From 55dc0c28265917a62b5c633c07c01b8666251d93 Mon Sep 17 00:00:00 2001 From: Camm Maguire Date: Tue, 20 Dec 2022 15:35:44 +0000 Subject: [PATCH] Import gcl_2.6.13.orig.tar.gz [dgit import orig gcl_2.6.13.orig.tar.gz] --- .gitignore | 10 + AC_FD_CC | 10 + AC_FD_MSG | 1 + COPYING.LIB-2.0 | 481 + ChangeLog | 532 + ChangeLog.old | 218 + README.macosx | 9 + README.openbsd | 40 + README.wine | 17 + RELEASE-2.5.1 | 138 + RELEASE-2.6.2.html | 1599 + add-defs | 139 + add-defs.bat | 63 + add-defs1 | 89 + ansi-tests/.cvsignore | 5 + ansi-tests/README | 14 + ansi-tests/adjustable-array-p.lsp | 68 + ansi-tests/and.lsp | 57 + ansi-tests/ansi-aux.lsp | 1640 + ansi-tests/apply.lsp | 61 + ansi-tests/aref.lsp | 144 + ansi-tests/array-as-class.lsp | 66 + ansi-tests/array-aux.lsp | 205 + ansi-tests/array-dimension.lsp | 63 + ansi-tests/array-dimensions.lsp | 69 + ansi-tests/array-displacement.lsp | 135 + ansi-tests/array-in-bounds-p.lsp | 152 + ansi-tests/array-misc.lsp | 30 + ansi-tests/array-rank.lsp | 52 + ansi-tests/array-row-major-index.lsp | 39 + ansi-tests/array-t.lsp | 275 + ansi-tests/array-total-size.lsp | 63 + ansi-tests/array.lsp | 330 + ansi-tests/arrayp.lsp | 57 + ansi-tests/assert.lsp | 90 + ansi-tests/atom-errors.lsp | 39 + ansi-tests/bit-and.lsp | 243 + ansi-tests/bit-andc1.lsp | 243 + ansi-tests/bit-andc2.lsp | 244 + ansi-tests/bit-eqv.lsp | 245 + ansi-tests/bit-ior.lsp | 244 + ansi-tests/bit-nand.lsp | 244 + ansi-tests/bit-nor.lsp | 244 + ansi-tests/bit-not.lsp | 139 + ansi-tests/bit-orc1.lsp | 244 + ansi-tests/bit-orc2.lsp | 245 + ansi-tests/bit-vector-p.lsp | 79 + ansi-tests/bit-vector.lsp | 121 + ansi-tests/bit-xor.lsp | 244 + ansi-tests/bit.lsp | 136 + ansi-tests/block.lsp | 73 + ansi-tests/boundp.lsp | 56 + ansi-tests/broadcast-stream-streams.lsp | 30 + ansi-tests/call-arguments-limit.lsp | 29 + ansi-tests/case.lsp | 171 + ansi-tests/catch.lsp | 75 + ansi-tests/ccase.lsp | 189 + ansi-tests/cell-error-name.lsp | 51 + ansi-tests/cerror.lsp | 56 + ansi-tests/char-aux.lsp | 286 + ansi-tests/char-compare.lsp | 723 + ansi-tests/char-schar.lsp | 164 + ansi-tests/character.lsp | 651 + ansi-tests/check-type.lsp | 51 + ansi-tests/cl-symbol-names.lsp | 2155 + ansi-tests/cl-symbols-aux.lsp | 43 + ansi-tests/cl-symbols.lsp | 1587 + ansi-tests/cl-test-package.lsp | 15 + ansi-tests/clear-input.lsp | 64 + ansi-tests/clear-output.lsp | 53 + ansi-tests/cltest.system | 123 + ansi-tests/coerce.lsp | 178 + ansi-tests/compile-and-load.lsp | 26 + ansi-tests/compile-file-test-file.lsp | 3 + ansi-tests/compile.lsp | 91 + ansi-tests/compiled-function-p.lsp | 39 + ansi-tests/compiler-macros.lsp | 8 + ansi-tests/complement.lsp | 57 + ansi-tests/concatenate.lsp | 227 + ansi-tests/concatenated-stream-streams.lsp | 67 + ansi-tests/cond.lsp | 75 + ansi-tests/condition.lsp | 63 + ansi-tests/cons-test-01.lsp | 456 + ansi-tests/cons-test-02.lsp | 1117 + ansi-tests/cons-test-03.lsp | 325 + ansi-tests/cons-test-04.lsp | 412 + ansi-tests/cons-test-05.lsp | 192 + ansi-tests/cons-test-06.lsp | 54 + ansi-tests/cons-test-07.lsp | 211 + ansi-tests/cons-test-08.lsp | 455 + ansi-tests/cons-test-09.lsp | 186 + ansi-tests/cons-test-10.lsp | 96 + ansi-tests/cons-test-11.lsp | 261 + ansi-tests/cons-test-12.lsp | 103 + ansi-tests/cons-test-13.lsp | 292 + ansi-tests/cons-test-14.lsp | 275 + ansi-tests/cons-test-15.lsp | 652 + ansi-tests/cons-test-16.lsp | 678 + ansi-tests/cons-test-17.lsp | 559 + ansi-tests/cons-test-18.lsp | 338 + ansi-tests/cons-test-19.lsp | 738 + ansi-tests/cons-test-20.lsp | 404 + ansi-tests/cons-test-21.lsp | 402 + ansi-tests/cons-test-22.lsp | 613 + ansi-tests/cons-test-23.lsp | 693 + ansi-tests/cons-test-24.lsp | 250 + ansi-tests/cons-test-25.lsp | 56 + ansi-tests/constantly.lsp | 37 + ansi-tests/constantp.lsp | 84 + ansi-tests/copy-seq.lsp | 187 + ansi-tests/count-if-not.lsp | 540 + ansi-tests/count-if.lsp | 541 + ansi-tests/count.lsp | 609 + ansi-tests/ctypecase.lsp | 88 + ansi-tests/data-and-control-flow.lsp | 34 + ansi-tests/defconstant.lsp | 45 + ansi-tests/define-modify-macro.lsp | 83 + ansi-tests/defparameter.lsp | 66 + ansi-tests/defun.lsp | 19 + ansi-tests/defvar.lsp | 64 + ansi-tests/delete-file.lsp | 95 + ansi-tests/destructuring-bind.lsp | 110 + ansi-tests/directory-namestring.lsp | 50 + ansi-tests/directory.lsp | 71 + ansi-tests/ecase.lsp | 149 + ansi-tests/echo-stream-input-stream.lsp | 27 + ansi-tests/echo-stream-output-stream.lsp | 26 + ansi-tests/elt.lsp | 368 + ansi-tests/enough-namestring.lsp | 84 + ansi-tests/ensure-directories-exist.lsp | 166 + ansi-tests/eql.lsp | 87 + ansi-tests/equal.lsp | 81 + ansi-tests/equalp.lsp | 47 + ansi-tests/error.lsp | 66 + ansi-tests/etypecase.lsp | 61 + ansi-tests/eval-and-compile.lsp | 22 + ansi-tests/eval.lsp | 52 + ansi-tests/every.lsp | 150 + ansi-tests/fboundp.lsp | 69 + ansi-tests/fdefinition.lsp | 83 + ansi-tests/features.lsp | 22 + ansi-tests/file-author.lsp | 88 + ansi-tests/file-error.lsp | 89 + ansi-tests/file-length.lsp | 176 + ansi-tests/file-namestring.lsp | 44 + ansi-tests/file-position.lsp | 170 + ansi-tests/file-string-length.lsp | 73 + ansi-tests/file-write-date.lsp | 89 + ansi-tests/fill-pointer.lsp | 82 + ansi-tests/fill-strings.lsp | 26 + ansi-tests/fill.lsp | 522 + ansi-tests/find-if-not.lsp | 611 + ansi-tests/find-if.lsp | 634 + ansi-tests/find.lsp | 870 + ansi-tests/finish-output.lsp | 54 + ansi-tests/flet.lsp | 431 + ansi-tests/fmakunbound.lsp | 67 + ansi-tests/force-output.lsp | 56 + ansi-tests/fresh-line.lsp | 87 + ansi-tests/funcall.lsp | 105 + ansi-tests/function-lambda-expression.lsp | 42 + ansi-tests/function.lsp | 95 + ansi-tests/functionp.lsp | 96 + ansi-tests/gclload.lsp | 4 + ansi-tests/gclload1.lsp | 33 + ansi-tests/gclload2.lsp | 64 + ansi-tests/get-output-stream-string.lsp | 32 + ansi-tests/get-setf-expansion.lsp | 16 + ansi-tests/handler-bind.lsp | 144 + ansi-tests/handler-case.lsp | 9 + ansi-tests/hash-table.lsp | 71 + ansi-tests/host-namestring.lsp | 49 + ansi-tests/identity.lsp | 34 + ansi-tests/if.lsp | 35 + ansi-tests/input-stream-p.lsp | 40 + ansi-tests/interactive-stream-p.lsp | 28 + ansi-tests/invoke-debugger.lsp | 23 + ansi-tests/iteration.lsp | 494 + ansi-tests/labels.lsp | 214 + ansi-tests/lambda-list-keywords.lsp | 39 + ansi-tests/lambda-parameters-limit.lsp | 17 + ansi-tests/lambda.lsp | 60 + ansi-tests/ldtest.lsp | 1 + ansi-tests/length.lsp | Bin 0 -> 2452 bytes ansi-tests/let.lsp | 210 + ansi-tests/listen.lsp | 73 + ansi-tests/load-arrays.lsp | 46 + ansi-tests/load-conditions.lsp | 10 + ansi-tests/load-cons.lsp | 27 + ansi-tests/load-data-and-control-flow.lsp | 69 + ansi-tests/load-eval-and-compile.lsp | 7 + ansi-tests/load-files.lsp | 16 + ansi-tests/load-iteration.lsp | 20 + .../load-logical-pathname-translations.lsp | 34 + ansi-tests/load-pathnames.lsp | 36 + ansi-tests/load-sequences.lsp | 41 + ansi-tests/load-streams.lsp | 57 + ansi-tests/load-strings.lsp | 18 + ansi-tests/load-structures.lsp | 6 + ansi-tests/load-symbols.lsp | 5 + ansi-tests/load-system-construction.lsp | 12 + ansi-tests/load-test-file-2.lsp | 7 + ansi-tests/load-test-file.lsp | 9 + ansi-tests/load-types-and-class.lsp | 15 + ansi-tests/load.lsp | 227 + ansi-tests/logical-pathname-translations.lsp | 8 + ansi-tests/logical-pathname.lsp | 93 + ansi-tests/loop.lsp | 53 + ansi-tests/loop1.lsp | 227 + ansi-tests/loop10.lsp | 450 + ansi-tests/loop11.lsp | 165 + ansi-tests/loop12.lsp | 234 + ansi-tests/loop13.lsp | 433 + ansi-tests/loop14.lsp | 333 + ansi-tests/loop15.lsp | 249 + ansi-tests/loop16.lsp | 243 + ansi-tests/loop17.lsp | 133 + ansi-tests/loop2.lsp | 139 + ansi-tests/loop3.lsp | 136 + ansi-tests/loop4.lsp | 57 + ansi-tests/loop5.lsp | 172 + ansi-tests/loop6.lsp | 294 + ansi-tests/loop7.lsp | 206 + ansi-tests/loop8.lsp | 141 + ansi-tests/loop9.lsp | 222 + ansi-tests/macrolet.lsp | 160 + ansi-tests/make-array.lsp | 670 + ansi-tests/make-broadcast-stream.lsp | 99 + ansi-tests/make-concatenated-stream.lsp | 323 + ansi-tests/make-echo-stream.lsp | 332 + ansi-tests/make-hash-table.lsp | 16 + ansi-tests/make-pathname.lsp | 171 + ansi-tests/make-sequence.lsp | 273 + ansi-tests/make-string-input-stream.lsp | 93 + ansi-tests/make-string-output-stream.lsp | 139 + ansi-tests/make-string.lsp | 163 + ansi-tests/make-synonym-stream.lsp | 97 + ansi-tests/make-tar | 2 + ansi-tests/make-two-way-stream.lsp | 244 + ansi-tests/makefile | 12 + ansi-tests/map-into.lsp | 407 + ansi-tests/map.lsp | 257 + ansi-tests/merge-pathnames.lsp | 124 + ansi-tests/merge.lsp | 572 + ansi-tests/mismatch.lsp | 715 + ansi-tests/multiple-value-bind.lsp | 62 + ansi-tests/multiple-value-call.lsp | 42 + ansi-tests/multiple-value-list.lsp | 37 + ansi-tests/multiple-value-prog1.lsp | 71 + ansi-tests/multiple-value-setq.lsp | 109 + ansi-tests/namestring.lsp | 64 + ansi-tests/nil.lsp | 44 + ansi-tests/not-and-null.lsp | 59 + ansi-tests/notany.lsp | 142 + ansi-tests/notevery.lsp | 142 + ansi-tests/nreverse.lsp | 126 + ansi-tests/nstring-capitalize.lsp | 108 + ansi-tests/nstring-downcase.lsp | 118 + ansi-tests/nstring-upcase.lsp | 115 + ansi-tests/nsubstitute-if-not.lsp | 761 + ansi-tests/nsubstitute-if.lsp | 753 + ansi-tests/nsubstitute.lsp | 957 + ansi-tests/nth-value.lsp | 36 + ansi-tests/open-stream-p.lsp | 54 + ansi-tests/open.lsp | 1238 + ansi-tests/or.lsp | 48 + ansi-tests/output-stream-p.lsp | 39 + ansi-tests/packages-00.lsp | 39 + ansi-tests/packages-01.lsp | 92 + ansi-tests/packages-02.lsp | 91 + ansi-tests/packages-03.lsp | 220 + ansi-tests/packages-04.lsp | 57 + ansi-tests/packages-05.lsp | 110 + ansi-tests/packages-06.lsp | 176 + ansi-tests/packages-07.lsp | 231 + ansi-tests/packages-08.lsp | 148 + ansi-tests/packages-09.lsp | 324 + ansi-tests/packages-10.lsp | 121 + ansi-tests/packages-11.lsp | 143 + ansi-tests/packages-12.lsp | 247 + ansi-tests/packages-13.lsp | 52 + ansi-tests/packages-14.lsp | 201 + ansi-tests/packages-15.lsp | 210 + ansi-tests/packages-16.lsp | 614 + ansi-tests/packages-17.lsp | 145 + ansi-tests/packages-18.lsp | 106 + ansi-tests/packages-19.lsp | 61 + ansi-tests/packages.lsp | 26 + ansi-tests/parse-namestring.lsp | 89 + ansi-tests/pathname-device.lsp | 74 + ansi-tests/pathname-directory.lsp | 89 + ansi-tests/pathname-host.lsp | 79 + ansi-tests/pathname-match-p.lsp | 103 + ansi-tests/pathname-name.lsp | 75 + ansi-tests/pathname-type.lsp | 75 + ansi-tests/pathname-version.lsp | 40 + ansi-tests/pathname.lsp | 88 + ansi-tests/pathnamep.lsp | 31 + ansi-tests/pathnames-aux.lsp | 25 + ansi-tests/pathnames.lsp | 19 + ansi-tests/peek-char.lsp | 329 + ansi-tests/places.lsp | 467 + ansi-tests/position-if-not.lsp | 575 + ansi-tests/position-if.lsp | 574 + ansi-tests/position.lsp | 773 + ansi-tests/probe-file.lsp | 58 + ansi-tests/prog.lsp | 147 + ansi-tests/prog1.lsp | 27 + ansi-tests/prog2.lsp | 36 + ansi-tests/progn.lsp | 38 + ansi-tests/progv.lsp | 75 + ansi-tests/random-aux.lsp | 90 + ansi-tests/random-int-form.lsp | 2115 + ansi-tests/random-intern.lsp | 72 + ansi-tests/read-byte.lsp | 194 + ansi-tests/read-char-no-hang.lsp | 123 + ansi-tests/read-char.lsp | 121 + ansi-tests/read-line.lsp | 104 + ansi-tests/read-sequence.lsp | 300 + ansi-tests/reader-test.lsp | 155 + ansi-tests/reduce.lsp | 470 + ansi-tests/remove-aux.lsp | 273 + ansi-tests/remove-duplicates-aux.lsp | 88 + ansi-tests/remove-duplicates.lsp | 253 + ansi-tests/remove.lsp | 806 + ansi-tests/rename-file.lsp | 199 + ansi-tests/replace.lsp | 685 + ansi-tests/reverse.lsp | 131 + ansi-tests/row-major-aref.lsp | 112 + ansi-tests/rt-acl.system | 12 + ansi-tests/rt-doc.txt | 194 + ansi-tests/rt-package.lsp | 25 + ansi-tests/rt-test.lsp | 229 + ansi-tests/rt.lsp | 436 + ansi-tests/rt.system | 22 + ansi-tests/sbit.lsp | 95 + ansi-tests/search-aux.lsp | 92 + ansi-tests/search-bitvector.lsp | 176 + ansi-tests/search-list.lsp | 251 + ansi-tests/search-string.lsp | 163 + ansi-tests/search-vector.lsp | 176 + ansi-tests/simple-array-t.lsp | 275 + ansi-tests/simple-array.lsp | 329 + ansi-tests/simple-bit-vector-p.lsp | 62 + ansi-tests/simple-bit-vector.lsp | 72 + ansi-tests/simple-vector-p.lsp | 71 + ansi-tests/some.lsp | 151 + ansi-tests/sort.lsp | 143 + ansi-tests/stable-sort.lsp | 154 + ansi-tests/stream-element-type.lsp | 102 + ansi-tests/stream-error-stream.lsp | 34 + ansi-tests/stream-external-format.lsp | 24 + ansi-tests/streamp.lsp | 44 + ansi-tests/string-aux.lsp | 165 + ansi-tests/string-capitalize.lsp | 132 + ansi-tests/string-comparisons.lsp | 514 + ansi-tests/string-downcase.lsp | 128 + ansi-tests/string-left-trim.lsp | 165 + ansi-tests/string-right-trim.lsp | 165 + ansi-tests/string-trim.lsp | 165 + ansi-tests/string-upcase.lsp | 129 + ansi-tests/string.lsp | 202 + ansi-tests/structure-00.lsp | 552 + ansi-tests/structures-01.lsp | 103 + ansi-tests/structures-02.lsp | 420 + ansi-tests/structures-03.lsp | 417 + ansi-tests/subseq-aux.lsp | 239 + ansi-tests/subseq.lsp | 235 + ansi-tests/substitute-if-not.lsp | 837 + ansi-tests/substitute-if.lsp | 856 + ansi-tests/substitute.lsp | 1086 + ansi-tests/subtypep-array.lsp | 98 + ansi-tests/subtypep-cons.lsp | 202 + ansi-tests/subtypep-eql.lsp | 54 + ansi-tests/subtypep-float.lsp | 175 + ansi-tests/subtypep-integer.lsp | 434 + ansi-tests/subtypep-member.lsp | 229 + ansi-tests/subtypep-rational.lsp | 173 + ansi-tests/subtypep-real.lsp | 194 + ansi-tests/subtypep.lsp | 200 + ansi-tests/svref.lsp | 59 + ansi-tests/synonym-stream-symbol.lsp | 23 + ansi-tests/t.lsp | 24 + ansi-tests/tagbody.lsp | 161 + ansi-tests/terpri.lsp | 62 + ansi-tests/translate-logical-pathname.lsp | 48 + ansi-tests/translate-pathname.lsp | 50 + ansi-tests/truename.lsp | 108 + ansi-tests/two-way-stream-input-stream.lsp | 26 + ansi-tests/two-way-stream-output-stream.lsp | 26 + ansi-tests/typecase.lsp | 72 + ansi-tests/types-and-class-2.lsp | 197 + ansi-tests/types-and-class.lsp | 422 + ansi-tests/universe.lsp | 432 + ansi-tests/unless.lsp | 49 + ansi-tests/unread-char.lsp | 92 + ansi-tests/unwind-protect.lsp | 90 + ansi-tests/upgraded-array-element-type.lsp | 108 + ansi-tests/values-list.lsp | 40 + ansi-tests/values.lsp | 62 + ansi-tests/vector-pop.lsp | 44 + ansi-tests/vector-push-extend.lsp | 362 + ansi-tests/vector-push.lsp | 319 + ansi-tests/vector.lsp | 331 + ansi-tests/vectorp.lsp | 82 + ansi-tests/warn.lsp | 161 + ansi-tests/when.lsp | 39 + ansi-tests/wild-pathname-p.lsp | 234 + ansi-tests/with-input-from-string.lsp | 245 + ansi-tests/with-open-file.lsp | 98 + ansi-tests/with-open-stream.lsp | 77 + ansi-tests/with-output-to-string.lsp | 129 + ansi-tests/write-char.lsp | 51 + ansi-tests/write-line.lsp | 165 + ansi-tests/write-sequence.lsp | 225 + ansi-tests/write-string.lsp | 156 + bfdtest.c | 418 + bin/.gitignore | 4 + bin/append.c | 35 + bin/dpp.c | 681 + bin/file-sub.c | 71 + bin/info | 3 + bin/info1 | 13 + bin/makefile | 19 + bin/tkinfo | 19 + clcs/.gitignore | 3 + clcs/gcl_clcs_condition_definitions.lisp | 145 + clcs/gcl_clcs_conditions.lisp | 85 + clcs/gcl_clcs_handler.lisp | 39 + clcs/gcl_clcs_precom.lisp | 6 + clcs/gcl_cmpinit.lsp | 7 + clcs/loading.lisp | 26 + clcs/makefile | 37 + clcs/myload.lisp | 4 + clcs/package.lisp | 23 + clcs/readme | 16 + clcs/sys-proclaim.lisp | 48 + clcs/unused/condition_precom.lisp | 61 + clcs/unused/doload.lisp | 21 + clcs/unused/reload.lisp | 12 + clcs/unused/sysdef.lisp | 129 + clcs/unused/test.lisp | 168 + clcs/unused/test2.lisp | 41 + clcs/unused/test3.lisp | 103 + clcs/unused/test4.lisp | 12 + clcs/unused/test5.lisp | 342 + clcs/unused/tester.lisp | 11 + cmpnew/.gitignore | 2 + cmpnew/gcl_cmpbind.lsp | 131 + cmpnew/gcl_cmpblock.lsp | 169 + cmpnew/gcl_cmpcall.lsp | 579 + cmpnew/gcl_cmpcatch.lsp | 124 + cmpnew/gcl_cmpenv.lsp | 680 + cmpnew/gcl_cmpeval.lsp | 681 + cmpnew/gcl_cmpflet.lsp | 405 + cmpnew/gcl_cmpfun.lsp | 969 + cmpnew/gcl_cmpif.lsp | 437 + cmpnew/gcl_cmpinit.lsp | 7 + cmpnew/gcl_cmpinline.lsp | 715 + cmpnew/gcl_cmplabel.lsp | 252 + cmpnew/gcl_cmplam.lsp | 980 + cmpnew/gcl_cmplet.lsp | 361 + cmpnew/gcl_cmploc.lsp | 297 + cmpnew/gcl_cmpmain.lsp | 802 + cmpnew/gcl_cmpmap.lsp | 262 + cmpnew/gcl_cmpmulti.lsp | 253 + cmpnew/gcl_cmpopt.lsp | 1336 + cmpnew/gcl_cmpspecial.lsp | 153 + cmpnew/gcl_cmptag.lsp | 419 + cmpnew/gcl_cmptest.lsp | 267 + cmpnew/gcl_cmptop.lsp | 1734 + cmpnew/gcl_cmptype.lsp | 229 + cmpnew/gcl_cmputil.lsp | 241 + cmpnew/gcl_cmpvar.lsp | 476 + cmpnew/gcl_cmpvs.lsp | 100 + cmpnew/gcl_cmpwt.lsp | 192 + cmpnew/gcl_collectfn.lsp | 399 + cmpnew/gcl_fasdmacros.lsp | 81 + cmpnew/gcl_init.lsp | 4 + cmpnew/gcl_lfun_list.lsp | 434 + cmpnew/gcl_make-fn.lsp | 4 + cmpnew/gcl_make_ufun.lsp | 86 + cmpnew/gcl_nocmpinc.lsp | 23 + cmpnew/makefile | 66 + cmpnew/so_locations | 4 + cmpnew/sys-proclaim.lisp | 411 + comp/bo1.lsp | 149 + comp/c-pass1.lsp | 70 + comp/cmpinit.lsp | 16 + comp/comptype.lsp | 227 + comp/data.lsp | 107 + comp/defmacro.lsp | 257 + comp/defs.lsp | 126 + comp/exit.lsp | 44 + comp/fasdmacros.lsp | 92 + comp/inline.lsp | 599 + comp/integer.doc | 35 + comp/lambda.lsp | 38 + comp/lisp-decls.doc | 531 + comp/macros.lsp | 79 + comp/makefile | 37 + comp/mangle.lsp | 116 + comp/opts-base.lsp | 52 + comp/opts.lsp | 492 + comp/proclaim.lsp | 1 + comp/smash-oldcmp.lsp | 7 + comp/stmt.lsp | 407 + comp/sysdef.lsp | 23 + comp/top.lsp | 92 + comp/top1.lsp | 137 + comp/top2.lsp | 1086 + comp/try.lsp | 26 + comp/try1.lsp | 8 + comp/utils.lsp | 166 + comp/var.lsp | 1147 + comp/wr.lsp | 476 + config.guess | 1754 + config.sub | 1890 + configure | 11102 ++++++ configure-new.ac | 1040 + configure.in | 2230 ++ debian/README.Debian | 28 + debian/changelog | 4240 ++ debian/compat | 1 + debian/control | 39 + debian/control_ | 39 + debian/control_cvs | 39 + debian/copyright | 65 + debian/gcl.lintian-overrides | 9 + debian/gcl.sh | 28 + debian/gcl.templates | 38 + debian/in.gcl-doc.README.Debian | 9 + debian/in.gcl-doc.doc-base.main | 9 + debian/in.gcl-doc.doc-base.si | 12 + debian/in.gcl-doc.doc-base.tk | 12 + debian/in.gcl-doc.doc-base.xgcl | 15 + debian/in.gcl-doc.docs | 3 + debian/in.gcl-doc.info | 14 + debian/in.gcl-doc.install | 1 + debian/in.gcl.config | 19 + debian/in.gcl.docs | 2 + debian/in.gcl.emacsen-compat | 1 + debian/in.gcl.emacsen-install | 46 + debian/in.gcl.emacsen-remove | 15 + debian/in.gcl.emacsen-startup | 19 + debian/in.gcl.install | 3 + debian/in.gcl.manpages | 1 + debian/in.gcl.postinst | 41 + debian/in.gcl.postrm | 22 + debian/old.in.gcl-doc.doc-base.main | 12 + debian/po/POTFILES.in | 1 + debian/po/cs.po | 139 + debian/po/da.po | 97 + debian/po/de.po | 139 + debian/po/es.po | 209 + debian/po/fi.po | 95 + debian/po/fr.po | 141 + debian/po/gl.po | 138 + debian/po/it.po | 102 + debian/po/ja.po | 96 + debian/po/nl.po | 101 + debian/po/pt.po | 99 + debian/po/pt_BR.po | 98 + debian/po/ru.po | 100 + debian/po/sv.po | 106 + debian/po/templates.pot | 82 + debian/po/vi.po | 98 + debian/rules | 281 + debian/source/format | 1 + debian/source/include-binaries | 4 + debian/source/lintian-overrides | 11 + debian/texi.awk | 27 + debian/upstream/signing-key.asc | 88 + debian/watch | 2 + doc/bignum | 60 + doc/c-gc | 39 + doc/c-gc.doc | 32 + doc/compile-file-handling-of-top-level-forms | 222 + doc/contributors | 41 + doc/debug | 28 + doc/enhancements | 146 + doc/fast-link | 158 + doc/format | 44 + doc/funcall-comp | 35 + doc/funcall.lsp | 81 + doc/makefile | 9 + doc/multiple-values | 94 + doc/profile | 45 + dos/dostimes.c | 19 + dos/dum_dos.c | 9 + dos/makefile | 27 + dos/read.s | 41 + dos/readme | 7 + dos/sigman.s | 49 + dos/signal.c | 109 + dos/signal.h | 137 + elisp/add-default.el | 4 + elisp/ansi-doc.el | 92 + elisp/dbl.el | 685 + elisp/doc-to-texi.el | 126 + elisp/gcl.el | 375 + elisp/makefile | 18 + elisp/man1-to-texi.el | 414 + elisp/readme | 7 + elisp/smart-complete.el | 154 + elisp/sshell.el | 379 + eval.html | 106 + eval.tcl | 79 + faq | 85 + gcl-tk/comm.c | 283 + gcl-tk/convert.el | 246 + gcl-tk/decode.tcl | 321 + gcl-tk/demos-4.1/items.lisp | 305 + gcl-tk/demos-4.2/widget | 376 + gcl-tk/demos-4.2/widget.lisp | 385 + gcl-tk/demos/gc-monitor.lisp | 158 + gcl-tk/demos/mkArrow.tcl | 203 + gcl-tk/demos/mkBasic.lisp | 69 + gcl-tk/demos/mkBasic.tcl | 61 + gcl-tk/demos/mkBitmaps.tcl | 46 + gcl-tk/demos/mkButton.tcl | 33 + gcl-tk/demos/mkCanvText.lisp | 110 + gcl-tk/demos/mkCanvText.tcl | 110 + gcl-tk/demos/mkCheck.tcl | 33 + gcl-tk/demos/mkDialog.tcl | 63 + gcl-tk/demos/mkEntry.lisp | 30 + gcl-tk/demos/mkEntry.tcl | 29 + gcl-tk/demos/mkEntry2.lisp | 39 + gcl-tk/demos/mkEntry2.tcl | 39 + gcl-tk/demos/mkFloor.tcl | 1276 + gcl-tk/demos/mkForm.lisp | 54 + gcl-tk/demos/mkForm.tcl | 52 + gcl-tk/demos/mkHScale.lisp | 38 + gcl-tk/demos/mkHScale.tcl | 35 + gcl-tk/demos/mkIcon.tcl | 48 + gcl-tk/demos/mkItems.lisp | 358 + gcl-tk/demos/mkItems.tcl | 271 + gcl-tk/demos/mkLabel.lisp | 35 + gcl-tk/demos/mkLabel.tcl | 34 + gcl-tk/demos/mkListbox.lisp | 42 + gcl-tk/demos/mkListbox.tcl | 41 + gcl-tk/demos/mkListbox2.tcl | 95 + gcl-tk/demos/mkListbox3.tcl | 34 + gcl-tk/demos/mkPlot.lisp | 81 + gcl-tk/demos/mkPlot.tcl | 75 + gcl-tk/demos/mkPuzzle.tcl | 59 + gcl-tk/demos/mkRadio.lisp | 61 + gcl-tk/demos/mkRadio.tcl | 58 + gcl-tk/demos/mkRuler.lisp | 140 + gcl-tk/demos/mkRuler.tcl | 125 + gcl-tk/demos/mkScroll.tcl | 84 + gcl-tk/demos/mkSearch.lisp | 135 + gcl-tk/demos/mkSearch.tcl | 140 + gcl-tk/demos/mkStyles.lisp | 135 + gcl-tk/demos/mkStyles.tcl | 128 + gcl-tk/demos/mkTear.tcl | 19 + gcl-tk/demos/mkTextBind.lisp | 108 + gcl-tk/demos/mkTextBind.tcl | 100 + gcl-tk/demos/mkVScale.lisp | 40 + gcl-tk/demos/mkVScale.tcl | 35 + gcl-tk/demos/mkdialog.lisp | 64 + gcl-tk/demos/nqthm-stack.lisp | 61 + gcl-tk/demos/showVars.lisp | 28 + gcl-tk/demos/showVars.tcl | 26 + gcl-tk/demos/tclIndex | 83 + gcl-tk/demos/widget.lisp | 220 + gcl-tk/dir.sed | 3 + gcl-tk/gcl-1.tcl | 39 + gcl-tk/gcl.tcl | 55 + gcl-tk/gcl_cmpinit.lsp | 1 + gcl-tk/gcl_guisl.h | 9 + gcl-tk/gcltksrv.bat | 8 + gcl-tk/gcltksrv.in | 31 + gcl-tk/gcltksrv.in.interp | 15 + gcl-tk/gcltksrv.prev | 22 + gcl-tk/guis.c | 509 + gcl-tk/guis.h | 104 + gcl-tk/helpers.lisp | 21 + gcl-tk/index.lsp | 55 + gcl-tk/intrs.h | 0 gcl-tk/makefile | 76 + gcl-tk/makefile.prev | 129 + gcl-tk/ngcltksrv | 12 + gcl-tk/our_io.c | 109 + gcl-tk/sheader.h | 112 + gcl-tk/socketsl.lisp | 27 + gcl-tk/socks.h | 31 + gcl-tk/sysdep-sunos.h | 9 + gcl-tk/tinfo.lsp | 588 + gcl-tk/tk-package.lsp | 33 + gcl-tk/tkAppInit.c | 112 + gcl-tk/tkMain.c | 712 + gcl-tk/tkXAppInit.c | 131 + gcl-tk/tkXshell.c | 445 + gcl-tk/tkl.lisp | 1559 + gcl-tk/tktst.c | 231 + gcl.ico | Bin 0 -> 23502 bytes gcl.jpg | Bin 0 -> 24640 bytes gcl.png | Bin 0 -> 12437 bytes gcl1.jpg | Bin 0 -> 17006 bytes gcl2.jpg | Bin 0 -> 5737 bytes git.tag | 2 + gmp.patch | 19 + gmp4/.gdbinit | 43 + gmp4/.pc/.quilt_patches | 1 + gmp4/.pc/.quilt_series | 1 + gmp4/.pc/.version | 1 + .../mpn/powerpc64/mode64/gcd_1.asm | 122 + gmp4/.pc/applied-patches | 2 + .../mpn/generic/div_qr_1n_pi1.c | 277 + gmp4/AUTHORS | 100 + gmp4/COPYING | 674 + gmp4/COPYING.LESSERv3 | 165 + gmp4/COPYINGv2 | 339 + gmp4/COPYINGv3 | 674 + gmp4/ChangeLog | 32941 ++++++++++++++++ gmp4/INSTALL | 370 + gmp4/INSTALL.autoconf | 228 + gmp4/Makefile.am | 445 + gmp4/Makefile.in | 1476 + gmp4/NEWS | 891 + gmp4/README | 116 + gmp4/acinclude.m4 | 3989 ++ gmp4/aclocal.m4 | 9492 +++++ gmp4/assert.c | 59 + gmp4/bootstrap.c | 146 + gmp4/compat.c | 60 + gmp4/compile | 347 + gmp4/config.guess | 1558 + gmp4/config.in | 640 + gmp4/config.sub | 1791 + gmp4/configfsf.guess | 1568 + gmp4/configfsf.sub | 1793 + gmp4/configure | 29982 ++++++++++++++ gmp4/configure.ac | 3816 ++ gmp4/cxx/Makefile.am | 40 + gmp4/cxx/Makefile.in | 630 + gmp4/cxx/dummy.cc | 33 + gmp4/cxx/isfuns.cc | 116 + gmp4/cxx/ismpf.cc | 145 + gmp4/cxx/ismpq.cc | 67 + gmp4/cxx/ismpz.cc | 63 + gmp4/cxx/ismpznw.cc | 73 + gmp4/cxx/limits.cc | 62 + gmp4/cxx/osdoprnti.cc | 68 + gmp4/cxx/osfuns.cc | 124 + gmp4/cxx/osmpf.cc | 71 + gmp4/cxx/osmpq.cc | 48 + gmp4/cxx/osmpz.cc | 48 + gmp4/debian/NEWS.Debian | 13 + gmp4/debian/Notes | 25 + gmp4/debian/README.Debian | 10 + gmp4/debian/README.source | 57 + gmp4/debian/changelog | 1148 + gmp4/debian/compat | 2 + gmp4/debian/control | 83 + gmp4/debian/copyright | 60 + gmp4/debian/libgmp10-doc.README.Debian | 21 + gmp4/debian/libgmp10-doc.examples | 1 + gmp4/debian/libgmp10.symbols | 912 + gmp4/debian/libgmpxx4ldbl.lintian-overrides | 1 + gmp4/debian/patches/4a6d258b467f.patch | 22 + gmp4/debian/patches/arm-asm-nothumb.patch | 21 + gmp4/debian/patches/series | 2 + gmp4/debian/rules | 177 + gmp4/debian/source/format | 1 + gmp4/debian/watch | 4 + gmp4/demos/Makefile.am | 50 + gmp4/demos/Makefile.in | 773 + gmp4/demos/calc/Makefile.am | 47 + gmp4/demos/calc/Makefile.in | 665 + gmp4/demos/calc/README | 65 + gmp4/demos/calc/calc-common.h | 35 + gmp4/demos/calc/calc-config-h.in | 21 + gmp4/demos/calc/calc.c | 2254 ++ gmp4/demos/calc/calc.h | 145 + gmp4/demos/calc/calc.y | 318 + gmp4/demos/calc/calclex.c | 1917 + gmp4/demos/calc/calclex.l | 113 + gmp4/demos/calc/calcread.c | 146 + gmp4/demos/expr/Makefile.am | 54 + gmp4/demos/expr/Makefile.in | 653 + gmp4/demos/expr/README | 501 + gmp4/demos/expr/expr-impl.h | 125 + gmp4/demos/expr/expr.c | 834 + gmp4/demos/expr/expr.h | 142 + gmp4/demos/expr/exprf.c | 123 + gmp4/demos/expr/exprfa.c | 191 + gmp4/demos/expr/exprq.c | 155 + gmp4/demos/expr/exprqa.c | 100 + gmp4/demos/expr/exprv.c | 57 + gmp4/demos/expr/exprz.c | 206 + gmp4/demos/expr/exprza.c | 108 + gmp4/demos/expr/run-expr.c | 242 + gmp4/demos/expr/t-expr.c | 510 + gmp4/demos/factorize.c | 446 + gmp4/demos/isprime.c | 68 + gmp4/demos/perl/GMP.pm | 671 + gmp4/demos/perl/GMP.xs | 3212 ++ gmp4/demos/perl/GMP/Mpf.pm | 106 + gmp4/demos/perl/GMP/Mpq.pm | 89 + gmp4/demos/perl/GMP/Mpz.pm | 101 + gmp4/demos/perl/GMP/Rand.pm | 44 + gmp4/demos/perl/INSTALL | 88 + gmp4/demos/perl/Makefile.PL | 82 + gmp4/demos/perl/sample.pl | 54 + gmp4/demos/perl/test.pl | 2179 + gmp4/demos/perl/test2.pl | 75 + gmp4/demos/perl/typemap | 108 + gmp4/demos/pexpr-config-h.in | 45 + gmp4/demos/pexpr.c | 1378 + gmp4/demos/primes.c | 387 + gmp4/demos/primes.h | 552 + gmp4/demos/qcn.c | 172 + gmp4/doc/Makefile.am | 0 gmp4/doc/Makefile.in | 467 + gmp4/errno.c | 70 + gmp4/extract-dbl.c | 311 + gmp4/gen-bases.c | 251 + gmp4/gen-fac.c | 285 + gmp4/gen-fib.c | 156 + gmp4/gen-jacobitab.c | 128 + gmp4/gen-psqr.c | 586 + gmp4/gen-trialdivtab.c | 300 + gmp4/gmp-h.in | 2301 ++ gmp4/gmp-impl.h | 5203 +++ gmp4/gmpxx.h | 3336 ++ gmp4/install-sh | 527 + gmp4/invalid.c | 83 + gmp4/longlong.h | 2183 + gmp4/ltmain.sh | 9661 +++++ gmp4/memory.c | 146 + gmp4/mini-gmp/README | 77 + gmp4/mini-gmp/mini-gmp.c | 4386 ++ gmp4/mini-gmp/mini-gmp.h | 294 + gmp4/mini-gmp/tests/Makefile | 60 + gmp4/mini-gmp/tests/hex-random.c | 434 + gmp4/mini-gmp/tests/hex-random.h | 50 + gmp4/mini-gmp/tests/mini-random.c | 142 + gmp4/mini-gmp/tests/mini-random.h | 33 + gmp4/mini-gmp/tests/run-tests | 123 + gmp4/mini-gmp/tests/t-add.c | 57 + gmp4/mini-gmp/tests/t-aorsmul.c | 77 + gmp4/mini-gmp/tests/t-bitops.c | 103 + gmp4/mini-gmp/tests/t-cmp_d.c | 283 + gmp4/mini-gmp/tests/t-comb.c | 164 + gmp4/mini-gmp/tests/t-cong.c | 212 + gmp4/mini-gmp/tests/t-div.c | 254 + gmp4/mini-gmp/tests/t-div_2exp.c | 82 + gmp4/mini-gmp/tests/t-double.c | 138 + gmp4/mini-gmp/tests/t-gcd.c | 176 + gmp4/mini-gmp/tests/t-import.c | 99 + gmp4/mini-gmp/tests/t-invert.c | 98 + gmp4/mini-gmp/tests/t-lcm.c | 73 + gmp4/mini-gmp/tests/t-limbs.c | 106 + gmp4/mini-gmp/tests/t-logops.c | 112 + gmp4/mini-gmp/tests/t-mul.c | 113 + gmp4/mini-gmp/tests/t-powm.c | 61 + gmp4/mini-gmp/tests/t-pprime_p.c | 182 + gmp4/mini-gmp/tests/t-reuse.c | 663 + gmp4/mini-gmp/tests/t-root.c | 95 + gmp4/mini-gmp/tests/t-scan.c | 90 + gmp4/mini-gmp/tests/t-signed.c | 142 + gmp4/mini-gmp/tests/t-sqrt.c | 181 + gmp4/mini-gmp/tests/t-str.c | 307 + gmp4/mini-gmp/tests/t-sub.c | 71 + gmp4/mini-gmp/tests/testutils.c | 173 + gmp4/mini-gmp/tests/testutils.h | 37 + gmp4/missing | 215 + gmp4/mp_bpl.c | 35 + gmp4/mp_clz_tab.c | 49 + gmp4/mp_dv_tab.c | 78 + gmp4/mp_get_fns.c | 48 + gmp4/mp_minv_tab.c | 59 + gmp4/mp_set_fns.c | 50 + gmp4/mpf/Makefile.am | 47 + gmp4/mpf/Makefile.in | 649 + gmp4/mpf/abs.c | 59 + gmp4/mpf/add.c | 184 + gmp4/mpf/add_ui.c | 153 + gmp4/mpf/ceilfloor.c | 126 + gmp4/mpf/clear.c | 39 + gmp4/mpf/clears.c | 49 + gmp4/mpf/cmp.c | 117 + gmp4/mpf/cmp_d.c | 60 + gmp4/mpf/cmp_si.c | 118 + gmp4/mpf/cmp_ui.c | 100 + gmp4/mpf/div.c | 138 + gmp4/mpf/div_2exp.c | 139 + gmp4/mpf/div_ui.c | 111 + gmp4/mpf/dump.c | 53 + gmp4/mpf/eq.c | 150 + gmp4/mpf/fits_s.h | 75 + gmp4/mpf/fits_sint.c | 36 + gmp4/mpf/fits_slong.c | 36 + gmp4/mpf/fits_sshort.c | 36 + gmp4/mpf/fits_u.h | 74 + gmp4/mpf/fits_uint.c | 35 + gmp4/mpf/fits_ulong.c | 35 + gmp4/mpf/fits_ushort.c | 35 + gmp4/mpf/get_d.c | 47 + gmp4/mpf/get_d_2exp.c | 61 + gmp4/mpf/get_dfl_prec.c | 39 + gmp4/mpf/get_prc.c | 38 + gmp4/mpf/get_si.c | 87 + gmp4/mpf/get_str.c | 330 + gmp4/mpf/get_ui.c | 102 + gmp4/mpf/init.c | 42 + gmp4/mpf/init2.c | 44 + gmp4/mpf/inits.c | 49 + gmp4/mpf/inp_str.c | 93 + gmp4/mpf/int_p.c | 59 + gmp4/mpf/iset.c | 62 + gmp4/mpf/iset_d.c | 42 + gmp4/mpf/iset_si.c | 58 + gmp4/mpf/iset_str.c | 44 + gmp4/mpf/iset_ui.c | 53 + gmp4/mpf/mul.c | 96 + gmp4/mpf/mul_2exp.c | 133 + gmp4/mpf/mul_ui.c | 182 + gmp4/mpf/neg.c | 62 + gmp4/mpf/out_str.c | 117 + gmp4/mpf/pow_ui.c | 54 + gmp4/mpf/random2.c | 67 + gmp4/mpf/reldiff.c | 65 + gmp4/mpf/set.c | 56 + gmp4/mpf/set_d.c | 60 + gmp4/mpf/set_dfl_prec.c | 40 + gmp4/mpf/set_prc.c | 69 + gmp4/mpf/set_prc_raw.c | 40 + gmp4/mpf/set_q.c | 155 + gmp4/mpf/set_si.c | 53 + gmp4/mpf/set_str.c | 402 + gmp4/mpf/set_ui.c | 49 + gmp4/mpf/set_z.c | 57 + gmp4/mpf/size.c | 39 + gmp4/mpf/sqrt.c | 113 + gmp4/mpf/sqrt_ui.c | 109 + gmp4/mpf/sub.c | 419 + gmp4/mpf/sub_ui.c | 51 + gmp4/mpf/swap.c | 57 + gmp4/mpf/trunc.c | 75 + gmp4/mpf/ui_div.c | 128 + gmp4/mpf/ui_sub.c | 336 + gmp4/mpf/urandomb.c | 69 + gmp4/mpn/Makeasm.am | 118 + gmp4/mpn/Makefile.am | 59 + gmp4/mpn/Makefile.in | 760 + gmp4/mpn/README | 44 + gmp4/mpn/alpha/README | 208 + gmp4/mpn/alpha/add_n.asm | 164 + gmp4/mpn/alpha/addmul_1.asm | 99 + gmp4/mpn/alpha/alpha-defs.m4 | 107 + gmp4/mpn/alpha/aorslsh1_n.asm | 164 + gmp4/mpn/alpha/aorslsh2_n.asm | 167 + gmp4/mpn/alpha/bdiv_dbm1c.asm | 282 + gmp4/mpn/alpha/cntlz.asm | 55 + gmp4/mpn/alpha/com.asm | 176 + gmp4/mpn/alpha/copyd.asm | 88 + gmp4/mpn/alpha/copyi.asm | 86 + gmp4/mpn/alpha/default.m4 | 127 + gmp4/mpn/alpha/dive_1.c | 115 + gmp4/mpn/alpha/divrem_2.asm | 177 + gmp4/mpn/alpha/ev5/diveby3.asm | 332 + gmp4/mpn/alpha/ev5/gmp-mparam.h | 187 + gmp4/mpn/alpha/ev6/add_n.asm | 283 + gmp4/mpn/alpha/ev6/aorslsh1_n.asm | 172 + gmp4/mpn/alpha/ev6/aorsmul_1.asm | 398 + gmp4/mpn/alpha/ev6/gmp-mparam.h | 209 + gmp4/mpn/alpha/ev6/mod_1_4.asm | 337 + gmp4/mpn/alpha/ev6/mul_1.asm | 496 + gmp4/mpn/alpha/ev6/nails/README | 65 + gmp4/mpn/alpha/ev6/nails/addmul_1.asm | 396 + gmp4/mpn/alpha/ev6/nails/addmul_2.asm | 146 + gmp4/mpn/alpha/ev6/nails/addmul_3.asm | 169 + gmp4/mpn/alpha/ev6/nails/addmul_4.asm | 210 + gmp4/mpn/alpha/ev6/nails/aors_n.asm | 233 + gmp4/mpn/alpha/ev6/nails/gmp-mparam.h | 72 + gmp4/mpn/alpha/ev6/nails/mul_1.asm | 364 + gmp4/mpn/alpha/ev6/nails/submul_1.asm | 396 + gmp4/mpn/alpha/ev6/slot.pl | 318 + gmp4/mpn/alpha/ev6/sub_n.asm | 283 + gmp4/mpn/alpha/ev67/gcd_1.asm | 145 + gmp4/mpn/alpha/ev67/hamdist.asm | 111 + gmp4/mpn/alpha/ev67/popcount.asm | 101 + gmp4/mpn/alpha/gmp-mparam.h | 86 + gmp4/mpn/alpha/invert_limb.asm | 95 + gmp4/mpn/alpha/lshift.asm | 182 + gmp4/mpn/alpha/mod_34lsub1.asm | 164 + gmp4/mpn/alpha/mode1o.asm | 209 + gmp4/mpn/alpha/mul_1.asm | 102 + gmp4/mpn/alpha/rshift.asm | 180 + gmp4/mpn/alpha/sec_tabselect.asm | 137 + gmp4/mpn/alpha/sqr_diag_addlsh1.asm | 93 + gmp4/mpn/alpha/sub_n.asm | 164 + gmp4/mpn/alpha/submul_1.asm | 99 + gmp4/mpn/alpha/umul.asm | 44 + gmp4/mpn/alpha/unicos.m4 | 131 + gmp4/mpn/arm/README | 35 + gmp4/mpn/arm/aors_n.asm | 112 + gmp4/mpn/arm/aorslsh1_n.asm | 167 + gmp4/mpn/arm/aorsmul_1.asm | 135 + gmp4/mpn/arm/arm-defs.m4 | 91 + gmp4/mpn/arm/bdiv_dbm1c.asm | 113 + gmp4/mpn/arm/cnd_aors_n.asm | 134 + gmp4/mpn/arm/com.asm | 75 + gmp4/mpn/arm/copyd.asm | 84 + gmp4/mpn/arm/copyi.asm | 79 + gmp4/mpn/arm/dive_1.asm | 151 + gmp4/mpn/arm/gmp-mparam.h | 127 + gmp4/mpn/arm/invert_limb.asm | 93 + gmp4/mpn/arm/logops_n.asm | 139 + gmp4/mpn/arm/lshift.asm | 88 + gmp4/mpn/arm/lshiftc.asm | 95 + gmp4/mpn/arm/mod_34lsub1.asm | 121 + gmp4/mpn/arm/mode1o.asm | 92 + gmp4/mpn/arm/mul_1.asm | 94 + gmp4/mpn/arm/neon/README | 2 + gmp4/mpn/arm/neon/hamdist.asm | 194 + gmp4/mpn/arm/neon/lorrshift.asm | 279 + gmp4/mpn/arm/neon/lshiftc.asm | 257 + gmp4/mpn/arm/neon/popcount.asm | 166 + gmp4/mpn/arm/neon/sec_tabselect.asm | 140 + gmp4/mpn/arm/rsh1aors_n.asm | 124 + gmp4/mpn/arm/rshift.asm | 86 + gmp4/mpn/arm/sec_tabselect.asm | 131 + gmp4/mpn/arm/udiv.asm | 104 + gmp4/mpn/arm/v5/gcd_1.asm | 120 + gmp4/mpn/arm/v5/mod_1_1.asm | 129 + gmp4/mpn/arm/v5/mod_1_2.asm | 156 + gmp4/mpn/arm/v6/addmul_1.asm | 111 + gmp4/mpn/arm/v6/addmul_2.asm | 138 + gmp4/mpn/arm/v6/addmul_3.asm | 187 + gmp4/mpn/arm/v6/dive_1.asm | 149 + gmp4/mpn/arm/v6/gmp-mparam.h | 157 + gmp4/mpn/arm/v6/mode1o.asm | 95 + gmp4/mpn/arm/v6/mul_1.asm | 114 + gmp4/mpn/arm/v6/mul_2.asm | 131 + gmp4/mpn/arm/v6/popham.asm | 138 + gmp4/mpn/arm/v6/sqr_basecase.asm | 518 + gmp4/mpn/arm/v6/submul_1.asm | 125 + gmp4/mpn/arm/v6t2/divrem_1.asm | 212 + gmp4/mpn/arm/v6t2/gcd_1.asm | 115 + gmp4/mpn/arm/v7a/cora15/addmul_1.asm | 145 + gmp4/mpn/arm/v7a/cora15/aors_n.asm | 162 + gmp4/mpn/arm/v7a/cora15/cnd_aors_n.asm | 158 + gmp4/mpn/arm/v7a/cora15/com.asm | 180 + gmp4/mpn/arm/v7a/cora15/gmp-mparam.h | 197 + gmp4/mpn/arm/v7a/cora15/logops_n.asm | 253 + gmp4/mpn/arm/v7a/cora15/mul_1.asm | 104 + .../mpn/arm/v7a/cora15/neon/aorsorrlsh1_n.asm | 43 + .../mpn/arm/v7a/cora15/neon/aorsorrlsh2_n.asm | 43 + .../mpn/arm/v7a/cora15/neon/aorsorrlshC_n.asm | 144 + gmp4/mpn/arm/v7a/cora15/neon/com.asm | 97 + gmp4/mpn/arm/v7a/cora15/neon/copyd.asm | 110 + gmp4/mpn/arm/v7a/cora15/neon/copyi.asm | 90 + gmp4/mpn/arm/v7a/cora15/neon/rsh1aors_n.asm | 177 + gmp4/mpn/arm/v7a/cora15/submul_1.asm | 159 + gmp4/mpn/arm/v7a/cora9/gmp-mparam.h | 209 + gmp4/mpn/arm64/aors_n.asm | 98 + gmp4/mpn/arm64/aorsmul_1.asm | 122 + gmp4/mpn/arm64/cnd_aors_n.asm | 99 + gmp4/mpn/arm64/copyd.asm | 93 + gmp4/mpn/arm64/copyi.asm | 77 + gmp4/mpn/arm64/gcd_1.asm | 125 + gmp4/mpn/arm64/invert_limb.asm | 83 + gmp4/mpn/arm64/logops_n.asm | 106 + gmp4/mpn/arm64/mul_1.asm | 98 + gmp4/mpn/asm-defs.m4 | 1761 + gmp4/mpn/cpp-ccas | 118 + gmp4/mpn/cray/README | 121 + gmp4/mpn/cray/add_n.c | 91 + gmp4/mpn/cray/cfp/addmul_1.c | 49 + gmp4/mpn/cray/cfp/mul_1.c | 48 + gmp4/mpn/cray/cfp/mulwwc90.s | 254 + gmp4/mpn/cray/cfp/mulwwj90.s | 253 + gmp4/mpn/cray/cfp/submul_1.c | 49 + gmp4/mpn/cray/gmp-mparam.h | 79 + gmp4/mpn/cray/hamdist.c | 43 + gmp4/mpn/cray/ieee/addmul_1.c | 112 + gmp4/mpn/cray/ieee/gmp-mparam.h | 73 + gmp4/mpn/cray/ieee/invert_limb.c | 128 + gmp4/mpn/cray/ieee/mul_1.c | 104 + gmp4/mpn/cray/ieee/mul_basecase.c | 108 + gmp4/mpn/cray/ieee/sqr_basecase.c | 106 + gmp4/mpn/cray/ieee/submul_1.c | 112 + gmp4/mpn/cray/lshift.c | 59 + gmp4/mpn/cray/mulww.f | 63 + gmp4/mpn/cray/popcount.c | 43 + gmp4/mpn/cray/rshift.c | 59 + gmp4/mpn/cray/sub_n.c | 91 + gmp4/mpn/generic/add.c | 34 + gmp4/mpn/generic/add_1.c | 34 + gmp4/mpn/generic/add_err1_n.c | 101 + gmp4/mpn/generic/add_err2_n.c | 117 + gmp4/mpn/generic/add_err3_n.c | 132 + gmp4/mpn/generic/add_n.c | 90 + gmp4/mpn/generic/add_n_sub_n.c | 173 + gmp4/mpn/generic/addmul_1.c | 139 + gmp4/mpn/generic/bdiv_dbm1c.c | 59 + gmp4/mpn/generic/bdiv_q.c | 77 + gmp4/mpn/generic/bdiv_q_1.c | 126 + gmp4/mpn/generic/bdiv_qr.c | 85 + gmp4/mpn/generic/binvert.c | 102 + gmp4/mpn/generic/broot.c | 196 + gmp4/mpn/generic/brootinv.c | 140 + gmp4/mpn/generic/bsqrt.c | 48 + gmp4/mpn/generic/bsqrtinv.c | 105 + gmp4/mpn/generic/cmp.c | 34 + gmp4/mpn/generic/cnd_add_n.c | 70 + gmp4/mpn/generic/cnd_sub_n.c | 70 + gmp4/mpn/generic/com.c | 45 + gmp4/mpn/generic/comb_tables.c | 48 + gmp4/mpn/generic/copyd.c | 41 + gmp4/mpn/generic/copyi.c | 43 + gmp4/mpn/generic/dcpi1_bdiv_q.c | 160 + gmp4/mpn/generic/dcpi1_bdiv_qr.c | 177 + gmp4/mpn/generic/dcpi1_div_q.c | 87 + gmp4/mpn/generic/dcpi1_div_qr.c | 249 + gmp4/mpn/generic/dcpi1_divappr_q.c | 257 + gmp4/mpn/generic/div_q.c | 323 + gmp4/mpn/generic/div_qr_1.c | 126 + gmp4/mpn/generic/div_qr_1n_pi1.c | 277 + gmp4/mpn/generic/div_qr_1n_pi2.c | 195 + gmp4/mpn/generic/div_qr_1u_pi2.c | 228 + gmp4/mpn/generic/div_qr_2.c | 332 + gmp4/mpn/generic/div_qr_2n_pi1.c | 85 + gmp4/mpn/generic/div_qr_2u_pi1.c | 77 + gmp4/mpn/generic/dive_1.c | 148 + gmp4/mpn/generic/diveby3.c | 174 + gmp4/mpn/generic/divexact.c | 294 + gmp4/mpn/generic/divis.c | 201 + gmp4/mpn/generic/divrem.c | 108 + gmp4/mpn/generic/divrem_1.c | 255 + gmp4/mpn/generic/divrem_2.c | 119 + gmp4/mpn/generic/dump.c | 100 + gmp4/mpn/generic/fib2_ui.c | 189 + gmp4/mpn/generic/gcd.c | 310 + gmp4/mpn/generic/gcd_1.c | 199 + gmp4/mpn/generic/gcd_subdiv_step.c | 205 + gmp4/mpn/generic/gcdext.c | 558 + gmp4/mpn/generic/gcdext_1.c | 328 + gmp4/mpn/generic/gcdext_lehmer.c | 337 + gmp4/mpn/generic/get_d.c | 412 + gmp4/mpn/generic/get_str.c | 553 + gmp4/mpn/generic/gmp-mparam.h | 33 + gmp4/mpn/generic/hgcd.c | 183 + gmp4/mpn/generic/hgcd2.c | 447 + gmp4/mpn/generic/hgcd2_jacobi.c | 366 + gmp4/mpn/generic/hgcd_appr.c | 268 + gmp4/mpn/generic/hgcd_jacobi.c | 244 + gmp4/mpn/generic/hgcd_matrix.c | 266 + gmp4/mpn/generic/hgcd_reduce.c | 247 + gmp4/mpn/generic/hgcd_step.c | 128 + gmp4/mpn/generic/invert.c | 91 + gmp4/mpn/generic/invertappr.c | 314 + gmp4/mpn/generic/jacbase.c | 243 + gmp4/mpn/generic/jacobi.c | 295 + gmp4/mpn/generic/jacobi_2.c | 352 + gmp4/mpn/generic/logops_n.c | 78 + gmp4/mpn/generic/lshift.c | 73 + gmp4/mpn/generic/lshiftc.c | 74 + gmp4/mpn/generic/matrix22_mul.c | 322 + .../generic/matrix22_mul1_inverse_vector.c | 65 + gmp4/mpn/generic/mod_1.c | 281 + gmp4/mpn/generic/mod_1_1.c | 332 + gmp4/mpn/generic/mod_1_2.c | 149 + gmp4/mpn/generic/mod_1_3.c | 157 + gmp4/mpn/generic/mod_1_4.c | 171 + gmp4/mpn/generic/mod_34lsub1.c | 131 + gmp4/mpn/generic/mode1o.c | 236 + gmp4/mpn/generic/mu_bdiv_q.c | 271 + gmp4/mpn/generic/mu_bdiv_qr.c | 289 + gmp4/mpn/generic/mu_div_q.c | 185 + gmp4/mpn/generic/mu_div_qr.c | 416 + gmp4/mpn/generic/mu_divappr_q.c | 363 + gmp4/mpn/generic/mul.c | 428 + gmp4/mpn/generic/mul_1.c | 97 + gmp4/mpn/generic/mul_basecase.c | 166 + gmp4/mpn/generic/mul_fft.c | 1014 + gmp4/mpn/generic/mul_n.c | 97 + gmp4/mpn/generic/mullo_basecase.c | 52 + gmp4/mpn/generic/mullo_n.c | 256 + gmp4/mpn/generic/mulmid.c | 256 + gmp4/mpn/generic/mulmid_basecase.c | 83 + gmp4/mpn/generic/mulmid_n.c | 62 + gmp4/mpn/generic/mulmod_bnm1.c | 355 + gmp4/mpn/generic/neg.c | 34 + gmp4/mpn/generic/nussbaumer_mul.c | 71 + gmp4/mpn/generic/perfpow.c | 417 + gmp4/mpn/generic/perfsqr.c | 240 + gmp4/mpn/generic/popham.c | 126 + gmp4/mpn/generic/pow_1.c | 134 + gmp4/mpn/generic/powlo.c | 174 + gmp4/mpn/generic/powm.c | 590 + gmp4/mpn/generic/pre_divrem_1.c | 146 + gmp4/mpn/generic/pre_mod_1.c | 62 + gmp4/mpn/generic/random.c | 51 + gmp4/mpn/generic/random2.c | 106 + gmp4/mpn/generic/redc_1.c | 57 + gmp4/mpn/generic/redc_2.c | 110 + gmp4/mpn/generic/redc_n.c | 81 + gmp4/mpn/generic/remove.c | 172 + gmp4/mpn/generic/rootrem.c | 415 + gmp4/mpn/generic/rshift.c | 70 + gmp4/mpn/generic/sbpi1_bdiv_q.c | 100 + gmp4/mpn/generic/sbpi1_bdiv_qr.c | 119 + gmp4/mpn/generic/sbpi1_div_q.c | 303 + gmp4/mpn/generic/sbpi1_div_qr.c | 110 + gmp4/mpn/generic/sbpi1_divappr_q.c | 199 + gmp4/mpn/generic/scan0.c | 60 + gmp4/mpn/generic/scan1.c | 60 + gmp4/mpn/generic/sec_aors_1.c | 60 + gmp4/mpn/generic/sec_div.c | 133 + gmp4/mpn/generic/sec_invert.c | 195 + gmp4/mpn/generic/sec_mul.c | 49 + gmp4/mpn/generic/sec_pi1_div.c | 173 + gmp4/mpn/generic/sec_powm.c | 438 + gmp4/mpn/generic/sec_sqr.c | 48 + gmp4/mpn/generic/sec_tabselect.c | 55 + gmp4/mpn/generic/set_str.c | 374 + gmp4/mpn/generic/sizeinbase.c | 50 + gmp4/mpn/generic/sqr.c | 99 + gmp4/mpn/generic/sqr_basecase.c | 325 + gmp4/mpn/generic/sqrmod_bnm1.c | 313 + gmp4/mpn/generic/sqrtrem.c | 357 + gmp4/mpn/generic/sub.c | 34 + gmp4/mpn/generic/sub_1.c | 34 + gmp4/mpn/generic/sub_err1_n.c | 101 + gmp4/mpn/generic/sub_err2_n.c | 117 + gmp4/mpn/generic/sub_err3_n.c | 132 + gmp4/mpn/generic/sub_n.c | 90 + gmp4/mpn/generic/submul_1.c | 139 + gmp4/mpn/generic/tdiv_qr.c | 389 + gmp4/mpn/generic/toom22_mul.c | 210 + gmp4/mpn/generic/toom2_sqr.c | 146 + gmp4/mpn/generic/toom32_mul.c | 323 + gmp4/mpn/generic/toom33_mul.c | 316 + gmp4/mpn/generic/toom3_sqr.c | 226 + gmp4/mpn/generic/toom42_mul.c | 234 + gmp4/mpn/generic/toom42_mulmid.c | 238 + gmp4/mpn/generic/toom43_mul.c | 234 + gmp4/mpn/generic/toom44_mul.c | 236 + gmp4/mpn/generic/toom4_sqr.c | 164 + gmp4/mpn/generic/toom52_mul.c | 257 + gmp4/mpn/generic/toom53_mul.c | 331 + gmp4/mpn/generic/toom54_mul.c | 143 + gmp4/mpn/generic/toom62_mul.c | 311 + gmp4/mpn/generic/toom63_mul.c | 232 + gmp4/mpn/generic/toom6_sqr.c | 182 + gmp4/mpn/generic/toom6h_mul.c | 263 + gmp4/mpn/generic/toom8_sqr.c | 226 + gmp4/mpn/generic/toom8h_mul.c | 306 + gmp4/mpn/generic/toom_couple_handling.c | 81 + gmp4/mpn/generic/toom_eval_dgr3_pm1.c | 73 + gmp4/mpn/generic/toom_eval_dgr3_pm2.c | 98 + gmp4/mpn/generic/toom_eval_pm1.c | 90 + gmp4/mpn/generic/toom_eval_pm2.c | 131 + gmp4/mpn/generic/toom_eval_pm2exp.c | 128 + gmp4/mpn/generic/toom_eval_pm2rexp.c | 102 + gmp4/mpn/generic/toom_interpolate_12pts.c | 361 + gmp4/mpn/generic/toom_interpolate_16pts.c | 527 + gmp4/mpn/generic/toom_interpolate_5pts.c | 199 + gmp4/mpn/generic/toom_interpolate_6pts.c | 240 + gmp4/mpn/generic/toom_interpolate_7pts.c | 266 + gmp4/mpn/generic/toom_interpolate_8pts.c | 212 + gmp4/mpn/generic/trialdiv.c | 132 + gmp4/mpn/generic/udiv_w_sdiv.c | 142 + gmp4/mpn/generic/zero.c | 42 + gmp4/mpn/ia64/README | 281 + gmp4/mpn/ia64/add_n_sub_n.asm | 309 + gmp4/mpn/ia64/addmul_1.asm | 602 + gmp4/mpn/ia64/addmul_2.asm | 708 + gmp4/mpn/ia64/aors_n.asm | 856 + gmp4/mpn/ia64/aorsorrlsh1_n.asm | 48 + gmp4/mpn/ia64/aorsorrlsh2_n.asm | 48 + gmp4/mpn/ia64/aorsorrlshC_n.asm | 397 + gmp4/mpn/ia64/bdiv_dbm1c.asm | 516 + gmp4/mpn/ia64/cnd_aors_n.asm | 259 + gmp4/mpn/ia64/copyd.asm | 186 + gmp4/mpn/ia64/copyi.asm | 182 + gmp4/mpn/ia64/dive_1.asm | 236 + gmp4/mpn/ia64/divrem_1.asm | 477 + gmp4/mpn/ia64/divrem_2.asm | 280 + gmp4/mpn/ia64/gcd_1.asm | 234 + gmp4/mpn/ia64/gmp-mparam.h | 204 + gmp4/mpn/ia64/hamdist.asm | 365 + gmp4/mpn/ia64/ia64-defs.m4 | 147 + gmp4/mpn/ia64/invert_limb.asm | 105 + gmp4/mpn/ia64/logops_n.asm | 292 + gmp4/mpn/ia64/lorrshift.asm | 358 + gmp4/mpn/ia64/lshiftc.asm | 463 + gmp4/mpn/ia64/mod_34lsub1.asm | 236 + gmp4/mpn/ia64/mode1o.asm | 342 + gmp4/mpn/ia64/mul_1.asm | 584 + gmp4/mpn/ia64/mul_2.asm | 620 + gmp4/mpn/ia64/popcount.asm | 200 + gmp4/mpn/ia64/rsh1aors_n.asm | 447 + gmp4/mpn/ia64/sec_tabselect.asm | 150 + gmp4/mpn/ia64/sqr_diag_addlsh1.asm | 144 + gmp4/mpn/ia64/submul_1.asm | 647 + gmp4/mpn/lisp/gmpasm-mode.el | 385 + gmp4/mpn/m4-ccas | 107 + gmp4/mpn/m68k/README | 138 + gmp4/mpn/m68k/aors_n.asm | 99 + gmp4/mpn/m68k/gmp-mparam.h | 76 + gmp4/mpn/m68k/lshift.asm | 175 + gmp4/mpn/m68k/m68k-defs.m4 | 230 + gmp4/mpn/m68k/mc68020/aorsmul_1.asm | 101 + gmp4/mpn/m68k/mc68020/mul_1.asm | 96 + gmp4/mpn/m68k/mc68020/udiv.asm | 45 + gmp4/mpn/m68k/mc68020/umul.asm | 44 + gmp4/mpn/m68k/rshift.asm | 175 + gmp4/mpn/m68k/t-m68k-defs.pl | 91 + gmp4/mpn/m88k/README | 61 + gmp4/mpn/m88k/add_n.s | 113 + gmp4/mpn/m88k/mc88110/add_n.S | 209 + gmp4/mpn/m88k/mc88110/addmul_1.s | 70 + gmp4/mpn/m88k/mc88110/mul_1.s | 68 + gmp4/mpn/m88k/mc88110/sub_n.S | 285 + gmp4/mpn/m88k/mul_1.s | 136 + gmp4/mpn/m88k/sub_n.s | 115 + gmp4/mpn/minithres/gmp-mparam.h | 109 + gmp4/mpn/mips32/add_n.asm | 124 + gmp4/mpn/mips32/addmul_1.asm | 101 + gmp4/mpn/mips32/gmp-mparam.h | 72 + gmp4/mpn/mips32/lshift.asm | 99 + gmp4/mpn/mips32/mips-defs.m4 | 80 + gmp4/mpn/mips32/mips.m4 | 80 + gmp4/mpn/mips32/mul_1.asm | 89 + gmp4/mpn/mips32/rshift.asm | 96 + gmp4/mpn/mips32/sub_n.asm | 123 + gmp4/mpn/mips32/submul_1.asm | 101 + gmp4/mpn/mips32/umul.asm | 45 + gmp4/mpn/mips64/README | 60 + gmp4/mpn/mips64/add_n.asm | 134 + gmp4/mpn/mips64/addmul_1.asm | 101 + gmp4/mpn/mips64/gmp-mparam.h | 72 + gmp4/mpn/mips64/lshift.asm | 99 + gmp4/mpn/mips64/mul_1.asm | 92 + gmp4/mpn/mips64/rshift.asm | 96 + gmp4/mpn/mips64/sqr_diagonal.asm | 77 + gmp4/mpn/mips64/sub_n.asm | 134 + gmp4/mpn/mips64/submul_1.asm | 101 + gmp4/mpn/mips64/umul.asm | 45 + gmp4/mpn/pa32/README | 162 + gmp4/mpn/pa32/add_n.asm | 63 + gmp4/mpn/pa32/gmp-mparam.h | 61 + gmp4/mpn/pa32/hppa1_1/addmul_1.asm | 106 + gmp4/mpn/pa32/hppa1_1/gmp-mparam.h | 72 + gmp4/mpn/pa32/hppa1_1/mul_1.asm | 102 + gmp4/mpn/pa32/hppa1_1/pa7100/add_n.asm | 83 + gmp4/mpn/pa32/hppa1_1/pa7100/addmul_1.asm | 201 + gmp4/mpn/pa32/hppa1_1/pa7100/lshift.asm | 95 + gmp4/mpn/pa32/hppa1_1/pa7100/rshift.asm | 92 + gmp4/mpn/pa32/hppa1_1/pa7100/sub_n.asm | 84 + gmp4/mpn/pa32/hppa1_1/pa7100/submul_1.asm | 207 + gmp4/mpn/pa32/hppa1_1/sqr_diagonal.asm | 60 + gmp4/mpn/pa32/hppa1_1/submul_1.asm | 115 + gmp4/mpn/pa32/hppa1_1/udiv.asm | 102 + gmp4/mpn/pa32/hppa1_1/umul.asm | 47 + gmp4/mpn/pa32/hppa2_0/add_n.asm | 107 + gmp4/mpn/pa32/hppa2_0/gmp-mparam.h | 167 + gmp4/mpn/pa32/hppa2_0/sqr_diagonal.asm | 112 + gmp4/mpn/pa32/hppa2_0/sub_n.asm | 107 + gmp4/mpn/pa32/lshift.asm | 75 + gmp4/mpn/pa32/pa-defs.m4 | 64 + gmp4/mpn/pa32/rshift.asm | 72 + gmp4/mpn/pa32/sub_n.asm | 64 + gmp4/mpn/pa32/udiv.asm | 291 + gmp4/mpn/pa64/README | 78 + gmp4/mpn/pa64/addmul_1.asm | 693 + gmp4/mpn/pa64/aors_n.asm | 130 + gmp4/mpn/pa64/aorslsh1_n.asm | 228 + gmp4/mpn/pa64/gmp-mparam.h | 247 + gmp4/mpn/pa64/lshift.asm | 114 + gmp4/mpn/pa64/mul_1.asm | 646 + gmp4/mpn/pa64/rshift.asm | 111 + gmp4/mpn/pa64/sqr_diagonal.asm | 191 + gmp4/mpn/pa64/submul_1.asm | 700 + gmp4/mpn/pa64/udiv.asm | 125 + gmp4/mpn/pa64/umul.asm | 98 + gmp4/mpn/power/add_n.asm | 83 + gmp4/mpn/power/addmul_1.asm | 126 + gmp4/mpn/power/gmp-mparam.h | 69 + gmp4/mpn/power/lshift.asm | 61 + gmp4/mpn/power/mul_1.asm | 113 + gmp4/mpn/power/rshift.asm | 59 + gmp4/mpn/power/sdiv.asm | 39 + gmp4/mpn/power/sub_n.asm | 85 + gmp4/mpn/power/submul_1.asm | 131 + gmp4/mpn/power/umul.asm | 43 + gmp4/mpn/powerpc32/750/com.asm | 79 + gmp4/mpn/powerpc32/750/gmp-mparam.h | 192 + gmp4/mpn/powerpc32/750/lshift.asm | 155 + gmp4/mpn/powerpc32/750/rshift.asm | 153 + gmp4/mpn/powerpc32/README | 180 + gmp4/mpn/powerpc32/addlsh1_n.asm | 100 + gmp4/mpn/powerpc32/addmul_1.asm | 155 + gmp4/mpn/powerpc32/aix.m4 | 82 + gmp4/mpn/powerpc32/aors_n.asm | 157 + gmp4/mpn/powerpc32/bdiv_dbm1c.asm | 131 + gmp4/mpn/powerpc32/darwin.m4 | 91 + gmp4/mpn/powerpc32/diveby3.asm | 93 + gmp4/mpn/powerpc32/divrem_2.asm | 182 + gmp4/mpn/powerpc32/eabi.m4 | 86 + gmp4/mpn/powerpc32/elf.m4 | 97 + gmp4/mpn/powerpc32/gmp-mparam.h | 217 + gmp4/mpn/powerpc32/invert_limb.asm | 142 + gmp4/mpn/powerpc32/lshift.asm | 166 + gmp4/mpn/powerpc32/lshiftc.asm | 168 + gmp4/mpn/powerpc32/mod_34lsub1.asm | 145 + gmp4/mpn/powerpc32/mode1o.asm | 127 + gmp4/mpn/powerpc32/mul_1.asm | 101 + gmp4/mpn/powerpc32/p3-p7/aors_n.asm | 186 + gmp4/mpn/powerpc32/p3/gmp-mparam.h | 155 + gmp4/mpn/powerpc32/p4/gmp-mparam.h | 204 + gmp4/mpn/powerpc32/p5/gmp-mparam.h | 156 + gmp4/mpn/powerpc32/p6/gmp-mparam.h | 165 + gmp4/mpn/powerpc32/p7/gmp-mparam.h | 159 + gmp4/mpn/powerpc32/powerpc-defs.m4 | 104 + gmp4/mpn/powerpc32/rshift.asm | 164 + gmp4/mpn/powerpc32/sec_tabselect.asm | 141 + gmp4/mpn/powerpc32/sqr_diag_addlsh1.asm | 80 + gmp4/mpn/powerpc32/sublsh1_n.asm | 101 + gmp4/mpn/powerpc32/submul_1.asm | 147 + gmp4/mpn/powerpc32/umul.asm | 50 + gmp4/mpn/powerpc32/vmx/copyd.asm | 203 + gmp4/mpn/powerpc32/vmx/copyi.asm | 198 + gmp4/mpn/powerpc32/vmx/logops_n.asm | 310 + gmp4/mpn/powerpc32/vmx/mod_34lsub1.asm | 386 + gmp4/mpn/powerpc32/vmx/popcount.asm | 34 + gmp4/mpn/powerpc64/README | 166 + gmp4/mpn/powerpc64/aix.m4 | 97 + gmp4/mpn/powerpc64/com.asm | 136 + gmp4/mpn/powerpc64/copyd.asm | 84 + gmp4/mpn/powerpc64/copyi.asm | 78 + gmp4/mpn/powerpc64/darwin.m4 | 119 + gmp4/mpn/powerpc64/elf.m4 | 123 + gmp4/mpn/powerpc64/logops_n.asm | 151 + gmp4/mpn/powerpc64/lshift.asm | 207 + gmp4/mpn/powerpc64/lshiftc.asm | 210 + gmp4/mpn/powerpc64/mode32/add_n.asm | 86 + gmp4/mpn/powerpc64/mode32/addmul_1.asm | 79 + gmp4/mpn/powerpc64/mode32/mul_1.asm | 73 + gmp4/mpn/powerpc64/mode32/p4/gmp-mparam.h | 173 + gmp4/mpn/powerpc64/mode32/sqr_diagonal.asm | 117 + gmp4/mpn/powerpc64/mode32/sub_n.asm | 88 + gmp4/mpn/powerpc64/mode32/submul_1.asm | 82 + gmp4/mpn/powerpc64/mode64/aors_n.asm | 189 + gmp4/mpn/powerpc64/mode64/aorsmul_1.asm | 225 + gmp4/mpn/powerpc64/mode64/aorsorrlsh1_n.asm | 43 + gmp4/mpn/powerpc64/mode64/aorsorrlsh2_n.asm | 43 + gmp4/mpn/powerpc64/mode64/aorsorrlshC_n.asm | 187 + gmp4/mpn/powerpc64/mode64/bdiv_dbm1c.asm | 132 + gmp4/mpn/powerpc64/mode64/cnd_aors_n.asm | 196 + gmp4/mpn/powerpc64/mode64/dive_1.asm | 132 + gmp4/mpn/powerpc64/mode64/divrem_1.asm | 274 + gmp4/mpn/powerpc64/mode64/divrem_2.asm | 187 + gmp4/mpn/powerpc64/mode64/gcd_1.asm | 125 + gmp4/mpn/powerpc64/mode64/gmp-mparam.h | 82 + gmp4/mpn/powerpc64/mode64/invert_limb.asm | 88 + gmp4/mpn/powerpc64/mode64/mod_1_1.asm | 164 + gmp4/mpn/powerpc64/mode64/mod_1_4.asm | 270 + gmp4/mpn/powerpc64/mode64/mod_34lsub1.asm | 132 + gmp4/mpn/powerpc64/mode64/mode1o.asm | 117 + gmp4/mpn/powerpc64/mode64/mul_1.asm | 168 + gmp4/mpn/powerpc64/mode64/mul_basecase.asm | 708 + gmp4/mpn/powerpc64/mode64/p3/gmp-mparam.h | 179 + gmp4/mpn/powerpc64/mode64/p4/gmp-mparam.h | 208 + gmp4/mpn/powerpc64/mode64/p5/gmp-mparam.h | 219 + gmp4/mpn/powerpc64/mode64/p6/aorsmul_1.asm | 183 + gmp4/mpn/powerpc64/mode64/p6/gmp-mparam.h | 160 + gmp4/mpn/powerpc64/mode64/p6/mul_basecase.asm | 589 + gmp4/mpn/powerpc64/mode64/p7/aormul_2.asm | 135 + gmp4/mpn/powerpc64/mode64/p7/aors_n.asm | 128 + .../mpn/powerpc64/mode64/p7/aorsorrlsh1_n.asm | 43 + .../mpn/powerpc64/mode64/p7/aorsorrlsh2_n.asm | 43 + .../mpn/powerpc64/mode64/p7/aorsorrlshC_n.asm | 129 + gmp4/mpn/powerpc64/mode64/p7/gcd_1.asm | 110 + gmp4/mpn/powerpc64/mode64/p7/gmp-mparam.h | 243 + gmp4/mpn/powerpc64/mode64/rsh1aors_n.asm | 172 + gmp4/mpn/powerpc64/mode64/sqr_basecase.asm | 863 + gmp4/mpn/powerpc64/p6/lshift.asm | 132 + gmp4/mpn/powerpc64/p6/lshiftc.asm | 136 + gmp4/mpn/powerpc64/p6/rshift.asm | 131 + gmp4/mpn/powerpc64/p7/copyd.asm | 128 + gmp4/mpn/powerpc64/p7/copyi.asm | 129 + gmp4/mpn/powerpc64/p7/hamdist.asm | 110 + gmp4/mpn/powerpc64/p7/popcount.asm | 90 + gmp4/mpn/powerpc64/rshift.asm | 207 + gmp4/mpn/powerpc64/sec_tabselect.asm | 147 + gmp4/mpn/powerpc64/umul.asm | 53 + gmp4/mpn/powerpc64/vmx/popcount.asm | 230 + gmp4/mpn/s390_32/README | 37 + gmp4/mpn/s390_32/addmul_1.asm | 93 + gmp4/mpn/s390_32/copyd.asm | 145 + gmp4/mpn/s390_32/copyi.asm | 69 + gmp4/mpn/s390_32/esame/addmul_1.asm | 72 + gmp4/mpn/s390_32/esame/aors_n.asm | 137 + gmp4/mpn/s390_32/esame/aorslsh1_n.asm | 173 + gmp4/mpn/s390_32/esame/bdiv_dbm1c.asm | 65 + gmp4/mpn/s390_32/esame/gmp-mparam.h | 207 + gmp4/mpn/s390_32/esame/mul_1.asm | 66 + gmp4/mpn/s390_32/esame/mul_basecase.asm | 130 + gmp4/mpn/s390_32/esame/sqr_basecase.asm | 203 + gmp4/mpn/s390_32/esame/submul_1.asm | 70 + gmp4/mpn/s390_32/gmp-mparam.h | 138 + gmp4/mpn/s390_32/logops_n.asm | 295 + gmp4/mpn/s390_32/lshift.asm | 144 + gmp4/mpn/s390_32/lshiftc.asm | 156 + gmp4/mpn/s390_32/mul_1.asm | 85 + gmp4/mpn/s390_32/rshift.asm | 138 + gmp4/mpn/s390_32/submul_1.asm | 93 + gmp4/mpn/s390_64/README | 88 + gmp4/mpn/s390_64/addmul_1.asm | 72 + gmp4/mpn/s390_64/aorrlsh1_n.asm | 168 + gmp4/mpn/s390_64/aors_n.asm | 136 + gmp4/mpn/s390_64/bdiv_dbm1c.asm | 65 + gmp4/mpn/s390_64/copyd.asm | 144 + gmp4/mpn/s390_64/copyi.asm | 68 + gmp4/mpn/s390_64/gmp-mparam.h | 175 + gmp4/mpn/s390_64/invert_limb.asm | 94 + gmp4/mpn/s390_64/logops_n.asm | 291 + gmp4/mpn/s390_64/lshift.asm | 196 + gmp4/mpn/s390_64/lshiftc.asm | 207 + gmp4/mpn/s390_64/mod_34lsub1.asm | 109 + gmp4/mpn/s390_64/mul_1.asm | 66 + gmp4/mpn/s390_64/mul_basecase.asm | 130 + gmp4/mpn/s390_64/rshift.asm | 195 + gmp4/mpn/s390_64/sqr_basecase.asm | 203 + gmp4/mpn/s390_64/sublsh1_n.asm | 169 + gmp4/mpn/s390_64/submul_1.asm | 70 + gmp4/mpn/s390_64/z10/gmp-mparam.h | 231 + gmp4/mpn/sh/add_n.asm | 59 + gmp4/mpn/sh/sh2/addmul_1.asm | 65 + gmp4/mpn/sh/sh2/mul_1.asm | 62 + gmp4/mpn/sh/sh2/submul_1.asm | 65 + gmp4/mpn/sh/sub_n.asm | 59 + gmp4/mpn/sparc32/README | 71 + gmp4/mpn/sparc32/add_n.asm | 245 + gmp4/mpn/sparc32/addmul_1.asm | 155 + gmp4/mpn/sparc32/gmp-mparam.h | 67 + gmp4/mpn/sparc32/lshift.asm | 105 + gmp4/mpn/sparc32/mul_1.asm | 146 + gmp4/mpn/sparc32/rshift.asm | 102 + gmp4/mpn/sparc32/sparc-defs.m4 | 79 + gmp4/mpn/sparc32/sub_n.asm | 335 + gmp4/mpn/sparc32/submul_1.asm | 155 + gmp4/mpn/sparc32/udiv.asm | 167 + gmp4/mpn/sparc32/udiv_nfp.asm | 202 + gmp4/mpn/sparc32/ultrasparct1/add_n.asm | 70 + gmp4/mpn/sparc32/ultrasparct1/addmul_1.asm | 90 + gmp4/mpn/sparc32/ultrasparct1/gmp-mparam.h | 153 + gmp4/mpn/sparc32/ultrasparct1/mul_1.asm | 83 + .../mpn/sparc32/ultrasparct1/sqr_diagonal.asm | 55 + gmp4/mpn/sparc32/ultrasparct1/sub_n.asm | 70 + gmp4/mpn/sparc32/ultrasparct1/submul_1.asm | 91 + gmp4/mpn/sparc32/umul.asm | 77 + gmp4/mpn/sparc32/v8/addmul_1.asm | 131 + gmp4/mpn/sparc32/v8/gmp-mparam.h | 73 + gmp4/mpn/sparc32/v8/mul_1.asm | 112 + gmp4/mpn/sparc32/v8/submul_1.asm | 67 + gmp4/mpn/sparc32/v8/supersparc/gmp-mparam.h | 73 + gmp4/mpn/sparc32/v8/supersparc/udiv.asm | 131 + gmp4/mpn/sparc32/v8/udiv.asm | 131 + gmp4/mpn/sparc32/v8/umul.asm | 40 + gmp4/mpn/sparc32/v9/README | 4 + gmp4/mpn/sparc32/v9/add_n.asm | 129 + gmp4/mpn/sparc32/v9/addmul_1.asm | 306 + gmp4/mpn/sparc32/v9/gmp-mparam.h | 204 + gmp4/mpn/sparc32/v9/mul_1.asm | 287 + gmp4/mpn/sparc32/v9/sqr_diagonal.asm | 462 + gmp4/mpn/sparc32/v9/sub_n.asm | 129 + gmp4/mpn/sparc32/v9/submul_1.asm | 316 + gmp4/mpn/sparc32/v9/udiv.asm | 52 + gmp4/mpn/sparc64/README | 125 + gmp4/mpn/sparc64/copyd.asm | 89 + gmp4/mpn/sparc64/copyi.asm | 86 + gmp4/mpn/sparc64/dive_1.c | 158 + gmp4/mpn/sparc64/divrem_1.c | 243 + gmp4/mpn/sparc64/gcd_1.asm | 135 + gmp4/mpn/sparc64/gmp-mparam.h | 139 + gmp4/mpn/sparc64/lshift.asm | 140 + gmp4/mpn/sparc64/lshiftc.asm | 147 + gmp4/mpn/sparc64/mod_1.c | 239 + gmp4/mpn/sparc64/mod_1_4.c | 236 + gmp4/mpn/sparc64/mode1o.c | 197 + gmp4/mpn/sparc64/rshift.asm | 142 + gmp4/mpn/sparc64/sec_tabselect.asm | 162 + gmp4/mpn/sparc64/sparc64.h | 219 + gmp4/mpn/sparc64/ultrasparc1234/add_n.asm | 241 + gmp4/mpn/sparc64/ultrasparc1234/addmul_1.asm | 606 + gmp4/mpn/sparc64/ultrasparc1234/addmul_2.asm | 551 + gmp4/mpn/sparc64/ultrasparc1234/lshiftc.asm | 165 + gmp4/mpn/sparc64/ultrasparc1234/mul_1.asm | 580 + .../sparc64/ultrasparc1234/sqr_diagonal.asm | 342 + gmp4/mpn/sparc64/ultrasparc1234/sub_n.asm | 241 + gmp4/mpn/sparc64/ultrasparc1234/submul_1.asm | 68 + gmp4/mpn/sparc64/ultrasparc34/gmp-mparam.h | 219 + gmp4/mpn/sparc64/ultrasparct1/add_n.asm | 68 + gmp4/mpn/sparc64/ultrasparct1/addlsh1_n.asm | 41 + gmp4/mpn/sparc64/ultrasparct1/addlsh2_n.asm | 41 + gmp4/mpn/sparc64/ultrasparct1/addlshC_n.asm | 69 + gmp4/mpn/sparc64/ultrasparct1/addmul_1.asm | 86 + gmp4/mpn/sparc64/ultrasparct1/gmp-mparam.h | 154 + gmp4/mpn/sparc64/ultrasparct1/mul_1.asm | 82 + gmp4/mpn/sparc64/ultrasparct1/rsblsh1_n.asm | 41 + gmp4/mpn/sparc64/ultrasparct1/rsblsh2_n.asm | 41 + gmp4/mpn/sparc64/ultrasparct1/rsblshC_n.asm | 69 + gmp4/mpn/sparc64/ultrasparct1/sub_n.asm | 68 + gmp4/mpn/sparc64/ultrasparct1/sublsh1_n.asm | 41 + gmp4/mpn/sparc64/ultrasparct1/sublsh2_n.asm | 41 + gmp4/mpn/sparc64/ultrasparct1/sublshC_n.asm | 69 + gmp4/mpn/sparc64/ultrasparct1/submul_1.asm | 86 + gmp4/mpn/sparc64/ultrasparct3/add_n.asm | 126 + gmp4/mpn/sparc64/ultrasparct3/addmul_1.asm | 182 + gmp4/mpn/sparc64/ultrasparct3/aormul_2.asm | 228 + gmp4/mpn/sparc64/ultrasparct3/aormul_4.asm | 219 + gmp4/mpn/sparc64/ultrasparct3/aorslsh_n.asm | 147 + gmp4/mpn/sparc64/ultrasparct3/bdiv_dbm1c.asm | 147 + gmp4/mpn/sparc64/ultrasparct3/cnd_aors_n.asm | 143 + gmp4/mpn/sparc64/ultrasparct3/dive_1.asm | 129 + gmp4/mpn/sparc64/ultrasparct3/hamdist.asm | 78 + gmp4/mpn/sparc64/ultrasparct3/invert_limb.asm | 92 + gmp4/mpn/sparc64/ultrasparct3/missing.asm | 77 + gmp4/mpn/sparc64/ultrasparct3/missing.m4 | 88 + gmp4/mpn/sparc64/ultrasparct3/mod_1_4.asm | 233 + gmp4/mpn/sparc64/ultrasparct3/mod_34lsub1.asm | 117 + gmp4/mpn/sparc64/ultrasparct3/mode1o.asm | 82 + gmp4/mpn/sparc64/ultrasparct3/mul_1.asm | 174 + gmp4/mpn/sparc64/ultrasparct3/popcount.asm | 70 + .../sparc64/ultrasparct3/sqr_diag_addlsh1.asm | 93 + gmp4/mpn/sparc64/ultrasparct3/sub_n.asm | 144 + gmp4/mpn/sparc64/ultrasparct3/submul_1.asm | 170 + gmp4/mpn/thumb/add_n.asm | 63 + gmp4/mpn/thumb/sub_n.asm | 63 + gmp4/mpn/vax/add_n.asm | 64 + gmp4/mpn/vax/addmul_1.asm | 124 + gmp4/mpn/vax/elf.m4 | 54 + gmp4/mpn/vax/gmp-mparam.h | 60 + gmp4/mpn/vax/lshift.asm | 59 + gmp4/mpn/vax/mul_1.asm | 118 + gmp4/mpn/vax/rshift.asm | 57 + gmp4/mpn/vax/sub_n.asm | 64 + gmp4/mpn/vax/submul_1.asm | 124 + gmp4/mpn/x86/README | 525 + gmp4/mpn/x86/aors_n.asm | 202 + gmp4/mpn/x86/aorsmul_1.asm | 156 + gmp4/mpn/x86/atom/aorrlsh1_n.asm | 53 + gmp4/mpn/x86/atom/aorrlsh2_n.asm | 53 + gmp4/mpn/x86/atom/aorrlshC_n.asm | 156 + gmp4/mpn/x86/atom/aors_n.asm | 159 + gmp4/mpn/x86/atom/aorslshC_n.asm | 247 + gmp4/mpn/x86/atom/bdiv_q_1.asm | 35 + gmp4/mpn/x86/atom/cnd_add_n.asm | 113 + gmp4/mpn/x86/atom/cnd_sub_n.asm | 124 + gmp4/mpn/x86/atom/dive_1.asm | 34 + gmp4/mpn/x86/atom/gmp-mparam.h | 201 + gmp4/mpn/x86/atom/logops_n.asm | 151 + gmp4/mpn/x86/atom/lshift.asm | 218 + gmp4/mpn/x86/atom/lshiftc.asm | 159 + gmp4/mpn/x86/atom/mmx/copyd.asm | 34 + gmp4/mpn/x86/atom/mmx/copyi.asm | 34 + gmp4/mpn/x86/atom/mmx/hamdist.asm | 34 + gmp4/mpn/x86/atom/mod_34lsub1.asm | 34 + gmp4/mpn/x86/atom/mode1o.asm | 34 + gmp4/mpn/x86/atom/rshift.asm | 152 + gmp4/mpn/x86/atom/sse2/aorsmul_1.asm | 174 + gmp4/mpn/x86/atom/sse2/bdiv_dbm1c.asm | 34 + gmp4/mpn/x86/atom/sse2/divrem_1.asm | 34 + gmp4/mpn/x86/atom/sse2/mod_1_1.asm | 34 + gmp4/mpn/x86/atom/sse2/mod_1_4.asm | 34 + gmp4/mpn/x86/atom/sse2/mul_1.asm | 124 + gmp4/mpn/x86/atom/sse2/mul_basecase.asm | 501 + gmp4/mpn/x86/atom/sse2/popcount.asm | 35 + gmp4/mpn/x86/atom/sse2/sqr_basecase.asm | 634 + gmp4/mpn/x86/atom/sublsh1_n.asm | 34 + gmp4/mpn/x86/atom/sublsh2_n.asm | 57 + gmp4/mpn/x86/bd1/gmp-mparam.h | 208 + gmp4/mpn/x86/bd2/gmp-mparam.h | 209 + gmp4/mpn/x86/bdiv_dbm1c.asm | 129 + gmp4/mpn/x86/bdiv_q_1.asm | 208 + gmp4/mpn/x86/bobcat/gmp-mparam.h | 197 + gmp4/mpn/x86/cnd_aors_n.asm | 124 + gmp4/mpn/x86/copyd.asm | 91 + gmp4/mpn/x86/copyi.asm | 99 + gmp4/mpn/x86/core2/gmp-mparam.h | 200 + gmp4/mpn/x86/coreihwl/gmp-mparam.h | 210 + gmp4/mpn/x86/coreinhm/gmp-mparam.h | 224 + gmp4/mpn/x86/coreisbr/gmp-mparam.h | 203 + gmp4/mpn/x86/darwin.m4 | 82 + gmp4/mpn/x86/dive_1.asm | 189 + gmp4/mpn/x86/divrem_1.asm | 233 + gmp4/mpn/x86/divrem_2.asm | 199 + gmp4/mpn/x86/fat/com.c | 32 + gmp4/mpn/x86/fat/fat.c | 473 + gmp4/mpn/x86/fat/fat_entry.asm | 220 + gmp4/mpn/x86/fat/gcd_1.c | 32 + gmp4/mpn/x86/fat/gmp-mparam.h | 71 + gmp4/mpn/x86/fat/lshiftc.c | 32 + gmp4/mpn/x86/fat/mod_1.c | 32 + gmp4/mpn/x86/fat/mod_1_1.c | 36 + gmp4/mpn/x86/fat/mod_1_2.c | 36 + gmp4/mpn/x86/fat/mod_1_4.c | 36 + gmp4/mpn/x86/fat/mode1o.c | 32 + gmp4/mpn/x86/fat/mullo_basecase.c | 32 + gmp4/mpn/x86/fat/redc_1.c | 32 + gmp4/mpn/x86/fat/redc_2.c | 32 + gmp4/mpn/x86/geode/gmp-mparam.h | 141 + gmp4/mpn/x86/gmp-mparam.h | 38 + gmp4/mpn/x86/i486/gmp-mparam.h | 69 + gmp4/mpn/x86/k10/gmp-mparam.h | 211 + gmp4/mpn/x86/k6/README | 251 + gmp4/mpn/x86/k6/aors_n.asm | 337 + gmp4/mpn/x86/k6/aorsmul_1.asm | 391 + gmp4/mpn/x86/k6/cross.pl | 182 + gmp4/mpn/x86/k6/divrem_1.asm | 203 + gmp4/mpn/x86/k6/gcd_1.asm | 362 + gmp4/mpn/x86/k6/gmp-mparam.h | 166 + gmp4/mpn/x86/k6/k62mmx/copyd.asm | 118 + gmp4/mpn/x86/k6/k62mmx/lshift.asm | 294 + gmp4/mpn/x86/k6/k62mmx/rshift.asm | 293 + gmp4/mpn/x86/k6/mmx/com.asm | 103 + gmp4/mpn/x86/k6/mmx/dive_1.asm | 281 + gmp4/mpn/x86/k6/mmx/logops_n.asm | 226 + gmp4/mpn/x86/k6/mmx/lshift.asm | 130 + gmp4/mpn/x86/k6/mmx/popham.asm | 236 + gmp4/mpn/x86/k6/mmx/rshift.asm | 130 + gmp4/mpn/x86/k6/mod_34lsub1.asm | 190 + gmp4/mpn/x86/k6/mode1o.asm | 175 + gmp4/mpn/x86/k6/mul_1.asm | 292 + gmp4/mpn/x86/k6/mul_basecase.asm | 612 + gmp4/mpn/x86/k6/pre_mod_1.asm | 146 + gmp4/mpn/x86/k6/sqr_basecase.asm | 680 + gmp4/mpn/x86/k7/README | 174 + gmp4/mpn/x86/k7/addlsh1_n.asm | 196 + gmp4/mpn/x86/k7/aors_n.asm | 258 + gmp4/mpn/x86/k7/aorsmul_1.asm | 167 + gmp4/mpn/x86/k7/bdiv_q_1.asm | 244 + gmp4/mpn/x86/k7/dive_1.asm | 207 + gmp4/mpn/x86/k7/gcd_1.asm | 186 + gmp4/mpn/x86/k7/gmp-mparam.h | 241 + gmp4/mpn/x86/k7/invert_limb.asm | 193 + gmp4/mpn/x86/k7/mmx/com.asm | 125 + gmp4/mpn/x86/k7/mmx/copyd.asm | 144 + gmp4/mpn/x86/k7/mmx/copyi.asm | 157 + gmp4/mpn/x86/k7/mmx/divrem_1.asm | 832 + gmp4/mpn/x86/k7/mmx/lshift.asm | 481 + gmp4/mpn/x86/k7/mmx/popham.asm | 213 + gmp4/mpn/x86/k7/mmx/rshift.asm | 480 + gmp4/mpn/x86/k7/mod_1_1.asm | 221 + gmp4/mpn/x86/k7/mod_1_4.asm | 260 + gmp4/mpn/x86/k7/mod_34lsub1.asm | 188 + gmp4/mpn/x86/k7/mode1o.asm | 180 + gmp4/mpn/x86/k7/mul_1.asm | 237 + gmp4/mpn/x86/k7/mul_basecase.asm | 602 + gmp4/mpn/x86/k7/sqr_basecase.asm | 635 + gmp4/mpn/x86/k7/sublsh1_n.asm | 173 + gmp4/mpn/x86/k8/gmp-mparam.h | 198 + gmp4/mpn/x86/lshift.asm | 106 + gmp4/mpn/x86/mmx/sec_tabselect.asm | 163 + gmp4/mpn/x86/mod_34lsub1.asm | 183 + gmp4/mpn/x86/mul_1.asm | 140 + gmp4/mpn/x86/mul_basecase.asm | 223 + gmp4/mpn/x86/nano/gmp-mparam.h | 162 + gmp4/mpn/x86/p6/README | 125 + gmp4/mpn/x86/p6/aors_n.asm | 156 + gmp4/mpn/x86/p6/aorsmul_1.asm | 320 + gmp4/mpn/x86/p6/bdiv_q_1.asm | 286 + gmp4/mpn/x86/p6/copyd.asm | 178 + gmp4/mpn/x86/p6/dive_1.asm | 266 + gmp4/mpn/x86/p6/gcd_1.asm | 156 + gmp4/mpn/x86/p6/gmp-mparam.h | 194 + gmp4/mpn/x86/p6/lshsub_n.asm | 169 + gmp4/mpn/x86/p6/mmx/divrem_1.asm | 767 + gmp4/mpn/x86/p6/mmx/gmp-mparam.h | 198 + gmp4/mpn/x86/p6/mmx/lshift.asm | 38 + gmp4/mpn/x86/p6/mmx/popham.asm | 39 + gmp4/mpn/x86/p6/mmx/rshift.asm | 38 + gmp4/mpn/x86/p6/mod_34lsub1.asm | 190 + gmp4/mpn/x86/p6/mode1o.asm | 169 + gmp4/mpn/x86/p6/mul_basecase.asm | 607 + gmp4/mpn/x86/p6/p3mmx/popham.asm | 42 + gmp4/mpn/x86/p6/sqr_basecase.asm | 649 + gmp4/mpn/x86/p6/sse2/addmul_1.asm | 37 + gmp4/mpn/x86/p6/sse2/gmp-mparam.h | 197 + gmp4/mpn/x86/p6/sse2/mod_1_1.asm | 34 + gmp4/mpn/x86/p6/sse2/mod_1_4.asm | 34 + gmp4/mpn/x86/p6/sse2/mul_1.asm | 38 + gmp4/mpn/x86/p6/sse2/mul_basecase.asm | 35 + gmp4/mpn/x86/p6/sse2/popcount.asm | 35 + gmp4/mpn/x86/p6/sse2/sqr_basecase.asm | 35 + gmp4/mpn/x86/p6/sse2/submul_1.asm | 35 + gmp4/mpn/x86/pentium/README | 181 + gmp4/mpn/x86/pentium/aors_n.asm | 203 + gmp4/mpn/x86/pentium/aorsmul_1.asm | 144 + gmp4/mpn/x86/pentium/bdiv_q_1.asm | 260 + gmp4/mpn/x86/pentium/com.asm | 181 + gmp4/mpn/x86/pentium/copyd.asm | 146 + gmp4/mpn/x86/pentium/copyi.asm | 164 + gmp4/mpn/x86/pentium/dive_1.asm | 272 + gmp4/mpn/x86/pentium/gmp-mparam.h | 76 + gmp4/mpn/x86/pentium/hamdist.asm | 143 + gmp4/mpn/x86/pentium/logops_n.asm | 176 + gmp4/mpn/x86/pentium/lshift.asm | 243 + gmp4/mpn/x86/pentium/mmx/gmp-mparam.h | 163 + gmp4/mpn/x86/pentium/mmx/hamdist.asm | 40 + gmp4/mpn/x86/pentium/mmx/lshift.asm | 463 + gmp4/mpn/x86/pentium/mmx/mul_1.asm | 371 + gmp4/mpn/x86/pentium/mmx/rshift.asm | 468 + gmp4/mpn/x86/pentium/mod_34lsub1.asm | 192 + gmp4/mpn/x86/pentium/mode1o.asm | 266 + gmp4/mpn/x86/pentium/mul_1.asm | 177 + gmp4/mpn/x86/pentium/mul_2.asm | 150 + gmp4/mpn/x86/pentium/mul_basecase.asm | 143 + gmp4/mpn/x86/pentium/popcount.asm | 134 + gmp4/mpn/x86/pentium/rshift.asm | 243 + gmp4/mpn/x86/pentium/sqr_basecase.asm | 528 + gmp4/mpn/x86/pentium4/README | 124 + gmp4/mpn/x86/pentium4/copyd.asm | 71 + gmp4/mpn/x86/pentium4/copyi.asm | 93 + gmp4/mpn/x86/pentium4/mmx/lshift.asm | 39 + gmp4/mpn/x86/pentium4/mmx/popham.asm | 203 + gmp4/mpn/x86/pentium4/mmx/rshift.asm | 39 + gmp4/mpn/x86/pentium4/sse2/add_n.asm | 101 + gmp4/mpn/x86/pentium4/sse2/addlsh1_n.asm | 108 + gmp4/mpn/x86/pentium4/sse2/addmul_1.asm | 189 + gmp4/mpn/x86/pentium4/sse2/bdiv_dbm1c.asm | 141 + gmp4/mpn/x86/pentium4/sse2/bdiv_q_1.asm | 233 + gmp4/mpn/x86/pentium4/sse2/cnd_add_n.asm | 95 + gmp4/mpn/x86/pentium4/sse2/cnd_sub_n.asm | 114 + gmp4/mpn/x86/pentium4/sse2/dive_1.asm | 215 + gmp4/mpn/x86/pentium4/sse2/divrem_1.asm | 645 + gmp4/mpn/x86/pentium4/sse2/gmp-mparam.h | 206 + gmp4/mpn/x86/pentium4/sse2/mod_1_1.asm | 166 + gmp4/mpn/x86/pentium4/sse2/mod_1_4.asm | 269 + gmp4/mpn/x86/pentium4/sse2/mod_34lsub1.asm | 175 + gmp4/mpn/x86/pentium4/sse2/mode1o.asm | 174 + gmp4/mpn/x86/pentium4/sse2/mul_1.asm | 164 + gmp4/mpn/x86/pentium4/sse2/mul_basecase.asm | 662 + gmp4/mpn/x86/pentium4/sse2/popcount.asm | 280 + gmp4/mpn/x86/pentium4/sse2/rsh1add_n.asm | 126 + gmp4/mpn/x86/pentium4/sse2/sqr_basecase.asm | 705 + gmp4/mpn/x86/pentium4/sse2/sub_n.asm | 119 + gmp4/mpn/x86/pentium4/sse2/submul_1.asm | 182 + gmp4/mpn/x86/rshift.asm | 108 + gmp4/mpn/x86/sec_tabselect.asm | 115 + gmp4/mpn/x86/sqr_basecase.asm | 359 + gmp4/mpn/x86/t-zdisp.sh | 71 + gmp4/mpn/x86/t-zdisp2.pl | 147 + gmp4/mpn/x86/udiv.asm | 52 + gmp4/mpn/x86/umul.asm | 51 + gmp4/mpn/x86/x86-defs.m4 | 999 + gmp4/mpn/x86_64/README | 74 + gmp4/mpn/x86_64/addaddmul_1msb0.asm | 170 + gmp4/mpn/x86_64/addmul_2.asm | 184 + gmp4/mpn/x86_64/aorrlsh1_n.asm | 170 + gmp4/mpn/x86_64/aorrlsh2_n.asm | 53 + gmp4/mpn/x86_64/aorrlshC_n.asm | 160 + gmp4/mpn/x86_64/aorrlsh_n.asm | 176 + gmp4/mpn/x86_64/aors_err1_n.asm | 225 + gmp4/mpn/x86_64/aors_err2_n.asm | 172 + gmp4/mpn/x86_64/aors_err3_n.asm | 156 + gmp4/mpn/x86_64/aors_n.asm | 169 + gmp4/mpn/x86_64/aorsmul_1.asm | 180 + gmp4/mpn/x86_64/atom/addmul_2.asm | 186 + gmp4/mpn/x86_64/atom/aorrlsh1_n.asm | 238 + gmp4/mpn/x86_64/atom/aorrlsh2_n.asm | 191 + gmp4/mpn/x86_64/atom/aors_n.asm | 37 + gmp4/mpn/x86_64/atom/aorsmul_1.asm | 190 + gmp4/mpn/x86_64/atom/com.asm | 37 + gmp4/mpn/x86_64/atom/copyd.asm | 37 + gmp4/mpn/x86_64/atom/copyi.asm | 37 + gmp4/mpn/x86_64/atom/dive_1.asm | 37 + gmp4/mpn/x86_64/atom/gmp-mparam.h | 220 + gmp4/mpn/x86_64/atom/lshift.asm | 123 + gmp4/mpn/x86_64/atom/lshiftc.asm | 127 + gmp4/mpn/x86_64/atom/mul_1.asm | 143 + gmp4/mpn/x86_64/atom/mul_2.asm | 186 + gmp4/mpn/x86_64/atom/popcount.asm | 35 + gmp4/mpn/x86_64/atom/redc_1.asm | 574 + gmp4/mpn/x86_64/atom/rsh1aors_n.asm | 287 + gmp4/mpn/x86_64/atom/rshift.asm | 121 + gmp4/mpn/x86_64/atom/sublsh1_n.asm | 242 + gmp4/mpn/x86_64/bd1/README | 11 + gmp4/mpn/x86_64/bd1/aorrlsh1_n.asm | 37 + gmp4/mpn/x86_64/bd1/aorsmul_1.asm | 181 + gmp4/mpn/x86_64/bd1/com.asm | 37 + gmp4/mpn/x86_64/bd1/copyd.asm | 37 + gmp4/mpn/x86_64/bd1/copyi.asm | 37 + gmp4/mpn/x86_64/bd1/gcd_1.asm | 37 + gmp4/mpn/x86_64/bd1/gmp-mparam.h | 236 + gmp4/mpn/x86_64/bd1/hamdist.asm | 38 + gmp4/mpn/x86_64/bd1/mul_1.asm | 184 + gmp4/mpn/x86_64/bd1/mul_2.asm | 192 + gmp4/mpn/x86_64/bd1/mul_basecase.asm | 416 + gmp4/mpn/x86_64/bd1/popcount.asm | 38 + gmp4/mpn/x86_64/bd1/sec_tabselect.asm | 37 + gmp4/mpn/x86_64/bd1/sublsh1_n.asm | 37 + gmp4/mpn/x86_64/bd2/gmp-mparam.h | 237 + gmp4/mpn/x86_64/bdiv_dbm1c.asm | 106 + gmp4/mpn/x86_64/bdiv_q_1.asm | 167 + gmp4/mpn/x86_64/bobcat/aors_n.asm | 150 + gmp4/mpn/x86_64/bobcat/aorsmul_1.asm | 183 + gmp4/mpn/x86_64/bobcat/copyd.asm | 91 + gmp4/mpn/x86_64/bobcat/copyi.asm | 94 + gmp4/mpn/x86_64/bobcat/gmp-mparam.h | 208 + gmp4/mpn/x86_64/bobcat/mul_1.asm | 187 + gmp4/mpn/x86_64/bobcat/mul_basecase.asm | 486 + gmp4/mpn/x86_64/bobcat/redc_1.asm | 502 + gmp4/mpn/x86_64/bobcat/sqr_basecase.asm | 565 + gmp4/mpn/x86_64/cnd_aors_n.asm | 183 + gmp4/mpn/x86_64/com.asm | 95 + gmp4/mpn/x86_64/copyd.asm | 93 + gmp4/mpn/x86_64/copyi.asm | 92 + gmp4/mpn/x86_64/core2/aorrlsh1_n.asm | 53 + gmp4/mpn/x86_64/core2/aorrlsh2_n.asm | 53 + gmp4/mpn/x86_64/core2/aorrlsh_n.asm | 38 + gmp4/mpn/x86_64/core2/aors_err1_n.asm | 225 + gmp4/mpn/x86_64/core2/aors_n.asm | 141 + gmp4/mpn/x86_64/core2/aorsmul_1.asm | 178 + gmp4/mpn/x86_64/core2/copyd.asm | 37 + gmp4/mpn/x86_64/core2/copyi.asm | 37 + gmp4/mpn/x86_64/core2/divrem_1.asm | 237 + gmp4/mpn/x86_64/core2/gcd_1.asm | 144 + gmp4/mpn/x86_64/core2/gmp-mparam.h | 217 + gmp4/mpn/x86_64/core2/lshift.asm | 149 + gmp4/mpn/x86_64/core2/lshiftc.asm | 159 + gmp4/mpn/x86_64/core2/mul_basecase.asm | 975 + gmp4/mpn/x86_64/core2/mullo_basecase.asm | 427 + gmp4/mpn/x86_64/core2/popcount.asm | 35 + gmp4/mpn/x86_64/core2/redc_1.asm | 425 + gmp4/mpn/x86_64/core2/rsh1aors_n.asm | 169 + gmp4/mpn/x86_64/core2/rshift.asm | 147 + gmp4/mpn/x86_64/core2/sec_tabselect.asm | 37 + gmp4/mpn/x86_64/core2/sqr_basecase.asm | 984 + gmp4/mpn/x86_64/core2/sublsh1_n.asm | 47 + gmp4/mpn/x86_64/core2/sublsh2_n.asm | 47 + gmp4/mpn/x86_64/core2/sublshC_n.asm | 158 + gmp4/mpn/x86_64/coreihwl/addmul_2.asm | 238 + gmp4/mpn/x86_64/coreihwl/aorsmul_1.asm | 198 + gmp4/mpn/x86_64/coreihwl/gmp-mparam.h | 237 + gmp4/mpn/x86_64/coreihwl/mul_1.asm | 155 + gmp4/mpn/x86_64/coreihwl/mul_2.asm | 173 + gmp4/mpn/x86_64/coreihwl/mul_basecase.asm | 441 + gmp4/mpn/x86_64/coreihwl/mullo_basecase.asm | 426 + gmp4/mpn/x86_64/coreihwl/redc_1.asm | 433 + gmp4/mpn/x86_64/coreihwl/sqr_basecase.asm | 506 + gmp4/mpn/x86_64/coreinhm/aorrlsh_n.asm | 200 + gmp4/mpn/x86_64/coreinhm/aorsmul_1.asm | 187 + gmp4/mpn/x86_64/coreinhm/gmp-mparam.h | 231 + gmp4/mpn/x86_64/coreinhm/hamdist.asm | 38 + gmp4/mpn/x86_64/coreinhm/popcount.asm | 38 + gmp4/mpn/x86_64/coreinhm/redc_1.asm | 544 + gmp4/mpn/x86_64/coreinhm/sec_tabselect.asm | 37 + gmp4/mpn/x86_64/coreisbr/addmul_2.asm | 224 + gmp4/mpn/x86_64/coreisbr/aorrlsh1_n.asm | 54 + gmp4/mpn/x86_64/coreisbr/aorrlsh2_n.asm | 56 + gmp4/mpn/x86_64/coreisbr/aorrlshC_n.asm | 173 + gmp4/mpn/x86_64/coreisbr/aorrlsh_n.asm | 215 + gmp4/mpn/x86_64/coreisbr/aors_n.asm | 198 + gmp4/mpn/x86_64/coreisbr/aorsmul_1.asm | 209 + gmp4/mpn/x86_64/coreisbr/divrem_1.asm | 37 + gmp4/mpn/x86_64/coreisbr/gmp-mparam.h | 224 + gmp4/mpn/x86_64/coreisbr/lshift.asm | 37 + gmp4/mpn/x86_64/coreisbr/lshiftc.asm | 37 + gmp4/mpn/x86_64/coreisbr/mul_1.asm | 161 + gmp4/mpn/x86_64/coreisbr/mul_2.asm | 163 + gmp4/mpn/x86_64/coreisbr/mul_basecase.asm | 407 + gmp4/mpn/x86_64/coreisbr/mullo_basecase.asm | 384 + gmp4/mpn/x86_64/coreisbr/popcount.asm | 118 + gmp4/mpn/x86_64/coreisbr/redc_1.asm | 541 + gmp4/mpn/x86_64/coreisbr/rsh1aors_n.asm | 193 + gmp4/mpn/x86_64/coreisbr/rshift.asm | 37 + gmp4/mpn/x86_64/coreisbr/sec_tabselect.asm | 37 + gmp4/mpn/x86_64/coreisbr/sqr_basecase.asm | 484 + gmp4/mpn/x86_64/darwin.m4 | 81 + gmp4/mpn/x86_64/div_qr_1n_pi1.asm | 247 + gmp4/mpn/x86_64/div_qr_2n_pi1.asm | 158 + gmp4/mpn/x86_64/div_qr_2u_pi1.asm | 200 + gmp4/mpn/x86_64/dive_1.asm | 158 + gmp4/mpn/x86_64/divrem_1.asm | 306 + gmp4/mpn/x86_64/divrem_2.asm | 189 + gmp4/mpn/x86_64/dos64.m4 | 100 + gmp4/mpn/x86_64/fastavx/copyd.asm | 171 + gmp4/mpn/x86_64/fastavx/copyi.asm | 168 + gmp4/mpn/x86_64/fastsse/README | 21 + gmp4/mpn/x86_64/fastsse/com-palignr.asm | 302 + gmp4/mpn/x86_64/fastsse/com.asm | 161 + gmp4/mpn/x86_64/fastsse/copyd-palignr.asm | 251 + gmp4/mpn/x86_64/fastsse/copyd.asm | 145 + gmp4/mpn/x86_64/fastsse/copyi-palignr.asm | 295 + gmp4/mpn/x86_64/fastsse/copyi.asm | 166 + gmp4/mpn/x86_64/fastsse/lshift-movdqu2.asm | 182 + gmp4/mpn/x86_64/fastsse/lshift.asm | 169 + gmp4/mpn/x86_64/fastsse/lshiftc-movdqu2.asm | 193 + gmp4/mpn/x86_64/fastsse/lshiftc.asm | 179 + gmp4/mpn/x86_64/fastsse/rshift-movdqu2.asm | 201 + gmp4/mpn/x86_64/fastsse/sec_tabselect.asm | 192 + gmp4/mpn/x86_64/fat/fat.c | 368 + gmp4/mpn/x86_64/fat/fat_entry.asm | 204 + gmp4/mpn/x86_64/fat/gmp-mparam.h | 72 + gmp4/mpn/x86_64/fat/mod_1.c | 32 + gmp4/mpn/x86_64/fat/mul_basecase.c | 32 + gmp4/mpn/x86_64/fat/mullo_basecase.c | 32 + gmp4/mpn/x86_64/fat/redc_1.c | 32 + gmp4/mpn/x86_64/fat/redc_2.c | 32 + gmp4/mpn/x86_64/fat/sqr_basecase.c | 32 + gmp4/mpn/x86_64/gcd_1.asm | 163 + gmp4/mpn/x86_64/gmp-mparam.h | 218 + gmp4/mpn/x86_64/invert_limb.asm | 115 + gmp4/mpn/x86_64/invert_limb_table.asm | 50 + gmp4/mpn/x86_64/k10/gcd_1.asm | 37 + gmp4/mpn/x86_64/k10/gmp-mparam.h | 222 + gmp4/mpn/x86_64/k10/hamdist.asm | 103 + gmp4/mpn/x86_64/k10/lshift.asm | 37 + gmp4/mpn/x86_64/k10/lshiftc.asm | 37 + gmp4/mpn/x86_64/k10/popcount.asm | 138 + gmp4/mpn/x86_64/k10/rshift.asm | 37 + gmp4/mpn/x86_64/k10/sec_tabselect.asm | 37 + gmp4/mpn/x86_64/k8/aorrlsh_n.asm | 217 + gmp4/mpn/x86_64/k8/div_qr_1n_pi1.asm | 249 + gmp4/mpn/x86_64/k8/gmp-mparam.h | 236 + gmp4/mpn/x86_64/k8/mul_basecase.asm | 469 + gmp4/mpn/x86_64/k8/mullo_basecase.asm | 436 + gmp4/mpn/x86_64/k8/mulmid_basecase.asm | 559 + gmp4/mpn/x86_64/k8/redc_1.asm | 591 + gmp4/mpn/x86_64/k8/sqr_basecase.asm | 807 + gmp4/mpn/x86_64/logops_n.asm | 244 + gmp4/mpn/x86_64/lshift.asm | 247 + gmp4/mpn/x86_64/lshiftc.asm | 182 + gmp4/mpn/x86_64/lshsub_n.asm | 172 + gmp4/mpn/x86_64/missing-call.m4 | 53 + gmp4/mpn/x86_64/missing-inline.m4 | 100 + gmp4/mpn/x86_64/missing.asm | 130 + gmp4/mpn/x86_64/mod_1_1.asm | 235 + gmp4/mpn/x86_64/mod_1_2.asm | 238 + gmp4/mpn/x86_64/mod_1_4.asm | 269 + gmp4/mpn/x86_64/mod_34lsub1.asm | 205 + gmp4/mpn/x86_64/mode1o.asm | 171 + gmp4/mpn/x86_64/mul_1.asm | 183 + gmp4/mpn/x86_64/mul_2.asm | 192 + gmp4/mpn/x86_64/mulx/adx/addmul_1.asm | 149 + gmp4/mpn/x86_64/mulx/aorsmul_1.asm | 161 + gmp4/mpn/x86_64/mulx/mul_1.asm | 154 + gmp4/mpn/x86_64/nano/copyd.asm | 37 + gmp4/mpn/x86_64/nano/copyi.asm | 37 + gmp4/mpn/x86_64/nano/dive_1.asm | 166 + gmp4/mpn/x86_64/nano/gcd_1.asm | 37 + gmp4/mpn/x86_64/nano/gmp-mparam.h | 243 + gmp4/mpn/x86_64/nano/popcount.asm | 35 + gmp4/mpn/x86_64/pentium4/aors_n.asm | 196 + gmp4/mpn/x86_64/pentium4/aorslsh1_n.asm | 50 + gmp4/mpn/x86_64/pentium4/aorslsh2_n.asm | 50 + gmp4/mpn/x86_64/pentium4/aorslshC_n.asm | 203 + gmp4/mpn/x86_64/pentium4/gmp-mparam.h | 231 + gmp4/mpn/x86_64/pentium4/lshift.asm | 166 + gmp4/mpn/x86_64/pentium4/lshiftc.asm | 179 + gmp4/mpn/x86_64/pentium4/mod_34lsub1.asm | 167 + gmp4/mpn/x86_64/pentium4/popcount.asm | 35 + gmp4/mpn/x86_64/pentium4/rsh1aors_n.asm | 334 + gmp4/mpn/x86_64/pentium4/rshift.asm | 169 + gmp4/mpn/x86_64/pentium4/sec_tabselect.asm | 37 + gmp4/mpn/x86_64/popham.asm | 177 + gmp4/mpn/x86_64/rsh1aors_n.asm | 189 + gmp4/mpn/x86_64/rshift.asm | 176 + gmp4/mpn/x86_64/sec_tabselect.asm | 176 + gmp4/mpn/x86_64/sqr_diag_addlsh1.asm | 116 + gmp4/mpn/x86_64/sublsh1_n.asm | 160 + gmp4/mpn/x86_64/x86_64-defs.m4 | 354 + gmp4/mpq/Makefile.am | 41 + gmp4/mpq/Makefile.in | 637 + gmp4/mpq/abs.c | 56 + gmp4/mpq/aors.c | 113 + gmp4/mpq/canonicalize.c | 63 + gmp4/mpq/clear.c | 41 + gmp4/mpq/clears.c | 52 + gmp4/mpq/cmp.c | 126 + gmp4/mpq/cmp_si.c | 67 + gmp4/mpq/cmp_ui.c | 100 + gmp4/mpq/div.c | 115 + gmp4/mpq/equal.c | 69 + gmp4/mpq/get_d.c | 175 + gmp4/mpq/get_den.c | 43 + gmp4/mpq/get_num.c | 45 + gmp4/mpq/get_str.c | 76 + gmp4/mpq/init.c | 49 + gmp4/mpq/inits.c | 49 + gmp4/mpq/inp_str.c | 76 + gmp4/mpq/inv.c | 71 + gmp4/mpq/md_2exp.c | 111 + gmp4/mpq/mul.c | 103 + gmp4/mpq/neg.c | 58 + gmp4/mpq/out_str.c | 54 + gmp4/mpq/set.c | 51 + gmp4/mpq/set_d.c | 166 + gmp4/mpq/set_den.c | 45 + gmp4/mpq/set_f.c | 107 + gmp4/mpq/set_num.c | 45 + gmp4/mpq/set_si.c | 65 + gmp4/mpq/set_str.c | 69 + gmp4/mpq/set_ui.c | 61 + gmp4/mpq/set_z.c | 49 + gmp4/mpq/swap.c | 71 + gmp4/mpz/2fac_ui.c | 100 + gmp4/mpz/Makefile.am | 67 + gmp4/mpz/Makefile.in | 688 + gmp4/mpz/abs.c | 55 + gmp4/mpz/add.c | 33 + gmp4/mpz/add_ui.c | 33 + gmp4/mpz/and.c | 244 + gmp4/mpz/aors.h | 124 + gmp4/mpz/aors_ui.h | 121 + gmp4/mpz/aorsmul.c | 164 + gmp4/mpz/aorsmul_i.c | 255 + gmp4/mpz/array_init.c | 50 + gmp4/mpz/bin_ui.c | 143 + gmp4/mpz/bin_uiui.c | 696 + gmp4/mpz/cdiv_q.c | 53 + gmp4/mpz/cdiv_q_ui.c | 103 + gmp4/mpz/cdiv_qr.c | 65 + gmp4/mpz/cdiv_qr_ui.c | 119 + gmp4/mpz/cdiv_r.c | 61 + gmp4/mpz/cdiv_r_ui.c | 110 + gmp4/mpz/cdiv_ui.c | 103 + gmp4/mpz/cfdiv_q_2exp.c | 113 + gmp4/mpz/cfdiv_r_2exp.c | 164 + gmp4/mpz/clear.c | 40 + gmp4/mpz/clears.c | 49 + gmp4/mpz/clrbit.c | 116 + gmp4/mpz/cmp.c | 54 + gmp4/mpz/cmp_d.c | 145 + gmp4/mpz/cmp_si.c | 70 + gmp4/mpz/cmp_ui.c | 78 + gmp4/mpz/cmpabs.c | 54 + gmp4/mpz/cmpabs_d.c | 130 + gmp4/mpz/cmpabs_ui.c | 77 + gmp4/mpz/com.c | 88 + gmp4/mpz/combit.c | 103 + gmp4/mpz/cong.c | 183 + gmp4/mpz/cong_2exp.c | 150 + gmp4/mpz/cong_ui.c | 116 + gmp4/mpz/dive_ui.c | 69 + gmp4/mpz/divegcd.c | 157 + gmp4/mpz/divexact.c | 91 + gmp4/mpz/divis.c | 44 + gmp4/mpz/divis_2exp.c | 61 + gmp4/mpz/divis_ui.c | 81 + gmp4/mpz/dump.c | 49 + gmp4/mpz/export.c | 190 + gmp4/mpz/fac_ui.c | 108 + gmp4/mpz/fdiv_q.c | 53 + gmp4/mpz/fdiv_q_ui.c | 101 + gmp4/mpz/fdiv_qr.c | 65 + gmp4/mpz/fdiv_qr_ui.c | 118 + gmp4/mpz/fdiv_r.c | 60 + gmp4/mpz/fdiv_r_ui.c | 108 + gmp4/mpz/fdiv_ui.c | 101 + gmp4/mpz/fib2_ui.c | 50 + gmp4/mpz/fib_ui.c | 152 + gmp4/mpz/fits_s.h | 61 + gmp4/mpz/fits_sint.c | 36 + gmp4/mpz/fits_slong.c | 36 + gmp4/mpz/fits_sshort.c | 36 + gmp4/mpz/fits_uint.c | 34 + gmp4/mpz/fits_ulong.c | 34 + gmp4/mpz/fits_ushort.c | 34 + gmp4/mpz/gcd.c | 167 + gmp4/mpz/gcd_ui.c | 85 + gmp4/mpz/gcdext.c | 124 + gmp4/mpz/get_d.c | 44 + gmp4/mpz/get_d_2exp.c | 54 + gmp4/mpz/get_si.c | 53 + gmp4/mpz/get_str.c | 119 + gmp4/mpz/get_ui.c | 34 + gmp4/mpz/getlimbn.c | 34 + gmp4/mpz/hamdist.c | 175 + gmp4/mpz/import.c | 180 + gmp4/mpz/init.c | 45 + gmp4/mpz/init2.c | 61 + gmp4/mpz/inits.c | 49 + gmp4/mpz/inp_raw.c | 173 + gmp4/mpz/inp_str.c | 174 + gmp4/mpz/invert.c | 73 + gmp4/mpz/ior.c | 230 + gmp4/mpz/iset.c | 59 + gmp4/mpz/iset_d.c | 42 + gmp4/mpz/iset_si.c | 59 + gmp4/mpz/iset_str.c | 52 + gmp4/mpz/iset_ui.c | 59 + gmp4/mpz/jacobi.c | 211 + gmp4/mpz/kronsz.c | 138 + gmp4/mpz/kronuz.c | 130 + gmp4/mpz/kronzs.c | 93 + gmp4/mpz/kronzu.c | 89 + gmp4/mpz/lcm.c | 88 + gmp4/mpz/lcm_ui.c | 79 + gmp4/mpz/limbs_finish.c | 40 + gmp4/mpz/limbs_modify.c | 39 + gmp4/mpz/limbs_read.c | 38 + gmp4/mpz/limbs_write.c | 39 + gmp4/mpz/lucnum2_ui.c | 90 + gmp4/mpz/lucnum_ui.c | 209 + gmp4/mpz/mfac_uiui.c | 140 + gmp4/mpz/millerrabin.c | 124 + gmp4/mpz/mod.c | 68 + gmp4/mpz/mul.c | 157 + gmp4/mpz/mul_2exp.c | 73 + gmp4/mpz/mul_i.h | 107 + gmp4/mpz/mul_si.c | 34 + gmp4/mpz/mul_ui.c | 34 + gmp4/mpz/n_pow_ui.c | 533 + gmp4/mpz/neg.c | 57 + gmp4/mpz/nextprime.c | 129 + gmp4/mpz/oddfac_1.c | 427 + gmp4/mpz/out_raw.c | 173 + gmp4/mpz/out_str.c | 112 + gmp4/mpz/perfpow.c | 39 + gmp4/mpz/perfsqr.c | 35 + gmp4/mpz/popcount.c | 35 + gmp4/mpz/pow_ui.c | 53 + gmp4/mpz/powm.c | 283 + gmp4/mpz/powm_sec.c | 104 + gmp4/mpz/powm_ui.c | 292 + gmp4/mpz/pprime_p.c | 164 + gmp4/mpz/primorial_ui.c | 164 + gmp4/mpz/prodlimbs.c | 109 + gmp4/mpz/random.c | 40 + gmp4/mpz/random2.c | 51 + gmp4/mpz/realloc.c | 71 + gmp4/mpz/realloc2.c | 60 + gmp4/mpz/remove.c | 147 + gmp4/mpz/roinit_n.c | 44 + gmp4/mpz/root.c | 93 + gmp4/mpz/rootrem.c | 101 + gmp4/mpz/rrandomb.c | 103 + gmp4/mpz/scan0.c | 130 + gmp4/mpz/scan1.c | 124 + gmp4/mpz/set.c | 50 + gmp4/mpz/set_d.c | 117 + gmp4/mpz/set_f.c | 72 + gmp4/mpz/set_q.c | 35 + gmp4/mpz/set_si.c | 55 + gmp4/mpz/set_str.c | 145 + gmp4/mpz/set_ui.c | 53 + gmp4/mpz/setbit.c | 105 + gmp4/mpz/size.c | 35 + gmp4/mpz/sizeinbase.c | 43 + gmp4/mpz/sqrt.c | 77 + gmp4/mpz/sqrtrem.c | 85 + gmp4/mpz/sub.c | 33 + gmp4/mpz/sub_ui.c | 33 + gmp4/mpz/swap.c | 55 + gmp4/mpz/tdiv_q.c | 93 + gmp4/mpz/tdiv_q_2exp.c | 68 + gmp4/mpz/tdiv_q_ui.c | 84 + gmp4/mpz/tdiv_qr.c | 107 + gmp4/mpz/tdiv_qr_ui.c | 103 + gmp4/mpz/tdiv_r.c | 98 + gmp4/mpz/tdiv_r_2exp.c | 78 + gmp4/mpz/tdiv_r_ui.c | 99 + gmp4/mpz/tdiv_ui.c | 85 + gmp4/mpz/tstbit.c | 81 + gmp4/mpz/ui_pow_ui.c | 59 + gmp4/mpz/ui_sub.c | 96 + gmp4/mpz/urandomb.c | 48 + gmp4/mpz/urandomm.c | 105 + gmp4/mpz/xor.c | 194 + gmp4/nextprime.c | 167 + gmp4/primesieve.c | 295 + gmp4/printf/Makefile.am | 41 + gmp4/printf/Makefile.in | 636 + gmp4/printf/asprintf.c | 48 + gmp4/printf/asprntffuns.c | 72 + gmp4/printf/doprnt.c | 627 + gmp4/printf/doprntf.c | 390 + gmp4/printf/doprnti.c | 137 + gmp4/printf/fprintf.c | 49 + gmp4/printf/obprintf.c | 59 + gmp4/printf/obprntffuns.c | 72 + gmp4/printf/obvprintf.c | 52 + gmp4/printf/printf.c | 49 + gmp4/printf/printffuns.c | 80 + gmp4/printf/repl-vsnprintf.c | 396 + gmp4/printf/snprintf.c | 54 + gmp4/printf/snprntffuns.c | 160 + gmp4/printf/sprintf.c | 55 + gmp4/printf/sprintffuns.c | 95 + gmp4/printf/vasprintf.c | 117 + gmp4/printf/vfprintf.c | 42 + gmp4/printf/vprintf.c | 42 + gmp4/printf/vsnprintf.c | 48 + gmp4/printf/vsprintf.c | 51 + gmp4/rand/Makefile.am | 38 + gmp4/rand/Makefile.in | 630 + gmp4/rand/rand.c | 52 + gmp4/rand/randbui.c | 57 + gmp4/rand/randclr.c | 38 + gmp4/rand/randdef.c | 38 + gmp4/rand/randiset.c | 39 + gmp4/rand/randlc2s.c | 93 + gmp4/rand/randlc2x.c | 333 + gmp4/rand/randmt.c | 416 + gmp4/rand/randmt.h | 51 + gmp4/rand/randmts.c | 165 + gmp4/rand/randmui.c | 86 + gmp4/rand/rands.c | 42 + gmp4/rand/randsd.c | 39 + gmp4/rand/randsdui.c | 44 + gmp4/scanf/Makefile.am | 38 + gmp4/scanf/Makefile.in | 629 + gmp4/scanf/doscan.c | 768 + gmp4/scanf/fscanf.c | 48 + gmp4/scanf/fscanffuns.c | 62 + gmp4/scanf/scanf.c | 48 + gmp4/scanf/sscanf.c | 53 + gmp4/scanf/sscanffuns.c | 124 + gmp4/scanf/vfscanf.c | 42 + gmp4/scanf/vscanf.c | 43 + gmp4/scanf/vsscanf.c | 61 + gmp4/tal-debug.c | 151 + gmp4/tal-notreent.c | 130 + gmp4/tal-reent.c | 82 + gmp4/test-driver | 139 + gmp4/tests/Makefile.am | 39 + gmp4/tests/Makefile.in | 1370 + gmp4/tests/amd64call.asm | 167 + gmp4/tests/amd64check.c | 106 + gmp4/tests/arm32call.asm | 83 + gmp4/tests/arm32check.c | 96 + gmp4/tests/cxx/Makefile.am | 81 + gmp4/tests/cxx/Makefile.in | 1395 + gmp4/tests/cxx/clocale.c | 60 + gmp4/tests/cxx/t-assign.cc | 604 + gmp4/tests/cxx/t-binary.cc | 466 + gmp4/tests/cxx/t-cast.cc | 57 + gmp4/tests/cxx/t-constr.cc | 756 + gmp4/tests/cxx/t-cxx11.cc | 220 + ...ceptions-work-at-all-with-this-compiler.cc | 38 + gmp4/tests/cxx/t-headers.cc | 26 + gmp4/tests/cxx/t-iostream.cc | 107 + gmp4/tests/cxx/t-istream.cc | 599 + gmp4/tests/cxx/t-locale.cc | 195 + gmp4/tests/cxx/t-misc.cc | 398 + gmp4/tests/cxx/t-mix.cc | 83 + gmp4/tests/cxx/t-ops.cc | 723 + gmp4/tests/cxx/t-ops2.cc | 256 + gmp4/tests/cxx/t-ops3.cc | 133 + gmp4/tests/cxx/t-ostream.cc | 450 + gmp4/tests/cxx/t-prec.cc | 217 + gmp4/tests/cxx/t-rand.cc | 149 + gmp4/tests/cxx/t-ternary.cc | 735 + gmp4/tests/cxx/t-unary.cc | 133 + gmp4/tests/devel/Makefile.am | 34 + gmp4/tests/devel/Makefile.in | 685 + gmp4/tests/devel/README | 37 + gmp4/tests/devel/anymul_1.c | 256 + gmp4/tests/devel/aors_n.c | 263 + gmp4/tests/devel/copy.c | 226 + gmp4/tests/devel/divmod_1.c | 200 + gmp4/tests/devel/divrem.c | 119 + gmp4/tests/devel/logops_n.c | 230 + gmp4/tests/devel/shift.c | 245 + gmp4/tests/devel/try.c | 3608 ++ gmp4/tests/devel/tst-addsub.c | 98 + gmp4/tests/memory.c | 247 + gmp4/tests/misc.c | 565 + gmp4/tests/misc/Makefile.am | 33 + gmp4/tests/misc/Makefile.in | 1028 + gmp4/tests/misc/t-locale.c | 201 + gmp4/tests/misc/t-printf.c | 948 + gmp4/tests/misc/t-scanf.c | 1616 + gmp4/tests/mpf/Makefile.am | 31 + gmp4/tests/mpf/Makefile.in | 1422 + gmp4/tests/mpf/reuse.c | 219 + gmp4/tests/mpf/t-add.c | 108 + gmp4/tests/mpf/t-cmp_d.c | 104 + gmp4/tests/mpf/t-cmp_si.c | 107 + gmp4/tests/mpf/t-conv.c | 143 + gmp4/tests/mpf/t-div.c | 186 + gmp4/tests/mpf/t-dm2exp.c | 119 + gmp4/tests/mpf/t-eq.c | 218 + gmp4/tests/mpf/t-fits.c | 333 + gmp4/tests/mpf/t-get_d.c | 106 + gmp4/tests/mpf/t-get_d_2exp.c | 121 + gmp4/tests/mpf/t-get_si.c | 223 + gmp4/tests/mpf/t-get_ui.c | 128 + gmp4/tests/mpf/t-gsprec.c | 62 + gmp4/tests/mpf/t-inp_str.c | 192 + gmp4/tests/mpf/t-int_p.c | 84 + gmp4/tests/mpf/t-mul_ui.c | 165 + gmp4/tests/mpf/t-muldiv.c | 159 + gmp4/tests/mpf/t-set.c | 113 + gmp4/tests/mpf/t-set_q.c | 127 + gmp4/tests/mpf/t-set_si.c | 91 + gmp4/tests/mpf/t-set_ui.c | 90 + gmp4/tests/mpf/t-sqrt.c | 194 + gmp4/tests/mpf/t-sqrt_ui.c | 113 + gmp4/tests/mpf/t-sub.c | 206 + gmp4/tests/mpf/t-trunc.c | 271 + gmp4/tests/mpf/t-ui_div.c | 152 + gmp4/tests/mpn/Makefile.am | 38 + gmp4/tests/mpn/Makefile.in | 1728 + gmp4/tests/mpn/logic.c | 134 + gmp4/tests/mpn/t-aors_1.c | 311 + gmp4/tests/mpn/t-asmtype.c | 64 + gmp4/tests/mpn/t-bdiv.c | 368 + gmp4/tests/mpn/t-broot.c | 105 + gmp4/tests/mpn/t-brootinv.c | 106 + gmp4/tests/mpn/t-div.c | 505 + gmp4/tests/mpn/t-divrem_1.c | 124 + gmp4/tests/mpn/t-fat.c | 311 + gmp4/tests/mpn/t-get_d.c | 498 + gmp4/tests/mpn/t-hgcd.c | 407 + gmp4/tests/mpn/t-hgcd_appr.c | 564 + gmp4/tests/mpn/t-instrument.c | 416 + gmp4/tests/mpn/t-invert.c | 161 + gmp4/tests/mpn/t-iord_u.c | 221 + gmp4/tests/mpn/t-matrix22.c | 207 + gmp4/tests/mpn/t-minvert.c | 179 + gmp4/tests/mpn/t-mod_1.c | 129 + gmp4/tests/mpn/t-mp_bases.c | 105 + gmp4/tests/mpn/t-mul.c | 101 + gmp4/tests/mpn/t-mullo.c | 142 + gmp4/tests/mpn/t-mulmid.c | 93 + gmp4/tests/mpn/t-mulmod_bnm1.c | 218 + gmp4/tests/mpn/t-perfsqr.c | 117 + gmp4/tests/mpn/t-scan.c | 145 + gmp4/tests/mpn/t-sizeinbase.c | 108 + gmp4/tests/mpn/t-sqrmod_bnm1.c | 191 + gmp4/tests/mpn/t-toom2-sqr.c | 6 + gmp4/tests/mpn/t-toom22.c | 10 + gmp4/tests/mpn/t-toom3-sqr.c | 6 + gmp4/tests/mpn/t-toom32.c | 8 + gmp4/tests/mpn/t-toom33.c | 11 + gmp4/tests/mpn/t-toom4-sqr.c | 6 + gmp4/tests/mpn/t-toom42.c | 8 + gmp4/tests/mpn/t-toom43.c | 8 + gmp4/tests/mpn/t-toom44.c | 11 + gmp4/tests/mpn/t-toom52.c | 8 + gmp4/tests/mpn/t-toom53.c | 8 + gmp4/tests/mpn/t-toom54.c | 8 + gmp4/tests/mpn/t-toom6-sqr.c | 8 + gmp4/tests/mpn/t-toom62.c | 8 + gmp4/tests/mpn/t-toom63.c | 8 + gmp4/tests/mpn/t-toom6h.c | 13 + gmp4/tests/mpn/t-toom8-sqr.c | 8 + gmp4/tests/mpn/t-toom8h.c | 18 + gmp4/tests/mpn/toom-shared.h | 158 + gmp4/tests/mpn/toom-sqr-shared.h | 129 + gmp4/tests/mpq/Makefile.am | 34 + gmp4/tests/mpq/Makefile.in | 1212 + gmp4/tests/mpq/io.c | 137 + gmp4/tests/mpq/reuse.c | 230 + gmp4/tests/mpq/t-aors.c | 183 + gmp4/tests/mpq/t-cmp.c | 102 + gmp4/tests/mpq/t-cmp_si.c | 118 + gmp4/tests/mpq/t-cmp_ui.c | 117 + gmp4/tests/mpq/t-equal.c | 147 + gmp4/tests/mpq/t-get_d.c | 295 + gmp4/tests/mpq/t-get_str.c | 143 + gmp4/tests/mpq/t-inp_str.c | 172 + gmp4/tests/mpq/t-inv.c | 61 + gmp4/tests/mpq/t-md_2exp.c | 245 + gmp4/tests/mpq/t-set_f.c | 170 + gmp4/tests/mpq/t-set_str.c | 103 + gmp4/tests/mpz/Makefile.am | 42 + gmp4/tests/mpz/Makefile.in | 2030 + gmp4/tests/mpz/bit.c | 406 + gmp4/tests/mpz/convert.c | 170 + gmp4/tests/mpz/dive.c | 101 + gmp4/tests/mpz/dive_ui.c | 87 + gmp4/tests/mpz/io.c | 139 + gmp4/tests/mpz/logic.c | 195 + gmp4/tests/mpz/reuse.c | 722 + gmp4/tests/mpz/t-addsub.c | 122 + gmp4/tests/mpz/t-aorsmul.c | 422 + gmp4/tests/mpz/t-bin.c | 266 + gmp4/tests/mpz/t-cdiv_ui.c | 159 + gmp4/tests/mpz/t-cmp.c | 182 + gmp4/tests/mpz/t-cmp_d.c | 293 + gmp4/tests/mpz/t-cmp_si.c | 102 + gmp4/tests/mpz/t-cong.c | 227 + gmp4/tests/mpz/t-cong_2exp.c | 209 + gmp4/tests/mpz/t-div_2exp.c | 224 + gmp4/tests/mpz/t-divis.c | 168 + gmp4/tests/mpz/t-divis_2exp.c | 133 + gmp4/tests/mpz/t-export.c | 206 + gmp4/tests/mpz/t-fac_ui.c | 106 + gmp4/tests/mpz/t-fdiv.c | 147 + gmp4/tests/mpz/t-fdiv_ui.c | 159 + gmp4/tests/mpz/t-fib_ui.c | 156 + gmp4/tests/mpz/t-fits.c | 202 + gmp4/tests/mpz/t-gcd.c | 454 + gmp4/tests/mpz/t-gcd_ui.c | 63 + gmp4/tests/mpz/t-get_d.c | 74 + gmp4/tests/mpz/t-get_d_2exp.c | 223 + gmp4/tests/mpz/t-get_si.c | 122 + gmp4/tests/mpz/t-hamdist.c | 124 + gmp4/tests/mpz/t-import.c | 176 + gmp4/tests/mpz/t-inp_str.c | 199 + gmp4/tests/mpz/t-invert.c | 121 + gmp4/tests/mpz/t-io_raw.c | 287 + gmp4/tests/mpz/t-jac.c | 1012 + gmp4/tests/mpz/t-lcm.c | 185 + gmp4/tests/mpz/t-limbs.c | 233 + gmp4/tests/mpz/t-lucnum_ui.c | 97 + gmp4/tests/mpz/t-mfac_uiui.c | 136 + gmp4/tests/mpz/t-mul.c | 219 + gmp4/tests/mpz/t-mul_i.c | 135 + gmp4/tests/mpz/t-nextprime.c | 222 + gmp4/tests/mpz/t-oddeven.c | 88 + gmp4/tests/mpz/t-perfpow.c | 243 + gmp4/tests/mpz/t-perfsqr.c | 155 + gmp4/tests/mpz/t-popcount.c | 168 + gmp4/tests/mpz/t-pow.c | 218 + gmp4/tests/mpz/t-powm.c | 184 + gmp4/tests/mpz/t-powm_ui.c | 128 + gmp4/tests/mpz/t-pprime_p.c | 190 + gmp4/tests/mpz/t-primorial_ui.c | 97 + gmp4/tests/mpz/t-remove.c | 147 + gmp4/tests/mpz/t-root.c | 174 + gmp4/tests/mpz/t-scan.c | 132 + gmp4/tests/mpz/t-set_d.c | 140 + gmp4/tests/mpz/t-set_f.c | 126 + gmp4/tests/mpz/t-set_si.c | 97 + gmp4/tests/mpz/t-set_str.c | 109 + gmp4/tests/mpz/t-sizeinbase.c | 90 + gmp4/tests/mpz/t-sqrtrem.c | 116 + gmp4/tests/mpz/t-tdiv.c | 146 + gmp4/tests/mpz/t-tdiv_ui.c | 159 + gmp4/tests/rand/Makefile.am | 89 + gmp4/tests/rand/Makefile.in | 1202 + gmp4/tests/rand/findlc.c | 252 + gmp4/tests/rand/gen.c | 481 + gmp4/tests/rand/gmpstat.h | 75 + gmp4/tests/rand/spect.c | 137 + gmp4/tests/rand/stat.c | 407 + gmp4/tests/rand/statlib.c | 837 + gmp4/tests/rand/t-iset.c | 68 + gmp4/tests/rand/t-lc2exp.c | 217 + gmp4/tests/rand/t-mt.c | 83 + gmp4/tests/rand/t-rand.c | 290 + gmp4/tests/rand/t-urbui.c | 65 + gmp4/tests/rand/t-urmui.c | 75 + gmp4/tests/rand/t-urndmm.c | 159 + gmp4/tests/rand/zdiv_round.c | 44 + gmp4/tests/refmpf.c | 428 + gmp4/tests/refmpn.c | 2578 ++ gmp4/tests/refmpq.c | 41 + gmp4/tests/refmpz.c | 298 + gmp4/tests/spinner.c | 129 + gmp4/tests/t-bswap.c | 71 + gmp4/tests/t-constants.c | 352 + gmp4/tests/t-count_zeros.c | 87 + gmp4/tests/t-gmpmax.c | 69 + gmp4/tests/t-hightomask.c | 43 + gmp4/tests/t-modlinv.c | 84 + gmp4/tests/t-parity.c | 67 + gmp4/tests/t-popc.c | 80 + gmp4/tests/t-sub.c | 115 + gmp4/tests/tests.h | 442 + gmp4/tests/trace.c | 318 + gmp4/tests/x86call.asm | 153 + gmp4/tests/x86check.c | 112 + gmp4/tune/Makefile.am | 181 + gmp4/tune/Makefile.in | 936 + gmp4/tune/README | 501 + gmp4/tune/alpha.asm | 59 + gmp4/tune/common.c | 2659 ++ gmp4/tune/div_qr_1_tune.c | 47 + gmp4/tune/div_qr_1n_pi1_1.c | 39 + gmp4/tune/div_qr_1n_pi1_2.c | 39 + gmp4/tune/divrem1div.c | 42 + gmp4/tune/divrem1inv.c | 42 + gmp4/tune/divrem2div.c | 41 + gmp4/tune/divrem2inv.c | 41 + gmp4/tune/freq.c | 894 + gmp4/tune/gcdext_double.c | 39 + gmp4/tune/gcdext_single.c | 39 + gmp4/tune/gcdextod.c | 40 + gmp4/tune/gcdextos.c | 40 + gmp4/tune/hgcd_appr_lehmer.c | 40 + gmp4/tune/hgcd_lehmer.c | 40 + gmp4/tune/hgcd_reduce_1.c | 41 + gmp4/tune/hgcd_reduce_2.c | 40 + gmp4/tune/hppa.asm | 42 + gmp4/tune/hppa2.asm | 44 + gmp4/tune/hppa2w.asm | 44 + gmp4/tune/ia64.asm | 47 + gmp4/tune/jacbase1.c | 38 + gmp4/tune/jacbase2.c | 38 + gmp4/tune/jacbase3.c | 38 + gmp4/tune/jacbase4.c | 38 + gmp4/tune/many.pl | 1334 + gmp4/tune/mod_1_1-1.c | 41 + gmp4/tune/mod_1_1-2.c | 41 + gmp4/tune/mod_1_div.c | 46 + gmp4/tune/mod_1_inv.c | 46 + gmp4/tune/modlinv.c | 178 + gmp4/tune/noop.c | 68 + gmp4/tune/pentium.asm | 60 + gmp4/tune/powerpc.asm | 53 + gmp4/tune/powerpc64.asm | 49 + gmp4/tune/powm_mod.c | 39 + gmp4/tune/powm_redc.c | 41 + gmp4/tune/pre_divrem_1.c | 41 + gmp4/tune/set_strb.c | 48 + gmp4/tune/set_strp.c | 43 + gmp4/tune/set_strs.c | 44 + gmp4/tune/sparcv9.asm | 45 + gmp4/tune/speed-ext.c | 233 + gmp4/tune/speed.c | 1384 + gmp4/tune/speed.h | 3646 ++ gmp4/tune/time.c | 1597 + gmp4/tune/tune-gcd-p.c | 225 + gmp4/tune/tuneup.c | 2912 ++ gmp4/tune/x86_64.asm | 55 + gmp4/version.c | 34 + gmp4/ylwrap | 247 + go/makefile | 183 + h/.gitignore | 4 + h/386-bsd.defs | 37 + h/386-bsd.h | 112 + h/386-gnu.h | 64 + h/386-kfreebsd.defs | 63 + h/386-kfreebsd.h | 49 + h/386-linux.h | 47 + h/386-macosx.defs | 35 + h/386-macosx.h | 199 + h/386.h | 89 + h/FreeBSD.defs | 45 + h/FreeBSD.h | 99 + h/NeXT.defs | 0 h/NeXT.h | 0 h/NeXT30-m68k.defs | 32 + h/NeXT30-m68k.h | 58 + h/NeXT32-i386.defs | 34 + h/NeXT32-i386.h | 59 + h/NeXT32-m68k.defs | 34 + h/NeXT32-m68k.h | 58 + h/NetBSD.defs | 49 + h/NetBSD.h | 104 + h/OpenBSD.defs | 36 + h/OpenBSD.h | 72 + h/aarch64-linux.h | 16 + h/alpha-linux.h | 24 + h/alpha-osf1.defs | 49 + h/alpha-osf1.h | 141 + h/amd64-kfreebsd.h | 26 + h/amd64-linux.h | 26 + h/apply_n.h | 101 + h/arith.h | 266 + h/arm-linux.h | 17 + h/armhf-linux.h | 17 + h/arth.h | 8265 ++++ h/att.h | 95 + h/att3b2.h | 25 + h/att_ext.h | 634 + h/bds.h | 63 + h/bits.h | 43 + h/bsd.h | 71 + h/cmpincl1.h | 1 + h/cmplrs/stsupport.h | 164 + h/cmponly.h | 52 + h/coff/i386.h | 232 + h/coff_encap.h | 40 + h/compat.h | 17 + h/compbas.h | 12 + h/compbas2.h | 0 h/compdefs.h | 126 + h/compprotos.h | 184 + h/convex.h | 25 + h/cyglacks.h | 82 + h/dec3100.defs | 56 + h/dec3100.h | 77 + h/defun.h | 35 + h/dos-go32.defs | 68 + h/dos-go32.h | 100 + h/e15.h | 77 + h/elf32_arm_reloc.h | 34 + h/elf32_arm_reloc_special.h | 43 + h/elf32_armhf_reloc.h | 71 + h/elf32_armhf_reloc_special.h | 87 + h/elf32_hppa_reloc.h | 35 + h/elf32_hppa_reloc_special.h | 44 + h/elf32_i386_reloc.h | 8 + h/elf32_m68k_reloc.h | 6 + h/elf32_mips_reloc.h | 49 + h/elf32_mips_reloc_special.h | 152 + h/elf32_ppc_reloc.h | 22 + h/elf32_s390_reloc.h | 11 + h/elf32_sh4_reloc.h | 3 + h/elf32_sparc_reloc.h | 19 + h/elf64_aarch64_reloc.h | 57 + h/elf64_aarch64_reloc_special.h | 53 + h/elf64_alpha_reloc.h | 40 + h/elf64_alpha_reloc_special.h | 179 + h/elf64_i386_reloc.h | 14 + h/elf64_mips_reloc.h | 67 + h/elf64_mips_reloc_special.h | 156 + h/elf64_ppc_reloc.h | 22 + h/elf64_ppc_reloc_special.h | 88 + h/elf64_ppcle_reloc.h | 49 + h/elf64_ppcle_reloc_special.h | 91 + h/elf64_riscv64_reloc.h | 29 + h/elf64_s390_reloc.h | 13 + h/elf64_sparc_reloc.h | 30 + h/elf64_sparc_reloc_special.h | 85 + h/enum.h | 15 + h/erreurs.h | 164 + h/error.h | 199 + h/eval.h | 124 + h/ext_sym.h | 143 + h/fixnum.h | 43 + h/frame.h | 135 + h/funlink.h | 120 + h/gclincl.h.in | 419 + h/gencom.h | 523 + h/genpari.h | 54 + h/genport.h | 118 + h/getpagesize.h | 6 + h/globals.h | 35 + h/gmp_wrappers.h | 199 + h/gnuwin95.defs | 61 + h/gnuwin95.h | 138 + h/hp300-bsd.defs | 36 + h/hp300-bsd.h | 70 + h/hp300.defs | 59 + h/hp300.h | 148 + h/hp800.defs | 88 + h/hp800.h | 172 + h/hppa-linux.h | 25 + h/ia64-linux.h | 14 + h/immnum.h | 358 + h/include.h | 135 + h/irix5.defs | 62 + h/irix5.h | 120 + h/irix6.defs | 0 h/irix6.h | 11 + h/ld_bind_now.h | 27 + h/lex.h | 64 + h/linux.defs | 63 + h/linux.h | 182 + h/lu.h | 439 + h/m68k-linux.h | 82 + h/mac2.defs | 39 + h/mac2.h | 187 + h/mach32_i386_reloc.h | 15 + h/mach32_ppc_reloc.h | 29 + h/mach64_i386_reloc.h | 26 + h/make-decl.h | 3 + h/make-init.h | 82 + h/mc68k.h | 91 + h/mdefs.h | 55 + h/mgmp.h | 54 + h/minglacks.h | 82 + h/mingw.defs | 61 + h/mingw.h | 224 + h/mips-linux.h | 24 + h/mips.h | 37 + h/mipsel-linux.h | 9 + h/mp.h | 181 + h/mp386.defs | 30 + h/mp386.h | 30 + h/ncr.defs | 33 + h/ncr.h | 54 + h/news.h | 22 + h/notcomp.h | 384 + h/num_include.h | 42 + h/object.h | 588 + h/options.h | 22 + h/page.h | 124 + h/pageinfo.h | 10 + h/pbits.h | 13 + h/pool.h | 169 + h/powerpc-linux.h | 31 + h/powerpc-macosx.defs | 35 + h/powerpc-macosx.h | 176 + h/prelink.h | 33 + h/protoize.h | 1989 + h/ptable.h | 58 + h/rgbc.h | 9 + h/rios-aix3.defs | 50 + h/rios-aix3.h | 238 + h/rios.defs | 50 + h/rios.h | 248 + h/riscv64-linux.h | 26 + h/rt_aix.defs | 43 + h/rt_aix.h | 150 + h/s3000.h | 56 + h/s390-linux.h | 20 + h/secondary_sun_magic | Bin 0 -> 8 bytes h/sfun_argd.h | 27 + h/sgi.defs | 28 + h/sgi.h | 33 + h/sgi4d.defs | 57 + h/sgi4d.h | 59 + h/sh4-linux.h | 60 + h/solaris-i386.defs | 65 + h/solaris-i386.h | 37 + h/solaris.defs | 65 + h/solaris.h | 44 + h/sparc-linux.h | 31 + h/sparc.h | 124 + h/stacks.h | 27 + h/sun.h | 30 + h/sun2r3.defs | 25 + h/sun2r3.h | 16 + h/sun3-os4.defs | 61 + h/sun3-os4.h | 38 + h/sun3.defs | 36 + h/sun3.h | 24 + h/sun386i.defs | 42 + h/sun386i.h | 133 + h/sun4.defs | 46 + h/sun4.h | 120 + h/symbol.h | 28 + h/symmetry.defs | 38 + h/symmetry.h | 55 + h/tsgc.h | 6 + h/twelve_null | Bin 0 -> 12 bytes h/type.h | 154 + h/u370_aix.defs | 63 + h/u370_aix.h | 188 + h/unrandomize.h | 81 + h/usig.h | 17 + h/vax.defs | 37 + h/vax.h | 29 + h/vs.h | 63 + h/wincoff.h | 23 + h/writable.h | 63 + info/.gitignore | 21 + info/bind.texi | 393 + info/c-interface.texi | 27 + info/chap-1.texi | 2778 ++ info/chap-10.texi | 1348 + info/chap-11.texi | 2711 ++ info/chap-12.texi | 5537 +++ info/chap-13.texi | 1592 + info/chap-14.texi | 3859 ++ info/chap-15.texi | 2496 ++ info/chap-16.texi | 769 + info/chap-17.texi | 2274 ++ info/chap-18.texi | 968 + info/chap-19.texi | 2456 ++ info/chap-2.texi | 2560 ++ info/chap-20.texi | 730 + info/chap-21.texi | 3638 ++ info/chap-22.texi | 5297 +++ info/chap-23.texi | 1457 + info/chap-24.texi | 1018 + info/chap-25.texi | 1865 + info/chap-26.texi | 6038 +++ info/chap-3.texi | 7096 ++++ info/chap-4.texi | 2805 ++ info/chap-5.texi | 6473 +++ info/chap-6.texi | 2866 ++ info/chap-7.texi | 5985 +++ info/chap-8.texi | 1169 + info/chap-9.texi | 4287 ++ info/chap-a.texi | 152 + info/character.texi | 377 + info/compile.texi | 313 + info/compiler-defs.texi | 158 + info/control.texi | 3424 ++ info/debug.texi | 149 + info/doc.texi | 100 + info/form.texi | 1128 + info/gcl-si-index.texi | 5 + info/gcl-si.info | 8225 ++++ info/gcl-si.pdf | Bin 0 -> 265797 bytes info/gcl-si.texi | 142 + info/gcl-si/Available-Symbols.html | 70 + info/gcl-si/Bignums.html | 120 + info/gcl-si/C-Interface.html | 58 + info/gcl-si/Characters.html | 476 + info/gcl-si/Command-Line.html | 200 + info/gcl-si/Compilation.html | 387 + info/gcl-si/Compiler-Definitions.html | 224 + info/gcl-si/Debugging.html | 62 + info/gcl-si/Doc.html | 158 + info/gcl-si/Environment.html | 62 + info/gcl-si/Function-and-Variable-Index.html | 1227 + info/gcl-si/GCL-Specific.html | 374 + info/gcl-si/Inititialization.html | 60 + info/gcl-si/Iteration-and-Tests.html | 217 + info/gcl-si/Lists.html | 1063 + info/gcl-si/Low-Level-Debug-Functions.html | 72 + info/gcl-si/Low-Level-X-Interface.html | 67 + info/gcl-si/Miscellaneous.html | 62 + info/gcl-si/Numbers.html | 1548 + info/gcl-si/Operating-System-Definitions.html | 407 + info/gcl-si/Operating-System.html | 60 + info/gcl-si/Regular-Expressions.html | 198 + .../Sequences-and-Arrays-and-Hash-Tables.html | 1150 + .../Source-Level-Debugging-in-Emacs.html | 158 + info/gcl-si/Special-Forms-and-Functions.html | 1254 + info/gcl-si/Streams-and-Reading.html | 1163 + info/gcl-si/Structures.html | 96 + info/gcl-si/Symbols.html | 568 + info/gcl-si/System-Definitions.html | 1147 + info/gcl-si/Type.html | 185 + info/gcl-si/User-Interface.html | 473 + info/gcl-si/index.html | 154 + info/gcl-tk.info | 77 + info/gcl-tk.info-1 | 6649 ++++ info/gcl-tk.info-2 | 1234 + info/gcl-tk.pdf | Bin 0 -> 398098 bytes info/gcl-tk.texi | 116 + info/gcl-tk/Argument-Lists.html | 145 + info/gcl-tk/Common-Features-of-Widgets.html | 151 + info/gcl-tk/Control.html | 105 + info/gcl-tk/General.html | 71 + info/gcl-tk/Getting-Started.html | 84 + info/gcl-tk/Introduction.html | 79 + info/gcl-tk/Linked-Variables.html | 149 + .../Lisp-Functions-Invoked-from-Graphics.html | 200 + info/gcl-tk/Return-Values.html | 166 + info/gcl-tk/Widgets.html | 85 + info/gcl-tk/after.html | 82 + info/gcl-tk/bind.html | 475 + info/gcl-tk/button.html | 244 + info/gcl-tk/canvas.html | 1535 + info/gcl-tk/checkbutton.html | 328 + info/gcl-tk/destroy.html | 68 + info/gcl-tk/entry.html | 332 + info/gcl-tk/exit.html | 71 + info/gcl-tk/focus.html | 166 + info/gcl-tk/frame.html | 173 + info/gcl-tk/grab.html | 166 + info/gcl-tk/index.html | 182 + info/gcl-tk/label.html | 160 + info/gcl-tk/listbox.html | 270 + info/gcl-tk/lower.html | 72 + info/gcl-tk/menu.html | 529 + info/gcl-tk/menubutton.html | 262 + info/gcl-tk/message.html | 217 + info/gcl-tk/option.html | 137 + info/gcl-tk/options.html | 653 + info/gcl-tk/pack.html | 318 + info/gcl-tk/pack_002dold.html | 264 + info/gcl-tk/place.html | 270 + info/gcl-tk/radiobutton.html | 314 + info/gcl-tk/raise.html | 72 + info/gcl-tk/scale.html | 309 + info/gcl-tk/scrollbar.html | 239 + info/gcl-tk/selection.html | 162 + info/gcl-tk/send.html | 96 + info/gcl-tk/text.html | 884 + info/gcl-tk/tk.html | 102 + info/gcl-tk/tk_002ddialog.html | 108 + .../tk_002dlistbox_002dsingle_002dselect.html | 71 + info/gcl-tk/tk_002dmenu_002dbar.html | 184 + info/gcl-tk/tkconnect.html | 109 + info/gcl-tk/tkerror.html | 97 + info/gcl-tk/tkvars.html | 112 + info/gcl-tk/tkwait.html | 84 + info/gcl-tk/toplevel.html | 156 + info/gcl-tk/update.html | 85 + info/gcl-tk/winfo.html | 287 + info/gcl-tk/wm.html | 945 + info/gcl.info | 1472 + info/gcl.info-1 | 8012 ++++ info/gcl.info-2 | 8302 ++++ info/gcl.info-3 | 8719 ++++ info/gcl.info-4 | 8292 ++++ info/gcl.info-5 | 9892 +++++ info/gcl.info-6 | 10582 +++++ info/gcl.info-7 | 9206 +++++ info/gcl.info-8 | 8650 ++++ info/gcl.info-9 | 4877 +++ info/gcl.pdf | Bin 0 -> 2490109 bytes info/gcl.texi | 2077 + info/gcl.texi.diff | 11612 ++++++ info/gcl/1_002b.html | 96 + .../gcl/A-specifier-for-a-rest-parameter.html | 72 + info/gcl/APPLY-Forms-as-Places.html | 98 + ...ams-_0028Introduction-to-Streams_0029.html | 51 + .../Abstract-Classifications-of-Streams.html | 51 + ...Accessibility-of-Symbols-in-a-Package.html | 93 + info/gcl/Accessing-Slots.html | 107 + ...Constraints-on-Externalizable-Objects.html | 187 + info/gcl/Additional-FORMAT-Parameters.html | 54 + ...l-Information-about-FORMAT-Operations.html | 62 + ...-Parsing-Logical-Pathname-Namestrings.html | 51 + ...ct-Definitions-in-Modified-BNF-Syntax.html | 73 + ...Parameter-Specializers-and-Qualifiers.html | 78 + info/gcl/Alphabetic-Characters.html | 66 + info/gcl/Alphanumeric-Characters.html | 55 + info/gcl/Appendix.html | 56 + ...the-sorted-list-of-applicable-methods.html | 95 + ...-Conventions-of-Some-Reader-Functions.html | 58 + info/gcl/Argument-Mismatch-Detection.html | 72 + info/gcl/Array-Concepts.html | 59 + info/gcl/Array-Dimensions.html | 66 + info/gcl/Array-Elements.html | 75 + info/gcl/Array-Indices.html | 59 + info/gcl/Array-Rank.html | 60 + info/gcl/Array-Upgrading.html | 87 + info/gcl/Arrays-Dictionary.html | 132 + info/gcl/Arrays.html | 58 + info/gcl/Assertions.html | 64 + ...ssociating-a-Restart-with-a-Condition.html | 67 + ...d-Commutativity-in-Numeric-Operations.html | 64 + info/gcl/Backquote.html | 207 + info/gcl/Boa-Lambda-Lists.html | 163 + ...Built_002din-Method-Combination-Types.html | 190 + info/gcl/Byte-Operations-on-Integers.html | 71 + ...-and-Punctuation-in-Condition-Reports.html | 63 + info/gcl/Case-in-Pathname-Components.html | 67 + info/gcl/Case-in-Symbols.html | 74 + ...Implementation_002dDefined-Characters.html | 56 + .../Changing-the-Class-of-an-Instance.html | 80 + info/gcl/Character-Attributes.html | 72 + info/gcl/Character-Categories.html | 93 + info/gcl/Character-Concepts.html | 75 + info/gcl/Character-Encodings.html | 63 + info/gcl/Character-Names.html | 104 + info/gcl/Character-Repertoires.html | 75 + info/gcl/Character-Scripts.html | 70 + info/gcl/Character-Syntax-Types.html | 161 + info/gcl/Character-Syntax.html | 76 + info/gcl/Characters-Dictionary.html | 97 + info/gcl/Characters-With-Case.html | 58 + info/gcl/Characters.html | 58 + info/gcl/Classes.html | 84 + info/gcl/Closures-and-Lexical-Binding.html | 171 + .../gcl/Coercion-of-Streams-to-Pathnames.html | 70 + info/gcl/Comma.html | 55 + .../Common-Case-in-Pathname-Components.html | 72 + info/gcl/Compilation-Semantics.html | 74 + info/gcl/Compilation.html | 65 + info/gcl/Compiler-Macros.html | 87 + info/gcl/Compiler-Terminology.html | 201 + info/gcl/Compiling-Format-Strings.html | 61 + info/gcl/Complex-Computations.html | 66 + info/gcl/Condition-Designators.html | 111 + info/gcl/Condition-System-Concepts.html | 153 + info/gcl/Condition-Types.html | 119 + info/gcl/Conditional-Execution-Clauses.html | 97 + info/gcl/Conditions-Dictionary.html | 152 + info/gcl/Conditions.html | 58 + info/gcl/Conformance-Statement.html | 76 + info/gcl/Conformance.html | 63 + info/gcl/Conforming-Implementations.html | 73 + info/gcl/Conforming-Programs.html | 95 + ...for-all-Methods-of-a-Generic-Function.html | 109 + info/gcl/Cons-Concepts.html | 76 + info/gcl/Conses-Dictionary.html | 158 + info/gcl/Conses-as-Forms.html | 70 + info/gcl/Conses-as-Lists.html | 103 + info/gcl/Conses-as-Trees.html | 84 + info/gcl/Conses.html | 58 + info/gcl/Constant-Variables.html | 65 + info/gcl/Constituent-Characters.html | 63 + info/gcl/Constituent-Traits.html | 134 + ...traints-on-Macros-and-Compiler-Macros.html | 64 + ...ackage-for-Conforming-Implementations.html | 81 + ...dLISP-Package-for-Conforming-Programs.html | 178 + .../gcl/Constructing-Numbers-from-Tokens.html | 79 + info/gcl/Contagion-in-Numeric-Operations.html | 57 + info/gcl/Control-Transfer-Clauses.html | 74 + ...sponding-Characters-in-the-Other-Case.html | 57 + info/gcl/Creating-Conditions.html | 65 + info/gcl/Creating-Instances-of-Classes.html | 64 + info/gcl/Customizing-Class-Redefinition.html | 68 + info/gcl/Customizing-Reinitialization.html | 62 + ...ng-the-Change-of-Class-of-an-Instance.html | 63 + info/gcl/Data-Type-Definition.html | 74 + .../gcl/Data-and-Control-Flow-Dictionary.html | 198 + info/gcl/Data-and-Control-Flow.html | 60 + ...irected-Destructuring-by-Lambda-Lists.html | 57 + info/gcl/Debugging-Utilities.html | 65 + info/gcl/Declaration-Identifiers.html | 81 + info/gcl/Declaration-Scope.html | 123 + info/gcl/Declaration-Specifiers.html | 60 + info/gcl/Declarations.html | 87 + info/gcl/Declarative-Method-Combination.html | 63 + ...-Validity-of-Initialization-Arguments.html | 140 + info/gcl/Decoded-Time.html | 117 + .../gcl/Default-Print_002dObject-Methods.html | 99 + ...efaulting-of-Initialization-Arguments.html | 121 + ...02dcombination-Arguments-Lambda-Lists.html | 70 + ...ine_002dmodify_002dmacro-Lambda-Lists.html | 73 + info/gcl/Defining-Classes.html | 131 + info/gcl/Definition-of-Similarity.html | 204 + ...dInstance-and-Initialize_002dInstance.html | 103 + info/gcl/Definitions.html | 66 + info/gcl/Defsetf-Lambda-Lists.html | 79 + info/gcl/Deftype-Lambda-Lists.html | 63 + info/gcl/Deprecated-Argument-Conventions.html | 74 + info/gcl/Deprecated-Functions.html | 64 + info/gcl/Deprecated-Language-Features.html | 73 + info/gcl/Deprecated-Reader-Syntax.html | 59 + info/gcl/Deprecated-Variables.html | 53 + info/gcl/Designators.html | 108 + info/gcl/Destructive-Operations.html | 59 + info/gcl/Destructuring-Lambda-Lists.html | 86 + info/gcl/Destructuring-Mismatch.html | 59 + info/gcl/Destructuring-by-Lambda-Lists.html | 71 + info/gcl/Destructuring.html | 185 + ...Determining-the-Class-Precedence-List.html | 111 + .../gcl/Determining-the-Effective-Method.html | 70 + ...ictionary-Entries-for-Type-Specifiers.html | 73 + info/gcl/Digits-in-a-Radix.html | 69 + ...-in-Non_002dHierarchical-File-Systems.html | 58 + info/gcl/Documentation-of-Extensions.html | 58 + ...of-Implementation_002dDefined-Scripts.html | 98 + ...Implementation_002dDependent-Features.html | 60 + info/gcl/Double_002dQuote.html | 87 + ...-Control-of-the-Arrangement-of-Output.html | 120 + .../Dynamic-Control-of-the-Lisp-Reader.html | 54 + info/gcl/Dynamic-Environments.html | 87 + info/gcl/Dynamic-Variables.html | 100 + ...of-Readtable-Case-on-the-Lisp-Printer.html | 118 + ...-of-Readtable-Case-on-the-Lisp-Reader.html | 84 + ...mbedded-Newlines-in-Condition-Reports.html | 81 + info/gcl/Environment-Dictionary.html | 115 + info/gcl/Environment-Inquiry.html | 67 + info/gcl/Environment-Objects.html | 71 + info/gcl/Environment.html | 58 + .../gcl/Error-Checking-in-Function-Calls.html | 57 + .../Error-Detection-Time-in-Safe-Calls.html | 59 + info/gcl/Error-Terminology.html | 280 + .../Errors-When-Calling-a-Next-Method.html | 69 + ...cape-Characters-and-Potential-Numbers.html | 66 + ...Evaluation-and-Compilation-Dictionary.html | 115 + info/gcl/Evaluation-and-Compilation.html | 70 + .../gcl/Evaluation-of-Subforms-to-Places.html | 153 + info/gcl/Evaluation.html | 95 + info/gcl/Examples-of-ALWAYS.html | 104 + .../Examples-of-APPEND-and-NCONC-clauses.html | 65 + ...d-Commutativity-in-Numeric-Operations.html | 86 + info/gcl/Examples-of-COLLECT-clause.html | 70 + info/gcl/Examples-of-COUNT-clause.html | 57 + ...f-Class-Precedence-List-Determination.html | 153 + ...irected-Destructuring-by-Lambda-Lists.html | 64 + info/gcl/Examples-of-Declaration-Scope.html | 139 + ...of-Readtable-Case-on-the-Lisp-Printer.html | 113 + ...-of-Readtable-Case-on-the-Lisp-Reader.html | 85 + ...s-of-Evaluation-of-Subforms-to-Places.html | 69 + info/gcl/Examples-of-FORMAT.html | 159 + info/gcl/Examples-of-Feature-Expressions.html | 90 + info/gcl/Examples-of-Inheritance.html | 74 + ...ents-in-Generic-Functions-and-Methods.html | 86 + ...ples-of-MAXIMIZE-and-MINIMIZE-clauses.html | 74 + info/gcl/Examples-of-Merging-Pathnames.html | 74 + ...amples-of-Miscellaneous-Loop-Features.html | 86 + ...xamples-of-Multiple-Escape-Characters.html | 60 + info/gcl/Examples-of-NAMED-clause.html | 61 + .../Examples-of-Ordinary-Lambda-Lists.html | 145 + info/gcl/Examples-of-Potential-Numbers.html | 87 + info/gcl/Examples-of-Printer-Behavior.html | 105 + info/gcl/Examples-of-Printing-Arrays.html | 65 + info/gcl/Examples-of-REPEAT-clause.html | 63 + ...nt-Conflict-in-Exceptional-Situations.html | 61 + ...-Representation-for-Complex-Rationals.html | 62 + ...-Rule-of-Float-and-Rational-Contagion.html | 70 + info/gcl/Examples-of-SUM-clause.html | 62 + ...of-Satisfying-a-One_002dArgument-Test.html | 64 + ...of-Satisfying-a-Two_002dArgument-Test.html | 79 + ...amples-of-Self_002dEvaluating-Objects.html | 62 + info/gcl/Examples-of-Semicolon.html | 57 + info/gcl/Examples-of-Setf-Expansions.html | 111 + info/gcl/Examples-of-Sharpsign-Asterisk.html | 68 + ...xamples-of-Sharpsign-Vertical_002dBar.html | 115 + .../Examples-of-Single-Escape-Characters.html | 60 + info/gcl/Examples-of-Single_002dQuote.html | 57 + info/gcl/Examples-of-Style-for-Semicolon.html | 72 + ...Suppressing-Keyword-Argument-Checking.html | 70 + ...ontrol-during-a-Destructive-Operation.html | 71 + info/gcl/Examples-of-Truenames.html | 79 + info/gcl/Examples-of-WHEN-clause.html | 95 + .../Examples-of-WHILE-and-UNTIL-clauses.html | 72 + info/gcl/Examples-of-WITH-clause.html | 81 + .../Examples-of-Whitespace-Characters.html | 61 + info/gcl/Examples-of-clause-grouping.html | 126 + ...es-of-for_002das_002dacross-subclause.html | 56 + ...f-for_002das_002darithmetic-subclause.html | 78 + ..._002das_002dequals_002dthen-subclause.html | 59 + ...-for_002das_002din_002dlist-subclause.html | 73 + ...-for_002das_002don_002dlist-subclause.html | 67 + ...s-of-for_002das_002dpackage-subclause.html | 65 + .../Examples-of-unconditional-execution.html | 67 + .../Examples-of-using-the-Pretty-Printer.html | 385 + ...xceptional-Situations-in-the-Compiler.html | 98 + info/gcl/Expanding-Loop-Forms.html | 123 + info/gcl/Extended-Loop.html | 61 + info/gcl/Extensions-to-Similarity-Rules.html | 66 + info/gcl/Extent.html | 120 + info/gcl/Externalizable-Objects.html | 87 + info/gcl/FORMAT-Basic-Output.html | 64 + .../FORMAT-Control_002dFlow-Operations.html | 66 + .../FORMAT-Floating_002dPoint-Printers.html | 62 + info/gcl/FORMAT-Layout-Control.html | 60 + info/gcl/FORMAT-Miscellaneous-Operations.html | 60 + ...T-Miscellaneous-Pseudo_002dOperations.html | 60 + .../gcl/FORMAT-Pretty-Printer-Operations.html | 64 + info/gcl/FORMAT-Printer-Operations.html | 60 + info/gcl/FORMAT-Radix-Control.html | 64 + info/gcl/Feature-Expressions.html | 86 + info/gcl/Features.html | 75 + info/gcl/File-Compilation.html | 99 + ...Operations-on-Open-and-Closed-Streams.html | 84 + info/gcl/File-Streams.html | 65 + info/gcl/File-System-Concepts.html | 90 + info/gcl/Filenames-Dictionary.html | 89 + info/gcl/Filenames.html | 62 + info/gcl/Files-Dictionary.html | 75 + info/gcl/Files.html | 58 + info/gcl/Fill-Pointers.html | 71 + info/gcl/Floating_002dpoint-Computations.html | 66 + info/gcl/Font-Key.html | 107 + info/gcl/Form-Evaluation.html | 55 + info/gcl/Format-Directive-Interface.html | 80 + info/gcl/Formatted-Output.html | 187 + info/gcl/Function-Call-Forms-as-Places.html | 282 + info/gcl/Function-Forms.html | 124 + ...ions-on-Parameters-that-must-be-Lists.html | 63 + ...-on-Parameters-that-must-be-Sequences.html | 55 + ...ions-on-Parameters-that-must-be-Trees.html | 57 + info/gcl/Generalized-Reference.html | 61 + info/gcl/Generic-Function-Lambda-Lists.html | 97 + info/gcl/Generic-Functions-and-Methods.html | 69 + info/gcl/Glossary-_0028Glossary_0029.html | 56 + info/gcl/Glossary.html | 6801 ++++ info/gcl/Graphic-Characters.html | 82 + info/gcl/Hash-Table-Concepts.html | 59 + info/gcl/Hash-Tables-Dictionary.html | 83 + info/gcl/Hash-Tables.html | 58 + info/gcl/Hash_002dTable-Operations.html | 120 + info/gcl/History.html | 231 + info/gcl/Identity-of-Characters.html | 54 + .../Implementation-Limits-on-Array-Rank.html | 54 + ...Limits-on-Individual-Array-Dimensions.html | 54 + .../Implementation_002dDefined-Packages.html | 60 + ...ation_002dDependent-Numeric-Constants.html | 73 + .../Implications-of-Strings-Being-Arrays.html | 60 + .../Indirection-in-Modified-BNF-Syntax.html | 65 + info/gcl/Inheritance-of-Class-Options.html | 64 + info/gcl/Inheritance-of-Methods.html | 62 + ...Inheritance-of-Slots-and-Slot-Options.html | 179 + info/gcl/Inheritance.html | 64 + info/gcl/Initial-and-Final-Execution.html | 96 + info/gcl/Initialization-Arguments.html | 108 + info/gcl/Initialize_002dInstance.html | 119 + ...hanging-the-Class-of-an-Instance_0029.html | 81 + ...al-Slots-_0028Redefining-Classes_0029.html | 86 + info/gcl/Input.html | 113 + info/gcl/Integrating-Types-and-Classes.html | 187 + info/gcl/Interactive-Streams.html | 88 + info/gcl/Interactive-Use-of-Restarts.html | 77 + info/gcl/Interfaces-to-Restarts.html | 74 + info/gcl/Internal-Time.html | 68 + info/gcl/Internal-and-External-Symbols.html | 71 + ...rning-a-Symbol-in-the-KEYWORD-Package.html | 57 + info/gcl/Interpretation-of-Tokens.html | 67 + info/gcl/Interpreting-Dictionary-Entries.html | 132 + ...nterpreting-Pathname-Component-Values.html | 101 + info/gcl/Interval-Designators.html | 105 + .../Introduction-_0028Introduction_0029.html | 72 + ...roduction-_0028Types-and-Classes_0029.html | 109 + info/gcl/Introduction-to-Characters.html | 92 + info/gcl/Introduction-to-Classes.html | 178 + info/gcl/Introduction-to-Environments.html | 83 + .../Introduction-to-Generic-Functions.html | 157 + info/gcl/Introduction-to-Methods.html | 201 + info/gcl/Introduction-to-Packages.html | 111 + ...troduction-to-Scripts-and-Repertoires.html | 58 + info/gcl/Introduction-to-Slots.html | 119 + info/gcl/Introduction-to-Streams.html | 102 + info/gcl/Invalid-Characters.html | 59 + info/gcl/Invalid-Keyword-Arguments.html | 61 + info/gcl/Iteration-Control.html | 120 + info/gcl/Iteration-Dictionary.html | 65 + info/gcl/Iteration.html | 58 + ...ents-in-Generic-Functions-and-Methods.html | 80 + info/gcl/Kinds-of-Places.html | 76 + info/gcl/Lambda-Expressions.html | 64 + info/gcl/Lambda-Forms.html | 63 + info/gcl/Lambda-Lists.html | 127 + ...irected-Destructuring-by-Lambda-Lists.html | 142 + info/gcl/Language-Extensions.html | 117 + info/gcl/Language-Subsets.html | 65 + ...railing-Newlines-in-Condition-Reports.html | 70 + info/gcl/Left_002dParenthesis.html | 106 + info/gcl/Lexical-Environments.html | 90 + info/gcl/Lexical-Variables.html | 71 + info/gcl/Lists-as-Association-Lists.html | 66 + info/gcl/Lists-as-Sets.html | 63 + .../Literal-Objects-in-Compiled-Files.html | 88 + info/gcl/Loading.html | 79 + .../Local-Case-in-Pathname-Components.html | 64 + info/gcl/Local-Variable-Initializations.html | 136 + info/gcl/Locating-a-Symbol-in-a-Package.html | 67 + info/gcl/Logical-Operations-on-Integers.html | 77 + info/gcl/Logical-Pathname-Components.html | 58 + info/gcl/Logical-Pathnames.html | 59 + info/gcl/Loop-Keywords.html | 66 + info/gcl/Lowercase-Characters.html | 59 + ...ters-in-a-Logical-Pathname-Namestring.html | 54 + info/gcl/Macro-Characters.html | 123 + info/gcl/Macro-Forms-as-Places.html | 61 + info/gcl/Macro-Forms.html | 101 + info/gcl/Macro-Lambda-Lists.html | 229 + ...taining-Function-in-Condition-Reports.html | 55 + info/gcl/Merging-Pathnames.html | 69 + info/gcl/Meta_002dObjects.html | 64 + .../gcl/Method-Selection-and-Combination.html | 89 + info/gcl/Minimal-Compilation.html | 103 + ...l-Declaration-Processing-Requirements.html | 82 + info/gcl/Miscellaneous-Clauses.html | 60 + ...ssing-and-Additional-FORMAT-Arguments.html | 55 + info/gcl/Modification-of-Literal-Objects.html | 142 + info/gcl/Modified-BNF-Syntax.html | 57 + info/gcl/Modifying-Hash-Table-Keys.html | 101 + .../Modifying-the-Structure-of-Instances.html | 74 + ...difying-the-Structure-of-the-Instance.html | 63 + info/gcl/Multidimensional-Arrays.html | 51 + info/gcl/Multiple-Escape-Characters.html | 65 + ...iple-Possible-Textual-Representations.html | 121 + info/gcl/NIL-as-a-Component-Value.html | 61 + info/gcl/NIL.html | 110 + info/gcl/Namestrings-as-Filenames.html | 73 + ...aming-Conventions-for-Rest-Parameters.html | 66 + info/gcl/Naming-of-Compiler-Macros.html | 69 + info/gcl/Nesting-of-FORMAT-Operations.html | 83 + ...alues-in-The-_0022Syntax_0022-Section.html | 59 + info/gcl/Nonsense-Words.html | 74 + info/gcl/Notational-Conventions.html | 84 + info/gcl/Note-about-Printing-Numbers.html | 54 + .../Note-about-Tabs-in-Condition-Reports.html | 58 + info/gcl/Notes-about-Backquote.html | 68 + info/gcl/Notes-about-FORMAT.html | 64 + info/gcl/Notes-about-Loop.html | 83 + info/gcl/Notes-about-Style-for-Semicolon.html | 55 + ...-Style-for-Sharpsign-Vertical_002dBar.html | 71 + info/gcl/Notes-about-The-KEYWORD-Package.html | 63 + ...the-Condition-System_0060s-Background.html | 57 + ...the-Implementation-of-Compiler-Macros.html | 68 + ...-about-the-Pathname-Version-Component.html | 69 + ...t-the-Pretty-Printer_0060s-Background.html | 57 + ...s-as-Components-of-a-Logical-Pathname.html | 54 + info/gcl/Number-Concepts.html | 69 + info/gcl/Numbers-Dictionary.html | 228 + info/gcl/Numbers-_0028Numbers_0029.html | 58 + ...8Objects-with-Multiple-Notations_0029.html | 55 + info/gcl/Numbers-as-Tokens.html | 82 + info/gcl/Numeric-Characters.html | 61 + info/gcl/Numeric-Operations.html | 137 + .../Object-Creation-and-Initialization.html | 149 + info/gcl/Objects-Dictionary.html | 142 + info/gcl/Objects-with-Multiple-Notations.html | 55 + info/gcl/Objects.html | 68 + info/gcl/Odd-Number-of-Keyword-Arguments.html | 60 + info/gcl/Open-and-Closed-Streams.html | 75 + info/gcl/Order-of-Execution.html | 122 + info/gcl/Ordering-of-Characters.html | 106 + info/gcl/Ordinary-Lambda-Lists.html | 136 + info/gcl/Organization-of-the-Document.html | 103 + info/gcl/Other-Compound-Forms-as-Places.html | 78 + info/gcl/Other-Subclasses-of-Stream.html | 79 + ...ntax-in-a-Logical-Pathname-Namestring.html | 57 + info/gcl/Overview-of-Filenames.html | 73 + ...w-of-Places-and-Generalized-Reference.html | 126 + info/gcl/Overview-of-The-Lisp-Printer.html | 69 + info/gcl/Overview-of-the-Loop-Facility.html | 88 + info/gcl/Package-Concepts.html | 59 + info/gcl/Package-Inheritance.html | 71 + info/gcl/Package-Names-and-Nicknames.html | 65 + info/gcl/Package-Prefixes-for-Symbols.html | 112 + .../gcl/Package-System-Consistency-Rules.html | 101 + info/gcl/Packages-Dictionary.html | 115 + info/gcl/Packages-No-Longer-Required.html | 66 + info/gcl/Packages.html | 58 + info/gcl/Parsing-Loop-Clauses.html | 88 + .../Parsing-Namestrings-Into-Pathnames.html | 65 + info/gcl/Pathname-Components.html | 74 + info/gcl/Pathnames-as-Filenames.html | 133 + info/gcl/Pathnames.html | 61 + info/gcl/Potential-Numbers-as-Tokens.html | 123 + info/gcl/Pretty-Print-Dispatch-Tables.html | 89 + info/gcl/Pretty-Printer-Concepts.html | 92 + info/gcl/Pretty-Printer-Margins.html | 58 + ...vention-of-Name-Conflicts-in-Packages.html | 160 + .../gcl/Principal-Values-and-Branch-Cuts.html | 103 + info/gcl/Printer-Dictionary.html | 117 + info/gcl/Printer-Dispatching.html | 62 + info/gcl/Printer-Escaping.html | 70 + info/gcl/Printer.html | 62 + info/gcl/Printing-Bit-Vectors.html | 62 + info/gcl/Printing-Characters.html | 74 + info/gcl/Printing-Complexes.html | 61 + info/gcl/Printing-Conditions.html | 89 + info/gcl/Printing-Floats.html | 87 + info/gcl/Printing-Integers.html | 64 + info/gcl/Printing-Lists-and-Conses.html | 143 + info/gcl/Printing-Numbers.html | 51 + info/gcl/Printing-Other-Arrays.html | 118 + info/gcl/Printing-Other-Objects.html | 72 + info/gcl/Printing-Other-Vectors.html | 88 + info/gcl/Printing-Pathnames.html | 65 + info/gcl/Printing-Random-States.html | 71 + info/gcl/Printing-Ratios.html | 67 + info/gcl/Printing-Strings.html | 63 + info/gcl/Printing-Structures.html | 74 + info/gcl/Printing-Symbols.html | 89 + info/gcl/Processing-of-Defining-Macros.html | 111 + info/gcl/Processing-of-Top-Level-Forms.html | 174 + info/gcl/Purpose-of-Compiler-Macros.html | 81 + info/gcl/Random_002dState-Operations.html | 62 + info/gcl/Rational-Computations.html | 62 + ...e_002dReading-Abbreviated-Expressions.html | 67 + info/gcl/Reader-Algorithm.html | 253 + info/gcl/Reader-Concepts.html | 61 + info/gcl/Reader-Dictionary.html | 91 + info/gcl/Reader.html | 58 + info/gcl/Readtables.html | 81 + ...ommended-Style-in-Condition-Reporting.html | 69 + info/gcl/Redefining-Classes.html | 126 + info/gcl/Referenced-Publications.html | 211 + info/gcl/Reinitializing-an-Instance.html | 82 + ...t-values-NIL-and-_002d_003eUNSPECIFIC.html | 65 + info/gcl/Removed-Argument-Conventions.html | 59 + info/gcl/Removed-Language-Features.html | 69 + info/gcl/Removed-Operators.html | 83 + info/gcl/Removed-Reader-Syntax.html | 53 + info/gcl/Removed-Types.html | 55 + info/gcl/Removed-Variables.html | 77 + .../Required-Kinds-of-Specialized-Arrays.html | 101 + info/gcl/Required-Language-Features.html | 60 + ...s-for-removed-and-deprecated-features.html | 69 + ...eters-in-The-_0022Syntax_0022-Section.html | 67 + info/gcl/Resignaling-a-Condition.html | 71 + ...t-Conflicts-in-Exceptional-Situations.html | 57 + info/gcl/Restart-Tests.html | 57 + info/gcl/Restarts.html | 117 + .../Restrictions-on-Composite-Streams.html | 59 + ...estrictions-on-Constructing-Pathnames.html | 98 + ...ions-on-Examining-Pathname-Components.html | 70 + ...Examining-a-Pathname-Device-Component.html | 59 + ...mining-a-Pathname-Directory-Component.html | 161 + ...n-Examining-a-Pathname-Host-Component.html | 53 + ...n-Examining-a-Pathname-Name-Component.html | 54 + ...n-Examining-a-Pathname-Type-Component.html | 54 + ...xamining-a-Pathname-Version-Component.html | 66 + .../gcl/Restrictions-on-Side_002dEffects.html | 53 + .../Restrictions-on-Wildcard-Pathnames.html | 75 + info/gcl/Return-Values.html | 88 + ...alues-in-The-_0022Syntax_0022-Section.html | 63 + info/gcl/Right_002dParenthesis.html | 55 + ...-Representation-for-Complex-Rationals.html | 63 + ...anonical-Representation-for-Rationals.html | 69 + info/gcl/Rule-of-Complex-Contagion.html | 63 + .../gcl/Rule-of-Complex-Substitutability.html | 55 + info/gcl/Rule-of-Float-Approximation.html | 72 + .../Rule-of-Float-Precision-Contagion.html | 54 + info/gcl/Rule-of-Float-Substitutability.html | 116 + .../Rule-of-Float-Underflow-and-Overflow.html | 55 + .../Rule-of-Float-and-Rational-Contagion.html | 63 + .../Rule-of-Unbounded-Rational-Precision.html | 55 + info/gcl/Rules-about-Test-Functions.html | 59 + .../Rules-for-Initialization-Arguments.html | 150 + info/gcl/Safe-and-Unsafe-Calls.html | 164 + .../Satisfying-a-One_002dArgument-Test.html | 105 + .../Satisfying-a-Two_002dArgument-Test.html | 125 + info/gcl/Scope-and-Purpose.html | 57 + info/gcl/Scope.html | 59 + info/gcl/Seconds.html | 66 + ...ns-Not-Formally-Part-Of-This-Standard.html | 75 + .../gcl/Selecting-the-Applicable-Methods.html | 53 + info/gcl/Self_002dEvaluating-Objects.html | 65 + info/gcl/Semantic-Constraints.html | 171 + info/gcl/Semicolon.html | 74 + info/gcl/Sequence-Concepts.html | 98 + info/gcl/Sequences-Dictionary.html | 101 + info/gcl/Sequences.html | 60 + info/gcl/Serious-Conditions.html | 56 + info/gcl/Setf-Expansions-and-Places.html | 62 + info/gcl/Setf-Expansions.html | 119 + info/gcl/Shadowing.html | 144 + info/gcl/Shared_002dInitialize.html | 136 + info/gcl/Sharpsign-A.html | 97 + info/gcl/Sharpsign-Asterisk.html | 80 + info/gcl/Sharpsign-B.html | 62 + info/gcl/Sharpsign-Backslash.html | 78 + info/gcl/Sharpsign-C.html | 81 + info/gcl/Sharpsign-Colon.html | 63 + info/gcl/Sharpsign-Dot.html | 66 + info/gcl/Sharpsign-Equal_002dSign.html | 61 + info/gcl/Sharpsign-Left_002dParenthesis.html | 96 + .../gcl/Sharpsign-Less_002dThan_002dSign.html | 60 + info/gcl/Sharpsign-Minus.html | 61 + info/gcl/Sharpsign-O.html | 63 + info/gcl/Sharpsign-P.html | 60 + info/gcl/Sharpsign-Plus.html | 74 + info/gcl/Sharpsign-R.html | 90 + info/gcl/Sharpsign-Right_002dParenthesis.html | 59 + info/gcl/Sharpsign-S.html | 81 + info/gcl/Sharpsign-Sharpsign.html | 87 + info/gcl/Sharpsign-Single_002dQuote.html | 62 + info/gcl/Sharpsign-Vertical_002dBar.html | 55 + info/gcl/Sharpsign-Whitespace.html | 55 + info/gcl/Sharpsign-X.html | 63 + info/gcl/Sharpsign.html | 185 + ...rthand-notation-for-Type-Declarations.html | 55 + .../Signaling-and-Handling-Conditions.html | 129 + info/gcl/Signaling.html | 83 + info/gcl/Similarity-of-Aggregate-Objects.html | 58 + info/gcl/Similarity-of-Literal-Objects.html | 51 + info/gcl/Simple-Loop.html | 62 + info/gcl/Simple-vs-Extended-Loop.html | 55 + info/gcl/Single-Escape-Character.html | 63 + info/gcl/Single_002dQuote.html | 64 + info/gcl/Slots.html | 61 + ...dLISP-Package-for-Conforming-Programs.html | 86 + ...pplicable-Methods-by-Precedence-Order.html | 88 + ...ial-Characters-in-Pathname-Components.html | 70 + info/gcl/Special-Forms.html | 89 + .../Special-Pathname-Component-Values.html | 51 + info/gcl/Special-Symbols.html | 202 + ...22-Notations-for-Overloaded-Operators.html | 70 + info/gcl/Specialized-Arrays.html | 86 + info/gcl/Specialized-Lambda-Lists.html | 88 + .../Specifiers-for-_0026aux-variables.html | 67 + .../Specifiers-for-keyword-parameters.html | 140 + .../Specifiers-for-optional-parameters.html | 73 + ...pecifiers-for-the-required-parameters.html | 64 + info/gcl/Splicing-in-Modified-BNF-Syntax.html | 156 + info/gcl/Standard-Characters.html | 158 + info/gcl/Standard-Macro-Characters.html | 85 + info/gcl/Standard-Meta_002dobjects.html | 93 + info/gcl/Standard-Metaclasses.html | 78 + info/gcl/Standard-Method-Combination.html | 185 + info/gcl/Standardized-Packages.html | 87 + ...ge-Layout-for-Multidimensional-Arrays.html | 56 + ...m-Arguments-to-Standardized-Functions.html | 100 + info/gcl/Stream-Concepts.html | 63 + info/gcl/Stream-Variables.html | 86 + info/gcl/Streams-Dictionary.html | 174 + info/gcl/Streams.html | 58 + info/gcl/String-Concepts.html | 59 + info/gcl/Strings-Dictionary.html | 79 + info/gcl/Strings-in-Component-Values.html | 51 + info/gcl/Strings.html | 58 + info/gcl/Structures-Dictionary.html | 59 + info/gcl/Structures.html | 56 + info/gcl/Subtypes-of-STRING.html | 59 + ...mary-of-Conditional-Execution-Clauses.html | 71 + info/gcl/Summary-of-Loop-Clauses.html | 53 + .../gcl/Summary-of-Miscellaneous-Clauses.html | 63 + .../Summary-of-Termination-Test-Clauses.html | 91 + ...ry-of-Unconditional-Execution-Clauses.html | 64 + ...Summary-of-Value-Accumulation-Clauses.html | 97 + ...e-Initialization-and-Stepping-Clauses.html | 63 + ...Suppressing-Keyword-Argument-Checking.html | 63 + info/gcl/Symbol-Concepts.html | 75 + info/gcl/Symbol-Macros-as-Places.html | 55 + info/gcl/Symbols-Dictionary.html | 95 + ...ng-Both-Lexical-and-Dynamic-Variables.html | 71 + info/gcl/Symbols-as-Forms.html | 113 + info/gcl/Symbols-as-Tokens.html | 135 + info/gcl/Symbols-in-a-Package.html | 51 + ...ymbols-in-the-COMMON_002dLISP-Package.html | 600 + info/gcl/Symbols.html | 58 + ...ocumentation-Strings-and-Declarations.html | 64 + ...yntax-of-Logical-Pathname-Namestrings.html | 121 + info/gcl/Syntax-of-a-Complex.html | 72 + info/gcl/Syntax-of-a-Float.html | 111 + info/gcl/Syntax-of-a-Ratio.html | 79 + info/gcl/Syntax-of-a-Rational.html | 51 + info/gcl/Syntax-of-an-Integer.html | 61 + info/gcl/Syntax.html | 62 + info/gcl/System-Construction-Concepts.html | 59 + info/gcl/System-Construction-Dictionary.html | 77 + info/gcl/System-Construction.html | 58 + info/gcl/THE-Forms-as-Places.html | 65 + info/gcl/Termination-Test-Clauses.html | 191 + info/gcl/The-COMMON_002dLISP-Package.html | 77 + .../The-COMMON_002dLISP_002dUSER-Package.html | 62 + info/gcl/The-Consing-Dot.html | 59 + info/gcl/The-Current-Readtable.html | 62 + ...part-of-a-Logical-Pathname-Namestring.html | 55 + ...part-of-a-Logical-Pathname-Namestring.html | 58 + .../gcl/The-EOF_002dERROR_002dP-argument.html | 82 + info/gcl/The-Evaluation-Model.html | 84 + info/gcl/The-External-Environment.html | 63 + info/gcl/The-Global-Environment.html | 78 + ...part-of-a-Logical-Pathname-Namestring.html | 58 + info/gcl/The-Initial-Readtable.html | 62 + info/gcl/The-KEYWORD-Package.html | 68 + info/gcl/The-LOOP-Facility.html | 73 + info/gcl/The-Lisp-Pretty-Printer.html | 61 + info/gcl/The-Lisp-Printer.html | 63 + info/gcl/The-Null-Lexical-Environment.html | 60 + info/gcl/The-Pathname-Device-Component.html | 54 + .../gcl/The-Pathname-Directory-Component.html | 54 + info/gcl/The-Pathname-Host-Component.html | 54 + info/gcl/The-Pathname-Name-Component.html | 54 + info/gcl/The-Pathname-Type-Component.html | 55 + info/gcl/The-Pathname-Version-Component.html | 63 + info/gcl/The-RECURSIVE_002dP-argument.html | 126 + info/gcl/The-Standard-Readtable.html | 61 + ...part-of-a-Logical-Pathname-Namestring.html | 55 + ...part-of-a-Logical-Pathname-Namestring.html | 60 + ...By_0022-Section-of-a-Dictionary-Entry.html | 57 + ...er_0022-Section-of-a-Dictionary-Entry.html | 54 + ...es_0022-Section-of-a-Dictionary-Entry.html | 59 + ...ts_0022-Section-of-a-Dictionary-Entry.html | 55 + ...ed_0022-Section-of-a-Dictionary-Entry.html | 56 + ...st_0022-Section-of-a-Dictionary-Entry.html | 72 + ...ts_0022-Section-of-a-Dictionary-Entry.html | 54 + ...on_0022-Section-of-a-Dictionary-Entry.html | 54 + ...nd_0022-Section-of-a-Dictionary-Entry.html | 66 + ...ax_0022-Section-of-a-Dictionary-Entry.html | 57 + ...ue_0022-Section-of-a-Dictionary-Entry.html | 54 + ...on_0022-Section-of-a-Dictionary-Entry.html | 55 + ...es_0022-Section-of-a-Dictionary-Entry.html | 55 + ...ns_0022-Section-of-a-Dictionary-Entry.html | 69 + ...ue_0022-Section-of-a-Dictionary-Entry.html | 54 + ...re_0022-Section-of-a-Dictionary-Entry.html | 79 + ...me_0022-Section-of-a-Dictionary-Entry.html | 145 + ...es_0022-Section-of-a-Dictionary-Entry.html | 63 + ...on_0022-Section-of-a-Dictionary-Entry.html | 59 + ...so_0022-Section-of-a-Dictionary-Entry.html | 55 + ...ts_0022-Section-of-a-Dictionary-Entry.html | 54 + ...es_0022-Section-of-a-Dictionary-Entry.html | 59 + ...ax_0022-Section-of-a-Dictionary-Entry.html | 76 + ...xt_0022-Section-of-a-Dictionary-Entry.html | 59 + ...pe_0022-Section-of-a-Dictionary-Entry.html | 54 + .../The-for_002das_002dacross-subclause.html | 61 + ...e-for_002das_002darithmetic-subclause.html | 167 + ..._002das_002dequals_002dthen-subclause.html | 64 + .../The-for_002das_002dhash-subclause.html | 126 + ...-for_002das_002din_002dlist-subclause.html | 66 + ...-for_002das_002don_002dlist-subclause.html | 65 + .../The-for_002das_002dpackage-subclause.html | 138 + info/gcl/Tilde-A_002d_003e-Aesthetic.html | 80 + ...de-Ampersand_002d_003e-Fresh_002dLine.html | 58 + .../Tilde-Asterisk_002d_003e-Go_002dTo.html | 70 + info/gcl/Tilde-B_002d_003e-Binary.html | 62 + info/gcl/Tilde-C_002d_003e-Character.html | 108 + ...de-Circumflex_002d_003e-Escape-Upward.html | 151 + info/gcl/Tilde-D_002d_003e-Decimal.html | 88 + ...002d_003e-Monetary-Floating_002dPoint.html | 107 + ...d_003e-Exponential-Floating_002dPoint.html | 169 + ...e-Fixed_002dFormat-Floating_002dPoint.html | 143 + ..._002d_003e-General-Floating_002dPoint.html | 87 + ...2dSign_002d_003e-End-of-Justification.html | 54 + info/gcl/Tilde-I_002d_003e-Indent.html | 56 + ...de-Left_002dBrace_002d_003e-Iteration.html | 155 + ...cket_002d_003e-Conditional-Expression.html | 125 + ...t_002dParen_002d_003e-Case-Conversion.html | 89 + ...Than_002dSign_002d_003e-Justification.html | 130 + ...Than_002dSign_002d_003e-Logical-Block.html | 120 + ...lde-Newline_002d_003e-Ignored-Newline.html | 83 + info/gcl/Tilde-O_002d_003e-Octal.html | 62 + info/gcl/Tilde-P_002d_003e-Plural.html | 72 + info/gcl/Tilde-Percent_002d_003e-Newline.html | 56 + ...2dMark_002d_003e-Recursive-Processing.html | 83 + info/gcl/Tilde-R_002d_003e-Radix.html | 101 + ..._002dBrace_002d_003e-End-of-Iteration.html | 54 + ...2d_003e-End-of-Conditional-Expression.html | 54 + ...aren_002d_003e-End-of-Case-Conversion.html | 54 + info/gcl/Tilde-S_002d_003e-Standard.html | 58 + ...-Semicolon_002d_003e-Clause-Separator.html | 54 + .../Tilde-Slash_002d_003e-Call-Function.html | 93 + info/gcl/Tilde-T_002d_003e-Tabulate.html | 103 + info/gcl/Tilde-Tilde_002d_003e-Tilde.html | 53 + ...erscore_002d_003e-Conditional-Newline.html | 56 + ...Tilde-Vertical_002dBar_002d_003e-Page.html | 54 + info/gcl/Tilde-W_002d_003e-Write.html | 63 + info/gcl/Tilde-X_002d_003e-Hexadecimal.html | 62 + info/gcl/Time.html | 92 + info/gcl/Too-Few-Arguments.html | 60 + info/gcl/Too-Many-Arguments.html | 61 + info/gcl/Top-level-loop.html | 73 + info/gcl/Topological-Sorting.html | 100 + ...ontrol-during-a-Destructive-Operation.html | 60 + .../Transfer-of-Control-to-an-Exit-Point.html | 111 + .../gcl/Traversal-Rules-and-Side-Effects.html | 87 + .../Treatment-of-Exceptional-Situations.html | 54 + ...nt-of-Newline-during-Input-and-Output.html | 57 + ...eatment-of-Other-Macros-Based-on-SETF.html | 102 + info/gcl/Truenames.html | 78 + info/gcl/Type-Relationships.html | 110 + info/gcl/Type-Specifiers.html | 267 + info/gcl/Types-and-Classes-Dictionary.html | 122 + info/gcl/Types-and-Classes.html | 62 + info/gcl/Types.html | 61 + info/gcl/Unconditional-Execution-Clauses.html | 74 + ...ntrol-in-The-_0022Syntax_0022-Section.html | 58 + ...ndefined-FORMAT-Modifier-Combinations.html | 55 + info/gcl/Universal-Time.html | 75 + info/gcl/Unrecognized-Keyword-Arguments.html | 61 + ...ific-Components-of-a-Logical-Pathname.html | 54 + info/gcl/Uppercase-Characters.html | 59 + info/gcl/Use-of-Double-Semicolon.html | 59 + ...ntation_002dDefined-Language-Features.html | 73 + info/gcl/Use-of-Quadruple-Semicolon.html | 57 + .../Use-of-Read_002dTime-Conditionals.html | 76 + info/gcl/Use-of-Single-Semicolon.html | 58 + info/gcl/Use-of-Triple-Semicolon.html | 55 + info/gcl/Use-of-the-Dot-Character.html | 74 + info/gcl/VALUES-Forms-as-Places.html | 87 + info/gcl/Valid-Patterns-for-Tokens.html | 150 + info/gcl/Value-Accumulation-Clauses.html | 246 + ...e-Initialization-and-Stepping-Clauses.html | 86 + info/gcl/Variable-Names-as-Places.html | 54 + ...Variables-that-affect-the-Lisp-Reader.html | 63 + info/gcl/Vectors.html | 56 + .../Viewing-Integers-as-Bits-and-Bytes.html | 51 + ...tion-of-Arrays-with-respect-to-EQUALP.html | 57 + ...ors-and-Strings-with-respect-to-EQUAL.html | 57 + ...ation-of-Conses-with-respect-to-EQUAL.html | 54 + ...of-Hash-Tables-with-respect-to-EQUALP.html | 60 + ...of-Objects-with-respect-to-EQ-and-EQL.html | 54 + ...tion-of-Objects-with-respect-to-EQUAL.html | 55 + ...ion-of-Objects-with-respect-to-EQUALP.html | 55 + ...-of-Structures-with-respect-to-EQUALP.html | 54 + ...-Modifications-by-Language-Extensions.html | 62 + info/gcl/When-Compiler-Macros-Are-Used.html | 88 + info/gcl/Whitespace-Characters.html | 56 + ...ords-in-a-Logical-Pathname-Namestring.html | 55 + info/gcl/_002a-_0028Variable_0029.html | 112 + info/gcl/_002a.html | 85 + .../_002abreak_002don_002dsignals_002a.html | 138 + ...02acompile_002dfile_002dpathname_002a.html | 89 + info/gcl/_002acompile_002dprint_002a.html | 70 + info/gcl/_002adebug_002dio_002a.html | 196 + info/gcl/_002adebugger_002dhook_002a.html | 127 + ...efault_002dpathname_002ddefaults_002a.html | 83 + info/gcl/_002afeatures_002a.html | 187 + info/gcl/_002agensym_002dcounter_002a.html | 80 + info/gcl/_002aload_002dpathname_002a.html | 89 + info/gcl/_002aload_002dprint_002a.html | 69 + info/gcl/_002amacroexpand_002dhook_002a.html | 121 + info/gcl/_002amodules_002a.html | 78 + info/gcl/_002apackage_002a.html | 102 + info/gcl/_002aprint_002darray_002a.html | 78 + info/gcl/_002aprint_002dbase_002a.html | 130 + info/gcl/_002aprint_002dcase_002a.html | 120 + info/gcl/_002aprint_002dcircle_002a.html | 115 + info/gcl/_002aprint_002descape_002a.html | 98 + info/gcl/_002aprint_002dgensym_002a.html | 80 + info/gcl/_002aprint_002dlevel_002a.html | 143 + info/gcl/_002aprint_002dlines_002a.html | 90 + .../_002aprint_002dmiser_002dwidth_002a.html | 65 + ...02aprint_002dpprint_002ddispatch_002a.html | 84 + info/gcl/_002aprint_002dpretty_002a.html | 123 + info/gcl/_002aprint_002dreadably_002a.html | 166 + .../_002aprint_002dright_002dmargin_002a.html | 75 + info/gcl/_002arandom_002dstate_002a.html | 103 + info/gcl/_002aread_002dbase_002a.html | 97 + ...002ddefault_002dfloat_002dformat_002a.html | 88 + info/gcl/_002aread_002deval_002a.html | 75 + info/gcl/_002aread_002dsuppress_002a.html | 163 + info/gcl/_002areadtable_002a.html | 93 + info/gcl/_002aterminal_002dio_002a.html | 103 + info/gcl/_002b-_0028Variable_0029.html | 95 + info/gcl/_002b.html | 85 + info/gcl/_002d-_0028Variable_0029.html | 84 + info/gcl/_002d.html | 97 + ...d_003eUNSPECIFIC-as-a-Component-Value.html | 76 + .../_002d_003eWILD-as-a-Component-Value.html | 71 + info/gcl/_002f-_0028Variable_0029.html | 93 + info/gcl/_002f.html | 109 + info/gcl/_003d.html | 165 + info/gcl/abort-_0028Function_0029.html | 280 + info/gcl/abort-_0028Restart_0029.html | 78 + info/gcl/abs.html | 113 + info/gcl/acons.html | 95 + info/gcl/add_002dmethod.html | 96 + info/gcl/adjoin.html | 124 + info/gcl/adjust_002darray.html | 312 + info/gcl/adjustable_002darray_002dp.html | 86 + info/gcl/allocate_002dinstance.html | 101 + info/gcl/alpha_002dchar_002dp.html | 92 + info/gcl/alphanumericp.html | 107 + info/gcl/and-_0028Type-Specifier_0029.html | 74 + info/gcl/and.html | 122 + info/gcl/append.html | 91 + info/gcl/apply.html | 120 + info/gcl/apropos.html | 97 + info/gcl/aref.html | 112 + info/gcl/arithmetic_002derror.html | 73 + .../arithmetic_002derror_002doperands.html | 79 + info/gcl/array.html | 157 + info/gcl/array_002ddimension.html | 89 + info/gcl/array_002ddimension_002dlimit.html | 68 + info/gcl/array_002ddimensions.html | 81 + info/gcl/array_002ddisplacement.html | 103 + info/gcl/array_002delement_002dtype.html | 101 + ...ay_002dhas_002dfill_002dpointer_002dp.html | 91 + info/gcl/array_002din_002dbounds_002dp.html | 90 + info/gcl/array_002drank.html | 82 + info/gcl/array_002drank_002dlimit.html | 68 + .../array_002drow_002dmajor_002dindex.html | 99 + info/gcl/array_002dtotal_002dsize.html | 98 + .../array_002dtotal_002dsize_002dlimit.html | 76 + info/gcl/arrayp.html | 85 + info/gcl/ash.html | 105 + info/gcl/asin.html | 247 + info/gcl/assert.html | 173 + info/gcl/assoc.html | 168 + info/gcl/atom-_0028Type_0029.html | 60 + info/gcl/atom.html | 80 + info/gcl/base_002dchar.html | 112 + info/gcl/base_002dstring.html | 87 + info/gcl/bignum.html | 66 + info/gcl/bit-_0028Array_0029.html | 104 + info/gcl/bit-_0028System-Class_0029.html | 69 + info/gcl/bit_002dand.html | 157 + info/gcl/bit_002dvector.html | 89 + info/gcl/bit_002dvector_002dp.html | 84 + info/gcl/block.html | 108 + info/gcl/boole.html | 190 + info/gcl/boole_002d1.html | 78 + info/gcl/boolean.html | 84 + info/gcl/boundp.html | 96 + info/gcl/break.html | 136 + info/gcl/broadcast_002dstream.html | 153 + .../gcl/broadcast_002dstream_002dstreams.html | 64 + info/gcl/built_002din_002dclass.html | 75 + info/gcl/butlast.html | 128 + info/gcl/byte.html | 104 + info/gcl/call_002darguments_002dlimit.html | 68 + info/gcl/call_002dmethod.html | 141 + info/gcl/call_002dnext_002dmethod.html | 146 + info/gcl/car.html | 286 + info/gcl/case.html | 228 + info/gcl/catch.html | 162 + info/gcl/cell_002derror.html | 69 + info/gcl/cell_002derror_002dname.html | 81 + info/gcl/cerror.html | 218 + info/gcl/change_002dclass.html | 169 + info/gcl/char.html | 108 + info/gcl/char_002dcode.html | 81 + info/gcl/char_002dcode_002dlimit.html | 71 + info/gcl/char_002dint.html | 87 + info/gcl/char_002dname.html | 120 + info/gcl/char_002dupcase.html | 121 + info/gcl/char_003d.html | 248 + .../gcl/character-_0028System-Class_0029.html | 70 + info/gcl/character.html | 89 + info/gcl/characterp.html | 89 + info/gcl/check_002dtype.html | 187 + info/gcl/cis.html | 75 + info/gcl/class.html | 65 + info/gcl/class_002dname.html | 83 + info/gcl/class_002dof.html | 86 + info/gcl/clear_002dinput.html | 118 + info/gcl/close.html | 125 + info/gcl/clrhash.html | 78 + info/gcl/code_002dchar.html | 81 + info/gcl/coerce.html | 220 + info/gcl/compile.html | 153 + info/gcl/compile_002dfile.html | 197 + info/gcl/compile_002dfile_002dpathname.html | 116 + info/gcl/compiled_002dfunction.html | 73 + info/gcl/compiled_002dfunction_002dp.html | 97 + info/gcl/compiler_002dmacro_002dfunction.html | 80 + info/gcl/complement.html | 113 + info/gcl/complex-_0028System-Class_0029.html | 123 + info/gcl/complex.html | 113 + info/gcl/complexp.html | 83 + .../compute_002dapplicable_002dmethods.html | 84 + info/gcl/compute_002drestarts.html | 141 + info/gcl/concatenate.html | 124 + info/gcl/concatenated_002dstream.html | 82 + .../concatenated_002dstream_002dstreams.html | 69 + info/gcl/cond.html | 112 + info/gcl/condition.html | 105 + info/gcl/conjugate.html | 87 + info/gcl/cons-_0028System-Class_0029.html | 94 + info/gcl/cons.html | 87 + info/gcl/consp.html | 86 + info/gcl/constantly.html | 88 + info/gcl/constantp.html | 155 + info/gcl/continue.html | 89 + info/gcl/control_002derror.html | 66 + info/gcl/copy_002dalist.html | 91 + info/gcl/copy_002dlist.html | 103 + info/gcl/copy_002dpprint_002ddispatch.html | 70 + info/gcl/copy_002dreadtable.html | 117 + info/gcl/copy_002dseq.html | 97 + info/gcl/copy_002dstructure.html | 80 + info/gcl/copy_002dsymbol.html | 129 + info/gcl/copy_002dtree.html | 99 + info/gcl/count.html | 130 + info/gcl/declaim.html | 74 + info/gcl/declaration.html | 87 + info/gcl/declare.html | 175 + info/gcl/decode_002dfloat.html | 240 + info/gcl/decode_002duniversal_002dtime.html | 104 + info/gcl/defclass.html | 403 + info/gcl/defconstant.html | 147 + info/gcl/defgeneric.html | 330 + info/gcl/define_002dcompiler_002dmacro.html | 239 + info/gcl/define_002dcondition.html | 405 + .../define_002dmethod_002dcombination.html | 628 + info/gcl/define_002dmodify_002dmacro.html | 140 + info/gcl/define_002dsetf_002dexpander.html | 190 + info/gcl/define_002dsymbol_002dmacro.html | 133 + info/gcl/defmacro.html | 242 + info/gcl/defmethod.html | 238 + info/gcl/defpackage.html | 323 + info/gcl/defparameter.html | 233 + info/gcl/defsetf.html | 268 + info/gcl/defstruct.html | 1193 + info/gcl/deftype.html | 150 + info/gcl/defun.html | 173 + info/gcl/delete_002dfile.html | 107 + info/gcl/delete_002dpackage.html | 196 + info/gcl/deposit_002dfield.html | 96 + info/gcl/describe.html | 104 + info/gcl/describe_002dobject.html | 137 + info/gcl/destructuring_002dbind.html | 93 + info/gcl/digit_002dchar.html | 96 + info/gcl/digit_002dchar_002dp.html | 105 + info/gcl/directory.html | 110 + info/gcl/disassemble.html | 94 + info/gcl/division_002dby_002dzero.html | 64 + info/gcl/do.html | 330 + info/gcl/do_002dsymbols.html | 174 + info/gcl/documentation.html | 247 + info/gcl/dolist.html | 144 + info/gcl/dotimes.html | 172 + info/gcl/dpb.html | 118 + info/gcl/dribble.html | 112 + info/gcl/dynamic_002dextent.html | 267 + info/gcl/echo_002dstream.html | 76 + .../echo_002dstream_002dinput_002dstream.html | 71 + info/gcl/ed.html | 101 + info/gcl/elt.html | 99 + info/gcl/encode_002duniversal_002dtime.html | 88 + info/gcl/end_002dof_002dfile.html | 74 + info/gcl/endp.html | 97 + .../gcl/ensure_002ddirectories_002dexist.html | 102 + info/gcl/ensure_002dgeneric_002dfunction.html | 158 + info/gcl/eq.html | 150 + info/gcl/eql-_0028Type-Specifier_0029.html | 72 + info/gcl/eql.html | 167 + info/gcl/equal.html | 193 + info/gcl/equalp.html | 197 + info/gcl/error-_0028Condition-Type_0029.html | 61 + info/gcl/error.html | 171 + info/gcl/eval.html | 121 + info/gcl/eval_002dwhen.html | 262 + info/gcl/evenp.html | 89 + info/gcl/every.html | 149 + info/gcl/exp.html | 165 + info/gcl/export.html | 158 + info/gcl/extended_002dchar.html | 67 + info/gcl/fboundp.html | 118 + info/gcl/fdefinition.html | 117 + info/gcl/file_002dauthor.html | 91 + info/gcl/file_002derror.html | 77 + info/gcl/file_002derror_002dpathname.html | 75 + info/gcl/file_002dlength.html | 89 + info/gcl/file_002dposition.html | 169 + info/gcl/file_002dstream.html | 72 + info/gcl/file_002dstring_002dlength.html | 72 + info/gcl/file_002dwrite_002ddate.html | 97 + info/gcl/fill.html | 103 + info/gcl/fill_002dpointer.html | 95 + info/gcl/find.html | 137 + info/gcl/find_002dall_002dsymbols.html | 88 + info/gcl/find_002dclass.html | 120 + info/gcl/find_002dmethod.html | 137 + info/gcl/find_002dpackage.html | 93 + info/gcl/find_002drestart.html | 117 + info/gcl/find_002dsymbol.html | 147 + info/gcl/finish_002doutput.html | 108 + info/gcl/first.html | 168 + info/gcl/fixnum.html | 72 + info/gcl/flet.html | 317 + info/gcl/float-_0028System-Class_0029.html | 137 + info/gcl/float.html | 94 + info/gcl/floating_002dpoint_002dinexact.html | 70 + ...g_002dpoint_002dinvalid_002doperation.html | 70 + info/gcl/floating_002dpoint_002doverflow.html | 64 + .../gcl/floating_002dpoint_002dunderflow.html | 69 + info/gcl/floatp.html | 80 + info/gcl/floor.html | 205 + info/gcl/fmakunbound.html | 91 + info/gcl/format.html | 118 + info/gcl/formatter.html | 96 + info/gcl/ftype.html | 109 + info/gcl/funcall.html | 108 + .../function-_0028Special-Operator_0029.html | 128 + info/gcl/function-_0028System-Class_0029.html | 217 + info/gcl/function_002dkeywords.html | 106 + .../function_002dlambda_002dexpression.html | 150 + info/gcl/functionp.html | 84 + info/gcl/gcd.html | 95 + info/gcl/generic_002dfunction.html | 76 + info/gcl/gensym.html | 130 + info/gcl/gentemp.html | 142 + info/gcl/get.html | 161 + .../get_002dinternal_002dreal_002dtime.html | 73 + .../get_002dinternal_002drun_002dtime.html | 84 + .../get_002doutput_002dstream_002dstring.html | 96 + info/gcl/get_002dproperties.html | 97 + info/gcl/get_002dsetf_002dexpansion.html | 112 + info/gcl/get_002duniversal_002dtime.html | 121 + info/gcl/getf.html | 159 + info/gcl/gethash.html | 122 + info/gcl/go.html | 109 + info/gcl/graphic_002dchar_002dp.html | 85 + info/gcl/handler_002dbind.html | 136 + info/gcl/handler_002dcase.html | 220 + info/gcl/hash_002dtable.html | 72 + info/gcl/hash_002dtable_002dcount.html | 103 + info/gcl/hash_002dtable_002dp.html | 79 + .../hash_002dtable_002drehash_002dsize.html | 99 + ...sh_002dtable_002drehash_002dthreshold.html | 85 + info/gcl/hash_002dtable_002dsize.html | 76 + info/gcl/hash_002dtable_002dtest.html | 77 + info/gcl/identity.html | 83 + info/gcl/if.html | 107 + info/gcl/ignore.html | 132 + info/gcl/ignore_002derrors.html | 117 + info/gcl/import.html | 137 + info/gcl/in_002dpackage.html | 82 + info/gcl/incf.html | 106 + info/gcl/index.html | 3651 ++ info/gcl/initialize_002dinstance.html | 100 + info/gcl/inline.html | 172 + info/gcl/input_002dstream_002dp.html | 86 + info/gcl/inspect.html | 86 + info/gcl/integer.html | 103 + info/gcl/integer_002dlength.html | 106 + info/gcl/integerp.html | 79 + info/gcl/interactive_002dstream_002dp.html | 86 + info/gcl/intern.html | 146 + ...002dtime_002dunits_002dper_002dsecond.html | 69 + info/gcl/intersection.html | 174 + info/gcl/invalid_002dmethod_002derror.html | 94 + info/gcl/invoke_002ddebugger.html | 102 + info/gcl/invoke_002drestart.html | 113 + .../invoke_002drestart_002dinteractively.html | 138 + info/gcl/keyword.html | 80 + info/gcl/keywordp.html | 89 + info/gcl/lambda-_0028Symbol_0029.html | 97 + info/gcl/lambda.html | 96 + info/gcl/lambda_002dlist_002dkeywords.html | 82 + info/gcl/lambda_002dparameters_002dlimit.html | 70 + info/gcl/last.html | 131 + info/gcl/lcm.html | 104 + info/gcl/ldb.html | 130 + info/gcl/ldb_002dtest.html | 89 + info/gcl/ldiff.html | 164 + info/gcl/length.html | 89 + info/gcl/let.html | 183 + .../gcl/lisp_002dimplementation_002dtype.html | 90 + info/gcl/list-_0028Function_0029.html | 116 + info/gcl/list-_0028System-Class_0029.html | 97 + info/gcl/list_002dall_002dpackages.html | 81 + info/gcl/list_002dlength.html | 111 + info/gcl/listen.html | 92 + info/gcl/listp.html | 86 + info/gcl/load.html | 231 + ...logical_002dpathname_002dtranslations.html | 105 + info/gcl/load_002dtime_002dvalue.html | 197 + info/gcl/locally.html | 120 + info/gcl/log.html | 146 + info/gcl/logand.html | 197 + info/gcl/logbitp.html | 95 + info/gcl/logcount.html | 99 + ...l_002dpathname-_0028System-Class_0029.html | 70 + info/gcl/logical_002dpathname.html | 95 + ...logical_002dpathname_002dtranslations.html | 242 + info/gcl/logtest.html | 93 + info/gcl/loop.html | 242 + info/gcl/loop_002dfinish.html | 145 + info/gcl/machine_002dinstance.html | 84 + info/gcl/machine_002dtype.html | 79 + info/gcl/machine_002dversion.html | 79 + info/gcl/macro_002dfunction.html | 136 + info/gcl/macroexpand.html | 211 + info/gcl/make_002darray.html | 316 + info/gcl/make_002dbroadcast_002dstream.html | 83 + .../gcl/make_002dconcatenated_002dstream.html | 79 + info/gcl/make_002dcondition.html | 97 + ..._002ddispatch_002dmacro_002dcharacter.html | 95 + info/gcl/make_002decho_002dstream.html | 87 + info/gcl/make_002dhash_002dtable.html | 145 + info/gcl/make_002dinstance.html | 101 + info/gcl/make_002dinstances_002dobsolete.html | 91 + info/gcl/make_002dlist.html | 87 + info/gcl/make_002dload_002dform.html | 339 + ...02dload_002dform_002dsaving_002dslots.html | 113 + info/gcl/make_002dpackage.html | 122 + info/gcl/make_002dpathname.html | 190 + info/gcl/make_002drandom_002dstate.html | 117 + info/gcl/make_002dsequence.html | 129 + info/gcl/make_002dstring.html | 91 + .../make_002dstring_002dinput_002dstream.html | 86 + ...make_002dstring_002doutput_002dstream.html | 90 + info/gcl/make_002dsymbol.html | 101 + info/gcl/make_002dsynonym_002dstream.html | 87 + info/gcl/make_002dtwo_002dway_002dstream.html | 85 + info/gcl/makunbound.html | 87 + info/gcl/map.html | 141 + info/gcl/map_002dinto.html | 133 + info/gcl/mapc.html | 196 + info/gcl/maphash.html | 112 + info/gcl/mask_002dfield.html | 101 + info/gcl/max.html | 131 + info/gcl/member-_0028Function_0029.html | 145 + info/gcl/member-_0028Type-Specifier_0029.html | 80 + info/gcl/merge.html | 172 + info/gcl/merge_002dpathnames.html | 187 + info/gcl/method.html | 79 + info/gcl/method_002dcombination.html | 65 + .../gcl/method_002dcombination_002derror.html | 85 + info/gcl/method_002dqualifiers.html | 81 + info/gcl/minusp.html | 85 + info/gcl/mismatch.html | 130 + info/gcl/mod-_0028Function_0029.html | 111 + info/gcl/mod-_0028System-Class_0029.html | 76 + info/gcl/most_002dpositive_002dfixnum.html | 68 + ...most_002dpositive_002dshort_002dfloat.html | 159 + info/gcl/muffle_002dwarning.html | 104 + info/gcl/multiple_002dvalue_002dbind.html | 116 + info/gcl/multiple_002dvalue_002dcall.html | 91 + info/gcl/multiple_002dvalue_002dlist.html | 85 + info/gcl/multiple_002dvalue_002dprog1.html | 84 + info/gcl/multiple_002dvalue_002dsetq.html | 117 + info/gcl/multiple_002dvalues_002dlimit.html | 75 + info/gcl/name_002dchar.html | 89 + info/gcl/namestring.html | 168 + info/gcl/nconc.html | 129 + info/gcl/next_002dmethod_002dp.html | 86 + info/gcl/nil-_0028Type_0029.html | 66 + info/gcl/nil.html | 69 + info/gcl/no_002dapplicable_002dmethod.html | 86 + info/gcl/no_002dnext_002dmethod.html | 90 + info/gcl/not-_0028Type-Specifier_0029.html | 71 + info/gcl/not.html | 87 + info/gcl/nth.html | 105 + info/gcl/nth_002dvalue.html | 98 + info/gcl/nthcdr.html | 100 + info/gcl/null-_0028System-Class_0029.html | 69 + info/gcl/null.html | 89 + info/gcl/number.html | 79 + info/gcl/numberp.html | 80 + info/gcl/numerator.html | 94 + info/gcl/open.html | 356 + info/gcl/open_002dstream_002dp.html | 86 + info/gcl/optimize.html | 146 + info/gcl/or-_0028Type-Specifier_0029.html | 77 + info/gcl/or.html | 99 + info/gcl/package.html | 66 + info/gcl/package_002derror.html | 72 + info/gcl/package_002derror_002dpackage.html | 82 + info/gcl/package_002dname.html | 88 + info/gcl/package_002dnicknames.html | 77 + .../package_002dshadowing_002dsymbols.html | 92 + info/gcl/package_002duse_002dlist.html | 82 + .../gcl/package_002dused_002dby_002dlist.html | 83 + info/gcl/packagep.html | 77 + info/gcl/pairlis.html | 114 + info/gcl/parse_002derror.html | 70 + info/gcl/parse_002dinteger.html | 119 + info/gcl/parse_002dnamestring.html | 210 + info/gcl/pathname-_0028System-Class_0029.html | 62 + info/gcl/pathname.html | 126 + info/gcl/pathname_002dhost.html | 181 + info/gcl/pathname_002dmatch_002dp.html | 88 + info/gcl/pathnamep.html | 84 + info/gcl/peek_002dchar.html | 150 + info/gcl/phase.html | 115 + info/gcl/pi.html | 82 + info/gcl/pop.html | 104 + info/gcl/position.html | 129 + info/gcl/pprint_002ddispatch.html | 101 + ...02dexit_002dif_002dlist_002dexhausted.html | 89 + info/gcl/pprint_002dfill.html | 161 + info/gcl/pprint_002dindent.html | 101 + info/gcl/pprint_002dlogical_002dblock.html | 196 + info/gcl/pprint_002dnewline.html | 184 + info/gcl/pprint_002dpop.html | 152 + info/gcl/pprint_002dtab.html | 95 + info/gcl/print_002dnot_002dreadable.html | 72 + ...print_002dnot_002dreadable_002dobject.html | 69 + info/gcl/print_002dobject.html | 210 + info/gcl/print_002dunreadable_002dobject.html | 106 + info/gcl/probe_002dfile.html | 100 + info/gcl/proclaim.html | 134 + info/gcl/prog.html | 202 + info/gcl/prog1.html | 134 + info/gcl/progn.html | 98 + info/gcl/program_002derror.html | 65 + info/gcl/progv.html | 105 + info/gcl/provide.html | 152 + info/gcl/psetq.html | 128 + info/gcl/push.html | 106 + info/gcl/pushnew.html | 153 + info/gcl/quote.html | 105 + info/gcl/random.html | 105 + info/gcl/random_002dstate.html | 75 + info/gcl/random_002dstate_002dp.html | 84 + info/gcl/rassoc.html | 141 + info/gcl/ratio.html | 74 + info/gcl/rational-_0028Function_0029.html | 121 + info/gcl/rational-_0028System-Class_0029.html | 87 + info/gcl/rationalp.html | 81 + info/gcl/read.html | 223 + info/gcl/read_002dbyte.html | 110 + info/gcl/read_002dchar.html | 125 + info/gcl/read_002dchar_002dno_002dhang.html | 133 + info/gcl/read_002ddelimited_002dlist.html | 184 + info/gcl/read_002dfrom_002dstring.html | 137 + info/gcl/read_002dline.html | 133 + info/gcl/read_002dsequence.html | 125 + info/gcl/reader_002derror.html | 79 + info/gcl/readtable.html | 74 + info/gcl/readtable_002dcase.html | 91 + info/gcl/readtablep.html | 78 + info/gcl/real.html | 86 + info/gcl/realp.html | 78 + info/gcl/realpart.html | 92 + info/gcl/reduce.html | 146 + info/gcl/reinitialize_002dinstance.html | 121 + info/gcl/remf.html | 104 + info/gcl/remhash.html | 80 + info/gcl/remove.html | 244 + info/gcl/remove_002dduplicates.html | 170 + info/gcl/remove_002dmethod.html | 78 + info/gcl/remprop.html | 143 + info/gcl/rename_002dfile.html | 131 + info/gcl/rename_002dpackage.html | 89 + info/gcl/replace.html | 124 + info/gcl/rest.html | 96 + info/gcl/restart.html | 65 + info/gcl/restart_002dbind.html | 171 + info/gcl/restart_002dcase.html | 332 + info/gcl/restart_002dname.html | 85 + info/gcl/return.html | 92 + info/gcl/return_002dfrom.html | 141 + info/gcl/revappend.html | 141 + info/gcl/reverse.html | 122 + info/gcl/room.html | 82 + info/gcl/rotatef.html | 117 + info/gcl/row_002dmajor_002daref.html | 90 + info/gcl/rplaca.html | 94 + info/gcl/satisfies.html | 82 + info/gcl/search.html | 124 + info/gcl/sequence.html | 70 + info/gcl/serious_002dcondition.html | 79 + info/gcl/set.html | 123 + info/gcl/set_002ddifference.html | 162 + ..._002ddispatch_002dmacro_002dcharacter.html | 154 + info/gcl/set_002dexclusive_002dor.html | 149 + info/gcl/set_002dmacro_002dcharacter.html | 135 + info/gcl/set_002dpprint_002ddispatch.html | 117 + .../gcl/set_002dsyntax_002dfrom_002dchar.html | 124 + info/gcl/setf-class_002dname.html | 77 + info/gcl/setf.html | 155 + info/gcl/setq.html | 125 + info/gcl/shadow.html | 131 + info/gcl/shadowing_002dimport.html | 113 + info/gcl/shared_002dinitialize.html | 178 + info/gcl/shiftf.html | 153 + info/gcl/short_002dfloat.html | 204 + info/gcl/short_002dfloat_002depsilon.html | 78 + info/gcl/short_002dsite_002dname.html | 83 + info/gcl/signal.html | 123 + info/gcl/signed_002dbyte.html | 88 + info/gcl/signum.html | 107 + info/gcl/simple_002darray.html | 115 + info/gcl/simple_002dbase_002dstring.html | 87 + info/gcl/simple_002dbit_002dvector.html | 90 + info/gcl/simple_002dbit_002dvector_002dp.html | 84 + info/gcl/simple_002dcondition.html | 81 + ..._002dcondition_002dformat_002dcontrol.html | 90 + info/gcl/simple_002derror.html | 69 + info/gcl/simple_002dstring.html | 87 + info/gcl/simple_002dstring_002dp.html | 77 + info/gcl/simple_002dtype_002derror.html | 86 + info/gcl/simple_002dvector.html | 89 + info/gcl/simple_002dvector_002dp.html | 82 + info/gcl/simple_002dwarning.html | 68 + info/gcl/sin.html | 90 + info/gcl/sinh.html | 185 + info/gcl/sleep.html | 90 + info/gcl/slot_002dboundp.html | 105 + info/gcl/slot_002dexists_002dp.html | 83 + info/gcl/slot_002dmakunbound.html | 99 + info/gcl/slot_002dmissing.html | 148 + info/gcl/slot_002dunbound.html | 108 + info/gcl/slot_002dvalue.html | 152 + info/gcl/software_002dtype.html | 84 + info/gcl/sort.html | 193 + info/gcl/special.html | 209 + info/gcl/special_002doperator_002dp.html | 82 + info/gcl/sqrt.html | 138 + info/gcl/standard_002dchar.html | 72 + info/gcl/standard_002dchar_002dp.html | 79 + info/gcl/standard_002dclass.html | 64 + .../standard_002dgeneric_002dfunction.html | 68 + info/gcl/standard_002dmethod.html | 66 + info/gcl/standard_002dobject.html | 61 + info/gcl/step.html | 94 + info/gcl/storage_002dcondition.html | 91 + info/gcl/store_002dvalue.html | 93 + info/gcl/stream.html | 70 + info/gcl/stream_002delement_002dtype.html | 93 + info/gcl/stream_002derror.html | 71 + info/gcl/stream_002derror_002dstream.html | 77 + info/gcl/stream_002dexternal_002dformat.html | 89 + info/gcl/streamp.html | 80 + info/gcl/string-_0028System-Class_0029.html | 91 + info/gcl/string.html | 111 + info/gcl/string_002dstream.html | 75 + info/gcl/string_002dtrim.html | 98 + info/gcl/string_002dupcase.html | 170 + info/gcl/string_003d.html | 212 + info/gcl/stringp.html | 83 + info/gcl/structure_002dclass.html | 65 + info/gcl/structure_002dobject.html | 71 + info/gcl/style_002dwarning.html | 85 + info/gcl/sublis.html | 168 + info/gcl/subseq.html | 123 + info/gcl/subsetp.html | 125 + info/gcl/subst.html | 196 + info/gcl/substitute.html | 244 + info/gcl/subtypep.html | 284 + info/gcl/svref.html | 99 + info/gcl/sxhash.html | 159 + info/gcl/symbol.html | 185 + info/gcl/symbol_002dfunction.html | 157 + info/gcl/symbol_002dmacrolet.html | 153 + info/gcl/symbol_002dname.html | 78 + info/gcl/symbol_002dpackage.html | 106 + info/gcl/symbol_002dplist.html | 95 + info/gcl/symbol_002dvalue.html | 129 + info/gcl/symbolp.html | 88 + info/gcl/synonym_002dstream.html | 76 + info/gcl/synonym_002dstream_002dsymbol.html | 67 + info/gcl/t-_0028System-Class_0029.html | 59 + info/gcl/t.html | 88 + info/gcl/tagbody.html | 145 + info/gcl/terpri.html | 115 + info/gcl/the.html | 131 + info/gcl/throw.html | 154 + info/gcl/time.html | 107 + info/gcl/trace.html | 148 + .../translate_002dlogical_002dpathname.html | 134 + info/gcl/translate_002dpathname.html | 221 + info/gcl/tree_002dequal.html | 118 + info/gcl/truename.html | 132 + info/gcl/two_002dway_002dstream.html | 71 + ...2dway_002dstream_002dinput_002dstream.html | 72 + info/gcl/type.html | 283 + info/gcl/type_002derror.html | 71 + info/gcl/type_002derror_002ddatum.html | 96 + info/gcl/type_002dof.html | 187 + info/gcl/typecase.html | 235 + info/gcl/typep.html | 178 + info/gcl/unbound_002dslot.html | 74 + info/gcl/unbound_002dslot_002dinstance.html | 76 + info/gcl/unbound_002dvariable.html | 76 + info/gcl/undefined_002dfunction.html | 76 + info/gcl/unexport.html | 107 + info/gcl/unintern.html | 121 + info/gcl/union.html | 170 + info/gcl/unread_002dchar.html | 126 + info/gcl/unsigned_002dbyte.html | 95 + info/gcl/unuse_002dpackage.html | 99 + info/gcl/unwind_002dprotect.html | 237 + ...tance_002dfor_002ddifferent_002dclass.html | 157 + ...tance_002dfor_002dredefined_002dclass.html | 205 + ...graded_002darray_002delement_002dtype.html | 105 + ...pgraded_002dcomplex_002dpart_002dtype.html | 83 + info/gcl/upper_002dcase_002dp.html | 103 + info/gcl/use_002dpackage.html | 123 + info/gcl/use_002dvalue.html | 72 + info/gcl/user_002dhomedir_002dpathname.html | 95 + info/gcl/values-_0028Type-Specifier_0029.html | 83 + info/gcl/values.html | 133 + info/gcl/values_002dlist.html | 95 + info/gcl/vector-_0028System-Class_0029.html | 129 + info/gcl/vector.html | 90 + info/gcl/vector_002dpop.html | 98 + info/gcl/vector_002dpush.html | 143 + info/gcl/vectorp.html | 79 + info/gcl/warn.html | 149 + info/gcl/warning.html | 64 + info/gcl/when.html | 145 + info/gcl/wild_002dpathname_002dp.html | 114 + info/gcl/with_002daccessors.html | 165 + info/gcl/with_002dcompilation_002dunit.html | 124 + info/gcl/with_002dcondition_002drestarts.html | 91 + .../with_002dhash_002dtable_002diterator.html | 155 + .../with_002dinput_002dfrom_002dstring.html | 142 + info/gcl/with_002dopen_002dfile.html | 170 + info/gcl/with_002dopen_002dstream.html | 101 + .../with_002doutput_002dto_002dstring.html | 147 + info/gcl/with_002dpackage_002diterator.html | 234 + info/gcl/with_002dsimple_002drestart.html | 161 + info/gcl/with_002dslots.html | 191 + .../with_002dstandard_002dio_002dsyntax.html | 111 + info/gcl/write.html | 207 + info/gcl/write_002dbyte.html | 100 + info/gcl/write_002dchar.html | 94 + info/gcl/write_002dsequence.html | 108 + info/gcl/write_002dstring.html | 115 + info/gcl/write_002dto_002dstring.html | 138 + info/gcl/y_002dor_002dn_002dp.html | 136 + info/gcl/zerop.html | 93 + info/general.texi | 687 + info/internal.texi | 361 + info/io.texi | 1008 + info/iteration.texi | 149 + info/list.texi | 899 + info/makefile | 126 + info/misc.texi | 47 + info/number.texi | 1332 + info/sequence.texi | 985 + info/si-defs.texi | 1157 + info/structure.texi | 43 + info/symbol.texi | 461 + info/system.texi | 458 + info/type.texi | 119 + info/user-interface.texi | 383 + info/widgets.texi | 5033 +++ install.sh | 250 + japitest.lsp | 369 + lsp/.gitignore | 3 + lsp/dbind.lisp | 15 + lsp/dummy.lisp | 1 + lsp/fasd.lisp | 151 + lsp/fast-mv.lisp | 41 + lsp/gcl_arraylib.lsp | 302 + lsp/gcl_assert.lsp | 81 + lsp/gcl_auto.lsp | 217 + lsp/gcl_auto_new.lsp | 213 + lsp/gcl_autocmp.lsp | 51 + lsp/gcl_autoload.lsp | 412 + lsp/gcl_cmpinit.lsp | 11 + lsp/gcl_debug.lsp | 823 + lsp/gcl_defmacro.lsp | 267 + lsp/gcl_defpackage.lsp | 339 + lsp/gcl_defstruct.lsp | 881 + lsp/gcl_describe.lsp | 448 + lsp/gcl_desetq.lsp | 25 + lsp/gcl_destructuring_bind.lsp | 403 + lsp/gcl_directory.lsp | 85 + lsp/gcl_doc-file.lsp | 24 + lsp/gcl_evalmacros.lsp | 277 + lsp/gcl_export.lsp | 488 + lsp/gcl_fdecl.lsp | 93 + lsp/gcl_fpe.lsp | 147 + lsp/gcl_fpe_test.lsp | 212 + lsp/gcl_gprof.lsp | 133 + lsp/gcl_info.lsp | 525 + lsp/gcl_iolib.lsp | 537 + lsp/gcl_japi.lsp | 308 + lsp/gcl_listlib.lsp | 213 + lsp/gcl_littleXlsp.lsp | Bin 0 -> 6572 bytes lsp/gcl_loadcmp.lsp | 47 + lsp/gcl_logical_pathname_translations.lsp | 28 + lsp/gcl_loop.lsp | 2184 + lsp/gcl_make-declare.lsp | 80 + lsp/gcl_make_defpackage.lsp | 52 + lsp/gcl_make_pathname.lsp | 179 + lsp/gcl_merge_pathnames.lsp | 18 + lsp/gcl_mislib.lsp | 213 + lsp/gcl_module.lsp | 117 + lsp/gcl_namestring.lsp | 39 + lsp/gcl_numlib.lsp | 280 + lsp/gcl_packages.lsp | 1 + lsp/gcl_packlib.lsp | 218 + lsp/gcl_parse_namestring.lsp | 123 + lsp/gcl_pathname_match_p.lsp | 14 + lsp/gcl_predlib.lsp | 839 + lsp/gcl_profile.lsp | 110 + lsp/gcl_readline.lsp | 12 + lsp/gcl_rename_file.lsp | 49 + lsp/gcl_restart.lsp | 196 + lsp/gcl_seq.lsp | 134 + lsp/gcl_seqlib.lsp | 808 + lsp/gcl_serror.lsp | 282 + lsp/gcl_setf.lsp | 536 + lsp/gcl_sharp.lsp | 66 + lsp/gcl_sharp_uv.lsp | 29 + lsp/gcl_sloop.lsp | 1230 + lsp/gcl_stack-problem.lsp | 29 + lsp/gcl_stdlisp.lsp | 61 + lsp/gcl_top.lsp | 645 + lsp/gcl_trace.lsp | 447 + lsp/gcl_translate_pathname.lsp | 90 + lsp/gcl_truename.lsp | 42 + lsp/gcl_wild_pathname_p.lsp | 28 + lsp/gprof.hc | 122 + lsp/gprof1.lisp | 53 + lsp/gprof_aix.hc | 255 + lsp/make.lisp | 409 + lsp/makefile | 62 + lsp/sys-proclaim.lisp | 666 + lsp/ucall.lisp | 143 + lsp/ustreams.lisp | 81 + ltmain.sh | 5476 +++ machines | 36 + majvers | 1 + makdefs | 42 + makedefc.in | 72 + makefile | 298 + man/man1/gcl.1 | 248 + merge.c | 450 + minvers | 1 + misc/check.c | 45 + misc/check_obj.c | 14 + misc/cstruct.lsp | 157 + misc/foreign.lsp | 121 + misc/mprotect.ch | 197 + misc/rusage.lsp | 44 + misc/test-seek.c | 37 + misc/test-sgc.lsp | 58 + misc/warn-slow.lsp | 50 + mp/fplus.c | 104 + mp/gcclab | 29 + mp/gcclab.awk | 13 + mp/gnulib1.c | 51 + mp/lo-ibmrt.s | 67 + mp/lo-rios.s | 106 + mp/lo-rios1.s | 26 + mp/lo-sgi4d.s | 58 + mp/lo-u370_aix.s | 77 + mp/make.defs | 37 + mp/makefile | 76 + mp/mp2.c | 619 + mp/mp_addmul.c | 40 + mp/mp_bfffo.c | 64 + mp/mp_dblrsl3.c | 45 + mp/mp_dblrul3.c | 39 + mp/mp_divul3.c | 65 + mp/mp_divul3_word.c | 80 + mp/mp_mulul3.c | 69 + mp/mp_shiftl.c | 34 + mp/mp_sl3todivul3.c | 110 + mp/mpi-386_no_under.s | 2337 ++ mp/mpi-386d.S | 2323 ++ mp/mpi-bsd68k.s | 2164 + mp/mpi-sol-sparc.s | 2848 ++ mp/mpi-sparc.s | 2808 ++ mp/mpi.c | 649 + mp/readme | 85 + mp/sparcdivul3.s | 283 + o/.gitignore | 6 + o/ChangeLog | 1385 + o/NeXTunixfasl.c | 469 + o/NeXTunixsave.c | 499 + o/Vmalloc.c | 101 + o/alloc.c | 1785 + o/array.c | 1536 + o/array.c.prev | 1064 + o/array.c1 | 1085 + o/assignment.c | 589 + o/backq.c | 383 + o/bcmp.c | 11 + o/bcopy.c | 10 + o/bds.c | 37 + o/before_init.c | 53 + o/big.c | 188 + o/bind.c | 1158 + o/bind.texi | 1 + o/bitop.c | 47 + o/block.c | 123 + o/bsearch.c | 30 + o/bzero.c | 7 + o/catch.c | 165 + o/cfun.c | 386 + o/character.d | 669 + o/clxsocket.c | 166 + o/cmac.c | 249 + o/cmpaux.c | 579 + o/conditional.c | 205 + o/earith.c | 6 + o/egrep-def | 5 + o/error.c | 598 + o/eval.c | 1400 + o/external_funs.h | 423 + o/fasdump.c | 1451 + o/fasldlsym.c | 118 + o/fasldlsym.c.link | 73 + o/faslhp800.c | 163 + o/faslnt.c | 6 + o/faslsgi4.c | 463 + o/fat_string.c | 404 + o/file.d | 2404 ++ o/firstfile.c | 34 + o/fix-structref.el | 17 + o/format.c | 2323 ++ o/frame.c | 84 + o/funlink.c | 622 + o/funs | 24 + o/gbc.c | 1552 + o/gcl_readline.d | 394 + o/gdb_commands | 45 + o/gmp.c | 34 + o/gmp_big.c | 567 + o/gmp_num_log.c | 117 + o/gnumalloc.c | 815 + o/gprof.c | 112 + o/grab_defs.c | 98 + o/grab_defs.u | 1 + o/hash.d | 744 + o/help.el | 425 + o/init_pari.c | 96 + o/internal-calls.lisp | 3227 ++ o/iteration.c | 458 + o/lastfile.c | 50 + o/let.c | 322 + o/lex.c | 129 + o/list.d | 1387 + o/littleXwin.c | 239 + o/macros.c | 348 + o/main.c | 1341 + o/makefile | 110 + o/makefun.c | 243 + o/malloc.c | 788 + o/mapfun.c | 326 + o/mingfile.c | 13 + o/mingwin.c | 954 + o/multival.c | 139 + o/mych | 60 + o/ndiv.c | 118 + o/nfunlink.c | 339 + o/nmul.c | 37 + o/nsocket.c | 683 + o/ntheap.h | 117 + o/num_arith.c | 1040 + o/num_co.c | 1165 + o/num_comp.c | 328 + o/num_log.c | 529 + o/num_pred.c | 253 + o/num_rand.c | 222 + o/num_sfun.c | 768 + o/number.c | 332 + o/package.d | 1317 + o/pari_big.c | 565 + o/pari_num_log.c | 245 + o/pathname.d | 125 + o/peculiar.c | 37 + o/plt.c | 202 + o/plttest.c | 86 + o/pre_init.c | 61 + o/predicate.c | 830 + o/prelink.c | 43 + o/print.d | 2160 + o/prog.c | 304 + o/read.d | 2513 ++ o/readme | 16 + o/reference.c | 195 + o/regexp.c | 1551 + o/regexp.h | 29 + o/regexpr.c | 193 + o/rel_aix.c | 110 + o/rel_coff.c | 86 + o/rel_hp300.c | 218 + o/rel_mac2.c | 84 + o/rel_ps2aix.c | 91 + o/rel_rios.c | 284 + o/rel_stand.c | 88 + o/rel_sun3.c | 44 + o/rel_sun4.c | 166 + o/rel_u370aix.c | 94 + o/run_process.c | 675 + o/save.c | 39 + o/save_sgi4.c | 472 + o/saveaix3.c | 283 + o/savedec31.c | 249 + o/saveu370.c | 188 + o/sbrk.c | 28 + o/sequence.d | 548 + o/sfasl.c | 84 + o/sfaslbfd.c | 393 + o/sfaslcoff.c | 501 + o/sfaslelf.c | 633 + o/sfasli.c | 143 + o/sfaslmacho.c | 584 + o/sfaslmacosx.c | 249 + o/sgbc.c | 1043 + o/sgi4d_emul.s | 68 + o/sockets.c | 556 + o/strcspn.c | 16 + o/string.d | 637 + o/structure.c | 465 + o/symbol.d | 711 + o/test_memprotect.c | 71 + o/toplevel.c | 241 + o/try.c | 496 + o/typespec.c | 301 + o/u370_emul.s | 82 + o/unexaix.c | 936 + o/unexec-19.29.c | 1197 + o/unexec.c | 1198 + o/unexelf.c | 1254 + o/unexelfsgi.c | 861 + o/unexhp9k800.c | 310 + o/unexlin.c | 969 + o/unexmacosx.c | 1192 + o/unexmips.c | 342 + o/unexnt.c | 1164 + o/unexsgi.c | 896 + o/unixfasl.c | 194 + o/unixfsys.c | 582 + o/unixsave.c | 164 + o/unixsys.c | 189 + o/unixtime.c | 304 + o/user_init.c | 3 + o/user_match.c | 3 + o/usig.c | 320 + o/usig2.c | 427 + o/usig2_aux.c | 81 + o/utils.c | 213 + o/wpool.c | 35 + o/xdrfuns.c | 186 + pcl/.gitignore | 3 + pcl/README | 11 + pcl/defsys.lisp | 943 + pcl/extensions/extensions.lisp | 496 + pcl/extensions/inline.lisp | 263 + pcl/extensions/user-instances.lisp | 684 + pcl/gcl_pcl_boot.lisp | 2195 + pcl/gcl_pcl_braid.lisp | 760 + pcl/gcl_pcl_cache.lisp | 1689 + pcl/gcl_pcl_combin.lisp | 407 + pcl/gcl_pcl_compat.lisp | 31 + pcl/gcl_pcl_cpl.lisp | 314 + pcl/gcl_pcl_ctypes.lisp | 45 + pcl/gcl_pcl_defclass.lisp | 467 + pcl/gcl_pcl_defcombin.lisp | 430 + pcl/gcl_pcl_defs.lisp | 970 + pcl/gcl_pcl_dfun.lisp | 1617 + pcl/gcl_pcl_dlisp.lisp | 425 + pcl/gcl_pcl_dlisp2.lisp | 178 + pcl/gcl_pcl_env.lisp | 406 + pcl/gcl_pcl_fast_init.lisp | 1048 + pcl/gcl_pcl_fin.lisp | 1868 + pcl/gcl_pcl_fixup.lisp | 40 + pcl/gcl_pcl_fngen.lisp | 214 + pcl/gcl_pcl_fsc.lisp | 100 + pcl/gcl_pcl_generic_functions.lisp | 779 + pcl/gcl_pcl_init.lisp | 261 + pcl/gcl_pcl_iterate.lisp | 1267 + pcl/gcl_pcl_low.lisp | 459 + pcl/gcl_pcl_macros.lisp | 789 + pcl/gcl_pcl_methods.lisp | 1647 + pcl/gcl_pcl_pkg.lisp | 405 + pcl/gcl_pcl_precom1.lisp | 51 + pcl/gcl_pcl_precom2.lisp | 31 + pcl/gcl_pcl_slots.lisp | 385 + pcl/gcl_pcl_slots_boot.lisp | 406 + pcl/gcl_pcl_std_class.lisp | 1321 + pcl/gcl_pcl_vector.lisp | 1109 + pcl/gcl_pcl_walk.lisp | 2198 ++ pcl/impl/cmu/README | 17 + pcl/impl/cmu/cmu-low.lisp | 217 + pcl/impl/cmu/pclcom.lisp | 66 + pcl/impl/cmu/pclload.lisp | 12 + pcl/impl/coral/coral-low.lisp | 63 + pcl/impl/franz/cpatch.lisp | 32 + pcl/impl/franz/excl-low.lisp | 136 + pcl/impl/franz/quadlap.lisp | 619 + pcl/impl/gcl/README | 14 + pcl/impl/gcl/gcl-low.lisp | 316 + pcl/impl/gcl/gcl-patches.lisp | 225 + pcl/impl/gcl/gcl_pcl_impl_low.lisp | 310 + pcl/impl/gcl/makefile.gcl | 38 + pcl/impl/gcl/sys-package.lisp | 149 + pcl/impl/gcl/sys-proclaim.lisp | 1448 + pcl/impl/gold-hill/gold-low.lisp | 51 + pcl/impl/gold-hill/gold-patches.lisp | 168 + pcl/impl/hp/hp-low.lisp | 37 + pcl/impl/ibcl/ibcl-low.lisp | 327 + pcl/impl/ibcl/ibcl-patches.lisp | 129 + pcl/impl/kcl/kcl-low.lisp | 438 + pcl/impl/kcl/kcl-mods.text | 224 + pcl/impl/kcl/kcl-notes.text | 39 + pcl/impl/kcl/kcl-patches.lisp | 362 + pcl/impl/kcl/makefile.akcl | 32 + pcl/impl/kcl/misc-kcl-patches.text | 340 + pcl/impl/kcl/new-kcl-wrapper.text | 2157 + pcl/impl/kcl/sys-package.lisp | 149 + pcl/impl/kcl/sys-proclaim.lisp | 818 + pcl/impl/kcl/sysdef.lisp | 121 + pcl/impl/lucid/lucid-low.lisp | 384 + pcl/impl/pyramid/pyr-low.lisp | 50 + pcl/impl/pyramid/pyr-patches.lisp | 9 + pcl/impl/symbolics/cloe-low.lisp | 32 + pcl/impl/symbolics/genera-low.lisp | 423 + pcl/impl/symbolics/rel-7-2-patches.lisp | 387 + pcl/impl/symbolics/rel-8-patches.lisp | 255 + pcl/impl/ti/ti-low.lisp | 83 + pcl/impl/ti/ti-patches.lisp | 105 + pcl/impl/vaxlisp/vaxl-low.lisp | 80 + pcl/impl/xerox/pcl-env-internal.lisp | 261 + pcl/impl/xerox/pcl-env.lisp | 1629 + pcl/impl/xerox/pcl-env.text | 105 + pcl/impl/xerox/xerox-low.lisp | 173 + pcl/impl/xerox/xerox-patches.lisp | 248 + pcl/makefile | 73 + pcl/notes/12-7-88-notes.text | 45 + pcl/notes/3-17-88-notes.text | 167 + pcl/notes/3-19-87-notes.text | 138 + pcl/notes/4-21-87-notes.text | 53 + pcl/notes/4-29-87-notes.text | 80 + pcl/notes/5-22-87-notes.text | 126 + pcl/notes/5-22-89-notes.text | 152 + pcl/notes/8-28-88-notes.text | 537 + pcl/notes/get-pcl.text | 180 + pcl/notes/lap.text | 655 + pcl/notes/may-day-notes.text | 98 + pcl/notes/notes.text | 366 + pcl/notes/readme.text | 11 + pcl/old/construct.lisp | 1064 + pcl/old/dlap.lisp | 639 + pcl/old/lap.lisp | 500 + pcl/old/plap.lisp | 369 + pcl/package.lisp | 21 + pcl/pcl_methods.patch | 11 + pcl/sys-proclaim.lisp | 1852 + pcl/test/bench-precompile.lisp | 3 + pcl/test/bench.lisp | 575 + pcl/test/bench.out | 21 + pcl/test/list-functions.lisp | 141 + pcl/test/make-test.lisp | 47 + pcl/test/makediff | Bin 0 -> 953 bytes pcl/test/time.lisp | 156 + pcl/unused/precom4.lisp | 32 + readme | 359 + readme-bin.mingw | 32 + readme.gmp | 20 + readme.mingw | 119 + readme.xgcl | 77 + release | 1 + unixport/.gitignore | 8 + unixport/aix-crt0.el | 7 + unixport/aix_exports | 1892 + unixport/ansi_cl.lisp | 159 + unixport/boots | 55 + unixport/bsd_rsym.c | 154 + unixport/cmpboots | 18 + unixport/gcldos.lsp | 84 + unixport/gcrt0.el | Bin 0 -> 203 bytes unixport/lspboots | 19 + unixport/make_kcn | 5 + unixport/makefile | 169 + unixport/makefile.dos | 188 + unixport/msys.c | 85 + unixport/ncrt0.el | Bin 0 -> 214 bytes unixport/rsym.c | 349 + unixport/rsym_elf.c | 311 + unixport/rsym_macosx.c | 99 + unixport/rsym_nt.c | 68 + unixport/so_locations | 4 + unixport/sys-init.lsp | 5 + unixport/sys.c | 56 + unixport/sys_ansi_gcl.c | 207 + unixport/sys_boot.c | 67 + unixport/sys_gcl.c | 123 + unixport/sys_init.lsp.in | 91 + unixport/sys_kcn.c | 26 + unixport/sys_pcl_gcl.c | 201 + unixport/sys_pre_gcl.c | 111 + unixport/tryserv.tcl | 29 + utils/replace | 4 + utils/repls1.sed | 31 + utils/repls2.sed | 8 + utils/repls3.sed | 25 + utils/repls4.sed | 90 + utils/repls5.sed | 93 + utils/revstruct.sed | 184 + windows/.gitignore | 3 + windows/gcl.iss.in | 47 + windows/install.lsp.in | 165 + windows/instdos.sh | 6 + windows/sysdir.bat.in | 5 + xbin/.gitignore | 1 + xbin/386-linux-fix | 10 + xbin/add-dir | 16 + xbin/append | 5 + xbin/append.bat | 3 + xbin/comp_rel | 16 + xbin/compare-src | 19 + xbin/compare.c | 31 + xbin/dfiles | 2 + xbin/distrib-help | 9 + xbin/distribute | 67 + xbin/dos-files | 21 + xbin/dosmake.bat | 73 + xbin/exists | 4 + xbin/fix-copyright | 78 + xbin/get-externals | 11 + xbin/get-internal-calls | 12 + xbin/get-machine | 2 + xbin/ibm | 7 + xbin/if-exist.bat | 5 + xbin/if-exists | 15 + xbin/if-have-gcc | 3 + xbin/inc-version | 6 + xbin/is-V-newest | 37 + xbin/make-fn | 21 + xbin/maketest | 43 + xbin/maketest1 | 48 + xbin/move-if-changed | 17 + xbin/new-files | 19 + xbin/notify | 26 + xbin/setup-tmptest | 13 + xbin/spp.c | 102 + xbin/strip-ifdef | 10 + xbin/test | 16 + xbin/test-distrib | 27 + xbin/test1 | 19 + xbin/update | 4 + xgcl-2/.gitignore | 6 + xgcl-2/Events.c | 3920 ++ xgcl-2/README | 119 + xgcl-2/XStruct-2.c | 1465 + xgcl-2/XStruct-4.c | 2484 ++ xgcl-2/Xakcl.paper | 801 + xgcl-2/Xutil-2.c | 56 + xgcl-2/dec.copyright | 23 + xgcl-2/dwdoc.pdf | Bin 0 -> 104815 bytes xgcl-2/dwdoc.tex | 958 + xgcl-2/dwdoc/dwdoc1.html | 948 + xgcl-2/dwdoc/dwdoc2.html | 117 + xgcl-2/dwdoc/dwdoc3.html | 44 + xgcl-2/dwdoc/dwdoccontents.html | 1 + xgcl-2/dwdoc/dwdocindex.html | 1 + xgcl-2/gcl_X.lsp | 689 + xgcl-2/gcl_X10.lsp | 30 + xgcl-2/gcl_XAtom.lsp | 118 + xgcl-2/gcl_XStruct_l_3.lsp | 491 + xgcl-2/gcl_Xakcl.example.lsp | 326 + xgcl-2/gcl_Xinit.lsp | 147 + xgcl-2/gcl_Xlib.lsp | 3456 ++ xgcl-2/gcl_Xstruct.lsp | 311 + xgcl-2/gcl_Xutil.lsp | 797 + xgcl-2/gcl_defentry_events.lsp | 817 + xgcl-2/gcl_dispatch-events.lsp | 50 + xgcl-2/gcl_draw-gates.lsp | 101 + xgcl-2/gcl_draw.lsp | 1089 + xgcl-2/gcl_drawtrans.lsp | 1890 + xgcl-2/gcl_dwexports.lsp | 153 + xgcl-2/gcl_dwimports.lsp | 77 + xgcl-2/gcl_dwimportsb.lsp | 76 + xgcl-2/gcl_dwindow.lsp | 3020 ++ xgcl-2/gcl_dwsyms.lsp | 148 + xgcl-2/gcl_dwtest.lsp | 192 + xgcl-2/gcl_dwtestcases.lsp | 32 + xgcl-2/gcl_dwtrans.lsp | 2894 ++ xgcl-2/gcl_editors.lsp | 483 + xgcl-2/gcl_editorstrans.lsp | 589 + xgcl-2/gcl_general.lsp | 86 + xgcl-2/gcl_ice-cream.lsp | 37 + xgcl-2/gcl_imports.lsp | 728 + xgcl-2/gcl_index.lsp | 88 + xgcl-2/gcl_init_xgcl.lsp | 118 + xgcl-2/gcl_keysymdef.lsp | 1151 + xgcl-2/gcl_lispserver.lsp | 130 + xgcl-2/gcl_lispservertrans.lsp | 110 + xgcl-2/gcl_menu-set.lsp | 521 + xgcl-2/gcl_menu-settrans.lsp | 531 + xgcl-2/gcl_pcalc.lsp | 133 + xgcl-2/gcl_sysinit.lsp | 69 + xgcl-2/gcl_tohtml.lsp | 502 + xgcl-2/general-c.c | 65 + xgcl-2/gnu.license | 249 + xgcl-2/makefile | 38 + xgcl-2/package.lisp | 1 + xgcl-2/sys-proclaim.lisp | 287 + xgcl-2/sysdef.lisp | 81 + xgcl-2/version | 1 + 4981 files changed, 1245108 insertions(+) create mode 100644 .gitignore create mode 100644 AC_FD_CC create mode 100644 AC_FD_MSG create mode 100755 COPYING.LIB-2.0 create mode 100755 ChangeLog create mode 100755 ChangeLog.old create mode 100644 README.macosx create mode 100644 README.openbsd create mode 100644 README.wine create mode 100644 RELEASE-2.5.1 create mode 100644 RELEASE-2.6.2.html create mode 100755 add-defs create mode 100755 add-defs.bat create mode 100755 add-defs1 create mode 100644 ansi-tests/.cvsignore create mode 100644 ansi-tests/README create mode 100644 ansi-tests/adjustable-array-p.lsp create mode 100644 ansi-tests/and.lsp create mode 100644 ansi-tests/ansi-aux.lsp create mode 100644 ansi-tests/apply.lsp create mode 100644 ansi-tests/aref.lsp create mode 100644 ansi-tests/array-as-class.lsp create mode 100644 ansi-tests/array-aux.lsp create mode 100644 ansi-tests/array-dimension.lsp create mode 100644 ansi-tests/array-dimensions.lsp create mode 100644 ansi-tests/array-displacement.lsp create mode 100644 ansi-tests/array-in-bounds-p.lsp create mode 100644 ansi-tests/array-misc.lsp create mode 100644 ansi-tests/array-rank.lsp create mode 100644 ansi-tests/array-row-major-index.lsp create mode 100644 ansi-tests/array-t.lsp create mode 100644 ansi-tests/array-total-size.lsp create mode 100644 ansi-tests/array.lsp create mode 100644 ansi-tests/arrayp.lsp create mode 100644 ansi-tests/assert.lsp create mode 100644 ansi-tests/atom-errors.lsp create mode 100644 ansi-tests/bit-and.lsp create mode 100644 ansi-tests/bit-andc1.lsp create mode 100644 ansi-tests/bit-andc2.lsp create mode 100644 ansi-tests/bit-eqv.lsp create mode 100644 ansi-tests/bit-ior.lsp create mode 100644 ansi-tests/bit-nand.lsp create mode 100644 ansi-tests/bit-nor.lsp create mode 100644 ansi-tests/bit-not.lsp create mode 100644 ansi-tests/bit-orc1.lsp create mode 100644 ansi-tests/bit-orc2.lsp create mode 100644 ansi-tests/bit-vector-p.lsp create mode 100644 ansi-tests/bit-vector.lsp create mode 100644 ansi-tests/bit-xor.lsp create mode 100644 ansi-tests/bit.lsp create mode 100644 ansi-tests/block.lsp create mode 100644 ansi-tests/boundp.lsp create mode 100644 ansi-tests/broadcast-stream-streams.lsp create mode 100644 ansi-tests/call-arguments-limit.lsp create mode 100644 ansi-tests/case.lsp create mode 100644 ansi-tests/catch.lsp create mode 100644 ansi-tests/ccase.lsp create mode 100644 ansi-tests/cell-error-name.lsp create mode 100644 ansi-tests/cerror.lsp create mode 100644 ansi-tests/char-aux.lsp create mode 100644 ansi-tests/char-compare.lsp create mode 100644 ansi-tests/char-schar.lsp create mode 100644 ansi-tests/character.lsp create mode 100644 ansi-tests/check-type.lsp create mode 100644 ansi-tests/cl-symbol-names.lsp create mode 100644 ansi-tests/cl-symbols-aux.lsp create mode 100644 ansi-tests/cl-symbols.lsp create mode 100644 ansi-tests/cl-test-package.lsp create mode 100644 ansi-tests/clear-input.lsp create mode 100644 ansi-tests/clear-output.lsp create mode 100644 ansi-tests/cltest.system create mode 100644 ansi-tests/coerce.lsp create mode 100644 ansi-tests/compile-and-load.lsp create mode 100644 ansi-tests/compile-file-test-file.lsp create mode 100644 ansi-tests/compile.lsp create mode 100644 ansi-tests/compiled-function-p.lsp create mode 100644 ansi-tests/compiler-macros.lsp create mode 100644 ansi-tests/complement.lsp create mode 100644 ansi-tests/concatenate.lsp create mode 100644 ansi-tests/concatenated-stream-streams.lsp create mode 100644 ansi-tests/cond.lsp create mode 100644 ansi-tests/condition.lsp create mode 100644 ansi-tests/cons-test-01.lsp create mode 100644 ansi-tests/cons-test-02.lsp create mode 100644 ansi-tests/cons-test-03.lsp create mode 100644 ansi-tests/cons-test-04.lsp create mode 100644 ansi-tests/cons-test-05.lsp create mode 100644 ansi-tests/cons-test-06.lsp create mode 100644 ansi-tests/cons-test-07.lsp create mode 100644 ansi-tests/cons-test-08.lsp create mode 100644 ansi-tests/cons-test-09.lsp create mode 100644 ansi-tests/cons-test-10.lsp create mode 100644 ansi-tests/cons-test-11.lsp create mode 100644 ansi-tests/cons-test-12.lsp create mode 100644 ansi-tests/cons-test-13.lsp create mode 100644 ansi-tests/cons-test-14.lsp create mode 100644 ansi-tests/cons-test-15.lsp create mode 100644 ansi-tests/cons-test-16.lsp create mode 100644 ansi-tests/cons-test-17.lsp create mode 100644 ansi-tests/cons-test-18.lsp create mode 100644 ansi-tests/cons-test-19.lsp create mode 100644 ansi-tests/cons-test-20.lsp create mode 100644 ansi-tests/cons-test-21.lsp create mode 100644 ansi-tests/cons-test-22.lsp create mode 100644 ansi-tests/cons-test-23.lsp create mode 100644 ansi-tests/cons-test-24.lsp create mode 100644 ansi-tests/cons-test-25.lsp create mode 100644 ansi-tests/constantly.lsp create mode 100644 ansi-tests/constantp.lsp create mode 100644 ansi-tests/copy-seq.lsp create mode 100644 ansi-tests/count-if-not.lsp create mode 100644 ansi-tests/count-if.lsp create mode 100644 ansi-tests/count.lsp create mode 100644 ansi-tests/ctypecase.lsp create mode 100644 ansi-tests/data-and-control-flow.lsp create mode 100644 ansi-tests/defconstant.lsp create mode 100644 ansi-tests/define-modify-macro.lsp create mode 100644 ansi-tests/defparameter.lsp create mode 100644 ansi-tests/defun.lsp create mode 100644 ansi-tests/defvar.lsp create mode 100644 ansi-tests/delete-file.lsp create mode 100644 ansi-tests/destructuring-bind.lsp create mode 100644 ansi-tests/directory-namestring.lsp create mode 100644 ansi-tests/directory.lsp create mode 100644 ansi-tests/ecase.lsp create mode 100644 ansi-tests/echo-stream-input-stream.lsp create mode 100644 ansi-tests/echo-stream-output-stream.lsp create mode 100644 ansi-tests/elt.lsp create mode 100644 ansi-tests/enough-namestring.lsp create mode 100644 ansi-tests/ensure-directories-exist.lsp create mode 100644 ansi-tests/eql.lsp create mode 100644 ansi-tests/equal.lsp create mode 100644 ansi-tests/equalp.lsp create mode 100644 ansi-tests/error.lsp create mode 100644 ansi-tests/etypecase.lsp create mode 100644 ansi-tests/eval-and-compile.lsp create mode 100644 ansi-tests/eval.lsp create mode 100644 ansi-tests/every.lsp create mode 100644 ansi-tests/fboundp.lsp create mode 100644 ansi-tests/fdefinition.lsp create mode 100644 ansi-tests/features.lsp create mode 100644 ansi-tests/file-author.lsp create mode 100644 ansi-tests/file-error.lsp create mode 100644 ansi-tests/file-length.lsp create mode 100644 ansi-tests/file-namestring.lsp create mode 100644 ansi-tests/file-position.lsp create mode 100644 ansi-tests/file-string-length.lsp create mode 100644 ansi-tests/file-write-date.lsp create mode 100644 ansi-tests/fill-pointer.lsp create mode 100644 ansi-tests/fill-strings.lsp create mode 100644 ansi-tests/fill.lsp create mode 100644 ansi-tests/find-if-not.lsp create mode 100644 ansi-tests/find-if.lsp create mode 100644 ansi-tests/find.lsp create mode 100644 ansi-tests/finish-output.lsp create mode 100644 ansi-tests/flet.lsp create mode 100644 ansi-tests/fmakunbound.lsp create mode 100644 ansi-tests/force-output.lsp create mode 100644 ansi-tests/fresh-line.lsp create mode 100644 ansi-tests/funcall.lsp create mode 100644 ansi-tests/function-lambda-expression.lsp create mode 100644 ansi-tests/function.lsp create mode 100644 ansi-tests/functionp.lsp create mode 100644 ansi-tests/gclload.lsp create mode 100644 ansi-tests/gclload1.lsp create mode 100644 ansi-tests/gclload2.lsp create mode 100644 ansi-tests/get-output-stream-string.lsp create mode 100644 ansi-tests/get-setf-expansion.lsp create mode 100644 ansi-tests/handler-bind.lsp create mode 100644 ansi-tests/handler-case.lsp create mode 100644 ansi-tests/hash-table.lsp create mode 100644 ansi-tests/host-namestring.lsp create mode 100644 ansi-tests/identity.lsp create mode 100644 ansi-tests/if.lsp create mode 100644 ansi-tests/input-stream-p.lsp create mode 100644 ansi-tests/interactive-stream-p.lsp create mode 100644 ansi-tests/invoke-debugger.lsp create mode 100644 ansi-tests/iteration.lsp create mode 100644 ansi-tests/labels.lsp create mode 100644 ansi-tests/lambda-list-keywords.lsp create mode 100644 ansi-tests/lambda-parameters-limit.lsp create mode 100644 ansi-tests/lambda.lsp create mode 100644 ansi-tests/ldtest.lsp create mode 100644 ansi-tests/length.lsp create mode 100644 ansi-tests/let.lsp create mode 100644 ansi-tests/listen.lsp create mode 100644 ansi-tests/load-arrays.lsp create mode 100644 ansi-tests/load-conditions.lsp create mode 100644 ansi-tests/load-cons.lsp create mode 100644 ansi-tests/load-data-and-control-flow.lsp create mode 100644 ansi-tests/load-eval-and-compile.lsp create mode 100644 ansi-tests/load-files.lsp create mode 100644 ansi-tests/load-iteration.lsp create mode 100644 ansi-tests/load-logical-pathname-translations.lsp create mode 100644 ansi-tests/load-pathnames.lsp create mode 100644 ansi-tests/load-sequences.lsp create mode 100644 ansi-tests/load-streams.lsp create mode 100644 ansi-tests/load-strings.lsp create mode 100644 ansi-tests/load-structures.lsp create mode 100644 ansi-tests/load-symbols.lsp create mode 100644 ansi-tests/load-system-construction.lsp create mode 100644 ansi-tests/load-test-file-2.lsp create mode 100644 ansi-tests/load-test-file.lsp create mode 100644 ansi-tests/load-types-and-class.lsp create mode 100644 ansi-tests/load.lsp create mode 100644 ansi-tests/logical-pathname-translations.lsp create mode 100644 ansi-tests/logical-pathname.lsp create mode 100644 ansi-tests/loop.lsp create mode 100644 ansi-tests/loop1.lsp create mode 100644 ansi-tests/loop10.lsp create mode 100644 ansi-tests/loop11.lsp create mode 100644 ansi-tests/loop12.lsp create mode 100644 ansi-tests/loop13.lsp create mode 100644 ansi-tests/loop14.lsp create mode 100644 ansi-tests/loop15.lsp create mode 100644 ansi-tests/loop16.lsp create mode 100644 ansi-tests/loop17.lsp create mode 100644 ansi-tests/loop2.lsp create mode 100644 ansi-tests/loop3.lsp create mode 100644 ansi-tests/loop4.lsp create mode 100644 ansi-tests/loop5.lsp create mode 100644 ansi-tests/loop6.lsp create mode 100644 ansi-tests/loop7.lsp create mode 100644 ansi-tests/loop8.lsp create mode 100644 ansi-tests/loop9.lsp create mode 100644 ansi-tests/macrolet.lsp create mode 100644 ansi-tests/make-array.lsp create mode 100644 ansi-tests/make-broadcast-stream.lsp create mode 100644 ansi-tests/make-concatenated-stream.lsp create mode 100644 ansi-tests/make-echo-stream.lsp create mode 100644 ansi-tests/make-hash-table.lsp create mode 100644 ansi-tests/make-pathname.lsp create mode 100644 ansi-tests/make-sequence.lsp create mode 100644 ansi-tests/make-string-input-stream.lsp create mode 100644 ansi-tests/make-string-output-stream.lsp create mode 100644 ansi-tests/make-string.lsp create mode 100644 ansi-tests/make-synonym-stream.lsp create mode 100755 ansi-tests/make-tar create mode 100644 ansi-tests/make-two-way-stream.lsp create mode 100644 ansi-tests/makefile create mode 100644 ansi-tests/map-into.lsp create mode 100644 ansi-tests/map.lsp create mode 100644 ansi-tests/merge-pathnames.lsp create mode 100644 ansi-tests/merge.lsp create mode 100644 ansi-tests/mismatch.lsp create mode 100644 ansi-tests/multiple-value-bind.lsp create mode 100644 ansi-tests/multiple-value-call.lsp create mode 100644 ansi-tests/multiple-value-list.lsp create mode 100644 ansi-tests/multiple-value-prog1.lsp create mode 100644 ansi-tests/multiple-value-setq.lsp create mode 100644 ansi-tests/namestring.lsp create mode 100644 ansi-tests/nil.lsp create mode 100644 ansi-tests/not-and-null.lsp create mode 100644 ansi-tests/notany.lsp create mode 100644 ansi-tests/notevery.lsp create mode 100644 ansi-tests/nreverse.lsp create mode 100644 ansi-tests/nstring-capitalize.lsp create mode 100644 ansi-tests/nstring-downcase.lsp create mode 100644 ansi-tests/nstring-upcase.lsp create mode 100644 ansi-tests/nsubstitute-if-not.lsp create mode 100644 ansi-tests/nsubstitute-if.lsp create mode 100644 ansi-tests/nsubstitute.lsp create mode 100644 ansi-tests/nth-value.lsp create mode 100644 ansi-tests/open-stream-p.lsp create mode 100644 ansi-tests/open.lsp create mode 100644 ansi-tests/or.lsp create mode 100644 ansi-tests/output-stream-p.lsp create mode 100644 ansi-tests/packages-00.lsp create mode 100644 ansi-tests/packages-01.lsp create mode 100644 ansi-tests/packages-02.lsp create mode 100644 ansi-tests/packages-03.lsp create mode 100644 ansi-tests/packages-04.lsp create mode 100644 ansi-tests/packages-05.lsp create mode 100644 ansi-tests/packages-06.lsp create mode 100644 ansi-tests/packages-07.lsp create mode 100644 ansi-tests/packages-08.lsp create mode 100644 ansi-tests/packages-09.lsp create mode 100644 ansi-tests/packages-10.lsp create mode 100644 ansi-tests/packages-11.lsp create mode 100644 ansi-tests/packages-12.lsp create mode 100644 ansi-tests/packages-13.lsp create mode 100644 ansi-tests/packages-14.lsp create mode 100644 ansi-tests/packages-15.lsp create mode 100644 ansi-tests/packages-16.lsp create mode 100644 ansi-tests/packages-17.lsp create mode 100644 ansi-tests/packages-18.lsp create mode 100644 ansi-tests/packages-19.lsp create mode 100644 ansi-tests/packages.lsp create mode 100644 ansi-tests/parse-namestring.lsp create mode 100644 ansi-tests/pathname-device.lsp create mode 100644 ansi-tests/pathname-directory.lsp create mode 100644 ansi-tests/pathname-host.lsp create mode 100644 ansi-tests/pathname-match-p.lsp create mode 100644 ansi-tests/pathname-name.lsp create mode 100644 ansi-tests/pathname-type.lsp create mode 100644 ansi-tests/pathname-version.lsp create mode 100644 ansi-tests/pathname.lsp create mode 100644 ansi-tests/pathnamep.lsp create mode 100644 ansi-tests/pathnames-aux.lsp create mode 100644 ansi-tests/pathnames.lsp create mode 100644 ansi-tests/peek-char.lsp create mode 100644 ansi-tests/places.lsp create mode 100644 ansi-tests/position-if-not.lsp create mode 100644 ansi-tests/position-if.lsp create mode 100644 ansi-tests/position.lsp create mode 100644 ansi-tests/probe-file.lsp create mode 100644 ansi-tests/prog.lsp create mode 100644 ansi-tests/prog1.lsp create mode 100644 ansi-tests/prog2.lsp create mode 100644 ansi-tests/progn.lsp create mode 100644 ansi-tests/progv.lsp create mode 100644 ansi-tests/random-aux.lsp create mode 100644 ansi-tests/random-int-form.lsp create mode 100644 ansi-tests/random-intern.lsp create mode 100644 ansi-tests/read-byte.lsp create mode 100644 ansi-tests/read-char-no-hang.lsp create mode 100644 ansi-tests/read-char.lsp create mode 100644 ansi-tests/read-line.lsp create mode 100644 ansi-tests/read-sequence.lsp create mode 100644 ansi-tests/reader-test.lsp create mode 100644 ansi-tests/reduce.lsp create mode 100644 ansi-tests/remove-aux.lsp create mode 100644 ansi-tests/remove-duplicates-aux.lsp create mode 100644 ansi-tests/remove-duplicates.lsp create mode 100644 ansi-tests/remove.lsp create mode 100644 ansi-tests/rename-file.lsp create mode 100644 ansi-tests/replace.lsp create mode 100644 ansi-tests/reverse.lsp create mode 100644 ansi-tests/row-major-aref.lsp create mode 100644 ansi-tests/rt-acl.system create mode 100644 ansi-tests/rt-doc.txt create mode 100644 ansi-tests/rt-package.lsp create mode 100644 ansi-tests/rt-test.lsp create mode 100644 ansi-tests/rt.lsp create mode 100644 ansi-tests/rt.system create mode 100644 ansi-tests/sbit.lsp create mode 100644 ansi-tests/search-aux.lsp create mode 100644 ansi-tests/search-bitvector.lsp create mode 100644 ansi-tests/search-list.lsp create mode 100644 ansi-tests/search-string.lsp create mode 100644 ansi-tests/search-vector.lsp create mode 100644 ansi-tests/simple-array-t.lsp create mode 100644 ansi-tests/simple-array.lsp create mode 100644 ansi-tests/simple-bit-vector-p.lsp create mode 100644 ansi-tests/simple-bit-vector.lsp create mode 100644 ansi-tests/simple-vector-p.lsp create mode 100644 ansi-tests/some.lsp create mode 100644 ansi-tests/sort.lsp create mode 100644 ansi-tests/stable-sort.lsp create mode 100644 ansi-tests/stream-element-type.lsp create mode 100644 ansi-tests/stream-error-stream.lsp create mode 100644 ansi-tests/stream-external-format.lsp create mode 100644 ansi-tests/streamp.lsp create mode 100644 ansi-tests/string-aux.lsp create mode 100644 ansi-tests/string-capitalize.lsp create mode 100644 ansi-tests/string-comparisons.lsp create mode 100644 ansi-tests/string-downcase.lsp create mode 100644 ansi-tests/string-left-trim.lsp create mode 100644 ansi-tests/string-right-trim.lsp create mode 100644 ansi-tests/string-trim.lsp create mode 100644 ansi-tests/string-upcase.lsp create mode 100644 ansi-tests/string.lsp create mode 100644 ansi-tests/structure-00.lsp create mode 100644 ansi-tests/structures-01.lsp create mode 100644 ansi-tests/structures-02.lsp create mode 100644 ansi-tests/structures-03.lsp create mode 100644 ansi-tests/subseq-aux.lsp create mode 100644 ansi-tests/subseq.lsp create mode 100644 ansi-tests/substitute-if-not.lsp create mode 100644 ansi-tests/substitute-if.lsp create mode 100644 ansi-tests/substitute.lsp create mode 100644 ansi-tests/subtypep-array.lsp create mode 100644 ansi-tests/subtypep-cons.lsp create mode 100644 ansi-tests/subtypep-eql.lsp create mode 100644 ansi-tests/subtypep-float.lsp create mode 100644 ansi-tests/subtypep-integer.lsp create mode 100644 ansi-tests/subtypep-member.lsp create mode 100644 ansi-tests/subtypep-rational.lsp create mode 100644 ansi-tests/subtypep-real.lsp create mode 100644 ansi-tests/subtypep.lsp create mode 100644 ansi-tests/svref.lsp create mode 100644 ansi-tests/synonym-stream-symbol.lsp create mode 100644 ansi-tests/t.lsp create mode 100644 ansi-tests/tagbody.lsp create mode 100644 ansi-tests/terpri.lsp create mode 100644 ansi-tests/translate-logical-pathname.lsp create mode 100644 ansi-tests/translate-pathname.lsp create mode 100644 ansi-tests/truename.lsp create mode 100644 ansi-tests/two-way-stream-input-stream.lsp create mode 100644 ansi-tests/two-way-stream-output-stream.lsp create mode 100644 ansi-tests/typecase.lsp create mode 100644 ansi-tests/types-and-class-2.lsp create mode 100644 ansi-tests/types-and-class.lsp create mode 100644 ansi-tests/universe.lsp create mode 100644 ansi-tests/unless.lsp create mode 100644 ansi-tests/unread-char.lsp create mode 100644 ansi-tests/unwind-protect.lsp create mode 100644 ansi-tests/upgraded-array-element-type.lsp create mode 100644 ansi-tests/values-list.lsp create mode 100644 ansi-tests/values.lsp create mode 100644 ansi-tests/vector-pop.lsp create mode 100644 ansi-tests/vector-push-extend.lsp create mode 100644 ansi-tests/vector-push.lsp create mode 100644 ansi-tests/vector.lsp create mode 100644 ansi-tests/vectorp.lsp create mode 100644 ansi-tests/warn.lsp create mode 100644 ansi-tests/when.lsp create mode 100644 ansi-tests/wild-pathname-p.lsp create mode 100644 ansi-tests/with-input-from-string.lsp create mode 100644 ansi-tests/with-open-file.lsp create mode 100644 ansi-tests/with-open-stream.lsp create mode 100644 ansi-tests/with-output-to-string.lsp create mode 100644 ansi-tests/write-char.lsp create mode 100644 ansi-tests/write-line.lsp create mode 100644 ansi-tests/write-sequence.lsp create mode 100644 ansi-tests/write-string.lsp create mode 100644 bfdtest.c create mode 100644 bin/.gitignore create mode 100755 bin/append.c create mode 100755 bin/dpp.c create mode 100644 bin/file-sub.c create mode 100755 bin/info create mode 100755 bin/info1 create mode 100644 bin/makefile create mode 100755 bin/tkinfo create mode 100644 clcs/.gitignore create mode 100755 clcs/gcl_clcs_condition_definitions.lisp create mode 100755 clcs/gcl_clcs_conditions.lisp create mode 100755 clcs/gcl_clcs_handler.lisp create mode 100755 clcs/gcl_clcs_precom.lisp create mode 100644 clcs/gcl_cmpinit.lsp create mode 100755 clcs/loading.lisp create mode 100644 clcs/makefile create mode 100644 clcs/myload.lisp create mode 100755 clcs/package.lisp create mode 100755 clcs/readme create mode 100644 clcs/sys-proclaim.lisp create mode 100755 clcs/unused/condition_precom.lisp create mode 100755 clcs/unused/doload.lisp create mode 100755 clcs/unused/reload.lisp create mode 100755 clcs/unused/sysdef.lisp create mode 100755 clcs/unused/test.lisp create mode 100755 clcs/unused/test2.lisp create mode 100755 clcs/unused/test3.lisp create mode 100755 clcs/unused/test4.lisp create mode 100755 clcs/unused/test5.lisp create mode 100755 clcs/unused/tester.lisp create mode 100644 cmpnew/.gitignore create mode 100755 cmpnew/gcl_cmpbind.lsp create mode 100755 cmpnew/gcl_cmpblock.lsp create mode 100755 cmpnew/gcl_cmpcall.lsp create mode 100755 cmpnew/gcl_cmpcatch.lsp create mode 100755 cmpnew/gcl_cmpenv.lsp create mode 100755 cmpnew/gcl_cmpeval.lsp create mode 100755 cmpnew/gcl_cmpflet.lsp create mode 100755 cmpnew/gcl_cmpfun.lsp create mode 100755 cmpnew/gcl_cmpif.lsp create mode 100755 cmpnew/gcl_cmpinit.lsp create mode 100755 cmpnew/gcl_cmpinline.lsp create mode 100755 cmpnew/gcl_cmplabel.lsp create mode 100755 cmpnew/gcl_cmplam.lsp create mode 100755 cmpnew/gcl_cmplet.lsp create mode 100755 cmpnew/gcl_cmploc.lsp create mode 100755 cmpnew/gcl_cmpmain.lsp create mode 100755 cmpnew/gcl_cmpmap.lsp create mode 100755 cmpnew/gcl_cmpmulti.lsp create mode 100755 cmpnew/gcl_cmpopt.lsp create mode 100755 cmpnew/gcl_cmpspecial.lsp create mode 100755 cmpnew/gcl_cmptag.lsp create mode 100755 cmpnew/gcl_cmptest.lsp create mode 100755 cmpnew/gcl_cmptop.lsp create mode 100755 cmpnew/gcl_cmptype.lsp create mode 100755 cmpnew/gcl_cmputil.lsp create mode 100755 cmpnew/gcl_cmpvar.lsp create mode 100755 cmpnew/gcl_cmpvs.lsp create mode 100755 cmpnew/gcl_cmpwt.lsp create mode 100755 cmpnew/gcl_collectfn.lsp create mode 100755 cmpnew/gcl_fasdmacros.lsp create mode 100755 cmpnew/gcl_init.lsp create mode 100755 cmpnew/gcl_lfun_list.lsp create mode 100755 cmpnew/gcl_make-fn.lsp create mode 100755 cmpnew/gcl_make_ufun.lsp create mode 100755 cmpnew/gcl_nocmpinc.lsp create mode 100644 cmpnew/makefile create mode 100755 cmpnew/so_locations create mode 100644 cmpnew/sys-proclaim.lisp create mode 100755 comp/bo1.lsp create mode 100755 comp/c-pass1.lsp create mode 100755 comp/cmpinit.lsp create mode 100755 comp/comptype.lsp create mode 100755 comp/data.lsp create mode 100755 comp/defmacro.lsp create mode 100755 comp/defs.lsp create mode 100755 comp/exit.lsp create mode 100755 comp/fasdmacros.lsp create mode 100755 comp/inline.lsp create mode 100755 comp/integer.doc create mode 100755 comp/lambda.lsp create mode 100755 comp/lisp-decls.doc create mode 100755 comp/macros.lsp create mode 100644 comp/makefile create mode 100755 comp/mangle.lsp create mode 100755 comp/opts-base.lsp create mode 100755 comp/opts.lsp create mode 100755 comp/proclaim.lsp create mode 100755 comp/smash-oldcmp.lsp create mode 100755 comp/stmt.lsp create mode 100755 comp/sysdef.lsp create mode 100755 comp/top.lsp create mode 100755 comp/top1.lsp create mode 100755 comp/top2.lsp create mode 100755 comp/try.lsp create mode 100755 comp/try1.lsp create mode 100755 comp/utils.lsp create mode 100755 comp/var.lsp create mode 100755 comp/wr.lsp create mode 100755 config.guess create mode 100755 config.sub create mode 100755 configure create mode 100644 configure-new.ac create mode 100644 configure.in create mode 100644 debian/README.Debian create mode 100644 debian/changelog create mode 100644 debian/compat create mode 100644 debian/control create mode 100644 debian/control_ create mode 100644 debian/control_cvs create mode 100644 debian/copyright create mode 100644 debian/gcl.lintian-overrides create mode 100755 debian/gcl.sh create mode 100644 debian/gcl.templates create mode 100644 debian/in.gcl-doc.README.Debian create mode 100644 debian/in.gcl-doc.doc-base.main create mode 100644 debian/in.gcl-doc.doc-base.si create mode 100644 debian/in.gcl-doc.doc-base.tk create mode 100644 debian/in.gcl-doc.doc-base.xgcl create mode 100644 debian/in.gcl-doc.docs create mode 100644 debian/in.gcl-doc.info create mode 100644 debian/in.gcl-doc.install create mode 100644 debian/in.gcl.config create mode 100644 debian/in.gcl.docs create mode 100644 debian/in.gcl.emacsen-compat create mode 100644 debian/in.gcl.emacsen-install create mode 100644 debian/in.gcl.emacsen-remove create mode 100644 debian/in.gcl.emacsen-startup create mode 100644 debian/in.gcl.install create mode 100644 debian/in.gcl.manpages create mode 100644 debian/in.gcl.postinst create mode 100644 debian/in.gcl.postrm create mode 100644 debian/old.in.gcl-doc.doc-base.main create mode 100644 debian/po/POTFILES.in create mode 100644 debian/po/cs.po create mode 100644 debian/po/da.po create mode 100644 debian/po/de.po create mode 100644 debian/po/es.po create mode 100644 debian/po/fi.po create mode 100644 debian/po/fr.po create mode 100644 debian/po/gl.po create mode 100644 debian/po/it.po create mode 100644 debian/po/ja.po create mode 100644 debian/po/nl.po create mode 100644 debian/po/pt.po create mode 100644 debian/po/pt_BR.po create mode 100644 debian/po/ru.po create mode 100644 debian/po/sv.po create mode 100644 debian/po/templates.pot create mode 100644 debian/po/vi.po create mode 100755 debian/rules create mode 100644 debian/source/format create mode 100644 debian/source/include-binaries create mode 100644 debian/source/lintian-overrides create mode 100755 debian/texi.awk create mode 100644 debian/upstream/signing-key.asc create mode 100644 debian/watch create mode 100644 doc/bignum create mode 100644 doc/c-gc create mode 100644 doc/c-gc.doc create mode 100644 doc/compile-file-handling-of-top-level-forms create mode 100644 doc/contributors create mode 100644 doc/debug create mode 100644 doc/enhancements create mode 100644 doc/fast-link create mode 100644 doc/format create mode 100644 doc/funcall-comp create mode 100644 doc/funcall.lsp create mode 100644 doc/makefile create mode 100644 doc/multiple-values create mode 100644 doc/profile create mode 100755 dos/dostimes.c create mode 100755 dos/dum_dos.c create mode 100644 dos/makefile create mode 100755 dos/read.s create mode 100755 dos/readme create mode 100755 dos/sigman.s create mode 100755 dos/signal.c create mode 100755 dos/signal.h create mode 100644 elisp/add-default.el create mode 100755 elisp/ansi-doc.el create mode 100755 elisp/dbl.el create mode 100755 elisp/doc-to-texi.el create mode 100755 elisp/gcl.el create mode 100644 elisp/makefile create mode 100755 elisp/man1-to-texi.el create mode 100755 elisp/readme create mode 100644 elisp/smart-complete.el create mode 100755 elisp/sshell.el create mode 100755 eval.html create mode 100755 eval.tcl create mode 100755 faq create mode 100755 gcl-tk/comm.c create mode 100755 gcl-tk/convert.el create mode 100644 gcl-tk/decode.tcl create mode 100755 gcl-tk/demos-4.1/items.lisp create mode 100755 gcl-tk/demos-4.2/widget create mode 100755 gcl-tk/demos-4.2/widget.lisp create mode 100755 gcl-tk/demos/gc-monitor.lisp create mode 100755 gcl-tk/demos/mkArrow.tcl create mode 100755 gcl-tk/demos/mkBasic.lisp create mode 100755 gcl-tk/demos/mkBasic.tcl create mode 100755 gcl-tk/demos/mkBitmaps.tcl create mode 100755 gcl-tk/demos/mkButton.tcl create mode 100755 gcl-tk/demos/mkCanvText.lisp create mode 100755 gcl-tk/demos/mkCanvText.tcl create mode 100755 gcl-tk/demos/mkCheck.tcl create mode 100755 gcl-tk/demos/mkDialog.tcl create mode 100755 gcl-tk/demos/mkEntry.lisp create mode 100755 gcl-tk/demos/mkEntry.tcl create mode 100755 gcl-tk/demos/mkEntry2.lisp create mode 100755 gcl-tk/demos/mkEntry2.tcl create mode 100755 gcl-tk/demos/mkFloor.tcl create mode 100755 gcl-tk/demos/mkForm.lisp create mode 100755 gcl-tk/demos/mkForm.tcl create mode 100755 gcl-tk/demos/mkHScale.lisp create mode 100755 gcl-tk/demos/mkHScale.tcl create mode 100755 gcl-tk/demos/mkIcon.tcl create mode 100755 gcl-tk/demos/mkItems.lisp create mode 100755 gcl-tk/demos/mkItems.tcl create mode 100755 gcl-tk/demos/mkLabel.lisp create mode 100755 gcl-tk/demos/mkLabel.tcl create mode 100755 gcl-tk/demos/mkListbox.lisp create mode 100755 gcl-tk/demos/mkListbox.tcl create mode 100755 gcl-tk/demos/mkListbox2.tcl create mode 100755 gcl-tk/demos/mkListbox3.tcl create mode 100755 gcl-tk/demos/mkPlot.lisp create mode 100755 gcl-tk/demos/mkPlot.tcl create mode 100755 gcl-tk/demos/mkPuzzle.tcl create mode 100755 gcl-tk/demos/mkRadio.lisp create mode 100755 gcl-tk/demos/mkRadio.tcl create mode 100755 gcl-tk/demos/mkRuler.lisp create mode 100755 gcl-tk/demos/mkRuler.tcl create mode 100755 gcl-tk/demos/mkScroll.tcl create mode 100755 gcl-tk/demos/mkSearch.lisp create mode 100755 gcl-tk/demos/mkSearch.tcl create mode 100755 gcl-tk/demos/mkStyles.lisp create mode 100755 gcl-tk/demos/mkStyles.tcl create mode 100755 gcl-tk/demos/mkTear.tcl create mode 100755 gcl-tk/demos/mkTextBind.lisp create mode 100755 gcl-tk/demos/mkTextBind.tcl create mode 100755 gcl-tk/demos/mkVScale.lisp create mode 100755 gcl-tk/demos/mkVScale.tcl create mode 100755 gcl-tk/demos/mkdialog.lisp create mode 100755 gcl-tk/demos/nqthm-stack.lisp create mode 100755 gcl-tk/demos/showVars.lisp create mode 100755 gcl-tk/demos/showVars.tcl create mode 100755 gcl-tk/demos/tclIndex create mode 100755 gcl-tk/demos/widget.lisp create mode 100755 gcl-tk/dir.sed create mode 100755 gcl-tk/gcl-1.tcl create mode 100755 gcl-tk/gcl.tcl create mode 100755 gcl-tk/gcl_cmpinit.lsp create mode 100755 gcl-tk/gcl_guisl.h create mode 100755 gcl-tk/gcltksrv.bat create mode 100755 gcl-tk/gcltksrv.in create mode 100755 gcl-tk/gcltksrv.in.interp create mode 100755 gcl-tk/gcltksrv.prev create mode 100755 gcl-tk/guis.c create mode 100755 gcl-tk/guis.h create mode 100755 gcl-tk/helpers.lisp create mode 100755 gcl-tk/index.lsp create mode 100755 gcl-tk/intrs.h create mode 100644 gcl-tk/makefile create mode 100644 gcl-tk/makefile.prev create mode 100755 gcl-tk/ngcltksrv create mode 100755 gcl-tk/our_io.c create mode 100755 gcl-tk/sheader.h create mode 100755 gcl-tk/socketsl.lisp create mode 100755 gcl-tk/socks.h create mode 100755 gcl-tk/sysdep-sunos.h create mode 100755 gcl-tk/tinfo.lsp create mode 100755 gcl-tk/tk-package.lsp create mode 100755 gcl-tk/tkAppInit.c create mode 100755 gcl-tk/tkMain.c create mode 100755 gcl-tk/tkXAppInit.c create mode 100755 gcl-tk/tkXshell.c create mode 100755 gcl-tk/tkl.lisp create mode 100755 gcl-tk/tktst.c create mode 100644 gcl.ico create mode 100755 gcl.jpg create mode 100644 gcl.png create mode 100755 gcl1.jpg create mode 100644 gcl2.jpg create mode 100644 git.tag create mode 100644 gmp.patch create mode 100644 gmp4/.gdbinit create mode 100644 gmp4/.pc/.quilt_patches create mode 100644 gmp4/.pc/.quilt_series create mode 100644 gmp4/.pc/.version create mode 100644 gmp4/.pc/4a6d258b467f.patch/mpn/powerpc64/mode64/gcd_1.asm create mode 100644 gmp4/.pc/applied-patches create mode 100644 gmp4/.pc/arm-asm-nothumb.patch/mpn/generic/div_qr_1n_pi1.c create mode 100644 gmp4/AUTHORS create mode 100644 gmp4/COPYING create mode 100644 gmp4/COPYING.LESSERv3 create mode 100644 gmp4/COPYINGv2 create mode 100644 gmp4/COPYINGv3 create mode 100644 gmp4/ChangeLog create mode 100644 gmp4/INSTALL create mode 100644 gmp4/INSTALL.autoconf create mode 100644 gmp4/Makefile.am create mode 100644 gmp4/Makefile.in create mode 100644 gmp4/NEWS create mode 100644 gmp4/README create mode 100644 gmp4/acinclude.m4 create mode 100644 gmp4/aclocal.m4 create mode 100644 gmp4/assert.c create mode 100644 gmp4/bootstrap.c create mode 100644 gmp4/compat.c create mode 100755 gmp4/compile create mode 100755 gmp4/config.guess create mode 100644 gmp4/config.in create mode 100755 gmp4/config.sub create mode 100755 gmp4/configfsf.guess create mode 100644 gmp4/configfsf.sub create mode 100755 gmp4/configure create mode 100644 gmp4/configure.ac create mode 100644 gmp4/cxx/Makefile.am create mode 100644 gmp4/cxx/Makefile.in create mode 100644 gmp4/cxx/dummy.cc create mode 100644 gmp4/cxx/isfuns.cc create mode 100644 gmp4/cxx/ismpf.cc create mode 100644 gmp4/cxx/ismpq.cc create mode 100644 gmp4/cxx/ismpz.cc create mode 100644 gmp4/cxx/ismpznw.cc create mode 100644 gmp4/cxx/limits.cc create mode 100644 gmp4/cxx/osdoprnti.cc create mode 100644 gmp4/cxx/osfuns.cc create mode 100644 gmp4/cxx/osmpf.cc create mode 100644 gmp4/cxx/osmpq.cc create mode 100644 gmp4/cxx/osmpz.cc create mode 100644 gmp4/debian/NEWS.Debian create mode 100644 gmp4/debian/Notes create mode 100644 gmp4/debian/README.Debian create mode 100644 gmp4/debian/README.source create mode 100644 gmp4/debian/changelog create mode 100644 gmp4/debian/compat create mode 100644 gmp4/debian/control create mode 100644 gmp4/debian/copyright create mode 100644 gmp4/debian/libgmp10-doc.README.Debian create mode 100644 gmp4/debian/libgmp10-doc.examples create mode 100644 gmp4/debian/libgmp10.symbols create mode 100644 gmp4/debian/libgmpxx4ldbl.lintian-overrides create mode 100644 gmp4/debian/patches/4a6d258b467f.patch create mode 100644 gmp4/debian/patches/arm-asm-nothumb.patch create mode 100644 gmp4/debian/patches/series create mode 100755 gmp4/debian/rules create mode 100644 gmp4/debian/source/format create mode 100644 gmp4/debian/watch create mode 100644 gmp4/demos/Makefile.am create mode 100644 gmp4/demos/Makefile.in create mode 100644 gmp4/demos/calc/Makefile.am create mode 100644 gmp4/demos/calc/Makefile.in create mode 100644 gmp4/demos/calc/README create mode 100644 gmp4/demos/calc/calc-common.h create mode 100644 gmp4/demos/calc/calc-config-h.in create mode 100644 gmp4/demos/calc/calc.c create mode 100644 gmp4/demos/calc/calc.h create mode 100644 gmp4/demos/calc/calc.y create mode 100644 gmp4/demos/calc/calclex.c create mode 100644 gmp4/demos/calc/calclex.l create mode 100644 gmp4/demos/calc/calcread.c create mode 100644 gmp4/demos/expr/Makefile.am create mode 100644 gmp4/demos/expr/Makefile.in create mode 100644 gmp4/demos/expr/README create mode 100644 gmp4/demos/expr/expr-impl.h create mode 100644 gmp4/demos/expr/expr.c create mode 100644 gmp4/demos/expr/expr.h create mode 100644 gmp4/demos/expr/exprf.c create mode 100644 gmp4/demos/expr/exprfa.c create mode 100644 gmp4/demos/expr/exprq.c create mode 100644 gmp4/demos/expr/exprqa.c create mode 100644 gmp4/demos/expr/exprv.c create mode 100644 gmp4/demos/expr/exprz.c create mode 100644 gmp4/demos/expr/exprza.c create mode 100644 gmp4/demos/expr/run-expr.c create mode 100644 gmp4/demos/expr/t-expr.c create mode 100644 gmp4/demos/factorize.c create mode 100644 gmp4/demos/isprime.c create mode 100644 gmp4/demos/perl/GMP.pm create mode 100644 gmp4/demos/perl/GMP.xs create mode 100644 gmp4/demos/perl/GMP/Mpf.pm create mode 100644 gmp4/demos/perl/GMP/Mpq.pm create mode 100644 gmp4/demos/perl/GMP/Mpz.pm create mode 100644 gmp4/demos/perl/GMP/Rand.pm create mode 100644 gmp4/demos/perl/INSTALL create mode 100644 gmp4/demos/perl/Makefile.PL create mode 100644 gmp4/demos/perl/sample.pl create mode 100644 gmp4/demos/perl/test.pl create mode 100644 gmp4/demos/perl/test2.pl create mode 100644 gmp4/demos/perl/typemap create mode 100644 gmp4/demos/pexpr-config-h.in create mode 100644 gmp4/demos/pexpr.c create mode 100644 gmp4/demos/primes.c create mode 100644 gmp4/demos/primes.h create mode 100644 gmp4/demos/qcn.c create mode 100644 gmp4/doc/Makefile.am create mode 100644 gmp4/doc/Makefile.in create mode 100644 gmp4/errno.c create mode 100644 gmp4/extract-dbl.c create mode 100644 gmp4/gen-bases.c create mode 100644 gmp4/gen-fac.c create mode 100644 gmp4/gen-fib.c create mode 100644 gmp4/gen-jacobitab.c create mode 100644 gmp4/gen-psqr.c create mode 100644 gmp4/gen-trialdivtab.c create mode 100644 gmp4/gmp-h.in create mode 100644 gmp4/gmp-impl.h create mode 100644 gmp4/gmpxx.h create mode 100755 gmp4/install-sh create mode 100644 gmp4/invalid.c create mode 100644 gmp4/longlong.h create mode 100644 gmp4/ltmain.sh create mode 100644 gmp4/memory.c create mode 100644 gmp4/mini-gmp/README create mode 100644 gmp4/mini-gmp/mini-gmp.c create mode 100644 gmp4/mini-gmp/mini-gmp.h create mode 100644 gmp4/mini-gmp/tests/Makefile create mode 100644 gmp4/mini-gmp/tests/hex-random.c create mode 100644 gmp4/mini-gmp/tests/hex-random.h create mode 100644 gmp4/mini-gmp/tests/mini-random.c create mode 100644 gmp4/mini-gmp/tests/mini-random.h create mode 100755 gmp4/mini-gmp/tests/run-tests create mode 100644 gmp4/mini-gmp/tests/t-add.c create mode 100644 gmp4/mini-gmp/tests/t-aorsmul.c create mode 100644 gmp4/mini-gmp/tests/t-bitops.c create mode 100644 gmp4/mini-gmp/tests/t-cmp_d.c create mode 100644 gmp4/mini-gmp/tests/t-comb.c create mode 100644 gmp4/mini-gmp/tests/t-cong.c create mode 100644 gmp4/mini-gmp/tests/t-div.c create mode 100644 gmp4/mini-gmp/tests/t-div_2exp.c create mode 100644 gmp4/mini-gmp/tests/t-double.c create mode 100644 gmp4/mini-gmp/tests/t-gcd.c create mode 100644 gmp4/mini-gmp/tests/t-import.c create mode 100644 gmp4/mini-gmp/tests/t-invert.c create mode 100644 gmp4/mini-gmp/tests/t-lcm.c create mode 100644 gmp4/mini-gmp/tests/t-limbs.c create mode 100644 gmp4/mini-gmp/tests/t-logops.c create mode 100644 gmp4/mini-gmp/tests/t-mul.c create mode 100644 gmp4/mini-gmp/tests/t-powm.c create mode 100644 gmp4/mini-gmp/tests/t-pprime_p.c create mode 100644 gmp4/mini-gmp/tests/t-reuse.c create mode 100644 gmp4/mini-gmp/tests/t-root.c create mode 100644 gmp4/mini-gmp/tests/t-scan.c create mode 100644 gmp4/mini-gmp/tests/t-signed.c create mode 100644 gmp4/mini-gmp/tests/t-sqrt.c create mode 100644 gmp4/mini-gmp/tests/t-str.c create mode 100644 gmp4/mini-gmp/tests/t-sub.c create mode 100644 gmp4/mini-gmp/tests/testutils.c create mode 100644 gmp4/mini-gmp/tests/testutils.h create mode 100755 gmp4/missing create mode 100644 gmp4/mp_bpl.c create mode 100644 gmp4/mp_clz_tab.c create mode 100644 gmp4/mp_dv_tab.c create mode 100644 gmp4/mp_get_fns.c create mode 100644 gmp4/mp_minv_tab.c create mode 100644 gmp4/mp_set_fns.c create mode 100644 gmp4/mpf/Makefile.am create mode 100644 gmp4/mpf/Makefile.in create mode 100644 gmp4/mpf/abs.c create mode 100644 gmp4/mpf/add.c create mode 100644 gmp4/mpf/add_ui.c create mode 100644 gmp4/mpf/ceilfloor.c create mode 100644 gmp4/mpf/clear.c create mode 100644 gmp4/mpf/clears.c create mode 100644 gmp4/mpf/cmp.c create mode 100644 gmp4/mpf/cmp_d.c create mode 100644 gmp4/mpf/cmp_si.c create mode 100644 gmp4/mpf/cmp_ui.c create mode 100644 gmp4/mpf/div.c create mode 100644 gmp4/mpf/div_2exp.c create mode 100644 gmp4/mpf/div_ui.c create mode 100644 gmp4/mpf/dump.c create mode 100644 gmp4/mpf/eq.c create mode 100644 gmp4/mpf/fits_s.h create mode 100644 gmp4/mpf/fits_sint.c create mode 100644 gmp4/mpf/fits_slong.c create mode 100644 gmp4/mpf/fits_sshort.c create mode 100644 gmp4/mpf/fits_u.h create mode 100644 gmp4/mpf/fits_uint.c create mode 100644 gmp4/mpf/fits_ulong.c create mode 100644 gmp4/mpf/fits_ushort.c create mode 100644 gmp4/mpf/get_d.c create mode 100644 gmp4/mpf/get_d_2exp.c create mode 100644 gmp4/mpf/get_dfl_prec.c create mode 100644 gmp4/mpf/get_prc.c create mode 100644 gmp4/mpf/get_si.c create mode 100644 gmp4/mpf/get_str.c create mode 100644 gmp4/mpf/get_ui.c create mode 100644 gmp4/mpf/init.c create mode 100644 gmp4/mpf/init2.c create mode 100644 gmp4/mpf/inits.c create mode 100644 gmp4/mpf/inp_str.c create mode 100644 gmp4/mpf/int_p.c create mode 100644 gmp4/mpf/iset.c create mode 100644 gmp4/mpf/iset_d.c create mode 100644 gmp4/mpf/iset_si.c create mode 100644 gmp4/mpf/iset_str.c create mode 100644 gmp4/mpf/iset_ui.c create mode 100644 gmp4/mpf/mul.c create mode 100644 gmp4/mpf/mul_2exp.c create mode 100644 gmp4/mpf/mul_ui.c create mode 100644 gmp4/mpf/neg.c create mode 100644 gmp4/mpf/out_str.c create mode 100644 gmp4/mpf/pow_ui.c create mode 100644 gmp4/mpf/random2.c create mode 100644 gmp4/mpf/reldiff.c create mode 100644 gmp4/mpf/set.c create mode 100644 gmp4/mpf/set_d.c create mode 100644 gmp4/mpf/set_dfl_prec.c create mode 100644 gmp4/mpf/set_prc.c create mode 100644 gmp4/mpf/set_prc_raw.c create mode 100644 gmp4/mpf/set_q.c create mode 100644 gmp4/mpf/set_si.c create mode 100644 gmp4/mpf/set_str.c create mode 100644 gmp4/mpf/set_ui.c create mode 100644 gmp4/mpf/set_z.c create mode 100644 gmp4/mpf/size.c create mode 100644 gmp4/mpf/sqrt.c create mode 100644 gmp4/mpf/sqrt_ui.c create mode 100644 gmp4/mpf/sub.c create mode 100644 gmp4/mpf/sub_ui.c create mode 100644 gmp4/mpf/swap.c create mode 100644 gmp4/mpf/trunc.c create mode 100644 gmp4/mpf/ui_div.c create mode 100644 gmp4/mpf/ui_sub.c create mode 100644 gmp4/mpf/urandomb.c create mode 100644 gmp4/mpn/Makeasm.am create mode 100644 gmp4/mpn/Makefile.am create mode 100644 gmp4/mpn/Makefile.in create mode 100644 gmp4/mpn/README create mode 100644 gmp4/mpn/alpha/README create mode 100644 gmp4/mpn/alpha/add_n.asm create mode 100644 gmp4/mpn/alpha/addmul_1.asm create mode 100644 gmp4/mpn/alpha/alpha-defs.m4 create mode 100644 gmp4/mpn/alpha/aorslsh1_n.asm create mode 100644 gmp4/mpn/alpha/aorslsh2_n.asm create mode 100644 gmp4/mpn/alpha/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/alpha/cntlz.asm create mode 100644 gmp4/mpn/alpha/com.asm create mode 100644 gmp4/mpn/alpha/copyd.asm create mode 100644 gmp4/mpn/alpha/copyi.asm create mode 100644 gmp4/mpn/alpha/default.m4 create mode 100644 gmp4/mpn/alpha/dive_1.c create mode 100644 gmp4/mpn/alpha/divrem_2.asm create mode 100644 gmp4/mpn/alpha/ev5/diveby3.asm create mode 100644 gmp4/mpn/alpha/ev5/gmp-mparam.h create mode 100644 gmp4/mpn/alpha/ev6/add_n.asm create mode 100644 gmp4/mpn/alpha/ev6/aorslsh1_n.asm create mode 100644 gmp4/mpn/alpha/ev6/aorsmul_1.asm create mode 100644 gmp4/mpn/alpha/ev6/gmp-mparam.h create mode 100644 gmp4/mpn/alpha/ev6/mod_1_4.asm create mode 100644 gmp4/mpn/alpha/ev6/mul_1.asm create mode 100644 gmp4/mpn/alpha/ev6/nails/README create mode 100644 gmp4/mpn/alpha/ev6/nails/addmul_1.asm create mode 100644 gmp4/mpn/alpha/ev6/nails/addmul_2.asm create mode 100644 gmp4/mpn/alpha/ev6/nails/addmul_3.asm create mode 100644 gmp4/mpn/alpha/ev6/nails/addmul_4.asm create mode 100644 gmp4/mpn/alpha/ev6/nails/aors_n.asm create mode 100644 gmp4/mpn/alpha/ev6/nails/gmp-mparam.h create mode 100644 gmp4/mpn/alpha/ev6/nails/mul_1.asm create mode 100644 gmp4/mpn/alpha/ev6/nails/submul_1.asm create mode 100755 gmp4/mpn/alpha/ev6/slot.pl create mode 100644 gmp4/mpn/alpha/ev6/sub_n.asm create mode 100644 gmp4/mpn/alpha/ev67/gcd_1.asm create mode 100644 gmp4/mpn/alpha/ev67/hamdist.asm create mode 100644 gmp4/mpn/alpha/ev67/popcount.asm create mode 100644 gmp4/mpn/alpha/gmp-mparam.h create mode 100644 gmp4/mpn/alpha/invert_limb.asm create mode 100644 gmp4/mpn/alpha/lshift.asm create mode 100644 gmp4/mpn/alpha/mod_34lsub1.asm create mode 100644 gmp4/mpn/alpha/mode1o.asm create mode 100644 gmp4/mpn/alpha/mul_1.asm create mode 100644 gmp4/mpn/alpha/rshift.asm create mode 100644 gmp4/mpn/alpha/sec_tabselect.asm create mode 100644 gmp4/mpn/alpha/sqr_diag_addlsh1.asm create mode 100644 gmp4/mpn/alpha/sub_n.asm create mode 100644 gmp4/mpn/alpha/submul_1.asm create mode 100644 gmp4/mpn/alpha/umul.asm create mode 100644 gmp4/mpn/alpha/unicos.m4 create mode 100644 gmp4/mpn/arm/README create mode 100644 gmp4/mpn/arm/aors_n.asm create mode 100644 gmp4/mpn/arm/aorslsh1_n.asm create mode 100644 gmp4/mpn/arm/aorsmul_1.asm create mode 100644 gmp4/mpn/arm/arm-defs.m4 create mode 100644 gmp4/mpn/arm/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/arm/cnd_aors_n.asm create mode 100644 gmp4/mpn/arm/com.asm create mode 100644 gmp4/mpn/arm/copyd.asm create mode 100644 gmp4/mpn/arm/copyi.asm create mode 100644 gmp4/mpn/arm/dive_1.asm create mode 100644 gmp4/mpn/arm/gmp-mparam.h create mode 100644 gmp4/mpn/arm/invert_limb.asm create mode 100644 gmp4/mpn/arm/logops_n.asm create mode 100644 gmp4/mpn/arm/lshift.asm create mode 100644 gmp4/mpn/arm/lshiftc.asm create mode 100644 gmp4/mpn/arm/mod_34lsub1.asm create mode 100644 gmp4/mpn/arm/mode1o.asm create mode 100644 gmp4/mpn/arm/mul_1.asm create mode 100644 gmp4/mpn/arm/neon/README create mode 100644 gmp4/mpn/arm/neon/hamdist.asm create mode 100644 gmp4/mpn/arm/neon/lorrshift.asm create mode 100644 gmp4/mpn/arm/neon/lshiftc.asm create mode 100644 gmp4/mpn/arm/neon/popcount.asm create mode 100644 gmp4/mpn/arm/neon/sec_tabselect.asm create mode 100644 gmp4/mpn/arm/rsh1aors_n.asm create mode 100644 gmp4/mpn/arm/rshift.asm create mode 100644 gmp4/mpn/arm/sec_tabselect.asm create mode 100644 gmp4/mpn/arm/udiv.asm create mode 100644 gmp4/mpn/arm/v5/gcd_1.asm create mode 100644 gmp4/mpn/arm/v5/mod_1_1.asm create mode 100644 gmp4/mpn/arm/v5/mod_1_2.asm create mode 100644 gmp4/mpn/arm/v6/addmul_1.asm create mode 100644 gmp4/mpn/arm/v6/addmul_2.asm create mode 100644 gmp4/mpn/arm/v6/addmul_3.asm create mode 100644 gmp4/mpn/arm/v6/dive_1.asm create mode 100644 gmp4/mpn/arm/v6/gmp-mparam.h create mode 100644 gmp4/mpn/arm/v6/mode1o.asm create mode 100644 gmp4/mpn/arm/v6/mul_1.asm create mode 100644 gmp4/mpn/arm/v6/mul_2.asm create mode 100644 gmp4/mpn/arm/v6/popham.asm create mode 100644 gmp4/mpn/arm/v6/sqr_basecase.asm create mode 100644 gmp4/mpn/arm/v6/submul_1.asm create mode 100644 gmp4/mpn/arm/v6t2/divrem_1.asm create mode 100644 gmp4/mpn/arm/v6t2/gcd_1.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/addmul_1.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/aors_n.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/cnd_aors_n.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/com.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/gmp-mparam.h create mode 100644 gmp4/mpn/arm/v7a/cora15/logops_n.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/mul_1.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/neon/aorsorrlsh1_n.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/neon/aorsorrlsh2_n.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/neon/aorsorrlshC_n.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/neon/com.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/neon/copyd.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/neon/copyi.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/neon/rsh1aors_n.asm create mode 100644 gmp4/mpn/arm/v7a/cora15/submul_1.asm create mode 100644 gmp4/mpn/arm/v7a/cora9/gmp-mparam.h create mode 100644 gmp4/mpn/arm64/aors_n.asm create mode 100644 gmp4/mpn/arm64/aorsmul_1.asm create mode 100644 gmp4/mpn/arm64/cnd_aors_n.asm create mode 100644 gmp4/mpn/arm64/copyd.asm create mode 100644 gmp4/mpn/arm64/copyi.asm create mode 100644 gmp4/mpn/arm64/gcd_1.asm create mode 100644 gmp4/mpn/arm64/invert_limb.asm create mode 100644 gmp4/mpn/arm64/logops_n.asm create mode 100644 gmp4/mpn/arm64/mul_1.asm create mode 100644 gmp4/mpn/asm-defs.m4 create mode 100755 gmp4/mpn/cpp-ccas create mode 100644 gmp4/mpn/cray/README create mode 100644 gmp4/mpn/cray/add_n.c create mode 100644 gmp4/mpn/cray/cfp/addmul_1.c create mode 100644 gmp4/mpn/cray/cfp/mul_1.c create mode 100644 gmp4/mpn/cray/cfp/mulwwc90.s create mode 100644 gmp4/mpn/cray/cfp/mulwwj90.s create mode 100644 gmp4/mpn/cray/cfp/submul_1.c create mode 100644 gmp4/mpn/cray/gmp-mparam.h create mode 100644 gmp4/mpn/cray/hamdist.c create mode 100644 gmp4/mpn/cray/ieee/addmul_1.c create mode 100644 gmp4/mpn/cray/ieee/gmp-mparam.h create mode 100644 gmp4/mpn/cray/ieee/invert_limb.c create mode 100644 gmp4/mpn/cray/ieee/mul_1.c create mode 100644 gmp4/mpn/cray/ieee/mul_basecase.c create mode 100644 gmp4/mpn/cray/ieee/sqr_basecase.c create mode 100644 gmp4/mpn/cray/ieee/submul_1.c create mode 100644 gmp4/mpn/cray/lshift.c create mode 100644 gmp4/mpn/cray/mulww.f create mode 100644 gmp4/mpn/cray/popcount.c create mode 100644 gmp4/mpn/cray/rshift.c create mode 100644 gmp4/mpn/cray/sub_n.c create mode 100644 gmp4/mpn/generic/add.c create mode 100644 gmp4/mpn/generic/add_1.c create mode 100644 gmp4/mpn/generic/add_err1_n.c create mode 100644 gmp4/mpn/generic/add_err2_n.c create mode 100644 gmp4/mpn/generic/add_err3_n.c create mode 100644 gmp4/mpn/generic/add_n.c create mode 100644 gmp4/mpn/generic/add_n_sub_n.c create mode 100644 gmp4/mpn/generic/addmul_1.c create mode 100644 gmp4/mpn/generic/bdiv_dbm1c.c create mode 100644 gmp4/mpn/generic/bdiv_q.c create mode 100644 gmp4/mpn/generic/bdiv_q_1.c create mode 100644 gmp4/mpn/generic/bdiv_qr.c create mode 100644 gmp4/mpn/generic/binvert.c create mode 100644 gmp4/mpn/generic/broot.c create mode 100644 gmp4/mpn/generic/brootinv.c create mode 100644 gmp4/mpn/generic/bsqrt.c create mode 100644 gmp4/mpn/generic/bsqrtinv.c create mode 100644 gmp4/mpn/generic/cmp.c create mode 100644 gmp4/mpn/generic/cnd_add_n.c create mode 100644 gmp4/mpn/generic/cnd_sub_n.c create mode 100644 gmp4/mpn/generic/com.c create mode 100644 gmp4/mpn/generic/comb_tables.c create mode 100644 gmp4/mpn/generic/copyd.c create mode 100644 gmp4/mpn/generic/copyi.c create mode 100644 gmp4/mpn/generic/dcpi1_bdiv_q.c create mode 100644 gmp4/mpn/generic/dcpi1_bdiv_qr.c create mode 100644 gmp4/mpn/generic/dcpi1_div_q.c create mode 100644 gmp4/mpn/generic/dcpi1_div_qr.c create mode 100644 gmp4/mpn/generic/dcpi1_divappr_q.c create mode 100644 gmp4/mpn/generic/div_q.c create mode 100644 gmp4/mpn/generic/div_qr_1.c create mode 100644 gmp4/mpn/generic/div_qr_1n_pi1.c create mode 100644 gmp4/mpn/generic/div_qr_1n_pi2.c create mode 100644 gmp4/mpn/generic/div_qr_1u_pi2.c create mode 100644 gmp4/mpn/generic/div_qr_2.c create mode 100644 gmp4/mpn/generic/div_qr_2n_pi1.c create mode 100644 gmp4/mpn/generic/div_qr_2u_pi1.c create mode 100644 gmp4/mpn/generic/dive_1.c create mode 100644 gmp4/mpn/generic/diveby3.c create mode 100644 gmp4/mpn/generic/divexact.c create mode 100644 gmp4/mpn/generic/divis.c create mode 100644 gmp4/mpn/generic/divrem.c create mode 100644 gmp4/mpn/generic/divrem_1.c create mode 100644 gmp4/mpn/generic/divrem_2.c create mode 100644 gmp4/mpn/generic/dump.c create mode 100644 gmp4/mpn/generic/fib2_ui.c create mode 100644 gmp4/mpn/generic/gcd.c create mode 100644 gmp4/mpn/generic/gcd_1.c create mode 100644 gmp4/mpn/generic/gcd_subdiv_step.c create mode 100644 gmp4/mpn/generic/gcdext.c create mode 100644 gmp4/mpn/generic/gcdext_1.c create mode 100644 gmp4/mpn/generic/gcdext_lehmer.c create mode 100644 gmp4/mpn/generic/get_d.c create mode 100644 gmp4/mpn/generic/get_str.c create mode 100644 gmp4/mpn/generic/gmp-mparam.h create mode 100644 gmp4/mpn/generic/hgcd.c create mode 100644 gmp4/mpn/generic/hgcd2.c create mode 100644 gmp4/mpn/generic/hgcd2_jacobi.c create mode 100644 gmp4/mpn/generic/hgcd_appr.c create mode 100644 gmp4/mpn/generic/hgcd_jacobi.c create mode 100644 gmp4/mpn/generic/hgcd_matrix.c create mode 100644 gmp4/mpn/generic/hgcd_reduce.c create mode 100644 gmp4/mpn/generic/hgcd_step.c create mode 100644 gmp4/mpn/generic/invert.c create mode 100644 gmp4/mpn/generic/invertappr.c create mode 100644 gmp4/mpn/generic/jacbase.c create mode 100644 gmp4/mpn/generic/jacobi.c create mode 100644 gmp4/mpn/generic/jacobi_2.c create mode 100644 gmp4/mpn/generic/logops_n.c create mode 100644 gmp4/mpn/generic/lshift.c create mode 100644 gmp4/mpn/generic/lshiftc.c create mode 100644 gmp4/mpn/generic/matrix22_mul.c create mode 100644 gmp4/mpn/generic/matrix22_mul1_inverse_vector.c create mode 100644 gmp4/mpn/generic/mod_1.c create mode 100644 gmp4/mpn/generic/mod_1_1.c create mode 100644 gmp4/mpn/generic/mod_1_2.c create mode 100644 gmp4/mpn/generic/mod_1_3.c create mode 100644 gmp4/mpn/generic/mod_1_4.c create mode 100644 gmp4/mpn/generic/mod_34lsub1.c create mode 100644 gmp4/mpn/generic/mode1o.c create mode 100644 gmp4/mpn/generic/mu_bdiv_q.c create mode 100644 gmp4/mpn/generic/mu_bdiv_qr.c create mode 100644 gmp4/mpn/generic/mu_div_q.c create mode 100644 gmp4/mpn/generic/mu_div_qr.c create mode 100644 gmp4/mpn/generic/mu_divappr_q.c create mode 100644 gmp4/mpn/generic/mul.c create mode 100644 gmp4/mpn/generic/mul_1.c create mode 100644 gmp4/mpn/generic/mul_basecase.c create mode 100644 gmp4/mpn/generic/mul_fft.c create mode 100644 gmp4/mpn/generic/mul_n.c create mode 100644 gmp4/mpn/generic/mullo_basecase.c create mode 100644 gmp4/mpn/generic/mullo_n.c create mode 100644 gmp4/mpn/generic/mulmid.c create mode 100644 gmp4/mpn/generic/mulmid_basecase.c create mode 100644 gmp4/mpn/generic/mulmid_n.c create mode 100644 gmp4/mpn/generic/mulmod_bnm1.c create mode 100644 gmp4/mpn/generic/neg.c create mode 100644 gmp4/mpn/generic/nussbaumer_mul.c create mode 100644 gmp4/mpn/generic/perfpow.c create mode 100644 gmp4/mpn/generic/perfsqr.c create mode 100644 gmp4/mpn/generic/popham.c create mode 100644 gmp4/mpn/generic/pow_1.c create mode 100644 gmp4/mpn/generic/powlo.c create mode 100644 gmp4/mpn/generic/powm.c create mode 100644 gmp4/mpn/generic/pre_divrem_1.c create mode 100644 gmp4/mpn/generic/pre_mod_1.c create mode 100644 gmp4/mpn/generic/random.c create mode 100644 gmp4/mpn/generic/random2.c create mode 100644 gmp4/mpn/generic/redc_1.c create mode 100644 gmp4/mpn/generic/redc_2.c create mode 100644 gmp4/mpn/generic/redc_n.c create mode 100644 gmp4/mpn/generic/remove.c create mode 100644 gmp4/mpn/generic/rootrem.c create mode 100644 gmp4/mpn/generic/rshift.c create mode 100644 gmp4/mpn/generic/sbpi1_bdiv_q.c create mode 100644 gmp4/mpn/generic/sbpi1_bdiv_qr.c create mode 100644 gmp4/mpn/generic/sbpi1_div_q.c create mode 100644 gmp4/mpn/generic/sbpi1_div_qr.c create mode 100644 gmp4/mpn/generic/sbpi1_divappr_q.c create mode 100644 gmp4/mpn/generic/scan0.c create mode 100644 gmp4/mpn/generic/scan1.c create mode 100644 gmp4/mpn/generic/sec_aors_1.c create mode 100644 gmp4/mpn/generic/sec_div.c create mode 100644 gmp4/mpn/generic/sec_invert.c create mode 100644 gmp4/mpn/generic/sec_mul.c create mode 100644 gmp4/mpn/generic/sec_pi1_div.c create mode 100644 gmp4/mpn/generic/sec_powm.c create mode 100644 gmp4/mpn/generic/sec_sqr.c create mode 100644 gmp4/mpn/generic/sec_tabselect.c create mode 100644 gmp4/mpn/generic/set_str.c create mode 100644 gmp4/mpn/generic/sizeinbase.c create mode 100644 gmp4/mpn/generic/sqr.c create mode 100644 gmp4/mpn/generic/sqr_basecase.c create mode 100644 gmp4/mpn/generic/sqrmod_bnm1.c create mode 100644 gmp4/mpn/generic/sqrtrem.c create mode 100644 gmp4/mpn/generic/sub.c create mode 100644 gmp4/mpn/generic/sub_1.c create mode 100644 gmp4/mpn/generic/sub_err1_n.c create mode 100644 gmp4/mpn/generic/sub_err2_n.c create mode 100644 gmp4/mpn/generic/sub_err3_n.c create mode 100644 gmp4/mpn/generic/sub_n.c create mode 100644 gmp4/mpn/generic/submul_1.c create mode 100644 gmp4/mpn/generic/tdiv_qr.c create mode 100644 gmp4/mpn/generic/toom22_mul.c create mode 100644 gmp4/mpn/generic/toom2_sqr.c create mode 100644 gmp4/mpn/generic/toom32_mul.c create mode 100644 gmp4/mpn/generic/toom33_mul.c create mode 100644 gmp4/mpn/generic/toom3_sqr.c create mode 100644 gmp4/mpn/generic/toom42_mul.c create mode 100644 gmp4/mpn/generic/toom42_mulmid.c create mode 100644 gmp4/mpn/generic/toom43_mul.c create mode 100644 gmp4/mpn/generic/toom44_mul.c create mode 100644 gmp4/mpn/generic/toom4_sqr.c create mode 100644 gmp4/mpn/generic/toom52_mul.c create mode 100644 gmp4/mpn/generic/toom53_mul.c create mode 100644 gmp4/mpn/generic/toom54_mul.c create mode 100644 gmp4/mpn/generic/toom62_mul.c create mode 100644 gmp4/mpn/generic/toom63_mul.c create mode 100644 gmp4/mpn/generic/toom6_sqr.c create mode 100644 gmp4/mpn/generic/toom6h_mul.c create mode 100644 gmp4/mpn/generic/toom8_sqr.c create mode 100644 gmp4/mpn/generic/toom8h_mul.c create mode 100644 gmp4/mpn/generic/toom_couple_handling.c create mode 100644 gmp4/mpn/generic/toom_eval_dgr3_pm1.c create mode 100644 gmp4/mpn/generic/toom_eval_dgr3_pm2.c create mode 100644 gmp4/mpn/generic/toom_eval_pm1.c create mode 100644 gmp4/mpn/generic/toom_eval_pm2.c create mode 100644 gmp4/mpn/generic/toom_eval_pm2exp.c create mode 100644 gmp4/mpn/generic/toom_eval_pm2rexp.c create mode 100644 gmp4/mpn/generic/toom_interpolate_12pts.c create mode 100644 gmp4/mpn/generic/toom_interpolate_16pts.c create mode 100644 gmp4/mpn/generic/toom_interpolate_5pts.c create mode 100644 gmp4/mpn/generic/toom_interpolate_6pts.c create mode 100644 gmp4/mpn/generic/toom_interpolate_7pts.c create mode 100644 gmp4/mpn/generic/toom_interpolate_8pts.c create mode 100644 gmp4/mpn/generic/trialdiv.c create mode 100644 gmp4/mpn/generic/udiv_w_sdiv.c create mode 100644 gmp4/mpn/generic/zero.c create mode 100644 gmp4/mpn/ia64/README create mode 100644 gmp4/mpn/ia64/add_n_sub_n.asm create mode 100644 gmp4/mpn/ia64/addmul_1.asm create mode 100644 gmp4/mpn/ia64/addmul_2.asm create mode 100644 gmp4/mpn/ia64/aors_n.asm create mode 100644 gmp4/mpn/ia64/aorsorrlsh1_n.asm create mode 100644 gmp4/mpn/ia64/aorsorrlsh2_n.asm create mode 100644 gmp4/mpn/ia64/aorsorrlshC_n.asm create mode 100644 gmp4/mpn/ia64/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/ia64/cnd_aors_n.asm create mode 100644 gmp4/mpn/ia64/copyd.asm create mode 100644 gmp4/mpn/ia64/copyi.asm create mode 100644 gmp4/mpn/ia64/dive_1.asm create mode 100644 gmp4/mpn/ia64/divrem_1.asm create mode 100644 gmp4/mpn/ia64/divrem_2.asm create mode 100644 gmp4/mpn/ia64/gcd_1.asm create mode 100644 gmp4/mpn/ia64/gmp-mparam.h create mode 100644 gmp4/mpn/ia64/hamdist.asm create mode 100644 gmp4/mpn/ia64/ia64-defs.m4 create mode 100644 gmp4/mpn/ia64/invert_limb.asm create mode 100644 gmp4/mpn/ia64/logops_n.asm create mode 100644 gmp4/mpn/ia64/lorrshift.asm create mode 100644 gmp4/mpn/ia64/lshiftc.asm create mode 100644 gmp4/mpn/ia64/mod_34lsub1.asm create mode 100644 gmp4/mpn/ia64/mode1o.asm create mode 100644 gmp4/mpn/ia64/mul_1.asm create mode 100644 gmp4/mpn/ia64/mul_2.asm create mode 100644 gmp4/mpn/ia64/popcount.asm create mode 100644 gmp4/mpn/ia64/rsh1aors_n.asm create mode 100644 gmp4/mpn/ia64/sec_tabselect.asm create mode 100644 gmp4/mpn/ia64/sqr_diag_addlsh1.asm create mode 100644 gmp4/mpn/ia64/submul_1.asm create mode 100644 gmp4/mpn/lisp/gmpasm-mode.el create mode 100755 gmp4/mpn/m4-ccas create mode 100644 gmp4/mpn/m68k/README create mode 100644 gmp4/mpn/m68k/aors_n.asm create mode 100644 gmp4/mpn/m68k/gmp-mparam.h create mode 100644 gmp4/mpn/m68k/lshift.asm create mode 100644 gmp4/mpn/m68k/m68k-defs.m4 create mode 100644 gmp4/mpn/m68k/mc68020/aorsmul_1.asm create mode 100644 gmp4/mpn/m68k/mc68020/mul_1.asm create mode 100644 gmp4/mpn/m68k/mc68020/udiv.asm create mode 100644 gmp4/mpn/m68k/mc68020/umul.asm create mode 100644 gmp4/mpn/m68k/rshift.asm create mode 100644 gmp4/mpn/m68k/t-m68k-defs.pl create mode 100644 gmp4/mpn/m88k/README create mode 100644 gmp4/mpn/m88k/add_n.s create mode 100644 gmp4/mpn/m88k/mc88110/add_n.S create mode 100644 gmp4/mpn/m88k/mc88110/addmul_1.s create mode 100644 gmp4/mpn/m88k/mc88110/mul_1.s create mode 100644 gmp4/mpn/m88k/mc88110/sub_n.S create mode 100644 gmp4/mpn/m88k/mul_1.s create mode 100644 gmp4/mpn/m88k/sub_n.s create mode 100644 gmp4/mpn/minithres/gmp-mparam.h create mode 100644 gmp4/mpn/mips32/add_n.asm create mode 100644 gmp4/mpn/mips32/addmul_1.asm create mode 100644 gmp4/mpn/mips32/gmp-mparam.h create mode 100644 gmp4/mpn/mips32/lshift.asm create mode 100644 gmp4/mpn/mips32/mips-defs.m4 create mode 100644 gmp4/mpn/mips32/mips.m4 create mode 100644 gmp4/mpn/mips32/mul_1.asm create mode 100644 gmp4/mpn/mips32/rshift.asm create mode 100644 gmp4/mpn/mips32/sub_n.asm create mode 100644 gmp4/mpn/mips32/submul_1.asm create mode 100644 gmp4/mpn/mips32/umul.asm create mode 100644 gmp4/mpn/mips64/README create mode 100644 gmp4/mpn/mips64/add_n.asm create mode 100644 gmp4/mpn/mips64/addmul_1.asm create mode 100644 gmp4/mpn/mips64/gmp-mparam.h create mode 100644 gmp4/mpn/mips64/lshift.asm create mode 100644 gmp4/mpn/mips64/mul_1.asm create mode 100644 gmp4/mpn/mips64/rshift.asm create mode 100644 gmp4/mpn/mips64/sqr_diagonal.asm create mode 100644 gmp4/mpn/mips64/sub_n.asm create mode 100644 gmp4/mpn/mips64/submul_1.asm create mode 100644 gmp4/mpn/mips64/umul.asm create mode 100644 gmp4/mpn/pa32/README create mode 100644 gmp4/mpn/pa32/add_n.asm create mode 100644 gmp4/mpn/pa32/gmp-mparam.h create mode 100644 gmp4/mpn/pa32/hppa1_1/addmul_1.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/gmp-mparam.h create mode 100644 gmp4/mpn/pa32/hppa1_1/mul_1.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/pa7100/add_n.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/pa7100/addmul_1.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/pa7100/lshift.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/pa7100/rshift.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/pa7100/sub_n.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/pa7100/submul_1.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/sqr_diagonal.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/submul_1.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/udiv.asm create mode 100644 gmp4/mpn/pa32/hppa1_1/umul.asm create mode 100644 gmp4/mpn/pa32/hppa2_0/add_n.asm create mode 100644 gmp4/mpn/pa32/hppa2_0/gmp-mparam.h create mode 100644 gmp4/mpn/pa32/hppa2_0/sqr_diagonal.asm create mode 100644 gmp4/mpn/pa32/hppa2_0/sub_n.asm create mode 100644 gmp4/mpn/pa32/lshift.asm create mode 100644 gmp4/mpn/pa32/pa-defs.m4 create mode 100644 gmp4/mpn/pa32/rshift.asm create mode 100644 gmp4/mpn/pa32/sub_n.asm create mode 100644 gmp4/mpn/pa32/udiv.asm create mode 100644 gmp4/mpn/pa64/README create mode 100644 gmp4/mpn/pa64/addmul_1.asm create mode 100644 gmp4/mpn/pa64/aors_n.asm create mode 100644 gmp4/mpn/pa64/aorslsh1_n.asm create mode 100644 gmp4/mpn/pa64/gmp-mparam.h create mode 100644 gmp4/mpn/pa64/lshift.asm create mode 100644 gmp4/mpn/pa64/mul_1.asm create mode 100644 gmp4/mpn/pa64/rshift.asm create mode 100644 gmp4/mpn/pa64/sqr_diagonal.asm create mode 100644 gmp4/mpn/pa64/submul_1.asm create mode 100644 gmp4/mpn/pa64/udiv.asm create mode 100644 gmp4/mpn/pa64/umul.asm create mode 100644 gmp4/mpn/power/add_n.asm create mode 100644 gmp4/mpn/power/addmul_1.asm create mode 100644 gmp4/mpn/power/gmp-mparam.h create mode 100644 gmp4/mpn/power/lshift.asm create mode 100644 gmp4/mpn/power/mul_1.asm create mode 100644 gmp4/mpn/power/rshift.asm create mode 100644 gmp4/mpn/power/sdiv.asm create mode 100644 gmp4/mpn/power/sub_n.asm create mode 100644 gmp4/mpn/power/submul_1.asm create mode 100644 gmp4/mpn/power/umul.asm create mode 100644 gmp4/mpn/powerpc32/750/com.asm create mode 100644 gmp4/mpn/powerpc32/750/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc32/750/lshift.asm create mode 100644 gmp4/mpn/powerpc32/750/rshift.asm create mode 100644 gmp4/mpn/powerpc32/README create mode 100644 gmp4/mpn/powerpc32/addlsh1_n.asm create mode 100644 gmp4/mpn/powerpc32/addmul_1.asm create mode 100644 gmp4/mpn/powerpc32/aix.m4 create mode 100644 gmp4/mpn/powerpc32/aors_n.asm create mode 100644 gmp4/mpn/powerpc32/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/powerpc32/darwin.m4 create mode 100644 gmp4/mpn/powerpc32/diveby3.asm create mode 100644 gmp4/mpn/powerpc32/divrem_2.asm create mode 100644 gmp4/mpn/powerpc32/eabi.m4 create mode 100644 gmp4/mpn/powerpc32/elf.m4 create mode 100644 gmp4/mpn/powerpc32/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc32/invert_limb.asm create mode 100644 gmp4/mpn/powerpc32/lshift.asm create mode 100644 gmp4/mpn/powerpc32/lshiftc.asm create mode 100644 gmp4/mpn/powerpc32/mod_34lsub1.asm create mode 100644 gmp4/mpn/powerpc32/mode1o.asm create mode 100644 gmp4/mpn/powerpc32/mul_1.asm create mode 100644 gmp4/mpn/powerpc32/p3-p7/aors_n.asm create mode 100644 gmp4/mpn/powerpc32/p3/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc32/p4/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc32/p5/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc32/p6/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc32/p7/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc32/powerpc-defs.m4 create mode 100644 gmp4/mpn/powerpc32/rshift.asm create mode 100644 gmp4/mpn/powerpc32/sec_tabselect.asm create mode 100644 gmp4/mpn/powerpc32/sqr_diag_addlsh1.asm create mode 100644 gmp4/mpn/powerpc32/sublsh1_n.asm create mode 100644 gmp4/mpn/powerpc32/submul_1.asm create mode 100644 gmp4/mpn/powerpc32/umul.asm create mode 100644 gmp4/mpn/powerpc32/vmx/copyd.asm create mode 100644 gmp4/mpn/powerpc32/vmx/copyi.asm create mode 100644 gmp4/mpn/powerpc32/vmx/logops_n.asm create mode 100644 gmp4/mpn/powerpc32/vmx/mod_34lsub1.asm create mode 100644 gmp4/mpn/powerpc32/vmx/popcount.asm create mode 100644 gmp4/mpn/powerpc64/README create mode 100644 gmp4/mpn/powerpc64/aix.m4 create mode 100644 gmp4/mpn/powerpc64/com.asm create mode 100644 gmp4/mpn/powerpc64/copyd.asm create mode 100644 gmp4/mpn/powerpc64/copyi.asm create mode 100644 gmp4/mpn/powerpc64/darwin.m4 create mode 100644 gmp4/mpn/powerpc64/elf.m4 create mode 100644 gmp4/mpn/powerpc64/logops_n.asm create mode 100644 gmp4/mpn/powerpc64/lshift.asm create mode 100644 gmp4/mpn/powerpc64/lshiftc.asm create mode 100644 gmp4/mpn/powerpc64/mode32/add_n.asm create mode 100644 gmp4/mpn/powerpc64/mode32/addmul_1.asm create mode 100644 gmp4/mpn/powerpc64/mode32/mul_1.asm create mode 100644 gmp4/mpn/powerpc64/mode32/p4/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc64/mode32/sqr_diagonal.asm create mode 100644 gmp4/mpn/powerpc64/mode32/sub_n.asm create mode 100644 gmp4/mpn/powerpc64/mode32/submul_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/aors_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/aorsmul_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/aorsorrlsh1_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/aorsorrlsh2_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/aorsorrlshC_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/powerpc64/mode64/cnd_aors_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/dive_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/divrem_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/divrem_2.asm create mode 100644 gmp4/mpn/powerpc64/mode64/gcd_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc64/mode64/invert_limb.asm create mode 100644 gmp4/mpn/powerpc64/mode64/mod_1_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/mod_1_4.asm create mode 100644 gmp4/mpn/powerpc64/mode64/mod_34lsub1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/mode1o.asm create mode 100644 gmp4/mpn/powerpc64/mode64/mul_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/mul_basecase.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p3/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc64/mode64/p4/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc64/mode64/p5/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc64/mode64/p6/aorsmul_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p6/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc64/mode64/p6/mul_basecase.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p7/aormul_2.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p7/aors_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p7/aorsorrlsh1_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p7/aorsorrlsh2_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p7/aorsorrlshC_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p7/gcd_1.asm create mode 100644 gmp4/mpn/powerpc64/mode64/p7/gmp-mparam.h create mode 100644 gmp4/mpn/powerpc64/mode64/rsh1aors_n.asm create mode 100644 gmp4/mpn/powerpc64/mode64/sqr_basecase.asm create mode 100644 gmp4/mpn/powerpc64/p6/lshift.asm create mode 100644 gmp4/mpn/powerpc64/p6/lshiftc.asm create mode 100644 gmp4/mpn/powerpc64/p6/rshift.asm create mode 100644 gmp4/mpn/powerpc64/p7/copyd.asm create mode 100644 gmp4/mpn/powerpc64/p7/copyi.asm create mode 100644 gmp4/mpn/powerpc64/p7/hamdist.asm create mode 100644 gmp4/mpn/powerpc64/p7/popcount.asm create mode 100644 gmp4/mpn/powerpc64/rshift.asm create mode 100644 gmp4/mpn/powerpc64/sec_tabselect.asm create mode 100644 gmp4/mpn/powerpc64/umul.asm create mode 100644 gmp4/mpn/powerpc64/vmx/popcount.asm create mode 100644 gmp4/mpn/s390_32/README create mode 100644 gmp4/mpn/s390_32/addmul_1.asm create mode 100644 gmp4/mpn/s390_32/copyd.asm create mode 100644 gmp4/mpn/s390_32/copyi.asm create mode 100644 gmp4/mpn/s390_32/esame/addmul_1.asm create mode 100644 gmp4/mpn/s390_32/esame/aors_n.asm create mode 100644 gmp4/mpn/s390_32/esame/aorslsh1_n.asm create mode 100644 gmp4/mpn/s390_32/esame/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/s390_32/esame/gmp-mparam.h create mode 100644 gmp4/mpn/s390_32/esame/mul_1.asm create mode 100644 gmp4/mpn/s390_32/esame/mul_basecase.asm create mode 100644 gmp4/mpn/s390_32/esame/sqr_basecase.asm create mode 100644 gmp4/mpn/s390_32/esame/submul_1.asm create mode 100644 gmp4/mpn/s390_32/gmp-mparam.h create mode 100644 gmp4/mpn/s390_32/logops_n.asm create mode 100644 gmp4/mpn/s390_32/lshift.asm create mode 100644 gmp4/mpn/s390_32/lshiftc.asm create mode 100644 gmp4/mpn/s390_32/mul_1.asm create mode 100644 gmp4/mpn/s390_32/rshift.asm create mode 100644 gmp4/mpn/s390_32/submul_1.asm create mode 100644 gmp4/mpn/s390_64/README create mode 100644 gmp4/mpn/s390_64/addmul_1.asm create mode 100644 gmp4/mpn/s390_64/aorrlsh1_n.asm create mode 100644 gmp4/mpn/s390_64/aors_n.asm create mode 100644 gmp4/mpn/s390_64/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/s390_64/copyd.asm create mode 100644 gmp4/mpn/s390_64/copyi.asm create mode 100644 gmp4/mpn/s390_64/gmp-mparam.h create mode 100644 gmp4/mpn/s390_64/invert_limb.asm create mode 100644 gmp4/mpn/s390_64/logops_n.asm create mode 100644 gmp4/mpn/s390_64/lshift.asm create mode 100644 gmp4/mpn/s390_64/lshiftc.asm create mode 100644 gmp4/mpn/s390_64/mod_34lsub1.asm create mode 100644 gmp4/mpn/s390_64/mul_1.asm create mode 100644 gmp4/mpn/s390_64/mul_basecase.asm create mode 100644 gmp4/mpn/s390_64/rshift.asm create mode 100644 gmp4/mpn/s390_64/sqr_basecase.asm create mode 100644 gmp4/mpn/s390_64/sublsh1_n.asm create mode 100644 gmp4/mpn/s390_64/submul_1.asm create mode 100644 gmp4/mpn/s390_64/z10/gmp-mparam.h create mode 100644 gmp4/mpn/sh/add_n.asm create mode 100644 gmp4/mpn/sh/sh2/addmul_1.asm create mode 100644 gmp4/mpn/sh/sh2/mul_1.asm create mode 100644 gmp4/mpn/sh/sh2/submul_1.asm create mode 100644 gmp4/mpn/sh/sub_n.asm create mode 100644 gmp4/mpn/sparc32/README create mode 100644 gmp4/mpn/sparc32/add_n.asm create mode 100644 gmp4/mpn/sparc32/addmul_1.asm create mode 100644 gmp4/mpn/sparc32/gmp-mparam.h create mode 100644 gmp4/mpn/sparc32/lshift.asm create mode 100644 gmp4/mpn/sparc32/mul_1.asm create mode 100644 gmp4/mpn/sparc32/rshift.asm create mode 100644 gmp4/mpn/sparc32/sparc-defs.m4 create mode 100644 gmp4/mpn/sparc32/sub_n.asm create mode 100644 gmp4/mpn/sparc32/submul_1.asm create mode 100644 gmp4/mpn/sparc32/udiv.asm create mode 100644 gmp4/mpn/sparc32/udiv_nfp.asm create mode 100644 gmp4/mpn/sparc32/ultrasparct1/add_n.asm create mode 100644 gmp4/mpn/sparc32/ultrasparct1/addmul_1.asm create mode 100644 gmp4/mpn/sparc32/ultrasparct1/gmp-mparam.h create mode 100644 gmp4/mpn/sparc32/ultrasparct1/mul_1.asm create mode 100644 gmp4/mpn/sparc32/ultrasparct1/sqr_diagonal.asm create mode 100644 gmp4/mpn/sparc32/ultrasparct1/sub_n.asm create mode 100644 gmp4/mpn/sparc32/ultrasparct1/submul_1.asm create mode 100644 gmp4/mpn/sparc32/umul.asm create mode 100644 gmp4/mpn/sparc32/v8/addmul_1.asm create mode 100644 gmp4/mpn/sparc32/v8/gmp-mparam.h create mode 100644 gmp4/mpn/sparc32/v8/mul_1.asm create mode 100644 gmp4/mpn/sparc32/v8/submul_1.asm create mode 100644 gmp4/mpn/sparc32/v8/supersparc/gmp-mparam.h create mode 100644 gmp4/mpn/sparc32/v8/supersparc/udiv.asm create mode 100644 gmp4/mpn/sparc32/v8/udiv.asm create mode 100644 gmp4/mpn/sparc32/v8/umul.asm create mode 100644 gmp4/mpn/sparc32/v9/README create mode 100644 gmp4/mpn/sparc32/v9/add_n.asm create mode 100644 gmp4/mpn/sparc32/v9/addmul_1.asm create mode 100644 gmp4/mpn/sparc32/v9/gmp-mparam.h create mode 100644 gmp4/mpn/sparc32/v9/mul_1.asm create mode 100644 gmp4/mpn/sparc32/v9/sqr_diagonal.asm create mode 100644 gmp4/mpn/sparc32/v9/sub_n.asm create mode 100644 gmp4/mpn/sparc32/v9/submul_1.asm create mode 100644 gmp4/mpn/sparc32/v9/udiv.asm create mode 100644 gmp4/mpn/sparc64/README create mode 100644 gmp4/mpn/sparc64/copyd.asm create mode 100644 gmp4/mpn/sparc64/copyi.asm create mode 100644 gmp4/mpn/sparc64/dive_1.c create mode 100644 gmp4/mpn/sparc64/divrem_1.c create mode 100644 gmp4/mpn/sparc64/gcd_1.asm create mode 100644 gmp4/mpn/sparc64/gmp-mparam.h create mode 100644 gmp4/mpn/sparc64/lshift.asm create mode 100644 gmp4/mpn/sparc64/lshiftc.asm create mode 100644 gmp4/mpn/sparc64/mod_1.c create mode 100644 gmp4/mpn/sparc64/mod_1_4.c create mode 100644 gmp4/mpn/sparc64/mode1o.c create mode 100644 gmp4/mpn/sparc64/rshift.asm create mode 100644 gmp4/mpn/sparc64/sec_tabselect.asm create mode 100644 gmp4/mpn/sparc64/sparc64.h create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/add_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/addmul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/addmul_2.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/lshiftc.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/mul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/sqr_diagonal.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/sub_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc1234/submul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparc34/gmp-mparam.h create mode 100644 gmp4/mpn/sparc64/ultrasparct1/add_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/addlsh1_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/addlsh2_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/addlshC_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/addmul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/gmp-mparam.h create mode 100644 gmp4/mpn/sparc64/ultrasparct1/mul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/rsblsh1_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/rsblsh2_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/rsblshC_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/sub_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/sublsh1_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/sublsh2_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/sublshC_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct1/submul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/add_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/addmul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/aormul_2.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/aormul_4.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/aorslsh_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/cnd_aors_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/dive_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/hamdist.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/invert_limb.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/missing.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/missing.m4 create mode 100644 gmp4/mpn/sparc64/ultrasparct3/mod_1_4.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/mod_34lsub1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/mode1o.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/mul_1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/popcount.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/sqr_diag_addlsh1.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/sub_n.asm create mode 100644 gmp4/mpn/sparc64/ultrasparct3/submul_1.asm create mode 100644 gmp4/mpn/thumb/add_n.asm create mode 100644 gmp4/mpn/thumb/sub_n.asm create mode 100644 gmp4/mpn/vax/add_n.asm create mode 100644 gmp4/mpn/vax/addmul_1.asm create mode 100644 gmp4/mpn/vax/elf.m4 create mode 100644 gmp4/mpn/vax/gmp-mparam.h create mode 100644 gmp4/mpn/vax/lshift.asm create mode 100644 gmp4/mpn/vax/mul_1.asm create mode 100644 gmp4/mpn/vax/rshift.asm create mode 100644 gmp4/mpn/vax/sub_n.asm create mode 100644 gmp4/mpn/vax/submul_1.asm create mode 100644 gmp4/mpn/x86/README create mode 100644 gmp4/mpn/x86/aors_n.asm create mode 100644 gmp4/mpn/x86/aorsmul_1.asm create mode 100644 gmp4/mpn/x86/atom/aorrlsh1_n.asm create mode 100644 gmp4/mpn/x86/atom/aorrlsh2_n.asm create mode 100644 gmp4/mpn/x86/atom/aorrlshC_n.asm create mode 100644 gmp4/mpn/x86/atom/aors_n.asm create mode 100644 gmp4/mpn/x86/atom/aorslshC_n.asm create mode 100644 gmp4/mpn/x86/atom/bdiv_q_1.asm create mode 100644 gmp4/mpn/x86/atom/cnd_add_n.asm create mode 100644 gmp4/mpn/x86/atom/cnd_sub_n.asm create mode 100644 gmp4/mpn/x86/atom/dive_1.asm create mode 100644 gmp4/mpn/x86/atom/gmp-mparam.h create mode 100644 gmp4/mpn/x86/atom/logops_n.asm create mode 100644 gmp4/mpn/x86/atom/lshift.asm create mode 100644 gmp4/mpn/x86/atom/lshiftc.asm create mode 100644 gmp4/mpn/x86/atom/mmx/copyd.asm create mode 100644 gmp4/mpn/x86/atom/mmx/copyi.asm create mode 100644 gmp4/mpn/x86/atom/mmx/hamdist.asm create mode 100644 gmp4/mpn/x86/atom/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86/atom/mode1o.asm create mode 100644 gmp4/mpn/x86/atom/rshift.asm create mode 100644 gmp4/mpn/x86/atom/sse2/aorsmul_1.asm create mode 100644 gmp4/mpn/x86/atom/sse2/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/x86/atom/sse2/divrem_1.asm create mode 100644 gmp4/mpn/x86/atom/sse2/mod_1_1.asm create mode 100644 gmp4/mpn/x86/atom/sse2/mod_1_4.asm create mode 100644 gmp4/mpn/x86/atom/sse2/mul_1.asm create mode 100644 gmp4/mpn/x86/atom/sse2/mul_basecase.asm create mode 100644 gmp4/mpn/x86/atom/sse2/popcount.asm create mode 100644 gmp4/mpn/x86/atom/sse2/sqr_basecase.asm create mode 100644 gmp4/mpn/x86/atom/sublsh1_n.asm create mode 100644 gmp4/mpn/x86/atom/sublsh2_n.asm create mode 100644 gmp4/mpn/x86/bd1/gmp-mparam.h create mode 100644 gmp4/mpn/x86/bd2/gmp-mparam.h create mode 100644 gmp4/mpn/x86/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/x86/bdiv_q_1.asm create mode 100644 gmp4/mpn/x86/bobcat/gmp-mparam.h create mode 100644 gmp4/mpn/x86/cnd_aors_n.asm create mode 100644 gmp4/mpn/x86/copyd.asm create mode 100644 gmp4/mpn/x86/copyi.asm create mode 100644 gmp4/mpn/x86/core2/gmp-mparam.h create mode 100644 gmp4/mpn/x86/coreihwl/gmp-mparam.h create mode 100644 gmp4/mpn/x86/coreinhm/gmp-mparam.h create mode 100644 gmp4/mpn/x86/coreisbr/gmp-mparam.h create mode 100644 gmp4/mpn/x86/darwin.m4 create mode 100644 gmp4/mpn/x86/dive_1.asm create mode 100644 gmp4/mpn/x86/divrem_1.asm create mode 100644 gmp4/mpn/x86/divrem_2.asm create mode 100644 gmp4/mpn/x86/fat/com.c create mode 100644 gmp4/mpn/x86/fat/fat.c create mode 100644 gmp4/mpn/x86/fat/fat_entry.asm create mode 100644 gmp4/mpn/x86/fat/gcd_1.c create mode 100644 gmp4/mpn/x86/fat/gmp-mparam.h create mode 100644 gmp4/mpn/x86/fat/lshiftc.c create mode 100644 gmp4/mpn/x86/fat/mod_1.c create mode 100644 gmp4/mpn/x86/fat/mod_1_1.c create mode 100644 gmp4/mpn/x86/fat/mod_1_2.c create mode 100644 gmp4/mpn/x86/fat/mod_1_4.c create mode 100644 gmp4/mpn/x86/fat/mode1o.c create mode 100644 gmp4/mpn/x86/fat/mullo_basecase.c create mode 100644 gmp4/mpn/x86/fat/redc_1.c create mode 100644 gmp4/mpn/x86/fat/redc_2.c create mode 100644 gmp4/mpn/x86/geode/gmp-mparam.h create mode 100644 gmp4/mpn/x86/gmp-mparam.h create mode 100644 gmp4/mpn/x86/i486/gmp-mparam.h create mode 100644 gmp4/mpn/x86/k10/gmp-mparam.h create mode 100644 gmp4/mpn/x86/k6/README create mode 100644 gmp4/mpn/x86/k6/aors_n.asm create mode 100644 gmp4/mpn/x86/k6/aorsmul_1.asm create mode 100755 gmp4/mpn/x86/k6/cross.pl create mode 100644 gmp4/mpn/x86/k6/divrem_1.asm create mode 100644 gmp4/mpn/x86/k6/gcd_1.asm create mode 100644 gmp4/mpn/x86/k6/gmp-mparam.h create mode 100644 gmp4/mpn/x86/k6/k62mmx/copyd.asm create mode 100644 gmp4/mpn/x86/k6/k62mmx/lshift.asm create mode 100644 gmp4/mpn/x86/k6/k62mmx/rshift.asm create mode 100644 gmp4/mpn/x86/k6/mmx/com.asm create mode 100644 gmp4/mpn/x86/k6/mmx/dive_1.asm create mode 100644 gmp4/mpn/x86/k6/mmx/logops_n.asm create mode 100644 gmp4/mpn/x86/k6/mmx/lshift.asm create mode 100644 gmp4/mpn/x86/k6/mmx/popham.asm create mode 100644 gmp4/mpn/x86/k6/mmx/rshift.asm create mode 100644 gmp4/mpn/x86/k6/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86/k6/mode1o.asm create mode 100644 gmp4/mpn/x86/k6/mul_1.asm create mode 100644 gmp4/mpn/x86/k6/mul_basecase.asm create mode 100644 gmp4/mpn/x86/k6/pre_mod_1.asm create mode 100644 gmp4/mpn/x86/k6/sqr_basecase.asm create mode 100644 gmp4/mpn/x86/k7/README create mode 100644 gmp4/mpn/x86/k7/addlsh1_n.asm create mode 100644 gmp4/mpn/x86/k7/aors_n.asm create mode 100644 gmp4/mpn/x86/k7/aorsmul_1.asm create mode 100644 gmp4/mpn/x86/k7/bdiv_q_1.asm create mode 100644 gmp4/mpn/x86/k7/dive_1.asm create mode 100644 gmp4/mpn/x86/k7/gcd_1.asm create mode 100644 gmp4/mpn/x86/k7/gmp-mparam.h create mode 100644 gmp4/mpn/x86/k7/invert_limb.asm create mode 100644 gmp4/mpn/x86/k7/mmx/com.asm create mode 100644 gmp4/mpn/x86/k7/mmx/copyd.asm create mode 100644 gmp4/mpn/x86/k7/mmx/copyi.asm create mode 100644 gmp4/mpn/x86/k7/mmx/divrem_1.asm create mode 100644 gmp4/mpn/x86/k7/mmx/lshift.asm create mode 100644 gmp4/mpn/x86/k7/mmx/popham.asm create mode 100644 gmp4/mpn/x86/k7/mmx/rshift.asm create mode 100644 gmp4/mpn/x86/k7/mod_1_1.asm create mode 100644 gmp4/mpn/x86/k7/mod_1_4.asm create mode 100644 gmp4/mpn/x86/k7/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86/k7/mode1o.asm create mode 100644 gmp4/mpn/x86/k7/mul_1.asm create mode 100644 gmp4/mpn/x86/k7/mul_basecase.asm create mode 100644 gmp4/mpn/x86/k7/sqr_basecase.asm create mode 100644 gmp4/mpn/x86/k7/sublsh1_n.asm create mode 100644 gmp4/mpn/x86/k8/gmp-mparam.h create mode 100644 gmp4/mpn/x86/lshift.asm create mode 100644 gmp4/mpn/x86/mmx/sec_tabselect.asm create mode 100644 gmp4/mpn/x86/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86/mul_1.asm create mode 100644 gmp4/mpn/x86/mul_basecase.asm create mode 100644 gmp4/mpn/x86/nano/gmp-mparam.h create mode 100644 gmp4/mpn/x86/p6/README create mode 100644 gmp4/mpn/x86/p6/aors_n.asm create mode 100644 gmp4/mpn/x86/p6/aorsmul_1.asm create mode 100644 gmp4/mpn/x86/p6/bdiv_q_1.asm create mode 100644 gmp4/mpn/x86/p6/copyd.asm create mode 100644 gmp4/mpn/x86/p6/dive_1.asm create mode 100644 gmp4/mpn/x86/p6/gcd_1.asm create mode 100644 gmp4/mpn/x86/p6/gmp-mparam.h create mode 100644 gmp4/mpn/x86/p6/lshsub_n.asm create mode 100644 gmp4/mpn/x86/p6/mmx/divrem_1.asm create mode 100644 gmp4/mpn/x86/p6/mmx/gmp-mparam.h create mode 100644 gmp4/mpn/x86/p6/mmx/lshift.asm create mode 100644 gmp4/mpn/x86/p6/mmx/popham.asm create mode 100644 gmp4/mpn/x86/p6/mmx/rshift.asm create mode 100644 gmp4/mpn/x86/p6/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86/p6/mode1o.asm create mode 100644 gmp4/mpn/x86/p6/mul_basecase.asm create mode 100644 gmp4/mpn/x86/p6/p3mmx/popham.asm create mode 100644 gmp4/mpn/x86/p6/sqr_basecase.asm create mode 100644 gmp4/mpn/x86/p6/sse2/addmul_1.asm create mode 100644 gmp4/mpn/x86/p6/sse2/gmp-mparam.h create mode 100644 gmp4/mpn/x86/p6/sse2/mod_1_1.asm create mode 100644 gmp4/mpn/x86/p6/sse2/mod_1_4.asm create mode 100644 gmp4/mpn/x86/p6/sse2/mul_1.asm create mode 100644 gmp4/mpn/x86/p6/sse2/mul_basecase.asm create mode 100644 gmp4/mpn/x86/p6/sse2/popcount.asm create mode 100644 gmp4/mpn/x86/p6/sse2/sqr_basecase.asm create mode 100644 gmp4/mpn/x86/p6/sse2/submul_1.asm create mode 100644 gmp4/mpn/x86/pentium/README create mode 100644 gmp4/mpn/x86/pentium/aors_n.asm create mode 100644 gmp4/mpn/x86/pentium/aorsmul_1.asm create mode 100644 gmp4/mpn/x86/pentium/bdiv_q_1.asm create mode 100644 gmp4/mpn/x86/pentium/com.asm create mode 100644 gmp4/mpn/x86/pentium/copyd.asm create mode 100644 gmp4/mpn/x86/pentium/copyi.asm create mode 100644 gmp4/mpn/x86/pentium/dive_1.asm create mode 100644 gmp4/mpn/x86/pentium/gmp-mparam.h create mode 100644 gmp4/mpn/x86/pentium/hamdist.asm create mode 100644 gmp4/mpn/x86/pentium/logops_n.asm create mode 100644 gmp4/mpn/x86/pentium/lshift.asm create mode 100644 gmp4/mpn/x86/pentium/mmx/gmp-mparam.h create mode 100644 gmp4/mpn/x86/pentium/mmx/hamdist.asm create mode 100644 gmp4/mpn/x86/pentium/mmx/lshift.asm create mode 100644 gmp4/mpn/x86/pentium/mmx/mul_1.asm create mode 100644 gmp4/mpn/x86/pentium/mmx/rshift.asm create mode 100644 gmp4/mpn/x86/pentium/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86/pentium/mode1o.asm create mode 100644 gmp4/mpn/x86/pentium/mul_1.asm create mode 100644 gmp4/mpn/x86/pentium/mul_2.asm create mode 100644 gmp4/mpn/x86/pentium/mul_basecase.asm create mode 100644 gmp4/mpn/x86/pentium/popcount.asm create mode 100644 gmp4/mpn/x86/pentium/rshift.asm create mode 100644 gmp4/mpn/x86/pentium/sqr_basecase.asm create mode 100644 gmp4/mpn/x86/pentium4/README create mode 100644 gmp4/mpn/x86/pentium4/copyd.asm create mode 100644 gmp4/mpn/x86/pentium4/copyi.asm create mode 100644 gmp4/mpn/x86/pentium4/mmx/lshift.asm create mode 100644 gmp4/mpn/x86/pentium4/mmx/popham.asm create mode 100644 gmp4/mpn/x86/pentium4/mmx/rshift.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/add_n.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/addlsh1_n.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/addmul_1.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/bdiv_q_1.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/cnd_add_n.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/cnd_sub_n.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/dive_1.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/divrem_1.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/gmp-mparam.h create mode 100644 gmp4/mpn/x86/pentium4/sse2/mod_1_1.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/mod_1_4.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/mode1o.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/mul_1.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/mul_basecase.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/popcount.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/rsh1add_n.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/sqr_basecase.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/sub_n.asm create mode 100644 gmp4/mpn/x86/pentium4/sse2/submul_1.asm create mode 100644 gmp4/mpn/x86/rshift.asm create mode 100644 gmp4/mpn/x86/sec_tabselect.asm create mode 100644 gmp4/mpn/x86/sqr_basecase.asm create mode 100755 gmp4/mpn/x86/t-zdisp.sh create mode 100755 gmp4/mpn/x86/t-zdisp2.pl create mode 100644 gmp4/mpn/x86/udiv.asm create mode 100644 gmp4/mpn/x86/umul.asm create mode 100644 gmp4/mpn/x86/x86-defs.m4 create mode 100644 gmp4/mpn/x86_64/README create mode 100644 gmp4/mpn/x86_64/addaddmul_1msb0.asm create mode 100644 gmp4/mpn/x86_64/addmul_2.asm create mode 100644 gmp4/mpn/x86_64/aorrlsh1_n.asm create mode 100644 gmp4/mpn/x86_64/aorrlsh2_n.asm create mode 100644 gmp4/mpn/x86_64/aorrlshC_n.asm create mode 100644 gmp4/mpn/x86_64/aorrlsh_n.asm create mode 100644 gmp4/mpn/x86_64/aors_err1_n.asm create mode 100644 gmp4/mpn/x86_64/aors_err2_n.asm create mode 100644 gmp4/mpn/x86_64/aors_err3_n.asm create mode 100644 gmp4/mpn/x86_64/aors_n.asm create mode 100644 gmp4/mpn/x86_64/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/atom/addmul_2.asm create mode 100644 gmp4/mpn/x86_64/atom/aorrlsh1_n.asm create mode 100644 gmp4/mpn/x86_64/atom/aorrlsh2_n.asm create mode 100644 gmp4/mpn/x86_64/atom/aors_n.asm create mode 100644 gmp4/mpn/x86_64/atom/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/atom/com.asm create mode 100644 gmp4/mpn/x86_64/atom/copyd.asm create mode 100644 gmp4/mpn/x86_64/atom/copyi.asm create mode 100644 gmp4/mpn/x86_64/atom/dive_1.asm create mode 100644 gmp4/mpn/x86_64/atom/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/atom/lshift.asm create mode 100644 gmp4/mpn/x86_64/atom/lshiftc.asm create mode 100644 gmp4/mpn/x86_64/atom/mul_1.asm create mode 100644 gmp4/mpn/x86_64/atom/mul_2.asm create mode 100644 gmp4/mpn/x86_64/atom/popcount.asm create mode 100644 gmp4/mpn/x86_64/atom/redc_1.asm create mode 100644 gmp4/mpn/x86_64/atom/rsh1aors_n.asm create mode 100644 gmp4/mpn/x86_64/atom/rshift.asm create mode 100644 gmp4/mpn/x86_64/atom/sublsh1_n.asm create mode 100644 gmp4/mpn/x86_64/bd1/README create mode 100644 gmp4/mpn/x86_64/bd1/aorrlsh1_n.asm create mode 100644 gmp4/mpn/x86_64/bd1/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/bd1/com.asm create mode 100644 gmp4/mpn/x86_64/bd1/copyd.asm create mode 100644 gmp4/mpn/x86_64/bd1/copyi.asm create mode 100644 gmp4/mpn/x86_64/bd1/gcd_1.asm create mode 100644 gmp4/mpn/x86_64/bd1/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/bd1/hamdist.asm create mode 100644 gmp4/mpn/x86_64/bd1/mul_1.asm create mode 100644 gmp4/mpn/x86_64/bd1/mul_2.asm create mode 100644 gmp4/mpn/x86_64/bd1/mul_basecase.asm create mode 100644 gmp4/mpn/x86_64/bd1/popcount.asm create mode 100644 gmp4/mpn/x86_64/bd1/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/bd1/sublsh1_n.asm create mode 100644 gmp4/mpn/x86_64/bd2/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/bdiv_dbm1c.asm create mode 100644 gmp4/mpn/x86_64/bdiv_q_1.asm create mode 100644 gmp4/mpn/x86_64/bobcat/aors_n.asm create mode 100644 gmp4/mpn/x86_64/bobcat/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/bobcat/copyd.asm create mode 100644 gmp4/mpn/x86_64/bobcat/copyi.asm create mode 100644 gmp4/mpn/x86_64/bobcat/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/bobcat/mul_1.asm create mode 100644 gmp4/mpn/x86_64/bobcat/mul_basecase.asm create mode 100644 gmp4/mpn/x86_64/bobcat/redc_1.asm create mode 100644 gmp4/mpn/x86_64/bobcat/sqr_basecase.asm create mode 100644 gmp4/mpn/x86_64/cnd_aors_n.asm create mode 100644 gmp4/mpn/x86_64/com.asm create mode 100644 gmp4/mpn/x86_64/copyd.asm create mode 100644 gmp4/mpn/x86_64/copyi.asm create mode 100644 gmp4/mpn/x86_64/core2/aorrlsh1_n.asm create mode 100644 gmp4/mpn/x86_64/core2/aorrlsh2_n.asm create mode 100644 gmp4/mpn/x86_64/core2/aorrlsh_n.asm create mode 100644 gmp4/mpn/x86_64/core2/aors_err1_n.asm create mode 100644 gmp4/mpn/x86_64/core2/aors_n.asm create mode 100644 gmp4/mpn/x86_64/core2/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/core2/copyd.asm create mode 100644 gmp4/mpn/x86_64/core2/copyi.asm create mode 100644 gmp4/mpn/x86_64/core2/divrem_1.asm create mode 100644 gmp4/mpn/x86_64/core2/gcd_1.asm create mode 100644 gmp4/mpn/x86_64/core2/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/core2/lshift.asm create mode 100644 gmp4/mpn/x86_64/core2/lshiftc.asm create mode 100644 gmp4/mpn/x86_64/core2/mul_basecase.asm create mode 100644 gmp4/mpn/x86_64/core2/mullo_basecase.asm create mode 100644 gmp4/mpn/x86_64/core2/popcount.asm create mode 100644 gmp4/mpn/x86_64/core2/redc_1.asm create mode 100644 gmp4/mpn/x86_64/core2/rsh1aors_n.asm create mode 100644 gmp4/mpn/x86_64/core2/rshift.asm create mode 100644 gmp4/mpn/x86_64/core2/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/core2/sqr_basecase.asm create mode 100644 gmp4/mpn/x86_64/core2/sublsh1_n.asm create mode 100644 gmp4/mpn/x86_64/core2/sublsh2_n.asm create mode 100644 gmp4/mpn/x86_64/core2/sublshC_n.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/addmul_2.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/coreihwl/mul_1.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/mul_2.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/mul_basecase.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/mullo_basecase.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/redc_1.asm create mode 100644 gmp4/mpn/x86_64/coreihwl/sqr_basecase.asm create mode 100644 gmp4/mpn/x86_64/coreinhm/aorrlsh_n.asm create mode 100644 gmp4/mpn/x86_64/coreinhm/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/coreinhm/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/coreinhm/hamdist.asm create mode 100644 gmp4/mpn/x86_64/coreinhm/popcount.asm create mode 100644 gmp4/mpn/x86_64/coreinhm/redc_1.asm create mode 100644 gmp4/mpn/x86_64/coreinhm/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/addmul_2.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/aorrlsh1_n.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/aorrlsh2_n.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/aorrlshC_n.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/aorrlsh_n.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/aors_n.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/divrem_1.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/coreisbr/lshift.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/lshiftc.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/mul_1.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/mul_2.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/mul_basecase.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/mullo_basecase.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/popcount.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/redc_1.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/rsh1aors_n.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/rshift.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/coreisbr/sqr_basecase.asm create mode 100644 gmp4/mpn/x86_64/darwin.m4 create mode 100644 gmp4/mpn/x86_64/div_qr_1n_pi1.asm create mode 100644 gmp4/mpn/x86_64/div_qr_2n_pi1.asm create mode 100644 gmp4/mpn/x86_64/div_qr_2u_pi1.asm create mode 100644 gmp4/mpn/x86_64/dive_1.asm create mode 100644 gmp4/mpn/x86_64/divrem_1.asm create mode 100644 gmp4/mpn/x86_64/divrem_2.asm create mode 100644 gmp4/mpn/x86_64/dos64.m4 create mode 100644 gmp4/mpn/x86_64/fastavx/copyd.asm create mode 100644 gmp4/mpn/x86_64/fastavx/copyi.asm create mode 100644 gmp4/mpn/x86_64/fastsse/README create mode 100644 gmp4/mpn/x86_64/fastsse/com-palignr.asm create mode 100644 gmp4/mpn/x86_64/fastsse/com.asm create mode 100644 gmp4/mpn/x86_64/fastsse/copyd-palignr.asm create mode 100644 gmp4/mpn/x86_64/fastsse/copyd.asm create mode 100644 gmp4/mpn/x86_64/fastsse/copyi-palignr.asm create mode 100644 gmp4/mpn/x86_64/fastsse/copyi.asm create mode 100644 gmp4/mpn/x86_64/fastsse/lshift-movdqu2.asm create mode 100644 gmp4/mpn/x86_64/fastsse/lshift.asm create mode 100644 gmp4/mpn/x86_64/fastsse/lshiftc-movdqu2.asm create mode 100644 gmp4/mpn/x86_64/fastsse/lshiftc.asm create mode 100644 gmp4/mpn/x86_64/fastsse/rshift-movdqu2.asm create mode 100644 gmp4/mpn/x86_64/fastsse/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/fat/fat.c create mode 100644 gmp4/mpn/x86_64/fat/fat_entry.asm create mode 100644 gmp4/mpn/x86_64/fat/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/fat/mod_1.c create mode 100644 gmp4/mpn/x86_64/fat/mul_basecase.c create mode 100644 gmp4/mpn/x86_64/fat/mullo_basecase.c create mode 100644 gmp4/mpn/x86_64/fat/redc_1.c create mode 100644 gmp4/mpn/x86_64/fat/redc_2.c create mode 100644 gmp4/mpn/x86_64/fat/sqr_basecase.c create mode 100644 gmp4/mpn/x86_64/gcd_1.asm create mode 100644 gmp4/mpn/x86_64/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/invert_limb.asm create mode 100644 gmp4/mpn/x86_64/invert_limb_table.asm create mode 100644 gmp4/mpn/x86_64/k10/gcd_1.asm create mode 100644 gmp4/mpn/x86_64/k10/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/k10/hamdist.asm create mode 100644 gmp4/mpn/x86_64/k10/lshift.asm create mode 100644 gmp4/mpn/x86_64/k10/lshiftc.asm create mode 100644 gmp4/mpn/x86_64/k10/popcount.asm create mode 100644 gmp4/mpn/x86_64/k10/rshift.asm create mode 100644 gmp4/mpn/x86_64/k10/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/k8/aorrlsh_n.asm create mode 100644 gmp4/mpn/x86_64/k8/div_qr_1n_pi1.asm create mode 100644 gmp4/mpn/x86_64/k8/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/k8/mul_basecase.asm create mode 100644 gmp4/mpn/x86_64/k8/mullo_basecase.asm create mode 100644 gmp4/mpn/x86_64/k8/mulmid_basecase.asm create mode 100644 gmp4/mpn/x86_64/k8/redc_1.asm create mode 100644 gmp4/mpn/x86_64/k8/sqr_basecase.asm create mode 100644 gmp4/mpn/x86_64/logops_n.asm create mode 100644 gmp4/mpn/x86_64/lshift.asm create mode 100644 gmp4/mpn/x86_64/lshiftc.asm create mode 100644 gmp4/mpn/x86_64/lshsub_n.asm create mode 100644 gmp4/mpn/x86_64/missing-call.m4 create mode 100644 gmp4/mpn/x86_64/missing-inline.m4 create mode 100644 gmp4/mpn/x86_64/missing.asm create mode 100644 gmp4/mpn/x86_64/mod_1_1.asm create mode 100644 gmp4/mpn/x86_64/mod_1_2.asm create mode 100644 gmp4/mpn/x86_64/mod_1_4.asm create mode 100644 gmp4/mpn/x86_64/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86_64/mode1o.asm create mode 100644 gmp4/mpn/x86_64/mul_1.asm create mode 100644 gmp4/mpn/x86_64/mul_2.asm create mode 100644 gmp4/mpn/x86_64/mulx/adx/addmul_1.asm create mode 100644 gmp4/mpn/x86_64/mulx/aorsmul_1.asm create mode 100644 gmp4/mpn/x86_64/mulx/mul_1.asm create mode 100644 gmp4/mpn/x86_64/nano/copyd.asm create mode 100644 gmp4/mpn/x86_64/nano/copyi.asm create mode 100644 gmp4/mpn/x86_64/nano/dive_1.asm create mode 100644 gmp4/mpn/x86_64/nano/gcd_1.asm create mode 100644 gmp4/mpn/x86_64/nano/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/nano/popcount.asm create mode 100644 gmp4/mpn/x86_64/pentium4/aors_n.asm create mode 100644 gmp4/mpn/x86_64/pentium4/aorslsh1_n.asm create mode 100644 gmp4/mpn/x86_64/pentium4/aorslsh2_n.asm create mode 100644 gmp4/mpn/x86_64/pentium4/aorslshC_n.asm create mode 100644 gmp4/mpn/x86_64/pentium4/gmp-mparam.h create mode 100644 gmp4/mpn/x86_64/pentium4/lshift.asm create mode 100644 gmp4/mpn/x86_64/pentium4/lshiftc.asm create mode 100644 gmp4/mpn/x86_64/pentium4/mod_34lsub1.asm create mode 100644 gmp4/mpn/x86_64/pentium4/popcount.asm create mode 100644 gmp4/mpn/x86_64/pentium4/rsh1aors_n.asm create mode 100644 gmp4/mpn/x86_64/pentium4/rshift.asm create mode 100644 gmp4/mpn/x86_64/pentium4/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/popham.asm create mode 100644 gmp4/mpn/x86_64/rsh1aors_n.asm create mode 100644 gmp4/mpn/x86_64/rshift.asm create mode 100644 gmp4/mpn/x86_64/sec_tabselect.asm create mode 100644 gmp4/mpn/x86_64/sqr_diag_addlsh1.asm create mode 100644 gmp4/mpn/x86_64/sublsh1_n.asm create mode 100644 gmp4/mpn/x86_64/x86_64-defs.m4 create mode 100644 gmp4/mpq/Makefile.am create mode 100644 gmp4/mpq/Makefile.in create mode 100644 gmp4/mpq/abs.c create mode 100644 gmp4/mpq/aors.c create mode 100644 gmp4/mpq/canonicalize.c create mode 100644 gmp4/mpq/clear.c create mode 100644 gmp4/mpq/clears.c create mode 100644 gmp4/mpq/cmp.c create mode 100644 gmp4/mpq/cmp_si.c create mode 100644 gmp4/mpq/cmp_ui.c create mode 100644 gmp4/mpq/div.c create mode 100644 gmp4/mpq/equal.c create mode 100644 gmp4/mpq/get_d.c create mode 100644 gmp4/mpq/get_den.c create mode 100644 gmp4/mpq/get_num.c create mode 100644 gmp4/mpq/get_str.c create mode 100644 gmp4/mpq/init.c create mode 100644 gmp4/mpq/inits.c create mode 100644 gmp4/mpq/inp_str.c create mode 100644 gmp4/mpq/inv.c create mode 100644 gmp4/mpq/md_2exp.c create mode 100644 gmp4/mpq/mul.c create mode 100644 gmp4/mpq/neg.c create mode 100644 gmp4/mpq/out_str.c create mode 100644 gmp4/mpq/set.c create mode 100644 gmp4/mpq/set_d.c create mode 100644 gmp4/mpq/set_den.c create mode 100644 gmp4/mpq/set_f.c create mode 100644 gmp4/mpq/set_num.c create mode 100644 gmp4/mpq/set_si.c create mode 100644 gmp4/mpq/set_str.c create mode 100644 gmp4/mpq/set_ui.c create mode 100644 gmp4/mpq/set_z.c create mode 100644 gmp4/mpq/swap.c create mode 100644 gmp4/mpz/2fac_ui.c create mode 100644 gmp4/mpz/Makefile.am create mode 100644 gmp4/mpz/Makefile.in create mode 100644 gmp4/mpz/abs.c create mode 100644 gmp4/mpz/add.c create mode 100644 gmp4/mpz/add_ui.c create mode 100644 gmp4/mpz/and.c create mode 100644 gmp4/mpz/aors.h create mode 100644 gmp4/mpz/aors_ui.h create mode 100644 gmp4/mpz/aorsmul.c create mode 100644 gmp4/mpz/aorsmul_i.c create mode 100644 gmp4/mpz/array_init.c create mode 100644 gmp4/mpz/bin_ui.c create mode 100644 gmp4/mpz/bin_uiui.c create mode 100644 gmp4/mpz/cdiv_q.c create mode 100644 gmp4/mpz/cdiv_q_ui.c create mode 100644 gmp4/mpz/cdiv_qr.c create mode 100644 gmp4/mpz/cdiv_qr_ui.c create mode 100644 gmp4/mpz/cdiv_r.c create mode 100644 gmp4/mpz/cdiv_r_ui.c create mode 100644 gmp4/mpz/cdiv_ui.c create mode 100644 gmp4/mpz/cfdiv_q_2exp.c create mode 100644 gmp4/mpz/cfdiv_r_2exp.c create mode 100644 gmp4/mpz/clear.c create mode 100644 gmp4/mpz/clears.c create mode 100644 gmp4/mpz/clrbit.c create mode 100644 gmp4/mpz/cmp.c create mode 100644 gmp4/mpz/cmp_d.c create mode 100644 gmp4/mpz/cmp_si.c create mode 100644 gmp4/mpz/cmp_ui.c create mode 100644 gmp4/mpz/cmpabs.c create mode 100644 gmp4/mpz/cmpabs_d.c create mode 100644 gmp4/mpz/cmpabs_ui.c create mode 100644 gmp4/mpz/com.c create mode 100644 gmp4/mpz/combit.c create mode 100644 gmp4/mpz/cong.c create mode 100644 gmp4/mpz/cong_2exp.c create mode 100644 gmp4/mpz/cong_ui.c create mode 100644 gmp4/mpz/dive_ui.c create mode 100644 gmp4/mpz/divegcd.c create mode 100644 gmp4/mpz/divexact.c create mode 100644 gmp4/mpz/divis.c create mode 100644 gmp4/mpz/divis_2exp.c create mode 100644 gmp4/mpz/divis_ui.c create mode 100644 gmp4/mpz/dump.c create mode 100644 gmp4/mpz/export.c create mode 100644 gmp4/mpz/fac_ui.c create mode 100644 gmp4/mpz/fdiv_q.c create mode 100644 gmp4/mpz/fdiv_q_ui.c create mode 100644 gmp4/mpz/fdiv_qr.c create mode 100644 gmp4/mpz/fdiv_qr_ui.c create mode 100644 gmp4/mpz/fdiv_r.c create mode 100644 gmp4/mpz/fdiv_r_ui.c create mode 100644 gmp4/mpz/fdiv_ui.c create mode 100644 gmp4/mpz/fib2_ui.c create mode 100644 gmp4/mpz/fib_ui.c create mode 100644 gmp4/mpz/fits_s.h create mode 100644 gmp4/mpz/fits_sint.c create mode 100644 gmp4/mpz/fits_slong.c create mode 100644 gmp4/mpz/fits_sshort.c create mode 100644 gmp4/mpz/fits_uint.c create mode 100644 gmp4/mpz/fits_ulong.c create mode 100644 gmp4/mpz/fits_ushort.c create mode 100644 gmp4/mpz/gcd.c create mode 100644 gmp4/mpz/gcd_ui.c create mode 100644 gmp4/mpz/gcdext.c create mode 100644 gmp4/mpz/get_d.c create mode 100644 gmp4/mpz/get_d_2exp.c create mode 100644 gmp4/mpz/get_si.c create mode 100644 gmp4/mpz/get_str.c create mode 100644 gmp4/mpz/get_ui.c create mode 100644 gmp4/mpz/getlimbn.c create mode 100644 gmp4/mpz/hamdist.c create mode 100644 gmp4/mpz/import.c create mode 100644 gmp4/mpz/init.c create mode 100644 gmp4/mpz/init2.c create mode 100644 gmp4/mpz/inits.c create mode 100644 gmp4/mpz/inp_raw.c create mode 100644 gmp4/mpz/inp_str.c create mode 100644 gmp4/mpz/invert.c create mode 100644 gmp4/mpz/ior.c create mode 100644 gmp4/mpz/iset.c create mode 100644 gmp4/mpz/iset_d.c create mode 100644 gmp4/mpz/iset_si.c create mode 100644 gmp4/mpz/iset_str.c create mode 100644 gmp4/mpz/iset_ui.c create mode 100644 gmp4/mpz/jacobi.c create mode 100644 gmp4/mpz/kronsz.c create mode 100644 gmp4/mpz/kronuz.c create mode 100644 gmp4/mpz/kronzs.c create mode 100644 gmp4/mpz/kronzu.c create mode 100644 gmp4/mpz/lcm.c create mode 100644 gmp4/mpz/lcm_ui.c create mode 100644 gmp4/mpz/limbs_finish.c create mode 100644 gmp4/mpz/limbs_modify.c create mode 100644 gmp4/mpz/limbs_read.c create mode 100644 gmp4/mpz/limbs_write.c create mode 100644 gmp4/mpz/lucnum2_ui.c create mode 100644 gmp4/mpz/lucnum_ui.c create mode 100644 gmp4/mpz/mfac_uiui.c create mode 100644 gmp4/mpz/millerrabin.c create mode 100644 gmp4/mpz/mod.c create mode 100644 gmp4/mpz/mul.c create mode 100644 gmp4/mpz/mul_2exp.c create mode 100644 gmp4/mpz/mul_i.h create mode 100644 gmp4/mpz/mul_si.c create mode 100644 gmp4/mpz/mul_ui.c create mode 100644 gmp4/mpz/n_pow_ui.c create mode 100644 gmp4/mpz/neg.c create mode 100644 gmp4/mpz/nextprime.c create mode 100644 gmp4/mpz/oddfac_1.c create mode 100644 gmp4/mpz/out_raw.c create mode 100644 gmp4/mpz/out_str.c create mode 100644 gmp4/mpz/perfpow.c create mode 100644 gmp4/mpz/perfsqr.c create mode 100644 gmp4/mpz/popcount.c create mode 100644 gmp4/mpz/pow_ui.c create mode 100644 gmp4/mpz/powm.c create mode 100644 gmp4/mpz/powm_sec.c create mode 100644 gmp4/mpz/powm_ui.c create mode 100644 gmp4/mpz/pprime_p.c create mode 100644 gmp4/mpz/primorial_ui.c create mode 100644 gmp4/mpz/prodlimbs.c create mode 100644 gmp4/mpz/random.c create mode 100644 gmp4/mpz/random2.c create mode 100644 gmp4/mpz/realloc.c create mode 100644 gmp4/mpz/realloc2.c create mode 100644 gmp4/mpz/remove.c create mode 100644 gmp4/mpz/roinit_n.c create mode 100644 gmp4/mpz/root.c create mode 100644 gmp4/mpz/rootrem.c create mode 100644 gmp4/mpz/rrandomb.c create mode 100644 gmp4/mpz/scan0.c create mode 100644 gmp4/mpz/scan1.c create mode 100644 gmp4/mpz/set.c create mode 100644 gmp4/mpz/set_d.c create mode 100644 gmp4/mpz/set_f.c create mode 100644 gmp4/mpz/set_q.c create mode 100644 gmp4/mpz/set_si.c create mode 100644 gmp4/mpz/set_str.c create mode 100644 gmp4/mpz/set_ui.c create mode 100644 gmp4/mpz/setbit.c create mode 100644 gmp4/mpz/size.c create mode 100644 gmp4/mpz/sizeinbase.c create mode 100644 gmp4/mpz/sqrt.c create mode 100644 gmp4/mpz/sqrtrem.c create mode 100644 gmp4/mpz/sub.c create mode 100644 gmp4/mpz/sub_ui.c create mode 100644 gmp4/mpz/swap.c create mode 100644 gmp4/mpz/tdiv_q.c create mode 100644 gmp4/mpz/tdiv_q_2exp.c create mode 100644 gmp4/mpz/tdiv_q_ui.c create mode 100644 gmp4/mpz/tdiv_qr.c create mode 100644 gmp4/mpz/tdiv_qr_ui.c create mode 100644 gmp4/mpz/tdiv_r.c create mode 100644 gmp4/mpz/tdiv_r_2exp.c create mode 100644 gmp4/mpz/tdiv_r_ui.c create mode 100644 gmp4/mpz/tdiv_ui.c create mode 100644 gmp4/mpz/tstbit.c create mode 100644 gmp4/mpz/ui_pow_ui.c create mode 100644 gmp4/mpz/ui_sub.c create mode 100644 gmp4/mpz/urandomb.c create mode 100644 gmp4/mpz/urandomm.c create mode 100644 gmp4/mpz/xor.c create mode 100644 gmp4/nextprime.c create mode 100644 gmp4/primesieve.c create mode 100644 gmp4/printf/Makefile.am create mode 100644 gmp4/printf/Makefile.in create mode 100644 gmp4/printf/asprintf.c create mode 100644 gmp4/printf/asprntffuns.c create mode 100644 gmp4/printf/doprnt.c create mode 100644 gmp4/printf/doprntf.c create mode 100644 gmp4/printf/doprnti.c create mode 100644 gmp4/printf/fprintf.c create mode 100644 gmp4/printf/obprintf.c create mode 100644 gmp4/printf/obprntffuns.c create mode 100644 gmp4/printf/obvprintf.c create mode 100644 gmp4/printf/printf.c create mode 100644 gmp4/printf/printffuns.c create mode 100644 gmp4/printf/repl-vsnprintf.c create mode 100644 gmp4/printf/snprintf.c create mode 100644 gmp4/printf/snprntffuns.c create mode 100644 gmp4/printf/sprintf.c create mode 100644 gmp4/printf/sprintffuns.c create mode 100644 gmp4/printf/vasprintf.c create mode 100644 gmp4/printf/vfprintf.c create mode 100644 gmp4/printf/vprintf.c create mode 100644 gmp4/printf/vsnprintf.c create mode 100644 gmp4/printf/vsprintf.c create mode 100644 gmp4/rand/Makefile.am create mode 100644 gmp4/rand/Makefile.in create mode 100644 gmp4/rand/rand.c create mode 100644 gmp4/rand/randbui.c create mode 100644 gmp4/rand/randclr.c create mode 100644 gmp4/rand/randdef.c create mode 100644 gmp4/rand/randiset.c create mode 100644 gmp4/rand/randlc2s.c create mode 100644 gmp4/rand/randlc2x.c create mode 100644 gmp4/rand/randmt.c create mode 100644 gmp4/rand/randmt.h create mode 100644 gmp4/rand/randmts.c create mode 100644 gmp4/rand/randmui.c create mode 100644 gmp4/rand/rands.c create mode 100644 gmp4/rand/randsd.c create mode 100644 gmp4/rand/randsdui.c create mode 100644 gmp4/scanf/Makefile.am create mode 100644 gmp4/scanf/Makefile.in create mode 100644 gmp4/scanf/doscan.c create mode 100644 gmp4/scanf/fscanf.c create mode 100644 gmp4/scanf/fscanffuns.c create mode 100644 gmp4/scanf/scanf.c create mode 100644 gmp4/scanf/sscanf.c create mode 100644 gmp4/scanf/sscanffuns.c create mode 100644 gmp4/scanf/vfscanf.c create mode 100644 gmp4/scanf/vscanf.c create mode 100644 gmp4/scanf/vsscanf.c create mode 100644 gmp4/tal-debug.c create mode 100644 gmp4/tal-notreent.c create mode 100644 gmp4/tal-reent.c create mode 100755 gmp4/test-driver create mode 100644 gmp4/tests/Makefile.am create mode 100644 gmp4/tests/Makefile.in create mode 100644 gmp4/tests/amd64call.asm create mode 100644 gmp4/tests/amd64check.c create mode 100644 gmp4/tests/arm32call.asm create mode 100644 gmp4/tests/arm32check.c create mode 100644 gmp4/tests/cxx/Makefile.am create mode 100644 gmp4/tests/cxx/Makefile.in create mode 100644 gmp4/tests/cxx/clocale.c create mode 100644 gmp4/tests/cxx/t-assign.cc create mode 100644 gmp4/tests/cxx/t-binary.cc create mode 100644 gmp4/tests/cxx/t-cast.cc create mode 100644 gmp4/tests/cxx/t-constr.cc create mode 100644 gmp4/tests/cxx/t-cxx11.cc create mode 100644 gmp4/tests/cxx/t-do-exceptions-work-at-all-with-this-compiler.cc create mode 100644 gmp4/tests/cxx/t-headers.cc create mode 100644 gmp4/tests/cxx/t-iostream.cc create mode 100644 gmp4/tests/cxx/t-istream.cc create mode 100644 gmp4/tests/cxx/t-locale.cc create mode 100644 gmp4/tests/cxx/t-misc.cc create mode 100644 gmp4/tests/cxx/t-mix.cc create mode 100644 gmp4/tests/cxx/t-ops.cc create mode 100644 gmp4/tests/cxx/t-ops2.cc create mode 100644 gmp4/tests/cxx/t-ops3.cc create mode 100644 gmp4/tests/cxx/t-ostream.cc create mode 100644 gmp4/tests/cxx/t-prec.cc create mode 100644 gmp4/tests/cxx/t-rand.cc create mode 100644 gmp4/tests/cxx/t-ternary.cc create mode 100644 gmp4/tests/cxx/t-unary.cc create mode 100644 gmp4/tests/devel/Makefile.am create mode 100644 gmp4/tests/devel/Makefile.in create mode 100644 gmp4/tests/devel/README create mode 100644 gmp4/tests/devel/anymul_1.c create mode 100644 gmp4/tests/devel/aors_n.c create mode 100644 gmp4/tests/devel/copy.c create mode 100644 gmp4/tests/devel/divmod_1.c create mode 100644 gmp4/tests/devel/divrem.c create mode 100644 gmp4/tests/devel/logops_n.c create mode 100644 gmp4/tests/devel/shift.c create mode 100644 gmp4/tests/devel/try.c create mode 100644 gmp4/tests/devel/tst-addsub.c create mode 100644 gmp4/tests/memory.c create mode 100644 gmp4/tests/misc.c create mode 100644 gmp4/tests/misc/Makefile.am create mode 100644 gmp4/tests/misc/Makefile.in create mode 100644 gmp4/tests/misc/t-locale.c create mode 100644 gmp4/tests/misc/t-printf.c create mode 100644 gmp4/tests/misc/t-scanf.c create mode 100644 gmp4/tests/mpf/Makefile.am create mode 100644 gmp4/tests/mpf/Makefile.in create mode 100644 gmp4/tests/mpf/reuse.c create mode 100644 gmp4/tests/mpf/t-add.c create mode 100644 gmp4/tests/mpf/t-cmp_d.c create mode 100644 gmp4/tests/mpf/t-cmp_si.c create mode 100644 gmp4/tests/mpf/t-conv.c create mode 100644 gmp4/tests/mpf/t-div.c create mode 100644 gmp4/tests/mpf/t-dm2exp.c create mode 100644 gmp4/tests/mpf/t-eq.c create mode 100644 gmp4/tests/mpf/t-fits.c create mode 100644 gmp4/tests/mpf/t-get_d.c create mode 100644 gmp4/tests/mpf/t-get_d_2exp.c create mode 100644 gmp4/tests/mpf/t-get_si.c create mode 100644 gmp4/tests/mpf/t-get_ui.c create mode 100644 gmp4/tests/mpf/t-gsprec.c create mode 100644 gmp4/tests/mpf/t-inp_str.c create mode 100644 gmp4/tests/mpf/t-int_p.c create mode 100644 gmp4/tests/mpf/t-mul_ui.c create mode 100644 gmp4/tests/mpf/t-muldiv.c create mode 100644 gmp4/tests/mpf/t-set.c create mode 100644 gmp4/tests/mpf/t-set_q.c create mode 100644 gmp4/tests/mpf/t-set_si.c create mode 100644 gmp4/tests/mpf/t-set_ui.c create mode 100644 gmp4/tests/mpf/t-sqrt.c create mode 100644 gmp4/tests/mpf/t-sqrt_ui.c create mode 100644 gmp4/tests/mpf/t-sub.c create mode 100644 gmp4/tests/mpf/t-trunc.c create mode 100644 gmp4/tests/mpf/t-ui_div.c create mode 100644 gmp4/tests/mpn/Makefile.am create mode 100644 gmp4/tests/mpn/Makefile.in create mode 100644 gmp4/tests/mpn/logic.c create mode 100644 gmp4/tests/mpn/t-aors_1.c create mode 100644 gmp4/tests/mpn/t-asmtype.c create mode 100644 gmp4/tests/mpn/t-bdiv.c create mode 100644 gmp4/tests/mpn/t-broot.c create mode 100644 gmp4/tests/mpn/t-brootinv.c create mode 100644 gmp4/tests/mpn/t-div.c create mode 100644 gmp4/tests/mpn/t-divrem_1.c create mode 100644 gmp4/tests/mpn/t-fat.c create mode 100644 gmp4/tests/mpn/t-get_d.c create mode 100644 gmp4/tests/mpn/t-hgcd.c create mode 100644 gmp4/tests/mpn/t-hgcd_appr.c create mode 100644 gmp4/tests/mpn/t-instrument.c create mode 100644 gmp4/tests/mpn/t-invert.c create mode 100644 gmp4/tests/mpn/t-iord_u.c create mode 100644 gmp4/tests/mpn/t-matrix22.c create mode 100644 gmp4/tests/mpn/t-minvert.c create mode 100644 gmp4/tests/mpn/t-mod_1.c create mode 100644 gmp4/tests/mpn/t-mp_bases.c create mode 100644 gmp4/tests/mpn/t-mul.c create mode 100644 gmp4/tests/mpn/t-mullo.c create mode 100644 gmp4/tests/mpn/t-mulmid.c create mode 100644 gmp4/tests/mpn/t-mulmod_bnm1.c create mode 100644 gmp4/tests/mpn/t-perfsqr.c create mode 100644 gmp4/tests/mpn/t-scan.c create mode 100644 gmp4/tests/mpn/t-sizeinbase.c create mode 100644 gmp4/tests/mpn/t-sqrmod_bnm1.c create mode 100644 gmp4/tests/mpn/t-toom2-sqr.c create mode 100644 gmp4/tests/mpn/t-toom22.c create mode 100644 gmp4/tests/mpn/t-toom3-sqr.c create mode 100644 gmp4/tests/mpn/t-toom32.c create mode 100644 gmp4/tests/mpn/t-toom33.c create mode 100644 gmp4/tests/mpn/t-toom4-sqr.c create mode 100644 gmp4/tests/mpn/t-toom42.c create mode 100644 gmp4/tests/mpn/t-toom43.c create mode 100644 gmp4/tests/mpn/t-toom44.c create mode 100644 gmp4/tests/mpn/t-toom52.c create mode 100644 gmp4/tests/mpn/t-toom53.c create mode 100644 gmp4/tests/mpn/t-toom54.c create mode 100644 gmp4/tests/mpn/t-toom6-sqr.c create mode 100644 gmp4/tests/mpn/t-toom62.c create mode 100644 gmp4/tests/mpn/t-toom63.c create mode 100644 gmp4/tests/mpn/t-toom6h.c create mode 100644 gmp4/tests/mpn/t-toom8-sqr.c create mode 100644 gmp4/tests/mpn/t-toom8h.c create mode 100644 gmp4/tests/mpn/toom-shared.h create mode 100644 gmp4/tests/mpn/toom-sqr-shared.h create mode 100644 gmp4/tests/mpq/Makefile.am create mode 100644 gmp4/tests/mpq/Makefile.in create mode 100644 gmp4/tests/mpq/io.c create mode 100644 gmp4/tests/mpq/reuse.c create mode 100644 gmp4/tests/mpq/t-aors.c create mode 100644 gmp4/tests/mpq/t-cmp.c create mode 100644 gmp4/tests/mpq/t-cmp_si.c create mode 100644 gmp4/tests/mpq/t-cmp_ui.c create mode 100644 gmp4/tests/mpq/t-equal.c create mode 100644 gmp4/tests/mpq/t-get_d.c create mode 100644 gmp4/tests/mpq/t-get_str.c create mode 100644 gmp4/tests/mpq/t-inp_str.c create mode 100644 gmp4/tests/mpq/t-inv.c create mode 100644 gmp4/tests/mpq/t-md_2exp.c create mode 100644 gmp4/tests/mpq/t-set_f.c create mode 100644 gmp4/tests/mpq/t-set_str.c create mode 100644 gmp4/tests/mpz/Makefile.am create mode 100644 gmp4/tests/mpz/Makefile.in create mode 100644 gmp4/tests/mpz/bit.c create mode 100644 gmp4/tests/mpz/convert.c create mode 100644 gmp4/tests/mpz/dive.c create mode 100644 gmp4/tests/mpz/dive_ui.c create mode 100644 gmp4/tests/mpz/io.c create mode 100644 gmp4/tests/mpz/logic.c create mode 100644 gmp4/tests/mpz/reuse.c create mode 100644 gmp4/tests/mpz/t-addsub.c create mode 100644 gmp4/tests/mpz/t-aorsmul.c create mode 100644 gmp4/tests/mpz/t-bin.c create mode 100644 gmp4/tests/mpz/t-cdiv_ui.c create mode 100644 gmp4/tests/mpz/t-cmp.c create mode 100644 gmp4/tests/mpz/t-cmp_d.c create mode 100644 gmp4/tests/mpz/t-cmp_si.c create mode 100644 gmp4/tests/mpz/t-cong.c create mode 100644 gmp4/tests/mpz/t-cong_2exp.c create mode 100644 gmp4/tests/mpz/t-div_2exp.c create mode 100644 gmp4/tests/mpz/t-divis.c create mode 100644 gmp4/tests/mpz/t-divis_2exp.c create mode 100644 gmp4/tests/mpz/t-export.c create mode 100644 gmp4/tests/mpz/t-fac_ui.c create mode 100644 gmp4/tests/mpz/t-fdiv.c create mode 100644 gmp4/tests/mpz/t-fdiv_ui.c create mode 100644 gmp4/tests/mpz/t-fib_ui.c create mode 100644 gmp4/tests/mpz/t-fits.c create mode 100644 gmp4/tests/mpz/t-gcd.c create mode 100644 gmp4/tests/mpz/t-gcd_ui.c create mode 100644 gmp4/tests/mpz/t-get_d.c create mode 100644 gmp4/tests/mpz/t-get_d_2exp.c create mode 100644 gmp4/tests/mpz/t-get_si.c create mode 100644 gmp4/tests/mpz/t-hamdist.c create mode 100644 gmp4/tests/mpz/t-import.c create mode 100644 gmp4/tests/mpz/t-inp_str.c create mode 100644 gmp4/tests/mpz/t-invert.c create mode 100644 gmp4/tests/mpz/t-io_raw.c create mode 100644 gmp4/tests/mpz/t-jac.c create mode 100644 gmp4/tests/mpz/t-lcm.c create mode 100644 gmp4/tests/mpz/t-limbs.c create mode 100644 gmp4/tests/mpz/t-lucnum_ui.c create mode 100644 gmp4/tests/mpz/t-mfac_uiui.c create mode 100644 gmp4/tests/mpz/t-mul.c create mode 100644 gmp4/tests/mpz/t-mul_i.c create mode 100644 gmp4/tests/mpz/t-nextprime.c create mode 100644 gmp4/tests/mpz/t-oddeven.c create mode 100644 gmp4/tests/mpz/t-perfpow.c create mode 100644 gmp4/tests/mpz/t-perfsqr.c create mode 100644 gmp4/tests/mpz/t-popcount.c create mode 100644 gmp4/tests/mpz/t-pow.c create mode 100644 gmp4/tests/mpz/t-powm.c create mode 100644 gmp4/tests/mpz/t-powm_ui.c create mode 100644 gmp4/tests/mpz/t-pprime_p.c create mode 100644 gmp4/tests/mpz/t-primorial_ui.c create mode 100644 gmp4/tests/mpz/t-remove.c create mode 100644 gmp4/tests/mpz/t-root.c create mode 100644 gmp4/tests/mpz/t-scan.c create mode 100644 gmp4/tests/mpz/t-set_d.c create mode 100644 gmp4/tests/mpz/t-set_f.c create mode 100644 gmp4/tests/mpz/t-set_si.c create mode 100644 gmp4/tests/mpz/t-set_str.c create mode 100644 gmp4/tests/mpz/t-sizeinbase.c create mode 100644 gmp4/tests/mpz/t-sqrtrem.c create mode 100644 gmp4/tests/mpz/t-tdiv.c create mode 100644 gmp4/tests/mpz/t-tdiv_ui.c create mode 100644 gmp4/tests/rand/Makefile.am create mode 100644 gmp4/tests/rand/Makefile.in create mode 100644 gmp4/tests/rand/findlc.c create mode 100644 gmp4/tests/rand/gen.c create mode 100644 gmp4/tests/rand/gmpstat.h create mode 100644 gmp4/tests/rand/spect.c create mode 100644 gmp4/tests/rand/stat.c create mode 100644 gmp4/tests/rand/statlib.c create mode 100644 gmp4/tests/rand/t-iset.c create mode 100644 gmp4/tests/rand/t-lc2exp.c create mode 100644 gmp4/tests/rand/t-mt.c create mode 100644 gmp4/tests/rand/t-rand.c create mode 100644 gmp4/tests/rand/t-urbui.c create mode 100644 gmp4/tests/rand/t-urmui.c create mode 100644 gmp4/tests/rand/t-urndmm.c create mode 100644 gmp4/tests/rand/zdiv_round.c create mode 100644 gmp4/tests/refmpf.c create mode 100644 gmp4/tests/refmpn.c create mode 100644 gmp4/tests/refmpq.c create mode 100644 gmp4/tests/refmpz.c create mode 100644 gmp4/tests/spinner.c create mode 100644 gmp4/tests/t-bswap.c create mode 100644 gmp4/tests/t-constants.c create mode 100644 gmp4/tests/t-count_zeros.c create mode 100644 gmp4/tests/t-gmpmax.c create mode 100644 gmp4/tests/t-hightomask.c create mode 100644 gmp4/tests/t-modlinv.c create mode 100644 gmp4/tests/t-parity.c create mode 100644 gmp4/tests/t-popc.c create mode 100644 gmp4/tests/t-sub.c create mode 100644 gmp4/tests/tests.h create mode 100644 gmp4/tests/trace.c create mode 100644 gmp4/tests/x86call.asm create mode 100644 gmp4/tests/x86check.c create mode 100644 gmp4/tune/Makefile.am create mode 100644 gmp4/tune/Makefile.in create mode 100644 gmp4/tune/README create mode 100644 gmp4/tune/alpha.asm create mode 100644 gmp4/tune/common.c create mode 100644 gmp4/tune/div_qr_1_tune.c create mode 100644 gmp4/tune/div_qr_1n_pi1_1.c create mode 100644 gmp4/tune/div_qr_1n_pi1_2.c create mode 100644 gmp4/tune/divrem1div.c create mode 100644 gmp4/tune/divrem1inv.c create mode 100644 gmp4/tune/divrem2div.c create mode 100644 gmp4/tune/divrem2inv.c create mode 100644 gmp4/tune/freq.c create mode 100644 gmp4/tune/gcdext_double.c create mode 100644 gmp4/tune/gcdext_single.c create mode 100644 gmp4/tune/gcdextod.c create mode 100644 gmp4/tune/gcdextos.c create mode 100644 gmp4/tune/hgcd_appr_lehmer.c create mode 100644 gmp4/tune/hgcd_lehmer.c create mode 100644 gmp4/tune/hgcd_reduce_1.c create mode 100644 gmp4/tune/hgcd_reduce_2.c create mode 100644 gmp4/tune/hppa.asm create mode 100644 gmp4/tune/hppa2.asm create mode 100644 gmp4/tune/hppa2w.asm create mode 100644 gmp4/tune/ia64.asm create mode 100644 gmp4/tune/jacbase1.c create mode 100644 gmp4/tune/jacbase2.c create mode 100644 gmp4/tune/jacbase3.c create mode 100644 gmp4/tune/jacbase4.c create mode 100644 gmp4/tune/many.pl create mode 100644 gmp4/tune/mod_1_1-1.c create mode 100644 gmp4/tune/mod_1_1-2.c create mode 100644 gmp4/tune/mod_1_div.c create mode 100644 gmp4/tune/mod_1_inv.c create mode 100644 gmp4/tune/modlinv.c create mode 100644 gmp4/tune/noop.c create mode 100644 gmp4/tune/pentium.asm create mode 100644 gmp4/tune/powerpc.asm create mode 100644 gmp4/tune/powerpc64.asm create mode 100644 gmp4/tune/powm_mod.c create mode 100644 gmp4/tune/powm_redc.c create mode 100644 gmp4/tune/pre_divrem_1.c create mode 100644 gmp4/tune/set_strb.c create mode 100644 gmp4/tune/set_strp.c create mode 100644 gmp4/tune/set_strs.c create mode 100644 gmp4/tune/sparcv9.asm create mode 100644 gmp4/tune/speed-ext.c create mode 100644 gmp4/tune/speed.c create mode 100644 gmp4/tune/speed.h create mode 100644 gmp4/tune/time.c create mode 100644 gmp4/tune/tune-gcd-p.c create mode 100644 gmp4/tune/tuneup.c create mode 100644 gmp4/tune/x86_64.asm create mode 100644 gmp4/version.c create mode 100755 gmp4/ylwrap create mode 100644 go/makefile create mode 100644 h/.gitignore create mode 100755 h/386-bsd.defs create mode 100755 h/386-bsd.h create mode 100755 h/386-gnu.h create mode 100644 h/386-kfreebsd.defs create mode 100644 h/386-kfreebsd.h create mode 100755 h/386-linux.h create mode 100644 h/386-macosx.defs create mode 100644 h/386-macosx.h create mode 100755 h/386.h create mode 100755 h/FreeBSD.defs create mode 100755 h/FreeBSD.h create mode 100755 h/NeXT.defs create mode 100755 h/NeXT.h create mode 100755 h/NeXT30-m68k.defs create mode 100755 h/NeXT30-m68k.h create mode 100755 h/NeXT32-i386.defs create mode 100755 h/NeXT32-i386.h create mode 100755 h/NeXT32-m68k.defs create mode 100755 h/NeXT32-m68k.h create mode 100755 h/NetBSD.defs create mode 100755 h/NetBSD.h create mode 100755 h/OpenBSD.defs create mode 100755 h/OpenBSD.h create mode 100644 h/aarch64-linux.h create mode 100755 h/alpha-linux.h create mode 100755 h/alpha-osf1.defs create mode 100755 h/alpha-osf1.h create mode 100644 h/amd64-kfreebsd.h create mode 100644 h/amd64-linux.h create mode 100644 h/apply_n.h create mode 100755 h/arith.h create mode 100755 h/arm-linux.h create mode 100644 h/armhf-linux.h create mode 100644 h/arth.h create mode 100755 h/att.h create mode 100755 h/att3b2.h create mode 100755 h/att_ext.h create mode 100755 h/bds.h create mode 100644 h/bits.h create mode 100755 h/bsd.h create mode 100755 h/cmpincl1.h create mode 100755 h/cmplrs/stsupport.h create mode 100755 h/cmponly.h create mode 100755 h/coff/i386.h create mode 100755 h/coff_encap.h create mode 100755 h/compat.h create mode 100755 h/compbas.h create mode 100755 h/compbas2.h create mode 100644 h/compdefs.h create mode 100644 h/compprotos.h create mode 100755 h/convex.h create mode 100755 h/cyglacks.h create mode 100755 h/dec3100.defs create mode 100755 h/dec3100.h create mode 100755 h/defun.h create mode 100755 h/dos-go32.defs create mode 100755 h/dos-go32.h create mode 100755 h/e15.h create mode 100644 h/elf32_arm_reloc.h create mode 100644 h/elf32_arm_reloc_special.h create mode 100644 h/elf32_armhf_reloc.h create mode 100644 h/elf32_armhf_reloc_special.h create mode 100644 h/elf32_hppa_reloc.h create mode 100644 h/elf32_hppa_reloc_special.h create mode 100644 h/elf32_i386_reloc.h create mode 100644 h/elf32_m68k_reloc.h create mode 100644 h/elf32_mips_reloc.h create mode 100644 h/elf32_mips_reloc_special.h create mode 100644 h/elf32_ppc_reloc.h create mode 100644 h/elf32_s390_reloc.h create mode 100644 h/elf32_sh4_reloc.h create mode 100644 h/elf32_sparc_reloc.h create mode 100644 h/elf64_aarch64_reloc.h create mode 100644 h/elf64_aarch64_reloc_special.h create mode 100644 h/elf64_alpha_reloc.h create mode 100644 h/elf64_alpha_reloc_special.h create mode 100644 h/elf64_i386_reloc.h create mode 100644 h/elf64_mips_reloc.h create mode 100644 h/elf64_mips_reloc_special.h create mode 100644 h/elf64_ppc_reloc.h create mode 100644 h/elf64_ppc_reloc_special.h create mode 100644 h/elf64_ppcle_reloc.h create mode 100644 h/elf64_ppcle_reloc_special.h create mode 100644 h/elf64_riscv64_reloc.h create mode 100644 h/elf64_s390_reloc.h create mode 100644 h/elf64_sparc_reloc.h create mode 100644 h/elf64_sparc_reloc_special.h create mode 100755 h/enum.h create mode 100755 h/erreurs.h create mode 100644 h/error.h create mode 100755 h/eval.h create mode 100755 h/ext_sym.h create mode 100644 h/fixnum.h create mode 100755 h/frame.h create mode 100755 h/funlink.h create mode 100644 h/gclincl.h.in create mode 100755 h/gencom.h create mode 100755 h/genpari.h create mode 100755 h/genport.h create mode 100755 h/getpagesize.h create mode 100644 h/globals.h create mode 100644 h/gmp_wrappers.h create mode 100755 h/gnuwin95.defs create mode 100755 h/gnuwin95.h create mode 100755 h/hp300-bsd.defs create mode 100755 h/hp300-bsd.h create mode 100755 h/hp300.defs create mode 100755 h/hp300.h create mode 100755 h/hp800.defs create mode 100755 h/hp800.h create mode 100755 h/hppa-linux.h create mode 100755 h/ia64-linux.h create mode 100644 h/immnum.h create mode 100755 h/include.h create mode 100755 h/irix5.defs create mode 100755 h/irix5.h create mode 100755 h/irix6.defs create mode 100755 h/irix6.h create mode 100644 h/ld_bind_now.h create mode 100755 h/lex.h create mode 100644 h/linux.defs create mode 100644 h/linux.h create mode 100644 h/lu.h create mode 100755 h/m68k-linux.h create mode 100755 h/mac2.defs create mode 100755 h/mac2.h create mode 100644 h/mach32_i386_reloc.h create mode 100644 h/mach32_ppc_reloc.h create mode 100644 h/mach64_i386_reloc.h create mode 100755 h/make-decl.h create mode 100755 h/make-init.h create mode 100755 h/mc68k.h create mode 100755 h/mdefs.h create mode 100644 h/mgmp.h create mode 100644 h/minglacks.h create mode 100755 h/mingw.defs create mode 100755 h/mingw.h create mode 100755 h/mips-linux.h create mode 100755 h/mips.h create mode 100755 h/mipsel-linux.h create mode 100755 h/mp.h create mode 100755 h/mp386.defs create mode 100755 h/mp386.h create mode 100755 h/ncr.defs create mode 100755 h/ncr.h create mode 100755 h/news.h create mode 100755 h/notcomp.h create mode 100755 h/num_include.h create mode 100755 h/object.h create mode 100755 h/options.h create mode 100755 h/page.h create mode 100644 h/pageinfo.h create mode 100644 h/pbits.h create mode 100644 h/pool.h create mode 100644 h/powerpc-linux.h create mode 100644 h/powerpc-macosx.defs create mode 100644 h/powerpc-macosx.h create mode 100644 h/prelink.h create mode 100644 h/protoize.h create mode 100755 h/ptable.h create mode 100755 h/rgbc.h create mode 100755 h/rios-aix3.defs create mode 100755 h/rios-aix3.h create mode 100755 h/rios.defs create mode 100755 h/rios.h create mode 100644 h/riscv64-linux.h create mode 100755 h/rt_aix.defs create mode 100755 h/rt_aix.h create mode 100755 h/s3000.h create mode 100755 h/s390-linux.h create mode 100755 h/secondary_sun_magic create mode 100755 h/sfun_argd.h create mode 100755 h/sgi.defs create mode 100755 h/sgi.h create mode 100755 h/sgi4d.defs create mode 100755 h/sgi4d.h create mode 100755 h/sh4-linux.h create mode 100755 h/solaris-i386.defs create mode 100755 h/solaris-i386.h create mode 100755 h/solaris.defs create mode 100755 h/solaris.h create mode 100755 h/sparc-linux.h create mode 100755 h/sparc.h create mode 100755 h/stacks.h create mode 100755 h/sun.h create mode 100755 h/sun2r3.defs create mode 100755 h/sun2r3.h create mode 100755 h/sun3-os4.defs create mode 100755 h/sun3-os4.h create mode 100755 h/sun3.defs create mode 100755 h/sun3.h create mode 100755 h/sun386i.defs create mode 100755 h/sun386i.h create mode 100755 h/sun4.defs create mode 100755 h/sun4.h create mode 100755 h/symbol.h create mode 100755 h/symmetry.defs create mode 100755 h/symmetry.h create mode 100644 h/tsgc.h create mode 100755 h/twelve_null create mode 100644 h/type.h create mode 100755 h/u370_aix.defs create mode 100755 h/u370_aix.h create mode 100644 h/unrandomize.h create mode 100755 h/usig.h create mode 100755 h/vax.defs create mode 100755 h/vax.h create mode 100755 h/vs.h create mode 100755 h/wincoff.h create mode 100644 h/writable.h create mode 100644 info/.gitignore create mode 100755 info/bind.texi create mode 100755 info/c-interface.texi create mode 100644 info/chap-1.texi create mode 100644 info/chap-10.texi create mode 100644 info/chap-11.texi create mode 100644 info/chap-12.texi create mode 100644 info/chap-13.texi create mode 100644 info/chap-14.texi create mode 100644 info/chap-15.texi create mode 100644 info/chap-16.texi create mode 100644 info/chap-17.texi create mode 100644 info/chap-18.texi create mode 100644 info/chap-19.texi create mode 100644 info/chap-2.texi create mode 100644 info/chap-20.texi create mode 100644 info/chap-21.texi create mode 100644 info/chap-22.texi create mode 100644 info/chap-23.texi create mode 100644 info/chap-24.texi create mode 100644 info/chap-25.texi create mode 100644 info/chap-26.texi create mode 100644 info/chap-3.texi create mode 100644 info/chap-4.texi create mode 100644 info/chap-5.texi create mode 100644 info/chap-6.texi create mode 100644 info/chap-7.texi create mode 100644 info/chap-8.texi create mode 100644 info/chap-9.texi create mode 100644 info/chap-a.texi create mode 100755 info/character.texi create mode 100755 info/compile.texi create mode 100755 info/compiler-defs.texi create mode 100755 info/control.texi create mode 100755 info/debug.texi create mode 100755 info/doc.texi create mode 100755 info/form.texi create mode 100755 info/gcl-si-index.texi create mode 100644 info/gcl-si.info create mode 100644 info/gcl-si.pdf create mode 100755 info/gcl-si.texi create mode 100644 info/gcl-si/Available-Symbols.html create mode 100644 info/gcl-si/Bignums.html create mode 100644 info/gcl-si/C-Interface.html create mode 100644 info/gcl-si/Characters.html create mode 100644 info/gcl-si/Command-Line.html create mode 100644 info/gcl-si/Compilation.html create mode 100644 info/gcl-si/Compiler-Definitions.html create mode 100644 info/gcl-si/Debugging.html create mode 100644 info/gcl-si/Doc.html create mode 100644 info/gcl-si/Environment.html create mode 100644 info/gcl-si/Function-and-Variable-Index.html create mode 100644 info/gcl-si/GCL-Specific.html create mode 100644 info/gcl-si/Inititialization.html create mode 100644 info/gcl-si/Iteration-and-Tests.html create mode 100644 info/gcl-si/Lists.html create mode 100644 info/gcl-si/Low-Level-Debug-Functions.html create mode 100644 info/gcl-si/Low-Level-X-Interface.html create mode 100644 info/gcl-si/Miscellaneous.html create mode 100644 info/gcl-si/Numbers.html create mode 100644 info/gcl-si/Operating-System-Definitions.html create mode 100644 info/gcl-si/Operating-System.html create mode 100644 info/gcl-si/Regular-Expressions.html create mode 100644 info/gcl-si/Sequences-and-Arrays-and-Hash-Tables.html create mode 100644 info/gcl-si/Source-Level-Debugging-in-Emacs.html create mode 100644 info/gcl-si/Special-Forms-and-Functions.html create mode 100644 info/gcl-si/Streams-and-Reading.html create mode 100644 info/gcl-si/Structures.html create mode 100644 info/gcl-si/Symbols.html create mode 100644 info/gcl-si/System-Definitions.html create mode 100644 info/gcl-si/Type.html create mode 100644 info/gcl-si/User-Interface.html create mode 100644 info/gcl-si/index.html create mode 100644 info/gcl-tk.info create mode 100644 info/gcl-tk.info-1 create mode 100644 info/gcl-tk.info-2 create mode 100644 info/gcl-tk.pdf create mode 100755 info/gcl-tk.texi create mode 100644 info/gcl-tk/Argument-Lists.html create mode 100644 info/gcl-tk/Common-Features-of-Widgets.html create mode 100644 info/gcl-tk/Control.html create mode 100644 info/gcl-tk/General.html create mode 100644 info/gcl-tk/Getting-Started.html create mode 100644 info/gcl-tk/Introduction.html create mode 100644 info/gcl-tk/Linked-Variables.html create mode 100644 info/gcl-tk/Lisp-Functions-Invoked-from-Graphics.html create mode 100644 info/gcl-tk/Return-Values.html create mode 100644 info/gcl-tk/Widgets.html create mode 100644 info/gcl-tk/after.html create mode 100644 info/gcl-tk/bind.html create mode 100644 info/gcl-tk/button.html create mode 100644 info/gcl-tk/canvas.html create mode 100644 info/gcl-tk/checkbutton.html create mode 100644 info/gcl-tk/destroy.html create mode 100644 info/gcl-tk/entry.html create mode 100644 info/gcl-tk/exit.html create mode 100644 info/gcl-tk/focus.html create mode 100644 info/gcl-tk/frame.html create mode 100644 info/gcl-tk/grab.html create mode 100644 info/gcl-tk/index.html create mode 100644 info/gcl-tk/label.html create mode 100644 info/gcl-tk/listbox.html create mode 100644 info/gcl-tk/lower.html create mode 100644 info/gcl-tk/menu.html create mode 100644 info/gcl-tk/menubutton.html create mode 100644 info/gcl-tk/message.html create mode 100644 info/gcl-tk/option.html create mode 100644 info/gcl-tk/options.html create mode 100644 info/gcl-tk/pack.html create mode 100644 info/gcl-tk/pack_002dold.html create mode 100644 info/gcl-tk/place.html create mode 100644 info/gcl-tk/radiobutton.html create mode 100644 info/gcl-tk/raise.html create mode 100644 info/gcl-tk/scale.html create mode 100644 info/gcl-tk/scrollbar.html create mode 100644 info/gcl-tk/selection.html create mode 100644 info/gcl-tk/send.html create mode 100644 info/gcl-tk/text.html create mode 100644 info/gcl-tk/tk.html create mode 100644 info/gcl-tk/tk_002ddialog.html create mode 100644 info/gcl-tk/tk_002dlistbox_002dsingle_002dselect.html create mode 100644 info/gcl-tk/tk_002dmenu_002dbar.html create mode 100644 info/gcl-tk/tkconnect.html create mode 100644 info/gcl-tk/tkerror.html create mode 100644 info/gcl-tk/tkvars.html create mode 100644 info/gcl-tk/tkwait.html create mode 100644 info/gcl-tk/toplevel.html create mode 100644 info/gcl-tk/update.html create mode 100644 info/gcl-tk/winfo.html create mode 100644 info/gcl-tk/wm.html create mode 100644 info/gcl.info create mode 100644 info/gcl.info-1 create mode 100644 info/gcl.info-2 create mode 100644 info/gcl.info-3 create mode 100644 info/gcl.info-4 create mode 100644 info/gcl.info-5 create mode 100644 info/gcl.info-6 create mode 100644 info/gcl.info-7 create mode 100644 info/gcl.info-8 create mode 100644 info/gcl.info-9 create mode 100644 info/gcl.pdf create mode 100644 info/gcl.texi create mode 100644 info/gcl.texi.diff create mode 100644 info/gcl/1_002b.html create mode 100644 info/gcl/A-specifier-for-a-rest-parameter.html create mode 100644 info/gcl/APPLY-Forms-as-Places.html create mode 100644 info/gcl/Abstract-Classifications-of-Streams-_0028Introduction-to-Streams_0029.html create mode 100644 info/gcl/Abstract-Classifications-of-Streams.html create mode 100644 info/gcl/Accessibility-of-Symbols-in-a-Package.html create mode 100644 info/gcl/Accessing-Slots.html create mode 100644 info/gcl/Additional-Constraints-on-Externalizable-Objects.html create mode 100644 info/gcl/Additional-FORMAT-Parameters.html create mode 100644 info/gcl/Additional-Information-about-FORMAT-Operations.html create mode 100644 info/gcl/Additional-Information-about-Parsing-Logical-Pathname-Namestrings.html create mode 100644 info/gcl/Additional-Uses-for-Indirect-Definitions-in-Modified-BNF-Syntax.html create mode 100644 info/gcl/Agreement-on-Parameter-Specializers-and-Qualifiers.html create mode 100644 info/gcl/Alphabetic-Characters.html create mode 100644 info/gcl/Alphanumeric-Characters.html create mode 100644 info/gcl/Appendix.html create mode 100644 info/gcl/Applying-method-combination-to-the-sorted-list-of-applicable-methods.html create mode 100644 info/gcl/Argument-Conventions-of-Some-Reader-Functions.html create mode 100644 info/gcl/Argument-Mismatch-Detection.html create mode 100644 info/gcl/Array-Concepts.html create mode 100644 info/gcl/Array-Dimensions.html create mode 100644 info/gcl/Array-Elements.html create mode 100644 info/gcl/Array-Indices.html create mode 100644 info/gcl/Array-Rank.html create mode 100644 info/gcl/Array-Upgrading.html create mode 100644 info/gcl/Arrays-Dictionary.html create mode 100644 info/gcl/Arrays.html create mode 100644 info/gcl/Assertions.html create mode 100644 info/gcl/Associating-a-Restart-with-a-Condition.html create mode 100644 info/gcl/Associativity-and-Commutativity-in-Numeric-Operations.html create mode 100644 info/gcl/Backquote.html create mode 100644 info/gcl/Boa-Lambda-Lists.html create mode 100644 info/gcl/Built_002din-Method-Combination-Types.html create mode 100644 info/gcl/Byte-Operations-on-Integers.html create mode 100644 info/gcl/Capitalization-and-Punctuation-in-Condition-Reports.html create mode 100644 info/gcl/Case-in-Pathname-Components.html create mode 100644 info/gcl/Case-in-Symbols.html create mode 100644 info/gcl/Case-of-Implementation_002dDefined-Characters.html create mode 100644 info/gcl/Changing-the-Class-of-an-Instance.html create mode 100644 info/gcl/Character-Attributes.html create mode 100644 info/gcl/Character-Categories.html create mode 100644 info/gcl/Character-Concepts.html create mode 100644 info/gcl/Character-Encodings.html create mode 100644 info/gcl/Character-Names.html create mode 100644 info/gcl/Character-Repertoires.html create mode 100644 info/gcl/Character-Scripts.html create mode 100644 info/gcl/Character-Syntax-Types.html create mode 100644 info/gcl/Character-Syntax.html create mode 100644 info/gcl/Characters-Dictionary.html create mode 100644 info/gcl/Characters-With-Case.html create mode 100644 info/gcl/Characters.html create mode 100644 info/gcl/Classes.html create mode 100644 info/gcl/Closures-and-Lexical-Binding.html create mode 100644 info/gcl/Coercion-of-Streams-to-Pathnames.html create mode 100644 info/gcl/Comma.html create mode 100644 info/gcl/Common-Case-in-Pathname-Components.html create mode 100644 info/gcl/Compilation-Semantics.html create mode 100644 info/gcl/Compilation.html create mode 100644 info/gcl/Compiler-Macros.html create mode 100644 info/gcl/Compiler-Terminology.html create mode 100644 info/gcl/Compiling-Format-Strings.html create mode 100644 info/gcl/Complex-Computations.html create mode 100644 info/gcl/Condition-Designators.html create mode 100644 info/gcl/Condition-System-Concepts.html create mode 100644 info/gcl/Condition-Types.html create mode 100644 info/gcl/Conditional-Execution-Clauses.html create mode 100644 info/gcl/Conditions-Dictionary.html create mode 100644 info/gcl/Conditions.html create mode 100644 info/gcl/Conformance-Statement.html create mode 100644 info/gcl/Conformance.html create mode 100644 info/gcl/Conforming-Implementations.html create mode 100644 info/gcl/Conforming-Programs.html create mode 100644 info/gcl/Congruent-Lambda_002dlists-for-all-Methods-of-a-Generic-Function.html create mode 100644 info/gcl/Cons-Concepts.html create mode 100644 info/gcl/Conses-Dictionary.html create mode 100644 info/gcl/Conses-as-Forms.html create mode 100644 info/gcl/Conses-as-Lists.html create mode 100644 info/gcl/Conses-as-Trees.html create mode 100644 info/gcl/Conses.html create mode 100644 info/gcl/Constant-Variables.html create mode 100644 info/gcl/Constituent-Characters.html create mode 100644 info/gcl/Constituent-Traits.html create mode 100644 info/gcl/Constraints-on-Macros-and-Compiler-Macros.html create mode 100644 info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Implementations.html create mode 100644 info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html create mode 100644 info/gcl/Constructing-Numbers-from-Tokens.html create mode 100644 info/gcl/Contagion-in-Numeric-Operations.html create mode 100644 info/gcl/Control-Transfer-Clauses.html create mode 100644 info/gcl/Corresponding-Characters-in-the-Other-Case.html create mode 100644 info/gcl/Creating-Conditions.html create mode 100644 info/gcl/Creating-Instances-of-Classes.html create mode 100644 info/gcl/Customizing-Class-Redefinition.html create mode 100644 info/gcl/Customizing-Reinitialization.html create mode 100644 info/gcl/Customizing-the-Change-of-Class-of-an-Instance.html create mode 100644 info/gcl/Data-Type-Definition.html create mode 100644 info/gcl/Data-and-Control-Flow-Dictionary.html create mode 100644 info/gcl/Data-and-Control-Flow.html create mode 100644 info/gcl/Data_002ddirected-Destructuring-by-Lambda-Lists.html create mode 100644 info/gcl/Debugging-Utilities.html create mode 100644 info/gcl/Declaration-Identifiers.html create mode 100644 info/gcl/Declaration-Scope.html create mode 100644 info/gcl/Declaration-Specifiers.html create mode 100644 info/gcl/Declarations.html create mode 100644 info/gcl/Declarative-Method-Combination.html create mode 100644 info/gcl/Declaring-the-Validity-of-Initialization-Arguments.html create mode 100644 info/gcl/Decoded-Time.html create mode 100644 info/gcl/Default-Print_002dObject-Methods.html create mode 100644 info/gcl/Defaulting-of-Initialization-Arguments.html create mode 100644 info/gcl/Define_002dmethod_002dcombination-Arguments-Lambda-Lists.html create mode 100644 info/gcl/Define_002dmodify_002dmacro-Lambda-Lists.html create mode 100644 info/gcl/Defining-Classes.html create mode 100644 info/gcl/Definition-of-Similarity.html create mode 100644 info/gcl/Definitions-of-Make_002dInstance-and-Initialize_002dInstance.html create mode 100644 info/gcl/Definitions.html create mode 100644 info/gcl/Defsetf-Lambda-Lists.html create mode 100644 info/gcl/Deftype-Lambda-Lists.html create mode 100644 info/gcl/Deprecated-Argument-Conventions.html create mode 100644 info/gcl/Deprecated-Functions.html create mode 100644 info/gcl/Deprecated-Language-Features.html create mode 100644 info/gcl/Deprecated-Reader-Syntax.html create mode 100644 info/gcl/Deprecated-Variables.html create mode 100644 info/gcl/Designators.html create mode 100644 info/gcl/Destructive-Operations.html create mode 100644 info/gcl/Destructuring-Lambda-Lists.html create mode 100644 info/gcl/Destructuring-Mismatch.html create mode 100644 info/gcl/Destructuring-by-Lambda-Lists.html create mode 100644 info/gcl/Destructuring.html create mode 100644 info/gcl/Determining-the-Class-Precedence-List.html create mode 100644 info/gcl/Determining-the-Effective-Method.html create mode 100644 info/gcl/Dictionary-Entries-for-Type-Specifiers.html create mode 100644 info/gcl/Digits-in-a-Radix.html create mode 100644 info/gcl/Directory-Components-in-Non_002dHierarchical-File-Systems.html create mode 100644 info/gcl/Documentation-of-Extensions.html create mode 100644 info/gcl/Documentation-of-Implementation_002dDefined-Scripts.html create mode 100644 info/gcl/Documentation-of-Implementation_002dDependent-Features.html create mode 100644 info/gcl/Double_002dQuote.html create mode 100644 info/gcl/Dynamic-Control-of-the-Arrangement-of-Output.html create mode 100644 info/gcl/Dynamic-Control-of-the-Lisp-Reader.html create mode 100644 info/gcl/Dynamic-Environments.html create mode 100644 info/gcl/Dynamic-Variables.html create mode 100644 info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Printer.html create mode 100644 info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Reader.html create mode 100644 info/gcl/Embedded-Newlines-in-Condition-Reports.html create mode 100644 info/gcl/Environment-Dictionary.html create mode 100644 info/gcl/Environment-Inquiry.html create mode 100644 info/gcl/Environment-Objects.html create mode 100644 info/gcl/Environment.html create mode 100644 info/gcl/Error-Checking-in-Function-Calls.html create mode 100644 info/gcl/Error-Detection-Time-in-Safe-Calls.html create mode 100644 info/gcl/Error-Terminology.html create mode 100644 info/gcl/Errors-When-Calling-a-Next-Method.html create mode 100644 info/gcl/Escape-Characters-and-Potential-Numbers.html create mode 100644 info/gcl/Evaluation-and-Compilation-Dictionary.html create mode 100644 info/gcl/Evaluation-and-Compilation.html create mode 100644 info/gcl/Evaluation-of-Subforms-to-Places.html create mode 100644 info/gcl/Evaluation.html create mode 100644 info/gcl/Examples-of-ALWAYS.html create mode 100644 info/gcl/Examples-of-APPEND-and-NCONC-clauses.html create mode 100644 info/gcl/Examples-of-Associativity-and-Commutativity-in-Numeric-Operations.html create mode 100644 info/gcl/Examples-of-COLLECT-clause.html create mode 100644 info/gcl/Examples-of-COUNT-clause.html create mode 100644 info/gcl/Examples-of-Class-Precedence-List-Determination.html create mode 100644 info/gcl/Examples-of-Data_002ddirected-Destructuring-by-Lambda-Lists.html create mode 100644 info/gcl/Examples-of-Declaration-Scope.html create mode 100644 info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Printer.html create mode 100644 info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Reader.html create mode 100644 info/gcl/Examples-of-Evaluation-of-Subforms-to-Places.html create mode 100644 info/gcl/Examples-of-FORMAT.html create mode 100644 info/gcl/Examples-of-Feature-Expressions.html create mode 100644 info/gcl/Examples-of-Inheritance.html create mode 100644 info/gcl/Examples-of-Keyword-Arguments-in-Generic-Functions-and-Methods.html create mode 100644 info/gcl/Examples-of-MAXIMIZE-and-MINIMIZE-clauses.html create mode 100644 info/gcl/Examples-of-Merging-Pathnames.html create mode 100644 info/gcl/Examples-of-Miscellaneous-Loop-Features.html create mode 100644 info/gcl/Examples-of-Multiple-Escape-Characters.html create mode 100644 info/gcl/Examples-of-NAMED-clause.html create mode 100644 info/gcl/Examples-of-Ordinary-Lambda-Lists.html create mode 100644 info/gcl/Examples-of-Potential-Numbers.html create mode 100644 info/gcl/Examples-of-Printer-Behavior.html create mode 100644 info/gcl/Examples-of-Printing-Arrays.html create mode 100644 info/gcl/Examples-of-REPEAT-clause.html create mode 100644 info/gcl/Examples-of-Resolution-of-Apparent-Conflict-in-Exceptional-Situations.html create mode 100644 info/gcl/Examples-of-Rule-of-Canonical-Representation-for-Complex-Rationals.html create mode 100644 info/gcl/Examples-of-Rule-of-Float-and-Rational-Contagion.html create mode 100644 info/gcl/Examples-of-SUM-clause.html create mode 100644 info/gcl/Examples-of-Satisfying-a-One_002dArgument-Test.html create mode 100644 info/gcl/Examples-of-Satisfying-a-Two_002dArgument-Test.html create mode 100644 info/gcl/Examples-of-Self_002dEvaluating-Objects.html create mode 100644 info/gcl/Examples-of-Semicolon.html create mode 100644 info/gcl/Examples-of-Setf-Expansions.html create mode 100644 info/gcl/Examples-of-Sharpsign-Asterisk.html create mode 100644 info/gcl/Examples-of-Sharpsign-Vertical_002dBar.html create mode 100644 info/gcl/Examples-of-Single-Escape-Characters.html create mode 100644 info/gcl/Examples-of-Single_002dQuote.html create mode 100644 info/gcl/Examples-of-Style-for-Semicolon.html create mode 100644 info/gcl/Examples-of-Suppressing-Keyword-Argument-Checking.html create mode 100644 info/gcl/Examples-of-Transfer-of-Control-during-a-Destructive-Operation.html create mode 100644 info/gcl/Examples-of-Truenames.html create mode 100644 info/gcl/Examples-of-WHEN-clause.html create mode 100644 info/gcl/Examples-of-WHILE-and-UNTIL-clauses.html create mode 100644 info/gcl/Examples-of-WITH-clause.html create mode 100644 info/gcl/Examples-of-Whitespace-Characters.html create mode 100644 info/gcl/Examples-of-clause-grouping.html create mode 100644 info/gcl/Examples-of-for_002das_002dacross-subclause.html create mode 100644 info/gcl/Examples-of-for_002das_002darithmetic-subclause.html create mode 100644 info/gcl/Examples-of-for_002das_002dequals_002dthen-subclause.html create mode 100644 info/gcl/Examples-of-for_002das_002din_002dlist-subclause.html create mode 100644 info/gcl/Examples-of-for_002das_002don_002dlist-subclause.html create mode 100644 info/gcl/Examples-of-for_002das_002dpackage-subclause.html create mode 100644 info/gcl/Examples-of-unconditional-execution.html create mode 100644 info/gcl/Examples-of-using-the-Pretty-Printer.html create mode 100644 info/gcl/Exceptional-Situations-in-the-Compiler.html create mode 100644 info/gcl/Expanding-Loop-Forms.html create mode 100644 info/gcl/Extended-Loop.html create mode 100644 info/gcl/Extensions-to-Similarity-Rules.html create mode 100644 info/gcl/Extent.html create mode 100644 info/gcl/Externalizable-Objects.html create mode 100644 info/gcl/FORMAT-Basic-Output.html create mode 100644 info/gcl/FORMAT-Control_002dFlow-Operations.html create mode 100644 info/gcl/FORMAT-Floating_002dPoint-Printers.html create mode 100644 info/gcl/FORMAT-Layout-Control.html create mode 100644 info/gcl/FORMAT-Miscellaneous-Operations.html create mode 100644 info/gcl/FORMAT-Miscellaneous-Pseudo_002dOperations.html create mode 100644 info/gcl/FORMAT-Pretty-Printer-Operations.html create mode 100644 info/gcl/FORMAT-Printer-Operations.html create mode 100644 info/gcl/FORMAT-Radix-Control.html create mode 100644 info/gcl/Feature-Expressions.html create mode 100644 info/gcl/Features.html create mode 100644 info/gcl/File-Compilation.html create mode 100644 info/gcl/File-Operations-on-Open-and-Closed-Streams.html create mode 100644 info/gcl/File-Streams.html create mode 100644 info/gcl/File-System-Concepts.html create mode 100644 info/gcl/Filenames-Dictionary.html create mode 100644 info/gcl/Filenames.html create mode 100644 info/gcl/Files-Dictionary.html create mode 100644 info/gcl/Files.html create mode 100644 info/gcl/Fill-Pointers.html create mode 100644 info/gcl/Floating_002dpoint-Computations.html create mode 100644 info/gcl/Font-Key.html create mode 100644 info/gcl/Form-Evaluation.html create mode 100644 info/gcl/Format-Directive-Interface.html create mode 100644 info/gcl/Formatted-Output.html create mode 100644 info/gcl/Function-Call-Forms-as-Places.html create mode 100644 info/gcl/Function-Forms.html create mode 100644 info/gcl/General-Restrictions-on-Parameters-that-must-be-Lists.html create mode 100644 info/gcl/General-Restrictions-on-Parameters-that-must-be-Sequences.html create mode 100644 info/gcl/General-Restrictions-on-Parameters-that-must-be-Trees.html create mode 100644 info/gcl/Generalized-Reference.html create mode 100644 info/gcl/Generic-Function-Lambda-Lists.html create mode 100644 info/gcl/Generic-Functions-and-Methods.html create mode 100644 info/gcl/Glossary-_0028Glossary_0029.html create mode 100644 info/gcl/Glossary.html create mode 100644 info/gcl/Graphic-Characters.html create mode 100644 info/gcl/Hash-Table-Concepts.html create mode 100644 info/gcl/Hash-Tables-Dictionary.html create mode 100644 info/gcl/Hash-Tables.html create mode 100644 info/gcl/Hash_002dTable-Operations.html create mode 100644 info/gcl/History.html create mode 100644 info/gcl/Identity-of-Characters.html create mode 100644 info/gcl/Implementation-Limits-on-Array-Rank.html create mode 100644 info/gcl/Implementation-Limits-on-Individual-Array-Dimensions.html create mode 100644 info/gcl/Implementation_002dDefined-Packages.html create mode 100644 info/gcl/Implementation_002dDependent-Numeric-Constants.html create mode 100644 info/gcl/Implications-of-Strings-Being-Arrays.html create mode 100644 info/gcl/Indirection-in-Modified-BNF-Syntax.html create mode 100644 info/gcl/Inheritance-of-Class-Options.html create mode 100644 info/gcl/Inheritance-of-Methods.html create mode 100644 info/gcl/Inheritance-of-Slots-and-Slot-Options.html create mode 100644 info/gcl/Inheritance.html create mode 100644 info/gcl/Initial-and-Final-Execution.html create mode 100644 info/gcl/Initialization-Arguments.html create mode 100644 info/gcl/Initialize_002dInstance.html create mode 100644 info/gcl/Initializing-Newly-Added-Local-Slots-_0028Changing-the-Class-of-an-Instance_0029.html create mode 100644 info/gcl/Initializing-Newly-Added-Local-Slots-_0028Redefining-Classes_0029.html create mode 100644 info/gcl/Input.html create mode 100644 info/gcl/Integrating-Types-and-Classes.html create mode 100644 info/gcl/Interactive-Streams.html create mode 100644 info/gcl/Interactive-Use-of-Restarts.html create mode 100644 info/gcl/Interfaces-to-Restarts.html create mode 100644 info/gcl/Internal-Time.html create mode 100644 info/gcl/Internal-and-External-Symbols.html create mode 100644 info/gcl/Interning-a-Symbol-in-the-KEYWORD-Package.html create mode 100644 info/gcl/Interpretation-of-Tokens.html create mode 100644 info/gcl/Interpreting-Dictionary-Entries.html create mode 100644 info/gcl/Interpreting-Pathname-Component-Values.html create mode 100644 info/gcl/Interval-Designators.html create mode 100644 info/gcl/Introduction-_0028Introduction_0029.html create mode 100644 info/gcl/Introduction-_0028Types-and-Classes_0029.html create mode 100644 info/gcl/Introduction-to-Characters.html create mode 100644 info/gcl/Introduction-to-Classes.html create mode 100644 info/gcl/Introduction-to-Environments.html create mode 100644 info/gcl/Introduction-to-Generic-Functions.html create mode 100644 info/gcl/Introduction-to-Methods.html create mode 100644 info/gcl/Introduction-to-Packages.html create mode 100644 info/gcl/Introduction-to-Scripts-and-Repertoires.html create mode 100644 info/gcl/Introduction-to-Slots.html create mode 100644 info/gcl/Introduction-to-Streams.html create mode 100644 info/gcl/Invalid-Characters.html create mode 100644 info/gcl/Invalid-Keyword-Arguments.html create mode 100644 info/gcl/Iteration-Control.html create mode 100644 info/gcl/Iteration-Dictionary.html create mode 100644 info/gcl/Iteration.html create mode 100644 info/gcl/Keyword-Arguments-in-Generic-Functions-and-Methods.html create mode 100644 info/gcl/Kinds-of-Places.html create mode 100644 info/gcl/Lambda-Expressions.html create mode 100644 info/gcl/Lambda-Forms.html create mode 100644 info/gcl/Lambda-Lists.html create mode 100644 info/gcl/Lambda_002dlist_002ddirected-Destructuring-by-Lambda-Lists.html create mode 100644 info/gcl/Language-Extensions.html create mode 100644 info/gcl/Language-Subsets.html create mode 100644 info/gcl/Leading-and-Trailing-Newlines-in-Condition-Reports.html create mode 100644 info/gcl/Left_002dParenthesis.html create mode 100644 info/gcl/Lexical-Environments.html create mode 100644 info/gcl/Lexical-Variables.html create mode 100644 info/gcl/Lists-as-Association-Lists.html create mode 100644 info/gcl/Lists-as-Sets.html create mode 100644 info/gcl/Literal-Objects-in-Compiled-Files.html create mode 100644 info/gcl/Loading.html create mode 100644 info/gcl/Local-Case-in-Pathname-Components.html create mode 100644 info/gcl/Local-Variable-Initializations.html create mode 100644 info/gcl/Locating-a-Symbol-in-a-Package.html create mode 100644 info/gcl/Logical-Operations-on-Integers.html create mode 100644 info/gcl/Logical-Pathname-Components.html create mode 100644 info/gcl/Logical-Pathnames.html create mode 100644 info/gcl/Loop-Keywords.html create mode 100644 info/gcl/Lowercase-Characters.html create mode 100644 info/gcl/Lowercase-Letters-in-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/Macro-Characters.html create mode 100644 info/gcl/Macro-Forms-as-Places.html create mode 100644 info/gcl/Macro-Forms.html create mode 100644 info/gcl/Macro-Lambda-Lists.html create mode 100644 info/gcl/Mentioning-Containing-Function-in-Condition-Reports.html create mode 100644 info/gcl/Merging-Pathnames.html create mode 100644 info/gcl/Meta_002dObjects.html create mode 100644 info/gcl/Method-Selection-and-Combination.html create mode 100644 info/gcl/Minimal-Compilation.html create mode 100644 info/gcl/Minimal-Declaration-Processing-Requirements.html create mode 100644 info/gcl/Miscellaneous-Clauses.html create mode 100644 info/gcl/Missing-and-Additional-FORMAT-Arguments.html create mode 100644 info/gcl/Modification-of-Literal-Objects.html create mode 100644 info/gcl/Modified-BNF-Syntax.html create mode 100644 info/gcl/Modifying-Hash-Table-Keys.html create mode 100644 info/gcl/Modifying-the-Structure-of-Instances.html create mode 100644 info/gcl/Modifying-the-Structure-of-the-Instance.html create mode 100644 info/gcl/Multidimensional-Arrays.html create mode 100644 info/gcl/Multiple-Escape-Characters.html create mode 100644 info/gcl/Multiple-Possible-Textual-Representations.html create mode 100644 info/gcl/NIL-as-a-Component-Value.html create mode 100644 info/gcl/NIL.html create mode 100644 info/gcl/Namestrings-as-Filenames.html create mode 100644 info/gcl/Naming-Conventions-for-Rest-Parameters.html create mode 100644 info/gcl/Naming-of-Compiler-Macros.html create mode 100644 info/gcl/Nesting-of-FORMAT-Operations.html create mode 100644 info/gcl/No-Arguments-or-Values-in-The-_0022Syntax_0022-Section.html create mode 100644 info/gcl/Nonsense-Words.html create mode 100644 info/gcl/Notational-Conventions.html create mode 100644 info/gcl/Note-about-Printing-Numbers.html create mode 100644 info/gcl/Note-about-Tabs-in-Condition-Reports.html create mode 100644 info/gcl/Notes-about-Backquote.html create mode 100644 info/gcl/Notes-about-FORMAT.html create mode 100644 info/gcl/Notes-about-Loop.html create mode 100644 info/gcl/Notes-about-Style-for-Semicolon.html create mode 100644 info/gcl/Notes-about-Style-for-Sharpsign-Vertical_002dBar.html create mode 100644 info/gcl/Notes-about-The-KEYWORD-Package.html create mode 100644 info/gcl/Notes-about-the-Condition-System_0060s-Background.html create mode 100644 info/gcl/Notes-about-the-Implementation-of-Compiler-Macros.html create mode 100644 info/gcl/Notes-about-the-Pathname-Version-Component.html create mode 100644 info/gcl/Notes-about-the-Pretty-Printer_0060s-Background.html create mode 100644 info/gcl/Null-Strings-as-Components-of-a-Logical-Pathname.html create mode 100644 info/gcl/Number-Concepts.html create mode 100644 info/gcl/Numbers-Dictionary.html create mode 100644 info/gcl/Numbers-_0028Numbers_0029.html create mode 100644 info/gcl/Numbers-_0028Objects-with-Multiple-Notations_0029.html create mode 100644 info/gcl/Numbers-as-Tokens.html create mode 100644 info/gcl/Numeric-Characters.html create mode 100644 info/gcl/Numeric-Operations.html create mode 100644 info/gcl/Object-Creation-and-Initialization.html create mode 100644 info/gcl/Objects-Dictionary.html create mode 100644 info/gcl/Objects-with-Multiple-Notations.html create mode 100644 info/gcl/Objects.html create mode 100644 info/gcl/Odd-Number-of-Keyword-Arguments.html create mode 100644 info/gcl/Open-and-Closed-Streams.html create mode 100644 info/gcl/Order-of-Execution.html create mode 100644 info/gcl/Ordering-of-Characters.html create mode 100644 info/gcl/Ordinary-Lambda-Lists.html create mode 100644 info/gcl/Organization-of-the-Document.html create mode 100644 info/gcl/Other-Compound-Forms-as-Places.html create mode 100644 info/gcl/Other-Subclasses-of-Stream.html create mode 100644 info/gcl/Other-Syntax-in-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/Overview-of-Filenames.html create mode 100644 info/gcl/Overview-of-Places-and-Generalized-Reference.html create mode 100644 info/gcl/Overview-of-The-Lisp-Printer.html create mode 100644 info/gcl/Overview-of-the-Loop-Facility.html create mode 100644 info/gcl/Package-Concepts.html create mode 100644 info/gcl/Package-Inheritance.html create mode 100644 info/gcl/Package-Names-and-Nicknames.html create mode 100644 info/gcl/Package-Prefixes-for-Symbols.html create mode 100644 info/gcl/Package-System-Consistency-Rules.html create mode 100644 info/gcl/Packages-Dictionary.html create mode 100644 info/gcl/Packages-No-Longer-Required.html create mode 100644 info/gcl/Packages.html create mode 100644 info/gcl/Parsing-Loop-Clauses.html create mode 100644 info/gcl/Parsing-Namestrings-Into-Pathnames.html create mode 100644 info/gcl/Pathname-Components.html create mode 100644 info/gcl/Pathnames-as-Filenames.html create mode 100644 info/gcl/Pathnames.html create mode 100644 info/gcl/Potential-Numbers-as-Tokens.html create mode 100644 info/gcl/Pretty-Print-Dispatch-Tables.html create mode 100644 info/gcl/Pretty-Printer-Concepts.html create mode 100644 info/gcl/Pretty-Printer-Margins.html create mode 100644 info/gcl/Prevention-of-Name-Conflicts-in-Packages.html create mode 100644 info/gcl/Principal-Values-and-Branch-Cuts.html create mode 100644 info/gcl/Printer-Dictionary.html create mode 100644 info/gcl/Printer-Dispatching.html create mode 100644 info/gcl/Printer-Escaping.html create mode 100644 info/gcl/Printer.html create mode 100644 info/gcl/Printing-Bit-Vectors.html create mode 100644 info/gcl/Printing-Characters.html create mode 100644 info/gcl/Printing-Complexes.html create mode 100644 info/gcl/Printing-Conditions.html create mode 100644 info/gcl/Printing-Floats.html create mode 100644 info/gcl/Printing-Integers.html create mode 100644 info/gcl/Printing-Lists-and-Conses.html create mode 100644 info/gcl/Printing-Numbers.html create mode 100644 info/gcl/Printing-Other-Arrays.html create mode 100644 info/gcl/Printing-Other-Objects.html create mode 100644 info/gcl/Printing-Other-Vectors.html create mode 100644 info/gcl/Printing-Pathnames.html create mode 100644 info/gcl/Printing-Random-States.html create mode 100644 info/gcl/Printing-Ratios.html create mode 100644 info/gcl/Printing-Strings.html create mode 100644 info/gcl/Printing-Structures.html create mode 100644 info/gcl/Printing-Symbols.html create mode 100644 info/gcl/Processing-of-Defining-Macros.html create mode 100644 info/gcl/Processing-of-Top-Level-Forms.html create mode 100644 info/gcl/Purpose-of-Compiler-Macros.html create mode 100644 info/gcl/Random_002dState-Operations.html create mode 100644 info/gcl/Rational-Computations.html create mode 100644 info/gcl/Re_002dReading-Abbreviated-Expressions.html create mode 100644 info/gcl/Reader-Algorithm.html create mode 100644 info/gcl/Reader-Concepts.html create mode 100644 info/gcl/Reader-Dictionary.html create mode 100644 info/gcl/Reader.html create mode 100644 info/gcl/Readtables.html create mode 100644 info/gcl/Recommended-Style-in-Condition-Reporting.html create mode 100644 info/gcl/Redefining-Classes.html create mode 100644 info/gcl/Referenced-Publications.html create mode 100644 info/gcl/Reinitializing-an-Instance.html create mode 100644 info/gcl/Relation-between-component-values-NIL-and-_002d_003eUNSPECIFIC.html create mode 100644 info/gcl/Removed-Argument-Conventions.html create mode 100644 info/gcl/Removed-Language-Features.html create mode 100644 info/gcl/Removed-Operators.html create mode 100644 info/gcl/Removed-Reader-Syntax.html create mode 100644 info/gcl/Removed-Types.html create mode 100644 info/gcl/Removed-Variables.html create mode 100644 info/gcl/Required-Kinds-of-Specialized-Arrays.html create mode 100644 info/gcl/Required-Language-Features.html create mode 100644 info/gcl/Requirements-for-removed-and-deprecated-features.html create mode 100644 info/gcl/Requiring-Non_002dNull-Rest-Parameters-in-The-_0022Syntax_0022-Section.html create mode 100644 info/gcl/Resignaling-a-Condition.html create mode 100644 info/gcl/Resolution-of-Apparent-Conflicts-in-Exceptional-Situations.html create mode 100644 info/gcl/Restart-Tests.html create mode 100644 info/gcl/Restarts.html create mode 100644 info/gcl/Restrictions-on-Composite-Streams.html create mode 100644 info/gcl/Restrictions-on-Constructing-Pathnames.html create mode 100644 info/gcl/Restrictions-on-Examining-Pathname-Components.html create mode 100644 info/gcl/Restrictions-on-Examining-a-Pathname-Device-Component.html create mode 100644 info/gcl/Restrictions-on-Examining-a-Pathname-Directory-Component.html create mode 100644 info/gcl/Restrictions-on-Examining-a-Pathname-Host-Component.html create mode 100644 info/gcl/Restrictions-on-Examining-a-Pathname-Name-Component.html create mode 100644 info/gcl/Restrictions-on-Examining-a-Pathname-Type-Component.html create mode 100644 info/gcl/Restrictions-on-Examining-a-Pathname-Version-Component.html create mode 100644 info/gcl/Restrictions-on-Side_002dEffects.html create mode 100644 info/gcl/Restrictions-on-Wildcard-Pathnames.html create mode 100644 info/gcl/Return-Values.html create mode 100644 info/gcl/Return-values-in-The-_0022Syntax_0022-Section.html create mode 100644 info/gcl/Right_002dParenthesis.html create mode 100644 info/gcl/Rule-of-Canonical-Representation-for-Complex-Rationals.html create mode 100644 info/gcl/Rule-of-Canonical-Representation-for-Rationals.html create mode 100644 info/gcl/Rule-of-Complex-Contagion.html create mode 100644 info/gcl/Rule-of-Complex-Substitutability.html create mode 100644 info/gcl/Rule-of-Float-Approximation.html create mode 100644 info/gcl/Rule-of-Float-Precision-Contagion.html create mode 100644 info/gcl/Rule-of-Float-Substitutability.html create mode 100644 info/gcl/Rule-of-Float-Underflow-and-Overflow.html create mode 100644 info/gcl/Rule-of-Float-and-Rational-Contagion.html create mode 100644 info/gcl/Rule-of-Unbounded-Rational-Precision.html create mode 100644 info/gcl/Rules-about-Test-Functions.html create mode 100644 info/gcl/Rules-for-Initialization-Arguments.html create mode 100644 info/gcl/Safe-and-Unsafe-Calls.html create mode 100644 info/gcl/Satisfying-a-One_002dArgument-Test.html create mode 100644 info/gcl/Satisfying-a-Two_002dArgument-Test.html create mode 100644 info/gcl/Scope-and-Purpose.html create mode 100644 info/gcl/Scope.html create mode 100644 info/gcl/Seconds.html create mode 100644 info/gcl/Sections-Not-Formally-Part-Of-This-Standard.html create mode 100644 info/gcl/Selecting-the-Applicable-Methods.html create mode 100644 info/gcl/Self_002dEvaluating-Objects.html create mode 100644 info/gcl/Semantic-Constraints.html create mode 100644 info/gcl/Semicolon.html create mode 100644 info/gcl/Sequence-Concepts.html create mode 100644 info/gcl/Sequences-Dictionary.html create mode 100644 info/gcl/Sequences.html create mode 100644 info/gcl/Serious-Conditions.html create mode 100644 info/gcl/Setf-Expansions-and-Places.html create mode 100644 info/gcl/Setf-Expansions.html create mode 100644 info/gcl/Shadowing.html create mode 100644 info/gcl/Shared_002dInitialize.html create mode 100644 info/gcl/Sharpsign-A.html create mode 100644 info/gcl/Sharpsign-Asterisk.html create mode 100644 info/gcl/Sharpsign-B.html create mode 100644 info/gcl/Sharpsign-Backslash.html create mode 100644 info/gcl/Sharpsign-C.html create mode 100644 info/gcl/Sharpsign-Colon.html create mode 100644 info/gcl/Sharpsign-Dot.html create mode 100644 info/gcl/Sharpsign-Equal_002dSign.html create mode 100644 info/gcl/Sharpsign-Left_002dParenthesis.html create mode 100644 info/gcl/Sharpsign-Less_002dThan_002dSign.html create mode 100644 info/gcl/Sharpsign-Minus.html create mode 100644 info/gcl/Sharpsign-O.html create mode 100644 info/gcl/Sharpsign-P.html create mode 100644 info/gcl/Sharpsign-Plus.html create mode 100644 info/gcl/Sharpsign-R.html create mode 100644 info/gcl/Sharpsign-Right_002dParenthesis.html create mode 100644 info/gcl/Sharpsign-S.html create mode 100644 info/gcl/Sharpsign-Sharpsign.html create mode 100644 info/gcl/Sharpsign-Single_002dQuote.html create mode 100644 info/gcl/Sharpsign-Vertical_002dBar.html create mode 100644 info/gcl/Sharpsign-Whitespace.html create mode 100644 info/gcl/Sharpsign-X.html create mode 100644 info/gcl/Sharpsign.html create mode 100644 info/gcl/Shorthand-notation-for-Type-Declarations.html create mode 100644 info/gcl/Signaling-and-Handling-Conditions.html create mode 100644 info/gcl/Signaling.html create mode 100644 info/gcl/Similarity-of-Aggregate-Objects.html create mode 100644 info/gcl/Similarity-of-Literal-Objects.html create mode 100644 info/gcl/Simple-Loop.html create mode 100644 info/gcl/Simple-vs-Extended-Loop.html create mode 100644 info/gcl/Single-Escape-Character.html create mode 100644 info/gcl/Single_002dQuote.html create mode 100644 info/gcl/Slots.html create mode 100644 info/gcl/Some-Exceptions-to-Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html create mode 100644 info/gcl/Sorting-the-Applicable-Methods-by-Precedence-Order.html create mode 100644 info/gcl/Special-Characters-in-Pathname-Components.html create mode 100644 info/gcl/Special-Forms.html create mode 100644 info/gcl/Special-Pathname-Component-Values.html create mode 100644 info/gcl/Special-Symbols.html create mode 100644 info/gcl/Special-_0022Syntax_0022-Notations-for-Overloaded-Operators.html create mode 100644 info/gcl/Specialized-Arrays.html create mode 100644 info/gcl/Specialized-Lambda-Lists.html create mode 100644 info/gcl/Specifiers-for-_0026aux-variables.html create mode 100644 info/gcl/Specifiers-for-keyword-parameters.html create mode 100644 info/gcl/Specifiers-for-optional-parameters.html create mode 100644 info/gcl/Specifiers-for-the-required-parameters.html create mode 100644 info/gcl/Splicing-in-Modified-BNF-Syntax.html create mode 100644 info/gcl/Standard-Characters.html create mode 100644 info/gcl/Standard-Macro-Characters.html create mode 100644 info/gcl/Standard-Meta_002dobjects.html create mode 100644 info/gcl/Standard-Metaclasses.html create mode 100644 info/gcl/Standard-Method-Combination.html create mode 100644 info/gcl/Standardized-Packages.html create mode 100644 info/gcl/Storage-Layout-for-Multidimensional-Arrays.html create mode 100644 info/gcl/Stream-Arguments-to-Standardized-Functions.html create mode 100644 info/gcl/Stream-Concepts.html create mode 100644 info/gcl/Stream-Variables.html create mode 100644 info/gcl/Streams-Dictionary.html create mode 100644 info/gcl/Streams.html create mode 100644 info/gcl/String-Concepts.html create mode 100644 info/gcl/Strings-Dictionary.html create mode 100644 info/gcl/Strings-in-Component-Values.html create mode 100644 info/gcl/Strings.html create mode 100644 info/gcl/Structures-Dictionary.html create mode 100644 info/gcl/Structures.html create mode 100644 info/gcl/Subtypes-of-STRING.html create mode 100644 info/gcl/Summary-of-Conditional-Execution-Clauses.html create mode 100644 info/gcl/Summary-of-Loop-Clauses.html create mode 100644 info/gcl/Summary-of-Miscellaneous-Clauses.html create mode 100644 info/gcl/Summary-of-Termination-Test-Clauses.html create mode 100644 info/gcl/Summary-of-Unconditional-Execution-Clauses.html create mode 100644 info/gcl/Summary-of-Value-Accumulation-Clauses.html create mode 100644 info/gcl/Summary-of-Variable-Initialization-and-Stepping-Clauses.html create mode 100644 info/gcl/Suppressing-Keyword-Argument-Checking.html create mode 100644 info/gcl/Symbol-Concepts.html create mode 100644 info/gcl/Symbol-Macros-as-Places.html create mode 100644 info/gcl/Symbols-Dictionary.html create mode 100644 info/gcl/Symbols-Naming-Both-Lexical-and-Dynamic-Variables.html create mode 100644 info/gcl/Symbols-as-Forms.html create mode 100644 info/gcl/Symbols-as-Tokens.html create mode 100644 info/gcl/Symbols-in-a-Package.html create mode 100644 info/gcl/Symbols-in-the-COMMON_002dLISP-Package.html create mode 100644 info/gcl/Symbols.html create mode 100644 info/gcl/Syntactic-Interaction-of-Documentation-Strings-and-Declarations.html create mode 100644 info/gcl/Syntax-of-Logical-Pathname-Namestrings.html create mode 100644 info/gcl/Syntax-of-a-Complex.html create mode 100644 info/gcl/Syntax-of-a-Float.html create mode 100644 info/gcl/Syntax-of-a-Ratio.html create mode 100644 info/gcl/Syntax-of-a-Rational.html create mode 100644 info/gcl/Syntax-of-an-Integer.html create mode 100644 info/gcl/Syntax.html create mode 100644 info/gcl/System-Construction-Concepts.html create mode 100644 info/gcl/System-Construction-Dictionary.html create mode 100644 info/gcl/System-Construction.html create mode 100644 info/gcl/THE-Forms-as-Places.html create mode 100644 info/gcl/Termination-Test-Clauses.html create mode 100644 info/gcl/The-COMMON_002dLISP-Package.html create mode 100644 info/gcl/The-COMMON_002dLISP_002dUSER-Package.html create mode 100644 info/gcl/The-Consing-Dot.html create mode 100644 info/gcl/The-Current-Readtable.html create mode 100644 info/gcl/The-Device-part-of-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/The-Directory-part-of-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/The-EOF_002dERROR_002dP-argument.html create mode 100644 info/gcl/The-Evaluation-Model.html create mode 100644 info/gcl/The-External-Environment.html create mode 100644 info/gcl/The-Global-Environment.html create mode 100644 info/gcl/The-Host-part-of-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/The-Initial-Readtable.html create mode 100644 info/gcl/The-KEYWORD-Package.html create mode 100644 info/gcl/The-LOOP-Facility.html create mode 100644 info/gcl/The-Lisp-Pretty-Printer.html create mode 100644 info/gcl/The-Lisp-Printer.html create mode 100644 info/gcl/The-Null-Lexical-Environment.html create mode 100644 info/gcl/The-Pathname-Device-Component.html create mode 100644 info/gcl/The-Pathname-Directory-Component.html create mode 100644 info/gcl/The-Pathname-Host-Component.html create mode 100644 info/gcl/The-Pathname-Name-Component.html create mode 100644 info/gcl/The-Pathname-Type-Component.html create mode 100644 info/gcl/The-Pathname-Version-Component.html create mode 100644 info/gcl/The-RECURSIVE_002dP-argument.html create mode 100644 info/gcl/The-Standard-Readtable.html create mode 100644 info/gcl/The-Type-part-of-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/The-Version-part-of-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/The-_0022Affected-By_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Argument-Precedence-Order_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Arguments-and-Values_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Arguments_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Binding-Types-Affected_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Class-Precedence-List_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Compound-Type-Specifier-Arguments_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Compound-Type-Specifier-Description_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Compound-Type-Specifier-Kind_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Compound-Type-Specifier-Syntax_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Constant-Value_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Description_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Examples_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Exceptional-Situations_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Initial-Value_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Method-Signature_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Name_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Notes_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Pronunciation_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022See-Also_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Side-Effects_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Supertypes_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Syntax_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Valid-Context_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-_0022Value-Type_0022-Section-of-a-Dictionary-Entry.html create mode 100644 info/gcl/The-for_002das_002dacross-subclause.html create mode 100644 info/gcl/The-for_002das_002darithmetic-subclause.html create mode 100644 info/gcl/The-for_002das_002dequals_002dthen-subclause.html create mode 100644 info/gcl/The-for_002das_002dhash-subclause.html create mode 100644 info/gcl/The-for_002das_002din_002dlist-subclause.html create mode 100644 info/gcl/The-for_002das_002don_002dlist-subclause.html create mode 100644 info/gcl/The-for_002das_002dpackage-subclause.html create mode 100644 info/gcl/Tilde-A_002d_003e-Aesthetic.html create mode 100644 info/gcl/Tilde-Ampersand_002d_003e-Fresh_002dLine.html create mode 100644 info/gcl/Tilde-Asterisk_002d_003e-Go_002dTo.html create mode 100644 info/gcl/Tilde-B_002d_003e-Binary.html create mode 100644 info/gcl/Tilde-C_002d_003e-Character.html create mode 100644 info/gcl/Tilde-Circumflex_002d_003e-Escape-Upward.html create mode 100644 info/gcl/Tilde-D_002d_003e-Decimal.html create mode 100644 info/gcl/Tilde-Dollarsign_002d_003e-Monetary-Floating_002dPoint.html create mode 100644 info/gcl/Tilde-E_002d_003e-Exponential-Floating_002dPoint.html create mode 100644 info/gcl/Tilde-F_002d_003e-Fixed_002dFormat-Floating_002dPoint.html create mode 100644 info/gcl/Tilde-G_002d_003e-General-Floating_002dPoint.html create mode 100644 info/gcl/Tilde-Greater_002dThan_002dSign_002d_003e-End-of-Justification.html create mode 100644 info/gcl/Tilde-I_002d_003e-Indent.html create mode 100644 info/gcl/Tilde-Left_002dBrace_002d_003e-Iteration.html create mode 100644 info/gcl/Tilde-Left_002dBracket_002d_003e-Conditional-Expression.html create mode 100644 info/gcl/Tilde-Left_002dParen_002d_003e-Case-Conversion.html create mode 100644 info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Justification.html create mode 100644 info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Logical-Block.html create mode 100644 info/gcl/Tilde-Newline_002d_003e-Ignored-Newline.html create mode 100644 info/gcl/Tilde-O_002d_003e-Octal.html create mode 100644 info/gcl/Tilde-P_002d_003e-Plural.html create mode 100644 info/gcl/Tilde-Percent_002d_003e-Newline.html create mode 100644 info/gcl/Tilde-Question_002dMark_002d_003e-Recursive-Processing.html create mode 100644 info/gcl/Tilde-R_002d_003e-Radix.html create mode 100644 info/gcl/Tilde-Right_002dBrace_002d_003e-End-of-Iteration.html create mode 100644 info/gcl/Tilde-Right_002dBracket_002d_003e-End-of-Conditional-Expression.html create mode 100644 info/gcl/Tilde-Right_002dParen_002d_003e-End-of-Case-Conversion.html create mode 100644 info/gcl/Tilde-S_002d_003e-Standard.html create mode 100644 info/gcl/Tilde-Semicolon_002d_003e-Clause-Separator.html create mode 100644 info/gcl/Tilde-Slash_002d_003e-Call-Function.html create mode 100644 info/gcl/Tilde-T_002d_003e-Tabulate.html create mode 100644 info/gcl/Tilde-Tilde_002d_003e-Tilde.html create mode 100644 info/gcl/Tilde-Underscore_002d_003e-Conditional-Newline.html create mode 100644 info/gcl/Tilde-Vertical_002dBar_002d_003e-Page.html create mode 100644 info/gcl/Tilde-W_002d_003e-Write.html create mode 100644 info/gcl/Tilde-X_002d_003e-Hexadecimal.html create mode 100644 info/gcl/Time.html create mode 100644 info/gcl/Too-Few-Arguments.html create mode 100644 info/gcl/Too-Many-Arguments.html create mode 100644 info/gcl/Top-level-loop.html create mode 100644 info/gcl/Topological-Sorting.html create mode 100644 info/gcl/Transfer-of-Control-during-a-Destructive-Operation.html create mode 100644 info/gcl/Transfer-of-Control-to-an-Exit-Point.html create mode 100644 info/gcl/Traversal-Rules-and-Side-Effects.html create mode 100644 info/gcl/Treatment-of-Exceptional-Situations.html create mode 100644 info/gcl/Treatment-of-Newline-during-Input-and-Output.html create mode 100644 info/gcl/Treatment-of-Other-Macros-Based-on-SETF.html create mode 100644 info/gcl/Truenames.html create mode 100644 info/gcl/Type-Relationships.html create mode 100644 info/gcl/Type-Specifiers.html create mode 100644 info/gcl/Types-and-Classes-Dictionary.html create mode 100644 info/gcl/Types-and-Classes.html create mode 100644 info/gcl/Types.html create mode 100644 info/gcl/Unconditional-Execution-Clauses.html create mode 100644 info/gcl/Unconditional-Transfer-of-Control-in-The-_0022Syntax_0022-Section.html create mode 100644 info/gcl/Undefined-FORMAT-Modifier-Combinations.html create mode 100644 info/gcl/Universal-Time.html create mode 100644 info/gcl/Unrecognized-Keyword-Arguments.html create mode 100644 info/gcl/Unspecific-Components-of-a-Logical-Pathname.html create mode 100644 info/gcl/Uppercase-Characters.html create mode 100644 info/gcl/Use-of-Double-Semicolon.html create mode 100644 info/gcl/Use-of-Implementation_002dDefined-Language-Features.html create mode 100644 info/gcl/Use-of-Quadruple-Semicolon.html create mode 100644 info/gcl/Use-of-Read_002dTime-Conditionals.html create mode 100644 info/gcl/Use-of-Single-Semicolon.html create mode 100644 info/gcl/Use-of-Triple-Semicolon.html create mode 100644 info/gcl/Use-of-the-Dot-Character.html create mode 100644 info/gcl/VALUES-Forms-as-Places.html create mode 100644 info/gcl/Valid-Patterns-for-Tokens.html create mode 100644 info/gcl/Value-Accumulation-Clauses.html create mode 100644 info/gcl/Variable-Initialization-and-Stepping-Clauses.html create mode 100644 info/gcl/Variable-Names-as-Places.html create mode 100644 info/gcl/Variables-that-affect-the-Lisp-Reader.html create mode 100644 info/gcl/Vectors.html create mode 100644 info/gcl/Viewing-Integers-as-Bits-and-Bytes.html create mode 100644 info/gcl/Visible-Modification-of-Arrays-with-respect-to-EQUALP.html create mode 100644 info/gcl/Visible-Modification-of-Bit-Vectors-and-Strings-with-respect-to-EQUAL.html create mode 100644 info/gcl/Visible-Modification-of-Conses-with-respect-to-EQUAL.html create mode 100644 info/gcl/Visible-Modification-of-Hash-Tables-with-respect-to-EQUALP.html create mode 100644 info/gcl/Visible-Modification-of-Objects-with-respect-to-EQ-and-EQL.html create mode 100644 info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUAL.html create mode 100644 info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUALP.html create mode 100644 info/gcl/Visible-Modification-of-Structures-with-respect-to-EQUALP.html create mode 100644 info/gcl/Visible-Modifications-by-Language-Extensions.html create mode 100644 info/gcl/When-Compiler-Macros-Are-Used.html create mode 100644 info/gcl/Whitespace-Characters.html create mode 100644 info/gcl/Wildcard-Words-in-a-Logical-Pathname-Namestring.html create mode 100644 info/gcl/_002a-_0028Variable_0029.html create mode 100644 info/gcl/_002a.html create mode 100644 info/gcl/_002abreak_002don_002dsignals_002a.html create mode 100644 info/gcl/_002acompile_002dfile_002dpathname_002a.html create mode 100644 info/gcl/_002acompile_002dprint_002a.html create mode 100644 info/gcl/_002adebug_002dio_002a.html create mode 100644 info/gcl/_002adebugger_002dhook_002a.html create mode 100644 info/gcl/_002adefault_002dpathname_002ddefaults_002a.html create mode 100644 info/gcl/_002afeatures_002a.html create mode 100644 info/gcl/_002agensym_002dcounter_002a.html create mode 100644 info/gcl/_002aload_002dpathname_002a.html create mode 100644 info/gcl/_002aload_002dprint_002a.html create mode 100644 info/gcl/_002amacroexpand_002dhook_002a.html create mode 100644 info/gcl/_002amodules_002a.html create mode 100644 info/gcl/_002apackage_002a.html create mode 100644 info/gcl/_002aprint_002darray_002a.html create mode 100644 info/gcl/_002aprint_002dbase_002a.html create mode 100644 info/gcl/_002aprint_002dcase_002a.html create mode 100644 info/gcl/_002aprint_002dcircle_002a.html create mode 100644 info/gcl/_002aprint_002descape_002a.html create mode 100644 info/gcl/_002aprint_002dgensym_002a.html create mode 100644 info/gcl/_002aprint_002dlevel_002a.html create mode 100644 info/gcl/_002aprint_002dlines_002a.html create mode 100644 info/gcl/_002aprint_002dmiser_002dwidth_002a.html create mode 100644 info/gcl/_002aprint_002dpprint_002ddispatch_002a.html create mode 100644 info/gcl/_002aprint_002dpretty_002a.html create mode 100644 info/gcl/_002aprint_002dreadably_002a.html create mode 100644 info/gcl/_002aprint_002dright_002dmargin_002a.html create mode 100644 info/gcl/_002arandom_002dstate_002a.html create mode 100644 info/gcl/_002aread_002dbase_002a.html create mode 100644 info/gcl/_002aread_002ddefault_002dfloat_002dformat_002a.html create mode 100644 info/gcl/_002aread_002deval_002a.html create mode 100644 info/gcl/_002aread_002dsuppress_002a.html create mode 100644 info/gcl/_002areadtable_002a.html create mode 100644 info/gcl/_002aterminal_002dio_002a.html create mode 100644 info/gcl/_002b-_0028Variable_0029.html create mode 100644 info/gcl/_002b.html create mode 100644 info/gcl/_002d-_0028Variable_0029.html create mode 100644 info/gcl/_002d.html create mode 100644 info/gcl/_002d_003eUNSPECIFIC-as-a-Component-Value.html create mode 100644 info/gcl/_002d_003eWILD-as-a-Component-Value.html create mode 100644 info/gcl/_002f-_0028Variable_0029.html create mode 100644 info/gcl/_002f.html create mode 100644 info/gcl/_003d.html create mode 100644 info/gcl/abort-_0028Function_0029.html create mode 100644 info/gcl/abort-_0028Restart_0029.html create mode 100644 info/gcl/abs.html create mode 100644 info/gcl/acons.html create mode 100644 info/gcl/add_002dmethod.html create mode 100644 info/gcl/adjoin.html create mode 100644 info/gcl/adjust_002darray.html create mode 100644 info/gcl/adjustable_002darray_002dp.html create mode 100644 info/gcl/allocate_002dinstance.html create mode 100644 info/gcl/alpha_002dchar_002dp.html create mode 100644 info/gcl/alphanumericp.html create mode 100644 info/gcl/and-_0028Type-Specifier_0029.html create mode 100644 info/gcl/and.html create mode 100644 info/gcl/append.html create mode 100644 info/gcl/apply.html create mode 100644 info/gcl/apropos.html create mode 100644 info/gcl/aref.html create mode 100644 info/gcl/arithmetic_002derror.html create mode 100644 info/gcl/arithmetic_002derror_002doperands.html create mode 100644 info/gcl/array.html create mode 100644 info/gcl/array_002ddimension.html create mode 100644 info/gcl/array_002ddimension_002dlimit.html create mode 100644 info/gcl/array_002ddimensions.html create mode 100644 info/gcl/array_002ddisplacement.html create mode 100644 info/gcl/array_002delement_002dtype.html create mode 100644 info/gcl/array_002dhas_002dfill_002dpointer_002dp.html create mode 100644 info/gcl/array_002din_002dbounds_002dp.html create mode 100644 info/gcl/array_002drank.html create mode 100644 info/gcl/array_002drank_002dlimit.html create mode 100644 info/gcl/array_002drow_002dmajor_002dindex.html create mode 100644 info/gcl/array_002dtotal_002dsize.html create mode 100644 info/gcl/array_002dtotal_002dsize_002dlimit.html create mode 100644 info/gcl/arrayp.html create mode 100644 info/gcl/ash.html create mode 100644 info/gcl/asin.html create mode 100644 info/gcl/assert.html create mode 100644 info/gcl/assoc.html create mode 100644 info/gcl/atom-_0028Type_0029.html create mode 100644 info/gcl/atom.html create mode 100644 info/gcl/base_002dchar.html create mode 100644 info/gcl/base_002dstring.html create mode 100644 info/gcl/bignum.html create mode 100644 info/gcl/bit-_0028Array_0029.html create mode 100644 info/gcl/bit-_0028System-Class_0029.html create mode 100644 info/gcl/bit_002dand.html create mode 100644 info/gcl/bit_002dvector.html create mode 100644 info/gcl/bit_002dvector_002dp.html create mode 100644 info/gcl/block.html create mode 100644 info/gcl/boole.html create mode 100644 info/gcl/boole_002d1.html create mode 100644 info/gcl/boolean.html create mode 100644 info/gcl/boundp.html create mode 100644 info/gcl/break.html create mode 100644 info/gcl/broadcast_002dstream.html create mode 100644 info/gcl/broadcast_002dstream_002dstreams.html create mode 100644 info/gcl/built_002din_002dclass.html create mode 100644 info/gcl/butlast.html create mode 100644 info/gcl/byte.html create mode 100644 info/gcl/call_002darguments_002dlimit.html create mode 100644 info/gcl/call_002dmethod.html create mode 100644 info/gcl/call_002dnext_002dmethod.html create mode 100644 info/gcl/car.html create mode 100644 info/gcl/case.html create mode 100644 info/gcl/catch.html create mode 100644 info/gcl/cell_002derror.html create mode 100644 info/gcl/cell_002derror_002dname.html create mode 100644 info/gcl/cerror.html create mode 100644 info/gcl/change_002dclass.html create mode 100644 info/gcl/char.html create mode 100644 info/gcl/char_002dcode.html create mode 100644 info/gcl/char_002dcode_002dlimit.html create mode 100644 info/gcl/char_002dint.html create mode 100644 info/gcl/char_002dname.html create mode 100644 info/gcl/char_002dupcase.html create mode 100644 info/gcl/char_003d.html create mode 100644 info/gcl/character-_0028System-Class_0029.html create mode 100644 info/gcl/character.html create mode 100644 info/gcl/characterp.html create mode 100644 info/gcl/check_002dtype.html create mode 100644 info/gcl/cis.html create mode 100644 info/gcl/class.html create mode 100644 info/gcl/class_002dname.html create mode 100644 info/gcl/class_002dof.html create mode 100644 info/gcl/clear_002dinput.html create mode 100644 info/gcl/close.html create mode 100644 info/gcl/clrhash.html create mode 100644 info/gcl/code_002dchar.html create mode 100644 info/gcl/coerce.html create mode 100644 info/gcl/compile.html create mode 100644 info/gcl/compile_002dfile.html create mode 100644 info/gcl/compile_002dfile_002dpathname.html create mode 100644 info/gcl/compiled_002dfunction.html create mode 100644 info/gcl/compiled_002dfunction_002dp.html create mode 100644 info/gcl/compiler_002dmacro_002dfunction.html create mode 100644 info/gcl/complement.html create mode 100644 info/gcl/complex-_0028System-Class_0029.html create mode 100644 info/gcl/complex.html create mode 100644 info/gcl/complexp.html create mode 100644 info/gcl/compute_002dapplicable_002dmethods.html create mode 100644 info/gcl/compute_002drestarts.html create mode 100644 info/gcl/concatenate.html create mode 100644 info/gcl/concatenated_002dstream.html create mode 100644 info/gcl/concatenated_002dstream_002dstreams.html create mode 100644 info/gcl/cond.html create mode 100644 info/gcl/condition.html create mode 100644 info/gcl/conjugate.html create mode 100644 info/gcl/cons-_0028System-Class_0029.html create mode 100644 info/gcl/cons.html create mode 100644 info/gcl/consp.html create mode 100644 info/gcl/constantly.html create mode 100644 info/gcl/constantp.html create mode 100644 info/gcl/continue.html create mode 100644 info/gcl/control_002derror.html create mode 100644 info/gcl/copy_002dalist.html create mode 100644 info/gcl/copy_002dlist.html create mode 100644 info/gcl/copy_002dpprint_002ddispatch.html create mode 100644 info/gcl/copy_002dreadtable.html create mode 100644 info/gcl/copy_002dseq.html create mode 100644 info/gcl/copy_002dstructure.html create mode 100644 info/gcl/copy_002dsymbol.html create mode 100644 info/gcl/copy_002dtree.html create mode 100644 info/gcl/count.html create mode 100644 info/gcl/declaim.html create mode 100644 info/gcl/declaration.html create mode 100644 info/gcl/declare.html create mode 100644 info/gcl/decode_002dfloat.html create mode 100644 info/gcl/decode_002duniversal_002dtime.html create mode 100644 info/gcl/defclass.html create mode 100644 info/gcl/defconstant.html create mode 100644 info/gcl/defgeneric.html create mode 100644 info/gcl/define_002dcompiler_002dmacro.html create mode 100644 info/gcl/define_002dcondition.html create mode 100644 info/gcl/define_002dmethod_002dcombination.html create mode 100644 info/gcl/define_002dmodify_002dmacro.html create mode 100644 info/gcl/define_002dsetf_002dexpander.html create mode 100644 info/gcl/define_002dsymbol_002dmacro.html create mode 100644 info/gcl/defmacro.html create mode 100644 info/gcl/defmethod.html create mode 100644 info/gcl/defpackage.html create mode 100644 info/gcl/defparameter.html create mode 100644 info/gcl/defsetf.html create mode 100644 info/gcl/defstruct.html create mode 100644 info/gcl/deftype.html create mode 100644 info/gcl/defun.html create mode 100644 info/gcl/delete_002dfile.html create mode 100644 info/gcl/delete_002dpackage.html create mode 100644 info/gcl/deposit_002dfield.html create mode 100644 info/gcl/describe.html create mode 100644 info/gcl/describe_002dobject.html create mode 100644 info/gcl/destructuring_002dbind.html create mode 100644 info/gcl/digit_002dchar.html create mode 100644 info/gcl/digit_002dchar_002dp.html create mode 100644 info/gcl/directory.html create mode 100644 info/gcl/disassemble.html create mode 100644 info/gcl/division_002dby_002dzero.html create mode 100644 info/gcl/do.html create mode 100644 info/gcl/do_002dsymbols.html create mode 100644 info/gcl/documentation.html create mode 100644 info/gcl/dolist.html create mode 100644 info/gcl/dotimes.html create mode 100644 info/gcl/dpb.html create mode 100644 info/gcl/dribble.html create mode 100644 info/gcl/dynamic_002dextent.html create mode 100644 info/gcl/echo_002dstream.html create mode 100644 info/gcl/echo_002dstream_002dinput_002dstream.html create mode 100644 info/gcl/ed.html create mode 100644 info/gcl/elt.html create mode 100644 info/gcl/encode_002duniversal_002dtime.html create mode 100644 info/gcl/end_002dof_002dfile.html create mode 100644 info/gcl/endp.html create mode 100644 info/gcl/ensure_002ddirectories_002dexist.html create mode 100644 info/gcl/ensure_002dgeneric_002dfunction.html create mode 100644 info/gcl/eq.html create mode 100644 info/gcl/eql-_0028Type-Specifier_0029.html create mode 100644 info/gcl/eql.html create mode 100644 info/gcl/equal.html create mode 100644 info/gcl/equalp.html create mode 100644 info/gcl/error-_0028Condition-Type_0029.html create mode 100644 info/gcl/error.html create mode 100644 info/gcl/eval.html create mode 100644 info/gcl/eval_002dwhen.html create mode 100644 info/gcl/evenp.html create mode 100644 info/gcl/every.html create mode 100644 info/gcl/exp.html create mode 100644 info/gcl/export.html create mode 100644 info/gcl/extended_002dchar.html create mode 100644 info/gcl/fboundp.html create mode 100644 info/gcl/fdefinition.html create mode 100644 info/gcl/file_002dauthor.html create mode 100644 info/gcl/file_002derror.html create mode 100644 info/gcl/file_002derror_002dpathname.html create mode 100644 info/gcl/file_002dlength.html create mode 100644 info/gcl/file_002dposition.html create mode 100644 info/gcl/file_002dstream.html create mode 100644 info/gcl/file_002dstring_002dlength.html create mode 100644 info/gcl/file_002dwrite_002ddate.html create mode 100644 info/gcl/fill.html create mode 100644 info/gcl/fill_002dpointer.html create mode 100644 info/gcl/find.html create mode 100644 info/gcl/find_002dall_002dsymbols.html create mode 100644 info/gcl/find_002dclass.html create mode 100644 info/gcl/find_002dmethod.html create mode 100644 info/gcl/find_002dpackage.html create mode 100644 info/gcl/find_002drestart.html create mode 100644 info/gcl/find_002dsymbol.html create mode 100644 info/gcl/finish_002doutput.html create mode 100644 info/gcl/first.html create mode 100644 info/gcl/fixnum.html create mode 100644 info/gcl/flet.html create mode 100644 info/gcl/float-_0028System-Class_0029.html create mode 100644 info/gcl/float.html create mode 100644 info/gcl/floating_002dpoint_002dinexact.html create mode 100644 info/gcl/floating_002dpoint_002dinvalid_002doperation.html create mode 100644 info/gcl/floating_002dpoint_002doverflow.html create mode 100644 info/gcl/floating_002dpoint_002dunderflow.html create mode 100644 info/gcl/floatp.html create mode 100644 info/gcl/floor.html create mode 100644 info/gcl/fmakunbound.html create mode 100644 info/gcl/format.html create mode 100644 info/gcl/formatter.html create mode 100644 info/gcl/ftype.html create mode 100644 info/gcl/funcall.html create mode 100644 info/gcl/function-_0028Special-Operator_0029.html create mode 100644 info/gcl/function-_0028System-Class_0029.html create mode 100644 info/gcl/function_002dkeywords.html create mode 100644 info/gcl/function_002dlambda_002dexpression.html create mode 100644 info/gcl/functionp.html create mode 100644 info/gcl/gcd.html create mode 100644 info/gcl/generic_002dfunction.html create mode 100644 info/gcl/gensym.html create mode 100644 info/gcl/gentemp.html create mode 100644 info/gcl/get.html create mode 100644 info/gcl/get_002dinternal_002dreal_002dtime.html create mode 100644 info/gcl/get_002dinternal_002drun_002dtime.html create mode 100644 info/gcl/get_002doutput_002dstream_002dstring.html create mode 100644 info/gcl/get_002dproperties.html create mode 100644 info/gcl/get_002dsetf_002dexpansion.html create mode 100644 info/gcl/get_002duniversal_002dtime.html create mode 100644 info/gcl/getf.html create mode 100644 info/gcl/gethash.html create mode 100644 info/gcl/go.html create mode 100644 info/gcl/graphic_002dchar_002dp.html create mode 100644 info/gcl/handler_002dbind.html create mode 100644 info/gcl/handler_002dcase.html create mode 100644 info/gcl/hash_002dtable.html create mode 100644 info/gcl/hash_002dtable_002dcount.html create mode 100644 info/gcl/hash_002dtable_002dp.html create mode 100644 info/gcl/hash_002dtable_002drehash_002dsize.html create mode 100644 info/gcl/hash_002dtable_002drehash_002dthreshold.html create mode 100644 info/gcl/hash_002dtable_002dsize.html create mode 100644 info/gcl/hash_002dtable_002dtest.html create mode 100644 info/gcl/identity.html create mode 100644 info/gcl/if.html create mode 100644 info/gcl/ignore.html create mode 100644 info/gcl/ignore_002derrors.html create mode 100644 info/gcl/import.html create mode 100644 info/gcl/in_002dpackage.html create mode 100644 info/gcl/incf.html create mode 100644 info/gcl/index.html create mode 100644 info/gcl/initialize_002dinstance.html create mode 100644 info/gcl/inline.html create mode 100644 info/gcl/input_002dstream_002dp.html create mode 100644 info/gcl/inspect.html create mode 100644 info/gcl/integer.html create mode 100644 info/gcl/integer_002dlength.html create mode 100644 info/gcl/integerp.html create mode 100644 info/gcl/interactive_002dstream_002dp.html create mode 100644 info/gcl/intern.html create mode 100644 info/gcl/internal_002dtime_002dunits_002dper_002dsecond.html create mode 100644 info/gcl/intersection.html create mode 100644 info/gcl/invalid_002dmethod_002derror.html create mode 100644 info/gcl/invoke_002ddebugger.html create mode 100644 info/gcl/invoke_002drestart.html create mode 100644 info/gcl/invoke_002drestart_002dinteractively.html create mode 100644 info/gcl/keyword.html create mode 100644 info/gcl/keywordp.html create mode 100644 info/gcl/lambda-_0028Symbol_0029.html create mode 100644 info/gcl/lambda.html create mode 100644 info/gcl/lambda_002dlist_002dkeywords.html create mode 100644 info/gcl/lambda_002dparameters_002dlimit.html create mode 100644 info/gcl/last.html create mode 100644 info/gcl/lcm.html create mode 100644 info/gcl/ldb.html create mode 100644 info/gcl/ldb_002dtest.html create mode 100644 info/gcl/ldiff.html create mode 100644 info/gcl/length.html create mode 100644 info/gcl/let.html create mode 100644 info/gcl/lisp_002dimplementation_002dtype.html create mode 100644 info/gcl/list-_0028Function_0029.html create mode 100644 info/gcl/list-_0028System-Class_0029.html create mode 100644 info/gcl/list_002dall_002dpackages.html create mode 100644 info/gcl/list_002dlength.html create mode 100644 info/gcl/listen.html create mode 100644 info/gcl/listp.html create mode 100644 info/gcl/load.html create mode 100644 info/gcl/load_002dlogical_002dpathname_002dtranslations.html create mode 100644 info/gcl/load_002dtime_002dvalue.html create mode 100644 info/gcl/locally.html create mode 100644 info/gcl/log.html create mode 100644 info/gcl/logand.html create mode 100644 info/gcl/logbitp.html create mode 100644 info/gcl/logcount.html create mode 100644 info/gcl/logical_002dpathname-_0028System-Class_0029.html create mode 100644 info/gcl/logical_002dpathname.html create mode 100644 info/gcl/logical_002dpathname_002dtranslations.html create mode 100644 info/gcl/logtest.html create mode 100644 info/gcl/loop.html create mode 100644 info/gcl/loop_002dfinish.html create mode 100644 info/gcl/machine_002dinstance.html create mode 100644 info/gcl/machine_002dtype.html create mode 100644 info/gcl/machine_002dversion.html create mode 100644 info/gcl/macro_002dfunction.html create mode 100644 info/gcl/macroexpand.html create mode 100644 info/gcl/make_002darray.html create mode 100644 info/gcl/make_002dbroadcast_002dstream.html create mode 100644 info/gcl/make_002dconcatenated_002dstream.html create mode 100644 info/gcl/make_002dcondition.html create mode 100644 info/gcl/make_002ddispatch_002dmacro_002dcharacter.html create mode 100644 info/gcl/make_002decho_002dstream.html create mode 100644 info/gcl/make_002dhash_002dtable.html create mode 100644 info/gcl/make_002dinstance.html create mode 100644 info/gcl/make_002dinstances_002dobsolete.html create mode 100644 info/gcl/make_002dlist.html create mode 100644 info/gcl/make_002dload_002dform.html create mode 100644 info/gcl/make_002dload_002dform_002dsaving_002dslots.html create mode 100644 info/gcl/make_002dpackage.html create mode 100644 info/gcl/make_002dpathname.html create mode 100644 info/gcl/make_002drandom_002dstate.html create mode 100644 info/gcl/make_002dsequence.html create mode 100644 info/gcl/make_002dstring.html create mode 100644 info/gcl/make_002dstring_002dinput_002dstream.html create mode 100644 info/gcl/make_002dstring_002doutput_002dstream.html create mode 100644 info/gcl/make_002dsymbol.html create mode 100644 info/gcl/make_002dsynonym_002dstream.html create mode 100644 info/gcl/make_002dtwo_002dway_002dstream.html create mode 100644 info/gcl/makunbound.html create mode 100644 info/gcl/map.html create mode 100644 info/gcl/map_002dinto.html create mode 100644 info/gcl/mapc.html create mode 100644 info/gcl/maphash.html create mode 100644 info/gcl/mask_002dfield.html create mode 100644 info/gcl/max.html create mode 100644 info/gcl/member-_0028Function_0029.html create mode 100644 info/gcl/member-_0028Type-Specifier_0029.html create mode 100644 info/gcl/merge.html create mode 100644 info/gcl/merge_002dpathnames.html create mode 100644 info/gcl/method.html create mode 100644 info/gcl/method_002dcombination.html create mode 100644 info/gcl/method_002dcombination_002derror.html create mode 100644 info/gcl/method_002dqualifiers.html create mode 100644 info/gcl/minusp.html create mode 100644 info/gcl/mismatch.html create mode 100644 info/gcl/mod-_0028Function_0029.html create mode 100644 info/gcl/mod-_0028System-Class_0029.html create mode 100644 info/gcl/most_002dpositive_002dfixnum.html create mode 100644 info/gcl/most_002dpositive_002dshort_002dfloat.html create mode 100644 info/gcl/muffle_002dwarning.html create mode 100644 info/gcl/multiple_002dvalue_002dbind.html create mode 100644 info/gcl/multiple_002dvalue_002dcall.html create mode 100644 info/gcl/multiple_002dvalue_002dlist.html create mode 100644 info/gcl/multiple_002dvalue_002dprog1.html create mode 100644 info/gcl/multiple_002dvalue_002dsetq.html create mode 100644 info/gcl/multiple_002dvalues_002dlimit.html create mode 100644 info/gcl/name_002dchar.html create mode 100644 info/gcl/namestring.html create mode 100644 info/gcl/nconc.html create mode 100644 info/gcl/next_002dmethod_002dp.html create mode 100644 info/gcl/nil-_0028Type_0029.html create mode 100644 info/gcl/nil.html create mode 100644 info/gcl/no_002dapplicable_002dmethod.html create mode 100644 info/gcl/no_002dnext_002dmethod.html create mode 100644 info/gcl/not-_0028Type-Specifier_0029.html create mode 100644 info/gcl/not.html create mode 100644 info/gcl/nth.html create mode 100644 info/gcl/nth_002dvalue.html create mode 100644 info/gcl/nthcdr.html create mode 100644 info/gcl/null-_0028System-Class_0029.html create mode 100644 info/gcl/null.html create mode 100644 info/gcl/number.html create mode 100644 info/gcl/numberp.html create mode 100644 info/gcl/numerator.html create mode 100644 info/gcl/open.html create mode 100644 info/gcl/open_002dstream_002dp.html create mode 100644 info/gcl/optimize.html create mode 100644 info/gcl/or-_0028Type-Specifier_0029.html create mode 100644 info/gcl/or.html create mode 100644 info/gcl/package.html create mode 100644 info/gcl/package_002derror.html create mode 100644 info/gcl/package_002derror_002dpackage.html create mode 100644 info/gcl/package_002dname.html create mode 100644 info/gcl/package_002dnicknames.html create mode 100644 info/gcl/package_002dshadowing_002dsymbols.html create mode 100644 info/gcl/package_002duse_002dlist.html create mode 100644 info/gcl/package_002dused_002dby_002dlist.html create mode 100644 info/gcl/packagep.html create mode 100644 info/gcl/pairlis.html create mode 100644 info/gcl/parse_002derror.html create mode 100644 info/gcl/parse_002dinteger.html create mode 100644 info/gcl/parse_002dnamestring.html create mode 100644 info/gcl/pathname-_0028System-Class_0029.html create mode 100644 info/gcl/pathname.html create mode 100644 info/gcl/pathname_002dhost.html create mode 100644 info/gcl/pathname_002dmatch_002dp.html create mode 100644 info/gcl/pathnamep.html create mode 100644 info/gcl/peek_002dchar.html create mode 100644 info/gcl/phase.html create mode 100644 info/gcl/pi.html create mode 100644 info/gcl/pop.html create mode 100644 info/gcl/position.html create mode 100644 info/gcl/pprint_002ddispatch.html create mode 100644 info/gcl/pprint_002dexit_002dif_002dlist_002dexhausted.html create mode 100644 info/gcl/pprint_002dfill.html create mode 100644 info/gcl/pprint_002dindent.html create mode 100644 info/gcl/pprint_002dlogical_002dblock.html create mode 100644 info/gcl/pprint_002dnewline.html create mode 100644 info/gcl/pprint_002dpop.html create mode 100644 info/gcl/pprint_002dtab.html create mode 100644 info/gcl/print_002dnot_002dreadable.html create mode 100644 info/gcl/print_002dnot_002dreadable_002dobject.html create mode 100644 info/gcl/print_002dobject.html create mode 100644 info/gcl/print_002dunreadable_002dobject.html create mode 100644 info/gcl/probe_002dfile.html create mode 100644 info/gcl/proclaim.html create mode 100644 info/gcl/prog.html create mode 100644 info/gcl/prog1.html create mode 100644 info/gcl/progn.html create mode 100644 info/gcl/program_002derror.html create mode 100644 info/gcl/progv.html create mode 100644 info/gcl/provide.html create mode 100644 info/gcl/psetq.html create mode 100644 info/gcl/push.html create mode 100644 info/gcl/pushnew.html create mode 100644 info/gcl/quote.html create mode 100644 info/gcl/random.html create mode 100644 info/gcl/random_002dstate.html create mode 100644 info/gcl/random_002dstate_002dp.html create mode 100644 info/gcl/rassoc.html create mode 100644 info/gcl/ratio.html create mode 100644 info/gcl/rational-_0028Function_0029.html create mode 100644 info/gcl/rational-_0028System-Class_0029.html create mode 100644 info/gcl/rationalp.html create mode 100644 info/gcl/read.html create mode 100644 info/gcl/read_002dbyte.html create mode 100644 info/gcl/read_002dchar.html create mode 100644 info/gcl/read_002dchar_002dno_002dhang.html create mode 100644 info/gcl/read_002ddelimited_002dlist.html create mode 100644 info/gcl/read_002dfrom_002dstring.html create mode 100644 info/gcl/read_002dline.html create mode 100644 info/gcl/read_002dsequence.html create mode 100644 info/gcl/reader_002derror.html create mode 100644 info/gcl/readtable.html create mode 100644 info/gcl/readtable_002dcase.html create mode 100644 info/gcl/readtablep.html create mode 100644 info/gcl/real.html create mode 100644 info/gcl/realp.html create mode 100644 info/gcl/realpart.html create mode 100644 info/gcl/reduce.html create mode 100644 info/gcl/reinitialize_002dinstance.html create mode 100644 info/gcl/remf.html create mode 100644 info/gcl/remhash.html create mode 100644 info/gcl/remove.html create mode 100644 info/gcl/remove_002dduplicates.html create mode 100644 info/gcl/remove_002dmethod.html create mode 100644 info/gcl/remprop.html create mode 100644 info/gcl/rename_002dfile.html create mode 100644 info/gcl/rename_002dpackage.html create mode 100644 info/gcl/replace.html create mode 100644 info/gcl/rest.html create mode 100644 info/gcl/restart.html create mode 100644 info/gcl/restart_002dbind.html create mode 100644 info/gcl/restart_002dcase.html create mode 100644 info/gcl/restart_002dname.html create mode 100644 info/gcl/return.html create mode 100644 info/gcl/return_002dfrom.html create mode 100644 info/gcl/revappend.html create mode 100644 info/gcl/reverse.html create mode 100644 info/gcl/room.html create mode 100644 info/gcl/rotatef.html create mode 100644 info/gcl/row_002dmajor_002daref.html create mode 100644 info/gcl/rplaca.html create mode 100644 info/gcl/satisfies.html create mode 100644 info/gcl/search.html create mode 100644 info/gcl/sequence.html create mode 100644 info/gcl/serious_002dcondition.html create mode 100644 info/gcl/set.html create mode 100644 info/gcl/set_002ddifference.html create mode 100644 info/gcl/set_002ddispatch_002dmacro_002dcharacter.html create mode 100644 info/gcl/set_002dexclusive_002dor.html create mode 100644 info/gcl/set_002dmacro_002dcharacter.html create mode 100644 info/gcl/set_002dpprint_002ddispatch.html create mode 100644 info/gcl/set_002dsyntax_002dfrom_002dchar.html create mode 100644 info/gcl/setf-class_002dname.html create mode 100644 info/gcl/setf.html create mode 100644 info/gcl/setq.html create mode 100644 info/gcl/shadow.html create mode 100644 info/gcl/shadowing_002dimport.html create mode 100644 info/gcl/shared_002dinitialize.html create mode 100644 info/gcl/shiftf.html create mode 100644 info/gcl/short_002dfloat.html create mode 100644 info/gcl/short_002dfloat_002depsilon.html create mode 100644 info/gcl/short_002dsite_002dname.html create mode 100644 info/gcl/signal.html create mode 100644 info/gcl/signed_002dbyte.html create mode 100644 info/gcl/signum.html create mode 100644 info/gcl/simple_002darray.html create mode 100644 info/gcl/simple_002dbase_002dstring.html create mode 100644 info/gcl/simple_002dbit_002dvector.html create mode 100644 info/gcl/simple_002dbit_002dvector_002dp.html create mode 100644 info/gcl/simple_002dcondition.html create mode 100644 info/gcl/simple_002dcondition_002dformat_002dcontrol.html create mode 100644 info/gcl/simple_002derror.html create mode 100644 info/gcl/simple_002dstring.html create mode 100644 info/gcl/simple_002dstring_002dp.html create mode 100644 info/gcl/simple_002dtype_002derror.html create mode 100644 info/gcl/simple_002dvector.html create mode 100644 info/gcl/simple_002dvector_002dp.html create mode 100644 info/gcl/simple_002dwarning.html create mode 100644 info/gcl/sin.html create mode 100644 info/gcl/sinh.html create mode 100644 info/gcl/sleep.html create mode 100644 info/gcl/slot_002dboundp.html create mode 100644 info/gcl/slot_002dexists_002dp.html create mode 100644 info/gcl/slot_002dmakunbound.html create mode 100644 info/gcl/slot_002dmissing.html create mode 100644 info/gcl/slot_002dunbound.html create mode 100644 info/gcl/slot_002dvalue.html create mode 100644 info/gcl/software_002dtype.html create mode 100644 info/gcl/sort.html create mode 100644 info/gcl/special.html create mode 100644 info/gcl/special_002doperator_002dp.html create mode 100644 info/gcl/sqrt.html create mode 100644 info/gcl/standard_002dchar.html create mode 100644 info/gcl/standard_002dchar_002dp.html create mode 100644 info/gcl/standard_002dclass.html create mode 100644 info/gcl/standard_002dgeneric_002dfunction.html create mode 100644 info/gcl/standard_002dmethod.html create mode 100644 info/gcl/standard_002dobject.html create mode 100644 info/gcl/step.html create mode 100644 info/gcl/storage_002dcondition.html create mode 100644 info/gcl/store_002dvalue.html create mode 100644 info/gcl/stream.html create mode 100644 info/gcl/stream_002delement_002dtype.html create mode 100644 info/gcl/stream_002derror.html create mode 100644 info/gcl/stream_002derror_002dstream.html create mode 100644 info/gcl/stream_002dexternal_002dformat.html create mode 100644 info/gcl/streamp.html create mode 100644 info/gcl/string-_0028System-Class_0029.html create mode 100644 info/gcl/string.html create mode 100644 info/gcl/string_002dstream.html create mode 100644 info/gcl/string_002dtrim.html create mode 100644 info/gcl/string_002dupcase.html create mode 100644 info/gcl/string_003d.html create mode 100644 info/gcl/stringp.html create mode 100644 info/gcl/structure_002dclass.html create mode 100644 info/gcl/structure_002dobject.html create mode 100644 info/gcl/style_002dwarning.html create mode 100644 info/gcl/sublis.html create mode 100644 info/gcl/subseq.html create mode 100644 info/gcl/subsetp.html create mode 100644 info/gcl/subst.html create mode 100644 info/gcl/substitute.html create mode 100644 info/gcl/subtypep.html create mode 100644 info/gcl/svref.html create mode 100644 info/gcl/sxhash.html create mode 100644 info/gcl/symbol.html create mode 100644 info/gcl/symbol_002dfunction.html create mode 100644 info/gcl/symbol_002dmacrolet.html create mode 100644 info/gcl/symbol_002dname.html create mode 100644 info/gcl/symbol_002dpackage.html create mode 100644 info/gcl/symbol_002dplist.html create mode 100644 info/gcl/symbol_002dvalue.html create mode 100644 info/gcl/symbolp.html create mode 100644 info/gcl/synonym_002dstream.html create mode 100644 info/gcl/synonym_002dstream_002dsymbol.html create mode 100644 info/gcl/t-_0028System-Class_0029.html create mode 100644 info/gcl/t.html create mode 100644 info/gcl/tagbody.html create mode 100644 info/gcl/terpri.html create mode 100644 info/gcl/the.html create mode 100644 info/gcl/throw.html create mode 100644 info/gcl/time.html create mode 100644 info/gcl/trace.html create mode 100644 info/gcl/translate_002dlogical_002dpathname.html create mode 100644 info/gcl/translate_002dpathname.html create mode 100644 info/gcl/tree_002dequal.html create mode 100644 info/gcl/truename.html create mode 100644 info/gcl/two_002dway_002dstream.html create mode 100644 info/gcl/two_002dway_002dstream_002dinput_002dstream.html create mode 100644 info/gcl/type.html create mode 100644 info/gcl/type_002derror.html create mode 100644 info/gcl/type_002derror_002ddatum.html create mode 100644 info/gcl/type_002dof.html create mode 100644 info/gcl/typecase.html create mode 100644 info/gcl/typep.html create mode 100644 info/gcl/unbound_002dslot.html create mode 100644 info/gcl/unbound_002dslot_002dinstance.html create mode 100644 info/gcl/unbound_002dvariable.html create mode 100644 info/gcl/undefined_002dfunction.html create mode 100644 info/gcl/unexport.html create mode 100644 info/gcl/unintern.html create mode 100644 info/gcl/union.html create mode 100644 info/gcl/unread_002dchar.html create mode 100644 info/gcl/unsigned_002dbyte.html create mode 100644 info/gcl/unuse_002dpackage.html create mode 100644 info/gcl/unwind_002dprotect.html create mode 100644 info/gcl/update_002dinstance_002dfor_002ddifferent_002dclass.html create mode 100644 info/gcl/update_002dinstance_002dfor_002dredefined_002dclass.html create mode 100644 info/gcl/upgraded_002darray_002delement_002dtype.html create mode 100644 info/gcl/upgraded_002dcomplex_002dpart_002dtype.html create mode 100644 info/gcl/upper_002dcase_002dp.html create mode 100644 info/gcl/use_002dpackage.html create mode 100644 info/gcl/use_002dvalue.html create mode 100644 info/gcl/user_002dhomedir_002dpathname.html create mode 100644 info/gcl/values-_0028Type-Specifier_0029.html create mode 100644 info/gcl/values.html create mode 100644 info/gcl/values_002dlist.html create mode 100644 info/gcl/vector-_0028System-Class_0029.html create mode 100644 info/gcl/vector.html create mode 100644 info/gcl/vector_002dpop.html create mode 100644 info/gcl/vector_002dpush.html create mode 100644 info/gcl/vectorp.html create mode 100644 info/gcl/warn.html create mode 100644 info/gcl/warning.html create mode 100644 info/gcl/when.html create mode 100644 info/gcl/wild_002dpathname_002dp.html create mode 100644 info/gcl/with_002daccessors.html create mode 100644 info/gcl/with_002dcompilation_002dunit.html create mode 100644 info/gcl/with_002dcondition_002drestarts.html create mode 100644 info/gcl/with_002dhash_002dtable_002diterator.html create mode 100644 info/gcl/with_002dinput_002dfrom_002dstring.html create mode 100644 info/gcl/with_002dopen_002dfile.html create mode 100644 info/gcl/with_002dopen_002dstream.html create mode 100644 info/gcl/with_002doutput_002dto_002dstring.html create mode 100644 info/gcl/with_002dpackage_002diterator.html create mode 100644 info/gcl/with_002dsimple_002drestart.html create mode 100644 info/gcl/with_002dslots.html create mode 100644 info/gcl/with_002dstandard_002dio_002dsyntax.html create mode 100644 info/gcl/write.html create mode 100644 info/gcl/write_002dbyte.html create mode 100644 info/gcl/write_002dchar.html create mode 100644 info/gcl/write_002dsequence.html create mode 100644 info/gcl/write_002dstring.html create mode 100644 info/gcl/write_002dto_002dstring.html create mode 100644 info/gcl/y_002dor_002dn_002dp.html create mode 100644 info/gcl/zerop.html create mode 100755 info/general.texi create mode 100755 info/internal.texi create mode 100755 info/io.texi create mode 100755 info/iteration.texi create mode 100755 info/list.texi create mode 100644 info/makefile create mode 100755 info/misc.texi create mode 100755 info/number.texi create mode 100755 info/sequence.texi create mode 100755 info/si-defs.texi create mode 100755 info/structure.texi create mode 100755 info/symbol.texi create mode 100755 info/system.texi create mode 100755 info/type.texi create mode 100755 info/user-interface.texi create mode 100755 info/widgets.texi create mode 100644 install.sh create mode 100644 japitest.lsp create mode 100644 lsp/.gitignore create mode 100755 lsp/dbind.lisp create mode 100755 lsp/dummy.lisp create mode 100755 lsp/fasd.lisp create mode 100755 lsp/fast-mv.lisp create mode 100755 lsp/gcl_arraylib.lsp create mode 100755 lsp/gcl_assert.lsp create mode 100755 lsp/gcl_auto.lsp create mode 100755 lsp/gcl_auto_new.lsp create mode 100755 lsp/gcl_autocmp.lsp create mode 100755 lsp/gcl_autoload.lsp create mode 100755 lsp/gcl_cmpinit.lsp create mode 100755 lsp/gcl_debug.lsp create mode 100755 lsp/gcl_defmacro.lsp create mode 100644 lsp/gcl_defpackage.lsp create mode 100755 lsp/gcl_defstruct.lsp create mode 100755 lsp/gcl_describe.lsp create mode 100755 lsp/gcl_desetq.lsp create mode 100644 lsp/gcl_destructuring_bind.lsp create mode 100644 lsp/gcl_directory.lsp create mode 100755 lsp/gcl_doc-file.lsp create mode 100755 lsp/gcl_evalmacros.lsp create mode 100755 lsp/gcl_export.lsp create mode 100755 lsp/gcl_fdecl.lsp create mode 100644 lsp/gcl_fpe.lsp create mode 100644 lsp/gcl_fpe_test.lsp create mode 100755 lsp/gcl_gprof.lsp create mode 100755 lsp/gcl_info.lsp create mode 100755 lsp/gcl_iolib.lsp create mode 100644 lsp/gcl_japi.lsp create mode 100755 lsp/gcl_listlib.lsp create mode 100755 lsp/gcl_littleXlsp.lsp create mode 100755 lsp/gcl_loadcmp.lsp create mode 100644 lsp/gcl_logical_pathname_translations.lsp create mode 100644 lsp/gcl_loop.lsp create mode 100755 lsp/gcl_make-declare.lsp create mode 100644 lsp/gcl_make_defpackage.lsp create mode 100644 lsp/gcl_make_pathname.lsp create mode 100644 lsp/gcl_merge_pathnames.lsp create mode 100755 lsp/gcl_mislib.lsp create mode 100755 lsp/gcl_module.lsp create mode 100644 lsp/gcl_namestring.lsp create mode 100755 lsp/gcl_numlib.lsp create mode 100755 lsp/gcl_packages.lsp create mode 100755 lsp/gcl_packlib.lsp create mode 100644 lsp/gcl_parse_namestring.lsp create mode 100644 lsp/gcl_pathname_match_p.lsp create mode 100755 lsp/gcl_predlib.lsp create mode 100755 lsp/gcl_profile.lsp create mode 100644 lsp/gcl_readline.lsp create mode 100644 lsp/gcl_rename_file.lsp create mode 100644 lsp/gcl_restart.lsp create mode 100755 lsp/gcl_seq.lsp create mode 100755 lsp/gcl_seqlib.lsp create mode 100755 lsp/gcl_serror.lsp create mode 100755 lsp/gcl_setf.lsp create mode 100644 lsp/gcl_sharp.lsp create mode 100644 lsp/gcl_sharp_uv.lsp create mode 100755 lsp/gcl_sloop.lsp create mode 100755 lsp/gcl_stack-problem.lsp create mode 100755 lsp/gcl_stdlisp.lsp create mode 100755 lsp/gcl_top.lsp create mode 100755 lsp/gcl_trace.lsp create mode 100644 lsp/gcl_translate_pathname.lsp create mode 100644 lsp/gcl_truename.lsp create mode 100644 lsp/gcl_wild_pathname_p.lsp create mode 100755 lsp/gprof.hc create mode 100755 lsp/gprof1.lisp create mode 100755 lsp/gprof_aix.hc create mode 100755 lsp/make.lisp create mode 100644 lsp/makefile create mode 100755 lsp/sys-proclaim.lisp create mode 100755 lsp/ucall.lisp create mode 100755 lsp/ustreams.lisp create mode 100644 ltmain.sh create mode 100755 machines create mode 100755 majvers create mode 100755 makdefs create mode 100644 makedefc.in create mode 100644 makefile create mode 100755 man/man1/gcl.1 create mode 100755 merge.c create mode 100755 minvers create mode 100755 misc/check.c create mode 100755 misc/check_obj.c create mode 100755 misc/cstruct.lsp create mode 100755 misc/foreign.lsp create mode 100755 misc/mprotect.ch create mode 100755 misc/rusage.lsp create mode 100755 misc/test-seek.c create mode 100755 misc/test-sgc.lsp create mode 100755 misc/warn-slow.lsp create mode 100755 mp/fplus.c create mode 100755 mp/gcclab create mode 100755 mp/gcclab.awk create mode 100755 mp/gnulib1.c create mode 100755 mp/lo-ibmrt.s create mode 100755 mp/lo-rios.s create mode 100644 mp/lo-rios1.s create mode 100755 mp/lo-sgi4d.s create mode 100755 mp/lo-u370_aix.s create mode 100755 mp/make.defs create mode 100644 mp/makefile create mode 100755 mp/mp2.c create mode 100755 mp/mp_addmul.c create mode 100755 mp/mp_bfffo.c create mode 100755 mp/mp_dblrsl3.c create mode 100755 mp/mp_dblrul3.c create mode 100755 mp/mp_divul3.c create mode 100755 mp/mp_divul3_word.c create mode 100755 mp/mp_mulul3.c create mode 100755 mp/mp_shiftl.c create mode 100755 mp/mp_sl3todivul3.c create mode 100644 mp/mpi-386_no_under.s create mode 100755 mp/mpi-386d.S create mode 100755 mp/mpi-bsd68k.s create mode 100755 mp/mpi-sol-sparc.s create mode 100755 mp/mpi-sparc.s create mode 100755 mp/mpi.c create mode 100755 mp/readme create mode 100755 mp/sparcdivul3.s create mode 100644 o/.gitignore create mode 100755 o/ChangeLog create mode 100755 o/NeXTunixfasl.c create mode 100755 o/NeXTunixsave.c create mode 100755 o/Vmalloc.c create mode 100644 o/alloc.c create mode 100755 o/array.c create mode 100755 o/array.c.prev create mode 100755 o/array.c1 create mode 100755 o/assignment.c create mode 100755 o/backq.c create mode 100755 o/bcmp.c create mode 100755 o/bcopy.c create mode 100755 o/bds.c create mode 100755 o/before_init.c create mode 100755 o/big.c create mode 100755 o/bind.c create mode 100755 o/bind.texi create mode 100755 o/bitop.c create mode 100755 o/block.c create mode 100755 o/bsearch.c create mode 100755 o/bzero.c create mode 100755 o/catch.c create mode 100755 o/cfun.c create mode 100755 o/character.d create mode 100755 o/clxsocket.c create mode 100755 o/cmac.c create mode 100755 o/cmpaux.c create mode 100755 o/conditional.c create mode 100755 o/earith.c create mode 100755 o/egrep-def create mode 100755 o/error.c create mode 100755 o/eval.c create mode 100755 o/external_funs.h create mode 100755 o/fasdump.c create mode 100755 o/fasldlsym.c create mode 100755 o/fasldlsym.c.link create mode 100755 o/faslhp800.c create mode 100755 o/faslnt.c create mode 100755 o/faslsgi4.c create mode 100755 o/fat_string.c create mode 100755 o/file.d create mode 100755 o/firstfile.c create mode 100755 o/fix-structref.el create mode 100755 o/format.c create mode 100755 o/frame.c create mode 100755 o/funlink.c create mode 100755 o/funs create mode 100755 o/gbc.c create mode 100644 o/gcl_readline.d create mode 100755 o/gdb_commands create mode 100644 o/gmp.c create mode 100755 o/gmp_big.c create mode 100644 o/gmp_num_log.c create mode 100755 o/gnumalloc.c create mode 100644 o/gprof.c create mode 100755 o/grab_defs.c create mode 100755 o/grab_defs.u create mode 100755 o/hash.d create mode 100755 o/help.el create mode 100755 o/init_pari.c create mode 100755 o/internal-calls.lisp create mode 100755 o/iteration.c create mode 100755 o/lastfile.c create mode 100755 o/let.c create mode 100755 o/lex.c create mode 100755 o/list.d create mode 100755 o/littleXwin.c create mode 100755 o/macros.c create mode 100755 o/main.c create mode 100644 o/makefile create mode 100755 o/makefun.c create mode 100755 o/malloc.c create mode 100755 o/mapfun.c create mode 100644 o/mingfile.c create mode 100755 o/mingwin.c create mode 100755 o/multival.c create mode 100755 o/mych create mode 100755 o/ndiv.c create mode 100755 o/nfunlink.c create mode 100755 o/nmul.c create mode 100644 o/nsocket.c create mode 100755 o/ntheap.h create mode 100755 o/num_arith.c create mode 100755 o/num_co.c create mode 100755 o/num_comp.c create mode 100755 o/num_log.c create mode 100755 o/num_pred.c create mode 100755 o/num_rand.c create mode 100755 o/num_sfun.c create mode 100755 o/number.c create mode 100755 o/package.d create mode 100755 o/pari_big.c create mode 100644 o/pari_num_log.c create mode 100755 o/pathname.d create mode 100755 o/peculiar.c create mode 100644 o/plt.c create mode 100644 o/plttest.c create mode 100755 o/pre_init.c create mode 100755 o/predicate.c create mode 100644 o/prelink.c create mode 100755 o/print.d create mode 100755 o/prog.c create mode 100755 o/read.d create mode 100755 o/readme create mode 100755 o/reference.c create mode 100755 o/regexp.c create mode 100755 o/regexp.h create mode 100755 o/regexpr.c create mode 100755 o/rel_aix.c create mode 100755 o/rel_coff.c create mode 100755 o/rel_hp300.c create mode 100755 o/rel_mac2.c create mode 100755 o/rel_ps2aix.c create mode 100755 o/rel_rios.c create mode 100755 o/rel_stand.c create mode 100755 o/rel_sun3.c create mode 100755 o/rel_sun4.c create mode 100755 o/rel_u370aix.c create mode 100755 o/run_process.c create mode 100755 o/save.c create mode 100755 o/save_sgi4.c create mode 100755 o/saveaix3.c create mode 100755 o/savedec31.c create mode 100755 o/saveu370.c create mode 100755 o/sbrk.c create mode 100755 o/sequence.d create mode 100755 o/sfasl.c create mode 100644 o/sfaslbfd.c create mode 100644 o/sfaslcoff.c create mode 100755 o/sfaslelf.c create mode 100755 o/sfasli.c create mode 100644 o/sfaslmacho.c create mode 100644 o/sfaslmacosx.c create mode 100755 o/sgbc.c create mode 100755 o/sgi4d_emul.s create mode 100755 o/sockets.c create mode 100755 o/strcspn.c create mode 100755 o/string.d create mode 100755 o/structure.c create mode 100755 o/symbol.d create mode 100755 o/test_memprotect.c create mode 100755 o/toplevel.c create mode 100755 o/try.c create mode 100755 o/typespec.c create mode 100755 o/u370_emul.s create mode 100644 o/unexaix.c create mode 100755 o/unexec-19.29.c create mode 100755 o/unexec.c create mode 100755 o/unexelf.c create mode 100755 o/unexelfsgi.c create mode 100755 o/unexhp9k800.c create mode 100755 o/unexlin.c create mode 100644 o/unexmacosx.c create mode 100755 o/unexmips.c create mode 100755 o/unexnt.c create mode 100755 o/unexsgi.c create mode 100755 o/unixfasl.c create mode 100755 o/unixfsys.c create mode 100755 o/unixsave.c create mode 100755 o/unixsys.c create mode 100755 o/unixtime.c create mode 100755 o/user_init.c create mode 100644 o/user_match.c create mode 100755 o/usig.c create mode 100755 o/usig2.c create mode 100755 o/usig2_aux.c create mode 100755 o/utils.c create mode 100644 o/wpool.c create mode 100755 o/xdrfuns.c create mode 100644 pcl/.gitignore create mode 100644 pcl/README create mode 100644 pcl/defsys.lisp create mode 100644 pcl/extensions/extensions.lisp create mode 100644 pcl/extensions/inline.lisp create mode 100644 pcl/extensions/user-instances.lisp create mode 100644 pcl/gcl_pcl_boot.lisp create mode 100644 pcl/gcl_pcl_braid.lisp create mode 100644 pcl/gcl_pcl_cache.lisp create mode 100644 pcl/gcl_pcl_combin.lisp create mode 100644 pcl/gcl_pcl_compat.lisp create mode 100644 pcl/gcl_pcl_cpl.lisp create mode 100644 pcl/gcl_pcl_ctypes.lisp create mode 100644 pcl/gcl_pcl_defclass.lisp create mode 100644 pcl/gcl_pcl_defcombin.lisp create mode 100644 pcl/gcl_pcl_defs.lisp create mode 100644 pcl/gcl_pcl_dfun.lisp create mode 100644 pcl/gcl_pcl_dlisp.lisp create mode 100644 pcl/gcl_pcl_dlisp2.lisp create mode 100644 pcl/gcl_pcl_env.lisp create mode 100644 pcl/gcl_pcl_fast_init.lisp create mode 100644 pcl/gcl_pcl_fin.lisp create mode 100644 pcl/gcl_pcl_fixup.lisp create mode 100644 pcl/gcl_pcl_fngen.lisp create mode 100644 pcl/gcl_pcl_fsc.lisp create mode 100644 pcl/gcl_pcl_generic_functions.lisp create mode 100644 pcl/gcl_pcl_init.lisp create mode 100644 pcl/gcl_pcl_iterate.lisp create mode 100644 pcl/gcl_pcl_low.lisp create mode 100644 pcl/gcl_pcl_macros.lisp create mode 100644 pcl/gcl_pcl_methods.lisp create mode 100644 pcl/gcl_pcl_pkg.lisp create mode 100644 pcl/gcl_pcl_precom1.lisp create mode 100644 pcl/gcl_pcl_precom2.lisp create mode 100644 pcl/gcl_pcl_slots.lisp create mode 100644 pcl/gcl_pcl_slots_boot.lisp create mode 100644 pcl/gcl_pcl_std_class.lisp create mode 100644 pcl/gcl_pcl_vector.lisp create mode 100644 pcl/gcl_pcl_walk.lisp create mode 100644 pcl/impl/cmu/README create mode 100644 pcl/impl/cmu/cmu-low.lisp create mode 100644 pcl/impl/cmu/pclcom.lisp create mode 100644 pcl/impl/cmu/pclload.lisp create mode 100644 pcl/impl/coral/coral-low.lisp create mode 100644 pcl/impl/franz/cpatch.lisp create mode 100644 pcl/impl/franz/excl-low.lisp create mode 100644 pcl/impl/franz/quadlap.lisp create mode 100644 pcl/impl/gcl/README create mode 100644 pcl/impl/gcl/gcl-low.lisp create mode 100644 pcl/impl/gcl/gcl-patches.lisp create mode 100644 pcl/impl/gcl/gcl_pcl_impl_low.lisp create mode 100644 pcl/impl/gcl/makefile.gcl create mode 100644 pcl/impl/gcl/sys-package.lisp create mode 100644 pcl/impl/gcl/sys-proclaim.lisp create mode 100644 pcl/impl/gold-hill/gold-low.lisp create mode 100644 pcl/impl/gold-hill/gold-patches.lisp create mode 100644 pcl/impl/hp/hp-low.lisp create mode 100644 pcl/impl/ibcl/ibcl-low.lisp create mode 100644 pcl/impl/ibcl/ibcl-patches.lisp create mode 100644 pcl/impl/kcl/kcl-low.lisp create mode 100644 pcl/impl/kcl/kcl-mods.text create mode 100644 pcl/impl/kcl/kcl-notes.text create mode 100644 pcl/impl/kcl/kcl-patches.lisp create mode 100644 pcl/impl/kcl/makefile.akcl create mode 100644 pcl/impl/kcl/misc-kcl-patches.text create mode 100644 pcl/impl/kcl/new-kcl-wrapper.text create mode 100644 pcl/impl/kcl/sys-package.lisp create mode 100644 pcl/impl/kcl/sys-proclaim.lisp create mode 100644 pcl/impl/kcl/sysdef.lisp create mode 100644 pcl/impl/lucid/lucid-low.lisp create mode 100644 pcl/impl/pyramid/pyr-low.lisp create mode 100644 pcl/impl/pyramid/pyr-patches.lisp create mode 100644 pcl/impl/symbolics/cloe-low.lisp create mode 100644 pcl/impl/symbolics/genera-low.lisp create mode 100644 pcl/impl/symbolics/rel-7-2-patches.lisp create mode 100644 pcl/impl/symbolics/rel-8-patches.lisp create mode 100644 pcl/impl/ti/ti-low.lisp create mode 100644 pcl/impl/ti/ti-patches.lisp create mode 100644 pcl/impl/vaxlisp/vaxl-low.lisp create mode 100644 pcl/impl/xerox/pcl-env-internal.lisp create mode 100644 pcl/impl/xerox/pcl-env.lisp create mode 100644 pcl/impl/xerox/pcl-env.text create mode 100644 pcl/impl/xerox/xerox-low.lisp create mode 100644 pcl/impl/xerox/xerox-patches.lisp create mode 100644 pcl/makefile create mode 100644 pcl/notes/12-7-88-notes.text create mode 100644 pcl/notes/3-17-88-notes.text create mode 100644 pcl/notes/3-19-87-notes.text create mode 100644 pcl/notes/4-21-87-notes.text create mode 100644 pcl/notes/4-29-87-notes.text create mode 100644 pcl/notes/5-22-87-notes.text create mode 100644 pcl/notes/5-22-89-notes.text create mode 100644 pcl/notes/8-28-88-notes.text create mode 100644 pcl/notes/get-pcl.text create mode 100644 pcl/notes/lap.text create mode 100644 pcl/notes/may-day-notes.text create mode 100644 pcl/notes/notes.text create mode 100644 pcl/notes/readme.text create mode 100644 pcl/old/construct.lisp create mode 100644 pcl/old/dlap.lisp create mode 100644 pcl/old/lap.lisp create mode 100644 pcl/old/plap.lisp create mode 100644 pcl/package.lisp create mode 100644 pcl/pcl_methods.patch create mode 100644 pcl/sys-proclaim.lisp create mode 100644 pcl/test/bench-precompile.lisp create mode 100644 pcl/test/bench.lisp create mode 100644 pcl/test/bench.out create mode 100644 pcl/test/list-functions.lisp create mode 100644 pcl/test/make-test.lisp create mode 100644 pcl/test/makediff create mode 100644 pcl/test/time.lisp create mode 100644 pcl/unused/precom4.lisp create mode 100644 readme create mode 100644 readme-bin.mingw create mode 100644 readme.gmp create mode 100755 readme.mingw create mode 100644 readme.xgcl create mode 100644 release create mode 100644 unixport/.gitignore create mode 100755 unixport/aix-crt0.el create mode 100755 unixport/aix_exports create mode 100644 unixport/ansi_cl.lisp create mode 100755 unixport/boots create mode 100755 unixport/bsd_rsym.c create mode 100755 unixport/cmpboots create mode 100755 unixport/gcldos.lsp create mode 100755 unixport/gcrt0.el create mode 100755 unixport/lspboots create mode 100644 unixport/make_kcn create mode 100644 unixport/makefile create mode 100755 unixport/makefile.dos create mode 100644 unixport/msys.c create mode 100755 unixport/ncrt0.el create mode 100755 unixport/rsym.c create mode 100755 unixport/rsym_elf.c create mode 100644 unixport/rsym_macosx.c create mode 100755 unixport/rsym_nt.c create mode 100755 unixport/so_locations create mode 100755 unixport/sys-init.lsp create mode 100644 unixport/sys.c create mode 100644 unixport/sys_ansi_gcl.c create mode 100755 unixport/sys_boot.c create mode 100755 unixport/sys_gcl.c create mode 100644 unixport/sys_init.lsp.in create mode 100755 unixport/sys_kcn.c create mode 100644 unixport/sys_pcl_gcl.c create mode 100755 unixport/sys_pre_gcl.c create mode 100755 unixport/tryserv.tcl create mode 100755 utils/replace create mode 100755 utils/repls1.sed create mode 100755 utils/repls2.sed create mode 100755 utils/repls3.sed create mode 100755 utils/repls4.sed create mode 100755 utils/repls5.sed create mode 100755 utils/revstruct.sed create mode 100644 windows/.gitignore create mode 100644 windows/gcl.iss.in create mode 100644 windows/install.lsp.in create mode 100755 windows/instdos.sh create mode 100644 windows/sysdir.bat.in create mode 100644 xbin/.gitignore create mode 100755 xbin/386-linux-fix create mode 100755 xbin/add-dir create mode 100755 xbin/append create mode 100755 xbin/append.bat create mode 100755 xbin/comp_rel create mode 100755 xbin/compare-src create mode 100755 xbin/compare.c create mode 100755 xbin/dfiles create mode 100755 xbin/distrib-help create mode 100755 xbin/distribute create mode 100755 xbin/dos-files create mode 100755 xbin/dosmake.bat create mode 100755 xbin/exists create mode 100755 xbin/fix-copyright create mode 100755 xbin/get-externals create mode 100755 xbin/get-internal-calls create mode 100755 xbin/get-machine create mode 100755 xbin/ibm create mode 100755 xbin/if-exist.bat create mode 100755 xbin/if-exists create mode 100755 xbin/if-have-gcc create mode 100755 xbin/inc-version create mode 100755 xbin/is-V-newest create mode 100755 xbin/make-fn create mode 100755 xbin/maketest create mode 100755 xbin/maketest1 create mode 100755 xbin/move-if-changed create mode 100755 xbin/new-files create mode 100755 xbin/notify create mode 100755 xbin/setup-tmptest create mode 100755 xbin/spp.c create mode 100755 xbin/strip-ifdef create mode 100755 xbin/test create mode 100755 xbin/test-distrib create mode 100755 xbin/test1 create mode 100755 xbin/update create mode 100644 xgcl-2/.gitignore create mode 100644 xgcl-2/Events.c create mode 100644 xgcl-2/README create mode 100644 xgcl-2/XStruct-2.c create mode 100644 xgcl-2/XStruct-4.c create mode 100644 xgcl-2/Xakcl.paper create mode 100644 xgcl-2/Xutil-2.c create mode 100644 xgcl-2/dec.copyright create mode 100644 xgcl-2/dwdoc.pdf create mode 100644 xgcl-2/dwdoc.tex create mode 100644 xgcl-2/dwdoc/dwdoc1.html create mode 100644 xgcl-2/dwdoc/dwdoc2.html create mode 100644 xgcl-2/dwdoc/dwdoc3.html create mode 100644 xgcl-2/dwdoc/dwdoccontents.html create mode 100644 xgcl-2/dwdoc/dwdocindex.html create mode 100644 xgcl-2/gcl_X.lsp create mode 100644 xgcl-2/gcl_X10.lsp create mode 100644 xgcl-2/gcl_XAtom.lsp create mode 100644 xgcl-2/gcl_XStruct_l_3.lsp create mode 100644 xgcl-2/gcl_Xakcl.example.lsp create mode 100644 xgcl-2/gcl_Xinit.lsp create mode 100644 xgcl-2/gcl_Xlib.lsp create mode 100644 xgcl-2/gcl_Xstruct.lsp create mode 100644 xgcl-2/gcl_Xutil.lsp create mode 100644 xgcl-2/gcl_defentry_events.lsp create mode 100644 xgcl-2/gcl_dispatch-events.lsp create mode 100644 xgcl-2/gcl_draw-gates.lsp create mode 100644 xgcl-2/gcl_draw.lsp create mode 100644 xgcl-2/gcl_drawtrans.lsp create mode 100644 xgcl-2/gcl_dwexports.lsp create mode 100644 xgcl-2/gcl_dwimports.lsp create mode 100644 xgcl-2/gcl_dwimportsb.lsp create mode 100644 xgcl-2/gcl_dwindow.lsp create mode 100644 xgcl-2/gcl_dwsyms.lsp create mode 100644 xgcl-2/gcl_dwtest.lsp create mode 100644 xgcl-2/gcl_dwtestcases.lsp create mode 100644 xgcl-2/gcl_dwtrans.lsp create mode 100644 xgcl-2/gcl_editors.lsp create mode 100644 xgcl-2/gcl_editorstrans.lsp create mode 100644 xgcl-2/gcl_general.lsp create mode 100644 xgcl-2/gcl_ice-cream.lsp create mode 100644 xgcl-2/gcl_imports.lsp create mode 100644 xgcl-2/gcl_index.lsp create mode 100644 xgcl-2/gcl_init_xgcl.lsp create mode 100644 xgcl-2/gcl_keysymdef.lsp create mode 100644 xgcl-2/gcl_lispserver.lsp create mode 100644 xgcl-2/gcl_lispservertrans.lsp create mode 100644 xgcl-2/gcl_menu-set.lsp create mode 100644 xgcl-2/gcl_menu-settrans.lsp create mode 100644 xgcl-2/gcl_pcalc.lsp create mode 100644 xgcl-2/gcl_sysinit.lsp create mode 100644 xgcl-2/gcl_tohtml.lsp create mode 100644 xgcl-2/general-c.c create mode 100644 xgcl-2/gnu.license create mode 100644 xgcl-2/makefile create mode 100644 xgcl-2/package.lisp create mode 100644 xgcl-2/sys-proclaim.lisp create mode 100644 xgcl-2/sysdef.lisp create mode 100644 xgcl-2/version diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3950896 --- /dev/null +++ b/.gitignore @@ -0,0 +1,10 @@ +TAGS +config.log +config.status +gcl.script +machine +makedefc +makedefs +makedefsafter +cmpinclude.h +autom4te.cache/ diff --git a/AC_FD_CC b/AC_FD_CC new file mode 100644 index 0000000..80cb3b6 --- /dev/null +++ b/AC_FD_CC @@ -0,0 +1,10 @@ +#line 40 "configure" +#include "confdefs.h" +#include +main() +{ + char *b = (void *) malloc(1000); + FILE *fp = fopen("conftest1","w"); + fprintf(fp,"0x%x",((unsigned int) b) & ~0xffffff); + fclose(fp); +} diff --git a/AC_FD_MSG b/AC_FD_MSG new file mode 100644 index 0000000..5888ea1 --- /dev/null +++ b/AC_FD_MSG @@ -0,0 +1 @@ +got 0 diff --git a/COPYING.LIB-2.0 b/COPYING.LIB-2.0 new file mode 100755 index 0000000..eb685a5 --- /dev/null +++ b/COPYING.LIB-2.0 @@ -0,0 +1,481 @@ + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called "this License"). Each licensee is +addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also compile or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + c) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + d) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library 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 + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/ChangeLog b/ChangeLog new file mode 100755 index 0000000..8907521 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,532 @@ +2006-10-26 Gabriel Dos Reis + + * configure.in: Don't be overly eager about setting INFO_DIR. + Fix quotations, as new Autoconf are pickier. + + * configure: Regenerate. + +2002-01-25 Camm Maguire + + * /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/ChangeLog.orig: + *** empty log message *** + +2002-01-24 Camm Maguire + + * /cvsroot/gcl/gcl/o/alloc.c, /cvsroot/gcl/gcl/o/sfaslelf.c: + Get bfd initialization to bypass malloc + + * /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/sys_gcl.c, /cvsroot/gcl/gcl/lsp/defpackage.c, /cvsroot/gcl/gcl/lsp/defpackage.data, /cvsroot/gcl/gcl/lsp/defpackage.h, /cvsroot/gcl/gcl/lsp/defpackage.lsp, /cvsroot/gcl/gcl/lsp/make_defpackage.c, /cvsroot/gcl/gcl/lsp/make_defpackage.data, /cvsroot/gcl/gcl/lsp/make_defpackage.h, /cvsroot/gcl/gcl/lsp/make_defpackage.lsp, /cvsroot/gcl/gcl/lsp/makefile: + Defpackage support + +2002-01-23 Camm Maguire + + * /cvsroot/gcl/gcl/o/mingfile.c, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/h/minglacks.h, /cvsroot/gcl/gcl/h/mingw.h: + Mingw support fixes + +2002-01-20 Camm Maguire + + * /cvsroot/gcl/gcl/gcl.png: gif -> png for logo + +2002-01-18 Camm Maguire + + * /cvsroot/gcl/gcl/lsp/destructuring_bind.c, /cvsroot/gcl/gcl/lsp/destructuring_bind.data, /cvsroot/gcl/gcl/lsp/destructuring_bind.h, /cvsroot/gcl/gcl/lsp/destructuring_bind.lsp, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/sys_gcl.c: + Add support for destructuring-bind + +2002-01-15 Camm Maguire + + * /cvsroot/gcl/gcl/h/gnuwin95.h, /cvsroot/gcl/gcl/o/unexnt.c: + Changes to get a preliminary NT build + +2002-01-13 Camm Maguire + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + Emacs site list dir fix + +2002-01-11 Camm Maguire + + * /cvsroot/gcl/gcl/cmpnew/lfun_list.lsp, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/lsp/stdlisp.lsp, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/new_init.c: + Added (quit) and (exit) as synonyms to (bye) + + * /cvsroot/gcl/gcl/gmp/assert.c, /cvsroot/gcl/gcl/gmp/extract-dbl.c, /cvsroot/gcl/gcl/gmp/gmp-impl.h, /cvsroot/gcl/gcl/gmp/mpn/generic/gcdext.c, /cvsroot/gcl/gcl/gmp/mpn/generic/tdiv_qr.c, /cvsroot/gcl/gcl/gmp/mpn/tests/addmul_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/add_n.c, /cvsroot/gcl/gcl/gmp/mpn/tests/copy.c, /cvsroot/gcl/gcl/gmp/mpn/tests/divmod_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/divrem.c, /cvsroot/gcl/gcl/gmp/mpn/tests/lshift.c, /cvsroot/gcl/gcl/gmp/mpn/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/mpn/tests/mul_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/rshift.c, /cvsroot/gcl/gcl/gmp/mpn/tests/submul_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/sub_n.c, /cvsroot/gcl/gcl/gmp/mpz/bin_uiui.c, /cvsroot/gcl/gcl/gmp/mpz/fac_ui.c, /cvsroot/gcl/gcl/gmp/mpz/pprime_p.c, /cvsroot/gcl/gcl/gmp/mpz/root.c, /cvsroot/gcl/gcl/gmp/mpz/set_d.c, /cvsroot/gcl/gcl/gmp/mpz/tests/bit.c, /cvsroot/gcl/gcl/gmp/mpz/tests/convert.c, /cvsroot/gcl/gcl/gmp/mpz/tests/dive.c, /cvsroot/gcl/gcl/gmp/mpz/tests/io.c, /cvsroot/gcl/gcl/gmp/mpz/tests/logic.c, /cvsroot/gcl/gcl/gmp/mpz/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/mpz/tests/reuse.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-2exp.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-bin.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-fdiv.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-fdiv_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-gcd.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-jac.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-misc.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-mul.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-powm.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-powm_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-pow_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-root.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-sqrtrem.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-tdiv.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-tdiv_ui.c, /cvsroot/gcl/gcl/gmp/randlc.c, /cvsroot/gcl/gcl/gmp/randraw.c, /cvsroot/gcl/gcl/gmp/urandom.h: + Changes submitted by Robert Byer for VMS (thanks\!) + +2002-01-10 Camm Maguire + + * /cvsroot/gcl/gcl/o/eval.c, /cvsroot/gcl/gcl/o/funlink.c, /cvsroot/gcl/gcl/h/object.h: + Fix function definitions to be more portable, enables build on m68k + +2002-01-09 Camm Maguire + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + Need 'return 0' at end of tests for DBEGIN and CSTACK_ADDRESS for sparc + + * /cvsroot/gcl/gcl/info/makefile: + Removed info files from tree, created now at build time from texi files + +2002-01-08 Camm Maguire + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + Better arm config support + + * /cvsroot/gcl/gcl/h/arm-linux.defs, /cvsroot/gcl/gcl/h/arm-linux.h, /cvsroot/gcl/gcl/h/m68k-linux.defs, /cvsroot/gcl/gcl/h/m68k-linux.h: + New arm and m68k machine files + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + Added configuration support for linux architectures + +2002-01-07 Camm Maguire + + * /cvsroot/gcl/gcl/h/gclincl.h.in, /cvsroot/gcl/gcl/h/notcomp.h, /cvsroot/gcl/gcl/o/sfasl.c, /cvsroot/gcl/gcl/o/sfaslelf.c, /cvsroot/gcl/gcl/o/sfasli.c, /cvsroot/gcl/gcl/acconfig.h: + BFD library support for relocations + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + Changes to better detect tcl/tk locations + + * /cvsroot/gcl/gcl/h/386-linux.defs: + Optimization flags by default in 386-linux.defs + + * /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/386-linux.defs, /cvsroot/gcl/gcl/h/386-linux.h, /cvsroot/gcl/gcl/info/gcl-si.info, /cvsroot/gcl/gcl/info/gcl-tk.info, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/alloc.c, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/makefile: + Removed some build-generated files + +2002-01-06 Camm Maguire + + * /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/unexelf.c, /cvsroot/gcl/gcl/unixport/rsym_elf.c: + Refinement to max stack size handling, better fix to unexelf section numbering bug, revert sigsetjmp change in rsym_elf.c + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + configure changes to detect newer as well as older tcl/tk libraries + + * /cvsroot/gcl/gcl/o/unexelf.c: + Protect against sh_info=0, causing occasional segfaults, in unexelf.c + +2002-01-04 Camm Maguire + + * /cvsroot/gcl/gcl/unixport/rsym_elf.c: + _setjmp -> __sigsetjmp for glibc systems in rsym_elf.c + + * /cvsroot/gcl/gcl/o/main.c: + Protect against unlimited stack resource environments + + * /cvsroot/gcl/gcl/unixport/rsym_elf.c: + _setjmp -> __sigsetjmp for glibc systems in rsym_elf.c + +2001-12-29 Camm Maguire + + * /cvsroot/gcl/gcl/ChangeLog: *** empty log message *** + + * /cvsroot/gcl/gcl/unixport/makefile: + Added DESTDIR to makefiles to support installing under arbitrary subdir; good 'clean' targets; correct building in absence of tcl/tk + + * /cvsroot/gcl/gcl/gcl-tk/makefile: + Add gcl-tk/demos/index.lsp to clean target + + * /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/makefile: + Added DESTDIR to makefiles to support installing under arbitrary subdir; good 'clean' targets; correct building in absence of tcl/tk + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/elisp/makefile: + changes to configure.in and elisp/makefile to handle emacs not being present + + * /cvsroot/gcl/gcl/gmp/ltconfig: + fix to gmp/ltconfig to avoid exec'ing empty string + + * /cvsroot/gcl/gcl/gmp/configure, /cvsroot/gcl/gcl/gmp/configure.in: + gmp/configure.in update for darwin + + * /cvsroot/gcl/gcl/gmp/ltconfig: + fix to gmp/ltconfig to avoid exec'ing empty string + + * /cvsroot/gcl/gcl/gmp/configure, /cvsroot/gcl/gcl/gmp/configure.in: + gmp/configure.in update for darwin + +2001-12-21 Camm Maguire + + * /cvsroot/gcl/gcl/debian/changelog, /cvsroot/gcl/gcl/debian/control, /cvsroot/gcl/gcl/debian/emacsen-startup, /cvsroot/gcl/gcl/debian/gcl-doc.dirs, /cvsroot/gcl/gcl/debian/gcl-doc.doc-base.si, /cvsroot/gcl/gcl/debian/gcl-doc.doc-base.tk, /cvsroot/gcl/gcl/debian/rules, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/debian/copyright, /cvsroot/gcl/gcl/debian/emacsen-install, /cvsroot/gcl/gcl/debian/emacsen-remove, /cvsroot/gcl/gcl/debian/gcl.dirs, /cvsroot/gcl/gcl/debian/gcl-doc.doc-base, /cvsroot/gcl/gcl/debian/gcl-doc.docs, /cvsroot/gcl/gcl/debian/gcl-doc.files, /cvsroot/gcl/gcl/debian/gcl.files, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/info/texinfo.tex, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/man/man1/gcl.1, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/makefile: + Many changes to get Debian package to build cleanly + +2001-12-20 Camm Maguire + + * /cvsroot/gcl/gcl/ChangeLog: remove more build-generated files + + * /cvsroot/gcl/gcl/h/gnuwin95.h: Apply fopen patch + + * /cvsroot/gcl/gcl/debian/all-files, /cvsroot/gcl/gcl/debian/changelog, /cvsroot/gcl/gcl/debian/clean, /cvsroot/gcl/gcl/debian/control, /cvsroot/gcl/gcl/debian/control.withtk, /cvsroot/gcl/gcl/debian/copyright, /cvsroot/gcl/gcl/debian/dirs, /cvsroot/gcl/gcl/debian/docs, /cvsroot/gcl/gcl/debian/gcl-doc.info, /cvsroot/gcl/gcl/debian/gcl.substvars, /cvsroot/gcl/gcl/debian/manpages, /cvsroot/gcl/gcl/debian/postinst, /cvsroot/gcl/gcl/debian/rules, /cvsroot/gcl/gcl/debian/texi.awk: + Initial upload of debian package building subdir + + * /cvsroot/gcl/gcl/tests/alltest.tst, /cvsroot/gcl/gcl/tests/array.tst, /cvsroot/gcl/gcl/tests/backquot.tst, /cvsroot/gcl/gcl/tests/characters.tst, /cvsroot/gcl/gcl/tests/eval20.tst, /cvsroot/gcl/gcl/tests/format.tst, /cvsroot/gcl/gcl/tests/GNU-GPL, /cvsroot/gcl/gcl/tests/hashlong.tst, /cvsroot/gcl/gcl/tests/hash.tst, /cvsroot/gcl/gcl/tests/iofkts.tst, /cvsroot/gcl/gcl/tests/lambda.tst, /cvsroot/gcl/gcl/tests/lists151.tst, /cvsroot/gcl/gcl/tests/lists152.tst, /cvsroot/gcl/gcl/tests/lists153.tst, /cvsroot/gcl/gcl/tests/lists154.tst, /cvsroot/gcl/gcl/tests/lists155.tst, /cvsroot/gcl/gcl/tests/lists156.tst, /cvsroot/gcl/gcl/tests/macro8.tst, /cvsroot/gcl/gcl/tests/Makefile, /cvsroot/gcl/gcl/tests/map.tst, /cvsroot/gcl/gcl/tests/number.tst, /cvsroot/gcl/gcl/tests/pack11.tst, /cvsroot/gcl/gcl/tests/path.tst, /cvsroot/gcl/gcl/tests/README, /cvsroot/gcl/gcl/tests/readtable.tst, /cvsroot/gcl/gcl/tests/setf.tst, /cvsroot/gcl/gcl/tests/steele7.tst, /cvsroot/gcl/gcl/tests/streamslong.tst, /cvsroot/gcl/gcl/tests/streams.tst, /cvsroot/gcl/gcl/tests/strings.tst, /cvsroot/gcl/gcl/tests/symbol10.tst, /cvsroot/gcl/gcl/tests/symbols.tst, /cvsroot/gcl/gcl/tests/tests.lsp, /cvsroot/gcl/gcl/tests/tprint.tst, /cvsroot/gcl/gcl/tests/tread.tst, /cvsroot/gcl/gcl/tests/type.tst: + Initial upload of cltl1 tests used by clisp -- needs #+ and #- for gcl + + * /cvsroot/gcl/gcl/makefile: Make distclean on gmp non-fatal + + * /cvsroot/gcl/gcl/info/compile.texi, /cvsroot/gcl/gcl/info/io.texi, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/info/number.texi, /cvsroot/gcl/gcl/info/sequence.texi, /cvsroot/gcl/gcl/info/si-defs.texi: + Clean target for docs, build all docs, fix texinfo errors + + * /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/makefile: + Got clean targets working so as not to leave any non-CVS files in tree after build (and clean) + + * /cvsroot/gcl/gcl/makefile: + Fixed makefile to build without tcl/tk if not found in configure + + * /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/demos/index.lsp, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/386-linux.defs, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/h/gclincl.h.in, /cvsroot/gcl/gcl/info/gcl-tk.info, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/lsp/readline.c, /cvsroot/gcl/gcl/lsp/readline.data, /cvsroot/gcl/gcl/lsp/readline.h, /cvsroot/gcl/gcl/lsp/readline.lsp, /cvsroot/gcl/gcl/lsp/serror.c, /cvsroot/gcl/gcl/lsp/serror.data, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/readline.d, /cvsroot/gcl/gcl/unixport/init_gcl.lsp, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/acconfig.h, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/makedefc.in, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/minvers: + Integrated dynamic readline support, activated at runtime with (si::init-readline) + +2001-12-19 Camm Maguire + + * /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/file.d, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/unixport/init_gcl.lsp, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/makefile: + Merge bugfixes from current + +2001-12-18 Camm Maguire + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + FCNTL check opens bad file 'jim', now opens configure.in read-only + + * /cvsroot/gcl/gcl/o/big.c, /cvsroot/gcl/gcl/o/cmpaux.c, /cvsroot/gcl/gcl/o/fasldlsym.c, /cvsroot/gcl/gcl/o/fat_string.c, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/print.d, /cvsroot/gcl/gcl/o/symbol.d, /cvsroot/gcl/gcl/o/try.c, /cvsroot/gcl/gcl/o/unixfsys.c, /cvsroot/gcl/gcl/unixport/rsym_nt.c, /cvsroot/gcl/gcl/unixport/tryserv.tcl, /cvsroot/gcl/gcl/bin/append.c, /cvsroot/gcl/gcl/bin/dpp.c, /cvsroot/gcl/gcl/bin/file-sub.c, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/elisp/smart-complete.el, /cvsroot/gcl/gcl/gcl-tk/decode.tcl, /cvsroot/gcl/gcl/gcl-tk/gcltksrv.in.interp, /cvsroot/gcl/gcl/gcl-tk/ngcltksrv, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/h/coff/i386.h, /cvsroot/gcl/gcl/h/cyglacks.h, /cvsroot/gcl/gcl/h/gnuwin95.defs, /cvsroot/gcl/gcl/h/gnuwin95.h, /cvsroot/gcl/gcl/h/num_include.h, /cvsroot/gcl/gcl/info/control.texi, /cvsroot/gcl/gcl/info/gcl-si.texi, /cvsroot/gcl/gcl/makdefs, /cvsroot/gcl/gcl/readme.mingw: + Merge current bugfixes into 2.5.0 + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + s/cygwin32/ cygwin\*/ in configure + + * /cvsroot/gcl/gcl/h/gnuwin95.defs: Tidy up h/gnuwin95.defs + + * /cvsroot/gcl/gcl/h/cyglacks.h: Remove cruft from h/cyglacks.h + + * /cvsroot/gcl/gcl/h/gnuwin95.h: Tidy up h/gnuwin95.defs + + * /cvsroot/gcl/gcl/h/coff/i386.h: Remove cruft from h/coff/i386.h + + * /cvsroot/gcl/gcl/o/print.d: Prototype definition for coerce_stream + + * /cvsroot/gcl/gcl/o/fat_string.c: + Compiler warning cleanup, strings end with char 0, not NULL + + * /cvsroot/gcl/gcl/info/control.texi, /cvsroot/gcl/gcl/info/gcl-si.texi: + Minor changes to .texi files to compile cleanly on standard texinfo installations + + * /cvsroot/gcl/gcl/h/num_include.h: + Clear up a compiler warning with MOST_NEGATIVE_FIX + + * /cvsroot/gcl/gcl/gcl-tk/gcltksrv.in.interp, /cvsroot/gcl/gcl/gcl-tk/ngcltksrv: + Remove version dependence on wish in shell scripts -- if need a dependency, will put in configure later + + * /cvsroot/gcl/gcl/elisp/smart-complete.el: + Rename split-string to split-string-gcl to avoid name conflicts with other elisp packages + + * /cvsroot/gcl/gcl/bin/dpp.c, /cvsroot/gcl/gcl/bin/file-sub.c, /cvsroot/gcl/gcl/o/cmpaux.c, /cvsroot/gcl/gcl/o/fasldlsym.c, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/symbol.d, /cvsroot/gcl/gcl/o/unixfsys.c: + Added missing headers for str... and exit standard functions + + * /cvsroot/gcl/gcl/bin/append.c, /cvsroot/gcl/gcl/gcl-tk/decode.tcl, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/h/cyglacks.h, /cvsroot/gcl/gcl/o/big.c, /cvsroot/gcl/gcl/o/try.c, /cvsroot/gcl/gcl/unixport/rsym_nt.c, /cvsroot/gcl/gcl/unixport/tryserv.tcl, /cvsroot/gcl/gcl/makdefs, /cvsroot/gcl/gcl/readme.mingw: + Removed CR from all compilable files; removed one useless file + +2001-12-17 Camm Maguire + + * /cvsroot/gcl/gcl/config.guess, /cvsroot/gcl/gcl/config.sub: + New versions of config.sub and config.guess + +2001-12-16 Camm Maguire + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + Allow setting compiler in CC env variable + + * /cvsroot/gcl/gcl/h/compbas2.h, /cvsroot/gcl/gcl/o/alloc.c, /cvsroot/gcl/gcl/o/file.d: + Commented labels at end of #endifs + + * /cvsroot/gcl/gcl/h/ptable.h: removed carriage returns + +2001-12-15 Camm Maguire + + * /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/pa7100/addmul_1.S, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/pa7100/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/pa7100/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/pa7100/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/pa7100/submul_1.S, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/pa7100/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v8/supersparc/udiv.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/k62mmx/copyd.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/k62mmx/copyi.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/k62mmx/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/k62mmx/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/mmx/com_n.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/mmx/logops_n.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/mmx/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/mmx/popham.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/mmx/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mmx/copyd.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mmx/copyi.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mmx/divrem_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mmx/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mmx/mod_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mmx/popham.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mmx/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/mmx/divrem_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/mmx/mod_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/mmx/popham.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/p3mmx/popham.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/mmx/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/mmx/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/mmx/popham.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/mmx/rshift.asm, /cvsroot/gcl/gcl/gmp/mpbsd/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/mpfr/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/mpf/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/mpn/alpha/ev5/add_n.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/ev5/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/ev5/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/ev5/sub_n.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/ev6/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/ev6/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/udiv_qrnnd.S, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa1_1/umul.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa2_0/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/hppa2_0/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/m68k/mc68020/addmul_1.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/mc68020/mul_1.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/mc68020/submul_1.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/mc68020/udiv.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/mc68020/umul.S, /cvsroot/gcl/gcl/gmp/mpn/m88k/mc88110/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/m88k/mc88110/add_n.S, /cvsroot/gcl/gcl/gmp/mpn/m88k/mc88110/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/m88k/mc88110/sub_n.S, /cvsroot/gcl/gcl/gmp/mpn/sh/sh2/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/sh/sh2/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/sh/sh2/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v8/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v8/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v8/submul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v8/umul.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v9/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v9/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v9/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v9/README, /cvsroot/gcl/gcl/gmp/mpn/sparc32/v9/submul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/aorsmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/aors_n.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/cross.pl, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/diveby3.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/mul_basecase.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/README, /cvsroot/gcl/gcl/gmp/mpn/x86/k6/sqr_basecase.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/aorsmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/aors_n.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/diveby3.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/mul_basecase.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/README, /cvsroot/gcl/gcl/gmp/mpn/x86/k7/sqr_basecase.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/aorsmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/diveby3.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/README, /cvsroot/gcl/gcl/gmp/mpn/x86/p6/sqr_basecase.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/aorsmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/aors_n.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/diveby3.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/mul_basecase.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/README, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/pentium/sqr_basecase.asm, /cvsroot/gcl/gcl/gmp/mpq/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/tests/rand/Makefile.in, /cvsroot/gcl/gcl/gmp/mpn/tests/submul_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/sub_n.c, /cvsroot/gcl/gcl/gmp/mpn/tests/trace.c, /cvsroot/gcl/gcl/gmp/mpn/tests/try.c, /cvsroot/gcl/gcl/gmp/mpn/tests/try.h, /cvsroot/gcl/gcl/gmp/mpn/tests/tst-addsub.c, /cvsroot/gcl/gcl/gmp/mpn/tests/x86call.asm, /cvsroot/gcl/gcl/gmp/mpn/tests/x86check.c, /cvsroot/gcl/gcl/gmp/mpn/thumb/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/thumb/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/vax/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/vax/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/vax/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/vax/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/vax/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/vax/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/vax/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/x86/addsub_n.S, /cvsroot/gcl/gcl/gmp/mpn/x86/aorsmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/aors_n.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/copyd.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/copyi.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/diveby3.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/divrem_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/mod_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/mul_basecase.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/README, /cvsroot/gcl/gcl/gmp/mpn/x86/README.family, /cvsroot/gcl/gcl/gmp/mpn/x86/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/udiv.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/umul.asm, /cvsroot/gcl/gcl/gmp/mpn/x86/x86-defs.m4, /cvsroot/gcl/gcl/gmp/mpn/z8000/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/z8000/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/z8000/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/z8000/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/z8000x/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/z8000x/sub_n.s, /cvsroot/gcl/gcl/gmp/mpq/Makefile.in, /cvsroot/gcl/gcl/gmp/mpz/tests/bit.c, /cvsroot/gcl/gcl/gmp/mpz/tests/convert.c, /cvsroot/gcl/gcl/gmp/mpz/tests/dive.c, /cvsroot/gcl/gcl/gmp/mpz/tests/io.c, /cvsroot/gcl/gcl/gmp/mpz/tests/logic.c, /cvsroot/gcl/gcl/gmp/mpz/tests/Makefile.am, /cvsroot/gcl/gcl/gmp/mpz/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/mpz/tests/reuse.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-2exp.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-bin.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-fdiv.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-fdiv_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-gcd.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-jac.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-misc.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-mul.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-powm.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-powm_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-pow_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-root.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-sqrtrem.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-tdiv.c, /cvsroot/gcl/gcl/gmp/mpz/tests/t-tdiv_ui.c, /cvsroot/gcl/gcl/gmp/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/tune/Makefile.in, /cvsroot/gcl/gcl/gmp/demos/Makefile.in, /cvsroot/gcl/gcl/gmp/macos/Makefile.in, /cvsroot/gcl/gcl/gmp/mpbsd/Makefile.in, /cvsroot/gcl/gcl/gmp/mpf/Makefile.in, /cvsroot/gcl/gcl/gmp/mpfr/Makefile.in, /cvsroot/gcl/gcl/gmp/mpn/a29k/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/udiv.s, /cvsroot/gcl/gcl/gmp/mpn/a29k/umul.s, /cvsroot/gcl/gcl/gmp/mpn/alpha/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/add_n.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/cntlz.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/default.m4, /cvsroot/gcl/gcl/gmp/mpn/alpha/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/alpha/invert_limb.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/README, /cvsroot/gcl/gcl/gmp/mpn/alpha/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/submul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/sub_n.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/udiv_qrnnd.S, /cvsroot/gcl/gcl/gmp/mpn/alpha/umul.asm, /cvsroot/gcl/gcl/gmp/mpn/alpha/unicos.m4, /cvsroot/gcl/gcl/gmp/mpn/arm/addmul_1.S, /cvsroot/gcl/gcl/gmp/mpn/arm/add_n.S, /cvsroot/gcl/gcl/gmp/mpn/arm/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/arm/mul_1.S, /cvsroot/gcl/gcl/gmp/mpn/arm/sub_n.S, /cvsroot/gcl/gcl/gmp/mpn/clipper/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/clipper/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/clipper/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/cray/addmul_1.c, /cvsroot/gcl/gcl/gmp/mpn/cray/add_n.c, /cvsroot/gcl/gcl/gmp/mpn/cray/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/cray/mul_1.c, /cvsroot/gcl/gcl/gmp/mpn/cray/mulww.f, /cvsroot/gcl/gcl/gmp/mpn/cray/mulww.s, /cvsroot/gcl/gcl/gmp/mpn/cray/README, /cvsroot/gcl/gcl/gmp/mpn/cray/submul_1.c, /cvsroot/gcl/gcl/gmp/mpn/cray/sub_n.c, /cvsroot/gcl/gcl/gmp/mpn/hppa/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/hppa/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/README, /cvsroot/gcl/gcl/gmp/mpn/hppa/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/hppa/udiv_qrnnd.s, /cvsroot/gcl/gcl/gmp/mpn/i960/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/i960/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/i960/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/i960/README, /cvsroot/gcl/gcl/gmp/mpn/i960/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/lisp/gmpasm-mode.el, /cvsroot/gcl/gcl/gmp/mpn/m68k/add_n.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/lshift.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/rshift.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/sub_n.S, /cvsroot/gcl/gcl/gmp/mpn/m68k/syntax.h, /cvsroot/gcl/gcl/gmp/mpn/m88k/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/m88k/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/m88k/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/mips2/umul.s, /cvsroot/gcl/gcl/gmp/mpn/mips3/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/mips3/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/mips3/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/mips3/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/mips3/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/mips3/README, /cvsroot/gcl/gcl/gmp/mpn/mips3/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/mips3/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/mips3/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/ns32k/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/ns32k/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/ns32k/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/ns32k/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/ns32k/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/pa64/addmul_1.S, /cvsroot/gcl/gcl/gmp/mpn/pa64/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/pa64/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/pa64/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/pa64/mul_1.S, /cvsroot/gcl/gcl/gmp/mpn/pa64/README, /cvsroot/gcl/gcl/gmp/mpn/pa64/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/pa64/submul_1.S, /cvsroot/gcl/gcl/gmp/mpn/pa64/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/pa64/udiv_qrnnd.c, /cvsroot/gcl/gcl/gmp/mpn/pa64/umul_ppmm.S, /cvsroot/gcl/gcl/gmp/mpn/pa64w/addmul_1.S, /cvsroot/gcl/gcl/gmp/mpn/pa64w/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/pa64w/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/pa64w/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/pa64w/mul_1.S, /cvsroot/gcl/gcl/gmp/mpn/pa64w/README, /cvsroot/gcl/gcl/gmp/mpn/pa64w/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/pa64w/submul_1.S, /cvsroot/gcl/gcl/gmp/mpn/pa64w/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/pa64w/udiv_qrnnd.c, /cvsroot/gcl/gcl/gmp/mpn/pa64w/umul_ppmm.S, /cvsroot/gcl/gcl/gmp/mpn/power/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/power/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/power/lshift.s, /cvsroot/gcl/gcl/gmp/mpn/power/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/add_n.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/aix.m4, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/regmap.m4, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/submul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/sub_n.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc32/umul.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/add_n.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/addsub_n.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/aix.m4, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/copyd.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/copyi.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/README, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/submul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/powerpc64/sub_n.asm, /cvsroot/gcl/gcl/gmp/mpn/power/rshift.s, /cvsroot/gcl/gcl/gmp/mpn/power/sdiv.s, /cvsroot/gcl/gcl/gmp/mpn/power/submul_1.s, /cvsroot/gcl/gcl/gmp/mpn/power/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/power/umul.s, /cvsroot/gcl/gcl/gmp/mpn/pyr/addmul_1.s, /cvsroot/gcl/gcl/gmp/mpn/pyr/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/pyr/mul_1.s, /cvsroot/gcl/gcl/gmp/mpn/pyr/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/sh/add_n.s, /cvsroot/gcl/gcl/gmp/mpn/sh/sub_n.s, /cvsroot/gcl/gcl/gmp/mpn/sparc32/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/add_n.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/README, /cvsroot/gcl/gcl/gmp/mpn/sparc32/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/submul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/sub_n.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/udiv_fp.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/udiv_nfp.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc32/umul.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/addmul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/addmul1h.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/add_n.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/copyi.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/sparc64/lshift.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/mul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/mul_1h.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/README, /cvsroot/gcl/gcl/gmp/mpn/sparc64/rshift.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/submul_1.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/submul1h.asm, /cvsroot/gcl/gcl/gmp/mpn/sparc64/sub_n.asm, /cvsroot/gcl/gcl/gmp/mpn/tests/addmul_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/add_n.c, /cvsroot/gcl/gcl/gmp/mpn/tests/copy.c, /cvsroot/gcl/gcl/gmp/mpn/tests/divmod_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/divrem.c, /cvsroot/gcl/gcl/gmp/mpn/tests/lshift.c, /cvsroot/gcl/gcl/gmp/mpn/tests/Makefile.am, /cvsroot/gcl/gcl/gmp/mpn/tests/Makefile.in, /cvsroot/gcl/gcl/gmp/mpn/tests/mul_1.c, /cvsroot/gcl/gcl/gmp/mpn/tests/README, /cvsroot/gcl/gcl/gmp/mpn/tests/ref.c, /cvsroot/gcl/gcl/gmp/mpn/tests/ref.h, /cvsroot/gcl/gcl/gmp/mpn/tests/rshift.c, /cvsroot/gcl/gcl/gmp/mpn/tests/spinner.c, /cvsroot/gcl/gcl/gmp/ansi2knr.c, /cvsroot/gcl/gcl/gmp/configure.in, /cvsroot/gcl/gcl/gmp/mpn/asm-defs.m4, /cvsroot/gcl/gcl/gmp/mpn/generic/addmul_1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/add_n.c, /cvsroot/gcl/gcl/gmp/mpn/generic/addsub_n.c, /cvsroot/gcl/gcl/gmp/mpn/generic/bdivmod.c, /cvsroot/gcl/gcl/gmp/mpn/generic/bz_divrem_n.c, /cvsroot/gcl/gcl/gmp/mpn/generic/cmp.c, /cvsroot/gcl/gcl/gmp/mpn/generic/diveby3.c, /cvsroot/gcl/gcl/gmp/mpn/generic/divrem_1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/divrem_2.c, /cvsroot/gcl/gcl/gmp/mpn/generic/divrem.c, /cvsroot/gcl/gcl/gmp/mpn/generic/dump.c, /cvsroot/gcl/gcl/gmp/mpn/generic/gcd_1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/gcd.c, /cvsroot/gcl/gcl/gmp/mpn/generic/gcdext.c, /cvsroot/gcl/gcl/gmp/mpn/generic/get_str.c, /cvsroot/gcl/gcl/gmp/mpn/generic/gmp-mparam.h, /cvsroot/gcl/gcl/gmp/mpn/generic/hamdist.c, /cvsroot/gcl/gcl/gmp/mpn/generic/inlines.c, /cvsroot/gcl/gcl/gmp/mpn/generic/jacbase.c, /cvsroot/gcl/gcl/gmp/mpn/generic/lshift.c, /cvsroot/gcl/gcl/gmp/mpn/generic/mod_1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/mod_1_rs.c, /cvsroot/gcl/gcl/gmp/mpn/generic/mul_1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/mul_basecase.c, /cvsroot/gcl/gcl/gmp/mpn/generic/mul.c, /cvsroot/gcl/gcl/gmp/mpn/generic/mul_fft.c, /cvsroot/gcl/gcl/gmp/mpn/generic/perfsqr.c, /cvsroot/gcl/gcl/gmp/mpn/generic/popcount.c, /cvsroot/gcl/gcl/gmp/mpn/generic/pre_mod_1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/random2.c, /cvsroot/gcl/gcl/gmp/mpn/generic/random.c, /cvsroot/gcl/gcl/gmp/mpn/generic/rshift.c, /cvsroot/gcl/gcl/gmp/mpn/generic/sb_divrem_mn.c, /cvsroot/gcl/gcl/gmp/mpn/generic/scan0.c, /cvsroot/gcl/gcl/gmp/mpn/generic/scan1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/set_str.c, /cvsroot/gcl/gcl/gmp/mpn/generic/sqr_basecase.c, /cvsroot/gcl/gcl/gmp/mpn/generic/sqrtrem.c, /cvsroot/gcl/gcl/gmp/mpn/generic/submul_1.c, /cvsroot/gcl/gcl/gmp/mpn/generic/sub_n.c, /cvsroot/gcl/gcl/gmp/mpn/generic/tdiv_qr.c, /cvsroot/gcl/gcl/gmp/mpn/generic/udiv_w_sdiv.c, /cvsroot/gcl/gcl/gmp/mpn/Makefile.am, /cvsroot/gcl/gcl/gmp/mpn/Makefile.in, /cvsroot/gcl/gcl/gmp/mpn/mp_bases.c, /cvsroot/gcl/gcl/gmp/mpn/README, /cvsroot/gcl/gcl/gmp/mpz/abs.c, /cvsroot/gcl/gcl/gmp/mpz/add.c, /cvsroot/gcl/gcl/gmp/mpz/addmul_ui.c, /cvsroot/gcl/gcl/gmp/mpz/add_ui.c, /cvsroot/gcl/gcl/gmp/mpz/and.c, /cvsroot/gcl/gcl/gmp/mpz/array_init.c, /cvsroot/gcl/gcl/gmp/mpz/bin_ui.c, /cvsroot/gcl/gcl/gmp/mpz/bin_uiui.c, /cvsroot/gcl/gcl/gmp/mpz/cdiv_q.c, /cvsroot/gcl/gcl/gmp/mpz/cdiv_qr.c, /cvsroot/gcl/gcl/gmp/mpz/cdiv_qr_ui.c, /cvsroot/gcl/gcl/gmp/mpz/cdiv_q_ui.c, /cvsroot/gcl/gcl/gmp/mpz/cdiv_r.c, /cvsroot/gcl/gcl/gmp/mpz/cdiv_r_ui.c, /cvsroot/gcl/gcl/gmp/mpz/cdiv_ui.c, /cvsroot/gcl/gcl/gmp/mpz/clear.c, /cvsroot/gcl/gcl/gmp/mpz/clrbit.c, /cvsroot/gcl/gcl/gmp/mpz/cmpabs.c, /cvsroot/gcl/gcl/gmp/mpz/cmpabs_ui.c, /cvsroot/gcl/gcl/gmp/mpz/cmp.c, /cvsroot/gcl/gcl/gmp/mpz/cmp_si.c, /cvsroot/gcl/gcl/gmp/mpz/cmp_ui.c, /cvsroot/gcl/gcl/gmp/mpz/com.c, /cvsroot/gcl/gcl/gmp/mpz/divexact.c, /cvsroot/gcl/gcl/gmp/mpz/dump.c, /cvsroot/gcl/gcl/gmp/mpz/fac_ui.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_q_2exp.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_q.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_qr.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_qr_ui.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_q_ui.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_r.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_r_ui.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_ui.c, /cvsroot/gcl/gcl/gmp/mpz/fib_ui.c, /cvsroot/gcl/gcl/gmp/mpz/fits_sint_p.c, /cvsroot/gcl/gcl/gmp/mpz/fits_slong_p.c, /cvsroot/gcl/gcl/gmp/mpz/fits_sshort_p.c, /cvsroot/gcl/gcl/gmp/mpz/fits_uint_p.c, /cvsroot/gcl/gcl/gmp/mpz/fits_ulong_p.c, /cvsroot/gcl/gcl/gmp/mpz/fits_ushort_p.c, /cvsroot/gcl/gcl/gmp/mpz/gcdext.c, /cvsroot/gcl/gcl/gmp/mpz/gcd_ui.c, /cvsroot/gcl/gcl/gmp/mpz/get_d.c, /cvsroot/gcl/gcl/gmp/mpz/getlimbn.c, /cvsroot/gcl/gcl/gmp/mpz/get_si.c, /cvsroot/gcl/gcl/gmp/mpz/get_str.c, /cvsroot/gcl/gcl/gmp/mpz/get_ui.c, /cvsroot/gcl/gcl/gmp/mpz/hamdist.c, /cvsroot/gcl/gcl/gmp/mpz/init.c, /cvsroot/gcl/gcl/gmp/mpz/inp_raw.c, /cvsroot/gcl/gcl/gmp/mpz/inp_str.c, /cvsroot/gcl/gcl/gmp/mpz/invert.c, /cvsroot/gcl/gcl/gmp/mpz/ior.c, /cvsroot/gcl/gcl/gmp/mpz/iset.c, /cvsroot/gcl/gcl/gmp/mpz/iset_d.c, /cvsroot/gcl/gcl/gmp/mpz/iset_si.c, /cvsroot/gcl/gcl/gmp/mpz/iset_str.c, /cvsroot/gcl/gcl/gmp/mpz/iset_ui.c, /cvsroot/gcl/gcl/gmp/mpz/jacobi.c, /cvsroot/gcl/gcl/gmp/mpz/kronsz.c, /cvsroot/gcl/gcl/gmp/mpz/kronuz.c, /cvsroot/gcl/gcl/gmp/mpz/kronzs.c, /cvsroot/gcl/gcl/gmp/mpz/kronzu.c, /cvsroot/gcl/gcl/gmp/mpz/lcm.c, /cvsroot/gcl/gcl/gmp/mpz/legendre.c, /cvsroot/gcl/gcl/gmp/mpz/Makefile.am, /cvsroot/gcl/gcl/gmp/mpz/Makefile.in, /cvsroot/gcl/gcl/gmp/mpz/mod.c, /cvsroot/gcl/gcl/gmp/mpz/mul_2exp.c, /cvsroot/gcl/gcl/gmp/mpz/mul_siui.c, /cvsroot/gcl/gcl/gmp/mpz/neg.c, /cvsroot/gcl/gcl/gmp/mpz/nextprime.c, /cvsroot/gcl/gcl/gmp/mpz/out_raw.c, /cvsroot/gcl/gcl/gmp/mpz/out_str.c, /cvsroot/gcl/gcl/gmp/mpz/perfpow.c, /cvsroot/gcl/gcl/gmp/mpz/perfsqr.c, /cvsroot/gcl/gcl/gmp/mpz/popcount.c, /cvsroot/gcl/gcl/gmp/mpz/powm.c, /cvsroot/gcl/gcl/gmp/mpz/powm_ui.c, /cvsroot/gcl/gcl/gmp/mpz/pow_ui.c, /cvsroot/gcl/gcl/gmp/mpz/pprime_p.c, /cvsroot/gcl/gcl/gmp/mpz/random2.c, /cvsroot/gcl/gcl/gmp/mpz/random.c, /cvsroot/gcl/gcl/gmp/mpz/README, /cvsroot/gcl/gcl/gmp/mpz/realloc.c, /cvsroot/gcl/gcl/gmp/mpz/remove.c, /cvsroot/gcl/gcl/gmp/mpz/root.c, /cvsroot/gcl/gcl/gmp/mpz/rrandomb.c, /cvsroot/gcl/gcl/gmp/mpz/scan0.c, /cvsroot/gcl/gcl/gmp/mpz/scan1.c, /cvsroot/gcl/gcl/gmp/mpz/setbit.c, /cvsroot/gcl/gcl/gmp/mpz/set.c, /cvsroot/gcl/gcl/gmp/mpz/set_d.c, /cvsroot/gcl/gcl/gmp/mpz/set_f.c, /cvsroot/gcl/gcl/gmp/mpz/set_q.c, /cvsroot/gcl/gcl/gmp/mpz/set_si.c, /cvsroot/gcl/gcl/gmp/mpz/set_str.c, /cvsroot/gcl/gcl/gmp/mpz/set_ui.c, /cvsroot/gcl/gcl/gmp/mpz/size.c, /cvsroot/gcl/gcl/gmp/mpz/sizeinbase.c, /cvsroot/gcl/gcl/gmp/mpz/sqrt.c, /cvsroot/gcl/gcl/gmp/mpz/sqrtrem.c, /cvsroot/gcl/gcl/gmp/mpz/sub.c, /cvsroot/gcl/gcl/gmp/mpz/sub_ui.c, /cvsroot/gcl/gcl/gmp/mpz/swap.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_q_2exp.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_q.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_qr.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_qr_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_q_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_r_2exp.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_r.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_r_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tdiv_ui.c, /cvsroot/gcl/gcl/gmp/mpz/tstbit.c, /cvsroot/gcl/gcl/gmp/mpz/ui_pow_ui.c, /cvsroot/gcl/gcl/gmp/mpz/urandomb.c, /cvsroot/gcl/gcl/gmp/mpz/urandomm.c, /cvsroot/gcl/gcl/gmp/mpz/xor.c: + Complete file additions for gmp configure and build + + * /cvsroot/gcl/gcl/gmp/ansi2knr.c, /cvsroot/gcl/gcl/gmp/assert.c, /cvsroot/gcl/gcl/gmp/compat.c, /cvsroot/gcl/gcl/gmp/config.guess, /cvsroot/gcl/gcl/gmp/config.in, /cvsroot/gcl/gcl/gmp/config.sub, /cvsroot/gcl/gcl/gmp/configure, /cvsroot/gcl/gcl/gmp/configure.in, /cvsroot/gcl/gcl/gmp/COPYING, /cvsroot/gcl/gcl/gmp/errno.c, /cvsroot/gcl/gcl/gmp/extract-dbl.c, /cvsroot/gcl/gcl/gmp/gmp.h, /cvsroot/gcl/gcl/gmp/gmp-impl.h, /cvsroot/gcl/gcl/gmp/insert-dbl.c, /cvsroot/gcl/gcl/gmp/install-sh, /cvsroot/gcl/gcl/gmp/longlong.h, /cvsroot/gcl/gcl/gmp/ltconfig, /cvsroot/gcl/gcl/gmp/ltmain.sh, /cvsroot/gcl/gcl/gmp/Makefile.in, /cvsroot/gcl/gcl/gmp/memory.c, /cvsroot/gcl/gcl/gmp/missing, /cvsroot/gcl/gcl/gmp/mp_bpl.c, /cvsroot/gcl/gcl/gmp/mp_clz_tab.c, /cvsroot/gcl/gcl/gmp/mp.h, /cvsroot/gcl/gcl/gmp/mp_minv_tab.c, /cvsroot/gcl/gcl/gmp/mp_set_fns.c, /cvsroot/gcl/gcl/gmp/rand.c, /cvsroot/gcl/gcl/gmp/randclr.c, /cvsroot/gcl/gcl/gmp/randlc2x.c, /cvsroot/gcl/gcl/gmp/randlc.c, /cvsroot/gcl/gcl/gmp/randraw.c, /cvsroot/gcl/gcl/gmp/randsd.c, /cvsroot/gcl/gcl/gmp/randsdui.c, /cvsroot/gcl/gcl/gmp/README, /cvsroot/gcl/gcl/gmp/stack-alloc.c, /cvsroot/gcl/gcl/gmp/stack-alloc.h, /cvsroot/gcl/gcl/gmp/urandom.h, /cvsroot/gcl/gcl/gmp/version.c: + gmp configure and build restoration + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in: + Run emacs with --no-site-file to avoid errors; default ix86 gmp target is i486 + + * /cvsroot/gcl/gcl/h/gmp.h: + Link needed to get gmp bignums working with new gmp_big.c file + + * /cvsroot/gcl/gcl/h/386-linux.h: + Patch submitted via email months ago by Dr. Schelter to enable reliable dynamic linking on i386 Linux + +2001-07-03 wfs + + * /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/h/gclincl.h: + fix to configure + +2001-06-06 wfs + + * /cvsroot/gcl/gcl/lsp/info.data, /cvsroot/gcl/gcl/lsp/info.lsp: + fix info to handle defunx + +2001-05-18 wfs + + * /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/o/gmp_big.c, /cvsroot/gcl/gcl/o/gmp.c, /cvsroot/gcl/gcl/o/gmp_num_log.c, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/pari_big.c, /cvsroot/gcl/gcl/o/pari_num_log.c, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/elisp/gcl.el, /cvsroot/gcl/gcl/h/mp.h: + changes for bignum code, now relocatable bignums ok, worked around bug in gmp code which does not detect 0 as fitting in an int + +2001-05-16 wfs + + * /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/h/mp.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/fat_string.c, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/new_init.c, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/makefile: + changes for gmp + +2001-05-15 wfs + + * /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/demos/index.lsp, /cvsroot/gcl/gcl/gcl-tk/gcltksrv, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/h/gclincl.h.in, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/num_log.c, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/cmpmain.lsp, /cvsroot/gcl/gcl/cmpnew/cmpopt.lsp, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/makefile: + fix to ash, and for buggy redhat/cygnus compiler + +2001-05-11 wfs + + * /cvsroot/gcl/gcl/readme.gmp, /cvsroot/gcl/gcl/readme.mingw, /cvsroot/gcl/gcl/unixport/init_gcl.lsp: + fix the error code on compile from command line + +2001-05-06 wfs + + * /cvsroot/gcl/gcl/gmp/mpn/generic/mul_n.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_r_2exp.c, /cvsroot/gcl/gcl/gmp/mpz/gcd.c, /cvsroot/gcl/gcl/gmp/mpz/mul.c: + changes to gmp from 3.1.1 for gcl + + * /cvsroot/gcl/gcl/add-defs1, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/cmpopt.lsp, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/dbl.el, /cvsroot/gcl/gcl/elisp/gcl.el, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/elisp/smart-complete.el, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/gmp/mpn/generic/mul_n.c, /cvsroot/gcl/gcl/gmp/mpz/fdiv_r_2exp.c, /cvsroot/gcl/gcl/gmp/mpz/gcd.c, /cvsroot/gcl/gcl/gmp/mpz/mul.c, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/386-linux.h, /cvsroot/gcl/gcl/h/att_ext.h, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/cmponly.h, /cvsroot/gcl/gcl/h/compbas2.h, /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/h/gclincl.h.in, /cvsroot/gcl/gcl/h/include.h, /cvsroot/gcl/gcl/h/mdefs.h, /cvsroot/gcl/gcl/h/mp.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/h/object.h, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/minvers, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/big.c, /cvsroot/gcl/gcl/o/cmac.c, /cvsroot/gcl/gcl/o/cmpaux.c, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/fasdump.c, /cvsroot/gcl/gcl/o/gbc.c, /cvsroot/gcl/gcl/o/hash.d, /cvsroot/gcl/gcl/o/init_pari.c, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/new_init.c, /cvsroot/gcl/gcl/o/num_arith.c, /cvsroot/gcl/gcl/o/number.c, /cvsroot/gcl/gcl/o/num_log.c, /cvsroot/gcl/gcl/o/num_pred.c, /cvsroot/gcl/gcl/o/print.d, /cvsroot/gcl/gcl/o/read.d, /cvsroot/gcl/gcl/o/sgbc.c, /cvsroot/gcl/gcl/o/unixfsys.c, /cvsroot/gcl/gcl/o/usig2_aux.c, /cvsroot/gcl/gcl/unixport/init_gcl.lsp, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/xbin/new-files: + many changes adding gmp bignums + +2001-04-17 wfs + + * /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/lsp/debug.c, /cvsroot/gcl/gcl/lsp/debug.data, /cvsroot/gcl/gcl/lsp/debug.h, /cvsroot/gcl/gcl/lsp/debug.lsp, /cvsroot/gcl/gcl/lsp/top.c, /cvsroot/gcl/gcl/lsp/top.data, /cvsroot/gcl/gcl/lsp/top.h, /cvsroot/gcl/gcl/lsp/top.lsp, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/new_init.c: + minor change to break-call + + * /cvsroot/gcl/gcl/o/sfaslelf.c, /cvsroot/gcl/gcl/unixport/rsym_nt.c, /cvsroot/gcl/gcl/add-defs1, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/cmpnew/cmpmain.lsp, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/h/mingw.defs, /cvsroot/gcl/gcl/h/mingw.h, /cvsroot/gcl/gcl/lsp/autoload.lsp, /cvsroot/gcl/gcl/lsp/debug.lsp: + removed the o/*.ini files since these are generated automatically. + fixed things in h/mingw.{h,defs}, made o/sfaslelf.c so it can + load things compiled under -O4 (since init_ is searched for), + repaired rsym_nt.c for mingw port + +2001-04-13 wfs + + * /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/h/386-linux.h, /cvsroot/gcl/gcl/h/notcomp.h: + changes for clisp, and to sysdef + +2001-03-22 wfs + + * /cvsroot/gcl/gcl/lsp/evalmacros.c, /cvsroot/gcl/gcl/lsp/evalmacros.data, /cvsroot/gcl/gcl/lsp/evalmacros.h, /cvsroot/gcl/gcl/lsp/evalmacros.lsp, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/unexelf.c: + Fix the unexelf to make the data section executable + +2001-02-24 wfs + + * /cvsroot/gcl/gcl/bin/append, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/gcl-tk/guis.c, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/h/386-linux.h, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/h/gclincl.h.in, /cvsroot/gcl/gcl/h/notcomp.h, /cvsroot/gcl/gcl/h/OpenBSD.defs, /cvsroot/gcl/gcl/h/OpenBSD.h, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/unexec.c, /cvsroot/gcl/gcl/xbin/new-files: + fix for debian, for stdout corruption after save + +2000-12-09 wfs + + * /cvsroot/gcl/gcl/add-defs1, /cvsroot/gcl/gcl/add-defs, /cvsroot/gcl/gcl/bin/append, /cvsroot/gcl/gcl/bin/file-sub.c, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/bin/winkill.c, /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/cmpmain.lsp, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/dbl.el, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/gcltksrv, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/coff/i386.h, /cvsroot/gcl/gcl/h/gclincl.h, /cvsroot/gcl/gcl/h/gnuwin95.h, /cvsroot/gcl/gcl/h/mingw.defs, /cvsroot/gcl/gcl/h/mingw.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/h/object.h, /cvsroot/gcl/gcl/h/wincoff.h, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/info.c, /cvsroot/gcl/gcl/lsp/info.lsp, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/lsp/top.c, /cvsroot/gcl/gcl/lsp/top.data, /cvsroot/gcl/gcl/lsp/top.h, /cvsroot/gcl/gcl/lsp/top.lsp, /cvsroot/gcl/gcl/makedefc.in, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/minvers, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/file.d, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/mingwin.c, /cvsroot/gcl/gcl/o/new_init.c, /cvsroot/gcl/gcl/o/nsocket.c, /cvsroot/gcl/gcl/o/pathname.d, /cvsroot/gcl/gcl/o/read.d, /cvsroot/gcl/gcl/o/save.c, /cvsroot/gcl/gcl/o/sockets.c, /cvsroot/gcl/gcl/o/tclwinkill.c, /cvsroot/gcl/gcl/o/unexnt.c, /cvsroot/gcl/gcl/o/unixfsys.c, /cvsroot/gcl/gcl/o/unixfsys.ini, /cvsroot/gcl/gcl/o/unixtime.c, /cvsroot/gcl/gcl/o/usig2.c, /cvsroot/gcl/gcl/o/usig.c, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/unixport/rsym_nt.c, /cvsroot/gcl/gcl/xbin/386-linux-fix: + many changes for xmaxima and for windows + +2000-10-28 wfs + + * /cvsroot/gcl/gcl/xbin/386-linux-fix: changes for redhat 7.0 + +2000-10-27 wfs + + * /cvsroot/gcl/gcl/h/386-linux.h, /cvsroot/gcl/gcl/h/bsd.h, /cvsroot/gcl/gcl/h/sparc-linux.h, /cvsroot/gcl/gcl/o/file.d, /cvsroot/gcl/gcl/configure.in: + changes for close_stream, and to configure for redhat 7.0 + + * /cvsroot/gcl/gcl/gcl-tk/demos/index.lsp, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/object.h, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/append, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/elisp/sshell.el, /cvsroot/gcl/gcl/gcl-tk/gcltksrv, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/makefile: + abort() is void so fixed BV_OFFSET macro + +2000-06-27 wfs + + * /cvsroot/gcl/gcl/info/io.texi, /cvsroot/gcl/gcl/o/file.d: + allow open of a file '| command' to open a pipe + +2000-06-26 wfs + + * /cvsroot/gcl/gcl/lsp/export.lsp, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/read.d: + change parse_number to do bignums much faster + +2000-06-15 wfs + + * /cvsroot/gcl/gcl/configure.in: fixes to configure + +2000-06-13 wfs + + * /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/unixport/init_maxima.lsp: + fix info compilation in makefile + +2000-06-04 wfs + + * /cvsroot/gcl/gcl/o/pathname.d: + fix so make-pathname when given an :type nil makes the type nil independent of the default + + * /cvsroot/gcl/gcl/lsp/sloop.c, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/macros.ini, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/new_init.c, /cvsroot/gcl/gcl/o/number.ini, /cvsroot/gcl/gcl/o/package.ini, /cvsroot/gcl/gcl/o/predicate.ini, /cvsroot/gcl/gcl/o/print.d, /cvsroot/gcl/gcl/o/read.d, /cvsroot/gcl/gcl/o/structure.ini, /cvsroot/gcl/gcl/o/toplevel.ini, /cvsroot/gcl/gcl/o/typespec.ini, /cvsroot/gcl/gcl/o/unixsys.ini, /cvsroot/gcl/gcl/o/usig.ini, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/cmplam.c, /cvsroot/gcl/gcl/cmpnew/cmptype.c, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/gcltksrv, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/info/gcl-tk.info, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/makefile: + change the # syntax for pathnames to be #p + +2000-05-25 wfs + + * /cvsroot/gcl/gcl/minvers: fix version to 3.6 + + * /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/configure: + update configure from configure.in + +2000-05-16 wfs + + * /cvsroot/gcl/gcl/h/386-linux.defs: + remove the -static declaration for the link + +2000-05-15 wfs + + * /cvsroot/gcl/gcl/readme, /cvsroot/gcl/gcl/makefile: + fix some cosmetic and documentation items + +2000-05-15 mzou + + * /cvsroot/gcl/gcl/ChangeLog: *** empty log message *** + +2000-05-13 wfs + + * /cvsroot/gcl/gcl/xbin/distribute, /cvsroot/gcl/gcl/xbin/new-files: + fix xbin/distribute + + * /cvsroot/gcl/gcl/o/sfaslelf.c, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/unixport/rsym_elf.c, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/mp/mpi-sol-sparc.s, /cvsroot/gcl/gcl/o/cmac.c, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/earith.c, /cvsroot/gcl/gcl/o/earith.ini, /cvsroot/gcl/gcl/o/makefile, /cvsroot/gcl/gcl/o/new_init.c, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/makedefs.in, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/readme: + bring cvs tree up to date with my development tree + + * /cvsroot/gcl/gcl/cmpnew/cmpmain.lsp, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/readme: + some cosmetic and readme changes + +1999-12-06 wfs + + * /cvsroot/gcl/gcl/ChangeLog: *** empty log message *** + + * /cvsroot/gcl/gcl/utils/replace, /cvsroot/gcl/gcl/utils/repls1.sed, /cvsroot/gcl/gcl/utils/repls2.sed, /cvsroot/gcl/gcl/utils/repls3.sed, /cvsroot/gcl/gcl/utils/repls4.sed, /cvsroot/gcl/gcl/utils/repls5.sed, /cvsroot/gcl/gcl/utils/revstruct.sed, /cvsroot/gcl/gcl/xbin/add-dir, /cvsroot/gcl/gcl/xbin/append, /cvsroot/gcl/gcl/xbin/append.bat, /cvsroot/gcl/gcl/xbin/compare.c, /cvsroot/gcl/gcl/xbin/compare-src, /cvsroot/gcl/gcl/xbin/comp_rel, /cvsroot/gcl/gcl/xbin/dfiles, /cvsroot/gcl/gcl/xbin/distrib-help, /cvsroot/gcl/gcl/xbin/distribute, /cvsroot/gcl/gcl/xbin/dos-files, /cvsroot/gcl/gcl/xbin/dosmake.bat, /cvsroot/gcl/gcl/xbin/exists, /cvsroot/gcl/gcl/xbin/file-sub, /cvsroot/gcl/gcl/xbin/fix-copyright, /cvsroot/gcl/gcl/xbin/get-externals, /cvsroot/gcl/gcl/xbin/get-internal-calls, /cvsroot/gcl/gcl/xbin/get-machine, /cvsroot/gcl/gcl/xbin/ibm, /cvsroot/gcl/gcl/xbin/if-exist.bat, /cvsroot/gcl/gcl/xbin/if-exists, /cvsroot/gcl/gcl/xbin/if-have-gcc, /cvsroot/gcl/gcl/xbin/inc-version, /cvsroot/gcl/gcl/xbin/is-V-newest, /cvsroot/gcl/gcl/xbin/make-fn, /cvsroot/gcl/gcl/xbin/maketest1, /cvsroot/gcl/gcl/xbin/maketest, /cvsroot/gcl/gcl/xbin/move-if-changed, /cvsroot/gcl/gcl/xbin/new-files, /cvsroot/gcl/gcl/xbin/notify, /cvsroot/gcl/gcl/xbin/setup-tmptest, /cvsroot/gcl/gcl/xbin/spp.c, /cvsroot/gcl/gcl/xbin/strip-ifdef, /cvsroot/gcl/gcl/xbin/test1, /cvsroot/gcl/gcl/xbin/test, /cvsroot/gcl/gcl/xbin/test-distrib, /cvsroot/gcl/gcl/xbin/update: + initial checkin + + * /cvsroot/gcl/gcl/utils/replace, /cvsroot/gcl/gcl/utils/repls1.sed, /cvsroot/gcl/gcl/utils/repls2.sed, /cvsroot/gcl/gcl/utils/repls3.sed, /cvsroot/gcl/gcl/utils/repls4.sed, /cvsroot/gcl/gcl/utils/repls5.sed, /cvsroot/gcl/gcl/utils/revstruct.sed, /cvsroot/gcl/gcl/xbin/add-dir, /cvsroot/gcl/gcl/xbin/append, /cvsroot/gcl/gcl/xbin/append.bat, /cvsroot/gcl/gcl/xbin/compare.c, /cvsroot/gcl/gcl/xbin/compare-src, /cvsroot/gcl/gcl/xbin/comp_rel, /cvsroot/gcl/gcl/xbin/dfiles, /cvsroot/gcl/gcl/xbin/distrib-help, /cvsroot/gcl/gcl/xbin/distribute, /cvsroot/gcl/gcl/xbin/dos-files, /cvsroot/gcl/gcl/xbin/dosmake.bat, /cvsroot/gcl/gcl/xbin/exists, /cvsroot/gcl/gcl/xbin/file-sub, /cvsroot/gcl/gcl/xbin/fix-copyright, /cvsroot/gcl/gcl/xbin/get-externals, /cvsroot/gcl/gcl/xbin/get-internal-calls, /cvsroot/gcl/gcl/xbin/get-machine, /cvsroot/gcl/gcl/xbin/ibm, /cvsroot/gcl/gcl/xbin/if-exist.bat, /cvsroot/gcl/gcl/xbin/if-exists, /cvsroot/gcl/gcl/xbin/if-have-gcc, /cvsroot/gcl/gcl/xbin/inc-version, /cvsroot/gcl/gcl/xbin/is-V-newest, /cvsroot/gcl/gcl/xbin/make-fn, /cvsroot/gcl/gcl/xbin/maketest1, /cvsroot/gcl/gcl/xbin/maketest, /cvsroot/gcl/gcl/xbin/move-if-changed, /cvsroot/gcl/gcl/xbin/new-files, /cvsroot/gcl/gcl/xbin/notify, /cvsroot/gcl/gcl/xbin/setup-tmptest, /cvsroot/gcl/gcl/xbin/spp.c, /cvsroot/gcl/gcl/xbin/strip-ifdef, /cvsroot/gcl/gcl/xbin/test1, /cvsroot/gcl/gcl/xbin/test, /cvsroot/gcl/gcl/xbin/test-distrib, /cvsroot/gcl/gcl/xbin/update: + New file. + + * /cvsroot/gcl/gcl/o/nsocket.ini, /cvsroot/gcl/gcl/o/unexaix.c, /cvsroot/gcl/gcl/unixport/aix-crt0.el, /cvsroot/gcl/gcl/unixport/aix_exports, /cvsroot/gcl/gcl/unixport/boots, /cvsroot/gcl/gcl/unixport/bsd_rsym.c, /cvsroot/gcl/gcl/unixport/cmpboots, /cvsroot/gcl/gcl/unixport/gcldos.lsp, /cvsroot/gcl/gcl/unixport/gcrt0.el, /cvsroot/gcl/gcl/unixport/init_gcl.lsp, /cvsroot/gcl/gcl/unixport/init_kcn.lsp, /cvsroot/gcl/gcl/unixport/init_maxima.lsp, /cvsroot/gcl/gcl/unixport/init_xgcl.lsp, /cvsroot/gcl/gcl/unixport/lspboots, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/makefile.dos, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/unixport/ncrt0.el, /cvsroot/gcl/gcl/unixport/rsym.c, /cvsroot/gcl/gcl/unixport/rsym_elf.c, /cvsroot/gcl/gcl/unixport/rsym_nt.c, /cvsroot/gcl/gcl/unixport/so_locations, /cvsroot/gcl/gcl/unixport/sys_boot.c, /cvsroot/gcl/gcl/unixport/sys_gcl.c, /cvsroot/gcl/gcl/unixport/sys-init.lsp, /cvsroot/gcl/gcl/unixport/sys_kcn.c, /cvsroot/gcl/gcl/unixport/tryserv.tcl: + initial checkin + + * /cvsroot/gcl/gcl/o/nsocket.ini, /cvsroot/gcl/gcl/o/unexaix.c, /cvsroot/gcl/gcl/unixport/aix-crt0.el, /cvsroot/gcl/gcl/unixport/aix_exports, /cvsroot/gcl/gcl/unixport/boots, /cvsroot/gcl/gcl/unixport/bsd_rsym.c, /cvsroot/gcl/gcl/unixport/cmpboots, /cvsroot/gcl/gcl/unixport/gcldos.lsp, /cvsroot/gcl/gcl/unixport/gcrt0.el, /cvsroot/gcl/gcl/unixport/init_gcl.lsp, /cvsroot/gcl/gcl/unixport/init_kcn.lsp, /cvsroot/gcl/gcl/unixport/init_maxima.lsp, /cvsroot/gcl/gcl/unixport/init_xgcl.lsp, /cvsroot/gcl/gcl/unixport/lspboots, /cvsroot/gcl/gcl/unixport/makefile, /cvsroot/gcl/gcl/unixport/makefile.dos, /cvsroot/gcl/gcl/unixport/make_kcn, /cvsroot/gcl/gcl/unixport/ncrt0.el, /cvsroot/gcl/gcl/unixport/rsym.c, /cvsroot/gcl/gcl/unixport/rsym_elf.c, /cvsroot/gcl/gcl/unixport/rsym_nt.c, /cvsroot/gcl/gcl/unixport/so_locations, /cvsroot/gcl/gcl/unixport/sys_boot.c, /cvsroot/gcl/gcl/unixport/sys_gcl.c, /cvsroot/gcl/gcl/unixport/sys-init.lsp, /cvsroot/gcl/gcl/unixport/sys_kcn.c, /cvsroot/gcl/gcl/unixport/tryserv.tcl: + New file. + + * /cvsroot/gcl/gcl/o/clxsocket.ini, /cvsroot/gcl/gcl/o/fasdump.c, /cvsroot/gcl/gcl/o/faslnt.c, /cvsroot/gcl/gcl/o/fat_string.ini, /cvsroot/gcl/gcl/o/file.d, /cvsroot/gcl/gcl/o/firstfile.c, /cvsroot/gcl/gcl/o/init_pari.ini, /cvsroot/gcl/gcl/o/lastfile.c, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/makefun.ini, /cvsroot/gcl/gcl/o/nsocket.c, /cvsroot/gcl/gcl/o/ntheap.h, /cvsroot/gcl/gcl/o/num_co.c, /cvsroot/gcl/gcl/o/rel_coff.c, /cvsroot/gcl/gcl/o/rel_stand.c, /cvsroot/gcl/gcl/o/run_process.ini, /cvsroot/gcl/gcl/o/sfasl.c, /cvsroot/gcl/gcl/o/sfasl.ini, /cvsroot/gcl/gcl/o/sockets.ini, /cvsroot/gcl/gcl/o/try.c, /cvsroot/gcl/gcl/o/unexelfsgi.c, /cvsroot/gcl/gcl/o/unexhp9k800.c, /cvsroot/gcl/gcl/o/unexlin.c, /cvsroot/gcl/gcl/o/unexmips.c, /cvsroot/gcl/gcl/o/unexsgi.c, /cvsroot/gcl/gcl/o/unixfasl.c, /cvsroot/gcl/gcl/o/unixfsys.c, /cvsroot/gcl/gcl/o/unixsave.c, /cvsroot/gcl/gcl/o/unixsys.c, /cvsroot/gcl/gcl/o/unixtime.c, /cvsroot/gcl/gcl/o/user_init.c, /cvsroot/gcl/gcl/o/usig2_aux.c, /cvsroot/gcl/gcl/o/usig2.c, /cvsroot/gcl/gcl/o/usig.c, /cvsroot/gcl/gcl/o/utils.c, /cvsroot/gcl/gcl/o/utils.ini, /cvsroot/gcl/gcl/o/Vmalloc.c, /cvsroot/gcl/gcl/o/xdrfuns.c: + initial checkin + + * /cvsroot/gcl/gcl/o/clxsocket.ini, /cvsroot/gcl/gcl/o/fasdump.c, /cvsroot/gcl/gcl/o/faslnt.c, /cvsroot/gcl/gcl/o/fat_string.ini, /cvsroot/gcl/gcl/o/file.d, /cvsroot/gcl/gcl/o/firstfile.c, /cvsroot/gcl/gcl/o/init_pari.ini, /cvsroot/gcl/gcl/o/lastfile.c, /cvsroot/gcl/gcl/o/main.c, /cvsroot/gcl/gcl/o/makefun.ini, /cvsroot/gcl/gcl/o/nsocket.c, /cvsroot/gcl/gcl/o/ntheap.h, /cvsroot/gcl/gcl/o/num_co.c, /cvsroot/gcl/gcl/o/rel_coff.c, /cvsroot/gcl/gcl/o/rel_stand.c, /cvsroot/gcl/gcl/o/run_process.ini, /cvsroot/gcl/gcl/o/sfasl.c, /cvsroot/gcl/gcl/o/sfasl.ini, /cvsroot/gcl/gcl/o/sockets.ini, /cvsroot/gcl/gcl/o/try.c, /cvsroot/gcl/gcl/o/unexelfsgi.c, /cvsroot/gcl/gcl/o/unexhp9k800.c, /cvsroot/gcl/gcl/o/unexlin.c, /cvsroot/gcl/gcl/o/unexmips.c, /cvsroot/gcl/gcl/o/unexsgi.c, /cvsroot/gcl/gcl/o/unixfasl.c, /cvsroot/gcl/gcl/o/unixfsys.c, /cvsroot/gcl/gcl/o/unixsave.c, /cvsroot/gcl/gcl/o/unixsys.c, /cvsroot/gcl/gcl/o/unixtime.c, /cvsroot/gcl/gcl/o/user_init.c, /cvsroot/gcl/gcl/o/usig2_aux.c, /cvsroot/gcl/gcl/o/usig2.c, /cvsroot/gcl/gcl/o/usig.c, /cvsroot/gcl/gcl/o/utils.c, /cvsroot/gcl/gcl/o/utils.ini, /cvsroot/gcl/gcl/o/Vmalloc.c, /cvsroot/gcl/gcl/o/xdrfuns.c: + New file. + + * /cvsroot/gcl/gcl/o/error.ini, /cvsroot/gcl/gcl/o/funlink.ini, /cvsroot/gcl/gcl/o/nfunlink.ini, /cvsroot/gcl/gcl/o/pathname.ini, /cvsroot/gcl/gcl/o/regexp.c, /cvsroot/gcl/gcl/o/regexp.h, /cvsroot/gcl/gcl/o/regexpr.c, /cvsroot/gcl/gcl/o/rel_aix.c, /cvsroot/gcl/gcl/o/rel_hp300.c, /cvsroot/gcl/gcl/o/rel_mac2.c, /cvsroot/gcl/gcl/o/rel_ps2aix.c, /cvsroot/gcl/gcl/o/rel_rios.c, /cvsroot/gcl/gcl/o/rel_sun3.c, /cvsroot/gcl/gcl/o/rel_sun4.c, /cvsroot/gcl/gcl/o/rel_u370aix.c, /cvsroot/gcl/gcl/o/run_process.c, /cvsroot/gcl/gcl/o/saveaix3.c, /cvsroot/gcl/gcl/o/save.c, /cvsroot/gcl/gcl/o/savedec31.c, /cvsroot/gcl/gcl/o/save_sgi4.c, /cvsroot/gcl/gcl/o/saveu370.c, /cvsroot/gcl/gcl/o/sbrk.c, /cvsroot/gcl/gcl/o/sequence.d, /cvsroot/gcl/gcl/o/sfaslelf.c, /cvsroot/gcl/gcl/o/sfasli.c, /cvsroot/gcl/gcl/o/sgbc.c, /cvsroot/gcl/gcl/o/sgi4d_emul.s, /cvsroot/gcl/gcl/o/sockets.c, /cvsroot/gcl/gcl/o/strcspn.c, /cvsroot/gcl/gcl/o/string.d, /cvsroot/gcl/gcl/o/structure.c, /cvsroot/gcl/gcl/o/symbol.d, /cvsroot/gcl/gcl/o/test_memprotect.c, /cvsroot/gcl/gcl/o/toplevel.c, /cvsroot/gcl/gcl/o/typespec.c, /cvsroot/gcl/gcl/o/u370_emul.s, /cvsroot/gcl/gcl/o/unexec-19.29.c, /cvsroot/gcl/gcl/o/unexec.c, /cvsroot/gcl/gcl/o/unexelf.c, /cvsroot/gcl/gcl/o/unixfasl.ini, /cvsroot/gcl/gcl/o/unixfsys.ini, /cvsroot/gcl/gcl/o/unixsave.ini, /cvsroot/gcl/gcl/o/unixsys.ini, /cvsroot/gcl/gcl/o/unixtime.ini, /cvsroot/gcl/gcl/o/usig2.ini, /cvsroot/gcl/gcl/o/usig.ini: + initial checkin + + * /cvsroot/gcl/gcl/o/error.ini, /cvsroot/gcl/gcl/o/funlink.ini, /cvsroot/gcl/gcl/o/nfunlink.ini, /cvsroot/gcl/gcl/o/pathname.ini, /cvsroot/gcl/gcl/o/regexp.c, /cvsroot/gcl/gcl/o/regexp.h, /cvsroot/gcl/gcl/o/regexpr.c, /cvsroot/gcl/gcl/o/rel_aix.c, /cvsroot/gcl/gcl/o/rel_hp300.c, /cvsroot/gcl/gcl/o/rel_mac2.c, /cvsroot/gcl/gcl/o/rel_ps2aix.c, /cvsroot/gcl/gcl/o/rel_rios.c, /cvsroot/gcl/gcl/o/rel_sun3.c, /cvsroot/gcl/gcl/o/rel_sun4.c, /cvsroot/gcl/gcl/o/rel_u370aix.c, /cvsroot/gcl/gcl/o/run_process.c, /cvsroot/gcl/gcl/o/saveaix3.c, /cvsroot/gcl/gcl/o/save.c, /cvsroot/gcl/gcl/o/savedec31.c, /cvsroot/gcl/gcl/o/save_sgi4.c, /cvsroot/gcl/gcl/o/saveu370.c, /cvsroot/gcl/gcl/o/sbrk.c, /cvsroot/gcl/gcl/o/sequence.d, /cvsroot/gcl/gcl/o/sfaslelf.c, /cvsroot/gcl/gcl/o/sfasli.c, /cvsroot/gcl/gcl/o/sgbc.c, /cvsroot/gcl/gcl/o/sgi4d_emul.s, /cvsroot/gcl/gcl/o/sockets.c, /cvsroot/gcl/gcl/o/strcspn.c, /cvsroot/gcl/gcl/o/string.d, /cvsroot/gcl/gcl/o/structure.c, /cvsroot/gcl/gcl/o/symbol.d, /cvsroot/gcl/gcl/o/test_memprotect.c, /cvsroot/gcl/gcl/o/toplevel.c, /cvsroot/gcl/gcl/o/typespec.c, /cvsroot/gcl/gcl/o/u370_emul.s, /cvsroot/gcl/gcl/o/unexec-19.29.c, /cvsroot/gcl/gcl/o/unexec.c, /cvsroot/gcl/gcl/o/unexelf.c, /cvsroot/gcl/gcl/o/unixfasl.ini, /cvsroot/gcl/gcl/o/unixfsys.ini, /cvsroot/gcl/gcl/o/unixsave.ini, /cvsroot/gcl/gcl/o/unixsys.ini, /cvsroot/gcl/gcl/o/unixtime.ini, /cvsroot/gcl/gcl/o/usig2.ini, /cvsroot/gcl/gcl/o/usig.ini: + New file. + + * /cvsroot/gcl/gcl/o/array.ini, /cvsroot/gcl/gcl/o/backq.ini, /cvsroot/gcl/gcl/o/character.ini, /cvsroot/gcl/gcl/o/earith.ini, /cvsroot/gcl/gcl/o/file.ini, /cvsroot/gcl/gcl/o/format.ini, /cvsroot/gcl/gcl/o/hash.ini, /cvsroot/gcl/gcl/o/list.ini, /cvsroot/gcl/gcl/o/mapfun.c, /cvsroot/gcl/gcl/o/multival.c, /cvsroot/gcl/gcl/o/ndiv.c, /cvsroot/gcl/gcl/o/new_init.c, /cvsroot/gcl/gcl/o/NeXTunixfasl.c, /cvsroot/gcl/gcl/o/NeXTunixsave.c, /cvsroot/gcl/gcl/o/nfunlink.c, /cvsroot/gcl/gcl/o/nmul.c, /cvsroot/gcl/gcl/o/num_arith.c, /cvsroot/gcl/gcl/o/number.c, /cvsroot/gcl/gcl/o/num_co.ini, /cvsroot/gcl/gcl/o/num_comp.c, /cvsroot/gcl/gcl/o/num_log.c, /cvsroot/gcl/gcl/o/num_log.ini, /cvsroot/gcl/gcl/o/num_pred.c, /cvsroot/gcl/gcl/o/num_rand.c, /cvsroot/gcl/gcl/o/num_rand.ini, /cvsroot/gcl/gcl/o/num_sfun.c, /cvsroot/gcl/gcl/o/package.d, /cvsroot/gcl/gcl/o/pathname.d, /cvsroot/gcl/gcl/o/peculiar.c, /cvsroot/gcl/gcl/o/predicate.c, /cvsroot/gcl/gcl/o/pre_init.c, /cvsroot/gcl/gcl/o/print.d, /cvsroot/gcl/gcl/o/print.ini, /cvsroot/gcl/gcl/o/prog.c, /cvsroot/gcl/gcl/o/read.d, /cvsroot/gcl/gcl/o/read.ini, /cvsroot/gcl/gcl/o/readme, /cvsroot/gcl/gcl/o/reference.c, /cvsroot/gcl/gcl/o/regexpr.ini, /cvsroot/gcl/gcl/o/sequence.ini, /cvsroot/gcl/gcl/o/string.ini, /cvsroot/gcl/gcl/o/structure.ini, /cvsroot/gcl/gcl/o/toplevel.ini: + initial checkin + + * /cvsroot/gcl/gcl/o/array.ini, /cvsroot/gcl/gcl/o/backq.ini, /cvsroot/gcl/gcl/o/character.ini, /cvsroot/gcl/gcl/o/earith.ini, /cvsroot/gcl/gcl/o/file.ini, /cvsroot/gcl/gcl/o/format.ini, /cvsroot/gcl/gcl/o/hash.ini, /cvsroot/gcl/gcl/o/list.ini, /cvsroot/gcl/gcl/o/mapfun.c, /cvsroot/gcl/gcl/o/multival.c, /cvsroot/gcl/gcl/o/ndiv.c, /cvsroot/gcl/gcl/o/new_init.c, /cvsroot/gcl/gcl/o/NeXTunixfasl.c, /cvsroot/gcl/gcl/o/NeXTunixsave.c, /cvsroot/gcl/gcl/o/nfunlink.c, /cvsroot/gcl/gcl/o/nmul.c, /cvsroot/gcl/gcl/o/num_arith.c, /cvsroot/gcl/gcl/o/number.c, /cvsroot/gcl/gcl/o/num_co.ini, /cvsroot/gcl/gcl/o/num_comp.c, /cvsroot/gcl/gcl/o/num_log.c, /cvsroot/gcl/gcl/o/num_log.ini, /cvsroot/gcl/gcl/o/num_pred.c, /cvsroot/gcl/gcl/o/num_rand.c, /cvsroot/gcl/gcl/o/num_rand.ini, /cvsroot/gcl/gcl/o/num_sfun.c, /cvsroot/gcl/gcl/o/package.d, /cvsroot/gcl/gcl/o/pathname.d, /cvsroot/gcl/gcl/o/peculiar.c, /cvsroot/gcl/gcl/o/predicate.c, /cvsroot/gcl/gcl/o/pre_init.c, /cvsroot/gcl/gcl/o/print.d, /cvsroot/gcl/gcl/o/print.ini, /cvsroot/gcl/gcl/o/prog.c, /cvsroot/gcl/gcl/o/read.d, /cvsroot/gcl/gcl/o/read.ini, /cvsroot/gcl/gcl/o/readme, /cvsroot/gcl/gcl/o/reference.c, /cvsroot/gcl/gcl/o/regexpr.ini, /cvsroot/gcl/gcl/o/sequence.ini, /cvsroot/gcl/gcl/o/string.ini, /cvsroot/gcl/gcl/o/structure.ini, /cvsroot/gcl/gcl/o/toplevel.ini: + New file. + + * /cvsroot/gcl/gcl/o/big.ini, /cvsroot/gcl/gcl/o/catch.ini, /cvsroot/gcl/gcl/o/cfun.ini, /cvsroot/gcl/gcl/o/cmpaux.ini, /cvsroot/gcl/gcl/o/conditional.ini, /cvsroot/gcl/gcl/o/faslsgi4.c, /cvsroot/gcl/gcl/o/fat_string.c, /cvsroot/gcl/gcl/o/fix-structref.el, /cvsroot/gcl/gcl/o/format.c, /cvsroot/gcl/gcl/o/frame.c, /cvsroot/gcl/gcl/o/funlink.c, /cvsroot/gcl/gcl/o/funs, /cvsroot/gcl/gcl/o/gbc.c, /cvsroot/gcl/gcl/o/gdb_commands, /cvsroot/gcl/gcl/o/gnumalloc.c, /cvsroot/gcl/gcl/o/grab_defs.c, /cvsroot/gcl/gcl/o/grab_defs.u, /cvsroot/gcl/gcl/o/hash.d, /cvsroot/gcl/gcl/o/help.el, /cvsroot/gcl/gcl/o/init_pari.c, /cvsroot/gcl/gcl/o/internal-calls.lisp, /cvsroot/gcl/gcl/o/iteration.c, /cvsroot/gcl/gcl/o/let.c, /cvsroot/gcl/gcl/o/lex.c, /cvsroot/gcl/gcl/o/list.d, /cvsroot/gcl/gcl/o/littleXwin.c, /cvsroot/gcl/gcl/o/macros.c, /cvsroot/gcl/gcl/o/makefun.c, /cvsroot/gcl/gcl/o/multival.ini, /cvsroot/gcl/gcl/o/mych, /cvsroot/gcl/gcl/o/num_arith.ini, /cvsroot/gcl/gcl/o/number.ini, /cvsroot/gcl/gcl/o/num_comp.ini, /cvsroot/gcl/gcl/o/num_pred.ini, /cvsroot/gcl/gcl/o/num_sfun.ini, /cvsroot/gcl/gcl/o/package.ini, /cvsroot/gcl/gcl/o/prog.ini, /cvsroot/gcl/gcl/o/symbol.ini, /cvsroot/gcl/gcl/o/unexnt.c: + initial checkin + + * /cvsroot/gcl/gcl/o/big.ini, /cvsroot/gcl/gcl/o/catch.ini, /cvsroot/gcl/gcl/o/cfun.ini, /cvsroot/gcl/gcl/o/cmpaux.ini, /cvsroot/gcl/gcl/o/conditional.ini, /cvsroot/gcl/gcl/o/faslsgi4.c, /cvsroot/gcl/gcl/o/fat_string.c, /cvsroot/gcl/gcl/o/fix-structref.el, /cvsroot/gcl/gcl/o/format.c, /cvsroot/gcl/gcl/o/frame.c, /cvsroot/gcl/gcl/o/funlink.c, /cvsroot/gcl/gcl/o/funs, /cvsroot/gcl/gcl/o/gbc.c, /cvsroot/gcl/gcl/o/gdb_commands, /cvsroot/gcl/gcl/o/gnumalloc.c, /cvsroot/gcl/gcl/o/grab_defs.c, /cvsroot/gcl/gcl/o/grab_defs.u, /cvsroot/gcl/gcl/o/hash.d, /cvsroot/gcl/gcl/o/help.el, /cvsroot/gcl/gcl/o/init_pari.c, /cvsroot/gcl/gcl/o/internal-calls.lisp, /cvsroot/gcl/gcl/o/iteration.c, /cvsroot/gcl/gcl/o/let.c, /cvsroot/gcl/gcl/o/lex.c, /cvsroot/gcl/gcl/o/list.d, /cvsroot/gcl/gcl/o/littleXwin.c, /cvsroot/gcl/gcl/o/macros.c, /cvsroot/gcl/gcl/o/makefun.c, /cvsroot/gcl/gcl/o/multival.ini, /cvsroot/gcl/gcl/o/mych, /cvsroot/gcl/gcl/o/num_arith.ini, /cvsroot/gcl/gcl/o/number.ini, /cvsroot/gcl/gcl/o/num_comp.ini, /cvsroot/gcl/gcl/o/num_pred.ini, /cvsroot/gcl/gcl/o/num_sfun.ini, /cvsroot/gcl/gcl/o/package.ini, /cvsroot/gcl/gcl/o/prog.ini, /cvsroot/gcl/gcl/o/symbol.ini, /cvsroot/gcl/gcl/o/unexnt.c: + New file. + + * /cvsroot/gcl/gcl/o/alloc.c, /cvsroot/gcl/gcl/o/assignment.c, /cvsroot/gcl/gcl/o/assignment.ini, /cvsroot/gcl/gcl/o/backq.c, /cvsroot/gcl/gcl/o/bcmp.c, /cvsroot/gcl/gcl/o/bcopy.c, /cvsroot/gcl/gcl/o/bds.c, /cvsroot/gcl/gcl/o/bds.ini, /cvsroot/gcl/gcl/o/before_init.c, /cvsroot/gcl/gcl/o/big.c, /cvsroot/gcl/gcl/o/bind.c, /cvsroot/gcl/gcl/o/bind.ini, /cvsroot/gcl/gcl/o/bind.texi, /cvsroot/gcl/gcl/o/bitop.c, /cvsroot/gcl/gcl/o/bitop.ini, /cvsroot/gcl/gcl/o/block.c, /cvsroot/gcl/gcl/o/block.ini, /cvsroot/gcl/gcl/o/bsearch.c, /cvsroot/gcl/gcl/o/bzero.c, /cvsroot/gcl/gcl/o/catch.c, /cvsroot/gcl/gcl/o/cfun.c, /cvsroot/gcl/gcl/o/ChangeLog, /cvsroot/gcl/gcl/o/character.d, /cvsroot/gcl/gcl/o/clxsocket.c, /cvsroot/gcl/gcl/o/cmac.c, /cvsroot/gcl/gcl/o/cmpaux.c, /cvsroot/gcl/gcl/o/conditional.c, /cvsroot/gcl/gcl/o/earith.c, /cvsroot/gcl/gcl/o/egrep-def, /cvsroot/gcl/gcl/o/error.c, /cvsroot/gcl/gcl/o/eval.c, /cvsroot/gcl/gcl/o/eval.ini, /cvsroot/gcl/gcl/o/external_funs.h, /cvsroot/gcl/gcl/o/fasldlsym.c, /cvsroot/gcl/gcl/o/fasldlsym.c.link, /cvsroot/gcl/gcl/o/faslhp800.c, /cvsroot/gcl/gcl/o/frame.ini, /cvsroot/gcl/gcl/o/gbc.ini, /cvsroot/gcl/gcl/o/iteration.ini, /cvsroot/gcl/gcl/o/let.ini, /cvsroot/gcl/gcl/o/lex.ini, /cvsroot/gcl/gcl/o/macros.ini, /cvsroot/gcl/gcl/o/malloc.c, /cvsroot/gcl/gcl/o/mapfun.ini, /cvsroot/gcl/gcl/o/predicate.ini, /cvsroot/gcl/gcl/o/reference.ini, /cvsroot/gcl/gcl/o/st, /cvsroot/gcl/gcl/o/typespec.ini: + initial checkin + + * /cvsroot/gcl/gcl/o/alloc.c, /cvsroot/gcl/gcl/o/assignment.c, /cvsroot/gcl/gcl/o/assignment.ini, /cvsroot/gcl/gcl/o/backq.c, /cvsroot/gcl/gcl/o/bcmp.c, /cvsroot/gcl/gcl/o/bcopy.c, /cvsroot/gcl/gcl/o/bds.c, /cvsroot/gcl/gcl/o/bds.ini, /cvsroot/gcl/gcl/o/before_init.c, /cvsroot/gcl/gcl/o/big.c, /cvsroot/gcl/gcl/o/bind.c, /cvsroot/gcl/gcl/o/bind.ini, /cvsroot/gcl/gcl/o/bind.texi, /cvsroot/gcl/gcl/o/bitop.c, /cvsroot/gcl/gcl/o/bitop.ini, /cvsroot/gcl/gcl/o/block.c, /cvsroot/gcl/gcl/o/block.ini, /cvsroot/gcl/gcl/o/bsearch.c, /cvsroot/gcl/gcl/o/bzero.c, /cvsroot/gcl/gcl/o/catch.c, /cvsroot/gcl/gcl/o/cfun.c, /cvsroot/gcl/gcl/o/ChangeLog, /cvsroot/gcl/gcl/o/character.d, /cvsroot/gcl/gcl/o/clxsocket.c, /cvsroot/gcl/gcl/o/cmac.c, /cvsroot/gcl/gcl/o/cmpaux.c, /cvsroot/gcl/gcl/o/conditional.c, /cvsroot/gcl/gcl/o/earith.c, /cvsroot/gcl/gcl/o/egrep-def, /cvsroot/gcl/gcl/o/error.c, /cvsroot/gcl/gcl/o/eval.c, /cvsroot/gcl/gcl/o/eval.ini, /cvsroot/gcl/gcl/o/external_funs.h, /cvsroot/gcl/gcl/o/fasldlsym.c, /cvsroot/gcl/gcl/o/fasldlsym.c.link, /cvsroot/gcl/gcl/o/faslhp800.c, /cvsroot/gcl/gcl/o/frame.ini, /cvsroot/gcl/gcl/o/gbc.ini, /cvsroot/gcl/gcl/o/iteration.ini, /cvsroot/gcl/gcl/o/let.ini, /cvsroot/gcl/gcl/o/lex.ini, /cvsroot/gcl/gcl/o/macros.ini, /cvsroot/gcl/gcl/o/malloc.c, /cvsroot/gcl/gcl/o/mapfun.ini, /cvsroot/gcl/gcl/o/predicate.ini, /cvsroot/gcl/gcl/o/reference.ini, /cvsroot/gcl/gcl/o/st, /cvsroot/gcl/gcl/o/typespec.ini: + New file. + + * /cvsroot/gcl/gcl/misc/warn-slow.lsp, /cvsroot/gcl/gcl/mp/fplus.c, /cvsroot/gcl/gcl/mp/gcclab, /cvsroot/gcl/gcl/mp/gcclab.awk, /cvsroot/gcl/gcl/mp/gnulib1.c, /cvsroot/gcl/gcl/mp/lo-ibmrt.s, /cvsroot/gcl/gcl/mp/lo-rios1.s, /cvsroot/gcl/gcl/mp/lo-rios.s, /cvsroot/gcl/gcl/mp/lo-sgi4d.s, /cvsroot/gcl/gcl/mp/lo-u370_aix.s, /cvsroot/gcl/gcl/mp/make.defs, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/mp/mp2.c, /cvsroot/gcl/gcl/mp/mp_addmul.c, /cvsroot/gcl/gcl/mp/mp_bfffo.c, /cvsroot/gcl/gcl/mp/mp_dblrsl3.c, /cvsroot/gcl/gcl/mp/mp_dblrul3.c, /cvsroot/gcl/gcl/mp/mp_divul3.c, /cvsroot/gcl/gcl/mp/mp_divul3_word.c, /cvsroot/gcl/gcl/mp/mpi-386d.S, /cvsroot/gcl/gcl/mp/mpi-386_no_under.s, /cvsroot/gcl/gcl/mp/mpi-bsd68k.s, /cvsroot/gcl/gcl/mp/mpi.c, /cvsroot/gcl/gcl/mp/mpi-sol-sparc.s, /cvsroot/gcl/gcl/mp/mpi-sparc.s, /cvsroot/gcl/gcl/mp/mp_mulul3.c, /cvsroot/gcl/gcl/mp/mp_shiftl.c, /cvsroot/gcl/gcl/mp/mp_sl3todivul3.c, /cvsroot/gcl/gcl/mp/readme, /cvsroot/gcl/gcl/mp/sparcdivul3.s, /cvsroot/gcl/gcl/o/alloc.ini, /cvsroot/gcl/gcl/o/array.c1, /cvsroot/gcl/gcl/o/array.c, /cvsroot/gcl/gcl/o/array.c.prev, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/main.ini, /cvsroot/gcl/gcl/o/makefile: + initial checkin + + * /cvsroot/gcl/gcl/misc/warn-slow.lsp, /cvsroot/gcl/gcl/mp/fplus.c, /cvsroot/gcl/gcl/mp/gcclab, /cvsroot/gcl/gcl/mp/gcclab.awk, /cvsroot/gcl/gcl/mp/gnulib1.c, /cvsroot/gcl/gcl/mp/lo-ibmrt.s, /cvsroot/gcl/gcl/mp/lo-rios1.s, /cvsroot/gcl/gcl/mp/lo-rios.s, /cvsroot/gcl/gcl/mp/lo-sgi4d.s, /cvsroot/gcl/gcl/mp/lo-u370_aix.s, /cvsroot/gcl/gcl/mp/make.defs, /cvsroot/gcl/gcl/mp/makefile, /cvsroot/gcl/gcl/mp/mp2.c, /cvsroot/gcl/gcl/mp/mp_addmul.c, /cvsroot/gcl/gcl/mp/mp_bfffo.c, /cvsroot/gcl/gcl/mp/mp_dblrsl3.c, /cvsroot/gcl/gcl/mp/mp_dblrul3.c, /cvsroot/gcl/gcl/mp/mp_divul3.c, /cvsroot/gcl/gcl/mp/mp_divul3_word.c, /cvsroot/gcl/gcl/mp/mpi-386d.S, /cvsroot/gcl/gcl/mp/mpi-386_no_under.s, /cvsroot/gcl/gcl/mp/mpi-bsd68k.s, /cvsroot/gcl/gcl/mp/mpi.c, /cvsroot/gcl/gcl/mp/mpi-sol-sparc.s, /cvsroot/gcl/gcl/mp/mpi-sparc.s, /cvsroot/gcl/gcl/mp/mp_mulul3.c, /cvsroot/gcl/gcl/mp/mp_shiftl.c, /cvsroot/gcl/gcl/mp/mp_sl3todivul3.c, /cvsroot/gcl/gcl/mp/readme, /cvsroot/gcl/gcl/mp/sparcdivul3.s, /cvsroot/gcl/gcl/o/alloc.ini, /cvsroot/gcl/gcl/o/array.c1, /cvsroot/gcl/gcl/o/array.c, /cvsroot/gcl/gcl/o/array.c.prev, /cvsroot/gcl/gcl/o/cmpinclude.h, /cvsroot/gcl/gcl/o/main.ini, /cvsroot/gcl/gcl/o/makefile: + New file. + + * /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/lsp/serror.data, /cvsroot/gcl/gcl/lsp/serror.h, /cvsroot/gcl/gcl/lsp/sloop.data, /cvsroot/gcl/gcl/lsp/sloop.h, /cvsroot/gcl/gcl/lsp/sloop.lsp, /cvsroot/gcl/gcl/lsp/stack-problem.lsp, /cvsroot/gcl/gcl/lsp/stdlisp.lsp, /cvsroot/gcl/gcl/lsp/sys-proclaim.lisp, /cvsroot/gcl/gcl/lsp/top.c, /cvsroot/gcl/gcl/lsp/top.data, /cvsroot/gcl/gcl/lsp/top.h, /cvsroot/gcl/gcl/lsp/top.lsp, /cvsroot/gcl/gcl/lsp/trace.c, /cvsroot/gcl/gcl/lsp/trace.data, /cvsroot/gcl/gcl/lsp/trace.h, /cvsroot/gcl/gcl/lsp/trace.lsp, /cvsroot/gcl/gcl/lsp/ucall.lisp, /cvsroot/gcl/gcl/lsp/ustreams.lisp, /cvsroot/gcl/gcl/man/man1/gcl.1, /cvsroot/gcl/gcl/misc/check.c, /cvsroot/gcl/gcl/misc/check_obj.c, /cvsroot/gcl/gcl/misc/cstruct.lsp, /cvsroot/gcl/gcl/misc/foreign.lsp, /cvsroot/gcl/gcl/misc/mprotect.ch, /cvsroot/gcl/gcl/misc/rusage.lsp, /cvsroot/gcl/gcl/misc/test-seek.c, /cvsroot/gcl/gcl/misc/test-sgc.lsp: + initial checkin + + * /cvsroot/gcl/gcl/lsp/makefile, /cvsroot/gcl/gcl/lsp/serror.data, /cvsroot/gcl/gcl/lsp/serror.h, /cvsroot/gcl/gcl/lsp/sloop.data, /cvsroot/gcl/gcl/lsp/sloop.h, /cvsroot/gcl/gcl/lsp/sloop.lsp, /cvsroot/gcl/gcl/lsp/stack-problem.lsp, /cvsroot/gcl/gcl/lsp/stdlisp.lsp, /cvsroot/gcl/gcl/lsp/sys-proclaim.lisp, /cvsroot/gcl/gcl/lsp/top.c, /cvsroot/gcl/gcl/lsp/top.data, /cvsroot/gcl/gcl/lsp/top.h, /cvsroot/gcl/gcl/lsp/top.lsp, /cvsroot/gcl/gcl/lsp/trace.c, /cvsroot/gcl/gcl/lsp/trace.data, /cvsroot/gcl/gcl/lsp/trace.h, /cvsroot/gcl/gcl/lsp/trace.lsp, /cvsroot/gcl/gcl/lsp/ucall.lisp, /cvsroot/gcl/gcl/lsp/ustreams.lisp, /cvsroot/gcl/gcl/man/man1/gcl.1, /cvsroot/gcl/gcl/misc/check.c, /cvsroot/gcl/gcl/misc/check_obj.c, /cvsroot/gcl/gcl/misc/cstruct.lsp, /cvsroot/gcl/gcl/misc/foreign.lsp, /cvsroot/gcl/gcl/misc/mprotect.ch, /cvsroot/gcl/gcl/misc/rusage.lsp, /cvsroot/gcl/gcl/misc/test-seek.c, /cvsroot/gcl/gcl/misc/test-sgc.lsp: + New file. + + * /cvsroot/gcl/gcl/lsp/littleXlsp.lsp, /cvsroot/gcl/gcl/lsp/loadcmp.lsp, /cvsroot/gcl/gcl/lsp/make-declare.lsp, /cvsroot/gcl/gcl/lsp/make.lisp, /cvsroot/gcl/gcl/lsp/mislib.c, /cvsroot/gcl/gcl/lsp/mislib.data, /cvsroot/gcl/gcl/lsp/mislib.h, /cvsroot/gcl/gcl/lsp/mislib.lsp, /cvsroot/gcl/gcl/lsp/module.c, /cvsroot/gcl/gcl/lsp/module.data, /cvsroot/gcl/gcl/lsp/module.h, /cvsroot/gcl/gcl/lsp/module.lsp, /cvsroot/gcl/gcl/lsp/numlib.c, /cvsroot/gcl/gcl/lsp/numlib.data, /cvsroot/gcl/gcl/lsp/numlib.h, /cvsroot/gcl/gcl/lsp/numlib.lsp, /cvsroot/gcl/gcl/lsp/packages.lsp, /cvsroot/gcl/gcl/lsp/packlib.c, /cvsroot/gcl/gcl/lsp/packlib.data, /cvsroot/gcl/gcl/lsp/packlib.h, /cvsroot/gcl/gcl/lsp/packlib.lsp, /cvsroot/gcl/gcl/lsp/predlib.c, /cvsroot/gcl/gcl/lsp/predlib.data, /cvsroot/gcl/gcl/lsp/predlib.h, /cvsroot/gcl/gcl/lsp/predlib.lsp, /cvsroot/gcl/gcl/lsp/profile.lsp, /cvsroot/gcl/gcl/lsp/seq.c, /cvsroot/gcl/gcl/lsp/seq.data, /cvsroot/gcl/gcl/lsp/seq.h, /cvsroot/gcl/gcl/lsp/seqlib.c, /cvsroot/gcl/gcl/lsp/seqlib.data, /cvsroot/gcl/gcl/lsp/seqlib.h, /cvsroot/gcl/gcl/lsp/seqlib.lsp, /cvsroot/gcl/gcl/lsp/seq.lsp, /cvsroot/gcl/gcl/lsp/serror.lsp, /cvsroot/gcl/gcl/lsp/setf.c, /cvsroot/gcl/gcl/lsp/setf.data, /cvsroot/gcl/gcl/lsp/setf.h, /cvsroot/gcl/gcl/lsp/setf.lsp, /cvsroot/gcl/gcl/lsp/sloop.c: + initial checkin + + * /cvsroot/gcl/gcl/lsp/littleXlsp.lsp, /cvsroot/gcl/gcl/lsp/loadcmp.lsp, /cvsroot/gcl/gcl/lsp/make-declare.lsp, /cvsroot/gcl/gcl/lsp/make.lisp, /cvsroot/gcl/gcl/lsp/mislib.c, /cvsroot/gcl/gcl/lsp/mislib.data, /cvsroot/gcl/gcl/lsp/mislib.h, /cvsroot/gcl/gcl/lsp/mislib.lsp, /cvsroot/gcl/gcl/lsp/module.c, /cvsroot/gcl/gcl/lsp/module.data, /cvsroot/gcl/gcl/lsp/module.h, /cvsroot/gcl/gcl/lsp/module.lsp, /cvsroot/gcl/gcl/lsp/numlib.c, /cvsroot/gcl/gcl/lsp/numlib.data, /cvsroot/gcl/gcl/lsp/numlib.h, /cvsroot/gcl/gcl/lsp/numlib.lsp, /cvsroot/gcl/gcl/lsp/packages.lsp, /cvsroot/gcl/gcl/lsp/packlib.c, /cvsroot/gcl/gcl/lsp/packlib.data, /cvsroot/gcl/gcl/lsp/packlib.h, /cvsroot/gcl/gcl/lsp/packlib.lsp, /cvsroot/gcl/gcl/lsp/predlib.c, /cvsroot/gcl/gcl/lsp/predlib.data, /cvsroot/gcl/gcl/lsp/predlib.h, /cvsroot/gcl/gcl/lsp/predlib.lsp, /cvsroot/gcl/gcl/lsp/profile.lsp, /cvsroot/gcl/gcl/lsp/seq.c, /cvsroot/gcl/gcl/lsp/seq.data, /cvsroot/gcl/gcl/lsp/seq.h, /cvsroot/gcl/gcl/lsp/seqlib.c, /cvsroot/gcl/gcl/lsp/seqlib.data, /cvsroot/gcl/gcl/lsp/seqlib.h, /cvsroot/gcl/gcl/lsp/seqlib.lsp, /cvsroot/gcl/gcl/lsp/seq.lsp, /cvsroot/gcl/gcl/lsp/serror.lsp, /cvsroot/gcl/gcl/lsp/setf.c, /cvsroot/gcl/gcl/lsp/setf.data, /cvsroot/gcl/gcl/lsp/setf.h, /cvsroot/gcl/gcl/lsp/setf.lsp, /cvsroot/gcl/gcl/lsp/sloop.c: + New file. + + * /cvsroot/gcl/gcl/lsp/debug.h, /cvsroot/gcl/gcl/lsp/debug.lsp, /cvsroot/gcl/gcl/lsp/defmacro.c, /cvsroot/gcl/gcl/lsp/defmacro.data, /cvsroot/gcl/gcl/lsp/defmacro.h, /cvsroot/gcl/gcl/lsp/defmacro.lsp, /cvsroot/gcl/gcl/lsp/defstruct.c, /cvsroot/gcl/gcl/lsp/defstruct.data, /cvsroot/gcl/gcl/lsp/defstruct.h, /cvsroot/gcl/gcl/lsp/defstruct.lsp, /cvsroot/gcl/gcl/lsp/describe.c, /cvsroot/gcl/gcl/lsp/describe.data, /cvsroot/gcl/gcl/lsp/describe.h, /cvsroot/gcl/gcl/lsp/describe.lsp, /cvsroot/gcl/gcl/lsp/desetq.lsp, /cvsroot/gcl/gcl/lsp/doc-file.lsp, /cvsroot/gcl/gcl/lsp/dummy.lisp, /cvsroot/gcl/gcl/lsp/evalmacros.c, /cvsroot/gcl/gcl/lsp/evalmacros.data, /cvsroot/gcl/gcl/lsp/evalmacros.h, /cvsroot/gcl/gcl/lsp/evalmacros.lsp, /cvsroot/gcl/gcl/lsp/export.lsp, /cvsroot/gcl/gcl/lsp/fasd.lisp, /cvsroot/gcl/gcl/lsp/fast-mv.lisp, /cvsroot/gcl/gcl/lsp/fdecl.lsp, /cvsroot/gcl/gcl/lsp/gprof1.lisp, /cvsroot/gcl/gcl/lsp/gprof_aix.hc, /cvsroot/gcl/gcl/lsp/gprof.hc, /cvsroot/gcl/gcl/lsp/gprof.lsp, /cvsroot/gcl/gcl/lsp/info.c, /cvsroot/gcl/gcl/lsp/info.data, /cvsroot/gcl/gcl/lsp/info.h, /cvsroot/gcl/gcl/lsp/info.lsp, /cvsroot/gcl/gcl/lsp/iolib.c, /cvsroot/gcl/gcl/lsp/iolib.data, /cvsroot/gcl/gcl/lsp/iolib.h, /cvsroot/gcl/gcl/lsp/iolib.lsp, /cvsroot/gcl/gcl/lsp/jim, /cvsroot/gcl/gcl/lsp/listlib.c, /cvsroot/gcl/gcl/lsp/listlib.data, /cvsroot/gcl/gcl/lsp/listlib.h, /cvsroot/gcl/gcl/lsp/listlib.lsp, /cvsroot/gcl/gcl/lsp/serror.c: + initial checkin + + * /cvsroot/gcl/gcl/lsp/debug.h, /cvsroot/gcl/gcl/lsp/debug.lsp, /cvsroot/gcl/gcl/lsp/defmacro.c, /cvsroot/gcl/gcl/lsp/defmacro.data, /cvsroot/gcl/gcl/lsp/defmacro.h, /cvsroot/gcl/gcl/lsp/defmacro.lsp, /cvsroot/gcl/gcl/lsp/defstruct.c, /cvsroot/gcl/gcl/lsp/defstruct.data, /cvsroot/gcl/gcl/lsp/defstruct.h, /cvsroot/gcl/gcl/lsp/defstruct.lsp, /cvsroot/gcl/gcl/lsp/describe.c, /cvsroot/gcl/gcl/lsp/describe.data, /cvsroot/gcl/gcl/lsp/describe.h, /cvsroot/gcl/gcl/lsp/describe.lsp, /cvsroot/gcl/gcl/lsp/desetq.lsp, /cvsroot/gcl/gcl/lsp/doc-file.lsp, /cvsroot/gcl/gcl/lsp/dummy.lisp, /cvsroot/gcl/gcl/lsp/evalmacros.c, /cvsroot/gcl/gcl/lsp/evalmacros.data, /cvsroot/gcl/gcl/lsp/evalmacros.h, /cvsroot/gcl/gcl/lsp/evalmacros.lsp, /cvsroot/gcl/gcl/lsp/export.lsp, /cvsroot/gcl/gcl/lsp/fasd.lisp, /cvsroot/gcl/gcl/lsp/fast-mv.lisp, /cvsroot/gcl/gcl/lsp/fdecl.lsp, /cvsroot/gcl/gcl/lsp/gprof1.lisp, /cvsroot/gcl/gcl/lsp/gprof_aix.hc, /cvsroot/gcl/gcl/lsp/gprof.hc, /cvsroot/gcl/gcl/lsp/gprof.lsp, /cvsroot/gcl/gcl/lsp/info.c, /cvsroot/gcl/gcl/lsp/info.data, /cvsroot/gcl/gcl/lsp/info.h, /cvsroot/gcl/gcl/lsp/info.lsp, /cvsroot/gcl/gcl/lsp/iolib.c, /cvsroot/gcl/gcl/lsp/iolib.data, /cvsroot/gcl/gcl/lsp/iolib.h, /cvsroot/gcl/gcl/lsp/iolib.lsp, /cvsroot/gcl/gcl/lsp/jim, /cvsroot/gcl/gcl/lsp/listlib.c, /cvsroot/gcl/gcl/lsp/listlib.data, /cvsroot/gcl/gcl/lsp/listlib.h, /cvsroot/gcl/gcl/lsp/listlib.lsp, /cvsroot/gcl/gcl/lsp/serror.c: + New file. + + * /cvsroot/gcl/gcl/info/gcl-si.info-1.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-1.gz, /cvsroot/gcl/gcl/info/sequence.texi, /cvsroot/gcl/gcl/info/si-defs.texi, /cvsroot/gcl/gcl/info/structure.texi, /cvsroot/gcl/gcl/info/symbol.texi, /cvsroot/gcl/gcl/info/system.texi, /cvsroot/gcl/gcl/info/texinfo.tex, /cvsroot/gcl/gcl/info/type.texi, /cvsroot/gcl/gcl/info/user-interface.texi, /cvsroot/gcl/gcl/info/widgets.texi, /cvsroot/gcl/gcl/lsp/arraylib.c, /cvsroot/gcl/gcl/lsp/arraylib.data, /cvsroot/gcl/gcl/lsp/arraylib.h, /cvsroot/gcl/gcl/lsp/arraylib.lsp, /cvsroot/gcl/gcl/lsp/assert.c, /cvsroot/gcl/gcl/lsp/assert.data, /cvsroot/gcl/gcl/lsp/assert.h, /cvsroot/gcl/gcl/lsp/assert.lsp, /cvsroot/gcl/gcl/lsp/autocmp.lsp, /cvsroot/gcl/gcl/lsp/autoload.lsp, /cvsroot/gcl/gcl/lsp/auto.lsp, /cvsroot/gcl/gcl/lsp/cmpinit.lsp, /cvsroot/gcl/gcl/lsp/dbind.lisp, /cvsroot/gcl/gcl/lsp/debug.c, /cvsroot/gcl/gcl/lsp/debug.data: + initial checkin + + * /cvsroot/gcl/gcl/info/gcl-si.info-1.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-1.gz, /cvsroot/gcl/gcl/info/sequence.texi, /cvsroot/gcl/gcl/info/si-defs.texi, /cvsroot/gcl/gcl/info/structure.texi, /cvsroot/gcl/gcl/info/symbol.texi, /cvsroot/gcl/gcl/info/system.texi, /cvsroot/gcl/gcl/info/texinfo.tex, /cvsroot/gcl/gcl/info/type.texi, /cvsroot/gcl/gcl/info/user-interface.texi, /cvsroot/gcl/gcl/info/widgets.texi, /cvsroot/gcl/gcl/lsp/arraylib.c, /cvsroot/gcl/gcl/lsp/arraylib.data, /cvsroot/gcl/gcl/lsp/arraylib.h, /cvsroot/gcl/gcl/lsp/arraylib.lsp, /cvsroot/gcl/gcl/lsp/assert.c, /cvsroot/gcl/gcl/lsp/assert.data, /cvsroot/gcl/gcl/lsp/assert.h, /cvsroot/gcl/gcl/lsp/assert.lsp, /cvsroot/gcl/gcl/lsp/autocmp.lsp, /cvsroot/gcl/gcl/lsp/autoload.lsp, /cvsroot/gcl/gcl/lsp/auto.lsp, /cvsroot/gcl/gcl/lsp/cmpinit.lsp, /cvsroot/gcl/gcl/lsp/dbind.lisp, /cvsroot/gcl/gcl/lsp/debug.c, /cvsroot/gcl/gcl/lsp/debug.data: + New file. + + * /cvsroot/gcl/gcl/info/character.texi, /cvsroot/gcl/gcl/info/compiler-defs.texi, /cvsroot/gcl/gcl/info/compile.texi, /cvsroot/gcl/gcl/info/control.texi, /cvsroot/gcl/gcl/info/debug.texi, /cvsroot/gcl/gcl/info/doc.texi, /cvsroot/gcl/gcl/info/form.texi, /cvsroot/gcl/gcl/info/gcl-si.cp, /cvsroot/gcl/gcl/info/gcl-si-index.texi, /cvsroot/gcl/gcl/info/gcl-si.info, /cvsroot/gcl/gcl/info/gcl-si.info-2.gz, /cvsroot/gcl/gcl/info/gcl-si.info-3.gz, /cvsroot/gcl/gcl/info/gcl-si.info-4.gz, /cvsroot/gcl/gcl/info/gcl-si.info-5.gz, /cvsroot/gcl/gcl/info/gcl-si.info-6.gz, /cvsroot/gcl/gcl/info/gcl-si.ky, /cvsroot/gcl/gcl/info/gcl-si.pg, /cvsroot/gcl/gcl/info/gcl-si.texi, /cvsroot/gcl/gcl/info/gcl-si.toc, /cvsroot/gcl/gcl/info/gcl-si.tp, /cvsroot/gcl/gcl/info/gcl-si.vr, /cvsroot/gcl/gcl/info/gcl-tk.cp, /cvsroot/gcl/gcl/info/gcl-tk.info, /cvsroot/gcl/gcl/info/gcl-tk.info-2.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-3.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-4.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-5.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-6.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-7.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-8.gz, /cvsroot/gcl/gcl/info/gcl-tk.ky, /cvsroot/gcl/gcl/info/gcl-tk.pg, /cvsroot/gcl/gcl/info/gcl-tk.texi, /cvsroot/gcl/gcl/info/gcl-tk.toc, /cvsroot/gcl/gcl/info/gcl-tk.tp, /cvsroot/gcl/gcl/info/gcl-tk.vr, /cvsroot/gcl/gcl/info/general.texi, /cvsroot/gcl/gcl/info/internal.texi, /cvsroot/gcl/gcl/info/io.texi, /cvsroot/gcl/gcl/info/iteration.texi, /cvsroot/gcl/gcl/info/list.texi, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/info/misc.texi, /cvsroot/gcl/gcl/info/number.texi: + initial checkin + + * /cvsroot/gcl/gcl/info/character.texi, /cvsroot/gcl/gcl/info/compiler-defs.texi, /cvsroot/gcl/gcl/info/compile.texi, /cvsroot/gcl/gcl/info/control.texi, /cvsroot/gcl/gcl/info/debug.texi, /cvsroot/gcl/gcl/info/doc.texi, /cvsroot/gcl/gcl/info/form.texi, /cvsroot/gcl/gcl/info/gcl-si.cp, /cvsroot/gcl/gcl/info/gcl-si-index.texi, /cvsroot/gcl/gcl/info/gcl-si.info, /cvsroot/gcl/gcl/info/gcl-si.info-2.gz, /cvsroot/gcl/gcl/info/gcl-si.info-3.gz, /cvsroot/gcl/gcl/info/gcl-si.info-4.gz, /cvsroot/gcl/gcl/info/gcl-si.info-5.gz, /cvsroot/gcl/gcl/info/gcl-si.info-6.gz, /cvsroot/gcl/gcl/info/gcl-si.ky, /cvsroot/gcl/gcl/info/gcl-si.pg, /cvsroot/gcl/gcl/info/gcl-si.texi, /cvsroot/gcl/gcl/info/gcl-si.toc, /cvsroot/gcl/gcl/info/gcl-si.tp, /cvsroot/gcl/gcl/info/gcl-si.vr, /cvsroot/gcl/gcl/info/gcl-tk.cp, /cvsroot/gcl/gcl/info/gcl-tk.info, /cvsroot/gcl/gcl/info/gcl-tk.info-2.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-3.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-4.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-5.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-6.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-7.gz, /cvsroot/gcl/gcl/info/gcl-tk.info-8.gz, /cvsroot/gcl/gcl/info/gcl-tk.ky, /cvsroot/gcl/gcl/info/gcl-tk.pg, /cvsroot/gcl/gcl/info/gcl-tk.texi, /cvsroot/gcl/gcl/info/gcl-tk.toc, /cvsroot/gcl/gcl/info/gcl-tk.tp, /cvsroot/gcl/gcl/info/gcl-tk.vr, /cvsroot/gcl/gcl/info/general.texi, /cvsroot/gcl/gcl/info/internal.texi, /cvsroot/gcl/gcl/info/io.texi, /cvsroot/gcl/gcl/info/iteration.texi, /cvsroot/gcl/gcl/info/list.texi, /cvsroot/gcl/gcl/info/makefile, /cvsroot/gcl/gcl/info/misc.texi, /cvsroot/gcl/gcl/info/number.texi: + New file. + + * /cvsroot/gcl/gcl/h/att.h, /cvsroot/gcl/gcl/h/cmplrs/stsupport.h, /cvsroot/gcl/gcl/h/coff/i386.h, /cvsroot/gcl/gcl/h/cyglacks.h, /cvsroot/gcl/gcl/h/ext_sym.h, /cvsroot/gcl/gcl/h/gclincl.h.in, /cvsroot/gcl/gcl/h/gnuwin95.defs, /cvsroot/gcl/gcl/h/gnuwin95.h, /cvsroot/gcl/gcl/h/options.h, /cvsroot/gcl/gcl/h/ptable.h, /cvsroot/gcl/gcl/h/rgbc.h, /cvsroot/gcl/gcl/h/rios-aix3.defs, /cvsroot/gcl/gcl/h/rios-aix3.h, /cvsroot/gcl/gcl/h/rios.defs, /cvsroot/gcl/gcl/h/rios.h, /cvsroot/gcl/gcl/h/rt_aix.defs, /cvsroot/gcl/gcl/h/rt_aix.h, /cvsroot/gcl/gcl/h/s3000.h, /cvsroot/gcl/gcl/h/secondary_sun_magic, /cvsroot/gcl/gcl/h/sfun_argd.h, /cvsroot/gcl/gcl/h/sgi4d.defs, /cvsroot/gcl/gcl/h/sgi4d.h, /cvsroot/gcl/gcl/h/sgi.defs, /cvsroot/gcl/gcl/h/sgi.h, /cvsroot/gcl/gcl/h/solaris.defs, /cvsroot/gcl/gcl/h/solaris.h, /cvsroot/gcl/gcl/h/solaris-i386.defs, /cvsroot/gcl/gcl/h/solaris-i386.h, /cvsroot/gcl/gcl/h/sparc.h, /cvsroot/gcl/gcl/h/sparc-linux.defs, /cvsroot/gcl/gcl/h/sparc-linux.h, /cvsroot/gcl/gcl/h/stacks.h, /cvsroot/gcl/gcl/h/sun2r3.defs, /cvsroot/gcl/gcl/h/sun2r3.h, /cvsroot/gcl/gcl/h/sun386i.defs, /cvsroot/gcl/gcl/h/sun386i.h, /cvsroot/gcl/gcl/h/sun3.defs, /cvsroot/gcl/gcl/h/sun3.h, /cvsroot/gcl/gcl/h/sun3-os4.defs, /cvsroot/gcl/gcl/h/sun3-os4.h, /cvsroot/gcl/gcl/h/sun4.defs, /cvsroot/gcl/gcl/h/sun4.h, /cvsroot/gcl/gcl/h/sun.h, /cvsroot/gcl/gcl/h/symbol.h, /cvsroot/gcl/gcl/h/symmetry.defs, /cvsroot/gcl/gcl/h/symmetry.h, /cvsroot/gcl/gcl/h/twelve_null, /cvsroot/gcl/gcl/h/u370_aix.defs, /cvsroot/gcl/gcl/h/u370_aix.h, /cvsroot/gcl/gcl/h/usig.h, /cvsroot/gcl/gcl/h/vax.defs, /cvsroot/gcl/gcl/h/vax.h, /cvsroot/gcl/gcl/h/vs.h, /cvsroot/gcl/gcl/h/wincoff.h, /cvsroot/gcl/gcl/info/bind.texi, /cvsroot/gcl/gcl/info/c-interface.texi: + initial checkin + + * /cvsroot/gcl/gcl/h/att.h, /cvsroot/gcl/gcl/h/cmplrs/stsupport.h, /cvsroot/gcl/gcl/h/coff/i386.h, /cvsroot/gcl/gcl/h/cyglacks.h, /cvsroot/gcl/gcl/h/ext_sym.h, /cvsroot/gcl/gcl/h/gclincl.h.in, /cvsroot/gcl/gcl/h/gnuwin95.defs, /cvsroot/gcl/gcl/h/gnuwin95.h, /cvsroot/gcl/gcl/h/options.h, /cvsroot/gcl/gcl/h/ptable.h, /cvsroot/gcl/gcl/h/rgbc.h, /cvsroot/gcl/gcl/h/rios-aix3.defs, /cvsroot/gcl/gcl/h/rios-aix3.h, /cvsroot/gcl/gcl/h/rios.defs, /cvsroot/gcl/gcl/h/rios.h, /cvsroot/gcl/gcl/h/rt_aix.defs, /cvsroot/gcl/gcl/h/rt_aix.h, /cvsroot/gcl/gcl/h/s3000.h, /cvsroot/gcl/gcl/h/secondary_sun_magic, /cvsroot/gcl/gcl/h/sfun_argd.h, /cvsroot/gcl/gcl/h/sgi4d.defs, /cvsroot/gcl/gcl/h/sgi4d.h, /cvsroot/gcl/gcl/h/sgi.defs, /cvsroot/gcl/gcl/h/sgi.h, /cvsroot/gcl/gcl/h/solaris.defs, /cvsroot/gcl/gcl/h/solaris.h, /cvsroot/gcl/gcl/h/solaris-i386.defs, /cvsroot/gcl/gcl/h/solaris-i386.h, /cvsroot/gcl/gcl/h/sparc.h, /cvsroot/gcl/gcl/h/sparc-linux.defs, /cvsroot/gcl/gcl/h/sparc-linux.h, /cvsroot/gcl/gcl/h/stacks.h, /cvsroot/gcl/gcl/h/sun2r3.defs, /cvsroot/gcl/gcl/h/sun2r3.h, /cvsroot/gcl/gcl/h/sun386i.defs, /cvsroot/gcl/gcl/h/sun386i.h, /cvsroot/gcl/gcl/h/sun3.defs, /cvsroot/gcl/gcl/h/sun3.h, /cvsroot/gcl/gcl/h/sun3-os4.defs, /cvsroot/gcl/gcl/h/sun3-os4.h, /cvsroot/gcl/gcl/h/sun4.defs, /cvsroot/gcl/gcl/h/sun4.h, /cvsroot/gcl/gcl/h/sun.h, /cvsroot/gcl/gcl/h/symbol.h, /cvsroot/gcl/gcl/h/symmetry.defs, /cvsroot/gcl/gcl/h/symmetry.h, /cvsroot/gcl/gcl/h/twelve_null, /cvsroot/gcl/gcl/h/u370_aix.defs, /cvsroot/gcl/gcl/h/u370_aix.h, /cvsroot/gcl/gcl/h/usig.h, /cvsroot/gcl/gcl/h/vax.defs, /cvsroot/gcl/gcl/h/vax.h, /cvsroot/gcl/gcl/h/vs.h, /cvsroot/gcl/gcl/h/wincoff.h, /cvsroot/gcl/gcl/info/bind.texi, /cvsroot/gcl/gcl/info/c-interface.texi: + New file. + + * /cvsroot/gcl/gcl/h/cmponly.h, /cvsroot/gcl/gcl/h/coff_encap.h, /cvsroot/gcl/gcl/h/compat.h, /cvsroot/gcl/gcl/h/compbas2.h, /cvsroot/gcl/gcl/h/compbas.h, /cvsroot/gcl/gcl/h/convex.h, /cvsroot/gcl/gcl/h/dec3100.defs, /cvsroot/gcl/gcl/h/dec3100.h, /cvsroot/gcl/gcl/h/defun.h, /cvsroot/gcl/gcl/h/dos-go32.defs, /cvsroot/gcl/gcl/h/dos-go32.h, /cvsroot/gcl/gcl/h/e15.h, /cvsroot/gcl/gcl/h/enum.h, /cvsroot/gcl/gcl/h/erreurs.h, /cvsroot/gcl/gcl/h/eval.h, /cvsroot/gcl/gcl/h/frame.h, /cvsroot/gcl/gcl/h/FreeBSD.defs, /cvsroot/gcl/gcl/h/FreeBSD.h, /cvsroot/gcl/gcl/h/funlink.h, /cvsroot/gcl/gcl/h/gencom.h, /cvsroot/gcl/gcl/h/genpari.h, /cvsroot/gcl/gcl/h/genport.h, /cvsroot/gcl/gcl/h/getpagesize.h, /cvsroot/gcl/gcl/h/hp300-bsd.defs, /cvsroot/gcl/gcl/h/hp300-bsd.h, /cvsroot/gcl/gcl/h/hp300.defs, /cvsroot/gcl/gcl/h/hp300.h, /cvsroot/gcl/gcl/h/hp800.defs, /cvsroot/gcl/gcl/h/hp800.h, /cvsroot/gcl/gcl/h/include.h, /cvsroot/gcl/gcl/h/irix5.defs, /cvsroot/gcl/gcl/h/irix5.h, /cvsroot/gcl/gcl/h/irix6.defs, /cvsroot/gcl/gcl/h/irix6.h, /cvsroot/gcl/gcl/h/lex.h, /cvsroot/gcl/gcl/h/mac2.defs, /cvsroot/gcl/gcl/h/mac2.h, /cvsroot/gcl/gcl/h/make-decl.h, /cvsroot/gcl/gcl/h/make-init.h, /cvsroot/gcl/gcl/h/mc68k.h, /cvsroot/gcl/gcl/h/mdefs.h, /cvsroot/gcl/gcl/h/mips.h, /cvsroot/gcl/gcl/h/mp386.defs, /cvsroot/gcl/gcl/h/mp386.h, /cvsroot/gcl/gcl/h/mp.h, /cvsroot/gcl/gcl/h/ncr.defs, /cvsroot/gcl/gcl/h/ncr.h, /cvsroot/gcl/gcl/h/NetBSD.defs, /cvsroot/gcl/gcl/h/NetBSD.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/h/news.h, /cvsroot/gcl/gcl/h/NeXT30-m68k.defs, /cvsroot/gcl/gcl/h/NeXT30-m68k.h, /cvsroot/gcl/gcl/h/NeXT32-i386.defs, /cvsroot/gcl/gcl/h/NeXT32-i386.h, /cvsroot/gcl/gcl/h/NeXT32-m68k.defs, /cvsroot/gcl/gcl/h/NeXT32-m68k.h, /cvsroot/gcl/gcl/h/NeXT.defs, /cvsroot/gcl/gcl/h/NeXT.h, /cvsroot/gcl/gcl/h/notcomp.h, /cvsroot/gcl/gcl/h/num_include.h, /cvsroot/gcl/gcl/h/object.h, /cvsroot/gcl/gcl/h/page.h: + initial checkin + + * /cvsroot/gcl/gcl/h/cmponly.h, /cvsroot/gcl/gcl/h/coff_encap.h, /cvsroot/gcl/gcl/h/compat.h, /cvsroot/gcl/gcl/h/compbas2.h, /cvsroot/gcl/gcl/h/compbas.h, /cvsroot/gcl/gcl/h/convex.h, /cvsroot/gcl/gcl/h/dec3100.defs, /cvsroot/gcl/gcl/h/dec3100.h, /cvsroot/gcl/gcl/h/defun.h, /cvsroot/gcl/gcl/h/dos-go32.defs, /cvsroot/gcl/gcl/h/dos-go32.h, /cvsroot/gcl/gcl/h/e15.h, /cvsroot/gcl/gcl/h/enum.h, /cvsroot/gcl/gcl/h/erreurs.h, /cvsroot/gcl/gcl/h/eval.h, /cvsroot/gcl/gcl/h/frame.h, /cvsroot/gcl/gcl/h/FreeBSD.defs, /cvsroot/gcl/gcl/h/FreeBSD.h, /cvsroot/gcl/gcl/h/funlink.h, /cvsroot/gcl/gcl/h/gencom.h, /cvsroot/gcl/gcl/h/genpari.h, /cvsroot/gcl/gcl/h/genport.h, /cvsroot/gcl/gcl/h/getpagesize.h, /cvsroot/gcl/gcl/h/hp300-bsd.defs, /cvsroot/gcl/gcl/h/hp300-bsd.h, /cvsroot/gcl/gcl/h/hp300.defs, /cvsroot/gcl/gcl/h/hp300.h, /cvsroot/gcl/gcl/h/hp800.defs, /cvsroot/gcl/gcl/h/hp800.h, /cvsroot/gcl/gcl/h/include.h, /cvsroot/gcl/gcl/h/irix5.defs, /cvsroot/gcl/gcl/h/irix5.h, /cvsroot/gcl/gcl/h/irix6.defs, /cvsroot/gcl/gcl/h/irix6.h, /cvsroot/gcl/gcl/h/lex.h, /cvsroot/gcl/gcl/h/mac2.defs, /cvsroot/gcl/gcl/h/mac2.h, /cvsroot/gcl/gcl/h/make-decl.h, /cvsroot/gcl/gcl/h/make-init.h, /cvsroot/gcl/gcl/h/mc68k.h, /cvsroot/gcl/gcl/h/mdefs.h, /cvsroot/gcl/gcl/h/mips.h, /cvsroot/gcl/gcl/h/mp386.defs, /cvsroot/gcl/gcl/h/mp386.h, /cvsroot/gcl/gcl/h/mp.h, /cvsroot/gcl/gcl/h/ncr.defs, /cvsroot/gcl/gcl/h/ncr.h, /cvsroot/gcl/gcl/h/NetBSD.defs, /cvsroot/gcl/gcl/h/NetBSD.h, /cvsroot/gcl/gcl/h/new_decl.h, /cvsroot/gcl/gcl/h/news.h, /cvsroot/gcl/gcl/h/NeXT30-m68k.defs, /cvsroot/gcl/gcl/h/NeXT30-m68k.h, /cvsroot/gcl/gcl/h/NeXT32-i386.defs, /cvsroot/gcl/gcl/h/NeXT32-i386.h, /cvsroot/gcl/gcl/h/NeXT32-m68k.defs, /cvsroot/gcl/gcl/h/NeXT32-m68k.h, /cvsroot/gcl/gcl/h/NeXT.defs, /cvsroot/gcl/gcl/h/NeXT.h, /cvsroot/gcl/gcl/h/notcomp.h, /cvsroot/gcl/gcl/h/num_include.h, /cvsroot/gcl/gcl/h/object.h, /cvsroot/gcl/gcl/h/page.h: + New file. + + * /cvsroot/gcl/gcl/gcl-tk/demos-4.1/items.lisp, /cvsroot/gcl/gcl/gcl-tk/demos-4.2/widget, /cvsroot/gcl/gcl/gcl-tk/demos-4.2/widget.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkForm.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkForm.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkHScale.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkHScale.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkIcon.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkItems.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkItems.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkLabel.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkLabel.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox2.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox3.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkPlot.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkPlot.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkPuzzle.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkRadio.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkRadio.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkRuler.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkRuler.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkScroll.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkSearch.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkSearch.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkStyles.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkStyles.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkTear.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkTextBind.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkTextBind.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkVScale.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkVScale.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/nqthm-stack.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/showVars.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/showVars.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/tclIndex, /cvsroot/gcl/gcl/gcl-tk/demos/widget.lisp, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/386-bsd.defs, /cvsroot/gcl/gcl/h/386-bsd.h, /cvsroot/gcl/gcl/h/386.h, /cvsroot/gcl/gcl/h/386-linux.defs, /cvsroot/gcl/gcl/h/386-linux.h, /cvsroot/gcl/gcl/h/alpha-osf1.defs, /cvsroot/gcl/gcl/h/alpha-osf1.h, /cvsroot/gcl/gcl/h/arith.h, /cvsroot/gcl/gcl/h/att3b2.h, /cvsroot/gcl/gcl/h/att_ext.h, /cvsroot/gcl/gcl/h/bds.h, /cvsroot/gcl/gcl/h/bsd.h, /cvsroot/gcl/gcl/h/cmpincl1.h, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/gclincl.h: + initial checkin + + * /cvsroot/gcl/gcl/gcl-tk/demos-4.1/items.lisp, /cvsroot/gcl/gcl/gcl-tk/demos-4.2/widget, /cvsroot/gcl/gcl/gcl-tk/demos-4.2/widget.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkForm.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkForm.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkHScale.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkHScale.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkIcon.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkItems.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkItems.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkLabel.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkLabel.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox2.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox3.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkListbox.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkPlot.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkPlot.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkPuzzle.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkRadio.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkRadio.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkRuler.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkRuler.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkScroll.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkSearch.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkSearch.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkStyles.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkStyles.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkTear.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkTextBind.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkTextBind.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkVScale.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkVScale.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/nqthm-stack.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/showVars.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/showVars.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/tclIndex, /cvsroot/gcl/gcl/gcl-tk/demos/widget.lisp, /cvsroot/gcl/gcl/go/makefile, /cvsroot/gcl/gcl/h/386-bsd.defs, /cvsroot/gcl/gcl/h/386-bsd.h, /cvsroot/gcl/gcl/h/386.h, /cvsroot/gcl/gcl/h/386-linux.defs, /cvsroot/gcl/gcl/h/386-linux.h, /cvsroot/gcl/gcl/h/alpha-osf1.defs, /cvsroot/gcl/gcl/h/alpha-osf1.h, /cvsroot/gcl/gcl/h/arith.h, /cvsroot/gcl/gcl/h/att3b2.h, /cvsroot/gcl/gcl/h/att_ext.h, /cvsroot/gcl/gcl/h/bds.h, /cvsroot/gcl/gcl/h/bsd.h, /cvsroot/gcl/gcl/h/cmpincl1.h, /cvsroot/gcl/gcl/h/cmpinclude.h, /cvsroot/gcl/gcl/h/gclincl.h: + New file. + + * /cvsroot/gcl/gcl/gcl-tk/decode.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/gc-monitor.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/index.lsp, /cvsroot/gcl/gcl/gcl-tk/demos/mkArrow.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkBasic.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkBasic.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkBitmaps.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkButton.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkCanvText.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkCanvText.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkCheck.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkdialog.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkDialog.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry2.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry2.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkFloor.tcl, /cvsroot/gcl/gcl/gcl-tk/gcl_guisl.h, /cvsroot/gcl/gcl/gcl-tk/gcltksrv, /cvsroot/gcl/gcl/gcl-tk/gcltksrv.in.interp, /cvsroot/gcl/gcl/gcl-tk/gcltksrv.prev, /cvsroot/gcl/gcl/gcl-tk/guis.c, /cvsroot/gcl/gcl/gcl-tk/guis.h, /cvsroot/gcl/gcl/gcl-tk/helpers.lisp, /cvsroot/gcl/gcl/gcl-tk/index.lsp, /cvsroot/gcl/gcl/gcl-tk/intrs.h, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile.prev, /cvsroot/gcl/gcl/gcl-tk/ngcltksrv, /cvsroot/gcl/gcl/gcl-tk/our_io.c, /cvsroot/gcl/gcl/gcl-tk/sheader.h, /cvsroot/gcl/gcl/gcl-tk/socketsl.lisp, /cvsroot/gcl/gcl/gcl-tk/socks.h, /cvsroot/gcl/gcl/gcl-tk/sysdep-sunos.h, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/gcl-tk/tinfo.lsp, /cvsroot/gcl/gcl/gcl-tk/tkAppInit.c, /cvsroot/gcl/gcl/gcl-tk/tkl.lisp, /cvsroot/gcl/gcl/gcl-tk/tkMain.c, /cvsroot/gcl/gcl/gcl-tk/tk-package.lsp, /cvsroot/gcl/gcl/gcl-tk/tktst.c, /cvsroot/gcl/gcl/gcl-tk/tkXAppInit.c, /cvsroot/gcl/gcl/gcl-tk/tkXshell.c: + initial checkin + + * /cvsroot/gcl/gcl/gcl-tk/decode.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/gc-monitor.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/index.lsp, /cvsroot/gcl/gcl/gcl-tk/demos/mkArrow.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkBasic.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkBasic.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkBitmaps.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkButton.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkCanvText.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkCanvText.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkCheck.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkdialog.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkDialog.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry2.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry2.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry.lisp, /cvsroot/gcl/gcl/gcl-tk/demos/mkEntry.tcl, /cvsroot/gcl/gcl/gcl-tk/demos/mkFloor.tcl, /cvsroot/gcl/gcl/gcl-tk/gcl_guisl.h, /cvsroot/gcl/gcl/gcl-tk/gcltksrv, /cvsroot/gcl/gcl/gcl-tk/gcltksrv.in.interp, /cvsroot/gcl/gcl/gcl-tk/gcltksrv.prev, /cvsroot/gcl/gcl/gcl-tk/guis.c, /cvsroot/gcl/gcl/gcl-tk/guis.h, /cvsroot/gcl/gcl/gcl-tk/helpers.lisp, /cvsroot/gcl/gcl/gcl-tk/index.lsp, /cvsroot/gcl/gcl/gcl-tk/intrs.h, /cvsroot/gcl/gcl/gcl-tk/makefile, /cvsroot/gcl/gcl/gcl-tk/makefile.prev, /cvsroot/gcl/gcl/gcl-tk/ngcltksrv, /cvsroot/gcl/gcl/gcl-tk/our_io.c, /cvsroot/gcl/gcl/gcl-tk/sheader.h, /cvsroot/gcl/gcl/gcl-tk/socketsl.lisp, /cvsroot/gcl/gcl/gcl-tk/socks.h, /cvsroot/gcl/gcl/gcl-tk/sysdep-sunos.h, /cvsroot/gcl/gcl/gcl-tk/tinfo.c, /cvsroot/gcl/gcl/gcl-tk/tinfo.lsp, /cvsroot/gcl/gcl/gcl-tk/tkAppInit.c, /cvsroot/gcl/gcl/gcl-tk/tkl.lisp, /cvsroot/gcl/gcl/gcl-tk/tkMain.c, /cvsroot/gcl/gcl/gcl-tk/tk-package.lsp, /cvsroot/gcl/gcl/gcl-tk/tktst.c, /cvsroot/gcl/gcl/gcl-tk/tkXAppInit.c, /cvsroot/gcl/gcl/gcl-tk/tkXshell.c: + New file. + + * /cvsroot/gcl/gcl/comp/top1.lsp, /cvsroot/gcl/gcl/comp/top2.lsp, /cvsroot/gcl/gcl/comp/try1.lsp, /cvsroot/gcl/gcl/comp/try.lsp, /cvsroot/gcl/gcl/comp/utils.lsp, /cvsroot/gcl/gcl/comp/var.lsp, /cvsroot/gcl/gcl/comp/wr.lsp, /cvsroot/gcl/gcl/doc/bignum, /cvsroot/gcl/gcl/doc/c-gc, /cvsroot/gcl/gcl/doc/c-gc.doc, /cvsroot/gcl/gcl/doc/compile-file-handling-of-top-level-forms, /cvsroot/gcl/gcl/doc/contributors, /cvsroot/gcl/gcl/doc/debug, /cvsroot/gcl/gcl/doc/enhancements, /cvsroot/gcl/gcl/doc/fast-link, /cvsroot/gcl/gcl/doc/format, /cvsroot/gcl/gcl/doc/funcall-comp, /cvsroot/gcl/gcl/doc/funcall.lsp, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/doc/multiple-values, /cvsroot/gcl/gcl/doc/profile, /cvsroot/gcl/gcl/dos/dostimes.c, /cvsroot/gcl/gcl/dos/dum_dos.c, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/dos/readme, /cvsroot/gcl/gcl/dos/read.s, /cvsroot/gcl/gcl/dos/sigman.s, /cvsroot/gcl/gcl/dos/signal.c, /cvsroot/gcl/gcl/dos/signal.h, /cvsroot/gcl/gcl/elisp/add-default.el, /cvsroot/gcl/gcl/elisp/ansi-doc.el, /cvsroot/gcl/gcl/elisp/dbl.el, /cvsroot/gcl/gcl/elisp/doc-to-texi.el, /cvsroot/gcl/gcl/elisp/gcl.el, /cvsroot/gcl/gcl/elisp/lisp-complete.el, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/elisp/man1-to-texi.el, /cvsroot/gcl/gcl/elisp/readme, /cvsroot/gcl/gcl/elisp/smart-complete.el, /cvsroot/gcl/gcl/elisp/sshell.el, /cvsroot/gcl/gcl/gcl-tk/cmpinit.lsp, /cvsroot/gcl/gcl/gcl-tk/comm.c, /cvsroot/gcl/gcl/gcl-tk/convert.el, /cvsroot/gcl/gcl/gcl-tk/dir.sed, /cvsroot/gcl/gcl/gcl-tk/gcl-1.tcl, /cvsroot/gcl/gcl/gcl-tk/gcl.tcl, /cvsroot/gcl/gcl/gcl-tk/gcltksrv.in: + initial checkin + + * /cvsroot/gcl/gcl/comp/top1.lsp, /cvsroot/gcl/gcl/comp/top2.lsp, /cvsroot/gcl/gcl/comp/try1.lsp, /cvsroot/gcl/gcl/comp/try.lsp, /cvsroot/gcl/gcl/comp/utils.lsp, /cvsroot/gcl/gcl/comp/var.lsp, /cvsroot/gcl/gcl/comp/wr.lsp, /cvsroot/gcl/gcl/doc/bignum, /cvsroot/gcl/gcl/doc/c-gc, /cvsroot/gcl/gcl/doc/c-gc.doc, /cvsroot/gcl/gcl/doc/compile-file-handling-of-top-level-forms, /cvsroot/gcl/gcl/doc/contributors, /cvsroot/gcl/gcl/doc/debug, /cvsroot/gcl/gcl/doc/enhancements, /cvsroot/gcl/gcl/doc/fast-link, /cvsroot/gcl/gcl/doc/format, /cvsroot/gcl/gcl/doc/funcall-comp, /cvsroot/gcl/gcl/doc/funcall.lsp, /cvsroot/gcl/gcl/doc/makefile, /cvsroot/gcl/gcl/doc/multiple-values, /cvsroot/gcl/gcl/doc/profile, /cvsroot/gcl/gcl/dos/dostimes.c, /cvsroot/gcl/gcl/dos/dum_dos.c, /cvsroot/gcl/gcl/dos/makefile, /cvsroot/gcl/gcl/dos/readme, /cvsroot/gcl/gcl/dos/read.s, /cvsroot/gcl/gcl/dos/sigman.s, /cvsroot/gcl/gcl/dos/signal.c, /cvsroot/gcl/gcl/dos/signal.h, /cvsroot/gcl/gcl/elisp/add-default.el, /cvsroot/gcl/gcl/elisp/ansi-doc.el, /cvsroot/gcl/gcl/elisp/dbl.el, /cvsroot/gcl/gcl/elisp/doc-to-texi.el, /cvsroot/gcl/gcl/elisp/gcl.el, /cvsroot/gcl/gcl/elisp/lisp-complete.el, /cvsroot/gcl/gcl/elisp/makefile, /cvsroot/gcl/gcl/elisp/man1-to-texi.el, /cvsroot/gcl/gcl/elisp/readme, /cvsroot/gcl/gcl/elisp/smart-complete.el, /cvsroot/gcl/gcl/elisp/sshell.el, /cvsroot/gcl/gcl/gcl-tk/cmpinit.lsp, /cvsroot/gcl/gcl/gcl-tk/comm.c, /cvsroot/gcl/gcl/gcl-tk/convert.el, /cvsroot/gcl/gcl/gcl-tk/dir.sed, /cvsroot/gcl/gcl/gcl-tk/gcl-1.tcl, /cvsroot/gcl/gcl/gcl-tk/gcl.tcl, /cvsroot/gcl/gcl/gcl-tk/gcltksrv.in: + New file. + + * /cvsroot/gcl/gcl/cmpnew/cmpmain.lsp, /cvsroot/gcl/gcl/cmpnew/cmptype.h, /cvsroot/gcl/gcl/cmpnew/cmptype.lsp, /cvsroot/gcl/gcl/cmpnew/cmputil.c, /cvsroot/gcl/gcl/cmpnew/cmputil.data, /cvsroot/gcl/gcl/cmpnew/cmputil.h, /cvsroot/gcl/gcl/cmpnew/cmputil.lsp, /cvsroot/gcl/gcl/cmpnew/cmpvar.c, /cvsroot/gcl/gcl/cmpnew/cmpvar.data, /cvsroot/gcl/gcl/cmpnew/cmpvar.h, /cvsroot/gcl/gcl/cmpnew/cmpvar.lsp, /cvsroot/gcl/gcl/cmpnew/cmpvs.c, /cvsroot/gcl/gcl/cmpnew/cmpvs.data, /cvsroot/gcl/gcl/cmpnew/cmpvs.h, /cvsroot/gcl/gcl/cmpnew/cmpvs.lsp, /cvsroot/gcl/gcl/cmpnew/cmpwt.c, /cvsroot/gcl/gcl/cmpnew/cmpwt.data, /cvsroot/gcl/gcl/cmpnew/cmpwt.h, /cvsroot/gcl/gcl/cmpnew/cmpwt.lsp, /cvsroot/gcl/gcl/cmpnew/collectfn.lsp, /cvsroot/gcl/gcl/cmpnew/fasdmacros.lsp, /cvsroot/gcl/gcl/cmpnew/init.lsp, /cvsroot/gcl/gcl/cmpnew/lfun_list.lsp, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/cmpnew/make-fn.lsp, /cvsroot/gcl/gcl/cmpnew/make_ufun.lsp, /cvsroot/gcl/gcl/cmpnew/nocmpinc.lsp, /cvsroot/gcl/gcl/cmpnew/so_locations, /cvsroot/gcl/gcl/cmpnew/sys-proclaim.lisp, /cvsroot/gcl/gcl/comp/bo1.lsp, /cvsroot/gcl/gcl/comp/cmpinit.lsp, /cvsroot/gcl/gcl/comp/comptype.lsp, /cvsroot/gcl/gcl/comp/c-pass1.lsp, /cvsroot/gcl/gcl/comp/data.lsp, /cvsroot/gcl/gcl/comp/defmacro.lsp, /cvsroot/gcl/gcl/comp/defs.lsp, /cvsroot/gcl/gcl/comp/exit.lsp, /cvsroot/gcl/gcl/comp/fasdmacros.lsp, /cvsroot/gcl/gcl/comp/inline.lsp, /cvsroot/gcl/gcl/comp/integer.doc, /cvsroot/gcl/gcl/comp/lambda.lsp, /cvsroot/gcl/gcl/comp/lisp-decls.doc, /cvsroot/gcl/gcl/comp/macros.lsp, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/comp/mangle.lsp, /cvsroot/gcl/gcl/comp/opts-base.lsp, /cvsroot/gcl/gcl/comp/opts.lsp, /cvsroot/gcl/gcl/comp/proclaim.lsp, /cvsroot/gcl/gcl/comp/smash-oldcmp.lsp, /cvsroot/gcl/gcl/comp/stmt.lsp, /cvsroot/gcl/gcl/comp/sysdef.lsp, /cvsroot/gcl/gcl/comp/top.lsp: + initial checkin + + * /cvsroot/gcl/gcl/cmpnew/cmpmain.lsp, /cvsroot/gcl/gcl/cmpnew/cmptype.h, /cvsroot/gcl/gcl/cmpnew/cmptype.lsp, /cvsroot/gcl/gcl/cmpnew/cmputil.c, /cvsroot/gcl/gcl/cmpnew/cmputil.data, /cvsroot/gcl/gcl/cmpnew/cmputil.h, /cvsroot/gcl/gcl/cmpnew/cmputil.lsp, /cvsroot/gcl/gcl/cmpnew/cmpvar.c, /cvsroot/gcl/gcl/cmpnew/cmpvar.data, /cvsroot/gcl/gcl/cmpnew/cmpvar.h, /cvsroot/gcl/gcl/cmpnew/cmpvar.lsp, /cvsroot/gcl/gcl/cmpnew/cmpvs.c, /cvsroot/gcl/gcl/cmpnew/cmpvs.data, /cvsroot/gcl/gcl/cmpnew/cmpvs.h, /cvsroot/gcl/gcl/cmpnew/cmpvs.lsp, /cvsroot/gcl/gcl/cmpnew/cmpwt.c, /cvsroot/gcl/gcl/cmpnew/cmpwt.data, /cvsroot/gcl/gcl/cmpnew/cmpwt.h, /cvsroot/gcl/gcl/cmpnew/cmpwt.lsp, /cvsroot/gcl/gcl/cmpnew/collectfn.lsp, /cvsroot/gcl/gcl/cmpnew/fasdmacros.lsp, /cvsroot/gcl/gcl/cmpnew/init.lsp, /cvsroot/gcl/gcl/cmpnew/lfun_list.lsp, /cvsroot/gcl/gcl/cmpnew/makefile, /cvsroot/gcl/gcl/cmpnew/make-fn.lsp, /cvsroot/gcl/gcl/cmpnew/make_ufun.lsp, /cvsroot/gcl/gcl/cmpnew/nocmpinc.lsp, /cvsroot/gcl/gcl/cmpnew/so_locations, /cvsroot/gcl/gcl/cmpnew/sys-proclaim.lisp, /cvsroot/gcl/gcl/comp/bo1.lsp, /cvsroot/gcl/gcl/comp/cmpinit.lsp, /cvsroot/gcl/gcl/comp/comptype.lsp, /cvsroot/gcl/gcl/comp/c-pass1.lsp, /cvsroot/gcl/gcl/comp/data.lsp, /cvsroot/gcl/gcl/comp/defmacro.lsp, /cvsroot/gcl/gcl/comp/defs.lsp, /cvsroot/gcl/gcl/comp/exit.lsp, /cvsroot/gcl/gcl/comp/fasdmacros.lsp, /cvsroot/gcl/gcl/comp/inline.lsp, /cvsroot/gcl/gcl/comp/integer.doc, /cvsroot/gcl/gcl/comp/lambda.lsp, /cvsroot/gcl/gcl/comp/lisp-decls.doc, /cvsroot/gcl/gcl/comp/macros.lsp, /cvsroot/gcl/gcl/comp/makefile, /cvsroot/gcl/gcl/comp/mangle.lsp, /cvsroot/gcl/gcl/comp/opts-base.lsp, /cvsroot/gcl/gcl/comp/opts.lsp, /cvsroot/gcl/gcl/comp/proclaim.lsp, /cvsroot/gcl/gcl/comp/smash-oldcmp.lsp, /cvsroot/gcl/gcl/comp/stmt.lsp, /cvsroot/gcl/gcl/comp/sysdef.lsp, /cvsroot/gcl/gcl/comp/top.lsp: + New file. + + * /cvsroot/gcl/gcl/cmpnew/cmplam.data, /cvsroot/gcl/gcl/cmpnew/cmplam.h, /cvsroot/gcl/gcl/cmpnew/cmplam.lsp, /cvsroot/gcl/gcl/cmpnew/cmplet.c, /cvsroot/gcl/gcl/cmpnew/cmplet.data, /cvsroot/gcl/gcl/cmpnew/cmplet.h, /cvsroot/gcl/gcl/cmpnew/cmplet.lsp, /cvsroot/gcl/gcl/cmpnew/cmploc.c, /cvsroot/gcl/gcl/cmpnew/cmploc.data, /cvsroot/gcl/gcl/cmpnew/cmploc.h, /cvsroot/gcl/gcl/cmpnew/cmploc.lsp, /cvsroot/gcl/gcl/cmpnew/cmpmap.c, /cvsroot/gcl/gcl/cmpnew/cmpmap.data, /cvsroot/gcl/gcl/cmpnew/cmpmap.h, /cvsroot/gcl/gcl/cmpnew/cmpmap.lsp, /cvsroot/gcl/gcl/cmpnew/cmpmulti.c, /cvsroot/gcl/gcl/cmpnew/cmpmulti.data, /cvsroot/gcl/gcl/cmpnew/cmpmulti.h, /cvsroot/gcl/gcl/cmpnew/cmpmulti.lsp, /cvsroot/gcl/gcl/cmpnew/cmpopt.lsp, /cvsroot/gcl/gcl/cmpnew/cmpspecial.c, /cvsroot/gcl/gcl/cmpnew/cmpspecial.data, /cvsroot/gcl/gcl/cmpnew/cmpspecial.h, /cvsroot/gcl/gcl/cmpnew/cmpspecial.lsp, /cvsroot/gcl/gcl/cmpnew/cmptag.c, /cvsroot/gcl/gcl/cmpnew/cmptag.data, /cvsroot/gcl/gcl/cmpnew/cmptag.h, /cvsroot/gcl/gcl/cmpnew/cmptag.lsp, /cvsroot/gcl/gcl/cmpnew/cmptest.lsp, /cvsroot/gcl/gcl/cmpnew/cmptop.c, /cvsroot/gcl/gcl/cmpnew/cmptop.data, /cvsroot/gcl/gcl/cmpnew/cmptop.h, /cvsroot/gcl/gcl/cmpnew/cmptop.lsp, /cvsroot/gcl/gcl/cmpnew/cmptype.c, /cvsroot/gcl/gcl/cmpnew/cmptype.data: + initial checkin + + * /cvsroot/gcl/gcl/cmpnew/cmplam.data, /cvsroot/gcl/gcl/cmpnew/cmplam.h, /cvsroot/gcl/gcl/cmpnew/cmplam.lsp, /cvsroot/gcl/gcl/cmpnew/cmplet.c, /cvsroot/gcl/gcl/cmpnew/cmplet.data, /cvsroot/gcl/gcl/cmpnew/cmplet.h, /cvsroot/gcl/gcl/cmpnew/cmplet.lsp, /cvsroot/gcl/gcl/cmpnew/cmploc.c, /cvsroot/gcl/gcl/cmpnew/cmploc.data, /cvsroot/gcl/gcl/cmpnew/cmploc.h, /cvsroot/gcl/gcl/cmpnew/cmploc.lsp, /cvsroot/gcl/gcl/cmpnew/cmpmap.c, /cvsroot/gcl/gcl/cmpnew/cmpmap.data, /cvsroot/gcl/gcl/cmpnew/cmpmap.h, /cvsroot/gcl/gcl/cmpnew/cmpmap.lsp, /cvsroot/gcl/gcl/cmpnew/cmpmulti.c, /cvsroot/gcl/gcl/cmpnew/cmpmulti.data, /cvsroot/gcl/gcl/cmpnew/cmpmulti.h, /cvsroot/gcl/gcl/cmpnew/cmpmulti.lsp, /cvsroot/gcl/gcl/cmpnew/cmpopt.lsp, /cvsroot/gcl/gcl/cmpnew/cmpspecial.c, /cvsroot/gcl/gcl/cmpnew/cmpspecial.data, /cvsroot/gcl/gcl/cmpnew/cmpspecial.h, /cvsroot/gcl/gcl/cmpnew/cmpspecial.lsp, /cvsroot/gcl/gcl/cmpnew/cmptag.c, /cvsroot/gcl/gcl/cmpnew/cmptag.data, /cvsroot/gcl/gcl/cmpnew/cmptag.h, /cvsroot/gcl/gcl/cmpnew/cmptag.lsp, /cvsroot/gcl/gcl/cmpnew/cmptest.lsp, /cvsroot/gcl/gcl/cmpnew/cmptop.c, /cvsroot/gcl/gcl/cmpnew/cmptop.data, /cvsroot/gcl/gcl/cmpnew/cmptop.h, /cvsroot/gcl/gcl/cmpnew/cmptop.lsp, /cvsroot/gcl/gcl/cmpnew/cmptype.c, /cvsroot/gcl/gcl/cmpnew/cmptype.data: + New file. + + * /cvsroot/gcl/gcl/cmpnew/cmpenv.c, /cvsroot/gcl/gcl/cmpnew/cmpenv.data, /cvsroot/gcl/gcl/cmpnew/cmpenv.h, /cvsroot/gcl/gcl/cmpnew/cmpenv.lsp, /cvsroot/gcl/gcl/cmpnew/cmpeval.c, /cvsroot/gcl/gcl/cmpnew/cmpeval.data, /cvsroot/gcl/gcl/cmpnew/cmpeval.h, /cvsroot/gcl/gcl/cmpnew/cmpeval.lsp, /cvsroot/gcl/gcl/cmpnew/cmpflet.c, /cvsroot/gcl/gcl/cmpnew/cmpflet.data, /cvsroot/gcl/gcl/cmpnew/cmpflet.h, /cvsroot/gcl/gcl/cmpnew/cmpflet.lsp, /cvsroot/gcl/gcl/cmpnew/cmpfun.c, /cvsroot/gcl/gcl/cmpnew/cmpfun.data, /cvsroot/gcl/gcl/cmpnew/cmpfun.h, /cvsroot/gcl/gcl/cmpnew/cmpfun.lsp, /cvsroot/gcl/gcl/cmpnew/cmpif.c, /cvsroot/gcl/gcl/cmpnew/cmpif.data, /cvsroot/gcl/gcl/cmpnew/cmpif.h, /cvsroot/gcl/gcl/cmpnew/cmpif.lsp, /cvsroot/gcl/gcl/cmpnew/cmpinit.lsp, /cvsroot/gcl/gcl/cmpnew/cmpinline.c, /cvsroot/gcl/gcl/cmpnew/cmpinline.data, /cvsroot/gcl/gcl/cmpnew/cmpinline.h, /cvsroot/gcl/gcl/cmpnew/cmpinline.lsp, /cvsroot/gcl/gcl/cmpnew/cmplabel.c, /cvsroot/gcl/gcl/cmpnew/cmplabel.data, /cvsroot/gcl/gcl/cmpnew/cmplabel.h, /cvsroot/gcl/gcl/cmpnew/cmplabel.lsp, /cvsroot/gcl/gcl/cmpnew/cmplam.c: + initial checkin + + * /cvsroot/gcl/gcl/cmpnew/cmpenv.c, /cvsroot/gcl/gcl/cmpnew/cmpenv.data, /cvsroot/gcl/gcl/cmpnew/cmpenv.h, /cvsroot/gcl/gcl/cmpnew/cmpenv.lsp, /cvsroot/gcl/gcl/cmpnew/cmpeval.c, /cvsroot/gcl/gcl/cmpnew/cmpeval.data, /cvsroot/gcl/gcl/cmpnew/cmpeval.h, /cvsroot/gcl/gcl/cmpnew/cmpeval.lsp, /cvsroot/gcl/gcl/cmpnew/cmpflet.c, /cvsroot/gcl/gcl/cmpnew/cmpflet.data, /cvsroot/gcl/gcl/cmpnew/cmpflet.h, /cvsroot/gcl/gcl/cmpnew/cmpflet.lsp, /cvsroot/gcl/gcl/cmpnew/cmpfun.c, /cvsroot/gcl/gcl/cmpnew/cmpfun.data, /cvsroot/gcl/gcl/cmpnew/cmpfun.h, /cvsroot/gcl/gcl/cmpnew/cmpfun.lsp, /cvsroot/gcl/gcl/cmpnew/cmpif.c, /cvsroot/gcl/gcl/cmpnew/cmpif.data, /cvsroot/gcl/gcl/cmpnew/cmpif.h, /cvsroot/gcl/gcl/cmpnew/cmpif.lsp, /cvsroot/gcl/gcl/cmpnew/cmpinit.lsp, /cvsroot/gcl/gcl/cmpnew/cmpinline.c, /cvsroot/gcl/gcl/cmpnew/cmpinline.data, /cvsroot/gcl/gcl/cmpnew/cmpinline.h, /cvsroot/gcl/gcl/cmpnew/cmpinline.lsp, /cvsroot/gcl/gcl/cmpnew/cmplabel.c, /cvsroot/gcl/gcl/cmpnew/cmplabel.data, /cvsroot/gcl/gcl/cmpnew/cmplabel.h, /cvsroot/gcl/gcl/cmpnew/cmplabel.lsp, /cvsroot/gcl/gcl/cmpnew/cmplam.c: + New file. + + * /cvsroot/gcl/gcl/bin/append, /cvsroot/gcl/gcl/bin/append.c, /cvsroot/gcl/gcl/bin/dpp.c, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/info1, /cvsroot/gcl/gcl/bin/info, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/bin/tkinfo, /cvsroot/gcl/gcl/clcs/condition-definitions.lisp, /cvsroot/gcl/gcl/clcs/condition-precom.lisp, /cvsroot/gcl/gcl/clcs/conditions.lisp, /cvsroot/gcl/gcl/clcs/debugger.lisp, /cvsroot/gcl/gcl/clcs/doload.lisp, /cvsroot/gcl/gcl/clcs/handler.lisp, /cvsroot/gcl/gcl/clcs/install.lisp, /cvsroot/gcl/gcl/clcs/kcl-cond.lisp, /cvsroot/gcl/gcl/clcs/loading.lisp, /cvsroot/gcl/gcl/clcs/macros.lisp, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/clcs/package.lisp, /cvsroot/gcl/gcl/clcs/precom.lisp, /cvsroot/gcl/gcl/clcs/readme, /cvsroot/gcl/gcl/clcs/reload.lisp, /cvsroot/gcl/gcl/clcs/restart.lisp, /cvsroot/gcl/gcl/clcs/sysdef.lisp, /cvsroot/gcl/gcl/clcs/test2.lisp, /cvsroot/gcl/gcl/clcs/test3.lisp, /cvsroot/gcl/gcl/clcs/test4.lisp, /cvsroot/gcl/gcl/clcs/test5.lisp, /cvsroot/gcl/gcl/clcs/tester.lisp, /cvsroot/gcl/gcl/clcs/test.lisp, /cvsroot/gcl/gcl/clcs/top-patches.lisp, /cvsroot/gcl/gcl/cmpnew/cmpbind.c, /cvsroot/gcl/gcl/cmpnew/cmpbind.data, /cvsroot/gcl/gcl/cmpnew/cmpbind.h, /cvsroot/gcl/gcl/cmpnew/cmpbind.lsp, /cvsroot/gcl/gcl/cmpnew/cmpblock.c, /cvsroot/gcl/gcl/cmpnew/cmpblock.data, /cvsroot/gcl/gcl/cmpnew/cmpblock.h, /cvsroot/gcl/gcl/cmpnew/cmpblock.lsp, /cvsroot/gcl/gcl/cmpnew/cmpcall.c, /cvsroot/gcl/gcl/cmpnew/cmpcall.data, /cvsroot/gcl/gcl/cmpnew/cmpcall.h, /cvsroot/gcl/gcl/cmpnew/cmpcall.lsp, /cvsroot/gcl/gcl/cmpnew/cmpcatch.c, /cvsroot/gcl/gcl/cmpnew/cmpcatch.data, /cvsroot/gcl/gcl/cmpnew/cmpcatch.h, /cvsroot/gcl/gcl/cmpnew/cmpcatch.lsp, /cvsroot/gcl/gcl/gcl1.jpg, /cvsroot/gcl/gcl/gcl2.jpg, /cvsroot/gcl/gcl/gcl.gif, /cvsroot/gcl/gcl/gcl.jpg: + initial checkin + + * /cvsroot/gcl/gcl/bin/append, /cvsroot/gcl/gcl/bin/append.c, /cvsroot/gcl/gcl/bin/dpp.c, /cvsroot/gcl/gcl/bin/gcl, /cvsroot/gcl/gcl/bin/info1, /cvsroot/gcl/gcl/bin/info, /cvsroot/gcl/gcl/bin/makefile, /cvsroot/gcl/gcl/bin/tkinfo, /cvsroot/gcl/gcl/clcs/condition-definitions.lisp, /cvsroot/gcl/gcl/clcs/condition-precom.lisp, /cvsroot/gcl/gcl/clcs/conditions.lisp, /cvsroot/gcl/gcl/clcs/debugger.lisp, /cvsroot/gcl/gcl/clcs/doload.lisp, /cvsroot/gcl/gcl/clcs/handler.lisp, /cvsroot/gcl/gcl/clcs/install.lisp, /cvsroot/gcl/gcl/clcs/kcl-cond.lisp, /cvsroot/gcl/gcl/clcs/loading.lisp, /cvsroot/gcl/gcl/clcs/macros.lisp, /cvsroot/gcl/gcl/clcs/makefile, /cvsroot/gcl/gcl/clcs/package.lisp, /cvsroot/gcl/gcl/clcs/precom.lisp, /cvsroot/gcl/gcl/clcs/readme, /cvsroot/gcl/gcl/clcs/reload.lisp, /cvsroot/gcl/gcl/clcs/restart.lisp, /cvsroot/gcl/gcl/clcs/sysdef.lisp, /cvsroot/gcl/gcl/clcs/test2.lisp, /cvsroot/gcl/gcl/clcs/test3.lisp, /cvsroot/gcl/gcl/clcs/test4.lisp, /cvsroot/gcl/gcl/clcs/test5.lisp, /cvsroot/gcl/gcl/clcs/tester.lisp, /cvsroot/gcl/gcl/clcs/test.lisp, /cvsroot/gcl/gcl/clcs/top-patches.lisp, /cvsroot/gcl/gcl/cmpnew/cmpbind.c, /cvsroot/gcl/gcl/cmpnew/cmpbind.data, /cvsroot/gcl/gcl/cmpnew/cmpbind.h, /cvsroot/gcl/gcl/cmpnew/cmpbind.lsp, /cvsroot/gcl/gcl/cmpnew/cmpblock.c, /cvsroot/gcl/gcl/cmpnew/cmpblock.data, /cvsroot/gcl/gcl/cmpnew/cmpblock.h, /cvsroot/gcl/gcl/cmpnew/cmpblock.lsp, /cvsroot/gcl/gcl/cmpnew/cmpcall.c, /cvsroot/gcl/gcl/cmpnew/cmpcall.data, /cvsroot/gcl/gcl/cmpnew/cmpcall.h, /cvsroot/gcl/gcl/cmpnew/cmpcall.lsp, /cvsroot/gcl/gcl/cmpnew/cmpcatch.c, /cvsroot/gcl/gcl/cmpnew/cmpcatch.data, /cvsroot/gcl/gcl/cmpnew/cmpcatch.h, /cvsroot/gcl/gcl/cmpnew/cmpcatch.lsp, /cvsroot/gcl/gcl/gcl1.jpg, /cvsroot/gcl/gcl/gcl2.jpg, /cvsroot/gcl/gcl/gcl.gif, /cvsroot/gcl/gcl/gcl.jpg: + New file. + + * /cvsroot/gcl/gcl/AC_FD_CC, /cvsroot/gcl/gcl/AC_FD_MSG, /cvsroot/gcl/gcl/add-defs1, /cvsroot/gcl/gcl/add-defs, /cvsroot/gcl/gcl/add-defs.bat, /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/config.guess, /cvsroot/gcl/gcl/config.sub, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/COPYING.LIB-2.0, /cvsroot/gcl/gcl/eval.html, /cvsroot/gcl/gcl/eval.tcl, /cvsroot/gcl/gcl/faq, /cvsroot/gcl/gcl/install.sh, /cvsroot/gcl/gcl/machine, /cvsroot/gcl/gcl/machines, /cvsroot/gcl/gcl/majvers, /cvsroot/gcl/gcl/makdefs, /cvsroot/gcl/gcl/makedefs.in, /cvsroot/gcl/gcl/makedf, /cvsroot/gcl/gcl/makedf.in, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/merge.c, /cvsroot/gcl/gcl/minvers, /cvsroot/gcl/gcl/readme: + initial checkin + + * /cvsroot/gcl/gcl/AC_FD_CC, /cvsroot/gcl/gcl/AC_FD_MSG, /cvsroot/gcl/gcl/add-defs1, /cvsroot/gcl/gcl/add-defs, /cvsroot/gcl/gcl/add-defs.bat, /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/config.guess, /cvsroot/gcl/gcl/config.sub, /cvsroot/gcl/gcl/configure, /cvsroot/gcl/gcl/configure.in, /cvsroot/gcl/gcl/COPYING.LIB-2.0, /cvsroot/gcl/gcl/eval.html, /cvsroot/gcl/gcl/eval.tcl, /cvsroot/gcl/gcl/faq, /cvsroot/gcl/gcl/install.sh, /cvsroot/gcl/gcl/machine, /cvsroot/gcl/gcl/machines, /cvsroot/gcl/gcl/majvers, /cvsroot/gcl/gcl/makdefs, /cvsroot/gcl/gcl/makedefs.in, /cvsroot/gcl/gcl/makedf, /cvsroot/gcl/gcl/makedf.in, /cvsroot/gcl/gcl/makefile, /cvsroot/gcl/gcl/merge.c, /cvsroot/gcl/gcl/minvers, /cvsroot/gcl/gcl/readme: + New file. + diff --git a/ChangeLog.old b/ChangeLog.old new file mode 100755 index 0000000..c8aebd9 --- /dev/null +++ b/ChangeLog.old @@ -0,0 +1,218 @@ +2001-12-29 Camm Maguire + + * gmp/configure.in update for darwin + * #ifdef'ed R_386_NUM in sfaslelf.c for old libc + * changes to configure.in and elisp/makefile to handle emacs not + being present + * fix to gmp/ltconfig to avoid exec'ing '""' + * Added DESTDIR to makefiles to support installing under arbitrary + subdir + * good 'clean' targets + * correct building in absence of tcl/tk + + +2001-12-18 David Billinghurst + + * h/gnuwin95.h: Cruft removal and update + (SA_RESTART): Surround by #if 0/#endif + (fopen_binary): Remove + (fopen): Remove redefinition to fopen_binary + + +2001-04-15 Bill Schelter + + * Added changes to allow the loading .o files compiled + on -O4 under linux, and also added this to be the default + optimize level if speed = 3. speed = 2 gives -O still + +2001-04-13 Bill Schelter + + * fix the NULL_OR_ON_C_STACK macro for x86 linux in notcomp.h + and in 386-linux.h + +2001-01-30 Bill Schelter + + * many changes added for MS windows version.. + * add check on CSTACK_ADDRESS to configure for NULL_OR_ON_C_STACK + +2000-10-27 Bill Schelter + + * o/file.d bug in close_stream + * add xbin/386-linux-fix to knock the -O4 flag off of gcc if + it is version 2.96 because of a C compiler bug + * fixes to configure.in to better find the tcl tk stuff. + +2000-06-01 Bill Schelter + + * o/print.d: change printing of pathnames to use the more + standard #p"foo.bar" instead of #"foo.bar" + * o/read.d: allow pathnames #p"foo.bar" instead of just #"foo.bar" + as many implementations do. + + + +2000-05-13 Bill Schelter + + * fix readme file + * update gcl-2.3/mp/mpi-sol-sparc.s for the 'sparc' version. + * number of changes to 'configure.in' to handle finding + paths correctly. + +2000-05-02 Bill Schelter + + * rsym_elf.c (out;): strip off the @@GLIB* from symbols, + in the base image, since this is not added to .o files + With advent of GLIB2.0 this addition to the symbol was made. + This will allow dynamic linking of the raw_gcl with the C library. + * remove the -static default from the 386-linux.defs file, + so that links will by default be dynamic for libc .. + + +Fri Mar 28 16:23:18 1997 Bill Schelter + + * fix o/unexelf.c for section following bss overlapping it. + * fix some of the install sections in makefile + * add man page. + + +Wed Mar 12 14:11:01 1997 Bill Schelter + + * makefile (go): change to remove typo o${..} in makefile + in the install script + * change DIR= to GCL_TK_DIR= in gcl-tk/gcltksrv* and in + makefile, gcl-tk/makefile. Plain DIR= was causing the + replacement (in sed in makefiles) of other other variables + ending in DIR= .. + + + +Sun Dec 8 18:31:38 1996 Bill Schelter + + * release 2.2.1 contains various fixes to unexec and to + makefiles, for building on current systems. + +Mon Dec 2 20:36:28 1996 Bill Schelter + + * o/gbc.c: make the marking of MVloc go in the right direction. + important for problems that use mv_ref methods.. + +Thu Nov 9 18:09:01 1995 Bill Schelter + + * fixes for format and structure printing. + * fixes to calls to FEerror + * arrange so that static arrays stay static on growing via + adjust-array or via output with string stream stuff + +Mon Oct 30 20:42:17 1995 Bill Schelter + + * o/print.d (BEGIN): fix (defstruct (foo (:print-function + print-foo)) junk) + (defun print-foo (foo stream depth) + (format stream "#" (foo-junk foo))) + bug. [with the printStructBufp value being nulled] + * add-defs sets TCL_LIBRARY, and gcltksrv sets it.. + * fixes to support solaris-i386 [in rsym_elf.c, sfaslelf.c + * ./add-defs fix order of tests of paths... + + +Fri Oct 20 01:15:47 1995 Bill Schelter + + * fix initialization of *link-array* to be a string.. + [remove from cmptop.lsp] + * misc fixes in gbc.c and sgbc.c + * fix to profiling. + +Wed Oct 18 00:16:59 1995 Bill Schelter + + * (format nil "~5,,X" 10) made to work. Note the ansi draft + neither condones nor prohibits this. Normally the , is a place + holder and there is a argument after the last , and then comes the + directive. Here the commas dont hold a place. + + * fix bv.bv_offset problem... the move to 64 bit machines caused + it to be impossible to have some structure fields overlap the way + they once did. added BV_OFFSET(x) and SET_BV_OFFSET(x,val) + macros. + * fix add-defs to make clxsocket.o not be compiled in case of + no X11 include files found. + +Tue Oct 17 13:21:38 1995 Bill Schelter + + * fix the (write 3) bug... in print.d + +Wed Oct 11 23:00:34 1995 Bill Schelter + + * merge in billm's elf support for linux, and repair the + changes effects on regular a.out linux + * switch to unexec from 19.29 for versions using either the + regular or elf unexec from emacs + + +Sun Oct 1 19:52:45 1995 Bill Schelter + + * Many changes to gcl 2.1 to support 64 bit machines (eg Dec + alpha). Layout of structures etc changed. + * a gcl-2.2 beta was released in the summer. + since then there have been several bugs fixed. One in cmpfun.lsp + affecting write, and another in init_gcl.lsp to make sure the + link array is a string array (changed from fixnum which are no + longer sufficient to hold pointers). + * changes to fix for PA risc hpux in the hp800.h + * changes to unexec-19.27.c to allow MUCH faster saving in NFS + environment. + * testing with maxima 5.1 + * reworking makefiles + * (write 2) bug fixed. (in compiler) + * (aref #*11111 0) fixed (was different bv_elttype field) + + +Sun Apr 30 18:28:07 1995 Bill Schelter + + * various fixes to array.c for bitarrays and non 1 dimensional arrays + * fix to Ieval + * verify that pcl and clx work with these changes. + +Sun Apr 9 21:24:38 1995 Bill Schelter + + * (ln): + +Sat Apr 1 14:01:35 1995 Bill Schelter + + * There have been an infinite number of changes for gcl-2.0 + + * GCL now contains a tcl/tk windowing interface. + It is based on TCL 7.3 and TK 3.6 available from + ftp.cs.berkeley.edu and many mirrors. + + See the gcl-tk/demos/widget.lisp file for the demos. + + + * support for gzipped files + (setq si::*allow-gzipped-file* t) + to allow it. (load "foo.o") will look for "foo.o.gz" if + it does not find foo.o. Writing gzipped files is not + supported. + + * Command line args: + See the documentaion in the info directory under command line. + `-eval' `-load' etc. + + `-f' allows shell scripts to be made such as + ================== + #!/usr/local/bin/gcl.exe -f + (print "hello world") + ================== + + * All documentation converted to texinfo, info format and + extended. Ansi common lisp documentation converted to texinfo + + * interrupts completely changed, to be more robust and to + allow communication with tk. + + * regexp matching introduced see 'string-match' + + + + + + diff --git a/README.macosx b/README.macosx new file mode 100644 index 0000000..b605f58 --- /dev/null +++ b/README.macosx @@ -0,0 +1,9 @@ +On some recent mac boxes (e.g. 10.6) running 64bit capable processors, +the default configure scripts detect the cpu as 32bit only. To get a +64bit build, do: + +./configure --build=x86_64-apple-darwin10.4.0 .... + +where the key item is the x86_64, and some darwin string in the last +place. + diff --git a/README.openbsd b/README.openbsd new file mode 100644 index 0000000..91b7a28 --- /dev/null +++ b/README.openbsd @@ -0,0 +1,40 @@ +Building and using GCL 2.6.2 on OpenBSD + +PLATFORMS +--------- +GCL has only been tested on OpenBSD/i386 3.4. Newer versions should +work as well. Other hardware platforms are unchartered land. + +TOOLS +----- +You need GNU make to compile GCL. If you have installed the ports +tree, you can get it by running the following as root: + +cd /usr/ports/devel/gmake +make install + +It is then installed as `gmake'. + +The sed that ships with OpenBSD 3.4 has a bug (PR 3677) which is +triggered by the GCL makefiles. You can use either the sed of 3.5 or +GNU sed. Make sure the correct sed comes first in your PATH. + +BUILDING +-------- +There's nothing special to do for OpenBSD; GCL should build out of +the box. The OpenBSD version shares makefiles with FreeBSD, so don't +be surprised when you see "FreeBSD" in the output. + +NOTES +----- +The default limits on data segment size are 64MB (soft) and 256MB +(hard). GCL will automatically raise the soft limit to the hard +limit, but you may find that it runs out of memory anyway. If so, +you can change the limits in /etc/login.conf. + +For the record, the W^X feature of OpenBSD is disabled, since it +interfers with the way GCL dumps its executable. + + +Magnus Henoch, 12 June 2004 + diff --git a/README.wine b/README.wine new file mode 100644 index 0000000..ec6ec52 --- /dev/null +++ b/README.wine @@ -0,0 +1,17 @@ +On Debian, for example, gcl can be run and tested under wine as follows: + +(as root) + +aptitude install mingw32 mingw32-runtime mingw32-binutils wine + +If necessary, as root + +update-binfmts --enable wine + +Then as a normal user, + +export PATH=/usr/i586-mingw32msvc/bin:$PATH +export CC=/usr/bin/i586-mingw32msvc-gcc + +./configure --host=mingw32 && make + diff --git a/RELEASE-2.5.1 b/RELEASE-2.5.1 new file mode 100644 index 0000000..1bfd022 --- /dev/null +++ b/RELEASE-2.5.1 @@ -0,0 +1,138 @@ +RELEASE NOTES FOR 2.5.1: +======================== +The GNU Common Lisp (GCL) development team is pleased to release +Version 2.5.1, the first major release since the untimely death of the +former maintainer Dr William Schelter over a year ago. This release +is dedicated to his memory. The project is now hosted on +http://savannah.gnu.org/projects/gcl/ and is maintained and developed +by a team of thirteen programmers. Our home page lives at +http://www.gnu.org/software/gcl/. + +This release stabilizes the CLtL1 compliant build of GCL on most major +Unices including 11 Debian Linux 64 and 32 bit architectures and modern +versions of Microsoft Windows (TM). A rapidly progressing, partially ANSI +compliant version is also available on the Linux platforms. + +GCL plays a substantial role in development of the Maxima computer +algebra system (http://maxima.sourceforge.net/), ACL2, a computational +logic system (http://www.cs.utexas.edu/users/moore/acl2/), and the +forthcoming public release of the Axiom computer algebra system.. The +compiler is a descendant of the famous KCL and AKCL Common Lisp +compilers and is licensed under version two of the GNU Library General +Public License. + +As with any Lisp system GCL is a lot of fun to work with. We welcome all +comments and feedback. Developers are particularly welcome too. You will +find that the project offers a wide variety of challenges on various +platforms to anyone with an interest in compilers, low level C programming +or Common Lisp. + +----- + +Features: + + * Compiles itself, maxima, and acl2, passing all tests, on 11 + Debian GNU/Linux platforms (i386, sparc, powerpc, s390, ia64, alpha, + mips, mipsel, hppa, arm, and m68k), Sparc Solaris, and recent Windows + systems. + + * Compilation to native object code. Lisp disassembly shows intermediate + C source and native assembler. + + * Native code relocation on all supported platforms except alpha, mips, + mipsel, ia64, and hppa. + + * Can save its running memory image to a file on all systems where native object + code relocation is supported, thus producing standalone executables. + + * Compiles Lisp function calls to C function calls with inlined + arguments, when function proclamation/declamations are made. + + * Quite fast, particularly if one pre-allocates memory to be commensurate + with that typically available on modern computer systems. (see below) + + * A foreign function interface as flexible in principle as the C interface. + + * Socket support via streams + + * Support for numbers of arbitrary precision via the GNU + Multiprecision Library. If you build GCL on your own system, + multiprecision numerical support will make use of ISA extension + instructions available on your system for maximum large number + performance. + + * An exact garbage collector with no (known) leaks. + + * An ANSI mode on Unix systems which passes approximately 97% of + the ANSI compliance tests currently developed for the project. + On Debian GNU/Linux systems, this mode can be selected by setting the + GCL_ANSI environment variable to any non-empty string. See + /usr/share/doc/gcl/test_results on Debian GNU/Linux systems. + + * An MPI extension for cluster computing support. See the website for details. + + * A long history of leveraging GCC compiler technology for use in + production lisp applications. + +----- + +GCL is one of the oldest Lisp systems still in use, and as such has +served as the basis for large lisp applications when computers were +much more limited than they are today, particularly in terms of +available memory. Considerable effort was therefore made in the past +to keep the memory image as small as possible. As of the present +time, the GCL team has not tuned the default memory allocation scheme +to be more in line with modern systems. One can therefore often get +significant performance increases by preallocating memory, as in for +example + +(progn +(si::allocate 'cons 10000 t) +(si::allocate 'fixnum 200 t) +(si::allocate 'symbol 100 t) +(si::allocate-relocatable-pages 2000 t) +(si::allocate 'cfun 1000 t)) + +Optimal values will no doubt vary by application and machine. One +user/developer reports effects of the following magnitude when +using preallocation: + +######## + +Take a look on some funny numbers below. This is time and RAM +required to compute ratsimp((x+y+z)^300)$ on Linux AthlonXP 2400+. +For GCL run time is in the form T - G = N, where T is the total +time as shown by showtime:true; G is total GC tome and N +is run time without GC. + +Lisp Time RAM RAM RAM + [sec] before max after + T - G = N [Mb] [Mb] [Mb] +===================================================== + +CLISP 4.6 5.5 29 16 + +CMUCL 1.6 6.5 31 31 + +GCL class 5.9 - 5.2 = 0.7 8 24 24 +GCL ansi 9.5 - 8.9 = 0.6 9.5 29 29 + +GCL class 1.0 - 0.4 = 0.6 24 31 31 +GCL ansi 1.1 - 0.6 = 0.5 25 32 32 + +GCL class 0.7 - 0.1 = 0.6 48 55 55 +GCL ansi 0.5 - 0.0 = 0.5 49 56 56 + +==================================================== + +######## + + +TO DO: + + 1) Full ANSI compliance + 2) Native optimized blas support + 3) Integrate MPI support + 4) GCL as a suported GCC front end. + 5) Performance/memory optimization + diff --git a/RELEASE-2.6.2.html b/RELEASE-2.6.2.html new file mode 100644 index 0000000..b4534e3 --- /dev/null +++ b/RELEASE-2.6.2.html @@ -0,0 +1,1599 @@ + + + + GCL 2.6.2 tests + + + + + +
+
+ +
GCL 2.6.2 RELEASE NOTES
+
+
+ The GCL team is happy to announce the release of version +2.6.2, the latest achievement in the 'stable' series.  While strictly +speaking a bug-fix only release, 2.6.2 incorporates several major improvements +over the last stable release, 2.5.3.  Some highlights:
+
+ +
    +
  • The development of a 'lisp compiler torture tester' by GCL developer + Paul Dietz which repeatedly compiles randomly generated forms of specifiable + length to test the compiler for correctness.
    • +
  • The application of several significant corrections to the GCL +lisp compiler to remove every known instance of miscompilation uncovered +by this tester.  To our knowledge, GCL is alone with CLISP in passing +this torture test for runs of effectively indefinite length.
    • +
  • Major performance improvements were applied to the lisp compiler + to enable it to complete random tests of great length in a reasonable amount + of time. 
    • +
  • Corrections to the GCL core files to enable very large image sizes + in 64 bits, in which more than a billion cons cells can be allocated.  Current + 64bit options include amd64, ia64, and alpha running most flavors of GNU/Linux.
    • +
  • Corrections to the heap scaling behavior of the garbage collector, + resulting in significant performance gains in many instances.
    • +
  • Support for the latest gcc and binutils versions on all platforms + but mingw
    • +
  • The elimination of many instances of unnecessary internal garbage + generation bringing the associated performance gains
    • +
  • Native support for execstack protected linux kernels, such as +on Fedora core systems
    • +
  • Native support for FreeBSD, OpenBSD, and MacOSX
    • +
  • Static function pointer support to stabilize dynamic library usage + on Itanium systems
    • +
  • Transparent readline initialization when compiled in
    • +
  • Support for profiling via gprof
    • +
  • Automatic disabling of SGC (stratified garbage collection) if +the image is executed on a kernel not supporting fault address recovery
    • +
  • Remove a memory leak associated with heavy bignum usage via the + introduction of SGC contiguous pages
    • +
  • Several significant internal bug fixes, epecially in the mingw +port.
    • +
  • Alter the build process to perform a full self compile with full + function proclamation at build time.
    • +
  • GCL now compiles Axiom from scratch and carries it to all supported + platforms with the current exception of mingw
    • +
  • GCL's ANSI build now in use for its first end-user application +-- maxima (current cvs)
    • +
  • New 64bit platform support -- amd64, with full native object relocation
    +
    • + +
+ The full changelog can be found in the source tree in the file 'debian/changelog'.
+
+  
+ The GCL team has subjected this release to a wide variety of tests and + benchmarks.  While all such results are necessarily incomplete, one + can nevertheless usefully summarize the approximate state of affairs as +follows:
+ +
    +
  • GCL is about as portable as CLISP
    • +
  • The GCL lisp compiler is about as robust/correct as that of CLISP, + at least as measured by the random tester, which at present only covers +a mostly integer subset of lisp.
    • +
  • GCL is about as fast as CMUCL
    • +
  • GCL plays a major role in carrying the primary large open source + lisp end user applications to a wide variety of systems
    • +
  • GCL is still the least ANSI compliant of the freely available +lisp systems,  though a modest level of compliance has been achieved +in this release.  Much greater compliance has been achieved in the +2.7.x (cvs unstable) series yet to be officially released.
    • + +
+
+ The specific test results are arranged in the following table.  Some + terms need defining:
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
BFD
+ 		the method of relocating compiled lisp object modules +into the running executable using the BFD library
+
custreloc
+ 		the method of relocating compiled lisp object modules +into the running executable using the native GCL code.  This method +as well as the BFD method preserve the module loading across image saving +and re-execution
+
dlopen
+ 		the method of dynamically linking in compiled lisp +object modules into the existing session only via the system dynamic linker +loader, ld.so.
+
SGC
+ 		Stratified Garbage Collection -- an optional accelerated +generational garbage collection algorithm employing read-only memory
+
CLtL1
+ 		Common Lisp, the Language vol I, referring to the +book of the same name by Steele defining a widely used lisp language standard +prior to the ANSI standardization process in 1994.
+
ANSI
+ 		the work in progress image build attempting to eventually +extend traditional GCL into full ANSI complaince
+
Ansi tests
+ 		the results of the work in progress ansi compliance +test suite written by GCL developer Paul Dietz presented as the number of +failures divided by the total number of tests run
+
Random tests
+ 		the results of the random 'compiler torture tester' + presented as the number of tests/the size of the random forms/the number + of variables passed to the random function
+
+
+
+In the table below, green denotes a pass, yellow denotes an as yet unimplemented + option, and red indicates failure.  Blank cells indicate tests that + have not been run.
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
System
+ 		CPU
+ 		Self Build
+ 		BFD
+ 		dlopen
+ 		custreloc
+ 		Preferred
+ Linking
+ 		SGC
+ 		CLtL1
+ 		ANSI
+ 		ANSI tests
+ 		Random tests
+ 		Maxima 5.9.0/CLtL1
+ (4)
+ 		Maxima CVS/ANSI
+ (4)
+ 		ACL2 2.8/CLtL1
+ (5)
+ 		Axiom CVS/CLtL1
+ (6)
+ 		nqthm
+ CLtL1
+ 		pc-nqthm
+ CLtL1
+
Debian GNU/Linux (sid)
+ 		i386
+
+
+
+
+ 		bfd
+ or
+ custreloc
+
+
+
+ 		303/
+ 10697
+ 		50000/10000/8
+ 500000/1000/8
+
+
+
+
+
+ 		(setq si::*multiply-stacks* + 16)
+
Debian GNU/Linux (sid)
+ 		sparc
+
+
+
+
+ 		bfd
+ or
+ custreloc
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
Debian GNU/Linux (sid)
+ 		powerpc
+
+
+
+
+ 		bfd
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
Debian GNU/Linux (sid)
+ 		amd64
+
+
+
+
+ 		bfd
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
Debian GNU/Linux (sid)
+ 		arm
+
+
+
+
+ 		bfd
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
Debian GNU/Linux (sid)
+ 		m68k
+
+
+
+
+ 		bfd
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
Debian GNU/Linux (sid)
+ 		s390
+
+
+
+
+ 		bfd
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
Debian GNU/Linux (sid)
+ 		ia64
+
+
+
+
+ 		dlopen
+
+
+
+ 		303/
+ 10697
+
+
+
+
+ 		(1)
+
+
+
Debian GNU/Linux (sid)
+ 		hppa
+ 		-O0
+
+
+
+ 		dlopen
+
+
+
+ 		303/
+ 10697
+
+
+
+
+ 		(1)
+
+
+
Debian GNU/Linux (sid)
+ 		mips
+
+
+
+
+ 		dlopen
+
+
+
+ 		303/
+ 10697
+
+
+
+
+ 		(1)
+
+
+
Debian GNU/Linux (sid)
+ 		mipsel
+
+
+
+
+ 		dlopen
+
+
+
+ 		303/
+ 10697
+
+
+
+
+ 		(1)
+
+
+
Debian GNU/Linux (sid)
+ 		alpha
+
+
+
+
+ 		dlopen
+
+
+
+ 		303/
+ 10697
+
+
+
+
+ 		(1)
+
+
+
Fedora FC1
+ 		i386
+
+
+
+
+ 		bfd or
+ custreloc
+
+
+
+ 		303/
+ 10697
+ 		12000/1000/8
+
+
+
+
+
+
+
Solaris
+ 		sparc
+
+
+
+
+ 		bfd or
+ custreloc
+
+
+
+ 		303/
+ 10697
+ 		4000/1000/8
+ (4)
+
+
+
+
+
+
+
Windows MINGW(a)
+ 		i386
+
+
+
+
+ 		custreloc
+
+
+
+
+ 		303/
+ 10697
+ 		57000/1000/8
+
+
+
+ 		(2)
+
+
+
MacOSX
+ 		powerpc
+
+
+
+
+ 		bfd
+ 		(3)
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
OpenBSD
+ 		i386
+
+
+
+
+ 		bfd
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+
FreeBSD
+ 		i386
+
+
+
+
+ 		custreloc
+
+
+
+ 		303/
+ 10697
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Notes:
+
+ (1) dlopen builds use file descriptors for each object load.  The + step in the Axiom build process which regenerates its databases consumes + more than the conventional maximum of 1024 file descriptors available +by default on most UNIX systems.
+ (2) An AXIOMsys executable can be produced, and is basically functional, + but experiences sporadic errors of a type as yet unknown.
+ (3) This is known to work on at least some versions of the OS, but + others report a hang (infinite loop) when enabling SGC.  It is possible + that this is due to a mprotect bug in older versions of the Darwin system + shared libraries.  'compatibility version of user 6.0.0' appears to +work.
+ (4) On this machine, the underlying gcc was old (3.0) and segfaulted + outside of GCL when attempting to compile its produced C code after a few + thousand        iterations.
+
+ (a) The preferred build environment for Mingw/Windows is gcc 3.3.1, +binutils 2.14.90, and the latest msys release.
+
+
+
+ The following table presents the results of the popular gabriel benchmarks + of three freely available lisp systems, GCL, CLISP and CMUCL.  Times + are presented as multiples of the time GCL took in completing the tests. +  Green  indicates tests on which GCL is the fastest, while red +indicates tests on which GCLwas not the fastest.   The benchmark code +can be found in ftp://ftp.ma.utexas.edu/gcl/gabriel.tgz.  The number +of test iterations has been increased by a factor of 400 to overcome granularity +issues on modern machines.  The '(print (time ...))' statements around +each test iteration were removed, again due to granularity and relative i/o +load.  Likewise the special init.lsp file conventionally used to preallocate +GCL memory in such cases was removed as it is now mostly obsolete.  Finally +the tests were modified slightly to place the optimization declamations at +the top of each file being compiled as suggested by a CMUCL expert.
+
+As with any benchmark, results can vary somewhat with the details of the +executing machine.  With lisp in particular, the ratios of the cache +sizes, cpu speed, and memory bandwidths can impact such tests significantly. + We present the results for two popular configurations below.  While +the precise details of the differences are as yet known, it is speculated +that the first result is more dominated by in-cache cpu performance, while +the latter is more dominated by memory access efficiency.
+
+ + + + + + + + + + + + + + + +
Dual Intel Xeon 2.4Ghz, 512 Mb, Linux 2.4.20
+ 		Athlon XP 3000+ (2.1Ghz), 512 Mb, Linux 2.4.26
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Benchmark
+ 		GCL
+ 2.6.2
+ 		CMUCL 18e-9
+ 		CLISP
+ 2.33-2
+

+ BOYER
+ 1.000
+ 2.200
+ 9.869

+ BROWSE
+ 1.000
+ 2.240
+ NA

+ CTAK
+ 1.000
+ 0.230
+ 1.890

+ DDERIV
+ 1.000
+ 2.148
+ 2.909

+ DERIV
+ 1.000
+ 2.083
+ 3.640

+ DESTRU-MOD
+ 1.000
+ 2.043
+ 9.880

+ DESTRU
+ 1.000
+ 1.168
+ 5.743

+ DIV2
+ 1.000
+ 2.222
+ 3.911

+ FFT-MOD
+ 1.000
+ 1.585
+ 206.057

+ FFT
+ 1.000
+ 1.544
+ 176.088

+ FPRINT
+ 1.000
+ 2.136
+ 3.742

+ FREAD
+ 1.000
+ 1.746
+ 2.111

+ FRPOLY
+ 1.000
+ 1.524
+ 5.112

+ PUZZLE-MOD
+ 1.000
+ 10.824
+ 41.618

+ PUZZLE
+ 1.000
+ 11.324
+ 37.671

+ STAK
+ 1.000
+ 1.536
+ 9.836

+ TAK-MOD
+ 1.000
+ 1.465
+ 15.053

+ TAK
+ 1.000
+ 1.486
+ 14.629

+ TAKL
+ 1.000
+ 1.419
+ 14.965

+ TAKR
+ 1.000
+ 1.933
+ 12.327

+ TPRINT
+ 1.000
+ 0.937
+ 1.263

+ TRAVERSE
+ 1.000
+ 0.875
+ 8.378

+ TRIANG-MOD
+ 1.000
+ 7.067
+ 26.814

+ TRIANG
+ 1.000
+ 1.281
+ 18.565
GEOMETRIC
+ AVERAGE
+ 1.00
+ 1.86
+ 10.33
MEDIAN
+ 		1.00
+ 		1.67
+ 		9.87
+
+
+ 		+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Benchmark
+ 		GCL
+ 2.6.2
+ 		CMUCL 18e
+ 		CLISP
+ 2.33
+

+ BOYER
+ 1.000
+ 0.892
+ 6.316

+ BROWSE
+ 1.000
+ 0.965
+ NA

+ CTAK
+ 1.000
+ 0.435
+ 3.489

+ DDERIV
+ 1.000
+ 0.822
+ 1.579

+ DERIV
+ 1.000
+ 0.651
+ 1.639

+ DESTRU-MOD
+ 1.000
+ 0.812
+ 4.779

+ DESTRU
+ 1.000
+ 0.550
+ 3.239

+ DIV2
+ 1.000
+ 0.599
+ 1.525

+ FFT-MOD
+ 1.000
+ 2.655
+ 337.207

+ FFT
+ 1.000
+ 1.923
+ 251.026

+ FPRINT
+ 1.000
+ 2.322
+ 3.508

+ FREAD
+ 1.000
+ 1.890
+ 1.900

+ FRPOLY
+ 1.000
+ 1.013
+ 3.606

+ PUZZLE-MOD
+ 1.000
+ 5.976
+ 20.350

+ PUZZLE
+ 1.000
+ 5.472
+ 19.387

+ STAK
+ 1.000
+ 1.655
+ 8.064

+ TAK-MOD
+ 1.000
+ 1.382
+ 14.775

+ TAK
+ 1.000
+ 1.399
+ 14.514

+ TAKL
+ 1.000
+ 1.281
+ 12.877

+ TAKR
+ 1.000
+ 1.735
+ 15.500

+ TPRINT
+ 1.000
+ 2.008
+ 1.674

+ TRAVERSE
+ 1.000
+ 0.770
+ 8.013

+ TRIANG-MOD
+ 1.000
+ 6.639
+ 25.182

+ TRIANG
+ 1.000
+ 1.186
+ 16.948
GEOMETRIC
+ AVERAGE
+ 1.00
+ 1.40
+ 8.46
MEDIAN
+ 		1.00
+ 		1.33
+ 		8.01
+
+
+
+
+ Many improvements are planned for the 2.7.x development series time + permitting, the most important of which is to complete the task of building + an ANSI compliant GCL image. 
+
+
+
+
+
+
+
+ + diff --git a/add-defs b/add-defs new file mode 100755 index 0000000..7536a4e --- /dev/null +++ b/add-defs @@ -0,0 +1,139 @@ +#!/bin/sh + +if [ $# -le 0 ] ; then + echo usage: ./add-defs machine-type; + echo or ' ' ./add-defs machine-type directory + echo where directory might be '/usr/local' or '/public' or '/lusr' -- a place to find various local includes or libs + echo see echo h/*.defs +exit 1 ; fi + +if [ -f h/$1.defs ] ; then echo using $1.defs ; + else echo h/$1.defs does not exist + echo Build one or use one of `ls h/*.defs` + exit 1 +fi + +echo $1 > machine + + + rm -f makedefs + echo > makedefs + echo "# begin makedefs" >> makedefs + echo "# constructed by ${USER} using: $0 $1 $2 $3 $4 $5" >> makdefs + + if [ -d ${PWD}/unixport ] ; + then echo "GCLDIR=${PWD}" >> makedefs ; + else echo "GCLDIR=`pwd`" >> makedefs ; + fi + echo "SHELL=/bin/sh" >> makedefs + echo "MACHINE=$1" >> makedefs + +# a place where you keep local things. Changing this may help to +# find things, otherwise edit the "LIST-OF-DIRECTORIES" for the +# given item. + +if [ "$2x" != "x" ] ; then +PUBLIC=$2 ; +else +PUBLIC=/public +fi +export PUBLIC + + + +TK_XINCLUDES=-Iunknown +# `add-dir' searches for ITEM in LIST-OF-DIRECTORIES and then sets the +# directory in VARIABLE-SETTING-TEMPLATE +#Usage: ./xbin/add-dir ITEM LIST-OF-DIRECTORIES VARIABLE-SETTING-TEMPLATE + +./xbin/add-dir tkConfig.sh "${PUBLIC}/lib /usr/lib /usr/local/lib" 'TK_CONFIG_PREFIX="$v"' +./xbin/add-dir tclConfig.sh "${PUBLIC}/lib /usr/lib /usr/local/lib" 'TCL_CONFIG_PREFIX="$v"' +./xbin/add-dir dir "/usr/local/lib/info ${PUBLIC}/lib/info /usr/lib/info" 'INFO_DIR="$v"' + +SOURCE=. +${SOURCE} makedefs + + + +if [ -f ${TK_CONFIG_PREFIX}/tkConfig.sh -a \ + -f ${TCL_CONFIG_PREFIX}/tclConfig.sh ] ; then + ${SOURCE} ${TK_CONFIG_PREFIX}/tkConfig.sh ; + ${SOURCE} ${TK_CONFIG_PREFIX}/tclConfig.sh ; + ./xbin/add-dir tk.h "${PUBLIC}/include /usr/include /usr/local/include" 'TK_INCLUDE="-I$v"' + + echo "TK_VERSION=${TK_VERSION}" >> makedefs + echo "TCL_VERSION=${TCL_VERSION}" >> makedefs + echo "TK_LIB_SPEC=${TK_LIB_SPEC}" >> makedefs + echo "TK_LIBRARY=${TK_CONFIG_PREFIX}/tk${TK_VERSION}" >> makedefs + echo "TCL_LIBRARY=${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION}" >> makedefs + echo "TK_BUILD_LIB_SPEC=${TK_BUILD_LIB_SPEC}" >> makedefs + echo "TK_XLIBSW=${TK_XLIBSW}" >> makedefs + TK_XLIB_DIR=`echo ${TK_XLIBSW} | sed "s:-L\\([^ ]*\\) .*:\\1:g"` + echo "TK_XLIB_DIR=${TK_XLIB_DIR}" >> makedefs + echo "TK_XINCLUDES=${TK_XINCLUDES}" >> makedefs + echo "TCL_LIB_SPEC=${TCL_LIB_SPEC}" >> makedefs + echo "TCL_DL_LIBS=${TCL_DL_LIBS}" >> makedefs + echo "TCL_LIBS=${TCL_LIBS}" >> makedefs + echo "HAVE_X11=-DHAVE_X11" >> makedefs +else + echo "TK_CONFIG_PREFIX=unknown" >> makedefs + ./xbin/add-dir X11/Xos.h "${PUBLIC}/include /usr/include /usr/local/X11R6/include /usr/local/X11/include " 'TK_XINCLUDES="-I$v"' + . makedefs + if [ "$TK_XINCLUDES" = "-Iunknown" ] ; then + echo "cant find X11 includes so not defining HAVE_X11" + else + echo HAVE_X11=-DHAVE_X11 >> makedefs + fi + echo unable to find tkConfig.sh and tclConfig.sh so not configuring tcl/tk +fi + + +####machine specific .defs files may over ride the above#### + + +####### insert the h/machine.defs file ############ + cat h/$1.defs >> makedefs + if [ -f ${HOME}/local_gcl.defs ] ; then + cat ${HOME}/local_gcl.defs >> makedefs + fi + + + echo "# end makedefs" >> makedefs + + echo inserting h/$1.defs in .. + for v in makefile unixport/make_kcn */makefile ; + do + echo " $v," + ./bin/file-sub makedefs $v "# begin makedefs" "# end makedefs" tmpx + mv tmpx $v + done + + +echo "" + +# Copy the config.h over. + +cat h/$1.h > tmpx +if [ -f ${HOME}/local_gcl.h ] ; then + cat ${HOME}/local_gcl.h >> tmpx +fi + +if fgrep =unknown makedefs > /dev/null ; +then echo " if the 'unknown' directories exist you may provide +a second argument to ./add-defs of a local directory where things might be, +or edit ./add-defs so that it can find them. Otherwise just continue +and the portions with unknown will not be compiled." +fi + + +if cmp tmpx h/config.h > /dev/null 2>&1 ;then true; +else +rm -f h/config.h +cp tmpx h/config.h +fi +rm -f tmpx + +# machine specific stuff that cant be handled normally... +if [ -f ./xbin/$1-fix ] ; then ./xbin/$1-fix ; fi + + diff --git a/add-defs.bat b/add-defs.bat new file mode 100755 index 0000000..92f6910 --- /dev/null +++ b/add-defs.bat @@ -0,0 +1,63 @@ +@echo off + +if .%1==. goto err_param +if NOT EXIST h\%1.def goto err_not_found + +IF EXIST unixport\saved_kc.exe goto found_saved_kcl_exe +echo WARNING : unixport/saved_kcl.exe file not found +echo _ you will not be able to recompile the .lsp files +echo _ nor start akcl +:found_saved_kcl_exe + +echo %1 > machine + +if .%2==. goto only_1_param +if exist %2\c\print.d goto only_1_param +echo %2 is not the main kcl directory + +:only_1_param + +make -f Smakefile merge + +copy tmpxx_.tem tmpxx +del makedefs + +echo AKCLDIR=/akcl >makedefs +echo SHELL=/bin/sh >>makedefs +echo MACHINE=%1 >>makedefs +type h\%1.def >>makedefs +if exist %2\c\print.d echo MAINDIR = %2 >> makedefs +type makedefs >>tmpxx +echo # end makedefs >>tmpxx +echo @s] >> tmpxx + +echo inserting h\%1.def in .. +for %%v in (Smakefile mp\makefile o\makefile lsp\makefile cmpnew\makefile dos\makefile) do go32 merge %%v tmpxx %%v.new +for %%v in (Smakefile mp\makefile o\makefile lsp\makefile cmpnew\makefile dos\makefile) do if exist %%v.new mv %%v %%v.bak +for %%v in (Smakefile mp\makefile o\makefile lsp\makefile cmpnew\makefile dos\makefile) do if exist %%v.new mv %%v.new %%v + +go32 merge unixport\makefile.dos tmpxx unixport\makefile.new +if exist unixport\makefile.new mv unixport\makefile.dos unixport\makefile.bak +if exist unixport\makefile.new mv unixport\makefile.new unixport\makefile.dos + +rem rm -f Vmakefile +rem rm -f tmpxx + +rem Copy the config.h over. +copy h\%1.h h\config.h + +rem fix the cmpinclude.h + +goto end + +:err_param +echo usage: Provide a machine name as arg +goto end + +:err_not_found +echo h\%1.def does not exist +echo Build one or use one of `ls h\*.def` +goto end + +:end + diff --git a/add-defs1 b/add-defs1 new file mode 100755 index 0000000..4c8c341 --- /dev/null +++ b/add-defs1 @@ -0,0 +1,89 @@ +#!/bin/sh + +#CC=cc +if test "$1" = "mingw" -o "$1" = "gnuwin95" ; then + EXE=.exe ; # CC=gcc + rm -f o/*.ini +fi + +#(cd bin ; make file-sub EXE=${EXE} CC=${CC}) + +if [ $# -le 0 ] ; then + echo usage: ./add-defs machine-type; + echo or ' ' ./add-defs machine-type directory + echo where directory might be '/usr/local' or '/public' or '/lusr' -- a place to find various local includes or libs + echo see echo h/*.defs +exit 1 ; fi + +if [ -f h/$1.defs ] ; then echo using $1.defs ; + else echo h/$1.defs does not exist + echo Build one or use one of `ls h/*.defs` + exit 1 +fi + +echo $1 > machine + + +# rm -f makedefs +# echo > makedefs +# echo "# begin makedefs" >> makedefs +# echo "# constructed by ${USER} using: $0 $1 $2 $3 $4 $5" >> makdefs + + rm -f makedefs + cp makedefc makedefs + if [ -d ${PWD}/unixport ] ; + then echo "GCLDIR=${PWD}" >> makedefs ; + else echo "GCLDIR=`pwd`" >> makedefs ; + fi + echo "SHELL=/bin/sh" >> makedefs + echo "MACHINE=$1" >> makedefs + + +####machine specific .defs files may over ride the above#### + + +####### insert the h/machine.defs file ############ + cat h/$1.defs >> makedefs + if [ -f makedefsafter ] ; then cat makedefsafter >> makedefs ; fi + if [ -f ${HOME}/local_gcl.defs ] ; then + cat ${HOME}/local_gcl.defs >> makedefs + fi + + echo "" >> makedefs + echo "# end makedefs" >> makedefs + + +# echo inserting h/$1.defs in .. +# for v in makefile unixport/make_kcn */makefile ; +# do +# echo " $v," +# ./bin/file-sub makedefs $v "# begin makedefs" "# end makedefs" tmpx +# mv tmpx $v +# done +# +#echo "" + +# Copy the config.h over. + +cat h/$1.h > tmpx +if [ -f ${HOME}/local_gcl.h ] ; then + cat ${HOME}/local_gcl.h >> tmpx +fi + +if fgrep =unknown makedefs > /dev/null ; +then echo " if the 'unknown' directories exist you may provide +a second argument to ./add-defs of a local directory where things might be, +or edit ./add-defs so that it can find them. Otherwise just continue +and the portions with unknown will not be compiled." +fi + + +if cmp tmpx h/config.h > /dev/null 2>&1 ;then true; +else +rm -f h/config.h +cp tmpx h/config.h +fi +rm -f tmpx + +# machine specific stuff that cant be handled normally... +if [ -f ./xbin/$1-fix ] ; then ./xbin/$1-fix ; fi diff --git a/ansi-tests/.cvsignore b/ansi-tests/.cvsignore new file mode 100644 index 0000000..2b0646a --- /dev/null +++ b/ansi-tests/.cvsignore @@ -0,0 +1,5 @@ +*.fn +*.x86f +*.fasl +*.ufsl +binary diff --git a/ansi-tests/README b/ansi-tests/README new file mode 100644 index 0000000..1d56d80 --- /dev/null +++ b/ansi-tests/README @@ -0,0 +1,14 @@ +This directory contains a partial Common Lisp standards compliance +test suite. + +To run the tests, load gclload.lsp. This will load and +run the tests. To just load the tests, load gclload1.lsp +and gclload2.lsp. + +Individual tests may be run by (rt:do-test '). + +Please tell me when you find incorrect test cases. + + Paul Dietz + dietz@dls.net + diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp new file mode 100644 index 0000000..6a39218 --- /dev/null +++ b/ansi-tests/adjustable-array-p.lsp @@ -0,0 +1,68 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 20 21:25:22 2003 +;;;; Contains: Tests for ADJUSTABLE-ARRAY-P + +(in-package :cl-test) + +(deftest adjustable-array-p.1 + (notnot (adjustable-array-p (make-array '(5) :adjustable t))) + t) + +(deftest adjustable-array-p.2 + (notnot (adjustable-array-p (make-array nil :adjustable t))) + t) + +(deftest adjustable-array-p.3 + (notnot (adjustable-array-p (make-array '(2 3) :adjustable t))) + t) + +(deftest adjustable-array-p.4 + (notnot (adjustable-array-p (make-array '(2 2 2) :adjustable t))) + t) + +(deftest adjustable-array-p.5 + (notnot (adjustable-array-p (make-array '(2 2 2 2) :adjustable t))) + t) + +(deftest adjustable-array-p.order.1 + (let ((i 0) x) + (values + (notnot (adjustable-array-p (progn (setf x (incf i)) + (make-array '(5) :adjustable t)))) + i x)) + t 1 1) + +;;; Error tests + +(deftest adjustable-array-p.error.1 + (classify-error (adjustable-array-p)) + program-error) + +(deftest adjustable-array-p.error.2 + (classify-error (adjustable-array-p "aaa" nil)) + program-error) + +(deftest adjustable-array-p.error.3 + (classify-error (adjustable-array-p 10)) + type-error) + +(deftest adjustable-array-p.error.4 + (let (why) + (loop for e in *mini-universe* + unless (or (typep e 'array) + (eq 'type-error + (setq why (classify-error** + `(adjustable-array-p ',e))))) + collect (list e why))) + nil) + +(deftest adjustable-array-p.error.5 + (classify-error (locally (adjustable-array-p 10))) + type-error) + +(deftest adjustable-array-p.error.6 + (classify-error (let ((x 10)) + (locally (declare (optimize (safety 3))) + (adjustable-array-p x)))) + type-error) diff --git a/ansi-tests/and.lsp b/ansi-tests/and.lsp new file mode 100644 index 0000000..1a1ffda --- /dev/null +++ b/ansi-tests/and.lsp @@ -0,0 +1,57 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 07:23:48 2002 +;;;; Contains: Tests for AND + +(in-package :cl-test) + +(deftest and.1 + (and) + t) + +(deftest and.2 + (and nil) + nil) + +(deftest and.3 + (and 'a) + a) + +(deftest and.4 + (and (values 'a 'b 'c)) + a b c) + +(deftest and.5 (and (values))) + +(deftest and.6 + (and (values t nil) 'a) + a) + +(deftest and.7 + (and nil (values 'a 'b 'c)) + nil) + +(deftest and.8 + (and (values 1 nil) (values nil 2)) + nil 2) + +(deftest and.9 + (and (values nil t) t) + nil) + +(deftest and.order.1 + (let ((x 0)) + (values (and nil (incf x)) + x)) + nil 0) + +(deftest and.order.2 + (let ((i 0) a b c d) + (values + (and (setf a (incf i)) + (setf b (incf i)) + (setf c (incf i)) + (setf d (incf i))) + i a b c d)) + 4 4 1 2 3 4) + diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp new file mode 100644 index 0000000..4146be6 --- /dev/null +++ b/ansi-tests/ansi-aux.lsp @@ -0,0 +1,1640 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 17:10:18 1998 +;;;; Contains: Aux. functions for CL-TEST + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;; A function for coercing truth values to BOOLEAN + +(defun notnot (x) (not (not x))) + +(defmacro notnot-mv (form) + `(notnot-mv-fn (multiple-value-list ,form))) + +(defun notnot-mv-fn (results) + (if (null results) + (values) + (apply #'values + (not (not (first results))) + (rest results)))) + +(defmacro not-mv (form) + `(not-mv-fn (multiple-value-list ,form))) + +(defun not-mv-fn (results) + (if (null results) + (values) + (apply #'values + (not (first results)) + (rest results)))) + + +;;; Macro to check that a function is returning a specified number of values +;;; (defaults to 1) +(defmacro check-values (form &optional (num 1)) + (let ((v (gensym)) + (n (gensym))) + `(let ((,v (multiple-value-list ,form)) + (,n ,num)) + (check-values-length ,v ,n ',form) + (car ,v)))) + +(defun check-values-length (results expected-number form) + (declare (type fixnum expected-number)) + (let ((n expected-number)) + (declare (type fixnum n)) + (dolist (e results) + (declare (ignore e)) + (decf n)) + (unless (= n 0) + (error "Expected ~A results from ~A, got ~A results instead.~%~ +Results: ~A~%" expected-number form n results)))) + +;;; Do multiple-value-bind, but check # of arguments +(defmacro multiple-value-bind* ((&rest vars) form &body body) + (let ((len (length vars)) + (v (gensym))) + `(let ((,v (multiple-value-list ,form))) + (check-values-length ,v ,len ',form) + (destructuring-bind ,vars ,v ,@body)))) + +;;; Comparison functions that are like various builtins, +;;; but are guaranteed to return T for true. + +(defun eqt (x y) + "Like EQ, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (eq x y))))) + +(defun eqlt (x y) + "Like EQL, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (eql x y))))) + +(defun equalt (x y) + "Like EQUAL, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (equal x y))))) + +(defun equalpt (x y) + "Like EQUALP, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (equalp x y))))) + +(defun equalpt-or-report (x y) + "Like EQUALPT, but return either T or a list of the arguments." + (or (equalpt x y) (list x y))) + +(defun =t (x &rest args) + "Like =, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (apply #'= x args))))) + +(defun make-int-list (n) + (loop for i from 0 below n collect i)) + +(defun make-int-array (n &optional (fn #'make-array)) + (let ((a (funcall fn n))) + (loop for i from 0 below n do (setf (aref a i) i)) + a)) + +;;; Return true if A1 and A2 are arrays with the same rank +;;; and dimensions whose elements are EQUAL + +(defun equal-array (a1 a2) + (and (typep a1 'array) + (typep a2 'array) + (= (array-rank a1) (array-rank a2)) + (if (= (array-rank a1) 0) + (equal (aref a1) (aref a2)) + (let ((ad (array-dimensions a1))) + (and (equal ad (array-dimensions a2)) + (if (= (array-rank a1) 1) + (let ((as (first ad))) + (loop + for i from 0 below as + always (equal (aref a1 i) (aref a2 i)))) + (let ((as (array-total-size a1))) + (and (= as (array-total-size a2)) + (loop + for i from 0 below as + always (equal (row-major-aref a1 i) + (row-major-aref a2 i))))))))))) + +;;; *universe* is defined elsewhere -- it is a list of various +;;; lisp objects used when stimulating things in various tests. +(declaim (special *universe*)) + +;;; The function EMPIRICAL-SUBTYPEP checks two types +;;; for subtypeness, first using SUBTYPEP*, then (if that +;;; fails) empirically against all the elements of *universe*, +;;; checking if all that are in the first are also in the second. +;;; Return T if this is the case, NIL otherwise. This will +;;; always return T if type1 is truly a subtype of type2, +;;; but may return T even if this is not the case. + +(defun empirical-subtypep (type1 type2) + (multiple-value-bind (sub good) + (subtypep* type1 type2) + (if good + sub + (loop for e in *universe* + always (or (not (typep e type1)) (typep e type2)))))) + +;;; Check that the subtype relationships implied +;;; by disjointness are not contradicted. Return NIL +;;; if ok, or a list of error messages if not. + +;;; Assumes the types are nonempty. + +(defun check-disjointness (type1 type2) + (append + (check-subtypep type1 type2 nil) + (check-subtypep type2 type1 nil) + (check-subtypep type1 `(not ,type2) t) + (check-subtypep type2 `(not ,type1) t) + (check-subtypep `(and ,type1 ,type2) nil t) + (check-subtypep `(and ,type2 ,type1) nil t) + (check-subtypep `(and ,type1 (not ,type2)) type1 t) + (check-subtypep `(and (not ,type2) ,type1) type1 t) + (check-subtypep `(and ,type2 (not ,type1)) type2 t) + (check-subtypep `(and (not ,type1) ,type2) type2 t) +;;; (check-subtypep type1 `(or ,type1 (not ,type2)) t) +;;; (check-subtypep type1 `(or (not ,type2) ,type1) t) +;;; (check-subtypep type2 `(or ,type2 (not ,type1)) t) +;;; (check-subtypep type2 `(or (not ,type1) ,type2) t) + (check-subtypep t `(or (not ,type1) (not ,type2)) t) + (check-subtypep t `(or (not ,type2) (not ,type1)) t) + )) + +(defun check-equivalence (type1 type2) + (append + (check-subtypep type1 type2 t) + (check-subtypep type2 type1 t) + (check-subtypep `(not ,type1) `(not ,type2) t) + (check-subtypep `(not ,type2) `(not ,type1) t) + (check-subtypep `(and ,type1 (not ,type2)) nil t) + (check-subtypep `(and ,type2 (not ,type1)) nil t) + (check-subtypep `(and (not ,type2) ,type1) nil t) + (check-subtypep `(and (not ,type1) ,type2) nil t) + (check-subtypep t `(or ,type1 (not ,type2)) t) + (check-subtypep t `(or ,type2 (not ,type1)) t) + (check-subtypep t `(or (not ,type2) ,type1) t) + (check-subtypep t `(or (not ,type1) ,type2) t))) + +(defun check-all-subtypep (type1 type2) + (append + (check-subtypep type1 type2 t) + (check-subtypep `(not ,type2) `(not ,type1) t) + (check-subtypep `(and ,type1 (not ,type2)) nil t) + (check-subtypep t `(or (not ,type1) ,type2) t))) + +(defun check-all-not-subtypep (type1 type2) + (append + (check-subtypep type1 type2 nil) + (check-subtypep `(not ,type2) `(not ,type1) nil))) + +(defun check-subtypep (type1 type2 is-sub &optional should-be-valid) + (multiple-value-bind + (sub valid) + (subtypep type1 type2) + (unless (constantp type1) (setq type1 (list 'quote type1))) + (unless (constantp type2) (setq type2 (list 'quote type2))) + (if (or (and valid sub (not is-sub)) + (and valid (not sub) is-sub) + (and (not valid) should-be-valid)) + `(((SUBTYPEP ,type1 ,type2) cl-user::==> ,sub ,valid)) + nil))) + +(defun check-type-predicate (P TYPE) + "Check that a predicate P is the same as #'(lambda (x) (typep x TYPE)) + by applying both to all elements of *UNIVERSE*. Print message + when a mismatch is found, and return number of mistakes." + (loop + for x in *universe* count + (block failed + (let ((p1 (handler-case + (funcall P x) + (error () (format t "(FUNCALL ~S ~S) failed~%" + P x) + (return-from failed t)))) + (p2 (handler-case + (typep x TYPE) + (error () (format t "(TYPEP ~S '~S) failed~%" + x TYPE) + (return-from failed t))))) + (when (or (and p1 (not p2)) + (and (not p1) p2)) + (format t "(FUNCALL ~S ~S) = ~S, (TYPEP ~S '~S) = ~S~%" + P x p1 x TYPE p2) + t))))) + +(defun check-predicate (predicate &optional guard (universe *universe*)) + "Return all elements of UNIVERSE for which the guard (if present) is false + and for which PREDICATE is false." + (remove-if #'(lambda (e) (or (and guard (funcall guard e)) + (funcall predicate e))) + universe)) + +(declaim (special *catch-error-type*)) + +(defun catch-continue-debugger-hook (condition dbh) + "Function that when used as *debugger-hook*, causes + continuable errors to be continued without user intervention." + (declare (ignore dbh)) + (let ((r (find-restart 'continue condition))) + (cond + ((and *catch-error-type* + (not (typep condition *catch-error-type*))) + (format t "Condition ~S is not a ~A~%" condition *catch-error-type*) + (cond (r (format t "Its continue restart is ~S~%" r)) + (t (format t "It has no continue restart~%"))) + (throw 'continue-failed nil)) + (r (invoke-restart r)) + (t (throw 'continue-failed nil))))) + +#| +(defun safe (fn &rest args) + "Apply fn to args, trapping errors. Convert type-errors to the + symbol type-error." + (declare (optimize (safety 3))) + (handler-case + (apply fn args) + (type-error () 'type-error) + (error (c) c))) +|# + +;;; Use the next macro in place of SAFE + +(defmacro catch-type-error (form) +"Evaluate form in safe mode, returning its value if there is no error. +If an error does occur, return type-error on TYPE-ERRORs, or the error +condition itself on other errors." +`(locally (declare (optimize (safety 3))) + (handler-case ,form + (type-error () 'type-error) + (error (c) c)))) + +(defmacro classify-error* (form) +"Evaluate form in safe mode, returning its value if there is no error. +If an error does occur, return a symbol classify the error, or allow +the condition to go uncaught if it cannot be classified." +`(locally (declare (optimize (safety 3))) + (handler-case ,form + (undefined-function () 'undefined-function) + (program-error () 'program-error) + (package-error () 'package-error) + (type-error () 'type-error) + (control-error () 'control-error) + (stream-error () 'stream-error) + (reader-error () 'reader-error) + (file-error () 'file-error) + (control-error () 'control-error) + (cell-error () 'cell-error) + (error () 'error) + ))) + +(defun classify-error** (form) + (handler-bind ((warning #'(lambda (c) (declare (ignore c)) + (muffle-warning)))) + (proclaim '(optimize (safety 3))) + (classify-error* + (if regression-test::*compile-tests* + (funcall (compile nil `(lambda () + (declare (optimize (safety 3))) + ,form))) + (eval form)) + ))) + +(defmacro classify-error (form) + `(classify-error** ',form)) + +(defun sequencep (x) (typep x 'sequence)) + +;;; +(defun typef (type) #'(lambda (x) (typep x type))) + +(defmacro signals-error (form error-name &key (safety 3) (name nil name-p) (inline nil)) + `(handler-bind + ((warning #'(lambda (c) (declare (ignore c)) + (muffle-warning)))) + (proclaim '(optimize (safety 3))) + (handler-case + (apply #'values + nil + (multiple-value-list + ,(cond + (inline form) + (regression-test::*compile-tests* + `(funcall (compile nil '(lambda () + (declare (optimize (safety ,safety))) + ,form)))) + (t `(eval ',form))))) + (,error-name (c) + (cond + ,@(case error-name + (type-error + `(((typep (type-error-datum c) + (type-error-expected-type c)) + (values + nil + (list (list 'typep (list 'quote + (type-error-datum c)) + (list 'quote + (type-error-expected-type c))) + "==> true"))))) + ((undefined-function unbound-variable) + (and name-p + `(((not (eq (cell-error-name c) ',name)) + (values + nil + (list 'cell-error-name "==>" + (cell-error-name c))))))) + ((stream-error end-of-file reader-error) + `(((not (streamp (stream-error-stream c))) + (values + nil + (list 'stream-error-stream "==>" + (stream-error-stream c)))))) + (file-error + `(((not (pathnamep (pathname (file-error-pathname c)))) + (values + nil + (list 'file-error-pathname "==>" + (file-error-pathname c)))))) + (t nil)) + (t (printable-p c))))))) + +(defmacro signals-error-always (form error-name) + `(values + (signals-error ,form ,error-name) + (signals-error ,form ,error-name :safety 0))) + +(defmacro signals-type-error (var datum-form form &key (safety 3) (inline nil)) + (let ((lambda-form + `(lambda (,var) + (declare (optimize (safety ,safety))) + ,form))) + `(let ((,var ,datum-form)) + (declare (optimize safety)) + (handler-bind + ((warning #'(lambda (c) (declare (ignore c)) + (muffle-warning)))) + ; (proclaim '(optimize (safety 3))) + (handler-case + (apply #'values + nil + (multiple-value-list + (funcall + ,(cond + (inline `(function ,lambda-form)) + (regression-test::*compile-tests* + `(compile nil ',lambda-form)) + (t `(eval ',lambda-form))) + ,var))) + (type-error + (c) + (let ((datum (type-error-datum c)) + (expected-type (type-error-expected-type c))) + (cond + ((not (eql ,var datum)) + (list :datum-mismatch ,var datum)) + ((typep datum expected-type) + (list :is-typep datum expected-type)) + (t (printable-p c)))))))))) + +(declaim (special *mini-universe*)) + +(defun check-type-error* (pred-fn guard-fn &optional (universe *mini-universe*)) + "Check that for all elements in some set, either guard-fn is true or + pred-fn signals a type error." + (let (val) + (loop for e in universe + unless (or (funcall guard-fn e) + (equal + (setf val (multiple-value-list + (signals-type-error x e (funcall pred-fn x) :inline t))) + '(t))) + collect (list e val)))) + +(defmacro check-type-error (&body args) + `(locally (declare (optimize safety)) (check-type-error* ,@args))) + +(defun printable-p (obj) + "Returns T iff obj can be printed to a string." + (with-standard-io-syntax + (let ((*print-readably* nil) + (*print-escape* nil)) + (declare (optimize safety)) + (handler-case (and (stringp (write-to-string obj)) t) + (condition (c) (declare (ignore c)) nil))))) + +(defun make-special-string (string &key fill adjust displace base) + (let* ((len (length string)) + (len2 (if fill (+ len 4) len)) + (etype (if base 'base-char 'character))) + (if displace + (let ((s0 (make-array (+ len2 5) + :initial-contents + (concatenate 'string + (make-string 2 :initial-element #\X) + string + (make-string (if fill 7 3) + :initial-element #\Y)) + :element-type etype))) + (make-array len2 :element-type etype + :adjustable adjust + :fill-pointer (if fill len nil) + :displaced-to s0 + :displaced-index-offset 2)) + (make-array len2 :element-type etype + :initial-contents + (if fill (concatenate 'string string "ZZZZ") string) + :fill-pointer (if fill len nil) + :adjustable adjust)))) + +(defmacro do-special-strings ((var string-form &optional ret-form) &body forms) + (let ((string (gensym)) + (fill (gensym "FILL")) + (adjust (gensym "ADJUST")) + (base (gensym "BASE")) + (displace (gensym "DISPLACE"))) + `(let ((,string ,string-form)) + (dolist (,fill '(nil t) ,ret-form) + (dolist (,adjust '(nil t)) + (dolist (,base '(nil t)) + (dolist (,displace '(nil t)) + (let ((,var (make-special-string + ,string + :fill ,fill :adjust ,adjust + :base ,base :displace ,displace))) + ,@forms)))))))) + +;;; A scaffold is a structure that is used to remember the object +;;; identities of the cons cells in a (noncircular) data structure. +;;; This lets us check if the data structure has been changed by +;;; an operation. +;;; + +(defstruct scaffold + node + car + cdr) + +(defun make-scaffold-copy (x) + "Make a tree that will be used to check if a tree has been changed." + (if + (consp x) + (make-scaffold :node x + :car (make-scaffold-copy (car x)) + :cdr (make-scaffold-copy (cdr x))) + (make-scaffold :node x + :car nil + :cdr nil))) + +(defun check-scaffold-copy (x xcopy) + "Return t if xcopy were produced from x by make-scaffold-copy, + and none of the cons cells in the tree rooted at x have been + changed." + + (and (eq x (scaffold-node xcopy)) + (or + (not (consp x)) + (and + (check-scaffold-copy (car x) (scaffold-car xcopy)) + (check-scaffold-copy (cdr x) (scaffold-cdr xcopy)))))) + +(defun create-c*r-test (n) + (cond + ((<= n 0) 'none) + (t + (cons (create-c*r-test (1- n)) + (create-c*r-test (1- n)))))) + +(defun nth-1-body (x) + (loop + for e in x + and i from 0 + count (not (eqt e (nth i x))))) + +;;; +;;; The function SUBTYPEP should return two generalized booleans. +;;; This auxiliary function returns booleans instead +;;; (which makes it easier to write tests). +;;; +(defun subtypep* (type1 type2) + (apply #'values + (mapcar #'notnot + (multiple-value-list (subtypep type1 type2))))) + +(defun subtypep*-or-fail (type1 type2) + (let ((results (multiple-value-list (subtypep type1 type2)))) + (and (= (length results) 2) + (or (not (second results)) + (notnot (first results)))))) + +(defun subtypep*-not-or-fail (type1 type2) + (let ((results (multiple-value-list (subtypep type1 type2)))) + (and (= (length results) 2) + (or (not (second results)) + (not (first results)))))) + +;;; (eval-when (load eval compile) +;;; (unless (fboundp 'complement) +;;; (defun complement (fn) +;;; #'(lambda (&rest args) (not (apply fn args)))))) + +(defun compose (&rest fns) + (let ((rfns (reverse fns))) + #'(lambda (x) (loop for f in rfns do (setf x (funcall f x))) x))) + +(defun evendigitp (c) + (notnot (find c "02468"))) + +(defun odddigitp (c) + (notnot (find c "13579"))) + +(defun nextdigit (c) + (cadr (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))) + +(defun is-eq-p (x) #'(lambda (y) (eqt x y))) +(defun is-not-eq-p (x) #'(lambda (y) (not (eqt x y)))) + +(defun is-eql-p (x) #'(lambda (y) (eqlt x y))) +(defun is-not-eql-p (x) #'(lambda (y) (not (eqlt x y)))) + +(defun onep (x) (eql x 1)) + +(defun char-invertcase (c) + (if (upper-case-p c) (char-downcase c) + (char-upcase c))) + +(defun string-invertcase (s) + (map 'string #'char-invertcase s)) + +(defun symbol< (x &rest args) + (apply #'string< (symbol-name x) (mapcar #'symbol-name args))) + +(defun random-from-seq (seq) + "Generate a random member of a sequence." + (let ((len (length seq))) + (assert (> len 0)) + (elt seq (random len)))) + +(defmacro random-case (&body cases) + (let ((len (length cases))) + (assert (> len 0)) + `(case (random ,len) + ,@(loop for i from 0 for e in cases collect `(,i ,e)) + (t (error "Can't happen?! (in random-case~%"))))) + +(defun coin (&optional (n 2)) + "Flip an n-sided coin." + (eql (random n) 0)) + +;;; Randomly permute a sequence +(defun random-permute (seq) + (setq seq (copy-seq seq)) + (let ((len (length seq))) + (loop for i from len downto 2 + do (let ((r (random i))) + (rotatef (elt seq r) (elt seq (1- i)))))) + seq) + +(defun make-list-expr (args) + "Build an expression for computing (LIST . args), but that evades + CALL-ARGUMENTS-LIMIT." + (if (cddddr args) + (list 'list* + (first args) (second args) (third args) (fourth args) + (make-list-expr (cddddr args))) + (cons 'list args))) + +(defparameter +standard-chars+ + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789~!@#$%^&*()_+|\\=-`{}[]:\";'<>?,./ + ") + +(defparameter + +base-chars+ #.(concatenate 'string + "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789" + "<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|")) + +(defparameter +num-base-chars+ (length +base-chars+)) + + +(defparameter +alpha-chars+ (subseq +standard-chars+ 0 52)) +(defparameter +lower-case-chars+ (subseq +alpha-chars+ 0 26)) +(defparameter +upper-case-chars+ (subseq +alpha-chars+ 26 52)) +(defparameter +alphanumeric-chars+ (subseq +standard-chars+ 0 62)) +(defparameter +digit-chars+ "0123456789") +(defparameter +extended-digit-chars+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ") +(defparameter +code-chars+ + (coerce (loop for i from 0 below 256 + for c = (code-char i) + when c collect c) + 'string)) +(defparameter +rev-code-chars+ (reverse +code-chars+)) + +;;; Used in checking for continuable errors + +(defun has-non-abort-restart (c) + (throw 'handled + (if (position 'abort (compute-restarts c) + :key #'restart-name :test-not #'eq) + 'success + 'fail))) + +(defmacro handle-non-abort-restart (&body body) + `(catch 'handled + (handler-bind ((error #'has-non-abort-restart)) + ,@body))) + +;;; used in elt.lsp +(defun elt-v-6-body () + (let ((x (make-int-list 1000))) + (let ((a (make-array '(1000) :initial-contents x))) + (loop + for i from 0 to 999 do + (unless (eql i (elt a i)) (return nil)) + finally (return t))))) + +(defun make-adj-array (n &key initial-contents) + (if initial-contents + (make-array n :adjustable t :initial-contents initial-contents) + (make-array n :adjustable t))) + +;;; used in elt.lsp +(defun elt-adj-array-6-body () + (let ((x (make-int-list 1000))) + (let ((a (make-adj-array '(1000) :initial-contents x))) + (loop + for i from 0 to 999 do + (unless (eql i (elt a i)) (return nil)) + finally (return t))))) + +(defparameter *displaced* (make-int-array 100000)) + +(defun make-displaced-array (n displacement) + (make-array n :displaced-to *displaced* + + :displaced-index-offset displacement)) + +;;; used in fill.lsp +(defun array-unsigned-byte-fill-test-fn (byte-size &rest fill-args) + (let* ((a (make-array '(5) :element-type (list 'unsigned-byte byte-size) + :initial-contents '(1 2 3 4 5))) + (b (apply #'fill a fill-args))) + (values (eqt a b) + (map 'list #'identity a)))) + +;;; used in fill-strings.lsp +(defun array-string-fill-test-fn (a &rest fill-args) + (setq a (copy-seq a)) + (let ((b (apply #'fill a fill-args))) + (values (eqt a b) b))) + +;;; From types-and-class.lsp + +(defparameter +float-types+ + '(long-float double-float short-float single-float)) + +(defparameter *subtype-table* +(let ((table + '( + (null symbol) + (symbol t) + (boolean symbol) + (standard-object t) + (function t) + (compiled-function function) + (generic-function function) + (standard-generic-function generic-function) + (class standard-object) + (built-in-class class) + (structure-class class) + (standard-class class) + (method standard-object) + (standard-method method) + (structure-object t) + (method-combination t) + (condition t) + (serious-condition condition) + (error serious-condition) + (type-error error) + (simple-type-error type-error) + (simple-condition condition) + (simple-type-error simple-condition) + (parse-error error) + (hash-table t) + (cell-error error) + (unbound-slot cell-error) + (warning condition) + (style-warning warning) + (storage-condition serious-condition) + (simple-warning warning) + (simple-warning simple-condition) + (keyword symbol) + (unbound-variable cell-error) + (control-error error) + (program-error error) + (undefined-function cell-error) + (package t) + (package-error error) + (random-state t) + (number t) + (real number) + (complex number) + (float real) + (short-float float) + (single-float float) + (double-float float) + (long-float float) + (rational real) + (integer rational) + (ratio rational) + (signed-byte integer) + (integer signed-byte) + (unsigned-byte signed-byte) + (bit unsigned-byte) + (fixnum integer) + (bignum integer) + (bit fixnum) + (arithmetic-error error) + (division-by-zero arithmetic-error) + (floating-point-invalid-operation arithmetic-error) + (floating-point-inexact arithmetic-error) + (floating-point-overflow arithmetic-error) + (floating-point-underflow arithmetic-error) + (character t) + (base-char character) + (standard-char base-char) + (extended-char character) + (sequence t) + (list sequence) + (null list) + (null boolean) + (cons list) + (array t) + (simple-array array) + (vector sequence) + (vector array) + (string vector) + (bit-vector vector) + (simple-vector vector) + (simple-vector simple-array) + (simple-bit-vector bit-vector) + (simple-bit-vector simple-array) + (base-string string) + (simple-string string) + (simple-string simple-array) + (simple-base-string base-string) + (simple-base-string simple-string) + (pathname t) + (logical-pathname pathname) + (file-error error) + (stream t) + (broadcast-stream stream) + (concatenated-stream stream) + (echo-stream stream) + (file-stream stream) + (string-stream stream) + (synonym-stream stream) + (two-way-stream stream) + (stream-error error) + (end-of-file stream-error) + (print-not-readable error) + (readtable t) + (reader-error parse-error) + (reader-error stream-error) + ))) + (when (subtypep* 'character 'base-char) + (setq table + (append + '((character base-char) + (string base-string) + (simple-string simple-base-string)) + table))) + + table)) + +(defparameter *disjoint-types-list* + '(cons symbol array + number character hash-table function readtable package + pathname stream random-state condition restart)) + +(defparameter *disjoint-types-list2* + `((cons (cons t t) (cons t (cons t t)) (eql (nil))) + (symbol keyword boolean null (eql a) (eql nil) (eql t) (eql *)) + (array vector simple-array simple-vector string simple-string + base-string simple-base-string (eql #())) + (character base-char standard-char (eql #\a) + ,@(if (subtypep 'character 'base-char) nil + (list 'extended-char))) + (function compiled-function generic-function standard-generic-function + (eql ,#'car)) + (package (eql ,(find-package "COMMON-LISP"))) + (pathname logical-pathname (eql #p"")) + (stream broadcast-stream concatenated-stream echo-stream + file-stream string-stream synonym-stream two-way-stream) + (number real complex float integer rational ratio fixnum + bit (integer 0 100) (float 0.0 100.0) (integer 0 *) + (rational 0 *) (mod 10) + (eql 0) + ,@(and (not (subtypep 'bignum nil)) + (list 'bignum))) + (random-state) + ,*condition-types* + (restart) + (readtable))) + +(defparameter *types-list3* + (reduce #'append *disjoint-types-list2* :from-end t)) + +(defun trim-list (list n) + (let ((len (length list))) + (if (<= len n) list + (append (subseq list 0 n) + (format nil "And ~A more omitted." (- len n)))))) + +(defun is-t-or-nil (e) + (or (eqt e t) (eqt e nil))) + +(defun is-builtin-class (type) + (when (symbolp type) (setq type (find-class type nil))) + (typep type 'built-in-class)) + +(defun classes-are-disjoint (c1 c2) + "If either c1 or c2 is a builtin class or the name of a builtin + class, then check for disjointness. Return a non-NIL list + of failed subtypep relationships, if any." + (and (or (is-builtin-class c1) + (is-builtin-class c2)) + (check-disjointness c1 c2))) + +(declaim (special *subtype-table*)) + +(defun types.6-body () + (loop + for p in *subtype-table* + for tp = (car p) + append + (and (not (member tp '(sequence cons list t))) + (let ((message (check-subtypep tp 'atom t t))) + (if message (list message)))))) + +(defparameter *type-list* nil) +(defparameter *supertype-table* nil) +(declaim (special *subtype-table*)) + +(defun types.9-body () + (let ((tp-list (append '(keyword atom list) + (loop for p in *subtype-table* collect (car p)))) + (result-list)) + (setf tp-list (remove-duplicates tp-list)) + ;; TP-LIST is now a list of unique CL type names + ;; Store it in *TYPE-LIST* so we can inspect it later if this test + ;; fails. The variable is also used in test TYPES.9A + (setf *type-list* tp-list) + ;; Compute all pairwise SUBTYPEP relationships among + ;; the elements of *TYPE-LIST*. + (let ((subs (make-hash-table :test #'eq)) + (sups (make-hash-table :test #'eq))) + (loop + for x in tp-list do + (loop + for y in tp-list do + (multiple-value-bind (result good) + (subtypep* x y) + (declare (ignore good)) + (when result + (pushnew x (gethash y subs)) + (pushnew y (gethash x sups)))))) + ;; Store the supertype relations for later inspection + ;; and use in test TYPES.9A + (setf *supertype-table* sups) + ;; Check that the relation we just computed is transitive. + ;; Return a list of triples on which transitivity fails. + (loop + for x in tp-list do + (let ((sub-list (gethash x subs)) + (sup-list (gethash x sups))) + (loop + for t1 in sub-list do + (loop + for t2 in sup-list do + (multiple-value-bind (result good) + (subtypep* t1 t2) + (when (and good (not result)) + (pushnew (list t1 x t2) result-list + :test #'equal))))))) + + result-list))) + +;;; TYPES.9-BODY returns a list of triples (T1 T2 T3) +;;; where (AND (SUBTYPEP T1 T2) (SUBTYPEP T2 T3) (NOT (SUBTYPEP T1 T3))) +;;; (and where SUBTYPEP succeeds in each case, returning true as its +;;; second return value.) + +(defun types.9a-body () + (cond + ((not (and *type-list* *supertype-table*)) + (format nil "Run test type.9 first~%") + nil) + (t + (loop + for tp in *type-list* + sum + (let ((sups (gethash tp *supertype-table*))) + (loop + for x in *universe* + sum + (handler-case + (cond + ((not (typep x tp)) 0) + (t + (loop + for tp2 in sups + count + (handler-case + (and (not (typep x tp2)) + (progn + (format t "Found element of ~S not in ~S: ~S~%" + tp tp2 x) + t)) + (condition (c) (format t "Error ~S occurred: ~S~%" + c tp2) + t))))) + (condition (c) (format t "Error ~S occurred: ~S~%" c tp) + 1)))))))) + +(defun even-size-p (a) + (some #'evenp (array-dimensions a))) + +(defun check-cons-copy (x y) + "Check that the tree x is a copy of the tree y, + returning t if it is, nil if not." + (cond + ((consp x) + (and (consp y) + (not (eqt x y)) + (check-cons-copy (car x) (car y)) + (check-cons-copy (cdr x) (cdr y)))) + ((eqt x y) t) + (t nil))) + +(defun check-sublis (a al &key (key 'no-key) test test-not) + "Apply sublis al a with various keys. Check that + the arguments are not themselves changed. Return nil + if the arguments do get changed." + (setf a (copy-tree a)) + (setf al (copy-tree al)) + (let ((acopy (make-scaffold-copy a)) + (alcopy (make-scaffold-copy al))) + (let ((as + (apply #'sublis al a + `(,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not)) + ,@(unless (eqt key 'no-key) `(:key ,key)))))) + (and + (check-scaffold-copy a acopy) + (check-scaffold-copy al alcopy) + as)))) + +(defun check-nsublis (a al &key (key 'no-key) test test-not) + "Apply nsublis al a, copying these arguments first." + (setf a (copy-tree a)) + (setf al (copy-tree al)) + (let ((as + (apply #'sublis (copy-tree al) (copy-tree a) + `(,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not)) + ,@(unless (eqt key 'no-key) `(:key ,key)))))) + as)) + +(defun check-subst (new old tree &key (key 'no-key) test test-not) + "Call subst new old tree, with keyword arguments if present. + Check that the arguments are not changed." + (setf new (copy-tree new)) + (setf old (copy-tree old)) + (setf tree (copy-tree tree)) + (let ((newcopy (make-scaffold-copy new)) + (oldcopy (make-scaffold-copy old)) + (treecopy (make-scaffold-copy tree))) + (let ((result + (apply #'subst new old tree + `(,@(unless (eqt key 'no-key) `(:key ,key)) + ,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not)))))) + (and (check-scaffold-copy new newcopy) + (check-scaffold-copy old oldcopy) + (check-scaffold-copy tree treecopy) + result)))) + + +(defun check-subst-if (new pred tree &key (key 'no-key)) + "Call subst-if new pred tree, with various keyword arguments + if present. Check that the arguments are not changed." + (setf new (copy-tree new)) + (setf tree (copy-tree tree)) + (let ((newcopy (make-scaffold-copy new)) + (predcopy (make-scaffold-copy pred)) + (treecopy (make-scaffold-copy tree))) + (let ((result + (apply #'subst-if new pred tree + (unless (eqt key 'no-key) `(:key ,key))))) + (and (check-scaffold-copy new newcopy) + (check-scaffold-copy pred predcopy) + (check-scaffold-copy tree treecopy) + result)))) + +(defun check-subst-if-not (new pred tree &key (key 'no-key)) + "Call subst-if-not new pred tree, with various keyword arguments + if present. Check that the arguments are not changed." + (setf new (copy-tree new)) + (setf tree (copy-tree tree)) + (let ((newcopy (make-scaffold-copy new)) + (predcopy (make-scaffold-copy pred)) + (treecopy (make-scaffold-copy tree))) + (let ((result + (apply #'subst-if-not new pred tree + (unless (eqt key 'no-key) `(:key ,key))))) + (and (check-scaffold-copy new newcopy) + (check-scaffold-copy pred predcopy) + (check-scaffold-copy tree treecopy) + result)))) + +(defun check-nsubst (new old tree &key (key 'no-key) test test-not) + "Call nsubst new old tree, with keyword arguments if present." + (setf new (copy-tree new)) + (setf old (copy-tree old)) + (setf tree (copy-tree tree)) + (apply #'nsubst new old tree + `(,@(unless (eqt key 'no-key) `(:key ,key)) + ,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not))))) + +(defun check-nsubst-if (new pred tree &key (key 'no-key)) + "Call nsubst-if new pred tree, with keyword arguments if present." + (setf new (copy-tree new)) + (setf tree (copy-tree tree)) + (apply #'nsubst-if new pred tree + (unless (eqt key 'no-key) `(:key ,key)))) + +(defun check-nsubst-if-not (new pred tree &key (key 'no-key)) + "Call nsubst-if-not new pred tree, with keyword arguments if present." + (setf new (copy-tree new)) + (setf tree (copy-tree tree)) + (apply #'nsubst-if-not new pred tree + (unless (eqt key 'no-key) `(:key ,key)))) + +(defun check-copy-list-copy (x y) + "Check that y is a copy of the list x." + (if + (consp x) + (and (consp y) + (not (eqt x y)) + (eqt (car x) (car y)) + (check-copy-list-copy (cdr x) (cdr y))) + (and (eqt x y) t))) + +(defun check-copy-list (x) + "Apply copy-list, checking that it properly copies, + and checking that it does not change its argument." + (let ((xcopy (make-scaffold-copy x))) + (let ((y (copy-list x))) + (and + (check-scaffold-copy x xcopy) + (check-copy-list-copy x y) + y)))) + +(defun append-6-body () + (let* ((cal (min 2048 call-arguments-limit)) + (step (max 1 (floor (/ cal) 64)))) + (loop + for n from 0 + below cal + by step + count + (not + (equal + (apply #'append (loop for i from 1 to n + collect '(a))) + (make-list n :initial-element 'a)))))) + +(defun is-intersection (x y z) + "Check that z is the intersection of x and y." + (and + (listp x) + (listp y) + (listp z) + (loop for e in x + always (or (not (member e y)) + (member e z))) + (loop for e in y + always (or (not (member e x)) + (member e z))) + (loop for e in z + always (and (member e x) (member e y))) + t)) + +(defun shuffle (x) + (cond + ((null x) nil) + ((null (cdr x)) x) + (t + (multiple-value-bind + (y z) + (split-list x) + (append (shuffle y) (shuffle z)))))) + +(defun split-list (x) + (cond + ((null x) (values nil nil)) + ((null (cdr x)) (values x nil)) + (t + (multiple-value-bind + (y z) + (split-list (cddr x)) + (values (cons (car x) y) (cons (cadr x) z)))))) + +(defun intersection-12-body (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size + collect (random maxelem state)))) + (y (shuffle (loop for j from 1 to size + collect (random maxelem state))))) + (let ((z (intersection x y))) + (let ((is-good (is-intersection x y z))) + (unless is-good (return (values x y z))))))) + nil)) + +(defun nintersection-with-check (x y &key test) + (let ((ycopy (make-scaffold-copy y))) + (let ((result (if test + (nintersection x y :test test) + (nintersection x y)))) + (if (check-scaffold-copy y ycopy) + result + 'failed)))) + +(defun nintersection-12-body (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state t))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size + collect (random maxelem state)))) + (y (shuffle (loop for j from 1 to size + collect (random maxelem state))))) + (let ((z (nintersection-with-check (copy-list x) y))) + (when (eqt z 'failed) (return (values x y z))) + (let ((is-good (is-intersection x y z))) + (unless is-good (return (values x y z))))))) + nil)) + + +(defun union-with-check (x y &key test test-not) + (let ((xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y))) + (let ((result (cond + (test (union x y :test test)) + (test-not (union x y :test-not test-not)) + (t (union x y))))) + (if (and (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy)) + result + 'failed)))) + +(defun union-with-check-and-key (x y key &key test test-not) + (let ((xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y))) + (let ((result (cond + (test (union x y :key key :test test)) + (test-not (union x y :key key :test-not test-not)) + (t (union x y :key key))))) + (if (and (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy)) + result + 'failed)))) + +(defun check-union (x y z) + (and (listp x) + (listp y) + (listp z) + (loop for e in z always (or (member e x) (member e y))) + (loop for e in x always (member e z)) + (loop for e in y always (member e z)) + t)) + +(defun do-random-unions (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size collect + (random maxelem state)))) + (y (shuffle (loop for j from 1 to size collect + (random maxelem state))))) + (let ((z (union x y))) + (let ((is-good (check-union x y z))) + (unless is-good (return (values x y z))))))) + nil)) + +(defun nunion-with-copy (x y &key test test-not) + (setf x (copy-list x)) + (setf y (copy-list y)) + (cond + (test (nunion x y :test test)) + (test-not (nunion x y :test-not test-not)) + (t (nunion x y)))) + +(defun nunion-with-copy-and-key (x y key &key test test-not) + (setf x (copy-list x)) + (setf y (copy-list y)) + (cond + (test (nunion x y :key key :test test)) + (test-not (nunion x y :key key :test-not test-not)) + (t (nunion x y :key key)))) + +(defun do-random-nunions (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size collect + (random maxelem state)))) + (y (shuffle (loop for j from 1 to size collect + (random maxelem state))))) + (let ((z (nunion-with-copy x y))) + (let ((is-good (check-union x y z))) + (unless is-good (return (values x y z))))))) + nil)) + +(defun set-difference-with-check (x y &key (key 'no-key) + test test-not) + (setf x (copy-list x)) + (setf y (copy-list y)) + (let ((xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y))) + (let ((result (apply #'set-difference + x y + `(,@(unless (eqt key 'no-key) `(:key ,key)) + ,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not)))))) + (cond + ((and (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy)) + result) + (t + 'failed))))) + +(defun check-set-difference (x y z &key (key #'identity) + (test #'eql)) + (and + ;; (not (eqt 'failed z)) + (listp x) + (listp y) + (listp z) + (loop for e in z always (member e x :key key :test test)) + (loop for e in x always (or (member e y :key key :test test) + (member e z :key key :test test))) + (loop for e in y never (member e z :key key :test test)) + t)) + +(defun do-random-set-differences (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size collect + (random maxelem state)))) + (y (shuffle (loop for j from 1 to size collect + (random maxelem state))))) + (let ((z (set-difference-with-check x y))) + (let ((is-good (check-set-difference x y z))) + (unless is-good (return (values x y z))))))) + nil)) +(defun nset-difference-with-check (x y &key (key 'no-key) + test test-not) + (setf x (copy-list x)) + (setf y (copy-list y)) + (apply #'nset-difference + x y + `(,@(unless (eqt key 'no-key) `(:key ,key)) + ,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not))))) + +(defun check-nset-difference (x y z &key (key #'identity) + (test #'eql)) + (and + (listp x) + (listp y) + (listp z) + (loop for e in z always (member e x :key key :test test)) + (loop for e in x always (or (member e y :key key :test test) + (member e z :key key :test test))) + (loop for e in y never (member e z :key key :test test)) + t)) + +(defun do-random-nset-differences (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size collect + (random maxelem state)))) + (y (shuffle (loop for j from 1 to size collect + (random maxelem state))))) + (let ((z (nset-difference-with-check x y))) + (let ((is-good (check-nset-difference x y z))) + (unless is-good (return (values x y z))))))) + nil)) + +(defun set-exclusive-or-with-check (x y &key (key 'no-key) + test test-not) + (setf x (copy-list x)) + (setf y (copy-list y)) + (let ((xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y))) + (let ((result (apply #'set-exclusive-or + x y + `(,@(unless (eqt key 'no-key) `(:key ,key)) + ,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not)))))) + (cond + ((and (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy)) + result) + (t + 'failed))))) + +(defun check-set-exclusive-or (x y z &key (key #'identity) + (test #'eql)) + (and + ;; (not (eqt 'failed z)) + (listp x) + (listp y) + (listp z) + (loop for e in z always (or (member e x :key key :test test) + (member e y :key key :test test))) + (loop for e in x always (if (member e y :key key :test test) + (not (member e z :key key :test test)) + (member e z :key key :test test))) + (loop for e in y always (if (member e x :key key :test test) + (not (member e z :key key :test test)) + (member e z :key key :test test))) + t)) + +(defun do-random-set-exclusive-ors (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size collect + (random maxelem state)))) + (y (shuffle (loop for j from 1 to size collect + (random maxelem state))))) + (let ((z (set-exclusive-or-with-check x y))) + (let ((is-good (check-set-exclusive-or x y z))) + (unless is-good (return (values x y z))))))) + nil)) + +(defun nset-exclusive-or-with-check (x y &key (key 'no-key) + test test-not) + (setf x (copy-list x)) + (setf y (copy-list y)) + (apply #'nset-exclusive-or + x y + `(,@(unless (eqt key 'no-key) `(:key ,key)) + ,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not))))) + +(defun do-random-nset-exclusive-ors (size niters &optional (maxelem (* 2 size))) + (let ((state (make-random-state))) + (loop + for i from 1 to niters do + (let ((x (shuffle (loop for j from 1 to size collect + (random maxelem state)))) + (y (shuffle (loop for j from 1 to size collect + (random maxelem state))))) + (let ((z (nset-exclusive-or-with-check x y))) + (let ((is-good (check-set-exclusive-or x y z))) + (unless is-good (return (values x y z))))))) + nil)) + +(defun subsetp-with-check (x y &key (key 'no-key) test test-not) + (let ((xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y))) + (let ((result + (apply #'subsetp x y + `(,@(unless (eqt key 'no-key) + `(:key ,key)) + ,@(when test `(:test ,test)) + ,@(when test-not `(:test-not ,test-not)))))) + (cond + ((and (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy)) + (not (not result))) + (t 'failed))))) + +(defun safe-elt (x n) + (classify-error* (elt x n))) + +(defmacro defstruct* (&body args) + `(eval-when (load eval compile) + (ignore-errors + (defstruct ,@args)))) + + +(defun sort-package-list (x) + (sort (copy-list x) + #'string< + :key #'package-name)) + +(defun sort-symbols (sl) + (sort (copy-list sl) + #'(lambda (x y) + (or + (string< (symbol-name x) + (symbol-name y)) + (and (string= (symbol-name x) + (symbol-name y)) + (string< (package-name (symbol-package x)) + (package-name (symbol-package y)))))))) + +(defun num-symbols-in-package (p) + (let ((num 0)) + (declare (fixnum num)) + (do-symbols (s p num) + (incf num)))) + +(defun num-external-symbols-in-package (p) + (let ((num 0)) + (declare (fixnum num)) + (do-external-symbols (s p num) + (incf num)))) + +(defun safely-delete-package (package-designator) + (let ((package (find-package package-designator))) + (when package + (let ((used-by (package-used-by-list package))) + (dolist (using-package used-by) + (unuse-package package using-package))) + (delete-package package)))) + +(defun delete-all-versions (pathspec) + "Replace the versions field of the pathname specified by pathspec with + :wild, and delete all the files this refers to." + (let* ((wild-pathname (make-pathname :version :wild :defaults (pathname pathspec))) + (truenames (directory wild-pathname))) + (mapc #'delete-file truenames))) + +(defconstant +fail-count-limit+ 20) + +(defmacro test-with-package-iterator (package-list-expr &rest symbol-types) + "Build an expression that tests the with-package-iterator form." + (let ((name (gensym)) + (cht-var (gensym)) + (pkg-list-var (gensym))) + `(let ((,cht-var (make-hash-table)) + (,pkg-list-var ,package-list-expr) + (fail-count 0)) + (with-package-iterator (,name ,pkg-list-var + ,@(copy-list symbol-types)) + ;; For each symbol, check that name is returning appropriate + ;; things + (loop + (block fail + (multiple-value-bind (more sym access pkg) + (,name) + (unless more (return nil)) + (setf (gethash sym ,cht-var) t) ;; note presence of symbol + ;; Check that its access status is in the list, + ;; that pkg is a package, + ;; that the symbol is in the package, + ;; and that (in the package) it has the correct access type + (unless (member access (quote ,(copy-list symbol-types))) + (unless (> fail-count +fail-count-limit+) + (format t "Bad access type: ~S ==> ~A~%" sym access)) + (when (= fail-count +fail-count-limit+) + (format t "Further messages suppressed~%")) + (incf fail-count) + (return-from fail nil)) + + (unless (packagep pkg) + (unless (> fail-count +fail-count-limit+) + (format t "Not a package: ~S ==> ~S~%" sym pkg)) + (when (= fail-count +fail-count-limit+) + (format t "Further messages suppressed~%")) + (incf fail-count) + (return-from fail nil)) + (multiple-value-bind (sym2 access2) + (find-symbol (symbol-name sym) pkg) + (unless (or (eqt sym sym2) + (member sym2 (package-shadowing-symbols pkg))) + (unless (> fail-count +fail-count-limit+) + (format t "Not same symbol: ~S ~S~%" sym sym2)) + (when (= fail-count +fail-count-limit+) + (format t "Further messages suppressed~%")) + (incf fail-count) + (return-from fail nil)) + (unless (eqt access access2) + (unless (> fail-count +fail-count-limit+) + (format t "Not same access type: ~S ~S ~S~%" + sym access access2)) + (when (= fail-count +fail-count-limit+) + (format t "Further messages suppressed~%")) + (incf fail-count) + (return-from fail nil))))))) + ;; now, check that each symbol in each package has + ;; been properly found + (loop + for p in ,pkg-list-var do + (block fail + (do-symbols (sym p) + (multiple-value-bind (sym2 access) + (find-symbol (symbol-name sym) p) + (unless (eqt sym sym2) + (unless (> fail-count +fail-count-limit+) + (format t "Not same symbol (2): ~S ~S~%" + sym sym2)) + (when (= fail-count +fail-count-limit+) + (format t "Further messages suppressed~%")) + (incf fail-count) + (return-from fail nil)) + (unless (or (not (member access + (quote ,(copy-list symbol-types)))) + (gethash sym ,cht-var)) + (format t "Symbol not found: ~S~%" sym) + (incf fail-count) + (return-from fail nil)))))) + (or (zerop fail-count) fail-count)))) + +(defun with-package-iterator-internal (packages) + (test-with-package-iterator packages :internal)) + +(defun with-package-iterator-external (packages) + (test-with-package-iterator packages :external)) + +(defun with-package-iterator-inherited (packages) + (test-with-package-iterator packages :inherited)) + +(defun with-package-iterator-all (packages) + (test-with-package-iterator packages :internal :external :inherited)) + +(defun frob-simple-condition (c expected-fmt &rest expected-args) + "Try out the format control and format arguments of a simple-condition C, + but make no assumptions about what they print as, only that they + do print." + (declare (ignore expected-fmt expected-args)) + (and (typep c 'simple-condition) + (let ((fc (simple-condition-format-control c)) + (args (simple-condition-format-arguments c))) + (and + (stringp (apply #'format nil fc args)) + t)))) + +(defun frob-simple-error (c expected-fmt &rest expected-args) + (and (typep c 'simple-error) + (apply #'frob-simple-condition c expected-fmt expected-args))) + +(defun frob-simple-warning (c expected-fmt &rest expected-args) + (and (typep c 'simple-warning) + (apply #'frob-simple-condition c expected-fmt expected-args))) + +(defparameter *array-element-types* + '(t (integer 0 0) + bit (unsigned-byte 8) (unsigned-byte 16) + (unsigned-byte 32) float short-float + single-float double-float long-float + nil character base-char symbol boolean null)) + +(defun random-partition (n p) + "Partition n into p numbers, each >= 1. Return list of numbers." + (assert (<= 1 p)) + #| + (cond + ((= p 1) (list n)) + ((< n p) (make-list p :initial-element 1)) + (t + (let ((n1 (1+ (random (floor n p))))) + (cons n1 (random-partition (- n n1) (1- p))))))) + |# + (cond + ((= p 1) (list n)) + ((= n 0) (make-list p :initial-element 0)) + (t (let* ((r (random p)) + (n1 (random (1+ n)))) + (cond + ((= r 0) + (cons n1 (random-partition (- n n1) (1- p)))) + ((= r (1- p)) + (append (random-partition (- n n1) (1- p)) (list n1))) + (t + (let* ((n2 (random (1+ (- n n1)))) + (n3 (- n n1 n2))) + (append (random-partition n2 r) + (list n1) + (random-partition n3 (- p 1 r)))))))))) + +(defmacro expand-in-current-env (macro-form &environment env) + (macroexpand macro-form env)) + +(defun typep* (element type) + (not (not (typep element type)))) diff --git a/ansi-tests/apply.lsp b/ansi-tests/apply.lsp new file mode 100644 index 0000000..56ab007 --- /dev/null +++ b/ansi-tests/apply.lsp @@ -0,0 +1,61 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 15:13:07 2003 +;;;; Contains: Tests of APPLY + +(in-package :cl-test) + +;;; Error cases + +(deftest apply.error.1 + (classify-error (apply)) + program-error) + +(deftest apply.error.2 + (classify-error (apply #'cons)) + program-error) + +(deftest apply.error.3 + (classify-error (apply #'cons nil)) + program-error) + +(deftest apply.error.4 + (classify-error (apply #'cons (list 1 2 3))) + program-error) + +;;; Non-error cases + +(deftest apply.1 + (apply #'cons 'a 'b nil) + (a . b)) + +(deftest apply.2 + (apply #'cons 'a '(b)) + (a . b)) + +(deftest apply.3 + (apply #'cons '(a b)) + (a . b)) + +(deftest apply.4 + (let ((zeros (make-list (min 10000 (1- call-arguments-limit)) + :initial-element 1))) + (apply #'+ zeros)) + #.(min 10000 (1- call-arguments-limit))) + +(deftest apply.5 + (apply 'cons '(a b)) + (a . b)) + +(deftest apply.order.1 + (let ((i 0) x y z) + (values + (apply (progn (setf x (incf i)) + #'list) + (progn (setf y (incf i)) + 'b) + (progn (setf z (incf i)) + (list 'a))) + i x y z)) + (b a) 3 1 2 3) + diff --git a/ansi-tests/aref.lsp b/ansi-tests/aref.lsp new file mode 100644 index 0000000..1b8c093 --- /dev/null +++ b/ansi-tests/aref.lsp @@ -0,0 +1,144 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Feb 11 17:33:24 2003 +;;;; Contains: Tests for AREF + +(in-package :cl-test) + +;;; AREF is also tested in many other places + +(deftest aref.1 + (aref #0aT) + T) + +(deftest aref.2 + (aref #(1 2 3 4) 2) + 3) + +(deftest aref.3 + (aref #2a((a b c d)(e f g h)) 1 2) + g) + +(deftest aref.4 + (loop for i from 0 below 6 collect (aref "abcdef" i)) + (#\a #\b #\c #\d #\e #\f)) + +(deftest aref.5 + (let ((a (make-array '(2 3) :element-type 'base-char + :initial-contents '("abc" "def")))) + (loop for i below 2 + collect (loop for j below 3 + collect (aref a i j)))) + ((#\a #\b #\c) + (#\d #\e #\f))) + +(deftest aref.6 + (loop for i below 10 collect (aref #*1101100010 i)) + (1 1 0 1 1 0 0 0 1 0)) + +(deftest aref.7 + (let ((a (make-array '(2 5) :element-type 'bit + :initial-contents '((1 1 0 0 1) + (0 1 0 1 0))))) + (loop for i below 2 + collect (loop for j below 5 + collect (aref a i j)))) + ((1 1 0 0 1) + (0 1 0 1 0))) + +;;; Order of argument evaluation + +(deftest aref.order.1 + (let ((i 0) x y (a #(a b c d))) + (values + (aref (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 2)) + i x y)) + c 2 1 2) + +(deftest aref.order.2 + (let ((i 0) x y z (a #2a((a b c)(d e f)))) + (values + (aref (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 1) + (progn (setf z (incf i)) 2)) + i x y z)) + f 3 1 2 3) + + +;;; Setf of aref + +(deftest setf-aref.1 + (let ((a (copy-seq #(1 2 3 4)))) + (values + (setf (aref a 2) 'z) + a)) + z + #(1 2 z 4)) + +(deftest setf-aref.2 + (let ((a (make-array nil :initial-element 1))) + (values + (setf (aref a) 'z) + a)) + z #0az) + +(deftest setf-aref.3 + (let ((a (make-array '(2 3) :initial-element 'a))) + (values + (setf (aref a 0 1) 'z) + a)) + z + #2a((a z a)(a a a))) + +(deftest setf-aref.4 + (let ((a (copy-seq "abcd"))) + (values + (setf (aref a 0) #\z) + a)) + #\z + "zbcd") + +(deftest setf-aref.5 + (let ((a (copy-seq #*0011))) + (values + (setf (aref a 0) 1) + a)) + 1 + #*1011) + +(deftest setf-aref.6 + (let ((a (make-array '(2 3) :initial-element #\a :element-type 'base-char))) + (values + (setf (aref a 0 1) #\z) + a)) + #\z + #2a((#\a #\z #\a)(#\a #\a #\a))) + +(deftest setf-aref.7 + (let ((a (make-array '(2 3) :initial-element 1 :element-type 'bit))) + (values + (setf (aref a 0 1) 0) + a)) + 0 + #2a((1 0 1)(1 1 1))) + +(deftest setf-aref.order.1 + (let ((i 0) x y z (a (copy-seq #(a b c d)))) + (values + (setf (aref (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 2)) + (progn (setf z (incf i)) 'z)) + a + i x y z)) + z #(a b z d) 3 1 2 3) + +;;; To add: aref on displaced arrays, arrays with fill pointers, etc. + +(deftest aref.error.1 + (classify-error (aref)) + program-error) + +(deftest aref.error.2 + (classify-error (funcall #'aref)) + program-error) diff --git a/ansi-tests/array-as-class.lsp b/ansi-tests/array-as-class.lsp new file mode 100644 index 0000000..879e090 --- /dev/null +++ b/ansi-tests/array-as-class.lsp @@ -0,0 +1,66 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 07:45:25 2003 +;;;; Contains: Tests for ARRAY as a class + +(in-package :cl-test) + +(deftest array-as-class.1 + (notnot-mv (typep #() (find-class 'array))) + t) + +(deftest array-as-class.2 + (notnot-mv (typep #(a b c) (find-class 'array))) + t) + +(deftest array-as-class.3 + (notnot-mv (typep #0aNIL (find-class 'array))) + t) + +(deftest array-as-class.4 + (notnot-mv (typep #2a((a b)(c d)) (find-class 'array))) + t) + +(deftest array-as-class.5 + (notnot-mv (typep "abcde" (find-class 'array))) + t) + +(deftest array-as-class.6 + (notnot-mv (typep #*0011101 (find-class 'array))) + t) + +(deftest array-as-class.7 + (subtypep* 'array (find-class 'array)) + t t) + +(deftest array-as-class.8 + (subtypep* (find-class 'array) 'array) + t t) + +(deftest array-as-class.9 + (typep nil (find-class 'array)) + nil) + +(deftest array-as-class.10 + (typep 'x (find-class 'array)) + nil) + +(deftest array-as-class.11 + (typep '(a b c) (find-class 'array)) + nil) + +(deftest array-as-class.12 + (typep 10.0 (find-class 'array)) + nil) + +(deftest array-as-class.13 + (typep #'(lambda (x) (cons x nil)) (find-class 'array)) + nil) + +(deftest array-as-class.14 + (typep 1 (find-class 'array)) + nil) + +(deftest array-as-class.15 + (typep (1+ most-positive-fixnum) (find-class 'array)) + nil) diff --git a/ansi-tests/array-aux.lsp b/ansi-tests/array-aux.lsp new file mode 100644 index 0000000..09f8ccf --- /dev/null +++ b/ansi-tests/array-aux.lsp @@ -0,0 +1,205 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 05:11:31 2003 +;;;; Contains: Auxiliary functions for array tests + +(in-package :cl-test) + +(defun make-array-check-upgrading (type) + (subtypep* type (array-element-type (make-array 0 :element-type type)))) + +(defun subtypep-or-unknown (subtype supertype) + (multiple-value-bind* (is-subtype is-known) + (subtypep subtype supertype) + (or (not is-known) (notnot is-subtype)))) + +(defun make-array-with-checks (dimensions + &rest options + &key + (element-type t element-type-p) + (initial-contents nil initial-contents-p) + (initial-element nil initial-element-p) + (adjustable nil) + (fill-pointer nil) + (displaced-to nil) + (displaced-index-offset 0 dio-p) + &aux + (dimensions-list (if (listp dimensions) + dimensions + (list dimensions)))) + "Call MAKE-ARRAY and do sanity tests on the output." + (declare (ignore element-type-p initial-contents initial-contents-p + initial-element initial-element-p dio-p)) + (let ((a (check-values (apply #'make-array dimensions options))) + (rank (length dimensions-list))) + (cond + + ((not (typep a 'array)) + :fail-not-array) + ((not (typep a (find-class 'array))) + :fail-not-array-class) + ((not (typep a '(array *))) + :fail-not-array2) + ((not (typep a `(array * ,dimensions-list))) + :fail-not-array3) + ((not (typep a `(array * *))) + :fail-not-array4) + ((not (typep a `(array ,element-type))) + :fail-not-array5) + ((not (typep a `(array ,element-type *))) + :fail-not-array6) + + #-gcl + ((not (typep a `(array ,element-type ,rank))) + :fail-not-array7) + + ((not (typep a `(array ,element-type ,dimensions-list))) + :fail-not-array8) + + ((not (typep a `(array ,element-type ,(mapcar (constantly '*) + dimensions-list)))) + :fail-not-array9) + + ((loop for i from 0 below (min 10 rank) + thereis + (let ((x (append (subseq dimensions-list 0 i) + (list '*) + (subseq dimensions-list (1+ i))))) + (or (not (typep a `(array * ,x))) + (not (typep a `(array ,element-type ,x)))))) + :fail-not-array10) + + ((not (check-values (arrayp a))) :fail-not-arrayp) + + ((and ;; (eq t element-type) + (not adjustable) + (not fill-pointer) + (not displaced-to) + (cond + ((not (typep a 'simple-array)) + :fail-not-simple-array) + ((not (typep a '(simple-array *))) + :fail-not-simple-array2) + ((not (typep a `(simple-array * ,dimensions-list))) + :fail-not-simple-array3) + ((not (typep a `(simple-array * *))) + :fail-not-simple-array4) + ((not (typep a `(simple-array ,element-type))) + :fail-not-simple-array5) + ((not (typep a `(simple-array ,element-type *))) + :fail-not-simple-array6) + #-gcl + ((not (typep a `(simple-array ,element-type + ,rank))) + :fail-not-array7) + ((not (typep a `(simple-array ,element-type ,dimensions-list))) + :fail-not-simple-array8) + ((not (typep a `(simple-array ,element-type + ,(mapcar (constantly '*) + dimensions-list)))) + :fail-not-simple-array9) + ))) + + ;; If the array is a vector, check that... + ((and (eql rank 1) + (cond + ;; ...It's in type vector + ((not (typep a 'vector)) + :fail-not-vector) + ;; ...If the element type is a subtype of BIT, then it's a + ;; bit vector... + ((and (subtypep 'bit element-type) + (subtypep element-type 'bit) + (or (not (bit-vector-p a)) + (not (typep a 'bit-vector)))) + :fail-not-bit-vector) + ;; ...If not adjustable, fill pointered, or displaced, + ;; then it's a simple vector or simple bit vector + ;; (if the element-type is appropriate) + ((and (not adjustable) + (not fill-pointer) + (not displaced-to) + (cond + ((and (eq t element-type) + (or (not (simple-vector-p a)) + (not (typep a 'simple-vector)))) + :fail-not-simple-vector) + ((and (subtypep 'bit element-type) + (subtypep element-type 'bit) + (or (not (simple-bit-vector-p a)) + (not (typep a 'simple-bit-vector)))) + :fail-not-simple-bit-vector) ))) ))) + + ;; The dimensions of the array must be initialized properly + ((not (equal (array-dimensions a) dimensions-list)) + :fail-array-dimensions) + + ;; The rank of the array must equal the number of dimensions + ((not (equal (array-rank a) rank)) + :fail-array-rank) + + ;; Arrays other than vectors cannot have fill pointers + ((and (not (equal (array-rank a) 1)) + (array-has-fill-pointer-p a)) + :fail-non-vector-fill-pointer) + + ;; The actual element type must be a supertype of the element-type + ;; argument + ((not (subtypep-or-unknown element-type (array-element-type a))) + :failed-array-element-type) + + ;; If :adjustable is given, the array must be adjustable. + ((and adjustable + (not (check-values (adjustable-array-p a))) + :fail-adjustable)) + + ;; If :fill-pointer is given, the array must have a fill pointer + ((and fill-pointer + (not (check-values (array-has-fill-pointer-p a))) + :fail-has-fill-pointer)) + + ;; If the fill pointer is given as an integer, it must be the value + ;; of the fill pointer of the new array + ((and (check-values (integerp fill-pointer)) + (not (eql fill-pointer (check-values (fill-pointer a)))) + :fail-fill-pointer-1)) + + ;; If the fill-pointer argument is t, the fill pointer must be + ;; set to the vector size. + ((and (eq fill-pointer t) + (not (eql (first dimensions-list) (fill-pointer a))) + :fail-fill-pointer-2)) + + ;; If displaced-to another array, check that this is proper + ((and + displaced-to + (multiple-value-bind* (actual-dt actual-dio) + (array-displacement a) + (cond + ((not (eq actual-dt displaced-to)) + :fail-displacement-1) + ((not (eql actual-dio displaced-index-offset)) + :fail-displaced-index-offset))))) + + ;; Test of array-total-size + ((not (eql (check-values (array-total-size a)) + (reduce #'* dimensions-list :initial-value 1))) + :fail-array-total-size) + + ;; Test array-row-major-index on all zeros + ((and (> (array-total-size a) 0) + (not (eql (check-values + (apply #'array-row-major-index + a (make-list (array-rank a) :initial-element 0))) + 0))) + :fail-array-row-major-index-0) + + ;; For the last entry + ((and (> (array-total-size a) 0) + (not (eql (apply #'array-row-major-index + a (mapcar #'1- dimensions-list)) + (1- (reduce #'* dimensions-list :initial-value 1))))) + :fail-array-row-major-index-last) + + ;; No problems -- return the array + (t a)))) diff --git a/ansi-tests/array-dimension.lsp b/ansi-tests/array-dimension.lsp new file mode 100644 index 0000000..f6f4ee0 --- /dev/null +++ b/ansi-tests/array-dimension.lsp @@ -0,0 +1,63 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 06:55:14 2003 +;;;; Contains: Tests of ARRAY-DIMENSION + +(in-package :cl-test) + +;;; array-dimension is also tested by the tests in make-array.lsp + +(deftest array-dimension.1 + (array-dimension #(0 1 2 3) 0) + 4) + +(deftest array-dimension.2 + (array-dimension "abcdef" 0) + 6) + +(deftest array-dimension.3 + (array-dimension #2a((1 2 3 4)(5 6 7 8)) 0) + 2) + +(deftest array-dimension.4 + (array-dimension #2a((1 2 3 4)(5 6 7 8)) 1) + 4) + +(deftest array-dimension.5 + (let ((a (make-array '(10) :fill-pointer 5))) + (array-dimension a 0)) + 10) + +(deftest array-dimension.6 + (let ((a (make-array '(10) :adjustable t))) + (values + (array-dimension a 0) + (progn + (adjust-array a '(20)) + (array-dimension a 0)))) + 10 20) + +(deftest array-dimension.order.1 + (let ((i 0) a b) + (values + (array-dimension (progn (setf a (incf i)) #(a b c d)) + (progn (setf b (incf i)) 0)) + i a b)) + 4 2 1 2) + +;;; Error tests + +(deftest array-dimension.error.1 + (classify-error (array-dimension)) + program-error) + +(deftest array-dimension.error.2 + (classify-error (array-dimension #(a b c))) + program-error) + +(deftest array-dimension.error.3 + (classify-error (array-dimension #(a b c) 0 nil)) + program-error) + + + diff --git a/ansi-tests/array-dimensions.lsp b/ansi-tests/array-dimensions.lsp new file mode 100644 index 0000000..5cdeb55 --- /dev/null +++ b/ansi-tests/array-dimensions.lsp @@ -0,0 +1,69 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 06:59:37 2003 +;;;; Contains: Tests of ARRAY-DIMENSIONS + +(in-package :cl-test) + +;;; The tests in make-array.lsp also test this function + +(deftest array-dimensions.1 + (array-dimensions #0aX) + nil) + +(deftest array-dimensions.2 + (array-dimensions #(a b c d)) + (4)) + +(deftest array-dimensions.3 + (array-dimensions #*0011011011) + (10)) + +(deftest array-dimensions.4 + (array-dimensions "abcdef") + (6)) + +(deftest array-dimensions.5 + (array-dimensions #2a((1 2 3)(4 5 6)(7 8 9)(10 11 12))) + (4 3)) + +(deftest array-dimensions.6 + (let ((a (make-array '(2 3 4) :adjustable t))) + (values (array-dimension a 0) + (array-dimension a 1) + (array-dimension a 2))) + 2 3 4) + +(deftest array-dimensions.7 + (let ((a (make-array '(10) :fill-pointer 5))) + (array-dimension a 0)) + 10) + +;;; Error tests + +(deftest array-dimensions.error.1 + (classify-error (array-dimensions)) + program-error) + +(deftest array-dimensions.error.2 + (classify-error (array-dimensions #(a b c) nil)) + program-error) + +(deftest array-dimensions.error.3 + (let (why) + (loop for e in *mini-universe* + unless (or (typep e 'array) + (eq 'type-error + (setq why (classify-error** + `(array-dimensions ',e))))) + collect (list e why))) + nil) + +(deftest array-dimensions.error.4 + (classify-error (array-dimensions nil)) + type-error) + +(deftest array-dimensions.error.5 + (classify-error (locally (array-dimensions nil))) + type-error) + diff --git a/ansi-tests/array-displacement.lsp b/ansi-tests/array-displacement.lsp new file mode 100644 index 0000000..f1c34f2 --- /dev/null +++ b/ansi-tests/array-displacement.lsp @@ -0,0 +1,135 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 06:20:51 2003 +;;;; Contains: Tests for ARRAY-DISPLACEMENT + +(in-package :cl-test) + +;;; The tests in make-array.lsp also test array-displacement + +;;; The standard is contradictory about whether arrays created with +;;; :displaced-to NIL should return NIL as their primary value or +;;; not. I will assume (as per Kent Pitman's comment on comp.lang.lisp) +;;; that an implementation is free to implement all arrays as actually +;;; displaced. Therefore, I've omitted all the tests of not-expressly +;;; displaced arrays. + +;;; Behavior on expressly displaced arrays + +(deftest array-displacement.7 + (let* ((a (make-array '(10))) + (b (make-array '(10) :displaced-to a))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 0)))) + t) + +(deftest array-displacement.8 + (let* ((a (make-array '(10))) + (b (make-array '(5) :displaced-to a :displaced-index-offset 2))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 2)))) + t) + +(deftest array-displacement.9 + (let* ((a (make-array '(10) :element-type 'base-char)) + (b (make-array '(5) :displaced-to a :displaced-index-offset 2 + :element-type 'base-char))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 2)))) + t) + +(deftest array-displacement.10 + (let* ((a (make-array '(10) :element-type 'base-char)) + (b (make-array '(5) :displaced-to a + :element-type 'base-char))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 0)))) + t) + +(deftest array-displacement.11 + (let* ((a (make-array '(10) :element-type 'bit)) + (b (make-array '(5) :displaced-to a :displaced-index-offset 2 + :element-type 'bit))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 2)))) + t) + +(deftest array-displacement.12 + (let* ((a (make-array '(10) :element-type 'bit)) + (b (make-array '(5) :displaced-to a + :element-type 'bit))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 0)))) + t) + +(deftest array-displacement.13 + (let* ((a (make-array '(10) :element-type '(integer 0 255))) + (b (make-array '(5) :displaced-to a :displaced-index-offset 2 + :element-type '(integer 0 255)))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 2)))) + t) + +(deftest array-displacement.14 + (let* ((a (make-array '(10) :element-type '(integer 0 255))) + (b (make-array '(5) :displaced-to a + :element-type '(integer 0 255)))) + (multiple-value-bind* (dt disp) + (array-displacement b) + (and (eqt a dt) + (eqlt disp 0)))) + t) + +(deftest array-displacement.order.1 + (let* ((a (make-array '(10))) + (b (make-array '(10) :displaced-to a)) + (i 0)) + (multiple-value-bind* (dt disp) + (array-displacement (progn (incf i) b)) + (and (eql i 1) + (eqt a dt) + (eqlt disp 0)))) + t) + +;;; Error tests + +(deftest array-displacement.error.1 + (classify-error (array-displacement)) + program-error) + +(deftest array-displacement.error.2 + (classify-error (array-displacement #(a b c) nil)) + program-error) + +(deftest array-displacement.error.3 + (let (why) + (loop for e in *mini-universe* + unless (or (typep e 'array) + (eq 'type-error + (setq why (classify-error** + `(array-displacement ',e))))) + collect (list e why))) + nil) + +(deftest array-displacement.error.4 + (classify-error (array-displacement nil)) + type-error) + +(deftest array-displacement.error.5 + (classify-error (let ((x nil)) (array-displacement x))) + type-error) + diff --git a/ansi-tests/array-in-bounds-p.lsp b/ansi-tests/array-in-bounds-p.lsp new file mode 100644 index 0000000..26e9afc --- /dev/null +++ b/ansi-tests/array-in-bounds-p.lsp @@ -0,0 +1,152 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 19:57:29 2003 +;;;; Contains: Tests for ARRAY-IN-BOUNDS-P + +(in-package :cl-test) + +(deftest array-in-bounds-p.1 + (array-in-bounds-p #() 0) + nil) + +(deftest array-in-bounds-p.2 + (array-in-bounds-p #() -1) + nil) + +(deftest array-in-bounds-p.3 + (let ((a #(a b c d))) + (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i)))) + (t t t t nil)) + +(deftest array-in-bounds-p.4 + (notnot (array-in-bounds-p #0aNIL)) + t) + +(deftest array-in-bounds-p.5 + (array-in-bounds-p "" 0) + nil) + +(deftest array-in-bounds-p.6 + (array-in-bounds-p "" -1) + nil) + +(deftest array-in-bounds-p.7 + (let ((a "abcd")) + (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i)))) + (t t t t nil)) + +(deftest array-in-bounds-p.8 + (array-in-bounds-p #* 0) + nil) + +(deftest array-in-bounds-p.9 + (array-in-bounds-p #* -1) + nil) + +(deftest array-in-bounds-p.10 + (let ((a #*0110)) + (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i)))) + (t t t t nil)) + +;; Fill pointer tests + +(deftest array-in-bounds-p.11 + (let ((a (make-array '(10) :fill-pointer 5))) + (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i)))) + (nil t t t t t t t t t t nil)) + +(deftest array-in-bounds-p.12 + (let ((a (make-array '(10) :fill-pointer 5 :element-type 'bit :initial-element 0))) + (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i)))) + (nil t t t t t t t t t t nil)) + +(deftest array-in-bounds-p.13 + (let ((a (make-array '(10) :fill-pointer 5 :element-type 'base-char :initial-element #\x))) + (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i)))) + (nil t t t t t t t t t t nil)) + +(deftest array-in-bounds-p.14 + (let ((a (make-array '(10) :fill-pointer 5 :element-type 'character :initial-element #\x))) + (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i)))) + (nil t t t t t t t t t t nil)) + +;;; Displaced arrays + +(deftest array-in-bounds-p.15 + (let* ((a1 (make-array '(20))) + (a2 (make-array '(10) :displaced-to a1))) + (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i)))) + (nil t t t t t t t t t t nil)) + +(deftest array-in-bounds-p.16 + (let* ((a1 (make-array '(20) :element-type 'bit :initial-element 0)) + (a2 (make-array '(10) :displaced-to a1 :element-type 'bit))) + (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i)))) + (nil t t t t t t t t t t nil)) + +(deftest array-in-bounds-p.17 + (let* ((a1 (make-array '(20) :element-type 'character :initial-element #\x)) + (a2 (make-array '(10) :displaced-to a1 :element-type 'character))) + (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i)))) + (nil t t t t t t t t t t nil)) + +;;; Multidimensional arrays + +(deftest array-in-bounds-p.18 + (let ((a (make-array '(3 4)))) + (loop for i from -1 to 3 collect + (loop for j from -1 to 4 collect + (notnot (array-in-bounds-p a i j))))) + ((nil nil nil nil nil nil) + (nil t t t t nil) + (nil t t t t nil) + (nil t t t t nil) + (nil nil nil nil nil nil))) + +(deftest array-in-bounds-p.19 + (let ((a (make-array '(1 3 4) :adjustable t))) + (loop for i from -1 to 3 collect + (loop for j from -1 to 4 collect + (notnot (array-in-bounds-p a 0 i j))))) + ((nil nil nil nil nil nil) + (nil t t t t nil) + (nil t t t t nil) + (nil t t t t nil) + (nil nil nil nil nil nil))) + +;;; Very large indices + +(deftest array-in-bounds-p.20 + (array-in-bounds-p #(a b c) (1+ most-positive-fixnum)) + nil) + +(deftest array-in-bounds-p.21 + (array-in-bounds-p #(a b c) (1- most-negative-fixnum)) + nil) + +(deftest array-in-bounds-p.22 + (array-in-bounds-p #(a b c) 1000000000000000000) + nil) + +(deftest array-in-bounds-p.23 + (array-in-bounds-p #(a b c) -1000000000000000000) + nil) + +;;; Order of evaluation tests + +(deftest array-in-bounds-p.order.1 + (let ((x 0) y z) + (values + (array-in-bounds-p (progn (setf y (incf x)) + #()) + (progn (setf z (incf x)) + 10)) + x y z)) + nil 2 1 2) + +;;; Error tests + +(deftest array-in-bounds-p.error.1 + (classify-error (array-in-bounds-p)) + program-error) + diff --git a/ansi-tests/array-misc.lsp b/ansi-tests/array-misc.lsp new file mode 100644 index 0000000..361b0a4 --- /dev/null +++ b/ansi-tests/array-misc.lsp @@ -0,0 +1,30 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 22 21:17:25 2003 +;;;; Contains: Misc. tests of array features + +(in-package :cl-test) + +(deftest array-dimension-limit.1 + (and (<= 1024 array-dimension-limit) t) + t) + +(deftest array-dimension-limit.2 + (and (typep array-dimension-limit 'fixnum) t) + t) + +(deftest array-total-size-limit.1 + (and (<= 1024 array-total-size-limit) t) + t) + +(deftest array-total-size-limit.2 + (and (typep array-total-size-limit 'fixnum) t) + t) + +(deftest array-rank-limit.1 + (and (<= 8 array-rank-limit) t) + t) + +(deftest array-rank-limit.2 + (and (typep array-rank-limit 'fixnum) t) + t) diff --git a/ansi-tests/array-rank.lsp b/ansi-tests/array-rank.lsp new file mode 100644 index 0000000..b57d67f --- /dev/null +++ b/ansi-tests/array-rank.lsp @@ -0,0 +1,52 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 20:32:57 2003 +;;;; Contains: Tests for ARRAY-RANK + +(in-package :cl-test) + +;;; Most tests for ARRAY-RANK are in make-array.lsp + +(deftest array-rank.1 + (array-rank #0aNIL) + 0) + +(deftest array-rank.2 + (loop for e in *universe* + when (and (typep e 'vector) + (not (eql (array-rank e) 1))) + collect e) + nil) + +(deftest array-rank.order.1 + (let ((i 0) a) + (values + (array-rank (progn (setf a (incf i)) "abcd")) + i a)) + 1 1 1) + +;;; Error tests + +(deftest array-rank.error.1 + (classify-error (array-rank)) + program-error) + +(deftest array-rank.error.2 + (classify-error (array-rank #(a b c) nil)) + program-error) + +(deftest array-rank.error.3 + (loop for e in *mini-universe* + when (and (not (typep e 'array)) + (not (eq (classify-error** `(array-rank ',e)) + 'type-error))) + collect e) + nil) + +(deftest array-rank.error.4 + (classify-error (array-rank nil)) + type-error) + +(deftest array-rank.error.5 + (classify-error (locally (array-rank nil) t)) + type-error) diff --git a/ansi-tests/array-row-major-index.lsp b/ansi-tests/array-row-major-index.lsp new file mode 100644 index 0000000..75f3352 --- /dev/null +++ b/ansi-tests/array-row-major-index.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 21:37:03 2003 +;;;; Contains: Tests of ARRAY-ROW-MAJOR-INDEX + +(in-package :cl-test) + +;;; More array-row-major-index tests are in make-array.lsp + +(deftest array-row-major-index.1 + (array-row-major-index #0aNIL) + 0) + +(deftest array-row-major-index.2 + (loop for i from 0 to 4 + collect (array-row-major-index #(a b c d e) i)) + (0 1 2 3 4)) + +(deftest array-row-major-index.3 + (let ((a (make-array '(5) :fill-pointer 1))) + (loop for i from 0 to 4 + collect (array-row-major-index a i))) + (0 1 2 3 4)) + +(deftest array-row-major-index.order.1 + (let ((x 0) y z + (a #(a b c d e f))) + (values + (array-row-major-index + (progn (setf y (incf x)) a) + (progn (setf z (incf x)) 0)) + x y z)) + 0 2 1 2) + +;;; Error tests + +(deftest array-row-major-index.error.1 + (classify-error (array-row-major-index)) + program-error) diff --git a/ansi-tests/array-t.lsp b/ansi-tests/array-t.lsp new file mode 100644 index 0000000..c6aa154 --- /dev/null +++ b/ansi-tests/array-t.lsp @@ -0,0 +1,275 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 25 11:55:48 2003 +;;;; Contains: Tests of (array t ...) type specifiers + +(in-package :cl-test) + +;;; Tests of (array t) + +(deftest array-t.2.1 + (notnot-mv (typep #() '(array t))) + t) + +(deftest array-t.2.2 + (notnot-mv (typep #0aX '(array t))) + t) + +(deftest array-t.2.3 + (notnot-mv (typep #2a(()) '(array t))) + t) + +(deftest array-t.2.4 + (notnot-mv (typep #(1 2 3) '(array t))) + t) + +(deftest array-t.2.5 + (typep "abcd" '(array t)) + nil) + +(deftest array-t.2.6 + (typep #*010101 '(array t)) + nil) + +;;; Tests of (array t ()) + +(deftest array-t.3.1 + (notnot-mv (typep #() '(array t nil))) + nil) + +(deftest array-t.3.2 + (notnot-mv (typep #0aX '(array t nil))) + t) + +(deftest array-t.3.3 + (typep #2a(()) '(array t nil)) + nil) + +(deftest array-t.3.4 + (typep #(1 2 3) '(array t nil)) + nil) + +(deftest array-t.3.5 + (typep "abcd" '(array t nil)) + nil) + +(deftest array-t.3.6 + (typep #*010101 '(array t nil)) + nil) + +;;; Tests of (array t 1) +;;; The '1' indicates rank, so this is equivalent to 'vector' + +(deftest array-t.4.1 + (notnot-mv (typep #() '(array t 1))) + t) + +(deftest array-t.4.2 + (typep #0aX '(array t 1)) + nil) + +(deftest array-t.4.3 + (typep #2a(()) '(array t 1)) + nil) + +(deftest array-t.4.4 + (notnot-mv (typep #(1 2 3) '(array t 1))) + t) + +(deftest array-t.4.5 + (typep "abcd" '(array t 1)) + nil) + +(deftest array-t.4.6 + (typep #*010101 '(array t 1)) + nil) + +;;; Tests of (array t 0) + +(deftest array-t.5.1 + (typep #() '(array t 0)) + nil) + +(deftest array-t.5.2 + (notnot-mv (typep #0aX '(array t 0))) + t) + +(deftest array-t.5.3 + (typep #2a(()) '(array t 0)) + nil) + +(deftest array-t.5.4 + (typep #(1 2 3) '(array t 0)) + nil) + +(deftest array-t.5.5 + (typep "abcd" '(array t 0)) + nil) + +(deftest array-t.5.6 + (typep #*010101 '(array t 0)) + nil) + +;;; Tests of (array t *) + +(deftest array-t.6.1 + (notnot-mv (typep #() '(array t *))) + t) + +(deftest array-t.6.2 + (notnot-mv (typep #0aX '(array t *))) + t) + +(deftest array-t.6.3 + (notnot-mv (typep #2a(()) '(array t *))) + t) + +(deftest array-t.6.4 + (notnot-mv (typep #(1 2 3) '(array t *))) + t) + +(deftest array-t.6.5 + (typep "abcd" '(array t *)) + nil) + +(deftest array-t.6.6 + (typep #*010101 '(array t *)) + nil) + +;;; Tests of (array t 2) + +(deftest array-t.7.1 + (typep #() '(array t 2)) + nil) + +(deftest array-t.7.2 + (typep #0aX '(array t 2)) + nil) + +(deftest array-t.7.3 + (notnot-mv (typep #2a(()) '(array t 2))) + t) + +(deftest array-t.7.4 + (typep #(1 2 3) '(array t 2)) + nil) + +(deftest array-t.7.5 + (typep "abcd" '(array t 2)) + nil) + +(deftest array-t.7.6 + (typep #*010101 '(array t 2)) + nil) + +;;; Testing '(array t (--)) + +(deftest array-t.8.1 + (typep #() '(array t (1))) + nil) + +(deftest array-t.8.2 + (notnot-mv (typep #() '(array t (0)))) + t) + +(deftest array-t.8.3 + (notnot-mv (typep #() '(array t (*)))) + t) + +(deftest array-t.8.4 + (typep #(a b c) '(array t (2))) + nil) + +(deftest array-t.8.5 + (notnot-mv (typep #(a b c) '(array t (3)))) + t) + +(deftest array-t.8.6 + (notnot-mv (typep #(a b c) '(array t (*)))) + t) + +(deftest array-t.8.7 + (typep #(a b c) '(array t (4))) + nil) + +(deftest array-t.8.8 + (typep #2a((a b c)) '(array t (*))) + nil) + +(deftest array-t.8.9 + (typep #2a((a b c)) '(array t (3))) + nil) + +(deftest array-t.8.10 + (typep #2a((a b c)) '(array t (1))) + nil) + +(deftest array-t.8.11 + (typep "abc" '(array t (2))) + nil) + +(deftest array-t.8.12 + (typep "abc" '(array t (3))) + nil) + +(deftest array-t.8.13 + (typep "abc" '(array t (*))) + nil) + +(deftest array-t.8.14 + (typep "abc" '(array t (4))) + nil) + +;;; Two dimensional array type tests + +(deftest array-t.9.1 + (typep #() '(array t (* *))) + nil) + +(deftest array-t.9.2 + (typep "abc" '(array t (* *))) + nil) + +(deftest array-t.9.3 + (typep #(a b c) '(array t (3 *))) + nil) + +(deftest array-t.9.4 + (typep #(a b c) '(array t (* 3))) + nil) + +(deftest array-t.9.5 + (typep "abc" '(array t (3 *))) + nil) + +(deftest array-t.9.6 + (typep "abc" '(array t (* 3))) + nil) + +(deftest array-t.9.7 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array t (* *)))) + t) + +(deftest array-t.9.8 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array t (3 *)))) + t) + +(deftest array-t.9.9 + (typep #2a((a b)(c d)(e f)) '(array t (2 *))) + nil) + +(deftest array-t.9.10 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array t (* 2)))) + t) + +(deftest array-t.9.11 + (typep #2a((a b)(c d)(e f)) '(array t (* 3))) + nil) + +(deftest array-t.9.12 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array t (3 2)))) + t) + +(deftest array-t.9.13 + (typep #2a((a b)(c d)(e f)) '(array t (2 3))) + nil) diff --git a/ansi-tests/array-total-size.lsp b/ansi-tests/array-total-size.lsp new file mode 100644 index 0000000..7f05c2d --- /dev/null +++ b/ansi-tests/array-total-size.lsp @@ -0,0 +1,63 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 22:01:09 2003 +;;;; Contains: Tests of ARRAY-TOTAL-SIZE + +(in-package :cl-test) + +;;; More tests of ARRAY-TOTAL-SIZE are in make-array.lsp + +(deftest array-total-size.1 + (array-total-size #0aNIL) + 1) + +(deftest array-total-size.2 + (array-total-size "abcdef") + 6) + +(deftest array-total-size.3 + (array-total-size #(a b c)) + 3) + +(deftest array-total-size.4 + (array-total-size #*0011010) + 7) + +(deftest array-total-size.5 + (array-total-size #2a((1 2 3)(4 5 6)(7 8 9)(a b c))) + 12) + +(deftest array-total-size.order.1 + (let ((i 0) a) + (values + (array-total-size (progn (setf a (incf i)) #(a b c d))) + i a)) + 4 1 1) + +;;; Error tests + +(deftest array-total-size.error.1 + (classify-error (array-total-size)) + program-error) + +(deftest array-total-size.error.2 + (classify-error (array-total-size #(a b c) nil)) + program-error) + +(deftest array-total-size.error.3 + (let (why) + (loop for e in *mini-universe* + when (and (not (typep e 'array)) + (not (eql (setq why + (classify-error** `(array-total-size ',e))) + 'type-error))) + collect (list e why))) + nil) + +(deftest array-total-size.error.4 + (classify-error (array-total-size 0)) + type-error) + +(deftest array-total-size.error.5 + (classify-error (locally (array-total-size 0) t)) + type-error) diff --git a/ansi-tests/array.lsp b/ansi-tests/array.lsp new file mode 100644 index 0000000..11bfae7 --- /dev/null +++ b/ansi-tests/array.lsp @@ -0,0 +1,330 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 25 08:46:58 2003 +;;;; Contains: Tests of the ARRAY type specifier + +(in-package :cl-test) + +;;; Tests of array by itself + +(deftest array.1.1 + (notnot-mv (typep #() 'array)) + t) + +(deftest array.1.2 + (notnot-mv (typep #0aX 'array)) + t) + +(deftest array.1.3 + (notnot-mv (typep #2a(()) 'array)) + t) + +(deftest array.1.4 + (notnot-mv (typep #(1 2 3) 'array)) + t) + +(deftest array.1.5 + (notnot-mv (typep "abcd" 'array)) + t) + +(deftest array.1.6 + (notnot-mv (typep #*010101 'array)) + t) + +(deftest array.1.7 + (typep nil 'array) + nil) + +(deftest array.1.8 + (typep 'x 'array) + nil) + +(deftest array.1.9 + (typep '(a b c) 'array) + nil) + +(deftest array.1.10 + (typep 10.0 'array) + nil) + +(deftest array.1.11 + (typep #'(lambda (x) (cons x nil)) 'array) + nil) + +(deftest array.1.12 + (typep 1 'array) + nil) + +(deftest array.1.13 + (typep (1+ most-positive-fixnum) 'array) + nil) + + +;;; Tests of (array *) + +(deftest array.2.1 + (notnot-mv (typep #() '(array *))) + t) + +(deftest array.2.2 + (notnot-mv (typep #0aX '(array *))) + t) + +(deftest array.2.3 + (notnot-mv (typep #2a(()) '(array *))) + t) + +(deftest array.2.4 + (notnot-mv (typep #(1 2 3) '(array *))) + t) + +(deftest array.2.5 + (notnot-mv (typep "abcd" '(array *))) + t) + +(deftest array.2.6 + (notnot-mv (typep #*010101 '(array *))) + t) + +;;; Tests of (array * ()) + +(deftest array.3.1 + (notnot-mv (typep #() '(array * nil))) + nil) + +(deftest array.3.2 + (notnot-mv (typep #0aX '(array * nil))) + t) + +(deftest array.3.3 + (typep #2a(()) '(array * nil)) + nil) + +(deftest array.3.4 + (typep #(1 2 3) '(array * nil)) + nil) + +(deftest array.3.5 + (typep "abcd" '(array * nil)) + nil) + +(deftest array.3.6 + (typep #*010101 '(array * nil)) + nil) + +;;; Tests of (array * 1) +;;; The '1' indicates rank, so this is equivalent to 'vector' + +(deftest array.4.1 + (notnot-mv (typep #() '(array * 1))) + t) + +(deftest array.4.2 + (typep #0aX '(array * 1)) + nil) + +(deftest array.4.3 + (typep #2a(()) '(array * 1)) + nil) + +(deftest array.4.4 + (notnot-mv (typep #(1 2 3) '(array * 1))) + t) + +(deftest array.4.5 + (notnot-mv (typep "abcd" '(array * 1))) + t) + +(deftest array.4.6 + (notnot-mv (typep #*010101 '(array * 1))) + t) + +;;; Tests of (array * 0) + +(deftest array.5.1 + (typep #() '(array * 0)) + nil) + +(deftest array.5.2 + (notnot-mv (typep #0aX '(array * 0))) + t) + +(deftest array.5.3 + (typep #2a(()) '(array * 0)) + nil) + +(deftest array.5.4 + (typep #(1 2 3) '(array * 0)) + nil) + +(deftest array.5.5 + (typep "abcd" '(array * 0)) + nil) + +(deftest array.5.6 + (typep #*010101 '(array * 0)) + nil) + +;;; Tests of (array * *) + +(deftest array.6.1 + (notnot-mv (typep #() '(array * *))) + t) + +(deftest array.6.2 + (notnot-mv (typep #0aX '(array * *))) + t) + +(deftest array.6.3 + (notnot-mv (typep #2a(()) '(array * *))) + t) + +(deftest array.6.4 + (notnot-mv (typep #(1 2 3) '(array * *))) + t) + +(deftest array.6.5 + (notnot-mv (typep "abcd" '(array * *))) + t) + +(deftest array.6.6 + (notnot-mv (typep #*010101 '(array * *))) + t) + +;;; Tests of (array * 2) + +(deftest array.7.1 + (typep #() '(array * 2)) + nil) + +(deftest array.7.2 + (typep #0aX '(array * 2)) + nil) + +(deftest array.7.3 + (notnot-mv (typep #2a(()) '(array * 2))) + t) + +(deftest array.7.4 + (typep #(1 2 3) '(array * 2)) + nil) + +(deftest array.7.5 + (typep "abcd" '(array * 2)) + nil) + +(deftest array.7.6 + (typep #*010101 '(array * 2)) + nil) + +;;; Testing '(array * (--)) + +(deftest array.8.1 + (typep #() '(array * (1))) + nil) + +(deftest array.8.2 + (notnot-mv (typep #() '(array * (0)))) + t) + +(deftest array.8.3 + (notnot-mv (typep #() '(array * (*)))) + t) + +(deftest array.8.4 + (typep #(a b c) '(array * (2))) + nil) + +(deftest array.8.5 + (notnot-mv (typep #(a b c) '(array * (3)))) + t) + +(deftest array.8.6 + (notnot-mv (typep #(a b c) '(array * (*)))) + t) + +(deftest array.8.7 + (typep #(a b c) '(array * (4))) + nil) + +(deftest array.8.8 + (typep #2a((a b c)) '(array * (*))) + nil) + +(deftest array.8.9 + (typep #2a((a b c)) '(array * (3))) + nil) + +(deftest array.8.10 + (typep #2a((a b c)) '(array * (1))) + nil) + +(deftest array.8.11 + (typep "abc" '(array * (2))) + nil) + +(deftest array.8.12 + (notnot-mv (typep "abc" '(array * (3)))) + t) + +(deftest array.8.13 + (notnot-mv (typep "abc" '(array * (*)))) + t) + +(deftest array.8.14 + (typep "abc" '(array * (4))) + nil) + +;;; Two dimensional array type tests + +(deftest array.9.1 + (typep #() '(array * (* *))) + nil) + +(deftest array.9.2 + (typep "abc" '(array * (* *))) + nil) + +(deftest array.9.3 + (typep #(a b c) '(array * (3 *))) + nil) + +(deftest array.9.4 + (typep #(a b c) '(array * (* 3))) + nil) + +(deftest array.9.5 + (typep "abc" '(array * (3 *))) + nil) + +(deftest array.9.6 + (typep "abc" '(array * (* 3))) + nil) + +(deftest array.9.7 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array * (* *)))) + t) + +(deftest array.9.8 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array * (3 *)))) + t) + +(deftest array.9.9 + (typep #2a((a b)(c d)(e f)) '(array * (2 *))) + nil) + +(deftest array.9.10 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array * (* 2)))) + t) + +(deftest array.9.11 + (typep #2a((a b)(c d)(e f)) '(array * (* 3))) + nil) + +(deftest array.9.12 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(array * (3 2)))) + t) + +(deftest array.9.13 + (typep #2a((a b)(c d)(e f)) '(array * (2 3))) + nil) diff --git a/ansi-tests/arrayp.lsp b/ansi-tests/arrayp.lsp new file mode 100644 index 0000000..4f46dd0 --- /dev/null +++ b/ansi-tests/arrayp.lsp @@ -0,0 +1,57 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 22:08:21 2003 +;;;; Contains: Tests of ARRAYP + +(in-package :cl-test) + +;;; Also tested by make-array.lsp + +(deftest arrayp.1 + (notnot-mv (arrayp #(a b c))) + t) + +(deftest arrayp.2 + (notnot-mv (arrayp "abcd")) + t) + +(deftest arrayp.3 + (notnot-mv (arrayp #*001110101)) + t) + +(deftest arrayp.4 + (notnot-mv (arrayp #0aNIL)) + t) + +(deftest arrayp.5 + (notnot-mv (arrayp #2a((1 2 3)(4 5 6)))) + t) + +(deftest arrayp.6 + (loop for e in *universe* + for a = (arrayp e) + for b = (typep e 'array) + when (or (and a (not b)) + (and b (not a))) + collect e) + nil) + +(deftest arrayp.order.1 + (let ((i 0) a) + (values + (arrayp (progn (setf a (incf i)) nil)) + i a)) + nil 1 1) + +;;; Error tests + +(deftest arrayp.error.1 + (classify-error (arrayp)) + program-error) + +(deftest arrayp.error.2 + (classify-error (arrayp #(a b c) nil)) + program-error) + + + diff --git a/ansi-tests/assert.lsp b/ansi-tests/assert.lsp new file mode 100644 index 0000000..4d90b0a --- /dev/null +++ b/ansi-tests/assert.lsp @@ -0,0 +1,90 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 28 06:48:19 2003 +;;;; Contains: Tests of ASSERT + +(in-package :cl-test) + +(deftest assert.1 + (assert t) + nil) + +(deftest assert.2 + (assert t ()) + nil) + +;;; I am assuming that when no places are given to ASSERT, +;;; it doesn't invoke any interactive handler. + +(deftest assert.3 + (let ((x nil)) + (handler-bind + ((error #'(lambda (c) + (setq x 17) + (let ((r (find-restart 'continue c))) + (when r (invoke-restart r)))))) + (assert x) + x)) + 17) + +(deftest assert.3a + (let ((x nil)) + (handler-bind + ((error #'(lambda (c) + (setq x 17) + (continue c)))) + (assert x) + x)) + 17) + + +;;; I don't yet know how to test the interactive version of ASSERT +;;; that is normally invoked when places are given. + +;;; Tests of the syntax (at least) + +(deftest assert.4 + (let (x) + (assert t (x))) + nil) + +(deftest assert.5 + (let ((x (cons 'a 'b))) + (assert t ((car x) (cdr x)))) + nil) + +(deftest assert.6 + (let ((x (vector 'a 'b 'c))) + (assert t ((aref x 0) (aref x 1) (aref x 2)) + "Vector x has value: ~A." x)) + nil) + +(deftest assert.7 + (let ((x nil)) + (handler-bind + ((simple-error #'(lambda (c) + (setq x 17) + (continue c)))) + (assert x () 'simple-error) + x)) + 17) + +(deftest assert.8 + (let ((x 0)) + (handler-bind + ((type-error #'(lambda (c) + (incf x) + (continue c)))) + (assert (> x 5) () 'type-error) + x)) + 6) + +(deftest assert.9 + (let ((x 0)) + (handler-bind + ((type-error #'(lambda (c) (declare (ignore c)) + (incf x) + (continue)))) + (assert (> x 5) () 'type-error) + x)) + 6) diff --git a/ansi-tests/atom-errors.lsp b/ansi-tests/atom-errors.lsp new file mode 100644 index 0000000..874fae2 --- /dev/null +++ b/ansi-tests/atom-errors.lsp @@ -0,0 +1,39 @@ +(setf x + (loop + for tp in '(CONDITION +SERIOUS-CONDITION +ERROR +TYPE-ERROR +SIMPLE-TYPE-ERROR +SIMPLE-CONDITION +PARSE-ERROR +CELL-ERROR +UNBOUND-SLOT +WARNING +STYLE-WARNING +STORAGE-CONDITION +SIMPLE-WARNING +UNBOUND-VARIABLE +CONTROL-ERROR +PROGRAM-ERROR +UNDEFINED-FUNCTION +PACKAGE-ERROR +ARITHMETIC-ERROR +DIVISION-BY-ZERO +FLOATING-POINT-INVALID-OPERATION +FLOATING-POINT-INEXACT +FLOATING-POINT-OVERFLOW +FLOATING-POINT-UNDERFLOW +FILE-ERROR +BROADCAST-STREAM +CONCATENATED-STREAM +ECHO-STREAM +FILE-STREAM +STRING-STREAM +SYNONYM-STREAM +TWO-WAY-STREAM +STREAM-ERROR +END-OF-FILE +PRINT-NOT-READABLE + READER-ERROR) + collect (list tp (multiple-value-list (subtypep* tp 'atom))))) diff --git a/ansi-tests/bit-and.lsp b/ansi-tests/bit-and.lsp new file mode 100644 index 0000000..0b62bb3 --- /dev/null +++ b/ansi-tests/bit-and.lsp @@ -0,0 +1,243 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 18:18:47 2003 +;;;; Contains: Tests of BIT-AND + +(in-package :cl-test) + +(deftest bit-and.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-and s1 s2) s1 s2)) + #0a0 + #0a0 + #0a0) + +(deftest bit-and.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-and s1 s2) s1 s2)) + #0a0 + #0a1 + #0a0) + +(deftest bit-and.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-and s1 s2) s1 s2)) + #0a0 + #0a0 + #0a1) + +(deftest bit-and.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-and s1 s2) s1 s2)) + #0a1 + #0a1 + #0a1) + +(deftest bit-and.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-and s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a0 + #0a0 + t) + +(deftest bit-and.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-and s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a1 + #0a1 + t) + +(deftest bit-and.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-and s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a0 + #0a0 + #0a0 + t) + + +;;; Tests on bit vectors + +(deftest bit-and.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-and a1 a2)) a1 a2)) + #*0001 #*0011 #*0101) + +(deftest bit-and.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-and a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*0001 #*0001 #*0101 t) + +(deftest bit-and.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-and a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*0001 #*0011 #*0101 #*0001 t) + +(deftest bit-and.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-and a1 a2 nil)) a1 a2)) + #*0001 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-and.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-and a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1))) + +(deftest bit-and.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-and a1 a2 t))) + (values a1 a2 result)) + #2a((0 0)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1))) + +(deftest bit-and.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-and a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1))) + +(deftest bit-and.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-and a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1)) + #2a((0 0)(0 1))) + +;;; Adjustable arrays + +(deftest bit-and.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-and a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1))) + +;;; Displaced arrays + +(deftest bit-and.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-and a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1))) + +(deftest bit-and.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-and a1 a2 t))) + (values a0 a1 a2 result)) + #*00010011 + #2a((0 0)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1))) + +(deftest bit-and.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-and a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100110001 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(0 1))) + +(deftest bit-and.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-and (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*0 2 1 2) + +;;; Error tests + +(deftest bit-and.error.1 + (classify-error (bit-and)) + program-error) + +(deftest bit-and.error.2 + (classify-error (bit-and #*000)) + program-error) + +(deftest bit-and.error.3 + (classify-error (bit-and #*000 #*0100 nil nil)) + program-error) diff --git a/ansi-tests/bit-andc1.lsp b/ansi-tests/bit-andc1.lsp new file mode 100644 index 0000000..5597ad1 --- /dev/null +++ b/ansi-tests/bit-andc1.lsp @@ -0,0 +1,243 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 18:56:39 2003 +;;;; Contains: Tests of BIT-ANDC1 + +(in-package :cl-test) + +(deftest bit-andc1.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-andc1 s1 s2) s1 s2)) + #0a0 + #0a0 + #0a0) + +(deftest bit-andc1.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-andc1 s1 s2) s1 s2)) + #0a0 + #0a1 + #0a0) + +(deftest bit-andc1.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-andc1 s1 s2) s1 s2)) + #0a1 + #0a0 + #0a1) + +(deftest bit-andc1.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-andc1 s1 s2) s1 s2)) + #0a0 + #0a1 + #0a1) + +(deftest bit-andc1.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-andc1 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a0 + #0a0 + t) + +(deftest bit-andc1.6 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-andc1 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a1 + #0a1 + #0a1 + t) + +(deftest bit-andc1.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-andc1 s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a0 + #0a0 + #0a0 + t) + + +;;; Tests on bit vectors + +(deftest bit-andc1.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-andc1 a1 a2)) a1 a2)) + #*0100 #*0011 #*0101) + +(deftest bit-andc1.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-andc1 a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*0100 #*0100 #*0101 t) + +(deftest bit-andc1.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*0000)) + (result (check-values (bit-andc1 a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*0100 #*0011 #*0101 #*0100 t) + +(deftest bit-andc1.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-andc1 a1 a2 nil)) a1 a2)) + #*0100 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-andc1.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-andc1 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0))) + +(deftest bit-andc1.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-andc1 a1 a2 t))) + (values a1 a2 result)) + #2a((0 0)(1 0)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0))) + +(deftest bit-andc1.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-andc1 a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0))) + +(deftest bit-andc1.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-andc1 a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0)) + #2a((0 0)(1 0))) + +;;; Adjustable arrays + +(deftest bit-andc1.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-andc1 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0))) + +;;; Displaced arrays + +(deftest bit-andc1.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-andc1 a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0))) + +(deftest bit-andc1.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-andc1 a1 a2 t))) + (values a0 a1 a2 result)) + #*00100011 + #2a((0 0)(1 0)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0))) + +(deftest bit-andc1.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-andc1 a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100110010 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 0)(1 0))) + +(deftest bit-andc1.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-andc1 (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*0 2 1 2) + +;;; Error tests + +(deftest bit-andc1.error.1 + (classify-error (bit-andc1)) + program-error) + +(deftest bit-andc1.error.2 + (classify-error (bit-andc1 #*000)) + program-error) + +(deftest bit-andc1.error.3 + (classify-error (bit-andc1 #*000 #*0100 nil nil)) + program-error) diff --git a/ansi-tests/bit-andc2.lsp b/ansi-tests/bit-andc2.lsp new file mode 100644 index 0000000..b61cbf7 --- /dev/null +++ b/ansi-tests/bit-andc2.lsp @@ -0,0 +1,244 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:01:38 2003 +;;;; Contains: Tests of BIT-ANDC2 + +(in-package :cl-test) + +(deftest bit-andc2.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-andc2 s1 s2) s1 s2)) + #0a0 + #0a0 + #0a0) + +(deftest bit-andc2.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-andc2 s1 s2) s1 s2)) + #0a1 + #0a1 + #0a0) + +(deftest bit-andc2.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-andc2 s1 s2) s1 s2)) + #0a0 + #0a0 + #0a1) + +(deftest bit-andc2.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-andc2 s1 s2) s1 s2)) + #0a0 + #0a1 + #0a1) + +(deftest bit-andc2.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-andc2 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a0 + #0a0 + t) + +(deftest bit-andc2.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-andc2 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a0 + #0a1 + #0a1 + t) + +(deftest bit-andc2.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-andc2 s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a0 + #0a1 + #0a0 + t) + + +;;; Tests on bit vectors + +(deftest bit-andc2.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-andc2 a1 a2)) a1 a2)) + #*0010 #*0011 #*0101) + +(deftest bit-andc2.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-andc2 a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*0010 #*0010 #*0101 t) + +(deftest bit-andc2.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-andc2 a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*0010 #*0011 #*0101 #*0010 t) + +(deftest bit-andc2.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-andc2 a1 a2 nil)) a1 a2)) + #*0010 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-andc2.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-andc2 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0))) + +(deftest bit-andc2.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-andc2 a1 a2 t))) + (values a1 a2 result)) + #2a((0 1)(0 0)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0))) + +(deftest bit-andc2.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-andc2 a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0))) + +(deftest bit-andc2.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-andc2 a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0)) + #2a((0 1)(0 0))) + +;;; Adjustable arrays + +(deftest bit-andc2.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-andc2 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0))) + +;;; Displaced arrays + +(deftest bit-andc2.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-andc2 a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0))) + +(deftest bit-andc2.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-andc2 a1 a2 t))) + (values a0 a1 a2 result)) + #*01000011 + #2a((0 1)(0 0)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0))) + +(deftest bit-andc2.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-andc2 a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100110100 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(0 0))) + +(deftest bit-andc2.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-andc2 (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*0 2 1 2) + +;;; Error tests + +(deftest bit-andc2.error.1 + (classify-error (bit-andc2)) + program-error) + +(deftest bit-andc2.error.2 + (classify-error (bit-andc2 #*000)) + program-error) + +(deftest bit-andc2.error.3 + (classify-error (bit-andc2 #*000 #*0100 nil nil)) + program-error) + diff --git a/ansi-tests/bit-eqv.lsp b/ansi-tests/bit-eqv.lsp new file mode 100644 index 0000000..6593d97 --- /dev/null +++ b/ansi-tests/bit-eqv.lsp @@ -0,0 +1,245 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:07:23 2003 +;;;; Contains: Tests of BIT-EQV + + +(in-package :cl-test) + +(deftest bit-eqv.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-eqv s1 s2) s1 s2)) + #0a1 + #0a0 + #0a0) + +(deftest bit-eqv.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-eqv s1 s2) s1 s2)) + #0a0 + #0a1 + #0a0) + +(deftest bit-eqv.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-eqv s1 s2) s1 s2)) + #0a0 + #0a0 + #0a1) + +(deftest bit-eqv.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-eqv s1 s2) s1 s2)) + #0a1 + #0a1 + #0a1) + +(deftest bit-eqv.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-eqv s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a1 + #0a1 + t) + +(deftest bit-eqv.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-eqv s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a1 + #0a1 + t) + +(deftest bit-eqv.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-eqv s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a0 + #0a0 + #0a0 + t) + + +;;; Tests on bit vectors + +(deftest bit-eqv.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-eqv a1 a2)) a1 a2)) + #*1001 #*0011 #*0101) + +(deftest bit-eqv.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-eqv a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*1001 #*1001 #*0101 t) + +(deftest bit-eqv.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*0000)) + (result (check-values (bit-eqv a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*1001 #*0011 #*0101 #*1001 t) + +(deftest bit-eqv.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-eqv a1 a2 nil)) a1 a2)) + #*1001 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-eqv.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-eqv a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1))) + +(deftest bit-eqv.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-eqv a1 a2 t))) + (values a1 a2 result)) + #2a((1 0)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1))) + +(deftest bit-eqv.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-eqv a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1))) + +(deftest bit-eqv.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-eqv a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1)) + #2a((1 0)(0 1))) + +;;; Adjustable arrays + +(deftest bit-eqv.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-eqv a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1))) + +;;; Displaced arrays + +(deftest bit-eqv.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-eqv a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1))) + +(deftest bit-eqv.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-eqv a1 a2 t))) + (values a0 a1 a2 result)) + #*10010011 + #2a((1 0)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1))) + +(deftest bit-eqv.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-eqv a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100111001 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 1))) + +(deftest bit-eqv.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-eqv (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*1 2 1 2) + +;;; Error tests + +(deftest bit-eqv.error.1 + (classify-error (bit-eqv)) + program-error) + +(deftest bit-eqv.error.2 + (classify-error (bit-eqv #*000)) + program-error) + +(deftest bit-eqv.error.3 + (classify-error (bit-eqv #*000 #*0100 nil nil)) + program-error) + diff --git a/ansi-tests/bit-ior.lsp b/ansi-tests/bit-ior.lsp new file mode 100644 index 0000000..469c778 --- /dev/null +++ b/ansi-tests/bit-ior.lsp @@ -0,0 +1,244 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:13:34 2003 +;;;; Contains: Tests of BIT-IOR + +(in-package :cl-test) + +(deftest bit-ior.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-ior s1 s2) s1 s2)) + #0a0 + #0a0 + #0a0) + +(deftest bit-ior.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-ior s1 s2) s1 s2)) + #0a1 + #0a1 + #0a0) + +(deftest bit-ior.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-ior s1 s2) s1 s2)) + #0a1 + #0a0 + #0a1) + +(deftest bit-ior.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-ior s1 s2) s1 s2)) + #0a1 + #0a1 + #0a1) + +(deftest bit-ior.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-ior s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a0 + #0a0 + t) + +(deftest bit-ior.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-ior s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a1 + #0a1 + t) + +(deftest bit-ior.7 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-ior s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a1 + #0a1 + #0a1 + t) + + +;;; Tests on bit vectors + +(deftest bit-ior.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-ior a1 a2)) a1 a2)) + #*0111 #*0011 #*0101) + +(deftest bit-ior.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-ior a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*0111 #*0111 #*0101 t) + +(deftest bit-ior.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-ior a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*0111 #*0011 #*0101 #*0111 t) + +(deftest bit-ior.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-ior a1 a2 nil)) a1 a2)) + #*0111 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-ior.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-ior a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1))) + +(deftest bit-ior.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-ior a1 a2 t))) + (values a1 a2 result)) + #2a((0 1)(1 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1))) + +(deftest bit-ior.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-ior a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1))) + +(deftest bit-ior.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-ior a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1)) + #2a((0 1)(1 1))) + +;;; Adjustable arrays + +(deftest bit-ior.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-ior a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1))) + +;;; Displaced arrays + +(deftest bit-ior.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-ior a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1))) + +(deftest bit-ior.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-ior a1 a2 t))) + (values a0 a1 a2 result)) + #*01110011 + #2a((0 1)(1 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1))) + +(deftest bit-ior.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-ior a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100110111 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 1))) + +(deftest bit-ior.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-ior (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*0 2 1 2) + +;;; Error tests + +(deftest bit-ior.error.1 + (classify-error (bit-ior)) + program-error) + +(deftest bit-ior.error.2 + (classify-error (bit-ior #*000)) + program-error) + +(deftest bit-ior.error.3 + (classify-error (bit-ior #*000 #*0100 nil nil)) + program-error) + diff --git a/ansi-tests/bit-nand.lsp b/ansi-tests/bit-nand.lsp new file mode 100644 index 0000000..840e686 --- /dev/null +++ b/ansi-tests/bit-nand.lsp @@ -0,0 +1,244 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:16:15 2003 +;;;; Contains: Tests for BIT-NAND + +(in-package :cl-test) + +(deftest bit-nand.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-nand s1 s2) s1 s2)) + #0a1 + #0a0 + #0a0) + +(deftest bit-nand.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-nand s1 s2) s1 s2)) + #0a1 + #0a1 + #0a0) + +(deftest bit-nand.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-nand s1 s2) s1 s2)) + #0a1 + #0a0 + #0a1) + +(deftest bit-nand.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-nand s1 s2) s1 s2)) + #0a0 + #0a1 + #0a1) + +(deftest bit-nand.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-nand s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a1 + #0a1 + t) + +(deftest bit-nand.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-nand s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a0 + #0a0 + t) + +(deftest bit-nand.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-nand s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a1 + #0a0 + #0a1 + t) + + +;;; Tests on bit vectors + +(deftest bit-nand.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-nand a1 a2)) a1 a2)) + #*1110 #*0011 #*0101) + +(deftest bit-nand.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-nand a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*1110 #*1110 #*0101 t) + +(deftest bit-nand.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-nand a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*1110 #*0011 #*0101 #*1110 t) + +(deftest bit-nand.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-nand a1 a2 nil)) a1 a2)) + #*1110 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-nand.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-nand a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0))) + +(deftest bit-nand.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-nand a1 a2 t))) + (values a1 a2 result)) + #2a((1 1)(1 0)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0))) + +(deftest bit-nand.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-nand a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0))) + +(deftest bit-nand.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-nand a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0)) + #2a((1 1)(1 0))) + +;;; Adjustable arrays + +(deftest bit-nand.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-nand a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0))) + +;;; Displaced arrays + +(deftest bit-nand.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-nand a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0))) + +(deftest bit-nand.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-nand a1 a2 t))) + (values a0 a1 a2 result)) + #*11100011 + #2a((1 1)(1 0)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0))) + +(deftest bit-nand.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-nand a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100111110 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(1 0))) + +(deftest bit-nand.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-nand (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*1 2 1 2) + +;;; Error tests + +(deftest bit-nand.error.1 + (classify-error (bit-nand)) + program-error) + +(deftest bit-nand.error.2 + (classify-error (bit-nand #*000)) + program-error) + +(deftest bit-nand.error.3 + (classify-error (bit-nand #*000 #*0100 nil nil)) + program-error) + diff --git a/ansi-tests/bit-nor.lsp b/ansi-tests/bit-nor.lsp new file mode 100644 index 0000000..36031ef --- /dev/null +++ b/ansi-tests/bit-nor.lsp @@ -0,0 +1,244 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:20:40 2003 +;;;; Contains: Tests for BIT-NOR + +(in-package :cl-test) + +(deftest bit-nor.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-nor s1 s2) s1 s2)) + #0a1 + #0a0 + #0a0) + +(deftest bit-nor.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-nor s1 s2) s1 s2)) + #0a0 + #0a1 + #0a0) + +(deftest bit-nor.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-nor s1 s2) s1 s2)) + #0a0 + #0a0 + #0a1) + +(deftest bit-nor.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-nor s1 s2) s1 s2)) + #0a0 + #0a1 + #0a1) + +(deftest bit-nor.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-nor s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a1 + #0a1 + t) + +(deftest bit-nor.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-nor s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a0 + #0a0 + t) + +(deftest bit-nor.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-nor s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a0 + #0a0 + #0a0 + t) + + +;;; Tests on bit vectors + +(deftest bit-nor.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-nor a1 a2)) a1 a2)) + #*1000 #*0011 #*0101) + +(deftest bit-nor.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-nor a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*1000 #*1000 #*0101 t) + +(deftest bit-nor.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-nor a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*1000 #*0011 #*0101 #*1000 t) + +(deftest bit-nor.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-nor a1 a2 nil)) a1 a2)) + #*1000 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-nor.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-nor a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0))) + +(deftest bit-nor.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-nor a1 a2 t))) + (values a1 a2 result)) + #2a((1 0)(0 0)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0))) + +(deftest bit-nor.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-nor a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0))) + +(deftest bit-nor.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-nor a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0)) + #2a((1 0)(0 0))) + +;;; Adjustable arrays + +(deftest bit-nor.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-nor a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0))) + +;;; Displaced arrays + +(deftest bit-nor.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-nor a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0))) + +(deftest bit-nor.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-nor a1 a2 t))) + (values a0 a1 a2 result)) + #*10000011 + #2a((1 0)(0 0)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0))) + +(deftest bit-nor.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-nor a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100111000 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(0 0))) + +(deftest bit-nor.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-nor (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*1 2 1 2) + +;;; Error tests + +(deftest bit-nor.error.1 + (classify-error (bit-nor)) + program-error) + +(deftest bit-nor.error.2 + (classify-error (bit-nor #*000)) + program-error) + +(deftest bit-nor.error.3 + (classify-error (bit-nor #*000 #*0100 nil nil)) + program-error) + diff --git a/ansi-tests/bit-not.lsp b/ansi-tests/bit-not.lsp new file mode 100644 index 0000000..550dce3 --- /dev/null +++ b/ansi-tests/bit-not.lsp @@ -0,0 +1,139 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:40:13 2003 +;;;; Contains: Tests of BIT-NOT + +(in-package :cl-test) + +(deftest bit-not.1 + (let ((a1 (make-array nil :element-type 'bit :initial-element 0))) + (values (bit-not a1) a1)) + #0a1 #0a0) + +(deftest bit-not.2 + (let ((a1 (make-array nil :element-type 'bit :initial-element 1))) + (values (bit-not a1) a1)) + #0a0 #0a1) + +(deftest bit-not.3 + (let ((a1 (make-array nil :element-type 'bit :initial-element 0))) + (values (bit-not a1 t) a1)) + #0a1 #0a1) + +(deftest bit-not.4 + (let ((a1 (make-array nil :element-type 'bit :initial-element 1))) + (values (bit-not a1 t) a1)) + #0a0 #0a0) + +(deftest bit-not.5 + (let* ((a1 (make-array nil :element-type 'bit :initial-element 1)) + (a2 (make-array nil :element-type 'bit :initial-element 1)) + (result (bit-not a1 a2))) + (values a1 a2 (eqt a2 result))) + #0a1 #0a0 t) + +(deftest bit-not.6 + (let ((a1 (make-array nil :element-type 'bit :initial-element 0))) + (values (bit-not a1 nil) a1)) + #0a1 #0a0) + +;;; Tests on bit vectors + +(deftest bit-not.7 + (let ((a1 (copy-seq #*0011010110))) + (values (bit-not a1) a1)) + #*1100101001 + #*0011010110) + +(deftest bit-not.8 + (let ((a1 (copy-seq #*0011010110))) + (values (bit-not a1 t) a1)) + #*1100101001 + #*1100101001) + +(deftest bit-not.9 + (let ((a1 (copy-seq #*0011010110)) + (a2 (copy-seq #*0000000000))) + (values (bit-not a1 a2) a1 a2)) + #*1100101001 + #*0011010110 + #*1100101001) + +;;; Arrays + +(deftest bit-not.10 + (let ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(1 0))))) + (values (bit-not a1) a1)) + #2a((1 0)(0 1)) + #2a((0 1)(1 0))) + +(deftest bit-not.11 + (let ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(1 0))))) + (values (bit-not a1 nil) a1)) + #2a((1 0)(0 1)) + #2a((0 1)(1 0))) + +(deftest bit-not.12 + (let ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(1 0))))) + (values (bit-not a1 t) a1)) + #2a((1 0)(0 1)) + #2a((1 0)(0 1))) + +(deftest bit-not.13 + (let ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(1 0)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-element 0))) + (values (bit-not a1 a2) a1 a2)) + #2a((1 0)(0 1)) + #2a((0 1)(1 0)) + #2a((1 0)(0 1))) + +;;; Adjustable array + +(deftest bit-not.14 + (let ((a1 (make-array '(2 2) :element-type 'bit + :adjustable t + :initial-contents '((0 1)(1 0))))) + (values (bit-not a1) a1)) + #2a((1 0)(0 1)) + #2a((0 1)(1 0))) + +;;; Displaced arrays + +(deftest bit-not.15 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 0 0 1 1 0 0 0 0 0 0 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 2)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 6))) + (values (bit-not a1 a2) a0 a1 a2)) + #2a((1 0)(0 1)) + #*000110100100 + #2a((0 1)(1 0)) + #2a((1 0)(0 1))) + +(deftest bit-not.order.1 + (let ((a (copy-seq #*001101)) + (i 0) x) + (values + (bit-not (progn (setf x (incf i)) a)) + i x)) + #*110010 1 1) + +;;; Error tests + +(deftest bit-not.error.1 + (classify-error (bit-not)) + program-error) + +(deftest bit-not.error.2 + (classify-error (bit-not #*000 nil nil)) + program-error) + diff --git a/ansi-tests/bit-orc1.lsp b/ansi-tests/bit-orc1.lsp new file mode 100644 index 0000000..96467f9 --- /dev/null +++ b/ansi-tests/bit-orc1.lsp @@ -0,0 +1,244 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:25:28 2003 +;;;; Contains: Tests of BIT-ORC1 + +(in-package :cl-test) + +(deftest bit-orc1.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-orc1 s1 s2) s1 s2)) + #0a1 + #0a0 + #0a0) + +(deftest bit-orc1.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-orc1 s1 s2) s1 s2)) + #0a0 + #0a1 + #0a0) + +(deftest bit-orc1.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-orc1 s1 s2) s1 s2)) + #0a1 + #0a0 + #0a1) + +(deftest bit-orc1.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-orc1 s1 s2) s1 s2)) + #0a1 + #0a1 + #0a1) + +(deftest bit-orc1.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-orc1 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a1 + #0a1 + t) + +(deftest bit-orc1.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-orc1 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a1 + #0a1 + t) + +(deftest bit-orc1.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-orc1 s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a0 + #0a0 + #0a0 + t) + + +;;; Tests on bit vectors + +(deftest bit-orc1.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-orc1 a1 a2)) a1 a2)) + #*1101 #*0011 #*0101) + +(deftest bit-orc1.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-orc1 a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*1101 #*1101 #*0101 t) + +(deftest bit-orc1.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-orc1 a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*1101 #*0011 #*0101 #*1101 t) + +(deftest bit-orc1.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-orc1 a1 a2 nil)) a1 a2)) + #*1101 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-orc1.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-orc1 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1))) + +(deftest bit-orc1.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-orc1 a1 a2 t))) + (values a1 a2 result)) + #2a((1 0)(1 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1))) + +(deftest bit-orc1.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-orc1 a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1))) + +(deftest bit-orc1.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-orc1 a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1)) + #2a((1 0)(1 1))) + +;;; Adjustable arrays + +(deftest bit-orc1.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-orc1 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1))) + +;;; Displaced arrays + +(deftest bit-orc1.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-orc1 a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1))) + +(deftest bit-orc1.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-orc1 a1 a2 t))) + (values a0 a1 a2 result)) + #*10110011 + #2a((1 0)(1 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1))) + +(deftest bit-orc1.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-orc1 a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100111011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 0)(1 1))) + +(deftest bit-orc1.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-orc1 (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*1 2 1 2) + +;;; Error tests + +(deftest bit-orc1.error.1 + (classify-error (bit-orc1)) + program-error) + +(deftest bit-orc1.error.2 + (classify-error (bit-orc1 #*000)) + program-error) + +(deftest bit-orc1.error.3 + (classify-error (bit-orc1 #*000 #*0100 nil nil)) + program-error) + diff --git a/ansi-tests/bit-orc2.lsp b/ansi-tests/bit-orc2.lsp new file mode 100644 index 0000000..1f7af72 --- /dev/null +++ b/ansi-tests/bit-orc2.lsp @@ -0,0 +1,245 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:31:35 2003 +;;;; Contains: Tests of BIT-ORC2 + +(in-package :cl-test) + +(deftest bit-orc2.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-orc2 s1 s2) s1 s2)) + #0a1 + #0a0 + #0a0) + +(deftest bit-orc2.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-orc2 s1 s2) s1 s2)) + #0a1 + #0a1 + #0a0) + +(deftest bit-orc2.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-orc2 s1 s2) s1 s2)) + #0a0 + #0a0 + #0a1) + +(deftest bit-orc2.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-orc2 s1 s2) s1 s2)) + #0a1 + #0a1 + #0a1) + +(deftest bit-orc2.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-orc2 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a1 + #0a1 + t) + +(deftest bit-orc2.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-orc2 s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a1 + #0a1 + t) + +(deftest bit-orc2.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-orc2 s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a1 + #0a0 + #0a1 + t) + + +;;; Tests on bit vectors + +(deftest bit-orc2.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-orc2 a1 a2)) a1 a2)) + #*1011 #*0011 #*0101) + +(deftest bit-orc2.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-orc2 a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*1011 #*1011 #*0101 t) + +(deftest bit-orc2.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-orc2 a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*1011 #*0011 #*0101 #*1011 t) + +(deftest bit-orc2.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-orc2 a1 a2 nil)) a1 a2)) + #*1011 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-orc2.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-orc2 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1))) + +(deftest bit-orc2.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-orc2 a1 a2 t))) + (values a1 a2 result)) + #2a((1 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1))) + +(deftest bit-orc2.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-orc2 a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1))) + +(deftest bit-orc2.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-orc2 a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1)) + #2a((1 1)(0 1))) + +;;; Adjustable arrays + +(deftest bit-orc2.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-orc2 a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1))) + +;;; Displaced arrays + +(deftest bit-orc2.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-orc2 a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1))) + +(deftest bit-orc2.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-orc2 a1 a2 t))) + (values a0 a1 a2 result)) + #*11010011 + #2a((1 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1))) + +(deftest bit-orc2.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-orc2 a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100111101 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((1 1)(0 1))) + +(deftest bit-orc2.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-orc2 (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*1 2 1 2) + +;;; Error tests + +(deftest bit-orc2.error.1 + (classify-error (bit-orc2)) + program-error) + +(deftest bit-orc2.error.2 + (classify-error (bit-orc2 #*000)) + program-error) + +(deftest bit-orc2.error.3 + (classify-error (bit-orc2 #*000 #*0100 nil nil)) + program-error) + + diff --git a/ansi-tests/bit-vector-p.lsp b/ansi-tests/bit-vector-p.lsp new file mode 100644 index 0000000..93ebbd2 --- /dev/null +++ b/ansi-tests/bit-vector-p.lsp @@ -0,0 +1,79 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 20:16:50 2003 +;;;; Contains: Tests of BIT-VECTOR-P + +(in-package :cl-test) + +(deftest bit-vector-p.2 + (notnot-mv (bit-vector-p #*)) + t) + +(deftest bit-vector-p.3 + (notnot-mv (bit-vector-p #*00101)) + t) + +(deftest bit-vector-p.4 + (bit-vector-p #(0 1 1 1 0 0)) + nil) + +(deftest bit-vector-p.5 + (bit-vector-p "011100") + nil) + +(deftest bit-vector-p.6 + (bit-vector-p 0) + nil) + +(deftest bit-vector-p.7 + (bit-vector-p 1) + nil) + +(deftest bit-vector-p.8 + (bit-vector-p nil) + nil) + +(deftest bit-vector-p.9 + (bit-vector-p 'x) + nil) + +(deftest bit-vector-p.10 + (bit-vector-p '(0 1 1 0)) + nil) + +(deftest bit-vector-p.11 + (bit-vector-p (make-array '(2 2) :element-type 'bit + :initial-element 0)) + nil) + +(deftest bit-vector-p.12 + (loop for e in *universe* + for p1 = (typep e 'bit-vector) + for p2 = (bit-vector-p e) + always (if p1 p2 (not p2))) + t) + +(deftest bit-vector-p.order.1 + (let ((i 0) x) + (values + (notnot (bit-vector-p (progn (setf x (incf i)) #*0010))) + i x)) + t 1 1) + +(deftest bit-vector-p.order.2 + (let ((i 0) x) + (values + (bit-vector-p (progn (setf x (incf i)) 'a)) + i x)) + nil 1 1) + + + + +(deftest bit-vector-p.error.1 + (classify-error (bit-vector-p)) + program-error) + +(deftest bit-vector-p.error.2 + (classify-error (bit-vector-p #* #*)) + program-error) diff --git a/ansi-tests/bit-vector.lsp b/ansi-tests/bit-vector.lsp new file mode 100644 index 0000000..9acce28 --- /dev/null +++ b/ansi-tests/bit-vector.lsp @@ -0,0 +1,121 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 13:03:22 2003 +;;;; Contains: Tests of type BIT-VECTOR + +(in-package :cl-test) + +(deftest bit-vector.1 + (notnot-mv (find-class 'bit-vector)) + t) + +(deftest bit-vector.2 + (notnot-mv (typep #* 'bit-vector)) + t) + +(deftest bit-vector.3 + (notnot-mv (typep #*00101 'bit-vector)) + t) + +(deftest bit-vector.4 + (typep #(0 1 1 1 0 0) 'bit-vector) + nil) + +(deftest bit-vector.5 + (typep "011100" 'bit-vector) + nil) + +(deftest bit-vector.6 + (typep 0 'bit-vector) + nil) + +(deftest bit-vector.7 + (typep 1 'bit-vector) + nil) + +(deftest bit-vector.8 + (typep nil 'bit-vector) + nil) + +(deftest bit-vector.9 + (typep 'x 'bit-vector) + nil) + +(deftest bit-vector.10 + (typep '(0 1 1 0) 'bit-vector) + nil) + +(deftest bit-vector.11 + (typep (make-array '(2 2) :element-type 'bit + :initial-element 0) + 'bit-vector) + nil) + +(deftest bit-vector.12 + (notnot-mv (typep #* '(bit-vector *))) + t) + +(deftest bit-vector.13 + (notnot-mv (typep #*01101 '(bit-vector *))) + t) + +(deftest bit-vector.14 + (notnot-mv (typep #* '(bit-vector 0))) + t) + +(deftest bit-vector.15 + (typep #*01101 '(bit-vector 0)) + nil) + +(deftest bit-vector.16 + (typep #* '(bit-vector 5)) + nil) + +(deftest bit-vector.17 + (notnot-mv (typep #*01101 '(bit-vector 5))) + t) + + +;;; Tests of typep on the class named bit-vector + +(deftest bit-vector.class.2 + (notnot-mv (typep #* (find-class 'bit-vector))) + t) + +(deftest bit-vector.class.3 + (notnot-mv (typep #*00101 (find-class 'bit-vector))) + t) + +(deftest bit-vector.class.4 + (typep #(0 1 1 1 0 0) (find-class 'bit-vector)) + nil) + +(deftest bit-vector.class.5 + (typep "011100" (find-class 'bit-vector)) + nil) + +(deftest bit-vector.class.6 + (typep 0 (find-class 'bit-vector)) + nil) + +(deftest bit-vector.class.7 + (typep 1 (find-class 'bit-vector)) + nil) + +(deftest bit-vector.class.8 + (typep nil (find-class 'bit-vector)) + nil) + +(deftest bit-vector.class.9 + (typep 'x (find-class 'bit-vector)) + nil) + +(deftest bit-vector.class.10 + (typep '(0 1 1 0) (find-class 'bit-vector)) + nil) + +(deftest bit-vector.class.11 + (typep (make-array '(2 2) :element-type 'bit + :initial-element 0) + (find-class 'bit-vector)) + nil) diff --git a/ansi-tests/bit-xor.lsp b/ansi-tests/bit-xor.lsp new file mode 100644 index 0000000..a2b58dd --- /dev/null +++ b/ansi-tests/bit-xor.lsp @@ -0,0 +1,244 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 19:35:46 2003 +;;;; Contains: Tests of BIT-XOR + +(in-package :cl-test) + +(deftest bit-xor.1 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-xor s1 s2) s1 s2)) + #0a0 + #0a0 + #0a0) + +(deftest bit-xor.2 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit))) + (values (bit-xor s1 s2) s1 s2)) + #0a1 + #0a1 + #0a0) + +(deftest bit-xor.3 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-xor s1 s2) s1 s2)) + #0a1 + #0a0 + #0a1) + +(deftest bit-xor.4 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit))) + (values (bit-xor s1 s2) s1 s2)) + #0a0 + #0a1 + #0a1) + +(deftest bit-xor.5 + (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-xor s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a0 + #0a0 + #0a0 + #0a0 + t) + +(deftest bit-xor.6 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 1 :element-type 'bit)) + (s3 (make-array nil :initial-element 1 :element-type 'bit)) + (result (bit-xor s1 s2 s3))) + (values s1 s2 s3 result (eqt s3 result))) + #0a1 + #0a1 + #0a0 + #0a0 + t) + +(deftest bit-xor.7 + (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit)) + (s2 (make-array nil :initial-element 0 :element-type 'bit)) + (result (bit-xor s1 s2 t))) + (values s1 s2 result (eqt s1 result))) + #0a1 + #0a0 + #0a1 + t) + + +;;; Tests on bit vectors + +(deftest bit-xor.8 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-xor a1 a2)) a1 a2)) + #*0110 #*0011 #*0101) + +(deftest bit-xor.9 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (result (check-values (bit-xor a1 a2 t)))) + (values result a1 a2 (eqt result a1))) + #*0110 #*0110 #*0101 t) + +(deftest bit-xor.10 + (let* ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101)) + (a3 (copy-seq #*1110)) + (result (check-values (bit-xor a1 a2 a3)))) + (values result a1 a2 a3 (eqt result a3))) + #*0110 #*0011 #*0101 #*0110 t) + +(deftest bit-xor.11 + (let ((a1 (copy-seq #*0011)) + (a2 (copy-seq #*0101))) + (values (check-values (bit-xor a1 a2 nil)) a1 a2)) + #*0110 #*0011 #*0101) + +;;; Tests on bit arrays + +(deftest bit-xor.12 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-xor a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0))) + +(deftest bit-xor.13 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-xor a1 a2 t))) + (values a1 a2 result)) + #2a((0 1)(1 0)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0))) + +(deftest bit-xor.14 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (result (bit-xor a1 a2 nil))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0))) + +(deftest bit-xor.15 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)))) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)))) + (a3 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(0 0)))) + (result (bit-xor a1 a2 a3))) + (values a1 a2 a3 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0)) + #2a((0 1)(1 0))) + +;;; Adjustable arrays + +(deftest bit-xor.16 + (let* ((a1 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 1)(0 1)) + :adjustable t)) + (a2 (make-array '(2 2) :element-type 'bit + :initial-contents '((0 0)(1 1)) + :adjustable t)) + (result (bit-xor a1 a2))) + (values a1 a2 result)) + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0))) + +;;; Displaced arrays + +(deftest bit-xor.17 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-xor a1 a2))) + (values a0 a1 a2 result)) + #*01010011 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0))) + +(deftest bit-xor.18 + (let* ((a0 (make-array '(8) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (result (bit-xor a1 a2 t))) + (values a0 a1 a2 result)) + #*01100011 + #2a((0 1)(1 0)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0))) + +(deftest bit-xor.19 + (let* ((a0 (make-array '(12) :element-type 'bit + :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0))) + (a1 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 0)) + (a2 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 4)) + (a3 (make-array '(2 2) :element-type 'bit + :displaced-to a0 + :displaced-index-offset 8)) + (result (bit-xor a1 a2 a3))) + (values a0 a1 a2 result)) + #*010100110110 + #2a((0 1)(0 1)) + #2a((0 0)(1 1)) + #2a((0 1)(1 0))) + +(deftest bit-xor.order.1 + (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) + (s2 (make-array 1 :initial-element 0 :element-type 'bit)) + (x 0) y z) + (values + (bit-xor (progn (setf y (incf x)) s1) + (progn (setf z (incf x)) s2)) + x y z)) + #*0 2 1 2) + +;;; Error tests + +(deftest bit-xor.error.1 + (classify-error (bit-xor)) + program-error) + +(deftest bit-xor.error.2 + (classify-error (bit-xor #*000)) + program-error) + +(deftest bit-xor.error.3 + (classify-error (bit-xor #*000 #*0100 nil nil)) + program-error) + diff --git a/ansi-tests/bit.lsp b/ansi-tests/bit.lsp new file mode 100644 index 0000000..70b807c --- /dev/null +++ b/ansi-tests/bit.lsp @@ -0,0 +1,136 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 13:22:59 2003 +;;;; Contains: Tests for accessor BIT + +(in-package :cl-test) + +(deftest bit.1 + (bit #*0010 2) + 1) + +(deftest bit.2 + (let ((a #*00000000)) + (loop for i from 0 below (length a) + collect (let ((b (copy-seq a))) + (setf (bit b i) 1) + b))) + (#*10000000 + #*01000000 + #*00100000 + #*00010000 + #*00001000 + #*00000100 + #*00000010 + #*00000001)) + +(deftest bit.3 + (let ((a #*11111111)) + (loop for i from 0 below (length a) + collect (let ((b (copy-seq a))) + (setf (bit b i) 0) + b))) + (#*01111111 + #*10111111 + #*11011111 + #*11101111 + #*11110111 + #*11111011 + #*11111101 + #*11111110)) + +(deftest bit.4 + (let ((a (make-array nil :element-type 'bit :initial-element 0))) + (values + (aref a) + (bit a) + (setf (bit a) 1) + (aref a) + (bit a))) + 0 0 1 1 1) + +(deftest bit.5 + (let ((a (make-array '(1 1) :element-type 'bit :initial-element 0))) + (values + (aref a 0 0) + (bit a 0 0) + (setf (bit a 0 0) 1) + (aref a 0 0) + (bit a 0 0))) + 0 0 1 1 1) + +(deftest bit.6 + (let ((a (make-array '(10 10) :element-type 'bit :initial-element 0))) + (values + (aref a 5 5) + (bit a 5 5) + (setf (bit a 5 5) 1) + (aref a 5 5) + (bit a 5 5))) + 0 0 1 1 1) + +;;; Check that the fill pointer is ignored + +(deftest bit.7 + (let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 1 1 1 0 0) + :element-type 'bit + :fill-pointer 5))) + (values + (coerce a 'list) + (loop for i from 0 below 10 collect (bit a i)) + (loop for i from 0 below 10 + collect (setf (bit a i) (- 1 (bit a i)))) + (coerce a 'list) + (loop for i from 0 below 10 collect (bit a i)) + (fill-pointer a))) + (0 1 1 0 0) + (0 1 1 0 0 1 1 1 0 0) + (1 0 0 1 1 0 0 0 1 1) + (1 0 0 1 1) + (1 0 0 1 1 0 0 0 1 1) + 5) + +;;; Check that adjustability is not relevant + +(deftest bit.8 + (let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 1 1 1 0 0) + :element-type 'bit + :adjustable t))) + (values + (coerce a 'list) + (loop for i from 0 below 10 collect (bit a i)) + (loop for i from 0 below 10 + collect (setf (bit a i) (- 1 (bit a i)))) + (coerce a 'list) + (loop for i from 0 below 10 collect (bit a i)))) + (0 1 1 0 0 1 1 1 0 0) + (0 1 1 0 0 1 1 1 0 0) + (1 0 0 1 1 0 0 0 1 1) + (1 0 0 1 1 0 0 0 1 1) + (1 0 0 1 1 0 0 0 1 1)) + +;;; Order of evaluation tests + +(deftest bit.order.1 + (let ((x 0) y z + (b (copy-seq #*01010))) + (values + (bit (progn (setf y (incf x)) b) + (progn (setf z (incf x)) 1)) + x y z)) + 1 2 1 2) + +(deftest bit.order.2 + (let ((x 0) y z w + (b (copy-seq #*01010))) + (values + (setf (bit (progn (setf y (incf x)) b) + (progn (setf z (incf x)) 1)) + (progn (setf w (incf x)) 0)) + b + x y z w)) + 0 #*00010 3 1 2 3) + +(deftest bit.error.1 + (classify-error (bit)) + program-error) diff --git a/ansi-tests/block.lsp b/ansi-tests/block.lsp new file mode 100644 index 0000000..b68d9df --- /dev/null +++ b/ansi-tests/block.lsp @@ -0,0 +1,73 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 12:30:46 2002 +;;;; Contains: Tests of BLOCK + +(in-package :cl-test) + +(deftest block.1 + (block foo + (return-from foo 1)) + 1) + +(deftest block.2 + (block nil + (block foo + (return 'good)) + 'bad) + good) + +(deftest block.3 + (block done + (flet ((%f (x) (return-from done x))) + (%f 'good)) + 'bad) + good) + +(deftest block.4 + (block foo + (block foo + (return-from foo 'bad)) + 'good) + good) + +(deftest block.5 + (block done + (flet ((%f (x) (return-from done x))) + (mapcar #'%f '(good bad bad))) + 'bad) + good) + +(deftest block.6 + (block b1 + (return-from b1 (values)) + 1)) + +(deftest block.7 + (block b1 + (return-from b1 (values 1 2 3 4)) + 1) + 1 2 3 4) + +(deftest block.8 + (block foo) + nil) + +(deftest block.9 + (block foo (values 'a 'b) (values 'c 'd)) + c d) + +(deftest block.10 + (block done + (flet ((%f (x) (return-from done x))) + (block done (mapcar #'%f '(good bad bad)))) + 'bad) + good) + +#| +(deftest return.error.1 + (classify-error + (block nil + (return 'a 'b))) + program-error) +|# diff --git a/ansi-tests/boundp.lsp b/ansi-tests/boundp.lsp new file mode 100644 index 0000000..b0385ff --- /dev/null +++ b/ansi-tests/boundp.lsp @@ -0,0 +1,56 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 14 05:58:01 2003 +;;;; Contains: Tests for BOUNDP + +(in-package :cl-test) + +(deftest boundp.error.1 + (classify-error (boundp)) + program-error) + +(deftest boundp.error.2 + (classify-error (boundp 'a 'a)) + program-error) + +(deftest boundp.error.3 + (classify-error (boundp 1)) + type-error) + +(deftest boundp.error.4 + (classify-error (boundp '(setf car))) + type-error) + +(deftest boundp.error.5 + (classify-error (boundp "abc")) + type-error) + +(deftest boundp.error.6 + (classify-error (locally (boundp "abc") t)) + type-error) + +;;; See other tests in cl-symbols.lsp + +(deftest boundp.1 + (notnot-mv (boundp 't)) + t) + +(deftest boundp.2 + (notnot-mv (boundp nil)) + t) + +(deftest boundp.3 + (notnot-mv (boundp :foo)) + t) + +(deftest boundp.4 + (boundp '#:foo) + nil) + +(deftest boundp.order.1 + (let ((i 0) x) + (values + (boundp (progn (setf x (incf i)) '#:foo)) + i x)) + nil 1 1) + diff --git a/ansi-tests/broadcast-stream-streams.lsp b/ansi-tests/broadcast-stream-streams.lsp new file mode 100644 index 0000000..f0aef32 --- /dev/null +++ b/ansi-tests/broadcast-stream-streams.lsp @@ -0,0 +1,30 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 29 22:06:28 2004 +;;;; Contains: Tests of BROADCAST-STREAM-STREAMS + +(in-package :cl-test) + +(deftest broadcast-stream-streams.1 + (broadcast-stream-streams (make-broadcast-stream)) + nil) + +(deftest broadcast-stream-streams.2 + (equalt + (broadcast-stream-streams (make-broadcast-stream *standard-output*)) + (list *standard-output*)) + t) + +(deftest broadcast-stream-streams.error.1 + (signals-error (broadcast-stream-streams) program-error) + t) + +(deftest broadcast-stream-streams.error.2 + (signals-error (broadcast-stream-streams (make-broadcast-stream) nil) + program-error) + t) + + + + + diff --git a/ansi-tests/call-arguments-limit.lsp b/ansi-tests/call-arguments-limit.lsp new file mode 100644 index 0000000..60e3363 --- /dev/null +++ b/ansi-tests/call-arguments-limit.lsp @@ -0,0 +1,29 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 10 22:39:25 2002 +;;;; Contains: Tests for CALL-ARGUMENTS-LIMIT + +(in-package :cl-test) + +(deftest call-arguments-limit.1 + (notnot-mv (constantp 'call-arguments-limit)) + t) + +(deftest call-arguments-limit.2 + (notnot-mv (typep call-arguments-limit 'integer)) + t) + +(deftest call-arguments-limit.3 + (< call-arguments-limit 50) + nil) + +(deftest call-arguments-limit.4 + (let* ((m (min 65536 (1- call-arguments-limit))) + (args (make-list m :initial-element 'a))) + (equal (apply #'list args) args)) + t) + +(deftest call-arguments-limit.5 + (< call-arguments-limit lambda-parameters-limit) + nil) + diff --git a/ansi-tests/case.lsp b/ansi-tests/case.lsp new file mode 100644 index 0000000..3118ccc --- /dev/null +++ b/ansi-tests/case.lsp @@ -0,0 +1,171 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 19:56:44 2002 +;;;; Contains: Tests of CASE + +(in-package :cl-test) + +(deftest case.1 + (case 'a) + nil) + +(deftest case.2 + (case 10 (10 'a)) + a) + +(deftest case.3 + (case (copy-seq "abc") ("abc" 'a)) + nil) + +(deftest case.4 + (case 'z ((a b c) 1) + ((d e) 2) + ((f z g) 3) + (t 4)) + 3) + +(deftest case.5 + (case (1+ most-positive-fixnum) + (#.(1+ most-positive-fixnum) 'a)) + a) + +(deftest case.6 + (case nil (nil 'a) (t 'b)) + b) + +(deftest case.7 + (case nil ((nil) 'a) (t 'b)) + a) + +(deftest case.8 + (case 'a (b 0) (a (values 1 2 3)) (t nil)) + 1 2 3) + +(deftest case.9 + (case 'c (b 0) (a (values 1 2 3)) (t (values 'x 'y 'z))) + x y z) + +(deftest case.10 + (case 'z (b 1) (a 2) (z (values)) (t nil))) + +(deftest case.11 + (case 'z (b 1) (a 2) (t (values)))) + +(deftest case.12 + (case t (a 10)) + nil) + +(deftest case.13 + (case t ((t) 10) (t 20)) + 10) + +(deftest case.14 + (let ((x (list 'a 'b))) + (eval `(case (quote ,x) ((,x) 1) (t 2)))) + 1) + +(deftest case.15 + (case 'otherwise ((t) 10)) + nil) + +(deftest case.16 + (case t ((otherwise) 10)) + nil) + +(deftest case.17 + (case 'a (b 0) (c 1) (otherwise 2)) + 2) + +(deftest case.18 + (case 'a (b 0) (c 1) ((otherwise) 2)) + nil) + +(deftest case.19 + (case 'a (b 0) (c 1) ((t) 2)) + nil) + +(deftest case.20 + (case #\a + ((#\b #\c) 10) + ((#\d #\e #\A) 20) + (() 30) + ((#\z #\a #\y) 40)) + 40) + +(deftest case.21 (case 1 (1 (values)))) + +(deftest case.22 (case 2 (t (values)))) + +(deftest case.23 (case 1 (1 (values 'a 'b 'c))) + a b c) + +(deftest case.24 (case 2 (t (values 'a 'b 'c))) + a b c) + +;;; Show that the key expression is evaluated only once. +(deftest case.25 + (let ((x 0)) + (values + (case (progn (incf x) 'c) + (a 1) + (b 2) + (c 3) + (t 4)) + x)) + 3 1) + +;;; Repeated keys are allowed (all but the first are ignored) + +(deftest case.26 + (case 'b ((a b c) 10) (b 20)) + 10) + +(deftest case.27 + (case 'b (b 20) ((a b c) 10)) + 20) + +(deftest case.28 + (case 'b (b 20) (b 10) (t 0)) + 20) + +;;; There are implicit progns + +(deftest case.29 + (let ((x nil)) + (values + (case 2 + (1 (setq x 'a) 'w) + (2 (setq x 'b) 'y) + (t (setq x 'c) 'z)) + x)) + y b) + +(deftest case.30 + (let ((x nil)) + (values + (case 10 + (1 (setq x 'a) 'w) + (2 (setq x 'b) 'y) + (t (setq x 'c) 'z)) + x)) + z c) + +(deftest case.31 + (case (values 'b 'c) (c 0) ((a b) 10) (t 20)) + 10) + +(deftest case.32 + (case 'a (a) (t 'b)) + nil) + +(deftest case.33 + (case 'a (b 'b) (t)) + nil) + +(deftest case.34 + (case 'a (b 'b) (otherwise)) + nil) + +;;; (deftest case.error.1 +;;; (classify-error (case)) +;;; program-error) diff --git a/ansi-tests/catch.lsp b/ansi-tests/catch.lsp new file mode 100644 index 0000000..5a3732e --- /dev/null +++ b/ansi-tests/catch.lsp @@ -0,0 +1,75 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 13:04:02 2002 +;;;; Contains: Tests of CATCH and THROW + +(in-package :cl-test) + +(deftest catch.1 + (catch 'foo) + nil) + +(deftest catch.2 + (catch 'foo 'a) + a) + +(deftest catch.3 + (catch 'foo (values))) + +(deftest catch.4 + (catch 'foo (values 1 2 3)) + 1 2 3) + +(deftest catch.5 + (catch 'foo 'a (throw 'foo 'b) 'c) + b) + +(deftest catch.6 + (let ((tag1 (1+ most-positive-fixnum)) + (tag2 (1+ most-positive-fixnum))) + (if (eqt tag1 tag2) + 'good + (catch tag1 + (catch tag2 (throw tag1 'good)) + 'bad))) + good) + +(deftest catch.7 + (catch 'foo 'a (throw 'foo (values)) 'c)) + +(deftest catch.8 + (catch 'foo 'a (throw 'foo (values 1 2 3)) 'c) + 1 2 3) + +(deftest catch.9 + (let ((i 0)) + (catch (progn (incf i) 'foo) + (assert (eql i 1)) + (throw (progn (incf i 2) 'foo) i))) + 3) + +(deftest catch.10 + (flet ((%f (x) (throw 'foo x))) + (catch 'foo + (%f 'good) + 'bad)) + good) + +(defun catch.11-fn (x) (throw 'foo x)) + +(deftest catch.11 + (catch 'foo + (catch.11-fn 'good) + 'bad) + good) + +(deftest catch.12 + (labels ((%f (x) (throw 'foo x))) + (catch 'foo + (%f 'good) + 'bad)) + good) + +(deftest throw-error + (classify-error (throw (gensym) nil)) + control-error) diff --git a/ansi-tests/ccase.lsp b/ansi-tests/ccase.lsp new file mode 100644 index 0000000..8bbc445 --- /dev/null +++ b/ansi-tests/ccase.lsp @@ -0,0 +1,189 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 21:06:45 2002 +;;;; Contains: Tests of CCASE + +(in-package :cl-test) + +(deftest ccase.1 + (let ((x 'b)) + (ccase x (a 1) (b 2) (c 3))) + 2) + +(deftest ccase.2 + (classify-error + (let ((x 1)) (ccase x))) + type-error) + +(deftest ccase.3 + (classify-error + (let ((x 1)) + (ccase x (a 1) (b 2) (c 3)))) + type-error) + +;;; It is legal to use T or OTHERWISE as key designators +;;; in CCASE forms. They have no special meaning here. + +(deftest ccase.4 + (classify-error + (let ((x 1)) + (ccase x (t nil)))) + type-error) + +(deftest ccase.5 + (classify-error + (let ((x 1)) + (ccase x (otherwise nil)))) + type-error) + +(deftest ccase.6 + (let ((x 'b)) + (ccase x ((a z) 1) ((y b w) 2) ((b c) 3))) + 2) + +(deftest ccase.7 + (let ((x 'z)) + (ccase x + ((a b c) 1) + ((d e) 2) + ((f z g) 3))) + 3) + +(deftest ccase.8 + (let ((x (1+ most-positive-fixnum))) + (ccase x (#.(1+ most-positive-fixnum) 'a))) + a) + +(deftest ccase.9 + (classify-error + (let (x) + (ccase x (nil 'a)))) + type-error) + +(deftest ccase.10 + (let (x) + (ccase x ((nil) 'a))) + a) + +(deftest ccase.11 + (let ((x 'a)) + (ccase x (b 0) (a (values 1 2 3)) (c nil))) + 1 2 3) + +(deftest ccase.12 + (classify-error + (let ((x t)) + (ccase x (a 10)))) + type-error) + +(deftest ccase.13 + (let ((x t)) + (ccase x ((t) 10) (t 20))) + 10) + +(deftest ccase.14 + (let ((x (list 'a 'b))) + (eval `(let ((y (quote ,x))) (ccase y ((,x) 1) (a 2))))) + 1) + +(deftest ccase.15 + (classify-error + (let ((x 'otherwise)) + (ccase x ((t) 10)))) + type-error) + +(deftest ccase.16 + (classify-error + (let ((x t)) + (ccase x ((otherwise) 10)))) + type-error) + +(deftest ccase.17 + (classify-error + (let ((x 'a)) + (ccase x (b 0) (c 1) (otherwise 2)))) + type-error) + +(deftest ccase.19 + (classify-error + (let ((x 'a)) + (ccase x (b 0) (c 1) ((t) 2)))) + type-error) + +(deftest ccase.20 + (let ((x #\a)) + (ccase x + ((#\b #\c) 10) + ((#\d #\e #\A) 20) + (() 30) + ((#\z #\a #\y) 40))) + 40) + +(deftest ccase.21 (let ((x 1)) (ccase x (1 (values)) (2 'a)))) + +(deftest ccase.23 (let ((x 1)) (ccase x (1 (values 'a 'b 'c)))) + a b c) + +;;; Show that the key expression is evaluated only once. +(deftest ccase.25 + (let ((a (vector 'a 'b 'c 'd 'e)) + (i 1)) + (values + (ccase (aref a (incf i)) + (a 1) + (b 2) + (c 3) + (d 4)) + i)) + 3 2) + +;;; Repeated keys are allowed (all but the first are ignored) + +(deftest ccase.26 + (let ((x 'b)) + (ccase x ((a b c) 10) (b 20))) + 10) + +(deftest ccase.27 + (let ((x 'b)) + (ccase x (b 20) ((a b c) 10))) + 20) + +(deftest ccase.28 + (let ((x 'b)) + (ccase x (b 20) (b 10) (d 0))) + 20) + +;;; There are implicit progns + +(deftest ccase.29 + (let ((x nil) (y 2)) + (values + (ccase y + (1 (setq x 'a) 'w) + (2 (setq x 'b) 'y) + (3 (setq x 'c) 'z)) + x)) + y b) + +(deftest ccase.30 + (let ((x 'a)) + (ccase x (a))) + nil) + +(deftest ccase.31 + (handler-bind + ((type-error #'(lambda (c) (store-value 7 c)))) + (let ((x 0)) + (ccase x + (1 :bad) + (7 :good) + (2 nil)))) + :good) + +;;; (deftest ccase.error.1 +;;; (classify-error (ccase)) +;;; program-error) + + + diff --git a/ansi-tests/cell-error-name.lsp b/ansi-tests/cell-error-name.lsp new file mode 100644 index 0000000..3a418ac --- /dev/null +++ b/ansi-tests/cell-error-name.lsp @@ -0,0 +1,51 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 27 22:36:48 2003 +;;;; Contains: Tests of CELL-ERROR-NAME + +(in-package :cl-test) + +(deftest cell-error-name.1 + (handler-case + (eval 'my-unbound-variable) + (cell-error (c) (cell-error-name c))) + my-unbound-variable) + +(deftest cell-error-name.2 + (handler-case + (eval '(my-undefined-function)) + ;; (warning (c) (muffle-warning c)) + (cell-error (c) (cell-error-name c))) + my-undefined-function) + +(deftest cell-error-name.3 + (cell-error-name (make-condition 'unbound-variable :name 'x)) + x) + +(deftest cell-error-name.4 + (cell-error-name (make-condition 'undefined-function :name 'f)) + f) + +(deftest cell-error-name.5 + (cell-error-name (make-condition 'unbound-slot :name 's)) + s) + +(deftest cell-error-name.6 + (let ((i 0)) + (values + (cell-error-name (progn (incf i) (make-condition + 'unbound-slot :name 's))) + i)) + s 1) + + +;;; Need test raising condition unbound-slot + + +(deftest cell-error-name.error.1 + (classify-error (cell-error-name)) + program-error) + +(deftest cell-error-name.error.2 + (classify-error (cell-error-name (make-condition 'unbound-variable :name 'foo) nil)) + program-error) diff --git a/ansi-tests/cerror.lsp b/ansi-tests/cerror.lsp new file mode 100644 index 0000000..1e60520 --- /dev/null +++ b/ansi-tests/cerror.lsp @@ -0,0 +1,56 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 19:45:27 2003 +;;;; Contains: Tests of CERROR + + +(in-package :cl-test) + +(deftest cerror.1 + (let ((fmt "Cerror")) + (handler-case (cerror "Keep going." fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest cerror.2 + (let* ((fmt "Cerror") + (cnd (make-condition 'simple-error :format-control fmt))) + (handler-case (cerror "Continue on." cnd) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest cerror.3 + (let ((fmt "Cerror")) + (handler-case (cerror "Continue" 'simple-error :format-control fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest cerror.4 + (let ((fmt "Cerror: ~A")) + (handler-case (cerror "On on" fmt 10) + (simple-error (c) (frob-simple-error c fmt 10)))) + t) + +(deftest cerror.5 + (let ((fmt (formatter "Cerror"))) + (handler-case (cerror "Keep going." fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +;;; Continuing from a cerror + +(deftest cerror.6 + (handler-bind ((simple-error #'(lambda (c) (continue c)))) + (progn + (cerror "Wooo" 'simple-error) + 10)) + 10) + + +(deftest cerror.error.1 + (classify-error (cerror)) + program-error) + +(deftest cerror.error.2 + (classify-error (cerror "foo")) + program-error) diff --git a/ansi-tests/char-aux.lsp b/ansi-tests/char-aux.lsp new file mode 100644 index 0000000..61d6d42 --- /dev/null +++ b/ansi-tests/char-aux.lsp @@ -0,0 +1,286 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 5 20:15:55 2002 +;;;; Contains: Auxiliary functions for character tests + +(in-package :cl-test) + +(defun is-ordered-by (seq fn) + (let ((n (length seq))) + (loop for i from 0 below (1- n) + for e = (elt seq i) + always + (loop for j from (1+ i) below n + always (funcall fn e (elt seq j)))))) + +(defun is-antisymmetrically-ordered-by (seq fn) + (and (is-ordered-by seq fn) + (is-ordered-by (reverse seq) (complement fn)))) + +(defun is-case-insensitive (fn) + (loop for c across +code-chars+ + for c1 = (char-upcase c) + for c2 = (if (eql c c1) (char-downcase c) c1) + always + (loop for d across +code-chars+ + for d1 = (char-upcase d) + for d2 = (if (eql d d1) (char-downcase d) d1) + always (equiv (funcall fn c d) + (funcall fn c2 d) + (funcall fn c d2) + (funcall fn c2 d2))))) + +(defun equiv (&rest args) + (declare (dynamic-extent args)) + (cond + ((null args) t) + ((car args) + (loop for e in (cdr args) always e)) + (t (loop for e in (cdr args) never e)))) + +;;; From character.lsp +(defun char-type-error-check (fn) + (loop for x in *universe* + always (or (characterp x) + (eqt (catch-type-error (funcall fn x)) 'type-error)))) + +(defun standard-char.5.body () + (loop for i from 0 below (min 65536 char-code-limit) + always (let ((c (code-char i))) + (not (and (typep c 'standard-char) + (not (standard-char-p c))))))) + +(defun extended-char.3.body () + (loop for i from 0 below (min 65536 char-code-limit) + always (let ((c (code-char i))) + (not (and (typep c 'extended-char) + (typep c 'base-char)))))) + +(defun character.1.body () + (loop for i from 0 below (min 65536 char-code-limit) + always (let ((c (code-char i))) + (or (null c) + (let ((s (string c))) + (and + (eqlt (character c) c) + (eqlt (character s) c) + (eqlt (character (make-symbol s)) c))))))) + +(defun character.2.body () + (loop for x in *universe* + when (not (or (characterp x) + (and (stringp x) (eqlt (length x) 1)) + (and (symbolp x) (eqlt (length (symbol-name x)) 1)) + (let ((c (catch-type-error (character x)))) + (or (eqlt c 'type-error) + (let ((s (catch-type-error (string x)))) + (and (stringp s) (eqlt (char s 0) c))))))) + do (return x))) + +(defun characterp.2.body () + (loop for i from 0 below (min 65536 char-code-limit) + always (let ((c (code-char i))) + (or (null c) (characterp c))))) + +(defun characterp.3.body () + (loop for x in *universe* + always (let ((p (characterp x)) + (q (typep x 'character))) + (if p (notnot q) (not q))))) + +(defun alphanumericp.4.body () + (loop for x in *universe* + always (or (not (characterp x)) + (if (or (digit-char-p x) (alpha-char-p x)) + (alphanumericp x) + ;; The hyperspec has an example that claims alphanumeric == + ;; digit-char-p or alpha-char-p, but the text seems to suggest + ;; that there can be numeric characters for which digit-char-p + ;; returns NIL. Therefore, I've weakened the next line + ;; (not (alphanumericp x)) + t + )))) + +(defun alphanumericp.5.body () + (loop for i from 0 below (min 65536 char-code-limit) + for x = (code-char i) + always (or (not (characterp x)) + (if (or (digit-char-p x) (alpha-char-p x)) + (alphanumericp x) + ;; The hyperspec has an example that claims alphanumeric == + ;; digit-char-p or alpha-char-p, but the text seems to suggest + ;; that there can be numeric characters for which digit-char-p + ;; returns NIL. Therefore, I've weakened the next line + ;; (not (alphanumericp x)) + t + )))) + +(defun digit-char.1.body () + (loop + for r from 2 to 36 + always + (loop for i from 0 to 36 + always (let ((c (digit-char i r))) + (if (>= i r) (null c) + (eqlt c (char +extended-digit-chars+ i))))))) + +(defun digit-char-p.1.body () + (loop for x in *universe* + always (not (and (characterp x) + (not (alphanumericp x)) + (digit-char-p x))))) + +(defun digit-char-p.2.body () + (loop for i from 0 below (min 65536 char-code-limit) + for x = (code-char i) + always (or (not x) + (not (and (not (alphanumericp x)) + (digit-char-p x)))))) + +(defun digit-char-p.3.body () + (loop for r from 2 to 35 + always + (loop for i from r to 35 + for c = (char +extended-digit-chars+ i) + never (or (digit-char-p c r) + (digit-char-p (char-downcase c) r))))) + +(defun digit-char-p.4.body () + (loop for r from 2 to 35 + always + (loop for i from 0 below r + for c = (char +extended-digit-chars+ i) + always (and (eqlt (digit-char-p c r) i) + (eqlt (digit-char-p (char-downcase c) r) i))))) + +(defun standard-char-p.2.body () + (loop for x in *universe* + always (or (not (characterp x)) + (find x +standard-chars+) + (not (standard-char-p x))))) + +(defun standard-char-p.2a.body () + (loop for i from 0 below (min 65536 char-code-limit) + for x = (code-char i) + always (or (not (characterp x)) + (find x +standard-chars+) + (not (standard-char-p x))))) + +(defun char-upcase.1.body () + (loop for x in *universe* + always + (or (not (characterp x)) + (let ((u (char-upcase x))) + (and + (or (lower-case-p x) (eqlt u x)) + (eqlt u (char-upcase u))))))) + +(defun char-upcase.2.body () + (loop for i from 0 below (min 65536 char-code-limit) + for x = (code-char i) + always + (or (not x) + (let ((u (char-upcase x))) + (and + (or (lower-case-p x) (eqlt u x)) + (eqlt u (char-upcase u))))))) + +(defun char-downcase.1.body () + (loop for x in *universe* + always + (or (not (characterp x)) + (let ((u (char-downcase x))) + (and + (or (upper-case-p x) (eqlt u x)) + (eqlt u (char-downcase u))))))) + +(defun char-downcase.2.body () + (loop for i from 0 below (min 65536 char-code-limit) + for x = (code-char i) + always + (or (not x) + (let ((u (char-downcase x))) + (and + (or (upper-case-p x) (eqlt u x)) + (eqlt u (char-downcase u))))))) + +(defun both-case-p.1.body () + (loop for x in *universe* + always (or (not (characterp x)) + (if (both-case-p x) + (and (graphic-char-p x) + (or (upper-case-p x) + (lower-case-p x))) + (not (or (upper-case-p x) + (lower-case-p x))))))) + +(defun both-case-p.2.body () + (loop for i from 0 below (min 65536 char-code-limit) + for x = (code-char i) + always (or (not (characterp x)) + (if (both-case-p x) + (and (graphic-char-p x) + (or (upper-case-p x) + (lower-case-p x))) + (not (or (upper-case-p x) + (lower-case-p x))))))) + +(defun char-code.2.body () + (loop for i from 0 below (min 65536 char-code-limit) + for c = (code-char i) + always (or (not c) + (eqlt (char-code c) i)))) + +(defun char-int.2.fn () + (declare (optimize (safety 3) (speed 1) (space 1))) + (let ((c->i (make-hash-table :test #'equal)) + (i->c (make-hash-table :test #'eql))) + (flet ((%insert + (c) + (or (not (characterp c)) + (let* ((i (char-int c)) + (j (gethash c c->i)) + (d (gethash i i->c))) + (and + (or (null j) (eqlt j i)) + (or (null d) (char= c d)) + (progn + (setf (gethash c c->i) i) + (setf (gethash i i->c) c) + t)))))) + (and + (loop for i from 0 below char-code-limit + always (%insert (code-char i))) + (every #'%insert +standard-chars+) + (every #'%insert *universe*) + t)))) + +(defun char-name.1.fn () + (declare (optimize (safety 3) (speed 1) (space 1))) + (flet ((%check + (c) + (or (not (characterp c)) + (let ((name (char-name c))) + (or (null name) + (and (stringp name) + (eqlt c (name-char name)))))))) + (and + (loop for i from 0 below char-code-limit + always (%check (code-char i))) + (every #'%check +standard-chars+) + (every #'%check *universe*) + t))) + +(defun name-char.1.body () + (declare (optimize (safety 3))) + (loop for x in *universe* + for s = (catch-type-error (string x)) + always + (or (eqlt s 'type-error) + (let ((c (name-char x))) + (or (not c) + (characterp c) + (let ((name (char-name c))) + (declare (type (or null string) name)) + (and name + (string-equal name s)))))))) diff --git a/ansi-tests/char-compare.lsp b/ansi-tests/char-compare.lsp new file mode 100644 index 0000000..e26205e --- /dev/null +++ b/ansi-tests/char-compare.lsp @@ -0,0 +1,723 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 5 19:36:00 2002 +;;;; Contains: Tests of character comparison functions + +(in-package :cl-test) + +;;; The character comparisons should throw a PROGRAM-ERROR when +;;; safe-called with no arguments +(deftest char-compare-no-args + (loop for f in '(char= char/= char< char> char<= char>= + char-lessp char-greaterp char-equal + char-not-lessp char-not-greaterp char-not-equal) + collect (eval `(classify-error (funcall ',f)))) + (program-error program-error program-error program-error + program-error program-error program-error program-error + program-error program-error program-error program-error + )) + +(deftest char=.1 + (is-ordered-by +code-chars+ #'(lambda (c1 c2) (not (char= c1 c2)))) + t) + +(deftest char=.2 + (loop for c across +code-chars+ + always (char= c c)) + t) + +(deftest char=.3 + (every #'char= +code-chars+) + t) + +(deftest char=.4 + (is-ordered-by +rev-code-chars+ + #'(lambda (c1 c2) (not (char= c1 c2)))) + t) + +(deftest char=.order.1 + (let ((i 0)) + (values (not (char= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char=.order.2 + (let ((i 0) a b) + (values (char= (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b)) + i a b)) + nil 2 1 2) + +(deftest char=.order.3 + (let ((i 0) a b c) + (values + (char= (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char/=.1 + (is-ordered-by +code-chars+ #'char/=) + t) + +(deftest char/=.2 + (loop for c across +code-chars+ + never (char/= c c)) + t) + +(deftest char/=.3 + (every #'char/= +code-chars+) + t) + +(deftest char/=.4 + (is-ordered-by +rev-code-chars+ #'char/=) + t) + +(deftest char/=.order.1 + (let ((i 0)) + (values (not (char/= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char/=.order.2 + (let ((i 0) a b) + (values (not (char/= (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char/=.order.3 + (let ((i 0) a b c) + (values + (char/= (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char<=.1 + (loop for c across +code-chars+ + always (char<= c c)) + t) + +(deftest char<=.2 + (every #'char<= +code-chars+) + t) + +(deftest char<=.3 + (is-antisymmetrically-ordered-by +code-chars+ #'char<=) + t) + +(deftest char<=.4 + (is-antisymmetrically-ordered-by +lower-case-chars+ #'char<=) + t) + +(deftest char<=.5 + (is-antisymmetrically-ordered-by +upper-case-chars+ #'char<=) + t) + +(deftest char<=.6 + (is-antisymmetrically-ordered-by +digit-chars+ #'char<=) + t) + +(deftest char<=.7 + (notnot-mv (or (char<= #\9 #\A) (char<= #\Z #\0))) + t) + +(deftest char<=.8 + (notnot-mv (or (char<= #\9 #\a) (char<= #\z #\0))) + t) + +(deftest char<=.order.1 + (let ((i 0)) + (values (not (char<= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char<=.order.2 + (let ((i 0) a b) + (values (not (char<= (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char<=.order.3 + (let ((i 0) a b c) + (values + (char<= (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char<.1 + (loop for c across +code-chars+ + never (char< c c)) + t) + +(deftest char<.2 + (every #'char< +code-chars+) + t) + +(deftest char<.3 + (is-antisymmetrically-ordered-by +code-chars+ #'char<) + t) + +(deftest char<.4 + (is-antisymmetrically-ordered-by +lower-case-chars+ #'char<) + t) + +(deftest char<.5 + (is-antisymmetrically-ordered-by +upper-case-chars+ #'char<) + t) + +(deftest char<.6 + (is-antisymmetrically-ordered-by +digit-chars+ #'char<) + t) + +(deftest char<.7 + (notnot-mv (or (char< #\9 #\A) (char< #\Z #\0))) + t) + +(deftest char<.8 + (notnot-mv (or (char< #\9 #\a) (char< #\z #\0))) + t) + +(deftest char<.order.1 + (let ((i 0)) + (values (not (char< (progn (incf i) #\a))) i)) + nil 1) + +(deftest char<.order.2 + (let ((i 0) a b) + (values (not (char< (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char<.order.3 + (let ((i 0) a b c) + (values + (char< (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +(deftest char<.order.4 + (let ((i 0) a b c) + (values + (char< (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char>=.1 + (loop for c across +code-chars+ + always (char>= c c)) + t) + +(deftest char>=.2 + (every #'char>= +code-chars+) + t) + +(deftest char>=.3 + (is-antisymmetrically-ordered-by +rev-code-chars+ #'char>=) + t) + +(deftest char>=.4 + (is-antisymmetrically-ordered-by (reverse +lower-case-chars+) #'char>=) + t) + +(deftest char>=.5 + (is-antisymmetrically-ordered-by (reverse +upper-case-chars+) #'char>=) + t) + +(deftest char>=.6 + (is-antisymmetrically-ordered-by (reverse +digit-chars+) #'char>=) + t) + +(deftest char>=.7 + (notnot-mv (or (char>= #\A #\9) (char>= #\0 #\Z))) + t) + +(deftest char>=.8 + (notnot-mv (or (char>= #\a #\9) (char>= #\0 #\z))) + t) + +(deftest char>=.order.1 + (let ((i 0)) + (values (not (char>= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char>=.order.2 + (let ((i 0) a b) + (values (not (char>= (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char>=.order.3 + (let ((i 0) a b c) + (values + (char>= (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +(deftest char>=.order.4 + (let ((i 0) a b c) + (values + (char>= (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char>.1 + (loop for c across +code-chars+ + never (char> c c)) + t) + +(deftest char>.2 + (every #'char> +code-chars+) + t) + +(deftest char>.3 + (is-antisymmetrically-ordered-by +rev-code-chars+ #'char>) + t) + +(deftest char>.4 + (is-antisymmetrically-ordered-by (reverse +lower-case-chars+) #'char>) + t) + +(deftest char>.5 + (is-antisymmetrically-ordered-by (reverse +upper-case-chars+) #'char>) + t) + +(deftest char>.6 + (is-antisymmetrically-ordered-by (reverse +digit-chars+) #'char>) + t) + +(deftest char>.7 + (notnot-mv (or (char> #\A #\9) (char> #\0 #\Z))) + t) + +(deftest char>.8 + (notnot-mv (or (char> #\a #\9) (char> #\0 #\z))) + t) + +(deftest char>.order.1 + (let ((i 0)) + (values (not (char> (progn (incf i) #\a))) i)) + nil 1) + +(deftest char>.order.2 + (let ((i 0) a b) + (values (not (char> (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char>.order.3 + (let ((i 0) a b c) + (values + (char> (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +(deftest char>.order.4 + (let ((i 0) a b c) + (values + (char> (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; Case-insensitive comparisons + +(deftest char-equal.1 + (is-ordered-by +code-chars+ + #'(lambda (c1 c2) + (or (char= (char-downcase c1) + (char-downcase c2)) + (not (char-equal c1 c2))))) + t) + +(deftest char-equal.2 + (loop for c across +code-chars+ + always (char-equal c c)) + t) + +(deftest char-equal.3 + (loop for c across +code-chars+ + always (char-equal c)) + t) + +(deftest char-equal.4 + (is-ordered-by +rev-code-chars+ + #'(lambda (c1 c2) + (or (char= (char-downcase c1) + (char-downcase c2)) + (not (char-equal c1 c2))))) + t) + +(deftest char-equal.order.1 + (let ((i 0)) + (values (not (char-equal (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-equal.order.2 + (let ((i 0) a b) + (values (char-equal (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a)) + i a b)) + nil 2 1 2) + +(deftest char-equal.order.3 + (let ((i 0) a b c) + (values + (char-equal (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +(deftest char-equal.order.4 + (let ((i 0) a b c) + (values + (char-equal (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char-not-equal.1 + (is-ordered-by +code-chars+ #'(lambda (c1 c2) + (or (char= (char-downcase c1) + (char-downcase c2)) + (char-not-equal c1 c2)))) + t) + +(deftest char-not-equal.2 + (loop for c across +code-chars+ + never (char-not-equal c c)) + t) + +(deftest char-not-equal.3 + (every #'char-not-equal +code-chars+) + t) + +(deftest char-not-equal.4 + (is-ordered-by +rev-code-chars+ #'(lambda (c1 c2) + (or (char= (char-downcase c1) + (char-downcase c2)) + (char-not-equal c1 c2)))) + t) + +(deftest char-not-equal.order.1 + (let ((i 0)) + (values (not (char-not-equal (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-not-equal.order.2 + (let ((i 0) a b) + (values (not (char-not-equal (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char-not-equal.order.3 + (let ((i 0) a b c) + (values + (char-not-equal (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +(deftest char-not-equal.order.4 + (let ((i 0) a b c) + (values + (char-not-equal (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char-not-greaterp.1 + (loop for c across +code-chars+ + always (char-not-greaterp c c)) + t) + +(deftest char-not-greaterp.2 + (every #'char-not-greaterp +code-chars+) + t) + +(deftest char-not-greaterp.3 + (is-case-insensitive #'char-not-greaterp) + t) + +(deftest char-not-greaterp.4 + (is-antisymmetrically-ordered-by +lower-case-chars+ #'char-not-greaterp) + t) + +(deftest char-not-greaterp.5 + (is-antisymmetrically-ordered-by +upper-case-chars+ #'char-not-greaterp) + t) + +(deftest char-not-greaterp.6 + (is-antisymmetrically-ordered-by +digit-chars+ #'char-not-greaterp) + t) + +(deftest char-not-greaterp.7 + (notnot-mv (or (char-not-greaterp #\9 #\A) (char-not-greaterp #\Z #\0))) + t) + +(deftest char-not-greaterp.8 + (notnot-mv (or (char-not-greaterp #\9 #\a) (char-not-greaterp #\z #\0))) + t) + +(deftest char-not-greaterp.order.1 + (let ((i 0)) + (values (not (char-not-greaterp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-not-greaterp.order.2 + (let ((i 0) a b) + (values (not (char-not-greaterp (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char-not-greaterp.order.3 + (let ((i 0) a b c) + (values + (char-not-greaterp (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +(deftest char-not-greaterp.order.4 + (let ((i 0) a b c) + (values + (char-not-greaterp (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char-lessp.1 + (loop for c across +code-chars+ + never (char-lessp c c)) + t) + +(deftest char-lessp.2 + (every #'char-lessp +code-chars+) + t) + +(deftest char-lessp.3 + (is-case-insensitive #'char-lessp) + t) + +(deftest char-lessp.4 + (is-antisymmetrically-ordered-by +lower-case-chars+ #'char-lessp) + t) + +(deftest char-lessp.5 + (is-antisymmetrically-ordered-by +upper-case-chars+ #'char-lessp) + t) + +(deftest char-lessp.6 + (is-antisymmetrically-ordered-by +digit-chars+ #'char-lessp) + t) + +(deftest char-lessp.7 + (notnot-mv (or (char-lessp #\9 #\A) (char-lessp #\Z #\0))) + t) + +(deftest char-lessp.8 + (notnot-mv (or (char-lessp #\9 #\a) (char-lessp #\z #\0))) + t) + +(deftest char-lessp.order.1 + (let ((i 0)) + (values (not (char-lessp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-lessp.order.2 + (let ((i 0) a b) + (values (not (char-lessp (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char-lessp.order.3 + (let ((i 0) a b c) + (values + (char-lessp (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +(deftest char-lessp.order.4 + (let ((i 0) a b c) + (values + (char-lessp (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char-not-lessp.1 + (loop for c across +code-chars+ + always (char-not-lessp c c)) + t) + +(deftest char-not-lessp.2 + (every #'char-not-lessp +code-chars+) + t) + +(deftest char-not-lessp.3 + (is-case-insensitive #'char-not-lessp) + t) + +(deftest char-not-lessp.4 + (is-antisymmetrically-ordered-by (reverse +lower-case-chars+) + #'char-not-lessp) + t) + +(deftest char-not-lessp.5 + (is-antisymmetrically-ordered-by (reverse +upper-case-chars+) #'char-not-lessp) + t) + +(deftest char-not-lessp.6 + (is-antisymmetrically-ordered-by (reverse +digit-chars+) #'char-not-lessp) + t) + +(deftest char-not-lessp.7 + (notnot-mv (or (char-not-lessp #\A #\9) (char-not-lessp #\0 #\Z))) + t) + +(deftest char-not-lessp.8 + (notnot-mv (or (char-not-lessp #\a #\9) (char-not-lessp #\0 #\z))) + t) + +(deftest char-not-lessp.order.1 + (let ((i 0)) + (values (not (char-not-lessp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-not-lessp.order.2 + (let ((i 0) a b) + (values (not (char-not-lessp (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char-not-lessp.order.3 + (let ((i 0) a b c) + (values + (char-not-lessp (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +(deftest char-not-lessp.order.4 + (let ((i 0) a b c) + (values + (char-not-lessp (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + +(deftest char-greaterp.1 + (loop for c across +code-chars+ + never (char-greaterp c c)) + t) + +(deftest char-greaterp.2 + (every #'char-greaterp +code-chars+) + t) + +(deftest char-greaterp.3 + (is-case-insensitive #'char-greaterp) + t) + +(deftest char-greaterp.4 + (is-antisymmetrically-ordered-by (reverse +lower-case-chars+) + #'char-greaterp) + t) + +(deftest char-greaterp.5 + (is-antisymmetrically-ordered-by (reverse +upper-case-chars+) #'char-greaterp) + t) + +(deftest char-greaterp.6 + (is-antisymmetrically-ordered-by (reverse +digit-chars+) #'char-greaterp) + t) + +(deftest char-greaterp.7 + (notnot-mv (or (char-greaterp #\A #\9) (char-greaterp #\0 #\Z))) + t) + +(deftest char-greaterp.8 + (notnot-mv (or (char-greaterp #\a #\9) (char-greaterp #\0 #\z))) + t) + +(deftest char-greaterp.order.1 + (let ((i 0)) + (values (not (char-greaterp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-greaterp.order.2 + (let ((i 0) a b) + (values (not (char-greaterp (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char-greaterp.order.3 + (let ((i 0) a b c) + (values + (char-greaterp (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +(deftest char-greaterp.order.4 + (let ((i 0) a b c) + (values + (char-greaterp (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) diff --git a/ansi-tests/char-schar.lsp b/ansi-tests/char-schar.lsp new file mode 100644 index 0000000..617316f --- /dev/null +++ b/ansi-tests/char-schar.lsp @@ -0,0 +1,164 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Sep 29 21:04:44 2002 +;;;; Contains: Tests of CHAR and SCHAR accessors + +(in-package :cl-test) + +(deftest char.1 + (let ((s "abcd")) + (values (char s 0) (char s 1) (char s 2) (char s 3))) + #\a #\b #\c #\d) + +(deftest char.2 + (let ((s0 (copy-seq "abcd")) + (s1 (copy-seq "abcd")) + (s2 (copy-seq "abcd")) + (s3 (copy-seq "abcd"))) + (setf (char s0 0) #\X) + (setf (char s1 1) #\X) + (setf (char s2 2) #\X) + (setf (char s3 3) #\X) + (values s0 s1 s2 s3)) + "Xbcd" "aXcd" "abXd" "abcX") + +(deftest char.3 + (let ((s (make-array 6 :element-type 'character + :initial-contents '(#\a #\b #\c #\d #\e #\f)))) + (setf (char s 3) #\X) + s) + "abcXef") + +(deftest char.4 + (let ((s (make-array 6 :element-type 'character + :initial-contents '(#\a #\b #\c #\d #\e #\f) + :fill-pointer 4))) + (setf (char s 3) #\X) + s) + "abcX") + +(deftest char.5 + (let ((s (make-string 5 :initial-element #\a))) + (setf (char s 3) #\X) + s) + "aaaXa") + +(deftest char.6 + (let ((s (make-string 5 :initial-element #\a :element-type 'base-char))) + (setf (char s 3) #\X) + s) + "aaaXa") + +(deftest char.7 + (let ((s (make-string 5 :initial-element #\a :element-type 'character))) + (setf (char s 3) #\X) + s) + "aaaXa") + +(deftest char.8 + (let ((s (make-array 6 :element-type 'character + :initial-contents '(#\a #\b #\c #\d #\e #\f) + :fill-pointer 4))) + (setf (char s 5) #\X) + (setf (fill-pointer s) 6) + s) + "abcdeX") + +(deftest char.9 + (let ((s (make-string 5 :initial-element #\a + :element-type 'base-char))) + (setf (char s 3) #\X) + s) + "aaaXa") + +(deftest char.10 + (let ((s (make-string 5 :initial-element #\a + :element-type 'standard-char))) + (setf (char s 3) #\X) + s) + "aaaXa") + +(deftest char.order.1 + (let ((i 0) a b) + (values + (char (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) 1)) + i a b)) + #\b 2 1 2) + +(deftest char.order.2 + (let ((i 0) a b c (s (make-string 5 :initial-element #\z))) + (values + (setf + (char (progn (setf a (incf i)) s) + (progn (setf b (incf i)) 1)) + (progn (setf c (incf i)) #\a)) + s i a b c)) + #\a "zazzz" 3 1 2 3) + +;;; Tests of schar + +(deftest schar.1 + (let ((s "abcd")) (values (schar s 0) (schar s 1) (schar s 2) (schar s 3))) + #\a #\b #\c #\d) + +(deftest schar.2 + (let ((s0 (copy-seq "abcd")) + (s1 (copy-seq "abcd")) + (s2 (copy-seq "abcd")) + (s3 (copy-seq "abcd"))) + (setf (schar s0 0) #\X) + (setf (schar s1 1) #\X) + (setf (schar s2 2) #\X) + (setf (schar s3 3) #\X) + (values s0 s1 s2 s3)) + "Xbcd" "aXcd" "abXd" "abcX") + +(deftest schar.3 + (let ((s (make-string 6 :initial-element #\x))) + (setf (schar s 2) #\X) + s) + "xxXxxx") + +(deftest schar.4 + (let ((s (make-string 6 :initial-element #\x :element-type 'character))) + (setf (schar s 2) #\X) + s) + "xxXxxx") + +(deftest schar.5 + (let ((s (make-string 6 :initial-element #\x :element-type 'standard-char))) + (setf (schar s 2) #\X) + s) + "xxXxxx") + +(deftest schar.6 + (let ((s (make-string 6 :initial-element #\x :element-type 'base-char))) + (setf (schar s 2) #\X) + s) + "xxXxxx") + +(deftest schar.7 + (let ((s (make-string 6 :initial-element #\x + :element-type 'standard-char))) + (setf (schar s 2) #\X) + s) + "xxXxxx") + +(deftest schar.order.1 + (let ((i 0) a b) + (values + (schar (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) 1)) + i a b)) + #\b 2 1 2) + +(deftest schar.order.2 + (let ((i 0) a b c (s (copy-seq "zzzzz"))) + (values + (setf + (schar (progn (setf a (incf i)) s) + (progn (setf b (incf i)) 1)) + (progn (setf c (incf i)) #\a)) + s i a b c)) + #\a "zazzz" 3 1 2 3) diff --git a/ansi-tests/character.lsp b/ansi-tests/character.lsp new file mode 100644 index 0000000..4f5b06d --- /dev/null +++ b/ansi-tests/character.lsp @@ -0,0 +1,651 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 5 12:52:18 2002 +;;;; Contains: Tests associated with the class CHARACTER + +(in-package :cl-test) + +(deftest character-class.1 + (subtypep* 'character t) + t t) + +(deftest base-char.1 + (subtypep* 'base-char 'character) + t t) + +(deftest base-char.2 + (subtypep* 'base-char t) + t t) + +(deftest base-char.3 + (every #'(lambda (c) (typep c 'base-char)) +standard-chars+) + t) + +(deftest standard-char.1 + (subtypep* 'standard-char 'base-char) + t t) + +(deftest standard-char.2 + (subtypep* 'standard-char 'character) + t t) + +(deftest standard-char.3 + (subtypep* 'standard-char t) + t t) + +(deftest standard-char.4 + (every #'(lambda (c) (typep c 'standard-char)) +standard-chars+) + t) + +(deftest standard-char.5 + (standard-char.5.body) + t) + +(deftest extended-char.1 + (subtypep* 'extended-char 'character) + t t) + +(deftest extended-char.2 + (subtypep* 'extended-char t) + t t) + +(deftest extended-char.3 + (extended-char.3.body) + t) + +;;; + +(deftest character.1 + (character.1.body) + t) + +(deftest character.2 + (character.2.body) + nil) + +(deftest character.order.1 + (let ((i 0)) + (values + (character (progn (incf i) #\a)) + i)) + #\a 1) + +(deftest character.error.1 + (classify-error (character)) + program-error) + +(deftest character.error.2 + (classify-error (character #\a #\a)) + program-error) + +;;; + +(deftest characterp.1 + (every #'characterp +standard-chars+) + t) + +(deftest characterp.2 + (characterp.2.body) + t) + +(deftest characterp.3 + (characterp.3.body) + t) + +(deftest characterp.order.1 + (let ((i 0)) + (values + (characterp (incf i)) + i)) + nil 1) + +(deftest characterp.error.1 + (classify-error (characterp)) + program-error) + +(deftest characterp.error.2 + (classify-error (characterp #\a #\b)) + program-error) + + +(deftest alpha-char-p.1 + (loop for c across +standard-chars+ + always + (or (find c +alpha-chars+) + (not (alpha-char-p c)))) + t) + +;;; + +(deftest alpha-char-p.2 + (every #'alpha-char-p +alpha-chars+) + t) + +(deftest alpha-char-p.3 + (char-type-error-check #'alpha-char-p) + t) + +(deftest alpha-char-p.order.1 + (let ((i 0)) + (values + (alpha-char-p (progn (incf i) #\8)) + i)) + nil 1) + +(deftest alpha-char-p.error.1 + (classify-error (alpha-char-p)) + program-error) + +(deftest alpha-char-p.error.2 + (classify-error (alpha-char-p #\a #\b)) + program-error) + +;;; + +(deftest alphanumericp.1 + (loop for c across +standard-chars+ + always + (or (find c +alphanumeric-chars+) + (not (alphanumericp c)))) + t) + +(deftest alphanumericp.2 + (every #'alphanumericp +alphanumeric-chars+) + t) + +(deftest alphanumericp.3 + (char-type-error-check #'alphanumericp) + t) + +(deftest alphanumericp.4 + (alphanumericp.4.body) + t) + +(deftest alphanumericp.5 + (alphanumericp.5.body) + t) + +(deftest alphanumericp.order.1 + (let ((i 0)) + (values + (alphanumericp (progn (incf i) #\?)) + i)) + nil 1) + +(deftest alphanumericp.error.1 + (classify-error (alphanumericp)) + program-error) + +(deftest alphanumericp.error.2 + (classify-error (alphanumericp #\a #\b)) + program-error) + +;;; + +(deftest digit-char.1 + (digit-char.1.body) + t) + +(deftest digit-char.2 + (map 'list #'digit-char (loop for i from 0 to 39 collect i)) + (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 + 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)) + +(deftest digit-char.order.1 + (let ((i 0)) + (values + (digit-char (incf i)) + i)) + #\1 1) + +(deftest digit-char.order.2 + (let ((i 0) x) + (values + (digit-char (incf i) (progn (setf x (incf i)) 10)) + i x)) + #\1 2 2) + +(deftest digit-char.error.1 + (classify-error (digit-char)) + program-error) + +(deftest digit-char.error.2 + (classify-error (digit-char 0 10 'foo)) + program-error) + +;;; + +(deftest digit-char-p.1 + (digit-char-p.1.body) + t) + +(deftest digit-char-p.2 + (digit-char-p.2.body) + t) + +(deftest digit-char-p.3 + (digit-char-p.3.body) + t) + +(deftest digit-char-p.4 + (digit-char-p.4.body) + t) + +(deftest digit-char-p.5 + (loop for i from 10 to 35 + for c = (char +extended-digit-chars+ i) + never (or (digit-char-p c) + (digit-char-p (char-downcase c)))) + t) + +(deftest digit-char-p.6 + (loop for i from 0 below 10 + for c = (char +extended-digit-chars+ i) + always (eqlt (digit-char-p c) i)) + t) + +(deftest digit-char-p.order.1 + (let ((i 0)) + (values + (digit-char-p (progn (incf i) #\0)) + i)) + 0 1) + +(deftest digit-char-p.order.2 + (let ((i 0) x y) + (values + (digit-char-p (progn (setf x (incf i)) #\0) + (progn (setf y (incf i)) 10)) + i x y)) + 0 2 1 2) + +(deftest digit-char-p.error.1 + (classify-error (digit-char-p)) + program-error) + +(deftest digit-char-p.error.2 + (classify-error (digit-char-p #\1 10 'foo)) + program-error) + +;;; + +(deftest graphic-char-p.1 + (loop for c across +standard-chars+ + always (if (eqlt c #\Newline) + (not (graphic-char-p c)) + (graphic-char-p c))) + t) + +(deftest graphic-char-p.2 + (loop + for name in '("Rubout" "Page" "Backspace" "Tab" "Linefeed" "Return") + for c = (name-char name) + when (and c (graphic-char-p c)) collect c) + nil) + +(deftest graphic-char-p.3 + (char-type-error-check #'graphic-char-p) + t) + +(deftest graphic-char-p.order.1 + (let ((i 0)) + (values + (not (graphic-char-p (progn (incf i) #\a))) + i)) + nil 1) + +(deftest graphic-char-p.error.1 + (classify-error (graphic-char-p)) + program-error) + +(deftest graphic-char-p.error.2 + (classify-error (graphic-char-p #\a #\a)) + program-error) + +;;; + +(deftest standard-char-p.1 + (every #'standard-char-p +standard-chars+) + t) + +(deftest standard-char-p.2 + (standard-char-p.2.body) + t) + +(deftest standard-char-p.2a + (standard-char-p.2a.body) + t) + +(deftest standard-char-p.3 + (char-type-error-check #'standard-char-p) + t) + +(deftest standard-char-p.order.1 + (let ((i 0)) + (values + (not (standard-char-p (progn (incf i) #\a))) + i)) + nil 1) + +(deftest standard-char-p.error.1 + (classify-error (standard-char-p)) + program-error) + +(deftest standard-char-p.error.2 + (classify-error (standard-char-p #\a #\a)) + program-error) + +;;; + +(deftest char-upcase.1 + (char-upcase.1.body) + t) + +(deftest char-upcase.2 + (char-upcase.2.body) + t) + +(deftest char-upcase.3 + (map 'string #'char-upcase +alpha-chars+) + "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ") + +(deftest char-upcase.4 + (char-type-error-check #'char-upcase) + t) + +(deftest char-upcase.order.1 + (let ((i 0)) + (values + (char-upcase (progn (incf i) #\a)) + i)) + #\A 1) + +(deftest char-upcase.error.1 + (classify-error (char-upcase)) + program-error) + +(deftest char-upcase.error.2 + (classify-error (char-upcase #\a #\a)) + program-error) + +;;; + +(deftest char-downcase.1 + (char-downcase.1.body) + t) + +(deftest char-downcase.2 + (char-downcase.2.body) + t) + +(deftest char-downcase.3 + (map 'string #'char-downcase +alpha-chars+) + "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz") + +(deftest char-downcase.4 + (char-type-error-check #'char-downcase) + t) + +(deftest char-downcase.order.1 + (let ((i 0)) + (values + (char-downcase (progn (incf i) #\A)) + i)) + #\a 1) + +(deftest char-downcase.error.1 + (classify-error (char-downcase)) + program-error) + +(deftest char-downcase.error.2 + (classify-error (char-downcase #\A #\A)) + program-error) + +;;; + +(deftest upper-case-p.1 + (find-if-not #'upper-case-p +standard-chars+ :start 26 :end 52) + nil) + +(deftest upper-case-p.2 + (find-if #'upper-case-p +standard-chars+ :end 26) + nil) + +(deftest upper-case-p.3 + (find #'upper-case-p +standard-chars+ :start 52) + nil) + +(deftest upper-case-p.4 + (char-type-error-check #'upper-case-p) + t) + +(deftest upper-case-p.order.1 + (let ((i 0)) + (values + (upper-case-p (progn (incf i) #\a)) + i)) + nil 1) + +(deftest upper-case-p.error.1 + (classify-error (upper-case-p)) + program-error) + +(deftest upper-case-p.error.2 + (classify-error (upper-case-p #\a #\A)) + program-error) + +;;; + +(deftest lower-case-p.1 + (find-if-not #'lower-case-p +standard-chars+ :end 26) + nil) + +(deftest lower-case-p.2 + (find-if #'lower-case-p +standard-chars+ :start 26) + nil) + +(deftest lower-case-p.3 + (char-type-error-check #'lower-case-p) + t) + +(deftest lower-case-p.order.1 + (let ((i 0)) + (values + (lower-case-p (progn (incf i) #\A)) + i)) + nil 1) + +(deftest lower-case-p.error.1 + (classify-error (lower-case-p)) + program-error) + +(deftest lower-case-p.error.2 + (classify-error (lower-case-p #\a #\a)) + program-error) + +;;; + +(deftest both-case-p.1 + (both-case-p.1.body) + t) + +(deftest both-case-p.2 + (both-case-p.2.body) + t) + +(deftest both-case-p.3 + (char-type-error-check #'both-case-p) + t) + +(deftest both-case-p.order.1 + (let ((i 0)) + (values + (both-case-p (progn (incf i) #\5)) + i)) + nil 1) + +(deftest both-case-p.error.1 + (classify-error (both-case-p)) + program-error) + +(deftest both-case-p.error.2 + (classify-error (both-case-p #\a #\a)) + program-error) + +;;; + +(deftest char-code.1 + (char-type-error-check #'char-code) + t) + +(deftest char-code.2 + (char-code.2.body) + t) + +(deftest char-code.order.1 + (let ((i 0)) + (values + (not (numberp (char-code (progn (incf i) #\a)))) + i)) + nil 1) + +(deftest char-code.error.1 + (classify-error (char-code)) + program-error) + +(deftest char-code.error.2 + (classify-error (char-code #\a #\a)) + program-error) + +;;; + +(deftest code-char.1 + (loop for x across +standard-chars+ + always (eqlt (code-char (char-code x)) x)) + t) + +(deftest code-char.order.1 + (let ((i 0)) + (values + (code-char (progn (incf i) (char-code #\a))) + i)) + #\a 1) + +(deftest code-char.error.1 + (classify-error (code-char)) + program-error) + +(deftest code-char.error.2 + (classify-error (code-char 1 1)) + program-error) + +;;; + +(deftest char-int.1 + (loop for x across +standard-chars+ + always (eqlt (char-int x) (char-code x))) + t) + +(deftest char-int.2 + (char-int.2.fn) + t) + +(deftest char-int.order.1 + (let ((i 0)) + (values + (code-char (char-int (progn (incf i) #\a))) + i)) + #\a 1) + +(deftest char-int.error.1 + (classify-error (char-int)) + program-error) + +(deftest char-int.error.2 + (classify-error (char-int #\a #\a)) + program-error) + +;;; + +(deftest char-name.1 + (char-name.1.fn) + t) + +(deftest char-name.2 + (notnot-mv (string= (char-name #\Space) "Space")) + t) + +(deftest char-name.3 + (notnot-mv (string= (char-name #\Newline) "Newline")) + t) + +;;; Check that the names of various semi-standard characters are +;;; appropriate. This is complicated by the possibility that two different +;;; names may refer to the same character (as is allowed by the standard, +;;; for example in the case of Newline and Linefeed). + +(deftest char-name.4 + (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed") + for c = (name-char s) + unless (or (not c) + ;; If the char-name is not even string-equal, + ;; assume we're sharing the character with some other + ;; name, and assume it's ok + (not (string-equal (char-name c) s)) + (string= (char-name c) s)) + ;; Collect list of cases that failed + collect (list s c (char-name c))) + nil) + +(deftest char-name.5 + (char-type-error-check #'char-name) + t) + +(deftest char-name.order.1 + (let ((i 0)) + (values + (char-name (progn (incf i) #\Space)) + i)) + "Space" 1) + +(deftest char-name.error.1 + (classify-error (char-name)) + program-error) + +(deftest char-name.error.2 + (classify-error (char-name #\a #\a)) + program-error) + +;;; + +(deftest name-char.1 + (name-char.1.body) + t) + +(deftest name-char.2 + (loop for s in '("RubOut" "PAGe" "BacKspace" "RetUrn" "Tab" "LineFeed" + "SpaCE" "NewLine") + always + (let ((c1 (name-char (string-upcase s))) + (c2 (name-char (string-downcase s))) + (c3 (name-char (string-capitalize s))) + (c4 (name-char s))) + (and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4)))) + t) + +(deftest name-char.order.1 + (let ((i 0)) + (values + (name-char (progn (incf i) "Space")) + i)) + #\Space 1) + +(deftest name-char.error.1 + (classify-error (name-char)) + program-error) + +(deftest name-char.error.2 + (classify-error (name-char "space" "space")) + program-error) diff --git a/ansi-tests/check-type.lsp b/ansi-tests/check-type.lsp new file mode 100644 index 0000000..94a3e4f --- /dev/null +++ b/ansi-tests/check-type.lsp @@ -0,0 +1,51 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 20:12:04 2003 +;;;; Contains: Tests of CHECK-TYPE + +(in-package :cl-test) + +(deftest check-type.1 + (let ((x 'a)) + (values (check-type x symbol) x)) + nil a) + +(deftest check-type.2 + (classify-error + (let ((x 'a)) + (check-type x integer))) + type-error) + +(deftest check-type.3 + (let ((x 'a)) + (handler-bind + ((type-error #'(lambda (c) (store-value 15 c)))) + (values (check-type x number) x))) + nil 15) + +(deftest check-type.4 + (let ((x 'a)) + (values (check-type x symbol "a symbol") x)) + nil a) + +(deftest check-type.5 + (let ((x 'a)) + (handler-bind + ((type-error #'(lambda (c) (store-value "abc" c)))) + (values (check-type x string "a string") x))) + nil "abc") + +(deftest check-type.6 + (let ((x 'a)) + (handler-bind + ((type-error #'(lambda (c) (declare (ignore c)) (store-value 15 nil)))) + (values (check-type x number) x))) + nil 15) + +(deftest check-type.7 + (let ((x 'a)) + (handler-bind + ((type-error #'(lambda (c) (declare (ignore c)) (store-value 15)))) + (values (check-type x number) x))) + nil 15) + diff --git a/ansi-tests/cl-symbol-names.lsp b/ansi-tests/cl-symbol-names.lsp new file mode 100644 index 0000000..98821da --- /dev/null +++ b/ansi-tests/cl-symbol-names.lsp @@ -0,0 +1,2155 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Oct 6 21:49:33 2002 +;;;; Contains: Names of standard CL symbols + +(in-package :cl-test) + +;;; +;;; These are the names of the 978 symbols that can and must be external to +;;; the COMMON-LISP package. +;;; + +(defparameter *cl-symbol-names* +(mapcar #'string +'( +#:&allow-other-keys +#:&aux +#:&body +#:&environment +#:&key +#:&optional +#:&rest +#:&whole +#:* +#:** +#:*** +#:*break-on-signals* +#:*compile-file-pathname* +#:*compile-file-truename* +#:*compile-print* +#:*compile-verbose* +#:*debug-io* +#:*debugger-hook* +#:*default-pathname-defaults* +#:*error-output* +#:*features* +#:*gensym-counter* +#:*load-pathname* +#:*load-print* +#:*load-truename* +#:*load-verbose* +#:*macroexpand-hook* +#:*modules* +#:*package* +#:*print-array* +#:*print-base* +#:*print-case* +#:*print-circle* +#:*print-escape* +#:*print-gensym* +#:*print-length* +#:*print-level* +#:*print-lines* +#:*print-miser-width* +#:*print-pprint-dispatch* +#:*print-pretty* +#:*print-radix* +#:*print-readably* +#:*print-right-margin* +#:*query-io* +#:*random-state* +#:*read-base* +#:*read-default-float-format* +#:*read-eval* +#:*read-suppress* +#:*readtable* +#:*standard-input* +#:*standard-output* +#:*terminal-io* +#:*trace-output* +#:+ +#:++ +#:+++ +#:- +#:/ +#:// +#:/// +#:/= +#:1+ +#:1- +#:< +#:<= +#:= +#:> +#:>= +#:abort +#:abs +#:acons +#:acos +#:acosh +#:add-method +#:adjoin +#:adjust-array +#:adjustable-array-p +#:allocate-instance +#:alpha-char-p +#:alphanumericp +#:and +#:append +#:apply +#:apropos +#:apropos-list +#:aref +#:arithmetic-error +#:arithmetic-error-operands +#:arithmetic-error-operation +#:array +#:array-dimension +#:array-dimension-limit +#:array-dimensions +#:array-displacement +#:array-element-type +#:array-has-fill-pointer-p +#:array-in-bounds-p +#:array-rank +#:array-rank-limit +#:array-row-major-index +#:array-total-size +#:array-total-size-limit +#:arrayp +#:ash +#:asin +#:asinh +#:assert +#:assoc +#:assoc-if +#:assoc-if-not +#:atan +#:atanh +#:atom +#:base-char +#:base-string +#:bignum +#:bit +#:bit-and +#:bit-andc1 +#:bit-andc2 +#:bit-eqv +#:bit-ior +#:bit-nand +#:bit-nor +#:bit-not +#:bit-orc1 +#:bit-orc2 +#:bit-vector +#:bit-vector-p +#:bit-xor +#:block +#:boole +#:boole-1 +#:boole-2 +#:boole-and +#:boole-andc1 +#:boole-andc2 +#:boole-c1 +#:boole-c2 +#:boole-clr +#:boole-eqv +#:boole-ior +#:boole-nand +#:boole-nor +#:boole-orc1 +#:boole-orc2 +#:boole-set +#:boole-xor +#:boolean +#:both-case-p +#:boundp +#:break +#:broadcast-stream +#:broadcast-stream-streams +#:built-in-class +#:butlast +#:byte +#:byte-position +#:byte-size +#:caaaar +#:caaadr +#:caaar +#:caadar +#:caaddr +#:caadr +#:caar +#:cadaar +#:cadadr +#:cadar +#:caddar +#:cadddr +#:caddr +#:cadr +#:call-arguments-limit +#:call-method +#:call-next-method +#:car +#:case +#:catch +#:ccase +#:cdaaar +#:cdaadr +#:cdaar +#:cdadar +#:cdaddr +#:cdadr +#:cdar +#:cddaar +#:cddadr +#:cddar +#:cdddar +#:cddddr +#:cdddr +#:cddr +#:cdr +#:ceiling +#:cell-error +#:cell-error-name +#:cerror +#:change-class +#:char +#:char-code +#:char-code-limit +#:char-downcase +#:char-equal +#:char-greaterp +#:char-int +#:char-lessp +#:char-name +#:char-not-equal +#:char-not-greaterp +#:char-not-lessp +#:char-upcase +#:char/= +#:char< +#:char<= +#:char= +#:char> +#:char>= +#:character +#:characterp +#:check-type +#:cis +#:class +#:class-name +#:class-of +#:clear-input +#:clear-output +#:close +#:clrhash +#:code-char +#:coerce +#:compilation-speed +#:compile +#:compile-file +#:compile-file-pathname +#:compiled-function +#:compiled-function-p +#:compiler-macro +#:compiler-macro-function +#:complement +#:complex +#:complexp +#:compute-applicable-methods +#:compute-restarts +#:concatenate +#:concatenated-stream +#:concatenated-stream-streams +#:cond +#:condition +#:conjugate +#:cons +#:consp +#:constantly +#:constantp +#:continue +#:control-error +#:copy-alist +#:copy-list +#:copy-pprint-dispatch +#:copy-readtable +#:copy-seq +#:copy-structure +#:copy-symbol +#:copy-tree +#:cos +#:cosh +#:count +#:count-if +#:count-if-not +#:ctypecase +#:debug +#:decf +#:declaim +#:declaration +#:declare +#:decode-float +#:decode-universal-time +#:defclass +#:defconstant +#:defgeneric +#:define-compiler-macro +#:define-condition +#:define-method-combination +#:define-modify-macro +#:define-setf-expander +#:define-symbol-macro +#:defmacro +#:defmethod +#:defpackage +#:defparameter +#:defsetf +#:defstruct +#:deftype +#:defun +#:defvar +#:delete +#:delete-duplicates +#:delete-file +#:delete-if +#:delete-if-not +#:delete-package +#:denominator +#:deposit-field +#:describe +#:describe-object +#:destructuring-bind +#:digit-char +#:digit-char-p +#:directory +#:directory-namestring +#:disassemble +#:division-by-zero +#:do +#:do* +#:do-all-symbols +#:do-external-symbols +#:do-symbols +#:documentation +#:dolist +#:dotimes +#:double-float +#:double-float-epsilon +#:double-float-negative-epsilon +#:dpb +#:dribble +#:dynamic-extent +#:ecase +#:echo-stream +#:echo-stream-input-stream +#:echo-stream-output-stream +#:ed +#:eighth +#:elt +#:encode-universal-time +#:end-of-file +#:endp +#:enough-namestring +#:ensure-directories-exist +#:ensure-generic-function +#:eq +#:eql +#:equal +#:equalp +#:error +#:etypecase +#:eval +#:eval-when +#:evenp +#:every +#:exp +#:export +#:expt +#:extended-char +#:fboundp +#:fceiling +#:fdefinition +#:ffloor +#:fifth +#:file-author +#:file-error +#:file-error-pathname +#:file-length +#:file-namestring +#:file-position +#:file-stream +#:file-string-length +#:file-write-date +#:fill +#:fill-pointer +#:find +#:find-all-symbols +#:find-class +#:find-if +#:find-if-not +#:find-method +#:find-package +#:find-restart +#:find-symbol +#:finish-output +#:first +#:fixnum +#:flet +#:float +#:float-digits +#:float-precision +#:float-radix +#:float-sign +#:floating-point-inexact +#:floating-point-invalid-operation +#:floating-point-overflow +#:floating-point-underflow +#:floatp +#:floor +#:fmakunbound +#:force-output +#:format +#:formatter +#:fourth +#:fresh-line +#:fround +#:ftruncate +#:ftype +#:funcall +#:function +#:function-keywords +#:function-lambda-expression +#:functionp +#:gcd +#:generic-function +#:gensym +#:gentemp +#:get +#:get-decoded-time +#:get-dispatch-macro-character +#:get-internal-real-time +#:get-internal-run-time +#:get-macro-character +#:get-output-stream-string +#:get-properties +#:get-setf-expansion +#:get-universal-time +#:getf +#:gethash +#:go +#:graphic-char-p +#:handler-bind +#:handler-case +#:hash-table +#:hash-table-count +#:hash-table-p +#:hash-table-rehash-size +#:hash-table-rehash-threshold +#:hash-table-size +#:hash-table-test +#:host-namestring +#:identity +#:if +#:ignorable +#:ignore +#:ignore-errors +#:imagpart +#:import +#:in-package +#:incf +#:initialize-instance +#:inline +#:input-stream-p +#:inspect +#:integer +#:integer-decode-float +#:integer-length +#:integerp +#:interactive-stream-p +#:intern +#:internal-time-units-per-second +#:intersection +#:invalid-method-error +#:invoke-debugger +#:invoke-restart +#:invoke-restart-interactively +#:isqrt +#:keyword +#:keywordp +#:labels +#:lambda +#:lambda-list-keywords +#:lambda-parameters-limit +#:last +#:lcm +#:ldb +#:ldb-test +#:ldiff +#:least-negative-double-float +#:least-negative-long-float +#:least-negative-normalized-double-float +#:least-negative-normalized-long-float +#:least-negative-normalized-short-float +#:least-negative-normalized-single-float +#:least-negative-short-float +#:least-negative-single-float +#:least-positive-double-float +#:least-positive-long-float +#:least-positive-normalized-double-float +#:least-positive-normalized-long-float +#:least-positive-normalized-short-float +#:least-positive-normalized-single-float +#:least-positive-short-float +#:least-positive-single-float +#:length +#:let +#:let* +#:lisp-implementation-type +#:lisp-implementation-version +#:list +#:list* +#:list-all-packages +#:list-length +#:listen +#:listp +#:load +#:load-logical-pathname-translations +#:load-time-value +#:locally +#:log +#:logand +#:logandc1 +#:logandc2 +#:logbitp +#:logcount +#:logeqv +#:logical-pathname +#:logical-pathname-translations +#:logior +#:lognand +#:lognor +#:lognot +#:logorc1 +#:logorc2 +#:logtest +#:logxor +#:long-float +#:long-float-epsilon +#:long-float-negative-epsilon +#:long-site-name +#:loop +#:loop-finish +#:lower-case-p +#:machine-instance +#:machine-type +#:machine-version +#:macro-function +#:macroexpand +#:macroexpand-1 +#:macrolet +#:make-array +#:make-broadcast-stream +#:make-concatenated-stream +#:make-condition +#:make-dispatch-macro-character +#:make-echo-stream +#:make-hash-table +#:make-instance +#:make-instances-obsolete +#:make-list +#:make-load-form +#:make-load-form-saving-slots +#:make-method +#:make-package +#:make-pathname +#:make-random-state +#:make-sequence +#:make-string +#:make-string-input-stream +#:make-string-output-stream +#:make-symbol +#:make-synonym-stream +#:make-two-way-stream +#:makunbound +#:map +#:map-into +#:mapc +#:mapcan +#:mapcar +#:mapcon +#:maphash +#:mapl +#:maplist +#:mask-field +#:max +#:member +#:member-if +#:member-if-not +#:merge +#:merge-pathnames +#:method +#:method-combination +#:method-combination-error +#:method-qualifiers +#:min +#:minusp +#:mismatch +#:mod +#:most-negative-double-float +#:most-negative-fixnum +#:most-negative-long-float +#:most-negative-short-float +#:most-negative-single-float +#:most-positive-double-float +#:most-positive-fixnum +#:most-positive-long-float +#:most-positive-short-float +#:most-positive-single-float +#:muffle-warning +#:multiple-value-bind +#:multiple-value-call +#:multiple-value-list +#:multiple-value-prog1 +#:multiple-value-setq +#:multiple-values-limit +#:name-char +#:namestring +#:nbutlast +#:nconc +#:next-method-p +#:nil +#:nintersection +#:ninth +#:no-applicable-method +#:no-next-method +#:not +#:notany +#:notevery +#:notinline +#:nreconc +#:nreverse +#:nset-difference +#:nset-exclusive-or +#:nstring-capitalize +#:nstring-downcase +#:nstring-upcase +#:nsublis +#:nsubst +#:nsubst-if +#:nsubst-if-not +#:nsubstitute +#:nsubstitute-if +#:nsubstitute-if-not +#:nth +#:nth-value +#:nthcdr +#:null +#:number +#:numberp +#:numerator +#:nunion +#:oddp +#:open +#:open-stream-p +#:optimize +#:or +#:otherwise +#:output-stream-p +#:package +#:package-error +#:package-error-package +#:package-name +#:package-nicknames +#:package-shadowing-symbols +#:package-use-list +#:package-used-by-list +#:packagep +#:pairlis +#:parse-error +#:parse-integer +#:parse-namestring +#:pathname +#:pathname-device +#:pathname-directory +#:pathname-host +#:pathname-match-p +#:pathname-name +#:pathname-type +#:pathname-version +#:pathnamep +#:peek-char +#:phase +#:pi +#:plusp +#:pop +#:position +#:position-if +#:position-if-not +#:pprint +#:pprint-dispatch +#:pprint-exit-if-list-exhausted +#:pprint-fill +#:pprint-indent +#:pprint-linear +#:pprint-logical-block +#:pprint-newline +#:pprint-pop +#:pprint-tab +#:pprint-tabular +#:prin1 +#:prin1-to-string +#:princ +#:princ-to-string +#:print +#:print-not-readable +#:print-not-readable-object +#:print-object +#:print-unreadable-object +#:probe-file +#:proclaim +#:prog +#:prog* +#:prog1 +#:prog2 +#:progn +#:program-error +#:progv +#:provide +#:psetf +#:psetq +#:push +#:pushnew +#:quote +#:random +#:random-state +#:random-state-p +#:rassoc +#:rassoc-if +#:rassoc-if-not +#:ratio +#:rational +#:rationalize +#:rationalp +#:read +#:read-byte +#:read-char +#:read-char-no-hang +#:read-delimited-list +#:read-from-string +#:read-line +#:read-preserving-whitespace +#:read-sequence +#:reader-error +#:readtable +#:readtable-case +#:readtablep +#:real +#:realp +#:realpart +#:reduce +#:reinitialize-instance +#:rem +#:remf +#:remhash +#:remove +#:remove-duplicates +#:remove-if +#:remove-if-not +#:remove-method +#:remprop +#:rename-file +#:rename-package +#:replace +#:require +#:rest +#:restart +#:restart-bind +#:restart-case +#:restart-name +#:return +#:return-from +#:revappend +#:reverse +#:room +#:rotatef +#:round +#:row-major-aref +#:rplaca +#:rplacd +#:safety +#:satisfies +#:sbit +#:scale-float +#:schar +#:search +#:second +#:sequence +#:serious-condition +#:set +#:set-difference +#:set-dispatch-macro-character +#:set-exclusive-or +#:set-macro-character +#:set-pprint-dispatch +#:set-syntax-from-char +#:setf +#:setq +#:seventh +#:shadow +#:shadowing-import +#:shared-initialize +#:shiftf +#:short-float +#:short-float-epsilon +#:short-float-negative-epsilon +#:short-site-name +#:signal +#:signed-byte +#:signum +#:simple-array +#:simple-base-string +#:simple-bit-vector +#:simple-bit-vector-p +#:simple-condition +#:simple-condition-format-arguments +#:simple-condition-format-control +#:simple-error +#:simple-string +#:simple-string-p +#:simple-type-error +#:simple-vector +#:simple-vector-p +#:simple-warning +#:sin +#:single-float +#:single-float-epsilon +#:single-float-negative-epsilon +#:sinh +#:sixth +#:sleep +#:slot-boundp +#:slot-exists-p +#:slot-makunbound +#:slot-missing +#:slot-unbound +#:slot-value +#:software-type +#:software-version +#:some +#:sort +#:space +#:special +#:special-operator-p +#:speed +#:sqrt +#:stable-sort +#:standard +#:standard-char +#:standard-char-p +#:standard-class +#:standard-generic-function +#:standard-method +#:standard-object +#:step +#:storage-condition +#:store-value +#:stream +#:stream-element-type +#:stream-error +#:stream-error-stream +#:stream-external-format +#:streamp +#:string +#:string-capitalize +#:string-downcase +#:string-equal +#:string-greaterp +#:string-left-trim +#:string-lessp +#:string-not-equal +#:string-not-greaterp +#:string-not-lessp +#:string-right-trim +#:string-stream +#:string-trim +#:string-upcase +#:string/= +#:string< +#:string<= +#:string= +#:string> +#:string>= +#:stringp +#:structure +#:structure-class +#:structure-object +#:style-warning +#:sublis +#:subseq +#:subsetp +#:subst +#:subst-if +#:subst-if-not +#:substitute +#:substitute-if +#:substitute-if-not +#:subtypep +#:svref +#:sxhash +#:symbol +#:symbol-function +#:symbol-macrolet +#:symbol-name +#:symbol-package +#:symbol-plist +#:symbol-value +#:symbolp +#:synonym-stream +#:synonym-stream-symbol +#:t +#:tagbody +#:tailp +#:tan +#:tanh +#:tenth +#:terpri +#:the +#:third +#:throw +#:time +#:trace +#:translate-logical-pathname +#:translate-pathname +#:tree-equal +#:truename +#:truncate +#:two-way-stream +#:two-way-stream-input-stream +#:two-way-stream-output-stream +#:type +#:type-error +#:type-error-datum +#:type-error-expected-type +#:type-of +#:typecase +#:typep +#:unbound-slot +#:unbound-slot-instance +#:unbound-variable +#:undefined-function +#:unexport +#:unintern +#:union +#:unless +#:unread-char +#:unsigned-byte +#:untrace +#:unuse-package +#:unwind-protect +#:update-instance-for-different-class +#:update-instance-for-redefined-class +#:upgraded-array-element-type +#:upgraded-complex-part-type +#:upper-case-p +#:use-package +#:use-value +#:user-homedir-pathname +#:values +#:values-list +#:variable +#:vector +#:vector-pop +#:vector-push +#:vector-push-extend +#:vectorp +#:warn +#:warning +#:when +#:wild-pathname-p +#:with-accessors +#:with-compilation-unit +#:with-condition-restarts +#:with-hash-table-iterator +#:with-input-from-string +#:with-open-file +#:with-open-stream +#:with-output-to-string +#:with-package-iterator +#:with-simple-restart +#:with-slots +#:with-standard-io-syntax +#:write +#:write-byte +#:write-char +#:write-line +#:write-sequence +#:write-string +#:write-to-string +#:y-or-n-p +#:yes-or-no-p +#:zerop))) + +(defparameter *cl-symbols* + (let ((pkg (find-package :common-lisp))) + (mapcar #'(lambda (str) (intern str pkg)) + *cl-symbol-names*))) + +;;; Symbols classified by their kind in the spec +(defparameter *cl-function-symbols* + '( + * + + + - + / + /= + 1+ + 1- + < + <= + = + > + >= + abort + abs + acons + acos + acosh + adjoin + adjust-array + adjustable-array-p + alpha-char-p + alphanumericp + append + apply + apropos + apropos-list + arithmetic-error-operands + arithmetic-error-operation + array-dimension + array-dimensions + array-displacement + array-element-type + array-has-fill-pointer-p + array-in-bounds-p + array-rank + array-row-major-index + array-total-size + arrayp + ash + asin + asinh + assoc-if-not + assoc + assoc-if + atan + atanh + atom + bit-and + bit-andc1 + bit-andc2 + bit-eqv + bit-ior + bit-nand + bit-nor + bit-not + bit-orc1 + bit-orc2 + bit-vector-p + bit-xor + boole + both-case-p + boundp + break + broadcast-stream-streams + butlast + byte + byte-position + byte-size + ceiling + cell-error-name + cerror + char-code + char-downcase + char-equal + char-greaterp + char-int + char-lessp + char-name + char-not-equal + char-not-greaterp + char-not-lessp + char-upcase + char/= + char< + char<= + char= + char> + char>= + character + characterp + cis + class-of + clear-input + clear-output + close + clrhash + code-char + coerce + compile + compile-file + compile-file-pathname + compiled-function-p + complement + complex + complexp + compute-restarts + concatenate + concatenated-stream-streams + conjugate + cons + consp + constantly + constantp + continue + copy-alist + copy-list + copy-pprint-dispatch + copy-readtable + copy-seq + copy-structure + copy-symbol + copy-tree + cos + cosh + count + count-if + count-if-not + decode-float + decode-universal-time + delete + delete-duplicates + delete-file + delete-if + delete-if-not + delete-package + denominator + deposit-field + describe + digit-char + digit-char-p + directory + directory-namestring + disassemble + dpb + dribble + echo-stream-input-stream + echo-stream-output-stream + ;;; The function ED is commented out because an implementation + ;;; needn't provide this function. + ;; ed + encode-universal-time + endp + enough-namestring + ensure-directories-exist + ensure-generic-function + eq + eql + equal + equalp + error + eval + evenp + every + exp + export + expt + fboundp + fceiling + ffloor + file-author + file-error-pathname + file-length + file-namestring + file-position + file-write-date + find + find-all-symbols + find-if + find-if-not + find-package + find-restart + find-symbol + finish-output + float + float-digits + float-precision + float-radix + float-sign + floatp + floor + fmakunbound + force-output + format + fresh-line + fround + funcall + function-lambda-expression + functionp + gcd + gensym + gentemp + get-decoded-time + get-dispatch-macro-character + get-internal-real-time + get-internal-run-time + get-macro-character + get-output-stream-string + get-properties + get-setf-expansion + get-universal-time + graphic-char-p + hash-table-count + hash-table-p + hash-table-rehash-size + hash-table-rehash-threshold + hash-table-size + hash-table-test + host-namestring + identity + imagpart + import + input-stream-p + inspect + integer-decode-float + integer-length + integerp + interactive-stream-p + intern + intersection + invalid-method-error + invoke-debugger + invoke-restart + invoke-restart-interactively + isqrt + keywordp + last + lcm + ldb-test + ldiff + length + lisp-implementation-type + lisp-implementation-version + list + list* + list-all-packages + list-length + listen + listp + load + load-logical-pathname-translations + log + logand + logandc1 + logandc2 + logbitp + logcount + logeqv + logical-pathname + logior + lognand + lognor + lognot + logorc1 + logorc2 + logtest + logxor + long-site-name + lower-case-p + machine-instance + machine-type + machine-version + macroexpand + macroexpand-1 + make-array + make-broadcast-stream + make-concatenated-stream + make-condition + make-dispatch-macro-character + make-echo-stream + make-hash-table + make-list + make-load-form-saving-slots + make-package + make-pathname + make-random-state + make-sequence + make-string + make-string-input-stream + make-string-output-stream + make-symbol + make-synonym-stream + make-two-way-stream + makunbound + map + map-into + mapc + mapcan + mapcar + mapcon + maphash + mapl + maplist + max + member + member-if + member-if-not + merge + merge-pathnames + method-combination-error + min + minusp + mismatch + mod + muffle-warning + name-char + namestring + nbutlast + nconc + nintersection + not + notany + notevery + nreconc + nreverse + nset-difference + nset-exclusive-or + nstring-capitalize + nstring-downcase + nstring-upcase + nsublis + nsubst + nsubst-if + nsubst-if-not + nsubstitute + nsubstitute-if + nsubstitute-if-not + nthcdr + null + numberp + numerator + nunion + oddp + open + open-stream-p + output-stream-p + package-error-package + package-name + package-nicknames + package-shadowing-symbols + package-use-list + package-used-by-list + packagep + pairlis + parse-integer + parse-namestring + pathname + pathname-device + pathname-directory + pathname-host + pathname-match-p + pathname-name + pathname-type + pathname-version + pathnamep + peek-char + phase + plusp + position + position-if + position-if-not + pprint + pprint-dispatch + pprint-fill + pprint-indent + pprint-linear + pprint-newline + pprint-tab + pprint-tabular + prin1 + prin1-to-string + princ + princ-to-string + print + print-not-readable-object + probe-file + proclaim + provide + random-state-p + rassoc + rassoc-if + rassoc-if-not + rational + rationalize + rationalp + read + read-byte + read-char + read-char-no-hang + read-delimited-list + read-from-string + read-line + read-preserving-whitespace + read-sequence + readtablep + realp + realpart + reduce + rem + remhash + remove + remove-duplicates + remove-if + remove-if-not + remprop + rename-file + rename-package + replace + require + restart-name + revappend + reverse + room + round + rplaca + rplacd + scale-float + search + set + set-difference + set-dispatch-macro-character + set-exclusive-or + set-macro-character + set-pprint-dispatch + set-syntax-from-char + shadow + shadowing-import + short-site-name + signal + signum + simple-bit-vector-p + simple-condition-format-arguments + simple-condition-format-control + simple-string-p + simple-vector-p + sin + sinh + slot-exists-p + sleep + slot-boundp + slot-makunbound + slot-value + software-type + software-version + some + sort + special-operator-p + sqrt + stable-sort + standard-char-p + store-value + stream-element-type + stream-error-stream + stream-external-format + streamp + string + string-capitalize + string-downcase + string-equal + string-greaterp + string-left-trim + string-lessp + string-not-equal + string-not-greaterp + string-not-lessp + string-right-trim + string-trim + string-upcase + string/= + string< + string<= + string= + string> + string>= + stringp + sublis + subsetp + subst + subst-if + subst-if-not + substitute + substitute-if + substitute-if-not + subtypep + sxhash + symbol-name + symbol-package + symbolp + synonym-stream-symbol + tailp + tan + tanh + terpri + translate-logical-pathname + translate-pathname + tree-equal + truename + truncate ftruncate + two-way-stream-input-stream + two-way-stream-output-stream + type-error-datum + type-error-expected-type + type-of + typep + unbound-slot-instance + unexport + unintern + union + unread-char + unuse-package + upgraded-array-element-type + upgraded-complex-part-type + upper-case-p + use-package + use-value + user-homedir-pathname + values-list + vector + vector-pop + vector-push + vector-push-extend + vectorp + warn + wild-pathname-p + write + write-byte + write-char + write-line + write-sequence + write-string + write-to-string + y-or-n-p + yes-or-no-p + zerop + )) + +(defparameter *cl-variable-symbols* + '( + * + ** + *** + *break-on-signals* + *compile-file-pathname* + *compile-file-truename* + *compile-print* + *compile-verbose* + *debug-io* + *debugger-hook* + *default-pathname-defaults* + *error-output* + *features* + *gensym-counter* + *load-pathname* + *load-print* + *load-truename* + *load-verbose* + *macroexpand-hook* + *modules* + *package* + *print-array* + *print-base* + *print-case* + *print-circle* + *print-escape* + *print-gensym* + *print-length* + *print-level* + *print-lines* + *print-miser-width* + *print-pprint-dispatch* + *print-pretty* + *print-radix* + *print-readably* + *print-right-margin* + *query-io* + *random-state* + *read-base* + *read-default-float-format* + *read-eval* + *read-suppress* + *readtable* + *standard-input* + *standard-output* + *terminal-io* + *trace-output* + + + ++ + +++ + / + // + /// + - + )) + +(defparameter *cl-constant-symbols* + '( + array-dimension-limit + array-rank-limit + array-total-size-limit + boole-1 + boole-2 + boole-and + boole-andc1 + boole-andc2 + boole-c1 + boole-c2 + boole-clr + boole-eqv + boole-ior + boole-nand + boole-nor + boole-orc1 + boole-orc2 + boole-set + boole-xor + call-arguments-limit + char-code-limit + double-float-epsilon + double-float-negative-epsilon + internal-time-units-per-second + lambda-list-keywords + lambda-parameters-limit + least-negative-double-float + least-negative-long-float + least-negative-normalized-double-float + least-negative-normalized-long-float + least-negative-normalized-short-float + least-negative-normalized-single-float + least-negative-short-float + least-negative-single-float + least-positive-double-float + least-positive-long-float + least-positive-normalized-double-float + least-positive-normalized-long-float + least-positive-normalized-short-float + least-positive-normalized-single-float + least-positive-short-float + least-positive-single-float + long-float-epsilon + long-float-negative-epsilon + most-negative-double-float + most-negative-fixnum + most-negative-long-float + most-negative-short-float + most-negative-single-float + most-positive-double-float + most-positive-fixnum + most-positive-long-float + most-positive-short-float + most-positive-single-float + multiple-values-limit + nil + pi + short-float-epsilon + short-float-negative-epsilon + single-float-epsilon + single-float-negative-epsilon + t + )) + +(defparameter *cl-macro-symbols* + '( + and + assert + case + ccase + ecase + check-type + cond + declaim + defclass + defconstant + defgeneric + define-compiler-macro + define-condition + define-method-combination + define-modify-macro + define-setf-expander + define-symbol-macro + defmacro + defmethod + defpackage + defparameter + defvar + defsetf + defstruct + deftype + defun + destructuring-bind + do + do* + do-symbols + do-external-symbols + do-all-symbols + dolist + dotimes + formatter + handler-bind + handler-case + ignore-errors + in-package + incf + decf + lambda + loop + multiple-value-bind + multiple-value-list + multiple-value-setq + nth-value + or + pop + pprint-logical-block + print-unreadable-object + prog + prog* + prog1 + prog2 + psetq + push + pushnew + remf + restart-bind + restart-case + return + rotatef + setf + psetf + shiftf + step + time + trace + untrace + typecase + ctypecase + etypecase + when + unless + with-accessors + with-compilation-unit + with-condition-restarts + with-hash-table-iterator + with-input-from-string + with-open-file + with-open-stream + with-output-to-string + with-package-iterator + with-simple-restart + with-slots + with-standard-io-syntax + )) + +(defparameter *cl-accessor-symbols* + '( + aref + bit + caaaar + caaadr + caaar + caadar + caaddr + caadr + caar + cadaar + cadadr + cadar + caddar + cadddr + caddr + cadr + car + cdaaar + cdaadr + cdaar + cdadar + cdaddr + cdadr + cdar + cddaar + cddadr + cddar + cdddar + cddddr + cdddr + cddr + cdr + char + compiler-macro-function + eighth + elt + fdefinition + fifth + fill-pointer + find-class + first + fourth + get + getf + gethash + ldb + logical-pathname-translations + macro-function + mask-field + ninth + nth + readtable-case + rest + row-major-aref + sbit + schar + second + seventh + sixth + subseq + svref + symbol-function + symbol-plist + symbol-value + tenth + third + values + )) + +(defparameter *cl-condition-type-symbols* + '( + arithmetic-error + cell-error + condition + control-error + division-by-zero + end-of-file + error + file-error + floating-point-inexact + floating-point-invalid-operation + floating-point-overflow + floating-point-underflow + package-error + parse-error + print-not-readable + program-error + reader-error + serious-condition + simple-condition + simple-error + simple-type-error + simple-warning + storage-condition + stream-error + style-warning + type-error + unbound-slot + unbound-variable + undefined-function + warning + )) + +(defparameter *cl-class-symbols* + '(standard-object structure-object)) + +(defparameter *cl-declaration-symbols* + '( + declaration + dynamic-extent + ftype + ignore + ignorable + inline + notinline + optimize + special + type)) + +(defparameter *cl-local-function-symbols* + '(call-next-method next-method-p)) + +(defparameter *cl-local-macro-symbols* + '( + call-method + make-method + loop-finish + pprint-exit-if-list-exhausted + pprint-pop + )) + +(defparameter *cl-special-operator-symbols* + '( + block + catch + eval-when + flet + function + go + if + labels + let + let* + load-time-value + locally + macrolet + multiple-value-call + multiple-value-prog1 + progn + progv + quote + return-from + setq + symbol-macrolet + tagbody + the + throw + unwind-protect +)) + +(defparameter *cl-standard-generic-function-symbols* + '( + add-method + allocate-instance + change-class + class-name + compute-applicable-methods + describe-object + documentation + find-method + function-keywords + initialize-instance + make-instance + make-instances-obsolete + make-load-form + method-qualifiers + no-applicable-method + no-next-method + print-object + reinitialize-instance + remove-method + shared-initialize + slot-missing + slot-unbound + update-instance-for-different-class + update-instance-for-redefined-class + )) + +(defparameter *cl-system-class-symbols* + '( + array + bit-vector + broadcast-stream + built-in-class + character + class + complex + concatenated-stream + cons + echo-stream + file-stream + float + function + generic-function + hash-table + integer + list + logical-pathname + method + method-combination + null + number + package + pathname + random-state + ratio + rational + readtable + real + restart + sequence + standard-class + standard-generic-function + standard-method + stream + string + string-stream + structure-class + symbol + synonym-stream + t + two-way-stream + vector + )) + +(defparameter *cl-type-symbols* + '( + atom + base-char + base-string + bignum + bit + boolean + compiled-function + extended-char + fixnum + keyword + nil + short-float + single-float + double-float + long-float + signed-byte + simple-array + simple-base-string + simple-bit-vector + simple-string + simple-vector + standard-char + unsigned-byte + )) + +(defparameter *cl-type-specifier-symbols* + '( + and + eql + member + mod + not + or + satisfies + values + )) + +(defparameter *cl-restart-symbols* + '( + abort + continue + muffle-warning + store-value + use-value + )) + +;;; Symbols that are names of types that are also classes +;;; See figure 4-8 in section 4.3.7 +(defparameter *cl-types-that-are-classes-symbols* + '( + arithmetic-error + array + bit-vector + broadcast-stream + built-in-class + cell-error + character + class + complex + concatenated-stream + condition + cons + control-error + division-by-zero + echo-stream + end-of-file + error + file-error + file-stream + float + floating-point-inexact + floating-point-invalid-operation + floating-point-overflow + floating-point-underflow + function + generic-function + hash-table + integer + list + logical-pathname + method + method-combination + null + number + package + package-error + parse-error + pathname + print-not-readable + program-error + random-state + ratio + rational + reader-error + readtable + real + restart + sequence + serious-condition + simple-condition + simple-error + simple-type-error + simple-warning + standard-class + standard-generic-function + standard-method + standard-object + storage-condition + stream + stream-error + string + string-stream + structure-class + structure-object + style-warning + symbol + synonym-stream + t + two-way-stream + type-error + unbound-slot + unbound-variable + undefined-function + vector + warning + )) + +(defparameter *cl-all-type-symbols* + (reduce #'union + (list *cl-type-symbols* *cl-types-that-are-classes-symbols* + *cl-system-class-symbols* *cl-class-symbols* + *cl-condition-type-symbols*))) + +(defparameter *cl-non-function-macro-special-operator-symbols* + (set-difference + *cl-symbols* + (reduce #'union + (list *cl-function-symbols* + *cl-macro-symbols* + *cl-accessor-symbols* + *cl-local-function-symbols* + *cl-local-macro-symbols* + *cl-special-operator-symbols* + *cl-standard-generic-function-symbols* + '(declare))))) + +(defparameter *cl-function-or-accessor-symbols* + (append *cl-function-symbols* *cl-accessor-symbols*)) + +(defparameter *cl-non-variable-constant-symbols* + (set-difference + *cl-symbols* + (union *cl-variable-symbols* + *cl-constant-symbols*))) diff --git a/ansi-tests/cl-symbols-aux.lsp b/ansi-tests/cl-symbols-aux.lsp new file mode 100644 index 0000000..542fe9c --- /dev/null +++ b/ansi-tests/cl-symbols-aux.lsp @@ -0,0 +1,43 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Nov 28 06:43:51 2002 +;;;; Contains: Aux. functions for cl-symbols.lsp + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +(defun is-external-symbol-of (sym package) + (multiple-value-bind (sym2 status) + (find-symbol (symbol-name sym) package) + (and (eqt sym sym2) + (eqt status :external)))) + +(defun test-if-not-in-cl-package (str) + (multiple-value-bind (sym status) + (find-symbol #+lower-case str #-lower-case (string-upcase str) 'common-lisp) + (or + ;; Symbol not present in the common lisp package + (not status) + ;; Check if it has any properties whose indicators are + ;; external in any of the standard packages or are accessible + ;; in CL-USER + (and (eqt status :external) + (let ((plist (symbol-plist sym))) + (loop for e = plist then (cddr e) + while e + for indicator = (car e) + when (and (symbolp indicator) + (or (is-external-symbol-of indicator + "COMMON-LISP") + (is-external-symbol-of indicator "KEYWORD") + (eqt indicator (find-symbol + (symbol-name indicator) + "COMMON-LISP-USER")))) + collect indicator)))))) + +(defun safe-symbol-name (sym) + (catch-type-error (symbol-name sym))) + +(defun safe-make-symbol (name) + (catch-type-error (make-symbol name))) diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp new file mode 100644 index 0000000..7b2c0a3 --- /dev/null +++ b/ansi-tests/cl-symbols.lsp @@ -0,0 +1,1587 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Mar 15 13:19:57 1998 +;;;; Contains: Test presence of symbols in the CL package, +;;;; and symbol-related functions + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;; Test for the presence of every darned symbol +;;; the standard says should be in the CL package. +;;; Also, test that they have no prohibited plist indicators (section 11.1.2.1.1) + +(deftest symbol-&allow-other-keys (test-if-not-in-cl-package "&allow-other-keys") nil) +(deftest symbol-&aux (test-if-not-in-cl-package "&aux") nil) +(deftest symbol-&body (test-if-not-in-cl-package "&body") nil) +(deftest symbol-&environment (test-if-not-in-cl-package "&environment") nil) +(deftest symbol-&key (test-if-not-in-cl-package "&key") nil) +(deftest symbol-&optional (test-if-not-in-cl-package "&optional") nil) +(deftest symbol-&rest (test-if-not-in-cl-package "&rest") nil) +(deftest symbol-&whole (test-if-not-in-cl-package "&whole") nil) +(deftest symbol-* (test-if-not-in-cl-package "*") nil) +(deftest symbol-** (test-if-not-in-cl-package "**") nil) +(deftest symbol-*** (test-if-not-in-cl-package "***") nil) +(deftest symbol-*break-on-signals* (test-if-not-in-cl-package "*break-on-signals*") nil) +(deftest symbol-*compile-file-pathname* (test-if-not-in-cl-package "*compile-file-pathname*") nil) +(deftest symbol-*compile-file-truename* (test-if-not-in-cl-package "*compile-file-truename*") nil) +(deftest symbol-*compile-print* (test-if-not-in-cl-package "*compile-print*") nil) +(deftest symbol-*compile-verbose* (test-if-not-in-cl-package "*compile-verbose*") nil) +(deftest symbol-*debug-io* (test-if-not-in-cl-package "*debug-io*") nil) +(deftest symbol-*debugger-hook* (test-if-not-in-cl-package "*debugger-hook*") nil) +(deftest symbol-*default-pathname-defaults* (test-if-not-in-cl-package "*default-pathname-defaults*") nil) +(deftest symbol-*error-output* (test-if-not-in-cl-package "*error-output*") nil) +(deftest symbol-*features* (test-if-not-in-cl-package "*features*") nil) +(deftest symbol-*gensym-counter* (test-if-not-in-cl-package "*gensym-counter*") nil) +(deftest symbol-*load-pathname* (test-if-not-in-cl-package "*load-pathname*") nil) +(deftest symbol-*load-print* (test-if-not-in-cl-package "*load-print*") nil) +(deftest symbol-*load-truename* (test-if-not-in-cl-package "*load-truename*") nil) +(deftest symbol-*load-verbose* (test-if-not-in-cl-package "*load-verbose*") nil) +(deftest symbol-*macroexpand-hook* (test-if-not-in-cl-package "*macroexpand-hook*") nil) +(deftest symbol-*modules* (test-if-not-in-cl-package "*modules*") nil) +(deftest symbol-*package* (test-if-not-in-cl-package "*package*") nil) +(deftest symbol-*print-array* (test-if-not-in-cl-package "*print-array*") nil) +(deftest symbol-*print-base* (test-if-not-in-cl-package "*print-base*") nil) +(deftest symbol-*print-case* (test-if-not-in-cl-package "*print-case*") nil) +(deftest symbol-*print-circle* (test-if-not-in-cl-package "*print-circle*") nil) +(deftest symbol-*print-escape* (test-if-not-in-cl-package "*print-escape*") nil) +(deftest symbol-*print-gensym* (test-if-not-in-cl-package "*print-gensym*") nil) +(deftest symbol-*print-length* (test-if-not-in-cl-package "*print-length*") nil) +(deftest symbol-*print-level* (test-if-not-in-cl-package "*print-level*") nil) +(deftest symbol-*print-lines* (test-if-not-in-cl-package "*print-lines*") nil) +(deftest symbol-*print-miser-width* (test-if-not-in-cl-package "*print-miser-width*") nil) +(deftest symbol-*print-pprint-dispatch* (test-if-not-in-cl-package "*print-pprint-dispatch*") nil) +(deftest symbol-*print-pretty* (test-if-not-in-cl-package "*print-pretty*") nil) +(deftest symbol-*print-radix* (test-if-not-in-cl-package "*print-radix*") nil) +(deftest symbol-*print-readably* (test-if-not-in-cl-package "*print-readably*") nil) +(deftest symbol-*print-right-margin* (test-if-not-in-cl-package "*print-right-margin*") nil) +(deftest symbol-*query-io* (test-if-not-in-cl-package "*query-io*") nil) +(deftest symbol-*random-state* (test-if-not-in-cl-package "*random-state*") nil) +(deftest symbol-*read-base* (test-if-not-in-cl-package "*read-base*") nil) +(deftest symbol-*read-default-float-format* (test-if-not-in-cl-package "*read-default-float-format*") nil) +(deftest symbol-*read-eval* (test-if-not-in-cl-package "*read-eval*") nil) +(deftest symbol-*read-suppress* (test-if-not-in-cl-package "*read-suppress*") nil) +(deftest symbol-*readtable* (test-if-not-in-cl-package "*readtable*") nil) +(deftest symbol-*standard-input* (test-if-not-in-cl-package "*standard-input*") nil) +(deftest symbol-*standard-output* (test-if-not-in-cl-package "*standard-output*") nil) +(deftest symbol-*terminal-io* (test-if-not-in-cl-package "*terminal-io*") nil) +(deftest symbol-*trace-output* (test-if-not-in-cl-package "*trace-output*") nil) +(deftest symbol-+ (test-if-not-in-cl-package "+") nil) +(deftest symbol-++ (test-if-not-in-cl-package "++") nil) +(deftest symbol-+++ (test-if-not-in-cl-package "+++") nil) +(deftest symbol-- (test-if-not-in-cl-package "-") nil) +(deftest symbol-/ (test-if-not-in-cl-package "/") nil) +(deftest symbol-// (test-if-not-in-cl-package "//") nil) +(deftest symbol-/// (test-if-not-in-cl-package "///") nil) +(deftest symbol-/= (test-if-not-in-cl-package "/=") nil) +(deftest symbol-1+ (test-if-not-in-cl-package "1+") nil) +(deftest symbol-1- (test-if-not-in-cl-package "1-") nil) +(deftest symbol-< (test-if-not-in-cl-package "<") nil) +(deftest symbol-<= (test-if-not-in-cl-package "<=") nil) +(deftest symbol-= (test-if-not-in-cl-package "=") nil) +(deftest symbol-> (test-if-not-in-cl-package ">") nil) +(deftest symbol->= (test-if-not-in-cl-package ">=") nil) +(deftest symbol-abort (test-if-not-in-cl-package "abort") nil) +(deftest symbol-abs (test-if-not-in-cl-package "abs") nil) +(deftest symbol-acons (test-if-not-in-cl-package "acons") nil) +(deftest symbol-acos (test-if-not-in-cl-package "acos") nil) +(deftest symbol-acosh (test-if-not-in-cl-package "acosh") nil) +(deftest symbol-add-method (test-if-not-in-cl-package "add-method") nil) +(deftest symbol-adjoin (test-if-not-in-cl-package "adjoin") nil) +(deftest symbol-adjust-array (test-if-not-in-cl-package "adjust-array") nil) +(deftest symbol-adjustable-array-p (test-if-not-in-cl-package "adjustable-array-p") nil) +(deftest symbol-allocate-instance (test-if-not-in-cl-package "allocate-instance") nil) +(deftest symbol-alpha-char-p (test-if-not-in-cl-package "alpha-char-p") nil) +(deftest symbol-alphanumericp (test-if-not-in-cl-package "alphanumericp") nil) +(deftest symbol-and (test-if-not-in-cl-package "and") nil) +(deftest symbol-append (test-if-not-in-cl-package "append") nil) +(deftest symbol-apply (test-if-not-in-cl-package "apply") nil) +(deftest symbol-apropos (test-if-not-in-cl-package "apropos") nil) +(deftest symbol-apropos-list (test-if-not-in-cl-package "apropos-list") nil) +(deftest symbol-aref (test-if-not-in-cl-package "aref") nil) +(deftest symbol-arithmetic-error (test-if-not-in-cl-package "arithmetic-error") nil) +(deftest symbol-arithmetic-error-operands (test-if-not-in-cl-package "arithmetic-error-operands") nil) +(deftest symbol-arithmetic-error-operation (test-if-not-in-cl-package "arithmetic-error-operation") nil) +(deftest symbol-array (test-if-not-in-cl-package "array") nil) +(deftest symbol-array-dimension (test-if-not-in-cl-package "array-dimension") nil) +(deftest symbol-array-dimension-limit (test-if-not-in-cl-package "array-dimension-limit") nil) +(deftest symbol-array-dimensions (test-if-not-in-cl-package "array-dimensions") nil) +(deftest symbol-array-displacement (test-if-not-in-cl-package "array-displacement") nil) +(deftest symbol-array-element-type (test-if-not-in-cl-package "array-element-type") nil) +(deftest symbol-array-has-fill-pointer-p (test-if-not-in-cl-package "array-has-fill-pointer-p") nil) +(deftest symbol-array-in-bounds-p (test-if-not-in-cl-package "array-in-bounds-p") nil) +(deftest symbol-array-rank (test-if-not-in-cl-package "array-rank") nil) +(deftest symbol-array-rank-limit (test-if-not-in-cl-package "array-rank-limit") nil) +(deftest symbol-array-row-major-index (test-if-not-in-cl-package "array-row-major-index") nil) +(deftest symbol-array-total-size (test-if-not-in-cl-package "array-total-size") nil) +(deftest symbol-array-total-size-limit (test-if-not-in-cl-package "array-total-size-limit") nil) +(deftest symbol-arrayp (test-if-not-in-cl-package "arrayp") nil) +(deftest symbol-ash (test-if-not-in-cl-package "ash") nil) +(deftest symbol-asin (test-if-not-in-cl-package "asin") nil) +(deftest symbol-asinh (test-if-not-in-cl-package "asinh") nil) +(deftest symbol-assert (test-if-not-in-cl-package "assert") nil) +(deftest symbol-assoc (test-if-not-in-cl-package "assoc") nil) +(deftest symbol-assoc-if (test-if-not-in-cl-package "assoc-if") nil) +(deftest symbol-assoc-if-not (test-if-not-in-cl-package "assoc-if-not") nil) +(deftest symbol-atan (test-if-not-in-cl-package "atan") nil) +(deftest symbol-atanh (test-if-not-in-cl-package "atanh") nil) +(deftest symbol-atom (test-if-not-in-cl-package "atom") nil) +(deftest symbol-base-char (test-if-not-in-cl-package "base-char") nil) +(deftest symbol-base-string (test-if-not-in-cl-package "base-string") nil) +(deftest symbol-bignum (test-if-not-in-cl-package "bignum") nil) +(deftest symbol-bit (test-if-not-in-cl-package "bit") nil) +(deftest symbol-bit-and (test-if-not-in-cl-package "bit-and") nil) +(deftest symbol-bit-andc1 (test-if-not-in-cl-package "bit-andc1") nil) +(deftest symbol-bit-andc2 (test-if-not-in-cl-package "bit-andc2") nil) +(deftest symbol-bit-eqv (test-if-not-in-cl-package "bit-eqv") nil) +(deftest symbol-bit-ior (test-if-not-in-cl-package "bit-ior") nil) +(deftest symbol-bit-nand (test-if-not-in-cl-package "bit-nand") nil) +(deftest symbol-bit-nor (test-if-not-in-cl-package "bit-nor") nil) +(deftest symbol-bit-not (test-if-not-in-cl-package "bit-not") nil) +(deftest symbol-bit-orc1 (test-if-not-in-cl-package "bit-orc1") nil) +(deftest symbol-bit-orc2 (test-if-not-in-cl-package "bit-orc2") nil) +(deftest symbol-bit-vector (test-if-not-in-cl-package "bit-vector") nil) +(deftest symbol-bit-vector-p (test-if-not-in-cl-package "bit-vector-p") nil) +(deftest symbol-bit-xor (test-if-not-in-cl-package "bit-xor") nil) +(deftest symbol-block (test-if-not-in-cl-package "block") nil) +(deftest symbol-boole (test-if-not-in-cl-package "boole") nil) +(deftest symbol-boole-1 (test-if-not-in-cl-package "boole-1") nil) +(deftest symbol-boole-2 (test-if-not-in-cl-package "boole-2") nil) +(deftest symbol-boole-and (test-if-not-in-cl-package "boole-and") nil) +(deftest symbol-boole-andc1 (test-if-not-in-cl-package "boole-andc1") nil) +(deftest symbol-boole-andc2 (test-if-not-in-cl-package "boole-andc2") nil) +(deftest symbol-boole-c1 (test-if-not-in-cl-package "boole-c1") nil) +(deftest symbol-boole-c2 (test-if-not-in-cl-package "boole-c2") nil) +(deftest symbol-boole-clr (test-if-not-in-cl-package "boole-clr") nil) +(deftest symbol-boole-eqv (test-if-not-in-cl-package "boole-eqv") nil) +(deftest symbol-boole-ior (test-if-not-in-cl-package "boole-ior") nil) +(deftest symbol-boole-nand (test-if-not-in-cl-package "boole-nand") nil) +(deftest symbol-boole-nor (test-if-not-in-cl-package "boole-nor") nil) +(deftest symbol-boole-orc1 (test-if-not-in-cl-package "boole-orc1") nil) +(deftest symbol-boole-orc2 (test-if-not-in-cl-package "boole-orc2") nil) +(deftest symbol-boole-set (test-if-not-in-cl-package "boole-set") nil) +(deftest symbol-boole-xor (test-if-not-in-cl-package "boole-xor") nil) +(deftest symbol-boolean (test-if-not-in-cl-package "boolean") nil) +(deftest symbol-both-case-p (test-if-not-in-cl-package "both-case-p") nil) +(deftest symbol-boundp (test-if-not-in-cl-package "boundp") nil) +(deftest symbol-break (test-if-not-in-cl-package "break") nil) +(deftest symbol-broadcast-stream (test-if-not-in-cl-package "broadcast-stream") nil) +(deftest symbol-broadcast-stream-streams (test-if-not-in-cl-package "broadcast-stream-streams") nil) +(deftest symbol-built-in-class (test-if-not-in-cl-package "built-in-class") nil) +(deftest symbol-butlast (test-if-not-in-cl-package "butlast") nil) +(deftest symbol-byte (test-if-not-in-cl-package "byte") nil) +(deftest symbol-byte-position (test-if-not-in-cl-package "byte-position") nil) +(deftest symbol-byte-size (test-if-not-in-cl-package "byte-size") nil) +(deftest symbol-caaaar (test-if-not-in-cl-package "caaaar") nil) +(deftest symbol-caaadr (test-if-not-in-cl-package "caaadr") nil) +(deftest symbol-caaar (test-if-not-in-cl-package "caaar") nil) +(deftest symbol-caadar (test-if-not-in-cl-package "caadar") nil) +(deftest symbol-caaddr (test-if-not-in-cl-package "caaddr") nil) +(deftest symbol-caadr (test-if-not-in-cl-package "caadr") nil) +(deftest symbol-caar (test-if-not-in-cl-package "caar") nil) +(deftest symbol-cadaar (test-if-not-in-cl-package "cadaar") nil) +(deftest symbol-cadadr (test-if-not-in-cl-package "cadadr") nil) +(deftest symbol-cadar (test-if-not-in-cl-package "cadar") nil) +(deftest symbol-caddar (test-if-not-in-cl-package "caddar") nil) +(deftest symbol-cadddr (test-if-not-in-cl-package "cadddr") nil) +(deftest symbol-caddr (test-if-not-in-cl-package "caddr") nil) +(deftest symbol-cadr (test-if-not-in-cl-package "cadr") nil) +(deftest symbol-call-arguments-limit (test-if-not-in-cl-package "call-arguments-limit") nil) +(deftest symbol-call-method (test-if-not-in-cl-package "call-method") nil) +(deftest symbol-call-next-method (test-if-not-in-cl-package "call-next-method") nil) +(deftest symbol-car (test-if-not-in-cl-package "car") nil) +(deftest symbol-case (test-if-not-in-cl-package "case") nil) +(deftest symbol-catch (test-if-not-in-cl-package "catch") nil) +(deftest symbol-ccase (test-if-not-in-cl-package "ccase") nil) +(deftest symbol-cdaaar (test-if-not-in-cl-package "cdaaar") nil) +(deftest symbol-cdaadr (test-if-not-in-cl-package "cdaadr") nil) +(deftest symbol-cdaar (test-if-not-in-cl-package "cdaar") nil) +(deftest symbol-cdadar (test-if-not-in-cl-package "cdadar") nil) +(deftest symbol-cdaddr (test-if-not-in-cl-package "cdaddr") nil) +(deftest symbol-cdadr (test-if-not-in-cl-package "cdadr") nil) +(deftest symbol-cdar (test-if-not-in-cl-package "cdar") nil) +(deftest symbol-cddaar (test-if-not-in-cl-package "cddaar") nil) +(deftest symbol-cddadr (test-if-not-in-cl-package "cddadr") nil) +(deftest symbol-cddar (test-if-not-in-cl-package "cddar") nil) +(deftest symbol-cdddar (test-if-not-in-cl-package "cdddar") nil) +(deftest symbol-cddddr (test-if-not-in-cl-package "cddddr") nil) +(deftest symbol-cdddr (test-if-not-in-cl-package "cdddr") nil) +(deftest symbol-cddr (test-if-not-in-cl-package "cddr") nil) +(deftest symbol-cdr (test-if-not-in-cl-package "cdr") nil) +(deftest symbol-ceiling (test-if-not-in-cl-package "ceiling") nil) +(deftest symbol-cell-error (test-if-not-in-cl-package "cell-error") nil) +(deftest symbol-cell-error-name (test-if-not-in-cl-package "cell-error-name") nil) +(deftest symbol-cerror (test-if-not-in-cl-package "cerror") nil) +(deftest symbol-change-class (test-if-not-in-cl-package "change-class") nil) +(deftest symbol-char (test-if-not-in-cl-package "char") nil) +(deftest symbol-char-code (test-if-not-in-cl-package "char-code") nil) +(deftest symbol-char-code-limit (test-if-not-in-cl-package "char-code-limit") nil) +(deftest symbol-char-downcase (test-if-not-in-cl-package "char-downcase") nil) +(deftest symbol-char-equal (test-if-not-in-cl-package "char-equal") nil) +(deftest symbol-char-greaterp (test-if-not-in-cl-package "char-greaterp") nil) +(deftest symbol-char-int (test-if-not-in-cl-package "char-int") nil) +(deftest symbol-char-lessp (test-if-not-in-cl-package "char-lessp") nil) +(deftest symbol-char-name (test-if-not-in-cl-package "char-name") nil) +(deftest symbol-char-not-equal (test-if-not-in-cl-package "char-not-equal") nil) +(deftest symbol-char-not-greaterp (test-if-not-in-cl-package "char-not-greaterp") nil) +(deftest symbol-char-not-lessp (test-if-not-in-cl-package "char-not-lessp") nil) +(deftest symbol-char-upcase (test-if-not-in-cl-package "char-upcase") nil) +(deftest symbol-char/= (test-if-not-in-cl-package "char/=") nil) +(deftest symbol-char< (test-if-not-in-cl-package "char<") nil) +(deftest symbol-char<= (test-if-not-in-cl-package "char<=") nil) +(deftest symbol-char= (test-if-not-in-cl-package "char=") nil) +(deftest symbol-char> (test-if-not-in-cl-package "char>") nil) +(deftest symbol-char>= (test-if-not-in-cl-package "char>=") nil) +(deftest symbol-character (test-if-not-in-cl-package "character") nil) +(deftest symbol-characterp (test-if-not-in-cl-package "characterp") nil) +(deftest symbol-check-type (test-if-not-in-cl-package "check-type") nil) +(deftest symbol-cis (test-if-not-in-cl-package "cis") nil) +(deftest symbol-class (test-if-not-in-cl-package "class") nil) +(deftest symbol-class-name (test-if-not-in-cl-package "class-name") nil) +(deftest symbol-class-of (test-if-not-in-cl-package "class-of") nil) +(deftest symbol-clear-input (test-if-not-in-cl-package "clear-input") nil) +(deftest symbol-clear-output (test-if-not-in-cl-package "clear-output") nil) +(deftest symbol-close (test-if-not-in-cl-package "close") nil) +(deftest symbol-clrhash (test-if-not-in-cl-package "clrhash") nil) +(deftest symbol-code-char (test-if-not-in-cl-package "code-char") nil) +(deftest symbol-coerce (test-if-not-in-cl-package "coerce") nil) +(deftest symbol-compilation-speed (test-if-not-in-cl-package "compilation-speed") nil) +(deftest symbol-compile (test-if-not-in-cl-package "compile") nil) +(deftest symbol-compile-file (test-if-not-in-cl-package "compile-file") nil) +(deftest symbol-compile-file-pathname (test-if-not-in-cl-package "compile-file-pathname") nil) +(deftest symbol-compiled-function (test-if-not-in-cl-package "compiled-function") nil) +(deftest symbol-compiled-function-p (test-if-not-in-cl-package "compiled-function-p") nil) +(deftest symbol-compiler-macro (test-if-not-in-cl-package "compiler-macro") nil) +(deftest symbol-compiler-macro-function (test-if-not-in-cl-package "compiler-macro-function") nil) +(deftest symbol-complement (test-if-not-in-cl-package "complement") nil) +(deftest symbol-complex (test-if-not-in-cl-package "complex") nil) +(deftest symbol-complexp (test-if-not-in-cl-package "complexp") nil) +(deftest symbol-compute-applicable-methods (test-if-not-in-cl-package "compute-applicable-methods") nil) +(deftest symbol-compute-restarts (test-if-not-in-cl-package "compute-restarts") nil) +(deftest symbol-concatenate (test-if-not-in-cl-package "concatenate") nil) +(deftest symbol-concatenated-stream (test-if-not-in-cl-package "concatenated-stream") nil) +(deftest symbol-concatenated-stream-streams (test-if-not-in-cl-package "concatenated-stream-streams") nil) +(deftest symbol-cond (test-if-not-in-cl-package "cond") nil) +(deftest symbol-condition (test-if-not-in-cl-package "condition") nil) +(deftest symbol-conjugate (test-if-not-in-cl-package "conjugate") nil) +(deftest symbol-cons (test-if-not-in-cl-package "cons") nil) +(deftest symbol-consp (test-if-not-in-cl-package "consp") nil) +(deftest symbol-constantly (test-if-not-in-cl-package "constantly") nil) +(deftest symbol-constantp (test-if-not-in-cl-package "constantp") nil) +(deftest symbol-continue (test-if-not-in-cl-package "continue") nil) +(deftest symbol-control-error (test-if-not-in-cl-package "control-error") nil) +(deftest symbol-copy-alist (test-if-not-in-cl-package "copy-alist") nil) +(deftest symbol-copy-list (test-if-not-in-cl-package "copy-list") nil) +(deftest symbol-copy-pprint-dispatch (test-if-not-in-cl-package "copy-pprint-dispatch") nil) +(deftest symbol-copy-readtable (test-if-not-in-cl-package "copy-readtable") nil) +(deftest symbol-copy-seq (test-if-not-in-cl-package "copy-seq") nil) +(deftest symbol-copy-structure (test-if-not-in-cl-package "copy-structure") nil) +(deftest symbol-copy-symbol (test-if-not-in-cl-package "copy-symbol") nil) +(deftest symbol-copy-tree (test-if-not-in-cl-package "copy-tree") nil) +(deftest symbol-cos (test-if-not-in-cl-package "cos") nil) +(deftest symbol-cosh (test-if-not-in-cl-package "cosh") nil) +(deftest symbol-count (test-if-not-in-cl-package "count") nil) +(deftest symbol-count-if (test-if-not-in-cl-package "count-if") nil) +(deftest symbol-count-if-not (test-if-not-in-cl-package "count-if-not") nil) +(deftest symbol-ctypecase (test-if-not-in-cl-package "ctypecase") nil) +(deftest symbol-debug (test-if-not-in-cl-package "debug") nil) +(deftest symbol-decf (test-if-not-in-cl-package "decf") nil) +(deftest symbol-declaim (test-if-not-in-cl-package "declaim") nil) +(deftest symbol-declaration (test-if-not-in-cl-package "declaration") nil) +(deftest symbol-declare (test-if-not-in-cl-package "declare") nil) +(deftest symbol-decode-float (test-if-not-in-cl-package "decode-float") nil) +(deftest symbol-decode-universal-time (test-if-not-in-cl-package "decode-universal-time") nil) +(deftest symbol-defclass (test-if-not-in-cl-package "defclass") nil) +(deftest symbol-defconstant (test-if-not-in-cl-package "defconstant") nil) +(deftest symbol-defgeneric (test-if-not-in-cl-package "defgeneric") nil) +(deftest symbol-define-compiler-macro (test-if-not-in-cl-package "define-compiler-macro") nil) +(deftest symbol-define-condition (test-if-not-in-cl-package "define-condition") nil) +(deftest symbol-define-method-combination (test-if-not-in-cl-package "define-method-combination") nil) +(deftest symbol-define-modify-macro (test-if-not-in-cl-package "define-modify-macro") nil) +(deftest symbol-define-setf-expander (test-if-not-in-cl-package "define-setf-expander") nil) +(deftest symbol-define-symbol-macro (test-if-not-in-cl-package "define-symbol-macro") nil) +(deftest symbol-defmacro (test-if-not-in-cl-package "defmacro") nil) +(deftest symbol-defmethod (test-if-not-in-cl-package "defmethod") nil) +(deftest symbol-defpackage (test-if-not-in-cl-package "defpackage") nil) +(deftest symbol-defparameter (test-if-not-in-cl-package "defparameter") nil) +(deftest symbol-defsetf (test-if-not-in-cl-package "defsetf") nil) +(deftest symbol-defstruct (test-if-not-in-cl-package "defstruct") nil) +(deftest symbol-deftype (test-if-not-in-cl-package "deftype") nil) +(deftest symbol-defun (test-if-not-in-cl-package "defun") nil) +(deftest symbol-defvar (test-if-not-in-cl-package "defvar") nil) +(deftest symbol-delete (test-if-not-in-cl-package "delete") nil) +(deftest symbol-delete-duplicates (test-if-not-in-cl-package "delete-duplicates") nil) +(deftest symbol-delete-file (test-if-not-in-cl-package "delete-file") nil) +(deftest symbol-delete-if (test-if-not-in-cl-package "delete-if") nil) +(deftest symbol-delete-if-not (test-if-not-in-cl-package "delete-if-not") nil) +(deftest symbol-delete-package (test-if-not-in-cl-package "delete-package") nil) +(deftest symbol-denominator (test-if-not-in-cl-package "denominator") nil) +(deftest symbol-deposit-field (test-if-not-in-cl-package "deposit-field") nil) +(deftest symbol-describe (test-if-not-in-cl-package "describe") nil) +(deftest symbol-describe-object (test-if-not-in-cl-package "describe-object") nil) +(deftest symbol-destructuring-bind (test-if-not-in-cl-package "destructuring-bind") nil) +(deftest symbol-digit-char (test-if-not-in-cl-package "digit-char") nil) +(deftest symbol-digit-char-p (test-if-not-in-cl-package "digit-char-p") nil) +(deftest symbol-directory (test-if-not-in-cl-package "directory") nil) +(deftest symbol-directory-namestring (test-if-not-in-cl-package "directory-namestring") nil) +(deftest symbol-disassemble (test-if-not-in-cl-package "disassemble") nil) +(deftest symbol-division-by-zero (test-if-not-in-cl-package "division-by-zero") nil) +(deftest symbol-do (test-if-not-in-cl-package "do") nil) +(deftest symbol-do* (test-if-not-in-cl-package "do*") nil) +(deftest symbol-do-all-symbols (test-if-not-in-cl-package "do-all-symbols") nil) +(deftest symbol-do-external-symbols (test-if-not-in-cl-package "do-external-symbols") nil) +(deftest symbol-do-symbols (test-if-not-in-cl-package "do-symbols") nil) +(deftest symbol-documentation (test-if-not-in-cl-package "documentation") nil) +(deftest symbol-dolist (test-if-not-in-cl-package "dolist") nil) +(deftest symbol-dotimes (test-if-not-in-cl-package "dotimes") nil) +(deftest symbol-double-float (test-if-not-in-cl-package "double-float") nil) +(deftest symbol-double-float-epsilon (test-if-not-in-cl-package "double-float-epsilon") nil) +(deftest symbol-double-float-negative-epsilon (test-if-not-in-cl-package "double-float-negative-epsilon") nil) +(deftest symbol-dpb (test-if-not-in-cl-package "dpb") nil) +(deftest symbol-dribble (test-if-not-in-cl-package "dribble") nil) +(deftest symbol-dynamic-extent (test-if-not-in-cl-package "dynamic-extent") nil) +(deftest symbol-ecase (test-if-not-in-cl-package "ecase") nil) +(deftest symbol-echo-stream (test-if-not-in-cl-package "echo-stream") nil) +(deftest symbol-echo-stream-input-stream (test-if-not-in-cl-package "echo-stream-input-stream") nil) +(deftest symbol-echo-stream-output-stream (test-if-not-in-cl-package "echo-stream-output-stream") nil) +(deftest symbol-ed (test-if-not-in-cl-package "ed") nil) +(deftest symbol-eighth (test-if-not-in-cl-package "eighth") nil) +(deftest symbol-elt (test-if-not-in-cl-package "elt") nil) +(deftest symbol-encode-universal-time (test-if-not-in-cl-package "encode-universal-time") nil) +(deftest symbol-end-of-file (test-if-not-in-cl-package "end-of-file") nil) +(deftest symbol-endp (test-if-not-in-cl-package "endp") nil) +(deftest symbol-enough-namestring (test-if-not-in-cl-package "enough-namestring") nil) +(deftest symbol-ensure-directories-exist (test-if-not-in-cl-package "ensure-directories-exist") nil) +(deftest symbol-ensure-generic-function (test-if-not-in-cl-package "ensure-generic-function") nil) +(deftest symbol-eq (test-if-not-in-cl-package "eq") nil) +(deftest symbol-eql (test-if-not-in-cl-package "eql") nil) +(deftest symbol-equal (test-if-not-in-cl-package "equal") nil) +(deftest symbol-equalp (test-if-not-in-cl-package "equalp") nil) +(deftest symbol-error (test-if-not-in-cl-package "error") nil) +(deftest symbol-etypecase (test-if-not-in-cl-package "etypecase") nil) +(deftest symbol-eval (test-if-not-in-cl-package "eval") nil) +(deftest symbol-eval-when (test-if-not-in-cl-package "eval-when") nil) +(deftest symbol-evenp (test-if-not-in-cl-package "evenp") nil) +(deftest symbol-every (test-if-not-in-cl-package "every") nil) +(deftest symbol-exp (test-if-not-in-cl-package "exp") nil) +(deftest symbol-export (test-if-not-in-cl-package "export") nil) +(deftest symbol-expt (test-if-not-in-cl-package "expt") nil) +(deftest symbol-extended-char (test-if-not-in-cl-package "extended-char") nil) +(deftest symbol-fboundp (test-if-not-in-cl-package "fboundp") nil) +(deftest symbol-fceiling (test-if-not-in-cl-package "fceiling") nil) +(deftest symbol-fdefinition (test-if-not-in-cl-package "fdefinition") nil) +(deftest symbol-ffloor (test-if-not-in-cl-package "ffloor") nil) +(deftest symbol-fifth (test-if-not-in-cl-package "fifth") nil) +(deftest symbol-file-author (test-if-not-in-cl-package "file-author") nil) +(deftest symbol-file-error (test-if-not-in-cl-package "file-error") nil) +(deftest symbol-file-error-pathname (test-if-not-in-cl-package "file-error-pathname") nil) +(deftest symbol-file-length (test-if-not-in-cl-package "file-length") nil) +(deftest symbol-file-namestring (test-if-not-in-cl-package "file-namestring") nil) +(deftest symbol-file-position (test-if-not-in-cl-package "file-position") nil) +(deftest symbol-file-stream (test-if-not-in-cl-package "file-stream") nil) +(deftest symbol-file-string-length (test-if-not-in-cl-package "file-string-length") nil) +(deftest symbol-file-write-date (test-if-not-in-cl-package "file-write-date") nil) +(deftest symbol-fill (test-if-not-in-cl-package "fill") nil) +(deftest symbol-fill-pointer (test-if-not-in-cl-package "fill-pointer") nil) +(deftest symbol-find (test-if-not-in-cl-package "find") nil) +(deftest symbol-find-all-symbols (test-if-not-in-cl-package "find-all-symbols") nil) +(deftest symbol-find-class (test-if-not-in-cl-package "find-class") nil) +(deftest symbol-find-if (test-if-not-in-cl-package "find-if") nil) +(deftest symbol-find-if-not (test-if-not-in-cl-package "find-if-not") nil) +(deftest symbol-find-method (test-if-not-in-cl-package "find-method") nil) +(deftest symbol-find-package (test-if-not-in-cl-package "find-package") nil) +(deftest symbol-find-restart (test-if-not-in-cl-package "find-restart") nil) +(deftest symbol-find-symbol (test-if-not-in-cl-package "find-symbol") nil) +(deftest symbol-finish-output (test-if-not-in-cl-package "finish-output") nil) +(deftest symbol-first (test-if-not-in-cl-package "first") nil) +(deftest symbol-fixnum (test-if-not-in-cl-package "fixnum") nil) +(deftest symbol-flet (test-if-not-in-cl-package "flet") nil) +(deftest symbol-float (test-if-not-in-cl-package "float") nil) +(deftest symbol-float-digits (test-if-not-in-cl-package "float-digits") nil) +(deftest symbol-float-precision (test-if-not-in-cl-package "float-precision") nil) +(deftest symbol-float-radix (test-if-not-in-cl-package "float-radix") nil) +(deftest symbol-float-sign (test-if-not-in-cl-package "float-sign") nil) +(deftest symbol-floating-point-inexact (test-if-not-in-cl-package "floating-point-inexact") nil) +(deftest symbol-floating-point-invalid-operation (test-if-not-in-cl-package "floating-point-invalid-operation") nil) +(deftest symbol-floating-point-overflow (test-if-not-in-cl-package "floating-point-overflow") nil) +(deftest symbol-floating-point-underflow (test-if-not-in-cl-package "floating-point-underflow") nil) +(deftest symbol-floatp (test-if-not-in-cl-package "floatp") nil) +(deftest symbol-floor (test-if-not-in-cl-package "floor") nil) +(deftest symbol-fmakunbound (test-if-not-in-cl-package "fmakunbound") nil) +(deftest symbol-force-output (test-if-not-in-cl-package "force-output") nil) +(deftest symbol-format (test-if-not-in-cl-package "format") nil) +(deftest symbol-formatter (test-if-not-in-cl-package "formatter") nil) +(deftest symbol-fourth (test-if-not-in-cl-package "fourth") nil) +(deftest symbol-fresh-line (test-if-not-in-cl-package "fresh-line") nil) +(deftest symbol-fround (test-if-not-in-cl-package "fround") nil) +(deftest symbol-ftruncate (test-if-not-in-cl-package "ftruncate") nil) +(deftest symbol-ftype (test-if-not-in-cl-package "ftype") nil) +(deftest symbol-funcall (test-if-not-in-cl-package "funcall") nil) +(deftest symbol-function (test-if-not-in-cl-package "function") nil) +(deftest symbol-function-keywords (test-if-not-in-cl-package "function-keywords") nil) +(deftest symbol-function-lambda-expression (test-if-not-in-cl-package "function-lambda-expression") nil) +(deftest symbol-functionp (test-if-not-in-cl-package "functionp") nil) +(deftest symbol-gcd (test-if-not-in-cl-package "gcd") nil) +(deftest symbol-generic-function (test-if-not-in-cl-package "generic-function") nil) +(deftest symbol-gensym (test-if-not-in-cl-package "gensym") nil) +(deftest symbol-gentemp (test-if-not-in-cl-package "gentemp") nil) +(deftest symbol-get (test-if-not-in-cl-package "get") nil) +(deftest symbol-get-decoded-time (test-if-not-in-cl-package "get-decoded-time") nil) +(deftest symbol-get-dispatch-macro-character (test-if-not-in-cl-package "get-dispatch-macro-character") nil) +(deftest symbol-get-internal-real-time (test-if-not-in-cl-package "get-internal-real-time") nil) +(deftest symbol-get-internal-run-time (test-if-not-in-cl-package "get-internal-run-time") nil) +(deftest symbol-get-macro-character (test-if-not-in-cl-package "get-macro-character") nil) +(deftest symbol-get-output-stream-string (test-if-not-in-cl-package "get-output-stream-string") nil) +(deftest symbol-get-properties (test-if-not-in-cl-package "get-properties") nil) +(deftest symbol-get-setf-expansion (test-if-not-in-cl-package "get-setf-expansion") nil) +(deftest symbol-get-universal-time (test-if-not-in-cl-package "get-universal-time") nil) +(deftest symbol-getf (test-if-not-in-cl-package "getf") nil) +(deftest symbol-gethash (test-if-not-in-cl-package "gethash") nil) +(deftest symbol-go (test-if-not-in-cl-package "go") nil) +(deftest symbol-graphic-char-p (test-if-not-in-cl-package "graphic-char-p") nil) +(deftest symbol-handler-bind (test-if-not-in-cl-package "handler-bind") nil) +(deftest symbol-handler-case (test-if-not-in-cl-package "handler-case") nil) +(deftest symbol-hash-table (test-if-not-in-cl-package "hash-table") nil) +(deftest symbol-hash-table-count (test-if-not-in-cl-package "hash-table-count") nil) +(deftest symbol-hash-table-p (test-if-not-in-cl-package "hash-table-p") nil) +(deftest symbol-hash-table-rehash-size (test-if-not-in-cl-package "hash-table-rehash-size") nil) +(deftest symbol-hash-table-rehash-threshold (test-if-not-in-cl-package "hash-table-rehash-threshold") nil) +(deftest symbol-hash-table-size (test-if-not-in-cl-package "hash-table-size") nil) +(deftest symbol-hash-table-test (test-if-not-in-cl-package "hash-table-test") nil) +(deftest symbol-host-namestring (test-if-not-in-cl-package "host-namestring") nil) +(deftest symbol-identity (test-if-not-in-cl-package "identity") nil) +(deftest symbol-if (test-if-not-in-cl-package "if") nil) +(deftest symbol-ignorable (test-if-not-in-cl-package "ignorable") nil) +(deftest symbol-ignore (test-if-not-in-cl-package "ignore") nil) +(deftest symbol-ignore-errors (test-if-not-in-cl-package "ignore-errors") nil) +(deftest symbol-imagpart (test-if-not-in-cl-package "imagpart") nil) +(deftest symbol-import (test-if-not-in-cl-package "import") nil) +(deftest symbol-in-package (test-if-not-in-cl-package "in-package") nil) +(deftest symbol-incf (test-if-not-in-cl-package "incf") nil) +(deftest symbol-initialize-instance (test-if-not-in-cl-package "initialize-instance") nil) +(deftest symbol-inline (test-if-not-in-cl-package "inline") nil) +(deftest symbol-input-stream-p (test-if-not-in-cl-package "input-stream-p") nil) +(deftest symbol-inspect (test-if-not-in-cl-package "inspect") nil) +(deftest symbol-integer (test-if-not-in-cl-package "integer") nil) +(deftest symbol-integer-decode-float (test-if-not-in-cl-package "integer-decode-float") nil) +(deftest symbol-integer-length (test-if-not-in-cl-package "integer-length") nil) +(deftest symbol-integerp (test-if-not-in-cl-package "integerp") nil) +(deftest symbol-interactive-stream-p (test-if-not-in-cl-package "interactive-stream-p") nil) +(deftest symbol-intern (test-if-not-in-cl-package "intern") nil) +(deftest symbol-internal-time-units-per-second (test-if-not-in-cl-package "internal-time-units-per-second") nil) +(deftest symbol-intersection (test-if-not-in-cl-package "intersection") nil) +(deftest symbol-invalid-method-error (test-if-not-in-cl-package "invalid-method-error") nil) +(deftest symbol-invoke-debugger (test-if-not-in-cl-package "invoke-debugger") nil) +(deftest symbol-invoke-restart (test-if-not-in-cl-package "invoke-restart") nil) +(deftest symbol-invoke-restart-interactively (test-if-not-in-cl-package "invoke-restart-interactively") nil) +(deftest symbol-isqrt (test-if-not-in-cl-package "isqrt") nil) +(deftest symbol-keyword (test-if-not-in-cl-package "keyword") nil) +(deftest symbol-keywordp (test-if-not-in-cl-package "keywordp") nil) +(deftest symbol-labels (test-if-not-in-cl-package "labels") nil) +(deftest symbol-lambda (test-if-not-in-cl-package "lambda") nil) +(deftest symbol-lambda-list-keywords (test-if-not-in-cl-package "lambda-list-keywords") nil) +(deftest symbol-lambda-parameters-limit (test-if-not-in-cl-package "lambda-parameters-limit") nil) +(deftest symbol-last (test-if-not-in-cl-package "last") nil) +(deftest symbol-lcm (test-if-not-in-cl-package "lcm") nil) +(deftest symbol-ldb (test-if-not-in-cl-package "ldb") nil) +(deftest symbol-ldb-test (test-if-not-in-cl-package "ldb-test") nil) +(deftest symbol-ldiff (test-if-not-in-cl-package "ldiff") nil) +(deftest symbol-least-negative-double-float (test-if-not-in-cl-package "least-negative-double-float") nil) +(deftest symbol-least-negative-long-float (test-if-not-in-cl-package "least-negative-long-float") nil) +(deftest symbol-least-negative-normalized-double-float (test-if-not-in-cl-package "least-negative-normalized-double-float") nil) +(deftest symbol-least-negative-normalized-long-float (test-if-not-in-cl-package "least-negative-normalized-long-float") nil) +(deftest symbol-least-negative-normalized-short-float (test-if-not-in-cl-package "least-negative-normalized-short-float") nil) +(deftest symbol-least-negative-normalized-single-float (test-if-not-in-cl-package "least-negative-normalized-single-float") nil) +(deftest symbol-least-negative-short-float (test-if-not-in-cl-package "least-negative-short-float") nil) +(deftest symbol-least-negative-single-float (test-if-not-in-cl-package "least-negative-single-float") nil) +(deftest symbol-least-positive-double-float (test-if-not-in-cl-package "least-positive-double-float") nil) +(deftest symbol-least-positive-long-float (test-if-not-in-cl-package "least-positive-long-float") nil) +(deftest symbol-least-positive-normalized-double-float (test-if-not-in-cl-package "least-positive-normalized-double-float") nil) +(deftest symbol-least-positive-normalized-long-float (test-if-not-in-cl-package "least-positive-normalized-long-float") nil) +(deftest symbol-least-positive-normalized-short-float (test-if-not-in-cl-package "least-positive-normalized-short-float") nil) +(deftest symbol-least-positive-normalized-single-float (test-if-not-in-cl-package "least-positive-normalized-single-float") nil) +(deftest symbol-least-positive-short-float (test-if-not-in-cl-package "least-positive-short-float") nil) +(deftest symbol-least-positive-single-float (test-if-not-in-cl-package "least-positive-single-float") nil) +(deftest symbol-length (test-if-not-in-cl-package "length") nil) +(deftest symbol-let (test-if-not-in-cl-package "let") nil) +(deftest symbol-let* (test-if-not-in-cl-package "let*") nil) +(deftest symbol-lisp-implementation-type (test-if-not-in-cl-package "lisp-implementation-type") nil) +(deftest symbol-lisp-implementation-version (test-if-not-in-cl-package "lisp-implementation-version") nil) +(deftest symbol-list (test-if-not-in-cl-package "list") nil) +(deftest symbol-list* (test-if-not-in-cl-package "list*") nil) +(deftest symbol-list-all-packages (test-if-not-in-cl-package "list-all-packages") nil) +(deftest symbol-list-length (test-if-not-in-cl-package "list-length") nil) +(deftest symbol-listen (test-if-not-in-cl-package "listen") nil) +(deftest symbol-listp (test-if-not-in-cl-package "listp") nil) +(deftest symbol-load (test-if-not-in-cl-package "load") nil) +(deftest symbol-load-logical-pathname-translations (test-if-not-in-cl-package "load-logical-pathname-translations") nil) +(deftest symbol-load-time-value (test-if-not-in-cl-package "load-time-value") nil) +(deftest symbol-locally (test-if-not-in-cl-package "locally") nil) +(deftest symbol-log (test-if-not-in-cl-package "log") nil) +(deftest symbol-logand (test-if-not-in-cl-package "logand") nil) +(deftest symbol-logandc1 (test-if-not-in-cl-package "logandc1") nil) +(deftest symbol-logandc2 (test-if-not-in-cl-package "logandc2") nil) +(deftest symbol-logbitp (test-if-not-in-cl-package "logbitp") nil) +(deftest symbol-logcount (test-if-not-in-cl-package "logcount") nil) +(deftest symbol-logeqv (test-if-not-in-cl-package "logeqv") nil) +(deftest symbol-logical-pathname (test-if-not-in-cl-package "logical-pathname") nil) +(deftest symbol-logical-pathname-translations (test-if-not-in-cl-package "logical-pathname-translations") nil) +(deftest symbol-logior (test-if-not-in-cl-package "logior") nil) +(deftest symbol-lognand (test-if-not-in-cl-package "lognand") nil) +(deftest symbol-lognor (test-if-not-in-cl-package "lognor") nil) +(deftest symbol-lognot (test-if-not-in-cl-package "lognot") nil) +(deftest symbol-logorc1 (test-if-not-in-cl-package "logorc1") nil) +(deftest symbol-logorc2 (test-if-not-in-cl-package "logorc2") nil) +(deftest symbol-logtest (test-if-not-in-cl-package "logtest") nil) +(deftest symbol-logxor (test-if-not-in-cl-package "logxor") nil) +(deftest symbol-long-float (test-if-not-in-cl-package "long-float") nil) +(deftest symbol-long-float-epsilon (test-if-not-in-cl-package "long-float-epsilon") nil) +(deftest symbol-long-float-negative-epsilon (test-if-not-in-cl-package "long-float-negative-epsilon") nil) +(deftest symbol-long-site-name (test-if-not-in-cl-package "long-site-name") nil) +(deftest symbol-loop (test-if-not-in-cl-package "loop") nil) +(deftest symbol-loop-finish (test-if-not-in-cl-package "loop-finish") nil) +(deftest symbol-lower-case-p (test-if-not-in-cl-package "lower-case-p") nil) +(deftest symbol-machine-instance (test-if-not-in-cl-package "machine-instance") nil) +(deftest symbol-machine-type (test-if-not-in-cl-package "machine-type") nil) +(deftest symbol-machine-version (test-if-not-in-cl-package "machine-version") nil) +(deftest symbol-macro-function (test-if-not-in-cl-package "macro-function") nil) +(deftest symbol-macroexpand (test-if-not-in-cl-package "macroexpand") nil) +(deftest symbol-macroexpand-1 (test-if-not-in-cl-package "macroexpand-1") nil) +(deftest symbol-macrolet (test-if-not-in-cl-package "macrolet") nil) +(deftest symbol-make-array (test-if-not-in-cl-package "make-array") nil) +(deftest symbol-make-broadcast-stream (test-if-not-in-cl-package "make-broadcast-stream") nil) +(deftest symbol-make-concatenated-stream (test-if-not-in-cl-package "make-concatenated-stream") nil) +(deftest symbol-make-condition (test-if-not-in-cl-package "make-condition") nil) +(deftest symbol-make-dispatch-macro-character (test-if-not-in-cl-package "make-dispatch-macro-character") nil) +(deftest symbol-make-echo-stream (test-if-not-in-cl-package "make-echo-stream") nil) +(deftest symbol-make-hash-table (test-if-not-in-cl-package "make-hash-table") nil) +(deftest symbol-make-instance (test-if-not-in-cl-package "make-instance") nil) +(deftest symbol-make-instances-obsolete (test-if-not-in-cl-package "make-instances-obsolete") nil) +(deftest symbol-make-list (test-if-not-in-cl-package "make-list") nil) +(deftest symbol-make-load-form (test-if-not-in-cl-package "make-load-form") nil) +(deftest symbol-make-load-form-saving-slots (test-if-not-in-cl-package "make-load-form-saving-slots") nil) +(deftest symbol-make-method (test-if-not-in-cl-package "make-method") nil) +(deftest symbol-make-package (test-if-not-in-cl-package "make-package") nil) +(deftest symbol-make-pathname (test-if-not-in-cl-package "make-pathname") nil) +(deftest symbol-make-random-state (test-if-not-in-cl-package "make-random-state") nil) +(deftest symbol-make-sequence (test-if-not-in-cl-package "make-sequence") nil) +(deftest symbol-make-string (test-if-not-in-cl-package "make-string") nil) +(deftest symbol-make-string-input-stream (test-if-not-in-cl-package "make-string-input-stream") nil) +(deftest symbol-make-string-output-stream (test-if-not-in-cl-package "make-string-output-stream") nil) +(deftest symbol-make-symbol (test-if-not-in-cl-package "make-symbol") nil) +(deftest symbol-make-synonym-stream (test-if-not-in-cl-package "make-synonym-stream") nil) +(deftest symbol-make-two-way-stream (test-if-not-in-cl-package "make-two-way-stream") nil) +(deftest symbol-makunbound (test-if-not-in-cl-package "makunbound") nil) +(deftest symbol-map (test-if-not-in-cl-package "map") nil) +(deftest symbol-map-into (test-if-not-in-cl-package "map-into") nil) +(deftest symbol-mapc (test-if-not-in-cl-package "mapc") nil) +(deftest symbol-mapcan (test-if-not-in-cl-package "mapcan") nil) +(deftest symbol-mapcar (test-if-not-in-cl-package "mapcar") nil) +(deftest symbol-mapcon (test-if-not-in-cl-package "mapcon") nil) +(deftest symbol-maphash (test-if-not-in-cl-package "maphash") nil) +(deftest symbol-mapl (test-if-not-in-cl-package "mapl") nil) +(deftest symbol-maplist (test-if-not-in-cl-package "maplist") nil) +(deftest symbol-mask-field (test-if-not-in-cl-package "mask-field") nil) +(deftest symbol-max (test-if-not-in-cl-package "max") nil) +(deftest symbol-member (test-if-not-in-cl-package "member") nil) +(deftest symbol-member-if (test-if-not-in-cl-package "member-if") nil) +(deftest symbol-member-if-not (test-if-not-in-cl-package "member-if-not") nil) +(deftest symbol-merge (test-if-not-in-cl-package "merge") nil) +(deftest symbol-merge-pathnames (test-if-not-in-cl-package "merge-pathnames") nil) +(deftest symbol-method (test-if-not-in-cl-package "method") nil) +(deftest symbol-method-combination (test-if-not-in-cl-package "method-combination") nil) +(deftest symbol-method-combination-error (test-if-not-in-cl-package "method-combination-error") nil) +(deftest symbol-method-qualifiers (test-if-not-in-cl-package "method-qualifiers") nil) +(deftest symbol-min (test-if-not-in-cl-package "min") nil) +(deftest symbol-minusp (test-if-not-in-cl-package "minusp") nil) +(deftest symbol-mismatch (test-if-not-in-cl-package "mismatch") nil) +(deftest symbol-mod (test-if-not-in-cl-package "mod") nil) +(deftest symbol-most-negative-double-float (test-if-not-in-cl-package "most-negative-double-float") nil) +(deftest symbol-most-negative-fixnum (test-if-not-in-cl-package "most-negative-fixnum") nil) +(deftest symbol-most-negative-long-float (test-if-not-in-cl-package "most-negative-long-float") nil) +(deftest symbol-most-negative-short-float (test-if-not-in-cl-package "most-negative-short-float") nil) +(deftest symbol-most-negative-single-float (test-if-not-in-cl-package "most-negative-single-float") nil) +(deftest symbol-most-positive-double-float (test-if-not-in-cl-package "most-positive-double-float") nil) +(deftest symbol-most-positive-fixnum (test-if-not-in-cl-package "most-positive-fixnum") nil) +(deftest symbol-most-positive-long-float (test-if-not-in-cl-package "most-positive-long-float") nil) +(deftest symbol-most-positive-short-float (test-if-not-in-cl-package "most-positive-short-float") nil) +(deftest symbol-most-positive-single-float (test-if-not-in-cl-package "most-positive-single-float") nil) +(deftest symbol-muffle-warning (test-if-not-in-cl-package "muffle-warning") nil) +(deftest symbol-multiple-value-bind (test-if-not-in-cl-package "multiple-value-bind") nil) +(deftest symbol-multiple-value-call (test-if-not-in-cl-package "multiple-value-call") nil) +(deftest symbol-multiple-value-list (test-if-not-in-cl-package "multiple-value-list") nil) +(deftest symbol-multiple-value-prog1 (test-if-not-in-cl-package "multiple-value-prog1") nil) +(deftest symbol-multiple-value-setq (test-if-not-in-cl-package "multiple-value-setq") nil) +(deftest symbol-multiple-values-limit (test-if-not-in-cl-package "multiple-values-limit") nil) +(deftest symbol-name-char (test-if-not-in-cl-package "name-char") nil) +(deftest symbol-namestring (test-if-not-in-cl-package "namestring") nil) +(deftest symbol-nbutlast (test-if-not-in-cl-package "nbutlast") nil) +(deftest symbol-nconc (test-if-not-in-cl-package "nconc") nil) +(deftest symbol-next-method-p (test-if-not-in-cl-package "next-method-p") nil) +(deftest symbol-nil (test-if-not-in-cl-package "nil") nil) +(deftest symbol-nintersection (test-if-not-in-cl-package "nintersection") nil) +(deftest symbol-ninth (test-if-not-in-cl-package "ninth") nil) +(deftest symbol-no-applicable-method (test-if-not-in-cl-package "no-applicable-method") nil) +(deftest symbol-no-next-method (test-if-not-in-cl-package "no-next-method") nil) +(deftest symbol-not (test-if-not-in-cl-package "not") nil) +(deftest symbol-notany (test-if-not-in-cl-package "notany") nil) +(deftest symbol-notevery (test-if-not-in-cl-package "notevery") nil) +(deftest symbol-notinline (test-if-not-in-cl-package "notinline") nil) +(deftest symbol-nreconc (test-if-not-in-cl-package "nreconc") nil) +(deftest symbol-nreverse (test-if-not-in-cl-package "nreverse") nil) +(deftest symbol-nset-difference (test-if-not-in-cl-package "nset-difference") nil) +(deftest symbol-nset-exclusive-or (test-if-not-in-cl-package "nset-exclusive-or") nil) +(deftest symbol-nstring-capitalize (test-if-not-in-cl-package "nstring-capitalize") nil) +(deftest symbol-nstring-downcase (test-if-not-in-cl-package "nstring-downcase") nil) +(deftest symbol-nstring-upcase (test-if-not-in-cl-package "nstring-upcase") nil) +(deftest symbol-nsublis (test-if-not-in-cl-package "nsublis") nil) +(deftest symbol-nsubst (test-if-not-in-cl-package "nsubst") nil) +(deftest symbol-nsubst-if (test-if-not-in-cl-package "nsubst-if") nil) +(deftest symbol-nsubst-if-not (test-if-not-in-cl-package "nsubst-if-not") nil) +(deftest symbol-nsubstitute (test-if-not-in-cl-package "nsubstitute") nil) +(deftest symbol-nsubstitute-if (test-if-not-in-cl-package "nsubstitute-if") nil) +(deftest symbol-nsubstitute-if-not (test-if-not-in-cl-package "nsubstitute-if-not") nil) +(deftest symbol-nth (test-if-not-in-cl-package "nth") nil) +(deftest symbol-nth-value (test-if-not-in-cl-package "nth-value") nil) +(deftest symbol-nthcdr (test-if-not-in-cl-package "nthcdr") nil) +(deftest symbol-null (test-if-not-in-cl-package "null") nil) +(deftest symbol-number (test-if-not-in-cl-package "number") nil) +(deftest symbol-numberp (test-if-not-in-cl-package "numberp") nil) +(deftest symbol-numerator (test-if-not-in-cl-package "numerator") nil) +(deftest symbol-nunion (test-if-not-in-cl-package "nunion") nil) +(deftest symbol-oddp (test-if-not-in-cl-package "oddp") nil) +(deftest symbol-open (test-if-not-in-cl-package "open") nil) +(deftest symbol-open-stream-p (test-if-not-in-cl-package "open-stream-p") nil) +(deftest symbol-optimize (test-if-not-in-cl-package "optimize") nil) +(deftest symbol-or (test-if-not-in-cl-package "or") nil) +(deftest symbol-otherwise (test-if-not-in-cl-package "otherwise") nil) +(deftest symbol-output-stream-p (test-if-not-in-cl-package "output-stream-p") nil) +(deftest symbol-package (test-if-not-in-cl-package "package") nil) +(deftest symbol-package-error (test-if-not-in-cl-package "package-error") nil) +(deftest symbol-package-error-package (test-if-not-in-cl-package "package-error-package") nil) +(deftest symbol-package-name (test-if-not-in-cl-package "package-name") nil) +(deftest symbol-package-nicknames (test-if-not-in-cl-package "package-nicknames") nil) +(deftest symbol-package-shadowing-symbols (test-if-not-in-cl-package "package-shadowing-symbols") nil) +(deftest symbol-package-use-list (test-if-not-in-cl-package "package-use-list") nil) +(deftest symbol-package-used-by-list (test-if-not-in-cl-package "package-used-by-list") nil) +(deftest symbol-packagep (test-if-not-in-cl-package "packagep") nil) +(deftest symbol-pairlis (test-if-not-in-cl-package "pairlis") nil) +(deftest symbol-parse-error (test-if-not-in-cl-package "parse-error") nil) +(deftest symbol-parse-integer (test-if-not-in-cl-package "parse-integer") nil) +(deftest symbol-parse-namestring (test-if-not-in-cl-package "parse-namestring") nil) +(deftest symbol-pathname (test-if-not-in-cl-package "pathname") nil) +(deftest symbol-pathname-device (test-if-not-in-cl-package "pathname-device") nil) +(deftest symbol-pathname-directory (test-if-not-in-cl-package "pathname-directory") nil) +(deftest symbol-pathname-host (test-if-not-in-cl-package "pathname-host") nil) +(deftest symbol-pathname-match-p (test-if-not-in-cl-package "pathname-match-p") nil) +(deftest symbol-pathname-name (test-if-not-in-cl-package "pathname-name") nil) +(deftest symbol-pathname-type (test-if-not-in-cl-package "pathname-type") nil) +(deftest symbol-pathname-version (test-if-not-in-cl-package "pathname-version") nil) +(deftest symbol-pathnamep (test-if-not-in-cl-package "pathnamep") nil) +(deftest symbol-peek-char (test-if-not-in-cl-package "peek-char") nil) +(deftest symbol-phase (test-if-not-in-cl-package "phase") nil) +(deftest symbol-pi (test-if-not-in-cl-package "pi") nil) +(deftest symbol-plusp (test-if-not-in-cl-package "plusp") nil) +(deftest symbol-pop (test-if-not-in-cl-package "pop") nil) +(deftest symbol-position (test-if-not-in-cl-package "position") nil) +(deftest symbol-position-if (test-if-not-in-cl-package "position-if") nil) +(deftest symbol-position-if-not (test-if-not-in-cl-package "position-if-not") nil) +(deftest symbol-pprint (test-if-not-in-cl-package "pprint") nil) +(deftest symbol-pprint-dispatch (test-if-not-in-cl-package "pprint-dispatch") nil) +(deftest symbol-pprint-exit-if-list-exhausted (test-if-not-in-cl-package "pprint-exit-if-list-exhausted") nil) +(deftest symbol-pprint-fill (test-if-not-in-cl-package "pprint-fill") nil) +(deftest symbol-pprint-indent (test-if-not-in-cl-package "pprint-indent") nil) +(deftest symbol-pprint-linear (test-if-not-in-cl-package "pprint-linear") nil) +(deftest symbol-pprint-logical-block (test-if-not-in-cl-package "pprint-logical-block") nil) +(deftest symbol-pprint-newline (test-if-not-in-cl-package "pprint-newline") nil) +(deftest symbol-pprint-pop (test-if-not-in-cl-package "pprint-pop") nil) +(deftest symbol-pprint-tab (test-if-not-in-cl-package "pprint-tab") nil) +(deftest symbol-pprint-tabular (test-if-not-in-cl-package "pprint-tabular") nil) +(deftest symbol-prin1 (test-if-not-in-cl-package "prin1") nil) +(deftest symbol-prin1-to-string (test-if-not-in-cl-package "prin1-to-string") nil) +(deftest symbol-princ (test-if-not-in-cl-package "princ") nil) +(deftest symbol-princ-to-string (test-if-not-in-cl-package "princ-to-string") nil) +(deftest symbol-print (test-if-not-in-cl-package "print") nil) +(deftest symbol-print-not-readable (test-if-not-in-cl-package "print-not-readable") nil) +(deftest symbol-print-not-readable-object (test-if-not-in-cl-package "print-not-readable-object") nil) +(deftest symbol-print-object (test-if-not-in-cl-package "print-object") nil) +(deftest symbol-print-unreadable-object (test-if-not-in-cl-package "print-unreadable-object") nil) +(deftest symbol-probe-file (test-if-not-in-cl-package "probe-file") nil) +(deftest symbol-proclaim (test-if-not-in-cl-package "proclaim") nil) +(deftest symbol-prog (test-if-not-in-cl-package "prog") nil) +(deftest symbol-prog* (test-if-not-in-cl-package "prog*") nil) +(deftest symbol-prog1 (test-if-not-in-cl-package "prog1") nil) +(deftest symbol-prog2 (test-if-not-in-cl-package "prog2") nil) +(deftest symbol-progn (test-if-not-in-cl-package "progn") nil) +(deftest symbol-program-error (test-if-not-in-cl-package "program-error") nil) +(deftest symbol-progv (test-if-not-in-cl-package "progv") nil) +(deftest symbol-provide (test-if-not-in-cl-package "provide") nil) +(deftest symbol-psetf (test-if-not-in-cl-package "psetf") nil) +(deftest symbol-psetq (test-if-not-in-cl-package "psetq") nil) +(deftest symbol-push (test-if-not-in-cl-package "push") nil) +(deftest symbol-pushnew (test-if-not-in-cl-package "pushnew") nil) +(deftest symbol-quote (test-if-not-in-cl-package "quote") nil) +(deftest symbol-random (test-if-not-in-cl-package "random") nil) +(deftest symbol-random-state (test-if-not-in-cl-package "random-state") nil) +(deftest symbol-random-state-p (test-if-not-in-cl-package "random-state-p") nil) +(deftest symbol-rassoc (test-if-not-in-cl-package "rassoc") nil) +(deftest symbol-rassoc-if (test-if-not-in-cl-package "rassoc-if") nil) +(deftest symbol-rassoc-if-not (test-if-not-in-cl-package "rassoc-if-not") nil) +(deftest symbol-ratio (test-if-not-in-cl-package "ratio") nil) +(deftest symbol-rational (test-if-not-in-cl-package "rational") nil) +(deftest symbol-rationalize (test-if-not-in-cl-package "rationalize") nil) +(deftest symbol-rationalp (test-if-not-in-cl-package "rationalp") nil) +(deftest symbol-read (test-if-not-in-cl-package "read") nil) +(deftest symbol-read-byte (test-if-not-in-cl-package "read-byte") nil) +(deftest symbol-read-char (test-if-not-in-cl-package "read-char") nil) +(deftest symbol-read-char-no-hang (test-if-not-in-cl-package "read-char-no-hang") nil) +(deftest symbol-read-delimited-list (test-if-not-in-cl-package "read-delimited-list") nil) +(deftest symbol-read-from-string (test-if-not-in-cl-package "read-from-string") nil) +(deftest symbol-read-line (test-if-not-in-cl-package "read-line") nil) +(deftest symbol-read-preserving-whitespace (test-if-not-in-cl-package "read-preserving-whitespace") nil) +(deftest symbol-read-sequence (test-if-not-in-cl-package "read-sequence") nil) +(deftest symbol-reader-error (test-if-not-in-cl-package "reader-error") nil) +(deftest symbol-readtable (test-if-not-in-cl-package "readtable") nil) +(deftest symbol-readtable-case (test-if-not-in-cl-package "readtable-case") nil) +(deftest symbol-readtablep (test-if-not-in-cl-package "readtablep") nil) +(deftest symbol-real (test-if-not-in-cl-package "real") nil) +(deftest symbol-realp (test-if-not-in-cl-package "realp") nil) +(deftest symbol-realpart (test-if-not-in-cl-package "realpart") nil) +(deftest symbol-reduce (test-if-not-in-cl-package "reduce") nil) +(deftest symbol-reinitialize-instance (test-if-not-in-cl-package "reinitialize-instance") nil) +(deftest symbol-rem (test-if-not-in-cl-package "rem") nil) +(deftest symbol-remf (test-if-not-in-cl-package "remf") nil) +(deftest symbol-remhash (test-if-not-in-cl-package "remhash") nil) +(deftest symbol-remove (test-if-not-in-cl-package "remove") nil) +(deftest symbol-remove-duplicates (test-if-not-in-cl-package "remove-duplicates") nil) +(deftest symbol-remove-if (test-if-not-in-cl-package "remove-if") nil) +(deftest symbol-remove-if-not (test-if-not-in-cl-package "remove-if-not") nil) +(deftest symbol-remove-method (test-if-not-in-cl-package "remove-method") nil) +(deftest symbol-remprop (test-if-not-in-cl-package "remprop") nil) +(deftest symbol-rename-file (test-if-not-in-cl-package "rename-file") nil) +(deftest symbol-rename-package (test-if-not-in-cl-package "rename-package") nil) +(deftest symbol-replace (test-if-not-in-cl-package "replace") nil) +(deftest symbol-require (test-if-not-in-cl-package "require") nil) +(deftest symbol-rest (test-if-not-in-cl-package "rest") nil) +(deftest symbol-restart (test-if-not-in-cl-package "restart") nil) +(deftest symbol-restart-bind (test-if-not-in-cl-package "restart-bind") nil) +(deftest symbol-restart-case (test-if-not-in-cl-package "restart-case") nil) +(deftest symbol-restart-name (test-if-not-in-cl-package "restart-name") nil) +(deftest symbol-return (test-if-not-in-cl-package "return") nil) +(deftest symbol-return-from (test-if-not-in-cl-package "return-from") nil) +(deftest symbol-revappend (test-if-not-in-cl-package "revappend") nil) +(deftest symbol-reverse (test-if-not-in-cl-package "reverse") nil) +(deftest symbol-room (test-if-not-in-cl-package "room") nil) +(deftest symbol-rotatef (test-if-not-in-cl-package "rotatef") nil) +(deftest symbol-round (test-if-not-in-cl-package "round") nil) +(deftest symbol-row-major-aref (test-if-not-in-cl-package "row-major-aref") nil) +(deftest symbol-rplaca (test-if-not-in-cl-package "rplaca") nil) +(deftest symbol-rplacd (test-if-not-in-cl-package "rplacd") nil) +(deftest symbol-safety (test-if-not-in-cl-package "safety") nil) +(deftest symbol-satisfies (test-if-not-in-cl-package "satisfies") nil) +(deftest symbol-sbit (test-if-not-in-cl-package "sbit") nil) +(deftest symbol-scale-float (test-if-not-in-cl-package "scale-float") nil) +(deftest symbol-schar (test-if-not-in-cl-package "schar") nil) +(deftest symbol-search (test-if-not-in-cl-package "search") nil) +(deftest symbol-second (test-if-not-in-cl-package "second") nil) +(deftest symbol-sequence (test-if-not-in-cl-package "sequence") nil) +(deftest symbol-serious-condition (test-if-not-in-cl-package "serious-condition") nil) +(deftest symbol-set (test-if-not-in-cl-package "set") nil) +(deftest symbol-set-difference (test-if-not-in-cl-package "set-difference") nil) +(deftest symbol-set-dispatch-macro-character (test-if-not-in-cl-package "set-dispatch-macro-character") nil) +(deftest symbol-set-exclusive-or (test-if-not-in-cl-package "set-exclusive-or") nil) +(deftest symbol-set-macro-character (test-if-not-in-cl-package "set-macro-character") nil) +(deftest symbol-set-pprint-dispatch (test-if-not-in-cl-package "set-pprint-dispatch") nil) +(deftest symbol-set-syntax-from-char (test-if-not-in-cl-package "set-syntax-from-char") nil) +(deftest symbol-setf (test-if-not-in-cl-package "setf") nil) +(deftest symbol-setq (test-if-not-in-cl-package "setq") nil) +(deftest symbol-seventh (test-if-not-in-cl-package "seventh") nil) +(deftest symbol-shadow (test-if-not-in-cl-package "shadow") nil) +(deftest symbol-shadowing-import (test-if-not-in-cl-package "shadowing-import") nil) +(deftest symbol-shared-initialize (test-if-not-in-cl-package "shared-initialize") nil) +(deftest symbol-shiftf (test-if-not-in-cl-package "shiftf") nil) +(deftest symbol-short-float (test-if-not-in-cl-package "short-float") nil) +(deftest symbol-short-float-epsilon (test-if-not-in-cl-package "short-float-epsilon") nil) +(deftest symbol-short-float-negative-epsilon (test-if-not-in-cl-package "short-float-negative-epsilon") nil) +(deftest symbol-short-site-name (test-if-not-in-cl-package "short-site-name") nil) +(deftest symbol-signal (test-if-not-in-cl-package "signal") nil) +(deftest symbol-signed-byte (test-if-not-in-cl-package "signed-byte") nil) +(deftest symbol-signum (test-if-not-in-cl-package "signum") nil) +(deftest symbol-simple-array (test-if-not-in-cl-package "simple-array") nil) +(deftest symbol-simple-base-string (test-if-not-in-cl-package "simple-base-string") nil) +(deftest symbol-simple-bit-vector (test-if-not-in-cl-package "simple-bit-vector") nil) +(deftest symbol-simple-bit-vector-p (test-if-not-in-cl-package "simple-bit-vector-p") nil) +(deftest symbol-simple-condition (test-if-not-in-cl-package "simple-condition") nil) +(deftest symbol-simple-condition-format-arguments (test-if-not-in-cl-package "simple-condition-format-arguments") nil) +(deftest symbol-simple-condition-format-control (test-if-not-in-cl-package "simple-condition-format-control") nil) +(deftest symbol-simple-error (test-if-not-in-cl-package "simple-error") nil) +(deftest symbol-simple-string (test-if-not-in-cl-package "simple-string") nil) +(deftest symbol-simple-string-p (test-if-not-in-cl-package "simple-string-p") nil) +(deftest symbol-simple-type-error (test-if-not-in-cl-package "simple-type-error") nil) +(deftest symbol-simple-vector (test-if-not-in-cl-package "simple-vector") nil) +(deftest symbol-simple-vector-p (test-if-not-in-cl-package "simple-vector-p") nil) +(deftest symbol-simple-warning (test-if-not-in-cl-package "simple-warning") nil) +(deftest symbol-sin (test-if-not-in-cl-package "sin") nil) +(deftest symbol-single-float (test-if-not-in-cl-package "single-float") nil) +(deftest symbol-single-float-epsilon (test-if-not-in-cl-package "single-float-epsilon") nil) +(deftest symbol-single-float-negative-epsilon (test-if-not-in-cl-package "single-float-negative-epsilon") nil) +(deftest symbol-sinh (test-if-not-in-cl-package "sinh") nil) +(deftest symbol-sixth (test-if-not-in-cl-package "sixth") nil) +(deftest symbol-sleep (test-if-not-in-cl-package "sleep") nil) +(deftest symbol-slot-boundp (test-if-not-in-cl-package "slot-boundp") nil) +(deftest symbol-slot-exists-p (test-if-not-in-cl-package "slot-exists-p") nil) +(deftest symbol-slot-makunbound (test-if-not-in-cl-package "slot-makunbound") nil) +(deftest symbol-slot-missing (test-if-not-in-cl-package "slot-missing") nil) +(deftest symbol-slot-unbound (test-if-not-in-cl-package "slot-unbound") nil) +(deftest symbol-slot-value (test-if-not-in-cl-package "slot-value") nil) +(deftest symbol-software-type (test-if-not-in-cl-package "software-type") nil) +(deftest symbol-software-version (test-if-not-in-cl-package "software-version") nil) +(deftest symbol-some (test-if-not-in-cl-package "some") nil) +(deftest symbol-sort (test-if-not-in-cl-package "sort") nil) +(deftest symbol-space (test-if-not-in-cl-package "space") nil) +(deftest symbol-special (test-if-not-in-cl-package "special") nil) +(deftest symbol-special-operator-p (test-if-not-in-cl-package "special-operator-p") nil) +(deftest symbol-speed (test-if-not-in-cl-package "speed") nil) +(deftest symbol-sqrt (test-if-not-in-cl-package "sqrt") nil) +(deftest symbol-stable-sort (test-if-not-in-cl-package "stable-sort") nil) +(deftest symbol-standard (test-if-not-in-cl-package "standard") nil) +(deftest symbol-standard-char (test-if-not-in-cl-package "standard-char") nil) +(deftest symbol-standard-char-p (test-if-not-in-cl-package "standard-char-p") nil) +(deftest symbol-standard-class (test-if-not-in-cl-package "standard-class") nil) +(deftest symbol-standard-generic-function (test-if-not-in-cl-package "standard-generic-function") nil) +(deftest symbol-standard-method (test-if-not-in-cl-package "standard-method") nil) +(deftest symbol-standard-object (test-if-not-in-cl-package "standard-object") nil) +(deftest symbol-step (test-if-not-in-cl-package "step") nil) +(deftest symbol-storage-condition (test-if-not-in-cl-package "storage-condition") nil) +(deftest symbol-store-value (test-if-not-in-cl-package "store-value") nil) +(deftest symbol-stream (test-if-not-in-cl-package "stream") nil) +(deftest symbol-stream-element-type (test-if-not-in-cl-package "stream-element-type") nil) +(deftest symbol-stream-error (test-if-not-in-cl-package "stream-error") nil) +(deftest symbol-stream-error-stream (test-if-not-in-cl-package "stream-error-stream") nil) +(deftest symbol-stream-external-format (test-if-not-in-cl-package "stream-external-format") nil) +(deftest symbol-streamp (test-if-not-in-cl-package "streamp") nil) +(deftest symbol-string (test-if-not-in-cl-package "string") nil) +(deftest symbol-string-capitalize (test-if-not-in-cl-package "string-capitalize") nil) +(deftest symbol-string-downcase (test-if-not-in-cl-package "string-downcase") nil) +(deftest symbol-string-equal (test-if-not-in-cl-package "string-equal") nil) +(deftest symbol-string-greaterp (test-if-not-in-cl-package "string-greaterp") nil) +(deftest symbol-string-left-trim (test-if-not-in-cl-package "string-left-trim") nil) +(deftest symbol-string-lessp (test-if-not-in-cl-package "string-lessp") nil) +(deftest symbol-string-not-equal (test-if-not-in-cl-package "string-not-equal") nil) +(deftest symbol-string-not-greaterp (test-if-not-in-cl-package "string-not-greaterp") nil) +(deftest symbol-string-not-lessp (test-if-not-in-cl-package "string-not-lessp") nil) +(deftest symbol-string-right-trim (test-if-not-in-cl-package "string-right-trim") nil) +(deftest symbol-string-stream (test-if-not-in-cl-package "string-stream") nil) +(deftest symbol-string-trim (test-if-not-in-cl-package "string-trim") nil) +(deftest symbol-string-upcase (test-if-not-in-cl-package "string-upcase") nil) +(deftest symbol-string/= (test-if-not-in-cl-package "string/=") nil) +(deftest symbol-string< (test-if-not-in-cl-package "string<") nil) +(deftest symbol-string<= (test-if-not-in-cl-package "string<=") nil) +(deftest symbol-string= (test-if-not-in-cl-package "string=") nil) +(deftest symbol-string> (test-if-not-in-cl-package "string>") nil) +(deftest symbol-string>= (test-if-not-in-cl-package "string>=") nil) +(deftest symbol-stringp (test-if-not-in-cl-package "stringp") nil) +(deftest symbol-structure (test-if-not-in-cl-package "structure") nil) +(deftest symbol-structure-class (test-if-not-in-cl-package "structure-class") nil) +(deftest symbol-structure-object (test-if-not-in-cl-package "structure-object") nil) +(deftest symbol-style-warning (test-if-not-in-cl-package "style-warning") nil) +(deftest symbol-sublis (test-if-not-in-cl-package "sublis") nil) +(deftest symbol-subseq (test-if-not-in-cl-package "subseq") nil) +(deftest symbol-subsetp (test-if-not-in-cl-package "subsetp") nil) +(deftest symbol-subst (test-if-not-in-cl-package "subst") nil) +(deftest symbol-subst-if (test-if-not-in-cl-package "subst-if") nil) +(deftest symbol-subst-if-not (test-if-not-in-cl-package "subst-if-not") nil) +(deftest symbol-substitute (test-if-not-in-cl-package "substitute") nil) +(deftest symbol-substitute-if (test-if-not-in-cl-package "substitute-if") nil) +(deftest symbol-substitute-if-not (test-if-not-in-cl-package "substitute-if-not") nil) +(deftest symbol-subtypep (test-if-not-in-cl-package "subtypep") nil) +(deftest symbol-svref (test-if-not-in-cl-package "svref") nil) +(deftest symbol-sxhash (test-if-not-in-cl-package "sxhash") nil) +(deftest symbol-symbol (test-if-not-in-cl-package "symbol") nil) +(deftest symbol-symbol-function (test-if-not-in-cl-package "symbol-function") nil) +(deftest symbol-symbol-macrolet (test-if-not-in-cl-package "symbol-macrolet") nil) +(deftest symbol-symbol-name (test-if-not-in-cl-package "symbol-name") nil) +(deftest symbol-symbol-package (test-if-not-in-cl-package "symbol-package") nil) +(deftest symbol-symbol-plist (test-if-not-in-cl-package "symbol-plist") nil) +(deftest symbol-symbol-value (test-if-not-in-cl-package "symbol-value") nil) +(deftest symbol-symbolp (test-if-not-in-cl-package "symbolp") nil) +(deftest symbol-synonym-stream (test-if-not-in-cl-package "synonym-stream") nil) +(deftest symbol-synonym-stream-symbol (test-if-not-in-cl-package "synonym-stream-symbol") nil) +(deftest symbol-t (test-if-not-in-cl-package "t") nil) +(deftest symbol-tagbody (test-if-not-in-cl-package "tagbody") nil) +(deftest symbol-tailp (test-if-not-in-cl-package "tailp") nil) +(deftest symbol-tan (test-if-not-in-cl-package "tan") nil) +(deftest symbol-tanh (test-if-not-in-cl-package "tanh") nil) +(deftest symbol-tenth (test-if-not-in-cl-package "tenth") nil) +(deftest symbol-terpri (test-if-not-in-cl-package "terpri") nil) +(deftest symbol-the (test-if-not-in-cl-package "the") nil) +(deftest symbol-third (test-if-not-in-cl-package "third") nil) +(deftest symbol-throw (test-if-not-in-cl-package "throw") nil) +(deftest symbol-time (test-if-not-in-cl-package "time") nil) +(deftest symbol-trace (test-if-not-in-cl-package "trace") nil) +(deftest symbol-translate-logical-pathname (test-if-not-in-cl-package "translate-logical-pathname") nil) +(deftest symbol-translate-pathname (test-if-not-in-cl-package "translate-pathname") nil) +(deftest symbol-tree-equal (test-if-not-in-cl-package "tree-equal") nil) +(deftest symbol-truename (test-if-not-in-cl-package "truename") nil) +(deftest symbol-truncate (test-if-not-in-cl-package "truncate") nil) +(deftest symbol-two-way-stream (test-if-not-in-cl-package "two-way-stream") nil) +(deftest symbol-two-way-stream-input-stream (test-if-not-in-cl-package "two-way-stream-input-stream") nil) +(deftest symbol-two-way-stream-output-stream (test-if-not-in-cl-package "two-way-stream-output-stream") nil) +(deftest symbol-type (test-if-not-in-cl-package "type") nil) +(deftest symbol-type-error (test-if-not-in-cl-package "type-error") nil) +(deftest symbol-type-error-datum (test-if-not-in-cl-package "type-error-datum") nil) +(deftest symbol-type-error-expected-type (test-if-not-in-cl-package "type-error-expected-type") nil) +(deftest symbol-type-of (test-if-not-in-cl-package "type-of") nil) +(deftest symbol-typecase (test-if-not-in-cl-package "typecase") nil) +(deftest symbol-typep (test-if-not-in-cl-package "typep") nil) +(deftest symbol-unbound-slot (test-if-not-in-cl-package "unbound-slot") nil) +(deftest symbol-unbound-slot-instance (test-if-not-in-cl-package "unbound-slot-instance") nil) +(deftest symbol-unbound-variable (test-if-not-in-cl-package "unbound-variable") nil) +(deftest symbol-undefined-function (test-if-not-in-cl-package "undefined-function") nil) +(deftest symbol-unexport (test-if-not-in-cl-package "unexport") nil) +(deftest symbol-unintern (test-if-not-in-cl-package "unintern") nil) +(deftest symbol-union (test-if-not-in-cl-package "union") nil) +(deftest symbol-unless (test-if-not-in-cl-package "unless") nil) +(deftest symbol-unread-char (test-if-not-in-cl-package "unread-char") nil) +(deftest symbol-unsigned-byte (test-if-not-in-cl-package "unsigned-byte") nil) +(deftest symbol-untrace (test-if-not-in-cl-package "untrace") nil) +(deftest symbol-unuse-package (test-if-not-in-cl-package "unuse-package") nil) +(deftest symbol-unwind-protect (test-if-not-in-cl-package "unwind-protect") nil) +(deftest symbol-update-instance-for-different-class (test-if-not-in-cl-package "update-instance-for-different-class") nil) +(deftest symbol-update-instance-for-redefined-class (test-if-not-in-cl-package "update-instance-for-redefined-class") nil) +(deftest symbol-upgraded-array-element-type (test-if-not-in-cl-package "upgraded-array-element-type") nil) +(deftest symbol-upgraded-complex-part-type (test-if-not-in-cl-package "upgraded-complex-part-type") nil) +(deftest symbol-upper-case-p (test-if-not-in-cl-package "upper-case-p") nil) +(deftest symbol-use-package (test-if-not-in-cl-package "use-package") nil) +(deftest symbol-use-value (test-if-not-in-cl-package "use-value") nil) +(deftest symbol-user-homedir-pathname (test-if-not-in-cl-package "user-homedir-pathname") nil) +(deftest symbol-values (test-if-not-in-cl-package "values") nil) +(deftest symbol-values-list (test-if-not-in-cl-package "values-list") nil) +(deftest symbol-variable (test-if-not-in-cl-package "variable") nil) +(deftest symbol-vector (test-if-not-in-cl-package "vector") nil) +(deftest symbol-vector-pop (test-if-not-in-cl-package "vector-pop") nil) +(deftest symbol-vector-push (test-if-not-in-cl-package "vector-push") nil) +(deftest symbol-vector-push-extend (test-if-not-in-cl-package "vector-push-extend") nil) +(deftest symbol-vectorp (test-if-not-in-cl-package "vectorp") nil) +(deftest symbol-warn (test-if-not-in-cl-package "warn") nil) +(deftest symbol-warning (test-if-not-in-cl-package "warning") nil) +(deftest symbol-when (test-if-not-in-cl-package "when") nil) +(deftest symbol-wild-pathname-p (test-if-not-in-cl-package "wild-pathname-p") nil) +(deftest symbol-with-accessors (test-if-not-in-cl-package "with-accessors") nil) +(deftest symbol-with-compilation-unit (test-if-not-in-cl-package "with-compilation-unit") nil) +(deftest symbol-with-condition-restarts (test-if-not-in-cl-package "with-condition-restarts") nil) +(deftest symbol-with-hash-table-iterator (test-if-not-in-cl-package "with-hash-table-iterator") nil) +(deftest symbol-with-input-from-string (test-if-not-in-cl-package "with-input-from-string") nil) +(deftest symbol-with-open-file (test-if-not-in-cl-package "with-open-file") nil) +(deftest symbol-with-open-stream (test-if-not-in-cl-package "with-open-stream") nil) +(deftest symbol-with-output-to-string (test-if-not-in-cl-package "with-output-to-string") nil) +(deftest symbol-with-package-iterator (test-if-not-in-cl-package "with-package-iterator") nil) +(deftest symbol-with-simple-restart (test-if-not-in-cl-package "with-simple-restart") nil) +(deftest symbol-with-slots (test-if-not-in-cl-package "with-slots") nil) +(deftest symbol-with-standard-io-syntax (test-if-not-in-cl-package "with-standard-io-syntax") nil) +(deftest symbol-write (test-if-not-in-cl-package "write") nil) +(deftest symbol-write-byte (test-if-not-in-cl-package "write-byte") nil) +(deftest symbol-write-char (test-if-not-in-cl-package "write-char") nil) +(deftest symbol-write-line (test-if-not-in-cl-package "write-line") nil) +(deftest symbol-write-sequence (test-if-not-in-cl-package "write-sequence") nil) +(deftest symbol-write-string (test-if-not-in-cl-package "write-string") nil) +(deftest symbol-write-to-string (test-if-not-in-cl-package "write-to-string") nil) +(deftest symbol-y-or-n-p (test-if-not-in-cl-package "y-or-n-p") nil) +(deftest symbol-yes-or-no-p (test-if-not-in-cl-package "yes-or-no-p") nil) +(deftest symbol-zerop (test-if-not-in-cl-package "zerop") nil) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Test that all keywords have themselves as their value, +;;; are external if present in KEYWORD, and have themselves +;;; as their values (and are constant). Symbols that are +;;; merely used in KEYWORD but not present there are exempt. + +(deftest keyword-behavior + (let ((result nil) + (keyword-package (find-package "KEYWORD"))) + (do-symbols (s keyword-package result) + (multiple-value-bind (sym status) + (find-symbol (symbol-name s) keyword-package) + (cond + ((not (eqt s sym)) (push (list s sym) result)) + ((eqt status :internal) + (push (list s status) result)) + ((eqt status :external) + (unless (and (eqt (symbol-value s) s) + (constantp s)) + (push (list s sym 'not-constant) result))))))) + nil) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; special-operator-p + + +;;; See section 3.1.2.1.2.1 +(defparameter +special-operators+ + '(block let* return-from catch load-time-value setq eval-when + locally symbol-macrolet flet macrolet tagbody function + multiple-value-call the go multiple-value-prog1 throw if + progn unwind-protect labels progv let quote)) + + +;;; All the symbols in +special-operators+ are special operators +(deftest special-operator-p.1 + (loop for s in +special-operators+ + unless (special-operator-p s) + collect s) + nil) + +;;; None of the standard symbols except those in +special-operators+ +;;; are special operators, unless they have a macro function +;;; (See the page for MACRO-FUNCTION) + +(deftest special-operator-p.2 + (let ((p (find-package "CL"))) + (loop for name in *cl-symbol-names* + unless (or (member name +special-operators+ :test #'string=) + (let ((sym (find-symbol name p))) + (or (not (special-operator-p sym)) + (macro-function sym)))) + collect name)) + nil) + +(deftest special-operator-p.order.1 + (let ((i 0)) + (values (notnot (special-operator-p (progn (incf i) 'catch))) + i)) + t 1) + +(deftest special-operator-p.error.1 + (classify-error (special-operator-p 1)) + type-error) + +(deftest special-operator-p.error.2 + (classify-error (special-operator-p)) + program-error) + +(deftest special-operator-p.error.3 + (classify-error (special-operator-p 'cons 'cons)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; keywordp + +(deftest keywordp.1 (keywordp 'hefalump) nil) +(deftest keywordp.2 (keywordp 17) nil) +(deftest keywordp.3 (notnot-mv (keywordp :stream)) t) +(deftest keywordp.4 (notnot-mv (keywordp ':stream)) t) +(deftest keywordp.5 (keywordp nil) nil) +(deftest keywordp.6 (notnot-mv (keywordp :nil)) t) +(deftest keywordp.7 (keywordp '(:stream)) nil) +(deftest keywordp.8 (keywordp "rest") nil) +(deftest keywordp.9 (keywordp ":rest") nil) +(deftest keywordp.10 (keywordp '&body) nil) +;;; This next test was busted. ::foo is not portable syntax +;;(deftest keywordp.11 (notnot-mv (keywordp ::foo)) t) +(deftest keywordp.12 (keywordp t) nil) + +(deftest keywordp.order.1 + (let ((i 0)) + (values (keywordp (progn (incf i) nil)) i)) + nil 1) + +(deftest keywordp.error.1 (classify-error (keywordp)) program-error) +(deftest keywordp.error.2 (classify-error (keywordp :x :x)) program-error) + +(deftest keywordp.error.3 + (classify-error (keywordp)) + program-error) + +(deftest keywordp.error.4 + (classify-error (keywordp nil nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; symbol-name + +(deftest symbol-name.1 + (symbol-name '|ABCD|) + "ABCD") + +(deftest symbol-name.2 + (symbol-name '|1234abcdABCD|) + "1234abcdABCD") + +(deftest symbol-name.3 + (classify-error (symbol-name 1)) + type-error) + +(deftest symbol-name.4 + (classify-error (symbol-name '(a))) + type-error) + +(deftest symbol-name.5 + (classify-error (symbol-name "ABCDE")) + type-error) + +(deftest symbol-name.6 + (classify-error (symbol-name 12913.0213)) + type-error) + +(deftest symbol-name.7 + (symbol-name :|abcdefg|) + "abcdefg") + +(deftest symbol-name.error.1 + (classify-error (symbol-name)) + program-error) + +(deftest symbol-name.error.2 + (classify-error (symbol-name 'a 'b)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; make-symbol + +(deftest make-symbol.1 + (notnot-mv (symbolp (make-symbol "FOO"))) + t) + +(deftest make-symbol.2 + (symbol-package (make-symbol "BAR")) + nil) + +(deftest make-symbol.3 + (symbol-package (make-symbol "CL::FOO")) + nil) + +(deftest make-symbol.4 + (symbol-package (make-symbol "CL:FOO")) + nil) + +(deftest make-symbol.5 + (symbol-name (make-symbol "xyz")) + "xyz") + +(deftest make-symbol.6 + (eqt (make-symbol "A") + (make-symbol "A")) + nil) + +(deftest make-symbol.7 + (boundp (make-symbol "B")) + nil) + +(deftest make-symbol.8 + (symbol-plist (make-symbol "C")) + nil) + +(deftest make-symbol.9 + (fboundp (make-symbol "D")) + nil) + +(deftest make-symbol.10 + (symbol-name (make-symbol "")) + "") + +(deftest make-symbol.order.1 + (let ((i 0)) + (values + (symbol-name (make-symbol (progn (incf i) "ABC"))) + i)) + "ABC" 1) + +(deftest make-symbol.error.1 + (classify-error (make-symbol nil)) + type-error) + +(deftest make-symbol.error.2 + (classify-error (make-symbol 'a)) + type-error) + +(deftest make-symbol.error.3 + (classify-error (make-symbol 1)) + type-error) + +(deftest make-symbol.error.4 + (classify-error (make-symbol -1)) + type-error) + +(deftest make-symbol.error.5 + (classify-error (make-symbol 1.213)) + type-error) + +(deftest make-symbol.error.6 + (classify-error (make-symbol -1312.2)) + type-error) + +(deftest make-symbol.error.7 + (classify-error (make-symbol #\w)) + type-error) + +(deftest make-symbol.error.8 + (classify-error (make-symbol '(a))) + type-error) + +(deftest make-symbol.error.9 + (classify-error (make-symbol)) + program-error) + +(deftest make-symbol.error.10 + (classify-error (make-symbol "a" "a")) + program-error) + +(deftest make-symbol.error.11 + (classify-error (make-symbol '(#\a #\b #\c))) + type-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; copy-symbol + +(deftest copy-symbol.1 + (notnot-mv + (every + #'(lambda (x) + (let ((y (copy-symbol x))) + (and (null (symbol-plist y)) + (symbolp y) + (not (boundp y)) + (not (fboundp y)) + (null (symbol-package y)) + (string= (symbol-name x) (symbol-name y)) + (symbolp (copy-symbol y)) + ))) + '(nil t a b |a| |123|))) + t) + +(deftest copy-symbol.2 + (progn + (setf (symbol-plist '|foo|) '(a b c d)) + (makunbound '|foo|) + (notnot-mv + (every + #'(lambda (x) + (let ((y (copy-symbol x t))) + (and + (equal (symbol-plist y) (symbol-plist x)) + (symbolp y) + (if (boundp x) + (boundp y) + (not (boundp y))) + (if (fboundp x) (fboundp y) (not (fboundp y))) + (null (symbol-package y)) + (string= (symbol-name x) (symbol-name y)) + ))) + '(nil t a b |foo| |a| |123|)))) + t) + +(deftest copy-symbol.3 + (progn + (setf (symbol-plist '|foo|) '(a b c d)) + (setf (symbol-value '|a|) 12345) + (notnot-mv + (every + #'(lambda (x) + (let ((y (copy-symbol x t))) + (and + (eql (length (symbol-plist y)) + (length (symbol-plist x))) + ;; Is a list copy + (every #'eq (symbol-plist y) (symbol-plist x)) + (symbolp y) + (if (boundp x) + (eqt (symbol-value x) + (symbol-value y)) + (not (boundp y))) + (if (fboundp x) (fboundp y) (not (fboundp y))) + (null (symbol-package y)) + (string= (symbol-name x) (symbol-name y)) + (eql (length (symbol-plist x)) + (length (symbol-plist y))) + ))) + '(nil t a b |foo| |a| |123|)))) + t) + +(deftest copy-symbol.4 + (eqt (copy-symbol 'a) (copy-symbol 'a)) + nil) + +(deftest copy-symbol.5 + (let ((i 0) x y (s '#:|x|)) + (let ((s2 (copy-symbol + (progn (setf x (incf i)) s) + (progn (setf y (incf i)) nil)))) + (values + (symbol-name s2) + (eq s s2) + i x y))) + "x" nil 2 1 2) + +(deftest copy-symbol.error.1 + (classify-error (copy-symbol)) + program-error) + +(deftest copy-symbol.error.2 + (classify-error (copy-symbol 'a t 'foo)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; gensym + +;;; Gensym returns unique symbols +(deftest gensym.1 + (equal (gensym) (gensym)) + nil) + +;;; Gensym returns symbols with distinct print names +(deftest gensym.2 + (string= (symbol-name (gensym)) + (symbol-name (gensym))) + nil) + +;;; Gensym uses the *gensym-counter* special variable, +;;; but does not increment it until after the symbol +;;; has been created. +(deftest gensym.3 + (let ((*gensym-counter* 1)) + (declare (special *gensym-counter*)) + (symbol-name (gensym))) + #.(string '#:g1)) + +;;; Gensym uses the string argument instead of the default +(deftest gensym.4 + (let ((*gensym-counter* 1327)) + (declare (special *gensym-counter*)) + (symbol-name (gensym "FOO"))) + "FOO1327") + +;;; The symbol returned by gensym should be unbound +(deftest gensym.5 + (boundp (gensym)) + nil) + +;;; The symbol returned by gensym should have no function binding +(deftest gensym.6 + (fboundp (gensym)) + nil) + +;;; The symbol returned by gensym should have no property list +(deftest gensym.7 + (symbol-plist (gensym)) + nil) + +;;; The symbol returned by gensym should be uninterned +(deftest gensym.8 + (symbol-package (gensym)) + nil) + +;;; *gensym-counter* is incremented by gensym +(deftest gensym.9 + (let ((*gensym-counter* 12345)) + (declare (special *gensym-counter*)) + (gensym) + *gensym-counter*) + 12346) + +;;; Gensym works when *gensym-counter* is Really Big +;;; (and does not increment the counter until after creating +;;; the symbol.) +(deftest gensym.10 + (let ((*gensym-counter* 1234567890123456789012345678901234567890)) + (declare (special *gensym-counter*)) + (symbol-name (gensym))) + #.(string '#:g1234567890123456789012345678901234567890)) + +;;; gensym increments Really Big values of *gensym-counter* +(deftest gensym.11 + (let ((*gensym-counter* 12345678901234567890123456789012345678901234567890)) + (declare (special *gensym-counter*)) + (gensym) + *gensym-counter*) + 12345678901234567890123456789012345678901234567891) + +;;; Gensym uses an integer argument instead of the counter +(deftest gensym.12 + (let ((*gensym-counter* 10)) + (declare (special *gensym-counter*)) + (symbol-name (gensym 123))) + #.(string '#:g123)) + +;;; When given an integer argument, gensym does not increment the +;;; *gensym-counter* +(deftest gensym.13 + (let ((*gensym-counter* 10)) + (declare (special *gensym-counter*)) + (gensym 123) + *gensym-counter*) + 10) + +;;; Check response to erroneous arguments +;;; Note! NIL is not the same as no argument +;;; gensym should be implemented so that its only +;;; argument defaults to "G", with NIL causing an error. + +(deftest gensym.error.1 + (classify-error (gensym 'aaa)) + type-error) + +(deftest gensym.error.2 + (classify-error (gensym 12.3)) + type-error) + +(deftest gensym.error.3 + (classify-error (gensym t)) + type-error) + +(deftest gensym.error.4 + (classify-error (gensym nil)) + type-error) ;; NIL /= no argument! + +(deftest gensym.error.5 + (classify-error (gensym '(a))) + type-error) + +(deftest gensym.error.6 + (classify-error (gensym #\x)) + type-error) + +(deftest gensym.error.7 + (classify-error (gensym 10 'foo)) + program-error) + +(deftest gensym.error.8 + (classify-error (locally (gensym t) t)) + type-error) + + +;;;;;;;;;;;;;;;;;;;; + +;;; Tests of CL package constraints from section 11.1.2.1.1 + +;;; Check that all symbols listed as 'functions' or 'accessors' +;;; are indeed functions. + +(deftest cl-function-symbols.1 + (loop + for s in (append *cl-function-symbols* *cl-accessor-symbols*) + when (or (not (fboundp s)) + (macro-function s) + (special-operator-p s) + (not (symbol-function s))) + collect s) + nil) + +;;; Check that all symols listed as 'macros' are macros. + +(deftest cl-macro-symbols.1 + (loop + for s in *cl-macro-symbols* + when (or (not (fboundp s)) + (not (macro-function s))) + collect s) + nil) + +;;; Check that all constants are indeed constant + +(deftest cl-constant-symbols.1 + (loop + for s in *cl-constant-symbols* + when (or (not (boundp s)) + (not (constantp s))) + collect s) + nil) + +;;; Check that all global variables have values + +(deftest cl-variable-symbols.1 + (loop + for s in *cl-variable-symbols* + when (not (boundp s)) + collect s) + nil) + +;;; Check that all types that are classes name classes. + +;;; "Many but not all of the predefined type specifiers have +;;; a corresponding class with the same proper name as the type. +;;; These type specifiers are listed in Figure 4-8." -- section 4.3.7 + +(deftest cl-types-that-are-classes.1 + ;; Collect class names that violate the condition in the + ;; above quotation. + (loop + for s in *cl-types-that-are-classes-symbols* + for c = (find-class s nil) + unless (and c + (eq (class-name c) s) + (typep c 'class)) + collect s) + nil) + + +(deftest cl-types-that-are-classes.2 + ;; The same as cl-types-that-are-classes.1 + ;; with an environment argument + (loop + for s in *cl-types-that-are-classes-symbols* + for c = (find-class s nil nil) + unless (and c + (eq (class-name c) s) + (typep c 'class)) + collect s) + nil) + +(deftest cl-types-that-are-classes.3 + ;; The same as cl-types-that-are-classes.1, + ;; with an environment argument + (loop + for s in *cl-types-that-are-classes-symbols* + for c = (eval `(macrolet ((%foo (&environment env) + (list 'quote + (find-class ',s nil env)))) + (%foo))) + unless (and c + (eq (class-name c) s) + (typep c 'class)) + collect s) + nil) + +;;; Various error cases for symbol-related functions + +(deftest symbolp.error.1 + (classify-error (symbolp)) + program-error) + +(deftest symbolp.error.2 + (classify-error (symbolp nil nil)) + program-error) + +(deftest symbol-function.error.1 + (classify-error (symbol-function)) + program-error) + +(deftest symbol-function.error.2 + (classify-error (symbol-function 'cons nil)) + program-error) + +(deftest symbol-package.error.1 + (classify-error (symbol-package)) + program-error) + +(deftest symbol-package.error.2 + (classify-error (symbol-package 'cons nil)) + program-error) + +(deftest symbol-plist.error.1 + (classify-error (symbol-plist)) + program-error) + +(deftest symbol-plist.error.2 + (classify-error (symbol-plist 'cons nil)) + program-error) + +(deftest symbol-value.error.1 + (classify-error (symbol-value)) + program-error) + +(deftest symbol-value.error.2 + (classify-error (symbol-value '*package* nil)) + program-error) + diff --git a/ansi-tests/cl-test-package.lsp b/ansi-tests/cl-test-package.lsp new file mode 100644 index 0000000..5a77e47 --- /dev/null +++ b/ansi-tests/cl-test-package.lsp @@ -0,0 +1,15 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 14 10:13:21 1998 +;;;; Contains: CL test case package definition + +(defpackage :cl-test + (:use :cl :regression-test) + ;; #+gcl (:use defpackage) + (:nicknames) + (:import-from "COMMON-LISP-USER" #:compile-and-load "==>") + (:export)) + +#+cmu (import 'cl::quit :cl-test) + + diff --git a/ansi-tests/clear-input.lsp b/ansi-tests/clear-input.lsp new file mode 100644 index 0000000..73c12f8 --- /dev/null +++ b/ansi-tests/clear-input.lsp @@ -0,0 +1,64 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 28 06:12:39 2004 +;;;; Contains: Tests of CLEAR-INPUT + +(in-package :cl-test) + +;;; These tests are limited, since whether an input stream can be +;;; cleared is not well specified. + +(deftest clear-input.1 + (loop for s in (list *debug-io* *query-io* + *standard-input* *terminal-io*) + always (eq (clear-input s) nil)) + t) + +(deftest clear-input.2 + (clear-input) + nil) + +(deftest clear-input.3 + (clear-input nil) + nil) + +(deftest clear-input.4 + (clear-input t) + nil) + +(deftest clear-input.5 + (with-input-from-string + (is "!?*") + (let ((*terminal-io* (make-two-way-stream is (make-broadcast-stream)))) + (clear-input t))) + nil) + +(deftest clear-input.6 + (with-input-from-string + (*standard-input* "345") + (clear-input nil)) + nil) + +;;; Error cases + +(deftest clear-input.error.1 + :notes (:assume-no-simple-streams) + (signals-error (clear-input t nil) program-error) + t) + +(deftest clear-input.error.2 + :notes (:assume-no-simple-streams) + (signals-error (clear-input nil nil) program-error) + t) + +(deftest clear-input.error.3 + (signals-error (clear-input t nil nil) program-error) + t) + +(deftest clear-input.error.4 + (signals-error (clear-input nil nil nil) program-error) + t) + +(deftest clear-input.error.5 + (check-type-error #'clear-input #'(lambda (x) (typep x '(or stream (member nil t))))) + nil) diff --git a/ansi-tests/clear-output.lsp b/ansi-tests/clear-output.lsp new file mode 100644 index 0000000..03f0ae8 --- /dev/null +++ b/ansi-tests/clear-output.lsp @@ -0,0 +1,53 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 28 06:43:17 2004 +;;;; Contains: Tests of CLEAR-OUTPUT + +(in-package :cl-test) + +(deftest clear-output.1 + (progn (finish-output) (clear-output)) + nil) + +(deftest clear-output.2 + (progn (finish-output) (clear-output t)) + nil) + +(deftest clear-output.3 + (progn (finish-output) (clear-output nil)) + nil) + +(deftest clear-output.4 + (loop for s in (list *debug-io* *error-output* *query-io* + *standard-output* *trace-output* *terminal-io*) + for dummy = (finish-output s) + for results = (multiple-value-list (clear-output s)) + unless (equal results '(nil)) + collect s) + nil) + +(deftest clear-output.5 + (let ((os (make-string-output-stream))) + (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") + os))) + (clear-output t))) + nil) + +(deftest clear-output.6 + (let ((*standard-output* (make-string-output-stream))) + (clear-output nil)) + nil) + +;;; Error tests + +(deftest clear-output.error.1 + (signals-error (clear-output nil nil) program-error) + t) + +(deftest clear-output.error.2 + (signals-error (clear-output t nil) program-error) + t) + +(deftest clear-output.error.3 + (check-type-error #'clear-output #'(lambda (x) (typep x '(or stream (member nil t))))) + nil) diff --git a/ansi-tests/cltest.system b/ansi-tests/cltest.system new file mode 100644 index 0000000..f62d5df --- /dev/null +++ b/ansi-tests/cltest.system @@ -0,0 +1,123 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Mar 27 09:57:28 1998 +;;;; Contains: MK portable system file for CL test suite + +;;; NOTE!! This file is not being maintained right now. +;;; To run the test suite, load "gclload.lsp" + +(mk::defsystem "cltest" + :source-pathname #.(directory-namestring *LOAD-TRUENAME*) + :source-extension "lsp" + :binary-pathname #.(mk::append-directories + (directory-namestring *LOAD-TRUENAME*) + "binary/") + :binary-extension + #+CMU #.(C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*) + #+ALLEGRO "fasl" + #+(OR AKCL GCL) "o" + #+CLISP "fas" + #-(OR CMU ALLEGRO AKCL GCL CLISP) + #.(pathname-type (compile-file-pathname "foo.lisp")) + :initially-do (progn (load "rt/rt.system") + (mk::compile-system "rt")) + :components + ("cl-test-package" + (:subsystem "cl-test-code" + :source-pathname "" + :binary-pathname "" + :depends-on ("cl-test-package") + :components + ( + "ansi-aux" + "universe" + "cons-test-01" + "cons-test-02" + "cons-test-03" + "cons-test-04" + "cons-test-05" + "cons-test-06" + "cons-test-07" + "cons-test-08" + "cons-test-09" + "cons-test-10" + "cons-test-11" + "cons-test-12" + "cons-test-13" + "cons-test-14" + "cons-test-15" + "cons-test-16" + "cons-test-17" + "cons-test-18" + "cons-test-19" + "cons-test-20" + "cons-test-21" + "cons-test-22" + "cons-test-23" + "cons-test-24" + "types-and-class" + "cl-symbols" + "cases-14-1-arrays" + "cases-14-1-list" + "reader-test" + + "packages-00" + "packages-01" + "packages-02" + "packages-03" + "packages-04" + "packages-05" + "packages-06" + "packages-07" + "packages-08" + "packages-09" + "packages-10" + "packages-11" + "packages-12" + "packages-13" + "packages-14" + "packages-15" + "packages-16" + "packages-17" + "packages-18" + + "fill-strings" + "make-sequence" + "map" + "map-into" + "reduce" + "count" + "count-if" + "count-if-not" + "reverse" + "nreverse" + "sort" + "find" + "find-if" + "find-if-not" + "position" + "search-aux" + "search-list" + "search-vector" + "search-bitvector" + "search-string" + "mismatch" + "replace" + "substitute" + "substitute-if" + "substitute-if-not" + "nsubstitute" + "nsubstitute-if" + "nsubstitute-if-not" + "concatenate" + "merge" + "remove" ;; need to extend these tests + + "structure-00" + "structures-01" + "structures-02" + + )))) + + + diff --git a/ansi-tests/coerce.lsp b/ansi-tests/coerce.lsp new file mode 100644 index 0000000..a2dec72 --- /dev/null +++ b/ansi-tests/coerce.lsp @@ -0,0 +1,178 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Dec 13 20:48:04 2002 +;;;; Contains: Tests for COERCE + +(in-package :cl-test) + +(deftest coerce.1 + (loop for x in *universe* + for type = (type-of x) + unless (and (consp type) (eqt (car type) 'function)) + count (not (eq (coerce x type) x))) + 0) + +(deftest coerce.2 + (loop for x in *universe* + count (not (eq (coerce x t) x))) + 0) + +(deftest coerce.3 + (loop for x in *universe* + for class = (class-of x) + count (and class (not (eq (coerce x class) x)))) + 0) + +(deftest coerce.4 + (loop for x in '(() #() #*) + never (coerce x 'list)) + t) + +(deftest coerce.5 + (loop for x in '((1 0) #(1 0) #*10) + always (equal (coerce x 'list) '(1 0))) + t) + +(deftest coerce.6 + (loop for x in '(() #() #*) + always (equalp (coerce x 'vector) #())) + t) + +(deftest coerce.7 + (loop for x in '((1 0) #(1 0) #*10) + for y = (coerce x 'vector) + always (and (equalp y #(1 0)) + (vectorp y))) + t) + +(deftest coerce.8 + (loop for x in '((1 0) #(1 0) #*10) + for y = (coerce x '(vector *)) + always (and (equalp y #(1 0)) + (vectorp y))) + t) + +(deftest coerce.9 + (loop for x in '((1 0) #(1 0) #*10) + for y = (coerce x '(vector * 2)) + always (and (equalp y #(1 0)) + (vectorp y))) + t) + +(deftest coerce.10 + (values (coerce #\A 'character) + (coerce '|A| 'character) + (coerce "A" 'character)) + #\A #\A #\A) + +(deftest coerce.11 + (loop with class = (find-class 'vector) + for x in '((1 0) #(1 0) #*10) + for y = (coerce x class) + always (and (equalp y #(1 0)) + (vectorp y))) + t) + +(deftest coerce.12 + (loop for x in '((1 0) #(1 0) #*10) + for y = (coerce x 'bit-vector) + always (and (equalp y #*10) + (bit-vector-p y))) + t) + +(deftest coerce.13 + (loop for x in '((#\a #\b #\c) "abc") + for y = (coerce x 'string) + always (and (stringp y) + (string= y "abc"))) + t) + +(deftest coerce.14 + (loop for x in '((#\a #\b #\c) "abc") + for y = (coerce x 'simple-string) + always (and (typep y 'simple-string) + (string= y "abc"))) + t) + +(deftest coerce.15 + (loop for x in '((1 0) #(1 0) #*10) + for y = (coerce x 'simple-vector) + always (and (equalp y #(1 0)) + (simple-vector-p y))) + t) + +(deftest coerce.16 + (coerce 0 'integer) + 0) + +(deftest coerce.17 + (coerce 0 'complex) + 0) + +(deftest coerce.18 + (coerce 3 'complex) + 3) + +(deftest coerce.19 + (coerce 5/3 'complex) + 5/3) + +(deftest coerce.20 + (coerce 1.0 'complex) + #c(1.0 0.0)) + +(deftest coerce.21 + (eqt (symbol-function 'car) + (coerce 'car 'function)) + t) + +(deftest coerce.22 + (funcall (coerce '(lambda () 10) 'function)) + 10) + +(deftest coerce.order.1 + (let ((i 0) a b) + (values + (coerce (progn (setf a (incf i)) 10) + (progn (setf b (incf i)) 'single-float)) + i a b)) + 10.0f0 2 1 2) + +;;; Error tests + +;;; (deftest coerce.error.1 +;;; (classify-error (coerce -1 '(integer 0 100))) +;;; type-error) + +(deftest coerce.error.2 + (classify-error (coerce '(a b c) '(vector * 2))) + type-error) + +(deftest coerce.error.3 + (classify-error (coerce '(a b c) '(vector * 4))) + type-error) + +(deftest coerce.error.4 + (classify-error (coerce nil 'cons)) + type-error) + +(deftest coerce.error.5 + (handler-case (eval '(coerce 'not-a-bound-function 'function)) + (error () :caught)) + :caught) + +(deftest coerce.error.6 + (classify-error (coerce)) + program-error) + +(deftest coerce.error.7 + (classify-error (coerce t)) + program-error) + +(deftest coerce.error.8 + (classify-error (coerce 'x t 'foo)) + program-error) + +(deftest coerce.error.9 + (classify-error (locally (coerce nil 'cons) t)) + type-error) diff --git a/ansi-tests/compile-and-load.lsp b/ansi-tests/compile-and-load.lsp new file mode 100644 index 0000000..939fe5f --- /dev/null +++ b/ansi-tests/compile-and-load.lsp @@ -0,0 +1,26 @@ +(in-package :common-lisp-user) + +#+allegro +(progn + (setq *ignore-package-name-case* t) + (when (eq excl:*current-case-mode* :case-sensitive-lower) + (push :lower-case *features*))) + +(eval-when (load eval compile) + (intern "==>" "CL-USER") + (unless (fboundp 'compile-file-pathname) + (defun compile-file-pathname (pathname) + (make-pathname :defaults pathname :type "o")))) + +(defun compile-and-load (pathspec) + "Find the file indicated by PATHSPEC, compiling it first if + the associated compiled file is out of date." + (let* ((pathname (pathname pathspec)) + (compile-pathname (compile-file-pathname pathname)) + (source-write-time (file-write-date pathname)) + (target-write-time (and (probe-file compile-pathname) + (file-write-date compile-pathname)))) + (when (or (not target-write-time) + (<= target-write-time source-write-time)) + (compile-file pathname)) + (load compile-pathname))) diff --git a/ansi-tests/compile-file-test-file.lsp b/ansi-tests/compile-file-test-file.lsp new file mode 100644 index 0000000..ec47795 --- /dev/null +++ b/ansi-tests/compile-file-test-file.lsp @@ -0,0 +1,3 @@ +(in-package "CL-TEST") + +(defun compile-file-test-fun.1 () nil) diff --git a/ansi-tests/compile.lsp b/ansi-tests/compile.lsp new file mode 100644 index 0000000..f3d61f5 --- /dev/null +++ b/ansi-tests/compile.lsp @@ -0,0 +1,91 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 10 20:54:20 2002 +;;;; Contains: Tests for COMPILE, COMPILED-FUNCTION-P, COMPILED-FUNCTION + +(in-package :cl-test) + +(deftest compile.1 + (progn + (fmakunbound 'compile.1-fn) + (values + (defun compile.1-fn (x) x) + (compiled-function-p 'compile.1-fn) + (let ((x (compile 'compile.1-fn))) + (or (eqt x 'compile.1-fn) + (notnot (compiled-function-p x)))) + (compiled-function-p 'compile.1-fn) + (not (compiled-function-p #'compile.1-fn)) + (fmakunbound 'compile.1-fn))) + compile.1-fn + nil + t + nil + nil + compile.1-fn) + + +;;; COMPILE returns three values (function, warnings-p, failure-p) +(deftest compile.2 + (let* ((results (multiple-value-list + (compile nil '(lambda (x y) (cons y x))))) + (fn (car results))) + (values (length results) + (funcall fn 'a 'b) + (second results) + (third results))) + 3 + (b . a) + nil + nil) + +;;; Compile does not coalesce literal constants +(deftest compile.3 + (let ((x (list 'a 'b)) + (y (list 'a 'b))) + (and (not (eqt x y)) + (funcall (compile nil `(lambda () (eqt ',x ',y)))))) + nil) + +(deftest compile.4 + (let ((x (copy-seq "abc")) + (y (copy-seq "abc"))) + (and (not (eqt x y)) + (funcall (compile nil `(lambda () (eqt ,x ,y)))))) + nil) + +(deftest compile.5 + (let ((x (copy-seq "abc"))) + (funcall (compile nil `(lambda () (eqt ,x ,x))))) + t) + +(deftest compile.6 + (let ((x (copy-seq "abc"))) + (funcall (compile nil `(lambda () (eqt ',x ',x))))) + t) + +(deftest compile.7 + (let ((x (copy-seq "abc"))) + (eqt x (funcall (compile nil `(lambda () ,x))))) + t) + +(deftest compile.8 + (let ((x (list 'a 'b))) + (eqt x (funcall (compile nil `(lambda () ',x))))) + t) + +(deftest compile.9 + (let ((i 0) a b) + (values + (funcall (compile (progn (setf a (incf i)) nil) + (progn (setf b (incf i)) '(lambda () 'z)))) + i a b)) + z 2 1 2) + +(deftest compile.error.1 + (classify-error (compile)) + program-error) + +(deftest compile.error.2 + (classify-error (compile nil '(lambda () nil) 'garbage)) + program-error) diff --git a/ansi-tests/compiled-function-p.lsp b/ansi-tests/compiled-function-p.lsp new file mode 100644 index 0000000..f430182 --- /dev/null +++ b/ansi-tests/compiled-function-p.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 16:32:44 2003 +;;;; Contains: Tests of COMPILED-FUNCTION-P + +(in-package :cl-test) + +(deftest compiled-function-p.1 + (some #'(lambda (obj) + (if (check-values (compiled-function-p obj)) + (not (typep obj 'compiled-function)) + (typep obj 'compiled-function))) + *universe*) + nil) + +(deftest compiled-function-p.2 + (compiled-function-p '(lambda (x y) (cons y x))) + nil) + +(deftest compiled-function-p.3 + (notnot-mv (compiled-function-p (compile nil '(lambda (y x) (cons x y))))) + t) + +(deftest compiled-function-p.order.1 + (let ((i 0)) + (values + (compiled-function-p (progn (incf i) '(lambda () nil))) + i)) + nil 1) + +(deftest compiled-function-p.error.1 + (classify-error (compiled-function-p)) + program-error) + +(deftest compiled-function-p.error.2 + (classify-error (compiled-function-p nil nil)) + program-error) + + diff --git a/ansi-tests/compiler-macros.lsp b/ansi-tests/compiler-macros.lsp new file mode 100644 index 0000000..116b2aa --- /dev/null +++ b/ansi-tests/compiler-macros.lsp @@ -0,0 +1,8 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 18:51:30 2003 +;;;; Contains: Tests for compiler macros + +(in-package :cl-test) + +;;; Compiler macro tests will go here diff --git a/ansi-tests/complement.lsp b/ansi-tests/complement.lsp new file mode 100644 index 0000000..0fee0a8 --- /dev/null +++ b/ansi-tests/complement.lsp @@ -0,0 +1,57 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Oct 6 20:04:33 2002 +;;;; Contains: Tests for COMPLEMENT + +(in-package :cl-test) + +(deftest complement.1 + (notnot-mv (funcall (complement #'identity) nil)) + t) + +(deftest complement.2 + (funcall (complement #'identity) t) + nil) + +(deftest complement.3 + (every #'(lambda (x) (eql (funcall (cl::complement #'not) x) + (not (not x)))) + *universe*) + t) + +(deftest complement.4 + (let ((x '(#\b))) + (loop for i from 2 to (min 256 (1- call-arguments-limit)) + always (progn + (push #\a x) + (apply (complement #'char=) x)))) + t) + +(deftest complement.5 + (notnot-mv (complement #'identity)) + t) + +(deftest complement.order.1 + (let ((i 0)) + (let ((fn (complement (progn (incf i) #'null)))) + (values + i + (mapcar fn '(a b nil c 1 nil t nil)) + i))) + 1 (t t nil t t nil t nil) 1) + +(deftest complement.error.1 + (classify-error (complement)) + program-error) + +(deftest complement.error.2 + (classify-error (complement #'not t)) + program-error) + +(deftest complement.error.3 + (classify-error (funcall (complement #'identity))) + program-error) + +(deftest complement.error.4 + (classify-error (funcall (complement #'identity) t t)) + program-error) diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp new file mode 100644 index 0000000..6fdb214 --- /dev/null +++ b/ansi-tests/concatenate.lsp @@ -0,0 +1,227 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Sep 4 22:53:51 2002 +;;;; Contains: Tests for CONCATENATE + +(in-package :cl-test) + +(deftest concatenate.1 + (concatenate 'list) + nil) + +(deftest concatenate.2 + (let* ((orig (list 'a 'b 'c 'd 'e)) + (copy (concatenate 'list orig))) + (values + copy + (intersection (loop for e on orig collect e) + (loop for e on copy collect e) + :test #'eq))) + (a b c d e) + nil) + +(deftest concatenate.3 + (concatenate 'list "") + nil) + +(deftest concatenate.4 + (concatenate 'list "abcd" '(x y z) nil #*1101 #()) + (#\a #\b #\c #\d x y z 1 1 0 1)) + +(deftest concatenate.5 + (concatenate 'vector) + #()) + +(deftest concatenate.6 + (concatenate 'vector nil "abcd" '(x y z) nil #*1101 #()) + #(#\a #\b #\c #\d x y z 1 1 0 1)) + +(deftest concatenate.7 + (let* ((orig (vector 'a 'b 'c 'd 'e)) + (copy (concatenate 'vector orig))) + (values + copy + (eqt copy orig))) + #(a b c d e) + nil) + +(deftest concatenate.8 + (concatenate 'simple-vector '(a b c) #(1 2 3)) + #(a b c 1 2 3)) + +(deftest concatenate.9 + (concatenate 'simple-vector) + #()) + +(deftest concatenate.10 + (concatenate 'bit-vector nil) + #*) + +(deftest concatenate.11 + (concatenate 'bit-vector) + #*) + +(deftest concatenate.12 + (concatenate 'bit-vector '(0 1 1) nil #(1 0 1) #()) + #*011101) + +(deftest concatenate.13 + (concatenate 'simple-bit-vector nil) + #*) + +(deftest concatenate.14 + (concatenate 'simple-bit-vector) + #*) + +(deftest concatenate.15 + (concatenate 'simple-bit-vector '(0 1 1) nil #(1 0 1) #()) + #*011101) + +(deftest concatenate.16 + (concatenate 'string "abc" '(#\d #\e) nil #() "fg") + "abcdefg") + +(deftest concatenate.17 + (concatenate 'simple-string "abc" '(#\d #\e) nil #() "fg") + "abcdefg") + +(deftest concatenate.18 + (concatenate '(vector * *) '(a b c) '(d e f) #(g h)) + #(a b c d e f g h)) + +(deftest concatenate.19 + (concatenate '(vector * 8) '(a b c) '(d e f) #(g h)) + #(a b c d e f g h)) + +(deftest concatenate.20 + (concatenate '(vector symbol 8) '(a b c) '(d e f) #(g h)) + #(a b c d e f g h)) + +(deftest concatenate.21 + (concatenate '(vector symbol) '(a b c) '(d e f) #(g h)) + #(a b c d e f g h)) + +(deftest concatenate.22 + (concatenate '(vector symbol *) '(a b c) '(d e f) #(g h)) + #(a b c d e f g h)) + +(deftest concatenate.23 + (concatenate 'cons '(a b c) '(d e f)) + (a b c d e f)) + +(deftest concatenate.24 + (concatenate 'null nil nil) + nil) + +;;; Tests on vectors with fill pointers + +(deftest concatenate.25 + (let ((x (make-array '(10) :initial-contents '(a b c d e f g h i j) + :fill-pointer 5))) + (concatenate 'list x x)) + (a b c d e a b c d e)) + +(deftest concatenate.26 + (let ((x (make-array '(10) :initial-contents '(a b c d e f g h i j) + :fill-pointer 5))) + (concatenate 'list x)) + (a b c d e)) + +(deftest concatenate.27 + (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j) + :fill-pointer 5)) + (result (concatenate 'vector x))) + (values (not (simple-vector-p result)) + result)) + nil + #(a b c d e)) + +(deftest concatenate.28 + (let* ((x (make-array '(10) :initial-contents "abcdefghij" + :fill-pointer 5 :element-type 'character))) + (values + (concatenate 'string x '(#\z)) + (concatenate 'string '(#\z) x) + (concatenate 'string x x) + (concatenate 'string x) + (not (simple-string-p (concatenate 'string x))) + )) + "abcdez" + "zabcde" + "abcdeabcde" + "abcde" + nil) + +(deftest concatenate.29 + (let* ((x (make-array '(10) :initial-contents "abcdefghij" + :fill-pointer 5 :element-type 'base-char))) + (values + (concatenate 'string x '(#\z)) + (concatenate 'string '(#\z) x) + (concatenate 'string x x) + (concatenate 'string x) + (not (simple-string-p (concatenate 'string x))) + )) + "abcdez" + "zabcde" + "abcdeabcde" + "abcde" + nil) + +(deftest concatenate.30 + (let* ((x (make-array '(10) :initial-contents #*0110010111 + :fill-pointer 5 :element-type 'bit))) + (values + (concatenate 'bit-vector x '(0)) + (concatenate 'bit-vector '(0) x) + (concatenate 'bit-vector x x) + (concatenate 'bit-vector x) + (not (simple-bit-vector-p (concatenate 'bit-vector x))) + )) + #*011000 + #*001100 + #*0110001100 + #*01100 + nil) + +(deftest concatenate.order.1 + (let ((i 0) w x y z) + (values + (concatenate (progn (setf w (incf i)) 'string) + (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "def") + (progn (setf z (incf i)) "ghi")) + i w x y z)) + "abcdefghi" 4 1 2 3 4) + +(deftest concatenate.order.2 + (let ((i 0) x y z) + (values + (concatenate 'string + (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "def") + (progn (setf z (incf i)) "ghi")) + i x y z)) + "abcdefghi" 3 1 2 3) + +;;; Error tests + +(deftest concatenate.error.1 + (subtypep* (classify-error (concatenate 'sequence '(a b c))) 'error) + t t) + +(deftest concatenate.error.2 + (subtypep* (classify-error (concatenate 'fixnum '(a b c d e))) 'error) + t t) + +(deftest concatenate.error.3 + (classify-error (concatenate '(vector * 3) '(a b c d e))) + type-error) + +(deftest concatenate.error.4 + (classify-error (concatenate)) + program-error) + +(deftest concatenate.error.5 + (classify-error (locally (concatenate '(vector * 3) '(a b c d e)) t)) + type-error) diff --git a/ansi-tests/concatenated-stream-streams.lsp b/ansi-tests/concatenated-stream-streams.lsp new file mode 100644 index 0000000..0cc7e29 --- /dev/null +++ b/ansi-tests/concatenated-stream-streams.lsp @@ -0,0 +1,67 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 08:43:45 2004 +;;;; Contains: Tests of CONCATENATED-STREAM-STREAMS + +(in-package :cl-test) + +(deftest concatenated-stream-streams.1 + (concatenated-stream-streams (make-concatenated-stream)) + nil) + +(deftest concatenated-stream-streams.2 + (equalt (list (list *standard-input*)) + (multiple-value-list + (concatenated-stream-streams + (make-concatenated-stream *standard-input*)))) + t) + +(deftest concatenated-stream-streams.3 + (with-input-from-string + (s1 "abc") + (with-input-from-string + (s2 "def") + (let ((s (make-concatenated-stream s1 s2))) + (equalt (list (list s1 s2)) + (multiple-value-list + (concatenated-stream-streams s)))))) + t) + +(deftest concatenated-stream-streams.4 + (with-input-from-string + (s1 "") + (with-input-from-string + (s2 "def") + (let ((s (make-concatenated-stream s1 s2))) + (equalt (list (list s1 s2)) + (multiple-value-list + (concatenated-stream-streams s)))))) + t) + +(deftest concatenated-stream-streams.5 + (with-input-from-string + (s1 "") + (with-input-from-string + (s2 "def") + (let ((s (make-concatenated-stream s1 s2))) + (values + (read-char s) + (equalt (list (list s2)) + (multiple-value-list + (concatenated-stream-streams s))))))) + #\d t) + +;;; Error cases + +(deftest concatenated-stream-streams.error.1 + (signals-error (concatenated-stream-streams) program-error) + t) + +(deftest concatenated-stream-streams.error.2 + (signals-error (concatenated-stream-streams + (make-concatenated-stream) + nil) + program-error) + t) + + diff --git a/ansi-tests/cond.lsp b/ansi-tests/cond.lsp new file mode 100644 index 0000000..df34248 --- /dev/null +++ b/ansi-tests/cond.lsp @@ -0,0 +1,75 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 07:37:58 2002 +;;;; Contains: Tests of COND + +(in-package :cl-test) + +(deftest cond.1 + (cond) + nil) + +(deftest cond.2 + (cond ('a)) + a) + +(deftest cond.3 + (cond (nil)) + nil) + +(deftest cond.4 + (cond (nil 'a) (nil 'b)) + nil) + +(deftest cond.5 + (cond (nil 'a) ('b)) + b) + +(deftest cond.6 + (cond (t 'a) (t 'b)) + a) + +(deftest cond.7 + (let ((x 0)) + (values + (cond ((progn (incf x) nil) 'a) (t 'b) ((incf x) 'c)) + x)) + b 1) + +(deftest cond.8 + (let ((x 0)) + (values + (cond (nil (incf x) 'a) + (nil (incf x 10) 'b) + (t (incf x 2) 'c) + (t (incf x 100) 'd)) + x)) + c 2) + +(deftest cond.9 + (cond ((values 'a 'b 'c))) + a) + +(deftest cond.10 + (cond (t (values 'a 'b 'c))) + a b c) + +(deftest cond.11 + (cond + ((values nil t) 'a) + (t 'b)) + b) + +(deftest cond.12 + (cond ((values))) + nil) + +(deftest cond.13 + (cond ((values)) (t 'a)) + a) + +(deftest cond.14 (cond (t (values)))) + + + + diff --git a/ansi-tests/condition.lsp b/ansi-tests/condition.lsp new file mode 100644 index 0000000..a42ea74 --- /dev/null +++ b/ansi-tests/condition.lsp @@ -0,0 +1,63 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 27 22:13:25 2003 +;;;; Contains: Tests of class CONDITION + +(in-package :cl-test) + +(deftest condition.1 + (notnot-mv (find-class 'condition nil)) + t) + +(defparameter *allowed-condition-inclusions* + '( + (arithmetic-error error serious-condition condition) + (cell-error error serious-condition condition) + (condition) + (control-error error serious-condition condition) + (division-by-zero arithmetic-error error serious-condition condition) + (end-of-file stream-error error serious-condition condition) + (error serious-condition condition) + (file-error error serious-condition condition) + (floating-point-inexact arithmetic-error error serious-condition condition) + (floating-point-invalid-operation arithmetic-error error serious-condition condition) + (floating-point-overflow arithmetic-error error serious-condition condition) + (floating-point-underflow arithmetic-error error serious-condition condition) + (package-error error serious-condition condition) + (parse-error error serious-condition condition) + (print-not-readable error serious-condition condition) + (program-error error serious-condition condition) + (reader-error parse-error stream-error error serious-condition condition) + (serious-condition condition) + (simple-condition condition) + (simple-error simple-condition error serious-condition condition) + (simple-type-error simple-condition type-error error serious-condition condition) + (simple-warning simple-condition warning condition) + (storage-condition serious-condition condition) + (stream-error error serious-condition condition) + (style-warning warning condition) + (type-error error serious-condition condition) + (unbound-slot cell-error error serious-condition condition) + (unbound-variable cell-error error serious-condition condition) + (undefined-function cell-error error serious-condition condition) + (warning condition) + )) + +;;; Relationships given in *allowed-condition-inclusions* are the only +;;; subtype relationships allowed on condition types +(deftest condition.2 + (loop for (cnd . supers) in *allowed-condition-inclusions* + append (loop for super in supers + unless (subtypep cnd super) + collect (list cnd super))) + nil) + +(deftest condition.3 + ;; Relationships given in *allowed-condition-inclusions* are the only + ;; subtype relationships allowed on condition types + (loop for cnds in *allowed-condition-inclusions* + for cnd = (first cnds) + append (loop for super in (set-difference *condition-types* cnds) + when (subtypep cnd super) + collect (list cnd super))) + nil) diff --git a/ansi-tests/cons-test-01.lsp b/ansi-tests/cons-test-01.lsp new file mode 100644 index 0000000..c665a81 --- /dev/null +++ b/ansi-tests/cons-test-01.lsp @@ -0,0 +1,456 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:29:48 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 1 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;; +;; Test the subtype relationships between null, list, cons and atom +;; +(deftest subtypep-null-list + (subtypep* 'null 'list) + t t) + +(deftest subtypep-cons-list + (subtypep* 'cons 'list) + t t) + +(deftest subtypep-null-cons + (subtypep* 'null 'cons) + nil t) + +(deftest subtypep-cons-null + (subtypep* 'cons 'null) + nil t) + +(deftest subtypep-null-atom + (subtypep* 'null 'atom) + t t) + +(deftest subtypep-cons-atom + (subtypep* 'cons 'atom) + nil t) + +(deftest subtypep-atom-cons + (subtypep* 'atom 'cons) + nil t) + +(deftest subtypep-atom-list + (subtypep* 'atom 'list) + nil t) + +(deftest subtypep-list-atom + (subtypep* 'list 'atom) + nil t) + +;; +;; Check that the elements of *universe* in type null +;; are those for which the null predice is true. +;; +(deftest null-null-universe + (check-type-predicate 'null 'null) + 0) + +(defvar *cons-fns* + (list 'cons 'consp 'atom 'rplaca 'rplacd + 'car 'cdr 'caar 'cadr 'cdar 'cddr + 'caaar 'caadr 'cadar 'caddr + 'cdaar 'cdadr 'cddar 'cdddr + 'caaaar 'caaadr 'caadar 'caaddr + 'cadaar 'cadadr 'caddar 'cadddr + 'cdaaar 'cdaadr 'cdadar 'cdaddr + 'cddaar 'cddadr 'cdddar 'cddddr + 'copy-tree 'sublis 'nsublis + 'subst 'subst-if 'subst-if-not + 'nsubst 'nsubst-if 'nsubst-if-not + 'tree-equal + 'copy-list + 'list + 'list* + 'list-length + 'listp + 'make-list + 'first 'second 'third 'fourth + 'fifth 'sixth 'seventh 'eighth 'ninth 'tenth + 'nth + 'endp + 'null + 'nconc + 'append + 'revappend 'nreconc + 'butlast 'nbutlast + 'last 'ldiff 'tailp + 'nthcdr 'rest + 'member 'member-if 'member-if-not + 'mapc 'mapcar 'mapcan 'mapl 'maplist 'mapcon + 'acons + 'assoc 'assoc-if 'assoc-if-not + 'copy-alist + 'pairlis + 'rassoc 'rassoc-if 'rassoc-if-not + 'get-properties + 'getf + 'intersection + 'nintersection + 'adjoin + 'set-difference 'nset-difference + 'set-exclusive-or 'nset-exclusive-or + 'subsetp + 'union 'nunion + )) + +;; All the cons functions have a function binding + +(deftest function-bound-cons-fns + (loop + for x in *cons-fns* count + (when (or (not (fboundp x)) + (not (functionp (symbol-function x)))) + (format t "~%~S not bound to a function" x) + t)) + 0) + +;; All the cons-related macros have a macro binding +(deftest macro-bound-cons-macros + (notnot-mv (every #'macro-function + (list 'push 'pop 'pushnew 'remf))) + t) + +;; None of the cons-related functions have macro bindings +(deftest no-cons-fns-are-macros + (some #'macro-function *cons-fns*) + nil) + +;; Various easy tests of cons +(deftest cons-of-symbols + (cons 'a 'b) + (a . b)) + +(deftest cons-with-nil + (cons 'a nil) + (a)) + +;; successive calls to cons produces results that are equal, but not eq +(deftest cons-eq-equal + (let ((x (cons 'a 'b)) + (y (cons 'a 'b))) + (and (not (eqt x y)) + (equalt x y))) + t) + +;; list can be expressed as a bunch of conses (with nil) +(deftest cons-equal-list + (equalt (cons 'a (cons 'b (cons 'c nil))) + (list 'a 'b 'c)) + t) + +;;; Order of evaluation of cons arguments +(deftest cons.order.1 + (let ((i 0)) (values (cons (incf i) (incf i)) i)) + (1 . 2) 2) + +;; Lists satisfy consp +(deftest consp-list + (notnot-mv (consp '(a))) + t) + +;; cons satisfies consp +(deftest consp-cons + (notnot-mv (consp (cons nil nil))) + t) + +;; nil is not a consp +(deftest consp-nil + (consp nil) + nil) + +;; The empty list is not a cons +(deftest consp-empty-list + (consp (list)) + nil) + +;; A single element list is a cons +(deftest consp-single-element-list + (notnot-mv (consp (list 'a))) + t) + +;; For everything in *universe*, it is either an atom, or satisfies +;; consp, but not both +(deftest consp-xor-atom-universe + (notnot-mv + (every #'(lambda (x) (or (and (consp x) (not (atom x))) + (and (not (consp x)) (atom x)))) + *universe*)) + t) + +;; Everything in type cons satisfies consp, and vice versa +(deftest consp-cons-universe + (check-type-predicate 'consp 'cons) + 0) + +(deftest consp.order.1 + (let ((i 0)) + (values (consp (incf i)) i)) + nil 1) + +(deftest consp.error.1 + (classify-error (consp)) + program-error) + +(deftest consp.error.2 + (classify-error (consp 'a 'b)) + program-error) + +(deftest atom.order.1 + (let ((i 0)) + (values (atom (progn (incf i) '(a b))) i)) + nil 1) + +(deftest atom.error.1 + (classify-error (atom)) + program-error) + +(deftest atom.error.2 + (classify-error (atom 'a 'b)) + program-error) + +;; Tests of car, cdr and compound forms +(deftest cons.23 + (car '(a)) + a) + +(deftest cons.24 + (cdr '(a . b)) + b) + +(deftest cons.25 + (caar '((a))) + a) + +(deftest cons.26 + (cdar '((a . b))) + b) + +(deftest cons.27 + (cadr '(a b)) + b) + +(deftest cons.28 + (cddr '(a b . c)) + c) + +(deftest cons.29 + (caaar '(((a)))) + a) + +(deftest cons.30 + (cdaar '(((a . b)))) + b) + +(deftest cons.31 + (cadar (cons (cons 'a (cons 'b 'c)) 'd)) + b) + +(deftest cons.32 + (cddar (cons (cons 'a (cons 'b 'c)) 'd)) + c) + +(deftest cons.33 + (caadr (cons 'a (cons (cons 'b 'c) 'd))) + b) + +(deftest cons.34 + (caddr (cons 'a (cons 'b (cons 'c 'd)))) + c) + +(deftest cons.36 + (cdadr (cons 'a (cons (cons 'b 'c) 'd))) + c) + +(deftest cons.37 + (cdddr (cons 'a (cons 'b (cons 'c 'd)))) + d) + +(defvar *cons-test-4* + (cons (cons (cons (cons 'a 'b) + (cons 'c 'd)) + (cons (cons 'e 'f) + (cons 'g 'h))) + (cons (cons (cons 'i 'j) + (cons 'k 'l)) + (cons (cons 'm 'n) + (cons 'o 'p))))) + + +(deftest cons.38 + (caaaar *cons-test-4*) + a) + +(deftest cons.39 + (cdaaar *cons-test-4*) + b) + +(deftest cons.40 + (cadaar *cons-test-4*) + c) + +(deftest cons.41 + (cddaar *cons-test-4*) + d) + +(deftest cons.42 + (caadar *cons-test-4*) + e) + +(deftest cons.43 + (cdadar *cons-test-4*) + f) + +(deftest cons.44 + (caddar *cons-test-4*) + g) + +(deftest cons.45 + (cdddar *cons-test-4*) + h) + +;;; + +(deftest cons.46 + (caaadr *cons-test-4*) + i) + +(deftest cons.47 + (cdaadr *cons-test-4*) + j) + +(deftest cons.48 + (cadadr *cons-test-4*) + k) + +(deftest cons.49 + (cddadr *cons-test-4*) + l) + +(deftest cons.50 + (caaddr *cons-test-4*) + m) + +(deftest cons.51 + (cdaddr *cons-test-4*) + n) + +(deftest cons.52 + (cadddr *cons-test-4*) + o) + +(deftest cons.53 + (cddddr *cons-test-4*) + p) + +(deftest cons.error.1 + (classify-error (cons)) + program-error) + +(deftest cons.error.2 + (classify-error (cons 'a)) + program-error) + +(deftest cons.error.3 + (classify-error (cons 'a 'b 'c)) + program-error) + +;; Test rplaca, rplacd + +(deftest rplaca.1 + (let ((x (cons 'a 'b))) + (let ((y x)) + (and (eqt (rplaca x 'c) y) + (eqt x y) + (eqt (car x) 'c) + (eqt (cdr x) 'b)))) + t) + +(deftest rplaca.order.1 + (let ((x (cons 'a 'b)) + (i 0) a b) + (values + (rplaca (progn (setf a (incf i)) x) + (progn (setf b (incf i)) 'c)) + i a b)) + (c . b) 2 1 2) + +(deftest rplacd.1 + (let ((x (cons 'a 'b))) + (let ((y x)) + (and (eqt (rplacd x 'd) y) + (eqt x y) + (eqt (car x) 'a) + (eqt (cdr x) 'd)))) + t) + +(deftest rplacd.order.1 + (let ((x (cons 'a 'b)) + (i 0) a b) + (values + (rplacd (progn (setf a (incf i)) x) + (progn (setf b (incf i)) 'c)) + i a b)) + (a . c) 2 1 2) + +;; rplaca on a fixnum is a type error +(deftest rplaca.error.1 + (loop for x in *universe* + thereis (and (not (consp x)) + (not (eq (catch-type-error (rplaca x 1)) 'type-error)))) + nil) + +(deftest rplaca.error.2 + (classify-error (rplaca)) + program-error) + +(deftest rplaca.error.3 + (classify-error (rplaca (cons 'a 'b))) + program-error) + +(deftest rplaca.error.4 + (classify-error (rplaca (cons 'a 'b) (cons 'c 'd) 'garbage)) + program-error) + +(deftest rplaca.error.5 + (classify-error (rplaca 'a 1)) + type-error) + +(deftest rplaca.error.6 + (classify-error (locally (rplaca 'a 1) t)) + type-error) + +;; rplacd on a fixnum is a type error +(deftest rplacd.error.1 + (loop for x in *universe* + thereis (and (not (consp x)) + (not (eq (catch-type-error (rplacd x 1)) 'type-error)))) + nil) + +(deftest rplacd.error.2 + (classify-error (rplacd)) + program-error) + +(deftest rplacd.error.3 + (classify-error (rplacd (cons 'a 'b))) + program-error) + +(deftest rplacd.error.4 + (classify-error (rplacd (cons 'a 'b) (cons 'c 'd) 'garbage)) + program-error) + +(deftest rplacd.error.5 + (classify-error (rplacd 'a 1)) + type-error) + +(deftest rplacd.error.6 + (classify-error (locally (rplacd 'a 1) t)) + type-error) diff --git a/ansi-tests/cons-test-02.lsp b/ansi-tests/cons-test-02.lsp new file mode 100644 index 0000000..85cb288 --- /dev/null +++ b/ansi-tests/cons-test-02.lsp @@ -0,0 +1,1117 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:30:50 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 2 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; copy-tree + +;; Try copy-tree on a tree containing elements of various kinds +(deftest copy-tree.1 + (let ((x (cons 'a (list (cons 'b 'c) + (cons 1 1.2) + (list (list "abcde" + (make-array '(10) :initial-element (cons 'e 'f))) + 'g))))) + (let ((y (copy-tree x))) + (check-cons-copy x y))) + t) + +;; Try copy-tree on *universe* +(deftest copy-tree.2 + (let* ((x (copy-list *universe*)) + (y (copy-tree x))) + (check-cons-copy x y)) + t) + +(deftest copy-tree.order.1 + (let ((i 0)) + (values + (copy-tree (progn (incf i) '(a b c))) + i)) + (a b c) 1) + +(deftest copy-tree.error.1 + (classify-error (copy-tree)) + program-error) + +(deftest copy-tree.error.2 + (classify-error (copy-tree 'a 'b)) + program-error) + +;;; + +(deftest sublis.1 + (check-sublis '((a b) g (d e 10 g h) 15 . g) + '((e . e2) (g . 17))) + ((a b) 17 (d e2 10 17 h) 15 . 17)) + +(deftest sublis.2 + (check-sublis '(f6 10 (f4 (f3 (f1 a b) (f1 a p)) (f2 a b))) + '(((f1 a b) . (f2 a b)) ((f2 a b) . (f1 a b))) + :test #'equal) + (f6 10 (f4 (f3 (f2 a b) (f1 a p)) (f1 a b)))) + +(deftest sublis.3 + (check-sublis '(10 ((10 20 (a b c) 30)) (((10 20 30 40)))) + '((30 . "foo"))) + (10 ((10 20 (a b c) "foo")) (((10 20 "foo" 40))))) + +(deftest sublis.4 + (check-sublis (sublis + (copy-tree '((a . 2) (b . 4) (c . 1))) + (copy-tree '(a b c d e (a b c a d b) f))) + '((t . "yes")) + :key #'(lambda (x) (and (typep x 'integer) + (evenp x)))) + ("yes" "yes" 1 d e ("yes" "yes" 1 "yes" d "yes") f)) + +(deftest sublis.5 + (check-sublis '("fee" (("fee" "Fie" "foo")) + fie ("fee" "fie")) + `((,(copy-seq "fie") . #\f))) + ("fee" (("fee" "Fie" "foo")) fie ("fee" "fie"))) + +(deftest sublis.6 + (check-sublis '("fee" fie (("fee" "Fie" "foo") 1) + ("fee" "fie")) + `((,(copy-seq "fie") . #\f)) + :test 'equal) + ("fee" fie (("fee" "Fie" "foo") 1) ("fee" #\f))) + +(deftest sublis.7 + (check-sublis '(("aa" a b) + (z "bb" d) + ((x . "aa"))) + `((,(copy-seq "aa") . 1) + (,(copy-seq "bb") . 2)) + :test 'equal + :key #'(lambda (x) (if (consp x) (car x) + '*not-present*))) + (1 (z . 2) ((x . "aa")))) + +;; Check that a null key arg is ignored. + +(deftest sublis.8 + (check-sublis + '(1 2 a b) + '((1 . 2) (a . b)) + :key nil) + (2 2 b b)) + +;;; Order of argument evaluation +(deftest sublis.order.1 + (let ((i 0) w x y z) + (values + (sublis + (progn (setf w (incf i)) + '((a . z))) + (progn (setf x (incf i)) + (copy-tree '(a b c d))) + :test (progn (setf y (incf i)) #'eql) + :key (progn (setf z (incf i)) #'identity)) + i w x y z)) + (z b c d) + 4 1 2 3 4) + +(deftest sublis.order.2 + (let ((i 0) w x y z) + (values + (sublis + (progn (setf w (incf i)) + '((a . z))) + (progn (setf x (incf i)) + (copy-tree '(a b c d))) + :key (progn (setf y (incf i)) #'identity) + :test-not (progn (setf z (incf i)) (complement #'eql)) + ) + i w x y z)) + (z b c d) + 4 1 2 3 4) + + +;;; Keyword tests + +(deftest sublis.allow-other-keys.1 + (sublis nil 'a :bad t :allow-other-keys t) + a) + +(deftest sublis.allow-other-keys.2 + (sublis nil 'a :allow-other-keys t :bad t) + a) + +(deftest sublis.allow-other-keys.3 + (sublis nil 'a :allow-other-keys t) + a) + +(deftest sublis.allow-other-keys.4 + (sublis nil 'a :allow-other-keys nil) + a) + +(deftest sublis.allow-other-keys.5 + (sublis nil 'a :allow-other-keys t :allow-other-keys t :bad t) + a) + +(deftest sublis.keywords.6 + (sublis '((1 . a)) (list 0 1 2) :key #'(lambda (x) (if (numberp x) (1+ x) x)) + :key #'identity) + (a 1 2)) + + +;; Argument error cases + +(deftest sublis.error.1 + (classify-error (sublis)) + program-error) + +(deftest sublis.error.2 + (classify-error (sublis nil)) + program-error) + +(deftest sublis.error.3 + (classify-error (sublis nil 'a :test)) + program-error) + +(deftest sublis.error.4 + (classify-error (sublis nil 'a :bad-keyword t)) + program-error) + +(deftest sublis.error.5 + (classify-error (sublis '((a . 1) (b . 2)) + (list 'a 'b 'c 'd) + :test #'identity)) + program-error) + +(deftest sublis.error.6 + (classify-error (sublis '((a . 1) (b . 2)) + (list 'a 'b 'c 'd) + :key #'cons)) + program-error) + +(deftest sublis.error.7 + (classify-error (sublis '((a . 1) (b . 2)) + (list 'a 'b 'c 'd) + :test-not #'identity)) + program-error) + +;; nsublis + +(deftest nsublis.1 + (check-nsublis '((a b) g (d e 10 g h) 15 . g) + '((e . e2) (g . 17))) + ((a b) 17 (d e2 10 17 h) 15 . 17)) + +(deftest nsublis.2 + (check-nsublis '(f6 10 (f4 (f3 (f1 a b) (f1 a p)) (f2 a b))) + '(((f1 a b) . (f2 a b)) ((f2 a b) . (f1 a b))) + :test #'equal) + (f6 10 (f4 (f3 (f2 a b) (f1 a p)) (f1 a b)))) + +(deftest nsublis.3 + (check-nsublis '(10 ((10 20 (a b c) 30)) (((10 20 30 40)))) + '((30 . "foo"))) + (10 ((10 20 (a b c) "foo")) (((10 20 "foo" 40))))) + +(deftest nsublis.4 + (check-nsublis + (nsublis (copy-tree '((a . 2) (b . 4) (c . 1))) + (copy-tree '(a b c d e (a b c a d b) f))) + '((t . "yes")) + :key #'(lambda (x) (and (typep x 'integer) + (evenp x)))) + ("yes" "yes" 1 d e ("yes" "yes" 1 "yes" d "yes") f)) + +(deftest nsublis.5 + (check-nsublis '("fee" (("fee" "Fie" "foo")) + fie ("fee" "fie")) + `((,(copy-seq "fie") . #\f))) + ("fee" (("fee" "Fie" "foo")) fie ("fee" "fie"))) + +(deftest nsublis.6 + (check-nsublis '("fee" fie (("fee" "Fie" "foo") 1) + ("fee" "fie")) + `((,(copy-seq "fie") . #\f)) + :test 'equal) + ("fee" fie (("fee" "Fie" "foo") 1) ("fee" #\f))) + +(deftest nsublis.7 + (check-nsublis '(("aa" a b) + (z "bb" d) + ((x . "aa"))) + `((,(copy-seq "aa") . 1) + (,(copy-seq "bb") . 2)) + :test 'equal + :key #'(lambda (x) (if (consp x) (car x) + '*not-present*))) + (1 (z . 2) ((x . "aa")))) + +(deftest nsublis.8 + (nsublis nil 'a :bad-keyword t :allow-other-keys t) + a) + +;; Check that a null key arg is ignored. + +(deftest nsublis.9 + (check-nsublis + '(1 2 a b) + '((1 . 2) (a . b)) + :key nil) + (2 2 b b)) + +;;; Order of argument evaluation +(deftest nsublis.order.1 + (let ((i 0) w x y z) + (values + (nsublis + (progn (setf w (incf i)) + '((a . z))) + (progn (setf x (incf i)) + (copy-tree '(a b c d))) + :test (progn (setf y (incf i)) #'eql) + :key (progn (setf z (incf i)) #'identity)) + i w x y z)) + (z b c d) + 4 1 2 3 4) + +(deftest nsublis.order.2 + (let ((i 0) w x y z) + (values + (nsublis + (progn (setf w (incf i)) + '((a . z))) + (progn (setf x (incf i)) + (copy-tree '(a b c d))) + :key (progn (setf y (incf i)) #'identity) + :test-not (progn (setf z (incf i)) (complement #'eql)) + ) + i w x y z)) + (z b c d) + 4 1 2 3 4) + +;;; Keyword tests + +(deftest nsublis.allow-other-keys.1 + (nsublis nil 'a :bad t :allow-other-keys t) + a) + +(deftest nsublis.allow-other-keys.2 + (nsublis nil 'a :allow-other-keys t :bad t) + a) + +(deftest nsublis.allow-other-keys.3 + (nsublis nil 'a :allow-other-keys t) + a) + +(deftest nsublis.allow-other-keys.4 + (nsublis nil 'a :allow-other-keys nil) + a) + +(deftest nsublis.allow-other-keys.5 + (nsublis nil 'a :allow-other-keys t :allow-other-keys t :bad t) + a) + +(deftest nsublis.keywords.6 + (nsublis '((1 . a)) (list 0 1 2) + :key #'(lambda (x) (if (numberp x) (1+ x) x)) + :key #'identity) + (a 1 2)) + +;; Argument error cases + +(deftest nsublis.error.1 + (classify-error (nsublis)) + program-error) + +(deftest nsublis.error.2 + (classify-error (nsublis nil)) + program-error) + +(deftest nsublis.error.3 + (classify-error (nsublis nil 'a :test)) + program-error) + +(deftest nsublis.error.4 + (classify-error (nsublis nil 'a :bad-keyword t)) + program-error) + +(deftest nsublis.error.5 + (classify-error (nsublis '((a . 1) (b . 2)) + (list 'a 'b 'c 'd) + :test #'identity)) + program-error) + +(deftest nsublis.error.6 + (classify-error (nsublis '((a . 1) (b . 2)) + (list 'a 'b 'c 'd) + :key #'cons)) + program-error) + +(deftest nsublis.error.7 + (classify-error (nsublis '((a . 1) (b . 2)) + (list 'a 'b 'c 'd) + :test-not #'identity)) + program-error) + +;;;;;; + +(deftest sublis.shared + (let* ((shared-piece (list 'a 'b)) + (a (list shared-piece shared-piece))) + (check-sublis a '((a . b) (b . a)))) + ((b a) (b a))) + +(defvar *subst-tree-1* '(10 (30 20 10) (20 10) (10 20 30 40))) + +(deftest subst.1 + (check-subst "Z" 30 (copy-tree *subst-tree-1*)) + (10 ("Z" 20 10) (20 10) (10 20 "Z" 40))) + +(deftest subst.2 + (check-subst "A" 0 (copy-tree *subst-tree-1*)) + (10 (30 20 10) (20 10) (10 20 30 40))) + +(deftest subst.3 + (check-subst "Z" 100 (copy-tree *subst-tree-1*) :test-not #'eql) + "Z") + +(deftest subst.4 + (check-subst 'grape 'dick + '(melville wrote (moby dick))) + (melville wrote (moby grape))) + +(deftest subst.5 + (check-subst 'cha-cha-cha 'nil '(melville wrote (moby dick))) + (melville wrote (moby dick . cha-cha-cha) . cha-cha-cha)) + +(deftest subst.6 + (check-subst + '(1 2) '(foo . bar) + '((foo . baz) (foo . bar) (bar . foo) (baz foo . bar)) + :test #'equal) + ((foo . baz) (1 2) (bar . foo) (baz 1 2))) + +(deftest subst.7 + (check-subst + 'foo "aaa" + '((1 . 2) (4 . 5) (6 7 8 9 10 (11 12))) + :key #'(lambda (x) (if (and (numberp x) (evenp x)) + "aaa" + nil)) + :test #'string=) + ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo)))) + +(deftest subst.8 + (check-subst + 'foo nil + '((1 . 2) (4 . 5) (6 7 8 9 10 (11 12))) + :key #'(lambda (x) (if (and (numberp x) (evenp x)) + (copy-seq "aaa") + nil)) + :test-not #'equal) + ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo)))) + +(deftest subst.9 + (check-subst 'a 'b + (copy-tree '(a b c d a b)) + :key nil) + (a a c d a a)) + +;;; Order of argument evaluation +(deftest subst.order.1 + (let ((i 0) v w x y z) + (values + (subst (progn (setf v (incf i)) 'b) + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z))) + :key (progn (setf y (incf i)) #'identity) + :test (progn (setf z (incf i)) #'eql)) + i v w x y z)) + ((10 b . b) b b c ((b)) z) + 5 1 2 3 4 5) + +(deftest subst.order.2 + (let ((i 0) v w x y z) + (values + (subst (progn (setf v (incf i)) 'b) + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z))) + :test-not (progn (setf y (incf i)) (complement #'eql)) + :key (progn (setf z (incf i)) #'identity) + ) + i v w x y z)) + ((10 b . b) b b c ((b)) z) + 5 1 2 3 4 5) + + + +;;; Keyword tests for subst + +(deftest subst.allow-other-keys.1 + (subst 'a 'b (list 'a 'b 'c) :bad t :allow-other-keys t) + (a a c)) + +(deftest subst.allow-other-keys.2 + (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t) + (a a c)) + +(deftest subst.allow-other-keys.3 + (subst 'a 'b (list 'a 'b 'c) :allow-other-keys nil) + (a a c)) + +(deftest subst.allow-other-keys.4 + (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t :bad t) + (a a c)) + +(deftest subst.allow-other-keys.5 + (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t :allow-other-keys nil + :bad t) + (a a c)) + +(deftest subst.keywords.6 + (subst 'a 'b (list 'a 'b 'c) :test #'eq :test (complement #'eq)) + (a a c)) + + +;;; Tests for subst-if, subst-if-not + +(deftest subst-if.1 + (check-subst-if 'a #'consp '((100 1) (2 3) (4 3 2 1) (a b c))) + a) + +(deftest subst-if-not.1 + (check-subst-if-not '(x) 'consp '(1 (1 2) (1 2 3) (1 2 3 4))) + ((x) + ((x) (x) x) + ((x) (x) (x) x) + ((x) (x) (x) (x) x) + x)) + +(deftest subst-if.2 + (check-subst-if 17 (complement #'listp) '(a (a b) (a c d) (a nil e f g))) + (17 (17 17) (17 17 17) (17 nil 17 17 17))) + +(deftest subst-if.3 + (check-subst-if '(z) + (complement #'consp) + '(a (a b) (c d e) (f g h i))) + ((z) + ((z) (z) z) + ((z) (z) (z) z) + ((z) (z) (z) (z) z) + z)) + +(deftest subst-if-not.2 + (check-subst-if-not 'a (complement #'listp) + '((100 1) (2 3) (4 3 2 1) (a b c))) + a) + +(deftest subst-if.4 + (check-subst-if 'b #'identity '((100 1) (2 3) (4 3 2 1) (a b c)) + :key #'listp) + b) + +(deftest subst-if-not.3 + (check-subst-if-not 'c #'identity + '((100 1) (2 3) (4 3 2 1) (a b c)) + :key (complement #'listp)) + c) + +(deftest subst-if.5 + (check-subst-if 4 #'(lambda (x) (eql x 1)) + '((1 3) (1) (1 10 20 30) (1 3 x y)) + :key #'(lambda (x) + (and (consp x) + (car x)))) + (4 4 4 4)) + +(deftest subst-if-not.4 + (check-subst-if-not + 40 + #'(lambda (x) (not (eql x 17))) + '((17) (17 22) (17 22 31) (17 21 34 54)) + :key #'(lambda (x) + (and (consp x) + (car x)))) + (40 40 40 40)) + +(deftest subst-if.6 + (check-subst-if 'a #'(lambda (x) (eql x 'b)) + '((a) (b) (c) (d)) + :key nil) + ((a) (a) (c) (d))) + +(deftest subst-if-not.5 + (check-subst-if-not 'a #'(lambda (x) (not (eql x 'b))) + '((a) (b) (c) (d)) + :key nil) + ((a) (a) (c) (d))) + +(deftest subst-if.7 + (let ((i 0) w x y z) + (values + (subst-if + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) #'(lambda (x) (eql x 'b))) + (progn (setf y (incf i)) (copy-list '(1 2 a b c))) + :key (progn (setf z (incf i)) #'identity)) + i w x y z)) + (1 2 a a c) + 4 1 2 3 4) + +(deftest subst-if-not.7 + (let ((i 0) w x y z) + (values + (subst-if-not + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) #'(lambda (x) (not (eql x 'b)))) + (progn (setf y (incf i)) (copy-list '(1 2 a b c))) + :key (progn (setf z (incf i)) #'identity)) + i w x y z)) + (1 2 a a c) + 4 1 2 3 4) + + + +;;; Keyword tests for subst-if + +(deftest subst-if.allow-other-keys.1 + (subst-if 'a #'null nil :bad t :allow-other-keys t) + a) + +(deftest subst-if.allow-other-keys.2 + (subst-if 'a #'null nil :allow-other-keys t) + a) + +(deftest subst-if.allow-other-keys.3 + (subst-if 'a #'null nil :allow-other-keys nil) + a) + +(deftest subst-if.allow-other-keys.4 + (subst-if 'a #'null nil :allow-other-keys t :bad t) + a) + +(deftest subst-if.allow-other-keys.5 + (subst-if 'a #'null nil :allow-other-keys t :allow-other-keys nil :bad t) + a) + +(deftest subst-if.keywords.6 + (subst-if 'a #'null nil :key nil :key (constantly 'b)) + a) + +;;; Keywords tests for subst-if-not + +(deftest subst-if-not.allow-other-keys.1 + (subst-if-not 'a #'identity nil :bad t :allow-other-keys t) + a) + +(deftest subst-if-not.allow-other-keys.2 + (subst-if-not 'a #'identity nil :allow-other-keys t) + a) + +(deftest subst-if-not.allow-other-keys.3 + (subst-if-not 'a #'identity nil :allow-other-keys nil) + a) + +(deftest subst-if-not.allow-other-keys.4 + (subst-if-not 'a #'identity nil :allow-other-keys t :bad t) + a) + +(deftest subst-if-not.allow-other-keys.5 + (subst-if-not 'a #'identity nil :allow-other-keys t :allow-other-keys nil :bad t) + a) + +(deftest subst-if-not.keywords.6 + (subst-if-not 'a #'identity nil :key nil :key (constantly 'b)) + a) + + +(defvar *nsubst-tree-1* '(10 (30 20 10) (20 10) (10 20 30 40))) + +(deftest nsubst.1 + (check-nsubst "Z" 30 (copy-tree *nsubst-tree-1*)) + (10 ("Z" 20 10) (20 10) (10 20 "Z" 40))) + +(deftest nsubst.2 + (check-nsubst "A" 0 (copy-tree *nsubst-tree-1*)) + (10 (30 20 10) (20 10) (10 20 30 40))) + +(deftest nsubst.3 + (check-nsubst "Z" 100 (copy-tree *nsubst-tree-1*) :test-not #'eql) + "Z") + +(deftest nsubst.4 + (check-nsubst 'grape 'dick + '(melville wrote (moby dick))) + (melville wrote (moby grape))) + +(deftest nsubst.5 + (check-nsubst 'cha-cha-cha 'nil '(melville wrote (moby dick))) + (melville wrote (moby dick . cha-cha-cha) . cha-cha-cha)) + +(deftest nsubst.6 + (check-nsubst + '(1 2) '(foo . bar) + '((foo . baz) (foo . bar) (bar . foo) (baz foo . bar)) + :test #'equal) + ((foo . baz) (1 2) (bar . foo) (baz 1 2))) + +(deftest nsubst.7 + (check-nsubst + 'foo "aaa" + '((1 . 2) (4 . 5) (6 7 8 9 10 (11 12))) + :key #'(lambda (x) (if (and (numberp x) (evenp x)) + "aaa" + nil)) + :test #'string=) + ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo)))) + +(deftest nsubst.8 + (check-nsubst + 'foo nil + '((1 . 2) (4 . 5) (6 7 8 9 10 (11 12))) + :key #'(lambda (x) (if (and (numberp x) (evenp x)) + (copy-seq "aaa") + nil)) + :test-not #'equal) + ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo)))) + +(deftest nsubst.9 + (check-nsubst 'a 'b + (copy-tree '(a b c d a b)) + :key nil) + (a a c d a a)) + +;;; Order of argument evaluation +(deftest nsubst.order.1 + (let ((i 0) v w x y z) + (values + (nsubst (progn (setf v (incf i)) 'b) + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z))) + :key (progn (setf y (incf i)) #'identity) + :test (progn (setf z (incf i)) #'eql)) + i v w x y z)) + ((10 b . b) b b c ((b)) z) + 5 1 2 3 4 5) + +(deftest nsubst.order.2 + (let ((i 0) v w x y z) + (values + (nsubst (progn (setf v (incf i)) 'b) + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z))) + :test-not (progn (setf y (incf i)) (complement #'eql)) + :key (progn (setf z (incf i)) #'identity) + ) + i v w x y z)) + ((10 b . b) b b c ((b)) z) + 5 1 2 3 4 5) + +;;; Keyword tests for nsubst + +(deftest nsubst.allow-other-keys.1 + (nsubst 'a 'b (list 'a 'b 'c) :bad t :allow-other-keys t) + (a a c)) + +(deftest nsubst.allow-other-keys.2 + (nsubst 'a 'b (list 'a 'b 'c) :allow-other-keys t) + (a a c)) + +(deftest nsubst.allow-other-keys.3 + (nsubst 'a 'b (list 'a 'b 'c) :allow-other-keys nil) + (a a c)) + +(deftest nsubst.allow-other-keys.4 + (nsubst 'a 'b (list 'a 'b 'c) :allow-other-keys t :bad t) + (a a c)) + +(deftest nsubst.allow-other-keys.5 + (nsubst 'a 'b (list 'a 'b 'c) :allow-other-keys t :allow-other-keys nil + :bad t) + (a a c)) + +(deftest nsubst.keywords.6 + (nsubst 'a 'b (list 'a 'b 'c) :test #'eq :test (complement #'eq)) + (a a c)) + +;;; Tests for nsubst-if, nsubst-if-not + +(deftest nsubst-if.1 + (check-nsubst-if 'a #'consp '((100 1) (2 3) (4 3 2 1) (a b c))) + a) + +(deftest nsubst-if-not.1 + (check-nsubst-if-not '(x) 'consp '(1 (1 2) (1 2 3) (1 2 3 4))) + ((x) + ((x) (x) x) + ((x) (x) (x) x) + ((x) (x) (x) (x) x) + x)) + +(deftest nsubst-if.2 + (check-nsubst-if 17 (complement #'listp) '(a (a b) (a c d) (a nil e f g))) + (17 (17 17) (17 17 17) (17 nil 17 17 17))) + +(deftest nsubst-if.3 + (check-nsubst-if '(z) + (complement #'consp) + '(a (a b) (c d e) (f g h i))) + ((z) + ((z) (z) z) + ((z) (z) (z) z) + ((z) (z) (z) (z) z) + z)) + +(deftest nsubst-if-not.2 + (check-nsubst-if-not 'a (complement #'listp) + '((100 1) (2 3) (4 3 2 1) (a b c))) + a) + +(deftest nsubst-if.4 + (check-nsubst-if 'b #'identity '((100 1) (2 3) (4 3 2 1) (a b c)) + :key #'listp) + b) + +(deftest nsubst-if-not.3 + (check-nsubst-if-not 'c #'identity + '((100 1) (2 3) (4 3 2 1) (a b c)) + :key (complement #'listp)) + c) + +(deftest nsubst-if.5 + (check-nsubst-if 4 #'(lambda (x) (eql x 1)) + '((1 3) (1) (1 10 20 30) (1 3 x y)) + :key #'(lambda (x) + (and (consp x) + (car x)))) + (4 4 4 4)) + +(deftest nsubst-if-not.4 + (check-nsubst-if-not + 40 + #'(lambda (x) (not (eql x 17))) + '((17) (17 22) (17 22 31) (17 21 34 54)) + :key #'(lambda (x) + (and (consp x) + (car x)))) + (40 40 40 40)) + +(deftest nsubst-if.6 + (check-nsubst-if 'a #'(lambda (x) (eql x 'b)) + '((a) (b) (c) (d)) + :key nil) + ((a) (a) (c) (d))) + +(deftest nsubst-if-not.5 + (check-nsubst-if-not 'a #'(lambda (x) (not (eql x 'b))) + '((a) (b) (c) (d)) + :key nil) + ((a) (a) (c) (d))) + +(deftest nsubst-if.7 + (nsubst-if 'a #'null nil :bad t :allow-other-keys t) + a) + +(deftest nsubst-if-not.6 + (nsubst-if-not 'a #'null nil :bad t :allow-other-keys t) + nil) + +(deftest nsubst-if.8 + (let ((i 0) w x y z) + (values + (nsubst-if + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) #'(lambda (x) (eql x 'b))) + (progn (setf y (incf i)) (copy-list '(1 2 a b c))) + :key (progn (setf z (incf i)) #'identity)) + i w x y z)) + (1 2 a a c) + 4 1 2 3 4) + +(deftest nsubst-if-not.7 + (let ((i 0) w x y z) + (values + (nsubst-if-not + (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) #'(lambda (x) (not (eql x 'b)))) + (progn (setf y (incf i)) (copy-list '(1 2 a b c))) + :key (progn (setf z (incf i)) #'identity)) + i w x y z)) + (1 2 a a c) + 4 1 2 3 4) + +;;; Keyword tests for nsubst-if + +(deftest nsubst-if.allow-other-keys.1 + (nsubst-if 'a #'null nil :bad t :allow-other-keys t) + a) + +(deftest nsubst-if.allow-other-keys.2 + (nsubst-if 'a #'null nil :allow-other-keys t) + a) + +(deftest nsubst-if.allow-other-keys.3 + (nsubst-if 'a #'null nil :allow-other-keys nil) + a) + +(deftest nsubst-if.allow-other-keys.4 + (nsubst-if 'a #'null nil :allow-other-keys t :bad t) + a) + +(deftest nsubst-if.allow-other-keys.5 + (nsubst-if 'a #'null nil :allow-other-keys t :allow-other-keys nil :bad t) + a) + +(deftest nsubst-if.keywords.6 + (nsubst-if 'a #'null nil :key nil :key (constantly 'b)) + a) + +;;; Keywords tests for nsubst-if-not + +(deftest nsubst-if-not.allow-other-keys.1 + (nsubst-if-not 'a #'identity nil :bad t :allow-other-keys t) + a) + +(deftest nsubst-if-not.allow-other-keys.2 + (nsubst-if-not 'a #'identity nil :allow-other-keys t) + a) + +(deftest nsubst-if-not.allow-other-keys.3 + (nsubst-if-not 'a #'identity nil :allow-other-keys nil) + a) + +(deftest nsubst-if-not.allow-other-keys.4 + (nsubst-if-not 'a #'identity nil :allow-other-keys t :bad t) + a) + +(deftest nsubst-if-not.allow-other-keys.5 + (nsubst-if-not 'a #'identity nil :allow-other-keys t :allow-other-keys nil :bad t) + a) + +(deftest nsubst-if-not.keywords.6 + (nsubst-if-not 'a #'identity nil :key nil :key (constantly 'b)) + a) + +;;; Error cases + +;;; subst +(deftest subst.error.1 + (classify-error (subst)) + program-error) + +(deftest subst.error.2 + (classify-error (subst 'a)) + program-error) + +(deftest subst.error.3 + (classify-error (subst 'a 'b)) + program-error) + +(deftest subst.error.4 + (classify-error (subst 'a 'b nil :foo nil)) + program-error) + +(deftest subst.error.5 + (classify-error (subst 'a 'b nil :test)) + program-error) + +(deftest subst.error.6 + (classify-error (subst 'a 'b nil 1)) + program-error) + +(deftest subst.error.7 + (classify-error (subst 'a 'b nil :bad t :allow-other-keys nil)) + program-error) + +(deftest subst.error.8 + (classify-error (subst 'a 'b (list 'a 'b) :test #'identity)) + program-error) + +(deftest subst.error.9 + (classify-error (subst 'a 'b (list 'a 'b) :test-not #'identity)) + program-error) + +(deftest subst.error.10 + (classify-error (subst 'a 'b (list 'a 'b) :key #'equal)) + program-error) + +;;; nsubst +(deftest nsubst.error.1 + (classify-error (nsubst)) + program-error) + +(deftest nsubst.error.2 + (classify-error (nsubst 'a)) + program-error) + +(deftest nsubst.error.3 + (classify-error (nsubst 'a 'b)) + program-error) + +(deftest nsubst.error.4 + (classify-error (nsubst 'a 'b nil :foo nil)) + program-error) + +(deftest nsubst.error.5 + (classify-error (nsubst 'a 'b nil :test)) + program-error) + +(deftest nsubst.error.6 + (classify-error (nsubst 'a 'b nil 1)) + program-error) + +(deftest nsubst.error.7 + (classify-error (nsubst 'a 'b nil :bad t :allow-other-keys nil)) + program-error) + +(deftest nsubst.error.8 + (classify-error (nsubst 'a 'b (list 'a 'b) :test #'identity)) + program-error) + +(deftest nsubst.error.9 + (classify-error (nsubst 'a 'b (list 'a 'b) :test-not #'identity)) + program-error) + +(deftest nsubst.error.10 + (classify-error (nsubst 'a 'b (list 'a 'b) :key #'equal)) + program-error) + +;;; subst-if +(deftest subst-if.error.1 + (classify-error (subst-if)) + program-error) + +(deftest subst-if.error.2 + (classify-error (subst-if 'a)) + program-error) + +(deftest subst-if.error.3 + (classify-error (subst-if 'a #'null)) + program-error) + +(deftest subst-if.error.4 + (classify-error (subst-if 'a #'null nil :foo nil)) + program-error) + +(deftest subst-if.error.5 + (classify-error (subst-if 'a #'null nil :test)) + program-error) + +(deftest subst-if.error.6 + (classify-error (subst-if 'a #'null nil 1)) + program-error) + +(deftest subst-if.error.7 + (classify-error (subst-if 'a #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest subst-if.error.8 + (classify-error (subst-if 'a #'null (list 'a nil 'c) :key #'cons)) + program-error) + +;;; subst-if-not +(deftest subst-if-not.error.1 + (classify-error (subst-if-not)) + program-error) + +(deftest subst-if-not.error.2 + (classify-error (subst-if-not 'a)) + program-error) + +(deftest subst-if-not.error.3 + (classify-error (subst-if-not 'a #'null)) + program-error) + +(deftest subst-if-not.error.4 + (classify-error (subst-if-not 'a #'null nil :foo nil)) + program-error) + +(deftest subst-if-not.error.5 + (classify-error (subst-if-not 'a #'null nil :test)) + program-error) + +(deftest subst-if-not.error.6 + (classify-error (subst-if-not 'a #'null nil 1)) + program-error) + +(deftest subst-if-not.error.7 + (classify-error (subst-if-not 'a #'null nil + :bad t :allow-other-keys nil)) + program-error) + +(deftest subst-if-not.error.8 + (classify-error (subst-if-not 'a #'null (list 'a nil 'c) :key #'cons)) + program-error) + +;;; nsubst-if +(deftest nsubst-if.error.1 + (classify-error (nsubst-if)) + program-error) + +(deftest nsubst-if.error.2 + (classify-error (nsubst-if 'a)) + program-error) + +(deftest nsubst-if.error.3 + (classify-error (nsubst-if 'a #'null)) + program-error) + +(deftest nsubst-if.error.4 + (classify-error (nsubst-if 'a #'null nil :foo nil)) + program-error) + +(deftest nsubst-if.error.5 + (classify-error (nsubst-if 'a #'null nil :test)) + program-error) + +(deftest nsubst-if.error.6 + (classify-error (nsubst-if 'a #'null nil 1)) + program-error) + +(deftest nsubst-if.error.7 + (classify-error (nsubst-if 'a #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest nsubst-if.error.8 + (classify-error (nsubst-if 'a #'null (list 'a nil 'c) :key #'cons)) + program-error) + + +;;; nsubst-if-not +(deftest nsubst-if-not.error.1 + (classify-error (nsubst-if-not)) + program-error) + +(deftest nsubst-if-not.error.2 + (classify-error (nsubst-if-not 'a)) + program-error) + +(deftest nsubst-if-not.error.3 + (classify-error (nsubst-if-not 'a #'null)) + program-error) + +(deftest nsubst-if-not.error.4 + (classify-error (nsubst-if-not 'a #'null nil :foo nil)) + program-error) + +(deftest nsubst-if-not.error.5 + (classify-error (nsubst-if-not 'a #'null nil :test)) + program-error) + +(deftest nsubst-if-not.error.6 + (classify-error (nsubst-if-not 'a #'null nil 1)) + program-error) + +(deftest nsubst-if-not.error.7 + (classify-error (nsubst-if-not 'a #'null nil + :bad t :allow-other-keys nil)) + program-error) + +(deftest nsubst-if-not.error.8 + (classify-error (nsubst-if-not 'a #'null (list 'a nil 'c) :key #'cons)) + program-error) + diff --git a/ansi-tests/cons-test-03.lsp b/ansi-tests/cons-test-03.lsp new file mode 100644 index 0000000..43ddb61 --- /dev/null +++ b/ansi-tests/cons-test-03.lsp @@ -0,0 +1,325 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:32:20 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 3 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; copy-list + +(deftest copy-list.1 + (check-copy-list '(a b c d)) + (a b c d)) + +;; Check that copy-list works on dotted lists + +(deftest copy-list.2 + (check-copy-list '(a . b)) + (a . b)) + +(deftest copy-list.3 + (check-copy-list '(a b c . d)) + (a b c . d)) + +(deftest copy-list.4 + (let ((i 0)) + (values (copy-list (progn (incf i) '(a b c))) + i)) + (a b c) 1) + +(deftest copy-list.error.1 + (classify-error (copy-list)) + program-error) + +(deftest copy-list.error.2 + (classify-error (copy-list nil nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; list, list* + +(deftest list.1 + (list 'a 'b 'c) + (a b c)) + +(deftest list.2 + (list) + nil) + +(deftest list.order.1 + (let ((i 0)) + (list (incf i) (incf i) (incf i) (incf i))) + (1 2 3 4)) + +(deftest list.order.2 + (let ((i 0)) + (list (incf i) (incf i) (incf i) (incf i) + (incf i) (incf i) (incf i) (incf i))) + (1 2 3 4 5 6 7 8)) + +(deftest list.order.3 + (let ((i 0)) + (list (incf i) (incf i) (incf i) (incf i) + (incf i) (incf i) (incf i) (incf i) + (incf i) (incf i) (incf i) (incf i) + (incf i) (incf i) (incf i) (incf i))) + (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)) + +(deftest list*.1 + (list* 1 2 3) + (1 2 . 3)) + +(deftest list*.2 + (list* 'a) + a) + +(deftest list-list*.1 + (list* 'a 'b 'c (list 'd 'e 'f)) + (a b c d e f)) + +(deftest list*.3 + (list* 1) + 1) + +(deftest list*.order.1 + (let ((i 0)) + (list* (incf i) (incf i) (incf i) (incf i))) + (1 2 3 . 4)) + +(deftest list*.order.2 + (let ((i 0)) + (list* (incf i) (incf i) (incf i) (incf i) + (incf i) (incf i) (incf i) (incf i) + (incf i) (incf i) (incf i) (incf i) + (incf i) (incf i) (incf i) (incf i))) + (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 . 16)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; list-length + +(deftest list-length-nil + (list-length nil) + 0) + +(deftest list-length-list + (list-length '(a b c d e f)) + 6) + +;; check that list-length returns nil +;; on a circular list + +(deftest list-length-circular-list + (let ((x (cons nil nil))) + (let ((y (list* 1 2 3 4 5 6 7 8 9 x))) + (setf (cdr x) y) + (let ((z (list* 'a 'b 'c 'd 'e y))) + (list-length z)))) + nil) + +(deftest list-length.order.1 + (let ((i 0)) + (values (list-length (progn (incf i) '(a b c))) i)) + 3 1) + + +;; Check that list-length produces a type-error +;; on arguments that are not proper lists or circular lists + +(deftest list-length.error.1 + (loop + for x in (list 'a 1 1.0 #\w (make-array '(10)) + '(a b . c) (symbol-package 'cons)) + count (not (eqt (catch-type-error (list-length x)) + 'type-error))) + 0) + +(deftest list-length.error.2 + (classify-error (list-length)) + program-error) + +(deftest list-length.error.3 + (classify-error (list-length nil nil)) + program-error) + +(deftest list-length.error.4 + (classify-error (list-length 'a)) + type-error) + +(deftest list-length.error.5 + (classify-error (locally (list-length 'a) t)) + type-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; listp + +;; Check listp against various simple cases + +(deftest listp-nil + (notnot-mv (listp nil)) + t) + +(deftest listp-symbol + (listp 'a) + nil) + +(deftest listp-singleton-list + (notnot-mv (listp '(a))) + t) + +(deftest listp-circular-list + (let ((x (cons nil nil))) + (setf (cdr x) x) + (notnot-mv (listp x))) + t) + +(deftest listp-longer-list + (notnot-mv (listp '(a b c d e f g h))) + t) + +;;; Check that (listp x) == (typep x 'list) + +(deftest listp-universe + (check-type-predicate 'listp 'list) + 0) + +(deftest listp.order.1 + (let ((i 0)) + (values (listp (incf i)) i)) + nil 1) + +(deftest listp.error.1 + (classify-error (listp)) + program-error) + +(deftest listp.error.2 + (classify-error (listp nil nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; (typep 'list) + +;;; These tests are now somewhat redundant + +(deftest typep-nil-list + (notnot-mv (typep nil 'list)) + t) + +(deftest typep-symbol-list + (typep 'a 'list) + nil) + +(deftest typep-singleton-list-list + (notnot-mv (typep '(a) 'list)) + t) + +(deftest typep-circular-list-list + (let ((x (cons nil nil))) + (setf (cdr x) x) + (notnot-mv (typep x 'list))) + t) + +(deftest typep-longer-list-list + (notnot-mv (typep '(a b c d e f g h) 'list)) + t) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; make-list + +(deftest make-list-empty.1 + (make-list 0) + nil) + +(deftest make-list-empty.2 + (make-list 0 :initial-element 'a) + nil) + +(deftest make-list-no-initial-element + (make-list 6) + (nil nil nil nil nil nil)) + +(deftest make-list-with-initial-element + (make-list 6 :initial-element 'a) + (a a a a a a)) + +(deftest make-list.allow-other-keys.1 + (make-list 5 :allow-other-keys t :foo 'a) + (nil nil nil nil nil)) + +(deftest make-list.allow-other-keys.2 + (make-list 5 :bar nil :allow-other-keys t) + (nil nil nil nil nil)) + +(deftest make-list.allow-other-keys.3 + (make-list 5 :allow-other-keys nil) + (nil nil nil nil nil)) + +(deftest make-list.allow-other-keys.4 + (make-list 5 :allow-other-keys t :allow-other-keys nil 'bad t) + (nil nil nil nil nil)) + +(deftest make-list.allow-other-keys.5 + (make-list 5 :allow-other-keys t) + (nil nil nil nil nil)) + +(deftest make-list-repeated-keyword + (make-list 5 :initial-element 'a :initial-element 'b) + (a a a a a)) + +(deftest make-list.order.1 + (let ((i 0) x y) + (values + (make-list (progn (setf x (incf i)) 5) + :initial-element + (progn (setf y (incf i)) 'a)) + i x y)) + (a a a a a) + 2 1 2) + +(deftest make-list.order.2 + (let ((i 0) x y z) + (values + (make-list (progn (setf x (incf i)) 5) + :initial-element + (progn (setf y (incf i)) 'a) + :initial-element + (progn (setf z (incf i)) 'b)) + i x y z)) + (a a a a a) + 3 1 2 3) + + +(deftest make-list.error.1 + (catch-type-error (make-list -1)) + type-error) + +(deftest make-list.error.2 + (classify-error (make-list 'a)) + type-error) + +(deftest make-list.error.3 + (classify-error (make-list)) + program-error) + +(deftest make-list.error.4 + (classify-error (make-list 5 :bad t)) + program-error) + +(deftest make-list.error.5 + (classify-error (make-list 5 :initial-element)) + program-error) + +(deftest make-list.error.6 + (classify-error (make-list 5 1 2)) + program-error) + +(deftest make-list.error.7 + (classify-error (make-list 5 :bad t :allow-other-keys nil)) + program-error) + +(deftest make-list.error.8 + (classify-error (locally (make-list 'a) t)) + type-error) diff --git a/ansi-tests/cons-test-04.lsp b/ansi-tests/cons-test-04.lsp new file mode 100644 index 0000000..0053f0d --- /dev/null +++ b/ansi-tests/cons-test-04.lsp @@ -0,0 +1,412 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:33:20 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 4 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; push +;;; There will be a separate test suite +;;; for ACCESSORS x SETF-like macros + +;;; See also places.lsp + +(deftest push.1 + (let ((x nil)) + (push 'a x)) + (a)) + +(deftest push.2 + (let ((x 'b)) + (push 'a x) + (push 'c x)) + (c a . b)) + +(deftest push.3 + (let ((x (copy-tree '(a)))) + (push x x) + (and + (eqt (car x) (cdr x)) + x)) + ((a) a)) + +(deftest push.order.1 + (let ((x (list nil)) (i 0) a b) + (values + (push (progn (setf a (incf i)) 'z) + (car (progn (setf b (incf i)) x))) + x + i a b)) + (z) ((z)) 2 1 2) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; pop + +(deftest pop.1 + (let ((x (copy-tree '(a b c)))) + (let ((y (pop x))) + (list x y))) + ((b c) a)) + +(deftest pop.2 + (let ((x nil)) + (let ((y (pop x))) + (list x y))) + (nil nil)) + +;;; Confirm argument is executed just once. +(deftest pop.order.1 + (let ((i 0) + (a (vector (list 'a 'b 'c)))) + (pop (aref a (progn (incf i) 0))) + (values a i)) + #((b c)) 1) + +(deftest push-and-pop + (let* ((x (copy-tree '(a b))) + (y x)) + (push 'c x) + (and + (eqt (cdr x) y) + (pop x))) + c) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; pushnew + +;;; See also places.lsp + +(deftest pushnew.1 + (let ((x nil)) + (let ((y (pushnew 'a x))) + (and + (eqt x y) + (equal x '(a)) + t))) + t) + +(deftest pushnew.2 + (let* ((x (copy-tree '(b c d a k f q))) + (y (pushnew 'a x))) + (and + (eqt x y) + x)) + (b c d a k f q)) + +(deftest pushnew.3 + (let* ((x (copy-tree '(1 2 3 4 5 6 7 8))) + (y (pushnew 7 x))) + (and + (eqt x y) + x)) + (1 2 3 4 5 6 7 8)) + +(deftest pushnew.4 + (let* ((x (copy-tree '((a b) 1 "and" c d e))) + (y (pushnew (copy-tree '(c d)) x + :test 'equal))) + (and (eqt x y) + x)) + ((c d) (a b) 1 "and" c d e)) + +(deftest pushnew.5 + (let* ((x (copy-tree '((a b) 1 "and" c d e))) + (y (pushnew (copy-tree '(a b)) x + :test 'equal))) + (and + (eqt x y) + x)) + ((a b) 1 "and" c d e)) + +(deftest pushnew.6 + (let* ((x (copy-tree '((a b) (c e) (d f) (g h)))) + (y (pushnew (copy-tree '(d i)) x :key #'car)) + (z (pushnew (copy-tree '(z 10)) x :key #'car))) + (and (eqt y (cdr z)) + (eqt z x) + x)) + ((z 10) (a b) (c e) (d f) (g h))) + +(deftest pushnew.7 + (let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3)))) + (y (pushnew (copy-tree '("def" 4)) x + :key #'car :test #'string=)) + (z (pushnew (copy-tree '("xyz" 10)) + x + :key #'car :test #'string=))) + (and + (eqt y (cdr x)) + (eqt x z) + x)) + (("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3))) + +(deftest pushnew.8 + (let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3)))) + (y (pushnew (copy-tree '("def" 4)) x + :key #'car :test-not (complement #'string=))) + (z (pushnew (copy-tree '("xyz" 10)) x + :key #'car :test-not (complement #'string=)))) + (and + (eqt y (cdr x)) + (eqt x z) + x)) + (("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3))) + +(deftest pushnew.9 + (let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3)))) + (y (pushnew (copy-tree '("def" 4)) x + :key 'car :test-not (complement #'string=))) + (z (pushnew (copy-tree '("xyz" 10)) x + :key 'car :test-not (complement #'string=)))) + (and + (eqt y (cdr x)) + (eqt x z) + x)) + (("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3))) + +;; Check that a NIL :key argument is the same as no key argument at all +(deftest pushnew.10 + (let* ((x (list 'a 'b 'c 'd)) + (result (pushnew 'z x :key nil))) + result) + (z a b c d)) + +;; Check that a NIL :key argument is the same as no key argument at all +(deftest pushnew.11 + (let* ((x (copy-tree '((a b) 1 "and" c d e))) + (y (pushnew (copy-tree '(a b)) x + :test 'equal :key nil))) + (and + (eqt x y) + x)) + ((a b) 1 "and" c d e)) + +(deftest pushnew.12 + (let ((i 0) x y z (d '(b c))) + (values + (pushnew (progn (setf x (incf i)) 'a) + d + :key (progn (setf y (incf i)) #'identity) + :test (progn (setf z (incf i)) #'eql)) + d i x y z)) + (a b c) (a b c) + 3 1 2 3) + +(deftest pushnew.13 + (let ((i 0) x y z (d '(b c))) + (values + (pushnew (progn (setf x (incf i)) 'a) + d + :key (progn (setf y (incf i)) #'identity) + :test-not (progn (setf z (incf i)) (complement #'eql))) + d i x y z)) + (a b c) (a b c) + 3 1 2 3) + +(deftest pushnew.14 + (let ((i 0) x y z (d '(b c))) + (values + (pushnew (progn (setf x (incf i)) 'a) + d + :test (progn (setf z (incf i)) #'eql) + :key (progn (setf y (incf i)) #'identity)) + d i x y z)) + (a b c) (a b c) + 3 1 3 2) + +(deftest pushnew.15 + (let ((i 0) x y z (d '(b c))) + (values + (pushnew (progn (setf x (incf i)) 'a) + d + :test-not (progn (setf z (incf i)) (complement #'eql)) + :key (progn (setf y (incf i)) #'identity)) + d i x y z)) + (a b c) (a b c) + 3 1 3 2) + +(deftest pushnew.error.1 + (classify-error + (let ((x '(a b))) + (pushnew 'c x :test #'identity))) + program-error) + +(deftest pushnew.error.2 + (classify-error + (let ((x '(a b))) + (pushnew 'c x :test-not #'identity))) + program-error) + +(deftest pushnew.error.3 + (classify-error + (let ((x '(a b))) + (pushnew 'c x :key #'cons))) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; adjoin + +(deftest adjoin.1 + (adjoin 'a nil) + (a)) + +(deftest adjoin.2 + (adjoin nil nil) + (nil)) + +(deftest adjoin.3 + (adjoin 'a '(a)) + (a)) + +;; Check that a NIL :key argument is the same as no key argument at all +(deftest adjoin.4 + (adjoin 'a '(a) :key nil) + (a)) + +(deftest adjoin.5 + (adjoin 'a '(a) :key #'identity) + (a)) + +(deftest adjoin.6 + (adjoin 'a '(a) :key 'identity) + (a)) + +(deftest adjoin.7 + (adjoin (1+ 11) '(4 3 12 2 1)) + (4 3 12 2 1)) + +;; Check that the test is EQL, not EQ (by adjoining a bignum) +(deftest adjoin.8 + (adjoin (1+ 999999999999) '(4 1 1000000000000 3816734 a "aa")) + (4 1 1000000000000 3816734 a "aa")) + +(deftest adjoin.9 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)) + ("aaa" aaa "AAA" "aaa" #\a)) + +(deftest adjoin.10 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test #'equal) + (aaa "AAA" "aaa" #\a)) + +(deftest adjoin.11 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test 'equal) + (aaa "AAA" "aaa" #\a)) + +(deftest adjoin.12 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test-not (complement #'equal)) + (aaa "AAA" "aaa" #\a)) + +(deftest adjoin.14 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test #'equal :key #'identity) + (aaa "AAA" "aaa" #\a)) + +(deftest adjoin.15 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test 'equal :key #'identity) + (aaa "AAA" "aaa" #\a)) + +;; Test that a :key of NIL is the same as no key at all +(deftest adjoin.16 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test #'equal :key nil) + (aaa "AAA" "aaa" #\a)) + +;; Test that a :key of NIL is the same as no key at all +(deftest adjoin.17 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test 'equal :key nil) + (aaa "AAA" "aaa" #\a)) + +;; Test that a :key of NIL is the same as no key at all +(deftest adjoin.18 + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test-not (complement #'equal) :key nil) + (aaa "AAA" "aaa" #\a)) + +(deftest adjoin.order.1 + (let ((i 0) w x y z) + (values + (adjoin (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) '(b c d a e)) + :key (progn (setf y (incf i)) #'identity) + :test (progn (setf z (incf i)) #'eql)) + i w x y z)) + (b c d a e) + 4 1 2 3 4) + +(deftest adjoin.order.2 + (let ((i 0) w x y z p) + (values + (adjoin (progn (setf w (incf i)) 'a) + (progn (setf x (incf i)) '(b c d e)) + :test-not (progn (setf y (incf i)) (complement #'eql)) + :key (progn (setf z (incf i)) #'identity) + :key (progn (setf p (incf i)) nil)) + i w x y z p)) + (a b c d e) + 5 1 2 3 4 5) + +(deftest adjoin.allow-other-keys.1 + (adjoin 'a '(b c) :bad t :allow-other-keys t) + (a b c)) + +(deftest adjoin.allow-other-keys.2 + (adjoin 'a '(b c) :allow-other-keys t :foo t) + (a b c)) + +(deftest adjoin.allow-other-keys.3 + (adjoin 'a '(b c) :allow-other-keys t) + (a b c)) + +(deftest adjoin.allow-other-keys.4 + (adjoin 'a '(b c) :allow-other-keys nil) + (a b c)) + +(deftest adjoin.allow-other-keys.5 + (adjoin 'a '(b c) :allow-other-keys t :allow-other-keys nil 'bad t) + (a b c)) + +(deftest adjoin.repeat-key + (adjoin 'a '(b c) :test #'eq :test (complement #'eq)) + (a b c)) + +(deftest adjoin.error.1 + (classify-error (adjoin)) + program-error) + +(deftest adjoin.error.2 + (classify-error (adjoin 'a)) + program-error) + +(deftest adjoin.error.3 + (classify-error (adjoin 'a '(b c) :bad t)) + program-error) + +(deftest adjoin.error.4 + (classify-error (adjoin 'a '(b c) :allow-other-keys nil :bad t)) + program-error) + +(deftest adjoin.error.5 + (classify-error (adjoin 'a '(b c) 1 2)) + program-error) + +(deftest adjoin.error.6 + (classify-error (adjoin 'a '(b c) :test)) + program-error) + +(deftest adjoin.error.7 + (classify-error (adjoin 'a '(b c) :test #'identity)) + program-error) + +(deftest adjoin.error.8 + (classify-error (adjoin 'a '(b c) :test-not #'identity)) + program-error) + +(deftest adjoin.error.9 + (classify-error (adjoin 'a '(b c) :key #'cons)) + program-error) diff --git a/ansi-tests/cons-test-05.lsp b/ansi-tests/cons-test-05.lsp new file mode 100644 index 0000000..100c1ed --- /dev/null +++ b/ansi-tests/cons-test-05.lsp @@ -0,0 +1,192 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:34:08 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 5 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +(defparameter *cons-accessors* + '(first second third fourth fifth sixth seventh eighth ninth tenth + car cdr caar cadr cdar cddr + caaar caadr cadar caddr cdaar cdadr cddar cdddr + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; first, ..., tenth + +(deftest first-etc-1 + (let ((x (loop for i from 1 to 20 collect i))) + (list (first x) + (second x) + (third x) + (fourth x) + (fifth x) + (sixth x) + (seventh x) + (eighth x) + (ninth x) + (tenth x))) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest first-etc-2 + (let ((x (make-list 15 :initial-element 'a))) + (and + (eql (setf (first x) 1) 1) + (eql (setf (second x) 2) 2) + (eql (setf (third x) 3) 3) + (eql (setf (fourth x) 4) 4) + (eql (setf (fifth x) 5) 5) + (eql (setf (sixth x) 6) 6) + (eql (setf (seventh x) 7) 7) + (eql (setf (eighth x) 8) 8) + (eql (setf (ninth x) 9) 9) + (eql (setf (tenth x) 10) 10) + x)) + (1 2 3 4 5 6 7 8 9 10 a a a a a)) + +(deftest rest-set-1 + (let ((x (list 'a 'b 'c))) + (and + (eqt (setf (rest x) 'd) 'd) + x)) + (a . d)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; setting of C*R accessors + +(loop + for fn in '(car cdr caar cadr cdar cddr + caaar caadr cadar caddr cdaar cdadr cddar cdddr + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr) + do + (let ((level (- (length (symbol-name fn)) 2))) + (eval `(deftest ,(intern + (concatenate 'string + (symbol-name fn) + "-SET") + :cl-test) + (let ((x (create-c*r-test ,level)) + (y (list (create-c*r-test ,level))) + (i 0)) + (and + (setf (,fn (progn (incf i) x)) 'a) + (eqlt (,fn x) 'a) + (eqlt i 1) + (setf (,fn x) 'none) + (equalt x (create-c*r-test ,level)) + (setf (,fn (progn (incf i) (car y))) 'a) + (eqlt (,fn (car y)) 'a) + (eqlt i 2) + (setf (,fn (car y)) 'none) + (null (cdr y)) + (equalt (car y) (create-c*r-test ,level)) + )) + t)))) + +(loop + for (fn len) in '((first 1) (second 2) (third 3) (fourth 4) + (fifth 5) (sixth 6) (seventh 7) (eighth 8) + (ninth 9) (tenth 10)) + do + (eval + `(deftest ,(intern + (concatenate 'string + (symbol-name fn) + "-SET") + :cl-test) + (let* ((x (make-list 20 :initial-element nil)) + (y (list (copy-list x))) + (cnt 0)) + (and + (setf (,fn (progn (incf cnt) x)) 'a) + (eqlt cnt 1) + (loop + for i from 1 to 20 + do (when (and (not (eql i ,len)) + (nth (1- i) x)) + (return nil)) + finally (return t)) + (setf (,fn (car y)) 'a) + (loop + for i from 1 to 20 + do (when (and (not (eql i ,len)) + (nth (1- i) (car y))) + (return nil)) + finally (return t)) + (eqlt (,fn x) 'a) + (eqlt (nth ,(1- len) x) 'a) + (eqlt (,fn (car y)) 'a) + (nth ,(1- len) (car y)))) + a))) + +;; set up program error tests + +(loop for name in *cons-accessors* + do (eval + `(deftest ,(intern (concatenate 'string (symbol-name name) + ".ERROR.NO-ARGS") + :cl-test) + (classify-error (,name)) + program-error)) + do (eval + `(deftest ,(intern (concatenate 'string (symbol-name name) + ".ERROR.EXCESS-ARGS") + :cl-test) + (classify-error (,name nil nil)) + program-error))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nth + +(deftest nth.1 + (nth-1-body (loop for i from 1 to 2000 collect (* 4 i))) + 0) + +(deftest nth.2 + (let ((x (loop for i from 1 to 2000 collect i))) + (loop + for i from 0 to 1999 do + (setf (nth i x) (- 1999 i))) + (equalt x (loop for i from 1999 downto 0 collect i))) + t) + +;;; Test side effects, evaluation order in assignment to NTH +(deftest nth.order.1 + (let ((i 0) + (x (list 'a 'b 'c 'd)) + y z) + (and + (eqlt (setf (nth (setf y (incf i)) x) (progn (setf z (incf i)) 'z)) + 'z) + (eqlt y 1) + (eqlt z 2) + x)) + (a z c d)) + +(deftest nth.order.2 + (let ((i 0) x y (z '(a b c d e))) + (values + (nth (progn (setf x (incf i)) 1) + (progn (setf y (incf i)) z)) + i x y)) + b 2 1 2) + +(deftest nth.error.1 + (classify-error (nth)) + program-error) + +(deftest nth.error.2 + (classify-error (nth 0)) + program-error) + +(deftest nth.error.3 + (classify-error (nth 1 '(a b c) nil)) + program-error) + +(deftest nth.error.4 + (classify-error (nth 0 '(a b c) nil)) + program-error) diff --git a/ansi-tests/cons-test-06.lsp b/ansi-tests/cons-test-06.lsp new file mode 100644 index 0000000..211003f --- /dev/null +++ b/ansi-tests/cons-test-06.lsp @@ -0,0 +1,54 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:34:40 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 6 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; endp + +(deftest endp-nil + (notnot-mv (endp nil)) + t) + +(deftest endp-cons + (endp (cons 'a 'a)) + nil) + +(deftest endp-singleton-list + (endp '(a)) + nil) + +(deftest endp.order.1 + (let ((i 0)) + (values + (endp (progn (incf i) '(a b c))) + i)) + nil 1) + +(deftest endp-symbol-error + (catch-type-error (endp 'a)) + type-error) + +(deftest endp-fixnum-error + (catch-type-error (endp 1)) + type-error) + +(deftest endp-float-error + (catch-type-error (endp 0.9212d4)) + type-error) + +(deftest endp.error.4 + (classify-error (endp)) + program-error) + +(deftest endp.error.5 + (classify-error (endp nil nil)) + program-error) + +(deftest endp.error.6 + (catch-type-error (locally (endp 1))) + type-error) diff --git a/ansi-tests/cons-test-07.lsp b/ansi-tests/cons-test-07.lsp new file mode 100644 index 0000000..445d0e8 --- /dev/null +++ b/ansi-tests/cons-test-07.lsp @@ -0,0 +1,211 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:35:15 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 7 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nconc + +(deftest nconc.1 + (nconc) + nil) + +(deftest nconc.2 + (nconc (copy-tree '(a b c d e f))) + (a b c d e f)) + +(deftest nconc.3 + (nconc 1) + 1) + +(deftest nconc.4 + (let ((x (list 'a 'b 'c)) + (y (list 'd 'e 'f))) + (let ((ycopy (make-scaffold-copy y))) + (let ((result (nconc x y))) + (and + (check-scaffold-copy y ycopy) + (eqt (cdddr x) y) + result)))) + (a b c d e f)) + +(deftest nconc.5 + (let ((x (list 'a 'b 'c))) + (nconc x x) + (and + (eqt (cdddr x) x) + (null (list-length x)))) + t) + +(deftest nconc.6 + (let ((x (list 'a 'b 'c)) + (y (list 'd 'e 'f 'g 'h)) + (z (list 'i 'j 'k))) + (let ((result (nconc x y z 'foo))) + (and + (eqt (nthcdr 3 x) y) + (eqt (nthcdr 5 y) z) + (eqt (nthcdr 3 z) 'foo) + result))) + (a b c d e f g h i j k . foo)) + +(deftest nconc.7 + (nconc (copy-tree '(a . b)) + (copy-tree '(c . d)) + (copy-tree '(e . f)) + 'foo) + (a c e . foo)) + +(deftest nconc.order.1 + (let ((i 0) x y z) + (values + (nconc (progn (setf x (incf i)) (copy-list '(a b c))) + (progn (setf y (incf i)) (copy-list '(d e f))) + (progn (setf z (incf i)) (copy-list '(g h i)))) + i x y z)) + (a b c d e f g h i) 3 1 2 3) + +(deftest nconc.order.2 + (let ((i 0)) + (values + (nconc (incf i)) + i)) + 1 1) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; append + +(deftest append.1 + (append) + nil) + +(deftest append.2 + (append 'x) + x) + +(deftest append.3 + (let ((x (list 'a 'b 'c 'd)) + (y (list 'e 'f 'g))) + (let ((xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y))) + (let ((result (append x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)))) + (a b c d e f g)) + +(deftest append.4 + (append (list 'a) (list 'b) (list 'c) + (list 'd) (list 'e) (list 'f) + (list 'g) 'h) + (a b c d e f g . h)) + +(deftest append.5 + (append nil nil nil nil nil nil nil nil 'a) + a) + +(deftest append.6 + (append-6-body) + 0) + +(deftest append.order.1 + (let ((i 0) x y z) + (values + (append (progn (setf x (incf i)) (copy-list '(a b c))) + (progn (setf y (incf i)) (copy-list '(d e f))) + (progn (setf z (incf i)) (copy-list '(g h i)))) + i x y z)) + (a b c d e f g h i) 3 1 2 3) + +(deftest append.order.2 + (let ((i 0)) (values (append (incf i)) i)) + 1 1) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; revappend + +(deftest revappend.1 + (let* ((x (list 'a 'b 'c)) + (y (list 'd 'e 'f)) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + ) + (let ((result (revappend x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + (eqt (cdddr result) y) + result))) + (c b a d e f)) + +(deftest revappend.2 + (revappend (copy-tree '(a b c d e)) 10) + (e d c b a . 10)) + +(deftest revappend.3 + (revappend nil 'a) + a) + +(deftest revappend.4 + (revappend (copy-tree '(a (b c) d)) nil) + (d (b c) a)) + +(deftest revappend.order.1 + (let ((i 0) x y) + (values + (revappend (progn (setf x (incf i)) (copy-list '(a b c))) + (progn (setf y (incf i)) (copy-list '(d e f)))) + i x y)) + (c b a d e f) 2 1 2) + +(deftest revappend.error.1 + (classify-error (revappend)) + program-error) + +(deftest revappend.error.2 + (classify-error (revappend nil)) + program-error) + +(deftest revappend.error.3 + (classify-error (revappend nil nil nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nreconc + +(deftest nreconc.1 + (let* ((x (list 'a 'b 'c)) + (y (copy-tree '(d e f))) + (result (nreconc x y))) + (and (equal y '(d e f)) + result)) + (c b a d e f)) + +(deftest nreconc.2 + (nreconc nil 'a) + a) + +(deftest nreconc.order.1 + (let ((i 0) x y) + (values + (nreconc (progn (setf x (incf i)) (copy-list '(a b c))) + (progn (setf y (incf i)) (copy-list '(d e f)))) + i x y)) + (c b a d e f) 2 1 2) + +(deftest nreconc.error.1 + (classify-error (nreconc)) + program-error) + +(deftest nreconc.error.2 + (classify-error (nreconc nil)) + program-error) + +(deftest nreconc.error.3 + (classify-error (nreconc nil nil nil)) + program-error) diff --git a/ansi-tests/cons-test-08.lsp b/ansi-tests/cons-test-08.lsp new file mode 100644 index 0000000..6b1e3f0 --- /dev/null +++ b/ansi-tests/cons-test-08.lsp @@ -0,0 +1,455 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:36:01 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 8 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Error checking car, cdr, list-length + +(deftest car.1 + (car '(a)) + a) + +(deftest car-nil + (car nil) + nil) + +(deftest car-symbol-error + (classify-error (car 'a)) + type-error) + +(deftest car-symbol-error.2 + (classify-error (locally (car 'a) t)) + type-error) + +(deftest car.order.1 + (let ((i 0)) + (values (car (progn (incf i) '(a b))) i)) + a 1) + +(deftest cdr.1 + (cdr '(a b)) + (b)) + +(deftest cdr-nil + (cdr ()) + nil) + +(deftest cdr.order.1 + (let ((i 0)) + (values (cdr (progn (incf i) '(a b))) i)) + (b) 1) + +(deftest cdr-symbol-error + (classify-error (cdr 'a)) + type-error) + +(deftest cdr-symbol-error.2 + (classify-error (locally (cdr 'a) t)) + type-error) + +(deftest list-length.4 + (list-length (copy-tree '(a b c))) + 3) + +(deftest list-length-symbol + (classify-error (list-length 'a)) + type-error) + +(deftest list-length-dotted-list + (classify-error (list-length (copy-tree '(a b c d . e)))) + type-error) + +;;; Error checking of c*r functions + +(deftest caar.error.1 + (classify-error (caar 'a)) + type-error) + +(deftest caar.error.2 + (classify-error (caar '(a))) + type-error) + +(deftest cadr.error.1 + (classify-error (cadr 'a)) + type-error) + +(deftest cadr.error.2 + (classify-error (cadr '(a . b))) + type-error) + +(deftest cdar.error.1 + (classify-error (cdar 'a)) + type-error) + +(deftest cdar.error.2 + (classify-error (cdar '(a . b))) + type-error) + +(deftest cddr.error.1 + (classify-error (cddr 'a)) + type-error) + +(deftest cddr.error.2 + (classify-error (cddr '(a . b))) + type-error) + +(deftest caaar.error.1 + (classify-error (caaar 'a)) + type-error) + +(deftest caaar.error.2 + (classify-error (caaar '(a))) + type-error) + +(deftest caaar.error.3 + (classify-error (caaar '((a)))) + type-error) + +(deftest caadr.error.1 + (classify-error (caadr 'a)) + type-error) + +(deftest caadr.error.2 + (classify-error (caadr '(a . b))) + type-error) + +(deftest caadr.error.3 + (classify-error (caadr '(a . (b)))) + type-error) + +(deftest cadar.error.1 + (classify-error (cadar 'a)) + type-error) + +(deftest cadar.error.2 + (classify-error (cadar '(a . b))) + type-error) + +(deftest cadar.error.3 + (classify-error (cadar '((a . c) . b))) + type-error) + +(deftest caddr.error.1 + (classify-error (caddr 'a)) + type-error) + +(deftest caddr.error.2 + (classify-error (caddr '(a . b))) + type-error) + +(deftest caddr.error.3 + (classify-error (caddr '(a c . b))) + type-error) + +(deftest cdaar.error.1 + (classify-error (cdaar 'a)) + type-error) + +(deftest cdaar.error.2 + (classify-error (cdaar '(a))) + type-error) + +(deftest cdaar.error.3 + (classify-error (cdaar '((a . b)))) + type-error) + +(deftest cdadr.error.1 + (classify-error (cdadr 'a)) + type-error) + +(deftest cdadr.error.2 + (classify-error (cdadr '(a . b))) + type-error) + +(deftest cdadr.error.3 + (classify-error (cdadr '(a b . c))) + type-error) + +(deftest cddar.error.1 + (classify-error (cddar 'a)) + type-error) + +(deftest cddar.error.2 + (classify-error (cddar '(a . b))) + type-error) + +(deftest cddar.error.3 + (classify-error (cddar '((a . b) . b))) + type-error) + +(deftest cdddr.error.1 + (classify-error (cdddr 'a)) + type-error) + +(deftest cdddr.error.2 + (classify-error (cdddr '(a . b))) + type-error) + +(deftest cdddr.error.3 + (classify-error (cdddr '(a c . b))) + type-error) + +;; + +(deftest caaaar.error.1 + (classify-error (caaaar 'a)) + type-error) + +(deftest caaaar.error.2 + (classify-error (caaaar '(a))) + type-error) + +(deftest caaaar.error.3 + (classify-error (caaaar '((a)))) + type-error) + +(deftest caaaar.error.4 + (classify-error (caaaar '(((a))))) + type-error) + +(deftest caaadr.error.1 + (classify-error (caaadr 'a)) + type-error) + +(deftest caaadr.error.2 + (classify-error (caaadr '(a . b))) + type-error) + +(deftest caaadr.error.3 + (classify-error (caaadr '(a . (b)))) + type-error) + +(deftest caaadr.error.4 + (classify-error (caaadr '(a . ((b))))) + type-error) + +(deftest caadar.error.1 + (classify-error (caadar 'a)) + type-error) + +(deftest caadar.error.2 + (classify-error (caadar '(a . b))) + type-error) + +(deftest caadar.error.3 + (classify-error (caadar '((a . c) . b))) + type-error) + +(deftest caadar.error.4 + (classify-error (caadar '((a . (c)) . b))) + type-error) + +(deftest caaddr.error.1 + (classify-error (caaddr 'a)) + type-error) + +(deftest caaddr.error.2 + (classify-error (caaddr '(a . b))) + type-error) + +(deftest caaddr.error.3 + (classify-error (caaddr '(a c . b))) + type-error) + +(deftest caaddr.error.4 + (classify-error (caaddr '(a c . (b)))) + type-error) + +(deftest cadaar.error.1 + (classify-error (cadaar 'a)) + type-error) + +(deftest cadaar.error.2 + (classify-error (cadaar '(a))) + type-error) + +(deftest cadaar.error.3 + (classify-error (cadaar '((a . b)))) + type-error) + +(deftest cadaar.error.4 + (classify-error (cadaar '((a . (b))))) + type-error) + +(deftest cadadr.error.1 + (classify-error (cadadr 'a)) + type-error) + +(deftest cadadr.error.2 + (classify-error (cadadr '(a . b))) + type-error) + +(deftest cadadr.error.3 + (classify-error (cadadr '(a b . c))) + type-error) + +(deftest cadadr.error.4 + (classify-error (cadadr '(a (b . e) . c))) + type-error) + +(deftest caddar.error.1 + (classify-error (caddar 'a)) + type-error) + +(deftest caddar.error.2 + (classify-error (caddar '(a . b))) + type-error) + +(deftest caddar.error.3 + (classify-error (caddar '((a . b) . b))) + type-error) + +(deftest caddar.error.4 + (classify-error (caddar '((a b . c) . b))) + type-error) + +(deftest cadddr.error.1 + (classify-error (cadddr 'a)) + type-error) + +(deftest cadddr.error.2 + (classify-error (cadddr '(a . b))) + type-error) + +(deftest cadddr.error.3 + (classify-error (cadddr '(a c . b))) + type-error) + +(deftest cadddr.error.4 + (classify-error (cadddr '(a c e . b))) + type-error) + +(deftest cdaaar.error.1 + (classify-error (cdaaar 'a)) + type-error) + +(deftest cdaaar.error.2 + (classify-error (cdaaar '(a))) + type-error) + +(deftest cdaaar.error.3 + (classify-error (cdaaar '((a)))) + type-error) + +(deftest cdaaar.error.4 + (classify-error (cdaaar '(((a . b))))) + type-error) + +(deftest cdaadr.error.1 + (classify-error (cdaadr 'a)) + type-error) + +(deftest cdaadr.error.2 + (classify-error (cdaadr '(a . b))) + type-error) + +(deftest cdaadr.error.3 + (classify-error (cdaadr '(a . (b)))) + type-error) + +(deftest cdaadr.error.4 + (classify-error (cdaadr '(a . ((b . c))))) + type-error) + +(deftest cdadar.error.1 + (classify-error (cdadar 'a)) + type-error) + +(deftest cdadar.error.2 + (classify-error (cdadar '(a . b))) + type-error) + +(deftest cdadar.error.3 + (classify-error (cdadar '((a . c) . b))) + type-error) + +(deftest cdadar.error.4 + (classify-error (cdadar '((a . (c . d)) . b))) + type-error) + +(deftest cdaddr.error.1 + (classify-error (cdaddr 'a)) + type-error) + +(deftest cdaddr.error.2 + (classify-error (cdaddr '(a . b))) + type-error) + +(deftest cdaddr.error.3 + (classify-error (cdaddr '(a c . b))) + type-error) + +(deftest cdaddr.error.4 + (classify-error (cdaddr '(a c b . d))) + type-error) + +(deftest cddaar.error.1 + (classify-error (cddaar 'a)) + type-error) + +(deftest cddaar.error.2 + (classify-error (cddaar '(a))) + type-error) + +(deftest cddaar.error.3 + (classify-error (cddaar '((a . b)))) + type-error) + +(deftest cddaar.error.4 + (classify-error (cddaar '((a . (b))))) + type-error) + +(deftest cddadr.error.1 + (classify-error (cddadr 'a)) + type-error) + +(deftest cddadr.error.2 + (classify-error (cddadr '(a . b))) + type-error) + +(deftest cddadr.error.3 + (classify-error (cddadr '(a b . c))) + type-error) + +(deftest cddadr.error.4 + (classify-error (cddadr '(a (b . e) . c))) + type-error) + +(deftest cdddar.error.1 + (classify-error (cdddar 'a)) + type-error) + +(deftest cdddar.error.2 + (classify-error (cdddar '(a . b))) + type-error) + +(deftest cdddar.error.3 + (classify-error (cdddar '((a . b) . b))) + type-error) + +(deftest cdddar.error.4 + (classify-error (cdddar '((a b . c) . b))) + type-error) + +(deftest cddddr.error.1 + (classify-error (cddddr 'a)) + type-error) + +(deftest cddddr.error.2 + (classify-error (cddddr '(a . b))) + type-error) + +(deftest cddddr.error.3 + (classify-error (cddddr '(a c . b))) + type-error) + +(deftest cddddr.error.4 + (classify-error (cddddr '(a c e . b))) + type-error) + +;;; Need to add 'locally' wrapped forms of these diff --git a/ansi-tests/cons-test-09.lsp b/ansi-tests/cons-test-09.lsp new file mode 100644 index 0000000..baba347 --- /dev/null +++ b/ansi-tests/cons-test-09.lsp @@ -0,0 +1,186 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:36:30 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 9 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; butlast, nbutlast + +(deftest butlast.1 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((xcopy (make-scaffold-copy x))) + (let ((result (butlast x 2))) + (and + (check-scaffold-copy x xcopy) + result)))) + (a b c)) + +(deftest butlast.2 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((xcopy (make-scaffold-copy x))) + (let ((result (butlast x 0))) + (and + (check-scaffold-copy x xcopy) + result)))) + (a b c d e)) + +(deftest butlast.3 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((xcopy (make-scaffold-copy x))) + (let ((result (butlast x 5))) + (and + (check-scaffold-copy x xcopy) + result)))) + nil) + +(deftest butlast.4 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((xcopy (make-scaffold-copy x))) + (let ((result (butlast x 6))) + (and + (check-scaffold-copy x xcopy) + result)))) + nil) + +(deftest butlast.5 + (butlast (copy-tree '(a b c . d)) 1) + (a b)) + +(deftest butlast.order.1 + (let ((i 0) x y) + (values + (butlast (progn (setf x (incf i)) + (list 'a 'b 'c 'd 'e)) + (progn (setf y (incf i)) + 2)) + i x y)) + (a b c) 2 1 2) + +(deftest butlast.order.2 + (let ((i 0)) + (values + (butlast (progn (incf i) '(a b c d))) + i)) + (a b c) 1) + +(deftest butlast.error.1 + (classify-error (butlast (copy-tree '(a b c d)) 'a)) + type-error) + +(deftest butlast.error.2 + (classify-error (butlast 'a 0)) + type-error) + +(deftest butlast.error.3 + (classify-error (butlast)) + program-error) + +(deftest butlast.error.4 + (classify-error (butlast '(a b c) 3 3)) + program-error) + +(deftest butlast.error.5 + (classify-error (locally (butlast 'a 0) t)) + type-error) + + +;;; Tests of NBUTLAST + +(deftest nbutlast.1 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((y (cdr x)) + (z (cddr x))) + (let ((result (nbutlast x 2))) + (and (eqt x result) + (eqt (cdr x) y) + (eqt (cddr x) z) + result)))) + (a b c)) + +(deftest nbutlast.2 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((result (nbutlast x 5))) + (list x result))) + ((a b c d e) nil)) + +(deftest nbutlast.3 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((result (nbutlast x 500))) + (list x result))) + ((a b c d e) nil)) + +(deftest nbutlast.4 + (let ((x (list* 'a 'b 'c 'd))) + (let ((result (nbutlast x 1))) + (and (eqt result x) + result))) + (a b)) + +(deftest nbutlast.5 + (nbutlast nil) + nil) + +(deftest nbutlast.6 + (nbutlast (list 'a)) + nil) + +(deftest nbutlast.order.1 + (let ((i 0) x y) + (values + (nbutlast (progn (setf x (incf i)) + (list 'a 'b 'c 'd 'e)) + (progn (setf y (incf i)) + 2)) + i x y)) + (a b c) 2 1 2) + +(deftest nbutlast.order.2 + (let ((i 0)) + (values + (nbutlast (progn (incf i) (list 'a 'b 'c 'd))) + i)) + (a b c) 1) + +(deftest nbutlast.error.1 + (classify-error (let ((x (list* 'a 'b 'c 'd))) (nbutlast x 'a))) + type-error) + +(deftest nbutlast.error.2 + (classify-error (nbutlast 'a 10)) + type-error) + +(deftest nbutlast.error.3 + (classify-error (nbutlast 2 10)) + type-error) + +(deftest nbutlast.error.4 + (classify-error (nbutlast #\w 10)) + type-error) + +(deftest nbutlast.error.5 + (classify-error (nbutlast (list 'a 'b 'c 'd) -3)) + type-error) + +(deftest nbutlast.error.6 + (classify-error (nbutlast (list 'a) 20.0)) + type-error) + +(deftest nbutlast.error.7 + (classify-error (nbutlast (list 'a) -100.0)) + type-error) + +(deftest nbutlast.error.8 + (classify-error (nbutlast)) + program-error) + +(deftest nbutlast.error.9 + (classify-error (nbutlast (list 'a 'b 'c) 3 3)) + program-error) + +(deftest nbutlast.error.10 + (classify-error (locally (nbutlast 'a 10) t)) + type-error) diff --git a/ansi-tests/cons-test-10.lsp b/ansi-tests/cons-test-10.lsp new file mode 100644 index 0000000..fc62578 --- /dev/null +++ b/ansi-tests/cons-test-10.lsp @@ -0,0 +1,96 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:37:21 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 10 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; last + +(deftest last.1 + (last nil) + nil) + +(deftest last.2 + (last (copy-tree '(a b))) + (b)) + +(deftest last.3 + (last (copy-tree '(a b . c))) + (b . c)) + +(deftest last.4 + (last (copy-tree '(a b c d)) 0) + nil) + +(deftest last.5 + (last (copy-tree '(a b c d)) 1) + (d)) + +(deftest last.6 + (last (copy-tree '(a b c d)) 2) + (c d)) + +(deftest last.7 + (last (copy-tree '(a b c d)) 5) + (a b c d)) + +(deftest last.8 + (last (cons 'a 'b) 0) + b) + +(deftest last.9 + (last (cons 'a 'b) 1) + (a . b)) + +(deftest last.10 + (last (cons 'a 'b) 2) + (a . b)) + +(deftest last.order.1 + (let ((i 0) x y) + (values + (last (progn (setf x (incf i)) (list 'a 'b 'c 'd)) + (setf y (incf i))) + i x y)) + (c d) 2 1 2) + +(deftest last.order.2 + (let ((i 0)) + (values (last (progn (incf i) (list 'a 'b 'c 'd))) i)) + (d) 1) + +(deftest last.error.1 + (classify-error (last (list 'a 'b 'c) -1)) + type-error) + +(deftest last.error.2 + (classify-error (last (list 'a 'b 'c) 'a)) + type-error) + +(deftest last.error.3 + (classify-error (last (list 'a 'b 'c) 10.0)) + type-error) + +(deftest last.error.4 + (classify-error (last (list 'a 'b 'c) -10.0)) + type-error) + +(deftest last.error.5 + (classify-error (last (list 'a 'b 'c) #\w)) + type-error) + +(deftest last.error.6 + (classify-error (last)) + program-error) + +(deftest last.error.7 + (classify-error (last '(a b c) 2 nil)) + program-error) + +(deftest last.error.8 + (classify-error (locally (last (list 'a 'b 'c) 'a) t)) + type-error) diff --git a/ansi-tests/cons-test-11.lsp b/ansi-tests/cons-test-11.lsp new file mode 100644 index 0000000..c807859 --- /dev/null +++ b/ansi-tests/cons-test-11.lsp @@ -0,0 +1,261 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:37:56 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 11 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ldiff, tailp + +(deftest ldiff.1 + (let* ((x (copy-tree '(a b c d e f))) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x (cdddr x)))) + (and (check-scaffold-copy x xcopy) + result))) + (a b c)) + +(deftest ldiff.2 + (let* ((x (copy-tree '(a b c d e f))) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x 'a))) + (and + (check-scaffold-copy x xcopy) + (zerop + (loop + for a on x and b on result count + (eqt a b))) + result))) + (a b c d e f)) + +;; Works when the end of the dotted list is a symbol +(deftest ldiff.3 + (let* ((x (copy-tree '(a b c d e . f))) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x 'a))) + (and + (check-scaffold-copy x xcopy) + result))) + (a b c d e . f)) + +;; Works when the end of the dotted list is a fixnum +(deftest ldiff.4 + (let* ((n 18) + (x (list* 'a 'b 'c 18)) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x n))) + (and + (check-scaffold-copy x xcopy) + result))) + (a b c)) + +;; Works when the end of the dotted list is a larger +;; integer (that is eql, but probably not eq). +(deftest ldiff.5 + (let* ((n 18000000000000) + (x (list* 'a 'b 'c (1- 18000000000001))) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x n))) + (and + (check-scaffold-copy x xcopy) + result))) + (a b c)) + +;; Test works when the end of a dotted list is a string +(deftest ldiff.6 + (let* ((n (copy-seq "abcde")) + (x (list* 'a 'b 'c n)) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x n))) + (if (equal result (list 'a 'b 'c)) + (check-scaffold-copy x xcopy) + result))) + t) + +;; Check that having the cdr of a dotted list be string-equal, but +;; not eql, does not result in success +(deftest ldiff.7 + (let* ((n (copy-seq "abcde")) + (x (list* 'a 'b 'c n)) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x (copy-seq n)))) + (if (equal result x) + (check-scaffold-copy x xcopy) + result))) + t) + +;; Check that on failure, the list returned by ldiff is +;; a copy of the list, not the list itself. + +(deftest ldiff.8 + (let ((x (list 'a 'b 'c 'd))) + (let ((result (ldiff x '(e)))) + (and (equal x result) + (loop + for c1 on x + for c2 on result + count (eqt c1 c2))))) + 0) + +(deftest ldiff.order.1 + (let ((i 0) x y) + (values + (ldiff (progn (setf x (incf i)) + (list* 'a 'b 'c 'd)) + (progn (setf y (incf i)) + 'd)) + i x y)) + (a b c) 2 1 2) + +;; Error checking + +(deftest ldiff.error.1 + (classify-error (ldiff 10 'a)) + type-error) + +;; Single atoms are not dotted lists, so the next +;; case should be a type-error +(deftest ldiff.error.2 + (classify-error (ldiff 'a 'a)) + type-error) + +(deftest ldiff.error.3 + (classify-error (ldiff (make-array '(10) :initial-element 'a) '(a))) + type-error) + +(deftest ldiff.error.4 + (classify-error (ldiff 1.23 t)) + type-error) + +(deftest ldiff.error.5 + (classify-error (ldiff #\w 'a)) + type-error) + +(deftest ldiff.error.6 + (classify-error (ldiff)) + program-error) + +(deftest ldiff.error.7 + (classify-error (ldiff nil)) + program-error) + +(deftest ldiff.error.8 + (classify-error (ldiff nil nil nil)) + program-error) + +;; Note! The spec is ambiguous on whether this next test +;; is correct. The spec says that ldiff should be prepared +;; to signal an error if the list argument is not a proper +;; list or dotted list. If listp is false, the list argument +;; is neither (atoms are not dotted lists). +;; +;; However, the sample implementation *does* work even if +;; the list argument is an atom. +;; +#| +(defun ldiff-12-body () + (loop + for x in *universe* + count (and (not (listp x)) + (not (eqt 'type-error + (catch-type-error (ldiff x x))))))) + +(deftest ldiff-12 + (ldiff-12-body) + 0) +|# + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; tailp + +(deftest tailp.1 + (let ((x (copy-tree '(a b c d e . f)))) + (and + (tailp x x) + (tailp (cdr x) x) + (tailp (cddr x) x) + (tailp (cdddr x) x) + (tailp (cddddr x) x) + t)) + t) + +;; The next four tests test that tailp handles dotted lists. See +;; TAILP-NIL:T in the X3J13 documentation. + +(deftest tailp.2 + (notnot-mv (tailp 'e (copy-tree '(a b c d . e)))) + t) + +(deftest tailp.3 + (tailp 'z (copy-tree '(a b c d . e))) + nil) + +(deftest tailp.4 + (notnot-mv (tailp 10203040506070 + (list* 'a 'b (1- 10203040506071)))) + t) + +(deftest tailp.5 + (let ((x "abcde")) (tailp x (list* 'a 'b (copy-seq x)))) + nil) + +(deftest tailp.error.5 + (classify-error (tailp)) + program-error) + +(deftest tailp.error.6 + (classify-error (tailp nil)) + program-error) + +(deftest tailp.error.7 + (classify-error (tailp nil nil nil)) + program-error) + +;; Test that tailp does not modify its arguments + +(deftest tailp.6 + (let* ((x (copy-list '(a b c d e))) + (y (cddr x))) + (let ((xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y))) + (and + (tailp y x) + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy)))) + t) + +;; Note! The spec is ambiguous on whether this next test +;; is correct. The spec says that tailp should be prepared +;; to signal an error if the list argument is not a proper +;; list or dotted list. If listp is false, the list argument +;; is neither (atoms are not dotted lists). +;; +;; However, the sample implementation *does* work even if +;; the list argument is an atom. +;; + +#| +(defun tailp.7-body () + (loop + for x in *universe* + count (and (not (listp x)) + (eqt 'type-error + (catch-type-error (tailp x x)))))) + +(deftest tailp.7 + (tailp.7-body) + 0) +|# + +(deftest tailp.order.1 + (let ((i 0) x y) + (values + (notnot + (tailp (progn (setf x (incf i)) 'd) + (progn (setf y (incf i)) '(a b c . d)))) + i x y)) + t 2 1 2) + diff --git a/ansi-tests/cons-test-12.lsp b/ansi-tests/cons-test-12.lsp new file mode 100644 index 0000000..2402b86 --- /dev/null +++ b/ansi-tests/cons-test-12.lsp @@ -0,0 +1,103 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:38:26 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 12 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nthcdr + +(deftest nthcdr.error.1 + (classify-error (nthcdr nil (copy-tree '(a b c d)))) + type-error) + +(deftest nthcdr.error.2 + (classify-error (nthcdr 'a (copy-tree '(a b c d)))) + type-error) + +(deftest nthcdr.error.3 + (classify-error (nthcdr 0.1 (copy-tree '(a b c d)))) + type-error) + +(deftest nthcdr.error.4 + (classify-error (nthcdr #\A (copy-tree '(a b c d)))) + type-error) + +(deftest nthcdr.error.5 + (classify-error (nthcdr '(a) (copy-tree '(a b c d)))) + type-error) + +(deftest nthcdr.error.6 + (classify-error (nthcdr -10 (copy-tree '(a b c d)))) + type-error) + +(deftest nthcdr.error.7 + (classify-error (nthcdr)) + program-error) + +(deftest nthcdr.error.8 + (classify-error (nthcdr 0)) + program-error) + +(deftest nthcdr.error.9 + (classify-error (nthcdr 0 nil nil)) + program-error) + +(deftest nthcdr.error.10 + (classify-error (nthcdr 3 (cons 'a 'b))) + type-error) + +(deftest nthcdr.error.11 + (classify-error (locally (nthcdr 'a (copy-tree '(a b c d))) t)) + type-error) + +(deftest nthcdr.1 + (nthcdr 0 (copy-tree '(a b c d . e))) + (a b c d . e)) + +(deftest nthcdr.2 + (nthcdr 1 (copy-tree '(a b c d))) + (b c d)) + +(deftest nthcdr.3 + (nthcdr 10 nil) + nil) + +(deftest nthcdr.4 + (nthcdr 4 (list 'a 'b 'c)) + nil) + +(deftest nthcdr.5 + (nthcdr 1 (cons 'a 'b)) + b) + +(deftest nthcdr.order.1 + (let ((i 0) x y) + (values + (nthcdr (setf x (incf i)) + (progn (setf y (incf i)) '(a b c d))) + i x y)) + (b c d) 2 1 2) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; rest + +(deftest rest.1 + (rest (list 'a 'b 'c)) + (b c)) + +(deftest rest.order.1 + (let ((i 0)) + (values (rest (progn (incf i) '(a b))) i)) + (b) 1) + +(deftest rest.error.1 + (classify-error (rest)) + program-error) + +(deftest rest.error.2 + (classify-error (rest nil nil)) + program-error) diff --git a/ansi-tests/cons-test-13.lsp b/ansi-tests/cons-test-13.lsp new file mode 100644 index 0000000..bdef6cc --- /dev/null +++ b/ansi-tests/cons-test-13.lsp @@ -0,0 +1,292 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:38:57 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 13 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; member + +(deftest member.1 + (let* ((x (copy-tree '(a b c d e f))) + (xcopy (make-scaffold-copy x)) + (result (member 'c x))) + (and + (eqt result (cddr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.2 + (let* ((x (copy-tree '(a b c d e f))) + (xcopy (make-scaffold-copy x)) + (result (member 'e x))) + (and + (eqt result (cddddr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.3 + (let* ((x (copy-tree '(1 2 3 4 5 6 7))) + (xcopy (make-scaffold-copy x)) + (result (member 4 x))) + (and + (eqt result (cdddr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.4 + (let* ((x (copy-tree '(2 4 6 8 10 12))) + (xcopy (make-scaffold-copy x)) + (result (member 9 x :key #'1+))) + (and + (eqt result (cdddr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.5 + (let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) + (xcopy (make-scaffold-copy x)) + (result (member '(c d) x :test #'equal))) + (and + (eqt result (cdr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.6 + (let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) + (xcopy (make-scaffold-copy x)) + (result (member 'c x :key #'car))) + (and + (eqt result (cdr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.7 + (let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) + (xcopy (make-scaffold-copy x)) + (result (member 'c x :key #'car :test #'eq))) + (and + (eqt result (cdr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.8 + (let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) + (xcopy (make-scaffold-copy x)) + (result (member 'c x :key #'car :test-not (complement #'eq)))) + (and + (eqt result (cdr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.9 + (let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) + (xcopy (make-scaffold-copy x)) + (result (member 'c x :key #'car :test #'eql))) + (and + (eqt result (cdr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.10 + (let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) + (xcopy (make-scaffold-copy x)) + (result (member (list 'd) x :key #'cdr :test #'equal))) + (and + (eqt result (cdr x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest member.11 + (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee"))) + nil) + +(deftest member.12 + (member 1 (copy-tree '(3 4 1 31 423))) + (1 31 423)) + +(deftest member.13 + (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee")) + :test #'equal) + ("cc" "dd" "ee")) + +(deftest member.14 + (member 'a nil) + nil) + +(deftest member.15 + (member nil nil) + nil) + +(deftest member.16 + (member nil nil :test #'equal) + nil) + +(deftest member.16-a + (member nil nil :test #'(lambda (x y) (error "Should not call this function"))) + nil) + +(deftest member.17 + (member 'a nil :test #'(lambda (x y) (error "Should not call this function"))) + nil) + +;; Check that a null key argument is ignored + +(deftest member.18 + (member 'a '(c d a b e) :key nil) + (a b e)) + +(deftest member.19 + (member 'z '(a b c d) :key nil) + nil) + +;;; Order of evaluation + +(deftest member.order.1 + (let ((i 0) x y) + (values + (member (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '(a b c d))) + i x y)) + (c d) 2 1 2) + +(deftest member.order.2 + (let ((i 0) x y z p) + (values + (member (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '(a b c d)) + :key (progn (setf z (incf i)) #'identity) + :test (progn (setf p (incf i)) #'eq)) + i x y z p)) + (c d) 4 1 2 3 4) + +(deftest member.order.3 + (let ((i 0) x y) + (values + (member (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '(a b c d)) + :test #'eq) + i x y)) + (c d) 2 1 2) + +(deftest member.order.4 + (let ((i 0) x y z p q) + (values + (member (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '(a b c d)) + :key (progn (setf z (incf i)) #'identity) + :test (progn (setf p (incf i)) #'eq) + :key (progn (setf q (incf i)) (constantly 'z))) + i x y z p q)) + (c d) 5 1 2 3 4 5) + +(deftest member.order.5 + (let ((i 0) x y z q) + (values + (member (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '(a b c d)) + :test #'eq + :key (progn (setf z (incf i)) #'identity) + :key (progn (setf q (incf i)) (constantly 'z))) + i x y z q)) + (c d) 4 1 2 3 4) + + +;;; Keyword tests + +(deftest member.allow-other-keys.1 + (member 'b '(a b c) :bad t :allow-other-keys t) + (b c)) + +(deftest member.allow-other-keys.2 + (member 'b '(a b c) :allow-other-keys t :bad t) + (b c)) + +(deftest member.allow-other-keys.3 + (member 'b '(a b c) :allow-other-keys t) + (b c)) + +(deftest member.allow-other-keys.4 + (member 'b '(a b c) :allow-other-keys nil) + (b c)) + +(deftest member.allow-other-keys.5 + (member 'b '(a b c) :allow-other-keys 17 :allow-other-keys nil '#:x t) + (b c)) + +(deftest member.keywords.6 + (member 'b '(a b c) :test #'eq :test (complement #'eq)) + (b c)) + +;;; Error cases + +(deftest member.error.1 + (classify-error (member 'a 'b)) + type-error) + +(deftest member.error.2 + (classify-error (member 'a 1.3)) + type-error) + +(deftest member.error.3 + (classify-error (member 'a 1)) + type-error) + +(deftest member.error.4 + (classify-error (member 'a 0)) + type-error) + +(deftest member.error.5 + (classify-error (member 'a "abcde")) + type-error) + +(deftest member.error.6 + (classify-error (member 'a #\w)) + type-error) + +(deftest member.error.7 + (classify-error (member 'a t)) + type-error) + +(deftest member.error.8 + (classify-error (member)) + program-error) + +(deftest member.error.9 + (classify-error (member nil)) + program-error) + +(deftest member.error.10 + (classify-error (member nil nil :bad t)) + program-error) + +(deftest member.error.11 + (classify-error (member nil nil :test)) + program-error) + +(deftest member.error.12 + (classify-error (member nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest member.error.13 + (classify-error (member nil nil nil)) + program-error) + +(deftest member.error.14 + (classify-error (locally (member 'a t) t)) + type-error) + +(deftest member.error.15 + (classify-error (member 'a '(a b c) :test #'identity)) + program-error) + +(deftest member.error.16 + (classify-error (member 'a '(a b c) :test-not #'identity)) + program-error) + +(deftest member.error.17 + (classify-error (member 'a '(a b c) :key #'cons)) + program-error) diff --git a/ansi-tests/cons-test-14.lsp b/ansi-tests/cons-test-14.lsp new file mode 100644 index 0000000..3b90821 --- /dev/null +++ b/ansi-tests/cons-test-14.lsp @@ -0,0 +1,275 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:39:29 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 14 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; member-if + +(deftest member-if.1 + (member-if #'listp nil) + nil) + +(deftest member-if.2 + (member-if #'(lambda (x) (eqt x 'a)) '(1 2 a 3 4)) + (a 3 4)) + +(deftest member-if.3 + (member-if #'(lambda (x) (eql x 12)) '(4 12 11 73 11) :key #'1+) + (11 73 11)) + +(deftest member-if.4 + (let ((test-inputs + `(1 a 11.3121 11.31s3 1.123f5 -1 0 + 13.13122d34 581.131e-10 + (a b c . d) + ,(make-array '(10)) + "ancadas" #\w))) + (notnot-mv + (every + #'(lambda (x) + (let ((result (catch-type-error (member-if #'listp x)))) + (or (eqt result 'type-error) + (progn + (format t "~%On ~S: returned ~%~S" x result) + nil)))) + test-inputs))) + t) + +(deftest member-if.5 + (member-if #'identity '(1 2 3 4 5) :key #'evenp) + (2 3 4 5)) + +;;; Order of argument tests + +(deftest member-if.order.1 + (let ((i 0) x y) + (values + (member-if (progn (setf x (incf i)) + #'identity) + (progn (setf y (incf i)) + '(nil nil a b nil c d))) + i x y)) + (a b nil c d) 2 1 2) + +(deftest member-if.order.2 + (let ((i 0) x y z w) + (values + (member-if (progn (setf x (incf i)) + #'identity) + (progn (setf y (incf i)) + '(nil nil a b nil c d)) + :key (progn (setf z (incf i)) #'identity) + :key (progn (setf w (incf i)) #'not)) + + i x y z w)) + (a b nil c d) 4 1 2 3 4) + + +;;; Keyword tests + +(deftest member-if.keywords.1 + (member-if #'identity '(1 2 3 4 5) :key #'evenp :key #'oddp) + (2 3 4 5)) + +(deftest member-if.allow-other-keys.2 + (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t :bad t) + (2 3 4 5)) + +(deftest member-if.allow-other-keys.3 + (member-if #'identity '(nil 2 3 4 5) :bad t :allow-other-keys t) + (2 3 4 5)) + +(deftest member-if.allow-other-keys.4 + (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t) + (2 3 4 5)) + +(deftest member-if.allow-other-keys.5 + (member-if #'identity '(nil 2 3 4 5) :allow-other-keys nil) + (2 3 4 5)) + +(deftest member-if.allow-other-keys.6 + (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t + :allow-other-keys nil) + (2 3 4 5)) + +(deftest member-if.allow-other-keys.7 + (member-if #'identity '(nil 2 3 4 5) :allow-other-keys t + :allow-other-keys nil :key #'identity :key #'null) + (2 3 4 5)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; member-if-not + +(deftest member-if-not.1 + (member-if-not #'listp nil) + nil) + +(deftest member-if-not.2 + (member-if-not #'(lambda (x) (eqt x 'a)) '(a 1 2 a 3 4)) + (1 2 a 3 4)) + +(deftest member-if-not.3 + (member-if-not #'(lambda (x) (not (eql x 12))) '(4 12 11 73 11) :key #'1+) + (11 73 11)) + +(deftest member-if-not.4 + (let ((test-inputs + `(1 a 11.3121 11.31s3 1.123f5 -1 0 + 13.13122d34 581.131e-10 + ((a) (b) (c) . d) + ,(make-array '(10)) + "ancadas" #\w))) + (not (every + #'(lambda (x) + (let ((result (catch-type-error (member-if-not #'listp x)))) + (or (eqt result 'type-error) + (progn + (format t "~%On x = ~S, returns: ~%~S" x result) + nil)))) + test-inputs))) + nil) + +(deftest member-if-not.5 + (member-if-not #'not '(1 2 3 4 5) :key #'evenp) + (2 3 4 5)) + +;;; Order of evaluation tests + +(deftest member-if-not.order.1 + (let ((i 0) x y) + (values + (member-if-not (progn (setf x (incf i)) + #'not) + (progn (setf y (incf i)) + '(nil nil a b nil c d))) + i x y)) + (a b nil c d) 2 1 2) + +(deftest member-if-not.order.2 + (let ((i 0) x y z w) + (values + (member-if-not (progn (setf x (incf i)) + #'not) + (progn (setf y (incf i)) + '(nil nil a b nil c d)) + :key (progn (setf z (incf i)) #'identity) + :key (progn (setf w (incf i)) #'not)) + + i x y z w)) + (a b nil c d) 4 1 2 3 4) + +;;; Keyword tests + +(deftest member-if-not.keywords.1 + (member-if-not #'not '(1 2 3 4 5) :key #'evenp :key #'oddp) + (2 3 4 5)) + +(deftest member-if-not.allow-other-keys.2 + (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys t :bad t) + (2 3 4 5)) + +(deftest member-if-not.allow-other-keys.3 + (member-if-not #'not '(nil 2 3 4 5) :bad t :allow-other-keys t) + (2 3 4 5)) + +(deftest member-if-not.allow-other-keys.4 + (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys t) + (2 3 4 5)) + +(deftest member-if-not.allow-other-keys.5 + (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys nil) + (2 3 4 5)) + +(deftest member-if-not.allow-other-keys.6 + (member-if-not #'not '(nil 2 3 4 5) :allow-other-keys t + :allow-other-keys nil :key #'identity :key #'null) + (2 3 4 5)) + + +;;; Error cases + +(deftest member-if.error.1 + (classify-error (member-if #'identity 'a)) + type-error) + +(deftest member-if.error.2 + (classify-error (member-if)) + program-error) + +(deftest member-if.error.3 + (classify-error (member-if #'null)) + program-error) + +(deftest member-if.error.4 + (classify-error (member-if #'null '(a b c) :bad t)) + program-error) + +(deftest member-if.error.5 + (classify-error (member-if #'null '(a b c) :bad t :allow-other-keys nil)) + program-error) + +(deftest member-if.error.6 + (classify-error (member-if #'null '(a b c) :key)) + program-error) + +(deftest member-if.error.7 + (classify-error (member-if #'null '(a b c) 1 2)) + program-error) + +(deftest member-if.error.8 + (classify-error (locally (member-if #'identity 'a) t)) + type-error) + +(deftest member-if.error.9 + (classify-error (member-if #'cons '(a b c))) + program-error) + +(deftest member-if.error.10 + (classify-error (member-if #'identity '(a b c) :key #'cons)) + program-error) + + +(deftest member-if-not.error.1 + (classify-error (member-if-not #'identity 'a)) + type-error) + +(deftest member-if-not.error.2 + (classify-error (member-if-not)) + program-error) + +(deftest member-if-not.error.3 + (classify-error (member-if-not #'null)) + program-error) + +(deftest member-if-not.error.4 + (classify-error (member-if-not #'null '(a b c) :bad t)) + program-error) + +(deftest member-if-not.error.5 + (classify-error (member-if-not #'null '(a b c) :bad t :allow-other-keys nil)) + program-error) + +(deftest member-if-not.error.6 + (classify-error (member-if-not #'null '(a b c) :key)) + program-error) + +(deftest member-if-not.error.7 + (classify-error (member-if-not #'null '(a b c) 1 2)) + program-error) + +(deftest member-if-not.error.8 + (classify-error (locally (member-if-not #'identity 'a) t)) + type-error) + +(deftest member-if-not.error.9 + (classify-error (member-if-not #'cons '(a b c))) + program-error) + +(deftest member-if-not.error.10 + (classify-error (member-if-not #'identity '(a b c) :key #'cons)) + program-error) diff --git a/ansi-tests/cons-test-15.lsp b/ansi-tests/cons-test-15.lsp new file mode 100644 index 0000000..89b2a8f --- /dev/null +++ b/ansi-tests/cons-test-15.lsp @@ -0,0 +1,652 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:40:12 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 15 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; mapc + +(deftest mapc.1 + (mapc #'list nil) + nil) + +(deftest mapc.2 + (let ((x 0)) + (let ((result + (mapc #'(lambda (y) (incf x y)) + '(1 2 3 4)))) + (list result x))) + ((1 2 3 4) 10)) + +(deftest mapc.3 + (let ((x 0)) + (list + (mapc #'(lambda (y z) (declare (ignore y z)) (incf x)) + (make-list 5 :initial-element 'a) + (make-list 5 )) + x)) + ((a a a a a) 5)) + +(deftest mapc.4 + (let ((x 0)) + (list + (mapc #'(lambda (y z) (declare (ignore y z)) (incf x)) + (make-list 5 :initial-element 'a) + (make-list 10)) + x)) + ((a a a a a) 5)) + +(deftest mapc.5 + (let ((x 0)) + (list + (mapc #'(lambda (y z) (declare (ignore y z)) (incf x)) + (make-list 5 :initial-element 'a) + (make-list 3)) + x)) + ((a a a a a) 3)) + +(defvar *mapc.6-var* nil) +(defun mapc.6-fun (x) + (push x *mapc.6-var*) + x) + +(deftest mapc.6 + (let* ((x (copy-list '(a b c d e f g h))) + (xcopy (make-scaffold-copy x))) + (setf *mapc.6-var* nil) + (let ((result (mapc 'mapc.6-fun x))) + (and (check-scaffold-copy x xcopy) + (eqt result x) + *mapc.6-var*))) + (h g f e d c b a)) + +(deftest mapc.order.1 + (let ((i 0) x y z) + (values + (mapc (progn (setf x (incf i)) + #'list) + (progn (setf y (incf i)) + '(a b c)) + (progn (setf z (incf i)) + '(1 2 3))) + i x y z)) + (a b c) 3 1 2 3) + +(deftest mapc.error.1 + (classify-error (mapc #'identity 1)) + type-error) + +(deftest mapc.error.2 + (classify-error (mapc)) + program-error) + +(deftest mapc.error.3 + (classify-error (mapc #'append)) + program-error) + +(deftest mapc.error.4 + (classify-error (locally (mapc #'identity 1) t)) + type-error) + +(deftest mapc.error.5 + (classify-error (mapc #'cons '(a b c))) + program-error) + +(deftest mapc.error.6 + (classify-error (mapc #'cons '(a b c) '(1 2 3) '(4 5 6))) + program-error) + +(deftest mapc.error.7 + (classify-error (mapc #'car '(a b c))) + type-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; mapcar + +(deftest mapcar.1 + (mapcar #'1+ nil) + nil) + +(deftest mapcar.2 + (let* ((x (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x))) + (let ((result (mapcar #'1+ x))) + (and (check-scaffold-copy x xcopy) + result))) + (2 3 4 5)) + +(deftest mapcar.3 + (let* ((n 0) + (x (copy-list '(a b c d))) + (xcopy (make-scaffold-copy x))) + (let ((result + (mapcar #'(lambda (y) (declare (ignore y)) (incf n)) + x))) + (and (check-scaffold-copy x xcopy) + result))) + (1 2 3 4)) + +(deftest mapcar.4 + (let* ((n 0) + (x (copy-list '(a b c d))) + (xcopy (make-scaffold-copy x)) + (x2 (copy-list '(a b c d e f))) + (x2copy (make-scaffold-copy x2)) + (result + (mapcar #'(lambda (y z) (declare (ignore y z)) (incf n)) + x x2))) + (and (check-scaffold-copy x xcopy) + (check-scaffold-copy x2 x2copy) + (list result n))) + ((1 2 3 4) 4)) + +(deftest mapcar.5 + (let* ((n 0) + (x (copy-list '(a b c d))) + (xcopy (make-scaffold-copy x)) + (x2 (copy-list '(a b c d e f))) + (x2copy (make-scaffold-copy x2)) + (result + (mapcar #'(lambda (y z) (declare (ignore y z)) (incf n)) + x2 x))) + (and (check-scaffold-copy x xcopy) + (check-scaffold-copy x2 x2copy) + (list result n))) + ((1 2 3 4) 4)) + +(deftest mapcar.6 + (let* ((x (copy-list '(a b c d e f g h))) + (xcopy (make-scaffold-copy x))) + (setf *mapc.6-var* nil) + (let ((result (mapcar 'mapc.6-fun x))) + (and (check-scaffold-copy x xcopy) + (list *mapc.6-var* result)))) + ((h g f e d c b a) (a b c d e f g h))) + +(deftest mapcar.order.1 + (let ((i 0) x y z) + (values + (mapcar (progn (setf x (incf i)) + #'list) + (progn (setf y (incf i)) + '(a b c)) + (progn (setf z (incf i)) + '(1 2 3))) + i x y z)) + ((a 1) (b 2) (c 3)) + 3 1 2 3) + +(deftest mapcar.error.1 + (classify-error (mapcar #'identity 1)) + type-error) + +(deftest mapcar.error.2 + (classify-error (mapcar)) + program-error) + +(deftest mapcar.error.3 + (classify-error (mapcar #'append)) + program-error) + +(deftest mapcar.error.4 + (classify-error (locally (mapcar #'identity 1) t)) + type-error) + +(deftest mapcar.error.5 + (classify-error (mapcar #'car '(a b c))) + type-error) + +(deftest mapcar.error.6 + (classify-error (mapcar #'cons '(a b c))) + program-error) + +(deftest mapcar.error.7 + (classify-error (mapcar #'cons '(a b c) '(1 2 3) '(4 5 6))) + program-error) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; mapcan + +(deftest mapcan.1 + (mapcan #'list nil) + nil) + +(deftest mapcan.2 + (mapcan #'list (copy-list '(a b c d e f))) + (a b c d e f)) + +(deftest mapcan.3 + (let* ((x (list 'a 'b 'c 'd)) + (xcopy (make-scaffold-copy x)) + (result (mapcan #'list x))) + (and + (= (length x) (length result)) + (check-scaffold-copy x xcopy) + (loop + for e1 on x + and e2 on result + count (or (eqt e1 e2) (not (eql (car e1) (car e2))))))) + 0) + +(deftest mapcan.4 + (mapcan #'list + (copy-list '(1 2 3 4)) + (copy-list '(a b c d))) + (1 a 2 b 3 c 4 d)) + +(deftest mapcan.5 + (mapcan #'(lambda (x y) (make-list y :initial-element x)) + (copy-list '(a b c d)) + (copy-list '(1 2 3 4))) + (a b b c c c d d d d)) + +(defvar *mapcan.6-var* nil) +(defun mapcan.6-fun (x) + (push x *mapcan.6-var*) + (copy-list *mapcan.6-var*)) + +(deftest mapcan.6 + (progn + (setf *mapcan.6-var* nil) + (mapcan 'mapcan.6-fun (copy-list '(a b c d)))) + (a b a c b a d c b a)) + +(deftest mapcan.order.1 + (let ((i 0) x y z) + (values + (mapcan (progn (setf x (incf i)) + #'list) + (progn (setf y (incf i)) + '(a b c)) + (progn (setf z (incf i)) + '(1 2 3))) + i x y z)) + (a 1 b 2 c 3) + 3 1 2 3) + +(deftest mapcan.8 + (mapcan #'(lambda (x y) (make-list y :initial-element x)) + (copy-list '(a b c d)) + (copy-list '(1 2 3 4 5 6))) + (a b b c c c d d d d)) + +(deftest mapcan.9 + (mapcan #'(lambda (x y) (make-list y :initial-element x)) + (copy-list '(a b c d e f)) + (copy-list '(1 2 3 4))) + (a b b c c c d d d d)) + +(deftest mapcan.10 + (mapcan #'list + (copy-list '(a b c d)) + (copy-list '(1 2 3 4)) + nil) + nil) + +(deftest mapcan.11 + (mapcan (constantly 1) (list 'a)) + 1) + +(deftest mapcan.error.1 + (classify-error (mapcan #'identity 1)) + type-error) + +(deftest mapcan.error.2 + (classify-error (mapcan)) + program-error) + +(deftest mapcan.error.3 + (classify-error (mapcan #'append)) + program-error) + +(deftest mapcan.error.4 + (classify-error (locally (mapcan #'identity 1) t)) + type-error) + +(deftest mapcan.error.5 + (classify-error (mapcan #'car '(a b c))) + type-error) + +(deftest mapcan.error.6 + (classify-error (mapcan #'cons '(a b c))) + program-error) + +(deftest mapcan.error.7 + (classify-error (mapcan #'cons '(a b c) '(1 2 3) '(4 5 6))) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; mapl + +(deftest mapl.1 + (mapl #'list nil) + nil) + +(deftest mapl.2 + (let* ((a nil) + (x (copy-list '(a b c))) + (xcopy (make-scaffold-copy x)) + (result + (mapl #'(lambda (y) (push y a)) + x))) + (and + (check-scaffold-copy x xcopy) + (eqt result x) + a)) + ((c) (b c) (a b c))) + +(deftest mapl.3 + (let* ((a nil) + (x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapl #'(lambda (xtail ytail) + (setf a + (append (mapcar #'list xtail ytail) + a))) + x y))) + (and + (eqt result x) + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + a)) + ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4) + (a 1) (b 2) (c 3) (d 4))) + +(deftest mapl.4 + (let* ((a nil) + (x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4 5 6 7 8))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapl #'(lambda (xtail ytail) + (setf a + (append (mapcar #'list xtail ytail) + a))) + x y))) + (and + (eqt result x) + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + a)) + ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4) + (a 1) (b 2) (c 3) (d 4))) + +(deftest mapl.5 + (let* ((a nil) + (x (copy-list '(a b c d e f g))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapl #'(lambda (xtail ytail) + (setf a + (append (mapcar #'list xtail ytail) + a))) + x y))) + (and + (eqt result x) + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + a)) + ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4) + (a 1) (b 2) (c 3) (d 4))) + +(deftest mapl.order.1 + (let ((i 0) x y z) + (values + (mapl (progn + (setf x (incf i)) + (constantly nil)) + (progn + (setf y (incf i)) + '(a b c)) + (progn + (setf z (incf i)) + '(1 2 3))) + i x y z)) + (a b c) 3 1 2 3) + +(deftest mapl.error.1 + (classify-error (mapl #'identity 1)) + type-error) + +(deftest mapl.error.2 + (classify-error (mapl)) + program-error) + +(deftest mapl.error.3 + (classify-error (mapl #'append)) + program-error) + +(deftest mapl.error.4 + (classify-error (locally (mapl #'identity 1) t)) + type-error) + +(deftest mapl.error.5 + (classify-error (mapl #'cons '(a b c))) + program-error) + +(deftest mapl.error.6 + (classify-error (mapl #'cons '(a b c) '(1 2 3) '(4 5 6))) + program-error) + +(deftest mapl.error.7 + (classify-error (mapl #'caar '(a b c))) + type-error) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; maplist + +(deftest maplist.1 + (maplist #'list nil) + nil) + +(deftest maplist.2 + (let* ((x (copy-list '(a b c))) + (xcopy (make-scaffold-copy x)) + (result (maplist #'identity x))) + (and (check-scaffold-copy x xcopy) + result)) + ((a b c) (b c) (c))) + +(deftest maplist.3 + (let* ((x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (maplist #'append x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) + ((a b c d 1 2 3 4) + (b c d 2 3 4) + (c d 3 4) + (d 4))) + +(deftest maplist.4 + (let* ((x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4 5))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (maplist #'append x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) + ((a b c d 1 2 3 4 5) + (b c d 2 3 4 5) + (c d 3 4 5) + (d 4 5))) + +(deftest maplist.5 + (let* ((x (copy-list '(a b c d e))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (maplist #'append x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) + ((a b c d e 1 2 3 4) + (b c d e 2 3 4) + (c d e 3 4) + (d e 4))) + +(deftest maplist.6 + (maplist 'append '(a b c) '(1 2 3)) + ((a b c 1 2 3) (b c 2 3) (c 3))) + +(deftest maplist.7 + (maplist #'(lambda (x y) (nth (car x) y)) + '(0 1 0 1 0 1 0) + '(a b c d e f g) + ) + (a c c e e g g)) + +(deftest maplist.order.1 + (let ((i 0) x y z) + (values + (maplist + (progn + (setf x (incf i)) + #'(lambda (x y) (declare (ignore x)) (car y))) + (progn + (setf y (incf i)) + '(a b c)) + (progn + (setf z (incf i)) + '(1 2 3))) + i x y z)) + (1 2 3) 3 1 2 3) + +(deftest maplist.error.1 + (classify-error (maplist #'identity 'a)) + type-error) + +(deftest maplist.error.2 + (classify-error (maplist #'identity 1)) + type-error) + +(deftest maplist.error.3 + (classify-error (maplist #'identity 1.1323)) + type-error) + +(deftest maplist.error.4 + (classify-error (maplist #'identity "abcde")) + type-error) + +(deftest maplist.error.5 + (classify-error (maplist)) + program-error) + +(deftest maplist.error.6 + (classify-error (maplist #'append)) + program-error) + +(deftest maplist.error.7 + (classify-error (locally (maplist #'identity 'a) t)) + type-error) + +(deftest maplist.error.8 + (classify-error (maplist #'caar '(a b c))) + type-error) + +(deftest maplist.error.9 + (classify-error (maplist #'cons '(a b c))) + program-error) + +(deftest maplist.error.10 + (classify-error (maplist #'cons '(a b c) '(1 2 3) '(4 5 6))) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; mapcon + +(deftest mapcon.1 + (mapcon #'(lambda (x) (append '(a) x nil)) nil) + nil) + +(deftest mapcon.2 + (let* ((x (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (result + (mapcon #'(lambda (y) (append '(a) y nil)) x))) + (and + (check-scaffold-copy x xcopy) + result)) + (a 1 2 3 4 a 2 3 4 a 3 4 a 4)) + +(deftest mapcon.3 + (let* ((x (copy-list '(4 2 3 2 2))) + (y (copy-list '(a b c d e f g h i j k l))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapcon #'(lambda (xt yt) + (subseq yt 0 (car xt))) + x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) + (a b c d b c c d e d e e f)) + +(deftest mapcon.4 + (mapcon (constantly 1) (list 'a)) + 1) + +(deftest mapcon.order.1 + (let ((i 0) x y z) + (values + (mapcon (progn (setf x (incf i)) + #'(lambda (x y) (list (car x) (car y)))) + (progn (setf y (incf i)) + '(a b c)) + (progn (setf z (incf i)) + '(1 2 3))) + i x y z)) + (a 1 b 2 c 3) + 3 1 2 3) + +(deftest mapcon.error.1 + (classify-error (mapcon #'identity 1)) + type-error) + +(deftest mapcon.error.2 + (classify-error (mapcon)) + program-error) + +(deftest mapcon.error.3 + (classify-error (mapcon #'append)) + program-error) + +(deftest mapcon.error.4 + (classify-error (locally (mapcon #'identity 1) t)) + type-error) + +(deftest mapcon.error.5 + (classify-error (mapcon #'caar '(a b c))) + type-error) + +(deftest mapcon.error.6 + (classify-error (mapcon #'cons '(a b c))) + program-error) + +(deftest mapcon.error.7 + (classify-error (mapcon #'cons '(a b c) '(1 2 3) '(4 5 6))) + program-error) diff --git a/ansi-tests/cons-test-16.lsp b/ansi-tests/cons-test-16.lsp new file mode 100644 index 0000000..be3978a --- /dev/null +++ b/ansi-tests/cons-test-16.lsp @@ -0,0 +1,678 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 07:41:13 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 16 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; acons + +(deftest acons.1 + (let* ((x (copy-tree '((c . d) (e . f)))) + (xcopy (make-scaffold-copy x)) + (result (acons 'a 'b x))) + (and + (check-scaffold-copy x xcopy) + (eqt (cdr result) x) + result)) + ((a . b) (c . d) (e . f))) + +(deftest acons.2 + (acons 'a 'b nil) + ((a . b))) + +(deftest acons.3 + (acons 'a 'b 'c) + ((a . b) . c)) + +(deftest acons.4 + (acons '((a b)) '(((c d) e) f) '((1 . 2))) + (( ((a b)) . (((c d) e) f)) (1 . 2))) + +(deftest acons.5 + (acons "ancd" 1.143 nil) + (("ancd" . 1.143))) + +(deftest acons.6 + (acons #\R :foo :bar) + ((#\R . :foo) . :bar)) + +(deftest acons.order.1 + (let ((i 0) x y z) + (values + (acons (progn (setf x (incf i)) 'a) + (progn (setf y (incf i)) 'b) + (progn (setf z (incf i)) '((c . d)))) + i x y z)) + ((a . b)(c . d)) + 3 1 2 3) + +(deftest acons.error.1 + (classify-error (acons)) + program-error) + +(deftest acons.error.2 + (classify-error (acons 'a)) + program-error) + +(deftest acons.error.3 + (classify-error (acons 'a 'b)) + program-error) + +(deftest acons.error.4 + (classify-error (acons 'a 'b 'c 'd)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; assoc + +(deftest assoc.1 + (assoc nil nil) + nil) + +(deftest assoc.2 + (assoc nil '(nil)) + nil) + +(deftest assoc.3 + (assoc nil '(nil (nil . 2) (a . b))) + (nil . 2)) + +(deftest assoc.4 + (assoc nil '((a . b) (c . d))) + nil) + +(deftest assoc.5 + (assoc 'a '((a . b))) + (a . b)) + +(deftest assoc.6 + (assoc 'a '((:a . b) (#:a . c) (a . d) (a . e) (z . f))) + (a . d)) + +(deftest assoc.7 + (let* ((x (copy-tree '((a . b) (b . c) (c . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc 'b x))) + (and + (eqt result (second x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest assoc.8 + (assoc 1 '((0 . a) (1 . b) (2 . c))) + (1 . b)) + +(deftest assoc.9 + (assoc (copy-seq "abc") + '((abc . 1) ("abc" . 2) ("abc" . 3))) + nil) + +(deftest assoc.10 + (assoc (copy-list '(a)) (copy-tree '(((a) b) ((a) (c))))) + nil) + +(deftest assoc.11 + (let ((x (list 'a 'b))) + (assoc x `(((a b) c) (,x . d) (,x . e) ((a b) 1)))) + ((a b) . d)) + + +(deftest assoc.12 + (assoc #\e '(("abefd" . 1) ("aevgd" . 2) ("edada" . 3)) + :key #'(lambda (x) (char x 1))) + ("aevgd" . 2)) + +(deftest assoc.13 + (assoc nil '(((a) . b) ( nil . c ) ((nil) . d)) + :key #'car) + (nil . c)) + +(deftest assoc.14 + (assoc (copy-seq "abc") + '((abc . 1) ("abc" . 2) ("abc" . 3)) + :test #'equal) + ("abc" . 2)) + +(deftest assoc.15 + (assoc (copy-seq "abc") + '((abc . 1) ("abc" . 2) ("abc" . 3)) + :test #'equalp) + ("abc" . 2)) + +(deftest assoc.16 + (assoc (copy-list '(a)) (copy-tree '(((a) b) ((a) (c)))) + :test #'equal) + ((a) b)) + +(deftest assoc.17 + (assoc (copy-seq "abc") + '((abc . 1) (a . a) (b . b) ("abc" . 2) ("abc" . 3)) + :test-not (complement #'equalp)) + ("abc" . 2)) + +(deftest assoc.18 + (assoc 'a '((a . d)(b . c)) :test-not #'eq) + (b . c)) + +(deftest assoc.19 + (assoc 'a '((a . d)(b . c)) :test (complement #'eq)) + (b . c)) + +(deftest assoc.20 + (assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)) + :key #'(lambda (x) (and (stringp x) (string-downcase x))) + :test #'equal) + ("A" . 6)) + +(deftest assoc.21 + (assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)) + :key #'(lambda (x) (and (stringp x) x)) + :test #'equal) + ("a" . 3)) + +(deftest assoc.22 + (assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)) + :key #'(lambda (x) (and (stringp x) (string-downcase x))) + :test-not (complement #'equal)) + ("A" . 6)) + +(deftest assoc.23 + (assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)) + :key #'(lambda (x) (and (stringp x) x)) + :test-not (complement #'equal)) + ("a" . 3)) + +;; Check that it works when test returns a true value +;; other than T + +(deftest assoc.24 + (assoc 'a '((b . 1) (a . 2) (c . 3)) + :test #'(lambda (x y) (and (eqt x y) 'matched))) + (a . 2)) + +;; Check that the order of the arguments to test is correct + +(deftest assoc.25 + (block fail + (assoc 'a '((b . 1) (c . 2) (a . 3)) + :test #'(lambda (x y) + (unless (eqt x 'a) (return-from fail 'fail)) + (eqt x y)))) + (a . 3)) + +;;; Order of argument evaluation + +(deftest assoc.order.1 + (let ((i 0) x y) + (values + (assoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((a . 1) (b . 2) (c . 3) (d . 4)))) + i x y)) + (c . 3) 2 1 2) + +(deftest assoc.order.2 + (let ((i 0) x y z) + (values + (assoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((a . 1) (b . 2) (c . 3) (d . 4))) + :test (progn (setf z (incf i)) #'eq)) + i x y z)) + (c . 3) 3 1 2 3) + +(deftest assoc.order.3 + (let ((i 0) x y) + (values + (assoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((a . 1) (b . 2) (c . 3) (d . 4))) + :test #'eq) + i x y)) + (c . 3) 2 1 2) + +(deftest assoc.order.4 + (let ((i 0) x y z w) + (values + (assoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((a . 1) (b . 2) (c . 3) (d . 4))) + :key (progn (setf z (incf i)) #'identity) + :key (progn (setf w (incf i)) #'not)) + i x y z w)) + (c . 3) 4 1 2 3 4) + +;;; Keyword tests + +(deftest assoc.allow-other-keys.1 + (assoc 'b '((a . 1) (b . 2) (c . 3)) :bad t :allow-other-keys t) + (b . 2)) + +(deftest assoc.allow-other-keys.2 + (assoc 'b '((a . 1) (b . 2) (c . 3)) :allow-other-keys t :also-bad t) + (b . 2)) + +(deftest assoc.allow-other-keys.3 + (assoc 'b '((a . 1) (b . 2) (c . 3)) :allow-other-keys t :also-bad t + :test-not #'eql) + (a . 1)) + +(deftest assoc.allow-other-keys.4 + (assoc 'b '((a . 1) (b . 2) (c . 3)) :allow-other-keys t) + (b . 2)) + +(deftest assoc.allow-other-keys.5 + (assoc 'b '((a . 1) (b . 2) (c . 3)) :allow-other-keys nil) + (b . 2)) + +(deftest assoc.keywords.6 + (assoc 'b '((a . 1) (b . 2) (c . 3)) :key #'identity :key #'null) + (b . 2)) + +(deftest assoc.keywords.7 + (assoc 'b '((a . 1) (b . 2) (c . 3)) :key nil :key #'null) + (b . 2)) + + +(deftest assoc.error.1 + (classify-error (assoc)) + program-error) + +(deftest assoc.error.2 + (classify-error (assoc nil)) + program-error) + +(deftest assoc.error.3 + (classify-error (assoc nil nil :bad t)) + program-error) + +(deftest assoc.error.4 + (classify-error (assoc nil nil :key)) + program-error) + +(deftest assoc.error.5 + (classify-error (assoc nil nil 1 1)) + program-error) + +(deftest assoc.error.6 + (classify-error (assoc nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest assoc.error.7 + (classify-error (assoc 'a '((a . b)) :test #'identity)) + program-error) + +(deftest assoc.error.8 + (classify-error (assoc 'a '((a . b)) :test-not #'identity)) + program-error) + +(deftest assoc.error.9 + (classify-error (assoc 'a '((a . b)) :key #'cons)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; assoc-if + +(deftest assoc-if.1 + (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if #'evenp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (6 . c)) + +(deftest assoc-if.2 + (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if #'oddp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (6 . c)) + +(deftest assoc-if.3 + (let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if #'evenp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (fourth x)) + result)) + (6 . c)) + +(deftest assoc-if.4 + (assoc-if #'null '((a . b) nil (c . d) (nil . e) (f . g))) + (nil . e)) + +;;; Order of argument evaluation + +(deftest assoc-if.order.1 + (let ((i 0) x y) + (values + (assoc-if (progn (setf x (incf i)) #'null) + (progn (setf y (incf i)) + '((a . 1) (b . 2) (nil . 17) (d . 4)))) + i x y)) + (nil . 17) 2 1 2) + +(deftest assoc-if.order.2 + (let ((i 0) x y z) + (values + (assoc-if (progn (setf x (incf i)) #'null) + (progn (setf y (incf i)) + '((a . 1) (b . 2) (nil . 17) (d . 4))) + :key (progn (setf z (incf i)) #'null)) + i x y z)) + (a . 1) 3 1 2 3) + +;;; Keyword tests + +(deftest assoc-if.allow-other-keys.1 + (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t) + (nil . 2)) + +(deftest assoc-if.allow-other-keys.2 + (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) + :allow-other-keys t :also-bad t) + (nil . 2)) + +(deftest assoc-if.allow-other-keys.3 + (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) + :allow-other-keys t :also-bad t :key #'not) + (a . 1)) + +(deftest assoc-if.allow-other-keys.4 + (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys t) + (nil . 2)) + +(deftest assoc-if.allow-other-keys.5 + (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys nil) + (nil . 2)) + +(deftest assoc-if.keywords.6 + (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key #'identity :key #'null) + (nil . 2)) + +(deftest assoc-if.keywords.7 + (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key nil :key #'null) + (nil . 2)) + +;;; Error cases + +(deftest assoc-if.error.1 + (classify-error (assoc-if)) + program-error) + +(deftest assoc-if.error.2 + (classify-error (assoc-if #'null)) + program-error) + +(deftest assoc-if.error.3 + (classify-error (assoc-if #'null nil :bad t)) + program-error) + +(deftest assoc-if.error.4 + (classify-error (assoc-if #'null nil :key)) + program-error) + +(deftest assoc-if.error.5 + (classify-error (assoc-if #'null nil 1 1)) + program-error) + +(deftest assoc-if.error.6 + (classify-error (assoc-if #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest assoc-if.error.7 + (classify-error (assoc-if #'cons '((a b)(c d)))) + program-error) + +(deftest assoc-if.error.8 + (classify-error (assoc-if #'identity '((a b)(c d)) :key #'cons)) + program-error) + +(deftest assoc-if.error.9 + (classify-error (assoc-if #'car '((a b)(c d)))) + type-error) + +(deftest assoc-if.error.10 + (classify-error (assoc-if #'identity '((a b)(c d)) :key #'car)) + type-error) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; assoc-if-not + +(deftest assoc-if-not.1 + (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if-not #'oddp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (6 . c)) + +(deftest assoc-if-not.2 + (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if-not #'evenp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (6 . c)) + +(deftest assoc-if-not.3 + (let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if-not #'oddp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (fourth x)) + result)) + (6 . c)) + +(deftest assoc-if-not.4 + (assoc-if-not #'identity '((a . b) nil (c . d) (nil . e) (f . g))) + (nil . e)) + +;;; Order of argument evaluation tests + +(deftest assoc-if-not.order.1 + (let ((i 0) x y) + (values + (assoc-if-not (progn (setf x (incf i)) #'identity) + (progn (setf y (incf i)) + '((a . 1) (b . 2) (nil . 17) (d . 4)))) + i x y)) + (nil . 17) 2 1 2) + +(deftest assoc-if-not.order.2 + (let ((i 0) x y z) + (values + (assoc-if-not (progn (setf x (incf i)) #'identity) + (progn (setf y (incf i)) + '((a . 1) (b . 2) (nil . 17) (d . 4))) + :key (progn (setf z (incf i)) #'null)) + i x y z)) + (a . 1) 3 1 2 3) + +;;; Keyword tests + +(deftest assoc-if-not.allow-other-keys.1 + (assoc-if-not #'identity + '((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t) + (nil . 2)) + +(deftest assoc-if-not.allow-other-keys.2 + (assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) + :allow-other-keys t :also-bad t) + (nil . 2)) + +(deftest assoc-if-not.allow-other-keys.3 + (assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) + :allow-other-keys t :also-bad t :key #'not) + (a . 1)) + +(deftest assoc-if-not.allow-other-keys.4 + (assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) :allow-other-keys t) + (nil . 2)) + +(deftest assoc-if-not.allow-other-keys.5 + (assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) :allow-other-keys nil) + (nil . 2)) + +(deftest assoc-if-not.keywords.6 + (assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) + :key #'identity :key #'null) + (nil . 2)) + +(deftest assoc-if-not.keywords.7 + (assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) :key nil :key #'null) + (nil . 2)) + +;;; Error tests + +(deftest assoc-if-not.error.1 + (classify-error (assoc-if-not)) + program-error) + +(deftest assoc-if-not.error.2 + (classify-error (assoc-if-not #'null)) + program-error) + +(deftest assoc-if-not.error.3 + (classify-error (assoc-if-not #'null nil :bad t)) + program-error) + +(deftest assoc-if-not.error.4 + (classify-error (assoc-if-not #'null nil :key)) + program-error) + +(deftest assoc-if-not.error.5 + (classify-error (assoc-if-not #'null nil 1 1)) + program-error) + +(deftest assoc-if-not.error.6 + (classify-error (assoc-if-not #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest assoc-if-not.error.7 + (classify-error (assoc-if-not #'cons '((a b)(c d)))) + program-error) + +(deftest assoc-if-not.error.8 + (classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'cons)) + program-error) + +(deftest assoc-if-not.error.9 + (classify-error (assoc-if-not #'car '((a b)(c d)))) + type-error) + +(deftest assoc-if-not.error.10 + (classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'car)) + type-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; copy-alist + +(deftest copy-alist-1 + (let* ((x (copy-tree '((a . b) (c . d) nil (e f) ((x) ((y z)) w) + ("foo" . "bar") (#\w . 1.234) + (1/3 . 4123.4d5)))) + (xcopy (make-scaffold-copy x)) + (result (copy-alist x))) + (and + (check-scaffold-copy x xcopy) + (= (length x) (length result)) + (every #'(lambda (p1 p2) + (or (and (null p1) (null p2)) + (and (not (eqt p1 p2)) + (eqt (car p1) (car p2)) + (eqt (cdr p1) (cdr p2))))) + x result) + t)) + t) + +(deftest copy-alist.error.1 + (classify-error (copy-alist)) + program-error) + +(deftest copy-alist.error.2 + (classify-error (copy-alist nil nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; pairlis + +;; Pairlis has two legal behaviors: the pairs +;; can be prepended in the same order, or in the +;; reverse order, that they appear in the first +;; two arguments + +(defun my-pairlis (x y &optional alist) + (if (null x) + alist + (acons (car x) (car y) + (my-pairlis (cdr x) (cdr y) alist)))) + +(deftest pairlis-1 + (pairlis nil nil nil) + nil) + +(deftest pairlis-2 + (pairlis '(a) '(b) nil) + ((a . b))) + +(deftest pairlis-3 + (let* ((x (copy-list '(a b c d e))) + (xcopy (make-scaffold-copy x)) + (y (copy-list '(1 2 3 4 5))) + (ycopy (make-scaffold-copy y)) + (result (pairlis x y)) + (expected (my-pairlis x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + (or + (equal result expected) + (equal result (reverse expected))) + t)) + t) + +(deftest pairlis-4 + (let* ((x (copy-list '(a b c d e))) + (xcopy (make-scaffold-copy x)) + (y (copy-list '(1 2 3 4 5))) + (ycopy (make-scaffold-copy y)) + (z '((x . 10) (y . 20))) + (zcopy (make-scaffold-copy z)) + (result (pairlis x y z)) + (expected (my-pairlis x y z))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + (check-scaffold-copy z zcopy) + (eqt (cdr (cddr (cddr result))) z) + (or + (equal result expected) + (equal result (append (reverse (subseq expected 0 5)) + (subseq expected 5)))) + t)) + t) + +(deftest pairlis.error.1 + (classify-error (pairlis)) + program-error) + +(deftest pairlis.error.2 + (classify-error (pairlis nil)) + program-error) + +(deftest pairlis.error.3 + (classify-error (pairlis nil nil nil nil)) + program-error) diff --git a/ansi-tests/cons-test-17.lsp b/ansi-tests/cons-test-17.lsp new file mode 100644 index 0000000..e1941c6 --- /dev/null +++ b/ansi-tests/cons-test-17.lsp @@ -0,0 +1,559 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 09:45:22 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 17 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +(defun rev-assoc-list (x) + (cond + ((null x) nil) + ((null (car x)) + (cons nil (rev-assoc-list (cdr x)))) + (t + (acons (cdar x) (caar x) (rev-assoc-list (cdr x)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; rassoc + +(deftest rassoc.1 + (rassoc nil nil) + nil) + +(deftest rassoc.2 + (rassoc nil '(nil)) + nil) + +(deftest rassoc.3 + (rassoc nil (rev-assoc-list '(nil (nil . 2) (a . b)))) + (2 . nil)) + +(deftest rassoc.4 + (rassoc nil '((a . b) (c . d))) + nil) + +(deftest rassoc.5 + (rassoc 'a '((b . a))) + (b . a)) + +(deftest rassoc.6 + (rassoc 'a (rev-assoc-list '((:a . b) (#:a . c) (a . d) (a . e) (z . f)))) + (d . a)) + +(deftest rassoc.7 + (let* ((x (copy-tree (rev-assoc-list '((a . b) (b . c) (c . d))))) + (xcopy (make-scaffold-copy x)) + (result (rassoc 'b x))) + (and + (eqt result (second x)) + (check-scaffold-copy x xcopy))) + t) + +(deftest rassoc.8 + (rassoc 1 (rev-assoc-list '((0 . a) (1 . b) (2 . c)))) + (b . 1)) + +(deftest rassoc.9 + (rassoc (copy-seq "abc") + (rev-assoc-list '((abc . 1) ("abc" . 2) ("abc" . 3)))) + nil) + +(deftest rassoc.10 + (rassoc (copy-list '(a)) + (copy-tree (rev-assoc-list '(((a) b) ((a) (c)))))) + nil) + +(deftest rassoc.11 + (let ((x (list 'a 'b))) + (rassoc x + (rev-assoc-list `(((a b) c) (,x . d) (,x . e) ((a b) 1))))) + (d a b)) + + +(deftest rassoc.12 + (rassoc #\e + (copy-tree + (rev-assoc-list '(("abefd" . 1) ("aevgd" . 2) ("edada" . 3)))) + :key #'(lambda (x) (char x 1))) + (2 . "aevgd")) + +(deftest rassoc.13 + (rassoc nil + (copy-tree + (rev-assoc-list + '(((a) . b) ( nil . c ) ((nil) . d)))) + :key #'car) + (c)) + +(deftest rassoc.14 + (rassoc (copy-seq "abc") + (copy-tree + (rev-assoc-list + '((abc . 1) ("abc" . 2) ("abc" . 3)))) + :test #'equal) + (2 . "abc")) + +(deftest rassoc.15 + (rassoc (copy-seq "abc") + (copy-tree + (rev-assoc-list + '((abc . 1) ("abc" . 2) ("abc" . 3)))) + :test #'equalp) + (2 . "abc")) + +(deftest rassoc.16 + (rassoc (copy-list '(a)) + (copy-tree + (rev-assoc-list '(((a) b) ((a) (c))))) + :test #'equal) + ((b) a)) + +(deftest rassoc.17 + (rassoc (copy-seq "abc") + (copy-tree + (rev-assoc-list + '((abc . 1) (a . a) (b . b) ("abc" . 2) ("abc" . 3)))) + :test-not (complement #'equalp)) + (2 . "abc")) + +(deftest rassoc.18 + (rassoc 'a + (copy-tree + (rev-assoc-list + '((a . d)(b . c)))) + :test-not #'eq) + (c . b)) + +(deftest rassoc.19 + (rassoc 'a + (copy-tree + (rev-assoc-list + '((a . d)(b . c)))) + :test (complement #'eq)) + (c . b)) + +(deftest rassoc.20 + (rassoc "a" + (copy-tree + (rev-assoc-list + '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) + :key #'(lambda (x) (and (stringp x) (string-downcase x))) + :test #'equal) + (6 . "A")) + +(deftest rassoc.21 + (rassoc "a" + (copy-tree + (rev-assoc-list + '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) + :key #'(lambda (x) (and (stringp x) x)) + :test #'equal) + (3 . "a")) + +(deftest rassoc.22 + (rassoc "a" + (copy-tree + (rev-assoc-list + '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) + :key #'(lambda (x) (and (stringp x) (string-downcase x))) + :test-not (complement #'equal)) + (6 . "A")) + +(deftest rassoc.23 + (rassoc "a" + (copy-tree + (rev-assoc-list + '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) + :key #'(lambda (x) (and (stringp x) x)) + :test-not (complement #'equal)) + (3 . "a")) + +;; Check that it works when test returns a true value +;; other than T + +(deftest rassoc.24 + (rassoc 'a + (copy-tree + (rev-assoc-list + '((b . 1) (a . 2) (c . 3)))) + :test #'(lambda (x y) (and (eqt x y) 'matched))) + (2 . a)) + +;; Check that the order of the arguments to :test is correct + +(deftest rassoc.25 + (block fail + (rassoc 'a '((1 . b) (2 . c) (3 . a)) + :test #'(lambda (x y) + (unless (eqt x 'a) (return-from fail 'fail)) + (eqt x y)))) + (3 . a)) + +;;; Order of argument evaluation + +(deftest rassoc.order.1 + (let ((i 0) x y) + (values + (rassoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c)))) + i x y)) + (3 . c) 2 1 2) + +(deftest rassoc.order.2 + (let ((i 0) x y z) + (values + (rassoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c))) + :test (progn (setf z (incf i)) #'eql)) + i x y z)) + (3 . c) 3 1 2 3) + +(deftest rassoc.order.3 + (let ((i 0) x y) + (values + (rassoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c))) + :test #'eql) + i x y)) + (3 . c) 2 1 2) + +(deftest rassoc.order.4 + (let ((i 0) x y z w) + (values + (rassoc (progn (setf x (incf i)) 'c) + (progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c))) + :key (progn (setf z (incf i)) #'identity) + :key (progn (setf w (incf i)) #'not)) + i x y z w)) + (3 . c) 4 1 2 3 4) + +;;; Keyword tests + +(deftest rassoc.allow-other-keys.1 + (rassoc 'b '((1 . a) (2 . b) (3 . c)) :bad t :allow-other-keys t) + (2 . b)) + +(deftest rassoc.allow-other-keys.2 + (rassoc 'b '((1 . a) (2 . b) (3 . c)) :allow-other-keys t :bad t) + (2 . b)) + +(deftest rassoc.allow-other-keys.3 + (rassoc 'a '((1 . a) (2 . b) (3 . c)) :allow-other-keys t :bad t + :test-not #'eql) + (2 . b)) + +(deftest rassoc.allow-other-keys.4 + (rassoc 'b '((1 . a) (2 . b) (3 . c)) :allow-other-keys t) + (2 . b)) + +(deftest rassoc.allow-other-keys.5 + (rassoc 'b '((1 . a) (2 . b) (3 . c)) :allow-other-keys nil) + (2 . b)) + +(deftest rassoc.keywords.6 + (rassoc 'b '((1 . a) (2 . b) (3 . c)) + :test #'eql :test (complement #'eql)) + (2 . b)) + +;;; Error tests + +(deftest rassoc.error.1 + (classify-error (rassoc)) + program-error) + +(deftest rassoc.error.2 + (classify-error (rassoc nil)) + program-error) + +(deftest rassoc.error.3 + (classify-error (rassoc nil nil :bad t)) + program-error) + +(deftest rassoc.error.4 + (classify-error (rassoc nil nil :key)) + program-error) + +(deftest rassoc.error.5 + (classify-error (rassoc nil nil 1 1)) + program-error) + +(deftest rassoc.error.6 + (classify-error (rassoc nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest rassoc.error.7 + (classify-error (rassoc 'a '((b . a)(c . d)) :test #'identity)) + program-error) + +(deftest rassoc.error.8 + (classify-error (rassoc 'a '((b . a)(c . d)) :test-not #'identity)) + program-error) + +(deftest rassoc.error.9 + (classify-error (rassoc 'a '((b . a)(c . d)) :key #'cons)) + program-error) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; rassoc-if + +(deftest rassoc-if.1 + (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if #'evenp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (c . 6)) + +(deftest rassoc-if.2 + (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if #'oddp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (c . 6)) + +(deftest rassoc-if.3 + (let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if #'evenp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (fourth x)) + result)) + (c . 6)) + +(deftest rassoc-if.4 + (rassoc-if #'null + (rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g)))) + (e)) + +;;; Order of argument evaluation + +(deftest rassoc-if.order.1 + (let ((i 0) x y) + (values + (rassoc-if (progn (setf x (incf i)) #'null) + (progn (setf y (incf i)) + '((1 . a) (2 . b) (17) (4 . d)))) + i x y)) + (17) 2 1 2) + +(deftest rassoc-if.order.2 + (let ((i 0) x y z) + (values + (rassoc-if (progn (setf x (incf i)) #'null) + (progn (setf y (incf i)) + '((1 . a) (2 . b) (17) (4 . d))) + :key (progn (setf z (incf i)) #'null)) + i x y z)) + (1 . a) 3 1 2 3) + + +;;; Keyword tests + +(deftest rassoc-if.allow-other-keys.1 + (rassoc-if #'null '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t) + (2)) + +(deftest rassoc-if.allow-other-keys.2 + (rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t) + (2)) + +(deftest rassoc-if.allow-other-keys.3 + (rassoc-if #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t + :key 'not) + (2)) + +(deftest rassoc-if.allow-other-keys.4 + (rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t) + (2)) + +(deftest rassoc-if.allow-other-keys.5 + (rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys nil) + (2)) + +(deftest rassoc-if.keywords.6 + (rassoc-if #'identity '((1 . a) (2) (3 . c)) :key #'not :key #'identity) + (2)) + +;;; Error tests + +(deftest rassoc-if.error.1 + (classify-error (rassoc-if)) + program-error) + +(deftest rassoc-if.error.2 + (classify-error (rassoc-if #'null)) + program-error) + +(deftest rassoc-if.error.3 + (classify-error (rassoc-if #'null nil :bad t)) + program-error) + +(deftest rassoc-if.error.4 + (classify-error (rassoc-if #'null nil :key)) + program-error) + +(deftest rassoc-if.error.5 + (classify-error (rassoc-if #'null nil 1 1)) + program-error) + +(deftest rassoc-if.error.6 + (classify-error (rassoc-if #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest rassoc-if.error.7 + (classify-error (rassoc-if #'cons '((a . b)(c . d)))) + program-error) + +(deftest rassoc-if.error.8 + (classify-error (rassoc-if #'car '((a . b)(c . d)))) + type-error) + +(deftest rassoc-if.error.9 + (classify-error (rassoc-if #'identity '((a . b)(c . d)) :key #'cons)) + program-error) + +(deftest rassoc-if.error.10 + (classify-error (rassoc-if #'identity '((a . b)(c . d)) :key #'car)) + type-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; rassoc-if-not + +(deftest rassoc-if-not.1 + (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if-not #'oddp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (c . 6)) + +(deftest rassoc-if-not.2 + (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if-not #'evenp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) + (c . 6)) + +(deftest rassoc-if-not.3 + (let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if-not #'oddp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (fourth x)) + result)) + (c . 6)) + +(deftest rassoc-if-not.4 + (rassoc-if-not #'identity + (rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g)))) + (e)) + +;;; Order of argument evaluation + +(deftest rassoc-if-not.order.1 + (let ((i 0) x y) + (values + (rassoc-if-not (progn (setf x (incf i)) #'identity) + (progn (setf y (incf i)) + '((1 . a) (2 . b) (17) (4 . d)))) + i x y)) + (17) 2 1 2) + +(deftest rassoc-if-not.order.2 + (let ((i 0) x y z) + (values + (rassoc-if-not (progn (setf x (incf i)) #'identity) + (progn (setf y (incf i)) + '((1 . a) (2 . b) (17) (4 . d))) + :key (progn (setf z (incf i)) #'null)) + i x y z)) + (1 . a) 3 1 2 3) + +;;; Keyword tests + +(deftest rassoc-if-not.allow-other-keys.1 + (rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t) + (2)) + +(deftest rassoc-if-not.allow-other-keys.2 + (rassoc-if-not #'values '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t) + (2)) + +(deftest rassoc-if-not.allow-other-keys.3 + (rassoc-if-not #'not '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t + :key 'not) + (2)) + +(deftest rassoc-if-not.allow-other-keys.4 + (rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t) + (2)) + +(deftest rassoc-if-not.allow-other-keys.5 + (rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :allow-other-keys nil) + (2)) + +(deftest rassoc-if-not.allow-other-keys.6 + (rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t + :allow-other-keys nil :bad t) + (2)) + +(deftest rassoc-if-not.keywords.7 + (rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :key #'not :key nil) + (1 . a)) + +;;; Error tests + +(deftest rassoc-if-not.error.1 + (classify-error (rassoc-if-not)) + program-error) + +(deftest rassoc-if-not.error.2 + (classify-error (rassoc-if-not #'null)) + program-error) + +(deftest rassoc-if-not.error.3 + (classify-error (rassoc-if-not #'null nil :bad t)) + program-error) + +(deftest rassoc-if-not.error.4 + (classify-error (rassoc-if-not #'null nil :key)) + program-error) + +(deftest rassoc-if-not.error.5 + (classify-error (rassoc-if-not #'null nil 1 1)) + program-error) + +(deftest rassoc-if-not.error.6 + (classify-error (rassoc-if-not #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest rassoc-if-not.error.7 + (classify-error (rassoc-if-not #'cons '((a . b)(c . d)))) + program-error) + +(deftest rassoc-if-not.error.8 + (classify-error (rassoc-if-not #'car '((a . b)(c . d)))) + type-error) + +(deftest rassoc-if-not.error.9 + (classify-error (rassoc-if-not #'identity '((a . b)(c . d)) :key #'cons)) + program-error) + +(deftest rassoc-if-not.error.10 + (classify-error (rassoc-if-not #'identity '((a . b)(c . d)) :key #'car)) + type-error) diff --git a/ansi-tests/cons-test-18.lsp b/ansi-tests/cons-test-18.lsp new file mode 100644 index 0000000..679ca9d --- /dev/null +++ b/ansi-tests/cons-test-18.lsp @@ -0,0 +1,338 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 10:23:31 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 18 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; get-properties + +(deftest get-properties.1 + (get-properties nil nil) + nil nil nil) + +(deftest get-properties.2 + (get-properties '(a b) nil) + nil nil nil) + +(deftest get-properties.3 + (get-properties '(a b c d) '(a)) + a b (a b c d)) + +(deftest get-properties.4 + (get-properties '(a b c d) '(c)) + c d (c d)) + +(deftest get-properties.5 + (get-properties '(a b c d) '(c a)) + a b (a b c d)) + +(deftest get-properties.6 + (get-properties '(a b c d) '(b)) + nil nil nil) + +(deftest get-properties.7 + (get-properties '("aa" b c d) (list (copy-seq "aa"))) + nil nil nil) + +(deftest get-properties.8 + (get-properties '(1000000000000 b c d) (list (1+ 999999999999))) + nil nil nil) + +(deftest get-properties.9 + (let* ((x (copy-list '(a b c d e f g h a c))) + (xcopy (make-scaffold-copy x)) + (y (copy-list '(x y f g))) + (ycopy (make-scaffold-copy y))) + (multiple-value-bind + (indicator value tail) + (get-properties x y) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + (eqt tail (nthcdr 6 x)) + (values indicator value tail)))) + g h (g h a c)) + +(deftest get-properties.order.1 + (let ((i 0) x y) + (values + (multiple-value-list + (get-properties (progn (setf x (incf i)) '(a b c d)) + (progn (setf y (incf i)) '(c)))) + i x y)) + (c d (c d)) 2 1 2) + +(deftest get-properties.error.1 + (classify-error (get-properties)) + program-error) + +(deftest get-properties.error.2 + (classify-error (get-properties nil)) + program-error) + +(deftest get-properties.error.3 + (classify-error (get-properties nil nil nil)) + program-error) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; getf + +(deftest getf.1 + (getf nil 'a) + nil) + +(deftest getf.2 + (getf nil 'a 'b) + b) + +(deftest getf.3 + (getf '(a b) 'a) + b) + +(deftest getf.4 + (getf '(a b) 'a 'c) + b) + +(deftest getf.5 + (let ((x 0)) + (values + (getf '(a b) 'a (incf x)) + x)) + b 1) + +(deftest getf.order.1 + (let ((i 0) x y) + (values + (getf (progn (setf x (incf i)) '(a b)) + (progn (setf y (incf i)) 'a)) + i x y)) + b 2 1 2) + +(deftest getf.order.2 + (let ((i 0) x y z) + (values + (getf (progn (setf x (incf i)) '(a b)) + (progn (setf y (incf i)) 'a) + (setf z (incf i))) + i x y z)) + b 3 1 2 3) + +(deftest setf-getf.1 + (let ((p (copy-list '(a 1 b 2)))) + (setf (getf p 'c) 3) + ;; Must check that only a, b, c have properties + (and + (eqlt (getf p 'a) 1) + (eqlt (getf p 'b) 2) + (eqlt (getf p 'c) 3) + (eqlt + (loop + for ptr on p by #'cddr count + (not (member (car ptr) '(a b c)))) + 0) + t)) + t) + +(deftest setf-getf.2 + (let ((p (copy-list '(a 1 b 2)))) + (setf (getf p 'a) 3) + ;; Must check that only a, b have properties + (and + (eqlt (getf p 'a) 3) + (eqlt (getf p 'b) 2) + (eqlt + (loop + for ptr on p by #'cddr count + (not (member (car ptr) '(a b)))) + 0) + t)) + t) + +(deftest setf-getf.3 + (let ((p (copy-list '(a 1 b 2)))) + (setf (getf p 'c 17) 3) + ;; Must check that only a, b, c have properties + (and + (eqlt (getf p 'a) 1) + (eqlt (getf p 'b) 2) + (eqlt (getf p 'c) 3) + (eqlt + (loop + for ptr on p by #'cddr count + (not (member (car ptr) '(a b c)))) + 0) + t)) + t) + +(deftest setf-getf.4 + (let ((p (copy-list '(a 1 b 2)))) + (setf (getf p 'a 17) 3) + ;; Must check that only a, b have properties + (and + (eqlt (getf p 'a) 3) + (eqlt (getf p 'b) 2) + (eqlt + (loop + for ptr on p by #'cddr count + (not (member (car ptr) '(a b)))) + 0) + t)) + t) + +(deftest setf-getf.5 + (let ((p (copy-list '(a 1 b 2))) + (foo nil)) + (setf (getf p 'a (progn (setf foo t) 0)) 3) + ;; Must check that only a, b have properties + (and + (eqlt (getf p 'a) 3) + (eqlt (getf p 'b) 2) + (eqlt + (loop + for ptr on p by #'cddr count + (not (member (car ptr) '(a b)))) + 0) + foo)) + t) + +(deftest setf-getf.order.1 + (let ((p (list (copy-list '(a 1 b 2)))) + (cnt1 0) (cnt2 0) (cnt3 0)) + (setf (getf (car (progn (incf cnt1) p)) 'c (incf cnt3)) + (progn (incf cnt2) 3)) + ;; Must check that only a, b, c have properties + (and + (eqlt cnt1 1) + (eqlt cnt2 1) + (eqlt cnt3 1) + (eqlt (getf (car p) 'a) 1) + (eqlt (getf (car p) 'b) 2) + (eqlt (getf (car p) 'c) 3) + (eqlt + (loop + for ptr on (car p) by #'cddr count + (not (member (car ptr) '(a b c)))) + 0) + t)) + t) + +(deftest setf-getf.order.2 + (let ((p (list (copy-list '(a 1 b 2)))) + (i 0) x y z w) + (setf (getf (car (progn (setf x (incf i)) p)) + (progn (setf y (incf i)) 'c) + (setf z (incf i))) + (progn (setf w (incf i)) 3)) + ;; Must check that only a, b, c have properties + (and + (eqlt i 4) + (eqlt x 1) + (eqlt y 2) + (eqlt z 3) + (eqlt w 4) + (eqlt (getf (car p) 'a) 1) + (eqlt (getf (car p) 'b) 2) + (eqlt (getf (car p) 'c) 3) + (eqlt + (loop + for ptr on (car p) by #'cddr count + (not (member (car ptr) '(a b c)))) + 0) + t)) + t) + +(deftest incf-getf.1 + (let ((p (copy-list '(a 1 b 2)))) + (incf (getf p 'b)) + ;; Must check that only a, b have properties + (and + (eqlt (getf p 'a) 1) + (eqlt (getf p 'b) 3) + (eqlt + (loop + for ptr on p by #'cddr count + (not (member (car ptr) '(a b)))) + 0) + t)) + t) + +(deftest incf-getf.2 + (let ((p (copy-list '(a 1 b 2)))) + (incf (getf p 'c 19)) + ;; Must check that only a, b have properties + (and + (eqlt (getf p 'a) 1) + (eqlt (getf p 'b) 2) + (eqlt (getf p 'c) 20) + (eqlt + (loop + for ptr on p by #'cddr count + (not (member (car ptr) '(a b c)))) + 0) + t)) + t) + +(deftest push-getf.1 + (let ((p nil)) + (values + (push 'x (getf p 'a)) + p)) + (x) (a (x))) + +(deftest getf.error.1 + (classify-error (getf)) + program-error) + +(deftest getf.error.2 + (classify-error (getf nil)) + program-error) + +(deftest getf.error.3 + (classify-error (getf nil nil nil nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; remf + +(deftest remf.1 + (let ((x nil)) + (values (remf x 'a) x)) + nil ()) + +(deftest remf.2 + (let ((x (list 'a 'b))) + (values (not (null (remf x 'a))) x)) + t ()) + +(deftest remf.3 + (let ((x (list 'a 'b 'a 'c))) + (values (not (null (remf x 'a))) x)) + t (a c)) + +(deftest remf.4 + (let ((x (list 'a 'b 'c 'd))) + (values + (and (remf x 'c) t) + (loop + for ptr on x by #'cddr count + (not (eqt (car ptr) 'a))))) + t 0) + +(deftest remf.order.1 + (let ((i 0) x y + (p (make-array 1 :initial-element (copy-list '(a b c d e f))))) + (values + (notnot + (remf (aref p (progn (setf x (incf i)) 0)) + (progn (setf y (incf i)) + 'c))) + (aref p 0) + i x y)) + t (a b e f) 2 1 2) + + \ No newline at end of file diff --git a/ansi-tests/cons-test-19.lsp b/ansi-tests/cons-test-19.lsp new file mode 100644 index 0000000..1214a72 --- /dev/null +++ b/ansi-tests/cons-test-19.lsp @@ -0,0 +1,738 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 11:53:33 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 19 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; intersection + +(deftest intersection.1 + (intersection nil nil) + nil) + +(deftest intersection.2 + (intersection (loop for i from 1 to 100 collect i) nil) + nil) + +(deftest intersection.3 + (intersection nil (loop for i from 1 to 100 collect i)) + nil) + +(deftest intersection.4 + (let* ((x (copy-list '(a 1 c 7 b 4 3 z))) + (xcopy (make-scaffold-copy x)) + (y (copy-list '(3 y c q z a 18))) + (ycopy (make-scaffold-copy y)) + (result (intersection x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + (+ + (loop + for e in x count + (and (member e y) + (not (member e result)))) + (loop + for e in result count + (or (not (member e x)) + (not (member e y)))) + (loop + for hd on result count + (and (consp hd) + (member (car hd) (cdr hd))))))) + 0) + +(deftest intersection.5 + (let* ((x (copy-list '(a a a))) + (xcopy (make-scaffold-copy x)) + (y (copy-list '(a a a b b b))) + (ycopy (make-scaffold-copy y)) + (result (intersection x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + (member 'a result) + (not (member 'b result)))) + t) + +(deftest intersection.6 + (intersection (list 1000000000000 'a 'b 'c) + (list (1+ 999999999999) 'd 'e 'f)) + (1000000000000)) + +(deftest intersection.7 + (intersection (list 'a 10 'b 17) + (list 'c 'd 4 'e 'f 10 1 13 'z)) + (10)) + +(deftest intersection.8 + (intersection (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e)) + nil) + +(deftest intersection.9 + (intersection (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e) + :test #'equal) + ("aaa")) + +;; Same as 9, but with a symbol function designator for :test +(deftest intersection.9-a + (intersection (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e) + :test 'equal) + ("aaa")) + +(deftest intersection.9-b + (intersection (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e) + :test-not #'(lambda (p q) (not (equal p q)))) + ("aaa")) + +(deftest intersection.10 + (equalt + (sort + (intersection (loop + for i from 0 to 1000 by 3 + collect i) + (loop + for i from 0 to 1000 by 7 + collect i)) + #'<) + (loop for i from 0 to 1000 by 21 collect i)) + t) + +(deftest intersection.11 + (equalt + (sort + (intersection (loop + for i from 0 to 999 by 5 + collect i) + (loop + for i from 0 to 999 by 7 + collect i) + :test #'(lambda (a b) + (and (eql a b) + (= (mod a 3) 0)))) + #'<) + (loop for i from 0 to 999 by (* 3 5 7) collect i)) + t) + +(deftest intersection.11-a + (equalt + (sort + (intersection (loop + for i from 0 to 999 by 5 + collect i) + (loop + for i from 0 to 999 by 7 + collect i) + :test-not + #'(lambda (a b) + (not (and (eql a b) + (= (mod a 3) 0))))) + #'<) + (loop for i from 0 to 999 by (* 3 5 7) collect i)) + t) + +;; +;; Do large numbers of random intersection tests +;; + +(deftest intersection.12 + (intersection-12-body 100 100) + nil) + + +;; +;; :key argument +;; + +(deftest intersection.13 + (let ((x (copy-list '(0 5 8 13 31 42))) + (y (copy-list '(3 5 42 0 7 100 312 33)))) + (equalt + (sort (copy-list (intersection x y)) #'<) + (sort (copy-list (intersection x y :key #'1+)) #'<))) + t) + +;; Same as 13, but with a symbol function designator for :key +(deftest intersection.13-a + (let ((x (copy-list '(0 5 8 13 31 42))) + (y (copy-list '(3 5 42 0 7 100 312 33)))) + (equalt + (sort (copy-list (intersection x y)) #'<) + (sort (copy-list (intersection x y :key '1+)) #'<))) + t) + +;; Test that a nil key argument is ignored + +(deftest intersection.14 + (let + ((result (intersection (copy-list '(a b c d)) + (copy-list '(e c f b g)) + :key nil))) + (and + (member 'b result) + (member 'c result) + (every #'(lambda (x) (member x '(b c))) result) + t)) + t) + +;; Test that intersection preserves the order of arguments to :test, :test-not + +(deftest intersection.15 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (intersection + list1 list2 + :test + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))))) + (4)) + +(deftest intersection.16 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (intersection + list1 list2 + :key #'identity + :test + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))))) + (4)) + +(deftest intersection.17 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (intersection + list1 list2 + :test-not + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))))) + (4)) + +(deftest intersection.18 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (intersection + list1 list2 + :key #'identity + :test-not + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))))) + (4)) + +;;; Order of argument evaluation tests + +(deftest intersection.order.1 + (let ((i 0) x y) + (values + (intersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd))) + i x y)) + nil 2 1 2) + +(deftest intersection.order.2 + (let ((i 0) x y) + (values + (intersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :test #'eq) + i x y)) + nil 2 1 2) + +(deftest intersection.order.3 + (let ((i 0) x y z w) + (values + (intersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :test (progn (setf z (incf i)) #'eq) + :test (progn (setf w (incf i)) + (complement #'eq))) + i x y z w)) + nil 4 1 2 3 4) + +(deftest intersection.order.4 + (let ((i 0) x y z w) + (values + (intersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :test (progn (setf z (incf i)) #'eq) + :key (progn (setf w (incf i)) #'identity)) + i x y z w)) + nil 4 1 2 3 4) + +(deftest intersection.order.5 + (let ((i 0) x y z w) + (values + (intersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :key (progn (setf z (incf i)) #'identity) + :test (progn (setf w (incf i)) #'eq)) + i x y z w)) + nil 4 1 2 3 4) + + +;;; Keyword tests + +(deftest intersection.allow-other-keys.1 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 :bad t :allow-other-keys 1)) + (4)) + +(deftest intersection.allow-other-keys.2 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 :allow-other-keys :foo :also-bad t)) + (4)) + +(deftest intersectionallow-other-keys.3 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 :allow-other-keys :foo :also-bad t + :test #'(lambda (x y) (= x (1+ y))))) + nil) + +(deftest intersection.allow-other-keys.4 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 :allow-other-keys t)) + (4)) + +(deftest intersection.allow-other-keys.5 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 :allow-other-keys nil)) + (4)) + +(deftest intersection.allow-other-keys.6 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 :allow-other-keys t + :allow-other-keys nil :bad t)) + (4)) + +(deftest intersection.allow-other-keys.7 + (sort + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 :allow-other-keys t + :allow-other-keys nil + :test #'(lambda (x y) (eql x (1- y))))) + #'<) + (3 4)) + +(deftest intersection.keywords.8 + (sort + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (intersection list1 list2 + :test #'(lambda (x y) (eql x (1- y))) + :test #'eql)) + #'<) + (3 4)) + +;;; Error tests + +(deftest intersection.error.1 + (classify-error (intersection)) + program-error) + +(deftest intersection.error.2 + (classify-error (intersection nil)) + program-error) + +(deftest intersection.error.3 + (classify-error (intersection nil nil :bad t)) + program-error) + +(deftest intersection.error.4 + (classify-error (intersection nil nil :key)) + program-error) + +(deftest intersection.error.5 + (classify-error (intersection nil nil 1 2)) + program-error) + +(deftest intersection.error.6 + (classify-error (intersection nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest intersection.error.7 + (classify-error (intersection '(a b c) '(d e f) :test #'identity)) + program-error) + +(deftest intersection.error.8 + (classify-error (intersection '(a b c) '(d e f) :test-not #'identity)) + program-error) + +(deftest intersection.error.9 + (classify-error (intersection '(a b c) '(d e f) :key #'cons)) + program-error) + +(deftest intersection.error.10 + (classify-error (intersection '(a b c) '(d e f) :key #'car)) + type-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nintersection + +(deftest nintersection.1 + (nintersection nil nil) + nil) + +(deftest nintersection.2 + (nintersection (loop for i from 1 to 100 collect i) nil) + nil) + +(deftest nintersection.3 + (nintersection-with-check nil (loop for i from 1 to 100 collect i)) + nil) + +(deftest nintersection.4 + (let* ((x (copy-list '(a 1 c 7 b 4 3 z))) + (xc (copy-list x)) + (y (copy-list '(3 y c q z a 18))) + (result (nintersection-with-check xc y))) + (and + (not (eqt result 'failed)) + (+ + (loop for e in x count + (and (member e y) + (not (member e result)))) + (loop for e in result count + (or (not (member e x)) (not (member e y)))) + (loop for hd on result count + (and (consp hd) + (member (car hd) (cdr hd))))))) + 0) + +(deftest nintersection.5 + (let* ((x (copy-list '(a a a))) + (y (copy-list '(a a a b b b))) + (result (nintersection-with-check x y))) + (and + (not (eqt result 'failed)) + (member 'a result) + (not (member 'b result)))) + t) + +(deftest nintersection.6 + (nintersection-with-check + (list 1000000000000 'a 'b 'c) + (list (1+ 999999999999) 'd 'e 'f)) + (1000000000000)) + +(deftest nintersection.7 + (nintersection-with-check (list 'a 10 'b 17) + (list 'c 'd 4 'e 'f 10 1 13 'z)) + (10)) + +(deftest nintersection.8 + (nintersection-with-check + (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e)) + nil) + +(deftest nintersection.9 + (nintersection-with-check + (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e) + :test #'equal) + ("aaa")) + +(deftest nintersection.9-a + (nintersection-with-check + (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e) + :test 'equal) + ("aaa")) + +(deftest nintersection.9-b + (nintersection + (list 'a (copy-seq "aaa") 'b) + (list 'd (copy-seq "aaa") 'e) + :test-not #'(lambda (p q) (not (equal p q)))) + ("aaa")) + +(deftest nintersection.10 + (equalt + (sort + (let ((result + (nintersection-with-check + (loop for i from 0 to 1000 by 3 collect i) + (loop for i from 0 to 1000 by 7 collect i)))) + (if (eqt result 'failed) () result)) + #'<) + (loop for i from 0 to 1000 by 21 collect i)) + t) + +(deftest nintersection.11 + (equalt + (sort + (let ((result + (nintersection-with-check + (loop for i from 0 to 999 by 5 collect i) + (loop for i from 0 to 999 by 7 collect i) + :test #'(lambda (a b) + (and (eql a b) + (= (mod a 3) 0)))))) + (if (eqt result 'failed) () result)) + #'<) + (loop + for i from 0 to 999 by (* 3 5 7) collect i)) + t) + +(deftest nintersection.12 + (nintersection-12-body 100 100) + nil) + +;; Key argument + +(deftest nintersection.13 + (let ((x '(0 5 8 13 31 42)) + (y (copy-list '(3 5 42 0 7 100 312 33)))) + (equalt + (sort (copy-list (nintersection + (copy-list x) y)) #'<) + (sort (copy-list (nintersection + (copy-list x) y :key #'1+)) #'<))) + t) + +;; Check that a nil key argument is ignored + +(deftest nintersection.14 + (let + ((result (nintersection + (copy-list '(a b c d)) + (copy-list '(e c f b g)) + :key nil))) + (and + (member 'b result) + (member 'c result) + (every #'(lambda (x) (member x '(b c))) result) + t)) + t) + +;; Test that nintersection preserves the order of arguments to :test, :test-not + +(deftest nintersection.15 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (nintersection + list1 list2 + :test + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))))) + (4)) + +(deftest nintersection.16 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (nintersection + list1 list2 + :key #'identity + :test + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))))) + (4)) + +(deftest nintersection.17 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (nintersection + list1 list2 + :test-not + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))))) + (4)) + +(deftest nintersection.18 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (block fail + (nintersection + list1 list2 + :key #'identity + :test-not + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))))) + (4)) + +;;; Order of argument evaluation tests + +(deftest nintersection.order.1 + (let ((i 0) x y) + (values + (nintersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd))) + i x y)) + nil 2 1 2) + +(deftest nintersection.order.2 + (let ((i 0) x y) + (values + (nintersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :test #'eq) + i x y)) + nil 2 1 2) + +(deftest nintersection.order.3 + (let ((i 0) x y z w) + (values + (nintersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :test (progn (setf z (incf i)) #'eq) + :test (progn (setf w (incf i)) + (complement #'eq))) + i x y z w)) + nil 4 1 2 3 4) + +(deftest nintersection.order.4 + (let ((i 0) x y z w) + (values + (nintersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :test (progn (setf z (incf i)) #'eq) + :key (progn (setf w (incf i)) #'identity)) + i x y z w)) + nil 4 1 2 3 4) + +(deftest nintersection.order.5 + (let ((i 0) x y z w) + (values + (nintersection (progn (setf x (incf i)) (list 'a 'b)) + (progn (setf y (incf i)) (list 'c 'd)) + :key (progn (setf z (incf i)) #'identity) + :test (progn (setf w (incf i)) #'eq)) + i x y z w)) + nil 4 1 2 3 4) + +;;; Keyword tests + +(deftest nintersection.allow-other-keys.1 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :bad t :allow-other-keys 1)) + (4)) + +(deftest nintersection.allow-other-keys.2 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :allow-other-keys :foo :also-bad t)) + (4)) + +(deftest nintersection.allow-other-keys.3 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :allow-other-keys :foo :also-bad t + :test #'(lambda (x y) (= x (1+ y))))) + nil) + +(deftest nintersection.allow-other-keys.4 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :allow-other-keys t)) + (4)) + +(deftest nintersection.allow-other-keys.5 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :allow-other-keys nil)) + (4)) + +(deftest nintersection.allow-other-keys.6 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :allow-other-keys t + :allow-other-keys nil :bad t)) + (4)) + +(deftest nintersection.allow-other-keys.7 + (sort + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :allow-other-keys t + :allow-other-keys nil + :test #'(lambda (x y) (eql x (1- y))))) + #'<) + (3 4)) + +(deftest nintersection.keywords.8 + (sort + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 + :test #'(lambda (x y) (eql x (1- y))) + :test #'eql)) + #'<) + (3 4)) + +(deftest nintersection.allow-other-keys.9 + (let ((list1 (list 1 2 3 4)) + (list2 (list 4 5 6 7))) + (nintersection list1 list2 :allow-other-keys :foo :also-bad t + :test #'(lambda (x y) (= x (1+ y))))) + nil) + +(deftest nintersection.error.1 + (classify-error (nintersection)) + program-error) + +(deftest nintersection.error.2 + (classify-error (nintersection nil)) + program-error) + +(deftest nintersection.error.3 + (classify-error (nintersection nil nil :bad t)) + program-error) + +(deftest nintersection.error.4 + (classify-error (nintersection nil nil :key)) + program-error) + +(deftest nintersection.error.5 + (classify-error (nintersection nil nil 1 2)) + program-error) + +(deftest nintersection.error.6 + (classify-error (nintersection nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest nintersection.error.7 + (classify-error (nintersection (list 1 2 3) (list 4 5 6) :test #'identity)) + program-error) + +(deftest nintersection.error.8 + (classify-error (nintersection (list 1 2 3) (list 4 5 6) :test-not #'identity)) + program-error) + +(deftest nintersection.error.9 + (classify-error (nintersection (list 1 2 3) (list 4 5 6) :key #'cons)) + program-error) + +(deftest nintersection.error.10 + (classify-error (nintersection (list 1 2 3) (list 4 5 6) :key #'car)) + type-error) diff --git a/ansi-tests/cons-test-20.lsp b/ansi-tests/cons-test-20.lsp new file mode 100644 index 0000000..6fc53be --- /dev/null +++ b/ansi-tests/cons-test-20.lsp @@ -0,0 +1,404 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 22:11:27 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 20 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; union + +(deftest union.1 + (union nil nil) + nil) + +(deftest union.2 + (union-with-check (list 'a) nil) + (a)) + +(deftest union.3 + (union-with-check (list 'a) (list 'a)) + (a)) + +(deftest union-4 + (union-with-check (list 1) (list 1)) + (1)) + +(deftest union.5 + (let ((x (list 'a 'b))) + (union-with-check (list x) (list x))) + ((a b))) + +(deftest union.6 + (let ((x (copy-list '(a b c d e f))) + (y (copy-list '(z c y a v b)))) + (let ((result (union-with-check x y))) + (check-union x y result))) + t) + +(deftest union.6-a + (let ((x (copy-list '(a b c d e f))) + (y (copy-list '(z c y a v b)))) + (let ((result (union-with-check x y :test #'eq))) + (check-union x y result))) + t) + +(deftest union.7 + (let ((x (copy-list '(a b c d e f))) + (y (copy-list '(z c y a v b)))) + (let ((result (union-with-check x y :test #'eql))) + (check-union x y result))) + t) + +(deftest union.8 + (let ((x (copy-list '(a b c d e f))) + (y (copy-list '(z c y a v b)))) + (let ((result (union-with-check x y :test #'equal))) + (check-union x y result))) + t) + +(deftest union.9 + (let ((x (copy-list '(a b c d e f))) + (y (copy-list '(z c y a v b)))) + (let ((result (union-with-check x y :test-not (complement #'eql)))) + (check-union x y result))) + t) + +(deftest union.10 + (let ((x (copy-list '(a b c d e f))) + (y (copy-list '(z c y a v b)))) + (let ((result (union-with-check x y :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest union.11 + (let ((x (copy-list '(a b c d e f))) + (y (copy-list '(z c y a v b)))) + (let ((result (union-with-check x y :test-not (complement #'eq)))) + (check-union x y result))) + t) + +(deftest union.12 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check x y))) + (check-union x y result))) + t) + +(deftest union.13 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check x y :test #'equal))) + (check-union x y result))) + t) + +(deftest union.14 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check x y :test #'eql))) + (check-union x y result))) + t) + +(deftest union.15 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check x y :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest union.16 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check x y :test-not (complement #'eql)))) + (check-union x y result))) + t) + +(deftest union.17 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y #'1+))) + (check-union x y result))) + t) + +(deftest union.18 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y #'1+ :test #'equal))) + (check-union x y result))) + t) + +(deftest union.19 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y #'1+ :test #'eql))) + (check-union x y result))) + t) + +(deftest union.20 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y #'1+ + :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest union.21 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y #'1+ + :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest union.22 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y nil))) + (check-union x y result))) + t) + +(deftest union.23 + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y '1+))) + (check-union x y result))) + t) + +;; Do large numbers of random units + +(deftest union.24 + (do-random-unions 100 100 200) + nil) + +(deftest union.25 + (let ((x (shuffle '(1 4 6 10 45 101))) + (y (copy-list '(102 5 2 11 44 6)))) + (let ((result (union-with-check x y + :test #'(lambda (a b) + (<= (abs (- a b)) 1))))) + (and + (not (eqt result 'failed)) + (sort + (sublis + '((2 . 1) (5 . 4) (11 . 10) (45 . 44) (102 . 101)) + (copy-list result)) + #'<)))) + (1 4 6 10 44 101)) + +;;; Check that union uses eql, not equal or eq + +(deftest union.26 + (let ((x 1000) + (y 1000)) + (loop + while (not (typep x 'bignum)) + do (progn + (setf x (* x x)) + (setf y (* y y)))) + (notnot-mv + (or + (eqt x y) ;; if bignums are eq, the test is worthless + (eql (length + (union-with-check + (list x) (list x))) + 1)))) + t) + +(deftest union.27 + (union-with-check (list (copy-seq "aa")) + (list (copy-seq "aa"))) + ("aa" "aa")) + +;; Check that union does not reverse the arguments to :test, :test-not + +(deftest union.28 + (block fail + (sort + (union-with-check + (list 1 2 3) + (list 4 5 6) + :test #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))) + #'<)) + (1 2 3 4 5 6)) + +(deftest union.29 + (block fail + (sort + (union-with-check-and-key + (list 1 2 3) + (list 4 5 6) + #'identity + :test #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))) + #'<)) + (1 2 3 4 5 6)) + +(deftest union.30 + (block fail + (sort + (union-with-check + (list 1 2 3) + (list 4 5 6) + :test-not + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))) + #'<)) + (1 2 3 4 5 6)) + +(deftest union.31 + (block fail + (sort + (union-with-check-and-key + (list 1 2 3) + (list 4 5 6) + #'identity + :test-not #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))) + #'<)) + (1 2 3 4 5 6)) + +;;; Order of evaluation tests + +(deftest union.order.1 + (let ((i 0) x y) + (values + (sort + (union (progn (setf x (incf i)) (copy-list '(1 3 5))) + (progn (setf y (incf i)) (copy-list '(2 5 8)))) + #'<) + i x y)) + (1 2 3 5 8) + 2 1 2) + +(deftest union.order.2 + (let ((i 0) x y z w) + (values + (sort + (union (progn (setf x (incf i)) (copy-list '(1 3 5))) + (progn (setf y (incf i)) (copy-list '(2 5 8))) + :test (progn (setf z (incf i)) #'eql) + :key (progn (setf w (incf i)) #'identity)) + #'<) + i x y z w)) + (1 2 3 5 8) + 4 1 2 3 4) + + +(deftest union.order.3 + (let ((i 0) x y z w) + (values + (sort + (union (progn (setf x (incf i)) (copy-list '(1 3 5))) + (progn (setf y (incf i)) (copy-list '(2 5 8))) + :key (progn (setf z (incf i)) #'identity) + :test (progn (setf w (incf i)) #'eql)) + #'<) + i x y z w)) + (1 2 3 5 8) + 4 1 2 3 4) + +;;; Keyword tests + +(deftest union.allow-other-keys.1 + (sort (union (list 7 9 1 5) (list 10 11 9 20 1 2) :bad t + :allow-other-keys "yes") + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest union.allow-other-keys.2 + (sort (union (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t :also-bad t) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest union.allow-other-keys.3 + (sort (union (list 1 2 3) (list 1 2 3) + :allow-other-keys t :also-bad t + :test #'(lambda (x y) (= x (+ y 100)))) + #'<) + (1 1 2 2 3 3)) + +(deftest union.allow-other-keys.4 + (sort (union (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest union.allow-other-keys.5 + (sort (union (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys nil) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest union.allow-other-keys.6 + (sort (union (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t + :allow-other-keys nil) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest union.allow-other-keys.7 + (sort (union (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t + :allow-other-keys nil + '#:x 1) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest union.keywords.9 + (sort (union (list 1 2 3) (list 1 2 3) + :test #'(lambda (x y) (= x (+ y 100))) + :test #'eql) + #'<) + (1 1 2 2 3 3)) + +;;; Error tests + +(deftest union.error.1 + (classify-error (union)) + program-error) + +(deftest union.error.2 + (classify-error (union nil)) + program-error) + +(deftest union.error.3 + (classify-error (union nil nil :bad t)) + program-error) + +(deftest union.error.4 + (classify-error (union nil nil :key)) + program-error) + +(deftest union.error.5 + (classify-error (union nil nil 1 2)) + program-error) + +(deftest union.error.6 + (classify-error (union nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest union.error.7 + (classify-error (union (list 1 2) (list 3 4) :test #'identity)) + program-error) + +(deftest union.error.8 + (classify-error (union (list 1 2) (list 3 4) :test-not #'identity)) + program-error) + +(deftest union.error.9 + (classify-error (union (list 1 2) (list 3 4) :key #'cons)) + program-error) + +(deftest union.error.10 + (classify-error (union (list 1 2) (list 3 4) :key #'car)) + type-error) + + diff --git a/ansi-tests/cons-test-21.lsp b/ansi-tests/cons-test-21.lsp new file mode 100644 index 0000000..9457df0 --- /dev/null +++ b/ansi-tests/cons-test-21.lsp @@ -0,0 +1,402 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 28 22:11:27 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 21 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nunion + +(deftest nunion.1 + (nunion nil nil) + nil) + +(deftest nunion.2 + (nunion-with-copy (list 'a) nil) + (a)) + +(deftest nunion.3 + (nunion-with-copy (list 'a) (list 'a)) + (a)) + +(deftest nunion.4 + (nunion-with-copy (list 1) (list 1)) + (1)) + +(deftest nunion.5 + (let ((x (list 'a 'b))) + (nunion-with-copy (list x) (list x))) + ((a b))) + +(deftest nunion.6 + (let ((x '(a b c d e f)) + (y '(z c y a v b))) + (let ((result (nunion-with-copy x y))) + (check-union x y result))) + t) + +(deftest nunion.6-a + (let ((x '(a b c d e f)) + (y '(z c y a v b))) + (let ((result (nunion-with-copy x y :test #'eq))) + (check-union x y result))) + t) + +(deftest nunion.7 + (let ((x '(a b c d e f)) + (y '(z c y a v b))) + (let ((result (nunion-with-copy x y :test #'eql))) + (check-union x y result))) + t) + +(deftest nunion.8 + (let ((x '(a b c d e f)) + (y '(z c y a v b))) + (let ((result (nunion-with-copy x y :test #'equal))) + (check-union x y result))) + t) + +(deftest nunion.9 + (let ((x '(a b c d e f)) + (y '(z c y a v b))) + (let ((result (nunion-with-copy x y :test-not (complement #'eql)))) + (check-union x y result))) + t) + +(deftest nunion.10 + (let ((x '(a b c d e f)) + (y '(z c y a v b))) + (let ((result (nunion-with-copy x y :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest nunion.11 + (let ((x '(a b c d e f)) + (y '(z c y a v b))) + (let ((result (nunion-with-copy x y :test-not (complement #'eq)))) + (check-union x y result))) + t) + +(deftest nunion.12 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy x y))) + (check-union x y result))) + t) + +(deftest nunion.13 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy x y :test #'equal))) + (check-union x y result))) + t) + +(deftest nunion.14 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy x y :test #'eql))) + (check-union x y result))) + t) + +(deftest nunion.15 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy x y :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest nunion.16 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy x y :test-not (complement #'eql)))) + (check-union x y result))) + t) + +(deftest nunion.17 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y #'1+))) + (check-union x y result))) + t) + +(deftest nunion.18 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y #'1+ :test #'equal))) + (check-union x y result))) + t) + +(deftest nunion.19 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y #'1+ :test #'eql))) + (check-union x y result))) + t) + +(deftest nunion.20 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y #'1+ + :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest nunion.21 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y #'1+ + :test-not (complement #'equal)))) + (check-union x y result))) + t) + +(deftest nunion.22 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y nil))) + (check-union x y result))) + t) + +(deftest nunion.23 + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y '1+))) + (check-union x y result))) + t) + +;; Do large numbers of random nunions + +(deftest nunion.24 + (do-random-nunions 100 100 200) + nil) + +(deftest nunion.25 + (let ((x (shuffle '(1 4 6 10 45 101))) + (y '(102 5 2 11 44 6))) + (let ((result (nunion-with-copy x y + :test #'(lambda (a b) + (<= (abs (- a b)) 1))))) + (sort + (sublis + '((2 . 1) (5 . 4) (11 . 10) (45 . 44) (102 . 101)) + (copy-list result)) + #'<))) + (1 4 6 10 44 101)) + +;; Check that nunion uses eql, not equal or eq + +(deftest nunion.26 + (let ((x 1000) + (y 1000)) + (loop + while (not (typep x 'bignum)) + do (progn + (setf x (* x x)) + (setf y (* y y)))) + (notnot-mv + (or + (eqt x y) ;; if bignums are eq, the test is worthless + (eql (length + (nunion-with-copy (list x) (list x))) + 1)))) + t) + +(deftest nunion.27 + (nunion-with-copy (list (copy-seq "aa")) + (list (copy-seq "aa"))) + ("aa" "aa")) + + + +;; Check that nunion does not reverse the arguments to :test, :test-not + +(deftest nunion.28 + (block fail + (sort + (nunion-with-copy + '(1 2 3) + '(4 5 6) + :test #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))) + #'<)) + (1 2 3 4 5 6)) + +(deftest nunion.29 + (block fail + (sort + (nunion-with-copy-and-key + '(1 2 3) + '(4 5 6) + #'identity + :test #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (eql x y))) + #'<)) + (1 2 3 4 5 6)) + +(deftest nunion.30 + (block fail + (sort + (nunion-with-copy + '(1 2 3) + '(4 5 6) + :test-not + #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))) + #'<)) + (1 2 3 4 5 6)) + +(deftest nunion.31 + (block fail + (sort + (nunion-with-copy-and-key + '(1 2 3) + '(4 5 6) + #'identity + :test-not #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + (not (eql x y)))) + #'<)) + (1 2 3 4 5 6)) + +;;; Order of evaluation tests + +(deftest nunion.order.1 + (let ((i 0) x y) + (values + (sort + (nunion (progn (setf x (incf i)) (copy-list '(1 3 5))) + (progn (setf y (incf i)) (copy-list '(2 5 8)))) + #'<) + i x y)) + (1 2 3 5 8) + 2 1 2) + +(deftest nunion.order.2 + (let ((i 0) x y z w) + (values + (sort + (nunion (progn (setf x (incf i)) (copy-list '(1 3 5))) + (progn (setf y (incf i)) (copy-list '(2 5 8))) + :test (progn (setf z (incf i)) #'eql) + :key (progn (setf w (incf i)) #'identity)) + #'<) + i x y z w)) + (1 2 3 5 8) + 4 1 2 3 4) + + +(deftest nunion.order.3 + (let ((i 0) x y z w) + (values + (sort + (nunion (progn (setf x (incf i)) (copy-list '(1 3 5))) + (progn (setf y (incf i)) (copy-list '(2 5 8))) + :key (progn (setf z (incf i)) #'identity) + :test (progn (setf w (incf i)) #'eql)) + #'<) + i x y z w)) + (1 2 3 5 8) + 4 1 2 3 4) + +;;; Keyword tests + +(deftest nunion.allow-other-keys.1 + (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) :bad t + :allow-other-keys "yes") + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest nunion.allow-other-keys.2 + (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t :also-bad t) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest nunion.allow-other-keys.3 + (sort (nunion (list 1 2 3) (list 1 2 3) + :allow-other-keys t :also-bad t + :test #'(lambda (x y) (= x (+ y 100)))) + #'<) + (1 1 2 2 3 3)) + +(deftest nunion.allow-other-keys.4 + (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest nunion.allow-other-keys.5 + (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys nil) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest nunion.allow-other-keys.6 + (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t + :allow-other-keys nil) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest nunion.allow-other-keys.7 + (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) + :allow-other-keys t + :allow-other-keys nil + '#:x 1) + #'<) + (1 2 5 7 9 10 11 20)) + +(deftest nunion.keywords.9 + (sort (nunion (list 1 2 3) (list 1 2 3) + :test #'(lambda (x y) (= x (+ y 100))) + :test #'eql) + #'<) + (1 1 2 2 3 3)) + +;;; Error tests + +(deftest nunion.error.1 + (classify-error (nunion)) + program-error) + +(deftest nunion.error.2 + (classify-error (nunion nil)) + program-error) + +(deftest nunion.error.3 + (classify-error (nunion nil nil :bad t)) + program-error) + +(deftest nunion.error.4 + (classify-error (nunion nil nil :key)) + program-error) + +(deftest nunion.error.5 + (classify-error (nunion nil nil 1 2)) + program-error) + +(deftest nunion.error.6 + (classify-error (nunion nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest nunion.error.7 + (classify-error (nunion (list 1 2) (list 3 4) :test #'identity)) + program-error) + +(deftest nunion.error.8 + (classify-error (nunion (list 1 2) (list 3 4) :test-not #'identity)) + program-error) + +(deftest nunion.error.9 + (classify-error (nunion (list 1 2) (list 3 4) :key #'cons)) + program-error) + +(deftest nunion.error.10 + (classify-error (nunion (list 1 2) (list 3 4) :key #'car)) + type-error) + diff --git a/ansi-tests/cons-test-22.lsp b/ansi-tests/cons-test-22.lsp new file mode 100644 index 0000000..380d1d4 --- /dev/null +++ b/ansi-tests/cons-test-22.lsp @@ -0,0 +1,613 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Mar 30 22:10:34 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 22 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; set-difference + +(deftest set-difference.1 + (set-difference nil nil) + nil) + +(deftest set-difference.2 + (let ((result + (set-difference-with-check '(a b c) nil))) + (check-set-difference '(a b c) nil result)) + t) + +(deftest set-difference.3 + (let ((result + (set-difference-with-check '(a b c d e f) '(f b d)))) + (check-set-difference '(a b c d e f) '(f b d) result)) + t) + +(deftest set-difference.4 + (sort + (copy-list + (set-difference-with-check (shuffle '(1 2 3 4 5 6 7 8)) + '(10 101 4 74 2 1391 7 17831))) + #'<) + (1 3 5 6 8)) + +(deftest set-difference.5 + (set-difference-with-check nil '(a b c d e f g h)) + nil) + +(deftest set-difference.6 + (set-difference-with-check '(a b c d e) '(d a b e) + :key nil) + (c)) + +(deftest set-difference.7 + (set-difference-with-check '(a b c d e) '(d a b e) :test #'eq) + (c)) + +(deftest set-difference.8 + (set-difference-with-check '(a b c d e) '(d a b e) :test #'eql) + (c)) + +(deftest set-difference.9 + (set-difference-with-check '(a b c d e) '(d a b e) :test #'equal) + (c)) + +(deftest set-difference.10 + (set-difference-with-check '(a b c d e) '(d a b e) + :test 'eq) + (c)) + +(deftest set-difference.11 + (set-difference-with-check '(a b c d e) '(d a b e) + :test 'eql) + (c)) + +(deftest set-difference.12 + (set-difference-with-check '(a b c d e) '(d a b e) + :test 'equal) + (c)) + +(deftest set-difference.13 + (do-random-set-differences 100 100) + nil) + +(deftest set-difference.14 + (set-difference-with-check '((a . 1) (b . 2) (c . 3)) + '((a . 1) (c . 3)) + :key 'car) + ((b . 2))) + +(deftest set-difference.15 + (set-difference-with-check '((a . 1) (b . 2) (c . 3)) + '((a . 1) (c . 3)) + :key #'car) + ((b . 2))) + +;; +;; Verify that the :test argument is called with the arguments +;; in the correct order +;; +(deftest set-difference.16 + (block fail + (sort + (copy-list + (set-difference-with-check + '(1 2 3 4) '(e f g h) + :test #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (eqt x y)))) + #'<)) + (1 2 3 4)) + +(deftest set-difference.17 + (block fail + (sort + (copy-list + (set-difference-with-check + '(1 2 3 4) '(e f g h) + :key #'identity + :test #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (eqt x y)))) + #'<)) + (1 2 3 4)) + +(deftest set-difference.18 + (block fail + (sort + (copy-list + (set-difference-with-check + '(1 2 3 4) '(e f g h) + :test-not + #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (not (eqt x y))))) + #'<)) + (1 2 3 4)) + +(deftest set-difference.19 + (block fail + (sort + (copy-list + (set-difference-with-check + '(1 2 3 4) '(e f g h) + :test-not + #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (not (eqt x y))))) + #'<)) + (1 2 3 4)) + +;;; Order of argument evaluation tests + +(deftest set-difference.order.1 + (let ((i 0) x y) + (values + (set-difference (progn (setf x (incf i)) (list 1 2 3 4)) + (progn (setf y (incf i)) (list 2 3 4))) + i x y)) + (1) 2 1 2) + +(deftest set-difference.order.2 + (let ((i 0) x y z) + (values + (set-difference (progn (setf x (incf i)) (list 1 2 3 4)) + (progn (setf y (incf i)) (list 2 3 4)) + :test (progn (setf z (incf i)) + #'(lambda (x y) (= x (1- y))))) + i x y z)) + (4) 3 1 2 3) + +(deftest set-difference.order.3 + (let ((i 0) x y z w) + (values + (set-difference (progn (setf x (incf i)) (list 1 2 3 4)) + (progn (setf y (incf i)) (list 2 3 4)) + :test (progn (setf z (incf i)) + #'(lambda (x y) (= x (1- y)))) + :key (progn (setf w (incf i)) nil)) + i x y z w)) + (4) 4 1 2 3 4) + + +;;; Keyword tests + +(deftest set-difference.allow-other-keys.1 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :bad t :allow-other-keys t)) + #'<) + (1 5)) + +(deftest set-difference.allow-other-keys.2 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t :bad t)) + #'<) + (1 5)) + +(deftest set-difference.allow-other-keys.3 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t :bad t :test #'(lambda (x y) (= x (1- y))))) + #'<) + (4 5)) + +(deftest set-difference.allow-other-keys.4 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t)) + #'<) + (1 5)) + +(deftest set-difference.allow-other-keys.5 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys nil)) + #'<) + (1 5)) + +(deftest set-difference.allow-other-keys.6 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t + :allow-other-keys nil)) + #'<) + (1 5)) + +(deftest set-difference.allow-other-keys.7 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t + :allow-other-keys nil + '#:x 1)) + #'<) + (1 5)) + +(deftest set-difference.keywords.8 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :test #'eql :test (complement #'eql))) + #'<) + (1 5)) + +(deftest set-difference.keywords.9 + (sort + (copy-list + (set-difference + (list 1 2 3 4 5) (list 2 3 4) + :test (complement #'eql) :test #'eql)) + #'<) + nil) + +;;; Error tests + + +(deftest set-difference.error.1 + (classify-error (set-difference)) + program-error) + +(deftest set-difference.error.2 + (classify-error (set-difference nil)) + program-error) + +(deftest set-difference.error.3 + (classify-error (set-difference nil nil :bad t)) + program-error) + +(deftest set-difference.error.4 + (classify-error (set-difference nil nil :key)) + program-error) + +(deftest set-difference.error.5 + (classify-error (set-difference nil nil 1 2)) + program-error) + +(deftest set-difference.error.6 + (classify-error (set-difference nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest set-difference.error.7 + (classify-error (set-difference (list 1 2) (list 3 4) :test #'identity)) + program-error) + +(deftest set-difference.error.8 + (classify-error (set-difference (list 1 2) (list 3 4) :test-not #'identity)) + program-error) + +(deftest set-difference.error.9 + (classify-error (set-difference (list 1 2) (list 3 4) :key #'cons)) + program-error) + +(deftest set-difference.error.10 + (classify-error (set-difference (list 1 2) (list 3 4) :key #'car)) + type-error) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nset-difference + +(deftest nset-difference.1 + (nset-difference nil nil) + nil) + +(deftest nset-difference.2 + (let ((result + (nset-difference-with-check '(a b c) nil))) + (check-nset-difference '(a b c) nil result)) + t) + +(deftest nset-difference.3 + (let ((result + (nset-difference-with-check '(a b c d e f) '(f b d)))) + (check-nset-difference '(a b c d e f) '(f b d) result)) + t) + +(deftest nset-difference.4 + (sort + (copy-list + (nset-difference-with-check (shuffle '(1 2 3 4 5 6 7 8)) + '(10 101 4 74 2 1391 7 17831))) + #'<) + (1 3 5 6 8)) + +(deftest nset-difference.5 + (nset-difference-with-check nil '(a b c d e f g h)) + nil) + +(deftest nset-difference.6 + (nset-difference-with-check '(a b c d e) '(d a b e) + :key nil) + (c)) + +(deftest nset-difference.7 + (nset-difference-with-check '(a b c d e) '(d a b e) :test #'eq) + (c)) + +(deftest nset-difference.8 + (nset-difference-with-check '(a b c d e) '(d a b e) :test #'eql) + (c)) + +(deftest nset-difference.9 + (nset-difference-with-check '(a b c d e) '(d a b e) :test #'equal) + (c)) + +(deftest nset-difference.10 + (nset-difference-with-check '(a b c d e) '(d a b e) + :test 'eq) + (c)) + +(deftest nset-difference.11 + (nset-difference-with-check '(a b c d e) '(d a b e) + :test 'eql) + (c)) + +(deftest nset-difference.12 + (nset-difference-with-check '(a b c d e) '(d a b e) + :test 'equal) + (c)) + +(deftest nset-difference.13 + (do-random-nset-differences 100 100) + nil) + +(deftest nset-difference.14 + (nset-difference-with-check '((a . 1) (b . 2) (c . 3)) + '((a . 1) (c . 3)) + :key 'car) + ((b . 2))) + +(deftest nset-difference.15 + (nset-difference-with-check '((a . 1) (b . 2) (c . 3)) + '((a . 1) (c . 3)) + :key #'car) + ((b . 2))) + +;; +;; Verify that the :test argument is called with the arguments +;; in the correct order +;; +(deftest nset-difference.16 + (block fail + (sort + (copy-list + (nset-difference-with-check + '(1 2 3 4) '(e f g h) + :test #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (eqt x y)))) + #'<)) + (1 2 3 4)) + +(deftest nset-difference.17 + (block fail + (sort + (copy-list + (nset-difference-with-check + '(1 2 3 4) '(e f g h) + :key #'identity + :test #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (eqt x y)))) + #'<)) + (1 2 3 4)) + +(deftest nset-difference.18 + (block fail + (sort + (copy-list + (nset-difference-with-check + '(1 2 3 4) '(e f g h) + :test-not + #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (not (eqt x y))))) + #'<)) + (1 2 3 4)) + +(deftest nset-difference.19 + (block fail + (sort (copy-list + (nset-difference-with-check + '(1 2 3 4) '(e f g h) + :test-not + #'(lambda (x y) + (when (or (member x '(e f g h)) + (member y '(1 2 3 4))) + (return-from fail 'fail)) + (not (eqt x y))))) + #'<)) + (1 2 3 4)) + +;;; Order of argument evaluation tests + +(deftest nset-difference.order.1 + (let ((i 0) x y) + (values + (nset-difference (progn (setf x (incf i)) (list 1 2 3 4)) + (progn (setf y (incf i)) (list 2 3 4))) + i x y)) + (1) 2 1 2) + +(deftest nset-difference.order.2 + (let ((i 0) x y z) + (values + (nset-difference (progn (setf x (incf i)) (list 1 2 3 4)) + (progn (setf y (incf i)) (list 2 3 4)) + :test (progn (setf z (incf i)) + #'(lambda (x y) (= x (1- y))))) + i x y z)) + (4) 3 1 2 3) + +(deftest nset-difference.order.3 + (let ((i 0) x y z w) + (values + (nset-difference (progn (setf x (incf i)) (list 1 2 3 4)) + (progn (setf y (incf i)) (list 2 3 4)) + :test (progn (setf z (incf i)) + #'(lambda (x y) (= x (1- y)))) + :key (progn (setf w (incf i)) nil)) + i x y z w)) + (4) 4 1 2 3 4) + + +;;; Keyword tests + +(deftest nset-difference.allow-other-keys.1 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :bad t :allow-other-keys t)) + #'<) + (1 5)) + +(deftest nset-difference.allow-other-keys.2 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t :bad t)) + #'<) + (1 5)) + +(deftest nset-difference.allow-other-keys.3 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t :bad t :test #'(lambda (x y) (= x (1- y))))) + #'<) + (4 5)) + +(deftest nset-difference.allow-other-keys.4 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t)) + #'<) + (1 5)) + +(deftest nset-difference.allow-other-keys.5 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys nil)) + #'<) + (1 5)) + +(deftest nset-difference.allow-other-keys.6 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t + :allow-other-keys nil)) + #'<) + (1 5)) + +(deftest nset-difference.allow-other-keys.7 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :allow-other-keys t + :allow-other-keys nil + '#:x 1)) + #'<) + (1 5)) + +(deftest nset-difference.keywords.8 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :test #'eql :test (complement #'eql))) + #'<) + (1 5)) + +(deftest nset-difference.keywords.9 + (sort + (copy-list + (nset-difference + (list 1 2 3 4 5) (list 2 3 4) + :test (complement #'eql) :test #'eql)) + #'<) + nil) + +;;; Error tests + +(deftest nset-difference.error.1 + (classify-error (nset-difference)) + program-error) + +(deftest nset-difference.error.2 + (classify-error (nset-difference nil)) + program-error) + +(deftest nset-difference.error.3 + (classify-error (nset-difference nil nil :bad t)) + program-error) + +(deftest nset-difference.error.4 + (classify-error (nset-difference nil nil :key)) + program-error) + +(deftest nset-difference.error.5 + (classify-error (nset-difference nil nil 1 2)) + program-error) + +(deftest nset-difference.error.6 + (classify-error (nset-difference nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest nset-difference.error.7 + (classify-error (nset-difference (list 1 2) (list 3 4) :test #'identity)) + program-error) + +(deftest nset-difference.error.8 + (classify-error (nset-difference (list 1 2) (list 3 4) :test-not #'identity)) + program-error) + +(deftest nset-difference.error.9 + (classify-error (nset-difference (list 1 2) (list 3 4) :key #'cons)) + program-error) + +(deftest nset-difference.error.10 + (classify-error (nset-difference (list 1 2) (list 3 4) :key #'car)) + type-error) diff --git a/ansi-tests/cons-test-23.lsp b/ansi-tests/cons-test-23.lsp new file mode 100644 index 0000000..53cb224 --- /dev/null +++ b/ansi-tests/cons-test-23.lsp @@ -0,0 +1,693 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Apr 1 21:49:43 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 23 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; set-exclusive-or + +(deftest set-exclusive-or.1 + (set-exclusive-or nil nil) + nil) + +(deftest set-exclusive-or.2 + (let ((result + (set-exclusive-or-with-check '(a b c) nil))) + (check-set-exclusive-or '(a b c) nil result)) + t) + +(deftest set-exclusive-or.3 + (let ((result + (set-exclusive-or-with-check '(a b c d e f) '(f b d)))) + (check-set-exclusive-or '(a b c d e f) '(f b d) result)) + t) + +(deftest set-exclusive-or.4 + (sort + (copy-list + (set-exclusive-or-with-check (shuffle '(1 2 3 4 5 6 7 8)) + '(10 101 4 74 2 1391 7 17831))) + #'<) + (1 3 5 6 8 10 74 101 1391 17831)) + +(deftest set-exclusive-or.5 + (check-set-exclusive-or + nil + '(a b c d e f g h) + (set-exclusive-or-with-check nil '(a b c d e f g h))) + t) + +(deftest set-exclusive-or.6 + (set-exclusive-or-with-check '(a b c d e) '(d a b e) + :key nil) + (c)) + +(deftest set-exclusive-or.7 + (set-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eq) + (c)) + +(deftest set-exclusive-or.7-a + (set-exclusive-or-with-check '(d a b e) '(a b c d e) :test #'eq) + (c)) + +(deftest set-exclusive-or.8 + (set-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eql) + (c)) + +(deftest set-exclusive-or.8-a + (set-exclusive-or-with-check '(e d b a) '(a b c d e) :test #'eql) + (c)) + +(deftest set-exclusive-or.8-b + (set-exclusive-or-with-check '(a b c d e) '(d a b e) + :test-not (complement #'eql)) + (c)) + +(deftest set-exclusive-or.9 + (set-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'equal) + (c)) + +(deftest set-exclusive-or.10 + (set-exclusive-or-with-check '(a b c d e) '(d a b e) + :test 'eq) + (c)) + +(deftest set-exclusive-or.11 + (set-exclusive-or-with-check '(a b c d e) '(d a b e) + :test 'eql) + (c)) + +(deftest set-exclusive-or.12 + (set-exclusive-or-with-check '(a b c d e) '(d a b e) + :test 'equal) + (c)) + +(deftest set-exclusive-or.13 + (do-random-set-exclusive-ors 100 100) + nil) + +(deftest set-exclusive-or.14 + (set-exclusive-or-with-check '((a . 1) (b . 2) (c . 3012)) + '((a . 10) (c . 3)) + :key 'car) + ((b . 2))) + +(deftest set-exclusive-or.15 + (set-exclusive-or-with-check '((a . xx) (b . 2) (c . 3)) + '((a . 1) (c . 3313)) + :key #'car) + ((b . 2))) + +(deftest set-exclusive-or.16 + (set-exclusive-or-with-check '((a . xx) (b . 2) (c . 3)) + '((a . 1) (c . 3313)) + :key #'car + :test-not (complement #'eql)) + ((b . 2))) + +;; +;; Check that set-exclusive-or does not invert +;; the order of the arguments to the test function +;; +(deftest set-exclusive-or.17 + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) + t) + +(deftest set-exclusive-or.17-a + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :key #'identity + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) + t) + +(deftest set-exclusive-or.18 + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) + t) + +(deftest set-exclusive-or.18-a + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :key #'identity + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) + t) + +;;; Order of argument evaluation tests + +(deftest set-exclusive-or.order.1 + (let ((i 0) x y) + (values + (sort + (set-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10))) + #'<) + i x y)) + (2 4 6 10) 2 1 2) + +(deftest set-exclusive-or.order.2 + (let ((i 0) x y z) + (values + (sort + (set-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :test (progn (setf z (incf i)) + #'eql)) + #'<) + i x y z)) + (2 4 6 10) 3 1 2 3) + +(deftest set-exclusive-or.order.3 + (let ((i 0) x y z w) + (values + (sort + (set-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :test (progn (setf z (incf i)) + #'eql) + :key (progn (setf w (incf i)) nil)) + #'<) + i x y z w)) + (2 4 6 10) 4 1 2 3 4) + +(deftest set-exclusive-or.order.4 + (let ((i 0) x y z w) + (values + (sort + (set-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :key (progn (setf z (incf i)) nil) + :test (progn (setf w (incf i)) + #'eql)) + #'<) + i x y z w)) + (2 4 6 10) 4 1 2 3 4) + +(deftest set-exclusive-or.order.5 + (let ((i 0) x y z w) + (values + (sort + (set-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :key (progn (setf z (incf i)) nil) + :key (progn (setf w (incf i)) + (complement #'eql))) + #'<) + i x y z w)) + (2 4 6 10) 4 1 2 3 4) + + +;;; Keyword tests + +(deftest set-exclusive.allow-other-keys.1 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :bad t :allow-other-keys t) + #'<) + (1 2 5 6)) + +(deftest set-exclusive.allow-other-keys.2 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t :bad t) + #'<) + (1 2 5 6)) + +(deftest set-exclusive.allow-other-keys.3 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t :bad t + :test #'(lambda (x y) (= x (1- y)))) + #'<) + (1 6)) + +(deftest set-exclusive.allow-other-keys.4 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t) + #'<) + (1 2 5 6)) + +(deftest set-exclusive.allow-other-keys.5 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys nil) + #'<) + (1 2 5 6)) + +(deftest set-exclusive.allow-other-keys.6 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t + :allow-other-keys nil) + #'<) + (1 2 5 6)) + +(deftest set-exclusive.allow-other-keys.7 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t + :allow-other-keys nil + '#:x 1) + #'<) + (1 2 5 6)) + +(deftest set-exclusive.keywords.8 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :test #'eql + :test #'/=) + #'<) + (1 2 5 6)) + +(deftest set-exclusive.keywords.9 + (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :test #'/= + :test #'eql) + #'<) + nil) + +(deftest set-exclusive-or.error.1 + (classify-error (set-exclusive-or)) + program-error) + +(deftest set-exclusive-or.error.2 + (classify-error (set-exclusive-or nil)) + program-error) + +(deftest set-exclusive-or.error.3 + (classify-error (set-exclusive-or nil nil :bad t)) + program-error) + +(deftest set-exclusive-or.error.4 + (classify-error (set-exclusive-or nil nil :key)) + program-error) + +(deftest set-exclusive-or.error.5 + (classify-error (set-exclusive-or nil nil 1 2)) + program-error) + +(deftest set-exclusive-or.error.6 + (classify-error (set-exclusive-or nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest set-exclusive-or.error.7 + (classify-error (set-exclusive-or (list 1 2) (list 3 4) :test #'identity)) + program-error) + +(deftest set-exclusive-or.error.8 + (classify-error (set-exclusive-or (list 1 2) (list 3 4) :test-not #'identity)) + program-error) + +(deftest set-exclusive-or.error.9 + (classify-error (set-exclusive-or (list 1 2) (list 3 4) :key #'cons)) + program-error) + +(deftest set-exclusive-or.error.10 + (classify-error (set-exclusive-or (list 1 2) (list 3 4) :key #'car)) + type-error) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; nset-exclusive-or + +(deftest nset-exclusive-or.1 + (nset-exclusive-or nil nil) + nil) + +(deftest nset-exclusive-or.2 + (let ((result + (nset-exclusive-or-with-check '(a b c) nil))) + (check-set-exclusive-or '(a b c) nil result)) + t) + +(deftest nset-exclusive-or.3 + (let ((result + (nset-exclusive-or-with-check '(a b c d e f) '(f b d)))) + (check-set-exclusive-or '(a b c d e f) '(f b d) result)) + t) + +(deftest nset-exclusive-or.4 + (sort + (copy-list + (nset-exclusive-or-with-check (shuffle '(1 2 3 4 5 6 7 8)) + '(10 101 4 74 2 1391 7 17831))) + #'<) + (1 3 5 6 8 10 74 101 1391 17831)) + +(deftest nset-exclusive-or.5 + (check-set-exclusive-or + nil + '(a b c d e f g h) + (nset-exclusive-or-with-check nil '(a b c d e f g h))) + t) + +(deftest nset-exclusive-or.6 + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) + :key nil) + (c)) + +(deftest nset-exclusive-or.7 + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eq) + (c)) + +(deftest nset-exclusive-or.7-a + (nset-exclusive-or-with-check '(d a b e) '(a b c d e) :test #'eq) + (c)) + +(deftest nset-exclusive-or.8 + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eql) + (c)) + +(deftest nset-exclusive-or.8-a + (nset-exclusive-or-with-check '(e d b a) '(a b c d e) :test #'eql) + (c)) + +(deftest nset-exclusive-or.8-b + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) + :test-not (complement #'eql)) + (c)) + +(deftest nset-exclusive-or.9 + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'equal) + (c)) + +(deftest nset-exclusive-or.10 + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) + :test 'eq) + (c)) + +(deftest nset-exclusive-or.11 + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) + :test 'eql) + (c)) + +(deftest nset-exclusive-or.12 + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) + :test 'equal) + (c)) + +(deftest nset-exclusive-or.13 + (do-random-nset-exclusive-ors 100 100) + nil) + +(deftest nset-exclusive-or.14 + (nset-exclusive-or-with-check '((a . 1) (b . 2) (c . 3012)) + '((a . 10) (c . 3)) + :key 'car) + ((b . 2))) + +(deftest nset-exclusive-or.15 + (nset-exclusive-or-with-check '((a . xx) (b . 2) (c . 3)) + '((a . 1) (c . 3313)) + :key #'car) + ((b . 2))) + +(deftest nset-exclusive-or.16 + (nset-exclusive-or-with-check '((a . xx) (b . 2) (c . 3)) + '((a . 1) (c . 3313)) + :key #'car + :test-not (complement #'eql)) + ((b . 2))) + +;; +;; Check that nset-exclusive-or does not invert +;; the order of the arguments to the test function +;; +(deftest nset-exclusive-or.17 + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) + t) + +(deftest nset-exclusive-or.17-a + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :key #'identity + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) + t) + +(deftest nset-exclusive-or.18 + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) + t) + +(deftest nset-exclusive-or.18-a + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :key #'identity + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) + t) + +;;; Order of argument evaluation tests + +(deftest nset-exclusive-or.order.1 + (let ((i 0) x y) + (values + (sort + (nset-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10))) + #'<) + i x y)) + (2 4 6 10) 2 1 2) + +(deftest nset-exclusive-or.order.2 + (let ((i 0) x y z) + (values + (sort + (nset-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :test (progn (setf z (incf i)) + #'eql)) + #'<) + i x y z)) + (2 4 6 10) 3 1 2 3) + +(deftest nset-exclusive-or.order.3 + (let ((i 0) x y z w) + (values + (sort + (nset-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :test (progn (setf z (incf i)) + #'eql) + :key (progn (setf w (incf i)) nil)) + #'<) + i x y z w)) + (2 4 6 10) 4 1 2 3 4) + +(deftest nset-exclusive-or.order.4 + (let ((i 0) x y z w) + (values + (sort + (nset-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :key (progn (setf z (incf i)) nil) + :test (progn (setf w (incf i)) + #'eql)) + #'<) + i x y z w)) + (2 4 6 10) 4 1 2 3 4) + +(deftest nset-exclusive-or.order.5 + (let ((i 0) x y z w) + (values + (sort + (nset-exclusive-or (progn (setf x (incf i)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :key (progn (setf z (incf i)) nil) + :key (progn (setf w (incf i)) + (complement #'eql))) + #'<) + i x y z w)) + (2 4 6 10) 4 1 2 3 4) + + +;;; Keyword tests + +(deftest nset-exclusive.allow-other-keys.1 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :bad t :allow-other-keys t) + #'<) + (1 2 5 6)) + +(deftest nset-exclusive.allow-other-keys.2 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t :bad t) + #'<) + (1 2 5 6)) + +(deftest nset-exclusive.allow-other-keys.3 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t :bad t + :test #'(lambda (x y) (= x (1- y)))) + #'<) + (1 6)) + +(deftest nset-exclusive.allow-other-keys.4 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t) + #'<) + (1 2 5 6)) + +(deftest nset-exclusive.allow-other-keys.5 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys nil) + #'<) + (1 2 5 6)) + +(deftest nset-exclusive.allow-other-keys.6 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t + :allow-other-keys nil) + #'<) + (1 2 5 6)) + +(deftest nset-exclusive.allow-other-keys.7 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :allow-other-keys t + :allow-other-keys nil + '#:x 1) + #'<) + (1 2 5 6)) + +(deftest nset-exclusive.keywords.8 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :test #'eql + :test #'/=) + #'<) + (1 2 5 6)) + +(deftest nset-exclusive.keywords.9 + (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6) + :test #'/= + :test #'eql) + #'<) + nil) + +;;; Error tests + +(deftest nset-exclusive-or.error.1 + (classify-error (nset-exclusive-or)) + program-error) + +(deftest nset-exclusive-or.error.2 + (classify-error (nset-exclusive-or nil)) + program-error) + +(deftest nset-exclusive-or.error.3 + (classify-error (nset-exclusive-or nil nil :bad t)) + program-error) + +(deftest nset-exclusive-or.error.4 + (classify-error (nset-exclusive-or nil nil :key)) + program-error) + +(deftest nset-exclusive-or.error.5 + (classify-error (nset-exclusive-or nil nil 1 2)) + program-error) + +(deftest nset-exclusive-or.error.6 + (classify-error (nset-exclusive-or nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest nset-exclusive-or.error.7 + (classify-error (nset-exclusive-or (list 1 2) (list 3 4) :test #'identity)) + program-error) + +(deftest nset-exclusive-or.error.8 + (classify-error (nset-exclusive-or (list 1 2) (list 3 4) :test-not #'identity)) + program-error) + +(deftest nset-exclusive-or.error.9 + (classify-error (nset-exclusive-or (list 1 2) (list 3 4) :key #'cons)) + program-error) + +(deftest nset-exclusive-or.error.10 + (classify-error (nset-exclusive-or (list 1 2) (list 3 4) :key #'car)) + type-error) + diff --git a/ansi-tests/cons-test-24.lsp b/ansi-tests/cons-test-24.lsp new file mode 100644 index 0000000..04b07cd --- /dev/null +++ b/ansi-tests/cons-test-24.lsp @@ -0,0 +1,250 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Apr 1 22:10:54 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 24 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; subsetp + +(defvar cons-test-24-var '(78 "z" (8 9))) + +(deftest subsetp.1 + (subsetp-with-check (copy-tree '(78)) cons-test-24-var) + t) + +(deftest subsetp.2 + (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var) + nil) + +(deftest subsetp.3 + (subsetp-with-check (copy-tree '((8 9))) + cons-test-24-var :test 'equal) + t) + +(deftest subsetp.4 + (subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var + :test #'equalp) + t) + +(deftest subsetp.5 + (subsetp-with-check (list 1) (list 0 2 3 4) + :key #'(lambda (i) (floor (/ i 2)))) + t) + +(deftest subsetp.6 + (subsetp-with-check (list 1 6) (list 0 2 3 4) + :key #'(lambda (i) (floor (/ i 2)))) + nil) + +(deftest subsetp.7 + (subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30)) + (list '(z . c) '(a . y) '(b . 100) '(e . f) + '(c . foo)) + :key #'car) + t) + +(deftest subsetp.8 + (subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30))) + (copy-tree '((z . c) (a . y) (b . 100) (e . f) + (c . foo))) + :key 'car) + t) + +(deftest subsetp.9 + (subsetp-with-check (list 'a 'b 'c) + (copy-tree + (list '(z . c) '(a . y) '(b . 100) '(e . f) + '(c . foo))) + :test #'(lambda (e1 e2) + (eqt e1 (car e2)))) + t) + +(deftest subsetp.10 + (subsetp-with-check (list 'a 'b 'c) + (copy-tree + (list '(z . c) '(a . y) '(b . 100) '(e . f) + '(c . foo))) + :test #'(lambda (e1 e2) + (eqt e1 (car e2))) + :key nil) + t) + +(deftest subsetp.11 + (subsetp-with-check (list 'a 'b 'c) + (copy-tree + (list '(z . c) '(a . y) '(b . 100) '(e . f) + '(c . foo))) + :test-not #'(lambda (e1 e2) + (not (eqt e1 (car e2))))) + t) + +;; Check that it maintains order of arguments + +(deftest subsetp.12 + (block fail + (subsetp-with-check + (list 1 2 3) + (list 4 5 6) + :test #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + t))) + t) + +(deftest subsetp.13 + (block fail + (subsetp-with-check + (list 1 2 3) + (list 4 5 6) + :key #'identity + :test #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + t))) + t) + +(deftest subsetp.14 + (block fail + (subsetp-with-check + (list 1 2 3) + (list 4 5 6) + :test-not #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + nil))) + t) + +(deftest subsetp.15 + (block fail + (subsetp-with-check + (list 1 2 3) + (list 4 5 6) + :key #'identity + :test-not #'(lambda (x y) + (when (< y x) (return-from fail 'fail)) + nil))) + t) + +;;; Order of argument evaluation tests + +(deftest subsetp.order.1 + (let ((i 0) x y) + (values + (notnot (subsetp (progn (setf x (incf i)) + '(a b c)) + (progn (setf y (incf i)) + '(a b c d)))) + i x y)) + t 2 1 2) + +(deftest subsetp.order.2 + (let ((i 0) x y z w) + (values + (notnot (subsetp (progn (setf x (incf i)) + '(a b c)) + (progn (setf y (incf i)) + '(a b c d)) + :test (progn (setf z (incf i)) #'eql) + :key (progn (setf w (incf i)) nil))) + i x y z w)) + t 4 1 2 3 4) + +(deftest subsetp.order.3 + (let ((i 0) x y z w) + (values + (notnot (subsetp (progn (setf x (incf i)) + '(a b c)) + (progn (setf y (incf i)) + '(a b c d)) + :key (progn (setf z (incf i)) nil) + :test (progn (setf w (incf i)) #'eql))) + i x y z w)) + t 4 1 2 3 4) + +;;; Keyword tests + +(deftest subsetp.allow-other-keys.1 + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :bad t :allow-other-keys 67)) + t) + +(deftest subsetp.allow-other-keys.2 + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) + :allow-other-keys #'cons :bad t)) + t) + +(deftest subsetp.allow-other-keys.3 + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4) + :allow-other-keys (make-hash-table) + :bad t + :test #'(lambda (x y) (= (1+ x) y)))) + nil) + +(deftest subsetp.allow-other-keys.4 + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys t)) + t) + +(deftest subsetp.allow-other-keys.5 + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys nil)) + t) + +(deftest subsetp.allow-other-keys.6 + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) + :allow-other-keys t :bad1 t + :allow-other-keys nil :bad2 t)) + t) + +(deftest subsetp.keywords.7 + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4) + :test #'(lambda (x y) (= (1+ x) y)) + :test #'eql)) + nil) + +(deftest subsetp.keywords.8 + (notnot-mv (subsetp '(1 2 3 4 10) '(0 1 2 3 4) + :key nil + :key #'(lambda (x) (mod x 2)))) + nil) + + +;;; Error tests + +(deftest subsetp.error.1 + (classify-error (subsetp)) + program-error) + +(deftest subsetp.error.2 + (classify-error (subsetp nil)) + program-error) + +(deftest subsetp.error.3 + (classify-error (subsetp nil nil :bad t)) + program-error) + +(deftest subsetp.error.4 + (classify-error (subsetp nil nil :key)) + program-error) + +(deftest subsetp.error.5 + (classify-error (subsetp nil nil 1 2)) + program-error) + +(deftest subsetp.error.6 + (classify-error (subsetp nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest subsetp.error.7 + (classify-error (subsetp (list 1 2) (list 3 4) :test #'identity)) + program-error) + +(deftest subsetp.error.8 + (classify-error (subsetp (list 1 2) (list 3 4) :test-not #'identity)) + program-error) + +(deftest subsetp.error.9 + (classify-error (subsetp (list 1 2) (list 3 4) :key #'cons)) + program-error) + +(deftest subsetp.error.10 + (classify-error (subsetp (list 1 2) (list 3 4) :key #'car)) + type-error) \ No newline at end of file diff --git a/ansi-tests/cons-test-25.lsp b/ansi-tests/cons-test-25.lsp new file mode 100644 index 0000000..baa1544 --- /dev/null +++ b/ansi-tests/cons-test-25.lsp @@ -0,0 +1,56 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 5 22:26:59 1998 +;;;; Contains: Testing of CL Features related to "CONS", part 25 + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; setting of C*R accessors + +(loop + for fn in '(car cdr caar cadr cdar cddr + caaar caadr cadar caddr cdaar cdadr cddar cdddr + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr) + do + (let ((level (- (length (symbol-name fn)) 2))) + (eval `(deftest ,(intern + (concatenate 'string + (symbol-name fn) + "-SET-ALT") + :cl-test) + (let ((x (create-c*r-test ,level))) + (and + (setf (,fn x) 'a) + (eql (,fn x) 'a) + (setf (,fn x) 'none) + (equal x (create-c*r-test ,level)) + )) + t)))) + +(loop + for (fn len) in '((first 1) (second 2) (third 3) (fourth 4) + (fifth 5) (sixth 6) (seventh 7) (eighth 8) + (ninth 9) (tenth 10)) + do + (eval + `(deftest ,(intern + (concatenate 'string + (symbol-name fn) + "-SET-ALT") + :cl-test) + (let ((x (make-list 20 :initial-element nil))) + (and + (setf (,fn x) 'a) + (loop + for i from 1 to 20 + do (when (and (not (eql i ,len)) + (nth (1- i) x)) + (return nil)) + finally (return t)) + (eql (,fn x) 'a) + (nth ,(1- len) x))) + a))) diff --git a/ansi-tests/constantly.lsp b/ansi-tests/constantly.lsp new file mode 100644 index 0000000..59d7143 --- /dev/null +++ b/ansi-tests/constantly.lsp @@ -0,0 +1,37 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Oct 6 19:47:16 2002 +;;;; Contains: Tests for CONSTANTLY + +(in-package :cl-test) + +(deftest constantly.1 + (let ((fn (cl:constantly 10)) + (x nil)) + (loop for i from 0 to (min 256 (1- call-arguments-limit)) + always (prog1 (eql (apply fn x) 10) + (push 'a x)))) + t) + +(deftest constantly.2 + (notnot-mv (cl:constantly 1)) + t) + +(deftest constantly.3 + (let ((i 0)) + (let ((fn (cl:constantly (progn (incf i) 'a)))) + (values + i + (mapcar fn '(1 2 3 4)) + i))) + 1 (a a a a) 1) + +(deftest constantly.error.1 + (classify-error (cl:constantly)) + program-error) + +;;; The next test fails in CMUCL, which has non-conformantly extended +;;; the syntax of constantly. +(deftest constantly.error.2 + (classify-error (cl:constantly 1 1)) + program-error) diff --git a/ansi-tests/constantp.lsp b/ansi-tests/constantp.lsp new file mode 100644 index 0000000..99556a2 --- /dev/null +++ b/ansi-tests/constantp.lsp @@ -0,0 +1,84 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 19:12:17 2003 +;;;; Contains: Tests for CONSTANTP + +;;; See also defconstant.lsp + +(in-package :cl-test) + +(deftest constantp.error.1 + (classify-error (constantp)) + program-error) + +(deftest constantp.error.2 + (classify-error (constantp nil nil nil)) + program-error) + + +(deftest constantp.1 + (loop for e in *universe* + when (and (not (symbolp e)) + (not (consp e)) + (not (constantp e))) + collect e) + nil) + +(deftest constantp.2 + (notnot-mv (constantp t)) + t) + +(deftest constantp.3 + (notnot-mv (constantp nil)) + t) + +(deftest constantp.4 + (notnot-mv (constantp :foo)) + t) + +(deftest constantp.5 + (constantp (gensym)) + nil) + +(defconstant constantp-test-symbol 1) + +(defmacro constantp-macro (form &environment env) + (notnot-mv (constantp form env))) + +(deftest constantp.6 + (constantp-macro constantp-test-symbol) + t) + +(deftest constantp.7 + (constantp '(incf x)) + nil) + +(deftest constantp.8 + (notnot-mv (constantp 1 nil)) + t) + +(deftest constantp.9 + (notnot-mv (constantp ''(((foo))))) + t) + +(deftest constantp.10 + (notnot-mv (constantp 'pi)) + t) + +(deftest constantp.order.1 + (let ((i 0)) + (values + (notnot (constantp (progn (incf i) 1))) + i)) + t 1) + +(deftest constantp.order.2 + (let ((i 0) x y) + (values + (notnot (constantp (progn (setf x (incf i)) 1) + (progn (setf y (incf i)) nil))) + i x y)) + t 2 1 2) + + + diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp new file mode 100644 index 0000000..bb2cd1e --- /dev/null +++ b/ansi-tests/copy-seq.lsp @@ -0,0 +1,187 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 2 21:38:08 2002 +;;;; Contains: Tests for COPY-SEQ + +(in-package :cl-test) + +;;; This function is extensively used elsewhere, but is tested again +;;; here for completeness. + +(deftest copy-seq.1 + (copy-seq nil) + nil) + +(deftest copy-seq.2 + (let* ((s1 '(a b c)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (equalt s1 s2))) + t) + +(deftest copy-seq.3 + (let* ((s1 #(a b c)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) s2)) + #(a b c)) + +(deftest copy-seq.4 + (let* ((s1 (make-array '(4) :initial-contents '(a b c d) + :adjustable t)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (simple-vector-p s2) + s2)) + #(a b c d)) + + +(deftest copy-seq.5 + (let* ((s1 (make-array '(4) :initial-contents '(a b c d) + :fill-pointer 3)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (simple-vector-p s2) + s2)) + #(a b c)) + +(deftest copy-seq.6 + (let* ((a1 (make-array '(6) :initial-contents '(a b c d e f))) + (a2 (make-array '(4) :displaced-to a1 + :displaced-index-offset 1)) + (s2 (check-values (copy-seq a2)))) + (and (not (eql a2 s2)) + (simple-vector-p s2) + s2)) + #(b c d e)) + +(deftest copy-seq.7 + (let* ((s1 (make-array '(4) + :element-type 'base-char + :initial-contents '(#\a #\b #\c #\d) + :adjustable t)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (simple-string-p s2) + s2)) + "abcd") + + +(deftest copy-seq.8 + (let* ((s1 (make-array '(4) + :element-type 'base-char + :initial-contents '(#\a #\b #\c #\d) + :fill-pointer 3)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (simple-string-p s2) + s2)) + "abc") + +(deftest copy-seq.9 + (let* ((a1 (make-array '(6) :initial-contents '(#\a #\b #\c #\d #\e #\f) + :element-type 'base-char)) + (a2 (make-array '(4) :displaced-to a1 + :element-type 'base-char + :displaced-index-offset 1)) + (s2 (check-values (copy-seq a2)))) + (and (not (eql a2 s2)) + (simple-string-p s2) + s2)) + "bcde") + +(deftest copy-seq.10 + (let*((s1 "abcd") + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + s2)) + "abcd") + +(deftest copy-seq.11 + (let* ((s1 #*0010110) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (simple-bit-vector-p s2) + s2)) + #*0010110) + +(deftest copy-seq.12 + (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0) + :element-type 'bit + :adjustable t)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (simple-bit-vector-p s2) + s2)) + #*0010) + +(deftest copy-seq.13 + (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0) + :element-type 'bit + :fill-pointer 3)) + (s2 (check-values (copy-seq s1)))) + (and (not (eql s1 s2)) + (simple-bit-vector-p s2) + s2)) + #*001) + +(deftest copy-seq.14 + (let* ((a1 (make-array '(6) :initial-contents '(0 0 1 0 1 1) + :element-type 'bit)) + (a2 (make-array '(4) :displaced-to a1 + :displaced-index-offset 1 + :element-type 'bit)) + (s2 (check-values (copy-seq a2)))) + (and (not (eql a2 s2)) + (simple-bit-vector-p s2) + s2)) + #*0101) + +(deftest copy-seq.15 + (copy-seq "") + "") + +(deftest copy-seq.16 + (copy-seq #*) + #*) + +(deftest copy-seq.17 + (copy-seq #()) + #()) + +(deftest copy-seq.18 + (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j))) + (y (check-values (copy-seq x)))) + (equal-array x y)) + t) + +(deftest copy-seq.order.1 + (let ((i 0)) + (values (copy-seq (progn (incf i) "abc")) i)) + "abc" 1) + +;;; Error tests + +(deftest copy-seq.error.1 + (classify-error (copy-seq 10)) + type-error) + +(deftest copy-seq.error.2 + (classify-error (copy-seq 'a)) + type-error) + +(deftest copy-seq.error.3 + (classify-error (copy-seq 13.21)) + type-error) + +(deftest copy-seq.error.4 + (classify-error (copy-seq)) + program-error) + +(deftest copy-seq.error.5 + (classify-error (copy-seq "abc" 2 nil)) + program-error) + +(deftest copy-seq.error.6 + (classify-error (locally (copy-seq 10) t)) + type-error) + diff --git a/ansi-tests/count-if-not.lsp b/ansi-tests/count-if-not.lsp new file mode 100644 index 0000000..bdcf63d --- /dev/null +++ b/ansi-tests/count-if-not.lsp @@ -0,0 +1,540 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Aug 20 22:42:35 2002 +;;;; Contains: Tests for COUNT-IF-NOT + +(in-package :cl-test) + +(deftest count-if-not-list.1 + (count-if-not #'identity '(a b nil c d nil e)) + 2) + +(deftest count-if-not-list.2 + (count-if-not #'not '(a b nil c d nil e)) + 5) + +(deftest count-if-not-list.3 + (count-if-not #'(lambda (x) (break)) nil) + 0) + +(deftest count-if-not-list.4 + (count-if-not #'identity '(a b nil c d nil e) :key #'identity) + 2) + +(deftest count-if-not-list.5 + (count-if-not 'identity '(a b nil c d nil e) :key #'identity) + 2) + +(deftest count-if-not-list.6 + (count-if-not #'identity '(a b nil c d nil e) :key 'identity) + 2) + +(deftest count-if-not-list.8 + (count-if-not #'identity '(a b nil c d nil e) :key 'not) + 5) + +(deftest count-if-not-list.9 + (count-if-not #'oddp '(1 2 3 4 4 1 8 10 1)) + 5) + +(deftest count-if-not-list.10 + (count-if-not #'oddp '(1 2 3 4 4 1 8 10 1) :key #'1+) + 4) + +(deftest count-if-not-list.11 + (let ((c 0)) + (count-if-not #'oddp '(1 2 3 4 4 1 8 10 1) + :key #'(lambda (x) (+ x (incf c))))) + 6) + +(deftest count-if-not-list.12 + (let ((c 0)) + (count-if-not #'oddp '(0 1 2 3 4 4 1 7 10 1) + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 8) + +(deftest count-if-not-list.13 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + '(a b c d a e f a e f f a a) :start 2) + 4) + +(deftest count-if-not-list.14 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + '(a b c d a e f a e f f a a) :end 7) + 2) + +(deftest count-if-not-list.15 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + '(a b c d a e f a e f f a a) :end 7 + :start 2) + 1) + +(deftest count-if-not-list.16 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + '(a b c d a e f a e f f a a) :end 7 + :start 2 :from-end t) + 1) + + +;;; tests on vectors + +(deftest count-if-not-vector.1 + (count-if-not #'identity #(a b nil c d nil e)) + 2) + +(deftest count-if-not-vector.2 + (count-if-not #'not #(a b nil c d nil e)) + 5) + +(deftest count-if-not-vector.3 + (count-if-not #'(lambda (x) (break)) #()) + 0) + +(deftest count-if-not-vector.4 + (count-if-not #'not #(a b nil c d nil e) :key #'identity) + 5) + +(deftest count-if-not-vector.5 + (count-if-not 'not #(a b nil c d nil e) :key #'identity) + 5) + +(deftest count-if-not-vector.6 + (count-if-not #'not #(a b nil c d nil e) :key 'identity) + 5) + +(deftest count-if-not-vector.8 + (count-if-not #'not #(a b nil c d nil e) :key 'not) + 2) + +(deftest count-if-not-vector.9 + (count-if-not #'oddp #(1 2 3 4 4 1 8 10 1)) + 5) + +(deftest count-if-not-vector.10 + (count-if-not #'oddp #(1 2 3 4 4 1 8 10 1) :key #'1+) + 4) + +(deftest count-if-not-vector.11 + (let ((c 0)) + (count-if-not #'oddp #(1 2 3 4 4 1 8 10 1) + :key #'(lambda (x) (+ x (incf c))))) + 6) + +(deftest count-if-not-vector.12 + (let ((c 0)) + (count-if-not #'oddp #(0 1 2 3 4 4 1 7 10 1) + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 8) + +(deftest count-if-not-vector.13 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + #(a b c d a e f a e f f a a) :start 2) + 4) + +(deftest count-if-not-vector.14 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + #(a b c d a e f a e f f a a) :end 7) + 2) + +(deftest count-if-not-vector.15 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + #(a b c d a e f a e f f a a) :end 7 + :start 2) + 1) + +(deftest count-if-not-vector.16 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + #(a b c d a e f a e f f a a) :end 7 + :start 2 :from-end t) + 1) + +;;; Non-simple vectors + +(deftest count-if-not-nonsimple-vector.1 + (count-if-not #'identity (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t)) + 2) + +(deftest count-if-not-nonsimple-vector.2 + (count-if-not #'not (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t)) + 5) + +(deftest count-if-not-nonsimple-vector.3 + (count-if-not #'(lambda (x) (break)) (make-array 0 + :fill-pointer t + :adjustable t)) + 0) + +(deftest count-if-not-nonsimple-vector.4 + (count-if-not #'not + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key #'identity) + 5) + +(deftest count-if-not-nonsimple-vector.5 + (count-if-not 'not + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key #'identity) + 5) + +(deftest count-if-not-nonsimple-vector.6 + (count-if-not #'not + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key 'identity) + 5) + +(deftest count-if-not-nonsimple-vector.8 + (count-if-not #'not + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key 'not) + 2) + +(deftest count-if-not-nonsimple-vector.9 + (count-if-not #'oddp (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1) + :fill-pointer t :adjustable t)) + 5) + +(deftest count-if-not-nonsimple-vector.10 + (count-if-not #'oddp + (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1) + :fill-pointer t :adjustable t) + :key #'1+) + 4) + +(deftest count-if-not-nonsimple-vector.11 + (let ((c 0)) + (count-if-not #'oddp + (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1) + :fill-pointer t :adjustable t) + :key #'(lambda (x) (+ x (incf c))))) + 6) + +(deftest count-if-not-nonsimple-vector.12 + (let ((c 0)) + (count-if-not #'oddp + (make-array 10 :initial-contents '(0 1 2 3 4 4 1 7 10 1) + :fill-pointer t :adjustable t) + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 8) + +(deftest count-if-not-nonsimple-vector.13 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :start 2) + 4) + +(deftest count-if-not-nonsimple-vector.14 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :end 7) + 2) + +(deftest count-if-not-nonsimple-vector.15 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :end 7 :start 2) + 1) + +(deftest count-if-not-nonsimple-vector.16 + (count-if-not #'(lambda (x) (not (eqt x 'a))) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :end 7 :start 2 :from-end t) + 1) + +(deftest count-if-not-nonsimple-vector.17 + (flet ((%a (c) (not (eqt c 'a))) + (%f (c) (not (eqt c 'f)))) + (let ((a (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer 9))) + (values (count-if-not #'%a a) + (count-if-not #'%a a :from-end t) + (count-if-not #'%f a) + (count-if-not #'%f a :from-end t) + ))) + 3 3 1 1) + +;;; tests on bit-vectors + +(deftest count-if-not-bit-vector.1 + (count-if-not #'oddp #*001011101101) + 5) + +(deftest count-if-not-bit-vector.2 + (count-if-not #'identity #*001011101101) + 0) + +(deftest count-if-not-bit-vector.3 + (count-if-not #'(lambda (x) (break)) #*) + 0) + +(deftest count-if-not-bit-vector.4 + (count-if-not #'identity #*001011101101 :key #'zerop) + 7) + +(deftest count-if-not-bit-vector.5 + (count-if-not 'not #*001011101101 :key #'zerop) + 5) + +(deftest count-if-not-bit-vector.6 + (count-if-not #'not #*001011101101 :key 'zerop) + 5) + +(deftest count-if-not-bit-vector.8 + (count-if-not #'identity #*001011101101 :key 'oddp) + 5) + +(deftest count-if-not-bit-vector.10 + (count-if-not #'oddp #*001011101101 :key #'1+) + 7) + +(deftest count-if-not-bit-vector.11 + (let ((c 0)) + (count-if-not #'oddp #*001011101101 + :key #'(lambda (x) (+ x (incf c))))) + 7) + +(deftest count-if-not-bit-vector.12 + (let ((c 0)) + (count-if-not #'oddp #*001011101101 + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 5) + +(deftest count-if-not-bit-vector.13 + (count-if-not #'zerop #*0111011011100 :start 2) + 7) + +(deftest count-if-not-bit-vector.14 + (count-if-not #'zerop #*0111011011100 :end 7) + 5) + +(deftest count-if-not-bit-vector.15 + (count-if-not #'zerop #*0111011011100 :end 7 :start 2) + 4) + +(deftest count-if-not-bit-vector.16 + (count-if-not #'zerop #*0111011011100 :end 7 :start 2 :from-end t) + 4) + +(deftest count-if-not-bit-vector.17 + (let ((a (make-array '(10) :initial-contents '(0 0 0 1 1 1 0 1 0 0) + :fill-pointer 5 + :element-type 'bit))) + (and (bit-vector-p a) + (values (count-if-not #'zerop a) + (count-if-not #'oddp a) + (count-if-not #'zerop a :from-end t) + (count-if-not #'oddp a :from-end t)))) + 2 3 2 3) + +;;; tests on strings + +(deftest count-if-not-string.1 + (count-if-not #'(lambda (x) (eql x #\0)) "001011101101") + 7) + +(deftest count-if-not-string.2 + (count-if-not #'identity "001011101101") + 0) + +(deftest count-if-not-string.3 + (count-if-not #'(lambda (x) (break)) "") + 0) + +(deftest count-if-not-string.4 + (count-if-not #'identity "001011101101" :key #'(lambda (x) (eql x #\0))) + 7) + +(deftest count-if-not-string.5 + (count-if-not 'identity "001011101101" :key #'(lambda (x) (eql x #\0))) + 7) + +(deftest count-if-not-string.6 + (count-if-not #'(lambda (x) (eql x #\0)) "001011101101" :key 'identity) + 7) + +(deftest count-if-not-string.8 + (count-if-not #'identity "001011101101" :key #'(lambda (x) (eql x #\1))) + 5) + +(deftest count-if-not-string.11 + (let ((c 0)) + (count-if-not #'oddp "001011101101" + :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c))))) + 7) + +(deftest count-if-not-string.12 + (let ((c 0)) + (count-if-not #'oddp "001011101101" + :from-end t + :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c))))) + 5) + +(deftest count-if-not-string.13 + (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :start 2) + 7) + +(deftest count-if-not-string.14 + (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :end 7) + 5) + +(deftest count-if-not-string.15 + (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :end 7 :start 2) + 4) + +(deftest count-if-not-string.16 + (count-if-not #'(lambda (x) (eql x #\0)) + "0111011011100" :end 7 :start 2 :from-end t) + 4) + +(deftest count-if-not-string.17 + (flet ((%zerop (c) (eql c #\0)) + (%onep (c) (eql c #\1))) + (let ((a (make-array '(10) :initial-contents "0001110100" + :fill-pointer 5 + :element-type 'character))) + (and (stringp a) + (values (count-if-not #'%zerop a) + (count-if-not #'%onep a) + (count-if-not #'%zerop a :from-end t) + (count-if-not #'%onep a :from-end t))))) + 2 3 2 3) + +;;; Argument order tests + +(deftest count-if-not.order.1 + (let ((i 0) c1 c2 c3 c4 c5 c6) + (values + (count-if-not + (progn (setf c1 (incf i)) #'null) + (progn (setf c2 (incf i)) '(a nil b c nil d e)) + :start (progn (setf c3 (incf i)) 0) + :end (progn (setf c4 (incf i)) 3) + :key (progn (setf c5 (incf i)) #'not) + :from-end (progn (setf c6 (incf i)) nil) + ) + i c1 c2 c3 c4 c5 c6)) + 1 6 1 2 3 4 5 6) + +(deftest count-if-not.order.2 + (let ((i 0) c1 c2 c3 c4 c5 c6) + (values + (count-if-not + (progn (setf c1 (incf i)) #'null) + (progn (setf c2 (incf i)) '(a nil b c nil d e)) + :from-end (progn (setf c3 (incf i)) nil) + :key (progn (setf c4 (incf i)) #'not) + :end (progn (setf c5 (incf i)) 3) + :start (progn (setf c6 (incf i)) 0) + ) + i c1 c2 c3 c4 c5 c6)) + 1 6 1 2 3 4 5 6) + +;;; Keyword tests + +(deftest count-if-not.keywords.1 + (count-if-not #'oddp '(1 2 3 4 5) :bad t :allow-other-keys t) + 2) + +(deftest count-if-not.keywords.2 + (count-if-not #'oddp '(1 2 3 4 5) :allow-other-keys #p"*" :also-bad t) + 2) + +;;; The leftmost of two :allow-other-keys arguments is the one that matters. +(deftest count-if-not.keywords.3 + (count-if-not #'oddp '(1 2 3 4 5) + :allow-other-keys t + :allow-other-keys nil + :bad t) + 2) + +(deftest count-if-not.keywords.4 + (count-if-not #'oddp '(1 2 3 4 5) :key #'identity :key #'1+) + 2) + +(deftest count-if-not.allow-other-keys.5 + (count-if-not #'null '(nil a b c nil) :allow-other-keys nil) + 3) + +;;; Error tests + +(deftest count-if-not.error.1 + (classify-error (count-if-not #'identity 1)) + type-error) + +(deftest count-if-not.error.2 + (classify-error (count-if-not #'identity 'a)) + type-error) + +(deftest count-if-not.error.3 + (classify-error (count-if-not #'identity #\a)) + type-error) + +(deftest count-if-not.error.4 + (classify-error (count-if-not)) + program-error) + +(deftest count-if-not.error.5 + (classify-error (count-if-not #'null)) + program-error) + +(deftest count-if-not.error.6 + (classify-error (count-if-not #'null nil :bad t)) + program-error) + +(deftest count-if-not.error.7 + (classify-error (count-if-not #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest count-if-not.error.8 + (classify-error (count-if-not #'null nil :key)) + program-error) + +(deftest count-if-not.error.9 + (classify-error (count-if-not #'null nil 3 3)) + program-error) + +;;; Only leftmost :allow-other-keys argument matters +(deftest count-if-not.error.10 + (classify-error (count-if-not #'null nil :bad t + :allow-other-keys nil + :allow-other-keys t)) + program-error) + +(deftest count-if-not.error.11 + (classify-error (locally (count-if-not #'identity 1) t)) + type-error) + +(deftest count-if-not.error.12 + (classify-error (count-if-not #'cons '(a b c))) + program-error) + +(deftest count-if-not.error.13 + (classify-error (count-if-not #'car '(a b c))) + type-error) + +(deftest count-if-not.error.14 + (classify-error (count-if-not #'identity '(a b c) :key #'cdr)) + type-error) + +(deftest count-if-not.error.15 + (classify-error (count-if-not #'identity '(a b c) :key #'cons)) + program-error) diff --git a/ansi-tests/count-if.lsp b/ansi-tests/count-if.lsp new file mode 100644 index 0000000..3226584 --- /dev/null +++ b/ansi-tests/count-if.lsp @@ -0,0 +1,541 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Aug 20 08:01:30 2002 +;;;; Contains: Tests for COUNT-IF + +(in-package :cl-test) + +(deftest count-if-list.1 + (count-if #'identity '(a b nil c d nil e)) + 5) + +(deftest count-if-list.2 + (count-if #'not '(a b nil c d nil e)) + 2) + +(deftest count-if-list.3 + (count-if #'(lambda (x) (break)) nil) + 0) + +(deftest count-if-list.4 + (count-if #'identity '(a b nil c d nil e) :key #'identity) + 5) + +(deftest count-if-list.5 + (count-if 'identity '(a b nil c d nil e) :key #'identity) + 5) + +(deftest count-if-list.6 + (count-if #'identity '(a b nil c d nil e) :key 'identity) + 5) + +(deftest count-if-list.8 + (count-if #'identity '(a b nil c d nil e) :key 'not) + 2) + +(deftest count-if-list.9 + (count-if #'evenp '(1 2 3 4 4 1 8 10 1)) + 5) + +(deftest count-if-list.10 + (count-if #'evenp '(1 2 3 4 4 1 8 10 1) :key #'1+) + 4) + +(deftest count-if-list.11 + (let ((c 0)) + (count-if #'evenp '(1 2 3 4 4 1 8 10 1) + :key #'(lambda (x) (+ x (incf c))))) + 6) + +(deftest count-if-list.12 + (let ((c 0)) + (count-if #'evenp '(0 1 2 3 4 4 1 7 10 1) + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 8) + +(deftest count-if-list.13 + (count-if #'(lambda (x) (eqt x 'a)) + '(a b c d a e f a e f f a a) :start 2) + 4) + +(deftest count-if-list.14 + (count-if #'(lambda (x) (eqt x 'a)) + '(a b c d a e f a e f f a a) :end 7) + 2) + +(deftest count-if-list.15 + (count-if #'(lambda (x) (eqt x 'a)) + '(a b c d a e f a e f f a a) :end 7 + :start 2) + 1) + +(deftest count-if-list.16 + (count-if #'(lambda (x) (eqt x 'a)) + '(a b c d a e f a e f f a a) :end 7 + :start 2 :from-end t) + 1) + + +;;; tests on vectors + +(deftest count-if-vector.1 + (count-if #'identity #(a b nil c d nil e)) + 5) + +(deftest count-if-vector.2 + (count-if #'not #(a b nil c d nil e)) + 2) + +(deftest count-if-vector.3 + (count-if #'(lambda (x) (break)) #()) + 0) + +(deftest count-if-vector.4 + (count-if #'identity #(a b nil c d nil e) :key #'identity) + 5) + +(deftest count-if-vector.5 + (count-if 'identity #(a b nil c d nil e) :key #'identity) + 5) + +(deftest count-if-vector.6 + (count-if #'identity #(a b nil c d nil e) :key 'identity) + 5) + +(deftest count-if-vector.8 + (count-if #'identity #(a b nil c d nil e) :key 'not) + 2) + +(deftest count-if-vector.9 + (count-if #'evenp #(1 2 3 4 4 1 8 10 1)) + 5) + +(deftest count-if-vector.10 + (count-if #'evenp #(1 2 3 4 4 1 8 10 1) :key #'1+) + 4) + +(deftest count-if-vector.11 + (let ((c 0)) + (count-if #'evenp #(1 2 3 4 4 1 8 10 1) + :key #'(lambda (x) (+ x (incf c))))) + 6) + +(deftest count-if-vector.12 + (let ((c 0)) + (count-if #'evenp #(0 1 2 3 4 4 1 7 10 1) + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 8) + +(deftest count-if-vector.13 + (count-if #'(lambda (x) (eqt x 'a)) + #(a b c d a e f a e f f a a) :start 2) + 4) + +(deftest count-if-vector.14 + (count-if #'(lambda (x) (eqt x 'a)) + #(a b c d a e f a e f f a a) :end 7) + 2) + +(deftest count-if-vector.15 + (count-if #'(lambda (x) (eqt x 'a)) + #(a b c d a e f a e f f a a) :end 7 + :start 2) + 1) + +(deftest count-if-vector.16 + (count-if #'(lambda (x) (eqt x 'a)) + #(a b c d a e f a e f f a a) :end 7 + :start 2 :from-end t) + 1) + +;;; Non-simple vectors + +(deftest count-if-nonsimple-vector.1 + (count-if #'identity (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t)) + 5) + +(deftest count-if-nonsimple-vector.2 + (count-if #'not (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t)) + 2) + +(deftest count-if-nonsimple-vector.3 + (count-if #'(lambda (x) (break)) (make-array 0 + :fill-pointer t + :adjustable t)) + 0) + +(deftest count-if-nonsimple-vector.4 + (count-if #'identity + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key #'identity) + 5) + +(deftest count-if-nonsimple-vector.5 + (count-if 'identity + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key #'identity) + 5) + +(deftest count-if-nonsimple-vector.6 + (count-if #'identity + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key 'identity) + 5) + +(deftest count-if-nonsimple-vector.8 + (count-if #'identity + (make-array 7 :initial-contents '(a b nil c d nil e) + :fill-pointer t + :adjustable t) + :key 'not) + 2) + +(deftest count-if-nonsimple-vector.9 + (count-if #'evenp (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1) + :fill-pointer t :adjustable t)) + 5) + +(deftest count-if-nonsimple-vector.10 + (count-if #'evenp + (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1) + :fill-pointer t :adjustable t) + :key #'1+) + 4) + +(deftest count-if-nonsimple-vector.11 + (let ((c 0)) + (count-if #'evenp + (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1) + :fill-pointer t :adjustable t) + :key #'(lambda (x) (+ x (incf c))))) + 6) + +(deftest count-if-nonsimple-vector.12 + (let ((c 0)) + (count-if #'evenp + (make-array 10 :initial-contents '(0 1 2 3 4 4 1 7 10 1) + :fill-pointer t :adjustable t) + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 8) + +(deftest count-if-nonsimple-vector.13 + (count-if #'(lambda (x) (eqt x 'a)) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :start 2) + 4) + +(deftest count-if-nonsimple-vector.14 + (count-if #'(lambda (x) (eqt x 'a)) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :end 7) + 2) + +(deftest count-if-nonsimple-vector.15 + (count-if #'(lambda (x) (eqt x 'a)) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :end 7 :start 2) + 1) + +(deftest count-if-nonsimple-vector.16 + (count-if #'(lambda (x) (eqt x 'a)) + (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer t :adjustable t) + :end 7 :start 2 :from-end t) + 1) + +(deftest count-if-nonsimple-vector.17 + (flet ((%f (x) (eqt x 'a))) + (let ((s (make-array 13 :initial-contents '(a b c d a e f a e f f a a) + :fill-pointer 6))) + (values (count-if #'%f s) + (count-if #'%f s :end nil) + (count-if #'%f s :end 4) + (count-if #'%f s :start 1) + (count-if #'%f s :start 1 :end 4) + (count-if #'%f s :start 1 :end 4 :from-end t)))) + 2 2 1 1 0 0) + +;;; tests on bit-vectors + +(deftest count-if-bit-vector.1 + (count-if #'evenp #*001011101101) + 5) + +(deftest count-if-bit-vector.2 + (count-if #'identity #*001011101101) + 12) + +(deftest count-if-bit-vector.3 + (count-if #'(lambda (x) (break)) #*) + 0) + +(deftest count-if-bit-vector.4 + (count-if #'identity #*001011101101 :key #'zerop) + 5) + +(deftest count-if-bit-vector.5 + (count-if 'identity #*001011101101 :key #'zerop) + 5) + +(deftest count-if-bit-vector.6 + (count-if #'identity #*001011101101 :key 'zerop) + 5) + +(deftest count-if-bit-vector.8 + (count-if #'identity #*001011101101 :key 'oddp) + 7) + +(deftest count-if-bit-vector.10 + (count-if #'evenp #*001011101101 :key #'1+) + 7) + +(deftest count-if-bit-vector.11 + (let ((c 0)) + (count-if #'evenp #*001011101101 + :key #'(lambda (x) (+ x (incf c))))) + 7) + +(deftest count-if-bit-vector.12 + (let ((c 0)) + (count-if #'evenp #*001011101101 + :from-end t + :key #'(lambda (x) (+ x (incf c))))) + 5) + +(deftest count-if-bit-vector.13 + (count-if #'zerop #*0111011011100 :start 2) + 4) + +(deftest count-if-bit-vector.14 + (count-if #'zerop #*0111011011100 :end 7) + 2) + +(deftest count-if-bit-vector.15 + (count-if #'zerop #*0111011011100 :end 7 :start 2) + 1) + +(deftest count-if-bit-vector.16 + (count-if #'zerop #*0111011011100 :end 7 :start 2 :from-end t) + 1) + +(deftest count-if-bit-vector.17 + (let ((s (make-array '(10) :initial-contents '(0 0 1 0 1 0 0 1 1 0) + :element-type 'bit + :fill-pointer 6))) + (values (count-if #'zerop s) + (count-if #'zerop s :end nil) + (count-if #'zerop s :end 4) + (count-if #'zerop s :start 5) + (count-if #'zerop s :start 1 :end 4))) + 4 4 3 1 2) + +;;; tests on strings + +(deftest count-if-string.1 + (count-if #'(lambda (x) (eql x #\0)) "001011101101") + 5) + +(deftest count-if-string.2 + (count-if #'identity "001011101101") + 12) + +(deftest count-if-string.3 + (count-if #'(lambda (x) (break)) "") + 0) + +(deftest count-if-string.4 + (count-if #'identity "001011101101" :key #'(lambda (x) (eql x #\0))) + 5) + +(deftest count-if-string.5 + (count-if 'identity "001011101101" :key #'(lambda (x) (eql x #\0))) + 5) + +(deftest count-if-string.6 + (count-if #'(lambda (x) (eql x #\0)) "001011101101" :key 'identity) + 5) + +(deftest count-if-string.8 + (count-if #'identity "001011101101" :key #'(lambda (x) (eql x #\1))) + 7) + +(deftest count-if-string.11 + (let ((c 0)) + (count-if #'evenp "001011101101" + :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c))))) + 7) + +(deftest count-if-string.12 + (let ((c 0)) + (count-if #'evenp "001011101101" + :from-end t + :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c))))) + 5) + +(deftest count-if-string.13 + (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :start 2) + 4) + +(deftest count-if-string.14 + (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :end 7) + 2) + +(deftest count-if-string.15 + (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :end 7 :start 2) + 1) + +(deftest count-if-string.16 + (count-if #'(lambda (x) (eql x #\0)) + "0111011011100" :end 7 :start 2 :from-end t) + 1) + +(deftest count-if-string.17 + (let ((s (make-array '(10) + :initial-contents "00a0aa0a0a" + :element-type 'character + :fill-pointer 6))) + (values (count-if #'digit-char-p s) + (count-if #'digit-char-p s :end nil) + (count-if #'digit-char-p s :start 1) + (count-if #'digit-char-p s :end 2) + (count-if #'digit-char-p s :start 1 :end 2))) + 3 3 2 2 1) + +;;; Argument order tests + +(deftest count-if.order.1 + (let ((i 0) c1 c2 c3 c4 c5 c6) + (values + (count-if (progn (setf c1 (incf i)) #'null) + (progn (setf c2 (incf i)) '(a nil b c nil d e)) + :start (progn (setf c3 (incf i)) 0) + :end (progn (setf c4 (incf i)) 3) + :key (progn (setf c5 (incf i)) #'identity) + :from-end (progn (setf c6 (incf i)) nil) + ) + i c1 c2 c3 c4 c5 c6)) + 1 6 1 2 3 4 5 6) + +(deftest count-if.order.2 + (let ((i 0) c1 c2 c3 c4 c5 c6) + (values + (count-if (progn (setf c1 (incf i)) #'null) + (progn (setf c2 (incf i)) '(a nil b c nil d e)) + :from-end (progn (setf c3 (incf i)) nil) + :key (progn (setf c4 (incf i)) #'identity) + :end (progn (setf c5 (incf i)) 3) + :start (progn (setf c6 (incf i)) 0) + ) + i c1 c2 c3 c4 c5 c6)) + 1 6 1 2 3 4 5 6) + + +;;; Keyword tests + +(deftest count-if.allow-other-keys.1 + (count-if #'evenp '(1 2 3 4 5) :bad t :allow-other-keys t) + 2) + +(deftest count-if.allow-other-keys.2 + (count-if #'evenp '(1 2 3 4 5) :allow-other-keys #p"*" :also-bad t) + 2) + +;;; The leftmost of two :allow-other-keys arguments is the one that matters. +(deftest count-if.allow-other-keys.3 + (count-if #'evenp '(1 2 3 4 5) + :allow-other-keys t + :allow-other-keys nil + :bad t) + 2) + +(deftest count-if.keywords.4 + (count-if #'evenp '(1 2 3 4 5) :key #'identity :key #'1+) + 2) + +(deftest count-if.allow-other-keys.5 + (count-if #'evenp '(1 2 3 4 5) :allow-other-keys nil) + 2) + + +;;; Error tests + +(deftest count-if.error.1 + (classify-error (count-if #'identity 1)) + type-error) + +(deftest count-if.error.2 + (classify-error (count-if #'identity 'a)) + type-error) + +(deftest count-if.error.3 + (classify-error (count-if #'identity #\a)) + type-error) + +(deftest count-if.error.4 + (classify-error (count-if)) + program-error) + +(deftest count-if.error.5 + (classify-error (count-if #'null)) + program-error) + +(deftest count-if.error.6 + (classify-error (count-if #'null nil :bad t)) + program-error) + +(deftest count-if.error.7 + (classify-error (count-if #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest count-if.error.8 + (classify-error (count-if #'null nil :key)) + program-error) + +(deftest count-if.error.9 + (classify-error (count-if #'null nil 3 3)) + program-error) + +;;; Only leftmost :allow-other-keys argument matters +(deftest count-if.error.10 + (classify-error (count-if #'null nil :bad t + :allow-other-keys nil + :allow-other-keys t)) + program-error) + +(deftest count-if.error.11 + (classify-error (locally (count-if #'identity 1) t)) + type-error) + +(deftest count-if.error.12 + (classify-error (count-if #'cons '(a b c))) + program-error) + +(deftest count-if.error.13 + (classify-error (count-if #'car '(a b c))) + type-error) + +(deftest count-if.error.14 + (classify-error (count-if #'identity '(a b c) :key #'cdr)) + type-error) + +(deftest count-if.error.15 + (classify-error (count-if #'identity '(a b c) :key #'cons)) + program-error) + + diff --git a/ansi-tests/count.lsp b/ansi-tests/count.lsp new file mode 100644 index 0000000..ede89ed --- /dev/null +++ b/ansi-tests/count.lsp @@ -0,0 +1,609 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Aug 19 07:31:55 2002 +;;;; Contains: Tests for COUNT + +(in-package :cl-test) + +(deftest count-list.1 + (count 'a '(a b c d e a e f)) + 2) + +(deftest count-list.2 + (count 'a '(a b c d e a e f) :test #'eql) + 2) + +(deftest count-list.3 + (count 'a '(a b c d e a e f) :test 'eql) + 2) + +(deftest count-list.4 + (count 1 '(1 2 2 3 2 1 2 2 5 4) :key #'1-) + 5) + +(deftest count-list.5 + (count 1 '(1 2 2 3 2 1 2 2 5 4) :key '1-) + 5) + +(deftest count-list.6 + (count 1 '(1 2 2 3 2 1 2 2 5 4) :key #'1- :test #'equal) + 5) + +(deftest count-list.7 + (count 1 '(2 1 1 2 3 1 4 1 7 6 1 8) :from-end t) + 5) + +(deftest count-list.8 + (let ((c 0)) + (count 1 '(1 2 3 1 4 1 7 6 1 8) + :key #'(lambda (x) + ;; (format t "~%~A ~A" x c) + (prog1 (- x c) (incf c))))) + 4) + +(deftest count-list.9 + (let ((c 0)) + (count 1 '(1 2 3 7 4 5 7 6 2 8) + :from-end t + :key #'(lambda (x) + ;; (format t "~%~A ~A" x c) + (prog1 (- x c) (incf c))))) + 3) + +(deftest count-list.10 + (count 1 '(1 1 1 1 1 2 1 1) :start 3) + 4) + +(deftest count-list.11 + (count 1 '(1 1 1 1 1 2 1 1) :end 6) + 5) + +(deftest count-list.12 + (count 1 '(1 1 1 1 1 2 1 1) :start 2 :end 7) + 4) + +(deftest count-list.13 + (count 1 '(1 1 1 1 1 2 1 1) :start 3 :end nil) + 4) + +(deftest count-list.14 + (count 1 '(1 1 1 1 1 2 1 1) :end nil) + 7) + +(deftest count-list.15 + (count 1 '(1 1 1 1 1 2 1 1) :test-not #'eql) + 1) + +(deftest count-list.16 + (count 1 '(1 1 1 3 1 2 1 1) :start 2 :end 7 + :test #'(lambda (x y) (declare (ignore x y)) t)) + 5) + +;;; On vectors + +(deftest count-vector.1 + (count 'a #(a b c d e a e f)) + 2) + +(deftest count-vector.2 + (count 'a #(a b c d e a e f) :test #'eql) + 2) + +(deftest count-vector.3 + (count 'a #(a b c d e a e f) :test 'eql) + 2) + +(deftest count-vector.4 + (count 1 #(1 2 2 3 2 1 2 2 5 4) :key #'1-) + 5) + +(deftest count-vector.5 + (count 1 #(1 2 2 3 2 1 2 2 5 4) :key '1-) + 5) + +(deftest count-vector.6 + (count 1 #(1 2 2 3 2 1 2 2 5 4) :key #'1- :test #'equal) + 5) + +(deftest count-vector.7 + (count 1 #(2 1 1 2 3 1 4 1 7 6 1 8) :from-end t) + 5) + +(deftest count-vector.8 + (let ((c 0)) + (count 1 #(1 2 3 1 4 1 7 6 1 8) + :key #'(lambda (x) + ;; (format t "~%~A ~A" x c) + (prog1 (- x c) (incf c))))) + 4) + +(deftest count-vector.9 + (let ((c 0)) + (count 1 #(1 2 3 7 4 5 7 6 2 8) + :from-end t + :key #'(lambda (x) + ;; (format t "~%~A ~A" x c) + (prog1 (- x c) (incf c))))) + 3) + +(deftest count-vector.10 + (count 1 #(1 1 1 1 1 2 1 1) :start 3) + 4) + +(deftest count-vector.11 + (count 1 #(1 1 1 1 1 2 1 1) :end 6) + 5) + +(deftest count-vector.12 + (count 1 #(1 1 1 1 1 2 1 1) :start 2 :end 7) + 4) + +(deftest count-vector.13 + (count 1 #(1 1 1 1 1 2 1 1) :start 3 :end nil) + 4) + +(deftest count-vector.14 + (count 1 #(1 1 1 1 1 2 1 1) :end nil) + 7) + +(deftest count-vector.15 + (count 1 #(1 1 1 1 1 2 1 1) :test-not #'eql) + 1) + +(deftest count-vector16 + (count 1 #(1 1 1 3 1 2 1 1) :start 2 :end 7 + :test #'(lambda (x y) (declare (ignore x y)) t)) + 5) + +;;; Non-simple vectors + +(deftest count-filled-vector.1 + (count 'a (make-array 8 :initial-contents '(a b c d e a e f) + :fill-pointer t)) + 2) + +(deftest count-filled-vector.2 + (count 'a (make-array 8 :initial-contents '(a b c d e a e f) + :fill-pointer t) + :test #'eql) + 2) + +(deftest count-filled-vector.3 + (count 'a (make-array 8 :initial-contents '(a b c d e a e f) + :fill-pointer t) + :test 'eql) + 2) + +(deftest count-filled-vector.4 + (count 1 (make-array 10 :initial-contents '(1 2 2 3 2 1 2 2 5 4) + :fill-pointer t) + :key #'1-) + 5) + +(deftest count-filled-vector.5 + (count 1 (make-array 10 :initial-contents '(1 2 2 3 2 1 2 2 5 4) + :fill-pointer t) + :key '1-) + 5) + +(deftest count-filled-vector.6 + (count 1 (make-array 10 :initial-contents '(1 2 2 3 2 1 2 2 5 4) + :fill-pointer t) + :key #'1- :test #'equal) + 5) + +(deftest count-filled-vector.7 + (count 1 (make-array 12 :initial-contents '(2 1 1 2 3 1 4 1 7 6 1 8) + :fill-pointer t) + :from-end t) + 5) + +(deftest count-filled-vector.8 + (let ((c 0)) + (count 1 (make-array 10 :initial-contents '(1 2 3 1 4 1 7 6 1 8) + :fill-pointer t) + :key #'(lambda (x) + ;; (format t "~%~A ~A" x c) + (prog1 (- x c) (incf c))))) + 4) + +(deftest count-filled-vector.9 + (let ((c 0)) + (count 1 (make-array 10 :initial-contents '(1 2 3 7 4 5 7 6 2 8) + :fill-pointer t) + :from-end t + :key #'(lambda (x) + ;; (format t "~%~A ~A" x c) + (prog1 (- x c) (incf c))))) + 3) + +(deftest count-filled-vector.10 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1) + :fill-pointer t) + :start 3) + 4) + +(deftest count-filled-vector.11 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1) + :fill-pointer t) + :end 6) + 5) + +(deftest count-filled-vector.12 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1) + :fill-pointer t) + :start 2 :end 7) + 4) + +(deftest count-filled-vector.13 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1) + :fill-pointer t) + :start 3 :end nil) + 4) + +(deftest count-filled-vector.14 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1) + :fill-pointer t) + :end nil) + 7) + +(deftest count-filled-vector.15 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1) + :fill-pointer t) + :test-not #'eql) + 1) + +(deftest count-filled-vector.16 + (count 1 (make-array 8 :initial-contents '(1 1 1 3 1 2 1 1) + :fill-pointer t) + :start 2 :end 7 + :test #'(lambda (x y) (declare (ignore x y)) t)) + 5) + +(deftest count-filled-vector.17 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1) + :fill-pointer 6)) + 6) + +(deftest count-filled-vector.18 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1) + :fill-pointer 6) + :start 2) + 4) +(deftest count-filled-vector.19 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1) + :fill-pointer 6) + :from-end 'foo) + 6) + +(deftest count-filled-vector.20 + (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1) + :fill-pointer 6) + :start 2 :from-end 'yes) + 4) + + + +;;; Tests on bit vectors + +(deftest count-bit-vector.1 + (count 1 #*00101100011011000) + 7) + +(deftest count-bit-vector.2 + (count 1 #*00101100011011000 :test #'eql) + 7) + +(deftest count-bit-vector.3 + (count 1 #*00101100011011000 :test 'eql) + 7) + +(deftest count-bit-vector.4 + (count 1 #*00101100011011000 :key #'1+) + 10) + +(deftest count-bit-vector.5 + (count 0 #*00101100011011000 :key '1-) + 7) + +(deftest count-bit-vector.6 + (count 0 #*00101100011011000 :key #'1- :test #'equal) + 7) + +(deftest count-bit-vector.7 + (count 1 #*00101100011011000 :from-end t) + 7) + +(deftest count-bit-vector.8 + (let ((c 1)) + (count 0 #*0000110101001 + :key #'(lambda (x) (setf c (- c)) (+ c x)))) + 2) + +(deftest count-bit-vector.9 + (let ((c 1)) + (count 0 #*0000011010101 + :from-end t + :key #'(lambda (x) (setf c (- c)) (+ c x)))) + 4) + +(deftest count-bit-vector.10 + (count 1 #*11000110110 :start 3) + 4) + +(deftest count-bit-vector.11 + (count 1 '#*110111110111 :end 6) + 5) + +(deftest count-bit-vector.12 + (count 1 #*11111011 :start 2 :end 7) + 4) + +(deftest count-bit-vector.13 + (count 1 #*11111011 :start 3 :end nil) + 4) + +(deftest count-bit-vector.14 + (count 1 #*11111011 :end nil) + 7) + +(deftest count-bit-vector.15 + (count 1 #*11111011 :test-not #'eql) + 1) + +(deftest count-bit-vector.16 + (count 1 #*11101101 :start 2 :end 7 + :test #'(lambda (x y) (declare (ignore x y)) t)) + 5) + +(deftest count-bit-vector.17 + (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1) + :element-type 'bit + :fill-pointer 5)) + 4) + +(deftest count-bit-vector.18 + (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1) + :element-type 'bit + :fill-pointer 5) + :start 1) + 3) + +(deftest count-bit-vector.19 + (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1) + :element-type 'bit + :fill-pointer 5) + :end nil) + 4) + + +(deftest count-bit-vector.20 + (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1) + :element-type 'bit + :fill-pointer 6) + :end 4) + 3) + + +;;; Tests on strings + +(deftest count-string.1 + (count #\1 "00101100011011000") + 7) + +(deftest count-string.2 + (count #\1 "00101100011011000" :test #'eql) + 7) + +(deftest count-string.3 + (count #\1 "00101100011011000" :test 'eql) + 7) + +(deftest count-string.4 + (count #\1 "00101100011011000" :key #'(lambda (x) (if (eql x #\0) #\1 #\2))) + 10) + +(deftest count-string.5 + (count #\1 "00101100011011000" :key 'identity) + 7) + +(deftest count-string.6 + (count #\1 "00101100011011000" :key #'identity :test #'equal) + 7) + +(deftest count-string.7 + (count #\1 "00101100011011000" :from-end t) + 7) + +(deftest count-string.8 + (let ((c nil)) + (count #\0 "0000110101001" + :key #'(lambda (x) (setf c (not c)) + (and c x)))) + 5) + +(deftest count-string.9 + (let ((c nil)) + (count #\0 "0000011010101" + :from-end t + :key #'(lambda (x) (setf c (not c)) + (and c x)))) + 3) + +(deftest count-string.10 + (count #\1 "11000110110" :start 3) + 4) + +(deftest count-string.11 + (count #\1 '"110111110111" :end 6) + 5) + +(deftest count-string.12 + (count #\1 "11111011" :start 2 :end 7) + 4) + +(deftest count-string.13 + (count #\1 "11111011" :start 3 :end nil) + 4) + +(deftest count-string.14 + (count #\1 "11111011" :end nil) + 7) + +(deftest count-string.15 + (count #\1 "11111011" :test-not #'eql) + 1) + +(deftest count-string.16 + (count #\1 "11101101" :start 2 :end 7 + :test #'(lambda (x y) (declare (ignore x y)) t)) + 5) + +(deftest count-string.17 + (count #\a (make-array 10 :initial-contents "abaaacaaaa" + :fill-pointer 7 + :element-type 'character)) + 5) + +(deftest count-string.18 + (count #\a (make-array 10 :initial-contents "abaaacaaaa" + :fill-pointer 7 + :element-type 'character) + :start 1) + 4) + +(deftest count-string.19 + (count #\a (make-array 10 :initial-contents "abaaacaaaa" + :fill-pointer 7 + :element-type 'character) + :end nil) + 5) + +(deftest count-string.20 + (count #\a (make-array 10 :initial-contents "abaaacaaaa" + :fill-pointer 7 + :element-type 'character) + :start 2 :end 5) + 3) + +;;; Argument order tests + +(deftest count.order.1 + (let ((i 0) c1 c2 c3 c4 c5 c6 c7) + (values + (count (progn (setf c1 (incf i)) nil) + (progn (setf c2 (incf i)) '(a nil b c nil d e)) + :start (progn (setf c3 (incf i)) 0) + :end (progn (setf c4 (incf i)) 3) + :key (progn (setf c5 (incf i)) #'identity) + :from-end (progn (setf c6 (incf i)) nil) + :test (progn (setf c7 (incf i)) #'eql) + ) + i c1 c2 c3 c4 c5 c6 c7)) + 1 7 1 2 3 4 5 6 7) + +(deftest count.order.2 + (let ((i 0) c1 c2 c3 c4 c5 c6 c7) + (values + (count (progn (setf c1 (incf i)) nil) + (progn (setf c2 (incf i)) '(a nil b c nil d e)) + :test (progn (setf c3 (incf i)) #'eql) + :from-end (progn (setf c4 (incf i)) nil) + :key (progn (setf c5 (incf i)) #'identity) + :end (progn (setf c6 (incf i)) 3) + :start (progn (setf c7 (incf i)) 0) + ) + i c1 c2 c3 c4 c5 c6 c7)) + 1 7 1 2 3 4 5 6 7) + + +;;; Keyword tests + +(deftest count.allow-other-keys.1 + (count 'a '(b a d a c) :bad t :allow-other-keys t) + 2) + +(deftest count.allow-other-keys.2 + (count 'a '(b a d a c) :allow-other-keys #p"*" :also-bad t) + 2) + +;;; The leftmost of two :allow-other-keys arguments is the one that matters. +(deftest count.allow-other-keys.3 + (count 'a '(b a d a c) + :allow-other-keys t + :allow-other-keys nil + :bad t) + 2) + +(deftest count.keywords.4 + (count 2 '(1 2 3 2 5) :key #'identity :key #'1+) + 2) + +(deftest count.allow-other-keys.5 + (count 'a '(a b c a) :allow-other-keys nil) + 2) + +;;; Error tests + +(deftest count.error.1 + (classify-error (count 'a 1)) + type-error) + +(deftest count.error.2 + (classify-error (count 'a 'a)) + type-error) + +(deftest count.error.3 + (classify-error (count 'a #\a)) + type-error) + +(deftest count.error.4 + (classify-error (count)) + program-error) + +(deftest count.error.5 + (classify-error (count nil)) + program-error) + +(deftest count.error.6 + (classify-error (count nil nil :bad t)) + program-error) + +(deftest count.error.7 + (classify-error (count nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest count.error.8 + (classify-error (count nil nil :key)) + program-error) + +(deftest count.error.9 + (classify-error (count nil nil 3 3)) + program-error) + +;;; Only leftmost :allow-other-keys argument matters +(deftest count.error.10 + (classify-error (count 'a nil :bad t + :allow-other-keys nil + :allow-other-keys t)) + program-error) + +(deftest count.error.11 + (classify-error (locally (count 'a 1) t)) + type-error) + +(deftest count.error.12 + (classify-error (count 'b '(a b c) :test #'identity)) + program-error) + +(deftest count.error.13 + (classify-error (count 'b '(a b c) :key #'car)) + type-error) + +(deftest count.error.14 + (classify-error (count 'b '(a b c) :test-not #'identity)) + program-error) + +(deftest count.error.15 + (classify-error (count 'b '(a b c) :key #'cons)) + program-error) diff --git a/ansi-tests/ctypecase.lsp b/ansi-tests/ctypecase.lsp new file mode 100644 index 0000000..7e7ea50 --- /dev/null +++ b/ansi-tests/ctypecase.lsp @@ -0,0 +1,88 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 23:05:10 2002 +;;;; Contains: Tests of CTYPECASE + +(in-package :cl-test) + +(deftest ctypecase.1 + (let ((x 1)) + (ctypecase x (integer 'a) (t 'b))) + a) + +(deftest ctypecase.2 + (classify-error + (let ((x 1)) + (ctypecase x (symbol 'a)))) + type-error) + +(deftest ctypecase.3 + (let ((x 1)) + (ctypecase x (symbol 'a) (t 'b))) + b) + +(deftest ctypecase.4 + (let ((x 1)) + (ctypecase x (t (values))))) + +(deftest ctypecase.5 + (let ((x 1)) + (ctypecase x (integer (values)) (t 'a)))) + +(deftest ctypecase.6 + (let ((x 1)) + (ctypecase x (bit 'a) (integer 'b))) + a) + +(deftest ctypecase.7 + (let ((x 1)) + (ctypecase x (t 'a))) + a) + +(deftest ctypecase.8 + (let ((x 1)) + (ctypecase x (t (values 'a 'b 'c)))) + a b c) + +(deftest ctypecase.9 + (let ((x 1)) + (ctypecase x (integer (values 'a 'b 'c)) (t nil))) + a b c) + +(deftest ctypecase.10 + (let ((x 0) (y 1)) + (values + (ctypecase y + (bit (incf x) 'a) + (integer (incf x 2) 'b) + (t (incf x 4) 'c)) + x)) + a 1) + +(deftest ctypecase.11 + (let ((x 1)) + (ctypecase x (integer) (t 'a))) + nil) + +(deftest ctypecase.12 + (let ((x 1)) + (values + (handler-bind + ((type-error #'(lambda (c) (store-value 'a c)))) + (ctypecase x + (symbol :good) + (float :bad))) + x)) + :good a) + +;;; (deftest ctypecase.error.1 +;;; (classify-error (ctypecase)) +;;; program-error) + + +(deftest ctypecase.13 + (ctypecase 'a + (number 'bad) + (#.(find-class 'symbol nil) 'good)) + good) + diff --git a/ansi-tests/data-and-control-flow.lsp b/ansi-tests/data-and-control-flow.lsp new file mode 100644 index 0000000..86437dc --- /dev/null +++ b/ansi-tests/data-and-control-flow.lsp @@ -0,0 +1,34 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 21 22:21:48 2002 +;;;; Contains: Overall tests for section 5 of spec, "Data and Control Flow" + +(in-package :cl-test) + +;;; Functions from section 5 +(defparameter *dcf-fns* + '(apply fboundp fmakunbound funcall function-lambda-expression + functionp compiled-function-p not eq eql equal equalp identity + complement constantly every some notevery notany + values-list get-setf-expansion)) + +;;; Macros from section 5 +(defparameter *dcf-macros* + '(defun defconstant defparameter defvar destructuring-bind + psetq return and cond or when unless case ccase ecase + multiple-value-list multiple-value-setq nth-value + prog prog* prog1 prog2 define-modify-macro defsetf + define-setf-expander setf psetf shiftf rotatef)) + +(deftest dcf-funs + (remove-if #'fboundp *dcf-fns*) + nil) + +(deftest dcf-macros + (remove-if #'macro-function *dcf-macros*) + nil) + + + + + \ No newline at end of file diff --git a/ansi-tests/defconstant.lsp b/ansi-tests/defconstant.lsp new file mode 100644 index 0000000..f0b132c --- /dev/null +++ b/ansi-tests/defconstant.lsp @@ -0,0 +1,45 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 10 23:05:39 2002 +;;;; Contains: Tests of DEFCONSTANT + +(in-package :cl-test) + +(defconstant test-constant-1 17) + +(deftest defconstant.1 + (symbol-value 'test-constant-1) + 17) + +(deftest defconstant.2 + (notnot-mv (constantp 'test-constant-1)) + t) + +(deftest defconstant.3 + (documentation 'test-constant-1 'variable) + nil) + +(defconstant test-constant-2 'a + "This is the documentation.") + +(deftest defconstant.4 + (documentation 'test-constant-2 'variable) + "This is the documentation.") + +(deftest defconstant.5 + (defconstant test-constant-3 0) + test-constant-3) + +;;; (deftest defconstant.error.1 +;;; (classify-error (defconstant)) +;;; program-error) +;;; +;;; (deftest defconstant.error.2 +;;; (classify-error (defconstant +ignorable-constant-name+)) +;;; program-error) +;;; +;;; (deftest defconstant.error.3 +;;; (classify-error (defconstant +ignorable-constant-name2+ nil +;;; "This is a docstring" +;;; "This is an unnecessary extra argument.")) +;;; program-error) diff --git a/ansi-tests/define-modify-macro.lsp b/ansi-tests/define-modify-macro.lsp new file mode 100644 index 0000000..e1d4381 --- /dev/null +++ b/ansi-tests/define-modify-macro.lsp @@ -0,0 +1,83 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 11:42:14 2002 +;;;; Contains: Tests of DEFINE-MODIFY-MACRO + +(in-package :cl-test) + +(deftest define-modify-macro.1 + (values + (eval '(define-modify-macro dmm1-appendf (&rest args) + append "Append lists onto a list")) + (eval + '(let ((u '(p q r)) v) + (list + (setq v u) + (dmm1-appendf u '(a b c d)) + (dmm1-appendf u ()) + (dmm1-appendf u '(e f g)) + u + v)))) + dmm1-appendf + ((p q r) + (p q r a b c d) + (p q r a b c d) + (p q r a b c d e f g) + (p q r a b c d e f g) + (p q r))) + +(deftest define-modify-macro.2 + (values + (eval '(define-modify-macro new-incf (&optional (delta 1)) +)) + (eval + '(let ((i 10)) + (list + (new-incf i) + (new-incf i 100) + i)))) + new-incf + (11 111 111)) + +(deftest define-modify-macro.3 + (values + (eval '(define-modify-macro new-incf1 (&optional (delta 1)) +)) + (eval + '(let ((a (vector 0 0 0 0 0)) + (i 1)) + (list + (new-incf1 (aref a (incf i))) + a + i)))) + new-incf1 + (1 #(0 0 1 0 0) 2)) + +(deftest define-modify-macro.4 + (values + (eval '(define-modify-macro new-incf2 (&optional (delta 1)) +)) + (eval + '(let ((a (vector 0 0 0 0 0)) + (i 1)) + (list + (new-incf2 (aref a (incf i)) (incf i)) + a + i)))) + new-incf2 + (3 #(0 0 3 0 0) 3)) + +;;; (deftest define-modify-macro.error.1 +;;; (classify-error (define-modify-macro)) +;;; program-error) +;;; +;;; (deftest define-modify-macro.error.2 +;;; (classify-error (define-modify-macro dfm-error-1)) +;;; program-error) +;;; +;;; (deftest define-modify-macro.error.3 +;;; (classify-error (define-modify-macro dfm-error-2 ())) +;;; program-error) +;;; +;;; (deftest define-modify-macro.error.4 +;;; (classify-error (define-modify-macro dfm-error-2 () nil "Documentation" +;;; "extra illegal argument")) +;;; program-error) + diff --git a/ansi-tests/defparameter.lsp b/ansi-tests/defparameter.lsp new file mode 100644 index 0000000..4cc3c90 --- /dev/null +++ b/ansi-tests/defparameter.lsp @@ -0,0 +1,66 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 10 23:13:22 2002 +;;;; Contains: Tests of DEFPARAMETER + +(in-package :cl-test) + +(defparameter *defparameter-test-var-1* 100) + +(deftest defparameter.1 + *defparameter-test-var-1* + 100) + +(deftest defparameter.2 + (documentation '*defparameter-test-var-1* 'variable) + nil) + +;;; Show that it's declared special. +(deftest defparameter.3 + (flet ((%f () *defparameter-test-var-1*)) + (let ((*defparameter-test-var-1* 29)) + (%f))) + 29) + +(deftest defparameter.4 + (values + (makunbound '*defparameter-test-var-2*) + (defparameter *defparameter-test-var-2* 200 "Whatever.") + (documentation '*defparameter-test-var-2* 'variable) + *defparameter-test-var-2*) + *defparameter-test-var-2* + *defparameter-test-var-2* + "Whatever." + 200) + +(deftest defparameter.5 + (values + (makunbound '*defparameter-test-var-2*) + (defparameter *defparameter-test-var-2* 200 "Whatever.") + (documentation '*defparameter-test-var-2* 'variable) + *defparameter-test-var-2* + (defparameter *defparameter-test-var-2* 300 "And ever.") + (documentation '*defparameter-test-var-2* 'variable) + *defparameter-test-var-2* + ) + *defparameter-test-var-2* + *defparameter-test-var-2* + "Whatever." + 200 + *defparameter-test-var-2* + "And ever." + 300) + +;;; (deftest defparameter.error.1 +;;; (classify-error (defparameter)) +;;; program-error) +;;; +;;; (deftest defparameter.error.2 +;;; (classify-error (defparameter *ignored-defparameter-name*)) +;;; program-error) +;;; +;;; (deftest defparameter.error.3 +;;; (classify-error (defparameter *ignored-defparameter-name* nil +;;; "documentation" +;;; "illegal extra argument")) +;;; program-error) diff --git a/ansi-tests/defun.lsp b/ansi-tests/defun.lsp new file mode 100644 index 0000000..f7e29a9 --- /dev/null +++ b/ansi-tests/defun.lsp @@ -0,0 +1,19 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Feb 16 23:40:32 2003 +;;;; Contains: Tests of DEFUN + +(in-package :cl-test) + +;;; DEFUN is used extensively elsewhere, so I'm just putting error +;;; case tests here + +#| +(deftest defun.error.1 + (classify-error (defun)) + program-error) + +(deftest defun.error.2 + (classify-error (defun ignored-defun-name)) + program-error) +|# diff --git a/ansi-tests/defvar.lsp b/ansi-tests/defvar.lsp new file mode 100644 index 0000000..02aadc8 --- /dev/null +++ b/ansi-tests/defvar.lsp @@ -0,0 +1,64 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 10 23:21:50 2002 +;;;; Contains: Tests for DEFVAR + +(in-package :cl-test) + +(defvar *defvar-test-var-1* 100) + +(deftest defvar.1 + *defvar-test-var-1* + 100) + +(deftest defvar.2 + (documentation '*defvar-test-var-1* 'variable) + nil) + +;;; Show that it's declared special. +(deftest defvar.3 + (flet ((%f () *defvar-test-var-1*)) + (let ((*defvar-test-var-1* 29)) + (%f))) + 29) + +(deftest defvar.4 + (values + (makunbound '*defvar-test-var-2*) + (defvar *defvar-test-var-2* 200 "Whatever.") + (documentation '*defvar-test-var-2* 'variable) + *defvar-test-var-2*) + *defvar-test-var-2* + *defvar-test-var-2* + "Whatever." + 200) + +(deftest defvar.5 + (let ((x 0)) + (values + (makunbound '*defvar-test-var-2*) + (defvar *defvar-test-var-2* 200 "Whatever.") + (documentation '*defvar-test-var-2* 'variable) + *defvar-test-var-2* + (defvar *defvar-test-var-2* (incf x) "And ever.") + (documentation '*defvar-test-var-2* 'variable) + *defvar-test-var-2* + x + )) + *defvar-test-var-2* + *defvar-test-var-2* + "Whatever." + 200 + *defvar-test-var-2* + "And ever." + 200 + 0) + +;;; (deftest defvar.error.1 +;;; (classify-error (defvar)) +;;; program-error) +;;; +;;; (deftest defvar.error.2 +;;; (classify-error (defvar *ignored-defvar-name* nil "documentation" +;;; "illegal extra argument")) +;;; program-error) diff --git a/ansi-tests/delete-file.lsp b/ansi-tests/delete-file.lsp new file mode 100644 index 0000000..99a958e --- /dev/null +++ b/ansi-tests/delete-file.lsp @@ -0,0 +1,95 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 13 18:42:29 2004 +;;;; Contains: Tests for DELETE-FILE + +(in-package :cl-test) + +(deftest delete-file.1 + (let ((pn "scratchfile.txt")) + (unless (probe-file pn) + (with-open-file (s pn :direction :output) + (format s "Contents~%"))) + (values + (notnot (probe-file pn)) + (multiple-value-list (delete-file pn)) + (probe-file pn))) + t (t) nil) + +(deftest delete-file.2 + (let ((pn #p"scratchfile.txt")) + (unless (probe-file pn) + (with-open-file (s pn :direction :output) + (format s "Contents~%"))) + (values + (notnot (probe-file pn)) + (multiple-value-list (delete-file pn)) + (probe-file pn))) + t (t) nil) + +(deftest delete-file.3 + (let ((pn "CLTEST:SCRATCHFILE.TXT")) + (assert (typep (pathname pn) 'logical-pathname)) + (unless (probe-file pn) + (with-open-file (s pn :direction :output) + (format s "Contents~%"))) + (values + (notnot (probe-file pn)) + (multiple-value-list (delete-file pn)) + (probe-file pn))) + t (t) nil) + +(deftest delete-file.4 + (let ((pn "CLTEST:SCRATCHFILE.TXT")) + (assert (typep (pathname pn) 'logical-pathname)) + (unless (probe-file pn) + (with-open-file (s pn :direction :output) + (format s "Contents~%"))) + (let ((s (open pn :direction :input))) + (close s) + (values + (notnot (probe-file pn)) + (multiple-value-list (delete-file s)) + (probe-file pn)))) + t (t) nil) + +;;; Specialized string tests + +(deftest delete-file.5 + (do-special-strings + (pn "scratchfile.txt" nil) + (unless (probe-file pn) + (with-open-file (s pn :direction :output) + (format s "Contents~%"))) + (assert (probe-file pn)) + (assert (equal (multiple-value-list (delete-file pn)) '(t))) + (assert (not (probe-file pn)))) + nil) + +;;; Error tests + +(deftest delete-file.error.1 + (signals-error (delete-file) program-error) + t) + +(deftest delete-file.error.2 + (let ((pn "scratch.txt")) + (unless (probe-file pn) + (with-open-file (s pn :direction :output) + (format s "Contents~%"))) + (values + (notnot (probe-file pn)) + (signals-error (delete-file "scratch.txt" nil) program-error) + (notnot (probe-file pn)) + (delete-file pn) + (probe-file pn))) + t t t t nil) + +#| +(deftest delete-file.error.3 + (let ((pn "nonexistent.txt")) + (when (probe-file pn) (delete-file pn)) + (signals-error (delete-file "nonexistent.txt") file-error)) + t) +|# + diff --git a/ansi-tests/destructuring-bind.lsp b/ansi-tests/destructuring-bind.lsp new file mode 100644 index 0000000..d24eb5c --- /dev/null +++ b/ansi-tests/destructuring-bind.lsp @@ -0,0 +1,110 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 10 23:25:50 2002 +;;;; Contains: Tests for DESTRUCTURING-BIND + +(in-package :cl-test) + +;;; See the page for this in section 5.3 +;;; Also, see destructuring lambda lists in section 3.4.5 + +(deftest destructuring-bind.1 + (destructuring-bind (x y z) '(a b c) (values x y z)) + a b c) + +(deftest destructuring-bind.2 + (destructuring-bind (x y &rest z) '(a b c d) (values x y z)) + a b (c d)) + +(deftest destructuring-bind.3 + (destructuring-bind (x y &optional z) '(a b c) (values x y z)) + a b c) + +(deftest destructuring-bind.4 + (destructuring-bind (x y &optional z) '(a b) (values x y z)) + a b nil) + +(deftest destructuring-bind.5 + (destructuring-bind (x y &optional (z 'w)) '(a b) (values x y z)) + a b w) + +(deftest destructuring-bind.6 + (destructuring-bind (x y &optional (z 'w z-p)) '(a b) (values x y z z-p)) + a b w nil) + +(deftest destructuring-bind.7 + (destructuring-bind (x y &optional (z 'w z-p)) '(a b c) (values x y z z-p)) + a b c t) + +(deftest destructuring-bind.8 + (destructuring-bind (x y &optional z w) '(a b c) (values x y z w)) + a b c nil) + +(deftest destructuring-bind.9 + (destructuring-bind ((x y)) '((a b)) (values x y)) + a b) + +(deftest destructuring-bind.10 + (destructuring-bind (&whole w (x y)) '((a b)) (values x y w)) + a b ((a b))) + +(deftest destructuring-bind.11 + (destructuring-bind ((x . y) . w) '((a b) c) (values x y w)) + a (b) (c)) + +(deftest destructuring-bind.12 + (destructuring-bind (x y &body z) '(a b c d) (values x y z)) + a b (c d)) + +(deftest destructuring-bind.13 + (destructuring-bind (&whole x y z) '(a b) (values x y z)) + (a b) a b) + +(deftest destructuring-bind.14 + (destructuring-bind (w (&whole x y z)) '(1 (a b)) (values w x y z)) + 1 (a b) a b) + +(deftest destructuring-bind.15 + (destructuring-bind (&key a b c) '(:a 1) (values a b c)) + 1 nil nil) + +(deftest destructuring-bind.16 + (destructuring-bind (&key a b c) '(:b 1) (values a b c)) + nil 1 nil) + +(deftest destructuring-bind.17 + (destructuring-bind (&key a b c) '(:c 1) (values a b c)) + nil nil 1) + +(deftest destructuring-bind.18 + (destructuring-bind ((&key a b c)) '((:c 1 :b 2)) (values a b c)) + nil 2 1) + +;;; Error cases + +#| +(deftest destructuring-bind.error.1 + (classify-error (destructuring-bind (a b c) nil (list a b c))) + program-error) + +(deftest destructuring-bind.error.2 + (classify-error (destructuring-bind ((a b c)) nil (list a b c))) + program-error) + +(deftest destructuring-bind.error.3 + (classify-error (destructuring-bind (a b) 'x (list a b))) + program-error) + +(deftest destructuring-bind.error.4 + (classify-error (destructuring-bind (a . b) 'x (list a b))) + program-error) +|# + +;;; (deftest destructuring-bind.error.5 +;;; (classify-error (destructuring-bind)) +;;; program-error) +;;; +;;; (deftest destructuring-bind.error.6 +;;; (classify-error (destructuring-bind x)) +;;; program-error) + diff --git a/ansi-tests/directory-namestring.lsp b/ansi-tests/directory-namestring.lsp new file mode 100644 index 0000000..a330001 --- /dev/null +++ b/ansi-tests/directory-namestring.lsp @@ -0,0 +1,50 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Sep 12 06:21:42 2004 +;;;; Contains: Tests for DIRECTORY-NAMESTRING + +(in-package :cl-test) + +(deftest directory-namestring.1 + (let* ((vals (multiple-value-list + (directory-namestring "directory-namestring.lsp"))) + (s (first vals))) + (if (and (null (cdr vals)) + (stringp s) + (equal (directory-namestring s) s)) + :good + vals)) + :good) + +(deftest directory-namestring.2 + (do-special-strings + (s "directory-namestring.lsp" nil) + (let ((ns (directory-namestring s))) + (assert (stringp ns)) + (assert (string= (directory-namestring ns) ns)))) + nil) + +;;; Lispworks makes another assumption about filename normalization +;;; when using file streams as pathname designators, so this test +;;; doesn't work there. +;;; (This is another example of the difficulty of testing a feature +;;; in which so much is left up to the implementation.) +#-lispworks +(deftest directory-namestring.3 + (let* ((name "directory-namestring.lsp") + (pn (merge-pathnames (pathname name))) + (name2 (with-open-file (s pn :direction :input) + (directory-namestring s))) + (name3 (directory-namestring pn))) + (or (equalt name2 name3) (list name2 name3))) + t) + +;;; Error tests + +(deftest directory-namestring.error.1 + (signals-error (directory-namestring) program-error) + t) + +(deftest directory-namestring.error.2 + (signals-error (directory-namestring "directory-namestring.lsp" nil) program-error) + t) diff --git a/ansi-tests/directory.lsp b/ansi-tests/directory.lsp new file mode 100644 index 0000000..2cc7085 --- /dev/null +++ b/ansi-tests/directory.lsp @@ -0,0 +1,71 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 1 12:00:18 2004 +;;;; Contains: Tests of DIRECTORY + +(in-package :cl-test) + +(deftest directory.1 + (directory "nonexistent") + nil) + +(deftest directory.2 + (directory #p"nonexistent") + nil) + +(deftest directory.3 + (directory "nonexistent" :allow-other-keys nil) + nil) + +(deftest directory.4 + (directory "nonexistent" :allow-other-keys t :foo 'bar) + nil) + +(deftest directory.5 + (directory "nonexistent" :foo 0 :allow-other-keys t) + nil) + +(deftest directory.6 + (let* ((pattern-pathname (make-pathname :name :wild :type :wild + :defaults *default-pathname-defaults*)) + (pathnames (directory pattern-pathname))) + (values + (remove-if #'pathnamep pathnames) + (loop for pn in pathnames + unless (equal pn (truename pn)) + collect pn) +;; (loop for pn in pathnames +;; unless (pathname-match-p pn pattern-pathname) +;; collect pn)) + )) + nil nil ;; nil + ) + +(deftest directory.7 + (let* ((pattern-pathname (make-pathname :name :wild :type :wild + :defaults *default-pathname-defaults*)) + (pathnames (directory pattern-pathname))) + (loop for pn in pathnames + unless (equal pn (probe-file pn)) + collect pn)) + nil) + +(deftest directory.8 + (let* ((pathname-pattern "CLTEST:*.*") + (len (length (directory pathname-pattern)))) + (if (< len 300) len nil)) + nil) + +;;; Specialized string tests + +(deftest directory.9 + (do-special-strings + (s "nonexistent" nil) + (assert (null (directory s)))) + nil) + +;;; Error tests + +(deftest directory.error.1 + (signals-error (directory) program-error) + t) diff --git a/ansi-tests/ecase.lsp b/ansi-tests/ecase.lsp new file mode 100644 index 0000000..ed47af8 --- /dev/null +++ b/ansi-tests/ecase.lsp @@ -0,0 +1,149 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 20:17:30 2002 +;;;; Contains: Tests for ECASE + +(in-package :cl-test) + +(deftest ecase.1 + (ecase 'b (a 1) (b 2) (c 3)) + 2) + +(deftest ecase.2 + (classify-error (ecase 1)) + type-error) + +(deftest ecase.3 + (classify-error (ecase 1 (a 1) (b 2) (c 3))) + type-error) + +;;; It is legal to use T or OTHERWISE as key designators +;;; in ECASE forms. They have no special meaning here. + +(deftest ecase.4 + (classify-error (ecase 1 (t nil))) + type-error) + +(deftest ecase.5 + (classify-error (ecase 1 (otherwise nil))) + type-error) + +(deftest ecase.6 + (ecase 'b ((a z) 1) ((y b w) 2) ((b c) 3)) + 2) + +(deftest ecase.7 + (ecase 'z + ((a b c) 1) + ((d e) 2) + ((f z g) 3)) + 3) + +(deftest ecase.8 + (ecase (1+ most-positive-fixnum) + (#.(1+ most-positive-fixnum) 'a)) + a) + +(deftest ecase.9 + (classify-error (ecase nil (nil 'a))) + type-error) + +(deftest ecase.10 + (ecase nil ((nil) 'a)) + a) + +(deftest ecase.11 + (ecase 'a (b 0) (a (values 1 2 3)) (c nil)) + 1 2 3) + +(deftest ecase.12 + (classify-error (ecase t (a 10))) + type-error) + +(deftest ecase.13 + (ecase t ((t) 10) (t 20)) + 10) + +(deftest ecase.14 + (let ((x (list 'a 'b))) + (eval `(ecase (quote ,x) ((,x) 1) (a 2)))) + 1) + +(deftest ecase.15 + (classify-error (ecase 'otherwise ((t) 10))) + type-error) + +(deftest ecase.16 + (classify-error (ecase t ((otherwise) 10))) + type-error) + +(deftest ecase.17 + (classify-error (ecase 'a (b 0) (c 1) (otherwise 2))) + type-error) + +(deftest ecase.18 + (classify-error (ecase 'a (b 0) (c 1) ((otherwise) 2))) + type-error) + +(deftest ecase.19 + (classify-error (ecase 'a (b 0) (c 1) ((t) 2))) + type-error) + +(deftest ecase.20 + (ecase #\a + ((#\b #\c) 10) + ((#\d #\e #\A) 20) + (() 30) + ((#\z #\a #\y) 40)) + 40) + +(deftest ecase.21 (ecase 1 (1 (values)) (2 'a))) + +(deftest ecase.23 (ecase 1 (1 (values 'a 'b 'c))) + a b c) + +;;; Show that the key expression is evaluated only once. +(deftest ecase.25 + (let ((x 0)) + (values + (ecase (progn (incf x) 'c) + (a 1) + (b 2) + (c 3) + (d 4)) + x)) + 3 1) + +;;; Repeated keys are allowed (all but the first are ignored) + +(deftest ecase.26 + (ecase 'b ((a b c) 10) (b 20)) + 10) + +(deftest ecase.27 + (ecase 'b (b 20) ((a b c) 10)) + 20) + +(deftest ecase.28 + (ecase 'b (b 20) (b 10) (d 0)) + 20) + +;;; There are implicit progns + +(deftest ecase.29 + (let ((x nil)) + (values + (ecase 2 + (1 (setq x 'a) 'w) + (2 (setq x 'b) 'y) + (3 (setq x 'c) 'z)) + x)) + y b) + +(deftest ecase.31 + (ecase (values 'b 'c) (c 0) ((a b) 10) (d 20)) + 10) + +(deftest ecase.32 + (ecase 'a (a) (b 'b)) + nil) diff --git a/ansi-tests/echo-stream-input-stream.lsp b/ansi-tests/echo-stream-input-stream.lsp new file mode 100644 index 0000000..d654cc1 --- /dev/null +++ b/ansi-tests/echo-stream-input-stream.lsp @@ -0,0 +1,27 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Feb 12 04:30:40 2004 +;;;; Contains: Tests of ECHO-STREAM-INPUT-STREAM + +(in-package :cl-test) + +(deftest echo-stream-input-stream.1 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (equalt (multiple-value-list (echo-stream-input-stream s)) + (list is))) + t) + +(deftest echo-stream-input-stream.error.1 + (signals-error (echo-stream-input-stream) program-error) + t) + +(deftest echo-stream-input-stream.error.2 + (signals-error (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (echo-stream-input-stream s nil)) + program-error) + t) + diff --git a/ansi-tests/echo-stream-output-stream.lsp b/ansi-tests/echo-stream-output-stream.lsp new file mode 100644 index 0000000..769bfc3 --- /dev/null +++ b/ansi-tests/echo-stream-output-stream.lsp @@ -0,0 +1,26 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Feb 12 04:32:33 2004 +;;;; Contains: Tests off ECHO-STREAM-OUTPUT-STREAM + +(in-package :cl-test) + +(deftest echo-stream-output-stream.1 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (equalt (multiple-value-list (echo-stream-output-stream s)) + (list os))) + t) + +(deftest echo-stream-output-stream.error.1 + (signals-error (echo-stream-output-stream) program-error) + t) + +(deftest echo-stream-output-stream.error.2 + (signals-error (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (echo-stream-output-stream s nil)) + program-error) + t) diff --git a/ansi-tests/elt.lsp b/ansi-tests/elt.lsp new file mode 100644 index 0000000..16698cc --- /dev/null +++ b/ansi-tests/elt.lsp @@ -0,0 +1,368 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 19:38:29 2002 +;;;; Contains: Tests of ELT + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +;; elt on lists + +(deftest elt.1 + (classify-error (elt nil 0)) + type-error) + +(deftest elt.1a + (classify-error (elt nil -10)) + type-error) + +(deftest elt.1b + (classify-error (locally (elt nil 0) t)) + type-error) + +(deftest elt.2 + (classify-error (elt nil 1000000)) + type-error) + +(deftest elt.3 (elt '(a b c d e) 0) a) +(deftest elt.4 (elt '(a b c d e) 2) c) +(deftest elt.5 (elt '(a b c d e) 4) e) +(deftest elt.5a + (classify-error (elt '(a b c d e) -4)) + type-error) + +(deftest elt.6 + (let ((x (make-int-list 1000))) + (notnot-mv + (every + #'(lambda (i) (eql i (elt x i))) + x))) + t) + +(deftest elt.7 + (let* ((x (list 'a 'b 'c 'd)) + (y (setf (elt x 0) 'e))) + (list x y)) + ((e b c d) e)) + +(deftest elt.8 + (let* ((x (list 'a 'b 'c 'd)) + (y (setf (elt x 1) 'e))) + (list x y)) + ((a e c d) e)) + +(deftest elt.9 + (let* ((x (list 'a 'b 'c 'd)) + (y (setf (elt x 3) 'e))) + (list x y)) + ((a b c e) e)) + +(deftest elt.10 + (classify-error + (let ((x (list 'a 'b 'c))) + (setf (elt x 4) 'd))) + type-error) + +(deftest elt.11 + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((y (loop for c on x collect c))) + (setf (elt x 2) 'f) + (notnot-mv + (every #'eq + y + (loop for c on x collect c))))) + t) + +(deftest elt.12 + (let ((x (make-int-list 100000))) + (elt x 90000)) + 90000) + +(deftest elt.13 + (let ((x (make-int-list 100000))) + (setf (elt x 80000) 'foo) + (list (elt x 79999) + (elt x 80000) + (elt x 80001))) + (79999 foo 80001)) + +(deftest elt.14 + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x 10))) + type-error) + +(deftest elt.15 + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x 'a))) + type-error) + +(deftest elt.16 + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x 10.0))) + type-error) + +(deftest elt.17 + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x -1))) + type-error) + +(deftest elt.18 + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x -100000000000000000))) + type-error) + +(deftest elt.19 + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x #\w))) + type-error) + +(deftest elt.order.1 + (let ((i 0) x y) + (values + (elt (progn (setf x (incf i)) '(a b c d e)) + (progn (setf y (incf i)) 3)) + i x y)) + d 2 1 2) + +(deftest elt.order.2 + (let ((i 0) x y z) + (let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e)))) + (values + (setf (elt (aref a (progn (setf x (incf i)) 0)) + (progn (setf y (incf i)) 3)) + (progn (setf z (incf i)) 'k)) + (aref a 0) + i x y z))) + k (a b c k e) 3 1 2 3) + +(deftest elt-v.1 + (classify-error + (elt (make-array '(0)) 0)) + type-error) + +;; (deftest elt-v.2 (elt (make-array '(1)) 0) nil) ;; actually undefined +(deftest elt-v.3 + (elt (make-array '(5) :initial-contents '(a b c d e)) 0) + a) + +(deftest elt-v.4 + (elt (make-array '(5) :initial-contents '(a b c d e)) 2) + c) + +(deftest elt-v.5 + (elt (make-array '(5) :initial-contents '(a b c d e)) 4) + e) + +(deftest elt-v.6 + (elt-v-6-body) + t) + +(deftest elt-v.7 + (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) + (y (setf (elt x 0) 'e))) + (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) + (e b c d e)) + +(deftest elt-v.8 + (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) + (y (setf (elt x 1) 'e))) + (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) + (a e c d e)) + +(deftest elt-v.9 + (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) + (y (setf (elt x 3) 'e))) + (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) + (a b c e e)) + +(deftest elt-v.10 + (classify-error + (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) + (setf (elt x 4) 'd))) + type-error) + +(deftest elt-v.11 + (classify-error + (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) + (setf (elt x -100) 'd))) + type-error) + +(deftest elt-v.12 + (let ((x (make-int-array 100000))) + (elt x 90000)) + 90000) + +(deftest elt-v.13 + (let ((x (make-int-array 100000))) + (setf (elt x 80000) 'foo) + (list (elt x 79999) + (elt x 80000) + (elt x 80001))) + (79999 foo 80001)) + +;;; Adjustable arrays + +(deftest elt-adj-array.1 + (classify-error (elt (make-adj-array '(0)) 0)) + type-error) + +;;; (deftest elt-adj-array.2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined + +(deftest elt-adj-array.3 + (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0) + a) + +(deftest elt-adj-array.4 + (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2) + c) + +(deftest elt-adj-array.5 + (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4) + e) + +(deftest elt-adj-array.6 + (elt-adj-array-6-body) + t) + +(deftest elt-adj-array.7 + (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) + (y (setf (elt x 0) 'e))) + (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) + (e b c d e)) + +(deftest elt-adj-array.8 + (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) + (y (setf (elt x 1) 'e))) + (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) + (a e c d e)) + +(deftest elt-adj-array.9 + (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) + (y (setf (elt x 3) 'e))) + (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) + (a b c e e)) + +(deftest elt-adj-array.10 + (classify-error + (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) + (setf (elt x 4) 'd))) + type-error) + +(deftest elt-adj-array.11 + (classify-error + (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) + (setf (elt x -100) 'd))) + type-error) + +(deftest elt-adj-array.12 + (let ((x (make-int-array 100000 #'make-adj-array))) + (elt x 90000)) + 90000) + +(deftest elt-adj-array.13 + (let ((x (make-int-array 100000 #'make-adj-array))) + (setf (elt x 80000) 'foo) + (list (elt x 79999) + (elt x 80000) + (elt x 80001))) + (79999 foo 80001)) + +;; displaced arrays + +(deftest elt-displaced-array.1 + (classify-error (elt (make-displaced-array '(0) 100) 0)) + type-error) + +(deftest elt-displaced-array.2 + (elt (make-displaced-array '(1) 100) 0) + 100) + +(deftest elt-displaced-array.3 + (elt (make-displaced-array '(5) 100) 4) + 104) + +;;; Arrays with fill points + +(deftest elt-fill-pointer.1 + (let ((a (make-array '(5) :initial-contents '(a b c d e) + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + a b c) + +(deftest elt-fill-pointer.2 + (let ((a (make-array '(5) + :initial-contents '(0 0 1 0 0) + :element-type 'bit + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + 0 0 1) + +(deftest elt-fill-pointer.3 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(0 0 1 0 0) + :fill-pointer 3))) + (elt a 4))) + type-error) + +(deftest elt-fill-pointer.4 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(0 0 1 0 0) + :element-type 'bit + :fill-pointer 3))) + (elt a 4))) + type-error) + +(deftest elt-fill-pointer.5 + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'character + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + #\a #\b #\c) + +(deftest elt-fill-pointer.6 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'character + :fill-pointer 3))) + (elt a 4))) + type-error) + +(deftest elt-fill-pointer.7 + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'base-char + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + #\a #\b #\c) + +(deftest elt-fill-pointer.8 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'base-char + :fill-pointer 3))) + (elt a 4))) + type-error) + +(deftest elt.error.1 + (classify-error (elt)) + program-error) + +(deftest elt.error.2 + (classify-error (elt nil)) + program-error) + +(deftest elt.error.3 + (classify-error (elt nil 0 nil)) + program-error) diff --git a/ansi-tests/enough-namestring.lsp b/ansi-tests/enough-namestring.lsp new file mode 100644 index 0000000..33825b8 --- /dev/null +++ b/ansi-tests/enough-namestring.lsp @@ -0,0 +1,84 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Sep 12 06:23:50 2004 +;;;; Contains: Tests of ENOUGH-NAMESTRING + +(in-package :cl-test) + +(deftest enough-namestring.1 + (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp"))) + (s (first vals))) + (if (and (null (cdr vals)) + (stringp s) + (equal (enough-namestring s) s)) + :good + vals)) + :good) + +(deftest enough-namestring.2 + (do-special-strings + (s "enough-namestring.lsp" nil) + (let ((ns (enough-namestring s))) + (assert (stringp ns)) + (assert (string= (enough-namestring ns) ns)))) + nil) + +(deftest enough-namestring.3 + (let* ((name "enough-namestring.lsp") + (pn (merge-pathnames (pathname name))) + (name2 (enough-namestring pn)) + (name3 (enough-namestring name))) + (or (equalt name2 name3) (list name2 name3))) + t) + +(deftest enough-namestring.4 + (let* ((name "enough-namestring.lsp") + (pn (merge-pathnames (pathname name))) + (name2 (with-open-file (s pn :direction :input) (enough-namestring s))) + (name3 (enough-namestring name))) + (or (equalt name2 name3) (list name2 name3))) + t) + +(deftest enough-namestring.5 + (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" + *default-pathname-defaults*))) + (s (first vals))) + (if (and (null (cdr vals)) + (stringp s) + (equal (enough-namestring s) s)) + :good + vals)) + :good) + +(deftest enough-namestring.6 + (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" + (namestring *default-pathname-defaults*)))) + (s (first vals))) + (if (and (null (cdr vals)) + (stringp s) + (equal (enough-namestring s) s)) + :good + vals)) + :good) + +(deftest enough-namestring.7 + (do-special-strings + (s (namestring *default-pathname-defaults*) nil) + (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" s))) + (s2 (first vals))) + (assert (null (cdr vals))) + (assert (stringp s2)) + (assert (equal (enough-namestring s2) s2)))) + nil) + +;;; Error tests + +(deftest enough-namestring.error.1 + (signals-error (enough-namestring) program-error) + t) + +(deftest enough-namestring.error.2 + (signals-error + (enough-namestring "enough-namestring.lsp" *default-pathname-defaults* nil) + program-error) + t) diff --git a/ansi-tests/ensure-directories-exist.lsp b/ansi-tests/ensure-directories-exist.lsp new file mode 100644 index 0000000..af79efa --- /dev/null +++ b/ansi-tests/ensure-directories-exist.lsp @@ -0,0 +1,166 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 5 20:53:03 2004 +;;;; Contains: Tests of ENSURE-DIRECTORIES-EXIST + +(in-package :cl-test) + +(deftest ensure-directories-exist.1 + (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" + :defaults *default-pathname-defaults*)) + (results nil) + (verbosity + (with-output-to-string + (*standard-output*) + (setq results (multiple-value-list (ensure-directories-exist pn)))))) + (values + (length results) + (equalt (truename pn) (truename (first results))) + (second results) + verbosity)) + 2 t nil "") + +(deftest ensure-directories-exist.2 + (with-open-file + (s "ensure-directories-exist.lsp" :direction :input) + (let* ((results (multiple-value-list (ensure-directories-exist s)))) + (values + (length results) + (equalt (truename (first results)) (truename s)) + (second results)))) + 2 t nil) + +(deftest ensure-directories-exist.3 + (let ((s (open "ensure-directories-exist.lsp" :direction :input))) + (close s) + (let* ((results (multiple-value-list (ensure-directories-exist s)))) + (values + (length results) + (equalt (truename (first results)) (truename s)) + (second results)))) + 2 t nil) + +(deftest ensure-directories-exist.4 + (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" + :defaults *default-pathname-defaults*)) + (results nil) + (verbosity + (with-output-to-string + (*standard-output*) + (setq results (multiple-value-list + (ensure-directories-exist pn :verbose nil)))))) + (values + (length results) + (equalt (truename pn) (truename (first results))) + (second results) + verbosity)) + 2 t nil "") + +(deftest ensure-directories-exist.5 + (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" + :defaults *default-pathname-defaults*)) + (results nil) + (verbosity + (with-output-to-string + (*standard-output*) + (setq results (multiple-value-list + (ensure-directories-exist pn :verbose t)))))) + (values + (length results) + (equalt (truename pn) (truename (first results))) + (second results) + verbosity)) + 2 t nil "") + +(deftest ensure-directories-exist.6 + (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" + :defaults *default-pathname-defaults*)) + (results nil) + (verbosity + (with-output-to-string + (*standard-output*) + (setq results (multiple-value-list + (ensure-directories-exist + pn :allow-other-keys nil)))))) + (values + (length results) + (equalt (truename pn) (truename (first results))) + (second results) + verbosity)) + 2 t nil "") + +(deftest ensure-directories-exist.7 + (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" + :defaults *default-pathname-defaults*)) + (results nil) + (verbosity + (with-output-to-string + (*standard-output*) + (setq results (multiple-value-list + (ensure-directories-exist + pn :allow-other-keys t :nonsense t)))))) + (values + (length results) + (equalt (truename pn) (truename (first results))) + (second results) + verbosity)) + 2 t nil "") + +;;; Case where directory shouldn't exist + +;; The directort ansi-tests/scratch must not exist before this +;; test is run +(deftest ensure-directories-exist.8 + (let* ((subdir (make-pathname :directory '(:relative "scratch") + :defaults *default-pathname-defaults*)) + (pn (make-pathname :name "foo" :type "txt" + :defaults subdir))) + (ignore-errors (delete-file pn) (delete-file subdir)) + (assert (not (probe-file pn)) () + "Delete subdirectory scratch and its contents!") + (let* ((results nil) + (verbosity + (with-output-to-string + (*standard-output*) + (setq results (multiple-value-list (ensure-directories-exist pn))))) + (result-pn (first results)) + (created (second results))) + ;; Create the file and write to it + (with-open-file (*standard-output* + pn :direction :output :if-exists :error + :if-does-not-exist :create) + (print nil)) + (values + (length results) + (notnot created) + (equalt pn result-pn) + (notnot (probe-file pn)) + verbosity + ))) + 2 t t t "") + +;;; Specialized string tests + +(deftest ensure-directories-exist.9 + (do-special-strings + (str "ensure-directories-exist.lsp" nil) + (let* ((results (multiple-value-list (ensure-directories-exist str)))) + (assert (eql (length results) 2)) + (assert (equalt (truename (first results)) (truename str))) + (assert (null (second results))))) + nil) + +;; FIXME +;; Need to add a LPN test + +(deftest ensure-directories-exist.error.1 + (signals-error-always + (ensure-directories-exist + (make-pathname :directory '(:relative :wild) + :defaults *default-pathname-defaults*)) + file-error) + t t) + +(deftest ensure-directories-exist.error.2 + (signals-error (ensure-directories-exist) program-error) + t) diff --git a/ansi-tests/eql.lsp b/ansi-tests/eql.lsp new file mode 100644 index 0000000..10318a0 --- /dev/null +++ b/ansi-tests/eql.lsp @@ -0,0 +1,87 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 19:36:33 2002 +;;;; Contains: Tests of EQL + +(in-package :cl-test) + +;;; EQLT is defined in ansi-aux.lsp +;;; It calls EQL, returning NIL when the result is false and T when it +;;; is true. + +(deftest eql.1 + (loop for x in *universe* always (check-values (eql x x))) + t) + +(deftest eql.2 + (eqlt 2 (1+ 1)) + t) + +(deftest eql.3 + (let ((x "abc")) + (eql x (copy-seq x))) + nil) + +(deftest eql.4 + (eqlt #\a #\a) + t) + +(deftest eql.5 + (eqlt 12345678901234567890 12345678901234567890) + t) + +(deftest eql.7 + (eql 12.0 12) + nil) + +(deftest eql.8 + (eqlt #c(1 -2) #c(1 -2)) + t) + +(deftest eql.9 + (let ((x "abc") (y "abc")) + (if (eq x y) (eqlt x y) (not (eql x y)))) + t) + +(deftest eql.10 + (eql (list 'a) (list 'b)) + nil) + +(deftest eql.11 + (eqlt #c(1 -2) (- #c(-1 2))) + t) + +(deftest eql.order.1 + (let ((i 0) x y) + (values + (eql (setf x (incf i)) (setf y (incf i))) + i x y)) + nil 2 1 2) + +(deftest eql.error.1 + (classify-error (eql)) + program-error) + +(deftest eql.error.2 + (classify-error (eql nil)) + program-error) + +(deftest eql.error.3 + (classify-error (eql nil nil nil)) + program-error) + +;;; Error tests for EQ + +(deftest eq.error.1 + (classify-error (eq)) + program-error) + +(deftest eq.error.2 + (classify-error (eq nil)) + program-error) + +(deftest eq.error.3 + (classify-error (eq nil nil nil)) + program-error) + + \ No newline at end of file diff --git a/ansi-tests/equal.lsp b/ansi-tests/equal.lsp new file mode 100644 index 0000000..a2a5244 --- /dev/null +++ b/ansi-tests/equal.lsp @@ -0,0 +1,81 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 21:38:16 2002 +;;;; Contains: Tests for EQUAL + +(in-package :cl-test) + +(deftest equal.1 + (loop for x in *symbols* + always (loop for y in *symbols* + always (if (eq x y) (equal x y) + (not (equal x y))))) + t) + +(deftest equal.2 + (equalt (cons 'a 'b) (cons 'a 'b)) + t) + +(deftest equal.3 + (equalt (cons 'a 'c) (cons 'a 'b)) + nil) + +(deftest equal.4 + (equalt (vector 1 2 3) (vector 1 2 3)) + nil) + +(deftest equal.5 + (loop for c in *characters* + always (loop for d in *characters* + always (if (eql c d) (equalt c d) + (not (equalt c d))))) + t) + +(deftest equal.6 + (equalt (make-pathname :name (copy-seq "foo")) + (make-pathname :name (copy-seq "foo"))) + t) + +(deftest equal.7 + (equalt (make-pathname :name (copy-seq "foo")) + (make-pathname :name (copy-seq "bar"))) + nil) + +(deftest equal.8 + (equalt (copy-seq "abcd") (copy-seq "abcd")) + t) + +(deftest equal.9 + (equalt (copy-seq "abcd") (copy-seq "abc")) + nil) + +(deftest equal.10 + (equalt (copy-seq "abcd") (copy-seq "ABCD")) + nil) + +(deftest equal.11 + (equalt (copy-seq #*000110) (copy-seq #*000110)) + t) + +(deftest equal.12 + (equalt (copy-seq #*000110) (copy-seq #*000111)) + nil) + +(deftest equal.order.1 + (let ((i 0) x y) + (values + (equal (setf x (incf i)) (setf y (incf i))) + i x y)) + nil 2 1 2) + +(deftest equal.error.1 + (classify-error (equal)) + program-error) + +(deftest equal.error.2 + (classify-error (equal nil)) + program-error) + +(deftest equal.error.3 + (classify-error (equal nil nil nil)) + program-error) diff --git a/ansi-tests/equalp.lsp b/ansi-tests/equalp.lsp new file mode 100644 index 0000000..5248fc7 --- /dev/null +++ b/ansi-tests/equalp.lsp @@ -0,0 +1,47 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 22:14:42 2002 +;;;; Contains: Tests for EQUALP + +(in-package :cl-test) + +(deftest equalp.1 + (loop for c across +base-chars+ + always (loop for d across +base-chars+ + always (if (char-equal c d) (equalpt c d) + (not (equalpt c d))))) + t) + +(deftest equalp.2 + (loop for i from 1 to 100 + always (loop for j from 1 to 100 + always (if (eqlt i j) (equalpt i j) + (not (equalpt i j))))) + t) + +(deftest equalp.3 + (equalpt "abc" "ABC") + t) + +(deftest equalp.4 + (equalpt "abc" "abd") + nil) + +(deftest equalp.order.1 + (let ((i 0) x y) + (values + (equalp (setf x (incf i)) (setf y (incf i))) + i x y)) + nil 2 1 2) + +(deftest equalp.error.1 + (classify-error (equalp)) + program-error) + +(deftest equalp.error.2 + (classify-error (equalp nil)) + program-error) + +(deftest equalp.error.3 + (classify-error (equalp nil nil nil)) + program-error) diff --git a/ansi-tests/error.lsp b/ansi-tests/error.lsp new file mode 100644 index 0000000..1bd9c7d --- /dev/null +++ b/ansi-tests/error.lsp @@ -0,0 +1,66 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 28 21:37:43 2003 +;;;; Contains: Tests of ERROR + +(in-package :cl-test) + +(deftest error.1 + (let ((fmt "Error")) + (handler-case + (error fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest error.2 + (let* ((fmt "Error") + (cnd (make-condition 'simple-error :format-control fmt))) + (handler-case + (error cnd) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest error.3 + (let ((fmt "Error")) + (handler-case + (error 'simple-error :format-control fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest error.4 + (let ((fmt "Error: ~A")) + (handler-case + (error fmt 10) + (simple-error (c) (frob-simple-error c fmt 10)))) + t) + +(deftest error.5 + (let ((fmt (formatter "Error"))) + (handler-case + (error fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest error.6 + (handler-case + (error 'simple-condition) + (error (c) :wrong) + (simple-condition (c) :right)) + :right) + +(deftest error.7 + (handler-case + (error 'simple-warning) + (error (c) :wrong) + (simple-warning (c) :right) + (condition (c) :wrong2)) + :right) + +(deftest error.8 + (let ((fmt "Boo!")) + (handler-case + (error 'simple-warning :format-control fmt) + (simple-warning (c) (frob-simple-warning c fmt)))) + t) + +;;; Tests for other conditions will in their own files. diff --git a/ansi-tests/etypecase.lsp b/ansi-tests/etypecase.lsp new file mode 100644 index 0000000..06d46ec --- /dev/null +++ b/ansi-tests/etypecase.lsp @@ -0,0 +1,61 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 23:02:23 2002 +;;;; Contains: Tests of ETYPECASE + +(in-package :cl-test) + +(deftest etypecase.1 + (etypecase 1 (integer 'a) (t 'b)) + a) + +(deftest etypecase.2 + (classify-error (etypecase 1 (symbol 'a))) + type-error) + +(deftest etypecase.3 + (etypecase 1 (symbol 'a) (t 'b)) + b) + +(deftest etypecase.4 + (etypecase 1 (t (values)))) + +(deftest etypecase.5 + (etypecase 1 (integer (values)) (t 'a))) + +(deftest etypecase.6 + (etypecase 1 (bit 'a) (integer 'b)) + a) + +(deftest etypecase.7 + (etypecase 1 (t 'a)) + a) + +(deftest etypecase.8 + (etypecase 1 (t (values 'a 'b 'c))) + a b c) + +(deftest etypecase.9 + (etypecase 1 (integer (values 'a 'b 'c)) (t nil)) + a b c) + +(deftest etypecase.10 + (let ((x 0)) + (values + (etypecase 1 + (bit (incf x) 'a) + (integer (incf x 2) 'b) + (t (incf x 4) 'c)) + x)) + a 1) + +(deftest etypecase.11 + (etypecase 1 (integer) (t 'a)) + nil) + +(deftest etypecase.12 + (etypecase 'a + (number 'bad) + (#.(find-class 'symbol nil) 'good)) + good) + diff --git a/ansi-tests/eval-and-compile.lsp b/ansi-tests/eval-and-compile.lsp new file mode 100644 index 0000000..4580c55 --- /dev/null +++ b/ansi-tests/eval-and-compile.lsp @@ -0,0 +1,22 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 21 22:52:19 2002 +;;;; Contains: Overall tests for section 3, 'Evaluation and Compilation' + +(in-package :cl-test) + +(defparameter *eval-and-compile-fns* + '(compile eval macroexpand macroexpand-1 proclaim special-operator-p + constantp)) + +(deftest eval-and-compile-fns + (remove-if #'fboundp *eval-and-compile-fns*) + nil) + +(defparameter *eval-and-compile-macros* + '(lambda define-compiler-macro defmacro define-symbol-macro declaim)) + +(deftest eval-and-compile-macros + (remove-if #'macro-function *eval-and-compile-macros*) + nil) + diff --git a/ansi-tests/eval.lsp b/ansi-tests/eval.lsp new file mode 100644 index 0000000..cf16659 --- /dev/null +++ b/ansi-tests/eval.lsp @@ -0,0 +1,52 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Nov 21 10:43:15 2002 +;;;; Contains: Tests of EVAL + +(in-package :cl-test) + +(deftest eval.1 + (eval 1) + 1) + +(deftest eval.2 + (loop for x being the symbols of "KEYWORD" + always (eq (eval x) x)) + t) + +(deftest eval.3 + (let ((s "abcd")) + (eqlt (eval s) s)) + t) + +(deftest eval.4 + (eval '(car '(a . b))) + a) + +(deftest eval.5 + (eval '(let ((x 0)) x)) + 0) + +(deftest eval.6 + (funcall #'eval 1) + 1) + +(deftest eval.order.1 + (let ((i 0)) + (values (eval (progn (incf i) 10)) i)) + 10 1) + +;;; Error cases + +(deftest eval.error.1 + (classify-error (eval)) + program-error) + +(deftest eval.error.2 + (classify-error (eval nil nil)) + program-error) + +(deftest eval.error.3 + (classify-error (eval (list (gensym)))) + undefined-function) + diff --git a/ansi-tests/every.lsp b/ansi-tests/every.lsp new file mode 100644 index 0000000..412fb15 --- /dev/null +++ b/ansi-tests/every.lsp @@ -0,0 +1,150 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 23:25:58 2002 +;;;; Contains: Tests of EVERY + +(in-package :cl-test) + +(deftest every.1 + (notnot-mv (every #'identity nil)) + t) + +(deftest every.2 + (notnot-mv (every #'identity #())) + t) + +(deftest every.3 + (let ((count 0)) + (values + (every #'(lambda (x) (incf count) (< x 10)) + '(1 2 4 13 5 1)) + count)) + nil 4) + +(deftest every.4 + (notnot-mv (every #'= '(1 2 3 4) '(1 2 3 4 5))) + t) + +(deftest every.5 + (notnot-mv (every #'= '(1 2 3 4 5) '(1 2 3 4))) + t) + +(deftest every.6 + (every #'= '(1 2 3 4 5) '(1 2 3 4 6)) + nil) + +(deftest every.7 + (notnot-mv (every #'(lambda (x y) (or x y)) + '(nil t t nil t) #(t nil t t nil nil))) + t) + +(deftest every.8 + (let ((x '(1)) + (args nil)) + (loop for i from 1 below (1- (min 100 call-arguments-limit)) + do (push x args) + always (apply #'every #'= args))) + t) + +(deftest every.9 + (notnot-mv (every #'zerop #*000000000000)) + t) + +(deftest every.10 + (notnot-mv (every #'zerop #*)) + t) + +(deftest every.11 + (every #'zerop #*0000010000) + nil) + +(deftest every.12 + (notnot-mv (every #'(lambda (x) (eql x #\a)) "aaaaaaaa")) + t) + +(deftest every.13 + (notnot-mv (every #'(lambda (x) (eql x #\a)) "")) + t) + +(deftest every.14 + (every #'(lambda (x) (eql x #\a)) "aaaaaabaaaa") + nil) + +(deftest every.15 + (every 'null '(nil nil t nil)) + nil) + +(deftest every.16 + (notnot-mv (every 'null '(nil nil nil nil))) + t) + +(deftest every.order.1 + (let ((i 0) x y) + (values + (every (progn (setf x (incf i)) #'null) + (progn (setf y (incf i)) '(nil nil a nil))) + i x y)) + nil 2 1 2) + +(deftest every.order.2 + (let ((i 0) x y z) + (values + (every (progn (setf x (incf i)) #'equal) + (progn (setf y (incf i)) '(nil nil a nil)) + (progn (setf z (incf i)) '(nil nil a b))) + i x y z)) + nil 3 1 2 3) + +;;; Error cases + +(deftest every.error.1 + (classify-error (every 1 '(a b c))) + type-error) + +(deftest every.error.2 + (classify-error (every #\a '(a b c))) + type-error) + +(deftest every.error.3 + (classify-error (every #() '(a b c))) + type-error) + +(deftest every.error.4 + (classify-error (every #'null 'a)) + type-error) + +(deftest every.error.5 + (classify-error (every #'null 100)) + type-error) + +(deftest every.error.6 + (classify-error (every #'null 'a)) + type-error) + +(deftest every.error.7 + (classify-error (every #'eq () 'a)) + type-error) +` +(deftest every.error.8 + (classify-error (every)) + program-error) + +(deftest every.error.9 + (classify-error (every #'null)) + program-error) + +(deftest every.error.10 + (classify-error (locally (every 1 '(a b c)) t)) + type-error) + +(deftest every.error.11 + (classify-error (every #'cons '(a b c))) + program-error) + +(deftest every.error.12 + (classify-error (every #'cons '(a b c) '(1 2 3) '(4 5 6))) + program-error) + +(deftest every.error.13 + (classify-error (every #'car '(a b c))) + type-error) diff --git a/ansi-tests/fboundp.lsp b/ansi-tests/fboundp.lsp new file mode 100644 index 0000000..0ec7332 --- /dev/null +++ b/ansi-tests/fboundp.lsp @@ -0,0 +1,69 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 7 22:37:22 2002 +;;;; Contains: Tests of FBOUNDP + +(in-package :cl-test) + +(deftest fboundp.1 + (not-mv (fboundp 'car)) + nil) + +(deftest fboundp.2 + (not-mv (fboundp 'cdr)) + nil) + +(deftest fboundp.3 + (not-mv (fboundp 'defun)) ; a macro + nil) + +(deftest fboundp.4 + ;; fresh symbols are not fbound + (let ((g (gensym))) (fboundp g)) + nil) + +(defun fboundp-5-fn (x) x) +(deftest fboundp.5 + (not-mv (fboundp 'fboundp-5-fn)) + nil) + +(eval-when (eval compile) + (ignore-errors + (defun (setf fboundp-6-accessor) (y x) (setf (car x) y)))) + +(deftest fboundp.6 + (not-mv (fboundp '(setf fboundp-6-accessor))) + nil) + +(deftest fboundp.7 + (let ((g (gensym))) (fboundp (list 'setf g))) + nil) + +(deftest fboundp.order.1 + (let ((i 0)) + (values (notnot (fboundp (progn (incf i) 'car))) i)) + t 1) + +(deftest fboundp.error.1 + (classify-error (fboundp 1)) + type-error) + +(deftest fboundp.error.2 + (classify-error (fboundp #\a)) + type-error) + +(deftest fboundp.error.3 + (classify-error (fboundp '(foo))) + type-error) + +(deftest fboundp.error.4 + (classify-error (fboundp)) + program-error) + +(deftest fboundp.error.5 + (classify-error (fboundp 'cons nil)) + program-error) + +(deftest fboundp.error.6 + (classify-error (locally (fboundp 1) t)) + type-error) diff --git a/ansi-tests/fdefinition.lsp b/ansi-tests/fdefinition.lsp new file mode 100644 index 0000000..1cfaa8d --- /dev/null +++ b/ansi-tests/fdefinition.lsp @@ -0,0 +1,83 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 15:27:51 2003 +;;;; Contains: Tests for FDEFINITION + +(in-package :cl-test) + +;;; Error cases + +(deftest fdefinition.error.1 + (classify-error (fdefinition)) + program-error) + +(deftest fdefinition.error.2 + (classify-error (fdefinition 'cons nil)) + program-error) + +(deftest fdefinition.error.3 + (classify-error (fdefinition (gensym))) + undefined-function) + +(deftest fdefinition.error.4 + (classify-error (fdefinition 10)) + type-error) + +(deftest fdefinition.error.5 + (classify-error (fdefinition (list 'setf (gensym)))) + undefined-function) + +(deftest fdefinition.error.6 + (classify-error (locally (fdefinition 10) t)) + type-error) + +;;; Non-error cases + +(deftest fdefinition.1 + (let ((fun (fdefinition 'cons))) + (funcall fun 'a 'b)) + (a . b)) + +(deftest fdefinition.2 + (progn + (fdefinition 'cond) + :good) + :good) + +(deftest fdefinition.3 + (progn + (fdefinition 'setq) + :good) + :good) + +(deftest fdefinition.4 + (let ((sym (gensym))) + (values + (fboundp sym) + (progn + (setf (fdefinition sym) (fdefinition 'cons)) + (funcall (symbol-function sym) 'a 'b)) + (notnot (fboundp sym)))) + nil + (a . b) + t) + +(deftest fdefinition.5 + (let* ((sym (gensym)) + (fname (list 'setf sym))) + (values + (fboundp fname) + (progn + (setf (fdefinition fname) (fdefinition 'cons)) + (eval `(setf (,sym 'a) 'b))) + (notnot (fboundp fname)))) + nil + (b . a) + t) + +(deftest fdefinition.order.1 + (let ((i 0)) + (fdefinition (progn (incf i) 'setq)) + i) + 1) + diff --git a/ansi-tests/features.lsp b/ansi-tests/features.lsp new file mode 100644 index 0000000..57d0a47 --- /dev/null +++ b/ansi-tests/features.lsp @@ -0,0 +1,22 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Dec 2 07:44:40 2002 +;;;; Contains: Tests of *FEATURES* + +(in-package :cl-test) + +(deftest features.1 + (let ((f *features*)) + (or (not (member :draft-ansi-cl f)) + (not (intersection '(:draft-ansi-cl-2 :ansi-cl) f)))) + t) + +(deftest features.2 + (let ((f *features*)) + (or (not (intersection '(:x3j13 :draft-ansi-cl :ansi-cl) f)) + (notnot (member :common-lisp f)))) + t) + +(deftest features.3 + (not (member :cltl2 *features*)) + t) diff --git a/ansi-tests/file-author.lsp b/ansi-tests/file-author.lsp new file mode 100644 index 0000000..20cf87b --- /dev/null +++ b/ansi-tests/file-author.lsp @@ -0,0 +1,88 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 6 05:41:06 2004 +;;;; Contains: Tests of FILE-AUTHOR + +(in-package :cl-test) + +(deftest file-author.1 + (loop for pn in + (directory (make-pathname :name :wild :type :wild + :defaults *default-pathname-defaults*)) + for author = (file-author pn) + unless (or (null author) (stringp author)) + collect (list pn author)) + nil) + +(deftest file-author.2 + (let ((author (file-author "file-author.lsp"))) + (if (or (null author) (stringp author)) + nil + author)) + nil) + +(deftest file-author.3 + (let ((author (file-author #p"file-author.lsp"))) + (if (or (null author) (stringp author)) + nil + author)) + nil) + +(deftest file-author.4 + (let ((author (file-author (truename "file-author.lsp")))) + (if (or (null author) (stringp author)) + nil + author)) + nil) + +(deftest file-author.5 + (let ((author (with-open-file (s "file-author.lsp" :direction :input) + (file-author s)))) + (if (or (null author) (stringp author)) + nil + author)) + nil) + +(deftest file-author.6 + (let ((author (let ((s (open "file-author.lsp" :direction :input))) + (close s) + (file-author s)))) + (if (or (null author) (stringp author)) + nil + author)) + nil) + +;;; Specialized string tests + +(deftest file-author.7 + (do-special-strings + (s "file-author.lsp" nil) + (assert (equal (file-author s) (file-author "file-author.lsp")))) + nil) + +;;; FIXME +;;; Add LPN test + +;;; Error tests + +(deftest file-author.error.1 + (signals-error (file-author) program-error) + t) + +(deftest file-author.error.2 + (signals-error (file-author "file-author.lsp" nil) program-error) + t) + +(deftest file-author.error.3 + (signals-error-always + (file-author (make-pathname :name :wild :type "lsp" + :defaults *default-pathname-defaults*)) + file-error) + t t) + +(deftest file-author.error.4 + (signals-error-always + (file-author (make-pathname :name "file-author" :type :wild + :defaults *default-pathname-defaults*)) + file-error) + t t) diff --git a/ansi-tests/file-error.lsp b/ansi-tests/file-error.lsp new file mode 100644 index 0000000..6023c8d --- /dev/null +++ b/ansi-tests/file-error.lsp @@ -0,0 +1,89 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 13 19:10:02 2004 +;;;; Contains: Tests of the FILE-ERROR condition, and associated accessor function + +(in-package :cl-test) + +(deftest file-error.1 + (let ((pn (make-pathname :name :wild + :type "txt" + :version :newest + :defaults *default-pathname-defaults*))) + (handler-case + (probe-file pn) + (error (c) + (values + (notnot (typep c 'file-error)) + (if (equalp (file-error-pathname c) pn) + t + (list (file-error-pathname c) pn)))))) + t t) + +(deftest file-error-pathname.1 + (let ((c (make-condition 'file-error :pathname "foo.txt"))) + (values + (notnot (typep c 'file-error)) + (eqlt (class-of c) (find-class 'file-error)) + (file-error-pathname c))) + t t "foo.txt") + +(deftest file-error-pathname.2 + (let ((c (make-condition 'file-error :pathname #p"foo.txt"))) + (values + (notnot (typep c 'file-error)) + (eqlt (class-of c) (find-class 'file-error)) + (equalt #p"foo.txt" (file-error-pathname c)))) + t t t) + +(deftest file-error-pathname.3 + (let ((c (make-condition 'file-error :pathname "CLTEST:FOO.TXT"))) + (values + (notnot (typep c 'file-error)) + (eqlt (class-of c) (find-class 'file-error)) + (equalpt "CLTEST:FOO.TXT" + (file-error-pathname c)))) + t t t) + +(deftest file-error-pathname.4 + (let ((c (make-condition 'file-error :pathname (logical-pathname "CLTEST:FOO.TXT")))) + (values + (notnot (typep c 'file-error)) + (eqlt (class-of c) (find-class 'file-error)) + (equalpt (logical-pathname "CLTEST:FOO.TXT") + (file-error-pathname c)))) + t t t) + +(deftest file-error-pathname.5 + (with-open-file (s "file-error.lsp" :direction :input) + (let ((c (make-condition 'file-error :pathname s))) + (values + (notnot (typep c 'file-error)) + (eqlt (class-of c) (find-class 'file-error)) + (equalpt s (file-error-pathname c))))) + t t t) + +(deftest file-error-pathname.6 + (let ((s (open "file-error.lsp" :direction :input))) + (close s) + (let ((c (make-condition 'file-error :pathname s))) + (values + (notnot (typep c 'file-error)) + (eqlt (class-of c) (find-class 'file-error)) + (equalpt s (file-error-pathname c))))) + t t t) + +(deftest file-error-pathname.error.1 + (signals-error (file-error-pathname) program-error) + t) + +(deftest file-error-pathname.error.2 + (signals-error + (file-error-pathname (make-condition 'file-error :pathname "foo.txt") nil) + program-error) + t) + + + + + diff --git a/ansi-tests/file-length.lsp b/ansi-tests/file-length.lsp new file mode 100644 index 0000000..cb0d422 --- /dev/null +++ b/ansi-tests/file-length.lsp @@ -0,0 +1,176 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 21 06:21:11 2004 +;;;; Contains: Tests of FILE-LENGTH + +(in-package :cl-test) + +(deftest file-length.error.1 + (signals-error (file-length) program-error) + t) + +(deftest file-length.error.2 + (signals-error + (with-open-file (is "file-length.lsp" :direction :input) + (file-length is nil)) + program-error) + t) + +(deftest file-length.error.3 + (loop for x in *mini-universe* + unless (or (typep x 'file-stream) + (typep x 'broadcast-stream) + (handler-case (progn (file-length x) nil) + (type-error (c) + (assert (not (typep x (type-error-expected-type c)))) + t) + (condition () nil))) + collect x) + nil) + +(deftest file-length.error.4 + :notes (:assume-no-simple-streams :assume-no-gray-streams) + (signals-error (with-input-from-string (s "abc") (file-length s)) + type-error) + t) + +(deftest file-length.error.5 + (signals-error + (with-open-file + (is "file-length.lsp" :direction :input) + (with-open-file + (os "tmp.txt" :direction :output :if-exists :supersede) + (let ((s (make-two-way-stream is os))) + (unwind-protect (file-length s) (close s))))) + type-error) + t) + +(deftest file-length.error.6 + (signals-error + (with-open-file + (is "file-length.lsp" :direction :input) + (with-open-file + (os "tmp.txt" :direction :output :if-exists :supersede) + (let ((s (make-echo-stream is os))) + (unwind-protect (file-length s) (close s))))) + type-error) + t) + +(deftest file-length.error.8 + (with-open-file + (os "tmp.txt" :direction :output :if-exists :supersede) + (let ((s (make-broadcast-stream os))) + (eqlt (file-length s) (file-length os)))) + t) + +(deftest file-length.error.9 + (signals-type-error s (make-concatenated-stream) + (unwind-protect (file-length s) (close s))) + t) + +(deftest file-length.error.10 + (signals-error + (with-open-file + (is "file-length.lsp" :direction :input) + (let ((s (make-concatenated-stream is))) + (unwind-protect (file-length s) (close s)))) + type-error) + t) + +(deftest file-length.error.11 + :notes (:assume-no-simple-streams :assume-no-gray-streams) + (signals-type-error s (make-string-input-stream "abcde") + (unwind-protect (file-length s) (close s))) + t) + +(deftest file-length.error.12 + :notes (:assume-no-simple-streams :assume-no-gray-streams) + (signals-type-error s (make-string-output-stream) + (unwind-protect (file-length s) (close s))) + t) + +;;; Non-error tests + +(deftest file-length.1 + (let ((results (multiple-value-list + (with-open-file + (is "file-length.lsp" :direction :input) + (file-length is))))) + (and (= (length results) 1) + (typep (car results) '(integer 1)) + t)) + t) + +(deftest file-length.2 + (loop for i from 1 to 32 + for etype = `(unsigned-byte ,i) + for e = (max 0 (- (ash 1 i) 5)) + for os = (open "tmp.dat" :direction :output + :if-exists :supersede + :element-type etype) + do (loop repeat 17 do (write-byte e os)) + do (finish-output os) + unless (= (file-length os) 17) + collect (list i (file-length os)) + do (close os)) + nil) + +(deftest file-length.3 + (loop for i from 1 to 32 + for etype = `(unsigned-byte ,i) + for e = (max 0 (- (ash 1 i) 5)) + for os = (open "tmp.dat" :direction :output + :if-exists :supersede + :element-type etype) + for len = 0 + do (loop repeat 17 do (write-byte e os)) + do (close os) + unless (let ((is (open "tmp.dat" :direction :input + :element-type etype))) + (prog1 + (= (file-length is) 17) + (close is))) + collect i) + nil) + +(deftest file-length.4 + (loop for i from 33 to 100 + for etype = `(unsigned-byte ,i) + for e = (max 0 (- (ash 1 i) 5)) + for os = (open "tmp.dat" :direction :output + :if-exists :supersede + :element-type etype) + do (loop repeat 17 do (write-byte e os)) + do (finish-output os) + unless (= (file-length os) 17) + collect (list i (file-length os)) + do (close os)) + nil) + +(deftest file-length.5 + (loop for i from 33 to 100 + for etype = `(unsigned-byte ,i) + for e = (max 0 (- (ash 1 i) 5)) + for os = (open "tmp.dat" :direction :output + :if-exists :supersede + :element-type etype) + for len = 0 + do (loop repeat 17 do (write-byte e os)) + do (close os) + unless (let ((is (open "tmp.dat" :direction :input + :element-type etype))) + (prog1 + (= (file-length is) 17) + (close is))) + collect i) + nil) + +(deftest file-length.6 + (with-open-file + (*foo* "file-length.lsp" :direction :input) + (declare (special *foo*)) + (let ((s (make-synonym-stream '*foo*))) + (unwind-protect + (typep* (file-length s) '(integer 1)) + (close s)))) + t) diff --git a/ansi-tests/file-namestring.lsp b/ansi-tests/file-namestring.lsp new file mode 100644 index 0000000..f837c95 --- /dev/null +++ b/ansi-tests/file-namestring.lsp @@ -0,0 +1,44 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 11 07:40:47 2004 +;;;; Contains: Tests for FILE-NAMESTRING + +(in-package :cl-test) + +(deftest file-namestring.1 + (let* ((vals (multiple-value-list + (file-namestring "file-namestring.lsp"))) + (s (first vals))) + (if (and (null (cdr vals)) + (stringp s) + (equal (file-namestring s) s)) + :good + vals)) + :good) + +(deftest file-namestring.2 + (do-special-strings + (s "file-namestring.lsp" nil) + (let ((ns (file-namestring s))) + (assert (stringp ns)) + (assert (string= (file-namestring ns) ns)))) + nil) + +(deftest file-namestring.3 + (let* ((name "file-namestring.lsp") + (pn (merge-pathnames (pathname name))) + (name2 (with-open-file (s pn :direction :input) + (file-namestring s))) + (name3 (file-namestring pn))) + (or (equalt name2 name3) (list name2 name3))) + t) + +;;; Error tests + +(deftest file-namestring.error.1 + (signals-error (file-namestring) program-error) + t) + +(deftest file-namestring.error.2 + (signals-error (file-namestring "file-namestring.lsp" nil) program-error) + t) diff --git a/ansi-tests/file-position.lsp b/ansi-tests/file-position.lsp new file mode 100644 index 0000000..c623014 --- /dev/null +++ b/ansi-tests/file-position.lsp @@ -0,0 +1,170 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 22 03:02:31 2004 +;;;; Contains: Tests of FILE-POSITION + +(in-package :cl-test) + +(deftest file-position.1 + (with-open-file (is "file-position.lsp":direction :input) + (file-position is)) + 0) + +(deftest file-position.2 + (with-open-file (is "file-position.lsp":direction :input) + (values + (multiple-value-list + (notnot-mv (file-position is :start))) + (file-position is))) + + (t) 0) + +(deftest file-position.3 + (with-open-file (is "file-position.lsp":direction :input) + (values + (multiple-value-list + (notnot-mv (file-position is :end))) + (notnot (> (file-position is) 0)))) + (t) t) + +(deftest file-position.4 + (with-open-file + (is "file-position.lsp":direction :input) + (values + (file-position is) + (read-char is) + (notnot (> (file-position is) 0)))) + 0 #\; t) + +(deftest file-position.5 + (with-open-file + (os "tmp.dat":direction :output + :if-exists :supersede) + (values + (file-position os) + (write-char #\x os) + (notnot (> (file-position os) 0)))) + 0 #\x t) + +(deftest file-position.6 + (with-open-file + (os "tmp.dat":direction :output + :if-exists :supersede) + (let ((p1 (file-position os)) + (delta (file-string-length os #\x))) + (write-char #\x os) + (let ((p2 (file-position os))) + (or (null p1) (null p2) (null delta) + (=t (+ p1 delta) p2))))) + t) + +;;; Byte streams + +(deftest file-position.7 + (loop for len from 1 to 32 + for n = (ash 1 len) + do (with-open-file + (os "tmp.dat" :direction :output + :if-exists :supersede + :element-type `(unsigned-byte ,len)) + (loop for i from 0 below 100 + for r = (logand (1- n) i) + for pos = (file-position os) + do (assert (or (not pos) (eql pos i))) + do (write-byte r os))) + do (with-open-file + (is "tmp.dat" :direction :input + :element-type `(unsigned-byte ,len)) + (loop for i from 0 below 100 + for pos = (file-position is) + do (assert (or (not pos) (eql pos i))) + do (let ((byte (read-byte is))) + (assert (eql byte (logand (1- n) i))))))) + nil) + +(deftest file-position.8 + (loop for len from 33 to 100 + for n = (ash 1 len) + do (with-open-file + (os "tmp.dat" :direction :output + :if-exists :supersede + :element-type `(unsigned-byte ,len)) + (loop for i from 0 below 100 + for r = (logand (1- n) i) + for pos = (file-position os) + do (assert (or (not pos) (eql pos i))) + do (write-byte r os))) + do (with-open-file + (is "tmp.dat" :direction :input + :element-type `(unsigned-byte ,len)) + (loop for i from 0 below 100 + for pos = (file-position is) + do (assert (or (not pos) (eql pos i))) + do (let ((byte (read-byte is))) + (assert (eql byte (logand (1- n) i))))))) + nil) + +(deftest file-position.9 + (with-input-from-string + (s "abcdefghijklmnopqrstuvwxyz") + (loop repeat 26 + for p = (file-position s) + unless (or (not p) + (progn + (file-position s p) + (eql (file-position s) p))) + collect p + do (read-char s))) + nil) + +(deftest file-position.10 + (with-output-to-string + (s) + (loop repeat 26 + for p = (file-position s) + unless (or (not p) + (progn + (file-position s p) + (eql (file-position s) p))) + collect p + do (write-char #\x s))) + "xxxxxxxxxxxxxxxxxxxxxxxxxx") + +;;; Error tests + +(deftest file-position.error.1 + (signals-error (file-position) program-error) + t) + +(deftest file-position.error.2 + (signals-error + (file-position (make-string-input-stream "abc") :start nil) + program-error) + t) + +;;; It's not clear what 'too large' means -- can we set the +;;; file position to a point where the file may later be extended +;;; by some other writer? +#| +(deftest file-position.error.3 + (signals-error + (with-open-file + (is "file-position.lsp" :direction :input) + (flet ((%fail () (error 'type-error))) + (unless (file-position is :end) (%fail)) + (let ((fp (file-position is))) + (unless fp (%fail)) + (file-position is (+ 1000000 fp))))) + error) + t) + +(deftest file-position.error.4 + (signals-error + (with-open-file + (is "file-position.lsp" :direction :input) + (file-position is 1000000000000000000000)) + error) + t) +|# + + \ No newline at end of file diff --git a/ansi-tests/file-string-length.lsp b/ansi-tests/file-string-length.lsp new file mode 100644 index 0000000..f8a8d78 --- /dev/null +++ b/ansi-tests/file-string-length.lsp @@ -0,0 +1,73 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 22 21:34:04 2004 +;;;; Contains: Tests of FILE-STRING-LENGTH + +(in-package :cl-test) + +(deftest file-string-length.1 + (with-open-file + (s "tmp.dat" :direction :output + :if-exists :supersede) + (loop for x across +standard-chars+ + for len = (file-string-length s x) + do (assert (typep len '(or null (integer 0)))) + do (let ((pos1 (file-position s))) + (write-char x s) + (let ((pos2 (file-position s))) + (when (and pos1 pos2 len) + (assert (= (+ pos1 len) pos2))))))) + nil) + +(deftest file-string-length.2 + (with-open-file + (s "tmp.dat" :direction :output + :if-exists :supersede) + (loop for x across +standard-chars+ + for len = (file-string-length s (string x)) + do (assert (typep len '(or null (integer 0)))) + do (let ((pos1 (file-position s))) + (write-sequence (string x) s) + (let ((pos2 (file-position s))) + (when (and pos1 pos2 len) + (assert (= (+ pos1 len) pos2))))))) + nil) + +(deftest file-string-length.3 + (with-open-file + (stream "tmp.dat" :direction :output + :if-exists :supersede) + (let* ((s1 "abcde") + (n (file-string-length stream s1))) + (do-special-strings + (s2 s1 nil) + (assert (= (file-string-length stream s2) n))))) + nil) + +;;; Error tests + +(deftest file-string-length.error.1 + (signals-error (file-string-length) program-error) + t) + +(deftest file-string-length.error.2 + (signals-error + (with-open-file + (s "tmp.dat" :direction :output + :if-exists :supersede) + (file-string-length s)) + program-error) + t) + +(deftest file-string-length.error.3 + (signals-error + (with-open-file + (s "tmp.dat" :direction :output + :if-exists :supersede) + (file-string-length s #\x nil)) + program-error) + t) + + + + diff --git a/ansi-tests/file-write-date.lsp b/ansi-tests/file-write-date.lsp new file mode 100644 index 0000000..de48dac --- /dev/null +++ b/ansi-tests/file-write-date.lsp @@ -0,0 +1,89 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 6 06:01:35 2004 +;;;; Contains: Tests for FILE-WRITE-DATE + +(in-package :cl-test) + +(deftest file-write-date.1 + (let* ((pn "file-write-date.lsp") + (date (file-write-date pn)) + (time (get-universal-time))) + (or (null date) + (and (integerp date) + (<= 0 date time) + t))) + t) + +(deftest file-write-date.2 + (let* ((pn #p"file-write-date.lsp") + (date (file-write-date pn)) + (time (get-universal-time))) + (or (null date) + (and (integerp date) + (<= 0 date time) + t))) + t) + +(deftest file-write-date.3 + (let* ((pn (truename "file-write-date.lsp")) + (date (file-write-date pn)) + (time (get-universal-time))) + (or (null date) + (and (integerp date) + (<= 0 date time) + t))) + t) + +(deftest file-write-date.4 + (loop for pn in (directory + (make-pathname :name :wild :type :wild + :defaults *default-pathname-defaults*)) + for date = (file-write-date pn) + for time = (get-universal-time) + unless (or (null date) + (<= 0 date time)) + collect (list pn date time)) + nil) + +(deftest file-write-date.5 + (length (multiple-value-list (file-write-date "file-write-date.lsp"))) + 1) + +;;; Specialized string tests + +(deftest file-write-date.6 + (let* ((str "file-write-date.lsp") + (date (file-write-date str))) + (do-special-strings + (s str nil) + (assert (equal (file-write-date s) date)))) + nil) + +;;; FIXME +;;; Add LPN test + +;;; Error tests + +(deftest file-write-date.error.1 + (signals-error (file-write-date) program-error) + t) + +(deftest file-write-date.error.2 + (signals-error (file-write-date "file-write-date.lsp" nil) + program-error) + t) + +(deftest file-write-date.error.3 + (signals-error-always + (file-write-date (make-pathname :name :wild :type "lsp" + :defaults *default-pathname-defaults*)) + file-error) + t t) + +(deftest file-write-date.error.4 + (signals-error-always + (file-write-date (make-pathname :name "file-write-date" :type :wild + :defaults *default-pathname-defaults*)) + file-error) + t t) diff --git a/ansi-tests/fill-pointer.lsp b/ansi-tests/fill-pointer.lsp new file mode 100644 index 0000000..2f86e42 --- /dev/null +++ b/ansi-tests/fill-pointer.lsp @@ -0,0 +1,82 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 21 22:14:23 2003 +;;;; Contains: Tests of FILL-POINTER + +(in-package :cl-test) + +;;; More tests are in make-array.lsp + +(deftest fill-pointer.1 + (fill-pointer (make-array '(10) :fill-pointer 5)) + 5) + +(deftest fill-pointer.2 + (fill-pointer (make-array '(10) :fill-pointer t)) + 10) + +(deftest fill-pointer.3 + (let ((a (make-array '(10) :fill-pointer 5 + :initial-contents '(1 2 3 4 5 6 7 8 9 10)))) + (values + (fill-pointer a) + (setf (fill-pointer a) 6) + a)) + 5 6 #(1 2 3 4 5 6)) + +(deftest fill-pointer.order.1 + (let ((i 0) + (a (make-array '(10) :fill-pointer 5))) + (values + (fill-pointer (progn (incf i) a)) + i)) + 5 1) + +(deftest fill-pointer.order.2 + (let ((i 0) x y + (a (make-array '(10) :fill-pointer 5 + :initial-contents '(1 2 3 4 5 6 7 8 9 10)))) + (values + i + (setf (fill-pointer (progn (setf x (incf i)) a)) + (progn (setf y (incf i)) 6)) + a + i x y)) + 0 6 #(1 2 3 4 5 6) 2 1 2) + +;;; Error tests + +(deftest fill-pointer.error.1 + (classify-error (fill-pointer)) + program-error) + +(deftest fill-pointer.error.2 + (classify-error (fill-pointer (make-array '(10) :fill-pointer 4) + nil)) + program-error) + +(deftest fill-pointer.error.3 + (classify-error (fill-pointer (make-array '(10) :fill-pointer nil))) + type-error) + +(deftest fill-pointer.error.4 + (classify-error (fill-pointer #0aNIL)) + type-error) + +(deftest fill-pointer.error.5 + (classify-error (fill-pointer #2a((a b c)(d e f)))) + type-error) + +(deftest fill-pointer.error.6 + (let (why) + (loop for e in *mini-universe* + when (and (or (not (typep e 'vector)) + (not (array-has-fill-pointer-p e))) + (not (eql (setq why (classify-error** `(fill-pointer ',e))) + 'type-error))) + collect (list e why))) + nil) + +(deftest fill-pointer.error.7 + (classify-error (locally (fill-pointer #2a((a b c)(d e f))) t)) + type-error) diff --git a/ansi-tests/fill-strings.lsp b/ansi-tests/fill-strings.lsp new file mode 100644 index 0000000..38bdc3c --- /dev/null +++ b/ansi-tests/fill-strings.lsp @@ -0,0 +1,26 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 17 08:04:27 2002 +;;;; Contains: Test cases for FILL on strings + +(in-package :cl-test) + +(deftest array-string-fill.1 + (array-string-fill-test-fn "abcde" #\Z) + t "ZZZZZ") + +(deftest array-string-fill.2 + (array-string-fill-test-fn "abcde" #\Z :start 2) + t "abZZZ") + +(deftest array-string-fill.3 + (array-string-fill-test-fn "abcde" #\Z :end 3) + t "ZZZde") + +(deftest array-string-fill.4 + (array-string-fill-test-fn "abcde" #\Z :start 1 :end 4) + t "aZZZe") + +(deftest array-string-fill.5 + (array-string-fill-test-fn "abcde" #\Z :start 2 :end 3) + t "abZde") diff --git a/ansi-tests/fill.lsp b/ansi-tests/fill.lsp new file mode 100644 index 0000000..6e85f1f --- /dev/null +++ b/ansi-tests/fill.lsp @@ -0,0 +1,522 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 19:44:45 2002 +;;;; Contains: Tests on FILL + +(in-package :cl-test) + +(deftest fill.error.1 + (classify-error (fill 'a 'b)) + type-error) + +(deftest fill.error.2 + (classify-error (fill)) + program-error) + +(deftest fill.error.3 + (classify-error (fill (list 'a 'b))) + program-error) + +(deftest fill.error.4 + (classify-error (fill (list 'a 'b) 'c :bad t)) + program-error) + +(deftest fill.error.5 + (classify-error (fill (list 'a 'b) 'c :bad t :allow-other-keys nil)) + program-error) + +(deftest fill.error.6 + (classify-error (fill (list 'a 'b) 'c :start)) + program-error) + +(deftest fill.error.7 + (classify-error (fill (list 'a 'b) 'c :end)) + program-error) + +(deftest fill.error.8 + (classify-error (fill (list 'a 'b) 'c 1 2)) + program-error) + +(deftest fill.error.10 + (classify-error (fill (list 'a 'b) 'c :bad t :allow-other-keys nil + :allow-other-keys t)) + program-error) + +(deftest fill.error.11 + (classify-error (locally (fill 'a 'b) t)) + type-error) + +;;; Fill on arrays + +(deftest array-fill-1 + (let* ((a (make-array '(5) :initial-contents '(a b c d e))) + (b (fill a 'x))) + (values (eqt a b) + (map 'list #'identity a))) + t (x x x x x)) + +(deftest array-fill-2 + (let* ((a (make-array '(5) :initial-contents '(a b c d e))) + (b (fill a 'x :start 2))) + (values (eqt a b) + (map 'list #'identity a))) + t (a b x x x)) + +(deftest array-fill-3 + (let* ((a (make-array '(5) :initial-contents '(a b c d e))) + (b (fill a 'x :end 2))) + (values (eqt a b) + (map 'list #'identity a))) + t (x x c d e)) + +(deftest array-fill-4 + (let* ((a (make-array '(5) :initial-contents '(a b c d e))) + (b (fill a 'x :start 1 :end 3))) + (values (eqt a b) + (map 'list #'identity a))) + t (a x x d e)) + +(deftest array-fill-5 + (let* ((a (make-array '(5) :initial-contents '(a b c d e))) + (b (fill a 'x :start 1 :end nil))) + (values (eqt a b) + (map 'list #'identity a))) + t (a x x x x)) + +(deftest array-fill-6 + (let* ((a (make-array '(5) :initial-contents '(a b c d e))) + (b (fill a 'x :end nil))) + (values (eqt a b) + (map 'list #'identity a))) + t (x x x x x)) + +(deftest array-fill-7 + (classify-error + (let* ((a (make-array '(5)))) + (fill a 'x :start -1))) + type-error) + +(deftest array-fill-8 + (classify-error + (let* ((a (make-array '(5)))) + (fill a 'x :start 'a))) + type-error) + +(deftest array-fill-9 + (classify-error + (let* ((a (make-array '(5)))) + (fill a 'x :end -1))) + type-error) + +(deftest array-fill-10 + (classify-error + (let* ((a (make-array '(5)))) + (fill a 'x :end 'a))) + type-error) + +;;; fill on arrays of fixnums + +(deftest array-fixnum-fill-1 + (let* ((a (make-array '(5) :element-type 'fixnum :initial-contents '(1 2 3 4 5))) + (b (fill a 6))) + (values (eqt a b) + (map 'list #'identity a))) + t (6 6 6 6 6)) + +(deftest array-fixnum-fill-2 + (let* ((a (make-array '(5) :element-type 'fixnum :initial-contents '(1 2 3 4 5))) + (b (fill a 6 :start 2))) + (values (eqt a b) + (map 'list #'identity a))) + t (1 2 6 6 6)) + +(deftest array-fixnum-fill-3 + (let* ((a (make-array '(5) :element-type 'fixnum :initial-contents '(1 2 3 4 5))) + (b (fill a 7 :end 2))) + (values (eqt a b) + (map 'list #'identity a))) + t (7 7 3 4 5)) + +(deftest array-fixnum-fill-4 + (let* ((a (make-array '(5) :element-type 'fixnum :initial-contents '(1 2 3 4 5))) + (b (fill a 8 :start 1 :end 3))) + (values (eqt a b) + (map 'list #'identity a))) + t (1 8 8 4 5)) + +(deftest array-fixnum-fill-5 + (let* ((a (make-array '(5) :element-type 'fixnum :initial-contents '(1 2 3 4 5))) + (b (fill a 0 :start 1 :end nil))) + (values (eqt a b) + (map 'list #'identity a))) + t (1 0 0 0 0)) + +(deftest array-fixnum-fill-6 + (let* ((a (make-array '(5) :element-type 'fixnum :initial-contents '(1 2 3 4 5))) + (b (fill a -1 :end nil))) + (values (eqt a b) + (map 'list #'identity a))) + t (-1 -1 -1 -1 -1)) + +(deftest array-fixnum-fill-7 + (classify-error + (let* ((a (make-array '(5) :element-type 'fixnum))) + (fill a 10 :start -1))) + type-error) + +(deftest array-fixnum-fill-8 + (classify-error + (let* ((a (make-array '(5) :element-type 'fixnum))) + (fill a 100 :start 'a))) + type-error) + +(deftest array-fixnum-fill-9 + (classify-error + (let* ((a (make-array '(5) :element-type 'fixnum))) + (fill a -5 :end -1))) + type-error) + +(deftest array-fixnum-fill-10 + (classify-error + (let* ((a (make-array '(5) :element-type 'fixnum))) + (fill a 17 :end 'a))) + type-error) + +;;; fill on arrays of unsigned eight bit bytes + +(deftest array-unsigned-byte8-fill-1 + (array-unsigned-byte-fill-test-fn 8 6) + t (6 6 6 6 6)) + +(deftest array-unsigned-byte8-fill-2 + (array-unsigned-byte-fill-test-fn 8 6 :start 2) + t (1 2 6 6 6)) + +(deftest array-unsigned-byte8-fill-3 + (array-unsigned-byte-fill-test-fn 8 7 :end 2) + t (7 7 3 4 5)) + +(deftest array-unsigned-byte8-fill-4 + (array-unsigned-byte-fill-test-fn 8 8 :start 1 :end 3) + t (1 8 8 4 5)) + +(deftest array-unsigned-byte8-fill-5 + (array-unsigned-byte-fill-test-fn 8 9 :start 1 :end nil) + t (1 9 9 9 9)) + +(deftest array-unsigned-byte8-fill-6 + (array-unsigned-byte-fill-test-fn 8 0 :end nil) + t (0 0 0 0 0)) + +(deftest array-unsigned-byte8-fill-7 + (classify-error (array-unsigned-byte-fill-test-fn 8 0 :start -1)) + type-error) + +(deftest array-unsigned-byte8-fill-8 + (classify-error (array-unsigned-byte-fill-test-fn 8 100 :start 'a)) + type-error) + +(deftest array-unsigned-byte8-fill-9 + (classify-error (array-unsigned-byte-fill-test-fn 8 19 :end -1)) + type-error) + +(deftest array-unsigned-byte8-fill-10 + (classify-error (array-unsigned-byte-fill-test-fn 8 17 :end 'a)) + type-error) + +;;; Tests on arrays with fill pointers + +(deftest array-fill-pointer-fill.1 + (let ((s1 (make-array '(10) :fill-pointer 5 :initial-element nil))) + (fill s1 'a) + (loop for i from 0 to 9 collect (aref s1 i))) + (a a a a a nil nil nil nil nil)) + +(deftest array-fill-pointer-fill.2 + (let ((s1 (make-array '(10) :fill-pointer 5 :initial-element nil))) + (fill s1 'a :end nil) + (loop for i from 0 to 9 collect (aref s1 i))) + (a a a a a nil nil nil nil nil)) + +;;; Tests on strings + +(deftest fill.string.1 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z))) + (values (eqt s1 s2) s2)) + t + "zzzzz") + +(deftest fill.string.2 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z :start 0 :end 1))) + (values (eqt s1 s2) s2)) + t + "zbcde") + +(deftest fill.string.3 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z :end 2))) + (values (eqt s1 s2) s2)) + t + "zzcde") + +(deftest fill.string.4 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z :end nil))) + (values (eqt s1 s2) s2)) + t + "zzzzz") + +(deftest fill.string.5 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for start from 0 to (1- len) + always + (loop for end from (1+ start) to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :start start :end end))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :start start :end end)) + t))))) + t) + +(deftest fill.string.6 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :start start))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :start start)) + t)))) + t) + +(deftest fill.string.7 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :end nil :start start))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :end nil :start start)) + t)))) + t) + +(deftest fill.string.8 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for end from 1 to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :end end))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :end end)) + t)))) + t) + +(deftest fill.string.9 + (let* ((s1 (make-array '(8) :element-type 'character + :initial-element #\z + :fill-pointer 4)) + (s2 (fill s1 #\a))) + (and (eqt s1 s2) + (coerce (loop for i from 0 to 7 collect (aref s2 i)) + 'string))) + "aaaazzzz") + +(deftest fill.string.10 + (let* ((s1 (make-array '(8) :element-type 'base-char + :initial-element #\z + :fill-pointer 4)) + (s2 (fill s1 #\a))) + (and (eqt s1 s2) + (coerce (loop for i from 0 to 7 collect (aref s2 i)) + 'base-string))) + "aaaazzzz") + +;;; Tests for bit vectors + +(deftest fill.bit-vector.1 + (let* ((s1 (copy-seq #*01100)) + (s2 (fill s1 0))) + (values (eqt s1 s2) s2)) + t + #*00000) + +(deftest fill.bit-vector.2 + (let* ((s1 (copy-seq #*00100)) + (s2 (fill s1 1 :start 0 :end 1))) + (values (eqt s1 s2) s2)) + t + #*10100) + +(deftest fill.bit-vector.3 + (let* ((s1 (copy-seq #*00010)) + (s2 (fill s1 1 :end 2))) + (values (eqt s1 s2) s2)) + t + #*11010) + +(deftest fill.bit-vector.4 + (let* ((s1 (copy-seq #*00111)) + (s2 (fill s1 0 :end nil))) + (values (eqt s1 s2) s2)) + t + #*00000) + +(deftest fill.bit-vector.5 + (let* ((s1 #*00000000) + (len (length s1))) + (loop for start from 0 to (1- len) + always + (loop for end from (1+ start) to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 1 :start start :end end))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 1 (constantly t) s1 + :start start :end end)) + t))))) + t) + +(deftest fill.bit-vector.6 + (let* ((s1 #*11111111) + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 0 :start start))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 0 (constantly t) s1 + :start start)) + t)))) + t) + +(deftest fill.bit-vector.7 + (let* ((s1 #*00000000) + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 1 :end nil :start start))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 1 (constantly t) s1 + :end nil :start start)) + t)))) + t) + +(deftest fill.bit-vector.8 + (let* ((s1 #*11111111) + (len (length s1))) + (loop for end from 1 to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 0 :end end))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 0 (constantly t) s1 + :end end)) + t)))) + t) + +(deftest fill.bit-vector.9 + (let* ((s1 (make-array '(8) :element-type 'bit + :initial-element 0 + :fill-pointer 4)) + (s2 (fill s1 1))) + (and (eqt s1 s2) + (coerce (loop for i from 0 to 7 collect (aref s2 i)) + 'bit-vector))) + #*11110000) + +;;; Test of :allow-other-keys + +(deftest fill.allow-other-keys.1 + (fill (list 'a 'b 'c 'd 'e) 'a :allow-other-keys t) + (a a a a a)) + +(deftest fill.allow-other-keys.2 + (fill (list 'a 'b 'c 'd 'e) 'a :allow-other-keys nil) + (a a a a a)) + +(deftest fill.allow-other-keys.3 + (fill (list 'a 'b 'c 'd 'e) 'a :allow-other-keys t :bad t) + (a a a a a)) + +(deftest fill.allow-other-keys.4 + (fill (list 'a 'b 'c 'd 'e) 'a :bad t :allow-other-keys t) + (a a a a a)) + +(deftest fill.allow-other-keys.5 + (fill (list 'a 'b 'c 'd 'e) 'a 'bad t :allow-other-keys t) + (a a a a a)) + +(deftest fill.allow-other-keys.6 + (fill (list 'a 'b 'c 'd 'e) 'a :bad t :allow-other-keys t + :allow-other-keys nil) + (a a a a a)) + +(deftest fill.allow-other-keys.7 + (fill (list 'a 'b 'c 'd 'e) 'a :allow-other-keys t :allow-other-keys nil + :bad t) + (a a a a a)) + + +;;; Tests of evaluation order + +(deftest fill.order.1 + (let ((i 0) x y (a (copy-seq #(a a a a)))) + (values + (fill (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 'z)) + i x y)) + #(z z z z) 2 1 2) + +(deftest fill.order.2 + (let ((i 0) x y z w (a (copy-seq #(a a a a)))) + (values + (fill (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 'z) + :start (progn (setf z (incf i)) 1) + :end (progn (setf w (incf i)) 3)) + i x y z w)) + #(a z z a) 4 1 2 3 4) + +(deftest fill.order.3 + (let ((i 0) x y z w (a (copy-seq #(a a a a)))) + (values + (fill (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 'z) + :end (progn (setf z (incf i)) 3) + :start (progn (setf w (incf i)) 1)) + i x y z w)) + #(a z z a) 4 1 2 3 4) + +(deftest fill.order.4 + (let ((i 0) x y z p q r s w (a (copy-seq #(a a a a)))) + (values + (fill (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 'z) + :end (progn (setf z (incf i)) 3) + :end (progn (setf p (incf i)) 1) + :end (progn (setf q (incf i)) 1) + :end (progn (setf r (incf i)) 1) + :start (progn (setf s (incf i)) 1) + :start (progn (setf w (incf i)) 0)) + i x y z p q r s w)) + #(a z z a) 8 1 2 3 4 5 6 7 8) diff --git a/ansi-tests/find-if-not.lsp b/ansi-tests/find-if-not.lsp new file mode 100644 index 0000000..7d5e7b2 --- /dev/null +++ b/ansi-tests/find-if-not.lsp @@ -0,0 +1,611 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 28 20:53:24 2002 +;;;; Contains: Tests for FIND-IF-NOT + +(in-package :cl-test) + +(deftest find-if-not-list.1 + (find-if-not #'identity ()) + nil) + +(deftest find-if-not-list.2 + (find-if-not #'null '(a)) + a) + +(deftest find-if-not-list.2a + (find-if-not 'null '(a)) + a) + +(deftest find-if-not-list.3 + (find-if-not #'oddp '(1 2 4 8 3 1 6 7)) + 2) + +(deftest find-if-not-list.4 + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :from-end t) + 6) + +(deftest find-if-not-list.5 + (loop for i from 0 to 7 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :start i)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-not-list.6 + (loop for i from 0 to 7 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :start i :end nil)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-not-list.7 + (loop for i from 0 to 7 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :start i :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-not-list.8 + (loop for i from 0 to 7 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :start i :end nil :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-not-list.9 + (loop for i from 0 to 8 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :end i)) + (nil nil 2 2 2 2 2 2 2)) + +(deftest find-if-not-list.10 + (loop for i from 0 to 8 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :end i :from-end t)) + (nil nil 2 4 8 8 8 6 6)) + +(deftest find-if-not-list.11 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :start j :end i))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-not-list.12 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'oddp '(1 2 4 8 3 1 6 7) :start j :end i + :from-end t))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-not-list.13 + (loop for i from 0 to 6 + collect + (find-if-not #'oddp '(1 6 11 32 45 71 100) :key #'1+ :start i)) + (1 11 11 45 45 71 nil)) + +(deftest find-if-not-list.14 + (loop for i from 0 to 6 + collect + (find-if-not #'oddp '(1 6 11 32 45 71 100) :key '1+ :start i :from-end t)) + (71 71 71 71 71 71 nil)) + +(deftest find-if-not-list.15 + (loop for i from 0 to 7 + collect + (find-if-not #'oddp '(1 6 11 32 45 71 100) :key #'1+ :end i)) + (nil 1 1 1 1 1 1 1)) + +(deftest find-if-not-list.16 + (loop for i from 0 to 7 + collect + (find-if-not #'oddp '(1 6 11 32 45 71 100) :key '1+ :end i :from-end t)) + (nil 1 1 11 11 45 71 71)) + +(deftest find-if-not-list.17 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'evenp '(1 2 4 8 3 1 6 7) :start j :end i :key #'1-))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-not-list.18 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'evenp '(1 2 4 8 3 1 6 7) :start j :end i + :from-end t :key #'1+))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +;;; tests for vectors + +(deftest find-if-not-vector.1 + (find-if-not #'identity #()) + nil) + +(deftest find-if-not-vector.2 + (find-if-not #'not #(a)) + a) + +(deftest find-if-not-vector.2a + (find-if-not 'null #(a)) + a) + +(deftest find-if-not-vector.3 + (find-if-not #'oddp #(1 2 4 8 3 1 6 7)) + 2) + +(deftest find-if-not-vector.4 + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :from-end t) + 6) + +(deftest find-if-not-vector.5 + (loop for i from 0 to 7 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :start i)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-not-vector.6 + (loop for i from 0 to 7 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :start i :end nil)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-not-vector.7 + (loop for i from 0 to 7 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :start i :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-not-vector.8 + (loop for i from 0 to 7 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :start i :end nil :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-not-vector.9 + (loop for i from 0 to 8 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :end i)) + (nil nil 2 2 2 2 2 2 2)) + +(deftest find-if-not-vector.10 + (loop for i from 0 to 8 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :end i :from-end t)) + (nil nil 2 4 8 8 8 6 6)) + +(deftest find-if-not-vector.11 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :start j :end i))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-not-vector.12 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'oddp #(1 2 4 8 3 1 6 7) :start j :end i + :from-end t))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-not-vector.13 + (loop for i from 0 to 6 + collect + (find-if-not #'oddp #(1 6 11 32 45 71 100) :key #'1+ :start i)) + (1 11 11 45 45 71 nil)) + +(deftest find-if-not-vector.14 + (loop for i from 0 to 6 + collect + (find-if-not #'oddp #(1 6 11 32 45 71 100) :key '1+ :start i :from-end t)) + (71 71 71 71 71 71 nil)) + +(deftest find-if-not-vector.15 + (loop for i from 0 to 7 + collect + (find-if-not #'oddp #(1 6 11 32 45 71 100) :key #'1+ :end i)) + (nil 1 1 1 1 1 1 1)) + +(deftest find-if-not-vector.16 + (loop for i from 0 to 7 + collect + (find-if-not #'oddp #(1 6 11 32 45 71 100) :key '1+ :end i :from-end t)) + (nil 1 1 11 11 45 71 71)) + +(deftest find-if-not-vector.17 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'evenp #(1 2 4 8 3 1 6 7) :start j :end i :key #'1-))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-not-vector.18 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'evenp #(1 2 4 8 3 1 6 7) :start j :end i + :from-end t :key #'1+))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +;;; Tests for bit vectors + +(deftest find-if-not-bit-vector.1 + (find-if-not #'identity #*) + nil) + +(deftest find-if-not-bit-vector.2 + (find-if-not #'null #*1) + 1) + +(deftest find-if-not-bit-vector.3 + (find-if-not #'not #*0) + 0) + +(deftest find-if-not-bit-vector.4 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if-not #'oddp #*0110110 :start i :end j))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +(deftest find-if-not-bit-vector.5 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if-not #'oddp #*0110110 :start i :end j + :from-end t))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +(deftest find-if-not-bit-vector.6 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if-not #'evenp #*0110110 :start i :end j + :from-end t :key #'1+))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +(deftest find-if-not-bit-vector.7 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if-not #'evenp #*0110110 :start i :end j + :key '1-))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +;;; Tests for strings + +(deftest find-if-not-string.1 + (find-if-not #'identity "") + nil) + +(deftest find-if-not-string.2 + (find-if-not #'null "a") + #\a) + +(deftest find-if-not-string.2a + (find-if-not 'null "a") + #\a) + +(deftest find-if-not-string.3 + (find-if-not #'odddigitp "12483167") + #\2) + +(deftest find-if-not-string.3a + (find-if-not #'oddp "12483167" :key #'(lambda (c) (read-from-string (string c)))) + #\2) + +(deftest find-if-not-string.4 + (find-if-not #'odddigitp "12483167" :from-end t) + #\6) + +(deftest find-if-not-string.5 + (loop for i from 0 to 7 collect + (find-if-not #'odddigitp "12483167" :start i)) + (#\2 #\2 #\4 #\8 #\6 #\6 #\6 nil)) + +(deftest find-if-not-string.6 + (loop for i from 0 to 7 collect + (find-if-not #'odddigitp "12483167" :start i :end nil)) + (#\2 #\2 #\4 #\8 #\6 #\6 #\6 nil)) + +(deftest find-if-not-string.7 + (loop for i from 0 to 7 collect + (find-if-not #'odddigitp "12483167" :start i :from-end t)) + (#\6 #\6 #\6 #\6 #\6 #\6 #\6 nil)) + +(deftest find-if-not-string.8 + (loop for i from 0 to 7 collect + (find-if-not #'odddigitp "12483167" :start i :end nil :from-end t)) + (#\6 #\6 #\6 #\6 #\6 #\6 #\6 nil)) + +(deftest find-if-not-string.9 + (loop for i from 0 to 8 collect + (find-if-not #'odddigitp "12483167" :end i)) + (nil nil #\2 #\2 #\2 #\2 #\2 #\2 #\2)) + +(deftest find-if-not-string.10 + (loop for i from 0 to 8 collect + (find-if-not #'odddigitp "12483167" :end i :from-end t)) + (nil nil #\2 #\4 #\8 #\8 #\8 #\6 #\6)) + +(deftest find-if-not-string.11 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'odddigitp "12483167" :start j :end i))) + ((nil #\2 #\2 #\2 #\2 #\2 #\2 #\2) + (#\2 #\2 #\2 #\2 #\2 #\2 #\2) + (#\4 #\4 #\4 #\4 #\4 #\4) + (#\8 #\8 #\8 #\8 #\8) + (nil nil #\6 #\6) + (nil #\6 #\6) + (#\6 #\6) + (nil))) + +(deftest find-if-not-string.12 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if-not #'odddigitp "12483167" :start j :end i + :from-end t))) + ((nil #\2 #\4 #\8 #\8 #\8 #\6 #\6) + (#\2 #\4 #\8 #\8 #\8 #\6 #\6) + (#\4 #\8 #\8 #\8 #\6 #\6) + (#\8 #\8 #\8 #\6 #\6) + (nil nil #\6 #\6) + (nil #\6 #\6) + (#\6 #\6) + (nil))) + +(deftest find-if-not-string.13 + (loop for i from 0 to 6 + collect + (find-if-not #'oddp "1473816" + :key (compose #'read-from-string #'string) + :start i)) + (#\4 #\4 #\8 #\8 #\8 #\6 #\6)) + +(deftest find-if-not-string.14 + (loop for i from 0 to 6 + collect + (find-if-not #'oddp "1473816" + :key (compose #'read-from-string #'string) + :start i :from-end t)) + (#\6 #\6 #\6 #\6 #\6 #\6 #\6)) + +(deftest find-if-not-string.15 + (loop for i from 0 to 7 + collect + (find-if-not #'oddp "1473816" + :key (compose #'read-from-string #'string) + :end i)) + (nil nil #\4 #\4 #\4 #\4 #\4 #\4)) + +(deftest find-if-not-string.16 + (loop for i from 0 to 7 + collect + (find-if-not #'oddp "1473816" + :key (compose #'read-from-string #'string) + :end i :from-end t)) + (nil nil #\4 #\4 #\4 #\8 #\8 #\6)) + +(deftest find-if-not-string.17 + (loop for j from 0 to 6 + collect + (loop for i from (1+ j) to 7 collect + (find-if-not #'oddp "1473816" + :key (compose #'read-from-string #'string) + :start j :end i))) + ((nil #\4 #\4 #\4 #\4 #\4 #\4) + (#\4 #\4 #\4 #\4 #\4 #\4) + (nil nil #\8 #\8 #\8) + (nil #\8 #\8 #\8) + (#\8 #\8 #\8) + (nil #\6) + (#\6))) + +(deftest find-if-not-string.18 + (loop for j from 0 to 6 + collect + (loop for i from (1+ j) to 7 collect + (find-if-not #'oddp "1473816" + :key (compose #'read-from-string #'string) + :start j :end i + :from-end t))) + ((nil #\4 #\4 #\4 #\8 #\8 #\6) + (#\4 #\4 #\4 #\8 #\8 #\6) + (nil nil #\8 #\8 #\6) + (nil #\8 #\8 #\6) + (#\8 #\8 #\6) + (nil #\6) + (#\6))) + + +;;; Keyword tests + +(deftest find-if-not.allow-other-keys.1 + (find-if-not #'oddp '(1 2 3 4 5) :bad t :allow-other-keys t) + 2) + +(deftest find-if-not.allow-other-keys.2 + (find-if-not #'oddp '(1 2 3 4 5) :allow-other-keys t :also-bad t) + 2) + +;;; The leftmost of two :allow-other-keys arguments is the one that matters. +(deftest find-if-not.allow-other-keys.3 + (find-if-not #'oddp '(1 2 3 4 5) + :allow-other-keys t + :allow-other-keys nil + :bad t) + 2) + +(deftest find-if-not.keywords.4 + (find-if-not #'oddp '(1 2 3 4 5) :key #'identity :key #'1+) + 2) + +(deftest find-if-not.allow-other-keys.5 + (find-if-not #'null '(nil a b c nil) :allow-other-keys nil) + a) + +;;; Error tests + +(deftest find-if-not.error.1 + (classify-error (find-if-not #'null 'b)) + type-error) + +(deftest find-if-not.error.2 + (classify-error (find-if-not #'identity 10)) + type-error) + +(deftest find-if-not.error.3 + (classify-error (find-if-not '1+ 1.4)) + type-error) + +(deftest find-if-not.error.4 + (classify-error (find-if-not 'identity '(a b c . d))) + type-error) + +(deftest find-if-not.error.5 + (classify-error (find-if-not)) + program-error) + +(deftest find-if-not.error.6 + (classify-error (find-if-not #'null)) + program-error) + +(deftest find-if-not.error.7 + (classify-error (find-if-not #'null nil :bad t)) + program-error) + +(deftest find-if-not.error.8 + (classify-error (find-if-not #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest find-if-not.error.9 + (classify-error (find-if-not #'null nil 1 1)) + program-error) + +(deftest find-if-not.error.10 + (classify-error (find-if-not #'null nil :key)) + program-error) + +(deftest find-if-not.error.11 + (classify-error (locally (find-if-not #'null 'b) t)) + type-error) + +(deftest find-if-not.error.12 + (classify-error (find-if-not #'cons '(a b c))) + program-error) + +(deftest find-if-not.error.13 + (classify-error (find-if-not #'car '(a b c))) + type-error) + +(deftest find-if-not.error.14 + (classify-error (find-if-not #'identity '(a b c) :key #'cons)) + program-error) + +(deftest find-if-not.error.15 + (classify-error (find-if-not #'identity '(a b c) :key #'car)) + type-error) + +;;; Order of evaluation tests + +(deftest find-if-not.order.1 + (let ((i 0) x y) + (values + (find-if-not (progn (setf x (incf i)) #'null) + (progn (setf y (incf i)) '(nil nil nil a nil nil))) + i x y)) + a 2 1 2) + +(deftest find-if-not.order.2 + (let ((i 0) a b c d e f g) + (values + (find-if-not (progn (setf a (incf i)) #'identity) + (progn (setf b (incf i)) '(nil nil nil a nil nil)) + :start (progn (setf c (incf i)) 1) + :end (progn (setf d (incf i)) 4) + :from-end (setf e (incf i)) + :key (progn (setf f (incf i)) #'null) + ) + i a b c d e f)) + a 6 1 2 3 4 5 6) + + +(deftest find-if-not.order.3 + (let ((i 0) a b c d e f g) + (values + (find-if-not (progn (setf a (incf i)) #'identity) + (progn (setf b (incf i)) '(nil nil nil a nil nil)) + :key (progn (setf c (incf i)) #'null) + :from-end (setf d (incf i)) + :end (progn (setf e (incf i)) 4) + :start (progn (setf f (incf i)) 1) + ) + i a b c d e f)) + a 6 1 2 3 4 5 6) diff --git a/ansi-tests/find-if.lsp b/ansi-tests/find-if.lsp new file mode 100644 index 0000000..71e2a0d --- /dev/null +++ b/ansi-tests/find-if.lsp @@ -0,0 +1,634 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 28 18:37:52 2002 +;;;; Contains: Tests for FIND-IF + +(in-package :cl-test) + +(deftest find-if-list.1 + (find-if #'identity ()) + nil) + +(deftest find-if-list.2 + (find-if #'identity '(a)) + a) + +(deftest find-if-list.2a + (find-if 'identity '(a)) + a) + +(deftest find-if-list.3 + (find-if #'evenp '(1 2 4 8 3 1 6 7)) + 2) + +(deftest find-if-list.4 + (find-if #'evenp '(1 2 4 8 3 1 6 7) :from-end t) + 6) + +(deftest find-if-list.5 + (loop for i from 0 to 7 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :start i)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-list.6 + (loop for i from 0 to 7 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :start i :end nil)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-list.7 + (loop for i from 0 to 7 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :start i :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-list.8 + (loop for i from 0 to 7 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :start i :end nil :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-list.9 + (loop for i from 0 to 8 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :end i)) + (nil nil 2 2 2 2 2 2 2)) + +(deftest find-if-list.10 + (loop for i from 0 to 8 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :end i :from-end t)) + (nil nil 2 4 8 8 8 6 6)) + +(deftest find-if-list.11 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :start j :end i))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-list.12 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'evenp '(1 2 4 8 3 1 6 7) :start j :end i + :from-end t))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-list.13 + (loop for i from 0 to 6 + collect + (find-if #'evenp '(1 6 11 32 45 71 100) :key #'1+ :start i)) + (1 11 11 45 45 71 nil)) + +(deftest find-if-list.14 + (loop for i from 0 to 6 + collect + (find-if #'evenp '(1 6 11 32 45 71 100) :key '1+ :start i :from-end t)) + (71 71 71 71 71 71 nil)) + +(deftest find-if-list.15 + (loop for i from 0 to 7 + collect + (find-if #'evenp '(1 6 11 32 45 71 100) :key #'1+ :end i)) + (nil 1 1 1 1 1 1 1)) + +(deftest find-if-list.16 + (loop for i from 0 to 7 + collect + (find-if #'evenp '(1 6 11 32 45 71 100) :key '1+ :end i :from-end t)) + (nil 1 1 11 11 45 71 71)) + +(deftest find-if-list.17 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'oddp '(1 2 4 8 3 1 6 7) :start j :end i :key #'1-))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-list.18 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'oddp '(1 2 4 8 3 1 6 7) :start j :end i + :from-end t :key #'1+))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +;;; tests for vectors + +(deftest find-if-vector.1 + (find-if #'identity #()) + nil) + +(deftest find-if-vector.2 + (find-if #'identity #(a)) + a) + +(deftest find-if-vector.2a + (find-if 'identity #(a)) + a) + +(deftest find-if-vector.3 + (find-if #'evenp #(1 2 4 8 3 1 6 7)) + 2) + +(deftest find-if-vector.4 + (find-if #'evenp #(1 2 4 8 3 1 6 7) :from-end t) + 6) + +(deftest find-if-vector.5 + (loop for i from 0 to 7 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :start i)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-vector.6 + (loop for i from 0 to 7 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :start i :end nil)) + (2 2 4 8 6 6 6 nil)) + +(deftest find-if-vector.7 + (loop for i from 0 to 7 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :start i :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-vector.8 + (loop for i from 0 to 7 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :start i :end nil :from-end t)) + (6 6 6 6 6 6 6 nil)) + +(deftest find-if-vector.9 + (loop for i from 0 to 8 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :end i)) + (nil nil 2 2 2 2 2 2 2)) + +(deftest find-if-vector.10 + (loop for i from 0 to 8 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :end i :from-end t)) + (nil nil 2 4 8 8 8 6 6)) + +(deftest find-if-vector.11 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :start j :end i))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-vector.12 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'evenp #(1 2 4 8 3 1 6 7) :start j :end i + :from-end t))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-vector.13 + (loop for i from 0 to 6 + collect + (find-if #'evenp #(1 6 11 32 45 71 100) :key #'1+ :start i)) + (1 11 11 45 45 71 nil)) + +(deftest find-if-vector.14 + (loop for i from 0 to 6 + collect + (find-if #'evenp #(1 6 11 32 45 71 100) :key '1+ :start i :from-end t)) + (71 71 71 71 71 71 nil)) + +(deftest find-if-vector.15 + (loop for i from 0 to 7 + collect + (find-if #'evenp #(1 6 11 32 45 71 100) :key #'1+ :end i)) + (nil 1 1 1 1 1 1 1)) + +(deftest find-if-vector.16 + (loop for i from 0 to 7 + collect + (find-if #'evenp #(1 6 11 32 45 71 100) :key '1+ :end i :from-end t)) + (nil 1 1 11 11 45 71 71)) + +(deftest find-if-vector.17 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'oddp #(1 2 4 8 3 1 6 7) :start j :end i :key #'1-))) + ((nil 2 2 2 2 2 2 2) + (2 2 2 2 2 2 2) + (4 4 4 4 4 4) + (8 8 8 8 8) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-vector.18 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'oddp #(1 2 4 8 3 1 6 7) :start j :end i + :from-end t :key #'1+))) + ((nil 2 4 8 8 8 6 6) + (2 4 8 8 8 6 6) + (4 8 8 8 6 6) + (8 8 8 6 6) + (nil nil 6 6) + (nil 6 6) + (6 6) + (nil))) + +(deftest find-if-vector.19 + (let ((a (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10) + :fill-pointer 5))) + (values + (find-if #'evenp a) + (find-if #'evenp a :from-end t) + (find-if #'oddp a) + (find-if #'oddp a :from-end t) + )) + 2 4 1 5) + +;;; Tests for bit vectors + +(deftest find-if-bit-vector.1 + (find-if #'identity #*) + nil) + +(deftest find-if-bit-vector.2 + (find-if #'identity #*1) + 1) + +(deftest find-if-bit-vector.3 + (find-if #'identity #*0) + 0) + +(deftest find-if-bit-vector.4 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if #'evenp #*0110110 :start i :end j))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +(deftest find-if-bit-vector.5 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if #'evenp #*0110110 :start i :end j + :from-end t))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +(deftest find-if-bit-vector.6 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if #'oddp #*0110110 :start i :end j + :from-end t :key #'1+))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +(deftest find-if-bit-vector.7 + (loop for i from 0 to 6 + collect (loop for j from i to 7 + collect (find-if #'oddp #*0110110 :start i :end j + :key '1-))) + ((nil 0 0 0 0 0 0 0) + (nil nil nil 0 0 0 0) + (nil nil 0 0 0 0) + (nil 0 0 0 0) + (nil nil nil 0) + (nil nil 0) + (nil 0))) + +;;; Tests for strings + +(deftest find-if-string.1 + (find-if #'identity "") + nil) + +(deftest find-if-string.2 + (find-if #'identity "a") + #\a) + +(deftest find-if-string.2a + (find-if 'identity "a") + #\a) + +(deftest find-if-string.3 + (find-if #'evendigitp "12483167") + #\2) + +(deftest find-if-string.3a + (find-if #'evenp "12483167" :key #'(lambda (c) (read-from-string (string c)))) + #\2) + +(deftest find-if-string.4 + (find-if #'evendigitp "12483167" :from-end t) + #\6) + +(deftest find-if-string.5 + (loop for i from 0 to 7 collect + (find-if #'evendigitp "12483167" :start i)) + (#\2 #\2 #\4 #\8 #\6 #\6 #\6 nil)) + +(deftest find-if-string.6 + (loop for i from 0 to 7 collect + (find-if #'evendigitp "12483167" :start i :end nil)) + (#\2 #\2 #\4 #\8 #\6 #\6 #\6 nil)) + +(deftest find-if-string.7 + (loop for i from 0 to 7 collect + (find-if #'evendigitp "12483167" :start i :from-end t)) + (#\6 #\6 #\6 #\6 #\6 #\6 #\6 nil)) + +(deftest find-if-string.8 + (loop for i from 0 to 7 collect + (find-if #'evendigitp "12483167" :start i :end nil :from-end t)) + (#\6 #\6 #\6 #\6 #\6 #\6 #\6 nil)) + +(deftest find-if-string.9 + (loop for i from 0 to 8 collect + (find-if #'evendigitp "12483167" :end i)) + (nil nil #\2 #\2 #\2 #\2 #\2 #\2 #\2)) + +(deftest find-if-string.10 + (loop for i from 0 to 8 collect + (find-if #'evendigitp "12483167" :end i :from-end t)) + (nil nil #\2 #\4 #\8 #\8 #\8 #\6 #\6)) + +(deftest find-if-string.11 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'evendigitp "12483167" :start j :end i))) + ((nil #\2 #\2 #\2 #\2 #\2 #\2 #\2) + (#\2 #\2 #\2 #\2 #\2 #\2 #\2) + (#\4 #\4 #\4 #\4 #\4 #\4) + (#\8 #\8 #\8 #\8 #\8) + (nil nil #\6 #\6) + (nil #\6 #\6) + (#\6 #\6) + (nil))) + +(deftest find-if-string.12 + (loop for j from 0 to 7 + collect + (loop for i from (1+ j) to 8 collect + (find-if #'evendigitp "12483167" :start j :end i + :from-end t))) + ((nil #\2 #\4 #\8 #\8 #\8 #\6 #\6) + (#\2 #\4 #\8 #\8 #\8 #\6 #\6) + (#\4 #\8 #\8 #\8 #\6 #\6) + (#\8 #\8 #\8 #\6 #\6) + (nil nil #\6 #\6) + (nil #\6 #\6) + (#\6 #\6) + (nil))) + +(deftest find-if-string.13 + (loop for i from 0 to 6 + collect + (find-if #'evenp "1473816" + :key (compose #'read-from-string #'string) + :start i)) + (#\4 #\4 #\8 #\8 #\8 #\6 #\6)) + +(deftest find-if-string.14 + (loop for i from 0 to 6 + collect + (find-if #'evenp "1473816" + :key (compose #'read-from-string #'string) + :start i :from-end t)) + (#\6 #\6 #\6 #\6 #\6 #\6 #\6)) + +(deftest find-if-string.15 + (loop for i from 0 to 7 + collect + (find-if #'evenp "1473816" + :key (compose #'read-from-string #'string) + :end i)) + (nil nil #\4 #\4 #\4 #\4 #\4 #\4)) + +(deftest find-if-string.16 + (loop for i from 0 to 7 + collect + (find-if #'evenp "1473816" + :key (compose #'read-from-string #'string) + :end i :from-end t)) + (nil nil #\4 #\4 #\4 #\8 #\8 #\6)) + +(deftest find-if-string.17 + (loop for j from 0 to 6 + collect + (loop for i from (1+ j) to 7 collect + (find-if #'evenp "1473816" + :key (compose #'read-from-string #'string) + :start j :end i))) + ((nil #\4 #\4 #\4 #\4 #\4 #\4) + (#\4 #\4 #\4 #\4 #\4 #\4) + (nil nil #\8 #\8 #\8) + (nil #\8 #\8 #\8) + (#\8 #\8 #\8) + (nil #\6) + (#\6))) + +(deftest find-if-string.18 + (loop for j from 0 to 6 + collect + (loop for i from (1+ j) to 7 collect + (find-if #'evenp "1473816" + :key (compose #'read-from-string #'string) + :start j :end i + :from-end t))) + ((nil #\4 #\4 #\4 #\8 #\8 #\6) + (#\4 #\4 #\4 #\8 #\8 #\6) + (nil nil #\8 #\8 #\6) + (nil #\8 #\8 #\6) + (#\8 #\8 #\6) + (nil #\6) + (#\6))) + +(deftest find-if-string.19 + (let ((a (make-array '(10) :initial-contents "123456789a" + :fill-pointer 5 + :element-type 'character))) + (values + (find-if #'evendigitp a) + (find-if #'evendigitp a :from-end t) + (find-if #'odddigitp a) + (find-if #'odddigitp a :from-end t) + )) + #\2 #\4 #\1 #\5) + +;;; Keyword tests + +(deftest find-if.allow-other-keys.1 + (find-if #'evenp '(1 2 3 4 5) :bad t :allow-other-keys t) + 2) + +(deftest find-if.allow-other-keys.2 + (find-if #'evenp '(1 2 3 4 5) :allow-other-keys t :also-bad t) + 2) + +;;; The leftmost of two :allow-other-keys arguments is the one that matters. +(deftest find-if.allow-other-keys.3 + (find-if #'evenp '(1 2 3 4 5) + :allow-other-keys t + :allow-other-keys nil + :bad t) + 2) + +(deftest find-if.keywords.4 + (find-if #'evenp '(1 2 3 4 5) :key #'identity :key #'1+) + 2) + +(deftest find-if.allow-other-keys.5 + (find-if #'identity '(nil a b c nil) :allow-other-keys nil) + a) + + +;;; Error tests + +(deftest find-if.error.1 + (classify-error (find-if #'null 'b)) + type-error) + +(deftest find-if.error.2 + (classify-error (find-if #'identity 10)) + type-error) + +(deftest find-if.error.3 + (classify-error (find-if '1+ 1.4)) + type-error) + +(deftest find-if.error.4 + (classify-error (find-if 'null '(a b c . d))) + type-error) + +(deftest find-if.error.5 + (classify-error (find-if)) + program-error) + +(deftest find-if.error.6 + (classify-error (find-if #'null)) + program-error) + +(deftest find-if.error.7 + (classify-error (find-if #'null nil :bad t)) + program-error) + +(deftest find-if.error.8 + (classify-error (find-if #'null nil :bad t :allow-other-keys nil)) + program-error) + +(deftest find-if.error.9 + (classify-error (find-if #'null nil 1 1)) + program-error) + +(deftest find-if.error.10 + (classify-error (find-if #'null nil :key)) + program-error) + +(deftest find-if.error.11 + (classify-error (locally (find-if #'null 'b) t)) + type-error) + +(deftest find-if.error.12 + (classify-error (find-if #'cons '(a b c))) + program-error) + +(deftest find-if.error.13 + (classify-error (find-if #'car '(a b c))) + type-error) + +(deftest find-if.error.14 + (classify-error (find-if #'identity '(a b c) :key #'cons)) + program-error) + +(deftest find-if.error.15 + (classify-error (find-if #'identity '(a b c) :key #'car)) + type-error) + +;;; Order of evaluation tests + +(deftest find-if.order.1 + (let ((i 0) x y) + (values + (find-if (progn (setf x (incf i)) #'identity) + (progn (setf y (incf i)) '(nil nil nil a nil nil))) + i x y)) + a 2 1 2) + +(deftest find-if.order.2 + (let ((i 0) a b c d e f g) + (values + (find-if (progn (setf a (incf i)) #'null) + (progn (setf b (incf i)) '(nil nil nil a nil nil)) + :start (progn (setf c (incf i)) 1) + :end (progn (setf d (incf i)) 4) + :from-end (setf e (incf i)) + :key (progn (setf f (incf i)) #'null) + ) + i a b c d e f)) + a 6 1 2 3 4 5 6) + + +(deftest find-if.order.3 + (let ((i 0) a b c d e f g) + (values + (find-if (progn (setf a (incf i)) #'null) + (progn (setf b (incf i)) '(nil nil nil a nil nil)) + :key (progn (setf c (incf i)) #'null) + :from-end (setf d (incf i)) + :end (progn (setf e (incf i)) 4) + :start (progn (setf f (incf i)) 1) + ) + i a b c d e f)) + a 6 1 2 3 4 5 6) diff --git a/ansi-tests/find.lsp b/ansi-tests/find.lsp new file mode 100644 index 0000000..c9de8b0 --- /dev/null +++ b/ansi-tests/find.lsp @@ -0,0 +1,870 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Aug 23 07:49:49 2002 +;;;; Contains: Tests for FIND + +(in-package :cl-test) + +(deftest find-list.1 + (find 'c '(a b c d e c a)) + c) + +(deftest find-list.2 + (find 'c '(a b c d e c a) :from-end t) + c) + +(deftest find-list.3 + (loop for i from 0 to 7 collect + (find 'c '(a b c d e c a) :start i)) + (c c c c c c nil nil)) + +(deftest find-list.4 + (loop for i from 0 to 7 collect + (find 'c '(a b c d e c a) :start i :end nil)) + (c c c c c c nil nil)) + +(deftest find-list.5 + (loop for i from 7 downto 0 collect + (find 'c '(a b c d e c a) :end i)) + (c c c c c nil nil nil)) + +(deftest find-list.6 + (loop for i from 0 to 7 collect + (find 'c '(a b c d e c a) :start i :from-end t)) + (c c c c c c nil nil)) + +(deftest find-list.7 + (loop for i from 0 to 7 collect + (find 'c '(a b c d e c a) :start i :end nil :from-end t)) + (c c c c c c nil nil)) + +(deftest find-list.8 + (loop for i from 7 downto 0 collect + (find 'c '(a b c d e c a) :end i :from-end t)) + (c c c c c nil nil nil)) + +(deftest find-list.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find 'c '(a b c d e c a) :start i :end j))) + ((nil nil c c c c c) + (nil c c c c c) + (c c c c c) + (nil nil c c) + (nil c c) + (c c) + (nil))) + +(deftest find-list.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find 'c '(a b c d e c a) :start i :end j :from-end t))) + ((nil nil c c c c c) + (nil c c c c c) + (c c c c c) + (nil nil c c) + (nil c c) + (c c) + (nil))) + +(deftest find-list.11 + (find 5 '(1 2 3 4 5 6 4 8) :key #'1+) + 4) + +(deftest find-list.12 + (find 5 '(1 2 3 4 5 6 4 8) :key '1+) + 4) + +(deftest find-list.13 + (find 5 '(1 2 3 4 5 6 4 8) :key #'1+ :from-end t) + 4) + +(deftest find-list.14 + (find 'a '(a a b a c e d a f a) :test (complement #'eql)) + b) + +(deftest find-list.15 + (find 'a '(a a b a c e d a f a) :test (complement #'eql) + :from-end t) + f) + +(deftest find-list.16 + (find 'a '(a a b a c e d a f a) :test-not #'eql) + b) + +(deftest find-list.17 + (find 'a '(a a b a c e d a f a) :test-not 'eql + :from-end t) + f) + +(deftest find-list.18 + (find 'a '(a a b a c e d a f a) :test-not 'eql) + b) + +(deftest find-list.19 + (find 'a '(a a b a c e d a f a) :test-not #'eql + :from-end t) + f) + +(deftest find-list.20 + (find 'a '(a a b a c e d a f a) :test-not #'eql) + b) + +(deftest find-list.21 + (find 'a '(a a b a c e d a f a) :test #'eql + :start 2) + a) + +(deftest find-list.22 + (find 'a '(a a b a c e d a f a) :test #'eql + :start 2 :end nil) + a) + +(deftest find-list.23 + (find 'a '(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5) + b) + +(deftest find-list.24 + (find 'a '(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5 :from-end t) + c) + +(deftest find-list.25 + (find "ab" '("a" #(#\b #\a) #(#\a #\b #\c) #(#\a #\b) #(#\d #\e) f) :test #'equalp) + #(#\a #\b)) + +(deftest find-list.26 + (find 'a '((c) (b a) (a b c) (a b) (d e) f) :key #'car) + (a b c)) + +(deftest find-list.27 + (find 'a '((c) (b a) (a b c) (z) (a b) (d e) f) :key #'car + :start 3) + (a b)) + +(deftest find-list.28 + (find 'a '((c) (b a) (a b c) (z) (a b) (d e) (f)) :key #'car + :start 2 :from-end t) + (a b)) + +;;; Tests on vectors + +(deftest find-vector.1 + (find 'c #(a b c d e c a)) + c) + +(deftest find-vector.1a + (find 'z #(a b c d e c a)) + nil) + +(deftest find-vector.2 + (find 'c #(a b c d e c a) :from-end t) + c) + +(deftest find-vector.2a + (find 'z #(a b c d e c a) :from-end t) + nil) + +(deftest find-vector.3 + (loop for i from 0 to 7 collect + (find 'c #(a b c d e c a) :start i)) + (c c c c c c nil nil)) + +(deftest find-vector.4 + (loop for i from 0 to 7 collect + (find 'c #(a b c d e c a) :start i :end nil)) + (c c c c c c nil nil)) + +(deftest find-vector.5 + (loop for i from 7 downto 0 collect + (find 'c #(a b c d e c a) :end i)) + (c c c c c nil nil nil)) + +(deftest find-vector.6 + (loop for i from 0 to 7 collect + (find 'c #(a b c d e c a) :start i :from-end t)) + (c c c c c c nil nil)) + +(deftest find-vector.7 + (loop for i from 0 to 7 collect + (find 'c #(a b c d e c a) :start i :end nil :from-end t)) + (c c c c c c nil nil)) + +(deftest find-vector.8 + (loop for i from 7 downto 0 collect + (find 'c #(a b c d e c a) :end i :from-end t)) + (c c c c c nil nil nil)) + +(deftest find-vector.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find 'c #(a b c d e c a) :start i :end j))) + ((nil nil c c c c c) + (nil c c c c c) + (c c c c c) + (nil nil c c) + (nil c c) + (c c) + (nil))) + +(deftest find-vector.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find 'c #(a b c d e c a) :start i :end j :from-end t))) + ((nil nil c c c c c) + (nil c c c c c) + (c c c c c) + (nil nil c c) + (nil c c) + (c c) + (nil))) + +(deftest find-vector.11 + (find 5 #(1 2 3 4 5 6 4 8) :key #'1+) + 4) + +(deftest find-vector.12 + (find 5 #(1 2 3 4 5 6 4 8) :key '1+) + 4) + +(deftest find-vector.13 + (find 5 #(1 2 3 4 5 6 4 8) :key #'1+ :from-end t) + 4) + +(deftest find-vector.14 + (find 'a #(a a b a c e d a f a) :test (complement #'eql)) + b) + +(deftest find-vector.15 + (find 'a #(a a b a c e d a f a) :test (complement #'eql) + :from-end t) + f) + +(deftest find-vector.16 + (find 'a #(a a b a c e d a f a) :test-not #'eql) + b) + +(deftest find-vector.17 + (find 'a #(a a b a c e d a f a) :test-not 'eql + :from-end t) + f) + +(deftest find-vector.18 + (find 'a #(a a b a c e d a f a) :test-not 'eql) + b) + +(deftest find-vector.19 + (find 'a #(a a b a c e d a f a) :test-not #'eql + :from-end t) + f) + +(deftest find-vector.20 + (find 'a #(a a b a c e d a f a) :test-not #'eql) + b) + +(deftest find-vector.21 + (find 'a #(a a b a c e d a f a) :test #'eql + :start 2) + a) + +(deftest find-vector.22 + (find 'a #(a a b a c e d a f a) :test #'eql + :start 2 :end nil) + a) + +(deftest find-vector.23 + (find 'a #(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5) + b) + +(deftest find-vector.24 + (find 'a #(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5 :from-end t) + c) + +(deftest find-vector.25 + (find "ab" #("a" #(#\b #\a) #(#\a #\b #\c) #(#\a #\b) #(#\d #\e) f) :test #'equalp) + #(#\a #\b)) + +(deftest find-vector.26 + (find 'a #((c) (b a) (a b c) (a b) (d e) f) :key #'car) + (a b c)) + +(deftest find-vector.27 + (find 'a #((c) (b a) (a b c) (z) (a b) (d e) f) :key #'car + :start 3) + (a b)) + +(deftest find-vector.28 + (find 'a #((c) (b a) (a b c) (z) (a b) (d e) (f)) :key #'car + :start 2 :from-end t) + (a b)) + +(deftest find-vector.29 + (let ((a (make-array '(10) + :initial-contents '(1 2 3 4 5 6 7 8 9 10) + :fill-pointer 5))) + (loop for i from 1 to 10 collect (find i a))) + (1 2 3 4 5 nil nil nil nil nil)) + +(deftest find-vector.30 + (let ((a (make-array '(10) + :initial-contents (loop for i from 1 for e in '(1 2 3 4 5 5 4 3 2 1) + collect (list e i)) + :fill-pointer 5))) + (loop for i from 1 to 5 collect (find i a :from-end t :key #'car))) + ((1 1) (2 2) (3 3) (4 4) (5 5))) + +;;; tests on bit vectors + +(deftest find-bit-vector.1 + (find 1 #*001001010100) + 1) + +(deftest find-bit-vector.1a + (find 0 #*001001010100) + 0) + +(deftest find-bit-vector.1b + (find 2 #*001001010100) + nil) + +(deftest find-bit-vector.1c + (find 'a #*001001010100) + nil) + +(deftest find-bit-vector.1d + (find 1 #*000000) + nil) + +(deftest find-bit-vector.2 + (find 1 #*001001010100 :from-end t) + 1) + +(deftest find-bit-vector.2a + (find 1 #*00000 :from-end t) + nil) + +(deftest find-bit-vector.2b + (find 0 #*00000 :from-end t) + 0) + +(deftest find-bit-vector.2c + (find 0 #*11111 :from-end t) + nil) + +(deftest find-bit-vector.2d + (find 2 #*11111 :from-end t) + nil) + +(deftest find-bit-vector.2e + (find 'a #*11111 :from-end t) + nil) + +(deftest find-bit-vector.3 + (loop for i from 0 to 7 collect + (find 1 #*0010010 :start i)) + (1 1 1 1 1 1 nil nil)) + +(deftest find-bit-vector.4 + (loop for i from 0 to 7 collect + (find 1 #*0010010 :start i :end nil)) + (1 1 1 1 1 1 nil nil)) + +(deftest find-bit-vector.5 + (loop for i from 7 downto 0 collect + (find 1 #*0010010 :end i)) + (1 1 1 1 1 nil nil nil)) + +(deftest find-bit-vector.6 + (loop for i from 0 to 7 collect + (find 1 #*0010010 :start i :from-end t)) + (1 1 1 1 1 1 nil nil)) + +(deftest find-bit-vector.7 + (loop for i from 0 to 7 collect + (find 0 #*1101101 :start i :end nil :from-end t)) + (0 0 0 0 0 0 nil nil)) + +(deftest find-bit-vector.8 + (loop for i from 7 downto 0 collect + (find 0 #*1101101 :end i :from-end t)) + (0 0 0 0 0 nil nil nil)) + +(deftest find-bit-vector.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find 1 #*0010010 :start i :end j))) + ((nil nil 1 1 1 1 1) + (nil 1 1 1 1 1) + (1 1 1 1 1) + (nil nil 1 1) + (nil 1 1) + (1 1) + (nil))) + +(deftest find-bit-vector.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find 1 #*0010010 :start i :end j :from-end t))) + ((nil nil 1 1 1 1 1) + (nil 1 1 1 1 1) + (1 1 1 1 1) + (nil nil 1 1) + (nil 1 1) + (1 1) + (nil))) + +(deftest find-bit-vector.11 + (find 2 #*00010001010 :key #'1+) + 1) + +(deftest find-bit-vector.12 + (find 2 #*00010001010 :key '1+) + 1) + +(deftest find-bit-vector.13 + (find 2 #*0010001000 :key #'1+ :from-end t) + 1) + +(deftest find-bit-vector.14 + (find 0 #*0010111010 :test (complement #'eql)) + 1) + +(deftest find-bit-vector.15 + (find 0 #*0010111010 :test (complement #'eql) + :from-end t) + 1) + +(deftest find-bit-vector.16 + (find 0 #*0010111010 :test-not #'eql) + 1) + +(deftest find-bit-vector.16a + (find 1 #*111111111111 :test-not #'eql) + nil) + +(deftest find-bit-vector.16b + (find 0 #*0000000 :test-not #'eql) + nil) + +(deftest find-bit-vector.17 + (find 0 #*001011101 :test-not 'eql + :from-end t) + 1) + +(deftest find-bit-vector.17a + (find 0 #*0000000 :test-not 'eql + :from-end t) + nil) + +(deftest find-bit-vector.17b + (find 1 #*111111111111 :test-not 'eql + :from-end t) + nil) + +(deftest find-bit-vector.18 + (find 0 #*00101110 :test-not 'eql) + 1) + +(deftest find-bit-vector.18a + (find 0 #*00000000 :test-not 'eql) + nil) + +(deftest find-bit-vector.19 + (find 0 #*00101110 :test-not #'eql + :from-end t) + 1) + +(deftest find-bit-vector.19a + (find 0 #*00000000 :test-not #'eql + :from-end t) + nil) + +(deftest find-bit-vector.20 + (find 0 #*00101110 :test-not #'eql) + 1) + +(deftest find-bit-vector.21 + (find 0 #*00101110 :test #'eql + :start 2) + 0) + +(deftest find-bit-vector.21a + (find 0 #*00111111 :test #'eql + :start 2) + nil) + +(deftest find-bit-vector.21b + (find 1 #*00111111 :test #'eql + :start 2) + 1) + +(deftest find-bit-vector.22 + (find 0 #*00101110 :test #'eql + :start 2 :end nil) + 0) + +(deftest find-bit-vector.22a + (find 0 #*001111111 :test #'eql + :start 2 :end nil) + nil) + +(deftest find-bit-vector.22b + (find 1 #*001111111 :test #'eql + :start 2 :end nil) + 1) + +(deftest find-bit-vector.23 + (find 0 #*00101110 :test-not #'eql + :start 0 :end 5) + 1) + +(deftest find-bit-vector.23a + (find 0 #*00000111 :test-not #'eql + :start 0 :end 5) + nil) + +(deftest find-bit-vector.23b + (find 0 #*00001000 :test-not #'eql + :start 0 :end 5) + 1) + +(deftest find-bit-vector.24 + (find 0 #*00101110 :test-not #'eql + :start 0 :end 5 :from-end t) + 1) + +(deftest find-bit-vector.24a + (find 0 #*0000001111 :test-not #'eql + :start 0 :end 5 :from-end t) + nil) + +(deftest find-bit-vector.24b + (find 0 #*0000100 :test-not #'eql + :start 0 :end 5 :from-end t) + 1) + +(deftest find-bit-vector.25 + (find 2 #*1100001010 :key #'1+ + :start 3) + 1) + +(deftest find-bit-vector.26 + (find 2 #*11100000 :key #'1+ + :start 3) + nil) + +(deftest find-bit-vector.26a + (find 2 #*11110000 :key #'1+ + :start 3) + 1) + +(deftest find-bit-vector.27 + (find 2 #*1100001010 :key #'1+ + :start 2 :from-end t) + 1) + +(deftest find-bit-vector.28 + (find 2 #*1100000000 :key #'1+ + :start 2 :from-end t) + nil) + +(deftest find-bit-vector.29 + (let ((a + (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0) + :element-type 'bit + :fill-pointer 5))) + (values (find 0 a) + (find 0 a :from-end t))) + nil nil) + +(deftest find-bit-vector.30 + (let ((a (make-array '(10) :initial-contents '(1 1 1 1 0 0 0 0 0 0) + :element-type 'bit + :fill-pointer 5))) + (values (find 0 a) (find 0 a :from-end t))) + 0 0) + +;;; strings + +(deftest find-string.1 + (find #\c "abcdeca") + #\c) + +(deftest find-string.1a + (find #\c "abCa") + nil) + +(deftest find-string.2 + (find #\c "abcdeca" :from-end t) + #\c) + +(deftest find-string.2a + (find #\c "abCCCa" :from-end t) + nil) + +(deftest find-string.3 + (loop for i from 0 to 7 collect + (find #\c "abcdeca" :start i)) + (#\c #\c #\c #\c #\c #\c nil nil)) + +(deftest find-string.4 + (loop for i from 0 to 7 collect + (find #\c "abcdeca" :start i :end nil)) + (#\c #\c #\c #\c #\c #\c nil nil)) + +(deftest find-string.5 + (loop for i from 7 downto 0 collect + (find #\c "abcdeca" :end i)) + (#\c #\c #\c #\c #\c nil nil nil)) + +(deftest find-string.6 + (loop for i from 0 to 7 collect + (find #\c "abcdeca" :start i :from-end t)) + (#\c #\c #\c #\c #\c #\c nil nil)) + +(deftest find-string.7 + (loop for i from 0 to 7 collect + (find #\c "abcdeca" :start i :end nil :from-end t)) + (#\c #\c #\c #\c #\c #\c nil nil)) + +(deftest find-string.8 + (loop for i from 7 downto 0 collect + (find #\c "abcdeca" :end i :from-end t)) + (#\c #\c #\c #\c #\c nil nil nil)) + +(deftest find-string.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find #\c "abcdeca" :start i :end j))) + ((nil nil #\c #\c #\c #\c #\c) + (nil #\c #\c #\c #\c #\c) + (#\c #\c #\c #\c #\c) + (nil nil #\c #\c) + (nil #\c #\c) + (#\c #\c) + (nil))) + +(deftest find-string.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (find #\c "abcdeca" :start i :end j :from-end t))) + ((nil nil #\c #\c #\c #\c #\c) + (nil #\c #\c #\c #\c #\c) + (#\c #\c #\c #\c #\c) + (nil nil #\c #\c) + (nil #\c #\c) + (#\c #\c) + (nil))) + +(deftest find-string.11 + (find 5 "12345648" :key #'(lambda (c) + (1+ (read-from-string (string c))))) + #\4) + +(deftest find-string.13 + (find 5 "12345648" :key #'(lambda (c) + (1+ (read-from-string (string c)))) + :from-end t) + #\4) + +(deftest find-string.14 + (find #\a "aabacedafa" :test (complement #'eql)) + #\b) + +(deftest find-string.15 + (find #\a "aabacedafa" :test (complement #'eql) + :from-end t) + #\f) + +(deftest find-string.16 + (find #\a "aabacedafa" :test-not #'eql) + #\b) + +(deftest find-string.17 + (find #\a "aabacedafa" :test-not 'eql + :from-end t) + #\f) + +(deftest find-string.18 + (find #\a "aabacedafa" :test-not 'eql) + #\b) + +(deftest find-string.19 + (find #\a "aabacedafa" :test-not #'eql + :from-end t) + #\f) + +(deftest find-string.20 + (find #\a "aabacedafa" :test-not #'eql) + #\b) + +(deftest find-string.21 + (find #\a "aabAcedafa" :test #'char-equal + :start 2) + #\A) + +(deftest find-string.22 + (find #\a "aabAcedafa" :test #'char-equal + :start 2 :end nil) + #\A) + +(deftest find-string.23 + (find #\a "aAbAcedafa" :test-not #'char-equal + :start 0 :end 5) + #\b) + +(deftest find-string.24 + (find #\a "aabacedafa" :test-not #'char-equal + :start 0 :end 5 :from-end t) + #\c) + +(deftest find-string.25 + (let ((s (make-array '(10) :initial-contents "abcdefghij" + :element-type 'character + :fill-pointer 5))) + (values + (loop for e across "abcdefghij" + collect (find e s)) + (loop for e across "abcdefghij" + collect (find e s :from-end t)))) + (#\a #\b #\c #\d #\e nil nil nil nil nil) + (#\a #\b #\c #\d #\e nil nil nil nil nil)) + +;;; Keyword tests + +(deftest find.allow-other-keys.1 + (find 0 '(1 2 3 4 5) :key #'(lambda (x) (mod x 2)) + :bad t :allow-other-keys t) + 2) + +(deftest find.allow-other-keys.2 + (find 0 '(1 2 3 4 5) :key #'(lambda (x) (mod x 2)) + :allow-other-keys t :also-bad t) + 2) + +;;; The leftmost of two :allow-other-keys arguments is the one that matters. +(deftest find.allow-other-keys.3 + (find 0 '(1 2 3 4 5) :key #'(lambda (x) (mod x 2)) + :allow-other-keys t + :allow-other-keys nil + :bad t) + 2) + +(deftest find.keywords.4 + (find 2 '(1 2 3 4 5) :key #'identity :key #'1+) + 2) + +(deftest find.allow-other-keys.5 + (find 'b '(nil a b c nil) :allow-other-keys nil) + b) + + +;;; Error tests + +(deftest find.error.1 + (classify-error (find 'a 'b)) + type-error) + +(deftest find.error.2 + (classify-error (find 'a 10)) + type-error) + +(deftest find.error.3 + (classify-error (find 'a 1.4)) + type-error) + +(deftest find.error.4 + (classify-error (find 'e '(a b c . d))) + type-error) + +(deftest find.error.5 + (classify-error (find)) + program-error) + +(deftest find.error.6 + (classify-error (find 'a)) + program-error) + +(deftest find.error.7 + (classify-error (find 'a nil :bad t)) + program-error) + +(deftest find.error.8 + (classify-error (find 'a nil :bad t :allow-other-keys nil)) + program-error) + +(deftest find.error.9 + (classify-error (find 'a nil 1 1)) + program-error) + +(deftest find.error.10 + (classify-error (find 'a nil :key)) + program-error) + +(deftest find.error.11 + (classify-error (locally (find 'a 'b) t)) + type-error) + +(deftest find.error.12 + (classify-error (find 'b '(a b c) :test #'identity)) + program-error) + +(deftest find.error.13 + (classify-error (find 'b '(a b c) :test-not #'identity)) + program-error) + +(deftest find.error.14 + (classify-error (find 'c '(a b c) :key #'cons)) + program-error) + +(deftest find.error.15 + (classify-error (find 'c '(a b c) :key #'car)) + type-error) + + +;;; Order of evaluation tests + +(deftest find.order.1 + (let ((i 0) x y) + (values + (find (progn (setf x (incf i)) 'a) + (progn (setf y (incf i)) '(nil nil nil a nil nil))) + i x y)) + a 2 1 2) + +(deftest find.order.2 + (let ((i 0) a b c d e f g) + (values + (find (progn (setf a (incf i)) nil) + (progn (setf b (incf i)) '(nil nil nil a nil nil)) + :start (progn (setf c (incf i)) 1) + :end (progn (setf d (incf i)) 4) + :from-end (setf e (incf i)) + :key (progn (setf f (incf i)) #'null) + ) + i a b c d e f)) + a 6 1 2 3 4 5 6) + +(deftest find.order.3 + (let ((i 0) a b c d e f g) + (values + (find (progn (setf a (incf i)) nil) + (progn (setf b (incf i)) '(nil nil nil a nil nil)) + :key (progn (setf c (incf i)) #'null) + :from-end (setf d (incf i)) + :end (progn (setf e (incf i)) 4) + :start (progn (setf f (incf i)) 1) + ) + i a b c d e f)) + a 6 1 2 3 4 5 6) diff --git a/ansi-tests/finish-output.lsp b/ansi-tests/finish-output.lsp new file mode 100644 index 0000000..f6fab14 --- /dev/null +++ b/ansi-tests/finish-output.lsp @@ -0,0 +1,54 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 28 06:38:20 2004 +;;;; Contains: Tests of FINISH-OUTPUT + +(in-package :cl-test) + +(deftest finish-output.1 + (finish-output) + nil) + +(deftest finish-output.2 + (finish-output t) + nil) + +(deftest finish-output.3 + (finish-output nil) + nil) + +(deftest finish-output.4 + (loop for s in (list *debug-io* *error-output* *query-io* + *standard-output* *trace-output* *terminal-io*) + for results = (multiple-value-list (finish-output s)) + unless (equal results '(nil)) + collect s) + nil) + +(deftest finish-output.5 + (let ((os (make-string-output-stream))) + (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") + os))) + (finish-output t))) + nil) + +(deftest finish-output.6 + (let ((*standard-output* (make-string-output-stream))) + (finish-output nil)) + nil) + +;;; Error tests + +(deftest finish-output.error.1 + (signals-error (finish-output nil nil) program-error) + t) + +(deftest finish-output.error.2 + (signals-error (finish-output t nil) program-error) + t) + +(deftest finish-output.error.3 + (check-type-error #'finish-output + #'(lambda (x) (typep x '(or stream (member nil t))))) + nil) + diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp new file mode 100644 index 0000000..a4691f7 --- /dev/null +++ b/ansi-tests/flet.lsp @@ -0,0 +1,431 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Oct 8 22:55:02 2002 +;;;; Contains: Tests of FLET + +(in-package :cl-test) + +(deftest flet.1 + (flet ((%f () 1)) + (%f)) + 1) + +(deftest flet.2 + (flet ((%f (x) x)) + (%f 2)) + 2) + +(deftest flet.3 + (flet ((%f (&rest args) args)) + (%f 'a 'b 'c)) + (a b c)) + +;;; The optional arguments are not in the block defined by +;;; the local function declaration +(deftest flet.4 + (block %f + (flet ((%f (&optional (x (return-from %f 10))) + 20)) + (%f))) + 10) + +(deftest flet.5 + (flet ((%f () (return-from %f 15) 35)) + (%f)) + 15) + +;;; The aux parameters are not in the block defined by +;;; the local function declaration +(deftest flet.6 + (block %f + (flet ((%f (&aux (x (return-from %f 10))) + 20)) + (%f))) + 10) + +;;; The function is not visible inside itself +(deftest flet.7 + (flet ((%f (x) (+ x 5))) + (flet ((%f (y) (cond ((eql y 20) 30) + (t (%f 20))))) + (%f 15))) + 25) + +;;; Keyword arguments +(deftest flet.8 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f)) + nil 0 nil) + +(deftest flet.9 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :a 1)) + 1 0 nil) + +(deftest flet.10 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :b 2)) + nil 2 t) + +(deftest flet.11 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :b 2 :a 3)) + 3 2 t) + +;;; Unknown keyword parameter should throw a program-error in safe code +;;; (section 3.5.1.4) +(deftest flet.12 + (classify-error + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))) + program-error) + +;;; Odd # of keyword args should throw a program-error in safe code +;;; (section 3.5.1.6) +(deftest flet.13 + (classify-error + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))) + program-error) + +;;; Too few arguments (section 3.5.1.2) +(deftest flet.14 + (classify-error (flet ((%f (a) a)) (%f))) + program-error) + +;;; Too many arguments (section 3.5.1.3) +(deftest flet.15 + (classify-error (flet ((%f (a) a)) (%f 1 2))) + program-error) + +;;; Invalid keyword argument (section 3.5.1.5) +(deftest flet.16 + (classify-error (flet ((%f (&key a) a)) (%f '(foo)))) + program-error) + + +;;; Definition of a (setf ...) function + +(deftest flet.17 + (flet (((setf %f) (x y) (setf (car y) x))) + (let ((z (list 1 2))) + (setf (%f z) 'a) + z)) + (a 2)) + +;;; Body is an implicit progn +(deftest flet.18 + (flet ((%f (x) (incf x) (+ x x))) + (%f 10)) + 22) + +;;; Can handle at least 50 lambda parameters +(deftest flet.19 + (flet ((%f (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 + b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 + c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 + d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 + e1 e2 e3 e4 e5 e6 e7 e8 e9 e10) + (+ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 + b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 + c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 + d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 + e1 e2 e3 e4 e5 e6 e7 e8 e9 e10))) + (%f 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)) + 1275) + +;;; flet works with a large (maximal?) number of arguments +(deftest flet.20 + (let* ((n (min lambda-parameters-limit 1024)) + (vars (loop for i from 1 to n collect (gensym)))) + (eval + `(eql ,n + (flet ((%f ,vars (+ ,@ vars))) + (%f ,@(loop for e in vars collect 1)))))) + t) + +;;; Declarations and documentation strings are ok +(deftest flet.21 + (flet ((%f (x) + (declare (type fixnum x)) + "Add one to the fixnum x." + (1+ x))) + (declare (ftype (function (fixnum) integer) %f)) + (%f 10)) + 11) + +(deftest flet.22 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p)) + (list x y (not (not y-p)) z (not (not z-p))))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c))) + (10 1 nil 2 nil) + (20 40 t 2 nil) + (a b t c t)) + +(deftest flet.23 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r) + (list x y (not (not y-p)) z (not (not z-p)) r))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c) (%f 'd 'e 'f 'g 'h))) + (10 1 nil 2 nil nil) + (20 40 t 2 nil nil) + (a b t c t nil) + (d e t f t (g h))) + +(deftest flet.24 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar) + (list x y (not (not y-p)) z (not (not z-p)) r foo bar))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c) + (%f 'd 'e 'f :foo 'h) + (%f 'd 'e 'f :bar 'i) )) + (10 1 nil 2 nil nil nil nil) + (20 40 t 2 nil nil nil nil) + (a b t c t nil nil nil) + (d e t f t (:foo h) h nil) + (d e t f t (:bar i) nil i)) + +(deftest flet.25 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar + &allow-other-keys) + (list x y (not (not y-p)) z (not (not z-p)) r foo bar))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c) + (%f 'd 'e 'f :foo 'h :whatever nil) + (%f 'd 'e 'f :bar 'i :illegal t :foo 'z) )) + (10 1 nil 2 nil nil nil nil) + (20 40 t 2 nil nil nil nil) + (a b t c t nil nil nil) + (d e t f t (:foo h :whatever nil) h nil) + (d e t f t (:bar i :illegal t :foo z) z i)) + +(deftest flet.26 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar) + (list x y (not (not y-p)) z (not (not z-p)) r foo bar))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c) + (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys t) + (%f 'd 'e 'f :bar 'i :illegal t :foo 'z :allow-other-keys t) )) + (10 1 nil 2 nil nil nil nil) + (20 40 t 2 nil nil nil nil) + (a b t c t nil nil nil) + (d e t f t (:foo h :whatever nil :allow-other-keys t) h nil) + (d e t f t (:bar i :illegal t :foo z :allow-other-keys t) z i)) + +;;; Section 3.4.1.4.1: "The :allow-other-keys argument is permissible +;;; in all situations involving keyword[2] arguments, even when its +;;; associated value is false." +(deftest flet.27 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar) + (list x y (not (not y-p)) z (not (not z-p)) r foo bar))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c) + (%f 'd 'e 'f :foo 'h :allow-other-keys nil) + (%f 'd 'e 'f :bar 'i :allow-other-keys nil) )) + (10 1 nil 2 nil nil nil nil) + (20 40 t 2 nil nil nil nil) + (a b t c t nil nil nil) + (d e t f t (:foo h :allow-other-keys nil) h nil) + (d e t f t (:bar i :allow-other-keys nil) nil i)) + +(deftest flet.28 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r + &key foo bar allow-other-keys) + (list x y (not (not y-p)) z (not (not z-p)) allow-other-keys + r foo bar))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c) + (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys 100) + (%f 'd 'e 'f :bar 'i :illegal t :foo 'z :allow-other-keys 200) )) + (10 1 nil 2 nil nil nil nil nil) + (20 40 t 2 nil nil nil nil nil) + (a b t c t nil nil nil nil) + (d e t f t 100 (:foo h :whatever nil :allow-other-keys 100) h nil) + (d e t f t 200 (:bar i :illegal t :foo z :allow-other-keys 200) z i)) + +(deftest flet.29 + (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r + &key foo bar allow-other-keys &allow-other-keys) + (list x y (not (not y-p)) z (not (not z-p)) allow-other-keys + r foo bar))) + (values (%f 10) (%f 20 40) (%f 'a 'b 'c) + (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys nil :blah t) + (%f 'd 'e 'f :bar 'i :illegal t :foo 'z + :allow-other-keys nil :zzz 10) )) + (10 1 nil 2 nil nil nil nil nil) + (20 40 t 2 nil nil nil nil nil) + (a b t c t nil nil nil nil) + (d e t f t nil (:foo h :whatever nil :allow-other-keys nil :blah t) h nil) + (d e t f t nil (:bar i :illegal t :foo z :allow-other-keys nil :zzz 10) z i)) + +;;; Tests of non-keyword keywords (see section 3.4.1.4, paragrph 2). +(deftest flet.30 + (flet ((%f (&key ((foo bar) nil)) bar)) + (values (%f) (%f 'foo 10))) + nil 10) + +(deftest flet.31 + (flet ((%f (&key ((:foo bar) nil)) bar)) + (values (%f) (%f :foo 10))) + nil 10) + +;;; Multiple keyword actual parameters +(deftest flet.32 + (flet ((%f (&key a b c) (list a b c))) + (%f :a 10 :b 20 :c 30 :a 40 :b 50 :c 60)) + (10 20 30)) + +;;; More aux parameters +(deftest flet.33 + (flet ((%f (x y &aux (a (1+ x)) (b (+ x y a)) (c (list x y a b))) + c)) + (%f 5 9)) + (5 9 6 20)) + +(deftest flet.34 + (flet ((%f (x y &rest r &key foo bar &aux (c (list x y r foo bar))) + c)) + (values + (%f 1 2) + (%f 1 2 :foo 'a) + (%f 1 2 :bar 'b) + (%f 1 2 :foo 'a :bar 'b) + (%f 1 2 :bar 'b :foo 'a))) + (1 2 nil nil nil) + (1 2 (:foo a) a nil) + (1 2 (:bar b) nil b) + (1 2 (:foo a :bar b) a b) + (1 2 (:bar b :foo a) a b)) + +;;; Binding of formal parameters that are also special variables +(deftest flet.35 + (let ((x 'bad)) + (declare (special x)) + (flet ((%f () x)) + (flet ((%g (x) + (declare (special x)) + (%f))) + (%g 'good)))) + good) + +(deftest flet.36 + (let ((x 'bad)) + (declare (special x)) + (flet ((%f () x)) + (flet ((%g (&aux (x 'good)) + (declare (special x)) + (%f))) + (%g)))) + good) + +(deftest flet.37 + (let ((x 'bad)) + (declare (special x)) + (flet ((%f () x)) + (flet ((%g (&rest x) + (declare (special x)) + (%f))) + (%g 'good)))) + (good)) + +(deftest flet.38 + (let ((x 'bad)) + (declare (special x)) + (flet ((%f () x)) + (flet ((%g (&key (x 'good)) + (declare (special x)) + (%f))) + (%g)))) + good) + +(deftest flet.39 + (let ((x 'bad)) + (declare (special x)) + (flet ((%f () x)) + (flet ((%g (&key (x 'bad)) + (declare (special x)) + (%f))) + (%g :x 'good)))) + good) + +(deftest flet.40 + (let ((x 'good)) + (declare (special x)) + (flet ((%f () x)) + (flet ((%g (&key (x 'bad)) + (%f))) + (%g :x 'worse)))) + good) + +;;; Test that [:&]allow-other-keys suppress errors for illegal keywords +;;; or odd numbers of keyword arguments + +;;; Note -- These are apparently bad tests! -- PFD +;;;(deftest flet.41 +;;; (classify-error +;;; (flet ((%f (&key (a :good)) a)) +;;; (%f :allow-other-keys t :b))) +;;; :good) +;;; +;;;(deftest flet.42 +;;; (classify-error +;;; (flet ((%f (&key (a :good)) a)) +;;; (%f :allow-other-keys t 10 20))) +;;; :good) +;;; +;;;(deftest flet.43 +;;; (classify-error +;;; (flet ((%f (&key (a :good) &allow-other-keys) a)) +;;; (%f :b))) +;;; :good) +;;; +;;;(deftest flet.44 +;;; (classify-error +;;; (flet ((%f (&key (a :good) &allow-other-keys) a)) +;;; (%f 10 20))) +;;; :good) + + +(deftest flet.45 + (flet ((nil () 'a)) (nil)) + a) + +(deftest flet.46 + (flet ((t () 'b)) (t)) + b) + +;;; Keywords can be function names +(deftest flet.47 + (flet ((:foo () 'bar)) (:foo)) + bar) + +(deftest flet.48 + (flet ((:foo () 'bar)) (funcall #':foo)) + bar) + +(deftest flet.49 + (loop for s in *cl-non-function-macro-special-operator-symbols* + for form = `(classify-error (flet ((,s () 'a)) (,s))) + unless (eq (eval form) 'a) + collect s) + nil) + +(deftest flet.50 + (loop for s in *cl-non-function-macro-special-operator-symbols* + for form = `(classify-error (flet ((,s () 'a)) + (declare (ftype (function () symbol) + ,s)) + (,s))) + unless (eq (eval form) 'a) + collect s) + nil) + +;;; Binding SETF functions of certain COMMON-LISP symbols +(deftest flet.51 + (loop for s in *cl-non-function-macro-special-operator-symbols* + for form = `(classify-error + (flet (((setf ,s) (&rest args) + (declare (ignore args)) + 'a)) + (setf (,s) 10))) + unless (eq (eval form) 'a) + collect s) + nil) + + diff --git a/ansi-tests/fmakunbound.lsp b/ansi-tests/fmakunbound.lsp new file mode 100644 index 0000000..f6c44f5 --- /dev/null +++ b/ansi-tests/fmakunbound.lsp @@ -0,0 +1,67 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Oct 8 00:09:14 2002 +;;;; Contains: Tests for FMAKUNBOUND + +(in-package :cl-test) + +(deftest fmakunbound.1 + (let ((g (gensym))) + (and (not (fboundp g)) + (setf (symbol-function g) #'car) + (fboundp g) + (values (eqt (check-values (fmakunbound g)) g) + (fboundp g)))) + t nil) + +(deftest fmakunbound.2 + (let ((g (gensym))) + (and (not (fboundp g)) + (eval `(defun ,g () nil)) + (fboundp g) + (values (eqt (check-values (fmakunbound g)) g) + (fboundp g)))) + t nil) + +(deftest fmakunbound.3 + (let ((g (gensym))) + (and (not (fboundp g)) + (eval `(defmacro ,g () nil)) + (fboundp g) + (values (eqt (check-values (fmakunbound g)) g) + (fboundp g)))) + t nil) + +(deftest fmakunbound.4 + (let* ((g (gensym)) + (n `(setf ,g))) + (and (not (fboundp n)) + (eval `(defun ,n () nil)) + (fboundp n) + (values (equal (check-values (fmakunbound n)) n) + (fboundp n)))) + t nil) + +(deftest fmakunbound.error.1 + (classify-error (fmakunbound 1)) + type-error) + +(deftest fmakunbound.error.2 + (classify-error (fmakunbound #\a)) + type-error) + +(deftest fmakunbound.error.3 + (classify-error (fmakunbound '(x))) + type-error) + +(deftest fmakunbound.error.4 + (classify-error (fmakunbound)) + program-error) + +(deftest fmakunbound.error.5 + (classify-error (fmakunbound (gensym) nil)) + program-error) + +(deftest fmakunbound.error.6 + (classify-error (locally (fmakunbound 1) t)) + type-error) diff --git a/ansi-tests/force-output.lsp b/ansi-tests/force-output.lsp new file mode 100644 index 0000000..af3584b --- /dev/null +++ b/ansi-tests/force-output.lsp @@ -0,0 +1,56 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 28 06:41:46 2004 +;;;; Contains: Tests of FORCE-OUTPUT + +(in-package :cl-test) + +(deftest force-output.1 + (force-output) + nil) + +(deftest force-output.2 + (force-output t) + nil) + +(deftest force-output.3 + (force-output nil) + nil) + +(deftest force-output.4 + (loop for s in (list *debug-io* *error-output* *query-io* + *standard-output* *trace-output* *terminal-io*) + for results = (multiple-value-list (force-output s)) + unless (equal results '(nil)) + collect s) + nil) + +(deftest force-output.5 + (let ((os (make-string-output-stream))) + (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") + os))) + (force-output t))) + nil) + +(deftest force-output.6 + (let ((*standard-output* (make-string-output-stream))) + (force-output nil)) + nil) + + +;;; Error tests + +(deftest force-output.error.1 + (signals-error (force-output nil nil) program-error) + t) + +(deftest force-output.error.2 + (signals-error (force-output t nil) program-error) + t) + +(deftest force-output.error.3 + (check-type-error #'force-output + #'(lambda (x) (typep x '(or stream (member nil t))))) + nil) + + diff --git a/ansi-tests/fresh-line.lsp b/ansi-tests/fresh-line.lsp new file mode 100644 index 0000000..41542e0 --- /dev/null +++ b/ansi-tests/fresh-line.lsp @@ -0,0 +1,87 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 20:41:18 2004 +;;;; Contains: Tests of FRESH-LINE + +(in-package :cl-test) + +(deftest fresh-line.1 + (let (result) + (values + (with-output-to-string + (*standard-output*) + (write-char #\a) + (setq result (notnot (fresh-line)))) + result)) + #.(concatenate 'string "a" (string #\Newline)) + t) + +(deftest fresh-line.2 + (let (result) + (values + (with-output-to-string + (s) + (write-char #\a s) + (setq result (notnot (fresh-line s)))) + result)) + #.(concatenate 'string "a" (string #\Newline)) + t) + +(deftest fresh-line.3 + (with-output-to-string + (s) + (write-char #\x s) + (fresh-line s) + (fresh-line s) + (write-char #\y s)) + #.(concatenate 'string "x" (string #\Newline) "y")) + +(deftest fresh-line.4 + (let (result) + (values + (with-output-to-string + (*standard-output*) + (setq result (multiple-value-list (fresh-line)))) + result)) + "" (nil)) + +(deftest fresh-line.5 + (let (result) + (values + (with-output-to-string + (s) + (write-char #\Space s) + (setq result + (list + (multiple-value-list (notnot-mv (fresh-line s))) + (multiple-value-list (fresh-line s)) + (multiple-value-list (fresh-line s))))) + result)) + " +" ((t) (nil) (nil))) + +(deftest fresh-line.6 + (with-output-to-string + (os) + (let ((*terminal-io* (make-two-way-stream *standard-input* os))) + (write-char #\a t) + (fresh-line t) + (finish-output t))) + #.(concatenate 'string (string #\a) (string #\Newline))) + +(deftest fresh-line.7 + (with-output-to-string + (*standard-output*) + (write-char #\a nil) + (terpri nil)) + #.(concatenate 'string (string #\a) (string #\Newline))) + +;;; Error tests + +(deftest fresh-line.error.1 + (signals-error + (with-output-to-string + (s) + (fresh-line s nil)) + program-error) + t) diff --git a/ansi-tests/funcall.lsp b/ansi-tests/funcall.lsp new file mode 100644 index 0000000..f39e4fd --- /dev/null +++ b/ansi-tests/funcall.lsp @@ -0,0 +1,105 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Oct 9 21:45:07 2002 +;;;; Contains: Tests of FUNCALL + +(in-package :cl-test) + +(deftest funcall.1 + (let ((fn #'cons)) + (funcall fn 'a 'b)) + (a . b)) + +(deftest funcall.2 + (funcall (symbol-function 'cons) 'a 'b) + (a . b)) + +(deftest funcall.3 + (let ((fn 'cons)) + (funcall fn 'a 'b)) + (a . b)) + +(deftest funcall.4 + (funcall 'cons 'a 'b) + (a . b)) + +(deftest funcall.5 + (let ((fn #'+)) + (funcall fn 1 2 3 4)) + 10) + +(deftest funcall.6 + (funcall #'(lambda (x y) (cons x y)) 'a 'b) + (a . b)) + +(defun xcons (x y) (cons x y)) + +(deftest funcall.7 + (flet ((xcons (x y) (list y x))) + (values (funcall 'xcons 1 2) + (funcall #'xcons 1 2))) + (1 . 2) + (2 1)) + +(deftest funcall.8 + (flet ((foo (x y z) (values x y z))) + (funcall #'foo 1 2 3)) + 1 2 3) + +(deftest funcall.9 + (flet ((foo () (values))) + (funcall #'foo)) + ) + +(deftest funcall.order.1 + (let ((i 0) a b) + (values + (funcall (progn (setf a (incf i)) #'car) + (progn (setf b (incf i)) '(x . y))) + i a b)) + x 2 1 2) + +(deftest funcall.order.2 + (let ((i 0) a b c) + (values + (funcall (progn (setf a (incf i)) #'cons) + (progn (setf b (incf i)) 'x) + (progn (setf c (incf i)) 'y)) + i a b c)) + (x . y) 3 1 2 3) + + +;;; FUNCALL should throw an UNDEFINED-FUNCTION condition when +;;; called on a symbol with a global definition as a special +;;; operator +(deftest funcall.error.1 + (classify-error (funcall 'quote 1)) + undefined-function) + +(deftest funcall.error.2 + (classify-error (funcall 'progn 1)) + undefined-function) + +;;; FUNCALL should throw an UNDEFINED-FUNCTION condition when +;;; called on a symbol with a global definition as a macro +(deftest funcall.error.3 + (classify-error (funcall 'defconstant '(defconstant x 10))) + undefined-function) + +(deftest funcall.error.4 + (classify-error (funcall)) + program-error) + +(deftest funcall.error.5 + (classify-error (funcall #'cons)) + program-error) + +(deftest funcall.error.6 + (classify-error (funcall #'cons 1)) + program-error) + +(deftest funcall.error.7 + (classify-error (funcall #'car 'a)) + type-error) + + diff --git a/ansi-tests/function-lambda-expression.lsp b/ansi-tests/function-lambda-expression.lsp new file mode 100644 index 0000000..1ac0a07 --- /dev/null +++ b/ansi-tests/function-lambda-expression.lsp @@ -0,0 +1,42 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 16:27:12 2003 +;;;; Contains: Tests for FUNCTION-LAMBDA-EXPRESSION + +(in-package :cl-test) + +(deftest function-lambda-expression.1 + (length + (multiple-value-list + (function-lambda-expression #'cons))) + 3) + +(deftest function-lambda-expression.2 + (let ((x nil)) + (flet ((%f () x)) + (let ((ret-vals + (multiple-value-list + (function-lambda-expression #'%f)))) + (values (length ret-vals) + (notnot (second ret-vals)))))) + 3 t) + +(deftest function-lambda-expression.order.1 + (let ((i 0)) + (function-lambda-expression (progn (incf i) #'cons)) + i) + 1) + +(deftest function-lambda-expression.error.1 + (classify-error (function-lambda-expression)) + program-error) + +(deftest function-lambda-expression.error.2 + (classify-error (function-lambda-expression #'cons nil)) + program-error) + + + + + + diff --git a/ansi-tests/function.lsp b/ansi-tests/function.lsp new file mode 100644 index 0000000..f6039c6 --- /dev/null +++ b/ansi-tests/function.lsp @@ -0,0 +1,95 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 7 07:34:29 2002 +;;;; Contains: Tests for type FUNCTION and the special form FUNCTION + +(in-package :cl-test) + +;;; +;;; Note! There are significant incompatibilities between CLTL1 and ANSI CL +;;; in the meaning of FUNCTION and FUNCTIONP. +;;; + +(deftest function.1 + (typep nil 'function) + nil) + +;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL. +;;; In ANSI CL, symbols are no longer of type FUNCTION. +(deftest function.2 + (typep 'identity 'function) + nil) + +(deftest function.3 + (not-mv (typep #'identity 'function)) + nil) + +(deftest function.4 + (loop for x in *cl-symbol-names* + for s = (find-symbol x "CL") + for f = (and (fboundp s) + (symbol-function s) + (not (special-operator-p s)) + (not (macro-function s)) + (symbol-function s)) + unless (or (null f) + (typep f 'function)) + collect x) + nil) + +(deftest function.5 + (typep '(setf car) 'function) + nil) + +;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL. +;;; In ANSI CL, lambda forms are no longer of type FUNCTION. +(deftest function.6 + (typep '(lambda (x) x) 'function) + nil) + +(eval-when (eval compile) + (ignore-errors + (defun (setf function-7-accessor) (y x) (setf (car x) y) y))) + +(deftest function.7 + (not-mv (typep #'(setf function-7-accessor) 'function)) + nil) + +(deftest function.8 + (not-mv (typep #'(lambda (x) x) 'function)) + nil) + +(deftest function.9 + (not-mv (typep (compile nil '(lambda (x) x)) 'function)) + nil) + +;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL. +;;; In ANSI CL, symbols and cons can no longer also be of type FUNCTION. +(deftest function.10 + (loop for x in *universe* + when (and (or (numberp x) (characterp x) + (symbolp x) (consp x) + (typep x 'array)) + (typep x 'function)) + collect x) + nil) + +(deftest function.11 + (flet ((%f () nil)) (typep '%f 'function)) + nil) + +(deftest function.12 + (flet ((%f () nil)) (not-mv (typep #'%f 'function))) + nil) + +(deftest function.13 + (labels ((%f () nil)) (not-mv (typep #'%f 'function))) + nil) + +;;; "If name is a function name, the functional definition of that +;;; name is that established by the innermost lexically enclosing flet, +;;; labels, or macrolet form, if there is one." (page for FUNCTION, sec. 5.3) +;;; ^^^^^^^^ +;;;(deftest function.14 +;;; (macrolet ((%f () nil)) (not-mv (typep #'%f 'function))) +;;; nil) diff --git a/ansi-tests/functionp.lsp b/ansi-tests/functionp.lsp new file mode 100644 index 0000000..23edd09 --- /dev/null +++ b/ansi-tests/functionp.lsp @@ -0,0 +1,96 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 7 06:39:21 2002 +;;;; Contains: Tests for FUNCTIONP + +(in-package :cl-test) + +;;; +;;; Note! FUNCTIONP and FUNCTION behave differently in ANSI CL than +;;; in CLTL1. In particular, symbols and various lists are no longer +;;; in the class FUNCTION in ANSI CL. +;;; + +(deftest functionp.1 + (functionp nil) + nil) + +;;; In ANSI CL, symbols can no longer be functions +(deftest functionp.2 + (functionp 'identity) + nil) + +(deftest functionp.3 + (not (functionp #'identity)) + nil) + +(deftest functionp.4 + (loop for x in *cl-symbol-names* + for s = (find-symbol x "CL") + for f = (and (fboundp s) + (symbol-function s) + (not (special-operator-p s)) + (not (macro-function s)) + (symbol-function s)) + unless (or (null f) + (functionp f)) + collect x) + nil) + +(deftest functionp.5 + (functionp '(setf car)) + nil) + +;;; In ANSI CL, lambda forms are no longer functions +(deftest functionp.6 + (functionp '(lambda (x) x)) + nil) + +(eval-when (eval compile) + (ignore-errors + (defun (setf functionp-7-accessor) (y x) (setf (car x) y) y))) + +(deftest functionp.7 + (not-mv (functionp #'(setf functionp-7-accessor))) + nil) + +(deftest functionp.8 + (not-mv (functionp #'(lambda (x) x))) + nil) + +(deftest functionp.9 + (not-mv (functionp (compile nil '(lambda (x) x)))) + nil) + +;;; In ANSI CL, symbols and cons can no longer be functions +(deftest functionp.10 + (loop for x in *universe* + when (and (or (numberp x) (characterp x) + (symbolp x) (consp x) + (typep x 'array)) + (functionp x)) + collect x) + nil) + +(deftest functionp.11 + (flet ((%f () nil)) (functionp '%f)) + nil) + +(deftest functionp.12 + (flet ((%f () nil)) (not-mv (functionp #'%f))) + nil) + +(deftest functionp.order.1 + (let ((i 0)) + (values + (notnot (functionp (progn (incf i) #'cons))) + i)) + t 1) + +(deftest functionp.error.1 + (classify-error (functionp)) + program-error) + +(deftest functionp.error.2 + (classify-error (functionp #'cons nil)) + program-error) diff --git a/ansi-tests/gclload.lsp b/ansi-tests/gclload.lsp new file mode 100644 index 0000000..8d8110c --- /dev/null +++ b/ansi-tests/gclload.lsp @@ -0,0 +1,4 @@ +(load "gclload1.lsp") +(load "gclload2.lsp") +(in-package :cl-test) +(regression-test:do-tests) diff --git a/ansi-tests/gclload1.lsp b/ansi-tests/gclload1.lsp new file mode 100644 index 0000000..de81d08 --- /dev/null +++ b/ansi-tests/gclload1.lsp @@ -0,0 +1,33 @@ +(load "compile-and-load.lsp") +(load "rt-package.lsp") +(compile-and-load "rt.lsp") +;;; (unless (probe-file "rt.o") (compile-file "rt.lsp")) +;;; (load "rt.o") +(load "cl-test-package.lsp") +(in-package :cl-test) +(load "universe.lsp") +(compile-and-load "random-aux.lsp") +(compile-and-load "ansi-aux.lsp") +;;; (unless (probe-file "ansi-aux.o") (compile-file "ansi-aux.lsp")) +;;; (load "ansi-aux.o") + +(load "cl-symbol-names.lsp") +;(load "notes.lsp") + +(setq *compile-verbose* nil + *compile-print* nil + *load-verbose* nil) + +#+cmu (setq ext:*gc-verbose* nil) + +#+gcl (setq compiler:*suppress-compiler-notes* t + compiler:*suppress-compiler-warnings* t + compiler:*compile-verbose* nil + compiler:*compile-print* nil) + +#+lispworks (setq compiler::*compiler-warnings* nil) + +#+ecl (setq c:*suppress-compiler-warnings* t + c:*suppress-compiler-notes* t) + +#+clisp (setq custom::*warn-on-floating-point-contagion* nil) diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp new file mode 100644 index 0000000..3ae4833 --- /dev/null +++ b/ansi-tests/gclload2.lsp @@ -0,0 +1,64 @@ +;;; Load test files + +;;; Tests of symbols +(load "load-symbols.lsp") + +;;; Tests of evaluation and compilation +(load "load-eval-and-compile.lsp") + +;;; Tests of data and control flow +(load "load-data-and-control-flow.lsp") + +;;; Tests of iteration forms +(load "load-iteration.lsp") + +;;; Tests of conditions +(load "load-conditions.lsp") + +;;; Tests of conses +(load "load-cons.lsp") + +;;; Tests on arrays +(load "load-arrays.lsp") + +;;; Tests of hash tables + +(load "hash-table.lsp") +(load "make-hash-table.lsp") + ; More to come + +;;; Tests of packages + +#-ecl (load "packages.lsp") + +;;; Tests of sequences +(load "load-sequences.lsp") + +;;; Tests of structures +(load "load-structures.lsp") + +;;; Tests of types and classes +(load "load-types-and-class.lsp") + +;;; Tests of the reader +(load "reader-test.lsp") + +;;; Tests of strings +(load "load-strings.lsp") + +;;; Tests of pathnames +(load "load-pathnames.lsp") + +;;; Tests of file operations +(load "load-files.lsp") + +;;; Tests of streams +(load "load-streams.lsp") + +;;; Tests for character functions +(compile-and-load "char-aux.lsp") +(load "character.lsp") +(load "char-compare.lsp") + +;;; Tests of system construction +(load "features.lsp") diff --git a/ansi-tests/get-output-stream-string.lsp b/ansi-tests/get-output-stream-string.lsp new file mode 100644 index 0000000..7fc390c --- /dev/null +++ b/ansi-tests/get-output-stream-string.lsp @@ -0,0 +1,32 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 09:48:46 2004 +;;;; Contains: Tests of GET-OUTPUT-STREAM-STRING + +(in-package :cl-test) + +;; this function is used extensively elsewhere in the test suite + +(deftest get-output-stream-string.1 + (let ((s (make-string-output-stream))) + (values + (get-output-stream-string s) + (write-string "abc" s) + (write-string "def" s) + (get-output-stream-string s) + (get-output-stream-string s))) + "" "abc" "def" "abcdef" "") + +;;; Error cases + +(deftest get-output-stream-string.error.1 + (signals-error (get-output-stream-string) t) + t) + +(deftest get-output-stream-string.error.2 + (signals-error (get-output-stream-string (make-string-output-stream) nil) t) + t) + + + + diff --git a/ansi-tests/get-setf-expansion.lsp b/ansi-tests/get-setf-expansion.lsp new file mode 100644 index 0000000..77c603a --- /dev/null +++ b/ansi-tests/get-setf-expansion.lsp @@ -0,0 +1,16 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 17:05:17 2003 +;;;; Contains: Tests for GET-SETF-EXPANSION + +(in-package :cl-test) + +(deftest get-setf-expansion.error.1 + (classify-error (get-setf-expansion)) + program-error) + +(deftest get-setf-expansion.error.2 + (classify-error (get-setf-expansion 'x nil nil)) + program-error) + +;;; Tests for proper behavior will go here diff --git a/ansi-tests/handler-bind.lsp b/ansi-tests/handler-bind.lsp new file mode 100644 index 0000000..2bbef0c --- /dev/null +++ b/ansi-tests/handler-bind.lsp @@ -0,0 +1,144 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Feb 28 22:07:25 2003 +;;;; Contains: Tests of HANDLER-BIND + +(in-package :cl-test) + +(deftest handler-bind.1 + (handler-bind ()) + nil) + +(deftest handler-bind.2 + (handler-bind () (values))) + +(deftest handler-bind.3 + (handler-bind () (values 1 2 3)) + 1 2 3) + +(deftest handler-bind.4 + (let ((x 0)) + (values + (handler-bind () (incf x) (+ x 10)) + x)) + 11 1) + +(deftest handler-bind.5 + (block foo + (handler-bind ((error #'(lambda (c) (return-from foo 'good)))) + (error "an error"))) + good) + +(deftest handler-bind.6 + (block foo + (handler-bind + ((error #'(lambda (c) (return-from foo 'good)))) + (handler-bind ((error #'(lambda (c) (error c))) + (error #'(lambda (c) (return-from foo 'bad)))) + (error "an error")))) + good) + +(defun handler-bind.7-handler-fn (c) + (declare (ignore c)) + (throw 'foo 'good)) + +(deftest handler-bind.7 + (catch 'foo + (handler-bind ((simple-error #'handler-bind.7-handler-fn)) + (error "simple error"))) + good) + +(deftest handler-bind.8 + (catch 'foo + (handler-bind ((simple-error 'handler-bind.7-handler-fn)) + (error "simple error"))) + good) + +(deftest handler-bind.9 + (catch 'foo + (handler-bind ((simple-error #.(symbol-function + 'handler-bind.7-handler-fn))) + (error "simple error"))) + good) + +(deftest handler-bind.10 + (block done + (flet ((%foo () (signal "A simple condition")) + (%succeed (c) (declare (ignore c)) (return-from done 'good)) + (%fail (c) (declare (ignore c)) (return-from done 'bad))) + (handler-bind + ((error #'%fail) + (simple-condition #'%succeed)) + (%foo)))) + good) + +(deftest handler-bind.11 + (block done + (handler-bind + ((error #'(lambda (c) c)) + (error #'(lambda (c) (declare (ignore c)) (return-from done 'good)))) + (error "an error"))) + good) + +(deftest handler-bind.12 + (block done + (handler-bind + ((error #'(lambda (c) (declare (ignore c)) (return-from done 'good)))) + (handler-bind + ((error #'(lambda (c) c))) + (error "an error")))) + good) + +(deftest handler-bind.13 + (handler-bind + ((error #'(lambda (c) (declare (ignore c)) + (throw 'done 'good)))) + (catch 'done + (error "an error"))) + good) + +(deftest handler-bind.14 + (catch 'done + (handler-bind + ((symbol #'identity) ;; can never succeed + (error #'(lambda (c) (declare (ignore c)) + (throw 'done 'good)))) + (error "an error"))) + good) + +(deftest handler-bind.15 + (catch 'done + (handler-bind + ((t #'(lambda (c) (declare (ignore c)) + (throw 'done 'good)))) + (error "an error"))) + good) + +(deftest handler-bind.16 + (catch 'done + (handler-bind + (((not error) #'identity) + (error + #'(lambda (c) (declare (ignore c)) + (throw 'done 'good)))) + (error "an error"))) + good) + +(deftest handler-bind.17 + (catch 'done + (handler-bind + ((#.(find-class 'error) + #'(lambda (c) (declare (ignore c)) + (throw 'done 'good)))) + (error "an error"))) + good) + +;;; More handler-bind tests elsewhere + + + + + + + + diff --git a/ansi-tests/handler-case.lsp b/ansi-tests/handler-case.lsp new file mode 100644 index 0000000..373bad4 --- /dev/null +++ b/ansi-tests/handler-case.lsp @@ -0,0 +1,9 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 1 14:08:07 2003 +;;;; Contains: Tests of HANDLER-CASE + +(in-package :cl-test) + +;;; (deftest handler-case.1 +;;; (handler-case (( diff --git a/ansi-tests/hash-table.lsp b/ansi-tests/hash-table.lsp new file mode 100644 index 0000000..fb6c5fd --- /dev/null +++ b/ansi-tests/hash-table.lsp @@ -0,0 +1,71 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 21:30:42 2003 +;;;; Contains: Tests of HASH-TABLE and related interface + +(in-package :cl-test) + +(deftest hash-table.1 + (notnot-mv (find-class 'hash-table)) + t) + +(deftest hash-table.2 + (loop for e in '(nil t 1 10.0 (a b c) #(a b c) #*1011 + #0aNIL #2a((a b)(c d)) #p"foo" + "bar" #\a 3/5 #c(1.0 2.0)) + when (typep e 'hash-table) + collect e) + nil) + +(deftest hash-table.3 + (let ((c (find-class 'hash-table))) + (loop for e in '(nil t 1 10.0 (a b c) #(a b c) #*1011 + #0aNIL #2a((a b)(c d)) #p"foo" + "bar" #\a 3/5 #c(1.0 2.0)) + when (typep e c) + collect e)) + nil) + +(deftest hash-table.4 + (notnot-mv (typep (make-hash-table) 'hash-table)) + t) + +(deftest hash-table.5 + (notnot-mv (typep (make-hash-table) (find-class 'hash-table))) + t) + +;;; + +(deftest hash-table-p.1 + (loop for e in '(nil t 1 10.0 (a b c) #(a b c) #*1011 + #0aNIL #2a((a b)(c d)) #p"foo" + "bar" #\a 3/5 #c(1.0 2.0)) + when (hash-table-p e) + collect e) + nil) + +(deftest hash-table-p.2 + (loop for e in *universe* + for p = (typep e 'hash-table) + for q = (hash-table-p e) + always (if p q (not q))) + t) + +(deftest hash-table-p.3 + (let ((i 0)) + (values (hash-table-p (incf i)) i)) + nil 1) + +(deftest hash-table-p.error.1 + (classify-error (hash-table-p)) + program-error) + +(deftest hash-table-p.error.2 + (classify-error (let ((h (make-hash-table))) (hash-table-p h nil))) + program-error) + + + + + + diff --git a/ansi-tests/host-namestring.lsp b/ansi-tests/host-namestring.lsp new file mode 100644 index 0000000..274b1f5 --- /dev/null +++ b/ansi-tests/host-namestring.lsp @@ -0,0 +1,49 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Sep 12 06:22:40 2004 +;;;; Contains: Tests of HOST-NAMESTRING + +(in-package :cl-test) + +(deftest host-namestring.1 + (let* ((vals (multiple-value-list + (host-namestring "host-namestring.lsp"))) + (s (first vals))) + (if (and (null (cdr vals)) + (or (null s) + (stringp s) + ;; (equal (host-namestring s) s) + )) + :good + vals)) + :good) + +(deftest host-namestring.2 + (do-special-strings + (s "host-namestring.lsp" nil) + (let ((ns (host-namestring s))) + (when ns + (assert (stringp ns)) + ;; (assert (string= (host-namestring ns) ns)) + ))) + nil) + +(deftest host-namestring.3 + (let* ((name "host-namestring.lsp") + (pn (merge-pathnames (pathname name))) + (name2 (with-open-file (s pn :direction :input) + (host-namestring s))) + (name3 (host-namestring pn))) + (or (equalt name2 name3) (list name2 name3))) + t) + +;;; Error tests + +(deftest host-namestring.error.1 + (signals-error (host-namestring) program-error) + t) + +(deftest host-namestring.error.2 + (signals-error (host-namestring "host-namestring.lsp" nil) program-error) + t) + diff --git a/ansi-tests/identity.lsp b/ansi-tests/identity.lsp new file mode 100644 index 0000000..0ea8f70 --- /dev/null +++ b/ansi-tests/identity.lsp @@ -0,0 +1,34 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 23:21:11 2002 +;;;; Contains: Tests for IDENTITY + +(in-package :cl-test) + +(deftest identity.1 + (loop for x in *universe* + always (eqlt x (check-values (identity x)))) + t) + +(deftest identity.2 + (let ((x (ash 1 100))) + (eqlt x (check-values (identity x)))) + t) + +(deftest identity.3 + (let ((x 1.00000001)) + (eqlt x (check-values (identity x)))) + t) + +(deftest identity.order.1 + (let ((i 0)) + (values (identity (incf i)) i)) + 1 1) + +(deftest identity.error.1 + (classify-error (identity)) + program-error) + +(deftest identity.error.2 + (classify-error (identity 'a 'a)) + program-error) diff --git a/ansi-tests/if.lsp b/ansi-tests/if.lsp new file mode 100644 index 0000000..764e287 --- /dev/null +++ b/ansi-tests/if.lsp @@ -0,0 +1,35 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 08:21:29 2002 +;;;; Contains: Tests for IF + +(in-package :cl-test) + +(deftest if.1 + (if t 1 2) + 1) + +(deftest if.2 + (if nil 1 2) + 2) + +(deftest if.3 (if t (values) 'a)) + +(deftest if.4 + (if nil 'a) + nil) + +(deftest if.5 + (if t (values 'a 'b 'c) 'd) + a b c) + +(deftest if.6 + (if nil 'a (values 'b 'c 'd)) + b c d) + +(deftest if.7 (if nil 'a (values))) + +(deftest if.order.1 + (let ((i 0)) + (values (if (= (incf i) 1) 't nil) i)) + t 1) diff --git a/ansi-tests/input-stream-p.lsp b/ansi-tests/input-stream-p.lsp new file mode 100644 index 0000000..ca5f1d0 --- /dev/null +++ b/ansi-tests/input-stream-p.lsp @@ -0,0 +1,40 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 13 19:39:27 2004 +;;;; Contains: Tests for INPUT-STREAM-P + +(in-package :cl-test) + +(deftest input-stream-p.1 + (notnot-mv (input-stream-p *standard-input*)) + t) + +(deftest input-stream-p.2 + (notnot-mv (input-stream-p *terminal-io*)) + t) + +(deftest input-stream-p.3 + (with-open-file (s "input-stream-p.lsp" :direction :input) + (notnot-mv (input-stream-p s))) + t) + +(deftest input-stream-p.4 + (with-open-file (s "foo.txt" :direction :output + :if-exists :supersede) + (input-stream-p s)) + nil) + +;;; Error tests + +(deftest input-stream-p.error.1 + (signals-error (input-stream-p) program-error) + t) + +(deftest input-stream-p.error.2 + (signals-error (input-stream-p *standard-input* nil) + program-error) + t) + +(deftest input-stream-p.error.3 + (check-type-error #'input-stream-p #'streamp) + nil) diff --git a/ansi-tests/interactive-stream-p.lsp b/ansi-tests/interactive-stream-p.lsp new file mode 100644 index 0000000..e29cb0f --- /dev/null +++ b/ansi-tests/interactive-stream-p.lsp @@ -0,0 +1,28 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 13 19:47:59 2004 +;;;; Contains: Tests of INTERACTIVE-STREAM-P + +(in-package :cl-test) + +(deftest interactive-stream-p.1 + (let ((streams (list *debug-io* *error-output* *query-io* + *standard-input* *standard-output* + *trace-output* *terminal-io*))) + (mapc #'interactive-stream-p streams) + ;; no error should occur + nil) + nil) + +(deftest interactive-stream-p.error.1 + (check-type-error #'interactive-stream-p #'streamp) + nil) + +(deftest interactive-stream-p.error.2 + (signals-error (interactive-stream-p) program-error) + t) + +(deftest interactive-stream-p.error.3 + (signals-error (interactive-stream-p *terminal-io* nil) + program-error) + t) diff --git a/ansi-tests/invoke-debugger.lsp b/ansi-tests/invoke-debugger.lsp new file mode 100644 index 0000000..700cf42 --- /dev/null +++ b/ansi-tests/invoke-debugger.lsp @@ -0,0 +1,23 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Feb 28 21:59:57 2003 +;;;; Contains: Tests of INVOKE-DEBUGGER + +(in-package :cl-test) + +;;; We can't test actual entry into the debugger, but we can test +;;; that the function in *debugger-hook* is properly called. + +(deftest invoke-debugger.1 + (block done + (let (fn (cnd (make-condition 'simple-error))) + (setq fn #'(lambda (c hook) + (return-from done + (and (null *debugger-hook*) + (eqt hook fn) + (eqt cnd c) + 'good)))) + (let ((*debugger-hook* fn)) + (invoke-debugger cnd))) + 'bad) + good) diff --git a/ansi-tests/iteration.lsp b/ansi-tests/iteration.lsp new file mode 100644 index 0000000..5b6d13b --- /dev/null +++ b/ansi-tests/iteration.lsp @@ -0,0 +1,494 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 21 22:58:00 2002 +;;;; Contains: Tests for iteration forms other than LOOP + +(in-package :cl-test) + +;;; Confirm that most macros exist + +(defparameter *iteration-macros* + '(do do* dotimes dolist loop)) + +(deftest iteration-macros + (remove-if #'macro-function *iteration-macros*) + nil) + +;;; Tests of DO + +(deftest do.1 + (do ((i 0 (1+ i))) + ((>= i 10) i)) + 10) + +(deftest do.2 + (do ((i 0 (1+ j)) + (j 0 (1+ i))) + ((>= i 10) (+ i j))) + 20) + +(deftest do.3 + (let ((x nil)) + (do ((i 0 (1+ i))) + ((>= i 10) x) + (push i x))) + (9 8 7 6 5 4 3 2 1 0)) + +(deftest do.4 + (let ((x nil)) + (do ((i 0 (1+ i))) + ((>= i 10) x) + (declare (fixnum i)) + (push i x))) + (9 8 7 6 5 4 3 2 1 0)) + +(deftest do.5 + (do ((i 0 (1+ i))) + (nil) + (when (> i 10) (return i))) + 11) + +;;; Zero iterations +(deftest do.6 + (do ((i 0 (+ i 10))) + ((> i -1) i) + (return 'bad)) + 0) + +;;; Tests of go tags +(deftest do.7 + (let ((x nil)) + (do ((i 0 (1+ i))) + ((>= i 10) x) + (go around) + small + (push 'a x) + (go done) + big + (push 'b x) + (go done) + around + (if (> i 4) (go big) (go small)) + done)) + (b b b b b a a a a a)) + +;;; No increment form +(deftest do.8 + (do ((i 0 (1+ i)) + (x nil)) + ((>= i 10) x) + (push 'a x)) + (a a a a a a a a a a)) + +;;; No do locals +(deftest do.9 + (let ((i 0)) + (do () + ((>= i 10) i) + (incf i))) + 10) + +;;; Return of no values +(deftest do.10 + (do ((i 0 (1+ i))) + ((> i 10) (values)))) + +;;; Return of two values +(deftest do.11 + (do ((i 0 (1+ i))) + ((> i 10) (values i (1+ i)))) + 11 12) + +;;; The results* list is an implicit progn +(deftest do.12 + (do ((i 0 (1+ i))) + ((> i 10) (incf i) (incf i) i)) + 13) + +(deftest do.13 + (do ((i 0 (1+ i))) + ((> i 10))) + nil) + +;; Special var +(deftest do.14 + (let ((x 0)) + (flet ((%f () (locally (declare (special i)) + (incf x i)))) + (do ((i 0 (1+ i))) + ((>= i 10) x) + (declare (special i)) + (%f)))) + 45) + +;;; Confirm that the variables in succesive iterations are +;;; identical +(deftest do.15 + (mapcar #'funcall + (let ((x nil)) + (do ((i 0 (1+ i))) + ((= i 5) x) + (push #'(lambda () i) x)))) + (5 5 5 5 5)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;; Tests of DO* + +(deftest do*.1 + (do* ((i 0 (1+ i))) + ((>= i 10) i)) + 10) + +(deftest do*.2 + (do* ((i 0 (1+ j)) + (j 0 (1+ i))) + ((>= i 10) (+ i j))) + 23) + +(deftest do*.3 + (let ((x nil)) + (do* ((i 0 (1+ i))) + ((>= i 10) x) + (push i x))) + (9 8 7 6 5 4 3 2 1 0)) + +(deftest do*.4 + (let ((x nil)) + (do* ((i 0 (1+ i))) + ((>= i 10) x) + (declare (fixnum i)) + (push i x))) + (9 8 7 6 5 4 3 2 1 0)) + +(deftest do*.5 + (do* ((i 0 (1+ i))) + (nil) + (when (> i 10) (return i))) + 11) + +;;; Zero iterations +(deftest do*.6 + (do* ((i 0 (+ i 10))) + ((> i -1) i) + (return 'bad)) + 0) + +;;; Tests of go tags +(deftest do*.7 + (let ((x nil)) + (do* ((i 0 (1+ i))) + ((>= i 10) x) + (go around) + small + (push 'a x) + (go done) + big + (push 'b x) + (go done) + around + (if (> i 4) (go big) (go small)) + done)) + (b b b b b a a a a a)) + +;;; No increment form +(deftest do*.8 + (do* ((i 0 (1+ i)) + (x nil)) + ((>= i 10) x) + (push 'a x)) + (a a a a a a a a a a)) + +;;; No do* locals +(deftest do*.9 + (let ((i 0)) + (do* () + ((>= i 10) i) + (incf i))) + 10) + +;;; Return of no values +(deftest do*.10 + (do* ((i 0 (1+ i))) + ((> i 10) (values)))) + +;;; Return of two values +(deftest do*.11 + (do* ((i 0 (1+ i))) + ((> i 10) (values i (1+ i)))) + 11 12) + +;;; The results* list is an implicit progn +(deftest do*.12 + (do* ((i 0 (1+ i))) + ((> i 10) (incf i) (incf i) i)) + 13) + +(deftest do*.13 + (do* ((i 0 (1+ i))) + ((> i 10))) + nil) + +;; Special var +(deftest do*.14 + (let ((x 0)) + (flet ((%f () (locally (declare (special i)) + (incf x i)))) + (do* ((i 0 (1+ i))) + ((>= i 10) x) + (declare (special i)) + (%f)))) + 45) + +;;; Confirm that the variables in succesive iterations are +;;; identical +(deftest do*.15 + (mapcar #'funcall + (let ((x nil)) + (do* ((i 0 (1+ i))) + ((= i 5) x) + (push #'(lambda () i) x)))) + (5 5 5 5 5)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;; Tests for DOLIST + +(deftest dolist.1 + (let ((count 0)) + (dolist (x '(a b nil d)) (incf count)) + count) + 4) + +(deftest dolist.2 + (let ((count 0)) + (dolist (x '(a nil c d) count) (incf count))) + 4) + +(deftest dolist.3 + (let ((count 0)) + (dolist (x nil count) (incf count))) + 0) + +(deftest dolist.4 + (let ((y nil)) + (flet ((%f () (locally (declare (special e)) + (push e y)))) + (dolist (e '(a b c) (reverse y)) + (declare (special e)) + (%f)))) + (a b c)) + +;;; Tests that it's a tagbody +(deftest dolist.5 + (let ((even nil) + (odd nil)) + (dolist (i '(1 2 3 4 5 6 7 8) (values (reverse even) + (reverse odd))) + (when (evenp i) (go even)) + (push i odd) + (go done) + even + (push i even) + done)) + (2 4 6 8) + (1 3 5 7)) + +;;; Test that bindings are not normally special +(deftest dolist.6 + (let ((i 0) (y nil)) + (declare (special i)) + (flet ((%f () i)) + (dolist (i '(1 2 3 4)) + (push (%f) y))) + y) + (0 0 0 0)) + +;;; Test multiple return values + +(deftest dolist..7 + (dolist (x '(a b) (values)))) + +(deftest dolist.8 + (let ((count 0)) + (dolist (x '(a b c) (values count count)) + (incf count))) + 3 3) + +;;; Test ability to return, and the scope of the implicit +;;; nil block +(deftest dolist.9 + (block nil + (eqlt (dolist (x '(a b c)) + (return 1)) + 1)) + t) + +(deftest dolist.10 + (block nil + (eqlt (dolist (x '(a b c)) + (return-from nil 1)) + 1)) + t) + +(deftest dolist.11 + (block nil + (dolist (x (return 1))) + 2) + 2) + +(deftest dolist.12 + (block nil + (dolist (x '(a b) (return 1))) + 2) + 2) + +;;; Check that binding of element var is visible in the result form +(deftest dolist.13 + (dolist (e '(a b c) e)) + nil) + +(deftest dolist.14 + (let ((e 1)) + (dolist (e '(a b c) (setf e 2))) + e) + 1) + +(deftest dolist.15 + (let ((x nil)) + (dolist (e '(a b c d e f)) + (push e x) + (when (eq e 'c) (return x)))) + (c b a)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Tests for DOTIMES + +(deftest dotimes.1 + (dotimes (i 10)) + nil) + +(deftest dotimes.2 + (dotimes (i 10 'a)) + a) + +(deftest dotimes.3 + (dotimes (i 10 (values)))) + +(deftest dotimes.3a + (dotimes (i 10 (values 'a 'b 'c))) + a b c) + +(deftest dotimes.4 + (let ((x nil)) + (dotimes (i 5 x) (push i x))) + (4 3 2 1 0)) + +(deftest dotimes.5 + (let ((x nil)) + (dotimes (i 0 x) (push i x))) + nil) + +(deftest dotimes.6 + (let ((x nil)) + (dotimes (i -1 x) (push i x))) + nil) + +(deftest dotimes.7 + (let ((x nil)) + (dotimes (i (1- most-negative-fixnum) x) (push i x))) + nil) + +;;; Implicit nil block has the right scope +(deftest dotimes.8 + (block nil + (dotimes (i (return 1))) + 2) + 2) + +(deftest dotimes.9 + (block nil + (dotimes (i 10 (return 1))) + 2) + 2) + +(deftest dotimes.10 + (block nil + (dotimes (i 10) (return 1)) + 2) + 2) + +(deftest dotimes.11 + (let ((x nil)) + (dotimes (i 10) + (push i x) + (when (= i 5) (return x)))) + (5 4 3 2 1 0)) + +;;; Check there's an implicit tagbody +(deftest dotimes.12 + (let ((even nil) + (odd nil)) + (dotimes (i 8 (values (reverse even) + (reverse odd))) + (when (evenp i) (go even)) + (push i odd) + (go done) + even + (push i even) + done)) + (0 2 4 6) + (1 3 5 7)) + +;;; Check that at the time the result form is evaluated, +;;; the index variable is set to the number of times the loop +;;; was executed. + +(deftest dotimes.13 + (let ((i 100)) + (dotimes (i 10 i))) + 10) + +(deftest dotimes.14 + (let ((i 100)) + (dotimes (i 0 i))) + 0) + +(deftest dotimes.15 + (let ((i 100)) + (dotimes (i -1 i))) + 0) + +;;; Check that the variable is not bound in the count form +(deftest dotimes.16 + (let ((i nil)) + (values + i + (dotimes (i (progn (setf i 'a) 10) i)) + i)) + nil 10 a) + +;;; Check special variable decls +(deftest dotimes.17 + (let ((i 0) (y nil)) + (declare (special i)) + (flet ((%f () i)) + (dotimes (i 4) + (push (%f) y))) + y) + (0 0 0 0)) + +(deftest dotimes.18 + (let ((i 0) (y nil)) + (declare (special i)) + (flet ((%f () i)) + (dotimes (i 4) + (declare (special i)) + (push (%f) y))) + y) + (3 2 1 0)) + + + + diff --git a/ansi-tests/labels.lsp b/ansi-tests/labels.lsp new file mode 100644 index 0000000..37f8802 --- /dev/null +++ b/ansi-tests/labels.lsp @@ -0,0 +1,214 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Oct 9 19:06:33 2002 +;;;; Contains: Tests of LABELS + +(in-package :cl-test) + +(deftest labels.1 + (labels ((%f () 1)) + (%f)) + 1) + +(deftest labels.2 + (labels ((%f (x) x)) + (%f 2)) + 2) + +(deftest labels.3 + (labels ((%f (&rest args) args)) + (%f 'a 'b 'c)) + (a b c)) + +;;; The optional arguments are not in the block defined by +;;; the local function declaration +(deftest labels.4 + (block %f + (labels ((%f (&optional (x (return-from %f 10))) + 20)) + (%f))) + 10) + +(deftest labels.5 + (labels ((%f () (return-from %f 15) 35)) + (%f)) + 15) + +;;; The aux parameters are not in the block defined by +;;; the local function declaration +(deftest labels.6 + (block %f + (labels ((%f (&aux (x (return-from %f 10))) + 20)) + (%f))) + 10) + +;;; The function is visible inside itself +(deftest labels.7 + (labels ((%f (x n) (cond ((eql n 0) x) + (t (%f (+ x n) (1- n)))))) + (%f 0 10)) + 55) + +;;; Keyword arguments +(deftest labels.8 + (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f)) + nil 0 nil) + +(deftest labels.9 + (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :a 1)) + 1 0 nil) + +(deftest labels.10 + (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :b 2)) + nil 2 t) + +(deftest labels.11 + (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :b 2 :a 3)) + 3 2 t) + +;;; Unknown keyword parameter should throw a program-error in safe code +;;; (section 3.5.1.4) +(deftest labels.12 + (classify-error + (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))) + program-error) + +;;; Odd # of keyword args should throw a program-error in safe code +;;; (section 3.5.1.6) +(deftest labels.13 + (classify-error + (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))) + program-error) + +;;; Too few arguments (section 3.5.1.2) +(deftest labels.14 + (classify-error (labels ((%f (a) a)) (%f))) + program-error) + +;;; Too many arguments (section 3.5.1.3) +(deftest labels.15 + (classify-error (labels ((%f (a) a)) (%f 1 2))) + program-error) + +;;; Invalid keyword argument (section 3.5.1.5) +(deftest labels.16 + (classify-error (labels ((%f (&key a) a)) (%f '(foo)))) + program-error) + + +;;; Definition of a (setf ...) function + +(deftest labels.17 + (labels (((setf %f) (x y) (setf (car y) x))) + (let ((z (list 1 2))) + (setf (%f z) 'a) + z)) + (a 2)) + +;;; Scope of defined function names includes &AUX parameters + +(deftest labels.7b + (labels ((%f (x &aux (b (%g x))) b) + (%g (y) (+ y y))) + (%f 10)) + 20) + +;;; Body is an implicit progn +(deftest labels.18 + (labels ((%f (x) (incf x) (+ x x))) + (%f 10)) + 22) + +;;; Can handle at least 50 lambda parameters +(deftest labels.19 + (labels ((%f (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 + b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 + c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 + d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 + e1 e2 e3 e4 e5 e6 e7 e8 e9 e10) + (+ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 + b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 + c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 + d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 + e1 e2 e3 e4 e5 e6 e7 e8 e9 e10))) + (%f 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)) + 1275) + +;;; labels works with the maximum number of arguments (if +;;; not too many.) +(deftest labels.20 + (let* ((n (min lambda-parameters-limit 1024)) + (vars (loop for i from 1 to n collect (gensym)))) + (eval + `(eql ,n + (labels ((%f ,vars (+ ,@ vars))) + (%f ,@(loop for e in vars collect 1)))))) + t) + +;;; Declarations and documentation strings are ok +(deftest labels.21 + (labels ((%f (x) + (declare (type fixnum x)) + "Add one to the fixnum x." + (1+ x))) + (declare (ftype (function (fixnum) integer) %f)) + (%f 10)) + 11) + +;;; Keywords can be function names +(deftest labels.22 + (labels ((:foo () 10) + (:bar () (1+ (:foo)))) + (:bar)) + 11) + +(deftest labels.23 + (labels ((:foo () 10) + (:bar () (1+ (funcall #':foo)))) + (funcall #':bar)) + 11) + +(deftest labels.24 + (loop for s in *cl-non-function-macro-special-operator-symbols* + for form = `(classify-error (labels ((,s (x) (foo (1- x))) + (foo (y) + (if (<= y 0) 'a + (,s (1- y))))) + (,s 10))) + unless (eq (eval form) 'a) + collect s) + nil) + +(deftest labels.25 + (loop for s in *cl-non-function-macro-special-operator-symbols* + for form = `(classify-error + (labels ((,s (x) (foo (1- x))) + (foo (y) + (if (<= y 0) 'a + (,s (1- y))))) + (declare (ftype (function (integer) symbol) + foo ,s)) + (,s 10))) + unless (eq (eval form) 'a) + collect s) + nil) + +(deftest labels.26 + (loop for s in *cl-non-function-macro-special-operator-symbols* + for form = `(classify-error + (labels (((setf ,s) (&rest args) + (declare (ignore args)) + 'a)) + (setf (,s) 10))) + unless (eq (eval form) 'a) + collect s) + nil) diff --git a/ansi-tests/lambda-list-keywords.lsp b/ansi-tests/lambda-list-keywords.lsp new file mode 100644 index 0000000..856727d --- /dev/null +++ b/ansi-tests/lambda-list-keywords.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 7 22:11:31 2002 +;;;; Contains: Tests for LAMBDA-LIST-KEYWORDS + +(in-package :cl-test) + +;;; The variable is bound +(deftest lambda-list-keywords.1 + (not-mv (boundp 'lambda-list-keywords)) + nil) + +;;; The variable is a constant +(deftest lambda-list-keywords.2 + (not-mv (constantp 'lambda-list-keywords)) + nil) + +;;; The standard keywords are present in the list +(deftest lambda-list-keywords.3 + (and (consp lambda-list-keywords) + (not-mv (set-difference '(&allow-other-keys + &aux &body &environment + &key &optional &rest &whole) + lambda-list-keywords))) + t) + +;;; No lambda list keywords are in the keyword package +(deftest lambda-list-keywords.4 + (some #'keywordp lambda-list-keywords) + nil) + +;;; Every keyword starts with an ampersand +(deftest lambda-list-keywords.5 + (notevery #'(lambda (sym) + (let ((name (symbol-name sym))) + (and (> (length name) 0) + (eql (aref name 0) #\&)))) + lambda-list-keywords) + nil) diff --git a/ansi-tests/lambda-parameters-limit.lsp b/ansi-tests/lambda-parameters-limit.lsp new file mode 100644 index 0000000..c886cf1 --- /dev/null +++ b/ansi-tests/lambda-parameters-limit.lsp @@ -0,0 +1,17 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 10 22:45:44 2002 +;;;; Contains: Tests for LAMBDA-PARAMETERS-LIMIT + +(in-package :cl-test) + +(deftest lambda-parameters-limit.1 + (not (typep lambda-parameters-limit 'integer)) + nil) + +(deftest lambda-parameters-limit.2 + (< lambda-parameters-limit 50) + nil) + +;;; See also tests is flet.lsp, labels.lsp + diff --git a/ansi-tests/lambda.lsp b/ansi-tests/lambda.lsp new file mode 100644 index 0000000..d3751a8 --- /dev/null +++ b/ansi-tests/lambda.lsp @@ -0,0 +1,60 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Nov 27 06:43:21 2002 +;;;; Contains: Tests of LAMBDA forms + +(in-package :cl-test) + +(deftest lambda.1 + ((lambda (x) x) 'a) + a) + +(deftest lambda.2 + ((lambda () 'a)) + a) + +(deftest lambda.3 + ((lambda () "documentation" 'a)) + a) + +(deftest lambda.4 + ((lambda (x) (declare (type symbol x)) x) 'z) + z) + +(deftest lambda.5 + ((lambda (&aux (x 'a)) x)) + a) + +(deftest lambda.6 + ((lambda (&aux (x 'a)) (declare (type symbol x)) x)) + a) + +(deftest lambda.7 + ((lambda () "foo")) + "foo") + +(deftest lambda.8 + ((lambda () "foo" "bar")) + "bar") + +(deftest lambda.9 + ((lambda (x y) (declare (ignore x)) "foo" (declare (ignore y)) "bar") 1 2) + "bar") + +(deftest lambda.10 + ((lambda (x) (declare (type symbol x))) 'z) + nil) + +;;; Should test lambda argument lists more fully here + +;;; Tests of lambda as a macro + +(deftest lambda.macro.1 + (notnot (macro-function 'lambda)) + t) + +(deftest lambda.macro.2 + (funcall (eval (macroexpand '(lambda () 10)))) + 10) + + \ No newline at end of file diff --git a/ansi-tests/ldtest.lsp b/ansi-tests/ldtest.lsp new file mode 100644 index 0000000..e84259d --- /dev/null +++ b/ansi-tests/ldtest.lsp @@ -0,0 +1 @@ +(in-package :cl-test) (defun LOAD-TEST-FUN-3 () :foo) \ No newline at end of file diff --git a/ansi-tests/length.lsp b/ansi-tests/length.lsp new file mode 100644 index 0000000000000000000000000000000000000000..79aab2dad52374b917f84fc851513fa657fb29b6 GIT binary patch literal 2452 zcmb7FOLN*V5bl{@u|p2X%s9m+Neel3+Dv;$J3VmBMHm4}gyc$c8~W?JdIaoZO^7%k zOZ)ovTkYQF;~c)L6`O-w_uSNgM}u2j@Tsv|rQOX>+6ef5A(iAU`F365PG4I&{ z!sV6YHiX#7c7XX+zErC{5a$E~wLr)-etA82qEziY_zZAZYqf(3SOv4$3|1=Kky@*b z40}{+q+rGXVZX!y{Bs681EQI2wDhTP9{nP9W46HIIXZcH#!7w=vbkT?U#6`sKYJQM&?o$yG>fU!^a(HCA)E=@K_i@phE&P&Y=>5OYsfj|v^~#+aVh z6guRMCx!btt(zV (length str) 0))) + (v4 (if (or print? verbose?) + (> (length str) 0) + t))) + (if (and (= (length vals) 1) v1 v2 v3 v4) t (list vals v2 v3 v4 str))) + (funcall funname)))) + +(deftest load.1 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1) + t nil) + +(deftest load.2 + (load-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1) + t nil) + +(deftest load.3 + (with-input-from-string + (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") + (load-file-test s 'load-file-test-fun.2)) + t good) + +(deftest load.4 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :external-format :default) + t nil) + +(deftest load.5 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :verbose t) + t nil) + +(deftest load.6 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :*load-verbose* t) + t nil) + +(deftest load.7 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :*load-verbose* t :verbose nil) + t nil) + +(deftest load.8 + (with-input-from-string + (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") + (load-file-test s 'load-file-test-fun.2 :verbose t)) + t good) + +(deftest load.9 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :print t) + t nil) + +(deftest load.10 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :*load-print* t) + t nil) + +(deftest load.11 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :*load-print* t :print nil) + t nil) + +(deftest load.12 + (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :*load-print* nil :print t) + t nil) + +(deftest load.13 + (with-input-from-string + (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") + (load-file-test s 'load-file-test-fun.2 :print t)) + t good) + +(deftest load.14 + (load "nonexistent-file.lsp" :if-does-not-exist nil) + nil) + +(defpackage LOAD-TEST-PACKAGE (:use "COMMON-LISP")) + +(deftest load.15 + (let ((*package* (find-package "LOAD-TEST-PACKAGE"))) + (with-input-from-string + (s "(defun f () 'good)") + (load-file-test s 'load-test-package::f))) + t load-test-package::good) + +(deftest load.15a + (let ((*package* (find-package "CL-TEST"))) + (values + (with-input-from-string + (s "(eval-when (:load-toplevel :execute) (setq *package* (find-package \"LOAD-TEST-PACKAGE\"))) + (defun f () 'good)") + (multiple-value-list (load-file-test s 'load-test-package::f))) + (read-from-string "GOOD"))) + (t load-test-package::good) good) + +(deftest load.16 + (let ((*readtable* (copy-readtable nil))) + (set-macro-character #\! (get-macro-character #\')) + (with-input-from-string + (s "(in-package :cl-test) (defun load-file-test-fun.3 () !good)") + (load-file-test s 'load-file-test-fun.3))) + t good) + +(deftest load.16a + (let ((*readtable* *readtable*) + (*package* (find-package "CL-TEST"))) + (values + (with-input-from-string + (s "(in-package :cl-test) + (eval-when (:load-toplevel :execute) + (setq *readtable* (copy-readtable nil)) + (set-macro-character #\\! (get-macro-character #\\'))) + (defun load-file-test-fun.3 () !good)") + (multiple-value-list + (load-file-test s 'load-file-test-fun.3))) + (read-from-string "!FOO"))) + (t good) !FOO) + +(deftest load.17 + (let ((file #p"load-test-file.lsp")) + (fmakunbound 'load-file-test-fun.1) + (fmakunbound 'load-file-test-fun.2) + (values + (notnot (load file)) + (let ((p1 (pathname (merge-pathnames file))) + (p2 (funcall 'load-file-test-fun.1))) + (equalpt-or-report p1 p2)) + (let ((p1 (truename file)) + (p2 (funcall 'load-file-test-fun.2))) + (equalpt-or-report p1 p2)))) + t t t) + +;;; Test that the load pathname/truename variables are bound +;;; properly when loading compiled files + +(deftest load.18 + (let* ((file "load-test-file-2.lsp") + (target (enough-namestring (compile-file-pathname file)))) + (declare (special *load-test-var.1* *load-test-var.2*)) + (compile-file file) + (makunbound '*load-test-var.1*) + (makunbound '*load-test-var.2*) + (load target) + (values + (let ((p1 (pathname (merge-pathnames target))) + (p2 *load-test-var.1*)) + (equalpt-or-report p1 p2)) + (let ((p1 (truename target)) + (p2 *load-test-var.2*)) + (equalpt-or-report p1 p2)))) + t t) + +(deftest load.19 + (let ((file (logical-pathname "CLTEST:LDTEST.LSP")) + (fn 'load-test-fun-3) + (*package* (find-package "CL-TEST"))) + (with-open-file + (s file :direction :output :if-exists :supersede + :if-does-not-exist :create) + (format s "(in-package :cl-test) (defun ~a () :foo)" fn)) + (fmakunbound fn) + (values + (notnot (load file)) + (funcall fn))) + t :foo) + +;;; Defaults of the load variables + +(deftest load-pathname.1 + *load-pathname* + nil) + +(deftest load-truename.1 + *load-truename* + nil) + +(deftest load-print.1 + *load-print* + nil) + +;;; Error tests + +(deftest load.error.1 + (signals-error (load "nonexistent-file.lsp") file-error) + t) + +(deftest load.error.2 + (signals-error (load) program-error) + t) + +(deftest load.error.3 + (signals-error (load "compile-file-test-file.lsp" :bad-key-arg t) + program-error) + t) diff --git a/ansi-tests/logical-pathname-translations.lsp b/ansi-tests/logical-pathname-translations.lsp new file mode 100644 index 0000000..b03718e --- /dev/null +++ b/ansi-tests/logical-pathname-translations.lsp @@ -0,0 +1,8 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Dec 31 09:46:08 2003 +;;;; Contains: Tests of LOGICAL-PATHNAME-TRANSLATIONS + +(in-package :cl-test) + + diff --git a/ansi-tests/logical-pathname.lsp b/ansi-tests/logical-pathname.lsp new file mode 100644 index 0000000..aebbd39 --- /dev/null +++ b/ansi-tests/logical-pathname.lsp @@ -0,0 +1,93 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Dec 30 19:05:01 2003 +;;;; Contains: Tests of LOGICAL-PATHNAME + +(in-package :cl-test) + +(deftest logical-pathname.1 + (loop for x in *logical-pathnames* + always (eql x (logical-pathname x))) + t) + +(deftest logical-pathname.2 + (notnot-mv (typep (logical-pathname "CLTEST:FOO") 'logical-pathname)) + t) + +(deftest logical-pathname.3 + (let ((name "CLTEST:TEMP.DAT.NEWEST")) + (with-open-file + (s (logical-pathname name) + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (or (equalt (logical-pathname s) (logical-pathname name)) + (list (logical-pathname s) (logical-pathname name))))) + t) + + +;;; Error tests + +(deftest logical-pathname.error.1 + (check-type-error #'logical-pathname + (typef '(or string stream logical-pathname))) + nil) + +(deftest logical-pathname.error.2 + ;; Doesn't specify a host + (signals-error (logical-pathname "FOO.TXT") type-error) + t) + +(deftest logical-pathname.error.3 + (signals-error + (with-open-file (s #p"logical-pathname.lsp" :direction :input) + (logical-pathname s)) + type-error) + t) + +(deftest logical-pathname.error.4 + (signals-error + (with-open-stream + (is (make-concatenated-stream)) + (with-open-stream + (os (make-broadcast-stream)) + (with-open-stream + (s (make-two-way-stream is os)) + (logical-pathname s)))) + type-error) + t) + +(deftest logical-pathname.error.5 + (signals-error + (with-open-stream + (is (make-concatenated-stream)) + (with-open-stream + (os (make-broadcast-stream)) + (with-open-stream + (s (make-echo-stream is os)) + (logical-pathname s)))) + type-error) + t) + +(deftest logical-pathname.error.6 + (signals-error (with-open-stream (s (make-broadcast-stream)) (logical-pathname s)) type-error) + t) + +(deftest logical-pathname.error.7 + (signals-error (with-open-stream (s (make-concatenated-stream)) (logical-pathname s)) type-error) + t) + +(deftest logical-pathname.error.8 + (signals-error (with-open-stream (s (make-string-input-stream "foo")) + (logical-pathname s)) type-error) + t) + +(deftest logical-pathname.error.9 + (signals-error (with-output-to-string (s) (logical-pathname s)) type-error) + t) + +(deftest logical-pathname.error.10 + (handler-case + (progn (eval '(locally (declare (optimize safety)) (logical-pathname "CLROOT:%"))) t) + (type-error () t)) + t) diff --git a/ansi-tests/loop.lsp b/ansi-tests/loop.lsp new file mode 100644 index 0000000..2a362fa --- /dev/null +++ b/ansi-tests/loop.lsp @@ -0,0 +1,53 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 25 18:48:59 2002 +;;;; Contains: Tests of LOOP + +(in-package :cl-test) + +;;; Simple loops +(deftest sloop.1 + (loop (return 'a)) + a) + +(deftest sloop.2 + (loop (return (values)))) + +(deftest sloop.3 + (loop (return (values 'a 'b 'c 'd))) + a b c d) + +(deftest sloop.4 + (block nil + (loop (return 'a)) + 'b) + b) + +(deftest sloop.5 + (let ((i 0) (x nil)) + (loop + (when (>= i 4) (return x)) + (incf i) + (push 'a x))) + (a a a a)) + +(deftest sloop.6 + (let ((i 0) (x nil)) + (block foo + (tagbody + (loop + (when (>= i 4) (go a)) + (incf i) + (push 'a x)) + a + (return-from foo x)))) + (a a a a)) + +(deftest sloop.7 + (catch 'foo + (let ((i 0) (x nil)) + (loop + (when (>= i 4) (throw 'foo x)) + (incf i) + (push 'a x)))) + (a a a a)) diff --git a/ansi-tests/loop1.lsp b/ansi-tests/loop1.lsp new file mode 100644 index 0000000..37f9c75 --- /dev/null +++ b/ansi-tests/loop1.lsp @@ -0,0 +1,227 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 25 19:07:19 2002 +;;;; Contains: Tests of extended loop, part 1 + +(in-package :cl-test) + +;;; Tests of variable initialization and stepping clauses + +;;; for-as-arithmetic + +(deftest loop.1.1 + (loop for x from 1 to 10 collect x) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.1.2 + (loop for x from 6 downto 1 collect x) + (6 5 4 3 2 1)) + +(deftest loop.1.3 + (loop for x from 1 to 1 collect x) + (1)) + +(deftest loop.1.4 + (loop for x from 1 to 0 collect x) + nil) + +(deftest loop.1.5 + (loop for x to 5 collect x) + (0 1 2 3 4 5)) + +(deftest loop.1.6 + (loop for x downfrom 5 to 0 collect x) + (5 4 3 2 1 0)) + +(deftest loop.1.7 + (loop for x upfrom 1 to 5 collect x) + (1 2 3 4 5)) + +(deftest loop.1.8 + (loop for x from 1.0 to 5.0 count x) + 5) + +(deftest loop.1.9 + (loop for x from 1 to 9 by 2 collect x) + (1 3 5 7 9)) + +(deftest loop.1.10 + (loop for x from 1 to 10 by 2 collect x) + (1 3 5 7 9)) + +(deftest loop.1.11 + (loop for x to 10 from 1 collect x) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.1.12 + (loop for x to 10 by 2 from 1 collect x) + (1 3 5 7 9)) + +(deftest loop.1.13 + (loop for x by 2 to 10 from 1 collect x) + (1 3 5 7 9)) + +(deftest loop.1.14 + (loop for x by 2 to 10 collect x) + (0 2 4 6 8 10)) + +(deftest loop.1.15 + (loop for x to 10 by 2 collect x) + (0 2 4 6 8 10)) + +(deftest loop.1.16 + (let ((n 0)) + (loop for x from (incf n) to (+ n 5) collect x)) + (1 2 3 4 5 6)) + +(deftest loop.1.17 + (let ((n 0)) + (loop for x to (+ n 5) from (incf n) collect x)) + (1 2 3 4 5)) + +(deftest loop.1.18 + (let ((n 0)) + (loop for x from (incf n) to (+ n 9) by (incf n) collect x)) + (1 3 5 7 9)) + +(deftest loop.1.19 + (let ((n 0)) + (loop for x from (incf n) by (incf n) to (+ n 9) collect x)) + (1 3 5 7 9 11)) + +(deftest loop.1.20 + (let ((a 0) (b 5) (c 1)) + (loop for x from a to b by c + collect (progn (incf a) (incf b 2) (incf c 3) x))) + (0 1 2 3 4 5)) + +(deftest loop.1.21 + (loop for x from 0 to 5 by 1/2 collect x) + (0 1/2 1 3/2 2 5/2 3 7/2 4 9/2 5)) + +(deftest loop.1.22 + (loop for x from 1 below 5 collect x) + (1 2 3 4)) + +(deftest loop.1.23 + (loop for x from 1 below 5.01 collect x) + (1 2 3 4 5)) + +(deftest loop.1.24 + (loop for x below 5 from 2 collect x) + (2 3 4)) + +(deftest loop.1.25 + (loop for x from 10 above 4 collect x) + (10 9 8 7 6 5)) + +(deftest loop.1.26 + (loop for x from 14 above 6 by 2 collect x) + (14 12 10 8)) + +(deftest loop.1.27 + (loop for x above 6 from 14 by 2 collect x) + (14 12 10 8)) + +(deftest loop.1.28 + (loop for x downfrom 16 above 7 by 3 collect x) + (16 13 10)) + +(deftest loop.1.29 + (let (a b c (i 0)) + (values + (loop for x from (progn (setq a (incf i)) 0) + below (progn (setq b (incf i)) 9) + by (progn (setq c (incf i)) 2) + collect x) + a b c i)) + (0 2 4 6 8) + 1 2 3 3) + +(deftest loop.1.30 + (let (a b c (i 0)) + (values + (loop for x from (progn (setq a (incf i)) 0) + by (progn (setq c (incf i)) 2) + below (progn (setq b (incf i)) 9) + collect x) + a b c i)) + (0 2 4 6 8) + 1 3 2 3) + +(deftest loop.1.31 + (let (a b c (i 0)) + (values + (loop for x + below (progn (setq b (incf i)) 9) + by (progn (setq c (incf i)) 2) + from (progn (setq a (incf i)) 0) + collect x) + a b c i)) + (0 2 4 6 8) + 3 1 2 3) + +(deftest loop.1.32 + (let (a b c (i 0)) + (values + (loop for x + by (progn (setq c (incf i)) 2) + below (progn (setq b (incf i)) 9) + from (progn (setq a (incf i)) 0) + collect x) + a b c i)) + (0 2 4 6 8) + 3 2 1 3) + +(deftest loop.1.33 + (loop for x from 1 upto 5 collect x) + (1 2 3 4 5)) + +(deftest loop.1.34 + (loop for x from 1 to 4.0 collect x) + (1 2 3 4)) + +(deftest loop.1.35 + (loop for x below 5 collect x) + (0 1 2 3 4)) + +(deftest loop.1.36 + (loop for x below 20 by 3 collect x) + (0 3 6 9 12 15 18)) + +(deftest loop.1.37 + (loop for x by 3 below 20 collect x) + (0 3 6 9 12 15 18)) + +(deftest loop.1.38 + (loop for x of-type fixnum from 1 to 5 collect x) + (1 2 3 4 5)) + +#| +;;; The following provides an example where an incorrect +;;; implementation will assign X an out-of-range value +;;; at the end. +(deftest loop.1.39 + (loop for x of-type (integer 1 5) from 1 to 5 collect x) + (1 2 3 4 5)) + +;;; Test that the index variable achieves the inclusive +;;; upper bound, but does not exceed it. +(deftest loop.1.40 + (loop for x from 1 to 5 do nil finally (return x)) + 5) + +;;; Test that the index variable acheives the exclusive +;;; upper bound, but does not exceed it. +(deftest loop.1.41 + (loop for x from 1 below 5 do nil finally (return x)) + 4) + +(deftest loop.1.42 + (loop for x from 10 downto 0 do nil finally (return x)) + 0) + +(deftest loop.1.43 + (loop for x from 10 above 0 do nil finally (return x)) + 1) +|# \ No newline at end of file diff --git a/ansi-tests/loop10.lsp b/ansi-tests/loop10.lsp new file mode 100644 index 0000000..c34ea30 --- /dev/null +++ b/ansi-tests/loop10.lsp @@ -0,0 +1,450 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 16 09:07:02 2002 +;;;; Contains: Tests of LOOP numeric value accumulation clauses + +(in-package :cl-test) + +;; Tests of COUNT, COUNTING + +(deftest loop.10.1 + (loop for x from 1 to 10 count (< x 5)) + 4) + +(deftest loop.10.2 + (loop for x from 1 to 10 counting (< x 7)) + 6) + +(deftest loop.10.3 + (loop for x from 1 to 10 count (< x 5) fixnum) + 4) + +(deftest loop.10.4 + (loop for x from 1 to 10 count (< x 5) of-type integer) + 4) + +(deftest loop.10.5 + (let (z) + (values + (loop for x from 1 to 10 count (< x 5) into foo + finally (setq z foo)) + z)) + nil + 4) + +(deftest loop.10.6 + (let (z) + (values + (loop for x from 1 to 10 count (< x 5) into foo fixnum + finally (setq z foo)) + z)) + nil + 4) + +(deftest loop.10.7 + (let (z) + (values + (loop for x from 1 to 10 count (< x 5) into foo of-type (integer 0 100) + finally (setq z foo)) + z)) + nil + 4) + +(deftest loop.10.8 + (let (z) + (values + (loop for x from 1 to 10 count (< x 5) into foo float + finally (setq z foo)) + z)) + nil + 4.0) + +(deftest loop.10.9 + (classify-error + (loop with foo = 10 + for x in '(a b c) count x into foo + finally (return foo))) + program-error) + +(deftest loop.10.10 + (classify-error + (loop with foo = 10 + for x in '(a b c) counting x into foo + finally (return foo))) + program-error) + +(declaim (special *loop-count-var*)) + +(deftest loop.10.11 + (let ((*loop-count-var* 100)) + (values + (loop for x in '(a b c d) count x into *loop-count-var* + finally (return *loop-count-var*)) + *loop-count-var*)) + 4 100) + +(deftest loop.10.12 + (loop for x in '(a b nil d nil e) + count x into foo + collect foo) + (1 2 2 3 3 4)) + +(deftest loop.10.13 + (loop for x in '(a b nil d nil e) + counting x into foo + collect foo) + (1 2 2 3 3 4)) + +(deftest loop.10.14 + (loop for x in '(a b c) count (return 10)) + 10) + + +;;; Tests of MAXIMIZE, MAXIMIZING + +(deftest loop.10.20 + (loop for x in '(1 4 10 5 7 9) maximize x) + 10) + +(deftest loop.10.21 + (loop for x in '(1 4 10 5 7 9) maximizing x) + 10) + +(deftest loop.10.22 + (loop for x in '(1000000000000) maximizing x) + 1000000000000) + +(deftest loop.10.23 + (loop for x in '(-1000000000000) maximize x) + -1000000000000) + +(deftest loop.10.24 + (loop for x in '(1.0 2.0 3.0 -1.0) maximize x) + 3.0) + +(deftest loop.10.25 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) maximize x fixnum) + 24) + +(deftest loop.10.26 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) maximize x of-type integer) + 24) + +(deftest loop.10.27 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) maximize x of-type rational) + 24) + +(deftest loop.10.28 + (loop for x in '(1 4 10 5 7 9) maximize x into foo finally (return foo)) + 10) + +(deftest loop.10.29 + (let (z) + (values + (loop for x in '(1 4 10 5 7 9) maximize x into foo finally (setq z foo)) + z)) + nil + 10) + +(deftest loop.10.30 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) maximize x of-type real) + 24) + +(deftest loop.10.31 + (loop for x in '(0.08 0.20 0.05 0.03 0.24 0.01 0.19 0.04 0.20 0.03) maximize x of-type float) + 0.24) + +(deftest loop.10.32 + (loop for x in '(-1/8 -1/20 -1/5 -1/3 -1/24 -1/1 -1/19 -1/4 -1/20 -1/3) maximize x of-type rational) + -1/24) + +(deftest loop.10.33 + (loop for x in '(1 4 10 5 7 9) maximize x into foo fixnum finally (return foo)) + 10) + +(deftest loop.10.34 + (loop for x in '(1 4 10 5 7 9) maximize x into foo of-type integer finally (return foo)) + 10) + +(deftest loop.10.35 + (let ((foo 20)) + (values + (loop for x in '(3 5 8 3 7) maximize x into foo finally (return foo)) + foo)) + 8 20) + +(declaim (special *loop-max-var*)) + +(deftest loop.10.36 + (let ((*loop-max-var* 100)) + (values + (loop for x in '(1 10 4 8) maximize x into *loop-max-var* + finally (return *loop-max-var*)) + *loop-max-var*)) + 10 100) + +(deftest loop.10.37 + (classify-error + (loop with foo = 100 + for i from 1 to 10 maximize i into foo + finally (return foo))) + program-error) + +(deftest loop.10.38 + (classify-error + (loop with foo = 100 + for i from 1 to 10 maximizing i into foo + finally (return foo))) + program-error) + + +(deftest loop.10.39 + (loop for x in '(1 2 3) maximize (return 10)) + 10) + +;;; Tests of MINIMIZE, MINIMIZING + +(deftest loop.10.40 + (loop for x in '(4 10 1 5 7 9) minimize x) + 1) + +(deftest loop.10.41 + (loop for x in '(4 10 5 7 1 9) minimizing x) + 1) + +(deftest loop.10.42 + (loop for x in '(1000000000000) minimizing x) + 1000000000000) + +(deftest loop.10.43 + (loop for x in '(-1000000000000) minimize x) + -1000000000000) + +(deftest loop.10.44 + (loop for x in '(1.0 2.0 -1.0 3.0) minimize x) + -1.0) + +(deftest loop.10.45 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) minimize x fixnum) + 1) + +(deftest loop.10.46 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) minimize x of-type integer) + 1) + +(deftest loop.10.47 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) minimize x of-type rational) + 1) + +(deftest loop.10.48 + (loop for x in '(1 4 10 5 7 9) minimize x into foo finally (return foo)) + 1) + +(deftest loop.10.49 + (let (z) + (values + (loop for x in '(4 1 10 1 5 7 9) minimize x into foo finally (setq z foo)) + z)) + nil + 1) + +(deftest loop.10.50 + (loop for x in '(8 20 5 3 24 1 19 4 20 3) minimize x of-type real) + 1) + +(deftest loop.10.51 + (loop for x in '(0.08 0.40 0.05 0.03 0.44 0.01 0.19 0.04 0.40 0.03) minimize x of-type float) + 0.01) + +(deftest loop.10.52 + (loop for x in '(-1/8 -1/20 -1/5 -1/3 -1/24 -1/1 -1/19 -1/4 -1/20 -1/3) minimize x of-type rational) + -1/1) + +(deftest loop.10.53 + (loop for x in '(4 10 5 1 7 9) minimize x into foo fixnum finally (return foo)) + 1) + +(deftest loop.10.54 + (loop for x in '(1 4 10 5 7 9) minimize x into foo of-type integer finally (return foo)) + 1) + +(deftest loop.10.55 + (let ((foo 20)) + (values + (loop for x in '(4 5 8 3 7) minimize x into foo finally (return foo)) + foo)) + 3 20) + +(declaim (special *loop-min-var*)) + +(deftest loop.10.56 + (let ((*loop-min-var* 100)) + (values + (loop for x in '(10 4 8) minimize x into *loop-min-var* + finally (return *loop-min-var*)) + *loop-min-var*)) + 4 100) + +(deftest loop.10.57 + (classify-error + (loop with foo = 100 + for i from 1 to 10 minimize i into foo + finally (return foo))) + program-error) + +(deftest loop.10.58 + (classify-error + (loop with foo = 100 + for i from 1 to 10 minimizing i into foo + finally (return foo))) + program-error) + +(deftest loop.10.58a + (loop for x in '(1 2 3) minimize (return 10)) + 10) + +;;; Tests combining MINIMIZE, MAXIMIZE + +(deftest loop.10.59 + (loop for i from 1 to 10 + minimize i + maximize (- i)) + 1) + +(deftest loop.10.60 + (loop for i from 1 to 10 + maximize (- i) + minimize i) + -1) + +(deftest loop.10.61 + (loop for i from 5 downto 1 + maximize i + minimize (- i)) + -1) + + +;;; Tests for SUM, SUMMING + +(deftest loop.10.70 + (loop for i from 1 to 4 sum i) + 10) + +(deftest loop.10.71 + (loop for i from 1 to 4 summing i) + 10) + +(deftest loop.10.72 + (loop for i from 1 to 4 sum (float i)) + 10.0) + +(deftest loop.10.73 + (loop for i from 1 to 4 sum (complex i i)) + #c(10 10)) + +(deftest loop.10.74 + (loop for i from 1 to 4 sum i fixnum) + 10) + +(deftest loop.10.75 + (loop for i from 1 to 4 sum i of-type integer) + 10) + +(deftest loop.10.76 + (loop for i from 1 to 4 sum i of-type rational) + 10) + +(deftest loop.10.77 + (loop for i from 1 to 4 sum (float i) float) + 10.0) + +(deftest loop.10.78 + (loop for i from 1 to 4 sum i of-type number) + 10) + +(deftest loop.10.79 + (loop for i from 1 to 4 sum i into foo finally (return foo)) + 10) + +(deftest loop.10.80 + (loop for i from 1 to 4 sum i into foo fixnum finally (return foo)) + 10) + +(deftest loop.10.81 + (let (z) + (values + (loop for i from 1 to 4 sum i into foo of-type (integer 0 10) + finally (setq z foo)) + z)) + nil + 10) + +(deftest loop.10.82 + (loop for i from 1 to 4 + sum i fixnum + count t) + 14) + +(deftest loop.10.83 + (loop for i from 1 to 4 + sum i fixnum + count t fixnum) + 14) + +(deftest loop.10.84 + (let ((foo 100)) + (values + (loop for i from 1 to 4 sum i into foo of-type integer + finally (return foo)) + foo)) + 10 100) + +(deftest loop.10.85 + (classify-error + (loop with foo = 100 + for i from 1 to 4 sum i into foo + finally (return foo))) + program-error) + +(deftest loop.10.86 + (classify-error + (loop with foo = 100 + for i from 1 to 4 summing i into foo + finally (return foo))) + program-error) + +(deftest loop.10.87 + (loop for i from 1 to 4 + sum (complex i (1+ i)) of-type complex) + #c(10 14)) + +(deftest loop.10.88 + (loop for i from 1 to 4 + sum (/ i 17) of-type rational) + 10/17) + +(deftest loop.10.89 + (loop for i from 1 to 4 summing (/ i 17)) + 10/17) + +(deftest loop.10.90 + (loop for i from 1 to 4 + sum i into foo + sum (1+ i) into bar + finally (return (values foo bar))) + 10 14) + +(deftest loop.10.91 + (loop for i from 1 to 4 + sum i into foo fixnum + sum (float (1+ i)) into bar float + finally (return (values foo bar))) + 10 14.0) + +(deftest loop.10.92 + (loop for i from 1 to 4 sum (return 100)) + 100) + +(deftest loop.10.93 + (loop for i from 1 to 4 summing (return 100)) + 100) diff --git a/ansi-tests/loop11.lsp b/ansi-tests/loop11.lsp new file mode 100644 index 0000000..3ff8f31 --- /dev/null +++ b/ansi-tests/loop11.lsp @@ -0,0 +1,165 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 16 21:39:33 2002 +;;;; Contains: Tests for loop termination clauses REPEAT, WHILE and UNTIL + +(in-package :cl-test) + +;;; Tests of REPEAT + +(deftest loop.11.1 + (let ((z 0)) + (values + (loop repeat 10 do (incf z)) + z)) + nil + 10) + +(deftest loop.11.2 + (loop repeat 10 collect 'a) + (a a a a a a a a a a)) + +(deftest loop.11.3 + (let ((z 0)) + (loop repeat 0 do (incf z)) + z) + 0) + +(deftest loop.11.4 + (let ((z 0)) + (loop repeat -1 do (incf z)) + z) + 0) + +(deftest loop.11.5 + (let ((z 0)) + (loop repeat -1.5 do (incf z)) + z) + 0) + +(deftest loop.11.6 + (let ((z 0)) + (loop repeat -1000000000000 do (incf z)) + z) + 0) + +(deftest loop.11.7 + (let ((z 0)) + (loop repeat 10 do (incf z) (loop-finish)) + z) + 1) + +(deftest loop.11.8 + (loop repeat 3 for i in '(a b c d e) collect i) + (a b c)) + +(deftest loop.11.9 + (loop for i in '(a b c d e) collect i repeat 3) + (a b c)) + + +;;; Tests of WHILE + +(deftest loop.11.10 + (loop with i = 0 while (< i 10) collect (incf i)) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.11.11 + (loop with i = 0 while (if (< i 10) t (return 'good)) + collect (incf i)) + good) + +(deftest loop.11.12 + (loop with i = 0 + while (< i 10) collect (incf i) + while (< i 10) collect (incf i) + while (< i 10) collect (incf i)) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.11.13 + (loop with i = 0 while (< i 10) collect (incf i) + finally (return 'done)) + done) + +(deftest loop.11.14 + (loop for i in '(a b c) + while nil + collect i) + nil) + +(deftest loop.11.15 + (loop for i in '(a b c) + collect i + while nil) + (a)) + +(deftest loop.11.16 + (loop for i in '(a b c) + while t + collect i) + (a b c)) + +(deftest loop.11.17 + (loop for i in '(a b c) + collect i + while t) + (a b c)) + +(deftest loop.11.18 + (loop for i from 1 to 10 + while (< i 6) + finally (return i)) + 6) + +;;; Tests of UNTIL + +(deftest loop.11.20 + (loop with i = 0 until (>= i 10) collect (incf i)) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.11.21 + (loop with i = 0 while (if (< i 10) t (return 'good)) + collect (incf i)) + good) + +(deftest loop.11.22 + (loop with i = 0 + until (>= i 10) collect (incf i) + until (>= i 10) collect (incf i) + until (>= i 10) collect (incf i)) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.11.23 + (loop with i = 0 until (>= i 10) collect (incf i) + finally (return 'done)) + done) + +(deftest loop.11.24 + (loop for i in '(a b c) + until t + collect i) + nil) + +(deftest loop.11.25 + (loop for i in '(a b c) + collect i + until t) + (a)) + +(deftest loop.11.26 + (loop for i in '(a b c) + until nil + collect i) + (a b c)) + +(deftest loop.11.27 + (loop for i in '(a b c) + collect i + until nil) + (a b c)) + +(deftest loop.11.28 + (loop for i from 1 to 10 + until (>= i 6) + finally (return i)) + 6) diff --git a/ansi-tests/loop12.lsp b/ansi-tests/loop12.lsp new file mode 100644 index 0000000..edc3f61 --- /dev/null +++ b/ansi-tests/loop12.lsp @@ -0,0 +1,234 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Nov 17 08:47:43 2002 +;;;; Contains: Tests for ALWAYS, NEVER, THEREIS + +(in-package :cl-test) + +;;; Tests of ALWAYS clauses + +(deftest loop.12.1 + (loop for i in '(1 2 3 4) always (< i 10)) + t) + +(deftest loop.12.2 + (loop for i in nil always nil) + t) + +(deftest loop.12.3 + (loop for i in '(a) always nil) + nil) + +(deftest loop.12.4 + (loop for i in '(1 2 3 4 5 6 7) + always t + until (> i 5)) + t) + +(deftest loop.12.5 + (loop for i in '(1 2 3 4 5 6 7) + always (< i 6) + until (>= i 5)) + t) + +(deftest loop.12.6 + (loop for x in '(a b c d e) always x) + t) + +(deftest loop.12.7 + (loop for x in '(1 2 3 4 5 6) + always (< x 20) + never (> x 10)) + t) + +(deftest loop.12.8 + (loop for x in '(1 2 3 4 5 6) + always (< x 20) + never (> x 5)) + nil) + +(deftest loop.12.9 + (loop for x in '(1 2 3 4 5 6) + never (> x 5) + always (< x 20)) + nil) + +(deftest loop.12.10 + (loop for x in '(1 2 3 4 5) + always (< x 10) + finally (return 'good)) + good) + +(deftest loop.12.11 + (loop for x in '(1 2 3 4 5) + always (< x 3) + finally (return 'bad)) + nil) + +(deftest loop.12.12 + (loop for x in '(1 2 3 4 5 6) + always t + when (= x 4) do (loop-finish)) + t) + +(deftest loop.12.13 + (loop for x in '(1 2 3 4 5 6) + do (loop-finish) + always nil) + t) + +;;; Tests of NEVER + +(deftest loop.12.21 + (loop for i in '(1 2 3 4) never (> i 10)) + t) + +(deftest loop.12.22 + (loop for i in nil never t) + t) + +(deftest loop.12.23 + (loop for i in '(a) never t) + nil) + +(deftest loop.12.24 + (loop for i in '(1 2 3 4 5 6 7) + never nil + until (> i 5)) + t) + +(deftest loop.12.25 + (loop for i in '(1 2 3 4 5 6 7) + never (>= i 6) + until (>= i 5)) + t) + +(deftest loop.12.26 + (loop for x in '(a b c d e) never (not x)) + t) + +(deftest loop.12.30 + (loop for x in '(1 2 3 4 5) + never (>= x 10) + finally (return 'good)) + good) + +(deftest loop.12.31 + (loop for x in '(1 2 3 4 5) + never (>= x 3) + finally (return 'bad)) + nil) + +(deftest loop.12.32 + (loop for x in '(1 2 3 4 5 6) + never nil + when (= x 4) do (loop-finish)) + t) + +(deftest loop.12.33 + (loop for x in '(1 2 3 4 5 6) + do (loop-finish) + never t) + t) + +;;; Tests of THEREIS + +(deftest loop.12.41 + (loop for x in '(1 2 3 4 5) + thereis (and (eqlt x 3) 'good)) + good) + +(deftest loop.12.42 + (loop for x in '(nil nil a nil nil) + thereis x) + a) + +(deftest loop.12.43 + (loop for x in '(1 2 3 4 5) + thereis (eql x 4) + when (eql x 2) do (loop-finish)) + nil) + +;;; Error cases + +(deftest loop.12.error.50 + (classify-error + (loop for i from 1 to 10 + collect i + always (< i 20))) + program-error) + +(deftest loop.12.error.50a + (classify-error + (loop for i from 1 to 10 + always (< i 20) + collect i)) + program-error) + +(deftest loop.12.error.51 + (classify-error + (loop for i from 1 to 10 + collect i + never (> i 20))) + program-error) + +(deftest loop.12.error.51a + (classify-error + (loop for i from 1 to 10 + never (> i 20) + collect i)) + program-error) + +(deftest loop.12.error.52 + (classify-error + (loop for i from 1 to 10 + collect i + thereis (> i 20))) + program-error) + +(deftest loop.12.error.52a + (classify-error + (loop for i from 1 to 10 + thereis (> i 20) + collect i)) + program-error) + +;;; Non-error cases + +(deftest loop.12.53 + (loop for i from 1 to 10 + collect i into foo + always (< i 20)) + t) + +(deftest loop.12.53a + (loop for i from 1 to 10 + always (< i 20) + collect i into foo) + t) + +(deftest loop.12.54 + (loop for i from 1 to 10 + collect i into foo + never (> i 20)) + t) + +(deftest loop.12.54a + (loop for i from 1 to 10 + never (> i 20) + collect i into foo) + t) + +(deftest loop.12.55 + (loop for i from 1 to 10 + collect i into foo + thereis i) + 1) + +(deftest loop.12.55a + (loop for i from 1 to 10 + thereis i + collect i into foo) + 1) + + diff --git a/ansi-tests/loop13.lsp b/ansi-tests/loop13.lsp new file mode 100644 index 0000000..f8e65c2 --- /dev/null +++ b/ansi-tests/loop13.lsp @@ -0,0 +1,433 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Nov 17 12:37:45 2002 +;;;; Contains: Tests of DO, DOING, RETURN in LOOP. Tests of NAMED loops + +(in-package :cl-test) + +(deftest loop.13.1 + (loop do (return 10)) + 10) + +(deftest loop.13.2 + (loop doing (return 10)) + 10) + +(deftest loop.13.3 + (loop for i from 0 below 100 by 7 + when (> i 50) return i) + 56) + +(deftest loop.13.4 + (let ((x 0)) + (loop do + (incf x) + (when (= x 10) (return x)))) + 10) + +(deftest loop.13.5 + (loop return 'a) + a) + +(deftest loop.13.6 + (loop return (values))) + +(deftest loop.13.7 + (loop return (values 1 2)) + 1 2) + +(deftest loop.13.8 + (let* ((limit (min 1000 (1- multiple-values-limit))) + (vals (make-list limit :initial-element :a)) + (vals2 (multiple-value-list (eval `(loop return (values ,@vals)))))) + (equalt vals vals2)) + t) + +(deftest loop.13.9 + (loop named foo return 'a) + a) + +(deftest loop.13.10 + (block nil + (return (loop named foo return :good)) + :bad) + :good) + +(deftest loop.13.11 + (block nil + (loop named foo do (return :good)) + :bad) + :good) + +(deftest loop.13.12 + (loop named foo with a = (return-from foo :good) return :bad) + :good) + +(deftest loop.13.13 + (loop named foo + with b = 1 + and a = (return-from foo :good) return :bad) + :good) + +(deftest loop.13.14 + (loop named foo + for a = (return-from foo :good) return :bad) + :good) + +(deftest loop.13.15 + (loop named foo for a in (return-from foo :good)) + :good) + +(deftest loop.13.16 + (loop named foo for a from (return-from foo :good) return :bad) + :good) + +(deftest loop.13.17 + (loop named foo for a on (return-from foo :good) return :bad) + :good) + +(deftest loop.13.18 + (loop named foo for a across (return-from foo :good) return :bad) + :good) + +(deftest loop.13.19 + (loop named foo for a being the hash-keys of (return-from foo :good) + return :bad) + :good) + +(deftest loop.13.20 + (loop named foo for a being the symbols of (return-from foo :good) + return :bad) + :good) + +(deftest loop.13.21 + (loop named foo repeat (return-from foo :good) return :bad) + :good) + +(deftest loop.13.22 + (loop named foo for i from 0 to (return-from foo :good) return :bad) + :good) + +(deftest loop.13.23 + (loop named foo for i from 0 to 10 by (return-from foo :good) return :bad) + :good) + +(deftest loop.13.24 + (loop named foo for i from 10 downto (return-from foo :good) return :bad) + :good) + +(deftest loop.13.25 + (loop named foo for i from 10 above (return-from foo :good) return :bad) + :good) + +(deftest loop.13.26 + (loop named foo for i from 10 below (return-from foo :good) return :bad) + :good) + +(deftest loop.13.27 + (loop named foo for i in '(a b c) by (return-from foo :good) return :bad) + :good) + +(deftest loop.13.28 + (loop named foo for i on '(a b c) by (return-from foo :good) return :bad) + :good) + +(deftest loop.13.29 + (loop named foo for i = 1 then (return-from foo :good)) + :good) + +(deftest loop.13.30 + (loop named foo for x in '(a b c) collect (return-from foo :good)) + :good) + +(deftest loop.13.31 + (loop named foo for x in '(a b c) append (return-from foo :good)) + :good) + +(deftest loop.13.32 + (loop named foo for x in '(a b c) nconc (return-from foo :good)) + :good) + +(deftest loop.13.33 + (loop named foo for x in '(a b c) count (return-from foo :good)) + :good) + +(deftest loop.13.34 + (loop named foo for x in '(a b c) sum (return-from foo :good)) + :good) + +(deftest loop.13.35 + (loop named foo for x in '(a b c) maximize (return-from foo :good)) + :good) + +(deftest loop.13.36 + (loop named foo for x in '(a b c) minimize (return-from foo :good)) + :good) + +(deftest loop.13.37 + (loop named foo for x in '(a b c) thereis (return-from foo :good)) + :good) + +(deftest loop.13.38 + (loop named foo for x in '(a b c) always (return-from foo :good)) + :good) + +(deftest loop.13.39 + (loop named foo for x in '(a b c) never (return-from foo :good)) + :good) + +(deftest loop.13.40 + (loop named foo for x in '(a b c) until (return-from foo :good)) + :good) + +(deftest loop.13.41 + (loop named foo for x in '(a b c) while (return-from foo :good)) + :good) + +(deftest loop.13.42 + (loop named foo for x in '(a b c) when (return-from foo :good) return :bad) + :good) + +(deftest loop.13.43 + (loop named foo for x in '(a b c) unless (return-from foo :good) return :bad) + :good) + +(deftest loop.13.44 + (loop named foo for x in '(a b c) if (return-from foo :good) return :bad) + :good) + +(deftest loop.13.45 + (loop named foo for x in '(a b c) return (return-from foo :good)) + :good) + +(deftest loop.13.46 + (loop named foo initially (return-from foo :good) return :bad) + :good) + +(deftest loop.13.47 + (loop named foo do (loop-finish) finally (return-from foo :good)) + :good) + + +(deftest loop.13.52 + (block nil + (loop named foo with a = (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.53 + (block nil + (loop named foo + with b = 1 + and a = (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.54 + (block nil + (loop named foo + for a = (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.55 + (block nil + (loop named foo for a in (return :good)) + :bad) + :good) + +(deftest loop.13.56 + (block nil + (loop named foo for a from (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.57 + (block nil + (loop named foo for a on (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.58 + (block nil + (loop named foo for a across (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.59 + (block nil + (loop named foo for a being the hash-keys of (return :good) + return :bad) + :bad) + :good) + +(deftest loop.13.60 + (block nil + (loop named foo for a being the symbols of (return :good) + return :bad) + :bad) + :good) + +(deftest loop.13.61 + (block nil + (loop named foo repeat (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.62 + (block nil + (loop named foo for i from 0 to (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.63 + (block nil + (loop named foo for i from 0 to 10 by (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.64 + (block nil + (loop named foo for i from 10 downto (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.65 + (block nil + (loop named foo for i from 10 above (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.66 + (block nil + (loop named foo for i from 10 below (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.67 + (block nil + (loop named foo for i in '(a b c) by (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.68 + (block nil + (loop named foo for i on '(a b c) by (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.69 + (block nil + (loop named foo for i = 1 then (return :good)) + :bad) + :good) + +(deftest loop.13.70 + (block nil + (loop named foo for x in '(a b c) collect (return :good)) + :bad) + :good) + +(deftest loop.13.71 + (block nil + (loop named foo for x in '(a b c) append (return :good)) + :bad) + :good) + +(deftest loop.13.72 + (block nil + (loop named foo for x in '(a b c) nconc (return :good)) + :bad) + :good) + +(deftest loop.13.73 + (block nil + (loop named foo for x in '(a b c) count (return :good)) + :bad) + :good) + +(deftest loop.13.74 + (block nil + (loop named foo for x in '(a b c) sum (return :good)) + :bad) + :good) + +(deftest loop.13.75 + (block nil + (loop named foo for x in '(a b c) maximize (return :good)) + :bad) + :good) + +(deftest loop.13.76 + (block nil + (loop named foo for x in '(a b c) minimize (return :good)) + :bad) + :good) + +(deftest loop.13.77 + (block nil + (loop named foo for x in '(a b c) thereis (return :good)) + :bad) + :good) + +(deftest loop.13.78 + (block nil + (loop named foo for x in '(a b c) always (return :good)) + :bad) + :good) + +(deftest loop.13.79 + (block nil + (loop named foo for x in '(a b c) never (return :good)) + :bad) + :good) + +(deftest loop.13.80 + (block nil + (loop named foo for x in '(a b c) until (return :good)) + :bad) + :good) + +(deftest loop.13.81 + (block nil + (loop named foo for x in '(a b c) while (return :good)) + :bad) + :good) + +(deftest loop.13.82 + (block nil + (loop named foo for x in '(a b c) when (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.83 + (block nil + (loop named foo for x in '(a b c) unless (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.84 + (block nil + (loop named foo for x in '(a b c) if (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.85 + (block nil + (loop named foo for x in '(a b c) return (return :good)) + :bad) + :good) + +(deftest loop.13.86 + (block nil + (loop named foo initially (return :good) return :bad) + :bad) + :good) + +(deftest loop.13.87 + (block nil + (loop named foo do (loop-finish) finally (return :good)) + :bad) + :good) + + diff --git a/ansi-tests/loop14.lsp b/ansi-tests/loop14.lsp new file mode 100644 index 0000000..f22fa3c --- /dev/null +++ b/ansi-tests/loop14.lsp @@ -0,0 +1,333 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Nov 20 06:33:21 2002 +;;;; Contains: Tests of LOOP conditional execution clauses + +(in-package :cl-test) + +(deftest loop.14.1 + (loop for x from 1 to 6 + when (evenp x) + collect x) + (2 4 6)) + +(deftest loop.14.2 + (loop for x from 1 to 6 + unless (evenp x) + collect x) + (1 3 5)) + +(deftest loop.14.3 + (loop for x from 1 to 10 + when (evenp x) + collect x into foo + and count t into bar + finally (return (values foo bar))) + (2 4 6 8 10) + 5) + +(deftest loop.14.4 + (loop for x from 1 to 10 + when (evenp x) collect x end) + (2 4 6 8 10)) + +(deftest loop.14.5 + (loop for x from 1 to 10 + when (evenp x) collect x into evens + else collect x into odds + end + finally (return (values evens odds))) + (2 4 6 8 10) + (1 3 5 7 9)) + +(deftest loop.14.6 + (loop for x from 1 to 10 + unless (oddp x) + collect x into foo + and count t into bar + finally (return (values foo bar))) + (2 4 6 8 10) + 5) + +(deftest loop.14.7 + (loop for x from 1 to 10 + unless (oddp x) collect x end) + (2 4 6 8 10)) + +(deftest loop.14.8 + (loop for x from 1 to 10 + unless (oddp x) collect x into evens + else collect x into odds + end + finally (return (values evens odds))) + (2 4 6 8 10) + (1 3 5 7 9)) + +(deftest loop.14.9 + (loop for x from 1 to 6 + if (evenp x) + collect x) + (2 4 6)) + +(deftest loop.14.10 + (loop for x from 1 to 10 + if (evenp x) + collect x into foo + and count t into bar + finally (return (values foo bar))) + (2 4 6 8 10) + 5) + +(deftest loop.14.11 + (loop for x from 1 to 10 + if (evenp x) collect x end) + (2 4 6 8 10)) + +(deftest loop.14.12 + (loop for x from 1 to 10 + if (evenp x) collect x into evens + else collect x into odds + end + finally (return (values evens odds))) + (2 4 6 8 10) + (1 3 5 7 9)) + +;;; Test that else associates with the nearest conditional unclosed +;;; by end + +(deftest loop.14.13 + (loop for i from 1 to 20 + if (evenp i) + if (= (mod i 3) 0) + collect i into list1 + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (2 4 8 10 14 16 20)) + +(deftest loop.14.14 + (loop for i from 1 to 20 + when (evenp i) + if (= (mod i 3) 0) + collect i into list1 + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (2 4 8 10 14 16 20)) + +(deftest loop.14.15 + (loop for i from 1 to 20 + if (evenp i) + when (= (mod i 3) 0) + collect i into list1 + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (2 4 8 10 14 16 20)) + +(deftest loop.14.16 + (loop for i from 1 to 20 + if (evenp i) + if (= (mod i 3) 0) + collect i into list1 + end + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (1 3 5 7 9 11 13 15 17 19)) + +(deftest loop.14.17 + (loop for i from 1 to 20 + when (evenp i) + if (= (mod i 3) 0) + collect i into list1 + end + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (1 3 5 7 9 11 13 15 17 19)) + +(deftest loop.14.18 + (loop for i from 1 to 20 + if (evenp i) + when (= (mod i 3) 0) + collect i into list1 + end + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (1 3 5 7 9 11 13 15 17 19)) + +(deftest loop.14.19 + (loop for i from 1 to 20 + when (evenp i) + when (= (mod i 3) 0) + collect i into list1 + end + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (1 3 5 7 9 11 13 15 17 19)) + +(deftest loop.14.20 + (loop for i from 1 to 20 + unless (oddp i) + if (= (mod i 3) 0) + collect i into list1 + end + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (1 3 5 7 9 11 13 15 17 19)) + +(deftest loop.14.21 + (loop for i from 1 to 20 + if (evenp i) + unless (/= (mod i 3) 0) + collect i into list1 + end + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (1 3 5 7 9 11 13 15 17 19)) + +(deftest loop.14.22 + (loop for i from 1 to 20 + unless (oddp i) + unless (/= (mod i 3) 0) + collect i into list1 + end + else collect i into list2 + finally (return (values list1 list2))) + (6 12 18) + (1 3 5 7 9 11 13 15 17 19)) + +;;; More tests conditionals + +(deftest loop.14.23 + (loop for i from 1 to 20 + if (evenp i) + collect i into list1 + else if (= (mod i 3) 0) + collect i into list2 + else collect i into list3 + finally (return (values list1 list2 list3))) + (2 4 6 8 10 12 14 16 18 20) + (3 9 15) + (1 5 7 11 13 17 19)) + +;;; Tests of 'IT' + +(deftest loop.14.24 + (loop for x in '((a) nil (b) (c) (nil) (d)) + when (car x) collect it) + (a b c d)) + +(deftest loop.14.25 + (loop for x in '((a) nil (b) (c) (nil) (d)) + if (car x) collect it) + (a b c d)) + +(deftest loop.14.26 + (loop for x in '(nil (a) nil (b) (c) (nil) (d)) + when (car x) return it) + a) + +(deftest loop.14.27 + (loop for x in '(nil (a) nil (b) (c) (nil) (d)) + if (car x) return it) + a) + +(deftest loop.14.28 + (loop for x in '((a) nil (b) (c) (nil) (d)) + when (car x) collect it and collect 'foo) + (a foo b foo c foo d foo)) + +(deftest loop.14.29 + (let ((it 'z)) + (loop for x in '(a b c d) + when x collect it and collect it)) + (a z b z c z d z)) + +(deftest loop.14.30 + (let ((it 'z)) + (loop for x in '(a b c d) + if x collect it end + collect it)) + (a z b z c z d z)) + +(deftest loop.14.31 + (loop for it on '(a b c d) + when (car it) collect it) + (a b c d)) + +(deftest loop.14.32 + (loop for x in '(a b nil c d nil e) + when x collecting it) + (a b c d e)) + +(deftest loop.14.33 + (loop for x in '(a b nil c d nil e) + when x append (list x)) + (a b c d e)) + +(deftest loop.14.34 + (loop for x in '(a b nil c d nil e) + when x appending (list x)) + (a b c d e)) + +(deftest loop.14.35 + (loop for x in '(a b nil c d nil e) + when x nconc (list x)) + (a b c d e)) + +(deftest loop.14.36 + (loop for x in '(a b nil c d nil e) + when x nconcing (list x)) + (a b c d e)) + +(deftest loop.14.37 + (loop for it on '(a b c d) + when (car it) collect it into foo + finally (return foo)) + (a b c d)) + +(deftest loop.14.38 + (loop for x in '(1 2 nil 3 4 nil 5 nil) + when x count it) + 5) + +(deftest loop.14.39 + (loop for x in '(1 2 nil 3 4 nil 5 nil) + when x counting it) + 5) + +(deftest loop.14.40 + (loop for x in '(1 2 nil 3 4 nil 6 nil) + when x maximize it) + 6) + +(deftest loop.14.41 + (loop for x in '(1 2 nil 3 4 nil 6 nil) + when x maximizing it) + 6) + +(deftest loop.14.42 + (loop for x in '(1 2 nil 3 4 nil 6 nil) + when x minimize it) + 1) + +(deftest loop.14.43 + (loop for x in '(1 2 nil 3 4 nil 6 nil) + when x minimizing it) + 1) + +(deftest loop.14.44 + (loop for x in '(1 2 nil 3 4 nil 6 nil) + when x sum it) + 16) + +(deftest loop.14.45 + (loop for x in '(1 2 nil 3 4 nil 6 nil) + when x summing it) + 16) diff --git a/ansi-tests/loop15.lsp b/ansi-tests/loop15.lsp new file mode 100644 index 0000000..e7d2cb3 --- /dev/null +++ b/ansi-tests/loop15.lsp @@ -0,0 +1,249 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Nov 21 07:08:21 2002 +;;;; Contains: Tests that keywords can be loop keywords + +(in-package :cl-test) + +;;; Tests of loop keywords + +(deftest loop.15.30 + (loop :for i :from 1 :to 10 :collect i) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.15.31 + (loop :for i :upfrom 1 :below 10 :by 2 :collect i) + (1 3 5 7 9)) + +(deftest loop.15.32 + (loop :with x = 1 :and y = 2 :return (values x y)) + 1 2) + +(deftest loop.15.33 + (loop :named foo :doing (return-from foo 1)) + 1) + +(deftest loop.15.34 + (let ((x 0)) + (loop + :initially (setq x 2) + :until t + :finally (return x))) + 2) + +(deftest loop.15.35 + (loop :for x :in '(a b c) :collecting x) + (a b c)) + +(deftest loop.15.36 + (loop :for x :in '(a b c) :append (list x)) + (a b c)) + +(deftest loop.15.37 + (loop :for x :in '(a b c) :appending (list x)) + (a b c)) + +(deftest loop.15.38 + (loop :for x :in '(a b c) :nconc (list x)) + (a b c)) + +(deftest loop.15.39 + (loop :for x :in '(a b c) :nconcing (list x)) + (a b c)) + +(deftest loop.15.40 + (loop :for x :in '(1 2 3) :count x) + 3) + +(deftest loop.15.41 + (loop :for x :in '(1 2 3) :counting x) + 3) + +(deftest loop.15.42 + (loop :for x :in '(1 2 3) :sum x) + 6) + +(deftest loop.15.43 + (loop :for x :in '(1 2 3) :summing x) + 6) + +(deftest loop.15.44 + (loop :for x :in '(10 20 30) :maximize x) + 30) + +(deftest loop.15.45 + (loop :for x :in '(10 20 30) :maximizing x) + 30) + +(deftest loop.15.46 + (loop :for x :in '(10 20 30) :minimize x) + 10) + +(deftest loop.15.47 + (loop :for x :in '(10 20 30) :minimizing x) + 10) + +(deftest loop.15.48 + (loop :for x :in '(1 2 3 4) :sum x :into foo :of-type fixnum + :finally (return foo)) + 10) + +(deftest loop.15.49 + (loop :for x :upfrom 1 :to 10 + :if (evenp x) :sum x :into foo + :else :sum x :into bar + :end + :finally (return (values foo bar))) + 30 25) + +(deftest loop.15.50 + (loop :for x :downfrom 10 :above 0 + :when (evenp x) :sum x :into foo + :else :sum x :into bar + :end + :finally (return (values foo bar))) + 30 25) + +(deftest loop.15.51 + (loop :for x :in '(a b nil c d nil) + :unless x :count t) + 2) + +(deftest loop.15.52 + (loop :for x :in '(a b nil c d nil) + :unless x :collect x :into bar :and :count t :into foo + :end + finally (return (values bar foo))) + (nil nil) + 2) + +(deftest loop.15.53 + (loop :for x :in '(nil nil a b nil c nil) + :collect x + :until x) + (nil nil a)) + +(deftest loop.15.54 + (loop :for x :in '(a b nil c nil) + :while x :collect x) + (a b)) + +(deftest loop.15.55 + (loop :for x :in '(nil nil a b nil c nil) + :thereis x) + a) + +(deftest loop.15.56 + (loop :for x :in '(nil nil a b nil c nil) + :never x) + nil) + +(deftest loop.15.57 + (loop :for x :in '(a b c d e) + :always x) + t) + +(deftest loop.15.58 + (loop :as x :in '(a b c) :count t) + 3) + +(deftest loop.15.59 + (loop :for i :from 10 :downto 5 :collect i) + (10 9 8 7 6 5)) + +(deftest loop.15.60 + (loop :for i :from 0 :upto 5 :collect i) + (0 1 2 3 4 5)) + +(deftest loop.15.61 + (loop :for x :on '(a b c) :collecting (car x)) + (a b c)) + +(deftest loop.15.62 + (loop :for x = '(a b c) :then (cdr x) + :while x + :collect (car x)) + (a b c)) + +(deftest loop.15.63 + (loop :for x :across #(a b c) :collect x) + (a b c)) + +(deftest loop.15.64 + (loop :for x :being :the :hash-keys :of (make-hash-table) + :count t) + 0) + +(deftest loop.15.65 + (loop :for x :being :each :hash-key :in (make-hash-table) + :count t) + 0) + +(deftest loop.15.66 + (loop :for x :being :each :hash-value :of (make-hash-table) + :count t) + 0) + +(deftest loop.15.67 + (loop :for x :being :the :hash-values :in (make-hash-table) + :count t) + 0) + +(deftest loop.15.68 + (loop :for x :being :the :hash-values :in (make-hash-table) + :using (:hash-key k) + :count t) + 0) + +(deftest loop.15.69 + (loop :for x :being :the :hash-keys :in (make-hash-table) + :using (:hash-value v) + :count t) + 0) + +(deftest loop.15.70 + (progn + (ignore-errors (delete-package "LOOP.15.PACKAGE")) + (let ((p (make-package "LOOP.15.PACKAGE" :use nil))) + (loop :for x :being :the :symbols :of p :count t))) + 0) + +(deftest loop.15.71 + (progn + (ignore-errors (delete-package "LOOP.15.PACKAGE")) + (let ((p (make-package "LOOP.15.PACKAGE" :use nil))) + (loop :for x :being :each :symbol :of p :count t))) + 0) + +(deftest loop.15.72 + (progn + (ignore-errors (delete-package "LOOP.15.PACKAGE")) + (let ((p (make-package "LOOP.15.PACKAGE" :use nil))) + (loop :for x :being :the :external-symbols :of p :count t))) + 0) + +(deftest loop.15.73 + (progn + (ignore-errors (delete-package "LOOP.15.PACKAGE")) + (let ((p (make-package "LOOP.15.PACKAGE" :use nil))) + (loop :for x :being :each :external-symbol :of p :count t))) + 0) + +(deftest loop.15.74 + (progn + (ignore-errors (delete-package "LOOP.15.PACKAGE")) + (let ((p (make-package "LOOP.15.PACKAGE" :use nil))) + (loop :for x :being :the :present-symbols :of p :count t))) + 0) + +(deftest loop.15.75 + (progn + (ignore-errors (delete-package "LOOP.15.PACKAGE")) + (let ((p (make-package "LOOP.15.PACKAGE" :use nil))) + (loop :for x :being :each :present-symbol :of p :count t))) + 0) + + + + + diff --git a/ansi-tests/loop16.lsp b/ansi-tests/loop16.lsp new file mode 100644 index 0000000..205ef95 --- /dev/null +++ b/ansi-tests/loop16.lsp @@ -0,0 +1,243 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Nov 21 09:46:27 2002 +;;;; Contains: Tests that uninterned symbols can be loop keywords + +(in-package :cl-test) + + +(deftest loop.16.30 + (loop #:for i #:from 1 #:to 10 #:collect i) + (1 2 3 4 5 6 7 8 9 10)) + +(deftest loop.16.31 + (loop #:for i #:upfrom 1 #:below 10 #:by 2 #:collect i) + (1 3 5 7 9)) + +(deftest loop.16.32 + (loop #:with x = 1 #:and y = 2 #:return (values x y)) + 1 2) + +(deftest loop.16.33 + (loop #:named foo #:doing (return-from foo 1)) + 1) + +(deftest loop.16.34 + (let ((x 0)) + (loop + #:initially (setq x 2) + #:until t + #:finally (return x))) + 2) + +(deftest loop.16.35 + (loop #:for x #:in '(a b c) #:collecting x) + (a b c)) + +(deftest loop.16.36 + (loop #:for x #:in '(a b c) #:append (list x)) + (a b c)) + +(deftest loop.16.37 + (loop #:for x #:in '(a b c) #:appending (list x)) + (a b c)) + +(deftest loop.16.38 + (loop #:for x #:in '(a b c) #:nconc (list x)) + (a b c)) + +(deftest loop.16.39 + (loop #:for x #:in '(a b c) #:nconcing (list x)) + (a b c)) + +(deftest loop.16.40 + (loop #:for x #:in '(1 2 3) #:count x) + 3) + +(deftest loop.16.41 + (loop #:for x #:in '(1 2 3) #:counting x) + 3) + +(deftest loop.16.42 + (loop #:for x #:in '(1 2 3) #:sum x) + 6) + +(deftest loop.16.43 + (loop #:for x #:in '(1 2 3) #:summing x) + 6) + +(deftest loop.16.44 + (loop #:for x #:in '(10 20 30) #:maximize x) + 30) + +(deftest loop.16.45 + (loop #:for x #:in '(10 20 30) #:maximizing x) + 30) + +(deftest loop.16.46 + (loop #:for x #:in '(10 20 30) #:minimize x) + 10) + +(deftest loop.16.47 + (loop #:for x #:in '(10 20 30) #:minimizing x) + 10) + +(deftest loop.16.48 + (loop #:for x #:in '(1 2 3 4) #:sum x #:into foo #:of-type fixnum + #:finally (return foo)) + 10) + +(deftest loop.16.49 + (loop #:for x #:upfrom 1 #:to 10 + #:if (evenp x) #:sum x #:into foo + #:else #:sum x #:into bar + #:end + #:finally (return (values foo bar))) + 30 25) + +(deftest loop.16.50 + (loop #:for x #:downfrom 10 #:above 0 + #:when (evenp x) #:sum x #:into foo + #:else #:sum x #:into bar + #:end + #:finally (return (values foo bar))) + 30 25) + +(deftest loop.16.51 + (loop #:for x #:in '(a b nil c d nil) + #:unless x #:count t) + 2) + +(deftest loop.16.52 + (loop #:for x #:in '(a b nil c d nil) + #:unless x #:collect x #:into bar #:and #:count t #:into foo + #:end + finally (return (values bar foo))) + (nil nil) + 2) + +(deftest loop.16.53 + (loop #:for x #:in '(nil nil a b nil c nil) + #:collect x + #:until x) + (nil nil a)) + +(deftest loop.16.54 + (loop #:for x #:in '(a b nil c nil) + #:while x #:collect x) + (a b)) + +(deftest loop.16.55 + (loop #:for x #:in '(nil nil a b nil c nil) + #:thereis x) + a) + +(deftest loop.16.56 + (loop #:for x #:in '(nil nil a b nil c nil) + #:never x) + nil) + +(deftest loop.16.57 + (loop #:for x #:in '(a b c d e) + #:always x) + t) + +(deftest loop.16.58 + (loop #:as x #:in '(a b c) #:count t) + 3) + +(deftest loop.16.59 + (loop #:for i #:from 10 #:downto 5 #:collect i) + (10 9 8 7 6 5)) + +(deftest loop.16.60 + (loop #:for i #:from 0 #:upto 5 #:collect i) + (0 1 2 3 4 5)) + +(deftest loop.16.61 + (loop #:for x #:on '(a b c) #:collecting (car x)) + (a b c)) + +(deftest loop.16.62 + (loop #:for x = '(a b c) #:then (cdr x) + #:while x + #:collect (car x)) + (a b c)) + +(deftest loop.16.63 + (loop #:for x #:across #(a b c) #:collect x) + (a b c)) + +(deftest loop.16.64 + (loop #:for x #:being #:the #:hash-keys #:of (make-hash-table) + #:count t) + 0) + +(deftest loop.16.65 + (loop #:for x #:being #:each #:hash-key #:in (make-hash-table) + #:count t) + 0) + +(deftest loop.16.66 + (loop #:for x #:being #:each #:hash-value #:of (make-hash-table) + #:count t) + 0) + +(deftest loop.16.67 + (loop #:for x #:being #:the #:hash-values #:in (make-hash-table) + #:count t) + 0) + +(deftest loop.16.68 + (loop #:for x #:being #:the #:hash-values #:in (make-hash-table) + #:using (#:hash-key k) + #:count t) + 0) + +(deftest loop.16.69 + (loop #:for x #:being #:the #:hash-keys #:in (make-hash-table) + #:using (#:hash-value v) + #:count t) + 0) + +(deftest loop.16.70 + (progn + (ignore-errors (delete-package "LOOP.16.PACKAGE")) + (let ((p (make-package "LOOP.16.PACKAGE" :use nil))) + (loop #:for x #:being #:the #:symbols #:of p #:count t))) + 0) + +(deftest loop.16.71 + (progn + (ignore-errors (delete-package "LOOP.16.PACKAGE")) + (let ((p (make-package "LOOP.16.PACKAGE" :use nil))) + (loop #:for x #:being #:each #:symbol #:of p #:count t))) + 0) + +(deftest loop.16.72 + (progn + (ignore-errors (delete-package "LOOP.16.PACKAGE")) + (let ((p (make-package "LOOP.16.PACKAGE" :use nil))) + (loop #:for x #:being #:the #:external-symbols #:of p #:count t))) + 0) + +(deftest loop.16.73 + (progn + (ignore-errors (delete-package "LOOP.16.PACKAGE")) + (let ((p (make-package "LOOP.16.PACKAGE" :use nil))) + (loop #:for x #:being #:each #:external-symbol #:of p #:count t))) + 0) + +(deftest loop.16.74 + (progn + (ignore-errors (delete-package "LOOP.16.PACKAGE")) + (let ((p (make-package "LOOP.16.PACKAGE" :use nil))) + (loop #:for x #:being #:the #:present-symbols #:of p #:count t))) + 0) + +(deftest loop.16.75 + (progn + (ignore-errors (delete-package "LOOP.16.PACKAGE")) + (let ((p (make-package "LOOP.16.PACKAGE" :use nil))) + (loop #:for x #:being #:each #:present-symbol #:of p #:count t))) + 0) diff --git a/ansi-tests/loop17.lsp b/ansi-tests/loop17.lsp new file mode 100644 index 0000000..2297099 --- /dev/null +++ b/ansi-tests/loop17.lsp @@ -0,0 +1,133 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Nov 21 09:48:38 2002 +;;;; Contains: Miscellaneous loop tests + +(in-package :cl-test) + +;;; Initially and finally take multiple forms, +;;; and execute them in the right order +(deftest loop.17.1 + (loop + with x = 0 + initially (incf x 1) (incf x (+ x x)) + initially (incf x (+ x x x)) + until t + finally (incf x 100) (incf x (+ x x)) + finally (return x)) + 336) + +(deftest loop.17.2 + (loop + with x = 0 + until t + initially (incf x 1) (incf x (+ x x)) + finally (incf x 100) (incf x (+ x x)) + initially (incf x (+ x x x)) + finally (return x)) + 336) + +(deftest loop.17.3 + (let ((x 0)) + (loop + with y = (incf x 1) + initially (incf x 2) + until t + finally (return (values x y)))) + 3 1) + +(deftest loop.17.4 + (loop + doing (return 'a) + finally (return 'b)) + a) + +(deftest loop.17.5 + (loop + return 'a + finally (return 'b)) + a) + +(deftest loop.17.6 + (let ((x 0)) + (tagbody + (loop + do (go done) + finally (incf x)) + done) + x) + 0) + +(deftest loop.17.7 + (let ((x 0)) + (catch 'done + (loop + do (throw 'done nil) + finally (incf x))) + x) + 0) + +(deftest loop.17.8 + (loop + for x in '(1 2 3) + collect x + finally (return 'good)) + good) + +(deftest loop.17.9 + (loop + for x in '(1 2 3) + append (list x) + finally (return 'good)) + good) + +(deftest loop.17.10 + (loop + for x in '(1 2 3) + nconc (list x) + finally (return 'good)) + good) + +(deftest loop.17.11 + (loop + for x in '(1 2 3) + count (> x 1) + finally (return 'good)) + good) + +(deftest loop.17.12 + (loop + for x in '(1 2 3) + sum x + finally (return 'good)) + good) + +(deftest loop.17.13 + (loop + for x in '(1 2 3) + maximize x + finally (return 'good)) + good) + +(deftest loop.17.14 + (loop + for x in '(1 2 3) + minimize x + finally (return 'good)) + good) + +;;; iteration clause grouping + +(deftest loop.17.20 + (loop + for i from 1 to 5 + for j = 0 then (+ j i) + collect j) + (0 2 5 9 14)) + +(deftest loop.17.21 + (loop + for i from 1 to 5 + and j = 0 then (+ j i) + collect j) + (0 1 3 6 10)) diff --git a/ansi-tests/loop2.lsp b/ansi-tests/loop2.lsp new file mode 100644 index 0000000..f93c566 --- /dev/null +++ b/ansi-tests/loop2.lsp @@ -0,0 +1,139 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 26 13:45:45 2002 +;;;; Contains: Tests of the FOR-AS-IN-LIST loop iteration control form, +;;;; and of destructuring in loop forms + +(in-package :cl-test) + +(deftest loop.2.1 + (loop for x in '(1 2 3) sum x) + 6) + +(deftest loop.2.2 + (loop for x in '(1 2 3 4) + do (when (evenp x) (return x))) + 2) + +(deftest loop.2.3 + (classify-error (loop for x in '(a . b) collect x)) + type-error) + +(deftest loop.2.4 + (let ((x nil)) + (loop for e in '(a b c d) do (push e x)) + x) + (d c b a)) + +(deftest loop.2.5 + (loop for e in '(a b c d e f) by #'cddr + collect e) + (a c e)) + +(deftest loop.2.6 + (loop for e in '(a b c d e f g) by #'cddr + collect e) + (a c e g)) + +(deftest loop.2.7 + (loop for e in '(a b c d e f) + by #'(lambda (l) (and (cdr l) (cons (car l) (cddr l)))) + collect e) + (a a a a a a)) + +(deftest loop.2.8 + (loop for (x . y) in '((a . b) (c . d) (e . f)) + collect (list x y)) + ((a b) (c d) (e f))) + +(deftest loop.2.9 + (loop for (x nil y) in '((a b c) (d e f) (g h i)) + collect (list x y)) + ((a c) (d f) (g i))) + +(deftest loop.2.10 + (loop for (x y) of-type fixnum in '((1 2) (3 4) (5 6)) + collect (+ x y)) + (3 7 11)) + +(deftest loop.2.11 + (loop for (x y) of-type fixnum in '((1 2) (3 4) (5 6)) + collect (+ x y)) + (3 7 11)) + +(deftest loop.2.12 + (loop for (x y) of-type (fixnum fixnum) in '((1 2) (3 4) (5 6)) + collect (+ x y)) + (3 7 11)) + + +(deftest loop.2.13 + (loop for (x . y) of-type (fixnum . fixnum) in '((1 . 2) (3 . 4) (5 . 6)) + collect (+ x y)) + (3 7 11)) + +(deftest loop.2.14 + (classify-error + (loop for x in '(a b c) + for x in '(d e f) collect x)) + program-error) + +(deftest loop.2.15 + (classify-error + (loop for (x . x) in '((a b) (c d)) collect x)) + program-error) + +(deftest loop.2.16 + (loop for nil in nil do (return t)) + nil) + +(deftest loop.2.17 + (let ((x '(a b c))) + (values + x + (loop for x in '(d e f) collect (list x)) + x)) + (a b c) + ((d) (e) (f)) + (a b c)) + +(deftest loop.2.18 + (loop for x of-type (integer 0 10) in '(2 4 6 7) sum x) + 19) + +;;; Tests of the 'AS' form + +(deftest loop.2.19 + (loop as x in '(1 2 3) sum x) + 6) + +(deftest loop.2.20 + (loop as x in '(a b c) + as y in '(1 2 3) + collect (list x y)) + ((a 1) (b 2) (c 3))) + +(deftest loop.2.21 + (loop as x in '(a b c) + for y in '(1 2 3) + collect (list x y)) + ((a 1) (b 2) (c 3))) + +(deftest loop.2.22 + (loop for x in '(a b c) + as y in '(1 2 3) + collect (list x y)) + ((a 1) (b 2) (c 3))) + +(deftest loop.2.23 + (let (a b (i 0)) + (values + (loop for e in (progn (setf a (incf i)) + '(a b c d e f g)) + by (progn (setf b (incf i)) #'cddr) + collect e) + a b i)) + (a c e g) + 1 2 2) + + diff --git a/ansi-tests/loop3.lsp b/ansi-tests/loop3.lsp new file mode 100644 index 0000000..44ccd03 --- /dev/null +++ b/ansi-tests/loop3.lsp @@ -0,0 +1,136 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Oct 27 08:36:36 2002 +;;;; Contains: Tests of FOR-ON-AS-LIST iteration control in LOOP + +(in-package :cl-test) + +(deftest loop.3.1 + (loop for x on '(1 2 3) sum (car x)) + 6) + +(deftest loop.3.2 + (loop for x on '(1 2 3 4) + do (when (evenp (car x)) (return x))) + (2 3 4)) + + +(deftest loop.3.3 + (loop for x on '(a b c . d) collect (car x)) + (a b c)) + +(deftest loop.3.4 + (let ((x nil)) + (loop for e on '(a b c d) do (push (car e) x)) + x) + (d c b a)) + +(deftest loop.3.5 + (loop for e on '(a b c d e f) by #'cddr + collect (car e)) + (a c e)) + +(deftest loop.3.6 + (loop for e on '(a b c d e f g) by #'cddr + collect (car e)) + (a c e g)) + +(deftest loop.3.7 + (loop for e on '(a b c d e f) + by #'(lambda (l) (and (cdr l) (cons (car l) (cddr l)))) + collect (car e)) + (a a a a a a)) + +(deftest loop.3.8 + (loop for ((x . y)) on '((a . b) (c . d) (e . f)) + collect (list x y)) + ((a b) (c d) (e f))) + +(deftest loop.3.9 + (loop for ((x nil y)) on '((a b c) (d e f) (g h i)) + collect (list x y)) + ((a c) (d f) (g i))) + +(deftest loop.3.10 + (loop for ((x y)) of-type (fixnum) on '((1 2) (3 4) (5 6)) + collect (+ x y)) + (3 7 11)) + +(deftest loop.3.11 + (loop for ((x y)) of-type (fixnum) on '((1 2) (3 4) (5 6)) + collect (+ x y)) + (3 7 11)) + +(deftest loop.3.12 + (loop for ((x y)) of-type ((fixnum fixnum)) on '((1 2) (3 4) (5 6)) + collect (+ x y)) + (3 7 11)) + +(deftest loop.3.13 + (loop for ((x . y)) of-type ((fixnum . fixnum)) on '((1 . 2) (3 . 4) (5 . 6)) + collect (+ x y)) + (3 7 11)) + +(deftest loop.3.14 + (classify-error + (loop for x on '(a b c) + for x on '(d e f) collect x)) + program-error) + +(deftest loop.3.15 + (classify-error + (loop for (x . x) on '((a b) (c d)) collect x)) + program-error) + +(deftest loop.3.16 + (loop for nil on nil do (return t)) + nil) + +(deftest loop.3.17 + (let ((x '(a b c))) + (values + x + (loop for x on '(d e f) collect x) + x)) + (a b c) + ((d e f) (e f) (f)) + (a b c)) + +(deftest loop.3.18 + (loop for (x) of-type ((integer 0 10)) on '(2 4 6 7) sum x) + 19) + +;;; Tests of the 'AS' form + +(deftest loop.3.19 + (loop as x on '(1 2 3) sum (car x)) + 6) + +(deftest loop.3.20 + (loop as x on '(a b c) + as y on '(1 2 3) + collect (list (car x) (car y))) + ((a 1) (b 2) (c 3))) + +(deftest loop.3.21 + (loop as x on '(a b c) + for y on '(1 2 3) + collect (list (car x) (car y))) + ((a 1) (b 2) (c 3))) + +(deftest loop.3.22 + (loop for x on '(a b c) + as y on '(1 2 3) + collect (list (car x) (car y))) + ((a 1) (b 2) (c 3))) + +(deftest loop.3.23 + (let (a b (i 0)) + (values + (loop for e on (progn (setf a (incf i)) + '(a b c d e f g)) + by (progn (setf b (incf i)) #'cddr) + collect (car e)) + a b i)) + (a c e g) + 1 2 2) diff --git a/ansi-tests/loop4.lsp b/ansi-tests/loop4.lsp new file mode 100644 index 0000000..bd0f7e1 --- /dev/null +++ b/ansi-tests/loop4.lsp @@ -0,0 +1,57 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Oct 27 22:46:39 2002 +;;;; Contains: Tests for LOOP FOR-AS-EQUAL-THEN + +(in-package :cl-test) + +(deftest loop.4.1 + (loop + for x = 1 then (1+ x) + until (> x 5) + collect x) + (1 2 3 4 5)) + +(deftest loop.4.2 + (loop + for i from 1 to 10 + for j = (1+ i) collect j) + (2 3 4 5 6 7 8 9 10 11)) + +(deftest loop.4.3 + (loop + for i from 1 to 10 + for j of-type integer = (1+ i) collect j) + (2 3 4 5 6 7 8 9 10 11)) + +(deftest loop.4.4 + (loop for e on '(a b c d e) + for (x . y) = e + collect x) + (a b c d e)) + +(deftest loop.4.5 + (loop for (x . y) = '(a b c d e) then y + while x + collect x) + (a b c d e)) + +;;; Error cases + +(deftest loop.4.6 + (classify-error + (loop for (x . x) = '(nil nil nil) + until x count t)) + program-error) + +(deftest loop.4.7 + (classify-error* + (macroexpand '(loop for (x . x) = '(nil nil nil) + until x count t))) + program-error) + +(deftest loop.4.8 + (classify-error* + (macroexpand '(loop for x = '(nil nil nil) + for x = 1 count x until t))) + program-error) diff --git a/ansi-tests/loop5.lsp b/ansi-tests/loop5.lsp new file mode 100644 index 0000000..d5f2a8c --- /dev/null +++ b/ansi-tests/loop5.lsp @@ -0,0 +1,172 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 2 13:52:50 2002 +;;;; Contains: Tests of LOOP clause FOR-AS-ACROSS + +(in-package :cl-test) + +(deftest loop.5.1 + (let ((x "abcd")) (loop for e across x collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.2 + (let ((x "abcd")) (loop for e across (the string x) collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.3 + (let ((x "abcd")) (loop for e across (the simple-string x) collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.4 + (loop for e across "abcd" collect e) + (#\a #\b #\c #\d)) + +(deftest loop.5.5 + (loop for e across "abcd" + for i from 1 to 3 collect e) + (#\a #\b #\c)) + +(deftest loop.5.6 + (loop for e of-type base-char across "abcd" + for i from 1 to 3 collect e) + (#\a #\b #\c)) + +(deftest loop.5.7 + (let ((x "abcd")) (loop for e across (the base-string x) collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.8 + (let ((x "abcd")) (loop for e of-type character across x collect e)) + (#\a #\b #\c #\d)) + + +(deftest loop.5.10 + (let ((x #*00010110)) + (loop for e across x collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.11 + (let ((x #*00010110)) + (loop for e across (the bit-vector x) collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.12 + (let ((x #*00010110)) + (loop for e across (the simple-bit-vector x) collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.13 + (let ((x #*00010110)) + (loop for e of-type bit across (the simple-bit-vector x) collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.14 + (let ((x #*00010110)) + (loop for e of-type bit across x + for i from 1 to 4 collect e)) + (0 0 0 1)) + + +(deftest loop.5.20 + (let ((x (vector 'a 'b 'c 'd))) + (loop for e across x collect e)) + (a b c d)) + +(deftest loop.5.21 + (let ((x (vector 'a 'b 'c 'd))) + (loop for e across (the vector x) collect e)) + (a b c d)) + +(deftest loop.5.22 + (let ((x (vector 'a 'b 'c 'd))) + (loop for e across (the simple-vector x) collect e)) + (a b c d)) + +(deftest loop.5.23 + (let ((x (vector '(a) '(b) '(c) '(d)))) + (loop for (e) across x collect e)) + (a b c d)) + + +(deftest loop.5.30 + (let ((x (make-array '(5) :initial-contents '(a b c d e) + :adjustable t))) + (loop for e across x collect e)) + (a b c d e)) + +(deftest loop.5.32 + (let* ((x (make-array '(5) :initial-contents '(a b c d e))) + (y (make-array '(3) :displaced-to x + :displaced-index-offset 1))) + (loop for e across y collect e)) + (b c d)) + +;;; tests of 'as' form + +(deftest loop.5.33 + (loop as e across "abc" collect e) + (#\a #\b #\c)) + +(deftest loop.5.34 + (loop as e of-type character across "abc" collect e) + (#\a #\b #\c)) + +(deftest loop.5.35 + (loop as e of-type integer across (the simple-vector (coerce '(1 2 3) 'simple-vector)) + sum e) + 6) + +;;; Loop across displaced vectors + +(deftest loop.5.36 + (let* ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))) + (da (make-array '(5) :displaced-to a + :displaced-index-offset 2))) + (loop for e across da collect e)) + (c d e f g)) + +(deftest loop.5.37 + (let* ((a (make-array '(10) :element-type 'base-char + :initial-contents "abcdefghij")) + (da (make-array '(5) :element-type 'base-char + :displaced-to a + :displaced-index-offset 2))) + (loop for e across da collect e)) + (#\c #\d #\e #\f #\g)) + +(deftest loop.5.38 + (let* ((a (make-array '(10) :element-type 'bit + :initial-contents '(0 1 1 0 0 1 0 1 1 1))) + (da (make-array '(5) :element-type 'bit + :displaced-to a + :displaced-index-offset 2))) + (loop for e across da collect e)) + (1 0 0 1 0)) + + +;;; Error cases + +(deftest loop.5.error.1 + (classify-error + (loop for (e . e) across (vector '(x . y) '(u . v)) collect e)) + program-error) + +(deftest loop.5.error.2 + (classify-error + (loop for e across (vector '(x . y) '(u . v)) + for e from 1 to 5 collect e)) + program-error) + +(deftest loop.5.error.3 + (classify-error* + (macroexpand + '(loop for (e . e) across (vector '(x . y) '(u . v)) collect e))) + program-error) + +(deftest loop.5.error.4 + (classify-error* + (macroexpand + '(loop for e across (vector '(x . y) '(u . v)) + for e from 1 to 5 collect e))) + program-error) + diff --git a/ansi-tests/loop6.lsp b/ansi-tests/loop6.lsp new file mode 100644 index 0000000..3dc4123 --- /dev/null +++ b/ansi-tests/loop6.lsp @@ -0,0 +1,294 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Nov 10 21:13:04 2002 +;;;; Contains: Tests for LOOP-AS-HASH forms + +(in-package :cl-test) + +(defparameter *loop.6.alist* + '((a . 1) (b . 2) (c . 3))) + +(defparameter *loop.6.alist.2* + '(("a" . 1) ("b" . 2) ("c" . 3))) + +(defparameter *loop.6.alist.3* + '(((a1 . a2) . 1) ((b1 . b2) . 2) ((c1 . c2) . 3))) + +(defparameter *loop.6.hash.1* + (let ((table (make-hash-table :test #'eq))) + (loop for (key . val) in *loop.6.alist* + do (setf (gethash key table) val)) + table)) + +(defparameter *loop.6.hash.2* + (let ((table (make-hash-table :test #'eql))) + (loop for (key . val) in *loop.6.alist* + do (setf (gethash key table) val)) + table)) + +(defparameter *loop.6.hash.3* + (let ((table (make-hash-table :test #'equal))) + (loop for (key . val) in *loop.6.alist.3* + do (setf (gethash key table) val)) + table)) + +;;; (defparameter *loop.6.hash.4* +;;; (let ((table (make-hash-table :test #'equalp))) +;;; (loop for (key . val) in *loop.6.alist.2* +;;; do (setf (gethash key table) val)) +;;; table)) + +(defparameter *loop.6.hash.5* + (let ((table (make-hash-table :test #'eql))) + (loop for (val . key) in *loop.6.alist.3* + do (setf (gethash key table) val)) + table)) + +(defparameter *loop.6.hash.6* + (let ((table (make-hash-table :test #'eq))) + (loop for (key . val) in *loop.6.alist* + do (setf (gethash key table) (coerce val 'float))) + table)) + +(defparameter *loop.6.hash.7* + (let ((table (make-hash-table :test #'equal))) + (loop for (val . key) in *loop.6.alist.3* + do (setf (gethash (coerce key 'float) table) val)) + table)) + +(defparameter *loop.6.alist.8* + '(((1 . 2) . 1) ((3 . 4) . b) ((5 . 6) . c))) + +(defparameter *loop.6.hash.8* + (let ((table (make-hash-table :test #'equal))) + (loop for (key . val) in *loop.6.alist.8* + do (setf (gethash key table) val)) + table)) + +(defparameter *loop.6.hash.9* + (let ((table (make-hash-table :test #'equal))) + (loop for (val . key) in *loop.6.alist.8* + do (setf (gethash key table) val)) + table)) + +;;; being {each | the} {hash-value | hash-values | hash-key | hash-keys} {in | of } + +(deftest loop.6.1 + (loop for x being the hash-value of *loop.6.hash.1* sum x) + 6) + +(deftest loop.6.2 + (loop for x being the hash-values of *loop.6.hash.1* sum x) + 6) + +(deftest loop.6.3 + (loop for x being each hash-value of *loop.6.hash.1* sum x) + 6) + +(deftest loop.6.4 + (loop for x being each hash-values of *loop.6.hash.1* sum x) + 6) + +(deftest loop.6.5 + (loop for x being the hash-values in *loop.6.hash.1* sum x) + 6) + +(deftest loop.6.6 + (sort (loop for x being the hash-key of *loop.6.hash.1* collect x) + #'symbol<) + (a b c)) + +(deftest loop.6.7 + (sort (loop for x being the hash-keys of *loop.6.hash.1* collect x) + #'symbol<) + (a b c)) + +(deftest loop.6.8 + (sort (loop for x being each hash-key of *loop.6.hash.1* collect x) + #'symbol<) + (a b c)) + +(deftest loop.6.9 + (sort (loop for x being each hash-keys of *loop.6.hash.1* collect x) + #'symbol<) + (a b c)) + +(deftest loop.6.10 + (sort (loop for x being each hash-keys in *loop.6.hash.1* collect x) + #'symbol<) + (a b c)) + +(deftest loop.6.11 + (sort (loop for (u . v) being the hash-keys of *loop.6.hash.3* collect u) + #'symbol<) + (a1 b1 c1)) + +(deftest loop.6.12 + (sort (loop for (u . v) being the hash-keys of *loop.6.hash.3* collect v) + #'symbol<) + (a2 b2 c2)) + +(deftest loop.6.13 + (sort (loop for (u . v) being the hash-values of *loop.6.hash.5* collect u) + #'symbol<) + (a1 b1 c1)) + +(deftest loop.6.14 + (sort (loop for (u . v) being the hash-values of *loop.6.hash.5* collect v) + #'symbol<) + (a2 b2 c2)) + +(deftest loop.6.15 + (sort (loop for k being the hash-keys of *loop.6.hash.1* using (hash-value v) + collect (list k v)) + #'< :key #'second) + ((a 1) (b 2) (c 3))) + +(deftest loop.6.16 + (sort (loop for v being the hash-values of *loop.6.hash.1* using (hash-key k) + collect (list k v)) + #'< :key #'second) + ((a 1) (b 2) (c 3))) + +(deftest loop.6.17 + (sort (loop for (u . nil) being the hash-values of *loop.6.hash.5* collect u) + #'symbol<) + (a1 b1 c1)) + +(deftest loop.6.18 + (sort (loop for (nil . v) being the hash-values of *loop.6.hash.5* collect v) + #'symbol<) + (a2 b2 c2)) + +(deftest loop.6.19 + (loop for nil being the hash-values of *loop.6.hash.5* count t) + 3) + +(deftest loop.6.20 + (loop for nil being the hash-keys of *loop.6.hash.5* count t) + 3) + +(deftest loop.6.21 + (loop for v being the hash-values of *loop.6.hash.5* using (hash-key nil) count t) + 3) + +(deftest loop.6.22 + (loop for k being the hash-keys of *loop.6.hash.5* using (hash-value nil) count t) + 3) + +(deftest loop.6.23 + (loop for v fixnum being the hash-values of *loop.6.hash.1* sum v) + 6) + +(deftest loop.6.24 + (loop for v of-type fixnum being the hash-values of *loop.6.hash.1* sum v) + 6) + +(deftest loop.6.25 + (loop for k fixnum being the hash-keys of *loop.6.hash.5* sum k) + 6) + +(deftest loop.6.26 + (loop for k of-type fixnum being the hash-keys of *loop.6.hash.5* sum k) + 6) + +(deftest loop.6.27 + (loop for k t being the hash-keys of *loop.6.hash.5* sum k) + 6) + +(deftest loop.6.28 + (loop for k of-type t being the hash-keys of *loop.6.hash.5* sum k) + 6) + +(deftest loop.6.29 + (loop for v t being the hash-values of *loop.6.hash.1* sum v) + 6) + +(deftest loop.6.30 + (loop for v of-type t being the hash-values of *loop.6.hash.1* sum v) + 6) + +(deftest loop.6.31 + (loop for v float being the hash-values of *loop.6.hash.6* sum v) + 6.0) + +(deftest loop.6.32 + (loop for v of-type float being the hash-values of *loop.6.hash.6* sum v) + 6.0) + +(deftest loop.6.33 + (loop for k float being the hash-keys of *loop.6.hash.7* sum k) + 6.0) + +(deftest loop.6.34 + (loop for k of-type float being the hash-keys of *loop.6.hash.7* sum k) + 6.0) + +(deftest loop.6.35 + (loop for (k1 . k2) of-type (integer . integer) being the hash-keys + of *loop.6.hash.8* sum (+ k1 k2)) + 21) + +(deftest loop.6.36 + (loop for (v1 . v2) of-type (integer . integer) being the hash-values + of *loop.6.hash.9* sum (+ v1 v2)) + 21) + +(deftest loop.6.37 + (loop for v being the hash-values of *loop.6.hash.8* + using (hash-key (k1 . k2)) sum (+ k1 k2)) + 21) + +(deftest loop.6.38 + (loop for k being the hash-keys of *loop.6.hash.9* + using (hash-value (v1 . v2)) sum (+ v1 v2)) + 21) + +(deftest loop.6.39 + (loop as x being the hash-value of *loop.6.hash.1* sum x) + 6) + +(deftest loop.6.40 + (sort (loop as x being the hash-key of *loop.6.hash.1* collect x) + #'symbol<) + (a b c)) + +;;; Error tests + +(deftest loop.6.error.1 + (classify-error + (loop for k from 1 to 10 + for k being the hash-keys of *loop.6.hash.1* + count t)) + program-error) + +(deftest loop.6.error.2 + (classify-error + (loop for k being the hash-keys of *loop.6.hash.1* + for k from 1 to 10 + count t)) + program-error) + +(deftest loop.6.error.3 + (classify-error + (loop for (k . k) being the hash-keys of *loop.6.hash.3* + count t)) + program-error) + +(deftest loop.6.error.4 + (classify-error + (loop for k being the hash-keys of *loop.6.hash.3* + using (hash-value k) + count t)) + program-error) + +(deftest loop.6.error.5 + (classify-error + (loop for k being the hash-values of *loop.6.hash.3* + using (hash-key k) + count t)) + program-error) + + + + diff --git a/ansi-tests/loop7.lsp b/ansi-tests/loop7.lsp new file mode 100644 index 0000000..d6594eb --- /dev/null +++ b/ansi-tests/loop7.lsp @@ -0,0 +1,206 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Nov 11 21:40:05 2002 +;;;; Contains: Tests for FOR-AS-PACKAGE clause for LOOP + +(in-package :cl-test) + +(defpackage "LOOP.CL-TEST.1" + (:use) + (:intern "FOO" "BAR" "BAZ") + (:export "A" "B" "C")) + +(defpackage "LOOP.CL-TEST.2" + (:use "LOOP.CL-TEST.1") + (:intern "X" "Y" "Z")) + +(deftest loop.7.1 + (sort (mapcar #'symbol-name + (loop for x being the symbols of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.2 + (sort (mapcar #'symbol-name + (loop for x being each symbol of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.3 + (sort (mapcar #'symbol-name + (loop for x being the symbol of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.4 + (sort (mapcar #'symbol-name + (loop for x being each symbols of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.5 + (sort (mapcar #'symbol-name + (loop for x being the symbols in "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.6 + (sort (mapcar #'symbol-name + (loop for x being each symbol in "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.7 + (sort (mapcar #'symbol-name + (loop for x being the symbol in "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.8 + (sort (mapcar #'symbol-name + (loop for x being each symbols in "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.9 + (sort (mapcar #'symbol-name + (loop for x being the external-symbols of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "C")) + +(deftest loop.7.10 + (sort (mapcar #'symbol-name + (loop for x being each external-symbol in "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "C")) + +(deftest loop.7.11 + (sort (mapcar #'symbol-name + (loop for x being each external-symbol in (find-package "LOOP.CL-TEST.1") collect x)) + #'string<) + ("A" "B" "C")) + +(deftest loop.7.12 + (sort (mapcar #'symbol-name + (loop for x being each external-symbol in :LOOP.CL-TEST.1 collect x)) + #'string<) + ("A" "B" "C")) + +(deftest loop.7.13 + (sort (mapcar #'symbol-name + (loop for x being the symbols of "LOOP.CL-TEST.2" collect x)) + #'string<) + ("A" "B" "C" "X" "Y" "Z")) + +(deftest loop.7.14 + (sort (mapcar #'symbol-name + (loop for x being the present-symbols of "LOOP.CL-TEST.2" collect x)) + #'string<) + ("X" "Y" "Z")) + +;;; According to the ANSI CL spec, "If the package for the iteration is not supplied, +;;; the current package is used." Thse next tests are of the cases that the package +;;; is not supplied in the loop form. + +(deftest loop.7.15 + (let ((*package* (find-package "LOOP.CL-TEST.1"))) + (sort (mapcar #'symbol-name (loop for x being each symbol collect x)) + #'string<)) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.16 + (let ((*package* (find-package "LOOP.CL-TEST.1"))) + (sort (mapcar #'symbol-name (loop for x being each external-symbol collect x)) + #'string<)) + ("A" "B" "C")) + +(deftest loop.7.17 + (let ((*package* (find-package "LOOP.CL-TEST.2"))) + (sort (mapcar #'symbol-name (loop for x being each present-symbol collect x)) + #'string<)) + ("X" "Y" "Z")) + +;;; Cases where the package doesn't exist. According to the standard, +;;; (section 6.1.2.1.7), this should cause a pacakge-error. + +(deftest loop.7.18 + (progn + (ignore-errors (delete-package "LOOP.MISSING.PACKAGE")) + (classify-error + (loop for x being each symbol of "LOOP.MISSING.PACKAGE" collect x))) + package-error) + +(deftest loop.7.19 + (progn + (ignore-errors (delete-package "LOOP.MISSING.PACKAGE")) + (classify-error + (loop for x being each present-symbol of "LOOP.MISSING.PACKAGE" collect x))) + package-error) + +(deftest loop.7.20 + (progn + (ignore-errors (delete-package "LOOP.MISSING.PACKAGE")) + (classify-error + (loop for x being each external-symbol of "LOOP.MISSING.PACKAGE" collect x))) + package-error) + +;;; NIL d-var-specs + +(deftest loop.7.21 + (loop for nil being the symbols of "LOOP.CL-TEST.1" count t) + 6) + +(deftest loop.7.22 + (loop for nil being the external-symbols of "LOOP.CL-TEST.1" count t) + 3) + +(deftest loop.7.23 + (loop for nil being the present-symbols of "LOOP.CL-TEST.2" count t) + 3) + +;;; Type specs + +(deftest loop.7.24 + (loop for x t being the symbols of "LOOP.CL-TEST.1" count x) + 6) + +(deftest loop.7.25 + (loop for x t being the external-symbols of "LOOP.CL-TEST.1" count x) + 3) + +(deftest loop.7.26 + (loop for x t being the present-symbols of "LOOP.CL-TEST.2" count x) + 3) + +(deftest loop.7.27 + (loop for x of-type symbol being the symbols of "LOOP.CL-TEST.1" count x) + 6) + +(deftest loop.7.28 + (loop for x of-type symbol being the external-symbols of "LOOP.CL-TEST.1" count x) + 3) + +(deftest loop.7.29 + (loop for x of-type symbol being the present-symbols of "LOOP.CL-TEST.2" count x) + 3) + +;;; Tests of the 'as' form + +(deftest loop.7.30 + (sort (mapcar #'symbol-name + (loop as x being the symbols of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.31 + (sort (mapcar #'symbol-name + (loop as x being each symbol of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.32 + (sort (mapcar #'symbol-name + (loop as x being the symbol of "LOOP.CL-TEST.1" collect x)) + #'string<) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + diff --git a/ansi-tests/loop8.lsp b/ansi-tests/loop8.lsp new file mode 100644 index 0000000..5866429 --- /dev/null +++ b/ansi-tests/loop8.lsp @@ -0,0 +1,141 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Nov 12 06:30:14 2002 +;;;; Contains: Tests of LOOP local variable initialization + +(in-package :cl-test) + +(deftest loop.8.1 + (loop with x = 1 do (return x)) + 1) + +(deftest loop.8.2 + (loop with x = 1 + with y = (1+ x) do (return (list x y))) + (1 2)) + +(deftest loop.8.3 + (let ((y 2)) + (loop with x = y + with y = (1+ x) do (return (list x y)))) + (2 3)) + +(deftest loop.8.4 + (let (a b) + (loop with a = 1 + and b = (list a) + and c = (list b) + return (list a b c))) + (1 (nil) (nil))) + + +;;; type specs + +(deftest loop.8.5 + (loop with a t = 1 return a) + 1) + +(deftest loop.8.6 + (loop with a fixnum = 2 return a) + 2) + +(deftest loop.8.7 + (loop with a float = 3.0 return a) + 3.0) + +(deftest loop.8.8 + (loop with a of-type string = "abc" return a) + "abc") + +(deftest loop.8.9 + (loop with (a b) = '(1 2) return (list b a)) + (2 1)) + +(deftest loop.8.10 + (loop with (a b) of-type (fixnum fixnum) = '(3 4) return (+ a b)) + 7) + +(deftest loop.8.11 + (loop with a of-type fixnum return a) + 0) + +(deftest loop.8.12 + (loop with a of-type float return a) + 0.0) + +(deftest loop.8.13 + (loop with a of-type t return a) + nil) + +(deftest loop.8.14 + (loop with a t return a) + nil) + +(deftest loop.8.15 + (loop with a t and b t return (list a b)) + (nil nil)) + +(deftest loop.8.16 + (loop with (a b c) of-type (fixnum float t) return (list a b c)) + (0 0.0 nil)) + +(deftest loop.8.17 + (loop with nil = nil return nil) + nil) + +;;; The NIL block of a loop encloses the entire loop. + +(deftest loop.8.18 + (loop with nil = (return t) return nil) + t) + +(deftest loop.8.19 + (loop with (nil a) = '(1 2) return a) + 2) + +(deftest loop.8.20 + (loop with (a nil) = '(1 2) return a) + 1) + +(deftest loop.8.21 + (loop with b = 3 + and (a nil) = '(1 2) return (list a b)) + (1 3)) + +(deftest loop.8.22 + (loop with b = 3 + and (nil a) = '(1 2) return (list a b)) + (2 3)) + +;;; The NIL block of a loop encloses the entire loop. + +(deftest loop.8.23 + (loop + with a = 1 + and b = (return 2) + return 3) + 2) + +;;; Error cases + +;;; The spec says (in section 6.1.1.7) that: +;;; "An error of type program-error is signaled (at macro expansion time) +;;; if the same variable is bound twice in any variable-binding clause +;;; of a single loop expression. Such variables include local variables, +;;; iteration control variables, and variables found by destructuring." +;;; +;;; This is somewhat ambiguous. Test loop.8.error.1 binds A twice in +;;; the same clause, but loop.8.error.2 binds A in two different clauses. +;;; I am interpreting the spec as ruling out the latter as well. + +(deftest loop.8.error.1 + (classify-error + (loop with a = 1 + and a = 2 return a)) + program-error) + +(deftest loop.8.error.2 + (classify-error + (loop with a = 1 + with a = 2 return a)) + program-error) diff --git a/ansi-tests/loop9.lsp b/ansi-tests/loop9.lsp new file mode 100644 index 0000000..fbf9478 --- /dev/null +++ b/ansi-tests/loop9.lsp @@ -0,0 +1,222 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Nov 14 06:25:21 2002 +;;;; Contains: Tests for loop list accumulation clauses + +(in-package :cl-test) + +;;; Tests of COLLECT, COLLECTING + +(deftest loop.9.1 + (loop for x in '(2 3 4) collect (1+ x)) + (3 4 5)) + +(deftest loop.9.2 + (loop for x in '(2 3 4) collecting (1+ x)) + (3 4 5)) + +(deftest loop.9.3 + (loop for x in '(0 1 2) + when (eql x 2) do (return 'good) + collect x) + good) + +(deftest loop.9.4 + (loop for x in '(a b c) + collect (list x) into foo + finally (return (reverse foo))) + ((c) (b) (a))) + +(deftest loop.9.5 + (loop for x in '(a b c) + collecting (list x) into foo + finally (return (reverse foo))) + ((c) (b) (a))) + +(deftest loop.9.6 + (loop for x from 1 to 10 + when (evenp x) collect x into foo + when (oddp x) collect x into bar + finally (return (list foo bar))) + ((2 4 6 8 10) (1 3 5 7 9))) + +(deftest loop.9.7 + (loop for x from 1 to 10 + collect (if (> x 5) (loop-finish) x)) + (1 2 3 4 5)) + +(deftest loop.9.8 + (loop for x from 1 to 20 + when (eql (mod x 5) 0) collect x into foo + when (eql (mod x 5) 2) collect x into foo + finally (return foo)) + (2 5 7 10 12 15 17 20)) + +(deftest loop.9.9 + (loop for x from 1 to 20 + when (eql (mod x 5) 0) collecting x into foo + when (eql (mod x 5) 2) collecting x into foo + finally (return foo)) + (2 5 7 10 12 15 17 20)) + +(deftest loop.9.10 + (classify-error + (loop with foo = '(a b) + for x in '(c d) collect x into foo + finally (return foo))) + program-error) + +(deftest loop.9.11 + (classify-error + (loop with foo = '(a b) + for x in '(c d) collecting x into foo + finally (return foo))) + program-error) + +(deftest loop.9.12 + (let ((foo '(a b))) + (values + (loop for x in '(c d e) collect x into foo finally (return foo)) + foo)) + (c d e) + (a b)) + +;;; Tests of APPEND, APPENDING + +(deftest loop.9.20 + (loop for x in '((a b) (c d) (e f g) () (i)) append x) + (a b c d e f g i)) + +(deftest loop.9.21 + (loop for x in '((a b) (c d) (e f g) () (i)) appending x) + (a b c d e f g i)) + +(deftest loop.9.22 + (loop for x in '((a) (b) (c . whatever)) append x) + (a b c . whatever)) + +(deftest loop.9.23 + (loop for x in '((a) (b) (c . whatever)) appending x) + (a b c . whatever)) + +(deftest loop.9.24 + (loop for x in '(a b c d) + append (list x) + when (eq x 'b) append '(1 2 3) + when (eq x 'd) appending '(4 5 6)) + (a b 1 2 3 c d 4 5 6)) + +(deftest loop.9.25 + (let (z) + (values + (loop for x in '((a) (b) (c) (d)) + append x into foo + finally (setq z foo)) + z)) + nil + (a b c d)) + +(deftest loop.9.26 + (loop for x in '((a) (b) (c) (d)) + for i from 1 + append x into foo + append x into foo + appending (list i) into foo + finally (return foo)) + (a a 1 b b 2 c c 3 d d 4)) + +(deftest loop.9.27 + (classify-error + (loop with foo = '(a b) + for x in '(c d) append (list x) into foo + finally (return foo))) + program-error) + +(deftest loop.9.28 + (classify-error + (loop with foo = '(a b) + for x in '(c d) appending (list x) into foo + finally (return foo))) + program-error) + + +;;; NCONC, NCONCING + +(deftest loop.9.30 + (loop for x in '((a b) (c d) (e f g) () (i)) nconc (copy-seq x)) + (a b c d e f g i)) + +(deftest loop.9.31 + (loop for x in '((a b) (c d) (e f g) () (i)) nconcing (copy-seq x)) + (a b c d e f g i)) + +(deftest loop.9.32 + (loop for x in '((a) (b) (c . whatever)) nconc (cons (car x) (cdr x))) + (a b c . whatever)) + +(deftest loop.9.33 + (loop for x in '((a) (b) (c . whatever)) nconcing (cons (car x) (cdr x))) + (a b c . whatever)) + +(deftest loop.9.34 + (loop for x in '(a b c d) + nconc (list x) + when (eq x 'b) nconc (copy-seq '(1 2 3)) + when (eq x 'd) nconcing (copy-seq '(4 5 6))) + (a b 1 2 3 c d 4 5 6)) + +(deftest loop.9.35 + (let (z) + (values + (loop for x in '((a) (b) (c) (d)) + nconc (copy-seq x) into foo + finally (setq z foo)) + z)) + nil + (a b c d)) + +(deftest loop.9.36 + (loop for x in '((a) (b) (c) (d)) + for i from 1 + nconc (copy-seq x) into foo + nconc (copy-seq x) into foo + nconcing (list i) into foo + finally (return foo)) + (a a 1 b b 2 c c 3 d d 4)) + +(deftest loop.9.37 + (classify-error + (loop with foo = '(a b) + for x in '(c d) nconc (list x) into foo + finally (return foo))) + program-error) + +(deftest loop.9.38 + (classify-error + (loop with foo = '(a b) + for x in '(c d) nconcing (list x) into foo + finally (return foo))) + program-error) + +;;; Combinations + +(deftest loop.9.40 + (loop for x in '(1 2 3 4 5 6 7) + if (< x 2) append (list x) + else if (< x 5) nconc (list (1+ x)) + else collect (+ x 2)) + (1 3 4 5 7 8 9)) + +(deftest loop.9.41 + (loop for x in '(1 2 3 4 5 6 7) + if (< x 2) append (list x) into foo + else if (< x 5) nconc (list (1+ x)) into foo + else collect (+ x 2) into foo + finally (return foo)) + (1 3 4 5 7 8 9)) + +;;; More nconc tests + +(deftest loop.9.42 + (loop for x in '(a b c d e) nconc (cons x 'foo)) + (a b c d e . foo)) diff --git a/ansi-tests/macrolet.lsp b/ansi-tests/macrolet.lsp new file mode 100644 index 0000000..1b92b7e --- /dev/null +++ b/ansi-tests/macrolet.lsp @@ -0,0 +1,160 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Oct 9 19:41:24 2002 +;;;; Contains: Tests of MACROLET + +(in-package :cl-test) + +(deftest macrolet.1 + (let ((z (list 3 4))) + (macrolet ((%m (x) `(car ,x))) + (let ((y (list 1 2))) + (values (%m y) (%m z))))) + 1 3) + +(deftest macrolet.2 + (let ((z (list 3 4))) + (macrolet ((%m (x) `(car ,x))) + (let ((y (list 1 2))) + (values + (setf (%m y) 6) + (setf (%m z) 'a) + y z)))) + 6 a (6 2) (a 4)) + + +;;; Inner definitions shadow outer ones +(deftest macrolet.3 + (macrolet ((%m (w) `(cadr ,w))) + (let ((z (list 3 4))) + (macrolet ((%m (x) `(car ,x))) + (let ((y (list 1 2))) + (values + (%m y) (%m z) + (setf (%m y) 6) + (setf (%m z) 'a) + y z))))) + 1 3 6 a (6 2) (a 4)) + +;;; &whole parameter +(deftest macrolet.4 + (let ((x nil)) + (macrolet ((%m (&whole w arg) + `(progn (setq x (quote ,w)) + ,arg))) + (values (%m 1) x))) + 1 (%m 1)) + +;;; &whole parameter (nested, destructuring; see section 3.4.4) +(deftest macrolet.5 + (let ((x nil)) + (macrolet ((%m ((&whole w arg)) + `(progn (setq x (quote ,w)) + ,arg))) + (values (%m (1)) x))) + 1 (1)) + +;;; key parameter +(deftest macrolet.6 + (let ((x nil)) + (macrolet ((%m (&key (a 'xxx) b) + `(setq x (quote ,a)))) + + (values (%m :a foo) x + (%m :b bar) x))) + foo foo xxx xxx) + +;;; nested key parameters +(deftest macrolet.7 + (let ((x nil)) + (macrolet ((%m ((&key a b)) + `(setq x (quote ,a)))) + + (values (%m (:a foo)) x + (%m (:b bar)) x))) + foo foo nil nil) + +;;; nested key parameters +(deftest macrolet.8 + (let ((x nil)) + (macrolet ((%m ((&key (a 10) b)) + `(setq x (quote ,a)))) + + (values (%m (:a foo)) x + (%m (:b bar)) x))) + foo foo 10 10) + +;;; keyword parameter with supplied-p parameter +(deftest macrolet.9 + (let ((x nil)) + (macrolet ((%m (&key (a 'xxx a-p) b) + `(setq x (quote ,(list a (not (not a-p))))))) + + (values (%m :a foo) x + (%m :b bar) x))) + (foo t) (foo t) (xxx nil) (xxx nil)) + + +;;; rest parameter +(deftest macrolet.10 + (let ((x nil)) + (macrolet ((%m (b &rest a) + `(setq x (quote ,a)))) + (values (%m a1 a2) x))) + (a2) (a2)) + +;;; rest parameter w. destructuring +(deftest macrolet.11 + (let ((x nil)) + (macrolet ((%m ((b &rest a)) + `(setq x (quote ,a)))) + (values (%m (a1 a2)) x))) + (a2) (a2)) + +;;; rest parameter w. whole +(deftest macrolet.12 + (let ((x nil)) + (macrolet ((%m (&whole w b &rest a) + `(setq x (quote ,(list a w))))) + (values (%m a1 a2) x))) + ((a2) (%m a1 a2)) + ((a2) (%m a1 a2))) + +;;; Interaction with symbol-macrolet + +(deftest macrolet.13 + (symbol-macrolet ((a b)) + (macrolet ((foo (x &environment env) + (let ((y (macroexpand x env))) + (if (eq y 'a) 1 2)))) + (foo a))) + 2) + +(deftest macrolet.14 + (symbol-macrolet ((a b)) + (macrolet ((foo (x &environment env) + (let ((y (macroexpand-1 x env))) + (if (eq y 'a) 1 2)))) + (foo a))) + 2) + +(deftest macrolet.15 + (macrolet ((nil () ''a)) + (nil)) + a) + +(deftest macrolet.16 + (loop for s in *cl-non-function-macro-special-operator-symbols* + for form = `(classify-error (macrolet ((,s () ''a)) (,s))) + unless (eq (eval form) 'a) + collect s) + nil) + +;;; Symbol-macrolet tests + +(deftest symbol-macrolet.1 + (loop for s in *cl-non-variable-constant-symbols* + for form = `(classify-error (symbol-macrolet ((,s 17)) ,s)) + unless (eql (eval form) 17) + collect s) + nil) diff --git a/ansi-tests/make-array.lsp b/ansi-tests/make-array.lsp new file mode 100644 index 0000000..761b860 --- /dev/null +++ b/ansi-tests/make-array.lsp @@ -0,0 +1,670 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Sep 20 06:47:37 2002 +;;;; Contains: Tests for MAKE-ARRAY + +(in-package :cl-test) + +;;; See array-aux.lsp for auxiliary functions + +(deftest make-array.1 + (let ((a (make-array-with-checks 10))) + (and (symbolp a) a)) + nil) + +(deftest make-array.1a + (let ((a (make-array-with-checks '(10)))) + (and (symbolp a) a)) + nil) + +(deftest make-array.2 + (make-array-with-checks 3 :initial-element 'z) + #(z z z)) + +(deftest make-array.2a + (make-array-with-checks 3 :initial-contents '(a b c)) + #(a b c)) + +(deftest make-array.2b + (make-array-with-checks 3 :initial-contents #(a b c)) + #(a b c)) + +(deftest make-array.2c + (make-array-with-checks 3 :initial-contents "abc") + #(#\a #\b #\c)) + +(deftest make-array.2d + (make-array-with-checks 3 :initial-contents #*010) + #(0 1 0)) + +(deftest make-array.3 + (let ((a (make-array-with-checks 5 :element-type 'bit))) + (and (symbolp a) a)) + nil) + +(deftest make-array.4 + (make-array-with-checks 5 :element-type 'bit :initial-element 1) + #*11111) + +(deftest make-array.4a + (make-array-with-checks 5 :element-type 'bit :initial-contents '(1 0 0 1 0)) + #*10010) + +(deftest make-array.4b + (make-array-with-checks 5 :element-type 'bit :initial-contents #(1 0 0 1 0)) + #*10010) + +(deftest make-array.4c + (make-array-with-checks 5 :element-type 'bit :initial-contents #*10010) + #*10010) + +(deftest make-array.5 + (let ((a (make-array-with-checks 4 :element-type 'character))) + (and (symbolp a) a)) + nil) + +(deftest make-array.5a + (let ((a (make-array-with-checks '(4) :element-type 'character))) + (and (symbolp a) a)) + nil) + +(deftest make-array.6 + (make-array-with-checks 4 :element-type 'character + :initial-element #\x) + "xxxx") + +(deftest make-array.6a + (make-array-with-checks 4 :element-type 'character + :initial-contents '(#\a #\b #\c #\d)) + "abcd") + +(deftest make-array.6b + (make-array-with-checks 4 :element-type 'character + :initial-contents "abcd") + "abcd") + +(deftest make-array.7 + (make-array-with-checks 5 :element-type 'symbol + :initial-element 'a) + #(a a a a a)) + +(deftest make-array.7a + (make-array-with-checks 5 :element-type 'symbol + :initial-contents '(a b c d e)) + #(a b c d e)) + +(deftest make-array.7b + (make-array-with-checks '(5) :element-type 'symbol + :initial-contents '(a b c d e)) + #(a b c d e)) + +(deftest make-array.8 + (let ((a (make-array-with-checks 8 :element-type '(integer 0 (256))))) + (and (symbolp a) a)) + nil) + +(deftest make-array.8a + (make-array-with-checks 8 :element-type '(integer 0 (256)) + :initial-element 9) + #(9 9 9 9 9 9 9 9)) + +(deftest make-array.8b + (make-array-with-checks '(8) :element-type '(integer 0 (256)) + :initial-contents '(4 3 2 1 9 8 7 6)) + #(4 3 2 1 9 8 7 6)) + +;;; Zero dimensional arrays + +(deftest make-array.9 + (let ((a (make-array-with-checks nil))) + (and (symbolp a) a)) + nil) + +(deftest make-array.10 + (make-array-with-checks nil :initial-element 1) + #0a1) + +(deftest make-array.11 + (make-array-with-checks nil :initial-contents 2) + #0a2) + +(deftest make-array.12 + (make-array-with-checks nil :element-type 'bit :initial-contents 1) + #0a1) + +(deftest make-array.13 + (make-array-with-checks nil :element-type t :initial-contents 'a) + #0aa) + +;;; Higher dimensional arrays + +(deftest make-array.14 + (let ((a (make-array-with-checks '(2 3)))) + (and (symbolp a) a)) + nil) + +(deftest make-array.15 + (make-array-with-checks '(2 3) :initial-element 'x) + #2a((x x x) (x x x))) + +(deftest make-array.16 + (equalpt (make-array-with-checks '(0 0)) + (read-from-string "#2a()")) + t) + +(deftest make-array.17 + (make-array-with-checks '(2 3) :initial-contents '((a b c) (d e f))) + #2a((a b c) (d e f))) + +(deftest make-array.18 + (make-array-with-checks '(2 3) :initial-contents '(#(a b c) #(d e f))) + #2a((a b c) (d e f))) + +(deftest make-array.19 + (make-array-with-checks '(4) :initial-contents + (make-array '(10) :initial-element 1 + :fill-pointer 4)) + #(1 1 1 1)) + +(deftest make-array.20 + (let ((a (make-array '(10) :initial-element 1 + :fill-pointer 4))) + (make-array-with-checks '(3 4) :initial-contents + (list a a a))) + #2a((1 1 1 1) (1 1 1 1) (1 1 1 1))) + +(deftest make-array.21 + (make-array-with-checks '(3 4) :initial-contents + (make-array '(10) :initial-element '(1 2 3 4) + :fill-pointer 3)) + #2a((1 2 3 4) (1 2 3 4) (1 2 3 4))) + +(deftest make-array.22 + (loop for i from 3 below (min array-rank-limit 128) + always + (equalpt (make-array-with-checks (make-list i :initial-element 0)) + (read-from-string (format nil "#~Aa()" i)))) + t) + +(deftest make-array.23 + (let ((len (1- array-rank-limit))) + (equalpt (make-array-with-checks (make-list len :initial-element 0)) + (read-from-string (format nil "#~Aa()" len)))) + t) + +(deftest make-array.24 + (make-array-with-checks '(5) :initial-element 'a :displaced-to nil) + #(a a a a a)) + +(deftest make-array.25 + (make-array '(4) :initial-element 'x :nonsense-argument t + :allow-other-keys t) + #(x x x x)) + +(deftest make-array.26 + (make-array '(4) :initial-element 'x + :allow-other-keys nil) + #(x x x x)) + +(deftest make-array.27 + (make-array '(4) :initial-element 'x + :allow-other-keys t + :allow-other-keys nil + :nonsense-argument t) + #(x x x x)) + +(deftest make-array.28 + (let ((*package* (find-package :cl-test))) + (let ((len (1- (min 10000 array-rank-limit)))) + (equalpt (make-array (make-list len :initial-element 1) :initial-element 'x) + (read-from-string (concatenate + 'string + (format nil "#~dA" len) + (make-string len :initial-element #\() + "x" + (make-string len :initial-element #\))))))) + t) + +(deftest make-array.29 + (make-array-with-checks '(5) :element-type '(integer 0 (256)) + :initial-contents '(0 5 255 119 57)) + #(0 5 255 119 57)) + +(deftest make-array.30 + (make-array-with-checks '(5) :element-type '(integer -128 127) + :initial-contents '(-10 5 -128 86 127)) + #(-10 5 -128 86 127)) + +(deftest make-array.31 + (make-array-with-checks '(5) :element-type '(integer 0 (65536)) + :initial-contents '(0 100 65535 7623 13)) + #(0 100 65535 7623 13)) + +(deftest make-array.32 + (make-array-with-checks '(5) :element-type 'fixnum + :initial-contents '(1 2 3 4 5)) + #(1 2 3 4 5)) + +(deftest make-array.33 + (make-array-with-checks '(5) :element-type 'short-float + :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)) + #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)) + +(deftest make-array.34 + (make-array-with-checks '(5) :element-type 'single-float + :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)) + #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)) + +(deftest make-array.35 + (make-array-with-checks '(5) :element-type 'double-float + :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) + #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) + +(deftest make-array.36 + (make-array-with-checks '(5) :element-type 'long-float + :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)) + #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)) + + +;;; Adjustable arrays + +(deftest make-array.adjustable.1 + (let ((a (make-array-with-checks '(10) :adjustable t))) + (and (symbolp a) a)) + nil) + +(deftest make-array.adjustable.2 + (make-array-with-checks '(4) :adjustable t + :initial-element 6) + #(6 6 6 6)) + +(deftest make-array.adjustable.3 + (make-array-with-checks nil :adjustable t :initial-element 7) + #0a7) + +(deftest make-array.adjustable.4 + (make-array-with-checks '(2 3) :adjustable t :initial-element 7) + #2a((7 7 7) (7 7 7))) + +(deftest make-array.adjustable.5 + (make-array-with-checks '(2 3) :adjustable t + :initial-contents '((1 2 3) "abc")) + #2a((1 2 3) (#\a #\b #\c))) + +(deftest make-array.adjustable.6 + (make-array-with-checks '(4) :adjustable t + :initial-contents '(a b c d)) + #(a b c d)) + +(deftest make-array.adjustable.7 + (make-array-with-checks '(4) :adjustable t + :fill-pointer t + :initial-contents '(a b c d)) + #(a b c d)) + +(deftest make-array.adjustable.8 + (make-array-with-checks '(4) :adjustable t + :element-type '(integer 0 (256)) + :initial-contents '(1 4 7 9)) + #(1 4 7 9)) + +(deftest make-array.adjustable.9 + (make-array-with-checks '(4) :adjustable t + :element-type 'base-char + :initial-contents "abcd") + "abcd") + +(deftest make-array.adjustable.10 + (make-array-with-checks '(4) :adjustable t + :element-type 'bit + :initial-contents '(0 1 1 0)) + #*0110) + +(deftest make-array.adjustable.11 + (make-array-with-checks '(4) :adjustable t + :element-type 'symbol + :initial-contents '(a b c d)) + #(a b c d)) + +;;; Displaced arrays + +(deftest make-array.displaced.1 + (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j)))) + (make-array-with-checks '(5) :displaced-to a)) + #(a b c d e)) + +(deftest make-array.displaced.2 + (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j)))) + (make-array-with-checks '(5) :displaced-to a + :displaced-index-offset 3)) + #(d e f g h)) + +(deftest make-array.displaced.3 + (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j)))) + (make-array-with-checks '(5) :displaced-to a + :displaced-index-offset 5)) + #(f g h i j)) + +(deftest make-array.displaced.4 + (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j)))) + (make-array-with-checks '(0) :displaced-to a + :displaced-index-offset 10)) + #()) + +(deftest make-array.displaced.5 + (let ((a (make-array '(10) :element-type '(integer 0 (256)) + :initial-contents '(1 3 5 7 9 11 13 15 17 19)))) + (make-array-with-checks '(5) :element-type '(integer 0 (256)) + :displaced-to a)) + #(1 3 5 7 9)) + +(deftest make-array.displaced.6 + (let ((a (make-array '(10) :element-type '(integer 0 (256)) + :initial-contents '(1 3 5 7 9 11 13 15 17 19)))) + (loop for i from 0 to 5 collect + (make-array-with-checks '(5) :element-type '(integer 0 (256)) + :displaced-to a + :displaced-index-offset i))) + (#(1 3 5 7 9) + #(3 5 7 9 11) + #(5 7 9 11 13) + #(7 9 11 13 15) + #(9 11 13 15 17) + #(11 13 15 17 19))) + +(deftest make-array.displaced.7 + (let ((a (make-array '(10) :element-type '(integer 0 (256)) + :initial-contents '(1 3 5 7 9 11 13 15 17 19)))) + (make-array-with-checks '(0) :element-type '(integer 0 (256)) + :displaced-to a + :displaced-index-offset 10)) + #()) + +(deftest make-array.displaced.8 + (let ((a (make-array '(10) :element-type 'bit + :initial-contents '(0 1 1 0 1 1 1 0 1 0)))) + (make-array-with-checks '(5) :element-type 'bit + :displaced-to a)) + #*01101) + +(deftest make-array.displaced.9 + (let ((a (make-array '(10) :element-type 'bit + :initial-contents '(0 1 1 0 1 1 1 0 1 0)))) + (loop for i from 0 to 5 collect + (make-array-with-checks '(5) :element-type 'bit + :displaced-to a + :displaced-index-offset i))) + (#*01101 #*11011 #*10111 #*01110 #*11101 #*11010)) + +(deftest make-array.displaced.10 + (let ((a (make-array '(10) :element-type 'bit + :initial-contents '(0 1 1 0 1 1 1 0 1 0)))) + (make-array-with-checks '(0) :element-type 'bit + :displaced-to a + :displaced-index-offset 10)) + #*) + +(deftest make-array.displaced.11 + (let ((a (make-array '(10) :element-type 'base-char + :initial-contents "abcdefghij"))) + (make-array-with-checks '(5) :element-type 'base-char + :displaced-to a)) + "abcde") + +(deftest make-array.displaced.12 + (let ((a (make-array '(10) :element-type 'base-char + :initial-contents "abcdefghij"))) + (loop for i from 0 to 5 collect + (make-array-with-checks '(5) :element-type 'base-char + :displaced-to a + :displaced-index-offset i))) + ("abcde" + "bcdef" + "cdefg" + "defgh" + "efghi" + "fghij")) + +(deftest make-array.displaced.13 + (let ((a (make-array '(10) :element-type 'base-char + :initial-contents "abcdefghij"))) + (make-array-with-checks '(0) :element-type 'base-char + :displaced-to a + :displaced-index-offset 10)) + "") + +(deftest make-array.displaced.14 + (let ((a (make-array '(10) :element-type 'character + :initial-contents "abcdefghij"))) + (make-array-with-checks '(5) :element-type 'character + :displaced-to a)) + "abcde") + +(deftest make-array.displaced.15 + (let ((a (make-array '(10) :element-type 'character + :initial-contents "abcdefghij"))) + (loop for i from 0 to 5 collect + (make-array-with-checks '(5) :element-type 'character + :displaced-to a + :displaced-index-offset i))) + ("abcde" + "bcdef" + "cdefg" + "defgh" + "efghi" + "fghij")) + +(deftest make-array.displaced.16 + (let ((a (make-array '(10) :element-type 'character + :initial-contents "abcdefghij"))) + (make-array-with-checks '(0) :element-type 'character + :displaced-to a + :displaced-index-offset 10)) + "") + +;;; Multidimensional displaced arrays + +(deftest make-array.displaced.17 + (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8) + (9 10 11 12))))) + (make-array-with-checks '(8) :displaced-to a)) + #(1 2 3 4 5 6 7 8)) + +(deftest make-array.displaced.18 + (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8) + (9 10 11 12))))) + (make-array-with-checks '(8) :displaced-to a + :displaced-index-offset 3)) + #(4 5 6 7 8 9 10 11)) + +(deftest make-array.displaced.19 + (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8) + (9 10 11 12))))) + (make-array-with-checks '(2 4) :displaced-to a + :displaced-index-offset 4)) + #2a((5 6 7 8) (9 10 11 12))) + +(deftest make-array.displaced.20 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(24) :displaced-to a)) + #(a b c d e f g h i j k l m n o p q r s t u v w x)) + +(deftest make-array.displaced.21 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(3 8) :displaced-to a)) + #2a((a b c d e f g h) (i j k l m n o p) (q r s t u v w x))) + +(deftest make-array.displaced.22 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5)) + #(f g h i j k l m n o)) + +(deftest make-array.displaced.23 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :fill-pointer t)) + #(f g h i j k l m n o)) + +(deftest make-array.displaced.24 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :fill-pointer 5)) + #(f g h i j)) + +(deftest make-array.displaced.25 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :adjustable t)) + #(f g h i j k l m n o)) + +(deftest make-array.displaced.26 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :fill-pointer 8 + :adjustable t)) + #(f g h i j k l m)) + +(deftest make-array.displaced.27 + (let ((a (make-array '(10) + :initial-contents '(1 2 3 4 5 6 7 8 9 10) + :fill-pointer t))) + (make-array-with-checks '(2 4) :displaced-to a)) + #2a((1 2 3 4) (5 6 7 8))) + +(deftest make-array.displaced.28 + (let ((a (make-array '(10) + :initial-contents '(1 2 3 4 5 6 7 8 9 10) + :fill-pointer 4))) + (make-array-with-checks '(2 4) :displaced-to a)) + #2a((1 2 3 4) (5 6 7 8))) + +(deftest make-array.displaced.29 + (let ((a (make-array '(10) :initial-element 0))) + (prog1 + (make-array-with-checks '(2 4) :displaced-to a) + (loop for i below 10 do (setf (aref a i) (1+ i))))) + #2a((1 2 3 4) (5 6 7 8))) + +(deftest make-array.displaced.30 + (let* ((a1 (make-array '(10) :initial-element 0)) + (a2 (make-array '(10) :displaced-to a1))) + (prog1 + (make-array-with-checks '(2 4) :displaced-to a2) + (loop for i below 10 do (setf (aref a2 i) (1+ i))))) + #2a((1 2 3 4) (5 6 7 8))) + +(deftest make-array.displaced.31 + (let* ((a1 (make-array '(10) :initial-element 0)) + (a2 (make-array '(10) :displaced-to a1))) + (prog1 + (make-array-with-checks '(2 4) :displaced-to a2) + (loop for i below 10 do (setf (aref a1 i) (1+ i))))) + #2a((1 2 3 4) (5 6 7 8))) + + +;;; Keywords tests + +(deftest make-array.allow-other-keys.1 + (make-array '(5) :initial-element 'a :allow-other-keys t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.2 + (make-array '(5) :initial-element 'a :allow-other-keys nil) + #(a a a a a)) + +(deftest make-array.allow-other-keys.3 + (make-array '(5) :initial-element 'a :allow-other-keys t '#:bad t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.4 + (make-array '(5) :initial-element 'a :bad t :allow-other-keys t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.5 + (make-array '(5) :bad t :initial-element 'a :allow-other-keys t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.6 + (make-array '(5) :bad t :initial-element 'a :allow-other-keys t + :allow-other-keys nil :also-bad nil) + #(a a a a a)) + +(deftest make-array.allow-other-keys.7 + (make-array '(5) :allow-other-keys t :initial-element 'a) + #(a a a a a)) + +(deftest make-array.keywords.8. + (make-array '(5) :initial-element 'x :initial-element 'a) + #(x x x x x)) + +;;; Error tests + +(deftest make-array.error.1 + (classify-error (make-array)) + program-error) + +(deftest make-array.error.2 + (classify-error (make-array '(10) :bad t)) + program-error) + +(deftest make-array.error.3 + (classify-error (make-array '(10) :allow-other-keys nil :bad t)) + program-error) + +(deftest make-array.error.4 + (classify-error (make-array '(10) :allow-other-keys nil + :allow-other-keys t :bad t)) + program-error) + +(deftest make-array.error.5 + (classify-error (make-array '(10) :bad)) + program-error) + +(deftest make-array.error.6 + (classify-error (make-array '(10) 1 2)) + program-error) + +;;; Order of evaluation tests + +(deftest make-array.order.1 + (let ((i 0) a b c d e) + (values + (make-array (progn (setf a (incf i)) 5) + :initial-element (progn (setf b (incf i)) 'a) + :fill-pointer (progn (setf c (incf i)) nil) + :displaced-to (progn (setf d (incf i)) nil) + :element-type (progn (setf e (incf i)) t) + ) + i a b c d e)) + #(a a a a a) 5 1 2 3 4 5) + +(deftest make-array.order.2 + (let ((i 0) a b c d e) + (values + (make-array (progn (setf a (incf i)) 5) + :element-type (progn (setf b (incf i)) t) + :displaced-to (progn (setf c (incf i)) nil) + :fill-pointer (progn (setf d (incf i)) nil) + :initial-element (progn (setf e (incf i)) 'a) + ) + i a b c d e)) + #(a a a a a) 5 1 2 3 4 5) diff --git a/ansi-tests/make-broadcast-stream.lsp b/ansi-tests/make-broadcast-stream.lsp new file mode 100644 index 0000000..25615a9 --- /dev/null +++ b/ansi-tests/make-broadcast-stream.lsp @@ -0,0 +1,99 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 29 21:28:25 2004 +;;;; Contains: Tests of MAKE-BROADCAST-STREAM + +(in-package :cl-test) + +(deftest make-broadcast-stream.1 + (let ((s (make-broadcast-stream))) + (assert (typep s 'stream)) + (assert (typep s 'broadcast-stream)) + (assert (output-stream-p s)) + ;; (assert (not (input-stream-p s))) + (assert (open-stream-p s)) + (assert (streamp s)) + ;; (assert (eq (stream-element-type s) t)) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'broadcast-stream)) + (notnot (output-stream-p s)) + (progn (write-char #\x s) nil) + )) + t t t nil) + +(deftest make-broadcast-stream.2 + (with-output-to-string + (s1) + (let ((s (make-broadcast-stream s1))) + (assert (typep s 'stream)) + (assert (typep s 'broadcast-stream)) + (assert (output-stream-p s)) + ;; (assert (not (input-stream-p s))) + (assert (open-stream-p s)) + (assert (streamp s)) + (assert (eql (stream-element-type s) + (stream-element-type s1))) + (write-char #\x s))) + "x") + +(deftest make-broadcast-stream.3 + (let ((s1 (make-string-output-stream)) + (s2 (make-string-output-stream))) + (let ((s (make-broadcast-stream s1 s2))) + (assert (typep s 'stream)) + (assert (typep s 'broadcast-stream)) + (assert (output-stream-p s)) + ;; (assert (not (input-stream-p s))) + (assert (open-stream-p s)) + (assert (streamp s)) + (assert (eql (stream-element-type s) + (stream-element-type s2))) + (format s "This is a test")) + (values + (get-output-stream-string s1) + (get-output-stream-string s2))) + "This is a test" + "This is a test") + +(deftest make-broadcast-stream.4 + (fresh-line (make-broadcast-stream)) + nil) + +(deftest make-broadcast-stream.5 + (file-length (make-broadcast-stream)) + 0) + +(deftest make-broadcast-stream.6 + (file-position (make-broadcast-stream)) + 0) + +(deftest make-broadcast-stream.7 + (file-string-length (make-broadcast-stream) "antidisestablishmentarianism") + 1) + +(deftest make-broadcast-stream.8 + (stream-external-format (make-broadcast-stream)) + :default) + + + +;;; FIXME +;;; Add tests for: close, +;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, +;;; read-line, write-line, write-string, read-sequence, write-sequence, +;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, +;;; clear-output, print, prin1 princ + +;;; Error tests + +(deftest make-broadcast-stream.error.1 + (check-type-error #'make-broadcast-stream + #'(lambda (x) (and (streamp x) (output-stream-p x)))) + nil) + +(deftest make-broadcast-stream.error.2 + (check-type-error #'make-broadcast-stream + #'(lambda (x) (and (streamp x) (output-stream-p x))) + *streams*) + nil) diff --git a/ansi-tests/make-concatenated-stream.lsp b/ansi-tests/make-concatenated-stream.lsp new file mode 100644 index 0000000..97da920 --- /dev/null +++ b/ansi-tests/make-concatenated-stream.lsp @@ -0,0 +1,323 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 08:41:18 2004 +;;;; Contains: Tests of MAKE-CONCATENATED-STREAM + +(in-package :cl-test) + +(deftest make-concatenated-stream.1 + (let ((s (make-concatenated-stream))) + (read s nil :eof)) + :eof) + +(deftest make-concatenated-stream.2 + (let ((s (make-concatenated-stream))) + (notnot-mv (input-stream-p s))) + t) + +(deftest make-concatenated-stream.3 + (let ((s (make-concatenated-stream))) + (output-stream-p s)) + nil) + +(deftest make-concatenated-stream.4 + (let ((s (make-concatenated-stream))) + (notnot-mv (streamp s))) + t) + +(deftest make-concatenated-stream.5 + (let ((s (make-concatenated-stream))) + (notnot-mv (typep s 'stream))) + t) + +(deftest make-concatenated-stream.6 + (let ((s (make-concatenated-stream))) + (notnot-mv (typep s 'concatenated-stream))) + t) + +(deftest make-concatenated-stream.7 + (let ((s (make-concatenated-stream))) + (notnot-mv (open-stream-p s))) + t) + +(deftest make-concatenated-stream.8 + (let ((s (make-concatenated-stream *standard-input*))) + (notnot-mv (stream-element-type s))) + t) + +(deftest make-concatenated-stream.9 + (let ((pn #p"tmp.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (s pn :direction :output :element-type element-type + :if-exists :supersede) + (dolist (b '(1 5 9 13)) (write-byte b s))) + (with-open-file + (s1 pn :direction :input :element-type element-type) + (with-open-file + (s2 pn :direction :input :element-type element-type) + (let ((s (make-concatenated-stream s1 s2))) + (loop repeat 8 collect (read-byte s)))))) + (1 5 9 13 1 5 9 13)) + +(deftest make-concatenated-stream.10 + (let ((s (make-concatenated-stream))) + (read-byte s nil :eof)) + :eof) + +(deftest make-concatenated-stream.11 + (let ((s (make-concatenated-stream))) + (peek-char nil s nil :eof)) + :eof) + +(deftest make-concatenated-stream.12 + (with-input-from-string + (s1 "a") + (with-input-from-string + (s2 "b") + (let ((s (make-concatenated-stream s1 s2))) + (values + (peek-char nil s) + (read-char s) + (peek-char nil s) + (read-char s) + (peek-char nil s nil :eof))))) + #\a #\a #\b #\b :eof) + +(deftest make-concatenated-stream.13 + (with-input-from-string + (s1 " a ") + (with-input-from-string + (s2 " b ") + (let ((s (make-concatenated-stream s1 s2))) + (values + (peek-char t s) + (read-char s) + (peek-char t s) + (read-char s) + (peek-char t s nil :eof))))) + #\a #\a #\b #\b :eof) + +(deftest make-concatenated-stream.14 + (with-input-from-string + (s1 "a") + (with-input-from-string + (s2 "b") + (let ((s (make-concatenated-stream s1 s2))) + (values + (read-char s) + (unread-char #\a s) + (read-char s) + (read-char s) + (unread-char #\b s) + (read-char s) + (read-char s nil :eof))))) + #\a nil #\a #\b nil #\b :eof) + +(deftest make-concatenated-stream.15 + (let ((s (make-concatenated-stream))) + (read-char-no-hang s nil :eof)) + :eof) + +(deftest make-concatenated-stream.16 + (with-input-from-string + (s1 "a") + (with-input-from-string + (s2 "b") + (let ((s (make-concatenated-stream s1 s2))) + (values + (read-char-no-hang s) + (read-char-no-hang s) + (read-char-no-hang s nil :eof))))) + #\a #\b :eof) + +(deftest make-concatenated-stream.17 + (with-input-from-string + (s1 "a") + (with-input-from-string + (s2 "b") + (let ((s (make-concatenated-stream s1 s2))) + (multiple-value-bind (str mnp) + (read-line s) + (values str (notnot mnp)))))) + "ab" t) + +(deftest make-concatenated-stream.18 + (with-input-from-string + (s1 "ab") + (with-input-from-string + (s2 "") + (let ((s (make-concatenated-stream s1 s2))) + (multiple-value-bind (str mnp) + (read-line s) + (values str (notnot mnp)))))) + "ab" t) + +(deftest make-concatenated-stream.19 + (with-input-from-string + (s1 "") + (with-input-from-string + (s2 "ab") + (let ((s (make-concatenated-stream s1 s2))) + (multiple-value-bind (str mnp) + (read-line s) + (values str (notnot mnp)))))) + "ab" t) + +(deftest make-concatenated-stream.20 + (with-input-from-string + (s1 "ab") + (with-input-from-string + (s2 (concatenate 'string (string #\Newline) "def")) + (let ((s (make-concatenated-stream s1 s2))) + (read-line s)))) + "ab" nil) + +(deftest make-concatenated-stream.21 + (with-input-from-string + (s1 "") + (with-input-from-string + (s2 "") + (let ((s (make-concatenated-stream s1 s2))) + (multiple-value-bind (str mnp) + (read-line s nil :eof) + (values str (notnot mnp)))))) + :eof t) + +(deftest make-concatenated-stream.22 + (let ((pn #p"tmp.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (s pn :direction :output :element-type element-type + :if-exists :supersede) + (dolist (b '(1 5 9 13)) (write-byte b s))) + (with-open-file + (s1 pn :direction :input :element-type element-type) + (with-open-file + (s2 pn :direction :input :element-type element-type) + (let ((s (make-concatenated-stream s1 s2)) + (x (vector nil nil nil nil nil nil nil nil))) + (values + (read-sequence x s) + x))))) + 8 + #(1 5 9 13 1 5 9 13)) + +(deftest make-concatenated-stream.23 + (let ((pn #p"tmp.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (s pn :direction :output :element-type element-type + :if-exists :supersede) + (dolist (b '(1 5 9 13)) (write-byte b s))) + (with-open-file + (s1 pn :direction :input :element-type element-type) + (with-open-file + (s2 pn :direction :input :element-type element-type) + (let ((s (make-concatenated-stream s1 s2)) + (x (vector nil nil nil nil nil nil))) + (values + (read-sequence x s) + x))))) + 6 + #(1 5 9 13 1 5)) + +(deftest make-concatenated-stream.24 + (let ((pn #p"tmp.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (s pn :direction :output :element-type element-type + :if-exists :supersede) + (dolist (b '(1 5 9 13)) (write-byte b s))) + (with-open-file + (s1 pn :direction :input :element-type element-type) + (with-open-file + (s2 pn :direction :input :element-type element-type) + (let ((s (make-concatenated-stream s1 s2)) + (x (vector nil nil nil nil nil nil nil nil nil nil))) + (values + (read-sequence x s) + x))))) + 8 + #(1 5 9 13 1 5 9 13 nil nil)) + +(deftest make-concatenated-stream.25 + (close (make-concatenated-stream)) + t) + +(deftest make-concatenated-stream.26 + (let ((s (make-concatenated-stream))) + (values (prog1 (close s) (close s)) + (open-stream-p s))) + t nil) + +(deftest make-concatenated-stream.27 + (with-input-from-string + (s1 "abc") + (let ((s (make-concatenated-stream s1))) + (values + (notnot (open-stream-p s1)) + (notnot (open-stream-p s)) + (close s) + (notnot (open-stream-p s1)) + (open-stream-p s)))) + t t t t nil) + +(deftest make-concatenated-stream.28 + (with-input-from-string + (s1 "a") + (let ((s (make-concatenated-stream s1))) + (notnot-mv (listen s)))) + t) + +(deftest make-concatenated-stream.28a + (listen (make-concatenated-stream)) + nil) + +(deftest make-concatenated-stream.29 + (with-input-from-string + (s1 "") + (let ((s (make-concatenated-stream s1))) + (listen s))) + nil) + +(deftest make-concatenated-stream.30 + (with-input-from-string + (s1 "") + (with-input-from-string + (s2 "a") + (let ((s (make-concatenated-stream s1 s2))) + (notnot-mv (listen s))))) + t) + +(deftest make-concatenated-stream.31 + (with-input-from-string + (s1 "") + (with-input-from-string + (s2 "") + (let ((s (make-concatenated-stream s1 s2))) + (listen s)))) + nil) + +(deftest make-concatenated-stream.32 + (clear-input (make-concatenated-stream)) + nil) + +(deftest make-concatenated-stream.33 + (with-input-from-string + (s1 "abc") + (clear-input (make-concatenated-stream s1))) + nil) + +;;; Error cases + +(deftest make-concatenated-stream.error.1 + (loop for x in *mini-universe* + unless (or (and (streamp x) (input-stream-p x)) + (eval `(signals-error (make-concatenated-stream ',x) t))) + collect x) + nil) + +(deftest make-concatenated-stream.error.2 + (loop for x in *streams* + unless (or (and (streamp x) (input-stream-p x)) + (eval `(signals-error (make-concatenated-stream ',x) t))) + collect x) + nil) + diff --git a/ansi-tests/make-echo-stream.lsp b/ansi-tests/make-echo-stream.lsp new file mode 100644 index 0000000..223a232 --- /dev/null +++ b/ansi-tests/make-echo-stream.lsp @@ -0,0 +1,332 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Feb 12 04:34:42 2004 +;;;; Contains: Tests of MAKE-ECHO-STREAM + +(in-package :cl-test) + +(deftest make-echo-stream.1 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (read-char s) + (get-output-stream-string os))) + #\f "f") + +(deftest make-echo-stream.2 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (get-output-stream-string os)) + "") + +(deftest make-echo-stream.3 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values (read-line s nil) + (get-output-stream-string os))) + "foo" "foo") + +;;; Tests of READ-BYTE on echo streams + +(deftest make-echo-stream.4 + (let ((pn #p"tmp.dat") + (pn2 #p"tmp2.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (os pn + :direction :output + :element-type element-type + :if-exists :supersede) + (loop for x in '(2 3 5 7 11) + do (write-byte x os))) + (with-open-file + (is pn :direction :input :element-type element-type) + (values + (with-open-file + (os pn2 :direction :output :if-exists :supersede + :element-type element-type) + (let ((s (make-echo-stream is os))) + (loop repeat 6 collect (read-byte s nil :eof1)))) + (with-open-file + (s pn2 :direction :input :element-type element-type) + (loop repeat 6 collect (read-byte s nil :eof2)))))) + (2 3 5 7 11 :eof1) + (2 3 5 7 11 :eof2)) + +(deftest make-echo-stream.5 + (let ((pn #p"tmp.dat") + (pn2 #p"tmp2.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (os pn + :direction :output + :element-type element-type + :if-exists :supersede) + (loop for x in '(2 3 5 7 11) + do (write-byte x os))) + (with-open-file + (is pn :direction :input :element-type element-type) + (values + (with-open-file + (os pn2 :direction :output :if-exists :supersede + :element-type element-type) + (let ((s (make-echo-stream is os))) + (loop repeat 6 collect (read-byte s nil 100)))) + (with-open-file + (s pn2 :direction :input :element-type element-type) + (loop repeat 6 collect (read-byte s nil 200)))))) + (2 3 5 7 11 100) + (2 3 5 7 11 200)) + +(deftest make-echo-stream.6 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values (coerce (loop repeat 3 collect (read-char-no-hang s)) 'string) + (get-output-stream-string os))) + "foo" "foo") + +(deftest make-echo-stream.7 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values (coerce (loop repeat 4 collect (read-char-no-hang s nil '#\z)) + 'string) + (get-output-stream-string os))) + "fooz" "foo") + +;;; peek-char + echo streams is tested in peek-char.lsp +;;; unread-char + echo streams is tested in unread-char.lsp + +(deftest make-echo-stream.8 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os)) + (x (copy-seq "xxxxxx"))) + (values + (read-sequence x s) + x + (get-output-stream-string os))) + 3 + "fooxxx" + "foo") + +(deftest make-echo-stream.9 + (let ((pn #p"tmp.dat") + (pn2 #p"tmp2.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (os pn + :direction :output + :element-type element-type + :if-exists :supersede) + (loop for x in '(2 3 5 7 11) + do (write-byte x os))) + (with-open-file + (is pn :direction :input :element-type element-type) + (values + (with-open-file + (os pn2 :direction :output :if-exists :supersede + :element-type element-type) + (let ((s (make-echo-stream is os)) + (x (vector 0 0 0 0 0 0 0 0))) + (list (read-sequence x s) + x))) + (with-open-file + (s pn2 :direction :input :element-type element-type) + (loop repeat 8 collect (read-byte s nil nil)))))) + (5 #(2 3 5 7 11 0 0 0)) + (2 3 5 7 11 nil nil nil)) + +(deftest make-echo-stream.10 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (notnot (open-stream-p s)) + (close s) + (open-stream-p s) + (notnot (open-stream-p is)) + (notnot (open-stream-p os)))) + t t nil t t) + +(deftest make-echo-stream.11 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (notnot (listen s)) + (read-char s) + (notnot (listen s)) + (read-char s) + (notnot (listen s)) + (read-char s) + (listen s))) + t #\f t #\o t #\o nil) + +(deftest make-echo-stream.12 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (notnot (streamp s)) + (notnot (typep s 'stream)) + (notnot (typep s 'echo-stream)) + (notnot (input-stream-p s)) + (notnot (output-stream-p s)) + (notnot (stream-element-type s)))) + t t t t t t) + +;;; FIXME +;;; Add tests for clear-input, file-position(?) +;;; Also, add tests for output operations (since echo-streams are +;;; bidirectional) + +(deftest make-echo-stream.13 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (write-char #\0 s) + (close s) + (get-output-stream-string os))) + #\0 t "0") + +(deftest make-echo-stream.14 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (terpri s) + (close s) + (get-output-stream-string os))) + nil t #.(string #\Newline)) + +(deftest make-echo-stream.15 + (let ((pn #p"tmp.dat") + (pn2 #p"tmp2.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (os pn + :direction :output + :element-type element-type + :if-exists :supersede)) + (with-open-file + (is pn :direction :input :element-type element-type) + (values + (with-open-file + (os pn2 :direction :output :if-exists :supersede + :element-type element-type) + (let ((s (make-echo-stream is os)) + (x (mapcar #'char-code (coerce "abcdefg" 'list)))) + (loop for b in x do + (assert (equal (list b) + (multiple-value-list (write-byte b s))))) + (close s))))) + (with-open-file + (is pn2 :direction :input :element-type element-type) + (let ((x (vector 0 0 0 0 0 0 0))) + (read-sequence x is) + (values + (read-byte is nil :done) + (map 'string #'code-char x))))) + :done + "abcdefg") + +(deftest make-echo-stream.16 + (let ((pn #p"tmp.dat") + (pn2 #p"tmp2.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (os pn + :direction :output + :element-type element-type + :if-exists :supersede)) + (with-open-file + (is pn :direction :input :element-type element-type) + (values + (with-open-file + (os pn2 :direction :output :if-exists :supersede + :element-type element-type) + (let ((s (make-echo-stream is os)) + (x (map 'vector #'char-code "abcdefg"))) + (assert (equal (multiple-value-list (write-sequence x s)) (list x))) + (close s))))) + (with-open-file + (is pn2 :direction :input :element-type element-type) + (let ((x (vector 0 0 0 0 0 0 0))) + (read-sequence x is) + (values + (read-byte is nil :done) + (map 'string #'code-char x))))) + :done + "abcdefg") + +(deftest make-echo-stream.17 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (write-char #\X s) + (notnot (fresh-line s)) + (finish-output s) + (force-output s) + (close s) + (get-output-stream-string os))) + #\X t nil nil t #.(coerce '(#\X #\Newline) 'string)) + +(deftest make-echo-stream.18 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (write-string "159" s) + (close s) + (get-output-stream-string os))) + "159" t "159") + +(deftest make-echo-stream.20 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (write-string "0159X" s :start 1 :end 4) + (close s) + (get-output-stream-string os))) + "0159X" t "159") + +(deftest make-echo-stream.21 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (write-line "159" s) + (close s) + (get-output-stream-string os))) + "159" t #.(concatenate 'string "159" (string #\Newline))) + +(deftest make-echo-stream.22 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os))) + (values + (write-char #\0 s) + (clear-output s))) + #\0 nil) + +;;; Error tests + +(deftest make-echo-stream.error.1 + (signals-error (make-echo-stream) program-error) + t) + +(deftest make-echo-stream.error.2 + (signals-error (make-echo-stream *standard-input*) program-error) + t) + +(deftest make-echo-stream.error.3 + (signals-error (make-echo-stream *standard-input* *standard-output* nil) + program-error) + t) + + + + diff --git a/ansi-tests/make-hash-table.lsp b/ansi-tests/make-hash-table.lsp new file mode 100644 index 0000000..b6750ef --- /dev/null +++ b/ansi-tests/make-hash-table.lsp @@ -0,0 +1,16 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 21:36:33 2003 +;;;; Contains: Tests for MAKE-HASH-TABLE + +(in-package :cl-test) +#| +(deftest make-hash-table.1 + (let ((ht (make-hash-table))) + (values + (check-values (typep ht 'hash-table)) + (notnot (check-values (hash-table-p ht))) + (check-values (hash-table-count ht)) +|# + + diff --git a/ansi-tests/make-pathname.lsp b/ansi-tests/make-pathname.lsp new file mode 100644 index 0000000..8ccfd3f --- /dev/null +++ b/ansi-tests/make-pathname.lsp @@ -0,0 +1,171 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 29 05:54:30 2003 +;;;; Contains: Tests of MAKE-PATHNAME + +(in-package :cl-test) + +(defvar *null-pathname* + (make-pathname)) + +(defun make-pathname-test + (&rest args &key (defaults nil) + (host (if defaults (pathname-host defaults) + (pathname-host *default-pathname-defaults*))) + (device (if defaults (pathname-device defaults) + (pathname-device *null-pathname*))) + (directory (if defaults (pathname-directory defaults) + (pathname-directory *null-pathname*))) + (name (if defaults (pathname-name defaults) + (pathname-name *null-pathname*))) + (type (if defaults (pathname-type defaults) + (pathname-type *null-pathname*))) + (version (if defaults (pathname-version defaults) + (pathname-version *null-pathname*))) + case) + (declare (ignorable case)) + (let* ((vals (multiple-value-list (apply #'make-pathname args))) + (pn (first vals))) + (and (= (length vals) 1) + (typep pn 'pathname) + (equalp (pathname-host pn) host) + (equalp (pathname-device pn) device) + ;; (equalp (pathname-directory pn) directory) + (let ((pnd (pathname-directory pn))) + (if (eq directory :wild) + (member pnd '((:absolute :wild-inferiors) + (:absolute :wild)) + :test #'equal) + (equalp pnd directory))) + (equalp (pathname-name pn) name) + (equalp (pathname-type pn) type) + (equalp (pathname-version pn) version) + t))) + + + +(deftest make-pathname.1 + (make-pathname-test) + t) + +(deftest make-pathname.2 + (make-pathname-test :name "foo") + t) + +(deftest make-pathname.2a + (do-special-strings + (s "foo") + (assert (make-pathname-test :name s))) + nil) + +(deftest make-pathname.3 + (make-pathname-test :name "foo" :type "txt") + t) + +(deftest make-pathname.3a + (do-special-strings + (s "txt") + (assert (make-pathname-test :name "foo" :type s))) + nil) + +(deftest make-pathname.4 + (make-pathname-test :type "lsp") + t) + +(deftest make-pathname.5 + (make-pathname-test :directory :wild) + t) + +(deftest make-pathname.6 + (make-pathname-test :name :wild) + t) + +(deftest make-pathname.7 + (make-pathname-test :type :wild) + t) + +(deftest make-pathname.8 + (make-pathname-test :version :wild) + t) + +(deftest make-pathname.9 + (make-pathname-test :defaults *default-pathname-defaults*) + t) + +(deftest make-pathname.10 + (make-pathname-test :defaults (make-pathname :name "foo" :type "bar")) + t) + +(deftest make-pathname.11 + (make-pathname-test :version :newest) + t) + +(deftest make-pathname.12 + (make-pathname-test :case :local) + t) + +(deftest make-pathname.13 + (make-pathname-test :case :common) + t) + +(deftest make-pathname.14 + (let ((*default-pathname-defaults* + (make-pathname :name "foo" :type "lsp" :version :newest))) + (make-pathname-test)) + t) + +;;; Works on the components of actual pathnames +(deftest make-pathname.rebuild + (loop for p in *pathnames* + for host = (pathname-host p) + for device = (pathname-device p) + for directory = (pathname-directory p) + for name = (pathname-name p) + for type = (pathname-type p) + for version = (pathname-version p) + for p2 = (make-pathname + :host host + :device device + :directory directory + :name name + :type type + :version version) + unless (equal p p2) + collect (list p p2)) + nil) + +;;; Various constraints on :directory + +(deftest make-pathname-error-absolute-up + (signals-error (directory (make-pathname :directory '(:absolute :up))) + file-error) + t) + +(deftest make-pathname-error-absolute-back + (signals-error (directory (make-pathname :directory '(:absolute :back))) + file-error) + t) + +;; The next test is correct, but was causing very large amounts of time to be spent +;; in buggy implementations +;;#| +(deftest make-pathname-error-absolute-wild-inferiors-up + (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :up))) + file-error) + t) +;;|# + +(deftest make-pathname-error-relative-wild-inferiors-up + (signals-error (length (directory (make-pathname :directory '(:relative :wild-inferiors :up)))) + file-error) + t) + +(deftest make-pathname-error-absolute-wild-inferiors-back + (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :back))) + file-error) + t) + +(deftest make-pathname-error-relative-wild-inferiors-back + (signals-error (directory (make-pathname :directory '(:relative :wild-inferiors :back))) + file-error) + t) diff --git a/ansi-tests/make-sequence.lsp b/ansi-tests/make-sequence.lsp new file mode 100644 index 0000000..dd8101c --- /dev/null +++ b/ansi-tests/make-sequence.lsp @@ -0,0 +1,273 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 14 09:58:47 2002 +;;;; Contains: Tests for MAKE-SEQUENCE + +(in-package :cl-test) + +(deftest make-sequence.1 + (let ((x (make-sequence 'list 4))) + (and (eql (length x) 4) + (listp x) + (loop for e in x always (eql (car x) e)) + t)) + t) + +(deftest make-sequence.2 + (make-sequence 'list 4 :initial-element 'a) + (a a a a)) + +(deftest make-sequence.3 + (let ((x (make-sequence 'cons 4))) + (and (eql (length x) 4) + (listp x) + (loop for e in x always (eql (car x) e)) + t)) + t) + +(deftest make-sequence.4 + (make-sequence 'cons 4 :initial-element 'a) + (a a a a)) + +(deftest make-sequence.5 + (make-sequence 'string 10 :initial-element #\a) + "aaaaaaaaaa") + +(deftest make-sequence.6 + (let ((s (make-sequence 'string 10))) + (and (eql (length s) 10) + (loop for e across s always (eql e (aref s 0))) + t)) + t) + +(deftest make-sequence.7 + (make-sequence 'simple-string 10 :initial-element #\a) + "aaaaaaaaaa") + +(deftest make-sequence.8 + (let ((s (make-sequence 'simple-string 10))) + (and (eql (length s) 10) + (loop for e across s always (eql e (aref s 0))) + t)) + t) + +(deftest make-sequence.9 + (make-sequence 'null 0) + nil) + +(deftest make-sequence.10 + (let ((x (make-sequence 'vector 10))) + (and (eql (length x) 10) + (loop for e across x always (eql e (aref x 0))) + t)) + t) + +(deftest make-sequence.11 + (let* ((u (list 'a)) + (x (make-sequence 'vector 10 :initial-element u))) + (and (eql (length x) 10) + (loop for e across x always (eql e u)) + t)) + t) + +(deftest make-sequence.12 + (let ((x (make-sequence 'simple-vector 10))) + (and (eql (length x) 10) + (loop for e across x always (eql e (aref x 0))) + t)) + t) + +(deftest make-sequence.13 + (let* ((u (list 'a)) + (x (make-sequence 'simple-vector 10 :initial-element u))) + (and (eql (length x) 10) + (loop for e across x always (eql e u)) + t)) + t) + +(deftest make-sequence.14 + (let ((x (make-sequence '(vector *) 10))) + (and (eql (length x) 10) + (loop for e across x always (eql e (aref x 0))) + t)) + t) + +(deftest make-sequence.15 + (let* ((u (list 'a)) + (x (make-sequence '(vector *) 10 :initial-element u))) + (and (eql (length x) 10) + (loop for e across x always (eql e u)) + t)) + t) + +(deftest make-sequence.16 + (let ((x (make-sequence '(simple-vector *) 10))) + (and (eql (length x) 10) + (loop for e across x always (eql e (aref x 0))) + t)) + t) + +(deftest make-sequence.17 + (let* ((u (list 'a)) + (x (make-sequence '(simple-vector *) 10 :initial-element u))) + (and (eql (length x) 10) + (loop for e across x always (eql e u)) + t)) + t) + +(deftest make-sequence.18 + (let ((x (make-sequence '(string *) 10))) + (and (eql (length x) 10) + (loop for e across x always (eql e (aref x 0))) + t)) + t) + +(deftest make-sequence.19 + (let* ((u #\a) + (x (make-sequence '(string *) 10 :initial-element u))) + (and (eql (length x) 10) + (loop for e across x always (eql e u)) + t)) + t) + +(deftest make-sequence.20 + (let ((x (make-sequence '(simple-string *) 10))) + (and (eql (length x) 10) + (loop for e across x always (eql e (aref x 0))) + t)) + t) + +(deftest make-sequence.21 + (let* ((u #\a) + (x (make-sequence '(simple-string *) 10 :initial-element u))) + (and (eql (length x) 10) + (loop for e across x always (eql e u)) + t)) + t) + +(deftest make-sequence.22 + (make-sequence '(vector * 5) 5 :initial-element 'a) + #(a a a a a)) + +(deftest make-sequence.23 + (make-sequence '(vector fixnum 5) 5 :initial-element 1) + #(1 1 1 1 1)) + +(deftest make-sequence.24 + (make-sequence '(vector (integer 0 255) 5) 5 :initial-element 17) + #(17 17 17 17 17)) + +(deftest make-sequence.25 + (make-sequence '(simple-vector 5) 5 :initial-element 'a) + #(a a a a a)) + +(deftest make-sequence.26 + (equalp (make-sequence 'string 5) (make-string 5)) + t) + +;;; Keyword tests + +(deftest make-sequence.allow-other-keys.1 + (make-sequence 'list 5 :allow-other-keys t :initial-element 'a :bad t) + (a a a a a)) + +(deftest make-sequence.allow-other-keys.2 + (make-sequence 'list 5 :initial-element 'a :bad t :allow-other-keys t) + (a a a a a)) + +(deftest make-sequence.allow-other-keys.3 + (make-sequence 'list 5 :initial-element 'a :allow-other-keys t) + (a a a a a)) + +(deftest make-sequence.allow-other-keys.4 + (make-sequence 'list 5 :initial-element 'a :allow-other-keys nil) + (a a a a a)) + +(deftest make-sequence.allow-other-keys.5 + (make-sequence 'list 5 :initial-element 'a :allow-other-keys t + :allow-other-keys nil :bad t) + (a a a a a)) + +(deftest make-sequence.keywords.6 + (make-sequence 'list 5 :initial-element 'a :initial-element 'b) + (a a a a a)) + +;;; Tests for errors + +(deftest make-sequence.error.1 + (classify-error (make-sequence 'symbol 10)) + type-error) + +(deftest make-sequence.error.2 + (classify-error (make-sequence 'null 1)) + type-error) + +(deftest make-sequence.error.3 + (classify-error (make-sequence '(vector * 4) 3)) + type-error) + +(deftest make-sequence.error.4 + (classify-error (make-sequence '(vector * 2) 3)) + type-error) + +(deftest make-sequence.error.5 + (classify-error (make-sequence '(string 4) 3)) + type-error) + +(deftest make-sequence.error.6 + (classify-error (make-sequence '(simple-string 2) 3)) + type-error) + +(deftest make-sequence.error.7 + (classify-error (make-sequence 'cons 0)) + type-error) + +(deftest make-sequence.error.8 + (classify-error (make-sequence)) + program-error) + +(deftest make-sequence.error.9 + (classify-error (make-sequence 'list)) + program-error) + +(deftest make-sequence.error.10 + (classify-error (make-sequence 'list 10 :bad t)) + program-error) + +(deftest make-sequence.error.11 + (classify-error (make-sequence 'list 10 :bad t :allow-other-keys nil)) + program-error) + +(deftest make-sequence.error.12 + (classify-error (make-sequence 'list 10 :initial-element)) + program-error) + +(deftest make-sequence.error.13 + (classify-error (make-sequence 'list 10 0 0)) + program-error) + +(deftest make-sequence.error.14 + (classify-error (locally (make-sequence 'symbol 10) t)) + type-error) + +;;; Order of execution tests + +(deftest make-sequence.order.1 + (let ((i 0) a b c) + (values + (make-sequence (progn (setf a (incf i)) 'list) + (progn (setf b (incf i)) 5) + :initial-element (progn (setf c (incf i)) 'a)) + i a b c)) + (a a a a a) 3 1 2 3) + +(deftest make-sequence.order.2 + (let ((i 0) a b c d e) + (values + (make-sequence (progn (setf a (incf i)) 'list) + (progn (setf b (incf i)) 5) + :allow-other-keys (setf c (incf i)) + :initial-element (progn (setf d (incf i)) 'a) + :foo (setf e (incf i))) + i a b c d e)) + (a a a a a) 5 1 2 3 4 5) diff --git a/ansi-tests/make-string-input-stream.lsp b/ansi-tests/make-string-input-stream.lsp new file mode 100644 index 0000000..b56b8b1 --- /dev/null +++ b/ansi-tests/make-string-input-stream.lsp @@ -0,0 +1,93 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 18:36:48 2004 +;;;; Contains: Tests for MAKE-STRING-INPUT-STREAM + +(in-package :cl-test) + +(deftest make-string-input-stream.1 + (let ((s (make-string-input-stream ""))) + (values + (notnot (typep s 'stream)) + (notnot (streamp s)) + (notnot (input-stream-p s)) + (output-stream-p s))) + t t t nil) + +(deftest make-string-input-stream.2 + (let ((s (make-string-input-stream "abcd"))) + (values + (notnot (typep s 'stream)) + (notnot (streamp s)) + (notnot (input-stream-p s)) + (output-stream-p s))) + t t t nil) + + +(deftest make-string-input-stream.3 + (let ((s (make-string-input-stream "abcd" 1))) + (values (read-line s))) + "bcd") + + +(deftest make-string-input-stream.4 + (let ((s (make-string-input-stream "abcd" 0 2))) + (values (read-line s))) + "ab") + +(deftest make-string-input-stream.5 + (let ((s (make-string-input-stream "abcd" 1 nil))) + (values (read-line s))) + "bcd") + +(deftest make-string-input-stream.6 + (let ((str1 (make-array 6 :element-type 'character + :initial-contents "abcdef" + :fill-pointer 4))) + (let ((s (make-string-input-stream str1))) + (values (read-line s) (read-char s nil :eof)))) + "abcd" :eof) + +(deftest make-string-input-stream.7 + (let* ((str1 (make-array 6 :element-type 'character + :initial-contents "abcdef")) + (str2 (make-array 4 :element-type 'character + :displaced-to str1))) + (let ((s (make-string-input-stream str2))) + (values (read-line s) (read-char s nil :eof)))) + "abcd" :eof) + +(deftest make-string-input-stream.8 + (let* ((str1 (make-array 6 :element-type 'character + :initial-contents "abcdef")) + (str2 (make-array 4 :element-type 'character + :displaced-to str1 + :displaced-index-offset 1))) + (let ((s (make-string-input-stream str2))) + (values (read-line s) (read-char s nil :eof)))) + "bcde" :eof) + +(deftest make-string-input-stream.9 + (let ((str1 (make-array 6 :element-type 'character + :initial-contents "abcdef" + :adjustable t))) + (let ((s (make-string-input-stream str1))) + (values (read-line s) (read-char s nil :eof)))) + "abcdef" :eof) + +(deftest make-string-input-stream.10 + :notes (:allow-nil-arrays :nil-vectors-are-strings) + (let ((s (make-string-input-stream + (make-array 0 :element-type nil)))) + (read-char s nil :eof)) + :eof) + +;;; Error tests + +(deftest make-string-input-stream.error.1 + (signals-error (make-string-input-stream) program-error) + t) + +(deftest make-string-input-stream.error.2 + (signals-error (make-string-input-stream "abc" 1 2 nil) program-error) + t) diff --git a/ansi-tests/make-string-output-stream.lsp b/ansi-tests/make-string-output-stream.lsp new file mode 100644 index 0000000..9b3e7fd --- /dev/null +++ b/ansi-tests/make-string-output-stream.lsp @@ -0,0 +1,139 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 19:42:07 2004 +;;;; Contains: Tests of MAKE-STRING-OUTPUT-STREAM + +(in-package :cl-test) + +(deftest make-string-output-stream.1 + (let ((s (make-string-output-stream))) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (input-stream-p s) + (notnot (output-stream-p s)) + (notnot (open-stream-p s)))) + t t nil t t) + +(deftest make-string-output-stream.2 + (let ((s (make-string-output-stream :element-type 'character))) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (input-stream-p s) + (notnot (output-stream-p s)) + (notnot (open-stream-p s)))) + t t nil t t) + +(deftest make-string-output-stream.3 + (let ((s (make-string-output-stream :element-type 'base-char))) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (input-stream-p s) + (notnot (output-stream-p s)) + (notnot (open-stream-p s)))) + t t nil t t) + +(deftest make-string-output-stream.4 + :notes (:nil-vectors-are-strings) + (let ((s (make-string-output-stream :element-type nil))) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (input-stream-p s) + (notnot (output-stream-p s)) + (notnot (open-stream-p s)))) + t t nil t t) + +(deftest make-string-output-stream.5 + (let ((s (make-string-output-stream :allow-other-keys nil))) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (input-stream-p s) + (notnot (output-stream-p s)) + (notnot (open-stream-p s)))) + t t nil t t) + +(deftest make-string-output-stream.6 + (let ((s (make-string-output-stream :allow-other-keys t :foo 'bar))) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (input-stream-p s) + (notnot (output-stream-p s)) + (notnot (open-stream-p s)))) + t t nil t t) + +(deftest make-string-output-stream.7 + (let ((s (make-string-output-stream :foo 'bar :allow-other-keys t + :allow-other-keys nil + :foo2 'x))) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (input-stream-p s) + (notnot (output-stream-p s)) + (notnot (open-stream-p s)))) + t t nil t t) + +(deftest make-string-output-stream.8 + (let ((s (make-string-output-stream))) + (write-string "abc" s) + (write-string "def" s) + (get-output-stream-string s)) + "abcdef") + +(deftest make-string-output-stream.9 + (let ((s (make-string-output-stream :element-type 'character))) + (write-string "abc" s) + (write-string "def" s) + (get-output-stream-string s)) + "abcdef") + +(deftest make-string-output-stream.10 + (let ((s (make-string-output-stream :element-type 'base-char))) + (write-string "abc" s) + (write-string "def" s) + (get-output-stream-string s)) + "abcdef") + +(deftest make-string-output-stream.11 + :notes (:nil-vectors-are-strings) + (let ((s (make-string-output-stream :element-type nil))) + (get-output-stream-string s)) + "") + +(deftest make-string-output-stream.12 + :notes (:nil-vectors-are-strings) + (let ((s (make-string-output-stream :element-type nil))) + (typep #\a (array-element-type (get-output-stream-string s)))) + nil) + +(deftest make-string-output-stream.13 + (let ((s (make-string-output-stream))) + (values + (close s) + (open-stream-p s))) + t nil) + +;;; Error tests + +(deftest make-string-output-stream.error.1 + (signals-error (make-string-output-stream nil) program-error) + t) + +(deftest make-string-output-stream.error.2 + (signals-error (make-string-output-stream :foo nil) program-error) + t) + +(deftest make-string-output-stream.error.3 + (signals-error (make-string-output-stream :allow-other-keys nil + :foo 'bar) + program-error) + t) + + + + diff --git a/ansi-tests/make-string.lsp b/ansi-tests/make-string.lsp new file mode 100644 index 0000000..160f05e --- /dev/null +++ b/ansi-tests/make-string.lsp @@ -0,0 +1,163 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 5 12:32:20 2002 +;;;; Contains: Tests for MAKE-STRING + +(in-package :cl-test) + +(deftest make-string.1 + (let ((s (make-string 10))) + (and (stringp s) + ;; (string-all-the-same s) + (eqlt (length s) 10) + )) + t) + +(deftest make-string.2 + (let ((s (make-string 10 :initial-element #\a))) + (and (stringp s) + (eql (length s) 10) + s)) + "aaaaaaaaaa") + +(deftest make-string.3 + (let ((s (make-string 10 :initial-element #\a + :element-type 'character))) + (and (stringp s) + (eql (length s) 10) + s)) + "aaaaaaaaaa") + +(deftest make-string.4 + (let ((s (make-string 10 :initial-element #\a + :element-type 'standard-char))) + (and (stringp s) + (eql (length s) 10) + s)) + "aaaaaaaaaa") + +(deftest make-string.5 + (let ((s (make-string 10 :initial-element #\a + :element-type 'base-char))) + (and (stringp s) + (eql (length s) 10) + s)) + "aaaaaaaaaa") + +(deftest make-string.6 + (make-string 0) + "") + +(deftest make-string.7 + (let ((s (make-string 10 :element-type 'character))) + (and (stringp s) + (eqlt (length s) 10) + #| (string-all-the-same s) |# + )) + t) + +(deftest make-string.8 + (let ((s (make-string 10 :element-type 'standard-char))) + (and (stringp s) + (eqlt (length s) 10) + #| (string-all-the-same s) |# + )) + t) + +(deftest make-string.9 + (let ((s (make-string 10 :element-type 'base-char))) + (and (stringp s) + (eqlt (length s) 10) + #| (string-all-the-same s) |# + )) + t) + +;;; Keyword tests +; +(deftest make-string.allow-other-keys.1 + (make-string 5 :allow-other-keys t :initial-element #\a) + "aaaaa") + +(deftest make-string.allow-other-keys.2 + (make-string 5 :initial-element #\a :allow-other-keys t) + "aaaaa") + +(deftest make-string.allow-other-keys.3 + (make-string 5 :initial-element #\a :allow-other-keys t + :bad t) + "aaaaa") + +(deftest make-string.allow-other-keys.4 + (make-string 5 :bad t :allow-other-keys t :allow-other-keys nil + :initial-element #\a) + "aaaaa") + +(deftest make-string.allow-other-keys.5 + (make-string 5 :allow-other-keys t :bad t :allow-other-keys nil + :initial-element #\a) + "aaaaa") + +(deftest make-string.allow-other-keys.6 + (make-string 5 :allow-other-keys t :allow-other-keys nil :bad nil + :initial-element #\a) + "aaaaa") + +(deftest make-string.keywords.7 + (make-string 5 :initial-element #\a :initial-element #\b) + "aaaaa") + +;; Error cases + +(deftest make-string.error.1 + (classify-error (make-string)) + program-error) + +(deftest make-string.error.2 + (classify-error (make-string 10 :bad t)) + program-error) + +(deftest make-string.error.3 + (classify-error (make-string 10 :bad t :allow-other-keys nil)) + program-error) + +(deftest make-string.error.4 + (classify-error (make-string 10 :initial-element)) + program-error) + +(deftest make-string.error.5 + (classify-error (make-string 10 1 1)) + program-error) + +(deftest make-string.error.6 + (classify-error (make-string 10 :element-type)) + program-error) + +;;; Order of evaluation + +(deftest make-string.order.1 + (let ((i 0) a b) + (values + (make-string (progn (setf a (incf i)) 4) + :initial-element (progn (setf b (incf i)) #\a)) + i a b)) + "aaaa" 2 1 2) + +(deftest make-string.order.2 + (let ((i 0) a b c) + (values + (make-string (progn (setf a (incf i)) 4) + :initial-element (progn (setf b (incf i)) #\a) + :element-type (progn (setf c (incf i)) 'base-char)) + i a b c)) + "aaaa" 3 1 2 3) + +(deftest make-string.order.3 + (let ((i 0) a b c) + (values + (make-string (progn (setf a (incf i)) 4) + :element-type (progn (setf b (incf i)) 'base-char) + :initial-element (progn (setf c (incf i)) #\a)) + i a b c)) + "aaaa" 3 1 2 3) + + diff --git a/ansi-tests/make-synonym-stream.lsp b/ansi-tests/make-synonym-stream.lsp new file mode 100644 index 0000000..b5bab2d --- /dev/null +++ b/ansi-tests/make-synonym-stream.lsp @@ -0,0 +1,97 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 28 06:54:33 2004 +;;;; Contains: Tests of MAKE-SYNONYM-STREAM + +(in-package :cl-test) + +(deftest make-synonym-stream.1 + (with-input-from-string + (*s* "abcde") + (declare (special *s*)) + (let ((ss (make-synonym-stream '*s*))) + (assert (typep ss 'stream)) + (assert (typep ss 'synonym-stream)) + (assert (input-stream-p ss)) + (assert (not (output-stream-p ss))) + (assert (open-stream-p ss)) + (assert (streamp ss)) + (assert (stream-element-type ss)) + (values + (read-char *s*) + (read-char ss) + (read-char *s*) + (read-char ss) + (read-char ss)))) + #\a #\b #\c #\d #\e) + + +;;; This test was wrong (section 21.1.4) +#| +(deftest make-synonym-stream.2 + (let ((ss (make-synonym-stream '*s*))) + (with-input-from-string + (*s* "z") + (declare (special *s*)) + (assert (typep ss 'stream)) + (assert (typep ss 'synonym-stream)) + (assert (input-stream-p ss)) + (assert (not (output-stream-p ss))) + (assert (open-stream-p ss)) + (assert (streamp ss)) + (assert (stream-element-type ss)) + (read-char ss))) + #\z) +|# + +(deftest make-synonym-stream.3 + (with-output-to-string + (*s*) + (declare (special *s*)) + (let ((ss (make-synonym-stream '*s*))) + (assert (typep ss 'stream)) + (assert (typep ss 'synonym-stream)) + (assert (output-stream-p ss)) + (assert (not (input-stream-p ss))) + (assert (open-stream-p ss)) + (assert (streamp ss)) + (assert (stream-element-type ss)) + (write-char #\a *s*) + (write-char #\b ss) + (write-char #\x *s*) + (write-char #\y ss))) + "abxy") + +(deftest make-synonym-stream.4 + (let ((ss (make-synonym-stream '*terminal-io*))) + (assert (typep ss 'stream)) + (assert (typep ss 'synonym-stream)) + (assert (output-stream-p ss)) + (assert (input-stream-p ss)) + (assert (open-stream-p ss)) + (assert (streamp ss)) + (assert (stream-element-type ss)) + nil) + nil) + + +;;; FIXME +;;; Add tests for: close, +;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, +;;; read-line, write-line, write-string, read-sequence, write-sequence, +;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, +;;; clear-output, format, print, prin1, princ + +;;; Error cases + +(deftest make-synonym-stream.error.1 + (signals-error (make-synonym-stream) program-error) + t) + +(deftest make-synonym-stream.error.2 + (signals-error (make-synonym-stream '*standard-input* nil) program-error) + t) + +(deftest make-synonym-stream.error.3 + (check-type-error #'make-synonym-stream #'symbolp) + nil) diff --git a/ansi-tests/make-tar b/ansi-tests/make-tar new file mode 100755 index 0000000..cb7257b --- /dev/null +++ b/ansi-tests/make-tar @@ -0,0 +1,2 @@ +rm -f binary/* rt/binary/* +tar cvf cltest.tar README *.system *.lsp make-tar binary/ rt/*.system rt/*.lsp rt/*.txt rt/binary/ diff --git a/ansi-tests/make-two-way-stream.lsp b/ansi-tests/make-two-way-stream.lsp new file mode 100644 index 0000000..e1a43d7 --- /dev/null +++ b/ansi-tests/make-two-way-stream.lsp @@ -0,0 +1,244 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Jan 30 05:39:56 2004 +;;;; Contains: Tests for MAKE-TWO-WAY-STREAM + +(in-package :cl-test) + +(deftest make-two-way-stream.1 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (assert (typep s 'stream)) + (assert (typep s 'two-way-stream)) + (assert (streamp s)) + (assert (open-stream-p s)) + (assert (input-stream-p s)) + (assert (output-stream-p s)) + (assert (stream-element-type s)) + (values + (read-char s) + (write-char #\b s) + (read-char s) + (write-char #\a s) + (read-char s) + (write-char #\r s) + (get-output-stream-string os))) + #\f #\b #\o #\a #\o #\r "bar") + +(deftest make-two-way-stream.2 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (close s) + (open-stream-p s) + (notnot (open-stream-p is)) + (notnot (open-stream-p os)) + (write-char #\8 os) + (get-output-stream-string os))) + t nil t t #\8 "8") + +(deftest make-two-way-stream.3 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (peek-char nil s) + (read-char s) + (get-output-stream-string os))) + #\f #\f "") + +(deftest make-two-way-stream.4 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (read-char-no-hang s) + (read-char-no-hang s nil) + (read-char-no-hang s t :eof) + (read-char-no-hang s nil :eof) + (get-output-stream-string os))) + #\f #\o #\o :eof "") + +(deftest make-two-way-stream.5 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (terpri s) + (get-output-stream-string os))) + nil #.(string #\Newline)) + +(deftest make-two-way-stream.6 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (write-char #\+ s) + (notnot (fresh-line s)) + (read-char s) + (get-output-stream-string os))) + #\+ t #\f #.(coerce (list #\+ #\Newline) 'string)) + +(deftest make-two-way-stream.7 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (read-char s) + (unread-char #\f s) + (read-char s) + (read-char s) + (unread-char #\o s) + (get-output-stream-string os))) + #\f nil #\f #\o nil "") + +(deftest make-two-way-stream.8 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (read-line s) + (get-output-stream-string os))) + "foo" "") + +(deftest make-two-way-stream.9 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (write-string "bar" s) + (get-output-stream-string os))) + "bar" "bar") + +(deftest make-two-way-stream.10 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (write-line "bar" s) + (get-output-stream-string os))) + "bar" #.(concatenate 'string "bar" '(#\Newline))) + +(deftest make-two-way-stream.11 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (let ((x (vector nil nil nil))) + (values + (read-sequence x s) + x + (get-output-stream-string os)))) + 3 #(#\f #\o #\o) "") + +(deftest make-two-way-stream.12 + (let ((pn1 #p"tmp.dat") + (pn2 #p"tmp2.dat") + (element-type '(unsigned-byte 8))) + (with-open-file (s pn1 :direction :output :if-exists :supersede + :element-type element-type) + (dolist (b '(3 8 19 41)) (write-byte b s))) + (with-open-file + (is pn1 :direction :input :element-type element-type) + (with-open-file + (os pn2 :direction :output :element-type element-type + :if-exists :supersede) + (let ((s (make-two-way-stream is os)) + (x (vector nil nil nil nil))) + (assert (eql (read-sequence x s) 4)) + (assert (equalp x #(3 8 19 41))) + (let ((y #(100 5 18 211 0 178))) + (assert (eql (write-sequence y s) y)) + (close s))))) + (with-open-file + (s pn2 :direction :input :element-type element-type) + (let ((x (vector nil nil nil nil nil nil nil))) + (values + (read-sequence x s) + x)))) + 6 + #(100 5 18 211 0 178 nil)) + +(deftest make-two-way-stream.13 + (let ((pn1 #p"tmp.dat") + (pn2 #p"tmp2.dat") + (element-type '(unsigned-byte 32))) + (with-open-file (s pn1 :direction :output :if-exists :supersede + :element-type element-type) + (dolist (b '(3 8 19 41)) (write-byte b s))) + (with-open-file + (is pn1 :direction :input :element-type element-type) + (with-open-file + (os pn2 :direction :output :element-type element-type + :if-exists :supersede) + (let ((s (make-two-way-stream is os)) + (x (vector nil nil nil nil))) + (assert (eql (read-sequence x s) 4)) + (assert (equalp x #(3 8 19 41))) + (let ((y #(100 5 18 211 0 178))) + (assert (eql (write-sequence y s) y)) + (close s))))) + (with-open-file + (s pn2 :direction :input :element-type element-type) + (let ((x (vector nil nil nil nil nil nil nil))) + (values + (read-sequence x s) + x)))) + 6 + #(100 5 18 211 0 178 nil)) + +(deftest make-two-way-stream.14 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (values + (write-string "abc" s) + (clear-input s) + (write-string "def" s) + (get-output-stream-string os))) + "abc" nil "def" "abcdef") + +;;; Error tests + +(deftest make-two-way-stream.error.1 + (signals-error (make-two-way-stream) program-error) + t) + +(deftest make-two-way-stream.error.2 + (signals-error (make-two-way-stream (make-string-input-stream "foo")) + program-error) + t) + +(deftest make-two-way-stream.error.3 + (signals-error (let ((os (make-string-output-stream))) + (make-two-way-stream (make-string-input-stream "foo") + os nil)) + program-error) + t) + +(deftest make-two-way-stream.error.4 + (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) + #'(lambda (x) (and (streamp x) (input-stream-p x)))) + nil) + +(deftest make-two-way-stream.error.5 + (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) + #'(lambda (x) (and (streamp x) (input-stream-p x))) + *streams*) + nil) + +(deftest make-two-way-stream.error.6 + (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) + #'(lambda (x) (and (streamp x) (output-stream-p x)))) + nil) + +(deftest make-two-way-stream.error.7 + (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) + #'(lambda (x) (and (streamp x) (output-stream-p x))) + *streams*) + nil) + + + + \ No newline at end of file diff --git a/ansi-tests/makefile b/ansi-tests/makefile new file mode 100644 index 0000000..722ded5 --- /dev/null +++ b/ansi-tests/makefile @@ -0,0 +1,12 @@ +-include ../makedefs + +test-unixport: + echo "(load \"gclload.lsp\")" | ../unixport/saved_ansi_gcl$(EXE) | tee test.out + +test: + echo "(load \"gclload.lsp\")" | gcl | tee test.out + +clean: + rm -f test.out *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl + rm -f foo.txt temp.dat file-that-was-renamed.txt tmp.dat tmp.dat.BAK tmp2.dat + rm -rf scratch tmp.txt foo.lsp 'CLTEST:foo.txt' diff --git a/ansi-tests/map-into.lsp b/ansi-tests/map-into.lsp new file mode 100644 index 0000000..cc0c1f4 --- /dev/null +++ b/ansi-tests/map-into.lsp @@ -0,0 +1,407 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Aug 18 10:10:04 2002 +;;;; Contains: Tests for the MAP-INTO function + +(in-package :cl-test) + +(deftest map-into-list.1 + (let ((a (copy-seq '(a b c d e f))) + (b nil)) + (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) + (values a b)) + (1 2 3 4 5 6) + (6 5 4 3 2 1)) + +(deftest map-into-list.2 + (let ((a (copy-seq '(a b c d e f g)))) + (map-into a #'identity '(1 2 3)) + a) + (1 2 3 d e f g)) + +(deftest map-into-list.3 + (let ((a (copy-seq '(a b c)))) + (map-into a #'identity '(1 2 3 4 5 6)) + a) + (1 2 3)) + +(deftest map-into-list.4 + (let ((a (copy-seq '(a b c d e f))) + (b nil)) + (map-into a #'(lambda (x y) (let ((z (+ x y))) (push z b) z)) + '(1 2 3 4 5 6) + '(10 11 12 13 14 15)) + (values a b)) + (11 13 15 17 19 21) + (21 19 17 15 13 11)) + +(deftest map-into-list.5 + (let ((a (copy-seq '(a b c d e f)))) + (map-into a 'identity '(1 2 3 4 5 6)) + a) + (1 2 3 4 5 6)) + +(deftest map-into-list.6 + (let ((b nil)) + (values + (map-into nil #'(lambda (x y) (let ((z (+ x y))) (push z b) z)) + '(1 2 3 4 5 6) + '(10 11 12 13 14 15)) + b)) + nil nil) + +(deftest map-into-list.7 + (let ((a (copy-seq '(a b c d e f)))) + (map-into a #'(lambda () 1)) + a) + (1 1 1 1 1 1)) + +(deftest map-into-list.8 + (let ((a (copy-seq '(a b c d e f))) + (s2 (make-array '(6) :initial-element 'x + :fill-pointer 4))) + (map-into a #'identity s2) + a) + (x x x x e f)) + +(deftest map-into-array.1 + (let ((a (copy-seq #(a b c d e f))) + b) + (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) + (values a b)) + #(1 2 3 4 5 6) + (6 5 4 3 2 1)) + +(deftest map-into-array.2 + (let ((a (copy-seq #(a b c d e f g h))) + b) + (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) + (values a b)) + #(1 2 3 4 5 6 g h) + (6 5 4 3 2 1)) + +(deftest map-into-array.3 + (let ((a (copy-seq #(a b c d))) + b) + (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) + (values a b)) + #(1 2 3 4) + (4 3 2 1)) + +(deftest map-into-array.4 + (let ((a (copy-seq #(a b c d e f))) + b) + (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6)) + (values a b)) + #(1 2 3 4 5 6) + (6 5 4 3 2 1)) + +(deftest map-into-array.5 + (let ((a (copy-seq #(a b c d e f g h))) + b) + (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6)) + (values a b)) + #(1 2 3 4 5 6 g h) + (6 5 4 3 2 1)) + +(deftest map-into-array.6 + (let ((a (copy-seq #(a b c d))) + b) + (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6)) + (values a b)) + #(1 2 3 4) + (4 3 2 1)) + +;;; Tests of mapping into arrays with fill pointers +(deftest map-into-array.7 + (let ((a (make-array 6 :initial-element 'x + :fill-pointer 3))) + (map-into a #'identity '(1 2 3)) + a) + #(1 2 3)) + +(deftest map-into-array.8 + (let ((a (make-array 6 :initial-element 'x + :fill-pointer 3))) + (map-into a #'identity '(1 2)) + a) + #(1 2)) + +(deftest map-into-array.9 + (let ((a (make-array 6 :initial-element 'x + :fill-pointer 3))) + (map-into a #'identity '(1 2 3 4 5)) + (and (eqlt (fill-pointer a) 5) + a)) + #(1 2 3 4 5)) + +(deftest map-into-array.10 + (let ((a (make-array 6 :initial-element 'x + :fill-pointer 3))) + (map-into a #'(lambda () 'y)) + (and (eqlt (fill-pointer a) 6) + a)) + #(y y y y y y)) + +(deftest map-into-array.11 + (let ((a (copy-seq #(a b c d e f))) + (s2 (make-array '(6) :initial-element 'x + :fill-pointer 4))) + (map-into a #'identity s2) + a) + #(x x x x e f)) + +;;; mapping into strings + +(deftest map-into-string.1 + (let ((a (copy-seq "abcdef"))) + (map-into a #'identity "123456") + (values (not (not (stringp a))) a)) + t + "123456") + +(deftest map-into-string.2 + (let ((a (copy-seq "abcdef"))) + (map-into a #'identity "1234") + (values (not (not (stringp a))) a)) + t + "1234ef") + +(deftest map-into-string.3 + (let ((a (copy-seq "abcd"))) + (map-into a #'identity "123456") + (values (not (not (stringp a))) a)) + t + "1234") + +(deftest map-into-string.4 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character + :fill-pointer 3))) + (map-into a #'identity "abcde") + (values + (fill-pointer a) + (aref a 5) + a)) + 5 + #\x + "abcde") + +(deftest map-into-string.5 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character + :fill-pointer 3))) + (map-into a #'(lambda () #\y)) + (values (fill-pointer a) + a)) + 6 + "yyyyyy") + +(deftest map-into-string.6 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character))) + (map-into a #'(lambda () #\y)) + a) + "yyyyyy") + +(deftest map-into-string.7 + (let ((a (make-array 6 :initial-element #\x + :element-type 'base-char + :fill-pointer 3))) + (map-into a #'identity "abcde") + (values (fill-pointer a) + (aref a 5) + a)) + 5 + #\x + "abcde") + +(deftest map-into-string.8 + (let ((a (make-array 6 :initial-element #\x + :element-type 'base-char + :fill-pointer 3))) + (map-into a #'(lambda () #\y)) + (values (fill-pointer a) + a)) + 6 + "yyyyyy") + +(deftest map-into-string.9 + (let ((a (make-array 6 :initial-element #\x + :element-type 'base-char))) + (map-into a #'(lambda () #\y)) + a) + "yyyyyy") + +(deftest map-into-string.10 + (let ((a (copy-seq "abcdef")) + (s2 (make-array '(6) :initial-element #\x + :fill-pointer 4))) + (map-into a #'identity s2) + a) + "xxxxef") + +(deftest map-into-string.11 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character + :fill-pointer 3))) + (map-into a #'identity "abcd") + (values + (fill-pointer a) + (aref a 4) + (aref a 5) + a)) + 4 + #\x + #\x + "abcd") + +(deftest map-into-string.12 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character + :fill-pointer 3))) + (map-into a #'identity "abcdefgh") + (values + (fill-pointer a) + a)) + 6 + "abcdef") + +;;; Tests on bit vectors + +(deftest map-into.bit-vector.1 + (let ((v (copy-seq #*0100110))) + (map-into v #'(lambda (x) (- 1 x)) v) + (and (bit-vector-p v) + v)) + #*1011001) + +(deftest map-into.bit-vector.2 + (let ((v (copy-seq #*0100110))) + (map-into v #'(lambda () 0)) + (and (bit-vector-p v) + v)) + #*0000000) + +(deftest map-into.bit-vector.3 + (let ((v (copy-seq #*0100110))) + (map-into v #'identity '(0 1 1 1 0 0 1)) + (and (bit-vector-p v) + v)) + #*0111001) + +(deftest map-into.bit-vector.4 + (let ((v (copy-seq #*0100110))) + (map-into v #'identity '(0 1 1 1)) + (and (bit-vector-p v) + v)) + #*0111110) + +(deftest map-into.bit-vector.5 + (let ((v (copy-seq #*0100110))) + (map-into v #'identity '(0 1 1 1 0 0 1 4 5 6 7)) + (and (bit-vector-p v) + v)) + #*0111001) + +(deftest map-into.bit-vector.6 + (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) + :fill-pointer 4 + :element-type 'bit))) + (map-into v #'(lambda () 1)) + (and (bit-vector-p v) + v)) + #*11111111) + +(deftest map-into.bit-vector.7 + (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) + :fill-pointer 4 + :element-type 'bit))) + (map-into v #'identity v) + (and (bit-vector-p v) + v)) + #*0100) + +(deftest map-into.bit-vector.8 + (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) + :fill-pointer 4 + :element-type 'bit))) + (map-into v #'identity '(1 1 1 1 1 1)) + (and (bit-vector-p v) + (values (fill-pointer v) + v))) + 6 + #*111111) + +(deftest map-into.bit-vector.9 + (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) + :fill-pointer 4 + :element-type 'bit))) + (map-into v #'identity '(1 1 1 1 1 1 0 0 1 1 1)) + (and (bit-vector-p v) + (values (fill-pointer v) + v))) + 8 + #*11111100) + + +;;; Error cases + +(deftest map-into.error.1 + (classify-error (map-into 'a #'(lambda () nil))) + type-error) + +;;; The next test was changed because if the first argument +;;; is NIL, map-into is said to 'return nil immediately', so +;;; the 'should be prepared' notation for the error checking +;;; means that error checking may be skipped. +(deftest map-into.error.2 + (case (classify-error (map-into nil #'identity 'a)) + ((nil type-error) 'good) + (t 'bad)) + good) + +(deftest map-into.error.3 + (classify-error (map-into (copy-seq '(a b c)) #'cons '(d e f) 100)) + type-error) + +(deftest map-into.error.4 + (classify-error (map-into)) + program-error) + +(deftest map-into.error.5 + (classify-error (map-into (list 'a 'b 'c))) + program-error) + +(deftest map-into.error.6 + (classify-error (locally (map-into 'a #'(lambda () nil)) t)) + type-error) + +(deftest map-into.error.7 + (classify-error (map-into (list 'a 'b 'c) #'cons '(a b c))) + program-error) + +(deftest map-into.error.8 + (classify-error (map-into (list 'a 'b 'c) #'car '(a b c))) + type-error) + +;;; Order of evaluation tests + +(deftest map-into.order.1 + (let ((i 0) a b c) + (values + (map-into (progn (setf a (incf i)) (list 1 2 3 4)) + (progn (setf b (incf i)) #'identity) + (progn (setf c (incf i)) '(a b c d))) + i a b c)) + (a b c d) 3 1 2 3) + +(deftest map-into.order.2 + (let ((i 0) a b c d) + (values + (map-into (progn (setf a (incf i)) (list 1 2 3 4)) + (progn (setf b (incf i)) #'list) + (progn (setf c (incf i)) '(a b c d)) + (progn (setf d (incf i)) '(e f g h))) + i a b c d)) + ((a e) (b f) (c g) (d h)) 4 1 2 3 4) diff --git a/ansi-tests/map.lsp b/ansi-tests/map.lsp new file mode 100644 index 0000000..11316cc --- /dev/null +++ b/ansi-tests/map.lsp @@ -0,0 +1,257 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 17 20:54:48 2002 +;;;; Contains: Tests for the MAP function + +(in-package :cl-test) + +(deftest map-array.1 + (map 'list #'1+ #(1 2 3 4)) + (2 3 4 5)) + +(deftest map-array.2 + (map 'vector #'+ #(1 2 3 4) #(6 6 6 6)) + #(7 8 9 10)) + +(deftest map-array.3 + (map 'vector #'+ #(1 2 3 4 5) #(6 6 6 6)) + #(7 8 9 10)) + +(deftest map-array.4 + (map 'vector #'+ #(1 2 3 4) #(6 6 6 6 6)) + #(7 8 9 10)) + +(deftest map-array.5 + (map '(vector *) #'+ #(1 2 3 4) #(6 6 6 6)) + #(7 8 9 10)) + +(deftest map-array.6 + (map '(vector * 4) #'+ #(1 2 3 4) #(6 6 6 6)) + #(7 8 9 10)) + +;;; (deftest map-array.7 +;;; (map 'array #'identity '(a b c d e f)) +;;; #(a b c d e f)) + +;;; (deftest map-array.8 +;;; (map 'simple-array #'identity '(a b c d e f)) +;;; #(a b c d e f)) + +(deftest map-array.9 + (map 'simple-vector #'identity '(a b c d e f)) + #(a b c d e f)) + +(deftest map-array.10 + (map 'simple-vector #'cons '(a b c d e f) #(1 2 3 4 5 6)) + #((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6))) + +(deftest map-array.11 + (map 'vector #'identity '(#\a #\b #\c #\d #\e)) + #(#\a #\b #\c #\d #\e)) + +(deftest map-array.12 + (map 'vector #'identity "abcde") + #(#\a #\b #\c #\d #\e)) + +(deftest map-array.13 + (map 'vector #'identity #*000001) + #(0 0 0 0 0 1)) + +(deftest map-array.14 + (map 'list #'identity #*000001) + (0 0 0 0 0 1)) + +(deftest map-bit-vector.15 + (map 'bit-vector #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.16 + (map 'simple-bit-vector #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.17 + (map '(vector bit) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.18 + (map '(simple-vector *) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.19 + (map '(bit-vector 6) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.20 + (map '(bit-vector *) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.21 + (map '(simple-bit-vector 6) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.22 + (map '(simple-bit-vector *) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.23 + (map '(vector bit 6) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.24 + (map '(vector bit *) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-bit-vector.25 + (map '(simple-vector 6) #'identity '(0 0 0 0 0 1)) + #*000001) + +(deftest map-string.26 + (map 'string #'identity '(#\a #\b #\c #\d #\e)) + "abcde") + +(deftest map-string.27 + (map 'string #'identity "abcde") + "abcde") + +(deftest map-string.28 + (map '(vector character) #'identity '(#\a #\b #\c #\d #\e)) + "abcde") + +(deftest map-string.29 + (map '(vector character 5) #'identity '(#\a #\b #\c #\d #\e)) + "abcde") + +(deftest map-string.30 + (map '(simple-vector 5) #'identity '(#\a #\b #\c #\d #\e)) + "abcde") + +;;; Use a more elaborate form of the simple-array type specifier +;;; (deftest map-string.31 +;;; (map '(simple-array character *) #'identity "abcde") +;;; "abcde") + +;;; Use a more elaborate form of the simple-array type specifier +;;; (deftest map-string.32 +;;; (map '(simple-array character 5) #'identity "abcde") +;;; "abcde") + +(deftest map-nil.33 + (let ((a nil)) + (values (map nil #'(lambda (x) (push x a)) "abcdef") a)) + nil (#\f #\e #\d #\c #\b #\a)) + +(deftest map-nil.34 + (let ((a nil)) + (values (map nil #'(lambda (x) (push x a)) '(a b c d e)) a)) + nil (e d c b a)) + +(deftest map-nil.35 + (let ((a nil)) + (values (map nil #'(lambda (x) (push x a)) #(a b c d e)) a)) + nil (e d c b a)) + +(deftest map-nil.36 + (let ((a nil)) + (values (map nil #'(lambda (x) (push x a)) #*001011110) a)) + nil (0 1 1 1 1 0 1 0 0)) + +(deftest map-null.1 + (map 'null #'identity nil) + nil) + +(deftest map-cons.1 + (map 'cons #'identity '(a b c)) + (a b c)) + +(deftest map.error.1 + (handler-case (progn (proclaim '(optimize (safety 3))) + (eval '(map 'symbol #'identity '(a b c)))) + (error () :caught)) + :caught) + +(deftest map.error.2 + (classify-error (map '(vector * 8) #'identity '(a b c))) + type-error) + +(deftest map.error.3 + (classify-error (map 'list #'identity '(a b . c))) + type-error) + +(deftest map.error.4 + (classify-error (map)) + program-error) + +(deftest map.error.5 + (classify-error (map 'list)) + program-error) + +(deftest map.error.6 + (classify-error (map 'list #'null)) + program-error) + +(deftest map.error.7 + (classify-error (map 'list #'cons '(a b c d))) + program-error) + +(deftest map.error.8 + (classify-error (map 'list #'cons '(a b c d) '(1 2 3 4) '(5 6 7 8))) + program-error) + +(deftest map.error.9 + (classify-error (map 'list #'car '(a b c d))) + type-error) + + +;;; Test mapping on arrays with fill pointers + +(deftest map.fill.1 + (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j) + :fill-pointer 8))) + (map 'list #'identity s1)) + (a b c d e f g h)) + +(deftest map.fill.2 + (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j) + :fill-pointer 8))) + (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1)) + (1 2 3 4 5 6 7 8)) + +(deftest map.fill.3 + (let ((s1 (make-array '(10) :initial-element #\a + :element-type 'character + :fill-pointer 8))) + (map 'string #'identity s1)) + "aaaaaaaa") + +(deftest map.fill.4 + (let ((s1 (make-array '(10) :initial-element #\a + :element-type 'base-char + :fill-pointer 8))) + (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1)) + (1 2 3 4 5 6 7 8)) + +(deftest map.fill.5 + (let ((s1 (make-array '(10) :initial-element 0 + :element-type 'bit + :fill-pointer 8))) + (map 'bit-vector #'identity s1)) + #*00000000) + +(deftest map.fill.6 + (let ((s1 (make-array '(10) :initial-element 1 + :element-type 'bit + :fill-pointer 8))) + (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1)) + (1 2 3 4 5 6 7 8)) + +;;; Order of evaluation tests + +(deftest map.order.1 + (let ((i 0) a b c d) + (values + (map (progn (setf a (incf i)) 'list) + (progn (setf b (incf i)) #'list) + (progn (setf c (incf i)) '(a b c)) + (progn (setf d (incf i)) '(b c d))) + i a b c d)) + ((a b)(b c)(c d)) 4 1 2 3 4) diff --git a/ansi-tests/merge-pathnames.lsp b/ansi-tests/merge-pathnames.lsp new file mode 100644 index 0000000..7435e98 --- /dev/null +++ b/ansi-tests/merge-pathnames.lsp @@ -0,0 +1,124 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Dec 31 11:25:55 2003 +;;;; Contains: Tests of MERGE-PATHNAMES + +(in-package :cl-test) + +#| +(defun merge-pathnames-test (&rest args) + (assert (<= 1 (length args) 3)) + (let* ((p1 (car args)) + (p2 (if (cdr args) (cadr args) *default-pathname-defaults*)) + (default-version (if (cddr args) (caddr args) :newest)) + (results (multiple-value-list (apply #'merge-pathnames args)))) + (assert (= (length results) 1)) + (let ((p3 (first results))) + +|# + +(deftest merge-pathnames.1 + (let* ((p1 (make-pathname :name "foo")) + (p2 (merge-pathnames p1 p1 nil))) + (values + (equalpt (pathname-name p1) "foo") + (if (equalpt p1 p2) t + (list p1 p2)))) + t t) + +(deftest merge-pathnames.2 + (let* ((p1 (make-pathname :name "foo")) + (p2 (merge-pathnames p1 p1))) + (values + (equalpt (pathname-host p1) (pathname-host p2)) + (equalpt (pathname-device p1) (pathname-device p2)) + (equalpt (pathname-directory p1) (pathname-directory p2)) + (pathname-name p1) + (pathname-name p2) + (equalpt (pathname-type p1) (pathname-type p2)) + (if (pathname-version p1) + (equalpt (pathname-version p1) (pathname-version p2)) + (equalpt (pathname-version p2) :newest)))) + t t t "foo" "foo" t t) + +(deftest merge-pathnames.3 + (let* ((p1 (make-pathname :name "foo")) + (p2 (make-pathname :name "bar")) + (p3 (merge-pathnames p1 p2))) + (values + (equalpt (pathname-host p1) (pathname-host p3)) + (equalpt (pathname-device p1) (pathname-device p3)) + (equalpt (pathname-directory p1) (pathname-directory p3)) + (pathname-name p1) + (pathname-name p3) + (equalpt (pathname-type p1) (pathname-type p3)) + (if (pathname-version p1) + (equalpt (pathname-version p1) (pathname-version p3)) + (equalpt (pathname-version p3) :newest)))) + t t t "foo" "foo" t t) + +(deftest merge-pathnames.4 + (let* ((p1 (make-pathname :name "foo")) + (p2 (make-pathname :type "lsp")) + (p3 (merge-pathnames p1 p2))) + (values + (equalpt (pathname-host p1) (pathname-host p3)) + (equalpt (pathname-device p1) (pathname-device p3)) + (equalpt (pathname-directory p1) (pathname-directory p3)) + (pathname-name p1) + (pathname-type p2) + (pathname-type p3) + (equalpt (pathname-type p2) (pathname-type p3)) + (if (pathname-version p1) + (equalpt (pathname-version p1) (pathname-version p3)) + (equalpt (pathname-version p3) :newest)))) + t t t "foo" "lsp" "lsp" t t) + +(deftest merge-pathnames.5 + (let* ((p1 (make-pathname :name "foo")) + (p2 (make-pathname :type "lsp" :version :newest)) + (p3 (merge-pathnames p1 p2 nil))) + (values + (equalpt (pathname-host p1) (pathname-host p3)) + (equalpt (pathname-device p1) (pathname-device p3)) + (equalpt (pathname-directory p1) (pathname-directory p3)) + (pathname-name p1) + (pathname-name p3) + (pathname-type p2) + (pathname-type p3) + (equalpt (pathname-version p1) (pathname-version p3)))) + t t t "foo" "foo" "lsp" "lsp" t) + +(deftest merge-pathnames.6 + (let* ((p1 (make-pathname)) + (p2 (make-pathname :name "foo" :version :newest)) + (p3 (merge-pathnames p1 p2 nil))) + (values + (equalpt (pathname-host p1) (pathname-host p3)) + (equalpt (pathname-device p1) (pathname-device p3)) + (equalpt (pathname-directory p1) (pathname-directory p3)) + (pathname-name p2) + (pathname-name p3) + (equalpt (pathname-type p2) (pathname-type p3)) + (pathname-version p2) + (pathname-version p3))) + t t t "foo" "foo" t :newest :newest) + +(deftest merge-pathnames.7 + (let* ((p1 (make-pathname)) + (p2 *default-pathname-defaults*) + (p3 (merge-pathnames p1))) + (values + (equalpt (pathname-host p1) (pathname-host p3)) + (equalpt (pathname-host p2) (pathname-host p3)) + (equalpt (pathname-device p2) (pathname-device p3)) + (equalpt (pathname-directory p2) (pathname-directory p3)) + (equalpt (pathname-name p2) (pathname-name p3)) + (equalpt (pathname-type p2) (pathname-type p3)) + (cond + ((pathname-version p1) (equalpt (pathname-version p1) + (pathname-version p3))) + ((pathname-version p2) (equalpt (pathname-version p2) + (pathname-version p3))) + (t (equalpt (pathname-version p3) :newest))))) + t t t t t t t) diff --git a/ansi-tests/merge.lsp b/ansi-tests/merge.lsp new file mode 100644 index 0000000..688c8d8 --- /dev/null +++ b/ansi-tests/merge.lsp @@ -0,0 +1,572 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Sep 6 07:24:17 2002 +;;;; Contains: Tests for MERGE + +(in-package :cl-test) + +(deftest merge-list.1 + (let ((x (list 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'list x y #'<)) + (1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-list.2 + (let ((x nil) + (y (list 2 4 5 8 11))) + (merge 'list x y #'<)) + (2 4 5 8 11)) + +(deftest merge-list.3 + (let ((x nil) + (y (list 2 4 5 8 11))) + (merge 'list y x #'<)) + (2 4 5 8 11)) + +(deftest merge-list.4 + (merge 'list nil nil #'<) + nil) + +(deftest merge-list.5 + (let ((x (vector 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'list x y #'<)) + (1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-list.6 + (let ((x (list 1 3 7 8 10)) + (y (vector 2 4 5 8 11))) + (merge 'list x y #'<)) + (1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-list.7 + (let ((x (vector 1 3 7 8 10)) + (y (vector 2 4 5 8 11))) + (merge 'list x y #'<)) + (1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-list.8 + (let ((x (sort (list 1 3 7 8 10) #'>)) + (y (sort (list 2 4 5 8 11) #'>))) + (merge 'list x y #'< :key #'-)) + (11 10 8 8 7 5 4 3 2 1)) + +(deftest merge-list.9 + (let ((x (list 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'list x y #'< :key nil)) + (1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-list.10 + (let ((x (list 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'list x y '<)) + (1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-list.11 + (let ((x (vector)) (y (vector))) + (merge 'list x y #'<)) + nil) + +(deftest merge-list.12 + (let ((x nil) (y (vector 1 2 3))) + (merge 'list x y #'<)) + (1 2 3)) + +(deftest merge-list.13 + (let ((x (vector)) (y (list 1 2 3))) + (merge 'list x y #'<)) + (1 2 3)) + +(deftest merge-list.14 + (let ((x nil) (y (vector 1 2 3))) + (merge 'list y x #'<)) + (1 2 3)) + +(deftest merge-list.15 + (let ((x (vector)) (y (list 1 2 3))) + (merge 'list y x #'<)) + (1 2 3)) + +;;; Tests yielding vectors + +(deftest merge-vector.1 + (let ((x (list 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'vector x y #'<)) + #(1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-vector.2 + (let ((x nil) + (y (list 2 4 5 8 11))) + (merge 'vector x y #'<)) + #(2 4 5 8 11)) + +(deftest merge-vector.3 + (let ((x nil) + (y (list 2 4 5 8 11))) + (merge 'vector y x #'<)) + #(2 4 5 8 11)) + +(deftest merge-vector.4 + (merge 'vector nil nil #'<) + #()) + +(deftest merge-vector.5 + (let ((x (vector 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'vector x y #'<)) + #(1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-vector.6 + (let ((x (list 1 3 7 8 10)) + (y (vector 2 4 5 8 11))) + (merge 'vector x y #'<)) + #(1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-vector.7 + (let ((x (vector 1 3 7 8 10)) + (y (vector 2 4 5 8 11))) + (merge 'vector x y #'<)) + #(1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-vector.8 + (let ((x (sort (list 1 3 7 8 10) #'>)) + (y (sort (list 2 4 5 8 11) #'>))) + (merge 'vector x y #'< :key #'-)) + #(11 10 8 8 7 5 4 3 2 1)) + +(deftest merge-vector.9 + (let ((x (list 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'vector x y #'< :key nil)) + #(1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-vector.10 + (let ((x (list 1 3 7 8 10)) + (y (list 2 4 5 8 11))) + (merge 'vector x y '<)) + #(1 2 3 4 5 7 8 8 10 11)) + +(deftest merge-vector.11 + (let ((x (vector)) (y (vector))) + (merge 'vector x y #'<)) + #()) + +(deftest merge-vector.12 + (let ((x nil) (y (vector 1 2 3))) + (merge 'vector x y #'<)) + #(1 2 3)) + +(deftest merge-vector.13 + (let ((x (vector)) (y (list 1 2 3))) + (merge 'vector x y #'<)) + #(1 2 3)) + +(deftest merge-vector.14 + (let ((x nil) (y (vector 1 2 3))) + (merge 'vector y x #'<)) + #(1 2 3)) + +(deftest merge-vector.15 + (let ((x (vector)) (y (list 1 2 3))) + (merge 'vector y x #'<)) + #(1 2 3)) + +(deftest merge-vector.16 + (let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30) + :fill-pointer 5)) + (y (list 1 6 10))) + (merge 'vector x y #'<)) + #(1 2 5 6 8 9 10 11)) + +(deftest merge-vector.16a + (let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30) + :fill-pointer 5)) + (y (list 1 6 10))) + (merge 'vector y x #'<)) + #(1 2 5 6 8 9 10 11)) + +(deftest merge-vector.17 + (let* ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30) + :fill-pointer 5)) + (result (merge 'vector x () #'<))) + (values + (array-element-type result) + result)) + t + #(2 5 8 9 11)) + +;;; Tests on strings + +(deftest merge-string.1 + (let ((x (list #\1 #\3 #\7 #\8)) + (y (list #\2 #\4 #\5 #\9))) + (merge 'string x y #'char<)) + "12345789") + +(deftest merge-string.1a + (let ((x "1378") + (y (list #\2 #\4 #\5 #\9))) + (merge 'string x y #'char<)) + "12345789") + +(deftest merge-string.1b + (let ((x (list #\1 #\3 #\7 #\8)) + (y "2459")) + (merge 'string x y #'char<)) + "12345789") + +(deftest merge-string.1c + (let ((x "1378") + (y "2459")) + (merge 'string x y #'char<)) + "12345789") + +(deftest merge-string.1d + (let ((x "1378") + (y "2459")) + (merge 'string y x #'char<)) + "12345789") + +(deftest merge-string.2 + (let ((x nil) + (y (list #\2 #\4 #\5 #\9))) + (merge 'string x y #'char<)) + "2459") + +(deftest merge-string.3 + (let ((x nil) + (y (list #\2 #\4 #\5 #\9))) + (merge 'string y x #'char<)) + "2459") + +(deftest merge-string.4 + (merge 'string nil nil #'char<) + "") + +(deftest merge-string.8 + (let ((x (list #\1 #\3 #\7 #\8)) + (y (list #\2 #\4 #\5))) + (merge 'string x y #'char< :key #'nextdigit)) + "1234578") + +(deftest merge-string.9 + (let ((x (list #\1 #\3 #\7 #\8)) + (y (list #\2 #\4 #\5 #\9))) + (merge 'string x y #'char< :key nil)) + "12345789") + +(deftest merge-string.10 + (let ((x (list #\1 #\3 #\7 #\8)) + (y (list #\2 #\4 #\5 #\9))) + (merge 'string x y 'char<)) + "12345789") + +(deftest merge-string.11 + (let ((x (vector)) (y (vector))) + (merge 'string x y #'char<)) + "") + +(deftest merge-string.12 + (let ((x nil) (y (vector #\1 #\2 #\3))) + (merge 'string x y #'char<)) + "123") + +(deftest merge-string.13 + (let ((x (vector)) (y (list #\1 #\2 #\3))) + (merge 'string x y #'char<)) + "123") + +(deftest merge-string.13a + (let ((x (copy-seq "")) (y (list #\1 #\2 #\3))) + (merge 'string x y #'char<)) + "123") + +(deftest merge-string.14 + (let ((x nil) (y (vector #\1 #\2 #\3))) + (merge 'string y x #'char<)) + "123") + +(deftest merge-string.14a + (let ((x (copy-seq "")) (y (vector #\1 #\2 #\3))) + (merge 'string y x #'char<)) + "123") + +(deftest merge-string.15 + (let* ((x (make-array '(10) :initial-contents "adgkmpruwv" + :fill-pointer 5 :element-type 'character)) + (y (copy-seq "bci"))) + (merge 'string x y #'char<)) + "abcdgikm") + +(deftest merge-string.16 + (let* ((x (make-array '(10) :initial-contents "adgkmpruwv" + :fill-pointer 5 :element-type 'character)) + (y (copy-seq "bci"))) + (merge 'string y x #'char<)) + "abcdgikm") + +(deftest merge-string.17 + (let* ((x (make-array '(10) :initial-contents "adgkmpruwv" + :fill-pointer 5 :element-type 'character))) + (merge 'string nil x #'char<)) + "adgkm") + +(deftest merge-string.18 + (let* ((x (make-array '(10) :initial-contents "adgkmpruwv" + :fill-pointer 5 :element-type 'character))) + (merge 'string x nil #'char<)) + "adgkm") + +;;; Tests for bit vectors + +(deftest merge-bit-vector.1 + (let ((x (list 0 0 1 1 1)) + (y (list 0 0 0 1 1))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.2 + (let ((x nil) + (y (list 0 0 0 1 1))) + (merge 'bit-vector x y #'<)) + #*00011) + +(deftest merge-bit-vector.3 + (let ((x nil) + (y (list 0 0 0 1 1))) + (merge 'bit-vector y x #'<)) + #*00011) + +(deftest merge-bit-vector.4 + (merge 'bit-vector nil nil #'<) + #*) + +(deftest merge-bit-vector.5 + (let ((x (vector 0 0 1 1 1)) + (y (list 0 0 0 1 1))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.5a + (let ((x (copy-seq #*00111)) + (y (list 0 0 0 1 1))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.5b + (let ((x (list 0 0 1 1 1)) + (y (copy-seq #*00011))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.5c + (let ((x (copy-seq #*00111)) + (y (copy-seq #*00011))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.5d + (let ((x (copy-seq #*11111)) + (y (copy-seq #*00000))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.5e + (let ((x (copy-seq #*11111)) + (y (copy-seq #*00000))) + (merge 'bit-vector y x #'<)) + #*0000011111) + +(deftest merge-bit-vector.6 + (let ((x (list 0 0 1 1 1)) + (y (vector 0 0 0 1 1))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.7 + (let ((x (vector 0 0 1 1 1)) + (y (vector 0 0 0 1 1))) + (merge 'bit-vector x y #'<)) + #*0000011111) + +(deftest merge-bit-vector.8 + (let ((x (list 1 1 1 0 0)) + (y (list 1 1 0 0 0))) + (merge 'bit-vector x y #'< :key #'-)) + #*1111100000) + +(deftest merge-bit-vector.9 + (let ((x (list 0 0 1 1 1)) + (y (list 0 0 0 1 1))) + (merge 'bit-vector x y #'< :key nil)) + #*0000011111) + +(deftest merge-bit-vector.10 + (let ((x (list 0 0 1 1 1)) + (y (list 0 0 0 1 1))) + (merge 'bit-vector x y '<)) + #*0000011111) + +(deftest merge-bit-vector.11 + (let ((x (copy-seq #*)) (y (copy-seq #*))) + (merge 'bit-vector x y #'<)) + #*) + +(deftest merge-bit-vector.12 + (let ((x (copy-seq #*)) (y (copy-seq #*011))) + (merge 'bit-vector x y #'<)) + #*011) + +(deftest merge-bit-vector.13 + (let ((x (copy-seq #*)) (y (list 0 1 1))) + (merge 'bit-vector x y #'<)) + #*011) + +(deftest merge-bit-vector.14 + (let ((x nil) (y (vector 0 1 1))) + (merge 'bit-vector y x #'<)) + #*011) + +(deftest merge-bit-vector.15 + (let ((x (copy-seq #*)) (y (list 0 1 1))) + (merge 'bit-vector y x #'<)) + #*011) + +(deftest merge-bit-vector.16 + (let* ((x (make-array '(10) :initial-contents #*0001101010 + :fill-pointer 5 :element-type 'bit)) + (y (copy-seq #*001))) + (merge 'bit-vector x y #'<)) + #*00000111) + +(deftest merge-bit-vector.17 + (let* ((x (make-array '(10) :initial-contents #*0001101010 + :fill-pointer 5 :element-type 'bit)) + (y (copy-seq #*001))) + (merge 'bit-vector y x #'<)) + #*00000111) + +(deftest merge-bit-vector.18 + (let* ((x (make-array '(10) :initial-contents #*0001101010 + :fill-pointer 5 :element-type 'bit))) + (merge 'bit-vector nil x #'<)) + #*00011) + +(deftest merge-bit-vector.19 + (let* ((x (make-array '(10) :initial-contents #*0001101010 + :fill-pointer 5 :element-type 'bit))) + (merge 'bit-vector x nil #'<)) + #*00011) + + +;;; Cons (which is a recognizable subtype of list) + +(deftest merge-cons.1 + (merge 'cons (list 1 2 3) (list 4 5 6) #'<) + (1 2 3 4 5 6)) + +;;; Null, which is a recognizable subtype of list + +(deftest merge-null.1 + (merge 'null nil nil #'<) + nil) + +;;; Vectors with length + +(deftest merge-vector-length.1 + (merge '(vector * 6) (list 1 2 3) (list 4 5 6) #'<) + #(1 2 3 4 5 6)) + +(deftest merge-bit-vector-length.1 + (merge '(bit-vector 6) (list 0 1 1) (list 0 0 1) #'<) + #*000111) + +;;; Order of evaluation + +(deftest merge.order.1 + (let ((i 0) a b c d) + (values + (merge (progn (setf a (incf i)) 'list) + (progn (setf b (incf i)) (list 2 5 6)) + (progn (setf c (incf i)) (list 1 3 4)) + (progn (setf d (incf i)) #'<)) + i a b c d)) + (1 2 3 4 5 6) 4 1 2 3 4) + +;;; Tests of error situations + +(deftest merge.error.1 + (handler-case (eval + '(locally (declare (optimize (safety 3))) + (merge 'symbol (list 1 2 3) (list 4 5 6) #'<))) + (error () :caught)) + :caught) + +(deftest merge.error.2 + (classify-error (merge '(vector * 3) (list 1 2 3) (list 4 5 6) #'<)) + type-error) + +(deftest merge.error.3 + (classify-error (merge '(bit-vector 3) (list 0 0 0) (list 1 1 1) #'<)) + type-error) + +(deftest merge.error.4 + (classify-error (merge '(vector * 7) (list 1 2 3) (list 4 5 6) #'<)) + type-error) + +(deftest merge.error.5 + (classify-error (merge '(bit-vector 7) (list 0 0 0) (list 1 1 1) #'<)) + type-error) + +(deftest merge.error.6 + (classify-error (merge 'null (list 1 2 3) (list 4 5 6) #'<)) + type-error) + +(deftest merge.error.7 + (classify-error (merge)) + program-error) + +(deftest merge.error.8 + (classify-error (merge 'list)) + program-error) + +(deftest merge.error.9 + (classify-error (merge 'list (list 2 4 6))) + program-error) + +(deftest merge.error.10 + (classify-error (merge 'list (list 2 4 6) (list 1 3 5))) + program-error) + +(deftest merge.error.11 + (classify-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :bad t)) + program-error) + +(deftest merge.error.12 + (classify-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :key)) + program-error) + +(deftest merge.error.13 + (classify-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :bad t + :allow-other-keys nil)) + program-error) + +(deftest merge.error.14 + (classify-error (merge 'list (list 2 4 6) (list 1 3 5) #'< 1 2)) + program-error) + +(deftest merge.error.15 + (classify-error (locally (merge '(vector * 3) (list 1 2 3) + (list 4 5 6) #'<) + t)) + type-error) + +(deftest merge.error.16 + (classify-error (merge 'list (list 1 2) (list 3 4) #'car)) + program-error) + +(deftest merge.error.17 + (classify-error (merge 'list (list 'a 'b) (list 3 4) #'max)) + type-error) diff --git a/ansi-tests/mismatch.lsp b/ansi-tests/mismatch.lsp new file mode 100644 index 0000000..2f9b4c3 --- /dev/null +++ b/ansi-tests/mismatch.lsp @@ -0,0 +1,715 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Aug 26 23:55:29 2002 +;;;; Contains: Tests for MISMATCH + +(in-package :cl-test) + +(deftest mismatch-list.1 + (mismatch '() '(a b c)) + 0) + +(deftest mismatch-list.2 + (mismatch '(a b c d) '()) + 0) + +(deftest mismatch-list.3 + (mismatch '(a b c) '(a b c)) + nil) + +(deftest mismatch-list.4 + (mismatch '(a b c) '(a b d)) + 2) + +(deftest mismatch-list.5 + (mismatch '(a b c) '(b c) :start1 1) + nil) + +(deftest mismatch-list.6 + (mismatch '(a b c d) '(z b c e) :start1 1 :start2 1) + 3) + +(deftest mismatch-list.7 + (mismatch '(a b c d) '(z b c e) :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-list.8 + (mismatch '(1 2 3 4) '(5 6 7 8) :test #'(lambda (x y) (= x (- y 4)))) + nil) + +(deftest mismatch-list.9 + (mismatch '(1 2 3 4) '(5 6 17 8) :test #'(lambda (x y) (= x (- y 4)))) + 2) + +(deftest mismatch-list.10 + (mismatch '(1 2 3 4) '(10 11 7 123) :test-not #'(lambda (x y) (= x (- y 4)))) + 2) + +(deftest mismatch-list.11 + (mismatch '(1 2 3 4) '(5 6 17 8) :key #'evenp) + nil) + +(deftest mismatch-list.12 + (mismatch '(1 2 3 4) '(5 6 12 8) :key 'oddp) + 2) + +(deftest mismatch-list.13 + (mismatch '(1 2 3 4) '(1 2 3 4) :test 'eql) + nil) + +(deftest mismatch-list.14 + (mismatch '(1 2 3 4) '(5 6 7 8) :test-not 'eql) + nil) + +(deftest mismatch-list.15 + (mismatch '(a b c d e f g h i j k) '(a b c c e f g h z j k)) + 3) + +(deftest mismatch-list.16 + (mismatch '(a b c d e f g h i j k) '(a b c c y f g h z j k) :from-end t) + 9) + +(deftest mismatch-list.17 + (mismatch '(a b c) '(a b c a b c d) :from-end t) + 3) + +(deftest mismatch-list.18 + (mismatch '(a b c a b c d) '(a b c) :from-end t) + 7) + +(deftest mismatch-list.19 + (mismatch '(1 1 1) '(2 2 2 2 2 1 2 2) :from-end t :test-not 'eql) + 1) + +(deftest mismatch-list.20 + (mismatch '(1 1 1 1 1 1 1) '(2 3 3) :from-end t :key #'evenp) + 5) + +(deftest mismatch-list.21 + (mismatch '(1 1 1) '(2 2 2 2 2 1 2 2) :from-end t :test-not #'equal) + 1) + +(deftest mismatch-list.22 + (mismatch '(1 1 1 1 1 1 1) '(2 3 3) :from-end t :key 'evenp) + 5) + +;;; tests on vectors + +(deftest mismatch-vector.1 + (mismatch #() #(a b c)) + 0) + +(deftest mismatch-vector.2 + (mismatch #(a b c d) #()) + 0) + +(deftest mismatch-vector.3 + (mismatch #(a b c) #(a b c)) + nil) + +(deftest mismatch-vector.4 + (mismatch #(a b c) #(a b d)) + 2) + +(deftest mismatch-vector.5 + (mismatch #(a b c) #(b c) :start1 1) + nil) + +(deftest mismatch-vector.6 + (mismatch #(a b c d) #(z b c e) :start1 1 :start2 1) + 3) + +(deftest mismatch-vector.7 + (mismatch #(a b c d) #(z b c e) :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-vector.8 + (mismatch #(1 2 3 4) #(5 6 7 8) :test #'(lambda (x y) (= x (- y 4)))) + nil) + +(deftest mismatch-vector.9 + (mismatch #(1 2 3 4) #(5 6 17 8) :test #'(lambda (x y) (= x (- y 4)))) + 2) + +(deftest mismatch-vector.10 + (mismatch #(1 2 3 4) #(10 11 7 123) :test-not #'(lambda (x y) (= x (- y 4)))) + 2) + +(deftest mismatch-vector.11 + (mismatch #(1 2 3 4) #(5 6 17 8) :key #'evenp) + nil) + +(deftest mismatch-vector.12 + (mismatch #(1 2 3 4) #(5 6 12 8) :key 'oddp) + 2) + +(deftest mismatch-vector.13 + (mismatch #(1 2 3 4) #(1 2 3 4) :test 'eql) + nil) + +(deftest mismatch-vector.14 + (mismatch #(1 2 3 4) #(5 6 7 8) :test-not 'eql) + nil) + +(deftest mismatch-vector.15 + (mismatch #(a b c d e f g h i j k) #(a b c c e f g h z j k)) + 3) + +(deftest mismatch-vector.16 + (mismatch #(a b c d e f g h i j k) #(a b c c y f g h z j k) :from-end t) + 9) + +(deftest mismatch-vector.17 + (mismatch #(a b c) #(a b c a b c d) :from-end t) + 3) + +(deftest mismatch-vector.18 + (mismatch #(a b c a b c d) #(a b c) :from-end t) + 7) + +(deftest mismatch-vector.19 + (mismatch #(1 1 1) #(2 2 2 2 2 1 2 2) :from-end t :test-not 'eql) + 1) + +(deftest mismatch-vector.20 + (mismatch #(1 1 1 1 1 1 1) #(2 3 3) :from-end t :key #'evenp) + 5) + +(deftest mismatch-vector.21 + (mismatch #(1 1 1) #(2 2 2 2 2 1 2 2) :from-end t :test-not #'equal) + 1) + +(deftest mismatch-vector.22 + (mismatch #(1 1 1 1 1 1 1) #(2 3 3) :from-end t :key 'evenp) + 5) + +(deftest mismatch-vector.23 + (let ((a (make-array '(9) :initial-contents '(1 2 3 4 5 6 7 8 9) + :fill-pointer 5))) + (values + (mismatch '(1 2 3 4 5) a) + (mismatch '(1 2 3 4 5) a :from-end t) + (mismatch '(1 2 3 4) a) + (mismatch '(1 2 3 4 5 6) a) + (mismatch '(6 7 8 9) a :from-end t) + (mismatch '(2 3 4 5) a :from-end t))) + nil nil 4 5 4 0) + +(deftest mismatch-vector.24 + (let ((m (make-array '(6) :initial-contents '(1 2 3 4 5 6) + :fill-pointer 4)) + (a '(1 2 3 4 5))) + (list + (mismatch m a) + (mismatch m a :from-end t) + (setf (fill-pointer m) 5) + (mismatch m a) + (mismatch m a :from-end t) + (setf (fill-pointer m) 6) + (mismatch m a) + (mismatch m a :from-end t))) + (4 4 5 nil nil 6 5 6)) + +;;; tests on bit vectors + +(deftest mismatch-bit-vector.1 + (mismatch "" #*111) + 0) + +(deftest mismatch-bit-vector.1a + (mismatch '() #*111) + 0) + +(deftest mismatch-bit-vector.1b + (mismatch "" '(1 1 1)) + 0) + +(deftest mismatch-bit-vector.2 + (mismatch #*1010 #*) + 0) + +(deftest mismatch-bit-vector.2a + (mismatch #*1010 '()) + 0) + +(deftest mismatch-bit-vector.2b + (mismatch '(1 0 1 0) #*) + 0) + +(deftest mismatch-bit-vector.3 + (mismatch #*101 #*101) + nil) + +(deftest mismatch-bit-vector.4 + (mismatch #*101 #*100) + 2) + +(deftest mismatch-bit-vector.5 + (mismatch #*101 #*01 :start1 1) + nil) + +(deftest mismatch-bit-vector.6 + (mismatch #*0110 #*0111 :start1 1 :start2 1) + 3) + +(deftest mismatch-bit-vector.7 + (mismatch #*0110 #*0111 :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-bit-vector.7a + (mismatch '(0 1 1 0) #*0111 :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-bit-vector.7b + (mismatch #*0110 '(0 1 1 1) :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-bit-vector.8 + (mismatch #*1001 #*0110 :test #'(lambda (x y) (= x (- 1 y)))) + nil) + +(deftest mismatch-bit-vector.8a + (mismatch #*1001 '(5 4 4 5) :test #'(lambda (x y) (= x (- y 4)))) + nil) + +(deftest mismatch-bit-vector.9 + (mismatch #*1001 '(5 4 17 5) :test #'(lambda (x y) (= x (- y 4)))) + 2) + +(deftest mismatch-bit-vector.9a + (mismatch '(5 4 17 5) #*1001 :test #'(lambda (x y) (= y (- x 4)))) + 2) + +(deftest mismatch-bit-vector.9b + (mismatch #*0100 #*1001 :test #'(lambda (x y) (= x (- 1 y)))) + 2) + +(deftest mismatch-bit-vector.10 + (mismatch #*1001 '(10 11 4 123) :test-not #'(lambda (x y) (= x (- y 4)))) + 2) + +(deftest mismatch-bit-vector.10a + (mismatch #*1001 '(10 11 100 123) :test-not #'(lambda (x y) (= x (- y 4)))) + nil) + +(deftest mismatch-bit-vector.11 + (mismatch #*1010 '(5 6 17 8) :key #'evenp) + nil) + +(deftest mismatch-bit-vector.11a + (mismatch '(5 6 17 8) #*1010 :key #'evenp) + nil) + +(deftest mismatch-bit-vector.11b + (mismatch #*0101 #*1010 :key #'evenp :test-not 'eql) + nil) + +(deftest mismatch-bit-vector.11c + (mismatch '(5 6 17 8) #*10101 :key #'evenp) + 4) + +(deftest mismatch-bit-vector.11d + (mismatch '(5 6 17 8 100) #*1010 :key #'evenp) + 4) + +(deftest mismatch-bit-vector.12 + (mismatch #*1010 #*1000 :key 'oddp) + 2) + +(deftest mismatch-bit-vector.12a + (mismatch #*1010 '(5 6 8 8) :key 'oddp) + 2) + +(deftest mismatch-bit-vector.12b + (mismatch '(5 6 8 8) #*1010 :key 'oddp) + 2) + +(deftest mismatch-bit-vector.13 + (mismatch #*0001 #*0001 :test 'eql) + nil) + +(deftest mismatch-bit-vector.14 + (mismatch '#*10001 #*01110 :test-not 'eql) + nil) + +(deftest mismatch-bit-vector.15 + (mismatch #*00100010100 #*00110010000) + 3) + +(deftest mismatch-bit-vector.16 + (mismatch #*00100010100 #*00110010000 :from-end t) + 9) + +(deftest mismatch-bit-vector.17 + (mismatch #*001 #*0010010 :from-end t) + 3) + +(deftest mismatch-bit-vector.18 + (mismatch #*0010010 #*001 :from-end t) + 7) + +(deftest mismatch-bit-vector.19 + (mismatch #*000 #*11111011 :from-end t :test-not 'eql) + 1) + +(deftest mismatch-bit-vector.20 + (mismatch #*1111111 '(2 3 3) :from-end t :key #'evenp) + 5) + +(deftest mismatch-bit-vector.21 + (mismatch #*111 #*00000100 :from-end t :test-not #'equal) + 1) + +(deftest mismatch-bit-vector.22 + (mismatch #*1111111 '(2 3 3) :from-end t :key 'evenp) + 5) + +(deftest mismatch-bit-vector.23 + (let ((a (make-array '(9) :initial-contents #*001011000 + :fill-pointer 5 + :element-type 'bit))) + (values + (mismatch #*00101 a) + (mismatch #*00101 a :from-end t) + (mismatch #*0010 a) + (mismatch #*001011 a) + (mismatch #*1000 a :from-end t) + (mismatch #*0010 a :from-end t))) + nil nil 4 5 4 4) + +(deftest mismatch-bit-vector.24 + (let ((m (make-array '(6) :initial-contents #*001011 + :fill-pointer 4 + :element-type 'bit)) + (a #*00101)) + (list + (mismatch m a) + (mismatch m a :from-end t) + (setf (fill-pointer m) 5) + (mismatch m a) + (mismatch m a :from-end t) + (setf (fill-pointer m) 6) + (mismatch m a) + (mismatch m a :from-end t))) + (4 4 5 nil nil 6 5 5)) + +;;; tests on strings + +(deftest mismatch-string.1 + (mismatch "" "111") + 0) + +(deftest mismatch-string.1a + (mismatch '() "111") + 0) + +(deftest mismatch-string.1b + (mismatch "" '(1 1 1)) + 0) + +(deftest mismatch-string.2 + (mismatch "1010" "") + 0) + +(deftest mismatch-string.2a + (mismatch "1010" '()) + 0) + +(deftest mismatch-string.2b + (mismatch '(1 0 1 0) "") + 0) + +(deftest mismatch-string.3 + (mismatch "101" "101") + nil) + +(deftest mismatch-string.4 + (mismatch "101" "100") + 2) + +(deftest mismatch-string.5 + (mismatch "101" "01" :start1 1) + nil) + +(deftest mismatch-string.6 + (mismatch "0110" "0111" :start1 1 :start2 1) + 3) + +(deftest mismatch-string.7 + (mismatch "0110" "0111" :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-string.7a + (mismatch '(#\0 #\1 #\1 #\0) "0111" :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-string.7b + (mismatch "0110" '(#\0 #\1 #\1 #\1) :start1 1 :start2 1 :end1 3 :end2 3) + nil) + +(deftest mismatch-string.8 + (mismatch "1001" "0110" :test #'(lambda (x y) (eql x (if (eql y #\0) + #\1 #\0)))) + nil) + +(deftest mismatch-string.8a + (mismatch "1001" '(5 4 4 5) :test #'(lambda (x y) + (setq x (read-from-string (string x))) + (= x (- y 4)))) + nil) + +(deftest mismatch-string.9 + (mismatch "1001" '(5 4 17 5) :test #'(lambda (x y) + (setq x (read-from-string (string x))) + (= x (- y 4)))) + 2) + +(deftest mismatch-string.9a + (mismatch '(5 4 17 5) "1001" :test #'(lambda (x y) + (setq y (read-from-string (string y))) + (= y (- x 4)))) + 2) + +(deftest mismatch-string.9b + (mismatch "0100" "1001" :test #'(lambda (x y) (eql x (if (eql y #\0) #\1 #\0)))) + 2) + +(deftest mismatch-string.10 + (mismatch "1001" "0049" :test-not #'(lambda (x y) + (setq x (read-from-string (string x))) + (setq y (read-from-string (string y))) + (eql x (- y 4)))) + 2) + +(deftest mismatch-string.10a + (mismatch "1001" "3333" :test-not #'(lambda (x y) + (setq x (read-from-string (string x))) + (setq y (read-from-string (string y))) + (eql x (- y 4)))) + nil) + +(deftest mismatch-string.11 + (mismatch "1010" "5678" :key #'evendigitp) + nil) + +(deftest mismatch-string.11a + (mismatch "5678" "1010" :key #'odddigitp) + nil) + +(deftest mismatch-string.11b + (mismatch "0101" "1010" :key #'evendigitp :test-not 'eql) + nil) + +(deftest mismatch-string.11c + (mismatch "5678" "10101" :key #'evendigitp) + 4) + +(deftest mismatch-string.11d + (mismatch "56122" "1010" :key #'evendigitp) + 4) + +(deftest mismatch-string.11e + (mismatch "0101" '(#\1 #\0 #\1 #\0) :key #'evendigitp :test-not 'eql) + nil) + +(deftest mismatch-string.12 + (mismatch "1010" "1000" :key 'odddigitp) + 2) + +(deftest mismatch-string.12a + (mismatch "1010" "5688" :key 'odddigitp) + 2) + +(deftest mismatch-string.12b + (mismatch '(#\5 #\6 #\8 #\8) "1010" :key 'odddigitp) + 2) + +(deftest mismatch-string.13 + (mismatch "0001" "0001" :test 'eql) + nil) + +(deftest mismatch-string.14 + (mismatch "10001" "01110" :test-not 'eql) + nil) + +(deftest mismatch-string.15 + (mismatch "00100010100" "00110010000") + 3) + +(deftest mismatch-string.16 + (mismatch "00100010100" "00110010000" :from-end t) + 9) + +(deftest mismatch-string.17 + (mismatch "001" "0010010" :from-end t) + 3) + +(deftest mismatch-string.18 + (mismatch "0010010" "001" :from-end t) + 7) + +(deftest mismatch-string.19 + (mismatch "000" "11111011" :from-end t :test-not 'eql) + 1) + +(deftest mismatch-string.20 + (mismatch "1111111" "233" :from-end t :key #'evendigitp) + 5) + +(deftest mismatch-string.20a + (mismatch "1111111" '(#\2 #\3 #\3) :from-end t :key #'evendigitp) + 5) + +(deftest mismatch-string.21 + (mismatch "111" "00000100" :from-end t :test-not #'equal) + 1) + +(deftest mismatch-string.22 + (mismatch "1111111" "233" :from-end t :key 'evendigitp) + 5) + +(deftest mismatch-string.23 + (let ((a (make-array '(9) :initial-contents "123456789" + :fill-pointer 5 + :element-type 'character))) + (values + (mismatch "12345" a) + (mismatch "12345" a :from-end t) + (mismatch "1234" a) + (mismatch "123456" a) + (mismatch "6789" a :from-end t) + (mismatch "2345" a :from-end t))) + nil nil 4 5 4 0) + +(deftest mismatch-string.24 + (let ((m (make-array '(6) :initial-contents "123456" + :fill-pointer 4 + :element-type 'character)) + (a "12345")) + (list + (mismatch m a) + (mismatch m a :from-end t) + (setf (fill-pointer m) 5) + (mismatch m a) + (mismatch m a :from-end t) + (setf (fill-pointer m) 6) + (mismatch m a) + (mismatch m a :from-end t))) + (4 4 5 nil nil 6 5 6)) + +;;; Keyword tests + +(deftest mismatch.allow-other-keys.1 + (mismatch "1234" "1244" :allow-other-keys t :bad t) + 2) + +(deftest mismatch.allow-other-keys.2 + (mismatch "1234" "1244" :bad t :allow-other-keys t) + 2) + +(deftest mismatch.allow-other-keys.3 + (mismatch "1234" "1244" :bad t :allow-other-keys t :allow-other-keys nil) + 2) + +(deftest mismatch.allow-other-keys.4 + (mismatch "1234" "1244" :allow-other-keys t :bad t + :allow-other-keys nil) + 2) + +(deftest mismatch.allow-other-keys.5 + (mismatch "1234" "1244" :allow-other-keys t + :allow-other-keys nil + :bad t) + 2) + +(deftest mismatch.keywords.6 + (mismatch "1234" "1244" :test #'equal :test (complement #'equal)) + 2) + +(deftest mismatch.allow-other-keys.7 + (mismatch "1234" "1244" :bad t :allow-other-keys t + :test (complement #'equal)) + 0) + +;;; Order of evaluation + +(deftest mismatch.order.1 + (let ((i 0) a b) + (values + (mismatch (progn (setf a (incf i)) "abcd") + (progn (setf b (incf i)) "abzd")) + i a b)) + 2 2 1 2) + +(deftest mismatch.order.2 + (let ((i 0) a b c d e f g h j) + (values + (mismatch (progn (setf a (incf i)) "abcdef") + (progn (setf b (incf i)) "abcdef") + :key (progn (setf c (incf i)) #'identity) + :test (progn (setf d (incf i)) #'equal) + :start1 (progn (setf e (incf i)) 1) + :start2 (progn (setf f (incf i)) 1) + :end1 (progn (setf g (incf i)) 4) + :end2 (progn (setf h (incf i)) 4) + :from-end (setf j (incf i))) + i a b c d e f g h j)) + nil 9 1 2 3 4 5 6 7 8 9) + +(deftest mismatch.order.3 + (let ((i 0) a b c d e f g h j) + (values + (mismatch (progn (setf a (incf i)) "abcdef") + (progn (setf b (incf i)) "abcdef") + :from-end (setf c (incf i)) + :end2 (progn (setf d (incf i)) 4) + :end1 (progn (setf e (incf i)) 4) + :start2 (progn (setf f (incf i)) 1) + :start1 (progn (setf g (incf i)) 1) + :test (progn (setf h (incf i)) #'equal) + :key (progn (setf j (incf i)) #'identity)) + i a b c d e f g h j)) + nil 9 1 2 3 4 5 6 7 8 9) + + +;;; Error cases + +(deftest mismatch.error.1 + (classify-error (mismatch)) + program-error) + +(deftest mismatch.error.2 + (classify-error (mismatch nil)) + program-error) + +(deftest mismatch.error.3 + (classify-error (mismatch nil nil :bad t)) + program-error) + +(deftest mismatch.error.4 + (classify-error (mismatch nil nil :bad t :allow-other-keys nil)) + program-error) + +(deftest mismatch.error.5 + (classify-error (mismatch nil nil :key)) + program-error) + +(deftest mismatch.error.6 + (classify-error (mismatch nil nil 1 2)) + program-error) + +(deftest mismatch.error.7 + (classify-error (mismatch '(a b) '(a b) :test #'identity)) + program-error) + +(deftest mismatch.error.8 + (classify-error (mismatch '(a b) '(a b) :test-not #'identity)) + program-error) + +(deftest mismatch.error.9 + (classify-error (mismatch '(a b) '(a b) :key #'car)) + type-error) + +(deftest mismatch.error.10 + (classify-error (mismatch '(a b) '(a b) :key #'cons)) + program-error) diff --git a/ansi-tests/multiple-value-bind.lsp b/ansi-tests/multiple-value-bind.lsp new file mode 100644 index 0000000..9c5b855 --- /dev/null +++ b/ansi-tests/multiple-value-bind.lsp @@ -0,0 +1,62 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 23:16:23 2002 +;;;; Contains: Tests for MULTIPLE-VALUE-BIND + +(in-package :cl-test) + +(deftest multiple-value-bind.1 + (multiple-value-bind (x y z) (values 1 2 3) + (declare (type integer x)) + (declare (type integer y)) + (declare (type integer z)) + (list z y x)) + (3 2 1)) + +(deftest multiple-value-bind.2 + (multiple-value-bind (x y z) (values 1 2 3) + (let ((x 4)) + (list x y z))) + (4 2 3)) + +(deftest multiple-value-bind.3 + (multiple-value-bind (x y z) (values 1 2 3 4 5 6) + (list x y z)) + (1 2 3)) + +(deftest multiple-value-bind.4 + (multiple-value-bind (x y z) (values 1 2) + (list x y z)) + (1 2 nil)) + +(deftest multiple-value-bind.5 + (multiple-value-bind () (values 1 2) (values 'a 'b 'c)) + a b c) + +(deftest multiple-value-bind.6 + (multiple-value-bind (x y z) (values) + (list x y z)) + (nil nil nil)) + +(deftest multiple-value-bind.7 + (let ((z 0) x y) + (declare (special z)) + (values + (flet ((%x () (symbol-value 'x)) + (%y () (symbol-value 'y)) + (%z () (symbol-value 'z))) + (multiple-value-bind (x y z) (values 1 2 3) + (declare (special x y)) + (list (%x) (%y) (%z)))) + x y z)) + (1 2 0) nil nil 0) + +;;; (deftest multiple-value-bind.error.1 +;;; (classify-error (multiple-value-bind)) +;;; program-error) +;;; +;;; (deftest multiple-value-bind.error.2 +;;; (classify-error (multiple-value-bind (a b c))) +;;; program-error) + + \ No newline at end of file diff --git a/ansi-tests/multiple-value-call.lsp b/ansi-tests/multiple-value-call.lsp new file mode 100644 index 0000000..012d942 --- /dev/null +++ b/ansi-tests/multiple-value-call.lsp @@ -0,0 +1,42 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 23:35:07 2002 +;;;; Contains: Tests of MULTIPLE-VALUE-CALL, MULTIPLE-VALUE-LIST + +(in-package :cl-test) + +(deftest multiple-value-call.1 + (multiple-value-call #'+ (values 1 2) (values) 3 (values 4 5 6)) + 21) + +(deftest multiple-value-call.2 + (multiple-value-call 'list) + nil) + +(deftest multiple-value-call.3 + (multiple-value-call 'list (floor 13 4)) + (3 1)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(deftest multiple-value-list.1 + (multiple-value-list (values)) + nil) + +(deftest multiple-value-list.2 + (multiple-value-list (values 'a)) + (a)) + +(deftest multiple-value-list.3 + (multiple-value-list (values 'a 'b)) + (a b)) + +(deftest multiple-value-list.4 + (not + (loop + for i from 0 below (min multiple-values-limit 100) + for x = (make-list i :initial-element 'a) + always (equal x (multiple-value-list (values-list x))))) + nil) + + diff --git a/ansi-tests/multiple-value-list.lsp b/ansi-tests/multiple-value-list.lsp new file mode 100644 index 0000000..cdb3277 --- /dev/null +++ b/ansi-tests/multiple-value-list.lsp @@ -0,0 +1,37 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Feb 17 06:38:07 2003 +;;;; Contains: Tests of MULTIPLE-VALUE-LIST + +(in-package :cl-test) + +(deftest multiple-value-list.1 + (multiple-value-list 'a) + (a)) + +(deftest multiple-value-list.2 + (multiple-value-list (values)) + nil) + +(deftest multiple-value-list.3 + (multiple-value-list (values 'a 'b 'c 'd 'e)) + (a b c d e)) + +(deftest multiple-value-list.4 + (multiple-value-list (values (values 'a 'b 'c 'd 'e))) + (a)) + +(deftest multiple-value-list.order.1 + (let ((i 0)) + (values (multiple-value-list (incf i)) i)) + (1) 1) + +#| +(deftest multiple-value-list.error.1 + (classify-error (multiple-value-list)) + program-error) + +(deftest multiple-value-list.error.2 + (classify-error (multiple-value-list 'a 'b)) + program-error) +|# diff --git a/ansi-tests/multiple-value-prog1.lsp b/ansi-tests/multiple-value-prog1.lsp new file mode 100644 index 0000000..d8ab80c --- /dev/null +++ b/ansi-tests/multiple-value-prog1.lsp @@ -0,0 +1,71 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 06:48:02 2002 +;;;; Contains: Tests for MULTIPLE-VALUE-PROG1 + +(in-package :cl-test) + +(deftest multiple-value-prog1.1 + (multiple-value-prog1 nil) + nil) + +(deftest multiple-value-prog1.2 + (multiple-value-prog1 '(a b c)) + (a b c)) + +(deftest multiple-value-prog1.3 + (multiple-value-prog1 (values-list '(a b c))) + a b c) + +(deftest multiple-value-prog1.4 + (multiple-value-prog1 (values))) + +(deftest multiple-value-prog1.5 + (let ((x 0) (y 0)) + (multiple-value-prog1 (values x y) + (incf x) (incf y 2))) + 0 0) + +(deftest multiple-value-prog1.6 + (let ((x 0) (y 0)) + (multiple-value-call + #'list + (multiple-value-prog1 (values x y) + (incf x) (incf y 2)) + x y)) + (0 0 1 2)) + +(deftest multiple-value-prog1.7 + (let ((x 0) (y 0)) + (multiple-value-call + #'list + (multiple-value-prog1 (values (incf x) y) + (incf x x) + (incf y 10)) + x y)) + (1 0 2 10)) + + +(deftest multiple-value-prog1.8 + (let* ((n (min 100 multiple-values-limit))) + (not-mv + (loop for i from 0 below n + for x = (make-int-list i) + always + (equalt + (multiple-value-list + (eval `(multiple-value-prog1 (values-list (quote ,(copy-seq x))) + nil))) + x)))) + nil) + + +(deftest multiple-value-prog1.9 + (let ((x 0) (y 0)) + (values + (block foo + (multiple-value-prog1 + (values (incf x) (incf y 2)) + (return-from foo 'a))) + x y)) + a 1 2) diff --git a/ansi-tests/multiple-value-setq.lsp b/ansi-tests/multiple-value-setq.lsp new file mode 100644 index 0000000..088ff88 --- /dev/null +++ b/ansi-tests/multiple-value-setq.lsp @@ -0,0 +1,109 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 07:00:57 2002 +;;;; Contains: Tests of MULTIPLE-VALUE-SETQ + +(in-package :cl-test) + +(deftest multiple-value-setq.1 + (let ((x 1) (y 2)) + (values + (multiple-value-list + (multiple-value-setq (x y) (values 3 4))) + x y)) + (3) 3 4) + +(deftest multiple-value-setq.2 + (let (x) + (multiple-value-setq (x) (values 1 2)) + x) + 1) + +(deftest multiple-value-setq.3 + (let (x) + (symbol-macrolet ((y x)) + (multiple-value-setq (y) (values 1 2)) + x)) + 1) + +(deftest multiple-value-setq.4 + (let ((x (list nil))) + (symbol-macrolet ((y (car x))) + (multiple-value-setq (y) (values 1 2)) + x)) + (1)) + +;;; test of order of evaluation +;;; The (INCF I) should be evaluated before the assigned form I. +(deftest multiple-value-setq.5 + (let ((i 0) (x (list nil))) + (symbol-macrolet ((y (car (progn (incf i) x)))) + (multiple-value-setq (y) i)) + x) + (1)) + +(deftest multiple-value-setq.6 + (let ((x (list nil)) z) + (symbol-macrolet ((y (car x))) + (multiple-value-setq (y z) (values 1 2))) + (values x z)) + (1) 2) + +(deftest multiple-value-setq.7 + (let ((x (list nil)) (z (list nil))) + (symbol-macrolet ((y (car x)) + (w (car z))) + (multiple-value-setq (y w) (values 1 2))) + (values x z)) + (1) (2)) + +;;; Another order of evaluation tests, this time with two +;;; symbol macro arguments +(deftest multiple-value-setq.8 + (let ((x (list nil)) (z (list nil)) (i 0)) + (symbol-macrolet ((y (car (progn (incf i 3) x))) + (w (car (progn (incf i i) z)))) + (multiple-value-setq (y w) (values i 10))) + (values x z)) + (6) (10)) + +(deftest multiple-value-setq.9 + (let (x) + (values + (multiple-value-setq (x x) (values 1 2)) + x)) + 1 2) + +(deftest multiple-value-setq.10 + (let (x) + (values + (multiple-value-setq (x x) (values 1)) + x)) + 1 nil) + +(deftest multiple-value-setq.11 + (let ((x 1) (y 2) (z 3)) + (multiple-value-setq (x y z) (values)) + (values x y z)) + nil nil nil) + + +(deftest multiple-value-setq.12 + (let ((n (min 100 multiple-values-limit)) + (vars nil) + (result nil)) + (loop + for i from 1 below n + for form = + (progn + (push (gensym) vars) + (push i result) + `(let ,vars + (and (eql (multiple-value-setq ,vars (values-list (quote ,result))) + ,(car result)) + (equal ,(make-list-expr vars) + (quote ,result))))) + unless (eval form) + collect (list i form))) + nil) + diff --git a/ansi-tests/namestring.lsp b/ansi-tests/namestring.lsp new file mode 100644 index 0000000..794ab9c --- /dev/null +++ b/ansi-tests/namestring.lsp @@ -0,0 +1,64 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Sep 2 07:24:42 2004 +;;;; Contains: Tests for NAMESTRING + +(in-package :cl-test) + +(deftest namestring.1 + (let* ((vals (multiple-value-list (namestring "namestring.lsp"))) + (s (first vals))) + (if (and (null (cdr vals)) + (stringp s) + (equal (namestring s) s)) + :good + vals)) + :good) + +(deftest namestring.2 + (do-special-strings + (s "namestring.lsp" nil) + (let ((ns (namestring s))) + (assert (stringp ns)) + (assert (string= (namestring ns) ns)))) + nil) + +;;; I'm not convinced these tested required behavior, so I'm commenting +;;; them out for now. FIXME: determine if they are bogus +#| +(deftest namestring.3 + (let* ((name "namestring.lsp") + (pn (merge-pathnames (pathname name))) + (name2 (namestring pn)) + (pn2 (pathname name2))) + (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) + (pathname-directory pn) (pathname-name pn) + (pathname-type pn) (pathname-version pn)) + (list pn2 (pathname-host pn2) (pathname-device pn2) + (pathname-directory pn2) (pathname-name pn2) + (pathname-type pn2) (pathname-version pn2))))) + t) + +(deftest namestring.4 + (let* ((name "namestring.lsp") + (pn (merge-pathnames (pathname name))) + (name2 (with-open-file (s pn :direction :input) (namestring s))) + (pn2 (pathname name2))) + (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) + (pathname-directory pn) (pathname-name pn) + (pathname-type pn) (pathname-version pn)) + (list pn2 (pathname-host pn2) (pathname-device pn2) + (pathname-directory pn2) (pathname-name pn2) + (pathname-type pn2) (pathname-version pn2))))) + t) +|# + +;;; Error tests + +(deftest namestring.error.1 + (signals-error (namestring) program-error) + t) + +(deftest namestring.error.2 + (signals-error (namestring "namestring.lsp" nil) program-error) + t) diff --git a/ansi-tests/nil.lsp b/ansi-tests/nil.lsp new file mode 100644 index 0000000..b0f5674 --- /dev/null +++ b/ansi-tests/nil.lsp @@ -0,0 +1,44 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 06:32:46 2002 +;;;; Contains: Tests for NIL + +(in-package :cl-test) + +(deftest nil.1 + (loop for x in *universe* + thereis (subtypep (type-of x) nil)) + nil) + + +(deftest nil.2 + (loop for x in *universe* + unless (subtypep nil (type-of x)) + collect (type-of x)) + nil) + +(deftest nil.3 + (not-mv (constantp nil)) + nil) + +(deftest nil.4 + (car nil) + nil) + +(deftest nil.5 + (cdr nil) + nil) + +(deftest nil.6 + (eval nil) + nil) + +(deftest nil.7 + (symbol-value nil) + nil) + +(deftest nil.8 + (eqt nil 'nil) + t) + +;;; NIL is, of course, present in many other files diff --git a/ansi-tests/not-and-null.lsp b/ansi-tests/not-and-null.lsp new file mode 100644 index 0000000..e4fdf56 --- /dev/null +++ b/ansi-tests/not-and-null.lsp @@ -0,0 +1,59 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 06:38:33 2002 +;;;; Contains: Tests of NOT and NULL + +(in-package :cl-test) + +(deftest null.1 + (null nil) + t) + +(deftest null.2 + (null t) + nil) + +(deftest null.3 + (some #'(lambda (x) (and x (null x))) *universe*) + nil) + +(deftest null.4 + (not (some #'null + `(1 a 1.2 "a" #\w (a) ,*terminal-io* + #'car (make-array '(10))))) + t) + +(deftest null.error.1 + (classify-error (null)) + program-error) + +(deftest null.error.2 + (classify-error (null nil nil)) + program-error) + +(deftest not.1 + (not nil) + t) + +(deftest not.2 + (not t) + nil) + +(deftest not.3 + (some #'(lambda (x) (and x (not x))) *universe*) + nil) + +(deftest not.4 + (not (some #'not + `(1 a 1.2 "a" #\w (a) ,*terminal-io* + #'car (make-array '(10))))) + t) + + +(deftest not.error.1 + (classify-error (not)) + program-error) + +(deftest not.error.2 + (classify-error (not nil nil)) + program-error) diff --git a/ansi-tests/notany.lsp b/ansi-tests/notany.lsp new file mode 100644 index 0000000..66491af --- /dev/null +++ b/ansi-tests/notany.lsp @@ -0,0 +1,142 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 07:14:14 2002 +;;;; Contains: Tests for NOTANY + +(in-package :cl-test) + +(deftest notany.1 + (not-mv (notany #'identity nil)) + nil) + +(deftest notany.2 + (not-mv (notany #'identity #())) + nil) + +(deftest notany.3 + (let ((count 0)) + (values + (notany #'(lambda (x) (incf count) (if (>= x 10) x nil)) + '(1 2 4 13 5 1)) + count)) + nil 4) + +(deftest notany.4 + (not-mv (notany #'/= '(1 2 3 4) '(1 2 3 4 5))) + nil) + +(deftest notany.5 + (not-mv (notany #'/= '(1 2 3 4 5) '(1 2 3 4))) + nil) + +(deftest notany.6 + (notany #'/= '(1 2 3 4 5) '(1 2 3 4 6)) + nil) + +(deftest notany.7 + (not-mv (notany #'(lambda (x y) (and x y)) + '(nil t t nil t) #(t nil nil t nil nil))) + nil) + +(deftest notany.8 + (let* ((x '(1)) + (args (list x))) + (not + (loop for i from 2 below (1- (min 100 call-arguments-limit)) + do (push x args) + always (apply #'notany #'/= args)))) + nil) + +(deftest notany.9 + (not-mv (notany #'zerop #*11111111111111)) + nil) + +(deftest notany.10 + (not-mv (notany #'zerop #*)) + nil) + +(deftest notany.11 + (notany #'zerop #*1111111011111) + nil) + +(deftest notany.12 + (not-mv (notany #'(lambda (x) (not (eql x #\a))) "aaaaaaaa")) + nil) + +(deftest notany.13 + (not-mv (notany #'(lambda (x) (eql x #\a)) "")) + nil) + +(deftest notany.14 + (notany #'(lambda (x) (not (eql x #\a))) "aaaaaabaaaa") + nil) + +(deftest notany.15 + (not-mv (notany 'null '(1 2 3 4))) + nil) + +(deftest notany.16 + (notany 'null '(1 2 3 nil 5)) + nil) + +(deftest notany.order.1 + (let ((i 0) a b) + (values + (not (notany (progn (setf a (incf i)) 'null) + (progn (setf b (incf i)) '(a b c)))) + i a b)) + nil 2 1 2) + +;;; Error cases + +(deftest notany.error.1 + (classify-error (notany 1 '(a b c))) + type-error) + +(deftest notany.error.2 + (classify-error (notany #\a '(a b c))) + type-error) + +(deftest notany.error.3 + (classify-error (notany #() '(a b c))) + type-error) + +(deftest notany.error.4 + (classify-error (notany #'null 'a)) + type-error) + +(deftest notany.error.5 + (classify-error (notany #'null 100)) + type-error) + +(deftest notany.error.6 + (classify-error (notany #'null 'a)) + type-error) + +(deftest notany.error.7 + (classify-error (notany #'eq () 'a)) + type-error) + +(deftest notany.error.8 + (classify-error (notany)) + program-error) + +(deftest notany.error.9 + (classify-error (notany #'null)) + program-error) + +(deftest notany.error.10 + (classify-error (locally (notany 1 '(a b c)) t)) + type-error) + +(deftest notany.error.11 + (classify-error (notany #'cons '(a b c))) + program-error) + +(deftest notany.error.12 + (classify-error (notany #'cons '(a b c) '(1 2 4) '(g h j))) + program-error) + +(deftest notany.error.13 + (classify-error (notany #'car '(a b c))) + type-error) \ No newline at end of file diff --git a/ansi-tests/notevery.lsp b/ansi-tests/notevery.lsp new file mode 100644 index 0000000..35ddba1 --- /dev/null +++ b/ansi-tests/notevery.lsp @@ -0,0 +1,142 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 07:20:12 2002 +;;;; Contains: Tests for NOTEVERY + +(in-package :cl-test) + +(deftest notevery.1 + (notevery #'identity nil) + nil) + +(deftest notevery.2 + (notevery #'identity #()) + nil) + +(deftest notevery.3 + (let ((count 0)) + (values + (not (notevery #'(lambda (x) (incf count) (< x 10)) + '(1 2 4 13 5 1))) + count)) + nil 4) + +(deftest notevery.4 + (notevery #'= '(1 2 3 4) '(1 2 3 4 5)) + nil) + +(deftest notevery.5 + (notevery #'= '(1 2 3 4 5) '(1 2 3 4)) + nil) + +(deftest notevery.6 + (not-mv (notevery #'= '(1 2 3 4 5) '(1 2 3 4 6))) + nil) + +(deftest notevery.7 + (notevery #'(lambda (x y) (or x y)) + '(nil t t nil t) #(t nil t t nil nil)) + nil) + +(deftest notevery.8 + (let ((x '(1)) + (args nil)) + (not + (loop for i from 1 below (1- (min 100 call-arguments-limit)) + do (push x args) + always (not (apply #'notevery #'= args))))) + nil) + +(deftest notevery.9 + (notevery #'zerop #*000000000000) + nil) + +(deftest notevery.10 + (notevery #'zerop #*) + nil) + +(deftest notevery.11 + (not-mv (notevery #'zerop #*0000010000)) + nil) + +(deftest notevery.12 + (notevery #'(lambda (x) (eql x #\a)) "aaaaaaaa") + nil) + +(deftest notevery.13 + (notevery #'(lambda (x) (eql x #\a)) "") + nil) + +(deftest notevery.14 + (not-mv (notevery #'(lambda (x) (eql x #\a)) "aaaaaabaaaa")) + nil) + +(deftest notevery.15 + (not-mv (notevery 'null '(nil nil t nil))) + nil) + +(deftest notevery.16 + (notevery 'null '(nil nil nil nil)) + nil) + +(deftest notevery.order.1 + (let ((i 0) a b) + (values + (notevery (progn (setf a (incf i)) #'identity) + (progn (setf b (incf i)) '(a b c d))) + i a b)) + nil 2 1 2) + +;;; Error cases + +(deftest notevery.error.1 + (classify-error (notevery 1 '(a b c))) + type-error) + +(deftest notevery.error.2 + (classify-error (notevery #\a '(a b c))) + type-error) + +(deftest notevery.error.3 + (classify-error (notevery #() '(a b c))) + type-error) + +(deftest notevery.error.4 + (classify-error (notevery #'null 'a)) + type-error) + +(deftest notevery.error.5 + (classify-error (notevery #'null 100)) + type-error) + +(deftest notevery.error.6 + (classify-error (notevery #'null 'a)) + type-error) + +(deftest notevery.error.7 + (classify-error (notevery #'eq () 'a)) + type-error) + +(deftest notevery.error.8 + (classify-error (notevery)) + program-error) + +(deftest notevery.error.9 + (classify-error (notevery #'null)) + program-error) + +(deftest notevery.error.10 + (classify-error (locally (notevery 1 '(a b c)) t)) + type-error) + +(deftest notevery.error.11 + (classify-error (notevery #'cons '(a b c))) + program-error) + +(deftest notevery.error.12 + (classify-error (notevery #'cons '(a b c) '(1 2 4) '(g h j))) + program-error) + +(deftest notevery.error.13 + (classify-error (notevery #'car '(a b c))) + type-error) \ No newline at end of file diff --git a/ansi-tests/nreverse.lsp b/ansi-tests/nreverse.lsp new file mode 100644 index 0000000..d752aa0 --- /dev/null +++ b/ansi-tests/nreverse.lsp @@ -0,0 +1,126 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 21 00:04:57 2002 +;;;; Contains: Tests for NREVERSE + +(in-package :cl-test) + +(deftest nreverse-list.1 + (nreverse nil) + nil) + +(deftest nreverse-list.2 + (let ((x (copy-seq '(a b c)))) + (nreverse x)) + (c b a)) + +(deftest nreverse-vector.1 + (nreverse #()) + #()) + +(deftest nreverse-vector.2 + (let ((x (copy-seq #(a b c d e)))) + (nreverse x)) + #(e d c b a)) + +(deftest nreverse-nonsimple-vector.1 + (let ((x (make-array 0 :fill-pointer t :adjustable t))) + (nreverse x)) + #()) + +(deftest nreverse-nonsimple-vector.2 + (let* ((x (make-array 5 :initial-contents '(1 2 3 4 5) + :fill-pointer t :adjustable t)) + (y (nreverse x))) + (values y (equalt (type-of x) (type-of y)))) + #(5 4 3 2 1) + t) + +(deftest nreverse-nonsimple-vector.3 + (let* ((x (make-array 10 :initial-contents '(1 2 3 4 5 6 7 8 9 10) + :fill-pointer 5)) + (y (nreverse x))) + (values y (equalt (type-of x) (type-of y)))) + #(5 4 3 2 1) + t) + +(deftest nreverse-bit-vector.1 + (nreverse #*) + #*) + +(deftest nreverse-bit-vector.2 + (let ((x (copy-seq #*000110110110))) + (nreverse x)) + #*011011011000) + +(deftest nreverse-bit-vector.3 + (let* ((x (make-array 10 :initial-contents '(0 0 0 1 1 0 1 0 1 0) + :fill-pointer 5 + :element-type 'bit)) + (y (nreverse x))) + y) + #*11000) + +(deftest nreverse-string.1 + (nreverse "") + "") + +(deftest nreverse-string.2 + (let ((x (copy-seq "000110110110"))) + (nreverse x)) + "011011011000") + +(deftest nreverse-string.3 + (let* ((x (make-array 10 :initial-contents "abcdefghij" + :fill-pointer 5 + :element-type 'character)) + (y (nreverse x))) + y) + "edcba") + +(deftest nreverse-string.4 + (let* ((x (make-array 10 :initial-contents "abcdefghij" + :fill-pointer 5 + :element-type 'base-char)) + (y (nreverse x))) + y) + "edcba") + +(deftest nreverse.order.1 + (let ((i 0)) + (values + (nreverse (progn (incf i) (list 'a 'b 'c 'd))) + i)) + (d c b a) 1) + +(deftest nreverse.error.1 + (classify-error (nreverse 'a)) + type-error) + +(deftest nreverse.error.2 + (classify-error (nreverse #\a)) + type-error) + +(deftest nreverse.error.3 + (classify-error (nreverse 10)) + type-error) + +(deftest nreverse.error.4 + (classify-error (nreverse 0.3)) + type-error) + +(deftest nreverse.error.5 + (classify-error (nreverse 10/3)) + type-error) + +(deftest nreverse.error.6 + (classify-error (nreverse)) + program-error) + +(deftest nreverse.error.7 + (classify-error (nreverse nil nil)) + program-error) + +(deftest nreverse.error.8 + (classify-error (locally (nreverse 'a) t)) + type-error) diff --git a/ansi-tests/nstring-capitalize.lsp b/ansi-tests/nstring-capitalize.lsp new file mode 100644 index 0000000..9c9eb17 --- /dev/null +++ b/ansi-tests/nstring-capitalize.lsp @@ -0,0 +1,108 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 3 21:38:49 2002 +;;;; Contains: Tests for NSTRING-CAPITALIZE + +(in-package :cl-test) + +(deftest nstring-capitalize.1 + (let* ((s (copy-seq "abCd")) + (s2 (nstring-capitalize s))) + (values (eqt s s2) s)) + t "Abcd") + +(deftest nstring-capitalize.2 + (let* ((s (copy-seq "0adA2Cdd3wXy")) + (s2 (nstring-capitalize s))) + (values (eqt s s2) s)) + t "0ada2cdd3wxy") + +(deftest nstring-capitalize.3 + (let* ((s (copy-seq "1a")) + (s2 (nstring-capitalize s))) + (values (eqt s s2) s)) + t "1a") + +(deftest nstring-capitalize.4 + (let* ((s (copy-seq "a1a")) + (s2 (nstring-capitalize s))) + (values (eqt s s2) s)) + t "A1a") + +(deftest nstring-capitalize.7 + (let ((s "ABCDEF")) + (loop for i from 0 to 5 + collect (nstring-capitalize (copy-seq s) :start i))) + ("Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF")) + +(deftest nstring-capitalize.8 + (let ((s "ABCDEF")) + (loop for i from 0 to 5 + collect (nstring-capitalize (copy-seq s) :start i :end nil))) + ("Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF")) + +(deftest nstring-capitalize.9 + (let ((s "ABCDEF")) + (loop for i from 0 to 6 + collect (nstring-capitalize (copy-seq s) :end i))) + ("ABCDEF" "ABCDEF" "AbCDEF" "AbcDEF" "AbcdEF" "AbcdeF" "Abcdef")) + +(deftest nstring-capitalize.10 + (let ((s "ABCDEF")) + (loop for i from 0 to 5 + collect (loop for j from i to 6 + collect (nstring-capitalize (copy-seq s) + :start i :end j)))) + (("ABCDEF" "ABCDEF" "AbCDEF" "AbcDEF" "AbcdEF" "AbcdeF" "Abcdef") + ("ABCDEF" "ABCDEF" "ABcDEF" "ABcdEF" "ABcdeF" "ABcdef") + ("ABCDEF" "ABCDEF" "ABCdEF" "ABCdeF" "ABCdef") + ("ABCDEF" "ABCDEF" "ABCDeF" "ABCDef") + ("ABCDEF" "ABCDEF" "ABCDEf") + ("ABCDEF" "ABCDEF"))) + +(deftest nstring-capitalize.order.1 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (nstring-capitalize + (progn (setf a (incf i)) s) + :start (progn (setf b (incf i)) 1) + :end (progn (setf c (incf i)) 4)) + i a b c)) + "aBcdef" 3 1 2 3) + +(deftest nstring-capitalize.order.2 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (nstring-capitalize + (progn (setf a (incf i)) s) + :end (progn (setf b (incf i)) 4) + :start (progn (setf c (incf i)) 1)) + i a b c)) + "aBcdef" 3 1 2 3) + +;;; Error cases + +(deftest nstring-capitalize.error.1 + (classify-error (nstring-capitalize)) + program-error) + +(deftest nstring-capitalize.error.2 + (classify-error (nstring-capitalize (copy-seq "abc") :bad t)) + program-error) + +(deftest nstring-capitalize.error.3 + (classify-error (nstring-capitalize (copy-seq "abc") :start)) + program-error) + +(deftest nstring-capitalize.error.4 + (classify-error (nstring-capitalize (copy-seq "abc") :bad t + :allow-other-keys nil)) + program-error) + +(deftest nstring-capitalize.error.5 + (classify-error (nstring-capitalize (copy-seq "abc") :end)) + program-error) + +(deftest nstring-capitalize.error.6 + (classify-error (nstring-capitalize (copy-seq "abc") 1 2)) + program-error) diff --git a/ansi-tests/nstring-downcase.lsp b/ansi-tests/nstring-downcase.lsp new file mode 100644 index 0000000..409bc3c --- /dev/null +++ b/ansi-tests/nstring-downcase.lsp @@ -0,0 +1,118 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 3 21:33:16 2002 +;;;; Contains: Tests for NSTRING-DOWNCASE + +(in-package :cl-test) + +(deftest nstring-downcase.1 + (let* ((s (copy-seq "A")) + (s2 (nstring-downcase s))) + (values (eqt s s2) s)) + t "a") + +(deftest nstring-downcase.2 + (let* ((s (copy-seq "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) + (s2 (nstring-downcase s))) + (values (eqt s s2) s)) + t + "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz") + +(deftest nstring-downcase.3 + (let* ((s (copy-seq "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ")) + (s2 (nstring-downcase s))) + (values (eqt s s2) s)) + t + "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ") + +(deftest nstring-downcase.6 + (let* ((s (make-array 6 :element-type 'character + :initial-contents '(#\A #\B #\C #\D #\E #\F))) + (s2 (nstring-downcase s))) + (values (eqt s s2) s)) + t "abcdef") + +(deftest nstring-downcase.7 + (let* ((s (make-array 6 :element-type 'standard-char + :initial-contents '(#\A #\B #\7 #\D #\E #\F))) + (s2 (nstring-downcase s))) + (values (eqt s s2) s)) + t + "ab7def") + +;; Tests with :start, :end + +(deftest nstring-downcase.8 + (let ((s "ABCDEF")) + (loop for i from 0 to 6 + collect (nstring-downcase (copy-seq s) :start i))) + ("abcdef" "Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF")) + +(deftest nstring-downcase.9 + (let ((s "ABCDEF")) + (loop for i from 0 to 6 + collect (nstring-downcase (copy-seq s) :start i :end nil))) + ("abcdef" "Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF")) + +(deftest nstring-downcase.10 + (let ((s "ABCDE")) + (loop for i from 0 to 4 + collect (loop for j from i to 5 + collect (string-invertcase + (nstring-downcase (copy-seq s) + :start i :end j))))) + (("abcde" "Abcde" "ABcde" "ABCde" "ABCDe" "ABCDE") + ("abcde" "aBcde" "aBCde" "aBCDe" "aBCDE") + ("abcde" "abCde" "abCDe" "abCDE") + ("abcde" "abcDe" "abcDE") + ("abcde" "abcdE"))) + +(deftest nstring-downcase.order.1 + (let ((i 0) a b c (s (copy-seq "ABCDEF"))) + (values + (nstring-downcase + (progn (setf a (incf i)) s) + :start (progn (setf b (incf i)) 1) + :end (progn (setf c (incf i)) 4)) + i a b c)) + "AbcdEF" 3 1 2 3) + +(deftest nstring-downcase.order.2 + (let ((i 0) a b c (s (copy-seq "ABCDEF"))) + (values + (nstring-downcase + (progn (setf a (incf i)) s) + :end (progn (setf b (incf i)) 4) + :start (progn (setf c (incf i)) 1)) + i a b c)) + "AbcdEF" 3 1 2 3) + +;;; Error cases + +(deftest nstring-downcase.error.1 + (classify-error (nstring-downcase)) + program-error) + +(deftest nstring-downcase.error.2 + (classify-error (nstring-downcase (copy-seq "abc") :bad t)) + program-error) + +(deftest nstring-downcase.error.3 + (classify-error (nstring-downcase (copy-seq "abc") :start)) + program-error) + +(deftest nstring-downcase.error.4 + (classify-error (nstring-downcase (copy-seq "abc") :bad t + :allow-other-keys nil)) + program-error) + +(deftest nstring-downcase.error.5 + (classify-error (nstring-downcase (copy-seq "abc") :end)) + program-error) + +(deftest nstring-downcase.error.6 + (classify-error (nstring-downcase (copy-seq "abc") 1 2)) + program-error) + + + diff --git a/ansi-tests/nstring-upcase.lsp b/ansi-tests/nstring-upcase.lsp new file mode 100644 index 0000000..5f6baf1 --- /dev/null +++ b/ansi-tests/nstring-upcase.lsp @@ -0,0 +1,115 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 3 21:12:40 2002 +;;;; Contains: Tests for NSTRING-UPCASE + +(in-package :cl-test) + +(deftest nstring-upcase.1 + (let* ((s (copy-seq "a")) + (s2 (nstring-upcase s))) + (values (eqt s s2) s)) + t "A") + +(deftest nstring-upcase.2 + (let* ((s (copy-seq "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) + (s2 (nstring-upcase s))) + (values (eqt s s2) s)) + t + "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ") + +(deftest nstring-upcase.3 + (let* ((s (copy-seq "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ")) + (s2 (nstring-upcase s))) + (values (eqt s s2) s)) + t + "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ") + +(deftest nstring-upcase.6 + (let* ((s (make-array 6 :element-type 'character + :initial-contents '(#\a #\b #\c #\d #\e #\f))) + (s2 (nstring-upcase s))) + (values (eqt s s2) s)) + t "ABCDEF") + +(deftest nstring-upcase.7 + (let* ((s (make-array 6 :element-type 'standard-char + :initial-contents '(#\a #\b #\7 #\d #\e #\f))) + (s2 (nstring-upcase s))) + (values (eqt s s2) s)) + t "AB7DEF") + +;; Tests with :start, :end + +(deftest nstring-upcase.8 + (let ((s "abcdef")) + (loop for i from 0 to 6 + collect (nstring-upcase (copy-seq s) :start i))) + ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef")) + +(deftest nstring-upcase.9 + (let ((s "abcdef")) + (loop for i from 0 to 6 + collect + (nstring-upcase (copy-seq s) :start i :end nil))) + ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef")) + +(deftest nstring-upcase.10 + (let ((s "abcde")) + (loop for i from 0 to 4 + collect (loop for j from i to 5 + collect (nstring-upcase (copy-seq s) + :start i :end j)))) + (("abcde" "Abcde" "ABcde" "ABCde" "ABCDe" "ABCDE") + ("abcde" "aBcde" "aBCde" "aBCDe" "aBCDE") + ("abcde" "abCde" "abCDe" "abCDE") + ("abcde" "abcDe" "abcDE") + ("abcde" "abcdE"))) + +(deftest nstring-upcase.order.1 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (nstring-upcase + (progn (setf a (incf i)) s) + :start (progn (setf b (incf i)) 1) + :end (progn (setf c (incf i)) 4)) + i a b c)) + "aBCDef" 3 1 2 3) + +(deftest nstring-upcase.order.2 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (nstring-upcase + (progn (setf a (incf i)) s) + :end (progn (setf b (incf i)) 4) + :start (progn (setf c (incf i)) 1)) + i a b c)) + "aBCDef" 3 1 2 3) + + +;;; Error cases + +(deftest nstring-upcase.error.1 + (classify-error (nstring-upcase)) + program-error) + +(deftest nstring-upcase.error.2 + (classify-error (nstring-upcase (copy-seq "abc") :bad t)) + program-error) + +(deftest nstring-upcase.error.3 + (classify-error (nstring-upcase (copy-seq "abc") :start)) + program-error) + +(deftest nstring-upcase.error.4 + (classify-error (nstring-upcase (copy-seq "abc") :bad t + :allow-other-keys nil)) + program-error) + +(deftest nstring-upcase.error.5 + (classify-error (nstring-upcase (copy-seq "abc") :end)) + program-error) + +(deftest nstring-upcase.error.6 + (classify-error (nstring-upcase (copy-seq "abc") 1 2)) + program-error) diff --git a/ansi-tests/nsubstitute-if-not.lsp b/ansi-tests/nsubstitute-if-not.lsp new file mode 100644 index 0000000..78528a3 --- /dev/null +++ b/ansi-tests/nsubstitute-if-not.lsp @@ -0,0 +1,761 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 31 19:00:55 2002 +;;;; Contains: Tests for NSUBSTITUTE-IF-NOT + +(in-package :cl-test) + +(deftest nsubstitute-if-not-list.1 + (nsubstitute-if-not 'b 'identity nil) + nil) + +(deftest nsubstitute-if-not-list.2 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x) x) + (b b b c)) + +(deftest nsubstitute-if-not-list.3 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count nil)) + (b b b c)) + +(deftest nsubstitute-if-not-list.4 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 2)) + (b b b c)) + +(deftest nsubstitute-if-not-list.5 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 1)) + (b b a c)) + +(deftest nsubstitute-if-not-list.6 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 0)) + (a b a c)) + +(deftest nsubstitute-if-not-list.7 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count -1)) + (a b a c)) + +(deftest nsubstitute-if-not-list.8 + (nsubstitute-if-not 'b (is-not-eq-p 'a) nil :from-end t) + nil) + +(deftest nsubstitute-if-not-list.9 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :from-end t)) + (b b b c)) + +(deftest nsubstitute-if-not-list.10 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :from-end t :count nil)) + (b b b c)) + +(deftest nsubstitute-if-not-list.11 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 2 :from-end t)) + (b b b c)) + +(deftest nsubstitute-if-not-list.12 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 1 :from-end t)) + (a b b c)) + +(deftest nsubstitute-if-not-list.13 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 0 :from-end t)) + (a b a c)) + +(deftest nsubstitute-if-not-list.14 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count -1 :from-end t)) + (a b a c)) + +(deftest nsubstitute-if-not-list.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-not-list.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :from-end t))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-not-list.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 (+ i c)) :initial-element 'a))))))) + t) + +(deftest nsubstitute-if-not-list.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c :from-end t))) + (equal y (nconc (make-list (- j c) :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +;;; Tests on vectors + +(deftest nsubstitute-if-not-vector.1 + (let ((x #())) (nsubstitute-if-not 'b (is-not-eq-p 'a) x)) + #()) + +(deftest nsubstitute-if-not-vector.2 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x)) + #(b b b c)) + +(deftest nsubstitute-if-not-vector.3 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count nil) x) + #(b b b c)) + +(deftest nsubstitute-if-not-vector.4 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 2)) + #(b b b c)) + +(deftest nsubstitute-if-not-vector.5 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 1)) + #(b b a c)) + +(deftest nsubstitute-if-not-vector.6 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 0)) + #(a b a c)) + +(deftest nsubstitute-if-not-vector.7 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count -1)) + #(a b a c)) + +(deftest nsubstitute-if-not-vector.8 + (let ((x #())) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :from-end t)) + #()) + +(deftest nsubstitute-if-not-vector.9 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :from-end t)) + #(b b b c)) + +(deftest nsubstitute-if-not-vector.10 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :from-end t :count nil)) + #(b b b c)) + +(deftest nsubstitute-if-not-vector.11 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 2 :from-end t)) + #(b b b c)) + +(deftest nsubstitute-if-not-vector.12 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 1 :from-end t)) + #(a b b c)) + +(deftest nsubstitute-if-not-vector.13 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count 0 :from-end t)) + #(a b a c)) + +(deftest nsubstitute-if-not-vector.14 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if-not 'b (is-not-eq-p 'a) x :count -1 :from-end t)) + #(a b a c)) + +(deftest nsubstitute-if-not-vector.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-not-vector.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :from-end t))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-not-vector.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 (+ i c)) :initial-element 'a))))))) + t) + +(deftest nsubstitute-if-not-vector.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c :from-end t))) + (equalp y (concatenate 'simple-vector + (make-array (- j c) :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest nsubstitute-if-not-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x))) + result) + #(z b z c b)) + +(deftest nsubstitute-if-not-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x :from-end t))) + result) + #(z b z c b)) + +(deftest nsubstitute-if-not-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x :count 1))) + result) + #(z b a c b)) + +(deftest nsubstitute-if-not-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x + :from-end t :count 1))) + result) + #(a b z c b)) + +;;; Tests on strings + +(deftest nsubstitute-if-not-string.1 + (let ((x "")) (nsubstitute-if-not #\b (is-not-eq-p #\a) x)) + "") + +(deftest nsubstitute-if-not-string.2 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x)) + "bbbc") + +(deftest nsubstitute-if-not-string.3 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count nil)) + "bbbc") + +(deftest nsubstitute-if-not-string.4 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count 2)) + "bbbc") + +(deftest nsubstitute-if-not-string.5 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count 1)) + "bbac") + +(deftest nsubstitute-if-not-string.6 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count 0)) + "abac") + +(deftest nsubstitute-if-not-string.7 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count -1)) + "abac") + +(deftest nsubstitute-if-not-string.8 + (let ((x "")) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :from-end t)) + "") + +(deftest nsubstitute-if-not-string.9 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :from-end t)) + "bbbc") + +(deftest nsubstitute-if-not-string.10 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :from-end t :count nil)) + "bbbc") + +(deftest nsubstitute-if-not-string.11 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count 2 :from-end t)) + "bbbc") + +(deftest nsubstitute-if-not-string.12 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count 1 :from-end t)) + "abbc") + +(deftest nsubstitute-if-not-string.13 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count 0 :from-end t)) + "abac") + +(deftest nsubstitute-if-not-string.14 + (let ((x (copy-seq "abac"))) (nsubstitute-if-not #\b (is-not-eq-p #\a) x :count -1 :from-end t)) + "abac") + +(deftest nsubstitute-if-not-string.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if-not #\x (is-not-eq-p #\a) x :start i :end j))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))) + t) + +(deftest nsubstitute-if-not-string.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if-not #\x (is-not-eq-p #\a) x :start i :end j :from-end t))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))) + t) + +(deftest nsubstitute-if-not-string.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if-not #\x (is-not-eq-p #\a) x :start i :end j :count c))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 (+ i c)) :initial-element #\a))))))) + t) + +(deftest nsubstitute-if-not-string.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if-not #\x (is-not-eq-p #\a) x :start i :end j :count c :from-end t))) + (equalp y (concatenate 'simple-string + (make-array (- j c) :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest nsubstitute-if-not-string.28 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x))) + result) + "zbzcb") + +(deftest nsubstitute-if-not-string.29 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x :from-end t))) + result) + "zbzcb") + +(deftest nsubstitute-if-not-string.30 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x :count 1))) + result) + "zbacb") + +(deftest nsubstitute-if-not-string.31 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x + :from-end t :count 1))) + result) + "abzcb") + + +;;; Tests on bit-vectors + +(deftest nsubstitute-if-not-bit-vector.1 + (let* ((orig #*) + (x (copy-seq orig)) + (result (nsubstitute-if-not 0 (is-not-eq-p 1) x))) + result) + #*) + +(deftest nsubstitute-if-not-bit-vector.2 + (let* ((orig #*) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x))) + result) + #*) + +(deftest nsubstitute-if-not-bit-vector.3 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 0 (is-not-eq-p 1) x))) + result) + #*000000) + +(deftest nsubstitute-if-not-bit-vector.4 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x))) + result) + #*111111) + +(deftest nsubstitute-if-not-bit-vector.5 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :start 1))) + result) + #*011111) + +(deftest nsubstitute-if-not-bit-vector.6 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 0 (is-not-eq-p 1) x :start 2 :end nil))) + result) + #*010000) + +(deftest nsubstitute-if-not-bit-vector.7 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :end 4))) + result) + #*111101) + +(deftest nsubstitute-if-not-bit-vector.8 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end nil))) + result) + #*000000) + +(deftest nsubstitute-if-not-bit-vector.9 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end 3))) + result) + #*000101) + +(deftest nsubstitute-if-not-bit-vector.10 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 0 (is-not-eq-p 1) x :start 2 :end 4))) + result) + #*010001) + +(deftest nsubstitute-if-not-bit-vector.11 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :start 2 :end 4))) + result) + #*011101) + +(deftest nsubstitute-if-not-bit-vector.12 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 1))) + result) + #*110101) + +(deftest nsubstitute-if-not-bit-vector.13 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 0))) + result) + #*010101) + +(deftest nsubstitute-if-not-bit-vector.14 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count -1))) + result) + #*010101) + +(deftest nsubstitute-if-not-bit-vector.15 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 1 :from-end t))) + result) + #*010111) + +(deftest nsubstitute-if-not-bit-vector.16 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 0 :from-end t))) + result) + #*010101) + +(deftest nsubstitute-if-not-bit-vector.17 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count -1 :from-end t))) + result) + #*010101) + +(deftest nsubstitute-if-not-bit-vector.18 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count nil))) + result) + #*111111) + +(deftest nsubstitute-if-not-bit-vector.19 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count nil :from-end t))) + result) + #*111111) + +(deftest nsubstitute-if-not-bit-vector.20 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*0000000000) + (x (copy-seq orig)) + (y (nsubstitute-if-not 1 (is-not-eq-p 0) x :start i :end j :count c))) + (equalp y (concatenate + 'simple-bit-vector + (make-list i :initial-element 0) + (make-list c :initial-element 1) + (make-list (- 10 (+ i c)) :initial-element 0))))))) + t) + +(deftest nsubstitute-if-not-bit-vector.21 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*1111111111) + (x (copy-seq orig)) + (y (nsubstitute-if-not 0 (is-not-eq-p 1) x :start i :end j :count c :from-end t))) + (equalp y (concatenate + 'simple-bit-vector + (make-list (- j c) :initial-element 1) + (make-list c :initial-element 0) + (make-list (- 10 j) :initial-element 1))))))) + t) + + +;;; More tests + +(deftest nsubstitute-if-not-list.24 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if-not '(a 10) (is-not-eq-p 'a) x :key #'car))) + result) + ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest nsubstitute-if-not-list.25 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if-not '(a 10) (is-not-eq-p 'a) x + :key #'car :start 1 :end 5))) + result) + ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest nsubstitute-if-not-vector.24 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if-not '(a 10) (is-not-eq-p 'a) x :key #'car))) + result) + #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest nsubstitute-if-not-vector.25 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if-not '(a 10) (is-not-eq-p 'a) x :key #'car :start 1 :end 5))) + result) + #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest nsubstitute-if-not-string.24 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute-if-not #\a (is-not-eq-p #\1) x :key #'nextdigit))) + result) + "a1a2342a15") + +(deftest nsubstitute-if-not-string.25 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute-if-not #\a (is-not-eq-p #\1) x :key #'nextdigit :start 1 :end 6))) + result) + "01a2342015") + +(deftest nsubstitute-if-not-bit-vector.26 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 1) x :key #'1+))) + result) + #*11111111111111111) + +(deftest nsubstitute-if-not-bit-vector.27 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (nsubstitute-if-not 1 (is-not-eq-p 1) x :key #'1+ :start 1 :end 10))) + result) + #*01111111111010110) + +(deftest nsubstitute-if-not-bit-vector.30 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if-not 1 #'onep x))) + result) + #*11111) + +(deftest nsubstitute-if-not-bit-vector.31 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if-not 1 #'onep x :from-end t))) + result) + #*11111) + +(deftest nsubstitute-if-not-bit-vector.32 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if-not 1 #'onep x :count 1))) + result) + #*11011) + +(deftest nsubstitute-if-not-bit-vector.33 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if-not 1 #'onep x :from-end t :count 1))) + result) + #*01111) + +(deftest nsubstitute-if-not.order.1 + (let ((i 0) a b c d e f g h) + (values + (nsubstitute-if-not + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'identity) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :count (progn (setf d (incf i)) 2) + :start (progn (setf e (incf i)) 0) + :end (progn (setf f (incf i)) 7) + :key (progn (setf g (incf i)) #'identity) + :from-end (setf h (incf i)) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 4 5 6 7 8) + +(deftest nsubstitute-if-not.order.2 + (let ((i 0) a b c d e f g h) + (values + (nsubstitute-if-not + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'identity) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :from-end (setf h (incf i)) + :key (progn (setf g (incf i)) #'identity) + :end (progn (setf f (incf i)) 7) + :start (progn (setf e (incf i)) 0) + :count (progn (setf d (incf i)) 2) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 8 7 6 5 4) + + +;;; Keyword tests + +(deftest nsubstitute-if-not.allow-other-keys.1 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :allow-other-keys t :bad t) + (a a 0 a a 0 a)) + +(deftest nsubstitute-if-not.allow-other-keys.2 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :bad t :allow-other-keys t) + (a a 0 a a 0 a)) + +(deftest nsubstitute-if-not.allow-other-keys.3 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :allow-other-keys nil :bad t) + (a a 0 a a 0 a)) + +(deftest nsubstitute-if-not.allow-other-keys.4 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :bad t + :allow-other-keys t :allow-other-keys nil) + (a a 0 a a 0 a)) + +(deftest nsubstitute-if-not.allow-other-keys.5 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :allow-other-keys t :key #'1-) + (1 a a a 1 a a)) + +(deftest nsubstitute-if-not.keywords.6 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :key #'1- :key #'identity) + (1 a a a 1 a a)) + +(deftest nsubstitute-if-not.allow-other-keys.7 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :bad t :allow-other-keys nil) + (a a 0 a a 0 a)) + +(deftest nsubstitute-if-not.allow-other-keys.8 + (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) + (a a 0 a a 0 a)) + + +;;; Error cases + +(deftest nsubstitute-if-not.error.1 + (classify-error (nsubstitute-if-not)) + program-error) + +(deftest nsubstitute-if-not.error.2 + (classify-error (nsubstitute-if-not 'a)) + program-error) + +(deftest nsubstitute-if-not.error.3 + (classify-error (nsubstitute-if-not 'a #'null)) + program-error) + +(deftest nsubstitute-if-not.error.4 + (classify-error (nsubstitute-if-not 'a #'null nil 'bad t)) + program-error) + +(deftest nsubstitute-if-not.error.5 + (classify-error (nsubstitute-if-not 'a #'null nil + 'bad t :allow-other-keys nil)) + program-error) + +(deftest nsubstitute-if-not.error.6 + (classify-error (nsubstitute-if-not 'a #'null nil :key)) + program-error) + +(deftest nsubstitute-if-not.error.7 + (classify-error (nsubstitute-if-not 'a #'null nil 1 2)) + program-error) + +(deftest nsubstitute-if-not.error.8 + (classify-error (nsubstitute-if-not 'a #'cons (list 'a 'b 'c))) + program-error) + +(deftest nsubstitute-if-not.error.9 + (classify-error (nsubstitute-if-not 'a #'car (list 'a 'b 'c))) + type-error) + +(deftest nsubstitute-if-not.error.10 + (classify-error (nsubstitute-if-not 'a #'identity (list 'a 'b 'c) + :key #'car)) + type-error) + +(deftest nsubstitute-if-not.error.11 + (classify-error (nsubstitute-if-not 'a #'identity (list 'a 'b 'c) + :key #'cons)) + program-error) + diff --git a/ansi-tests/nsubstitute-if.lsp b/ansi-tests/nsubstitute-if.lsp new file mode 100644 index 0000000..91f7ade --- /dev/null +++ b/ansi-tests/nsubstitute-if.lsp @@ -0,0 +1,753 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 31 18:56:41 2002 +;;;; Contains: Tests for NSUBSTITUTE-IF + +(in-package :cl-test) + +(deftest nsubstitute-if-list.1 + (nsubstitute-if 'b 'identity nil) + nil) + +(deftest nsubstitute-if-list.2 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x) x) + (b b b c)) + +(deftest nsubstitute-if-list.3 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count nil)) + (b b b c)) + +(deftest nsubstitute-if-list.4 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 2)) + (b b b c)) + +(deftest nsubstitute-if-list.5 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 1)) + (b b a c)) + +(deftest nsubstitute-if-list.6 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 0)) + (a b a c)) + +(deftest nsubstitute-if-list.7 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count -1)) + (a b a c)) + +(deftest nsubstitute-if-list.8 + (nsubstitute-if 'b (is-eq-p 'a) nil :from-end t) + nil) + +(deftest nsubstitute-if-list.9 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :from-end t)) + (b b b c)) + +(deftest nsubstitute-if-list.10 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :from-end t :count nil)) + (b b b c)) + +(deftest nsubstitute-if-list.11 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 2 :from-end t)) + (b b b c)) + +(deftest nsubstitute-if-list.12 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 1 :from-end t)) + (a b b c)) + +(deftest nsubstitute-if-list.13 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 0 :from-end t)) + (a b a c)) + +(deftest nsubstitute-if-list.14 + (let ((x (copy-seq '(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count -1 :from-end t)) + (a b a c)) + +(deftest nsubstitute-if-list.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-list.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j :from-end t))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-list.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j :count c))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 (+ i c)) :initial-element 'a))))))) + t) + +(deftest nsubstitute-if-list.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j :count c :from-end t))) + (equal y (nconc (make-list (- j c) :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +;;; Tests on vectors + +(deftest nsubstitute-if-vector.1 + (let ((x #())) (nsubstitute-if 'b (is-eq-p 'a) x)) + #()) + +(deftest nsubstitute-if-vector.2 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x)) + #(b b b c)) + +(deftest nsubstitute-if-vector.3 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count nil) x) + #(b b b c)) + +(deftest nsubstitute-if-vector.4 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 2)) + #(b b b c)) + +(deftest nsubstitute-if-vector.5 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 1)) + #(b b a c)) + +(deftest nsubstitute-if-vector.6 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 0)) + #(a b a c)) + +(deftest nsubstitute-if-vector.7 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count -1)) + #(a b a c)) + +(deftest nsubstitute-if-vector.8 + (let ((x #())) (nsubstitute-if 'b (is-eq-p 'a) x :from-end t)) + #()) + +(deftest nsubstitute-if-vector.9 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :from-end t)) + #(b b b c)) + +(deftest nsubstitute-if-vector.10 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :from-end t :count nil)) + #(b b b c)) + +(deftest nsubstitute-if-vector.11 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 2 :from-end t)) + #(b b b c)) + +(deftest nsubstitute-if-vector.12 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 1 :from-end t)) + #(a b b c)) + +(deftest nsubstitute-if-vector.13 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count 0 :from-end t)) + #(a b a c)) + +(deftest nsubstitute-if-vector.14 + (let ((x (copy-seq #(a b a c)))) (nsubstitute-if 'b (is-eq-p 'a) x :count -1 :from-end t)) + #(a b a c)) + +(deftest nsubstitute-if-vector.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-vector.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j :from-end t))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-if-vector.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j :count c))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 (+ i c)) :initial-element 'a))))))) + t) + +(deftest nsubstitute-if-vector.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute-if 'x (is-eq-p 'a) x :start i :end j :count c :from-end t))) + (equalp y (concatenate 'simple-vector + (make-array (- j c) :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest nsubstitute-if-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if 'z (is-eql-p 'a) x))) + result) + #(z b z c b)) + +(deftest nsubstitute-if-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if 'z (is-eql-p 'a) x :from-end t))) + result) + #(z b z c b)) + +(deftest nsubstitute-if-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if 'z (is-eql-p 'a) x :count 1))) + result) + #(z b a c b)) + +(deftest nsubstitute-if-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute-if 'z (is-eql-p 'a) x :from-end t :count 1))) + result) + #(a b z c b)) + +;;; Tests on strings + +(deftest nsubstitute-if-string.1 + (let ((x "")) (nsubstitute-if #\b (is-eq-p #\a) x)) + "") + +(deftest nsubstitute-if-string.2 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x)) + "bbbc") + +(deftest nsubstitute-if-string.3 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count nil)) + "bbbc") + +(deftest nsubstitute-if-string.4 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count 2)) + "bbbc") + +(deftest nsubstitute-if-string.5 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count 1)) + "bbac") + +(deftest nsubstitute-if-string.6 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count 0)) + "abac") + +(deftest nsubstitute-if-string.7 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count -1)) + "abac") + +(deftest nsubstitute-if-string.8 + (let ((x "")) (nsubstitute-if #\b (is-eq-p #\a) x :from-end t)) + "") + +(deftest nsubstitute-if-string.9 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :from-end t)) + "bbbc") + +(deftest nsubstitute-if-string.10 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :from-end t :count nil)) + "bbbc") + +(deftest nsubstitute-if-string.11 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count 2 :from-end t)) + "bbbc") + +(deftest nsubstitute-if-string.12 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count 1 :from-end t)) + "abbc") + +(deftest nsubstitute-if-string.13 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count 0 :from-end t)) + "abac") + +(deftest nsubstitute-if-string.14 + (let ((x (copy-seq "abac"))) (nsubstitute-if #\b (is-eq-p #\a) x :count -1 :from-end t)) + "abac") + +(deftest nsubstitute-if-string.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if #\x (is-eq-p #\a) x :start i :end j))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))) + t) + +(deftest nsubstitute-if-string.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if #\x (is-eq-p #\a) x :start i :end j :from-end t))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))) + t) + +(deftest nsubstitute-if-string.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if #\x (is-eq-p #\a) x :start i :end j :count c))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 (+ i c)) :initial-element #\a))))))) + t) + +(deftest nsubstitute-if-string.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute-if #\x (is-eq-p #\a) x :start i :end j :count c :from-end t))) + (equalp y (concatenate 'simple-string + (make-array (- j c) :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest nsubstitute-if-string.28 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if #\z (is-eql-p #\a) x))) + result) + "zbzcb") + +(deftest nsubstitute-if-string.29 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if #\z (is-eql-p #\a) x :from-end t))) + result) + "zbzcb") + +(deftest nsubstitute-if-string.30 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if #\z (is-eql-p #\a) x :count 1))) + result) + "zbacb") + +(deftest nsubstitute-if-string.31 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute-if #\z (is-eql-p #\a) x :from-end t :count 1))) + result) + "abzcb") + + +;;; Tests on bit-vectors + +(deftest nsubstitute-if-bit-vector.1 + (let* ((orig #*) + (x (copy-seq orig)) + (result (nsubstitute-if 0 (is-eq-p 1) x))) + result) + #*) + +(deftest nsubstitute-if-bit-vector.2 + (let* ((orig #*) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x))) + result) + #*) + +(deftest nsubstitute-if-bit-vector.3 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 0 (is-eq-p 1) x))) + result) + #*000000) + +(deftest nsubstitute-if-bit-vector.4 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x))) + result) + #*111111) + +(deftest nsubstitute-if-bit-vector.5 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :start 1))) + result) + #*011111) + +(deftest nsubstitute-if-bit-vector.6 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 0 (is-eq-p 1) x :start 2 :end nil))) + result) + #*010000) + +(deftest nsubstitute-if-bit-vector.7 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :end 4))) + result) + #*111101) + +(deftest nsubstitute-if-bit-vector.8 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 0 (is-eq-p 1) x :end nil))) + result) + #*000000) + +(deftest nsubstitute-if-bit-vector.9 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 0 (is-eq-p 1) x :end 3))) + result) + #*000101) + +(deftest nsubstitute-if-bit-vector.10 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 0 (is-eq-p 1) x :start 2 :end 4))) + result) + #*010001) + +(deftest nsubstitute-if-bit-vector.11 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :start 2 :end 4))) + result) + #*011101) + +(deftest nsubstitute-if-bit-vector.12 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count 1))) + result) + #*110101) + +(deftest nsubstitute-if-bit-vector.13 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count 0))) + result) + #*010101) + +(deftest nsubstitute-if-bit-vector.14 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count -1))) + result) + #*010101) + +(deftest nsubstitute-if-bit-vector.15 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count 1 :from-end t))) + result) + #*010111) + +(deftest nsubstitute-if-bit-vector.16 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count 0 :from-end t))) + result) + #*010101) + +(deftest nsubstitute-if-bit-vector.17 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count -1 :from-end t))) + result) + #*010101) + +(deftest nsubstitute-if-bit-vector.18 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count nil))) + result) + #*111111) + +(deftest nsubstitute-if-bit-vector.19 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 0) x :count nil :from-end t))) + result) + #*111111) + +(deftest nsubstitute-if-bit-vector.20 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*0000000000) + (x (copy-seq orig)) + (y (nsubstitute-if 1 (is-eq-p 0) x :start i :end j :count c))) + (equalp y (concatenate + 'simple-bit-vector + (make-list i :initial-element 0) + (make-list c :initial-element 1) + (make-list (- 10 (+ i c)) :initial-element 0))))))) + t) + +(deftest nsubstitute-if-bit-vector.21 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*1111111111) + (x (copy-seq orig)) + (y (nsubstitute-if 0 (is-eq-p 1) x :start i :end j :count c :from-end t))) + (equalp y (concatenate + 'simple-bit-vector + (make-list (- j c) :initial-element 1) + (make-list c :initial-element 0) + (make-list (- 10 j) :initial-element 1))))))) + t) + +;;; More tests + +(deftest nsubstitute-if-list.24 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if '(a 10) (is-eq-p 'a) x :key #'car))) + result) + ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest nsubstitute-if-list.25 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if '(a 10) (is-eq-p 'a) x + :key #'car :start 1 :end 5))) + result) + ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest nsubstitute-if-vector.24 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if '(a 10) (is-eq-p 'a) x :key #'car))) + result) + #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest nsubstitute-if-vector.25 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute-if '(a 10) (is-eq-p 'a) x :key #'car :start 1 :end 5))) + result) + #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest nsubstitute-if-string.24 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute-if #\a (is-eq-p #\1) x :key #'nextdigit))) + result) + "a1a2342a15") + +(deftest nsubstitute-if-string.25 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute-if #\a (is-eq-p #\1) x :key #'nextdigit :start 1 :end 6))) + result) + "01a2342015") + +(deftest nsubstitute-if-bit-vector.26 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 1) x :key #'1+))) + result) + #*11111111111111111) + +(deftest nsubstitute-if-bit-vector.27 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (nsubstitute-if 1 (is-eq-p 1) x :key #'1+ :start 1 :end 10))) + result) + #*01111111111010110) + +(deftest nsubstitute-if-bit-vector.30 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if 1 #'zerop x))) + result) + #*11111) + +(deftest nsubstitute-if-bit-vector.31 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if 1 #'zerop x :from-end t))) + result) + #*11111) + +(deftest nsubstitute-if-bit-vector.32 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if 1 #'zerop x :count 1))) + result) + #*11011) + +(deftest nsubstitute-if-bit-vector.33 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute-if 1 #'zerop x :from-end t :count 1))) + result) + #*01111) + +(deftest nsubstitute-if.order.1 + (let ((i 0) a b c d e f g h) + (values + (nsubstitute-if + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'null) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :count (progn (setf d (incf i)) 2) + :start (progn (setf e (incf i)) 0) + :end (progn (setf f (incf i)) 7) + :key (progn (setf g (incf i)) #'identity) + :from-end (setf h (incf i)) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 4 5 6 7 8) + +(deftest nsubstitute-if.order.2 + (let ((i 0) a b c d e f g h) + (values + (nsubstitute-if + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'null) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :from-end (setf h (incf i)) + :key (progn (setf g (incf i)) #'identity) + :end (progn (setf f (incf i)) 7) + :start (progn (setf e (incf i)) 0) + :count (progn (setf d (incf i)) 2) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 8 7 6 5 4) + + +;;; Keyword tests + +(deftest nsubstitute-if.allow-other-keys.1 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t :bad t) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute-if.allow-other-keys.2 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :bad t :allow-other-keys t) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute-if.allow-other-keys.3 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :allow-other-keys nil :bad t) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute-if.allow-other-keys.4 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :bad t + :allow-other-keys t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute-if.allow-other-keys.5 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) + :allow-other-keys t :key #'1-) + (a 2 0 3 a 0 3)) + +(deftest nsubstitute-if.keywords.6 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :key #'1- :key #'identity) + (a 2 0 3 a 0 3)) + +(deftest nsubstitute-if.allow-other-keys.7 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :bad t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute-if.allow-other-keys.8 + (nsubstitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +;;; Error cases + +(deftest nsubstitute-if.error.1 + (classify-error (nsubstitute-if)) + program-error) + +(deftest nsubstitute-if.error.2 + (classify-error (nsubstitute-if 'a)) + program-error) + +(deftest nsubstitute-if.error.3 + (classify-error (nsubstitute-if 'a #'null)) + program-error) + +(deftest nsubstitute-if.error.4 + (classify-error (nsubstitute-if 'a #'null nil 'bad t)) + program-error) + +(deftest nsubstitute-if.error.5 + (classify-error (nsubstitute-if 'a #'null nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest nsubstitute-if.error.6 + (classify-error (nsubstitute-if 'a #'null nil :key)) + program-error) + +(deftest nsubstitute-if.error.7 + (classify-error (nsubstitute-if 'a #'null nil 1 2)) + program-error) + +(deftest nsubstitute-if.error.8 + (classify-error (nsubstitute-if 'a #'cons (list 'a 'b 'c))) + program-error) + +(deftest nsubstitute-if.error.9 + (classify-error (nsubstitute-if 'a #'car (list 'a 'b 'c))) + type-error) + +(deftest nsubstitute-if.error.10 + (classify-error (nsubstitute-if 'a #'identity (list 'a 'b 'c) + :key #'car)) + type-error) + +(deftest nsubstitute-if.error.11 + (classify-error (nsubstitute-if 'a #'identity (list 'a 'b 'c) + :key #'cons)) + program-error) + diff --git a/ansi-tests/nsubstitute.lsp b/ansi-tests/nsubstitute.lsp new file mode 100644 index 0000000..ea6a6b0 --- /dev/null +++ b/ansi-tests/nsubstitute.lsp @@ -0,0 +1,957 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 31 16:56:48 2002 +;;;; Contains: Tests for NSUBSTITUTE + +(in-package :cl-test) + +(deftest nsubstitute-list.1 + (nsubstitute 'b 'a nil) + nil) + +(deftest nsubstitute-list.2 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x) x) + (b b b c)) + +(deftest nsubstitute-list.3 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count nil)) + (b b b c)) + +(deftest nsubstitute-list.4 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count 2)) + (b b b c)) + +(deftest nsubstitute-list.5 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count 1)) + (b b a c)) + +(deftest nsubstitute-list.6 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count 0)) + (a b a c)) + +(deftest nsubstitute-list.7 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count -1)) + (a b a c)) + +(deftest nsubstitute-list.8 + (nsubstitute 'b 'a nil :from-end t) + nil) + +(deftest nsubstitute-list.9 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :from-end t)) + (b b b c)) + +(deftest nsubstitute-list.10 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :from-end t :count nil)) + (b b b c)) + +(deftest nsubstitute-list.11 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count 2 :from-end t)) + (b b b c)) + +(deftest nsubstitute-list.12 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count 1 :from-end t)) + (a b b c)) + +(deftest nsubstitute-list.13 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count 0 :from-end t)) + (a b a c)) + +(deftest nsubstitute-list.14 + (let ((x (copy-seq '(a b a c)))) (nsubstitute 'b 'a x :count -1 :from-end t)) + (a b a c)) + +(deftest nsubstitute-list.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-list.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j :from-end t))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-list.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j :count c))) + (equal y (nconc (make-list i :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 (+ i c)) :initial-element 'a))))))) + t) + +(deftest nsubstitute-list.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j :count c :from-end t))) + (equal y (nconc (make-list (- j c) :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +(deftest nsubstitute-list.19 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (result (nsubstitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2))))) + result) + (1 2 x x x x x 8 9)) + +(deftest nsubstitute-list.20 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (nsubstitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a))))) + result) + (1 2 x 4 5 6 7 8 9)) + + +(deftest nsubstitute-list.21 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (nsubstitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a)) + :from-end t))) + result) + (1 2 3 4 5 6 7 x 9)) + +(deftest nsubstitute-list.22 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (nsubstitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a))))) + result) + (1 2 x 4 5 6 7 8 9)) + + +(deftest nsubstitute-list.23 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (nsubstitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a)) + :from-end t))) + result) + (1 2 3 4 5 6 7 x 9)) + +;;; Tests on vectors + +(deftest nsubstitute-vector.1 + (let ((x #())) (values (nsubstitute 'b 'a x) x)) + #() #()) + +(deftest nsubstitute-vector.2 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x)) + #(b b b c)) + +(deftest nsubstitute-vector.3 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count nil) x) + #(b b b c)) + +(deftest nsubstitute-vector.4 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count 2)) + #(b b b c)) + +(deftest nsubstitute-vector.5 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count 1)) + #(b b a c)) + +(deftest nsubstitute-vector.6 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count 0)) + #(a b a c)) + +(deftest nsubstitute-vector.7 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count -1)) + #(a b a c)) + +(deftest nsubstitute-vector.8 + (let ((x #())) (nsubstitute 'b 'a x :from-end t)) + #()) + +(deftest nsubstitute-vector.9 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :from-end t)) + #(b b b c)) + +(deftest nsubstitute-vector.10 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :from-end t :count nil)) + #(b b b c)) + +(deftest nsubstitute-vector.11 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count 2 :from-end t)) + #(b b b c)) + +(deftest nsubstitute-vector.12 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count 1 :from-end t)) + #(a b b c)) + +(deftest nsubstitute-vector.13 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count 0 :from-end t)) + #(a b a c)) + +(deftest nsubstitute-vector.14 + (let ((x (copy-seq #(a b a c)))) (nsubstitute 'b 'a x :count -1 :from-end t)) + #(a b a c)) + +(deftest nsubstitute-vector.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-vector.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j :from-end t))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))) + t) + +(deftest nsubstitute-vector.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j :count c))) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 (+ i c)) :initial-element 'a))))))) + t) + +(deftest nsubstitute-vector.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (nsubstitute 'x 'a x :start i :end j :count c :from-end t))) + (equalp y (concatenate 'simple-vector + (make-array (- j c) :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest nsubstitute-vector.19 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (result (nsubstitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2))))) + result) + #(1 2 x x x x x 8 9)) + +(deftest nsubstitute-vector.20 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (nsubstitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a))))) + result) + #(1 2 x 4 5 6 7 8 9)) + + +(deftest nsubstitute-vector.21 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (nsubstitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a)) + :from-end t))) + result) + #(1 2 3 4 5 6 7 x 9)) + +(deftest nsubstitute-vector.22 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (nsubstitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a))))) + result) + #(1 2 x 4 5 6 7 8 9)) + +(deftest nsubstitute-vector.23 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (nsubstitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a)) + :from-end t))) + result) + #(1 2 3 4 5 6 7 x 9)) + +(deftest nsubstitute-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x))) + result) + #(z b z c b)) + +(deftest nsubstitute-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x :from-end t))) + result) + #(z b z c b)) + +(deftest nsubstitute-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x :count 1))) + result) + #(z b a c b)) + +(deftest nsubstitute-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x :from-end t :count 1))) + result) + #(a b z c b)) + +;;; Tests on strings + +(deftest nsubstitute-string.1 + (let ((x "")) (nsubstitute #\b #\a x)) + "") + +(deftest nsubstitute-string.2 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x)) + "bbbc") + +(deftest nsubstitute-string.3 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count nil)) + "bbbc") + +(deftest nsubstitute-string.4 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count 2)) + "bbbc") + +(deftest nsubstitute-string.5 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count 1)) + "bbac") + +(deftest nsubstitute-string.6 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count 0)) + "abac") + +(deftest nsubstitute-string.7 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count -1)) + "abac") + +(deftest nsubstitute-string.8 + (let ((x "")) (nsubstitute #\b #\a x :from-end t)) + "") + +(deftest nsubstitute-string.9 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :from-end t)) + "bbbc") + +(deftest nsubstitute-string.10 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :from-end t :count nil)) + "bbbc") + +(deftest nsubstitute-string.11 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count 2 :from-end t)) + "bbbc") + +(deftest nsubstitute-string.12 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count 1 :from-end t)) + "abbc") + +(deftest nsubstitute-string.13 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count 0 :from-end t)) + "abac") + +(deftest nsubstitute-string.14 + (let ((x (copy-seq "abac"))) (nsubstitute #\b #\a x :count -1 :from-end t)) + "abac") + +(deftest nsubstitute-string.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute #\x #\a x :start i :end j))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))) + t) + +(deftest nsubstitute-string.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute #\x #\a x :start i :end j :from-end t))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))) + t) + +(deftest nsubstitute-string.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute #\x #\a x :start i :end j :count c))) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 (+ i c)) :initial-element #\a))))))) + t) + +(deftest nsubstitute-string.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (nsubstitute #\x #\a x :start i :end j :count c :from-end t))) + (equalp y (concatenate 'simple-string + (make-array (- j c) :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest nsubstitute-string.19 + (let* ((orig "123456789") + (x (copy-seq orig)) + (result (nsubstitute #\x #\5 x :test #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (<= (abs (- a b)) 2))))) + result) + "12xxxxx89") + +(deftest nsubstitute-string.20 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c -4) + (result (nsubstitute #\x #\5 x :test #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c 2) (= (+ b c) a))))) + result) + "12x456789") + + +(deftest nsubstitute-string.21 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c 5) + (result (nsubstitute #\x #\9 x :test #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c -2) (= (+ b c) a)) + :from-end t))) + result) + "1234567x9") + +(deftest nsubstitute-string.22 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c -4) + (result (nsubstitute #\x #\5 x :test-not #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c 2) (/= (+ b c) a))))) + result) + "12x456789") + + +(deftest nsubstitute-string.23 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c 5) + (result (nsubstitute #\x #\9 x :test-not #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c -2) (/= (+ b c) a)) + :from-end t))) + result) + "1234567x9") + +(deftest nsubstitute-string.28 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x))) + result) + "zbzcb") + +(deftest nsubstitute-string.29 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x :from-end t))) + result) + "zbzcb") + +(deftest nsubstitute-string.30 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x :count 1))) + result) + "zbacb") + +(deftest nsubstitute-string.31 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x :from-end t :count 1))) + result) + "abzcb") + + +;;; Tests on bit-vectors + +(deftest nsubstitute-bit-vector.1 + (let* ((orig #*) + (x (copy-seq orig)) + (result (nsubstitute 0 1 x))) + result) + #*) + +(deftest nsubstitute-bit-vector.2 + (let* ((orig #*) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x))) + result) + #*) + +(deftest nsubstitute-bit-vector.3 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 0 1 x))) + result) + #*000000) + +(deftest nsubstitute-bit-vector.4 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x))) + result) + #*111111) + +(deftest nsubstitute-bit-vector.5 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :start 1))) + result) + #*011111) + +(deftest nsubstitute-bit-vector.6 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 0 1 x :start 2 :end nil))) + result) + #*010000) + +(deftest nsubstitute-bit-vector.7 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :end 4))) + result) + #*111101) + +(deftest nsubstitute-bit-vector.8 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 0 1 x :end nil))) + result) + #*000000) + +(deftest nsubstitute-bit-vector.9 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 0 1 x :end 3))) + result) + #*000101) + +(deftest nsubstitute-bit-vector.10 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 0 1 x :start 2 :end 4))) + result) + #*010001) + +(deftest nsubstitute-bit-vector.11 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :start 2 :end 4))) + result) + #*011101) + +(deftest nsubstitute-bit-vector.12 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count 1))) + result) + #*110101) + +(deftest nsubstitute-bit-vector.13 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count 0))) + result) + #*010101) + +(deftest nsubstitute-bit-vector.14 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count -1))) + result) + #*010101) + +(deftest nsubstitute-bit-vector.15 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count 1 :from-end t))) + result) + #*010111) + +(deftest nsubstitute-bit-vector.16 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count 0 :from-end t))) + result) + #*010101) + +(deftest nsubstitute-bit-vector.17 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count -1 :from-end t))) + result) + #*010101) + +(deftest nsubstitute-bit-vector.18 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count nil))) + result) + #*111111) + +(deftest nsubstitute-bit-vector.19 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (nsubstitute 1 0 x :count nil :from-end t))) + result) + #*111111) + +(deftest nsubstitute-bit-vector.20 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*0000000000) + (x (copy-seq orig)) + (y (nsubstitute 1 0 x :start i :end j :count c))) + (equalp y (concatenate + 'simple-bit-vector + (make-list i :initial-element 0) + (make-list c :initial-element 1) + (make-list (- 10 (+ i c)) :initial-element 0))))))) + t) + +(deftest nsubstitute-bit-vector.21 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*1111111111) + (x (copy-seq orig)) + (y (nsubstitute 0 1 x :start i :end j :count c :from-end t))) + (equalp y (concatenate + 'simple-bit-vector + (make-list (- j c) :initial-element 1) + (make-list c :initial-element 0) + (make-list (- 10 j) :initial-element 1))))))) + t) + +(deftest nsubstitute-bit-vector.22 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (nsubstitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b)))))) + result) + #*0111110101) + +(deftest nsubstitute-bit-vector.23 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (nsubstitute 1 0 x :test-not #'(lambda (a b) (incf c) + (not (and (<= 2 c 5) (= a b))))))) + result) + #*0111110101) + +(deftest nsubstitute-bit-vector.24 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (nsubstitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b))) + :from-end t))) + result) + #*0101011111) + +(deftest nsubstitute-bit-vector.25 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (nsubstitute 1 0 x :test-not #'(lambda (a b) (incf c) + (not (and (<= 2 c 5) (= a b)))) + :from-end t))) + result) + #*0101011111) + +;;;; additional tests + +(deftest nsubstitute-list.24 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car))) + result) + ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest nsubstitute-list.25 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car :start 1 :end 5))) + result) + ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest nsubstitute-list.26 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car :test (complement #'eql)))) + result) + ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +(deftest nsubstitute-list.27 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car :test-not #'eql))) + result) + ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +(deftest nsubstitute-vector.24 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car))) + result) + #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest nsubstitute-vector.25 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car :start 1 :end 5))) + result) + #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest nsubstitute-vector.26 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car :test (complement #'eql)))) + result) + #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +(deftest nsubstitute-vector.27 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (nsubstitute '(a 10) 'a x :key #'car :test-not #'eql))) + result) + #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +(deftest nsubstitute-string.24 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute #\a #\1 x :key #'nextdigit))) + result) + "a1a2342a15") + +(deftest nsubstitute-string.25 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute #\a #\1 x :key #'nextdigit :start 1 :end 6))) + result) + "01a2342015") + +(deftest nsubstitute-string.26 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute #\a #\1 x :key #'nextdigit :test (complement #'eql)))) + result) + "0a0aaaa0aa") + +(deftest nsubstitute-string.27 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (nsubstitute #\a #\1 x :key #'nextdigit :test-not #'eql))) + result) + "0a0aaaa0aa") + +(deftest nsubstitute-bit-vector.30 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute 1 0 x))) + result) + #*11111) + +(deftest nsubstitute-bit-vector.31 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute 1 0 x :from-end t))) + result) + #*11111) + +(deftest nsubstitute-bit-vector.32 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute 1 0 x :count 1))) + result) + #*11011) + +(deftest nsubstitute-bit-vector.33 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (nsubstitute 1 0 x :from-end t :count 1))) + result) + #*01111) + +(deftest nsubstitute.order.1 + (let ((i 0) a b c d e f g h) + (values + (nsubstitute + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) nil) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :count (progn (setf d (incf i)) 2) + :start (progn (setf e (incf i)) 0) + :end (progn (setf f (incf i)) 7) + :key (progn (setf g (incf i)) #'identity) + :from-end (setf h (incf i)) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 4 5 6 7 8) + +(deftest nsubstitute.order.2 + (let ((i 0) a b c d e f g h) + (values + (nsubstitute + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) nil) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :from-end (setf h (incf i)) + :key (progn (setf g (incf i)) #'identity) + :end (progn (setf f (incf i)) 7) + :start (progn (setf e (incf i)) 0) + :count (progn (setf d (incf i)) 2) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 8 7 6 5 4) + +;;; Keyword tests + +(deftest nsubstitute.allow-other-keys.1 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t :bad t) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute.allow-other-keys.2 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) :bad t :allow-other-keys t) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute.allow-other-keys.3 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t + :allow-other-keys nil :bad t) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute.allow-other-keys.4 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) :bad t + :allow-other-keys t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute.allow-other-keys.5 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) + :allow-other-keys t :key #'1-) + (a 2 0 3 a 0 3)) + +(deftest nsubstitute.keywords.6 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) :key #'1- :key #'identity) + (a 2 0 3 a 0 3)) + +(deftest nsubstitute.allow-other-keys.7 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t + :bad t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest nsubstitute.allow-other-keys.8 + (nsubstitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys nil) + (1 2 a 3 1 a 3)) + + +;;; Error cases + +(deftest nsubstitute.error.1 + (classify-error (nsubstitute)) + program-error) + +(deftest nsubstitute.error.2 + (classify-error (nsubstitute 'a)) + program-error) + +(deftest nsubstitute.error.3 + (classify-error (nsubstitute 'a 'b)) + program-error) + +(deftest nsubstitute.error.4 + (classify-error (nsubstitute 'a 'b nil 'bad t)) + program-error) + +(deftest nsubstitute.error.5 + (classify-error (nsubstitute 'a 'b nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest nsubstitute.error.6 + (classify-error (nsubstitute 'a 'b nil :key)) + program-error) + +(deftest nsubstitute.error.7 + (classify-error (nsubstitute 'a 'b nil 1 2)) + program-error) + +(deftest nsubstitute.error.8 + (classify-error (nsubstitute 'a 'b (list 'a 'b 'c) :test #'identity)) + program-error) + +(deftest nsubstitute.error.9 + (classify-error (nsubstitute 'a 'b (list 'a 'b 'c) :test-not #'identity)) + program-error) + +(deftest nsubstitute.error.10 + (classify-error (nsubstitute 'a 'b (list 'a 'b 'c) :key #'cons)) + program-error) + +(deftest nsubstitute.error.11 + (classify-error (nsubstitute 'a 'b (list 'a 'b 'c) :key #'car)) + type-error) + diff --git a/ansi-tests/nth-value.lsp b/ansi-tests/nth-value.lsp new file mode 100644 index 0000000..1d825ad --- /dev/null +++ b/ansi-tests/nth-value.lsp @@ -0,0 +1,36 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 08:24:14 2002 +;;;; Contains: Tests of NTH-VALUE + +(in-package :cl-test) + +(deftest nth-value.1 + (nth-value 0 'a) + a) + +(deftest nth-value.2 + (nth-value 1 'a) + nil) + +(deftest nth-value.3 + (nth-value 0 (values)) + nil) + +(deftest nth-value.4 + (loop for i from 0 to 19 + collect (nth-value i (values 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k + 'l 'm 'n 'o 'p 'q 'r 's))) + (a b c d e f g h i j k l m n o p q r s nil)) + +(deftest nth-value.5 + (nth-value 100 'a) + nil) + +(deftest nth-value.order.1 + (let ((i 0) x y) + (values + (nth-value (progn (setf x (incf i)) 3) + (progn (setf y (incf i)) (values 'a 'b 'c 'd 'e 'f 'g))) + i x y)) + d 2 1 2) diff --git a/ansi-tests/open-stream-p.lsp b/ansi-tests/open-stream-p.lsp new file mode 100644 index 0000000..ea4ed22 --- /dev/null +++ b/ansi-tests/open-stream-p.lsp @@ -0,0 +1,54 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 13 19:52:30 2004 +;;;; Contains: Tests of OPEN-STREAM-P + +(in-package :cl-test) + +(deftest open-stream-p.1 + (loop for s in (list *debug-io* *error-output* *query-io* + *standard-input* *standard-output* + *trace-output* *terminal-io*) + for results = (multiple-value-list (open-stream-p s)) + unless (and (eql (length results) 1) + (car results)) + collect s) + nil) + +(deftest open-stream-p.2 + (with-open-file (s "open-stream-p.lsp" :direction :input) + (notnot-mv (open-stream-p s))) + t) + +(deftest open-stream-p.3 + (with-open-file (s "foo.txt" :direction :output + :if-exists :supersede) + (notnot-mv (open-stream-p s))) + t) + +(deftest open-stream-p.4 + (let ((s (open "open-stream-p.lsp" :direction :input))) + (close s) + (open-stream-p s)) + nil) + +(deftest open-stream-p.5 + (let ((s (open "foo.txt" :direction :output + :if-exists :supersede))) + (close s) + (open-stream-p s)) + nil) + +;;; error tests + +(deftest open-stream-p.error.1 + (signals-error (open-stream-p) program-error) + t) + +(deftest open-stream-p.error.2 + (signals-error (open-stream-p *standard-input* nil) program-error) + t) + +(deftest open-stream-p.error.3 + (check-type-error #'open-stream-p #'streamp) + nil) diff --git a/ansi-tests/open.lsp b/ansi-tests/open.lsp new file mode 100644 index 0000000..e8d1790 --- /dev/null +++ b/ansi-tests/open.lsp @@ -0,0 +1,1238 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Jan 23 05:36:55 2004 +;;;; Contains: Tests of OPEN + +(in-package :cl-test) + +;;; Input streams + +(defun generator-for-element-type (type) + (etypecase type + ((member character base-char) + #'(lambda (i) (aref "abcdefghijklmnopqrstuvwxyz" (mod i 26)))) + ((member signed-byte unsigned-byte bit) + #'(lambda (i) (logand i 1))) + (cons + (let ((op (car type)) + (arg1 (cadr type)) + (arg2 (caddr type))) + (ecase op + (unsigned-byte + (let ((mask (1- (ash 1 arg1)))) + #'(lambda (i) (logand i mask)))) + (signed-byte + (let ((mask (1- (ash 1 (1- arg1))))) + #'(lambda (i) (logand i mask)))) + (integer + (let* ((lo arg1) + (hi arg2) + (lower-bound + (etypecase lo + (integer lo) + (cons (1+ (car lo))))) + (upper-bound + (etypecase hi + (integer hi) + (cons (1- (car hi))))) + (range (1+ (- upper-bound lower-bound)))) + #'(lambda (i) (+ lower-bound (mod i range)))))))))) + +(compile 'generator-for-element-type) + +(defmacro def-open-test (name args form expected + &key + (notes nil notes-p) + (build-form nil build-form-p) + (element-type 'character element-type-p) + (pathname #p"tmp.dat")) + + (when element-type-p + (setf args (append args (list :element-type `',element-type)))) + + (unless build-form-p + (let ((write-element-form + (cond + ((subtypep element-type 'integer) + `(write-byte + (funcall (the function + (generator-for-element-type ',element-type)) i) + os)) + ((subtypep element-type 'character) + `(write-char + (funcall (the function + (generator-for-element-type ',element-type)) i) + os))))) + (setq build-form + `(with-open-file + (os pn :direction :output + ,@(if element-type-p + `(:element-type ',element-type)) + :if-exists :supersede) + (assert (open-stream-p os)) + (dotimes (i 10) ,write-element-form) + (finish-output os) + )))) + + `(deftest ,name + ,@(when notes-p `(:notes ,notes)) + (let ((pn ,pathname)) + (delete-all-versions pn) + ,build-form + (let ((s (open pn ,@args))) + (unwind-protect + (progn + (assert (open-stream-p s)) + (assert (typep s 'file-stream)) + ,@ + (unless (member element-type '(signed-byte unsigned-byte)) + #-allegro + `((assert (subtypep ',element-type + (stream-element-type s)))) + #+allegro nil + ) + ,form) + (close s)))) + ,@expected)) + +;; (compile 'def-open-test) + +(def-open-test open.1 () (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.2 (:direction :input) + (values (read-line s nil)) ("abcdefghij") :element-type character) +(def-open-test open.3 (:direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.4 (:direction :input) + (values (read-line s nil)) ("abcdefghij") :element-type base-char) +(def-open-test open.5 (:if-exists :error) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.6 (:if-exists :error :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.7 (:if-exists :new-version) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.8 (:if-exists :new-version :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.9 (:if-exists :rename) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.10 (:if-exists :rename :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.11 (:if-exists :rename-and-delete) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.12 (:if-exists :rename-and-delete :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.13 (:if-exists :overwrite) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.14 (:if-exists :overwrite :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.15 (:if-exists :append) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.16 (:if-exists :append :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.17 (:if-exists :supersede) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.18 (:if-exists :supersede :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.19 (:if-exists nil) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.20 (:if-exists nil :direction :input) + (values (read-line s nil)) ("abcdefghij")) + +(def-open-test open.21 (:if-does-not-exist nil) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.22 (:if-does-not-exist nil :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.23 (:if-does-not-exist :error) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.24 (:if-does-not-exist :error :direction :input) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.25 (:if-does-not-exist :create) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.26 (:if-does-not-exist :create :direction :input) + (values (read-line s nil)) ("abcdefghij")) + +(def-open-test open.27 (:external-format :default) + (values (read-line s nil)) ("abcdefghij")) +(def-open-test open.28 (:external-format :default :direction :input) + (values (read-line s nil)) ("abcdefghij")) + +(def-open-test open.29 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) +(def-open-test open.30 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) + +(def-open-test open.31 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) +(def-open-test open.32 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) + +(def-open-test open.33 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) +(def-open-test open.34 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) + +(def-open-test open.35 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) +(def-open-test open.36 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) + +(def-open-test open.37 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) +(def-open-test open.38 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) + +(def-open-test open.39 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) +(def-open-test open.40 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) + +(def-open-test open.41 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) +(def-open-test open.42 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) + +(def-open-test open.43 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) +(def-open-test open.44 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) + +(def-open-test open.45 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) +(def-open-test open.46 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) + +(def-open-test open.47 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) +(def-open-test open.48 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) + +(def-open-test open.49 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) +(def-open-test open.50 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) + +(def-open-test open.51 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) +(def-open-test open.52 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) + +(def-open-test open.53 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) +(def-open-test open.54 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) + +(def-open-test open.55 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) +(def-open-test open.56 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) + +(def-open-test open.57 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) +(def-open-test open.58 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) + +(def-open-test open.59 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) +(def-open-test open.60 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) + +(def-open-test open.61 () + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) +(def-open-test open.62 (:direction :input) + (let ((seq (make-array 10))) (read-sequence seq s) seq) + (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) + + +(def-open-test open.63 () + (values (read-line s nil)) ("abcdefghij") + :pathname "tmp.dat") + +(def-open-test open.64 () + (values (read-line s nil)) ("abcdefghij") + :pathname (logical-pathname "CLTEST:TMP.DAT")) + +;;; It works on recognizable subtypes. +(deftest open.65 + (let ((type '(or (integer 0 1) (integer 100 200))) + (pn #p"tmp.dat") + (vals '(0 1 100 120 130 190 200 1 0 150))) + (or + (not (subtypep type 'integer)) + (progn + (with-open-file + (os pn :direction :output + :element-type type + :if-exists :supersede) + (dolist (e vals) (write-byte e os))) + (let ((s (open pn :direction :input + :element-type type)) + (seq (make-array 10))) + (unwind-protect + (progn (read-sequence seq s) seq) + (close s)) + (notnot (every #'eql seq vals)))))) + t) + +;;; FIXME: Add -- tests for when the filespec is a stream + +(deftest open.66 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file + (s pn :direction :io :if-exists :rename-and-delete + :if-does-not-exist :create) + (format s "some stuff~%") + (finish-output s) + (let ((is (open s :direction :input))) + (unwind-protect + (values + (read-char is) + (notnot (file-position s :start)) + (read-line is) + (read-line s)) + (close is))))) + #\s + t + "ome stuff" + "some stuff") + +(deftest open.67 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (let ((s (open pn :direction :output))) + (unwind-protect + (progn + (format s "some stuff~%") + (finish-output s) + (close s) + (let ((is (open s :direction :input))) + (unwind-protect + (values (read-line is)) + (close is)))) + (when (open-stream-p s) (close s))))) + "some stuff") + +;;; FIXME: Add -- tests for when element-type is :default + +;;; Tests of file creation + +(defmacro def-open-output-test + (name args form expected + &rest keyargs + &key + (element-type 'character) + (build-form + `(dotimes (i 10) + ,(cond + ((subtypep element-type 'integer) + `(write-byte + (funcall (the function + (generator-for-element-type ',element-type)) i) + s)) + ((subtypep element-type 'character) + `(write-char + (funcall (the function + (generator-for-element-type ',element-type)) i) + s))))) + &allow-other-keys) + `(def-open-test ,name (:direction :output ,@args) + (progn + ,build-form + (assert (output-stream-p s)) + ,form) + ,expected + :build-form nil + ,@keyargs)) + +;; (compile 'def-open-output-test) + +(def-open-output-test open.output.1 () + (progn (close s) + (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) + ("abcdefghij")) + +(def-open-output-test open.output.2 () + (progn (close s) + (with-open-file (is "tmp.dat") (values (read-line is nil)))) + ("abcdefghij") + :pathname "tmp.dat") + +(def-open-output-test open.output.3 + () + (progn (close s) + (with-open-file (is (logical-pathname "CLTEST:TMP.DAT")) + (values (read-line is nil)))) + ("abcdefghij") + :pathname (logical-pathname "CLTEST:TMP.DAT")) + +(def-open-output-test open.output.4 () + (progn (close s) + (with-open-file (is #p"tmp.dat" :element-type 'character) + (values (read-line is nil)))) + ("abcdefghij") + :element-type character) + +(def-open-output-test open.output.5 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type 'base-char) + (values (read-line is nil)))) + ("abcdefghij") + :element-type base-char) + +(def-open-output-test open.output.6 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(integer 0 1)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 0 1 0 1 0 1 0 1)) + :element-type (integer 0 1)) + +(def-open-output-test open.output.7 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type 'bit) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 0 1 0 1 0 1 0 1)) + :element-type bit) + +(def-open-output-test open.output.8 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 1)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 0 1 0 1 0 1 0 1)) + :element-type (unsigned-byte 1)) + +(def-open-output-test open.output.9 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 2)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 0 1 2 3 0 1)) + :element-type (unsigned-byte 2)) + +(def-open-output-test open.output.10 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 3)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 0 1)) + :element-type (unsigned-byte 3)) + +(def-open-output-test open.output.11 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 4)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 4)) + + +(def-open-output-test open.output.12 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 6)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 6)) + +(def-open-output-test open.output.13 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 8)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 8)) + +(def-open-output-test open.output.14 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 12)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 12)) + +(def-open-output-test open.output.15 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 16)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 16)) + +(def-open-output-test open.output.16 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 24)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 24)) + +(def-open-output-test open.output.17 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 32)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 32)) + +(def-open-output-test open.output.18 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 64)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 64)) + +(def-open-output-test open.output.19 () + (progn (close s) (with-open-file (is #p"tmp.dat" + :element-type '(unsigned-byte 100)) + (let ((seq (make-array 10))) + (read-sequence seq is) + seq))) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 100)) + +(deftest open.output.20 + (let ((pn #p"tmp.dat")) + (with-open-file (s pn :direction :output :if-exists :supersede)) + (open pn :direction :output :if-exists nil)) + nil) + +(def-open-test open.output.21 (:if-exists :new-version :direction :output) + (progn (write-sequence "wxyz" s) + (close s) + (with-open-file + (s pn :direction :input) + (values (read-line s nil)))) + ("wxyz") + :notes (:open-if-exists-new-version-no-error) + ) + +(def-open-test open.output.22 (:if-exists :rename :direction :output) + (progn (write-sequence "wxyz" s) + (close s) + (with-open-file + (s pn :direction :input) + (values (read-line s nil)))) + ("wxyz")) + +(def-open-test open.output.23 (:if-exists :rename-and-delete + :direction :output) + (progn (write-sequence "wxyz" s) + (close s) + (with-open-file + (s pn :direction :input) + (values (read-line s nil)))) + ("wxyz")) + +(def-open-test open.output.24 (:if-exists :overwrite + :direction :output) + (progn (write-sequence "wxyz" s) + (close s) + (with-open-file + (s pn :direction :input) + (values (read-line s nil)))) + ("wxyzefghij")) + +(def-open-test open.output.25 (:if-exists :append + :direction :output) + (progn (write-sequence "wxyz" s) + (close s) + (with-open-file + (s pn :direction :input) + (values (read-line s nil)))) + ("abcdefghijwxyz")) + +(def-open-test open.output.26 (:if-exists :supersede + :direction :output) + (progn (write-sequence "wxyz" s) + (close s) + (with-open-file + (s pn :direction :input) + (values (read-line s nil)))) + ("wxyz")) + +(def-open-output-test open.output.27 (:if-does-not-exist :create + :direction :output) + (progn (close s) + (with-open-file + (is pn :direction :input) + (values (read-line is nil)))) + ("abcdefghij")) + +(deftest open.output.28 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :output :if-does-not-exist nil)) + nil) + +(def-open-output-test open.output.28a (:external-format :default) + (progn (close s) + (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) + ("abcdefghij")) + +(def-open-output-test open.output.29 + (:external-format (prog1 + (with-open-file (s "foo.dat" :direction :output + :if-exists :supersede) + (stream-external-format s)) + (delete-all-versions "foo.dat") + )) + (progn (close s) + (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) + ("abcdefghij")) + +;;; Default behavior of open :if-exists is :create when the version +;;; of the filespec is :newest + +(deftest open.output.30 + :notes (:open-if-exists-new-version-no-error) + (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) + (or (not (eql (pathname-version pn) :newest)) + (progn + ;; Create file + (let ((s1 (open pn :direction :output :if-exists :overwrite + :if-does-not-exist :create))) + (unwind-protect + ;; Now try again + (let ((s2 (open pn :direction :output))) + (unwind-protect + (write-line "abcdef" s2) + (close s2)) + (unwind-protect + (progn + (setq s2 (open s1 :direction :input)) + (equalt (read-line s2 nil) "abcdef")) + (close s2))) + (close s1) + (delete-all-versions pn) + ))))) + t) + +(def-open-output-test open.output.31 (:if-exists :rename + :direction :output) + (progn (close s) + (with-open-file + (is pn :direction :input) + (values (read-line is nil)))) + ("abcdefghij")) + +(def-open-output-test open.output.32 (:if-exists :rename-and-delete + :direction :output) + (progn (close s) + (with-open-file + (is pn :direction :input) + (values (read-line is nil)))) + ("abcdefghij")) + +(def-open-output-test open.output.33 (:if-exists :new-version + :direction :output) + (progn (close s) + (with-open-file + (is pn :direction :input) + (values (read-line is nil)))) + ("abcdefghij")) + +(def-open-output-test open.output.34 (:if-exists :supersede + :direction :output) + (progn (close s) + (with-open-file + (is pn :direction :input) + (values (read-line is nil)))) + ("abcdefghij")) + +(def-open-output-test open.output.35 (:if-exists nil + :direction :output) + (progn (close s) + (with-open-file + (is pn :direction :input) + (values (read-line is nil)))) + ("abcdefghij")) + +;;; Add -- tests for when the filespec is a stream + + +;;; Tests of bidirectional IO + +(defmacro def-open-io-test + (name args form expected + &rest keyargs + &key + (element-type 'character) + (build-form + `(dotimes (i 10) + ,(cond + ((subtypep element-type 'integer) + `(write-byte + (funcall (the function + (generator-for-element-type ',element-type)) i) + s)) + ((subtypep element-type 'character) + `(write-char + (funcall (the function + (generator-for-element-type ',element-type)) i) + s))))) + &allow-other-keys) + `(def-open-test ,name (:direction :io ,@args) + (progn + ,build-form + (assert (input-stream-p s)) + (assert (output-stream-p s)) + ,form) + ,expected + :build-form nil + ,@keyargs)) + +;; (compile 'def-open-io-test) + +(def-open-io-test open.io.1 () + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +(def-open-io-test open.io.2 () + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij") + :pathname "tmp.dat") + +(def-open-io-test open.io.3 + () + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij") + :pathname (logical-pathname "CLTEST:TMP.DAT")) + +(def-open-io-test open.io.4 () + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij") + :element-type character) + +(def-open-io-test open.io.5 () + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij") + :element-type base-char) + +(def-open-io-test open.io.6 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 0 1 0 1 0 1 0 1)) + :element-type (integer 0 1)) + +(def-open-io-test open.io.7 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 0 1 0 1 0 1 0 1)) + :element-type bit) + +(def-open-io-test open.io.8 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 0 1 0 1 0 1 0 1)) + :element-type (unsigned-byte 1)) + +(def-open-io-test open.io.9 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 0 1 2 3 0 1)) + :element-type (unsigned-byte 2)) + +(def-open-io-test open.io.10 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 0 1)) + :element-type (unsigned-byte 3)) + +(def-open-io-test open.io.11 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 4)) + + +(def-open-io-test open.io.12 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 6)) + +(def-open-io-test open.io.13 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 8)) + +(def-open-io-test open.io.14 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 12)) + +(def-open-io-test open.io.15 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 16)) + +(def-open-io-test open.io.16 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 24)) + +(def-open-io-test open.io.17 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 32)) + +(def-open-io-test open.io.18 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 64)) + +(def-open-io-test open.io.19 () + (progn (file-position s :start) + (let ((seq (make-array 10))) + (read-sequence seq s) + seq)) + (#(0 1 2 3 4 5 6 7 8 9)) + :element-type (unsigned-byte 100)) + +(deftest open.io.20 + (let ((pn #p"tmp.dat")) + (with-open-file (s pn :direction :io :if-exists :supersede)) + (open pn :direction :io :if-exists nil)) + nil) + +(def-open-test open.io.21 (:if-exists :new-version :direction :io) + (progn (write-sequence "wxyz" s) + (file-position s :start) + (values (read-line s nil))) + ("wxyz") + :notes (:open-if-exists-new-version-no-error) + ) + +(def-open-test open.io.22 (:if-exists :rename :direction :io) + (progn (write-sequence "wxyz" s) + (file-position s :start) + (values (read-line s nil))) + ("wxyz")) + +(def-open-test open.io.23 (:if-exists :rename-and-delete + :direction :io) + (progn (write-sequence "wxyz" s) + (file-position s :start) + (values (read-line s nil))) + ("wxyz")) + +(def-open-test open.io.24 (:if-exists :overwrite + :direction :io) + (progn (write-sequence "wxyz" s) + (file-position s :start) + (values (read-line s nil))) + ("wxyzefghij")) + +(def-open-test open.io.25 (:if-exists :append + :direction :io) + (progn (write-sequence "wxyz" s) + (file-position s :start) + (values (read-line s nil))) + ("abcdefghijwxyz")) + +(def-open-test open.io.26 (:if-exists :supersede + :direction :io) + (progn (write-sequence "wxyz" s) + (file-position s :start) + (values (read-line s nil))) + ("wxyz")) + +(def-open-io-test open.io.27 (:if-does-not-exist :create + :direction :io) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +(deftest open.io.28 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :io :if-does-not-exist nil)) + nil) + +(def-open-io-test open.io.28a (:external-format :default) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +(def-open-io-test open.io.29 + (:external-format (prog1 + (with-open-file (s "foo.dat" :direction :io + :if-exists :supersede) + (stream-external-format s)) + (delete-all-versions "foo.dat") + )) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +;;; Default behavior of open :if-exists is :create when the version +;;; of the filespec is :newest + +(deftest open.io.30 + :notes (:open-if-exists-new-version-no-error) + (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) + (or (not (eql (pathname-version pn) :newest)) + (progn + ;; Create file + (let ((s1 (open pn :direction :io :if-exists :overwrite + :if-does-not-exist :create))) + (unwind-protect + ;; Now try again + (let ((s2 (open pn :direction :io))) + (unwind-protect + (write-line "abcdef" s2) + (close s2)) + (unwind-protect + (progn + (setq s2 (open s1 :direction :input)) + (equalt (read-line s2 nil) "abcdef")) + (close s2))) + (close s1) + (delete-all-versions pn) + ))))) + t) + +(def-open-io-test open.io.31 (:if-exists :rename + :direction :io) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +(def-open-io-test open.io.32 (:if-exists :rename-and-delete + :direction :io) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +(def-open-io-test open.io.33 (:if-exists :new-version + :direction :io) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +(def-open-io-test open.io.34 (:if-exists :supersede + :direction :io) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +(def-open-io-test open.io.35 (:if-exists nil + :direction :io) + (progn (file-position s :start) + (values (read-line s nil))) + ("abcdefghij")) + +;;;; :PROBE tests + +(defmacro def-open-probe-test + (name args form + &key (build-form nil build-form-p) + (pathname #p"tmp.dat")) + (unless build-form-p + (setf build-form + `(with-open-file (s pn :direction :output + :if-exists :supersede)))) + `(deftest ,name + (let ((pn ,pathname)) + (delete-all-versions pn) + ,build-form + (let ((s (open pn :direction :probe ,@args))) + (values + ,(if build-form + `(and + (typep s 'file-stream) + (not (open-stream-p s)) + ) + `(not s)) + ,form))) + t t)) + +(def-open-probe-test open.probe.1 () t) +(def-open-probe-test open.probe.2 (:if-exists :error) t) +(def-open-probe-test open.probe.3 (:if-exists :new-version) t) +(def-open-probe-test open.probe.4 (:if-exists :rename) t) +(def-open-probe-test open.probe.5 (:if-exists :rename-and-delete) t) +(def-open-probe-test open.probe.6 (:if-exists :overwrite) t) +(def-open-probe-test open.probe.7 (:if-exists :append) t) +(def-open-probe-test open.probe.8 (:if-exists :supersede) t) + +(def-open-probe-test open.probe.9 (:if-does-not-exist :error) t) +(def-open-probe-test open.probe.10 (:if-does-not-exist nil) t) +(def-open-probe-test open.probe.11 (:if-does-not-exist :create) t) + +(def-open-probe-test open.probe.12 () t :build-form nil) +(def-open-probe-test open.probe.13 (:if-exists :error) t :build-form nil) +(def-open-probe-test open.probe.14 (:if-exists :new-version) t :build-form nil) +(def-open-probe-test open.probe.15 (:if-exists :rename) t :build-form nil) +(def-open-probe-test open.probe.16 (:if-exists :rename-and-delete) t + :build-form nil) +(def-open-probe-test open.probe.17 (:if-exists :overwrite) t + :build-form nil) +(def-open-probe-test open.probe.18 (:if-exists :append) t + :build-form nil) +(def-open-probe-test open.probe.19 (:if-exists :supersede) t + :build-form nil) + +(def-open-probe-test open.probe.20 (:if-does-not-exist nil) t + :build-form nil) + +(deftest open.probe.21 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (let ((s (open pn :direction :probe :if-does-not-exist :create))) + (values + (notnot s) + (notnot (probe-file pn))))) + t t) + +(deftest open.probe.22 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (let ((s (open pn :direction :probe :if-does-not-exist :create + :if-exists :error))) + (values + (notnot s) + (notnot (probe-file pn))))) + t t) + +(def-open-probe-test open.probe.23 (:external-format :default) t) +(def-open-probe-test open.probe.24 (:element-type 'character) t) +(def-open-probe-test open.probe.25 (:element-type 'bit) t) +(def-open-probe-test open.probe.26 (:element-type '(unsigned-byte 2)) t) +(def-open-probe-test open.probe.27 (:element-type '(unsigned-byte 4)) t) +(def-open-probe-test open.probe.28 (:element-type '(unsigned-byte 8)) t) +(def-open-probe-test open.probe.29 (:element-type '(unsigned-byte 9)) t) +(def-open-probe-test open.probe.30 (:element-type '(unsigned-byte 15)) t) +(def-open-probe-test open.probe.31 (:element-type '(unsigned-byte 16)) t) +(def-open-probe-test open.probe.32 (:element-type '(unsigned-byte 17)) t) +(def-open-probe-test open.probe.33 (:element-type '(unsigned-byte 31)) t) +(def-open-probe-test open.probe.34 (:element-type '(unsigned-byte 32)) t) +(def-open-probe-test open.probe.35 (:element-type '(unsigned-byte 33)) t) +(def-open-probe-test open.probe.36 (:element-type '(integer -1002 13112)) t) + +;;;; Error tests + +(deftest open.error.1 + (signals-error (open) program-error) + t) + +(deftest open.error.2 + (signals-error-always + (let ((pn #p"tmp.dat")) + (close (open pn :direction :output :if-does-not-exist :create)) + (open pn :if-exists :error :direction :output)) + file-error) + t t) + +(deftest open.error.3 + (signals-error-always + (let ((pn #p"tmp.dat")) + (close (open pn :direction :output :if-does-not-exist :create)) + (open pn :if-exists :error :direction :io)) + file-error) + t t) + +(deftest open.error.4 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn)) + file-error) + t t) + +(deftest open.error.5 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :if-does-not-exist :error)) + file-error) + t t) + +(deftest open.error.6 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :input)) + file-error) + t t) + +(deftest open.error.7 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :if-does-not-exist :error :direction :input)) + file-error) + t t) + +(deftest open.error.8 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :output :if-does-not-exist :error)) + file-error) + t t) + +(deftest open.error.9 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :io :if-does-not-exist :error)) + file-error) + t t) + +(deftest open.error.10 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :probe :if-does-not-exist :error)) + file-error) + t t) + +(deftest open.error.11 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :output :if-exists :overwrite)) + file-error) + t t) + +(deftest open.error.12 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :output :if-exists :append)) + file-error) + t t) + +(deftest open.error.13 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :io :if-exists :overwrite)) + file-error) + t t) + +(deftest open.error.14 + (signals-error-always + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (open pn :direction :io :if-exists :append)) + file-error) + t t) + +(deftest open.error.15 + (signals-error-always + (open (make-pathname :name :wild :type "lsp")) + file-error) + t t) + +(deftest open.error.16 + (signals-error-always + (open (make-pathname :name "open" :type :wild)) + file-error) + t t) + +(deftest open.error.17 + (signals-error-always + (let ((pn (make-pathname :name "open" :type "lsp" :version :wild))) + (if (wild-pathname-p pn) (open pn) + (error 'file-error))) + file-error) + t t) + +(deftest open.error.18 + (signals-error-always + (open #p"tmp.dat" :direction :output :if-exists :supersede + :external-form (gensym)) + error) + t t) + + +;;; FIXME -- add tests for :element-type :default + +;;; FIXME -- add tests for filespec being a specialized string diff --git a/ansi-tests/or.lsp b/ansi-tests/or.lsp new file mode 100644 index 0000000..4b7d746 --- /dev/null +++ b/ansi-tests/or.lsp @@ -0,0 +1,48 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 07:29:27 2002 +;;;; Contains: Tests of OR + +(in-package :cl-test) + +(deftest or.1 + (or) + nil) + +(deftest or.2 + (or nil) + nil) + +(deftest or.3 + (or 'a) + a) + +(deftest or.4 + (or (values 'a 'b 'c)) + a b c) + +(deftest or.5 (or (values))) + +(deftest or.6 + (or (values t nil) 'a) + t) + +(deftest or.7 + (or nil (values 'a 'b 'c)) + a b c) + +(deftest or.8 + (let ((x 0)) + (values (or t (incf x)) + x)) + t 0) + +(deftest or.9 + (or (values nil 1 2) (values 1 nil 2)) + 1 nil 2) + + + + + + diff --git a/ansi-tests/output-stream-p.lsp b/ansi-tests/output-stream-p.lsp new file mode 100644 index 0000000..e4f13c0 --- /dev/null +++ b/ansi-tests/output-stream-p.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 13 19:46:12 2004 +;;;; Contains: Tests of OUTPUT-STREAM-P + +(in-package :cl-test) + +(deftest output-stream-p.1 + (notnot-mv (output-stream-p *standard-output*)) + t) + +(deftest output-stream-p.2 + (notnot-mv (output-stream-p *terminal-io*)) + t) + +(deftest output-stream-p.3 + (with-open-file (s "output-stream-p.lsp" :direction :input) + (output-stream-p s)) + nil) + +(deftest output-stream-p.4 + (with-open-file (s "foo.txt" :direction :output + :if-exists :supersede) + (notnot-mv (output-stream-p s))) + t) + +;;; Error tests + +(deftest output-stream-p.error.1 + (signals-error (output-stream-p) program-error) + t) + +(deftest output-stream-p.error.2 + (signals-error (output-stream-p *standard-output* nil) program-error) + t) + +(deftest output-stream-p.error.3 + (check-type-error #'output-stream-p #'streamp) + nil) diff --git a/ansi-tests/packages-00.lsp b/ansi-tests/packages-00.lsp new file mode 100644 index 0000000..0f951e3 --- /dev/null +++ b/ansi-tests/packages-00.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:07:31 1998 +;;;; Contains: Package test code (common code) + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +(defpackage "A" + (:use) + (:nicknames "Q") + (:export "FOO")) + +(defpackage "B" + (:use "A") + (:export "BAR")) + +(defpackage "DS1" + (:use) + (:intern "C" "D") + (:export "A" "B")) + +(defpackage "DS2" + (:use) + (:intern "E" "F") + (:export "G" "H" "A")) + +(defpackage "DS3" + (:shadow "B") + (:shadowing-import-from "DS1" "A") + (:use "DS1" "DS2") + (:export "A" "B" "G" "I" "J" "K") + (:intern "L" "M")) + +(defpackage "DS4" + (:shadowing-import-from "DS1" "B") + (:use "DS1" "DS3") + (:intern "X" "Y" "Z") + (:import-from "DS2" "F")) diff --git a/ansi-tests/packages-01.lsp b/ansi-tests/packages-01.lsp new file mode 100644 index 0000000..f811c79 --- /dev/null +++ b/ansi-tests/packages-01.lsp @@ -0,0 +1,92 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 07:49:34 1998 +;;;; Contains: Package test code, part 01 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;; Test find-symbol, with the various combinations of +;; package designators + +(deftest find-symbol.1 + (find-symbol "aBmAchb1c") + nil nil) + +(deftest find-symbol.2 + (find-symbol "aBmAchb1c" "CL") + nil nil) + +(deftest find-symbol.3 + (find-symbol "aBmAchb1c" "COMMON-LISP") + nil nil) + +(deftest find-symbol.4 + (find-symbol "aBmAchb1c" "KEYWORD") + nil nil) + +(deftest find-symbol.5 + (find-symbol "aBmAchb1c" "COMMON-LISP-USER") + nil nil) + +(deftest find-symbol.6 + (find-symbol (string '#:car) "CL") + car :external) + +(deftest find-symbol.7 + (find-symbol (string '#:car) "COMMON-LISP") + car :external) + +(deftest find-symbol.8 + (values (find-symbol (string '#:car) "COMMON-LISP-USER")) + car #| :inherited |# ) + +(deftest find-symbol.9 + (find-symbol (string '#:car) "CL-TEST") + car :inherited) + +(deftest find-symbol.10 + (find-symbol (string '#:test) "KEYWORD") + :test :external) + +(deftest find-symbol.11 + (find-symbol (string '#:find-symbol.11) "CL-TEST") + find-symbol.11 :internal) + +(deftest find-symbol.12 + (find-symbol "FOO" #\A) + A::FOO :external) + +(deftest find-symbol.13 + (progn + (intern "X" (find-package "A")) + (find-symbol "X" #\A)) + A::X :internal) + +(deftest find-symbol.14 + (find-symbol "FOO" #\B) + A::FOO :inherited) + +(deftest find-symbol.15 + (find-symbol "FOO" "B") + A::FOO :inherited) + +(deftest find-symbol.16 + (find-symbol "FOO" (find-package "B")) + A::FOO :inherited) + +(deftest find-symbol.order.1 + (let ((i 0) x y) + (values + (find-symbol (progn (setf x (incf i)) (string '#:car)) + (progn (setf y (incf i)) "COMMON-LISP")) + i x y)) + car 2 1 2) + +(deftest find-symbol.error.1 + (classify-error (find-symbol)) + program-error) + +(deftest find-symbol.error.2 + (classify-error (find-symbol "CAR" "CL" nil)) + program-error) \ No newline at end of file diff --git a/ansi-tests/packages-02.lsp b/ansi-tests/packages-02.lsp new file mode 100644 index 0000000..3139da7 --- /dev/null +++ b/ansi-tests/packages-02.lsp @@ -0,0 +1,91 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 07:50:39 1998 +;;;; Contains: Package test code, aprt 02 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; find-package + +(deftest find-package.1 + (let ((p (find-package "CL")) + (p2 (find-package "COMMON-LISP"))) + (and p p2 (eqt p p2))) + t) + +(deftest find-package.2 + (let ((p (find-package "CL-USER")) + (p2 (find-package "COMMON-LISP-USER"))) + (and p p2 (eqt p p2))) + t) + +(deftest find-package.3 + (let ((p (find-package "KEYWORD"))) + (and p (eqt p (symbol-package :test)))) + t) + +(deftest find-package.4 + (let ((p (ignore-errors (find-package "A")))) + (if (packagep p) + t + p)) + t) + +(deftest find-package.5 + (let ((p (ignore-errors (find-package #\A)))) + (if (packagep p) + t + p)) + t) + +(deftest find-package.6 + (let ((p (ignore-errors (find-package "B")))) + (if (packagep p) + t + p)) + t) + +(deftest find-package.7 + (let ((p (ignore-errors (find-package #\B)))) + (if (packagep p) + t + p)) + t) + +(deftest find-package.8 + (let ((p (ignore-errors (find-package "Q"))) + (p2 (ignore-errors (find-package "A")))) + (and (packagep p) + (packagep p2) + (eqt p p2))) + t) + +(deftest find-package.9 + (let ((p (ignore-errors (find-package "A"))) + (p2 (ignore-errors (find-package "B")))) + (eqt p p2)) + nil) + +(deftest find-package.10 + (let ((p (ignore-errors (find-package #\Q))) + (p2 (ignore-errors (find-package "Q")))) + (and (packagep p) + (eqt p p2))) + t) + +(deftest find-package.11 + (let* ((cl (find-package "CL")) + (cl2 (find-package cl))) + (and (packagep cl) + (eqt cl cl2))) + t) + +(deftest find-package.error.1 + (classify-error (find-package)) + program-error) + +(deftest find-package.error.2 + (classify-error (find-package "CL" nil)) + program-error) diff --git a/ansi-tests/packages-03.lsp b/ansi-tests/packages-03.lsp new file mode 100644 index 0000000..dc8dfb1 --- /dev/null +++ b/ansi-tests/packages-03.lsp @@ -0,0 +1,220 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 07:51:26 1998 +;;;; Contains: Package test code, part 03 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; list-all-packages + +;; list-all-packages returns a list +(deftest list-all-packages.1 + (numberp (ignore-errors (list-length (list-all-packages)))) + t) + +;; The required packages are present +(deftest list-all-packages.2 + (subsetp + (list (find-package "CL") + (find-package "CL-USER") + (find-package "KEYWORD") + (find-package "A") + (find-package "RT") + (find-package "CL-TEST") + (find-package "B")) + (list-all-packages)) + t) + +;; The list returned has only packages in it +(deftest list-all-packages.3 + (notnot-mv (every #'packagep (list-all-packages))) + t) + +;; It returns a list of the same packages each time it is called +(deftest list-all-packages.4 + (let ((p1 (list-all-packages)) + (p2 (list-all-packages))) + (and (subsetp p1 p2) + (subsetp p2 p1))) + t) + +(deftest list-all-packages.error.1 + (classify-error (list-all-packages nil)) + program-error) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; package-name + +(deftest package-name.1 + (ignore-errors (package-name "A")) + "A") + +(deftest package-name.2 + (ignore-errors (package-name #\A)) + "A") + +(deftest package-name.3 + (ignore-errors (package-name "Q")) + "A") + +(deftest package-name.4 + (ignore-errors (package-name #\Q)) + "A") + +(deftest package-name.5 + (notnot-mv (member (classify-error (package-name "NOT-THERE")) + '(type-error package-error))) + t) + +(deftest package-name.6 + (notnot-mv (member (classify-error (package-name #\*)) + '(type-error package-error))) + t) + +(deftest package-name.6a + (notnot-mv (member (classify-error (locally (package-name #\*) t)) + '(type-error package-error))) + t) + +(deftest package-name.7 + (package-name "CL") + #.(string '#:common-lisp)) + +(deftest package-name.8 + (package-name "COMMON-LISP") + #.(string '#:common-lisp)) + +(deftest package-name.9 + (package-name "COMMON-LISP-USER") + #.(string '#:common-lisp-user)) + +(deftest package-name.10 + (package-name "CL-USER") + #.(string '#:common-lisp-user)) + +(deftest package-name.11 + (package-name "KEYWORD") + #.(string '#:keyword)) + +(deftest package-name.12 + (package-name (find-package "CL")) + #.(string '#:common-lisp)) + +(deftest package-name.13 + (let* ((p (make-package "TEMP1")) + (pname1 (package-name p))) + (rename-package "TEMP1" "TEMP2") + (let ((pname2 (package-name p))) + (safely-delete-package p) + (list pname1 pname2 (package-name p)))) + ("TEMP1" "TEMP2" nil)) + +;; (find-package (package-name p)) == p for any package p +(deftest package-name.14 + (loop + for p in (list-all-packages) count + (not + (let ((name (package-name p))) + (and (stringp name) + (eqt (find-package name) p))))) + 0) + +;; package-name applied to a package's name +;; should return an equal string +(deftest package-name.15 + (loop + for p in (list-all-packages) count + (not (equal (package-name p) + (ignore-errors (package-name (package-name p)))))) + 0) + +(deftest package-name.error.1 + (classify-error (package-name)) + program-error) + +(deftest package-name.error.2 + (classify-error (package-name "CL" nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; package-nicknames + +(deftest package-nicknames.1 + (ignore-errors (package-nicknames "A")) + ("Q")) + +(deftest package-nicknames.2 + (ignore-errors (package-nicknames #\A)) + ("Q")) + +(deftest package-nicknames.3 + (ignore-errors (package-nicknames ':|A|)) + ("Q")) + +(deftest package-nicknames.4 + (ignore-errors (package-nicknames "B")) + nil) + +(deftest package-nicknames.5 + (ignore-errors (package-nicknames #\B)) + nil) + +(deftest package-nicknames.6 + (ignore-errors (package-nicknames '#:|B|)) + nil) + +(deftest package-nicknames.7 + (ignore-errors + (subsetp '(#.(string '#:cl)) + (package-nicknames "COMMON-LISP") + :test #'string=)) + t) + +(deftest package-nicknames.8 + (ignore-errors + (notnot + (subsetp '(#.(string '#:cl-user)) + (package-nicknames "COMMON-LISP-USER") + :test #'string=))) + t) + +(deftest package-nicknames.9 + (classify-error (package-nicknames 10)) + type-error) + +(deftest package-nicknames.9a + (classify-error (locally (package-nicknames 10) t)) + type-error) + +(deftest package-nicknames.10 + (ignore-errors (package-nicknames (find-package "A"))) + ("Q")) + +(deftest package-nicknames.11 + (notnot-mv (member (classify-error (package-nicknames "NOT-A-PACKAGE-NAME")) + '(type-error package-error))) + t) + + +;; (find-package n) == p for each n in (package-nicknames p), +;; for any package p +(deftest package-nicknames.12 + (loop + for p in (list-all-packages) sum + (loop + for nk in (package-nicknames p) count + (not + (and (stringp nk) + (eqt p (find-package nk)))))) + 0) + +(deftest package-nicknames.error.1 + (classify-error (package-nicknames)) + program-error) + +(deftest package-nicknames.error.2 + (classify-error (package-nicknames "CL" nil)) + program-error) diff --git a/ansi-tests/packages-04.lsp b/ansi-tests/packages-04.lsp new file mode 100644 index 0000000..f9dabec --- /dev/null +++ b/ansi-tests/packages-04.lsp @@ -0,0 +1,57 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 07:59:10 1998 +;;;; Contains: Package test code, part 04 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; intern + +(deftest intern.1 + (progn + (safely-delete-package "TEMP1") + (let ((p (make-package "TEMP1")) + (i 0) x y) + (multiple-value-bind* (sym1 status1) + (find-symbol "FOO" p) + (intern (progn (setf x (incf i)) "FOO") + (progn (setf y (incf i)) p)) + (multiple-value-bind* (sym2 status2) + (find-symbol "FOO" p) + (and (eql i 2) + (eql x 1) + (eql y 2) + (null sym1) + (null status1) + (string= (symbol-name sym2) "FOO") + (eqt (symbol-package sym2) p) + (eqt status2 :internal) + (progn (delete-package p) t)))))) + t) + +(deftest intern.2 + (progn + (safely-delete-package "TEMP1") + (let ((p (make-package "TEMP1"))) + (multiple-value-bind* (sym1 status1) + (find-symbol "FOO" "TEMP1") + (intern "FOO" "TEMP1") + (multiple-value-bind* (sym2 status2) + (find-symbol "FOO" p) + (and (null sym1) + (null status1) + (string= (symbol-name sym2) "FOO") + (eqt (symbol-package sym2) p) + (eqt status2 :internal) + (progn (delete-package p) t)))))) + t) + +(deftest intern.error.1 + (classify-error (intern)) + program-error) + +(deftest intern.error.2 + (classify-error (intern "X" "CL" nil)) + program-error) diff --git a/ansi-tests/packages-05.lsp b/ansi-tests/packages-05.lsp new file mode 100644 index 0000000..6085e34 --- /dev/null +++ b/ansi-tests/packages-05.lsp @@ -0,0 +1,110 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 07:59:45 1998 +;;;; Contains: Package test code, part 05 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; export + +(deftest export.1 + (let ((return-value nil)) + (safely-delete-package "TEST1") + (let ((p (make-package "TEST1"))) + (let ((sym (intern "FOO" p)) + (i 0) x y) + (setf return-value (export (progn (setf x (incf i)) sym) + (progn (setf y (incf i)) p))) + (multiple-value-bind* (sym2 status) + (find-symbol "FOO" p) + (prog1 + (and sym2 + (eql i 2) + (eql x 1) + (eql y 2) + (eqt (symbol-package sym2) p) + (string= (symbol-name sym2) "FOO") + (eqt sym sym2) + (eqt status :external)) + (delete-package p))))) + return-value) + t) + +(deftest export.2 + (progn + (safely-delete-package "TEST1") + (let ((p (make-package "TEST1"))) + (let ((sym (intern "FOO" p))) + (export (list sym) p) + (multiple-value-bind* (sym2 status) + (find-symbol "FOO" p) + (prog1 + (and sym2 + (eqt (symbol-package sym2) p) + (string= (symbol-name sym2) "FOO") + (eqt sym sym2) + (eqt status :external)) + (delete-package p)))))) + t) + +(deftest export.3 + (handler-case + (progn + (safely-delete-package "F") + (make-package "F") + (let ((sym (intern "FOO" "F"))) + (export sym #\F) + (delete-package "F") + t)) + (error (c) (safely-delete-package "F") c)) + t) + +;; +;; When a symbol not in a package is exported, export +;; should signal a correctable package-error asking the +;; user whether the symbol should be imported. +;; +(deftest export.4 + (handler-case + (export 'b::bar "A") + (package-error () 'package-error) + (error (c) c)) + package-error) + +;; +;; Test that it catches an attempt to export a symbol +;; from a package that is used by another package that +;; is exporting a symbol with the same name. +;; +(deftest export.5 + (progn + (safely-delete-package "TEST1") + (safely-delete-package "TEST2") + (make-package "TEST1") + (make-package "TEST2" :use '("TEST1")) + (export (intern "X" "TEST2") "TEST2") + (prog1 + (handler-case + (let ((sym (intern "X" "TEST1"))) + (handler-case + (export sym "TEST1") + (error (c) + (format t "Caught error in EXPORT.5: ~A~%" c) + 'caught))) + (error (c) c)) + (delete-package "TEST2") + (delete-package "TEST1"))) + caught) + +(deftest export.error.1 + (classify-error (export)) + program-error) + +(deftest export.error.2 + (classify-error (export 'X "CL-TEST" NIL)) + program-error) + + + diff --git a/ansi-tests/packages-06.lsp b/ansi-tests/packages-06.lsp new file mode 100644 index 0000000..a1580c6 --- /dev/null +++ b/ansi-tests/packages-06.lsp @@ -0,0 +1,176 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:00:28 1998 +;;;; Contains: Package test code, part 06 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; rename-package + +(deftest rename-package.1 + (block nil + (safely-delete-package "TEST1") + (safely-delete-package "TEST2") + (let ((p (make-package "TEST1")) + (i 0) x y) + (unless (packagep p) (return nil)) + (let ((p2 (rename-package (progn (setf x (incf i)) "TEST1") + (progn (setf y (incf i)) "TEST2")))) + (unless (packagep p2) + (safely-delete-package p) + (return p2)) + (unless (and (eqt p p2) + (eql i 2) + (eql x 1) + (eql y 2) + (equal (package-name p2) "TEST2")) + (safely-delete-package p) + (safely-delete-package p2) + (return nil)) + (safely-delete-package p2) + t))) + t) + +(deftest rename-package.2 + (block nil + (safely-delete-package "TEST1") + (safely-delete-package "TEST2") + (safely-delete-package "TEST3") + (safely-delete-package "TEST4") + (safely-delete-package "TEST5") + (let ((p (make-package "TEST1")) + (nicknames (copy-list '("TEST3" "TEST4" "TEST5")))) + (unless (packagep p) (return nil)) + (let ((p2 (rename-package "TEST1" "TEST2" nicknames))) + (unless (packagep p2) + (safely-delete-package p) + (return p2)) + (unless (and (eqt p p2) + (equal (package-name p2) "TEST2") + (null (set-exclusive-or nicknames + (package-nicknames p2) + :test #'equal))) + (safely-delete-package p) + (safely-delete-package p2) + (return nil)) + (safely-delete-package p2) + t))) + t) + +(deftest rename-package.3 + (block nil + (safely-delete-package "TEST1") + (safely-delete-package "TEST2") + (let ((p (make-package "TEST1")) + (nicknames (copy-list '(#\M #\N)))) + (unless (packagep p) (return nil)) + (let ((p2 (ignore-errors (rename-package "TEST1" "TEST2" nicknames)))) + (unless (packagep p2) + (safely-delete-package p) + (return p2)) + (unless (and (eqt p p2) + (equal (package-name p2) "TEST2") + (equal + (sort (copy-list (package-nicknames p2)) + #'string<) + (sort (mapcar #'(lambda (c) + (make-string 1 :initial-element c)) + nicknames) + #'string<))) + (safely-delete-package p) + (safely-delete-package p2) + (return nil)) + (safely-delete-package p2) + t))) + t) + +(deftest rename-package.4 + (block nil + (safely-delete-package "G") + (safely-delete-package "TEST2") + (let ((p (make-package "G")) + (nicknames nil)) + (unless (packagep p) (return nil)) + (let ((p2 (ignore-errors (rename-package #\G "TEST2" nicknames)))) + (unless (packagep p2) + (safely-delete-package p) + (return p2)) + (unless (and (eqt p p2) + (equal (package-name p2) "TEST2") + (null (set-exclusive-or nicknames + (package-nicknames p2) + :test #'equal))) + (safely-delete-package p) + (safely-delete-package p2) + (return nil)) + (ignore-errors (safely-delete-package p2)) + t))) + t) + +(deftest rename-package.5 + (block nil + (safely-delete-package "TEST1") + (safely-delete-package "G") + (let ((p (make-package "TEST1")) + (nicknames nil)) + (unless (packagep p) (return nil)) + (let ((p2 (ignore-errors (rename-package "TEST1" #\G nicknames)))) + (unless (packagep p2) + (safely-delete-package p) + (return p2)) + (unless (and (eqt p p2) + (equal (package-name p2) "G") + (null (set-exclusive-or nicknames + (package-nicknames p2) + :test #'equal))) + (safely-delete-package p) + (safely-delete-package p2) + (return nil)) + (safely-delete-package p2) + t))) + t) + +(deftest rename-package.6 + (block nil + (safely-delete-package '|TEST1|) + (safely-delete-package '|TEST2|) + (safely-delete-package '|M|) + (safely-delete-package '|N|) + (let ((p (make-package '|TEST1|)) + (nicknames (copy-list '(|M| |N|)))) + (unless (packagep p) (return nil)) + (let ((p2 (ignore-errors (rename-package + '|TEST1| '|TEST2| nicknames)))) + (unless (packagep p2) + (safely-delete-package p) + (return p2)) + (unless (and (eqt p p2) + (equal (package-name p2) "TEST2") + (equal + (sort (copy-list (package-nicknames p2)) + #'string<) + (sort (mapcar #'symbol-name nicknames) + #'string<))) + (safely-delete-package p) + (safely-delete-package p2) + (return nil)) + (safely-delete-package p2) + t))) + t) + +(deftest rename-package.error.1 + (classify-error (rename-package)) + program-error) + +(deftest rename-package.error.2 + (classify-error (rename-package "CL")) + program-error) + +(deftest rename-package.error.3 + (classify-error (rename-package "A" "XXXXX" NIL NIL)) + program-error) + + + diff --git a/ansi-tests/packages-07.lsp b/ansi-tests/packages-07.lsp new file mode 100644 index 0000000..9d3c0cf --- /dev/null +++ b/ansi-tests/packages-07.lsp @@ -0,0 +1,231 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:01:20 1998 +;;;; Contains: Package test code, part 07 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; shadow + +(deftest shadow.1 + (prog1 + (progn + (safely-delete-package "TEST5") + (safely-delete-package "TEST4") + (handler-case + (let* ((p1 (prog1 + (make-package "TEST4") + (export (intern "A" "TEST4") "TEST4"))) + (p2 (make-package "TEST5" :use '("TEST4"))) + (r1 (package-shadowing-symbols "TEST4")) + (r2 (package-shadowing-symbols "TEST5"))) + (multiple-value-bind* (s1 kind1) + (find-symbol "A" p1) + (multiple-value-bind* (s2 kind2) + (find-symbol "A" p2) + (let ((r3 (shadow "A" p2))) + (multiple-value-bind* (s3 kind3) + (find-symbol "A" p2) + (list + (package-name p1) + (package-name p2) + r1 r2 + (symbol-name s1) + (package-name (symbol-package s1)) + kind1 + (symbol-name s2) + (package-name (symbol-package s2)) + kind2 + r3 + (symbol-name s3) + (package-name (symbol-package s3)) + kind3)))))) + (error (c) c))) + (safely-delete-package "TEST5") + (safely-delete-package "TEST4")) + ("TEST4" "TEST5" nil nil "A" "TEST4" :external + "A" "TEST4" :inherited + t + "A" "TEST5" :internal)) + +(deftest shadow.2 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (handler-case + (let* ((p1 (prog1 + (make-package "G") + (export (intern "A" "G") "G"))) + (p2 (make-package "H" :use '("G"))) + (r1 (package-shadowing-symbols "G")) + (r2 (package-shadowing-symbols "H"))) + (multiple-value-bind* (s1 kind1) + (find-symbol "A" p1) + (multiple-value-bind* (s2 kind2) + (find-symbol "A" p2) + (let ((r3 (shadow "A" "H"))) + (multiple-value-bind* (s3 kind3) + (find-symbol "A" p2) + (prog1 + (list (package-name p1) (package-name p2) + r1 r2 (symbol-name s1) (package-name (symbol-package s1)) + kind1 (symbol-name s2) (package-name (symbol-package s2)) + kind2 r3 (symbol-name s3) (package-name (symbol-package s3)) + kind3) + (safely-delete-package p2) + (safely-delete-package p1) + )))))) + (error (c) + (safely-delete-package "H") + (safely-delete-package "G") + c))) + ("G" "H" nil nil "A" "G" :external + "A" "G" :inherited + t + "A" "H" :internal)) + +;; shadow in which the package is given +;; by a character +(deftest shadow.3 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (handler-case + (let* ((p1 (prog1 + (make-package "G") + (export (intern "A" "G") "G"))) + (p2 (make-package "H" :use '("G"))) + (r1 (package-shadowing-symbols "G")) + (r2 (package-shadowing-symbols "H"))) + (multiple-value-bind* (s1 kind1) + (find-symbol "A" p1) + (multiple-value-bind* (s2 kind2) + (find-symbol "A" p2) + (let ((r3 (shadow "A" #\H))) + (multiple-value-bind* (s3 kind3) + (find-symbol "A" p2) + (prog1 + (list (package-name p1) (package-name p2) + r1 r2 (symbol-name s1) (package-name (symbol-package s1)) + kind1 (symbol-name s2) (package-name (symbol-package s2)) + kind2 r3 (symbol-name s3) (package-name (symbol-package s3)) + kind3) + (safely-delete-package p2) + (safely-delete-package p1) + )))))) + (error (c) + (safely-delete-package "H") + (safely-delete-package "G") + c))) + ("G" "H" nil nil "A" "G" :external + "A" "G" :inherited + t + "A" "H" :internal)) + + +;; shadow on an existing internal symbol returns the existing symbol +(deftest shadow.4 + (prog1 + (handler-case + (progn + (safely-delete-package :G) + (make-package :G) + (let ((s1 (intern "X" :G))) + (shadow "X" :G) + (multiple-value-bind* (s2 kind) + (find-symbol "X" :G) + (list (eqt s1 s2) + (symbol-name s2) + (package-name (symbol-package s2)) + kind)))) + (error (c) c)) + (safely-delete-package "G")) + (t "X" "G" :internal)) + + +;; shadow of an existing shadowed symbol returns the symbol +(deftest shadow.5 + (prog1 + (handler-case + (progn + (safely-delete-package :H) + (safely-delete-package :G) + (make-package :G) + (export (intern "X" :G) :G) + (make-package :H :use '("G")) + (shadow "X" :H) + (multiple-value-bind* (s1 kind1) + (find-symbol "X" :H) + (shadow "X" :H) + (multiple-value-bind* (s2 kind2) + (find-symbol "X" :H) + (list (eqt s1 s2) kind1 kind2)))) + (error (c) c)) + (safely-delete-package :H) + (safely-delete-package :G)) + (t :internal :internal)) + +;; Shadow several names simultaneously + +(deftest shadow.6 + (prog1 + (handler-case + (progn + (safely-delete-package :G) + (make-package :G) + (shadow '("X" "Y" |Z|) :G) + (let ((results + (append (multiple-value-list + (find-symbol "X" :G)) + (multiple-value-list + (find-symbol "Y" :G)) + (multiple-value-list + (find-symbol "Z" :G)) + nil))) + (list + (symbol-name (first results)) + (second results) + (symbol-name (third results)) + (fourth results) + (symbol-name (fifth results)) + (sixth results) + (length (package-shadowing-symbols :G))))) + (error (c) c)) + (safely-delete-package :G)) + ("X" :internal "Y" :internal "Z" :internal 3)) + +;; Same, but shadow character string designators +(deftest shadow.7 + (prog1 + (handler-case + (let ((i 0) x y) + (safely-delete-package :G) + (make-package :G) + (shadow (progn (setf x (incf i)) '(#\X #\Y)) + (progn (setf y (incf i)) :G)) + (let ((results + (append (multiple-value-list + (find-symbol "X" :G)) + (multiple-value-list + (find-symbol "Y" :G)) + nil))) + (list + i x y + (symbol-name (first results)) + (second results) + (symbol-name (third results)) + (fourth results) + (length (package-shadowing-symbols :G))))) + (error (c) c)) + (safely-delete-package :G)) + (2 1 2 "X" :internal "Y" :internal 2)) + +(deftest shadow.error.1 + (classify-error (shadow)) + program-error) + +(deftest shadow.error.2 + (classify-error (shadow "X" "CL-USER" nil)) + program-error) diff --git a/ansi-tests/packages-08.lsp b/ansi-tests/packages-08.lsp new file mode 100644 index 0000000..d35d09b --- /dev/null +++ b/ansi-tests/packages-08.lsp @@ -0,0 +1,148 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:01:58 1998 +;;;; Contains: Package test code, part 08 + +(in-package :cl-test) +(declaim (optimize (safety 3))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; delete-package + +;; check return value of delete-package, and check +;; that package-name is nil on the deleted package object +(deftest delete-package.1 + (progn + (safely-delete-package :test1) + (let ((p (make-package :test1 :use nil))) + (list + (notnot (delete-package :test1)) + (notnot (packagep p)) + (package-name p)))) + (t t nil)) + +(deftest delete-package.2 + (progn + (safely-delete-package :test1) + (let ((p (make-package :test1 :use nil))) + (list + (notnot (delete-package :test1)) + (notnot (packagep p)) + (delete-package p)))) + (t t nil)) + +;; Check that deletion of different package designators works +(deftest delete-package.3 + (progn + (safely-delete-package "X") + (make-package "X") + (handler-case + (notnot (delete-package "X")) + (error (c) c))) + t) + +(deftest delete-package.4 + (progn + (safely-delete-package "X") + (make-package "X") + (handler-case + (notnot (delete-package #\X)) + (error (c) c))) + t) + +;;; PFD 10/14/02 -- These tests are broken again. I suspect +;;; some sort of interaction with the test harness. + +;;; PFD 01.18.03 This test is working, but suspicious. + +(deftest delete-package.5 + (prog (P1 S1 P2 S2 P3) + (safely-delete-package "P3") + (safely-delete-package "P2") + (safely-delete-package "P1") + + (setq P1 (make-package "P1" :use ())) + (setq S1 (intern "S1" P1)) + (export S1 "P1") + + (setq P2 (make-package "P2" :use '("P1"))) + (setq S2 (intern "S2" P2)) + (export S1 P2) + (export S2 "P2") + + (setf P3 (make-package "P3" :use '("P2"))) + + ;; Delete the P2 package, catching the continuable + ;; error and deleting the package + + (handler-bind ((package-error + #'(lambda (c) + (let ((r (find-restart 'continue c))) + (and r (invoke-restart r)))))) + (delete-package P2)) + + (unless (and (equal (package-name P1) "P1") + (null (package-name P2)) + (equal (package-name P3) "P3")) + (return 'fail1)) + + (unless (eqt (symbol-package S1) P1) + (return 'fail2)) + (unless (equal (prin1-to-string S1) "P1:S1") + (return 'fail3)) + + (unless (equal (multiple-value-list (find-symbol "S1" P3)) + '(nil nil)) + (return 'fail4)) + + (unless (equal (multiple-value-list (find-symbol "S2" P3)) + '(nil nil)) + (return 'fail5)) + + (unless (and (null (package-used-by-list P1)) + (null (package-used-by-list P3))) + (return 'fail6)) + + (unless (and (packagep P1) + (packagep P2) + (packagep P3)) (return 'fail7)) + + (unless (and (null (package-use-list P1)) + (null (package-use-list P3))) + (return 'fail8)) + + (safely-delete-package P3) + (safely-delete-package P1) + (return t)) + t) + +;; deletion of a nonexistent package should cause a continuable +;; package-error (same comments for delete-package.5 apply +;; here as well) + +;;; PFD 10/14/02 -- These tests are broken again. I suspect +;;; some sort of interaction with the test harness. + +;;; PFD 01.18.03 This test is working, but suspicious. + +(deftest delete-package.6 + (progn + (safely-delete-package "TEST-20)") + (handler-bind ((package-error + #'(lambda (c) + (let ((r (find-restart 'continue c))) + (and r (invoke-restart r)))))) + (and (not (delete-package "TEST-20")) + t))) + t) + +(deftest delete-package.error.1 + (classify-error (delete-package)) + program-error) + +(deftest delete-package.error.2 + (progn + (unless (find-package "TEST-DPE2") + (make-package "TEST-DPE2" :use nil)) + (classify-error (delete-package "TEST-DPE2" nil))) + program-error) + diff --git a/ansi-tests/packages-09.lsp b/ansi-tests/packages-09.lsp new file mode 100644 index 0000000..67a86ba --- /dev/null +++ b/ansi-tests/packages-09.lsp @@ -0,0 +1,324 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:02:43 1998 +;;;; Contains: Package test code, part 09 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; make-package + +;; Test basic make-package, using string, symbol and character +;; package-designators + +(deftest make-package.1 + (progn + (safely-delete-package "TEST1") + (let ((p (ignore-errors (make-package "TEST1")))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.2 + (progn + (safely-delete-package '#:|TEST1|) + (let ((p (ignore-errors (make-package '#:|TEST1|)))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.3 + (progn + (safely-delete-package #\X) + (let ((p (ignore-errors (make-package #\X)))) + (prog1 + (and (packagep p) + (equalt (package-name p) "X") + (equalt (package-nicknames p) nil) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +;; Same, but with a null :use list + +(deftest make-package.4 + (progn + (safely-delete-package "TEST1") + (let ((p (ignore-errors (make-package "TEST1" :use nil)))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) nil) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.5 + (progn + (safely-delete-package '#:|TEST1|) + (let ((p (ignore-errors (make-package '#:|TEST1| :use nil)))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) nil) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.6 + (progn + (safely-delete-package #\X) + (let ((p (make-package #\X))) + (prog1 + (and (packagep p) + (equalt (package-name p) "X") + (equalt (package-nicknames p) nil) + ;; (equalt (package-use-list p) nil) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +;; Same, but use the A package + +(deftest make-package.7 + (progn + (safely-delete-package "TEST1") + (let ((p (ignore-errors (make-package "TEST1" :use '("A"))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.7a + (progn + (safely-delete-package "TEST1") + (let ((p (ignore-errors (make-package "TEST1" :use '(#:|A|))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.7b + (progn + (safely-delete-package "TEST1") + (let ((p (ignore-errors (make-package "TEST1" :use '(#\A))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.8 + (progn + (safely-delete-package '#:|TEST1|) + (let ((p (ignore-errors (make-package '#:|TEST1| :use '("A"))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.8a + (progn + (safely-delete-package '#:|TEST1|) + (let ((p (ignore-errors (make-package '#:|TEST1| :use '(#:|A|))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.8b + (progn + (safely-delete-package '#:|TEST1|) + (let ((p (ignore-errors (make-package '#:|TEST1| :use '(#\A))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.9 + (progn + (safely-delete-package #\X) + (let ((p (ignore-errors (make-package #\X :use '("A"))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "X") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.9a + (progn + (safely-delete-package #\X) + (let ((p (ignore-errors (make-package #\X :use '(#:|A|))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "X") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.9b + (progn + (safely-delete-package #\X) + (let ((p (ignore-errors (make-package #\X :use '(#\A))))) + (prog1 + (and (packagep p) + (equalt (package-name p) "X") + (equalt (package-nicknames p) nil) + (equalt (package-use-list p) (list (find-package "A"))) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +;; make-package with nicknames + +(deftest make-package.10 + (progn + (safely-delete-package "TEST1") + (let ((p (make-package "TEST1" :nicknames '("F")))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) '("F")) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.11 + (progn + (safely-delete-package '#:|TEST1|) + (let ((p (make-package '#:|TEST1| :nicknames '(#:|G|)))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) '("G")) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.12 + (progn + (safely-delete-package '#:|TEST1|) + (let ((p (make-package '#:|TEST1| :nicknames '(#\G)))) + (prog1 + (and (packagep p) + (equalt (package-name p) "TEST1") + (equalt (package-nicknames p) '("G")) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +(deftest make-package.13 + (progn + (safely-delete-package #\X) + (let ((p (make-package #\X :nicknames '("F" #\G #:|H|)))) + (prog1 + (and (packagep p) + (equalt (package-name p) "X") + (null (set-exclusive-or (package-nicknames p) + '("F" "G" "H") + :test #'equal)) + (equalt (package-used-by-list p) nil)) + (safely-delete-package p)))) + t) + +;; Signal a continuable error if the package or any nicknames +;; exist as packages or nicknames of packages + +(deftest make-package.error.1 + (handle-non-abort-restart (make-package "A")) + success) + +(deftest make-package.error.2 + (handle-non-abort-restart (make-package "Q")) + success) + +(deftest make-package.error.3 + (handle-non-abort-restart + (safely-delete-package "TEST1") + (make-package "TEST1" :nicknames '("A"))) + success) + +(deftest make-package.error.4 + (handle-non-abort-restart + (safely-delete-package "TEST1") + (make-package "TEST1" :nicknames '("Q"))) + success) + +(deftest make-package.error.5 + (classify-error (make-package)) + program-error) + +(deftest make-package.error.6 + (progn + (safely-delete-package "MPE6") + (classify-error (make-package "MPE6" :bad t))) + program-error) + +(deftest make-package.error.7 + (progn + (safely-delete-package "MPE7") + (classify-error (make-package "MPE7" :nicknames))) + program-error) + +(deftest make-package.error.8 + (progn + (safely-delete-package "MPE8") + (classify-error (make-package "MPE8" :use))) + program-error) + +(deftest make-package.error.9 + (progn + (safely-delete-package "MPE9") + (classify-error (make-package "MPE9" 'bad t))) + program-error) + +(deftest make-package.error.10 + (progn + (safely-delete-package "MPE10") + (classify-error (make-package "MPE10" 1 2))) + program-error) + +(deftest make-package.error.11 + (progn + (safely-delete-package "MPE11") + (classify-error (make-package "MPE11" 'bad t :allow-other-keys nil))) + program-error) diff --git a/ansi-tests/packages-10.lsp b/ansi-tests/packages-10.lsp new file mode 100644 index 0000000..d8ff897 --- /dev/null +++ b/ansi-tests/packages-10.lsp @@ -0,0 +1,121 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:03:36 1998 +;;;; Contains: Package test code, part 10 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; with-package-iterator + +(deftest with-package-iterator.1 + (with-package-iterator-internal (list (find-package "COMMON-LISP-USER"))) + t) + +(deftest with-package-iterator.2 + (with-package-iterator-external (list (find-package "COMMON-LISP-USER"))) + t) + +(deftest with-package-iterator.3 + (with-package-iterator-inherited (list (find-package "COMMON-LISP-USER"))) + t) + +(deftest with-package-iterator.4 + (with-package-iterator-all (list (find-package "COMMON-LISP-USER"))) + t) + +;;; Should test on some packages containing shadowed symbols, +;;; multiple inheritance + +(deftest with-package-iterator.5 + (with-package-iterator-all '("A")) + t) + +(deftest with-package-iterator.6 + (with-package-iterator-all '(#:|A|)) + t) + +(deftest with-package-iterator.7 + (with-package-iterator-all '(#\A)) + t) + +(deftest with-package-iterator.8 + (with-package-iterator-internal (list (find-package "A"))) + t) + +(deftest with-package-iterator.9 + (with-package-iterator-external (list (find-package "A"))) + t) + +(deftest with-package-iterator.10 + (with-package-iterator-inherited (list (find-package "A"))) + t) + +;;; Check that if no access symbols are provided, a program error is +;;; raised +#| +(deftest with-package-iterator.11 + (handler-case + (progn + (test-with-package-iterator (list (find-package "COMMON-LISP-USER"))) + nil) + (program-error () t) + (error (c) c)) + t) +|# + +;;; Paul Werkowski" pointed out that +;;; that test is broken. Here's a version of the replacement +;;; he suggested. +;; +;;; I'm not sure if this is correct either; it depends on +;;; whether with-package-iterator should signal the error +;;; at macro expansion time or at run time. +;; +;;; PFD 01-18-03: I should rewrite this to use CLASSIFY-ERROR, which +;;; uses EVAL to avoid that problem. + +(deftest with-package-iterator.11 + (handler-case (macroexpand-1 + '(with-package-iterator (x "COMMON-LISP-USER"))) + (program-error () t) + (error (c) c)) + t) + +;;; Apply to all packages +(deftest with-package-iterator.12 + (loop + for p in (list-all-packages) count + (handler-case + (progn + (format t "Package ~S~%" p) + (not (with-package-iterator-internal (list p)))) + (error (c) + (format "Error ~S on package ~A~%" c p) + t))) + 0) + +(deftest with-package-iterator.13 + (loop + for p in (list-all-packages) count + (handler-case + (progn + (format t "Package ~S~%" p) + (not (with-package-iterator-external (list p)))) + (error (c) + (format "Error ~S on package ~A~%" c p) + t))) + 0) + +(deftest with-package-iterator.14 + (loop + for p in (list-all-packages) count + (handler-case + (progn + (format t "Package ~S~%" p) + (not (with-package-iterator-inherited (list p)))) + (error (c) + (format t "Error ~S on package ~S~%" c p) + t))) + 0) diff --git a/ansi-tests/packages-11.lsp b/ansi-tests/packages-11.lsp new file mode 100644 index 0000000..71e2cd3 --- /dev/null +++ b/ansi-tests/packages-11.lsp @@ -0,0 +1,143 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:04:19 1998 +;;;; Contains: Package test code, part 11 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; unexport + +(deftest unexport.1 + (progn + (safely-delete-package "X") + (let* ((p (make-package "X" :use nil)) + (r (export (intern "X" p) p)) + (i 0) x y) + (multiple-value-bind* + (sym1 access1) + (find-symbol "X" p) + (unexport (progn (setf x (incf i)) sym1) + (progn (setf y (incf i)) p)) + (multiple-value-bind* + (sym2 access2) + (find-symbol "X" p) + (and (eqt r t) + (eql i 2) (eql x 1) (eql y 2) + (eqt sym1 sym2) + (eqt access1 :external) + (eqt access2 :internal) + (equal (symbol-name sym1) "X") + t))))) + t) + +(deftest unexport.2 + (progn + (safely-delete-package "X") + (let* ((p (make-package "X" :use nil)) + (r (export (intern "X" p) p))) + (multiple-value-bind* + (sym1 access1) + (find-symbol "X" p) + (unexport (list sym1) "X") + (multiple-value-bind* + (sym2 access2) + (find-symbol "X" p) + (and (eqt sym1 sym2) + (eqt r t) + (eqt access1 :external) + (eqt access2 :internal) + (equal (symbol-name sym1) "X") + t))))) + t) + +(deftest unexport.3 + (progn + (safely-delete-package "X") + (let* ((p (make-package "X" :use nil)) + (r1 (export (intern "X" p) p)) + (r2 (export (intern "Y" p) p))) + (multiple-value-bind* + (sym1 access1) + (find-symbol "X" p) + (multiple-value-bind* + (sym1a access1a) + (find-symbol "Y" p) + (unexport (list sym1 sym1a) '#:|X|) + (multiple-value-bind* + (sym2 access2) + (find-symbol "X" p) + (multiple-value-bind* + (sym2a access2a) + (find-symbol "Y" p) + (and (eqt sym1 sym2) + (eqt sym1a sym2a) + (eqt r1 t) + (eqt r2 t) + (eqt access1 :external) + (eqt access2 :internal) + (eqt access1a :external) + (eqt access2a :internal) + (equal (symbol-name sym1) "X") + (equal (symbol-name sym1a) "Y") + t))))))) + t) + +(deftest unexport.4 + (progn + (safely-delete-package "X") + (let* ((p (make-package "X" :use nil)) + (r (export (intern "X" p) p))) + (multiple-value-bind* + (sym1 access1) + (find-symbol "X" p) + (unexport (list sym1) #\X) + (multiple-value-bind* + (sym2 access2) + (find-symbol "X" p) + (and (eqt sym1 sym2) + (eqt r t) + (eqt access1 :external) + (eqt access2 :internal) + (equal (symbol-name sym1) "X") + t))))) + t) + +;; Check that it signals a package error when unexporting +;; an inaccessible symbol + +(deftest unexport.5 + (classify-error + (progn + (when (find-package "X") (delete-package "X")) + (unexport 'a (make-package "X" :use nil)) + nil)) + package-error) + +;; Check that internal symbols are left alone + +(deftest unexport.6 + (progn + (when (find-package "X") (delete-package "X")) + (let ((p (make-package "X" :use nil))) + (let* ((sym (intern "FOO" p)) + (r (unexport sym p))) + (multiple-value-bind* + (sym2 access) + (find-symbol "FOO" p) + (and (eqt r t) + (eqt access :internal) + (eqt sym sym2) + (equal (symbol-name sym) "FOO") + t))))) + t) + +(deftest unexport.error.1 + (classify-error (unexport)) + program-error) + +(deftest unexport.error.2 + (classify-error (unexport 'xyz "CL-TEST" nil)) + program-error) + diff --git a/ansi-tests/packages-12.lsp b/ansi-tests/packages-12.lsp new file mode 100644 index 0000000..b1614ca --- /dev/null +++ b/ansi-tests/packages-12.lsp @@ -0,0 +1,247 @@ +();-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:04:56 1998 +;;;; Contains: Package test code, part 12 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; unintern + +;; Simple unintern of an internal symbol, package explicitly +;; given as a package object +(deftest unintern.1 + (progn + (safely-delete-package "H") + (prog1 + (let ((p (make-package "H")) + (i 0) x y) + (intern "FOO" p) + (multiple-value-bind* + (sym access) + (find-symbol "FOO" p) + (and + (eqt access :internal) + (unintern (progn (setf x (incf i)) sym) + (progn (setf y (incf i)) p)) + (eql i 2) (eql x 1) (eql y 2) + (null (symbol-package sym)) + (not (find-symbol "FOO" p))))) + (safely-delete-package "H"))) + t) + +;; Simple unintern, package taken from the *PACKAGES* +;; special variable (should this have unwind protect?) +(deftest unintern.2 + (progn + (safely-delete-package "H") + (prog1 + (let ((*PACKAGE* (make-package "H"))) + (declare (special *PACKAGE*)) + (intern "FOO") + (multiple-value-bind* (sym access) + (find-symbol "FOO") + (and + (eqt access :internal) + (unintern sym) + (null (symbol-package sym)) + (not (find-symbol "FOO"))))) + (safely-delete-package "H"))) + t) + +;; Simple unintern, package given as string +(deftest unintern.3 + (progn + (safely-delete-package "H") + (prog1 + (let ((p (make-package "H"))) + (intern "FOO" p) + (multiple-value-bind* (sym access) + (find-symbol "FOO" p) + (and + (eqt access :internal) + (unintern sym "H") + (null (symbol-package sym)) + (not (find-symbol "FOO" p))))) + (safely-delete-package "H"))) + t) + +;; Simple unintern, package given as symbol +(deftest unintern.4 + (progn + (safely-delete-package "H") + (prog1 + (let ((p (make-package "H"))) + (intern "FOO" p) + (multiple-value-bind* (sym access) + (find-symbol "FOO" p) + (and + (eqt access :internal) + (unintern sym '#:|H|) + (null (symbol-package sym)) + (not (find-symbol "FOO" p))))) + (safely-delete-package "H"))) + t) + +;; Simple unintern, package given as character +(deftest unintern.5 + (handler-case + (progn + (safely-delete-package "H") + (prog1 + (let ((p (make-package "H"))) + (intern "FOO" p) + (multiple-value-bind* (sym access) + (find-symbol "FOO" p) + (and + (eqt access :internal) + (unintern sym #\H) + (null (symbol-package sym)) + (not (find-symbol "FOO" p))))) + (safely-delete-package "H"))) + (error (c) c)) + t) + + +;; Test more complex examples of unintern + +;; Unintern an external symbol that is also inherited + +(deftest unintern.6 + (handler-case + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (make-package "G") + (export (intern "FOO" "G") "G") + (make-package "H" :use '("G")) + (export (intern "FOO" "H") "H") + ;; At this point, G:FOO is also an external + ;; symbol of H. + (multiple-value-bind* (sym1 access1) + (find-symbol "FOO" "H") + (and sym1 + (eqt access1 :external) + (equal "FOO" (symbol-name sym1)) + (eqt (find-package "G") + (symbol-package sym1)) + (unintern sym1 "H") + (multiple-value-bind* (sym2 access2) + (find-symbol "FOO" "H") + (and (eqt sym1 sym2) + (eqt (symbol-package sym1) + (find-package "G")) + (eqt access2 :inherited)))))) + (error (c) c)) + t) + +;; unintern a symbol that is shadowing another symbol + +(deftest unintern.7 + (block failed + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G")) + (ph (make-package "H" :use (list pg)))) + (handler-case + (shadow "FOO" ph) + (error (c) (return-from failed (list :shadow-error c)))) + (export (intern "FOO" pg) pg) + ;; At this point, H::FOO shadows G:FOO + (multiple-value-bind* (sym1 access1) + (find-symbol "FOO" ph) + (and + sym1 + (eqt (symbol-package sym1) ph) + (eqt access1 :internal) + (equal (list sym1) (package-shadowing-symbols ph)) + (unintern sym1 ph) + (multiple-value-bind* (sym2 access2) + (find-symbol "FOO" ph) + (and (not (eqt sym1 sym2)) + (eqt access2 :inherited) + (null (symbol-package sym1)) + (eqt (symbol-package sym2) pg))))))) + t) + +;; Error situation: when the symbol is uninterned, creates +;; a name conflict from two used packages +(deftest unintern.8 + (block failed + (safely-delete-package "H") + (safely-delete-package "G1") + (safely-delete-package "G2") + (let* ((pg1 (make-package "G1")) + (pg2 (make-package "G2")) + (ph (make-package "H" :use (list pg1 pg2)))) + (handler-case + (shadow "FOO" ph) + (error (c) (return-from failed (list :shadow-error c)))) + (let ((gsym1 (intern "FOO" pg1)) + (gsym2 (intern "FOO" pg2))) + (export gsym1 pg1) + (export gsym2 pg2) + (multiple-value-bind* (sym1 access1) + (find-symbol "FOO" ph) + (and + (equal (list sym1) (package-shadowing-symbols ph)) + (not (eqt sym1 gsym1)) + (not (eqt sym1 gsym2)) + (eqt (symbol-package sym1) ph) + (eqt access1 :internal) + (equal (symbol-name sym1) "FOO") + (handler-case + (progn + (unintern sym1 ph) + nil) + (error (c) + (format t "Properly threw an error: ~S~%" c) + t))))))) + t) + +;; Now, inherit the same symbol through two intermediate +;; packages. No error should occur when the shadowing +;; is removed +(deftest unintern.9 + (block failed + (safely-delete-package "H") + (safely-delete-package "G1") + (safely-delete-package "G2") + (safely-delete-package "G3") + (let* ((pg3 (make-package "G3")) + (pg1 (make-package "G1" :use (list pg3))) + (pg2 (make-package "G2" :use (list pg3))) + (ph (make-package "H" :use (list pg1 pg2)))) + (handler-case + (shadow "FOO" ph) + (error (c) (return-from failed (list :shadow-error c)))) + (let ((gsym (intern "FOO" pg3))) + (export gsym pg3) + (export gsym pg1) + (export gsym pg2) + (multiple-value-bind* (sym access) + (find-symbol "FOO" ph) + (and + (equal (list sym) (package-shadowing-symbols ph)) + (not (eqt sym gsym)) + (equal (symbol-name sym) "FOO") + (equal (symbol-package sym) ph) + (eqt access :internal) + (handler-case + (and (unintern sym ph) + (multiple-value-bind* (sym2 access2) + (find-symbol "FOO" ph) + (and (eqt gsym sym2) + (eqt access2 :inherited)))) + (error (c) c))))))) + t) + +(deftest unintern.error.1 + (classify-error (unintern)) + program-error) + +(deftest unintern.error.2 + (classify-error (unintern '#:x "CL-TEST" nil)) + program-error) diff --git a/ansi-tests/packages-13.lsp b/ansi-tests/packages-13.lsp new file mode 100644 index 0000000..4add73c --- /dev/null +++ b/ansi-tests/packages-13.lsp @@ -0,0 +1,52 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:06:03 1998 +;;;; Contains: Package test code, part 13 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; in-package + +(deftest in-package.1 + (let ((*package* *package*)) + (declare (special *package*)) + (let ((p2 (in-package "A"))) + (and (eqt p2 (find-package "A")) + (eqt *package* p2)))) + t) + +(deftest in-package.2 + (let ((*package* *package*)) + (declare (special *package*)) + (let ((p2 (in-package |A|))) + (and (eqt p2 (find-package "A")) + (eqt *package* p2)))) + t) + +(deftest in-package.3 + (let ((*package* *package*)) + (declare (special *package*)) + (let ((p2 (in-package :|A|))) + (and (eqt p2 (find-package "A")) + (eqt *package* p2)))) + t) + +(deftest in-package.4 + (let ((*package* *package*)) + (declare (special *package*)) + (let ((p2 (in-package #\A))) + (and (eqt p2 (find-package "A")) + (eqt *package* p2)))) + t) + +(deftest in-package.5 + (let ((*package* *package*)) + (declare (special *package*)) + (safely-delete-package "H") + (handler-case + (eval '(in-package "H")) + (package-error () 'package-error) + (error (c) c))) + package-error) diff --git a/ansi-tests/packages-14.lsp b/ansi-tests/packages-14.lsp new file mode 100644 index 0000000..fe3a9b2 --- /dev/null +++ b/ansi-tests/packages-14.lsp @@ -0,0 +1,201 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:06:48 1998 +;;;; Contains: Package test code, part 14 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; unuse-package + +(deftest unuse-package.1 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G"))) + (i 0) x y) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (unuse-package (progn (setf x (incf i)) pg) + (progn (setf y (incf i)) ph)) + (eql i 2) (eql x 1) (eql y 2) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +(deftest unuse-package.2 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G")))) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (unuse-package "G" ph) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +(deftest unuse-package.3 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G")))) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (unuse-package :|G| ph) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +(deftest unuse-package.4 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G")))) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (ignore-errors (unuse-package #\G ph)) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +(deftest unuse-package.5 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G")))) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (unuse-package (list pg) ph) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +(deftest unuse-package.6 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G")))) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (unuse-package (list "G") ph) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +(deftest unuse-package.7 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G")))) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (unuse-package (list :|G|) ph) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +(deftest unuse-package.8 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use '("G")))) + (prog1 + (and + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (ignore-errors (unuse-package (list #\G) ph)) + (equal (package-use-list ph) nil) + (null (package-used-by-list pg))) + (safely-delete-package "H") + (safely-delete-package "G")))) + t) + +;; Now test with multiple packages + +(deftest unuse-package.9 + (progn + (dolist (p '("H1" "H2" "G1" "G2" "G3")) + (safely-delete-package p)) + (let* ((pg1 (make-package "G1" :use nil)) + (pg2 (make-package "G2" :use nil)) + (pg3 (make-package "G3" :use nil)) + (ph1 (make-package "H1" :use (list pg1 pg2 pg3))) + (ph2 (make-package "H2" :use (list pg1 pg2 pg3)))) + (let ((pubg1 (sort-package-list (package-used-by-list pg1))) + (pubg2 (sort-package-list (package-used-by-list pg2))) + (pubg3 (sort-package-list (package-used-by-list pg3))) + (puh1 (sort-package-list (package-use-list ph1))) + (puh2 (sort-package-list (package-use-list ph2)))) + (prog1 + (and + (= (length (remove-duplicates (list pg1 pg2 pg3 ph1 ph2))) + 5) + (equal (list ph1 ph2) pubg1) + (equal (list ph1 ph2) pubg2) + (equal (list ph1 ph2) pubg3) + (equal (list pg1 pg2 pg3) puh1) + (equal (list pg1 pg2 pg3) puh2) + (unuse-package (list pg1 pg3) ph1) + (equal (package-use-list ph1) (list pg2)) + (equal (package-used-by-list pg1) (list ph2)) + (equal (package-used-by-list pg3) (list ph2)) + (equal (sort-package-list (package-use-list ph2)) + (list pg1 pg2 pg3)) + (equal (sort-package-list (package-used-by-list pg2)) + (list ph1 ph2)) + t) + (dolist (p '("H1" "H2" "G1" "G2" "G3")) + (safely-delete-package p)))))) + t) + +(deftest unuse-package.error.1 + (classify-error (unuse-package)) + program-error) + +(deftest unuse-package.error.2 + (progn + (safely-delete-package "UPE2A") + (safely-delete-package "UPE2") + (make-package "UPE2" :use ()) + (make-package "UPE2A" :use '("UPE2")) + (classify-error (unuse-package "UPE2" "UPE2A" nil))) + program-error) diff --git a/ansi-tests/packages-15.lsp b/ansi-tests/packages-15.lsp new file mode 100644 index 0000000..c4d24a7 --- /dev/null +++ b/ansi-tests/packages-15.lsp @@ -0,0 +1,210 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:08:41 1998 +;;;; Contains: Package test code, part 15 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; use-package + +(deftest use-package.1 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use nil)) + (sym1 (intern "FOO" pg)) + (i 0) x y) + (and + (eqt (export sym1 pg) t) + (null (package-used-by-list pg)) + (null (package-used-by-list ph)) + (null (package-use-list pg)) + (null (package-use-list ph)) + (eqt (use-package (progn (setf x (incf i)) pg) + (progn (setf y (incf i)) ph)) + t) ;; "H" will use "G" + (eql i 2) (eql x 1) (eql y 2) + (multiple-value-bind (sym2 access) + (find-symbol "FOO" ph) + (and + (eqt access :inherited) + (eqt sym1 sym2))) + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (null (package-use-list pg)) + (null (package-used-by-list ph)) + (eqt (unuse-package pg ph) t) + (null (find-symbol "FOO" ph))))) + t) + +(deftest use-package.2 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use nil)) + (sym1 (intern "FOO" pg))) + (and + (eqt (export sym1 pg) t) + (null (package-used-by-list pg)) + (null (package-used-by-list ph)) + (null (package-use-list pg)) + (null (package-use-list ph)) + (eqt (use-package "G" "H") t) ;; "H" will use "G" + (multiple-value-bind (sym2 access) + (find-symbol "FOO" ph) + (and + (eqt access :inherited) + (eqt sym1 sym2))) + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (null (package-use-list pg)) + (null (package-used-by-list ph)) + (eqt (unuse-package pg ph) t) + (null (find-symbol "FOO" ph))))) + t) + +(deftest use-package.3 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use nil)) + (sym1 (intern "FOO" pg))) + (and + (eqt (export sym1 pg) t) + (null (package-used-by-list pg)) + (null (package-used-by-list ph)) + (null (package-use-list pg)) + (null (package-use-list ph)) + (eqt (use-package '#:|G| '#:|H|) t) ;; "H" will use "G" + (multiple-value-bind (sym2 access) + (find-symbol "FOO" ph) + (and + (eqt access :inherited) + (eqt sym1 sym2))) + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (null (package-use-list pg)) + (null (package-used-by-list ph)) + (eqt (unuse-package pg ph) t) + (null (find-symbol "FOO" ph))))) + t) + +(deftest use-package.4 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let* ((pg (make-package "G" :use nil)) + (ph (make-package "H" :use nil)) + (sym1 (intern "FOO" pg))) + (and + (eqt (export sym1 pg) t) + (null (package-used-by-list pg)) + (null (package-used-by-list ph)) + (null (package-use-list pg)) + (null (package-use-list ph)) + (eqt (ignore-errors (use-package #\G #\H)) + t) ;; "H" will use "G" + (multiple-value-bind (sym2 access) + (find-symbol "FOO" ph) + (and + (eqt access :inherited) + (eqt sym1 sym2))) + (equal (package-use-list ph) (list pg)) + (equal (package-used-by-list pg) (list ph)) + (null (package-use-list pg)) + (null (package-used-by-list ph)) + (eqt (unuse-package pg ph) t) + (null (find-symbol "FOO" ph))))) + t) + +;; use lists of packages + +(deftest use-package.5 + (let ((pkgs '("H" "G1" "G2" "G3")) + (vars '("FOO1" "FOO2" "FOO3"))) + (dolist (p pkgs) + (safely-delete-package p) + (make-package p :use nil)) + (and + (every (complement #'package-use-list) pkgs) + (every (complement #'package-used-by-list) pkgs) + (every #'(lambda (v p) + (export (intern v p) p)) + vars (cdr pkgs)) + (progn + (dolist (p (cdr pkgs)) (intern "MINE" p)) + (eqt (use-package (cdr pkgs) (car pkgs)) t)) + (every #'(lambda (v p) + (eqt (find-symbol v p) + (find-symbol v (car pkgs)))) + vars (cdr pkgs)) + (null (find-symbol "MINE" (car pkgs))) + (every #'(lambda (p) + (equal (package-used-by-list p) + (list (find-package (car pkgs))))) + (cdr pkgs)) + (equal (sort-package-list (package-use-list (car pkgs))) + (mapcar #'find-package (cdr pkgs))) + (every (complement #'package-use-list) (cdr pkgs)) + (null (package-used-by-list (car pkgs))))) + t) + +;; Circular package use + +(deftest use-package.6 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let ((pg (make-package "G")) + (ph (make-package "H")) + sym1 sym2 sym3 sym4 + a1 a2 a3 a4) + (prog1 + (and + (export (intern "X" pg) pg) + (export (intern "Y" ph) ph) + (use-package pg ph) + (use-package ph pg) + (progn + (multiple-value-setq + (sym1 a1) (find-symbol "X" pg)) + (multiple-value-setq + (sym2 a2) (find-symbol "Y" ph)) + (multiple-value-setq + (sym3 a3) (find-symbol "Y" pg)) + (multiple-value-setq + (sym4 a4) (find-symbol "X" ph)) + (and + (eqt a1 :external) + (eqt a2 :external) + (eqt a3 :inherited) + (eqt a4 :inherited) + (eqt sym1 sym4) + (eqt sym2 sym3) + (eqt (symbol-package sym1) pg) + (eqt (symbol-package sym2) ph) + (unuse-package pg ph) + (unuse-package ph pg)))) + (safely-delete-package pg) + (safely-delete-package ph)))) + t) + +;; Also: need to check that *PACKAGE* is used as a default + +(deftest use-package.error.1 + (classify-error (use-package)) + program-error) + +(deftest use-package.error.2 + (progn + (safely-delete-package "UPE2A") + (safely-delete-package "UPE2") + (make-package "UPE2" :use ()) + (make-package "UPE2A" :use ()) + (classify-error (use-package "UPE2" "UPE2A" nil))) + program-error) diff --git a/ansi-tests/packages-16.lsp b/ansi-tests/packages-16.lsp new file mode 100644 index 0000000..44a052a --- /dev/null +++ b/ansi-tests/packages-16.lsp @@ -0,0 +1,614 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:09:18 1998 +;;;; Contains: Package test code, part 16 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; defpackage + +;; Test basic defpackage call, with no options +;; The use-list is implementation dependent, so +;; we don't examine it here. +;; Try several ways of specifying the package name. +(deftest defpackage.1 + (loop + for n in '("H" #:|H| #\H) count + (not + (progn + (safely-delete-package "H") + (let ((p (ignore-errors (eval `(defpackage ,n))))) + (and + (packagep p) + (equal (package-name p) "H") + ;; (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + (null (documentation p t)) + ))))) + 0) + +;; Test :nicknames option +;; Do not check use-list, because it is implementation dependent +;; Try several ways of specifying a nickname. +(deftest defpackage.2 + (loop + for n in '("I" #:|I| #\I) count + (not + (ignore-errors + (progn + (safely-delete-package "H") + (let ((p (ignore-errors + (eval `(defpackage "H" (:nicknames ,n "J")))))) + (and + (packagep p) + (equal (package-name p) "H") + ;; (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (sort (copy-list (package-nicknames p)) + #'string<) + '("I" "J")) + (equal (package-shadowing-symbols p) nil) + (null (documentation p t)) + )))))) + 0) + +;; Test defpackage with documentation option +;; Do not check use-list, because it is implementation dependent +(deftest defpackage.3 + (progn + (safely-delete-package "H") + (ignore-errors + (let ((p (eval '(defpackage "H" (:documentation "This is a doc string"))))) + (and + (packagep p) + (equal (package-name p) "H") + ;; (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + ;; The spec says implementations are free to discard + ;; documentations, so this next form was wrong. + ;; Instead, we'll just computation DOCUMENTATION + ;; and throw away the value. + ;; (equal (documentation p t) "This is a doc string") + (progn (documentation p t) t) + )))) + t) + +;; Check use argument +;; Try several ways of specifying the package to be used +(deftest defpackage.4 + (loop + for n in '("A" :|A| #\A) count + (not + (ignore-errors + (progn + (safely-delete-package "H") + (let ((p (ignore-errors (eval `(defpackage "H" (:use ,n)))))) + (and + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) (list (find-package "A"))) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + (eql (num-symbols-in-package p) + (num-external-symbols-in-package "A")) + (equal (documentation p t) nil) + )))))) + 0) + +;; Test defpackage shadow option, and null use +(deftest defpackage.5 + (progn + (safely-delete-package "H") + (ignore-errors + (let ((p (ignore-errors (eval `(defpackage "H" (:use) + (:shadow "foo")))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (eql (num-symbols-in-package p) 1) + (multiple-value-bind* (sym access) + (find-symbol "foo" p) + (and (eqt access :internal) + (equal (symbol-name sym) "foo") + (equal (symbol-package sym) p) + (equal (package-shadowing-symbols p) + (list sym)))) + (equal (documentation p t) nil) + ))))) + (t t t t t t t t)) + +;; Test defpackage shadow and null use, with several ways +;; of specifying the name of the shadowed symbol +(deftest defpackage.6 + (loop + for s in '(:|f| #\f) + collect + (ignore-errors + (safely-delete-package "H") + (let ((p (ignore-errors (eval `(defpackage "H" + (:use) + (:shadow ,s)))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (eql (num-symbols-in-package p) 1) + (multiple-value-bind* (sym access) + (find-symbol "f" p) + (and (eqt access :internal) + (equal (symbol-name sym) "f") + (equal (symbol-package sym) p) + (equal (package-shadowing-symbols p) + (list sym)))) + (equal (documentation p t) nil) + ))))) + ((t t t t t t t t) + (t t t t t t t t))) + + +;; Testing defpackage with shadowing-import-from. +;; Test several ways of specifying the symbol name +(deftest defpackage.7 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let ((pg (make-package "G" :use nil))) + ;; Populate package G with several symbols + (export (intern "A" pg) pg) + (export (intern "foo" pg) pg) + (intern "bar" pg) + ;; Do test with several ways of specifying the + ;; shadowing-imported symbol + (loop + for n in '("A" :|A| #\A) + collect + (ignore-errors + (safely-delete-package "H") + (let ((p (ignore-errors + (eval + `(defpackage "H" + (:use) + (:shadowing-import-from "G" ,n)))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (eql (num-symbols-in-package p) 1) + (multiple-value-bind* (sym access) + (find-symbol "A" p) + (and (eqt access :internal) + (equal (symbol-name sym) "A") + (equal (symbol-package sym) pg) + (equal (package-shadowing-symbols p) + (list sym)))) + (equal (documentation p t) nil) + ))))))) + ((t t t t t t t t) + (t t t t t t t t) + (t t t t t t t t))) + +;; Test import-from option +;; Test for each way of specifying the imported symbol name, +;; and for each way of specifying the package name from which +;; the symbol is imported +(deftest defpackage.8 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (let ((pg (eval '(defpackage "G" (:use) (:intern "A" "B" "C"))))) + (loop + for pn in '("G" #:|G| #\G) + collect + (loop + for n in '("B" #:|B| #\B) + collect + (ignore-errors + (safely-delete-package "H") + (let ((p (ignore-errors + (eval `(defpackage + "H" (:use) + (:import-from ,pn ,n "A")))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + (eql (num-symbols-in-package p) 2) + (multiple-value-bind* (sym access) + (find-symbol "A" p) + (and (eqt access :internal) + (equal (symbol-name sym) "A") + (equal (symbol-package sym) pg))) + (multiple-value-bind* (sym access) + (find-symbol "B" p) + (and (eqt access :internal) + (equal (symbol-name sym) "B") + (equal (symbol-package sym) pg))) + (equal (documentation p t) nil) + )))))))) + (((t t t t t t t t t t) (t t t t t t t t t t) (t t t t t t t t t t)) + ((t t t t t t t t t t) (t t t t t t t t t t) (t t t t t t t t t t)) + ((t t t t t t t t t t) (t t t t t t t t t t) (t t t t t t t t t t)))) + +;; Test defpackage with export option + +(deftest defpackage.9 + (progn + (loop + for n in '("Z" #:|Z| #\Z) + collect + (ignore-errors + (safely-delete-package "H") + (let ((p (ignore-errors + (eval `(defpackage + "H" + (:export "Q" ,n "R") (:use)))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + (eql (num-symbols-in-package p) 3) + (loop + for s in '("Q" "Z" "R") do + (unless + (multiple-value-bind* (sym access) + (find-symbol s p) + (and (eqt access :external) + (equal (symbol-name sym) s) + (equal (symbol-package sym) p))) + (return nil)) + finally (return t)) + )))))) + ((t t t t t t t t)(t t t t t t t t)(t t t t t t t t))) + +;; Test defpackage with the intern option + +(deftest defpackage.10 + (progn + (loop + for n in '("Z" #:|Z| #\Z) + collect + (ignore-errors + (safely-delete-package "H") + (let ((p (ignore-errors + (eval `(defpackage + "H" + (:intern "Q" ,n "R") (:use)))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + (eql (num-symbols-in-package p) 3) + (loop + for s in '("Q" "Z" "R") do + (unless + (multiple-value-bind* (sym access) + (find-symbol s p) + (and (eqt access :internal) + (equal (symbol-name sym) s) + (equal (symbol-package sym) p))) + (return nil)) + finally (return t)) + )))))) + ((t t t t t t t t) (t t t t t t t t) (t t t t t t t t))) + +;; Test defpackage with size + +(deftest defpackage.11 + (ignore-errors + (safely-delete-package "H") + (let ((p (ignore-errors + (eval '(defpackage "H" (:use) (:size 0)))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + (zerop (num-symbols-in-package p)))))) + (t t t t t t t)) + +(deftest defpackage.12 + (ignore-errors + (safely-delete-package "H") + (let ((p (ignore-errors + (eval '(defpackage "H" (:use) (:size 10000)))))) + (mapcar + #'notnot + (list + (packagep p) + (equal (package-name p) "H") + (equal (package-use-list p) nil) + (equal (package-used-by-list p) nil) + (equal (package-nicknames p) nil) + (equal (package-shadowing-symbols p) nil) + (zerop (num-symbols-in-package p)))))) + (t t t t t t t)) + +;; defpackage error handling + +;; Repeated size field should cause a program-error +(deftest defpackage.13 + (progn + (safely-delete-package "H") + (classify-error + (eval '(defpackage "H" (:use) (:size 10) (:size 20))))) + program-error) + +;; Repeated documentation field should cause a program-error +(deftest defpackage.14 + (progn + (safely-delete-package "H") + (classify-error + (eval '(defpackage "H" (:use) + (:documentation "foo") + (:documentation "bar"))))) + program-error) + +;; When a nickname refers to an existing package or nickname, +;; signal a package-error + +(deftest defpackage.15 + (progn + (safely-delete-package "H") + (classify-error + (eval '(defpackage "H" (:use) + (:nicknames "A"))))) + package-error) + +(deftest defpackage.16 + (progn + (safely-delete-package "H") + (classify-error + (eval '(defpackage "H" (:use) + (:nicknames "Q"))))) + package-error) + +;; Names in :shadow, :shadowing-import-from, :import-from, and :intern +;; must be disjoint, or a package-error is signalled. + +;; :shadow and :shadowing-import-from +(deftest defpackage.17 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (eval '(defpackage "G" (:use) (:export "A"))) + (classify-error + (eval '(defpackage "H" (:use) + (:shadow "A") + (:shadowing-import-from "G" "A"))))) + program-error) + +;; :shadow and :import-from +(deftest defpackage.18 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (eval '(defpackage "G" (:use) (:export "A"))) + (classify-error + (eval '(defpackage "H" (:use) + (:shadow "A") + (:import-from "G" "A"))))) + program-error) + +;; :shadow and :intern +(deftest defpackage.19 + (progn + (safely-delete-package "H") + (classify-error + (eval '(defpackage "H" (:use) + (:shadow "A") + (:intern "A"))))) + program-error) + +;; :shadowing-import-from and :import-from +(deftest defpackage.20 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (eval '(defpackage "G" (:use) (:export "A"))) + (classify-error + (eval '(defpackage "H" (:use) + (:shadowing-import-from "G" "A") + (:import-from "G" "A"))))) + program-error) + +;; :shadowing-import-from and :intern +(deftest defpackage.21 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (eval '(defpackage "G" (:use) (:export "A"))) + (classify-error + (eval '(defpackage "H" (:use) + (:shadowing-import-from "G" "A") + (:intern "A"))))) + program-error) + +;; :import-from and :intern +(deftest defpackage.22 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (eval '(defpackage "G" (:use) (:export "A"))) + (classify-error + (eval '(defpackage "H" (:use) + (:import-from "G" "A") + (:intern "A"))))) + program-error) + +;; Names given to :export and :intern must be disjoint, +;; otherwise signal a program-error +(deftest defpackage.23 + (progn + (safely-delete-package "H") + (classify-error + (eval '(defpackage "H" (:use) + (:export "A") + (:intern "A"))))) + program-error) + +;; :shadowing-import-from signals a correctable package-error +;; if the symbol is not accessible in the named package +(deftest defpackage.24 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (eval '(defpackage "G" (:use))) + (handle-non-abort-restart + (eval '(defpackage "H" (:shadowing-import-from + "G" "NOT-THERE"))))) + success) + +;; :import-from signals a correctable package-error if a symbol with +;; the indicated name is not accessible in the package indicated + +(deftest defpackage.25 + (progn + (safely-delete-package "H") + (safely-delete-package "G") + (eval '(defpackage "G" (:use))) + (handle-non-abort-restart + (eval '(defpackage "H" (:import-from "G" "NOT-THERE"))))) + success) + +;; A big test that combines all the options to defpackage + +(deftest defpackage.26 + (ignore-errors + (flet + ((%do-it% + (args) + (safely-delete-package "H") + (safely-delete-package "G1") + (safely-delete-package "G2") + (safely-delete-package "G3") + (let ((pg1 + (progn + (format t "Making G1...~%") + (eval '(defpackage "G1" + (:use) + (:export "A" "B" "C") + (:intern "D" "E" "F"))))) + (pg2 + (progn + (format t "Making G2...~%") + (eval '(defpackage "G2" + (:use) + (:export "A" "D" "G") + (:intern "E" "H" "I"))))) + (pg3 + (progn + (format t "Making G3...~%") + (eval '(defpackage "G3" + (:use) + (:export "J" "K" "L") + (:intern "M" "N" "O")))))) + (let ((p (eval (list* 'defpackage "H" (copy-tree args))))) + (prog + () + (unless (packagep p) (return 1)) + (unless (equal (package-name p) "H") (return 2)) + (unless (equal (package-name pg1) "G1") (return 3)) + (unless (equal (package-name pg2) "G2") (return 4)) + (unless (equal (package-name pg3) "G3") (return 5)) + (unless + (equal (sort (copy-list (package-nicknames p)) #'string<) + '("H1" "H2")) + (return 6)) + (unless + (or + (equal (package-use-list p) (list pg1 pg2)) + (equal (package-use-list p) (list pg2 pg1))) + (return 7)) + (unless (equal (package-used-by-list pg1) (list p)) + (return 8)) + (unless (equal (package-used-by-list pg2) (list p)) + (return 9)) + (when (package-used-by-list pg3) (return 10)) + (unless (equal (sort (mapcar #'symbol-name + (package-shadowing-symbols p)) + #'string<) + '("A" "B")) + (return 10)) + (let ((num 11)) + (unless + (every + #'(lambda (str acc pkg) + (multiple-value-bind* + (sym access) + (find-symbol str p) + (or + (and (or (not acc) (equal (symbol-name sym) str)) + (or (not acc) (equal (symbol-package sym) pkg)) + (equal access acc) + (incf num)) + (progn + (format t + "Failed on str = ~S, acc = ~S, pkg = ~S, sym = ~S, access = ~S~%" + str acc pkg sym access) + nil)))) + (list "A" "B" "C" "D" "E" "F" "G" + "H" "I" "J" "K" "L" "M" "N" "O") + (list :internal :internal + :external :inherited + nil nil + :inherited :internal + nil nil + nil :external + nil nil + :internal) + (list pg2 p pg1 pg2 nil nil + pg2 p nil nil nil pg3 + nil nil pg3)) + (return num))) + (return 'success)))))) + (let ((args '((:nicknames "H1" "H2") + (:use "G1" "G2") + (:shadow "B") + (:shadowing-import-from "G2" "A") + (:import-from "G3" "L" "O") + (:intern "D" "H") + (:export "L" "C") + (:size 20) + (:documentation "A test package")))) + (list (%do-it% args) + (%do-it% (reverse args)))))) + (success success)) diff --git a/ansi-tests/packages-17.lsp b/ansi-tests/packages-17.lsp new file mode 100644 index 0000000..2555f7b --- /dev/null +++ b/ansi-tests/packages-17.lsp @@ -0,0 +1,145 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 19:20:29 1998 +;;;; Contains: Package test code, part 17 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +(deftest do-symbols.1 + (equalt + (remove-duplicates + (sort-symbols (let ((all nil)) + (do-symbols (x "B" all) (push x all))))) + (list (find-symbol "BAR" "B") + (find-symbol "FOO" "A"))) + t) + +;; +;; Test up some test packages +;; + +(defun collect-symbols (pkg) + (remove-duplicates + (sort-symbols + (let ((all nil)) + (do-symbols (x pkg all) (push x all)))))) + +(defun collect-external-symbols (pkg) + (remove-duplicates + (sort-symbols + (let ((all nil)) + (do-external-symbols (x pkg all) (push x all)))))) + +(deftest do-symbols.2 + (collect-symbols "DS1") + (DS1:A DS1:B DS1::C DS1::D)) + +(deftest do-symbols.3 + (collect-symbols "DS2") + (DS2:A DS2::E DS2::F DS2:G DS2:H)) + +(deftest do-symbols.4 + (collect-symbols "DS3") + (DS1:A DS3:B DS2:G DS2:H DS3:I DS3:J DS3:K DS3::L DS3::M)) + +(deftest do-symbols.5 + (remove-duplicates + (collect-symbols "DS4") + :test #'(lambda (x y) + (and (eqt x y) + (not (eqt x 'DS4::B))))) + (DS1:A DS1:B DS2::F DS3:G DS3:I DS3:J DS3:K DS4::X DS4::Y DS4::Z)) + + +(deftest do-external-symbols.1 + (collect-external-symbols "DS1") + (DS1:A DS1:B)) + +(deftest do-external-symbols.2 + (collect-external-symbols "DS2") + (DS2:A DS2:G DS2:H)) + +(deftest do-external-symbols.3 + (collect-external-symbols "DS3") + (DS1:A DS3:B DS2:G DS3:I DS3:J DS3:K)) + +(deftest do-external-symbols.4 + (collect-external-symbols "DS4") + ()) + +(deftest do-external-symbols.5 + (equalt (collect-external-symbols "KEYWORD") + (collect-symbols "KEYWORD")) + t) + +;; Test that do-symbols, do-external-symbols work without +;; a return value (and that the default return value is nil) + +(deftest do-symbols.6 + (do-symbols (s "DS1") (declare (ignore s)) t) + nil) + +(deftest do-external-symbols.6 + (do-external-symbols (s "DS1") (declare (ignore s)) t) + nil) + +;; Test that do-symbols, do-external-symbols work without +;; a package being specified + +(deftest do-symbols.7 + (let ((x nil) + (*package* (find-package "DS1"))) + (declare (special *package*)) + (list + (do-symbols (s) (push s x)) + (sort-symbols x))) + (nil (DS1:A DS1:B DS1::C DS1::D))) + +(deftest do-external-symbols.7 + (let ((x nil) + (*package* (find-package "DS1"))) + (declare (special *package*)) + (list + (do-external-symbols (s) (push s x)) + (sort-symbols x))) + (nil (DS1:A DS1:B))) + +;; Test that the tags work in the tagbody, +;; and that multiple statements work + +(deftest do-symbols.8 + (handler-case + (let ((x nil)) + (list + (do-symbols + (s "DS1") + (when (equalt (symbol-name s) "C") (go bar)) + (push s x) + (go foo) + bar + (push t x) + foo) + (sort-symbols x))) + (error (c) c)) + (NIL (DS1:A DS1:B DS1::D T))) + +(deftest do-external-symbols.8 + (handler-case + (let ((x nil)) + (list + (do-external-symbols + (s "DS1") + (when (equalt (symbol-name s) "A") (go bar)) + (push s x) + (go foo) + bar + (push t x) + foo) + (sort-symbols x))) + (error (c) c)) + (NIL (DS1:B T))) + + + + diff --git a/ansi-tests/packages-18.lsp b/ansi-tests/packages-18.lsp new file mode 100644 index 0000000..2fd03b2 --- /dev/null +++ b/ansi-tests/packages-18.lsp @@ -0,0 +1,106 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Apr 25 08:07:31 1998 +;;;; Contains: Package test code, part 18 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +(declaim (special *universe*)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; packagep, typep * 'package + +(deftest packagep.1 + (loop + for x in *universe* count + (unless (eqt (not (packagep x)) + (not (typep x 'package))) + (format t + "(packagep ~S) = ~S, (typep x 'package) = ~S~%" + x (packagep x) x (typep x 'package)) + t)) + 0) + +;;; *package* is always a package + +(deftest packagep.2 + (not-mv (packagep *package*)) + nil) + +(deftest packagep.error.1 + (classify-error (packagep)) + program-error) + +(deftest packagep.error.2 + (classify-error (packagep nil nil)) + program-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; package-error + +(deftest package-error.1 + (not + (typep (make-condition 'package-error :package "CL") + 'package-error)) + nil) + +(deftest package-error.2 + (not + (typep (make-condition 'package-error + :package (find-package "CL")) + 'package-error)) + nil) + +(deftest package-error.3 + (subtypep* 'package-error 'error) + t t) + +(deftest package-error.4 + (not + (typep (make-condition 'package-error + :package (find-package '#:|CL|)) + 'package-error)) + nil) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; package-error-package + +(deftest package-error-package.1 + (eqt (find-package (package-error-package + (make-condition 'package-error + :package "CL"))) + (find-package "CL")) + t) + +(deftest package-error-package.2 + (eqt (find-package (package-error-package + (make-condition 'package-error + :package (find-package "CL")))) + (find-package "CL")) + t) + +(deftest package-error-package.3 + (eqt (find-package (package-error-package + (make-condition 'package-error + :package '#:|CL|))) + (find-package "CL")) + t) + +(deftest package-error-package.4 + (eqt (find-package (package-error-package + (make-condition 'package-error + :package #\A))) + (find-package "A")) + t) + +(deftest package-error-package.error.1 + (classify-error (package-error-package)) + program-error) + +(deftest package-error-package.error.2 + (classify-error + (package-error-package + (make-condition 'package-error :package #\A) + nil)) + program-error) diff --git a/ansi-tests/packages-19.lsp b/ansi-tests/packages-19.lsp new file mode 100644 index 0000000..be4b3b7 --- /dev/null +++ b/ansi-tests/packages-19.lsp @@ -0,0 +1,61 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue May 5 17:22:49 1998 +;;;; Contains: Packages test code, part 19. Tests of the keyword package. +;;;; See also cl-symbols.lsp (for keywordp test cases) + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;; Check that each keyword satisfies keywordp + +(deftest keyword.1 + (do-symbols (s "KEYWORD" t) + (unless (keywordp s) + (return (list s nil)))) + t) + +;; Every keyword is external +(deftest keyword.2 + (do-symbols (s "KEYWORD" t) + (multiple-value-bind (s2 access) + (find-symbol (symbol-name s) "KEYWORD") + (unless (and (eqt s s2) + (eqt access :external)) + (return (list s2 access))))) + t) + +;; Every keyword evaluates to itself +(deftest keyword.3 + (do-symbols (s "KEYWORD" t) + (unless (eqt s (eval s)) + (return (list s (eval s))))) + t) + + +;;; Other error tests + +(deftest package-shadowing-symbols.error.1 + (classify-error (package-shadowing-symbols)) + program-error) + +(deftest package-shadowing-symbols.error.2 + (classify-error (package-shadowing-symbols "CL" nil)) + program-error) + +(deftest package-use-list.error.1 + (classify-error (package-use-list)) + program-error) + +(deftest package-use-list.error.2 + (classify-error (package-use-list "CL" nil)) + program-error) + +(deftest package-used-by-list.error.1 + (classify-error (package-used-by-list)) + program-error) + +(deftest package-used-by-list.error.2 + (classify-error (package-used-by-list "CL" nil)) + program-error) + diff --git a/ansi-tests/packages.lsp b/ansi-tests/packages.lsp new file mode 100644 index 0000000..dc6b38e --- /dev/null +++ b/ansi-tests/packages.lsp @@ -0,0 +1,26 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Oct 6 00:32:56 2002 +;;;; Contains: Loader for files containing package tests + + +(load "packages-00.lsp") +(load "packages-01.lsp") +(load "packages-02.lsp") +(load "packages-03.lsp") +(load "packages-04.lsp") +(load "packages-05.lsp") +(load "packages-06.lsp") +(load "packages-07.lsp") +(load "packages-08.lsp") +(load "packages-09.lsp") +(load "packages-10.lsp") +(load "packages-11.lsp") +(load "packages-12.lsp") +(load "packages-13.lsp") +(load "packages-14.lsp") +(load "packages-15.lsp") +(load "packages-16.lsp") +(load "packages-17.lsp") +(load "packages-18.lsp") +(load "packages-19.lsp") diff --git a/ansi-tests/parse-namestring.lsp b/ansi-tests/parse-namestring.lsp new file mode 100644 index 0000000..0d83e89 --- /dev/null +++ b/ansi-tests/parse-namestring.lsp @@ -0,0 +1,89 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 14 13:59:18 2004 +;;;; Contains: Tests of PARSE-NAMESTRING + +(in-package :cl-test) + +;;; "Parsing a null string always succeeds, producing a pathname +;;; with all components (except the host) equal to nil." + +(deftest parse-namestring.1 + (let ((vals (multiple-value-list (parse-namestring "")))) + (assert (= (length vals) 2)) + (let ((pn (first vals)) + (pos (second vals))) + (values + (pathname-directory pn) + (pathname-device pn) + (pathname-name pn) + (pathname-type pn) + (pathname-version pn) + pos))) + nil nil nil nil nil 0) + +(deftest parse-namestring.2 + (let ((vals (multiple-value-list (parse-namestring (make-array 0 :element-type 'base-char))))) + (assert (= (length vals) 2)) + (let ((pn (first vals)) + (pos (second vals))) + (values + (pathname-directory pn) + (pathname-device pn) + (pathname-name pn) + (pathname-type pn) + (pathname-version pn) + pos))) + nil nil nil nil nil 0) + +(deftest parse-namestring.3 + (let ((vals (multiple-value-list (parse-namestring (make-array 4 :element-type 'base-char + :initial-element #\X + :fill-pointer 0))))) + (assert (= (length vals) 2)) + (let ((pn (first vals)) + (pos (second vals))) + (values + (pathname-directory pn) + (pathname-device pn) + (pathname-name pn) + (pathname-type pn) + (pathname-version pn) + pos))) + nil nil nil nil nil 0) + +(deftest parse-namestring.4 + (loop for etype in '(standard-char base-char character) + for s0 = (make-array 4 :element-type etype :initial-element #\X) + for s = (make-array 0 :element-type etype :displaced-to s0 + :displaced-index-offset 1) + for vals = (multiple-value-list (parse-namestring s)) + for pn = (first vals) + for pos = (second vals) + do (assert (= (length vals) 2)) + nconc + (let ((result (list (pathname-directory pn) + (pathname-device pn) + (pathname-name pn) + (pathname-type pn) + (pathname-version pn) + pos))) + (unless (equal result '(nil nil nil nil nil 0)) + (list (list etype result))))) + nil) + +;;; Error tests + +(deftest parse-namestring.error.1 + (signals-error (parse-namestring) program-error) + t) + +(deftest parse-name-string.error.2 + (signals-error (parse-namestring "" nil *default-pathname-defaults* :foo nil) program-error) + t) + +(deftest parse-name-string.error.3 + (signals-error (parse-namestring "" nil *default-pathname-defaults* :start) program-error) + t) + + diff --git a/ansi-tests/pathname-device.lsp b/ansi-tests/pathname-device.lsp new file mode 100644 index 0000000..228682c --- /dev/null +++ b/ansi-tests/pathname-device.lsp @@ -0,0 +1,74 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 14:23:54 2003 +;;;; Contains: Tests for PATHNAME-DEVICE + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +(deftest pathname-device.1 + (loop for p in *pathnames* + for device = (pathname-device p) + unless (or (stringp device) + (member device '(nil :wild :unspecific))) + collect (list p device)) + nil) + +(deftest pathname-device.2 + (loop for p in *pathnames* + for device = (pathname-device p :case :local) + unless (or (stringp device) + (member device '(nil :wild :unspecific))) + collect (list p device)) + nil) + +(deftest pathname-device.3 + (loop for p in *pathnames* + for device = (pathname-device p :case :common) + unless (or (stringp device) + (member device '(nil :wild :unspecific))) + collect (list p device)) + nil) + +(deftest pathname-device.4 + (loop for p in *pathnames* + for device = (pathname-device p :allow-other-keys nil) + unless (or (stringp device) + (member device '(nil :wild :unspecific))) + collect (list p device)) + nil) + +(deftest pathname-device.5 + (loop for p in *pathnames* + for device = (pathname-device p :foo 'bar :allow-other-keys t) + unless (or (stringp device) + (member device '(nil :wild :unspecific))) + collect (list p device)) + nil) + +(deftest pathname-device.6 + (loop for p in *pathnames* + for device = (pathname-device p :allow-other-keys t :allow-other-keys nil :foo 'bar) + unless (or (stringp device) + (member device '(nil :wild :unspecific))) + collect (list p device)) + nil) + +;;; section 19.3.2.1 +(deftest pathname-device.7 + (loop for p in *logical-pathnames* + always (eq (pathname-device p) :unspecific)) + t) + +(deftest pathname-device.8 + (do-special-strings (s "" nil) (pathname-device s)) + nil) + +(deftest pathname-device.error.1 + (signals-error (pathname-device) program-error) + t) + +(deftest pathname-device.error.2 + (check-type-error #'pathname-device #'could-be-pathname-designator) + nil) \ No newline at end of file diff --git a/ansi-tests/pathname-directory.lsp b/ansi-tests/pathname-directory.lsp new file mode 100644 index 0000000..01d86cd --- /dev/null +++ b/ansi-tests/pathname-directory.lsp @@ -0,0 +1,89 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 14:24:39 2003 +;;;; Contains: Tests for PATHNAME-DIRECTORY + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +(deftest pathname-directory.1 + (loop for p in *pathnames* + for directory = (pathname-directory p) + unless (or (stringp directory) + (member directory '(nil :wild :unspecific)) + (and (consp directory) + (member (car directory) '(:absolute :relative)))) + collect (list p directory)) + nil) + +(deftest pathname-directory.2 + (loop for p in *pathnames* + for directory = (pathname-directory p :case :local) + unless (or (stringp directory) + (member directory '(nil :wild :unspecific)) + (and (consp directory) + (member (car directory) '(:absolute :relative)))) + collect (list p directory)) + nil) + +(deftest pathname-directory.3 + (loop for p in *pathnames* + for directory = (pathname-directory p :case :common) + unless (or (stringp directory) + (member directory '(nil :wild :unspecific)) + (and (consp directory) + (member (car directory) '(:absolute :relative)))) + collect (list p directory)) + nil) + +(deftest pathname-directory.4 + (loop for p in *pathnames* + for directory = (pathname-directory p :allow-other-keys nil) + unless (or (stringp directory) + (member directory '(nil :wild :unspecific)) + (and (consp directory) + (member (car directory) '(:absolute :relative)))) + collect (list p directory)) + nil) + +(deftest pathname-directory.5 + (loop for p in *pathnames* + for directory = (pathname-directory p :foo 'bar :allow-other-keys t) + unless (or (stringp directory) + (member directory '(nil :wild :unspecific)) + (and (consp directory) + (member (car directory) '(:absolute :relative)))) + collect (list p directory)) + nil) + +(deftest pathname-directory.6 + (loop for p in *pathnames* + for directory = (pathname-directory p :allow-other-keys t + :allow-other-keys nil + 'foo 'bar) + unless (or (stringp directory) + (member directory '(nil :wild :unspecific)) + (and (consp directory) + (member (car directory) '(:absolute :relative)))) + collect (list p directory)) + nil) + +;;; section 19.3.2.1 +(deftest pathname-directory.7 + (loop for p in *logical-pathnames* + when (eq (pathname-directory p) :unspecific) + collect p) + nil) + +(deftest pathname-directory.8 + (do-special-strings (s "" nil) (pathname-directory s)) + nil) + +(deftest pathname-directory.error.1 + (signals-error (pathname-directory) program-error) + t) + +(deftest pathname-directory.error.2 + (check-type-error #'pathname-directory #'could-be-pathname-designator) + nil) diff --git a/ansi-tests/pathname-host.lsp b/ansi-tests/pathname-host.lsp new file mode 100644 index 0000000..7c29c27 --- /dev/null +++ b/ansi-tests/pathname-host.lsp @@ -0,0 +1,79 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 14:23:22 2003 +;;;; Contains: Tests for PATHNAME-HOST + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +(deftest pathname-host.1 + (loop for p in *pathnames* + always (eql (length (multiple-value-list (pathname-host p))) 1)) + t) + +(deftest pathname-host.2 + (loop for p in *pathnames* + always (eql (length (multiple-value-list (pathname-host p :case :local))) 1)) + t) + +(deftest pathname-host.3 + (loop for p in *pathnames* + always (eql (length (multiple-value-list (pathname-host p :case :common))) 1)) + t) + +(deftest pathname-host.4 + (loop for p in *pathnames* + always (eql (length (multiple-value-list (pathname-host p :allow-other-keys nil))) 1)) + t) + +(deftest pathname-host.5 + (loop for p in *pathnames* + always (eql (length (multiple-value-list + (pathname-host p :foo t :allow-other-keys t))) 1)) + t) + +(deftest pathname-host.6 + (loop for p in *pathnames* + always (eql (length (multiple-value-list + (pathname-host p :allow-other-keys t + :allow-other-keys nil + 'foo t))) 1)) + t) + +;;; section 19.3.2.1 +(deftest pathname-host.7 + (loop for p in *logical-pathnames* + when (eq (pathname-host p) :unspecific) + collect p) + nil) + +(deftest pathname-host.8 + (do-special-strings (s "" nil) (pathname-host s)) + nil) + +#| +(deftest pathname-host.9 + (loop for p in *pathnames* + for host = (pathname-host p) + unless (or (stringp host) + (and (listp host) (every #'stringp host)) + (eql host :unspecific)) + collect (list p host)) + nil) +|# + +;;; Error cases + +(deftest pathname-host.error.1 + (signals-error (pathname-host) program-error) + t) + +(deftest pathname-host.error.2 + (check-type-error #'pathname-host #'could-be-pathname-designator) + nil) + +(deftest pathname-host.error.3 + (signals-error (pathname-host *default-pathname-defaults* '#:bogus t) + program-error) + t) diff --git a/ansi-tests/pathname-match-p.lsp b/ansi-tests/pathname-match-p.lsp new file mode 100644 index 0000000..09bbd27 --- /dev/null +++ b/ansi-tests/pathname-match-p.lsp @@ -0,0 +1,103 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Aug 15 07:46:22 2004 +;;;; Contains: Tests for PATHNAME-MATCH-P + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +;;; Much of the behavior cannot be tested portably. + +(deftest pathname-match-p.1 + (let ((pn1 (make-pathname :name :wild)) + (pn2 (make-pathname :name "foo"))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.2 + (let ((pn1 (make-pathname :type :wild)) + (pn2 (make-pathname :type "txt"))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.3 + (let ((pn1 (make-pathname :directory '(:absolute :wild))) + (pn2 (make-pathname :directory '(:absolute)))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.4 + (let ((pn1 (make-pathname :directory '(:relative :wild))) + (pn2 (make-pathname :directory '(:relative)))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.5 + (let ((pn1 (make-pathname :directory '(:relative :wild))) + (pn2 (make-pathname :directory nil))) + (and (wild-pathname-p pn1) + (not (pathname-directory pn2)) + (not (pathname-match-p pn1 pn2)))) + nil) + +(deftest pathname-match-p.6 + (let ((pn1 (make-pathname :version :wild)) + (pn2 (make-pathname))) + (and (wild-pathname-p pn1) + (not (pathname-version pn2)) + (not (pathname-match-p pn1 pn2)))) + nil) + +;;; Specialized string tests + +(deftest pathname-match-p.7 + (let ((wpn (parse-namestring "CLTEST:*.LSP"))) + (assert (wild-pathname-p wpn)) + (do-special-strings + (s "CLTEST:FOO.LSP" nil) + (assert (pathname-match-p s wpn)))) + nil) + +(deftest pathname-match-p.8 + (do-special-strings + (s "CLTEST:*.LSP" nil) + (assert (pathname-match-p "CLTEST:FOO.LSP" s))) + nil) + + +;;; Add more tests here + +;;; Here are error tests + +(deftest pathname-match-p.error.1 + (signals-error (pathname-match-p) program-error) + t) + +(deftest pathname-match-p.error.2 + (signals-error (pathname-match-p #p"") program-error) + t) + +(deftest pathname-match-p.error.3 + (signals-error (pathname-match-p #p"" #p"" nil) program-error) + t) + +(deftest pathname-match-p.error.4 + (check-type-error #'(lambda (x) (pathname-match-p x #p"")) + #'could-be-pathname-designator) + nil) + +(deftest pathname-match-p.error.5 + (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p x #p"")) + #'could-be-pathname-designator) + nil) + +(deftest pathname-match-p.error.6 + (check-type-error #'(lambda (x) (pathname-match-p #p"" x)) + #'could-be-pathname-designator) + nil) + +(deftest pathname-match-p.error.7 + (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p #p"" x)) + #'could-be-pathname-designator) + nil) diff --git a/ansi-tests/pathname-name.lsp b/ansi-tests/pathname-name.lsp new file mode 100644 index 0000000..df030d6 --- /dev/null +++ b/ansi-tests/pathname-name.lsp @@ -0,0 +1,75 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 14:45:16 2003 +;;;; Contains: Tests for PATHNAME-NAME + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +(deftest pathname-name.1 + (loop for p in *pathnames* + for name = (pathname-name p) + unless (or (stringp name) + (member name '(nil :wild :unspecific))) + collect (list p name)) + nil) + +(deftest pathname-name.2 + (loop for p in *pathnames* + for name = (pathname-name p :case :local) + unless (or (stringp name) + (member name '(nil :wild :unspecific))) + collect (list p name)) + nil) + +(deftest pathname-name.3 + (loop for p in *pathnames* + for name = (pathname-name p :case :common) + unless (or (stringp name) + (member name '(nil :wild :unspecific))) + collect (list p name)) + nil) + +(deftest pathname-name.4 + (loop for p in *pathnames* + for name = (pathname-name p :allow-other-keys nil) + unless (or (stringp name) + (member name '(nil :wild :unspecific))) + collect (list p name)) + nil) + +(deftest pathname-name.5 + (loop for p in *pathnames* + for name = (pathname-name p :foo 'bar :allow-other-keys t) + unless (or (stringp name) + (member name '(nil :wild :unspecific))) + collect (list p name)) + nil) + +(deftest pathname-name.6 + (loop for p in *pathnames* + for name = (pathname-name p :allow-other-keys t :allow-other-keys nil :foo 'bar) + unless (or (stringp name) + (member name '(nil :wild :unspecific))) + collect (list p name)) + nil) + +;;; section 19.3.2.1 +(deftest pathname-name.7 + (loop for p in *logical-pathnames* + when (eq (pathname-name p) :unspecific) + collect p) + nil) + +(deftest pathname-name.8 + (do-special-strings (s "" nil) (pathname-name s)) + nil) + +(deftest pathname-name.error.1 + (signals-error (pathname-name) program-error) + t) + +(deftest pathname-name.error.2 + (check-type-error #'pathname-name #'could-be-pathname-designator) + nil) diff --git a/ansi-tests/pathname-type.lsp b/ansi-tests/pathname-type.lsp new file mode 100644 index 0000000..136977b --- /dev/null +++ b/ansi-tests/pathname-type.lsp @@ -0,0 +1,75 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 14:45:16 2003 +;;;; Contains: Tests for PATHNAME-TYPE + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +(deftest pathname-type.1 + (loop for p in *pathnames* + for type = (pathname-type p) + unless (or (stringp type) + (member type '(nil :wild :unspecific))) + collect (list p type)) + nil) + +(deftest pathname-type.2 + (loop for p in *pathnames* + for type = (pathname-type p :case :local) + unless (or (stringp type) + (member type '(nil :wild :unspecific))) + collect (list p type)) + nil) + +(deftest pathname-type.3 + (loop for p in *pathnames* + for type = (pathname-type p :case :common) + unless (or (stringp type) + (member type '(nil :wild :unspecific))) + collect (list p type)) + nil) + +(deftest pathname-type.4 + (loop for p in *pathnames* + for type = (pathname-type p :allow-other-keys nil) + unless (or (stringp type) + (member type '(nil :wild :unspecific))) + collect (list p type)) + nil) + +(deftest pathname-type.5 + (loop for p in *pathnames* + for type = (pathname-type p :foo 'bar :allow-other-keys t) + unless (or (stringp type) + (member type '(nil :wild :unspecific))) + collect (list p type)) + nil) + +(deftest pathname-type.6 + (loop for p in *pathnames* + for type = (pathname-type p :allow-other-keys t :allow-other-keys nil :foo 'bar) + unless (or (stringp type) + (member type '(nil :wild :unspecific))) + collect (list p type)) + nil) + +;;; section 19.3.2.1 +(deftest pathname-type.7 + (loop for p in *logical-pathnames* + when (eq (pathname-type p) :unspecific) + collect p) + nil) + +(deftest pathname-type.8 + (do-special-strings (s "" nil) (pathname-type s)) + nil) + +(deftest pathname-type.error.1 + (signals-error (pathname-type) program-error) + t) + +(deftest pathname-type.error.2 + (check-type-error #'pathname-type #'could-be-pathname-designator) + nil) diff --git a/ansi-tests/pathname-version.lsp b/ansi-tests/pathname-version.lsp new file mode 100644 index 0000000..e97ac4a --- /dev/null +++ b/ansi-tests/pathname-version.lsp @@ -0,0 +1,40 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 14:45:16 2003 +;;;; Contains: Tests for PATHNAME-VERSION + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +(deftest pathname-version.1 + (loop for p in *pathnames* + for version = (pathname-version p) + unless (or (integerp version) (symbolp version)) + collect (list p version)) + nil) + +;;; section 19.3.2.1 +(deftest pathname-version.2 + (loop for p in *logical-pathnames* + when (eq (pathname-version p) :unspecific) + collect p) + nil) + +(deftest pathname-version.3 + (do-special-strings (s "" nil) (pathname-version s)) + nil) + +(deftest pathname-version.error.1 + (signals-error (pathname-version) program-error) + t) + +(deftest pathname-version.error.2 + (signals-error (pathname-version *default-pathname-defaults* nil) + program-error) + t) + +(deftest pathname-version.error.3 + (check-type-error #'pathname-version #'could-be-pathname-designator) + nil) + diff --git a/ansi-tests/pathname.lsp b/ansi-tests/pathname.lsp new file mode 100644 index 0000000..08ac128 --- /dev/null +++ b/ansi-tests/pathname.lsp @@ -0,0 +1,88 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 29 05:06:57 2003 +;;;; Contains: Tests of the function PATHNAME + +(in-package :cl-test) + +(deftest pathname.1 + (loop for x in *pathnames* + always (eq x (pathname x))) + t) + +(deftest pathname.2 + (equalt #p"ansi-aux.lsp" (pathname "ansi-aux.lsp")) + t) + +(deftest pathname.3 + (let ((s (open "ansi-aux.lsp" :direction :input))) + (prog1 (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp")) + (close s))) + t) + +(deftest pathname.4 + (let ((s (open "ansi-aux.lsp" :direction :input))) + (close s) + (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp"))) + t) + +(deftest pathname.5 + (loop for x in *logical-pathnames* + always (eq x (pathname x))) + t) + +(deftest pathname.6 + (equalt #p"ansi-aux.lsp" + (pathname (make-array 12 :initial-contents "ansi-aux.lsp" + :element-type 'base-char))) + t) + +(deftest pathname.7 + (equalt #p"ansi-aux.lsp" + (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" + :element-type 'base-char + :fill-pointer 12))) + t) + +(deftest pathname.8 + (equalt #p"ansi-aux.lsp" + (pathname (make-array 12 :initial-contents "ansi-aux.lsp" + :element-type 'base-char + :adjustable t))) + t) + +(deftest pathname.9 + (equalt #p"ansi-aux.lsp" + (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" + :element-type 'character + :fill-pointer 12))) + t) + +(deftest pathname.10 + (equalt #p"ansi-aux.lsp" + (pathname (make-array 12 :initial-contents "ansi-aux.lsp" + :element-type 'character + :adjustable t))) + t) + +(deftest pathname.11 + (loop for etype in '(standard-char base-char character) + collect + (equalt #p"ansi-aux.lsp" + (pathname + (let* ((s (make-array 15 :initial-contents "XXansi-aux.lspX" + :element-type etype))) + (make-array 12 :element-type etype + :displaced-to s + :displaced-index-offset 2))))) + (t t t)) + +;;; Error tests + +(deftest pathname.error.1 + (signals-error (pathname) program-error) + t) + +(deftest pathname.error.2 + (signals-error (pathname (first *pathnames*) nil) program-error) + t) diff --git a/ansi-tests/pathnamep.lsp b/ansi-tests/pathnamep.lsp new file mode 100644 index 0000000..398e8e5 --- /dev/null +++ b/ansi-tests/pathnamep.lsp @@ -0,0 +1,31 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 10:26:45 2003 +;;;; Contains: Tests of PATHNAMEP + +(in-package :cl-test) + +(deftest pathnamep.1 + (check-type-predicate #'pathnamep 'pathname) + 0) + +(deftest pathnamep.2 + (check-predicate #'(lambda (x) (eql (length (multiple-value-list (pathnamep x))) 1))) + nil) + +(deftest pathnamep.3 + (check-predicate (typef '(not logical-pathname)) #'pathnamep) + nil) + +(deftest pathnamep.error.1 + (signals-error (pathnamep) program-error) + t) + +(deftest pathnamep.error.2 + (signals-error (pathnamep nil nil) program-error) + t) + +(deftest pathnamep.error.3 + (signals-error (pathnamep *default-pathname-defaults* nil) + program-error) + t) diff --git a/ansi-tests/pathnames-aux.lsp b/ansi-tests/pathnames-aux.lsp new file mode 100644 index 0000000..659ea24 --- /dev/null +++ b/ansi-tests/pathnames-aux.lsp @@ -0,0 +1,25 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Dec 6 15:05:05 2003 +;;;; Contains: Functions associated with pathname tests + +(in-package :cl-test) + +(defun could-be-pathname-designator (x) + (or (stringp x) + (pathnamep x) + (typep x 'file-stream) + (and (typep x 'synonym-stream) + (could-be-pathname-designator + (symbol-value + (synonym-stream-symbol x)))))) + +(defun explode-pathname (pn) + (list + :host (pathname-host pn) + :device (pathname-device pn) + :directory (pathname-directory pn) + :name (pathname-name pn) + :type (pathname-type pn) + :version (pathname-version pn))) + diff --git a/ansi-tests/pathnames.lsp b/ansi-tests/pathnames.lsp new file mode 100644 index 0000000..d916461 --- /dev/null +++ b/ansi-tests/pathnames.lsp @@ -0,0 +1,19 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 29 04:21:53 2003 +;;;; Contains: Various tests on pathnames + +(in-package :cl-test) + +(deftest pathnames-print-and-read-properly + (with-standard-io-syntax + (loop + for p1 in *pathnames* + for s = (handler-case (write-to-string p1 :readably t) + (print-not-readable () :unreadable-error)) + unless (eql s :unreadable-error) + append + (let ((p2 (read-from-string s))) + (unless (equal p1 p2) + (list (list p1 s p2)))))) + nil) diff --git a/ansi-tests/peek-char.lsp b/ansi-tests/peek-char.lsp new file mode 100644 index 0000000..36b0212 --- /dev/null +++ b/ansi-tests/peek-char.lsp @@ -0,0 +1,329 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 17 21:02:13 2004 +;;;; Contains: Tests of PEEK-CHAR + +(in-package :cl-test) + +(deftest peek-char.1 + (with-input-from-string + (*standard-input* "abc") + (values + (peek-char) + (read-char) + (read-char) + (peek-char) + (read-char))) + #\a #\a #\b #\c #\c) + +(deftest peek-char.2 + (with-input-from-string + (*standard-input* " ab") + (values + (peek-char) + (read-char) + (peek-char t) + (read-char) + (peek-char t) + (read-char))) + #\Space #\Space #\a #\a #\b #\b) + +(deftest peek-char.3 + (with-input-from-string + (*standard-input* (concatenate 'string + (string #\Newline) + (string #\Newline) + " " + (string #\Newline) + "ab")) + (values + (peek-char) + (read-char) + (peek-char t) + (read-char) + (peek-char t) + (read-char))) + #\Newline #\Newline #\a #\a #\b #\b) + +(when (name-char "Linefeed") + (deftest peek-char.4 + (with-input-from-string + (*standard-input* (concatenate 'string + (string (name-char "Linefeed")) + (string (name-char "Linefeed")) + "abc")) + (values + (peek-char) + (read-char) + (peek-char t) + (read-char))) + #.(name-char "Linefeed") + #.(name-char "Linefeed") + #\a #\a)) + +(when (name-char "Page") + (deftest peek-char.5 + (with-input-from-string + (*standard-input* (concatenate 'string + (string (name-char "Page")) + (string (name-char "Page")) + "abc")) + (values + (peek-char) + (read-char) + (peek-char t) + (read-char))) + #.(name-char "Page") + #.(name-char "Page") + #\a #\a)) + +(when (name-char "Tab") + (deftest peek-char.6 + (with-input-from-string + (*standard-input* (concatenate 'string + (string (name-char "Tab")) + (string (name-char "Tab")) + "abc")) + (values + (peek-char) + (read-char) + (peek-char t) + (read-char))) + #.(name-char "Tab") + #.(name-char "Tab") + #\a #\a)) + +(when (name-char "Return") + (deftest peek-char.7 + (with-input-from-string + (*standard-input* (concatenate 'string + (string (name-char "Return")) + (string (name-char "Return")) + "abc")) + (values + (peek-char) + (read-char) + (peek-char t) + (read-char))) + #.(name-char "Return") + #.(name-char "Return") + #\a #\a)) + +(deftest peek-char.8 + (with-input-from-string + (s "a bcd") + (values + (peek-char nil s) + (read-char s) + (peek-char t s) + (read-char s) + (peek-char t s) + (read-char s))) + #\a #\a #\b #\b #\c #\c) + +(deftest peek-char.9 + (with-input-from-string + (*standard-input* " a bCcde") + (values + (peek-char #\c) + (read-char) + (read-char))) + #\c #\c #\d) + +(deftest peek-char.10 + (with-input-from-string + (*standard-input* " ; foo") + (values + (peek-char t) + (read-char))) + #\; #\;) + +(deftest peek-char.11 + (with-input-from-string + (s "") + (peek-char nil s nil)) + nil) + +(deftest peek-char.12 + (with-input-from-string + (s "") + (peek-char nil s nil 'foo)) + foo) + +(deftest peek-char.13 + (with-input-from-string + (s " ") + (peek-char t s nil)) + nil) + +(deftest peek-char.14 + (with-input-from-string + (s " ") + (peek-char t s nil 'foo)) + foo) + +(deftest peek-char.15 + (with-input-from-string + (s "ab c d") + (peek-char #\z s nil)) + nil) + +(deftest peek-char.16 + (with-input-from-string + (s "ab c d") + (peek-char #\z s nil 'foo)) + foo) + +;;; Interaction with echo streams + +(deftest peek-char.17 + (block done + (with-input-from-string + (is "ab") + (with-output-to-string + (os) + (let ((es (make-echo-stream is os))) + (let ((pos1 (file-position os))) + (unless (zerop pos1) (return-from done :good)) + (peek-char nil es nil) + (let ((pos2 (file-position os))) + (return-from done + (if (eql pos1 pos2) + :good + (list pos1 pos2))))))))) + :good) + +(deftest peek-char.18 + (block done + (with-input-from-string + (is " ab") + (with-output-to-string + (os) + (let ((es (make-echo-stream is os))) + (let ((pos1 (file-position os))) + (unless (zerop pos1) (return-from done :good)) + (peek-char t es nil) + (let ((pos2 (file-position os))) + (return-from done + (if (eql pos1 pos2) + pos1 + :good)))))))) + :good) + +(deftest peek-char.19 + (block done + (with-input-from-string + (is "abcde") + (with-output-to-string + (os) + (let ((es (make-echo-stream is os))) + (let ((pos1 (file-position os))) + (unless (zerop pos1) (return-from done :good)) + (peek-char #\c es nil) + (let ((pos2 (file-position os))) + (return-from done + (if (eql pos1 pos2) + pos1 + :good)))))))) + :good) + +;;; Interactions with the readtable + +(deftest peek-char.20 + (let ((*readtable* (copy-readtable))) + (set-syntax-from-char #\Space #\a) + (with-input-from-string + (*standard-input* " x") + (values + (peek-char) + (read-char) + (peek-char t) + (read-char)))) + #\Space #\Space + #\Space #\Space ; *not* #\x #\x + ) + +(deftest peek-char.21 + (let ((*readtable* (copy-readtable))) + (set-syntax-from-char #\x #\Space) + (with-input-from-string + (*standard-input* "xxa") + (values + (peek-char) + (read-char) + (peek-char t) + (read-char)))) + #\x #\x + #\a #\a ; *not* #\x #\x + ) + +;;; Stream designators are accepted for the stream argument + +(deftest peek-char.22 + (with-input-from-string + (is "!?*") + (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) + (peek-char nil t))) + #\!) + +(deftest peek-char.23 + (with-input-from-string + (*standard-input* "345") + (peek-char nil nil)) + #\3) + +;;; Error tests + +(deftest peek-char.error.1 + (signals-error + (with-input-from-string + (s "abc") + (peek-char s nil nil nil nil 'nonsense)) + program-error) + t) + + +(deftest peek-char.error.2 + (signals-error-always + (with-input-from-string + (*standard-input* "") + (peek-char)) + end-of-file) + t t) + +(deftest peek-char.error.3 + (signals-error-always + (with-input-from-string + (s "") + (peek-char nil s)) + end-of-file) + t t) + +(deftest peek-char.error.4 + (signals-error-always + (with-input-from-string + (s " ") + (peek-char t s)) + end-of-file) + t t) + +(deftest peek-char.error.5 + (signals-error-always + (with-input-from-string + (s "abcd") + (peek-char #\z s)) + end-of-file) + t t) + +;;; There was a consensus on comp.lang.lisp that the requirement +;;; that an end-of-file error be thrown in the following case +;;; is a spec bug +#| +(deftest peek-char.error.6 + (signals-error + (with-input-from-string + (s "") + (peek-char nil s nil nil t)) + end-of-file) + t) +|# diff --git a/ansi-tests/places.lsp b/ansi-tests/places.lsp new file mode 100644 index 0000000..caf7815 --- /dev/null +++ b/ansi-tests/places.lsp @@ -0,0 +1,467 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Oct 7 19:20:17 2002 +;;;; Contains: Tests of various kinds of places (section 5.1) + +(in-package :cl-test) + +;;; Section 5.1.1.1 +(deftest setf-order + (let ((x (vector nil nil nil nil)) + (i 0)) + (setf (aref x (incf i)) (incf i)) + (values x i)) + #(nil 2 nil nil) 2) + +(deftest setf-order.2 + (let ((x (vector nil nil nil nil)) + (i 0)) + (setf (aref x (incf i)) (incf i) + (aref x (incf i)) (incf i 10)) + (values x i)) + #(nil 2 nil 13) 13) + +(deftest push-order + (let ((x (vector nil nil nil nil)) + (y (vector 'a 'b 'c 'd)) + (i 1)) + (push (aref y (incf i)) (aref x (incf i))) + (values x y i)) + #(nil nil nil (c)) + #(a b c d) + 3) + +(deftest pushnew-order + (let ((x (vector nil nil nil nil)) + (y (vector 'a 'b 'c 'd)) + (i 1)) + (pushnew (aref y (incf i)) (aref x (incf i))) + (values x y i)) + #(nil nil nil (c)) + #(a b c d) + 3) + +(deftest pushnew-order.2 + (let ((x (vector nil nil nil nil nil)) + (y (vector 'a 'b 'c 'd 'e)) + (i 1)) + (pushnew (aref y (incf i)) (aref x (incf i)) + :test (progn (incf i) #'eql)) + (values x y i)) + #(nil nil nil (c) nil) + #(a b c d e) + 4) + +(deftest remf-order + (let ((x (copy-seq #(nil :a :b))) + (pa (vector (list :a 1) (list :b 2) (list :c 3) (list :d 4))) + (i 0)) + (values + (not (remf (aref pa (incf i)) (aref x (incf i)))) + pa)) + nil #((:a 1) nil (:c 3) (:d 4))) + +(deftest incf-order + (let ((x (copy-seq #(0 0 0 0 0))) + (i 1)) + (values + (incf (aref x (incf i)) (incf i)) + x i)) + 3 #(0 0 3 0 0) 3) + +(deftest decf-order + (let ((x (copy-seq #(0 0 0 0 0))) + (i 1)) + (values + (decf (aref x (incf i)) (incf i)) + x i)) + -3 #(0 0 -3 0 0) 3) + +(deftest shiftf-order.1 + (let ((x (vector 'a 'b 'c 'd 'e)) + (i 2)) + (values (shiftf (aref x (incf i)) (incf i)) x i)) + d #(a b c 4 e) 4) + +(deftest shiftf-order.2 + (let ((x (vector 'a 'b 'c 'd 'e 'f 'g 'h)) + (i 2)) + (values (shiftf (aref x (incf i)) (aref x (incf i)) (incf i)) x i)) + d #(a b c e 5 f g h) 5) + +(deftest rotatef-order.1 + (let ((x (vector 'a 'b 'c 'd 'e 'f)) + (i 2)) + (values + (rotatef (aref x (incf i)) (aref x (incf i))) + x i)) + nil + #(a b c e d f) + 4) + +(deftest rotatef-order.2 + (let ((x (vector 'a 'b 'c 'd 'e 'f)) + (i 2)) + (values + (rotatef (aref x (incf i)) (aref x (incf i)) (aref x (incf i))) + x i)) + nil + #(a b c e f d) + 5) + +(deftest psetf-order + (let ((x (vector nil nil nil nil)) + (i 0)) + (psetf (aref x (incf i)) (incf i)) + (values x i)) + #(nil 2 nil nil) 2) + +(deftest psetf-order.2 + (let ((x (vector nil nil nil nil)) + (i 0)) + (psetf (aref x (incf i)) (incf i) + (aref x (incf i)) (incf i 10)) + (values x i)) + #(nil 2 nil 13) 13) + +(deftest pop-order + (let ((x (vector '(a b) '(c d) '(e f))) + (i 0)) + (values (pop (aref x (incf i))) x i)) + c #((a b) (d) (e f)) 1) + + +;;; Section 5.1.2.1 +(deftest setf-var + (let ((x nil)) + (setf x 'a) + x) + a) + +;;; Section 5.1.2.2 +;;; See SETF forms at various accessor functions + +;;; Section 5.1.2.3 +(deftest setf-values.1 + (let ((x nil) (y nil) (z nil)) + (setf (values x y z) (values 1 2 3))) + 1 2 3) + +(deftest setf-values.2 + (let ((x nil) (y nil) (z nil)) + (setf (values x y z) (values 1 2 3)) + (values z y x)) + 3 2 1) + +(deftest setf-values.3 + (let ((x nil) (y nil) (z nil)) + (setf (values x x x) (values 1 2 3)) + x) + 3) + +;;; Test that the subplaces of a VALUES place can be +;;; complex, and that the various places' subforms are +;;; evaluated in the correct (left-to-right) order. + +(deftest setf-values.4 + (let ((x (list 'a 'b))) + (setf (values (car x) (cadr x)) (values 1 2)) + x) + (1 2)) + +(deftest setf-values.5 + (let ((a (vector nil nil)) + (i 0) + x y z) + (setf (values (aref a (progn (setf x (incf i)) 0)) + (aref a (progn (setf y (incf i)) 1))) + (progn + (setf z (incf i)) + (values 'foo 'bar))) + (values a i x y z)) + #(foo bar) 3 1 2 3) + +(deftest setf-values.6 + (setf (values) (values))) + +;;; Section 5.1.2.4 +(deftest setf-the.1 + (let ((x 1)) + (setf (the integer x) 2) + x) + 2) + +(deftest setf-the.2 + (let ((x (list 'a))) + (values + (setf (the symbol (car x)) 'b) + x)) + b (b)) + +;;; Section 5.1.2.5 +(deftest setf-apply.1 + (let ((x (vector 0 1 2 3 4 5))) + (setf (apply #'aref x '(0)) 10) + x) + #(10 1 2 3 4 5)) + +(deftest setf-apply.2 + (let ((a (make-array '(2 2) :initial-contents '((0 0)(0 0))))) + (setf (apply #'aref a 1 1 nil) 'a) + (equalp a (make-array '(2 2) :initial-contents '((0 0)(0 a))))) + t) + +(deftest setf-apply.3 + (let ((bv (copy-seq #*0000000000))) + (setf (apply #'bit bv 4 nil) 1) + bv) + #*0000100000) + +(deftest setf-apply.4 + (let ((bv (copy-seq #*0000000000))) + (setf (apply #'sbit bv 4 nil) 1) + bv) + #*0000100000) + +;;; Section 5.1.2.6 +(defun accessor-5-1-2-6-update-fn (x y) + (setf (car x) y) + y) + +(defsetf accessor-5-1-2-6 accessor-5-1-2-6-update-fn) + +(deftest setf-expander.1 + (let ((x (list 1))) + (values (setf (accessor-5-1-2-6 x) 2) + (1+ (car x)))) + 2 3) + +;;; Section 5.1.2.7 + +(defmacro accessor-5-1-2-7 (x) `(car ,x)) +(deftest setf-macro.1 + (let ((x (list 1))) + (values (setf (accessor-5-1-2-7 x) 2) + (1+ (car x)))) + 2 3) + +(defun accessor-5-1-2-7a-update-fn (x y) + (declare (special *x*)) + (setf (car x) y) + (setf *x* 'boo) + y) + +(defmacro accessor-5-1-2-7a (x) `(car ,x)) +(defsetf accessor-5-1-2-7a accessor-5-1-2-7a-update-fn) +;; Test that the defsetf override the macro expansion +(deftest setf-macro.2 + (let ((x (list 1)) + (*x* nil)) + (declare (special *x*)) + (values (setf (accessor-5-1-2-7a x) 2) + *x* + (1+ (car x)))) + 2 boo 3) + +(defmacro accessor-5-1-2-7b (x) `(accessor-5-1-2-7 ,x)) +;; Test that the macroexpansion occurs more than once +(deftest setf-macro.3 + (let ((x (list 1))) + (values (setf (accessor-5-1-2-7b x) 2) + (1+ (car x)))) + 2 3) + +;; Macroexpansion from a macrolet +(deftest setf-macro.4 + (macrolet ((%m (y) `(car ,y))) + (let ((x (list 1))) + (values (setf (%m x) 2) + (1+ (car x))))) + 2 3) + +;;; section 5.1.2.8 -- symbol macros +(deftest setf-symbol-macro.1 + (symbol-macrolet ((x y)) + (let ((y nil)) + (values (setf x 1) x y))) + 1 1 1) + +;;; Symbol macros in SETQs are treated as if the form were a SETF +(deftest setf-symbol-macro.2 + (symbol-macrolet ((x y)) + (let ((y nil)) + (values (setq x 1) x y))) + 1 1 1) + +;;; Tests that, being treated like SETF, this causes multiple values +;;; to be assigned to (values y z) +(deftest setf-symbol-macro.3 + (symbol-macrolet ((x (values y z))) + (let ((y nil) (z nil)) + (values (setq x (values 1 2)) x y z))) + 1 1 1 2) + +(deftest setq.1 + (setq) + nil) + +(deftest setq.2 + (let ((x 0) (y 0)) + (values (setq x 1 y 2) x y)) + 2 1 2) + +(deftest setq.3 + (let ((x 0) (y 0)) + (values (setq x (values 1 3) y (values 2 4)) x y)) + 2 1 2) + +(deftest setq.4 + (let (x) (setq x (values 1 2))) + 1) + +(deftest setf.1 + (setf) + nil) + +(deftest setf.2 + (let ((x 0) (y 0)) + (values (setf x 1 y 2) x y)) + 2 1 2) + +(deftest setf.3 + (let ((x 0) (y 0)) + (values (setf x (values 1 3) y (values 2 4)) x y)) + 2 1 2) + +(deftest setf.4 + (let (x) (setf x (values 1 2))) + 1) + +;;; Tests of PSETQ + +(deftest psetq.1 + (psetq) + nil) + +(deftest psetq.2 + (let ((x 0)) + (values (psetq x 1) x)) + nil 1) + +(deftest psetq.3 + (let ((x 0) (y 1)) + (values (psetq x y y x) x y)) + nil 1 0) + +(deftest psetq.4 + (let ((x 0)) + (values + (symbol-macrolet ((x y)) + (let ((y 1)) + (psetq x 2) + y)) + x)) + 2 0) + +(deftest psetq.5 + (let ((w (list nil))) + (values + (symbol-macrolet ((x (car w))) + (psetq x 2)) + w)) + nil (2)) + +(deftest psetq.6 + (let ((c 0) x y) + (psetq x (incf c) + y (incf c)) + (values c x y)) + 2 1 2) + +;;; The next test is a PSETQ that is equivalent to a PSETF +;;; See PSETF.7 for comments related to this test. + +(deftest psetq.7 + (symbol-macrolet ((x (aref a (incf i))) + (y (aref a (incf i)))) + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) + (i 0)) + (psetq x (aref a (incf i)) + y (aref a (incf i))) + (values a i))) + #(0 2 2 4 4 5 6 7 8 9) + 4) + +;;; Tests of PSETF + +(deftest psetf.1 + (psetf) + nil) + +(deftest psetf.2 + (let ((x 0)) + (values (psetf x 1) x)) + nil 1) + +(deftest psetf.3 + (let ((x 0) (y 1)) + (values (psetf x y y x) x y)) + nil 1 0) + +(deftest psetf.4 + (let ((x 0)) + (values + (symbol-macrolet ((x y)) + (let ((y 1)) + (psetf x 2) + y)) + x)) + 2 0) + +(deftest psetf.5 + (let ((w (list nil))) + (values + (symbol-macrolet ((x (car w))) + (psetf x 2)) + w)) + nil (2)) + +(deftest psetf.6 + (let ((c 0) x y) + (psetf x (incf c) + y (incf c)) + (values c x y)) + 2 1 2) + +;;; According to the standard, the forms to be assigned and +;;; the subforms in the places to be assigned to are evaluated +;;; from left to right. Therefore, PSETF.7 and PSETF.8 should +;;; do the same thing to A as PSETF.9 does. +;;; (See the page for PSETF) + +(deftest psetf.7 + (symbol-macrolet ((x (aref a (incf i))) + (y (aref a (incf i)))) + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) + (i 0)) + (psetf x (aref a (incf i)) + y (aref a (incf i))) + (values a i))) + #(0 2 2 4 4 5 6 7 8 9) + 4) + +(deftest psetf.8 + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) + (i 0)) + (psetf (aref a (incf i)) (aref a (incf i)) + (aref a (incf i)) (aref a (incf i))) + (values a i)) + #(0 2 2 4 4 5 6 7 8 9) + 4) + +(deftest psetf.9 + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9)))) + (psetf (aref a 1) (aref a 2) + (aref a 3) (aref a 4)) + a) + #(0 2 2 4 4 5 6 7 8 9)) diff --git a/ansi-tests/position-if-not.lsp b/ansi-tests/position-if-not.lsp new file mode 100644 index 0000000..00b1d7d --- /dev/null +++ b/ansi-tests/position-if-not.lsp @@ -0,0 +1,575 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 24 07:10:05 2002 +;;;; Contains: Tests for POSITION-IF-NOT-NOT + +(in-package :cl-test) + +(deftest position-if-not-list.1 + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-not-list.2 + (position-if-not 'oddp '(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-not-list.3 + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start 4) + 5) + +(deftest position-if-not-list.4 + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :from-end t) + 7) + +(deftest position-if-not-list.5 + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :from-end nil) + 3) + +(deftest position-if-not-list.6 + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start 4 + :from-end t) + 7) + +(deftest position-if-not-list.7 + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :end nil) + 3) + +(deftest position-if-not-list.8 + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :end 3) + nil) + +(deftest position-if-not-list.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-list.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-list.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j + :key '1+))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-list.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j + :key #'1+ :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +;;; Vector tests + +(deftest position-if-not-vector.1 + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-not-vector.2 + (position-if-not 'oddp #(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-not-vector.3 + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start 4) + 5) + +(deftest position-if-not-vector.4 + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :from-end t) + 7) + +(deftest position-if-not-vector.5 + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :from-end nil) + 3) + +(deftest position-if-not-vector.6 + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start 4 + :from-end t) + 7) + +(deftest position-if-not-vector.7 + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :end nil) + 3) + +(deftest position-if-not-vector.8 + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :end 3) + nil) + +(deftest position-if-not-vector.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-vector.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-vector.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j + :key '1+))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-vector.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j + :key #'1+ :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-vector.13 + (let ((a (make-array '(10) :initial-contents '(1 2 3 4 5 a b c d e) + :fill-pointer 5))) + (values + (position-if-not #'numberp a) + (position-if-not #'symbolp a) + (position-if-not #'numberp a :from-end t) + (position-if-not #'symbolp a :from-end t))) + nil 0 nil 4) + +;;; Bit vector tests + +(deftest position-if-not-bit-vector.1 + (position-if-not #'oddp #*111010101) + 3) + +(deftest position-if-not-bit-vector.2 + (position-if-not 'oddp #*111010101) + 3) + +(deftest position-if-not-bit-vector.3 + (position-if-not #'oddp #*111010101 :start 4) + 5) + +(deftest position-if-not-bit-vector.4 + (position-if-not #'oddp #*111010101 :from-end t) + 7) + +(deftest position-if-not-bit-vector.5 + (position-if-not #'oddp #*111010101 :from-end nil) + 3) + +(deftest position-if-not-bit-vector.6 + (position-if-not #'oddp #*111010101 :start 4 + :from-end t) + 7) + +(deftest position-if-not-bit-vector.7 + (position-if-not #'oddp #*111010101 :end nil) + 3) + +(deftest position-if-not-bit-vector.8 + (position-if-not #'oddp #*111010101 :end 3) + nil) + +(deftest position-if-not-bit-vector.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'oddp #*111010101 :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-bit-vector.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'oddp #*111010101 :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-bit-vector.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evenp #*111010101 :start i :end j + :key #'1+))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-bit-vector.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evenp #*111010101 :start i :end j + :key '1+ :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-bit-vector.13 + (let ((a (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0) + :fill-pointer 5 + :element-type 'bit))) + (values + (position-if-not #'zerop a) + (position-if-not (complement #'zerop) a) + (position-if-not #'zerop a :from-end t) + (position-if-not (complement #'zerop) a :from-end t))) + 0 nil 4 nil) + +;;; string tests + +(deftest position-if-not-string.1 + (position-if-not #'odddigitp "131432189") + 3) + +(deftest position-if-not-string.2 + (position-if-not 'odddigitp "131432189") + 3) + +(deftest position-if-not-string.3 + (position-if-not #'odddigitp "131432189" :start 4) + 5) + +(deftest position-if-not-string.4 + (position-if-not #'odddigitp "131432189" :from-end t) + 7) + +(deftest position-if-not-string.5 + (position-if-not #'odddigitp "131432189" :from-end nil) + 3) + +(deftest position-if-not-string.6 + (position-if-not #'odddigitp "131432189" :start 4 + :from-end t) + 7) + +(deftest position-if-not-string.7 + (position-if-not #'odddigitp "131432189" :end nil) + 3) + +(deftest position-if-not-string.8 + (position-if-not #'odddigitp "131432189" :end 3) + nil) + +(deftest position-if-not-string.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'odddigitp "131432189" :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-string.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'odddigitp "131432189" :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-string.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evendigitp "131432183" :start i :end j + :key #'nextdigit))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-string.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if-not #'evendigitp "131432183" :start i :end j + :key 'nextdigit :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-not-string.13 + (let ((a (make-array '(10) :initial-contents "55555aaaaa" + :fill-pointer 5 + :element-type 'character))) + (and (stringp a) + (values + (position-if-not #'digit-char-p a) + (position-if-not (complement #'digit-char-p) a) + (position-if-not #'digit-char-p a :from-end t) + (position-if-not (complement #'digit-char-p) a :from-end t)))) + nil 0 nil 4) + +(deftest position-if-not.order.1 + (let ((i 0) a b c d e f) + (values + (position-if-not + (progn (setf a (incf i)) (complement #'zerop)) + (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4)) + :from-end (setf c (incf i)) + :start (progn (setf d (incf i)) 1) + :end (progn (setf e (incf i)) 6) + :key (progn (setf f (incf i)) #'1-)) + i a b c d e f)) + 4 6 1 2 3 4 5 6) + +(deftest position-if-not.order.2 + (let ((i 0) a b c d e f) + (values + (position-if-not + (progn (setf a (incf i)) (complement #'zerop)) + (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4)) + :key (progn (setf c (incf i)) #'1-) + :end (progn (setf d (incf i)) 6) + :start (progn (setf e (incf i)) 1) + :from-end (setf f (incf i))) + i a b c d e f)) + 4 6 1 2 3 4 5 6) + +;;; Keyword tests + +(deftest position-if-not.allow-other-keys.1 + (position-if-not #'zerop '(0 0 3 2 0 1) :allow-other-keys t) + 2) + +(deftest position-if-not.allow-other-keys.2 + (position-if-not #'zerop '(0 0 3 2 0 1) :allow-other-keys nil) + 2) + +(deftest position-if-not.allow-other-keys.3 + (position-if-not #'zerop '(0 0 1 2 3 0) :allow-other-keys t :bad t) + 2) + +(deftest position-if-not.allow-other-keys.4 + (position-if-not #'zerop '(0 0 1 2 3 0) :bad t :allow-other-keys t) + 2) + +(deftest position-if-not.allow-other-keys.5 + (position-if-not #'zerop '(0 0 1 2 3 0) :bad t :allow-other-keys t :key #'1-) + 0) + +(deftest position-if-not.keywords.6 + (position-if-not #'zerop '(0 0 1 2 3 0) :key #'1- :key #'identity) + 0) + +(deftest position-if-not.allow-other-keys.7 + (position-if-not #'zerop '(0 0 1 2 3 0) :bad t :allow-other-keys t + :allow-other-keys nil) + 2) + +(deftest position-if-not.allow-other-keys.8 + (position-if-not #'zerop '(0 0 1 2 3 0) :allow-other-keys t :bad t + :allow-other-keys nil) + 2) + +(deftest position-if-not.allow-other-keys.9 + (position-if-not #'zerop '(0 0 1 2 3 0) :allow-other-keys t + :allow-other-keys nil :bad t) + 2) + + +;;; Error tests + +(deftest position-if-not.error.1 + (classify-error (position-if-not #'identity 'b)) + type-error) + +(deftest position-if-not.error.2 + (classify-error (position-if-not #'identity 10)) + type-error) + +(deftest position-if-not.error.3 + (classify-error (position-if-not 'null 1.4)) + type-error) + +(deftest position-if-not.error.4 + (classify-error (position-if-not 'identity '(a b c . d))) + type-error) + +(deftest position-if-not.error.5 + (classify-error (position-if-not)) + program-error) + +(deftest position-if-not.error.6 + (classify-error (position-if-not #'null)) + program-error) + +(deftest position-if-not.error.7 + (classify-error (position-if-not #'null nil :key)) + program-error) + +(deftest position-if-not.error.8 + (classify-error (position-if-not #'null nil 'bad t)) + program-error) + +(deftest position-if-not.error.9 + (classify-error (position-if-not #'null nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest position-if-not.error.10 + (classify-error (position-if-not #'null nil 1 2)) + program-error) + +(deftest position-if-not.error.11 + (classify-error (locally (position-if-not #'identity 'b) t)) + type-error) + +(deftest position-if-not.error.12 + (classify-error (position-if-not #'cons '(a b c d))) + program-error) + +(deftest position-if-not.error.13 + (classify-error (position-if-not #'car '(a b c d))) + type-error) + +(deftest position-if-not.error.14 + (classify-error (position-if-not #'identity '(a b c d) :key #'cdr)) + type-error) + +(deftest position-if-not.error.15 + (classify-error (position-if-not #'identity '(a b c d) :key #'cons)) + program-error) diff --git a/ansi-tests/position-if.lsp b/ansi-tests/position-if.lsp new file mode 100644 index 0000000..cad0748 --- /dev/null +++ b/ansi-tests/position-if.lsp @@ -0,0 +1,574 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Aug 23 22:08:57 2002 +;;;; Contains: Tests for POSITION-IF + +(in-package :cl-test) + +(deftest position-if-list.1 + (position-if #'evenp '(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-list.2 + (position-if 'evenp '(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-list.3 + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start 4) + 5) + +(deftest position-if-list.4 + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :from-end t) + 7) + +(deftest position-if-list.5 + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :from-end nil) + 3) + +(deftest position-if-list.6 + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start 4 + :from-end t) + 7) + +(deftest position-if-list.7 + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :end nil) + 3) + +(deftest position-if-list.8 + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :end 3) + nil) + +(deftest position-if-list.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-list.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-list.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j + :key '1+))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-list.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j + :key #'1+ :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +;;; Vector tests + +(deftest position-if-vector.1 + (position-if #'evenp #(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-vector.2 + (position-if 'evenp #(1 3 1 4 3 2 1 8 9)) + 3) + +(deftest position-if-vector.3 + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start 4) + 5) + +(deftest position-if-vector.4 + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :from-end t) + 7) + +(deftest position-if-vector.5 + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :from-end nil) + 3) + +(deftest position-if-vector.6 + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start 4 + :from-end t) + 7) + +(deftest position-if-vector.7 + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :end nil) + 3) + +(deftest position-if-vector.8 + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :end 3) + nil) + +(deftest position-if-vector.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-vector.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-vector.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j + :key '1+))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-vector.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j + :key #'1+ :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-vector.13 + (let ((a (make-array '(10) :initial-contents '(1 3 1 4 3 1 2 1 8 9) + :fill-pointer 5))) + (flet ((%f (x) (eql x 1))) + (values (position-if #'%f a) + (position-if #'%f a :from-end t)))) + 0 2) + +;;; Bit vector tests + +(deftest position-if-bit-vector.1 + (position-if #'evenp #*111010101) + 3) + +(deftest position-if-bit-vector.2 + (position-if 'evenp #*111010101) + 3) + +(deftest position-if-bit-vector.3 + (position-if #'evenp #*111010101 :start 4) + 5) + +(deftest position-if-bit-vector.4 + (position-if #'evenp #*111010101 :from-end t) + 7) + +(deftest position-if-bit-vector.5 + (position-if #'evenp #*111010101 :from-end nil) + 3) + +(deftest position-if-bit-vector.6 + (position-if #'evenp #*111010101 :start 4 + :from-end t) + 7) + +(deftest position-if-bit-vector.7 + (position-if #'evenp #*111010101 :end nil) + 3) + +(deftest position-if-bit-vector.8 + (position-if #'evenp #*111010101 :end 3) + nil) + +(deftest position-if-bit-vector.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evenp #*111010101 :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-bit-vector.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evenp #*111010101 :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-bit-vector.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'oddp #*111010101 :start i :end j + :key #'1+))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-bit-vector.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'oddp #*111010101 :start i :end j + :key '1+ :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-bit-vector.13 + (let ((a (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0) + :fill-pointer 5 + :element-type 'bit))) + (values (position-if #'evenp a) + (position-if #'evenp a :from-end 'foo) + (position-if #'oddp a) + (position-if #'oddp a :from-end 'foo))) + nil nil 0 4) + +;;; string tests + +(deftest position-if-string.1 + (position-if #'evendigitp "131432189") + 3) + +(deftest position-if-string.2 + (position-if 'evendigitp "131432189") + 3) + +(deftest position-if-string.3 + (position-if #'evendigitp "131432189" :start 4) + 5) + +(deftest position-if-string.4 + (position-if #'evendigitp "131432189" :from-end t) + 7) + +(deftest position-if-string.5 + (position-if #'evendigitp "131432189" :from-end nil) + 3) + +(deftest position-if-string.6 + (position-if #'evendigitp "131432189" :start 4 + :from-end t) + 7) + +(deftest position-if-string.7 + (position-if #'evendigitp "131432189" :end nil) + 3) + +(deftest position-if-string.8 + (position-if #'evendigitp "131432189" :end 3) + nil) + +(deftest position-if-string.9 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evendigitp "131432189" :start i :end j))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-string.10 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'evendigitp "131432189" :start i :end j + :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-string.11 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'odddigitp "131432189" :start i :end j + :key #'nextdigit))) + ((nil nil nil 3 3 3 3 3 3) + (nil nil 3 3 3 3 3 3) + (nil 3 3 3 3 3 3) + (3 3 3 3 3 3) + (nil 5 5 5 5) + (5 5 5 5) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-string.12 + (loop for i from 0 to 8 + collect + (loop for j from (1+ i) to 9 + collect + (position-if #'odddigitp "131432189" :start i :end j + :key 'nextdigit :from-end t))) + ((nil nil nil 3 3 5 5 7 7) + (nil nil 3 3 5 5 7 7) + (nil 3 3 5 5 7 7) + (3 3 5 5 7 7) + (nil 5 5 7 7) + (5 5 7 7) + (nil 7 7) + (7 7) + (nil))) + +(deftest position-if-string.13 + (flet ((%f (c) (eql c #\0)) + (%g (c) (eql c #\1))) + (let ((a (make-array '(10) :initial-contents "1111100000" + :fill-pointer 5 + :element-type 'character))) + (values (position-if #'%f a) + (position-if #'%f a :from-end 'foo) + (position-if #'%g a) + (position-if #'%g a :from-end 'foo)))) + nil nil 0 4) + +(deftest position-if.order.1 + (let ((i 0) a b c d e f) + (values + (position-if + (progn (setf a (incf i)) #'zerop) + (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4)) + :from-end (setf c (incf i)) + :start (progn (setf d (incf i)) 1) + :end (progn (setf e (incf i)) 6) + :key (progn (setf f (incf i)) #'1-)) + i a b c d e f)) + 4 6 1 2 3 4 5 6) + +(deftest position-if.order.2 + (let ((i 0) a b c d e f) + (values + (position-if + (progn (setf a (incf i)) #'zerop) + (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4)) + :key (progn (setf c (incf i)) #'1-) + :end (progn (setf d (incf i)) 6) + :start (progn (setf e (incf i)) 1) + :from-end (setf f (incf i))) + i a b c d e f)) + 4 6 1 2 3 4 5 6) + +;;; Keyword tests + +(deftest position-if.allow-other-keys.1 + (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t) + 2) + +(deftest position-if.allow-other-keys.2 + (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys nil) + 2) + +(deftest position-if.allow-other-keys.3 + (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t :bad t) + 2) + +(deftest position-if.allow-other-keys.4 + (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t) + 2) + +(deftest position-if.allow-other-keys.5 + (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t :key #'1-) + 0) + +(deftest position-if.keywords.6 + (position-if #'zerop '(1 2 0 3 2 1) :key #'1- :key #'identity) + 0) + +(deftest position-if.allow-other-keys.7 + (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t + :allow-other-keys nil) + 2) + +(deftest position-if.allow-other-keys.8 + (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t :bad t + :allow-other-keys nil) + 2) + +(deftest position-if.allow-other-keys.9 + (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t + :allow-other-keys nil :bad t) + 2) + + +;;; Error tests + +(deftest position-if.error.1 + (classify-error (position-if #'identity 'b)) + type-error) + +(deftest position-if.error.2 + (classify-error (position-if #'identity 10)) + type-error) + +(deftest position-if.error.3 + (classify-error (position-if 'null 1.4)) + type-error) + +(deftest position-if.error.4 + (classify-error (position-if 'null '(a b c . d))) + type-error) + +(deftest position-if.error.5 + (classify-error (position-if)) + program-error) + +(deftest position-if.error.6 + (classify-error (position-if #'null)) + program-error) + +(deftest position-if.error.7 + (classify-error (position-if #'null nil :key)) + program-error) + +(deftest position-if.error.8 + (classify-error (position-if #'null nil 'bad t)) + program-error) + +(deftest position-if.error.9 + (classify-error (position-if #'null nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest position-if.error.10 + (classify-error (position-if #'null nil 1 2)) + program-error) + +(deftest position-if.error.11 + (classify-error (locally (position-if #'identity 'b) t)) + type-error) + +(deftest position-if.error.12 + (classify-error (position-if #'cons '(a b c d))) + program-error) + +(deftest position-if.error.13 + (classify-error (position-if #'car '(a b c d))) + type-error) + +(deftest position-if.error.14 + (classify-error (position-if #'identity '(a b c d) :key #'cdr)) + type-error) + +(deftest position-if.error.15 + (classify-error (position-if #'identity '(a b c d) :key #'cons)) + program-error) + + diff --git a/ansi-tests/position.lsp b/ansi-tests/position.lsp new file mode 100644 index 0000000..e070b90 --- /dev/null +++ b/ansi-tests/position.lsp @@ -0,0 +1,773 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Aug 23 07:49:49 2002 +;;;; Contains: Tests for POSITION + +(in-package :cl-test) + +(deftest position-list.1 + (position 'c '(a b c d e c a)) + 2) + +(deftest position-list.2 + (position 'c '(a b c d e c a) :from-end t) + 5) + +(deftest position-list.3 + (loop for i from 0 to 7 collect + (position 'c '(a b c d e c a) :start i)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-list.4 + (loop for i from 0 to 7 collect + (position 'c '(a b c d e c a) :start i :end nil)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-list.5 + (loop for i from 7 downto 0 collect + (position 'c '(a b c d e c a) :end i)) + (2 2 2 2 2 nil nil nil)) + +(deftest position-list.6 + (loop for i from 0 to 7 collect + (position 'c '(a b c d e c a) :start i :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-list.7 + (loop for i from 0 to 7 collect + (position 'c '(a b c d e c a) :start i :end nil :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-list.8 + (loop for i from 7 downto 0 collect + (position 'c '(a b c d e c a) :end i :from-end t)) + (5 5 2 2 2 nil nil nil)) + +(deftest position-list.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position 'c '(a b c d e c a) :start i :end j))) + ((nil nil 2 2 2 2 2) + (nil 2 2 2 2 2) + (2 2 2 2 2) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-list.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position 'c '(a b c d e c a) :start i :end j :from-end t))) + ((nil nil 2 2 2 5 5) + (nil 2 2 2 5 5) + (2 2 2 5 5) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-list.11 + (position 5 '(1 2 3 4 5 6 4 8) :key #'1+) + 3) + +(deftest position-list.12 + (position 5 '(1 2 3 4 5 6 4 8) :key '1+) + 3) + +(deftest position-list.13 + (position 5 '(1 2 3 4 5 6 4 8) :key #'1+ :from-end t) + 6) + +(deftest position-list.14 + (position 'a '(a a b a c e d a f a) :test (complement #'eql)) + 2) + +(deftest position-list.15 + (position 'a '(a a b a c e d a f a) :test (complement #'eql) + :from-end t) + 8) + +(deftest position-list.16 + (position 'a '(a a b a c e d a f a) :test-not #'eql) + 2) + +(deftest position-list.17 + (position 'a '(a a b a c e d a f a) :test-not 'eql + :from-end t) + 8) + +(deftest position-list.18 + (position 'a '(a a b a c e d a f a) :test-not 'eql) + 2) + +(deftest position-list.19 + (position 'a '(a a b a c e d a f a) :test-not #'eql + :from-end t) + 8) + +(deftest position-list.20 + (position 'a '(a a b a c e d a f a) :test-not #'eql) + 2) + +(deftest position-list.21 + (position 'a '(a a b a c e d a f a) :test #'eql + :start 2) + 3) + +(deftest position-list.22 + (position 'a '(a a b a c e d a f a) :test #'eql + :start 2 :end nil) + 3) + +(deftest position-list.23 + (position 'a '(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5) + 2) + +(deftest position-list.24 + (position 'a '(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5 :from-end t) + 4) + +(deftest position-list.25 + (position '(a b) '(a (b a) (a b c) (a b) (d e) f) :test #'equal) + 3) + +(deftest position-list.26 + (position 'a '((c) (b a) (a b c) (a b) (d e) f) :key #'car) + 2) + +(deftest position-list.27 + (position 'a '((c) (b a) (a b c) (z) (a b) (d e) f) :key #'car + :start 3) + 4) + +(deftest position-list.28 + (position 'a '((c) (b a) (a b c) (z) (a b) (d e) (f)) :key #'car + :start 2 :from-end t) + 4) + +;;; Tests on vectors + +(deftest position-vector.1 + (position 'c #(a b c d e c a)) + 2) + +(deftest position-vector.2 + (position 'c #(a b c d e c a) :from-end t) + 5) + +(deftest position-vector.3 + (loop for i from 0 to 7 collect + (position 'c #(a b c d e c a) :start i)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-vector.4 + (loop for i from 0 to 7 collect + (position 'c #(a b c d e c a) :start i :end nil)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-vector.5 + (loop for i from 7 downto 0 collect + (position 'c #(a b c d e c a) :end i)) + (2 2 2 2 2 nil nil nil)) + +(deftest position-vector.6 + (loop for i from 0 to 7 collect + (position 'c #(a b c d e c a) :start i :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-vector.7 + (loop for i from 0 to 7 collect + (position 'c #(a b c d e c a) :start i :end nil :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-vector.8 + (loop for i from 7 downto 0 collect + (position 'c #(a b c d e c a) :end i :from-end t)) + (5 5 2 2 2 nil nil nil)) + +(deftest position-vector.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position 'c #(a b c d e c a) :start i :end j))) + ((nil nil 2 2 2 2 2) + (nil 2 2 2 2 2) + (2 2 2 2 2) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-vector.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position 'c #(a b c d e c a) :start i :end j :from-end t))) + ((nil nil 2 2 2 5 5) + (nil 2 2 2 5 5) + (2 2 2 5 5) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-vector.11 + (position 5 #(1 2 3 4 5 6 4 8) :key #'1+) + 3) + +(deftest position-vector.12 + (position 5 #(1 2 3 4 5 6 4 8) :key '1+) + 3) + +(deftest position-vector.13 + (position 5 #(1 2 3 4 5 6 4 8) :key #'1+ :from-end t) + 6) + +(deftest position-vector.14 + (position 'a #(a a b a c e d a f a) :test (complement #'eql)) + 2) + +(deftest position-vector.15 + (position 'a #(a a b a c e d a f a) :test (complement #'eql) + :from-end t) + 8) + +(deftest position-vector.16 + (position 'a #(a a b a c e d a f a) :test-not #'eql) + 2) + +(deftest position-vector.17 + (position 'a #(a a b a c e d a f a) :test-not 'eql + :from-end t) + 8) + +(deftest position-vector.18 + (position 'a #(a a b a c e d a f a) :test-not 'eql) + 2) + +(deftest position-vector.19 + (position 'a #(a a b a c e d a f a) :test-not #'eql + :from-end t) + 8) + +(deftest position-vector.20 + (position 'a #(a a b a c e d a f a) :test-not #'eql) + 2) + +(deftest position-vector.21 + (position 'a #(a a b a c e d a f a) :test #'eql + :start 2) + 3) + +(deftest position-vector.22 + (position 'a #(a a b a c e d a f a) :test #'eql + :start 2 :end nil) + 3) + +(deftest position-vector.23 + (position 'a #(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5) + 2) + +(deftest position-vector.24 + (position 'a #(a a b a c e d a f a) :test-not #'eql + :start 0 :end 5 :from-end t) + 4) + +(deftest position-vector.25 + (position '(a b) #(a (b a) (a b c) (a b) (d e) f) :test #'equal) + 3) + +(deftest position-vector.26 + (position 'a #((c) (b a) (a b c) (a b) (d e) f) :key #'car) + 2) + +(deftest position-vector.27 + (position 'a #((c) (b a) (a b c) (z) (a b) (d e) f) :key #'car + :start 3) + 4) + +(deftest position-vector.28 + (position 'a #((c) (b a) (a b c) (z) (a b) (d e) (f)) :key #'car + :start 2 :from-end t) + 4) + +(deftest position-vector.29 + (position 'a (make-array '(10) :initial-contents '(b b b b b a a a a a) + :fill-pointer 5)) + nil) + +(deftest position-vector.30 + (position 'a (make-array '(10) :initial-contents '(b b b b a a a a a a) + :fill-pointer 5)) + 4) + +(deftest position-vector.31 + (position 'a (make-array '(10) :initial-contents '(b a b b a a a a a a) + :fill-pointer 5) + :from-end t) + 4) + +;;; tests on bit vectors + +(deftest position-bit-vector.1 + (position 1 #*001001010100) + 2) + +(deftest position-bit-vector.2 + (position 1 #*001001010100 :from-end t) + 9) + +(deftest position-bit-vector.3 + (loop for i from 0 to 7 collect + (position 1 #*0010010 :start i)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-bit-vector.4 + (loop for i from 0 to 7 collect + (position 1 #*0010010 :start i :end nil)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-bit-vector.5 + (loop for i from 7 downto 0 collect + (position 1 #*0010010 :end i)) + (2 2 2 2 2 nil nil nil)) + +(deftest position-bit-vector.6 + (loop for i from 0 to 7 collect + (position 1 #*0010010 :start i :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-bit-vector.7 + (loop for i from 0 to 7 collect + (position 0 #*1101101 :start i :end nil :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-bit-vector.8 + (loop for i from 7 downto 0 collect + (position 0 #*1101101 :end i :from-end t)) + (5 5 2 2 2 nil nil nil)) + +(deftest position-bit-vector.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position 1 #*0010010 :start i :end j))) + ((nil nil 2 2 2 2 2) + (nil 2 2 2 2 2) + (2 2 2 2 2) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-bit-vector.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position 1 #*0010010 :start i :end j :from-end t))) + ((nil nil 2 2 2 5 5) + (nil 2 2 2 5 5) + (2 2 2 5 5) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-bit-vector.11 + (position 2 #*00010001010 :key #'1+) + 3) + +(deftest position-bit-vector.12 + (position 2 #*00010001010 :key '1+) + 3) + +(deftest position-bit-vector.13 + (position 2 #*0010001000 :key #'1+ :from-end t) + 6) + +(deftest position-bit-vector.14 + (position 0 #*0010111010 :test (complement #'eql)) + 2) + +(deftest position-bit-vector.15 + (position 0 #*0010111010 :test (complement #'eql) + :from-end t) + 8) + +(deftest position-bit-vector.16 + (position 0 #*0010111010 :test-not #'eql) + 2) + +(deftest position-bit-vector.17 + (position 0 #*001011101 :test-not 'eql + :from-end t) + 8) + +(deftest position-bit-vector.18 + (position 0 #*00101110 :test-not 'eql) + 2) + +(deftest position-bit-vector.19 + (position 0 #*00101110 :test-not #'eql + :from-end t) + 6) + +(deftest position-bit-vector.20 + (position 0 #*00101110 :test-not #'eql) + 2) + +(deftest position-bit-vector.21 + (position 0 #*00101110 :test #'eql + :start 2) + 3) + +(deftest position-bit-vector.22 + (position 0 #*00101110 :test #'eql + :start 2 :end nil) + 3) + +(deftest position-bit-vector.23 + (position 0 #*00101110 :test-not #'eql + :start 0 :end 5) + 2) + +(deftest position-bit-vector.24 + (position 0 #*00101110 :test-not #'eql + :start 0 :end 5 :from-end t) + 4) + +(deftest position-bit-vector.25 + (position 2 #*1100001010 :key #'1+ + :start 3) + 6) + +(deftest position-bit-vector.27 + (position 2 #*1100001010 :key #'1+ + :start 2 :from-end t) + 8) + +(deftest position-bit-vector.28 + (position 0 (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0) + :element-type 'bit + :fill-pointer 5)) + nil) + +(deftest position-bit-vector.29 + (position 0 (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0) + :element-type 'bit + :fill-pointer 5) + :from-end t) + nil) + +(deftest position-bit-vector.30 + (position 0 (make-array '(10) :initial-contents '(1 1 1 1 0 0 0 0 0 0) + :element-type 'bit + :fill-pointer 5)) + 4) + +(deftest position-bit-vector.31 + (position 0 (make-array '(10) :initial-contents '(0 1 0 1 0 0 0 0 0 0) + :element-type 'bit + :fill-pointer 5) + :from-end t) + 4) + +(deftest position-bit-vector.32 + (position 0 (make-array '(10) :initial-contents '(1 0 1 1 0 0 0 0 0 0) + :element-type 'bit + :fill-pointer 5)) + 1) + +;;; strings + +(deftest position-string.1 + (position #\c "abcdeca") + 2) + +(deftest position-string.2 + (position #\c "abcdeca" :from-end t) + 5) + +(deftest position-string.3 + (loop for i from 0 to 7 collect + (position #\c "abcdeca" :start i)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-string.4 + (loop for i from 0 to 7 collect + (position #\c "abcdeca" :start i :end nil)) + (2 2 2 5 5 5 nil nil)) + +(deftest position-string.5 + (loop for i from 7 downto 0 collect + (position #\c "abcdeca" :end i)) + (2 2 2 2 2 nil nil nil)) + +(deftest position-string.6 + (loop for i from 0 to 7 collect + (position #\c "abcdeca" :start i :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-string.7 + (loop for i from 0 to 7 collect + (position #\c "abcdeca" :start i :end nil :from-end t)) + (5 5 5 5 5 5 nil nil)) + +(deftest position-string.8 + (loop for i from 7 downto 0 collect + (position #\c "abcdeca" :end i :from-end t)) + (5 5 2 2 2 nil nil nil)) + +(deftest position-string.9 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position #\c "abcdeca" :start i :end j))) + ((nil nil 2 2 2 2 2) + (nil 2 2 2 2 2) + (2 2 2 2 2) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-string.10 + (loop for i from 0 to 6 collect + (loop for j from (1+ i) to 7 + collect + (position #\c "abcdeca" :start i :end j :from-end t))) + ((nil nil 2 2 2 5 5) + (nil 2 2 2 5 5) + (2 2 2 5 5) + (nil nil 5 5) + (nil 5 5) + (5 5) + (nil))) + +(deftest position-string.11 + (position 5 "12345648" :key #'(lambda (c) + (1+ (read-from-string (string c))))) + 3) + +(deftest position-string.13 + (position 5 "12345648" :key #'(lambda (c) + (1+ (read-from-string (string c)))) + :from-end t) + 6) + +(deftest position-string.14 + (position #\a "aabacedafa" :test (complement #'eql)) + 2) + +(deftest position-string.15 + (position #\a "aabacedafa" :test (complement #'eql) + :from-end t) + 8) + +(deftest position-string.16 + (position #\a "aabacedafa" :test-not #'eql) + 2) + +(deftest position-string.17 + (position #\a "aabacedafa" :test-not 'eql + :from-end t) + 8) + +(deftest position-string.18 + (position #\a "aabacedafa" :test-not 'eql) + 2) + +(deftest position-string.19 + (position #\a "aabacedafa" :test-not #'eql + :from-end t) + 8) + +(deftest position-string.20 + (position #\a "aabacedafa" :test-not #'eql) + 2) + +(deftest position-string.21 + (position #\a "aabacedafa" :test #'eql + :start 2) + 3) + +(deftest position-string.22 + (position #\a "aabacedafa" :test #'eql + :start 2 :end nil) + 3) + +(deftest position-string.23 + (position #\a "aabacedafa" :test-not #'eql + :start 0 :end 5) + 2) + +(deftest position-string.24 + (position #\a "aabacedafa" :test-not #'eql + :start 0 :end 5 :from-end t) + 4) + +(deftest position-string.25 + (position #\a (make-array '(10) :initial-contents "bbbbbaaaaa" + :element-type 'character + :fill-pointer 5)) + nil) + +(deftest position-string.26 + (position #\a (make-array '(10) :initial-contents "bbbbbaaaaa" + :element-type 'character + :fill-pointer 5) + :from-end t) + nil) + +(deftest position-string.27 + (position #\a (make-array '(10) :initial-contents "bbbbaaaaaa" + :element-type 'character + :fill-pointer 5)) + 4) + +(deftest position-string.28 + (position #\a (make-array '(10) :initial-contents "babbaaaaaa" + :element-type 'character + :fill-pointer 5) + :from-end t) + 4) + +(deftest position.order.1 + (let ((i 0) a b c d e f g) + (values + (position + (progn (setf a (incf i)) 0) + (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4)) + :from-end (setf c (incf i)) + :start (progn (setf d (incf i)) 1) + :end (progn (setf e (incf i)) 6) + :key (progn (setf f (incf i)) #'1-) + :test (progn (setf g (incf i)) #'=) + ) + i a b c d e f g)) + 4 7 1 2 3 4 5 6 7) + +(deftest position.order.2 + (let ((i 0) a b c d e f g) + (values + (position + (progn (setf a (incf i)) 0) + (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4)) + :test-not (progn (setf c (incf i)) #'/=) + :key (progn (setf d (incf i)) #'1-) + :end (progn (setf e (incf i)) 6) + :start (progn (setf f (incf i)) 1) + :from-end (setf g (incf i)) + ) + i a b c d e f g)) + 4 7 1 2 3 4 5 6 7) + +;;; Keyword tests + +(deftest position.allow-other-keys.1 + (position 0 '(1 2 0 3 2 1) :allow-other-keys t) + 2) + +(deftest position.allow-other-keys.2 + (position 0 '(1 2 0 3 2 1) :allow-other-keys nil) + 2) + +(deftest position.allow-other-keys.3 + (position 0 '(1 2 0 3 2 1) :allow-other-keys t :bad t) + 2) + +(deftest position.allow-other-keys.4 + (position 0 '(1 2 0 3 2 1) :bad t :allow-other-keys t) + 2) + +(deftest position.allow-other-keys.5 + (position 0 '(1 2 0 3 2 1) :bad t :allow-other-keys t :key #'1-) + 0) + +(deftest position.keywords.6 + (position 0 '(1 2 0 3 2 1) :key #'1- :key #'identity) + 0) + +(deftest position.allow-other-keys.7 + (position 0 '(1 2 0 3 2 1) :bad t :allow-other-keys t + :allow-other-keys nil) + 2) + +(deftest position.allow-other-keys.8 + (position 0 '(1 2 0 3 2 1) :allow-other-keys t :bad t + :allow-other-keys nil) + 2) + +(deftest position.allow-other-keys.9 + (position 0 '(1 2 0 3 2 1) :allow-other-keys t + :allow-other-keys nil :bad t) + 2) + +;;; Error tests + +(deftest position.error.1 + (classify-error (position 'a 'b)) + type-error) + +(deftest position.error.2 + (classify-error (position 'a 10)) + type-error) + +(deftest position.error.3 + (classify-error (position 'a 1.4)) + type-error) + +(deftest position.error.4 + (classify-error (position 'e '(a b c . d))) + type-error) + +(deftest position.error.5 + (classify-error (position)) + program-error) + +(deftest position.error.6 + (classify-error (position 'a)) + program-error) + +(deftest position.error.7 + (classify-error (position 'a nil :key)) + program-error) + +(deftest position.error.8 + (classify-error (position 'a nil 'bad t)) + program-error) + +(deftest position.error.9 + (classify-error (position 'a nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest position.error.10 + (classify-error (position 'a nil 1 2)) + program-error) + +(deftest position.error.11 + (classify-error (locally (position 'a 'b) t)) + type-error) + +(deftest position.error.12 + (classify-error (position 'b '(a b c d) :test #'identity)) + program-error) + +(deftest position.error.13 + (classify-error (position 'b '(a b c d) :test-not #'not)) + program-error) + +(deftest position.error.14 + (classify-error (position 'b '(a b c d) :key #'cdr)) + type-error) + +(deftest position.error.15 + (classify-error (position 'b '(a b c d) :key #'cons)) + program-error) + diff --git a/ansi-tests/probe-file.lsp b/ansi-tests/probe-file.lsp new file mode 100644 index 0000000..7e8d506 --- /dev/null +++ b/ansi-tests/probe-file.lsp @@ -0,0 +1,58 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 5 20:46:29 2004 +;;;; Contains: Tests of PROBE-FILE + +(in-package :cl-test) + +(deftest probe-file.1 + (probe-file #p"nonexistent") + nil) + +(deftest probe-file.2 + (let ((s (open #p"probe-file.lsp" :direction :input))) + (prog1 + (equalpt (truename #p"probe-file.lsp") + (probe-file s)) + (close s))) + t) + +(deftest probe-file.3 + (let ((s (open #p"probe-file.lsp" :direction :input))) + (close s) + (equalpt (truename #p"probe-file.lsp") + (probe-file s))) + t) + +(deftest probe-file.4 + (equalpt (truename #p"probe-file.lsp") + (probe-file "CLTEST:PROBE-FILE.LSP")) + t) + +;;; Specialized string tests + +(deftest probe-file.5 + (do-special-strings + (str "probe-file.lsp" nil) + (let ((s (open str :direction :input))) + (assert (equalpt (truename #p"probe-file.lsp") (probe-file s))) + (close s))) + nil) + +;;; Error tests + +(deftest probe-file.error.1 + (signals-error (probe-file) program-error) + t) + +(deftest probe-file.error.2 + (signals-error (probe-file #p"probe-file.lsp" nil) program-error) + t) + +(deftest probe-file.error.3 + (signals-error-always (probe-file (make-pathname :name :wild)) file-error) + t t) + +(deftest probe-file.error.4 + (signals-error-always (probe-file "CLTEST:*.FOO") file-error) + t t) diff --git a/ansi-tests/prog.lsp b/ansi-tests/prog.lsp new file mode 100644 index 0000000..8b508f2 --- /dev/null +++ b/ansi-tests/prog.lsp @@ -0,0 +1,147 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 09:21:57 2002 +;;;; Contains: Tests of PROG + +(in-package :cl-test) + +(deftest prog.1 + (prog ()) + nil) + +(deftest prog.2 + (prog () 'a) + nil) + +(deftest prog.3 + (prog () (return 'a)) + a) + +(deftest prog.4 + (prog () (return (values 1 2 3 4 5))) + 1 2 3 4 5) + +(deftest prog.5 + (let ((x 'a)) + (prog ((x 'b) (y x)) + (declare (type symbol x y)) + (return (values x y)))) + b a) + +(deftest prog.6 + (let ((x 'a)) + (prog (x) (setq x 'b)) + x) + a) + +(deftest prog.7 + (prog ((i 1) (s 0)) + (declare (type fixnum i s)) + again + (when (> i 10) (return s)) + (incf s i) + (incf i) + (go again)) + 55) + +(deftest prog.8 + (let ((x 0)) + (prog ((y (incf x)) (z (incf x))) + (return (values x y z)))) + 2 1 2) + +(deftest prog.9 + (flet ((%f () (locally (declare (special z)) z))) + (prog ((z 10)) + (declare (special z)) + (return (%f)))) + 10) + +(deftest prog.10 + (prog () + (return + (1+ + (prog () + (go end) + done + (return 1) + end + (go done)))) + done + (return 'bad)) + 2) + + +;;; Tests of PROG* + +(deftest prog*.1 + (prog* ()) + nil) + +(deftest prog*.2 + (prog* () 'a) + nil) + +(deftest prog*.3 + (prog* () (return 'a)) + a) + +(deftest prog*.4 + (prog* () (return (values 1 2 3 4 5))) + 1 2 3 4 5) + +(deftest prog*.5 + (let ((x 'a)) + (prog* ((z x) (x 'b) (y x)) + (declare (type symbol x y)) + (return (values x y z)))) + b b a) + +(deftest prog*.6 + (let ((x 'a)) + (prog* (x) (setq x 'b)) + x) + a) + +(deftest prog*.7 + (prog* ((i 1) (s 0)) + (declare (type fixnum i s)) + again + (when (> i 10) (return s)) + (incf s i) + (incf i) + (go again)) + 55) + +(deftest prog*.8 + (let ((x 0)) + (prog* ((y (incf x)) (z (incf x))) + (return (values x y z)))) + 2 1 2) + +(deftest prog*.9 + (flet ((%f () (locally (declare (special z)) z))) + (prog* ((z 10)) + (declare (special z)) + (return (%f)))) + 10) + +(deftest prog*.10 + (prog* () + (return + (1+ + (prog* () + (go end) + done + (return 1) + end + (go done)))) + done + (return 'bad)) + 2) + + + + + + diff --git a/ansi-tests/prog1.lsp b/ansi-tests/prog1.lsp new file mode 100644 index 0000000..66c8459 --- /dev/null +++ b/ansi-tests/prog1.lsp @@ -0,0 +1,27 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 09:37:14 2002 +;;;; Contains: Tests for PROG1 + +(in-package :cl-test) + +(deftest prog1.1 + (prog1 'a) + a) + +(deftest prog1.2 + (prog1 'a 'b) + a) + +(deftest prog1.3 + (prog1 (values 'a 'b) 'c) + a) + +(deftest prog1.4 + (prog1 (values) 'c) + nil) + +(deftest prog1.5 + (let ((x 0)) + (values (prog1 x (incf x)) x)) + 0 1) diff --git a/ansi-tests/prog2.lsp b/ansi-tests/prog2.lsp new file mode 100644 index 0000000..97dbed8 --- /dev/null +++ b/ansi-tests/prog2.lsp @@ -0,0 +1,36 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 09:40:51 2002 +;;;; Contains: Tests for PROG2 + +(in-package :cl-test) + +(deftest prog2.1 + (prog2 'a 'b) + b) + +(deftest prog2.2 + (prog2 'a 'b 'c) + b) + +(deftest prog2.3 + (prog2 'a (values) 'c) + nil) + +(deftest prog2.4 + (prog2 'a (values 'b 'd) 'c) + b) + +(deftest prog2.5 + (let ((x 0)) + (values + (prog2 (incf x) (incf x) (incf x)) + x)) + 2 3) + +(deftest prog2.6 + (let ((x 1)) + (values + (prog2 (incf x (1+ x)) (incf x (+ 2 x)) (incf x 100)) + x)) + 8 108) diff --git a/ansi-tests/progn.lsp b/ansi-tests/progn.lsp new file mode 100644 index 0000000..159530c --- /dev/null +++ b/ansi-tests/progn.lsp @@ -0,0 +1,38 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 09:33:51 2002 +;;;; Contains: Tests of PROGN + +(in-package :cl-test) + +(deftest progn.1 + (progn) + nil) + +(deftest progn.2 + (progn 'a) + a) + +(deftest progn.3 + (progn 'b 'a) + a) + +(deftest progn.4 + (let ((x 0)) + (values (progn (incf x) x) x)) + 1 1) + +(deftest progn.5 (progn (values))) + +(deftest progn.6 + (progn (values 1 2) (values 'a 'b 'c 'd 'e)) + a b c d e) + +(deftest progn.7 + (let ((x 0)) + (prog () + (progn (go x) x 'a) + (return 'bad) + x + (return 'good))) + good) diff --git a/ansi-tests/progv.lsp b/ansi-tests/progv.lsp new file mode 100644 index 0000000..5b863f0 --- /dev/null +++ b/ansi-tests/progv.lsp @@ -0,0 +1,75 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 10:00:50 2002 +;;;; Contains: Tests for PROGV + +(in-package :cl-test) + +(deftest progv.1 + (progv () () t) + t) + +(deftest progv.2 + (progv '(x) '(1) (not (not (boundp 'x)))) + t) + +(deftest progv.3 + (progv '(x) '(1) (symbol-value 'x)) + 1) + +(deftest progv.4 + (progv '(x) '(1) + (locally (declare (special x)) + x)) + 1) + +(deftest progv.5 + (let ((x 0)) + (progv '(x) '(1) x)) + 0) + +(deftest progv.6 + (let ((x 0)) + (declare (special x)) + (progv '(x) () + (boundp 'x))) + nil) + +(deftest progv.6a + (let ((x 0)) + (declare (special x)) + (progv '(x) () (setq x 1)) + x) + 0) + +(deftest progv.7 + (progv '(x y z) '(1 2 3) + (locally (declare (special x y z)) + (values x y z))) + 1 2 3) + +(deftest progv.8 + (progv '(x y z) '(1 2 3 4 5 6 7 8) + (locally (declare (special x y z)) + (values x y z))) + 1 2 3) + +(deftest progv.9 + (let ((x 0)) + (declare (special x)) + (progv '(x y z w) '(1) + (values (not (not (boundp 'x))) + (boundp 'y) + (boundp 'z) + (boundp 'w)))) + t nil nil nil) + +;; forms are evaluated in order + +(deftest progv.10 + (let ((x 0) (y 0) (c 0)) + (progv + (progn (setf x (incf c)) nil) + (progn (setf y (incf c)) nil) + (values x y c))) + 1 2 2) diff --git a/ansi-tests/random-aux.lsp b/ansi-tests/random-aux.lsp new file mode 100644 index 0000000..56895a9 --- /dev/null +++ b/ansi-tests/random-aux.lsp @@ -0,0 +1,90 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jun 8 06:56:15 2003 +;;;; Contains: Aux. functions and macros used for randomization + +(in-package :cl-test) + +(defun random-from-seq (seq) + "Generate a random member of a sequence." + (let ((len (length seq))) + (assert (> len 0)) + (elt seq (random len)))) + +(defmacro random-case (&body cases) + (let ((len (length cases))) + (assert (> len 0)) + `(case (random ,len) + ,@(loop for i from 0 for e in cases collect `(,i ,e)) + (t (error "Can't happen?! (in random-case)~%"))))) + +(defmacro rcase (&body cases) + "Usage: (RCASE (
+)+), where is a positive real + indicating the relative probability of executing the associated implicit + progn." + (assert cases) + (let* ((weights (mapcar #'car cases)) + (cumulative-weights (let ((sum 0)) + (loop for w in weights collect (incf sum w)))) + (total (car (last cumulative-weights))) + (r (gensym))) + (assert (every #'plusp weights)) + `(let ((,r (random ,total))) + (cond + ,@(loop for case in (butlast cases) + for cw in cumulative-weights + collect `((< ,r ,cw) ,@(cdr case))) + (t ,@(cdar (last cases))))))) + +(defun random-nonnegative-real () + (if (coin 3) + (random-case + (/ (random 10000) (1+ (random 1000))) + (/ (random 1000000) (1+ (random 100000))) + (/ (random 100000000) (1+ (random 10000000))) + (/ (random 1000000000000) (1+ (random 10000000)))) + (random (random-case + 1000 + 100000 + 10000000 + 1000000000 + (expt 2.0s0 (random 15)) + (expt 2.0f0 (random 32)) + (expt 2.0d0 (random 32)) + (expt 2.0l0 (random 32)))))) + +(defun random-real () + (if (coin) (random-nonnegative-real) + (- (random-nonnegative-real)))) + +(defun random-fixnum () + (+ (random (1+ (- most-positive-fixnum most-negative-fixnum))) + most-negative-fixnum)) + +(defun random-from-interval (upper &optional (lower (- upper))) + (+ (random (- upper lower)) lower)) + +(defun coin (&optional (n 2)) + "Flip an n-sided coin." + (eql (random n) 0)) + +;;; Randomly permute a sequence +(defun random-permute (seq) + (setq seq (copy-seq seq)) + (let ((len (length seq))) + (loop for i from len downto 2 + do (let ((r (random i))) + (rotatef (elt seq r) (elt seq (1- i)))))) + seq) + +(defun binomial-distribution-test (n fn) + (let* ((count (loop repeat n count (funcall fn))) + (sigma (/ (sqrt n) 2.0)) + (bound (* sigma 6)) + (expected (/ n 2.0))) + (<= (- expected bound) + count + (+ expected bound)))) + + + diff --git a/ansi-tests/random-int-form.lsp b/ansi-tests/random-int-form.lsp new file mode 100644 index 0000000..0104908 --- /dev/null +++ b/ansi-tests/random-int-form.lsp @@ -0,0 +1,2115 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Sep 10 18:03:52 2003 +;;;; Contains: Simple randon form generator/tester + +(in-package :cl-test) + +(compile-and-load "random-aux.lsp") + +;;; +;;; This file contains a routine for generating random legal Common Lisp functions +;;; for differential testing. +;;; +;;; To run the random tests by themselves, start a lisp in the ansi-tests directory +;;; and do the following: +;;; (load "gclload1.lsp") +;;; (compile-and-load "random-int-form.lsp") +;;; (in-package :cl-test) +;;; (let ((*random-state* (make-random-state t))) +;;; (test-random-integer-forms 100 4 10000)) ;; or other parameters +;;; +;;; If a test breaks during testing the variables *optimized-fn-src*, +;;; *unoptimized-fn-src*, and *int-form-vals* can be used to get the source +;;; of the optimized/unoptimized lambda forms being compiled, and the arguments +;;; on which they are called. +;;; +;;; If a difference is found between optimized/unoptimized functions the forms, +;;; values, and results are collected. A list of all these discrepancies is returned +;;; after testing finishes (assuming nothing breaks). +;;; +;;; The variable *compile-unoptimized-form* controls whether the low optimization +;;; form is compiled, or if a form funcalling it is EVALed. The latter is often +;;; faster, and may find more problems since an interpreter and compiler may evaluate +;;; forms in very different ways. +;;; +;;; The rctest/ subdirectory contains fragments of a more OO random form generator +;;; that will eventually replace this preliminary effort. +;;; +;;; The file misc.lsp contains tests that were mostly for bugs found by this +;;; random tester in various Common Lisp implementations. +;;; + +(declaim (special *optimized-fn-src* *unoptimized-fn-src* *int-form-vals* + *opt-result* *unopt-result* $x $y $z + *compile-unoptimized-form*)) + +;;; Little functions used to run collected tests. +;;; (f i) runs the ith collected optimized test +;;; (g i) runs the ith collected unoptimized test +;;; (p i) prints the ith test (forms, input values, and other information) + +(defun f (i) (let ((plist (elt $y i))) + (apply (compile nil (getf plist :optimized-lambda-form)) + (getf plist :vals)))) + +(defun g (i) (let ((plist (elt $y i))) + (if *compile-unoptimized-form* + (apply (compile nil (getf plist :unoptimized-lambda-form)) + (getf plist :vals)) + (apply (the function (eval `(function ,(getf plist :unoptimized-lambda-form)))) + (getf plist :vals))))) + +(defun p (i) (write (elt $y i) :pretty t :escape t) (values)) + +(defun tn (n &optional (size 100)) + (length (setq $y (prune-results (setq $x (test-random-integer-forms size 2 n)))))) + +(declaim (special *s1* *s2* *s3* *s4* *s5* *s6* *s7* *s8* *s9*)) + +(defparameter *loop-random-int-form-period* 2000) + +;;; Run the random tester, collecting failures into the special +;;; variable $y. + +(defun loop-random-int-forms (&optional (size 200) (nvars 3)) + (unless (boundp '$x) (setq $x nil)) + (unless (boundp '$y) (setq $y nil)) + (loop + for i from 1 + do + (format t "~6D | " i) + (finish-output *standard-output*) + (let ((x (test-random-integer-forms + size nvars *loop-random-int-form-period* + :index (* (1- i) *loop-random-int-form-period*)))) + (when x + (setq $x (append $x x)) + (setq x (prune-results x)) + (terpri) (print x) (finish-output *standard-output*) + (setq $y (append $y x))) + (terpri)))) + +(defvar *random-int-form-blocks* nil) +(defvar *random-int-form-catch-tags* nil) +(defvar *go-tags* nil) + +(defvar *maximum-random-int-bits* 45) + +(defvar *random-vals-list-bound* 10) + +(defvar *max-compile-time* 0) +(defvar *max-compile-term* nil) + +(defvar *print-immediately* nil) + +(defvar *compile-unoptimized-form* + #+(or allegro sbcl) t + #-(or allegro sbcl) nil) + +(declaim (special *vars*)) + +(defstruct var-desc + (name nil :type symbol) + (type t)) + +(defun test-random-integer-forms + (size nvars n + &key ((:random-state *random-state*) (make-random-state t)) + (file-prefix "b") + (index 0) + (random-size nil) + (random-nvars nil) + ) + + "Generate random integer forms of size SIZE with NVARS variables. + Do this N times, returning all those on which a discrepancy + is found between optimized and nonoptimize, notinlined code." + + (assert (integerp nvars)) + (assert (<= 1 nvars 26)) + (assert (and (integerp n) (plusp n))) + (assert (and (integerp n) (plusp size))) + +;;; #+sbcl +;;; (loop for x in (reverse sb-ext:*before-gc-hooks*) +;;; do (pushnew x sb-ext:*after-gc-hooks*)) + + (loop for i from 1 to n + do (when (= (mod i 100) 0) + ;; #+sbcl (print "Do gc...") + ;; #+sbcl (sb-ext::gc :full t) + (prin1 i) (princ " ") (finish-output *standard-output*)) + nconc (let ((result (test-random-integer-form + (if random-size (1+ (random size)) size) + (if random-nvars (1+ (random nvars)) nvars) + :index (+ index i) + :file-prefix file-prefix))) + (when result + (let ((*print-readably* t)) + (format t "~%~A~%" (format nil "~S" (car result))) + (finish-output *standard-output*))) + result))) + +(defun test-random-integer-form + (size nvars &key (index 0) (file-prefix "b")) + (let* ((vars (subseq '(a b c d e f g h i j k l m + n o p q r s u v w x y z) 0 nvars)) + (var-ranges (mapcar #'make-random-integer-range vars)) + (var-types (mapcar #'(lambda (range) + (let ((lo (car range)) + (hi (cadr range))) + (assert (>= hi lo)) + `(integer ,lo ,hi))) + var-ranges)) + (form (let ((*vars* (loop for v in vars + for tp in var-types + collect (make-var-desc :name v + :type tp))) + (*random-int-form-blocks* nil) + (*random-int-form-catch-tags* nil) + (*go-tags* nil) + ) + (make-random-integer-form (1+ (random size))))) + (vals-list + (loop repeat *random-vals-list-bound* + collect + (mapcar #'(lambda (range) + (let ((lo (car range)) + (hi (cadr range))) + (random-from-interval (1+ hi) lo))) + var-ranges))) + (opt-decls-1 (make-random-optimize-settings)) + (opt-decls-2 (make-random-optimize-settings))) + (when *print-immediately* + (with-open-file + (s (format nil "~A~A.lsp" file-prefix index) + :direction :output :if-exists :error) + (print `(defparameter *x* + '(:vars ,vars + :var-types ,var-types + :vals-list ,vals-list + :decls1 ,opt-decls-1 + :decls2 ,opt-decls-2 + :form ,form)) + s) + (print '(load "c.lsp") s) + (finish-output s)) + ;; (cl-user::gc) + (make-list 1000000) ;; try to trigger a gc + ) + (test-int-form form vars var-types vals-list opt-decls-1 opt-decls-2))) + +(defun make-random-optimize-settings () + (loop for settings = (cons + (list 'speed (1+ (random 3))) + (loop for s in '(space safety debug compilation-speed) + for n = (random 4) + collect (list s n))) + while + #+allegro (subsetp '((speed 3) (safety 0)) settings :test 'equal) + #-allegro nil + finally (return settings))) + +(defun fn-symbols-in-form (form) + "Return a list of the distinct standardized lisp function + symbols occuring ing FORM. These are used to generate a NOTINLINE + declaration for the unoptimized form." + (intersection + (remove-duplicates (fn-symbols-in-form* form) :test #'eq) + *cl-function-or-accessor-symbols*)) + +(defun fn-symbols-in-form* (form) + (when (consp form) + (if (symbolp (car form)) + (cons (car form) (mapcan #'fn-symbols-in-form* (cdr form))) + (mapcan #'fn-symbols-in-form* form)))) + +(defun make-random-integer-range (&optional var) + "Generate a list (LO HI) of integers, LO <= HI. This is used + for generating integer types." + (declare (ignore var)) + (rcase + (1 (flet ((%r () (let ((r (ash 1 (1+ (random *maximum-random-int-bits*))))) + (- (random r) (floor (/ r 2)))))) + (let ((x (%r)) + (y (%r))) + (list (min x y) (max x y))))) + (1 (let* ((b (ash 1 (1+ (random *maximum-random-int-bits*)))) + (b2 (floor (/ b 2)))) + (let ((x (- (random b) b2)) + (y (- (random b) b2))) + (list (min x y) (max x y))))))) + +(defun fn-arg-name (fn-name arg-index) + (intern (concatenate 'string + (subseq (symbol-name fn-name) 1) + (format nil "-~D" arg-index)) + (symbol-package fn-name))) + +(declaim (special *flet-names*)) +(defparameter *flet-names* nil) + +(defun make-random-integer () + (let ((r (ash 1 (1+ (random 32))))) + (- (random r) (floor (/ r 2))))) + +(defun random-var-desc () + (loop + (let* ((pos (random (length *vars*))) + (desc (elt *vars* pos))) + (when (= pos (position (var-desc-name desc) (the list *vars*) + :key #'var-desc-name)) + (return desc))))) + +(defun make-random-integer-form (size) + "Generate a random legal lisp form of size SIZE (roughly)." + + (if (<= size 1) + ;; Leaf node -- generate a variable, constant, or flet function call + (loop + when + (rcase + (10 (make-random-integer)) + (9 (if *vars* + (let* ((desc (random-var-desc)) + (type (var-desc-type desc)) + (name (var-desc-name desc))) + (cond + ((subtypep type 'integer) name) + ((subtypep type '(array integer nil)) `(aref ,name)) + ((subtypep type '(cons integer integer)) + (rcase (1 `(car ,name)) + (1 `(cdr ,name)))) + (t nil))) + nil)) + (1 (if *go-tags* `(go ,(random-from-seq *go-tags*)) nil)) + (2 (if *flet-names* + (let* ((flet-entry (random-from-seq *flet-names*)) + (flet-name (car flet-entry)) + (flet-minargs (cadr flet-entry)) + (flet-maxargs (caddr flet-entry)) + (nargs (random-from-interval (1+ flet-maxargs) flet-minargs)) + (args (loop repeat nargs + collect (make-random-integer-form 1)))) + `(,flet-name ,@args)) + nil))) + return it) + ;; (> size 1) + (rcase + ;; flet call + #-(or armedbear) + (30 ;; 5 + (make-random-integer-flet-call-form size)) + + ;; Unary ops + (40 + (let ((op (random-from-seq '(- abs signum 1+ 1- conjugate + rational rationalize + numerator denominator + identity progn floor + #-(or armedbear) ignore-errors + cl:handler-case restart-case + ceiling truncate round realpart imagpart + integer-length logcount values + locally)))) + `(,op ,(make-random-integer-form (1- size))))) + + #-(or armedbear) + (4 + (make-random-integer-unwind-protect-form size)) + + (5 (make-random-integer-mapping-form size)) + + ;; prog1, multiple-value-prog1 + #-(or armedbear) + (4 + (let* ((op (random-from-seq #(prog1 multiple-value-prog1))) + (nforms (random 4)) + (sizes (random-partition (1- size) (1+ nforms))) + (args (mapcar #'make-random-integer-form sizes))) + `(,op ,@args))) + + ;; prog2 + (2 (let* ((nforms (random 4)) + (sizes (random-partition (1- size) (+ nforms 2))) + (args (mapcar #'make-random-integer-form sizes))) + `(prog2 ,@args))) + + (2 `(isqrt (abs ,(make-random-integer-form (- size 2))))) + + (2 `(the integer ,(make-random-integer-form (1- size)))) + + (1 `(cl:handler-bind nil ,(make-random-integer-form (1- size)))) + (1 `(restart-bind nil ,(make-random-integer-form (1- size)))) + (1 `(macrolet () ,(make-random-integer-form (1- size)))) + + ;; dotimes + #-allegro + (5 + (let* ((var (random-from-seq #(iv1 iv2 iv3 iv4))) + (count (random 4)) + (sizes (random-partition (1- size) 2)) + (body (let ((*vars* (cons (make-var-desc :name var :type nil) + *vars*))) + (make-random-integer-form (first sizes)))) + (ret-form (make-random-integer-form (second sizes)))) + (unless (consp body) (setq body `(progn ,body))) + `(dotimes (,var ,count ,ret-form) ,body))) + + ;; loop + (5 (make-random-loop-form (1- size))) + + #-(or gcl ecl armedbear) + ;; load-time-value + (2 + (let ((arg (let ((*flet-names* nil) + (*vars* nil) + (*random-int-form-blocks* nil) + (*random-int-form-catch-tags* nil) + (*go-tags* nil)) + (make-random-integer-form (1- size))))) + (rcase + (4 `(load-time-value ,arg t)) + (2 `(load-time-value ,arg)) + (2 `(load-time-value ,arg nil))))) + + ;; eval + (2 (make-random-integer-eval-form size)) + + #-(or cmu allegro) + (2 + (destructuring-bind (s1 s2) + (random-partition (- size 2) 2) + `(ash ,(make-random-integer-form s1) + (min ,(random 100) + ,(make-random-integer-form s2))))) + + ;; binary floor, ceiling, truncate, round + (4 + (let ((op (random-from-seq #(floor ceiling truncate round mod rem))) + (op2 (random-from-seq #(max min)))) + (destructuring-bind (s1 s2) + (random-partition (- size 2) 2) + `(,op ,(make-random-integer-form s1) + (,op2 ,(if (eq op2 'max) + (1+ (random 100)) + (- (1+ (random 100)))) + ,(make-random-integer-form s2)))))) + + ;; Binary op + (30 + (let* ((op (random-from-seq + '(+ - * logand min max gcd + lcm + #-:allegro + logandc1 + logandc2 logeqv logior lognand lognor + #-:allegro + logorc1 + logorc2 + logxor + )))) + (destructuring-bind (leftsize rightsize) + (random-partition (1- size) 2) + (let ((e1 (make-random-integer-form leftsize)) + (e2 (make-random-integer-form rightsize))) + `(,op ,e1 ,e2))))) + + ;; boole + (4 + (let* ((op (random-from-seq + #(boole-1 boole-2 boole-and boole-andc1 boole-andc2 + boole-c1 boole-c2 boole-clr boole-eqv boole-ior boole-nand + boole-nor boole-orc1 boole-orc2 boole-set boole-xor)))) + (destructuring-bind (leftsize rightsize) + (random-partition (- size 2) 2) + (let ((e1 (make-random-integer-form leftsize)) + (e2 (make-random-integer-form rightsize))) + `(boole ,op ,e1 ,e2))))) + + ;; n-ary ops + (30 + (let* ((op (random-from-seq #(+ - * logand min max logior + lcm gcd logxor))) + (nargs (1+ (min (random 10) (random 10) (random 10)))) + (sizes (random-partition (1- size) nargs)) + (args (mapcar #'make-random-integer-form sizes))) + `(,op ,@args))) + + ;; expt + (3 `(expt ,(make-random-integer-form (1- size)) ,(random 3))) + + ;; coerce + (2 `(coerce ,(make-random-integer-form (1- size)) 'integer)) + + ;; complex (degenerate case) + (2 `(complex ,(make-random-integer-form (1- size)) 0)) + + ;; quotient (degenerate cases) + (1 `(/ ,(make-random-integer-form (1- size)) 1)) + (1 `(/ ,(make-random-integer-form (1- size)) -1)) + + ;; tagbody + (5 (make-random-tagbody-and-progn size)) + + ;; conditionals + (20 + (let* ((cond-size (random (max 1 (floor size 2)))) + (then-size (random (- size cond-size))) + (else-size (- size 1 cond-size then-size)) + (pred (make-random-pred-form cond-size)) + (then-part (make-random-integer-form then-size)) + (else-part (make-random-integer-form else-size))) + `(if ,pred ,then-part ,else-part))) + (5 + (destructuring-bind (s1 s2 s3) (random-partition (1- size) 3) + `(,(random-from-seq '(deposit-field dpb)) + ,(make-random-integer-form s1) + ,(make-random-byte-spec-form s2) + ,(make-random-integer-form s3)))) + + #-:allegro + (10 + (destructuring-bind (s1 s2) (random-partition (1- size) 2) + `(,(random-from-seq '(ldb mask-field)) + ,(make-random-byte-spec-form s1) + ,(make-random-integer-form s2)))) + + (20 (make-random-integer-binding-form size)) + + ;; progv + #-(or armedbear) + (4 (make-random-integer-progv-form size)) + + (4 `(let () ,(make-random-integer-form (1- size)))) + + (10 + (let* ((name (random-from-seq #(b1 b2 b3 b4 b5 b6 b7 b8))) + (*random-int-form-blocks* (adjoin name *random-int-form-blocks*))) + `(block ,name ,(make-random-integer-form (1- size))))) + + #-(or armedbear) + (20 + (let* ((tag (list 'quote (random-from-seq #(ct1 ct2 ct2 ct4 ct5 ct6 ct7 ct8)))) + (*random-int-form-catch-tags* (cons tag *random-int-form-catch-tags*))) + `(catch ,tag ,(make-random-integer-form (1- size))))) + + (4 ;; setq and similar + (make-random-integer-setq-form size)) + + (10 (make-random-integer-case-form size)) + + (3 + (if *random-int-form-blocks* + (let ((name (random-from-seq *random-int-form-blocks*)) + (form (make-random-integer-form (1- size)))) + `(return-from ,name ,form)) + ;; No blocks -- try again + (make-random-integer-form size))) + + (20 + (if *random-int-form-catch-tags* + (let ((tag (random-from-seq *random-int-form-catch-tags*)) + (form (make-random-integer-form (1- size)))) + `(throw ,tag ,form)) + ;; No catch tags -- try again + (make-random-integer-form size))) + + (5 + (if *random-int-form-blocks* + (destructuring-bind (s1 s2 s3) (random-partition (1- size) 3) + (let ((name (random-from-seq *random-int-form-blocks*)) + (pred (make-random-pred-form s1)) + (then (make-random-integer-form s2)) + (else (make-random-integer-form s3))) + `(if ,pred (return-from ,name ,then) ,else))) + ;; No blocks -- try again + (make-random-integer-form size))) + + #-(or armedbear) + (20 + (make-random-flet-form size)) + + (2 + (let* ((nbits (1+ (min (random 20) (random 20)))) + (bvec (coerce (loop repeat nbits collect (random 2)) 'simple-bit-vector)) + (op (random-from-seq #(bit sbit)))) + `(,op ,bvec (min ,(1- nbits) (max 0 ,(make-random-integer-form (- size 3 nbits))))))) + + (2 + (let* ((nvals (1+ (min (random 20) (random 20)))) + (lim (ash 1 (+ 3 (random 40)))) + (vec (coerce (loop repeat nvals collect (random lim)) 'simple-vector)) + (op (random-from-seq #(aref svref elt)))) + `(,op ,vec (min ,(1- nvals) (max 0 ,(make-random-integer-form (- size 3 nvals))))))) + + (2 + (let* ((nvals (1+ (min (random 20) (random 20)))) + (lim (ash 1 (+ 3 (random 40)))) + (vals (loop repeat nvals collect (random lim))) + (op 'elt)) + `(,op ',vals (min ,(1- nvals) (max 0 ,(make-random-integer-form (- size 3 nvals))))))) + + ))) + +(defun make-random-integer-flet-call-form (size) + (if *flet-names* + (let* ((flet-entry (random-from-seq *flet-names*)) + (flet-name (car flet-entry)) + (flet-minargs (cadr flet-entry)) + (flet-maxargs (caddr flet-entry)) + (nargs (random-from-interval (1+ flet-maxargs) flet-minargs)) + ) + (cond + ((> nargs 0) + (let* ((arg-sizes (random-partition (1- size) nargs)) + (args (mapcar #'make-random-integer-form arg-sizes))) + (rcase + (1 `(,flet-name ,@args)) + (1 `(multiple-value-call #',flet-name (values ,@args))) + (1 `(funcall (function ,flet-name) ,@args)) + (1 (let ((r (random (1+ (length args))))) + `(apply (function ,flet-name) + ,@(subseq args 0 r) + (list ,@(subseq args r)))))))) + (t (make-random-integer-form size)))) + (make-random-integer-form size))) + +(defun make-random-integer-unwind-protect-form (size) + (let* ((op 'unwind-protect) + (nforms (random 4)) + (sizes (random-partition (1- size) (1+ nforms))) + (arg (make-random-integer-form (first sizes))) + (unwind-forms + ;; We have to be careful not to generate code that will + ;; illegally transfer control to a dead location + (let ((*flet-names* nil) + (*go-tags* nil) + (*random-int-form-blocks* nil) + (*random-int-form-catch-tags* nil)) + (mapcar #'make-random-integer-form (rest sizes))))) + `(,op ,arg ,@unwind-forms))) + +(defun make-random-integer-eval-form (size) + (flet ((%arg (size) + (let ((*flet-names* nil) + (*vars* (remove-if-not #'(lambda (s) + (member (var-desc-name s) + '(*s1* *s2* *s3* *s4* *s5* + *s6* *s7* *s8* *s9*) + :test #'eq)) + *vars*)) + (*random-int-form-blocks* nil) + (*go-tags* nil)) + (make-random-integer-form size)))) + (rcase + (2 `(eval ',(%arg (1- size)))) + (2 (let* ((nargs (1+ (random 4))) + (sizes (random-partition (1- size) nargs)) + (args (mapcar #'%arg sizes))) + `(eval (values ,@args)))) + ))) + +(defun make-random-type-for-var (var e1) + (let (desc) + (values + (cond + ((and (member var '(*s1* *s2* *s3* *s4* *s5* *s6* *s7* *s8*) :test #'eq) + (setq desc (find var *vars* :key #'var-desc-name))) + (var-desc-type desc)) + (t (rcase + (4 '(integer * *)) + (2 (setq e1 `(make-array nil :initial-element ,e1 + ,@(rcase (1 nil) (1 '(:adjustable t))))) + '(array integer nil)) + (1 (setq e1 `(cons ,e1 ,(make-random-integer-form 1))) + '(cons integer integer)) + (1 (setq e1 `(cons ,(make-random-integer-form 1) ,e1)) + '(cons integer integer))))) + e1))) + +(defun make-random-integer-binding-form (size) + (destructuring-bind (s1 s2) (random-partition (1- size) 2) + (let* ((var (rcase + (2 (random-from-seq #(v1 v2 v3 v4 v5 v6 v7 v8 v9 v10))) + (2 (random-from-seq #(*s1* *s2* *s3* *s4* *s5* *s6* *s7* *s8*))))) + (e1 (make-random-integer-form s1)) + (type (multiple-value-bind (type2 e) + (make-random-type-for-var var e1) + (setq e1 e) + type2)) + (e2 (let ((*vars* (cons (make-var-desc :name var :type type) + *vars*))) + (make-random-integer-form s2))) + (op (random-from-seq #(let let*)))) + ;; for now, avoid shadowing + (if (member var *vars* :key #'var-desc-name) + (make-random-integer-form size) + (rcase + (8 `(,op ((,var ,e1)) + ,@(rcase (1 `((declare (dynamic-extent ,var)))) + (1 nil)) + ,e2)) + (2 `(multiple-value-bind (,var) ,e1 ,e2))))))) + +(defun make-random-integer-progv-form (size) + (let* ((num-vars (random 4)) + (possible-vars #(*s1* *s2* *s3* *s4* *s5* *s6* *s7* *s8*)) + (vars nil)) + (loop repeat num-vars + do (loop for r = (elt possible-vars (random (length possible-vars))) + while (member r vars) + finally (push r vars))) + (setq vars (remove-if #'(lambda (var) (let ((desc (find var *vars* :key #'var-desc-name))) + (and desc (not (subtypep (var-desc-type desc) 'integer))))) + vars) + num-vars (length vars)) + (if (null vars) + `(progv nil nil ,(make-random-integer-form (1- size))) + (destructuring-bind (s1 s2) (random-partition (1- size) 2) + (let* ((var-sizes (random-partition s1 num-vars)) + (var-forms (mapcar #'make-random-integer-form var-sizes)) + (*vars* (append (loop for v in vars collect + (make-var-desc :name v :type '(integer * *))) + *vars*)) + (body-form (make-random-integer-form s2))) + `(progv ',vars (list ,@var-forms) ,body-form)))))) + +(defun make-random-integer-mapping-form (size) + ;; reduce + (let ((keyargs nil) + (nargs (1+ (random (min 10 (max 1 size))))) + (sequence-op (random-from-seq '(vector list)))) + (when (coin 2) (setq keyargs '(:from-end t))) + (cond + ((coin 2) + (let ((start (random nargs))) + (setq keyargs `(:start ,start ,@keyargs)) + (when (coin 2) + (let ((end (+ start 1 (random (- nargs start))))) + (setq keyargs `(:end ,end ,@keyargs)))))) + (t + (when (coin 2) + (let ((end (1+ (random nargs)))) + (setq keyargs `(:end ,end ,@keyargs)))))) + (rcase + (1 + (let ((sizes (random-partition (1- size) nargs)) + (op (random-from-seq #(+ - * logand logxor logior max min)))) + `(reduce ,(rcase (1 `(function ,op)) + (1 `(quote ,op))) + (,sequence-op + ,@(mapcar #'make-random-integer-form sizes)) + ,@keyargs))) + #-(or armedbear) + (1 + (destructuring-bind (size1 size2) (random-partition (1- size) 2) + (let* ((vars '(lmv1 lmv2 lmv3 lmv4 lmv5 lmv6)) + (var1 (random-from-seq vars)) + (var2 (random-from-seq (remove var1 vars))) + (form (let ((*vars* (list* + (make-var-desc :name var1 :type '(integer * *)) + (make-var-desc :name var2 :type '(integer * *)) + *vars*))) + (make-random-integer-form size1))) + (sizes (random-partition size2 nargs)) + (args (mapcar #'make-random-integer-form sizes))) + `(reduce (function (lambda (,var1 ,var2) ,form)) + (,sequence-op ,@args) + ,@keyargs))))))) + +(defun make-random-integer-setq-form (size) + (if *vars* + (let* ((vdesc (random-from-seq *vars*)) + (var (var-desc-name vdesc)) + (type (var-desc-type vdesc)) + (op (random-from-seq #(setq setf #-(or armedbear)shiftf)))) + (cond + ((subtypep '(integer * *) type) + (assert (not (member var '(lv1 lv2 lv3 lv4 lv5 lv6 lv7 lv8)))) + (when (coin 4) + (setq op 'multiple-value-setq) + (setq var (list var))) + `(,op ,var ,(make-random-integer-form (1- size)))) + ((and (consp type) + (eq (car type) 'integer) + (integerp (second type)) + (integerp (third type))) + (assert (not (member var '(lv1 lv2 lv3 lv4 lv5 lv6 lv7 lv8)))) + (when (coin 4) + (setq op 'multiple-value-setq) + (setq var (list var))) + `(,op ,var ,(random-from-interval (1+ (third type)) (second type)))) + ((and (subtypep '(array integer nil) type)) + (assert (not (member var '(lv1 lv2 lv3 lv4 lv5 lv6 lv7 lv8)))) + (when (eq op 'setq) + (setq op (random-from-seq #(setf shiftf)))) + `(,op (aref ,var) ,(make-random-integer-form (- size 2)))) + ;; Abort -- can't assign + (t (make-random-integer-form size)))) + (make-random-integer-form size))) + + +(defun make-random-integer-case-form (size) + (let ((ncases (1+ (random 10)))) + (if (< (+ size size) (+ ncases 2)) + ;; Too small, give up + (make-random-integer-form size) + (let* ((sizes (random-partition (1- size) (+ ncases 2))) + (bound (ash 1 (+ 2 (random 16)))) + (lower-bound (if (coin 3) 0 (- bound))) + (upper-bound (if (and (< lower-bound 0) (coin 3)) + 1 + (1+ bound))) + (cases + (loop + for case-size in (cddr sizes) + for vals = (loop repeat (1+ (min (random 10) (random 10))) + collect (random-from-interval + upper-bound lower-bound)) + for result = (make-random-integer-form case-size) + repeat ncases + collect `(,vals ,result))) + (expr (make-random-integer-form (first sizes)))) + `(case ,expr + ,@cases + (t ,(make-random-integer-form (second sizes)))))))) + +(defun make-random-flet-form (size) + "Generate random flet, labels forms, for now with no arguments + and a single binding per form." + (let ((fname (random-from-seq #(%f1 %f2 %f3 %f4 %f5 %f6 %f7 %f8 %f9 %f10 + %f11 %f12 %f13 %f14 %f15 %f16 %f17 %f18)))) + (if (assoc fname *flet-names*) + ;; Fail if the name is in use + (make-random-integer-form size) + (let* ((op (random-from-seq #(flet labels))) + (minargs (random 4)) + (maxargs #+:allegro minargs + #-:allegro + (rcase + (1 minargs) + (1 (+ minargs (random 4))))) + (keyarg-p (coin 2)) + (keyarg-n (if keyarg-p (random 3) 0)) + (arg-names (loop for i from 1 to maxargs + collect (fn-arg-name fname i))) + (key-arg-names (loop for i from 1 to keyarg-n + collect (intern (format nil "KEY~A" i) + (find-package "CL-TEST")))) + (allow-other-keys (and keyarg-p (coin 3))) + ) + (destructuring-bind (s1 s2 . opt-sizes) + (random-partition (1- size) (+ 2 keyarg-n (- maxargs minargs))) + (let* ((form1 + ;; Allow return-from of the flet/labels function + (let ((*random-int-form-blocks* + (cons fname *random-int-form-blocks*)) + (*vars* (nconc (loop for var in (append arg-names key-arg-names) + collect (make-var-desc :name var + :type '(integer * *))) + *vars*))) + (make-random-integer-form s1))) + (form2 (let ((*flet-names* (cons (list fname minargs maxargs keyarg-p) + *flet-names*))) + (make-random-integer-form s2))) + (opt-forms (mapcar #'make-random-integer-form opt-sizes))) + (if opt-forms + `(,op ((,fname (,@(subseq arg-names 0 minargs) + &optional + ,@(mapcar #'list + (subseq arg-names minargs) + opt-forms) + ,@(when keyarg-p + (append '(&key) + (mapcar #'list + key-arg-names + (subseq opt-forms (- maxargs minargs))) + (when allow-other-keys '(&allow-other-keys)) + ))) + ,form1)) + ,form2) + `(,op ((,fname (,@arg-names + ,@(when keyarg-p + (append '(&key) + (mapcar #'list + key-arg-names + opt-forms ) + (when allow-other-keys '(&allow-other-keys)) + ))) + ,form1)) + ,form2)))))))) + +(defun make-random-tagbody (size) + (let* ((num-forms (random 6)) + (tags nil)) + (loop for i below num-forms + do (loop for tag = (rcase + #-allegro (1 (random 8)) + (1 (random-from-seq #(tag1 tag2 tag3 tag4 + tag5 tag6 tag7 tag8)))) + while (member tag tags) + finally (push tag tags))) + (assert (= (length (remove-duplicates tags)) (length tags))) + (let* ((*go-tags* (set-difference *go-tags* tags)) + (sizes (if (> num-forms 0) (random-partition (1- size) num-forms) nil)) + (forms + (loop for tag-list on tags + for i below num-forms + for size in sizes + collect (let ((*go-tags* (append tag-list *go-tags*))) + (make-random-integer-form size))))) + `(tagbody ,@(loop for tag in tags + for form in forms + when (atom form) do (setq form `(progn ,form)) + append `(,form ,tag)))))) + +(defun make-random-tagbody-and-progn (size) + (let* ((final-size (random (max 1 (floor size 5)))) + (tagbody-size (- size final-size))) + (let ((final-form (make-random-integer-form final-size)) + (tagbody-form (make-random-tagbody tagbody-size))) + `(progn ,tagbody-form ,final-form)))) + +(defun make-random-pred-form (size) + "Make a random form whose value is to be used as a generalized boolean." + (if (<= size 1) + (rcase + (1 (if (coin) t nil)) + (2 + `(,(random-from-seq '(< <= = > >= /= eql equal)) + ,(make-random-integer-form size) + ,(make-random-integer-form size)))) + (rcase + (1 (if (coin) t nil)) + (3 `(not ,(make-random-pred-form (1- size)))) + (6 (destructuring-bind (leftsize rightsize) + (random-partition (1- size) 2) + `(,(random-from-seq '(and or)) + ,(make-random-pred-form leftsize) + ,(make-random-pred-form rightsize)))) + (1 (destructuring-bind (leftsize rightsize) + (random-partition (1- size) 2) + `(,(random-from-seq '(< <= > >= = /= eql equal)) + ,(make-random-integer-form leftsize) + ,(make-random-integer-form rightsize)))) + (3 (let* ((cond-size (random (max 1 (floor size 2)))) + (then-size (random (- size cond-size))) + (else-size (- size 1 cond-size then-size)) + (pred (make-random-pred-form cond-size)) + (then-part (make-random-pred-form then-size)) + (else-part (make-random-pred-form else-size))) + `(if ,pred ,then-part ,else-part))) + (1 (destructuring-bind (s1 s2) + (random-partition (1- size) 2) + `(ldb-test ,(make-random-byte-spec-form s1) + ,(make-random-integer-form s2)))) + (1 (let ((index (random (1+ (random *maximum-random-int-bits*)))) + (form (make-random-integer-form (1- size)))) + `(logbitp ,index ,form))) + (1 ;; typep form + (let ((subform (make-random-integer-form (- size 2))) + (type + (rcase + (1 `(integer ,@(make-random-integer-range))) + (1 `(integer ,(make-random-integer))) + (1 `(integer * ,(make-random-integer))) + (1 `(integer))))) + `(typep ,subform ',type))) + ))) + +(defun make-random-loop-form (size) + (if (<= size 2) + (make-random-integer-form size) + (let* ((var (random-from-seq #(lv1 lv2 lv3 lv4))) + (count (random 4)) + (*vars* (cons (make-var-desc :name var :type nil) + *vars*))) + (rcase + (1 `(loop for ,var below ,count count ,(make-random-pred-form (- size 2)))) + (1 `(loop for ,var below ,count sum ,(make-random-integer-form (- size 2)))) + )))) + +(defun make-random-byte-spec-form (size) + (declare (ignore size)) + (let* ((pform (random 33)) + (sform (1+ (random 33)))) + `(byte ,sform ,pform))) + +(defun make-random-element-of-type (type) + "Create a random element of a lisp type." + (cond + ((consp type) + (let ((type-op (first type))) + (ecase type-op + (integer + (let ((lo (let ((lo (cadr type))) + (cond + ((consp lo) (1+ (car lo))) + ((eq lo nil) '*) + (t lo)))) + (hi (let ((hi (caddr type))) + (cond + ((consp hi) (1- (car hi))) + ((eq hi nil) '*) + (t hi))))) + (if (eq lo '*) + (if (eq hi '*) + (let ((x (ash 1 (random *maximum-random-int-bits*)))) + (random-from-interval x (- x))) + (random-from-interval (1+ hi) + (- hi (random (ash 1 *maximum-random-int-bits*))))) + + (if (eq hi '*) + (random-from-interval (+ lo (random (ash 1 *maximum-random-int-bits*)) 1) + lo) + ;; May generalize the next case to increase odds + ;; of certain integers (near 0, near endpoints, near + ;; powers of 2...) + (random-from-interval (1+ hi) lo))))) + (mod + (let ((modulus (second type))) + (assert (and (integerp modulus) + (plusp modulus))) + (make-random-element-of-type `(integer 0 (,modulus))))) + (unsigned-byte + (if (null (cdr type)) + (make-random-element-of-type '(integer 0 *)) + (let ((bits (second type))) + (if (eq bits'*) + (make-random-element-of-type '(integer 0 *)) + (progn + (assert (and (integerp bits) (>= bits 1))) + (make-random-element-of-type + `(integer 0 ,(1- (ash 1 bits))))))))) + ))) + (t + (ecase type + (bit (random 2)) + (boolean (random-from-seq #(nil t))) + (symbol (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| cl:car))) + (unsigned-byte (random-from-interval + (1+ (ash 1 (random *maximum-random-int-bits*))) 0)) + (integer (let ((x (ash 1 (random *maximum-random-int-bits*)))) + (random-from-interval (1+ x) (- x)))) + )))) + +(defun make-optimized-lambda-form (form vars var-types opt-decls) + `(lambda ,vars + ,@(mapcar #'(lambda (tp var) `(declare (type ,tp ,var))) + var-types vars) + (declare (ignorable ,@vars)) + #+cmu (declare (optimize (extensions:inhibit-warnings 3))) + (declare (optimize ,@opt-decls)) + ,form)) + +(defun make-unoptimized-lambda-form (form vars var-types opt-decls) + (declare (ignore var-types)) + `(lambda ,vars + (declare (notinline ,@(fn-symbols-in-form form))) + #+cmu (declare (optimize (extensions:inhibit-warnings 3))) + (declare (optimize ,@opt-decls)) + ,form)) + +(defvar *compile-using-defun* + #-(or allegro lispworks) nil + #+(or allegro lispworks) t) +(defvar *name-to-use-in-optimized-defun* 'dummy-fn-name1) +(defvar *name-to-use-in-unoptimized-defun* 'dummy-fn-name2) + +(defun test-int-form (form vars var-types vals-list opt-decls-1 opt-decls-2) + ;; Try to compile FORM with associated VARS, and if it compiles + ;; check for equality of the two compiled forms. + ;; Return a non-nil list of details if a problem is found, + ;; NIL otherwise. + (let ((optimized-fn-src (make-optimized-lambda-form form vars var-types opt-decls-1)) + (unoptimized-fn-src (make-unoptimized-lambda-form form vars var-types opt-decls-2))) + (setq *int-form-vals* nil + *optimized-fn-src* optimized-fn-src + *unoptimized-fn-src* unoptimized-fn-src) + (flet ((%compile + (lambda-form opt-defun-name) + (cl:handler-bind + (#+sbcl (sb-ext::compiler-note #'muffle-warning) + (warning #'muffle-warning) + (error #'(lambda (c) + (format t "Compilation failure~%~A~%" + (format nil "~S" form)) + (finish-output *standard-output*) + (return-from test-int-form + (list (list :vars vars + :form form + :var-types var-types + :vals (first vals-list) + :lambda-form lambda-form + :decls1 opt-decls-1 + :decls2 opt-decls-2 + :compiler-condition + (with-output-to-string + (s) + (prin1 c s)))))))) + (let ((start-time (get-universal-time))) + (prog1 + (if *compile-using-defun* + (progn + (eval `(defun ,opt-defun-name + ,@(cdr lambda-form))) + (compile opt-defun-name) + (symbol-function opt-defun-name)) + (compile nil lambda-form)) + (let* ((stop-time (get-universal-time)) + (total-time (- stop-time start-time))) + (when (> total-time *max-compile-time*) + (setf *max-compile-time* total-time) + (setf *max-compile-term* lambda-form))) + ;; #+:ecl (si:gc t) + ))))) + (let ((optimized-compiled-fn (%compile optimized-fn-src + *name-to-use-in-optimized-defun*)) + (unoptimized-compiled-fn + (if *compile-unoptimized-form* + (%compile unoptimized-fn-src *name-to-use-in-unoptimized-defun*) + (eval `(function ,unoptimized-fn-src))))) + (declare (type function optimized-compiled-fn unoptimized-compiled-fn)) + (dolist (vals vals-list) + (setq *int-form-vals* vals) + (flet ((%eval-error + (kind) + (let ((*print-circle* t)) + (format t "~A~%" (format nil "~S" form))) + (finish-output *standard-output*) + (return + (list (list :vars vars + :vals vals + :form form + :var-types var-types + :decls1 opt-decls-1 + :decls2 opt-decls-2 + :optimized-lambda-form optimized-fn-src + :unoptimized-lambda-form unoptimized-fn-src + :kind kind))))) + + (let ((unopt-result + (cl:handler-case + (cl:handler-bind + (#+sbcl (sb-ext::compiler-note #'muffle-warning) + (warning #'muffle-warning)) + (identity ;; multiple-value-list + (apply unoptimized-compiled-fn vals))) + ((or error serious-condition) + (c) + (%eval-error (list :unoptimized-form-error + (with-output-to-string + (s) (prin1 c s))))))) + (opt-result + (cl:handler-case + (cl:handler-bind + (#+sbcl (sb-ext::compiler-note #'muffle-warning) + (warning #'muffle-warning)) + (identity ;; multiple-value-list + (apply optimized-compiled-fn vals))) + ((or error serious-condition) + (c) + (%eval-error (list :optimized-form-error + (with-output-to-string + (s) (prin1 c s)))))))) + (if (equal opt-result unopt-result) + nil + (progn + (format t "Different results: ~A, ~A~%" + opt-result unopt-result) + (setq *opt-result* opt-result + *unopt-result* unopt-result) + (%eval-error (list :different-results + opt-result + unopt-result))))))))))) + +;;; Interface to the form pruner + +(declaim (special *prune-table*)) + +(defun prune-int-form (input-form vars var-types vals-list opt-decls-1 opt-decls-2) + "Conduct tests on selected simplified versions of INPUT-FORM. Return the + minimal form that still causes some kind of failure." + (loop do + (let ((form input-form)) + (flet ((%try-fn (new-form) + (when (test-int-form new-form vars var-types vals-list + opt-decls-1 opt-decls-2) + (setf form new-form) + (throw 'success nil)))) + (let ((*prune-table* (make-hash-table :test #'eq))) + (loop + (catch 'success + (prune form #'%try-fn) + (return form))))) + (when (equal form input-form) (return form)) + (setq input-form form)))) + +(defun prune-results (result-list) + "Given a list of test results, prune their forms down to a minimal set." + (loop for result in result-list + collect + (let* ((form (getf result :form)) + (vars (getf result :vars)) + (var-types (getf result :var-types)) + (vals-list (list (getf result :vals))) + (opt-decl-1 (getf result :decls1)) + (opt-decl-2 (getf result :decls2)) + (pruned-form (prune-int-form form vars var-types vals-list opt-decl-1 opt-decl-2)) + (optimized-lambda-form (make-optimized-lambda-form + pruned-form vars var-types opt-decl-1)) + (unoptimized-lambda-form (make-unoptimized-lambda-form + pruned-form vars var-types opt-decl-2))) + `(:vars ,vars + :var-types ,var-types + :vals ,(first vals-list) + :form ,pruned-form + :decls1 ,opt-decl-1 + :decls2 ,opt-decl-2 + :optimized-lambda-form ,optimized-lambda-form + :unoptimized-lambda-form ,unoptimized-lambda-form)))) + +;;; +;;; The call (PRUNE form try-fn) attempts to simplify the lisp form +;;; so that it still satisfies TRY-FN. The function TRY-FN should +;;; return if the substitution is a failure. Otherwise, it should +;;; transfer control elsewhere via GO, THROW, etc. +;;; +;;; The return value of PRUNE should be ignored. +;;; +(defun prune (form try-fn) + (declare (type function try-fn)) + (when (gethash form *prune-table*) + (return-from prune nil)) + (flet ((try (x) (funcall try-fn x))) + (cond + ((keywordp form) nil) + ((integerp form) + (unless (zerop form) (try 0))) + ((consp form) + (let* ((op (car form)) + (args (cdr form)) + (nargs (length args))) + (case op + + ((quote) nil) + + ((go) + (try 0)) + + ((signum integer-length logcount + logandc1 logandc2 lognand lognor logorc1 logorc2 + realpart imagpart) + (try 0) + (mapc try-fn args) + (prune-fn form try-fn)) + + ((make-array) + (when (and (eq (car args) nil) + (eq (cadr args) ':initial-element) + ; (null (cdddr args)) + ) + (prune (caddr args) #'(lambda (form) (try `(make-array nil :initial-element ,form . ,(cdddr args))))) + (when (cdddr args) + (try `(make-array nil :initial-element ,(caddr args)))) + )) + + ((cons) + (prune-fn form try-fn)) + + ((dotimes) + (try 0) + (let* ((binding-form (first args)) + (body (rest args)) + (var (first binding-form)) + (count-form (second binding-form)) + (result (third binding-form))) + (try result) + (unless (eql count-form 0) + (try `(dotimes (,var 0 ,result) ,@body))) + (prune result #'(lambda (form) + (try `(dotimes (,var ,count-form ,form) ,@body)))) + (when (= (length body) 1) + (prune (first body) + #'(lambda (form) + (when (consp form) + (try `(dotimes (,var ,count-form ,result) ,form)))))))) + + ((abs 1+ 1-) + (try 0) + (mapc try-fn args) + (prune-fn form try-fn)) + + ((identity values ignore-errors cl:handler-case restart-case locally) + (unless (and (consp args) + (consp (car args)) + (eql (caar args) 'tagbody)) + (mapc try-fn args)) + (prune-fn form try-fn)) + + ((boole) + (try (second args)) + (try (third args)) + (prune (second args) + #'(lambda (form) (try `(boole ,(first args) ,form ,(third args))))) + (prune (third args) + #'(lambda (form) (try `(boole ,(first args) ,(second args) ,form))))) + + ((unwind-protect prog1 multiple-value-prog1) + (try (first args)) + (let ((val (first args)) + (rest (rest args))) + (when rest + (try `(unwind-protect ,val)) + (when (cdr rest) + (loop for i from 0 below (length rest) + do + (try `(unwind-protect ,val + ,@(subseq rest 0 i) + ,@(subseq rest (1+ i)))))))) + (prune-fn form try-fn)) + + ((prog2) + (assert (>= (length args) 2)) + (let ((val1 (first args)) + (arg2 (second args)) + (rest (cddr args))) + (try arg2) + (prune-fn form try-fn) + (when rest + (try `(prog2 ,val1 ,arg2)) + (when (cdr rest) + (loop for i from 0 below (length rest) + do + (try `(prog2 ,val1 ,arg2 + ,@(subseq rest 0 i) + ,@(subseq rest (1+ i))))))))) + + ((typep) + (try (car args)) + (prune (car args) + #'(lambda (form) `(,op ,form ,@(cdr args))))) + + ((load-time-value) + (let ((arg (first args))) + (try arg) + (cond + ((cdr args) + (try `(load-time-value ,arg)) + (prune arg + #'(lambda (form) + (try `(load-time-value ,form ,(second args)))))) + (t + (prune arg + #'(lambda (form) + (try `(load-time-value ,form)))))))) + + ((eval) + (try 0) + (let ((arg (first args))) + (cond + ((consp arg) + (cond + ((eql (car arg) 'quote) + (prune (cadr arg) #'(lambda (form) (try `(eval ',form))))) + (t + (try arg) + (prune arg #'(lambda (form) `(eval ,form)))))) + (t (try arg))))) + + ((the macrolet cl:handler-bind restart-bind) + (assert (= (length args) 2)) + (try (second args)) + (prune (second args) try-fn)) + + ((not eq eql equal) + (when (every #'constantp args) + (try (eval form))) + (try t) + (try nil) + (mapc try-fn args) + (prune-fn form try-fn) + ) + + ((and or = < > <= >= /=) + (when (every #'constantp args) + (try (eval form))) + (try t) + (try nil) + (mapc try-fn args) + (prune-nary-fn form try-fn) + (prune-fn form try-fn)) + + ((- + * min max logand logior logxor logeqv gcd lcm) + (when (every #'constantp args) + (try (eval form))) + (try 0) + (mapc try-fn args) + (prune-nary-fn form try-fn) + (prune-fn form try-fn)) + + ((/) + (when (every #'constantp args) + (try (eval form))) + (try 0) + (try (car args)) + (when (cddr args) + (prune (car args) #'(lambda (form) (try `(/ ,form ,(second args))))))) + + ((multiple-value-call) + ;; Simplify usual case + (when (= nargs 2) + (destructuring-bind (arg1 arg2) args + (when (and (consp arg1) (consp arg2) + (eql (first arg1) 'function) + (eql (first arg2) 'values)) + (mapc try-fn (rest arg2)) + (let ((fn (second arg1))) + (when (symbolp fn) + (try `(,fn ,@(rest arg2))))) + ;; Prune the VALUES form + (prune-list (rest arg2) + #'prune + #'(lambda (args) + (try `(multiple-value-call ,arg1 (values ,@args))))) + ))) + (mapc try-fn (rest args))) + + ((bit sbit elt aref svref) + (try 0) + (when (= (length args) 2) + (let ((arg1 (car args)) + (arg2 (cadr args))) + (when (and (consp arg2) + (eql (car arg2) 'min) + (integerp (cadr arg2))) + (let ((arg2.2 (caddr arg2))) + (when (and (consp arg2.2) + (eql (car arg2.2) 'max) + (integerp (cadr arg2.2))) + (prune (caddr arg2.2) + #'(lambda (form) + (try `(,op ,arg1 (min ,(cadr arg2) + (max ,(cadr arg2.2) ,form)))))))))))) + + ((car cdr) + (try 0) + (try 1)) + + ((if) + (let (;; (pred (first args)) + (then (second args)) + (else (third args))) + (try then) + (try else) + (when (every #'constantp args) + (try (eval form))) + (prune-fn form try-fn))) + + ((setq setf shiftf) + (try 0) + ;; Assumes only one assignment + (assert (= (length form) 3)) + (try (second args)) + (unless (integerp (second args)) + (prune (second args) + #'(lambda (form) + (try `(,op ,(first args) ,form)))))) + + ((multiple-value-setq) + (try 0) + ;; Assumes only one assignment, and one variable + (assert (= (length form) 3)) + (assert (= (length (first args)) 1)) + (try `(setq ,(caar args) ,(cadr args))) + (unless (integerp (second args)) + (prune (second args) + #'(lambda (form) + (try `(,op ,(first args) ,form)))))) + + ((byte) + (prune-fn form try-fn)) + + ((deposit-field dpb) + (try 0) + (destructuring-bind (a1 a2 a3) + args + (try a1) + (try a3) + (when (and (integerp a1) + (integerp a3) + (and (consp a2) + (eq (first a2) 'byte) + (integerp (second a2)) + (integerp (third a2)))) + (try (eval form)))) + (prune-fn form try-fn)) + + ((ldb mask-field) + (try 0) + (try (second args)) + (when (and (consp (first args)) + (eq 'byte (first (first args))) + (every #'numberp (cdr (first args))) + (numberp (second args))) + (try (eval form))) + (prune-fn form try-fn)) + + ((ldb-test) + (try t) + (try nil) + (prune-fn form try-fn)) + + ((let let*) + (prune-let form try-fn)) + + ((multiple-value-bind) + (assert (= (length args) 3)) + (let ((arg1 (first args)) + (arg2 (second args)) + (body (caddr args))) + (when (= (length arg1) 1) + (try `(let ((,(first arg1) ,arg2)) ,body))) + (prune arg2 #'(lambda (form) + (try `(multiple-value-bind ,arg1 ,form ,body)))) + (prune body #'(lambda (form) + (try `(multiple-value-bind ,arg1 ,arg2 ,form)))))) + + ((block) + (let ((name (second form)) + (body (cddr form))) + (when (and body (null (cdr body))) + (let ((form1 (first body))) + + ;; Try removing the block entirely if it is not in use + (when (not (find-in-tree name body)) + (try form1)) + + ;; Try removing the block if its only use is an immediately + ;; enclosed return-from: (block (return-from )) + (when (and (consp form1) + (eq (first form1) 'return-from) + (eq (second form1) name) + (not (find-in-tree name (third form1)))) + (try (third form1))) + + ;; Otherwise, try to simplify the subexpression + (prune form1 + #'(lambda (x) + (try `(block ,name ,x)))))))) + + ((catch) + (let* ((tag (second form)) + (name (if (consp tag) (cadr tag) tag)) + (body (cddr form))) + (when (and body (null (cdr body))) + (let ((form1 (first body))) + + ;; Try removing the catch entirely if it is not in use + ;; We make assumptions here about what throws can + ;; be present. + (when (or (not (find-in-tree 'throw body)) + (not (find-in-tree name body))) + (try form1)) + + ;; Try removing the block if its only use is an immediately + ;; enclosed return-from: (block (return-from )) + (when (and (consp form1) + (eq (first form1) 'throw) + (equal (second form1) name) + (not (find-in-tree name (third form1)))) + (try (third form1))) + + ;; Otherwise, try to simplify the subexpression + (prune form1 + #'(lambda (x) + (try `(catch ,tag ,x)))))))) + + ((throw) + (try (second args)) + (prune (second args) + #'(lambda (x) (try `(throw ,(first args) ,x))))) + + ((flet labels) + (try 0) + (prune-flet form try-fn)) + + ((case) + (prune-case form try-fn)) + + ((isqrt) + (let ((arg (second form))) + (assert (null (cddr form))) + (assert (consp arg)) + (assert (eq (first arg) 'abs)) + (let ((arg2 (second arg))) + (try arg2) + ;; Try to fold + (when (integerp arg2) + (try (isqrt (abs arg2)))) + ;; Otherwise, simplify arg2 + (prune arg2 #'(lambda (form) + (try `(isqrt (abs ,form)))))))) + + ((ash) + (try 0) + (let ((form1 (second form)) + (form2 (third form))) + (try form1) + (try form2) + (prune form1 + #'(lambda (form) + (try `(ash ,form ,form2)))) + (when (and (consp form2) + (= (length form2) 3)) + (when (and (integerp form1) + (eq (first form2) 'min) + (every #'integerp (cdr form2))) + (try (eval form))) + (let ((form3 (third form2))) + (prune form3 + #'(lambda (form) + (try + `(ash ,form1 (,(first form2) ,(second form2) + ,form))))))))) + + ((floor ceiling truncate round mod rem) + (try 0) + (let ((form1 (second form)) + (form2 (third form))) + (try form1) + (when (cddr form) (try form2)) + (prune form1 + (if (cddr form) + #'(lambda (form) + (try `(,op ,form ,form2))) + #'(lambda (form) (try `(,op ,form))))) + (when (and (consp form2) + (= (length form2) 3)) + (when (and (integerp form1) + (member (first form2) '(max min)) + (every #'integerp (cdr form2))) + (try (eval form))) + (let ((form3 (third form2))) + (prune form3 + #'(lambda (form) + (try + `(,op ,form1 (,(first form2) ,(second form2) + ,form))))))))) + + ((constantly) + (unless (eql (car args) 0) + (prune (car args) + #'(lambda (arg) (try `(constantly ,arg)))))) + + ((funcall) + (try 0) + (let ((fn (second form)) + (fn-args (cddr form))) + (mapc try-fn fn-args) + (unless (equal fn '(constantly 0)) + (try `(funcall (constantly 0) ,@fn-args))) + (when (and (consp fn) + (eql (car fn) 'function) + (symbolp (cadr fn))) + (try `(,(cadr fn) ,@fn-args))) + (prune-list fn-args + #'prune + #'(lambda (args) + (try `(funcall ,fn ,@args)))))) + + ((reduce) + (try 0) + (let ((arg1 (car args)) + (arg2 (cadr args)) + (rest (cddr args))) + (when (and ;; (null (cddr args)) + (consp arg1) + (eql (car arg1) 'function)) + (let ((arg1.2 (cadr arg1))) + (when (and (consp arg1.2) + (eql (car arg1.2) 'lambda)) + (let ((largs (cadr arg1.2)) + (body (cddr arg1.2))) + (when (null (cdr body)) + (prune (car body) + #'(lambda (bform) + (try `(reduce (function (lambda ,largs ,bform)) + ,arg2 ,@rest))))))))) + (when (consp arg2) + (case (car arg2) + ((list vector) + (let ((arg2.rest (cdr arg2))) + (mapc try-fn arg2.rest) + (prune-list arg2.rest + #'prune + #'(lambda (args) + (try `(reduce ,arg1 + (,(car arg2) ,@args) + ,@rest)))))))))) + + ((apply) + (try 0) + (let ((fn (second form)) + (fn-args (butlast (cddr form))) + (list-arg (car (last form)))) + (mapc try-fn fn-args) + (unless (equal fn '(constantly 0)) + (try `(apply (constantly 0) ,@(cddr form)))) + (when (and (consp list-arg) + (eq (car list-arg) 'list)) + (mapc try-fn (cdr list-arg))) + (prune-list fn-args + #'prune + #'(lambda (args) + (try `(apply ,fn ,@args ,list-arg)))) + (when (and (consp list-arg) + (eq (car list-arg) 'list)) + (try `(apply ,fn ,@fn-args ,@(cdr list-arg) nil)) + (prune-list (cdr list-arg) + #'prune + #'(lambda (args) + (try `(apply ,fn ,@fn-args + (list ,@args)))))))) + + ((progv) + (try 0) + (prune-progv form try-fn)) + + ((tagbody) + (try 0) + (prune-tagbody form try-fn)) + + ((progn) + (when (null args) (try nil)) + (try (car (last args))) + (loop for i from 0 below (1- (length args)) + for a in args + do (try `(progn ,@(subseq args 0 i) + ,@(subseq args (1+ i)))) + do (when (and (consp a) + (or + (eq (car a) 'progn) + (and (eq (car a) 'tagbody) + (every #'consp (cdr a))))) + (try `(progn ,@(subseq args 0 i) + ,@(copy-list (cdr a)) + ,@(subseq args (1+ i)))))) + (prune-fn form try-fn)) + + ((loop) + (try 0) + (when (and (eql (length args) 6) + (eql (elt args 0) 'for) + (eql (elt args 2) 'below)) + (let ((var (elt args 1)) + (count (elt args 3)) + (form (elt args 5))) + (unless (eql count 0) (try count)) + (case (elt args 4) + (sum + (try `(let ((,(elt args 1) 0)) ,(elt args 5))) + (prune form #'(lambda (form) + (try `(loop for ,var below ,count sum ,form))))) + (count + (unless (or (eql form t) (eql form nil)) + (try `(loop for ,var below ,count count t)) + (try `(loop for ,var below ,count count nil)) + (prune form + #'(lambda (form) + (try `(loop for ,var below ,count count ,form)))))) + )))) + + (otherwise + (try 0) + (prune-fn form try-fn)) + + ))))) + (setf (gethash form *prune-table*) t) + nil) + +(defun find-in-tree (value tree) + "Return true if VALUE is eql to a node in TREE." + (or (eql value tree) + (and (consp tree) + (or (find-in-tree value (car tree)) + (find-in-tree value (cdr tree)))))) + +(defun prune-list (list element-prune-fn list-try-fn) + (declare (type function element-prune-fn list-try-fn)) + "Utility function for pruning in a list." + (loop for i from 0 + for e in list + do (funcall element-prune-fn + e + #'(lambda (form) + (funcall list-try-fn + (append (subseq list 0 i) + (list form) + (subseq list (1+ i)))))))) + +(defun prune-case (form try-fn) + (declare (type function try-fn)) + (flet ((try (e) (funcall try-fn e))) + (let* ((op (first form)) + (expr (second form)) + (cases (cddr form))) + + ;; Try just the top expression + (try expr) + + ;; Try simplifying the expr + (prune expr + #'(lambda (form) + (try `(,op ,form ,@cases)))) + + ;; Try individual cases + (loop for case in cases + do (try (first (last (rest case))))) + + ;; Try deleting individual cases + (loop for i from 0 below (1- (length cases)) + do (try `(,op ,expr + ,@(subseq cases 0 i) + ,@(subseq cases (1+ i))))) + + ;; Try simplifying the cases + ;; Assume each case has a single form + (prune-list cases + #'(lambda (case try-fn) + (declare (type function try-fn)) + (when (eql (length case) 2) + (prune (cadr case) + #'(lambda (form) + (funcall try-fn + (list (car case) form)))))) + #'(lambda (cases) + (try `(,op ,expr ,@cases))))))) + +(defun prune-tagbody (form try-fn) + (declare (type function try-fn)) + (let (;; (op (car form)) + (body (cdr form))) + (loop for i from 0 + for e in body + do + (cond + ((atom e) + ;; A tag + (unless (find-in-tree e (subseq body 0 i)) + (funcall try-fn `(tagbody ,@(subseq body 0 i) + ,@(subseq body (1+ i)))))) + (t + (funcall try-fn + `(tagbody ,@(subseq body 0 i) + ,@(subseq body (1+ i)))) + (prune e + #'(lambda (form) + ;; Don't put an atom here. + (when (consp form) + (funcall + try-fn + `(tagbody ,@(subseq body 0 i) + ,form + ,@(subseq body (1+ i)))))))))))) + +(defun prune-progv (form try-fn) + (declare (type function try-fn)) + (let (;; (op (car form)) + (vars-form (cadr form)) + (vals-form (caddr form)) + (body-list (cdddr form))) + (when (and (null vars-form) (null vals-form)) + (funcall try-fn `(let () ,@body-list))) + (when (and (consp vals-form) (eql (car vals-form) 'list)) + (when (and (consp vars-form) (eql (car vars-form) 'quote)) + (let ((vars (cadr vars-form)) + (vals (cdr vals-form))) + (when (eql (length vars) (length vals)) + (let ((let-form `(let () ,@body-list))) + (mapc #'(lambda (var val) + (setq let-form `(let ((,var ,val)) ,let-form))) + vars vals) + (funcall try-fn let-form))) + ;; Try simplifying the vals forms + (prune-list vals + #'prune + #'(lambda (vals) + (funcall try-fn + `(progv ,vars-form (list ,@vals) ,@body-list))))))) + ;; Try simplifying the body + (when (eql (length body-list) 1) + (prune (car body-list) + #'(lambda (form) + (funcall try-fn + `(progv ,vars-form ,vals-form ,form))))))) + +(defun prune-nary-fn (form try-fn) + ;; Attempt to reduce the number of arguments to the fn + ;; Do not reduce below 1 + (declare (type function try-fn)) + (let* ((op (car form)) + (args (cdr form)) + (nargs (length args))) + (when (> nargs 1) + (loop for i from 1 to nargs + do (funcall try-fn `(,op ,@(subseq args 0 (1- i)) + ,@(subseq args i))))))) + +(defun prune-fn (form try-fn) + "Attempt to simplify a function call form. It is considered + acceptable to replace the call by one of its argument forms." + (declare (type function try-fn)) + (prune-list (cdr form) + #'prune + #'(lambda (args) + (funcall try-fn (cons (car form) args))))) + +(defun prune-let (form try-fn) + "Attempt to simplify a LET form." + (declare (type function try-fn)) + (let* ((op (car form)) + (binding-list (cadr form)) + (body (cddr form)) + ;; (body-len (length body)) + ;; (len (length binding-list)) + ) + + ;; Try to simplify (let (( )) ...) to + #| + (when (and (>= len 1) + ;; (eql body-len 1) + ;; (eql (caar binding-list) (car body)) + ) + (let ((val-form (cadar binding-list))) + (unless (and (consp val-form) + (eql (car val-form) 'make-array)) + (funcall try-fn val-form)))) + |# + + ;; Try to simplify the forms in the RHS of the bindings + (prune-list binding-list + #'(lambda (binding try-fn) + (declare (type function try-fn)) + (prune (cadr binding) + #'(lambda (form) + (funcall try-fn + (list (car binding) + form))))) + #'(lambda (bindings) + (funcall try-fn `(,op ,bindings ,@body)))) + + ;; Try to simplify the body of the LET form + (when body + (unless binding-list + (funcall try-fn (car (last body)))) + (when (and (first binding-list) + (not (rest binding-list)) + (not (rest body))) + (let ((binding (first binding-list))) + (unless (or (consp (second binding)) + (has-binding-to-var (first binding) body) + (has-assignment-to-var (first binding) body) + ) + (funcall try-fn `(let () + ,@(subst (second binding) + (first binding) + (remove-if #'(lambda (x) (and (consp x) (eq (car x) 'declare))) + body) + )))))) + (prune (car (last body)) + #'(lambda (form2) + (funcall try-fn + `(,@(butlast form) ,form2))))))) + +(defun has-assignment-to-var (var form) + (find-if-subtree + #'(lambda (form) + (and (consp form) + (or + (and (member (car form) '(setq setf shiftf) :test #'eq) + (eq (cadr form) var)) + (and (eql (car form) 'multiple-value-setq) + (member var (cadr form)))))) + form)) + +(defun has-binding-to-var (var form) + (find-if-subtree + #'(lambda (form) + (and (consp form) + (case (car form) + ((let let*) + (loop for binding in (cadr form) + thereis (eq (car binding) var))) + ((progv) + (and (consp (cadr form)) + (eq (caadr form) 'quote) + (consp (second (cadr form))) + (member var (second (cadr form))))) + (t nil)))) + form)) + +(defun find-if-subtree (pred tree) + (declare (type function pred)) + (cond + ((funcall pred tree) tree) + ((consp tree) + (or (find-if-subtree pred (car tree)) + (find-if-subtree pred (cdr tree)))) + (t nil))) + +(defun prune-flet (form try-fn) + "Attempt to simplify a FLET form." + (declare (type function try-fn)) + + (let* ((op (car form)) + (binding-list (cadr form)) + (body (cddr form))) + + ;; Remove a declaration, if any + (when (and (consp body) + (consp (car body)) + (eq (caar body) 'declare)) + (funcall try-fn `(,op ,binding-list ,@(cdr body)))) + + ;; Try to prune optional arguments + (prune-list binding-list + #'(lambda (binding try-fn) + (declare (type function try-fn)) + (let* ((name (car binding)) + (args (cadr binding)) + (body (cddr binding)) + (opt-pos (position-if #'(lambda (e) (member e '(&key &optional))) + (the list args)))) + (when opt-pos + (incf opt-pos) + (let ((normal-args (subseq args 0 (1- opt-pos))) + (optionals (subseq args opt-pos))) + (prune-list optionals + #'(lambda (opt-lambda-arg try-fn) + (declare (type function try-fn)) + (when (consp opt-lambda-arg) + (let ((name (first opt-lambda-arg)) + (form (second opt-lambda-arg))) + (prune form + #'(lambda (form) + (funcall try-fn (list name form))))))) + #'(lambda (opt-args) + (funcall try-fn + `(,name (,@normal-args + &optional + ,@opt-args) + ,@body)))))))) + #'(lambda (bindings) + (funcall try-fn `(,op ,bindings ,@body)))) + + + ;; Try to simplify the forms in the RHS of the bindings + (prune-list binding-list + #'(lambda (binding try-fn) + (declare (type function try-fn)) + + ;; Prune body of a binding + (prune (third binding) + #'(lambda (form) + (funcall try-fn + (list (first binding) + (second binding) + form))))) + #'(lambda (bindings) + (funcall try-fn `(,op ,bindings ,@body)))) + + ;; ;; Try to simplify the body of the FLET form + (when body + + ;; No bindings -- try to simplify to the last form in the body + (unless binding-list + (funcall try-fn (first (last body)))) + + (when (and (consp binding-list) + (null (rest binding-list))) + (let ((binding (first binding-list))) + ;; One binding -- match on (flet (( () )) ()) + (when (and (symbolp (first binding)) + (not (find-in-tree (first binding) (rest binding))) + (null (second binding)) + (equal body (list (list (first binding))))) + (funcall try-fn `(,op () ,@(cddr binding)))) + ;; One binding -- try to remove it if not used + (when (and (symbolp (first binding)) + (not (find-in-tree (first binding) body))) + (funcall try-fn (first (last body)))) + )) + + + ;; Try to simplify (the last form in) the body. + (prune (first (last body)) + #'(lambda (form2) + (funcall try-fn + `(,@(butlast form) ,form2))))))) + +;;; Routine to walk form, applying a function at each form +;;; The fn is applied in preorder. When it returns :stop, do +;;; not descend into subforms + +#| +(defun walk (form fn) + (declare (type function fn)) + (unless (eq (funcall fn form) :stop) + (when (consp form) + (let ((op (car form))) + (case op + ((let let*) + (walk-let form fn)) + ((cond) + (dolist (clause (cdr form)) + (walk-implicit-progn clause fn))) + ((multiple-value-bind) + (walk (third form) fn) + (walk-body (cdddr form) fn)) + ((function quote declare) nil) + ((block the return-from) + (walk-implicit-progn (cddr form) fn)) + ((case typecase) + (walk (cadr form) fn) + (dolist (clause (cddr form)) + (walk-implicit-progn (cdr clause) fn))) + ((flet labels) + + + + +|# + +;;;;;;;;;;;;;;;;;;;;;; +;;; Convert pruned results to test cases + +(defun produce-test-cases (instances &key + (stream *standard-output*) + (prefix "MISC.") + (index 1)) + (dolist (inst instances) + (let* (;; (vars (getf inst :vars)) + (vals (getf inst :vals)) + (optimized-lambda-form (getf inst :optimized-lambda-form)) + (unoptimized-lambda-form (getf inst :unoptimized-lambda-form)) + (name (intern + (concatenate 'string prefix (format nil "~D" index)) + "CL-TEST")) + (test-form + `(deftest ,name + (let* ((fn1 ',optimized-lambda-form) + (fn2 ',unoptimized-lambda-form) + (vals ',vals) + (v1 (apply (compile nil fn1) vals)) + (v2 (apply (compile nil fn2) vals))) + (if (eql v1 v2) + :good + (list v1 v2))) + :good))) + (print test-form stream) + (terpri stream) + (incf index))) + (values)) diff --git a/ansi-tests/random-intern.lsp b/ansi-tests/random-intern.lsp new file mode 100644 index 0000000..80bda18 --- /dev/null +++ b/ansi-tests/random-intern.lsp @@ -0,0 +1,72 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Contains: Code to randomly intern and unintern random strings +;;;; in a package. Exercises package and hash table routines + +(in-package :cl-test) + +(defconstant +max-len-random-symbol+ 63) + +(defun make-random-symbol (package) + (declare (optimize (speed 3) (safety 3))) + (loop + (let* ((len (random (1+ +max-len-random-symbol+))) + (str (make-string len))) + (declare (type (integer 0 #.+max-len-random-symbol+) len)) + (loop + for i from 0 to (1- len) do + (setf (schar str i) + (schar +base-chars+ + (random +num-base-chars+)))) + (multiple-value-bind + (symbol status) + (intern (copy-seq str) package) + (unless (equal str (symbol-name symbol)) + (error "Intern gave bad symbol: ~A, ~A~%" str symbol)) + (unless status (return symbol)))))) + +(defun queue-insert (q x) + (declare (type cons q)) + (push x (cdr q))) + +(defun queue-remove (q) + (declare (type cons q)) + (when (null (car q)) + (when (null (cdr q)) + (error "Attempty to remove from empty queue.~%")) + (setf (car q) (nreverse (cdr q))) + (setf (cdr q) nil)) + (pop (car q))) + +(defun queue-empty (q) + (and (null (car q)) + (null (cdr q)))) + +(defun random-intern (n) + (declare (fixnum n)) + (let ((q (list nil)) + (xp (defpackage "X" (:use)))) + (declare (type cons q)) + (loop + for i from 1 to n do + (if (and + (= (random 2) 0) + (not (queue-empty q))) + (unintern (queue-remove q) xp) + (queue-insert q (make-random-symbol xp)))))) + +(defun fill-intern (n) + (declare (fixnum n)) + (let ((xp (defpackage "X" (:use)))) + (loop + for i from 1 to n do + (make-random-symbol xp)))) + + + + + + + + + diff --git a/ansi-tests/read-byte.lsp b/ansi-tests/read-byte.lsp new file mode 100644 index 0000000..5b17972 --- /dev/null +++ b/ansi-tests/read-byte.lsp @@ -0,0 +1,194 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 17 17:30:49 2004 +;;;; Contains: Tests of READ-BYTE, WRITE-BYTE + +(in-package :cl-test) + +(deftest read-byte.1 + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)))) + (values + (write-byte 17 s) + (close s) + (progn + (setq s (open "foo.txt" + :direction :input + :element-type '(unsigned-byte 8))) + (read-byte s)) + (close s))) + 17 t 17 t) + +(deftest read-byte.2 + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)))) + (values + (close s) + (progn + (setq s (open "foo.txt" + :direction :input + :element-type '(unsigned-byte 8))) + (read-byte s nil 'foo)) + (read-byte s nil) + (close s))) + t foo nil t) + +(deftest read-byte.3 + (loop with b1 = 0 + and b2 = 0 + for i from 1 to 32 + do (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type `(unsigned-byte ,i)))) + (write-byte (1- (ash 1 i)) s) + (write-byte 1 s) + (close s)) + unless (let ((s (open "foo.txt" + :direction :input + :element-type `(unsigned-byte ,i)))) + (prog1 + (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) + (eql (setq b2 (read-byte s)) 1)) + (close s))) + collect (list i b1 b2)) + nil) + +(deftest read-byte.4 + (loop with b1 = 0 + and b2 = 0 + for i from 33 to 200 by 7 + do (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type `(unsigned-byte ,i)))) + (write-byte (1- (ash 1 i)) s) + (write-byte 1 s) + (close s)) + unless (let ((s (open "foo.txt" + :direction :input + :element-type `(unsigned-byte ,i)))) + (prog1 + (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) + (eql (setq b2 (read-byte s)) 1)) + (close s))) + collect (list i b1 b2)) + nil) + +;;; Error tests + +(deftest read-byte.error.1 + (signals-error (read-byte) program-error) + t) + +(deftest read-byte.error.2 + (progn + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type `(unsigned-byte 8)))) + (close s)) + (signals-error + (let ((s (open "foo.txt" + :direction :input + :element-type '(unsigned-byte 8)))) + (read-byte s)) + end-of-file)) + t) + +(deftest read-byte.error.3 + (progn + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede))) + (close s)) + (signals-error + (let ((s (open "foo.txt" :direction :input))) + (unwind-protect + (read-byte s) + (close s))) + error)) + t) + +(deftest read-byte.error.4 + (signals-error-always + (progn + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)))) + (close s)) + (let ((s (open "foo.txt" + :direction :input + :element-type '(unsigned-byte 8)))) + (unwind-protect + (read-byte s t) + (close s)))) + end-of-file) + t t) + +(deftest read-byte.error.5 + (check-type-error #'read-byte #'streamp) + nil) + +(deftest read-byte.error.6 + (progn + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)))) + (close s)) + (signals-error + (let ((s (open "foo.txt" + :direction :input + :element-type '(unsigned-byte 8)))) + (unwind-protect + (read-byte s t t nil) + (close s))) + program-error)) + t) + + +(deftest write-byte.error.1 + (signals-error (write-byte) program-error) + t) + +(deftest write-byte.error.2 + (signals-error (write-byte 0) program-error) + t) + +(deftest write-byte.error.3 + (signals-error + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)))) + (unwind-protect + (write 1 s nil) + (close s))) + program-error) + t) + +(deftest write-byte.error.4 + (check-type-error #'(lambda (x) (write-byte 0 x)) #'streamp) + nil) + +(deftest write-byte.error.5 + (signals-error + (let ((s (open "foo.txt" + :direction :output + :if-exists :supersede))) + (unwind-protect + (write 1 s) + (close s))) + error) + t) + + + + + diff --git a/ansi-tests/read-char-no-hang.lsp b/ansi-tests/read-char-no-hang.lsp new file mode 100644 index 0000000..9a6e168 --- /dev/null +++ b/ansi-tests/read-char-no-hang.lsp @@ -0,0 +1,123 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 20:32:38 2004 +;;;; Contains: Tests of READ-CHAR-NO-HANG + +(in-package :cl-test) + +(deftest read-char-no-hang.1 + (with-input-from-string + (*standard-input* "a") + (read-char-no-hang)) + #\a) + +(deftest read-char-no-hang.2 + (with-input-from-string + (*standard-input* "abc") + (values + (read-char-no-hang) + (read-char-no-hang) + (read-char-no-hang))) + #\a #\b #\c) + +(when (code-char 0) + (deftest read-char-no-hang.3 + (with-input-from-string + (*standard-input* (concatenate 'string + "a" + (string (code-char 0)) + "b")) + (values + (read-char-no-hang) + (read-char-no-hang) + (read-char-no-hang))) + #\a #.(code-char 0) #\b)) + +(deftest read-char-no-hang.4 + (with-input-from-string + (s "abc") + (values + (read-char-no-hang s) + (read-char-no-hang s) + (read-char-no-hang s))) + #\a #\b #\c) + +(deftest read-char-no-hang.5 + (with-input-from-string + (s "") + (read-char-no-hang s nil)) + nil) + +(deftest read-char-no-hang.6 + (with-input-from-string + (s "") + (read-char-no-hang s nil 'foo)) + foo) + +(deftest read-char-no-hang.7 + (with-input-from-string + (s "abc") + (values + (read-char-no-hang s nil nil) + (read-char-no-hang s nil nil) + (read-char-no-hang s nil nil))) + #\a #\b #\c) + +(deftest read-char-no-hang.8 + (with-input-from-string + (s "abc") + (values + (read-char-no-hang s nil t) + (read-char-no-hang s nil t) + (read-char-no-hang s nil t))) + #\a #\b #\c) + +(deftest read-char-no-hang.9 + (with-input-from-string + (is "!?*") + (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) + (read-char-no-hang t))) + #\!) + +(deftest read-char-no-hang.10 + (with-input-from-string + (*standard-input* "345") + (read-char-no-hang nil)) + #\3) + +;;; Need a test of the non-hanging. +;;; This is hard to do portably. + +;;; Error tests + +(deftest read-char-no-hang.error.1 + (signals-error + (with-input-from-string + (s "abc") + (read-char-no-hang s nil nil nil nil)) + program-error) + t) + +(deftest read-char-no-hang.error.2 + (signals-error-always + (with-input-from-string + (s "") + (read-char-no-hang s)) + end-of-file) + t t) + +(deftest read-char-no-hang.error.3 + (signals-error-always + (with-input-from-string + (s "") + (read-char-no-hang s t)) + end-of-file) + t t) + +(deftest read-char-no-hang.error.4 + (signals-error-always + (with-input-from-string + (s "") + (read-char-no-hang s t t)) + end-of-file) + t t) diff --git a/ansi-tests/read-char.lsp b/ansi-tests/read-char.lsp new file mode 100644 index 0000000..0b63540 --- /dev/null +++ b/ansi-tests/read-char.lsp @@ -0,0 +1,121 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 08:53:56 2004 +;;;; Contains: Tests of READ-CHAR + +(in-package :cl-test) + +(deftest read-char.1 + (with-input-from-string + (*standard-input* "a") + (read-char)) + #\a) + +(deftest read-char.2 + (with-input-from-string + (*standard-input* "abc") + (values + (read-char) + (read-char) + (read-char))) + #\a #\b #\c) + +(when (code-char 0) + (deftest read-char.3 + (with-input-from-string + (*standard-input* (concatenate 'string + "a" + (string (code-char 0)) + "b")) + (values + (read-char) + (read-char) + (read-char))) + #\a #.(code-char 0) #\b)) + +(deftest read-char.4 + (with-input-from-string + (s "abc") + (values + (read-char s) + (read-char s) + (read-char s))) + #\a #\b #\c) + +(deftest read-char.5 + (with-input-from-string + (s "") + (read-char s nil)) + nil) + +(deftest read-char.6 + (with-input-from-string + (s "") + (read-char s nil 'foo)) + foo) + +(deftest read-char.7 + (with-input-from-string + (s "abc") + (values + (read-char s nil nil) + (read-char s nil nil) + (read-char s nil nil))) + #\a #\b #\c) + +(deftest read-char.8 + (with-input-from-string + (s "abc") + (values + (read-char s nil t) + (read-char s nil t) + (read-char s nil t))) + #\a #\b #\c) + +(deftest read-char.9 + (with-input-from-string + (is "!?*") + (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) + (read-char t))) + #\!) + +(deftest read-char.10 + (with-input-from-string + (*standard-input* "345") + (read-char nil)) + #\3) + + +;;; Error tests + +(deftest read-char.error.1 + (signals-error + (with-input-from-string + (s "abc") + (read-char s nil nil nil nil)) + program-error) + t) + +(deftest read-char.error.2 + (signals-error-always + (with-input-from-string + (s "") + (read-char s)) + end-of-file) + t t) + +(deftest read-char.error.3 + (signals-error-always + (with-input-from-string + (s "") + (read-char s t)) + end-of-file) + t t) + +(deftest read-char.error.4 + (signals-error-always + (with-input-from-string + (s "") + (read-char s t t)) + end-of-file) + t t) diff --git a/ansi-tests/read-line.lsp b/ansi-tests/read-line.lsp new file mode 100644 index 0000000..8f9c744 --- /dev/null +++ b/ansi-tests/read-line.lsp @@ -0,0 +1,104 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 20:53:59 2004 +;;;; Contains: Tests of READ-LINE + +(in-package :cl-test) + +(deftest read-line.1 + (with-input-from-string + (*standard-input* " abcd ") + (let ((vals (multiple-value-list (read-line)))) + (assert (= (length vals) 2)) + (values (first vals) (notnot (second vals))))) + " abcd " t) + +(deftest read-line.2 + (with-input-from-string + (*standard-input* (string #\Newline)) + (read-line)) + "" nil) + +(deftest read-line.3 + (with-input-from-string + (s (concatenate 'string "abc" (string #\Newline))) + (read-line s)) + "abc" nil) + +(deftest read-line.4 + (with-input-from-string + (s "") + (let ((vals (multiple-value-list (read-line s nil)))) + (assert (= (length vals) 2)) + (values (first vals) (notnot (second vals))))) + nil t) + +(deftest read-line.5 + (with-input-from-string + (s "") + (let ((vals (multiple-value-list (read-line s nil 'foo)))) + (assert (= (length vals) 2)) + (values (first vals) (notnot (second vals))))) + foo t) + +(deftest read-line.6 + (with-input-from-string + (s " abcd ") + (let ((vals (multiple-value-list (read-line s t nil t)))) + (assert (= (length vals) 2)) + (values (first vals) (notnot (second vals))))) + " abcd " t) + +(deftest read-line.7 + (with-input-from-string + (is "abc") + (let ((*terminal-io* (make-two-way-stream is *standard-output*))) + (let ((vals (multiple-value-list (read-line t)))) + (assert (= (length vals) 2)) + (assert (second vals)) + (first vals)))) + "abc") + +(deftest read-line.8 + (with-input-from-string + (*standard-input* "abc") + (let ((vals (multiple-value-list (read-line nil)))) + (assert (= (length vals) 2)) + (assert (second vals)) + (first vals))) + "abc") + +;;; Error tests + +(deftest read-line.error.1 + (signals-error + (with-input-from-string + (s (concatenate 'string "abc" (string #\Newline))) + (read-line s t nil nil nil)) + program-error) + t) + +(deftest read-line.error.2 + (signals-error-always + (with-input-from-string + (s "") + (read-line s)) + end-of-file) + t t) + +(deftest read-line.error.3 + (signals-error-always + (with-input-from-string + (*standard-input* "") + (read-line)) + end-of-file) + t t) + +(deftest read-line.error.4 + (signals-error-always + (with-input-from-string + (s "") + (read-line s t)) + end-of-file) + t t) + diff --git a/ansi-tests/read-sequence.lsp b/ansi-tests/read-sequence.lsp new file mode 100644 index 0000000..0250aac --- /dev/null +++ b/ansi-tests/read-sequence.lsp @@ -0,0 +1,300 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 19 06:55:04 2004 +;;;; Contains: Tests of READ-SEQUENCE + +(in-package :cl-test) + +;;; Read into a string + +(defmacro def-read-sequence-test (name init args input &rest expected) + `(deftest ,name + (let ((s ,init)) + (with-input-from-string + (is ,input) + (values + (read-sequence s is ,@args) + s))) + ,@expected)) + +(def-read-sequence-test read-sequence.string.1 (copy-seq " ") + () "abcdefghijk" 5 "abcde") + +(def-read-sequence-test read-sequence.string.2 (copy-seq " ") + () "abc" 3 "abc ") + +(def-read-sequence-test read-sequence.string.3 (copy-seq " ") + (:start 1) "abcdefghijk" 5 " abcd") + +(def-read-sequence-test read-sequence.string.4 (copy-seq " ") + (:end 3) "abcdefghijk" 3 "abc ") + +(def-read-sequence-test read-sequence.string.5 (copy-seq " ") + (:start 1 :end 4) "abcdefghijk" 4 " abc ") + +(def-read-sequence-test read-sequence.string.6 (copy-seq " ") + (:start 0 :end 0) "abcdefghijk" 0 " ") + +(def-read-sequence-test read-sequence.string.7 (copy-seq " ") + (:end nil) "abcdefghijk" 5 "abcde") + +(def-read-sequence-test read-sequence.string.8 (copy-seq " ") + (:allow-other-keys nil) "abcdefghijk" 5 "abcde") + +(def-read-sequence-test read-sequence.string.9 (copy-seq " ") + (:allow-other-keys t :foo 'bar) "abcdefghijk" 5 "abcde") + +(def-read-sequence-test read-sequence.string.10 (copy-seq " ") + (:foo 'bar :allow-other-keys 'x) "abcdefghijk" 5 "abcde") + +(def-read-sequence-test read-sequence.string.11 (copy-seq " ") + (:foo 'bar :allow-other-keys 'x :allow-other-keys nil) + "abcdefghijk" 5 "abcde") + +(def-read-sequence-test read-sequence.string.12 (copy-seq " ") + (:end 5 :end 3 :start 0 :start 1) "abcdefghijk" 5 "abcde") + +;;; Read into a base string + +(def-read-sequence-test read-sequence.base-string.1 + (make-array 5 :element-type 'base-char) + () "abcdefghijk" 5 "abcde") + +(def-read-sequence-test read-sequence.base-string.2 + (make-array 5 :element-type 'base-char :initial-element #\Space) + () "abc" 3 "abc ") + +(def-read-sequence-test read-sequence.base-string.3 + (make-array 5 :element-type 'base-char :initial-element #\Space) + (:start 1) "abcdefghijk" 5 " abcd") + +(def-read-sequence-test read-sequence.base-string.4 + (make-array 5 :element-type 'base-char :initial-element #\Space) + (:end 3) "abcdefghijk" 3 "abc ") + +(def-read-sequence-test read-sequence.base-string.5 + (make-array 5 :element-type 'base-char :initial-element #\Space) + (:start 1 :end 4) "abcdefghijk" 4 " abc ") + +(def-read-sequence-test read-sequence.base-string.6 + (make-array 5 :element-type 'base-char :initial-element #\Space) + (:start 0 :end 0) "abcdefghijk" 0 " ") + +(def-read-sequence-test read-sequence.base-string.7 + (make-array 5 :element-type 'base-char :initial-element #\Space) + (:end nil) "abcdefghijk" 5 "abcde") + +;;; Read into a list + +(def-read-sequence-test read-sequence.list.1 (make-list 5) + () "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) + +(def-read-sequence-test read-sequence.list.2 (make-list 5) + () "abc" 3 (#\a #\b #\c nil nil)) + +(def-read-sequence-test read-sequence.list.3 (make-list 5) + (:start 1) "abcdefghijk" 5 (nil #\a #\b #\c #\d)) + +(def-read-sequence-test read-sequence.list.4 (make-list 5) + (:end 3) "abcdefghijk" 3 (#\a #\b #\c nil nil)) + +(def-read-sequence-test read-sequence.list.5 (make-list 5) + (:end 4 :start 1) "abcdefghijk" 4 (nil #\a #\b #\c nil)) + +(def-read-sequence-test read-sequence.list.6 (make-list 5) + (:start 0 :end 0) "abcdefghijk" 0 (nil nil nil nil nil)) + +(def-read-sequence-test read-sequence.list.7 (make-list 5) + (:end nil) "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) + +;;; Read into a vector + +(def-read-sequence-test read-sequence.vector.1 + (vector nil nil nil nil nil) + () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) + +(def-read-sequence-test read-sequence.vector.2 + (vector nil nil nil nil nil) + () "abc" 3 #(#\a #\b #\c nil nil)) + +(def-read-sequence-test read-sequence.vector.3 + (vector nil nil nil nil nil) + (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) + +(def-read-sequence-test read-sequence.vector.4 + (vector nil nil nil nil nil) + (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) + +(def-read-sequence-test read-sequence.vector.5 + (vector nil nil nil nil nil) + (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) + +(def-read-sequence-test read-sequence.vector.6 + (vector nil nil nil nil nil) + (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) + +(def-read-sequence-test read-sequence.vector.7 + (vector nil nil nil nil nil) + (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) + +;;; Read into a vector with a fill pointer + +(def-read-sequence-test read-sequence.fill-vector.1 + (make-array 10 :initial-element nil :fill-pointer 5) + () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) + +(def-read-sequence-test read-sequence.fill-vector.2 + (make-array 10 :initial-element nil :fill-pointer 5) + () "ab" 2 #(#\a #\b nil nil nil)) + +(def-read-sequence-test read-sequence.fill-vector.3 + (make-array 10 :initial-element nil :fill-pointer 5) + () "" 0 #(nil nil nil nil nil)) + +(def-read-sequence-test read-sequence.fill-vector.4 + (make-array 10 :initial-element nil :fill-pointer 5) + (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) + +(def-read-sequence-test read-sequence.fill-vector.5 + (make-array 10 :initial-element nil :fill-pointer 5) + (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) + +(def-read-sequence-test read-sequence.fill-vector.6 + (make-array 10 :initial-element nil :fill-pointer 5) + (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) + +(def-read-sequence-test read-sequence.fill-vector.7 + (make-array 10 :initial-element nil :fill-pointer 5) + (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) + +(def-read-sequence-test read-sequence.fill-vector.8 + (make-array 10 :initial-element nil :fill-pointer 5) + (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) + +;;; Nil vectors + +(deftest read-sequence.nil-vector.1 + :notes (:nil-vectors-are-strings) + (let ((s (make-array 0 :element-type nil))) + (with-input-from-string + (is "abcde") + (values + (read-sequence s is) + s))) + 0 "") + +;;; Read into a bit vector + +(defmacro def-read-sequence-bv-test (name init args &rest expected) + `(deftest ,name + ;; Create output file + (progn + (let (os) + (unwind-protect + (progn + (setq os (open "temp.dat" :direction :output + :element-type '(unsigned-byte 8) + :if-exists :supersede)) + (loop for i in '(0 1 1 0 0 1 1 0 1 0 1 1 1 0) + do (write-byte i os))) + (when os (close os)))) + (let (is (bv (copy-seq ,init))) + (unwind-protect + (progn + (setq is (open "temp.dat" :direction :input + :element-type '(unsigned-byte 8))) + (values + (read-sequence bv is ,@args) + bv)) + (when is (close is))))) + ,@expected)) + +(def-read-sequence-bv-test read-sequence.bv.1 #*00000000000000 () + 14 #*01100110101110) + +(def-read-sequence-bv-test read-sequence.bv.2 #*00000000000000 (:start 0) + 14 #*01100110101110) + +(def-read-sequence-bv-test read-sequence.bv.3 #*00000000000000 (:end 14) + 14 #*01100110101110) + +(def-read-sequence-bv-test read-sequence.bv.4 #*00000000000000 (:end nil) + 14 #*01100110101110) + +(def-read-sequence-bv-test read-sequence.bv.5 #*00000000000000 (:start 2) + 14 #*00011001101011) + +(def-read-sequence-bv-test read-sequence.bv.6 #*00000000000000 + (:start 2 :end 13) + 13 #*00011001101010) + +(def-read-sequence-bv-test read-sequence.bv.7 #*00000000000000 (:end 6) + 6 #*01100100000000) + +;;; Error cases + +(deftest read-sequence.error.1 + (signals-error (read-sequence) program-error) + t) + +(deftest read-sequence.error.2 + (signals-error (read-sequence (make-string 10)) program-error) + t) + +(deftest read-sequence.error.3 + (signals-error + (read-sequence (make-string 5) (make-string-input-stream "abc") :start) + program-error) + t) + +(deftest read-sequence.error.4 + (signals-error + (read-sequence (make-string 5) (make-string-input-stream "abc") :foo 1) + program-error) + t) + +(deftest read-sequence.error.5 + (signals-error + (read-sequence (make-string 5) (make-string-input-stream "abc") + :allow-other-keys nil :bar 2) + program-error) + t) + +(deftest read-sequence.error.6 + (check-type-error #'(lambda (x) (read-sequence x (make-string-input-stream "abc"))) + #'sequencep) + nil) + +(deftest read-sequence.error.7 + (signals-error + (read-sequence (cons 'a 'b) (make-string-input-stream "abc")) + type-error) + t) + +;;; This test appears to cause Allegro CL to crash +(deftest read-sequence.error.8 + (signals-type-error x -1 + (read-sequence (make-string 3) + (make-string-input-stream "abc") + :start x)) + t) + +(deftest read-sequence.error.9 + (check-type-error #'(lambda (s) + (read-sequence (make-string 3) (make-string-input-stream "abc") + :start s)) + (typef 'unsigned-byte)) + nil) + +(deftest read-sequence.error.10 + (signals-type-error x -1 + (read-sequence (make-string 3) (make-string-input-stream "abc") + :end x)) + t) + +(deftest read-sequence.error.11 + (check-type-error #'(lambda (e) + (read-sequence (make-string 3) (make-string-input-stream "abc") + :end e)) + (typef '(or unsigned-byte null))) + nil) diff --git a/ansi-tests/reader-test.lsp b/ansi-tests/reader-test.lsp new file mode 100644 index 0000000..6ec37c2 --- /dev/null +++ b/ansi-tests/reader-test.lsp @@ -0,0 +1,155 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Apr 8 20:03:45 1998 +;;;; Contains: Tests on readtables (just started, very incomplete) + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +(deftest readtable-valid (not (readtablep *readtable*)) nil) +(deftest readtablep.1 + (and (not (readtablep nil)) + (not (readtablep 'a)) + (not (readtablep 0)) + (not (readtablep 1/2)) + (not (readtablep 1.2)) + (not (readtablep 1.2s2)) + (not (readtablep 1.2f3)) + (not (readtablep 1.2e2)) + (not (readtablep 1.2d2)) + (not (readtablep (list 'a))) + (not (readtablep "abcde")) + (not (readtablep t)) + (not (readtablep '*readtable*)) + (not (readtablep (make-array '(10)))) + (not (readtablep (make-array '(10) :element-type 'fixnum))) + (not (readtablep (make-array '(10) :element-type 'float))) + (not (readtablep (make-array '(10) :element-type 'double-float))) + (not (readtablep (make-array '(10) :element-type 'string))) + (not (readtablep (make-array '(10) :element-type 'character))) + (not (readtablep (make-array '(10) :element-type 'bit))) + (not (readtablep (make-array '(10) :element-type 'boolean))) + (not (not (readtablep (copy-readtable)))) + (not (readtablep #'car)) + ) + t) + +(deftest read-symbol.1 + (let ((*package* (find-package "CL-TEST"))) + (ignore-errors (read-from-string "a"))) + a 1) + +(deftest read-symbol.2 + (let ((*package* (find-package "CL-TEST"))) + (ignore-errors (read-from-string "|a|"))) + |a| 3) + +(deftest read-symbol.3 + (multiple-value-bind (s n) + (ignore-errors (read-from-string "#:abc")) + (not + (and (symbolp s) + (eql n 5) + (not (symbol-package s)) + (string-equal (symbol-name s) "abc")))) + nil) + +(deftest read-symbol.4 + (multiple-value-bind (s n) + (ignore-errors (read-from-string "#:|abc|")) + (not + (and (symbolp s) + (eql n 7) + (not (symbol-package s)) + (string= (symbol-name s) "abc")))) + nil) + +(deftest read-symbol.5 + (multiple-value-bind (s n) + (ignore-errors (read-from-string "#:||")) + (if (not (symbolp s)) + s + (not (not + (and (eql n 4) + (not (symbol-package s)) + (string= (symbol-name s) "")))))) + t) + +(deftest read-symbol.6 + (let ((str "cl-test::abcd0123")) + (multiple-value-bind (s n) + (ignore-errors (read-from-string str)) + (if (not (symbolp s)) + s + (not (not + (and (eql n (length str)) + (eqt (symbol-package s) (find-package :cl-test)) + (string-equal (symbol-name s) + "abcd0123"))))))) + t) + +(deftest read-symbol.7 + (multiple-value-bind (s n) + (ignore-errors (read-from-string ":ABCD")) + (if (not (symbolp s)) + s + (not (not + (and (eql n 5) + (eqt (symbol-package s) (find-package "KEYWORD")) + (string-equal (symbol-name s) + "ABCD")))))) + t) + +(defun read-symbol.9-body (natoms maxlen) + (let* ((chars (concatenate 'string + "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789" + "<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|")) + (nchars (length chars))) + (loop + for i from 1 to natoms + count + (let* ((len (random (1+ maxlen))) + (actual-len 0) + (s (make-string (+ 2 (* 2 len)))) + (s2 (make-string len))) + (loop for j from 0 to (1- len) do + (let ((c (elt chars (random (max 1 (1- nchars)))))) + (when (member c '(#\| #\\)) + (setf (elt s actual-len) #\\) + (incf actual-len)) + (setf (elt s actual-len) c) + (setf (elt s2 j) c) + (incf actual-len))) + (let ((actual-string (subseq s 0 actual-len))) + (multiple-value-bind (sym nread) + (ignore-errors (read-from-string + (concatenate 'string + "#:|" actual-string "|"))) + (unless (and (symbolp sym) + (eql nread (+ 4 actual-len)) + (string-equal s2 (symbol-name sym))) + (format t "Symbol read failed: ~S (~S) read as ~S~%" + actual-string s2 sym :readably t) + t))))))) + +(deftest read-symbol.9 + (read-symbol.9-body 1000 100) + 0) + +(deftest read-symbol.10 + (handler-case + (not (not + (equal (symbol-name + (read-from-string + (with-output-to-string (s) + (write (make-symbol ":") + :readably t + :stream s)))) + ":"))) + (error (c) c)) + t) + + diff --git a/ansi-tests/reduce.lsp b/ansi-tests/reduce.lsp new file mode 100644 index 0000000..cb74c38 --- /dev/null +++ b/ansi-tests/reduce.lsp @@ -0,0 +1,470 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Aug 18 14:08:57 2002 +;;;; Contains: Tests for function REDUCE + +(in-package :cl-test) + +(deftest reduce-list.1 + (reduce #'cons '(a b c d e f)) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-list.2 + (reduce #'cons '(a b c d e f) :from-end t) + (a b c d e . f)) + +(deftest reduce-list.3 + (reduce #'cons '(a b c d e f) :initial-value 'z) + ((((((z . a) . b) . c) . d) . e) . f)) + +(deftest reduce-list.4 + (reduce #'cons '(a b c d e f) :from-end t :initial-value 'g) + (a b c d e f . g)) + +(deftest reduce-list.5 + (reduce #'cons '(a b c d e f) :from-end nil) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-list.6 + (reduce #'cons '(a b c d e f) :from-end 17) + (a b c d e . f)) + +(deftest reduce-list.7 + (reduce #'cons '(a b c d e f) :end nil) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-list.8 + (reduce #'cons '(a b c d e f) :end 3) + ((a . b) . c)) + +(deftest reduce-list.9 + (reduce #'cons '(a b c d e f) :start 1 :end 4) + ((b . c) . d)) + +(deftest reduce-list.10 + (reduce #'cons '(a b c d e f) :start 1 :end 4 :from-end t) + (b c . d)) + +(deftest reduce-list.11 + (reduce #'cons '(a b c d e f) :start 1 :end 4 :from-end t + :initial-value nil) + (b c d)) + +(deftest reduce-list.12 + (reduce 'cons '(a b c d e f)) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-list.13 + (reduce #'+ nil) + 0) + +(deftest reduce-list.14 + (reduce #'+ '(1 2 3) :start 0 :end 0) + 0) + +(deftest reduce-list.15 + (reduce #'+ '(1 2 3) :key '1+) + 9) + +(deftest reduce-list.16 + (reduce #'cons '(1 2 3) :key '1+ :from-end t :initial-value nil) + (2 3 4)) + +(deftest reduce-list.17 + (reduce #'+ '(1 2 3 4 5 6 7) :key '1+ :start 2 :end 6) + 22) + +;;;;;;; + +(deftest reduce-array.1 + (reduce #'cons #(a b c d e f)) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-array.2 + (reduce #'cons #(a b c d e f) :from-end t) + (a b c d e . f)) + +(deftest reduce-array.3 + (reduce #'cons #(a b c d e f) :initial-value 'z) + ((((((z . a) . b) . c) . d) . e) . f)) + +(deftest reduce-array.4 + (reduce #'cons #(a b c d e f) :from-end t :initial-value 'g) + (a b c d e f . g)) + +(deftest reduce-array.5 + (reduce #'cons #(a b c d e f) :from-end nil) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-array.6 + (reduce #'cons #(a b c d e f) :from-end 17) + (a b c d e . f)) + +(deftest reduce-array.7 + (reduce #'cons #(a b c d e f) :end nil) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-array.8 + (reduce #'cons #(a b c d e f) :end 3) + ((a . b) . c)) + +(deftest reduce-array.9 + (reduce #'cons #(a b c d e f) :start 1 :end 4) + ((b . c) . d)) + +(deftest reduce-array.10 + (reduce #'cons #(a b c d e f) :start 1 :end 4 :from-end t) + (b c . d)) + +(deftest reduce-array.11 + (reduce #'cons #(a b c d e f) :start 1 :end 4 :from-end t + :initial-value nil) + (b c d)) + +(deftest reduce-array.12 + (reduce 'cons #(a b c d e f)) + (((((a . b) . c) . d) . e) . f)) + +(deftest reduce-array.13 + (reduce #'+ #(1 2 3) :start 0 :end 0) + 0) + +(deftest reduce-array.14 + (let ((a (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8) + :fill-pointer 4))) + (reduce #'+ a)) + 10) + +(deftest reduce-array.15 + (let ((a (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8) + :fill-pointer 4))) + (reduce #'+ a :end nil)) + 10) + +(deftest reduce-array.16 + (let ((a (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8) + :fill-pointer 4))) + (reduce #'+ a :from-end t)) + 10) + +(deftest reduce-array.17 + (let ((a (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8) + :fill-pointer 4))) + (reduce #'+ a :initial-value 1)) + 11) + +(deftest reduce-array.18 + (let ((a (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8) + :fill-pointer 4))) + (reduce #'+ a :initial-value 1 :start 2)) + 8) + +(deftest reduce-array.19 + (let ((a (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8) + :fill-pointer 4))) + (reduce #'+ a :end 3)) + 6) + + +;;;;;;;; + +(deftest reduce.error.1 + (classify-error (reduce 'cons 'a)) + type-error) + +(deftest reduce.error.2 + (classify-error (reduce)) + program-error) + +(deftest reduce.error.3 + (classify-error (reduce #'list nil :start)) + program-error) + +(deftest reduce.error.4 + (classify-error (reduce #'list nil 'bad t)) + program-error) + +(deftest reduce.error.5 + (classify-error (reduce #'list nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest reduce.error.6 + (classify-error (reduce #'list nil 1 2)) + program-error) + +(deftest reduce.error.7 + (classify-error (locally (reduce 'cons 'a) t)) + type-error) + +(deftest reduce.error.8 + (classify-error (reduce #'identity '(a b c))) + program-error) + +(deftest reduce.error.9 + (classify-error (reduce #'cons '(a b c) :key #'cons)) + program-error) + +(deftest reduce.error.10 + (classify-error (reduce #'cons '(a b c) :key #'car)) + type-error) + + +;;;;;;;; + +(deftest reduce-string.1 + (reduce #'cons "abcdef") + (((((#\a . #\b) . #\c) . #\d) . #\e) . #\f)) + +(deftest reduce-string.2 + (reduce #'cons "abcdef" :from-end t) + (#\a #\b #\c #\d #\e . #\f)) + +(deftest reduce-string.3 + (reduce #'cons "abcdef" :initial-value 'z) + ((((((z . #\a) . #\b) . #\c) . #\d) . #\e) . #\f)) + +(deftest reduce-string.4 + (reduce #'cons "abcdef" :from-end t :initial-value 'g) + (#\a #\b #\c #\d #\e #\f . g)) + +(deftest reduce-string.5 + (reduce #'cons "abcdef" :from-end nil) + (((((#\a . #\b) . #\c) . #\d) . #\e) . #\f)) + +(deftest reduce-string.6 + (reduce #'cons "abcdef" :from-end 17) + (#\a #\b #\c #\d #\e . #\f)) + +(deftest reduce-string.7 + (reduce #'cons "abcdef" :end nil) + (((((#\a . #\b) . #\c) . #\d) . #\e) . #\f)) + +(deftest reduce-string.8 + (reduce #'cons "abcdef" :end 3) + ((#\a . #\b) . #\c)) + +(deftest reduce-string.9 + (reduce #'cons "abcdef" :start 1 :end 4) + ((#\b . #\c) . #\d)) + +(deftest reduce-string.10 + (reduce #'cons "abcdef" :start 1 :end 4 :from-end t) + (#\b #\c . #\d)) + +(deftest reduce-string.11 + (reduce #'cons "abcdef" :start 1 :end 4 :from-end t + :initial-value nil) + (#\b #\c #\d)) + +(deftest reduce-string.12 + (reduce 'cons "abcdef") + (((((#\a . #\b) . #\c) . #\d) . #\e) . #\f)) + +(deftest reduce-string.13 + (reduce #'+ "abc" :start 0 :end 0) + 0) + +(deftest reduce-string.14 + (let ((s (make-array '(8) :initial-contents "abcdefgh" + :fill-pointer 6 + :element-type 'character))) + (coerce (reduce #'(lambda (x y) (cons y x)) s :initial-value nil) + 'string)) + "fedcba") + +(deftest reduce-string.15 + (let ((s (make-array '(8) :initial-contents "abcdefgh" + :fill-pointer 6 + :element-type 'character))) + (coerce (reduce #'(lambda (x y) (cons y x)) s :initial-value nil + :start 1) + 'string)) + "fedcb") + +(deftest reduce-string.16 + (let ((s (make-array '(8) :initial-contents "abcdefgh" + :fill-pointer 6 + :element-type 'character))) + (coerce (reduce #'(lambda (x y) (cons y x)) s :end nil + :initial-value nil) + 'string)) + "fedcba") + +(deftest reduce-string.17 + (let ((s (make-array '(8) :initial-contents "abcdefgh" + :fill-pointer 6 + :element-type 'character))) + (coerce (reduce #'(lambda (x y) (cons y x)) s :end 4 + :initial-value nil) + 'string)) + "dcba") + +;;;;;;;; + +(deftest reduce-bitstring.1 + (reduce #'cons #*001101) + (((((0 . 0) . 1) . 1) . 0) . 1)) + +(deftest reduce-bitstring.2 + (reduce #'cons #*001101 :from-end t) + (0 0 1 1 0 . 1)) + +(deftest reduce-bitstring.3 + (reduce #'cons #*001101 :initial-value 'z) + ((((((z . 0) . 0) . 1) . 1) . 0) . 1)) + +(deftest reduce-bitstring.4 + (reduce #'cons #*001101 :from-end t :initial-value 'g) + (0 0 1 1 0 1 . g)) + +(deftest reduce-bitstring.5 + (reduce #'cons #*001101 :from-end nil) + (((((0 . 0) . 1) . 1) . 0) . 1)) + +(deftest reduce-bitstring.6 + (reduce #'cons #*001101 :from-end 17) + (0 0 1 1 0 . 1)) + +(deftest reduce-bitstring.7 + (reduce #'cons #*001101 :end nil) + (((((0 . 0) . 1) . 1) . 0) . 1)) + +(deftest reduce-bitstring.8 + (reduce #'cons #*001101 :end 3) + ((0 . 0) . 1)) + +(deftest reduce-bitstring.9 + (reduce #'cons #*001101 :start 1 :end 4) + ((0 . 1) . 1)) + +(deftest reduce-bitstring.10 + (reduce #'cons #*001101 :start 1 :end 4 :from-end t) + (0 1 . 1)) + +(deftest reduce-bitstring.11 + (reduce #'cons #*001101 :start 1 :end 4 :from-end t + :initial-value nil) + (0 1 1)) + +(deftest reduce-bitstring.12 + (reduce 'cons #*001101) + (((((0 . 0) . 1) . 1) . 0) . 1)) + +(deftest reduce-bitstring.13 + (reduce #'+ #(1 1 1) :start 0 :end 0) + 0) + +(deftest reduce-bitstring.14 + (let ((s (make-array '(8) :initial-contents '(0 0 1 0 1 1 0 1) + :fill-pointer 6 + :element-type 'bit))) + (reduce #'+ s)) + 3) + +(deftest reduce-bitstring.15 + (let ((s (make-array '(8) :initial-contents '(0 0 1 0 1 1 0 1) + :fill-pointer 6 + :element-type 'bit))) + (reduce #'+ s :start 3)) + 2) + +(deftest reduce-bitstring.16 + (let ((s (make-array '(8) :initial-contents '(0 0 1 0 1 1 0 1) + :fill-pointer 6 + :element-type 'bit))) + (reduce #'+ s :start 3 :initial-value 10)) + 12) + +(deftest reduce-bitstring.17 + (let ((s (make-array '(8) :initial-contents '(0 0 1 0 1 1 0 1) + :fill-pointer 6 + :element-type 'bit))) + (reduce #'+ s :end nil)) + 3) + +(deftest reduce-bitstring.18 + (let ((s (make-array '(8) :initial-contents '(1 1 1 1 1 1 1 1) + :fill-pointer 6 + :element-type 'bit))) + (reduce #'+ s :start 2 :end 4)) + 2) + +;;; Order of evaluation tests + +(deftest reduce.order.1 + (let ((i 0) x y) + (values + (reduce (progn (setf x (incf i)) #'cons) + (progn (setf y (incf i)) '(a b c))) + i x y)) + ((a . b) . c) 2 1 2) + +(deftest reduce.order.2 + (let ((i 0) a b c d e f g) + (values + (reduce (progn (setf a (incf i)) #'cons) + (progn (setf b (incf i)) '(a b c d e f)) + :from-end (progn (setf c (incf i)) t) + :initial-value (progn (setf d (incf i)) 'nil) + :start (progn (setf e (incf i)) 1) + :end (progn (setf f (incf i)) 4) + :key (progn (setf g (incf i)) #'identity) + ) + i a b c d e f g)) + (b c d) 7 1 2 3 4 5 6 7) + +(deftest reduce.order.3 + (let ((i 0) a b c d e f g) + (values + (reduce (progn (setf a (incf i)) #'cons) + (progn (setf b (incf i)) '(a b c d e f)) + :key (progn (setf c (incf i)) #'identity) + :end (progn (setf d (incf i)) 4) + :start (progn (setf e (incf i)) 1) + :initial-value (progn (setf f (incf i)) 'nil) + :from-end (progn (setf g (incf i)) t) + ) + i a b c d e f g)) + (b c d) 7 1 2 3 4 5 6 7) + + +;;; Keyword tests + +(deftest reduce.allow-other-keys.1 + (reduce #'+ '(1 2 3) :allow-other-keys t) + 6) + +(deftest reduce.allow-other-keys.2 + (reduce #'+ '(1 2 3) :allow-other-keys nil) + 6) + +(deftest reduce.allow-other-keys.3 + (reduce #'+ '(1 2 3) :bad t :allow-other-keys t) + 6) + +(deftest reduce.allow-other-keys.4 + (reduce #'+ '(1 2 3) :allow-other-keys t :bad t) + 6) + +(deftest reduce.allow-other-keys.5 + (reduce #'+ '(1 2 3) :allow-other-keys t :allow-other-keys nil :bad t) + 6) + +(deftest reduce.allow-other-keys.6 + (reduce #'+ '(1 2 3) :allow-other-keys t :bad t :allow-other-keys nil) + 6) + +(deftest reduce.allow-other-keys.7 + (reduce #'+ '(1 2 3) :bad t :allow-other-keys t :allow-other-keys nil) + 6) + +(deftest reduce.allow-other-keys.8 + (reduce #'cons '(1 2 3) :allow-other-keys t :from-end t :bad t + :initial-value nil) + (1 2 3)) + +(deftest reduce.keywords.9 + (reduce #'cons '(1 2 3) :from-end t :from-end nil + :initial-value nil :initial-value 'a) + (1 2 3)) + diff --git a/ansi-tests/remove-aux.lsp b/ansi-tests/remove-aux.lsp new file mode 100644 index 0000000..4dda4d5 --- /dev/null +++ b/ansi-tests/remove-aux.lsp @@ -0,0 +1,273 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Sep 15 07:42:36 2002 +;;;; Contains: Auxiliary functions for testing REMOVE and related functions + +(in-package :cl-test) + +(defun make-random-element (type) + (cond + ((subtypep* 'fixnum type) + (random most-positive-fixnum)) + ((subtypep* '(integer 0 255) type) + (random 255)) + ((subtypep* '(integer 0 7) type) + (random 8)) + ((subtypep* 'bit type) + (random 2)) + ((subtypep* 'symbol type) + (elt '(a b c d e f g h) (random 8))) + ((subtypep* '(member #\a #\b #\c #\d #\e #\f #\g #\h) type) + (elt "abcdefgh" (random 8))) + (t (error "Can't get random element of type ~A~%." type)))) + +(defun make-random-remove-input (len type element-type) + + "Randomly generate a test case for REMOVE. Given a length + a sequence type, and an element type, produce a random + sequence of length LEN of sequence type TYPE, and either + generate a random member of the sequence or a random + element of the element type to delete from the sequence." + + (let* ((seq (if (subtypep* type 'list) + (loop for i from 1 to len collect + (make-random-element element-type)) + (let ((seq (if (and (subtypep type 'vector) + (coin 3)) + (make-array + (list (+ len (random (1+ len)))) + :initial-element (make-random-element element-type) + :fill-pointer len + :element-type element-type) + (make-sequence type len)))) + (dotimes (i len) + (setf (elt seq i) (make-random-element element-type))) + seq))) + (e (if (and (> len 0) (coin)) + (elt seq (random len)) + (make-random-element element-type))) + ) + (values len seq e))) + +(defun my-remove (element + sequence + &key + (start 0) + (end nil) + (test #'eql test-p) + (test-not nil test-not-p) + (key nil) + (from-end nil) + (count nil)) + (assert (not (and test-p test-not-p))) + (my-remove-if + (cond (test-p #'(lambda (x) (funcall test element x))) + (test-not-p #'(lambda (x) (not (funcall test-not element x)))) + (t #'(lambda (x) (eql element x)))) + sequence :start start :end end :key key :from-end from-end :count count)) + +(defun my-remove-if (predicate + original-sequence + &key (from-end nil) + (start 0) + (end nil) + (count nil) + (key #'identity)) + (let ((len (length original-sequence)) + (sequence (copy-seq original-sequence))) + (unless end (setq end len)) + (unless key (setq key #'identity)) + (unless count (setq count len)) + + ;; Check that everything's kosher + (assert (<= 0 start end len)) + (assert (typep sequence 'sequence)) + (assert (integerp count)) + (assert (or (symbolp predicate) (functionp predicate))) + (assert (or (symbolp key) (functionp key))) + + ;; If FROM-END, reverse the sequence and flip + ;; start, end + (when from-end + (psetq sequence (nreverse sequence) + start (- len end) + end (- len start))) + + ;; Accumulate a list of elements for the result + (let ((pos 0) + (result nil)) ;; accumulate in reverse order + (map nil + #'(lambda (e) + (if (and (> count 0) + (>= pos start) + (< pos end) + (funcall predicate (funcall key e))) + (decf count) + (push e result)) + (incf pos)) + sequence) + (unless from-end + (setq result (nreverse result))) + ;; Convert to the correct type + (if (listp sequence) + result + (let ((element-type (array-element-type original-sequence))) + (make-array (length result) :element-type element-type + :initial-contents result)))))) + +(defun my-remove-if-not (pred &rest args) + (when (symbolp pred) + (setq pred (coerce pred 'function))) + (assert (typep pred 'function)) + (apply #'my-remove-if (complement pred) args)) + +(defun make-random-rd-params (maxlen) + "Generate random paramaters for remove/delete/etc. functions." + (let* ((element-type t) + (type-select (random 7)) + (type + (case type-select + (0 'list) + (1 'vector) + (2 (setq element-type 'character) 'string) + (3 (setq element-type 'bit) 'bit-vector) + (4 'simple-vector) + (5 (setq element-type '(integer 0 255)) + '(vector (integer 0 255))) + (6 (setq element-type 'fixnum) '(vector fixnum)) + (t (error "Can't happen?!~%")))) + (len (random maxlen)) + (start (and (coin) (> len 0) + (random len))) + (end (and (coin) + (if start (+ start (random (- len start))) + (random (1+ len))))) + (from-end (coin)) + (count (case (random 5) + ((0 1) nil) + ((2 3) (random (1+ len))) + (t (if (coin) -1 -10000000000000)))) + (seq (multiple-value-bind (x y z) (make-random-remove-input len type element-type) + (declare (ignore x z)) + y)) + (key (and (coin) + (case type-select + (2 (random-case + #'char-upcase 'char-upcase + #'char-downcase 'char-downcase)) + (3 #'(lambda (x) (- 1 x))) + ((5 6) (random-case #'1+ '1+ #'1- '1-)) + (t (random-case 'identity #'identity))))) + (test (and (eql (random 3) 0) + (random-case 'eq 'eql 'equal + #'eq #'eql #'equal))) + (test-not (and (not test) + (coin) + (random-case 'eq 'eql 'equal + #'eq #'eql #'equal))) + ) + ;; Return parameters + (values + element-type type len start end from-end count seq key test test-not))) + +(defun random-test-remove-args (maxlen) + (multiple-value-bind (element-type type len start end from-end count seq key test test-not) + (make-random-rd-params maxlen) + (declare (ignore type)) + (let ((element (if (and (coin) (> len 0)) + (random-from-seq seq) + (make-random-element element-type))) + (arg-list + (reduce #'nconc + (random-permute + (list + (when start (list :start start)) + (cond (end (list :end end)) + ((coin) (list :end nil))) + (cond (from-end (list :from-end from-end)) + ((coin) (list :from-end nil))) + (cond (count (list :count count)) + ((coin) (list :count nil))) + (cond (key (list :key key)) + ;; ((coin) (list :key nil)) + ) + (when test (list :test test)) + (when test-not (list :test test-not))))))) + (values element seq arg-list)))) + +(defparameter *remove-fail-args* nil) + +(defun random-test-remove (maxlen &key (tested-fn #'remove) + (check-fn #'my-remove) + (pure t)) + (multiple-value-bind (element seq arg-list) + (random-test-remove-args maxlen) + (let* ((seq1 (copy-seq seq)) + (seq2 (copy-seq seq)) + (seq1r (apply tested-fn element seq1 arg-list)) + (seq2r (apply check-fn element seq2 arg-list))) + (setq *remove-fail-args* (list* element seq1 arg-list)) + (cond + ((and pure (not (equalp seq seq1))) :fail1) + ((and pure (not (equalp seq seq2))) :fail2) + ((not (equalp seq1r seq2r)) :fail3) + (t t))))) + +(defun random-test-remove-if (maxlen &optional (negate nil)) + (multiple-value-bind (element seq arg-list) + (random-test-remove-args maxlen) + (let ((fn (getf arg-list :key)) + (test (getf arg-list :test))) + (remf arg-list :key) + (remf arg-list :test) + (remf arg-list :test-not) + (unless test (setq test #'eql)) + (if fn + (case (random 3) + (0 (setf arg-list (list* :key 'identity arg-list))) + (1 (setf arg-list (list* :key #'identity arg-list))) + (t nil)) + (setf fn (if (coin) 'identity + #'(lambda (x) (funcall test element x))))) + (let* ((seq1 (copy-seq seq)) + (seq2 (copy-seq seq)) + (seq1r (apply (if negate #'remove-if-not #'remove-if) + fn seq1 arg-list)) + (seq2r (apply (if negate #'my-remove-if-not #'my-remove-if) + fn seq2 arg-list))) + (setq *remove-fail-args* (cons seq1 arg-list)) + (cond + ((not (equalp seq seq1)) :fail1) + ((not (equalp seq seq2)) :fail2) + ((not (equalp seq1r seq2r)) :fail3) + (t t)))))) + +(defun random-test-delete (maxlen) + (random-test-remove maxlen :tested-fn #'delete :pure nil)) + +(defun random-test-delete-if (maxlen &optional (negate nil)) + (multiple-value-bind (element seq arg-list) + (random-test-remove-args maxlen) + (let ((fn (getf arg-list :key)) + (test (getf arg-list :test))) + (remf arg-list :key) + (remf arg-list :test) + (remf arg-list :test-not) + (unless test (setq test #'eql)) + (if fn + (case (random 3) + (0 (setf arg-list (list* :key 'identity arg-list))) + (1 (setf arg-list (list* :key #'identity arg-list))) + (t nil)) + (setf fn (if (coin) 'identity + #'(lambda (x) (funcall test element x))))) + (setq *remove-fail-args* (list* seq arg-list)) + (let* ((seq1 (copy-seq seq)) + (seq2 (copy-seq seq)) + (seq1r (apply (if negate #'delete-if-not #'delete-if) + fn seq1 arg-list)) + (seq2r (apply (if negate #'my-remove-if-not #'my-remove-if) + fn seq2 arg-list))) + (cond + ((not (equalp seq1r seq2r)) :fail3) + (t t)))))) diff --git a/ansi-tests/remove-duplicates-aux.lsp b/ansi-tests/remove-duplicates-aux.lsp new file mode 100644 index 0000000..1f482ba --- /dev/null +++ b/ansi-tests/remove-duplicates-aux.lsp @@ -0,0 +1,88 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Sep 23 20:59:10 2002 +;;;; Contains: Aux. functions for testing REMOVE-DUPLICATES/DELETE-DUPLICATES + +(in-package :cl-test) + +(defun my-remove-duplicates (orig-sequence + &key from-end test test-not (start 0) end key) + (assert (typep orig-sequence 'sequence)) + (let* ((sequence orig-sequence) + (len (length sequence))) + (unless end (setq end len)) + (unless key (setq key #'identity)) + (cond + (test (assert (not test-not))) + (test-not (setq test #'(lambda (x y) (not (funcall test x y))))) + (t (setq test #'eql))) + (assert (integerp start)) + (assert (integerp end)) + (assert (<= 0 start end len)) + ;; (format t "start = ~A, end = ~A, len = ~A~%" start end len) + (if from-end + (psetq start (- len end) + end (- len start) + sequence (reverse sequence)) + (setq sequence (copy-seq sequence))) + ;; (format t "start = ~A, end = ~A, len = ~A~%" start end len) + (assert (<= 0 start end len) (start end len)) + (let ((result nil)) + (loop for i from 0 below start + do (push (elt sequence i) result)) + (loop for i from start below end + for x = (elt sequence i) + for kx = (if key (funcall key x) x) + unless (position kx + sequence + :start (1+ i) + :end end + :test test + :key key) + do (push x result)) + (loop for i from end below len + do (push (elt sequence i) result)) + (unless from-end (setq result (reverse result))) + (cond + ((listp orig-sequence) result) + ((arrayp orig-sequence) + (make-array (length result) :initial-contents result + :element-type (array-element-type orig-sequence))) + (t (assert nil)))))) + +(defun make-random-rdup-params (maxlen) + "Make random input parameters for REMOVE-DUPLICATES." + (multiple-value-bind (element-type type len start end from-end + count seq key test test-not) + (make-random-rd-params maxlen) + (declare (ignore count element-type)) + (let ((arg-list + (reduce #'nconc + (random-permute + (list + (when start (list :start start)) + (cond (end (list :end end)) + ((coin) (list :end nil))) + (cond (from-end (list :from-end from-end)) + ((coin) (list :from-end nil))) + (cond (key (list :key key)) + ;; ((coin) (list :key nil)) + ) + (when test (list :test test)) + (when test-not (list :test test-not))))))) + (values seq arg-list)))) + +(defun random-test-remove-dups (maxlen &optional (pure t)) + (multiple-value-bind (seq arg-list) + (make-random-rdup-params maxlen) + (let* ((seq1 (copy-seq seq)) + (seq2 (copy-seq seq)) + (seq1r (apply (if pure #'remove-duplicates + #'delete-duplicates) + seq1 arg-list)) + (seq2r (apply #'my-remove-duplicates seq2 arg-list))) + (cond + ((and pure (not (equalp seq seq1))) :fail1) + ((and pure (not (equalp seq seq2))) :fail2) + ((not (equalp seq1r seq2r)) :fail3) + (t t))))) diff --git a/ansi-tests/remove-duplicates.lsp b/ansi-tests/remove-duplicates.lsp new file mode 100644 index 0000000..ac5956b --- /dev/null +++ b/ansi-tests/remove-duplicates.lsp @@ -0,0 +1,253 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Sep 29 20:49:47 2002 +;;;; Contains: Tests for REMOVE-DUPLICATES, DELETE-DUPLICATES + +(in-package :cl-test) + +(deftest random-remove-duplicates + (loop for i from 1 to 5000 + always (random-test-remove-dups 20)) + t) + +(deftest random-delete-duplicates + (loop for i from 1 to 5000 + always (random-test-remove-dups 20 nil)) + t) + +;;; Look for :KEY NIL bugs + +(deftest remove-duplicates.1 + (let* ((orig '(1 2 3 4 1 3 4 1 2 5 6 2 7)) + (x (copy-seq orig)) + (y (remove-duplicates x :key nil))) + (and (equalp orig x) y)) + (3 4 1 5 6 2 7)) + +(deftest delete-duplicates.1 + (let* ((orig '(1 2 3 4 1 3 4 1 2 5 6 2 7)) + (x (copy-seq orig)) + (y (delete-duplicates x :key nil))) + y) + (3 4 1 5 6 2 7)) + + +;;; Order of evaluation tests + +(deftest remove-duplicates.order.1 + (let ((i 0) a b c d e f) + (values + (remove-duplicates + (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4)) + :from-end (progn (setf b (incf i)) nil) + :start (progn (setf c (incf i)) 0) + :end (progn (setf d (incf i)) nil) + :key (progn (setf e (incf i)) #'identity) + :test (progn (setf f (incf i)) #'=) + ) + i a b c d e f)) + (3 1 2 4) 6 1 2 3 4 5 6) + +(deftest remove-duplicates.order.2 + (let ((i 0) a b c d e f) + (values + (remove-duplicates + (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4)) + :test-not (progn (setf b (incf i)) #'/=) + :key (progn (setf c (incf i)) #'identity) + :end (progn (setf d (incf i)) nil) + :start (progn (setf e (incf i)) 0) + :from-end (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + (3 1 2 4) 6 1 2 3 4 5 6) + + +;;; Keyword tests + +(deftest remove-duplicates.allow-other-keys.1 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys t) + (3 4 2 7 8 1 5)) + +(deftest remove-duplicates.allow-other-keys.2 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys nil) + (3 4 2 7 8 1 5)) + +(deftest remove-duplicates.allow-other-keys.3 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) :bad t :allow-other-keys t) + (3 4 2 7 8 1 5)) + +(deftest remove-duplicates.allow-other-keys.4 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys t :bad t) + (3 4 2 7 8 1 5)) + +(deftest remove-duplicates.allow-other-keys.5 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) :bad t + :allow-other-keys t :allow-other-keys nil) + (3 4 2 7 8 1 5)) + +(deftest remove-duplicates.allow-other-keys.6 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) + :allow-other-keys t :bad t :allow-other-keys nil) + (3 4 2 7 8 1 5)) + +(deftest remove-duplicates.allow-other-keys.7 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) + :allow-other-keys t :allow-other-keys nil :bad t) + (3 4 2 7 8 1 5)) + +(deftest remove-duplicates.allow-other-keys.8 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) + :allow-other-keys t :from-end t) + (1 2 3 4 7 8 5)) + +(deftest remove-duplicates.keywords.1 + (remove-duplicates '(1 2 3 4 2 7 8 1 5) :from-end t :from-end nil) + (1 2 3 4 7 8 5)) + + +(deftest delete-duplicates.allow-other-keys.1 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys t) + (3 4 2 7 8 1 5)) + +(deftest delete-duplicates.allow-other-keys.2 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys nil) + (3 4 2 7 8 1 5)) + +(deftest delete-duplicates.allow-other-keys.3 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :bad t :allow-other-keys t) + (3 4 2 7 8 1 5)) + +(deftest delete-duplicates.allow-other-keys.4 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys t :bad t) + (3 4 2 7 8 1 5)) + +(deftest delete-duplicates.allow-other-keys.5 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :bad t + :allow-other-keys t :allow-other-keys nil) + (3 4 2 7 8 1 5)) + +(deftest delete-duplicates.allow-other-keys.6 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) + :allow-other-keys t :bad t :allow-other-keys nil) + (3 4 2 7 8 1 5)) + +(deftest delete-duplicates.allow-other-keys.7 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) + :allow-other-keys t :allow-other-keys nil :bad t) + (3 4 2 7 8 1 5)) + +(deftest delete-duplicates.allow-other-keys.8 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) + :allow-other-keys t :from-end t) + (1 2 3 4 7 8 5)) + +(deftest delete-duplicates.keywords.1 + (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :from-end t :from-end nil) + (1 2 3 4 7 8 5)) + +;;; Order of evaluation tests + +(deftest delete-duplicates.order.1 + (let ((i 0) a b c d e f) + (values + (delete-duplicates + (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4)) + :from-end (progn (setf b (incf i)) nil) + :start (progn (setf c (incf i)) 0) + :end (progn (setf d (incf i)) nil) + :key (progn (setf e (incf i)) #'identity) + :test (progn (setf f (incf i)) #'=) + ) + i a b c d e f)) + (3 1 2 4) 6 1 2 3 4 5 6) + +(deftest delete-duplicates.order.2 + (let ((i 0) a b c d e f) + (values + (delete-duplicates + (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4)) + :test-not (progn (setf b (incf i)) #'/=) + :key (progn (setf c (incf i)) #'identity) + :end (progn (setf d (incf i)) nil) + :start (progn (setf e (incf i)) 0) + :from-end (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + (3 1 2 4) 6 1 2 3 4 5 6) + +;;; Error cases + +(deftest remove-duplicates.error.1 + (classify-error (remove-duplicates)) + program-error) + +(deftest remove-duplicates.error.2 + (classify-error (remove-duplicates nil :start)) + program-error) + +(deftest remove-duplicates.error.3 + (classify-error (remove-duplicates nil 'bad t)) + program-error) + +(deftest remove-duplicates.error.4 + (classify-error (remove-duplicates nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest remove-duplicates.error.5 + (classify-error (remove-duplicates nil 1 2)) + program-error) + +(deftest remove-duplicates.error.6 + (classify-error (remove-duplicates (list 'a 'b 'c) :test #'identity)) + program-error) + +(deftest remove-duplicates.error.7 + (classify-error (remove-duplicates (list 'a 'b 'c) :test-not #'identity)) + program-error) + +(deftest remove-duplicates.error.8 + (classify-error (remove-duplicates (list 'a 'b 'c) :key #'cons)) + program-error) + +(deftest remove-duplicates.error.9 + (classify-error (remove-duplicates (list 'a 'b 'c) :key #'car)) + type-error) + +;;; + +(deftest delete-duplicates.error.1 + (classify-error (delete-duplicates)) + program-error) + +(deftest delete-duplicates.error.2 + (classify-error (delete-duplicates nil :start)) + program-error) + +(deftest delete-duplicates.error.3 + (classify-error (delete-duplicates nil 'bad t)) + program-error) + +(deftest delete-duplicates.error.4 + (classify-error (delete-duplicates nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest delete-duplicates.error.5 + (classify-error (delete-duplicates nil 1 2)) + program-error) + +(deftest delete-duplicates.error.6 + (classify-error (delete-duplicates (list 'a 'b 'c) :test #'identity)) + program-error) + +(deftest delete-duplicates.error.7 + (classify-error (delete-duplicates (list 'a 'b 'c) :test-not #'identity)) + program-error) + +(deftest delete-duplicates.error.8 + (classify-error (delete-duplicates (list 'a 'b 'c) :key #'cons)) + program-error) + +(deftest delete-duplicates.error.9 + (classify-error (delete-duplicates (list 'a 'b 'c) :key #'car)) + type-error) \ No newline at end of file diff --git a/ansi-tests/remove.lsp b/ansi-tests/remove.lsp new file mode 100644 index 0000000..ecb0127 --- /dev/null +++ b/ansi-tests/remove.lsp @@ -0,0 +1,806 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Sep 14 11:46:05 2002 +;;;; Contains: Tests for REMOVE + +(in-package :cl-test) + +(deftest remove-list.1 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-list.2 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :count nil))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-list.3 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :key nil))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-list.4 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :count 100))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-list.5 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :count 0))) + (and (equalp orig x) y)) + (a b c a b d a c b a e)) + +(deftest remove-list.6 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :count 1))) + (and (equalp orig x) y)) + (b c a b d a c b a e)) + +(deftest remove-list.7 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'c x :count 1))) + (and (equalp orig x) y)) + (a b a b d a c b a e)) + +(deftest remove-list.8 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :from-end t))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-list.9 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :from-end t :count 1))) + (and (equalp orig x) y)) + (a b c a b d a c b e)) + +(deftest remove-list.10 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :from-end t :count 4))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-list.11 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig))) + (values + (loop for i from 0 to 10 + collect (remove 'a x :start i)) + (equalp orig x))) + ((b c b d c b e) + (a b c b d c b e) + (a b c b d c b e) + (a b c b d c b e) + (a b c a b d c b e) + (a b c a b d c b e) + (a b c a b d c b e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b a e)) + t) + +(deftest remove-list.12 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig))) + (values + (loop for i from 0 to 10 + collect (remove 'a x :start i :end nil)) + (equalp orig x))) + ((b c b d c b e) + (a b c b d c b e) + (a b c b d c b e) + (a b c b d c b e) + (a b c a b d c b e) + (a b c a b d c b e) + (a b c a b d c b e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b a e)) + t) + +(deftest remove-list.13 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig))) + (values + (loop for i from 0 to 10 + collect (remove 'a x :start i :end 11)) + (equalp orig x))) + ((b c b d c b e) + (a b c b d c b e) + (a b c b d c b e) + (a b c b d c b e) + (a b c a b d c b e) + (a b c a b d c b e) + (a b c a b d c b e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b a e)) + t) + +(deftest remove-list.14 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove 'a x :end nil))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-list.15 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig))) + (values + (loop for i from 0 to 9 + collect (remove 'a x :start i :end 9)) + (equalp orig x))) + ((b c b d c b a e) + (a b c b d c b a e) + (a b c b d c b a e) + (a b c b d c b a e) + (a b c a b d c b a e) + (a b c a b d c b a e) + (a b c a b d c b a e) + (a b c a b d a c b a e) + (a b c a b d a c b a e) + (a b c a b d a c b a e)) + t) + +(deftest remove-list.16 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig))) + (values + (loop for i from 0 to 10 + collect (remove 'a x :start i :end 11 :count 1)) + (equalp orig x))) + ((b c a b d a c b a e) + (a b c b d a c b a e) + (a b c b d a c b a e) + (a b c b d a c b a e) + (a b c a b d c b a e) + (a b c a b d c b a e) + (a b c a b d c b a e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b e) + (a b c a b d a c b a e)) + t) + +(deftest remove-list.17 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig))) + (values + (loop for i from 0 to 10 + collect (remove 'a x :start i :end (1+ i))) + (equalp orig x))) + (( b c a b d a c b a e) + (a b c a b d a c b a e) + (a b c a b d a c b a e) + (a b c b d a c b a e) + (a b c a b d a c b a e) + (a b c a b d a c b a e) + (a b c a b d c b a e) + (a b c a b d a c b a e) + (a b c a b d a c b a e) + (a b c a b d a c b e) + (a b c a b d a c b a e)) + t) + +;;; Show that it tests using EQL, not EQ +(deftest remove-list.18 + (let* ((i (1+ most-positive-fixnum)) + (orig (list i 0 i 1 i 2 3)) + (x (copy-seq orig)) + (y (remove (1+ most-positive-fixnum) x))) + (and (equalp orig x) y)) + (0 1 2 3)) + +(deftest remove-list.19 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 1 x :key #'1-))) + (and (equalp orig x) y)) + (1 3 6 1 4 1 3 7)) + +(deftest remove-list.20 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :test #'>))) + (and (equalp orig x) y)) + (3 6 4 3 7)) + +(deftest remove-list.21 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :test '> :from-end t))) + (and (equalp orig x) y)) + (3 6 4 3 7)) + +(deftest remove-list.22 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 2 x :key nil))) + (and (equalp orig x) y)) + (1 3 6 1 4 1 3 7)) + +(deftest remove-list.23 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 1 x :key '1-))) + (and (equalp orig x) y)) + (1 3 6 1 4 1 3 7)) + +(deftest remove-list.24 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :test-not #'<=))) + (and (equalp orig x) y)) + (3 6 4 3 7)) + +(deftest remove-list.25 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :test-not '<= :from-end t))) + (and (equalp orig x) y)) + (3 6 4 3 7)) + +(deftest remove-list.26 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :from-end t :start 1 :end 5))) + (and (equalp orig x) y)) + (1 2 2 6 1 2 4 1 3 2 7)) + +(deftest remove-list.27 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :count -1))) + (and (equalp orig x) + (equalpt x y))) + t) + +(deftest remove-list.28 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :count -1000000000000))) + (and (equalp orig x) + (equalpt x y))) + t) + +(deftest remove-list.29 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove 3 x :count 1000000000000))) + (and (equalp orig x) + y)) + (1 2 2 6 1 2 4 1 2 7)) + +;;; Assorted tests of remove and delete on vectors, strings, +;;; and bit vectors. These are mostly to exercise bugs previously +;;; detected by the randomized tests + +(deftest remove-vector.1 + (remove 'a (vector 'b 'c 'd)) + #(b c d)) + +(deftest remove-vector.2 + (remove 'a (vector 'b 'c 'd) :count -1) + #(b c d)) + +(deftest remove-vector.3 + (remove 'a (vector 'a 'b 'c 'd) :count -1) + #(a b c d)) + +(deftest remove-string.1 + (remove #\a (copy-seq "abcad")) + "bcd") + +(deftest remove-string.2 + (remove #\a (copy-seq "abcad") :count -1) + "abcad") + +(deftest remove-string.3 + (remove #\a (copy-seq "bcd") :count -1) + "bcd") + +(deftest delete-vector.1 + (delete 'a (vector 'b 'c 'd)) + #(b c d)) + +(deftest delete-vector.2 + (delete 'a (vector 'b 'c 'd) :count -1) + #(b c d)) + +(deftest delete-vector.3 + (delete 'a (vector 'a 'b 'c 'd) :count -1) + #(a b c d)) + +(deftest delete-string.1 + (delete #\a (copy-seq "abcad")) + "bcd") + +(deftest delete-string.2 + (delete #\a (copy-seq "abcad") :count -1) + "abcad") + +(deftest delete-string.3 + (delete #\a (copy-seq "bcd") :count -1) + "bcd") + +(deftest remove-bit-vector.1 + (remove 0 (copy-seq #*00011101101)) + #*111111) + +(deftest remove-bit-vector.2 + (remove 0 (copy-seq #*00011101101) :count -1) + #*00011101101) + +(deftest remove-bit-vector.3 + (remove 0 (copy-seq #*11111) :count -1) + #*11111) + +(deftest delete-bit-vector.1 + (delete 0 (copy-seq #*00011101101)) + #*111111) + +(deftest delete-bit-vector.2 + (delete 0 (copy-seq #*00011101101) :count -1) + #*00011101101) + +(deftest delete-bit-vector.3 + (delete 0 (copy-seq #*11111) :count -1) + #*11111) + +;;; Order of evaluation tests + +(deftest remove.order.1 + (let ((i 0) a b c d e f g h) + (values + (remove + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :from-end (progn (setf c (incf i)) t) + :count (progn (setf d (incf i)) 1) + :key (progn (setf e (incf i)) #'identity) + :test (progn (setf f (incf i)) #'eq) + :start (progn (setf g (incf i)) 0) + :end (progn (setf h (incf i)) nil)) + i a b c d e f g h)) + (a b c d f) 8 1 2 3 4 5 6 7 8) + +(deftest remove.order.2 + (let ((i 0) a b c d e f g h) + (values + (remove + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :end (progn (setf c (incf i)) nil) + :start (progn (setf d (incf i)) 0) + :test-not (progn (setf e (incf i)) (complement #'eq)) + :key (progn (setf f (incf i)) #'identity) + :count (progn (setf g (incf i)) 1) + :from-end (progn (setf h (incf i)) t) + ) + i a b c d e f g h)) + (a b c d f) 8 1 2 3 4 5 6 7 8) + +(deftest delete.order.1 + (let ((i 0) a b c d e f g h) + (values + (delete + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :from-end (progn (setf c (incf i)) t) + :count (progn (setf d (incf i)) 1) + :key (progn (setf e (incf i)) #'identity) + :test (progn (setf f (incf i)) #'eq) + :start (progn (setf g (incf i)) 0) + :end (progn (setf h (incf i)) nil)) + i a b c d e f g h)) + (a b c d f) 8 1 2 3 4 5 6 7 8) + +(deftest delete.order.2 + (let ((i 0) a b c d e f g h) + (values + (delete + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :end (progn (setf c (incf i)) nil) + :start (progn (setf d (incf i)) 0) + :test-not (progn (setf e (incf i)) (complement #'eq)) + :key (progn (setf f (incf i)) #'identity) + :count (progn (setf g (incf i)) 1) + :from-end (progn (setf h (incf i)) t) + ) + i a b c d e f g h)) + (a b c d f) 8 1 2 3 4 5 6 7 8) + +(deftest remove-if.order.1 + (let ((i 0) a b c d e f g) + (values + (remove-if + (progn (setf a (incf i)) #'(lambda (x) (eq x 'a))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :from-end (progn (setf c (incf i)) t) + :count (progn (setf d (incf i)) 1) + :key (progn (setf e (incf i)) #'identity) + :start (progn (setf f (incf i)) 0) + :end (progn (setf g (incf i)) nil)) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +(deftest remove-if.order.2 + (let ((i 0) a b c d e f g) + (values + (remove-if + (progn (setf a (incf i)) #'(lambda (x) (eq x 'a))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :end (progn (setf c (incf i)) nil) + :start (progn (setf d (incf i)) 0) + :key (progn (setf e (incf i)) #'identity) + :count (progn (setf f (incf i)) 1) + :from-end (progn (setf g (incf i)) t) + ) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +(deftest delete-if.order.1 + (let ((i 0) a b c d e f g) + (values + (delete-if + (progn (setf a (incf i)) #'(lambda (x) (eq x 'a))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :from-end (progn (setf c (incf i)) t) + :count (progn (setf d (incf i)) 1) + :key (progn (setf e (incf i)) #'identity) + :start (progn (setf f (incf i)) 0) + :end (progn (setf g (incf i)) nil)) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +(deftest delete-if.order.2 + (let ((i 0) a b c d e f g) + (values + (delete-if + (progn (setf a (incf i)) #'(lambda (x) (eq x 'a))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :end (progn (setf c (incf i)) nil) + :start (progn (setf d (incf i)) 0) + :key (progn (setf e (incf i)) #'identity) + :count (progn (setf f (incf i)) 1) + :from-end (progn (setf g (incf i)) t) + ) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +(deftest remove-if-not.order.1 + (let ((i 0) a b c d e f g) + (values + (remove-if-not + (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a)))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :from-end (progn (setf c (incf i)) t) + :count (progn (setf d (incf i)) 1) + :key (progn (setf e (incf i)) #'identity) + :start (progn (setf f (incf i)) 0) + :end (progn (setf g (incf i)) nil)) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +(deftest remove-if-not.order.2 + (let ((i 0) a b c d e f g) + (values + (remove-if-not + (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a)))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :end (progn (setf c (incf i)) nil) + :start (progn (setf d (incf i)) 0) + :key (progn (setf e (incf i)) #'identity) + :count (progn (setf f (incf i)) 1) + :from-end (progn (setf g (incf i)) t) + ) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +(deftest delete-if-not.order.1 + (let ((i 0) a b c d e f g) + (values + (delete-if-not + (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a)))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :from-end (progn (setf c (incf i)) t) + :count (progn (setf d (incf i)) 1) + :key (progn (setf e (incf i)) #'identity) + :start (progn (setf f (incf i)) 0) + :end (progn (setf g (incf i)) nil)) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +(deftest delete-if-not.order.2 + (let ((i 0) a b c d e f g) + (values + (delete-if-not + (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a)))) + (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f)) + :end (progn (setf c (incf i)) nil) + :start (progn (setf d (incf i)) 0) + :key (progn (setf e (incf i)) #'identity) + :count (progn (setf f (incf i)) 1) + :from-end (progn (setf g (incf i)) t) + ) + i a b c d e f g)) + (a b c d f) 7 1 2 3 4 5 6 7) + +;;; Randomized tests + +(deftest remove-random + (loop for i from 1 to 2500 + unless (eq (random-test-remove 20) t) + do (return *remove-fail-args*)) + nil) + +(deftest remove-if-random + (loop for i from 1 to 2500 + unless (eq (random-test-remove-if 20) t) + do (return *remove-fail-args*)) + nil) + +(deftest remove-if-not-random + (loop for i from 1 to 2500 + unless (eq (random-test-remove-if 20 t) t) + do (return *remove-fail-args*)) + nil) + +(deftest delete-random + (loop for i from 1 to 2500 + unless (eq (random-test-delete 20) t) + do (return *remove-fail-args*)) + nil) + +(deftest delete-if-random + (loop for i from 1 to 2500 + unless (eq (random-test-delete-if 20) t) + do (return *remove-fail-args*)) + nil) + +(deftest delete-if-not-random + (loop for i from 1 to 2500 + unless (eq (random-test-delete-if 20 t) t) + do (return *remove-fail-args*)) + nil) + +;;; Additional tests with KEY = NIL + +(deftest remove-if-list.1 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove-if #'evenp x :key nil))) + (and (equalp orig x) y)) + (1 3 1 1 3 7)) + +(deftest remove-if-list.2 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove-if #'(lambda (y) (eqt y 'a)) x :key nil))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest remove-if-not-list.1 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (remove-if-not #'oddp x :key nil))) + (and (equalp orig x) y)) + (1 3 1 1 3 7)) + +(deftest remove-if-not-list.2 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (remove-if-not #'(lambda (y) (not (eqt y 'a))) x :key nil))) + (and (equalp orig x) y)) + (b c b d c b e)) + +(deftest delete-if-list.1 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (delete-if #'evenp x :key nil))) + y) + (1 3 1 1 3 7)) + +(deftest delete-if-list.2 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (delete-if #'(lambda (y) (eqt y 'a)) x :key nil))) + y) + (b c b d c b e)) + +(deftest delete-if-not-list.1 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (delete-if-not #'oddp x :key nil))) + y) + (1 3 1 1 3 7)) + +(deftest delete-if-not-list.2 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (delete-if-not #'(lambda (y) (not (eqt y 'a))) x :key nil))) + y) + (b c b d c b e)) + +(deftest delete-list.1 + (let* ((orig '(a b c a b d a c b a e)) + (x (copy-seq orig)) + (y (delete 'a x :key nil))) + y) + (b c b d c b e)) + +(deftest delete-list.2 + (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7)) + (x (copy-seq orig)) + (y (delete 2 x :key nil))) + y) + (1 3 6 1 4 1 3 7)) + +;;; Keyword tests + +(deftest remove.allow-other-keys.1 + (remove 'a '(a b c a d) :allow-other-keys t) + (b c d)) + +(deftest remove.allow-other-keys.2 + (remove 'a '(a b c a d) :allow-other-keys nil) + (b c d)) + +(deftest remove.allow-other-keys.3 + (remove 'a '(a b c a d) :bad t :allow-other-keys t) + (b c d)) + +(deftest remove.allow-other-keys.4 + (remove 'a '(a b c a d) :allow-other-keys t :bad t :bad nil) + (b c d)) + +(deftest remove.allow-other-keys.5 + (remove 'a '(a b c a d) :bad1 t :allow-other-keys t :bad2 t + :allow-other-keys nil :bad3 t) + (b c d)) + +(deftest remove.allow-other-keys.6 + (remove 'a '(a b c a d) :allow-other-keys t :from-end t :count 1) + (a b c d)) + +(deftest remove.keywords.7 + (remove 'a '(a b c a d) :from-end t :count 1 :from-end nil :count 10) + (a b c d)) + + +(deftest delete.allow-other-keys.1 + (delete 'a (copy-seq '(a b c a d)) :allow-other-keys t) + (b c d)) + +(deftest delete.allow-other-keys.2 + (delete 'a (copy-seq '(a b c a d)) :allow-other-keys nil) + (b c d)) + +(deftest delete.allow-other-keys.3 + (delete 'a (copy-seq '(a b c a d)) :bad t :allow-other-keys t) + (b c d)) + +(deftest delete.allow-other-keys.4 + (delete 'a (copy-seq '(a b c a d)) :allow-other-keys t :bad t :bad nil) + (b c d)) + +(deftest delete.allow-other-keys.5 + (delete 'a (copy-seq '(a b c a d)) :bad1 t :allow-other-keys t :bad2 t + :allow-other-keys nil :bad3 t) + (b c d)) + +(deftest delete.allow-other-keys.6 + (delete 'a (copy-seq '(a b c a d)) :allow-other-keys t :from-end t :count 1) + (a b c d)) + +(deftest delete.keywords.7 + (delete 'a (copy-seq '(a b c a d)) + :from-end t :count 1 :from-end nil :count 10) + (a b c d)) + + + +;;; Error cases + +(deftest remove.error.1 + (classify-error (remove)) + program-error) + +(deftest remove.error.2 + (classify-error (remove 'a)) + program-error) + +(deftest remove.error.3 + (classify-error (remove 'a nil :key)) + program-error) + +(deftest remove.error.4 + (classify-error (remove 'a nil 'bad t)) + program-error) + +(deftest remove.error.5 + (classify-error (remove 'a nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest remove.error.6 + (classify-error (remove 'a nil 1 2)) + program-error) + +(deftest remove.error.7 + (classify-error (remove 'a (list 'a 'b 'c) :test #'identity)) + program-error) + +(deftest remove.error.8 + (classify-error (remove 'a (list 'a 'b 'c) :test-not #'identity)) + program-error) + +(deftest remove.error.9 + (classify-error (remove 'a (list 'a 'b 'c) :key #'cons)) + program-error) + +(deftest remove.error.10 + (classify-error (remove 'a (list 'a 'b 'c) :key #'car)) + type-error) + + +;;; + +(deftest delete.error.1 + (classify-error (delete)) + program-error) + +(deftest delete.error.2 + (classify-error (delete 'a)) + program-error) + +(deftest delete.error.3 + (classify-error (delete 'a nil :key)) + program-error) + +(deftest delete.error.4 + (classify-error (delete 'a nil 'bad t)) + program-error) + +(deftest delete.error.5 + (classify-error (delete 'a nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest delete.error.6 + (classify-error (delete 'a nil 1 2)) + program-error) + +(deftest delete.error.7 + (classify-error (delete 'a (list 'a 'b 'c) :test #'identity)) + program-error) + +(deftest delete.error.8 + (classify-error (delete 'a (list 'a 'b 'c) :test-not #'identity)) + program-error) + +(deftest delete.error.9 + (classify-error (delete 'a (list 'a 'b 'c) :key #'cons)) + program-error) + +(deftest delete.error.10 + (classify-error (delete 'a (list 'a 'b 'c) :key #'car)) + type-error) diff --git a/ansi-tests/rename-file.lsp b/ansi-tests/rename-file.lsp new file mode 100644 index 0000000..d8a3021 --- /dev/null +++ b/ansi-tests/rename-file.lsp @@ -0,0 +1,199 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 8 06:22:53 2004 +;;;; Contains: Tests for RENAME-FILE + +(in-package :cl-test) + +(deftest rename-file.1 + (let ((pn1 #p"file-to-be-renamed.txt") + (pn2 #p"file-that-was-renamed.txt")) + (delete-all-versions pn1) + (delete-all-versions pn2) + (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) + (let ((results (multiple-value-list (rename-file pn1 pn2)))) + (destructuring-bind (defaulted-new-name old-truename new-truename) + results + (values + (=t (length results) 3) + (probe-file pn1) + (notnot (probe-file pn2)) + (list (notnot (pathnamep defaulted-new-name)) + (notnot (pathnamep old-truename)) + (notnot (pathnamep new-truename)) + (typep old-truename 'logical-pathname) + (typep new-truename 'logical-pathname)) + (notnot (probe-file defaulted-new-name)) + (probe-file old-truename) + (notnot (probe-file new-truename)))))) + t nil t (t t t nil nil) t nil t) + +(deftest rename-file.2 + (let ((pn1 "file-to-be-renamed.txt") + (pn2 "file-that-was-renamed.txt")) + (delete-all-versions pn1) + (delete-all-versions pn2) + (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) + (let ((results (multiple-value-list (rename-file pn1 pn2)))) + (destructuring-bind (defaulted-new-name old-truename new-truename) + results + (values + (=t (length results) 3) + (probe-file pn1) + (notnot (probe-file pn2)) + (list (notnot (pathnamep defaulted-new-name)) + (notnot (pathnamep old-truename)) + (notnot (pathnamep new-truename)) + (typep old-truename 'logical-pathname) + (typep new-truename 'logical-pathname)) + (notnot (probe-file defaulted-new-name)) + (probe-file old-truename) + (notnot (probe-file new-truename)))))) + t nil t (t t t nil nil) t nil t) + + (deftest rename-file.3 + (let* ((pn1 (make-pathname :name "file-to-be-renamed" + :type "txt" + :version :newest + :defaults *default-pathname-defaults*)) + (pn2 (make-pathname :name "file-that-was-renamed")) + (pn3 (make-pathname :name "file-that-was-renamed" + :defaults pn1))) + (delete-all-versions pn1) + (delete-all-versions pn3) + (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) + (let ((results (multiple-value-list (rename-file pn1 pn2)))) + (destructuring-bind (defaulted-new-name old-truename new-truename) + results + (values + (equalpt (pathname-type pn1) + (pathname-type defaulted-new-name)) + (=t (length results) 3) + (probe-file pn1) + (notnot (probe-file pn3)) + (list (notnot (pathnamep defaulted-new-name)) + (notnot (pathnamep old-truename)) + (notnot (pathnamep new-truename)) + (typep old-truename 'logical-pathname) + (typep new-truename 'logical-pathname)) + (notnot (probe-file defaulted-new-name)) + (probe-file old-truename) + (notnot (probe-file new-truename)))))) + t t nil t (t t t nil nil) t nil t) + +(deftest rename-file.4 + (let ((pn1 "file-to-be-renamed.txt") + (pn2 "file-that-was-renamed.txt")) + (delete-all-versions pn1) + (delete-all-versions pn2) + (let ((s (open pn1 :direction :output))) + (format s "Whatever~%") + (close s) + (let ((results (multiple-value-list (rename-file s pn2)))) + (destructuring-bind (defaulted-new-name old-truename new-truename) + results + (values + (=t (length results) 3) + (probe-file pn1) + (notnot (probe-file pn2)) + (list (notnot (pathnamep defaulted-new-name)) + (notnot (pathnamep old-truename)) + (notnot (pathnamep new-truename)) + (typep old-truename 'logical-pathname) + (typep new-truename 'logical-pathname)) + (notnot (probe-file defaulted-new-name)) + (probe-file old-truename) + (notnot (probe-file new-truename))))))) + t nil t (t t t nil nil) t nil t) + +(deftest rename-file.5 + (let ((pn1 "CLTEST:FILE-TO-BE-RENAMED.TXT") + (pn2 "CLTEST:FILE-THAT-WAS-RENAMED.TXT")) + (delete-all-versions pn1) + (delete-all-versions pn2) + (assert (typep (pathname pn1) 'logical-pathname)) + (assert (typep (pathname pn2) 'logical-pathname)) + (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) + (let ((results (multiple-value-list (rename-file pn1 pn2)))) + (destructuring-bind (defaulted-new-name old-truename new-truename) + results + (values + (=t (length results) 3) + (probe-file pn1) + (notnot (probe-file pn2)) + (list (notnot (pathnamep defaulted-new-name)) + (notnot (pathnamep old-truename)) + (notnot (pathnamep new-truename)) + (typep old-truename 'logical-pathname) + (typep new-truename 'logical-pathname)) + (notnot (probe-file defaulted-new-name)) + (probe-file old-truename) + (notnot (probe-file new-truename)) + (notnot (typep defaulted-new-name 'logical-pathname)) + )))) + t nil t (t t t nil nil) t nil t t) + +;;; Specialized string tests + +(deftest rename-file.6 + (do-special-strings + (s "file-to-be-renamed.txt" nil) + (let ((pn1 s) + (pn2 "file-that-was-renamed.txt")) + (delete-all-versions pn1) + (delete-all-versions pn2) + (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) + (let ((results (multiple-value-list (rename-file pn1 pn2)))) + (destructuring-bind (defaulted-new-name old-truename new-truename) + results + (assert + (equal + (list + (=t (length results) 3) + (probe-file pn1) + (notnot (probe-file pn2)) + (list (notnot (pathnamep defaulted-new-name)) + (notnot (pathnamep old-truename)) + (notnot (pathnamep new-truename)) + (typep old-truename 'logical-pathname) + (typep new-truename 'logical-pathname)) + (notnot (probe-file defaulted-new-name)) + (probe-file old-truename) + (notnot (probe-file new-truename))) + '(t nil t (t t t nil nil) t nil t))))))) + nil) + +(deftest rename-file.7 + (do-special-strings + (s "file-that-was-renamed.txt" nil) + (let ((pn1 "file-to-be-renamed.txt") + (pn2 s)) + (delete-all-versions pn1) + (delete-all-versions pn2) + (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) + (let ((results (multiple-value-list (rename-file pn1 pn2)))) + (destructuring-bind (defaulted-new-name old-truename new-truename) + results + (assert + (equal + (list + (=t (length results) 3) + (probe-file pn1) + (notnot (probe-file pn2)) + (list (notnot (pathnamep defaulted-new-name)) + (notnot (pathnamep old-truename)) + (notnot (pathnamep new-truename)) + (typep old-truename 'logical-pathname) + (typep new-truename 'logical-pathname)) + (notnot (probe-file defaulted-new-name)) + (probe-file old-truename) + (notnot (probe-file new-truename))) + '(t nil t (t t t nil nil) t nil t))))))) + nil) + +;;; Error tests + +(deftest rename-file.error.1 + (signals-error (rename-file) program-error) + t) + diff --git a/ansi-tests/replace.lsp b/ansi-tests/replace.lsp new file mode 100644 index 0000000..310db89 --- /dev/null +++ b/ansi-tests/replace.lsp @@ -0,0 +1,685 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Aug 27 16:11:38 2002 +;;;; Contains: Tests for REPLACE + +(in-package :cl-test) + +(deftest replace-list.1 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z)))) + (values (eqt x result) result)) + t + (x y z d e f g)) + +(deftest replace-list.2 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start1 1))) + (values (eqt x result) result)) + t + (a x y z e f g)) + +(deftest replace-list.3 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start1 4))) + (values (eqt x result) result)) + t + (a b c d x y z)) + +(deftest replace-list.4 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start1 5))) + (values (eqt x result) result)) + t + (a b c d e x y)) + +(deftest replace-list.5 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start1 6))) + (values (eqt x result) result)) + t + (a b c d e f x)) + +(deftest replace-list.6 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x #(x y z) :start1 2))) + (values (eqt x result) result)) + t + (a b x y z f g)) + +(deftest replace-list.7 + (replace nil #(x y z)) + nil) + +(deftest replace-list.8 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :end1 1))) + (values (eqt x result) result)) + t + (x b c d e f g)) + +(deftest replace-list.9 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start1 3 :end1 4))) + (values (eqt x result) result)) + t + (a b c x e f g)) + +(deftest replace-list.10 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start1 0 :end1 5))) + (values (eqt x result) result)) + t + (x y z d e f g)) + + +(deftest replace-list.11 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start2 1))) + (values (eqt x result) result)) + t + (y z c d e f g)) + +(deftest replace-list.12 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start2 1 :end1 nil))) + (values (eqt x result) result)) + t + (y z c d e f g)) + +(deftest replace-list.13 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start2 1 :end2 nil))) + (values (eqt x result) result)) + t + (y z c d e f g)) + +(deftest replace-list.14 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start2 1 :end2 2))) + (values (eqt x result) result)) + t + (y b c d e f g)) + +(deftest replace-list.15 + (let* ((x (copy-seq '(a b c d e f g))) + (result (replace x '(x y z) :start1 4 :end1 5 :start2 1 :end2 2))) + (values (eqt x result) result)) + t + (a b c d y f g)) + +(deftest replace-list.16 + (let* ((x (copy-seq '(a b c d e f))) + (y #(1 2 3)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + (a 1 2 3 e f)) + +(deftest replace-list.17 + (let* ((x (copy-seq '(a b c d e f))) + (y (make-array '(3) :initial-contents '(1 2 3) + :fill-pointer t)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + (a 1 2 3 e f)) + +(deftest replace-list.18 + (let* ((x (copy-seq '(a b c d e f))) + (y (make-array '(6) :initial-contents '(1 2 3 4 5 6) + :fill-pointer 3)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + (a 1 2 3 e f)) + +(deftest replace-list.19 + (let* ((x (copy-seq '(a b c d e f))) + (result (replace x x :start1 0 :end1 3 :start2 1 :end2 4))) + (values (eqt x result) result)) + t + (b c d d e f)) + +(deftest replace-list.20 + (let* ((x (copy-seq '(a b c d e f))) + (result (replace x x :start1 1 :end1 4 :start2 0 :end2 3))) + (values (eqt x result) result)) + t + (a a b c e f)) + + +;;; Tests of vectors + +(deftest replace-vector.1 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z)))) + (values (eqt x result) result)) + t + #(x y z d e f g)) + +(deftest replace-vector.2 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start1 1))) + (values (eqt x result) result)) + t + #(a x y z e f g)) + +(deftest replace-vector.3 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start1 4))) + (values (eqt x result) result)) + t + #(a b c d x y z)) + +(deftest replace-vector.4 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start1 5))) + (values (eqt x result) result)) + t + #(a b c d e x y)) + +(deftest replace-vector.5 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start1 6))) + (values (eqt x result) result)) + t + #(a b c d e f x)) + +(deftest replace-vector.6 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x '(x y z) :start1 2))) + (values (eqt x result) result)) + t + #(a b x y z f g)) + +(deftest replace-vector.7 + (replace #() #(x y z)) + #()) + +(deftest replace-vector.8 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :end1 1))) + (values (eqt x result) result)) + t + #(x b c d e f g)) + +(deftest replace-vector.9 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start1 3 :end1 4))) + (values (eqt x result) result)) + t + #(a b c x e f g)) + +(deftest replace-vector.10 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start1 0 :end1 5))) + (values (eqt x result) result)) + t + #(x y z d e f g)) + + +(deftest replace-vector.11 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start2 1))) + (values (eqt x result) result)) + t + #(y z c d e f g)) + +(deftest replace-vector.12 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start2 1 :end1 nil))) + (values (eqt x result) result)) + t + #(y z c d e f g)) + +(deftest replace-vector.13 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start2 1 :end2 nil))) + (values (eqt x result) result)) + t + #(y z c d e f g)) + +(deftest replace-vector.14 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start2 1 :end2 2))) + (values (eqt x result) result)) + t + #(y b c d e f g)) + +(deftest replace-vector.15 + (let* ((x (copy-seq #(a b c d e f g))) + (result (replace x #(x y z) :start1 4 :end1 5 :start2 1 :end2 2))) + (values (eqt x result) result)) + t + #(a b c d y f g)) + +(deftest replace-vector.16 + (let* ((x (copy-seq #(a b c d e f))) + (y '(1 2 3)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + #(a 1 2 3 e f)) + +(deftest replace-vector.17 + (let* ((x (copy-seq #(a b c d e f))) + (y (make-array '(3) :initial-contents '(1 2 3) + :fill-pointer t)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + #(a 1 2 3 e f)) + +(deftest replace-vector.18 + (let* ((x (copy-seq #(a b c d e f))) + (y (make-array '(6) :initial-contents '(1 2 3 4 5 6) + :fill-pointer 3)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + #(a 1 2 3 e f)) + +(deftest replace-vector.19 + (let* ((x (copy-seq #(a b c d e f))) + (result (replace x x :start1 0 :end1 3 :start2 1 :end2 4))) + (values (eqt x result) result)) + t + #(b c d d e f)) + +(deftest replace-vector.21 + (let* ((x (copy-seq #(a b c d e f))) + (result (replace x x :start1 1 :end1 4 :start2 0 :end2 3))) + (values (eqt x result) result)) + t + #(a a b c e f)) + +;;; tests on bit vectors + +(deftest replace-bit-vector.1 + (let* ((x (copy-seq #*1101001)) + (result (replace x #*011))) + (values (eqt x result) result)) + t + #*0111001) + +(deftest replace-bit-vector.2 + (let* ((x (copy-seq #*1101001)) + (result (replace x #*011 :start1 1))) + (values (eqt x result) result)) + t + #*1011001) + +(deftest replace-bit-vector.3 + (let* ((x (copy-seq #*1101001)) + (result (replace x #*011 :start1 4))) + (values (eqt x result) result)) + t + #*1101011) + +(deftest replace-bit-vector.4 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*111 :start1 5))) + (values (eqt x result) result)) + t + #*0000011) + +(deftest replace-bit-vector.5 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*100 :start1 6))) + (values (eqt x result) result)) + t + #*0000001) + +(deftest replace-bit-vector.6 + (let* ((x (copy-seq #*0000000)) + (result (replace x '(1 1 1) :start1 2))) + (values (eqt x result) result)) + t + #*0011100) + +(deftest replace-bit-vector.7 + (replace #* #*111) + #*) + +(deftest replace-bit-vector.8 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*111 :end1 1))) + (values (eqt x result) result)) + t + #*1000000) + +(deftest replace-bit-vector.9 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*110 :start1 3 :end1 4))) + (values (eqt x result) result)) + t + #*0001000) + +(deftest replace-bit-vector.10 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*111 :start1 0 :end1 5))) + (values (eqt x result) result)) + t + #*1110000) + + +(deftest replace-bit-vector.11 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*011 :start2 1))) + (values (eqt x result) result)) + t + #*1100000) + +(deftest replace-bit-vector.12 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*011 :start2 1 :end1 nil))) + (values (eqt x result) result)) + t + #*1100000) + +(deftest replace-bit-vector.13 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*011 :start2 1 :end2 nil))) + (values (eqt x result) result)) + t + #*1100000) + +(deftest replace-bit-vector.14 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*011 :start2 1 :end2 2))) + (values (eqt x result) result)) + t + #*1000000) + +(deftest replace-bit-vector.15 + (let* ((x (copy-seq #*0000000)) + (result (replace x #*011 :start1 4 :end1 5 :start2 1 :end2 2))) + (values (eqt x result) result)) + t + #*0000100) + +(deftest replace-bit-vector.16 + (let* ((x (copy-seq #*001011)) + (y '(1 0 1)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + #*010111) + +(deftest replace-bit-vector.17 + (let* ((x (copy-seq #*001011)) + (y (make-array '(3) :initial-contents '(1 0 1) + :fill-pointer t :element-type 'bit)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + #*010111) + +(deftest replace-bit-vector.18 + (let* ((x (copy-seq #*001011)) + (y (make-array '(6) :initial-contents '(1 0 1 0 0 1) + :fill-pointer 3 + :element-type 'bit)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + #*010111) + +(deftest replace-bit-vector.19 + (let* ((x (copy-seq #*001011)) + (result (replace x x :start1 0 :end1 3 :start2 1 :end2 4))) + (values (eqt x result) result)) + t + #*010011) + +(deftest replace-bit-vector.21 + (let* ((x (copy-seq #*001011)) + (result (replace x x :start1 1 :end1 4 :start2 0 :end2 3))) + (values (eqt x result) result)) + t + #*000111) + +;;; Tests on strings + +(deftest replace-string.1 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz"))) + (values (eqt x result) result)) + t + "xyzdefg") + +(deftest replace-string.2 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start1 1))) + (values (eqt x result) result)) + t + "axyzefg") + +(deftest replace-string.3 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start1 4))) + (values (eqt x result) result)) + t + "abcdxyz") + +(deftest replace-string.4 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start1 5))) + (values (eqt x result) result)) + t + "abcdexy") + +(deftest replace-string.5 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start1 6))) + (values (eqt x result) result)) + t + "abcdefx") + +(deftest replace-string.6 + (let* ((x (copy-seq "abcdefg")) + (result (replace x '(#\x #\y #\z) :start1 2))) + (values (eqt x result) result)) + t + "abxyzfg") + +(deftest replace-string.7 + (replace "" "xyz") + "") + +(deftest replace-string.8 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :end1 1))) + (values (eqt x result) result)) + t + "xbcdefg") + +(deftest replace-string.9 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start1 3 :end1 4))) + (values (eqt x result) result)) + t + "abcxefg") + +(deftest replace-string.10 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start1 0 :end1 5))) + (values (eqt x result) result)) + t + "xyzdefg") + + +(deftest replace-string.11 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start2 1))) + (values (eqt x result) result)) + t + "yzcdefg") + +(deftest replace-string.12 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start2 1 :end1 nil))) + (values (eqt x result) result)) + t + "yzcdefg") + +(deftest replace-string.13 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start2 1 :end2 nil))) + (values (eqt x result) result)) + t + "yzcdefg") + +(deftest replace-string.14 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start2 1 :end2 2))) + (values (eqt x result) result)) + t + "ybcdefg") + +(deftest replace-string.15 + (let* ((x (copy-seq "abcdefg")) + (result (replace x "xyz" :start1 4 :end1 5 :start2 1 :end2 2))) + (values (eqt x result) result)) + t + "abcdyfg") + +(deftest replace-string.16 + (let* ((x (copy-seq "abcdef")) + (y (coerce "123" 'list)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + "a123ef") + +(deftest replace-string.17 + (let* ((x (copy-seq "abcdef")) + (y (make-array '(3) :initial-contents '(#\1 #\2 #\3) + :fill-pointer t :element-type 'character)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + "a123ef") + +(deftest replace-string.18 + (let* ((x (copy-seq "abcdef")) + (y (make-array '(6) :initial-contents "123456" + :fill-pointer 3 + :element-type 'character)) + (result (replace x y :start1 1))) + (values (eqt x result) result)) + t + "a123ef") + +(deftest replace-string.19 + (let* ((x (copy-seq "abcdef")) + (result (replace x x :start1 0 :end1 3 :start2 1 :end2 4))) + (values (eqt x result) result)) + t + "bcddef") + +(deftest replace-string.21 + (let* ((x (copy-seq "abcdef")) + (result (replace x x :start1 1 :end1 4 :start2 0 :end2 3))) + (values (eqt x result) result)) + t + "aabcef") + +;;; Order of evaluation tests + +(deftest replace.order.1 + (let ((i 0) a b) + (values + (replace (progn (setf a (incf i)) (list 'a 'b 'c)) + (progn (setf b (incf i)) (list 'e 'f))) + i a b)) + (e f c) 2 1 2) + +(deftest replace.order.2 + (let ((i 0) a b c d e f) + (values + (replace (progn (setf a (incf i)) (list 'a 'b 'c)) + (progn (setf b (incf i)) (list 'e 'f)) + :start1 (progn (setf c (incf i)) 1) + :end1 (progn (setf d (incf i)) 3) + :start2 (progn (setf e (incf i)) 0) + :end2 (progn (setf f (incf i)) 2) + ) + i a b c d e f)) + (a e f) 6 1 2 3 4 5 6) + +(deftest replace.order.3 + (let ((i 0) a b c d e f) + (values + (replace (progn (setf a (incf i)) (list 'a 'b 'c)) + (progn (setf b (incf i)) (list 'e 'f)) + :end2 (progn (setf c (incf i)) 2) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) 3) + :start1 (progn (setf f (incf i)) 1) + ) + i a b c d e f)) + (a e f) 6 1 2 3 4 5 6) + +;;; Keyword tests + +(deftest replace.allow-other-keys.1 + (replace (copy-seq "abcdefg") "xyz" :allow-other-keys t) + "xyzdefg") + +(deftest replace.allow-other-keys.2 + (replace (copy-seq "abcdefg") "xyz" :allow-other-keys nil) + "xyzdefg") + +(deftest replace.allow-other-keys.3 + (replace (copy-seq "abcdefg") "xyz" :allow-other-keys t :bad t) + "xyzdefg") + +(deftest replace.allow-other-keys.4 + (replace (copy-seq "abcdefg") "xyz" :bad t :allow-other-keys t) + "xyzdefg") + +(deftest replace.allow-other-keys.5 + (replace (copy-seq "abcdefg") "xyz" :bad1 t :allow-other-keys t + :bad2 t :allow-other-keys nil :bad3 nil) + "xyzdefg") + +(deftest replace.allow-other-keys.6 + (replace (copy-seq "abcdefg") "xyz" :allow-other-keys t :start1 1) + "axyzefg") + +(deftest replace.keywords.7 + (replace (copy-seq "abcdefg") "xyz" :start1 0 :start2 0 :end1 3 :end2 3 + :start1 1 :start2 1 :end1 2 :end1 2) + "xyzdefg") + + + + +;;; Error cases + +(deftest replace.error.1 + (classify-error (replace)) + program-error) + +(deftest replace.error.2 + (classify-error (replace nil)) + program-error) + +(deftest replace.error.3 + (classify-error (replace nil nil :start)) + program-error) + +(deftest replace.error.4 + (classify-error (replace nil nil 'bad t)) + program-error) + +(deftest replace.error.5 + (classify-error (replace nil nil :allow-other-keys nil 'bad t)) + program-error) + +(deftest replace.error.6 + (classify-error (replace nil nil 1 2)) + program-error) + diff --git a/ansi-tests/reverse.lsp b/ansi-tests/reverse.lsp new file mode 100644 index 0000000..cf1ab93 --- /dev/null +++ b/ansi-tests/reverse.lsp @@ -0,0 +1,131 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Aug 20 23:47:28 2002 +;;;; Contains: Tests for REVERSE + +(in-package :cl-test) + +(deftest reverse-list.1 + (reverse nil) + nil) + +(deftest reverse-list.2 + (let ((x '(a b c))) + (values (reverse x) x)) + (c b a) + (a b c)) + +(deftest reverse-vector.1 + (reverse #()) + #()) + +(deftest reverse-vector.2 + (let ((x #(a b c d e))) + (values (reverse x) x)) + #(e d c b a) + #(a b c d e)) + +(deftest reverse-nonsimple-vector.1 + (let ((x (make-array 0 :fill-pointer t :adjustable t))) + (reverse x)) + #()) + +(deftest reverse-nonsimple-vector.2 + (let* ((x (make-array 5 :initial-contents '(1 2 3 4 5) + :fill-pointer t :adjustable t)) + (y (reverse x))) + (values y x)) + #(5 4 3 2 1) + #(1 2 3 4 5)) + +(deftest reverse-nonsimple-vector.3 + (let* ((x (make-array 10 :initial-contents '(1 2 3 4 5 6 7 8 9 10) + :fill-pointer 5)) + (y (reverse x))) + y) + #(5 4 3 2 1)) + +(deftest reverse-bit-vector.1 + (reverse #*) + #*) + +(deftest reverse-bit-vector.2 + (let ((x #*000110110110)) + (values (reverse x) x)) + #*011011011000 + #*000110110110) + +(deftest reverse-bit-vector.3 + (let* ((x (make-array 10 :initial-contents '(0 0 0 1 1 0 1 0 1 0) + :fill-pointer 5 + :element-type 'bit)) + (y (reverse x))) + y) + #*11000) + +(deftest reverse-string.1 + (reverse "") + "") + +(deftest reverse-string.2 + (let ((x "000110110110")) + (values (reverse x) x)) + "011011011000" + "000110110110") + +(deftest reverse-string.3 + (let* ((x (make-array 10 :initial-contents "abcdefghij" + :fill-pointer 5 + :element-type 'character)) + (y (reverse x))) + y) + "edcba") + +(deftest reverse-string.4 + (let* ((x (make-array 10 :initial-contents "abcdefghij" + :fill-pointer 5 + :element-type 'base-char)) + (y (reverse x))) + y) + "edcba") + +(deftest reverse.order.1 + (let ((i 0)) + (values + (reverse (progn (incf i) (list 'a 'b 'c 'd))) + i)) + (d c b a) 1) + +;;; Error cases + +(deftest reverse.error.1 + (classify-error (reverse 'a)) + type-error) + +(deftest reverse.error.2 + (classify-error (reverse #\a)) + type-error) + +(deftest reverse.error.3 + (classify-error (reverse 10)) + type-error) + +(deftest reverse.error.4 + (classify-error (reverse 0.3)) + type-error) + +(deftest reverse.error.5 + (classify-error (reverse 10/3)) + type-error) + +(deftest reverse.error.6 + (classify-error (reverse)) + program-error) + +(deftest reverse.error.7 + (classify-error (reverse nil nil)) + program-error) + +(deftest reverse.error.8 + (classify-error (locally (reverse 'a) t)) + type-error) diff --git a/ansi-tests/row-major-aref.lsp b/ansi-tests/row-major-aref.lsp new file mode 100644 index 0000000..48d4d3e --- /dev/null +++ b/ansi-tests/row-major-aref.lsp @@ -0,0 +1,112 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 22 20:16:38 2003 +;;;; Contains: Tests of ROW-MAJOR-AREF + +(in-package :cl-test) + +;;; ROW-MAJOR-AREF is also used by equalp-with-case (see rt/rt.lsp) + +(deftest row-major-aref.1 + (loop for i from 0 to 5 collect (row-major-aref #(a b c d e f) i)) + (a b c d e f)) + +(deftest row-major-aref.2 + (loop for i from 0 to 5 collect (row-major-aref #2a((a b c d)(e f g h)) i)) + (a b c d e f)) + +(deftest row-major-aref.3 + (row-major-aref #0a100 0) + 100) + +(deftest row-major-aref.4 + (loop for i from 0 to 5 collect (row-major-aref #*011100 i)) + (0 1 1 1 0 0)) + +(deftest row-major-aref.5 + (loop for i from 0 to 5 collect (row-major-aref "abcdef" i)) + (#\a #\b #\c #\d #\e #\f)) + +(deftest row-major-aref.6 + (let ((a (make-array nil :initial-element 'x))) + (values + (aref a) + (setf (row-major-aref a 0) 'y) + (aref a) + a)) + x y y #0ay) + +(deftest row-major-aref.7 + (let ((a (make-array '(4) :initial-element 'x))) + (values + (aref a 0) + (aref a 1) + (aref a 2) + (aref a 3) + (setf (row-major-aref a 0) 'a) + (setf (row-major-aref a 1) 'b) + (setf (row-major-aref a 2) 'c) + a)) + x x x x a b c #(a b c x)) + +(deftest row-major-aref.8 + (let ((a (make-array '(4) :element-type 'base-char + :initial-element #\x))) + (values + (aref a 0) + (aref a 1) + (aref a 2) + (aref a 3) + (setf (row-major-aref a 0) #\a) + (setf (row-major-aref a 1) #\b) + (setf (row-major-aref a 2) #\c) + a)) + #\x #\x #\x #\x #\a #\b #\c "abcx") + +(deftest row-major-aref.9 + (let ((a (make-array '(4) :initial-element 0 + :element-type 'bit))) + (values + (aref a 0) + (aref a 1) + (aref a 2) + (aref a 3) + (setf (row-major-aref a 0) 1) + (setf (row-major-aref a 1) 1) + (setf (row-major-aref a 3) 1) + a)) + 0 0 0 0 1 1 1 #*1101) + +(deftest row-major-aref.10 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d)(e f g h)(i j k l)) + ((m n o p)(q r s t)(u v w x)))))) + (loop for i from 0 to 23 collect (row-major-aref a i))) + (a b c d e f g h i j k l m n o p q r s t u v w x)) + +(deftest row-major-aref.order.1 + (let ((i 0) x y) + (values + (row-major-aref + (progn (setf x (incf i)) #(a b c d e f)) + (progn (setf y (incf i)) 2)) + i x y)) + c 2 1 2) + +(deftest row-major-aref.order.2 + (let ((i 0) x y z + (a (copy-seq #(a b c d e f)))) + (values + (setf + (row-major-aref + (progn (setf x (incf i)) a) + (progn (setf y (incf i)) 2)) + (progn (setf z (incf i)) 'w)) + a i x y z)) + w #(a b w d e f) 3 1 2 3) + +;;; Error tests + +(deftest row-major-aref.error.1 + (classify-error (row-major-aref)) + program-error) diff --git a/ansi-tests/rt-acl.system b/ansi-tests/rt-acl.system new file mode 100644 index 0000000..d9cfc7f --- /dev/null +++ b/ansi-tests/rt-acl.system @@ -0,0 +1,12 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 7 23:30:22 1998 +;;;; Contains: Allegro CL defsystem for RT testing system + +(defsystem :rt-acl + (:default-pathname #.(directory-namestring (truename *LOAD-PATHNAME*)) + :default-file-type "lsp") + (:definitions + "rt-package" + "rt")) + diff --git a/ansi-tests/rt-doc.txt b/ansi-tests/rt-doc.txt new file mode 100644 index 0000000..8c07b8d --- /dev/null +++ b/ansi-tests/rt-doc.txt @@ -0,0 +1,194 @@ + +#|----------------------------------------------------------------------------| + | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. | + | | + | Permission to use, copy, modify, and distribute this software and its | + | documentation for any purpose and without fee is hereby granted, provided | + | that this copyright and permission notice appear in all copies and | + | supporting documentation, and that the name of M.I.T. not be used in | + | advertising or publicity pertaining to distribution of the software | + | without specific, written prior permission. M.I.T. makes no | + | representations about the suitability of this software for any purpose. | + | It is provided "as is" without express or implied warranty. | + | | + | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING | + | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL | + | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR | + | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, | + | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, | + | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS | + | SOFTWARE. | + |----------------------------------------------------------------------------|# + + (This is the December 19, 1990 version of brief documentation for the + RT regression tester. A more complete discussion can be found in + the article in Lisp Pointers.) + +The functions, macros, and variables that make up the RT regression tester are +in a package called "RT". The ten exported symbols are documented below. If +you want to refer to these symbols without a package prefix, you have to `use' +the package. + +The basic unit of concern of RT is the test. Each test has an identifying name +and a body that specifies the action of the test. Functions are provided for +defining, redefining, removing, and performing individual tests and the test +suite as a whole. In addition, information is maintained about which tests have +succeeded and which have failed. + + +<> deftest NAME FORM &rest VALUES + +Individual tests are defined using the macro DEFTEST. The identifying NAME is +typically a number or symbol, but can be any Lisp form. If the test suite +already contains a test with the same (EQUAL) NAME, then this test is redefined +and a warning message printed. (This warning is important to alert the user +when a test suite definition file contains two tests with the same name.) When +the test is a new one, it is added to the end of the suite. In either case, +NAME is returned as the value of DEFTEST and stored in the variable *TEST*. + +(deftest t-1 (floor 15/7) 2 1/7) => t-1 + +(deftest (t 2) (list 1) (1)) => (t 2) + +(deftest bad (1+ 1) 1) => bad + +(deftest good (1+ 1) 2) => good + +The FORM can be any kind of Lisp form. The zero or more VALUES can be any kind +of Lisp objects. The test is performed by evaluating FORM and comparing the +results with the VALUES. The test succeeds if and only if FORM produces the +correct number of results and each one is EQUAL to the corresponding VALUE. + + +<> *test* NAME-OF-CURRENT-TEST + +The variable *TEST* contains the name of the test most recently defined or +performed. It is set by DEFTEST and DO-TEST. + + +<> do-test &optional (NAME *TEST*) + +The function DO-TEST performs the test identified by NAME, which defaults to +*TEST*. Before running the test, DO-TEST stores NAME in the variable *TEST*. +If the test succeeds, DO-TEST returns NAME as its value. If the test fails, +DO-TEST returns NIL, after printing an error report on *STANDARD-OUTPUT*. The +following examples show the results of performing two of the tests defined +above. + +(do-test '(t 2)) => (t 2) + +(do-test 'bad) => nil ; after printing: +Test BAD failed +Form: (1+ 1) +Expected value: 1 +Actual value: 2. + + +<> *do-tests-when-defined* default value NIL + +If the value of this variable is non-null, each test is performed at the moment +that it is defined. This is helpful when interactively constructing a suite of +tests. However, when loading a test suite for later use, performing tests as +they are defined is not liable to be helpful. + + +<> get-test &optional (NAME *TEST*) + +This function returns the NAME, FORM, and VALUES of the specified test. + +(get-test '(t 2)) => ((t 2) (list 1) (1)) + + +<> rem-test &optional (NAME *TEST*) + +If the indicated test is in the test suite, this function removes it and returns +NAME. Otherwise, NIL is returned. + + +<> rem-all-tests + +This function reinitializes RT by removing every test from the test suite and +returns NIL. Generally, it is advisable for the whole test suite to apply to +some one system. When switching from testing one system to testing another, it +is wise to remove all the old tests before beginning to define new ones. + + +<> do-tests &optional (OUT *STANDARD-OUTPUT*) + +This function uses DO-TEST to run each of the tests in the test suite and prints +a report of the results on OUT, which can either be an output stream or the name +of a file. If OUT is omitted, it defaults to *STANDARD-OUTPUT*. DO-TESTS +returns T if every test succeeded and NIL if any test failed. + +As illustrated below, the first line of the report produced by DO-TEST shows how +many tests need to be performed. The last line shows how many tests failed and +lists their names. While the tests are being performed, DO-TESTS prints the +names of the successful tests and the error reports from the unsuccessful tests. + +(do-tests "report.txt") => nil +; the file "report.txt" contains: +Doing 4 pending tests of 4 tests total. + T-1 (T 2) +Test BAD failed +Form: (1+ 1) +Expected value: 1 +Actual value: 2. + GOOD +1 out of 4 total tests failed: BAD. + +It is best if the individual tests in the suite are totally independent of each +other. However, should the need arise for some interdependence, you can rely on +the fact that DO-TESTS will run tests in the order they were originally defined. + + +<> pending-tests + +When a test is defined or redefined, it is marked as pending. In addition, +DO-TEST marks the test to be run as pending before running it and DO-TESTS marks +every test as pending before running any of them. The only time a test is +marked as not pending is when it completes successfully. The function +PENDING-TESTS returns a list of the names of the currently pending tests. + +(pending-tests) => (bad) + + +<> continue-testing + +This function is identical to DO-TESTS except that it only runs the tests that +are pending and always writes its output on *STANDARD-OUTPUT*. + +(continue-testing) => nil ; after printing: +Doing 1 pending test out of 4 total tests. +Test BAD failed +Form: (1+ 1) +Expected value: 1 +Actual value: 2. +1 out of 4 total tests failed: BAD. + +CONTINUE-TESTING has a special meaning if called at a breakpoint generated while +a test is being performed. The failure of a test to return the correct value +does not trigger an error break. However, there are many kinds of things that +can go wrong while a test is being performed (e.g., dividing by zero) that will +cause breaks. + +If CONTINUE-TESTING is evaluated in a break generated during testing, it aborts +the current test (which remains pending) and forces the processing of tests to +continue. Note that in such a breakpoint, *TEST* is bound to the name of the +test being performed and (GET-TEST) can be used to look at the test. + +When building a system, it is advisable to start constructing a test suite for +it as soon as possible. Since individual tests are rather weak, a comprehensive +test suite requires large numbers of tests. However, these can be accumulated +over time. In particular, whenever a bug is found by some means other than +testing, it is wise to add a test that would have found the bug and therefore +will ensure that the bug will not reappear. + +Every time the system is changed, the entire test suite should be run to make +sure that no unintended changes have occurred. Typically, some tests will fail. +Sometimes, this merely means that tests have to be changed to reflect changes in +the system's specification. Other times, it indicates bugs that have to be +tracked down and fixed. During this phase, CONTINUE-TESTING is useful for +focusing on the tests that are failing. However, for safety sake, it is always +wise to reinitialize RT, redefine the entire test suite, and run DO-TESTS one +more time after you think all of the tests are working. + diff --git a/ansi-tests/rt-package.lsp b/ansi-tests/rt-package.lsp new file mode 100644 index 0000000..dd4d4ec --- /dev/null +++ b/ansi-tests/rt-package.lsp @@ -0,0 +1,25 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Dec 17 21:10:53 2002 +;;;; Contains: Package definition for RT + +(eval-when + ;;(:execute :compile-toplevel :load-toplevel) + (load eval compile) + (defpackage :regression-test + (:use :cl) + (:nicknames :rtest #-lispworks :rt) + (:export + #:*do-tests-when-defined* + #:*test* + #:continue-testing + #:deftest + #:do-test + #:do-tests + #:get-test + #:pending-tests + #:rem-all-tests + #:rem-test + ))) + +(in-package :regression-test) diff --git a/ansi-tests/rt-test.lsp b/ansi-tests/rt-test.lsp new file mode 100644 index 0000000..73a87be --- /dev/null +++ b/ansi-tests/rt-test.lsp @@ -0,0 +1,229 @@ +;-*-syntax:COMMON-LISP-*- + +#|----------------------------------------------------------------------------| + | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. | + | | + | Permission to use, copy, modify, and distribute this software and its | + | documentation for any purpose and without fee is hereby granted, provided | + | that this copyright and permission notice appear in all copies and | + | supporting documentation, and that the name of M.I.T. not be used in | + | advertising or publicity pertaining to distribution of the software | + | without specific, written prior permission. M.I.T. makes no | + | representations about the suitability of this software for any purpose. | + | It is provided "as is" without express or implied warranty. | + | | + | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING | + | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL | + | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR | + | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, | + | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, | + | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS | + | SOFTWARE. | + |----------------------------------------------------------------------------|# + +;This is the December 19, 1990 version of a set of tests that use the +;RT regression tester to test itself. See the documentation of RT for +;a discusion of how to use this file. + +(in-package :user) +;; (require "RT") +(use-package :regression-test) + +(defmacro setup (&rest body) + `(do-setup '(progn ., body))) + +(defun do-setup (form) + (let ((*test* nil) + (*do-tests-when-defined* nil) + (regression-test::*entries* (list nil)) + (regression-test::*in-test* nil) + (regression-test::*debug* t) + result) + (deftest t1 4 4) + (deftest (t 2) 4 3) + (values-list + (cons (normalize + (with-output-to-string (*standard-output*) + (setq result + (multiple-value-list + (catch 'regression-test::*debug* (eval form)))))) + result)))) + +(defun normalize (string) + (with-input-from-string (s string) + (normalize-stream s))) + +(defvar *file-name* nil) + +(defun get-file-name () + (loop (if *file-name* (return *file-name*)) + (format *error-output* + "~%Type a string representing naming of a scratch disk file: ") + (setq *file-name* (read)) + (if (not (stringp *file-name*)) (setq *file-name* nil)))) + +(get-file-name) + +(defmacro with-temporary-file (f &body forms) + `(let ((,f *file-name*)) + ,@ forms + (get-file-output ,f))) + +(defun get-file-output (f) + (prog1 (with-open-file (in f) + (normalize-stream in)) + (delete-file f))) + +(defun normalize-stream (s) + (let ((l nil)) + (loop (push (read-line s nil s) l) + (when (eq (car l) s) + (setq l (nreverse (cdr l))) + (return nil))) + (delete "" l :test #'equal))) + +(rem-all-tests) + +(deftest deftest-1 + (setup (deftest t1 3 3) (values (get-test 't1) *test* (pending-tests))) + ("Redefining test T1") (t1 3 3) t1 (t1 (t 2))) +(deftest deftest-2 + (setup (deftest (t 2) 3 3) (get-test '(t 2))) + ("Redefining test (T 2)") ((t 2) 3 3)) +(deftest deftest-3 + (setup (deftest 2 3 3) (values (get-test 2) *test* (pending-tests))) + () (2 3 3) 2 (t1 (t 2) 2)) +(deftest deftest-4 + (setup (let ((*do-tests-when-defined* t)) (deftest (temp) 4 3))) + ("Test (TEMP) failed" + "Form: 4" + "Expected value: 3" + "Actual value: 4.") + (temp)) + +(deftest do-test-1 + (setup (values (do-test 't1) *test* (pending-tests))) + () t1 t1 ((t 2))) +(deftest do-test-2 + (setup (values (do-test '(t 2)) (pending-tests))) + ("Test (T 2) failed" + "Form: 4" + "Expected value: 3" + "Actual value: 4.") nil (t1 (t 2))) +(deftest do-test-3 + (setup (let ((*test* 't1)) (do-test))) + () t1) + +(deftest get-test-1 + (setup (values (get-test 't1) *test*)) + () (t1 4 4) (t 2)) +(deftest get-test-2 + (setup (get-test '(t 2))) + () ((t 2) 4 3)) +(deftest get-test-3 + (setup (let ((*test* 't1)) (get-test))) + () (t1 4 4)) +(deftest get-test-4 + (setup (deftest t3 1 1) (get-test)) + () (t3 1 1)) +(deftest get-test-5 + (setup (get-test 't0)) + ("No test with name T0.") nil) + +(deftest rem-test-1 + (setup (values (rem-test 't1) (pending-tests))) + () t1 ((t 2))) +(deftest rem-test-2 + (setup (values (rem-test '(t 2)) (pending-tests))) + () (t 2) (t1)) +(deftest rem-test-3 + (setup (let ((*test* '(t 2))) (rem-test)) (pending-tests)) + () (t1)) +(deftest rem-test-4 + (setup (values (rem-test 't0) (pending-tests))) + () nil (t1 (t 2))) +(deftest rem-test-5 + (setup (rem-all-tests) (rem-test 't0) (pending-tests)) + () ()) + +(deftest rem-all-tests-1 + (setup (values (rem-all-tests) (pending-tests))) + () nil nil) +(deftest rem-all-tests-2 + (setup (rem-all-tests) (rem-all-tests) (pending-tests)) + () nil) + +(deftest do-tests-1 + (setup (let ((*print-case* :downcase)) + (values (do-tests) (continue-testing) (do-tests)))) + ("Doing 2 pending tests of 2 tests total." + " T1" + "Test (T 2) failed" + "Form: 4" + "Expected value: 3" + "Actual value: 4." + "1 out of 2 total tests failed: (T 2)." + "Doing 1 pending test of 2 tests total." + "Test (T 2) failed" + "Form: 4" + "Expected value: 3" + "Actual value: 4." + "1 out of 2 total tests failed: (T 2)." + "Doing 2 pending tests of 2 tests total." + " T1" + "Test (T 2) failed" + "Form: 4" + "Expected value: 3" + "Actual value: 4." + "1 out of 2 total tests failed: (T 2).") + nil + nil + nil) + +(deftest do-tests-2 + (setup (rem-test '(t 2)) + (deftest (t 2) 3 3) + (values (do-tests) (continue-testing) (do-tests))) + ("Doing 2 pending tests of 2 tests total." + " T1 (T 2)" + "No tests failed." + "Doing 0 pending tests of 2 tests total." + "No tests failed." + "Doing 2 pending tests of 2 tests total." + " T1 (T 2)" + "No tests failed.") + t + t + t) +(deftest do-tests-3 + (setup (rem-all-tests) (values (do-tests) (continue-testing))) + ("Doing 0 pending tests of 0 tests total." + "No tests failed." + "Doing 0 pending tests of 0 tests total." + "No tests failed.") + t + t) +(deftest do-tests-4 + (setup (normalize (with-output-to-string (s) (do-tests s)))) + () + ("Doing 2 pending tests of 2 tests total." + " T1" + "Test (T 2) failed" + "Form: 4" + "Expected value: 3" + "Actual value: 4." + "1 out of 2 total tests failed: (T 2).")) +(deftest do-tests-5 + (setup (with-temporary-file s (do-tests s))) + () + ("Doing 2 pending tests of 2 tests total." + " T1" + "Test (T 2) failed" + "Form: 4" + "Expected value: 3" + "Actual value: 4." + "1 out of 2 total tests failed: (T 2).")) + +(deftest continue-testing-1 + (setup (deftest temp (continue-testing) 5) (do-test 'temp) (pending-tests)) + () (t1 (t 2) temp)) diff --git a/ansi-tests/rt.lsp b/ansi-tests/rt.lsp new file mode 100644 index 0000000..e52c991 --- /dev/null +++ b/ansi-tests/rt.lsp @@ -0,0 +1,436 @@ +;-*-syntax:COMMON-LISP;Package:(RT :use "COMMON-LISP" :colon-mode :external)-*- + +#|----------------------------------------------------------------------------| + | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. | + | | + | Permission to use, copy, modify, and distribute this software and its | + | documentation for any purpose and without fee is hereby granted, provided | + | that this copyright and permission notice appear in all copies and | + | supporting documentation, and that the name of M.I.T. not be used in | + | advertising or publicity pertaining to distribution of the software | + | without specific, written prior permission. M.I.T. makes no | + | representations about the suitability of this software for any purpose. | + | It is provided "as is" without express or implied warranty. | + | | + | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING | + | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL | + | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR | + | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, | + | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, | + | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS | + | SOFTWARE. | + |----------------------------------------------------------------------------|# + +;This was the December 19, 1990 version of the regression tester, but +;has since been modified. + +(in-package :regression-test) + +(declaim (ftype (function (t) t) get-entry expanded-eval do-entries)) +(declaim (type list *entries*)) +(declaim (ftype (function (t &rest t) t) report-error)) +(declaim (ftype (function (t &optional t) t) do-entry)) + +(defvar *test* nil "Current test name") +(defvar *do-tests-when-defined* nil) +(defvar *entries* (list nil) "Test database. Has a leading dummy cell that does not contain an entry.") +(defvar *entries-tail* *entries* "Tail of the *entries* list") +(defvar *entries-table* (make-hash-table :test #'equal) + "Map the names of entries to the cons cell in *entries* that precedes the one whose car is the entry.") +(defvar *in-test* nil "Used by TEST") +(defvar *debug* nil "For debugging") +(defvar *catch-errors* t "When true, causes errors in a test to be caught.") +(defvar *print-circle-on-failure* nil + "Failure reports are printed with *PRINT-CIRCLE* bound to this value.") + +(defvar *compile-tests* nil "When true, compile the tests before running them.") +(defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.") +(defvar *optimization-settings* '((safety 3))) + +(defvar *failed-tests* nil "After DO-TESTS, becomes the list of names of tests that have failed") +(defvar *passed-tests* nil "After DO-TESTS, becomes the list of names of tests that have passed") + +(defvar *expected-failures* nil + "A list of test names that are expected to fail.") + +(defvar *notes* (make-hash-table :test 'equal) + "A mapping from names of notes to note objects.") + +(defstruct (entry (:conc-name nil)) + pend name props form vals) + +;;; Note objects are used to attach information to tests. +;;; A typical use is to mark tests that depend on a particular +;;; part of a set of requirements, or a particular interpretation +;;; of the requirements. + +(defstruct note + name + contents + disabled ;; When true, tests with this note are considered inactive + ) + +;; (defmacro vals (entry) `(cdddr ,entry)) + +(defmacro defn (entry) + (let ((var (gensym))) + `(let ((,var ,entry)) + (list* (name ,var) (form ,var) (vals ,var))))) + +(defun entry-notes (entry) + (let* ((props (props entry)) + (notes (getf props :notes))) + (if (listp notes) + notes + (list notes)))) + +(defun has-disabled-note (entry) + (let ((notes (entry-notes entry))) + (loop for n in notes + for note = (if (note-p n) n + (gethash n *notes*)) + thereis (and note (note-disabled note))))) + +(defun has-note (entry note) + (unless (note-p note) + (let ((new-note (gethash note *notes*))) + (setf note new-note))) + (and note (not (not (member note (entry-notes entry)))))) + +(defun pending-tests () + (loop for entry in (cdr *entries*) + when (and (pend entry) (not (has-disabled-note entry))) + collect (name entry))) + +(defun rem-all-tests () + (setq *entries* (list nil)) + (setq *entries-tail* *entries*) + (clrhash *entries-table*) + nil) + +(defun rem-test (&optional (name *test*)) + (let ((pred (gethash name *entries-table*))) + (when pred + (if (null (cddr pred)) + (setq *entries-tail* pred) + (setf (gethash (name (caddr pred)) *entries-table*) pred)) + (setf (cdr pred) (cddr pred)) + (remhash name *entries-table*) + name))) + +(defun get-test (&optional (name *test*)) + (defn (get-entry name))) + +(defun get-entry (name) + (let ((entry ;; (find name (the list (cdr *entries*)) + ;; :key #'name :test #'equal) + (cadr (gethash name *entries-table*)) + )) + (when (null entry) + (report-error t + "~%No test with name ~:@(~S~)." + name)) + entry)) + +(defmacro deftest (name &rest body) + (let* ((p body) + (properties + (loop while (keywordp (first p)) + unless (cadr p) + do (error "Poorly formed deftest: ~A~%" + (list* 'deftest name body)) + append (list (pop p) (pop p)))) + (form (pop p)) + (vals p)) + `(add-entry (make-entry :pend t + :name ',name + :props ',properties + :form ',form + :vals ',vals)))) + +(defun add-entry (entry) + (setq entry (copy-entry entry)) + (let* ((pred (gethash (name entry) *entries-table*))) + (cond + (pred + (setf (cadr pred) entry) + (report-error nil + "Redefining test ~:@(~S~)" + (name entry))) + (t + (setf (gethash (name entry) *entries-table*) *entries-tail*) + (setf (cdr *entries-tail*) (cons entry nil)) + (setf *entries-tail* (cdr *entries-tail*)) + ))) + (when *do-tests-when-defined* + (do-entry entry)) + (setq *test* (name entry))) + +(defun report-error (error? &rest args) + (cond (*debug* + (apply #'format t args) + (if error? (throw '*debug* nil))) + (error? (apply #'error args)) + (t (apply #'warn args))) + nil) + +(defun do-test (&optional (name *test*) &rest key-args) + (flet ((%parse-key-args + (&key + ((:catch-errors *catch-errors*) *catch-errors*) + ((:compile *compile-tests*) *compile-tests*)) + (do-entry (get-entry name)))) + (apply #'%parse-key-args key-args))) + +(defun my-aref (a &rest args) + (apply #'aref a args)) + +(defun my-row-major-aref (a index) + (row-major-aref a index)) + +(defun equalp-with-case (x y) + "Like EQUALP, but doesn't do case conversion of characters. + Currently doesn't work on arrays of dimension > 2." + (cond + ((eq x y) t) + ((consp x) + (and (consp y) + (equalp-with-case (car x) (car y)) + (equalp-with-case (cdr x) (cdr y)))) + ((and (typep x 'array) + (= (array-rank x) 0)) + (equalp-with-case (my-aref x) (my-aref y))) + ((typep x 'vector) + (and (typep y 'vector) + (let ((x-len (length x)) + (y-len (length y))) + (and (eql x-len y-len) + (loop + for i from 0 below x-len + for e1 = (my-aref x i) + for e2 = (my-aref y i) + always (equalp-with-case e1 e2)))))) + ((and (typep x 'array) + (typep y 'array) + (not (equal (array-dimensions x) + (array-dimensions y)))) + nil) + + ((typep x 'array) + (and (typep y 'array) + (let ((size (array-total-size x))) + (loop for i from 0 below size + always (equalp-with-case (my-row-major-aref x i) + (my-row-major-aref y i)))))) + ((typep x 'pathname) + (equal x y)) + (t (eql x y)))) + +(defun do-entry (entry &optional + (s *standard-output*)) + (catch '*in-test* + (setq *test* (name entry)) + (setf (pend entry) t) + (let* ((*in-test* t) + ;; (*break-on-warnings* t) + (aborted nil) + r) + ;; (declare (special *break-on-warnings*)) + + (block aborted + (setf r + (flet ((%do () + (handler-bind + #-sbcl nil + #+sbcl ((sb-ext:code-deletion-note #'(lambda (c) + (if (has-note entry :do-not-muffle) + nil + (muffle-warning c))))) + (cond + (*compile-tests* + (multiple-value-list + (funcall (compile + nil + `(lambda () + (declare + (optimize ,@*optimization-settings*)) + ,(form entry)))))) + (*expanded-eval* + (multiple-value-list + (expanded-eval (form entry)))) + (t + (multiple-value-list + (eval (form entry)))))))) + (if *catch-errors* + (handler-bind + (#-ecl (style-warning #'(lambda (c) (if (has-note entry :do-not-muffle-warnings) + c + (muffle-warning c)))) + (error #'(lambda (c) + (setf aborted t) + (setf r (list c)) + (return-from aborted nil)))) + (%do)) + (%do))))) + + (setf (pend entry) + (or aborted + (not (equalp-with-case r (vals entry))))) + + (when (pend entry) + (let ((*print-circle* *print-circle-on-failure*)) + (format s "~&Test ~:@(~S~) failed~ + ~%Form: ~S~ + ~%Expected value~P: ~ + ~{~S~^~%~17t~}~%" + *test* (form entry) + (length (vals entry)) + (vals entry)) + (handler-case + (let ((st (format nil "Actual value~P: ~ + ~{~S~^~%~15t~}.~%" + (length r) r))) + (format s "~A" st)) + (error () (format s "Actual value: #~%"))) + (finish-output s))))) + (when (not (pend entry)) *test*)) + +(defun expanded-eval (form) + "Split off top level of a form and eval separately. This reduces the chance that + compiler optimizations will fold away runtime computation." + (if (not (consp form)) + (eval form) + (let ((op (car form))) + (cond + ((eq op 'let) + (let* ((bindings (loop for b in (cadr form) + collect (if (consp b) b (list b nil)))) + (vars (mapcar #'car bindings)) + (binding-forms (mapcar #'cadr bindings))) + (apply + (the function + (eval `(lambda ,vars ,@(cddr form)))) + (mapcar #'eval binding-forms)))) + ((and (eq op 'let*) (cadr form)) + (let* ((bindings (loop for b in (cadr form) + collect (if (consp b) b (list b nil)))) + (vars (mapcar #'car bindings)) + (binding-forms (mapcar #'cadr bindings))) + (funcall + (the function + (eval `(lambda (,(car vars) &aux ,@(cdr bindings)) ,@(cddr form)))) + (eval (car binding-forms))))) + ((eq op 'progn) + (loop for e on (cdr form) + do (if (null (cdr e)) (return (eval (car e))) + (eval (car e))))) + ((and (symbolp op) (fboundp op) + (not (macro-function op)) + (not (special-operator-p op))) + (apply (symbol-function op) + (mapcar #'eval (cdr form)))) + (t (eval form)))))) + +(defun continue-testing () + (if *in-test* + (throw '*in-test* nil) + (do-entries *standard-output*))) + +(defun do-tests (&key (out *standard-output*) + ((:catch-errors *catch-errors*) *catch-errors*) + ((:compile *compile-tests*) *compile-tests*)) + (setq *failed-tests* nil + *passed-tests* nil) + (dolist (entry (cdr *entries*)) + (setf (pend entry) t)) + (if (streamp out) + (do-entries out) + (with-open-file + (stream out :direction :output) + (do-entries stream)))) + +(defun do-entries (s) + (format s "~&Doing ~A pending test~:P ~ + of ~A tests total.~%" + (count t (the list (cdr *entries*)) :key #'pend) + (length (cdr *entries*))) + (finish-output s) + (dolist (entry (cdr *entries*)) + (when (and (pend entry) + (not (has-disabled-note entry))) + (let ((success? (do-entry entry s))) + (if success? + (push (name entry) *passed-tests*) + (push (name entry) *failed-tests*)) + (format s "~@[~<~%~:; ~:@(~S~)~>~]" success?)) + (finish-output s) + )) + (let ((pending (pending-tests)) + (expected-table (make-hash-table :test #'equal))) + (dolist (ex *expected-failures*) + (setf (gethash ex expected-table) t)) + (let ((new-failures + (loop for pend in pending + unless (gethash pend expected-table) + collect pend))) + (if (null pending) + (format s "~&No tests failed.") + (progn + (format s "~&~A out of ~A ~ + total tests failed: ~ + ~:@(~{~<~% ~1:;~S~>~ + ~^, ~}~)." + (length pending) + (length (cdr *entries*)) + pending) + (if (null new-failures) + (format s "~&No unexpected failures.") + (when *expected-failures* + (format s "~&~A unexpected failures: ~ + ~:@(~{~<~% ~1:;~S~>~ + ~^, ~}~)." + (length new-failures) + new-failures))) + )) + (finish-output s) + (null pending)))) + +;;; Note handling functions and macros + +(defmacro defnote (name contents &optional disabled) + `(eval-when (:load-toplevel :execute) + (let ((note (make-note :name ',name + :contents ',contents + :disabled ',disabled))) + (setf (gethash (note-name note) *notes*) note) + note))) + +(defun disable-note (n) + (let ((note (if (note-p n) n + (setf n (gethash n *notes*))))) + (unless note (error "~A is not a note or note name." n)) + (setf (note-disabled note) t) + note)) + +(defun enable-note (n) + (let ((note (if (note-p n) n + (setf n (gethash n *notes*))))) + (unless note (error "~A is not a note or note name." n)) + (setf (note-disabled note) nil) + note)) + +;;; Extended random regression + +(defun do-extended-tests (&key (tests *passed-tests*) (count nil) + ((:catch-errors *catch-errors*) *catch-errors*) + ((:compile *compile-tests*) *compile-tests*)) + "Execute randomly chosen tests from TESTS until one fails or until + COUNT is an integer and that many tests have been executed." + (let ((test-vector (coerce tests 'simple-vector))) + (let ((n (length test-vector))) + (when (= n 0) (error "Must provide at least one test.")) + (loop for i from 0 + for name = (svref test-vector (random n)) + until (eql i count) + do (print name) + unless (do-test name) return (values name (1+ i)))))) diff --git a/ansi-tests/rt.system b/ansi-tests/rt.system new file mode 100644 index 0000000..e0cce97 --- /dev/null +++ b/ansi-tests/rt.system @@ -0,0 +1,22 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 7 23:30:22 1998 +;;;; Contains: Portable defsystem for RT testing system + +(mk::defsystem "rt" + :source-pathname #.(directory-namestring *LOAD-TRUENAME*) + :binary-pathname #.(mk::append-directories + (directory-namestring *LOAD-TRUENAME*) + "binary/") + :source-extension "lsp" + :binary-extension + #+CMU #.(C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*) + #+ALLEGRO "fasl" + #+(OR AKCL GCL) "o" + #+CLISP "fas" + #-(OR CMU ALLEGRO AKCL GCL CLISP) + #.(pathname-type (compile-file-pathname "foo.lisp")) + :components + ( + "rt-package" + ("rt" :depends-on ("rt-package")))) diff --git a/ansi-tests/sbit.lsp b/ansi-tests/sbit.lsp new file mode 100644 index 0000000..f657f59 --- /dev/null +++ b/ansi-tests/sbit.lsp @@ -0,0 +1,95 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 15:30:31 2003 +;;;; Contains: Tests for SBIT + +(in-package :cl-test) + +(deftest sbit.1 + (sbit #*0010 2) + 1) + +(deftest sbit.2 + (let ((a #*00000000)) + (loop for i from 0 below (length a) + collect (let ((b (copy-seq a))) + (setf (sbit b i) 1) + b))) + (#*10000000 + #*01000000 + #*00100000 + #*00010000 + #*00001000 + #*00000100 + #*00000010 + #*00000001)) + +(deftest sbit.3 + (let ((a #*11111111)) + (loop for i from 0 below (length a) + collect (let ((b (copy-seq a))) + (setf (sbit b i) 0) + b))) + (#*01111111 + #*10111111 + #*11011111 + #*11101111 + #*11110111 + #*11111011 + #*11111101 + #*11111110)) + +(deftest sbit.4 + (let ((a (make-array nil :element-type 'bit :initial-element 0))) + (values + (aref a) + (sbit a) + (setf (sbit a) 1) + (aref a) + (sbit a))) + 0 0 1 1 1) + +(deftest sbit.5 + (let ((a (make-array '(1 1) :element-type 'bit :initial-element 0))) + (values + (aref a 0 0) + (sbit a 0 0) + (setf (sbit a 0 0) 1) + (aref a 0 0) + (sbit a 0 0))) + 0 0 1 1 1) + +(deftest sbit.6 + (let ((a (make-array '(10 10) :element-type 'bit :initial-element 0))) + (values + (aref a 5 5) + (sbit a 5 5) + (setf (sbit a 5 5) 1) + (aref a 5 5) + (sbit a 5 5))) + 0 0 1 1 1) + +(deftest sbit.order.1 + (let ((i 0) a b) + (values + (sbit (progn (setf a (incf i)) #*001001) + (progn (setf b (incf i)) 1)) + i a b)) + 0 2 1 2) + +(deftest sbit.order.2 + (let ((i 0) a b c + (v (copy-seq #*001001))) + (values + (setf (sbit (progn (setf a (incf i)) v) + (progn (setf b (incf i)) 1)) + (progn (setf c (incf i)) 1)) + v i a b c)) + 1 #*011001 3 1 2 3) + +(deftest sbit.error.1 + (classify-error (sbit)) + program-error) + + + \ No newline at end of file diff --git a/ansi-tests/search-aux.lsp b/ansi-tests/search-aux.lsp new file mode 100644 index 0000000..129a794 --- /dev/null +++ b/ansi-tests/search-aux.lsp @@ -0,0 +1,92 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 24 07:22:10 2002 +;;;; Contains: Aux. functions for testing SEARCH + +(in-package :cl-test) + +(defparameter *searched-list* + '(b b a b b b b b b b a b a b b b a b a b b b a a a a b a a b a a a a a + a b a b b a b a a b a a a b b a a b a a a a b b a b a b a a a b a b + b a b a a b b b b b a a a a a b a b b b b b a b a b b a b a b)) + +(defparameter *pattern-sublists* + (remove-duplicates + (let* ((s *searched-list*) (len (length s))) + (loop for x from 0 to 8 nconc + (loop for y from 0 to (- len x) + collect (subseq s y (+ y x))))) + :test #'equal)) + +(defparameter *searched-vector* + (make-array (length *searched-list*) + :initial-contents *searched-list*)) + +(defparameter *pattern-subvectors* + (mapcar #'(lambda (x) (apply #'vector x)) *pattern-sublists*)) + +(defparameter *searched-bitvector* + #*1101111111010111010111000010010000001011010010001100100001101010001011010011111000001011111010110101) + +(defparameter *pattern-subbitvectors* + (remove-duplicates + (let* ((s *searched-bitvector*) (len (length s))) + (loop for x from 0 to 8 nconc + (loop for y from 0 to (- len x) + collect (subseq s y (+ y x))))) + :test #'equalp)) + +(defparameter *searched-string* + "1101111111010111010111000010010000001011010010001100100001101010001011010011111000001011111010110101") + +(defparameter *pattern-substrings* + (remove-duplicates + (let* ((s *searched-string*) (len (length s))) + (loop for x from 0 to 8 nconc + (loop for y from 0 to (- len x) + collect (subseq s y (+ y x))))) + :test #'equalp)) + +(defun subseq-equalp (seq1 seq2 start1 start2 len &key (test #'equalp)) + (assert + (and + (>= start1 0) + (>= start2 0) + (<= (+ start1 len) (length seq1)) + (<= (+ start2 len) (length seq2)))) + (if (and (listp seq1) (listp seq2)) + (loop for i from 0 to (1- len) + for e1 in (nthcdr start1 seq1) + for e2 in (nthcdr start2 seq2) + always (funcall test e1 e2)) + (loop for i from 0 to (1- len) + always + (funcall test + (elt seq1 (+ start1 i)) + (elt seq2 (+ start2 i)))))) + +(defun search-check (pattern searched pos + &key (start1 0) (end1 nil) (start2 0) (end2 nil) + key from-end (test #'equalp)) + (unless end1 (setq end1 (length pattern))) + (unless end2 (setq end2 (length searched))) + (assert (<= start1 end1)) + (assert (<= start2 end2)) + (let* ((plen (- end1 start1))) + (when key + (setq pattern (map 'list key pattern)) + (setq searched (map 'list key searched))) + (if pos + (and + (subseq-equalp searched pattern pos start1 plen :test test) + (if from-end + (loop for i from (1+ pos) to (- end2 plen) + never + (subseq-equalp searched pattern i start1 plen :test test)) + (loop for i from start2 to (1- pos) + never + (subseq-equalp searched pattern i start1 plen :test test)))) + (loop for i from start2 to (- end2 plen) + never (subseq-equalp searched pattern i start1 plen :test test))))) + + diff --git a/ansi-tests/search-bitvector.lsp b/ansi-tests/search-bitvector.lsp new file mode 100644 index 0000000..4080812 --- /dev/null +++ b/ansi-tests/search-bitvector.lsp @@ -0,0 +1,176 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Aug 25 13:06:54 2002 +;;;; Contains: Tests for SEARCH on bit vectors + +(in-package :cl-test) + +(deftest search-bitvector.1 + (let ((target *searched-bitvector*) + (pat #(a))) + (loop for i from 0 to (1- (length target)) + for tail on target + always + (let ((pos (search pat tail))) + (search-check pat tail pos)))) + t) + +(deftest search-bitvector.2 + (let ((target *searched-bitvector*) + (pat #(a))) + (loop for i from 1 to (length target) + always + (let ((pos (search pat target :end2 i :from-end t))) + (search-check pat target pos :end2 i :from-end t)))) + t) + +(deftest search-bitvector.3 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target) + unless (search-check pat target pos) + collect pat)) + nil) + +(deftest search-bitvector.4 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target :from-end t) + unless (search-check pat target pos :from-end t) + collect pat)) + nil) + +(deftest search-bitvector.5 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target :start2 25 :end2 75) + unless (search-check pat target pos :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-bitvector.6 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target :from-end t :start2 25 :end2 75) + unless (search-check pat target pos :from-end t + :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-bitvector.7 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target :start2 20) + unless (search-check pat target pos :start2 20) + collect pat)) + nil) + +(deftest search-bitvector.8 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target :from-end t :start2 20) + unless (search-check pat target pos :from-end t + :start2 20) + collect pat)) + nil) + +(deftest search-bitvector.9 + (let ((target *searched-bitvector*)) + (loop for pat in (mapcar #'(lambda (x) + (map 'vector + #'(lambda (y) + (sublis '((a . 2) (b . 3)) y)) + x)) + *pattern-sublists*) + for pos = (search pat target :start2 20 :key #'evenp) + unless (search-check pat target pos :start2 20 :key #'evenp) + collect pat)) + nil) + +(deftest search-bitvector.10 + (let ((target *searched-bitvector*)) + (loop for pat in (mapcar #'(lambda (x) + (map 'vector + #'(lambda (y) + (sublis '((a . 2) (b . 3)) y)) + x)) + *pattern-sublists*) + for pos = (search pat target :from-end t :start2 20 :key 'oddp) + unless (search-check pat target pos :from-end t + :start2 20 :key 'oddp) + collect pat)) + nil) + +(deftest search-bitvector.11 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target :start2 20 :test (complement #'eql)) + unless (search-check pat target pos :start2 20 + :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-bitvector.12 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + for pos = (search pat target :from-end t :start2 20 :test-not #'eql) + unless (search-check pat target pos :from-end t + :start2 20 :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-bitvector.13 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + when (and (> (length pat) 0) + (let ((pos (search pat target :start1 1 + :test (complement #'eql)))) + (not (search-check pat target pos + :start1 1 + :test (complement #'eql))))) + collect pat)) + nil) + +(deftest search-bitvector.14 + (let ((target *searched-bitvector*)) + (loop for pat in *pattern-subbitvectors* + when (let ((len (length pat))) + (and (> len 0) + (let ((pos (search pat target :end1 (1- len) + :test (complement #'eql)))) + (not (search-check pat target pos + :end1 (1- len) + :test (complement #'eql)))))) + collect pat)) + nil) + +(deftest search-bitvector.15 + (let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 0 1 0 1 1) + :fill-pointer 5 + :element-type 'bit))) + (values + (search #*0 a) + (search #*0 a :from-end t) + (search #*01 a) + (search #*01 a :from-end t) + (search #*010 a) + (search #*010 a :from-end t))) + 0 4 0 0 nil nil) + +(deftest search-bitvector.16 + (let ((pat (make-array '(3) :initial-contents '(0 1 0) + :fill-pointer 1)) + (a #*01100)) + (values + (search pat a) + (search pat a :from-end t) + (progn + (setf (fill-pointer pat) 2) + (search pat a)) + (search pat a :from-end t) + (progn + (setf (fill-pointer pat) 3) + (search pat a)) + (search pat a :from-end t))) + 0 4 0 0 nil nil) + diff --git a/ansi-tests/search-list.lsp b/ansi-tests/search-list.lsp new file mode 100644 index 0000000..5dba4fc --- /dev/null +++ b/ansi-tests/search-list.lsp @@ -0,0 +1,251 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 24 07:22:10 2002 +;;;; Contains: Tests for SEARCH on lists + +(in-package :cl-test) + +(deftest search-list.1 + (let ((target *searched-list*) + (pat '(a))) + (loop for i from 0 to (1- (length target)) + for tail on target + always + (let ((pos (search pat tail))) + (search-check pat tail pos)))) + t) + +(deftest search-list.2 + (let ((target *searched-list*) + (pat '(a))) + (loop for i from 1 to (length target) + always + (let ((pos (search pat target :end2 i :from-end t))) + (search-check pat target pos :end2 i :from-end t)))) + t) + +(deftest search-list.3 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target) + unless (search-check pat target pos) + collect pat)) + nil) + +(deftest search-list.4 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :from-end t) + unless (search-check pat target pos :from-end t) + collect pat)) + nil) + +(deftest search-list.5 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :start2 25 :end2 75) + unless (search-check pat target pos :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-list.6 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :from-end t :start2 25 :end2 75) + unless (search-check pat target pos :from-end t + :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-list.7 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :start2 20) + unless (search-check pat target pos :start2 20) + collect pat)) + nil) + +(deftest search-list.8 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :from-end t :start2 20) + unless (search-check pat target pos :from-end t + :start2 20) + collect pat)) + nil) + +(deftest search-list.9 + (let ((target (sublis '((a . 1) (b . 2)) *searched-list*))) + (loop for pat in (sublis '((a . 3) (b . 4)) *pattern-sublists*) + for pos = (search pat target :start2 20 :key #'evenp) + unless (search-check pat target pos :start2 20 :key #'evenp) + collect pat)) + nil) + +(deftest search-list.10 + (let ((target (sublis '((a . 1) (b . 2)) *searched-list*))) + (loop for pat in (sublis '((a . 3) (b . 4)) *pattern-sublists*) + for pos = (search pat target :from-end t :start2 20 :key 'oddp) + unless (search-check pat target pos :from-end t + :start2 20 :key 'oddp) + collect pat)) + nil) + +(deftest search-list.11 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :start2 20 :test (complement #'eql)) + unless (search-check pat target pos :start2 20 + :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-list.12 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :from-end t :start2 20 :test-not #'eql) + unless (search-check pat target pos :from-end t + :start2 20 :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-list.13 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + when (and (> (length pat) 0) + (let ((pos (search pat target :start1 1 + :test (complement #'eql)))) + (not (search-check pat target pos + :start1 1 + :test (complement #'eql))))) + collect pat)) + nil) + +(deftest search-list.14 + (let ((target *searched-list*)) + (loop for pat in *pattern-sublists* + when (let ((len (length pat))) + (and (> len 0) + (let ((pos (search pat target :end1 (1- len) + :test (complement #'eql)))) + (not (search-check pat target pos + :end1 (1- len) + :test (complement #'eql)))))) + collect pat)) + nil) + +;;; Keyword tests + +(deftest search.allow-other-keys.1 + (search '(c d) '(a b c d c d e) :allow-other-keys t) + 2) + +(deftest search.allow-other-keys.2 + (search '(c d) '(a b c d c d e) :allow-other-keys nil) + 2) + +(deftest search.allow-other-keys.3 + (search '(c d) '(a b c d c d e) :bad t :allow-other-keys t) + 2) + +(deftest search.allow-other-keys.4 + (search '(c d) '(a b c d c d e) :allow-other-keys 'foo :bad nil) + 2) + +(deftest search.allow-other-keys.5 + (search '(c d) '(a b c d c d e) :bad1 1 :allow-other-keys t :bad2 2 + :allow-other-keys nil :bad3 3) + 2) + +(deftest search.allow-other-keys.6 + (search '(c d) '(a b c d c d e) :allow-other-keys 'foo + :from-end t) + 4) + +(deftest search.allow-other-keys.7 + (search '(c d) '(a b c d c d e) :from-end t :allow-other-keys t) + 4) + +(deftest search.keywords.8 + (search '(c d) '(a b c d c d e) :start1 0 :start2 0 :start1 1 + :start2 6 :from-end t :from-end nil) + 4) + + +;;; Error cases + +(deftest search.error.1 + (classify-error (search)) + program-error) + +(deftest search.error.2 + (classify-error (search "a")) + program-error) + +(deftest search.error.3 + (classify-error (search "a" "a" :key)) + program-error) + +(deftest search.error.4 + (classify-error (search "a" "a" 'bad t)) + program-error) + +(deftest search.error.5 + (classify-error (search "a" "a" 'bad t :allow-other-keys nil)) + program-error) + +(deftest search.error.6 + (classify-error (search "a" "a" 1 2)) + program-error) + +(deftest search.error.7 + (classify-error (search "c" "abcde" :test #'identity)) + program-error) + +(deftest search.error.8 + (classify-error (search "c" "abcde" :test-not #'identity)) + program-error) + +(deftest search.error.9 + (classify-error (search "c" "abcde" :key #'cons)) + program-error) + +(deftest search.error.10 + (classify-error (search "c" "abcde" :key #'car)) + type-error) + +;;; Order of evaluation + +(deftest search.order.1 + (let ((i 0) a b c d e f g h j) + (values + (search + (progn (setf a (incf i)) '(nil a b nil)) + (progn (setf b (incf i)) '(z z z a a b b z z z)) + :from-end (progn (setf c (incf i)) t) + :start1 (progn (setf d (incf i)) 1) + :end1 (progn (setf e (incf i)) 3) + :start2 (progn (setf f (incf i)) 1) + :end2 (progn (setf g (incf i)) 8) + :key (progn (setf h (incf i)) #'identity) + :test (progn (setf j (incf i)) #'eql) + ) + i a b c d e f g h j)) + 4 9 1 2 3 4 5 6 7 8 9) + +(deftest search.order.2 + (let ((i 0) a b c d e f g h j) + (values + (search + (progn (setf a (incf i)) '(nil a b nil)) + (progn (setf b (incf i)) '(z z z a a b b z z z)) + :test-not (progn (setf c (incf i)) (complement #'eql)) + :key (progn (setf d (incf i)) #'identity) + :end2 (progn (setf e (incf i)) 8) + :start2 (progn (setf f (incf i)) 1) + :end1 (progn (setf g (incf i)) 3) + :start1 (progn (setf h (incf i)) 1) + :from-end (progn (setf j (incf i)) t) + ) + i a b c d e f g h j)) + 4 9 1 2 3 4 5 6 7 8 9) \ No newline at end of file diff --git a/ansi-tests/search-string.lsp b/ansi-tests/search-string.lsp new file mode 100644 index 0000000..243af8d --- /dev/null +++ b/ansi-tests/search-string.lsp @@ -0,0 +1,163 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Aug 25 13:06:54 2002 +;;;; Contains: Tests for SEARCH on strings + +(in-package :cl-test) + +;;; The next test was busted due to to a stupid cut and paste +;;; error. The loop terminates immediately, doing nothing +;;; useful. -- PFD +#| +(deftest search-string.1 + (let ((target *searched-string*) + (pat #(a))) + (loop for i from 0 to (1- (length target)) + for tail on target + always + (let ((pos (search pat tail))) + (search-check pat tail pos)))) + t) +|# + +(deftest search-string.2 + (let ((target *searched-string*) + (pat #(a))) + (loop for i from 1 to (length target) + always + (let ((pos (search pat target :end2 i :from-end t))) + (search-check pat target pos :end2 i :from-end t)))) + t) + +(deftest search-string.3 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target) + unless (search-check pat target pos) + collect pat)) + nil) + +(deftest search-string.4 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target :from-end t) + unless (search-check pat target pos :from-end t) + collect pat)) + nil) + +(deftest search-string.5 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target :start2 25 :end2 75) + unless (search-check pat target pos :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-string.6 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target :from-end t :start2 25 :end2 75) + unless (search-check pat target pos :from-end t + :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-string.7 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target :start2 20) + unless (search-check pat target pos :start2 20) + collect pat)) + nil) + +(deftest search-string.8 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target :from-end t :start2 20) + unless (search-check pat target pos :from-end t + :start2 20) + collect pat)) + nil) + +(deftest search-string.9 + (flet ((%f (x) (case x ((#\0 a) 'c) ((#\1 b) 'd) (t nil)))) + (let ((target *searched-string*)) + (loop for pat in *pattern-sublists* + for pos = (search pat target :start2 20 :key #'%f) + unless (search-check pat target pos :start2 20 :key #'%f) + collect pat))) + nil) + +(deftest search-string.10 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target :start2 20 :test (complement #'eql)) + unless (search-check pat target pos :start2 20 + :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-string.11 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + for pos = (search pat target :from-end t :start2 20 :test-not #'eql) + unless (search-check pat target pos :from-end t + :start2 20 :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-string.13 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + when (and (> (length pat) 0) + (let ((pos (search pat target :start1 1 + :test (complement #'eql)))) + (not (search-check pat target pos + :start1 1 + :test (complement #'eql))))) + collect pat)) + nil) + +(deftest search-string.14 + (let ((target *searched-string*)) + (loop for pat in *pattern-substrings* + when (let ((len (length pat))) + (and (> len 0) + (let ((pos (search pat target :end1 (1- len) + :test (complement #'eql)))) + (not (search-check pat target pos + :end1 (1- len) + :test (complement #'eql)))))) + collect pat)) + nil) + +(deftest search-string.15 + (let ((a (make-array '(10) :initial-contents "abbaaababb" + :fill-pointer 5 + :element-type 'character))) + (values + (search "a" a) + (search "a" a :from-end t) + (search "ab" a) + (search "ab" a :from-end t) + (search "aba" a) + (search "aba" a :from-end t))) + 0 4 0 0 nil nil) + +(deftest search-string.16 + (let ((pat (make-array '(3) :initial-contents '(#\a #\b #\a) + :fill-pointer 1)) + (a "abbaa")) + (values + (search pat a) + (search pat a :from-end t) + (progn + (setf (fill-pointer pat) 2) + (search pat a)) + (search pat a :from-end t) + (progn + (setf (fill-pointer pat) 3) + (search pat a)) + (search pat a :from-end t))) + 0 4 0 0 nil nil) + diff --git a/ansi-tests/search-vector.lsp b/ansi-tests/search-vector.lsp new file mode 100644 index 0000000..6be7d0b --- /dev/null +++ b/ansi-tests/search-vector.lsp @@ -0,0 +1,176 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Aug 25 13:06:54 2002 +;;;; Contains: Tests for SEARCH on vectors + +(in-package :cl-test) + +(deftest search-vector.1 + (let ((target *searched-vector*) + (pat #(a))) + (loop for i from 0 to (1- (length target)) + for tail on target + always + (let ((pos (search pat tail))) + (search-check pat tail pos)))) + t) + +(deftest search-vector.2 + (let ((target *searched-vector*) + (pat #(a))) + (loop for i from 1 to (length target) + always + (let ((pos (search pat target :end2 i :from-end t))) + (search-check pat target pos :end2 i :from-end t)))) + t) + +(deftest search-vector.3 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target) + unless (search-check pat target pos) + collect pat)) + nil) + +(deftest search-vector.4 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target :from-end t) + unless (search-check pat target pos :from-end t) + collect pat)) + nil) + +(deftest search-vector.5 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target :start2 25 :end2 75) + unless (search-check pat target pos :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-vector.6 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target :from-end t :start2 25 :end2 75) + unless (search-check pat target pos :from-end t + :start2 25 :end2 75) + collect pat)) + nil) + +(deftest search-vector.7 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target :start2 20) + unless (search-check pat target pos :start2 20) + collect pat)) + nil) + +(deftest search-vector.8 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target :from-end t :start2 20) + unless (search-check pat target pos :from-end t + :start2 20) + collect pat)) + nil) + +(deftest search-vector.9 + (let ((target (map 'vector #'(lambda (x) (sublis '((a . 1) (b . 2)) x)) + *searched-list*))) + (loop for pat in (mapcar #'(lambda (x) + (map 'vector + #'(lambda (y) + (sublis '((a . 3) (b . 4)) y)) + x)) + *pattern-sublists*) + for pos = (search pat target :start2 20 :key #'evenp) + unless (search-check pat target pos :start2 20 :key #'evenp) + collect pat)) + nil) + +(deftest search-vector.10 + (let ((target (map 'vector #'(lambda (x) (sublis '((a . 1) (b . 2)) x)) + *searched-list*))) + (loop for pat in (mapcar #'(lambda (x) + (map 'vector + #'(lambda (y) + (sublis '((a . 3) (b . 4)) y)) + x)) + *pattern-sublists*) + for pos = (search pat target :from-end t :start2 20 :key 'oddp) + unless (search-check pat target pos :from-end t + :start2 20 :key 'oddp) + collect pat)) + nil) + +(deftest search-vector.11 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target :start2 20 :test (complement #'eql)) + unless (search-check pat target pos :start2 20 + :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-vector.12 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + for pos = (search pat target :from-end t :start2 20 :test-not #'eql) + unless (search-check pat target pos :from-end t + :start2 20 :test (complement #'eql)) + collect pat)) + nil) + +(deftest search-vector.13 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + when (and (> (length pat) 0) + (let ((pos (search pat target :start1 1 + :test (complement #'eql)))) + (not (search-check pat target pos + :start1 1 + :test (complement #'eql))))) + collect pat)) + nil) + +(deftest search-vector.14 + (let ((target *searched-vector*)) + (loop for pat in *pattern-subvectors* + when (let ((len (length pat))) + (and (> len 0) + (let ((pos (search pat target :end1 (1- len) + :test (complement #'eql)))) + (not (search-check pat target pos + :end1 (1- len) + :test (complement #'eql)))))) + collect pat)) + nil) + +(deftest search-vector.15 + (let ((a (make-array '(10) :initial-contents '(a b b a a a b a b b) + :fill-pointer 5))) + (values + (search '(a) a) + (search '(a) a :from-end t) + (search '(a b) a) + (search '(a b) a :from-end t) + (search '(a b a) a) + (search '(a b a) a :from-end t))) + 0 4 0 0 nil nil) + +(deftest search-vector.16 + (let ((pat (make-array '(3) :initial-contents '(a b a) + :fill-pointer 1)) + (a #(a b b a a))) + (values + (search pat a) + (search pat a :from-end t) + (progn + (setf (fill-pointer pat) 2) + (search pat a)) + (search pat a :from-end t) + (progn + (setf (fill-pointer pat) 3) + (search pat a)) + (search pat a :from-end t))) + 0 4 0 0 nil nil) diff --git a/ansi-tests/simple-array-t.lsp b/ansi-tests/simple-array-t.lsp new file mode 100644 index 0000000..255f280 --- /dev/null +++ b/ansi-tests/simple-array-t.lsp @@ -0,0 +1,275 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 07:23:45 2003 +;;;; Contains: Tests of SIMPLE-ARRAY on T element type + +(in-package :cl-test) + +;;; Tests of (simple-array t) + +(deftest simple-array-t.2.1 + (notnot-mv (typep #() '(simple-array t))) + t) + +(deftest simple-array-t.2.2 + (notnot-mv (typep #0aX '(simple-array t))) + t) + +(deftest simple-array-t.2.3 + (notnot-mv (typep #2a(()) '(simple-array t))) + t) + +(deftest simple-array-t.2.4 + (notnot-mv (typep #(1 2 3) '(simple-array t))) + t) + +(deftest simple-array-t.2.5 + (typep "abcd" '(simple-array t)) + nil) + +(deftest simple-array-t.2.6 + (typep #*010101 '(simple-array t)) + nil) + +;;; Tests of (simple-array t ()) + +(deftest simple-array-t.3.1 + (notnot-mv (typep #() '(simple-array t nil))) + nil) + +(deftest simple-array-t.3.2 + (notnot-mv (typep #0aX '(simple-array t nil))) + t) + +(deftest simple-array-t.3.3 + (typep #2a(()) '(simple-array t nil)) + nil) + +(deftest simple-array-t.3.4 + (typep #(1 2 3) '(simple-array t nil)) + nil) + +(deftest simple-array-t.3.5 + (typep "abcd" '(simple-array t nil)) + nil) + +(deftest simple-array-t.3.6 + (typep #*010101 '(simple-array t nil)) + nil) + +;;; Tests of (simple-array t 1) +;;; The '1' indicates rank, so this is equivalent to 'vector' + +(deftest simple-array-t.4.1 + (notnot-mv (typep #() '(simple-array t 1))) + t) + +(deftest simple-array-t.4.2 + (typep #0aX '(simple-array t 1)) + nil) + +(deftest simple-array-t.4.3 + (typep #2a(()) '(simple-array t 1)) + nil) + +(deftest simple-array-t.4.4 + (notnot-mv (typep #(1 2 3) '(simple-array t 1))) + t) + +(deftest simple-array-t.4.5 + (typep "abcd" '(simple-array t 1)) + nil) + +(deftest simple-array-t.4.6 + (typep #*010101 '(simple-array t 1)) + nil) + +;;; Tests of (simple-array t 0) + +(deftest simple-array-t.5.1 + (typep #() '(simple-array t 0)) + nil) + +(deftest simple-array-t.5.2 + (notnot-mv (typep #0aX '(simple-array t 0))) + t) + +(deftest simple-array-t.5.3 + (typep #2a(()) '(simple-array t 0)) + nil) + +(deftest simple-array-t.5.4 + (typep #(1 2 3) '(simple-array t 0)) + nil) + +(deftest simple-array-t.5.5 + (typep "abcd" '(simple-array t 0)) + nil) + +(deftest simple-array-t.5.6 + (typep #*010101 '(simple-array t 0)) + nil) + +;;; Tests of (simple-array t *) + +(deftest simple-array-t.6.1 + (notnot-mv (typep #() '(simple-array t *))) + t) + +(deftest simple-array-t.6.2 + (notnot-mv (typep #0aX '(simple-array t *))) + t) + +(deftest simple-array-t.6.3 + (notnot-mv (typep #2a(()) '(simple-array t *))) + t) + +(deftest simple-array-t.6.4 + (notnot-mv (typep #(1 2 3) '(simple-array t *))) + t) + +(deftest simple-array-t.6.5 + (typep "abcd" '(simple-array t *)) + nil) + +(deftest simple-array-t.6.6 + (typep #*010101 '(simple-array t *)) + nil) + +;;; Tests of (simple-array t 2) + +(deftest simple-array-t.7.1 + (typep #() '(simple-array t 2)) + nil) + +(deftest simple-array-t.7.2 + (typep #0aX '(simple-array t 2)) + nil) + +(deftest simple-array-t.7.3 + (notnot-mv (typep #2a(()) '(simple-array t 2))) + t) + +(deftest simple-array-t.7.4 + (typep #(1 2 3) '(simple-array t 2)) + nil) + +(deftest simple-array-t.7.5 + (typep "abcd" '(simple-array t 2)) + nil) + +(deftest simple-array-t.7.6 + (typep #*010101 '(simple-array t 2)) + nil) + +;;; Testing '(simple-array t (--)) + +(deftest simple-array-t.8.1 + (typep #() '(simple-array t (1))) + nil) + +(deftest simple-array-t.8.2 + (notnot-mv (typep #() '(simple-array t (0)))) + t) + +(deftest simple-array-t.8.3 + (notnot-mv (typep #() '(simple-array t (*)))) + t) + +(deftest simple-array-t.8.4 + (typep #(a b c) '(simple-array t (2))) + nil) + +(deftest simple-array-t.8.5 + (notnot-mv (typep #(a b c) '(simple-array t (3)))) + t) + +(deftest simple-array-t.8.6 + (notnot-mv (typep #(a b c) '(simple-array t (*)))) + t) + +(deftest simple-array-t.8.7 + (typep #(a b c) '(simple-array t (4))) + nil) + +(deftest simple-array-t.8.8 + (typep #2a((a b c)) '(simple-array t (*))) + nil) + +(deftest simple-array-t.8.9 + (typep #2a((a b c)) '(simple-array t (3))) + nil) + +(deftest simple-array-t.8.10 + (typep #2a((a b c)) '(simple-array t (1))) + nil) + +(deftest simple-array-t.8.11 + (typep "abc" '(simple-array t (2))) + nil) + +(deftest simple-array-t.8.12 + (typep "abc" '(simple-array t (3))) + nil) + +(deftest simple-array-t.8.13 + (typep "abc" '(simple-array t (*))) + nil) + +(deftest simple-array-t.8.14 + (typep "abc" '(simple-array t (4))) + nil) + +;;; Two dimensional simple-array type tests + +(deftest simple-array-t.9.1 + (typep #() '(simple-array t (* *))) + nil) + +(deftest simple-array-t.9.2 + (typep "abc" '(simple-array t (* *))) + nil) + +(deftest simple-array-t.9.3 + (typep #(a b c) '(simple-array t (3 *))) + nil) + +(deftest simple-array-t.9.4 + (typep #(a b c) '(simple-array t (* 3))) + nil) + +(deftest simple-array-t.9.5 + (typep "abc" '(simple-array t (3 *))) + nil) + +(deftest simple-array-t.9.6 + (typep "abc" '(simple-array t (* 3))) + nil) + +(deftest simple-array-t.9.7 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array t (* *)))) + t) + +(deftest simple-array-t.9.8 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array t (3 *)))) + t) + +(deftest simple-array-t.9.9 + (typep #2a((a b)(c d)(e f)) '(simple-array t (2 *))) + nil) + +(deftest simple-array-t.9.10 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array t (* 2)))) + t) + +(deftest simple-array-t.9.11 + (typep #2a((a b)(c d)(e f)) '(simple-array t (* 3))) + nil) + +(deftest simple-array-t.9.12 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array t (3 2)))) + t) + +(deftest simple-array-t.9.13 + (typep #2a((a b)(c d)(e f)) '(simple-array t (2 3))) + nil) diff --git a/ansi-tests/simple-array.lsp b/ansi-tests/simple-array.lsp new file mode 100644 index 0000000..c6e1099 --- /dev/null +++ b/ansi-tests/simple-array.lsp @@ -0,0 +1,329 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 07:20:31 2003 +;;;; Contains: Tests of SIMPLE-ARRAY + +(in-package :cl-test) + +;;; Tests of simple-array by itself + +(deftest simple-array.1.1 + (notnot-mv (typep #() 'simple-array)) + t) + +(deftest simple-array.1.2 + (notnot-mv (typep #0aX 'simple-array)) + t) + +(deftest simple-array.1.3 + (notnot-mv (typep #2a(()) 'simple-array)) + t) + +(deftest simple-array.1.4 + (notnot-mv (typep #(1 2 3) 'simple-array)) + t) + +(deftest simple-array.1.5 + (notnot-mv (typep "abcd" 'simple-array)) + t) + +(deftest simple-array.1.6 + (notnot-mv (typep #*010101 'simple-array)) + t) + +(deftest simple-array.1.7 + (typep nil 'simple-array) + nil) + +(deftest simple-array.1.8 + (typep 'x 'simple-array) + nil) + +(deftest simple-array.1.9 + (typep '(a b c) 'simple-array) + nil) + +(deftest simple-array.1.10 + (typep 10.0 'simple-array) + nil) + +(deftest simple-array.1.11 + (typep #'(lambda (x) (cons x nil)) 'simple-array) + nil) + +(deftest simple-array.1.12 + (typep 1 'simple-array) + nil) + +(deftest simple-array.1.13 + (typep (1+ most-positive-fixnum) 'simple-array) + nil) + +;;; Tests of (simple-array *) + +(deftest simple-array.2.1 + (notnot-mv (typep #() '(simple-array *))) + t) + +(deftest simple-array.2.2 + (notnot-mv (typep #0aX '(simple-array *))) + t) + +(deftest simple-array.2.3 + (notnot-mv (typep #2a(()) '(simple-array *))) + t) + +(deftest simple-array.2.4 + (notnot-mv (typep #(1 2 3) '(simple-array *))) + t) + +(deftest simple-array.2.5 + (notnot-mv (typep "abcd" '(simple-array *))) + t) + +(deftest simple-array.2.6 + (notnot-mv (typep #*010101 '(simple-array *))) + t) + +;;; Tests of (simple-array * ()) + +(deftest simple-array.3.1 + (notnot-mv (typep #() '(simple-array * nil))) + nil) + +(deftest simple-array.3.2 + (notnot-mv (typep #0aX '(simple-array * nil))) + t) + +(deftest simple-array.3.3 + (typep #2a(()) '(simple-array * nil)) + nil) + +(deftest simple-array.3.4 + (typep #(1 2 3) '(simple-array * nil)) + nil) + +(deftest simple-array.3.5 + (typep "abcd" '(simple-array * nil)) + nil) + +(deftest simple-array.3.6 + (typep #*010101 '(simple-array * nil)) + nil) + +;;; Tests of (simple-array * 1) +;;; The '1' indicates rank, so this is equivalent to 'vector' + +(deftest simple-array.4.1 + (notnot-mv (typep #() '(simple-array * 1))) + t) + +(deftest simple-array.4.2 + (typep #0aX '(simple-array * 1)) + nil) + +(deftest simple-array.4.3 + (typep #2a(()) '(simple-array * 1)) + nil) + +(deftest simple-array.4.4 + (notnot-mv (typep #(1 2 3) '(simple-array * 1))) + t) + +(deftest simple-array.4.5 + (notnot-mv (typep "abcd" '(simple-array * 1))) + t) + +(deftest simple-array.4.6 + (notnot-mv (typep #*010101 '(simple-array * 1))) + t) + +;;; Tests of (simple-array * 0) + +(deftest simple-array.5.1 + (typep #() '(simple-array * 0)) + nil) + +(deftest simple-array.5.2 + (notnot-mv (typep #0aX '(simple-array * 0))) + t) + +(deftest simple-array.5.3 + (typep #2a(()) '(simple-array * 0)) + nil) + +(deftest simple-array.5.4 + (typep #(1 2 3) '(simple-array * 0)) + nil) + +(deftest simple-array.5.5 + (typep "abcd" '(simple-array * 0)) + nil) + +(deftest simple-array.5.6 + (typep #*010101 '(simple-array * 0)) + nil) + +;;; Tests of (simple-array * *) + +(deftest simple-array.6.1 + (notnot-mv (typep #() '(simple-array * *))) + t) + +(deftest simple-array.6.2 + (notnot-mv (typep #0aX '(simple-array * *))) + t) + +(deftest simple-array.6.3 + (notnot-mv (typep #2a(()) '(simple-array * *))) + t) + +(deftest simple-array.6.4 + (notnot-mv (typep #(1 2 3) '(simple-array * *))) + t) + +(deftest simple-array.6.5 + (notnot-mv (typep "abcd" '(simple-array * *))) + t) + +(deftest simple-array.6.6 + (notnot-mv (typep #*010101 '(simple-array * *))) + t) + +;;; Tests of (simple-array * 2) + +(deftest simple-array.7.1 + (typep #() '(simple-array * 2)) + nil) + +(deftest simple-array.7.2 + (typep #0aX '(simple-array * 2)) + nil) + +(deftest simple-array.7.3 + (notnot-mv (typep #2a(()) '(simple-array * 2))) + t) + +(deftest simple-array.7.4 + (typep #(1 2 3) '(simple-array * 2)) + nil) + +(deftest simple-array.7.5 + (typep "abcd" '(simple-array * 2)) + nil) + +(deftest simple-array.7.6 + (typep #*010101 '(simple-array * 2)) + nil) + +;;; Testing '(simple-array * (--)) + +(deftest simple-array.8.1 + (typep #() '(simple-array * (1))) + nil) + +(deftest simple-array.8.2 + (notnot-mv (typep #() '(simple-array * (0)))) + t) + +(deftest simple-array.8.3 + (notnot-mv (typep #() '(simple-array * (*)))) + t) + +(deftest simple-array.8.4 + (typep #(a b c) '(simple-array * (2))) + nil) + +(deftest simple-array.8.5 + (notnot-mv (typep #(a b c) '(simple-array * (3)))) + t) + +(deftest simple-array.8.6 + (notnot-mv (typep #(a b c) '(simple-array * (*)))) + t) + +(deftest simple-array.8.7 + (typep #(a b c) '(simple-array * (4))) + nil) + +(deftest simple-array.8.8 + (typep #2a((a b c)) '(simple-array * (*))) + nil) + +(deftest simple-array.8.9 + (typep #2a((a b c)) '(simple-array * (3))) + nil) + +(deftest simple-array.8.10 + (typep #2a((a b c)) '(simple-array * (1))) + nil) + +(deftest simple-array.8.11 + (typep "abc" '(simple-array * (2))) + nil) + +(deftest simple-array.8.12 + (notnot-mv (typep "abc" '(simple-array * (3)))) + t) + +(deftest simple-array.8.13 + (notnot-mv (typep "abc" '(simple-array * (*)))) + t) + +(deftest simple-array.8.14 + (typep "abc" '(simple-array * (4))) + nil) + +;;; Two dimensional simple-array type tests + +(deftest simple-array.9.1 + (typep #() '(simple-array * (* *))) + nil) + +(deftest simple-array.9.2 + (typep "abc" '(simple-array * (* *))) + nil) + +(deftest simple-array.9.3 + (typep #(a b c) '(simple-array * (3 *))) + nil) + +(deftest simple-array.9.4 + (typep #(a b c) '(simple-array * (* 3))) + nil) + +(deftest simple-array.9.5 + (typep "abc" '(simple-array * (3 *))) + nil) + +(deftest simple-array.9.6 + (typep "abc" '(simple-array * (* 3))) + nil) + +(deftest simple-array.9.7 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array * (* *)))) + t) + +(deftest simple-array.9.8 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array * (3 *)))) + t) + +(deftest simple-array.9.9 + (typep #2a((a b)(c d)(e f)) '(simple-array * (2 *))) + nil) + +(deftest simple-array.9.10 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array * (* 2)))) + t) + +(deftest simple-array.9.11 + (typep #2a((a b)(c d)(e f)) '(simple-array * (* 3))) + nil) + +(deftest simple-array.9.12 + (notnot-mv (typep #2a((a b)(c d)(e f)) '(simple-array * (3 2)))) + t) + +(deftest simple-array.9.13 + (typep #2a((a b)(c d)(e f)) '(simple-array * (2 3))) + nil) diff --git a/ansi-tests/simple-bit-vector-p.lsp b/ansi-tests/simple-bit-vector-p.lsp new file mode 100644 index 0000000..debd322 --- /dev/null +++ b/ansi-tests/simple-bit-vector-p.lsp @@ -0,0 +1,62 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 20:20:27 2003 +;;;; Contains: Tests of SIMPLE-BIT-VECTOR-P + +(in-package :cl-test) + +(deftest simple-bit-vector-p.2 + (notnot-mv (simple-bit-vector-p #*)) + t) + +(deftest simple-bit-vector-p.3 + (notnot-mv (simple-bit-vector-p #*00101)) + t) + +(deftest simple-bit-vector-p.4 + (simple-bit-vector-p #(0 1 1 1 0 0)) + nil) + +(deftest simple-bit-vector-p.5 + (simple-bit-vector-p "011100") + nil) + +(deftest simple-bit-vector-p.6 + (simple-bit-vector-p 0) + nil) + +(deftest simple-bit-vector-p.7 + (simple-bit-vector-p 1) + nil) + +(deftest simple-bit-vector-p.8 + (simple-bit-vector-p nil) + nil) + +(deftest simple-bit-vector-p.9 + (simple-bit-vector-p 'x) + nil) + +(deftest simple-bit-vector-p.10 + (simple-bit-vector-p '(0 1 1 0)) + nil) + +(deftest simple-bit-vector-p.11 + (simple-bit-vector-p (make-array '(2 2) :element-type 'bit + :initial-element 0)) + nil) + +(deftest simple-bit-vector-p.12 + (loop for e in *universe* + for p1 = (typep e 'simple-bit-vector) + for p2 = (simple-bit-vector-p e) + always (if p1 p2 (not p2))) + t) + +(deftest simple-bit-vector-p.error.1 + (classify-error (simple-bit-vector-p)) + program-error) + +(deftest simple-bit-vector-p.error.2 + (classify-error (simple-bit-vector-p #* #*)) + program-error) diff --git a/ansi-tests/simple-bit-vector.lsp b/ansi-tests/simple-bit-vector.lsp new file mode 100644 index 0000000..a46fd21 --- /dev/null +++ b/ansi-tests/simple-bit-vector.lsp @@ -0,0 +1,72 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 13:12:07 2003 +;;;; Contains: Tests for type SIMPLE-BIT-VECTOR + +(in-package :cl-test) + +(deftest simple-bit-vector.2 + (notnot-mv (typep #* 'simple-bit-vector)) + t) + +(deftest simple-bit-vector.3 + (notnot-mv (typep #*00101 'simple-bit-vector)) + t) + +(deftest simple-bit-vector.4 + (typep #(0 1 1 1 0 0) 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.5 + (typep "011100" 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.6 + (typep 0 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.7 + (typep 1 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.8 + (typep nil 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.9 + (typep 'x 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.10 + (typep '(0 1 1 0) 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.11 + (typep (make-array '(2 2) :element-type 'bit + :initial-element 0) + 'simple-bit-vector) + nil) + +(deftest simple-bit-vector.12 + (notnot-mv (typep #* '(simple-bit-vector *))) + t) + +(deftest simple-bit-vector.13 + (notnot-mv (typep #*01101 '(simple-bit-vector *))) + t) + +(deftest simple-bit-vector.14 + (notnot-mv (typep #* '(simple-bit-vector 0))) + t) + +(deftest simple-bit-vector.15 + (typep #*01101 '(simple-bit-vector 0)) + nil) + +(deftest simple-bit-vector.16 + (typep #* '(simple-bit-vector 5)) + nil) + +(deftest simple-bit-vector.17 + (notnot-mv (typep #*01101 '(simple-bit-vector 5))) + t) diff --git a/ansi-tests/simple-vector-p.lsp b/ansi-tests/simple-vector-p.lsp new file mode 100644 index 0000000..2246e09 --- /dev/null +++ b/ansi-tests/simple-vector-p.lsp @@ -0,0 +1,71 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 22 21:23:45 2003 +;;;; Contains: Tests for SIMPLE-VECTOR-P + +(in-package :cl-test) + +;;; More tests for this are in make-array.lsp + +(deftest simple-vector-p.1 + (loop for e in *universe* + unless (if (typep e 'simple-vector) + (simple-vector-p e) + (not (simple-vector-p e))) + collect e) + nil) + +(deftest simple-vector-p.2 + (notnot-mv (simple-vector-p (make-array '(10)))) + t) + +;; (deftest simple-vector-p.3 +;; (simple-vector-p (make-array '(5) :fill-pointer t)) +;; nil) + +(deftest simple-vector-p.4 + (notnot-mv (simple-vector-p (vector 'a 'b 'c))) + t) + +;;; (deftest simple-vector-p.5 +;;; (simple-vector-p (make-array '(5) :adjustable t)) +;;; nil) + +;;; (deftest simple-vector-p.6 +;;; (let ((a #(a b c d e g h))) +;;; (simple-vector-p (make-array '(5) :displaced-to a))) +;;; nil) + +(deftest simple-vector-p.7 + (simple-vector-p #*001101) + nil) + +(deftest simple-vector-p.8 + (simple-vector-p "abcdef") + nil) + +(deftest simple-vector-p.9 + (simple-vector-p (make-array nil)) + nil) + +(deftest simple-vector-p.10 + (simple-vector-p (make-array '(10) :element-type 'base-char)) + nil) + +(deftest simple-vector-p.11 + (simple-vector-p (make-array '(10) :element-type 'character)) + nil) + +(deftest simple-vector-p.12 + (simple-vector-p (make-array '(10) :element-type 'bit)) + nil) + +;;; Error tests + +(deftest simple-vector-p.error.1 + (classify-error (simple-vector-p)) + program-error) + +(deftest simple-vector-p.error.2 + (classify-error (simple-vector-p #(a b) nil)) + program-error) diff --git a/ansi-tests/some.lsp b/ansi-tests/some.lsp new file mode 100644 index 0000000..5932375 --- /dev/null +++ b/ansi-tests/some.lsp @@ -0,0 +1,151 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 07:07:07 2002 +;;;; Contains: Tests for SOME + +(in-package :cl-test) + +(deftest some.1 + (some #'identity nil) + nil) + +(deftest some.2 + (some #'identity #()) + nil) + +(deftest some.3 + (let ((count 0)) + (values + (some #'(lambda (x) (incf count) (if (>= x 10) x nil)) + '(1 2 4 13 5 1)) + count)) + 13 4) + +(deftest some.4 + (some #'/= '(1 2 3 4) '(1 2 3 4 5)) + nil) + +(deftest some.5 + (some #'/= '(1 2 3 4 5) '(1 2 3 4)) + nil) + +(deftest some.6 + (not-mv (some #'/= '(1 2 3 4 5) '(1 2 3 4 6))) + nil) + +(deftest some.7 + (some #'(lambda (x y) (and x y)) + '(nil t t nil t) #(t nil nil t nil nil)) + nil) + +(deftest some.8 + (let ((x '(1)) + (args nil)) + (loop for i from 1 below (1- (min 100 call-arguments-limit)) + do (push x args) + always (apply #'some #'/= args))) + nil) + +(deftest some.9 + (some #'zerop #*11111111111111) + nil) + +(deftest some.10 + (some #'zerop #*) + nil) + +(deftest some.11 + (not-mv (some #'zerop #*1111111011111)) + nil) + +(deftest some.12 + (some #'(lambda (x) (not (eql x #\a))) "aaaaaaaa") + nil) + +(deftest some.13 + (some #'(lambda (x) (eql x #\a)) "") + nil) + +(deftest some.14 + (not-mv (some #'(lambda (x) (not (eql x #\a))) "aaaaaabaaaa")) + nil) + +(deftest some.15 + (some 'null '(1 2 3 4)) + nil) + +(deftest some.16 + (not-mv (some 'null '(1 2 3 nil 5))) + nil) + +(deftest some.order.1 + (let ((i 0) x y) + (values + (some (progn (setf x (incf i)) #'null) + (progn (setf y (incf i)) '(a b c d))) + i x y)) + nil 2 1 2) + +(deftest some.order.2 + (let ((i 0) x y z) + (values + (some (progn (setf x (incf i)) #'eq) + (progn (setf y (incf i)) '(a b c d)) + (progn (setf z (incf i)) '(e f g h))) + i x y z)) + nil 3 1 2 3) + + +(deftest some.error.1 + (classify-error (some 1 '(a b c))) + type-error) + +(deftest some.error.2 + (classify-error (some #\a '(a b c))) + type-error) + +(deftest some.error.3 + (classify-error (some #() '(a b c))) + type-error) + +(deftest some.error.4 + (classify-error (some #'null 'a)) + type-error) + +(deftest some.error.5 + (classify-error (some #'null 100)) + type-error) + +(deftest some.error.6 + (classify-error (some #'null 'a)) + type-error) + +(deftest some.error.7 + (classify-error (some #'eq () 'a)) + type-error) + +(deftest some.error.8 + (classify-error (some)) + program-error) + +(deftest some.error.9 + (classify-error (some #'null)) + program-error) + +(deftest some.error.10 + (classify-error (locally (some 1 '(a b c)) t)) + type-error) + +(deftest some.error.11 + (classify-error (some #'cons '(a b c))) + program-error) + +(deftest some.error.12 + (classify-error (some #'car '(a b c))) + type-error) + +(deftest some.error.13 + (classify-error (some #'cons '(a b c) '(b c d) '(c d e))) + program-error) + + diff --git a/ansi-tests/sort.lsp b/ansi-tests/sort.lsp new file mode 100644 index 0000000..1eabcac --- /dev/null +++ b/ansi-tests/sort.lsp @@ -0,0 +1,143 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 21 00:11:24 2002 +;;;; Contains: Tests for SORT + +(in-package :cl-test) + +(deftest sort-list.1 + (let ((a (list 1 4 2 5 3))) + (sort a #'<)) + (1 2 3 4 5)) + +(deftest sort-list.2 + (let ((a (list 1 4 2 5 3))) + (sort a #'< :key #'-)) + (5 4 3 2 1)) + +(deftest sort-list.3 + (let ((a (list 1 4 2 5 3))) + (sort a #'(lambda (x y) nil)) + (sort a #'<)) + (1 2 3 4 5)) + +(deftest sort-vector.1 + (let ((a (copy-seq #(1 4 2 5 3)))) + (sort a #'<)) + #(1 2 3 4 5)) + +(deftest sort-vector.2 + (let ((a (copy-seq #(1 4 2 5 3)))) + (sort a #'< :key #'-)) + #(5 4 3 2 1)) + +(deftest sort-vector.3 + (let ((a (copy-seq #(1 4 2 5 3)))) + (sort a #'(lambda (x y) nil)) + (sort a #'<)) + #(1 2 3 4 5)) + +(deftest sort-vector.4 + (let ((a (make-array 10 :initial-contents '(10 40 20 50 30 15 45 25 55 35) + :fill-pointer 5))) + (sort a #'<)) + #(10 20 30 40 50)) + +(deftest sort-bit-vector.1 + (let ((a (copy-seq #*10011101))) + (sort a #'<)) + #*00011111) + +(deftest sort-bit-vector.2 + (let ((a (copy-seq #*10011101))) + (values (sort a #'< :key #'-) a)) + #*11111000 + #*11111000) + +(deftest sort-bit-vector.3 + (let ((a (make-array 10 :initial-contents '(1 0 0 1 1 1 1 0 1 1) + :element-type 'bit + :fill-pointer 5))) + (sort a #'<)) + #*00111) + +(deftest sort-string.1 + (let ((a (copy-seq "10011101"))) + (values (sort a #'char<) a)) + "00011111" + "00011111") + +(deftest sort-string.2 + (let ((a (copy-seq "10011101"))) + (values (sort a #'char< :key #'(lambda (c) (if (eql c #\0) #\1 #\0))) a)) + "11111000" + "11111000") + +(deftest sort-string.3 + (let ((a (make-array 10 :initial-contents "1001111011" + :element-type 'character + :fill-pointer 5))) + (sort a #'char<)) + "00111") + +;;; Order of evaluation tests + +(deftest sort.order.1 + (let ((i 0) x y) + (values + (sort (progn (setf x (incf i)) (list 1 7 3 2)) + (progn (setf y (incf i)) #'<)) + i x y)) + (1 2 3 7) 2 1 2) + +(deftest sort.order.2 + (let ((i 0) x y z) + (values + (sort (progn (setf x (incf i)) (list 1 7 3 2)) + (progn (setf y (incf i)) #'<) + :key (progn (setf z (incf i)) #'-)) + i x y z)) + (7 3 2 1) 3 1 2 3) + + +;;; Error cases + +(deftest sort.error.1 + (classify-error (sort)) + program-error) + +(deftest sort.error.2 + (classify-error (sort nil)) + program-error) + +(deftest sort.error.3 + (classify-error (sort nil #'< :key)) + program-error) + +(deftest sort.error.4 + (classify-error (sort nil #'< 'bad t)) + program-error) + +(deftest sort.error.5 + (classify-error (sort nil #'< 'bad t :allow-other-keys nil)) + program-error) + +(deftest sort.error.6 + (classify-error (sort nil #'< 1 2)) + program-error) + +(deftest sort.error.7 + (classify-error (sort (list 1 2 3 4) #'identity)) + program-error) + +(deftest sort.error.8 + (classify-error (sort (list 1 2 3 4) #'< :key #'cons)) + program-error) + +(deftest sort.error.9 + (classify-error (sort (list 1 2 3 4) #'< :key #'car)) + type-error) + +(deftest sort.error.10 + (classify-error (sort (list 1 2 3 4) #'elt)) + type-error) diff --git a/ansi-tests/stable-sort.lsp b/ansi-tests/stable-sort.lsp new file mode 100644 index 0000000..9925d9c --- /dev/null +++ b/ansi-tests/stable-sort.lsp @@ -0,0 +1,154 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 28 21:00:44 2002 +;;;; Contains: Tests for STABLE-SORT + +(in-package :cl-test) + +(deftest stable-sort-list.1 + (let ((a (list 1 4 2 5 3))) + (stable-sort a #'<)) + (1 2 3 4 5)) + +(deftest stable-sort-list.2 + (let ((a (list 1 4 2 5 3))) + (stable-sort a #'< :key #'-)) + (5 4 3 2 1)) + +(deftest stable-sort-list.3 + (let ((a (list 1 4 2 5 3))) + (stable-sort a #'(lambda (x y) nil)) + (stable-sort a #'<)) + (1 2 3 4 5)) + +(deftest stable-sort-list.4 + (let ((a (copy-seq '((1 a) (2 a) (1 b) (2 b) (1 c) (2 c))))) + (stable-sort a #'(lambda (x y) (< (car x) (car y))))) + ((1 a) (1 b) (1 c) (2 a) (2 b) (2 c))) + +(deftest stable-sort-list.5 + (let ((a (reverse (copy-seq '((1 a) (2 a) (1 b) (2 b) (1 c) (2 c)))))) + (stable-sort a #'(lambda (x y) (< (car x) (car y))))) + ((1 c) (1 b) (1 a) (2 c) (2 b) (2 a))) + +(deftest stable-sort-vector.1 + (let ((a (copy-seq #(1 4 2 5 3)))) + (stable-sort a #'<)) + #(1 2 3 4 5)) + +(deftest stable-sort-vector.2 + (let ((a (copy-seq #(1 4 2 5 3)))) + (stable-sort a #'< :key #'-)) + #(5 4 3 2 1)) + +(deftest stable-sort-vector.3 + (let ((a (copy-seq #(1 4 2 5 3)))) + (stable-sort a #'(lambda (x y) nil)) + (stable-sort a #'<)) + #(1 2 3 4 5)) + +(deftest stable-sort-vector.4 + (let ((a (make-array 10 :initial-contents '(10 40 20 50 30 15 45 25 55 35) + :fill-pointer 5))) + (stable-sort a #'<)) + #(10 20 30 40 50)) + +(deftest stable-sort-bit-vector.1 + (let ((a (copy-seq #*10011101))) + (stable-sort a #'<)) + #*00011111) + +(deftest stable-sort-bit-vector.2 + (let ((a (copy-seq #*10011101))) + (values (stable-sort a #'< :key #'-) a)) + #*11111000 + #*11111000) + +(deftest stable-sort-bit-vector.3 + (let ((a (make-array 10 :initial-contents '(1 0 0 1 1 1 1 0 1 1) + :element-type 'bit + :fill-pointer 5))) + (stable-sort a #'<)) + #*00111) + +(deftest stable-sort-string.1 + (let ((a (copy-seq "10011101"))) + (values (stable-sort a #'char<) a)) + "00011111" + "00011111") + +(deftest stable-sort-string.2 + (let ((a (copy-seq "10011101"))) + (values (stable-sort a #'char< + :key #'(lambda (c) (if (eql c #\0) #\1 #\0))) a)) + "11111000" + "11111000") + +(deftest stable-sort-string.3 + (let ((a (make-array 10 :initial-contents "1001111011" + :element-type 'character + :fill-pointer 5))) + (stable-sort a #'char<)) + "00111") + +;;; Order of evaluation tests + +(deftest stable-sort.order.1 + (let ((i 0) x y) + (values + (stable-sort (progn (setf x (incf i)) (list 1 7 3 2)) + (progn (setf y (incf i)) #'<)) + i x y)) + (1 2 3 7) 2 1 2) + +(deftest stable-sort.order.2 + (let ((i 0) x y z) + (values + (stable-sort (progn (setf x (incf i)) (list 1 7 3 2)) + (progn (setf y (incf i)) #'<) + :key (progn (setf z (incf i)) #'-)) + i x y z)) + (7 3 2 1) 3 1 2 3) + + +;;; Error cases + +(deftest stable-sort.error.1 + (classify-error (stable-sort)) + program-error) + +(deftest stable-sort.error.2 + (classify-error (stable-sort nil)) + program-error) + +(deftest stable-sort.error.3 + (classify-error (stable-sort nil #'< :key)) + program-error) + +(deftest stable-sort.error.4 + (classify-error (stable-sort nil #'< 'bad t)) + program-error) + +(deftest stable-sort.error.5 + (classify-error (stable-sort nil #'< 'bad t :allow-other-keys nil)) + program-error) + +(deftest stable-sort.error.6 + (classify-error (stable-sort nil #'< 1 2)) + program-error) + +(deftest stable-sort.error.7 + (classify-error (stable-sort (list 1 2 3 4) #'identity)) + program-error) + +(deftest stable-sort.error.8 + (classify-error (stable-sort (list 1 2 3 4) #'< :key #'cons)) + program-error) + +(deftest stable-sort.error.9 + (classify-error (stable-sort (list 1 2 3 4) #'< :key #'car)) + type-error) + +(deftest stable-sort.error.10 + (classify-error (stable-sort (list 1 2 3 4) #'elt)) + type-error) diff --git a/ansi-tests/stream-element-type.lsp b/ansi-tests/stream-element-type.lsp new file mode 100644 index 0000000..71bfa86 --- /dev/null +++ b/ansi-tests/stream-element-type.lsp @@ -0,0 +1,102 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 13 20:09:50 2004 +;;;; Contains: Tests for STREAM-ELEMENT-TYPE + +(in-package :cl-test) + +(deftest stream-element-type.1 + (loop for s in (list *debug-io* *error-output* *query-io* + *standard-input* *standard-output* + *trace-output* *terminal-io*) + for results = (multiple-value-list (stream-element-type s)) + unless (and (eql (length results) 1) + (car results)) + collect s) + nil) + +(deftest stream-element-type.2 + (let ((pn "foo.txt")) + (loop for i from 1 to 100 + for etype = `(unsigned-byte ,i) + for s = (progn (delete-all-versions pn) + (open pn :direction :output + :element-type etype)) + unless + (multiple-value-bind (sub good) + (subtypep etype (stream-element-type s)) + (close s) + (or sub (not good))) + collect i)) + nil) + +(deftest stream-element-type.3 + (let ((pn "foo.txt")) + (loop for i from 1 to 100 + for etype = `(signed-byte ,i) + for s = (progn (delete-all-versions pn) + (open pn :direction :output + :element-type etype)) + unless + (multiple-value-bind (sub good) + (subtypep etype (stream-element-type s)) + (close s) + (or sub (not good))) + collect i)) + nil) + +(deftest stream-element-type.4 + (let ((pn "foo.txt")) + (loop for i from 1 to 100 + for etype = `(integer 0 ,i) + for s = (progn (delete-all-versions pn) + (open pn :direction :output + :element-type etype)) + unless + (multiple-value-bind (sub good) + (subtypep etype (stream-element-type s)) + (close s) + (or sub (not good))) + collect i)) + nil) + + +(deftest stream-element-type.5 + :notes (:assume-no-simple-streams) + (let ((pn "foo.txt")) + (delete-all-versions pn) + (let ((s (open pn :direction :output))) + (let ((etype (stream-element-type s))) + (unwind-protect + (equalt (multiple-value-list (subtypep* 'character etype)) + '(nil t)) + (close s))))) + nil) + +(deftest stream-element-type.6 + :notes (:assume-no-simple-streams) + (let ((pn "foo.txt")) + (delete-all-versions pn) + (let ((s (open pn :direction :output + :element-type :default))) + (let ((etype (stream-element-type s))) + (unwind-protect + (multiple-value-bind (sub1 good1) (subtypep* etype 'integer) + (multiple-value-bind (sub2 good2) (subtypep* etype 'character) + (or (not good1) + (not good2) + sub1 sub2))) + (close s))))) + t) + +(deftest stream-element-type.error.1 + (signals-error (stream-element-type) program-error) + t) + +(deftest stream-element-type.error.2 + (signals-error (stream-element-type *standard-input* nil) program-error) + t) + +(deftest stream-element-type.error.3 + (check-type-error #'stream-element-type #'streamp) + nil) diff --git a/ansi-tests/stream-error-stream.lsp b/ansi-tests/stream-error-stream.lsp new file mode 100644 index 0000000..9a7f533 --- /dev/null +++ b/ansi-tests/stream-error-stream.lsp @@ -0,0 +1,34 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 20:51:33 2004 +;;;; Contains: Tests of STREAM-ERROR-STREAM + +(in-package :cl-test) + +(deftest stream-error-stream.1 + (with-input-from-string + (s "") + (handler-case + (read-char s) + (stream-error (c) (eqlt (stream-error-stream c) s)))) + t) + +;;; Error tests + +(deftest stream-error-stream.error.1 + (signals-error (stream-error-stream) program-error) + t) + + +(deftest stream-error-stream.error.2 + (signals-error + (with-input-from-string + (s "") + (handler-case + (read-char s) + (stream-error (c) (stream-error-stream c nil)))) + program-error) + t) + + + diff --git a/ansi-tests/stream-external-format.lsp b/ansi-tests/stream-external-format.lsp new file mode 100644 index 0000000..528986c --- /dev/null +++ b/ansi-tests/stream-external-format.lsp @@ -0,0 +1,24 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 27 20:53:21 2004 +;;;; Contains: Tests of STREAM-EXTERNAL-FORMAT + +(in-package :cl-test) + +;;; This is tested in open.lsp + +;;; Error tests + +(deftest stream-external-format.error.1 + (signals-error (stream-external-format) program-error) + t) + +(deftest stream-external-format.error.2 + (signals-error + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file + (s pn :direction :output :if-exists :supersede) + (stream-external-format s nil))) + program-error) + t) diff --git a/ansi-tests/streamp.lsp b/ansi-tests/streamp.lsp new file mode 100644 index 0000000..5bc1b18 --- /dev/null +++ b/ansi-tests/streamp.lsp @@ -0,0 +1,44 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 17 17:12:38 2004 +;;;; Contains: Tests for STREAMP + +(in-package :cl-test) + +(deftest streamp.1 + (loop for s in (list *debug-io* *error-output* *query-io* + *standard-input* *standard-output* + *trace-output* *terminal-io*) + unless (equal (multiple-value-list (notnot-mv (streamp s))) + '(t)) + collect s) + nil) + +(deftest streamp.2 + (check-type-predicate #'streamp 'stream) + 0) + +(deftest streamp.3 + (let ((s (open "foo.txt" :direction :output + :if-exists :supersede))) + (close s) + (notnot-mv (streamp s))) + t) + +(deftest streamp.4 + (let ((s (open "foo.txt" :direction :output + :if-exists :supersede))) + (unwind-protect + (notnot-mv (streamp s)) + (close s))) + t) + +;;; Error tests + +(deftest streamp.error.1 + (signals-error (streamp) program-error) + t) + +(deftest streamp.error.2 + (signals-error (streamp *standard-input* nil) program-error) + t) diff --git a/ansi-tests/string-aux.lsp b/ansi-tests/string-aux.lsp new file mode 100644 index 0000000..ba765c2 --- /dev/null +++ b/ansi-tests/string-aux.lsp @@ -0,0 +1,165 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 4 06:51:32 2002 +;;;; Contains: Auxiliary functions for string testing + +(in-package :cl-test) + +(defun my-string-compare (string1 string2 comparison + &key (start1 0) end1 (start2 0) end2 case + &aux + (len1 (progn (assert (stringp string1)) + (length string1))) + (len2 (progn (assert (stringp string2)) + (length string2))) + (compare-fn + (case comparison + (< (if case #'char-lessp #'char<)) + (<= (if case #'char-not-greaterp + #'char<=)) + (= (if case #'char-equal #'char=)) + (/= (if case #'char-not-equal #'char/=)) + (> (if case #'char-greaterp #'char>)) + (>= (if case #'char-not-lessp #'char>=)) + (t (error "Bad comparison arg: ~A~%" + comparison)))) + (equal-fn (if case #'char-equal #'char=))) + + (assert (integerp start1)) + (assert (integerp start2)) + (unless end1 (setq end1 len1)) + (unless end2 (setq end2 len2)) + (assert (<= 0 start1 end1)) + (assert (<= 0 start2 end2)) + (loop + for i1 from start1 + for i2 from start2 + do + (cond + ((= i1 end1) + (return + (cond + ((= i2 end2) + ;; Both ended -- equality case + (if (member comparison '(= <= >=)) + end1 + nil)) + (t ;; string2 still extending + (if (member comparison '(/= < <=)) + end1 + nil))))) + ((= i2 end2) + ;; string1 still extending + (return + (if (member comparison '(/= > >=)) + i1 + nil))) + (t + (let ((c1 (char string1 i1)) + (c2 (char string2 i2))) + (cond + ((funcall equal-fn c1 c2)) + (t ;; mismatch found -- what kind? + (return + (if (funcall compare-fn c1 c2) + i1 + nil))))))))) + +(defun make-random-string-compare-test (n) + (let* ((len (random n)) + ;; Lengths of the two strings + (len1 (if (or (coin) (= len 0)) len (+ len (random len)))) + (len2 (if (or (coin) (= len 0)) len (+ len (random len)))) + ;; Lengths of the parts of the strings to be matched + (sublen1 (if (or (coin) (= len1 0)) (min len1 len2) (random len1))) + (sublen2 (if (or (coin) (= len2 0)) (min len2 sublen1) (random len2))) + ;; Start and end of the substring of the first string + (start1 (if (coin 3) 0 + (max 0 (min (1- len1) (random (- len1 sublen1 -1)))))) + (end1 (+ start1 sublen1)) + ;; Start and end of the substring of the second string + (start2 (if (coin 3) 0 + (max 0 (min (1- len2) (random (- len2 sublen2 -1)))))) + (end2 (+ start2 sublen2)) + ;; generate the strings + (s1 (make-random-string len1)) + (s2 (make-random-string len2))) + #| + (format t "len = ~A, len1 = ~A, len2 = ~A, sublen1 = ~A, sublen2 = ~A~%" + len len1 len2 sublen1 sublen2) + (format t "start1 = ~A, end1 = ~A, start2 = ~A, end2 = ~A~%" + start1 end1 start2 end2) + (format t "s1 = ~S, s2 = ~S~%" s1 s2) + |# + ;; Sometimes we want them to have a common prefix + (when (coin) + (if (<= sublen1 sublen2) + (setf (subseq s2 start2 (+ start2 sublen1)) + (subseq s1 start1 (+ start1 sublen1))) + (setf (subseq s1 start1 (+ start1 sublen2)) + (subseq s2 start2 (+ start2 sublen2))))) + (values + s1 + s2 + (reduce #'nconc + (random-permute + (list + (if (and (= start1 0) (coin)) + nil + (list :start1 start1)) + (if (and (= end1 len1) (coin)) + nil + (list :end1 end1)) + (if (and (= start2 0) (coin)) + nil + (list :start2 start2)) + (if (and (= end2 len2) (coin)) + nil + (list :end2 end2)))))))) + +(defun random-string-compare-test (n comparison case &optional (iterations 1)) + (loop for i from 1 to iterations + count + (multiple-value-bind (s1 s2 args) + (make-random-string-compare-test n) + ;; (format t "Args = ~S~%" args) + (let ((x (apply (case comparison + (< (if case #'string-lessp #'string<)) + (<= (if case #'string-not-greaterp + #'string<=)) + (= (if case #'string-equal #'string=)) + (/= (if case #'string-not-equal #'string/=)) + (> (if case #'string-greaterp #'string>)) + (>= (if case #'string-not-lessp #'string>=)) + (t (error "Bad comparison arg: ~A~%" comparison))) + s1 s2 args)) + (y (apply #'my-string-compare s1 s2 comparison :case case args))) + (not + (or (eql x y) + (and x y (eqt comparison '=)))))))) + +(defun make-random-string (n) + (let ((s (random-case + (make-string n) + (make-array n :element-type 'character + :initial-element #\a) + (make-array n :element-type 'standard-char + :initial-element #\a) + (make-array n :element-type 'base-char + :initial-element #\a)))) + (if (coin) + (dotimes (i n) + (setf (char s i) (elt #(#\a #\b #\A #\B) (random 4)))) + (dotimes (i n) + (dotimes (i n) + (setf (char s i) + (or (code-char (random 256)) + (elt "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" + (random 62))))))) + s)) + +(defun string-all-the-same (s) + (let ((len (length s))) + (or (= len 0) + (let ((c (char s 0))) + (loop for d across s always (eql c d)))))) diff --git a/ansi-tests/string-capitalize.lsp b/ansi-tests/string-capitalize.lsp new file mode 100644 index 0000000..82be8ce --- /dev/null +++ b/ansi-tests/string-capitalize.lsp @@ -0,0 +1,132 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 3 20:08:26 2002 +;;;; Contains: Tests for STRING-CAPITALIZE + +(in-package :cl-test) + +(deftest string-capitalize.1 + (let ((s "abCd")) + (values (string-capitalize s) s)) + "Abcd" + "abCd") + + +(deftest string-capitalize.2 + (let ((s "0adA2Cdd3wXy")) + (values (string-capitalize s) s)) + "0ada2cdd3wxy" + "0adA2Cdd3wXy") + +(deftest string-capitalize.3 + (let ((s "1a")) + (values (string-capitalize s) s)) + "1a" + "1a") + +(deftest string-capitalize.4 + (let ((s "a1a")) + (values (string-capitalize s) s)) + "A1a" + "a1a") + +(deftest string-capitalize.5 + (let ((s #\a)) + (values (string-capitalize s) s)) + "A" + #\a) + +(deftest string-capitalize.6 + (let ((s '|abcDe|)) + (values (string-capitalize s) (symbol-name s))) + "Abcde" + "abcDe") + +(deftest string-capitalize.7 + (let ((s "ABCDEF")) + (values + (loop for i from 0 to 5 + collect (string-capitalize s :start i)) + s)) + ("Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF") + "ABCDEF") + +(deftest string-capitalize.8 + (let ((s "ABCDEF")) + (values + (loop for i from 0 to 5 + collect (string-capitalize s :start i :end nil)) + s)) + ("Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF") + "ABCDEF") + +(deftest string-capitalize.9 + (let ((s "ABCDEF")) + (values + (loop for i from 0 to 6 + collect (string-capitalize s :end i)) + s)) + ("ABCDEF" "ABCDEF" "AbCDEF" "AbcDEF" "AbcdEF" "AbcdeF" "Abcdef") + "ABCDEF") + +(deftest string-capitalize.10 + (let ((s "ABCDEF")) + (values + (loop for i from 0 to 5 + collect (loop for j from i to 6 + collect (string-capitalize s :start i :end j))) + s)) + (("ABCDEF" "ABCDEF" "AbCDEF" "AbcDEF" "AbcdEF" "AbcdeF" "Abcdef") + ("ABCDEF" "ABCDEF" "ABcDEF" "ABcdEF" "ABcdeF" "ABcdef") + ("ABCDEF" "ABCDEF" "ABCdEF" "ABCdeF" "ABCdef") + ("ABCDEF" "ABCDEF" "ABCDeF" "ABCDef") + ("ABCDEF" "ABCDEF" "ABCDEf") + ("ABCDEF" "ABCDEF")) + "ABCDEF") + +(deftest string-capitalize.order.1 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (string-capitalize + (progn (setf a (incf i)) s) + :start (progn (setf b (incf i)) 1) + :end (progn (setf c (incf i)) 4)) + i a b c)) + "aBcdef" 3 1 2 3) + +(deftest string-capitalize.order.2 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (string-capitalize + (progn (setf a (incf i)) s) + :end (progn (setf b (incf i)) 4) + :start (progn (setf c (incf i)) 1)) + i a b c)) + "aBcdef" 3 1 2 3) + +;;; Error cases + +(deftest string-capitalize.error.1 + (classify-error (string-capitalize)) + program-error) + +(deftest string-capitalize.error.2 + (classify-error (string-capitalize (copy-seq "abc") :bad t)) + program-error) + +(deftest string-capitalize.error.3 + (classify-error (string-capitalize (copy-seq "abc") :start)) + program-error) + +(deftest string-capitalize.error.4 + (classify-error (string-capitalize (copy-seq "abc") :bad t + :allow-other-keys nil)) + program-error) + +(deftest string-capitalize.error.5 + (classify-error (string-capitalize (copy-seq "abc") :end)) + program-error) + +(deftest string-capitalize.error.6 + (classify-error (string-capitalize (copy-seq "abc") 1 2)) + program-error) diff --git a/ansi-tests/string-comparisons.lsp b/ansi-tests/string-comparisons.lsp new file mode 100644 index 0000000..617390e --- /dev/null +++ b/ansi-tests/string-comparisons.lsp @@ -0,0 +1,514 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 4 06:32:41 2002 +;;;; Contains: Tests of string comparison functions + +(in-package :cl-test) + +(deftest string=.1 + (not (string= "abc" (copy-seq "abc"))) + nil) + +(deftest string=.2 + (string= "A" "a") + nil) + +(deftest string=.3 + (not (string= #\a "a")) + nil) + +(deftest string=.4 + (not (string= '|abc| (copy-seq "abc"))) + nil) + +(deftest string=.5 + (not (string= (copy-seq "abc") '#:|abc|)) + nil) + +;;; Test that it doesn't stop at null characters +(deftest string=.6 + (let ((s1 (copy-seq "abc")) + (s2 (copy-seq "abd")) + (c (or (code-char 0) #\a))) + (setf (char s1 1) c) + (setf (char s2 1) c) + (values (length s1) (length s2) (string= s1 s2))) + 3 3 nil) + +(deftest string=.7 + (loop for i from 0 to 3 + collect (not (string= "abc" "abd" :start1 0 :end1 i :end2 i))) + (nil nil nil t)) + +(deftest string=.8 + (loop for i from 0 to 3 + collect (not (string= "abc" "ab" :end1 i))) + (t t nil t)) + +(deftest string=.9 + (loop for i from 0 to 3 + collect (not (string= "abc" "abd" :start2 0 :end2 i :end1 i))) + (nil nil nil t)) + +(deftest string=.10 + (loop for i from 0 to 3 + collect (not (string= "ab" "abc" :end2 i))) + (t t nil t)) + +(deftest string=.11 + (loop for i from 0 to 3 + collect (not (string= "xyab" "ab" :start1 i))) + (t t nil t)) + +(deftest string=.12 + (loop for i from 0 to 3 + collect (not (string= "ab" "xyab" :start2 i))) + (t t nil t)) + +(deftest string=.13 + (loop for i from 0 to 3 + collect (not (string= "xyab" "ab" :start1 i :end1 nil))) + (t t nil t)) + +(deftest string=.14 + (loop for i from 0 to 3 + collect (not (string= "ab" "xyab" :start2 i :end2 nil))) + (t t nil t)) + +;;; Order of evaluation + +(deftest string=.order.1 + (let ((i 0) x y) + (values + (string= (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string=.order.2 + (let ((i 0) a b c d e f) + (values + (string= (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string=.order.3 + (let ((i 0) a b c d e f) + (values + (string= (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string<=.order.1 + (let ((i 0) x y) + (values + (string<= (progn (setf x (incf i)) "abf") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string<=.order.2 + (let ((i 0) a b c d e f) + (values + (string<= (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string<=.order.3 + (let ((i 0) a b c d e f) + (values + (string<= (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string<.order.1 + (let ((i 0) x y) + (values + (string< (progn (setf x (incf i)) "abf") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string<.order.2 + (let ((i 0) a b c d e f) + (values + (string< (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string<.order.3 + (let ((i 0) a b c d e f) + (values + (string< (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + + +(deftest string/=.order.1 + (let ((i 0) x y) + (values + (string/= (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "abc")) + i x y)) + nil 2 1 2) + +(deftest string/=.order.2 + (let ((i 0) a b c d e f) + (values + (string/= (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abc") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string/=.order.3 + (let ((i 0) a b c d e f) + (values + (string/= (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abc") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string>=.order.1 + (let ((i 0) x y) + (values + (string<= (progn (setf x (incf i)) "abf") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string>=.order.2 + (let ((i 0) a b c d e f) + (values + (string>= (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string>=.order.3 + (let ((i 0) a b c d e f) + (values + (string>= (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string>.order.1 + (let ((i 0) x y) + (values + (string> (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string>.order.2 + (let ((i 0) a b c d e f) + (values + (string> (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string>.order.3 + (let ((i 0) a b c d e f) + (values + (string> (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + + +(deftest string-equal.order.1 + (let ((i 0) x y) + (values + (string-equal (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string-equal.order.2 + (let ((i 0) a b c d e f) + (values + (string-equal (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-equal.order.3 + (let ((i 0) a b c d e f) + (values + (string-equal (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-not-greaterp.order.1 + (let ((i 0) x y) + (values + (string-not-greaterp (progn (setf x (incf i)) "abf") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string-not-greaterp.order.2 + (let ((i 0) a b c d e f) + (values + (string-not-greaterp (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-not-greaterp.order.3 + (let ((i 0) a b c d e f) + (values + (string-not-greaterp (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-lessp.order.1 + (let ((i 0) x y) + (values + (string-lessp (progn (setf x (incf i)) "abf") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string-lessp.order.2 + (let ((i 0) a b c d e f) + (values + (string-lessp (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-lessp.order.3 + (let ((i 0) a b c d e f) + (values + (string-lessp (progn (setf a (incf i)) "abf") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + + +(deftest string-not-equal.order.1 + (let ((i 0) x y) + (values + (string-not-equal (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "abc")) + i x y)) + nil 2 1 2) + +(deftest string-not-equal.order.2 + (let ((i 0) a b c d e f) + (values + (string-not-equal (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abc") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-not-equal.order.3 + (let ((i 0) a b c d e f) + (values + (string-not-equal (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abc") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-not-lessp.order.1 + (let ((i 0) x y) + (values + (string-not-lessp (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string-not-lessp.order.2 + (let ((i 0) a b c d e f) + (values + (string-not-lessp (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-not-lessp.order.3 + (let ((i 0) a b c d e f) + (values + (string-not-lessp (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-greaterp.order.1 + (let ((i 0) x y) + (values + (string-greaterp (progn (setf x (incf i)) "abc") + (progn (setf y (incf i)) "abd")) + i x y)) + nil 2 1 2) + +(deftest string-greaterp.order.2 + (let ((i 0) a b c d e f) + (values + (string-greaterp (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :start1 (progn (setf c (incf i)) 0) + :start2 (progn (setf d (incf i)) 0) + :end1 (progn (setf e (incf i)) nil) + :end2 (progn (setf f (incf i)) nil) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + +(deftest string-greaterp.order.3 + (let ((i 0) a b c d e f) + (values + (string-greaterp (progn (setf a (incf i)) "abc") + (progn (setf b (incf i)) "abd") + :end2 (progn (setf c (incf i)) nil) + :end1 (progn (setf d (incf i)) nil) + :start2 (progn (setf e (incf i)) 0) + :start1 (progn (setf f (incf i)) 0) + ) + i a b c d e f)) + nil 6 1 2 3 4 5 6) + + +;;; Random tests (of all the string comparson functions) + +(deftest random-string-comparison-tests + (loop for cmp in '(= /= < > <= >=) + append + (loop for case in '(nil t) + collect + (list cmp case + (random-string-compare-test 10 cmp case 1000)))) + ((= nil 0) (= t 0) (/= nil 0) (/= t 0) (< nil 0) (< t 0) + (> nil 0) (> t 0) (<= nil 0) (<= t 0) (>= nil 0) (>= t 0))) + + + + + + + + + + + + diff --git a/ansi-tests/string-downcase.lsp b/ansi-tests/string-downcase.lsp new file mode 100644 index 0000000..a1c4dd2 --- /dev/null +++ b/ansi-tests/string-downcase.lsp @@ -0,0 +1,128 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Sep 30 21:41:59 2002 +;;;; Contains: Tests for STRING-DOWNCASE + +(in-package :cl-test) + +(deftest string-downcase.1 + (let ((s "A")) + (values (string-downcase s) s)) + "a" "A") + +(deftest string-downcase.2 + (let ((s "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) + (values (string-downcase s) s)) + "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz") + +(deftest string-downcase.3 + (let ((s "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ")) + (values (string-downcase s) s)) + "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ " + "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ") + +(deftest string-downcase.4 + (string-downcase #\A) + "a") + +(deftest string-downcase.5 + (let ((sym '|A|)) + (values (string-downcase sym) sym)) + "a" |A|) + +(deftest string-downcase.6 + (let ((s (make-array 6 :element-type 'character + :initial-contents '(#\A #\B #\C #\D #\E #\F)))) + (values (string-downcase s) s)) + "abcdef" + "ABCDEF") + +(deftest string-downcase.7 + (let ((s (make-array 6 :element-type 'standard-char + :initial-contents '(#\A #\B #\7 #\D #\E #\F)))) + (values (string-downcase s) s)) + "ab7def" + "AB7DEF") + +;; Tests with :start, :end + +(deftest string-downcase.8 + (let ((s "ABCDEF")) + (values + (loop for i from 0 to 6 + collect (string-downcase s :start i)) + s)) + ("abcdef" "Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF") + "ABCDEF") + +(deftest string-downcase.9 + (let ((s "ABCDEF")) + (values + (loop for i from 0 to 6 + collect (string-downcase s :start i :end nil)) + s)) + ("abcdef" "Abcdef" "ABcdef" "ABCdef" "ABCDef" "ABCDEf" "ABCDEF") + "ABCDEF") + +(deftest string-downcase.10 + (let ((s "ABCDE")) + (values + (loop for i from 0 to 4 + collect (loop for j from i to 5 + collect (string-invertcase + (string-downcase s :start i :end j)))) + s)) + (("abcde" "Abcde" "ABcde" "ABCde" "ABCDe" "ABCDE") + ("abcde" "aBcde" "aBCde" "aBCDe" "aBCDE") + ("abcde" "abCde" "abCDe" "abCDE") + ("abcde" "abcDe" "abcDE") + ("abcde" "abcdE")) + "ABCDE") + +(deftest string-downcase.order.1 + (let ((i 0) a b c (s (copy-seq "ABCDEF"))) + (values + (string-downcase + (progn (setf a (incf i)) s) + :start (progn (setf b (incf i)) 1) + :end (progn (setf c (incf i)) 4)) + i a b c)) + "AbcdEF" 3 1 2 3) + +(deftest string-downcase.order.2 + (let ((i 0) a b c (s (copy-seq "ABCDEF"))) + (values + (string-downcase + (progn (setf a (incf i)) s) + :end (progn (setf b (incf i)) 4) + :start (progn (setf c (incf i)) 1)) + i a b c)) + "AbcdEF" 3 1 2 3) + +;;; Error cases + +(deftest string-downcase.error.1 + (classify-error (string-downcase)) + program-error) + +(deftest string-downcase.error.2 + (classify-error (string-downcase (copy-seq "abc") :bad t)) + program-error) + +(deftest string-downcase.error.3 + (classify-error (string-downcase (copy-seq "abc") :start)) + program-error) + +(deftest string-downcase.error.4 + (classify-error (string-downcase (copy-seq "abc") :bad t + :allow-other-keys nil)) + program-error) + +(deftest string-downcase.error.5 + (classify-error (string-downcase (copy-seq "abc") :end)) + program-error) + +(deftest string-downcase.error.6 + (classify-error (string-downcase (copy-seq "abc") 1 2)) + program-error) diff --git a/ansi-tests/string-left-trim.lsp b/ansi-tests/string-left-trim.lsp new file mode 100644 index 0000000..c620670 --- /dev/null +++ b/ansi-tests/string-left-trim.lsp @@ -0,0 +1,165 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 4 04:57:41 2002 +;;;; Contains: Tests for STRING-LEFT-TRIM + +(in-package :cl-test) + +(deftest string-left-trim.1 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim "ab" s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.2 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim '(#\a #\b) s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.3 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim #(#\a #\b) s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.4 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b)) + s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.5 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'character) + s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.6 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'standard-char) + s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.7 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'base-char) + s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.8 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-left-trim (make-array 4 :initial-contents '(#\a #\b #\c #\d) + :element-type 'character + :fill-pointer 2) + s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.9 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'character + )) + (s2 (string-left-trim "ab" s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.10 + (let* ((s (make-array 9 :initial-contents "abcdabadd" + :element-type 'character + :fill-pointer 7)) + (s2 (string-left-trim "ab" s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.11 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'standard-char + )) + (s2 (string-left-trim "ab" s))) + (values s s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.12 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'base-char + )) + (s2 (string-left-trim "ab" s))) + (values s s2)) + "abcdaba" + "cdaba") + +;;; Test that trimming is case sensitive +(deftest string-left-trim.13 + (let* ((s (copy-seq "aA")) + (s2 (string-left-trim "a" s))) + (values s s2)) + "aA" "A") + +(deftest string-left-trim.14 + (let* ((s '|abcdaba|) + (s2 (string-left-trim "ab" s))) + (values (symbol-name s) s2)) + "abcdaba" + "cdaba") + +(deftest string-left-trim.15 + (string-left-trim "abc" "") + "") + +(deftest string-left-trim.16 + (string-left-trim "a" #\a) + "") + +(deftest string-left-trim.17 + (string-left-trim "b" #\a) + "a") + +(deftest string-left-trim.18 + (string-left-trim "" (copy-seq "abcde")) + "abcde") + +(deftest string-left-trim.19 + (string-left-trim "abc" (copy-seq "abcabcabc")) + "") + +(deftest string-left-trim.order.1 + (let ((i 0) x y) + (values + (string-left-trim (progn (setf x (incf i)) " ") + (progn (setf y (incf i)) + (copy-seq " abc d e f "))) + i x y)) + "abc d e f " 2 1 2) + +;;; Error cases + +(deftest string-left-trim.error.1 + (classify-error (string-left-trim)) + program-error) + +(deftest string-left-trim.error.2 + (classify-error (string-left-trim "abc")) + program-error) + +(deftest string-left-trim.error.3 + (classify-error (string-left-trim "abc" "abcdddabc" nil)) + program-error) diff --git a/ansi-tests/string-right-trim.lsp b/ansi-tests/string-right-trim.lsp new file mode 100644 index 0000000..883348e --- /dev/null +++ b/ansi-tests/string-right-trim.lsp @@ -0,0 +1,165 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 4 04:59:46 2002 +;;;; Contains: Tests of STRING-RIGHT-TRIM + +(in-package :cl-test) + +(deftest string-right-trim.1 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim "ab" s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.2 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim '(#\a #\b) s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.3 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim #(#\a #\b) s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.4 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b)) + s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.5 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'character) + s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.6 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'standard-char) + s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.7 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'base-char) + s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.8 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-right-trim (make-array 4 :initial-contents '(#\a #\b #\c #\d) + :element-type 'character + :fill-pointer 2) + s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.9 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'character + )) + (s2 (string-right-trim "ab" s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.10 + (let* ((s (make-array 9 :initial-contents "abcdabadd" + :element-type 'character + :fill-pointer 7)) + (s2 (string-right-trim "ab" s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.11 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'standard-char + )) + (s2 (string-right-trim "ab" s))) + (values s s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.12 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'base-char + )) + (s2 (string-right-trim "ab" s))) + (values s s2)) + "abcdaba" + "abcd") + +;;; Test that trimming is case sensitive +(deftest string-right-trim.13 + (let* ((s (copy-seq "Aa")) + (s2 (string-right-trim "a" s))) + (values s s2)) + "Aa" "A") + +(deftest string-right-trim.14 + (let* ((s '|abcdaba|) + (s2 (string-right-trim "ab" s))) + (values (symbol-name s) s2)) + "abcdaba" + "abcd") + +(deftest string-right-trim.15 + (string-right-trim "abc" "") + "") + +(deftest string-right-trim.16 + (string-right-trim "a" #\a) + "") + +(deftest string-right-trim.17 + (string-right-trim "b" #\a) + "a") + +(deftest string-right-trim.18 + (string-right-trim "" (copy-seq "abcde")) + "abcde") + +(deftest string-right-trim.19 + (string-right-trim "abc" (copy-seq "abcabcabc")) + "") + +(deftest string-right-trim.order.1 + (let ((i 0) x y) + (values + (string-right-trim (progn (setf x (incf i)) " ") + (progn (setf y (incf i)) + (copy-seq " abc d e f "))) + i x y)) + " abc d e f" 2 1 2) + +;;; Error cases + +(deftest string-right-trim.error.1 + (classify-error (string-right-trim)) + program-error) + +(deftest string-right-trim.error.2 + (classify-error (string-right-trim "abc")) + program-error) + +(deftest string-right-trim.error.3 + (classify-error (string-right-trim "abc" "abcdddabc" nil)) + program-error) diff --git a/ansi-tests/string-trim.lsp b/ansi-tests/string-trim.lsp new file mode 100644 index 0000000..a722268 --- /dev/null +++ b/ansi-tests/string-trim.lsp @@ -0,0 +1,165 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 3 21:53:38 2002 +;;;; Contains: Tests for STRING-TRIM + +(in-package :cl-test) + +(deftest string-trim.1 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim "ab" s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.2 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim '(#\a #\b) s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.3 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim #(#\a #\b) s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.4 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim (make-array 2 :initial-contents '(#\a #\b)) + s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.5 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'character) + s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.6 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'standard-char) + s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.7 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim (make-array 2 :initial-contents '(#\a #\b) + :element-type 'base-char) + s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.8 + (let* ((s (copy-seq "abcdaba")) + (s2 (string-trim (make-array 4 :initial-contents '(#\a #\b #\c #\d) + :element-type 'character + :fill-pointer 2) + s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.9 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'character + )) + (s2 (string-trim "ab" s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.10 + (let* ((s (make-array 9 :initial-contents "abcdabadd" + :element-type 'character + :fill-pointer 7)) + (s2 (string-trim "ab" s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.11 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'standard-char + )) + (s2 (string-trim "ab" s))) + (values s s2)) + "abcdaba" + "cd") + +(deftest string-trim.12 + (let* ((s (make-array 7 :initial-contents "abcdaba" + :element-type 'base-char + )) + (s2 (string-trim "ab" s))) + (values s s2)) + "abcdaba" + "cd") + +;;; Test that trimming is case sensitive +(deftest string-trim.13 + (let* ((s (copy-seq "Aa")) + (s2 (string-trim "a" s))) + (values s s2)) + "Aa" "A") + +(deftest string-trim.14 + (let* ((s '|abcdaba|) + (s2 (string-trim "ab" s))) + (values (symbol-name s) s2)) + "abcdaba" + "cd") + +(deftest string-trim.15 + (string-trim "abc" "") + "") + +(deftest string-trim.16 + (string-trim "a" #\a) + "") + +(deftest string-trim.17 + (string-trim "b" #\a) + "a") + +(deftest string-trim.18 + (string-trim "" (copy-seq "abcde")) + "abcde") + +(deftest string-trim.19 + (string-trim "abc" (copy-seq "abcabcabc")) + "") + +(deftest string-trim.order.1 + (let ((i 0) x y) + (values + (string-trim (progn (setf x (incf i)) " ") + (progn (setf y (incf i)) + (copy-seq " abc d e f "))) + i x y)) + "abc d e f" 2 1 2) + +;;; Error cases + +(deftest string-trim.error.1 + (classify-error (string-trim)) + program-error) + +(deftest string-trim.error.2 + (classify-error (string-trim "abc")) + program-error) + +(deftest string-trim.error.3 + (classify-error (string-trim "abc" "abcdddabc" nil)) + program-error) diff --git a/ansi-tests/string-upcase.lsp b/ansi-tests/string-upcase.lsp new file mode 100644 index 0000000..4999f5c --- /dev/null +++ b/ansi-tests/string-upcase.lsp @@ -0,0 +1,129 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Oct 1 07:51:00 2002 +;;;; Contains: Tests for STRING-UPCASE + +(in-package :cl-test) + +(deftest string-upcase.1 + (let ((s "a")) + (values (string-upcase s) s)) + "A" "a") + +(deftest string-upcase.2 + (let ((s "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) + (values (string-upcase s) s)) + "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ" + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz") + +(deftest string-upcase.3 + (let ((s "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ")) + (values (string-upcase s) s)) + "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ " + "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ") + +(deftest string-upcase.4 + (string-upcase #\a) + "A") + +(deftest string-upcase.5 + (let ((sym '|a|)) + (values (string-upcase sym) sym)) + "A" |a|) + +(deftest string-upcase.6 + (let ((s (make-array 6 :element-type 'character + :initial-contents '(#\a #\b #\c #\d #\e #\f)))) + (values (string-upcase s) s)) + "ABCDEF" + "abcdef") + +(deftest string-upcase.7 + (let ((s (make-array 6 :element-type 'standard-char + :initial-contents '(#\a #\b #\7 #\d #\e #\f)))) + (values (string-upcase s) s)) + "AB7DEF" + "ab7def") + +;; Tests with :start, :end + +(deftest string-upcase.8 + (let ((s "abcdef")) + (values + (loop for i from 0 to 6 + collect (string-upcase s :start i)) + s)) + ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef") + "abcdef") + +(deftest string-upcase.9 + (let ((s "abcdef")) + (values + (loop for i from 0 to 6 + collect + (string-upcase s :start i :end nil)) + s)) + ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef") + "abcdef") + +(deftest string-upcase.10 + (let ((s "abcde")) + (values + (loop for i from 0 to 4 + collect (loop for j from i to 5 + collect (string-upcase s :start i :end j))) + s)) + (("abcde" "Abcde" "ABcde" "ABCde" "ABCDe" "ABCDE") + ("abcde" "aBcde" "aBCde" "aBCDe" "aBCDE") + ("abcde" "abCde" "abCDe" "abCDE") + ("abcde" "abcDe" "abcDE") + ("abcde" "abcdE")) + "abcde") + +(deftest string-upcase.order.1 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (string-upcase + (progn (setf a (incf i)) s) + :start (progn (setf b (incf i)) 1) + :end (progn (setf c (incf i)) 4)) + i a b c)) + "aBCDef" 3 1 2 3) + +(deftest string-upcase.order.2 + (let ((i 0) a b c (s (copy-seq "abcdef"))) + (values + (string-upcase + (progn (setf a (incf i)) s) + :end (progn (setf b (incf i)) 4) + :start (progn (setf c (incf i)) 1)) + i a b c)) + "aBCDef" 3 1 2 3) + + +;;; Error cases + +(deftest string-upcase.error.1 + (classify-error (string-upcase)) + program-error) + +(deftest string-upcase.error.2 + (classify-error (string-upcase (copy-seq "abc") :bad t)) + program-error) + +(deftest string-upcase.error.3 + (classify-error (string-upcase (copy-seq "abc") :start)) + program-error) + +(deftest string-upcase.error.4 + (classify-error (string-upcase (copy-seq "abc") :bad t + :allow-other-keys nil)) + program-error) + +(deftest string-upcase.error.5 + (classify-error (string-upcase (copy-seq "abc") :end)) + program-error) + +(deftest string-upcase.error.6 + (classify-error (string-upcase (copy-seq "abc") 1 2)) + program-error) diff --git a/ansi-tests/string.lsp b/ansi-tests/string.lsp new file mode 100644 index 0000000..6752ddb --- /dev/null +++ b/ansi-tests/string.lsp @@ -0,0 +1,202 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Sep 30 19:16:59 2002 +;;;; Contains: Tests for string related functions and classes + +(in-package :cl-test) + +(deftest string.1 + (subtypep* 'string 'array) + t t) + +(deftest string.2 + (subtypep* 'string 'vector) + t t) + +(deftest string.3 + (subtypep* 'string 'sequence) + t t) + +(deftest string.4 + (let ((s (string #\a))) + (values (notnot (stringp s)) s)) + t "a") + +(deftest string.5 + (let ((s (string ""))) + (values (notnot (stringp s)) s)) + t "") + +(deftest string.6 + (let ((s (string '|FOO|))) + (values (notnot (stringp s)) s)) + t "FOO") + +(deftest string.7 + (loop for x in *universe* + always (handler-case (stringp (string x)) + (type-error () :caught))) + t) + +;;; Tests of base-string + +(deftest base-string.1 + (subtypep* 'base-string 'string) + t t) + +(deftest base-string.2 + (subtypep* 'base-string 'vector) + t t) + +(deftest base-string.3 + (subtypep* 'base-string 'array) + t t) + +(deftest base-string.4 + (subtypep* 'base-string 'sequence) + t t) + +;;; Tests of simple-string + +(deftest simple-string.1 + (subtypep* 'simple-string 'string) + t t) + +(deftest simple-string.2 + (subtypep* 'simple-string 'vector) + t t) + +(deftest simple-string.3 + (subtypep* 'simple-string 'simple-array) + t t) + +(deftest simple-string.4 + (subtypep* 'simple-string 'array) + t t) + +(deftest simple-string.5 + (subtypep* 'simple-string 'sequence) + t t) + +;;; Tests for simple-base-string + +(deftest simple-base-string.1 + (subtypep* 'simple-base-string 'string) + t t) + +(deftest simple-base-string.2 + (subtypep* 'simple-base-string 'vector) + t t) + +(deftest simple-base-string.3 + (subtypep* 'simple-base-string 'simple-array) + t t) + +(deftest simple-base-string.4 + (subtypep* 'simple-base-string 'array) + t t) + +(deftest simple-base-string.5 + (subtypep* 'simple-base-string 'sequence) + t t) + +(deftest simple-base-string.6 + (subtypep* 'simple-base-string 'base-string) + t t) + +(deftest simple-base-string.7 + (subtypep* 'simple-base-string 'simple-string) + t t) + +(deftest simple-base-string.8 + (subtypep* 'simple-base-string 'simple-vector) + nil t) + +;;; Tests for simple-string-p + +(deftest simple-string-p.1 + (loop for x in *universe* + always (if (typep x 'simple-string) + (simple-string-p x) + (not (simple-string-p x)))) + t) + +(deftest simple-string-p.2 + (notnot (simple-string-p "ancd")) + t) + +(deftest simple-string-p.3 + (simple-string-p 0) + nil) + +(deftest simple-string-p.4 + (simple-string-p (make-array 4 :element-type 'character + :initial-contents '(#\a #\a #\a #\b) + :fill-pointer t)) + nil) + +(deftest simple-string-p.5 + (notnot (simple-string-p (make-array + 4 :element-type 'base-char + :initial-contents '(#\a #\a #\a #\b)))) + t) + +(deftest simple-string-p.6 + (notnot (simple-string-p (make-array + 4 :element-type 'standard-char + :initial-contents '(#\a #\a #\a #\b)))) + t) + +(deftest simple-string-p.7 + (let* ((s (make-array 10 :element-type 'character + :initial-element #\a)) + (s2 (make-array 4 :element-type 'character + :displaced-to s + :displaced-index-offset 2))) + (simple-string-p s2)) + nil) + +;;; Tests of stringp + +(deftest stringp.1 + (loop for x in *universe* + always (if (typep x 'string) + (stringp x) + (not (stringp x)))) + t) + +(deftest stringp.2 + (notnot (stringp "abcd")) + t) + +(deftest stringp.3 + (notnot (stringp (make-array 4 :element-type 'character + :initial-contents '(#\a #\b #\c #\d)))) + t) + +(deftest stringp.4 + (notnot (stringp (make-array 4 :element-type 'base-char + :initial-contents '(#\a #\b #\c #\d)))) + t) + +(deftest stringp.5 + (notnot (stringp (make-array 4 :element-type 'standard-char + :initial-contents '(#\a #\b #\c #\d)))) + t) + +(deftest stringp.6 + (stringp 0) + nil) + +(deftest stringp.7 + (stringp #\a) + nil) + +(deftest stringp.8 + (let* ((s (make-array 10 :element-type 'character + :initial-element #\a)) + (s2 (make-array 4 :element-type 'character + :displaced-to s + :displaced-index-offset 2))) + (notnot (stringp s2))) + t) diff --git a/ansi-tests/structure-00.lsp b/ansi-tests/structure-00.lsp new file mode 100644 index 0000000..d1b00e3 --- /dev/null +++ b/ansi-tests/structure-00.lsp @@ -0,0 +1,552 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat May 9 11:21:25 1998 +;;;; Contains: Common code for creating structure tests + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +(defun make-struct-test-name (structure-name n) + ;; (declare (type (or string symbol character) structure-name) + ;; (type fixnum n)) + (assert (typep structure-name '(or string symbol character))) + ;; (assert (typep n 'fixnum)) + (setf structure-name (string structure-name)) + (intern (concatenate 'string + structure-name + "/" + (princ-to-string n)))) + +(defun make-struct-p-fn (structure-name) + (assert (typep structure-name '(or string symbol character))) + (setf structure-name (string structure-name)) + (intern (concatenate 'string + structure-name + (string '#:-p)))) + +(defun make-struct-copy-fn (structure-name) + (assert (typep structure-name '(or string symbol character))) + (setf structure-name (string structure-name)) + (intern (concatenate 'string + (string '#:copy-) + structure-name))) + +(defun make-struct-field-fn (conc-name field-name) + "Make field accessor for a field in a structure" + (cond + ((null conc-name) field-name) + (t + (assert (typep conc-name '(or string symbol character))) + (assert (typep field-name '(or string symbol character))) + (setf conc-name (string conc-name)) + (setf field-name (string field-name)) + (intern (concatenate 'string conc-name field-name))))) + +(defun make-struct-make-fn (structure-name) + "Make the make- function for a structure" + (assert (typep structure-name '(or string symbol character))) + (setf structure-name (string structure-name)) + (intern (concatenate 'string + (string '#:make-) structure-name))) + +(defun create-instance-of-type (type) + "Return an instance of a type. Signal an error if + it can't figure out a value for the type." + (cond + ((eqt type t) ;; anything + 'a) + ((eqt type 'symbol) + 'b) + ((eqt type 'null) nil) + ((eqt type 'boolean) t) + ((eqt type 'keyword) :foo) + ((eqt type nil) (error "Cannot obtain element of type ~S~%" type)) + ((eqt type 'cons) (cons 'a 'b)) + ((eqt type 'list) (list 1 2 3)) + ((eqt type 'fixnum) 17) + ((eqt type 'bignum) + (let ((x 1)) + (loop until (typep x 'bignum) + do (setq x (* 2 x))) + x)) + ((and (symbolp type) + (typep type 'structure-class)) + (let ((make-fn + (intern (concatenate 'string (string '#:make-) (symbol-name type)) + (symbol-package type)))) + (eval (list make-fn)))) + ((eqt type 'character) #\w) + ((eqt type 'base-char) #\z) + ((member type '(integer unsigned-byte signed-byte)) 35) + ((eqt type 'bit) 1) + ((and (consp type) + (consp (cdr type)) + (consp (cddr type)) + (null (cdddr type)) + (eqt (car type) 'integer) + (integerp (second type))) + (second type)) + ((member type '(float single-float long-float double-float short-float)) + 0.0) + ((and (consp type) + (eqt (car type) 'member) + (consp (cdr type))) + (second type)) + ((and (consp type) + (eqt (car type) 'or) + (consp (second type))) + (create-instance-of-type (second type))) + (t (error "Cannot generate element for type ~S~%" type)))) + +(defun find-option (option-list option &optional default) + (loop for opt in option-list + when (or (eq opt option) + (and (consp opt) + (eq (car opt) option))) + return opt + finally (return default))) + +(defvar *defstruct-with-tests-names* nil + "Names of structure types defined with DEFSRUCT-WITH-TESTS.") + +#| +(defvar *subtypep-works-with-classes* t + "Becomes NIL if SUBTYPEP doesn't work with classes. We test this first to avoid + repeated test failures that cause GCL to bomb.") + +(deftest subtypep-works-with-classes + (let ((c1 (find-class 'vector))) + ;; (setq *subtypep-works-with-classes* nil) + (subtypep c1 'vector) + (subtypep 'vector c1) + ;; (setq *subtypep-works-with-classes* t)) + t) + +(defvar *typep-works-with-classes* t + "Becomes NIL if TYPEP doesn't work with classes. We test this first to avoid + repeated test failures that cause GCL to bomb.") + +(deftest typep-works-with-classes + (let ((c1 (find-class 'vector))) + ;; (setq *typep-works-with-classes* nil) + (typep #(0 0) c1) + ;; (setq *typep-works-with-classes* t)) + t) +|# + +;; +;; There are a number of standardized tests for +;; structures. The following macro generates the +;; structure definition and the tests. +;; + +(defmacro defstruct-with-tests + (name-and-options &body slot-descriptions-and-documentation) +"Construct standardized tests for a defstruct, and also +do the defstruct." + (defstruct-with-tests-fun name-and-options + slot-descriptions-and-documentation)) + +(defun defstruct-with-tests-fun (name-and-options + slot-descriptions-and-documentation) + ;; Function called from macro defstruct-with-tests + (let* ( + ;; Either NIL or the documentation string for the structure + (doc-string + (when (and (consp slot-descriptions-and-documentation) + (stringp (car slot-descriptions-and-documentation))) + (car slot-descriptions-and-documentation))) + + ;; The list of slot descriptions that follows either the + ;; name and options or the doc string + (slot-descriptions + (if doc-string (cdr slot-descriptions-and-documentation) + slot-descriptions-and-documentation)) + + ;; The name of the structure (should be a symbol) + (name (if (consp name-and-options) + (car name-and-options) + name-and-options)) + + ;; The options list, or NIL if there were no options + (options (if (consp name-and-options) + (cdr name-and-options) + nil)) + + ;; List of symbols that are the names of the slots + (slot-names + (loop + for x in slot-descriptions collect + (if (consp x) (car x) x))) + + ;; List of slot types, if any + (slot-types + (loop + for x in slot-descriptions collect + (if (consp x) + (getf (cddr x) :type :none) + :none))) + + ;; read-only flags for slots + (slot-read-only + (loop + for x in slot-descriptions collect + (and (consp x) + (getf (cddr x) :read-only)))) + + ;; Symbol obtained by prepending MAKE- to the name symbol + (make-fn (make-struct-make-fn name)) + + ;; The type option, if specified + (type-option (find-option options :type)) + (struct-type (second type-option)) + + (named-option (find-option options :named)) + (include-option (find-option options :include)) + + ;; The :predicate option entry from OPTIONS, or NIL if none + (predicate-option (find-option options :predicate)) + + ;; The name of the -P function, either the default or the + ;; one specified in the :predicate option + (p-fn-default (make-struct-p-fn name)) + (p-fn (cond + ((and type-option (not named-option)) nil) + ((or (eq predicate-option :predicate) + (null (cdr predicate-option))) + p-fn-default) + ((cadr predicate-option) (cadr predicate-option)) + (t nil))) + + ;; The :copier option, or NIL if no such option specified + (copier-option (find-option options :copier)) + ;; The name of the copier function, either the default or + ;; one speciefied in the :copier option + (copy-fn-default (make-struct-copy-fn name)) + (copy-fn (cond + ((or (eq copier-option :copier) + (null (cdr copier-option))) + copy-fn-default) + ((cadr copier-option) (cadr copier-option)) + (t nil))) + + ;; The :conc-name option, or NIL if none specified + (conc-option (find-option options :conc-name)) + ;; String to be prepended to slot names to get the + ;; slot accessor function + (conc-prefix-default (concatenate 'string (string name) "-")) + (conc-prefix (cond + ((null conc-option) + conc-prefix-default) + ((or (eq conc-option :conc-name) + (null (cadr conc-option))) + nil) + (t (string (cadr conc-option))))) + + (initial-offset-option (find-option options :initial-offset)) + (initial-offset (second initial-offset-option)) + + ;; Accessor names + (field-fns + (loop for slot-name in slot-names + collect (make-struct-field-fn conc-prefix slot-name))) + + ;; a list of initial values + (initial-value-alist + (loop + for slot-desc in slot-descriptions + for slot-name in slot-names + for type in slot-types + for i from 1 + collect (if (not (eq type :none)) + (cons slot-name (create-instance-of-type type)) + (cons slot-name (defstruct-maketemp name "SLOTTEMP" i))))) + ) + ;; Build the tests in an eval-when form + `(eval-when (compile load eval) + + (ignore-errors + (eval '(defstruct ,name-and-options + ,@slot-descriptions-and-documentation)) + ,(unless (or type-option include-option) + `(pushnew ',name *defstruct-with-tests-names*)) + nil) + + ;; Test that structure is of the correct type + (deftest ,(make-struct-test-name name 1) + (and (fboundp (quote ,make-fn)) + (functionp (function ,make-fn)) + (symbol-function (quote ,make-fn)) + (typep (,make-fn) (quote ,(if type-option struct-type + name))) + t) + t) + + ;; Test that the predicate exists + ,@(when p-fn + `((deftest ,(make-struct-test-name name 2) + (let ((s (,make-fn))) + (and (fboundp (quote ,p-fn)) + (functionp (function ,p-fn)) + (symbol-function (quote ,p-fn)) + (notnot (funcall #',p-fn s)) + (notnot-mv (,p-fn s)) + )) + t) + (deftest ,(make-struct-test-name name "ERROR.1") + (classify-error (,p-fn)) + program-error) + (deftest ,(make-struct-test-name name "ERROR.2") + (classify-error (,p-fn (,make-fn) nil)) + program-error) + )) + + ;; Test that the elements of *universe* are not + ;; of this type + ,@(when p-fn + `((deftest ,(make-struct-test-name name 3) + (count-if (function ,p-fn) *universe*) + 0))) + ,@(unless type-option + `((deftest ,(make-struct-test-name name 4) + (count-if (function (lambda (x) (typep x (quote ,name)))) + *universe*) + 0))) + + ;; Check that the fields can be read after being initialized + (deftest ,(make-struct-test-name name 5) + ,(let ((inits nil) + (tests nil) + (var (defstruct-maketemp name "TEMP-5"))) + (loop + for (slot-name . initval) in initial-value-alist + for field-fn in field-fns + do + (setf inits + (list* (intern (string slot-name) "KEYWORD") + (list 'quote initval) + inits)) + (push `(and + (eqlt (quote ,initval) + (,field-fn ,var)) + (eqlt (quote ,initval) + (funcall #',field-fn ,var))) + tests)) + `(let ((,var (,make-fn . ,inits))) + (and ,@tests t))) + t) + + (deftest ,(make-struct-test-name name "ERROR.3") + (remove nil + (list + ,@(loop + for (slot-name . initval) in initial-value-alist + for field-fn in field-fns + collect + `(let ((x (classify-error (,field-fn)))) + (unless (eqt x 'program-error) + (list ',slot-name ',field-fn x)))))) + nil) + + (deftest ,(make-struct-test-name name "ERROR.4") + (remove nil + (list + ,@(loop + for (slot-name . initval) in initial-value-alist + for field-fn in field-fns + collect + `(let ((x (classify-error (,field-fn (,make-fn) nil)))) + (unless (eqt x 'program-error) + (list ',slot-name ',field-fn x)))))) + nil) + + ;; Check that two invocations return different structures + (deftest ,(make-struct-test-name name 6) + (eqt (,make-fn) (,make-fn)) + nil) + + ;; Check that we can setf the fields + (deftest ,(make-struct-test-name name 7) + ,(let* ((var (defstruct-maketemp name "TEMP-7-1")) + (var2 (defstruct-maketemp name "TEMP-7-2")) + (tests + (loop + for (slot-name . initval) in initial-value-alist + for read-only-p in slot-read-only + for slot-desc in slot-descriptions + for field-fn in field-fns + unless read-only-p + collect + `(let ((,var2 (quote ,initval))) + (setf (,field-fn ,var) ,var2) + (eqlt (,field-fn ,var) ,var2))))) + `(let ((,var (,make-fn))) + (and ,@tests t))) + t) + + ;; Check that the copy function exists + ,@(when copy-fn + `((deftest ,(make-struct-test-name name 8) + (and (fboundp (quote ,copy-fn)) + (functionp (function ,copy-fn)) + (symbol-function (quote ,copy-fn)) + t) + t) + (deftest ,(make-struct-test-name name "ERROR.5") + (classify-error (,copy-fn)) + program-error) + (deftest ,(make-struct-test-name name "ERROR.6") + (classify-error (,copy-fn (,make-fn) nil)) + program-error) + )) + + ;; Check that the copy function properly copies fields + ,@(when copy-fn + `((deftest ,(make-struct-test-name name 9) + ,(let* ((var 'XTEMP-9) + (var2 'YTEMP-9) + (var3 'ZTEMP-9)) + `(let ((,var (,make-fn + ,@(loop + for (slot-name . initval) + in initial-value-alist + nconc (list (intern (string slot-name) + "KEYWORD") + `(quote ,initval)))))) + (let ((,var2 (,copy-fn ,var)) + (,var3 (funcall #',copy-fn ,var))) + (and + (not (eqlt ,var ,var2)) + (not (eqlt ,var ,var3)) + (not (eqlt ,var2 ,var3)) + ,@(loop + for (slot-name . nil) in initial-value-alist + for fn in field-fns + collect + `(and (eqlt (,fn ,var) (,fn ,var2)) + (eqlt (,fn ,var) (,fn ,var3)))) + t)))) + t))) + + ;; When the predicate is not the default, check + ;; that the default is not defined. Tests should + ;; be designed so that this function name doesn't + ;; collide with anything else. + ,@(unless (eq p-fn p-fn-default) + `((deftest ,(make-struct-test-name name 10) + (fboundp (quote ,p-fn-default)) + nil))) + + ;; When the copy function name is not the default, check + ;; that the default function is not defined. Tests should + ;; be designed so that this name is not accidently defined + ;; for something else. + ,@(unless (eq copy-fn copy-fn-default) + `((deftest ,(make-struct-test-name name 11) + (fboundp (quote ,copy-fn-default)) + nil))) + + ;; When there are read-only slots, test that the SETF + ;; form for them is not FBOUNDP + ,@(when (loop for x in slot-read-only thereis x) + `((deftest ,(make-struct-test-name name 12) + (and + ,@(loop for slot-name in slot-names + for read-only in slot-read-only + for field-fn in field-fns + when read-only + collect `(not-mv (fboundp '(setf ,field-fn)))) + t) + t))) + + ;; When the structure is a true structure type, check that + ;; the various class relationships hold + ,@(unless type-option + `( + (deftest ,(make-struct-test-name name 13) + (notnot-mv (typep (,make-fn) (find-class (quote ,name)))) + t) + (deftest ,(make-struct-test-name name 14) + (let ((class (find-class (quote ,name)))) + (notnot-mv (typep class 'structure-class))) + t) + (deftest ,(make-struct-test-name name 15) + (notnot-mv (typep (,make-fn) 'structure-object)) + t) + (deftest ,(make-struct-test-name name 16) + (loop for type in *disjoint-types-list* + unless (and + (equalt (multiple-value-list + (subtypep* type (quote ,name))) + '(nil t)) + (equalt (multiple-value-list + (subtypep* (quote ,name) type)) + '(nil t))) + collect type) + nil) + (deftest ,(make-struct-test-name name 17) + (let ((class (find-class (quote ,name)))) + (loop for type in *disjoint-types-list* + unless (and + (equalt (multiple-value-list + (subtypep* type class)) + '(nil t)) + (equalt (multiple-value-list + (subtypep* class type)) + '(nil t))) + collect type)) + nil) + (deftest ,(make-struct-test-name name "15A") + (let ((class (find-class (quote ,name)))) + (notnot-mv (subtypep class 'structure-object))) + t t) + (deftest ,(make-struct-test-name name "15B") + (notnot-mv (subtypep (quote ,name) 'structure-object)) + t t) + + )) + + ;;; Documentation tests + + ,(when doc-string + `(deftest ,(make-struct-test-name name 18) + (let ((doc (documentation ',name 'structure))) + (or (null doc) (equalt doc ',doc-string))) + t)) + + ,(when (and doc-string (not type-option)) + `(deftest ,(make-struct-test-name name 19) + (let ((doc (documentation ',name 'type))) + (or (null doc) (equalt doc ',doc-string))) + t)) + + ;; Test that COPY-STRUCTURE works, if this is a structure + ;; type + ,@(unless type-option + `((deftest ,(make-struct-test-name name 20) + ,(let* ((var 'XTEMP-20) + (var2 'YTEMP-20)) + `(let ((,var (,make-fn + ,@(loop + for (slot-name . initval) + in initial-value-alist + nconc (list (intern (string slot-name) + "KEYWORD") + `(quote ,initval)))))) + (let ((,var2 (copy-structure ,var))) + (and + (not (eqlt ,var ,var2)) + ,@(loop + for (slot-name . nil) in initial-value-alist + for fn in field-fns + collect + `(eqlt (,fn ,var) (,fn ,var2))) + t)))) + t))) + nil + ))) + +(defun defstruct-maketemp (stem suffix1 &optional suffix2) + "Make a temporary variable for DEFSTRUCT-WITH-TESTS." + (intern (if suffix2 (format nil "~A-~A-~A" stem suffix1 suffix2) + (format nil "~A-~A" stem suffix1)))) diff --git a/ansi-tests/structures-01.lsp b/ansi-tests/structures-01.lsp new file mode 100644 index 0000000..022adff --- /dev/null +++ b/ansi-tests/structures-01.lsp @@ -0,0 +1,103 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat May 2 21:45:32 1998 +;;;; Contains: Test code for structures, part 01 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;;; Tests for structures +;;; +;;; The CL Spec leaves undefined just what will happen when a structure is +;;; redefined. These tests don't redefine structures, but reloading a file +;;; with structure definition will do so. I assume that this leaves the +;;; structure type unchanged. + +;; Test simple defstruct (fields, no options) + +(defstruct s-1 + foo bar) + +;; Test that make-s-1 produces objects +;; of the correct type +(deftest structure-1-1 + (notnot-mv (typep (make-s-1) 's-1)) + t) + +;; Test that the -p predicate exists +(deftest structure-1-2 + (notnot-mv (s-1-p (make-s-1))) + t) + +;; Test that all the objects in the universe are +;; not of this type +(deftest structure-1-3 + (count-if #'s-1-p *universe*) + 0) + +(deftest structure-1-4 + (count-if #'(lambda (x) (typep x 's-1)) *universe*) + 0) + +;; Check that the fields can be read after being initialized +(deftest structure-1-5 + (s-1-foo (make-s-1 :foo 'a)) + a) + +(deftest structure-1-6 + (s-1-bar (make-s-1 :bar 'b)) + b) + +(deftest structure-1-7 + (let ((s (make-s-1 :foo 'c :bar 'd))) + (list (s-1-foo s) (s-1-bar s))) + (c d)) + +;; Can setf the fields +(deftest structure-1-8 + (let ((s (make-s-1))) + (setf (s-1-foo s) 'e) + (setf (s-1-bar s) 'f) + (list (s-1-foo s) (s-1-bar s))) + (e f)) + +(deftest structure-1-9 + (let ((s (make-s-1 :foo 'a :bar 'b))) + (setf (s-1-foo s) 'e) + (setf (s-1-bar s) 'f) + (list (s-1-foo s) (s-1-bar s))) + (e f)) + +;; copier function defined +(deftest structure-1-10 + (let ((s (make-s-1 :foo 'a :bar 'b))) + (let ((s2 (copy-s-1 s))) + (setf (s-1-foo s) nil) + (setf (s-1-bar s) nil) + (list (s-1-foo s2) + (s-1-bar s2)))) + (a b)) + +;; Make produces unique items +(deftest structure-1-11 + (eqt (make-s-1) (make-s-1)) + nil) + +(deftest structure-1-12 + (eqt (make-s-1 :foo 'a :bar 'b) + (make-s-1 :foo 'a :bar 'b)) + nil) + +;; More type and class checks + +(deftest structure-1-13 + (notnot-mv (typep (class-of (make-s-1)) 'structure-class)) + t) + +(deftest structure-1-14 + (notnot-mv (typep (make-s-1) 'structure-object)) + t) + +(deftest structure-1-15 + (subtypep* 's-1 'structure-object) + t t) diff --git a/ansi-tests/structures-02.lsp b/ansi-tests/structures-02.lsp new file mode 100644 index 0000000..357d0f2 --- /dev/null +++ b/ansi-tests/structures-02.lsp @@ -0,0 +1,420 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun May 3 22:46:54 1998 +;;;; Contains: Test code for structures, part 02 + +(in-package :cl-test) +(declaim (optimize (safety 3))) + +;; Test initializers for fields + +(defvar *s-2-f6-counter* 0) + +(defstruct s-2 + (f1 0) + (f2 'a) + (f3 1.21) + (f4 #\d) + (f5 (list 'a 'b)) + (f6 (incf *s-2-f6-counter*))) + +;; Standard structure tests + + +;; Fields have appropriate values +(deftest structure-2-1 + (let ((*s-2-f6-counter* 0)) + (let ((s (make-s-2))) + (and + (eqlt (s-2-f1 s) 0) + (eqt (s-2-f2 s) 'a) + (= (s-2-f3 s) 1.21) + (eqlt (s-2-f4 s) #\d) + (equalt (s-2-f5 s) '(a b)) + (eqlt (s-2-f6 s) *s-2-f6-counter*) + (eqlt *s-2-f6-counter* 1)))) + t) + +;; Two successive invocations of make-s-2 return different objects +(deftest structure-2-2 + (let ((*s-2-f6-counter* 0)) + (eqt (s-2-f5 (make-s-2)) + (s-2-f5 (make-s-2)))) + nil) + +;; Creation with various fields does the right thing +(deftest structure-2-3 + (let* ((*s-2-f6-counter* 0) + (s (make-s-2 :f1 17))) + (and + (eqlt (s-2-f1 s) 17) + (eqt (s-2-f2 s) 'a) + (= (s-2-f3 s) 1.21) + (eqlt (s-2-f4 s) #\d) + (equalt (s-2-f5 s) '(a b)) + (eqlt (s-2-f6 s) *s-2-f6-counter*) + (eqlt *s-2-f6-counter* 1))) + t) + +(deftest structure-2-4 + (let* ((*s-2-f6-counter* 0) + (s (make-s-2 :f2 'z))) + (and + (eqlt (s-2-f1 s) 0) + (eqt (s-2-f2 s) 'z) + (= (s-2-f3 s) 1.21) + (eqlt (s-2-f4 s) #\d) + (equalt (s-2-f5 s) '(a b)) + (eqlt (s-2-f6 s) *s-2-f6-counter*) + (eqlt *s-2-f6-counter* 1))) + t) + +(deftest structure-2-5 + (let* ((*s-2-f6-counter* 0) + (s (make-s-2 :f3 1.0))) + (and + (eqlt (s-2-f1 s) 0) + (eqt (s-2-f2 s) 'a) + (= (s-2-f3 s) 1.0) + (eqlt (s-2-f4 s) #\d) + (equalt (s-2-f5 s) '(a b)) + (eqlt (s-2-f6 s) *s-2-f6-counter*) + (eqlt *s-2-f6-counter* 1))) + t) + +(deftest structure-2-6 + (let* ((*s-2-f6-counter* 0) + (s (make-s-2 :f4 #\z))) + (and + (eqlt (s-2-f1 s) 0) + (eqt (s-2-f2 s) 'a) + (= (s-2-f3 s) 1.21) + (eqlt (s-2-f4 s) #\z) + (equalt (s-2-f5 s) '(a b)) + (eqlt (s-2-f6 s) *s-2-f6-counter*) + (eqlt *s-2-f6-counter* 1))) + t) + +(deftest structure-2-7 + (let* ((*s-2-f6-counter* 0) + (s (make-s-2 :f5 '(c d e)))) + (and + (eqlt (s-2-f1 s) 0) + (eqt (s-2-f2 s) 'a) + (= (s-2-f3 s) 1.21) + (eqlt (s-2-f4 s) #\d) + (equalt (s-2-f5 s) '(c d e)) + (eqlt (s-2-f6 s) *s-2-f6-counter*) + (eqlt *s-2-f6-counter* 1))) + t) + +(deftest structure-2-8 + (let* ((*s-2-f6-counter* 0) + (s (make-s-2 :f6 10))) + (and + (eqlt (s-2-f1 s) 0) + (eqt (s-2-f2 s) 'a) + (= (s-2-f3 s) 1.21) + (eqlt (s-2-f4 s) #\d) + (equalt (s-2-f5 s) '(a b)) + (eqlt (s-2-f6 s) 10) + (eqlt *s-2-f6-counter* 0))) + t) + +;;; Tests using the defstruct-with-tests infrastructure + +(defstruct-with-tests struct-test-03 a b c d) + +(defstruct-with-tests (struct-test-04) a b c) + +(defstruct-with-tests (struct-test-05 :constructor) a05 b05 c05) +(defstruct-with-tests (struct-test-06 (:constructor)) a06 b06 c06) + +(defstruct-with-tests (struct-test-07 :conc-name) a07 b07) +(defstruct-with-tests (struct-test-08 (:conc-name)) a08 b08) +(defstruct-with-tests (struct-test-09 (:conc-name nil)) a09 b09) +(defstruct-with-tests (struct-test-10 (:conc-name "")) a10 b10) +(defstruct-with-tests (struct-test-11 (:conc-name "BLAH-")) a11 b11) +(defstruct-with-tests (struct-test-12 (:conc-name BLAH-)) a12 b12) +(defstruct-with-tests (struct-test-13 (:conc-name #\X)) foo-a13 foo-b13) + +(defstruct-with-tests (struct-test-14 (:predicate)) a14 b14) +(defstruct-with-tests (struct-test-15 (:predicate nil)) a15 b15) +(defstruct-with-tests (struct-test-16 :predicate) a16 b16) +(defstruct-with-tests (struct-test-17 + (:predicate struct-test-17-alternate-pred)) + a17 b17) + +(defstruct-with-tests (struct-test-18 :copier) a18 b18) +(defstruct-with-tests (struct-test-19 (:copier)) a19 b19) +(defstruct-with-tests (struct-test-20 (:copier nil)) a20 b20) +(defstruct-with-tests (struct-test-21 (:copier struct-test-21-alt-copier)) + a21 b21) + +(defstruct-with-tests struct-test-22 (a22) (b22)) +(defstruct-with-tests struct-test-23 (a23 1) (b23 2)) +(defstruct-with-tests struct-test-24 + (a24 1 :type fixnum) + (b24 2 :type integer)) + +(defstruct-with-tests struct-test-25) +(defstruct-with-tests struct-test-26 + (a26 nil :read-only nil) + (b26 'a :read-only nil)) + +(defstruct-with-tests struct-test-27 + (a27 1 :read-only t) + (b27 1.4 :read-only a)) + +(defstruct-with-tests struct-test-28 + (a28 1 :type integer :read-only t) + (b28 'xx :read-only a :type symbol)) + +(defstruct-with-tests struct-test-29 + a29 + (b29 'xx :read-only 1) + c29) + +(defstruct-with-tests struct-test-30 #:a30 #:b30) +(defstruct-with-tests #:struct-test-31 a31 b31) + +(defpackage struct-test-package (:use)) + +(defstruct-with-tests struct-test-32 + struct-test-package::a32 struct-test-package::b32) + +;;; If the :conc-name option is given no argument or +;;; a nil argument, the accessor names are the same as +;;; slot names. Note that this is different from prepending +;;; an empty string, since that may get you a name in +;;; a different package. + +(defstruct-with-tests (struct-test-33 (:conc-name)) + struct-test-package::a33 struct-test-package::b33) +(defstruct-with-tests (struct-test-34 :conc-name) + struct-test-package::a34 struct-test-package::b34) +(defstruct-with-tests (struct-test-35 (:conc-name nil)) + struct-test-package::a35 struct-test-package::b35) + +(defstruct-with-tests (struct-test-36 (:conc-name "")) + struct-test-package::st36-a36 struct-test-package::st26-b36) + +;;; List and vector structures + +(defstruct-with-tests (struct-test-37 (:type list)) a37 b37 c37) + +(deftest structure-37-1 + (make-struct-test-37 :a37 1 :b37 2 :c37 4) + (1 2 4)) + +(defstruct-with-tests (struct-test-38 (:type list) :named) a38 b38 c38) + +(deftest structure-38-1 + (make-struct-test-38 :a38 11 :b38 12 :c38 4) + (struct-test-38 11 12 4)) + +(defstruct-with-tests (struct-test-39 (:predicate nil) + (:type list) :named) + a39 b39 c39) + +(deftest structure-39-1 + (make-struct-test-39 :a39 11 :b39 12 :c39 4) + (struct-test-39 11 12 4)) + +(defstruct-with-tests (struct-test-40 (:type vector)) a40 b40) +(defstruct-with-tests (struct-test-41 (:type vector) :named) a41 b41) +(defstruct-with-tests (struct-test-42 (:type (vector t))) a42 b42) +(defstruct-with-tests (struct-test-43 (:type (vector t)) :named) a43 b43) + +(defstruct-with-tests (struct-test-44 (:type list)) + (a44 0 :type integer) + (b44 'a :type symbol)) + +;;; Confirm that the defined structure types are all disjoint +(deftest structs-are-disjoint + (loop for s1 in *defstruct-with-tests-names* + sum (loop for s2 in *defstruct-with-tests-names* + unless (eq s1 s2) + count (not (equalt (multiple-value-list + (subtypep* s1 s2)) + '(nil t))))) + 0) + +(defstruct-with-tests (struct-test-45 (:type list) (:initial-offset 2)) + a45 b45) + +(deftest structure-45-1 + (cddr (make-struct-test-45 :a45 1 :b45 2)) + (1 2)) + +(defstruct-with-tests (struct-test-46 (:type list) + (:include struct-test-45)) + c46 d46) + +(deftest structure-46-1 + (cddr (make-struct-test-46 :a45 1 :b45 2 :c46 3 :d46 4)) + (1 2 3 4)) + +(defstruct-with-tests (struct-test-47 (:type list) + (:initial-offset 3) + (:include struct-test-45)) + c47 d47) + +(deftest structure-47-1 + (let ((s (make-struct-test-47 :a45 1 :b45 2 :c47 3 :d47 4))) + (values (third s) (fourth s) (eighth s) (ninth s))) + 1 2 3 4) + +(defstruct-with-tests (struct-test-48 (:type list) + (:initial-offset 0) + (:include struct-test-45)) + c48 d48) + +(deftest structure-48-1 + (cddr (make-struct-test-48 :a45 1 :b45 2 :c48 3 :d48 4)) + (1 2 3 4)) + +(defstruct-with-tests (struct-test-49 (:type (vector bit))) + (a49 0 :type bit) + (b49 0 :type bit)) + +(defstruct-with-tests (struct-test-50 (:type (vector character))) + (a50 #\g :type character) + (b50 #\k :type character)) + +(defstruct-with-tests (struct-test-51 (:type (vector (integer 0 255)))) + (a51 17 :type (integer 0 255)) + (b51 25 :type (integer 0 255))) + +(defstruct-with-tests (struct-test-52 (:type vector) + (:initial-offset 0)) + a52 b52) + +(defstruct-with-tests (struct-test-53 (:type vector) + (:initial-offset 5)) + "This is struct-test-53" + a53 b53) + +(deftest structure-53-1 + (let ((s (make-struct-test-53 :a53 10 :b53 'a))) + (values (aref s 5) (aref s 6))) + 10 a) + +(defstruct-with-tests (struct-test-54 (:type vector) + (:initial-offset 2) + (:include struct-test-53)) + "This is struct-test-54" + a54 b54) + +(deftest structure-54-1 + (let ((s (make-struct-test-54 :a53 8 :b53 'g :a54 10 :b54 'a))) + (values (aref s 5) (aref s 6) (aref s 9) (aref s 10))) + 8 g 10 a) + +(defstruct-with-tests (struct-test-55 (:type list) + (:initial-offset 2) + :named) + a55 b55 c55) + +(deftest structure-55-1 + (let ((s (make-struct-test-55 :a55 'p :c55 'q))) + (values (third s) (fourth s) (sixth s))) + struct-test-55 p q) + +(defstruct-with-tests (struct-test-56 (:type list) + (:initial-offset 3) + (:include struct-test-55) + :named) + d56 e56) + +(deftest structure-56-1 + (let ((s (make-struct-test-56 :a55 3 :b55 7 :d56 'x :e56 'y))) + (mapcar #'(lambda (i) (nth i s)) '(2 3 4 9 10 11))) + (struct-test-55 3 7 struct-test-56 x y)) + +(defstruct-with-tests (struct-test-57 (:include struct-test-22)) + c57 d57) + +(defstruct-with-tests struct-test-58 + "This is struct-test-58" a-58 b-58) + +(defstruct-with-tests (struct-test-59 (:include struct-test-58)) + "This is struct-test-59" a-59 b-59) + +;;; When a field name of a structure is also a special variable, +;;; the constructor must not bind that name. + +(defvar *st-60* 100) + +(defstruct-with-tests struct-test-60 + (a60 *st-60* :type integer) + (*st-60* 0 :type integer) + (b60 *st-60* :type integer)) + +(deftest structure-60-1 + (let ((*st-60* 10)) + (let ((s (make-struct-test-60 :*st-60* 200))) + (values (struct-test-60-a60 s) + (struct-test-60-*st-60* s) + (struct-test-60-b60 s)))) + 10 200 10) + + +;;; When default initializers of the wrong type are given, they do not +;;; cause an error unless actually invoked + +(defstruct struct-test-61 + (a nil :type integer) + (b 0 :type symbol)) + +(deftest structure-61-1 + (let ((s (make-struct-test-61 :a 10 :b 'c))) + (values (struct-test-61-a s) + (struct-test-61-b s))) + 10 c) + +;;; Initializer forms are evaluated only when needed, and are +;;; evaluated in the lexical environment in which they were defined + +(eval-when (load eval) + (let ((x nil)) + (flet ((%f () x) + (%g (y) (setf x y))) + (defstruct struct-test-62 + (a (progn (setf x 'a) nil)) + (f #'%f) + (g #'%g))))) + +(deftest structure-62-1 + (let* ((s (make-struct-test-62 :a 1)) + (f (struct-test-62-f s))) + (values + (struct-test-62-a s) + (funcall f))) + 1 nil) + +(deftest structure-62-2 + (let* ((s (make-struct-test-62)) + (f (struct-test-62-f s)) + (g (struct-test-62-g s))) + (values + (struct-test-62-a s) + (funcall f) + (funcall g nil) + (funcall f))) + nil a nil nil) + +;;; Keywords are allowed in defstruct +(defstruct-with-tests :struct-test-63 a63 b63 c63) +(defstruct-with-tests struct-test-64 :a63 :b63 :c63) + +;;; Error tests + +(deftest copy-structure.error.1 + (classify-error (copy-structure)) + program-error) + +(deftest copy-structure.error.2 + (classify-error (copy-structure (make-s-2) nil)) + program-error) + diff --git a/ansi-tests/structures-03.lsp b/ansi-tests/structures-03.lsp new file mode 100644 index 0000000..11b9a4e --- /dev/null +++ b/ansi-tests/structures-03.lsp @@ -0,0 +1,417 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Dec 20 05:58:06 2002 +;;;; Contains: BOA Constructor Tests + +(in-package :cl-test) + +(defun sbt-slots (sname s &rest slots) + (loop for slotname in slots collect + (let ((fun (intern (concatenate 'string (string sname) + "-" (string slotname)) + :cl-test))) + (funcall (symbol-function fun) s)))) + +;;; See the DEFSTRUCT page, and section 3.4.6 (Boa Lambda Lists) + +(defstruct* (sbt-01 (:constructor sbt-01-con (b a c))) + a b c) + +(deftest structure-boa-test-01/1 + (let ((s (sbt-01-con 1 2 3))) + (values (sbt-01-a s) + (sbt-01-b s) + (sbt-01-c s))) + 2 1 3) + +(defstruct* (sbt-02 (:constructor sbt-02-con (a b c)) + (:constructor sbt-02-con-2 (a b)) + (:constructor sbt-02-con-3 ())) + (a 'x) (b 'y) (c 'z)) + +(deftest structure-boa-test-02/1 + (let ((s (sbt-02-con 1 2 3))) + (values (sbt-02-a s) + (sbt-02-b s) + (sbt-02-c s))) + 1 2 3) + +(deftest structure-boa-test-02/2 + (let ((s (sbt-02-con-2 'p 'q))) + (values (sbt-02-a s) + (sbt-02-b s) + (sbt-02-c s))) + p q z) + +(deftest structure-boa-test-02/3 + (let ((s (sbt-02-con-3))) + (values (sbt-02-a s) + (sbt-02-b s) + (sbt-02-c s))) + x y z) + +;;; &optional in BOA LL + +(defstruct* (sbt-03 (:constructor sbt-03-con (a b &optional c))) + c b a) + +(deftest structure-boa-test-03/1 + (let ((s (sbt-03-con 1 2))) + (values (sbt-03-a s) (sbt-03-b s))) + 1 2) + +(deftest structure-boa-test-03/2 + (let ((s (sbt-03-con 1 2 3))) + (values (sbt-03-a s) (sbt-03-b s) (sbt-03-c s))) + 1 2 3) + + +(defstruct* (sbt-04 (:constructor sbt-04-con (a b &optional c))) + (c nil) b (a nil)) + +(deftest structure-boa-test-04/1 + (let ((s (sbt-04-con 1 2))) + (values (sbt-04-a s) (sbt-04-b s) (sbt-04-c s))) + 1 2 nil) + +(deftest structure-boa-test-04/2 + (let ((s (sbt-04-con 1 2 4))) + (values (sbt-04-a s) (sbt-04-b s) (sbt-04-c s))) + 1 2 4) + + +(defstruct* (sbt-05 (:constructor sbt-05-con (&optional a b c))) + (c 1) (b 2) (a 3)) + +(deftest structure-boa-test-05/1 + (let ((s (sbt-05-con))) + (values (sbt-05-a s) (sbt-05-b s) (sbt-05-c s))) + 3 2 1) + +(deftest structure-boa-test-05/2 + (let ((s (sbt-05-con 'x))) + (values (sbt-05-a s) (sbt-05-b s) (sbt-05-c s))) + x 2 1) + +(deftest structure-boa-test-05/3 + (let ((s (sbt-05-con 'x 'y))) + (values (sbt-05-a s) (sbt-05-b s) (sbt-05-c s))) + x y 1) + +(deftest structure-boa-test-05/4 + (let ((s (sbt-05-con 'x 'y 'z))) + (values (sbt-05-a s) (sbt-05-b s) (sbt-05-c s))) + x y z) + + +(defstruct* (sbt-06 (:constructor sbt-06-con (&optional (a 'p) (b 'q) (c 'r)))) + (c 1) (b 2) (a 3)) + +(deftest structure-boa-test-06/1 + (let ((s (sbt-06-con))) + (values (sbt-06-a s) (sbt-06-b s) (sbt-06-c s))) + p q r) + +(deftest structure-boa-test-06/2 + (let ((s (sbt-06-con 'x))) + (values (sbt-06-a s) (sbt-06-b s) (sbt-06-c s))) + x q r) + +(deftest structure-boa-test-06/3 + (let ((s (sbt-06-con 'x 'y))) + (values (sbt-06-a s) (sbt-06-b s) (sbt-06-c s))) + x y r) + +(deftest structure-boa-test-06/4 + (let ((s (sbt-06-con 'x 'y 'z))) + (values (sbt-06-a s) (sbt-06-b s) (sbt-06-c s))) + x y z) + + +;;; Test presence flag in optional parameters + +(defstruct* (sbt-07 (:constructor sbt-07-con + (&optional (a 'p a-p) (b 'q b-p) (c 'r c-p) + &aux (d (list (notnot a-p) + (notnot b-p) + (notnot c-p)))))) + a b c d) + +(deftest structure-boa-test-07/1 + (sbt-slots 'sbt-07 (sbt-07-con) :a :b :c :d) + (p q r (nil nil nil))) + +(deftest structure-boa-test-07/2 + (sbt-slots 'sbt-07 (sbt-07-con 'x) :a :b :c :d) + (x q r (t nil nil))) + +(deftest structure-boa-test-07/3 + (sbt-slots 'sbt-07 (sbt-07-con 'x 'y) :a :b :c :d) + (x y r (t t nil))) + +(deftest structure-boa-test-07/4 + (sbt-slots 'sbt-07 (sbt-07-con 'x 'y 'z) :a :b :c :d) + (x y z (t t t))) + + +;;; Keyword arguments + +(defstruct* (sbt-08 (:constructor sbt-08-con + (&key ((:foo a))))) + a) + +(deftest structure-boa-test-08/1 + (sbt-slots 'sbt-08 (sbt-08-con :foo 10) :a) + (10)) + +(defstruct* (sbt-09 (:constructor sbt-09-con + (&key (a 'p a-p) + ((:x b) 'q) + (c 'r) + d + ((:y e)) + ((:z f) 's z-p) + &aux (g (list (notnot a-p) + (notnot z-p)))))) + a b c d e f g) + +(deftest structure-boa-test-09/1 + (sbt-slots 'sbt-09 (sbt-09-con) :a :b :c :f :g) + (p q r s (nil nil))) + +(deftest structure-boa-test-09/2 + (sbt-slots 'sbt-09 (sbt-09-con :d 1) :a :b :c :d :f :g) + (p q r 1 s (nil nil))) + +(deftest structure-boa-test-09/3 + (sbt-slots 'sbt-09 (sbt-09-con :a 1) :a :b :c :f :g) + (1 q r s (t nil))) + +(deftest structure-boa-test-09/4 + (sbt-slots 'sbt-09 (sbt-09-con :x 1) :a :b :c :f :g) + (p 1 r s (nil nil))) + +(deftest structure-boa-test-09/5 + (sbt-slots 'sbt-09 (sbt-09-con :c 1) :a :b :c :f :g) + (p q 1 s (nil nil))) + +(deftest structure-boa-test-09/6 + (sbt-slots 'sbt-09 (sbt-09-con :y 1) :a :b :c :e :f :g) + (p q r 1 s (nil nil))) + +(deftest structure-boa-test-09/7 + (sbt-slots 'sbt-09 (sbt-09-con :z 1) :a :b :c :f :g) + (p q r 1 (nil t))) + +;;; Aux variable overriding a default value + +(defstruct* (sbt-10 (:constructor sbt-10-con (&aux (a 10) + (b (1+ a))))) + (a 1) (b 2)) + +(deftest structure-boa-test-10/1 + (sbt-slots 'sbt-10 (sbt-10-con) :a :b) + (10 11)) + +;;; Aux variables with no value + +(defstruct* (sbt-11 (:constructor sbt-11-con (&aux a b))) + a (b 0 :type integer)) + +(deftest structure-boa-test-11/1 + (let ((s (sbt-11-con))) + (setf (sbt-11-a s) 'p) + (setf (sbt-11-b s) 10) + (sbt-slots 'sbt-11 s :a :b)) + (p 10)) + +;;; Arguments that correspond to no slots + +(defstruct* (sbt-12 (:constructor sbt-12-con (a &optional (b 1) + &rest c + &aux (d (list a b c))))) + d) + +(deftest structure-boa-12/1 + (sbt-12-d (sbt-12-con 'x)) + (x 1 nil)) + +(deftest structure-boa-12/2 + (sbt-12-d (sbt-12-con 'x 'y)) + (x y nil)) + +(deftest structure-boa-12/3 + (sbt-12-d (sbt-12-con 'x 'y 1 2 3)) + (x y (1 2 3))) + + +(defstruct* (sbt-13 (:constructor sbt-13-con + (&key (a 1) (b 2) c &aux (d (list a b c))))) + d) + +(deftest structure-boa-test-13/1 + (sbt-13-d (sbt-13-con)) + (1 2 nil)) + +(deftest structure-boa-test-13/2 + (sbt-13-d (sbt-13-con :a 10)) + (10 2 nil)) + +(deftest structure-boa-test-13/3 + (sbt-13-d (sbt-13-con :b 10)) + (1 10 nil)) + +(deftest structure-boa-test-13/4 + (sbt-13-d (sbt-13-con :c 10)) + (1 2 10)) + +(deftest structure-boa-test-13/5 + (sbt-13-d (sbt-13-con :c 10 :a 3)) + (3 2 10)) + +(deftest structure-boa-test-13/6 + (sbt-13-d (sbt-13-con :c 10 :b 3)) + (1 3 10)) + +(deftest structure-boa-test-13/7 + (sbt-13-d (sbt-13-con :a 10 :b 3)) + (10 3 nil)) + +(deftest structure-boa-test-13/8 + (sbt-13-d (sbt-13-con :a 10 :c 'a :b 3)) + (10 3 a)) + + +;;; Allow other keywords + +(defstruct* (sbt-14 (:constructor sbt-14-con (&key a b c &allow-other-keys))) + (a 1) (b 2) (c 3)) + +(deftest structure-boa-test-14/1 + (sbt-slots 'sbt-14 (sbt-14-con) :a :b :c) + (1 2 3)) + +(deftest structure-boa-test-14/2 + (sbt-slots 'sbt-14 (sbt-14-con :a 9) :a :b :c) + (9 2 3)) + +(deftest structure-boa-test-14/3 + (sbt-slots 'sbt-14 (sbt-14-con :b 9) :a :b :c) + (1 9 3)) + +(deftest structure-boa-test-14/4 + (sbt-slots 'sbt-14 (sbt-14-con :c 9) :a :b :c) + (1 2 9)) + +(deftest structure-boa-test-14/5 + (sbt-slots 'sbt-14 (sbt-14-con :d 9) :a :b :c) + (1 2 3)) + +;;; Keywords are in the correct package, and slot names are not +;;; keyword parameters if not specified. + +(defstruct* (sbt-15 (:constructor sbt-15-con + (&key ((:x a) nil) + ((y b) nil) + (c nil)))) + a b c) + +(deftest structure-boa-test-15/1 + (sbt-slots 'sbt-15 (sbt-15-con :x 1 'y 2 :c 3) :a :b :c) + (1 2 3)) + +(deftest structure-boa-test-15/2 + (classify-error (sbt-15-con :a 1)) + program-error) + +(deftest structure-boa-test-15/3 + (classify-error (sbt-15-con :b 1)) + program-error) + +(deftest structure-boa-test-15/4 + (classify-error (sbt-15-con 'x 1)) + program-error) + +(deftest structure-boa-test-15/5 + (classify-error (sbt-15-con :y 1)) + program-error) + +(deftest structure-boa-test-15/6 + (classify-error (sbt-15-con 'c 1)) + program-error) + +(deftest structure-boa-test-15/7 + (classify-error (sbt-15-con 'a 1)) + program-error) + +(deftest structure-boa-test-15/8 + (classify-error (sbt-15-con 'b 1)) + program-error) + + +;;; Default constructor w. BOA constructor, and error cases + +(defstruct* (sbt-16 (:constructor) + (:constructor sbt-16-con (a b c))) + a b c) + +(deftest structure-boa-test-16/1 + (sbt-slots 'sbt-16 (make-sbt-16 :a 1 :b 2 :c 3) :a :b :c) + (1 2 3)) + +(deftest structure-boa-test-16/2 + (sbt-slots 'sbt-16 (sbt-16-con 4 5 6) :a :b :c) + (4 5 6)) + +(deftest structure-boa-test-16/3 + (classify-error (make-sbt-16 :d 1)) + program-error) + +(deftest structure-boa-test-16/4 + (classify-error (make-sbt-16 :a)) + program-error) + +(deftest structure-boa-test-16/5 + (classify-error (make-sbt-16 'a)) + program-error) + +(deftest structure-boa-test-16/6 + (classify-error (make-sbt-16 1 1)) + program-error) + +(deftest structure-boa-test-16/7 + (sbt-slots 'sbt-16 (make-sbt-16 :a 1 :b 2 :c 3 :d 5 :allow-other-keys t) + :a :b :c) + (1 2 3)) + +(deftest structure-boa-test-16/8 + (sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t :a 1 :b 2 :c 3 :d 5) + :a :b :c) + (1 2 3)) + +;;; :allow-other-keys turns off keyword error checking, including +;;; invalid (nonsymbol) keyword arguments +;;;(deftest structure-boa-test-16/9 +;;; (sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t +;;; :a 3 :b 6 :c 9 1000 1000) +;;; :a :b :c) +;;; (3 6 9)) + +;;; Repeated keyword arguments are allowed; the leftmost one is used +(deftest structure-boa-test-16/10 + (sbt-slots 'sbt-16 (make-sbt-16 :a 1 :a 2 :b 3 :b 4 :c 5 :c 6) :a :b :c) + (1 3 5)) + +(deftest structure-boa-test-16/11 + (sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t + :allow-other-keys nil + :a 1 :b 2 :c 3 :d 5) + :a :b :c) + (1 2 3)) + +;; Checking of # of keywords is suppressed when :allow-other-keys is true +;;;(deftest structure-boa-test-16/12 +;;; (sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t :a 3 :b 6 :c 9 :a) +;;; :a :b :c) +;;; (3 6 9)) + diff --git a/ansi-tests/subseq-aux.lsp b/ansi-tests/subseq-aux.lsp new file mode 100644 index 0000000..ef466de --- /dev/null +++ b/ansi-tests/subseq-aux.lsp @@ -0,0 +1,239 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Nov 26 20:01:27 2002 +;;;; Contains: Aux. functions for subseq tests + +(in-package :cl-test) + +(defun subseq-list.4-body () + (block done + (let ((x (loop for i from 0 to 19 collect i))) + (loop + for i from 0 to 20 do + (loop + for j from i to 20 do + (let ((y (subseq x i j))) + (loop + for e in y and k from i to (1- j) do + (unless (eqlt e k) (return-from done nil))))))) + t)) + +(defun subseq-list.5-body () + (block done + (let ((x (loop for i from 0 to 29 collect i))) + (loop + for i from 0 to 30 do + (unless (equalt (subseq x i) + (loop for j from i to 29 collect j)) + (return-from done nil)))) + t)) + +(defun subseq-list.6-body () + (let* ((x (make-list 100)) + (z (loop for e on x collect e)) + (y (subseq x 0))) + (loop + for e on x + and f on y + and g in z do + (when (or (not (eqt g e)) + (not (eqlt (car e) (car f))) + (car e) + (eqt e f)) + (return nil)) + finally (return t)))) + +(defun subseq-vector.1-body () + (block nil + (let* ((x (make-sequence 'vector 10 :initial-element 'a)) + (y (subseq x 4 8))) + (unless (every #'(lambda (e) (eqt e 'a)) x) + (return 1)) + (unless (every #'(lambda (e) (eqt e 'a)) y) + (return 2)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) + (loop for i from 0 to 9 do (setf (aref x i) 'b)) + (unless (every #'(lambda (e) (eqt e 'a)) y) + (return 5)) + (loop for i from 0 to 3 do (setf (aref y i) 'c)) + (or + (not (not (every #'(lambda (e) (eqt e 'b)) x))) + 6)))) + +(defun subseq-vector.2-body () + (block nil + (let* ((x (make-sequence '(vector fixnum) 10 :initial-element 1)) + (y (subseq x 4 8))) + (unless (every #'(lambda (e) (eqlt e 1)) x) + (return 1)) + (unless (every #'(lambda (e) (eqlt e 1)) y) + (return 2)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) + (loop for i from 0 to 9 do (setf (aref x i) 2)) + (unless (every #'(lambda (e) (eqlt e 1)) y) + (return 5)) + (loop for i from 0 to 3 do (setf (aref y i) 3)) + (or + (not (not (every #'(lambda (e) (eqlt e 2)) x))) + 6)))) + +(defun subseq-vector.3-body () + (block nil + (let* ((x (make-sequence '(vector single-float) 10 :initial-element 1.0)) + (y (subseq x 4 8))) + (unless (every #'(lambda (e) (= e 1.0)) x) + (return 1)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 2)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) + (loop for i from 0 to 9 do (setf (aref x i) 2.0)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 5)) + (loop for i from 0 to 3 do (setf (aref y i) 3.0)) + (or + (not (not (every #'(lambda (e) (= e 2.0)) x))) + 6)))) + +(defun subseq-vector.4-body () + (block nil + (let* ((x (make-sequence '(vector double-float) 10 :initial-element 1.0d0)) + (y (subseq x 4 8))) + (unless (every #'(lambda (e) (= e 1.0)) x) + (return 1)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 2)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) + (loop for i from 0 to 9 do (setf (aref x i) 2.0d0)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 5)) + (loop for i from 0 to 3 do (setf (aref y i) 3.0d0)) + (or + (not (not (every #'(lambda (e) (= e 2.0)) x))) + 6)))) + +(defun subseq-vector.5-body () + (block nil + (let* ((x (make-sequence '(vector short-float) 10 :initial-element 1.0s0)) + (y (subseq x 4 8))) + (unless (every #'(lambda (e) (= e 1.0)) x) + (return 1)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 2)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) + (loop for i from 0 to 9 do (setf (aref x i) 2.0s0)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 5)) + (loop for i from 0 to 3 do (setf (aref y i) 3.0s0)) + (or + (not (not (every #'(lambda (e) (= e 2.0)) x))) + 6)))) + +(defun subseq-vector.6-body () + (block nil + (let* ((x (make-sequence '(vector long-float) 10 :initial-element 1.0l0)) + (y (subseq x 4 8))) + (unless (every #'(lambda (e) (= e 1.0)) x) + (return 1)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 2)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) + (loop for i from 0 to 9 do (setf (aref x i) 2.0l0)) + (unless (every #'(lambda (e) (= e 1.0)) y) + (return 5)) + (loop for i from 0 to 3 do (setf (aref y i) 3.0l0)) + (or + (not (not (every #'(lambda (e) (= e 2.0)) x))) + 6)))) + +(defun subseq-string.1-body () + (let* ((s1 "abcdefgh") + (len (length s1))) + (loop for start from 0 below len + always + (string= (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'string))))) + +(defun subseq-string.2-body () + (let* ((s1 "abcdefgh") + (len (length s1))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (string= (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'string)))))) + +(defun subseq-string.3-body () + (let* ((s1 (make-array '(10) :initial-contents "abcdefghij" + :fill-pointer 8 + :element-type 'character)) + (len (length s1))) + (and + (eqlt len 8) + (loop for start from 0 below len + always + (string= (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'string))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (string= (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'string))))))) +(defun subseq-bit-vector.1-body () + (let* ((s1 #*11001000) + (len (length s1))) + (loop for start from 0 below len + always + (equalp (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'bit-vector))))) + +(defun subseq-bit-vector.2-body () + (let* ((s1 #*01101011) + (len (length s1))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (equalp (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'bit-vector)))))) + +(defun subseq-bit-vector.3-body () + (let* ((s1 (make-array '(10) :initial-contents #*1101100110 + :fill-pointer 8 + :element-type 'bit)) + (len (length s1))) + (and + (eqlt len 8) + (loop for start from 0 below len + always + (equalp (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'bit-vector))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (equalp (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'bit-vector))))))) diff --git a/ansi-tests/subseq.lsp b/ansi-tests/subseq.lsp new file mode 100644 index 0000000..d9304b2 --- /dev/null +++ b/ansi-tests/subseq.lsp @@ -0,0 +1,235 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 19:41:14 2002 +;;;; Contains: Tests on SUBSEQ + +(in-package :cl-test) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; subseq, on lists + +(deftest subseq-list.1 + (subseq '(a b c d e) 0 0) + nil) + +(deftest subseq-list.2 + (subseq '(a b c) 0) + (a b c)) + +(deftest subseq-list.3 + (subseq '(a b c) 1) + (b c)) + + +(deftest subseq-list.4 + (subseq-list.4-body) + t) + +(deftest subseq-list.5 + (subseq-list.5-body) + t) + +(deftest subseq-list.6 ;; check that no structure is shared + (subseq-list.6-body) + t) + +(deftest subseq-list.7 + (let ((x (loop for i from 0 to 9 collect i))) + (setf (subseq x 0 3) (list 'a 'b 'c)) + x) + (a b c 3 4 5 6 7 8 9)) + +(deftest subseq-list.8 + (let* ((x '(a b c d e)) + (y (copy-seq x))) + (setf (subseq y 0) '(f g h)) + (list x y)) + ((a b c d e) (f g h d e))) + +(deftest subseq-list.9 + (let* ((x '(a b c d e)) + (y (copy-seq x))) + (setf (subseq y 1 3) '(1 2 3 4 5)) + (list x y)) + ((a b c d e) (a 1 2 d e))) + +(deftest subseq-list.10 + (let* ((x '(a b c d e)) + (y (copy-seq x))) + (setf (subseq y 5) '(1 2 3 4 5)) + (list x y)) + ((a b c d e) (a b c d e))) + +(deftest subseq-list.11 + (let* ((x '(a b c d e)) + (y (copy-seq x))) + (setf (subseq y 2 5) '(1)) + (list x y)) + ((a b c d e) (a b 1 d e))) + +(deftest subseq-list.12 + (let* ((x '(a b c d e)) + (y (copy-seq x))) + (setf (subseq y 0 0) '(1 2)) + (list x y)) + ((a b c d e) (a b c d e))) + +;; subseq on vectors + + +(deftest subseq-vector.1 + (subseq-vector.1-body) + t) + + +(deftest subseq-vector.2 + (subseq-vector.2-body) + t) + + +(deftest subseq-vector.3 + (subseq-vector.3-body) + t) + +(deftest subseq-vector.4 + (subseq-vector.4-body) + t) + +(deftest subseq-vector.5 + (subseq-vector.5-body) + t) + +(deftest subseq-vector.6 + (subseq-vector.6-body) + t) + +(deftest subseq-vector.7 + (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j))) + (y (subseq x 2 8))) + (equal-array y (make-array '(6) :initial-contents '(c d e f g h)))) + t) + +(deftest subseq-vector.8 + (let* ((x (make-array '(200) :initial-element 107 + :element-type 'fixnum)) + (y (subseq x 17 95))) + (and (eqlt (length y) (- 95 17)) + (equal-array y + (make-array (list (- 95 17)) + :initial-element 107 + :element-type 'fixnum)))) + t) + +(deftest subseq-vector.9 + (let* ((x (make-array '(1000) :initial-element 17.6e-1 + :element-type 'single-float)) + (lo 164) + (hi 873) + (y (subseq x lo hi))) + (and (eqlt (length y) (- hi lo)) + (equal-array y + (make-array (list (- hi lo)) + :initial-element 17.6e-1 + :element-type 'single-float)))) + t) + +(deftest subseq-vector.10 + (let* ((x (make-array '(2000) :initial-element 3.1415927d4 + :element-type 'double-float)) + (lo 731) + (hi 1942) + (y (subseq x lo hi))) + (and (eqlt (length y) (- hi lo)) + (equal-array y + (make-array (list (- hi lo)) + :initial-element 3.1415927d4 + :element-type 'double-float)))) + t) + +;;; subseq on strings + +(deftest subseq-string.1 + (subseq-string.1-body) + t) + +(deftest subseq-string.2 + (subseq-string.2-body) + t) + +(deftest subseq-string.3 + (subseq-string.3-body) + t) + +;;; Tests on bit vectors + +(deftest subseq-bit-vector.1 + (subseq-bit-vector.1-body) + t) + +(deftest subseq-bit-vector.2 + (subseq-bit-vector.2-body) + t) + +(deftest subseq-bit-vector.3 + (subseq-bit-vector.3-body) + t) + +;;; Order of evaluation + +(deftest subseq.order.1 + (let ((i 0) a b c) + (values + (subseq + (progn (setf a (incf i)) "abcdefgh") + (progn (setf b (incf i)) 1) + (progn (setf c (incf i)) 4)) + i a b c)) + "bcd" 3 1 2 3) + +(deftest subseq.order.2 + (let ((i 0) a b) + (values + (subseq + (progn (setf a (incf i)) "abcdefgh") + (progn (setf b (incf i)) 1)) + i a b)) + "bcdefgh" 2 1 2) + +(deftest subseq.order.3 + (let ((i 0) a b c d + (s (copy-seq "abcdefgh"))) + (values + (setf (subseq + (progn (setf a (incf i)) s) + (progn (setf b (incf i)) 1) + (progn (setf c (incf i)) 4)) + (progn (setf d (incf i)) "xyz")) + s i a b c d)) + "xyz" "axyzefgh" 4 1 2 3 4) + +(deftest subseq.order.4 + (let ((i 0) a b c + (s (copy-seq "abcd"))) + (values + (setf (subseq + (progn (setf a (incf i)) s) + (progn (setf b (incf i)) 1)) + (progn (setf c (incf i)) "xyz")) + s i a b c)) + "xyz" "axyz" 3 1 2 3) + +;;; Error cases + +(deftest subseq.error.1 + (classify-error (subseq)) + program-error) + +(deftest subseq.error.2 + (classify-error (subseq nil)) + program-error) + +(deftest subseq.error.3 + (classify-error (subseq nil 0 0 0)) + program-error) + + diff --git a/ansi-tests/substitute-if-not.lsp b/ansi-tests/substitute-if-not.lsp new file mode 100644 index 0000000..ad57f65 --- /dev/null +++ b/ansi-tests/substitute-if-not.lsp @@ -0,0 +1,837 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 31 18:17:09 2002 +;;;; Contains: Tests for SUBSTITUTE-IF-NOT + +(in-package :cl-test) + +(deftest substitute-if-not-list.1 + (let ((x '())) (values (substitute-if-not 'b #'null x) x)) + nil nil) + +(deftest substitute-if-not-list.2 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-not-list.3 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count nil) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-not-list.4 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 2) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-not-list.5 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 1) x)) + (b b a c) + (a b a c)) + +(deftest substitute-if-not-list.6 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 0) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-not-list.7 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count -1) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-not-list.8 + (let ((x '())) (values (substitute-if-not 'b (is-not-eq-p 'a) x :from-end t) x)) + nil nil) + +(deftest substitute-if-not-list.9 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :from-end t) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-not-list.10 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :from-end t :count nil) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-not-list.11 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 2 :from-end t) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-not-list.12 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 1 :from-end t) x)) + (a b b c) + (a b a c)) + +(deftest substitute-if-not-list.13 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 0 :from-end t) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-not-list.14 + (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count -1 :from-end t) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-not-list.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-not-list.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :from-end t))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-not-list.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 (+ i c)) :initial-element 'a)))))))) + t) + +(deftest substitute-if-not-list.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c :from-end t))) + (and (equal orig x) + (equal y (nconc (make-list (- j c) :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))))) + t) + +;;; Tests on vectors + +(deftest substitute-if-not-vector.1 + (let ((x #())) (values (substitute-if-not 'b (is-not-eq-p 'a) x) x)) + #() #()) + +(deftest substitute-if-not-vector.2 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-not-vector.3 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count nil) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-not-vector.4 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 2) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-not-vector.5 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 1) x)) + #(b b a c) + #(a b a c)) + +(deftest substitute-if-not-vector.6 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 0) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-not-vector.7 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count -1) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-not-vector.8 + (let ((x #())) (values (substitute-if-not 'b (is-not-eq-p 'a) x :from-end t) x)) + #() #()) + +(deftest substitute-if-not-vector.9 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :from-end t) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-not-vector.10 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :from-end t :count nil) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-not-vector.11 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 2 :from-end t) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-not-vector.12 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 1 :from-end t) x)) + #(a b b c) + #(a b a c)) + +(deftest substitute-if-not-vector.13 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count 0 :from-end t) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-not-vector.14 + (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eq-p 'a) x :count -1 :from-end t) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-not-vector.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-not-vector.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-not-vector.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 (+ i c)) :initial-element 'a)))))))) + t) + +(deftest substitute-if-not-vector.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if-not 'x (is-not-eq-p 'a) x :start i :end j :count c :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array (- j c) :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))))) + t) + +(deftest substitute-if-not-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if-not 'z (is-not-eql-p 'a) x))) + result) + #(z b z c b)) + +(deftest substitute-if-not-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if-not 'z (is-not-eql-p 'a) x :from-end t))) + result) + #(z b z c b)) + +(deftest substitute-if-not-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if-not 'z (is-not-eql-p 'a) x :count 1))) + result) + #(z b a c b)) + +(deftest substitute-if-not-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if-not 'z (is-not-eql-p 'a) x + :from-end t :count 1))) + result) + #(a b z c b)) + + +;;; Tests on strings + +(deftest substitute-if-not-string.1 + (let ((x "")) (values (substitute-if-not #\b (is-not-eq-p #\a) x) x)) + "" "") + +(deftest substitute-if-not-string.2 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x) x)) + "bbbc" + "abac") + +(deftest substitute-if-not-string.3 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count nil) x)) + "bbbc" + "abac") + +(deftest substitute-if-not-string.4 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count 2) x)) + "bbbc" + "abac") + +(deftest substitute-if-not-string.5 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count 1) x)) + "bbac" + "abac") + +(deftest substitute-if-not-string.6 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count 0) x)) + "abac" + "abac") + +(deftest substitute-if-not-string.7 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count -1) x)) + "abac" + "abac") + +(deftest substitute-if-not-string.8 + (let ((x "")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :from-end t) x)) + "" "") + +(deftest substitute-if-not-string.9 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :from-end t) x)) + "bbbc" + "abac") + +(deftest substitute-if-not-string.10 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :from-end t :count nil) x)) + "bbbc" + "abac") + +(deftest substitute-if-not-string.11 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count 2 :from-end t) x)) + "bbbc" + "abac") + +(deftest substitute-if-not-string.12 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count 1 :from-end t) x)) + "abbc" + "abac") + +(deftest substitute-if-not-string.13 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count 0 :from-end t) x)) + "abac" + "abac") + +(deftest substitute-if-not-string.14 + (let ((x "abac")) (values (substitute-if-not #\b (is-not-eq-p #\a) x :count -1 :from-end t) x)) + "abac" + "abac") + +(deftest substitute-if-not-string.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if-not #\x (is-not-eq-p #\a) x :start i :end j))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest substitute-if-not-string.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if-not #\x (is-not-eq-p #\a) x :start i :end j :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest substitute-if-not-string.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if-not #\x (is-not-eq-p #\a) x :start i :end j :count c))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 (+ i c)) :initial-element #\a)))))))) + t) + +(deftest substitute-if-not-string.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if-not #\x (is-not-eq-p #\a) x :start i :end j :count c :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array (- j c) :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))))) + t) + +(deftest substitute-if-not-string.28 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x))) + result) + "zbzcb") + +(deftest substitute-if-not-string.29 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x :from-end t))) + result) + "zbzcb") + +(deftest substitute-if-not-string.30 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x :count 1))) + result) + "zbacb") + +(deftest substitute-if-not-string.31 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x + :from-end t :count 1))) + result) + "abzcb") + + + +;;; Tests on bitstrings + +(deftest substitute-if-not-bitstring.1 + (let* ((orig #*) + (x (copy-seq orig)) + (result (substitute-if-not 0 (is-not-eq-p 1) x))) + (and (equalp orig x) + result)) + #*) + +(deftest substitute-if-not-bitstring.2 + (let* ((orig #*) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x))) + (and (equalp orig x) + result)) + #*) + +(deftest substitute-if-not-bitstring.3 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 0 (is-not-eq-p 1) x))) + (and (equalp orig x) + result)) + #*000000) + +(deftest substitute-if-not-bitstring.4 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-if-not-bitstring.5 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :start 1))) + (and (equalp orig x) + result)) + #*011111) + +(deftest substitute-if-not-bitstring.6 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 0 (is-not-eq-p 1) x :start 2 :end nil))) + (and (equalp orig x) + result)) + #*010000) + +(deftest substitute-if-not-bitstring.7 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :end 4))) + (and (equalp orig x) + result)) + #*111101) + +(deftest substitute-if-not-bitstring.8 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 0 (is-not-eq-p 1) x :end nil))) + (and (equalp orig x) + result)) + #*000000) + +(deftest substitute-if-not-bitstring.9 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 0 (is-not-eq-p 1) x :end 3))) + (and (equalp orig x) + result)) + #*000101) + +(deftest substitute-if-not-bitstring.10 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 0 (is-not-eq-p 1) x :start 2 :end 4))) + (and (equalp orig x) + result)) + #*010001) + +(deftest substitute-if-not-bitstring.11 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :start 2 :end 4))) + (and (equalp orig x) + result)) + #*011101) + +(deftest substitute-if-not-bitstring.12 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count 1))) + (and (equalp orig x) + result)) + #*110101) + +(deftest substitute-if-not-bitstring.13 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count 0))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-not-bitstring.14 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count -1))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-not-bitstring.15 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count 1 :from-end t))) + (and (equalp orig x) + result)) + #*010111) + +(deftest substitute-if-not-bitstring.16 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count 0 :from-end t))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-not-bitstring.17 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count -1 :from-end t))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-not-bitstring.18 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count nil))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-if-not-bitstring.19 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if-not 1 (complement #'zerop) x :count nil :from-end t))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-if-not-bitstring.20 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*0000000000) + (x (copy-seq orig)) + (y (substitute-if-not 1 (complement #'zerop) x :start i :end j :count c))) + (and (equalp orig x) + (equalp y (concatenate + 'simple-bit-vector + (make-list i :initial-element 0) + (make-list c :initial-element 1) + (make-list (- 10 (+ i c)) :initial-element 0)))))))) + t) + +(deftest substitute-if-not-bitstring.21 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*1111111111) + (x (copy-seq orig)) + (y (substitute-if-not 0 (is-not-eq-p 1) x :start i :end j :count c :from-end t))) + (and (equalp orig x) + (equalp y (concatenate + 'simple-bit-vector + (make-list (- j c) :initial-element 1) + (make-list c :initial-element 0) + (make-list (- 10 j) :initial-element 1)))))))) + t) + +;;; More tests + +(deftest substitute-if-not-list.24 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if-not '(a 10) (is-not-eq-p 'a) x :key #'car))) + (and (equal orig x) + result)) + ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest substitute-if-not-list.25 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if-not '(a 10) (is-not-eq-p 'a) x + :key #'car :start 1 :end 5))) + (and (equal orig x) + result)) + ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest substitute-if-not-vector.24 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if-not '(a 10) (is-not-eq-p 'a) x :key #'car))) + (and (equalp orig x) + result)) + #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest substitute-if-not-vector.25 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if-not '(a 10) (is-not-eq-p 'a) x :key #'car :start 1 :end 5))) + (and (equalp orig x) + result)) + #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest substitute-if-not-string.24 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute-if-not #\a (is-not-eq-p #\1) x :key #'nextdigit))) + (and (equalp orig x) + result)) + "a1a2342a15") + +(deftest substitute-if-not-string.25 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute-if-not #\a (is-not-eq-p #\1) x :key #'nextdigit :start 1 :end 6))) + (and (equalp orig x) + result)) + "01a2342015") + +(deftest substitute-if-not-bitstring.26 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute-if-not 1 (is-not-eq-p 1) x :key #'1+))) + (and (equalp orig x) + result)) + #*11111111111111111) + +(deftest substitute-if-not-bitstring.27 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute-if-not 1 (is-not-eq-p 1) x :key #'1+ :start 1 :end 10))) + (and (equalp orig x) + result)) + #*01111111111010110) + +(deftest substitute-if-not-bit-vector.30 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if-not 1 #'onep x))) + result) + #*11111) + +(deftest substitute-if-not-bit-vector.31 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if-not 1 #'onep x :from-end t))) + result) + #*11111) + +(deftest substitute-if-not-bit-vector.32 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if-not 1 #'onep x :count 1))) + result) + #*11011) + +(deftest substitute-if-not-bit-vector.33 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if-not 1 #'onep x :from-end t :count 1))) + result) + #*01111) + +(deftest substitute-if-not.order.1 + (let ((i 0) a b c d e f g h) + (values + (substitute-if-not + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'identity) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :count (progn (setf d (incf i)) 2) + :start (progn (setf e (incf i)) 0) + :end (progn (setf f (incf i)) 7) + :key (progn (setf g (incf i)) #'identity) + :from-end (setf h (incf i)) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 4 5 6 7 8) + +(deftest substitute-if-not.order.2 + (let ((i 0) a b c d e f g h) + (values + (substitute-if-not + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'identity) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :from-end (setf h (incf i)) + :key (progn (setf g (incf i)) #'identity) + :end (progn (setf f (incf i)) 7) + :start (progn (setf e (incf i)) 0) + :count (progn (setf d (incf i)) 2) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 8 7 6 5 4) + +;;; Keyword tests + +(deftest substitute-if-not.allow-other-keys.1 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :allow-other-keys t :bad t) + (a a 0 a a 0 a)) + +(deftest substitute-if-not.allow-other-keys.2 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :bad t :allow-other-keys t) + (a a 0 a a 0 a)) + +(deftest substitute-if-not.allow-other-keys.3 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :allow-other-keys nil :bad t) + (a a 0 a a 0 a)) + +(deftest substitute-if-not.allow-other-keys.4 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :bad t + :allow-other-keys t :allow-other-keys nil) + (a a 0 a a 0 a)) + +(deftest substitute-if-not.allow-other-keys.5 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :allow-other-keys t :key #'1-) + (1 a a a 1 a a)) + +(deftest substitute-if-not.keywords.6 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) + :key #'1- :key #'identity) + (1 a a a 1 a a)) + +(deftest substitute-if-not.allow-other-keys.7 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :bad t :allow-other-keys nil) + (a a 0 a a 0 a)) + +(deftest substitute-if-not.allow-other-keys.8 + (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) + (a a 0 a a 0 a)) + +;;; Error cases + +(deftest substitute-if-not.error.1 + (classify-error (substitute-if-not)) + program-error) + +(deftest substitute-if-not.error.2 + (classify-error (substitute-if-not 'a)) + program-error) + +(deftest substitute-if-not.error.3 + (classify-error (substitute-if-not 'a #'null)) + program-error) + +(deftest substitute-if-not.error.4 + (classify-error (substitute-if-not 'a #'null nil 'bad t)) + program-error) + +(deftest substitute-if-not.error.5 + (classify-error (substitute-if-not 'a #'null nil + 'bad t :allow-other-keys nil)) + program-error) + +(deftest substitute-if-not.error.6 + (classify-error (substitute-if-not 'a #'null nil :key)) + program-error) + +(deftest substitute-if-not.error.7 + (classify-error (substitute-if-not 'a #'null nil 1 2)) + program-error) + +(deftest substitute-if-not.error.8 + (classify-error (substitute-if-not 'a #'cons (list 'a 'b 'c))) + program-error) + +(deftest substitute-if-not.error.9 + (classify-error (substitute-if-not 'a #'car (list 'a 'b 'c))) + type-error) + +(deftest substitute-if-not.error.10 + (classify-error (substitute-if-not 'a #'identity (list 'a 'b 'c) + :key #'car)) + type-error) + +(deftest substitute-if-not.error.11 + (classify-error (substitute-if-not 'a #'identity (list 'a 'b 'c) + :key #'cons)) + program-error) + diff --git a/ansi-tests/substitute-if.lsp b/ansi-tests/substitute-if.lsp new file mode 100644 index 0000000..2643cc2 --- /dev/null +++ b/ansi-tests/substitute-if.lsp @@ -0,0 +1,856 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 31 17:42:04 2002 +;;;; Contains: Tests for SUBSTITUTE-IF + +(in-package :cl-test) + +(deftest substitute-if-list.1 + (let ((x '())) (values (substitute-if 'b #'identity x) x)) + nil nil) + +(deftest substitute-if-list.2 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-list.3 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count nil) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-list.4 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 2) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-list.5 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 1) x)) + (b b a c) + (a b a c)) + +(deftest substitute-if-list.6 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 0) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-list.7 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count -1) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-list.8 + (let ((x '())) (values (substitute-if 'b (is-eq-p 'a) x :from-end t) x)) + nil nil) + +(deftest substitute-if-list.9 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :from-end t) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-list.10 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :from-end t :count nil) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-list.11 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 2 :from-end t) x)) + (b b b c) + (a b a c)) + +(deftest substitute-if-list.12 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 1 :from-end t) x)) + (a b b c) + (a b a c)) + +(deftest substitute-if-list.13 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 0 :from-end t) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-list.14 + (let ((x '(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count -1 :from-end t) x)) + (a b a c) + (a b a c)) + +(deftest substitute-if-list.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x :start i :end j))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-list.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x :start i :end j :from-end t))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-list.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x :start i :end j :count c))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 (+ i c)) :initial-element 'a)))))))) + t) + +(deftest substitute-if-list.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x :start i :end j :count c :from-end t))) + (and (equal orig x) + (equal y (nconc (make-list (- j c) :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))))) + t) + + +;;; Tests on vectors + +(deftest substitute-if-vector.1 + (let ((x #())) (values (substitute-if 'b (is-eq-p 'a) x) x)) + #() #()) + +(deftest substitute-if-vector.2 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-vector.3 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count nil) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-vector.4 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 2) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-vector.5 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 1) x)) + #(b b a c) + #(a b a c)) + +(deftest substitute-if-vector.6 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 0) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-vector.7 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count -1) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-vector.8 + (let ((x #())) (values (substitute-if 'b (is-eq-p 'a) x :from-end t) x)) + #() #()) + +(deftest substitute-if-vector.9 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :from-end t) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-vector.10 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :from-end t :count nil) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-vector.11 + (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 2 :from-end t) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-if-vector.12 + (let ((x #(a b a c))) + (values (substitute-if 'b (is-eq-p 'a) x :count 1 :from-end t) x)) + #(a b b c) + #(a b a c)) + +(deftest substitute-if-vector.13 + (let ((x #(a b a c))) + (values (substitute-if 'b (is-eq-p 'a) x :count 0 :from-end t) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-vector.14 + (let ((x #(a b a c))) + (values (substitute-if 'b (is-eq-p 'a) x :count -1 :from-end t) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-if-vector.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x :start i :end j))) + (and (equalp orig x) + (equalp y + (concatenate + 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-vector.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x :start i :end j :from-end t))) + (and (equalp orig x) + (equalp y + (concatenate + 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-if-vector.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x + :start i :end j :count c))) + (and (equalp orig x) + (equalp + y (concatenate + 'simple-vector + (make-array i :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 (+ i c)) + :initial-element 'a)))))))) + t) + +(deftest substitute-if-vector.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute-if 'x (is-eq-p 'a) x + :start i :end j :count c + :from-end t))) + (and (equalp orig x) + (equalp + y + (concatenate + 'simple-vector + (make-array (- j c) :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))))) + t) + +(deftest substitute-if-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x))) + result) + #(z b z c b)) + +(deftest substitute-if-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x :from-end t))) + result) + #(z b z c b)) + +(deftest substitute-if-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x :count 1))) + result) + #(z b a c b)) + +(deftest substitute-if-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x :from-end t :count 1))) + result) + #(a b z c b)) + +;;; Tests on strings + +(deftest substitute-if-string.1 + (let ((x "")) (values (substitute-if #\b (is-eq-p #\a) x) x)) + "" "") + +(deftest substitute-if-string.2 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x) x)) + "bbbc" + "abac") + +(deftest substitute-if-string.3 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count nil) x)) + "bbbc" + "abac") + +(deftest substitute-if-string.4 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count 2) x)) + "bbbc" + "abac") + +(deftest substitute-if-string.5 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count 1) x)) + "bbac" + "abac") + +(deftest substitute-if-string.6 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count 0) x)) + "abac" + "abac") + +(deftest substitute-if-string.7 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count -1) x)) + "abac" + "abac") + +(deftest substitute-if-string.8 + (let ((x "")) (values (substitute-if #\b (is-eq-p #\a) x :from-end t) x)) + "" "") + +(deftest substitute-if-string.9 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :from-end t) x)) + "bbbc" + "abac") + +(deftest substitute-if-string.10 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :from-end t :count nil) x)) + "bbbc" + "abac") + +(deftest substitute-if-string.11 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count 2 :from-end t) x)) + "bbbc" + "abac") + +(deftest substitute-if-string.12 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count 1 :from-end t) x)) + "abbc" + "abac") + +(deftest substitute-if-string.13 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count 0 :from-end t) x)) + "abac" + "abac") + +(deftest substitute-if-string.14 + (let ((x "abac")) (values (substitute-if #\b (is-eq-p #\a) x :count -1 :from-end t) x)) + "abac" + "abac") + +(deftest substitute-if-string.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if #\x (is-eq-p #\a) x :start i :end j))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest substitute-if-string.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if #\x (is-eq-p #\a) x + :start i :end j :from-end t))) + (and (equalp orig x) + (equalp y + (concatenate + 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest substitute-if-string.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if #\x (is-eq-p #\a) x + :start i :end j :count c))) + (and (equalp orig x) + (equalp y + (concatenate + 'simple-string + (make-array i :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 (+ i c)) + :initial-element #\a)))))))) + t) + +(deftest substitute-if-string.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute-if #\x (is-eq-p #\a) x + :start i :end j :count c + :from-end t))) + (and (equalp orig x) + (equalp y (concatenate + 'simple-string + (make-array (- j c) :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 j) + :initial-element #\a)))))))) + t) + + +(deftest substitute-if-string.28 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x))) + result) + "zbzcb") + +(deftest substitute-if-string.29 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x :from-end t))) + result) + "zbzcb") + +(deftest substitute-if-string.30 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x :count 1))) + result) + "zbacb") + +(deftest substitute-if-string.31 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x :from-end t :count 1))) + result) + "abzcb") + +;;; Tests on bit-vectors + +(deftest substitute-if-bit-vector.1 + (let* ((orig #*) + (x (copy-seq orig)) + (result (substitute-if 0 (is-eq-p 1) x))) + (and (equalp orig x) + result)) + #*) + +(deftest substitute-if-bit-vector.2 + (let* ((orig #*) + (x (copy-seq orig)) + (result (substitute-if 1 'zerop x))) + (and (equalp orig x) + result)) + #*) + +(deftest substitute-if-bit-vector.3 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 0 (is-eq-p 1) x))) + (and (equalp orig x) + result)) + #*000000) + +(deftest substitute-if-bit-vector.4 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-if-bit-vector.5 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :start 1))) + (and (equalp orig x) + result)) + #*011111) + +(deftest substitute-if-bit-vector.6 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 0 (is-eq-p 1) x :start 2 :end nil))) + (and (equalp orig x) + result)) + #*010000) + +(deftest substitute-if-bit-vector.7 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :end 4))) + (and (equalp orig x) + result)) + #*111101) + +(deftest substitute-if-bit-vector.8 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 0 (is-eq-p 1) x :end nil))) + (and (equalp orig x) + result)) + #*000000) + +(deftest substitute-if-bit-vector.9 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 0 (is-eq-p 1) x :end 3))) + (and (equalp orig x) + result)) + #*000101) + +(deftest substitute-if-bit-vector.10 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 0 (is-eq-p 1) x :start 2 :end 4))) + (and (equalp orig x) + result)) + #*010001) + +(deftest substitute-if-bit-vector.11 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :start 2 :end 4))) + (and (equalp orig x) + result)) + #*011101) + +(deftest substitute-if-bit-vector.12 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count 1))) + (and (equalp orig x) + result)) + #*110101) + +(deftest substitute-if-bit-vector.13 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count 0))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-bit-vector.14 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count -1))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-bit-vector.15 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count 1 :from-end t))) + (and (equalp orig x) + result)) + #*010111) + +(deftest substitute-if-bit-vector.16 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count 0 :from-end t))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-bit-vector.17 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count -1 :from-end t))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-if-bit-vector.18 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count nil))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-if-bit-vector.19 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute-if 1 #'zerop x :count nil :from-end t))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-if-bit-vector.20 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*0000000000) + (x (copy-seq orig)) + (y (substitute-if 1 #'zerop x :start i :end j :count c))) + (and (equalp orig x) + (equalp y (concatenate + 'simple-bit-vector + (make-list i :initial-element 0) + (make-list c :initial-element 1) + (make-list (- 10 (+ i c)) :initial-element 0)))))))) + t) + +(deftest substitute-if-bit-vector.21 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*1111111111) + (x (copy-seq orig)) + (y (substitute-if 0 (is-eq-p 1) x :start i :end j :count c :from-end t))) + (and (equalp orig x) + (equalp y (concatenate + 'simple-bit-vector + (make-list (- j c) :initial-element 1) + (make-list c :initial-element 0) + (make-list (- 10 j) :initial-element 1)))))))) + t) + +;;; More tests + +(deftest substitute-if-list.24 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if '(a 10) (is-eq-p 'a) x :key #'car))) + (and (equal orig x) + result)) + ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest substitute-if-list.25 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if '(a 10) (is-eq-p 'a) x + :key #'car :start 1 :end 5))) + (and (equal orig x) + result)) + ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest substitute-if-vector.24 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if '(a 10) (is-eq-p 'a) x :key #'car))) + (and (equalp orig x) + result)) + #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest substitute-if-vector.25 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute-if '(a 10) (is-eq-p 'a) x :key #'car :start 1 :end 5))) + (and (equalp orig x) + result)) + #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest substitute-if-string.24 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute-if #\a (is-eq-p #\1) x :key #'nextdigit))) + (and (equalp orig x) + result)) + "a1a2342a15") + +(deftest substitute-if-string.25 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute-if #\a (is-eq-p #\1) x :key #'nextdigit :start 1 :end 6))) + (and (equalp orig x) + result)) + "01a2342015") + +(deftest substitute-if-bit-vector.26 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute-if 1 (is-eq-p 1) x :key #'1+))) + (and (equalp orig x) + result)) + #*11111111111111111) + +(deftest substitute-if-bit-vector.27 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute-if 1 (is-eq-p 1) x :key #'1+ :start 1 :end 10))) + (and (equalp orig x) + result)) + #*01111111111010110) + +(deftest substitute-if-bit-vector.30 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if 1 #'zerop x))) + result) + #*11111) + +(deftest substitute-if-bit-vector.31 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if 1 #'zerop x :from-end t))) + result) + #*11111) + +(deftest substitute-if-bit-vector.32 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if 1 #'zerop x :count 1))) + result) + #*11011) + +(deftest substitute-if-bit-vector.33 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute-if 1 #'zerop x :from-end t :count 1))) + result) + #*01111) + +(deftest substitute-if.order.1 + (let ((i 0) a b c d e f g h) + (values + (substitute-if + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'null) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :count (progn (setf d (incf i)) 2) + :start (progn (setf e (incf i)) 0) + :end (progn (setf f (incf i)) 7) + :key (progn (setf g (incf i)) #'identity) + :from-end (setf h (incf i)) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 4 5 6 7 8) + +(deftest substitute-if.order.2 + (let ((i 0) a b c d e f g h) + (values + (substitute-if + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) #'null) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :from-end (setf h (incf i)) + :key (progn (setf g (incf i)) #'identity) + :end (progn (setf f (incf i)) 7) + :start (progn (setf e (incf i)) 0) + :count (progn (setf d (incf i)) 2) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 8 7 6 5 4) + +;;; Keyword tests + +(deftest substitute-if.allow-other-keys.1 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t :bad t) + (1 2 a 3 1 a 3)) + +(deftest substitute-if.allow-other-keys.2 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :bad t :allow-other-keys t) + (1 2 a 3 1 a 3)) + +(deftest substitute-if.allow-other-keys.3 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :allow-other-keys nil :bad t) + (1 2 a 3 1 a 3)) + +(deftest substitute-if.allow-other-keys.4 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :bad t + :allow-other-keys t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest substitute-if.allow-other-keys.5 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) + :allow-other-keys t :key #'1-) + (a 2 0 3 a 0 3)) + +(deftest substitute-if.keywords.6 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :key #'1- :key #'identity) + (a 2 0 3 a 0 3)) + +(deftest substitute-if.allow-other-keys.7 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t + :bad t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest substitute-if.allow-other-keys.8 + (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +;;; Error cases + +(deftest substitute-if.error.1 + (classify-error (substitute-if)) + program-error) + +(deftest substitute-if.error.2 + (classify-error (substitute-if 'a)) + program-error) + +(deftest substitute-if.error.3 + (classify-error (substitute-if 'a #'null)) + program-error) + +(deftest substitute-if.error.4 + (classify-error (substitute-if 'a #'null nil 'bad t)) + program-error) + +(deftest substitute-if.error.5 + (classify-error (substitute-if 'a #'null nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest substitute-if.error.6 + (classify-error (substitute-if 'a #'null nil :key)) + program-error) + +(deftest substitute-if.error.7 + (classify-error (substitute-if 'a #'null nil 1 2)) + program-error) + +(deftest substitute-if.error.8 + (classify-error (substitute-if 'a #'cons (list 'a 'b 'c))) + program-error) + +(deftest substitute-if.error.9 + (classify-error (substitute-if 'a #'car (list 'a 'b 'c))) + type-error) + +(deftest substitute-if.error.10 + (classify-error (substitute-if 'a #'identity (list 'a 'b 'c) + :key #'car)) + type-error) + +(deftest substitute-if.error.11 + (classify-error (substitute-if 'a #'identity (list 'a 'b 'c) + :key #'cons)) + program-error) diff --git a/ansi-tests/substitute.lsp b/ansi-tests/substitute.lsp new file mode 100644 index 0000000..bd17f8e --- /dev/null +++ b/ansi-tests/substitute.lsp @@ -0,0 +1,1086 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 28 21:15:33 2002 +;;;; Contains: Tests for SUBSTITUTE + +(in-package :cl-test) + +(deftest substitute-list.1 + (let ((x '())) (values (substitute 'b 'a x) x)) + nil nil) + +(deftest substitute-list.2 + (let ((x '(a b a c))) (values (substitute 'b 'a x) x)) + (b b b c) + (a b a c)) + +(deftest substitute-list.3 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count nil) x)) + (b b b c) + (a b a c)) + +(deftest substitute-list.4 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count 2) x)) + (b b b c) + (a b a c)) + +(deftest substitute-list.5 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count 1) x)) + (b b a c) + (a b a c)) + +(deftest substitute-list.6 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count 0) x)) + (a b a c) + (a b a c)) + +(deftest substitute-list.7 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count -1) x)) + (a b a c) + (a b a c)) + +(deftest substitute-list.8 + (let ((x '())) (values (substitute 'b 'a x :from-end t) x)) + nil nil) + +(deftest substitute-list.9 + (let ((x '(a b a c))) (values (substitute 'b 'a x :from-end t) x)) + (b b b c) + (a b a c)) + +(deftest substitute-list.10 + (let ((x '(a b a c))) (values (substitute 'b 'a x :from-end t :count nil) x)) + (b b b c) + (a b a c)) + +(deftest substitute-list.11 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count 2 :from-end t) x)) + (b b b c) + (a b a c)) + +(deftest substitute-list.12 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count 1 :from-end t) x)) + (a b b c) + (a b a c)) + +(deftest substitute-list.13 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count 0 :from-end t) x)) + (a b a c) + (a b a c)) + +(deftest substitute-list.14 + (let ((x '(a b a c))) (values (substitute 'b 'a x :count -1 :from-end t) x)) + (a b a c) + (a b a c)) + +(deftest substitute-list.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-list.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j :from-end t))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list (- j i) :initial-element 'x) + (make-list (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-list.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j :count c))) + (and (equal orig x) + (equal y (nconc (make-list i :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 (+ i c)) :initial-element 'a)))))))) + t) + +(deftest substitute-list.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig '(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j :count c :from-end t))) + (and (equal orig x) + (equal y (nconc (make-list (- j c) :initial-element 'a) + (make-list c :initial-element 'x) + (make-list (- 10 j) :initial-element 'a)))))))) + t) + +(deftest substitute-list.19 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2))))) + (and (equal orig x) + result)) + (1 2 x x x x x 8 9)) + +(deftest substitute-list.20 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a))))) + (and (equal orig x) + result)) + (1 2 x 4 5 6 7 8 9)) + + +(deftest substitute-list.21 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a)) + :from-end t))) + (and (equal orig x) + result)) + (1 2 3 4 5 6 7 x 9)) + +(deftest substitute-list.22 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a))))) + (and (equal orig x) + result)) + (1 2 x 4 5 6 7 8 9)) + + +(deftest substitute-list.23 + (let* ((orig '(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (substitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a)) + :from-end t))) + (and (equal orig x) + result)) + (1 2 3 4 5 6 7 x 9)) + +(deftest substitute-list.24 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car))) + (and (equal orig x) + result)) + ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest substitute-list.25 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5))) + (and (equal orig x) + result)) + ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest substitute-list.26 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql)))) + (and (equal orig x) + result)) + ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +(deftest substitute-list.27 + (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car :test-not #'eql))) + (and (equal orig x) + result)) + ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +;;; Tests on vectors + +(deftest substitute-vector.1 + (let ((x #())) (values (substitute 'b 'a x) x)) + #() #()) + +(deftest substitute-vector.2 + (let ((x #(a b a c))) (values (substitute 'b 'a x) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-vector.3 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count nil) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-vector.4 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count 2) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-vector.5 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count 1) x)) + #(b b a c) + #(a b a c)) + +(deftest substitute-vector.6 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count 0) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-vector.7 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count -1) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-vector.8 + (let ((x #())) (values (substitute 'b 'a x :from-end t) x)) + #() #()) + +(deftest substitute-vector.9 + (let ((x #(a b a c))) (values (substitute 'b 'a x :from-end t) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-vector.10 + (let ((x #(a b a c))) (values (substitute 'b 'a x :from-end t :count nil) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-vector.11 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count 2 :from-end t) x)) + #(b b b c) + #(a b a c)) + +(deftest substitute-vector.12 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count 1 :from-end t) x)) + #(a b b c) + #(a b a c)) + +(deftest substitute-vector.13 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count 0 :from-end t) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-vector.14 + (let ((x #(a b a c))) (values (substitute 'b 'a x :count -1 :from-end t) x)) + #(a b a c) + #(a b a c)) + +(deftest substitute-vector.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-vector.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) + t) + +(deftest substitute-vector.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j :count c))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array i :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 (+ i c)) :initial-element 'a)))))))) + t) + +(deftest substitute-vector.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #(a a a a a a a a a a)) + (x (copy-seq orig)) + (y (substitute 'x 'a x :start i :end j :count c :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-vector + (make-array (- j c) :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))))) + t) + +(deftest substitute-vector.19 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2))))) + (and (equalp orig x) + result)) + #(1 2 x x x x x 8 9)) + +(deftest substitute-vector.20 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a))))) + (and (equalp orig x) + result)) + #(1 2 x 4 5 6 7 8 9)) + + +(deftest substitute-vector.21 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a)) + :from-end t))) + (and (equalp orig x) + result)) + #(1 2 3 4 5 6 7 x 9)) + +(deftest substitute-vector.22 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c -4) + (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a))))) + (and (equalp orig x) + result)) + #(1 2 x 4 5 6 7 8 9)) + + +(deftest substitute-vector.23 + (let* ((orig #(1 2 3 4 5 6 7 8 9)) + (x (copy-seq orig)) + (c 5) + (result (substitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a)) + :from-end t))) + (and (equalp orig x) + result)) + #(1 2 3 4 5 6 7 x 9)) + +(deftest substitute-vector.24 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car))) + (and (equalp orig x) + result)) + #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7))) + +(deftest substitute-vector.25 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5))) + (and (equalp orig x) + result)) + #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7))) + +(deftest substitute-vector.26 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql)))) + (and (equalp orig x) + result)) + #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +(deftest substitute-vector.27 + (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7))) + (x (copy-seq orig)) + (result (substitute '(a 10) 'a x :key #'car :test-not #'eql))) + (and (equalp orig x) + result)) + #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) + +(deftest substitute-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x))) + result) + #(z b z c b)) + +(deftest substitute-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x :from-end t))) + result) + #(z b z c b)) + +(deftest substitute-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x :count 1))) + result) + #(z b a c b)) + +(deftest substitute-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x :from-end t :count 1))) + result) + #(a b z c b)) + +;;; Tests on strings + +(deftest substitute-string.1 + (let ((x "")) (values (substitute #\b #\a x) x)) + "" "") + +(deftest substitute-string.2 + (let ((x "abac")) (values (substitute #\b #\a x) x)) + "bbbc" + "abac") + +(deftest substitute-string.3 + (let ((x "abac")) (values (substitute #\b #\a x :count nil) x)) + "bbbc" + "abac") + +(deftest substitute-string.4 + (let ((x "abac")) (values (substitute #\b #\a x :count 2) x)) + "bbbc" + "abac") + +(deftest substitute-string.5 + (let ((x "abac")) (values (substitute #\b #\a x :count 1) x)) + "bbac" + "abac") + +(deftest substitute-string.6 + (let ((x "abac")) (values (substitute #\b #\a x :count 0) x)) + "abac" + "abac") + +(deftest substitute-string.7 + (let ((x "abac")) (values (substitute #\b #\a x :count -1) x)) + "abac" + "abac") + +(deftest substitute-string.8 + (let ((x "")) (values (substitute #\b #\a x :from-end t) x)) + "" "") + +(deftest substitute-string.9 + (let ((x "abac")) (values (substitute #\b #\a x :from-end t) x)) + "bbbc" + "abac") + +(deftest substitute-string.10 + (let ((x "abac")) (values (substitute #\b #\a x :from-end t :count nil) x)) + "bbbc" + "abac") + +(deftest substitute-string.11 + (let ((x "abac")) (values (substitute #\b #\a x :count 2 :from-end t) x)) + "bbbc" + "abac") + +(deftest substitute-string.12 + (let ((x "abac")) (values (substitute #\b #\a x :count 1 :from-end t) x)) + "abbc" + "abac") + +(deftest substitute-string.13 + (let ((x "abac")) (values (substitute #\b #\a x :count 0 :from-end t) x)) + "abac" + "abac") + +(deftest substitute-string.14 + (let ((x "abac")) (values (substitute #\b #\a x :count -1 :from-end t) x)) + "abac" + "abac") + +(deftest substitute-string.15 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute #\x #\a x :start i :end j))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest substitute-string.16 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute #\x #\a x :start i :end j :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) + t) + +(deftest substitute-string.17 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute #\x #\a x :start i :end j :count c))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array i :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 (+ i c)) :initial-element #\a)))))))) + t) + +(deftest substitute-string.18 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig "aaaaaaaaaa") + (x (copy-seq orig)) + (y (substitute #\x #\a x :start i :end j :count c :from-end t))) + (and (equalp orig x) + (equalp y (concatenate 'simple-string + (make-array (- j c) :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 j) :initial-element #\a)))))))) + t) + +(deftest substitute-string.19 + (let* ((orig "123456789") + (x (copy-seq orig)) + (result (substitute #\x #\5 x :test #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (<= (abs (- a b)) 2))))) + (and (equalp orig x) + result)) + "12xxxxx89") + +(deftest substitute-string.20 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c -4) + (result (substitute #\x #\5 x :test #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c 2) (= (+ b c) a))))) + (and (equalp orig x) + result)) + "12x456789") + + +(deftest substitute-string.21 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c 5) + (result (substitute #\x #\9 x :test #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c -2) (= (+ b c) a)) + :from-end t))) + (and (equalp orig x) + result)) + "1234567x9") + +(deftest substitute-string.22 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c -4) + (result (substitute #\x #\5 x :test-not #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c 2) (/= (+ b c) a))))) + (and (equalp orig x) + result)) + "12x456789") + + +(deftest substitute-string.23 + (let* ((orig "123456789") + (x (copy-seq orig)) + (c 5) + (result (substitute #\x #\9 x :test-not #'(lambda (a b) + (setq a (read-from-string (string a))) + (setq b (read-from-string (string b))) + (incf c -2) (/= (+ b c) a)) + :from-end t))) + (and (equalp orig x) + result)) + "1234567x9") + +(deftest substitute-string.24 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute #\a #\1 x :key #'nextdigit))) + (and (equalp orig x) + result)) + "a1a2342a15") + +(deftest substitute-string.25 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute #\a #\1 x :key #'nextdigit :start 1 :end 6))) + (and (equalp orig x) + result)) + "01a2342015") + +(deftest substitute-string.26 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute #\a #\1 x :key #'nextdigit :test (complement #'eql)))) + (and (equalp orig x) + result)) + "0a0aaaa0aa") + +(deftest substitute-string.27 + (let* ((orig "0102342015") + (x (copy-seq orig)) + (result (substitute #\a #\1 x :key #'nextdigit :test-not #'eql))) + (and (equalp orig x) + result)) + "0a0aaaa0aa") + +(deftest substitute-string.28 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x))) + result) + "zbzcb") + +(deftest substitute-string.29 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x :from-end t))) + result) + "zbzcb") + +(deftest substitute-string.30 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x :count 1))) + result) + "zbacb") + +(deftest substitute-string.31 + (let* ((x (make-array '(10) :initial-contents "abacbadeaf" + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x :from-end t :count 1))) + result) + "abzcb") + +;;; Tests on bit-vectors + +(deftest substitute-bit-vector.1 + (let* ((orig #*) + (x (copy-seq orig)) + (result (substitute 0 1 x))) + (and (equalp orig x) + result)) + #*) + +(deftest substitute-bit-vector.2 + (let* ((orig #*) + (x (copy-seq orig)) + (result (substitute 1 0 x))) + (and (equalp orig x) + result)) + #*) + +(deftest substitute-bit-vector.3 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 0 1 x))) + (and (equalp orig x) + result)) + #*000000) + +(deftest substitute-bit-vector.4 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-bit-vector.5 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :start 1))) + (and (equalp orig x) + result)) + #*011111) + +(deftest substitute-bit-vector.6 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 0 1 x :start 2 :end nil))) + (and (equalp orig x) + result)) + #*010000) + +(deftest substitute-bit-vector.7 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :end 4))) + (and (equalp orig x) + result)) + #*111101) + +(deftest substitute-bit-vector.8 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 0 1 x :end nil))) + (and (equalp orig x) + result)) + #*000000) + +(deftest substitute-bit-vector.9 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 0 1 x :end 3))) + (and (equalp orig x) + result)) + #*000101) + +(deftest substitute-bit-vector.10 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 0 1 x :start 2 :end 4))) + (and (equalp orig x) + result)) + #*010001) + +(deftest substitute-bit-vector.11 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :start 2 :end 4))) + (and (equalp orig x) + result)) + #*011101) + +(deftest substitute-bit-vector.12 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count 1))) + (and (equalp orig x) + result)) + #*110101) + +(deftest substitute-bit-vector.13 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count 0))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-bit-vector.14 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count -1))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-bit-vector.15 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count 1 :from-end t))) + (and (equalp orig x) + result)) + #*010111) + +(deftest substitute-bit-vector.16 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count 0 :from-end t))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-bit-vector.17 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count -1 :from-end t))) + (and (equalp orig x) + result)) + #*010101) + +(deftest substitute-bit-vector.18 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count nil))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-bit-vector.19 + (let* ((orig #*010101) + (x (copy-seq orig)) + (result (substitute 1 0 x :count nil :from-end t))) + (and (equalp orig x) + result)) + #*111111) + +(deftest substitute-bit-vector.20 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*0000000000) + (x (copy-seq orig)) + (y (substitute 1 0 x :start i :end j :count c))) + (and (equalp orig x) + (equalp y (concatenate + 'simple-bit-vector + (make-list i :initial-element 0) + (make-list c :initial-element 1) + (make-list (- 10 (+ i c)) :initial-element 0)))))))) + t) + +(deftest substitute-bit-vector.21 + (loop for i from 0 to 9 always + (loop for j from i to 10 always + (loop for c from 0 to (- j i) always + (let* ((orig #*1111111111) + (x (copy-seq orig)) + (y (substitute 0 1 x :start i :end j :count c :from-end t))) + (and (equalp orig x) + (equalp y (concatenate + 'simple-bit-vector + (make-list (- j c) :initial-element 1) + (make-list c :initial-element 0) + (make-list (- 10 j) :initial-element 1)))))))) + t) + +(deftest substitute-bit-vector.22 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (substitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b)))))) + (and (equalp orig x) + result)) + #*0111110101) + +(deftest substitute-bit-vector.23 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (substitute 1 0 x :test-not #'(lambda (a b) (incf c) + (not (and (<= 2 c 5) (= a b))))))) + (and (equalp orig x) + result)) + #*0111110101) + +(deftest substitute-bit-vector.24 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (substitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b))) + :from-end t))) + (and (equalp orig x) + result)) + #*0101011111) + +(deftest substitute-bit-vector.25 + (let* ((orig #*0101010101) + (x (copy-seq orig)) + (c 0) + (result (substitute 1 0 x :test-not #'(lambda (a b) (incf c) + (not (and (<= 2 c 5) (= a b)))) + :from-end t))) + (and (equalp orig x) + result)) + #*0101011111) + +(deftest substitute-bit-vector.26 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute 1 1 x :key #'1+))) + (and (equalp orig x) + result)) + #*11111111111111111) + +(deftest substitute-bit-vector.27 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute 1 1 x :key #'1+ :start 1 :end 10))) + (and (equalp orig x) + result)) + #*01111111111010110) + +(deftest substitute-bit-vector.28 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute 0 1 x :key #'1+ :test (complement #'eql)))) + (and (equalp orig x) + result)) + #*00000000000000000) + +(deftest substitute-bit-vector.29 + (let* ((orig #*00111001011010110) + (x (copy-seq orig)) + (result (substitute 0 1 x :key #'1+ :test-not #'eql))) + (and (equalp orig x) + result)) + #*00000000000000000) + +(deftest substitute-bit-vector.30 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute 1 0 x))) + result) + #*11111) + +(deftest substitute-bit-vector.31 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute 1 0 x :from-end t))) + result) + #*11111) + +(deftest substitute-bit-vector.32 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute 1 0 x :count 1))) + result) + #*11011) + +(deftest substitute-bit-vector.33 + (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) + :fill-pointer 5 :element-type 'bit)) + (result (substitute 1 0 x :from-end t :count 1))) + result) + #*01111) + +(deftest substitute.order.1 + (let ((i 0) a b c d e f g h) + (values + (substitute + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) nil) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :count (progn (setf d (incf i)) 2) + :start (progn (setf e (incf i)) 0) + :end (progn (setf f (incf i)) 7) + :key (progn (setf g (incf i)) #'identity) + :from-end (setf h (incf i)) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 4 5 6 7 8) + +(deftest substitute.order.2 + (let ((i 0) a b c d e f g h) + (values + (substitute + (progn (setf a (incf i)) 'a) + (progn (setf b (incf i)) nil) + (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5)) + :from-end (setf h (incf i)) + :key (progn (setf g (incf i)) #'identity) + :end (progn (setf f (incf i)) 7) + :start (progn (setf e (incf i)) 0) + :count (progn (setf d (incf i)) 2) + ) + i a b c d e f g h)) + (nil 1 2 a 3 4 a 5) + 8 1 2 3 8 7 6 5 4) + +;;; Keyword tests + +(deftest substitute.allow-other-keys.1 + (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t :bad t) + (1 2 a 3 1 a 3)) + +(deftest substitute.allow-other-keys.2 + (substitute 'a 0 (list 1 2 0 3 1 0 3) :bad t :allow-other-keys t) + (1 2 a 3 1 a 3)) + +(deftest substitute.allow-other-keys.3 + (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t + :allow-other-keys nil :bad t) + (1 2 a 3 1 a 3)) + +(deftest substitute.allow-other-keys.4 + (substitute 'a 0 (list 1 2 0 3 1 0 3) :bad t + :allow-other-keys t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest substitute.allow-other-keys.5 + (substitute 'a 0 (list 1 2 0 3 1 0 3) + :allow-other-keys t :key #'1-) + (a 2 0 3 a 0 3)) + +(deftest substitute.keywords.6 + (substitute 'a 0 (list 1 2 0 3 1 0 3) :key #'1- :key #'identity) + (a 2 0 3 a 0 3)) + +(deftest substitute.allow-other-keys.7 + (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t + :bad t :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +(deftest substitute.allow-other-keys.8 + (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys nil) + (1 2 a 3 1 a 3)) + +;;; Error cases + +(deftest substitute.error.1 + (classify-error (substitute)) + program-error) + +(deftest substitute.error.2 + (classify-error (substitute 'a)) + program-error) + +(deftest substitute.error.3 + (classify-error (substitute 'a 'b)) + program-error) + +(deftest substitute.error.4 + (classify-error (substitute 'a 'b nil 'bad t)) + program-error) + +(deftest substitute.error.5 + (classify-error (substitute 'a 'b nil 'bad t :allow-other-keys nil)) + program-error) + +(deftest substitute.error.6 + (classify-error (substitute 'a 'b nil :key)) + program-error) + +(deftest substitute.error.7 + (classify-error (substitute 'a 'b nil 1 2)) + program-error) + +(deftest substitute.error.8 + (classify-error (substitute 'a 'b (list 'a 'b 'c) :test #'identity)) + program-error) + +(deftest substitute.error.9 + (classify-error (substitute 'a 'b (list 'a 'b 'c) :test-not #'identity)) + program-error) + +(deftest substitute.error.10 + (classify-error (substitute 'a 'b (list 'a 'b 'c) :key #'cons)) + program-error) + +(deftest substitute.error.11 + (classify-error (substitute 'a 'b (list 'a 'b 'c) :key #'car)) + type-error) + diff --git a/ansi-tests/subtypep-array.lsp b/ansi-tests/subtypep-array.lsp new file mode 100644 index 0000000..fde2604 --- /dev/null +++ b/ansi-tests/subtypep-array.lsp @@ -0,0 +1,98 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Mar 1 16:23:57 2003 +;;;; Contains: Tests of SUBTYPEP on array types + +(in-package :cl-test) + +;;; *array-element-types* is defined in ansi-aux.lsp + +(deftest subtypep.array.1 + (let ((array-types (cons (find-class 'array) + '(array (array) (array *) (array * *))))) + (loop for tp1 in array-types append + (loop for tp2 in array-types + unless (subtypep tp1 tp2) + collect (list tp1 tp2)))) + nil) + +(deftest subtypep.array.2 + (and (subtypep* '(array t) '(array t *)) + (subtypep* '(array t *) '(array t)) + t) + t) + +(deftest subtypep.array.3 + (loop for i from 0 below (min 16 array-rank-limit) + for type = `(array * ,i) + for type2 = `(array * ,(make-list i :initial-element '*)) + unless (and (subtypep type 'array) + (subtypep type '(array)) + (subtypep type '(array *)) + (subtypep type '(array * *)) + (subtypep type type2)) + collect type) + nil) + +(deftest subtypep.array.4 + (loop for i from 0 below (min 16 array-rank-limit) + for type = `(array t ,i) + for type2 = `(array t ,(make-list i :initial-element '*)) + unless (and (subtypep type '(array t)) + (subtypep type '(array t *)) + (subtypep type type2)) + collect type) + nil) + +(deftest subtypep.array.5 + (loop + for element-type in (cons '* *array-element-types*) + nconc + (loop for i from 0 below (min 16 array-rank-limit) + for type = `(array ,element-type ,i) + for type2 = `(array ,element-type ,(make-list i :initial-element '0)) + for type3 = `(array ,element-type ,(make-list i :initial-element '1)) + unless + (and (subtypep type2 type) + (subtypep type3 type) + (loop for j from 0 to i + always + (and + (subtypep + `(array ,element-type + (,@(make-list j :initial-element '*) + ,@(make-list (- i j) :initial-element 2))) + type) + (subtypep + `(array ,element-type + (,@(make-list j :initial-element 2) + ,@(make-list (- i j) :initial-element '*))) + type)))) + collect type)) + nil) + +(deftest subtypep.aray.6 + (loop + for etype in (cons '* *array-element-types*) + append + (check-equivalence + `(and (array ,etype (* 10 * * *)) + (array ,etype (* * * 29 *))) + `(array ,etype (* 10 * 29 *)))) + nil) + +(deftest subtypep.aray.7 + (let ((etypes *array-element-types*)) + (loop + for etp1 in etypes + for uaetp1 = (upgraded-array-element-type etp1) + append + (loop for etp2 in etypes + for uaetp2 = (upgraded-array-element-type etp2) + when (equal (multiple-value-list (subtypep* uaetp1 uaetp2)) + '(nil t)) + append (check-disjointness `(array ,etp1) `(array ,etp2))))) + nil) + + + \ No newline at end of file diff --git a/ansi-tests/subtypep-cons.lsp b/ansi-tests/subtypep-cons.lsp new file mode 100644 index 0000000..76d4f5b --- /dev/null +++ b/ansi-tests/subtypep-cons.lsp @@ -0,0 +1,202 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 11:57:03 2003 +;;;; Contains: Tests for subtype relationships on cons types + +(in-package :cl-test) + +;;; SUBTYPEP on CONS types + +(defvar *cons-types* + '(cons (cons) (cons *) (cons * *) (cons t) (cons t t) + (cons t *) (cons * t))) + +(deftest subtypep.cons.1 + (loop for t1 in *cons-types* + append (loop for t2 in *cons-types* + unless (equal (mapcar #'notnot + (multiple-value-list + (subtypep t1 t2))) + '(t t)) + collect (list t1 t2))) + nil) + +(deftest subtypep.cons.2 + (loop for t1 in '((cons nil) (cons nil *) (cons nil t) + (cons * nil) (cons t nil) (cons nil nil)) + unless (subtypep t1 nil) + collect t1) + nil) + +(deftest subtypep.cons.3 + (check-equivalence '(and (cons symbol *) (cons * symbol)) + '(cons symbol symbol)) + nil) + +(deftest subtypep.cons.4 + (check-equivalence '(and (cons (integer 0 10) *) + (cons (integer 5 15) (integer 10 20)) + (cons * (integer 15 25))) + '(cons (integer 5 10) (integer 15 20))) + nil) + +(deftest subtypep.cons.5 + (check-equivalence + '(and cons (not (cons symbol symbol))) + '(or (cons (not symbol) *) + (cons * (not symbol)))) + nil) + +(deftest subtypep.cons.6 + (check-equivalence + '(or (cons integer symbol) (cons integer integer) + (cons symbol integer) (cons symbol symbol)) + '(cons (or integer symbol) (or integer symbol))) + nil) + +(deftest subtypep.cons.7 + (check-equivalence + '(or (cons (integer 0 8) (integer 5 15)) + (cons (integer 0 7) (integer 0 6)) + (cons (integer 6 15) (integer 0 9)) + (cons (integer 3 15) (integer 4 15))) + '(cons (integer 0 15) (integer 0 15))) + nil) + +(deftest subtypep.cons.8 + (check-equivalence + '(or + (cons integer (cons symbol integer)) + (cons symbol (cons integer symbol)) + (cons symbol (cons symbol integer)) + (cons symbol (cons integer integer)) + (cons integer (cons integer symbol)) + (cons symbol (cons symbol symbol)) + (cons integer (cons integer integer)) + (cons integer (cons symbol symbol))) + '(cons (or symbol integer) + (cons (or symbol integer) (or symbol integer)))) + nil) + +(deftest subtypep.cons.9 + (check-equivalence + '(or + (cons (integer 0 (3)) (integer 0 (6))) + (cons (integer 3 (9)) (integer 0 (3))) + (cons (integer 0 (6)) (integer 6 (9))) + (cons (integer 6 (9)) (integer 3 (9))) + (cons (integer 3 (6)) (integer 3 (6)))) + '(cons (integer 0 (9)) (integer 0 (9)))) + nil) + +(deftest subtypep.cons.10 + (check-equivalence + '(or + (cons (rational 0 (3)) (rational 0 (6))) + (cons (rational 3 (9)) (rational 0 (3))) + (cons (rational 0 (6)) (rational 6 (9))) + (cons (rational 6 (9)) (rational 3 (9))) + (cons (rational 3 (6)) (rational 3 (6)))) + '(cons (rational 0 (9)) (rational 0 (9)))) + nil) + +(deftest subtypep.cons.11 + (check-equivalence + '(or + (cons (real 0 (3)) (real 0 (6))) + (cons (real 3 (9)) (real 0 (3))) + (cons (real 0 (6)) (real 6 (9))) + (cons (real 6 (9)) (real 3 (9))) + (cons (real 3 (6)) (real 3 (6)))) + '(cons (real 0 (9)) (real 0 (9)))) + nil) + +;;; Test suggested by C.R. +(deftest subtypep.cons.12 + (check-all-not-subtypep + '(cons (or integer symbol) + (or integer symbol)) + '(or (cons integer symbol) + (cons symbol integer))) + nil) + +(deftest subtypep.cons.13 + (check-all-not-subtypep '(not list) 'cons) + nil) + + +;;; a -> b, a ==> b +(deftest subtypep.cons.14 + (check-all-subtypep + '(and (or (cons (not symbol)) (cons * integer)) + (cons symbol)) + '(cons * integer)) + nil) + +;;; a -> b, not b ==> not a +(deftest subtypep.cons.15 + (check-all-subtypep + '(and (or (cons (not symbol)) (cons * integer)) + (cons * (not integer))) + '(cons (not symbol))) + nil) + +;;; (and (or a b) (or (not b) c)) ==> (or a c) +(deftest subtypep.cons.16 + (check-all-subtypep + '(and (or (cons symbol (cons * *)) + (cons * (cons integer *))) + (or (cons * (cons (not integer) *)) + (cons * (cons * float)))) + '(or (cons symbol (cons * *)) + (cons * (cons * float)))) + nil) + +(deftest subtypep.cons.17 + (check-all-subtypep + '(and (or (cons symbol (cons * *)) + (cons * (cons integer *))) + (or (cons * (cons (not integer))) + (cons * (cons * float))) + (or (cons * (cons * (not float))) + (cons symbol (cons * *)))) + '(cons symbol)) + nil) + +(deftest subtypep.cons.18 + (check-all-subtypep + '(cons symbol) + '(or (cons symbol (not integer)) + (cons * integer))) + nil) + +(deftest subtypep.cons.19 + (check-equivalence + '(or + (cons (eql a) (eql x)) + (cons (eql b) (eql y)) + (cons (eql c) (eql z)) + (cons (eql a) (eql y)) + (cons (eql b) (eql z)) + (cons (eql c) (eql x)) + (cons (eql a) (eql z)) + (cons (eql b) (eql x)) + (cons (eql c) (eql y))) + '(cons (member a b c) (member x y z))) + nil) + +(deftest subtypep.cons.20 + (check-equivalence + '(or + (cons (eql a) (eql x)) + (cons (eql b) (eql y)) + (cons (eql a) (eql y)) + (cons (eql b) (eql z)) + (cons (eql c) (eql x)) + (cons (eql a) (eql z)) + (cons (eql b) (eql x)) + (cons (eql c) (eql y))) + '(and (cons (member a b c) (member x y z)) + (not (cons (eql c) (eql z))))) + nil) + diff --git a/ansi-tests/subtypep-eql.lsp b/ansi-tests/subtypep-eql.lsp new file mode 100644 index 0000000..1c7192e --- /dev/null +++ b/ansi-tests/subtypep-eql.lsp @@ -0,0 +1,54 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 11:58:43 2003 +;;;; Contains: Tests for subtype relationships on EQL types + +(in-package :cl-test) + +(deftest subtypep.eql.1 + (let ((s1 (copy-seq "abc")) + (s2 (copy-seq "abc"))) + (let ((t1 `(eql ,s1)) + (t2 `(eql ,s2))) + (cond + ((subtypep t1 t2) "T1 is subtype of T2") + ((subtypep t2 t1) "T2 is subtype of T1") + (t (check-disjointness t1 t2))))) + nil) + +(deftest subtypep.eql.2 + (let ((s1 (copy-seq '(a b c))) + (s2 (copy-seq '(a b c)))) + (let ((t1 `(eql ,s1)) + (t2 `(eql ,s2))) + (cond + ((subtypep t1 t2) "T1 is subtype of T2") + ((subtypep t2 t1) "T2 is subtype of T1") + (t (check-disjointness t1 t2))))) + nil) + +(deftest subtypep.eql.3 + (let ((i1 (1+ most-positive-fixnum)) + (i2 (1+ most-positive-fixnum))) + (check-equivalence `(eql ,i1) `(eql ,i2))) + nil) + +(deftest subtypep.eql.4 + (check-equivalence '(and (eql a) (eql b)) nil) + nil) + +(deftest subtypep.eql.5 + (check-all-subtypep '(eql a) '(satisfies symbolp)) + nil) + +(deftest subtypep.eql.6 + (check-disjointness '(eql 17) '(satisfies symbolp)) + nil) + +(deftest subtypep.eql.7 + (check-all-subtypep '(eql nil) '(satisfies symbolp)) + nil) + +(deftest subtypep.eql.8 + (check-all-not-subtypep '(satisfies symbolp) '(eql a)) + nil) diff --git a/ansi-tests/subtypep-float.lsp b/ansi-tests/subtypep-float.lsp new file mode 100644 index 0000000..48a23f6 --- /dev/null +++ b/ansi-tests/subtypep-float.lsp @@ -0,0 +1,175 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 11:55:37 2003 +;;;; Contains: Tests for subtype relationships on float types + +(in-package :cl-test) + +;;;;;;; + +(deftest subtypep.float.1 + (loop for tp in +float-types+ + append (check-subtypep tp 'float t t)) + nil) + +(deftest subtypep.float.2 + (if (subtypep 'short-float 'long-float) + (loop for tp in +float-types+ + append + (loop for tp2 in +float-types+ + append (check-subtypep tp tp2 t t))) + nil) + nil) + +(deftest subtypep.float.3 + (if (and (not (subtypep 'short-float 'single-float)) + (subtypep 'single-float 'long-float)) + (append + (check-equivalence 'single-float 'double-float) + (check-equivalence 'single-float 'long-float) + (check-equivalence 'double-float 'long-float) + (classes-are-disjoint 'short-float 'single-float) + (classes-are-disjoint 'short-float 'double-float) + (classes-are-disjoint 'short-float 'long-float)) + nil) + nil) + +(deftest subtypep.float.4 + (if (and (subtypep 'single-float 'short-float) + (subtypep 'double-float 'long-float) + (not (subtypep 'short-float 'double-float))) + (append + (check-equivalence 'short-float 'single-float) + (check-equivalence 'double-float 'long-float) + (loop for tp in '(short-float single-float) + append + (loop for tp2 in '(double-float long-float) + append (classes-are-disjoint tp tp2)))) + nil) + nil) + +(deftest subtypep.float.5 + (if (and (not (subtypep 'single-float 'short-float)) + (not (subtypep 'single-float 'double-float)) + (subtypep 'double-float 'long-float)) + (append + (classes-are-disjoint 'short-float 'single-float) + (classes-are-disjoint 'short-float 'double-float) + (classes-are-disjoint 'short-float 'long-float) + (classes-are-disjoint 'single-float 'double-float) + (classes-are-disjoint 'single-float 'long-float) + (check-equivalence 'double-float 'long-float)) + nil) + nil) + +(deftest subtypep.float.6 + (if (and (subtypep 'single-float 'short-float) + (not (subtypep 'single-float 'double-float)) + (not (subtypep 'double-float 'long-float))) + (append + (check-equivalence 'short-float 'single-float) + (classes-are-disjoint 'single-float 'double-float) + (classes-are-disjoint 'single-float 'long-float) + (classes-are-disjoint 'double-float 'long-float)) + nil) + nil) + +(deftest subtypep.float.7 + (if (and (not (subtypep 'single-float 'short-float)) + (not (subtypep 'single-float 'double-float)) + (not (subtypep 'double-float 'long-float))) + (loop for tp in +float-types+ + append + (loop for tp2 in +float-types+ + unless (eq tp tp2) + append (classes-are-disjoint tp tp2))) + nil) + nil) + +(deftest subtypep.float.8 + (subtypep* '(short-float 0.0s0 10.0s0) '(short-float 0.0s0 11.0s0)) + t t) + +(deftest subtypep.float.9 + (subtypep* '(single-float 0.0f0 10.0f0) '(single-float 0.0f0 11.0f0)) + t t) + +(deftest subtypep.float.10 + (subtypep* '(double-float 0.0d0 10.0d0) '(double-float 0.0d0 11.0d0)) + t t) + +(deftest subtypep.float.11 + (subtypep* '(long-float 0.0l0 10.0l0) '(long-float 0.0l0 11.0l0)) + t t) + +(deftest subtypep.float.12 + (subtypep* '(short-float 0.0s0 11.0s0) '(short-float 0.0s0 10.0s0)) + nil t) + +(deftest subtypep.float.13 + (subtypep* '(single-float 0.0f0 11.0f0) '(single-float 0.0f0 10.0f0)) + nil t) + +(deftest subtypep.float.14 + (subtypep* '(double-float 0.0d0 11.0d0) '(double-float 0.0d0 10.0d0)) + nil t) + +(deftest subtypep.float.15 + (subtypep* '(long-float 0.0l0 11.0l0) '(long-float 0.0l0 10.0l0)) + nil t) + +(deftest subtypep.float.16 + (subtypep* '(short-float 0.0s0 (10.0s0)) '(short-float 0.0s0 10.0s0)) + t t) + +(deftest subtypep.float.17 + (subtypep* '(single-float 0.0f0 (10.0f0)) '(single-float 0.0f0 10.0f0)) + t t) + +(deftest subtypep.float.18 + (subtypep* '(double-float 0.0d0 (10.0d0)) '(double-float 0.0d0 10.0d0)) + t t) + +(deftest subtypep.float.19 + (subtypep* '(long-float 0.0l0 (10.0l0)) '(long-float 0.0l0 10.0l0)) + t t) + +(deftest subtypep.float.20 + (subtypep* '(short-float 0.0s0 10.0s0) '(short-float 0.0s0 (10.0s0))) + nil t) + +(deftest subtypep.float.21 + (subtypep* '(single-float 0.0f0 10.0f0) '(single-float 0.0f0 (10.0f0))) + nil t) + +(deftest subtypep.float.22 + (subtypep* '(double-float 0.0d0 10.0d0) '(double-float 0.0d0 (10.0d0))) + nil t) + +(deftest subtypep.float.23 + (subtypep* '(long-float 0.0l0 10.0l0) '(long-float 0.0l0 (10.0l0))) + nil t) + +(deftest subtypep.float.24 + (check-equivalence '(and (short-float 0.0s0 2.0s0) + (short-float 1.0s0 3.0s0)) + '(short-float 1.0s0 2.0s0)) + nil) + +(deftest subtypep.float.25 + (check-equivalence '(and (single-float 0.0f0 2.0f0) + (single-float 1.0f0 3.0f0)) + '(single-float 1.0f0 2.0f0)) + nil) + +(deftest subtypep.float.26 + (check-equivalence '(and (double-float 0.0d0 2.0d0) + (double-float 1.0d0 3.0d0)) + '(double-float 1.0d0 2.0d0)) + nil) + +(deftest subtypep.float.27 + (check-equivalence '(and (long-float 0.0l0 2.0l0) + (long-float 1.0l0 3.0l0)) + '(long-float 1.0l0 2.0l0)) + nil) diff --git a/ansi-tests/subtypep-integer.lsp b/ansi-tests/subtypep-integer.lsp new file mode 100644 index 0000000..ead0fe1 --- /dev/null +++ b/ansi-tests/subtypep-integer.lsp @@ -0,0 +1,434 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 11:54:05 2003 +;;;; Contains: Tests for subtype relationships on integer types + +(in-package :cl-test) + +(deftest subtypep.fixnum-or-bignum + (check-equivalence '(or fixnum bignum) 'integer) + nil) + +(deftest subtypep.fixnum.integer + (check-equivalence `(integer ,most-negative-fixnum ,most-positive-fixnum) + 'fixnum) + nil) + +(deftest subtypep.bignum.integer + (check-equivalence + `(or (integer * (,most-negative-fixnum)) + (integer (,most-positive-fixnum) *)) + 'bignum) + nil) + +;;;;;;; + +(deftest subtypep.integer.1 + (subtypep* '(integer 0 10) '(integer 0 20)) + t t) + +(deftest subtypep.integer.2 + (subtypep* '(integer 0 10) '(integer 0 (10))) + nil t) + +(deftest subtypep.integer.3 + (subtypep* '(integer 10 100) 'integer) + t t) + +(deftest subtypep.integer.3a + (subtypep* '(integer 10 100) '(integer)) + t t) + +(deftest subtypep.integer.3b + (subtypep* '(integer 10 100) '(integer *)) + t t) + +(deftest subtypep.integer.3c + (subtypep* '(integer 10 100) '(integer * *)) + t t) + +(deftest subtypep.integer.4 + (subtypep* 'integer '(integer 10 100)) + nil t) + +(deftest subtypep.integer.4a + (subtypep* '(integer) '(integer 10 100)) + nil t) + +(deftest subtypep.integer.4b + (subtypep* '(integer *) '(integer 10 100)) + nil t) + +(deftest subtypep.integer.4c + (subtypep* '(integer * *) '(integer 10 100)) + nil t) + +(deftest subtypep.integer.5 + (subtypep* '(integer 10 *) 'integer) + t t) + +(deftest subtypep.integer.5a + (subtypep* '(integer 10 *) '(integer)) + t t) + +(deftest subtypep.integer.5b + (subtypep* '(integer 10 *) '(integer *)) + t t) + +(deftest subtypep.integer.5c + (subtypep* '(integer 10 *) '(integer * *)) + t t) + +(deftest subtypep.integer.6 + (subtypep* 'integer '(integer 10 *)) + nil t) + +(deftest subtypep.integer.6a + (subtypep* '(integer) '(integer 10 *)) + nil t) + +(deftest subtypep.integer.6b + (subtypep* '(integer *) '(integer 10 *)) + nil t) + +(deftest subtypep.integer.6c + (subtypep* '(integer * *) '(integer 10 *)) + nil t) + +(deftest subtypep.integer.7 + (subtypep* '(integer 10) 'integer) + t t) + +(deftest subtypep.integer.7a + (subtypep* '(integer 10) '(integer)) + t t) + +(deftest subtypep.integer.7b + (subtypep* '(integer 10) '(integer *)) + t t) + +(deftest subtypep.integer.7c + (subtypep* '(integer 10) '(integer * *)) + t t) + +(deftest subtypep.integer.8 + (subtypep* 'integer '(integer 10)) + nil t) + +(deftest subtypep.integer.8a + (subtypep* '(integer) '(integer 10)) + nil t) + +(deftest subtypep.integer.8b + (subtypep* '(integer *) '(integer 10)) + nil t) + +(deftest subtypep.integer.8c + (subtypep* '(integer * *) '(integer 10)) + nil t) + +(deftest subtypep.integer.9 + (subtypep* '(integer * 10) 'integer) + t t) + +(deftest subtypep.integer.9a + (subtypep* '(integer * 10) '(integer)) + t t) + +(deftest subtypep.integer.9b + (subtypep* '(integer * 10) '(integer *)) + t t) + +(deftest subtypep.integer.9c + (subtypep* '(integer * 10) '(integer * *)) + t t) + +(deftest subtypep.integer.10 + (subtypep* 'integer '(integer * 10)) + nil t) + +(deftest subtypep.integer.10a + (subtypep* '(integer) '(integer * 10)) + nil t) + +(deftest subtypep.integer.10b + (subtypep* '(integer *) '(integer * 10)) + nil t) + +(deftest subtypep.integer.10c + (subtypep* '(integer * *) '(integer * 10)) + nil t) + +(deftest subtypep.integer.11 + (subtypep* '(integer 10) '(integer 5)) + t t) + +(deftest subtypep.integer.12 + (subtypep* '(integer 5) '(integer 10)) + nil t) + +(deftest subtypep.integer.13 + (subtypep* '(integer 10 *) '(integer 5)) + t t) + +(deftest subtypep.integer.14 + (subtypep* '(integer 5) '(integer 10 *)) + nil t) + +(deftest subtypep.integer.15 + (subtypep* '(integer 10) '(integer 5 *)) + t t) + +(deftest subtypep.integer.16 + (subtypep* '(integer 5 *) '(integer 10)) + nil t) + +(deftest subtypep.integer.17 + (subtypep* '(integer 10 *) '(integer 5 *)) + t t) + +(deftest subtypep.integer.18 + (subtypep* '(integer 5 *) '(integer 10 *)) + nil t) + +(deftest subtypep.integer.19 + (subtypep* '(integer * 5) '(integer * 10)) + t t) + +(deftest subtypep.integer.20 + (subtypep* '(integer * 10) '(integer * 5)) + nil t) + +(deftest subtypep.integer.21 + (subtypep* '(integer 10 *) '(integer * 10)) + nil t) + +(deftest subtypep.integer.22 + (subtypep* '(integer * 10) '(integer 10 *)) + nil t) + +(deftest subtypep.integer.23 + (check-equivalence '(integer (9)) '(integer 10)) + nil) + +(deftest subtypep.integer.24 + (check-equivalence '(integer * (11)) '(integer * 10)) + nil) + +(deftest subtypep.integer.25 + (check-equivalence + '(and (or (integer 0 10) (integer 20 30)) + (or (integer 5 15) (integer 25 35))) + '(or (integer 5 10) (integer 25 30))) + nil) + +(deftest subtypep.integer.26 + (check-equivalence + '(and (integer 0 10) (integer 5 15)) + '(integer 5 10)) + nil) + +(deftest subtypep.integer.27 + (check-equivalence + '(or (integer 0 10) (integer 5 15)) + '(integer 0 15)) + nil) + +(deftest subtypep.integer.28 + (check-equivalence + '(and integer (not (eql 10))) + '(or (integer * 9) (integer 11 *))) + nil) + +(deftest subtypep.integer.29 + (check-equivalence + '(and integer (not (integer 1 10))) + '(or (integer * 0) (integer 11 *))) + nil) + +(deftest subtypep.integer.30 + (check-equivalence + '(and (integer -100 100) (not (integer 1 10))) + '(or (integer -100 0) (integer 11 100))) + nil) + +;;; Relations between integer and real types + +(deftest subtypep.integer.real.1 + (check-equivalence + '(and integer (real 4 10)) + '(integer 4 10)) + nil) + +(deftest subtypep.integer.real.2 + (check-equivalence + '(and (integer 4 *) (real * 10)) + '(integer 4 10)) + nil) + +(deftest subtypep.integer.real.3 + (check-equivalence + '(and (integer * 10) (real 4)) + '(integer 4 10)) + nil) + +(deftest subtypep.integer.real.4 + (loop for int-type in '(integer (integer) (integer *) (integer * *)) + append (loop for real-type in '(real (real) (real *) (real * *)) + unless (equal (multiple-value-list + (subtypep* int-type real-type)) + '(t t)) + collect (list int-type real-type))) + nil) + +(deftest subtypep.integer.real.5 + (loop for int-type in '((integer 10) (integer 10 *)) + append (loop for real-type in '(real (real) (real *) (real * *) + (real 10.0) (real 10.0 *) + (real 10) (real 10 *)) + unless (equal (multiple-value-list + (subtypep* int-type real-type)) + '(t t)) + collect (list int-type real-type))) + nil) + +(deftest subtypep.integer.real.6 + (loop for int-type in '((integer * 10) (integer * 5)) + append (loop for real-type in '(real (real) (real *) (real * *) + (real * 10.0) + (real * 10) (real * 1000000000000)) + unless (equal (multiple-value-list + (subtypep* int-type real-type)) + '(t t)) + collect (list int-type real-type))) + nil) + +(deftest subtypep.integer.real.7 + (loop for int-type in '((integer 0 10) (integer 2 5)) + append (loop for real-type in '(real (real) (real *) (real * *) + (real * 10) (real * 1000000000000) + (real -10) (real -10.0) + (real -10 *) (real -10.0 *) + (real 0) (real 0.0) + (real 0 10) (real * 10) + (real 0 *) (real 0 10)) + unless (equal (multiple-value-list + (subtypep* int-type real-type)) + '(t t)) + collect (list int-type real-type))) + nil) + +(deftest subtypep.integer.real.8 + (check-equivalence + '(and (integer 4) (real * 10)) + '(integer 4 10)) + nil) + +(deftest subtypep.integer.real.9 + (check-equivalence + '(and (integer * 10) (real 4)) + '(integer 4 10)) + nil) + +(deftest subtypep.integer.real.10 + (check-equivalence + '(and (integer 4) (real * (10))) + '(integer 4 9)) + nil) + +(deftest subtypep.integer.real.11 + (check-equivalence + '(and (integer * 10) (real (4))) + '(integer 5 10)) + nil) + + +;;; Between integer and rational types + +(deftest subtypep.integer.rational.1 + (check-equivalence + '(and integer (rational 4 10)) + '(integer 4 10)) + nil) + +(deftest subtypep.integer.rational.2 + (check-equivalence + '(and (integer 4 *) (rational * 10)) + '(integer 4 10)) + nil) + +(deftest subtypep.integer.rational.3 + (check-equivalence + '(and (integer * 10) (rational 4)) + '(integer 4 10)) + nil) + + + +(deftest subtypep.integer.rational.4 + (loop for int-type in '(integer (integer) (integer *) (integer * *)) + append (loop for rational-type + in '(rational (rational) (rational *) (rational * *)) + unless (equal (multiple-value-list + (subtypep* int-type rational-type)) + '(t t)) + collect (list int-type rational-type))) + nil) + +(deftest subtypep.integer.rational.5 + (loop for int-type in '((integer 10) (integer 10 *)) + append (loop for rational-type + in '(rational (rational) (rational *) (rational * *) + (rational 19/2) (rational 19/2 *) + (rational 10) (rational 10 *)) + unless (equal (multiple-value-list + (subtypep* int-type rational-type)) + '(t t)) + collect (list int-type rational-type))) + nil) + +(deftest subtypep.integer.rational.6 + (loop for int-type in '((integer * 10) (integer * 5)) + append (loop for rational-type + in '(rational (rational) (rational *) (rational * *) + (rational * 21/2) + (rational * 10) (rational * 1000000000000)) + unless (equal (multiple-value-list + (subtypep* int-type rational-type)) + '(t t)) + collect (list int-type rational-type))) + nil) + +(deftest subtypep.integer.rational.7 + (loop for int-type in '((integer 0 10) (integer 2 5)) + append (loop for rational-type in + '(rational (rational) (rational *) (rational * *) + (rational * 10) (rational * 1000000000000) + (rational -1) (rational -1/2) + (rational -1 *) (rational -1/2 *) + (rational 0) + (rational 0 10) (rational * 10) + (rational 0 *) (rational 0 10)) + unless (equal (multiple-value-list + (subtypep* int-type rational-type)) + '(t t)) + collect (list int-type rational-type))) + nil) + +(deftest subtypep.integer.rational.8 + (check-equivalence + '(and integer (rational (4) 10)) + '(integer 5 10)) + nil) + +(deftest subtypep.integer.rational.9 + (check-equivalence + '(and (integer 4 *) (rational * (10))) + '(integer 4 9)) + nil) + +(deftest subtypep.integer.rational.10 + (check-equivalence + '(and (integer * 10) (rational (4))) + '(integer 5 10)) + nil) diff --git a/ansi-tests/subtypep-member.lsp b/ansi-tests/subtypep-member.lsp new file mode 100644 index 0000000..3a5fa78 --- /dev/null +++ b/ansi-tests/subtypep-member.lsp @@ -0,0 +1,229 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 11:58:06 2003 +;;;; Contains: Tests for subtype relationships on member types + +(in-package :cl-test) + +;;; SUBTYPEP on MEMBER types + +(deftest subtypep.member.1 + (check-all-subtypep '(member a b c) '(member a b c d)) + nil) + +(deftest subtypep.member.2 + (check-all-not-subtypep '(member a b c) '(member a b)) + nil) + +(deftest subtypep.member.3 + (check-equivalence '(member) nil) + nil) + +(deftest subtypep.member.4 + (check-all-subtypep '(eql b) '(member a b c)) + nil) + +(deftest subtypep.member.5 + (check-all-subtypep '(member a b c d e) 'symbol) + nil) + +(deftest subtypep.member.6 + (check-all-not-subtypep '(member a b 10 d e) 'symbol) + nil) + +(deftest subtypep.member.7 + (check-all-subtypep 'null '(member a b nil c d e)) + nil) + +(deftest subtypep.member.8 + (check-all-not-subtypep 'null '(member a b c d e)) + nil) + +(deftest subtypep.member.9 + (let ((b1 (1+ most-positive-fixnum)) + (b2 (1+ most-positive-fixnum))) + (check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2))) + nil) + +(deftest subtypep.member.10 + (check-all-subtypep '(member :a :b :c) 'keyword) + nil) + +(deftest subtypep.member.11 + (let ((b1 (copy-list '(a))) + (b2 (copy-list '(a)))) + (check-all-not-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2))) + nil) + +(deftest subtypep.member.12 + (let ((b1 '(a))) + (check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b1))) + nil) + +(deftest subtypep.member.13 + (check-all-subtypep '(member 10 20 30) '(integer 0 100)) + nil) + +(deftest subtypep.member.14 + (check-all-subtypep '(integer 3 6) '(member 0 1 2 3 4 5 6 7 8 100)) + nil) + +(deftest subtypep.member.15 + (check-all-not-subtypep '(integer 3 6) '(member 0 1 2 3 5 6 7 8)) + nil) + +(deftest subtypep.member.16 + (check-equivalence '(integer 2 5) '(member 2 5 4 3)) + nil) + +(deftest subtypep.member.17 + (let ((s1 (copy-seq "abc")) + (s2 (copy-seq "abc"))) + (let ((t1 `(member ,s1)) + (t2 `(member ,s2))) + (cond + ((subtypep t1 t2) "T1 is subtype of T2") + ((subtypep t2 t1) "T2 is subtype of T1") + (t (check-disjointness t1 t2))))) + nil) + +(deftest subtypep.member.18 + (let ((s1 (copy-seq '(a b c))) + (s2 (copy-seq '(a b c)))) + (let ((t1 `(member ,s1)) + (t2 `(member ,s2))) + (cond + ((subtypep t1 t2) "T1 is subtype of T2") + ((subtypep t2 t1) "T2 is subtype of T1") + (t (check-disjointness t1 t2))))) + nil) + +(deftest subtypep.member.19 + (let ((i1 (1+ most-positive-fixnum)) + (i2 (1+ most-positive-fixnum))) + (check-equivalence `(member 0 ,i1) `(member 0 ,i2))) + nil) + +(deftest subtypep.member.20 + (check-equivalence '(and (member a b c d) (member e d b f g)) + '(member b d)) + nil) + +(deftest subtypep.member.21 + (check-equivalence '(and (member a b c d) (member e d f g)) + '(eql d)) + nil) + +(deftest subtypep.member.22 + (check-equivalence '(and (member a b c d) (member e f g)) + nil) + nil) + +(deftest subtypep.member.23 + (check-equivalence '(or (member a b c) (member z b w)) + '(member z a b w c)) + nil) + +(deftest subtypep.member.24 + (check-equivalence '(or (member a b c) (eql d)) + '(member d c b a)) + nil) + +(deftest subtypep.member.25 + (check-equivalence 'boolean '(member nil t)) + nil) + +(deftest subtypep.member.26 + (check-equivalence '(or (eql a) (eql b)) + '(member a b)) + nil) + +(deftest subtypep.member.27 + (check-all-subtypep '(member a b c d) '(satisfies symbolp)) + nil) + +(deftest subtypep.member.28 + (check-all-subtypep '(member a b c d) t) + nil) + +(deftest subtypep.member.29 + (check-all-not-subtypep '(member a b 10 z) '(satisfies symbolp)) + nil) + +(deftest subtypep.member.30 + (check-disjointness '(member 1 6 10) '(satisfies symbolp)) + nil) + +(deftest subtypep.member.31 + (check-equivalence '(member a b c d) '(member c d b a)) + nil) + +(deftest subtypep.member.32 + (check-all-not-subtypep '(not (member a b 10 z)) '(satisfies symbolp)) + nil) + +(deftest subtypep.member.33 + (check-all-not-subtypep '(satisfies symbolp) '(member a b 10 z)) + nil) + +(deftest subtypep.member.34 + (check-all-not-subtypep '(member a b 10 z) '(not (satisfies symbolp))) + nil) + +(deftest subtypep.member.35 + (check-all-not-subtypep '(satisfies symbolp) '(member a b c d)) + nil) + +(deftest subtypep.member.36 + (check-disjointness '(eql a) '(or (member b c d) (eql e))) + nil) + +(deftest subtypep.member.37 + (check-equivalence + '(and (member a b c d) (not (eql c))) + '(member a b d)) + nil) + +(deftest subtypep.member.38 + (check-equivalence + '(and (member a b c d e f g) + (not (member b f))) + '(member a c d e g)) + nil) + +(deftest subtypep.member.39 + (check-equivalence + '(and (not (member b d e f g)) + (not (member x y b z d))) + '(not (member b d e f g x y z))) + nil) + +(deftest subtypep.member.40 + (check-equivalence + '(and (not (eql a)) (not (eql b))) + '(not (member a b))) + nil) + +(deftest subtypep.member.41 + (check-equivalence + '(and (not (eql a)) (not (eql b)) (not (eql c))) + '(not (member c b a))) + nil) + +(deftest subtypep.member.42 + (check-equivalence + '(and (not (member a b)) (not (member b c))) + '(not (member c b a))) + nil) + +(deftest subtypep.member.43 + (check-equivalence + '(and (not (member a g b k e)) (not (member b h k c f))) + '(not (member c b k a e f g h))) + nil) + +(deftest subtypep.member.44 + (check-equivalence + '(and (integer 0 30) (not (member 3 4 5 9 10 11 17 18 19))) + '(or (integer 0 2) (integer 6 8) (integer 12 16) (integer 20 30))) + nil) diff --git a/ansi-tests/subtypep-rational.lsp b/ansi-tests/subtypep-rational.lsp new file mode 100644 index 0000000..e2059a8 --- /dev/null +++ b/ansi-tests/subtypep-rational.lsp @@ -0,0 +1,173 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 15 11:56:19 2003 +;;;; Contains: Tests for subtype relationships on rational types + +(in-package :cl-test) + +;;; SUBTYPEP on rational types + +(deftest subtypep.rational.1 + (loop for tp1 in '((rational 10) (rational 10 *) + (rational 10 20) + (rational (10) 20) + (rational 10 (20)) + (rational (10) (20)) + (rational 10 1000000000000000) + (rational (10)) (rational (10) *)) + append + (loop for tp2 in '(rational (rational) (rational *) + (rational * *) (rational 10) (rational 10 *) + (rational 0) (rational 0 *) + (rational 19/2) (rational 19/2 *) + (rational -1000000000000000) + real (real) (real *) + (real * *) (real 10) (real 10 *) + (real 0) (real 0 *) + (real 19/2) (real 19/2 *) + (real -1000000000000000)) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(t t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.rational.2 + (loop for tp1 in '((rational * 10) + (rational 0 10) + (rational 0 (10)) + (rational (0) 10) + (rational (0) (10)) + (rational -1000000000000000 10) + (rational * (10))) + append + (loop for tp2 in '(rational (rational) (rational *) + (rational * *) (rational * 10) + (rational * 21/2) + (rational * 1000000000000000) + real (real) (real *) + (real * *) (real * 10) + (real * 21/2) + (real * 1000000000000000)) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(t t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.rational.3 + (loop for tp1 in '((rational 10) (rational 10 *) + (rational 10 20) + (rational 10 (21)) + (rational 10 1000000000000000)) + append + (loop for tp2 in '((rational 11) (rational 11 *) + (rational (10)) (rational (10) *) + (integer 10) (integer 10 *) + (real 11) + (real (10)) + (real 11 *) + (real (10) *) + (rational * (20)) + (rational * 19) + (real * (20)) + (real * 19)) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(nil t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.rational.4 + (loop for tp1 in '((rational * 10) + (rational 0 10) + (rational (0) 10) + (rational -1000000000000000 10)) + append + (loop for tp2 in '((rational * 9) + (rational * (10)) + (integer * 10) + (real * 9) + (real * (10))) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(nil t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.rational.5 + (check-equivalence + '(or (rational 0 0) (rational (0))) + '(rational 0)) + nil) + +(deftest subtypep.rational.6 + (check-equivalence + '(and (rational 0 10) (rational 5 15)) + '(rational 5 10)) + nil) + +(deftest subtypep.rational.7 + (check-equivalence + '(and (rational (0) 10) (rational 5 15)) + '(rational 5 10)) + nil) + +(deftest subtypep.rational.8 + (check-equivalence + '(and (rational 0 (10)) (rational 5 15)) + '(rational 5 (10))) + nil) + +(deftest subtypep.rational.9 + (check-equivalence + '(and (rational (0) (10)) (rational 5 15)) + '(rational 5 (10))) + nil) + +(deftest subtypep.rational.10 + (check-equivalence + '(and (rational 0 10) (rational (5) 15)) + '(rational (5) 10)) + nil) + +(deftest subtypep.rational.11 + (check-equivalence + '(and (rational 0 (10)) (rational (5) 15)) + '(rational (5) (10))) + nil) + +(deftest subtypep.rational.12 + (check-equivalence + '(and integer (rational 0 10) (not (rational (0) (10)))) + '(member 0 10)) + nil) + +(deftest subtypep.rational.13 + (check-equivalence '(and integer (rational -1/2 1/2)) + '(integer 0 0)) + nil) + +(deftest subtypep.rational.14 + (check-equivalence '(and integer (rational -1/2 1/2)) + '(eql 0)) + nil) + +(deftest subtypep.rational.15 + (check-equivalence '(and integer (rational (-1/2) 1/2)) + '(integer 0 0)) + nil) + +(deftest subtypep.rational.16 + (check-equivalence '(and integer (rational (-1/2) (1/2))) + '(integer 0 0)) + nil) + +(deftest subtypep.rational.17 + (check-all-subtypep '(not (rational -1/2 1/2)) '(not (integer 0 0))) + nil) + +(deftest subtypep.rational.18 + (check-all-subtypep '(not (rational -1/2 1/2)) '(not (eql 0))) + nil) + diff --git a/ansi-tests/subtypep-real.lsp b/ansi-tests/subtypep-real.lsp new file mode 100644 index 0000000..d27c183 --- /dev/null +++ b/ansi-tests/subtypep-real.lsp @@ -0,0 +1,194 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Feb 18 18:38:55 2003 +;;;; Contains: Tests of SUBTYPEP on REAL types. + +(in-package :cl-test) + +;;; SUBTYPEP on real types + +(deftest subtypep.real.1 + (loop for tp1 in '((real 10) (real 10 *) + (real 10 20) + (real (10) 20) + (real 10 (20)) + (real (10) (20)) + (real 10 1000000000000000) + (real (10)) (real (10) *)) + append + (loop for tp2 in '(real (real) (real *) + (real * *) (real 10) (real 10 *) + (real 0) (real 0 *) + (real 19/2) (real 19/2 *) + (real 9.5) (real 9.5 *) + (real -1000000000000000)) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(t t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.real.2 + (loop for tp1 in '((real * 10) + (real 0 10) + (real 0 (10)) + (real (0) 10) + (real (0) (10)) + (real -1000000000000000 10) + (real * (10))) + append + (loop for tp2 in '(real (real) (real *) + (real * *) (real * 10) + (real * 21/2) + (real * 10.5) + (real * 1000000000000000)) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(t t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.real.3 + (loop for tp1 in '((real 10) (real 10 *) + (real 10 20) + (real 10 (21)) + (real 10 1000000000000000)) + append + (loop for tp2 in '((real 11) (real 11 *) + (real (10)) (real (10) *) + (integer 10) (integer 10 *) + (real 11) + (real (10)) + (real 11 *) + (real (10) *) + (real * (20)) + (real * 19) + (real * (20)) + (real * 19)) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(nil t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.real.4 + (loop for tp1 in '((real * 10) + (real 0 10) + (real (0) 10) + (real -1000000000000000 10)) + append + (loop for tp2 in '((real * 9) + (real * (10)) + (integer * 10) + (real * 9) + (real * (10))) + unless (equal (multiple-value-list + (subtypep* tp1 tp2)) + '(nil t)) + collect (list tp1 tp2))) + nil) + +(deftest subtypep.real.5 + (check-equivalence + '(or (real 0 0) (real (0))) + '(real 0)) + nil) + +(deftest subtypep.real.6 + (check-equivalence + '(and (real 0 10) (real 5 15)) + '(real 5 10)) + nil) + +(deftest subtypep.real.7 + (check-equivalence + '(and (real (0) 10) (real 5 15)) + '(real 5 10)) + nil) + +(deftest subtypep.real.8 + (check-equivalence + '(and (real 0 (10)) (real 5 15)) + '(real 5 (10))) + nil) + +(deftest subtypep.real.9 + (check-equivalence + '(and (real (0) (10)) (real 5 15)) + '(real 5 (10))) + nil) + +(deftest subtypep.real.10 + (check-equivalence + '(and (real 0 10) (real (5) 15)) + '(real (5) 10)) + nil) + +(deftest subtypep.real.11 + (check-equivalence + '(and (real 0 (10)) (real (5) 15)) + '(real (5) (10))) + nil) + +(deftest subtypep.real.12 + (check-equivalence + '(and integer (real 0 10) (not (real (0) (10)))) + '(member 0 10)) + nil) + +(deftest subtypep.real.13 + (check-equivalence '(and integer (real -1/2 1/2)) + '(integer 0 0)) + nil) + +(deftest subtypep.real.14 + (check-equivalence '(and integer (real -1/2 1/2)) + '(eql 0)) + nil) + +(deftest subtypep.real.15 + (check-equivalence '(and integer (real (-1/2) 1/2)) + '(integer 0 0)) + nil) + +(deftest subtypep.real.16 + (check-equivalence '(and integer (real (-1/2) (1/2))) + '(integer 0 0)) + nil) + +(deftest subtypep.real.17 + (check-equivalence '(real 0 10) '(real 0.0 10.0)) + nil) + +(deftest subtypep.real.18 + (check-equivalence '(and rational (real 0 10)) + '(rational 0 10)) + nil) + +(deftest subtypep.real.19 + (check-equivalence '(and rational (real 0 (10))) + '(rational 0 (10))) + nil) + +(deftest subtypep.real.20 + (check-equivalence '(and rational (real (0) (10))) + '(rational (0) (10))) + nil) + +(deftest subtypep.real.21 + (check-equivalence '(and rational (real 1/2 7/3)) + '(rational 1/2 7/3)) + nil) + +(deftest subtypep.real.22 + (check-equivalence '(and rational (real (1/11) (8/37))) + '(rational (1/11) (8/37))) + nil) + +(deftest subtypep.real.23 + (check-all-subtypep '(not (real -1/2 1/2)) '(not (integer 0 0))) + nil) + +(deftest subtypep.real.24 + (check-all-subtypep '(not (real -1/2 1/2)) '(not (eql 0))) + nil) diff --git a/ansi-tests/subtypep.lsp b/ansi-tests/subtypep.lsp new file mode 100644 index 0000000..e46221b --- /dev/null +++ b/ansi-tests/subtypep.lsp @@ -0,0 +1,200 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 29 17:28:19 2003 +;;;; Contains: Tests of SUBTYPEP + +(in-package :cl-test) + +;;; More subtypep tests are in types-and-class.lsp + +(deftest subtypep.order.1 + (let ((i 0) x y) + (values + (notnot (subtypep (progn (setf x (incf i)) t) + (progn (setf y (incf i)) t))) + i x y)) + t 2 1 2) + +(deftest simple-base-string-is-sequence + (subtypep* 'simple-base-string 'sequence) + t t) + +(deftest subtype.env.1 + (mapcar #'notnot + (multiple-value-list (subtypep 'bit 'integer nil))) + (t t)) + +(deftest subtype.env.2 + (macrolet + ((%foo (&environment env) + (list 'quote + (mapcar #'notnot + (multiple-value-list + (subtypep 'bit 'integer env)))))) + (%foo)) + (t t)) + +(deftest subtype.env.3 + (macrolet + ((%foo (&environment env) + (multiple-value-bind (sub good) + (subtypep nil (type-of env)) + (or (not good) (notnot sub))))) + (%foo)) + t) + +(deftest subtype.env.4 + (macrolet + ((%foo (&environment env) + (multiple-value-bind (sub good) + (subtypep (type-of env) (type-of env)) + (or (not good) (notnot sub))))) + (%foo)) + t) + +(deftest subtype.env.5 + (macrolet + ((%foo (&environment env) + (multiple-value-bind (sub good) + (subtypep (type-of env) t) + (or (not good) (notnot sub))))) + (%foo)) + t) + +(deftest subtypep.error.1 + (classify-error (subtypep)) + program-error) + +(deftest subtypep.error.2 + (classify-error (subtypep t)) + program-error) + +(deftest subtypep.error.3 + (classify-error (subtypep t t nil nil)) + program-error) + +;;; Special cases of types-6 that are/were causing problems in CMU CL + +(deftest keyword-is-subtype-of-atom + (subtypep* 'keyword 'atom) + t t) + +(deftest ratio-is-subtype-of-atom + (subtypep* 'ratio 'atom) + t t) + +(deftest extended-char-is-subtype-of-atom + (subtypep* 'extended-char 'atom) + t t) + +(deftest string-is-not-simple-vector + (subtypep* 'string 'simple-vector) + nil t) + +(deftest base-string-is-not-simple-vector + (subtypep* 'base-string 'simple-vector) + nil t) + +(deftest simple-string-is-not-simple-vector + (subtypep* 'simple-string 'simple-vector) + nil t) + +(deftest simple-base-string-is-not-simple-vector + (subtypep* 'simple-base-string 'simple-vector) + nil t) + +(deftest bit-vector-is-not-simple-vector + (subtypep* 'bit-vector 'simple-vector) + nil t) + +(deftest simple-bit-vector-is-not-simple-vector + (subtypep* 'simple-bit-vector 'simple-vector) + nil t) + +(deftest subtypep.extended-char.1 + (if (subtypep* 'character 'base-char) + (subtypep* 'extended-char nil) + (values t t)) + t t) + +(deftest subtypep.and/or.1 + (check-equivalence + '(and (or symbol (integer 0 15)) + (or symbol (integer 10 25))) + '(or symbol (integer 10 15))) + nil) + +(deftest subtypep.and/or.2 + (check-equivalence + '(and (or (not symbol) (integer 0 10)) + (or symbol (integer 11 25))) + '(integer 11 25)) + nil) + +(deftest subtypep.and.1 + (loop for type in *types-list3* + append (check-equivalence `(and ,type ,type) type)) + nil) + +(deftest subtypep.or.1 + (loop for type in *types-list3* + append (check-equivalence `(or ,type ,type) type)) + nil) + +(deftest subtypep.and.2 + (check-equivalence t '(and)) + nil) + +(deftest subtypep.or.2 + (check-equivalence nil '(or)) + nil) + +(deftest subtypep.and.3 + (loop for type in *types-list3* + append (check-equivalence `(and ,type) type)) + nil) + +(deftest subtypep.or.3 + (loop for type in *types-list3* + append (check-equivalence `(or ,type) type)) + nil) + +(deftest subtypep.and.4 + (let* ((n (length *types-list3*)) + (a (make-array n :initial-contents *types-list3*))) + (trim-list + (loop for i below 1000 + for tp1 = (aref a (random n)) + for tp2 = (aref a (random n)) + append (check-equivalence `(and ,tp1 ,tp2) + `(and ,tp2 ,tp1))) + 100)) + nil) + +(deftest subtypep.or.4 + (let* ((n (length *types-list3*)) + (a (make-array n :initial-contents *types-list3*))) + (trim-list + (loop for i below 1000 + for tp1 = (aref a (random n)) + for tp2 = (aref a (random n)) + append (check-equivalence `(or ,tp1 ,tp2) + `(or ,tp2 ,tp1))) + 100)) + nil) + +;;; Check that types that are supposed to be nonempty are +;;; not subtypes of NIL + +(deftest subtypep.nil.1 + (loop for (type) in *subtype-table* + unless (member type '(nil extended-char)) + append (check-all-not-subtypep type nil)) + nil) + +(deftest subtypep.nil.2 + (loop for (type) in *subtype-table* + for class = (find-class type nil) + unless (or (not class) (member type '(nil extended-char))) + append (check-all-not-subtypep class nil)) + nil) diff --git a/ansi-tests/svref.lsp b/ansi-tests/svref.lsp new file mode 100644 index 0000000..af0f7c4 --- /dev/null +++ b/ansi-tests/svref.lsp @@ -0,0 +1,59 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 22 21:39:30 2003 +;;;; Contains: Tests of SVREF + +(in-package :cl-test) + +(deftest svref.1 + (let ((a (vector 1 2 3 4))) + (loop for i below 4 collect (svref a i))) + (1 2 3 4)) + +(deftest svref.2 + (let ((a (vector 1 2 3 4))) + (values + (loop for i below 4 + collect (setf (svref a i) (+ i 10))) + a)) + (10 11 12 13) + #(10 11 12 13)) + +(deftest svref.order.1 + (let ((v (vector 'a 'b 'c 'd)) + (i 0) a b) + (values + (svref (progn (setf a (incf i)) v) + (progn (setf b (incf i)) 2)) + i a b)) + c 2 1 2) + +(deftest svref.order.2 + (let ((v (vector 'a 'b 'c 'd)) + (i 0) a b c) + (values + (setf + (svref (progn (setf a (incf i)) v) + (progn (setf b (incf i)) 2)) + (progn (setf c (incf i)) 'w)) + v i a b c)) + w #(a b w d) 3 1 2 3) + + +;;; Error tests + +(deftest svref.error.1 + (classify-error (svref)) + program-error) + +(deftest svref.error.2 + (classify-error (svref (vector 1))) + program-error) + +(deftest svref.error.3 + (classify-error (svref (vector 1) 0 0)) + program-error) + +(deftest svref.error.4 + (classify-error (svref (vector 1) 0 nil)) + program-error) diff --git a/ansi-tests/synonym-stream-symbol.lsp b/ansi-tests/synonym-stream-symbol.lsp new file mode 100644 index 0000000..11eb6e6 --- /dev/null +++ b/ansi-tests/synonym-stream-symbol.lsp @@ -0,0 +1,23 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 29 21:21:06 2004 +;;;; Contains: Tests of SYNONYM-STREAM-SYMBOL + +(in-package :cl-test) + +(deftest synonym-stream-symbol.1 + (synonym-stream-symbol (make-synonym-stream '*standard-input*)) + *standard-input*) + +(deftest synonym-stream-symbol.error.1 + (signals-error (synonym-stream-symbol) program-error) + t) + +(deftest synonym-stream-symbol.error.2 + (signals-error (synonym-stream-symbol + (make-synonym-stream '*terminal-io*) + nil) + program-error) + t) + + diff --git a/ansi-tests/t.lsp b/ansi-tests/t.lsp new file mode 100644 index 0000000..eecb697 --- /dev/null +++ b/ansi-tests/t.lsp @@ -0,0 +1,24 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Oct 17 06:44:45 2002 +;;;; Contains: Tests of T + +(in-package :cl-test) + +(deftest t.1 + t t) + +(deftest t.2 + (not-mv (constantp t)) + nil) + +(deftest t.3 + (eqt t 't) + t) + +(deftest t.4 + (symbol-value t) + t) + +;;; Tests for use of T in case forms, as a stream designator, or as a class +;;; designator will be elsewhere diff --git a/ansi-tests/tagbody.lsp b/ansi-tests/tagbody.lsp new file mode 100644 index 0000000..fd373e1 --- /dev/null +++ b/ansi-tests/tagbody.lsp @@ -0,0 +1,161 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 13:27:22 2002 +;;;; Contains: Tests of TAGBODY + +(in-package :cl-test) + +(deftest tagbody.1 + (tagbody) + nil) + +(deftest tagbody.2 + (tagbody 'a) + nil) + +(deftest tagbody.3 + (tagbody (values)) + nil) + +(deftest tagbody.4 + (tagbody (values 1 2 3 4 5)) + nil) + +(deftest tagbody.5 + (let ((x 0)) + (values + (tagbody + (setq x 1) + (go a) + (setq x 2) + a) + x)) + nil 1) + +(deftest tagbody.6 + (let ((x 0)) + (tagbody + (setq x 1) + (go a) + b + (setq x 2) + (go c) + a + (setq x 3) + (go b) + c) + x) + 2) + +;;; Macroexpansion occurs after tag determination +(deftest tagbody.7 + (let ((x 0)) + (macrolet ((%m () 'a)) + (tagbody + (tagbody + (go a) + (%m) + (setq x 1)) + a )) + x) + 0) + +(deftest tagbody.8 + (let ((x 0)) + (tagbody + (flet ((%f (y) (setq x y) (go a))) + (%f 10)) + (setq x 1) + a) + x) + 10) + +;;; Tag names are in their own name space +(deftest tagbody.9 + (let (result) + (tagbody + (flet ((a (x) x)) + (setq result (a 10)) + (go a)) + a) + result) + 10) + +(deftest tagbody.10 + (let (result) + (tagbody + (block a + (setq result 10) + (go a)) + (setq result 20) + a) + result) + 10) + +(deftest tagbody.11 + (let (result) + (tagbody + (catch 'a + (setq result 10) + (go a)) + (setq result 20) + a) + result) + 10) + +(deftest tagbody.12 + (let (result) + (tagbody + (block a + (setq result 10) + (return-from a nil)) + (setq result 20) + a) + result) + 20) + +;;; Test that integers are accepted as go tags + +(deftest tagbody.13 + (block done + (tagbody + (go around) + 10 + (return-from done 'good) + around + (go 10))) + good) + +(deftest tagbody.14 + (block done + (tagbody + (go around) + -10 + (return-from done 'good) + around + (go -10))) + good) + +(deftest tagbody.15 + (block done + (tagbody + (go around) + #.(1+ most-positive-fixnum) + (return-from done 'good) + around + (go #.(1+ most-positive-fixnum)))) + good) + +(deftest tagbody.16 + (let* ((t1 (1+ most-positive-fixnum)) + (t2 (1+ most-positive-fixnum)) + (form `(block done + (tagbody + (go around) + ,t1 + (return-from done 'good) + around + (go ,t2))))) + (eval form)) + good) + diff --git a/ansi-tests/terpri.lsp b/ansi-tests/terpri.lsp new file mode 100644 index 0000000..89a07f1 --- /dev/null +++ b/ansi-tests/terpri.lsp @@ -0,0 +1,62 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 20:35:57 2004 +;;;; Contains: Tests of TERPRI + +(in-package :cl-test) + +(deftest terpri.1 + (let (result) + (values + (with-output-to-string + (*standard-output*) + (write-char #\a) + (setq result (terpri))) + result)) + #.(concatenate 'string "a" (string #\Newline)) + nil) + +(deftest terpri.2 + (let (result) + (values + (with-output-to-string + (s) + (write-char #\a s) + (setq result (terpri s))) + result)) + #.(concatenate 'string "a" (string #\Newline)) + nil) + +(deftest terpri.3 + (with-output-to-string + (s) + (write-char #\x s) + (terpri s) + (terpri s) + (write-char #\y s)) + #.(concatenate 'string "x" (string #\Newline) (string #\Newline) "y")) + +(deftest terpri.4 + (with-output-to-string + (os) + (let ((*terminal-io* (make-two-way-stream *standard-input* os))) + (terpri t) + (finish-output t))) + #.(string #\Newline)) + +(deftest terpri.5 + (with-output-to-string + (*standard-output*) + (terpri nil)) + #.(string #\Newline)) + +;;; Error tests + +(deftest terpri.error.1 + (signals-error + (with-output-to-string + (s) + (terpri s nil)) + program-error) + t) + diff --git a/ansi-tests/translate-logical-pathname.lsp b/ansi-tests/translate-logical-pathname.lsp new file mode 100644 index 0000000..e07edcc --- /dev/null +++ b/ansi-tests/translate-logical-pathname.lsp @@ -0,0 +1,48 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Dec 29 14:45:50 2003 +;;;; Contains: Tests for TRANSLATE-LOGICAL-PATHNAME + +(in-package :cl-test) + +;; On physical pathnames, t-l-p returns the pathname itself + +;;; Every physical pathname is converted to itself +(deftest translate-logical-pathname.1 + (loop for p in *pathnames* + unless (or (typep p 'logical-pathname) + (eq p (translate-logical-pathname p))) + collect p) + nil) + +;;; &key arguments are allowed +(deftest translate-logical-pathname.2 + (loop for p in *pathnames* + unless (or (typep p 'logical-pathname) + (eq p (translate-logical-pathname + p :allow-other-keys t))) + collect p) + nil) + +(deftest translate-logical-pathname.3 + (loop for p in *pathnames* + unless (or (typep p 'logical-pathname) + (eq p (translate-logical-pathname + p :allow-other-keys nil))) + collect p) + nil) + +(deftest translate-logical-pathname.4 + (loop for p in *pathnames* + unless (or (typep p 'logical-pathname) + (eq p (translate-logical-pathname + p :foo 1 :allow-other-keys t :bar 2))) + collect p) + nil) + + +;;; errors + +(deftest translate-logical-pathname.error.1 + (signals-error (translate-logical-pathname) program-error) + t) diff --git a/ansi-tests/translate-pathname.lsp b/ansi-tests/translate-pathname.lsp new file mode 100644 index 0000000..39726c4 --- /dev/null +++ b/ansi-tests/translate-pathname.lsp @@ -0,0 +1,50 @@ +;-*- Mode: Lisp -*- + +(in-package :cl-test) + +(deftest translate-pathname.1 (translate-pathname "foobar" "foobar" "foobar") #P"foobar") +(deftest translate-pathname.2 (translate-pathname "foobar" "foobar" "foo*") #P"foo") +(deftest translate-pathname.3 (translate-pathname "foobar" "foobar" "*") #P"foobar") +(deftest translate-pathname.4 (translate-pathname "foobar" "foobar" "") #P"foobar") + +(deftest translate-pathname.5 (translate-pathname "foobar" "foo*r" "foobar") #P"foobar") +(deftest translate-pathname.6 (translate-pathname "foobar" "foo*r" "foo*") #P"fooba") +(deftest translate-pathname.7 (translate-pathname "foobar" "foo*r" "*") #P"foobar") +(deftest translate-pathname.8 (translate-pathname "foobar" "foo*r" "") #P"foobar") + +(deftest translate-pathname.9 (translate-pathname "foobar" "*" "foobar") #P"foobar") +(deftest translate-pathname.10 (translate-pathname "foobar" "*" "foo*") #P"foofoobar") +(deftest translate-pathname.11 (translate-pathname "foobar" "*" "*") #P"foobar") +(deftest translate-pathname.12 (translate-pathname "foobar" "*" "") #P"foobar") + +(deftest translate-pathname.13 (translate-pathname "foobar" "" "foobar") #P"foobar") +(deftest translate-pathname.14 (translate-pathname "foobar" "" "foo*") #P"foofoobar") +(deftest translate-pathname.15 (translate-pathname "foobar" "" "*") #P"foobar") +(deftest translate-pathname.16 (translate-pathname "foobar" "" "") #P"foobar") + +(deftest translate-pathname.17 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") +(deftest translate-pathname.18 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") +(deftest translate-pathname.19 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/*/c/d/") #P"/a/c/d/") +(deftest translate-pathname.20 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/**/d/") #P"/a/d/") + +(deftest translate-pathname.21 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") +(deftest translate-pathname.22 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/q*c*/c/d/") #P"/a/qbcb/c/d/") +(deftest translate-pathname.23 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/*/c/d/") #P"/a/bbfb/c/d/") +(deftest translate-pathname.24 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/**/d/") #P"/a/bbfb/d/") + +(deftest translate-pathname.25 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") +(deftest translate-pathname.26 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") +(deftest translate-pathname.27 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/*/d/") #P"/a/bbfb/d/") +(deftest translate-pathname.28 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/**/d/") #P"/a/bbfb/c/d/") + +(deftest translate-pathname.29 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/qc/c/d/") #P"a/qc/c/d/") +(deftest translate-pathname.30 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/q*c*/c/d/") #P"a/qc/c/d/") +(deftest translate-pathname.31 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/*/d/") #P"a/bbfb/d/") +(deftest translate-pathname.32 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/**/d/") #P"a/bbfb/c/d/") + +(deftest translate-pathname.33 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "a") #P"/a/bbfb/c/d/a") +(deftest translate-pathname.34 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "a") #P"/a/bbfb/c/d/a") +(deftest translate-pathname.35 (translate-pathname "/a/bbfb/c/d/" "/a/*/c/d/" "a") #P"/a/bbfb/c/d/a") +(deftest translate-pathname.36 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a") #P"/a/bbfb/c/d/a") + + diff --git a/ansi-tests/truename.lsp b/ansi-tests/truename.lsp new file mode 100644 index 0000000..6bb8a2f --- /dev/null +++ b/ansi-tests/truename.lsp @@ -0,0 +1,108 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 6 05:32:37 2004 +;;;; Contains: Tests of TRUENAME + +(in-package :cl-test) + +(deftest truename.1 + (let* ((pn #p"truename.lsp") + (tn (truename pn))) + (values + (notnot (pathnamep pn)) + (typep pn 'logical-pathname) + (equalt (pathname-name pn) (pathname-name tn)) + (equalt (pathname-type pn) (pathname-type tn)) + )) + t nil t t) + +(deftest truename.2 + (let* ((name "truename.lsp") + (pn (pathname name)) + (tn (truename name))) + (values + (notnot (pathnamep pn)) + (typep pn 'logical-pathname) + (equalt (pathname-name pn) (pathname-name tn)) + (equalt (pathname-type pn) (pathname-type tn)) + )) + t nil t t) + +(deftest truename.3 + (let* ((pn #p"truename.lsp")) + (with-open-file + (s pn :direction :input) + (let ((tn (truename s))) + (values + (notnot (pathnamep pn)) + (typep pn 'logical-pathname) + (equalt (pathname-name pn) (pathname-name tn)) + (equalt (pathname-type pn) (pathname-type tn)) + )))) + t nil t t) + +(deftest truename.4 + (let* ((pn #p"truename.lsp")) + (let ((s (open pn :direction :input))) + (close s) + (let ((tn (truename s))) + (values + (notnot (pathnamep pn)) + (typep pn 'logical-pathname) + (equalt (pathname-name pn) (pathname-name tn)) + (equalt (pathname-type pn) (pathname-type tn)) + )))) + t nil t t) + +(deftest truename.5 + (let* ((lpn "CLTEST:foo.txt") + (pn (translate-logical-pathname lpn))) + (unless (probe-file lpn) + (with-open-file (s lpn :direction :output) (format s "Stuff~%"))) + (let ((tn (truename lpn))) + (values + (notnot (pathnamep pn)) + (if (equalt (pathname-name pn) (pathname-name tn)) + t (list (pathname-name pn) (pathname-name tn))) + (if (equalt (pathname-type pn) (pathname-type tn)) + t (list (pathname-type pn) (pathname-type tn))) + ))) + t t t) + +;;; Specialized string tests + +(deftest truename.6 + (do-special-strings + (s "truename.lsp" nil) + (assert (equalp (truename s) (truename "truename.lsp")))) + nil) + +;;; Error tests + +(deftest truename.error.1 + (signals-error (truename) program-error) + t) + +(deftest truename.error.2 + (signals-error (truename "truename.lsp" nil) program-error) + t) + +(deftest truename.error.3 + (signals-error-always (truename "nonexistent") file-error) + t t) + +(deftest truename.error.4 + (signals-error-always (truename #p"nonexistent") file-error) + t t) + +(deftest truename.error.5 + (signals-error-always (truename (logical-pathname "CLTESTROOT:NONEXISTENT")) file-error) + t t) + +(deftest truename.error.6 + (signals-error-always + (let ((pn (make-pathname :name :wild + :defaults *default-pathname-defaults*))) + (truename pn)) + file-error) + t t) diff --git a/ansi-tests/two-way-stream-input-stream.lsp b/ansi-tests/two-way-stream-input-stream.lsp new file mode 100644 index 0000000..1d96e01 --- /dev/null +++ b/ansi-tests/two-way-stream-input-stream.lsp @@ -0,0 +1,26 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Feb 12 04:22:50 2004 +;;;; Contains: Tests of TWO-WAY-STREAM-INPUT-STREAM + +(in-package :cl-test) + +(deftest two-way-stream-input-stream.1 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (equalt (multiple-value-list (two-way-stream-input-stream s)) + (list is))) + t) + +(deftest two-way-stream-input-stream.error.1 + (signals-error (two-way-stream-input-stream) program-error) + t) + +(deftest two-way-stream-input-stream.error.2 + (signals-error (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (two-way-stream-input-stream s nil)) + program-error) + t) diff --git a/ansi-tests/two-way-stream-output-stream.lsp b/ansi-tests/two-way-stream-output-stream.lsp new file mode 100644 index 0000000..a8415e0 --- /dev/null +++ b/ansi-tests/two-way-stream-output-stream.lsp @@ -0,0 +1,26 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Feb 12 04:25:59 2004 +;;;; Contains: Tests off TWO-WAY-STREAM-OUTPUT-STREAM + +(in-package :cl-test) + +(deftest two-way-stream-output-stream.1 + (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (equalt (multiple-value-list (two-way-stream-output-stream s)) + (list os))) + t) + +(deftest two-way-stream-output-stream.error.1 + (signals-error (two-way-stream-output-stream) program-error) + t) + +(deftest two-way-stream-output-stream.error.2 + (signals-error (let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-two-way-stream is os))) + (two-way-stream-output-stream s nil)) + program-error) + t) diff --git a/ansi-tests/typecase.lsp b/ansi-tests/typecase.lsp new file mode 100644 index 0000000..2c83a42 --- /dev/null +++ b/ansi-tests/typecase.lsp @@ -0,0 +1,72 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 22:51:25 2002 +;;;; Contains: Tests for TYPECASE + +(in-package :cl-test) + +(deftest typecase.1 + (typecase 1 (integer 'a) (t 'b)) + a) + +(deftest typecase.2 + (typecase 1 (symbol 'a)) + nil) + +(deftest typecase.3 + (typecase 1 (symbol 'a) (t 'b)) + b) + +(deftest typecase.4 + (typecase 1 (t (values)))) + +(deftest typecase.5 + (typecase 1 (integer (values)) (t 'a))) + +(deftest typecase.6 + (typecase 1 (bit 'a) (integer 'b)) + a) + +(deftest typecase.7 + (typecase 1 (otherwise 'a)) + a) + +(deftest typecase.8 + (typecase 1 (t (values 'a 'b 'c))) + a b c) + +(deftest typecase.9 + (typecase 1 (integer (values 'a 'b 'c)) (t nil)) + a b c) + +(deftest typecase.10 + (let ((x 0)) + (values + (typecase 1 + (bit (incf x) 'a) + (integer (incf x 2) 'b) + (t (incf x 4) 'c)) + x)) + a 1) + +(deftest typecase.11 + (typecase 1 (otherwise 'a)) + a) + +(deftest typecase.12 + (typecase 1 (integer) (t 'a)) + nil) + +(deftest typecase.13 + (typecase 1 (symbol 'a) (t)) + nil) + +(deftest typecase.14 + (typecase 1 (symbol 'a) (otherwise)) + nil) + +(deftest typecase.15 + (typecase 'a + (number 'bad) + (#.(find-class 'symbol nil) 'good)) + good) diff --git a/ansi-tests/types-and-class-2.lsp b/ansi-tests/types-and-class-2.lsp new file mode 100644 index 0000000..9a30250 --- /dev/null +++ b/ansi-tests/types-and-class-2.lsp @@ -0,0 +1,197 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Feb 5 21:20:05 2003 +;;;; Contains: More tests of types and classes + +(in-package :cl-test) + +;;; Union of a type with its complement is universal + +(deftest type-or-not-type-is-everything + (loop for l in *disjoint-types-list2* + append + (loop + for type in l + append (check-subtypep t `(or ,type (not ,type)) t) + append (check-subtypep t `(or (not ,type) ,type) t))) + nil) + +(defclass tac-1-class () (a b c)) +(defclass tac-1a-class (tac-1-class) (d e)) +(defclass tac-1b-class (tac-1-class) (f g)) + +(deftest user-class-disjointness + (loop for l in *disjoint-types-list2* + append + (loop + for type in l + append (classes-are-disjoint type 'tac-1-class))) + nil) + +(deftest user-class-disjointness-2 + (check-disjointness 'tac-1a-class 'tac-1b-class) + nil) + +(defstruct tac-2-struct a b c) +(defstruct (tac-2a-struct (:include tac-2-struct)) d e) +(defstruct (tac-2b-struct (:include tac-2-struct)) f g) + +(deftest user-struct-disjointness + (loop for l in *disjoint-types-list2* + append + (loop + for type in l + append (check-disjointness type 'tac-2-struct))) + nil) + +(deftest user-struct-disjointness-2 + (check-disjointness 'tac-2a-struct 'tac-2b-struct) + nil) + +(defclass tac-3-a () (x)) +(defclass tac-3-b () (y)) +(defclass tac-3-c () (z)) + +(defclass tac-3-ab (tac-3-a tac-3-b) ()) +(defclass tac-3-ac (tac-3-a tac-3-c) ()) +(defclass tac-3-bc (tac-3-b tac-3-c) ()) + +(defclass tac-3-abc (tac-3-ab tac-3-ac tac-3-bc) ()) + +(deftest tac-3.1 + (subtypep* 'tac-3-ab 'tac-3-a) + t t) + +(deftest tac-3.2 + (subtypep* 'tac-3-ab 'tac-3-b) + t t) + +(deftest tac-3.3 + (subtypep* 'tac-3-ab 'tac-3-c) + nil t) + +(deftest tac-3.4 + (subtypep* 'tac-3-a 'tac-3-ab) + nil t) + +(deftest tac-3.5 + (subtypep* 'tac-3-b 'tac-3-ab) + nil t) + +(deftest tac-3.6 + (subtypep* 'tac-3-c 'tac-3-ab) + nil t) + +(deftest tac-3.7 + (subtypep* 'tac-3-abc 'tac-3-a) + t t) + +(deftest tac-3.8 + (subtypep* 'tac-3-abc 'tac-3-b) + t t) + +(deftest tac-3.9 + (subtypep* 'tac-3-abc 'tac-3-c) + t t) + +(deftest tac-3.10 + (subtypep* 'tac-3-abc 'tac-3-ab) + t t) + +(deftest tac-3.11 + (subtypep* 'tac-3-abc 'tac-3-ac) + t t) + +(deftest tac-3.12 + (subtypep* 'tac-3-abc 'tac-3-bc) + t t) + +(deftest tac-3.13 + (subtypep* 'tac-3-ab 'tac-3-abc) + nil t) + +(deftest tac-3.14 + (subtypep* 'tac-3-ac 'tac-3-abc) + nil t) + +(deftest tac-3.15 + (subtypep* 'tac-3-bc 'tac-3-abc) + nil t) + +(deftest tac-3.16 + (check-equivalence '(and tac-3-a tac-3-b) 'tac-3-ab) + nil) + +(deftest tac-3.17 + (check-equivalence '(and (or tac-3-a tac-3-b) + (or (not tac-3-a) (not tac-3-b)) + (or tac-3-a tac-3-c) + (or (not tac-3-a) (not tac-3-c)) + (or tac-3-b tac-3-c) + (or (not tac-3-b) (not tac-3-c))) + nil) + nil) + +;;; +;;; Check that disjointness of types in *disjoint-types-list* +;;; is respected by all the elements of *universe* +;;; +(deftest universe-elements-in-at-most-one-disjoint-type + (loop for e in *universe* + for types = (remove-if-not #'(lambda (x) (typep e x)) + *disjoint-types-list*) + when (> (length types) 1) + collect (list e types)) + nil) + + + +;;;;; + +(deftest integer-and-ratio-are-disjoint + (classes-are-disjoint 'integer 'ratio) + nil) + +(deftest bignum-and-ratio-are-disjoint + (classes-are-disjoint 'bignum 'ratio) + nil) + +(deftest bignum-and-fixnum-are-disjoint + (classes-are-disjoint 'bignum 'fixnum) + nil) + +(deftest fixnum-and-ratio-are-disjoint + (classes-are-disjoint 'fixnum 'ratio) + nil) + +(deftest byte8-and-ratio-are-disjoint + (classes-are-disjoint '(unsigned-byte 8) 'ratio) + nil) + +(deftest bit-and-ratio-are-disjoint + (classes-are-disjoint 'bit 'ratio) + nil) + +(deftest integer-and-float-are-disjoint + (classes-are-disjoint 'integer 'float) + nil) + +(deftest ratio-and-float-are-disjoint + (classes-are-disjoint 'ratio 'float) + nil) + +(deftest complex-and-float-are-disjoint + (classes-are-disjoint 'complex 'float) + nil) + +(deftest integer-subranges-are-disjoint + (classes-are-disjoint '(integer 0 (10)) '(integer 10 (20))) + nil) + +(deftest keyword-and-null-are-disjoint + (classes-are-disjoint 'keyword 'null) + nil) + +(deftest keyword-and-boolean-are-disjoint + (classes-are-disjoint 'keyword 'boolean) + nil) diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp new file mode 100644 index 0000000..1b1bd45 --- /dev/null +++ b/ansi-tests/types-and-class.lsp @@ -0,0 +1,422 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Mar 19 21:48:39 1998 +;;;; Contains: Data for testing type and class inclusions + +;; We should check for every type that NIL is a subtype, and T a supertype + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +(deftest boolean-type.1 + (notnot-mv (typep nil 'boolean)) + t) + +(deftest boolean-type.2 + (notnot-mv (typep t 'boolean)) + t) + +(deftest boolean-type.3 + (check-type-predicate 'is-t-or-nil 'boolean) + 0) + +;; Two type inclusions on booleans +;; have been conditionalized to prevent +;; some tests from doing too badly on CMU CL on x86 +;; These should get removed when I get a more up to date +;; image for that platform -- pfd + + + +(deftest types.3 + (loop + for (t1 t2) in *subtype-table* + for m1 = (check-subtypep t1 t2 t t) + for m2 = (check-subtypep `(and ,t1 ,t2) t1 t) + for m3 = (check-subtypep `(and ,t2 ,t1) t1 t) + for m4 = (check-subtypep `(and ,t1 (not ,t2)) nil t) + for m5 = (check-subtypep `(and (not ,t2) ,t1) nil t) + when m1 collect m1 + when m2 collect m2 + when m3 collect m3 + when m4 collect m4 + when m5 collect m5) + nil) + +(declaim (special +float-types+ *subtype-table*)) + +;;; This next test is all screwed up. Basically, it assumes +;;; incorrectly that certain subtype relationships that are +;;; not specified in the spec cannot occur. +#| +(defun types.4-body () + (let ((parent-table (make-hash-table :test #'equal)) + (types nil)) + (loop + for p in *subtype-table* do + (let ((tp (first p)) + (parent (second p))) + (pushnew tp types) + (pushnew parent types) + (let ((parents (gethash tp parent-table))) + (pushnew parent parents) + ;; (format t "~S ==> ~S~%" tp parent) + (loop + for pp in (gethash parent parent-table) do + ;; (format t "~S ==> ~S~%" tp pp) + (pushnew pp parents)) + (setf (gethash tp parent-table) parents)))) + ;; parent-table now contains lists of ancestors + (loop + for tp in types sum + (let ((parents (gethash tp parent-table))) + (loop + for tp2 in types sum + (cond + ((and (not (eqt tp tp2)) + (not (eqt tp2 'standard-object)) + (not (eqt tp2 'structure-object)) + (not (member tp2 parents)) + (subtypep* tp tp2) + (not (and (member tp +float-types+) + (member tp2 +float-types+))) + (not (and (eqt tp2 'structure-object) + (member 'standard-object parents)))) + (format t "~%Improper subtype: ~S of ~S" + tp tp2) + 1) + (t 0))))) + )) + +(deftest types.4 + (types.4-body) + 0) +|# + +(deftest types.6 + (types.6-body) + nil) + +(declaim (special *disjoint-types-list*)) + +;;; Check that the disjoint types really are disjoint + +(deftest types.7b + (loop for e on *disjoint-types-list* + for tp1 = (first e) + append + (loop for tp2 in (rest e) + append (classes-are-disjoint tp1 tp2))) + nil) + +(deftest types.7c + (loop for e on *disjoint-types-list2* + for list1 = (first e) + append + (loop for tp1 in list1 append + (loop for list2 in (rest e) + append + (loop for tp2 in list2 append + (classes-are-disjoint tp1 tp2))))) + nil) + +(deftest types.8 + (loop + for tp in *disjoint-types-list* count + (cond + ((and (not (eqt tp 'cons)) + (not (subtypep* tp 'atom))) + (format t "~%Should be atomic, but isn't: ~S" tp) + t))) + 0) + +(declaim (special *type-list* *supertype-table*)) + +;;; +;;; TYPES.9 checks the transitivity of SUBTYPEP on pairs of types +;;; occuring in *SUBTYPE-TABLE*, as well as the types KEYWORD, ATOM, +;;; and LIST (the relationships given in *SUBTYPE-TABLE* are not used +;;; here.) +;;; + +(deftest types.9 + (types.9-body) + nil) + +;;; +;;; TYPES.9A takes the supertype relationship computed by test TYPE.9 +;;; and checks that TYPEP respects it for all elements of *UNIVERSE*. +;;; That is, if T1 and T2 are two types, and X is an element of *UNIVERSE*, +;;; then if (SUBTYPEP T1) then (TYPEP X T1) implies (TYPEP X T2). +;;; +;;; The function prints error messages when this fails, and returns the +;;; number of occurences of failure. +;;; +;;; Test TYPES.9 must be run before this test. +;;; + +(deftest types.9a + (types.9a-body) + 0) + + +;;; All class names in CL denote classes that are subtypep +;;; equivalent to themselves +(deftest all-classes-are-type-equivalent-to-their-names + (loop for sym being the external-symbols of "COMMON-LISP" + for class = (find-class sym nil) + when class + append (check-equivalence sym class)) + nil) + +;;; Check that all class names in CL that name standard-classes or +;;; structure-classes are subtypes of standard-object and structure-object, +;;; respectively + +(deftest all-standard-classes-are-subtypes-of-standard-object + (loop for sym being the external-symbols of "COMMON-LISP" + for class = (find-class sym nil) + when (and class + (typep class 'standard-class) + (or (not (subtypep sym 'standard-object)) + (not (subtypep class 'standard-object)))) + collect sym) + nil) + +(deftest all-structure-classes-are-subtypes-of-structure-object + (loop for sym being the external-symbols of "COMMON-LISP" + for class = (find-class sym nil) + when (and class + (typep class 'structure-class) + (or (not (subtypep sym 'structure-object)) + (not (subtypep class 'structure-object)))) + collect sym) + nil) + +;;; Confirm that only the symbols exported from CL that are supposed +;;; to be types are actually classes (see section 11.1.2.1.1) + +(deftest all-exported-cl-class-names-are-valid + (loop for sym being the external-symbols of "COMMON-LISP" + when (and (find-class sym nil) + (not (member sym *cl-all-type-symbols* :test #'eq))) + collect sym) + nil) + +;;; Confirm that all standard generic functions are instances of +;;; the class standard-generic-function. + +(deftest all-standard-generic-functions-are-instances-of-that-class + (loop for sym in *cl-standard-generic-function-symbols* + for fun = (and (fboundp sym) (symbol-function sym)) + unless (and (typep fun 'generic-function) + (typep fun 'standard-generic-function)) + collect (list sym fun)) + nil) + +;;; Canonical metaobjects are in the right classes + +(deftest structure-object-is-in-structure-class + (notnot-mv (typep (find-class 'structure-object) 'structure-class)) + t) + +(deftest standard-object-is-in-standard-class + (notnot-mv (typep (find-class 'standard-object) 'standard-class)) + t) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; deftype + +(deftype even-array (&optional type size) + `(and (array ,type ,size) + (satisfies even-size-p))) + +(deftest deftype.1 + (typep 1 '(even-array integer (10))) + nil) + +(deftest deftype.2 + (typep nil '(even-array t (*))) + nil) + +(deftest deftype.3 + (notnot-mv (typep (make-array '(10)) '(even-array t (*)))) + t) + +(deftest deftype.4 + (typep (make-array '(5)) '(even-array t (*))) + nil) + +(deftest deftype.5 + (notnot-mv (typep (make-string 10) '(even-array character (*)))) + t) + +(deftest deftype.6 + (notnot-mv + (typep (make-array '(3 5 6) :element-type '(unsigned-byte 8)) + '(even-array (unsigned-byte 8)))) + t) + +;; This should be greatly expanded + +(defparameter *type-and-class-fns* + '(coerce subtypep type-of typep type-error-datum type-error-expected-type)) + +(deftest type-and-class-fns + (remove-if #'fboundp *type-and-class-fns*) + nil) + +(deftest type-and-class-macros + (notnot-mv (macro-function 'deftype)) + t) + +(deftest typep-nil-null + (notnot-mv (typep nil 'null)) + t) + +(deftest typep-t-null + (typep t 'null) + nil) + + +;;; Error checking of type-related functions + +(deftest type-of.error.1 + (classify-error (type-of)) + program-error) + +(deftest type-of.error.2 + (classify-error (type-of nil nil)) + program-error) + +(deftest typep.error.1 + (classify-error (typep)) + program-error) + +(deftest typep.error.2 + (classify-error (typep nil)) + program-error) + +(deftest typep.error.3 + (classify-error (typep nil t nil nil)) + program-error) + +(deftest type-error-datum.error.1 + (classify-error (type-error-datum)) + program-error) + +(deftest type-error-datum.error.2 + (classify-error + (let ((c (make-condition 'type-error :datum nil + :expected-type t))) + (type-error-datum c nil))) + program-error) + +(deftest type-error-expected-type.error.1 + (classify-error (type-error-expected-type)) + program-error) + +(deftest type-error-expected-type.error.2 + (classify-error + (let ((c (make-condition 'type-error :datum nil + :expected-type t))) + (type-error-expected-type c nil))) + program-error) + +;;; Tests of env arguments to typep + +(deftest typep.env.1 + (notnot-mv (typep 0 'bit nil)) + t) + +(deftest typep.env.2 + (macrolet ((%foo (&environment env) + (notnot-mv (typep 0 'bit env)))) + (%foo)) + t) + +(deftest typep.env.3 + (macrolet ((%foo (&environment env) + (notnot-mv (typep env (type-of env))))) + (%foo)) + t) + +;;; Other typep tests + +(deftest typep.1 + (notnot-mv (typep 'a '(eql a))) + t) + +(deftest typep.2 + (notnot-mv (typep 'a '(and (eql a)))) + t) + +(deftest typep.3 + (notnot-mv (typep 'a '(or (eql a)))) + t) + +(deftest typep.4 + (typep 'a '(eql b)) + nil) + +(deftest typep.5 + (typep 'a '(and (eql b))) + nil) + +(deftest typep.6 + (typep 'a '(or (eql b))) + nil) + +(deftest typep.7 + (notnot-mv (typep 'a '(satisfies symbolp))) + t) + +(deftest typep.8 + (typep 10 '(satisfies symbolp)) + nil) + +(deftest typep.9 + (let ((class (find-class 'symbol))) + (notnot-mv (typep 'a class))) + t) + +(deftest typep.10 + (let ((class (find-class 'symbol))) + (notnot-mv (typep 'a `(and ,class)))) + t) + +(deftest typep.11 + (let ((class (find-class 'symbol))) + (typep 10 class)) + nil) + +(deftest typep.12 + (let ((class (find-class 'symbol))) + (typep 10 `(and ,class))) + nil) + +(deftest typep.13 + (typep 'a '(and symbol integer)) + nil) + +(deftest typep.14 + (notnot-mv (typep 'a '(or symbol integer))) + t) + +(deftest typep.15 + (notnot-mv (typep 'a '(or integer symbol))) + t) + +(deftest typep.16 + (let ((c1 (find-class 'number)) + (c2 (find-class 'symbol))) + (notnot-mv (typep 'a `(or ,c1 ,c2)))) + t) + +(deftest typep.17 + (let ((c1 (find-class 'number)) + (c2 (find-class 'symbol))) + (notnot-mv (typep 'a `(or ,c2 ,c1)))) + t) diff --git a/ansi-tests/universe.lsp b/ansi-tests/universe.lsp new file mode 100644 index 0000000..de3cb5b --- /dev/null +++ b/ansi-tests/universe.lsp @@ -0,0 +1,432 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Apr 9 19:32:56 1998 +;;;; Contains: A global variable containing a list of +;;;; as many kinds of CL objects as we can think of +;;;; This list is used to test many other CL functions + +(in-package :cl-test) + +(defvar *condition-types* + '(arithmetic-error + cell-error + condition + control-error + division-by-zero + end-of-file + error + file-error + floating-point-inexact + floating-point-invalid-operation + floating-point-underflow + floating-point-overflow + package-error + parse-error + print-not-readable + program-error + reader-error + serious-condition + simple-condition + simple-error + simple-type-error + simple-warning + storage-condition + stream-error + style-warning + type-error + unbound-slot + unbound-variable + undefined-function + warning)) + +(defvar *condition-objects* + (loop for tp in *condition-types* append + (handler-case (list (make-condition tp)) + (error () nil)))) + +(defvar *standard-package-names* + '("COMMON-LISP" "COMMON-LISP-USER" "KEYWORD")) + +(defvar *package-objects* + (loop for pname in *standard-package-names* append + (handler-case (let ((pkg (find-package pname))) + (and pkg (list pkg))) + (error () nil)))) + +(defvar *integers* + (remove-duplicates + `( + 0 + ;; Integers near the fixnum/bignum boundaries + ,@(loop for i from -5 to 5 collect (+ i most-positive-fixnum)) + ,@(loop for i from -5 to 5 collect (+ i most-negative-fixnum)) + ;; Powers of two, negatives, and off by one. + ,@(loop for i from 1 to 64 collect (ash 1 i)) + ,@(loop for i from 1 to 64 collect (1- (ash 1 i))) + ,@(loop for i from 1 to 64 collect (ash -1 i)) + ,@(loop for i from 1 to 64 collect (1+ (ash -1 i))) + ;; A big integer + ,(expt 17 50) + ;; Some arbitrarily chosen integers + 12387131 1272314 231 -131 -561823 23713 -1234611312123 444121 991))) + +(defvar *floats* + (append + (loop for sym in '(pi + most-positive-short-float + least-positive-short-float + least-positive-normalized-short-float + most-positive-double-float + least-positive-double-float + least-positive-normalized-double-float + most-positive-long-float + least-positive-long-float + least-positive-normalized-long-float + most-positive-single-float + least-positive-single-float + least-positive-normalized-single-float + most-negative-short-float + least-negative-short-float + least-negative-normalized-short-float + most-negative-single-float + least-negative-single-float + least-negative-normalized-single-float + most-negative-double-float + least-negative-double-float + least-negative-normalized-double-float + most-negative-long-float + least-negative-long-float + least-negative-normalized-long-float + short-float-epsilon + short-float-negative-epsilon + single-float-epsilon + single-float-negative-epsilon + double-float-epsilon + double-float-negative-epsilon + long-float-epsilon + long-float-negative-epsilon) + when (boundp sym) collect (symbol-value sym)) + (list + 0.0 1.0 -1.0 313123.13 283143.231 -314781.9 + 1.31283d2 834.13812D-45 + 8131238.1E14 -4618926.231e-2 + -37818.131F3 81.318231f-19 + 1.31273s3 12361.12S-7 + 6124.124l0 13123.1L-23))) + +(defvar *ratios* + '(1/3 1/1000 1/1000000000000000 -10/3 -1000/7 -987129387912381/13612986912361 + 189729874978126783786123/1234678123487612347896123467851234671234)) + +(defvar *complexes* + '(#C(0.0 0.0) + #C(1.0 0.0) + #C(0.0 1.0) + #C(1.0 1.0) + #C(-1.0 -1.0) + #C(1289713.12312 -9.12681271) + #C(1.0D100 1.0D100) + #C(-1.0D-100 -1.0D-100))) + +(defvar *numbers* + (append *integers* + *floats* + *ratios* + *complexes*)) + +(defun try-to-read-chars (&rest namelist) + (loop + for name in namelist append + (handler-case + (list (read-from-string + (concatenate 'string "\#\\" name))) + (error () nil)))) + +(defvar *characters* + (remove-duplicates + `(#\Newline + #\Space + ,@(try-to-read-chars "Rubout" + "Page" + "Tab" + "Backspace" + "Return" + "Linefeed" + "Null") + #\a #\A #\0 #\9 #\. #\( #\) #\[ #\] + ))) + + +(defvar *strings* + (append + (and (code-char 0) + (list + (make-string 1 :initial-element (code-char 0)) + (make-string 10 :initial-element (code-char 0)))) + (list + "" "A" "a" "0" "abcdef" + "~!@#$%^&*()_+`1234567890-=<,>.?/:;\"'{[}]|\\ abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWYXZ" + (make-string 100000 :initial-element #\g) + (let ((s (make-string 256))) + (loop + for i from 0 to 255 + do (let ((c (code-char i))) + (when c + (setf (elt s i) c)))) + s) + ))) + +(defvar *conses* + (list + (list 'a 'b) + (list nil) + (list 1 2 3 4 5 6))) + +(defvar *circular-conses* + (list + (let ((s (copy-list '(a b c d)))) + (nconc s s) + s) + (let ((s (list nil))) + (setf (car s) s) + s) + (let ((s (list nil))) + (setf (car s) s) + (setf (cdr s) s)))) + +(defvar *booleans* '(nil t)) +(defvar *keywords* '(:a :b :|| :|a| :|1234|)) +(defvar *uninterned-symbols* + (list '#:nil '#:t '#:foo '#:||)) +(defvar *cl-test-symbols* + `(,(intern "a" :cl-test) + ,(intern "" :cl-test) + ,@(and (code-char 0) + (list (intern (make-string 1 :initial-element (code-char 0)) :cl-test))) + ,@(and (code-char 0) + (let* ((s (make-string 10 :initial-element (code-char 0))) + (s2 (copy-seq s)) + (s3 (copy-seq s))) + (setf (subseq s 3 4) "a") + (setf (subseq s2 4 5) "a") + (setf (subseq s3 4 5) "a") + (setf (subseq s3 7 8) "b") + (list (intern s :cl-test) + (intern s2 :cl-test) + (intern s3 :cl-test)))) + )) + +(defvar *cl-user-symbols* + '(cl-user::foo cl-user::x + cl-user::cons cl-user::lambda + cl-user::*print-readably* cl-user::push)) + +(defvar *symbols* + (append *booleans* *keywords* *uninterned-symbols* + *cl-test-symbols* + *cl-user-symbols*)) + +(defvar *array-dimensions* + (loop + for i from 0 to 8 collect + (loop for j from 1 to i collect 2))) + +(defvar *default-array-target* (make-array '(300))) + +(defvar *arrays* + (append + (list (make-array '10)) + (mapcar #'make-array *array-dimensions*) + + ;; typed arrays + (loop for tp in '(fixnum float bit character base-char + (signed-byte 8) (unsigned-byte 8)) + append + (loop + for d in *array-dimensions* + collect (make-array d :element-type tp))) + + ;; adjustable arrays + (loop + for d in *array-dimensions* + collect (make-array d :adjustable t)) + + ;; Displaced arrays + (loop + for d in *array-dimensions* + for i from 1 + collect (make-array d :displaced-to *default-array-target* + :displaced-index-offset i)) + + (list + #() + #* + #*00000 + #*1010101010101101) + + ;; Integer arrays + (list + (make-array '(10) :element-type '(integer 0 (256)) + :initial-contents '(8 9 10 11 12 1 2 3 4 5)) + (make-array '(10) :element-type '(integer -128 (128)) + :initial-contents '(8 9 -10 11 -12 1 -2 -3 4 5)) + (make-array '(6) :element-type '(integer 0 (#.(ash 1 16))) + :initial-contents '(5 9 100 1312 23432 87)) + (make-array '(4) :element-type '(integer 0 (#.(ash 1 28))) + :initial-contents '(100000 231213 8123712 19)) + (make-array '(4) :element-type '(integer 0 (#.(ash 1 32))) + :initial-contents '(#.(1- (ash 1 32)) 0 872312 10000000)) + + (make-array nil :element-type '(integer 0 (256)) + :initial-element 14) + (make-array '(2 2) :element-type '(integer 0 (256)) + :initial-contents '((34 98)(14 119))) + ) + + ;; Float arrays + (list + (make-array '(5) :element-type 'short-float + :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)) + (make-array '(5) :element-type 'single-float + :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)) + (make-array '(5) :element-type 'double-float + :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) + (make-array '(5) :element-type 'long-float + :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)) + ) + + ;; more kinds of arrays here later + )) + +(defvar *hash-tables* + (list + (make-hash-table) + (make-hash-table :test #'eq) + (make-hash-table :test #'eql) + (make-hash-table :test #'equal) + #-(or GCL CMU ECL) (make-hash-table :test #'equalp) + )) + +(defparameter *pathnames* + (locally + (declare (optimize safety)) + (loop for form in '((make-pathname :name "foo") + (make-pathname :name "FOO" :case :common) + (make-pathname :name "bar") + (make-pathname :name "foo" :type "txt") + (make-pathname :name "bar" :type "txt") + (make-pathname :name "XYZ" :type "TXT" :case :common) + (make-pathname :name nil) + (make-pathname :name :wild) + (make-pathname :name nil :type "txt") + (make-pathname :name :wild :type "txt") + (make-pathname :name :wild :type "TXT" :case :common) + (make-pathname :name :wild :type "abc" :case :common) + (make-pathname :directory :wild) + (make-pathname :type :wild) + (make-pathname :version :wild) + (make-pathname :version :newest)) + append (ignore-errors (eval `(list ,form)))))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (locally + (declare (optimize safety)) + (ignore-errors + (setf (logical-pathname-translations "CLTESTROOT") + `(("**;*.*.*" ,(make-pathname :directory '(:absolute :wild-inferiors) + :name :wild :type :wild))))) + (ignore-errors + (setf (logical-pathname-translations "CLTEST") + `(("**;*.*.*" ,(make-pathname + :directory (append + (pathname-directory + (truename (make-pathname))) + '(:wild-inferiors)) + :name :wild :type :wild))))) + )) + +(defparameter *logical-pathnames* + (locally + (declare (optimize safety)) + (append + (ignore-errors (list (logical-pathname "CLTESTROOT:"))) + ))) + +(defvar *streams* + (remove-duplicates + (remove-if + #'null + (list + *debug-io* + *error-output* + *query-io* + *standard-input* + *standard-output* + *terminal-io* + *trace-output*)))) + +(defvar *readtables* + (list *readtable* + (copy-readtable))) + +(defstruct foo-structure + x y z) + +(defstruct bar-structure + x y z) + +(defvar *structures* + (list + (make-foo-structure :x 1 :y 'a :z nil) + (make-foo-structure :x 1 :y 'a :z nil) + (make-bar-structure :x 1 :y 'a :z nil) + )) + +(defvar *functions* + (list #'cons #'car #'append #'values + (macro-function 'cond) + #'(lambda (x) x))) + +(defvar *random-states* + (list (make-random-state))) + +(defvar *universe* + (remove-duplicates + (append + *symbols* + *numbers* + *characters* + (mapcar #'copy-seq *strings*) + *conses* + *condition-objects* + *package-objects* + *arrays* + *hash-tables* + *pathnames* + *streams* + *readtables* + *structures* + *functions* + *random-states* + nil))) + +(defvar *mini-universe* + (remove-duplicates + (mapcar #'first + (list *symbols* + *numbers* + *characters* + (mapcar #'copy-seq *strings*) + *conses* + *condition-objects* + *package-objects* + *arrays* + *hash-tables* + *pathnames* + *streams* + *readtables* + *structures* + *functions* + *random-states*)))) + + diff --git a/ansi-tests/unless.lsp b/ansi-tests/unless.lsp new file mode 100644 index 0000000..11a93a6 --- /dev/null +++ b/ansi-tests/unless.lsp @@ -0,0 +1,49 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 19:39:34 2002 +;;;; Contains: Tests of UNLESS + +(in-package :cl-test) + +(deftest unless.1 + (unless t) + nil) + +(deftest unless.2 + (unless nil) + nil) + +(deftest unless.3 + (unless 'b 'a) + nil) + +(deftest unless.4 + (unless nil 'a) + a) + +(deftest unless.5 (unless nil (values))) + +(deftest unless.6 + (unless nil (values 1 2 3 4)) + 1 2 3 4) + +(deftest unless.7 + (unless 1 (values)) + nil) + +(deftest unless.8 + (unless #() (values 1 2 3 4)) + nil) + +(deftest unless.9 + (let ((x 0)) + (values + (unless nil + (incf x) + 'a) + x)) + a 1) + +;;; (deftest unless.error.1 +;;; (classify-error (unless)) +;;; program-error) diff --git a/ansi-tests/unread-char.lsp b/ansi-tests/unread-char.lsp new file mode 100644 index 0000000..a98b828 --- /dev/null +++ b/ansi-tests/unread-char.lsp @@ -0,0 +1,92 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 20:05:36 2004 +;;;; Contains: Tests of UNREAD-CHAR + +(in-package :cl-test) + +(deftest unread-char.1 + (with-input-from-string + (*standard-input* "abc") + (values + (read-char) + (unread-char #\a) + (read-char) + (read-char) + (unread-char #\b) + (read-char) + (read-char))) + #\a nil #\a #\b nil #\b #\c) + +(deftest unread-char.2 + (with-input-from-string + (s "abc") + (values + (read-char s) + (unread-char #\a s) + (read-char s) + (read-char s) + (unread-char #\b s) + (read-char s) + (read-char s))) + #\a nil #\a #\b nil #\b #\c) + +(deftest unread-char.3 + (with-input-from-string + (is "abc") + (with-output-to-string + (os) + (let ((s (make-echo-stream is os))) + (read-char s) + (unread-char #\a s) + (read-char s) + (read-char s) + (read-char s) + (unread-char #\c s) + (read-char s)))) + "abc") + +(deftest unread-char.4 + (with-input-from-string + (*standard-input* "abc") + (values + (read-char) + (unread-char #\a nil) + (read-char) + (read-char) + (unread-char #\b nil) + (read-char) + (read-char))) + #\a nil #\a #\b nil #\b #\c) + +(deftest unread-char.5 + (with-input-from-string + (is "abc") + (let ((*terminal-io* (make-two-way-stream + is (make-string-output-stream)))) + (values + (read-char t) + (unread-char #\a t) + (read-char t) + (read-char t) + (unread-char #\b t) + (read-char t) + (read-char t)))) + #\a nil #\a #\b nil #\b #\c) + +;;; Error tests + +(deftest unread-char.error.1 + (signals-error (unread-char) program-error) + t) + +(deftest unread-char.error.2 + (signals-error + (with-input-from-string + (s "abc") + (read-char s) + (unread-char #\a s nil)) + program-error) + t) + + diff --git a/ansi-tests/unwind-protect.lsp b/ansi-tests/unwind-protect.lsp new file mode 100644 index 0000000..03d6fd3 --- /dev/null +++ b/ansi-tests/unwind-protect.lsp @@ -0,0 +1,90 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 14:41:16 2002 +;;;; Contains: Tests of UNWIND-PROTECT + +(in-package :cl-test) + +(deftest unwind-protect.1 + (let ((x nil)) + (unwind-protect + (push 1 x) + (incf (car x)))) + (2)) + +(deftest unwind-protect.2 + (let ((x nil)) + (block foo + (unwind-protect + (progn (push 1 x) (return-from foo x)) + (incf (car x))))) + (2)) + +(deftest unwind-protect.3 + (let ((x nil)) + (tagbody + (unwind-protect + (progn (push 1 x) (go done)) + (incf (car x))) + done) + x) + (2)) + +(deftest unwind-protect.4 + (let ((x nil)) + (catch 'done + (unwind-protect + (progn (push 1 x) (throw 'done x)) + (incf (car x))))) + (2)) + +(deftest unwind-protect.5 + (let ((x nil)) + (ignore-errors + (unwind-protect + (progn (push 1 x) (error "Boo!")) + (incf (car x)))) + x) + (2)) + +(deftest unwind-protect.6 + (let ((x nil)) + (block done + (flet ((%f () (return-from done nil))) + (unwind-protect (%f) + (push 'a x)))) + x) + (a)) + +(deftest unwind-protect.7 + (let ((x nil)) + (block done + (flet ((%f () (return-from done nil))) + (unwind-protect + (unwind-protect (%f) + (push 'b x)) + (push 'a x)))) + x) + (a b)) + +(deftest unwind-protect.8 + (let ((x nil)) + (block done + (unwind-protect + (flet ((%f () (return-from done nil))) + (unwind-protect + (unwind-protect (%f) + (push 'b x)) + (push 'a x))) + (push 'c x))) + x) + (c a b)) + +(deftest unwind-protect.9 + (let ((x nil)) + (handler-case + (flet ((%f () (error 'type-error :datum 'foo :expected-type nil))) + (unwind-protect (handler-case (%f)) + (push 'a x))) + (type-error () x))) + (a)) diff --git a/ansi-tests/upgraded-array-element-type.lsp b/ansi-tests/upgraded-array-element-type.lsp new file mode 100644 index 0000000..58eb51c --- /dev/null +++ b/ansi-tests/upgraded-array-element-type.lsp @@ -0,0 +1,108 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 22 20:43:55 2003 +;;;; Contains: Tests of UPGRADED-ARRAY-ELEMENT-TYPE + +(in-package :cl-test) + +(deftest upgraded-array-element-type.1 + (let ((upgraded-bit (upgraded-array-element-type 'bit))) + (and (empirical-subtypep 'bit upgraded-bit) + (empirical-subtypep upgraded-bit 'bit))) + t) + +(deftest upgraded-array-element-type.2 + (let ((upgraded-base-char (upgraded-array-element-type 'base-char))) + (and (empirical-subtypep 'base-char upgraded-base-char) + (empirical-subtypep upgraded-base-char 'base-char))) + t) + +(deftest upgraded-array-element-type.3 + (let ((upgraded-character (upgraded-array-element-type 'character))) + (and (empirical-subtypep 'character upgraded-character) + (empirical-subtypep upgraded-character 'character))) + t) + +(defparameter *upgraded-array-types-to-check* + `(boolean + base-char + character + t + ,@(loop for i from 0 to 32 + collect `(integer 0 (,(ash 1 i)))) + symbol + ,@(loop for i from 0 to 32 + collect `(integer ,(- (ash 1 i)) (,(ash 1 i)))) + (integer -10000000000000000000000000000000000 + 10000000000000000000000000000000000) + float + short-float + single-float + double-float + complex + rational + fixnum + function + sequence + list + cons + atom + symbol)) + +(deftest upgraded-array-element-type.4 + (loop for type in *upgraded-array-types-to-check* + for upgraded-type = (upgraded-array-element-type type) + always (empirical-subtypep type upgraded-type)) + t) + +;; Include an environment (NIL, denoting the default null lexical +;; environment) + +(deftest upgraded-array-element-type.5 + (loop for type in *upgraded-array-types-to-check* + for upgraded-type = (upgraded-array-element-type type nil) + always (empirical-subtypep type upgraded-type)) + t) + +(deftest upgraded-array-element-type.6 + (macrolet + ((%foo (&environment env) + (empirical-subtypep + 'bit + (upgraded-array-element-type 'bit env)))) + (%foo)) + t) + +(deftest upgraded-array-element-type.7 + (let ((upgraded-types (mapcar #'upgraded-array-element-type + *upgraded-array-types-to-check*))) + (loop for type in *upgraded-array-types-to-check* + for upgraded-type in upgraded-types + append + (loop for type2 in *upgraded-array-types-to-check* + for upgraded-type2 in upgraded-types + when (and (subtypep type type2) + (equal (subtypep* upgraded-type upgraded-type) + '(nil t))) + collect (list type type2)))) + nil) + +;;; Tests of upgrading NIL (it should be type equivalent to NIL) + +(deftest upgraded-array-element-type.nil.1 + (let ((uaet-nil (upgraded-array-element-type nil))) + (loop for e in *universe* + when (typep e uaet-nil) + collect e)) + nil) + + +;;; Error tests + +(deftest upgraded-array-element-type.error.1 + (classify-error (upgraded-array-element-type)) + program-error) + +(deftest upgraded-array-element-type.error.2 + (classify-error (upgraded-array-element-type 'bit nil nil)) + program-error) diff --git a/ansi-tests/values-list.lsp b/ansi-tests/values-list.lsp new file mode 100644 index 0000000..f48e924 --- /dev/null +++ b/ansi-tests/values-list.lsp @@ -0,0 +1,40 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 13 16:53:39 2003 +;;;; Contains: Tests for VALUES-LIST + +(in-package :cl-test) + +(deftest values-list.error.1 + (classify-error (values-list)) + program-error) + +(deftest values-list.error.2 + (classify-error (values-list nil nil)) + program-error) + +(deftest values-list.1 + (values-list nil)) + +(deftest values-list.2 + (values-list '(1)) + 1) + +(deftest values-list.3 + (values-list '(1 2)) + 1 2) + +(deftest values-list.4 + (values-list '(a b c d e f g h i j)) + a b c d e f g h i j) + +(deftest values-list.5 + (let ((x (loop for i from 1 to (min 1000 + (1- call-arguments-limit) + (1- multiple-values-limit)) + collect i))) + (equalt x + (multiple-value-list (values-list x)))) + t) + + diff --git a/ansi-tests/values.lsp b/ansi-tests/values.lsp new file mode 100644 index 0000000..32e4d99 --- /dev/null +++ b/ansi-tests/values.lsp @@ -0,0 +1,62 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 19 08:18:50 2002 +;;;; Contains: Tests of VALUES + +(in-package :cl-test) + +(deftest values.0 + (values)) + +(deftest values.1 + (values 1) + 1) + +(deftest values.2 + (values 1 2) + 1 2) + +(deftest values.3 + (values 1 2 3) + 1 2 3) + +(deftest values.4 + (values 1 2 3 4) + 1 2 3 4) + +(deftest values.10 + (values 1 2 3 4 5 6 7 8 9 10) + 1 2 3 4 5 6 7 8 9 10) + +(deftest values.15 + (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) + +(deftest values.19 + (values 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19) + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19) + +(deftest values.A + (values (values 1 2) (values 3 4 5) (values) (values 10)) + 1 3 nil 10) + +(deftest values.B + (funcall #'values 1 2 3 4) + 1 2 3 4) + +(deftest values.C + (let ((x (loop for i from 1 to (min 1000 + (1- call-arguments-limit) + (1- multiple-values-limit)) + collect i))) + (equalt x + (multiple-value-list (apply #'values x)))) + t) + +(deftest values.order.1 + (let ((i 0) a b c) + (values (multiple-value-list + (values (setf a (incf i)) (setf b (incf i)) (setf c (incf i)))) + i a b c)) + (1 2 3) 3 1 2 3) + diff --git a/ansi-tests/vector-pop.lsp b/ansi-tests/vector-pop.lsp new file mode 100644 index 0000000..e5d7d9e --- /dev/null +++ b/ansi-tests/vector-pop.lsp @@ -0,0 +1,44 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Jan 24 07:46:29 2003 +;;;; Contains: Tests for VECTOR-POP + +(in-package :cl-test) + +(deftest vector-pop.1 + (let ((v (make-array '(5) :initial-contents '(a b c d e) + :fill-pointer 3))) + (values + (length v) + (check-values (vector-pop v)) + (fill-pointer v) + (length v) + v)) + 3 c 2 2 #(a b)) + +;;; Error cases + +(deftest vector-pop.error.1 + (classify-error (vector-pop (vector 1 2 3))) + type-error) + +(deftest vector-pop.error.2 + (let ((v (make-array '(5) :initial-element 'x + :fill-pointer 0))) + (handler-case (vector-pop v) + (error () 'error))) + error) + +(deftest vector-pop.error.3 + (classify-error (vector-pop)) + program-error) + +(deftest vector-pop.error.4 + (classify-error (let ((v (make-array '(5) :fill-pointer t + :initial-element 'x))) + (vector-pop v nil))) + program-error) + +(deftest vector-pop.error.5 + (classify-error (locally (vector-pop (vector 1 2 3)) t)) + type-error) diff --git a/ansi-tests/vector-push-extend.lsp b/ansi-tests/vector-push-extend.lsp new file mode 100644 index 0000000..63903d6 --- /dev/null +++ b/ansi-tests/vector-push-extend.lsp @@ -0,0 +1,362 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 25 08:04:35 2003 +;;;; Contains: Tests for VECTOR-PUSH-EXTEND + +(in-package :cl-test) + +(deftest vector-push-extend.1 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(a b c d e))) + (i 0) x y) + (values + (fill-pointer a) + (vector-push-extend (progn (setf x (incf i)) 'x) + (progn (setf y (incf i)) a)) + (fill-pointer a) + a + i x y)) + 2 2 3 #(a b x) 2 1 2) + +(deftest vector-push-extend.2 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(a b c d e)))) + (values + (fill-pointer a) + (vector-push-extend 'x a) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #(a b c d e x)) + +(deftest vector-push-extend.3 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents "abcde" + :element-type 'base-char))) + (values + (fill-pointer a) + (vector-push-extend #\x a) + (fill-pointer a) + a)) + 2 2 3 "abx") + +(deftest vector-push-extend.4 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents "abcde" + :element-type 'base-char)) + (i 0) x y z) + (values + (fill-pointer a) + (vector-push-extend (progn (setf x (incf i)) #\x) + (progn (setf y (incf i)) a) + (progn (setf z (incf i)) 1)) + (fill-pointer a) + (<= (array-total-size a) 5) + a + i x y z)) + 5 5 6 nil "abcdex" 3 1 2 3) + +(deftest vector-push-extend.5 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents "abcde" + :element-type 'character))) + (values + (fill-pointer a) + (vector-push-extend #\x a) + (fill-pointer a) + a)) + 2 2 3 "abx") + +(deftest vector-push-extend.6 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents "abcde" + :element-type 'character))) + (values + (fill-pointer a) + (vector-push-extend #\x a 10) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil "abcdex") + +(deftest vector-push-extend.7 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(0 1 1 0 0) + :element-type 'bit))) + (values + (fill-pointer a) + (vector-push-extend 0 a) + (fill-pointer a) + a)) + 2 2 3 #*010) + +(deftest vector-push-extend.8 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(0 0 0 0 0) + :element-type 'bit))) + (values + (fill-pointer a) + (vector-push-extend 1 a 100) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #*000001) + +(deftest vector-push-extend.9 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1 2 3 4 5) + :element-type 'fixnum))) + (values + (fill-pointer a) + (vector-push-extend 0 a) + (fill-pointer a) + a)) + 2 2 3 #(1 2 0)) + +(deftest vector-push-extend.10 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(1 2 3 4 5) + :element-type 'fixnum))) + (values + (fill-pointer a) + (vector-push-extend 0 a 1) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #(1 2 3 4 5 0)) + +(deftest vector-push-extend.11 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1 2 3 4 5) + :element-type '(integer 0 (256))))) + (values + (fill-pointer a) + (vector-push-extend 0 a) + (fill-pointer a) + a)) + 2 2 3 #(1 2 0)) + +(deftest vector-push-extend.12 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(1 2 3 4 5) + :element-type '(integer 0 (256))))) + (values + (fill-pointer a) + (vector-push-extend 0 a 1) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #(1 2 3 4 5 0)) + +(deftest vector-push-extend.13 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0) + :element-type 'short-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0s0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0s0 2.0s0 0.0s0)) + +(deftest vector-push-extend.14 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0) + :element-type 'short-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0s0 a 1) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0 0.0s0)) + +(deftest vector-push-extend.15 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0) + :element-type 'single-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0f0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0f0 2.0f0 0.0f0)) + +(deftest vector-push-extend.16 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0) + :element-type 'single-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0f0 a 1) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0 0.0f0)) + + +(deftest vector-push-extend.17 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0) + :element-type 'double-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0d0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0d0 2.0d0 0.0d0)) + +(deftest vector-push-extend.18 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0) + :element-type 'double-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0d0 a 1) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0 0.0d0)) + +(deftest vector-push-extend.19 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0) + :element-type 'long-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0l0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0l0 2.0l0 0.0l0)) + +(deftest vector-push-extend.20 + (let ((a (make-array '(5) :fill-pointer 5 + :adjustable t + :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0) + :element-type 'long-float))) + (values + (fill-pointer a) + (vector-push-extend 0.0l0 a 1) + (fill-pointer a) + (<= (array-total-size a) 5) + a)) + 5 5 6 nil #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0 0.0l0)) + + + +;;; Error tests + +(defun vector-push-extend-error-test (seq val) + (declare (optimize (safety 3))) + (handler-case + (eval `(let ((a (copy-seq ,seq))) + (declare (optimize (safety 3))) + (or (notnot (array-has-fill-pointer-p a)) + (vector-push-extend ',val a 1)))) + (error () t))) + +(deftest vector-push-extend.error.1 + (vector-push-extend-error-test #(a b c d) 'x) + t) + +(deftest vector-push-extend.error.2 + (vector-push-extend-error-test #*00000 1) + t) + +(deftest vector-push-extend.error.3 + (vector-push-extend-error-test "abcde" #\x) + t) + +(deftest vector-push-extend.error.4 + (vector-push-extend-error-test #() 'x) + t) + +(deftest vector-push-extend.error.5 + (vector-push-extend-error-test #* 1) + t) + +(deftest vector-push-extend.error.6 + (vector-push-extend-error-test "" #\x) + t) + +(deftest vector-push-extend.error.7 + (vector-push-extend-error-test (make-array '5 :element-type 'base-char + :initial-element #\a) + #\x) + t) + +(deftest vector-push-extend.error.8 + (vector-push-extend-error-test (make-array '5 :element-type '(integer 0 (256)) + :initial-element 0) + 17) + t) + +(deftest vector-push-extend.error.9 + (vector-push-extend-error-test (make-array '5 :element-type 'float + :initial-element 1.0) + 2.0) + t) + +(deftest vector-push-extend.error.10 + (vector-push-extend-error-test (make-array '5 :element-type 'short-float + :initial-element 1.0s0) + 2.0s0) + t) + +(deftest vector-push-extend.error.11 + (vector-push-extend-error-test (make-array '5 :element-type 'long-float + :initial-element 1.0l0) + 2.0l0) + t) + +(deftest vector-push-extend.error.12 + (vector-push-extend-error-test (make-array '5 :element-type 'single-float + :initial-element 1.0f0) + 2.0f0) + t) + +(deftest vector-push-extend.error.13 + (vector-push-extend-error-test (make-array '5 :element-type 'double-float + :initial-element 1.0d0) + 2.0d0) + t) + +(deftest vector-push-extend.error.14 + (classify-error (vector-push-extend)) + program-error) + +(deftest vector-push-extend.error.15 + (classify-error (vector-push-extend (vector 1 2 3))) + program-error) + +(deftest vector-push-extend.error.16 + (classify-error (vector-push-extend (vector 1 2 3) 4 1 nil)) + program-error) + +(deftest vector-push-extend.error.17 + (handler-case + (eval + `(locally + (declare (optimize (safety 3))) + (let ((a (make-array '5 :fill-pointer t :adjustable nil + :initial-element nil))) + (or (notnot (adjustable-array-p a)) ; It's actually adjustable, or... + (vector-push-extend a 'x) ; ... this fails + )))) + (error () t)) + t) + + + + + + diff --git a/ansi-tests/vector-push.lsp b/ansi-tests/vector-push.lsp new file mode 100644 index 0000000..6cb106b --- /dev/null +++ b/ansi-tests/vector-push.lsp @@ -0,0 +1,319 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 25 00:55:43 2003 +;;;; Contains: Tests for VECTOR-PUSH + +(in-package :cl-test) + +(deftest vector-push.1 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(a b c d e))) + (i 0) x y) + (values + (fill-pointer a) + (vector-push (progn (setf x (incf i)) 'x) + (progn (setf y (incf i)) a)) + (fill-pointer a) + a i x y)) + 2 2 3 #(a b x) 2 1 2) + + +(deftest vector-push.2 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(a b c d e)))) + (values + (fill-pointer a) + (vector-push 'x a) + (fill-pointer a) + a)) + 5 nil 5 #(a b c d e)) + +(deftest vector-push.3 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents "abcde" + :element-type 'base-char))) + (values + (fill-pointer a) + (vector-push #\x a) + (fill-pointer a) + a)) + 2 2 3 "abx") + +(deftest vector-push.4 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents "abcde" + :element-type 'base-char))) + (values + (fill-pointer a) + (vector-push #\x a) + (fill-pointer a) + a)) + 5 nil 5 "abcde") + +(deftest vector-push.5 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents "abcde" + :element-type 'character))) + (values + (fill-pointer a) + (vector-push #\x a) + (fill-pointer a) + a)) + 2 2 3 "abx") + +(deftest vector-push.6 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents "abcde" + :element-type 'character))) + (values + (fill-pointer a) + (vector-push #\x a) + (fill-pointer a) + a)) + 5 nil 5 "abcde") + +(deftest vector-push.7 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(0 1 1 0 0) + :element-type 'bit))) + (values + (fill-pointer a) + (vector-push 0 a) + (fill-pointer a) + a)) + 2 2 3 #*010) + +(deftest vector-push.8 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(0 0 0 0 0) + :element-type 'bit))) + (values + (fill-pointer a) + (vector-push 1 a) + (fill-pointer a) + a)) + 5 nil 5 #*00000) + +(deftest vector-push.9 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1 2 3 4 5) + :element-type 'fixnum))) + (values + (fill-pointer a) + (vector-push 0 a) + (fill-pointer a) + a)) + 2 2 3 #(1 2 0)) + +(deftest vector-push.10 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(1 2 3 4 5) + :element-type 'fixnum))) + (values + (fill-pointer a) + (vector-push 0 a) + (fill-pointer a) + a)) + 5 nil 5 #(1 2 3 4 5)) + +(deftest vector-push.11 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1 2 3 4 5) + :element-type '(integer 0 (256))))) + (values + (fill-pointer a) + (vector-push 0 a) + (fill-pointer a) + a)) + 2 2 3 #(1 2 0)) + +(deftest vector-push.12 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(1 2 3 4 5) + :element-type '(integer 0 (256))))) + (values + (fill-pointer a) + (vector-push 0 a) + (fill-pointer a) + a)) + 5 nil 5 #(1 2 3 4 5)) + +(deftest vector-push.13 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0) + :element-type 'short-float))) + (values + (fill-pointer a) + (vector-push 0.0s0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0s0 2.0s0 0.0s0)) + +(deftest vector-push.14 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0) + :element-type 'short-float))) + (values + (fill-pointer a) + (vector-push 0.0s0 a) + (fill-pointer a) + a)) + 5 nil 5 #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)) + +(deftest vector-push.15 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0) + :element-type 'single-float))) + (values + (fill-pointer a) + (vector-push 0.0f0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0f0 2.0f0 0.0f0)) + +(deftest vector-push.16 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0) + :element-type 'single-float))) + (values + (fill-pointer a) + (vector-push 0.0f0 a) + (fill-pointer a) + a)) + 5 nil 5 #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)) + + +(deftest vector-push.17 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0) + :element-type 'double-float))) + (values + (fill-pointer a) + (vector-push 0.0d0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0d0 2.0d0 0.0d0)) + +(deftest vector-push.18 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0) + :element-type 'double-float))) + (values + (fill-pointer a) + (vector-push 0.0d0 a) + (fill-pointer a) + a)) + 5 nil 5 #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) + +(deftest vector-push.19 + (let ((a (make-array '(5) :fill-pointer 2 + :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0) + :element-type 'long-float))) + (values + (fill-pointer a) + (vector-push 0.0l0 a) + (fill-pointer a) + a)) + 2 2 3 #(1.0l0 2.0l0 0.0l0)) + +(deftest vector-push.20 + (let ((a (make-array '(5) :fill-pointer 5 + :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0) + :element-type 'long-float))) + (values + (fill-pointer a) + (vector-push 0.0l0 a) + (fill-pointer a) + a)) + 5 nil 5 #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)) + + + +;;; Error tests + +(defun vector-push-error-test (seq val) + (declare (optimize (safety 3))) + (handler-case + (eval `(let ((a (copy-seq ,seq))) + (declare (optimize (safety 3))) + (or (notnot (array-has-fill-pointer-p a)) + (vector-push ',val a)))) + (error () t))) + +(deftest vector-push.error.1 + (vector-push-error-test #(a b c d) 'x) + t) + +(deftest vector-push.error.2 + (vector-push-error-test #*00000 1) + t) + +(deftest vector-push.error.3 + (vector-push-error-test "abcde" #\x) + t) + +(deftest vector-push.error.4 + (vector-push-error-test #() 'x) + t) + +(deftest vector-push.error.5 + (vector-push-error-test #* 1) + t) + +(deftest vector-push.error.6 + (vector-push-error-test "" #\x) + t) + +(deftest vector-push.error.7 + (vector-push-error-test (make-array '5 :element-type 'base-char + :initial-element #\a) + #\x) + t) + +(deftest vector-push.error.8 + (vector-push-error-test (make-array '5 :element-type '(integer 0 (256)) + :initial-element 0) + 17) + t) + +(deftest vector-push.error.9 + (vector-push-error-test (make-array '5 :element-type 'float + :initial-element 1.0) + 2.0) + t) + +(deftest vector-push.error.10 + (vector-push-error-test (make-array '5 :element-type 'short-float + :initial-element 1.0s0) + 2.0s0) + t) + +(deftest vector-push.error.11 + (vector-push-error-test (make-array '5 :element-type 'long-float + :initial-element 1.0l0) + 2.0l0) + t) + +(deftest vector-push.error.12 + (vector-push-error-test (make-array '5 :element-type 'single-float + :initial-element 1.0f0) + 2.0f0) + t) + +(deftest vector-push.error.13 + (vector-push-error-test (make-array '5 :element-type 'double-float + :initial-element 1.0d0) + 2.0d0) + t) + +(deftest vector-push.error.14 + (classify-error (vector-push)) + program-error) + +(deftest vector-push.error.15 + (classify-error (vector-push (vector 1 2 3))) + program-error) + +(deftest vector-push.error.16 + (classify-error (vector-push (vector 1 2 3) 4 nil)) + program-error) diff --git a/ansi-tests/vector.lsp b/ansi-tests/vector.lsp new file mode 100644 index 0000000..2dc1bd4 --- /dev/null +++ b/ansi-tests/vector.lsp @@ -0,0 +1,331 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Jan 23 06:32:02 2003 +;;;; Contains: Tests of VECTOR (type and function) + +(in-package :cl-test) + +;;; More tests of type vector in make-array.lsp + +(deftest vector.type.1 + (notnot-mv (typep #(a b c) 'vector)) + t) + +(deftest vector.type.2 + (notnot-mv (typep #() 'vector)) + t) + +(deftest vector.type.3 + (notnot-mv (typep "" 'vector)) + t) + +(deftest vector.type.4 + (notnot-mv (typep "abcdef" 'vector)) + t) + +(deftest vector.type.5 + (notnot-mv (typep #* 'vector)) + t) + +(deftest vector.type.6 + (notnot-mv (typep #*011011101011 'vector)) + t) + +(deftest vector.type.7 + (typep #0aNIL 'vector) + nil) + +(deftest vector.type.8 + (typep #2a((a b c d)) 'vector) + nil) + +(deftest vector.type.9 + (subtypep* 'vector 'array) + t t) + +(deftest vector.type.10 + (notnot-mv (typep #(a b c) '(vector *))) + t) + +(deftest vector.type.11 + (notnot-mv (typep #(a b c) '(vector t))) + t) + +(deftest vector.type.12 + (notnot-mv (typep "abcde" '(vector *))) + t) + +(deftest vector.type.13 + (typep "abcdef" '(vector t)) + nil) + +(deftest vector.type.14 + (notnot-mv (typep #*00110 '(vector *))) + t) + +(deftest vector.type.15 + (typep #*00110 '(vector t)) + nil) + +(deftest vector.type.16 + (notnot-mv (typep #(a b c) '(vector * 3))) + t) + +(deftest vector.type.17 + (typep #(a b c) '(vector * 2)) + nil) + +(deftest vector.type.18 + (typep #(a b c) '(vector * 4)) + nil) + +(deftest vector.type.19 + (notnot-mv (typep #(a b c) '(vector t 3))) + t) + +(deftest vector.type.20 + (typep #(a b c) '(vector t 2)) + nil) + +(deftest vector.type.21 + (typep #(a b c) '(vector t 4)) + nil) + +(deftest vector.type.23 + (notnot-mv (typep #(a b c) '(vector t *))) + t) + +(deftest vector.type.23a + (notnot-mv (typep "abcde" '(vector * 5))) + t) + +(deftest vector.type.24 + (typep "abcde" '(vector * 4)) + nil) + +(deftest vector.type.25 + (typep "abcde" '(vector * 6)) + nil) + +(deftest vector.type.26 + (notnot-mv (typep "abcde" '(vector * *))) + t) + +(deftest vector.type.27 + (typep "abcde" '(vector t 5)) + nil) + +(deftest vector.type.28 + (typep "abcde" '(vector t 4)) + nil) + +(deftest vector.type.29 + (typep "abcde" '(vector t 6)) + nil) + +(deftest vector.type.30 + (typep "abcde" '(vector t *)) + nil) + +(deftest vector.type.31 + (let ((s (coerce "abc" 'simple-base-string))) + (notnot-mv (typep s '(vector base-char)))) + t) + +(deftest vector.type.32 + (let ((s (coerce "abc" 'simple-base-string))) + (notnot-mv (typep s '(vector base-char 3)))) + t) + +(deftest vector.type.33 + (let ((s (coerce "abc" 'simple-base-string))) + (typep s '(vector base-char 2))) + nil) + +(deftest vector.type.34 + (let ((s (coerce "abc" 'simple-base-string))) + (typep s '(vector base-char 4))) + nil) + +(deftest vector.type.35 + (let ((s (coerce "abc" 'simple-base-string))) + (notnot-mv (typep s 'vector))) + t) + +(deftest vector.type.36 + (let ((s (coerce "abc" 'simple-base-string))) + (notnot-mv (typep s '(vector *)))) + t) + +(deftest vector.type.37 + (let ((s (coerce "abc" 'simple-base-string))) + (notnot-mv (typep s '(vector * 3)))) + t) + +(deftest vector.type.38 + (let ((s (coerce "abc" 'simple-base-string))) + (notnot-mv (typep s '(vector * *)))) + t) + +(deftest vector.type.39 + (let ((s (coerce "abc" 'simple-base-string))) + (typep s '(vector t))) + nil) + +(deftest vector.type.40 + (let ((s (coerce "abc" 'simple-base-string))) + (typep s '(vector t *))) + nil) + +(deftest vector.type.41 + (notnot-mv (typep (make-array '10 :element-type 'short-float) 'vector)) + t) + +(deftest vector.type.42 + (notnot-mv (typep (make-array '10 :element-type 'single-float) 'vector)) + t) + +(deftest vector.type.43 + (notnot-mv (typep (make-array '10 :element-type 'double-float) 'vector)) + t) + +(deftest vector.type.44 + (notnot-mv (typep (make-array '10 :element-type 'long-float) 'vector)) + t) + + +;;; Tests of vector as class + +(deftest vector-as-class.1 + (notnot-mv (find-class 'vector)) + t) + +(deftest vector-as-class.2 + (notnot-mv (typep #() (find-class 'vector))) + t) + +(deftest vector-as-class.3 + (notnot-mv (typep #(a b c) (find-class 'vector))) + t) + +(deftest vector-as-class.4 + (notnot-mv (typep "" (find-class 'vector))) + t) + +(deftest vector-as-class.5 + (notnot-mv (typep "abcd" (find-class 'vector))) + t) + +(deftest vector-as-class.6 + (notnot-mv (typep #* (find-class 'vector))) + t) + +(deftest vector-as-class.7 + (notnot-mv (typep #*01101010100 (find-class 'vector))) + t) + +(deftest vector-as-class.8 + (typep #0aNIL (find-class 'vector)) + nil) + +(deftest vector-as-class.9 + (typep #2a((a b)(c d)) (find-class 'vector)) + nil) + +(deftest vector-as-class.10 + (typep (make-array '(1 0)) (find-class 'vector)) + nil) + +(deftest vector-as-class.11 + (typep (make-array '(0 1)) (find-class 'vector)) + nil) + +(deftest vector-as-class.12 + (typep 1 (find-class 'vector)) + nil) + +(deftest vector-as-class.13 + (typep nil (find-class 'vector)) + nil) + +(deftest vector-as-class.14 + (typep 'x (find-class 'vector)) + nil) + +(deftest vector-as-class.15 + (typep '(a b c) (find-class 'vector)) + nil) + +(deftest vector-as-class.16 + (typep 10.0 (find-class 'vector)) + nil) + +(deftest vector-as-class.17 + (typep 3/5 (find-class 'vector)) + nil) + +(deftest vector-as-class.18 + (typep (1+ most-positive-fixnum) (find-class 'vector)) + nil) + +;;;; Tests of the function VECTOR + +(deftest vector.1 + (vector) + #()) + +(deftest vector.2 + (vector 1 2 3) + #(1 2 3)) + +(deftest vector.3 + (let* ((len (min 1000 (1- call-arguments-limit))) + (args (make-int-list len)) + (v (apply #'vector args))) + (and + (typep v '(vector t)) + (typep v '(vector t *)) + (typep v `(vector t ,len)) + (typep v 'simple-vector) + (typep v `(simple-vector ,len)) + (eql (length v) len) + (loop for i from 0 + for e across v + always (eql i e)) + t)) + t) + +(deftest vector.4 + (notnot-mv (typep (vector) '(vector t 0))) + t) + +(deftest vector.5 + (notnot-mv (typep (vector) 'simple-vector)) + t) + +(deftest vector.6 + (notnot-mv (typep (vector) '(simple-vector 0))) + t) + +(deftest vector.7 + (notnot-mv (typep (vector 1 2 3) 'simple-vector)) + t) + +(deftest vector.8 + (notnot-mv (typep (vector 1 2 3) '(simple-vector 3))) + t) + +(deftest vector.9 + (typep (vector #\a #\b #\c) 'string) + nil) + +(deftest vector.10 + (notnot-mv (typep (vector 1 2 3) '(simple-vector *))) + t) + +(deftest vector.order.1 + (let ((i 0) a b c) + (values + (vector (setf a (incf i)) (setf b (incf i)) (setf c (incf i))) + i a b c)) + #(1 2 3) 3 1 2 3) diff --git a/ansi-tests/vectorp.lsp b/ansi-tests/vectorp.lsp new file mode 100644 index 0000000..2404993 --- /dev/null +++ b/ansi-tests/vectorp.lsp @@ -0,0 +1,82 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 26 13:17:05 2003 +;;;; Contains: Tests for VECTORP + +(in-package :cl-test) + +(deftest vectorp.1 + (vectorp 1) + nil) + +(deftest vectorp.2 + (vectorp (1+ most-positive-fixnum)) + nil) + +(deftest vectorp.3 + (vectorp #\a) + nil) + +(deftest vectorp.4 + (vectorp 10.0) + nil) + +(deftest vectorp.5 + (vectorp #'(lambda (x y) (cons y x))) + nil) + +(deftest vectorp.6 + (vectorp '(a b)) + nil) + +(deftest vectorp.7 + (vectorp #0aT) + nil) + +(deftest vectorp.8 + (vectorp #2a((a b)(c d))) + nil) + +(deftest vectorp.9 + (notnot-mv (vectorp "abcd")) + t) + +(deftest vectorp.10 + (notnot-mv (vectorp #*)) + t) + +(deftest vectorp.11 + (notnot-mv (vectorp #*1101)) + t) + +(deftest vectorp.12 + (notnot-mv (vectorp "")) + t) + +(deftest vectorp.13 + (notnot-mv (vectorp #(1 2 3))) + t) + +(deftest vectorp.14 + (notnot-mv (vectorp #())) + t) + +(deftest vectorp.15 + (vectorp #b11010) + nil) + +;;; Error tests + +(deftest vectorp.error.1 + (classify-error (vectorp)) + program-error) + +(deftest vectorp.error.2 + (classify-error (vectorp #() #())) + program-error) + + + + + + diff --git a/ansi-tests/warn.lsp b/ansi-tests/warn.lsp new file mode 100644 index 0000000..d16498d --- /dev/null +++ b/ansi-tests/warn.lsp @@ -0,0 +1,161 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Feb 23 20:48:12 2003 +;;;; Contains: Tests for WARN + +(in-package :cl-test) + +(deftest warn.1 + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn "This is a warning")) + warned))) + (nil) t) + +(deftest warn.2 + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning)))) + (values + (multiple-value-list (warn "This is a warning")) + warned))) + (nil) t) + +(deftest warn.3 + (with-output-to-string + (*error-output*) + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (warn "Foo!")))) + "") + +(deftest warn.4 + (let ((str (with-output-to-string + (*error-output*) + (warn "Foo!")))) + (not (string= str ""))) + t) + +(deftest warn.5 + (let ((warned nil)) + (handler-bind + ((simple-warning #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn "This is a warning")) + warned))) + (nil) t) + +(deftest warn.6 + (let ((warned nil)) + (handler-bind + ((simple-condition #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn "This is a warning")) + warned))) + (nil) t) + +(deftest warn.7 + (let ((warned nil)) + (handler-bind + ((condition #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn "This is a warning")) + warned))) + (nil) t) + +(deftest warn.8 + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn 'simple-warning :format-control "Foo!")) + warned))) + (nil) t) + +(deftest warn.9 + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn 'warning)) + warned))) + (nil) t) + +(deftest warn.10 + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn (make-condition 'simple-warning :format-control "Foo!"))) + warned))) + (nil) t) + +(deftest warn.11 + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list (warn (make-condition 'warning))) + warned))) + (nil) t) + +(deftest warn.12 + (classify-error (warn 'condition)) + type-error) + +(deftest warn.13 + (classify-error (warn 'simple-condition)) + type-error) + +(deftest warn.14 + (classify-error (warn (make-condition 'simple-warning) :format-control "Foo")) + type-error) + +(deftest warn.15 + (classify-error (warn)) + program-error) + +(deftest warn.16 + (classify-error (warn (make-condition 'condition))) + type-error) + +(deftest warn.17 + (classify-error (warn (make-condition 'simple-condition))) + type-error) + +(deftest warn.18 + (classify-error (warn (make-condition 'simple-error))) + type-error) diff --git a/ansi-tests/when.lsp b/ansi-tests/when.lsp new file mode 100644 index 0000000..67840fb --- /dev/null +++ b/ansi-tests/when.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Oct 18 19:36:57 2002 +;;;; Contains: Tests of WHEN + +(in-package :cl-test) + +(deftest when.1 + (when t) + nil) + +(deftest when.2 + (when nil 'a) + nil) + +(deftest when.3 (when t (values))) + +(deftest when.4 + (when t (values 'a 'b 'c 'd)) + a b c d) + +(deftest when.5 + (when nil (values)) + nil) + +(deftest when.6 + (when nil (values 'a 'b 'c 'd)) + nil) + +(deftest when.7 + (let ((x 0)) + (values + (when t (incf x) 'a) + x)) + a 1) + +;;; (deftest when.error.1 +;;; (classify-error (when)) +;;; program-error) diff --git a/ansi-tests/wild-pathname-p.lsp b/ansi-tests/wild-pathname-p.lsp new file mode 100644 index 0000000..d161c43 --- /dev/null +++ b/ansi-tests/wild-pathname-p.lsp @@ -0,0 +1,234 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Dec 31 16:54:55 2003 +;;;; Contains: Tests of WILD-PATHNAME-P + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +(deftest wild-pathname-p.1 + (wild-pathname-p (make-pathname)) + nil) + +(deftest wild-pathname-p.2 + (loop for key in '(:host :device :directory :name :type :version nil) + when (wild-pathname-p (make-pathname) key) + collect key) + nil) + +(deftest wild-pathname-p.3 + (let ((p (make-pathname :directory :wild))) + (notnot-mv (wild-pathname-p p))) + t) + +(deftest wild-pathname-p.4 + (let ((p (make-pathname :directory :wild))) + (notnot-mv (wild-pathname-p p nil))) + t) + +(deftest wild-pathname-p.5 + (let ((p (make-pathname :directory :wild))) + (notnot-mv (wild-pathname-p p :directory))) + t) + +(deftest wild-pathname-p.6 + (let ((p (make-pathname :directory :wild))) + (loop for key in '(:host :device :name :type :version) + when (wild-pathname-p p key) + collect key)) + nil) + + +(deftest wild-pathname-p.7 + (let ((p (make-pathname :directory '(:absolute :wild)))) + (notnot-mv (wild-pathname-p p))) + t) + +(deftest wild-pathname-p.8 + (let ((p (make-pathname :directory '(:absolute :wild)))) + (notnot-mv (wild-pathname-p p nil))) + t) + +(deftest wild-pathname-p.9 + (let ((p (make-pathname :directory '(:absolute :wild)))) + (notnot-mv (wild-pathname-p p :directory))) + t) + +(deftest wild-pathname-p.10 + (let ((p (make-pathname :directory '(:absolute :wild)))) + (loop for key in '(:host :device :name :type :version) + when (wild-pathname-p p key) + collect key)) + nil) + + +(deftest wild-pathname-p.11 + (let ((p (make-pathname :directory '(:relative :wild)))) + (notnot-mv (wild-pathname-p p))) + t) + +(deftest wild-pathname-p.12 + (let ((p (make-pathname :directory '(:relative :wild)))) + (notnot-mv (wild-pathname-p p nil))) + t) + +(deftest wild-pathname-p.13 + (let ((p (make-pathname :directory '(:relative :wild)))) + (notnot-mv (wild-pathname-p p :directory))) + t) + +(deftest wild-pathname-p.14 + (let ((p (make-pathname :directory '(:relative :wild)))) + (loop for key in '(:host :device :name :type :version) + when (wild-pathname-p p key) + collect key)) + nil) + +;;; + +(deftest wild-pathname-p.15 + (let ((p (make-pathname :name :wild))) + (notnot-mv (wild-pathname-p p))) + t) + +(deftest wild-pathname-p.16 + (let ((p (make-pathname :name :wild))) + (notnot-mv (wild-pathname-p p nil))) + t) + +(deftest wild-pathname-p.17 + (let ((p (make-pathname :name :wild))) + (notnot-mv (wild-pathname-p p :name))) + t) + +(deftest wild-pathname-p.18 + (let ((p (make-pathname :name :wild))) + (loop for key in '(:host :device :directory :type :version) + when (wild-pathname-p p key) + collect key)) + nil) + +;;; + +(deftest wild-pathname-p.19 + (let ((p (make-pathname :type :wild))) + (notnot-mv (wild-pathname-p p))) + t) + +(deftest wild-pathname-p.20 + (let ((p (make-pathname :type :wild))) + (notnot-mv (wild-pathname-p p nil))) + t) + +(deftest wild-pathname-p.21 + (let ((p (make-pathname :type :wild))) + (notnot-mv (wild-pathname-p p :type))) + t) + +(deftest wild-pathname-p.22 + (let ((p (make-pathname :type :wild))) + (loop for key in '(:host :device :directory :name :version) + when (wild-pathname-p p key) + collect key)) + nil) + +;;; + + (deftest wild-pathname-p.23 + (let ((p (make-pathname :version :wild))) + (notnot-mv (wild-pathname-p p))) + t) + +(deftest wild-pathname-p.24 + (let ((p (make-pathname :version :wild))) + (notnot-mv (wild-pathname-p p nil))) + t) + +(deftest wild-pathname-p.25 + (let ((p (make-pathname :version :wild))) + (notnot-mv (wild-pathname-p p :version))) + t) + +(deftest wild-pathname-p.26 + (let ((p (make-pathname :version :wild))) + (loop for key in '(:host :device :directory :name :type) + when (wild-pathname-p p key) + collect key)) + nil) + +;;; + +(deftest wild-pathname-p.27 + (loop for p in (append *pathnames* *logical-pathnames*) + unless (if (wild-pathname-p p) (wild-pathname-p p nil) + (not (wild-pathname-p p nil))) + collect p) + nil) + +(deftest wild-pathname-p.28 + (loop for p in (append *pathnames* *logical-pathnames*) + when (and (loop for key in '(:host :device :directory + :name :type :version) + thereis (wild-pathname-p p key)) + (not (wild-pathname-p p))) + collect p) + nil) + +;;; On streams associated with files + +(deftest wild-pathname-p.29 + (with-open-file (s "foo.lsp" + :direction :output + :if-exists :append + :if-does-not-exist :create) + (wild-pathname-p s)) + nil) + +(deftest wild-pathname-p.30 + (let ((s (open "foo.lsp" + :direction :output + :if-exists :append + :if-does-not-exist :create))) + (close s) + (wild-pathname-p s)) + nil) + +;;; logical pathname designators + +(deftest wild-pathname-p.31 + (wild-pathname-p "CLTEST:FOO.LISP") + nil) + +;;; Odd strings + +(deftest wild-pathname-p.32 + (do-special-strings + (s "CLTEST:FOO.LISP" nil) + (let ((vals (multiple-value-list (wild-pathname-p s)))) + (assert (equal vals '(nil))))) + nil) + +;;; + +(deftest wild-pathname-p.error.1 + (signals-error (wild-pathname-p) program-error) + t) + +(deftest wild-pathname-p.error.2 + (signals-error (wild-pathname-p *default-pathname-defaults* nil nil) + program-error) + t) + +(deftest wild-pathname-p.error.3 + (check-type-error #'wild-pathname-p + (typef '(or pathname string file-stream + synonym-stream))) + nil) + +(deftest wild-pathname-p.error.4 + (check-type-error #'(lambda (x) (declare (optimize (safety 0))) + (wild-pathname-p x)) + (typef '(or pathname string file-stream + synonym-stream))) + nil) diff --git a/ansi-tests/with-input-from-string.lsp b/ansi-tests/with-input-from-string.lsp new file mode 100644 index 0000000..a66f3fc --- /dev/null +++ b/ansi-tests/with-input-from-string.lsp @@ -0,0 +1,245 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 20:13:02 2004 +;;;; Contains: Tests of WITH-INPUT-FROM-STRING + +(in-package :cl-test) + +(deftest with-input-from-string.1 + (with-input-from-string + (s "abc") + (values (read-char s) (read-char s) (read-char s) (read-char s nil :eof))) + #\a #\b #\c :eof) + +(deftest with-input-from-string.2 + (with-input-from-string (s "abc")) + nil) + +(deftest with-input-from-string.3 + (with-input-from-string (s "abc") (declare (optimize speed))) + nil) + +(deftest with-input-from-string.3a + (with-input-from-string (s "abc") + (declare (optimize speed)) + (declare (optimize space))) + nil) + +(deftest with-input-from-string.4 + (with-input-from-string + (s "abc") + (declare (optimize safety)) + (read-char s) + (read-char s)) + #\b) + +(deftest with-input-from-string.5 + (let ((i nil)) + (values + (with-input-from-string + (s "abc" :index i)) + i)) + nil 0) + +(deftest with-input-from-string.6 + (let ((i (list nil))) + (values + (with-input-from-string + (s "abc" :index (car i))) + i)) + nil (0)) + +(deftest with-input-from-string.7 + (let ((i nil)) + (values + (with-input-from-string + (s "abc" :index i) + (list i (read-char s) i (read-char s) i)) + i)) + (nil #\a nil #\b nil) 2) + +(deftest with-input-from-string.9 + (with-input-from-string + (s "abc") + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s))) + t t t t nil) + +(deftest with-input-from-string.10 + :notes (:nil-vectors-are-strings) + (with-input-from-string + (s (make-array 0 :element-type nil)) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s))) + t t t t nil) + +(deftest with-input-from-string.11 + (with-input-from-string + (s (make-array 3 :element-type 'character :initial-contents "abc")) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s) + (read-line s))) + t t t t nil "abc") + +(deftest with-input-from-string.12 + (with-input-from-string + (s (make-array 3 :element-type 'base-char :initial-contents "abc")) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s) + (read-line s))) + t t t t nil "abc") + +(deftest with-input-from-string.13 + (with-input-from-string + (s "abcdef" :start 2) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s) + (read-line s))) + t t t t nil "cdef") + +(deftest with-input-from-string.14 + (with-input-from-string + (s "abcdef" :end 3) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s) + (read-line s))) + t t t t nil "abc") + +(deftest with-input-from-string.15 + (with-input-from-string + (s "abcdef" :start 1 :end 5) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s) + (read-line s))) + t t t t nil "bcde") + +(deftest with-input-from-string.16 + (with-input-from-string + (s "abcdef" :start 1 :end nil) + (values + (notnot (typep s 'stream)) + (notnot (typep s 'string-stream)) + (notnot (open-stream-p s)) + (notnot (input-stream-p s)) + (output-stream-p s) + (read-line s))) + t t t t nil "bcdef") + +(deftest with-input-from-string.17 + (let ((i 2)) + (values + (with-input-from-string + (s "abcdef" :index i :start i) + (read-char s)) + i)) + #\c 3) + +;;; Test that there is no implicit tagbody + +(deftest with-input-from-string.18 + (block done + (tagbody + (with-input-from-string + (s "abc") + (go 1) + 1 + (return-from done :bad)) + 1 + (return-from done :good))) + :good) + +;;; Free declaration scope + +(deftest with-input-from-string.19 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-input-from-string (s (return-from done x)) + (declare (special x)))))) + :good) + +(deftest with-input-from-string.20 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-input-from-string (s "abc" :start (return-from done x)) + (declare (special x)))))) + :good) + +(deftest with-input-from-string.21 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-input-from-string (s "abc" :end (return-from done x)) + (declare (special x)))))) + :good) + +;;; index is not updated if the form exits abnormally + +(deftest with-input-from-string.22 + (let ((i nil)) + (values + (block done + (with-input-from-string (s "abcde" :index i) (return-from done (read-char s)))) + i)) + #\a nil) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest with-input-from-string.23 + (macrolet + ((%m (z) z)) + (with-input-from-string (s (expand-in-current-env (%m "123"))) + (read-char s))) + #\1) + +(deftest with-input-from-string.24 + (macrolet + ((%m (z) z)) + (with-input-from-string (s "123" :start (expand-in-current-env (%m 1))) + (read-char s))) + #\2) + +(deftest with-input-from-string.25 + (macrolet + ((%m (z) z)) + (with-input-from-string (s "123" :start 0 + :end (expand-in-current-env (%m 0))) + (read-char s nil nil))) + nil) + + +;;; FIXME: Add more tests on specialized strings. + diff --git a/ansi-tests/with-open-file.lsp b/ansi-tests/with-open-file.lsp new file mode 100644 index 0000000..a138d82 --- /dev/null +++ b/ansi-tests/with-open-file.lsp @@ -0,0 +1,98 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jan 27 20:57:05 2004 +;;;; Contains: Tests of WITH-OPEN-FILE + +(in-package :cl-test) + +;;; For now, omit most of the options combinations, assuming they will +;;; be tested in OPEN. The tests of OPEN should be ported to here at some +;;; point. + +(deftest with-open-file.1 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file (s pn :direction :output))) + nil) + +(deftest with-open-file.2 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file + (s pn :direction :output) + (notnot-mv (output-stream-p s)))) + t) + +(deftest with-open-file.3 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file + (s pn :direction :output) + (values)))) + +(deftest with-open-file.4 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file + (s pn :direction :output) + (values 1 2 3 4 5 6 7 8))) + 1 2 3 4 5 6 7 8) + +(deftest with-open-file.5 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file + (s pn :direction :output) + (declare (ignore s)) + (declare (optimize)))) + nil) + +(deftest with-open-file.6 + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file + (s pn (cdr '(nil . :direction)) (car '(:output))) + (format s "foo!~%")) + (with-open-file (s pn) (read-line s))) + "foo!" nil) + +;;; Free declaration scope tests + +(deftest with-open-file.7 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-open-file (s (return-from done x)) + (declare (special x)))))) + :good) + +(deftest with-open-file.8 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-open-file (s "with-open-file.lsp" (return-from done x) :input) + (declare (special x)))))) + :good) + +(deftest with-open-file.9 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-open-file (s "with-open-file.lsp" :direction (return-from done x)) + (declare (special x)))))) + :good) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest with-open-file.10 + (macrolet + ((%m (z) z)) + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file (s (expand-in-current-env (%m pn)) + :direction :output)))) + nil) diff --git a/ansi-tests/with-open-stream.lsp b/ansi-tests/with-open-stream.lsp new file mode 100644 index 0000000..1dcf73a --- /dev/null +++ b/ansi-tests/with-open-stream.lsp @@ -0,0 +1,77 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Dec 13 01:42:59 2004 +;;;; Contains: Tests of WITH-OPEN-STREAM + +(in-package :cl-test) + +(deftest with-open-stream.1 + (with-open-stream (os (make-string-output-stream))) + nil) + +(deftest with-open-stream.2 + (with-open-stream (os (make-string-output-stream)) + (declare (ignore os))) + nil) + +(deftest with-open-stream.3 + (with-open-stream (os (make-string-output-stream)) + (declare (ignore os)) + (declare (type string-stream os))) + nil) + +(deftest with-open-stream.4 + (with-open-stream (os (make-string-output-stream)) + (declare (ignore os)) + (values))) + +(deftest with-open-stream.5 + (with-open-stream (os (make-string-output-stream)) + (declare (ignore os)) + (values 'a 'b)) + a b) + +(deftest with-open-stream.6 + (let ((s (make-string-output-stream))) + (values + (with-open-stream (os s)) + (notnot (typep s 'string-stream)) + (open-stream-p s))) + nil t nil) + +(deftest with-open-stream.7 + (let ((s (make-string-input-stream "123"))) + (values + (with-open-stream (is s) (read-char s)) + (notnot (typep s 'string-stream)) + (open-stream-p s))) + #\1 t nil) + +(deftest with-open-stream.8 + (let ((s (make-string-output-stream))) + (values + (block done + (with-open-stream (os s) (return-from done nil))) + (notnot (typep s 'string-stream)) + (open-stream-p s))) + nil t nil) + +(deftest with-open-stream.9 + (let ((s (make-string-output-stream))) + (values + (catch 'done + (with-open-stream (os s) (throw 'done nil))) + (notnot (typep s 'string-stream)) + (open-stream-p s))) + nil t nil) + +;;; Free declaration scope + +(deftest with-open-stream.10 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-open-stream (s (return-from done x)) + (declare (special x)))))) + :good) diff --git a/ansi-tests/with-output-to-string.lsp b/ansi-tests/with-output-to-string.lsp new file mode 100644 index 0000000..c7c59ef --- /dev/null +++ b/ansi-tests/with-output-to-string.lsp @@ -0,0 +1,129 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Feb 14 20:33:51 2004 +;;;; Contains: Tests of WITH-OUTPUT-TO-STRING + +(in-package :cl-test) + + +(deftest with-output-to-string.1 + (with-output-to-string (s)) + "") + +(deftest with-output-to-string.2 + (with-output-to-string (s) (write-char #\3 s)) + "3") + +(deftest with-output-to-string.3 + (with-output-to-string (s (make-array 10 :fill-pointer 0 + :element-type 'character))) + nil) + +(deftest with-output-to-string.4 + :notes (:allow-nil-arrays :nil-vectors-are-strings) + (let ((str (make-array 10 :fill-pointer 0 :element-type 'character))) + (values + (with-output-to-string + (s str :element-type nil) + (write-string "abcdef" s)) + str)) + "abcdef" "abcdef") + +(deftest with-output-to-string.5 + (with-output-to-string (s (make-array 10 :fill-pointer 0 + :element-type 'character)) + (values))) + +(deftest with-output-to-string.6 + (with-output-to-string (s (make-array 10 :fill-pointer 0 + :element-type 'character)) + (values 'a 'b 'c 'd)) + a b c d) + +(deftest with-output-to-string.7 + (with-output-to-string (s nil :element-type 'character) + (write-char #\& s)) + "&") + +(deftest with-output-to-string.8 + (let ((str (with-output-to-string (s nil :element-type 'base-char) + (write-char #\8 s)))) + (assert (typep str 'simple-base-string)) + str) + "8") + +(deftest with-output-to-string.9 + :notes (:allow-nil-arrays :nil-vectors-are-strings) + (with-output-to-string (s nil :element-type nil)) + "") + +(deftest with-output-to-string.10 + (let* ((s1 (make-array 20 :element-type 'character + :initial-element #\.)) + (s2 (make-array 10 :element-type 'character + :displaced-to s1 + :displaced-index-offset 5 + :fill-pointer 0))) + + (values + (with-output-to-string + (s s2) + (write-string "0123456789" s)) + s1 + s2)) + "0123456789" + ".....0123456789....." + "0123456789") + +(deftest with-output-to-string.11 + (with-output-to-string (s) (declare (optimize safety))) + "") + +(deftest with-output-to-string.12 + (with-output-to-string (s) (declare (optimize safety)) + (declare (optimize (speed 0)))) + "") + +(deftest with-output-to-string.13 + (with-output-to-string + (s) + (write-char #\0 s) + (write-char #\4 s) + (write-char #\9 s)) + "049") + +(deftest with-output-to-string.14 + (let* ((str1 (make-array '(256) :element-type 'base-char :fill-pointer 0)) + (str2 (with-output-to-string + (s nil :element-type 'base-char) + (loop for i below 256 + for c = (code-char i) + when (typep c 'base-char) + do (progn (write-char c s) + (vector-push c str1)))))) + (if (string= str1 str2) :good + (list str1 str2))) + :good) + +;;; Free declaration scope + +(deftest with-output-to-string.15 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) + (with-output-to-string (s (return-from done x)) + (declare (special x)))))) + :good) + +(deftest with-output-to-string.16 + (block done + (let ((x :bad)) + (declare (special x)) + (let ((x :good) + (str (make-array '(10) :element-type 'character + :fill-pointer 0))) + (with-output-to-string (s str :element-type (return-from done x)) + (declare (special x)))))) + :good) + diff --git a/ansi-tests/write-char.lsp b/ansi-tests/write-char.lsp new file mode 100644 index 0000000..8974e85 --- /dev/null +++ b/ansi-tests/write-char.lsp @@ -0,0 +1,51 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 20:50:31 2004 +;;;; Contains: Tests of WRITE-CHAR + +(in-package :cl-test) + +(deftest write-char.1 + (loop for i from 0 to 255 + for c = (code-char i) + when c + unless (string= (with-output-to-string + (*standard-output*) + (write-char c)) + (string c)) + collect c) + nil) + +(deftest write-char.2 + (with-input-from-string + (is "abcd") + (with-output-to-string + (os) + (let ((*terminal-io* (make-two-way-stream is os))) + (write-char #\$ t) + (close *terminal-io*)))) + "$") + +(deftest write-char.3 + (with-output-to-string + (*standard-output*) + (write-char #\: nil)) + ":") + +;;; Error tests + +(deftest write-char.error.1 + (signals-error (write-char) program-error) + t) + +(deftest write-char.error.2 + (signals-error + (with-output-to-string + (s) + (write-char #\a s nil)) + program-error) + t) + +;;; More tests in other files + + diff --git a/ansi-tests/write-line.lsp b/ansi-tests/write-line.lsp new file mode 100644 index 0000000..10abecf --- /dev/null +++ b/ansi-tests/write-line.lsp @@ -0,0 +1,165 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Jan 19 06:49:26 2004 +;;;; Contains: Tests of WRITE-LINE + +(in-package :cl-test) + +(deftest write-line.1 + (let (result) + (values + (with-output-to-string + (*standard-output*) + (setq result (multiple-value-list (write-line "")))) + result)) + #.(string #\Newline) + ("")) + +(deftest write-line.2 + :notes (:nil-vectors-are-strings) + (let (result) + (values + (with-output-to-string + (*standard-output*) + (setq result + (multiple-value-list + (write-line (make-array '(0) :element-type nil))))) + result)) + #.(string #\Newline) + ("")) + +(deftest write-line.3 + (let (result) + (values + (with-output-to-string + (*standard-output*) + (setq result (multiple-value-list (write-line "abcde")))) + result)) + #.(concatenate 'string "abcde" (string #\Newline)) + ("abcde")) + +(deftest write-line.4 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list (write-line "abcde" s :start 1)))) + result)) + #.(concatenate 'string "bcde" (string #\Newline)) + ("abcde")) + +(deftest write-line.5 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-line "abcde" s :start 1 :end 3)))) + result)) + #.(concatenate 'string "bc" (string #\Newline)) + ("abcde")) + +(deftest write-line.6 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-line "abcde" s :start 1 :end nil)))) + result)) + #.(concatenate 'string "bcde" (string #\Newline)) + ("abcde")) + +(deftest write-line.7 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list (write-line "abcde" s :end 3)))) + result)) + #.(concatenate 'string "abc" (string #\Newline)) + ("abcde")) + +(deftest write-line.8 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-line "abcde" s :end 3 :allow-other-keys nil)))) + result)) + #.(concatenate 'string "abc" (string #\Newline)) + ("abcde")) + +(deftest write-line.9 + (let (result) + (values + (with-output-to-string + (s) + (setq result + (multiple-value-list + (write-line "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) + result)) + #.(concatenate 'string "abc" (string #\Newline)) + ("abcde")) + +(deftest write-line.10 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-line "abcde" s :end 3 :end 2)))) + result)) + #.(concatenate 'string "abc" (string #\Newline)) + ("abcde")) + +(deftest write-line.11 + (with-input-from-string + (is "abcd") + (with-output-to-string + (os) + (let ((*terminal-io* (make-two-way-stream is os))) + (write-line "951" t) + (close *terminal-io*)))) + #.(concatenate 'string "951" (string #\Newline))) + +(deftest write-line.12 + (with-output-to-string + (*standard-output*) + (write-line "-=|!" nil)) + #.(concatenate 'string "-=|!" (string #\Newline))) + +;;; Specialized string tests + +(deftest write-line.13 + (do-special-strings + (s "abcde" nil) + (assert (equal + (with-output-to-string + (*standard-output*) + (multiple-value-list (write-line "abcde"))) + #.(concatenate 'string "abcde" (string #\Newline))))) + nil) + +;;; Error tests + +(deftest write-line.error.1 + (signals-error (write-line) program-error) + t) + +(deftest write-line.error.2 + (signals-error (write-line "" *standard-output* :start) program-error) + t) + +(deftest write-line.error.3 + (signals-error (write-line "" *standard-output* :foo nil) program-error) + t) + +(deftest write-line.error.4 + (signals-error (write-line "" *standard-output* + :allow-other-keys nil + :foo nil) + program-error) + t) + diff --git a/ansi-tests/write-sequence.lsp b/ansi-tests/write-sequence.lsp new file mode 100644 index 0000000..c16ef8e --- /dev/null +++ b/ansi-tests/write-sequence.lsp @@ -0,0 +1,225 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jan 21 04:07:58 2004 +;;;; Contains: Tests of WRITE-SEQUENCE + +(in-package :cl-test) + +(defmacro def-write-sequence-test (name input args &rest expected) + `(deftest ,name + (let ((s ,input)) + (with-output-to-string + (os) + (assert (eq (write-sequence s os ,@args) s)))) + ,@expected)) + +;;; on strings + +(def-write-sequence-test write-sequence.string.1 "abcde" () "abcde") +(def-write-sequence-test write-sequence.string.2 "abcde" (:start 1) "bcde") +(def-write-sequence-test write-sequence.string.3 "abcde" (:end 3) "abc") +(def-write-sequence-test write-sequence.string.4 "abcde" + (:start 1 :end 4) "bcd") +(def-write-sequence-test write-sequence.string.5 "abcde" (:end nil) "abcde") +(def-write-sequence-test write-sequence.string.6 "abcde" (:start 3 :end 3) "") +(def-write-sequence-test write-sequence.string.7 "abcde" + (:end nil :start 1) "bcde") +(def-write-sequence-test write-sequence.string.8 "abcde" + (:allow-other-keys nil) "abcde") +(def-write-sequence-test write-sequence.string.9 "abcde" + (:allow-other-keys t :foo nil) "abcde") +(def-write-sequence-test write-sequence.string.10 "abcde" + (:allow-other-keys t :allow-other-keys nil :foo nil) "abcde") +(def-write-sequence-test write-sequence.string.11 "abcde" + (:bar 'x :allow-other-keys t) "abcde") +(def-write-sequence-test write-sequence.string.12 "abcde" + (:start 1 :end 4 :start 2 :end 3) "bcd") +(def-write-sequence-test write-sequence.string.13 "" () "") + +(defmacro def-write-sequence-special-test (name string args expected) + `(deftest ,name + (let ((str ,string) + (expected ,expected)) + (do-special-strings + (s str nil) + (let ((out (with-output-to-string + (os) + (assert (eq (write-sequence s os ,@args) s))))) + (assert (equal out expected))))) + nil)) + +(def-write-sequence-special-test write-sequence.string.14 "12345" () "12345") +(def-write-sequence-special-test write-sequence.string.15 "12345" (:start 1 :end 3) "23") + +;;; on lists + +(def-write-sequence-test write-sequence.list.1 (coerce "abcde" 'list) + () "abcde") +(def-write-sequence-test write-sequence.list.2 (coerce "abcde" 'list) + (:start 1) "bcde") +(def-write-sequence-test write-sequence.list.3 (coerce "abcde" 'list) + (:end 3) "abc") +(def-write-sequence-test write-sequence.list.4 (coerce "abcde" 'list) + (:start 1 :end 4) "bcd") +(def-write-sequence-test write-sequence.list.5 (coerce "abcde" 'list) + (:end nil) "abcde") +(def-write-sequence-test write-sequence.list.6 (coerce "abcde" 'list) + (:start 3 :end 3) "") +(def-write-sequence-test write-sequence.list.7 (coerce "abcde" 'list) + (:end nil :start 1) "bcde") +(def-write-sequence-test write-sequence.list.8 () () "") + + +;;; on vectors + +(def-write-sequence-test write-sequence.simple-vector.1 + (coerce "abcde" 'simple-vector) () "abcde") +(def-write-sequence-test write-sequence.simple-vector.2 + (coerce "abcde" 'simple-vector) (:start 1) "bcde") +(def-write-sequence-test write-sequence.simple-vector.3 + (coerce "abcde" 'simple-vector) (:end 3) "abc") +(def-write-sequence-test write-sequence.simple-vector.4 + (coerce "abcde" 'simple-vector) (:start 1 :end 4) "bcd") +(def-write-sequence-test write-sequence.simple-vector.5 + (coerce "abcde" 'simple-vector) (:end nil) "abcde") +(def-write-sequence-test write-sequence.simple-vector.6 + (coerce "abcde" 'simple-vector) (:start 3 :end 3) "") +(def-write-sequence-test write-sequence.simple-vector.7 + (coerce "abcde" 'simple-vector) (:end nil :start 1) "bcde") +(def-write-sequence-test write-sequence.simple-vector.8 #() () "") + +;;; on vectors with fill pointers + +(def-write-sequence-test write-sequence.fill-vector.1 + (make-array 10 :initial-contents "abcde " :fill-pointer 5) () "abcde") +(def-write-sequence-test write-sequence.fill-vector.2 + (make-array 10 :initial-contents "abcde " :fill-pointer 5) + (:start 1) "bcde") +(def-write-sequence-test write-sequence.fill-vector.3 + (make-array 10 :initial-contents "abcde " :fill-pointer 5) + (:end 3) "abc") +(def-write-sequence-test write-sequence.fill-vector.4 + (make-array 10 :initial-contents "abcde " :fill-pointer 5) + (:start 1 :end 4) "bcd") +(def-write-sequence-test write-sequence.fill-vector.5 + (make-array 10 :initial-contents "abcde " :fill-pointer 5) + (:end nil) "abcde") +(def-write-sequence-test write-sequence.fill-vector.6 + (make-array 10 :initial-contents "abcde " :fill-pointer 5) + (:start 3 :end 3) "") +(def-write-sequence-test write-sequence.fill-vector.7 + (make-array 10 :initial-contents "abcde " :fill-pointer 5) + (:end nil :start 1) "bcde") + +;;; on bit vectors + +(defmacro def-write-sequence-bv-test (name input args expected) + `(deftest ,name + (let ((s ,input) + (expected ,expected)) + (with-open-file + (os "tmp.dat" :direction :output + :element-type '(unsigned-byte 8) + :if-exists :supersede) + (assert (eq (write-sequence s os ,@args) s))) + (with-open-file + (is "tmp.dat" :direction :input + :element-type '(unsigned-byte 8)) + (loop for i from 0 below (length expected) + for e = (elt expected i) + always (eql (read-byte is) e)))) + t)) + +(def-write-sequence-bv-test write-sequence.bv.1 #*00111010 + () #*00111010) +(def-write-sequence-bv-test write-sequence.bv.2 #*00111010 + (:start 1) #*0111010) +(def-write-sequence-bv-test write-sequence.bv.3 #*00111010 + (:end 5) #*00111) +(def-write-sequence-bv-test write-sequence.bv.4 #*00111010 + (:start 1 :end 6) #*01110) +(def-write-sequence-bv-test write-sequence.bv.5 #*00111010 + (:start 1 :end nil) #*0111010) +(def-write-sequence-bv-test write-sequence.bv.6 #*00111010 + (:start 1 :end nil :end 4) #*0111010) + + +;;; Error tests + +(deftest write-sequence.error.1 + (signals-error (write-sequence) program-error) + t) + +(deftest write-sequence.error.2 + (signals-error (write-sequence "abcde") program-error) + t) + +(deftest write-sequence.error.3 + (signals-error (write-sequence '(#\a . #\b) *standard-output*) type-error) + t) + +(deftest write-sequence.error.4 + (signals-error (write-sequence #\a *standard-output*) type-error) + t) + +(deftest write-sequence.error.5 + (signals-error (write-sequence "ABC" *standard-output* :start -1) type-error) + t) + +(deftest write-sequence.error.6 + (signals-error (write-sequence "ABC" *standard-output* :start 'x) type-error) + t) + +(deftest write-sequence.error.7 + (signals-error (write-sequence "ABC" *standard-output* :start 0.0) + type-error) + t) + +(deftest write-sequence.error.8 + (signals-error (write-sequence "ABC" *standard-output* :end -1) + type-error) + t) + +(deftest write-sequence.error.9 + (signals-error (write-sequence "ABC" *standard-output* :end 'x) + type-error) + t) + +(deftest write-sequence.error.10 + (signals-error (write-sequence "ABC" *standard-output* :end 2.0) + type-error) + t) + +(deftest write-sequence.error.11 + (signals-error (write-sequence "abcde" *standard-output* + :foo nil) program-error) + t) + +(deftest write-sequence.error.12 + (signals-error (write-sequence "abcde" *standard-output* + :allow-other-keys nil :foo t) + program-error) + t) + +(deftest write-sequence.error.13 + (signals-error (write-sequence "abcde" *standard-output* :start) + program-error) + t) + +(deftest write-sequence.error.14 + (check-type-error #'(lambda (x) (write-sequence x *standard-output*)) + #'sequencep) + nil) + +(deftest write-sequence.error.15 + (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* + :start x)) + (typef 'unsigned-byte)) + nil) + +(deftest write-sequence.error.16 + (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* + :end x)) + (typef '(or null unsigned-byte))) + nil) + diff --git a/ansi-tests/write-string.lsp b/ansi-tests/write-string.lsp new file mode 100644 index 0000000..9d3bf82 --- /dev/null +++ b/ansi-tests/write-string.lsp @@ -0,0 +1,156 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jan 18 21:13:32 2004 +;;;; Contains: Tests of WRITE-STRING + +(in-package :cl-test) + +(deftest write-string.1 + (let (result) + (values + (with-output-to-string + (*standard-output*) + (setq result (multiple-value-list (write-string "")))) + result)) + "" ("")) + +(deftest write-string.2 + :notes (:nil-vectors-are-strings) + (let (result) + (values + (with-output-to-string + (*standard-output*) + (setq result + (multiple-value-list + (write-string (make-array '(0) :element-type nil))))) + result)) + "" ("")) + +(deftest write-string.3 + (let (result) + (values + (with-output-to-string + (*standard-output*) + (setq result (multiple-value-list (write-string "abcde")))) + result)) + "abcde" ("abcde")) + +(deftest write-string.4 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list (write-string "abcde" s :start 1)))) + result)) + "bcde" ("abcde")) + +(deftest write-string.5 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-string "abcde" s :start 1 :end 3)))) + result)) + "bc" ("abcde")) + +(deftest write-string.6 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-string "abcde" s :start 1 :end nil)))) + result)) + "bcde" ("abcde")) + +(deftest write-string.7 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list (write-string "abcde" s :end 3)))) + result)) + "abc" ("abcde")) + +(deftest write-string.8 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-string "abcde" s :end 3 :allow-other-keys nil)))) + result)) + "abc" ("abcde")) + +(deftest write-string.9 + (let (result) + (values + (with-output-to-string + (s) + (setq result + (multiple-value-list + (write-string "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) + result)) + "abc" ("abcde")) + +(deftest write-string.10 + (let (result) + (values + (with-output-to-string + (s) + (setq result (multiple-value-list + (write-string "abcde" s :end 3 :end 2)))) + result)) + "abc" ("abcde")) + +(deftest write-string.11 + (with-input-from-string + (is "abcd") + (with-output-to-string + (os) + (let ((*terminal-io* (make-two-way-stream is os))) + (write-string "951" t) + (close *terminal-io*)))) + "951") + +(deftest write-string.12 + (with-output-to-string + (*standard-output*) + (write-string "-=|!" nil)) + "-=|!") + +;;; Specialized string tests + +(deftest write-string.13 + (let (result) + (do-special-strings + (s "abcde" nil) + (assert (equal + (with-output-to-string + (*standard-output*) + (setq result (multiple-value-list (write-string "abcde")))) + "abcde")) + (assert (equal result '("abcde"))))) + nil) + +;;; Error tests + +(deftest write-string.error.1 + (signals-error (write-string) program-error) + t) + +(deftest write-string.error.2 + (signals-error (write-string "" *standard-output* :start) program-error) + t) + +(deftest write-string.error.3 + (signals-error (write-string "" *standard-output* :foo nil) program-error) + t) + +(deftest write-string.error.4 + (signals-error (write-string "" *standard-output* + :allow-other-keys nil + :foo nil) + program-error) + t) diff --git a/bfdtest.c b/bfdtest.c new file mode 100644 index 0000000..ad3d657 --- /dev/null +++ b/bfdtest.c @@ -0,0 +1,418 @@ +#define IN_GCC +#include +#include +#include +#include + +static bfd *exe_bfd = NULL; +struct bfd_link_info link_info; + +int build_symbol_table_bfd ( char *oname ) { + + int u,v; + asymbol **q; + + if ( ! ( exe_bfd = bfd_openr ( oname, 0 ) ) ) { + fprintf ( stderr, "Cannot open self.\n" ); + exit ( 0 ); + } + + if ( ! bfd_check_format ( exe_bfd, bfd_object ) ) { + fprintf ( stderr, "I'm not an object.\n" ); + exit ( 0 ); + } + + if (!(link_info.hash = bfd_link_hash_table_create (exe_bfd))) { + fprintf ( stderr, "Cannot make hash table.\n" ); + exit ( 0 ); + } + + if (!bfd_link_add_symbols(exe_bfd,&link_info)) { + fprintf ( stderr, "Cannot add self symbols\n.\n" ); + exit ( 0 ); + } + + if ((u=bfd_get_symtab_upper_bound(exe_bfd))<0) { + fprintf ( stderr, "Cannot get self's symtab upper bound.\n" ); + exit ( 0 ); + } + + fprintf ( stderr, "Allocating symbol table (%d bytes)\n", u ); + q = (asymbol **) malloc ( u ); + + if ( ( v = bfd_canonicalize_symtab ( exe_bfd, q ) ) < 0 ) { + fprintf ( stderr, "Cannot canonicalize self's symtab.\n" ); + exit ( 0 ); + } + +#ifdef _WIN32 + for ( u=0; u < v; u++ ) { + char *c; + if ( ( c = (char *) strstr ( q[u]->name, "_" ) ) ) { + struct bfd_link_hash_entry *h; + if ( ! ( h = bfd_link_hash_lookup ( link_info.hash, q[u]->name, true, true, true ) ) ) + fprintf ( stderr, "Cannot make new hash entry.\n" ); + h->type=bfd_link_hash_defined; + if ( !q[u]->section ) + fprintf ( stderr, "Symbol is missing section.\n" ); + h->u.def.value = q[u]->value + q[u]->section->vma; + h->u.def.section = q[u]->section; + fprintf ( stderr, "Processed %s\n", q[u]->name ); + } + } +#else + for (u=0;uname,"@@GLIBC\n" ))) { + struct bfd_link_hash_entry *h; + *c=0; + if (!(h=bfd_link_hash_lookup(link_info.hash,q[u]->name,true,true,true))) + fprintf ( stderr, "Cannot make new hash entry.\n" ); + h->type=bfd_link_hash_defined; + if (!q[u]->section) + fprintf ( stderr, "Symbol is missing section.\n" ); + h->u.def.value=q[u]->value+q[u]->section->vma; + h->u.def.section=q[u]->section; + *c='@'; + } + } +#endif + bfd_close ( exe_bfd ); + free(q); + return 0; + +} + + +/* align for power of two n */ +static void * + round_up(void *address, unsigned long n) +{ + fprintf ( stderr, "round_up: address = %d, n = %d, returning %d\n", + address, n, (void *)(((unsigned long)address + n -1) & ~(n-1)) ); + fflush ( stderr ); + return (void *)(((unsigned long)address + n -1) & ~(n-1)) ; +} +#define ROUND_UP(a,b) round_up(a,b) + + +static boolean + madd_archive_element (struct bfd_link_info * link_info, + bfd *abfd, + const char *name) { + fprintf ( stderr, "madd_archive_element\n"); + return false; + + } + +static boolean + mmultiple_definition (struct bfd_link_info * link_info, + const char *name, + bfd *obfd, + asection *osec, + bfd_vma oval, + bfd *nbfd, + asection *nsec, + bfd_vma nval) { + + fprintf ( stderr, "mmultiple_definition\n"); + return false; + + } + +static boolean + mmultiple_common (struct bfd_link_info * link_info, + const char *name, + bfd *obfd, + enum bfd_link_hash_type otype, + bfd_vma osize, + bfd *nbfd, + enum bfd_link_hash_type ntype, + bfd_vma nsize) { + + fprintf ( stderr, " mmultiple_common\n"); + return false; + + } + +static boolean + madd_to_set (struct bfd_link_info * link_info, + struct bfd_link_hash_entry *entry, + bfd_reloc_code_real_type reloc, + bfd *abfd, asection *sec, bfd_vma value) { + + fprintf ( stderr, "madd_to_set\n"); + return false; + + } + +static boolean + mconstructor (struct bfd_link_info * link_info,boolean constructor, + const char *name, bfd *abfd, asection *sec, + bfd_vma value) { + + fprintf ( stderr, "mconstructor\n"); + return false; + + } + +static boolean + mwarning (struct bfd_link_info * link_info, + const char *warning, const char *symbol, + bfd *abfd, asection *section, + bfd_vma address) { + + fprintf ( stderr, "mwarning\n"); + return false; + + } + +static boolean + mundefined_symbol (struct bfd_link_info * link_info, + const char *name, bfd *abfd, + asection *section, + bfd_vma address, + boolean fatal) { + + printf("mundefined_symbol %s is undefined\n",name); + return false; + } + +static boolean + mreloc_overflow (struct bfd_link_info * link_info, + const char *name, + const char *reloc_name, bfd_vma addend, + bfd *abfd, asection *section, + bfd_vma address) { + + printf("mreloc_overflow reloc for %s is overflowing\n",name); + return false; + + } + +static boolean + mreloc_dangerous (struct bfd_link_info * link_info, + const char *message, + bfd *abfd, asection *section, + bfd_vma address) { + + printf("mreloc_dangerous reloc is dangerous %s\n",message); + return false; + + } + +static boolean + munattached_reloc (struct bfd_link_info * link_info, + const char *name, + bfd *abfd, asection *section, + bfd_vma address) { + + fprintf ( stderr, " munattached_reloc\n"); + return false; + + } + +static boolean + mnotice (struct bfd_link_info * link_info, const char *name, + bfd *abfd, asection *section, bfd_vma address) { + + fprintf ( stderr, "mnotice\n"); + return false; + + } + + +int main ( int argc, char ** argv ) +{ + int init_address=-1; + int max_align = 0; + unsigned long curr_size = 0; + bfd *obj_bfd = NULL; + bfd_error_type myerr; + unsigned u = 0, v = 0; + asymbol **q = NULL; + asection *s = NULL; + static struct bfd_link_callbacks link_callbacks; + static struct bfd_link_order link_order; + + void *current = NULL; + void *cfd_self = NULL; + void *cfd_start = NULL; + int cfd_size = 0; + void *the_start = NULL; + void *start_address = NULL; + void *m = NULL; + + fprintf ( stderr, "In BFD fast load test.\n" ); + if ( argc < 3 ) { + fprintf ( stderr, "Need an executable and an object file as arguments.\n" ); + } else { + + memset ( &link_info, 0, sizeof (link_info) ); + memset ( &link_order, 0, sizeof (link_order) ); + memset ( &link_callbacks, 0, sizeof (link_callbacks) ); + + + bfd_init(); + + fprintf ( stderr, "BUILDING EXECUTABLE SYMBOL TABLE (ARGV[1]) \n\n" ); + build_symbol_table_bfd ( argv[1] ); + + link_callbacks.add_archive_element=madd_archive_element; + link_callbacks.multiple_definition=mmultiple_definition; + link_callbacks.multiple_common=mmultiple_common; + link_callbacks.add_to_set=madd_to_set; + link_callbacks.constructor=mconstructor; + link_callbacks.warning=mwarning; + link_callbacks.undefined_symbol=mundefined_symbol; + link_callbacks.reloc_overflow=mreloc_overflow; + link_callbacks.reloc_dangerous=mreloc_dangerous; + link_callbacks.unattached_reloc=munattached_reloc; + link_callbacks.notice = mnotice; + link_info.callbacks = &link_callbacks; + link_order.type = bfd_indirect_link_order; + + if ( ! ( obj_bfd = bfd_openr ( argv[2], 0 ) ) ) { + fprintf ( stderr, "Cannot open bfd.\n" ); + } + + if ( ( myerr = bfd_get_error () ) && myerr != 3 ) { + fprintf ( stderr, "Unknown bfd error code on openr %s %d\n.", argv[2], myerr ); + } + fflush ( stderr ); + if ( ! bfd_check_format ( obj_bfd, bfd_object ) ) { + fprintf ( stderr, "Unknown bfd format %s.\n", argv[2] ); + } + + if ( ( myerr = bfd_get_error () ) && myerr != 3 ) { + fprintf ( stderr, "Unknown bfd error code on check_format %s\n", argv[2] ); + } + + bfd_set_error(0); + + current = NULL; + + fprintf ( stderr, "CALCULATING CURRENT, MAX_ALIGN and ALLOCATING \n\n" ); + + for ( s= obj_bfd->sections;s;s=s->next) { + + s->owner = obj_bfd; + s->output_section = ( s->flags & SEC_ALLOC) ? s : obj_bfd->sections; + s->output_offset=0; + + if (!(s->flags & SEC_ALLOC)) + continue; + + if (max_alignalignment_power) + max_align=s->alignment_power; + + current=round_up(current,1<alignment_power); + + current+=s->_raw_size; + + fprintf ( stderr, "Section %s: owner = %x, output_offset = %x, output_section = %x (%s)\n", + s->name, s->owner, s->output_offset, s->output_section, s->output_section->name ); + } + + fprintf ( stderr, "1\n"); + curr_size=(unsigned long)current; + max_align=1< sizeof(char *) ? max_align :0); + + cfd_start = (void *) malloc ( cfd_size ); + the_start = start_address = cfd_start; + + fprintf ( stderr, "ALLOCATED %d bytes \n\n", cfd_size ); + fprintf ( stderr, + "max_align = %d, current = %d, cfd_self = %x, " + "cfd_size = %x, cfd_start = %x\n", + max_align, current, cfd_self, cfd_size, cfd_start ); + + start_address = ROUND_UP ( start_address, max_align ); + cfd_size = cfd_size - ( start_address - the_start ); + cfd_start = (void *) start_address; + + fprintf ( stderr, + "max_align = %d, current = %d, cfd_self = %x, " + "cfd_size = %x, cfd_start = %x\n", + max_align, current, cfd_self, cfd_size, cfd_start ); + + memset ( cfd_start, 0, cfd_size ); + + for ( m = start_address, s = obj_bfd->sections; s; s=s->next ) { + + if (!(s->flags & SEC_ALLOC)) + continue; + + m=round_up(m,1<alignment_power); + s->output_section->vma=(unsigned long)m; + m+=s->_raw_size; + fprintf ( stderr, "Section address %x\n", s ); + fprintf ( stderr, "m loop Section %s: owner = %x, output_offset = %x, " + "output_section = %x (%s), vma = %x, m = %x\n", + s->name, s->owner, s->output_offset, s->output_section, s->output_section->name, + s->output_section->vma, m ); + + } + + fprintf ( stderr, "\n\nDOING SOMETHING WITH THE HASHED SYMBOLS\n\n" ); + if ((u=bfd_get_symtab_upper_bound(obj_bfd))<0) + fprintf ( stderr, "Cannot get symtab uppoer bound.\n" ); + q = (asymbol **) alloca ( u ); + if ( ( v = bfd_canonicalize_symtab ( obj_bfd, q ) ) < 0 ) + fprintf ( stderr, "cannot canonicalize symtab.\n" ); + fprintf ( stderr, "u = %d, v = %d\n", u, v ); + for (u=0;uname = %s\n", u, q[u]->name ); + + if (!strncmp("init_",q[u]->name,5)) { + init_address=q[u]->value; + continue; + } + + if (!(h=bfd_link_hash_lookup(link_info.hash,q[u]->name, false, false, true))) + continue; + + if (h->type!=bfd_link_hash_defined) + fprintf ( stderr, "Undefined symbol.\n" ); + + if (h->u.def.section) { + q[u]->value=h->u.def.value+h->u.def.section->vma; + q[u]->flags|=BSF_WEAK; + } else + fprintf ( stderr, "Symbol without section.\n" ); + + } + + fprintf ( stderr, "\n\nDOING RELOCATIONS\n\n", cfd_size ); + fflush ( stderr ); + for ( s = obj_bfd->sections; s; s = s->next ) { + + fprintf ( stderr, "s->name %s, s->flags = %x\n", s->name, s->flags ); + if ( ! ( s->flags & SEC_LOAD ) ) + continue; + + link_order.u.indirect.section=s; + + fprintf ( stderr, "About to get reloc section contents\n" ); + + fprintf ( stderr, "obj_bfd = %x, section %s, s->output_section = %x, q = %x\n", + obj_bfd, s->name, s->output_section, q); + + fflush ( stderr ); + if (!bfd_get_relocated_section_contents(obj_bfd, &link_info,&link_order, + (void *)(unsigned long)s->output_section->vma,0,q)) + fprintf ( stderr, "Cannot get relocated section contents\n"); + + } + + bfd_close ( obj_bfd ); + printf("start address -T %x \n", cfd_start); + } +} diff --git a/bin/.gitignore b/bin/.gitignore new file mode 100644 index 0000000..0fdabe7 --- /dev/null +++ b/bin/.gitignore @@ -0,0 +1,4 @@ +append +dpp +file-sub +gcl diff --git a/bin/append.c b/bin/append.c new file mode 100755 index 0000000..4712e10 --- /dev/null +++ b/bin/append.c @@ -0,0 +1,35 @@ +#include +/* usage: append a b c + equivalent to cat a b >> c + if only cat were binary... but by some wonderful dos like deicision, + it is not under cygnus.. + */ +int +main(int argc,char *argv[]) +{ int i; + FILE *out ; + if (argc < 2) return 0; + out = fopen(argv[argc-1],"a+b"); + if (out == 0) + { perror("cant open"); return 1; } + for (i=1; i < argc-1 ; i++) + { + FILE *fp = fopen(argv[i],"rb"); + int ch; + if (fp == 0) + { perror("cant open"); return 1; } + while (1) { + ch =getc(fp); + if (ch == EOF && feof(fp)) + { fclose(fp); + break; + } else + putc(ch,out); + + } + } + fclose(out); + return 0; +} + + diff --git a/bin/dpp.c b/bin/dpp.c new file mode 100755 index 0000000..6d3f657 --- /dev/null +++ b/bin/dpp.c @@ -0,0 +1,681 @@ +/* + dpp.c + + defun preprocessor +*/ + +/* + Usage: + dpp file + + The file named file.d is preprocessed and the output will be + written to the file whose name is file.c. + + + ;changes: remove \n from beginning of main output so debuggers + can find the right foo.d source file name.--wfs + ;add \" to the line output for ansi C --wfs + + The function definition: + + @(defun name ({var}* + [&optional {var | (var [initform [svar]])}*] + [&rest] + [&key {var | + ({var | (keyword var)} [initform [svar]])}* + [&allow_other_keys]] + [&aux {var | (var [initform])}*]) + + C-declaration + + @ + + C-body + + @) + + &optional may be abbreviated as &o. + &rest may be abbreviated as &r. + &key may be abbreviated as &k. + &allow_other_keys may be abbreviated as &aok. + &aux may be abbreviated as &a. + + Each variable becomes a macro name + defined to be an expression of the form + vs_base[...]. + + Each supplied-p parameter becomes a boolean C variable. + + Initforms are C expressions. + It an expression contain non-alphanumeric characters, + it should be surrounded by backquotes (`). + + + Function return: + + @(return {form}*) + + It becomes a C block. + +*/ + +#include +#include +#include + +#include "gclincl.h" +#include "config.h" + +#ifdef UNIX +#include +#define isalphanum(c) isalnum(c) +#endif + +#define POOLSIZE 2048 +#define MAXREQ 16 +#define MAXOPT 16 +#define MAXKEY 16 +#define MAXAUX 16 +#define MAXRES 16 + +#define TRUE 1 +#define FALSE 0 + +typedef int bool; + +FILE *in, *out; + +char filename[BUFSIZ]; +int line; +int tab; +int tab_save; + +char pool[POOLSIZE]; +char *poolp; + +char *function; +int fstatic; + +char *required[MAXREQ]; +int nreq; + +struct optional { + char *o_var; + char *o_init; + char *o_svar; +} optional[MAXOPT]; +int nopt; + +bool rest_flag; + +bool key_flag; +struct keyword { + char *k_key; + char *k_var; + char *k_init; + char *k_svar; +} keyword[MAXKEY]; +int nkey; +bool allow_other_keys_flag; + +struct aux { + char *a_var; + char *a_init; +} aux[MAXAUX]; +int naux; + +char *result[MAXRES]; +int nres; + +void +error(s) +char *s; +{ + printf("Error in line %d: %s.\n", line, s); + exit(0); +} + +int +readc() +{ + int c; + + c = getc(in); + if (feof(in)) { + if (function != NULL) + error("unexpected end of file"); + exit(0); + } + if (c == '\n') { + line++; + tab = 0; + } else if (c == '\t') + tab++; + return(c); +} + +int +nextc() +{ + int c; + + while (isspace(c = readc())) + ; + return(c); +} + +void +unreadc(c) +int c; +{ + if (c == '\n') + --line; + else if (c == '\t') + --tab; + ungetc(c, in); +} + +void +put_tabs(n) +int n; +{ + int i; + + for (i = 0; i < n; i++) + putc('\t', out); +} + +void +pushc(c) +int c; +{ + if (poolp >= &pool[POOLSIZE]) + error("buffer bool overflow"); + *poolp++ = c; +} + +char * +read_token() +{ + int c; + char *p; + + p = poolp; + if ((c = nextc()) == '`') { + while ((c = readc()) != '`') + pushc(c); + pushc('\0'); + return(p); + } + do + pushc(c); + while (isalphanum(c = readc()) || c == '_'); + pushc('\0'); + unreadc(c); + return(p); +} + +void +reset() +{ + int i; + + poolp = pool; + function = NULL; + nreq = 0; + for (i = 0; i < MAXREQ; i++) + required[i] = NULL; + nopt = 0; + for (i = 0; i < MAXOPT; i++) + optional[i].o_var + = optional[i].o_init + = optional[i].o_svar + = NULL; + rest_flag = FALSE; + key_flag = FALSE; + nkey = 0; + for (i = 0; i < MAXKEY; i++) + keyword[i].k_key + = keyword[i].k_var + = keyword[i].k_init + = keyword[i].k_svar + = NULL; + allow_other_keys_flag = FALSE; + naux = 0; + for (i = 0; i < MAXAUX; i++) + aux[i].a_var + = aux[i].a_init + = NULL; +} + +void +get_function() +{ + function = read_token(); +} + +void +get_lambda_list() +{ + int c; + char *p; + + if ((c = nextc()) != '(') + error("( expected"); + for (;;) { + if ((c = nextc()) == ')') + return; + if (c == '&') { + p = read_token(); + goto OPTIONAL; + } + unreadc(c); + p = read_token(); + if (nreq >= MAXREQ) + error("too many required variables"); + required[nreq++] = p; + } + +OPTIONAL: + if (strcmp(p, "optional") != 0 && strcmp(p, "o") != 0) + goto REST; + for (;; nopt++) { + if ((c = nextc()) == ')') + return; + if (c == '&') { + p = read_token(); + goto REST; + } + if (nopt >= MAXOPT) + error("too many optional argument"); + if (c == '(') { + optional[nopt].o_var = read_token(); + if ((c = nextc()) == ')') + continue; + unreadc(c); + optional[nopt].o_init = read_token(); + if ((c = nextc()) == ')') + continue; + unreadc(c); + optional[nopt].o_svar = read_token(); + if (nextc() != ')') + error(") expected"); + } else { + unreadc(c); + optional[nopt].o_var = read_token(); + } + } + +REST: + if (strcmp(p, "rest") != 0 && strcmp(p, "r") != 0) + goto KEYWORD; + rest_flag = TRUE; + if ((c = nextc()) == ')') + return; + if (c != '&') + error("& expected"); + p = read_token(); + goto KEYWORD; + +KEYWORD: + if (strcmp(p, "key") != 0 && strcmp(p, "k") != 0) + goto AUX_L; + key_flag = TRUE; + for (;; nkey++) { + if ((c = nextc()) == ')') + return; + if (c == '&') { + p = read_token(); + if (strcmp(p, "allow_other_keys") == 0 || + strcmp(p, "aok") == 0) { + allow_other_keys_flag = TRUE; + if ((c = nextc()) == ')') + return; + if (c != '&') + error("& expected"); + p = read_token(); + } + goto AUX_L; + } + if (nkey >= MAXKEY) + error("too many optional argument"); + if (c == '(') { + if ((c = nextc()) == '(') { + p = read_token(); + if (p[0] != ':' || p[1] == '\0') + error("keyword expected"); + keyword[nkey].k_key = p + 1; + keyword[nkey].k_var = read_token(); + if (nextc() != ')') + error(") expected"); + } else { + unreadc(c); + keyword[nkey].k_key + = keyword[nkey].k_var + = read_token(); + } + if ((c = nextc()) == ')') + continue; + unreadc(c); + keyword[nkey].k_init = read_token(); + if ((c = nextc()) == ')') + continue; + unreadc(c); + keyword[nkey].k_svar = read_token(); + if (nextc() != ')') + error(") expected"); + } else { + unreadc(c); + keyword[nkey].k_key + = keyword[nkey].k_var + = read_token(); + } + } + +AUX_L: + if (strcmp(p, "aux") != 0 && strcmp(p, "a") != 0) + error("illegal lambda-list keyword"); + for (;;) { + if ((c = nextc()) == ')') + return; + if (c == '&') + error("illegal lambda-list keyword"); + if (naux >= MAXAUX) + error("too many auxiliary variable"); + if (c == '(') { + aux[naux].a_var = read_token(); + if ((c = nextc()) == ')') + continue; + unreadc(c); + aux[naux].a_init = read_token(); + if (nextc() != ')') + error(") expected"); + } else { + unreadc(c); + aux[naux].a_var = read_token(); + } + naux++; + } +} + +void +get_return() +{ + int c; + + nres = 0; + for (;;) { + if ((c = nextc()) == ')') + return; + unreadc(c); + result[nres++] = read_token(); + } +} + +void +put_fhead() +{ +#ifdef STATIC_FUNCTION_POINTERS + fprintf(out, "static void L%s_static ();\n",function); + if (!fstatic) + fprintf(out,"void\nL%s()\n{ L%s_static();}\n\n",function,function); + fprintf(out,"static void\nL%s_static()\n{",function); +#else + fprintf(out, "%svoid\nL%s()\n{", fstatic ? "static " : "",function); +#endif +} + +void +put_declaration() +{ + int i; + + if (nopt || rest_flag || key_flag) + fprintf(out, "\tint narg;\n"); + fprintf(out, "\tregister object *DPPbase=vs_base;\n"); + + for (i = 0; i < nopt; i++) + if (optional[i].o_svar != NULL) + fprintf(out, "\tbool %s;\n", + optional[i].o_svar); + for (i = 0; i < nreq; i++) + fprintf(out, "#define\t%s\tDPPbase[%d]\n", + required[i], i); + for (i = 0; i < nopt; i++) + fprintf(out, "#define\t%s\tDPPbase[%d+%d]\n", + optional[i].o_var, nreq, i); + for (i = 0; i < nkey; i++) + fprintf(out, "#define\t%s\tDPPbase[%d+%d+%d]\n", + keyword[i].k_var, nreq, nopt, i); + for (i = 0; i < nkey; i++) + if (keyword[i].k_svar != NULL) + fprintf(out, "\tbool %s;\n", keyword[i].k_svar); + for (i = 0; i < naux; i++) + fprintf(out, "#define\t%s\tDPPbase[%d+%d+2*%d+%d]\n", + aux[i].a_var, nreq, nopt, nkey, i); + fprintf(out, "\n"); + if (nopt == 0 && !rest_flag && !key_flag) + fprintf(out, "\tcheck_arg(%d);\n", nreq); + else { + fprintf(out, "\tnarg = vs_top - vs_base;\n"); + fprintf(out, "\tif (narg < %d)\n", nreq); + fprintf(out, "\t\ttoo_few_arguments();\n"); + } + for (i = 0; i < nopt; i++) + if (optional[i].o_svar != NULL) { + fprintf(out, "\tif (narg > %d + %d)\n", + nreq, i); + fprintf(out, "\t\t%s = TRUE;\n", + optional[i].o_svar); + fprintf(out, "\telse {\n"); + fprintf(out, "\t\t%s = FALSE;\n", + optional[i].o_svar); + fprintf(out, "\t\tvs_push(%s);\n", + optional[i].o_init); + fprintf(out, "\t\tnarg++;\n"); + fprintf(out, "\t}\n"); + } else if (optional[i].o_init != NULL) { + fprintf(out, "\tif (narg <= %d + %d) {\n", + nreq, i); + fprintf(out, "\t\tvs_push(%s);\n", + optional[i].o_init); + fprintf(out, "\t\tnarg++;\n"); + fprintf(out, "\t}\n"); + } else { + fprintf(out, "\tif (narg <= %d + %d) {\n", + nreq, i); + fprintf(out, "\t\tvs_push(Cnil);\n"); + fprintf(out, "\t\tnarg++;\n"); + fprintf(out, "\t}\n"); + } + if (nopt > 0 && !key_flag && !rest_flag) { + fprintf(out, "\tif (narg > %d + %d)\n", nreq, nopt); + fprintf(out, "\t\ttoo_many_arguments();\n"); + } + if (key_flag) { + fprintf(out, "\tparse_key(vs_base+%d+%d,FALSE, %s, %d,\n", + nreq, nopt, + allow_other_keys_flag ? "TRUE" : "FALSE", nkey); + if (nkey > 0) { + i = 0; + for (;;) { + fprintf(out, "\t\tsK%s", keyword[i].k_key); + if (++i == nkey) { + fprintf(out, ");\n"); + break; + } else + fprintf(out, ",\n"); + } + } else + fprintf(out, "\t\tCnil);"); + fprintf(out, "\tvs_top = vs_base + %d+%d+2*%d;\n", + nreq, nopt, nkey); + for (i = 0; i < nkey; i++) { + if (keyword[i].k_init == NULL) + continue; + fprintf(out, "\tif (vs_base[%d+%d+%d+%d]==Cnil)\n", + nreq, nopt, nkey, i); + fprintf(out, "\t\t%s = %s;\n", + keyword[i].k_var, keyword[i].k_init); + } + for (i = 0; i < nkey; i++) + if (keyword[i].k_svar != NULL) + fprintf(out, + "\t%s = vs_base[%d+%d+%d+%d] != Cnil;\n", + keyword[i].k_svar, nreq, nopt, nkey, i); + } + for (i = 0; i < naux; i++) + if (aux[i].a_init != NULL) + fprintf(out, "\tvs_push(%s);\n", aux[i].a_init); + else + fprintf(out, "\tvs_push(Cnil);\n"); +} + +void +put_ftail() +{ + int i; + + for (i = 0; i < nreq; i++) + fprintf(out, "#undef %s\n", required[i]); + for (i = 0; i < nopt; i++) + fprintf(out, "#undef %s\n", optional[i].o_var); + for (i = 0; i < nkey; i++) + fprintf(out, "#undef %s\n", keyword[i].k_var); + for (i = 0; i < naux; i++) + fprintf(out, "#undef %s\n", aux[i].a_var); + fprintf(out, "}"); +} + +void +put_return() +{ + int i, t; + + t = tab_save + 1; + if (nres == 0) { + fprintf(out, "{\n"); + put_tabs(t); + fprintf(out, "vs_top = vs_base;\n"); + put_tabs(t); + fprintf(out, "vs_base[0] = Cnil;\n"); + put_tabs(t); + fprintf(out, "return;\n"); + put_tabs(tab_save); + fprintf(out, "}"); + } else if (nres == 1) { + fprintf(out, "{\n"); + put_tabs(t); + fprintf(out, "vs_base[0] = %s;\n", result[0]); + put_tabs(t); + fprintf(out, "vs_top = vs_base + 1;\n"); + put_tabs(t); + fprintf(out, "return;\n"); + put_tabs(tab_save); + fprintf(out, "}"); + } else { + fprintf(out, "{\n"); + for (i = 0; i < nres; i++) { + put_tabs(t); + fprintf(out, "object R%d;\n", i); + } + for (i = 0; i < nres; i++) { + put_tabs(t); + fprintf(out, "R%d = %s;\n", i, result[i]); + } + for (i = 0; i < nres; i++) { + put_tabs(t); + fprintf(out, "vs_base[%d] = R%d;\n", i, i); + } + put_tabs(t); + fprintf(out, "vs_top = vs_base + %d;\n", nres); + put_tabs(t); + fprintf(out, "return;\n"); + put_tabs(tab_save); + fprintf(out, "}"); + } +} + +void +main_loop() +{ + int c; + char *p; + + line = 1; + fprintf(out, "# line %d \"%s\"\n", line, filename); +LOOP: + reset(); + fprintf(out, "\n# line %d \"%s\"\n", line, filename); + while ((c = readc()) != '@') + putc(c, out); + if (readc() != '(') + error("@( expected"); + p = read_token(); + fstatic=0; + if (strcmp(p, "static") == 0) { + fstatic=1; + p = read_token(); + } + if (strcmp(p, "defun") == 0) { + get_function(); + get_lambda_list(); + put_fhead(); + fprintf(out, "\n# line %d \"%s\"\n", line, filename); + while ((c = readc()) != '@') + putc(c, out); + put_declaration(); + + BODY: + fprintf(out, "\n# line %d \"%s\"\n", line, filename); + while ((c = readc()) != '@') + putc(c, out); + if ((c = readc()) == ')') { + put_ftail(); + goto LOOP; + } else if (c != '(') + error("@( expected"); + p = read_token(); + if (strcmp(p, "return") == 0) { + tab_save = tab; + get_return(); + put_return(); + goto BODY; + } else + error("illegal symbol"); + } else + error("illegal symbol"); +} + +int +main(argc, argv) +int argc; +char **argv; +{ + char *p, *q; + + if (argc != 2) + error("arg count"); + for (p = argv[1], q = filename; *p != '\0'; p++, q++) + if (q >= &filename[BUFSIZ-3]) + error("too long file name"); + else + *q = *p; + q[0] = '.'; + q[1] = 'd'; + q[2] = '\0'; + in = fopen(filename, "r"); + if (in == NULL) + error("can't open input file"); + q[1] = 'c'; + out = fopen(filename, "w"); + if (out == NULL) + error("can't open output file"); + q[1] = 'd'; + printf("dpp: %s -> ", filename); + q[1] = 'c'; + printf("%s\n", filename); + q[1] = 'd'; + main_loop(); + return 0; +} diff --git a/bin/file-sub.c b/bin/file-sub.c new file mode 100644 index 0000000..e6dbb90 --- /dev/null +++ b/bin/file-sub.c @@ -0,0 +1,71 @@ +/* + +# Substitute the region between BEGIN and END in FILE1 into FILE2 + + */ + +#include +#include +#include + +void scanCopyToLine(FILE *fp, char *line,FILE *outstream); + +int +main(int argc,char *argv[]) +{ + if (argc < 5) + { + ERROR: + fprintf(stderr,"Usage: file-sub subFile FileToSubInto BEGIN END [outfile -]"); + exit(1); + } + { + FILE *file1; + FILE *file2; + FILE *outstream = stdout; + char *begin=argv[3]; + char *end=argv[4]; + + file2= fopen(argv[2],"rb"); + file1= fopen(argv[1],"rb"); + if (argc>=6 && strcmp(argv[5],"-")!=0) { + outstream= fopen(argv[5],"wb"); + } + + if (file1==0 || file2==0) goto ERROR; + { + scanCopyToLine(file2,begin,outstream); + scanCopyToLine(file1,begin,0); + scanCopyToLine(file1,end,outstream); + scanCopyToLine(file2,end,0); + scanCopyToLine(file2,0,outstream); + } + if (outstream != stdout) fclose(outstream); + } + + return 0; +} + + + + +/* copy from fp to outstream all lines up to and including + one beginning with LINE +*/ +void +scanCopyToLine(FILE *fp, char *line,FILE *outstream) +{ + int length=0; + int finish=0; + char buf[5000]; + if (line) length = strlen(line); + while (!finish && !feof(fp)) { + char *s = fgets(buf,sizeof(buf),fp); + if (line && s && strncmp(line,s,length)==0) { + finish=1; + } + if (s && outstream) + fputs(s,outstream); + } + +} diff --git a/bin/info b/bin/info new file mode 100755 index 0000000..0ce4b37 --- /dev/null +++ b/bin/info @@ -0,0 +1,3 @@ +#!/bin/sh +gcl -batch -eval '(si::error-set (quote (progn (tk::tkconnect :args "-geometry 20x20-2+2")(tk::wm :iconify ".")(si::info '\"$1\"')(tk::bind (quote .info) "" (quote (bye)))(read))))' + diff --git a/bin/info1 b/bin/info1 new file mode 100755 index 0000000..a7f6183 --- /dev/null +++ b/bin/info1 @@ -0,0 +1,13 @@ +#!/usr/local/bin/gcl.exe -f +(si::error-set + '(progn + (tk::tkconnect :args + "-geometry 20x20-2+2") + (tk::wm :iconify ".") + (si::info (nth 1 SYSTEM::*COMMAND-ARGS*)) + (tk::bind (quote .info) + "" + (quote (bye))) + + (read))) + diff --git a/bin/makefile b/bin/makefile new file mode 100644 index 0000000..f856465 --- /dev/null +++ b/bin/makefile @@ -0,0 +1,19 @@ +DEFS = -I../h +CC = cc +APPEND = ../bin/append + +-include ../makedefs + +all: dpp${EXE} ${APPEND}${EXE} file-sub${EXE} + +dpp${EXE}: dpp.c + ${CC} ${DEFS} -o dpp${EXE} dpp.c + +file-sub${EXE}: file-sub.c + ${CC} ${DEFS} -o file-sub${EXE} file-sub.c + +${APPEND}${EXE}: append.c + ${CC} ${DEFS} -o append${EXE} append.c + +clean: + rm -f dpp${EXE} append${EXE} file-sub${EXE} core a.out *.o gcl gclm.bat diff --git a/bin/tkinfo b/bin/tkinfo new file mode 100755 index 0000000..97a5446 --- /dev/null +++ b/bin/tkinfo @@ -0,0 +1,19 @@ +#!/home/wfs/bin/gcl -f +(in-package "SI") +(setq *load-verbose* nil) +(tkconnect) +(tk::wm :iconify ".") +(offer-choices + (sloop::sloop for v in (cdr si::*command-args*) + appending (info-aux v *default-info-files*)) + *default-info-files*) +(tk::bind '.info "" '(bye)) +(read) + + + + + + + + diff --git a/clcs/.gitignore b/clcs/.gitignore new file mode 100644 index 0000000..de518a9 --- /dev/null +++ b/clcs/.gitignore @@ -0,0 +1,3 @@ +*.c +*.h +saved_clcs_gcl diff --git a/clcs/gcl_clcs_condition_definitions.lisp b/clcs/gcl_clcs_condition_definitions.lisp new file mode 100755 index 0000000..8367016 --- /dev/null +++ b/clcs/gcl_clcs_condition_definitions.lisp @@ -0,0 +1,145 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: "CONDITIONS"; Base: 10 -*- + +(IN-PACKAGE :CONDITIONS) + +(define-condition warning (condition) nil) +(define-condition style-warning (warning) nil) + +(define-condition serious-condition (condition) nil) +(define-condition error (serious-condition) nil) + +(define-condition simple-condition (condition) + ((format-control :type string + :initarg :format-control + :reader simple-condition-format-control + :initform "") + (format-arguments :initarg :format-arguments + :reader simple-condition-format-arguments + :initform nil)) + (:report (lambda (c s) + (call-next-method) + (apply 'format s + (simple-condition-format-control c) + (simple-condition-format-arguments c))))) + +(define-condition simple-warning (simple-condition warning) nil) +(define-condition simple-error (simple-condition error) nil) + +(define-condition storage-condition (serious-condition) nil) +(define-condition stack-overflow (storage-condition) nil) +(define-condition storage-exhausted (storage-condition) nil) + +(define-condition type-error (error) + ((datum :initarg :datum + :reader type-error-datum) + (expected-type :initarg :expected-type + :reader type-error-expected-type)) + (:report ("~s is not of type ~s: " datum expected-type))) +(define-condition simple-type-error (simple-error type-error) nil) + +(define-condition program-error (error) nil) +(define-condition control-error (error) nil) +(define-condition parse-error (error) nil) + +(define-condition print-not-readable (error) + ((object :initarg :object + :reader print-not-readable-object)) + (:report ("Object ~s is unreadable: " object))) + +(define-condition stream-error (error) + ((stream :initarg :stream + :reader stream-error-stream)) + (:report ("Stream error on stream ~s: " stream))) + +(define-condition reader-error (parse-error stream-error) nil) + +(define-condition end-of-file (stream-error) + nil + (:report ("Unexpected end of file: "))) + +(define-condition file-error (error) + ((pathname :initarg :pathname + :reader file-error-pathname)) + (:report ("File error on ~s: " pathname))) + +(define-condition pathname-error (file-error) nil) + +(define-condition package-error (error) + ((package :initarg :package + :reader package-error-package)) + (:report ("Package error on ~s: " package))) + +(define-condition cell-error (error) + ((name :initarg :name + :reader cell-error-name)) + (:report ("Cell error on ~s: " name))) + +(define-condition unbound-variable (cell-error) + nil + (:report ("Unbound variable: "))) + +(define-condition unbound-slot (cell-error) + ((instance :initarg :instance + :reader unbound-slot-instance)) + (:report ("Slot is unbound in ~s: " instance))) + +(define-condition undefined-function (cell-error) + nil + (:report ("Undefined function: "))) + +(define-condition arithmetic-error (ERROR) + ((operation :initarg :operation + :reader arithmetic-error-operation) + (operands :initarg :operands + :reader arithmetic-error-operands)) + (:report ("~%Arithmetic error when performing ~s on ~s: " operation operands))) + +(define-condition division-by-zero (arithmetic-error) nil) +(define-condition floating-point-overflow (arithmetic-error) nil) +(define-condition floating-point-invalid-operation (arithmetic-error) nil) +(define-condition floating-point-inexact (arithmetic-error) nil) +(define-condition floating-point-underflow (arithmetic-error) nil) + +(define-condition case-failure (type-error) + ((name :initarg :name + :reader case-failure-name) + (possibilities :initarg :possibilities + :reader case-failure-possibilities)) + (:report + (lambda (condition stream) + (format stream "~s fell through ~s expression.~%wanted one of ~:s." + (type-error-datum condition) + (case-failure-name condition) + (case-failure-possibilities condition))))) + +(define-condition abort-failure (control-error) nil (:report "abort failed.")) + +(define-condition internal-condition (condition) + ((function-name :initarg :function-name + :reader internal-condition-function-name + :initform nil)) + (:report (lambda (condition stream) + (when (internal-condition-function-name condition) + (format stream "Condition in ~S [or a callee]: " + (internal-condition-function-name condition))) + (call-next-method)))) + +(define-condition internal-simple-condition (internal-condition simple-condition) nil) + +(define-condition internal-simple-error (internal-condition simple-error) nil) +(define-condition internal-simple-type-error (internal-condition simple-type-error) nil) +(define-condition internal-simple-warning (internal-condition simple-warning) nil) + +#.`(progn + ,@(mapcar (lambda (x) + `(define-condition + ,(intern (concatenate 'string "INTERNAL-SIMPLE-" (string x))) + (internal-condition simple-condition ,x) nil)) + `(stack-overflow storage-exhausted print-not-readable end-of-file style-warning + unbound-variable unbound-slot undefined-function division-by-zero + case-failure abort-failure + ,@(mapcar (lambda (x) (intern (concatenate 'string "FLOATING-POINT-" (string x)))) + '(overflow underflow invalid-operation inexact)) + ,@(mapcar (lambda (x) (intern (concatenate 'string (string x) "-ERROR"))) + '(program control parse stream reader file + package cell arithmetic pathname))))) diff --git a/clcs/gcl_clcs_conditions.lisp b/clcs/gcl_clcs_conditions.lisp new file mode 100755 index 0000000..c473060 --- /dev/null +++ b/clcs/gcl_clcs_conditions.lisp @@ -0,0 +1,85 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: "CONDITIONS"; Base: 10 -*- + +;(in-package "CONDITIONS" :USE '(:cl #+(and clos (not pcl)) "CLOS" #+pcl "PCL")) + +(in-package :conditions) + +(defun slot-sym (base slot) + (values (intern (concatenate 'string (string base) "-" (string slot))))) + +(defun coerce-to-fn (x y) + (cond ((stringp x) `(lambda (c s) (declare (ignore c)) (write-string ,x s))) + ((symbolp x) x) + ((atom x) nil) + ((eq (car x) 'lambda) x) + ((stringp (car x)) + `(lambda (c s) + (declare (ignorable c)) + (call-next-method) + (format s ,(car x) ,@(mapcar (lambda (st) `(if (slot-boundp c ',st) (,(slot-sym y st) c) 'unbound)) (cdr x))))))) + +(defun default-report (x) + `(lambda (c s) (call-next-method) (format s "~s " ',x))) + +(defmacro define-condition (name parent-list slot-specs &rest options) + (unless (or parent-list (eq name 'condition)) + (setq parent-list (list 'condition))) + (let* ((report-function nil) + (default-initargs nil) + (documentation nil)) + (do ((o options (cdr o))) + ((null o)) + (let ((option (car o))) + (case (car option) + (:report (setq report-function (coerce-to-fn (cadr option) name))) + (:default-initargs (setq default-initargs option)) + (:documentation (setq documentation (cadr option))) + (otherwise (cerror "ignore this define-condition option." + "invalid define-condition option: ~s" option))))) + `(progn + (eval-when (compile) + (setq pcl::*defclass-times* '(compile load eval))) + ,(if default-initargs + `(defclass ,name ,parent-list ,slot-specs ,default-initargs) + `(defclass ,name ,parent-list ,slot-specs)) + (eval-when (compile load eval) +; (setf (get ',name 'documentation) ',documentation) + (setf (get ',name 'si::s-data) nil)) + ,@(when report-function + `((defmethod print-object ((x ,name) stream) + (if *print-escape* + (call-next-method) + (,report-function x stream))))) + ',name))) + +(eval-when (compile load eval) + (define-condition condition nil nil)) + +(defmethod pcl::make-load-form ((object condition) &optional env) + (declare (ignore env)) + (error "~@" 'pcl::make-load-form object)) + +(mapc 'pcl::proclaim-incompatible-superclasses '((condition pcl::metaobject))) + +(defun conditionp (object) (typep object 'condition)) + +(defun is-condition (x) (conditionp x)) +(defun is-warning (x) (typep x 'warning)) + +(defmethod print-object ((x condition) stream) + (let ((y (class-name (class-of x)))) + (if *print-escape* + (format stream "#<~s.~d>" y (unique-id x)) + (format stream "~a: " y))));(type-of x) + +(defun make-condition (type &rest slot-initializations) + (when (and (consp type) (eq (car type) 'or)) + (return-from make-condition (apply 'make-condition (cadr type) slot-initializations)));FIXME + (unless (condition-class-p type) + (error 'simple-type-error + :datum type + :expected-type '(satisfies condition-class-p) + :format-control "not a condition type: ~s" + :format-arguments (list type))) + (apply 'make-instance type slot-initializations)) + diff --git a/clcs/gcl_clcs_handler.lisp b/clcs/gcl_clcs_handler.lisp new file mode 100755 index 0000000..9a5513f --- /dev/null +++ b/clcs/gcl_clcs_handler.lisp @@ -0,0 +1,39 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: "CONDITIONS"; Base: 10 -*- + +(in-package :conditions) + +(defmacro handler-bind (bindings &body forms) + (declare (optimize (safety 2))) + `(let ((*handler-clusters* (cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x))) bindings)) + *handler-clusters*))) + ,@forms)) + + +(defmacro handler-case (form &rest cases) + (declare (optimize (safety 2))) + (let ((no-error-clause (assoc ':no-error cases))) + (if no-error-clause + (let ((normal-return (gensym)) (error-return (gensym))) + `(block ,error-return + (multiple-value-call (lambda ,@(cdr no-error-clause)) + (block ,normal-return + (return-from ,error-return + (handler-case (return-from ,normal-return ,form) + ,@(remove no-error-clause cases))))))) + (let ((block (gensym))(var (gensym))(tcases (mapcar (lambda (x) (cons (gensym) x)) cases))) + `(block ,block + (let (,var) + (declare (ignorable ,var)) + (tagbody + (handler-bind ,(mapcar (lambda (x &aux (tag (pop x))(type (pop x))(ll (car x))) + (list type `(lambda (x) ,(if ll `(setq ,var x) `(declare (ignore x))) (go ,tag)))) + tcases) + (return-from ,block ,form)) + ,@(mapcan (lambda (x &aux (tag (pop x))(type (pop x))(ll (pop x))(body x)) + (list tag `(return-from ,block (let ,(when ll `((,(car ll) ,var))) ,@body)))) + tcases)))))))) + +(defmacro ignore-errors (&rest forms) + `(handler-case (progn ,@forms) + (error (condition) (values nil condition)))) + diff --git a/clcs/gcl_clcs_precom.lisp b/clcs/gcl_clcs_precom.lisp new file mode 100755 index 0000000..761607c --- /dev/null +++ b/clcs/gcl_clcs_precom.lisp @@ -0,0 +1,6 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: "CONDITIONS"; Base: 10 -*- + +(in-package "CONDITIONS" :USE '("LISP" #+(and clos (not pcl)) "CLOS" #+pcl "PCL")) + +#+pcl +(pcl::precompile-random-code-segments clcs) diff --git a/clcs/gcl_cmpinit.lsp b/clcs/gcl_cmpinit.lsp new file mode 100644 index 0000000..a242bb8 --- /dev/null +++ b/clcs/gcl_cmpinit.lsp @@ -0,0 +1,7 @@ +;(proclaim '(optimize (safety 2) (space 3))) + +(setq compiler::*eval-when-defaults* '(compile eval load)) +(setq compiler::*compile-ordinaries* t) +(if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp")) + +;;;;; diff --git a/clcs/loading.lisp b/clcs/loading.lisp new file mode 100755 index 0000000..d06e484 --- /dev/null +++ b/clcs/loading.lisp @@ -0,0 +1,26 @@ +(defun jamie-load-clcs (&optional (mode :compiled)) + (let ((files (list + ;"package" + "clcs_precom" + "clcs_macros" + "clcs_restart" + "clcs_handler" + "clcs_debugger" + "clcs_conditions" + "clcs_condition_definitions" + "clcs_kcl_cond" + "clcs_top_patches" + "clcs_install"))) +; (load "package.lisp") + (when (eql :compile mode) +; (load "package.lisp") + (load "clcs_precom.lisp")) + (mapc #'(lambda (file) + (ecase mode + (:interpreted (load (format nil "~A.lisp" file))) + (:compiled (load (format nil "~A.o" file))) + (:compile (compile-file (format nil "~A.lisp" file) :c-file t :h-file t :data-file t :system-p t)))) + files))) + + + diff --git a/clcs/makefile b/clcs/makefile new file mode 100644 index 0000000..9411ca3 --- /dev/null +++ b/clcs/makefile @@ -0,0 +1,37 @@ +-include ../makedefs + +COMPILE_FILE=./saved_clcs_gcl$(EXE) ./ -system-p -c-file -data-file \ + -o-file nil -h-file -compile + +FILES:=$(shell ls -1 gcl_clcs_*.lisp | sed 's,\.lisp,,1') + +all: $(addsuffix .c,$(FILES)) $(addsuffix .o,$(FILES)) + +saved_clcs_gcl: ../unixport/saved_pcl_gcl$(EXE) + echo '(load "package.lisp")(load "myload.lisp")(si::save-system "$@")' | $< $(| |top - base| + ("FEtoo_few_argumentsF" :too-few-arguments "Too few arguments." + internal-simple-control-error) ; || |args| + ("FEtoo_many_arguments" :too-many-arguments "~S [or a callee] requires less than ~R argument~:p." + internal-simple-control-error) ; || |top - base| + ("FEtoo_many_argumentsF" :too-many-arguments "Too many arguments." + internal-simple-control-error) ; || |args| + ("FEinvalid_macro_call" :invalid-form "Invalid macro call to ~S." + internal-simple-program-error) ; || + ("FEunexpected_keyword" :unexpected-keyword "~S does not allow the keyword ~S." + internal-simple-control-error) ; || |key| + ("FEunbound_variable" :unbound-variable "The variable ~S is unbound." + internal-unbound-variable :name) ; |sym| + ("FEundefined_function" :undefined-function "The function ~S is undefined." + internal-undefined-function :name) + ("FEinvalid_function" :invalid-function "~S is invalid as a function." + internal-simple-program-error) ; |obj| + ("check_arg_failed" :too-few-arguments "~S [or a callee] requires ~R argument~:p,~%\ +but only ~R ~:*~[were~;was~:;were~] supplied." + internal-simple-control-error) ; || |n| |top - base| + ("check_arg_failed" :too-many-arguments "~S [or a callee] requires only ~R argument~:p,~%\ +but ~R ~:*~[were~;was~:;were~] supplied." + internal-simple-control-error) ; || |n| |top - base| + ("ck_larg_at_least" :error "APPLY sended too few arguments to LAMBDA." + internal-simple-control-error) + ("ck_larg_exactly" :error "APPLY sended too few arguments to LAMBDA." + internal-simple-control-error) + ("keyword_value_mismatch" :error "Keywords and values do not match." + internal-simple-error) ;?? + ("not_a_keyword" :error "~S is not a keyword." + internal-simple-error) ;?? + ("illegal_declare" :invalid-form "~S is an illegal declaration form." + internal-simple-program-error) + ("not_a_symbol" :invalid-variable "~S is not a symbol." + internal-simple-error) ;?? + ("not_a_variable" :invalid-variable "~S is not a variable." + internal-simple-program-error) + ("illegal_index" :error "~S is an illegal index to ~S." + internal-simple-error) + ("vfun_wrong_number_of_args" :error "Expected ~S args but received ~S args" + internal-simple-control-error) + + ("end_of_stream" :error "Unexpected end of ~S." + internal-end-of-file :stream) + ("open_stream" :error "~S is an illegal IF-DOES-NOT-EXIST option." + internal-simple-control-error) + ("open_stream" :error "The file ~A already exists." + internal-simple-file-error :pathname) + ("open_stream" :error "Cannot append to the file ~A." + internal-simple-file-error :pathname) + ("open_stream" :error "~S is an illegal IF-EXISTS option." + internal-simple-control-error) + ("close_stream" :error "Cannot close the standard output." + internal-simple-stream-error) ; no stream here!! + ("close_stream" :error "Cannot close the standard input." + internal-simple-stream-error) ; no stream here!! + ("too_long_file_name" :error "~S is a too long file name." + internal-simple-file-error :pathname) + ("cannot_open" :error "Cannot open the file ~A." + internal-simple-file-error :pathname) + ("cannot_create" :error "Cannot create the file ~A." + internal-simple-file-error :pathname) + ("cannot_read" :error "Cannot read the stream ~S." + internal-simple-stream-error :stream) + ("cannot_write" :error "Cannot write to the stream ~S." + internal-simple-stream-error :stream) + )) + +(initialize-internal-error-table) + +(defun condition-backtrace (condition) + (let* ((*debug-io* *error-output*) + (si::*ihs-base* (1+ si::*ihs-top*)) + (si::*ihs-top* (1- (si::ihs-top))) + (si::*current-ihs* si::*ihs-top*) + (si::*frs-base* (or (si::sch-frs-base si::*frs-top* si::*ihs-base*) + (1+ (si::frs-top)))) + (si::*frs-top* (si::frs-top)) + (si::*break-env* nil)) + (format *error-output* "~%~A~%" condition) + (si::simple-backtrace))) + +(defvar *error-set-break-p* nil) + +(defun clcs-error-set (form) + (let ((cond nil)) + (restart-case (handler-bind ((error #'(lambda (condition) + (unless (or si::*break-enable* + *error-set-break-p*) + (condition-backtrace condition) + (return-from clcs-error-set condition)) + (setq cond condition) + nil))) + (values-list (cons nil (multiple-value-list (eval form))))) + (si::error-set () + :report (lambda (stream) + (format stream "~S" `(si::error-set ',form))) + cond)))) + +(eval-when (compile load eval) + +(defun reset-function (symbol) ; invoke compiler::compiler-clear-compiler-properties + (setf (symbol-function symbol) (symbol-function symbol))) + +(reset-function 'si::error-set) +(reset-function 'load) +(reset-function 'open) +) + +(setq compiler::*compiler-break-enable* t) + +(defun compiler::cmp-toplevel-eval (form) + (let* (;;(si::*ihs-base* si::*ihs-top*) ; show the whole stack + (si::*ihs-top* (1- (si::ihs-top))) + (*break-enable* compiler::*compiler-break-enable*) + (si::*break-hidden-packages* + (cons (find-package 'compiler) + si::*break-hidden-packages*))) + (si:error-set form))) diff --git a/clcs/unused/test2.lisp b/clcs/unused/test2.lisp new file mode 100755 index 0000000..5ed87e5 --- /dev/null +++ b/clcs/unused/test2.lisp @@ -0,0 +1,41 @@ +(in-package "conditions") + +(define-condition internal-unbound-variable + (#+(or clos pcl) internal-error unbound-variable) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-unbound-variable-) + #-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (FORMAT STREAM "The variable ~S is unbound." + (CELL-ERROR-NAME CONDITION))))) + + +#-(or pcl clos) +(defun internal-error-function-name (condition) + (etypecase condition + (internal-error + (%%internal-simple-error-function-name condition)) + (internal-simple-error + (%%internal-simple-error-function-name condition)) + (internal-type-error + (%%internal-type-error-function-name condition)) + (internal-simple-program-error + (%%internal-simple-program-error-function-name condition)) + (internal-simple-control-error + (%%internal-simple-control-error-function-name condition)) + (internal-unbound-variable + (%%internal-unbound-variable-function-name condition)) + (internal-undefined-function + (%%internal-undefined-function-function-name condition)) + (internal-end-of-file + (%%internal-end-of-file-function-name condition)) + (internal-simple-file-error + (%%internal-simple-file-error-function-name condition)) + (internal-simple-stream-error + (%%internal-simple-stream-error-function-name condition)))) + diff --git a/clcs/unused/test3.lisp b/clcs/unused/test3.lisp new file mode 100755 index 0000000..288cc90 --- /dev/null +++ b/clcs/unused/test3.lisp @@ -0,0 +1,103 @@ +(IN-PACKAGE "CONDITIONS") + +(define-condition internal-simple-error + (internal-error #+(or clos pcl) simple-condition) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-error-) + (:report internal-simple-error-printer)) + +(define-condition internal-type-error + (#+(or clos pcl) internal-error type-error) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-type-error-) + #-(or clos pcl)(:report (lambda (condition stream) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (format stream "~S is not of type ~S." + (type-error-datum condition) + (type-error-expected-type condition))))) + +(define-condition internal-simple-program-error + (#+(or clos pcl) internal-simple-error program-error) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-program-error-) + #-(or clos pcl)(:report internal-simple-error-printer)) + +(define-condition internal-simple-control-error + (#+(or clos pcl) internal-simple-error control-error) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-control-error-) + #-(or clos pcl)(:report internal-simple-error-printer)) + +(define-condition internal-unbound-variable + (#+(or clos pcl) internal-error unbound-variable) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-unbound-variable-) + #-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (FORMAT STREAM "The variable ~S is unbound." + (CELL-ERROR-NAME CONDITION))))) + +(define-condition internal-undefined-function + (#+(or clos pcl) internal-error undefined-function) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-undefined-function-) + #-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (FORMAT STREAM "The function ~S is undefined." + (CELL-ERROR-NAME CONDITION))))) + +(define-condition internal-end-of-file + (#+(or clos pcl) internal-error end-of-file) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-end-of-file-) + #-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (FORMAT STREAM "Unexpected end of file on ~S." + (STREAM-ERROR-STREAM CONDITION))))) + +(define-condition internal-simple-file-error + (#+(or clos pcl) internal-simple-error file-error) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-file-error-) + #-(or clos pcl)(:report internal-simple-error-printer)) + +(define-condition internal-simple-stream-error + (#+(or clos pcl) internal-simple-error stream-error) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-stream-error-) + #-(or clos pcl)(:report internal-simple-error-printer)) diff --git a/clcs/unused/test4.lisp b/clcs/unused/test4.lisp new file mode 100755 index 0000000..aa9455f --- /dev/null +++ b/clcs/unused/test4.lisp @@ -0,0 +1,12 @@ +(IN-PACKAGE "CONDITIONS") + +(define-condition internal-unbound-variable + (#+(or clos pcl) internal-error unbound-variable) #-(or clos pcl) ((function-name nil)) + #+(or clos pcl) () #-(or clos pcl)(:conc-name %%internal-unbound-variable-) + #-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (FORMAT STREAM "The variable ~S is unbound." + (CELL-ERROR-NAME CONDITION))))) + diff --git a/clcs/unused/test5.lisp b/clcs/unused/test5.lisp new file mode 100755 index 0000000..603b488 --- /dev/null +++ b/clcs/unused/test5.lisp @@ -0,0 +1,342 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: "CONDITIONS"; Base: 10 -*- + +(IN-PACKAGE "CONDITIONS") + +(eval-when (compile load eval) +(pushnew #+(or clos pcl) :clos-conditions #-(or clos pcl) :defstruct-conditions + *features*) +) + +(eval-when (compile load eval) +(when (and (member :clos-conditions *features*) + (member :defstruct-conditions *features*)) + (dolist (sym '(simple-condition-format-string simple-condition-format-arguments + type-error-datum type-error-expected-type + case-failure-name case-failure-possibilities + stream-error-stream file-error-pathname package-error-package + cell-error-name arithmetic-error-operation + internal-error-function-name)) + (when (fboundp sym) (fmakunbound sym))) + (setq *features* (remove :defstruct-conditions *features*))) +) + +;;; Start + +(DEFINE-CONDITION WARNING (CONDITION) + ()) + +(DEFINE-CONDITION SERIOUS-CONDITION (CONDITION) + ()) + +(DEFINE-CONDITION lisp:ERROR (SERIOUS-CONDITION) + ()) + +(DEFUN SIMPLE-CONDITION-PRINTER (CONDITION STREAM) + (APPLY #'FORMAT STREAM (SIMPLE-CONDITION-FORMAT-STRING CONDITION) + (SIMPLE-CONDITION-FORMAT-ARGUMENTS CONDITION))) + +(DEFINE-CONDITION SIMPLE-CONDITION (CONDITION) + #-(or clos pcl) + (FORMAT-STRING (FORMAT-ARGUMENTS '())) + #+(or clos pcl) + ((FORMAT-STRING :type string + :initarg :FORMAT-STRING + :reader SIMPLE-CONDITION-FORMAT-STRING) + (FORMAT-ARGUMENTS :initarg :FORMAT-ARGUMENTS + :reader SIMPLE-CONDITION-FORMAT-ARGUMENTS + :initform '())) + #-(or clos pcl)(:CONC-NAME %%SIMPLE-CONDITION-) + (:REPORT SIMPLE-CONDITION-PRINTER)) + +(DEFINE-CONDITION SIMPLE-WARNING (#+(or clos pcl) SIMPLE-CONDITION WARNING) + #-(or clos pcl) + (FORMAT-STRING (FORMAT-ARGUMENTS '())) + #+(or clos pcl) + () + #-(or clos pcl)(:CONC-NAME %%SIMPLE-WARNING-) + #-(or clos pcl)(:REPORT SIMPLE-CONDITION-PRINTER)) + +(DEFINE-CONDITION SIMPLE-ERROR (#+(or clos pcl) SIMPLE-CONDITION lisp:ERROR) + #-(or clos pcl) + (FORMAT-STRING (FORMAT-ARGUMENTS '())) + #+(or clos pcl) + () + #-(or clos pcl)(:CONC-NAME %%SIMPLE-ERROR-) + #-(or clos pcl)(:REPORT SIMPLE-CONDITION-PRINTER)) + +(DEFINE-CONDITION STORAGE-CONDITION (SERIOUS-CONDITION) ()) + +(DEFINE-CONDITION STACK-OVERFLOW (STORAGE-CONDITION) ()) + +(DEFINE-CONDITION STORAGE-EXHAUSTED (STORAGE-CONDITION) ()) + +(DEFINE-CONDITION TYPE-ERROR (lisp:ERROR) + #-(or clos pcl) + (DATUM EXPECTED-TYPE) + #+(or clos pcl) + ((DATUM :initarg :DATUM + :reader TYPE-ERROR-DATUM) + (EXPECTED-TYPE :initarg :EXPECTED-TYPE + :reader TYPE-ERROR-EXPECTED-TYPE)) + (:report + (lambda (condition stream) + (format stream "~S is not of type ~S." + (TYPE-ERROR-DATUM CONDITION) + (TYPE-ERROR-EXPECTED-TYPE CONDITION))))) + +(DEFINE-CONDITION SIMPLE-TYPE-ERROR (#+(or clos pcl) SIMPLE-CONDITION TYPE-ERROR) + #-(or clos pcl) + (FORMAT-STRING (FORMAT-ARGUMENTS '())) + #+(or clos pcl) + () + #-(or clos pcl)(:CONC-NAME %%SIMPLE-TYPE-ERROR-) + #-(or clos pcl)(:REPORT SIMPLE-CONDITION-PRINTER)) + +(DEFINE-CONDITION CASE-FAILURE (TYPE-ERROR) + #-(or clos pcl) + (NAME POSSIBILITIES) + #+(or clos pcl) + ((NAME :initarg :NAME + :reader CASE-FAILURE-NAME) + (POSSIBILITIES :initarg :POSSIBILITIES + :reader CASE-FAILURE-POSSIBILITIES)) + (:REPORT + (LAMBDA (CONDITION STREAM) + (FORMAT STREAM "~S fell through ~S expression.~%Wanted one of ~:S." + (TYPE-ERROR-DATUM CONDITION) + (CASE-FAILURE-NAME CONDITION) + (CASE-FAILURE-POSSIBILITIES CONDITION))))) + +(DEFINE-CONDITION PROGRAM-ERROR (lisp:ERROR) + ()) + +(DEFINE-CONDITION CONTROL-ERROR (lisp:ERROR) + ()) + +(DEFINE-CONDITION STREAM-ERROR (lisp:ERROR) + #-(or clos pcl) + (STREAM) + #+(or clos pcl) + ((STREAM :initarg :STREAM + :reader STREAM-ERROR-STREAM))) + +(DEFINE-CONDITION END-OF-FILE (STREAM-ERROR) + () + (:REPORT (LAMBDA (CONDITION STREAM) + (FORMAT STREAM "Unexpected end of file on ~S." + (STREAM-ERROR-STREAM CONDITION))))) + +(DEFINE-CONDITION FILE-ERROR (lisp:ERROR) + #-(or clos pcl) + (PATHNAME) + #+(or clos pcl) + ((PATHNAME :initarg :PATHNAME + :reader FILE-ERROR-PATHNAME))) + +(DEFINE-CONDITION PACKAGE-ERROR (lisp:ERROR) + #-(or clos pcl) + (PACKAGE) + #+(or clos pcl) + ((PACKAGE :initarg :PACKAGE + :reader PACKAGE-ERROR-PACKAGE))) + +(DEFINE-CONDITION CELL-ERROR (lisp:ERROR) + #-(or clos pcl) + (NAME) + #+(or clos pcl) + ((NAME :initarg :NAME + :reader CELL-ERROR-NAME))) + +(DEFINE-CONDITION UNDEFINED-FUNCTION (CELL-ERROR) + () + (:REPORT (LAMBDA (CONDITION STREAM) + (FORMAT STREAM "The function ~S is undefined." + (CELL-ERROR-NAME CONDITION))))) + +(DEFINE-CONDITION ARITHMETIC-ERROR (lisp:ERROR) + #-(or clos pcl) + (OPERATION OPERANDS) + #+(or clos pcl) + ((OPERATION :initarg :OPERATION + :reader ARITHMETIC-ERROR-OPERATION))) + +(DEFINE-CONDITION DIVISION-BY-ZERO (ARITHMETIC-ERROR) + ()) + +(DEFINE-CONDITION FLOATING-POINT-OVERFLOW (ARITHMETIC-ERROR) + ()) + +(DEFINE-CONDITION FLOATING-POINT-UNDERFLOW (ARITHMETIC-ERROR) + ()) + +(DEFINE-CONDITION ABORT-FAILURE (CONTROL-ERROR) () + (:REPORT "Abort failed.")) + + +#+kcl +(progn + +;;; When this form is present, the compiled behavior disagrees with +;;; the interpreted behavior. The interpreted behavior is correct. +(define-condition internal-error (lisp:error) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + ((function-name :initarg :function-name + :reader internal-error-function-name + :initform 'nil)) + (:report (lambda (condition stream) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + #+(or clos pcl)(call-next-method)))) + +(defun internal-simple-error-printer (condition stream) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (apply #'format stream (simple-condition-format-string condition) + (simple-condition-format-arguments condition))) + +(define-condition internal-simple-error + (internal-error #+(or clos pcl) simple-condition) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-error-) + (:report internal-simple-error-printer)) + +(define-condition internal-type-error + (#+(or clos pcl) internal-error type-error) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-type-error-) + #-(or clos pcl)(:report (lambda (condition stream) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (format stream "~S is not of type ~S." + (type-error-datum condition) + (type-error-expected-type condition))))) + +(define-condition internal-simple-program-error + (#+(or clos pcl) internal-simple-error program-error) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-program-error-) + #-(or clos pcl)(:report internal-simple-error-printer)) + +(define-condition internal-simple-control-error + (#+(or clos pcl) internal-simple-error control-error) + #-(or clos pcl) + ((function-name nil) format-string (format-arguments '())) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-simple-control-error-) + #-(or clos pcl)(:report internal-simple-error-printer)) + + +(define-condition internal-unbound-variable + (#+(or clos pcl) internal-error unbound-variable) + #-(or clos pcl) + ((function-name nil)) + #+(or clos pcl) + () + #-(or clos pcl)(:conc-name %%internal-unbound-variable-) + #-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) + (when (internal-error-function-name condition) + (format stream "Error in ~S [or a callee]: " + (internal-error-function-name condition))) + (FORMAT STREAM "The variable ~S is unbound." + (CELL-ERROR-NAME CONDITION))))) + +#-(or pcl clos) +(defun internal-error-function-name (condition) + (etypecase condition + (internal-error + (%%internal-error-function-name condition)) + (internal-simple-error + (%%internal-simple-error-function-name condition)) + (internal-type-error + (%%internal-type-error-function-name condition)) + (internal-simple-program-error + (%%internal-simple-program-error-function-name condition)) + (internal-simple-control-error + (%%internal-simple-control-error-function-name condition)) + (internal-unbound-variable + (%%internal-unbound-variable-function-name condition)) + (internal-undefined-function + (%%internal-undefined-function-function-name condition)) + (internal-end-of-file + (%%internal-end-of-file-function-name condition)) + (internal-simple-file-error + (%%internal-simple-file-error-function-name condition)) + (internal-simple-stream-error + (%%internal-simple-stream-error-function-name condition)))) +) + +#-(or clos pcl) +(progn + +(DEFUN SIMPLE-CONDITION-FORMAT-STRING (CONDITION) + (ETYPECASE CONDITION + (SIMPLE-CONDITION (%%SIMPLE-CONDITION-FORMAT-STRING CONDITION)) + (SIMPLE-WARNING (%%SIMPLE-WARNING-FORMAT-STRING CONDITION)) + (SIMPLE-TYPE-ERROR (%%SIMPLE-TYPE-ERROR-FORMAT-STRING CONDITION)) + (SIMPLE-ERROR (%%SIMPLE-ERROR-FORMAT-STRING CONDITION)) + #+kcl(internal-simple-error + (%%internal-simple-error-format-string condition)) + #+kcl(internal-simple-program-error + (%%internal-simple-program-error-format-string condition)) + #+kcl(internal-simple-control-error + (%%internal-simple-control-error-format-string condition)) + #+kcl(internal-simple-file-error + (%%internal-simple-file-error-format-string condition)) + #+kcl(internal-simple-stream-error + (%%internal-simple-stream-error-format-string condition)))) + +(DEFUN SIMPLE-CONDITION-FORMAT-ARGUMENTS (CONDITION) + (ETYPECASE CONDITION + (SIMPLE-CONDITION (%%SIMPLE-CONDITION-FORMAT-ARGUMENTS CONDITION)) + (SIMPLE-WARNING (%%SIMPLE-WARNING-FORMAT-ARGUMENTS CONDITION)) + (SIMPLE-TYPE-ERROR (%%SIMPLE-TYPE-ERROR-FORMAT-ARGUMENTS CONDITION)) + (SIMPLE-ERROR (%%SIMPLE-ERROR-FORMAT-ARGUMENTS CONDITION)) + #+kcl(internal-simple-error + (%%internal-simple-error-format-arguments condition)) + #+kcl(internal-simple-program-error + (%%internal-simple-program-error-format-arguments condition)) + #+kcl(internal-simple-control-error + (%%internal-simple-control-error-format-arguments condition)) + #+kcl(internal-simple-file-error + (%%internal-simple-file-error-format-arguments condition)) + #+kcl(internal-simple-stream-error + (%%internal-simple-stream-error-format-arguments condition)))) + +(defun simple-condition-class-p (type) + (member type '(SIMPLE-CONDITION SIMPLE-WARNING SIMPLE-TYPE-ERROR SIMPLE-ERROR + #+kcl internal-simple-error + #+kcl internal-simple-program-error + #+kcl internal-simple-control-error + #+kcl internal-simple-file-error + #+kcl internal-simple-stream-error))) +) + +#+(or clos pcl) +(progn +(defvar *simple-condition-class* (find-class 'simple-condition)) + +(defun simple-condition-class-p (TYPE) + (when (symbolp TYPE) + (setq TYPE (find-class TYPE))) + (and (typep TYPE 'standard-class) + (member *simple-condition-class* + (#+pcl pcl::class-precedence-list + #-pcl clos::class-precedence-list + type)))) +) + diff --git a/clcs/unused/tester.lisp b/clcs/unused/tester.lisp new file mode 100755 index 0000000..799c3aa --- /dev/null +++ b/clcs/unused/tester.lisp @@ -0,0 +1,11 @@ +(in-package "conditions") + +(defun compare-semantics (file condition) + (let ((results)) + (load (format nil "~A.lisp" file)) + (push (with-output-to-string (s) (princ condition s)) results) + (compile-file (format nil "~A.lisp" file)) + (load (format nil "~A.o" file)) + (push (with-output-to-string (s) (princ condition s)) results) + (print (reverse results)) + (values))) \ No newline at end of file diff --git a/cmpnew/.gitignore b/cmpnew/.gitignore new file mode 100644 index 0000000..68359a7 --- /dev/null +++ b/cmpnew/.gitignore @@ -0,0 +1,2 @@ +*.c +*.h diff --git a/cmpnew/gcl_cmpbind.lsp b/cmpnew/gcl_cmpbind.lsp new file mode 100755 index 0000000..7860b60 --- /dev/null +++ b/cmpnew/gcl_cmpbind.lsp @@ -0,0 +1,131 @@ +;;; CMPBIND Variable Binding. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'bds-bind 'set-bds-bind 'set-loc) + +;;; Those functions that call the following binding functions should +;;; rebind the special variables, +;;; *vs*, *clink*, *ccb-vs*, and *unwind-exit*. + +(defun c2bind (var) + (case (var-kind var) + (LEXICAL + (when (var-ref-ccb var) + (wt-nl) + (wt-vs (var-ref var)) + (wt "=MMcons(") (wt-vs (var-ref var)) + (wt ",") (wt-clink) (wt ");") + (clink (var-ref var)) + (setf (var-ref-ccb var) (ccb-vs-push)))) + (SPECIAL + (wt-nl "bds_bind(" (vv-str (var-loc var)) ",") (wt-vs (var-ref var)) + (wt ");") + (push 'bds-bind *unwind-exit*)) + (DOWN + (cond ((integerp (var-loc var)) + (wt-nl "base0[" (var-loc var) "]=") + (wt-vs (var-ref var)) + (wt ";")) + (t (wfs-error)))) + (INTEGER + (wt-nl "SETQ_IO(V" (var-loc var)"," + "V" (var-loc var)"alloc,") + (wt "(") (wt-vs (var-ref var)) (wt "),") + (wt (bignum-expansion-storage) ");")) + (t + (wt-nl "V" (var-loc var) "=") + (case (var-kind var) + (OBJECT) + (FIXNUM (wt "fix")) + (CHARACTER (wt "char_code")) + (LONG-FLOAT (wt "lf")) + (SHORT-FLOAT (wt "sf")) + (t (baboon))) + (wt "(") (wt-vs (var-ref var)) (wt ");"))) + ) + +(defun c2bind-loc (var loc) + (case (var-kind var) + (LEXICAL + (cond ((var-ref-ccb var) + (wt-nl) + (wt-vs (var-ref var)) + (wt "=MMcons(" loc ",") (wt-clink) (wt ");") + (clink (var-ref var)) + (setf (var-ref-ccb var) (ccb-vs-push))) + (t + (wt-nl) (wt-vs (var-ref var)) (wt "= " loc ";")))) + (SPECIAL + (wt-nl "bds_bind(" (vv-str (var-loc var)) "," loc ");") + (push 'bds-bind *unwind-exit*)) + + (DOWN + (wt-nl "base0[" (var-loc var) "]=" loc ";")) + (INTEGER + (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*)) + (save-avma '(nil integer)) + (wt-nl "V" (var-loc var) "= ") + (wt-integer-loc loc var) + (wt ";") + (close-inline-blocks))) + (t + (wt-nl "V" (var-loc var) "= ") + (case (var-kind var) + (OBJECT (wt-loc loc)) + (FIXNUM (wt-fixnum-loc loc)) + (CHARACTER (wt-character-loc loc)) + (LONG-FLOAT (wt-long-float-loc loc)) + (SHORT-FLOAT (wt-short-float-loc loc)) + (t (baboon))) + (wt ";"))) + ) + +(defun c2bind-init (var init) + (case (var-kind var) + (LEXICAL + (cond ((var-ref-ccb var) + (let ((loc (list 'vs (var-ref var)))) + (let ((*value-to-go* loc)) + (c2expr* init)) + (wt-nl loc "=MMcons(" loc ",") (wt-clink *clink*) + (wt ");")) + (clink (var-ref var)) + (setf (var-ref-ccb var) (ccb-vs-push))) + (t + (let ((*value-to-go* (list 'vs (var-ref var)))) + (c2expr* init))))) + (SPECIAL + (let ((*value-to-go* (list 'bds-bind (var-loc var)))) + (c2expr* init)) + (push 'bds-bind *unwind-exit*)) + (DOWN + (let ((*value-to-go* (list 'down (var-loc var)))) + (c2expr* init))) + ((OBJECT FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER) + (let ((*value-to-go* (list 'var var nil))) + (c2expr* init))) + (t (baboon))) + ) + +(defun set-bds-bind (loc vv) + (wt-nl "bds_bind(" (vv-str vv) "," loc ");")) diff --git a/cmpnew/gcl_cmpblock.lsp b/cmpnew/gcl_cmpblock.lsp new file mode 100755 index 0000000..ee46e8c --- /dev/null +++ b/cmpnew/gcl_cmpblock.lsp @@ -0,0 +1,169 @@ +;;; CMPBLOCK Block and Return-from. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'block 'c1block 'c1special) +(si:putprop 'block 'c2block 'c2) + +(si:putprop 'return-from 'c1return-from 'c1special) +(si:putprop 'return-from 'c2return-from 'c2) + +(defstruct blk + name ;;; Block name. + ref ;;; Referenced or not. T or NIL. + ref-clb ;;; Cross local function reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the vs-address for the + ;;; block id, or NIL. + ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the ccb-vs for the + ;;; block id, or NIL. + exit ;;; Where to return. A label. + value-to-go ;;; Where the value of the block to go. + var ;;; The block name holder. Used only in + ;;; the error message. + ) + +(defvar *blocks* nil) + +;;; During Pass 1, *blocks* holds a list of blk objects and the symbols 'CB' +;;; (Closure Boundary) and 'LB' (Level Boundary). 'CB' will be pushed on +;;; *blocks* when the compiler begins to process a closure. 'LB' will be +;;; pushed on *blocks* when *level* is incremented. + +(defun c1block (args) + (when (endp args) (too-few-args 'block 1 0)) + (cmpck (not (symbolp (car args))) + "The block name ~s is not a symbol." (car args)) + (let* ((blk (make-blk :name (car args) :ref nil :ref-ccb nil :ref-clb nil)) + (*blocks* (cons blk *blocks*)) + (body (c1progn (cdr args)))) + (if (or (blk-ref-ccb blk) (blk-ref-clb blk)) + (incf *setjmps*)) + + (if (or (blk-ref-ccb blk) (blk-ref-clb blk) (blk-ref blk)) + (list 'block (reset-info-type (cadr body)) blk body) + body)) + ) + +(defun c2block (blk body) + (cond ((blk-ref-ccb blk) (c2block-ccb blk body)) + ((blk-ref-clb blk) (c2block-clb blk body)) + (t (c2block-local blk body)))) + +(defun c2block-local (blk body) + (setf (blk-exit blk) *exit*) + (setf (blk-value-to-go blk) *value-to-go*) + (c2expr body) + ) + +(defun c2block-clb (blk body &aux (*vs* *vs*)) + (setf (blk-exit blk) *exit*) + (setf (blk-value-to-go blk) *value-to-go*) + (setf (blk-ref-clb blk) (vs-push)) + (wt-nl) + (wt-vs (blk-ref-clb blk)) + (wt "=alloc_frame_id();") + (wt-nl "frs_push(FRS_CATCH,") (wt-vs (blk-ref-clb blk)) (wt ");") + (wt-nl "if(nlj_active)") + (wt-nl "{nlj_active=FALSE;frs_pop();") + (unwind-exit 'fun-val 'jump) + (wt "}") + (wt-nl "else{") + (let ((*unwind-exit* (cons 'frame *unwind-exit*))) (c2expr body)) + (wt-nl "}") + ) + +(defun c2block-ccb (blk body &aux (*vs* *vs*) (*clink* *clink*) + (*ccb-vs* *ccb-vs*)) + (setf (blk-exit blk) *exit*) + (setf (blk-value-to-go blk) *value-to-go*) + (setf (blk-ref-clb blk) (vs-push)) + (setf (blk-var blk) (add-symbol (blk-name blk))) + (wt-nl) (wt-vs (blk-ref-clb blk)) (wt "=alloc_frame_id();") + (wt-nl) (wt-vs (blk-ref-clb blk)) + (wt "=MMcons(") (wt-vs (blk-ref-clb blk)) (wt ",") (wt-clink) (wt ");") + (clink (blk-ref-clb blk)) + (setf (blk-ref-ccb blk) (ccb-vs-push)) + (wt-nl "frs_push(FRS_CATCH,") (wt-vs* (blk-ref-clb blk)) (wt ");") + (wt-nl "if(nlj_active)") + (wt-nl "{nlj_active=FALSE;frs_pop();") + (unwind-exit 'fun-val 'jump) + (wt "}") + (wt-nl "else{") + (let ((*unwind-exit* (cons 'frame *unwind-exit*))) (c2expr body)) + (wt-nl "}") + ) + +(defun c1return-from (args) + (cond ((endp args) (too-few-args 'return-from 1 0)) + ((and (not (endp (cdr args))) (not (endp (cddr args)))) + (too-many-args 'return-from 2 (length args))) + ((not (symbolp (car args))) + "The block name ~s is not a symbol." (car args))) + (do ((blks *blocks* (cdr blks)) + (name (car args)) + (ccb nil) (clb nil)) + ((endp blks) + (cmperr "The block ~s is undefined." name)) + (declare (object name ccb clb)) + (case (car blks) + (cb (setq ccb t)) + (lb (setq clb t)) + (t (when (eq (blk-name (car blks)) name) + (let ((val (c1expr (cadr args))) + (blk (car blks))) + (cond + (ccb (setf (blk-ref-ccb blk) t)) + (clb (setf (blk-ref-clb blk) t)) + (t (setf (blk-ref blk) t))) + (return (list 'return-from + (reset-info-type (cadr val)) + blk clb ccb val))))))) + ) + +(defun c2return-from (blk clb ccb val) + (cond (ccb (c2return-ccb blk val)) + (clb (c2return-clb blk val)) + (t (c2return-local blk val)))) + +(defun c2return-local (blk val) + (let ((*value-to-go* (blk-value-to-go blk)) + (*exit* (blk-exit blk))) + (c2expr val)) + ) + +(defun c2return-clb (blk val) + (let ((*value-to-go* 'top)) (c2expr* val)) + (wt-nl "unwind(frs_sch(") + (if (blk-ref-ccb blk) (wt-vs* (blk-ref-clb blk)) (wt-vs (blk-ref-clb blk))) + (wt "),Cnil);") + ) + +(defun c2return-ccb (blk val) + (wt-nl "{frame_ptr fr;") + (wt-nl "fr=frs_sch(") (wt-ccb-vs (blk-ref-ccb blk)) (wt ");") + (wt-nl "if(fr==NULL) FEerror(\"The block ~s is missing.\",1," (vv-str (blk-var blk)) ");") + (let ((*value-to-go* 'top)) (c2expr* val)) + (wt-nl "unwind(fr,Cnil);}") + ) diff --git a/cmpnew/gcl_cmpcall.lsp b/cmpnew/gcl_cmpcall.lsp new file mode 100755 index 0000000..6739f1b --- /dev/null +++ b/cmpnew/gcl_cmpcall.lsp @@ -0,0 +1,579 @@ +;;; CMPCALL Function call. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(defvar *ifuncall* nil) + + +(eval-when (compile eval) +(defmacro link-arg-p (x) + `(let ((.u ,x)) + (not (member .u '(character boolean long-float short-float) :test 'eq))))) + +(defun fast-link-proclaimed-type-p (fname &optional args) + (and + (symbolp fname) + (and (< (the fixnum(length args)) 64) + (or (and (get fname 'fixed-args) + (listp args)) + (and + (get fname 'proclaimed-function) + (link-arg-p (get fname 'proclaimed-return-type)) + (dolist (v (get fname 'proclaimed-arg-types) t) + (or (eq v '*)(link-arg-p v) (return nil)))))))) + +(si::putprop 'funcall 'c2funcall-aux 'wholec2) +(si:putprop 'call-lambda 'c2call-lambda 'c2) +(si:putprop 'call-global 'c2call-global 'c2) + +;;Like macro-function except it searches the lexical environment, +;;to determine if the macro is shadowed by a function or a macro. +(defun cmp-macro-function (name &aux fd) + (cond ((setq fd (c1local-fun name)) + (if (eq (car fd) 'call-local) nil fd)) + (t (macro-function name)))) + +(defun c1funob (fun &aux fd) + ;;; NARGS is the number of arguments. If the number is unknown, (e.g. + ;;; in case of APPLY), then NARGS should be NIL. + (cond ((and (consp fun) + (symbolp (car fun)) + (cmp-macro-function (car fun))) + (setq fun (cmp-macroexpand fun)))) + (or + (and + (consp fun) + (or (and (eq (car fun) 'quote) + (not (endp (cdr fun))) + (endp (cddr fun)) + (or (and (consp (cadr fun)) + (not (endp (cdadr fun))) + (eq (caadr fun) 'lambda) + (let ((*vars* nil) (*funs* nil) (*blocks* nil) + (*tags* nil)) + (let ((lambda-expr (c1lambda-expr (cdadr fun)))) + (list 'call-lambda (cadr lambda-expr) + lambda-expr)))) + (and (symbolp (cadr fun)) + (or (and (setq fd (c1local-fun (cadr fun))) + (eq (car fd) 'call-local) + fd) + (list 'call-global + (make-info + :sp-change + (null (get (cadr fun) 'no-sp-change))) + (cadr fun))) + ))) + (and (eq (car fun) 'function) + (not (endp (cdr fun))) + (endp (cddr fun)) + (or (and (consp (cadr fun)) + (eq (caadr fun) 'lambda) + (not (endp (cdadr fun))) + (let ((lambda-expr (c1lambda-expr (cdadr fun)))) + (list 'call-lambda (cadr lambda-expr) lambda-expr)) + ) + (and (symbolp (cadr fun)) + (or (and (setq fd (c1local-fun (cadr fun))) + (eq (car fd) 'call-local) + fd) + (list 'call-global + (make-info + :sp-change + (null (get (cadr fun) 'no-sp-change))) + (cadr fun))) + ))))) + (let ((x (c1expr fun)) (info (make-info :sp-change t))) + (add-info info (cadr x)) + (list 'ordinary info x)) + )) + + +(defun c2funcall-aux(form &aux (info (cadr form)) + (funob (caddr form)) + (args (cadddr form)) + (loc (nth 4 form))) + (c2funcall funob args loc info)) + +(defvar *use-sfuncall* t) +(defvar *super-funcall* nil) + +(defun c2funcall (funob args &optional loc info) + + ;;; Usually, ARGS holds a list of forms, which are arguments to the + ;;; function. If, however, the arguments are already pushed on the stack, + ;;; ARGS should be set to the symbol ARGS-PUSHED. + (case (car funob) + (call-global (c2call-global (caddr funob) args loc t)) + (call-local (c2call-local (cddr funob) args)) + (call-lambda (c2call-lambda (caddr funob) args)) + (ordinary ;;; An ordinary expression. In this case, if + ;;; arguments are already pushed on the stack, then + ;;; LOC cannot be NIL. Callers of C2FUNCALL must be + ;;; responsible for maintaining this condition. + (let ((*vs* *vs*) (form (caddr funob))) + (declare (object form)) + (cond ((and (listp args) + (< (length args) 12) ;FIXME fcalln1 limitation + *use-sfuncall* + ;;Determine if only one value at most is required: + (or + (member *value-to-go* '(return-object trash)) + (and (consp *value-to-go*) + (member (car *value-to-go*) '(var cvar jump-false jump-true))) + (and info (equal (info-type info) '(values t))) + )) + (c2funcall-sfun form args info) + (return-from c2funcall nil))) + (unless loc + (unless (listp args) (baboon)) + (cond ((eq (car form) 'LOCATION) (setq loc (caddr form))) + ((and (eq (car form) 'VAR) + (not (args-info-changed-vars (caaddr form) args))) + (setq loc (cons 'VAR (caddr form)))) + (t + (setq loc (list 'vs (vs-push))) + (let ((*value-to-go* loc)) (c2expr* (caddr funob)))))) + (push-args args) + (if *compiler-push-events* + (wt-nl "super_funcall(" loc ");") + (if *super-funcall* + (funcall *super-funcall* loc) + (wt-nl "super_funcall_no_event(" loc ");"))) + (unwind-exit 'fun-val))) + (otherwise (baboon)) + )) + + +(defun fcalln-inline (&rest args) + (wt-nl "({object _f=" (car args) ";enum type _t=type_of(_f);") + (wt-nl "_f = _t==t_symbol && _f->s.s_gfdef!=OBJNULL ? (_t=type_of(_f->s.s_gfdef),_f->s.s_gfdef) : _f;") + (wt-nl "_t==t_sfun&&(_f->sfn.sfn_argd&0xff)== " (length (cdr args)) " ? _f->sfn.sfn_self : ") + (wt-nl "(fcall.argd= " (length (cdr args)) + ",_t==t_vfun&&_f->vfn.vfn_minargs<= " (length (cdr args)) "&&" (length (cdr args)) "<=_f->vfn.vfn_maxargs ? _f->vfn.vfn_self : ") + (wt-nl "(fcall.fun=_f,fcalln));})") + (wt-nl "(") + (when (cdr args) (wt (cadr args)) + (dolist (loc (cddr args)) (wt #\, loc))) + (wt-nl ")")) + +(defun c2call-lambda (lambda-expr args &aux (lambda-list (caddr lambda-expr))) + (declare (object lambda-list)) + (cond ((or (cadr lambda-list) ;;; Has optional? + (caddr lambda-list) ;;; Has rest? + (cadddr lambda-list) ;;; Has key? + (not (listp args)) ;;; Args already pushed? + ) + (when (listp args) ;;; Args already pushed? + (let ((*vs* *vs*) (base *vs*)) + (push-args-lispcall args) + (when (need-to-set-vs-pointers lambda-list) + (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";") + (base-used) + ))) + (c2lambda-expr lambda-list (caddr (cddr lambda-expr))) + ) + (t + (let ((l-length (length (car lambda-list))) + (a-length (length args))) + (or (eql a-length l-length) + (cmperr "Calling lambda with ~a args not ~a" a-length + l-length))) + + (c2let (car lambda-list) args (caddr (cddr lambda-expr))))) + ) + +(defun check-fname-args (fname args) + (let ((a (get fname 'arg-types t))) + (and (eq t a) (get fname 'si::structure-access) + (setq a '(t))) + (cond ((and (listp a) + (listp args) + (not (member '* a))) + (or (eql (length a) (length args)) + (cmpwarn "Wrong number of args for ~s: ~a instead of ~a." + fname + (length args) (length a))))))) + +(defun save-avma (fd) + (when (and (not *restore-avma*) + (setq *restore-avma* + (or + (member 'integer (car fd)) + (eq (cadr fd) 'integer) + (flag-p (caddr fd) is)))) + (wt-nl "{ save_avma;") + (inc-inline-blocks) + (or (consp *inline-blocks*) + (setq *inline-blocks* (cons *inline-blocks* 'restore-avma))))) + + + + + +(defun c2call-global (fname args loc return-type &aux fd (*vs* *vs*)) +;this is now done in get-inline-info +; (and *Fast-link-compiling* (fast-link-proclaimed-type-p fname args) +; (add-fast-link fname t args)) + (if (inline-possible fname) + (cond + ;;; Tail-recursive case. + ((and (listp args) + *do-tail-recursion* + *tail-recursion-info* + (eq (car *tail-recursion-info*) fname) + (member *exit* + '(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SHORT-FLOAT + RETURN-LONG-FLOAT RETURN-OBJECT)) + (tail-recursion-possible) + (= (length args) (length (cdr *tail-recursion-info*)))) + (let* ((*value-to-go* 'trash) + (*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*))) + (c2psetq (mapcar #'(lambda (v) (list v nil)) + (cdr *tail-recursion-info*)) + args) + (wt-label *exit*)) + (unwind-no-exit 'tail-recursion-mark) + (wt-nl "goto TTL;") + (cmpnote "Tail-recursive call of ~s was replaced by iteration." fname)) + + ;;; Open-codable function call. + ((and (listp args) + (null loc) + (setq fd (get-inline-info fname args return-type))) + (let ((*inline-blocks* 0) + (*restore-avma* *restore-avma*)) + (save-avma fd) + (unwind-exit (get-inline-loc fd args) nil fname) + (close-inline-blocks))) + + ;;; Call to a function whose C language function name is known. + ((setq fd (or (get fname 'Lfun) (get fname 'Ufun))) + (check-fname-args fname args) + (push-args args) + (wt-h "void " fd "();") + (wt-nl fd "();") + (unwind-exit 'fun-val nil fname) + ) + + ( t; *Fast-link-compiling* + (cond ((and + (listp args) + (< (the fixnum (length args)) 10) + (or + *ifuncall* + (get fname 'ifuncall)) + (progn (if (eq *value-to-go* 'top) (format t "~%Called with top:~a" fname)) t) + (not (eq 'top *value-to-go*)) + (null loc) + ) + (let ((*inline-blocks* 0)) + (unwind-exit (get-inline-loc (inline-proc fname args) args) + nil fname) + (close-inline-blocks))) + (t + (push-args args) + (let ((num (add-fast-link fname nil args))) + (wt-nl "(void) (*Lnk" num ")(") + (if (get fname 'proclaimed-closure) (wt "Lclptr" num)) + (wt ");") + (unwind-exit 'fun-val nil fname))))) + + + ;;; Call to a function defined in the same file. + ((setq fd (assoc fname *global-funs*)) + (push-args args) + (wt-nl (c-function-name "L" (cdr fd) fname) "();") + (unwind-exit 'fun-val nil fname) + ) + ((eql fname 'funcall-c) + (wt-funcall-c args)) + + ;;; Otherwise. + (t (c2call-unknown-global fname args loc t))) + (c2call-unknown-global fname args loc nil)) + ) + + + +(defun add-fast-link (fname type args) + (let (link link-info (n (add-object2 (add-symbol fname))) vararg) + (cond (type + ;;should do some args checking in that case too. + (let* (link-string tem argtypes + (leng (and (listp args) (length args)))) + (setq argtypes + (cond ((get fname 'proclaimed-function) + (get fname 'proclaimed-arg-types)) + ((setq tem (get fname ' fixed-args)) + (cond ((si:fixnump tem) + (or (equal leng tem) + (cmpwarn "~a: Fixed args not fixed!" + fname))) + (t (setf (get fname 'fixed-args) leng))) + (make-list leng :initial-element t)))) + (and leng + (or (eql leng (length argtypes)) + (MEMBER '* ARGTYPES) + (cmpwarn "~a called with ~a args, expected ~a " + fname leng + (length argtypes)))) + (unless + (cddr (setq link-info (car (member-if (lambda (x) (and (eq fname (car x)) (stringp (cadr x)))) *function-links*)))) + (setq link-string + (with-output-to-string + (st) + (format st "(*(LnkLI~d))(" n) + (do ((com) + (v argtypes (cdr v)) + (i 0 (+ 1 i))) + ((null v)) + (cond ((eq (car v) '*) + (setq vararg t) + (princ (if (eq v argtypes) "#?" "#*") st)) + (t + (if com (princ "," st) (setq com t)) + (format st "#~a" i)))) + (princ ")" st) + ) + ) +; (print (list 'link-string link-string)) +; (format t "~{~a~#[~:;,~]~}" '(1 2 3 4)) +; 1,2,3,4 + + (if vararg (setq link + #'(lambda ( &rest l) + (wt "(VFUN_NARGS="(length l) ",") + (wt-inline-loc link-string l) + (wt ")")))) + + (push (list fname argtypes + (or (get fname 'proclaimed-return-type) + t) + (flags side-effect-p allocates-new-storage) + (or link link-string) 'link-call) + *inline-functions*) + (setq link-info (list fname (format nil "LI~d" n) + (or (get fname 'proclaimed-return-type) + t) + argtypes))))) + (t + (check-fname-args fname args) + (setq link-info (list fname n + (if (get fname 'proclaimed-closure) 'proclaimed-closure) + )))) + (pushnew link-info *function-links* :test 'equal) + n)) + +;;make a function which will be called hopefully only once, +;;and will establish the link. +(defun wt-function-link (x) + (let ((name (first x)) + (num (second x)) + (type (third x)) + (args (fourth x))) + (cond + ((null type) + (wt-nl1 "static void LnkT" + num "(){ call_or_link(VV[" num "],(void **)(void *)&Lnk" num");}")) + ((eql type 'proclaimed-closure) + (wt-nl1 "static void LnkT" num + "(ptr) object *ptr;{ call_or_link_closure(VV[" num "],(void **)(void *)&Lnk" num",(void **)(void *)&Lclptr" num");}")) + (t + ;;change later to include above. + ;;(setq type (cdr (assoc type '((t . "object")(:btpr . "bptr"))))) + (wt-nl1 "static " (declaration-type (rep-type type)) " LnkT" num ) + (cond ((or args (not (eq t type))) + (let ((vararg (member '* args))) + (wt "(object first,...){" + (declaration-type (rep-type type)) "V1;" + "va_list ap;va_start(ap,first);V1=call_" + (if vararg "v" "") "proc_new(" (vv-str (add-object name)) ",(void **)(void *)&Lnk" num) + (or vararg (wt "," (proclaimed-argd args type))) + (wt ",first,ap);va_end(ap);return V1;}" ))) + (t (wt "(){return call_proc0(" (vv-str (add-object name)) ",(void **)(void *)&Lnk" num ");}" )))) + (t (error "unknown link type ~a" type))) + (setq name (symbol-name name)) + (if (find #\/ name) (setq name (remove #\/ name))) + (wt " /* " name " */") + )) + + + +;;For funcalling when the argument is guaranteed to be a compiled-function. +;;For (funcall-c he 3 4), he being a compiled function. (not a symbol)! +(defun wt-funcall-c (args) + (let ((fun (car args)) + (real-args (cdr args)) + loc) + (cond ((eql (car fun) 'var) + (let ((fun-loc (cons (car fun) (third fun)))) + (when *safe-compile* + (wt-nl "(type_of(") + (wt-loc fun-loc) + (wt ")==t_cfun)||FEinvalid_function(") + (wt-loc fun-loc)(wt ");")) + (push-args real-args) + (wt-nl "(") + (wt-loc fun-loc))) + (t + (setq loc (list 'cvar (incf *next-cvar*))) + (let ((*value-to-go* loc)) + (wt-nl + "{object V" (second loc) ";") + (c2expr* (car args)) + (push-args (cdr args)) + (wt "(V" (second loc))))) + (wt ")->cf.cf_self ();") + (and loc (wt "}"))) + (unwind-exit 'fun-val)) + +(defun inline-proc (fname args &aux (n (length args)) res + (obj (add-object fname))) + (format t "~%Using ifuncall: ~a" fname) + (let ((result + (case n + ;(0 (list () t (flags ans set) (format nil "ifuncall0(VV[~d])" obj))) + (1 (list '(t) t (flags ans set) (format nil "ifuncall1(~a,(#0))" (vv-str obj)) + 'ifuncall)) + (2 (list '(t t) t (flags ans set) + (format nil "ifuncall2(~a,(#0),(#1))" (vv-str obj)) + 'ifuncall)) + (t + (list (make-list n :initial-element t) + t (flags ans set) + (format nil "ifuncall(~a,~a~{,#~a~})" + (vv-str obj) n + (dotimes (i n(nreverse res)) + (push i res))) + 'ifuncall))))) + (push (cons fname result ) *inline-functions*) + result + )) + + +(si:putprop 'simple-call 'wt-simple-call 'wt-loc) + +(defun wt-simple-call (cfun base n &optional (vv-index nil)) + (wt "simple_" cfun "(") + (when vv-index (wt (vv-str vv-index) ",")) + (wt "base+" base "," n ")") + (base-used)) + +;;; Functions that use SAVE-FUNOB should reset *vs*. +(defun save-funob (funob) + (case (car funob) + ((call-lambda call-quote-lambda call-local)) + (call-global + (unless (and (inline-possible (caddr funob)) + (or (get (caddr funob) 'Lfun) + (get (caddr funob) 'Ufun) + (get (caddr funob) 'proclaimed-function) + (assoc (caddr funob) *global-funs*))) + (let ((temp (list 'vs (vs-push)))) + (if *safe-compile* + (wt-nl + temp + "=symbol_function(" (vv-str (add-symbol (caddr funob))) ");") + (wt-nl temp "=" (vv-str (add-symbol (caddr funob))) "->s.s_gfdef;")) + temp))) + (ordinary (let* ((temp (list 'vs (vs-push))) + (*value-to-go* temp)) + (c2expr* (caddr funob)) + temp)) + (otherwise (baboon)) + )) + +(defun push-args (args) + (cond ((null args) (wt-nl "vs_base=vs_top;")) + ((consp args) + (let ((*vs* *vs*) (base *vs*)) + (dolist** (arg args) + (let ((*value-to-go* (list 'vs (vs-push)))) + (c2expr* arg))) + (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";") + (base-used))))) + +(defun push-args-lispcall (args) + (dolist** (arg args) + (let ((*value-to-go* (list 'vs (vs-push)))) + (c2expr* arg)))) + +(defun c2call-unknown-global (fname args loc inline-p) + (cond (*compiler-push-events* + ;;; Want to set up the return catcher. + (unless loc + (setq loc (list 'vs (vs-push))) + (wt-nl loc "=symbol_function(" (vv-str (add-symbol fname)) ");")) + (push-args args) + (wt-nl "funcall_with_catcher(" (vv-str (add-symbol fname)) "," loc ");") + (unwind-exit 'fun-val nil fname)) + (loc + ;;; The function was already pushed. + (push-args args) + (if inline-p + (if *safe-compile* + (wt-nl "funcall_no_event(" loc ");") + (wt-nl "CMPfuncall(" loc ");")) + (wt-nl "funcall(" loc ");")) + (unwind-exit 'fun-val)) + ((args-cause-side-effect args) + ;;; Evaluation of the arguments may cause side-effect. + ;;; Arguments are not yet pushed. + (let ((base *vs*)) + (setq loc (list 'vs (vs-push))) + (if *safe-compile* + (wt-nl loc "=symbol_function(" (vv-str (add-symbol fname)) ");") + (wt-nl loc "=(" (vv-str (add-symbol fname)) "->s.s_gfdef);")) + (push-args-lispcall args) + (cond ((or (eq *value-to-go* 'return) + (eq *value-to-go* 'top)) + (wt-nl "lispcall") + (when inline-p (wt "_no_event")) + (wt "(base+" base "," (length args) ");") + (base-used) + (unwind-exit 'fun-val)) + (t (unwind-exit + (list 'SIMPLE-CALL + (if inline-p "lispcall_no_event" "lispcall") + base (length args)))))) + ) + (t + ;;; Evaluation of the arguments causes no side-effect. + ;;; Arguments are not yet pushed. + (let ((base *vs*)) + (push-args-lispcall args) + (cond ((or (eq *value-to-go* 'return) + (eq *value-to-go* 'top)) + (wt-nl "symlispcall") + (when inline-p (wt "_no_event")) + (wt "(" (vv-str (add-symbol fname)) ",base+" base "," + (length args) ");") + (base-used) + (unwind-exit 'fun-val nil fname)) + (t (unwind-exit + (list 'SIMPLE-CALL + (if inline-p "symlispcall_no_event" "symlispcall") + base (length args) (add-symbol fname)) + nil fname)))) + ))) diff --git a/cmpnew/gcl_cmpcatch.lsp b/cmpnew/gcl_cmpcatch.lsp new file mode 100755 index 0000000..4f8a930 --- /dev/null +++ b/cmpnew/gcl_cmpcatch.lsp @@ -0,0 +1,124 @@ +;;; CMPCATCH Catch, Unwind-protect, and Throw. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'catch 'c1catch 'c1special) +(si:putprop 'catch 'c2catch 'c2) +(si:putprop 'unwind-protect 'c1unwind-protect 'c1special) +(si:putprop 'unwind-protect 'c2unwind-protect 'c2) +(si:putprop 'throw 'c1throw 'c1special) +(si:putprop 'throw 'c2throw 'c2) + +(defun c1catch (args &aux (info (make-info :sp-change t)) tag) + (incf *setjmps*) + (when (endp args) (too-few-args 'catch 1 0)) + (setq tag (c1expr (car args))) + (add-info info (cadr tag)) + (setq args (c1progn (cdr args))) + (add-info info (cadr args)) + (list 'catch info tag args)) + +(si:putprop 'push-catch-frame 'set-push-catch-frame 'set-loc) + +(defun c2catch (tag body &aux (*vs* *vs*)) + (let ((*value-to-go* '(push-catch-frame))) (c2expr* tag)) + (wt-nl "if(nlj_active)") + (wt-nl "{nlj_active=FALSE;frs_pop();") + (unwind-exit 'fun-val 'jump) + (wt "}") + (wt-nl "else{") + (let ((*unwind-exit* (cons 'frame *unwind-exit*))) + (c2expr body)) + (wt "}") + ) + +(defun set-push-catch-frame (loc) + (wt-nl "frs_push(FRS_CATCH," loc ");")) + +(defun c1unwind-protect (args &aux (info (make-info :sp-change t)) form) + (incf *setjmps*) + (when (endp args) (too-few-args 'unwind-protect 1 0)) + (setq form (let ((*blocks* (cons 'lb *blocks*)) + (*tags* (cons 'lb *tags*)) + (*vars* (cons 'lb *vars*))) + (c1expr (car args)))) + (add-info info (cadr form)) + (setq args (c1progn (cdr args))) + (add-info info (cadr args)) + (list 'unwind-protect info form args) + ) + +(defun c2unwind-protect (form body + &aux (*vs* *vs*) (loc (list 'vs (vs-push))) + top-data) + ;;; exchanged following two lines to eliminate setjmp clobbering warning + (wt-nl "frs_push(FRS_PROTECT,Cnil);") + (wt-nl "{object tag=Cnil;frame_ptr fr=NULL;object p;bool active;") + (wt-nl "if(nlj_active){tag=nlj_tag;fr=nlj_fr;active=TRUE;}") + (wt-nl "else{") + (let ((*value-to-go* 'top) + *top-data* ) + (c2expr* form) + (setq top-data *top-data*)) + (wt-nl "active=FALSE;}") + (wt-nl loc "=Cnil;") + (wt-nl "while(vs_base= (cadr x) 1)) + (setq *safe-compile* (>= (cadr x) 2)) + (setq *compiler-push-events* (>= (cadr x) 3))) + (space (setq *space* (cadr x))) + (speed (setq *speed* (cadr x))) + (compilation-speed (setq *speed* (- 3 (cadr x)))) + (t (warn "The OPTIMIZE quality ~s is unknown." (car x))))))) + (type + (if (consp (cdr decl)) + (proclaim-var (cadr decl) (cddr decl)) + (warn "The type declaration ~s is illegal." decl))) + ((fixnum character short-float long-float) + (proclaim-var (car decl) (cdr decl))) + (ftype + (cond ((and (consp (cdr decl)) + (consp (cadr decl)) + (eq (caadr decl) 'function)) + (add-function-proclamation (caddr decl) (cdr (cadr decl)) + (cddr decl))) + (t (cmpwarn "Bad function proclamation ~a" decl)))) + (function + (cond ((and (consp (cdr decl))) + (add-function-proclamation (cadr decl) (cddr decl) nil)) + (t (cmpwarn "Bad function proclamation ~a" decl)))) + (inline + (dolist** (fun (cdr decl)) + (if (symbolp fun) + (remprop fun 'cmp-notinline) + (warn "The function name ~s is not a symbol." fun)))) + (notinline + (dolist** (fun (cdr decl)) + (if (symbolp fun) + (si:putprop fun t 'cmp-notinline) + (warn "The function name ~s is not a symbol." fun)))) + ((object ignore ignorable) + (dolist** (var (cdr decl)) + (unless (symbolp var) + (warn "The variable name ~s is not a symbol." var)))) + (declaration + (dolist** (x (cdr decl)) + (if (symbolp x) + (unless (member x *alien-declarations*) + (push x *alien-declarations*)) + (warn "The declaration specifier ~s is not a symbol." x)))) + ((array atom bignum bit bit-vector character common compiled-function + complex cons double-float fixnum float hash-table integer keyword list + long-float nil null number package pathname random-state ratio rational + readtable sequence short-float simple-array simple-bit-vector + simple-string simple-vector single-float standard-char stream string + dynamic-extent :dynamic-extent + symbol t vector signed-byte unsigned-byte) + (proclaim-var (car decl) (cdr decl))) + (otherwise + (unless (member (car decl) *alien-declarations*) + (warn "The declaration specifier ~s is unknown." (car decl))) + (and (functionp (get (car decl) :proclaim)) + (dolist** (v (cdr decl)) + (funcall (get (car decl) :proclaim) v))) +) + ) + nil + ) + +(defun proclaim-var (type vl) + (setq type (type-filter type)) + (dolist** (var vl) + (cond ((symbolp var) + (let ((type1 (get var 'cmp-type)) + (v (sch-global var))) + (setq type1 (if type1 (type-and type1 type) type)) + (when v (setq type1 (type-and type1 (var-type v)))) + (when (null type1) (warn + "Inconsistent type declaration was found for the variable ~s." + var)) + (si:putprop var type1 'cmp-type) + (when v (setf (var-type v) type1)))) + (t + (warn "The variable name ~s is not a symbol." var))))) + +(defun mexpand-deftype (tp &aux (l (listp tp))(i (when l (cdr tp)))(tp (if l (car tp) tp))) + (when (symbolp tp) + (let ((fn (get tp 'si::deftype-definition))) + (when fn + (apply fn i))))) + +(defun c1body (body doc-p &aux (ss nil) (is nil) (ts nil) (others nil) + doc form) + (loop + (when (endp body) (return)) + (setq form (car body)) + (cond + ((stringp form) + (when (or (null doc-p) (endp (cdr body)) doc) (return)) + (setq doc form)) + ((and (consp form) (eq (car form) 'declare)) + (dolist** (decl (cdr form)) +;;; Add support for 'cons' declarations, such as (declare ((vector t) foo)) +;;; 20040320 CM + (cmpck (not (consp decl)) + "The declaration ~s is illegal." decl) + (let* ((dtype (car decl)) + (dtype (or (mexpand-deftype dtype) dtype))) + (if (consp dtype) + (let ((stype (car dtype))) + (cmpck (or (not (symbolp stype)) (cdddr dtype)) "The declaration ~s is illegal." decl) + (case stype + (satisfies + (push decl others)) + (otherwise + (dolist** (var (cdr decl)) + (cmpck (not (symbolp var)) + "The type declaration ~s contains a non-symbol ~s." + decl var) + (push (cons var dtype) ts))))) + (let ((stype dtype)) + (cmpck (not (symbolp stype)) "The declaration ~s is illegal." decl) + (case stype + (special + (dolist** (var (cdr decl)) + (cmpck (not (symbolp var)) + "The special declaration ~s contains a non-symbol ~s." + decl var) + (push var ss))) + ((ignore ignorable) + (dolist** (var (cdr decl)) + (cmpck (not (symbolp var)) + "The ignore declaration ~s contains a non-symbol ~s." + decl var) + (when (eq stype 'ignorable) + (push 'ignorable is)) + (push var is))) + (type + (cmpck (endp (cdr decl)) + "The type declaration ~s is illegal." decl) + (let ((type (type-filter (cadr decl)))) + (when type + (dolist** (var (cddr decl)) + (cmpck (not (symbolp var)) + "The type declaration ~s contains a non-symbol ~s." + decl var) + (push (cons var type) ts))))) + (object + (dolist** (var (cdr decl)) + (cmpck (not (symbolp var)) + "The object declaration ~s contains a non-symbol ~s." + decl var) + (push (cons var 'object) ts))) + (:register + (dolist** (var (cdr decl)) + (cmpck (not (symbolp var)) + "The register declaration ~s contains a non-symbol ~s." + decl var) + (push (cons var 'register) ts) + )) + ((:dynamic-extent dynamic-extent) + (dolist (var (cdr decl)) + (cmpck (not (symbolp var)) "The type declaration ~s contains a non-symbol ~s." + decl var) + (push (cons var :dynamic-extent) ts))) + ((fixnum character double-float short-float array atom bignum bit + bit-vector common compiled-function complex cons float hash-table + integer keyword list long-float nil null number package pathname + random-state ratio rational readtable sequence simple-array + simple-bit-vector simple-string simple-base-string simple-vector single-float + standard-char stream string symbol t vector + signed-byte unsigned-byte) + (let ((type (type-filter stype))) + (when type + (dolist** (var (cdr decl)) + (cmpck (not (symbolp var)) + "The type declaration ~s contains a non-symbol ~s." + decl var) + (push (cons var type) ts))))) + (otherwise + (push decl others)))))))) + (t (return))) + (pop body) + ) + (values body ss ts is others doc) + ) + +(defun c1decl-body (decls body &aux (dl nil)) + (if (null decls) + (c1progn body) + (let ((*function-declarations* *function-declarations*) + (*alien-declarations* *alien-declarations*) + (*notinline* *notinline*) + (*space* *space*) + (*safe-compile* *safe-compile*)) + (dolist** (decl decls dl) + (case (car decl) + (optimize + (dolist (x (cdr decl)) + (when (symbolp x) (setq x (list x 3))) + (if (or (not (consp x)) + (not (consp (cdr x))) + (not (numberp (cadr x))) + (not (<= 0 (cadr x) 3))) + (warn "The OPTIMIZE proclamation ~s is illegal." x) + (case (car x) + (safety + (setq *safe-compile* + (>= (the fixnum (cadr x)) 2)) + (push (list 'safety (cadr x)) dl)) + (space (setq *space* (cadr x)) + (push (list 'space (cadr x)) dl)) + ((speed compilation-speed)) + (t (warn "The OPTIMIZE quality ~s is unknown." + (car x))))))) + (ftype + (if (or (endp (cdr decl)) + (not (consp (cadr decl))) + (not (eq (caadr decl) 'function)) + (endp (cdadr decl))) + (warn "The function declaration ~s is illegal." decl) + (dolist** (fname (cddr decl)) + (add-function-declaration + fname (cadadr decl) (cddadr decl))))) + (function + (if (or (endp (cdr decl)) + (endp (cddr decl)) + (not (symbolp (cadr decl)))) + (warn "The function declaration ~s is illegal." decl) + (add-function-declaration + (cadr decl) (caddr decl) (cdddr decl)))) + (inline + (dolist** (fun (cdr decl)) + (if (symbolp fun) + (progn (push (list 'inline fun) dl) + (setq *notinline* (remove fun *notinline*))) + (warn "The function name ~s is not a symbol." fun)))) + (notinline + (dolist** (fun (cdr decl)) + (if (symbolp fun) + (progn (push (list 'notinline fun) dl) + (push fun *notinline*)) + (warn "The function name ~s is not a symbol." fun)))) + (declaration + (dolist** (x (cdr decl)) + (if (symbolp x) + (unless (member x *alien-declarations*) + (push x *alien-declarations*)) + (warn "The declaration specifier ~s is not a symbol." + x)))) + (otherwise + (unless (member (car decl) *alien-declarations*) + (warn "The declaration specifier ~s is unknown." + (car decl)))) + )) + (setq body (c1progn body)) + (list 'decl-body (cadr body) dl body) + ) + ) + ) + +(si:putprop 'decl-body 'c2decl-body 'c2) + +(defun c2decl-body (decls body) + (let ((*compiler-check-args* *compiler-check-args*) + (*safe-compile* *safe-compile*) + (*compiler-push-events* *compiler-push-events*) + (*notinline* *notinline*) + (*space* *space*) + ) + (dolist** (decl decls) + (case (car decl) + (safety + (let ((level (cadr decl))) + (declare (fixnum level)) + (setq *compiler-check-args* (>= level 1) + *safe-compile* (>= level 2) + *compiler-push-events* (>= level 3)))) + (space (setq *space* (cadr decl))) + (notinline (push (cadr decl) *notinline*)) + (inline + (setq *notinline* (remove (cadr decl) *notinline*))) + (otherwise (baboon)))) + (c2expr body)) + ) + +(defun check-vdecl (vnames ts is) + (dolist** (x ts) + (unless (member (car x) vnames) + (cmpwarn "Type declaration was found for not bound variable ~s." + (car x)))) + (dolist** (x is) + (unless (or (eq x 'ignorable) (member x vnames)) + (cmpwarn "Ignore/ignorable declaration was found for not bound variable ~s." x))) + ) + +(defun proclamation (decl) + (case (car decl) + (special + (dolist** (var (cdr decl) t) + (if (symbolp var) + (unless (si:specialp var) (return nil)) + (warn "The variable name ~s is not a symbol." var)))) + (optimize + (dolist (x (cdr decl) t) + (when (symbolp x) (setq x (list x 3))) + (if (or (not (consp x)) + (not (consp (cdr x))) + (not (numberp (cadr x))) + (not (<= 0 (cadr x) 3))) + (warn "The OPTIMIZE proclamation ~s is illegal." x) + (case (car x) + (safety + (unless (= (cadr x) + (cond ((null *compiler-check-args*) 0) + ((null *safe-compile*) 1) + ((null *compiler-push-events*) 2) + (t 3))) + (return nil))) + (space (unless (= (cadr x) *space*) (return nil))) + (speed (unless (= (cadr x) *speed*) (return nil))) + (compilation-speed + (unless (= (- 3 (cadr x)) *speed*) (return nil))) + (t (warn "The OPTIMIZE quality ~s is unknown." + (car x))))))) + (type + (if (consp (cdr decl)) + (let ((type (type-filter (cadr decl))) + x) + (dolist** (var (cddr decl) t) + (if (symbolp var) + (unless (and (setq x (get var 'cmp-type)) + (equal x type)) + (return nil)) + (warn "The variable name ~s is not a symbol." var)))) + (warn "The type declaration ~s is illegal." decl))) + ((fixnum character short-float long-float) + (let ((type (type-filter (car decl))) + x) + (dolist** (var (cdr decl) t) + (if (symbolp var) + (unless (and (setq x (get var 'cmp-type)) (equal x type)) + (return nil)) + (warn "The variable name ~s is not a symbol." var))))) + (ftype + (if (or (endp (cdr decl)) + (not (consp (cadr decl))) + (not (eq (caadr decl) 'function)) + (endp (cdadr decl))) + (warn "The function declaration ~s is illegal." decl) + (dolist** (fname (cddr decl) t) + (unless (and (get fname 'proclaimed-function) + (equal (function-arg-types (cadadr decl)) + (get fname 'proclaimed-arg-types)) + (equal (function-return-type (cddadr decl)) + (get fname 'proclaimed-return-type))) + (return nil))))) + (function + (if (or (endp (cdr decl)) (endp (cddr decl))) + (warn "The function declaration ~s is illegal." decl) + (and (get (cadr decl) 'proclaimed-function) + (equal (function-arg-types (caddr decl)) + (get (cadr decl) 'proclaimed-arg-types)) + (equal (function-return-type (cdddr decl)) + (get (cadr decl) 'proclaimed-return-type))))) + (inline (dolist** (fun (cdr decl) t) + (if (symbolp fun) + (when (get fun 'cmp-notinline) (return nil)) + (warn "The function name ~s is not a symbol." fun)))) + (notinline (dolist** (fun (cdr decl) t) + (if (symbolp fun) + (unless (get fun 'cmp-notinline) (return nil)) + (warn "The function name ~s is not a symbol." fun)))) + ((object ignore ignorable) + (dolist** (var (cdr decl) t) + (unless (symbolp var) + (warn "The variable name ~s is not a symbol." var)))) + (declaration (dolist** (x (cdr decl) t) + (if (symbolp x) + (unless (member x *alien-declarations*) (return nil)) + (warn "The declaration specifier ~s is not a symbol." + x)))) + ((array atom bignum bit bit-vector character common compiled-function + complex cons double-float fixnum float hash-table integer keyword list + long-float nil null number package pathname random-state ratio rational + readtable sequence short-float simple-array simple-bit-vector + simple-string simple-vector single-float standard-char stream string + dynamic-extent :dynamic-extent + symbol t vector signed-byte unsigned-byte) + (let ((type (type-filter (car decl)))) + (dolist** (var (cdr decl) t) + (if (symbolp var) + (unless (equal (get var 'cmp-type) type) (return nil)) + (warn "The variable name ~s is not a symbol." var))))) + (otherwise + (unless (member (car decl) *alien-declarations*) + (warn "The declaration specifier ~s is unknown." (car decl)))) + ) + ) + diff --git a/cmpnew/gcl_cmpeval.lsp b/cmpnew/gcl_cmpeval.lsp new file mode 100755 index 0000000..ec266c3 --- /dev/null +++ b/cmpnew/gcl_cmpeval.lsp @@ -0,0 +1,681 @@ +;;; CMPEVAL The Expression Dispatcher. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + + + +(export '(si::define-compiler-macro + si::undef-compiler-macro + si::define-inline-function) :system) + +(in-package :compiler) + +(si:putprop 'progn 'c1progn 'c1special) +(si:putprop 'progn 'c2progn 'c2) + +(si:putprop 'si:structure-ref 'c1structure-ref 'c1) +(si:putprop 'structure-ref 'c2structure-ref 'c2) +(si:putprop 'structure-ref 'wt-structure-ref 'wt-loc) +(si:putprop 'si:structure-set 'c1structure-set 'c1) +(si:putprop 'structure-set 'c2structure-set 'c2) + +(defun c1expr* (form info) + (setq form (c1expr form)) + (add-info info (cadr form)) + form) + +(defun c1expr (form) + (setq form (catch *cmperr-tag* + (cond ((symbolp form) + (cond ((eq form nil) (c1nil)) + ((eq form t) (c1t)) + ((keywordp form) + (list 'LOCATION (make-info :type (object-type form)) + (list 'VV (add-object form)))) + ((constantp form) + (let ((val (symbol-value form))) + (or (c1constant-value val nil) + (list 'LOCATION (make-info :type (object-type val)) + (list 'VV (add-constant form)))))) + (t (c1var form)))) + ((consp form) + (let ((fun (car form))) + (cond ((symbolp fun) + (c1symbol-fun fun (cdr form))) + ((and (consp fun) (eq (car fun) 'lambda)) + (c1lambda-fun (cdr fun) (cdr form))) + ((and (consp fun) (eq (car fun) 'si:|#,|)) + (cmperr "Sharp-comma-macro was found in a bad place.")) + (t (cmperr "The function ~s is illegal." fun))))) + (t (c1constant-value form t))))) + (if (eq form '*cmperr-tag*) (c1nil) form)) + +(si::putprop 'si:|#,| 'c1sharp-comma 'c1special) +(si::putprop 'load-time-value 'c1load-time-value 'c1special) + +(defun c1sharp-comma (arg) + (c1constant-value (cons 'si:|#,| arg) t)) + +(defun c1load-time-value (arg) + (c1constant-value + (cons 'si:|#,| + (if *compiler-compile* + (let ((x (cmp-eval (car arg)))) + (if (and (cdr arg) (cadr arg)) + x + `(si::nani ,(si::address x)))) + (car arg))) + t)) + +(si::putprop 'si::define-structure 'c1define-structure 't1) + +(defun c1define-structure (arg &aux *sharp-commas*) + (declare (special *sharp-commas*)) + (eval (cons 'si::define-structure arg)) + (c1constant-value (cons 'si:|#,| (cons 'si::define-structure arg)) t) + (add-load-time-sharp-comma) + nil) + +(defvar *c1nil* (list 'LOCATION (make-info :type (object-type nil)) nil)) +(defun c1nil () *c1nil*) +(defvar *c1t* (list 'LOCATION (make-info :type (object-type t)) t)) +(defun c1t () *c1t*) + + +(defun flags-pos (flag &aux (i 0)) + (declare (fixnum i)) + (dolist + (v + '((allocates-new-storage ans); might invoke gbc + (side-effect-p set) ; no effect on arguments + (constantp) ; always returns same result, + ;double eval ok. + (result-type-from-args rfa); if passed args of matching + ;type result is of result type + (is))) ;; extends the `integer stack'. + (cond ((member flag v :test 'eq) + (return-from flags-pos i))) + (setq i (+ i 1))) + (error "unknown opt flag")) + +(defmacro flag-p (n flag) + `(logbitp ,(flags-pos flag) ,n)) + +;; old style opts had '(args ret new-storage side-effect string) +;; these new-storage and side-effect have been combined into +;; one integer, along with several other flags. + +(defun fix-opt (opt) + (let ((a (cddr opt))) + (unless (typep (car a ) 'fixnum) + (if *compiler-in-use* + (cmpwarn "Obsolete optimization: use fix-opt ~s" opt)) + + (setf (cddr opt) + (cons (logior (if (car a) 2 0) + (if (cadr a) 1 0)) + (cddr a)))) + opt)) + +;; some hacks for revising a list of optimizers. +#+revise +(progn +(defun output-opt (opt sym flag) + (fix-opt opt) + (format t "(push '(~(~s ~s #.(flags~)" (car opt) (second opt)) + (let ((o (third opt))) + (if (flag-p o set) (princ " set")) + (if (flag-p o ans) (princ " ans")) + (if (flag-p o rfa) (princ " rfa")) + (if (flag-p o constantp) (princ "constantp "))) + (format t ")") + (if (and (stringp (nth 3 opt)) + (> (length (nth 3 opt)) 40)) + (format t "~% ")) + (prin1 (nth 3 opt)) + (format t ")~% ~((get '~s '~s)~))~%" sym flag)) + +(defun output-all-opts (&aux lis did) + (sloop::sloop + for v in ;(list (find-package "LISP")) + (list-all-packages) + do + (setq lis + (sloop::sloop + for sym in-package (package-name v) + when (or (get sym 'inline-always) + (get sym 'inline-safe) + (get sym 'inline-unsafe)) + collect sym)) + (setq lis (sort lis #'(lambda (x y) (string-lessp (symbol-name x) + (symbol-name y))))) + do + (sloop::sloop for sym in lis do + (format t "~%;;~s~% " sym) + (sloop::sloop for u in '(inline-always inline-safe inline-unsafe) + do (sloop::sloop + for w in (nreverse (remove-duplicates + (copy-list (get sym u)) + :test 'equal)) + do (output-opt w sym u)))))) + +) + + +(defun result-type-from-args(f args &aux tem) + (when (if (setq tem (get f 'return-type)) + (and (not (eq tem '*)) (not (consp tem))) t) + (dolist (v '(inline-always inline-unsafe)) + (dolist (w (get f v)) + (fix-opt w) + (when (and + (flag-p (third w) result-type-from-args) + (eql (length args) (length (car w))) + (do ((a args (cdr a)) + (b (car w) (cdr b))) + ((null a) t) + (unless (or (eq (car a) (car b)) + (type>= (car b)(car a) )) + (return nil)))) + (return-from result-type-from-args (second w))))))) + + +;; omitting a flag means it is set to nil. +(defmacro flags (&rest lis &aux (i 0)) + (dolist (v lis) + (setq i (logior i (ash 1 (flags-pos v))))) + i) + +;; Usage: +; (flagp-p (caddr ii) side-effect-p) +; (push '((integer integer) integer #.(flags const raf) "addii(#0,#1)") +; (get '+ 'inline-always)) + + + +(defun c1symbol-fun (fname args &aux fd) + (cond ((setq fd (get fname 'c1special)) (funcall fd args)) + ((and (setq fd (get fname 'co1special)) + (funcall fd fname args))) + ((setq fd (c1local-fun fname)) + (if (eq (car fd) 'call-local) + ;; c1local-fun now adds fun-info into (cadr fd), so we need no longer + ;; do it explicitly here. CM 20031030 + (let* ((info (add-info (make-info :sp-change t) (cadr fd))) + (forms (c1args args info))) + (let ((return-type (get-local-return-type (caddr fd)))) + (when return-type (setf (info-type info) return-type))) + (let ((arg-types (get-local-arg-types (caddr fd)))) + ;;; Add type information to the arguments. + (when arg-types + (let ((fl nil)) + (dolist** (form forms) + (cond ((endp arg-types) (push form fl)) + (t (push (and-form-type + (car arg-types) form + (car args)) + fl) + (pop arg-types) + (pop args)))) + (setq forms (nreverse fl))))) + (list 'call-local info (cddr fd) forms)) + (c1expr (cmp-expand-macro fd fname args)))) + ((and (setq fd (get fname 'co1)) + (inline-possible fname) + (funcall fd fname args))) + ((and (setq fd (get fname 'c1)) (inline-possible fname)) + (funcall fd args)) + ((and (setq fd (get fname 'c1conditional)) + (inline-possible fname) + (funcall (car fd) args)) + (funcall (cdr fd) args)) + ;; record the call info if we get to here + ((progn + (and (eq (symbol-package fname) (symbol-package 'and)) + (not (fboundp fname)) + (cmpwarn "~A (in lisp package) is called as a function--not yet defined" + fname)) + (and *record-call-info* (record-call-info 'record-call-info + fname)) + nil)) + ;;continue + ((setq fd (macro-function fname)) + (c1expr (cmp-expand-macro fd fname args))) + ((setq fd (get fname 'compiler-macro)) + (c1expr (cmp-eval `(funcall ',fd ',(cons fname args) nil)))) + ((and (setq fd (get fname 'si::structure-access)) + (inline-possible fname) + ;;; Structure hack. + (consp fd) + (si:fixnump (cdr fd)) + (not (endp args)) + (endp (cdr args))) + (case (car fd) + (vector (c1expr `(elt ,(car args) ,(cdr fd)))) + (list (c1expr `(si:list-nth ,(cdr fd) ,(car args)))) + (t (c1structure-ref1 (car args) (car fd) (cdr fd))) + ) + ) + ((eq fname 'si:|#,|) + (cmperr "Sharp-comma-macro was found in a bad place.")) + (t (let* ((info (make-info + :sp-change (null (get fname 'no-sp-change)))) + (forms (c1args args info))) ;; info updated by args here + (let ((return-type (get-return-type fname))) + (when return-type + (if (equal return-type '(*)) + (setf return-type nil) + (setf (info-type info) return-type)))) + (let ((arg-types (get-arg-types fname))) + ;;; Add type information to the arguments. + (when arg-types + (do ((fl forms (cdr fl)) + (fl1 nil) + (al args (cdr al))) + ((endp fl) + (setq forms (nreverse fl1))) + (cond ((endp arg-types) (push (car fl) fl1)) + (t (push (and-form-type (car arg-types) + (car fl) + (car al)) + fl1) + (pop arg-types)))))) + (let ((arg-types (get fname 'arg-types))) + ;;; Check argument types. + (when arg-types + (do ((fl forms (cdr fl)) + (al args (cdr al))) + ((or (endp arg-types) (endp fl))) + (check-form-type (car arg-types) + (car fl) (car al)) + (pop arg-types)))) + (case fname + (aref + (let ((etype (info-type (cadar forms)))) + (when (or (and (eq etype 'string) + (setq etype 'character)) + (and (consp etype) + (or (eq (car etype) 'array) + (eq (car etype) 'vector)) + (setq etype (cadr etype)))) + (setq etype + (type-and (info-type info) etype)) + (when (null etype) + (cmpwarn + "Type mismatch was found in ~s." + (cons fname args))) + (setf (info-type info) etype)))) + (si:aset + (let ((etype (info-type (cadar forms)))) + (when (or (and (eq etype 'string) + (setq etype 'character)) + (and (consp etype) + (or (eq (car etype) 'array) + (eq (car etype) 'vector)) + (setq etype (cadr etype)))) + (setq etype + (type-and (info-type info) + (type-and (info-type + (cadar (last forms))) + etype))) + (when (null etype) + (cmpwarn + "Type mismatch was found in ~s." + (cons fname args))) + (setf (info-type info) etype) + (setf (info-type (cadar (last forms))) + etype) + )))) + ;; some functions can have result type deduced from + ;; arg types. + + (let ((tem (result-type-from-args fname + (mapcar #'(lambda (x) (info-type (cadr x))) + forms)))) + (when tem + (setq tem (type-and tem (info-type info))) + (setf (info-type info) tem))) + (list 'call-global info fname forms))) + ) + ) + +;;numbers and character constants may be sometimes used, instead +;;of the variable, eg inside eql + +(defun replace-constant (lis &aux found tem) + (do ((v lis (cdr v))) + ((null v) found) + (cond ((and (constantp (car v)) + (or (numberp (setq tem(eval (car v)))) + (characterp tem))) + (setq found t) (setf (car v) tem))))) + + + +(defun c1lambda-fun (lambda-expr args &aux (info (make-info :sp-change t))) + (setq args (c1args args info)) + (setq lambda-expr (c1lambda-expr lambda-expr)) + (add-info info (cadr lambda-expr)) + (list 'call-lambda info lambda-expr args) + ) + +(defun c2expr (form) + (if (eq (car form) 'call-global) + (c2call-global (caddr form) (cadddr form) nil (info-type (cadr form))) + (if (or (eq (car form) 'let) + (eq (car form) 'let*)) + (let ((*volatile* (volatile (cadr form)))) + (declare (special *volatile*)) + (apply (get (car form) 'c2) (cddr form))) + (let ((tem (get (car form) 'c2))) + (cond (tem (apply tem (cddr form))) + ((setq tem (get (car form) 'wholec2)) + (funcall tem form)) + (t (baboon))))))) + +(defun c2funcall-sfun (fn args info &aux locs (all (cons fn args))) info + (let ((*inline-blocks* 0)) + (setq locs (get-inline-loc + (list (make-list (length all) :initial-element t) + t #.(flags ans set) 'fcalln-inline) all)) + (unwind-exit locs) + (close-inline-blocks))) + +(defun c2expr* (form) + (let* ((*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*))) + (c2expr form) + (wt-label *exit*)) + ) + +(defun c2expr-top (form top &aux (*vs* 0) (*max-vs* 0) (*level* (1+ *level*)) + (*reservation-cmacro* (next-cmacro))) + (wt-nl "{register object *base" (1- *level*) "=base;") + (base-used) + (wt-nl "{register object *base=V" top ";") + (wt-nl "register object *sup=vs_base+VM" *reservation-cmacro* ";") + ;;; Dummy assignments for lint + (wt-nl "base" (1- *level*) "[0]=base" (1- *level*) "[0];") + (wt-nl "base[0]=base[0];") + (if *safe-compile* + (wt-nl "vs_reserve(VM" *reservation-cmacro* ");") + (wt-nl "vs_check;")) + (wt-nl) (reset-top) + (c2expr form) + (push (cons *reservation-cmacro* *max-vs*) *reservations*) + (wt-nl "}}") + ) + +(defun c2expr-top* (form top) + (let* ((*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*))) + (c2expr-top form top) + (wt-label *exit*))) + +(defun c1progn (forms &aux (fl nil)) + (cond ((endp forms) (c1nil)) + ((endp (cdr forms)) (c1expr (car forms))) + (t (let ((info (make-info))) + (dolist (form forms) + (setq form (c1expr form)) + (push form fl) + (add-info info (cadr form))) + (setf (info-type info) (info-type (cadar fl))) + (list 'progn info (nreverse fl)) + ))) + ) + +;;; Should be deleted. +(defun c1progn* (forms info) + (setq forms (c1progn forms)) + (add-info info (cadr forms)) + forms) + +(defun c2progn (forms) + ;;; The length of forms may not be less than 1. + (do ((l forms (cdr l))) + ((endp (cdr l)) + (c2expr (car l))) + (declare (object l)) + (let* ((*value-to-go* 'trash) + (*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*))) + (c2expr (car l)) + (wt-label *exit*) + )) + ) + +(defun c1args (forms info) + (mapcar #'(lambda (form) (c1expr* form info)) forms)) + +;;; Structures + +(defun c1structure-ref (args) + (if (and (not *safe-compile*) + (not (endp args)) + (not (endp (cdr args))) + (consp (cadr args)) + (eq (caadr args) 'quote) + (not (endp (cdadr args))) + (symbolp (cadadr args)) + (endp (cddadr args)) + (not (endp (cddr args))) + (si:fixnump (caddr args)) + (endp (cdddr args))) + (c1structure-ref1 (car args) (cadadr args) (caddr args)) + (let ((info (make-info))) + (list 'call-global info 'si:structure-ref (c1args args info))))) + +(defun c1structure-ref1 (form name index &aux (info (make-info))) + ;;; Explicitly called from c1expr and c1structure-ref. + (cond (*safe-compile* (c1expr `(si::structure-ref ,form ',name ,index))) + ((let* ((sd (get name 'si::s-data)) + (aet-type (aref (si::s-data-raw sd) index)) + (sym (find-symbol (si::string-concatenate + (or (si::s-data-conc-name sd) "") + (car (nth index (si::s-data-slot-descriptions sd)))))) + (tp (if sym (get-return-type sym) '*)) + (tp (type-filter (type-and tp (aref *aet-types* aet-type))))) + + (setf (info-type info) (if (and (eq name 'si::s-data) (= index 2));;FIXME -- this belongs somewhere else. CM 20050106 + '(vector unsigned-char) + tp)) + (list 'structure-ref info + (c1expr* form info) + (add-symbol name) + index sd))))) + +(defun coerce-loc-structure-ref (arg type-wanted &aux (form (cdr arg))) + (let* ((sd (fourth form)) + (index (caddr form))) + (cond (sd + (let* ((aet-type (aref (si::s-data-raw sd) index)) + (type (aref *aet-types* aet-type))) + (cond ((eq (inline-type (type-filter type)) 'inline) + (or (eql aet-type 0) (error "bad type ~a" type)))) + (setf (info-type (car arg)) (type-filter type)) + (coerce-loc + (list (inline-type + (type-filter type)) + (flags) + 'my-call + (list + (car + (inline-args (list (car form)) + '(t))) + 'joe index sd)) + (type-filter type-wanted))) + ) + (t (wfs-error))))) + + +(defun c2structure-ref (form name-vv index sd + &aux (*vs* *vs*) (*inline-blocks* 0)) + (let ((loc (car (inline-args (list form) '(t)))) + (type (aref *aet-types* (aref (si::s-data-raw sd) index)))) + (unwind-exit + (list (inline-type (type-filter type)) + (flags) 'my-call + (list loc name-vv + index sd)))) + (close-inline-blocks) + ) + + +(defun my-call (loc name-vv ind sd) name-vv + (let* ((raw (si::s-data-raw sd)) + (spos (si::s-data-slot-position sd))) + (if *safe-compile* (wfs-error) + (wt "STREF(" (aet-c-type (aref *aet-types* (aref raw ind)) ) + "," loc "," (aref spos ind) ")")))) + + +(defun c1structure-set (args &aux (info (make-info))) + (if (and (not (endp args)) (not *safe-compile*) + (not (endp (cdr args))) + (consp (cadr args)) + (eq (caadr args) 'quote) + (not (endp (cdadr args))) + (symbolp (cadadr args)) + (endp (cddadr args)) + (not (endp (cddr args))) + (si:fixnump (caddr args)) + (not (endp (cdddr args))) + (endp (cddddr args))) + (let ((x (c1expr (car args))) + (y (c1expr (cadddr args)))) + (add-info info (cadr x)) + (add-info info (cadr y)) + (setf (info-type info) (info-type (cadr y))) + (list 'structure-set info x + (add-symbol (cadadr args)) ;;; remove QUOTE. + (caddr args) y (get (cadadr args) 'si::s-data))) + (list 'call-global info 'si:structure-set (c1args args info)))) + + +;; The following (side-effects) exists for putting at the end of an +;; argument list to force all previous arguments to be stored in +;; variables, when computing inline-args. + + +(push '(() t #.(flags ans set) "Ct") (get 'side-effects 'inline-always)) + +(defun c2structure-set (x name-vv ind y sd + &aux locs (*vs* *vs*) (*inline-blocks* 0)) + name-vv + (let* ((raw (si::s-data-raw sd)) + (type (aref *aet-types* (aref raw ind))) + (spos (si::s-data-slot-position sd)) + (tftype (type-filter type)) + ix iy) + + (setq locs (inline-args + (list x y (list 'call-global (make-info) 'side-effects nil)) + (if (eq type t) '(t t t) + `(t ,tftype t)))) + + (setq ix (car locs)) + (setq iy (cadr locs)) + (if *safe-compile* (wfs-error)) + (wt-nl "STSET(" (aet-c-type type )"," + ix "," (aref spos ind) ", " iy ");") + (unwind-exit (list (inline-type tftype) (flags) 'wt-loc (list iy))) + (close-inline-blocks) + )) + +(defun c1constant-value (val always-p) + (cond + ((eq val nil) (c1nil)) + ((eq val t) (c1t)) + ((when (si:fixnump val) (< most-negative-fixnum val)) + (list 'LOCATION (make-info :type 'fixnum) + (list 'FIXNUM-VALUE (and (>= (abs val) 1024)(add-object val)) + val))) + ((characterp val) + (list 'LOCATION (make-info :type 'character) + (list 'CHARACTER-VALUE (add-object val) (char-code val)))) + ((typep val 'long-float) + ;; We can't read in long-floats which are too big: + (let* (sc (vv (cond ((> (abs val) (/ most-positive-long-float 2)) + (add-object `(si::|#,| * ,(/ val most-positive-long-float) most-positive-long-float))) + ((< (abs val) (* least-positive-normalized-long-float 2.0)) + (add-object `(si::|#,| * ,(/ val least-positive-normalized-long-float) least-positive-normalized-long-float))) + ((setq sc t) (add-object val))))) + `(location ,(make-info :type 'long-float) + ,(if sc (list 'LONG-FLOAT-VALUE vv val) (list 'vv vv))))) + ((typep val 'short-float) + (list 'LOCATION (make-info :type 'short-float) + (list 'SHORT-FLOAT-VALUE (add-object val) val))) + ((and *compiler-compile* (not *keep-gaz*)) + (list 'LOCATION (make-info :type (object-type val)) + (list 'VV (add-object (cons 'si::|#,| `(si::nani ,(si::address val))))))) + (always-p + (list 'LOCATION (make-info :type (object-type val)) + (list 'VV (add-object val)))) + (t nil))) + +(defmacro si::define-compiler-macro (name vl &rest body) + `(progn (si:putprop ',name + (caddr (si:defmacro* ',name ',vl ',body)) + 'compiler-macro) + ',name)) + +(defun si::undef-compiler-macro (name) + (remprop name 'compiler-macro)) + +(defvar *compiler-temps* + '(tmp0 tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7 tmp8 tmp9)) + +(defmacro si:define-inline-function (name vars &body body) + (let ((temps nil) + (*compiler-temps* *compiler-temps*)) + (dolist (var vars) + (if (and (symbolp var) + (not (si:memq var '(&optional &rest &key &aux)))) + (push (or (pop *compiler-temps*) + (gentemp "TMP" (find-package 'compiler))) + temps) + (error "The parameter ~s for the inline function ~s is illegal." + var name))) + (let ((binding (cons 'list (mapcar + #'(lambda (var temp) `(list ',var ,temp)) + vars temps)))) + `(progn + (defun ,name ,vars ,@body) + (si:define-compiler-macro ,name ,temps + (list* 'let ,binding ',body)))))) + +(defun name-to-sd (x &aux sd) + (or (and (symbolp x) (setq sd (get x 'si::s-data))) + (error "The structure ~a is undefined." x)) + sd) + +;; lay down code for a load time eval constant. +(defun name-sd1 (x) + (or (get x 'name-to-sd) + (setf (get x 'name-sd) + `(si::|#,| name-to-sd ',x)))) + +(defun co1structure-predicate (f args &aux tem) + (cond ((and (symbolp f) + (setq tem (get f 'si::struct-predicate))) + (c1expr `(typep ,(car args) ',tem))))) + + diff --git a/cmpnew/gcl_cmpflet.lsp b/cmpnew/gcl_cmpflet.lsp new file mode 100755 index 0000000..ce00ca0 --- /dev/null +++ b/cmpnew/gcl_cmpflet.lsp @@ -0,0 +1,405 @@ +;;; CMPFLET Flet, Labels, and Macrolet. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'flet 'c1flet 'c1special) +(si:putprop 'flet 'c2flet 'c2) +(si:putprop 'labels 'c1labels 'c1special) +(si:putprop 'labels 'c2labels 'c2) +(si:putprop 'macrolet 'c1macrolet 'c1special) +;;; c2macrolet is not defined, because MACROLET is replaced by PROGN +;;; during Pass 1. +(si:putprop 'call-local 'c2call-local 'c2) + +(defstruct fun + name ;;; Function name. + ref ;;; Referenced or not. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the vs-address for the + ;;; function closure, or NIL. + ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the vs-address for the + ;;; function closure, or NIL. + cfun ;;; The cfun for the function. + level ;;; The level of the function. + + info ;;; fun-info; CM, 20031008 + ;;; collect info structure when processing + ;;; function lambda list in flet and labels + ;;; and pass upwards to call-local and call-global + ;;; to determine more accurately when + ;;; args-info-changed-vars should prevent certain + ;;; inlining + ;;; examples: (defun foo (a) (flet ((%f8 nil (setq a 0))) + ;;; (let ((v9 a)) (- (%f8) v9)))) + ;;; (defun foo (a) (flet ((%f8 nil (setq a 2))) + ;;; (* a (%f8)))) + ) + +(defvar *funs* nil) + +;;; During Pass 1, *funs* holds a list of fun objects, local macro definitions +;;; and the symbol 'CB' (Closure Boundary). 'CB' will be pushed on *funs* +;;; when the compiler begins to process a closure. A local macro definition +;;; is a list ( macro-name expansion-function). + +(defun c1flet (args &aux body ss ts is other-decl info + (defs1 nil) (local-funs nil) (closures nil) (*info* (copy-info *info*))) + (when (endp args) (too-few-args 'flet 1 0)) + + (let ((*funs* *funs*)) + (dolist** (def (car args)) + (cmpck (or (endp def) + (not (symbolp (car def))) + (endp (cdr def))) + "The function definition ~s is illegal." def) + (let ((fun (make-fun :name (car def) :ref nil :ref-ccb nil :info (make-info :sp-change t)))) + (push fun *funs*) + (push (list fun (cdr def)) defs1))) + + (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) + + (let ((*vars* *vars*)) + (c1add-globals ss) + (check-vdecl nil ts is) + (setq body (c1decl-body other-decl body))) + + (setq info (copy-info (cadr body)))) + + (dolist* (def (setq defs1 (nreverse defs1))) + (when (fun-ref-ccb (car def)) + (let ((*vars* (cons 'cb *vars*)) + (*funs* (cons 'cb *funs*)) + (*blocks* (cons 'cb *blocks*)) + (*tags* (cons 'cb *tags*))) + (let ((lam (c1lambda-expr (cadr def) (fun-name (car def))))) + (add-info info (cadr lam)) + ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, + ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args + ;; via args-info-changed-vars + (add-info (fun-info (car def)) (cadr lam)) + (push (list (car def) lam) closures)))) + + (when (fun-ref (car def)) + (let ((*blocks* (cons 'lb *blocks*)) + (*tags* (cons 'lb *tags*)) + (*vars* (cons 'lb *vars*))) + (let ((lam (c1lambda-expr (cadr def) (fun-name (car def))))) + (add-info info (cadr lam)) + ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, + ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args + ;; via args-info-changed-vars + (add-info (fun-info (car def)) (cadr lam)) + (push (list (car def) lam) local-funs)))) + + (when (or (fun-ref (car def)) (fun-ref-ccb (car def))) + (setf (fun-cfun (car def)) (next-cfun)))) + + ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, + ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args + ;; via args-info-changed-vars + ;; + ;; walk body a second time to incorporate changed variable info from local function + ;; lambda lists + + (let ((*funs* *funs*)) + + (setq *funs* (nconc (mapcar 'car defs1) *funs*)) + + (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) + + (let ((*vars* *vars*)) + (c1add-globals ss) + (check-vdecl nil ts is) + (setq body (c1decl-body other-decl body))) + + ;; Apparently this is not scricttly necessary, just changes to body + (add-info info (cadr body))) + + (if (or local-funs closures) + (list 'flet info (nreverse local-funs) (nreverse closures) body) + body)) + +(defun c2flet (local-funs closures body + &aux (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) + + (dolist** (def local-funs) + (setf (fun-level (car def)) *level*) + ;; Append *initial-ccb-vs* here and use it to initialize *initial-ccb-vs* when writing + ;; the code for this function. Local functions, unlike closures, get an envinment + ;; level with the *initial-ccb-vs* at this point, and *ccb-vs* can be further incremented + ;; here, in c2tagbody-ccb, and in c2block-ccb. CM 20031130 + (push (list nil *clink* *ccb-vs* (car def) (cadr def) *initial-ccb-vs*) *local-funs*)) + + ;;; Setup closures. + (dolist** (def closures) + (push (list 'closure + (if (null *clink*) nil (cons 'fun-env 0)) + *ccb-vs* (car def) (cadr def)) + *local-funs*) + (push (car def) *closures*) + (let ((fun (car def))) + (declare (object fun)) + (setf (fun-ref fun) (vs-push)) + (wt-nl) + (wt-vs (fun-ref fun)) + (wt "=make_cclosure_new(" (c-function-name "LC" (fun-cfun fun) (fun-name fun)) ",Cnil,") (wt-clink) + (wt ",Cdata);") + (wt-nl) + (wt-vs (fun-ref fun)) + (wt "=MMcons(") (wt-vs (fun-ref fun)) (wt ",") (wt-clink) (wt ");") + (clink (fun-ref fun)) + (setf (fun-ref-ccb fun) (ccb-vs-push)) + )) + + (c2expr body) + ) + +(defun c1labels (args &aux body ss ts is other-decl info + (defs1 nil) (local-funs nil) (closures nil) + (fnames nil) (processed-flag nil) (*funs* *funs*) (*info* (copy-info *info*))) + (when (endp args) (too-few-args 'labels 1 0)) + + ;;; bind local-functions + (dolist** (def (car args)) + (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def))) + "The local function definition ~s is illegal." def) + (cmpck (member (car def) fnames) + "The function ~s was already defined." (car def)) + (push (car def) fnames) + (let ((fun (make-fun :name (car def) :ref nil :ref-ccb nil :info (make-info :sp-change t)))) + (push fun *funs*) + (push (list fun nil nil (cdr def)) defs1))) + + (setq defs1 (nreverse defs1)) + + ;;; Now DEFS1 holds ( { ( fun-object NIL NIL body ) }* ). + + (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) + (let ((*vars* *vars*)) + (c1add-globals ss) + (check-vdecl nil ts is) + (setq body (c1decl-body other-decl body))) + (setq info (copy-info (cadr body))) + + (block local-process + (loop + (setq processed-flag nil) + (dolist** (def defs1) + (when (and (fun-ref (car def)) ;;; referred locally and + (null (cadr def))) ;;; not processed yet + (setq processed-flag t) + (setf (cadr def) t) + (let ((*blocks* (cons 'lb *blocks*)) + (*tags* (cons 'lb *tags*)) + (*vars* (cons 'lb *vars*))) + (let ((lam (c1lambda-expr (cadddr def) (fun-name (car def))))) + (add-info info (cadr lam)) + ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, + ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args + ;; via args-info-changed-vars + (add-info (fun-info (car def)) (cadr lam)) + (push (list (car def) lam) local-funs))))) + (unless processed-flag (return-from local-process)) + )) ;;; end local process + + (block closure-process + (loop + (setq processed-flag nil) + (dolist** (def defs1) + (when (and (fun-ref-ccb (car def)) ; referred across closure + (null (caddr def))) ; and not processed + (setq processed-flag t) + (setf (caddr def) t) + (let ((*vars* (cons 'cb *vars*)) + (*funs* (cons 'cb *funs*)) + (*blocks* (cons 'cb *blocks*)) + (*tags* (cons 'cb *tags*))) + (let ((lam (c1lambda-expr (cadddr def) (fun-name (car def))))) + (add-info info (cadr lam)) + ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, + ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args + ;; via args-info-changed-vars + (add-info (fun-info (car def)) (cadr lam)) + (push (list (car def) lam) closures)))) + ) + (unless processed-flag (return-from closure-process)) + )) ;;; end closure process + + (dolist** (def defs1) + (when (or (fun-ref (car def)) (fun-ref-ccb (car def))) + (setf (fun-cfun (car def)) (next-cfun)))) + + ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, + ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args + ;; via args-info-changed-vars + ;; + ;; walk body a second time to gather info in labels lambda lists + + (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) + (let ((*vars* *vars*)) + (c1add-globals ss) + (check-vdecl nil ts is) + (setq body (c1decl-body other-decl body))) + (add-info info (cadr body)) + + (if (or local-funs closures) + (list 'labels info (nreverse local-funs) (nreverse closures) body) + body)) + +(defun c2labels (local-funs closures body &aux (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) + + ;;; Prepare for cross-referencing closures. + (dolist** (def closures) + (let ((fun (car def))) + (declare (object fun)) + (setf (fun-ref fun) (vs-push)) + (wt-nl) + (wt-vs (fun-ref fun)) + (wt "=MMcons(Cnil,") (wt-clink) (wt ");") + (clink (fun-ref fun)) + (setf (fun-ref-ccb fun) (ccb-vs-push)) + )) + + (dolist** (def local-funs) + (setf (fun-level (car def)) *level*) + ;; Append *initial-ccb-vs* here and use it to initialize *initial-ccb-vs* when writing + ;; the code for this function. Local functions, unlike closures, get an envinment + ;; level with the *initial-ccb-vs* at this point, and *ccb-vs* can be further incremented + ;; here, in c2tagbody-ccb, and in c2block-ccb. CM 20031130 + (push (list nil *clink* *ccb-vs* (car def) (cadr def) *initial-ccb-vs*) *local-funs*)) + + ;;; Then make closures. + (dolist** (def closures) + (push (list 'closure (if (null *clink*) nil (cons 'fun-env 0)) + *ccb-vs* (car def) (cadr def)) + *local-funs*) + (push (car def) *closures*) + (wt-nl) + (wt-vs* (fun-ref (car def))) + (wt "=make_cclosure_new(" (c-function-name "LC" (fun-cfun (car def)) (fun-name (car def))) ",Cnil,") (wt-clink) + (wt ",Cdata);") + ) + + ;;; now the body of flet + + (c2expr body) + ) + +(defun c1macrolet (args &aux body ss ts is other-decl + (*funs* *funs*) (*vars* *vars*)) + (when (endp args) (too-few-args 'macrolet 1 0)) + (dolist** (def (car args)) + (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def))) + "The macro definition ~s is illegal." def) + (push (list (car def) + (caddr (si:defmacro* (car def) (cadr def) (cddr def)))) + *funs*)) + (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) + (c1add-globals ss) + (check-vdecl nil ts is) + (c1decl-body other-decl body) + ) + +(defun c1local-fun (fname &aux (ccb nil)) + (declare (object ccb)) + (dolist* (fun *funs* nil) + (cond ((eq fun 'CB) (setq ccb t)) + ((consp fun) + (when (eq (car fun) fname) (return (cadr fun)))) + ((eq (fun-name fun) fname) + (if ccb + (setf (fun-ref-ccb fun) t) + (setf (fun-ref fun) t)) + ;; Add fun-info here at the bottom of the call-local processing tree + ;; FIXME -- understand why special variable *info* is used in certain + ;; cases and copy-info in othes. + ;; This extends local call arg side-effect protection (via args-info-changed-vars) + ;; through c1funob to other call methods than previously supported c1symbol-fun, + ;; e.g. c1multiple-value-call, etc. CM 20031030 + (add-info *info* (fun-info fun)) + (return (list 'call-local *info* fun ccb)))))) + +(defun sch-local-fun (fname) + ;;; Returns fun-ob for the local function (not locat macro) named FNAME, + ;;; if any. Otherwise, returns FNAME itself. + (dolist* (fun *funs* fname) + (when (and (not (eq fun 'CB)) + (not (consp fun)) + (eq (fun-name fun) fname)) + (return fun))) + ) + +(defun c1local-closure (fname &aux (ccb nil)) + (declare (object ccb)) + ;;; Called only from C1FUNCTION. + (dolist* (fun *funs* nil) + (cond ((eq fun 'CB) (setq ccb t)) + ((consp fun) + (when (eq (car fun) fname) (return (cadr fun)))) + ((eq (fun-name fun) fname) + (setf (fun-ref-ccb fun) t) + ;; Add fun-info here at the bottom of the call-local processing tree + ;; FIXME -- understand why special variable *info* is used in certain + ;; cases and copy-info in othes. + ;; This extends local call arg side-effect protection (via args-info-changed-vars) + ;; through c1funob to other call methods than previously supported c1symbol-fun, + ;; e.g. c1multiple-value-call, etc. CM 20031030 + (add-info *info* (fun-info fun)) + (return (list 'call-local *info* fun ccb)))))) + +(defun c2call-local (fd args &aux (*vs* *vs*)) + ;;; FD is a list ( fun-object ccb ). + (cond + ((cadr fd) + (push-args args) + (wt-nl "funcall(") (wt-ccb-vs (fun-ref-ccb (car fd))) (wt ");")) + ((and (listp args) + *do-tail-recursion* + *tail-recursion-info* + (eq (car *tail-recursion-info*) (car fd)) + (eq *exit* 'RETURN) + (tail-recursion-possible) + (= (length args) (length (cdr *tail-recursion-info*)))) + (let* ((*value-to-go* 'trash) + (*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*))) + (c2psetq (mapcar #'(lambda (v) (list v nil)) + (cdr *tail-recursion-info*)) + args) + (wt-label *exit*)) + (unwind-no-exit 'tail-recursion-mark) + (wt-nl "goto TTL;") + (cmpnote "Tail-recursive call of ~s was replaced by iteration." + (fun-name (car fd)))) + (t (push-args args) + (wt-nl (c-function-name "L" (fun-cfun (car fd)) (fun-name (car fd))) "(") + (dotimes** (n (fun-level (car fd))) + (if (when *closure-p* (zerop n)) (wt "fun->cc.cc_turbo,") (wt "base" n ","))) + (wt "base") + (unless (= (fun-level (car fd)) *level*) (wt (fun-level (car fd)))) + (wt ");") + (base-used))) + (unwind-exit 'fun-val) + ) + diff --git a/cmpnew/gcl_cmpfun.lsp b/cmpnew/gcl_cmpfun.lsp new file mode 100755 index 0000000..7304568 --- /dev/null +++ b/cmpnew/gcl_cmpfun.lsp @@ -0,0 +1,969 @@ +;; CMPFUN Library functions. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'princ 'c1princ 'c1) +(si:putprop 'princ 'c2princ 'c2) +(si:putprop 'terpri 'c1terpri 'c1) + +(si:putprop 'apply 'c1apply 'c1) +(si:putprop 'apply 'c2apply 'c2) +(si:putprop 'apply-optimize 'c2apply-optimize 'c2) +(si:putprop 'funcall 'c1funcall 'c1) + +(si:putprop 'rplaca 'c1rplaca 'c1) +(si:putprop 'rplaca 'c2rplaca 'c2) +(si:putprop 'rplacd 'c1rplacd 'c1) +(si:putprop 'rplacd 'c2rplacd 'c2) + +(si:putprop 'si::memq 'c1memq 'c1) +(si:putprop 'member 'c1member 'c1) +(si:putprop 'member!2 'c2member!2 'c2) +(si:putprop 'assoc 'c1assoc 'c1) +(si:putprop 'assoc!2 'c2assoc!2 'c2) +(si:putprop 'get 'c1get 'c1) +(si:putprop 'get 'c2get 'c2) + +(si:putprop 'nth '(c1nth-condition . c1nth) 'c1conditional) +(si:putprop 'nthcdr '(c1nthcdr-condition . c1nthcdr) 'c1conditional) +(si:putprop 'si:rplaca-nthcdr 'c1rplaca-nthcdr 'c1) +(si:putprop 'si:list-nth 'c1list-nth 'c1) +(si:putprop 'list-nth-immediate 'c2list-nth-immediate 'c2) + +(si:putprop 'gethash 'c1gethash 'c1) +(si:putprop 'gethash 'c2gethash 'c2) + + +(defvar *princ-string-limit* 80) + +(defun c1princ (args &aux stream (info (make-info))) + (when (endp args) (too-few-args 'princ 1 0)) + (unless (or (endp (cdr args)) (endp (cddr args))) + (too-many-args 'princ 2 (length args))) + (setq stream (if (endp (cdr args)) + (c1nil) + (c1expr* (cadr args) info))) + (if (and (or (and (stringp (car args)) + (<= (length (car args)) *princ-string-limit*)) + (characterp (car args))) + (or (endp (cdr args)) + (and (eq (car stream) 'var) + (member (var-kind (caaddr stream)) '(GLOBAL SPECIAL))))) + (list 'princ info (car args) + (if (endp (cdr args)) nil (var-loc (caaddr stream))) + stream) + (list 'call-global info 'princ + (list (c1expr* (car args) info) stream)))) + +(defun c2princ (string vv-index stream) + (cond ((eq *value-to-go* 'trash) + (cond ((characterp string) + (wt-nl "princ_char(" (char-code string)) + (if (null vv-index) (wt ",Cnil") (wt "," (vv-str vv-index))) + (wt ");")) + ((= (length string) 1) + (wt-nl "princ_char(" (char-code (aref string 0))) + (if (null vv-index) (wt ",Cnil") (wt "," (vv-str vv-index))) + (wt ");")) + (t + (wt-nl "princ_str(\"") + (dotimes** (n (length string)) + (let ((char (schar string n))) + (cond ((char= char #\\) (wt "\\\\")) + ((char= char #\") (wt "\\\"")) + ((char= char #\Newline) (wt "\\n")) + ((char= char #\Return) (wt "\\r")) + (t (wt char))))) + (wt "\",") + (if (null vv-index) (wt "Cnil") (wt (vv-str vv-index))) + (wt ");"))) + (unwind-exit nil)) + ((eql string #\Newline) (c2call-global 'terpri (list stream) nil t)) + (t (c2call-global + 'princ + (list (list 'LOCATION + (make-info :type + (if (characterp string) 'character 'string)) + (list 'VV (add-object string))) + stream) nil t)))) + +(defun c1terpri (args &aux stream (info (make-info))) + (unless (or (endp args) (endp (cdr args))) + (too-many-args 'terpri 1 (length args))) + (setq stream (if (endp args) + (c1nil) + (c1expr* (car args) info))) + (if (or (endp args) + (and (eq (car stream) 'var) + (member (var-kind (caaddr stream)) '(GLOBAL SPECIAL)))) + (list 'princ info #\Newline + (if (endp args) nil (var-loc (caaddr stream))) + stream) + (list 'call-global info 'terpri (list stream)))) + +(defun c1apply (args &aux info) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'apply 2 (length args))) + (let ((funob (c1funob (car args)))) + (setq info (copy-info (cadr funob))) + (setq args (c1args (cdr args) info)) + (cond ((eq (car funob) 'call-lambda) + (let* ((lambda-expr (caddr funob)) + (lambda-list (caddr lambda-expr))) + (declare (object lambda-expr lambda-list)) + (if (and (null (cadr lambda-list)) ; No optional + (null (cadddr lambda-list))) ; No keyword + (c1apply-optimize info + (car lambda-list) + (caddr lambda-list) + (car (cddddr lambda-expr)) + args) + (list 'apply info funob args)))) + (t (list 'apply info funob args)))) + ) + +(defun c2apply (funob args &aux (*vs* *vs*) loc) + (setq loc (save-funob funob)) + (let ((*vs* *vs*) (base *vs*) (last-arg (list 'CVAR (next-cvar)))) + (do ((l args (cdr l))) + ((endp (cdr l)) + (wt-nl "{object " last-arg ";") + (let ((*value-to-go* last-arg)) (c2expr* (car l)))) + (declare (object l)) + (let ((*value-to-go* (list 'vs (vs-push)))) (c2expr* (car l)))) + (wt-nl " vs_top=base+" *vs* ";") + (base-used) + (cond (*safe-compile* + (wt-nl " while(!endp(" last-arg "))") + (wt-nl " {vs_push(car(" last-arg "));") + (wt last-arg "=cdr(" last-arg ");}")) + (t + (wt-nl " while(" last-arg "!=Cnil)") + (wt-nl " {vs_push((" last-arg ")->c.c_car);") + (wt last-arg "=(" last-arg ")->c.c_cdr;}"))) + (wt-nl "vs_base=base+" base ";}") + (base-used)) + (c2funcall funob 'args-pushed loc) + ) + +(defun c1apply-optimize (info requireds rest body args + &aux (vl nil) (fl nil)) + (do () + ((or (endp (cdr args)) (endp requireds))) + (push (pop requireds) vl) + (push (pop args) fl)) + + (cond ((cdr args) ;;; REQUIREDS is NIL. + (cmpck (null rest) + "APPLY passes too many arguments to LAMBDA expression.") + (push rest vl) + (push (list 'call-global info 'list* args) fl) + (list 'let info (reverse vl) (reverse fl) body)) + (requireds ;;; ARGS is singleton. + (let ((temp (make-var :kind 'LEXICAL :ref t))) + (push temp vl) + (push (car args) fl) + (list 'let info (reverse vl) (reverse fl) + (list 'apply-optimize + (cadr body) temp requireds rest body)))) + (rest (push rest vl) + (push (car args) fl) + (list 'let info (reverse vl) (reverse fl) body)) + (t + (let ((temp (make-var :kind 'LEXICAL :ref t))) + (push temp vl) + (push (car args) fl) + (list 'let info (reverse vl) (reverse fl) + (list 'apply-optimize + (cadr body) temp requireds rest body)))) + ) + ) + +(defun c2apply-optimize (temp requireds rest body + &aux (*unwind-exit* *unwind-exit*) (*vs* *vs*) + (*clink* *clink*) (*ccb-vs* *ccb-vs*)) + (when (or *safe-compile* *compiler-check-args*) + (wt-nl (if rest "ck_larg_at_least" "ck_larg_exactly") + "(" (length requireds) ",") + (wt-var temp nil) + (wt ");")) + + (dolist** (v requireds) (setf (var-ref v) (vs-push))) + (when rest (setf (var-ref rest) (vs-push))) + + (do ((n 0 (1+ n)) + (vl requireds (cdr vl))) + ((endp vl) + (when rest + (wt-nl) (wt-vs (var-ref rest)) (wt "= ") + (dotimes** (i n) (wt "(")) + (wt-var temp nil) + (dotimes** (i n) (wt-nl ")->c.c_cdr")) + (wt ";"))) + (declare (fixnum n) (object vl)) + (wt-nl) (wt-vs (var-ref (car vl))) (wt "=(") + (dotimes** (i n) (wt "(")) + (wt-var temp nil) + (dotimes** (i n) (wt-nl ")->c.c_cdr")) + (wt ")->c.c_car;")) + + (dolist** (var requireds) (c2bind var)) + (when rest (c2bind rest)) + + (c2expr body) + ) + +(defun c1funcall (args &aux funob (info (make-info))) + (when (endp args) (too-few-args 'funcall 1 0)) + (setq funob (c1funob (car args))) + (add-info info (cadr funob)) + (list 'funcall info funob (c1args (cdr args) info)) + ) + + +(defun c1rplaca (args &aux (info (make-info))) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'rplaca 2 (length args))) + (unless (endp (cddr args)) + (too-many-args 'rplaca 2 (length args))) + (setq args (c1args args info)) + (list 'rplaca info args)) + +(defun c2rplaca (args &aux (*vs* *vs*) (*inline-blocks* 0)) + (setq args (inline-args args '(t t))) + (safe-compile + (wt-nl "if(type_of(" (car args) ")!=t_cons)" + "FEwrong_type_argument(Scons," (car args) ");")) + (wt-nl "(" (car args) ")->c.c_car = " (cadr args) ";") + (unwind-exit (car args)) + (close-inline-blocks) + ) + +(defun c1rplacd (args &aux (info (make-info))) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'rplacd 2 (length args))) + (when (not (endp (cddr args))) + (too-many-args 'rplacd 2 (length args))) + (setq args (c1args args info)) + (list 'rplacd info args)) + +(defun c2rplacd (args &aux (*vs* *vs*) (*inline-blocks* 0)) + (setq args (inline-args args '(t t))) + (safe-compile + (wt-nl "if(type_of(" (car args) ")!=t_cons)" + "FEwrong_type_argument(Scons," (car args) ");")) + (wt-nl "(" (car args) ")->c.c_cdr = SAFE_CDR(" (cadr args) ");") + (unwind-exit (car args)) + (close-inline-blocks) + ) + +(defun c1memq (args &aux (info (make-info))) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'si::memq 2 (length args))) + (unless (endp (cddr args)) + (too-many-args 'si::memq 2 (length args))) + (list 'member!2 info 'eq (c1args (list (car args) (cadr args)) info))) + +(defun c1member (args &aux (info (make-info))) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'member 2 (length args))) + (cond ((endp (cddr args)) + (list 'member!2 info 'eql (c1args args info))) + ((and (eq (caddr args) :test) + (eql (length args) 4) + (member (cadddr args) '('eq #'eq 'equal #'equal + 'equalp #'equalp 'eql #'eql) + :test 'equal)) + (list 'member!2 info (cadr (cadddr args)) + (c1args (list (car args) (cadr args)) info))) + (t + (list 'call-global info 'member (c1args args info))))) + +(defun c2member!2 (fun args + &aux (*vs* *vs*) (*inline-blocks* 0) (l (next-cvar))) + (setq args (inline-args args '(t t))) + (wt-nl "{register object x= " (car args) ",V" l "= " (cadr args) ";") + (if *safe-compile* + (wt-nl "while(!endp(V" l "))") + (wt-nl "while(V" l "!=Cnil)")) + (if (eq fun 'eq) + (wt-nl "if(x==(V" l "->c.c_car)){") + (wt-nl "if(" (string-downcase (symbol-name fun)) + "(x,V" l "->c.c_car)){")) + (if (and (consp *value-to-go*) + (or (eq (car *value-to-go*) 'JUMP-TRUE) + (eq (car *value-to-go*) 'JUMP-FALSE))) + (unwind-exit t 'JUMP) + (unwind-exit (list 'CVAR l) 'JUMP)) + (wt-nl "}else V" l "=V" l "->c.c_cdr;") + (unwind-exit nil) + (wt "}") + (close-inline-blocks) + ) + +(defun c1assoc (args &aux (info (make-info))) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'assoc 2 (length args))) + (cond ((endp (cddr args)) + (list 'assoc!2 info 'eql (c1args args info))) + ((and (eq (caddr args) ':test) + (eql (length args) 4) + (member (cadddr args) '('eq #'eq 'equal #'equal + 'equalp #'equalp 'eql #'eql) + :test 'equal)) + (list 'assoc!2 info (cadr (cadddr args)) (c1args (list (car args) (cadr args)) info))) + (t + (list 'call-global info 'assoc (c1args args info))))) + +(defun c2assoc!2 (fun args + &aux (*vs* *vs*) (*inline-blocks* 0) (al (next-cvar))name) + (setq args (inline-args args '(t t))) + (setq name (symbol-name fun)) + (or (eq fun 'eq) (setq name (string-downcase name))) + (wt-nl "{register object x= " (car args) ",V" al "= " (cadr args) ";") + (cond (*safe-compile* + (wt-nl "while(!endp(V" al "))") + (wt-nl "if(type_of(V"al"->c.c_car)==t_cons &&" + name "(x,V" al "->c.c_car->c.c_car)){")) + (t + (wt-nl "while(V" al "!=Cnil)") + (wt-nl "if(" name "(x,V" al "->c.c_car->c.c_car) &&" + "V"al"->c.c_car != Cnil){"))) + (if (and (consp *value-to-go*) + (or (eq (car *value-to-go*) 'jump-true) + (eq (car *value-to-go*) 'jump-false))) + (unwind-exit t 'jump) + (unwind-exit (list 'CAR al) 'jump)) + (wt-nl "}else V" al "=V" al "->c.c_cdr;") + (unwind-exit nil) + (wt "}") + (close-inline-blocks) + ) + + + + +(defun boole3 (a b c) (boole a b c)) +;(si:putprop 'boole '(c1boole-condition . c1boole3) 'c1conditional) + +(defun c1boole-condition (args) + (and (not (endp (cddr args))) + (endp (cdddr args)) + (inline-boole3-string (car args)))) + +(defun c1boole3 (args) + (c1expr (cons 'boole3 args))) + +(defun inline-boole3 (&rest args) + (let ((boole-op-arg (second (car args)))) + (or (eq (car boole-op-arg) 'fixnum-value) (error "must be constant")) + (let ((string (inline-boole3-string (third boole-op-arg)))) + (or string (error "should not get here boole opt")) + (wt-inline-loc string (cdr args))))) + +(defun inline-boole3-string (op-code) + (and (constantp op-code) (setq op-code (eval op-code))) + (case op-code + (#. boole-andc1 "((~(#0))&(#1))") + (#. boole-andc2 "(((#0))&(~(#1)))") + (#. boole-nor "(~((#0)|(#1)))") + (#. boole-orc1 "(~(#0)) | (#1)))") + (#. boole-orc2 "((#0) | (~(#1)))") + (#. boole-nand "(~((#0) & (#1)))") + (#. boole-eqv "(~((#0) ^ (#1)))") + (#. boole-and "((#0) & (#1))") + (#. boole-xor "((#0) ^ (#1))") + (#. boole-ior "((#0) | (#1))"))) + +(si:putprop 'ash '(c1ash-condition . c1ash) 'c1conditional) + +(defun c1ash-condition (args &aux (z '#.(let ((z (integer-length most-positive-fixnum))) `(integer ,(- z) ,z)))) + (let ((shamt (second args))) + (or (typep shamt z) + (and (consp shamt) + (eq (car shamt) 'the) + (let ((type (cadr shamt))) + (subtypep type z)))))) + +(defun c1ash (args) + (let ((shamt (second args))fun) + (cond ((constantp shamt) (setq shamt (eval shamt)) + (or (si:fixnump shamt) (error "integer shift only")) + (cond ((< shamt 0) (setq fun 'shift>> )) + ((>= shamt 0) (setq fun 'shift<<)))) + (t (let ((type (second shamt))) + ;;it had to be a (the type..) + (cond ((subtypep type '#.`(integer 0 ,(integer-length most-positive-fixnum))) + (setq fun 'shift<< )) + ((subtypep type '#.`(integer ,(- (integer-length most-positive-fixnum)) 0)) + (setq fun 'shift>> )) + (t (error "should not get here"))) + ))) + (c1expr (cons fun args)))) +(defun shift>> (a b) (ash a b)) +(defun shift<< (a b) (ash a b)) +(si:putprop 'ash '(c1ash-condition . c1ash) 'c1conditional) +(si:putprop 'shift>> "Lash" 'lfun) +(si:putprop 'shift<< "Lash" 'lfun) + +(si::putprop 'ldb 'co1ldb 'co1) + +(defun co1ldb (f args &aux tem (len (integer-length most-positive-fixnum))) f + (let ((specs + (cond ((and (consp (setq tem (first args))) + (eq 'byte (car tem)) + (cons (second tem) (third tem))))))) + (cond ((and (integerp (cdr specs)) + (integerp (car specs)) + (< (+ (car specs)(cdr specs)) + len) + (subtypep (result-type (second args)) 'fixnum)) + (c1expr `(the fixnum (si::ldb1 ,(car specs) ,(cdr specs) ,(second args)))))))) + + +(si:putprop 'length 'c1length 'c1) + +(defun c1length (args &aux (info (make-info))) + (setf (info-type info) 'fixnum) + (cond ((and (consp (car args)) + (eq (caar args) 'symbol-name) + (let ((args1 (cdr (car args)))) + (and args1 (not (cddr args1)) + (list 'call-global info 'symbol-length + (c1args args1 info)))))) + (t (setq args (c1args args info)) + (list 'call-global info 'length args )))) + + +(defun c1get (args &aux (info (make-info))) + + (when (or (endp args) (endp (cdr args))) + (too-few-args 'get 2 (length args))) + (when (and (not (endp (cddr args))) (not (endp (cdddr args)))) + (too-many-args 'get 3 (length args))) + (list 'get info (c1args args info))) + +(defun c2get (args) + (if *safe-compile* + (c2call-global 'get args nil t) + (let ((*vs* *vs*) (*inline-blocks* 0) (pl (next-cvar))) + (setq args (inline-args args (if (cddr args) '(t t t) '(t t)))) + (wt-nl "{object V" pl" =(" (car args) ")->s.s_plist;") + (wt-nl " object ind= " (cadr args) ";") + (wt-nl "while(V" pl "!=Cnil){") + (wt-nl "if(V" pl "->c.c_car==ind){") + (unwind-exit (list 'CADR pl) 'jump) + (wt-nl "}else V" pl "=V" pl "->c.c_cdr->c.c_cdr;}") + (unwind-exit (if (cddr args) (caddr args) nil)) + (wt "}") + (close-inline-blocks))) + ) + +(defun co1eql (f args) f + (or (and (cdr args) (not *safe-compile*)) + (return-from co1eql nil)) + (cond ((replace-constant args) + (cond ((characterp (second args)) + (setq args (reverse args)))) + (cond ((characterp (car args)) + (let ((c (gensym))) + (c1expr + `(let ((,c ,(second args))) + (declare (type ,(result-type (second args)) + ,c)) + (and (typep ,c 'character) + (= (char-code ,(car args)) + (the fixnum + (char-code + (the character + ,c))) + )))))))))) + + + +(si::putprop 'eql 'co1eql 'co1) + +(defvar *frozen-defstructs* nil) + +;; Return the most particular type we can EASILY obtain +;; from x. +(defun result-type (x) + (cond ((symbolp x) + (let ((tem (c1expr x))) + (info-type (second tem)))) + ((constantp x) + (type-filter (type-of x))) + ((and (consp x) (eq (car x) 'the)) + (type-filter (second x))) + (t t))) + + + +(defvar *type-alist* + '((fixnum . si::fixnump) + (float . floatp) + (si::spice . si::spice-p) + (short-float . short-float-p) + (long-float . long-float-p) + (integer . integerp) + (character . characterp) + (symbol . symbolp) + (cons . consp) + (null . null) + (array . arrayp) + (vector . vectorp) + (bit-vector . bit-vector-p) + (string . stringp) + (list . (lambda (y) (or (consp y) (null y)))) + (number . numberp) + (rational . rationalp) + (complex . complexp) + (ratio . ratiop) + (sequence . (lambda (y) (or (listp y) (vectorp y)))) + (function . functionp) + )) + + +(defun co1typep (f args &aux tem) f + (let* + ((x (car args)) new + (type (and (consp (second args)) + (eq (car (second args)) 'quote) + (second (second args))))) + (cond ((subtypep (result-type (car args)) type) + (setq new t) + (return-from co1typep (c1expr new)))) + (setq new + (cond + ((null type) nil) + ((setq f (assoc type *type-alist* :test 'equal)) + (list (cdr f) x)) + ((setq f (when (symbolp type) (get type 'si::type-predicate))) + (list f x)) + ((and (consp type) (eq (car type) 'or)) + `(or ,@(mapcar (lambda (y) `(typep ,x ',y)) (cdr type)))) + ((and (consp type) (eq (car type) 'member)) + `(or ,@(mapcar (lambda (y) `(eql ,x ',y)) (cdr type)))) + ((and (consp type) (eq (car type) 'eql)) + `(eql ,x ',(cadr type))) + ((and (consp type) + (or (and (eq (car type) 'vector) + (null (cddr type))) + (and + (member (car type) + '(array vector simple-array)) + (equal (third type) '(*))))) + (setq tem (si::best-array-element-type + (second type))) + (cond ((eq tem 'character) `(stringp ,x)) + ((eq tem 'bit) `(bit-vector-p ,x)) + ((setq tem (position tem *aet-types*)) + `(the boolean (vector-type ,x ,tem))))) + ((and (consp type) + (eq (car type) 'satisfies) + (consp (cdr type)) + (cadr type) + (symbolp (cadr type)) + (symbol-package (cadr type)) + (null (cddr type)) + `(,(cadr type) ,x))) + ((subtypep type 'fixnum) + (setq tem (si::normalize-type type)) + (and (consp tem) + (si::fixnump (second tem)) + (si::fixnump (third tem)) + `(let ((.tem ,x)) + (declare (type ,(result-type x) .tem)) + (and (typep .tem 'fixnum) + (>= (the fixnum .tem) ,(second tem)) + (<= (the fixnum .tem) ,(third tem)))))) + ((and (symbolp type) + (setq tem (get type 'si::s-data))) + (cond ((or (si::s-data-frozen tem) + *frozen-defstructs*) + (struct-type-opt x tem)) + (t + `(si::structure-subtype-p + ,x ',type)))) + ((and (symbolp type) (setq tem (get type 'si::deftype-definition))) + `(typep ,x ',(funcall tem))) + ;; ((and (print (list 'slow 'typep type)) nil)) + (t nil))) + (and new (c1expr `(the boolean , new))))) + +;; this is going the wrong way. want to go up.. +(defun struct-type-opt (x sd) + (let ((s (gensym)) + (included (get-included (si::s-data-name sd)))) + `(let ((,s ,x)) + (and + (si::structurep ,s) + ,(cond ((< (length included) 3) + `(or ,@ + (mapcar #'(lambda (x) + `(eq (si::structure-def ,s) + ,(name-sd1 x))) + included))) + (t `(si::structure-subtype-p ,s + ,(name-sd1 + (si::s-data-name sd))))))))) + +(defun get-included (name) + (let ((sd (get name 'si::s-data))) + (cons (si::s-data-name sd) + (mapcan 'get-included + (si::s-data-included sd))))) + + + +(si::putprop 'typep 'co1typep 'co1) + +(defun co1schar (f args) f + (and (listp (car args)) (not *safe-compile*) + (cdr args) + (eq (caar args) 'symbol-name) + (c1expr `(aref (the string ,(second (car args))) + ,(second args))))) + +(si::putprop 'schar 'co1schar 'co1) + +(si::putprop 'cons 'co1cons 'co1) +;; turn repetitious cons's into a list* + +(defun cons-to-lista (x) + (let ((tem (last x))) + (cond + ((and (consp tem) + (consp (car tem)) + (eq (caar tem) 'cons) + (eql (length (cdar tem)) 2) + (cons-to-lista (append (butlast x) + (cdar tem))))) + (t x)))) + + +(defun co1cons (f args) f + (let ((tem (and (eql (length args) 2) (cons-to-lista args)))) + (and (not (eq tem args)) + (c1expr (if (equal '(nil) (last tem)) + (cons 'list (butlast tem)) + (cons 'list* tem)))))) + +;; I don't feel it is good to replace the list call, but rather +;; usually better the other way around. We removed c1list +;; because of possible feedback. + +(defun c1nth-condition (args) + (and (not (endp args)) + (not (endp (cdr args))) + (endp (cddr args)) + (numberp (car args)) + (<= 0 (car args) 7))) + +(defun c1nth (args) + (c1expr (case (car args) + (0 (cons 'car (cdr args))) + (1 (cons 'cadr (cdr args))) + (2 (cons 'caddr (cdr args))) + (3 (cons 'cadddr (cdr args))) + (4 (list 'car (cons 'cddddr (cdr args)))) + (5 (list 'cadr (cons 'cddddr (cdr args)))) + (6 (list 'caddr (cons 'cddddr (cdr args)))) + (7 (list 'cadddr (cons 'cddddr (cdr args)))) + ))) + +(defun c1nthcdr-condition (args) + (and (not (endp args)) + (not (endp (cdr args))) + (endp (cddr args)) + (numberp (car args)) + (<= 0 (car args) 7))) + +(defun c1nthcdr (args) + (c1expr (case (car args) + (0 (cadr args)) + (1 (cons 'cdr (cdr args))) + (2 (cons 'cddr (cdr args))) + (3 (cons 'cdddr (cdr args))) + (4 (cons 'cddddr (cdr args))) + (5 (list 'cdr (cons 'cddddr (cdr args)))) + (6 (list 'cddr (cons 'cddddr (cdr args)))) + (7 (list 'cdddr (cons 'cddddr (cdr args)))) + ))) + +(defun c1rplaca-nthcdr (args &aux (info (make-info))) + (when (or (endp args) (endp (cdr args)) (endp (cddr args))) + (too-few-args 'si:rplaca-nthcdr 3 (length args))) + (unless (endp (cdddr args)) + (too-few-args 'si:rplaca-nthcdr 3 (length args))) + (if (and (numberp (cadr args)) (<= 0 (cadr args) 10)) + (let ((x (gensym))(y (gensym))) + (c1expr + `(let ((,x ,(car args)) + (,y ,(third args))) + (setf ,x (nthcdr ,(cadr args) ,x)) + (setf (car ,x) ,y) + ,y))) + (list 'call-global info 'si:rplaca-nthcdr (c1args args info)))) + + +;; Facilities for faster reading and writing from file streams. +;; You must declare the stream to be :in-file +;; or :out-file + +(si::putprop 'read-byte 'co1read-byte 'co1) +(si::putprop 'read-char 'co1read-char 'co1) +(si::putprop 'write-byte 'co1write-byte 'co1) +(si::putprop 'write-char 'co1write-char 'co1) + + + +(defun fast-read (args read-fun) + (cond + ((and (not *safe-compile*) + (< *space* 2) + (null (second args)) + (boundp 'si::*eof*)) + (cond + ((atom (car args)) + (or (car args) (setq args (cons '*standard-input* (cdr args)))) + (let ((stream (car args)) + (eof (third args))) + `(let ((ans 0)) + (declare (fixnum ans)) + (cond ((fp-okp ,stream) + (setq ans (sgetc1 ,stream)) + (cond ((and (eql ans ,si::*eof*) + (sfeof ,stream)) + ,eof) + (t ,(if (eq read-fun 'read-char1) + '(code-char ans) 'ans)) + )) + (t + (,read-fun ,stream ,eof) + ) + )))) + (t + `(let ((.strm. ,(car args))) + (declare (type ,(result-type (car args)) .strm.)) + ,(fast-read (cons '.strm. (cdr args)) read-fun))))))) + +(defun co1read-byte (f args &aux tem) f + (cond ((setq tem (fast-read args 'read-byte1)) + (let ((*space* 10)) ;prevent recursion! + (c1expr tem))))) + +(defun co1read-char (f args &aux tem) f + (cond ((setq tem (fast-read args 'read-char1)) + (let ((*space* 10)) ;prevent recursion! + (c1expr tem))))) + +(defun cfast-write (args write-fun) + (cond + ((and (not *safe-compile*) + (< *space* 2) + (boundp 'si::*eof*)) + (let ((stream (second args))) + (or stream (setq stream '*standard-output*)) + (cond + ((atom stream) + `(cond ((fp-okp ,stream) + (the fixnum (sputc .ch ,stream))) + (t (,write-fun .ch ,stream)))) + (t `(let ((.str ,stream)) + (declare (type ,(result-type stream) .str)) + ,(cfast-write (list '.ch '.str) write-fun)))))))) + +(defun co1write-byte (f args) f + (let ((tem (cfast-write args 'write-byte))) + (if tem (let ((*space* 10)) + (c1expr + `(let ((.ch ,(car args))) + (declare (fixnum .ch)) + ,tem + ,(if (atom (car args)) (car args) '.ch))))))) + +(defun co1write-char (f args) f + (let ((tem (cfast-write args 'write-char))) + (if tem (let ((*space* 10)) + (c1expr + `(let ((.ch ,(car args))) + (declare (character .ch)) + ,tem + ,(if (atom (car args)) (car args) '.ch))))))) + + + +(defvar *aet-types* + #(T CHARACTER SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT + SIGNED-CHAR + UNSIGNED-CHAR SIGNED-SHORT UNSIGNED-SHORT)) + + +(defun aet-c-type (type) + (ecase type + ((t) "object") + ((character signed-char) "char") + (fixnum "fixnum") + (unsigned-char "unsigned char") + (unsigned-short "unsigned short") + (signed-short "short") + (unsigned-short "unsigned short") + (long-float "longfloat") + (short-float "shortfloat"))) + + +(si:putprop 'vector-push 'co1vector-push 'co1) +(si:putprop 'vector-push-extend 'co1vector-push 'co1) +(defun co1vector-push (f args) f + (unless + (or *safe-compile* + (> *space* 3) + (null (cdr args)) + ) + (let ((*space* 10)) + (c1expr + `(let* ((.val ,(car args)) + (.v ,(second args)) + (.i (fill-pointer .v)) + (.dim (array-total-size .v))) + (declare (fixnum .i .dim)) + (declare (type ,(result-type (second args)) .v)) + (declare (type ,(result-type (car args)) .val)) + (cond ((< .i .dim) + (the fixnum (si::fill-pointer-set .v (the fixnum (+ 1 .i)))) + (si::aset .v .i .val) + .i) + (t ,(cond ((eq f 'vector-push-extend) + `(vector-push-extend .val + .v ,@(cddr args))))))))))) + +(defun constant-fold-p (x) + (cond ((constantp x) t) + ((atom x) nil) + ((eq (car x) 'the) + (constant-fold-p (third x))) + ((and + (symbolp (car x)) + (eq (get (car x) 'co1) + 'co1constant-fold)) + (dolist (w (cdr x)) + (or (constant-fold-p w) + (return-from constant-fold-p nil))) + t) + (t nil))) + +(defun co1constant-fold (f args ) + (cond ((and (fboundp f) + (dolist (v args t) + (or (constant-fold-p v) + (return-from co1constant-fold nil)))) + (c1expr (cmp-eval (cons f args)))))) + + +(si::putprop 'sublis 'co1sublis 'co1) +(defun co1sublis (f args &aux test) f + (and (case (length args) + (2 (setq test 'eql)) + (4 (and (eq (third args) :test) + (cond ((member (fourth args) '(equal (function equal))) (setq test 'equal)) + ((member (fourth args) '(eql (function eql))) (setq test 'eql)) + ((member (fourth args) '(eq (function eq))) (setq test 'eq)) + )))) + (let ((s (gensym))) + (c1expr `(let ((,s ,(car args))) + (sublis1 ,s ,(second args) ',test)))))) + +(defun sublis1-inline (a b c) + (let ((tst (ltvp-eval (cadr c)))) + (or (member tst '(eq equal eql)) (error "bad test")) + (wt "(check_alist(" a "),sublis1("a "," b "," (format nil "&o~(~a~)))" tst)))) + + +;; end new + +(defun c1list-nth (args &aux (info (make-info))) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'si:rplaca-nthcdr 2 (length args))) + (unless (endp (cddr args)) + (too-few-args 'si:rplaca-nthcdr 2 (length args))) + (if (and (numberp (car args)) (<= 0 (car args) 10)) + (list 'list-nth-immediate info + (car args) + (c1args (list (cadr args)) info)) + (list 'call-global info 'si:list-nth (c1args args info)))) + +(defun c2list-nth-immediate (index args &aux (l (next-cvar)) + (*vs* *vs*) (*inline-blocks* 0)) + (setq args (inline-args args '(t t))) + (wt-nl "{object V" l "= ") + (if *safe-compile* + (progn + (dotimes** (i index) (wt "cdr(")) + (wt (car args)) + (dotimes** (i index) (wt ")")) + (wt ";") + (wt-nl "if((type_of(V" l ")!=t_cons) && (" (car args) "!= Cnil))") + (wt-nl " FEwrong_type_argument(Scons,V" l ");") + ) + (progn + (wt-nl (car args)) + (dotimes** (i index) (wt-nl "->c.c_cdr")) + (wt ";"))) + (unwind-exit (list 'CAR l)) + (wt "}") + (close-inline-blocks) + ) + + +(defun c1gethash (args) + (unless (cdr args) (too-few-args 'gethash 2 (length args))) + (when (cdddr args) (too-many-args 'gethash 3 (length args))) + (let* ((info (make-info)) + (nargs (c1args args info))) + `(gethash ,info ,nargs))) + +(defun c2gethash (args) + (cond ((member *value-to-go* '(top return)) + (let* ((nargs (inline-args args '(t t))) + (base *vs*)(*vs* *vs*) + (r (cdr (vs-push)))(f (cdr (vs-push)))) + (wt-nl "{ struct htent *_z=gethash" (if *safe-compile* "_with_check" "") "(" (car nargs) "," (cadr nargs) ");") + (wt-nl "if (_z->hte_key==OBJNULL) {") + (wt-nl "base[" r "]=" (caddr nargs) ";") + (wt-nl "base[" f "]=Cnil;") + (wt-nl "} else {") + (wt-nl "base[" r "]=_z->hte_value;") + (wt-nl "base[" f "]=Ct;") + (wt-nl "}}") + (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";") + (unwind-exit 'fun-val nil (cons 'values 2)))) + ((let ((*inline-blocks* 0) + (*restore-avma* *restore-avma*) + (fd `((t t) t #.(flags rfa) + ,(concatenate 'string + "({struct htent *_z=gethash" + (if *safe-compile* "_with_check" "") + "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})")))) + (save-avma fd) + (unwind-exit (get-inline-loc fd args)) + (close-inline-blocks))))) diff --git a/cmpnew/gcl_cmpif.lsp b/cmpnew/gcl_cmpif.lsp new file mode 100755 index 0000000..ce75b75 --- /dev/null +++ b/cmpnew/gcl_cmpif.lsp @@ -0,0 +1,437 @@ +;;; CMPIF Conditionals. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'if 'c1if 'c1special) +(si:putprop 'if 'c2if 'c2) +(si:putprop 'and 'c1and 'c1) +(si:putprop 'and 'c2and 'c2) +(si:putprop 'or 'c1or 'c1) +(si:putprop 'or 'c2or 'c2) + +(si:putprop 'jump-true 'set-jump-true 'set-loc) +(si:putprop 'jump-false 'set-jump-false 'set-loc) + +(si:putprop 'case 'c1case 'c1) +(si:putprop 'ecase 'c1ecase 'c1) +(si:putprop 'case 'c2case 'c2) + +(defun c1if (args &aux info f) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'if 2 (length args))) + (unless (or (endp (cddr args)) (endp (cdddr args))) + (too-many-args 'if 3 (length args))) + (setq f (c1fmla-constant (car args))) + + (case f + ((t) (c1expr (cadr args))) + ((nil) (if (endp (cddr args)) (c1nil) (c1expr (caddr args)))) + (otherwise + (setq info (make-info)) + (list 'if info + (c1fmla f info) + (c1expr* (cadr args) info) + (if (endp (cddr args)) (c1nil) (c1expr* (caddr args) info))))) + ) + +(defun c1fmla-constant (fmla &aux f) + (cond + ((consp fmla) + (case (car fmla) + (and (do ((fl (cdr fmla) (cdr fl))) + ((endp fl) t) + (declare (object fl)) + (setq f (c1fmla-constant (car fl))) + (case f + ((t)) + ((nil) (return nil)) + (t (if (endp (cdr fl)) + (return f) + (return (list* 'and f (cdr fl)))))))) + (or (do ((fl (cdr fmla) (cdr fl))) + ((endp fl) nil) + (declare (object fl)) + (setq f (c1fmla-constant (car fl))) + (case f + ((t) (return t)) + ((nil)) + (t (if (endp (cdr fl)) + (return f) + (return (list* 'or f (cdr fl)))))))) + ((not null) + (when (endp (cdr fmla)) (too-few-args 'not 1 0)) + (unless (endp (cddr fmla)) + (too-many-args 'not 1 (length (cdr fmla)))) + (setq f (c1fmla-constant (cadr fmla))) + (case f + ((t) nil) + ((nil) t) + (t (list 'not f)))) + (t fmla))) + ((symbolp fmla) (if (constantp fmla) + (if (symbol-value fmla) t nil) + fmla)) + (t t)) + ) + +(defun c1fmla (fmla info) + (if (consp fmla) + (case (car fmla) + (and (case (length (cdr fmla)) + (0 (c1t)) + (1 (c1fmla (cadr fmla) info)) + (t (cons 'FMLA-AND + (mapcar #'(lambda (x) (c1fmla x info)) + (cdr fmla)))))) + (or (case (length (cdr fmla)) + (0 (c1nil)) + (1 (c1fmla (cadr fmla) info)) + (t (cons 'FMLA-OR + (mapcar #'(lambda (x) (c1fmla x info)) + (cdr fmla)))))) + ((not null) + (when (endp (cdr fmla)) (too-few-args 'not 1 0)) + (unless (endp (cddr fmla)) + (too-many-args 'not 1 (length (cdr fmla)))) + (list 'FMLA-NOT (c1fmla (cadr fmla) info))) + (t (c1expr* `(the boolean ,fmla) info))) + (c1expr* fmla info)) + ) + +(defun c2if (fmla form1 form2 + &aux (Tlabel (next-label)) Flabel) + (cond ((and (eq (car form2) 'LOCATION) + (null (caddr form2)) + (eq *value-to-go* 'TRASH) + (not (eq *exit* 'RETURN))) + (let ((exit *exit*) + (*unwind-exit* (cons Tlabel *unwind-exit*)) + (*exit* Tlabel)) + (CJF fmla Tlabel exit)) + (wt-label Tlabel) + (c2expr form1)) + (t + (setq Flabel (next-label)) + (let ((*unwind-exit* (cons Flabel (cons Tlabel *unwind-exit*))) + (*exit* Tlabel)) + (CJF fmla Tlabel Flabel)) + (wt-label Tlabel) + (let ((*unwind-exit* (cons 'JUMP *unwind-exit*))) (c2expr form1)) + (wt-label Flabel) + (c2expr form2))) + ) + +;;; If fmla is true, jump to Tlabel. If false, do nothing. +(defun CJT (fmla Tlabel Flabel) + (case (car fmla) + (fmla-and (do ((fs (cdr fmla) (cdr fs))) + ((endp (cdr fs)) + (CJT (car fs) Tlabel Flabel)) + (declare (object fs)) + (let* ((label (next-label)) + (*unwind-exit* (cons label *unwind-exit*))) + (CJF (car fs) label Flabel) + (wt-label label)))) + (fmla-or (do ((fs (cdr fmla) (cdr fs))) + ((endp (cdr fs)) + (CJT (car fs) Tlabel Flabel)) + (declare (object fs)) + (let* ((label (next-label)) + (*unwind-exit* (cons label *unwind-exit*))) + (CJT (car fs) Tlabel label) + (wt-label label)))) + (fmla-not (CJF (cadr fmla) Flabel Tlabel)) + (LOCATION + (case (caddr fmla) + ((t) (unwind-no-exit Tlabel) (wt-nl) (wt-go Tlabel)) + ((nil)) + (t (let ((*value-to-go* (list 'jump-true Tlabel))) + (c2expr* fmla))))) + (t (let ((*value-to-go* (list 'jump-true Tlabel))) (c2expr* fmla)))) + ) + +;;; If fmla is false, jump to Flabel. If true, do nothing. +(defun CJF (fmla Tlabel Flabel) + (case (car fmla) + (FMLA-AND (do ((fs (cdr fmla) (cdr fs))) + ((endp (cdr fs)) (CJF (car fs) Tlabel Flabel)) + (declare (object fs)) + (let* ((label (next-label)) + (*unwind-exit* (cons label *unwind-exit*))) + (CJF (car fs) label Flabel) + (wt-label label)))) + (FMLA-OR (do ((fs (cdr fmla) (cdr fs))) + ((endp (cdr fs)) (CJF (car fs) Tlabel Flabel)) + (declare (object fs)) + (let* ((label (next-label)) + (*unwind-exit* (cons label *unwind-exit*))) + (CJT (car fs) Tlabel label) + (wt-label label)))) + (FMLA-NOT (CJT (cadr fmla) Flabel Tlabel)) + (LOCATION + (case (caddr fmla) + ((t)) + ((nil) (unwind-no-exit Flabel) (wt-nl) (wt-go Flabel)) + (t (let ((*value-to-go* (list 'jump-false Flabel))) + (c2expr* fmla))))) + (t (let ((*value-to-go* (list 'jump-false Flabel))) (c2expr* fmla)))) + ) + +(defun c1and (args) + (cond ((endp args) (c1t)) + ((endp (cdr args)) (c1expr (car args))) + (t (let ((info (make-info))) (list 'AND info (c1args args info)))))) + +(defun c2and (forms) + (do ((forms forms (cdr forms))) + ((endp (cdr forms)) + (c2expr (car forms))) + (declare (object forms)) + (cond ((eq (caar forms) 'LOCATION) + (case (caddar forms) + ((t)) + ((nil) (unwind-exit nil 'JUMP)) + (t (wt-nl "if(" (caddar forms) "==Cnil){") + (unwind-exit nil 'JUMP) (wt "}") + ))) + ((eq (caar forms) 'VAR) + (wt-nl "if(") + (wt-var (car (caddar forms)) (cadr (caddar forms))) + (wt "==Cnil){") + (unwind-exit nil 'jump) (wt "}")) + (t + (let* ((label (next-label)) + (*unwind-exit* (cons label *unwind-exit*))) + (let ((*value-to-go* (list 'jump-true label))) + (c2expr* (car forms))) + (unwind-exit nil 'jump) + (wt-label label)))) + )) + +(defun c1or (args) + (cond ((endp args) (c1nil)) + ((endp (cdr args)) (c1expr (car args))) + (t (let ((info (make-info))) + (list 'OR info (c1args args info)))))) + +(defun c2or (forms &aux (*vs* *vs*) temp) + (do ((forms forms (cdr forms)) + ) + ((endp (cdr forms)) + (c2expr (car forms))) + (declare (object forms)) + (cond ((eq (caar forms) 'LOCATION) + (case (caddar forms) + ((t) (unwind-exit t 'JUMP)) + ((nil)) + (t (wt-nl "if(" (caddar forms) "!=Cnil){") + (unwind-exit (caddar forms) 'JUMP) (wt "}")))) + ((eq (caar forms) 'VAR) + (wt-nl "if(") + (wt-var (car (caddar forms)) (cadr (caddar forms))) + (wt "!=Cnil){") + (unwind-exit (cons 'VAR (caddar forms)) 'jump) (wt "}")) + ((and (eq (caar forms) 'CALL-GLOBAL) + (get (caddar forms) 'predicate)) + (let* ((label (next-label)) + (*unwind-exit* (cons label *unwind-exit*))) + (let ((*value-to-go* (list 'jump-false label))) + (c2expr* (car forms))) + (unwind-exit t 'jump) + (wt-label label))) + (t + (let* ((label (next-label)) + (*inline-blocks* 0) + (*unwind-exit* (cons label *unwind-exit*))) + (setq temp (wt-c-push)) + (let ((*value-to-go* temp)) (c2expr* (car forms))) + (wt-nl "if(" temp "==Cnil)") (wt-go label) + (unwind-exit temp 'jump) + (wt-label label) + (close-inline-blocks) + ))) + ) + ) + +(defun set-jump-true (loc label) + (unless (null loc) + (cond ((eq loc t)) + ((and (consp loc) (eq (car loc) 'INLINE-COND)) + (wt-nl "if(") + (wt-inline-loc (caddr loc) (cadddr loc)) + (wt ")")) + (t (wt-nl "if((" loc ")!=Cnil)"))) + (unless (eq loc t) (wt "{")) + (unwind-no-exit label) + (wt-nl) (wt-go label) + (unless (eq loc t) (wt "}"))) + ) + +(defun set-jump-false (loc label) + (unless (eq loc t) + (cond ((null loc)) + ((and (consp loc) (eq (car loc) 'INLINE-COND)) + (wt-nl "if(!(") + (wt-inline-loc (caddr loc) (cadddr loc)) + (wt "))")) + (t (wt-nl "if((" loc ")==Cnil)"))) + (unless (null loc) (wt "{")) + (unwind-no-exit label) + (wt-nl) (wt-go label) + (unless (null loc) (wt "}"))) + ) + +(defun c1ecase (args) (c1case args t)) + +;;If the key is declared fixnum, then we convert a case statement to a switch, +;;so that we may see the benefit of a table jump. + +(defun convert-case-to-switch (args default) + (let ((sym (gensym)) body keys) + (dolist (v (cdr args)) + (cond ((si::fixnump (car v)) (push (car v) body)) + ((consp (car v))(dolist (w (car v)) (push w body))) + ((member (car v) '(t otherwise)) + (and default + (cmperror "T or otherwise found in an ecase")) + (push t body))) + (push `(return-from ,sym (progn ,@ (cdr v))) body)) + (cond (default (push t body) + (dolist (v (cdr args)) + (cond ((atom (car v)) (push (car v) keys)) + (t (setq keys (append (car v) keys))))) + (push `(error "The key ~a for ECASE was not found in cases ~a" + ,(car args) ',keys) + body))) + `(block ,sym (si::switch ,(car args) ,@ (nreverse body))))) + + + +(defun c1case (args &optional (default nil)) + (when (endp args) (too-few-args 'case 1 0)) + (let* ((info (make-info)) + (key-form (c1expr* (car args) info)) + clauses) + (cond ((subtypep (info-type (second key-form)) 'fixnum) + (return-from c1case (c1expr (convert-case-to-switch args default ))))) + (do ((c (cdr args) (cdr c))) ((not c)) + (let* ((clause (car c))) + (cmpck (endp clause) "The CASE clause ~S is illegal." clause) + (let* ((k (pop clause))(dfp (unless default (member k '(t otherwise)))) + (keylist + (cond ((listp k) + (mapcar (lambda (key) (if (symbolp key) key (add-object key))) k)) + ((symbolp k) + (when dfp (when (cdr c) (cmperr "default case found in bad place"))) + (list k)) + ((list (add-object k))))) + (body (c1progn clause))) + (add-info info (cadr body)) + (if dfp (setq default body) (push (cons keylist body) clauses))))) + (list 'case info key-form (nreverse clauses) (or default (c1nil))))) + +;; (defun c1case (args &optional (default nil)) +;; (when (endp args) (too-few-args 'case 1 0)) +;; (let* ((info (make-info)) +;; (key-form (c1expr* (car args) info)) +;; (clauses nil)) +;; (cond ((subtypep (info-type (second key-form)) 'fixnum) +;; (return-from c1case (c1expr (convert-case-to-switch +;; args default ))))) +;; (dolist (clause (cdr args)) +;; (cmpck (endp clause) "The CASE clause ~S is illegal." clause) +;; (case (car clause) +;; ((nil)) +;; ((t otherwise) +;; (when default +;; (cmperr (if (eq default 't) +;; "ECASE had an OTHERWISE clause." +;; "CASE had more than one OTHERWISE clauses."))) +;; (setq default (c1progn (cdr clause))) +;; (add-info info (cadr default))) +;; (t (let* ((keylist +;; (cond ((consp (car clause)) +;; (mapcar #'(lambda (key) (if (symbolp key) key +;; (add-object key))) +;; (car clause))) +;; ((symbolp (car clause)) (list (car clause))) +;; (t (list (add-object (car clause)))))) +;; (body (c1progn (cdr clause)))) +;; (add-info info (cadr body)) +;; (push (cons keylist body) clauses))))) +;; (list 'case info key-form (reverse clauses) (or default (c1nil))))) + +(defun c2case (key-form clauses default + &aux (cvar (next-cvar)) (*vs* *vs*) (*inline-blocks* 0)) + (setq key-form (car (inline-args (list key-form) '(t)))) + (wt-nl "{object V" cvar "= " key-form ";") + + (dolist (clause clauses) + (let* ((label (next-label)) + (keylist (car clause)) + (local-label nil)) + (do () + ((<= (length keylist) 5)) + (when (null local-label) (setq local-label (next-label))) + (wt-nl "if(") + (dotimes (i 5) + (cond ((symbolp (car keylist)) + (wt "(V" cvar "== ") + (case (car keylist) + ((t) (wt "Ct")) + ((nil) (wt "Cnil")) + (otherwise (wt (vv-str (add-symbol (car keylist)))))) + (wt ")")) + (t (wt "eql(V" cvar "," (vv-str (car keylist)) ")"))) + (when (< i 4) (wt-nl "|| ")) + (pop keylist)) + (wt ")") + (wt-go local-label)) + + (when keylist + (wt-nl "if(") + (do () + ((endp keylist)) + (cond ((symbolp (car keylist)) + (wt "(V" cvar "!= ") + (case (car keylist) + ((t) (wt "Ct")) + ((nil) (wt "Cnil")) + (otherwise (wt (vv-str (add-symbol (car keylist)))))) + (wt ")")) + (t (wt "!eql(V" cvar "," (vv-str (car keylist)) ")"))) + (unless (endp (cdr keylist)) (wt-nl "&& ")) + (pop keylist)) + (wt ")") + (wt-go label) + (when local-label (wt-label local-label)) + (let ((*unwind-exit* (cons 'JUMP *unwind-exit*))) (c2expr (cdr clause))) + (wt-label label)))) + + (if (eq default 't) + (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1,V" cvar ");") + (c2expr default)) + + (wt "}") + (close-inline-blocks)) + + diff --git a/cmpnew/gcl_cmpinit.lsp b/cmpnew/gcl_cmpinit.lsp new file mode 100755 index 0000000..6185b16 --- /dev/null +++ b/cmpnew/gcl_cmpinit.lsp @@ -0,0 +1,7 @@ +;(proclaim '(optimize (safety 0) (space 3))) +;(proclaim '(optimize (safety 2) (space 3))) +(load "../lsp/sys-proclaim.lisp") +(load "sys-proclaim.lisp") +(setq compiler::*eval-when-defaults* '(compile eval load)) +;(load "cmptop.lsp") +;(dolist (v '( cmpeval cmpopt cmptype cmpbind cmpinline cmploc cmpvar cmptop cmplet cmpcall cmpmulti cmplam cmplabel cmpeval )) (si::nload (format nil "~(~a~).lsp" v))) diff --git a/cmpnew/gcl_cmpinline.lsp b/cmpnew/gcl_cmpinline.lsp new file mode 100755 index 0000000..9488a93 --- /dev/null +++ b/cmpnew/gcl_cmpinline.lsp @@ -0,0 +1,715 @@ +;;; CMPINLINE Open coding optimizer. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +;;; Pass 1 generates the internal form +;;; ( id info-object . rest ) +;;; for each form encountered. + +;;; Change changed-vars and referrred-vars slots in info structure to arrays +;;; for dramatic compilation speed improvements when the number of variables +;;; are large, as occurs at present in running the random-int-form tester. +;;; 20040320 CM + +(defmacro mia (x y) `(si:make-vector t ,x t ,y nil 0 nil nil)) +;(defmacro mia (x y) `(make-array ,x :adjustable t :fill-pointer ,y)) +(defmacro eql-not-nil (x y) `(and ,x (eql ,x ,y))) + +(defstruct (info (:copier old-copy-info)) + (type t) ;;; Type of the form. + (sp-change nil) ;;; Whether execution of the form may change + ;;; the value of a special variable *VS*. + (volatile nil) ;;; whether there is a possible setjmp + (changed-array (mia 10 0)) ;;; List of var-objects changed by the form. + (referred-array (mia 10 0)) ;;; List of var-objects referred in the form. + ) + +(defun copy-array (array) + (declare ((vector t) array)) + (let ((new-array (mia (the fixnum (array-total-size array)) (length array)))) + (declare ((vector t) new-array)) + (do ((i 0 (1+ i))) ((>= i (length array)) new-array) + (declare (fixnum i)) + (setf (aref new-array i) (aref array i))))) + +(defun copy-info (info) + (let ((new-info (old-copy-info info))) + (setf (info-referred-array new-info) + (copy-array (info-referred-array info))) + (setf (info-changed-array new-info) + (copy-array (info-changed-array info))) + new-info)) + +(defun bsearchleq (x a i j le) + (declare (object x le) ((vector t) a) (fixnum i j)) + (when (eql i j) + (return-from bsearchleq (if (or le (and (< i (length a)) (eq x (aref a i)))) i (length a)))) + (let* ((k (the fixnum (+ i (the fixnum (ash (the fixnum (- j i) ) -1))))) + (y (aref a k))) + (declare (fixnum k) (object y)) + (cond ((si::objlt x y) + (bsearchleq x a i k le)) + ((eq x y) k) + (t (bsearchleq x a (1+ k) j le))))) + +(defun push-array (x ar s lin) + (declare (object x lin) ((vector t) ar) (fixnum s) (ignore lin)) +; (j (if lin +; (do ((k s (1+ k))) ((or (eql k (length ar)) (si::objlt x (aref ar k)) (eq x (aref ar k))) k) +; (declare (fixnum k))) +; (bsearchleq x ar s (length ar))))) + (let ((j (bsearchleq x ar s (length ar) t))) + (declare (fixnum j)) + (when (and (< j (length ar)) (eq (aref ar j) x)) + (return-from push-array -1)) + (let ((ar (if (eql (length ar) (the fixnum (array-total-size ar))) + (adjust-array ar (the fixnum (* 2 (length ar)))) + ar))) + (declare ((vector t) ar)) + (do ((i (length ar) (1- i))) ((<= i j)) + (declare (fixnum i)) + (setf (aref ar i) (aref ar (the fixnum (1- i))))) + (setf (aref ar j) x) + (setf (fill-pointer ar) (the fixnum (1+ (length ar)))) + j))) + + +(defmacro do-array ((v oar) &rest body) + (let ((count (gensym)) (ar (gensym))) + `(let* ((,ar ,oar)) + (declare ((vector t) ,ar)) + (do ((,count 0 (1+ ,count))) ((eql ,count (length ,ar))) + (declare (fixnum ,count)) + (let ((,v (aref ,ar ,count))) + ,@body))))) + +(defmacro in-array (v ar) + `(< (bsearchleq ,v ,ar 0 (length ,ar) nil) (length ,ar))) + + +(defmacro do-referred ((v info) &rest body) + `(do-array (,v (info-referred-array ,info)) ,@body)) +(defmacro do-changed ((v info) &rest body) + `(do-array (,v (info-changed-array ,info)) ,@body)) +(defmacro is-referred (var info) + `(in-array ,var (info-referred-array ,info))) +(defmacro is-changed (var info) + `(in-array ,var (info-changed-array ,info))) +(defmacro push-referred (var info) + `(push-array ,var (info-referred-array ,info) 0 nil)) +(defmacro push-changed (var info) + `(push-array ,var (info-changed-array ,info) 0 nil)) +(defmacro push-referred-with-start (var info s lin) + `(push-array ,var (info-referred-array ,info) ,s ,lin)) +(defmacro push-changed-with-start (var info s lin) + `(push-array ,var (info-changed-array ,info) ,s ,lin)) +(defmacro changed-length (info) + `(length (info-changed-array ,info))) +(defmacro referred-length (info) + `(length (info-referred-array ,info))) + + +(defvar *info* (make-info)) + +(defun mlin (x y) + (declare (fixnum x y)) + (when (<= y 3) + (return-from mlin nil)) + (let ((ly + (do ((tl y (ash tl -1)) (k -1 (1+ k))) ((eql tl 0) k) + (declare (fixnum k tl))))) + (declare (fixnum ly)) + (let ((lyr (the fixnum (truncate y (the fixnum (1- ly)))))) + (declare (fixnum lyr)) + (> x (the fixnum (1+ lyr)))))) + +(defun add-info (to-info from-info) + ;; Allow nil from-info without error CM 20031030 + (unless from-info + (return-from add-info to-info)) + (let* ((s 0) + (lin)); (mlin (changed-length from-info) (changed-length to-info)))) + (declare (fixnum s) (object lin)) + (do-changed (v from-info) + (let ((res (push-changed-with-start v to-info s lin))) + (declare (fixnum res)) + (when (>= res 0) + (setq s (the fixnum (1+ res))))))) + (let* ((s 0) + (lin)); (mlin (referred-length from-info) (referred-length to-info)))) + (declare (fixnum s) (object lin)) + (do-referred (v from-info) + (let ((res (push-referred-with-start v to-info s lin))) + (declare (fixnum res)) + (when (>= res 0) + (setq s (the fixnum (1+ res))))))) + (when (info-sp-change from-info) + (setf (info-sp-change to-info) t)) + ;; Return to-info, CM 20031030 + to-info) + +(defun args-info-changed-vars (var forms) + (case (var-kind var) + ((LEXICAL FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT) + (dolist** (form forms) + (when (is-changed var (cadr form)) + (return-from args-info-changed-vars t)))) + (REPLACED nil) + (t (dolist** (form forms nil) + (when (or (is-changed var (cadr form)) + (info-sp-change (cadr form))) + (return-from args-info-changed-vars t))))) + ) + +;; Variable references in arguments can also be via replaced variables +;; (see gcl_cmplet.lsp) It appears that this is not necessary when +;; checking for changed variables, as matches would appear to require +;; that the variable not be replaced. It might be better to provide a +;; new slot in the var structure to point to the variable by which one +;; is replaced -- one would need to consider chains in such a case. +;; Here we match on the C variable reference, which should be complete. +;; 20040306 CM + +(defun var-rep-loc (x) + (and + (eq (var-kind x) 'replaced) + (consp (var-loc x)) ;; may not be necessary, but vars can also be replaced to 'locations + ;; see gcl_cmplet.lsp + (cadr (var-loc x)))) + +(defun is-rep-referred (var info) + (let ((rx (var-rep-loc var))) + (do-referred (v info) + (let ((ry (var-rep-loc v))) + (when (or (eql-not-nil (var-loc var) ry) + (eql-not-nil (var-loc v) rx) + (eql-not-nil rx ry)) + (return-from is-rep-referred t)))))) + +(defun args-info-referred-vars (var forms) + (case (var-kind var) + ((LEXICAL REPLACED FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT) + (dolist** (form forms nil) + (when (or (is-referred var (cadr form)) + (is-rep-referred var (cadr form))) + (return-from args-info-referred-vars t)))) + (t (dolist** (form forms nil) + (when (or (is-referred var (cadr form)) + (is-rep-referred var (cadr form)) + (info-sp-change (cadr form))) + (return-from args-info-referred-vars t)))) + )) + +;;; Valid property names for open coded functions are: +;;; INLINE +;;; INLINE-SAFE safe-compile only +;;; INLINE-UNSAFE non-safe-compile only +;;; +;;; Each property is a list of 'inline-info's, where each inline-info is: +;;; ( types { type | boolean } side-effect new-object { string | function } ). +;;; +;;; For each open-codable function, open coding will occur only if there exits +;;; an appropriate property with the argument types equal to 'types' and with +;;; the return-type equal to 'type'. The third element +;;; is T if and only if side effects may occur by the call of the function. +;;; Even if *VALUE-TO-GO* is TRASH, open code for such a function with side +;;; effects must be included in the compiled code. +;;; The forth element is T if and only if the result value is a new Lisp +;;; object, i.e., it must be explicitly protected against GBC. + +(defvar *inline-functions* nil) +(defvar *inline-blocks* 0) +;;; *inline-functions* holds: +;;; (...( function-name . inline-info )...) +;;; +;;; *inline-blocks* holds the number of temporary cvars used to save +;;; intermediate results during evaluation of inlined function calls. +;;; This variable is used to close up blocks introduced to declare static +;;; c variables. + +(defvar *special-types* '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT integer)) + +(defun inc-inline-blocks() + (cond ((consp *inline-blocks*) + (incf (car *inline-blocks*))) + (t (incf *inline-blocks*)))) + +(defun inline-args (forms types &optional fun &aux (locs nil) ii) + (do ((forms forms (cdr forms)) + (types types (cdr types))) + ((endp forms) (nreverse locs)) + (declare (object forms types)) + (let ((form (car forms)) + (type (car types))) + (declare (object form type)) + (case (car form) + (LOCATION (push (coerce-loc (caddr form) type) locs)) + (VAR + (cond ((args-info-changed-vars (caaddr form) (cdr forms)) + (cond ((and (member (var-kind (caaddr form)) + *special-types*) + (eq type (var-kind (caaddr form)))) + (let ((cvar (next-cvar))) + (wt-nl "{" (rep-type type) "V" cvar "= V" + (var-loc (caaddr form)) ";") + (push (list 'cvar cvar 'inline-args) locs) + (inc-inline-blocks))) + (t + (let ((temp (wt-c-push))) + (wt-nl temp "= ") + (wt-var (caaddr form) (cadr (caddr form))) + (wt ";") + (push (coerce-loc temp type) locs))))) + ((and (member (var-kind (caaddr form)) + '(FIXNUM LONG-FLOAT SHORT-FLOAT INTEGER)) + (not (eq type (var-kind (caaddr form))))) + (let ((temp (cs-push type))) + (wt-nl "V" temp " = " + (coerce-loc (cons 'var (caddr form)) type) ";") + (push (list 'cvar temp) locs))) + (t (push (coerce-loc (cons 'VAR (caddr form)) type) + locs)))) + (CALL-GLOBAL + (if (let ((fname (caddr form))) + (and (inline-possible fname) + (setq ii (get-inline-info + fname (cadddr form) + (info-type (cadr form)))) + (progn (save-avma ii) t))) + (let ((loc (get-inline-loc ii (cadddr form)))) + (cond + ((or (and (flag-p (caddr ii) ans)(not *c-gc*)) + ; returns new object + (and (member (cadr ii) + '(FIXNUM LONG-FLOAT SHORT-FLOAT)) + (not (eq type (cadr ii))))) + (let ((temp (cs-push type))) + (wt-nl "V" temp " = " (coerce-loc loc type) ";") + (push (list 'cvar temp) locs)) + ) + ((or (need-to-protect (cdr forms) (cdr types)) + ;;if either new form or side effect, + ;;we don't want double evaluation + (and (flag-p (caddr ii) allocates-new-storage) + (or (null fun) + ;; Any fun such as list,list* which + ;; does not cause side effects or + ;; do double eval (ie not "@..") + ;; could go here. + (not + (si::memq + fun '(list-inline list*-inline))))) + (flag-p (caddr ii) is) + (and (flag-p (caddr ii) set) ; side-effectp + (not (null (cdr forms))))) + (let (cvar) + (cond + ((eq type t) + (setq cvar (cs-push)) + (wt-nl "V" cvar "= ") + (wt-loc loc)) + (t (setq cvar (next-cvar)) + (wt-nl "{" (rep-type type) "V" cvar "= ") + (case type + (fixnum (wt-fixnum-loc loc)) + (integer (wt-integer-loc loc 'inline-args)) + (character (wt-character-loc loc)) + (long-float (wt-long-float-loc loc)) + (short-float (wt-short-float-loc loc)) + (otherwise (wt-loc loc))) + (inc-inline-blocks))) + (wt ";") + (push (list 'cvar cvar 'inline-args) locs) + )) + (t (push (coerce-loc loc type) locs)))) + (let ((temp (if *c-gc* (list 'cvar (cs-push)) (list 'vs (vs-push))))) + (let ((*value-to-go* temp)) (c2expr* form)) + (push (coerce-loc temp type) locs)))) + (structure-ref + (push (coerce-loc-structure-ref (cdr form) type) + locs)) + (SETQ + (let ((vref (caddr form)) + (form1 (cadddr form))) + (let ((*value-to-go* (cons 'var vref))) (c2expr* form1)) + (cond ((eq (car form1) 'LOCATION) + (push (coerce-loc (caddr form1) type) locs)) + (t + (setq forms (list* form + (list 'VAR (cadr form) vref) + (cdr forms))) + ;; want (setq types (list* type type (cdr types))) + ;; but type is first of types + (setq types (list* type types)))))) + (t (let + ((temp + (cond (*c-gc* + (cond ((eq type t) + (list 'cvar (cs-push))) + (t (push (cons type (next-cvar)) *c-vars*) + (list 'var + (make-var + :type type + :kind + (if (member type + *special-types*) + type 'object) + :loc (cdar *c-vars*)) + nil + )))) + (t (list 'vs (vs-push)))))) + (let ((*value-to-go* temp)) + (c2expr* form) + (push (coerce-loc temp type) locs)))))))) + +(defun coerce-loc (loc type) + (case type + (fixnum (list 'FIXNUM-LOC loc)) + (integer (list 'integer-loc loc )) + (character (list 'CHARACTER-LOC loc)) + (long-float (list 'LONG-FLOAT-LOC loc)) + (short-float (list 'SHORT-FLOAT-LOC loc)) + (t loc))) + +(defun get-inline-loc (ii args &aux (fun (car (cdddr ii))) locs) + ;;; Those functions that use GET-INLINE-LOC must rebind the variable *VS*. + (setq locs (inline-args args (car ii) fun)) + (when (and (stringp fun) (char= (char (the string fun) 0) #\@)) + (let ((i 1) (saves nil)) + (declare (fixnum i)) + (do ((char (char (the string fun) i) + (char (the string fun) i))) + ((char= char #\;) (incf i)) + (declare (character char)) + (push (the fixnum (- (char-code char) #.(char-code #\0))) saves) + (incf i)) + (do ((l locs (cdr l)) + (n 0 (1+ n)) + (locs1 nil)) + ((endp l) (setq locs (nreverse locs1))) + (declare (fixnum n) (object l)) + (if (member n saves) + (let* ((loc1 (car l)) (loc loc1) (coersion nil)) + (declare (object loc loc1)) + (when (and (consp loc1) + (member (car loc1) + '(FIXNUM-LOC integer-loc CHARACTER-LOC + LONG-FLOAT-LOC SHORT-FLOAT-LOC))) + (setq coersion (car loc1)) + (setq loc (cadr loc1)) ; remove coersion + ) + (cond + ((and (consp loc) + (or + (member (car loc) + '(INLINE INLINE-COND)) + (and (member (car loc) + '( + INLINE-FIXNUM inline-integer + INLINE-CHARACTER INLINE-LONG-FLOAT + INLINE-SHORT-FLOAT)) + (or (flag-p (cadr loc) allocates-new-storage) + (flag-p (cadr loc) side-effect-p)) + ))) + (wt-nl "{") + (inc-inline-blocks) + (let ((cvar (next-cvar))) + (push (list 'CVAR cvar) locs1) + (case coersion + ((nil) (wt "object V" cvar "= ") (wt-loc loc1)) + (FIXNUM-LOC (wt "int V" cvar "= ") (wt-fixnum-loc loc)) + (integer-loc (wt "MP_INT * V" cvar "= ") (wt-integer-loc loc + 'get-inline-locs)) + (CHARACTER-LOC + (wt "unsigned char V" cvar "= ") (wt-character-loc loc)) + (LONG-FLOAT-LOC + (wt "double V" cvar "= ") (wt-long-float-loc loc)) + (SHORT-FLOAT-LOC + (wt "float V" cvar "= ") (wt-short-float-loc loc)) + (t (baboon)))) + (wt ";") + ) + (t (push loc1 locs1)))) + (push (car l) locs1))))) + (list (inline-type (cadr ii)) + (caddr ii) + fun + locs) + ) +(defvar *inline-types* + '((boolean . INLINE-COND) + (fixnum . INLINE-FIXNUM) + (character . INLINE-CHARACTER) + (long-float . INLINE-LONG-FLOAT) + (short-float . INLINE-SHORT-FLOAT) + (integer . INLINE-INTEGER) + (t . INLINE))) + +(defun inline-type (type) + (or (cdr (assoc type *inline-types* :test 'eq)) 'inline)) + +(defun get-inline-info (fname args return-type &aux x ii) + (and (fast-link-proclaimed-type-p fname args) + (add-fast-link fname return-type args)) + (setq args (mapcar #'(lambda (form) (info-type (cadr form))) args)) + (when (if *safe-compile* + (setq x (get fname 'inline-safe)) + (setq x (get fname 'inline-unsafe))) + (dolist** (y x nil) + (when (setq ii (inline-type-matches y args return-type)) + (return-from get-inline-info ii)))) + (when (setq x (get fname 'inline-always)) + (dolist** (y x) + (when (setq ii (inline-type-matches y args return-type)) + (return-from get-inline-info ii)))) + (dolist* (x *inline-functions*) + (when (and (eq (car x) fname) + (setq ii (inline-type-matches (cdr x) args return-type))) + (return-from get-inline-info ii))) + nil) + +(defun inline-type-matches (inline-info arg-types return-type + &aux (rts nil)) + (if (not (typep (third inline-info) 'fixnum)) + (fix-opt inline-info)) + (if (member 'integer (car inline-info)) + (return-from inline-type-matches nil)) + (if (and (let ((types (car inline-info))) + (declare (object types)) + (dolist** (arg-type arg-types (or (equal types '(*)) + (endp types))) + (when (endp types) (return nil)) + (cond ((equal types '(*)) + (setq types '(t *)))) + (cond ((eq (car types) 'fixnum-float) + (cond ((type>= 'fixnum arg-type) + (push 'fixnum rts)) + ((type>= 'long-float arg-type) + (push 'long-float rts)) + ((type>= 'short-float arg-type) + (push 'short-float rts)) + (t (return nil)))) + ((type>= (car types) arg-type) + (push (car types) rts)) + (t (return nil))) + (pop types))) + (type>= (cadr inline-info) return-type)) + (cons (nreverse rts) (cdr inline-info)) + nil) + ) + +(defun need-to-protect (forms types &aux ii) + (do ((forms forms (cdr forms)) + (types types (cdr types))) + ((endp forms) nil) + (declare (object forms types)) + (let ((form (car forms))) + (declare (object form)) + (case (car form) + (LOCATION) + (VAR + (when (or (args-info-changed-vars (caaddr form) (cdr forms)) + (and (member (var-kind (caaddr form)) + '(FIXNUM LONG-FLOAT SHORT-FLOAT)) + (not (eq (car types) + (var-kind (caaddr form)))))) + (return t))) + (CALL-GLOBAL + (let ((fname (caddr form))) + (declare (object fname)) + (when + (or (not (inline-possible fname)) + (null (setq ii (get-inline-info + fname (cadddr form) + (info-type (cadr form))))) + (flag-p (caddr ii) allocates-new-storage) + (flag-p (caddr ii) set) + (flag-p (caddr ii) is) + (and (member (cadr ii) + '(fixnum long-float short-float)) + (not (eq (car types) (cadr ii)))) + (need-to-protect (cadddr form) (car ii))) + (return t)))) + (structure-ref + (when (need-to-protect (list (caddr form)) '(t)) + (return t))) + (t (return t))))) + ) + +(defun wt-c-push () + (cond (*c-gc* (inc-inline-blocks) + (let ((tem (next-cvar))) + (wt "{" *volatile* "object V" tem ";") + (list 'cvar tem))) + (t (list 'VS (vs-push))))) + +(defun close-inline-blocks ( &aux (bl *inline-blocks*)) + (when (consp bl) + (if (eql (cdr bl) 'restore-avma) (wt "restore_avma;")) + (setq bl (car bl))) + (dotimes** (i bl) (wt "}"))) + +(si:putprop 'inline 'wt-inline 'wt-loc) +(si:putprop 'inline-cond 'wt-inline-cond 'wt-loc) +(si:putprop 'inline-fixnum 'wt-inline-fixnum 'wt-loc) +(si:putprop 'inline-integer 'wt-inline-integer 'wt-loc) +(si:putprop 'inline-character 'wt-inline-character 'wt-loc) +(si:putprop 'inline-long-float 'wt-inline-long-float 'wt-loc) +(si:putprop 'inline-short-float 'wt-inline-short-float 'wt-loc) + +(defun wt-inline-loc (fun locs &aux (i 0) (max -1)) + (declare (fixnum i max)) + (cond ((stringp fun) + (when (char= (char (the string fun) 0) #\@) + (setq i 1) + (do () + ((char= (char (the string fun) i) #\;) (incf i)) + (incf i))) + (do ((size (length (the string fun)))) + ((>= i size)) + (declare (fixnum size )) + (let ((char (char (the string fun) i))) + (declare (character char)) + (cond ((char= char #\#) + (let ((ch (char (the string fun) + (the fixnum (1+ i)))) + (n 0)) + (cond ((or (eql ch #\*) (eql ch #\?));#? ensures 'first' vararg is initialized + (let* ((f (char= (char fun (1- i)) #\()) + (e (char= (char fun (+ 2 i)) #\))) + (locs (nthcdr (1+ max) locs)) + (locs (or locs (when (eql ch #\?) `((fixnum-value nil 0)))))) + (dolist (v locs (unless (or f e) (wt ","))) + (unless f (wt ",")) + (setq f nil) + (wt-loc v)))) + ((digit-char-p ch 10) + (setq n (- (char-code ch) + (char-code #\0))) + (when (and + (> (length fun) (+ i 2)) + (progn (setq ch (char (the string fun) + (+ i 2))) + (digit-char-p ch))) + (setq n (+ (* n 10) + (- (char-code ch) + (char-code #\0)))) + (incf i)) + (cond ((>= n max) (setq max n))) + (wt-loc (nth n locs))))) + (incf i 2)) + (t + (princ char *compiler-output1*) + (incf i))))) + ) + (t (apply fun locs)))) + +(defun wt-inline (side-effectp fun locs) + (declare (ignore side-effectp)) + (wt-inline-loc fun locs)) + +(defun wt-inline-cond (side-effectp fun locs) + (declare (ignore side-effectp)) + (wt "(") (wt-inline-loc fun locs) (wt "?Ct:Cnil)")) + +(defun wt-inline-fixnum (side-effectp fun locs) + (declare (ignore side-effectp)) + (when (zerop *space*) (wt "CMP")) + (wt "make_fixnum((long)(") (wt-inline-loc fun locs) (wt "))")) + +(defun wt-inline-integer (side-effectp fun locs) + (declare (ignore side-effectp)) + (wt "make_integer(") (wt-inline-loc fun locs) (wt ")")) + +(defun wt-inline-character (side-effectp fun locs) + (declare (ignore side-effectp)) + (wt "code_char(") (wt-inline-loc fun locs) (wt ")")) + +(defun wt-inline-long-float (side-effectp fun locs) + (declare (ignore side-effectp)) + (wt "make_longfloat(") (wt-inline-loc fun locs) (wt ")")) + +(defun wt-inline-short-float (side-effectp fun locs) + (declare (ignore side-effectp)) + (wt "make_shortfloat(") (wt-inline-loc fun locs) (wt ")")) + +(defun args-cause-side-effect (forms &aux ii) + (dolist** (form forms nil) + (case (car form) + ((LOCATION VAR structure-ref)) + (CALL-GLOBAL + (let ((fname (caddr form))) + (declare (object fname)) + (unless (and (inline-possible fname) + (setq ii (get-inline-info + fname (cadddr form) + (info-type (cadr form)))) + (progn (fix-opt ii) + (not (flag-p (caddr ii) side-effect-p))) + ) + (return t)))) + (otherwise (return t))))) + +;;; Borrowed from CMPOPT.LSP + +(defun list-inline (&rest x &aux tem (n (length x))) + (cond ((setq tem + (and (consp *value-to-go*) + (eq (car *value-to-go*) 'var) + (eq (var-type (second *value-to-go*)) :dynamic-extent))) + (wt "(ALLOCA_CONS(" n "),ON_STACK_LIST(" n)) + (t (wt "list(" (length x)))) + (dolist (loc x) (wt #\, loc)) + (wt #\)) + (if tem (wt #\))) +) + + +(defun list*-inline (&rest x) + (case (length x) + (1 (wt (car x))) + (2 (wt "make_cons(" (car x) "," (cadr x) ")")) + (otherwise + (wt "listA(" (length x)) (dolist (loc x) (wt #\, loc)) (wt #\))))) + +;;; Borrowed from LFUN_LIST.LSP + +(defun defsysfun (fname cname-string arg-types return-type + never-change-special-var-p predicate) + ;;; The value NIL for each parameter except for fname means "not known". + (when cname-string (si:putprop fname cname-string 'Lfun)) + (when arg-types + (si:putprop fname (mapcar #'(lambda (x) + (if (eq x '*) '* (type-filter x))) + arg-types) 'arg-types)) + + (when return-type + (let ((rt (function-return-type (if (atom return-type) + (list return-type) + return-type)))) + (or (consp rt) (setq rt (list rt))) + (si:putprop fname (if (null (cdr rt)) (car rt) (cons 'values rt)) + 'return-type))) + (when never-change-special-var-p (si:putprop fname t 'no-sp-change)) + (when predicate (si:putprop fname t 'predicate)) + ) + diff --git a/cmpnew/gcl_cmplabel.lsp b/cmpnew/gcl_cmplabel.lsp new file mode 100755 index 0000000..32efb82 --- /dev/null +++ b/cmpnew/gcl_cmplabel.lsp @@ -0,0 +1,252 @@ +;;; CMPLABEL Exit manager. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(defvar *last-label* 0) +(defvar *exit*) +(defvar *unwind-exit*) +(defvar *record-call-info* nil) + +;;; *last-label* holds the label# of the last used label. +;;; *exit* holds an 'exit', which is +;;; ( label# . ref-flag ) or one of RETURNs (i.e. RETURN, RETURN-FIXNUM, +;;; RETURN-CHARACTER, RETURN-LONG-FLOAT, RETURN-SHORT-FLOAT, or +;;; RETURN-OBJECT). +;;; *unwind-exit* holds a list consisting of: +;;; ( label# . ref-flag ), one of RETURNs, TAIL-RECURSION-MARK, FRAME, +;;; JUMP, BDS-BIND (each pushed for a single special binding), and +;;; cvar (which holds the bind stack pointer used to unbind). + +(defmacro next-label () `(cons (incf *last-label*) nil)) + +(defmacro next-label* () `(cons (incf *last-label*) t)) + +(defmacro wt-label (label) + `(when (cdr ,label) (wt-nl "goto T" (car ,label) ";")(wt-nl1 "T" (car ,label) ":;"))) + +(defmacro wt-go (label) + `(progn (rplacd ,label t) (wt "goto T" (car ,label) ";")(wt-nl))) + + +(defvar *restore-avma* nil) + +(defun unwind-bds (bds-cvar bds-bind) + (when (consp *inline-blocks*) (wt-nl "restore_avma; ")) + (when bds-cvar (wt-nl "bds_unwind(V" bds-cvar ");")) + (dotimes* (n bds-bind) (wt-nl "bds_unwind1;"))) + +(defun unwind-exit (loc &optional (jump-p nil) fname + &aux (*vs* *vs*) (bds-cvar nil) (bds-bind 0) type.wt) + (declare (fixnum bds-bind)) + (and *record-call-info* (record-call-info loc fname)) + (when (and (eq loc 'fun-val) + (not (eq *value-to-go* 'return)) + (not (eq *value-to-go* 'top))) + (wt-nl) (reset-top)) + (cond ((and (consp *value-to-go*) (eq (car *value-to-go*) 'jump-true)) + (set-jump-true loc (cadr *value-to-go*)) + (when (eq loc t) (return-from unwind-exit))) + ((and (consp *value-to-go*) (eq (car *value-to-go*) 'jump-false)) + (set-jump-false loc (cadr *value-to-go*)) + (when (null loc) (return-from unwind-exit)))) + (dolist* (ue *unwind-exit* (baboon)) + (cond + ((consp ue) + (cond ((eq ue *exit*) + (cond ((and (consp *value-to-go*) + (or (eq (car *value-to-go*) 'jump-true) + (eq (car *value-to-go*) 'jump-false))) + (unwind-bds bds-cvar bds-bind)) + (t + (if (or bds-cvar (plusp bds-bind)) + ;;; Save the value if LOC may possibly refer + ;;; to special binding. + (if (and (consp loc) + (or (and (eq (car loc) 'var) + (member (var-kind (cadr loc)) + '(SPECIAL GLOBAL))) + (member (car loc) + '(SIMPLE-CALL + INLINE + INLINE-COND INLINE-FIXNUM + INLINE-CHARACTER + INLINE-INTEGER + INLINE-LONG-FLOAT + INLINE-SHORT-FLOAT)))) + (cond ((and (consp *value-to-go*) + (eq (car *value-to-go*) 'vs)) + (set-loc loc) + (unwind-bds bds-cvar bds-bind)) + (t (let + ((temp (list 'cvar (cs-push)))) + (let ((*value-to-go* temp)) + (set-loc loc)) + (unwind-bds bds-cvar bds-bind) + (set-loc temp)))) + (progn (unwind-bds bds-cvar bds-bind) + (set-loc loc))) + (set-loc loc)))) + + (when jump-p + (when (consp *inline-blocks*) (wt-nl "restore_avma; ")) + (wt-nl) (wt-go *exit*)) + (return)) + ;; Add (sup .var) handling in unwind-exit -- in + ;; c2multiple-value-prog1 and c2-multiple-value-call, apparently + ;; alone, c2expr-top is used to evaluate arguments, presumably to + ;; preserve certain states of the value stack for the purposes of + ;; retrieving the final results. c2exprt-top rebinds sup, and + ;; vs_top in turn to the new sup, causing non-local exits to lose + ;; the true top of the stack vital for subsequent function + ;; evaluations. We unwind this stack supremum variable change here + ;; when necessary. CM 20040301 + ((eq (car ue) 'sup) + (when (and ;; If we've pushed the sup, we've always reset vs_top, as we're + ;; using c2expr-top{*}. Regardless then of whether we are + ;; explicitly unwinding a fun-val, we must reset the top, unless + ;; unless returning, when we rely on the returning code to leave + ;; the stack in the correct state, regardless of loc being a fun-val + ;; or otherwise. We might need to reset when returning and loc is not + ;; fun-val, but this appears doubtful. 20040306 CM + ;; (eq loc 'fun-val) + (not (eq *value-to-go* 'return)) + (not (eq *value-to-go* 'top))) + (wt-nl "sup=V" (cdr ue) ";") + (wt-nl) + (reset-top))) + (t (setq jump-p t)))) + ((numberp ue) (setq bds-cvar ue bds-bind 0)) + ((eq ue 'bds-bind) (incf bds-bind)) + ((eq ue 'return) + (when (eq *exit* 'return) + ;;; *VALUE-TO-GO* must be either *RETURN* or *TRASH*. + (set-loc loc) + (unwind-bds bds-cvar bds-bind) + (wt-nl "return;") + (return)) + ;;; Never reached + ) + ((eq ue 'frame) + (when (and (consp loc) + (member (car loc) + '(SIMPLE-CALL INLINE INLINE-COND INLINE-FIXNUM inline-integer + INLINE-CHARACTER INLINE-LONG-FLOAT + INLINE-SHORT-FLOAT))) + (cond ((and (consp *value-to-go*) + (eq (car *value-to-go*) 'vs)) + (set-loc loc) + (setq loc *value-to-go*)) + (t (let ((*value-to-go* (if *c-gc* (list 'cvar (cs-push)) + (list 'vs (vs-push))))) + (set-loc loc) + (setq loc *value-to-go*))))) + (wt-nl "frs_pop();")) + ((eq ue 'tail-recursion-mark)) + ((eq ue 'jump) (setq jump-p t)) + ((setq type.wt + (assoc ue + '((return-fixnum fixnum . wt-fixnum-loc) + (return-character character . wt-character-loc) + (return-short-float short-float . wt-short-float-loc) + (return-long-float long-float . wt-long-float-loc) + (return-object t . wt-loc)))) + (let ((cvar (next-cvar))) + (or (eq *exit* (car type.wt)) (wfs-error)) + (setq type.wt (cdr type.wt)) + (wt-nl "{" (rep-type (car type.wt)) "V" cvar " = ") + (funcall (cdr type.wt) loc) (wt ";") + (unwind-bds bds-cvar bds-bind) + (wt-nl "VMR" *reservation-cmacro* "(" + (if (equal (rep-type (car type.wt)) "long ") "(object)" "") + "V" cvar")}") + (return))) + (t (baboon)) + ;;; Never reached + )) + ) + +(defun unwind-no-exit (exit &aux (bds-cvar nil) (bds-bind 0)) + (declare (fixnum bds-bind)) + (dolist* (ue *unwind-exit* (baboon)) + (cond + ((consp ue) + (when (eq ue exit) + (unwind-bds bds-cvar bds-bind) + (return)) + ;; Add (sup .var) handling in unwind-exit -- in + ;; c2multiple-value-prog1 and c2-multiple-value-call, apparently + ;; alone, c2expr-top is used to evaluate arguments, presumably to + ;; preserve certain states of the value stack for the purposes of + ;; retrieving the final results. c2exprt-top rebinds sup, and + ;; vs_top in turn to the new sup, causing non-local exits to lose + ;; the true top of the stack vital for subsequent function + ;; evaluations. We unwind this stack supremum variable change here + ;; when necessary. CM 20040301 + (when (eq (car ue) 'sup) + (wt-nl "sup=V" (cdr ue) ";") + (wt-nl) + (reset-top))) + ((numberp ue) (setq bds-cvar ue bds-bind 0)) + ((eq ue 'bds-bind) (incf bds-bind)) + ((member ue '(return return-object return-fixnum return-character + return-long-float return-short-float)) + (cond ((eq exit ue) (unwind-bds bds-cvar bds-bind) + (return)) + (t (baboon))) + ;;; Never reached + ) + ((eq ue 'frame) (wt-nl "frs_pop();")) + ((eq ue 'tail-recursion-mark) + (cond ((eq exit 'tail-recursion-mark) (unwind-bds bds-cvar bds-bind) + (return)) + (t (baboon))) + ;;; Never reached + ) + ((eq ue 'jump)) + (t (baboon)) + ;;; Never reached + )) + ) + +;;; Tail-recursion optimization for a function F is possible only if +;;; 1. the value of *DO-TAIL-RECURSION* is non-nil (this is default), +;;; 2. F receives only required parameters, and +;;; 3. no required parameter of F is enclosed in a closure. +;;; +;;; A recursive call (F e1 ... en) may be replaced by a loop only if +;;; 1. F is not declared as NOTINLINE, +;;; 2. n is equal to the number of required parameters of F, +;;; 3. the form is a normal function call (i.e. the arguments are +;;; pushed on the stack, +;;; 4. (F e1 ... en) is not surrounded by a form that causes dynamic +;;; binding (such as LET, LET*, PROGV), +;;; 5. (F e1 ... en) is not surrounded by a form that that pushes a frame +;;; onto the frame-stack (such as BLOCK and TAGBODY whose tags are +;;; enclosed in a closure, and CATCH), + +(defun tail-recursion-possible () + (dolist* (ue *unwind-exit* (baboon)) + (cond ((eq ue 'tail-recursion-mark) (return t)) + ((or (numberp ue) (eq ue 'bds-bind) (eq ue 'frame)) + (return nil)) + ((or (consp ue) (eq ue 'jump))) + (t (baboon))))) diff --git a/cmpnew/gcl_cmplam.lsp b/cmpnew/gcl_cmplam.lsp new file mode 100755 index 0000000..fec4d56 --- /dev/null +++ b/cmpnew/gcl_cmplam.lsp @@ -0,0 +1,980 @@ +;;; CMPLAM Lambda expression. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +;;; During Pass1, a lambda-list +;;; +;;; ( { var }* +;;; [ &optional { var | ( var [ initform [ svar ] ] ) }* ] +;;; [ &rest var ] +;;; [ &key { var | ( { var | ( kwd var ) } [initform [ svar ]])}* +;;; [&allow-other-keys]] +;;; [ &aux {var | (var [initform])}*] +;;; ) +;;; +;;; is transformed into +;;; +;;; ( ( { var }* ) ; required +;;; ( { (var initform svar) }* ) ; optional +;;; { var | nil } ; rest +;;; key-flag +;;; ( { ( kwd-vv-index var initform svar) }* ) ; key +;;; allow-other-keys-flag +;;; ) +;;; +;;; where +;;; svar: nil ; means svar is not supplied +;;; | var +;;; +;;; &aux parameters will be embedded into LET*. +;;; +;;; c1lambda-expr receives +;;; ( lambda-list { doc | decl }* . body ) +;;; and returns +;;; ( lambda info-object lambda-list' doc body' ) +;;; +;;; Doc is NIL if no doc string is supplied. +;;; Body' is body possibly surrounded by a LET* (if &aux parameters are +;;; supplied) and an implicit block. + +(defmacro ck-spec (condition) + `(unless ,condition + (cmperr "The parameter specification ~s is illegal." spec))) + +(defmacro ck-vl (condition) + `(unless ,condition + (cmperr "The lambda list ~s is illegal." vl))) + + +;;;the following code implements downward closures. +;;;These are like closures, except they are guaranteed not +;;;to survive past the exit of the function in which they +;;;are born. + + +(defmacro downward-function (x) + `(function ,x)) + +(setf (get 'downward-function 'c1special) + 'c1downward-function) + +(defun c1downward-function (x) + (let* ((tem (c1expr (list 'function (car x)))) + (info (cadr tem))) + ;; for the moment we only allow downward closures with no args + (cond ((and (consp x) (consp (car x)) + (eq (caar x) 'lambda) + (null (second (car x)))) + (do-referred (var info) + (cond ((and (eq (var-kind var) 'lexical) + (var-ref-ccb var) t) + (setf (var-kind var) 'down))) + ) + (setf (car tem) 'downward-function) + tem) + (t tem)))) + +(si::putprop 'downward-function 'c2downward-function 'c2) +(si:putprop 'make-dclosure 'wt-make-dclosure 'wt-loc) + +(defun wt-make-dclosure (cfun clink)clink ;;Dbase=base0 + (wt-nl "(DownClose"cfun".t=t_dclosure,DownClose" cfun ".dc_self=LC" cfun"," + "DownClose" cfun ".dc_env=base0,(object)&DownClose" cfun ")")) + +(defun wfs-error () + (error "This error is not supposed to occur: Contact Schelter ~ + ~%wfs@math.utexas.edu")) + +(defun wt-downward-closure-macro (cfun) + (cond (*downward-closures* + (wt-h "#define DCnames" cfun " ") + (setq *downward-closures* (delete 'dcnames *downward-closures*)) + (cond (*downward-closures* + (wt-h1 "struct dclosure ") + (do ((v *downward-closures* (cdr v))) + ((null v)) + (wt-h1 "DownClose") + (wt-h1 (car v)) + (if (cdr v) (wt-h1 ","))) + (wt-h1 ";")))))) + +(defun c2downward-function (funob) + (let ((fun (make-fun :name 'closure :cfun (next-cfun)))) + (push (list 'dclosure (if (null *clink*) nil (cons 'fun-env 0)) + *ccb-vs* fun funob) + *local-funs*) + (push fun *closures*) + (push (fun-cfun fun) *downward-closures*) + (unwind-exit (list 'make-dclosure (fun-cfun fun) *clink*)))) + + + +(defun c1lambda-expr (lambda-expr + &optional (block-name nil block-it) + &aux (requireds nil) (optionals nil) (rest nil) + (keywords nil) (key-flag nil) + lambda-list + (allow-other-keys nil) (aux-vars nil) + (aux-inits nil) doc vl spec body ss is ts + other-decls vnames + (*vars* *vars*) + (info (make-info)) + (aux-info nil) + (setjmps *setjmps*) + ) + (cmpck (endp lambda-expr) + "The lambda expression ~s is illegal." (cons 'lambda lambda-expr)) + + (multiple-value-setq (body ss ts is other-decls doc) + (c1body (cdr lambda-expr) t)) + + (when block-it (setq body (list (cons 'block (cons block-name body))))) + + (c1add-globals ss) + + (setq vl (car lambda-expr)) + (block parse + (tagbody + Lreq + (when (null vl) (return-from parse)) + (ck-vl (consp vl)) + (case (setq spec (pop vl)) + (&optional (go Lopt)) + (&rest (go Lrest)) + (&key (go Lkey)) + (&aux (go Laux))) + (let ((v (c1make-var spec ss is ts))) + (push spec vnames) + (push v *vars*) + (push v requireds)) + (go Lreq) + + Lopt + (when (null vl) (return-from parse)) + (ck-vl (consp vl)) + (case (setq spec (pop vl)) + (&rest (go Lrest)) + (&key (go Lkey)) + (&aux (go Laux))) + (cond ((not (consp spec)) + (let ((v (c1make-var spec ss is ts))) + (push spec vnames) + (push (list v (default-init (var-type v)) nil) optionals) + (push v *vars*))) + ((not (consp (cdr spec))) + (ck-spec (null (cdr spec))) + (let ((v (c1make-var (car spec) ss is ts))) + (push (car spec) vnames) + (push (list v (default-init (var-type v)) nil) optionals) + (push v *vars*))) + ((not (consp (cddr spec))) + (ck-spec (null (cddr spec))) + (let ((init (c1expr* (cadr spec) info)) + (v (c1make-var (car spec) ss is ts))) + (push (car spec) vnames) + (push + (list v (and-form-type (var-type v) init (cadr spec)) nil) + optionals) + (push v *vars*))) + (t + (ck-spec (null (cdddr spec))) + (let ((init (c1expr* (cadr spec) info)) + (v (c1make-var (car spec) ss is ts)) + (sv (c1make-var (caddr spec) ss is ts)) + ) + (push (car spec) vnames) + (push (caddr spec) vnames) + (push + (list v (and-form-type (var-type v) init (cadr spec)) sv) + optionals) + (push v *vars*) + (push sv *vars*)))) + (go Lopt) + + Lrest + (ck-vl (consp vl)) + (push (car vl) vnames) + (setq rest (c1make-var (pop vl) ss is ts)) + (push rest *vars*) + (when (null vl) (return-from parse)) + (ck-vl (consp vl)) + (case (setq spec (pop vl)) + (&key (go Lkey)) + (&aux (go Laux))) + (cmperr "Either &key or &aux is missing before ~s." spec) + + Lkey + (setq key-flag t) + (when (null vl) (return-from parse)) + (ck-vl (consp vl)) + (case (setq spec (pop vl)) + (&aux (go Laux)) + (&allow-other-keys (setq allow-other-keys t) + (when (null vl) (return-from parse)) + (ck-vl (consp vl)) + (case (setq spec (pop vl)) + (&aux (go Laux))) + (cmperr "&aux is missing before ~s." spec))) + (when (not (consp spec)) (setq spec (list spec))) + (cond ((consp (car spec)) + (ck-spec (and (keywordp (caar spec)) + (consp (cdar spec)) + (null (cddar spec)))) + (setq spec (cons (caar spec) (cons (cadar spec) (cdr spec))))) + (t + (ck-spec (symbolp (car spec))) + (setq spec (cons (intern (string (car spec)) 'keyword) + (cons (car spec) (cdr spec)))))) + (cond ((not (consp (cddr spec))) + (ck-spec (null (cddr spec))) + (let ((v (c1make-var (cadr spec) ss is ts))) + (push (cadr spec) vnames) + (push + (list (car spec) v (default-init (var-type v)) + (make-var :kind 'DUMMY)) + keywords) + (push v *vars*))) + ((not (consp (cdddr spec))) + (ck-spec (null (cdddr spec))) + (let ((init (c1expr* (caddr spec) info)) + (v (c1make-var (cadr spec) ss is ts))) + (push (cadr spec) vnames) + (push (list (car spec) v + (and-form-type (var-type v) init (caddr spec)) + (make-var :kind 'DUMMY)) + keywords) + (push v *vars*))) + (t + (ck-spec (null (cddddr spec))) + (let ((init (c1expr* (caddr spec) info)) + (v (c1make-var (cadr spec) ss is ts)) + (sv (c1make-var (cadddr spec) ss is ts))) + (push (cadr spec) vnames) + (push (cadddr spec) vnames) + (push (list (car spec) v + (and-form-type (var-type v) init (caddr spec)) + sv) + keywords) + (push v *vars*) + (push sv *vars*)))) + (go Lkey) + + Laux + (setq aux-info (make-info)) + Laux1 + (when (null vl) (add-info info aux-info) (return-from parse)) + (ck-vl (consp vl)) + (setq spec (pop vl)) + (cond ((consp spec) + (cond ((not (consp (cdr spec))) + (ck-spec (null (cdr spec))) + (let ((v (c1make-var (car spec) ss is ts))) + (push (car spec) vnames) + (push (default-init (var-type v)) aux-inits) + (push v aux-vars) + (push v *vars*))) + (t + (ck-spec (null (cddr spec))) + (let ((init (c1expr* (cadr spec) aux-info)) + (v (c1make-var (car spec) ss is ts))) + (push (car spec) vnames) + (push (and-form-type (var-type v) init (cadr spec)) + aux-inits) + (push v aux-vars) + (push v *vars*))))) + (t + (let ((v (c1make-var spec ss is ts))) + (push spec vnames) + (push (default-init (var-type v)) aux-inits) + (push v aux-vars) + (push v *vars*)))) + (go Laux1) + ) + ) + (setq requireds (nreverse requireds) + optionals (nreverse optionals) + keywords (nreverse keywords) + aux-vars (nreverse aux-vars) + aux-inits (nreverse aux-inits)) + + (check-vdecl vnames ts is) + + (setq body (c1decl-body other-decls body)) + + (add-info info (cadr body)) + + (dolist** (var requireds) (check-vref var)) + (dolist** (opt optionals) + (check-vref (car opt)) + (when (caddr opt) (check-vref (caddr opt)))) + (when rest (check-vref rest)) + (dolist** (kwd keywords) + (check-vref (cadr kwd)) + (when (cadddr kwd) (check-vref (cadddr kwd)))) + (dolist** (var aux-vars) (check-vref var)) + + (when aux-vars + (add-info aux-info (cadr body)) + (setq body (list 'let* aux-info aux-vars aux-inits body)) + (or (eql setjmps *setjmps*) (setf (info-volatile aux-info) t))) + + (setq body (fix-down-args requireds body block-name)) + (setq lambda-list + (list requireds optionals rest key-flag keywords allow-other-keys)) + (and *record-call-info* (record-arg-info lambda-list)) + (list 'lambda + info + lambda-list + doc + body) + ) + + +;;this makes a let for REQUIREDS which are used in a downward +;;lexical closure + +(defun fix-down-args(requireds body name &aux auxv auxinit info v) + (let ((types (get name 'proclaimed-arg-types)) + (fixed (get name 'fixed-args))) + (do ((vv requireds (cdr vv)) + (typ types (cdr typ))) + ((null vv)) + (setq v (car vv)) + (cond ((not (or fixed (eq (car typ) t))) + (return-from fix-down-args body)) + ((and (eq (var-kind v) 'DOWN) (eq (var-loc v) 'object)) + ;;a downward variable could not have been special + ;;and must be type t. We create a new variable + ;;for the arg, and bind the old one to it. + (let* ((new (c1make-var (var-name v) nil nil nil)) + (init + (list 'var + (or info (setq info (make-info))) + (list new nil)))) + (push v auxv) + (setf (car vv) new) + (push-referred new info) + (push init auxinit))))) + (if auxv (list 'let* info auxv auxinit body) + body))) + +(defun the-parameter (name) + (cmpck (not (symbolp name)) "The parameter ~s is not a symbol." name) + (cmpck (constantp name) "The constant ~s is being bound." name) + name + ) + +(defvar *rest-on-stack* nil) ;; non nil means put rest arg on C stack. + +(defun c2lambda-expr (lambda-list body &optional (fname nil s-fname)) + (let ((*tail-recursion-info* ;;; Tail recursion possible if + (if (and *do-tail-recursion* + s-fname ;;; named function, + (dolist* (var (car lambda-list) t) + (when (var-ref-ccb var) (return nil))) + ;;; no required is closed in a closure, + (null (cadr lambda-list)) ;;; no optionals, + (null (caddr lambda-list)) ;;; no rest parameter, and + (not (cadddr lambda-list))) ;;; no keywords. + (cons fname (car lambda-list)) + nil))) + (let ((*rest-on-stack* + (cond ((and (caddr lambda-list) + (eq (var-type (caddr lambda-list)) :dynamic-extent)) + t) + (t *rest-on-stack*)))) + (if (cadddr lambda-list) ;;; key-flag + (c2lambda-expr-with-key lambda-list body) + (c2lambda-expr-without-key lambda-list body))) + )) + +(defun decl-body-safety (body) + (case (car body) + (decl-body (or (cadr (assoc 'safety (caddr body))) 0)) + ((let let*) (decl-body-safety (car (last body)))) + (otherwise 0))) + +(defun c2lambda-expr-without-key + (lambda-list body + &aux (requireds (car lambda-list)) + (optionals (cadr lambda-list)) + (rest (caddr lambda-list)) + (labels nil) + (*unwind-exit* *unwind-exit*) + (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) + (block-p nil) + ) + (declare (object requireds optionals rest)) + ;;; Allocate immediate-type parameters. + + (flet ((do-decl (var) + (let ((kind (c2var-kind var))) + (declare (object kind)) + (when kind + (let ((cvar (next-cvar))) + (setf (var-kind var) kind) + (setf (var-loc var) cvar) + (wt-nl) + (unless block-p (wt "{") (setq block-p t)) + (wt-var-decl var) + ))))) + + (dolist** (v requireds) (do-decl v)) + (dolist** (opt optionals) + (do-decl (car opt)) + (when (caddr opt) (do-decl (caddr opt)))) + (when rest (do-decl rest)) + ) + ;;; check arguments + (when (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body)));FIXME + (cond ((or rest optionals) + (when requireds + (wt-nl "if(vs_top-vs_base<" (length requireds) + ") too_few_arguments();")) + (unless rest + (wt-nl "if(vs_top-vs_base>" + (+ (length requireds) (length optionals)) + ") too_many_arguments();"))) + (t (when requireds (wt-nl "check_arg(" (length requireds) ");"))))) + + ;;; Allocate the parameters. + (dolist** (var requireds) (setf (var-ref var) (vs-push))) + (dolist** (opt optionals) (setf (var-ref (car opt)) (vs-push))) + (when rest (setf (var-ref rest) (vs-push))) + (dolist** (opt optionals) + (when (caddr opt) (setf (var-ref (caddr opt)) (vs-push)))) + + ;;; Bind required parameters. + (dolist** (var requireds) (c2bind var)) + + ;;; Bind optional parameters as long as there remain arguments. + ;;; The compile-time binding is discarded because they are bound again. + (when (and (or optionals rest) (not (null requireds))) + (wt-nl "vs_base=vs_base+" (length requireds) ";")) + (cond (optionals + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (when rest + (wt-nl "{object *q=vs_base+" (length optionals) ",*l;") + (wt-nl " for (l=q;qc.c_cdr) *l=MMcons(*q,Cnil);") + (wt-nl " *l=Cnil;}")) + (do ((opts optionals (cdr opts))) + ((endp opts)) + (declare (object opts)) + (push (next-label) labels) + (wt-nl "if(vs_base>=vs_top){") + (reset-top) + (wt-go (car labels)) (wt "}") + (c2bind (caar opts)) + (when (caddar opts) (c2bind-loc (caddar opts) t)) + (when (cdr opts) (wt-nl "vs_base++;")) + ) + (when rest (c2bind rest)) + ) + + (wt-nl) (reset-top) + + (let ((label (next-label))) + (wt-nl) (wt-go label) + + (setq labels (nreverse labels)) + + ;;; Bind unspecified optional parameters. + (dolist** (opt optionals) + (wt-label (car labels)) + (pop labels) + (c2bind-init (car opt) (cadr opt)) + (when (caddr opt) (c2bind-loc (caddr opt) nil))) + + (when rest (c2bind-loc rest nil)) + + (wt-label label))) + (rest + (wt-nl "{object *q=vs_base,*l;") + (wt-nl " for (l=q;qc.c_cdr) *l=" + (if *rest-on-stack* "ON_STACK_CONS" "MMcons") + "(*q,Cnil);") + (wt-nl " *l=Cnil;}") + (c2bind rest) + (wt-nl) + (reset-top)) + (t + (wt-nl) + (reset-top))) + + (when *tail-recursion-info* + (push 'tail-recursion-mark *unwind-exit*) (wt-nl "goto TTL;")(wt-nl1 "TTL:;")) + + ;;; Now the parameters are ready! + (c2expr body) + + (when block-p (wt-nl "}")) + ) + +(defun c2lambda-expr-with-key + (lambda-list body + &aux (requireds (nth 0 lambda-list)) + (optionals (nth 1 lambda-list)) + (rest (nth 2 lambda-list)) + (keywords (nth 4 lambda-list)) + (allow-other-keys (nth 5 lambda-list)) + (labels nil) + (*unwind-exit* *unwind-exit*) + (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) + (block-p nil) + ) + (declare + (object requireds optionals rest keywords allow-other-keys)) + ;;; Allocate immediate-type parameters. + (flet ((do-decl (var) + (let ((kind (c2var-kind var))) + (declare (object kind)) + (when kind + (let ((cvar (next-cvar))) + (setf (var-kind var) kind) + (setf (var-loc var) cvar) + (wt-nl) + (unless block-p (wt "{") (setq block-p t)) + (wt-var-decl var) + ))))) + + (dolist** (v requireds) (do-decl v)) + (dolist** (opt optionals) + (do-decl (car opt)) + (when (caddr opt) (do-decl (caddr opt)))) + (when rest (do-decl rest)) + (dolist** (kwd keywords) + (do-decl (cadr kwd)) + (when (cadddr kwd) (do-decl (cadddr kwd)))) + ) + ;;; Check arguments. + (when (and (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body))) requireds);FIXME + (when requireds + (wt-nl "if(vs_top-vs_base<" (length requireds) + ") too_few_arguments();"))) + + ;;; Allocate the parameters. + (dolist** (var requireds) (setf (var-ref var) (vs-push))) + (dolist** (opt optionals) + (setf (var-ref (car opt)) (vs-push))) + (when rest (setf (var-ref rest) (vs-push))) + (dolist** (kwd keywords) + (setf (var-ref (cadr kwd)) (vs-push))) + (dolist** (kwd keywords) + (setf (var-ref (cadddr kwd)) (vs-push))) + (dolist** (opt optionals) + (when (caddr opt) (setf (var-ref (caddr opt)) (vs-push)))) + + ;;; Assign rest and keyword parameters first. + ;;; parse_key does not change vs_base and vs_top. + + (wt-nl "parse_key(vs_base") + (when (or requireds optionals) + (wt "+" (+ (length requireds) (length optionals)))) + (if rest (wt ",TRUE,") (wt ",FALSE,")) + (if allow-other-keys (wt "TRUE,") (wt "FALSE,")) + (wt (length keywords)) + (dolist** (kwd keywords) (wt "," (vv-str (add-symbol (car kwd))))) + (wt ");") + + ;;; Bind required parameters. + (dolist** (var requireds) (c2bind var)) + + ;;; Bind optional parameters as long as there remain arguments. + ;;; The compile-time binding is discarded because they are bound again. + + (when optionals + + (when requireds (wt-nl "vs_base += " (length requireds) ";")) + + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (do ((opts optionals (cdr opts))) + ((endp opts)) + (declare (object opts)) + (push (next-label) labels) + (wt-nl "if(vs_base>=vs_top){") + (reset-top) + (wt-go (car labels)) (wt "}") + (c2bind (caar opts)) + (when (caddar opts) (c2bind-loc (caddar opts) t)) + (when (cdr opts) (wt-nl "vs_base++;")))) + + (setq labels (nreverse labels)) + ) + + (reset-top) + + (when optionals + (let ((label (next-label))) + (wt-go label) + + ;;; Bind unspecified optional parameters. + + (dolist** (opt optionals) + (wt-label (car labels)) + (pop labels) + (c2bind-init (car opt) (cadr opt)) + (when (caddr opt) (c2bind-loc (caddr opt) nil))) + + (wt-label label) + )) + + (when rest (c2bind rest)) + + ;;; Bind keywords. + + (dolist** (kwd keywords) + (cond ((and (eq (caaddr kwd) 'LOCATION) (null (caddr (caddr kwd)))) + ;;; Cnil has been set if keyword parameter is not supplied. + (c2bind (cadr kwd))) + (t + (wt-nl "if(") (wt-vs (var-ref (cadddr kwd))) (wt "==Cnil){") + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (c2bind-init (cadr kwd) (caddr kwd))) + (wt-nl "}else{") + (c2bind (cadr kwd)) + (wt "}"))) + (unless (eq (var-kind (cadddr kwd)) 'DUMMY) (c2bind (cadddr kwd)))) + + ;;; Now the parameters are ready, after all! + (c2expr body) + + (when block-p (wt-nl "}")) + ) + +(defun need-to-set-vs-pointers (lambda-list) + ;;; On entry to in-line lambda expression, + ;;; vs_base and vs_top must be set iff, + (or *safe-compile* + *compiler-check-args* + (nth 1 lambda-list) ;;; optional, + (nth 2 lambda-list) ;;; rest, or + (nth 3 lambda-list) ;;; key-flag. + )) + + +;;; The DEFMACRO compiler. + +;;; valid lambda-list to DEFMACRO is: +;;; +;;; ( [ &whole sym ] +;;; [ &environment sym ] +;;; { v }* +;;; [ &optional { sym | ( v [ init [ v ] ] ) }* ] +;;; { [ { &rest | &body } v ] +;;; [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }* +;;; [ &allow-other-keys ]] +;;; [ &aux { sym | ( v [ init ] ) }* ] +;;; | . sym } +;;; ) +;;; +;;; where v is short for { defmacro-lambda-list | sym }. +;;; Defamcro-lambda-list is defined as: +;;; +;;; ( { v }* +;;; [ &optional { sym | ( v [ init [ v ] ] ) }* ] +;;; { [ { &rest | &body } v ] +;;; [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }* +;;; [ &allow-other-keys ]] +;;; [ &aux { sym | ( v [ init ] ) }* ] +;;; | . sym } +;;; ) + +(defvar *vnames*) +(defvar *dm-info*) +(defvar *dm-vars*) + + +(defun c1dm (macro-name vl body + &aux (*vs* *vs*) (whole nil) (env nil) + (setjmps *setjmps*) + (*vnames* nil) (*dm-info* (make-info)) (*dm-vars* nil) + doc ss is ts other-decls ppn) + + (multiple-value-setq (body ss ts is other-decls doc) (c1body body t)) + (setq body (list (list* 'block macro-name body))) + + (c1add-globals ss) + + (when (and (listp vl) (eq (car vl) '&whole)) + (push (cadr vl) *vnames*) + (setq whole (c1make-var (cadr vl) ss is ts)) + (push whole *dm-vars*) + (push whole *vars*) + (setq vl (cddr vl)) + ) + (let ((env-m (and (listp vl) (do ((tail vl (cdr tail))) + ((not (consp tail)) nil) + (when (eq '&environment (car tail)) + (return tail)))))) + (when env-m + (push (cadr env-m) *vnames*) + (setq env (c1make-var (cadr env-m) ss is ts)) + (push env *dm-vars*) + (push env *vars*) + (setq vl (append (ldiff vl env-m) (cddr env-m))))) + (multiple-value-setq (vl ppn) (c1dm-vl vl ss is ts)) + + (check-vdecl *vnames* ts is) + (setq body (c1decl-body other-decls body)) + (add-info *dm-info* (cadr body)) + (cond ((eql setjmps *setjmps*)) + (t(setf (info-volatile *dm-info*) t) + (setf (get macro-name 'contains-setjmp) t) + )) + (dolist* (v *dm-vars*) (check-vref v)) + (list doc ppn whole env vl body *dm-info*) + ) + +(defun c1dm-vl (vl ss is ts) + (do ((optionalp nil) (restp nil) (keyp nil) (allow-other-keys-p nil) + (auxp nil) + (requireds nil) (optionals nil) (rest nil) (key-flag nil) + (keywords nil) (auxs nil) (allow-other-keys nil) + (n 0) (ppn nil) + ) + ((not (consp vl)) + (when vl + (when restp (dm-bad-key '&rest)) + (setq rest (c1dm-v vl ss is ts))) + (values (list (nreverse requireds) (nreverse optionals) rest key-flag + (nreverse keywords) allow-other-keys (nreverse auxs)) + ppn) + ) + (let ((v (car vl))) + (declare (object v)) + (cond + ((eq v '&optional) + (when optionalp (dm-bad-key '&optional)) + (setq optionalp t) + (pop vl)) + ((or (eq v '&rest) (eq v '&body)) + (when restp (dm-bad-key v)) + (setq rest (c1dm-v (cadr vl) ss is ts)) + (setq restp t optionalp t) + (setq vl (cddr vl)) + (when (eq v '&body) (setq ppn n))) + ((eq v '&key) + (when keyp (dm-bad-key '&key)) + (setq keyp t restp t optionalp t key-flag t) + (pop vl)) + ((eq v '&allow-other-keys) + (when (or (not keyp) allow-other-keys-p) + (dm-bad-key '&allow-other-keys)) + (setq allow-other-keys-p t allow-other-keys t) + (pop vl)) + ((eq v '&aux) + (when auxp (dm-bad-key '&aux)) + (setq auxp t allow-other-keys-p t keyp t restp t optionalp t) + (pop vl)) + (auxp + (let (x init) + (cond ((symbolp v) (setq x v init (c1nil))) + (t (setq x (car v)) + (if (endp (cdr v)) + (setq init (c1nil)) + (setq init (c1expr* (cadr v) *dm-info*))))) + (push (list (c1dm-v x ss is ts) init) auxs)) + (pop vl)) + (keyp + (let (x k init (sv nil)) + (cond ((symbolp v) + (setq x v k (intern (string v) 'keyword) init (c1nil))) + (t (if (symbolp (car v)) + (setq x (car v) + k (intern (string (car v)) 'keyword)) + (setq x (cadar v) k (caar v))) + (cond ((endp (cdr v)) (setq init (c1nil))) + (t (setq init (c1expr* (cadr v) *dm-info*)) + (unless (endp (cddr v)) + (setq sv (caddr v))))))) + (push (list k (c1dm-v x ss is ts) init + (if sv (c1dm-v sv ss is ts) nil)) + keywords) + ) + (pop vl)) + (optionalp + (let (x init (sv nil)) + (cond ((symbolp v) (setq x v init (c1nil))) + (t (setq x (car v)) + (cond ((endp (cdr v)) + (setq init (c1nil))) + (t (setq init (c1expr* (cadr v) *dm-info*)) + (unless (endp (cddr v)) + (setq sv (caddr v))))))) + (push (list (c1dm-v x ss is ts) init + (if sv (c1dm-v sv ss is ts) nil)) + optionals)) + (pop vl) + (incf n) + ) + (t (push (c1dm-v v ss is ts) requireds) + (pop vl) + (incf n)) + ))) + ) + +(defun c1dm-v (v ss is ts) + (cond ((symbolp v) + (push v *vnames*) + (setq v (c1make-var v ss is ts)) + (push v *vars*) + (push v *dm-vars*) + v) + (t (c1dm-vl v ss is ts)))) + +(defun c1dm-bad-key (key) + (cmperr "Defmacro-lambda-list contains illegal use of ~s." key)) + +(defmacro maybe-wt-c2dm-bind-vl (vl cvar form end-form) + `(let ((ipos (file-position *compiler-output1*))) + ,form + (let ((npos (file-position *compiler-output1*))) + (c2dm-bind-vl ,vl ,cvar) + (if (eql npos (file-position *compiler-output1*)) + (file-position *compiler-output1* ipos) + ,end-form)))) + +(defun c2dm (whole env vl body + &aux (cvar (next-cvar))) + (when (or *safe-compile* *compiler-check-args*) + (wt-nl "check_arg(2);")) + (cond (whole (setf (var-ref whole) (vs-push))) + (t (vs-push))) + (cond (env (setf (var-ref env) (vs-push))) + (t (vs-push))) + (c2dm-reserve-vl vl) + (reset-top) + (when whole (c2bind whole)) + (when env (c2bind env)) + (maybe-wt-c2dm-bind-vl vl cvar (wt-nl "{object V" cvar "=base[0]->c.c_cdr;") (wt "}")) + (c2expr body) + ) + +(defun c2dm-reserve-vl (vl) + (dolist** (var (car vl)) (c2dm-reserve-v var)) + (dolist** (opt (cadr vl)) + (c2dm-reserve-v (car opt)) + (when (caddr opt) (c2dm-reserve-v (caddr opt)))) + (when (caddr vl) (c2dm-reserve-v (caddr vl))) + (dolist** (kwd (car (cddddr vl))) + (c2dm-reserve-v (cadr kwd)) + (when (cadddr kwd) (c2dm-reserve-v (cadddr kwd)))) + (dolist** (aux (caddr (cddddr vl))) + (c2dm-reserve-v (car aux))) + ) + +(defun c2dm-reserve-v (v) + (if (consp v) + (c2dm-reserve-vl v) + (setf (var-ref v) (vs-push)))) + +(defun c2dm-bind-vl (vl cvar + &aux + (requireds (car vl)) (optionals (cadr vl)) + (rest (caddr vl)) (key-flag (cadddr vl)) + (keywords (car (cddddr vl))) + (allow-other-keys (cadr (cddddr vl))) + (auxs (caddr (cddddr vl))) + ) + (declare (object requireds optionals rest key-flag keywords allow-other-keys + auxs)) + (do ((reqs requireds (cdr reqs))) + ((endp reqs)) + (declare (object reqs)) + (when (or *safe-compile* *compiler-check-args*) + (wt-nl "if(endp(V" cvar "))invalid_macro_call();")) + (c2dm-bind-loc (car reqs) `(car ,cvar)) + (when (or (cdr reqs) optionals rest key-flag + *safe-compile* *compiler-check-args*) + (wt-nl "V" cvar "=V" cvar "->c.c_cdr;"))) + (do ((opts optionals (cdr opts))) + ((endp opts)) + (declare (object opts)) + (let ((opt (car opts))) + (declare (object opt)) + (wt-nl "if(endp(V" cvar ")){") + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (c2dm-bind-init (car opt) (cadr opt)) + (when (caddr opt) (c2dm-bind-loc (caddr opt) nil)) + ) + (wt-nl "} else {") + (c2dm-bind-loc (car opt) `(car ,cvar)) + (when (caddr opt) (c2dm-bind-loc (caddr opt) t))) + (when (or (cdr opts) rest key-flag + *safe-compile* *compiler-check-args*) + (wt-nl "V" cvar "=V" cvar "->c.c_cdr;")) + (wt "}")) + (when rest (c2dm-bind-loc rest `(cvar ,cvar))) + (dolist** (kwd keywords) + (let ((cvar1 (next-cvar))) + (wt-nl + "{object V" cvar1 "=getf(V" cvar "," (vv-str (add-symbol (car kwd))) ",OBJNULL);") + (wt-nl "if(V" cvar1 "==OBJNULL){") + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (c2dm-bind-init (cadr kwd) (caddr kwd)) + (when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) nil)) + (wt "} else {")) + (c2dm-bind-loc (cadr kwd) `(cvar ,cvar1)) + (when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) t)) + (wt-nl "}}"))) + (when (and (or *safe-compile* *compiler-check-args*) + (null rest) + (null key-flag)) + (wt-nl "if(!endp(V" cvar "))invalid_macro_call();")) + (when (and (or *safe-compile* *compiler-check-args*) + key-flag + (not allow-other-keys)) + (wt-nl "check_other_key(V" cvar "," (length keywords)) + (dolist** (kwd keywords) + (wt "," (vv-str (add-symbol (car kwd))))) + (wt ");")) + (dolist** (aux auxs) + (c2dm-bind-init (car aux) (cadr aux))) + ) + +(defun c2dm-bind-loc (v loc) + (if (consp v) + (let ((cvar (next-cvar))) + (maybe-wt-c2dm-bind-vl v cvar (wt-nl "{object V" cvar "= " loc ";") (wt "}"))) + (c2bind-loc v loc))) + +(defun c2dm-bind-init (v init) + (if (consp v) + (let* ((*vs* *vs*) (*inline-blocks* 0) + (cvar (next-cvar)) + (loc (car (inline-args (list init) '(t))))) + (maybe-wt-c2dm-bind-vl v cvar (wt-nl "{object V" cvar "= " loc ";") (wt "}")) + (close-inline-blocks)) + (c2bind-init v init))) + + + diff --git a/cmpnew/gcl_cmplet.lsp b/cmpnew/gcl_cmplet.lsp new file mode 100755 index 0000000..756dd0b --- /dev/null +++ b/cmpnew/gcl_cmplet.lsp @@ -0,0 +1,361 @@ +;;; CMPLET Let and Let*. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) +(eval-when (compile) + (or (fboundp 'write-block-open) (load "cmplet.lsp"))) + +(si:putprop 'let 'c1let 'c1special) +(si:putprop 'let 'c2let 'c2) +(si:putprop 'let* 'c1let* 'c1special) +(si:putprop 'let* 'c2let* 'c2) + +(defun c1let (args &aux (info (make-info))(setjmps *setjmps*) + (forms nil) (vars nil) (vnames nil) + ss is ts body other-decls + (*vars* *vars*)) + (when (endp args) (too-few-args 'let 1 0)) + + (multiple-value-setq (body ss ts is other-decls) (c1body (cdr args) nil)) + + (c1add-globals ss) + + (dolist** (x (car args)) + (cond ((symbolp x) + (let ((v (c1make-var x ss is ts))) + (push x vnames) + (push v vars) + (push (default-init (var-type v)) forms))) + (t (cmpck (not (and (consp x) (or (endp (cdr x)) (endp (cddr x))))) + "The variable binding ~s is illegal." x) + (let ((v (c1make-var (car x) ss is ts))) + (push (car x) vnames) + (push v vars) + (push (if (endp (cdr x)) + (default-init (var-type v)) + (and-form-type (var-type v) + (c1expr* (cadr x) info) + (cadr x))) + forms))))) + + (setq *vars* (append vars *vars*)) +; (dolist* (v (reverse vars)) (push v *vars*)) + + (check-vdecl vnames ts is) + + (setq body (c1decl-body other-decls body)) + + (add-info info (cadr body)) + (setf (info-type info) (info-type (cadr body))) + + (dolist** (var vars) (check-vref var)) + + + (or (eql setjmps *setjmps*) (setf (info-volatile info) t)) + (list 'let info (nreverse vars) (nreverse forms) body) + ) + +(defun c2let (vars forms body + &aux (block-p nil) (bindings nil) initials + + (*unwind-exit* *unwind-exit*) + (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) + (declare (object block-p)) + + (do ((vl vars (cdr vl)) (fl forms (cdr fl)) (prev-ss nil)) + ((endp vl)) + (declare (object vl fl)) + (let* ((form (car fl)) (var (car vl)) + (kind (c2var-kind var))) + (declare (object form var)) + (cond (kind (setf (var-kind var) kind) + (setf (var-loc var) (next-cvar))) + ((eq (var-kind var) 'down) + (or (si::fixnump (var-loc var)) (wfs-error))) + (t (setf (var-ref var) (vs-push)))) + (case (var-kind var) + ((FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER) + (push (list 'c2expr* (list 'var var nil) form) initials)) + (otherwise + (case (car form) + (LOCATION + (if (can-be-replaced var body) + (progn (setf (var-kind var) 'REPLACED) + (setf (var-loc var) (caddr form))) + (push (list var (caddr form)) bindings))) + (VAR + (let ((var1 (caaddr form))) + (declare (object var1)) + (cond ((or (args-info-changed-vars var1 (cdr fl)) + (and (member (var-kind var1) '(SPECIAL GLOBAL)) + (member (var-name var1) prev-ss))) + (push (list 'c2expr* + (cond ((eq (var-kind var) 'object) + (list 'var var nil)) + ((eq (var-kind var) 'down) + ;(push (list var) bindings) + (list 'down (var-loc var))) + (t(push (list var) bindings) + (list 'vs (var-ref var)))) + form)initials)) + ((and (can-be-replaced var body) + (member (var-kind var1) + '(LEXICAL REPLACED OBJECT)) + (null (var-ref-ccb var1)) + (not (is-changed var1 (cadr body)))) + (setf (var-kind var) 'REPLACED) + (setf (var-loc var) + (case (var-kind var1) + (LEXICAL (list 'vs (var-ref var1))) + (REPLACED (var-loc var1)) + (OBJECT (list 'cvar (var-loc var1))) + (otherwise (baboon))))) + (t (push (list var + (list 'var var1 (cadr (caddr form)))) + bindings))))) + (t (push (list 'c2expr* + (cond ((eq (var-kind var) 'object) + (list 'var var nil)) + ((eq (var-kind var) 'down) + ;(push (list var) bindings) + (list 'down (var-loc var))) + (t(push (list var) bindings) + (list 'vs (var-ref var)))) + form) initials)) + ))) + (when (eq (var-kind var) 'SPECIAL) (push (var-name var) prev-ss)) + )) + + (setq block-p (write-block-open vars)) + + (dolist* (binding (nreverse initials)) + (let ((*value-to-go* (second binding))) + (c2expr* (third binding)))) + (dolist* (binding (nreverse bindings)) + (if (cdr binding) + (c2bind-loc (car binding) (cadr binding)) + (c2bind (car binding)))) + + (c2expr body) + (when block-p (wt "}")) + ) + +(defun c1let* (args &aux (forms nil) (vars nil) (vnames nil) + (setjmps *setjmps*) + ss is ts body other-decls + (info (make-info)) (*vars* *vars*)) + (when (endp args) (too-few-args 'let* 1 0)) + + (multiple-value-setq (body ss ts is other-decls) (c1body (cdr args) nil)) + (c1add-globals ss) + + (dolist** (x (car args)) + (cond ((symbolp x) + (let ((v (c1make-var x ss is ts))) + (push x vnames) + (push (default-init (var-type v)) forms) + (push v vars) + (push v *vars*))) + ((not (and (consp x) (or (endp (cdr x)) (endp (cddr x))))) + (cmperr "The variable binding ~s is illegal." x)) + (t (let ((v (c1make-var (car x) ss is ts))) + (push (car x) vnames) + (push (if (endp (cdr x)) + (default-init (var-type v)) + (and-form-type (var-type v) + (c1expr* (cadr x) info) + (cadr x))) + forms) + (push v vars) + (push v *vars*))))) + + (check-vdecl vnames ts is) + (setq body (c1decl-body other-decls body)) + (add-info info (cadr body)) + (setf (info-type info) (info-type (cadr body))) + (dolist** (var vars) (check-vref var)) + (or (eql setjmps *setjmps*) (setf (info-volatile info) t)) + (list 'let* info (nreverse vars) (nreverse forms) body) + ) + +(defun c2let* (vars forms body + &aux (block-p nil) + (*unwind-exit* *unwind-exit*) + (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) + (declare (object block-p)) + + + (do ((vl vars (cdr vl)) + (fl forms (cdr fl))) + ((endp vl)) + (declare (object vl fl)) + (let* ((form (car fl)) (var (car vl)) + (kind (c2var-kind var))) + (declare (object form var)) + (cond (kind (setf (var-kind var) kind) + (setf (var-loc var) (next-cvar)))) + (if (member (var-kind var) + '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER)) + nil + (case (car form) + (LOCATION + (cond ((can-be-replaced* var body (cdr fl)) + (setf (var-kind var) 'REPLACED) + (setf (var-loc var) (caddr form))) + ((eq (var-kind var) 'object)) + ((eq (var-kind var) 'down) + (or (si::fixnump (var-loc var)) (baboon))) + (t (setf (var-ref var) (vs-push)) + ))) + (VAR + (let ((var1 (caaddr form))) + (declare (object var1)) + (cond ((and (can-be-replaced* var body (cdr fl)) + (member (var-kind var1) + '(LEXICAL REPLACED OBJECT)) + (null (var-ref-ccb var1)) + (not (args-info-changed-vars var1 (cdr fl))) + (not (is-changed var1 (cadr body)))) + (setf (var-kind var) 'REPLACED) + (setf (var-loc var) + (case (var-kind var1) + (LEXICAL (list 'vs (var-ref var1))) + (REPLACED (var-loc var1)) + (OBJECT (list 'cvar (var-loc var1))) + (t (baboon))))) + ((eq (var-kind var)'object)) + (t (setf (var-ref var) (vs-push)) + ))) + ) +; ((eq (var-kind var) 'object)) + (t (unless (eq (var-kind var) 'object) (setf (var-ref var) (vs-push))) + ))) + )) + + (setq block-p (write-block-open vars)) + + (do ((vl vars (cdr vl)) + (fl forms (cdr fl)) + (var nil) (form nil)) + ((null vl)) + (setq var (car vl))(setq form (car fl)) +; (print (list (var-kind var) (car form))) + (case + (var-kind var) + ((FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT INTEGER) + (let ((*value-to-go* (list 'var var nil))) + (c2expr* form))) + (REPLACED ) + (t + (case + (car form) + (LOCATION (c2bind-loc var (caddr form))) + (VAR (c2bind-loc var (list 'var (caaddr form) (cadr (caddr form))))) + (t (c2bind-init var form)))))) + + (c2expr body) + + (when block-p (wt "}")) + ) + +(defun can-be-replaced (var body) + (and (or (eq (var-kind var) 'LEXICAL) + (and (eq (var-kind var) 'object) + (< (the fixnum (var-register var)) + (the fixnum *register-min*)))) + (null (var-ref-ccb var)) + (not (eq (var-loc var) 'clb)) + (not (is-changed var (cadr body))))) + +(defun can-be-replaced* (var body forms) + (and (can-be-replaced var body) + (dolist** (form forms t) + (when (is-changed var (cadr form)) + (return nil))) + )) + + +(defun write-block-open (vars) + (let ( block-p) + (dolist** + (var vars) + (let ((kind (var-kind var))) + (declare (object kind)) + (when (member kind '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT + INTEGER)) + (wt-nl) + (unless block-p (wt "{") (setq block-p t)) + (wt-var-decl var) + ))) + block-p )) + + +;; ---------- stack-let for consing on stack --------- + +;; Usage: (stack-let ((a (cons 1 2)) (b (cons 3 4))) (foo a) (print b) 7) +;; where foo must not keep a copy of `a', since the cons will be formed +;; on the c stack. + +(setf (get 'stack-let 'c1special) 'c1stack-let) + +(defmacro stack-let (&rest x) (cons `let x)) + +(defun c1stack-let (args &aux npairs nums) + (let ((pairs (car args)) + ) + (dolist (v pairs) + (push + (cond ((atom v) v) + ((let ((var (car v)) + (val (second v))) + (and (consp val) + (or (eq (car val) 'cons) + (and (eq (car val) 'list) + (null (cddr val)) + (setq val `(cons ,(second val) nil)))) + (progn + (push (next-cvar) nums) + `(,var (stack-cons ,(car nums) ,@ (cdr val))))))) + (t (cmpwarn "Stack let = regular let for ~a ~a" + v (cdr args)) + v)) + npairs)) + (let ((result (c1expr (cons 'let (cons (nreverse npairs) (cdr args)))))) + (list 'stack-let (second result) nums result)))) + +(setf (get 'stack-let 'c2) 'c2stack-let) + +(defun c2stack-let (nums form) + (let ((n (next-cvar))) + (wt-nl "{Cons_Macro" n ";") + (c2expr form) + (wt "}") + (wt-h + "#define Cons_Macro" n (format nil " struct cons ~{STcons~a ~^,~};" nums) + ))) + +(push '((fixnum t t) t #.(flags) + "(STcons#0.t=t_cons,STcons#0.m=0,STcons#0.c_car=(#1), + STcons#0.c_cdr=SAFE_CDR(#2),(object)&STcons#0)") + (get 'stack-cons 'inline-always)) + +;; ---------- end stack-let for consing on stack --------- + diff --git a/cmpnew/gcl_cmploc.lsp b/cmpnew/gcl_cmploc.lsp new file mode 100755 index 0000000..a583446 --- /dev/null +++ b/cmpnew/gcl_cmploc.lsp @@ -0,0 +1,297 @@ +;;; CMPLOC Set-loc and Wt-loc. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(defvar *value-to-go*) + +;;; Valid locations are: +;;; NIL +;;; T +;;; 'FUN-VAL' +;;; ( 'VS' vs-address ) +;;; ( 'VS*' vs-address ) +;;; ( 'CCB-VS' ccb-vs ) +;;; ( 'VAR' var-object ccb ) +;;; ( 'VV' vv-index ) +;;; ( 'CVAR' cvar ) +;;; ( 'INLINE' side-effect-p fun/string locs ) +;;; ( 'INLINE-COND' side-effect-p fun/string locs ) +;;; ( 'INLINE-FIXNUM' side-effect-p fun/string locs ) +;;; ( 'INLINE-CHARACTER' side-effect-p fun/string locs ) +;;; ( 'INLINE-LONG-FLOAT' side-effect-p fun/string locs ) +;;; ( 'INLINE-SHORT-FLOAT' side-effect-p fun/string locs ) +;;; ( 'SIMPLE-CALL { SYMLISPCALL-NO-EVENT +;;; | LISPCALL-NO-EVENT +;;; | SYMLISPCALL +;;; | LISPCALL } +;;; vs-index number-of-arguments [ vv-index ] ) +;;; ( 'VS-BASE' offset ) +;;; ( 'CAR' cvar ) +;;; ( 'CADR' cvar ) +;;; ( 'SYMBOL-FUNCTION' vv-index ) +;;; ( 'MAKE-CCLOSURE' cfun cllink ) +;;; ( 'FIXNUM-VALUE' vv-index fixnum-value ) +;;; ( 'FIXNUM-LOC' loc ) +;;; ( 'CHARACTER-VALUE' vv-index character-code ) +;;; ( 'CHARACTER-LOC' loc ) +;;; ( 'LONG-FLOAT-VALUE' vv-index long-float-value ) +;;; ( 'LONG-FLOAT-LOC' loc ) +;;; ( 'SHORT-FLOAT-VALUE' vv-index short-float-value ) +;;; ( 'SHORT-FLOAT-LOC' loc ) + + +;;; Valid *value-to-go* locations are: +;;; +;;; 'RETURN' The value is returned from the current function. +;;; 'RETURN-FIXNUM' +;;; 'RETURN-CHARACTER' +;;; 'RETURN-LONG-FLOAT' +;;; 'RETURN-SHORT-FLOAT' +;;; 'RETURN-OBJECT +;;; 'TRASH' The value may be thrown away. +;;; 'TOP' The value should be set at the top of vs as if it were +;;; a resulted value of a function call. +;;; ( 'VS' vs-address ) +;;; ( 'VS*' vs-address ) +;;; ( 'CCB-VS' ccb-vs ) +;;; ( 'VAR' var-object ccb ) +;;; ( 'JUMP-TRUE' label ) +;;; ( 'JUMP-FALSE' label ) +;;; ( 'BDS-BIND' vv-index ) +;;; ( 'PUSH-CATCH-FRAME' ) +;;; ( 'DBIND' symbol-name-vv ) + +(si:putprop 'cvar 'wt-cvar 'wt-loc) +(si:putprop 'vv 'wt-vv 'wt-loc) +(si:putprop 'car 'wt-car 'wt-loc) +(si:putprop 'cdr 'wt-cdr 'wt-loc) +(si:putprop 'cadr 'wt-cadr 'wt-loc) +(si:putprop 'vs-base 'wt-vs-base 'wt-loc) +(si:putprop 'fixnum-value 'wt-fixnum-value 'wt-loc) +(si:putprop 'fixnum-loc 'wt-fixnum-loc 'wt-loc) +(si:putprop 'integer-loc 'wt-integer-loc 'wt-loc) +(si:putprop 'character-value 'wt-character-value 'wt-loc) +(si:putprop 'character-loc 'wt-character-loc 'wt-loc) +(si:putprop 'long-float-value 'wt-long-float-value 'wt-loc) +(si:putprop 'long-float-loc 'wt-long-float-loc 'wt-loc) +(si:putprop 'short-float-value 'wt-short-float-value 'wt-loc) +(si:putprop 'short-float-loc 'wt-short-float-loc 'wt-loc) +(si::putprop 'next-var-arg 'wt-next-var-arg 'wt-loc) +(si::putprop 'first-var-arg 'wt-first-var-arg 'wt-loc) + +(defun wt-first-var-arg () + (wt "first")) + +(defun wt-next-var-arg () + (wt "va_arg(ap,object)")) + +(defun set-loc (loc &aux fd) + (cond ((eq *value-to-go* 'return) (set-return loc)) + ((eq *value-to-go* 'trash) + (cond ((and (consp loc) + (member (car loc) + '(INLINE INLINE-COND INLINE-FIXNUM inline-integer + INLINE-CHARACTER INLINE-LONG-FLOAT + INLINE-SHORT-FLOAT)) + (cadr loc)) + (wt-nl "(void)(") (wt-inline t (caddr loc) (cadddr loc)) + (wt ");")) + ((and (consp loc) (eq (car loc) 'SIMPLE-CALL)) + (wt-nl "(void)" loc ";")))) + ((eq *value-to-go* 'top) + (unless (eq loc 'fun-val) (set-top loc))) + ((eq *value-to-go* 'return-fixnum) (set-return-fixnum loc)) + ((eq *value-to-go* 'return-character) (set-return-character loc)) + ((eq *value-to-go* 'return-long-float) (set-return-long-float loc)) + ((eq *value-to-go* 'return-short-float) (set-return-short-float loc)) + ((or (not (consp *value-to-go*)) + (not (symbolp (car *value-to-go*)))) + (baboon)) + ((setq fd (get (car *value-to-go*) 'set-loc)) + (apply fd loc (cdr *value-to-go*))) + ((setq fd (get (car *value-to-go*) 'wt-loc)) + (wt-nl) (apply fd (cdr *value-to-go*)) (wt "= " loc ";")) + (t (baboon))) + ) + +(defun wt-loc (loc) + (cond ((eq loc nil) (wt "Cnil")) + ((eq loc t) (wt "Ct")) + ((eq loc 'fun-val) (wt "vs_base[0]")) + ((or (not (consp loc)) + (not (symbolp (car loc)))) + (baboon)) + (t (let ((fd (get (car loc) 'wt-loc))) + (when (null fd) (baboon)) + (apply fd (cdr loc))))) + ) + +(defun set-return (loc) + (cond ((eq loc 'fun-val)) + ((and (consp loc) (eq (car loc) 'vs) (= (caadr loc) *level*)) + (wt-nl "vs_top=(vs_base=base+" (cdadr loc) ")+1;") + (base-used)) + ((and (consp loc) + (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'LEXICAL) + (not (var-ref-ccb (cadr loc))) + (eql (car (var-ref (cadr loc))) *level*)) + (wt-nl "vs_top=(vs_base=base+" (cdr (var-ref (cadr loc))) ")+1;") + (base-used)) + (t (set-top loc))) + ) + +(defun set-top (loc) + (let ((*vs* *vs*)) + (wt-nl) (wt-vs (vs-push)) (wt "= " loc ";") + (wt-nl "vs_top=(vs_base=base+" (1- *vs*) ")+1;") + (base-used))) + +(defun wt-vs-base (offset) (wt "vs_base[" offset "]")) + +(defun wt-car (cvar) (wt "(V" cvar "->c.c_car)")) + +(defun wt-cdr (cvar) (wt "(V" cvar "->c.c_cdr)")) + +(defun wt-cadr (cvar) (wt "(V" cvar "->c.c_cdr->c.c_car)")) + +(defun wt-cvar (cvar &optional type) + (if type (wt "/* " (symbol-name type) " */")) + (wt "V" cvar)) + +(defun vv-str (vv) (let ((vv (add-object2 vv))) (si::string-concatenate "((object)VV[" (write-to-string vv) "])"))) + +(defun wt-vv (vv) (wt (vv-str vv))) + +(defun wt-fixnum-loc (loc) + (cond ((and (consp loc) + (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'FIXNUM)) + (wt "V" (var-loc (cadr loc)))) + ((and (consp loc) (eq (car loc) 'INLINE-FIXNUM)) + (wt "(long)")(wt-inline-loc (caddr loc) (cadddr loc))) + ((and (consp loc) (eq (car loc) 'fixnum-value)) + (wt "(long)")(wt (caddr loc))) + ((and (consp loc) (member (car loc) '(INLINE-SHORT-FLOAT + INLINE-LONG-FLOAT))) + (wt "((long)(") + (wt-inline-loc (caddr loc) (cadddr loc)) + (wt "))")) + (t (wt "fix(" loc ")")))) + +(defun wt-integer-loc (loc &optional type + &aux (avma t)(first (and (consp loc) (car loc)))) + (declare (ignore type)) + (case first + (inline-fixnum + (wt "stoi(") + (wt-inline-loc (caddr loc) (cadddr loc)) + (wt ")")) + (INLINE-INTEGER (setq avma nil) (wt-inline-loc (caddr loc) (cadddr loc))) + (fixnum-value (wt "stoi(" (caddr loc) ")")) + (var + (case (var-kind (cadr loc)) + (integer (setq avma nil) (wt "V" (var-loc (cadr loc)))) + (fixnum (wt "stoi(V" (var-loc (cadr loc))")")) + (otherwise (wt "otoi(" loc ")")))) + (otherwise (wt "otoi(" loc ")"))) + (and avma (not *restore-avma*)(wfs-error)) + ) + + +(defun fixnum-loc-p (loc) + (and (consp loc) + (or (and (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'FIXNUM)) + (eq (car loc) 'INLINE-FIXNUM) + (eq (car loc) 'fixnum-value)))) + +(defun wt-fixnum-value (vv fixnum-value) + (if vv (wt (vv-str vv)) + (wt "small_fixnum(" fixnum-value ")"))) + + +(defun wt-character-loc (loc) + (cond ((and (consp loc) + (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'CHARACTER)) + (wt "V" (var-loc (cadr loc)))) + ((and (consp loc) (eq (car loc) 'INLINE-CHARACTER)) + (wt-inline-loc (caddr loc) (cadddr loc))) + ((and (consp loc) (eq (car loc) 'CHARACTER-VALUE)) + (wt (caddr loc))) + (t (wt "char_code(" loc ")")))) + +(defun character-loc-p (loc) + (and (consp loc) + (or (and (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'CHARACTER)) + (eq (car loc) 'INLINE-CHARACTER) + (eq (car loc) 'character-value)))) + +(defun wt-character-value (vv character-code) + (declare (ignore character-code)) + (wt (vv-str vv))) + +(defun wt-long-float-loc (loc) + (cond ((and (consp loc) + (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'LONG-FLOAT)) + (wt "V" (var-loc (cadr loc)))) + ((and (consp loc) (eq (car loc) 'INLINE-LONG-FLOAT)) + (wt-inline-loc (caddr loc) (cadddr loc))) + ((and (consp loc) (eq (car loc) 'long-float-value)) + (wt (caddr loc))) + (t (wt "lf(" loc ")")))) + +(defun long-float-loc-p (loc) + (and (consp loc) + (or (and (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'LONG-FLOAT)) + (eq (car loc) 'INLINE-LONG-FLOAT) + (eq (car loc) 'long-float-value)))) + +(defun wt-long-float-value (vv long-float-value) + (declare (ignore long-float-value)) + (wt (vv-str vv))) + +(defun wt-short-float-loc (loc) + (cond ((and (consp loc) + (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'SHORT-FLOAT)) + (wt "V" (var-loc (cadr loc)))) + ((and (consp loc) (eq (car loc) 'INLINE-SHORT-FLOAT)) + (wt-inline-loc (caddr loc) (cadddr loc))) + ((and (consp loc) (eq (car loc) 'short-float-value)) + (wt (caddr loc))) + (t (wt "sf(" loc ")")))) + +(defun short-float-loc-p (loc) + (and (consp loc) + (or (and (eq (car loc) 'var) + (eq (var-kind (cadr loc)) 'SHORT-FLOAT)) + (eq (car loc) 'INLINE-SHORT-FLOAT) + (eq (car loc) 'short-float-value)))) + +(defun wt-short-float-value (vv short-float-value) + (declare (ignore short-float-value)) + (wt (vv-str vv))) diff --git a/cmpnew/gcl_cmpmain.lsp b/cmpnew/gcl_cmpmain.lsp new file mode 100755 index 0000000..8eee6ed --- /dev/null +++ b/cmpnew/gcl_cmpmain.lsp @@ -0,0 +1,802 @@ +;;; CMPMAIN Compiler main program. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;; **** Caution **** +;;; This file is machine/OS dependant. +;;; ***************** + + +(in-package :compiler) + + +(export '(*compile-print* *compile-verbose*)) +(import 'si::(*tmp-dir* *cc* *ld* *objdump*)) +(import 'si::*error-p* 'compiler) + +;;; This had been true with Linux 1.2.13 a.out or even older +;;; #+linux (push :ld-not-accept-data *features*) +;;; its now a bug preventing the :linux feature. + + +(defvar *compiler-in-use* nil) +(defvar *compiler-compile* nil) +(defvar *compiler-input*) +(defvar *compiler-output1*) +(defvar *compiler-output2*) +(defvar *compiler-output-data*) +(defvar *compiler-output-i*) + +(defvar *compile-print* nil) +(defvar *compile-verbose* t) +(defvar *cmpinclude* "\"cmpinclude.h\"") +;;If the following is a string, then it is inserted instead of +;; the include file cmpinclude.h, EXCEPT for system-p calls. +(defvar *cmpinclude-string* + (si::file-to-string + (namestring + (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :back "h")) + :name "cmpinclude" :type "h")))) + + +;; Let the user write dump c-file etc to /dev/null. +(defun get-output-pathname (file ext name &optional + (dir (pathname-directory *default-pathname-defaults*)) + (device (pathname-device *default-pathname-defaults*))) + (cond ((equal file "/dev/null") (pathname file)) + #+aix3 + ((and (equal name "float") + (equal ext "h")) + (get-output-pathname file ext "Float" )) + ((let ((lf (and file (not (eq file t))))) + (let ((device (if lf (pathname-device file) device)) + (dir (if lf (pathname-directory file) dir)) + (name (if lf (pathname-name file) name))) + (make-pathname :device device :directory dir :name name :type ext)))))) + +(defun safe-system (string) + (multiple-value-bind + (code result) (system (mysub (ts string) "$" "\\$")) + (unless (and (zerop code) (zerop result)) + (cerror "Continues anyway." + "(SYSTEM ~S) returned a non-zero value ~D ~D." + string code result) + (setq *error-p* t)) + (values result))) + +;; If this is t we use fasd-data on all but system-p files. If it +;; is :system-p we use it on all files. If nil use it on none. +(defvar *fasd-data* t) +(defvar *data* nil) +(defvar *default-system-p* nil) +(defvar *default-c-file* nil) +(defvar *default-h-file* nil) +(defvar *default-data-file* nil) +(defvar *default-prof-p* nil) +#+large-memory-model(defvar *default-large-memory-model-p* nil) +(defvar *keep-gaz* nil) +(defvar *prof-p* nil) +#+large-memory-model(defvar *large-memory-model-p* nil) + +;; (list section-length split-file-names next-section-start-file-position) +;; Many c compilers cannot handle the large C files resulting from large lisp files. +;; If *split-files* is a number then, separate compilations for sections +;; *split-files* long, with the +;; will be performed for separate chunks of the lisp files. +(defvar *split-files* nil) ;; if +(defvar *compile-file-truename*) + +(defun compile-file (filename &rest args + &aux (*print-pretty* nil) + (*package* *package*) (*split-files* *split-files*) + (*PRINT-CIRCLE* NIL) + (*PRINT-RADIX* NIL) + (*PRINT-ARRAY* T) + (*PRINT-LEVEL* NIL) + (*PRINT-PRETTY* T) + (*PRINT-LENGTH* NIL) + (*PRINT-GENSYM* T) + (*PRINT-CASE* :UPCASE) + (*PRINT-BASE* 10) + (*PRINT-ESCAPE* T) + (section-length *split-files*) + tem warnings failures + (filename (pathname filename)) + (*compile-file-pathname* (merge-pathnames filename #p".lsp")) + (*compile-file-truename* (truename *compile-file-pathname*))) + (loop + (compiler::init-env) + (setq tem (apply 'compile-file1 filename args)) + (cond ((atom *split-files*) + (return (values (when tem (truename tem)) warnings failures))) + ((null (third *split-files*)) + (let ((gaz (gazonk-name))(*readtable* (si::standard-readtable))) + (with-open-file (st gaz :direction :output) + (print + `(eval-when (load eval) + (dolist (v ',(nreverse (second *split-files*))) + (load (merge-pathnames v si::*load-pathname*)))) + st)) + (setq *split-files* nil) + (return + (let ((tem (apply 'compile-file gaz + (append args + (unless (member :output-file args) + (list :output-file + (get-output-pathname filename "o" nil nil nil))))))) + (unless *keep-gaz* (mdelete-file gaz)) + (values (when tem (truename tem)) warnings failures))))) + ((setf (car *split-files*) (+ (third *split-files*) section-length)))))) + + +(defun compile-file1 (input-pathname + &key (output-file (merge-pathnames ".o" (truename input-pathname))) + (o-file t) + (c-file *default-c-file*) + (h-file *default-h-file*) + (data-file *default-data-file*) + (c-debug nil) + (system-p *default-system-p*) + (prof-p *default-prof-p*) + #+large-memory-model(large-memory-model-p *default-large-memory-model-p*) + (print nil) + (load nil) + &aux + (*standard-output* *standard-output*) + (*prof-p* prof-p) + #+large-memory-model(*large-memory-model-p* large-memory-model-p) + (output-file (pathname output-file)) + (*error-output* *error-output*) + (*compiler-in-use* *compiler-in-use*) + (*c-debug* c-debug) + (*compile-print* (or print *compile-print*)) + (*DEFAULT-PATHNAME-DEFAULTS* #p"") + (*data* (list nil)) + *init-name* + (*fasd-data* *fasd-data*) + (*error-count* 0)) + + (declare (special *c-debug* *init-name* system-p)) + + (cond (*compiler-in-use* + (format t "~&The compiler was called recursively.~%~ +Cannot compile ~a.~%" + (namestring (merge-pathnames input-pathname #p".lsp"))) + (setq *error-p* t) + (return-from compile-file1 (values))) + (t (setq *error-p* nil) + (setq *compiler-in-use* t))) + + (unless (probe-file (merge-pathnames input-pathname #p".lsp")) + (format t "~&The source file ~a is not found.~%" + (namestring (merge-pathnames input-pathname #p".lsp"))) + (setq *error-p* t) + (return-from compile-file1 (values))) + + (when *compile-verbose* + (format t "~&Compiling ~a.~%" (namestring (merge-pathnames input-pathname #p".lsp")))) + + (and *record-call-info* (clear-call-table)) + + (with-open-file + (*compiler-input* (merge-pathnames input-pathname #p".lsp")) + + + (when (numberp *split-files*) + (setq *split-files* (unless (< (file-length *compiler-input*) *split-files*) (list *split-files* nil 0 nil)))) + + (when (consp *split-files*) + (file-position *compiler-input* (third *split-files*)) + (setq output-file + (make-pathname :directory (pathname-directory output-file) + :name (format nil "~a~a" + (pathname-name output-file) + (length (second *split-files*))) + :type "o"))) + + + (let* ((eof (cons nil nil)) + (dir (pathname-directory (or output-file input-pathname))) + (name (pathname-name (or output-file input-pathname))) + (device (pathname-device (or output-file input-pathname))) + (typ (pathname-type (or output-file #p".o"))) + (o-pathname (get-output-pathname o-file typ name dir device)) + (c-pathname (get-output-pathname c-file "c" name dir device)) + (h-pathname (get-output-pathname h-file "h" name dir device)) + (data-pathname (get-output-pathname data-file "data" name dir device))) + + (declare (special dir name)) + + (init-env) + + (and (boundp 'si::*gcl-version*) + (not system-p) + (add-init `(si::warn-version ,si::*gcl-major-version* + ,si::*gcl-minor-version* + ,si::*gcl-extra-version*))) + + (when (probe-file "./gcl_cmpinit.lsp") + (load "./gcl_cmpinit.lsp" :verbose *compile-verbose*)) + + (with-open-file (*compiler-output-data* data-pathname :direction :output) + + (when *fasd-data* + (setq *fasd-data* (list (si::open-fasd *compiler-output-data* :output nil nil)))) + + (wt-data-begin) + + (if *compiler-compile* + (t1expr *compiler-compile*) + (let* ((rtb *readtable*) + (prev (and (eq (get-macro-character #\# rtb) + (get-macro-character + #\# (si:standard-readtable))) + (get-dispatch-macro-character #\# #\, rtb)))) + (if (and prev (eq prev (get-dispatch-macro-character + #\# #\, (si:standard-readtable)))) + (set-dispatch-macro-character #\# #\, 'si:sharp-comma-reader-for-compiler rtb) + (setq prev nil)) + + ;; t1expr the package ops again.. + (when (consp *split-files*) + (dolist (v (fourth *split-files*)) (t1expr v))) + + (unwind-protect + (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof)) + (load-flag (if *eval-when-defaults* + (or (member 'load *eval-when-defaults*) + (member :load-toplevel *eval-when-defaults*)) + t))) + (nil) + + (unless (eq form eof) + (if load-flag + (t1expr form) + (maybe-eval nil form))) + + (when (or (eq form eof) + (when *split-files* + (> (file-position *compiler-input*) (car *split-files*)))) + + (when *split-files* + (push (pathname-name output-file) (second *split-files*)) + (setf (third *split-files*) (unless (eq form eof) (file-position *compiler-input*))) + (setf (fourth *split-files*) nil));(reverse (third *data*)) ;FIXME check this + + (return nil))) + + (when prev (set-dispatch-macro-character #\# #\, prev rtb))))) + + (setq *init-name* (init-name input-pathname system-p)) + + (when (zerop *error-count*) + (when *compile-verbose* (format t "~&End of Pass 1. ~%")) + (compiler-pass2 c-pathname h-pathname system-p )) + + (wt-data-end)) ;;; *compiler-output-data* closed. + + (init-env) + + (if (zerop *error-count*) + + (progn + (when *compile-verbose* (format t "~&End of Pass 2. ~%")) + (cond (*record-call-info* + (dump-fn-data (get-output-pathname output-file "fn" name dir device)))) + (cond (o-file + (compiler-cc c-pathname o-pathname ) + (cond ((probe-file o-pathname) + (compiler-build o-pathname data-pathname) + (when load (load o-pathname)) + (when *compile-verbose* + (print-compiler-info) + (format t "~&Finished compiling ~a.~%" (namestring output-file) + ))) + (t + (format t "~&Your C compiler failed to compile the intermediate file.~%") + (setq *error-p* t)))) + (*compile-verbose* + (print-compiler-info) + (format t "~&Finished compiling ~a.~%" (namestring output-file) + ))) + (unless c-file (mdelete-file c-pathname)) + (unless h-file (mdelete-file h-pathname)) + (unless (or data-file #+ld-not-accept-data t system-p) (mdelete-file data-pathname)) + (when o-file o-pathname)) + + (progn + (when (probe-file c-pathname) (mdelete-file c-pathname)) + (when (probe-file h-pathname) (mdelete-file h-pathname)) + (when (probe-file data-pathname) (mdelete-file data-pathname)) + (format t "~&No FASL generated.~%") + (setq *error-p* t) + (values)))))) + +(defun gazonk-name () + (dotimes (i 1000) + (let ((tem (merge-pathnames + (format nil "~agazonk_~d_~d.lsp" (if (boundp '*tmp-dir*) *tmp-dir* "") (abs (si::getpid)) i)))) + (unless (probe-file tem) + (return-from gazonk-name (pathname tem))))) + (error "1000 gazonk names used already!")) + +(defun prin1-cmp (form strm) + (let ((*compiler-output-data* strm) + (*fasd-data* nil)) + (wt-data1 form) ;; this binds all the print stuff + )) + +(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #p".")) + + (cond ((not(symbolp name)) (error "Must be a name")) + ((and (consp def) + (member (car def) '(lambda ))) + (or name (setf name 'cmp-anon)) + (setf (symbol-function name) + def) + (compile name)) + (def (error "def not a lambda expression")) + ((setq tem (macro-function name)) + (setf (symbol-function 'cmp-anon) tem) + (compile 'cmp-anon) + (setf (macro-function name) (macro-function name)) + ;; FIXME -- support warnings-p and failures-p. CM 20041119 + (values name nil nil)) + ((and (setq tem (symbol-function name)) + (consp tem)) + (let ((na (if (symbol-package name) name 'cmp-anon))) + (unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon))) + (with-open-file + (st (setq gaz (gazonk-name)) :direction :output)) + (let* ((*compiler-compile* + `(defun ,na + ,@(ecase (car tem) + (lambda (cdr tem)) + (lambda-block (cddr tem))))) + (fi (compile-file gaz))) + (when (pathnamep fi) + (load fi) + (mdelete-file fi))) + (unless *keep-gaz* (mdelete-file gaz))) + (or (eq na name) (setf (symbol-function name) (symbol-function na))) + ;; FIXME -- support warnings-p and failures-p. CM 20041119 + (values (symbol-function name) nil nil) + )) + (t (error "can't compile ~a" name)))) + +(defun disassemble (name &aux tem) + (cond ((and (consp name) + (eq (car name) 'lambda)) + (eval `(defun cmp-anon ,@ (cdr name))) + (disassemble 'cmp-anon)) + ((not(symbolp name)) (error "Not a lambda or a name")) + ((setq tem(macro-function name)) + (setf (symbol-function 'cmp-tmp-macro) tem) + (disassemble 'cmp-tmp-macro) + (setf (macro-function name) (macro-function name)) + name) + ((and (setq tem (symbol-function name)) + (consp tem) + (eq (car tem) 'lambda-block)) + (let ((gaz (gazonk-name))) + (with-open-file + (st gaz :direction :output) + (prin1-cmp `(defun ,name ,@ (cddr tem)) st)) + (let (*fasd-data*) + (compile-file gaz + :h-file t + :c-file t + :data-file t + :o-file t)) + (let ((cn (get-output-pathname gaz "c" gaz )) + (dn (get-output-pathname gaz "data" gaz )) + (hn (get-output-pathname gaz "h" gaz )) + (on (get-output-pathname gaz "o" gaz ))) + (with-open-file (st cn) + (do () ((let ((a (read-line st))) + (when (>= (si::string-match "gazonk_[0-9]*_[0-9]*.h" a) 0) + (format t "~%~d~%" a) + a)))) + (si::copy-stream st *standard-output*)) + (with-open-file (st dn) + (si::copy-stream st *standard-output*)) + (with-open-file (st hn) + (si::copy-stream st *standard-output*)) + (when *objdump* + (safe-system (si::string-concatenate *objdump* (namestring on)))) + (mdelete-file cn) + (mdelete-file dn) + (mdelete-file hn) + (mdelete-file on) + (unless *keep-gaz* (mdelete-file gaz))))) + (t (error "can't disassemble ~a" name)))) + + +(defun compiler-pass2 (c-pathname h-pathname system-p + &aux + (ci *cmpinclude*) + (ci (when (stringp ci) (subseq ci 1 (1- (length ci))))) + (ci (concatenate 'string si::*system-directory* "../h/" ci)) + (system-p (when (probe-file ci) system-p))) + (declare (special *init-name*)) + (with-open-file (st c-pathname :direction :output) + (let ((*compiler-output1* st)) + (declare (special *compiler-output1*)) + (with-open-file (*compiler-output2* h-pathname :direction :output) + (cond ((and + (stringp *cmpinclude-string*) + (not system-p) + (si::fwrite *cmpinclude-string* 0 + (length *cmpinclude-string*) *compiler-output1*))) + (t (wt-nl1 "#include " *cmpinclude*))) + (wt-nl1 "#include \"" + (namestring + (make-pathname :name + (pathname-name h-pathname) + :type (pathname-type h-pathname))) + "\"") + + (catch *cmperr-tag* (ctop-write *init-name*)) + + (terpri *compiler-output1*) + ;; write ctl-z at end to make sure preprocessor stops! + #+dos (write-char (code-char 26) *compiler-output1*) + (terpri *compiler-output2*))))) + + +(defvar *ld-libs* "ld-libs") +(defvar *opt-three* "") +(defvar *opt-two* "") +(defvar *init-lsp* "init-lsp") + +(defvar *use-buggy* nil) + +(defun remove-flag (flag flags) + (let ((i (search flag flags))) + (if i + (concatenate 'string (subseq flags 0 i) (remove-flag flag (subseq flags (+ i (length flag))))) + flags))) + +(defun compiler-command (&rest args &aux na ) + (declare (special *c-debug*)) + (let ((dirlist (pathname-directory (first args))) + (name (pathname-name (first args))) + dir) + (cond (dirlist (setq dir (namestring (make-pathname :directory dirlist)))) + (t (setq dir "."))) + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) + (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a ~a" + (concatenate 'string + (if *prof-p* (remove-flag "-fomit-frame-pointer" *cc*) *cc*) + #+large-memory-model(if *large-memory-model-p* " -mcmodel=large " "") + #-large-memory-model "") + (if *prof-p* " -pg " "") + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") + (case *speed* + (3 *opt-three* ) + (2 *opt-two*) + (t "")) + (namestring (first args)) + (namestring (second args)) + (prog1 + #+aix3 + (format nil " -w ;ar x /lib/libc.a fsavres.o ; ar qc XXXfsave fsavres.o ; echo init_~a > XXexp ; mv ~a XXX~a ; ld -r -D-1 -bexport:XXexp -bgc XXX~a -o ~a XXXfsave ; rm -f XXX~a XXexp XXXfsave fsavres.o" + *init-name* + (setq na (namestring (get-output-pathname na "o" nil))) + na na na na na) + #+(or dlopen irix5) + (if (not system-p) + (format nil + " -w ; mv ~a XX~a ; ld ~a -shared XX~a -o ~a -lc ; rm -f XX~a" + (setq na (namestring (get-output-pathname na "o" nil))) na + #+ignore-unresolved "-ignore_unresolved" + #+expect-unresolved "-expect_unresolved '*'" + na na na)) + + #+(or winnt bsd) ""; "-w" + #-(or aix3 bsd winnt irix3) "");" 2> /dev/null " + + + ) + ) + ) + +#+(or cygwin winnt) (defun prep-win-path-acc ( s acc) + (let ((pos (search "\~" s))) + (if pos + (let ((start (subseq s 0 (1+ pos))) + (finish (subseq s (1+ pos)))) + (prep-win-path-acc finish (concatenate 'string acc start "~"))) + (concatenate 'string acc s)))) + +(defun compiler-cc (c-pathname o-pathname) + (safe-system + (format + nil + #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" + #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" + #+(or cygwin winnt) (prep-win-path-acc (compiler-command c-pathname o-pathname) "") + #-(or vax system-v e15 dgux sgi) (compiler-command c-pathname o-pathname) + *cc* + (if (or (= *speed* 2) (= *speed* 3)) t nil) + (namestring c-pathname) + (namestring o-pathname) + + )) + + #+large-memory-model(when *large-memory-model-p* (mark-as-large-memory-model o-pathname)) + + #+dont_need + (let ((cname (pathname-name c-pathname)) + (odir (pathname-directory o-pathname)) + (oname (pathname-name o-pathname))) + (unless (and (equalp (truename "./") + (truename (make-pathname :directory odir))) + (equal cname oname)) + (rename-file (make-pathname :name cname :type "o") + o-pathname) +))) + + +(defun compiler-build (o-pathname data-pathname) + #+(and system-v (not e15)) + (safe-system (format nil "echo \"\\000\\000\\000\\000\" >> ~A" + (namestring o-pathname))) + #+(or hp-ux sun sgi) + (with-open-file (o-file + (namestring o-pathname) + :direction :output + :if-exists :append) + ; we could do a safe-system, but forking is slow on the Iris + #+(or hp-ux (and sgi (not irix5))) + (dotimes (i 12) + (write-char #\^@ o-file)) + #+sun ; we could do a safe-system, but forking is slow on the Iris + (dolist (v '(0 0 4 16 0 0 0 0)) + (write-byte v o-file)) + + ) + #-ld-not-accept-data + (when (probe-file o-pathname) + (nconc-files o-pathname data-pathname) + #+never + (safe-system (format nil + "cat ~a >> ~A" + (namestring data-pathname) + (namestring o-pathname))))) + +(defun print-compiler-info () + (format t "~&OPTIMIZE levels: Safety=~d~:[ (No runtime error checking)~;~], Space=~d, Speed=~d~%" + (cond ((null *compiler-check-args*) 0) + ((null *safe-compile*) 1) + ((null *compiler-push-events*) 2) + (t 3)) + *safe-compile* *space* *speed*)) + +(defun nconc-files (a b) + (let* ((n 256) + (tem (make-string n)) + (m 0)) + (with-open-file (st-a a :direction :output :if-exists :append) + (with-open-file (st-b b ) + (sloop::sloop + do (setq m (si::fread tem 0 n st-b)) + while (and m (> m 0)) + do (si::fwrite tem 0 m st-a)))))) + +#+dos +(progn +(defun directory (x &aux ans) + (let* ((pa (pathname x)) + (temp "XXDIR") + tem + (name (pathname-name pa))) + (setq pa (make-pathname :directory (pathname-directory pa) + :name (or (pathname-name pa) :wild) + :type (pathname-type pa))) + (setq name (namestring pa)) + (safe-system (format nil "ls -d ~a > ~a" name temp)) + (with-open-file (st temp) + (loop (setq tem (read-line st nil nil)) + (if (and tem (setq tem (probe-file tem))) + (push tem ans) (return)))) + ans)) + +(defvar *old-compile-file* #'compile-file) +(defun compile-file (f &rest l) + (let* ((p (pathname f)) dir pwd) + (setq dir (pathname-directory p)) + (when dir + (setq dir (namestring (make-pathname :directory dir + :name "."))) + (setq pwd (namestring (truename "."))) + ) + (unwind-protect + (progn (if dir (si::chdir dir)) + (apply *old-compile-file* f l)) + (if pwd (si::chdir pwd))))) + +(defun user-homedir-pathname () + (or (si::getenv "HOME") "/")) + +) + +; +; These functions are added to build custom images requiring +; the loading of binary objects on systems relocating with dlopen. +; + +(defun make-user-init (files outn) + + (let* ((c (pathname outn)) + (c (merge-pathnames c (make-pathname :directory '(:relative)))) + (o (merge-pathnames (make-pathname :type "o") c)) + (c (merge-pathnames (make-pathname :type "c") c))) + + (with-open-file (st c :direction :output) + (format st "#include ~a~%~%" *cmpinclude*) + + (format st "#define load2(a) do {") + (format st "printf(\"Loading %s...\\n\",(a));") + (format st "load(a);") + (format st "printf(\"Finished %s...\\n\",(a));} while(0)~%~%") + + (let ((p nil)) + (dolist (tem files) + (when (equal (pathname-type tem) "o") + (let ((tem (namestring tem))) + (push (list (si::find-init-name tem) tem) p)))) + + (setq p (nreverse p)) + + (dolist (tem p) + (format st "extern void ~a(void);~%" (car tem))) + (format st "~%") + + (format st "typedef struct {void (*fn)(void);char *s;} Fnlst;~%") + (format st "#define NF ~a~%" (length p)) + (format st "static Fnlst my_fnlst[NF]={") + (dolist (tem p) + (when (not (eq tem (car p))) + (format st ",~%")) + (format st "{~a,\"~a\"}" (car tem) (cadr tem))) + (format st "};~%~%") + + (format st "static int user_init_run;~%") + (format st "#define my_load(a_,b_) {if (!user_init_run && (a_) && (b_)) gcl_init_or_load1((a_),(b_));(a_)=0;(b_)=0;}~%~%") + + (format st "object user_init(void) {~%") + (format st "user_init_run=1;~%") + (dolist (tem files) + (let ((tem (namestring tem))) + (cond ((equal (cadr (car p)) tem) + (format st "gcl_init_or_load1(~a,\"~a\");~%" + (car (car p)) tem) + (setq p (cdr p))) + (t + (format st "load2(\"~a\");~%" tem))))) + (format st "return Cnil;}~%~%") + + (format st "static int my_strncmp(const char *s1,const char *s2,unsigned long n) {") + (format st " for (;n--;) if (*s1++!=*s2++) return 1; return 0;}") + + (format st "int user_match(const char *s,int n) {~%") + (format st " Fnlst *f;~%") + (format st " for (f=my_fnlst;fs && !my_strncmp(s,f->s,n)) {~%") + (format st " my_load(f->fn,f->s);~%") + (format st " return 1;~%") + (format st " }~%") + (format st " }~%") + (format st " return 0;~%") + (format st "}~%~%"))) + + (compiler-cc c o) + (mdelete-file c) + + o)) + +(defun mysub (str it new) + (let ((x (search it str))) + (unless x + (return-from mysub str)) + (let ((y (+ (length it) (the fixnum x)))) + (declare (fixnum y)) + (concatenate (type-of str) + (subseq str 0 x) + new + (mysub (subseq str y) it new))))) + + +(eval-when (compile eval) +(defmacro fcr (x) `(load-time-value (si::compile-regexp ,x))) +(defmacro sml (x y &optional z) + (let ((q (gensym))) + `(let ((,q (si::string-match ,x ,y ,@(when z (list z))))) + (if (= ,q -1) (length ,y) ,q))))) + +(defun ts (s) + (declare (string s)) + s) + +(defun mdelete-file (x) + (delete-file (ts (namestring x)))) + + +(defun link (files image &optional post extra-libs (run-user-init t)) + + (let* ((ui (make-user-init files "user-init")) + (raw (pathname image)) + (init (merge-pathnames (make-pathname + :name (concatenate 'string "init_" (pathname-name raw)) + :type "lsp") raw)) + (raw (merge-pathnames raw (truename "./"))) + (raw (merge-pathnames (make-pathname + :name (concatenate 'string "raw_" (pathname-name raw))) + raw)) + (map (merge-pathnames (make-pathname + :name (concatenate 'string (pathname-name raw) "_map")) raw)) + #+winnt (raw (merge-pathnames (make-pathname :type "exe") raw))) + + (with-open-file (st (namestring map) :direction :output)) + (safe-system + (let* ((par (namestring (make-pathname :directory '(:relative :back)))) + (i (concatenate 'string " " par)) + (j (concatenate 'string " " si::*system-directory* par))) + (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" + (mysub *ld* i j) + (namestring raw) + (namestring ui) + (let ((sfiles "")) + (dolist (tem files) + (if (equal (pathname-type tem) "o") + (setq sfiles (concatenate 'string sfiles " " (namestring tem))))) + sfiles) + si::*system-directory* + #+gnu-ld (format nil "-Wl,-Map ~a" (namestring map)) #-gnu-ld "" + (if (stringp extra-libs) extra-libs "") + (mysub *ld-libs* i j)))) + + (mdelete-file ui) + + (with-open-file (st init :direction :output) + (unless run-user-init + (format st "(fmakunbound 'si::user-init)~%")) + (format st "(setq si::*no-init* '(") + (dolist (tem files) + (format st " \"~a\"" (pathname-name tem))) + (format st "))~%") + (with-open-file (st1 + (format nil "~a~a" si::*system-directory* *init-lsp*)) + (si::copy-stream st1 st)) + (if (stringp post) (format st "~a~%" post)) + (format st "(si::save-system \"~a\")~%" (ts (namestring image)))) + + (safe-system (format nil "~a ~a < ~a" + (namestring raw) + si::*system-directory* + (namestring init))) + + (mdelete-file raw) + (mdelete-file init)) + + image) diff --git a/cmpnew/gcl_cmpmap.lsp b/cmpnew/gcl_cmpmap.lsp new file mode 100755 index 0000000..de5bf78 --- /dev/null +++ b/cmpnew/gcl_cmpmap.lsp @@ -0,0 +1,262 @@ +;;; CMPMAP Map functions. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'mapcar 'c1mapcar 'c1) +(si:putprop 'maplist 'c1maplist 'c1) +(si:putprop 'mapcar 'c2mapcar 'c2) +(si:putprop 'mapc 'c1mapc 'c1) +(si:putprop 'mapl 'c1mapl 'c1) +(si:putprop 'mapc 'c2mapc 'c2) +(si:putprop 'mapcan 'c1mapcan 'c1) +(si:putprop 'mapcon 'c1mapcon 'c1) +(si:putprop 'mapcan 'c2mapcan 'c2) + +(defun c1mapcar (args) (c1map-functions 'mapcar t args)) +(defun c1maplist (args) (c1map-functions 'mapcar nil args)) +(defun c1mapc (args) (c1map-functions 'mapc t args)) +(defun c1mapl (args) (c1map-functions 'mapc nil args)) +(defun c1mapcan (args) (c1map-functions 'mapcan t args)) +(defun c1mapcon (args) (c1map-functions 'mapcan nil args)) + +(defun c1map-functions (name car-p args &aux funob info) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'map-function 2 (length args))) + (setq funob (c1funob (car args))) + (setq info (copy-info (cadr funob))) + (list name info funob car-p (c1args (cdr args) info)) + ) + +(defun c2mapcar (funob car-p args &aux (*vs* *vs*) (*inline-blocks* 0)) + (let ((label (next-label*)) + (value-loc (list 'VS (vs-push))) + (handy (list 'CVAR (next-cvar))) + (handies (mapcar #'(lambda (x) (declare (ignore x)) + (list 'CVAR (next-cvar))) + args)) + save + ) + (setq save (save-funob funob)) +; (setq args (inline-args args +; (make-list (length args) :initial-element t))) + (setq args (push-changed-vars + (inline-args args (make-list (length args) + :initial-element t)) + funob)) + (wt-nl "{object " handy ";") + (dolist** (loc handies) + (wt-nl "object " loc "= " (car args) ";") + (pop args)) + (cond (*safe-compile* + (wt-nl "if(endp(" (car handies) ")") + (dolist** (loc (cdr handies)) (wt "||endp(" loc ")")) + (wt "){")) + (t + (wt-nl "if(" (car handies) "==Cnil") + (dolist** (loc (cdr handies)) (wt "||" loc "==Cnil")) + (wt "){"))) + (unwind-exit nil 'jump) + (wt "}") + (wt-nl value-loc "=" handy "=MMcons(Cnil,Cnil);") + (wt-label label) + (let* ((*value-to-go* (list 'CAR (cadr handy))) + (*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*))) + (c2funcall funob + (if car-p + (mapcar + #'(lambda (loc) + (list 'LOCATION *info* (list 'CAR (cadr loc)))) + handies) + (mapcar #'(lambda (loc) (list 'LOCATION *info* loc)) + handies)) + save) + (wt-label *exit*)) + (cond (*safe-compile* + (wt-nl (car handies) "=MMcdr(" (car handies) ");") + (dolist** (loc (cdr handies)) + (wt-nl loc "=MMcdr(" loc ");")) + (wt-nl "if(endp(" (car handies) ")") + (dolist** (loc (cdr handies)) + (wt "||endp(" loc ")")) + (wt "){")) + (t + (wt-nl "if((" (car handies) "=MMcdr(" (car handies) "))==Cnil") + (dolist** (loc (cdr handies)) + (wt "||(" loc "=MMcdr(" loc "))==Cnil")) + (wt "){"))) + (unwind-exit value-loc 'jump) + (wt "}") + (wt-nl handy "=MMcdr(" handy ")=MMcons(Cnil,Cnil);") + (wt-nl) (wt-go label) + (wt "}") + (close-inline-blocks) + ) + ) + +(defun c2mapc (funob car-p args &aux (*vs* *vs*) (*inline-blocks* 0)) + (let ((label (next-label*)) + value-loc + (handies (mapcar #'(lambda (x) (declare (ignore x)) + (list 'CVAR (next-cvar))) + args)) + save + ) + (setq save (save-funob funob)) +; (setq args (inline-args args +; (make-list (length args) :initial-element t))) + (setq args (push-changed-vars + (inline-args args (make-list (length args) + :initial-element t)) + funob)) + (setq value-loc (car args)) + (wt-nl "{") + (dolist** (loc handies) + (wt-nl "object " loc "= " (car args) ";") + (pop args)) + (cond (*safe-compile* + (wt-nl "if(endp(" (car handies) ")") + (dolist** (loc (cdr handies)) (wt "||endp(" loc ")")) + (wt "){")) + (t + (wt-nl "if(" (car handies) "==Cnil") + (dolist** (loc (cdr handies)) (wt "||" loc "==Cnil")) + (wt "){"))) + (unwind-exit nil 'jump) + (wt "}") + (wt-label label) + (let* ((*value-to-go* 'trash) + (*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*))) + (c2funcall funob + (if car-p + (mapcar + #'(lambda (loc) + (list 'LOCATION *info* (list 'CAR (cadr loc)))) + handies) + (mapcar #'(lambda (loc) (list 'LOCATION *info* loc)) + handies)) + save) + (wt-label *exit*)) + (cond (*safe-compile* + (wt-nl (car handies) "=MMcdr(" (car handies) ");") + (dolist** (loc (cdr handies)) + (wt-nl loc "=MMcdr(" loc ");")) + (wt-nl "if(endp(" (car handies) ")") + (dolist** (loc (cdr handies)) + (wt "||endp(" loc ")")) + (wt "){")) + (t + (wt-nl "if((" (car handies) "=MMcdr(" (car handies) "))==Cnil") + (dolist** (loc (cdr handies)) + (wt "||(" loc "=MMcdr(" loc "))==Cnil")) + (wt "){"))) + (unwind-exit value-loc 'jump) + (wt "}") + (wt-nl) (wt-go label) + (wt "}") + (close-inline-blocks) + ) + ) + +(defun c2mapcan (funob car-p args &aux (*vs* *vs*) (*inline-blocks* 0)) + (let ((label (next-label*)) + (value-loc (list 'VS (vs-push))) + (handy (list 'CVAR (next-cvar))) + (handies (mapcar #'(lambda (x) (declare (ignore x)) + (list 'CVAR (next-cvar))) + args)) + save + ) + (setq save (save-funob funob)) +; (setq args (inline-args args +; (make-list (length args) :initial-element t))) + (setq args (push-changed-vars + (inline-args args (make-list (length args) + :initial-element t)) + funob)) + (wt-nl "{object " handy ";") + (dolist** (loc handies) + (wt-nl "object " loc "= " (car args) ";") + (pop args)) + (cond (*safe-compile* + (wt-nl "if(endp(" (car handies) ")") + (dolist** (loc (cdr handies)) (wt "||endp(" loc ")")) + (wt "){")) + (t + (wt-nl "if(" (car handies) "==Cnil") + (dolist** (loc (cdr handies)) (wt "||" loc "==Cnil")) + (wt "){"))) + (unwind-exit nil 'jump) + (wt "}") + (wt-nl value-loc "=" handy "=MMcons(Cnil,Cnil);") + (wt-label label) + (let* ((*value-to-go* (list 'cdr (cadr handy))) + (*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*)) + ) + (c2funcall funob + (if car-p + (mapcar + #'(lambda (loc) + (list 'LOCATION *info* (list 'CAR (cadr loc)))) + handies) + (mapcar #'(lambda (loc) (list 'LOCATION *info* loc)) + handies)) + save) + (wt-label *exit*)) + (cond + (*safe-compile* + (wt-nl "{object cdr_" handy "=MMcdr(" handy ");while(!endp(cdr_" handy ")) {cdr_" handy "=MMcdr(cdr_" handy ");" handy "=MMcdr(" handy ");}}") + (wt-nl (car handies) "=MMcdr(" (car handies) ");") + (dolist** (loc (cdr handies)) + (wt-nl loc "=MMcdr(" loc ");")) + (wt-nl "if(endp(" (car handies) ")") + (dolist** (loc (cdr handies)) + (wt "||endp(" loc ")")) + (wt "){")) + (t + (wt-nl "while(MMcdr(" handy ")!=Cnil)" handy "=MMcdr(" handy ");") + (wt-nl "if((" (car handies) "=MMcdr(" (car handies) "))==Cnil") + (dolist** (loc (cdr handies)) + (wt "||(" loc "=MMcdr(" loc "))==Cnil")) + (wt "){"))) + (wt-nl value-loc "=" value-loc "->c.c_cdr;") + (unwind-exit value-loc 'jump) + (wt "}") + (wt-nl) (wt-go label) + (wt "}") + (close-inline-blocks) + ) + ) + + +(defun push-changed-vars (locs funob &aux (locs1 nil) (forms (list funob))) + (dolist (loc locs (reverse locs1)) + (if (and (consp loc) + (eq (car loc) 'VAR) + (args-info-changed-vars (cadr loc) forms)) + (let ((temp (list 'VS (vs-push)))) + (wt-nl temp "= " loc ";") + (push temp locs1)) + (push loc locs1)))) + diff --git a/cmpnew/gcl_cmpmulti.lsp b/cmpnew/gcl_cmpmulti.lsp new file mode 100755 index 0000000..729c759 --- /dev/null +++ b/cmpnew/gcl_cmpmulti.lsp @@ -0,0 +1,253 @@ +;;; CMPMULT Multiple-value-call and Multiple-value-prog1. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'multiple-value-call 'c1multiple-value-call 'c1special) +(si:putprop 'multiple-value-call 'c2multiple-value-call 'c2) +(si:putprop 'multiple-value-prog1 'c1multiple-value-prog1 'c1special) +(si:putprop 'multiple-value-prog1 'c2multiple-value-prog1 'c2) +(si:putprop 'values 'c1values 'c1) +(si:putprop 'values 'c2values 'c2) +(si:putprop 'multiple-value-setq 'c1multiple-value-setq 'c1) +(si:putprop 'multiple-value-setq 'c2multiple-value-setq 'c2) +(si:putprop 'multiple-value-bind 'c1multiple-value-bind 'c1) +(si:putprop 'multiple-value-bind 'c2multiple-value-bind 'c2) + +(defun c1multiple-value-call (args &aux info funob) + (when (endp args) (too-few-args 'multiple-value-call 1 0)) + (cond ((endp (cdr args)) (c1funcall args)) + (t (setq funob (c1funob (car args))) + (setq info (copy-info (cadr funob))) + (setq args (c1args (cdr args) info)) + (list 'multiple-value-call info funob args))) + ) + +(defun c2multiple-value-call (funob forms &aux (*vs* *vs*) loc top sup) + (cond ((endp (cdr forms)) + (setq loc (save-funob funob)) + (let ((*value-to-go* 'top)) (c2expr* (car forms))) + (c2funcall funob 'args-pushed loc)) + (t + (setq top (next-cvar)) + (setq sup (next-cvar)) + (setq loc (save-funob funob)) + (base-used) + ;; Add (sup .var) handling in unwind-exit -- in + ;; c2multiple-value-prog1 and c2-multiple-value-call, apparently + ;; alone, c2expr-top is used to evaluate arguments, presumably to + ;; preserve certain states of the value stack for the purposes of + ;; retrieving the final results. c2exprt-top rebinds sup, and + ;; vs_top in turn to the new sup, causing non-local exits to lose + ;; the true top of the stack vital for subsequent function + ;; evaluations. We unwind this stack supremum variable change here + ;; when necessary. CM 20040301 + (wt-nl "{object *V" top "=base+" *vs* ",*V" sup "=sup;") + (dolist** (form forms) + (let ((*value-to-go* 'top) + (*unwind-exit* (cons (cons 'sup sup) *unwind-exit*))) + (c2expr-top* form top)) + (wt-nl "while(vs_basevs_top) vs_top=vs_base;") + (wt-nl "*vs_top=Cnil;") + (do ((vs vrefs (cdr vs))) + ((endp vs)) + (let ((vref (car vs))) + (set-var 'fun-val (car vref) (cadr vref)) + (unless (endp (cdr vs)) (wt-nl "if(vs_basevs_top) vs_top=vs_base;") + (wt-nl "*vs_top=Cnil;") + (do ((vs vars (cdr vs))) + ((endp vs)) + (c2bind-loc (car vs) '(vs-base 0)) + (unless (endp (cdr vs)) (wt-nl "if (vs_basesm.sm_fp)!=0: 0 )") + (get 'fp-okp 'inline-unsafe)) +(push '((stream) boolean #.(flags set)"((#0)->sm.sm_fp)!=0") + (get 'fp-okp 'inline-unsafe)) + +;;LDB1 + (push '((fixnum fixnum fixnum) fixnum #.(flags) + "((((~(-1 << (#0))) << (#1)) & (#2)) >> (#1))") + (get 'si::ldb1 'inline-always)) + +;;LONG-FLOAT-P + (push '((t) boolean #.(flags)"type_of(#0)==t_longfloat") + (get 'long-float-p 'inline-always)) + +;;COMPLEX-P + (push '((t) boolean #.(flags)"type_of(#0)==t_complex") + (get 'si::complexp 'inline-always)) + +;;SFEOF + (push '((object) boolean #.(flags set)"(gcl_feof((#0)->sm.sm_fp))") + (get 'sfeof 'inline-unsafe)) + + +;;SGETC1 + (push '((object) fixnum #.(flags set rfa) "gcl_getc((#0)->sm.sm_fp)") + (get 'sgetc1 'inline-unsafe)) + +;;SPUTC + (push '((fixnum object) fixnum #.(flags set rfa)"(gcl_putc(#0,(#1)->sm.sm_fp))") + (get 'sputc 'inline-unsafe)) +(push '((character object) fixnum #.(flags set rfa)"(gcl_putc(#0,(#1)->sm.sm_fp))") + (get 'sputc 'inline-unsafe)) + +;;READ-BYTE1 + (push '((t t) t #.(flags ans set)"read_byte1(#0,#1)") + (get 'read-byte1 'inline-unsafe)) + +;;READ-CHAR1 + (push '((t t) t #.(flags ans set)"read_char1(#0,#1)") + (get 'read-char1 'inline-unsafe)) + +;;SHIFT<< + (push '((fixnum fixnum) fixnum #.(flags)"((#0) << (#1))") + (get 'shift<< 'inline-always)) + +;;SHIFT>> + (push '((fixnum fixnum) fixnum #.(flags set rfa)"((#0) >> (- (#1)))") + (get 'shift>> 'inline-always)) + +;;SHORT-FLOAT-P + (push '((t) boolean #.(flags)"type_of(#0)==t_shortfloat") + (get 'short-float-p 'inline-always)) + +;;SIDE-EFFECTS + (push '(nil t #.(flags ans set)"Ct") + (get 'side-effects 'inline-always)) + +;;STACK-CONS + (push '((fixnum t t) t #.(flags) + "(STcons#0.t=t_cons,STcons#0.m=0,STcons#0.c_car=(#1), + STcons#0.c_cdr=SAFE_CDR(#2),(object)&STcons#0)") + (get 'stack-cons 'inline-always)) + +;;SUBLIS1 + (push '((t t t) t #.(flags ans set)SUBLIS1-INLINE) + (get 'sublis1 'inline-always)) + +;;SYMBOL-LENGTH + (push '((t) fixnum #.(flags rfa) + "@0;(type_of(#0)==t_symbol ? (#0)->s.s_fillp :not_a_variable((#0)))") + (get 'symbol-length 'inline-always)) + +;;VECTOR-TYPE + (push '((t fixnum) boolean #.(flags) + "@0;(type_of(#0) == t_vector && (#0)->v.v_elttype == (#1))") + (get 'vector-type 'inline-always)) + +;;SYSTEM:ASET + (push '((t t t) t #.(flags set)"aset1(#0,fixint(#1),#2)") + (get 'system:aset 'inline-always)) +(push '((t fixnum t) t #.(flags set)"aset1(#0,#1,#2)") + (get 'system:aset 'inline-always)) +(push '((t t t) t #.(flags set)"aset1(#0,fix(#1),#2)") + (get 'system:aset 'inline-unsafe)) +(push '((t fixnum t) t #.(flags set)"aset1(#0,#1,#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array character) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array bit) fixnum fixnum) fixnum #.(flags rfa) + "({object _o=(#0);fixnum _i=(#1)+_o->bv.bv_offset;char _c=1<bv.bv_self+(_i>>3);bool _b=(#2);if (_b) *_d|=_c; else *_d&=~_c;_b;})") + (get 'si::aset 'inline-unsafe)) +(push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array signed-short) fixnum fixnum) fixnum #.(flags rfa set)"((short *)(#0)->ust.ust_self)[#1]=(#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array signed-char) fixnum fixnum) fixnum #.(flags rfa set)"((#0)->ust.ust_self)[#1]=(#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array unsigned-short) fixnum fixnum) fixnum #.(flags rfa set) + "((unsigned short *)(#0)->ust.ust_self)[#1]=(#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array unsigned-char) fixnum fixnum) fixnum #.(flags rfa set)"((#0)->ust.ust_self)[#1]=(#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array short-float) fixnum short-float) short-float #.(flags rfa set)"(#0)->sfa.sfa_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) +(push '(((array long-float) fixnum long-float) long-float #.(flags rfa set)"(#0)->lfa.lfa_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) +(push '((t t t t) t #.(flags set) + "@0;aset(#0,fix(#1)*(#0)->a.a_dims[1]+fix(#2),#3)") + (get 'system:aset 'inline-unsafe)) +(push '(((array t) fixnum fixnum t) t #.(flags set) + "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") + (get 'system:aset 'inline-unsafe)) +(push '(((array character) fixnum fixnum character) character + #.(flags rfa set) + "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") + (get 'system:aset 'inline-unsafe)) +(push '(((array fixnum) fixnum fixnum fixnum) fixnum #.(flags set rfa) + "@0;(#0)->fixa.fixa_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") + (get 'system:aset 'inline-unsafe)) +(push '(((array short-float) fixnum fixnum short-float) short-float #.(flags rfa set) + "@0;(#0)->sfa.sfa_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") + (get 'system:aset 'inline-unsafe)) +(push '(((array long-float) fixnum fixnum long-float) long-float #.(flags rfa set) + "@0;(#0)->lfa.lfa_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") + (get 'system:aset 'inline-unsafe)) + +;;SYSTEM:CHAR-SET + (push '((t t t) t #.(flags set)"elt_set(#0,fixint(#1),#2)") + (get 'system:char-set 'inline-always)) +(push '((t fixnum t) t #.(flags set)"elt_set(#0,#1,#2)") + (get 'system:char-set 'inline-always)) +(push '((t t t) t #.(flags set) + "@2;((#0)->ust.ust_self[fix(#1)]=char_code(#2),(#2))") + (get 'system:char-set 'inline-unsafe)) +(push '((t fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)") + (get 'system:char-set 'inline-unsafe)) + +;;SYSTEM:ELT-SET + (push '((t t t) t #.(flags set)"elt_set(#0,fixint(#1),#2)") + (get 'system:elt-set 'inline-always)) +(push '((t fixnum t) t #.(flags set)"elt_set(#0,#1,#2)") + (get 'system:elt-set 'inline-always)) +(push '((t t t) t #.(flags set)"elt_set(#0,fix(#1),#2)") + (get 'system:elt-set 'inline-unsafe)) +(push '((t fixnum t) t #.(flags set)"elt_set(#0,#1,#2)") + (get 'system:elt-set 'inline-unsafe)) + +;;SYSTEM:FILL-POINTER-SET + (push '((t fixnum) fixnum #.(flags rfa set)"((#0)->st.st_fillp)=(#1)") + (get 'system:fill-pointer-set 'inline-unsafe)) + +;;SYSTEM:FIXNUMP + (push '((t) boolean #.(flags)"type_of(#0)==t_fixnum") + (get 'system:fixnump 'inline-always)) +(push '((fixnum) boolean #.(flags)"1") + (get 'system:fixnump 'inline-always)) + +;;SYSTEM:HASH-SET +(push '((t t t) t #.(flags rfa) "@2;(sethash(#0,#1,#2),#2)") (get 'si::hash-set 'inline-unsafe)) +(push '((t t t) t #.(flags rfa) "@2;(sethash_with_check(#0,#1,#2),#2)") (get 'si::hash-set 'inline-always)) + +;;SYSTEM:MV-REF + (push '((fixnum) t #.(flags ans set)"(MVloc[(#0)])") + (get 'system:mv-ref 'inline-always)) + +;;SYSTEM:PUTPROP + (push '((t t t) t #.(flags set)"putprop(#0,#1,#2)") + (get 'system:putprop 'inline-always)) + +;;SYSTEM:SCHAR-SET + (push '((t t t) t #.(flags set)"elt_set(#0,fixint(#1),#2)") + (get 'system:schar-set 'inline-always)) +(push '((t fixnum t) t #.(flags set)"elt_set(#0,#1,#2)") + (get 'system:schar-set 'inline-always)) +(push '((t t t) t #.(flags set) + "@2;((#0)->ust.ust_self[fix(#1)]=char_code(#2),(#2))") + (get 'system:schar-set 'inline-unsafe)) +(push '((t fixnum character) character #.(flags set rfa)"(#0)->ust.ust_self[#1]= (#2)") + (get 'system:schar-set 'inline-unsafe)) + +;;SYSTEM:SET-MV + (push '((fixnum t) t #.(flags ans set)"(MVloc[(#0)]=(#1))") + (get 'system:set-mv 'inline-always)) + +;;SYSTEM:SPUTPROP + (push '((t t t) t #.(flags set)"sputprop(#0,#1,#2)") + (get 'system:sputprop 'inline-always)) + +;;SYSTEM:STRUCTURE-DEF + (push '((t) t #.(flags)"(#0)->str.str_def") + (get 'system:structure-def 'inline-unsafe)) + +;;SYSTEM:STRUCTURE-LENGTH + (push '((t) fixnum #.(flags rfa)"S_DATA(#0)->length") + (get 'system:structure-length 'inline-unsafe)) + +;;SYSTEM:STRUCTURE-REF + (push '((t t fixnum) t #.(flags ans)"structure_ref(#0,#1,#2)") + (get 'system:structure-ref 'inline-always)) + +;;SYSTEM:STRUCTURE-SET + (push '((t t fixnum t) t #.(flags set)"structure_set(#0,#1,#2,#3)") + (get 'system:structure-set 'inline-always)) + +;;SYSTEM:STRUCTUREP + (push '((t) boolean #.(flags)"type_of(#0)==t_structure") + (get 'system:structurep 'inline-always)) + +;;SYSTEM:gethash1 + (push '((t t) t #.(flags)"({struct htent *e=gethash(#0,#1);e->hte_key != OBJNULL ? e->hte_value : Cnil;})") + (get 'system:gethash1 'inline-always)) + +;;SYSTEM:SVSET + (push '((t t t) t #.(flags set)"aset1(#0,fixint(#1),#2)") + (get 'system:svset 'inline-always)) +(push '((t fixnum t) t #.(flags set)"aset1(#0,#1,#2)") + (get 'system:svset 'inline-always)) +(push '((t t t) t #.(flags set)"((#0)->v.v_self[fix(#1)]=(#2))") + (get 'system:svset 'inline-unsafe)) +(push '((t fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)") + (get 'system:svset 'inline-unsafe)) + +;;* +(push '((t t) t #.(flags ans) "immnum_times(#0,#1)");"number_times(#0,#1)" + (get '* 'inline-always)) +(push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)*(double)(#1)") + (get '* 'inline-always)) +(push '((fixnum-float fixnum-float) long-float #.(flags)"(double)(#0)*(double)(#1)") + (get '* 'inline-always)) +(push '((long-float long-float) long-float #.(flags rfa)"(double)(#0)*(double)(#1)") + (get '* 'inline-always)) +(push '((short-float short-float) short-float #.(flags rfa)"(#0)*(#1)") + (get '* 'inline-always)) + + +(push '((fixnum fixnum) fixnum #.(flags)"(#0)*(#1)") + (get '* 'inline-always)) + + +;;+ +;; (push '((t t) t #.(flags ans)"number_plus(#0,#1)") +;; (get '+ 'inline-always)) +(push '((t t) t #.(flags ans)"immnum_plus(#0,#1)") (get '+ 'inline-always)) +(push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)+(double)(#1)") + (get '+ 'inline-always)) +(push '((fixnum-float fixnum-float) long-float #.(flags)"(double)(#0)+(double)(#1)") + (get '+ 'inline-always)) +(push '((long-float long-float) long-float #.(flags rfa)"(double)(#0)+(double)(#1)") + (get '+ 'inline-always)) +(push '((short-float short-float) short-float #.(flags rfa)"(#0)+(#1)") + (get '+ 'inline-always)) + + +(push '((fixnum fixnum) fixnum #.(flags)"(#0)+(#1)") + (get '+ 'inline-always)) + + +;;- + ;; (push '((t) t #.(flags ans)"number_negate(#0)") + ;; (get '- 'inline-always)) +(push '((t) t #.(flags ans)"immnum_negate(#0)") (get '- 'inline-always)) +(push '((t t) t #.(flags ans)"immnum_minus(#0,#1)") (get '- 'inline-always)) +;; (push '((t t) t #.(flags ans)"number_minus(#0,#1)") +;; (get '- 'inline-always)) +(push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)-(double)(#1)") + (get '- 'inline-always)) +(push '((fixnum-float) short-float #.(flags)"-(double)(#0)") + (get '- 'inline-always)) +(push '((fixnum-float) long-float #.(flags)"-(double)(#0)") + (get '- 'inline-always)) +(push '((fixnum-float fixnum-float) long-float #.(flags)"(double)(#0)-(double)(#1)") + (get '- 'inline-always)) +(push '((long-float long-float) long-float #.(flags rfa)"(double)(#0)-(double)(#1)") + (get '- 'inline-always)) +(push '((short-float short-float) short-float #.(flags rfa)"(#0)-(#1)") + (get '- 'inline-always)) + + +(push '((fixnum fixnum) fixnum #.(flags)"(#0)-(#1)") + (get '- 'inline-always)) +(push '((fixnum) fixnum #.(flags)"-(#0)") + (get '- 'inline-always)) + + +;;/ +(push '((fixnum fixnum) fixnum #.(flags)"(#0)/(#1)") + (get '/ 'inline-always)) + (push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)/(double)(#1)") + (get '/ 'inline-always)) +(push '((fixnum-float fixnum-float) long-float #.(flags)"(double)(#0)/(double)(#1)") + (get '/ 'inline-always)) +(push '((long-float long-float) long-float #.(flags rfa)"(double)(#0)/(double)(#1)") + (get '/ 'inline-always)) +(push '((short-float short-float) short-float #.(flags rfa)"(#0)/(#1)") + (get '/ 'inline-always)) + +;;/= + (push '((t t) boolean #.(flags rfa)"immnum_ne(#0,#1)") + (get '/= 'inline-always)) + ;; (push '((t t) boolean #.(flags)"number_compare(#0,#1)!=0") + ;; (get '/= 'inline-always)) +(push '((fixnum-float fixnum-float) boolean #.(flags)"(#0)!=(#1)") + (get '/= 'inline-always)) + +;;1+ + ;; (push '((t) t #.(flags ans)"one_plus(#0)") + ;; (get '1+ 'inline-always)) + (push '((t) t #.(flags ans)"immnum_plus(#0,make_fixnum(1))") + (get '1+ 'inline-always)) +(push '((fixnum-float) short-float #.(flags)"(double)(#0)+1") + (get '1+ 'inline-always)) +(push '((fixnum-float) long-float #.(flags)"(double)(#0)+1") + (get '1+ 'inline-always)) +(push '((fixnum) fixnum #.(flags)"(#0)+1") + (get '1+ 'inline-always)) + + +;;1- + ;; (push '((t) t #.(flags ans)"one_minus(#0)") + ;; (get '1- 'inline-always)) + (push '((t) t #.(flags ans)"immnum_plus(#0,make_fixnum(-1))") + (get '1- 'inline-always)) +(push '((fixnum) fixnum #.(flags)"(#0)-1") + (get '1- 'inline-always)) +(push '((fixnum-float) short-float #.(flags)"(double)(#0)-1") + (get '1- 'inline-always)) +(push '((fixnum-float) long-float #.(flags)"(double)(#0)-1") + (get '1- 'inline-always)) + +;;< + (push '((t t) boolean #.(flags rfa)"immnum_lt(#0,#1)") (get '< 'inline-always)) + ;; (push '((t t) boolean #.(flags)"number_compare(#0,#1)<0") + ;; (get '< 'inline-always)) +(push '((fixnum-float fixnum-float) boolean #.(flags)"(#0)<(#1)") + (get '< 'inline-always)) + +;;compiler::objlt + (push '((t t) boolean #.(flags)"((object)(#0))<((object)(#1))") + (get 'si::objlt 'inline-always)) + +;;<= + (push '((t t) boolean #.(flags rfa)"immnum_le(#0,#1)") (get '<= 'inline-always)) + ;; (push '((t t) boolean #.(flags)"number_compare(#0,#1)<=0") + ;; (get '<= 'inline-always)) + +(push '((fixnum-float fixnum-float) boolean #.(flags)"(#0)<=(#1)") + (get '<= 'inline-always)) + +;;= + (push '((t t) boolean #.(flags rfa)"immnum_eq(#0,#1)") (get '= 'inline-always)) + ;; (push '((t t) boolean #.(flags)"number_compare(#0,#1)==0") + ;; (get '= 'inline-always)) + +(push '((fixnum-float fixnum-float) boolean #.(flags)"(#0)==(#1)") + (get '= 'inline-always)) + +;;> + (push '((t t) boolean #.(flags rfa)"immnum_gt(#0,#1)") (get '> 'inline-always)) + ;; (push '((t t) boolean #.(flags)"number_compare(#0,#1)>0") + ;; (get '> 'inline-always)) + +(push '((fixnum-float fixnum-float) boolean #.(flags)"(#0)>(#1)") + (get '> 'inline-always)) + +;;>= + (push '((t t) boolean #.(flags rfa)"immnum_ge(#0,#1)") (get '>= 'inline-always)) + ;; (push '((t t) boolean #.(flags)"number_compare(#0,#1)>=0") + ;; (get '>= 'inline-always)) +(push '((fixnum-float fixnum-float) boolean #.(flags)"(#0)>=(#1)") + (get '>= 'inline-always)) + +;;APPEND + (push '((t t) t #.(flags ans)"append(#0,#1)") + (get 'append 'inline-always)) + +;;AREF +(push '((t t) t #.(flags ans)"fLrow_major_aref(#0,fixint(#1))") + (get 'aref 'inline-always)) +(push '((t fixnum) t #.(flags ans)"fLrow_major_aref(#0,#1)") + (get 'aref 'inline-always)) +(push '((t t) t #.(flags ans)"fLrow_major_aref(#0,fix(#1))") + (get 'aref 'inline-unsafe)) +(push '((t fixnum) t #.(flags ans)"fLrow_major_aref(#0,#1)") + (get 'aref 'inline-unsafe)) +(push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]") + (get 'aref 'inline-unsafe)) +(push '(((array character) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") + (get 'aref 'inline-unsafe)) +(push '(((array bit) fixnum) fixnum #.(flags rfa)"({object _o=(#0);fixnum _i=(#1)+(_o)->bv.bv_offset;(_o->bv.bv_self[_i>>3]>>BIT_ENDIAN(_i&0x7))&0x1;})") + (get 'aref 'inline-unsafe)) +(push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]") + (get 'aref 'inline-unsafe)) +(push '(((array unsigned-char) fixnum) fixnum #.(flags rfa)"(#0)->ust.ust_self[#1]") + (get 'aref 'inline-unsafe)) +(push '(((array signed-char) fixnum) fixnum #.(flags rfa)"SIGNED_CHAR((#0)->ust.ust_self[#1])") + (get 'aref 'inline-unsafe)) +(push '(((array unsigned-short) fixnum) fixnum #.(flags rfa) + "((unsigned short *)(#0)->ust.ust_self)[#1]") + (get 'aref 'inline-unsafe)) +(push '(((array signed-short) fixnum) fixnum #.(flags rfa)"((short *)(#0)->ust.ust_self)[#1]") + (get 'aref 'inline-unsafe)) +(push '(((array short-float) fixnum) short-float #.(flags rfa)"(#0)->sfa.sfa_self[#1]") + (get 'aref 'inline-unsafe)) +(push '(((array long-float) fixnum) long-float #.(flags rfa)"(#0)->lfa.lfa_self[#1]") + (get 'aref 'inline-unsafe)) +;; (push '((t t t) t #.(flags ans) +;; "@0;aref(#0,fix(#1)*(#0)->a.a_dims[1]+fix(#2))") +;; (get 'aref 'inline-unsafe)) +(push '(((array t) fixnum fixnum) t #.(flags ) + "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) +(push '(((array character) fixnum fixnum) character #.(flags rfa) + "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) +(push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa) + "@0;(#0)->fixa.fixa_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) +(push '(((array short-float) fixnum fixnum) short-float #.(flags rfa) + "@0;(#0)->sfa.sfa_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) +(push '(((array long-float) fixnum fixnum) long-float #.(flags rfa) + "@0;(#0)->lfa.lfa_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) + +;;ARRAY-TOTAL-SIZE + (push '((t) fixnum #.(flags rfa)"((#0)->st.st_dim)") + (get 'array-total-size 'inline-unsafe)) + +;;ARRAYP +;; (push '((t) boolean #.(flags) +;; "@0;type_of(#0)==t_array|| +;; type_of(#0)==t_vector|| +;; type_of(#0)==t_string|| +;; type_of(#0)==t_bitvector") +;; (get 'arrayp 'inline-always)) + +;;ATOM + (push '((t) boolean #.(flags)"atom(#0)") + (get 'atom 'inline-always)) + +;;BIT-VECTOR-P + (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") + (get 'bit-vector-p 'inline-always)) + +;;BIT-VECTOR-P + (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") + (get 'bit-vector-p 'inline-always)) + +;;HASH-TABLE-P + (push '((t) boolean #.(flags)"(type_of(#0)==t_hashtable)") + (get 'hash-table-p 'inline-always)) + +;;RANDOM-STATE-P + (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") + (get 'random-state-p 'inline-always)) + +;;RANDOM-STATE-P + (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") + (get 'random-state-p 'inline-always)) + +;;PACKAGEP + (push '((t) boolean #.(flags)"(type_of(#0)==t_package)") + (get 'packagep 'inline-always)) + +;;STREAMP + (push '((t) boolean #.(flags)"(type_of(#0)==t_stream)") + (get 'streamp 'inline-always)) + +;;READTABLEP + (push '((t) boolean #.(flags)"(type_of(#0)==t_readtable)") + (get 'readtablep 'inline-always)) + +;;COMPOUND PREDICATES +(dolist (l '(integerp rationalp floatp realp numberp vectorp arrayp compiled-function-p)) + (push + `((t) boolean #.(flags) ,(substitute #\_ #\- (concatenate 'string (string-downcase l) "(#0)"))) + (get l 'inline-always))) + + +;;BOUNDP + (push '((t) boolean #.(flags)"(#0)->s.s_dbind!=OBJNULL") + (get 'boundp 'inline-unsafe)) + +;;CAAAAR + (push '((t) t #.(flags)"caaaar(#0)") + (get 'caaaar 'inline-safe)) +(push '((t) t #.(flags)"CMPcaaaar(#0)") + (get 'caaaar 'inline-unsafe)) + +;;CAAADR + (push '((t) t #.(flags)"caaadr(#0)") + (get 'caaadr 'inline-safe)) +(push '((t) t #.(flags)"CMPcaaadr(#0)") + (get 'caaadr 'inline-unsafe)) + +;;CAAAR + (push '((t) t #.(flags)"caaar(#0)") + (get 'caaar 'inline-safe)) +(push '((t) t #.(flags)"CMPcaaar(#0)") + (get 'caaar 'inline-unsafe)) + +;;CAADAR + (push '((t) t #.(flags)"caadar(#0)") + (get 'caadar 'inline-safe)) +(push '((t) t #.(flags)"CMPcaadar(#0)") + (get 'caadar 'inline-unsafe)) + +;;CAADDR + (push '((t) t #.(flags)"caaddr(#0)") + (get 'caaddr 'inline-safe)) +(push '((t) t #.(flags)"CMPcaaddr(#0)") + (get 'caaddr 'inline-unsafe)) + +;;CAADR + (push '((t) t #.(flags)"caadr(#0)") + (get 'caadr 'inline-safe)) +(push '((t) t #.(flags)"CMPcaadr(#0)") + (get 'caadr 'inline-unsafe)) + +;;CAAR + (push '((t) t #.(flags)"caar(#0)") + (get 'caar 'inline-safe)) +(push '((t) t #.(flags)"CMPcaar(#0)") + (get 'caar 'inline-unsafe)) + +;;CADAAR + (push '((t) t #.(flags)"cadaar(#0)") + (get 'cadaar 'inline-safe)) +(push '((t) t #.(flags)"CMPcadaar(#0)") + (get 'cadaar 'inline-unsafe)) + +;;CADADR + (push '((t) t #.(flags)"cadadr(#0)") + (get 'cadadr 'inline-safe)) +(push '((t) t #.(flags)"CMPcadadr(#0)") + (get 'cadadr 'inline-unsafe)) + +;;CADAR + (push '((t) t #.(flags)"cadar(#0)") + (get 'cadar 'inline-safe)) +(push '((t) t #.(flags)"CMPcadar(#0)") + (get 'cadar 'inline-unsafe)) + +;;CADDAR + (push '((t) t #.(flags)"caddar(#0)") + (get 'caddar 'inline-safe)) +(push '((t) t #.(flags)"CMPcaddar(#0)") + (get 'caddar 'inline-unsafe)) + +;;CADDDR + (push '((t) t #.(flags)"cadddr(#0)") + (get 'cadddr 'inline-safe)) +(push '((t) t #.(flags)"CMPcadddr(#0)") + (get 'cadddr 'inline-unsafe)) + +;;CADDR + (push '((t) t #.(flags)"caddr(#0)") + (get 'caddr 'inline-safe)) +(push '((t) t #.(flags)"CMPcaddr(#0)") + (get 'caddr 'inline-unsafe)) + +;;CADR + (push '((t) t #.(flags)"cadr(#0)") + (get 'cadr 'inline-safe)) +(push '((t) t #.(flags)"CMPcadr(#0)") + (get 'cadr 'inline-unsafe)) + +;;CAR + (push '((t) t #.(flags)"car(#0)") + (get 'car 'inline-safe)) +(push '((t) t #.(flags)"CMPcar(#0)") + (get 'car 'inline-unsafe)) + +;;CDAAAR + (push '((t) t #.(flags)"cdaaar(#0)") + (get 'cdaaar 'inline-safe)) +(push '((t) t #.(flags)"CMPcdaaar(#0)") + (get 'cdaaar 'inline-unsafe)) + +;;CDAADR + (push '((t) t #.(flags)"cdaadr(#0)") + (get 'cdaadr 'inline-safe)) +(push '((t) t #.(flags)"CMPcdaadr(#0)") + (get 'cdaadr 'inline-unsafe)) + +;;CDAAR + (push '((t) t #.(flags)"cdaar(#0)") + (get 'cdaar 'inline-safe)) +(push '((t) t #.(flags)"CMPcdaar(#0)") + (get 'cdaar 'inline-unsafe)) + +;;CDADAR + (push '((t) t #.(flags)"cdadar(#0)") + (get 'cdadar 'inline-safe)) +(push '((t) t #.(flags)"CMPcdadar(#0)") + (get 'cdadar 'inline-unsafe)) + +;;CDADDR + (push '((t) t #.(flags)"cdaddr(#0)") + (get 'cdaddr 'inline-safe)) +(push '((t) t #.(flags)"CMPcdaddr(#0)") + (get 'cdaddr 'inline-unsafe)) + +;;CDADR + (push '((t) t #.(flags)"cdadr(#0)") + (get 'cdadr 'inline-safe)) +(push '((t) t #.(flags)"CMPcdadr(#0)") + (get 'cdadr 'inline-unsafe)) + +;;CDAR + (push '((t) t #.(flags)"cdar(#0)") + (get 'cdar 'inline-safe)) +(push '((t) t #.(flags)"CMPcdar(#0)") + (get 'cdar 'inline-unsafe)) + +;;CDDAAR + (push '((t) t #.(flags)"cddaar(#0)") + (get 'cddaar 'inline-safe)) +(push '((t) t #.(flags)"CMPcddaar(#0)") + (get 'cddaar 'inline-unsafe)) + +;;CDDADR + (push '((t) t #.(flags)"cddadr(#0)") + (get 'cddadr 'inline-safe)) +(push '((t) t #.(flags)"CMPcddadr(#0)") + (get 'cddadr 'inline-unsafe)) + +;;CDDAR + (push '((t) t #.(flags)"cddar(#0)") + (get 'cddar 'inline-safe)) +(push '((t) t #.(flags)"CMPcddar(#0)") + (get 'cddar 'inline-unsafe)) + +;;CDDDAR + (push '((t) t #.(flags)"cdddar(#0)") + (get 'cdddar 'inline-safe)) +(push '((t) t #.(flags)"CMPcdddar(#0)") + (get 'cdddar 'inline-unsafe)) + +;;CDDDDR + (push '((t) t #.(flags)"cddddr(#0)") + (get 'cddddr 'inline-safe)) +(push '((t) t #.(flags)"CMPcddddr(#0)") + (get 'cddddr 'inline-unsafe)) + +;;CDDDR + (push '((t) t #.(flags)"cdddr(#0)") + (get 'cdddr 'inline-safe)) +(push '((t) t #.(flags)"CMPcdddr(#0)") + (get 'cdddr 'inline-unsafe)) + +;;CDDR + (push '((t) t #.(flags)"cddr(#0)") + (get 'cddr 'inline-safe)) +(push '((t) t #.(flags)"CMPcddr(#0)") + (get 'cddr 'inline-unsafe)) + +;;CDR + (push '((t) t #.(flags)"cdr(#0)") + (get 'cdr 'inline-safe)) +(push '((t) t #.(flags)"CMPcdr(#0)") + (get 'cdr 'inline-unsafe)) + +;;CHAR + (push '((t t) t #.(flags ans)"elt(#0,fixint(#1))") + (get 'char 'inline-always)) +(push '((t fixnum) t #.(flags ans)"elt(#0,#1)") + (get 'char 'inline-always)) +(push '((t t) t #.(flags)"code_char((#0)->ust.ust_self[fix(#1)])") + (get 'char 'inline-unsafe)) +(push '((t fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") + (get 'char 'inline-unsafe)) + +;;CHAR-CODE + (push '((character) fixnum #.(flags rfa)"(#0)") + (get 'char-code 'inline-always)) + +;;CHAR/= + (push '((character character) boolean #.(flags)"(#0)!=(#1)") + (get 'char/= 'inline-always)) +(push '((t t) boolean #.(flags)"!eql(#0,#1)") + (get 'char/= 'inline-unsafe)) +(push '((t t) boolean #.(flags)"char_code(#0)!=char_code(#1)") + (get 'char/= 'inline-unsafe)) + +;;CHAR< + (push '((character character) boolean #.(flags)"(#0)<(#1)") + (get 'char< 'inline-always)) + +;;CHAR<= + (push '((character character) boolean #.(flags)"(#0)<=(#1)") + (get 'char<= 'inline-always)) + +;;CHAR= + (push '((t t) boolean #.(flags)"eql(#0,#1)") + (get 'char= 'inline-unsafe)) +(push '((t t) boolean #.(flags)"char_code(#0)==char_code(#1)") + (get 'char= 'inline-unsafe)) +(push '((character character) boolean #.(flags)"(#0)==(#1)") + (get 'char= 'inline-unsafe)) + +;;CHAR> + (push '((character character) boolean #.(flags)"(#0)>(#1)") + (get 'char> 'inline-always)) + +;;CHAR>= + (push '((character character) boolean #.(flags)"(#0)>=(#1)") + (get 'char>= 'inline-always)) + +;;CHARACTERP + (push '((t) boolean #.(flags)"type_of(#0)==t_character") + (get 'characterp 'inline-always)) + +;;CODE-CHAR + (push '((fixnum) character #.(flags)"(#0)") + (get 'code-char 'inline-always)) + +;;CONS + (push '((t t) t #.(flags ans)"make_cons(#0,#1)") + (get 'cons 'inline-always)) +(push '((t t) :dynamic-extent #.(flags ans)"ON_STACK_CONS(#0,#1)") + (get 'cons 'inline-always)) + +;;CONSP + (push '((t) boolean #.(flags)"consp(#0)") + (get 'consp 'inline-always)) + +;;COS + (push '((long-float) long-float #.(flags rfa)"cos(#0)") + (get 'cos 'inline-always)) + +;;DIGIT-CHAR-P + (push '((character) boolean #.(flags)"@0; ((#0) <= '9' && (#0) >= '0')") + (get 'digit-char-p 'inline-always)) + +;;ELT + (push '((t t) t #.(flags ans)"elt(#0,fixint(#1))") + (get 'elt 'inline-always)) +(push '((t fixnum) t #.(flags ans)"elt(#0,#1)") + (get 'elt 'inline-always)) +(push '((t t) t #.(flags ans)"elt(#0,fix(#1))") + (get 'elt 'inline-unsafe)) +(push '((t fixnum) t #.(flags ans)"elt(#0,#1)") + (get 'elt 'inline-unsafe)) + +;;ENDP +;;Must use endp_prop here as generic lisp code containing (endp +;;can be compiled to take function output as its argument, which +;;cannot be redirected via a macro, e.g. endp(cdr(V20)). CM + (push '((t) boolean #.(flags)"endp_prop(#0)") + (get 'endp 'inline-safe)) +(push '((t) boolean #.(flags)"(#0)==Cnil") + (get 'endp 'inline-unsafe)) + +;;EQ + (push '((t t) boolean #.(flags rfa)"(#0)==(#1)") + (get 'eq 'inline-always)) +(push '((fixnum fixnum) boolean #.(flags rfa)"0") + (get 'eq 'inline-always)) + +;;EQL + (push '((t t) boolean #.(flags rfa)"eql(#0,#1)") + (get 'eql 'inline-always)) +(push '((fixnum fixnum) boolean #.(flags rfa)"(#0)==(#1)") + (get 'eql 'inline-always)) +(push '((character character) boolean #.(flags rfa)"(#0)==(#1)") + (get 'eql 'inline-always)) + + +;;EQUAL + (push '((t t) boolean #.(flags rfa)"equal(#0,#1)") + (get 'equal 'inline-always)) +(push '((fixnum fixnum) boolean #.(flags rfa)"(#0)==(#1)") + (get 'equal 'inline-always)) + +;;EQUALP + (push '((t t) boolean #.(flags rfa)"equalp(#0,#1)") + (get 'equalp 'inline-always)) +(push '((fixnum fixnum) boolean #.(flags rfa)"(#0)==(#1)") + (get 'equalp 'inline-always)) + +;;EXPT + (push '((t t) t #.(flags ans)"number_expt(#0,#1)") + (get 'expt 'inline-always)) + +(push '((fixnum fixnum) fixnum #.(flags)(LAMBDA (LOC1 LOC2) + (IF + (AND (CONSP LOC1) + (EQ (CAR LOC1) 'FIXNUM-LOC) + (CONSP (CADR LOC1)) + (EQ (CAADR LOC1) + 'FIXNUM-VALUE) + (EQUAL (CADDR (CADR LOC1)) + 2)) + (WT "(1<<(" LOC2 "))") + (WT "fixnum_expt(" LOC1 #\, + LOC2 #\))))) + (get 'expt 'inline-always)) + + +;;FILL-POINTER + (push '((t) fixnum #.(flags rfa)"((#0)->st.st_fillp)") + (get 'fill-pointer 'inline-unsafe)) + +;;FIRST + (push '((t) t #.(flags)"car(#0)") + (get 'first 'inline-safe)) +(push '((t) t #.(flags)"CMPcar(#0)") + (get 'first 'inline-unsafe)) + +;;FLOAT + (push '((fixnum-float) long-float #.(flags)"((longfloat)(#0))") + (get 'float 'inline-always)) +(push '((fixnum-float) short-float #.(flags)"((shortfloat)(#0))") + (get 'float 'inline-always)) + +;;FLOATP + ;; (push '((t) boolean #.(flags) + ;; "@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat") + ;; (get 'floatp 'inline-always)) + +;;CEILING +(push '((t t) t #.(compiler::flags) "immnum_ceiling(#0,#1)") (get 'ceiling 'compiler::inline-always)) + +;;FLOOR +; (push '((fixnum fixnum) fixnum #.(flags rfa) +; "@01;(#0>=0&&(#1)>0?(#0)/(#1):ifloor(#0,#1))") +; (get 'floor 'inline-always)) +(push '((t t) t #.(compiler::flags) "immnum_floor(#0,#1)") (get 'floor 'compiler::inline-always)) +(push '((fixnum fixnum) fixnum #.(flags rfa) + "@01;({fixnum _t=(#0)/(#1);((#1)<0 && (#0)<=0) || ((#1)>0 && (#0)>=0) || ((#1)*_t == (#0)) ? _t : _t - 1;})") + (get 'floor 'inline-always)) + +;;FOURTH + (push '((t) t #.(flags)"cadddr(#0)") + (get 'fourth 'inline-safe)) +(push '((t) t #.(flags)"CMPcadddr(#0)") + (get 'fourth 'inline-unsafe)) + +;;GET + (push '((t t t) t #.(flags)"get(#0,#1,#2)") + (get 'get 'inline-always)) +(push '((t t) t #.(flags)"get(#0,#1,Cnil)") + (get 'get 'inline-always)) + +;;INTEGERP + ;; (push '((t) boolean #.(flags) + ;; "@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum") + ;; (get 'integerp 'inline-always)) +(push '((fixnum) boolean #.(flags) + "1") + (get 'integerp 'inline-always)) + + +;;KEYWORDP + (push '((t) boolean #.(flags) + "@0;(type_of(#0)==t_symbol&&(#0)->s.s_hpack==keyword_package)") + (get 'keywordp 'inline-always)) + +;;ADDRESS + (push '((t) fixnum #.(flags rfa)"((fixnum)(#0))") + (get 'si::address 'inline-always)) + +;;NANI + (push '((fixnum) t #.(flags rfa)"((object)(#0))") + (get 'si::nani 'inline-always)) + + +;;LENGTH + (push '((t) fixnum #.(flags rfa)"length(#0)") + (get 'length 'inline-always)) +(push '(((array t)) fixnum #.(flags rfa)"(#0)->v.v_fillp") + (get 'length 'inline-unsafe)) +(push '(((array fixnum)) fixnum #.(flags rfa)"(#0)->v.v_fillp") + (get 'length 'inline-unsafe)) +(push '((string) fixnum #.(flags rfa)"(#0)->v.v_fillp") + (get 'length 'inline-unsafe)) + +;;LIST + (push '(nil t #.(flags)"Cnil") + (get 'list 'inline-always)) +(push '((t) t #.(flags ans)"make_cons(#0,Cnil)") + (get 'list 'inline-always)) +(push '((t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t t t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t t t t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t t t t t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) +(push '((t t t t t t t t t t) t #.(flags ans)LIST-INLINE) + (get 'list 'inline-always)) + +;;LIST* + (push '((t) t #.(flags)"(#0)") + (get 'list* 'inline-always)) +(push '((t t) t #.(flags ans)"make_cons(#0,#1)") + (get 'list* 'inline-always)) +(push '((t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) +(push '((t t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) +(push '((t t t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) +(push '((t t t t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) +(push '((t t t t t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) +(push '((t t t t t t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) +(push '((t t t t t t t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) +(push '((t t t t t t t t t t) t #.(flags ans)LIST*-INLINE) + (get 'list* 'inline-always)) + +;;LISTP + (push '((t) boolean #.(flags)"listp(#0)") + (get 'listp 'inline-always)) + +;;si::spice-p + (push '((t) boolean #.(flags)"@0;type_of(#0)==t_spice") + (get 'si::spice-p 'inline-always)) + +;;LOGNAND +(push '((t t) t #.(compiler::flags) "immnum_nand(#0,#1)") (get 'lognand 'compiler::inline-always)) +;;LOGNOR +(push '((t t) t #.(compiler::flags) "immnum_nor(#0,#1)") (get 'lognor 'compiler::inline-always)) +;;LOGEQV +(push '((t t) t #.(compiler::flags) "immnum_eqv(#0,#1)") (get 'logeqv 'compiler::inline-always)) + +;;LOGANDC1 +(push '((t t) t #.(compiler::flags) "immnum_andc1(#0,#1)") (get 'logandc1 'compiler::inline-always)) +;;LOGANDC2 +(push '((t t) t #.(compiler::flags) "immnum_andc2(#0,#1)") (get 'logandc2 'compiler::inline-always)) +;;LOGORC1 +(push '((t t) t #.(compiler::flags) "immnum_orc1(#0,#1)") (get 'logorc1 'compiler::inline-always)) +;;LOGORC1 +(push '((t t) t #.(compiler::flags) "immnum_orc2(#0,#1)") (get 'logorc2 'compiler::inline-always)) + + +;;LOGAND + (push '((t t) t #.(flags)"immnum_and((#0),(#1))") + (get 'logand 'inline-always)) + (push '((fixnum fixnum) fixnum #.(flags rfa)"((#0) & (#1))") + (get 'logand 'inline-always)) + +;;LOGIOR + (push '((t t) t #.(flags)"immnum_ior((#0),(#1))") + (get 'logior 'inline-always)) + (push '((fixnum fixnum) fixnum #.(flags rfa)"((#0) | (#1))") + (get 'logior 'inline-always)) + +;;LOGXOR + (push '((t t) t #.(flags)"immnum_xor((#0),(#1))") + (get 'logxor 'inline-always)) + (push '((fixnum fixnum) fixnum #.(flags rfa)"((#0) ^ (#1))") + (get 'logxor 'inline-always)) + +;;LOGNOT + (push '((t) t #.(flags)"immnum_not(#0)") + (get 'lognot 'inline-always)) + (push '((fixnum) fixnum #.(flags rfa)"(~(#0))") + (get 'lognot 'inline-always)) + +;;MAKE-LIST + (push '((fixnum) :dynamic-extent #.(flags ans) + "@0;(ALLOCA_CONS(#0),ON_STACK_MAKE_LIST(#0))") + (get 'make-list 'inline-always)) + +;;MAX + (push '((t t) t #.(flags) "immnum_max(#0,#1)");"@01;(number_compare(#0,#1)>=0?(#0):#1)" + (get 'max 'inline-always)) +(push '((fixnum fixnum) fixnum #.(flags rfa)"@01;((#0)>=(#1)?(#0):#1)") + (get 'max 'inline-always)) + +;;MIN + (push '((t t) t #.(flags) "immnum_min(#0,#1)");"@01;(number_compare(#0,#1)<=0?(#0):#1)" + (get 'min 'inline-always)) +(push '((fixnum fixnum) fixnum #.(flags rfa)"@01;((#0)<=(#1)?(#0):#1)") + (get 'min 'inline-always)) + +;;LDB +(push '((t t) t #.(compiler::flags) "immnum_ldb(#0,#1)") (get 'ldb 'compiler::inline-always)) +;;LDB-TEST +(push '((t t) boolean #.(compiler::flags) "immnum_ldbt(#0,#1)") (get 'ldb-test 'compiler::inline-always)) +;;LOGTEST +(push '((t t) boolean #.(compiler::flags) "immnum_logt(#0,#1)") (get 'logtest 'compiler::inline-always)) +;;DPB +(push '((t t t) t #.(compiler::flags) "immnum_dpb(#0,#1,#2)") (get 'dpb 'compiler::inline-always)) +;;DEPOSIT-FIELD +(push '((t t t) t #.(compiler::flags) "immnum_dpf(#0,#1,#2)") (get 'deposit-field 'compiler::inline-always)) + + +;;MINUSP + (push '((t) boolean #.(flags) "immnum_minusp(#0)");"number_compare(small_fixnum(0),#0)>0" + (get 'minusp 'inline-always)) +(push '((fixnum-float) boolean #.(flags)"(#0)<0") + (get 'minusp 'inline-always)) + +;;MOD +; (push '((fixnum fixnum) fixnum #.(flags rfa)"@01;(#0>=0&&(#1)>0?(#0)%(#1):imod(#0,#1))") +; (get 'mod 'inline-always)) +(push '((t t) t #.(compiler::flags) "immnum_mod(#0,#1)") (get 'mod 'compiler::inline-always)) +(push '((fixnum fixnum) fixnum #.(flags rfa)"@01;({fixnum _t=(#0)%(#1);((#1)<0 && _t<=0) || ((#1)>0 && _t>=0) ? _t : _t + (#1);})") + (get 'mod 'inline-always)) + +;;NCONC + (push '((t t) t #.(flags set)"nconc(#0,#1)") + (get 'nconc 'inline-always)) + +;;NOT + (push '((t) boolean #.(flags)"(#0)==Cnil") + (get 'not 'inline-always)) + +;;NREVERSE + (push '((t) t #.(flags ans set)"nreverse(#0)") + (get 'nreverse 'inline-always)) + +;;NTH +; (push '((t t) t #.(flags)"nth(fixint(#0),#1)") +; (get 'nth 'inline-always)) +; (push '((fixnum t) t #.(flags)"nth(#0,#1)") +; (get 'nth 'inline-always)) +; (push '((t t) t #.(flags)"nth(fix(#0),#1)") +; (get 'nth 'inline-unsafe)) + +;(push '((fixnum proper-list) proper-list #.(flags rfa)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x->c.c_car;})") +; (get 'nth 'inline-always)) +;(push '(((and (integer 0) (not fixnum)) proper-list) null #.(flags rfa)"Cnil") +; (get 'nth 'inline-always)) +(push '((fixnum t) t #.(flags)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x->c.c_car;})") + (get 'nth 'inline-unsafe)) +;(push '(((not fixnum) proper-list) null #.(flags rfa)"Cnil") +; (get 'nth 'inline-unsafe)) + +;;NTHCDR +; (push '((t t) t #.(flags)"nthcdr(fixint(#0),#1)") +; (get 'nthcdr 'inline-always)) +; (push '((fixnum t) t #.(flags)"nthcdr(#0,#1)") +; (get 'nthcdr 'inline-always)) +; (push '((t t) t #.(flags)"nthcdr(fix(#0),#1)") +; (get 'nthcdr 'inline-unsafe)) + +;(push '((fixnum proper-list) proper-list #.(flags rfa)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x;})") +; (get 'nthcdr 'inline-always)) +;(push '(((and (integer 0) (not fixnum)) proper-list) null #.(flags rfa)"Cnil") +; (get 'nthcdr 'inline-always)) +(push '((fixnum t) t #.(flags)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x;})") + (get 'nthcdr 'inline-unsafe)) +;(push '(((not fixnum) proper-list) null #.(flags rfa)"Cnil") +; (get 'nthcdr 'inline-unsafe)) + + +;;NULL + (push '((t) boolean #.(flags)"(#0)==Cnil") + (get 'null 'inline-always)) + +;;NUMBERP +;; (push '((t) boolean #.(flags) +;; "@0;type_of(#0)==t_fixnum|| +;; type_of(#0)==t_bignum|| +;; type_of(#0)==t_ratio|| +;; type_of(#0)==t_shortfloat|| +;; type_of(#0)==t_longfloat|| +;; type_of(#0)==t_complex") +;; (get 'numberp 'inline-always)) + +;;PLUSP + (push '((t) boolean #.(flags) "immnum_plusp(#0)");"number_compare(small_fixnum(0),#0)<0" + (get 'plusp 'inline-always)) +(push '((fixnum-float) boolean #.(flags)"(#0)>0") + (get 'plusp 'inline-always)) + +;;PRIN1 + (push '((t t) t #.(flags set)"prin1(#0,#1)") + (get 'prin1 'inline-always)) +(push '((t) t #.(flags set)"prin1(#0,Cnil)") + (get 'prin1 'inline-always)) + +;;PRINC + (push '((t t) t #.(flags set)"princ(#0,#1)") + (get 'princ 'inline-always)) +(push '((t) t #.(flags set)"princ(#0,Cnil)") + (get 'princ 'inline-always)) + +;;PRINT + (push '((t t) t #.(flags set)"print(#0,#1)") + (get 'print 'inline-always)) +(push '((t) t #.(flags set)"print(#0,Cnil)") + (get 'print 'inline-always)) + +;;PROBE-FILE + (push '((t) boolean #.(flags)"(file_exists(#0))") + (get 'probe-file 'inline-always)) + +;;RATIOP +(push '((t) boolean #.(flags) "type_of(#0)==t_ratio") + (get 'ratiop 'inline-always)) + +;;REM +(push '((t t) t #.(compiler::flags) "immnum_rem(#0,#1)") (get 'rem 'compiler::inline-always)) +#+TRUNCATE_USE_C +(push '((fixnum fixnum) fixnum #.(flags rfa)"(#0)%(#1)") + (get 'rem 'inline-always)) + + + + +;;REMPROP + (push '((t t) t #.(flags set)"remprop(#0,#1)") + (get 'remprop 'inline-always)) + +;;REST + (push '((t) t #.(flags)"cdr(#0)") + (get 'rest 'inline-safe)) +(push '((t) t #.(flags)"CMPcdr(#0)") + (get 'rest 'inline-unsafe)) + +;;REVERSE + (push '((t) t #.(flags ans)"reverse(#0)") + (get 'reverse 'inline-always)) + +;;SCHAR + (push '((t t) t #.(flags ans)"elt(#0,fixint(#1))") + (get 'schar 'inline-always)) +(push '((t fixnum) t #.(flags ans)"elt(#0,#1)") + (get 'schar 'inline-always)) +(push '((t t) t #.(flags rfa)"code_char((#0)->ust.ust_self[fix(#1)])") + (get 'schar 'inline-unsafe)) +(push '((t fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") + (get 'schar 'inline-unsafe)) + +;;SECOND + (push '((t) t #.(flags)"cadr(#0)") + (get 'second 'inline-safe)) +(push '((t) t #.(flags)"CMPcadr(#0)") + (get 'second 'inline-unsafe)) + +;;SIN + (push '((long-float) long-float #.(flags rfa)"sin(#0)") + (get 'sin 'inline-always)) + +;;STRING + (push '((t) t #.(flags ans)"coerce_to_string(#0)") + (get 'string 'inline-always)) + +;;PATHNAME-DESIGNATORP +(push '((t) boolean #.(flags)"pathname_designatorp(#0)") + (get 'si::pathname-designatorp 'inline-always)) + +;;PATHNAMEP +(push '((t) boolean #.(flags)"type_of(#0)==t_pathname") + (get 'pathnamep 'inline-always)) + +;;STRINGP + (push '((t) boolean #.(flags)"type_of(#0)==t_string") + (get 'stringp 'inline-always)) + +;;SVREF +;; (push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))") +;; (get 'svref 'inline-always)) +;; (push '((t fixnum) t #.(flags ans)"aref1(#0,#1)") +;; (get 'svref 'inline-always)) +(push '((t t) t #.(flags)"(#0)->v.v_self[fix(#1)]") + (get 'svref 'inline-unsafe)) +(push '((t fixnum) t #.(flags)"(#0)->v.v_self[#1]") + (get 'svref 'inline-unsafe)) + +;;SYMBOL-NAME + (push '((t) t #.(flags ans)"symbol_name(#0)") + (get 'symbol-name 'inline-always)) + +;;SYMBOL-PLIST +(push (list '(t) t #.(flags) "((#0)->s.s_plist)") + (get 'symbol-plist 'inline-unsafe)) + +;;SYMBOLP + (push '((t) boolean #.(flags)"type_of(#0)==t_symbol") + (get 'symbolp 'inline-always)) + +;;TAN + (push '((long-float) long-float #.(flags rfa)"tan(#0)") + (get 'tan 'inline-always)) + +;;SQRT + (push '((long-float) long-float #.(flags rfa)"sqrt((double)#0)") + (get 'sqrt 'inline-always)) + +;;TERPRI + (push '((t) t #.(flags set)"terpri(#0)") + (get 'terpri 'inline-always)) +(push '(nil t #.(flags set)"terpri(Cnil)") + (get 'terpri 'inline-always)) + +;;THIRD + (push '((t) t #.(flags)"caddr(#0)") + (get 'third 'inline-safe)) +(push '((t) t #.(flags)"CMPcaddr(#0)") + (get 'third 'inline-unsafe)) + +;;TRUNCATE +(push '((t t) t #.(compiler::flags) "immnum_truncate(#0,#1)") (get 'truncate 'compiler::inline-always)) +#+TRUNCATE_USE_C +(push '((fixnum fixnum) fixnum #.(flags rfa)"(#0)/(#1)") + (get 'truncate 'inline-always)) +(push '((fixnum-float) fixnum #.(flags)"(fixnum)(#0)") + (get 'truncate 'inline-always)) + + + +;;VECTORP +;; (push '((t) boolean #.(flags) +;; "@0;type_of(#0)==t_vector|| +;; type_of(#0)==t_string|| +;; type_of(#0)==t_bitvector") +;; (get 'vectorp 'inline-always)) + +;;WRITE-CHAR + (push '((t) t #.(flags set) + "@0;(writec_stream(char_code(#0),Vstandard_output->s.s_dbind),(#0))") + (get 'write-char 'inline-unsafe)) + +;;EVENP +(push '((t) boolean #.(compiler::flags) "immnum_evenp(#0)") (get 'evenp 'compiler::inline-always)) +;;ODDP +(push '((t) boolean #.(compiler::flags) "immnum_oddp(#0)") (get 'oddp 'compiler::inline-always)) + +;;SIGNUM +(push '((t) t #.(compiler::flags) "immnum_signum(#0)") (get 'signum 'compiler::inline-always)) + + +;;ZEROP + (push '((t) boolean #.(flags) "immnum_zerop(#0)");"number_compare(small_fixnum(0),#0)==0" + (get 'zerop 'inline-always)) + +(push '((fixnum-float) boolean #.(flags)"(#0)==0") + (get 'zerop 'inline-always)) + +;;CMOD + (push '((t) t #.(flags) "cmod(#0)") + (get 'system:cmod 'inline-always)) + +;;CTIMES + (push '((t t) t #.(flags) "ctimes(#0,#1)") + (get 'system:ctimes 'inline-always)) + +;;CPLUS + (push '((t t) t #.(flags) "cplus(#0,#1)") + (get 'system:cplus 'inline-always)) + +;;CDIFFERENCE + (push '((t t) t #.(flags) "cdifference(#0,#1)") + (get 'system:cdifference 'inline-always)) + +;;si::static-inverse-cons +(push '((t) t #.(compiler::flags) "({object _y=(object)fixint(#0);is_imm_fixnum(_y) ? Cnil : (is_imm_fixnum(_y->c.c_cdr) ? _y : (_y->d.f||_y->d.e ? Cnil : _y));})") (get 'si::static-inverse-cons 'compiler::inline-always)) +(push '((fixnum) t #.(compiler::flags) "({object _y=(object)#0;is_imm_fixnum(_y) ? Cnil : (is_imm_fixnum(_y->c.c_cdr) ? _y : (_y->d.f||_y->d.e ? Cnil : _y));})") (get 'si::static-inverse-cons 'compiler::inline-always)) +(push '((t) t #.(compiler::flags) "({object _y=(object)fix(#0);is_imm_fixnum(_y) ? Cnil : (is_imm_fixnum(_y->c.c_cdr) ? _y : (_y->d.f||_y->d.e ? Cnil : _y));})") (get 'si::static-inverse-cons 'compiler::inline-unsafe)) +(push '((fixnum) t #.(compiler::flags) "({object _y=(object)#0;is_imm_fixnum(_y) ? Cnil : (is_imm_fixnum(_y->c.c_cdr) ? _y : (_y->d.f||_y->d.e ? Cnil : _y));})") (get 'si::static-inverse-cons 'compiler::inline-unsafe)) + +;;symbol-value +(push '((t) t #.(compiler::flags) "(#0)->s.s_dbind") + (get 'symbol-value 'compiler::inline-unsafe)) +(push '((t) t #.(compiler::flags) "@0;type_of(#0)!=t_symbol ? (not_a_symbol(#0),Cnil) : ((#0)->s.s_dbind==OBJNULL ? (FEerror(\"unbound variable\",0),Cnil) : (#0)->s.s_dbind)") + (get 'symbol-value 'compiler::inline-always)) +(push '((symbol) t #.(compiler::flags) "@0;(#0)->s.s_dbind==OBJNULL ? (FEerror(\"unbound variable\",0),Cnil) : (#0)->s.s_dbind") + (get 'symbol-value 'compiler::inline-always)) + +;;acons +(push '((t t t) t #.(compiler::flags) "MMcons(MMcons((#0),(#1)),(#2))") + (get 'acons 'compiler::inline-always)) diff --git a/cmpnew/gcl_cmpspecial.lsp b/cmpnew/gcl_cmpspecial.lsp new file mode 100755 index 0000000..2876ac9 --- /dev/null +++ b/cmpnew/gcl_cmpspecial.lsp @@ -0,0 +1,153 @@ +;;; CMPSPECIAL Miscellaneous special forms. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'quote 'c1quote 'c1special) +(si:putprop 'function 'c1function 'c1special) +(si:putprop 'function 'c2function 'c2) +(si:putprop 'the 'c1the 'c1special) +(si:putprop 'eval-when 'c1eval-when 'c1special) +(si:putprop 'declare 'c1declare 'c1special) +(si:putprop 'compiler-let 'c1compiler-let 'c1special) +(si:putprop 'compiler-let 'c2compiler-let 'c2) + +(defun c1quote (args) + (when (endp args) (too-few-args 'quote 1 0)) + (unless (endp (cdr args)) (too-many-args 'quote 1 (length args))) + (c1constant-value (car args) t) + ) + +(defun c1eval-when (args) + (when (endp args) (too-few-args 'eval-when 1 0)) + (dolist** (situation (car args) (c1nil)) + (case situation + ((eval :execute) (return-from c1eval-when (c1progn (cdr args)))) + ((load :load-toplevel compile :compile-toplevel)) + (otherwise + (cmperr "The situation ~s is illegal." situation)))) + ) + +(defun c1declare (args) + (cmperr "The declaration ~s was found in a bad place." (cons 'declare args)) + ) + +(defun c1the (args &aux info form type) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'the 2 (length args))) + (unless (endp (cddr args)) + (too-many-args 'the 2 (length args))) + (setq form (c1expr (cadr args))) + (setq info (copy-info (cadr form))) + (setq type (type-and (type-filter (car args)) (info-type info))) + (when (null type) + (when (and (type>= 'boolean (type-filter (car args))) + (type>= (type-filter (car args)) 'boolean)) + (return-from c1the (c1the (list 'boolean `(unless (eq nil ,(cadr args)) t))))) + (cmpwarn "Type mismatch was found in ~s." (cons 'the args))) + (setf (info-type info) type) + (list* (car form) info (cddr form)) + ) + +(defun c1compiler-let (args &aux (symbols nil) (values nil)) + (when (endp args) (too-few-args 'compiler-let 1 0)) + (dolist** (spec (car args)) + (cond ((consp spec) + (cmpck (not (and (symbolp (car spec)) + (or (endp (cdr spec)) + (endp (cddr spec))))) + "The variable binding ~s is illegal." spec) + (push (car spec) symbols) + (push (if (endp (cdr spec)) nil (eval (cadr spec))) values)) + ((symbolp spec) + (push spec symbols) + (push nil values)) + (t (cmperr "The variable binding ~s is illegal." spec)))) + (setq symbols (reverse symbols)) + (setq values (reverse values)) + (setq args (progv symbols values (c1progn (cdr args)))) + (list 'compiler-let (cadr args) symbols values args) + ) + +(defun c2compiler-let (symbols values body) + (progv symbols values (c2expr body))) + +(defun c1function (args &aux fd) + (when (endp args) (too-few-args 'function 1 0)) + (unless (endp (cdr args)) (too-many-args 'function 1 (length args))) + (let ((fun (car args))) + (cond ((symbolp fun) + (cond ((and (setq fd (c1local-closure fun)) + (eq (car fd) 'call-local)) + (list 'function *info* fd)) + (t (let ((info (make-info + :sp-change + (null (get fun 'no-sp-change))))) + (list 'function info (list 'call-global info fun)) + )))) + ((and (consp fun) (eq (car fun) 'lambda)) + (cmpck (endp (cdr fun)) + "The lambda expression ~s is illegal." fun) + (let ((*vars* (cons 'cb *vars*)) + (*funs* (cons 'cb *funs*)) + (*blocks* (cons 'cb *blocks*)) + (*tags* (cons 'cb *tags*))) + (setq fun (c1lambda-expr (cdr fun))) + (list 'function (cadr fun) fun))) + (t (cmperr "The function ~s is illegal." fun)))) + ) + +(defun c2function (funob) + (case (car funob) + (call-global + (unwind-exit (list 'symbol-function (add-symbol (caddr funob))))) + (call-local + (if (cadddr funob) + (unwind-exit (list 'ccb-vs (fun-ref-ccb (caddr funob)))) + (unwind-exit (list 'vs* (fun-ref (caddr funob)))))) + (t + ;;; Lambda closure. + (let ((fun (make-fun :name 'closure :cfun (next-cfun)))) + (push (list 'closure (if (null *clink*) nil (cons 'fun-env 0)) + *ccb-vs* fun funob) + *local-funs*) + (push fun *closures*) + (cond (*clink* + (unwind-exit (list 'make-cclosure (fun-cfun fun) *clink* (fun-name fun)))) + (t (unwind-exit (list 'vv (cons 'si::|#,| + `(si::mc nil ,(add-address + (c-function-name "&LC" (fun-cfun fun) (fun-name fun)))))))))) + )) + ) + +(si:putprop 'symbol-function 'wt-symbol-function 'wt-loc) +(si:putprop 'make-cclosure 'wt-make-cclosure 'wt-loc) + +(defun wt-symbol-function (vv) + (if *safe-compile* + (wt "symbol_function(" (vv-str vv) ")") + (wt "(" (vv-str vv) "->s.s_gfdef)"))) + +(defun wt-make-cclosure (cfun clink fname) + (wt-nl "make_cclosure_new(" (c-function-name "LC" cfun fname) ",Cnil,") + (wt-clink clink) + (wt ",Cdata)")) + diff --git a/cmpnew/gcl_cmptag.lsp b/cmpnew/gcl_cmptag.lsp new file mode 100755 index 0000000..a1ea2e0 --- /dev/null +++ b/cmpnew/gcl_cmptag.lsp @@ -0,0 +1,419 @@ +;;; CMPTAG Tagbody and Go. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) +(import 'si::switch) +(import 'si::switch-finish) + + +(si:putprop 'tagbody 'c1tagbody 'c1special) +(si:putprop 'tagbody 'c2tagbody 'c2) + +(si:putprop 'go 'c1go 'c1special) +(si:putprop 'go 'c2go 'c2) + +(defstruct tag + name ;;; Tag name. + ref ;;; Referenced or not. T or NIL. + ref-clb ;;; Cross local function reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the vs-address for the + ;;; tagbody id, or NIL. + ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the vs-address for the + ;;; block id, or NIL. + label ;;; Where to jump. A label. + unwind-exit ;;; Where to unwind-no-exit. + var ;;; The tag-name holder. A VV index. + switch ;;; tag for switch. A fixnum or 'default + ) + +(defvar *tags* nil) + +;;; During Pass 1, *tags* holds a list of tag objects and the symbols 'CB' +;;; (Closure Boundary) and 'LB' (Level Boundary). 'CB' will be pushed on +;;; *tags* when the compiler begins to process a closure. 'LB' will be pushed +;;; on *tags* when *level* is incremented. + + + +(defun jumps-to-p (clause tag-name &aux tem) +;;Does CLAUSE have a go TAG-NAME in it? + (cond ((atom clause)nil) + ((and (eq (car clause) 'go) + (tag-p (setq tem (cadddr (cdr clause)))) + (eq (tag-name tem) tag-name))) + ((eq (car clause) 'location) nil) + (t (or (jumps-to-p (car clause) tag-name) + (jumps-to-p (cdr clause) tag-name))))) + +(defvar *reg-amount* 60) +;;amount to increase var-register for each variable reference in side a loop + +(defun add-reg1 (form) +;;increase the var-register in FORM for all vars + (cond ((atom form) + (cond ((typep form 'var) + (setf (var-register form) + (the fixnum (+ (the fixnum (var-register form)) + (the fixnum *reg-amount*)))) + ))) + (t (add-reg1 (car form)) + (add-reg1 (cdr form))))) + + +(defun add-loop-registers (tagbody) +;;Find a maximal iteration interval in TAGBODY from first to end +;;then increment the var-register slot. + (do ((v tagbody (cdr v)) + (end nil) + (first nil)) + ((null v) + (do ((ww first (cdr ww))) + ((eq ww end)(add-reg1 (car ww))) + (add-reg1 (car ww)))) + (cond ((typep (car v) 'tag) + (or first (setq first v)) + (do ((w (cdr v) (cdr w)) + (name (tag-name (car v)))) + ((null w) ) + (cond ((jumps-to-p (car w) name) + (setq end w)))))))) + +(defun c1tagbody (body &aux (*tags* *tags*) (info (make-info))) + ;;; Establish tags. + (setq body + (mapcar + #'(lambda (x) + (cond ((or (symbolp x) (integerp x)) + (let ((tag (make-tag :name x :ref nil + :ref-ccb nil :ref-clb nil))) + (push tag *tags*) + tag)) + (t x))) + body)) + + ;;; Process non-tag forms. + (setq body (mapcar #'(lambda (x) (if (typep x 'tag) x (c1expr* x info))) + body)) + + ;;; Delete redundant tags. + (do ((l body (cdr l)) + (body1 nil) (ref nil) (ref-clb nil) (ref-ccb nil)) + ((endp l) + (if (or ref-ccb ref-clb ref) + (progn (setq body1 (nreverse body1)) + ;; If ref-ccb is set, we will cons up the environment, hence + ;; all tags which had level boundary references must be changed + ;; to ccb references. FIXME -- review this logic carefully + ;; CM 20040228 + (when ref-ccb + (dolist (l body1) + (when (and (typep l 'tag) (tag-ref-clb l)) + (setf (tag-ref-ccb l) t)))) + (cond ((or ref-clb ref-ccb) + (incf *setjmps*)) + (t + (add-loop-registers body1 ))) + (list 'tagbody info ref-clb ref-ccb body1)) + (list 'progn info (nreverse (cons (c1nil) body1))))) + (declare (object l ref ref-clb ref-ccb)) + (if (typep (car l) 'tag) + (cond ((tag-ref-ccb (car l)) + (push (car l) body1) + (setf (tag-var (car l)) (add-object (tag-name (car l)))) + (setq ref-ccb t)) + ((tag-ref-clb (car l)) + (push (car l) body1) + (setf (tag-var (car l)) (add-object (tag-name (car l)))) + (setq ref-clb t)) + ((tag-ref (car l)) (push (car l) body1) (setq ref t))) + (push (car l) body1)))) + +(defun c2tagbody (ref-clb ref-ccb body) + (cond (ref-ccb (c2tagbody-ccb body)) + (ref-clb (c2tagbody-clb body)) + (t (c2tagbody-local body)))) + +(defun c2tagbody-local (body &aux (label (next-label))) + ;;; Allocate labels. + (dolist** (x body) + (when (typep x 'tag) + (setf (tag-label x) (next-label*)) + (setf (tag-unwind-exit x) label))) + (let ((*unwind-exit* (cons label *unwind-exit*))) + (c2tagbody-body body)) + + ) + +(defun c2tagbody-body (body) + (do ((l body (cdr l)) (written nil)) + ((endp (cdr l)) + (cond (written (unwind-exit nil)) + ((typep (car l) 'tag) + (wt-switch-case (tag-switch (car l))) + (wt-label (tag-label (car l))) + (unwind-exit nil)) + (t (let* ((*exit* (next-label)) + (*unwind-exit* (cons *exit* *unwind-exit*)) + (*value-to-go* 'trash)) + (c2expr (car l)) + (wt-label *exit*)) + (unless (member (caar l) '(go return-from)) (unwind-exit nil))))) + (declare (object l written)) + (cond (written (setq written nil)) + ((typep (car l) 'tag) + (wt-switch-case (tag-switch (car l))) + (wt-label (tag-label (car l)))) + (t (let* ((*exit* (if (typep (cadr l) 'tag) + (progn (setq written t) (tag-label (cadr l))) + (next-label))) + (*unwind-exit* (cons *exit* *unwind-exit*)) + (*value-to-go* 'trash)) + (c2expr (car l)) + (and (typep (cadr l) 'tag) + (wt-switch-case (tag-switch (cadr l)))) + (wt-label *exit*)))))) + +(defun c2tagbody-clb (body &aux (label (next-label)) (*vs* *vs*)) + (let ((*unwind-exit* (cons 'frame *unwind-exit*)) + (ref-clb (vs-push))) + (wt-nl) (wt-vs ref-clb) (wt "=alloc_frame_id();") + (wt-nl "frs_push(FRS_CATCH,") (wt-vs ref-clb) (wt ");") + (wt-nl "if(nlj_active){") + (wt-nl "nlj_active=FALSE;") + ;;; Allocate labels. + (dolist** (tag body) + (when (typep tag 'tag) + (setf (tag-label tag) (next-label*)) + (setf (tag-unwind-exit tag) label) + (when (tag-ref-clb tag) + (setf (tag-ref-clb tag) ref-clb) + (wt-nl "if(eql(nlj_tag," (vv-str (tag-var tag)) ")) {") + (wt-nl " ") + (reset-top) + (wt-nl " ") + (wt-go (tag-label tag)) + (wt-nl "}")))) + (wt-nl "FEerror(\"The GO tag ~s is not established.\",1,nlj_tag);") + (wt-nl "}") + (let ((*unwind-exit* (cons label *unwind-exit*))) + (c2tagbody-body body)))) + +(defun c2tagbody-ccb (body &aux (label (next-label)) + (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) + (let ((*unwind-exit* (cons 'frame *unwind-exit*)) + (ref-clb (vs-push)) ref-ccb) + (wt-nl) (wt-vs ref-clb) (wt "=alloc_frame_id();") + (wt-nl) (wt-vs ref-clb) (wt "=MMcons(") (wt-vs ref-clb) (wt ",") + (wt-clink) (wt ");") + (clink ref-clb) + (setq ref-ccb (ccb-vs-push)) + (wt-nl "frs_push(FRS_CATCH,") (wt-vs* ref-clb) (wt ");") + (wt-nl "if(nlj_active){") + (wt-nl "nlj_active=FALSE;") + ;;; Allocate labels. + (dolist** (tag body) + (when (typep tag 'tag) + (setf (tag-label tag) (next-label*)) + (setf (tag-unwind-exit tag) label) + (when (or (tag-ref-clb tag) (tag-ref-ccb tag)) + (setf (tag-ref-clb tag) ref-clb) + (when (tag-ref-ccb tag) (setf (tag-ref-ccb tag) ref-ccb)) + (wt-nl "if(eql(nlj_tag," (vv-str (tag-var tag)) ")) {") + (wt-nl " ") + (reset-top) + (wt-nl " ") + (wt-go (tag-label tag)) + (wt-nl "}")))) + (wt-nl "FEerror(\"The GO tag ~s is not established.\",1,nlj_tag);") + (wt-nl "}") + (let ((*unwind-exit* (cons label *unwind-exit*))) + (c2tagbody-body body)))) + +(defun c1go (args) + (cond ((endp args) (too-few-args 'go 1 0)) + ((not (endp (cdr args))) (too-many-args 'go 1 (length args))) + ((not (or (symbolp (car args)) (integerp (car args)))) + "The tag name ~s is not a symbol nor an integer." (car args))) + (do ((tags *tags* (cdr tags)) + (name (car args)) + (ccb nil) (clb nil)) + ((endp tags) (cmperr "The tag ~s is undefined." name)) + (declare (object name ccb clb)) + (case (car tags) + (cb (setq ccb t)) + (lb (setq clb t)) + (t (when (eq (tag-name (car tags)) name) + (let ((tag (car tags))) + (cond (ccb (setf (tag-ref-ccb tag) t)) + (clb (setf (tag-ref-clb tag) t)) + (t (setf (tag-ref tag) t))) + (return (list 'go *info* clb ccb tag)))))))) + +(defun c2go (clb ccb tag) + (cond (ccb (c2go-ccb tag)) + (clb (c2go-clb tag)) + (t (c2go-local tag)))) + +(defun c2go-local (tag) + (unwind-no-exit (tag-unwind-exit tag)) + (wt-nl) (wt-go (tag-label tag))) + +(defun c2go-clb (tag) + (wt-nl "vs_base=vs_top;") + (wt-nl "unwind(frs_sch(") + (if (tag-ref-ccb tag) + (wt-vs* (tag-ref-clb tag)) + (wt-vs (tag-ref-clb tag))) + (wt ")," (vv-str (tag-var tag)) ");")) + +(defun c2go-ccb (tag) + (wt-nl "{frame_ptr fr;") + (wt-nl "fr=frs_sch(") (wt-ccb-vs (tag-ref-ccb tag)) (wt ");") + (wt-nl "if(fr==NULL)FEerror(\"The GO tag ~s is missing.\",1," (vv-str (tag-var tag)) ");") + (wt-nl "vs_base=vs_top;") + (wt-nl "unwind(fr," (vv-str (tag-var tag)) ");}")) + + +(defun wt-switch-case (x) + (cond (x (wt-nl (if (typep x 'fixnum) "case " "") x ":")))) + +(defun c1switch(form &aux (*tags* *tags*)) + (let* ((switch-op (car form)) + (body (cdr form)) + (switch-op-1 (c1expr switch-op))) + (cond ((and (typep (second switch-op-1 ) 'info) + (subtypep (info-type (second switch-op-1)) 'fixnum)) + ;;optimize into a C switch: + ;;If we ever get GCC to do switch's with an enum arg, + ;;which don't do bounds checking, then we will + ;;need to carry over the restricted range. + ;;more generally the compiler should carry along the original type + ;;decl, not just the coerced one. This needs another slot in + ;;info. + (or (member t body) (setq body (append body (list t)))) + ;; Remove duplicate tags in C switch statement -- CM 20031112 + (setq body + (let (tags new-body) + (dolist (b body) + (cond ((or (symbolp b) (integerp b)) + (unless (member b tags) + (push b tags) + (push b new-body))) + (t + (push b new-body)))) + (nreverse new-body))) + (setq body + (mapcar + #'(lambda (x) + (cond ((or (symbolp x) (integerp x)) + (let ((tag (make-tag :name x :ref + nil + :ref-ccb nil + :ref-clb nil))) + (cond((typep x 'fixnum) + (setf (tag-ref tag) t) + (setf (tag-switch tag) x)) + ((eq t x) + (setf (tag-ref tag) t) + (setf (tag-switch tag) "default"))) + tag)) + (t x))) + body)) + (let ((tem (c1tagbody + `(,@ body + switch-finish-label)))) + (nconc (list 'switch (cadr tem) switch-op-1) + (cddr tem)) + )) + (t (c1expr (cmp-macroexpand-1 (cons 'switch form))))))) + +(defun c2switch (op ref-clb ref-ccb body &aux (*inline-blocks* 0)(*vs* *vs*)) + (let ((args (inline-args (list op ) '(fixnum )))) + (wt-inline-loc "switch(#0){" args) + (cond (ref-ccb (c2tagbody-ccb body)) + (ref-clb (c2tagbody-clb body)) + (t (c2tagbody-local body))) + (wt "}") + (unwind-exit nil) + (close-inline-blocks))) + + + +;; SWITCH construct for Common Lisp. (TEST &body BODY) (in package SI) + +;; TEST must evaluate to something of INTEGER TYPE. If test matches one +;; of the labels (ie integers) in the body of switch, control will jump +;; to that point. It is an error to have two or more constants which are +;; eql in the the same switch. If none of the constants match the value, +;; then control moves to a label T. If there is no label T, control +;; flows as if the last term in the switch were a T. It is an error +;; however if TEST were declared to be in a given integer range, and at +;; runtime a value outside that range were provided. The value of a +;; switch construct is undefined. If you wish to return a value use a +;; block construct outside the switch and a return-from. `GO' may also +;; be used to jump to labels in the SWITCH. + +;; Control falls through from case to case, just as if the cases were +;; labels in a tagbody. To jump to the end of the switch, use +;; (switch-finish). + +;; The reason for using a new construct rather than building on CASE, is +;; that CASE does not allow the user to use invoke a `GO' if necessary. +;; to switch from one case to another. Also CASE does not allow sharing +;; of parts of code between different cases. They have to be either the +;; same or disjoint. + +;; The SWITCH may be implemented very efficiently using a jump table, if +;; the range of cases is not too much larger than the number of cases. +;; If the range is much larger than the number of cases, a binary +;; splitting of cases might be used. + +;; Sample usage: +;; (defun goo (x) +;; (switch x +;; 1 (princ "x is one, ") +;; 2 (princ "x is one or two, ") +;; (switch-finish) +;; 3 (princ "x is three, ") +;; (switch-finish) +;; t (princ "none"))) + +;; We provide a Common Lisp macro for implementing the above construct: + + +(defmacro switch (test &body body &aux cases) + (dolist (v body) + (cond ((integerp v) (push `(if (eql ,v ,test) (go ,v) nil) cases)))) + `(tagbody + ,@ (nreverse cases) + (go t) + ,@ body + ,@ (if (member t body) nil '(t)) + switch-finish-label )) + +(defmacro switch-finish nil '(go switch-finish-label)) + + +(si::putprop 'switch 'c1switch 'c1special) +(si::putprop 'switch 'c2switch 'c2) diff --git a/cmpnew/gcl_cmptest.lsp b/cmpnew/gcl_cmptest.lsp new file mode 100755 index 0000000..4381364 --- /dev/null +++ b/cmpnew/gcl_cmptest.lsp @@ -0,0 +1,267 @@ +;;; CMPTEST Functions for compiler test. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(defun self-compile () + (with-open-file (log "lsplog" :direction :output) + (let ((*standard-output* (make-broadcast-stream *standard-output* log))) + +; (self-compile2 "cmpbind") +; (self-compile2 "cmpblock") +; (self-compile2 "cmpcall") +; (self-compile2 "cmpcatch") + (self-compile2 "cmpenv") +; (self-compile2 "cmpeval") +; (self-compile2 "cmpflet") +; (self-compile2 "cmpfun") +; (self-compile2 "cmpif") +; (self-compile2 "cmpinline") + (self-compile2 "cmplabel") +; (self-compile2 "cmplam") +; (self-compile2 "cmplet") +; (self-compile2 "cmploc") +; (self-compile2 "cmpmap") +; (self-compile2 "cmpmulti") +; (self-compile2 "cmpspecial") +; (self-compile2 "cmptag") +; (self-compile2 "cmptop") +; (self-compile2 "cmptype") + (self-compile2 "cmputil") +; (self-compile2 "cmpvar") +; (self-compile2 "cmpvs") +; (self-compile2 "cmpwt") + + )) + t) + +(defun setup () + +; (allocate 'cons 800) +; (allocate 'string 256) +; (allocate 'structure 32) +; (allocate-relocatable-pages 128) + +; (load ":udd:common:cmpnew:cmpinline.lsp") + (load ":udd:common:cmpnew:cmputil.lsp") +; (load ":udd:common:cmpnew:cmptype.lsp") + +; (load ":udd:common:cmpnew:cmpbind.lsp") +; (load ":udd:common:cmpnew:cmpblock.lsp") + (load ":udd:common:cmpnew:cmpcall.lsp") +; (load ":udd:common:cmpnew:cmpcatch.lsp") +; (load ":udd:common:cmpnew:cmpenv.lsp") +; (load ":udd:common:cmpnew:cmpeval.lsp") + (load ":udd:common:cmpnew:cmpflet.lsp") +; (load ":udd:common:cmpnew:cmpfun.lsp") +; (load ":udd:common:cmpnew:cmpif.lsp") + (load ":udd:common:cmpnew:cmplabel.lsp") +; (load ":udd:common:cmpnew:cmplam.lsp") +; (load ":udd:common:cmpnew:cmplet.lsp") + (load ":udd:common:cmpnew:cmploc.lsp") +; (load ":udd:common:cmpnew:cmpmain.lsp") +; (load ":udd:common:cmpnew:cmpmap.lsp") +; (load ":udd:common:cmpnew:cmpmulti.lsp") +; (load ":udd:common:cmpnew:cmpspecial.lsp") +; (load ":udd:common:cmpnew:cmptag.lsp") + (load ":udd:common:cmpnew:cmptop.lsp") +; (load ":udd:common:cmpnew:cmpvar.lsp") +; (load ":udd:common:cmpnew:cmpvs.lsp") +; (load ":udd:common:cmpnew:cmpwt.lsp") + +; (load ":udd:common:cmpnew:lfun_list") +; (load ":udd:common:cmpnew:cmpopt.lsp") + + ) + +(defun cli () (process ":cli.pr")) + +(defun load-fasl () + + (load "cmpinline") + (load "cmputil") + (load "cmpbind") + (load "cmpblock") + (load "cmpcall") + (load "cmpcatch") + (load "cmpenv") + (load "cmpeval") + (load "cmpflet") + (load "cmpfun") + (load "cmpif") + (load "cmplabel") + (load "cmplam") + (load "cmplet") + (load "cmploc") + (load "cmpmap") + (load "cmpmulti") + (load "cmpspecial") + (load "cmptag") + (load "cmptop") + (load "cmptype") + (load "cmpvar") + (load "cmpvs") + (load "cmpwt") + + (load "cmpmain.lsp") + (load "lfun_list.lsp") + (load "cmpopt.lsp") + + ) + +(setq *macroexpand-hook* 'funcall) + +(defun self-compile1 (file) + (prin1 file) (terpri) + (compile-file1 file + :fasl-file t :c-file t :h-file t :data-file t :ob-file t :system-p t)) + +(defun self-compile2 (file) + (prin1 file) (terpri) + (compile-file1 file + :fasl-file t :c-file t :h-file t :data-file t :ob-file t :system-p t) + (prin1 (load file)) (terpri)) + +(defvar *previous-form* nil) + +(defun cmp (form) + (setq *previous-form* form) + (again)) + +(defun again () + (init-env) + (print *previous-form*) + (terpri) + (setq *compiler-output1* *standard-output*) + (setq *compiler-output2* *standard-output*) + (setq *compiler-output-data* *standard-output*) + (let ((prev (get-dispatch-macro-character #\# #\,))) + (set-dispatch-macro-character #\# #\, + 'si:sharp-comma-reader-for-compiler) + (unwind-protect + (t1expr *previous-form*) + (set-dispatch-macro-character #\# #\, prev))) + (catch *cmperr-tag* (ctop-write "test")) + t) + +;(defun make-cmpmain-for-unix () +; (print "unixmain") +; (format t "~&The old value of *FEATURES* is ~s." *features*) +; (let ((*features* '(unix common kcl))) +; (format t "~&The new value of *FEATURES* is ~s." *features*) +; (init-env) +; (compile-file1 "cmpmain.lsp" +; :output-file "unixmain" +; :c-file t +; :h-file t +; :data-file t +; :system-p t +; )) +; (format t "~&The resumed value of *FEATURES* is ~s." *features*) +; ) + +(defun compiler-make-ufun () + (make-ufun '( + "cmpbind.lsp" + "cmpblock.lsp" + "cmpcall.lsp" + "cmpcatch.lsp" + "cmpenv.lsp" + "cmpeval.lsp" + "cmpflet.lsp" + "cmpfun.lsp" + "cmpif.lsp" + "cmpinline.lsp" + "cmplabel.lsp" + "cmplam.lsp" + "cmplet.lsp" + "cmploc.lsp" + "cmpmain.lsp" + "cmpmap.lsp" + "cmpmulti.lsp" + "cmpspecial.lsp" + "cmptag.lsp" + "cmptop.lsp" + "cmptype.lsp" + "cmputil.lsp" + "cmpvar.lsp" + "cmpvs.lsp" + "cmpwt.lsp" + + )) + + t) + +(defun remrem () + (do-symbols (x (find-package 'lisp)) + (remprop x 'inline-always) + (remprop x 'inline-safe) + (remprop x 'inline-unsafe)) + (do-symbols (x (find-package 'system)) + (remprop x 'inline-always) + (remprop x 'inline-safe) + (remprop x 'inline-unsafe))) +(defun ckck () + (do-symbols (x (find-package 'lisp)) + (when (or (get x 'inline-always) + (get x 'inline-safe) + (get x 'inline-unsafe)) + (print x))) + (do-symbols (x (find-package 'si)) + (when (or (get x 'inline-always) + (get x 'inline-safe) + (get x 'inline-unsafe)) + (print x)))) + +(defun make-cmpopt (&aux (eof (cons nil nil))) + (with-open-file (in "cmpopt.db") + (with-open-file (out "cmpopt.lsp" :direction :output) + (print '(in-package 'compiler) out) + (terpri out) (terpri out) + (do ((x (read in nil eof) (read in nil eof))) + ((eq x eof)) + (apply #'(lambda (property return-type side-effectp new-object-p + name arg-types body) + (when (stringp body) + (do ((i 0 (1+ i)) + (l nil) + (l1 nil)) + ((>= i (length body)) + (when l1 + (setq body + (concatenate 'string + "@" + (reverse l1) + ";" + body)))) + (when (char= (aref body i) #\#) + (incf i) + (cond ((member (aref body i) l) + (pushnew (aref body i) l1)) + (t (push (aref body i) l)))))) + (print + `(push '(,arg-types ,return-type ,side-effectp + ,new-object-p ,body) + (get ',name ',property)) + out)) + (cdr x))) + (terpri out)))) + diff --git a/cmpnew/gcl_cmptop.lsp b/cmpnew/gcl_cmptop.lsp new file mode 100755 index 0000000..e020d83 --- /dev/null +++ b/cmpnew/gcl_cmptop.lsp @@ -0,0 +1,1734 @@ +;;; CMPTOP Compiler top-level. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(defvar *objects* (make-hash-table :test 'eq)) +;(defvar *objects* nil) +(defvar *constants* nil) +(defvar *sharp-commas* nil) +(defvar *function-links* nil) +(defvar *c-gc* t) ;if we gc the c stack. +(defvar *c-vars*) ;list of *c-vars* to put at beginning of function. +;;number of address registers available not counting the +;;frame pointer and the stack pointer +;;If sup and base are used, then their are even 2 less +;;To do: If the regs hold data then there are really more available; +(defvar *free-address-registers* 5) +(defvar *free-data-registers* 6) +;;Inside t3defun this collects the list of downward closures defined. +(defvar *downward-closures* nil) + +(defvar *volatile*) +(defvar *setjmps* 0) + +;; Functions may use a block of C stack space. +;; (cs . i) will become Vcs[i]. + +(defvar *cs* 0) + +;; Holds list of local-functions resulting from c1function of +;; a lambda. Is used to eliminate mix of downward and regular closures. +(defvar *local-functions* nil) + + + +;;; *objects* holds ( { object vv-index }* ). +;;; *constants* holds ( { symbol vv-index }* ). +;;; *sharp-commas* holds ( vv-index* ), indicating that the value +;;; of each vv should be turned into an object from a string before +;;; defining the current function during loading process, so that +;;; sharp-comma-macros may be evaluated correctly. +;;; *function-links* ( {symbol vv-index} ) for function symbols needing link + +(defvar *global-funs* nil) + +;;; *global-funs* holds +;;; ( { global-fun-name cfun }* ) + +(defvar *closures* nil) +(defvar *local-funs* nil) + +;;; *closure* holds fun-objects for closures. + + + +(defvar *top-level-forms* nil) + +;;; *top-level-forms* holds ( { top-level-form }* ). +;;; +;;; top-level-form: +;;; ( 'DEFUN' fun-name cfun lambda-expr doc-vv sp) +;;; | ( 'DEFMACRO' macro-name cfun lambda-expr doc-vv sp) +;;; | ( 'ORDINARY' cfun expr) +;;; | ( 'DECLARE' var-name-vv ) +;;; | ( 'DEFVAR' var-name-vv expr doc-vv) +;;; | ( 'CLINES' string ) +;;; | ( 'DEFCFUN' header vs-size body) +;;; | ( 'DEFENTRY' fun-name cfun cvspecs type cfun-name ) +;;; | ( 'SHARP-COMMA' vv ) + +(defvar *reservations* nil) +(defvar *reservation-cmacro* nil) + +;;; *reservations* holds (... ( cmacro . value ) ...). +;;; *reservation-cmacro* holds the cmacro current used as vs reservation. + +(defvar *global-entries* nil) + +;;; *global-entries* holds (... ( fname cfun return-types arg-type ) ...). + +;;; Package operations. + +(si:putprop 'in-package t 'eval-at-compile) +(si:putprop 'si::in-package-internal t 'eval-at-compile) + +;;; Pass 1 top-levels. + +(si:putprop 'eval-when 't1eval-when 't1) +(si:putprop 'progn 't1progn 't1) +(si:putprop 'macrolet 't1macrolet 't1) +(si:putprop 'defun 't1defun 't1) +(si:putprop 'defmacro 't1defmacro 't1) +(si:putprop 'clines 't1clines 't1) +(si:putprop 'defcfun 't1defcfun 't1) +(si:putprop 'defentry 't1defentry 't1) +(si:putprop 'defla 't1defla 't1) + +;;; Top-level macros. + +(si:putprop 'defconstant t 'top-level-macro) +(si:putprop 'defparameter t 'top-level-macro) +(si:putprop 'defstruct t 'top-level-macro) +(si:putprop 'deftype t 'top-level-macro) +(si:putprop 'defsetf t 'top-level-macro) + +;;; Pass 2 initializers. + +(si:putprop 'defun 't2defun 't2) +(si:putprop 'progn 't2progn 't2) +(si:putprop 'declare 't2declare 't2) +(si:putprop 'defentry 't2defentry 't2) +(si:putprop 'si:putprop 't2putprop 't2) + +;;; Pass 2 C function generators. + +(si:putprop 'defun 't3defun 't3) +(si:putprop 'progn 't3progn 't3) +(si:putprop 'ordinary 't3ordinary 't3) +(si:putprop 'sharp-comma 't3sharp-comma 't3) +(si:putprop 'clines 't3clines 't3) +(si:putprop 'defcfun 't3defcfun 't3) +(si:putprop 'defentry 't3defentry 't3) + + +(eval-when (compile eval) +(defmacro lambda-list (lambda-expr) `(caddr ,lambda-expr)) +(defmacro ll-requireds (lambda-list) `(car ,lambda-list)) +(defmacro ll-keywords (lambda-list) `(nth 4 ,lambda-list)) +(defmacro ll-optionals (lambda-list) `(nth 1 ,lambda-list)) +(defmacro ll-keywords-p (lambda-list) `(nth 3 ,lambda-list)) +(defmacro ll-rest (lambda-list) `(nth 2 ,lambda-list)) +(defmacro ll-allow-other-keys (lambda-list) `(nth 5 ,lambda-list)) +(defmacro vargd (min max) `(+ ,min (ash ,max 8))) +(defmacro let-pass3 (binds &body body &aux res) + (let ((usual '((*c-vars* nil) + (*vs* 0) (*max-vs* 0) (*level* 0) (*ccb-vs* 0) (*clink* nil) + (*unwind-exit* (list *exit*)) + (*value-to-go* *exit*) + (*reservation-cmacro* (next-cmacro)) + (*sup-used* nil) + (*restore-avma* nil) + (*base-used* nil) + (*cs* 0) + ))) + (dolist (v binds) + (or (assoc (car v) usual) + (push v usual))) + (do ((v (setq usual (copy-list usual)) (cdr v))) + ((null v)) + (let ((tem (assoc (caar v) binds))) + (if tem (setf (car v) tem)))) + `(let* ,usual ,@body))) +) + + +;; FIXME case does not optimize as well +(defun dash-to-underscore-int (str beg end) + (declare (string str) (fixnum beg end)) + (unless (< beg end) + (return-from dash-to-underscore-int str)) + (let ((ch (aref str beg))) + (declare (character ch)) + (setf (aref str beg) + (cond + ((eql ch #\-) #\_) + ((eql ch #\/) #\_) + ((eql ch #\.) #\_) + ((eql ch #\_) #\_) + ((eql ch #\!) #\E) + ((eql ch #\*) #\A) + (t (if (alphanumericp ch) ch #\$))))) + (dash-to-underscore-int str (1+ beg) end)) + +(defun dash-to-underscore (str) + (declare (string str)) + (let ((new (copy-seq str))) + (dash-to-underscore-int new 0 (length new)))) + + +(defun init-name (p &optional sp) + + (if sp + (let* ((p (truename (merge-pathnames p #p".lsp"))) + (pn (pathname-name p)) + (g (zerop (si::string-match #v"^gcl_" pn)))) + (dash-to-underscore + (namestring + (make-pathname :host (unless g (pathname-host p)) + :device (unless g (pathname-device p)) + :directory (unless g (pathname-directory p)) + :name pn)))) + "code")) + +;; FIXME consider making this a macro +(defun c-function-name (prefix num fname) + #-gprof(declare (ignore fname)) + (si::string-concatenate + (string prefix) + (write-to-string num) + #+gprof(let ((fname (string fname))) + (si::string-concatenate + "__" + (dash-to-underscore fname) + "__" + (if (boundp '*compiler-input*) + (subseq (init-name *compiler-input* t) 4) + ""))))) + +(defun t1expr (form &aux (*current-form* form) (*first-error* t)) + (catch *cmperr-tag* + (when (consp form) + (let ((fun (car form)) (args (cdr form)) fd) + (declare (object fun args)) + (cond + ((symbolp fun) + (cond ((eq fun 'si:|#,|) + (cmperr "Sharp-comma-macro is in a bad place.")) + ((setq fd (get fun 't1)) + (when *compile-print* (print-current-form)) + (funcall fd args)) + ((get fun 'top-level-macro) + (when *compile-print* (print-current-form)) + (t1expr (cmp-macroexpand-1 form))) + ((get fun 'c1) (t1ordinary form)) + ((setq fd (or (macro-function fun) (cadr (assoc fun *funs*)))) + (let ((res + (cmp-expand-macro fd fun (copy-list (cdr form))) + )) + (t1expr res))) + (t (t1ordinary form)) + )) + ((consp fun) (t1ordinary form)) + (t (cmperr "~s is illegal function." fun))) + ))) + ) + +(defun declaration-type (type) + (cond ((equal type "") "void") + ((equal type "long ") "object ") + (t type))) + +(defvar *vaddress-list*) ;; hold addresses of C functions, and other data +(defvar *vind*) ;; index in the VV array where the address is. +(defvar *Inits*) + +(defun t23expr (form prop &aux (def (when (consp form) (get (car form) prop))) + *local-funs* (*first-error* t) *vcs-used*) + (when def + (apply def (cdr form))) + (when (eq prop 't3) + ;;; Local function and closure function definitions. + (block + nil + (loop + (when (endp *local-funs*) (return)) + (let (*vcs-used*) + (apply 't3local-fun (pop *local-funs*))))))) + +(defun ctop-write (name &aux + (*function-links* nil) *c-vars* (*volatile* " VOL ") + *vaddress-list* (*vind* 0) *inits* + *current-form* *vcs-used*) + (declare (special *current-form* *vcs-used*)) + + (setq *top-level-forms* (nreverse *top-level-forms*)) + + ;;; Initialization function. + (wt-nl1 "void init_" name "(){" + #+sgi3d "Init_Links ();" + "do_init((void *)VV);" + "}") + + + ;; write all the inits. + (dolist (*current-form* *top-level-forms*) + (t23expr *current-form* 't2)) + + ;;; C function definitions. + (dolist (*current-form* *top-level-forms*) + (let* ((inits (data-inits))) + (t23expr *current-form* 't3) + (unless (or (eq (data-inits) inits) (eq (cdr (data-inits)) inits)) + (let ((di (data-inits))) + (setf (data-inits) inits) + (add-init (cons 'progn (nreverse (mapcar 'cdr (ldiff di inits))))))))) + + ;;; Global entries for directly called functions. + (dolist* (x *global-entries*) + (setq *vcs-used* nil) + (apply 'wt-global-entry x)) + + ;;; Fastlinks + (dolist* (x *function-links*) + (setq *vcs-used* nil) + (wt-function-link x)) + #+sgi3d + (progn + (wt-nl1 "" "static void Init_Links () {") + (dolist* (x *function-links*) + (let ((num (second x))) + (wt-nl "Lnk" num " = LnkT" num ";"))) + (wt-nl1 "}")) + + ;;; Declarations in h-file. + (dolist* (fun *closures*) (wt-h "static void " (c-function-name "LC" (fun-cfun fun) (fun-name fun)) "();")) + (dolist* (x *reservations*) + (wt-h "#define VM" (car x) " " (cdr x))) + + ;;*next-vv* is the index of the last entry pushed onto the data vector + ;;*vind* is the index of the next constant to be pushed. + ;;make sure enough room in VV to handle *vind* + + ;;reserve a spot for the Cdata which will be swapped for the (si::%init..): + (push-data-incf nil) + + ;Ensure there is enough room to write t + (dotimes (i (- *vind* *next-vv* +1)) + (push-data-incf nil)) + ;; now *next-vv* >= *vind* + + ;; reserve space for the Cdata the cfdata object as the + ;; last entry in the VV vector. + + + (wt-h "static void * VVi[" (+ 1 *next-vv*) "]={") + (wt-h "#define Cdata VV[" *next-vv* "]") + (or *vaddress-list* (wt-h 0)) + (do ((v (nreverse *Vaddress-List*) (cdr v))) + ((null v) (wt-h "};")) + (wt-h "(void *)(" (caar v) (if (cdr v) ")," ")"))) + + (wt-h "#define VV (VVi)") + + + (wt-data-file) + +; (break "f") + (dolist (x *function-links* ) + (let ((num (second x)) + (type (third x)) + (args (fourth x)) + (newtype nil)) + (cond ((eq type 'proclaimed-closure) + (wt-h "static object Lclptr"num";") + (setq newtype "")) + (t + (setq newtype (if type (Rep-type type) "")))) + + (if (and (not (null type)) + (not (eq type 'proclaimed-closure)) + (or args (not (eq t type)))) + (progn + (wt-h "static " (declaration-type newtype) " LnkT" num "(object,...);") + #-sgi3d (wt-h "static " (declaration-type newtype) " (*Lnk" num ")() = (" + (declaration-type newtype) "(*)()) LnkT" num ";") + #+sgi3d (wt-h "static " (declaration-type newtype) " (*Lnk" num ")();")) + (progn + (wt-h "static " (declaration-type newtype) " LnkT" num "();") + #-sgi3d (wt-h "static " (declaration-type newtype) " (*Lnk" num ")() = LnkT" num ";") + #+sgi3d (wt-h "static " (declaration-type newtype) " (*Lnk" num ")();")))))) + + +;; this default will be as close to the the decision of the x3j13 committee +;; as I can make it. Valid values of *eval-when-defaults* are +;; a sublist of '(compile eval load) + +(defvar *eval-when-defaults* nil);:defaults + +(defun maybe-eval (def form) + (when (or def + (intersection '(compile :compile-toplevel) *eval-when-defaults*) + (let ((c (car form))) (when (symbolp c) (get c 'eval-at-compile)))) + (when form + (cmp-eval form)) + t)) + +(defun t1eval-when (args &aux load-flag compile-flag) + (when (endp args) (too-few-args 'eval-when 1 0)) + (dolist (situation (car args)) + (case situation + ((load :load-toplevel) (setq load-flag t)) + ((compile :compile-toplevel) (setq compile-flag t)) + ((eval :execute)) + (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." situation)))) + (let ((*eval-when-defaults* (or *eval-when-defaults* (car args)))) + (cond (load-flag (t1progn (cdr args))) + (compile-flag (cmp-eval (cons 'progn (cdr args))))))) + +(defun t1macrolet(args &aux (*funs* *funs*)) + (dolist (def (car args)) + (push (list (car def) + (caddr (si:defmacro* (car def) (cadr def) (cddr def)))) + *funs*)) + (dolist (form (cdr args)) + (t1expr form))) + +(defvar *compile-ordinaries* nil) + +(defun t1progn (args) + (cond ((equal (car args) ''compile) + (let ((*compile-ordinaries* t)) + (t1progn (cdr args)))) + (t + (let ((f *top-level-forms*)) + (dolist (form args) (t1expr form)) + (setq *top-level-forms* (cons `(progn ,(nreverse (ldiff *top-level-forms* f))) f)))))) + +(defun t3progn (args) + (dolist (arg args) + (t23expr arg 't3))) + +(defun t2progn (args) + (dolist (arg args) + (t23expr arg 't2))) + +;; (defun foo (x) .. -> (defun foo (g102 &aux (x g102)) ... +(defun cmpfix-args (args bind &aux tem (lam (copy-list (second args)))) + (dolist (v bind) + (setq tem (member (car v) lam)) + (and tem + (setf (car tem) (second v)))) + (cond ((setq tem (member '&aux lam)) + (setf (cdr tem) (append bind (cdr tem)))) + (t (setf lam (append lam (cons '&aux bind))))) + (list* (car args) lam (cddr args))) + + + +(defun t1defun (args &aux (setjmps *setjmps*) (defun 'defun) (*sharp-commas* nil)) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'defun 2 (length args))) + (cmpck (not (symbolp (car args))) + "The function name ~s is not a symbol." (car args)) + (unless (macro-function (car args)) (maybe-eval nil (cons 'defun args))) + (tagbody + top + (setq *local-functions* nil) + (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) lambda-expr + (*special-binding* nil) + (cfun (or (get (car args) 'Ufun) (next-cfun))) + (doc nil) (fname (car args))) + (declare (object fname)) + (setq lambda-expr (c1lambda-expr (cdr args) fname)) + (or (eql setjmps *setjmps*) (setf (info-volatile (cadr lambda-expr)) t)) + (check-downward (cadr lambda-expr)) + +;;provide a simple way for the user to declare functions to +;;have fixed args without having to count them, and make mistakes. + (cond ((get fname 'fixed-args) + ;the number of regular args in definition + (let ((n (length (car (lambda-list lambda-expr))))) + (setf (get fname 'fixed-args) n);;for error checking. + (proclaim (list 'function fname + (make-list n :initial-element t) t))))) + + (cond + ((and + (get fname 'proclaimed-function) + ;; check the args: + (let ((lambda-list (lambda-list lambda-expr))bind) + (declare (object lambda-list)) + (and (null (cadr lambda-list)) ;;; no optional + (null (caddr lambda-list)) ;;; no rest + (null (cadddr lambda-list)) ;;; no keyword + (< (length (car lambda-list)) call-arguments-limit) + ;;; less than 10 requireds + ;;; For all required parameters... + (do ((vars (car lambda-list) (cdr vars)) + (types (get fname 'proclaimed-arg-types) (cdr types)) + (problem)) + ((endp vars) + (and (endp types) + (cond (bind (setq args (cmpfix-args args bind)) + (go top)) + (t (not problem))))) + (declare (object vars types)) + (let ((var (car vars))) + (declare (object var)) + (cond ((equal (car types) '*)(return nil))) + (unless + (and + (or (and (or (eq (var-kind var) 'LEXICAL) + (and (eq (var-kind var) + 'special) + (eq (car types) t))) + (not (var-ref-ccb var)) + (not (eq (var-loc var) 'clb))) + (progn (push (list + (var-name var) (gensym)) + bind) + t)) + (type-and (car types) (var-type var)) + (or (member (car types) + '(fixnum character + long-float short-float)) + (eq (var-loc var) 'object) + *c-gc* + (not (is-changed var (cadr lambda-expr))))) + (unless bind + (cmpwarn "Calls to ~a will be VERY SLOW. Recommend not to proclaim. ~%;;The arg caused the problem. ~a" + fname (var-name var))) + (setq problem t)))) + (numberp cfun)))) + ;;whew: it is acceptable. + (push (list fname + (get fname 'proclaimed-arg-types) + (get fname 'proclaimed-return-type) + (flags set ans) + (make-inline-string + cfun (get fname 'proclaimed-arg-types) fname)) + *inline-functions*)) + ((and ;(get fname 'proclaimed-function) + (eq (get fname 'proclaimed-return-type) t)) +; (setq me lambda-list) +; (setq me (lambda-list lambda-expr)) + +; (print args) + )) + ;; variable number of args; + + + + (when (cadddr lambda-expr) + (setq doc (cadddr lambda-expr))) + (add-load-time-sharp-comma) + (push (list defun fname cfun lambda-expr doc *special-binding*) + *top-level-forms*) + (push (cons fname cfun) *global-funs*) + + + ))) + +(defun make-inline-string (cfun args fname) + (if (null args) + (format nil "~d()" (c-function-name "LI" cfun fname)) + (let ((o (make-array 100 :element-type 'character :fill-pointer 0 + :adjustable t ))) + (format o "~d(" (c-function-name "LI" cfun fname)) + (do ((l args (cdr l)) + (n 0 (1+ n))) + ((endp (cdr l)) + (format o "#~d)" n)) + (declare (fixnum n)) + (format o "#~d," n)) + o))) + + + +(defun cs-push (&optional type) + (let ((tem (next-cvar))) + (push (if type (cons type tem) tem) *c-vars*) + tem)) +; For the moment only two types are recognized. +(defun f-type (x) + (if (var-p x) (setq x (var-type x))) + (cond ((and x (subtypep x 'fixnum)) + 1) + (t 0))) + + +(defun proclaimed-argd (args return) + (let ((ans (length args)) + (i 8) + (type (the fixnum (f-type return))) + (begin t)) + (declare (fixnum ans i)) + (loop + (if (not (eql 0 type)) + (setq ans (the fixnum (+ ans + (the fixnum (ash (the fixnum type) + (the (integer 0 30) + i))))))) + (when begin (setq i 10) (setq begin nil)) + (if (null args) (return ans)) + (setq i (the fixnum (+ i 2))) + (setq type (f-type (pop args)))))) + + +(defun wt-if-proclaimed (fname cfun lambda-expr macro-p) + (cond (macro-p (add-init `(si::MM ',fname ,(add-address (c-function-name "LI" cfun fname))))) + ((fast-link-proclaimed-type-p fname) + (cond ((unless (member '* (get fname 'proclaimed-arg-types)) (assoc fname *inline-functions*)) + (add-init `(si::mfsfun ',fname ,(add-address (c-function-name "LI" cfun fname)) + ,(proclaimed-argd (get fname 'proclaimed-arg-types) + (get fname 'proclaimed-return-type) + ) ) + ) + t) + (t + (let ((arg-c (length (car (lambda-list lambda-expr)))) + (arg-p (length (get fname 'proclaimed-arg-types))) + (va (member '* (get fname 'proclaimed-arg-types)))) + (cond (va + (or (>= arg-c) + (- arg-p (length va)) + (cmpwarn "~a needs ~a args. ~a supplied." + fname (- arg-p (length va)) + arg-c))) + + ((not (eql arg-c arg-p)) + (cmpwarn + "~%;; ~a Number of proclaimed args was ~a. ~ + ~%;;Its definition had ~a." fname arg-p arg-c)) + ;((>= arg-c 10.)) ;checked above + ;(cmpwarn " t1defun only likes 10 args ~ + ; ~%for proclaimed functions") + (t (cmpwarn + " ~a is proclaimed but not in *inline-functions* ~ + ~%T1defun could not assure suitability of args for C call" fname + )))) + nil))))) + + +(defun volatile (info) + (if (info-volatile info) "VOL " "")) + +(defun register (var) + (cond ((and (equal *volatile* "") + (>= (the fixnum (var-register var)) + (the fixnum *register-min*))) + "register ") + (t ""))) + +(defun vararg-p (x) + (and (equal (get x 'proclaimed-return-type) t) + (do ((v (get x 'proclaimed-arg-types) (cdr v))) + ((null v) t) + (or (consp v) (return nil)) + (or (eq (car v) t) + (eq (car v) '*) + (return nil))))) + + +(defun maxargs (lambda-list) +; any function can take &allow-other-keys in ANSI lisp + (cond ( +; (or (ll-allow-other-keys lambda-list)(ll-rest lambda-list)) + (or (ll-keywords-p lambda-list) (ll-rest lambda-list)) + 64) + (t (+ (length (car lambda-list)) ;reg + (length (ll-optionals lambda-list)) + (* 2 (length (ll-keywords lambda-list))))))) + + + + +(defun add-address (a) + ;; if need ampersand before function for address + ;; (setq a (string-concatenate "&" a)) + (push (list a) *vaddress-list*) + (prog1 *vind* (incf *vind*))) + +(defun t2defun (fname cfun lambda-expr doc sp &optional macro-p) + (declare (ignore cfun lambda-expr doc sp macro-p)) + (cond ((get fname 'no-global-entry)(return-from t2defun nil))) + (cond ((< *space* 2) + (setf (get fname 'debug-prop) t) + ))) + +(defun si::add-debug (fname x) + (si::putprop fname x 'si::debugger)) + +(defun t3init-fun (fname cfun lambda-expr doc macro-p) + + (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation))) + + (cond ((wt-if-proclaimed fname cfun lambda-expr macro-p)) + ((vararg-p fname) + (let ((keyp (ll-keywords-p (lambda-list lambda-expr)))) +; (wt-h "static object LI" cfun "();") + (if keyp + (add-init `(si::mfvfun-key + ',fname ,(add-address (c-function-name "LI" cfun fname)) + ,(vargd (length (car (lambda-list lambda-expr))) + (maxargs (lambda-list lambda-expr))) + ,(add-address (format nil "&LI~akey" cfun))) + ) + (add-init `(si::mfvfun ',fname ,(add-address (c-function-name "LI" cfun fname)) + ,(vargd (length (car (lambda-list lambda-expr))) + (maxargs (lambda-list lambda-expr)))) + )))) + ((numberp cfun) + (wt-h "static void " (c-function-name "L" cfun fname) "();") + (add-init `(si::mf ',fname ,(add-address (c-function-name "L" cfun fname))))) + (t (wt-h cfun "();") + (add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname))))))) + +(defun t3defun (fname cfun lambda-expr doc sp &optional macro-p &aux inline-info + (*current-form* (list 'defun fname)) + (*volatile* (volatile (second lambda-expr))) + *downward-closures*) + (cond + ((dolist (v *inline-functions*) + (or (si::fixnump (nth 3 v)) + (error "Old style inline")) + (and (eq (car v) fname) + (not (nth 5 v)) ; ie.not 'link-call or 'ifuncall + (return (setq inline-info v)))) + + ;;; Add global entry information. + (unless (or macro-p (fast-link-proclaimed-type-p fname)) + (push (list fname cfun (cadr inline-info) (caddr inline-info)) + *global-entries*)) + + ;;; Local entry + (analyze-regs (cadr lambda-expr) 0) + (t3defun-aux 't3defun-local-entry + (case (caddr inline-info) + (fixnum 'return-fixnum) + (character 'return-character) + (long-float 'return-long-float) + (short-float 'return-short-float) + (otherwise 'return-object)) + fname cfun lambda-expr sp inline-info + )) + ((vararg-p fname) + (analyze-regs (cadr lambda-expr) 0) + (t3defun-aux 't3defun-vararg 'return-object + fname cfun lambda-expr sp)) + (t + (analyze-regs (cadr lambda-expr) 2) + (t3defun-aux 't3defun-normal 'return fname cfun lambda-expr sp))) + + (wt-downward-closure-macro cfun) + + (t3init-fun fname cfun lambda-expr doc macro-p) + + (add-debug-info fname lambda-expr)) + +(defun t3defun-aux (f *exit* &rest lis) + (let-pass3 () (apply f lis))) + +(defun t3defun-local-entry (fname cfun lambda-expr sp inline-info + &aux specials + (requireds (caaddr lambda-expr))) + (do ((vl requireds (cdr vl)) + (types (cadr inline-info) (cdr types))) + ((endp vl)) + (declare (object vl types)) + (cond ((eq (var-kind (car vl)) 'special) + (push (cons (car vl) (var-loc (car vl))) specials)) + (t + (setf (var-kind (car vl)) + (case (car types) + (fixnum 'FIXNUM) + (character 'CHARACTER) + (long-float 'LONG-FLOAT) + (short-float 'SHORT-FLOAT) + (otherwise 'OBJECT)))) + ) + (setf (var-loc (car vl)) (next-cvar))) + (wt-comment "local entry for function " fname) + (wt-h "static " (declaration-type (rep-type (caddr inline-info))) (c-function-name "LI" cfun fname) "();") + (wt-nl1 "static " (declaration-type (rep-type (caddr inline-info))) (c-function-name "LI" cfun fname) "(") + (wt-requireds requireds + (cadr inline-info)) + ;;; Now the body. + (let ((cm *reservation-cmacro*) + (*tail-recursion-info* + (if *do-tail-recursion* (cons fname requireds) nil)) + (*unwind-exit* *unwind-exit*)) + (wt-nl1 "{ ") + (assign-down-vars (cadr lambda-expr) cfun + 't3defun) + (wt " VMB" cm " VMS" cm " VMV" cm) + + (when sp (wt-nl "bds_check;")) + (when *compiler-push-events* (wt-nl "ihs_check;")) + (when *tail-recursion-info* + (push 'tail-recursion-mark *unwind-exit*) + (wt-nl "goto TTL;") (wt-nl1 "TTL:;")) + (dolist + (v specials) + (wt-nl "bds_bind(" (vv-str (cdr v)) ",V" (var-loc (car v)) ");") + (push 'bds-bind *unwind-exit*) + (setf (var-kind (car v)) 'SPECIAL) + (setf (var-loc (car v)) (cdr v))) + (c2expr (caddr (cddr lambda-expr))) + +;;; Use base if defined for lint + (if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) t (wt-nl "base[0]=base[0];")) + +;;; Make sure to return object if necessary + (if (equal "object " (rep-type (caddr inline-info))) (wt-nl "return Cnil;")) + + (wt-nl1 "}") + (wt-V*-macros cm (caddr inline-info)) + )) + + + +(defvar *vararg-use-vs* nil) +(defun set-up-var-cvs (var) + (cond (*vararg-use-vs* + (setf (var-ref var) (vs-push))) +; ((numberp (var-loc var))) + (t (setf (var-ref var) (cvs-push))))) + +(defun t3defun-vararg (fname cfun lambda-expr sp &aux reqs *vararg-use-vs* + block-p labels (deflt t) key-offset + (*inline-blocks* 0) rest-var + (ll (lambda-list lambda-expr)) + (is-var-arg (or (ll-rest ll) + (ll-optionals ll) + (ll-keywords-p ll))) + (first (unless (car ll) is-var-arg))) + (dolist (v (car ll)) + (push (list 'cvar (next-cvar)) reqs)) + + (wt-comment "local entry for function " fname) + + (let ((tmp "")) + (wt-nl1 "static object " (c-function-name "LI" cfun fname) "(") + (when reqs + (do ((v reqs (cdr v))) + ((null v)) + (wt "object " (car v)) + (setq tmp (concatenate 'string tmp "object")) + (or (null (cdr v)) + (progn + (wt ",") + (setq tmp (concatenate 'string tmp ",")))))) + (when is-var-arg + (when first (wt "object first") (setq tmp (concatenate 'string tmp "object"))) + (wt ",...") (setq tmp (concatenate 'string tmp ",..."))) + (wt ")") + (wt-h "static object " (c-function-name "LI" cfun fname) "(" tmp ");")) + + +; (when reqs (wt-nl "object ") +; (wt-list reqs) (wt ";")) +; (if is-var-arg (wt-nl "va_dcl ")) + ;;; Now the body. + + (let ((cm *reservation-cmacro*) + (*tail-recursion-info* + ;; to do: When can we do tail recursion? + ;; Should be able to do the optionals case, where the + ;; optional defaults are constants. But this + ;; is probably not worth it. + (and + *do-tail-recursion* + (not (ll-rest ll)) + (dolist* (var (ll-requireds ll) t) + (when (var-ref-ccb var) (return nil))) + (null (ll-optionals ll)) + (null (ll-keywords ll)) + (cons fname (car ll)))) + (*unwind-exit* *unwind-exit*)) + (wt-nl1 "{ ") + (when is-var-arg (wt-nl "va_list ap;")) + (wt-nl "int narg = VFUN_NARGS;") + + (assign-down-vars (cadr lambda-expr) cfun + 't3defun) + (wt " VMB" cm " VMS" cm " VMV" cm) + + (when sp (wt-nl "bds_check;")) + (when *compiler-push-events* (wt-nl "ihs_check;")) + (or is-var-arg (wt-nl "if ( narg!= " (length reqs) ") vfun_wrong_number_of_args(small_fixnum(" + (length reqs) + "));")) + + (flet ((do-decl (var) + (and (eql (var-loc var) 'clb) (setf *vararg-use-vs* t)) + (let ((kind (c2var-kind var))) + (declare (object kind)) + (when kind + (let ((cvar (next-cvar))) + (setf (var-kind var) kind) + (setf (var-loc var) cvar) + (wt-nl) + (unless block-p (wt "{") (setq block-p t)) + (wt-var-decl var) + ))))) + + (dolist** (var (car ll)) + (do-decl var)) + (dolist** (opt (ll-optionals ll)) + (do-decl (car opt)) + (when (caddr opt) (do-decl (caddr opt)))) + (when (ll-rest ll) (do-decl (ll-rest ll))) + (dolist** (kwd (ll-keywords ll)) + (do-decl (cadr kwd)) + (when (cadddr kwd) (do-decl (cadddr kwd)))) + ) + + ;;; Use Vcs for lint + ; (if *vararg-use-vs* t (progn (wt-nl "Vcs[0]=Vcs[0];"))) + + ;;; start va_list at beginning + (when is-var-arg + (wt-nl "va_start(ap," (if first "first" (car (last reqs))) ");")) + + ;;; Check arguments. + (when (and (or *safe-compile* *compiler-check-args*) (car ll)) + (wt-nl "if(narg <" (length (car ll)) + ") too_few_arguments();")) + + ;;; Allocate the parameters. + (dolist** (var (car ll)) (set-up-var-cvs var)) + (dolist** (opt (ll-optionals ll)) (set-up-var-cvs (car opt))) + + + (when (ll-rest ll) (set-up-var-cvs (ll-rest ll))) + + (setf key-offset (if *vararg-use-vs* *vs* *cs*)) + (dolist** (kwd (ll-keywords ll)) + (set-up-var-cvs (cadr kwd))) + (dolist** (kwd (ll-keywords ll)) + (set-up-var-cvs (cadddr kwd))) + + ;;bind the params: + (do ((v reqs (cdr v)) + (vl (car ll) (cdr vl))) + ((null v)) + (c2bind-loc (car vl) (car v))) + (when (ll-optionals ll) + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (wt-nl "narg = narg - " (length reqs) ";") + (dolist** (opt (ll-optionals ll)) + (push (next-label) labels) + (wt-nl "if (" (if (cdr labels) "--" "") "narg <= 0) ") + (wt-go (car labels)) + (wt-nl "else {" ) + (c2bind-loc (car opt) (if first (list 'first-var-arg) (list 'next-var-arg))) + (setq first nil) + (wt "}") + (when (caddr opt) (c2bind-loc (caddr opt) t)))) + (setq labels (nreverse labels)) + + (let ((label (next-label))) + (wt-nl "--narg; ") + (wt-go label) + + ;;; Bind unspecified optional parameters. + + (dolist** (opt (ll-optionals ll)) + (wt-label (car labels)) + (pop labels) + (c2bind-init (car opt) (cadr opt)) + (when (caddr opt) (c2bind-loc (caddr opt) nil))) + ; (if (or (ll-rest ll)(ll-keywords-p ll))(wt-nl "narg=0;")) + + (wt-label label) + )) + (if (ll-rest ll) + (progn + (setq rest-var (cs-push)) + (cond ((ll-optionals ll)) + (t (wt-nl "narg= narg - " (length (car ll)) ";"))) + (wt-nl "V" rest-var " = ") + + (let ((*rest-on-stack* + (or (eq (var-type (ll-rest ll)) :dynamic-extent) + *rest-on-stack*))) + (if (ll-keywords-p ll) + (cond (*rest-on-stack* + (wt "(ALLOCA_CONS(narg),ON_STACK_MAKE_LIST(narg));")) + (t (wt "make_list(narg);"))) + (cond (*rest-on-stack* + (wt "(ALLOCA_CONS(narg),ON_STACK_LIST_VECTOR_NEW(narg," (if first "first" "OBJNULL") ",ap));" + )) + (t (wt "list_vector_new(narg," (if first "first" "OBJNULL") ",ap);")))) + (c2bind-loc (ll-rest ll) (list 'cvar rest-var))))) + (when (ll-keywords-p ll) + (cond ((ll-rest ll)) + ((ll-optionals ll)) + (t (wt-nl "narg= narg - " (length (car ll)) ";"))) + + (setq deflt (mapcar 'caddr (ll-keywords ll))) + (let ((vkdefaults nil) + (n (length (ll-keywords ll)))) + (do* ((v deflt (cdr v)) + (kwds (ll-keywords ll) (cdr kwds)) + (kwd (car kwds) (car kwds))) + ((null v)) + (unless (and (eq (caar v) 'location) + (eq (third (car v)) nil)) + (setq vkdefaults t)) + (when (or (not (and (eq (caar v) 'location) + (let ((tem (third (car v)))) + (or (eq tem nil) + (and (consp tem) + (member (car tem) + '(vv fixnum-value)) + ))))) + ;; the supplied-p variable is not there + (not (eq (var-kind (cadddr kwd)) 'DUMMY))) + (setf Vkdefaults t) + (setf (car v) 0))) + (if (> (length deflt) 15) (setq vkdefaults t)) + + (wt-nl "{") + (inc-inline-blocks) + (let ((*compiler-output1* *compiler-output2*)) + (when vkdefaults + (terpri *compiler-output2*) + (wt "static object VK" cfun + "defaults[" (length deflt) "]={") + (do ((v deflt(cdr v))(tem)) + ((null v)) + (wt "(void *)") + (cond ((eql (car v) 0) + (wt "-1")) + ;; must be location + ((and (eq (setq tem (third (car v))) nil)) + (wt "-2")) + ((and (consp tem) (eq (car tem) 'vv)) + (wt (add-object2 (add-object (second tem))) )) + ((and (consp tem) (eq (car tem) 'fixnum-value)) +; (print (setq ttem tem)) (break) + (wt (add-object2 (add-object (third tem))) )) + (t (baboon))) + + (if (cdr v) (wt ","))) + (wt "};")) + (terpri *compiler-output2*) + (wt "static struct { short n,allow_other_keys;" + "object *defaults;") + (wt-nl " KEYTYPE keys[" (max n 1) "];") + (wt "} " "LI" cfun "key=") + + (wt "{" (length (ll-keywords ll)) "," + (if (ll-allow-other-keys ll) 1 0) + ",") + (if vkdefaults (wt "VK" cfun "defaults") + (wt "Cstd_key_defaults")) + (when (ll-keywords ll) + (wt ",{") + (do ((v (reverse (ll-keywords ll)) (cdr v))) + ((null v)) + ;; We write this list backwards for convenience + ;; in stepping through it in parse_key + (wt "(void *)") +; (print (setq ss v))(break "h") + (wt (add-object2 (add-symbol (caar v)))) + (if (cdr v) (wt ","))) + (wt "}")) + (wt "};") + ) + (cond ((ll-rest ll) + (wt-nl "parse_key_rest_new(" (list 'cvar rest-var) ",")) + (t (wt-nl "parse_key_new_new("))) + (if (eql 0 *cs*)(setq *cs* 1)) + (wt "narg," (if *vararg-use-vs* "base " (progn (setq *vcs-used* t) "Vcs ")) + "+" key-offset",(struct key *)(void *)&LI" cfun "key," (if first "first" "OBJNULL") ",ap);") + + )) + + + + ;; bind keywords + + (dolist** (kwd (ll-keywords ll)) + (cond ((not (eql 0 (pop deflt))) + ;; keyword default bound by parse_key.. and no supplied-p + (c2bind (cadr kwd))) + (t + (wt-nl "if(") (wt-vs (var-ref (cadr kwd))) (wt "==OBJNULL){") + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (c2bind-init (cadr kwd) (caddr kwd))) + (unless (eq (var-kind (cadddr kwd)) 'DUMMY) (c2bind-loc (cadddr kwd) nil)) + + (wt-nl "}else{") + (c2bind (cadr kwd)) + (unless (eq (var-kind (cadddr kwd)) 'DUMMY) (c2bind-loc (cadddr kwd) + t)) + + (wt "}"))) + + + + ) + + (when *tail-recursion-info* + (push 'tail-recursion-mark *unwind-exit*) + (wt-nl "goto TTL;") (wt-nl1 "TTL:;")) + (c2expr (caddr (cddr lambda-expr))) + + ;;; End va_list at function end + + (when is-var-arg (wt-nl "va_end(ap);")) + +;;; Use base if defined for lint + (if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) t (wt-nl "base[0]=base[0];")) + +;;; Need to ensure return of type object + (wt-nl "return Cnil;") + + (wt "}") + (when block-p (wt-nl "}")) + (close-inline-blocks) + (wt-V*-macros cm (get fname 'proclaimed-return-type)) + )) + +(defun t3defun-normal (fname cfun lambda-expr sp) + (wt-comment "function definition for " fname) + (if (numberp cfun) + (wt-nl1 "static void " (c-function-name "L" cfun fname) "()") + (wt-nl1 cfun "()")) + (wt-nl1 "{" "register object *" *volatile*"base=vs_base;") + (assign-down-vars (cadr lambda-expr) cfun + 't3defun) + (wt-nl + "register object *" *volatile*"sup=base+VM" *reservation-cmacro* ";") + (wt " VC" *reservation-cmacro*) + (if *safe-compile* + (wt-nl "vs_reserve(VM" *reservation-cmacro* ");") + (wt-nl "vs_check;")) + (when sp (wt-nl "bds_check;")) + (when *compiler-push-events* (wt-nl "ihs_check;")) + (c2lambda-expr (lambda-list lambda-expr) (caddr (cddr lambda-expr)) fname) + (wt-nl1 "}") + (push (cons *reservation-cmacro* *max-vs*) *reservations*) + + (wt-h "#define VC" *reservation-cmacro*) + (wt-cvars) + + ) + + +;;Macros for conditionally writing vs_base ..preamble, and for setting +;;up the return. +(defun wt-V*-macros (cm return-type) + (declare (ignore return-type)) + (push (cons cm *max-vs*) *reservations*) + (if (and (zerop *max-vs*) (not *sup-used*) (not *base-used*)) + ;;note if (proclaim '(function foo () t)) + ;;(defun foo () (goo)) ;then *max-vs*=0,*sup-used*=t;--wfs + (wt-h "#define VMB" cm) + (wt-h "#define VMB" cm " " + "register object *" *volatile*"base=vs_top;")) + ;;tack following onto the VMB macro.. + (wt-cvars) + (if *sup-used* + (wt-h "#define VMS" cm + " " " register object *" *volatile*"sup=vs_top+" *max-vs* + ";vs_top=sup;") + (if (zerop *max-vs*) + (wt-h "#define VMS" cm) + (wt-h "#define VMS" cm " vs_top += " *max-vs* ";"))) + (if (zerop *max-vs*) + (wt-h "#define VMV" cm) + (if *safe-compile* + (wt-h "#define VMV" cm " vs_reserve(" *max-vs* ");") + (wt-h "#define VMV" cm " vs_check;"))) + (if (zerop *max-vs*) + (wt-h "#define VMR" cm "(VMT" cm ") return(VMT" cm ");") + (wt-h "#define VMR" cm "(VMT" cm ") vs_top=base ; return(VMT" cm ");")) + ) + +;;Write the required args as c arguments, and declarations for the arguments. +(defun wt-requireds (requireds arg-types) + (do ((vl requireds (cdr vl))) + ((endp vl)) + (declare (object vl)) + (let ((cvar (next-cvar))) + (setf (var-loc (car vl)) cvar) + (wt "V" cvar)) + (unless (endp (cdr vl)) (wt ","))) + (wt ") +") + (when requireds + (wt-nl1) + (do ((vl requireds (cdr vl)) + (types arg-types (cdr types)) + (prev-type nil)) + ((endp vl) (wt ";")) + (declare (object vl)) + + (if prev-type (wt ";")) + + (wt *volatile* (register (car vl)) + (rep-type (car types))) + (setq prev-type (car types)) + (wt "V" (var-loc (car vl)))))) + + +(defun add-debug-info (fname lambda-expr &aux locals) + (cond + ((>= *space* 2)) + ((null (get fname 'debug-prop)) + (warn "~a has a duplicate definition in this file" fname)) + (t + (remprop fname 'debug-prop) + (let ((leng 0)) + (do-referred (va (second lambda-expr)) + (when (and (consp (var-ref va)) + (si::fixnump (cdr (var-ref va)))) + (setq leng (max leng (cdr (var-ref va)))))) + (setq locals (make-list (1+ leng))) + (do-referred (va (second lambda-expr)) + (when (and (consp (var-ref va)) ;always fixnum ? + (si::fixnump (cdr (var-ref va)))) + (setf (nth (cdr (var-ref va)) locals) + (var-name va)))) + (setf (get fname 'si::debugger) locals) + (let ((locals (get fname 'si::debugger))) + (if (and locals (or (cdr locals) (not (null (car locals))))) + (add-init `(debug ',fname ',locals) ) + )) + )))) + + +;;Checks the register slots of variables, and finds which +;;variables should be in registers, zero'ing the register slot +;;in the remaining. Data and address variables are done separately. +(defun analyze-regs (info for-sup-base) + (let ((addr-regs (- *free-address-registers* for-sup-base))) + (cond ((zerop *free-data-registers*) + (analyze-regs1 info addr-regs)) + (t + (let ((addr (make-info)) + (data (make-info))) + (do-referred (v info) + (cond ((member (var-type v) '(FIXNUM CHARACTER SHORT-FLOAT LONG-FLOAT) :test #'eq) + (push-referred v data)) + (t + (push-referred v addr)))) + (analyze-regs1 addr addr-regs) + (analyze-regs1 data *free-data-registers*)))))) + +(defun analyze-regs1 (info want ) + (let ((tem 0)(real-min 3)(this-min 100000)(want want)(have 0)) + (declare (fixnum tem real-min this-min want have)) + (tagbody + START + (do-referred (v info) + (setq tem (var-register v)) + (cond ((>= tem real-min) + (setq have (the fixnum (+ have 1))) + (cond ((< tem this-min ) + (setq this-min tem))) + (cond ((> have want) (go NEXT))) + ))) + (cond ((< have want) (setq real-min (- real-min 1)))) + (do-referred (v info) + (cond ((< (the fixnum (var-register v)) + real-min) + (setf (var-register v) 0)))) + (return-from analyze-regs1 real-min) + NEXT + (setq have 0) + (setq real-min (the fixnum (+ this-min 1))) + (setq this-min 1000000) + (go START) +))) + + + +(defun wt-global-entry (fname cfun arg-types return-type) + (cond ((get fname 'no-global-entry)(return-from wt-global-entry nil))) + (wt-comment "global entry for the function " fname) + (wt-nl1 "static void " (c-function-name "L" cfun fname) "()") + (wt-nl1 "{ register object *base=vs_base;") + (when (or *safe-compile* *compiler-check-args*) + (wt-nl "check_arg(" (length arg-types) ");")) + (wt-nl "base[0]=" (case return-type + (fixnum (if (zerop *space*) + "CMPmake_fixnum" + "make_fixnum")) + (character "code_char") + (long-float "make_longfloat") + (short-float "make_shortfloat") + (otherwise "")) + "(" (c-function-name "LI" cfun fname) "(") + (do ((types arg-types (cdr types)) + (n 0 (1+ n))) + ((endp types)) + (declare (object types) (fixnum n)) + (wt (case (car types) + (fixnum "fix") + (character "char_code") + (long-float "lf") + (short-float "sf") + (otherwise "")) + "(base[" n "])") + (unless (endp (cdr types)) (wt ","))) + (wt "));") + (wt-nl "vs_top=(vs_base=base)+1;") + (wt-nl1 "}") + ) + +(defun rep-type (type) + (case type + (fixnum "long ") + (integer "MP_INT * ") + (character "unsigned char ") + (short-float "float ") + (long-float "double ") + (otherwise "object "))) + +(defun t1defmacro (args &aux (w args)(n (pop args))(l (symbol-plist n)) + (macp (when (listp n) (eq 'macro (car n))))(n (if macp (cdr n) n))) + (proclaim `(ftype (function (t t) t) ,n)) + (maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME? + (t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args)))))) + (setf (symbol-plist n) l) + (nconc (car *top-level-forms*) '(t))) + +(defvar *compiling-ordinary* nil) + +(defun compile-ordinary-p (form) + (when (consp form) + (or (member (car form) '(lambda defun defmacro flet labels)) + (compile-ordinary-p (car form)) + (compile-ordinary-p (cdr form))))) + +(defun t1ordinary (form) + (cond ((unless *compiling-ordinary* + (or *compile-ordinaries* (compile-ordinary-p form))) + (maybe-eval nil form) + (let ((gen (gensym))(*compiling-ordinary* t)) + (proclaim `(function ,gen nil t)) + (t1expr `(progn (defun ,gen nil ,form nil) (,gen))))) + (t + (maybe-eval nil form) + (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) + (*sharp-commas* nil)) + (push (list 'ordinary form) *top-level-forms*) + nil)))) + +(defun t3ordinary (form) + (cond ((atom form)) + ((constantp form)) + (t (add-init form )))) + +(defun add-load-time-sharp-comma () + (dolist* (vv (reverse *sharp-commas*)) + (cond ((atom vv) (wfs-error))) + (push (cons 'sharp-comma vv) *top-level-forms*))) + +(defun t3sharp-comma (vv val) + (add-init `(si::setvv ,vv ,val) )) + +(defun t2declare (vv) vv + (wfs-error)) + +;; Some top level functions which should be eval'd in the :default case +;; for eval-when +(setf (get 'si::*make-special 'eval-at-compile) t) +(setf (get 'si::*make-constant 'eval-at-compile) t) +(setf (get 'proclaim 'eval-at-compile) t) + + +(setf (get 'si::define-structure 't1) 't1define-structure) + +(defun t1define-structure (args) + (maybe-eval t `(si::define-structure ,@(copy-tree args) ,(not (maybe-eval nil nil))));FIXME + (t1ordinary (cons 'si::define-structure args))) + + +(si:putprop 'dbind 'set-dbind 'set-loc) + +(defun set-dbind (loc vv) + (wt-nl (vv-str vv) "->s.s_dbind = " loc ";")) + +(defun t1clines (args) + (dolist** (s args) + (cmpck (not (stringp s)) "The argument to CLINE, ~s, is not a string." s)) + (push (list 'clines args) *top-level-forms*)) + +(defun t3clines (ss) (dolist** (s ss) (wt-nl1 s))) + +(defun t1defcfun (args &aux (body nil)) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'defcfun 2 (length args))) + (cmpck (not (stringp (car args))) + "The first argument to defCfun ~s is not a string." (car args)) + (cmpck (not (numberp (cadr args))) + "The second argument to defCfun ~s is not a number." (cadr args)) + (dolist** (s (cddr args)) + (cond ((stringp s) (push s body)) + ((consp s) + (cond ((symbolp (car s)) + (cmpck (special-operator-p (car s)) + "Special form ~s is not allowed in defCfun." (car s)) + (push (list (cons (car s) (parse-cvspecs (cdr s)))) body)) + ((and (consp (car s)) (symbolp (caar s)) + (not (if (eq (caar s) 'quote) + (or (endp (cdar s)) + (not (endp (cddar s))) + (endp (cdr s)) + (not (endp (cddr s)))) + (special-operator-p (caar s))))) + (push (cons (cons (caar s) + (if (eq (caar s) 'quote) + (list (add-object (cadar s))) + (parse-cvspecs (cdar s)))) + (parse-cvspecs (cdr s))) + body)) + (t (cmperr "The defCfun body ~s is illegal." s)))) + (t (cmperr "The defCfun body ~s is illegal." s)))) + (push (list 'defcfun (car args) (cadr args) (nreverse body)) + *top-level-forms*) + ) + +(defun t3defcfun (header vs-size body &aux fd) + (wt-comment "C function defined by " 'defcfun) + (wt-nl1 header) + (wt-h header ";") + (wt-nl1 "{") + (wt-nl1 "object *vs=vs_top;") + (when (> vs-size 0) (wt-nl1 "object *old_top=vs_top+" vs-size ";")(wt-nl "vs_top=old_top;")) + (wt-nl1 "{") + (dolist** (s body) + (cond ((stringp s) (wt-nl1 s)) + ((eq (caar s) 'quote) + (wt-nl1 (cadadr s)) + (case (caadr s) + (object (wt "=" (vv-str (cadar s)) ";")) + (otherwise + (wt "=object_to_" (string-downcase (symbol-name (caadr s))) + "(" (vv-str (cadar s)) ");")))) + (t (wt-nl1 "{vs_base=vs_top=old_top;") + (dolist** (arg (cdar s)) + (wt-nl1 "vs_push(") + (case (car arg) + (object (wt (cadr arg))) + (char (wt "code_char((long)" (cadr arg) ")")) + (int (when (zerop *space*) (wt "CMP")) + (wt "make_fixnum((long)(" (cadr arg) "))")) + (float (wt "make_shortfloat((double)" (cadr arg) ")")) + (double (wt "make_longfloat((double)" (cadr arg) ")"))) + (wt ");")) + (cond ((setq fd (assoc (caar s) *global-funs*)) + (cond (*compiler-push-events* + (wt-nl1 "ihs_push(" (vv-str (add-symbol (caar s))) ");") + (wt-nl1 (c-function-name "L" (cdr fd) (caar s)) "();") + (wt-nl1 "ihs_pop();")) + (t (wt-nl1 (c-function-name "L" (cdr fd) (caar s)) "();")))) + (*compiler-push-events* + (wt-nl1 "super_funcall(" (vv-str (add-symbol (caar s))) ");")) + (*safe-compile* + (wt-nl1 "super_funcall_no_event(" (vv-str (add-symbol (caar s))) ");")) + (t (wt-nl1 "CMPfuncall(" (vv-str (add-symbol (caar s))) "->s.s_gfdef);")) + ) + (unless (endp (cdr s)) + (wt-nl1 (cadadr s)) + (case (caadr s) + (object (wt "=vs_base[0];")) + (otherwise (wt "=object_to_" + (string-downcase (symbol-name (caadr s))) + "(vs_base[0]);"))) + (dolist** (dest (cddr s)) + (wt-nl1 "vs_base++;") + (wt-nl1 (cadr dest)) + (case (car dest) + (object + (wt "=(vs_base= (type1 type2) + (equal (type-and type1 type2) type2)) + +(defun reset-info-type (info) + (if (info-type info) + (let ((info1 (copy-info info))) + (setf (info-type info1) t) + info1) + info)) + +(defun and-form-type (type form original-form &aux type1) + (setq type1 (type-and type (info-type (cadr form)))) + (when (null type1) + (cmpwarn "The type of the form ~s is not ~s." original-form type)) + (if (eq type1 (info-type (cadr form))) + form + (let ((info (copy-info (cadr form)))) + (setf (info-type info) type1) + (list* (car form) info (cddr form))))) + +(defun check-form-type (type form original-form) + (when (null (type-and type (info-type (cadr form)))) + (cmpwarn "The type of the form ~s is not ~s." original-form type))) + +(defun default-init (type) + (case type + (fixnum (cmpwarn "The default value of NIL is not FIXNUM.")) + (character (cmpwarn "The default value of NIL is not CHARACTER.")) + (long-float (cmpwarn "The default value of NIL is not LONG-FLOAT.")) + (short-float (cmpwarn "The default value of NIL is not SHORT-FLOAT.")) + (integer (cmpwarn "The default value of NIL is not INTEGER")) + + ) + (c1nil)) diff --git a/cmpnew/gcl_cmputil.lsp b/cmpnew/gcl_cmputil.lsp new file mode 100755 index 0000000..33e4640 --- /dev/null +++ b/cmpnew/gcl_cmputil.lsp @@ -0,0 +1,241 @@ +;;; CMPUTIL Miscellaneous Functions. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(export '(*suppress-compiler-warnings* + *suppress-compiler-notes* + *compiler-break-enable*)) + +(defmacro safe-compile (&rest forms) `(when *safe-compile* ,@forms)) + +(defvar *current-form* '|compiler preprocess|) +(defvar *first-error* t) +(defvar *error-count* 0) + +(defconstant *cmperr-tag* (cons nil nil)) + +(defun cmperr (string &rest args &aux (*print-case* :upcase)) + (print-current-form) + (format t "~&;;; ") + (apply #'format t string args) + (incf *error-count*) + (throw *cmperr-tag* '*cmperr-tag*)) + +(defmacro cmpck (condition string &rest args) + `(if ,condition (cmperr ,string ,@args))) + +(defun too-many-args (name upper-bound n &aux (*print-case* :upcase)) + (print-current-form) + (format t + ";;; ~S requires at most ~R argument~:p, ~ + but ~R ~:*~[were~;was~:;were~] supplied.~%" + name + upper-bound + n) + (incf *error-count*) + (throw *cmperr-tag* '*cmperr-tag*)) + +(defun too-few-args (name lower-bound n &aux (*print-case* :upcase)) + (print-current-form) + (format t + ";;; ~S requires at least ~R argument~:p, ~ + but only ~R ~:*~[were~;was~:;were~] supplied.~%" + name + lower-bound + n) + (incf *error-count*) + (throw *cmperr-tag* '*cmperr-tag*)) + +(defvar *suppress-compiler-warnings* nil) + +(defun cmpwarn (string &rest args &aux (*print-case* :upcase)) + (unless *suppress-compiler-warnings* + (print-current-form) + (format t ";; Warning: ") + (apply #'format t string args) + (terpri)) + nil) + +(defvar *suppress-compiler-notes* nil) + +(defun cmpnote (string &rest args &aux (*print-case* :upcase)) + (unless *suppress-compiler-notes* + (terpri) + (format t ";; Note: ") + (apply #'format t string args)) + nil) + +(defun print-current-form () + (when *first-error* + (setq *first-error* nil) + (fresh-line) + (cond + ((and (consp *current-form*) + (eq (car *current-form*) 'si:|#,|)) + (format t "; #,~s is being compiled.~%" (cdr *current-form*))) + (t + (let ((*print-length* 2) + (*print-level* 2)) + (format t "; ~s is being compiled.~%" *current-form*))))) + nil) + +(defun undefined-variable (sym &aux (*print-case* :upcase)) + (print-current-form) + (format t + ";; The variable ~s is undefined.~%~ + ;; The compiler will assume this variable is a global.~%" + sym) + nil) + +(defun baboon (&aux (*print-case* :upcase)) + (print-current-form) + (format t ";;; A bug was found in the compiler. Contact Taiichi.~%") + (incf *error-count*) + (break) +; (throw *cmperr-tag* '*cmperr-tag*) +) + +;;; Internal Macros with type declarations + +(defmacro dolist* ((v l &optional (val nil)) . body) + (let ((temp (gensym))) + `(do* ((,temp ,l (cdr ,temp)) (,v (car ,temp) (car ,temp))) + ((endp ,temp) ,val) + (declare (object ,v)) + ,@body))) + +(defmacro dolist** ((v l &optional (val nil)) . body) + (let ((temp (gensym))) + `(do* ((,temp ,l (cdr ,temp)) (,v (car ,temp) (car ,temp))) + ((endp ,temp) ,val) + (declare (object ,temp ,v)) + ,@body))) + +(defmacro dotimes* ((v n &optional (val nil)) . body) + (let ((temp (gensym))) + `(do* ((,temp ,n) (,v 0 (1+ ,v))) + ((>= ,v ,temp) ,val) + (declare (fixnum ,v)) + ,@body))) + +(defmacro dotimes** ((v n &optional (val nil)) . body) + (let ((temp (gensym))) + `(do* ((,temp ,n) (,v 0 (1+ ,v))) + ((>= ,v ,temp) ,val) + (declare (fixnum ,temp ,v)) + ,@body))) + +(defun cmp-eval (form) + (let ((x (multiple-value-list (cmp-toplevel-eval `(eval ',form))))) + (if (car x) + (let ((*print-case* :upcase)) + (incf *error-count*) + (print-current-form) + (format t + ";;; The form ~s was not evaluated successfully.~%~ + ;;; You are recommended to compile again.~%" + form) + nil) + (values-list (cdr x))))) + + +;(si::putprop 'setf 'c1setf 'c1special) + +;;The PLACE may be a local macro, so we must take care to expand it +;;before trying to call the macro form of setf, or an error will + +;(defun c1setf (args &aux fd) +; (cond ((and +; (consp (car args)) +; (symbolp (caar args)) +; (setq fd (cmp-macro-function (caar args)))) +; (c1expr `(setf ,(cmp-expand-macro fd (caar args) (cdar args)) +; ,@ (cdr args)))) +; (t +; (c1expr (cmp-expand-macro (macro-function 'setf) +; 'setf +; args))))) + +(defun macro-def-p (form &aux (fname (when (consp form) (car form)))) + (when (symbolp fname) + (or (member-if (lambda (x) (when (consp x) (eq (car x) fname))) *funs*) + (macro-function fname)))) + +(defun macro-env (&aux env) + (dolist (v *funs* (when env (list nil (nreverse env) nil))) + (when (consp v) + (push (list (car v) 'macro (cadr v)) env)))) + +(defun cmp-macroexpand (form) + (if (macro-def-p form) + (macroexpand form (macro-env)) + form)) + +(defun cmp-macroexpand-1 (form) + (if (macro-def-p form) + (macroexpand-1 form (macro-env)) + form)) + +(defun cmp-expand-macro (fd fname args &aux (form (cons fname args))) + (if (macro-def-p form) + (let ((env (macro-env))) + (if (eq *macroexpand-hook* 'funcall) + (funcall fd form env) + (funcall *macroexpand-hook* fd form env))) + form)) + +(defvar *compiler-break-enable* nil) + +(defun cmp-toplevel-eval (form) + (let* ((si::*ihs-base* si::*ihs-top*) + (si::*ihs-top* (1- (si::ihs-top))) + (si::*break-enable* *compiler-break-enable*) + (si::*break-hidden-packages* + (cons (find-package 'compiler) + si::*break-hidden-packages*))) + (si:error-set form))) + +(dolist (v '(si::cdefn lfun inline-safe inline-unsafe + inline-always c1conditional c2 c1 c1+ co1 + si::structure-access co1special + top-level-macro t3 t2 t1)) + (si::putprop v t 'compiler-prop )) + +(defun compiler-def-hook (symbol code) symbol code nil) + +(defun compiler-clear-compiler-properties (symbol code) + code + (let ((v (symbol-plist symbol)) w) + (tagbody + top + (setq w (car v)) + (cond ((and (symbolp w) + (get w 'compiler-prop)) + + (setq v (cddr v)) + (remprop symbol w)) + (t (setq v (cddr v)))) + (or (null v) (go top))) + (compiler-def-hook symbol code) + )) + +;hi diff --git a/cmpnew/gcl_cmpvar.lsp b/cmpnew/gcl_cmpvar.lsp new file mode 100755 index 0000000..33b5997 --- /dev/null +++ b/cmpnew/gcl_cmpvar.lsp @@ -0,0 +1,476 @@ +;;; CMPVAR Variables. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'var 'c2var 'c2) +(si:putprop 'location 'c2location 'c2) +(si:putprop 'setq 'c1setq 'c1special) +(si:putprop 'setq 'c2setq 'c2) +(si:putprop 'progv 'c1progv 'c1special) +(si:putprop 'progv 'c2progv 'c2) +(si:putprop 'psetq 'c1psetq 'c1) +(si:putprop 'psetq 'c2psetq 'c2) + +(si:putprop 'var 'set-var 'set-loc) +(si:putprop 'var 'wt-var 'wt-loc) + +(defstruct var + name ;;; Variable name. + kind ;;; One of LEXICAL, SPECIAL, GLOBAL, REPLACED, FIXNUM, + ;;; CHARACTER, LONG-FLOAT, SHORT-FLOAT, and OBJECT. + ref ;;; Referenced or not. + ;;; During Pass1, T, NIL, or IGNORE. + ;;; During Pass2, the vs-address for the variable. + ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the ccb-vs for the variable, or NIL. + loc ;;; For SPECIAL and GLOBAL, the vv-index for variable name. + ;;; For others, this field is used to indicate whether + ;;; to be allocated on the value-stack: OBJECT means + ;;; the variable is declared as OBJECT, and CLB means + ;;; the variable is referenced across Level Boundary and thus + ;;; cannot be allocated on the C stack. Note that OBJECT is + ;;; set during variable binding and CLB is set when the + ;;; variable is used later, and therefore CLB may supersede + ;;; OBJECT. + ;;; For REPLACED, the actual location of the variable. + ;;; For FIXNUM, CHARACTER, LONG-FLOAT, SHORT-FLOAT, and + ;;; OBJECT, the cvar for the C variable that holds the value. + ;;; Not used for LEXICAL. + (type t) ;;; Type of the variable. + (register 0) ;;; If greater than specified am't this goes into register. + ) + +;;; A special binding creates a var object with the kind field SPECIAL, +;;; whereas a special declaration without binding creates a var object with +;;; the kind field GLOBAL. Thus a reference to GLOBAL may need to make sure +;;; that the variable has a value. + +(defvar *vars* nil) +(defvar *register-min* 4) ;criteria for putting in register. +(defvar *undefined-vars* nil) +(defvar *special-binding* nil) + +;;; During Pass 1, *vars* holds a list of var objects and the symbols 'CB' +;;; (Closure Boundary) and 'LB' (Level Boundary). 'CB' will be pushed on +;;; *vars* when the compiler begins to process a closure. 'LB' will be pushed +;;; on *vars* when *level* is incremented. +;;; *GLOBALS* holds a list of var objects for those variables that are +;;; not defined. This list is used only to suppress duplicated warnings when +;;; undefined variables are detected. + +(defun c1make-var (name specials ignores types &aux x) + (let ((var (make-var :name name))) + (cmpck (not (symbolp name)) "The variable ~s is not a symbol." name) + (cmpck (constantp name) "The constant ~s is being bound." name) + + (cond ((or (member name specials) (si:specialp name)) + (setf (var-kind var) 'SPECIAL) + (setf (var-loc var) (add-symbol name)) + (cond ((setq x (assoc name types)) + (setf (var-type var) (cdr x))) + ((setq x (get name 'cmp-type)) + (setf (var-type var) x))) + (setq *special-binding* t)) + (t + (dolist** (v types) + (cond ((eq (car v) name) + (case (cdr v) + (object (setf (var-loc var) 'object)) + (register + (setf (var-register var) + (+ (var-register var) 100))) + (t (setf (var-type var) (cdr v))))))) + (and (boundp '*c-gc*) *c-gc* + (or (null (var-type var)) + (eq t (var-type var))) + (setf (var-loc var) 'object)) + (setf (var-kind var) 'LEXICAL))) + (let ((ign (member name ignores))) + (when ign + (setf (var-ref var) (if (eq (cadr ign) 'ignorable) 'IGNORABLE 'IGNORE)))) + var) + ) + +(defun check-vref (var) + (when (and (eq (var-kind var) 'LEXICAL) + (not (var-ref var)) ;;; This field may be IGNORE. + (not (var-ref-ccb var))) + (cmpwarn "The variable ~s is not used." (var-name var)))) + +(defun c1var (name) + (let ((info (make-info)) + (vref (c1vref name))) + (push-referred (car vref) info) + (setf (info-type info) (var-type (car vref))) + (list 'var info vref)) + ) + +;;; A variable reference (vref for short) is a pair +;;; ( var-object ccb-reference ) + +(defun c1vref (name &aux (ccb nil) (clb nil)) + (declare (object ccb clb)) + (dolist* (var *vars* + (let ((var (sch-global name))) + (unless var + (unless (si:specialp name) (undefined-variable name)) + (setq var (make-var :name name + :kind 'GLOBAL + :loc (add-symbol name) + :type (or (get name 'cmp-type) t) + )) + (push var *undefined-vars*)) + (list var ccb))) + (cond ((eq var 'cb) (setq ccb t)) + ((eq var 'lb) (setq clb t)) + ((eq (var-name var) name) + (when (eq (var-ref var) 'IGNORE) + (cmpwarn "The ignored variable ~s is used." name) + (setf (var-ref var) t)) + (cond (ccb (setf (var-ref-ccb var) t)) + (clb (when (eq (var-kind var) 'lexical) + (setf (var-loc var) 'clb)) + (setf (var-ref var) t)) + (t (setf (var-ref var) t) + (setf (var-register var) + (the fixnum (+ 1 (the fixnum (var-register var))))) + )) + (return-from c1vref (list var ccb))))) + ) + +(defun c2var-kind (var) + (if (and (eq (var-kind var) 'LEXICAL) + (not (var-ref-ccb var)) + (not (eq (var-loc var) 'clb))) + (if (eq (var-loc var) 'OBJECT) + 'OBJECT + (let ((type (var-type var))) + (declare (object type)) + (cond ((type>= 'fixnum type) 'FIXNUM) +; ((type>= 'integer type) 'INTEGER) + ((type>= 'CHARACTER type) 'CHARACTER) + ((type>= 'long-float type) 'LONG-FLOAT) + ((type>= 'short-float type) 'SHORT-FLOAT) + ((and (boundp '*c-gc*) *c-gc* 'OBJECT)) + (t nil)))) + nil) + ) + +(defun c2var (vref) (unwind-exit (cons 'var vref) nil 'single-value)) + +(defun c2location (loc) (unwind-exit loc nil 'single-value)) + + +(defun check-downward (info &aux no-down ) + (dolist (v *local-functions*) + (cond ((eq (car v) 'function) + (setq no-down t) + (dolist (w *local-functions*) + (cond ((eq (car w) 'downward-function) + (setf (car w) 'function)))) + (return nil)))) + (setq *local-functions* nil) + (cond (no-down + (do-referred (var info) + (if (eq (var-kind var) 'down) + (setf (var-kind var) 'lexical)))))) + + +(defun assign-down-vars (info cfun inside &aux (ind 0) ) + (do-referred (var info) + (cond ((eq (var-kind var) 'down) + ;;don't do twice since this list may have duplicates. + (cond ((integerp (var-loc var) ) + ;(or (integerp (var-ref var)) (print var)) + (setq ind (max ind (1+ (var-loc var)))) + (setf (var-ref var) (var-loc var)) ;delete later + ) + ;((integerp (var-loc var)) (break "bil")) + (t (setf (var-ref var) ind) ;delete later + (setf (var-loc var) ind) + (setf ind (+ ind 1))))))) + (cond ((> ind 0) + ;;(wt-nl "object Dbase[" ind "];") + (cond ((eq inside 't3defun) + (wt-nl "object base0[" ind "];"))) + ;DCnames gets defined at end whe + (push 'dcnames *downward-closures*) + (wt-nl "DCnames"cfun ""))) + ind) + +(si::putprop 'down 'wt-down 'wt-loc) + +(defun wt-down (n) + (or (si::fixnump n) (wfs-error)) + (wt "base0[" n "]")) + +(defun wt-var (var ccb) + (case (var-kind var) + (LEXICAL (cond (ccb (wt-ccb-vs (var-ref-ccb var))) + ((var-ref-ccb var) (wt-vs* (var-ref var))) + ((and (eq t (var-ref var)) + (si:fixnump (var-loc var)) + *c-gc* + (eq t (var-type var))) + (setf (var-kind var) 'object) + (wt-var var ccb)) + (t (wt-vs (var-ref var))))) + (SPECIAL (wt "(" (vv-str (var-loc var)) "->s.s_dbind)")) + (REPLACED (wt (var-loc var))) + (DOWN (wt-down (var-loc var))) + (GLOBAL (if *safe-compile* + (wt "symbol_value(" (vv-str (var-loc var)) ")") + (wt "(" (vv-str (var-loc var)) "->s.s_dbind)"))) + (t (case (var-kind var) + (FIXNUM (when (zerop *space*) (wt "CMP")) + (wt "make_fixnum")) + (INTEGER (wt "make_integer")) + (CHARACTER (wt "code_char")) + (LONG-FLOAT (wt "make_longfloat")) + (SHORT-FLOAT (wt "make_shortfloat")) + (OBJECT) + (t (baboon))) + (wt "(V" (var-loc var) ")")) + )) + +;; When setting bignums across setjmps, cannot use alloca as longjmp +;; restores the C stack. FIXME -- only need malloc when reading variable +;; outside frame. CM 20031201 +(defmacro bignum-expansion-storage () + `(if (and (boundp '*unwind-exit*) (member 'frame *unwind-exit*)) + "gcl_gmp_alloc" + "alloca")) + +(defun set-var (loc var ccb) + (unless (and (consp loc) + (eq (car loc) 'var) + (eq (cadr loc) var) + (eq (caddr loc) ccb)) + (case (var-kind var) + (LEXICAL (wt-nl) + (cond (ccb (wt-ccb-vs (var-ref-ccb var))) + ((var-ref-ccb var) (wt-vs* (var-ref var))) + (t (wt-vs (var-ref var)))) + (wt "= " loc ";")) + (SPECIAL (wt-nl "(" (vv-str (var-loc var)) "->s.s_dbind)= " loc ";")) + (GLOBAL + (if *safe-compile* + (wt-nl "setq(" (vv-str (var-loc var)) "," loc ");") + (wt-nl "(" (vv-str (var-loc var)) "->s.s_dbind)= " loc ";"))) + (DOWN + (wt-nl "") (wt-down (var-loc var)) + (wt "=" loc ";")) + (INTEGER + (let ((first (and (consp loc) (car loc))) + (n (var-loc var))) + (case first + (inline-fixnum + (wt-nl "ISETQ_FIX(V"n",V"n"alloc,") + (wt-inline-loc (caddr loc) (cadddr loc))) + (fixnum-value (wt-nl "ISETQ_FIX(V"n",V"n"alloc,"(caddr loc))) + + (var + (case (var-kind (cadr loc)) + (integer (wt "SETQ_II(V"n",V"n"alloc,V" (var-loc (cadr loc)) "," + (bignum-expansion-storage))) + (fixnum (wt "ISETQ_FIX(V"n",V"n"alloc,V" (var-loc (cadr loc)))) + (otherwise (wt "SETQ_IO(V"n",V"n"alloc,"loc "," + (bignum-expansion-storage))))) + (vs (wt "SETQ_IO(V"n",V"n"alloc,"loc "," + (bignum-expansion-storage))) + (otherwise + (let ((*inline-blocks* 0) (*restore-avma* *restore-avma*)) + (save-avma '(nil integer)) + (wt-nl "SETQ_II(V"n",V" n"alloc,") + (wt-integer-loc loc (cons 'set-var var)) + (wt "," (bignum-expansion-storage) ");") + (close-inline-blocks)) + (return-from set-var nil)) + ) + (wt ");"))) + (t + (wt-nl "V" (var-loc var) "= ") + (case (var-kind var) + (FIXNUM (wt-fixnum-loc loc)) + (CHARACTER (wt-character-loc loc)) + (LONG-FLOAT (wt-long-float-loc loc)) + (SHORT-FLOAT (wt-short-float-loc loc)) + (OBJECT (wt-loc loc)) + (t (baboon))) + (wt ";")) + ))) + +(defun sch-global (name) + (dolist* (var *undefined-vars* nil) + (when (eq (var-name var) name) (return-from sch-global var)))) + +(defun c1add-globals (globals) + (dolist** (name globals) + (push (make-var :name name + :kind 'GLOBAL + :loc (add-symbol name) + :type (let ((x (get name 'cmp-type))) (if x x t)) + ) + *vars*)) + ) + +(defun c1setq (args) + (cond ((endp args) (c1nil)) + ((endp (cdr args)) (too-few-args 'setq 2 1)) + ((endp (cddr args)) (c1setq1 (car args) (cadr args))) + (t + (do ((pairs args (cddr pairs)) + (forms nil)) + ((endp pairs) (c1expr (cons 'progn (nreverse forms)))) + (declare (object pairs)) + (cmpck (endp (cdr pairs)) + "No form was given for the value of ~s." (car pairs)) + (push (list 'setq (car pairs) (cadr pairs)) forms) + ))) + ) + +(defun c1setq1 (name form &aux (info (make-info)) type form1 name1) + (cmpck (not (symbolp name)) "The variable ~s is not a symbol." name) + (cmpck (constantp name) "The constant ~s is being assigned a value." name) + (setq name1 (c1vref name)) + (push-changed (car name1) info) + (setq form1 (c1expr form)) + (add-info info (cadr form1)) + (setq type (type-and (var-type (car name1)) (info-type (cadr form1)))) + (when (null type) + (cmpwarn "Type mismatches between ~s and ~s." name form)) + (unless (eq type (info-type (cadr form1))) + (let ((info1 (copy-info (cadr form1)))) + (setf (info-type info1) type) + (setq form1 (list* (car form1) info1 (cddr form1))))) + (setf (info-type info) type) + (list 'setq info name1 form1) + ) + +(defun c2setq (vref form) + (let ((*value-to-go* (cons 'var vref))) (c2expr* form)) + (case (car form) + (LOCATION (c2location (caddr form))) + (otherwise (unwind-exit (cons 'var vref)))) + ) + +(defun c1progv (args &aux symbols values (info (make-info))) + (when (or (endp args) (endp (cdr args))) + (too-few-args 'progv 2 (length args))) + (setq symbols (c1expr* (car args) info)) + (setq values (c1expr* (cadr args) info)) + (list 'progv info symbols values (c1progn* (cddr args) info)) + ) + +(defun c2progv (symbols values body + &aux (cvar (next-cvar)) + (*unwind-exit* *unwind-exit*)) + + (wt-nl "{object symbols,values;") + (wt-nl "bds_ptr V" cvar "=bds_top;") + (push cvar *unwind-exit*) + + (let ((*vs* *vs*)) + (let ((*value-to-go* (list 'vs (vs-push)))) + (c2expr* symbols) + (wt-nl "symbols= " *value-to-go* ";")) + + (let ((*value-to-go* (list 'vs (vs-push)))) + (c2expr* values) + (wt-nl "values= " *value-to-go* ";")) + + (wt-nl "while(!endp(symbols)){") + (when *safe-compile* + (wt-nl "if(type_of(MMcar(symbols))!=t_symbol)") + (wt-nl + "FEinvalid_variable(\"~s is not a symbol.\",MMcar(symbols));")) + (wt-nl "if(endp(values))bds_bind(MMcar(symbols),OBJNULL);") + (wt-nl "else{bds_bind(MMcar(symbols),MMcar(values));") + (wt-nl "values=MMcdr(values);}") + (wt-nl "symbols=MMcdr(symbols);}") + ) + (c2expr body) + (wt "}") + ) + +(defun c1psetq (args &aux (vrefs nil) (forms nil) + (info (make-info :type '(member nil)))) + (do ((l args (cddr l))) + ((endp l)) + (declare (object l)) + (cmpck (not (symbolp (car l))) + "The variable ~s is not a symbol." (car l)) + (cmpck (constantp (car l)) + "The constant ~s is being assigned a value." (car l)) + (cmpck (endp (cdr l)) + "No form was given for the value of ~s." (car l)) + (let* ((vref (c1vref (car l))) + (form (c1expr (cadr l))) + (type (type-and (var-type (car vref)) + (info-type (cadr form))))) + (unless (equal type (info-type (cadr form))) + (let ((info1 (copy-info (cadr form)))) + (setf (info-type info1) type) + (setq form (list* (car form) info1 (cddr form))))) + (push vref vrefs) + (push form forms) + (push-changed (car vref) info) + (add-info info (cadar forms))) + ) + (list 'psetq info (nreverse vrefs) (nreverse forms)) + ) + +(defun c2psetq (vrefs forms &aux (*vs* *vs*) (saves nil) (blocks 0)) + (dolist** (vref vrefs) + (if (or (args-info-changed-vars (car vref) (cdr forms)) + (args-info-referred-vars (car vref) (cdr forms))) + (case (caar forms) + (LOCATION (push (cons vref (caddar forms)) saves)) + (otherwise + (if (member (var-kind (car vref)) + '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)) + (let* ((kind (var-kind (car vref))) + (cvar (next-cvar)) + (temp (list 'var (make-var :kind kind :loc cvar) nil))) + (wt-nl "{" *volatile* (rep-type kind) "V" cvar ";") + (incf blocks) + (let ((*value-to-go* temp)) (c2expr* (car forms))) + (push (cons vref temp) saves)) + (let ((*value-to-go* (list 'vs (vs-push)))) + (c2expr* (car forms)) + (push (cons vref *value-to-go*) saves))))) + (let ((*value-to-go* (cons 'var vref))) (c2expr* (car forms)))) + (pop forms)) + (dolist** (save saves) (set-var (cdr save) (caar save) (cadar save))) + (dotimes (i blocks) (wt "}")) + (unwind-exit nil) + ) +(defun wt-var-decl (var) + (cond ((var-p var) + (let ((n (var-loc var))) + (cond ((eq (var-kind var) 'integer)(wt "IDECL("))) + (wt *volatile* (register var) (rep-type (var-kind var)) + "V" n ) + (if (eql (var-kind var) 'integer) (wt ",V"n"space,V"n"alloc)")) + (wt ";"))) + (t (wfs-error)))) diff --git a/cmpnew/gcl_cmpvs.lsp b/cmpnew/gcl_cmpvs.lsp new file mode 100755 index 0000000..38e6aa7 --- /dev/null +++ b/cmpnew/gcl_cmpvs.lsp @@ -0,0 +1,100 @@ +;;; CMPVS Value stack manager. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(si:putprop 'vs 'set-vs 'set-loc) +(si:putprop 'vs 'wt-vs 'wt-loc) +(si:putprop 'vs* 'wt-vs* 'wt-loc) +(si:putprop 'ccb-vs 'wt-ccb-vs 'wt-loc) + +(defvar *vs* 0) +(defvar *max-vs* 0) +(defvar *clink* nil) +(defvar *ccb-vs* 0) +;; We need an initial binding for *initial-ccb-vs* for use in defining +;; local functions at the toplevel in c2flet and c2labels. CM +;; 20031130. +(defvar *initial-ccb-vs* 0) +(defvar *level* 0) +(defvar *vcs-used*) + +;;; *vs* holds the offset of the current vs-top. +;;; *max-vs* holds the maximum offset so far. +;;; *clink* holds NIL or the vs-address of the last ccb object. +;;; *ccb-vs* holds the top of the level 0 vs. +;;; *initial-ccb-vs* holds the value of *ccb-vs* when Pass 2 began to process +;;; a local (possibly closure) function. +;;; *level* holds the current function level. *level* is 0 for a top-level +;;; function. + +(defun vs-push () + (prog1 (cons *level* *vs*) + (incf *vs*) + (setq *max-vs* (max *vs* *max-vs*)))) + +(defun set-vs (loc vs) + (unless (and (consp loc) + (eq (car loc) 'vs) + (equal (cadr loc) vs)) + (wt-nl) + (wt-vs vs) + (wt "= " loc ";"))) + +(defun wt-vs (vs) + (cond ((eq (car vs) 'cvar) + (wt "V" (second vs))) + ((eq (car vs) 'cs) + (setq *vcs-used* t) + (wt "Vcs[" (cdr vs) "]")) + ((eq (car vs) 'fun-env) + (wt "fun->cc.cc_turbo[" (cdr vs) "]")) + (t + (if (= (car vs) *level*) + (wt "base[" (cdr vs) "]") + (wt "base" (car vs) "[" (cdr vs) "]"))))) + +(defun wt-vs* (vs) + (wt "(" )(wt-vs vs) (wt "->c.c_car)")) + +(defun wt-ccb-vs (ccb-vs);;FIXME harmonize *closure-p* with *clink* + (wt "(" (if *closure-p* "fun->cc.cc_turbo" "base0") "[" (- *initial-ccb-vs* ccb-vs) "]->c.c_car)")) + +(defun clink (vs) (setq *clink* vs)) + +(defun wt-clink (&optional (clink *clink*)) + (if (null clink) (wt "Cnil") (wt-vs clink))) + +(defun ccb-vs-push () (incf *ccb-vs*)) + + +(defun cvs-push () + (prog1 (cons 'cs *cs*) + (incf *cs*) + )) + + +(defun wt-list (l) + (do ((v l (cdr v))) + ((null v)) + (wt (car v)) + (or (null (cdr v)) (wt ",")))) + diff --git a/cmpnew/gcl_cmpwt.lsp b/cmpnew/gcl_cmpwt.lsp new file mode 100755 index 0000000..7d60bea --- /dev/null +++ b/cmpnew/gcl_cmpwt.lsp @@ -0,0 +1,192 @@ +;;; CMPWT Output routines. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(in-package :compiler) + +(eval-when (compile eval) + (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp") + + +(defmacro data-inits () `(first *data*)) + +) + +(defun wt-comment (message &optional (symbol nil)) + (princ " +/* " *compiler-output1*) + (princ message *compiler-output1*) + (when symbol + (let ((s (symbol-name symbol))) + (declare (string s)) + (dotimes** (n (length s)) + (let ((c (schar s n))) + (declare (character c)) + (unless (char= c #\/) + (princ c *compiler-output1*)))))) + (princ " */ +" *compiler-output1*) + nil + ) + +(defun wt1 (form) + (cond ((or (stringp form) (integerp form) (characterp form)) + (princ form *compiler-output1*)) + ((or (typep form 'long-float) + (typep form 'short-float)) + (format *compiler-output1* "~10,,,,,,'eG" form)) + (t (wt-loc form))) + nil) + +(defun wt-h1 (form) + (cond ((consp form) + (let ((fun (get (car form) 'wt))) + (if fun + (apply fun (cdr form)) + (cmpiler-error "The location ~s is undefined." form)))) + (t (princ form *compiler-output2*))) + nil) + +(defvar *fasd-data*) + +(defvar *hash-eq* nil) +(defvar *run-hash-equal-data-checking* t) +(defun memoized-hash-equal (x depth);FIXME implement all this in lisp + (declare (fixnum depth)) + (when *run-hash-equal-data-checking* + (unless *hash-eq* (setq *hash-eq* (make-hash-table :test 'eq))) + (or (gethash x *hash-eq*) + (setf (gethash x *hash-eq*) + (if (> depth 3) 0 + (if (typep x 'cons) + (logxor (setq depth (the fixnum (1+ depth)));FIXME? + (logxor + (memoized-hash-equal (car x) depth) + (memoized-hash-equal (cdr x) depth))) + (si::hash-equal x depth))))))) + +(defun push-data-incf (x) + (incf *next-vv*)) + +(defun wt-data1 (expr) + (let ((*print-radix* nil) + (*print-base* 10) + (*print-circle* t) + (*print-pretty* nil) + (*print-level* nil) + (*print-length* nil) + (*print-case* :downcase) + (*print-gensym* t) + (*print-array* t) + ;;This forces the printer to add the float type in the .data file. + (*READ-DEFAULT-FLOAT-FORMAT* t) + (si::*print-package* t) + (si::*print-structure* t)) + (terpri *compiler-output-data*) + (prin1 expr *compiler-output-data*))) + +(defun add-init (x &optional endp &aux (tem (cons (memoized-hash-equal x -1000) x))) + (if endp + (nconc (data-inits) (list tem)) + (push tem (data-inits))) + x) + +(defun verify-datum (v) + (unless (eql (pop v) (memoized-hash-equal v -1000)) + (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" v)) + v) + +(defun wt-fasd-element (x) + (si::find-sharing-top x (fasd-table (car *fasd-data*))) + (si::write-fasd-top x (car *fasd-data*))) + +(defun wt-data2 (x) + (if *fasd-data* + (wt-fasd-element x) + (wt-data1 x))) + +(defun wt-data-file nil + (when *prof-p* (add-init `(si::mark-memory-as-profiling))) + (wt-data2 (1+ *next-vv*)) + (dolist (v (nreverse (data-inits))) + (wt-data2 (verify-datum v))) + (when *fasd-data* + (si::close-fasd (car *fasd-data*)))) + +(defun wt-data-begin ()) +(defun wt-data-end ()) + +(defmacro wt (&rest forms &aux (fl nil)) + (dolist** (form forms (cons 'progn (reverse (cons nil fl)))) + (if (stringp form) + (push `(princ ,form *compiler-output1*) fl) + (push `(wt1 ,form) fl)))) + +(defmacro wt-h (&rest forms &aux (fl nil)) + (cond ((endp forms) '(princ " +" *compiler-output2*)) + ((stringp (car forms)) + (dolist** (form (cdr forms) + (list* 'progn `(princ ,(concatenate 'string " +" (car forms)) *compiler-output2*) (reverse (cons nil fl)))) + (if (stringp form) + (push `(princ ,form *compiler-output2*) fl) + (push `(wt-h1 ,form) fl)))) + (t (dolist** (form forms + (list* 'progn '(princ " +" *compiler-output2*) (reverse (cons nil fl)))) + (if (stringp form) + (push `(princ ,form *compiler-output2*) fl) + (push `(wt-h1 ,form) fl)))))) + +(defmacro wt-nl (&rest forms &aux (fl nil)) + (cond ((endp forms) '(princ " + " *compiler-output1*)) + ((stringp (car forms)) + (dolist** (form (cdr forms) + (list* 'progn `(princ ,(concatenate 'string " + " (car forms)) *compiler-output1*) (reverse (cons nil fl)))) + (if (stringp form) + (push `(princ ,form *compiler-output1*) fl) + (push `(wt1 ,form) fl)))) + (t (dolist** (form forms + (list* 'progn '(princ " + " *compiler-output1*) (reverse (cons nil fl)))) + (if (stringp form) + (push `(princ ,form *compiler-output1*) fl) + (push `(wt1 ,form) fl)))))) + +(defmacro wt-nl1 (&rest forms &aux (fl nil)) + (cond ((endp forms) '(princ " +" *compiler-output1*)) + ((stringp (car forms)) + (dolist** (form (cdr forms) + (list* 'progn `(princ ,(concatenate 'string " +" (car forms)) *compiler-output1*) (nreverse (cons nil fl)))) + (if (stringp form) + (push `(princ ,form *compiler-output1*) fl) + (push `(wt1 ,form) fl)))) + (t (dolist** (form forms + (list* 'progn '(princ " +" *compiler-output1*) (nreverse (cons nil fl)))) + (if (stringp form) + (push `(princ ,form *compiler-output1*) fl) + (push `(wt1 ,form) fl)))))) + diff --git a/cmpnew/gcl_collectfn.lsp b/cmpnew/gcl_collectfn.lsp new file mode 100755 index 0000000..2df5159 --- /dev/null +++ b/cmpnew/gcl_collectfn.lsp @@ -0,0 +1,399 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;;;; +;;; Copyright (c) 1989 by William Schelter,University of Texas ;;;;; +;;; All rights reserved ;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; See the doc/DOC file for information on emit-fn and +;; make-all-proclaims. The basic idea is to utilize information gathered +;; by the compiler in a compile of a system of files in order to generate +;; better code on subsequent compiles of the system. To do this a file +;; sys-proclaim.lisp should be produced. + +;; Additionally cross reference information about functions in the system is +;; collected. + +(in-package :compiler) +(import 'sloop::sloop) + +(defstruct fn + name ;; name of THIS FUNCTION + def ;; defun, defmacro + value-type ;; If this function's body contained + ;; (cond ((> a 3) 7) + ;; ((> a 1) (foo))) + ;; then the return type of 7 is known at compile time + ;; and value-type would be fixnum. [see return-type] + fun-values ;; list of functions whose values are the values of THIS FN + ;; (foo) in the previous example. + callees ;; list of all functions called by THIS FUNCTION + return-type ;; Store a return-type computed from the fun-values + ;; and value-type field. This computation is done later. + arg-types ;; non optional arg types. + no-emit ;; if not nil don't emit declaration. + macros + ) + +(defvar *other-form* (make-fn)) +(defvar *all-fns* nil) +(defvar *call-table* (make-hash-table)) +(defvar *current-fn* nil) +(defun add-callee (fname) + (cond ((consp fname) + (or (eq (car fname) 'values) + (add-callee (car fname)))) + ((eq fname 'single-value)) + (fname (pushnew fname (fn-callees (current-fn)))))) + +(defun add-macro-callee (fname) + (or + ;; make sure the macro fname is not shadowed in the current environment. + (sloop::sloop for v in *funs* + when (and (consp v) (eq (car v) fname)) + do (return t)) + (pushnew fname (fn-macros (current-fn))))) + +(defun clear-call-table () + (setf *current-fn* nil) + (setq *all-fns* nil) + (setq *other-form* (make-fn :name 'other-form)) + (clrhash *call-table*) + (setf (gethash 'other-form *call-table*) *other-form*) + ) + +(defun emit-fn (flag) (setq *record-call-info* flag)) + +(defun type-or (a b) + (if (eq b '*) '* + (case a + ((nil) b) + ((t inline) t) + ((fixnum inline-fixnum fixnum-value) (if (eq b 'fixnum) 'fixnum + (type-or t b))) + (otherwise '*) + ))) + +(defun current-fn () + (cond ((and (consp *current-form*) + (member (car *current-form*) '(defun defmacro)) + (symbolp (second *current-form*)) + (symbol-package (second *current-form*));;don't record gensym'd + ) + (cond ((and *current-fn* + (equal (second *current-form*) (fn-name *current-fn*))) + *current-fn*) + (t + (unless + (setq *current-fn* + (gethash (second *current-form*) *call-table*)) + (setq *current-fn* (make-fn :name (second *current-form*) + :def (car *current-form*))) + (setf (gethash (second *current-form*) *call-table*) + *current-fn*) + (setq *all-fns* (cons *current-fn* *all-fns*))) + *current-fn*))) + ;; catch all for other top level forms + (t *other-form*))) + +(defun who-calls (f) + (sloop for (ke val) in-table *call-table* + when (or (member f (fn-callees val)) + (member f (fn-macros val))) + collect ke)) + + +(defun add-value-type (x fn &aux (current-fn (current-fn))) + (cond (fn (pushnew fn + (fn-fun-values current-fn) :test 'equal)) + (t + (setf (fn-value-type current-fn) + (type-or (fn-value-type current-fn) x))))) + + +(defun get-var-types (lis) + (sloop::sloop for v in lis collect (var-type v))) + +(defun record-arg-info( lambda-list &aux (cf (current-fn))) + (setf (fn-arg-types cf) (get-var-types (car lambda-list))) + (when (sloop::sloop for v in (cdr lambda-list) + for w in '(&optional &rest &key + nil &allow-other-keys + ) + when (and v w) do (return '*)) + (setf (fn-arg-types cf) (nconc(fn-arg-types cf) (list '*))) + )) + +(defvar *depth* 0) +(defvar *called-from* nil) + +(defun get-value-type (fname) + (cond ((member fname *called-from* :test 'eq) nil) + (t + (let ((tem (cons fname *called-from*))) + (declare (:dynamic-extent tem)) + (let ((*called-from* tem)) + (get-value-type1 fname)))))) + +(defun get-value-type1 (fname + &aux tem (*depth* (the fixnum (+ 1 (the fixnum + *depth* ))))) + (cond ((> (the fixnum *depth*) 100) '*) + ((setq tem (gethash fname *call-table*)) + (or + (fn-return-type tem) + (sloop::sloop with typ = (fn-value-type tem) + for v in (fn-fun-values tem) + when (symbolp v) + do (setq typ (type-or typ (get-value-type v))) + else + when (and (consp v) (eq (car v) 'values)) + do + (setq typ (type-or typ (if (eql (cdr v) 1) t '*))) + else do (error "unknown fun value ~a" v) + finally + ;; if there is no visible return, then we can assume + ;; one value. + (or typ (fn-value-type tem) + (fn-fun-values tem) + (setf typ t)) + (setf (fn-return-type tem) typ) + (return typ) + ))) + ((get fname 'return-type)) + ((get fname 'proclaimed-return-type)) + (t '*))) + +(defun result-type-from-loc (x) + (cond ((consp x) + (case (car x) + ((fixnum-value inline-fixnum) 'fixnum) + (var (var-type (second x))) + ;; eventually separate out other inlines + (t (cond ((and (symbolp (car x)) + (get (car x) 'wt-loc)) + t) + (t (print (list 'type '* x)) '*))))) + ((or (eq x t) (null x)) t) + (t (print (list 'type '*2 x)) '*))) + + +(defun small-all-t-p (args ret) + (and (eq ret t) + (< (length args) 10) + (sloop::sloop for v in args always (eq v t)))) + +;; Don't change return type but pretend all these are optional args. + +(defun no-make-proclaims-hack () + (sloop::sloop for (ke val) in-table *call-table* + do (progn ke) (setf (fn-no-emit val) 1))) + +(defun set-closure () + (setf (fn-def (current-fn)) 'closure)) + +(defun make-proclaims ( &optional (st *standard-output*) + &aux (ht (make-hash-table :test 'equal)) + *print-length* *print-level* + (si::*print-package* t) + ) +; (require "VLFUN" +; (concatenate 'string si::*system-directory* +; "../cmpnew/lfun_list.lsp")) + + (print `(in-package ,(package-name *package*)) st) + (sloop::sloop with ret with at + for (ke val) in-table *call-table* + do + (cond ((eq (fn-def val) 'closure) + (push ke (gethash 'proclaimed-closure ht))) + ((or (eql 1 (fn-no-emit val)) + (not (eq (fn-def val) 'defun)))) + (t (setq ret (get-value-type ke)) + (setq at (fn-arg-types val)) + (push ke (gethash (list at ret) ht))))) + (sloop::sloop for (at fns) in-table ht + do + (print + (if (symbolp at) `(mapc (lambda (x) (setf (get x 'compiler::proclaimed-closure) t)) '(,@fns)) + `(proclaim '(ftype (function ,@ at) ,@ fns))) + st))) + +(defun setup-sys-proclaims() + (or (gethash 'si::call-test *call-table*) + (get 'si::call-test 'proclaimed-function) + (load (concatenate 'string si::*system-directory* + "../lsp/sys-proclaim.lisp")) + (no-make-proclaims-hack) + )) + +(defun make-all-proclaims (&rest files) + (setup-sys-proclaims) + (dolist (v files) + (mapcar 'load (directory v))) + (write-sys-proclaims)) + +(defun write-sys-proclaims () + (with-open-file (st "sys-proclaim.lisp" :direction :output) + (make-proclaims st))) + +(defvar *file-table* (make-hash-table :test 'eq)) + +(defvar *warn-on-multiple-fn-definitions* t) + +(defun add-fn-data (lis &aux tem (file *load-truename*)) + (dolist (v lis) + (cond ((eql (fn-name v) 'other-form) + (setf (fn-name v) (intern + (concatenate 'string "OTHER-FORM-" + (namestring file)))) + (setf (get (fn-name v) 'other-form) t))) + (setf (gethash (fn-name v) *call-table*) v) + (when *warn-on-multiple-fn-definitions* + (when (setq tem (gethash (fn-name v) *file-table*)) + (unless (equal tem file) + (warn 'simple-warning :format-control "~% ~a redefined in ~a. Originally in ~a." + :format-arguments (list (fn-name v) file tem))))) + (setf (gethash (fn-name v) *file-table*) file))) + +(defun dump-fn-data (&optional (file "fn-data.lsp") + &aux (*package* (find-package "COMPILER")) + (*print-length* nil) + (*print-level* nil) + ) + (with-open-file (st file :direction :output) + (format st "(in-package 'compiler)(init-fn)~%(~s '(" 'add-fn-data) + (sloop::sloop for (ke val) in-table *call-table* + do (progn ke) (print val st)) + (princ "))" st) + (truename st))) + +(defun record-call-info (loc fname) + (cond ((and fname (symbolp fname)) + (add-callee fname))) + (cond ((eq loc 'record-call-info) (return-from record-call-info nil))) + (case *value-to-go* + (return + (if (eq loc 'fun-val) + (add-value-type nil (or fname 'unknown-values)) + (add-value-type (result-type-from-loc loc) nil))) + (return-fixnum + (add-value-type 'fixnum nil)) + (return-object + (add-value-type t nil)) + + (top (setq *top-data* (cons fname nil)) + )) + ) + +(defun list-undefined-functions (&aux undefs) + (sloop::sloop for (name fn) in-table *call-table* + declare (ignore name) + do (sloop for w in (fn-callees fn) + when (not (or (fboundp w) + (gethash w *call-table*) + (get w 'inline-always) + (get w 'inline-unsafe) + (get w 'other-form) + )) + do (pushnew w undefs))) + undefs) + + + +(dolist (v '(throw coerce single-value sort delete remove char-upcase + si::fset typep)) + (si::putprop v t 'return-type)) + +(defun init-fn () nil) + +(defun list-uncalled-functions ( ) + (let* ((size (sloop::sloop for (ke v) + in-table *call-table* count t + do (progn ke v nil))) + (called (make-hash-table :test 'eq :size (+ 3 size)))) + (sloop::sloop for (ke fn) in-table *call-table* + declare (ignore ke) + do (sloop::sloop for w in (fn-callees fn) + do + (setf (gethash w called) t)) + (sloop::sloop for w in (fn-macros fn) + do + (setf (gethash w called) t)) + + ) + (sloop::sloop for (ke fn) in-table *call-table* + when(and + (not (gethash ke called)) + (member (fn-def fn) '(defun defmacro) + :test 'eq)) + collect ke))) + +;; redefine the stub in defstruct.lsp +(defun si::record-fn (name def arg-types return-type) + (if (null return-type) (setq return-type t)) + (and *record-call-info* + *compiler-in-use* + (let ((fn (make-fn :name name + :def def + :return-type return-type + :arg-types arg-types))) + (push fn *all-fns*) + (setf (gethash name *call-table*) fn)))) + +(defun get-packages (&optional (st "sys-package.lisp") pass + &aux (si::*print-package* t)) + (flet ((pr (x) (format st "~%~s" x))) + (cond ((null pass) + (with-open-file (st st :direction :output) + (get-packages st 'establish) + (get-packages st 'export) + (get-packages st 'shadow) + (format st "~2%") + (return-from get-packages nil)))) + (dolist (p (list-all-packages)) + (unless + (member (package-name p) + '("SLOOP" + "COMPILER" "SYSTEM" "KEYWORD" "LISP" "USER") + :test 'equal + ) + (format st "~2%;;; Definitions for package ~a of type ~a" + (package-name p) pass) + (ecase pass + (establish + (let ((SYSTEM::*PRINT-PACKAGE* t)) + (pr + `(in-package ,(package-name p) :use nil + ,@ (if (package-nicknames p) + `(:nicknames ',(package-nicknames p))))))) + (export + (let ((SYSTEM::*PRINT-PACKAGE* t)) + (pr + `(in-package ,(package-name p) + :use + '(,@ + (mapcar 'package-name (package-use-list p))) + ,@(if (package-nicknames p) + `(:nicknames ',(package-nicknames p)))))) + (let (ext (*package* p) + imps) + (do-external-symbols (sym p) (push sym ext) + (or (eq (symbol-package sym) p) + (push sym imps))) + (pr `(import ',imps)) + (pr `(export ',ext)))) + (shadow + (let ((SYSTEM::*PRINT-PACKAGE* t)) + (pr `(in-package ,(package-name p)))) + (let (in out (*package* (find-package "LISP"))) + (dolist (v (package-shadowing-symbols p)) + (cond ((eq (symbol-package v) p) + (push v in)) + (t (push v out)))) + (pr `(shadow ',in)) + (pr `(shadowing-import ',out)) + (let (imp) + (do-symbols (v p) + (cond ((not (eq (symbol-package v) p)) + (push v imp)))) + (pr `(import ',imp)))))))))) diff --git a/cmpnew/gcl_fasdmacros.lsp b/cmpnew/gcl_fasdmacros.lsp new file mode 100755 index 0000000..a041e99 --- /dev/null +++ b/cmpnew/gcl_fasdmacros.lsp @@ -0,0 +1,81 @@ + + +(defstruct (fasd (:type vector)) + stream + table + eof + direction + package + index + filepos + table_length + evald_forms ; list of forms eval'd. (load-time-eval) + ) + +(defvar *fasd-ops* +'( d_nil ;/* dnil: nil */ + d_eval_skip ; /* deval o1: evaluate o1 after reading it */ + d_delimiter ;/* occurs after d_listd_general and d_new_indexed_items */ + d_enter_vector ; /* d_enter_vector o1 o2 .. on d_delimiter make a cf_data with + ; this length. Used internally by gcl. Just make + ; an array in other lisps */ + d_cons ; /* d_cons o1 o2: (o1 . o2) */ + d_dot ; + d_list ;/* list* delimited by d_delimiter d_list,o1,o2, ... ,d_dot,on + ;for (o1 o2 . on) + ;or d_list,o1,o2, ... ,on,d_delimiter for (o1 o2 ... on) + ;*/ + d_list1 ;/* nil terminated length 1 d_list1o1 */ + d_list2 ; /* nil terminated length 2 */ + d_list3 + d_list4 + d_eval + d_short_symbol + d_short_string + d_short_fixnum + d_short_symbol_and_package + d_bignum + d_fixnum + d_string + d_objnull + d_structure + d_package + d_symbol + d_symbol_and_package + d_end_of_file + d_standard_character + d_vector + d_array + d_begin_dump + d_general_type + d_sharp_equals ; /* define a sharp */ + d_sharp_value + d_sharp_value2 + d_new_indexed_item + d_new_indexed_items + d_reset_index + d_macro + d_reserve1 + d_reserve2 + d_reserve3 + d_reserve4 + d_indexed_item3 ; /* d_indexed_item3 followed by 3bytes to give index */ + d_indexed_item2 ; /* d_indexed_item2 followed by 2bytes to give index */ + d_indexed_item1 + d_indexed_item0 ; /* This must occur last ! */ +)) + +(defmacro put-op (op str) + `(write-byte ,(or (position op *fasd-ops*) + (error "illegal op")) ,str)) + +(defmacro put2 (n str) + `(progn (write-bytei ,n 0 ,str) + (write-bytei ,n 1 ,str))) + +(defmacro write-bytei (n i str) + `(write-byte (the fixnum (ash (the fixnum ,n) >> ,(* i 8))) ,str)) + + +(provide 'FASDMACROS) + diff --git a/cmpnew/gcl_init.lsp b/cmpnew/gcl_init.lsp new file mode 100755 index 0000000..26b96d9 --- /dev/null +++ b/cmpnew/gcl_init.lsp @@ -0,0 +1,4 @@ +(defun lcs1 (file) + (compile-file file + :c-file t :h-file t :data-file t :ob-file t + :system-p t)) diff --git a/cmpnew/gcl_lfun_list.lsp b/cmpnew/gcl_lfun_list.lsp new file mode 100755 index 0000000..86c134b --- /dev/null +++ b/cmpnew/gcl_lfun_list.lsp @@ -0,0 +1,434 @@ + +;; Modified data base including return values types +;; and making the arglists correct if they have optional args. +;; + +(in-package :compiler) + +(DEFSYSFUN 'GENSYM "Lgensym" '(*) 'T NIL NIL) +(DEFSYSFUN 'SUBSEQ "Lsubseq" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'MINUSP "Lminusp" '(T) 'T NIL T) +(DEFSYSFUN 'INTEGER-DECODE-FLOAT "Linteger_decode_float" '(T) + '(VALUES T T T) NIL NIL) +(DEFSYSFUN '- "Lminus" '(T *) 'T NIL NIL) +(DEFSYSFUN 'INT-CHAR "Lint_char" '(T) 'CHARACTER NIL NIL) +(DEFSYSFUN 'CHAR-INT "Lchar_int" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN '/= "Lall_different" '(T *) 'T NIL T) +(DEFSYSFUN 'COPY-SEQ "Lcopy_seq" '(T) 'T NIL NIL) +(DEFSYSFUN 'KEYWORDP "Lkeywordp" '(T) 'T NIL T) +(DEFSYSFUN 'NAME-CHAR "Lname_char" '(T) 'CHARACTER NIL NIL) +(DEFSYSFUN 'CHAR-NAME "Lchar_name" '(T) 'T NIL NIL) +(DEFSYSFUN 'RASSOC-IF "Lrassoc_if" '(T T) 'T NIL NIL) +(DEFSYSFUN 'MAKE-LIST "Lmake_list" '(T *) 'T NIL NIL) +(DEFSYSFUN 'MAKE-ECHO-STREAM "Lmake_echo_stream" '(T T) 'T NIL NIL) +;(DEFSYSFUN 'NTH "Lnth" '(T T) 'T NIL NIL) +(DEFSYSFUN 'SIN "Lsin" '(T) 'T NIL NIL) +(DEFSYSFUN 'NUMERATOR "Lnumerator" '(T) 'T NIL NIL) +(DEFSYSFUN 'ARRAY-RANK "Larray_rank" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'CAAR "Lcaar" '(T) 'T NIL NIL) +;#-clcs (DEFSYSFUN 'LOAD "Lload" '(T *) 'T NIL NIL) +;#-clcs (DEFSYSFUN 'OPEN "Lopen" '(T *) 'T NIL NIL) +(DEFSYSFUN 'BOTH-CASE-P "Lboth_case_p" '(T) 'T NIL T) +(DEFSYSFUN 'NULL "Lnull" '(T) 'T NIL T) +(DEFSYSFUN 'STRING-CAPITALIZE "Lstring_capitalize" '(T *) 'STRING NIL + NIL) +(DEFSYSFUN 'MACROEXPAND "Lmacroexpand" '(T *) '(VALUES T T) NIL NIL) +(DEFSYSFUN 'NCONC "Lnconc" '(*) 'T NIL NIL) +(DEFSYSFUN 'BOOLE "Lboole" '(T T T) 'T NIL NIL) +(DEFSYSFUN 'TAILP "Ltailp" '(T T) 'T NIL T) +(DEFSYSFUN 'CONSP "Lconsp" '(T) 'T NIL T) +(DEFSYSFUN 'LISTP "Llistp" '(T) 'T NIL T) +(DEFSYSFUN 'MAPCAN "Lmapcan" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'LENGTH "Llength" '(T) 'FIXNUM T NIL) +(DEFSYSFUN 'RASSOC "Lrassoc" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'PPRINT "Lpprint" '(T *) 'T NIL NIL) +(DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) +(DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'REVERSE "Lreverse" '(T) 'T NIL NIL) +(DEFSYSFUN 'STREAMP "Lstreamp" '(T) 'T NIL T) +(DEFSYSFUN 'SYSTEM::PUTPROP "siLputprop" '(T T T) 'T NIL NIL) +(DEFSYSFUN 'REMPROP "Lremprop" '(T T) 'T NIL NIL) +(DEFSYSFUN 'SYMBOL-PACKAGE "Lsymbol_package" '(T) 'T NIL NIL) +(DEFSYSFUN 'NSTRING-UPCASE "Lnstring_upcase" '(T *) 'STRING NIL NIL) +(DEFSYSFUN 'STRING>= "Lstring_ge" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'REALPART "Lrealpart" '(T) 'T NIL NIL) +;;broken on suns.. +(DEFSYSFUN 'NBUTLAST "Lnbutlast" '(T *) 'T NIL NIL) +(DEFSYSFUN 'ARRAY-DIMENSION "Larray_dimension" '(T T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'CDR "Lcdr" '(T) 'T NIL NIL) +;(DEFSYSFUN 'EQL "Leql" '(T T) 'T NIL T) +(DEFSYSFUN 'LOG "Llog" '(T *) 'T NIL NIL) +(DEFSYSFUN 'STRING-NOT-EQUAL "Lstring_not_equal" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'SHADOWING-IMPORT "Lshadowing_import" '(T *) 'T NIL NIL) +(DEFSYSFUN 'MAPC "Lmapc" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'MAPL "Lmapl" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'MAKUNBOUND "Lmakunbound" '(T) 'T NIL NIL) +(DEFSYSFUN 'CONS "Lcons" '(T T) 'T NIL NIL) +(DEFSYSFUN 'LIST "Llist" '(*) 'T NIL NIL) +(DEFSYSFUN 'USE-PACKAGE "Luse_package" '(T *) 'T NIL NIL) +(DEFSYSFUN 'MAKE-SYMBOL "Lmake_symbol" '(T) 'T NIL NIL) +(DEFSYSFUN 'STRING-RIGHT-TRIM "Lstring_right_trim" '(T T) 'STRING NIL + NIL) +(DEFSYSFUN 'PRINT "Lprint" '(T *) 'T NIL NIL) +(DEFSYSFUN 'CDDAAR "Lcddaar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CDADAR "Lcdadar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CDAADR "Lcdaadr" '(T) 'T NIL NIL) +(DEFSYSFUN 'CADDAR "Lcaddar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CADADR "Lcadadr" '(T) 'T NIL NIL) +(DEFSYSFUN 'CAADDR "Lcaaddr" '(T) 'T NIL NIL) +(DEFSYSFUN 'SET-MACRO-CHARACTER "Lset_macro_character" '(T T *) 'T NIL + NIL) +(DEFSYSFUN 'FORCE-OUTPUT "Lforce_output" '(*) 'T NIL NIL) +;(DEFSYSFUN 'NTHCDR "Lnthcdr" '(T T) 'T NIL NIL) +(DEFSYSFUN 'LOGIOR "Llogior" '(*) 'T NIL NIL) +(DEFSYSFUN 'CHAR-DOWNCASE "Lchar_downcase" '(T) 'CHARACTER NIL NIL) +(DEFSYSFUN 'STRING-CHAR-P "Lstring_char_p" '(T) 'T NIL T) +(DEFSYSFUN 'STREAM-ELEMENT-TYPE "Lstream_element_type" '(T) 'T NIL NIL) +(DEFSYSFUN 'PACKAGE-USED-BY-LIST "Lpackage_used_by_list" '(T) 'T NIL + NIL) +(DEFSYSFUN '/ "Ldivide" '(T *) 'T NIL NIL) +(DEFSYSFUN 'MAPHASH "Lmaphash" '(T T) 'T NIL NIL) +(DEFSYSFUN 'STRING= "Lstring_eq" '(T T *) 'T NIL T) +(DEFSYSFUN 'PAIRLIS "Lpairlis" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'SYMBOLP "Lsymbolp" '(T) 'T NIL T) +(DEFSYSFUN 'CHAR-NOT-LESSP "Lchar_not_lessp" '(T *) 'T NIL T) +(DEFSYSFUN '1+ "Lone_plus" '(T) 'T NIL NIL) +(DEFSYSFUN 'BY "Lby" 'NIL 'T NIL NIL) +(DEFSYSFUN 'NSUBST-IF "Lnsubst_if" '(T T T *) 'T NIL NIL) +(DEFSYSFUN 'COPY-LIST "Lcopy_list" '(T) 'T NIL NIL) +(DEFSYSFUN 'TAN "Ltan" '(T) 'T NIL NIL) +(DEFSYSFUN 'SET "Lset" '(T T) 'T NIL NIL) +(DEFSYSFUN 'FUNCTIONP "Lfunctionp" '(T) 'T NIL T) +(DEFSYSFUN 'WRITE-BYTE "Lwrite_byte" '(T T) 'T NIL NIL) +(DEFSYSFUN 'LAST "Llast" '(T *) 'T NIL NIL) +(DEFSYSFUN 'MAKE-STRING "Lmake_string" '(T *) 'STRING NIL NIL) +(DEFSYSFUN 'CAAAR "Lcaaar" '(T) 'T NIL NIL) +(DEFSYSFUN 'LIST-LENGTH "Llist_length" '(T) 'T NIL NIL) +(DEFSYSFUN 'CDDDR "Lcdddr" '(T) 'T NIL NIL) +(DEFSYSFUN 'PRIN1 "Lprin1" '(T *) 'T NIL NIL) +(DEFSYSFUN 'PRINC "Lprinc" '(T *) 'T NIL NIL) +(DEFSYSFUN 'LOWER-CASE-P "Llower_case_p" '(T) 'T NIL T) +(DEFSYSFUN 'CHAR<= "Lchar_le" '(T *) 'T NIL T) +(DEFSYSFUN 'STRING-EQUAL "Lstring_equal" '(T T *) 'T NIL T) +(DEFSYSFUN 'CLEAR-OUTPUT "Lclear_output" '(*) 'T NIL NIL) +#-clcs (DEFSYSFUN 'CERROR "Lcerror" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'TERPRI "Lterpri" '(*) 'T NIL NIL) +(DEFSYSFUN 'NSUBST "Lnsubst" '(T T T *) 'T NIL NIL) +(DEFSYSFUN 'UNUSE-PACKAGE "Lunuse_package" '(T *) 'T NIL NIL) +(DEFSYSFUN 'STRING-NOT-GREATERP "Lstring_not_greaterp" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'STRING> "Lstring_g" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'FINISH-OUTPUT "Lfinish_output" '(*) 'T NIL NIL) +(DEFSYSFUN 'SPECIAL-OPERATOR-P "Lspecial_operator_p" '(T) 'T NIL T) +(DEFSYSFUN 'STRINGP "Lstringp" '(T) 'T NIL T) +(DEFSYSFUN 'GET-INTERNAL-RUN-TIME "Lget_internal_run_time" 'NIL 'T NIL + NIL) +(DEFSYSFUN 'TRUNCATE "Ltruncate" '(T *) '(VALUES T T) NIL NIL) +(DEFSYSFUN 'CODE-CHAR "Lcode_char" '(T *) 'CHARACTER NIL NIL) +(DEFSYSFUN 'CHAR-CODE "Lchar_code" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'SIMPLE-STRING-P "Lsimple_string_p" '(T) 'T NIL T) +(DEFSYSFUN 'REVAPPEND "Lrevappend" '(T T) 'T NIL NIL) +(DEFSYSFUN 'HASH-TABLE-COUNT "Lhash_table_count" '(T) 'T NIL NIL) +(DEFSYSFUN 'PACKAGE-USE-LIST "Lpackage_use_list" '(T) 'T NIL NIL) +(DEFSYSFUN 'REM "Lrem" '(T T) 'T NIL NIL) +(DEFSYSFUN 'MIN "Lmin" '(T *) 'T NIL NIL) +(DEFSYSFUN 'APPLYHOOK "Lapplyhook" '(T T T T *) 'T NIL NIL) +(DEFSYSFUN 'EXP "Lexp" '(T) 'T NIL NIL) +(DEFSYSFUN 'CHAR-LESSP "Lchar_lessp" '(T *) 'T NIL T) +(DEFSYSFUN 'CDAR "Lcdar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CADR "Lcadr" '(T) 'T NIL NIL) +(DEFSYSFUN 'LIST-ALL-PACKAGES "Llist_all_packages" 'NIL 'T NIL NIL) +(DEFSYSFUN 'REST "Lcdr" '(T) 'T NIL NIL) +(DEFSYSFUN 'COPY-SYMBOL "Lcopy_symbol" '(T *) 'T NIL NIL) +(DEFSYSFUN 'ACONS "Lacons" '(T T T) 'T NIL NIL) +(DEFSYSFUN 'ADJUSTABLE-ARRAY-P "Ladjustable_array_p" '(T) 'T NIL T) +(DEFSYSFUN 'SVREF "Lsvref" '(T T) 'T NIL NIL) +(DEFSYSFUN 'APPLY "Lapply" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'DECODE-FLOAT "Ldecode_float" '(T) '(VALUES T T T) NIL NIL) +;(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) +(DEFSYSFUN 'RPLACA "Lrplaca" '(T T) 'T NIL NIL) +(DEFSYSFUN 'SYMBOL-PLIST "Lsymbol_plist" '(T) 'T NIL NIL) +(DEFSYSFUN 'WRITE-STRING "Lwrite_string" '(T *) 'T NIL NIL) +(DEFSYSFUN 'LOGEQV "Llogeqv" '(*) 'T NIL NIL) +(DEFSYSFUN 'STRING "Lstring" '(T) 'STRING NIL NIL) +(DEFSYSFUN 'STRING-UPCASE "Lstring_upcase" '(T *) 'STRING NIL NIL) +(DEFSYSFUN 'CEILING "Lceiling" '(T *) '(VALUES T T) NIL NIL) +;(DEFSYSFUN 'GETHASH "Lgethash" '(T T *) '(VALUES T T) NIL NIL) +(DEFSYSFUN 'TYPE-OF "Ltype_of" '(T) 'T NIL NIL) +(DEFSYSFUN 'BUTLAST "Lbutlast" '(T *) 'T NIL NIL) +(DEFSYSFUN '1- "Lone_minus" '(T) 'T NIL NIL) +;(DEFSYSFUN 'MAKE-HASH-TABLE "Lmake_hash_table" '(*) 'T NIL NIL) +(DEFSYSFUN 'STRING/= "Lstring_neq" '(T T *) 'T NIL NIL) +(DEFSYSFUN '<= "Lmonotonically_nondecreasing" '(T *) 'T NIL T) +(DEFSYSFUN 'MAKE-BROADCAST-STREAM "Lmake_broadcast_stream" '(*) 'T NIL + NIL) +(DEFSYSFUN 'IMAGPART "Limagpart" '(T) 'T NIL NIL) +(DEFSYSFUN 'INTEGERP "Lintegerp" '(T) 'T NIL T) +(DEFSYSFUN 'READ-CHAR "Lread_char" '(*) 'T NIL NIL) +(DEFSYSFUN 'PEEK-CHAR "Lpeek_char" '(*) 'T NIL NIL) +(DEFSYSFUN 'CHAR-FONT "Lchar_font" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'STRING-GREATERP "Lstring_greaterp" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'OUTPUT-STREAM-P "Loutput_stream_p" '(T) 'T NIL T) +(DEFSYSFUN 'ASH "Lash" '(T T) 'T NIL NIL) +(DEFSYSFUN 'LCM "Llcm" '(T *) 'T NIL NIL) +(DEFSYSFUN 'ELT "Lelt" '(T T) 'T NIL NIL) +(DEFSYSFUN 'COS "Lcos" '(T) 'T NIL NIL) +(DEFSYSFUN 'NSTRING-DOWNCASE "Lnstring_downcase" '(T *) 'STRING NIL + NIL) +(DEFSYSFUN 'COPY-ALIST "Lcopy_alist" '(T) 'T NIL NIL) +(DEFSYSFUN 'ATAN "Latan" '(T *) 'T NIL NIL) +(DEFSYSFUN 'FLOAT-RADIX "Lfloat_radix" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'SYMBOL-NAME "Lsymbol_name" '(T) 'STRING NIL NIL) +(DEFSYSFUN 'CLEAR-INPUT "Lclear_input" '(*) 'T NIL NIL) +(DEFSYSFUN 'FIND-SYMBOL "Lfind_symbol" '(T *) '(VALUES T T) NIL NIL) +(DEFSYSFUN 'CHAR< "Lchar_l" '(T *) 'T NIL T) +(DEFSYSFUN 'HASH-TABLE-P "Lhash_table_p" '(T) 'T NIL T) +(DEFSYSFUN 'EVENP "Levenp" '(T) 'T NIL T) +(DEFSYSFUN 'SYSTEM::CMOD "siLcmod" '(T) 'T NIL T) +(DEFSYSFUN 'SYSTEM::CPLUS "siLcplus" '(T T) 'T NIL T) +(DEFSYSFUN 'SYSTEM::CTIMES "siLctimes" '(T T) 'T NIL T) +(DEFSYSFUN 'SYSTEM::CDIFFERENCE "siLcdifference" '(T T) 'T NIL T) +(DEFSYSFUN 'ZEROP "Lzerop" '(T) 'T NIL T) +(DEFSYSFUN 'CAAAAR "Lcaaaar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CHAR>= "Lchar_ge" '(T *) 'T NIL T) +(DEFSYSFUN 'CDDDAR "Lcdddar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CDDADR "Lcddadr" '(T) 'T NIL NIL) +(DEFSYSFUN 'CDADDR "Lcdaddr" '(T) 'T NIL NIL) +(DEFSYSFUN 'CADDDR "Lcadddr" '(T) 'T NIL NIL) +(DEFSYSFUN 'FILL-POINTER "Lfill_pointer" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'MAPCAR "Lmapcar" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'FLOATP "Lfloatp" '(T) 'T NIL T) +(DEFSYSFUN 'SHADOW "Lshadow" '(T *) 'T NIL NIL) +(DEFSYSFUN 'MACROEXPAND-1 "Lmacroexpand_1" '(T *) '(VALUES T T) NIL + NIL) +(DEFSYSFUN 'SXHASH "Lsxhash" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'LISTEN "Llisten" '(*) 'T NIL NIL) +(DEFSYSFUN 'ARRAYP "Larrayp" '(T) 'T NIL T) +(DEFSYSFUN 'FUNCALL "Lfuncall" '(T *) 'T NIL NIL) +(DEFSYSFUN 'CLRHASH "Lclrhash" '(T) 'T NIL NIL) +(DEFSYSFUN 'GRAPHIC-CHAR-P "Lgraphic_char_p" '(T) 'T NIL T) +(DEFSYSFUN 'FBOUNDP "Lfboundp" '(T) 'T NIL T) +(DEFSYSFUN 'NSUBLIS "Lnsublis" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'CHAR-NOT-EQUAL "Lchar_not_equal" '(T *) 'T NIL T) +(DEFSYSFUN 'MACRO-FUNCTION "Lmacro_function" '(T) 'T NIL NIL) +;(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) +(DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) +(DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) +(DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) +(DEFSYSFUN 'IN-PACKAGE "Lin_package" '(T *) 'T NIL NIL) +(DEFSYSFUN 'READTABLEP "Lreadtablep" '(T) 'T NIL T) +(DEFSYSFUN 'FLOAT-SIGN "Lfloat_sign" '(T *) 'T NIL NIL) +(DEFSYSFUN 'CHARACTERP "Lcharacterp" '(T) 'T NIL T) +(DEFSYSFUN 'READ "Lread" '(*) 'T NIL NIL) +(DEFSYSFUN 'UNREAD-CHAR "Lunread_char" '(T *) 'T NIL NIL) +(DEFSYSFUN 'CDAAR "Lcdaar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CADAR "Lcadar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CAADR "Lcaadr" '(T) 'T NIL NIL) +(DEFSYSFUN 'CHAR= "Lchar_eq" '(T *) 'T NIL T) +(DEFSYSFUN 'ALPHA-CHAR-P "Lalpha_char_p" '(T) 'T NIL T) +(DEFSYSFUN 'STRING-TRIM "Lstring_trim" '(T T) 'STRING NIL NIL) +(DEFSYSFUN 'MAKE-PACKAGE "Lmake_package" '(T *) 'T NIL NIL) +(DEFSYSFUN 'CLOSE "Lclose" '(T *) 'T NIL NIL) +(DEFSYSFUN 'DENOMINATOR "Ldenominator" '(T) 'T NIL NIL) +(DEFSYSFUN 'FLOAT "Lfloat" '(T *) 'T NIL NIL) +;(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) +(DEFSYSFUN 'ROUND "Lround" '(T *) '(VALUES T T) NIL NIL) +;(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) +(DEFSYSFUN 'UPPER-CASE-P "Lupper_case_p" '(T) 'T NIL T) +(DEFSYSFUN 'ARRAY-ELEMENT-TYPE "Larray_element_type" '(T) 'T NIL NIL) +(DEFSYSFUN 'ADJOIN "Ladjoin" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'LOGAND "Llogand" '(*) 'T NIL NIL) +(DEFSYSFUN 'MAPCON "Lmapcon" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'INTERN "Lintern" '(T *) '(VALUES T T) NIL NIL) +(DEFSYSFUN 'VALUES "Lvalues" '(*) '* NIL NIL) +(DEFSYSFUN 'EXPORT "Lexport" '(T *) 'T NIL NIL) +(DEFSYSFUN '* "Ltimes" '(*) 'T NIL NIL) +(DEFSYSFUN '< "Lmonotonically_increasing" '(T *) 'T NIL T) +(DEFSYSFUN 'COMPLEX "Lcomplex" '(T *) 'T NIL NIL) +(DEFSYSFUN 'SET-SYNTAX-FROM-CHAR "Lset_syntax_from_char" '(T T *) 'T + NIL NIL) +(DEFSYSFUN 'CHAR-BIT "Lchar_bit" '(T T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'INTEGER-LENGTH "Linteger_length" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'PACKAGEP "Lpackagep" '(T) 'T NIL T) +(DEFSYSFUN 'INPUT-STREAM-P "Linput_stream_p" '(T) 'T NIL T) +(DEFSYSFUN '>= "Lmonotonically_nonincreasing" '(T *) 'T NIL T) +;(DEFSYSFUN 'EQ "Leq" '(T T) 'T NIL T) +(DEFSYSFUN 'MAKE-CHAR "Lmake_char" '(T *) 'CHARACTER NIL NIL) +(DEFSYSFUN 'CHARACTER "Lcharacter" '(T) 'CHARACTER NIL NIL) +(DEFSYSFUN 'SYMBOL-FUNCTION "Lsymbol_function" '(T) 'T NIL NIL) +(DEFSYSFUN 'CONSTANTP "Lconstantp" '(T) 'T NIL T) +(DEFSYSFUN 'CHAR-EQUAL "Lchar_equal" '(T *) 'T NIL T) +(DEFSYSFUN 'TREE-EQUAL "Ltree_equal" '(T T *) 'T NIL T) +(DEFSYSFUN 'CDDR "Lcddr" '(T) 'T NIL NIL) +(DEFSYSFUN 'GETF "Lgetf" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'SAVE "Lsave" '(T) 'T NIL NIL) +(DEFSYSFUN 'MAKE-RANDOM-STATE "Lmake_random_state" '(*) 'T NIL NIL) +(DEFSYSFUN 'CHAR-NOT-GREATERP "Lchar_not_greaterp" '(T *) 'T NIL T) +(DEFSYSFUN 'EXPT "Lexpt" '(T T) 'T NIL NIL) +(DEFSYSFUN 'SQRT "Lsqrt" '(T) 'T NIL NIL) +(DEFSYSFUN 'SCALE-FLOAT "Lscale_float" '(T T) 'T NIL NIL) +(DEFSYSFUN 'CHAR> "Lchar_g" '(T *) 'T NIL T) +(DEFSYSFUN 'LDIFF "Lldiff" '(T T) 'T NIL NIL) +(DEFSYSFUN 'ASSOC-IF-NOT "Lassoc_if_not" '(T T) 'T NIL NIL) +(DEFSYSFUN 'BIT-VECTOR-P "Lbit_vector_p" '(T) 'T NIL T) +(DEFSYSFUN 'NSTRING-CAPITALIZE "Lnstring_capitalize" '(T *) 'STRING NIL + NIL) +(DEFSYSFUN 'SYMBOL-VALUE "Lsymbol_value" '(T) 'T NIL NIL) +(DEFSYSFUN 'RPLACD "Lrplacd" '(T T) 'T NIL NIL) +(DEFSYSFUN 'BOUNDP "Lboundp" '(T) 'T NIL T) +;(DEFSYSFUN 'EQUALP "Lequalp" '(T T) 'T NIL T) +(DEFSYSFUN 'SIMPLE-BIT-VECTOR-P "Lsimple_bit_vector_p" '(T) 'T NIL T) +(DEFSYSFUN 'MEMBER-IF-NOT "Lmember_if_not" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'MAKE-TWO-WAY-STREAM "Lmake_two_way_stream" '(T T) 'T NIL + NIL) +(DEFSYSFUN 'PARSE-INTEGER "Lparse_integer" '(T *) 'T NIL NIL) +(DEFSYSFUN '+ "Lplus" '(*) 'T NIL NIL) +(DEFSYSFUN '= "Lall_the_same" '(T *) 'T NIL T) +(DEFSYSFUN 'GENTEMP "Lgentemp" '(*) 'T NIL NIL) +(DEFSYSFUN 'RENAME-PACKAGE "Lrename_package" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'COMMONP "siLcommonp" '(T) 'T NIL T) +(DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T) +(DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL) +(DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T) +(DEFSYSFUN 'STANDARD-CHAR-P "Lstandard_char_p" '(T) 'T NIL T) +(DEFSYSFUN 'IDENTITY "Lidentity" '(T) 'T NIL NIL) +(DEFSYSFUN 'NREVERSE "Lnreverse" '(T) 'T NIL NIL) +(DEFSYSFUN 'UNINTERN "Lunintern" '(T *) 'T NIL NIL) +(DEFSYSFUN 'UNEXPORT "Lunexport" '(T *) 'T NIL NIL) +(DEFSYSFUN 'FLOAT-PRECISION "Lfloat_precision" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'STRING-DOWNCASE "Lstring_downcase" '(T *) 'STRING NIL NIL) +(DEFSYSFUN 'CAR "Lcar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CONJUGATE "Lconjugate" '(T) 'T NIL NIL) +(DEFSYSFUN 'NOT "Lnull" '(T) 'T NIL T) +(DEFSYSFUN 'READ-CHAR-NO-HANG "Lread_char_no_hang" '(*) 'T NIL NIL) +(DEFSYSFUN 'FRESH-LINE "Lfresh_line" '(*) 'T NIL NIL) +(DEFSYSFUN 'WRITE-CHAR "Lwrite_char" '(T *) 'T NIL NIL) +;(DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) +(DEFSYSFUN 'STRING-NOT-LESSP "Lstring_not_lessp" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'CHAR "Lchar" '(T T) 'CHARACTER NIL NIL) +(DEFSYSFUN 'AREF "Laref" '(T *) 'T NIL NIL) +(DEFSYSFUN 'PACKAGE-NICKNAMES "Lpackage_nicknames" '(T) 'T NIL NIL) +(DEFSYSFUN 'ENDP "Lendp" '(T) 'T NIL T) +(DEFSYSFUN 'ODDP "Loddp" '(T) 'T NIL T) +(DEFSYSFUN 'CHAR-UPCASE "Lchar_upcase" '(T) 'CHARACTER NIL NIL) +(DEFSYSFUN 'LIST* "LlistA" '(T *) 'T NIL NIL) +(DEFSYSFUN 'VALUES-LIST "Lvalues_list" '(T) '* NIL NIL) +;(DEFSYSFUN 'EQUAL "Lequal" '(T T) 'T NIL T) +(DEFSYSFUN 'DIGIT-CHAR-P "Ldigit_char_p" '(T *) 'T NIL NIL) +;; #-clcs (DEFSYSFUN 'ERROR "Lerror" '(T *) 'T NIL NIL) +(DEFSYSFUN 'CHAR/= "Lchar_neq" '(T *) 'T NIL T) +(DEFSYSFUN 'CDAAAR "Lcdaaar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CADAAR "Lcadaar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CAADAR "Lcaadar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CAAADR "Lcaaadr" '(T) 'T NIL NIL) +(DEFSYSFUN 'CDDDDR "Lcddddr" '(T) 'T NIL NIL) +(DEFSYSFUN 'GET-MACRO-CHARACTER "Lget_macro_character" '(T *) 'T NIL + NIL) +(DEFSYSFUN 'FORMAT "Lformat" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'COMPILED-FUNCTION-P "Lcompiled_function_p" '(T) 'T NIL T) +(DEFSYSFUN 'SUBLIS "Lsublis" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'IMPORT "Limport" '(T *) 'T NIL NIL) +(DEFSYSFUN 'LOGXOR "Llogxor" '(*) 'T NIL NIL) +(DEFSYSFUN 'RASSOC-IF-NOT "Lrassoc_if_not" '(T T) 'T NIL NIL) +(DEFSYSFUN 'CHAR-GREATERP "Lchar_greaterp" '(T *) 'T NIL T) +(DEFSYSFUN 'MAKE-SYNONYM-STREAM "Lmake_synonym_stream" '(T) 'T NIL NIL) +(DEFSYSFUN 'ALPHANUMERICP "Lalphanumericp" '(T) 'T NIL T) +(DEFSYSFUN 'REMHASH "Lremhash" '(T T) 'T NIL NIL) +(DEFSYSFUN 'NRECONC "Lreconc" '(T T) 'T NIL NIL) +(DEFSYSFUN '> "Lmonotonically_decreasing" '(T *) 'T NIL T) +(DEFSYSFUN 'LOGBITP "Llogbitp" '(T T) 'T NIL T) +(DEFSYSFUN 'MAPLIST "Lmaplist" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'VECTORP "Lvectorp" '(T) 'T NIL T) +(DEFSYSFUN 'ASSOC-IF "Lassoc_if" '(T T) 'T NIL NIL) +(DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) +(DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL) +(DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL) +(DEFSYSFUN 'MEMBER-IF "Lmember_if" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'READ-BYTE "Lread_byte" '(T *) 'T NIL NIL) +(DEFSYSFUN 'SIMPLE-VECTOR-P "Lsimple_vector_p" '(T) 'T NIL T) +(DEFSYSFUN 'CHAR-BITS "Lchar_bits" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'COPY-TREE "Lcopy_tree" '(T) 'T NIL NIL) +(DEFSYSFUN 'GCD "Lgcd" '(*) 'T NIL NIL) +(DEFSYSFUN 'BYE "Lby" 'NIL 'T NIL NIL) +;(DEFSYSFUN 'QUIT "Lquit" 'NIL 'T NIL NIL) +;(DEFSYSFUN 'EXIT "Lexit" 'NIL 'T NIL NIL) +(DEFSYSFUN 'GET "Lget" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'MOD "Lmod" '(T T) 'T NIL NIL) +(DEFSYSFUN 'DIGIT-CHAR "Ldigit_char" '(T *) 'CHARACTER NIL NIL) +(DEFSYSFUN 'STRING-LEFT-TRIM "Lstring_left_trim" '(T T) 'STRING NIL + NIL) +(DEFSYSFUN 'WRITE-LINE "Lwrite_line" '(T *) 'T NIL NIL) +(DEFSYSFUN 'EVAL "Leval" '(T) 'T NIL NIL) +(DEFSYSFUN 'ATOM "Latom" '(T) 'T NIL T) +(DEFSYSFUN 'CDDAR "Lcddar" '(T) 'T NIL NIL) +(DEFSYSFUN 'CDADR "Lcdadr" '(T) 'T NIL NIL) +(DEFSYSFUN 'CADDR "Lcaddr" '(T) 'T NIL NIL) +(DEFSYSFUN 'FMAKUNBOUND "Lfmakunbound" '(T) 'T NIL NIL) +(DEFSYSFUN 'SLEEP "Lsleep" '(T) 'T NIL NIL) +(DEFSYSFUN 'PACKAGE-NAME "Lpackage_name" '(T) 'T NIL NIL) +;(DEFSYSFUN 'FIND-PACKAGE "Lfind_package" '(T) 'T NIL NIL) +(DEFSYSFUN 'ASSOC "Lassoc" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'SET-CHAR-BIT "Lset_char_bit" '(T T T) 'CHARACTER NIL NIL) +(DEFSYSFUN 'FLOOR "Lfloor" '(T *) '(VALUES T T) NIL NIL) +(DEFSYSFUN 'WRITE "Lwrite" '(T *) 'T NIL NIL) +(DEFSYSFUN 'PLUSP "Lplusp" '(T) 'T NIL T) +(DEFSYSFUN 'FLOAT-DIGITS "Lfloat_digits" '(T) 'FIXNUM NIL NIL) +(DEFSYSFUN 'READ-DELIMITED-LIST "Lread_delimited_list" '(T *) 'T NIL + NIL) +(DEFSYSFUN 'APPEND "Lappend" '(*) 'T NIL NIL) +(DEFSYSFUN 'MEMBER "Lmember" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'STRING-LESSP "Lstring_lessp" '(T T *) 'T NIL NIL) +(DEFSYSFUN 'RANDOM "Lrandom" '(T *) 'T NIL NIL) +(DEFSYSFUN 'SYSTEM::SPECIALP "siLspecialp" '(T) 'T NIL T) +(DEFSYSFUN 'SYSTEM::OUTPUT-STREAM-STRING "siLoutput_stream_string" '(T) + 'T NIL NIL) +;#-clcs (DEFSYSFUN 'SYSTEM::ERROR-SET "siLerror_set" '(T) '* NIL NIL) +(DEFSYSFUN 'SYSTEM::STRUCTUREP "siLstructurep" '(T) 'T NIL T) +(DEFSYSFUN 'SYSTEM::COPY-STREAM "siLcopy_stream" '(T T) 'T NIL NIL) +(DEFSYSFUN 'SYSTEM::INIT-SYSTEM "siLinit_system" 'NIL 'T NIL NIL) +(DEFSYSFUN 'SYSTEM::STRING-TO-OBJECT "siLstring_to_object" '(T) 'T NIL + NIL) +(DEFSYSFUN 'SYSTEM::RESET-STACK-LIMITS "siLreset_stack_limits" 'NIL 'T + NIL NIL) +(DEFSYSFUN 'SYSTEM::DISPLACED-ARRAY-P "siLdisplaced_array_p" '(T) 'T NIL + T) +(DEFSYSFUN 'SYSTEM::RPLACA-NTHCDR "siLrplaca_nthcdr" NIL T NIL NIL) +(DEFSYSFUN 'SYSTEM::LIST-NTH "siLlist_nth" NIL T NIL NIL) +;(DEFSYSFUN 'SYSTEM::MAKE-PURE-ARRAY "siLmake_pure_array" NIL T NIL NIL) +(DEFSYSFUN 'SYSTEM::MAKE-VECTOR "siLmake_vector" NIL 'VECTOR NIL NIL) +;(DEFSYSFUN 'SYSTEM::ARRAY-DISPLACEMENT "siLarray_displacement" NIL T NIL NIL) +(DEFSYSFUN 'SYSTEM::ASET "siLaset" '(ARRAY *) NIL NIL NIL) +(DEFSYSFUN 'SYSTEM::SVSET "siLsvset" '(SIMPLE-VECTOR FIXNUM T) T NIL + NIL) +(DEFSYSFUN 'SYSTEM::FILL-POINTER-SET "siLfill_pointer_set" + '(VECTOR FIXNUM) 'FIXNUM NIL NIL) +(DEFSYSFUN 'SYSTEM::REPLACE-ARRAY "siLreplace_array" NIL T NIL NIL) +(DEFSYSFUN 'SYSTEM::FSET "siLfset" '(SYMBOL T) NIL NIL NIL) +;(DEFSYSFUN 'SYSTEM::HASH-SET "siLhash_set" NIL T NIL NIL) +(DEFSYSFUN 'BOOLE3 "Lboole" NIL T NIL NIL) +(DEFSYSFUN 'SYSTEM::PACKAGE-INTERNAL "siLpackage_internal" NIL T NIL + NIL) +(DEFSYSFUN 'SYSTEM::PACKAGE-EXTERNAL "siLpackage_external" NIL T NIL + NIL) +(DEFSYSFUN 'SYSTEM::ELT-SET "siLelt_set" '(SEQUENCE FIXNUM T) T NIL NIL) +(DEFSYSFUN 'SYSTEM::CHAR-SET "siLchar_set" '(STRING FIXNUM CHARACTER) + 'CHARACTER NIL NIL) +(DEFSYSFUN 'SYSTEM::MAKE-STRUCTURE "siLmake_structure" NIL T NIL NIL) +(DEFSYSFUN 'SYSTEM::STRUCTURE-NAME "siLstructure_name" '(T) 'SYMBOL NIL + NIL) +;; (DEFSYSFUN 'SYSTEM::STRUCTURE-REF "siLstructure_ref" '(T T FIXNUM) T NIL +;; NIL) +;; (DEFSYSFUN 'SYSTEM::STRUCTURE-SET "siLstructure_set" '(T T FIXNUM T) T +;; NIL NIL) +(DEFSYSFUN 'SYSTEM::PUT-F "siLput_f" NIL '(T T) NIL NIL) +(DEFSYSFUN 'SYSTEM::REM-F "siLrem_f" NIL '(T T) NIL NIL) +(DEFSYSFUN 'SYSTEM::SET-SYMBOL-PLIST "siLset_symbol_plist" '(SYMBOL T) T + NIL NIL) +(DEFSYSFUN 'SI::BIT-ARRAY-OP "siLbit_array_op" NIL T NIL NIL) + +(dolist (l '(eq eql equal equalp ldb-test logtest)) + (setf (get l 'predicate) t)) + + + + diff --git a/cmpnew/gcl_make-fn.lsp b/cmpnew/gcl_make-fn.lsp new file mode 100755 index 0000000..ebff2c2 --- /dev/null +++ b/cmpnew/gcl_make-fn.lsp @@ -0,0 +1,4 @@ +(load (concatenate 'string si::*system-directory* "../cmpnew/gcl_collectfn")) +(compiler::emit-fn t) + + diff --git a/cmpnew/gcl_make_ufun.lsp b/cmpnew/gcl_make_ufun.lsp new file mode 100755 index 0000000..93865f8 --- /dev/null +++ b/cmpnew/gcl_make_ufun.lsp @@ -0,0 +1,86 @@ +;;; MAKE_UFUN Makes Ufun list for user-defined functions. +;;; +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + + +(in-package :compiler) + +(defvar gazonk (make-package 'symbol-table :use nil)) +(defvar eof (cons nil nil)) +(defvar *Ufun-out*) + +(defvar *str* (make-array 128 :element-type 'character :fill-pointer 0)) + +(defun make-Ufun (in-files &key (out-file "Ufun_list.lsp")) + (with-open-file (*Ufun-out* out-file :direction :output) + (print '(in-package "COMPILER") *Ufun-out*) + (dolist (file in-files) + (with-open-file (in (merge-pathnames file #".lsp")) + (loop (when (eq (setq form (read in nil eof)) eof) (return)) + (do-form form)))))) + +(defun do-form (form) + (when (consp form) + (case (car form) + (defun + (let ((*package* (find-package 'compiler))) + (print `(si:putprop + ',(cadr form) + ,(get-cname (cadr form)) + 'Ufun) + *Ufun-out*)) + (eval form)) + (progn (mapc #'do-form (cdr form))) + (eval-when + (if (member 'load (cadr form)) + (mapc #'do-form (cddr form)) + (if (member 'compile (cadr form)) + (mapc #'eval (cddr form))))) + (t + (if (macro-function (car form)) + (do-form (macroexpand-1 form)) + (eval form)))))) + +(defun get-cname (symbol &aux (name (symbol-name symbol))) + (setf (fill-pointer *str*) 0) + (vector-push #\U *str*) + (dotimes (n (length name)) + (let ((char (schar name n))) + (cond ((alphanumericp char) + (vector-push (char-downcase char) *str*)) + ((char= char #\-) (vector-push #\_ *str*)) + ((char= char #\*) (vector-push #\A *str*)) + ))) + (multiple-value-bind (foo flag) (find-symbol *str* 'symbol-table) + (unless flag + ;(setq foo (intern (copy-seq *str*) 'symbol-table)) + (setq foo (intern *str* 'symbol-table)) + ;(set foo nil) + (return-from get-cname *str*)) + (gensym *str*) + (gensym 0) + (loop + (setq name (symbol-name (gensym))) + (multiple-value-bind (foo flag1) + (intern name 'symbol-table) + (unless flag1 + ;(set foo nil) + (return-from get-cname name))))) + ) diff --git a/cmpnew/gcl_nocmpinc.lsp b/cmpnew/gcl_nocmpinc.lsp new file mode 100755 index 0000000..4544acb --- /dev/null +++ b/cmpnew/gcl_nocmpinc.lsp @@ -0,0 +1,23 @@ + + +(in-package :compiler) + +(defvar *cmpinclude-string* nil) + +(defun write-out-cmpinclude (stream string) + (do ((i 0 (setq i (the fixnum (+ i 1)))) + (l (length *cmpinclude-string*))) + ((>= i l)) + (declare (fixnum i l)) + (or string (setq string *cmpinclude-string*)) + (or string (error "need a string")) + (let ((tem (aref (the string string i)))) + (declare (character tem)) + (write-char tem stream)))) + + + + + + + diff --git a/cmpnew/makefile b/cmpnew/makefile new file mode 100644 index 0000000..dcca963 --- /dev/null +++ b/cmpnew/makefile @@ -0,0 +1,66 @@ + +.SUFFIXES: +.SUFFIXES: .o .c .lsp .lisp .fn + +-include ../makedefs + +PORTDIR = ../unixport +CAT=cat +APPEND=../xbin/append + +OBJS = gcl_cmpbind.o gcl_cmpblock.o gcl_cmpcall.o gcl_cmpcatch.o gcl_cmpenv.o gcl_cmpeval.o \ + gcl_cmpflet.o gcl_cmpfun.o gcl_cmpif.o gcl_cmpinline.o gcl_cmplabel.o gcl_cmplam.o gcl_cmplet.o \ + gcl_cmploc.o gcl_cmpmap.o gcl_cmpmulti.o gcl_cmpspecial.o gcl_cmptag.o gcl_cmptop.o \ + gcl_cmptype.o gcl_cmputil.o gcl_cmpvar.o gcl_cmpvs.o gcl_cmpwt.o gcl_cmpmain.o #gcl_cmpopt.o gcl_lfun_list.o + +FNS:= $(OBJS:.o=.fn) + +LISP=$(PORTDIR)/saved_pre_gcl$(EXE) +COMPILE_FILE=$(LISP) $(PORTDIR) -system-p -c-file -data-file -h-file -compile + +%.o: $(PORTDIR)/saved_pre_gcl$(EXE) %.lsp + $(COMPILE_FILE) $* + +all: $(OBJS) + +.lsp.fn: ../cmpnew/gcl_collectfn.o + ../xbin/make-fn $*.lsp $(LISP) + +fns1: $(FNS) + +fns: ../cmpnew/gcl_collectfn.o + $(MAKE) fns1 -e "FNS=`echo ${OBJS} | sed -e 's:\.o:\.fn:g'`" + +gcl_collectfn.o: + $(PORTDIR)/saved_pre_gcl$(EXE) $(PORTDIR)/ -compile $*.lsp + +.lisp.o: + @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl$(EXE) \ + "$(PORTDIR)/saved_pre_gcl$(EXE) $(PORTDIR)/ -compile $*.lisp " + +sys-proclaim.lisp: fns + echo '(in-package "COMPILER")' \ + '(load "../cmpnew/gcl_collectfn")(load "../lsp/sys-proclaim.lisp")'\ + '(compiler::make-all-proclaims "*.fn")' | ../xbin/gcl + + +newfn: + $(MAKE) `echo $(OBJS) | sed -e 's:\.o:.fn:g'` + + + +remake: + for v in `"ls" *.lsp.V | sed -e "s:\.lsp\.V::g"` ; \ + do rm -f $$v.c $$v.h $$v.data $$v.lsp $$v.o ; \ + ln -s $(MAINDIR)/cmpnew/$$v.c . ; ln -s $(MAINDIR)/cmpnew/$$v.h . ; \ + ln -s $(MAINDIR)/cmpnew/$$v.data . ; \ + done + rm -f ../unixport/$(FLISP) + (cd .. ; $(MAKE) sources) + (cd .. ; $(MAKE)) + (cd .. ; $(MAKE)) + +clean: + rm -f *.o core a.out *.fn *.c *.data *.h +allclean: + rm -f *.h *.data *.c diff --git a/cmpnew/so_locations b/cmpnew/so_locations new file mode 100755 index 0000000..142f563 --- /dev/null +++ b/cmpnew/so_locations @@ -0,0 +1,4 @@ +collectfn.o \ + :st = .text 0x000000005ffe0000, 0x0000000000010000:\ + :st = .data 0x000000005fff0000, 0x0000000000010000:\ + diff --git a/cmpnew/sys-proclaim.lisp b/cmpnew/sys-proclaim.lisp new file mode 100644 index 0000000..89be8e4 --- /dev/null +++ b/cmpnew/sys-proclaim.lisp @@ -0,0 +1,411 @@ + +(COMMON-LISP::IN-PACKAGE "COMPILER") +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) + COMPILER::WT-CHARACTER-LOC COMPILER::T1EXPR COMPILER::C2PROGN + COMPILER::WT-TO-STRING COMPILER::CMP-EVAL + COMPILER::WT-FIXNUM-LOC COMPILER::T1EVAL-WHEN + COMPILER::MEXPAND-DEFTYPE COMPILER::SET-LOC COMPILER::C2OR + COMPILER::C2AND COMPILER::WT-LOC COMPILER::CMP-TOPLEVEL-EVAL + COMPILER::WT-LONG-FLOAT-LOC COMPILER::WT-SHORT-FLOAT-LOC + COMPILER::C2EXPR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) + COMPILER::MAKE-VAR COMPILER::C2FSET COMPILER::CS-PUSH + COMPILER::MAKE-FUN COMPILER::LIST-INLINE COMPILER::WT-CLINK + COMPILER::FCALLN-INLINE COMPILER::MAKE-INFO COMPILER::MAKE-TAG + COMPILER::LIST*-INLINE COMPILER::MAKE-BLK + COMPILER::COMPILER-COMMAND)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) + COMPILER::PUSH-ARRAY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) + COMPILER::BSEARCHLEQ)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) + COMPILER::WT-FIRST-VAR-ARG COMPILER::CLOSE-INLINE-BLOCKS + COMPILER::WT-DATA-END COMPILER::CCB-VS-PUSH + COMPILER::INC-INLINE-BLOCKS COMPILER::CVS-PUSH COMPILER::C1NIL + COMPILER::MACRO-ENV COMPILER::WT-C-PUSH + COMPILER::TAIL-RECURSION-POSSIBLE COMPILER::VS-PUSH + COMPILER::WT-CVARS COMPILER::RESET-TOP COMPILER::WT-DATA-BEGIN + COMPILER::WFS-ERROR COMPILER::PRINT-CURRENT-FORM + COMPILER::INIT-ENV COMPILER::BABOON COMPILER::WT-NEXT-VAR-ARG + COMPILER::GAZONK-NAME COMPILER::ADD-LOAD-TIME-SHARP-COMMA + COMPILER::WT-DATA-FILE COMPILER::PRINT-COMPILER-INFO + COMPILER::C1T)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + COMPILER::GET-INLINE-LOC SYSTEM::ADD-DEBUG COMPILER::FAST-READ + COMPILER::WT-GO COMPILER::MAKE-USER-INIT COMPILER::C2THROW + COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-CFUN + COMPILER::TYPE>= COMPILER::C2DM-BIND-INIT + COMPILER::NCONC-FILES COMPILER::DO-CHANGED COMPILER::BASE-USED + COMPILER::COERCE-LOC COMPILER::NEXT-LABEL* + COMPILER::PUSH-CHANGED COMPILER::C2DM-BIND-VL + COMPILER::WT-FIXNUM-VALUE COMPILER::TYPE-AND + COMPILER::CAN-BE-REPLACED SYSTEM::DEFINE-INLINE-FUNCTION + COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::SET-BDS-BIND + COMPILER::NEED-TO-PROTECT COMPILER::COMPILER-BUILD + COMPILER::SAFE-COMPILE COMPILER::C2EXPR-TOP* + COMPILER::IS-REFERRED COMPILER::C1FMLA COMPILER::CK-SPEC + COMPILER::CO1WRITE-BYTE COMPILER::CO1CONSTANT-FOLD + COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::CO1TYPEP + COMPILER::BIGNUM-EXPANSION-STORAGE COMPILER::C1CONSTANT-VALUE + COMPILER::CHANGED-LENGTH COMPILER::UNWIND-BDS + COMPILER::DOTIMES** COMPILER::CO1CONS + COMPILER::CO1STRUCTURE-PREDICATE COMPILER::DO-REFERRED + COMPILER::C2ASSOC!2 COMPILER::NEXT-LABEL + COMPILER::C2CALL-LAMBDA COMPILER::C1PROGN* COMPILER::FLAG-P + COMPILER::CFAST-WRITE COMPILER::T23EXPR + COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::CO1VECTOR-PUSH + COMPILER::WT-LABEL COMPILER::C2CATCH + COMPILER::CHECK-FNAME-ARGS COMPILER::SET-DBIND + COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY COMPILER::SET-VS + COMPILER::C1DECL-BODY COMPILER::C1ARGS + COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::C2RETURN-CCB + COMPILER::IN-ARRAY COMMON-LISP::DEFINE-COMPILER-MACRO + COMPILER::C2APPLY COMPILER::CO1WRITE-CHAR + COMPILER::C2DM-BIND-LOC COMPILER::WT-NL + COMPILER::WT-LONG-FLOAT-VALUE COMPILER::CO1READ-BYTE + COMPILER::REMOVE-FLAG COMPILER::CO1LDB COMPILER::WT-VAR + COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::PUSH-CHANGED-VARS + COMPILER::C2PSETQ COMPILER::SHIFT>> COMPILER::PROCLAIM-VAR + COMPILER::IS-CHANGED COMPILER::ADD-DEBUG-INFO + COMPILER::CO1SUBLIS COMPILER::WT-CHARACTER-VALUE + COMPILER::C2EXPR-TOP COMPILER::WT-REQUIREDS COMPILER::DOTIMES* + COMPILER::PRIN1-CMP COMPILER::PUSH-CHANGED-WITH-START + COMPILER::DOLIST* COMPILER::C2BLOCK-CLB COMPILER::CMPCK + COMPILER::PUSH-REFERRED-WITH-START COMPILER::INLINE-PROC + COMPILER::CK-VL COMPILER::C1EXPR* COMPILER::WT-H + COMPILER::STRUCT-TYPE-OPT COMPILER::C2UNWIND-PROTECT + COMPILER::ARGS-INFO-CHANGED-VARS + COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::SET-JUMP-TRUE + COMPILER::WT-MAKE-DCLOSURE COMPILER::WT-NL1 COMPILER::CO1SCHAR + COMPILER::JUMPS-TO-P COMPILER::DOLIST** + COMPILER::COMPILER-DEF-HOOK COMPILER::NEXT-CMACRO + COMPILER::C2MEMBER!2 COMPILER::RESULT-TYPE-FROM-ARGS + COMPILER::CO1EQL COMPILER::C2CALL-LOCAL + COMPILER::SET-JUMP-FALSE COMPILER::C2MULTIPLE-VALUE-CALL + COMPILER::C2BIND-LOC COMPILER::C1SETQ1 COMPILER::CO1READ-CHAR + COMPILER::REFERRED-LENGTH COMPILER::C2STACK-LET COMPILER::WT + COMPILER::CMPFIX-ARGS COMPILER::NEXT-CVAR + COMPILER::ARGS-INFO-REFERRED-VARS + COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES SYSTEM::SWITCH + COMPILER::COMPILER-CC COMPILER::FLAGS COMPILER::T3SHARP-COMMA + COMPILER::C2SETQ COMPILER::C2RETURN-CLB COMPILER::C1LAMBDA-FUN + COMPILER::C2BLOCK-CCB COMPILER::IS-REP-REFERRED + COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::WT-V*-MACROS + SYSTEM::SWITCH-FINISH COMPILER::STACK-LET COMPILER::SHIFT<< + COMPILER::DO-ARRAY COMPILER::MULTIPLE-VALUE-CHECK + COMPILER::DOWNWARD-FUNCTION COMPILER::EQL-NOT-NIL + COMPILER::ADD-INFO COMPILER::MAYBE-EVAL COMPILER::MIA + COMPILER::PUSH-REFERRED COMPILER::C2BIND-INIT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + COMPILER::COMPILE-FILE1 COMMON-LISP::COMPILE-FILE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) + COMMON-LISP::T) + COMPILER::COPY-ARRAY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::FIXNUM) + COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS + COMPILER::ANALYZE-REGS1)) +(COMMON-LISP::MAPC + (COMMON-LISP::LAMBDA (COMPILER::X) + (COMMON-LISP::SETF + (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) + COMMON-LISP::T)) + '(COMMON-LISP::DISASSEMBLE COMMON-LISP::COMPILE COMPILER::CMP-ANON + COMPILER::CMP-TMP-MACRO)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) + COMPILER::C1DM-VL COMPILER::C2RETURN-FROM COMPILER::C2DM + COMPILER::C1DM-V COMPILER::C2APPLY-OPTIMIZE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + COMPILER::T3DEFUN-AUX)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + COMPILER::C2IF COMPILER::WT-INLINE COMPILER::C2FLET + COMPILER::C2LABELS COMPILER::C2COMPILER-LET)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER + COMMON-LISP::*)) + COMMON-LISP::T) + COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + COMPILER::C2BLOCK-LOCAL COMPILER::C1SYMBOL-FUN + COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL + COMPILER::C2BLOCK COMPILER::C2DECL-BODY COMPILER::C1BODY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + COMPILER::WT-COMMENT COMPILER::INIT-NAME COMPILER::ADD-INIT + COMPILER::CMPWARN COMPILER::FAST-LINK-PROCLAIMED-TYPE-P + COMPILER::UNWIND-EXIT COMPILER::CMPNOTE COMPILER::C1CASE + COMPILER::WT-INTEGER-LOC COMPILER::C1LAMBDA-EXPR + COMPILER::WT-CVAR COMPILER::CMPERR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER + COMMON-LISP::*) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::T) + COMPILER::DASH-TO-UNDERSCORE-INT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::T) + COMPILER::WT-GLOBAL-ENTRY COMPILER::MY-CALL + COMPILER::C2CALL-GLOBAL COMPILER::C1MAKE-VAR + COMPILER::T3DEFUN-VARARG COMPILER::C2SWITCH + COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::C2STRUCTURE-REF + COMPILER::T3DEFUN-NORMAL COMPILER::WT-IF-PROCLAIMED)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + COMPILER::T3LOCAL-FUN COMPILER::T2DEFUN + COMPILER::T3LOCAL-DCFUN COMPILER::T3DEFUN)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + COMPILER::MYSUB COMPILER::WT-INLINE-INTEGER COMPILER::C2MAPC + COMPILER::WT-INLINE-LONG-FLOAT COMPILER::C2PROGV + COMPILER::CHECK-VDECL COMPILER::AND-FORM-TYPE + COMPILER::WT-INLINE-CHARACTER COMPILER::C2MAPCAR + COMPILER::MAKE-INLINE-STRING COMPILER::C-FUNCTION-NAME + COMPILER::WT-INLINE-COND COMPILER::ADD-FUNCTION-DECLARATION + COMPILER::T3DEFCFUN COMPILER::C2MAPCAN COMPILER::C1DM + COMPILER::ASSIGN-DOWN-VARS COMPILER::CJT COMPILER::SET-VAR + COMPILER::COMPILER-PASS2 COMPILER::TOO-FEW-ARGS + COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO + COMPILER::C2FUNCALL-SFUN COMPILER::C2PRINC + COMPILER::WT-INLINE-SHORT-FLOAT COMPILER::C1STRUCTURE-REF1 + COMPILER::GET-INLINE-INFO COMPILER::CAN-BE-REPLACED* + COMPILER::CJF COMPILER::ADD-FUNCTION-PROCLAMATION + COMPILER::C2LET* COMPILER::C2TAGBODY + COMPILER::CMP-EXPAND-MACRO COMPILER::CHECK-FORM-TYPE + COMPILER::C2LET COMPILER::C2CASE COMPILER::WT-MAKE-CCLOSURE + COMPILER::TOO-MANY-ARGS COMPILER::BOOLE3 + COMPILER::SUBLIS1-INLINE COMPILER::WT-INLINE-FIXNUM + COMPILER::FIX-DOWN-ARGS COMPILER::C1MAP-FUNCTIONS + COMPILER::INLINE-TYPE-MATCHES COMPILER::ADD-FAST-LINK)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + COMPILER::C2LAMBDA-EXPR COMPILER::INLINE-ARGS + COMPILER::C2FUNCALL COMPILER::LINK)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + COMPILER::C2STRUCTURE-SET COMPILER::T3INIT-FUN + COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN-LOCAL-ENTRY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN COMPILER::T3DEFENTRY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::T) + COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::T) + COMPILER::MLIN)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::T) + COMPILER::MEMOIZED-HASH-EQUAL)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) + COMPILER::C1PSETQ COMPILER::ADD-LOOP-REGISTERS + COMPILER::FSET-FN-NAME COMPILER::CMP-MACRO-FUNCTION + COMPILER::C1PROGN COMPILER::C1SHARP-COMMA COMPILER::C1PRINC + COMPILER::C1EXPR COMPILER::CONS-TO-LISTA + COMPILER::RESET-INFO-TYPE COMPILER::WT-VS* + COMPILER::FUNCTION-RETURN-TYPE COMPILER::C2DM-RESERVE-VL + COMPILER::C1APPLY COMPILER::GET-INCLUDED COMPILER::BLK-REF-CCB + COMPILER::C1MACROLET COMPILER::ADD-OBJECT + COMPILER::C1ASH-CONDITION COMPILER::FUN-REF COMPILER::T1DEFLA + COMPILER::C1NTHCDR COMPILER::C1FUNCTION COMPILER::PROCLAMATION + COMPILER::C2FUNCALL-AUX COMPILER::MAXARGS + COMPILER::INFO-VOLATILE COMPILER::C1ASSOC COMPILER::C1MAPLIST + COMPILER::CLINK COMPILER::C1BOOLE-CONDITION COMPILER::C1VAR + COMPILER::VERIFY-DATUM COMPILER::C1OR + COMPILER::FUNCTION-ARG-TYPES COMPILER::C2FUNCTION + COMPILER::INLINE-POSSIBLE COMPILER::C2GO-LOCAL + COMPILER::C1COMPILER-LET COMPILER::NAME-SD1 COMPILER::C1LET + COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LOCAL-FUN + COMPILER::CHARACTER-LOC-P COMPILER::VARARG-P + COMPILER::FIXNUM-LOC-P COMPILER::SAVE-FUNOB COMPILER::BLK-VAR + COMPILER::C1STACK-LET COMPILER::C1FUNCALL + COMPILER::INFO-SP-CHANGE COMPILER::T1DEFINE-STRUCTURE + COMPILER::C1THROW COMPILER::T2PROGN COMPILER::GET-ARG-TYPES + COMMON-LISP::PROCLAIM COMPILER::C2LOCATION COMPILER::C1IF + COMPILER::CHECK-DOWNWARD COMPILER::TAG-REF-CCB + COMPILER::C1MEMBER COMPILER::VAR-REP-LOC COMPILER::VV-STR + COMPILER::C1RETURN-FROM COMPILER::SET-PUSH-CATCH-FRAME + COMPILER::C2TAGBODY-LOCAL COMPILER::C1MAPC COMPILER::C1LET* + COMPILER::WT1 COMPILER::C1PROGV COMPILER::C2TAGBODY-BODY + COMPILER::C1TERPRI COMPILER::FUN-INFO COMPILER::C1EVAL-WHEN + COMPILER::WT-CDR COMPILER::WT-VAR-DECL COMPILER::C1RPLACA + COMPILER::REPLACE-CONSTANT COMPILER::SET-TOP + COMPILER::OBJECT-TYPE COMPILER::C1TAGBODY COMPILER::T1ORDINARY + COMPILER::WT-VS-BASE COMPILER::CONSTANT-FOLD-P + COMPILER::C1RPLACD COMPILER::C1DOWNWARD-FUNCTION + COMPILER::TYPE-FILTER COMPILER::T3PROGN + COMPILER::C1LOCAL-CLOSURE COMPILER::C2RPLACD + COMPILER::TAG-UNWIND-EXIT COMPILER::PUSH-DATA-INCF + COMPILER::VAR-REF-CCB COMPILER::INFO-P + COMPILER::WT-SYMBOL-FUNCTION COMPILER::TAG-VAR + COMPILER::T1DEFMACRO COMPILER::CTOP-WRITE COMPILER::C1MAPCON + COMPILER::C1FUNOB COMPILER::C2BIND COMPILER::ADD-SYMBOL + COMPILER::SET-RETURN COMPILER::WT-CAR COMPILER::NAME-TO-SD + COMPILER::ADD-ADDRESS COMPILER::C2GETHASH COMPILER::C1FLET + COMPILER::C2TAGBODY-CLB COMPILER::C2VAR COMPILER::ADD-OBJECT2 + COMPILER::BLK-REF COMPILER::INLINE-TYPE COMPILER::C2RPLACA + COMPILER::C2GO-CCB COMPILER::WT-FUNCTION-LINK + COMPILER::T1DEFENTRY COMPILER::C1NTH COMPILER::COPY-INFO + COMPILER::WT-FASD-ELEMENT COMPILER::C1STRUCTURE-REF + COMPILER::LTVP-EVAL COMPILER::VAR-NAME COMPILER::C1BOOLE3 + COMPILER::C1STRUCTURE-SET COMPILER::WT-VS + COMPILER::INFO-CHANGED-ARRAY COMPILER::MACRO-DEF-P + COMPILER::TAG-P COMPILER::VAR-TYPE COMPILER::SHORT-FLOAT-LOC-P + COMPILER::AET-C-TYPE COMPILER::BLK-VALUE-TO-GO COMPILER::C1GET + COMPILER::C1AND COMPILER::C1SETQ COMPILER::C1LOAD-TIME-VALUE + COMPILER::C1ECASE COMPILER::C1MAPCAN COMPILER::T1DEFUN + COMPILER::C1DEFINE-STRUCTURE COMPILER::C1ASH + COMPILER::C1NTHCDR-CONDITION COMPILER::BLK-EXIT + COMPILER::FUN-P COMPILER::C1LABELS COMPILER::LONG-FLOAT-LOC-P + COMPILER::C1SWITCH COMPILER::T1CLINES + COMPILER::GET-RETURN-TYPE COMPILER::C1DM-BAD-KEY + COMPILER::T1PROGN COMPILER::C1QUOTE COMPILER::WT-SWITCH-CASE + COMPILER::FUN-LEVEL COMPILER::DECLARATION-TYPE + COMPILER::PARSE-CVSPECS COMPILER::WT-DATA1 COMPILER::REGISTER + COMPILER::C1FMLA-CONSTANT COMPILER::C1DECLARE COMPILER::VAR-P + COMPILER::ADD-REG1 COMPILER::C1UNWIND-PROTECT + COMPILER::C2VAR-KIND COMPILER::BLK-P COMPILER::INFO-TYPE + COMPILER::THE-PARAMETER COMPILER::C2VALUES + COMPILER::WRITE-BLOCK-OPEN COMPILER::C1NTH-CONDITION + COMPILER::C1MAPCAR COMPILER::VAR-LOC COMPILER::SCH-GLOBAL + COMPILER::WT-H1 COMPILER::SAVE-AVMA COMPILER::C1BLOCK + SYSTEM::UNDEF-COMPILER-MACRO COMPILER::C1MULTIPLE-VALUE-PROG1 + COMPILER::SAFE-SYSTEM COMPILER::DEFAULT-INIT + COMPILER::T3ORDINARY COMPILER::CMP-MACROEXPAND-1 + COMPILER::FUN-REF-CCB COMPILER::TAG-REF-CLB + COMPILER::C2DOWNWARD-FUNCTION COMPILER::C1THE + COMPILER::CHECK-VREF COMPILER::ARGS-CAUSE-SIDE-EFFECT + COMPILER::C1ADD-GLOBALS COMPILER::WT-LIST + COMPILER::SET-UP-VAR-CVS COMPILER::T1DEFCFUN + COMPILER::INLINE-BOOLE3-STRING COMPILER::FIX-OPT + COMPILER::VAR-REGISTER COMPILER::TAG-REF COMPILER::T2DECLARE + COMPILER::DECL-BODY-SAFETY COMPILER::C1VREF + COMPILER::C2DM-RESERVE-V COMPILER::BLK-NAME + COMPILER::C1RPLACA-NTHCDR COMPILER::VOLATILE + COMPILER::PUSH-ARGS COMPILER::C1FSET COMPILER::FLAGS-POS + COMPILER::TAG-LABEL COMPILER::C1MEMQ COMPILER::C1CATCH + COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::WT-DATA2 + COMPILER::PUSH-ARGS-LISPCALL COMPILER::FUN-NAME + COMPILER::C2TAGBODY-CCB COMPILER::C2GET + COMPILER::INFO-REFERRED-ARRAY + COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::T1MACROLET + COMPILER::T3CLINES COMPILER::SCH-LOCAL-FUN COMPILER::C1LENGTH + COMPILER::WT-DOWN COMPILER::WT-FUNCALL-C COMPILER::RESULT-TYPE + COMPILER::MDELETE-FILE COMPILER::ADD-CONSTANT + COMPILER::C1VALUES COMPILER::C1GETHASH + COMPILER::CMP-MACROEXPAND COMPILER::FUN-CFUN COMPILER::C1MAPL + COMPILER::UNWIND-NO-EXIT COMPILER::BLK-REF-CLB COMPILER::WT-VV + COMPILER::VAR-KIND COMPILER::TAG-SWITCH COMPILER::WT-CCB-VS + COMPILER::REP-TYPE COMPILER::UNDEFINED-VARIABLE + COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::C2GO-CLB + COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::LTVP + COMPILER::GET-LOCAL-ARG-TYPES COMPILER::COMPILE-ORDINARY-P + COMPILER::C1LIST-NTH COMPILER::C1GO + COMPILER::C1MULTIPLE-VALUE-CALL COMPILER::C2EXPR* + COMPILER::VAR-REF COMPILER::WT-CADR COMPILER::TAG-NAME)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) + COMPILER::INLINE-BOOLE3)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) + COMPILER::F-TYPE)) \ No newline at end of file diff --git a/comp/bo1.lsp b/comp/bo1.lsp new file mode 100755 index 0000000..e8924d8 --- /dev/null +++ b/comp/bo1.lsp @@ -0,0 +1,149 @@ +(in-package "BCOMP") +(defvar *space* 0) + + +(defmacro once-only (((v val) . res) &body body) + (cond (res `(once-only ((,v,val)) (once-only ,res ,@ body))) + ((and (consp val) (or (eq (car val) 'function)(eq (car val) 'quote))) + `(symbol-macrolet ((,v ,val)) ,@ body)) + (t (let ((w (gensym))) + `(let ((,w ,val)) + (symbol-macrolet ((,v ,w)) + ,@ body)))))) + +(defun get-test (x &aux item lis res key fn) + (when (<= *space* 0) + (desetq (item lis . res) (cdr x)) + (cond (res + (desetq (key fn . res) res) + (cond ((or res + (not (eq key :test)) + (not (and (consp fn) + (member (car fn) '(quote function))))) + nil) + (t (cadr fn)))) + (t 'eql)))) + +(setf (get 'assoc 'bo1) 'bo1-assoc) +(defun bo1-assoc (x where &aux fn ) where + (when (setq fn (get-test x)) + `(funcall #'(lambda (item lis) + (sloop for v in lis + when (funcall #',fn (car v) item) + do (return v))) + ,@ (cdr x)))) + +(setf (get 'member 'bo1) 'bo1-member) +(defun bo1-member (x where &aux fn ) where + (when (setq fn (get-test x)) + `(funcall #'(lambda (item lis) + (sloop for v on lis + when (funcall #',fn (car v) item) + do (return v))) + ,@ (cdr x)))) + +(setf (get 'get 'bo1) 'bo1-get) +(defun bo1-get (x where) where + (when (and (= *safety* 0) (< *space* 2)) + `(funcall #'(lambda (plis key &optional dflt) + (setq plis (symbol-plist plis)) + (loop (cond ((null plis) (return dflt)) + ((eq (car plis) key)(return (cadr plis))) + (t (setq plis (cddr plis)))))) + ,@ (cdr x)))) + +(setf (get 'mapcar 'bo1) 'bo1-mapcar) +(setf (get 'mapc 'bo1) 'bo1-mapcar) +(setf (get 'mapcan 'bo1) 'bo1-mapcar) +(defun bo1-mapcar (x where &aux fn l coll) where + (when (and (= *safety* 0) (< *space* 2)) + (desetq (fn l) (cdr x)) + (setq coll (cdr (assoc (car x) '((mapcar . collect) (mapc . do) + (mapcan . nconc))))) + (cond ((cdddr x) nil) + ((and (consp fn) (member (car fn) '(quote function))) + `(funcall #'(lambda (lis) + (sloop for v in lis ,coll (funcall ,fn v))) + ,@ (cddr x))) + (t `(funcall #'(lambda (fn lis) + (if (symbolp fn) (setq fn (symbol-function fn))) + (sloop for v in lis ,coll (funcall fn v))) + ,@ (cdr x)))))) + +(setf (get 'funcall 'bo1) 'bo1-funcall) +(defun bo1-funcall (x where &aux fn tem args ll w binds) where + (desetq (fn . args) (cdr x)) + (cond ((and (consp fn) + (or (eq (car fn) 'quote) + (eq (car fn) 'function)) + (consp (cdr fn)) + (setq tem (cadr fn)) + (symbolp tem)) + `(,(cadr fn) ,@ args)) + (tem + (cond ((and (consp tem) (eq (car tem) 'lambda)) + (desetq (ll) (cdr tem)) + (setq ll (decode-ll ll)) + (cond ((and (null (ll &key ll)) + (null (ll &rest ll)) + (null (ll &aux ll))) + (sloop for v in (ll &required ll) + do (desetq (w) args) + (setq args (cdr args)) + (push (list v w) binds)) + (sloop for v in (ll &optional ll) + do + (cond (args + (or (consp args) (comp-error "bad arglist in ~a " x)) + (push (list (car v) (pop args)) binds)) + (t (push (list (car v) (cadr v)) binds))) + (cond ((caddr v) + (push (list (caddr v) + (not (null args))) + binds)))) + `(let ,(nreverse binds) + ,@ (cddr tem))))))) + (t nil))) + +(setf (get 'typep 'b1.5) 'b1.5-typep) +(defun b1.5-typep (x where &aux (cd (third x)) + (args (call-data-arglist cd))) + where + (let ((rt (result-type (nth 0 args))) + (typ (nth 1 args))) + (cond ((and (consp typ) + (eq (car typ) 'dv) + (subtypep rt (THIRD typ))) + (get-object t))))) + +(defmacro dotimes ((var form &optional (val nil)) &rest body + &aux (temp (gensym))) + `(do* ((,temp ,form) (,var 0 (1+ ,var))) + ((>= ,var ,temp) ,val) + ,@ (cond ((typep form 'fixnum) + `((declare (fixnum ,temp ,var))))) + ,@body)) + +(defmacro psetq (&optional var val &rest l &aux sets types decls binds) + (cond ((null var) nil) + ((null l) `(setq ,var ,val)) + (t (loop + (push `(,(gensym) ,val) binds) + (push var sets) + (push (caar binds) sets) + (push `(type (type-of ,var) ,(caar binds)) types) + (or l (return nil)) + (desetq (var val) l) (setq l (cddr l))) + `(let ,(nreverse binds) + (declare ,@ types) + (setq ,@(nreverse sets)))))) + +;; +;;- Local variables: +;;- mode:lisp +;;- version-control:t +;;- End: + + + + diff --git a/comp/c-pass1.lsp b/comp/c-pass1.lsp new file mode 100755 index 0000000..c94ed7d --- /dev/null +++ b/comp/c-pass1.lsp @@ -0,0 +1,70 @@ +(in-package "BCOMP") +(setf (get 'call-set-mv 'b1) 'b1-call-set-mv) +(defun b1-call-set-mv (x where &aux form) where + (desetq (nil form) x) + `(call-set-mv #.(make-desk t) + ,(b1-walk form 'call-set-mv))) + + +(setf (get 'multiple-value-bind 'b1) 'b1-multiple-value-bind) +(defun b1-multiple-value-bind(x where &aux vars form body ) + (desetq (nil vars form . body) x) + (b1-walk + `(progn + (call-set-mv , form) + (let , + (sloop for v in vars + for i from 0 + collect `(,v (nth-mv ,i ))) + ,@ body)) + where)) + +(setf (get 'multiple-value-setq 'b1) 'b1-multiple-value-setq) +(defun b1-multiple-value-setq(x where &aux vars form body gens) + (desetq (nil vars form . body) x) + (setq gens (sloop for v in-list vars collect (gensym))) + (b1-walk + `(multiple-value-bind ,gens ,form + (setq ,@ (sloop for v in vars for w in gens collect v collect w)) + ,@ body) where )) + +(setf (get 'multiple-value-list 'b1) 'b1-multiple-value-list) +(defun b1-multiple-value-list(x where &aux form ) + (desetq (nil form ) x) + (b1-walk `(progn (call-set-mv ,form) + (list-mv)) + where)) + + +;; replace this by storage allocation in c stack of n*multiple-value-limit +;; and then copy into this storage at each stage. Then c_apply_n +;; which funcalls a vector. +(setf (get 'multiple-value-call 'b1) 'b1-multiple-value-call) +(defun b1-multiple-value-call(x where &aux bod fun ) + (desetq (nil fun . bod) x) + (b1-walk + `(apply ,fun + (nconc ,@ (sloop for v in-list bod + collect `(the dynamic-extent (multiple-value-list ,v))))) + + where + )) + +(setf (get 'multiple-value-prog1 'b1) 'b1-multiple-value-prog1) +(defun b1-multiple-value-prog1(x where &aux form bod (sym (gensym ))) + (desetq (nil form . bod) x) + (b1-walk + `(let ((,sym (multiple-value-list ,form))) + (declare (dynamic-extent ,sym)) + ,@ bod + (apply #'values ,sym)) + where)) + + + + + + + + + diff --git a/comp/cmpinit.lsp b/comp/cmpinit.lsp new file mode 100755 index 0000000..658d5fa --- /dev/null +++ b/comp/cmpinit.lsp @@ -0,0 +1,16 @@ + +(proclaim '(optimize (safety 2)(speed 0))) +(in-package "BCOMP") +(Use-package '("LISP" "SLOOP")) +(or (get 'call-data 'si::s-data) (load "defs.lsp")) +(or (macro-function 'dolist-safe)(load "macros.lsp")) +(or (si::specialp '*top-form*) (load "top.lsp")) +(or (si::specialp '*next-data*) (load "top2.lsp")) +(or (si::specialp '*C-OUTPUT*) (load "top.lsp")) +(or (si::specialp '*function-decls*)(load "top1.lsp")) +(or (si::specialp '*immediate-types*) (load "comptype.lsp")) +(or (fboundp 'flags-pos) (load "inline.lsp")) +(or (si::specialp '*value*)(Load "stmt.lsp")) +(or (si::specialp ' *PROMOTED-ARG-TYPES*) (load "utils.lsp")) + + diff --git a/comp/comptype.lsp b/comp/comptype.lsp new file mode 100755 index 0000000..5e7769d --- /dev/null +++ b/comp/comptype.lsp @@ -0,0 +1,227 @@ +(in-package "BCOMP") + + +(defvar *immediate-types* + '(fixnum character short-float double-float boolean)) + +(dolist (v + '((t array package + atom float pathname + bignum function random-state + hash-table ratio single-float + rational standard-char + keyword readtable stream + common list sequence + compiled-function + complex nil signed-byte symbol + cons null unsigned-byte t + number simple-array vector + ) + (bit bit) + (integer integer) + (double-float long-float single-float) + (character string-char) + ((vector character) string simple-string) + ((vector bit) bit-vector simple-bit-vector) + ((vector t) simple-vector) + (stream stream) + (dynamic-extent dynamic-extent ) + (fix-or-sf-or-df fix-or-sf-or-df) + )) + (dolist (w (cdr v)) + (setf (get w 'comp-type) (car v)))) +(dolist (v *immediate-types*) (setf (get v 'comp-type) v)) + +(deftype fix-or-sf-or-df nil '(or fixnum short-float double-float)) +(deftype boolean nil t) +(proclaim '(declaration dynamic-extent)) +;(deftype dynamic-extent nil t) + +(defun grab-1-decl (x decls &aux type l tem place) + (tagbody + (go begin) + ERROR + (comp-warn "bad declaration ~a" x) + (return-from grab-1-decl decls) + BEGIN + (or (consp x) (go error)) + (setq type (car x) l (cdr x)) + (or (null l) (consp l) (go error)) + (unless + (symbolp type) + (comp-warn "bad declaration ~a" x) + (return-from grab-1-decl decls) + ) + (cond ((or (setq tem (get type 'comp-type)) + (and (eq type 'type) + (consp l) + (setq tem (comp-type (car l))) + (setq l (cdr l)))) + (unless (eq t (setq tem (comp-type tem))) + (or decls (setq decls (list nil))) + (dolist-safe (v l) + (or (symbolp v) (go error)) + (push (cons v tem) (car decls))))) + ((eq type 'special) + (cond ((null decls) (setq decls (list nil nil))) + ((null (cdr decls)) + (setf (cdr decls) (list nil)))) + (setq place (cdr decls)) + (dolist-safe (v l) + (or (symbolp v) (go error)) + (push v (car place)) + )) + ((or (eq type 'inline) + (eq type 'not-inline) + (and (eq type 'ftype) + (progn (desetq (type . l) l) t))) + (dolist-safe (v l) (push + (cons v (increment-function-decl + type (function-declaration v))) + *function-decls*))) + (t nil))) + ; (((v1 . type1) (v2 . type2) ..)(special-var1 special-var2 ..)) + decls) + +(defun best-array-element-type (type) + (cond ((or (eql t type) (null type)) t) + ((memq type '(bit unsigned-char signed-char + unsigned-short + signed-short fixnum + character + )) + type) + ((subtypep type 'fixnum) + (dolist (v '(bit unsigned-char signed-char + unsigned-short + signed-short) + 'fixnum) + (cond ((subtypep type v) + (return v))))) + ((eql type 'string-char) 'character) + (t (or (dolist (v '(string-char bit short-float + long-float)) + (cond ((subtypep type v) + (return v)))) + t)))) + +(deftype type-of (x) + (cond (*in-pass-1* + (let ((tem (b1-walk x 'type-of))) + (result-type tem))) + (t t))) + +(defun assure-list (x) + (loop + (if (null x) (return t)) + (if (consp x) (setq x (cdr x)) + (error "expected a list ~a" x)))) + +(deftype struct (x) 'structure) +(defun comp-type (type &aux tem element-type sizes) +;; coerce type to ones understood by compiler + (cond ;((member type *immediate-types*) + ;(return-from comp-type type)) + ((and (symbolp type) + (setq tem (get type 'comp-type))) + (return-from comp-type tem)) + ((and(symbolp type) + (setq tem (get type 'si::deftype-definition))) + (comp-type (funcall tem))) + ((consp type) + (cond + ((eq (car type) 'struct) + (list 'struct (best-array-element-type (cadr type)))) + ((progn (setq type (si::normalize-type type)) nil)) + ((member (car type) '(array simple-array vector simple-vector)) + (when (consp (cdr type)) + (setq element-type (best-array-element-type (cadr type))) + (when(consp (cddr type)) + (setq sizes (caddr type)) + (cond ((consp sizes) + (assure-list sizes) + (unless (typep (second sizes) 'fixnum) (setq sizes nil))) + ((typep sizes 'fixnum) ) + (t (setq sizes nil)))) + (cond ((or (eql sizes 1) (null (cdr sizes))) + (setq tem 'vector) (setq sizes nil)) + (t (setq tem 'array))) + (list* tem element-type (if sizes (list sizes))))) + ((eq (car type) 'integer) + (if (si::sub-interval-p (cdr type) + (list most-negative-fixnum + most-positive-fixnum)) + 'fixnum + 'integer)) + ((eq (car type) 'values) + (if (null (cddr type)) + (comp-type (second type)) + (cons 'values (mapcar 'comp-type (cdr (the-list type)))))) + (t t))) + (t t))) + +(setf (get 'var 'result-type-b1) 'result-type-b1-var) +(defun result-type-b1-var (x) (or (third x) t)) + +(defun result-type (form &aux fd) +;; compute the result type of form , where FORM is somethign +;; returned by b1-walk + (cond ((consp form) + (cond ((and (symbolp (car form)) + (setq fd (get (car form) 'result-type-b1))) + (funcall fd form)) + ((and (atom (second form)) + (typep (second form) 'desk)) + (desk-result-type (second form))) + (t t))) + ((typep form 'var) + (var-type form)) + (t + (wfs-error) + ))) + +(setf (get 'dv 'result-type-b1) 'dv-result-type) +(defun dv-result-type (x) + (let ((val (third x))) + (cond ((typep val 'fixnum) 'fixnum) + ((typep val 'short-float) 'short-float) + ((typep val 'double-float) 'double-float) + ((typep val 'character) 'character) + ((typep val 'character) 'character) + (t t)))) + +(defun comp-subtypep (x y &aux xa xb) +; (cond ((and (atom x) (not (eq y t)) (not (eq x y)) +; (subtypep x y))(comp-warn "subtypep ~a ~a" x y))) + (cond ((eq y t) t) + ((atom x) + (subtypep x y)) + ((atom y) + (subtypep x y)) + ((member (car x) '(array struct)) + (and (eq (car y) (car y)) (subtypep (cdr x) (cdr y)))) + (t (subtypep x y)))) + +(defun type-and (a b) + (if (eq a b) (return-from type-and a)) + (if (eq a t) (return-from type-and b)) + (if (eq b t) (return-from type-and a)) + (multiple-value-bind (typ sure) + (subtypep a b) + sure + (cond (typ (return-from type-and a)))) + (multiple-value-bind (typ sure) + (subtypep b a) + sure + (cond (typ (return-from type-and b)))) + t) + + + + + + + + + + diff --git a/comp/data.lsp b/comp/data.lsp new file mode 100755 index 0000000..cbf3cc6 --- /dev/null +++ b/comp/data.lsp @@ -0,0 +1,107 @@ + +(in-package "BCOMP") + +(eval-when (compile eval) + (require 'FASDMACROS "../comp/fasdmacros.lsp") +(defvar *data*) +(defvar *data-output*) +(defmacro data-vector () `(car *data*)) +) +(defvar *fasd-data*) + + +; +; (defun verify-data-vector(vec &aux v) +; (dotimes (i (length vec)) +; (setq v (aref vec i)) +; (let ((has (si::hash-equal (cdr v) -1000))) +; (cond ((and (typep (car v) 'fixnum) +; (not (eql (car v) has))) +; (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" (cdr v))))) +; (setf (aref vec i) (cdr v))) +; vec +; ) + + + + +(defun wt-data-file ( &aux (x (data-vector)) + (*package* (find-package "LISP")) + fd tem + ) + (declare (type (array (t)) x)) +; (verify-data-vector x) + (setq fd (si::open-fasd *data-output* :output nil nil)) + + (si::find-sharing-top x (fasd-table fd)) + (put-op d_enter_vector *data-output*) + (sloop for i below (length x) + do (setq tem (aref x i)) + (cond ((consp tem) + (cond ((eq (car tem) 'd_eval_skip) + (put-op d_eval_skip *data-output*)) + ((eq (car tem) 'd_eval) + (put-op d_eval *data-output*))))) + (si::write-fasd-top (cdr tem) fd)) + (put-op d_delimiter *data-output*) + (si::close-fasd fd)) + +(defun display-data-file(file &aux fd (eof '(nil)) tem ) + (with-open-file (st file) + ; (setq fd (si::open-fasd st :input eof nil)) + (setq fd (si::open-fasd st :input eof + (make-array 100 :adjustable t))) + (sloop::sloop for i from 0 + while + (not (eq eof (setq tem (si::read-fasd-top fd)))) + do + (format t "~%item ~a:~%~s" i tem )) + )) +(defun display-data-file1(file &aux fd (eof '(nil)) ) + (with-open-file (st file) + ; (setq fd (si::open-fasd st :input eof nil)) + (setq fd (si::open-fasd st :input eof + (make-array 100 :adjustable t))) + (let ((si::%memory nil)) + (declare (special si::%memory)) + (si::read-fasd-top fd)))) + +(defun push-data (flag val) + (vector-push-extend (cons flag val) (data-vector)) + (prog1 *next-data* + (if (or (eq flag 'dv) (eq flag 'd_eval)) + (incf *next-data*)))) + +(defun get-load-time-form (x) + (let ((tem (cdr (assoc x *load-time-forms*)))) + (cond (tem) + (t (setq tem (list 'dv nil x)) + (setf (second tem) (push-data 'd_eval x)) + (push (cons x tem) *load-time-forms*) + tem)))) + + +(defun get-object (x &aux tem) + (cond ((setq tem (gethash x *data-table*))) + ((typep x 'compiled-function) + (setq tem (list 'd_eval + nil + `(function + ,(or (si::compiled-function-name x) + (comp-error + "Can't dump un named compiled funs"))) + )) + (setf (gethash x *data-table*) tem) + tem) + (t + (setq tem (list 'dv nil x)) + (setf (gethash x *data-table*) tem) + tem))) + +#| steps in loading +0) (let (*cfun-addresses* *data-object*) +1) copy address in VV vector into *vv-addresses* vector. +2) make a *data-object* whose body is the VV. +3) readin the items into the vector. using read-fasd-top + +|# diff --git a/comp/defmacro.lsp b/comp/defmacro.lsp new file mode 100755 index 0000000..359c17c --- /dev/null +++ b/comp/defmacro.lsp @@ -0,0 +1,257 @@ +(in-package "BCOMP") + +(eval-when (load eval compile) + +(defvar *let-bindings* nil) + +(defvar *pending-action* nil) + + +(defun find-declarations (body &aux decls doc bod) + (do ((v body (cdr v))) + (()) + (or (consp v) (return nil)) + (cond ((and (consp (car v)) (eq (caar v) 'declare)) + (push (car v) decls)) + ((stringp (car v))(if doc (return (setq bod v)) (setq doc (car v)))) + (t (setq bod v)(return nil)))) + (values (if doc (cons doc decls) decls) bod)) + + +(defun parse-mll (argl whole top + &aux u (pos 0) key-list key-test) + ;; parse a macro lambda list ARGL, where WHOLE is a variable bound + ;; to the whole list we gradually cdr down WHOLE + ;; This is called recursively by add-binding, whenever the item to be + ;; bound is not a symbol. + (declare (fixnum pos)) + (when (eq (car argl) '&whole) + (or (consp (cdr argl)) (macro-arg-error '&whole)) + (setq u (cadr argl)) + (add-binding u whole) + (setq argl (cddr argl))) + (if top (push `(setq ,whole (cdr ,whole)) *pending-action*)) + + (do () + ((atom argl) + (cond (key-test + (setf (third key-test) `(quote , key-list)))) + (when argl + (if (>= pos 2) (macro-arg-error '&rest)) + ;; ` . body' at the end is the same as `&rest body' + (add-binding argl whole))) + (let ((x (car argl))) + (case x + ;; The lambda list keywords must appear in the following order (with ommissions). + ;; We have deleted the &environment and &whole at this point. + ;; pos 1 &optional, 2 &rest &body, 3 &key, 4 &allow-other-keys, 5 &aux + (&optional + (when (>= pos 1) (macro-arg-error x)) + (setq pos 1)) + ((&rest &body) + (if (>= pos 2) (macro-arg-error x)) + (setq argl (cdr argl)) + (if (consp argl) nil (macro-arg-error x)) + (add-binding (car argl) whole) + (setq pos 2) + ) + (&key + (if (>= pos 3) (macro-arg-error x)) + (setq key-test `(dont-allow-other-keys ,whole nil)) + (push key-test *pending-action*) + (setq pos 3)) + (&allow-other-keys + (if (or (< pos 3) (>= pos 4)) (macro-arg-error x)) + (setf (car key-test) 'progn key-test nil) + (setq pos 4)) + (&aux + (if (>= pos 5) (macro-arg-error x)) + (setq pos 5)) + (t + (cond + ((= pos 5) ;&aux + (let ((var x) (val nil)) + (cond ((atom x)) + (t (or (consp (cdr x)) (macro-arg-error '&aux)) + ;(or (cddr x) (macro-arg-error '&aux)) + (setq var (car x) val (cadr x)))) + (or (symbolp var) (macro-arg-error '&aux)) + (add-binding var val))) + ((= pos 4) + (macro-arg-error '&allow-other-keys)) + ((= pos 3) ; &key + (let (var val supplied-p keyword dont-intern) + (cond + ((atom x) (setq var x keyword x)) + (t (setq var (car x)) + (cond ((symbolp var) + (setq keyword var)) + ((consp var) + (setq dont-intern t) + (if (consp (cdr var)) nil (macro-arg-error '&key)) + (setq keyword (car var) var (cadr var)) + (if (symbolp keyword) nil (macro-arg-error '&key))) + (t (macro-arg-error '&key))) + (cond ((consp (cdr x)) + (setq val (cadr x)) + (cond ((consp (cddr x)) + (setq supplied-p (caddr x)))))))) + (or dont-intern (setq keyword (intern (symbol-name keyword) 'keyword))) + (push keyword key-list) + (let ((key-val (gensym))) + (add-binding key-val `(getf ,whole ',keyword 'not-found)) + (add-binding var `(if (eq ,key-val 'not-found) ,val ,key-val)) + (if supplied-p + (add-binding supplied-p `(not (eq ,key-val 'not-found))))))) + ((= pos 2) + ;; they duplicated an &rest arg eg `&rest a b' + (macro-arg-error '&rest)) + ((= pos 1) ; &optional + (let (var val supplied-p) + (cond ((atom x) (setq var x)) + ((consp (cdr x)) + (setq var (car x) val (cadr x)) + (if (consp (cddr x)) + (setq supplied-p (caddr x)))) + (t (macro-arg-error x))) + (add-binding var `(cond ((consp ,whole) + ,@(if supplied-p `((setq ,supplied-p t))) + (prog1 (car ,whole) + (setq ,whole (cdr ,whole)))) + (t ,val))))) + ((= pos 0) ;&required arg + (let ((last-arg (or (null (cdr argl)) + (and (consp (cdr argl)) + (eq (car argl) '&aux))))) + (add-binding x + `(cond ((consp ,whole) + ,(if last-arg + `(if (cdr ,whole) + (too-many-arguments-to-macro) + (car , whole)) + `(car ,whole))) + (t (too-few-arguments-to-macro)))) + (or last-arg (push `(setq ,whole (cdr ,whole)) + *pending-action*)) + + )))))) + (pop argl))) + +(defun too-many-arguments-to-macro() + (error "Too many arguments to a macro or destructuring bind")) + +(defun too-few-arguments-to-macro() + (error "Too few arguments to a macro or destructuring bind")) + +(defun add-binding (v val) + (when *pending-action* (setq val `(progn ,@ (reverse *pending-action*) ,val)) + (setq *pending-action* nil)) + (cond ((symbolp v) + (push (list v val) *let-bindings*)) + ((consp v) + (let ((sub-whole (gensym))) + (push `(,sub-whole ,val) *let-bindings*) + (parse-mll v sub-whole nil))) + (t (error "Bad lambda list entry ~a" v)))) + +(defun parse-macro (name lambda-list body &optional env &aux envir whole) + ;; process a macro function body, laying out code for destructuring the + ;; lambda-list. An implicit block with NAME is placed around the body. + ;; The resulting lambda expression is a function of two arguments, suitable + ;; for calling as a macroexpander. + env + (let (*let-bindings* *pending-action*) + (do ((v lambda-list (cdr v)) (res nil)) + (()) + (if (atom v) (return nil)) + (cond ((eq (car v) '&environment) + (if (consp (cdr v)) nil (macro-arg-error '&environment)) + (setq envir (cadr v)) + (setf lambda-list (nconc (nreverse res) (cddr v))) + (return nil)) + (t (push (car v) res)))) + (if envir nil (setq envir (gensym))) + (setq whole (gensym)) + (parse-mll lambda-list whole t) + `(function (lambda (,whole ,envir) + ,envir + (block ,name + (let* ,(nreverse *let-bindings*) + ,@ body)))) + )) + +(defun macro-arg-error (x) + (error "Incorrect position or duplication of ~a arg in macro lambda list" x)) + +(defun dont-allow-other-keys(arglist allowed-keys) + ;; Make sure arglist doesn't contain other keys. + (do ((v arglist)) + ((null v)) + (cond ((consp v) + (if (consp (cdr v)) nil (error "Odd number of keyword args")) + (if (and (eq (car v) :allow-other-keys) + (cadr v)) + (return nil)) + (if (member (car v) allowed-keys :test 'eq) nil + (error "~s is not among the permitted keys ~s" (car v) allowed-keys)) + (setq v (cddr v))) + (t (error "The keyword args end in an atom ~a instead of NIL" v))))) + +(defun mset (sym fun) (setf (symbol-function sym) (cons 'macro fun))) + +;(defmacro defmacro (name ll &body body)) +(setf (macro-function 'defmacro) + #'(lambda (bod env &aux ll body name) + (setf bod (cdr bod)) + (or (consp bod) (too-few-arguments-to-macro)) + (setq name (car bod) bod (cdr bod)) + (or (consp bod) (too-few-arguments-to-macro)) + (setq ll (car bod) body (cdr bod)) + (let ((doc (car (find-declarations body))) + (def `(eval-when (compile eval load) + (mset ',name + ,(parse-macro name ll body t))))) + (when (stringp doc) + (setq def `(progn ,def + (setf (get ',name 'si::function-documentation) + ,doc)))) + def))) + + +(defmacro destructuring-bind (lambda-list expr &body body) + (let ((whole (gensym)) + *let-bindings* *pending-action*) + (parse-mll lambda-list whole nil) + `(let* ((,whole ,expr) + ,@ (nreverse *let-bindings*)) + ,@ body))) +) +#+test +(progn + +(defmacro1 billy (a b &key ((:u bil) 0 sup) sil &allow-other-keys) + `(billy-list ,a ,b ,sil ,bil,sup ,a)) + +(defmacro1 mwith ((st . open-args) &body body) + `(let (,st (open ,@ open-args)) + (unwind-protect + (progn ,@ body) + (close ,st)))) + +(defmacro1 joe ((st a) y) `(joe-flat ,st,a,y)) +(defmacro jo2 ((a b &key c d) &body body) + (list 'hi a b c d body)) +(jo2 (1 2 :c 3 ) 4 6) + +(mwith (st "foo" :direction :input) (read-char st)) +(billy 1 2 :sil 1 :u 4 :james 1) +(joe (1 2) 3) +) + + + + + + + + \ No newline at end of file diff --git a/comp/defs.lsp b/comp/defs.lsp new file mode 100755 index 0000000..99aaa88 --- /dev/null +++ b/comp/defs.lsp @@ -0,0 +1,126 @@ + +(in-package "BCOMP") + +#| +after pass 1 only the following forms are allowed + +forms1 == (form1 form1 ... form1) +form1 == output of (w1-walk form) +N == 0,1,2,3.. +desk == desk structure +var1 == var structure + | (var N) +binds == ((var1 form1) (var1 form1) ..) +arglist == (form1 form1 ... form1) +(LET desk binds forms1) +;(LET* desk binds forms1) ; not needed since the variable assign done. +(CALL desk call-data ) +(FUNCTION desk function-data) + +---------------------- +|# + +;;Globals for Second pass +;; push on to this when special is bound, so that it can be unbound. +(defvar *sp-bind* nil) +;; set when a setjmp is laid down, so variables can be declared volatile +(defvar *volatile* nil) + +;; tells unwind-set that number of values already set. +(defvar *MV-N-VALUES-SET* nil) + +(defvar *top-form* +;; Passes of the compiler may bind this to a form name which they are compiling +;; to make the errors more meaninful. + nil) + +(defstruct var name + ;; count of cross lambda block closure references + clb + type ;; rep type + changed ;; var was altered + ref ;; var referred to + special-p ;; var declared special + ;;for special var, something to which wr applies to write it + ;;for a closure var, if the the var is NOT in the *closure-vars* + ;; (ie those passed in to this function), then it is an (next-cvars) index + ;; if the var was passed in then this field is ignored, and the index is + ;; the position in the *closure-vars* list. + ;;for a normal variable the (next-cvar), eg ind = 3 , var written V3 + ind + ;; vars which are maybe referred to after return from a setjmp + volatile + ) + +(defstruct (desk (:constructor make-desk1 (result-type ))) + result-type ;result of first value + ;CHANGED-VARS are the plain-var-p vars which are altered in the + ;scope of the form of which this desk appears as the second member. + ;used when setting up args for a c call, to know if we need to save a var + changed-vars + single-value + ) + +(defun make-desk (x) + (or x (setq x t)) + (make-desk1 x)) + +(defstruct fdata + name + ll ; list : (ll &required (fdata-ll fd)) == the list of required args. + closure-vars + ind + address-index + doc + form + function-declaration ;; at the time of definition + argd + local-template ;; local function call template. + closure-self ;; if this is a closure and non nil then it points to a funobj = self + tail-label +) + +(defstruct (call-data (:constructor make-call-data + (fname arglist local-fun + function-declaration))) + fname ; may be a name or else fdata for a local function. + arglist + local-fun + ;;declaration at the point of call. + ;;If nil, and if not local then + ;; it may be retrieved later. + function-declaration + ) + +(defstruct label + identifier + ;; If this label is referred to across functions, a unique-id + ;; is assigned and put in the clb-reference field. Otherwise this is nil + clb-reference + ;; On pass1 this is set to 'clb by clb references. If it is null it is + ;; set to t by ordinary references. + referred + ind + ) + +(defstruct (block (:constructor make-block (label))) + label + value + exit) + +(defstruct top-form + lisp + walked + funp ;T if contains a function + ) + +(defstruct (link (:constructor make-link (fname proclaimed))) + (argd 0 :type fixnum) + ind + proclaimed + fname + ) + + + + \ No newline at end of file diff --git a/comp/exit.lsp b/comp/exit.lsp new file mode 100755 index 0000000..96de32a --- /dev/null +++ b/comp/exit.lsp @@ -0,0 +1,44 @@ +(in-package "BCOMP") + +(setf (get 'let-control-stack 'b2) 'b2-let-control-stack) +(defun b2-let-control-stack (x) + (let ((*control-stack* *control-stack*)(*blocks* 0)) + (open-block) + (wr "object *VOL SaveVs = VsTop;") + (expr-b2 (cadr x)) + (close-blocks) + )) + +(defopt control-jumped-back + ((t) boolean #.(flags set safe) control-jumped-back-aux)) + +(defun control-jumped-back-aux(x) + (push 'ctl-push *control-stack*) + (wr-inline-call1 x "@0;CtlJumpedBack(ctl_TAGGED_CATCH,$0)")) + +(defopt push-unwind-protect + ;; The second argument is a function to call to do unwinding + ((t) t #.(flags safe set) push-unwind-protect-aux)) + +(defun push-unwind-protect-aux (x) +;; we use this function call to push something on control stack + (push (list 'unwind-protect (car x)) *control-stack*) + (or (and (eq (car *exit*) 'next) + (or (and (eq (cadr *control-stack*) 'avma-bind) + (eq (cdr *exit*) (cddr *control-stack*))) + (eq (cdr *exit*) (cdr *control-stack*)))) + (wfs-error)) + (setq *exit* (cons 'next *control-stack*)) + (wr-inline-call1 x "CtlUnwindPush($0)")) + + + + + + + + + + + + diff --git a/comp/fasdmacros.lsp b/comp/fasdmacros.lsp new file mode 100755 index 0000000..b00d2ac --- /dev/null +++ b/comp/fasdmacros.lsp @@ -0,0 +1,92 @@ +(in-package "BCOMP") +(provide 'FASDMACROS) +(defstruct (fasd (:type vector)) + stream + table + eof + direction + package + index + filepos + table_length + macro + ) + +(defvar *fasd-ops* +'( d_nil ;/* dnil: nil */ + d_eval_skip ; /* deval o1: evaluate o1 after reading it */ + d_delimiter ;/* occurs after d_listd_general and d_new_indexed_items */ + d_enter_vector ; /* d_enter_vector o1 o2 .. on d_delimiter make a cf_data with + ; this length. Used internally by akcl. Just make + ; an array in other lisps */ + d_cons ; /* d_cons o1 o2: (o1 . o2) */ + d_dot ; + d_list ;/* list* delimited by d_delimiter d_list,o1,o2, ... ,d_dot,on + ;for (o1 o2 . on) + ;or d_list,o1,o2, ... ,on,d_delimiter for (o1 o2 ... on) + ;*/ + d_list1 ;/* nil terminated length 1 d_list1o1 */ + d_list2 ; /* nil terminated length 2 */ + d_list3 + d_list4 + d_eval + d_short_symbol + d_short_string + d_short_fixnum + d_short_symbol_and_package + d_bignum + d_fixnum + d_string + d_objnull + d_structure + d_package + d_symbol + d_symbol_and_package + d_end_of_file + d_standard_character + d_vector + d_array + d_begin_dump + d_general_type + d_sharp_equals ; /* define a sharp */ + d_sharp_value + d_sharp_value2 + d_new_indexed_item + d_new_indexed_items + d_reset_index + d_macro + d_reserve1 + d_reserve2 + d_reserve3 + d_reserve4 + d_indexed_item3 ; /* d_indexed_item3 followed by 3bytes to give index */ + d_indexed_item2 ; /* d_indexed_item2 followed by 2bytes to give index */ + d_indexed_item1 + d_indexed_item0 ; /* This must occur last ! */ +)) + +(defmacro put-op (op str) + `(write-byte ,(or (position op *fasd-ops*) + (error "illegal op")) ,str)) + +(defmacro putd (n str) + `(write-byte ,n ,str)) + +(defmacro put2 (n str) + `(progn (write-bytei ,n 0 ,str) + (write-bytei ,n 1 ,str))) + +(defmacro put4 (n str) + `(progn (write-bytei ,n 0 ,str) + (write-bytei ,n 1 ,str) + (write-bytei ,n 2 ,str) + (write-bytei ,n 3 ,str) + )) + + +(defmacro write-bytei (n i str) + `(write-byte (the fixnum (ash (the fixnum ,n) >> ,(* i 8))) ,str)) + + + + diff --git a/comp/inline.lsp b/comp/inline.lsp new file mode 100755 index 0000000..3e4a745 --- /dev/null +++ b/comp/inline.lsp @@ -0,0 +1,599 @@ +(in-package "BCOMP") + +(eval-when (compile load eval) + +(defmacro opt (key opt) + `(nth ,(position key '(args return flag template )) ,opt)) +) +(eval-when (eval compile load) + +(defun flags-pos (flag &aux (i 0)) + (declare (fixnum i)) + (dolist (v *flags*) + (cond ((member flag v :test 'eq) + (return-from flags-pos i))) + (setq i (+ i 1))) + (error "unknown opt flag")) + + +(defvar *flags* + '((allocates-new-storage ans) ; might invoke gbc + (side-effect-p set) ; no effect on arguments + (constantp) ; always returns same result, + ;double eval ok. + (result-type-from-args rfa) ; if passed args of matching + ;type result is of result type + (is);; extends the `integer stack'. + (mv);; in a declaration, function may return MV. + (safe);; can be used at safety 3 + (notinline) + (touch-mv);;Invoking this may alter the MV locations. + (not-1-val) ;; obsoluete + (proclaim) ; do a proclaim. + )) +) +(defmacro flags (&rest lis &aux (i 0)) + (dolist (v lis) + (setq i (logior i (ash 1 (flags-pos v))))) + i) + + +(defun print-flag (n &optional safe) + (princ "#.(flags") + (dotimes (i (length *flags*)) + (if (logbitp i n) (format t " ~(~s~)"(car (last (nth i *flags*))) ))) + (if safe (princ " safe")) + (princ ")") + n) +;#+assist +(progn + ;; Convert old AKCL opts. + +(defun print-opt (sym prop &aux tem ) + (unless (get 'compiler::boolean 'comp-type) + (setf (get 'compiler::boolean 'comp-type) 'boolean) + (setf (get :dynamic-extent 'comp-type) 'dynamic-extent) + (setf (get 'compiler::fixnum-float 'comp-type) 'fix-or-sf-or-df)) + (cond ((setq tem (get sym prop)) + (format t "~%(defopt ~s" sym) + (let ((*print-case* :downcase)) + (dolist (v (reverse tem)) + (format t "~% (~s ~s " (mapcar 'comp-type (car v)) + (comp-type (second v))) + (print-flag (third v) (eq prop 'compiler::inline-always)) + (format t " ~s)" + (if (stringp (fourth v)) + (substitute #\$ #\# (fourth v)) + (fourth v))))) + (princ ")")))) + +(defun convert-old (&rest props &aux syms) + (sloop for pack in '(lisp si compiler) + do + (sloop for v in-package pack + when (sloop for w in props when (get v w) return t) + do (push v syms))) + (setq syms (sort syms #'(lambda (x y) (string-lessp (symbol-name x) + (symbol-name y))))) + (sloop for v in syms + do (sloop for w in props + do (print-opt v w)))) + +;(with-open-file (*standard-output* "/tmp/opts1.lsp" :direction :output) (convert-old 'compiler::inline-always 'compiler::inline-unsafe)) +;(load "/tmp/opts.lsp") +;(with-open-file (*standard-output* "/tmp/opts.lsp" :direction :output) (convert-old 'bcomp-opt)) + +) + +(defmacro defopt (fname &rest l) + ;; adds additional opts to the front. + ;; last added is most significant. + `(defopt1 ',fname ',l)) +(defun defopt1 (fname l) + (dolist (v l) + (let ((fl (opt flag v))) + (cond ((flag-p fl proclaim) + (proclaim1 `(ftype (function ,(opt args v) ,(opt return v)) ,fname))))) + (push v (get fname 'bcomp-opt)))) + +(defmacro flag-p (n flag) + `(logbitp ,(flags-pos flag) ,n)) + +(setf (get 'aref 'coerce-arg-types) '(t fixnum fixnum fixnum fixnum)) +(setf (get 'si::aset1 'coerce-arg-types) '(t fixnum )) + + + +(defun get-inline-template (fname fdecl arg-types ret-type type-wanted + &aux lis opt-ret tem + (opt-flag 0) + (mask (if (> *safety* 0) ;*unsafe* + #.(flags safe) + #.(flags)))) + (declare (fixnum mask opt-flag)) + (or (symbolp fname) (wfs-error)) + (setq lis (get fname 'bcomp-opt)) + (or lis (return-from get-inline-template nil)) + (cond ((eq type-wanted 'mv) + (setq type-wanted t) + (unless + (and fdecl (not (flag-p (second fdecl) mv))) + ;function proclaimed to return 1 arg + (setq mask (logior mask #. (flags mv) + ))))) + (when (setq tem (get fname 'coerce-arg-types)) + (sloop for v on arg-types + for w in tem + unless (eq w t) do (setf (car v) (type-and (car v) w)))) + (if (member type-wanted *immediate-types*) + (setq ret-type type-wanted)) + (sloop for opt in lis + do + (setq opt-ret (opt return opt)) + (setq opt-flag (opt flag opt)) + ;; check return return matches + do + (when + (and + (eql mask (logand opt-flag mask)) + (or (eql opt-ret t) + (eql opt-ret '*) + (comp-subtypep ret-type opt-ret))) + (sloop + for v on arg-types + for w on (opt args opt) + do + (cond ((eq (car w) '*) + (return-from get-inline-template opt)) + ((or (comp-subtypep (car v) (car w)) (return nil)))) + finally + (cond ((eq (car w) '*) + (return-from get-inline-template opt)) + ((and (null v) (null w)) + (return-from get-inline-template opt)))))) + ) + +(defun result-from-args (sym argl &aux arg-types) + (let ((tem (get sym 'bcomp-opt))) + (when tem + (sloop for opt in tem + when (flag-p (opt flag opt) rfa) + do (or arg-types (setq arg-types (mapcar 'result-type argl))) + (sloop + for v on arg-types + for w on (opt args opt) + do + (cond ((eq (car w) '*) + (return-from result-from-args (opt return opt))) + ((or (subtypep (car v) (car w)) (return nil)))) + finally + (cond ((eq (car w) '*) + (return-from result-from-args (opt return opt)) + ) + ((and (null v) (null w)) + (return-from result-from-args (opt return opt)) + )))) + (cond ((get sym 'arithmetic-contagion) + (or arg-types (setq arg-types (mapcar 'result-type argl))) + (setq tem + (or (member 'double-float arg-types ) + (member 'short-float arg-types))) + (if (and tem (sloop for v in arg-types + always (or (subtypep v 'fixnum) + (subtypep v 'double-float) + (subtypep v 'short-float)))) + (return-from result-from-args (car tem))) + ))))) + +(dolist (v '(* + - 1- 1+ /)) (setf (get v 'arithmetic-contagion) t)) + +;; symbol_value ;; the result depends on WHEN the form is evaluated. +;; list ;; Different invocations give different results with same +;; args, but order of eval is not important. Double EVAL is. +;; (add x y) ;; May be multiple eval'd. WHEN is not important. +;; (aref x i) ;; May be multiple eval'd. WHEN is important. +;; (set x 3) ;; May be multiple eval'd. Changes something in x. WHEN important. + +;; by 'not side-effect' in the property of an inline, means that it may be +;; multiple eval'd as long as there were no intervening operation which does +;; not have the no-side-effect property, and the results would be same EXCEPT, +;; that we might get a different storage location. + +;; by allocates-new-storage we mean that storage is allocated. + +;; A function which has no-side-effect and 'not allocates-new-storage' +;; must return eq results if multiple-eval'd with no intervening +;; no-side-effect function. + +;; Call a function foo and goo `unordered' if +;; (setq a (goo x y)) +;; (setq b (foo x y)) +;; Then no common lisp function could tell whether a or b was computed first. +;; The set of 'not side-effect' functions are unordered. + +;; This is the case for LIST, CONS, MAKE-ARRAY, APPEND, AREF, .. + +(defun inline-args (args arg-types &aux type-wanted) + ;; returns (cons arglist referred-vars) + ;; where REFERRED-VARS is a list of vars which will be eval'd + ;; during the inline writeout of the forms in ARGLIST. The + ;; list of these variables is necessary so that INLINE-CALL + ;; may produce this list. + + ;; we check thru each ARG, and any one which we find which does not + ;; meet the following criteria, is pre eval'd as a temp. + ;; 1: Are them selves inline calls to functions with 'not side-effect-p' flag + ;; 2: Refer to vars which are setq'd by subsequent inline-calls (since + ;; it will be to late to eliminate them then. Those setq's will actually + ;; be written out in the preevalling. ) + ;; 3: lexical or special vars unless the last arg. + + ;; eg (foo x (progn (setq x 3) 7)) would require saving initial value of x in a + ;; temp, because it is changed by a subsequent arg. + ;; In (foo (progn (setq x 3) 7) x (+ x y)) the second x and the (+ x y) + ;; could stay and be inlined. + ;; All user functions are presumed to have 'side-effect-p' + + (sloop for v on args with referred = (cons nil nil) + do (setf type-wanted + (or (equal arg-types '(*)) (pop arg-types))) + collect (inline-arg (car v) type-wanted (cdr v) referred) into all + finally (setf (car referred) all) + (return referred))) + +(defun function-constant-p (x) +;; a function which returns something which will be the SAME for a given +;; set of arguments, where SAME means that there would not be a way in common lisp +;; of distinguishing between two results of an invocation OTHER than using eq. + (member x '(+ * list cons))) + +(defun remaining-args-constant (rest &aux cd) + (sloop for v in rest + do + (cond ((atom v)) + ((eq (car v) 'var)) + ((eq (car v) 'call) + (setq cd (third v)) + (unless (and (function-constant-p (call-data-fname cd)) + (remaining-args-constant (call-data-arglist cd))) + (return nil))) + (t (return nil))) + finally (return t))) + +(defun is-var-changed (var subsequent-args &aux cd) + (sloop for v in subsequent-args + do + (cond ((or (atom v) (eq (car v) 'var) (eq (car v) 'dv)) nil) + ((not (plain-var-p var)) + (setq cd (third v)) + (unless (and + (eq (car v) 'call) + (function-constant-p (call-data-fname cd)) + (not (is-var-changed var (call-data-arglist cd)))) + (return t))) + ((typep (second v) 'desk) + (return (memq var (desk-changed-vars (second v))))) + (t (return t))))) + +(defun inline-arg(a type-wanted rest referred &aux referred-vars result n tem) + ;; a value which can be written inline as an arg, and + ;; sets referred-vars + ;; + (when (eq type-wanted 'fix-or-sf-or-df) + (let ((x (car (member (result-type a) '(fixnum short-float double-float))))) + (and x (setq type-wanted x)))) + + (when (eq type-wanted 'double_ptr) + (let ((v (get-temp 'double-float)) + (tem (inline-arg a 'double-float rest referred))) + (wr-set-inline-loc v tem) + (return-from inline-arg (list 'address v)))) + + (cond ((atom a) + (or (typep a 'var) (wfs-error)) + (setq result a) + (cond ((or (null rest) + (remaining-args-constant rest) + (and (plain-var-p a) + (not (is-var-changed a rest)))) + (push a (cdr referred))) + (t (setq result (get-temp (var-implementation-type a))) + (wr-nl result "=" a ";"))) + (or (eq (var-implementation-type a) type-wanted) + (setq result (list 'inline-loc type-wanted result)))) + ((eq (car a) 'var) ;a temp var + (setq result a) + (or (eq (third a) type-wanted) + (setq result (list 'inline-loc type-wanted result)))) + ((eq (car a) 'dv) + (setq result (add-data a)) + (or (eq t type-wanted) + (setq result (list 'inline-loc type-wanted result)))) + ((eq (car a) 'the) + (setq result (inline-arg (third a) type-wanted rest referred))) + ((eq (car a) 'call) + (setq result (inline-call a type-wanted )) + (setq tem nil) + (setf referred-vars (car result) + (car result) 'inline-call) + (let ((templ (cddr result)) + tem1) + (setq n (opt flag templ)) + (cond ( ;; need a temp: + (or (not (or (flag-p n constantp) + (and (not (flag-p n set)) + (not (flag-p n ans))))) + (and (typep (setq tem1 (fourth templ)) 'link) + (or (argd-flag-p (link-argd tem1) requires-nargs) + (argd-flag-p (link-argd tem1) requires-fun-passed)))) + (setq tem (get-temp type-wanted))) + (rest + (sloop for referred-var in referred-vars + when (is-var-changed referred-var rest) + do (setq tem (get-temp (opt return templ))) + (loop-finish)))) + (unless (null tem) + (setq referred-vars nil) + (wr-set-inline-loc tem result) + (setf result tem)) + (unless (eq (opt return templ) type-wanted) + (setq result + (list 'inline-loc type-wanted result))) + (if referred-vars + (setf (cdr referred) (nconc referred-vars (cdr referred)))) + )) + (t (setq result (get-temp type-wanted)) + (when *do-pending-open* + (setq *do-pending-open* nil)(open-block)) + (valex (list 'var result) (next-exit) (expr-b2 a)) + result)) + result + ) + +(defun constant-inline-fixnum(x &aux y) + (or (and (consp x) (eq (car x) 'inline-loc) + (eq (second x) 'fixnum) + (and (consp (setq y (third x))) + (eq (car y) 'dv) + (typep (third y) 'fixnum))) + (wfs-error)) + (third y)) + +(setf (get 'boole 'bo2) 'bo2-boole) + +(defun bo2-boole(a type-wanted arg-types) + (when (and (equal arg-types '(fixnum fixnum fixnum)) + (dv-p (car (call-data-arglist (third a))))) + (do-inline-call 'boole3 a 'fixnum))) + +(defun wr-inline-boole3 (iargs) + (wr-inline-call1 (cdr iargs) + (ecase (constant-inline-fixnum (car iargs)) + (#.boole-ior "(($0) | ($1))" ) + (#.boole-xor "(($0) ^ ($1))" ) + (#.boole-and "(($0) & ($1))" ) + (#.boole-eqv "(~(($0) ^ ($1)))" ) + (#.boole-nand "(~(($0) & ($1)))" ) + (#.boole-nor "(~(($0) | ($1)))" ) + (#.boole-andc1 "((~($0)) & ($1))" ) + (#.boole-andc2 "(($0) & (~($1)))" ) + (#.boole-orc1 "((~($0)) | ($1))" ) + (#.boole-orc2 "(($0) | (~($1)))" ) + (#.boole-clr "(0)" ) + (#.boole-set "(-1)" ) + (#.boole-1 "(($0))" ) + (#.boole-2 "(($1))" ) + (#.boole-c1 "(~($0))" ) + (#.boole-c2 "(~($1))" )))) + + +(defun do-inline-call (fname a type-wanted) + (inline-call (list 'call (second a) (make-call-data + fname + (call-data-arglist (third a)) nil nil)) + type-wanted)) + +(defun coerce-to-binary (sym dsk argl &aux first) + (setq first + `(call ,dsk ,(make-call-data sym (list (car argl)(second argl)) nil nil))) + (cond ((cddr argl) + (coerce-to-binary sym dsk (cons first (cddr argl)))) + (t first))) + +(defun bo2-coerce-to-binary (a type-wanted arg-types) arg-types + (let* ((form-type (desk-result-type (second a))) + (call-dat (third a)) + (arglist (call-data-arglist (third a)))) + (cond ((and (cddr arglist) + (or (not (eq type-wanted t)) + (not (eq form-type t)))) + (if (eq type-wanted 'mv) (setq type-wanted t)) + (inline-call (coerce-to-binary (call-data-fname call-dat) + (make-desk (type-and type-wanted + form-type)) + arglist) + type-wanted))))) + + +(dolist (v '(+ * - /)) (setf (get v 'bo2) 'bo2-coerce-to-binary)) + +(setf (get 'aref 'bo2) 'bo2-aref) + +(defun bo2-aref (a type-wanted arg-types &aux (cd (third a)) argl type size) arg-types + (setq argl (call-data-arglist cd)) + (setq type (result-type (car argl))) + (cond ((and + (= *safety* 0) + (eql 3 (length argl)) + (consp type) + (eq (car type) 'array) + (eq (second type) t) + (consp (setq size (third type))) + (typep (second size) 'fixnum)) + (if (eq type-wanted 'mv) (setq type-wanted t)) + (inline-call (list 'call (second a) + (make-call-data + 'aref-2d + (append argl + (list (get-object (second size)))) + nil nil)) + type-wanted)))) + + +(defun inline-call (a type-wanted &aux call-dat in-args template tem + (*exit* (next-exit))) + ;; The arg A is a (call ..) as returned from b1-walk. + ;; If TYPE-WANTED is NIL then we may need Mult Values. + ;; This function returns a list: + ;; (referred-vars inlined-args result-type flags fname-or-string) + ;; The REFERRED-VARS and RESULT-TYPE and FLAGS are necessary for + ;; recursive calls, while the FNAME-OR-STRING and INLINED-ARGS + ;; are used to actually write out the result. + (setq call-dat (third a)) + + (let* ((fname (call-data-fname call-dat)) + fdecl check + (arglist (call-data-arglist call-dat)) + (arg-types (mapcar 'result-type arglist)) + (form-type (desk-result-type (second a)))) + + + (cond ((and (setq tem (get fname 'bo2)) + (setq tem (funcall tem a type-wanted arg-types))) + (return-from inline-call tem))) + + + + (cond ((call-data-local-fun call-dat) + (setq check t) + (setq template (get-template-fdata + (second (second + (call-data-local-fun call-dat)))))) + ((setq template + (progn + (setq fdecl (function-declaration fname)) + (let ((ret (if fdecl (ret-from-argd (fdecl argd fdecl))))) + (cond (ret + (cond ((eq ret 'double_ptr) + (setq form-type (type-and 'double-float form-type))) + ((or (eq ret t)(eq ret '*))) + (t (setq form-type (type-and ret form-type))))))) + (get-inline-template fname fdecl + arg-types form-type type-wanted)))) + ((setq template (add-link-template fname fdecl + arg-types type-wanted)))) + ;; now we have template. + (when check + (sloop for v in (car template) with al = arglist + do + (cond ((eq v '*) (return t)) + ((null al) (comp-error "Too few args passed to ~a " fname)) + (t (pop al))))) + (cond ((flag-p (opt flag template)is ) + (sloop for v on *control-stack* + when (or (eq (car v) 'avma-bind) + (eq (car v) 'avma-bind-needed)) + do (setf (car v) 'avma-bind-needed) + (return nil) + finally (wfs-error)))) + + (setq in-args (inline-args arglist (opt args template))) + (list* (cdr in-args) ; the referred-vars + (car in-args) ; the arglist + template))) + +(defun add-link-template (fname fdecl arg-types type-wanted &aux tem link ans + (leng (length arg-types))) + (declare (fixnum leng)) + (setq tem (assoc fname *file-inline-templates*)) + (when tem + (setq link (fourth tem)) + (cond ((typep link 'link) + (cond ((< leng (argd-minargs (link-argd link))) + (setf (argd-minargs (link-argd link)) leng)) + ((> leng (argd-maxargs (link-argd link))) + (setf (argd-maxargs (link-argd link)) leng)) + (t nil)) + (if (eq type-wanted 'mv) (setf (argd-flag-p (link-argd link) sets-mv) t)))) + (return-from add-link-template (cdr tem))) + (let ((ret t) + (argl '(*)) + (flags #.(flags set ans mv)) + (argd 0) + link) + (declare (fixnum argd)) + (cond (fdecl + (setq argd (car fdecl)) + (setq argl (argl-from-argd argd)) + (setq ret (ret-from-argd argd)) + (setq flags (second fdecl))) + (t (setf (argd-minargs argd) (length arg-types)) + (setf (argd-maxargs argd) (length arg-types)) + (setf (argd-flag-p argd requires-nargs) t) + (setf (argd-flag-p argd sets-mv) t))) + (setq link (make-link fname fdecl)) + (setf (link-argd link) argd) + ;; we need the data object now, so make sure it gets in the vector + ;; in time + (add-data (get-object fname)) + (push (setq ans (list fname argl ret flags link)) *file-inline-templates*) + (cdr ans))) + +(defun get-template-fdata (fd &aux fstring tem) + ;; make a template for a local fdata + (or (typep fd 'fdata) (wfs-error)) + (cond ((setq tem (fdata-local-template fd)) + (return-from get-template-fdata tem))) + (let* ((vararg (vararg-p fd)) + (fdecl (fdata-function-declaration fd)) + (ll (fdata-ll fd))) + (unless fdecl + (setq fdecl + (increment-function-decl + `(function + , (nconc + (sloop for v in (ll &required ll) collect (value-type v)) + (if (ll &optional ll) + (cons '&optional + (sloop for v in (ll &optional ll) collect + (value-type (car v))))) + (if (or (ll &rest ll) (ll &key ll)) '(*) nil)) + ;; todo arrange that pickup ret type + ;; from fdata some day10q + *) + nil))) + + (setq fstring (format nil "L~a($@0)" (fdata-ind fd))) + (if vararg (setq fstring (format nil "(VFUN_NARGS = $#,~a)" fstring))) +; (wr-h (rep-type t) " L" (fdata-ind fd) "();") + ;; it is only fitting that a closure's template `format string' should in + ;; fact be a closure. Takes a closure to know a closure. + (cond ((fdata-closure-vars fd) + (let ((fdc fd) + (string fstring)) + (setf fstring #'(lambda (iargs) + (wr "(fcall.fun=" + (or (fdata-closure-self fdc) + (fdata-to-obj fdc)) ",") + (wr-inline-call1 iargs string) + (wr ")")))))) + (let ((ans + (list (argl-from-argd (fdecl argd fdecl)) (ret-from-argd (fdecl argd fdecl)) + (fdecl flag fdecl) fstring))) + (setf (fdata-local-template fd) ans) + ans))) + + + +(defun replace-inline-by-temp (x) + (let* ((type (result-type x)) + (tem (get-temp type))) + (wr-set-inline-loc tem x) + tem)) + + + + + + + diff --git a/comp/integer.doc b/comp/integer.doc new file mode 100755 index 0000000..7f5f708 --- /dev/null +++ b/comp/integer.doc @@ -0,0 +1,35 @@ + +1) b2-call (or anyone who calls inline-arg or inline-args) + will push an 'avma-bind onto the *control-stack* if it is there + is not one between where it is and the next tag. If it did the push, + then it will pop it off an leaving. If the 'avma-bind has been changed to + 'avma-bind-needed then + a) it will also set the *used-function-saved-avma* to be t if at outer scope + b) bind *do-restore-avma* to the point in the *control-stack* where we pushed + to 'avma-bind, for the benefit of unwind-set. + c)It is an error if the *value* var is of type GEN and the level is outer. + +2) Any call to an 'is' fun will cause the most recent 'avma-bind or 'avma-bind-needed +to 'avma-bind-needed + +3) unwind-set if doing a go or return must do the restore to the level appropriate +to the tag, if there is an intervening 'avma-bind-needed in the *control-stack* + +If not going to a tag then if *do-restore-avma* is set, then unwind to the +current avma level. current level is global_saved_avma if there is not an intervening +inner-avma on the stack. + +4) entering tagbody, if there is an 'avma-bind on the stack, then push an +'inner-avma and write { GEN Inner_avma= avma; ..}. + + + + + + + + + + + + diff --git a/comp/lambda.lsp b/comp/lambda.lsp new file mode 100755 index 0000000..c9c6d6f --- /dev/null +++ b/comp/lambda.lsp @@ -0,0 +1,38 @@ +(in-package "BCOMP") + +#| +(let ((a 3)) + (defun f0 (x) (+ x 2)) + (defun f1 (x) (setq a x) (+ x 2)) + (defun f2 (x &aux u) #'(lambda (y) (+ x y a u))) + (list #'f0 #'f1 #'f2 (f2 1) (f2 1))) + +f1 alters the a which the function f2 outputs. +each call to f2 makes a different closure variable x however. +There is only one closure variable a. + + (function (lambda ....)) + is a closure if in (lambda ....) there are references to the cross boundary + You get the list of such vars + + +A compiled closure will be + + struct closure + { object name; + .. + object *cldata; + short cldata_dim; + } + +MakeClosure(3,fn,argd,V1,V2,V3) + + would construct it, and the V1,V2,V4 would be the cons's whose cars + represent the closure variables. + inside the closure we will have this_cldata variable, and can reference + the variables by position for this closure. + Each time we enter a let or &aux or lambda variable which freshly binds + a closure variable, a new cons must be created. This cons is immediately + put in the accessor array for this closure. + +|# diff --git a/comp/lisp-decls.doc b/comp/lisp-decls.doc new file mode 100755 index 0000000..217dd9d --- /dev/null +++ b/comp/lisp-decls.doc @@ -0,0 +1,531 @@ +(in-package "BCOMP") +;first load the proclaims then get them: +;(setq lis (sort (sloop for v in-package 'lisp when (get v 'PROCLAIMED-FUNCTION-DECLARATION) collect v) #'(lambda (x y) (string-lessp (symbol-name x) (symbol-name y))))) + +;(sloop for v in lis when (setq tem (get v 'proclaimed-function-declaration)) do (format t "(~a ~a ~a " v (car tem)(second tem)) (print-flag (third tem))(princ ")") (unless (eq (second tem) '*) (princ " ;Mv touched?")) (terpri)) +(defmacro proclaim2 (name args res flag) + (progn (proclaim1 `(ftype (function ,args ,res) ,name)) + (setf (fdecl flag (get name 'proclaimed-function-declaration) ) + flag))) +(proclaim2 * (*) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 + (*) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 - (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 / (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 /= (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 1+ (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 1- (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 < (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 <= (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 = (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 > (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 >= (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 ABS (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ACONS (T T T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ACOS (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ACOSH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ADJOIN (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ADJUST-ARRAY (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ADJUSTABLE-ARRAY-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 ALPHA-CHAR-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 ALPHANUMERICP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 APPEND (*) T #.(flags ans set )) ;Mv touched? +(proclaim2 APPLY (T T *) * #.(flags ans set mv touch-mv)) +(proclaim2 APROPOS (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 APROPOS-LIST (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 AREF (T &optional fixnum fixnum fixnum fixnum *) T + #.(flags ans constantp)) +(proclaim2 si::aset1 (T fixnum t) T #.(flags ans set constantp)) + +(proclaim2 ARRAY-DIMENSION (T FIXNUM) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 ARRAY-DIMENSIONS (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ARRAY-ELEMENT-TYPE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ARRAY-HAS-FILL-POINTER-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 ARRAY-IN-BOUNDS-P (T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ARRAY-RANK (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 ARRAY-ROW-MAJOR-INDEX (T *) FIXNUM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ARRAY-TOTAL-SIZE (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 ARRAYP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 ASH (INTEGER FIXNUM) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 ASIN (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ASINH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ASSOC (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ASSOC-IF (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ASSOC-IF-NOT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ATAN (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ATANH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ATOM (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 BIT (T *) BIT #.(flags ans constantp)) ;Mv touched? +(proclaim2 BIT-AND (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-ANDC1 (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-ANDC2 (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-EQV (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-IOR (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-NAND (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-NOR (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-NOT (T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-ORC1 (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-ORC2 (T T *) (ARRAY BIT) #.(flags ans set)) ;Mv touched? +(proclaim2 BIT-VECTOR-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 BIT-XOR (T T *) (ARRAY BIT) #.(flags ans set )) ;Mv touched? +(proclaim2 BOOLE (FIXNUM INTEGER INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 BOTH-CASE-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 BOUNDP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 BREAK (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 BUTLAST (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 BYTE (FIXNUM FIXNUM) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 BYTE-POSITION (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 BYTE-SIZE (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAAAAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAAADR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAAAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAADAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAADDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAADR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CADAAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CADADR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CADAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CADDAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CADDDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CADDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CADR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDAAAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDAADR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDAAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDADAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDADDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDADR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDDAAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDDADR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDDAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDDDAR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDDDDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDDDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CDR (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CEILING (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 CERROR (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 CHAR (T FIXNUM) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-CODE (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-DOWNCASE (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-EQUAL (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-GREATERP (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-INT (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-LESSP (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-NAME (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-NOT-EQUAL (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-NOT-GREATERP (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-NOT-LESSP (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR-UPCASE (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR/= (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR< (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR<= (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR= (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR> (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHAR>= (T *) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHARACTER (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CHARACTERP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CIS (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CLEAR-INPUT (*) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CLEAR-OUTPUT (*) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CLOSE (T *) STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 CLRHASH (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 CODE-CHAR (FIXNUM) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COERCE (T T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COMPILE (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 COMPILE-FILE (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 COMPILED-FUNCTION-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 COMPLEX (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 COMPLEXP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CONCATENATE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 CONJUGATE (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CONS (T T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 CONSP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 CONSTANTP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 COPY-ALIST (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COPY-LIST (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COPY-READTABLE (*) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COPY-SEQ (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COPY-SYMBOL (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COPY-TREE (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COS (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COSH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 COUNT (T T *) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 COUNT-IF (T T *) FIXNUM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 COUNT-IF-NOT (T T *) FIXNUM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DECODE-UNIVERSAL-TIME (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 DELETE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DELETE-DUPLICATES (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DELETE-FILE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DELETE-IF (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DELETE-IF-NOT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DENOMINATOR (T) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 DEPOSIT-FIELD (INTEGER T INTEGER) INTEGER #.(flags ans set)) ;Mv touched? +(proclaim2 DESCRIBE (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 DIGIT-CHAR (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 DIGIT-CHAR-P (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 DIRECTORY (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DIRECTORY-NAMESTRING (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 DOCUMENTATION (T T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 DPB (INTEGER T INTEGER) INTEGER #.(flags ans set )) ;Mv touched? +(proclaim2 DRIBBLE (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ED (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 EIGHTH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ELT (T FIXNUM) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 ENCODE-UNIVERSAL-TIME (T T T T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ENDP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 ENOUGH-NAMESTRING (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 EQ (T T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 EQL (T T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 EQUAL (T T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 EQUALP (T T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 ERROR (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 EVAL (T) * #.(flags ans set mv touch-mv)) +(proclaim2 EVENP (INTEGER) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 EVERY (T T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 EXP (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 EXPORT (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 EXPT (T T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 FBOUNDP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 FCEILING (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 FFLOOR (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 FIFTH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 FILE-AUTHOR (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FILE-LENGTH (STREAM) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FILE-NAMESTRING (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FILE-POSITION (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FILE-WRITE-DATE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FILL (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FILL-POINTER (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 FIND (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FIND-ALL-SYMBOLS (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FIND-IF (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FIND-IF-NOT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FIND-PACKAGE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FIND-SYMBOL (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 FINISH-OUTPUT (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FIRST (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 FLOAT-DIGITS (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 FLOAT-PRECISION (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 FLOAT-RADIX (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 FLOAT-SIGN (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 FLOATP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 FLOOR (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 FMAKUNBOUND (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FORCE-OUTPUT (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FORMAT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FOURTH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 FRESH-LINE (*) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 FROUND (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 FTRUNCATE (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 FUNCALL (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 FUNCTIONP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 GCD (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GENSYM (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GENTEMP (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GET (T T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 GET-DECODED-TIME NIL * #.(flags ans set mv touch-mv)) +(proclaim2 GET-DISPATCH-MACRO-CHARACTER (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GET-INTERNAL-REAL-TIME NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GET-INTERNAL-RUN-TIME NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GET-MACRO-CHARACTER (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 GET-OUTPUT-STREAM-STRING (STREAM) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GET-PROPERTIES (T T) * #.(flags ans set mv touch-mv)) +(proclaim2 GET-SETF-METHOD (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 GET-SETF-METHOD-MULTIPLE-VALUE (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 GET-UNIVERSAL-TIME NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 GETF (T T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 GETHASH (T T *) * #.(flags ans set mv touch-mv)) +(proclaim2 GRAPHIC-CHAR-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 HASH-TABLE-COUNT (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 HOST-NAMESTRING (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 IDENTITY (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 IMAGPART (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 IMPORT (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 IN-PACKAGE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 INPUT-STREAM-P (STREAM) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 INSPECT (T) * #.(flags ans set mv touch-mv)) +(proclaim2 INTEGER-DECODE-FLOAT (T) * #.(flags ans set mv touch-mv)) +(proclaim2 INTEGER-LENGTH (INTEGER) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 INTEGERP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 INTERN (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 INTERSECTION (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ISQRT (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 KEYWORDP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 LCM (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LDB (T INTEGER) INTEGER #.(flags ans set )) ;Mv touched? +(proclaim2 LDB-TEST (T INTEGER) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 LDIFF (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LENGTH (T) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 LISP-IMPLEMENTATION-VERSION NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LIST (*) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 LIST* (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 LIST-ALL-PACKAGES NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LIST-LENGTH (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LISTEN (*) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LISTP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOAD (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LOG (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LOGAND (*) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGANDC1 (INTEGER INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGANDC2 (INTEGER INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGBITP (FIXNUM INTEGER) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGCOUNT (INTEGER) FIXNUM #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGEQV (*) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGIOR (*) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGNAND (INTEGER INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGNOR (INTEGER INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGNOT (INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGORC1 (INTEGER INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGORC2 (INTEGER INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGTEST (INTEGER INTEGER) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 LOGXOR (*) INTEGER #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LONG-SITE-NAME NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 LOWER-CASE-P (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 MACHINE-INSTANCE NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MACHINE-TYPE NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MACHINE-VERSION NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MACRO-FUNCTION (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 MACROEXPAND (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 MACROEXPAND-1 (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 MAKE-BROADCAST-STREAM (*) STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-CONCATENATED-STREAM (*) STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-DISPATCH-MACRO-CHARACTER (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-ECHO-STREAM (STREAM STREAM) STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-HASH-TABLE (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-LIST (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-PACKAGE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-PATHNAME (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-RANDOM-STATE (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-SEQUENCE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-STRING (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-STRING-INPUT-STREAM (T *) STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-STRING-OUTPUT-STREAM NIL STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-SYMBOL (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-SYNONYM-STREAM (T) STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKE-TWO-WAY-STREAM (STREAM STREAM) STREAM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAKUNBOUND (T) T #.(flags ans set )) ;Mv touched? +(proclaim2 MAP (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAPC (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAPCAN (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAPCAR (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAPCON (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAPHASH (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAPL (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MAPLIST (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MASK-FIELD (T INTEGER) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 MAX (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 MEMBER (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MEMBER-IF (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MEMBER-IF-NOT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MERGE (T T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MERGE-PATHNAMES (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MIN (T *) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 MINUSP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 MISMATCH (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 MOD (T T) T #.(flags ans touch-mv)) ;Mv touched? +(proclaim2 NAME-CHAR (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NAMESTRING (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NBUTLAST (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NCONC (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NINTERSECTION (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NINTH (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 NOT (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 NOTANY (T T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NOTEVERY (T T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NRECONC (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NREVERSE (T) T #.(flags ans set )) ;Mv touched? +(proclaim2 NSET-DIFFERENCE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSET-EXCLUSIVE-OR (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSTRING-CAPITALIZE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSTRING-DOWNCASE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSTRING-UPCASE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSUBLIS (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSUBST (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSUBST-IF (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSUBST-IF-NOT (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSUBSTITUTE (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSUBSTITUTE-IF (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NSUBSTITUTE-IF-NOT (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 NTH (FIXNUM T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 NTHCDR (FIXNUM T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 NULL (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 NUMBERP (T) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 NUMERATOR (T) INTEGER #.(flags ans constantp)) ;Mv touched? +(proclaim2 NUNION (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ODDP (INTEGER) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 OPEN (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 OUTPUT-STREAM-P (STREAM) BOOLEAN #.(flags ans constantp)) ;Mv touched? +(proclaim2 PACKAGE-NAME (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 PACKAGE-NICKNAMES (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 PACKAGE-SHADOWING-SYMBOLS (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 PACKAGE-USE-LIST (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 PACKAGE-USED-BY-LIST (T) T #.(flags ans constantp)) ;Mv touched? +(proclaim2 PAIRLIS (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PARSE-INTEGER (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PARSE-NAMESTRING (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 PATHNAME (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PATHNAME-DEVICE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PATHNAME-DIRECTORY (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PATHNAME-HOST (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PATHNAME-NAME (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PATHNAME-TYPE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PATHNAME-VERSION (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PEEK-CHAR (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PHASE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PLUSP (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 POSITION (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 POSITION-IF (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 POSITION-IF-NOT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PRIN1 (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PRIN1-TO-STRING (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PRINC (T *) T #.(flags ans set )) ;Mv touched? +(proclaim2 PRINC-TO-STRING (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PRINT (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 PROBE-FILE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RANDOM (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RASSOC (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RASSOC-IF (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RASSOC-IF-NOT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RATIONAL (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RATIONALIZE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RATIONALP (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 READ (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 READ-BYTE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 READ-CHAR (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 READ-CHAR-NO-HANG (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 READ-DELIMITED-LIST (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 READ-FROM-STRING (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 READ-LINE (*) * #.(flags ans set mv touch-mv)) +(proclaim2 READ-PRESERVING-WHITESPACE (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REALPART (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REDUCE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REM (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REMHASH (T T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REMOVE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REMOVE-DUPLICATES (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REMOVE-IF (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REMOVE-IF-NOT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REMPROP (T T) T #.(flags ans set )) ;Mv touched? +(proclaim2 RENAME-FILE (T T) * #.(flags ans set mv touch-mv)) +(proclaim2 RENAME-PACKAGE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REPLACE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REST (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REVAPPEND (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 REVERSE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ROOM (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ROUND (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 RPLACA (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 RPLACD (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SBIT (T *) BIT #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SCALE-FLOAT (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SCHAR (T FIXNUM) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SEARCH (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SECOND (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SET (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SET-DIFFERENCE (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SET-DISPATCH-MACRO-CHARACTER (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SET-EXCLUSIVE-OR (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SET-MACRO-CHARACTER (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SET-SYNTAX-FROM-CHAR (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SEVENTH (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SHADOW (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SHADOWING-IMPORT (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SHORT-SITE-NAME NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SIGNUM (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SIMPLE-BIT-VECTOR-P (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SIMPLE-STRING-P (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SIMPLE-VECTOR-P (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SIN (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SINH (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SIXTH (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SLEEP (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SOFTWARE-TYPE NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SOFTWARE-VERSION NIL T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SOME (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SORT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SPECIAL-FORM-P (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SQRT (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STABLE-SORT (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STANDARD-CHAR-P (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STREAM-ELEMENT-TYPE (STREAM) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-CAPITALIZE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-DOWNCASE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-EQUAL (T T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-GREATERP (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-LEFT-TRIM (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-LESSP (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-NOT-EQUAL (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-NOT-GREATERP (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-NOT-LESSP (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-RIGHT-TRIM (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-TRIM (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING-UPCASE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING/= (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING< (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING<= (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING= (T T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING> (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRING>= (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 STRINGP (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBLIS (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBSEQ (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBSETP (T T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBST (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBST-IF (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBST-IF-NOT (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBSTITUTE (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBSTITUTE-IF (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBSTITUTE-IF-NOT (T T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SUBTYPEP (T T) * #.(flags ans set mv touch-mv)) +(proclaim2 SVREF ((VECTOR T) FIXNUM) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SXHASH (T) FIXNUM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SYMBOL-FUNCTION (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SYMBOL-NAME (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SYMBOL-PACKAGE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SYMBOL-PLIST (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SYMBOL-VALUE (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 SYMBOLP (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TAN (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TANH (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TENTH (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TERPRI (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 THIRD (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TREE-EQUAL (T T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TRUENAME (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TRUNCATE (T *) * #.(flags ans set mv touch-mv)) +(proclaim2 TYPE-OF (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 TYPEP (T T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 UNEXPORT (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 UNINTERN (T *) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 UNION (T T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 UNREAD-CHAR (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 UNUSE-PACKAGE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 UPPER-CASE-P (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 USE-PACKAGE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 USER-HOMEDIR-PATHNAME (*) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 VALUES (*) * #.(flags ans set mv touch-mv)) +(proclaim2 VALUES-LIST (T) * #.(flags ans set mv touch-mv)) +(proclaim2 VECTOR (*) (VECTOR T) #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 VECTOR-POP (T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 VECTOR-PUSH (T T) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 VECTOR-PUSH-EXTEND (T T *) FIXNUM #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 VECTORP (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 WARN (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 WRITE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 WRITE-BYTE (INTEGER STREAM) INTEGER #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 WRITE-CHAR (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 WRITE-LINE (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 WRITE-STRING (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 WRITE-TO-STRING (T *) T #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 Y-OR-N-P (*) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 YES-OR-NO-P (*) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? +(proclaim2 ZEROP (T) BOOLEAN #.(flags ans set touch-mv)) ;Mv touched? + + +(proclaim2 si::structure-ref (t t fixnum) t #.(flags ans)) +(proclaim2 si::structure-set (t t fixnum t) t #.(flags ans set)) + diff --git a/comp/macros.lsp b/comp/macros.lsp new file mode 100755 index 0000000..6d502fc --- /dev/null +++ b/comp/macros.lsp @@ -0,0 +1,79 @@ +(in-package "BCOMP") + +;(dolist-safe (a b) (foo a)) +(defmacro dolist-safe ((x l &optional res) &body body) + (let ((l1 (gensym)) + (l2 (gensym))) + `(let* ( + (,l1 ,l) + (,l2 ,l1) + ,x) + (loop + (cond ((consp ,l1) + (setq ,x (car ,l1) ,l1 (cdr ,l1)) + ,@body) + ((null ,l1) + (return ,res)) + (t (comp-error "expected a list ~a" ,l2)))))))) + +;; go through a list safely signalling an error if not a true list. +(def-loop-for in-list (var lis) + (let ((point (gensym "POINT")) + (l1 (gensym))) + `(with ,point with ,l1 with ,var initially (setf ,l1 (setf ,point ,lis)) + do(or (consp ,point) + (comp-error "Expected a list ~a " ,l1)) + (desetq ,var (car ,point)) + end-test (and (null ,point)(local-finish)) + increment (setf ,point (cdr ,point))))) + +(def-loop-for on-list (point lis) + (let ((l1 (gensym))) + `(with ,point with ,l1 initially (setf ,l1 (setf ,point ,lis)) + do(or (consp ,point) + (comp-error "Expected a list ~a " ,l1)) + end-test (and (null ,point)(local-finish)) + increment (setf ,point (cdr ,point))))) + + +(defmacro safe-cdr (x) + (if (symbolp x) `(progn (or (consp ,x)(null ,x) + (comp-error "expected list ~a" ,x)) + (cdr ,x)) + (let ((xx (gensym))) + `(let ((,xx ,x)) + (safe-cdr ,xx))))) + + +(defmacro memq (a l) `(member ,a,l :test 'eq)) +(defmacro valex (a b form) + (let (binds ) + (or (eq b '*exit*) (push (list '*exit* b) binds)) + (or (eq a '*value*) (push (list '*value* a) binds)) + `(let ,binds ,form))) + +(defsetf logbitp logstore) +(defmacro logstore ( i a val) + `(setf (ldb (byte 1 ,i) ,a) (if ,val 1 0))) + + + +(defmacro argd-minargs(x) + `(the fixnum (ldb (byte 6 0) (the fixnum ,x)))) +(defmacro argd-maxargs(x) + `(the fixnum (ldb (byte 6 9) (the fixnum ,x)))) +(defmacro argd-flags(x) + `(the fixnum (ldb (byte 3 6) (the fixnum ,x)))) +(defmacro argd-atypes(x) + `(the fixnum (ldb (byte 16 15) (the fixnum ,x)))) +(defmacro argd-flag-p (x name) + `(logbitp ,(+ 6 (position name + '(requires-nargs sets-mv + requires-fun-passed))) + (the fixnum ,x) + )) + + +(defmacro ll (key lambda-list) + `(nth ,(position key (cons '&required lambda-list-keywords)) ,lambda-list)) + \ No newline at end of file diff --git a/comp/makefile b/comp/makefile new file mode 100644 index 0000000..0f87fc1 --- /dev/null +++ b/comp/makefile @@ -0,0 +1,37 @@ + +LISP=../unixport/saved_kcl + +LOAD='(load "sysdef.lsp")(make::make :bcomp :compile t)' + +all: + echo ${LOAD} | ${LISP} + + +tests: + echo ${LOAD}'(load "try1")(load "../tests/all-tests.lsp")(in-package "BCOMP")(do-some-tests)' \ + '(test-sloop)' | ${LISP} + + +test1: + echo '(load "../tests/try-comp")' | ${LISP} + + +TFILES=src/makefile comp/makefile unixport/makefile o/makefile \ + h/enum.h src/kclobjs src/sobjs src/NewInit src/make-init + +tar: + (cd .. ; tar cvf - ${TFILES} src/sobjs src/*.c src/*.el newh/*.el src/makefile comp/*.lsp comp/*.doc newh/*.h newh/makefile | gzip -c > ${HOME}/`date '+acl-%y%m%d'`.tar.z) + +all-tests: + $(MAKE) + - $(MAKE) tests test1 + - (cd /u11/wfs/nqthm1 ; rm *.o ; $(MAKE) "LISP=nacl") + - (cd /u11/wfs/gabriel ; $(MAKE) "LISP=nacl") + +tests2: + $(MAKE) + - $(MAKE) tests test1 + - (cd /u11/wfs/nqthm1 ; rm *.o ; $(MAKE) "LISP=nacl") + + +-include ../makedefs diff --git a/comp/mangle.lsp b/comp/mangle.lsp new file mode 100755 index 0000000..d8ffa6a --- /dev/null +++ b/comp/mangle.lsp @@ -0,0 +1,116 @@ +(in-package "BCOMP") +;; Naming convention +;; {f | s | q | l} +;; where f = Function, s = Symbol , q = special form (Quote) , l= Lexical +;; eg fLcar, sLnil, fSallocate_internal,sLAstandard_outputA.qLprogn + +(eval-when (load eval compile) +(defvar *mangle-base* (make-array 128 :element-type 'character)) +(defvar *mangle-escapes* (make-array 128 :element-type 'character)) +(defmacro mangle-type (flag) `(position ',flag '(octal self special-escape))) +(defvar *mangle-escape* #\E) + +(sloop for i below 128 with tem + for ch = (code-char i) + + do (setf (aref *mangle-escapes* i) (code-char 0)) + (setf (aref *mangle-base* i) (code-char (mangle-type octal))) + (when (alphanumericp ch) (setf (aref *mangle-base* i) + (if (upper-case-p ch) (char-downcase ch) + (char-upcase ch))))) + +(sloop for (v ch) in + '((#\+ #\Q)(#\- #\_)(#\* #\A)(#\% #\P) + (#\; #\X)(#\. #\Z)(#\, #\Y) + (#\ #\E) + (#\@ #\B) + ) + do (setf (aref *mangle-base* (char-code v)) ch) + (setf (aref *mangle-base* (char-code v)) ch) + (setf (aref *mangle-base* (char-code (char-downcase ch))) + (code-char (mangle-type special-escape))) + (setf (aref *mangle-escapes* (char-code (char-downcase ch))) + (char-downcase ch))) +(sloop for i from (char-code #\0) to (char-code #\9) + for j from (char-code #\A) + do (setf (aref *mangle-escapes* i) (code-char j))) + +(defvar *mangle-out* (make-array 40 :element-type 'string-char :fill-pointer 0 + :adjustable t)) +(proclaim '(string *mangle-out* *mangle-escapes* *mangle-base*)) +(proclaim '(character *mangle-escape*)) +) + + +(defun mangle(string) + (let ((string + (if (symbolp string) (symbol-name string) + string))) + (declare (string string)) + (let ((n (length string)) (start 0)) + (declare (fixnum n)) + (unless (> (array-total-size *mangle-out*) + (the fixnum (* 4 n))) + (adjust-array *mangle-out* (* 4 n) :fill-pointer 0 )) + (cond ((and (> n 0) + (digit-char-p (aref string 0))) + (setf (aref *mangle-out* 0) *mangle-escape*) + (setf (aref *mangle-out* 1) + (aref *mangle-escapes* (char-code (aref string 0)))) + (setf (fill-pointer *mangle-out*) 2) + (incf start)) + (t (setf (fill-pointer *mangle-out*) 0))) + (sloop for i from start below n + do (mangle1 (aref string i))) + *mangle-out*))) + +(defun mangle1 (ch ) + (declare (character ch)) + (let* ((tem (aref *mangle-base* (char-code ch))) + (n (char-code tem)) + (out *mangle-out*)) + (declare (character tem)(fixnum n)) + (cond ((> n (mangle-type special-escape)) + (vector-push tem *mangle-out*)) + ((= n (mangle-type special-escape)) + (vector-push *mangle-escape* out) + (vector-push (aref *mangle-escapes* (char-code ch) )out)) + ((= n (mangle-type octal)) + (vector-push #.(char-upcase *mangle-escape*) out) + (let ((m (char-code ch))) + (vector-push (code-char + (the fixnum (+ (logand (the fixnum + (ash m -6)) 7) + (char-code #\0)))) + out) + (vector-push (code-char + (the fixnum (+ (logand (the fixnum + (ash m -3)) 7) + (char-code #\0)))) + out) + (vector-push (code-char + (the fixnum (+ (logand m 7) + (char-code #\0)))) + out))) + (t (wfs-error))))) + +#+how_to_unmangle ;; get next character and unmangle it. +(defun unmangle-next () + (let ((y (get-next))) + (cond ((alpha-char-p y) + (cond ((lower-case-p y) (upcase-char y)) + ((eql y *mangle-escape*) + (let ((n (get-next))) + (cond ((digit-char-p n) + (make-octal-char n (get-next) (get-next))) + ((upper-case-p n) + (code-char (+ (char-code #\0) (- n (char-code #\A))))) + (t n)))) + ((car (rassoc (list n) + '((#\+ #\Q)(#\- #\_)(#\* #\A)(#\% #\P) + (#\; #\X)(#\. #\Z)(#\, #\Y) + (#\e #\E))))) + (t (char-downcase n)))) + (t y)))) + + diff --git a/comp/opts-base.lsp b/comp/opts-base.lsp new file mode 100755 index 0000000..81320bc --- /dev/null +++ b/comp/opts-base.lsp @@ -0,0 +1,52 @@ +(in-package "BCOMP") + +(defopt NTH-MV + ((fixnum) t #.(flags safe constantp) + "(fcall.nvalues > $0 ? fcall.values[$0] : sLnil)")) + +(defopt LIST-MV + (() t #.(flags proclaim safe ans ) "ListVector(fcall.nvalues,&fcall.values[0])") + ;(() dynamic-extent #.(flags safe ans ) + ; "ON_STACK_LIST_VECTOR(fcall.nvalues,&fcall.values[0])") + ) + +;(defopt pop-control-stack +; (() t #.(flags safe set) "CtlPop")) + +(defopt progv-bind + ((t t) fixnum #.(flags set safe) "IprogvBind(#0,#1)")) + +(defopt do-throw + ((t)t #.(flags proclaim set safe) "Ido_throw(#0)")) + +(defopt unique-id + (() t #.(flags ans safe) "alloc_object(t_spice)")) + +(defopt pass-values + (() * #.(flags proclaim mv safe) "fcall.values[0]")) + +(defopt nlj-active-off + (()t #.(flags safe set) "nlj_active=0;VsTop = SaveVs ")) + +;(defopt nlj-active-off +; (()t #.(flags safe set) "nlj_active=0; ")) + + +(defopt assign-args + (( *) t #.(flags safe set) do-assign-args)) + +(defopt funcall + ((t *) t #.(flags set ) + "@0;(VFUN_NARGS=($#-1),fcall.fun=$0,(type_of($0)==t_afun||type_of($0)==t_closure) + && F_PLAIN($0->sfn.Argd) ? *($0->sfn.Body) : fcalln)($@1)")) +(proclaim1 '(ftype (function (*) t) si::make-structure)) +(defopt si::make-structure ((t *) t #.(flags ans safe) "ImakeStructure($#,$*0)")) + + + + + + + + + diff --git a/comp/opts.lsp b/comp/opts.lsp new file mode 100755 index 0000000..db4ffaa --- /dev/null +++ b/comp/opts.lsp @@ -0,0 +1,492 @@ +(in-package "BCOMP") + +(defopt * + ((t t) t #.(flags ans safe) "number_times($0,$1)") + ((fix-or-sf-or-df fix-or-sf-or-df) short-float #.(flags safe) "(double)($0)*(double)($1)") + ((fix-or-sf-or-df fix-or-sf-or-df) double-float #.(flags safe) "(double)($0)*(double)($1)") + ((integer integer) integer #.(flags rfa is safe) "mulii($0,$1)") + ((integer integer integer) integer #.(flags rfa is safe) "mulii($0,mulii($1,$2))") + ((fixnum integer) integer #.(flags rfa is safe) "mulsi($0,$1)") + ((fixnum fixnum) fixnum #.(flags safe) "($0)*($1)")) +(defopt + + ((t t) t #.(flags ans safe) "number_plus($0,$1)") + ((fix-or-sf-or-df fix-or-sf-or-df) short-float #.(flags safe) "(double)($0)+(double)($1)") + ((fix-or-sf-or-df fix-or-sf-or-df) double-float #.(flags safe) "(double)($0)+(double)($1)") + ((integer integer) integer #.(flags rfa is safe) "addii($0,$1)") + ((integer integer integer) integer #.(flags rfa is safe) "addii($0,addii($1,$2))") + ((fixnum fixnum) fixnum #.(flags safe) "($0)+($1)")) +(defopt - + ((t) t #.(flags ans safe) "number_negate($0)") + ((t t) t #.(flags ans safe) "number_minus($0,$1)") + ((fix-or-sf-or-df fix-or-sf-or-df) short-float #.(flags safe) "(double)($0)-(double)($1)") + ((fix-or-sf-or-df) short-float #.(flags safe) "-(double)($0)") + ((fix-or-sf-or-df) double-float #.(flags safe) "-(double)($0)") + ((fix-or-sf-or-df fix-or-sf-or-df) double-float #.(flags safe) "(double)($0)-(double)($1)") + ((integer integer) integer #.(flags rfa is safe) "subii($0,$1)") + ((integer) integer #.(flags rfa is safe) "subii(gzero,$0)") + ((fixnum fixnum) fixnum #.(flags safe) "($0)-($1)") + ((fixnum) fixnum #.(flags safe) "-($0)")) +(defopt / + ((fix-or-sf-or-df fix-or-sf-or-df) short-float #.(flags rfa safe) "(double)($0)/(double)($1)") + ((fix-or-sf-or-df fix-or-sf-or-df) double-float #.(flags rfa safe) "(double)($0)/(double)($1)") + ((fixnum fixnum) fixnum #.(flags ) "($0)/($1)") + ) +(defopt /= + ((t t) boolean #.(flags safe) "number_compare($0,$1)!=0") + ((fix-or-sf-or-df fix-or-sf-or-df) boolean #.(flags safe) "($0)!=($1)")) +(defopt 1+ + ((t) t #.(flags ans safe) "one_plus($0)") + ((fix-or-sf-or-df) short-float #.(flags safe) "(double)($0)+1") + ((fix-or-sf-or-df) double-float #.(flags safe) "(double)($0)+1") + ((fixnum) fixnum #.(flags safe) "($0)+1")) +(defopt 1- + ((t) t #.(flags ans safe) "one_minus($0)") + ((fixnum) fixnum #.(flags safe) "($0)-1") + ((fix-or-sf-or-df) short-float #.(flags safe) "(double)($0)-1") + ((fix-or-sf-or-df) double-float #.(flags safe) "(double)($0)-1")) +(defopt < + ((t t) boolean #.(flags safe) "number_compare($0,$1)<0") + ((integer integer) boolean #.(flags safe) "cmpii($0,$1)<0") + ((fix-or-sf-or-df fix-or-sf-or-df) boolean #.(flags safe) "($0)<($1)")) +(defopt <= + ((t t) boolean #.(flags safe) "number_compare($0,$1)<=0") + ((integer integer) boolean #.(flags safe) "cmpii($0,$1)<=0") + ((fix-or-sf-or-df fix-or-sf-or-df) boolean #.(flags safe) "($0)<=($1)")) +(defopt = + ((t t) boolean #.(flags safe) "number_compare($0,$1)==0") + ((integer integer) boolean #.(flags safe) "cmpii($0,$1)==0") + ((fix-or-sf-or-df fix-or-sf-or-df) boolean #.(flags safe) "($0)==($1)")) +(defopt > + ((t t) boolean #.(flags safe) "number_compare($0,$1)>0") + ((integer integer) boolean #.(flags safe) "cmpii($0,$1)>0") + ((fix-or-sf-or-df fix-or-sf-or-df) boolean #.(flags safe) "($0)>($1)")) +(defopt >= + ((t t) boolean #.(flags safe) "number_compare($0,$1)>=0") + ((integer integer) boolean #.(flags safe) "cmpii($0,$1)>=0") + ((fix-or-sf-or-df fix-or-sf-or-df) boolean #.(flags safe) "($0)>=($1)")) +(defopt APPEND + ((t t) t #.(flags ans safe) "append($0,$1)")) +(defopt aref-2d + (((array t) fixnum fixnum fixnum) t #.(flags) "@0;($0)->a.Body[($1)*($3)+$2]")) +(defopt AREF + ((t t) t #.(flags ans safe) "aref1($0,fixint($1))") + ((t fixnum) t #.(flags ans safe) "aref1($0,$1)") + ((t t) t #.(flags ans) "aref1($0,fix($1))") + (((array t) fixnum) t #.(flags) "($0)->v.Body[$1]") + (((array character) fixnum) character #.(flags rfa) "($0)->ust.Body[$1]") + (((array fixnum) fixnum) fixnum #.(flags rfa) "($0)->fixa.Body[$1]") + (((array unsigned-char) fixnum) fixnum #.(flags rfa) "($0)->ust.Body[$1]") + (((array signed-char) fixnum) fixnum #.(flags rfa) "SIGNED_CHAR(($0)->ust.Body[$1])") + (((array unsigned-short) fixnum) fixnum #.(flags rfa) "((unsigned short *)($0)->ust.Body)[$1]") + (((array signed-short) fixnum) fixnum #.(flags rfa) "((short *)($0)->ust.Body)[$1]") + (((array short-float) fixnum) short-float #.(flags rfa) "($0)->sfa.Body[$1]") + (((array long-float) fixnum) double-float #.(flags rfa) "($0)->lfa.Body[$1]") + ((t t t) t #.(flags ans) "@0;aref($0,fix($1)*($0)->a.Dims[1]+fix($2))") + (((array t) fixnum fixnum) t #.(flags) "@0;($0)->a.Body[($1)*($0)->a.Dims[1]+$2]") + (((array character) fixnum fixnum) character #.(flags rfa) "@0;($0)->ust.Body[($1)*($0)->a.Dims[1]+$2]") + (((array fixnum) fixnum fixnum) fixnum #.(flags rfa) "@0;($0)->fixa.Body[($1)*($0)->a.Dims[1]+$2]") + (((array short-float) fixnum fixnum) short-float #.(flags rfa) "@0;($0)->sfa.Body[($1)*($0)->a.Dims[1]+$2]") + (((array long-float) fixnum fixnum) double-float #.(flags rfa) "@0;($0)->lfa.Body[($1)*($0)->a.Dims[1]+$2]")) +(defopt ARRAY-TOTAL-SIZE + ((t) fixnum #.(flags rfa) "(($0)->st.Dim)")) +(defopt ARRAYP + ((t) boolean #.(flags safe) "@0;type_of($0)==t_array|| +type_of($0)==t_vector|| +type_of($0)==t_string|| +type_of($0)==t_bitvector")) +(defopt SYSTEM:ASET + ((t t t) t #.(flags set safe) "aset1($0,fixint($1),$2)") + ((t fixnum t) t #.(flags set safe) "aset1($0,$1,$2)") + ((t t t) t #.(flags set) "aset1($0,fix($1),$2)") + (((array t) fixnum t) t #.(flags set) "($0)->v.Body[$1]= ($2)") + (((array character) fixnum character) character #.(flags set rfa) "($0)->ust.Body[$1]= ($2)") + (((array fixnum) fixnum fixnum) fixnum #.(flags set rfa) "($0)->fixa.Body[$1]= ($2)") + (((array signed-short) fixnum fixnum) fixnum #.(flags set rfa) "((short *)($0)->ust.Body)[$1]=($2)") + (((array signed-char) fixnum fixnum) fixnum #.(flags set rfa) "(($0)->ust.Body)[$1]=($2)") + (((array unsigned-short) fixnum fixnum) fixnum #.(flags set rfa) "((unsigned short *)($0)->ust.Body)[$1]=($2)") + (((array unsigned-char) fixnum fixnum) fixnum #.(flags set rfa) "(($0)->ust.Body)[$1]=($2)") + (((array short-float) fixnum short-float) short-float #.(flags set rfa) "($0)->sfa.Body[$1]= ($2)") + (((array long-float) fixnum double-float) double-float #.(flags set rfa) "($0)->lfa.Body[$1]= ($2)") + ((t t t t) t #.(flags set) "@0;aset($0,fix($1)*($0)->a.Dims[1]+fix($2),$3)") + (((array t) fixnum fixnum t) t #.(flags set) "@0;($0)->a.Body[($1)*($0)->a.Dims[1]+$2]= ($3)") + (((array character) fixnum fixnum character) character #.(flags set rfa) "@0;($0)->ust.Body[($1)*($0)->a.Dims[1]+$2]= ($3)") + (((array fixnum) fixnum fixnum fixnum) fixnum #.(flags set rfa) "@0;($0)->fixa.Body[($1)*($0)->a.Dims[1]+$2]= ($3)") + (((array short-float) fixnum fixnum short-float) short-float #.(flags set rfa) "@0;($0)->sfa.Body[($1)*($0)->a.Dims[1]+$2]= ($3)") + (((array long-float) fixnum fixnum double-float) double-float #.(flags set rfa) "@0;($0)->lfa.Body[($1)*($0)->a.Dims[1]+$2]= ($3)")) +(defopt ash + ((fixnum fixnum) fixnum #.(flags ) "@1;($1 > 0 ? ($0) <<( $1 ): ($0) >> (-($1)))")) +(defopt ATOM + ((t) boolean #.(flags safe) "type_of($0)!=t_cons")) +(defopt BIT-VECTOR-P + ((t) boolean #.(flags safe) "(type_of($0)==t_bitvector)")) +(defopt BOOLE3 + ((fixnum fixnum fixnum) fixnum #.(flags rfa safe) wr-inline-boole3)) +(defopt BOUNDP + ((t) boolean #.(flags) "($0)->s.Bind!=OBJNULL")) +(defopt CAAAAR + ((t) t #.(flags) "Mcaaaar($0)")) +(defopt CAAADR + ((t) t #.(flags) "Mcaaadr($0)")) +(defopt CAAAR + ((t) t #.(flags) "Mcaaar($0)")) +(defopt CAADAR + ((t) t #.(flags) "Mcaadar($0)")) +(defopt CAADDR + ((t) t #.(flags) "Mcaaddr($0)")) +(defopt CAADR + ((t) t #.(flags) "Mcaadr($0)")) +(defopt CAAR + ((t) t #.(flags) "Mcaar($0)")) +(defopt CADAAR + ((t) t #.(flags) "Mcadaar($0)")) +(defopt CADADR + ((t) t #.(flags) "Mcadadr($0)")) +(defopt CADAR + ((t) t #.(flags) "Mcadar($0)")) +(defopt CADDAR + ((t) t #.(flags) "Mcaddar($0)")) +(defopt CADDDR + ((t) t #.(flags) "Mcadddr($0)")) +(defopt CADDR + ((t) t #.(flags) "Mcaddr($0)")) +(defopt CADR + ((t) t #.(flags) "Mcadr($0)")) +(defopt CAR + ((t) t #.(flags) "Mcar($0)")) +(defopt CDAAAR + ((t) t #.(flags) "Mcdaaar($0)")) +(defopt CDAADR + ((t) t #.(flags) "Mcdaadr($0)")) +(defopt CDAAR + ((t) t #.(flags) "Mcdaar($0)")) +(defopt CDADAR + ((t) t #.(flags) "Mcdadar($0)" )) +(defopt CDADDR + ((t) t #.(flags) "Mcdaddr($0)")) +(defopt CDADR + ((t) t #.(flags) "Mcdadr($0)")) +(defopt CDAR + ((t) t #.(flags) "Mcdar($0)")) +(defopt CDDAAR + ((t) t #.(flags) "Mcddaar($0)")) +(defopt CDDADR + ((t) t #.(flags) "Mcddadr($0)")) +(defopt CDDAR + ((t) t #.(flags) "Mcddar($0)")) +(defopt CDDDAR + ((t) t #.(flags) "Mcdddar($0)")) +(defopt CDDDDR + ((t) t #.(flags) "Mcddddr($0)")) +(defopt CDDDR + ((t) t #.(flags) "Mcdddr($0)")) +(defopt CDDR + ((t) t #.(flags) "Mcddr($0)")) +(defopt CDR + ((t) t #.(flags) "Mcdr($0)")) +(defopt CHAR + ((t t) t #.(flags ans safe) "elt($0,fixint($1))") + ((t fixnum) t #.(flags ans safe) "elt($0,$1)") + ((t t) t #.(flags) "code_char(($0)->ust.Body[fix($1)])") + ((t fixnum) character #.(flags rfa) "($0)->ust.Body[$1]")) +(defopt CHAR-CODE + ((character) fixnum #.(flags rfa safe) "($0)")) +(defopt SYSTEM:CHAR-SET + ((t t t) t #.(flags set safe) "elt_set($0,fixint($1),$2)") + ((t fixnum t) t #.(flags set safe) "elt_set($0,$1,$2)") + ((t t t) t #.(flags set) "@2;(($0)->ust.Body[fix($1)]=char_code($2),($2))") + ((t fixnum character) character #.(flags set rfa) "($0)->ust.Body[$1]= ($2)")) +(defopt CHAR/= + ((character character) boolean #.(flags safe) "($0)!=($1)") + ((t t) boolean #.(flags) "!eql($0,$1)") + ((t t) boolean #.(flags) "char_code($0)!=char_code($1)")) +(defopt CHAR< + ((character character) boolean #.(flags safe) "($0)<($1)")) +(defopt CHAR<= + ((character character) boolean #.(flags safe) "($0)<=($1)")) +(defopt CHAR= + ((t t) boolean #.(flags) "eql($0,$1)") + ((t t) boolean #.(flags) "char_code($0)==char_code($1)") + ((character character) boolean #.(flags) "($0)==($1)")) +(defopt CHAR> + ((character character) boolean #.(flags safe) "($0)>($1)")) +(defopt CHAR>= + ((character character) boolean #.(flags safe) "($0)>=($1)")) +(defopt CHARACTERP + ((t) boolean #.(flags safe) "type_of($0)==t_character")) +(defopt CODE-CHAR + ((fixnum) character #.(flags safe rfa) "($0)") + ((t) character #.(flags rfa) "fix($0)")) +(defopt CONS + ((t t) t #.(flags ans constantp safe) "make_cons($0,$1)") + ((t t) dynamic-extent #.(flags ans safe) "ON_STACK_CONS($0,$1)")) +(defopt CONSP + ((t) boolean #.(flags safe) "type_of($0)==t_cons")) +(defopt COS + ((double-float) double-float #.(flags rfa safe) "cos($0)")) +(defopt DIGIT-CHAR-P + ((character) boolean #.(flags safe) "@0; (($0) <= '9' && ($0) >= '0')")) +(defopt ELT + ((t t) t #.(flags ans safe) "elt($0,fixint($1))") + ((t fixnum) t #.(flags ans safe) "elt($0,$1)") + ((t t) t #.(flags ans) "elt($0,fix($1))")) +(defopt SYSTEM:ELT-SET + ((t t t) t #.(flags set safe) "elt_set($0,fixint($1),$2)") + ((t fixnum t) t #.(flags set safe) "elt_set($0,$1,$2)") + ((t t t) t #.(flags set) "elt_set($0,fix($1),$2)")) +(defopt ENDP + ((t) boolean #.(flags) "($0)==sLnil")) +(defopt EQ + ((t t) boolean #.(flags safe) "($0)==($1)") + ((fixnum fixnum) boolean #.(flags safe) "0")) +(defopt EQL + ((t t) boolean #.(flags safe) "eql($0,$1)") + ((fixnum fixnum) boolean #.(flags safe) "($0)==($1)")) +(defopt EQUAL + ((t t) boolean #.(flags safe) "equal($0,$1)") + ((fixnum fixnum) boolean #.(flags safe) "($0)==($1)")) +(defopt EQUALP + ((t t) boolean #.(flags safe) "equalp($0,$1)") + ((fixnum fixnum) boolean #.(flags safe) "($0)==($1)")) +(defopt EXPT + ((t t) t #.(flags ans safe) "number_expt($0,$1)") + ((integer integer) integer #.(flags is safe) "powerii($0,$1)") + ((fixnum fixnum) fixnum #.(flags safe) + (lambda (l &aux (x1 (car l))tem) + (if (and (consp x1) (eq (car x1) 'inline-loc) + (consp (setq tem (third x1)))(eq 'dv (car tem)) + (eql (third tem) 2)) + (wr-inline-call1 l "(1 << ($1))") + (wr-inline-call1 l "fixnum_expt($@0)"))))) +(defopt FILL-POINTER + ((t) fixnum #.(flags rfa) "(($0)->st.Fillp)")) +(defopt SYSTEM:FILL-POINTER-SET + ((t fixnum) fixnum #.(flags set rfa) "(($0)->st.Fillp)=($1)")) +(defopt FIRST + ((t) t #.(flags) "Mcar($0)")) +(defopt SYSTEM:FIXNUMP + ((t) boolean #.(flags safe) "type_of($0)==t_fixnum") + ((fixnum) boolean #.(flags safe) "1")) +(defopt FLOAT + ((fix-or-sf-or-df) double-float #.(flags safe) "((doublefloat)($0))") + ((fix-or-sf-or-df) short-float #.(flags safe) "((shortfloat)($0))")) +(defopt FLOATP + ((t) boolean #.(flags safe) "@0;type_of($0)==t_shortfloat||type_of($0)==t_doublefloat")) +(defopt FLOOR + ((fixnum fixnum) fixnum #.(flags rfa safe) "@01;($0>=0&&($1)>0?($0)/($1):ifloor($0,$1))")) +(defopt FOURTH + ((t) t #.(flags) "Mcadddr($0)")) +(defopt COMPILER::FP-OK + ((t) fixnum #.(flags set) "@0;(type_of($0)==t_stream? (int)(($0)->sm.Fp): 0 )") + ((stream) fixnum #.(flags set) "(($0)->sm.Fp)")) +(defopt GET + ((t t t) t #.(flags safe) "get($0,$1,$2)") + ((t t) t #.(flags safe) "get($0,$1,sLnil)")) +(defopt INTEGERP + ((t) boolean #.(flags safe) "@0;type_of($0)==t_fixnum||type_of($0)==t_bignum")) +(defopt KEYWORDP + ((t) boolean #.(flags safe) "@0;(type_of($0)==t_symbol&&($0)->s.Hpack==keyword_package)")) +(defopt COMPILER::LDB1 + ((fixnum fixnum fixnum) fixnum #.(flags safe) "((((~(-1 << ($0))) << ($1)) & ($2)) >> ($1))")) +(defopt LENGTH + ((t) fixnum #.(flags rfa safe) "length($0)") + (((array t)) fixnum #.(flags rfa) "($0)->v.Fillp") + (((vector character)) fixnum #.(flags rfa) "($0)->v.Fillp")) +(defopt LIST + ((t *) t #.(flags ans safe constantp) "list($#,$@0)") + (() t #.(flags ans safe constantp) "sLnil") + ) +(defopt LIST* + ((t *) t #.(flags ans safe constantp) "listA($#,$@0)")) +(defopt LISTP + ((t) boolean #.(flags constantp safe) "@0;type_of($0)==t_cons||($0)==sLnil")) +(defopt LOGAND + ((fixnum fixnum) fixnum #.(flags rfa safe) "(($0) & ($1))")) +(defopt LOGIOR + ((fixnum fixnum) fixnum #.(flags rfa safe) "(($0) | ($1))")) +(defopt LOGNOT + ((fixnum) fixnum #.(flags rfa safe) "(~($0))")) +(defopt COMPILER::LONG-FLOAT-P + ((t) boolean #.(flags safe) "type_of($0)==t_doublefloat")) +(defopt MAKE-LIST + ((fixnum) dynamic-extent #.(flags ans safe) "@0;(ALLOCA_CONS($0),ON_STACK_MAKE_LIST($0))")) +(defopt MAX + ((t t) t #.(flags safe) "@01;(number_compare($0,$1)>=0?($0):$1)") + ((fixnum fixnum) fixnum #.(flags rfa safe) "@01;($0)>=($1)?($0):$1")) +(defopt MIN + ((t t) t #.(flags safe) "@01;(number_compare($0,$1)<=0?($0):$1)") + ((fixnum fixnum) fixnum #.(flags rfa safe) "@01;($0)<=($1)?($0):$1")) +(defopt MINUSP + ((t) boolean #.(flags safe) "number_compare(small_fixnum(0),$0)>0") + ((fix-or-sf-or-df) boolean #.(flags safe) "($0)<0")) +(defopt MOD + ((fixnum fixnum) fixnum #.(flags rfa safe) "@01;($0>=0&&($1)>0?($0)%($1):imod($0,$1))")) +(defopt SYSTEM:MV-REF + ((fixnum) t #.(flags ans set safe) "(MVloc[($0)])")) +(defopt NCONC + ((t t) t #.(flags set safe) "nconc($0,$1)")) +(defopt NOT + ((t) boolean #.(flags safe) "($0)==sLnil") + ((boolean) boolean #.(flags safe) "!($0)")) +(defopt NREVERSE + ((t) t #.(flags ans set safe) "nreverse($0)")) +(defopt NTH + ((t t) t #.(flags safe) "nth(fixint($0),$1)") + ((fixnum t) t #.(flags safe) "nth($0,$1)") + ((t t) t #.(flags) "nth(fix($0),$1)")) +(defopt NTHCDR + ((t t) t #.(flags safe) "nthcdr(fixint($0),$1)") + ((fixnum t) t #.(flags safe) "nthcdr($0,$1)") + ((t t) t #.(flags) "nthcdr(fix($0),$1)")) +(defopt NULL + ((t) boolean #.(flags safe) "($0)==sLnil")) +(defopt NUMBERP + ((t) boolean #.(flags safe) "@0;type_of($0)==t_fixnum|| +type_of($0)==t_bignum|| +type_of($0)==t_ratio|| +type_of($0)==t_shortfloat|| +type_of($0)==t_doublefloat|| +type_of($0)==t_complex")) +(defopt PLUSP + ((t) boolean #.(flags safe) "number_compare(small_fixnum(0),$0)<0") + ((fix-or-sf-or-df) boolean #.(flags safe) "($0)>0")) +(defopt PRIN1 + ((t t) t #.(flags set safe) "prin1($0,$1)") + ((t) t #.(flags set safe) "prin1($0,sLnil)")) +(defopt PRINC + ((t t) t #.(flags set safe) "princ($0,$1)") + ((t) t #.(flags set safe) "princ($0,sLnil)")) +(defopt PRINT + ((t t) t #.(flags set safe) "print($0,$1)") + ((t) t #.(flags set safe) "print($0,sLnil)")) +(defopt PROBE-FILE + ((t) boolean #.(flags safe) "(file_exists($0))")) +(defopt SYSTEM:PUTPROP + ((t t t) t #.(flags set safe) "putprop($0,$1,$2)")) +(defopt COMPILER::QFEOF + ((fixnum) boolean #.(flags set) "(feof((FILE *)($0)))")) +(defopt COMPILER::QGETC + ((fixnum) fixnum #.(flags set rfa) "($0=getc((FILE *)($0)))")) +(defopt COMPILER::QPUTC + ((fixnum fixnum) fixnum #.(flags set rfa) "(putc($0,((FILE *)($1))))") + ((character fixnum) fixnum #.(flags set rfa) "(putc($0,((FILE *)($1))))")) +(defopt COMPILER::READ-BYTE1 + ((t t) t #.(flags ans set) "read_byte1($0,$1)")) +(defopt COMPILER::READ-CHAR1 + ((t t) t #.(flags ans set) "read_char1($0,$1)")) +(defopt REM + ((integer integer) integer #.(flags rfa is safe) "dvmdii($0,$1,-1)") + ((integer fixnum) fixnum #.(flags rfa is safe) "(FIXtemp=(int)dvmdii($0,stoi($1),-1), (signe(FIXtemp)> 0 ? (int) + ((GEN)FIXtemp)[2] : (signe(FIXtemp)< 0 ? -(int)((GEN)FIXtemp)[2] : 0)))") + #+truncate_use_c ((fixnum fixnum) fixnum #.(flags rfa safe) "($0)%($1)")) +(defopt REMPROP + ((t t) t #.(flags set safe) "remprop($0,$1)")) +(defopt REST + ((t) t #.(flags) "Mcdr($0)")) +(defopt REVERSE + ((t) t #.(flags ans safe) "reverse($0)")) +(defopt RPLACD + ((t t) t #.(flags set) "@0;($0->c.Cdr=$1,$0)")) +(defopt RPLACA + ((t t) t #.(flags set) "@0;($0->c.Car=$1,$0)")) +(defopt SCHAR + ((t t) t #.(flags ans safe) "elt($0,fixint($1))") + ((t fixnum) t #.(flags ans safe) "elt($0,$1)") + ((t t) t #.(flags rfa) "code_char(($0)->ust.Body[fix($1)])") + ((t fixnum) character #.(flags rfa) "($0)->ust.Body[$1]")) +(defopt SYSTEM:SCHAR-SET + ((t t t) t #.(flags set safe) "elt_set($0,fixint($1),$2)") + ((t fixnum t) t #.(flags set safe) "elt_set($0,$1,$2)") + ((t t t) t #.(flags set) "@2;(($0)->ust.Body[fix($1)]=char_code($2),($2))") + ((t fixnum character) character #.(flags set rfa) "($0)->ust.Body[$1]= ($2)")) +(defopt SECOND + ((t) t #.(flags) "Mcadr($0)")) +(defopt SYSTEM:SET-MV + ((fixnum t) t #.(flags ans set safe) "(MVloc[($0)]=($1))")) +(defopt COMPILER::SHIFT<< + ((fixnum fixnum) fixnum #.(flags safe) "(($0) << ($1))")) +(defopt COMPILER::SHIFT>> + ((fixnum fixnum) fixnum #.(flags safe) "(($0) >> (- ($1)))")) +(defopt COMPILER::SHORT-FLOAT-P + ((t) boolean #.(flags safe) "type_of($0)==t_shortfloat")) +(defopt COMPILER::SIDE-EFFECTS + (nil t #.(flags ans set safe) "Ct")) +(defopt SIN + ((double-float) double-float #.(flags rfa safe) "sin($0)")) +(defopt SYSTEM:SPUTPROP + ((t t t) t #.(flags set safe) "sputprop($0,$1,$2)")) +(defopt COMPILER::STACK-CONS + ((fixnum t t) t #.(flags safe) "(STcons$0.t=t_cons,STcons$0.m=0,STcons$0.Car=($1), + STcons$0.Cdr=($2),(object)&STcons$0)") + ((fixnum t t) t #.(flags safe) "(STcons$0.t=t_cons,STcons$0.m=0,STcons$0.Car=($1), + STcons$0.Cdr=($2),(object)&STcons$0)")) +(defopt STRING + ((t) t #.(flags ans safe) "coerce_to_string($0)")) +(defopt STRINGP + ((t) boolean #.(flags safe) "type_of($0)==t_string")) +(defopt SYSTEM:STRUCTURE-DEF + ((t) t #.(flags) "($0)->str.Def")) + +(defopt SYSTEM:STRUCTURE-REF + ((t t fixnum) t #.(flags ans safe) "structure_ref($0,$1,$2)") + ((t t fixnum) t #.(flags ) do-structure-ref) + (((struct fixnum) t fixnum) fixnum #.(flags ) do-structure-ref) + (((struct character) t fixnum) character #.(flags ) do-structure-ref) + (((struct double-float) t fixnum) double-float #.(flags ) do-structure-ref) + (((struct short-float) t fixnum) short-float #.(flags ) do-structure-ref) + ) + +(defopt SYSTEM:STRUCTURE-SET + ((t t fixnum t) t #.(flags set safe) "structure_set($0,$1,$2,$3)") + ((t t fixnum t) t #.(flags set ) do-structure-set) + (((struct fixnum) t fixnum fixnum) fixnum #.(flags set ) do-structure-set) + (((struct character) t fixnum character) character #.(flags set ) do-structure-set) + (((struct double-float) t fixnum double-float) double-float #.(flags set ) do-structure-set) + (((struct short-float) t fixnum short-float) short-float #.(flags set ) do-structure-set) + ) +(defopt SYSTEM:STRUCTUREP + ((t) boolean #.(flags safe) "type_of($0)==t_structure")) +(defopt COMPILER::SUBLIS1 + ((t t t) t #.(flags ans set safe) compiler::sublis1-inline)) +(defopt SVREF + ((t t) t #.(flags ans safe) "aref1($0,fixint($1))") + ((t fixnum) t #.(flags ans safe) "aref1($0,$1)") + ((t t) t #.(flags) "($0)->v.Body[fix($1)]") + ((t fixnum) t #.(flags) "($0)->v.Body[$1]")) +(defopt SYSTEM:SVSET + ((t t t) t #.(flags set safe) "aset1($0,fixint($1),$2)") + ((t fixnum t) t #.(flags set safe) "aset1($0,$1,$2)") + ((t t t) t #.(flags set) "(($0)->v.Body[fix($1)]=($2))") + ((t fixnum t) t #.(flags set) "($0)->v.Body[$1]= ($2)")) +(defopt COMPILER::SYMBOL-LENGTH + ((t) fixnum #.(flags rfa safe) "@0;(type_of($0)==t_symbol ? ($0)->s.Fillp :not_a_variable(($0)))")) +(defopt SYMBOL-NAME + ((t) t #.(flags ans safe) "symbol_name($0)")) +(defopt SYMBOL-PLIST + ((t) t #.(flags) "(($0)->s.Plist)")) +(defopt SYMBOLP + ((t) boolean #.(flags safe) "type_of($0)==t_symbol")) +(defopt TAN + ((double-float) double-float #.(flags rfa safe) "tan($0)")) +(defopt TERPRI + ((t) t #.(flags set safe) "terpri($0)") + (nil t #.(flags set safe) "terpri(sLnil)")) +(defopt THIRD + ((t) t #.(flags) "Mcaddr($0)")) +(defopt TRUNCATE + ((integer integer) integer #.(flags rfa is safe) "dvmdii($0,$1,0)") +#+truncate_use_c ((fixnum fixnum) fixnum #.(flags rfa safe) "($1)/($2)") + ((fix-or-sf-or-df) fixnum #.(flags safe) "(fixnum)($0)")) +(defopt COMPILER::VECTOR-TYPE + ((t fixnum) boolean #.(flags safe) "@0;(type_of($0) == t_vector && ($0)->v.Elttype == ($1))")) +(defopt VECTORP + ((t) boolean #.(flags safe) "@0;type_of($0)==t_vector|| +type_of($0)==t_string|| +type_of($0)==t_bitvector")) +(defopt WRITE-CHAR + ((t) t #.(flags set) "@0;(writec_stream(char_code($0),Vstandard_output->s.Bind),($0))")) +(defopt ZEROP + ((t) boolean #.(flags safe) "number_compare(small_fixnum(0),$0)==0") + ((integer) boolean #.(flags rfa safe) "lgef($0)==2") + ((fix-or-sf-or-df) boolean #.(flags safe) "($0)==0")) + + diff --git a/comp/proclaim.lsp b/comp/proclaim.lsp new file mode 100755 index 0000000..2274894 --- /dev/null +++ b/comp/proclaim.lsp @@ -0,0 +1 @@ +(in-package "BCOMP") diff --git a/comp/smash-oldcmp.lsp b/comp/smash-oldcmp.lsp new file mode 100755 index 0000000..384396e --- /dev/null +++ b/comp/smash-oldcmp.lsp @@ -0,0 +1,7 @@ + +(dolist (v '((compile-file . bcomp::compile-file1) + (proclaim . bcomp::proclaim1) + (disassemble . bcomp::disassemble1))) + (setf (symbol-function (car v)) (symbol-function (cdr v)))) + +(setq compiler::*cc* (si::concatenate 'string compiler::*cc* " -g ")) diff --git a/comp/stmt.lsp b/comp/stmt.lsp new file mode 100755 index 0000000..6b60c95 --- /dev/null +++ b/comp/stmt.lsp @@ -0,0 +1,407 @@ +(in-package "BCOMP") +;; pass 2 c compilation + +(defvar *value* + ;; indicates where to store the value of the current expression being + ;; computed. + ;; one of '(var ) + ;; '(mv ) + ;; '(ignore) + ) + +(setf (get 'nil 'dv) "sLnil") +(setf (get 't 'dv) "sLt") + +;; This function is the main dispatch. It causes writing out of the +;; code for x. An implicit *value* is set during this write out. +;; The code for doing that is in b2-call, b2-var, b2-return, and +;; any other primitives which might return a value. Note things like +;; progn, let, prog1, all just call expr-b2 on their last term. + +(defun expr-b2(x &aux fd) + (cond ((consp x) + (setq fd (get (car x) 'b2)) + (cond (fd (funcall fd x)) + (t (wfs-error)))) + ((typep x 'var) + (unwind-set x)) + ((eq x nil) + (unwind-set '(dv "sLnil" nil))) + ((eq x t) + (unwind-set '(dv "sLt" t))) + (t (wfs-error)))) + +(setf (get 'call 'b2) 'b2-call) + +(defun maybe-push-avma-bind () + (sloop for v on *control-stack* + do (cond ((or (eq (car v) 'avma-bind) + (eq (car v) 'avma-bind-needed)) + (return nil)) + ((typep (car v) 'label) + (loop-finish))) + finally + (push 'avma-bind *control-stack*) + (return *control-stack*))) + + +(defun b2-call (x &aux type-wanted (loc (second *value*)) tem avma-bind) + + (cond ((eq (car *value*) 'mv) (setq type-wanted 'mv)) + (loc + (cond ((typep loc 'var) + (setq type-wanted (var-type loc))) + ((and (consp loc) (eq (car loc) 'var)) + (setq type-wanted (third loc))) + (t (wfs-error)))) + (t (setq type-wanted t))) + + + (setq avma-bind (maybe-push-avma-bind)) + + (setq tem (cons 'inline-call + (cdr (inline-call x type-wanted )))) + (cond ((eq (car *value*) 'ignore) + (unwind-set tem avma-bind)) + (t (let ((*MV-N-VALUES-SET* *MV-N-VALUES-SET*)) + ;; We must communicate whether or not this inline-call + ;; sets multiple values, before we replace it by a temp + (when (unwind-stack-p (cdr *exit*)) + (if (flag-p (opt flag (cddr tem)) mv) + (setq *MV-N-VALUES-SET* t)) + (setq tem (replace-inline-by-temp tem))) + (unwind-set tem avma-bind)))) + ) + +(setf (get 'setq 'b2) 'b2-setq) + +(defun b2-setq (form &aux last) + ;;(setq desk var val var val..) + (do ((x (cddr form) (cddr x))) + ((null x)) + (setq last (car x)) + (valex (list 'var last) (next-exit) (expr-b2 (second x)))) + (unwind-set last)) + + + +(setf (get 'tagbody 'b2) 'b2-tagbody) + +(defun b2-tagbody (x &aux bod lab + all-labels it + (*blocks* 0) + (*control-stack* *control-stack*)) + (setq bod (third x)) + (dolist (v bod) + (when (and (consp v) (eq (car v) 'label)) + (setq lab (second v)) + (setf (label-ind lab) (next-label)) + (push lab all-labels))) + (sloop for v on *control-stack* + when (or (eq (car v) 'avma-bind) + (eq (car v) 'avma-bind-needed)) + do (push 'inner-avma *control-stack*) + (open-block) (wr "long InnerAvma=avma;") (return nil)) + + (setq *control-stack* (nconc all-labels *control-stack*)) + (sloop for v on bod do (setq it (car v)) + (valex '(ignore) (next-exit) (expr-b2 it))) + ;; this should do the unwinding to the outside frame. + (cond ((and (consp it) (or (eq (car it) 'return-from) + (eq (car it) 'go))) + ;;I don't even think this unwind-stack is necessary. + ;; I don't see hwo it will be reached. + (unwind-stack (cdr *exit*))) + (t (expr-b2 (get-object nil)))) + (close-blocks) + ) + +(setf (get 'label 'b2) 'b2-label) + +(defun b2-label (x &aux (lab (second x))) + (or (typep lab 'label) (wfs-error)) + (wr-label x) (wr ";")) + +(setf (get 'go 'b2) 'b2-go) + +(defun b2-go (x &aux lab) + (setq lab (cadr x)) + (let ((upto (member lab *control-stack* :test 'eq))) + (or upto + (wfs-error)) + (unwind-stack upto) + (wr-go lab))) + + +(setf (get 'if 'b2) 'b2-if) + +(defmacro ifb (x y) `(nth ,(position x '(test then else)) (cddr ,y))) + +(defun dv-p (x) (and (consp x) (eq (car x) 'dv))) + +(defun trans-if (x &aux test then else t-test t-then t-else + lab new (desk (second x))) +;; transform an if expression so that the TEST is neither an IF nor a CONSTANT. + + (desetq (test then else) (cddr x)) + (cond ((and (consp test) (eq (car test) 'if)) + (setq t-then (ifb then test) t-else (ifb else test) + t-test (ifb test test)) + (setq lab (make-label)) + (cond ((dv-p t-then)) + ((dv-p t-else) + (setq t-test (do-not t-test)) + (rotatef t-then t-else)) + (t (return-from trans-if x))) + (setq new + (cond ((null (third t-then)) + `(if ,desk,t-test (progn ,desk ((nlabel ,lab) ,else)) + (if ,desk ,t-else ,then (go ,lab) ))) + (t + `(if ,(second x),t-test (progn ,desk ((nlabel ,lab) ,then)) + (if ,desk ,t-else (go ,lab) ,else)))))) + ((dv-p test) + (setq new (if (third test) then else)) + (cond ((and (consp new) (eq (car new) 'if)) + (setq new (trans-if new)))) + (return-from trans-if new))) + (cond (new (trans-if new)) + (t x))) + +(defun do-not (x) + `(call ,(make-desk 'boolean) + ,(make-call-data 'not (list x) nil nil))) + +(setf (get 'nlabel 'b2) 'b2-nlabel) +(defun b2-nlabel (x) + (push (second x) *control-stack*) + (wr-label (second x)) (wr ";")) + +(defun b2-if (form &aux test then else (*control-stack* *control-stack*) avma-bind) + (setq form (trans-if form)) + (unless (and (consp form) (eq (car form) 'if)) + (return-from b2-if (expr-b2 form))) + (desetq (test then else) (cddr form)) + (setq avma-bind (maybe-push-avma-bind)) + (let ((tem (inline-arg test 'boolean nil (cons nil nil)))) + (when avma-bind + (cond ((eq (car avma-bind) 'avma-bind-needed) + (let ((tem1 (get-temp 'boolean))) + (valex (list 'var tem1) (next-exit) + (unwind-set tem avma-bind)))) + (t (remove-avma-bind avma-bind)))) + (wr-nl "if(" tem "){")) + (let ((*blocks* 0)) + (expr-b2 then) + (close-blocks) (wr "}")) + (unless (and + (or (atom else) (eq (car else) 'dv)) + (eq (car *value*) 'ignore) + (eq (car *exit*) 'next) + (not (unwind-stack-p (cdr *exit*)))) + (let ((*blocks* 0)) + (wr-nl "else ") + (open-block) + (expr-b2 else) + (close-blocks))) + ) + +(setf (get 'block 'b2) 'b2-block) + +(defun b2-block (x &aux sform block bod dsk + end-label + (*control-stack* *control-stack*)) + (desetq (sform dsk block bod) x) + (push block *control-stack*) + (setq end-label (make-label)) + (setf (block-exit block) + (cond ((eq (car *exit*) 'next) + (cons end-label (cdr *exit*))) + (t *exit*))) + (setf (block-value block) *value*) + (valex *value* (block-exit block) (progn-b2 bod)) + (cond ((label-ind end-label) + (wr-label end-label) (wr ";")))) + +(setf (get 'return-from 'b2) 'b2-return-from) + +(defun b2-return-from (x &aux block form tem) + (desetq (block form) (cddr x)) + (cond ((setq tem (member block *control-stack*)) + (valex (block-value block) (block-exit block) (expr-b2 form))) + (t (wfs-error)))) + +(setf (get 'the 'b2) 'b2-the) + +(defun b2-the (x) + (expr-b2 (third x))) + +(defun fdata-to-obj (fdat ) + (or (typep fdat 'fdata) (wfs-error)) + (or (fdata-ind fdat) (setf (fdata-ind fdat) (incf *next-function*))) + (cond ((fdata-closure-vars fdat) + (let ((args (mapcar #'(lambda (x) (list 'var (var-ind x))) + (fdata-closure-vars fdat)))) + (list 'inline-call (list* + (get-load-time-form 'si::%memory) + fdat + args) + '(*) t #.(flags ans) + (format nil "MakeClosure(~a,~a,$@0)" + (length (fdata-closure-vars fdat)) + (fdata-to-argd fdat) + )))) + (t + (list 'inline-call + (list fdat + (fdata-to-argd fdat) + (get-load-time-form 'si::%memory) + ) '(t fixnum t) t #.(flags ans constantp) + "MakeAfun($0,$1,$2)" )))) + +(setf (get 'pointer-to-funobj 'b2) 'b2-pointer-to-funobj) +(defun b2-pointer-to-funobj (x &aux ans tem) + (setq tem (second x)) + (cond ((and (consp tem) (eq (car tem) 'lambda-block)) + (setq tem (second tem)))) + (setq ans (fdata-to-obj tem)) + (unwind-set ans)) + +(setf (get 'lambda-block 'b2) 'b2-lambda-block) +(setf (get 'lambda 'b2) 'b2-lambda-block) + +(defun b2-lambda-block (x &aux result (*used-names* *used-names*)) + (let ((fdat (second x))) + (unless (fdata-ind fdat) + (setf (fdata-ind fdat) + (mangle-name (fdata-name fdat) 'function))) + (push (list 'local-function x) *local-funs*) +; (wr-h "static object " fdat "();") + (setq result (fdata-to-obj fdat)) + (unwind-set result))) + +(defun might-touch-mv (x) + ;; This needs expanding to handle functions like LIST,+, + ;; .. etc which do not touch mv + (not (or (atom x) (eq (car x) 'var) (eq (car x) 'dv)))) +(setf (get 'values 'b2) 'b2-values) + +(defun b2-values (x &aux (argl (third x)) avma-bind) + (cond ((eq (car *value*) 'mv) + (setq avma-bind (maybe-push-avma-bind)) + (let ((args (car (inline-args argl '(*))))) + (sloop for v on args + when (and (consp (car v)) (might-touch-mv (car v))) + do (setf (car v) (replace-inline-by-temp (car v)))) + (when (cdr args) + (wr-nl "{obj *MVptr = &fcall.values[1];" + "*MVptr =" (second args) ";") + (dolist (v (cddr args))(wr "*(++MVptr) = " v ";")) + (wr "}")) + (wr " fcall.nvalues=" (length args) ";") + (let ((*MV-N-VALUES-SET* t)) + (unwind-set (if args (car args) (get-object nil)) avma-bind)) + )) + (argl (expr-b2 (car argl))) + (t (expr-b2 (get-object nil))))) + +(setf (get 'call-set-mv 'b2) 'b2-call-set-mv) + +(defun b2-call-set-mv (x &aux form) +;; invoke form setting up multiple-values. +;; x == (call-set-mv desk form) + (setq form (third x)) + (valex `(mv (var "fcall.values[0]")) (next-exit) (expr-b2 form))) + +(setf (get 'progv 'b2) 'b2-progv) + +(defun b2-progv (x &aux binds body) + (desetq (binds body) (cddr x)) + (let ((tem (get-temp 'fixnum))) + (valex `(var ,tem) (next-exit) (expr-b2 binds)) + (let ((*control-stack* (cons `(progv-bind ,tem) *control-stack*))) + (progn-b2 body)))) + +(setf (get 'flet 'b2) 'b2-flet) + +(defun b2-flet (x &aux binds body fd) + (desetq (binds body) (cddr x)) + (sloop for v in binds + do + (setq fd (cadr (third v))) + (or (typep fd 'fdata) (wfs-error)) + (or (fdata-ind fd) (setf (fdata-ind fd) (incf *next-function*))) + (valex '(ignore) (next-exit) + (expr-b2 (third v))) + ) + (progn-b2 body)) + +(defun do-assign-args (x &aux reqs) + (setq reqs (ll &required (fdata-ll *fdata*))) + (or (eql (length x) (length reqs)) + (comp-error "Wrong number of args in call to ~a " (fdata-name *fdata*))) + (sloop for v in reqs + for val in x + do (wr-set-inline-loc (car v) val) + ) + ) + +(defvar *aet-types* + #(T STRING-CHAR SIGNED-CHAR FIXNUM SHORT-FLOAT DOUBLE-FLOAT + SIGNED-CHAR + UNSIGNED-CHAR SIGNED-SHORT UNSIGNED-SHORT)) + +(defun aet-type (i) (aref *aet-types* i)) + +(defun aet-c-type (type) + (ecase type + ((t) "object") + ((string-char signed-char) "char") + (fixnum "fixnum") + (unsigned-char "unsigned char") + (unsigned-short "unsigned short") + (signed-short "short") + (unsigned-short "unsigned short") + (double-float "double") + (short-float "float"))) + +(defun do-structure-ref (iargs &aux x name ind (index 0) sd) + (declare (fixnum index)) + (setq x (car iargs) name (second iargs) ind (third iargs)) + (or (and (consp ind) (eq (car ind)'inline-loc) + (dv-p (third ind))) (wfs-error)) + (setq index (third (third ind))) + (setq sd (get (third name) 'si::s-data)) + (or sd (wfs-error)) + (let* ((aet (aref (si::s-data-raw sd) index)) + (c-type (aet-c-type (aref *aet-types* aet))) + (pos (aref (si::s-data-slot-position sd) index))) + (wr "STREF(" c-type "," x "," pos")"))) + +(defun do-structure-set (iargs) + (let ((rargs (butlast iargs))) + (do-structure-ref rargs) + (wr " = " (car (last iargs))))) + +(defun si::setf-structure-access (struct type index newvalue) + (case type + (list `(si:rplaca-nthcdr ,struct ,index ,newvalue)) + (vector `(si:aset ,struct ,index ,newvalue)) + (t + (let ((sd (get type 'si::s-data))) + (when sd + (let ((res-type (comp-type(aet-type (aref (si::s-data-raw sd) index))))) + (cond ((eq res-type t) + `(si::structure-set ,struct ',type ,index ,newvalue)) + (t `(the ,res-type + (si::structure-set + (the (struct ,res-type),struct) ',type ,index + (the ,res-type ,newvalue))))))))))) + + +(setf (get 'eval-when 'b2) 'b2-eval-when) +(defun b2-eval-when + (x) + (progn-b2 (cddr x))) + + diff --git a/comp/sysdef.lsp b/comp/sysdef.lsp new file mode 100755 index 0000000..f8f9db1 --- /dev/null +++ b/comp/sysdef.lsp @@ -0,0 +1,23 @@ +(in-package "BCOMP" :use '("LISP" "SLOOP")) +(setq compiler::*cc* (concatenate 'string compiler::*cc* " -I../newh -I../h")) +(setf macros '(defmacro data defs macros wr)) +(require "MAKE" "../lsp/make.lisp") +(setf files '( var c-pass1 fasdmacros lambda top top1 + bo1 + inline top2 stmt exit + mangle + utils comptype)) +(proclaim '(optimize (speed 0))) +(setf (get :bcomp :make) + `((:serial ,@ macros) + ,@ files + (:progn (unless (get 'list 'bcomp-opt) + (load "lisp-decls.doc") + (load "opts.lsp")) + (load "opts-base.lsp") + ) + (:depends ,files ,macros))) +(setf (get :bcomp :source-path) "foo.lsp") +(setf (get :bcomp :object-path) "foo.o") + + diff --git a/comp/top.lsp b/comp/top.lsp new file mode 100755 index 0000000..88c1992 --- /dev/null +++ b/comp/top.lsp @@ -0,0 +1,92 @@ +(in-package "BCOMP") + +(eval-when (compile eval load) + +(defparameter *comp-vars* '(*c-output* *h-output* *lsp-input* *data-output* + *next-vv* + *data* + *data-table* + *hard-error* + *top-form* + *top-forms* + )) +(proclaim (cons 'special *comp-vars*)) +) + +(defun get-output-pathname (ext) + (declare (special input-pathname )) + (setq input-pathname (pathname input-pathname)) + (let ((dir (pathname-directory *default-pathname-defaults*))) + (make-pathname :directory + (or (pathname-directory input-pathname) + dir) + :name + (pathname-name input-pathname) + :type + ext))) + +(defvar *safety* 0 + ;; the safety level set by proclaim '(optimize (safety n)) + ) +(defvar *speed* 3 + ;; the desired speed level of the final code. The higher the + ;; speed the slower the compilation, but the faster the code runs. + ) +(proclaim '(fixnum *safety* *space* *speed*)) + +(defun open-out (ext flag) + (if (streamp flag) flag + (open (get-output-pathname ext) :direction :output))) + +(defun compile-file1 (input-pathname + &key output-file (load nil) (message-file nil) + system-p (c-debug t) + (c-file t) (h-file t)( data-file t) + (o-file t) + &aux (*package* *package*) + (*readtable* *readtable*)) + (declare (special input-pathname output-file c-debug)) + message-file system-p + (progv *comp-vars* '#. (make-list (length *comp-vars*)) + (unwind-protect + (progn + (setq *data-table* (make-hash-table :test 'eql)) + (setq *data* (list (make-array 50 :fill-pointer 0 ))) + (setq *lsp-input* (open input-pathname)) + + (execute-pass-1) + + (setq *c-output* (open-out "c" c-file)) + (setq *h-output* (open-out "h" h-file)) + (setq *data-output* (open-out "data" data-file)) + + (execute-pass-2) + + (compile-and-add-data-file o-file) + (let ((out (get-output-pathname "o"))) + (and output-file + (rename-file out output-file)) + (if load (load out)) + out) + + + ) + + ;; unwind protect forms: + (flet ((maybe-delete (f flag) + (cond ((and (streamp f) + (not (eq f flag))) + (close f) + (if (not flag) + (delete-file (pathname f))))))) + (maybe-delete *c-output* c-file) + (maybe-delete *h-output* h-file) + (maybe-delete *data-output* data-file) + (if (streamp *lsp-input*) (close *lsp-input*)) + )))) + + + + + + \ No newline at end of file diff --git a/comp/top1.lsp b/comp/top1.lsp new file mode 100755 index 0000000..20b56b5 --- /dev/null +++ b/comp/top1.lsp @@ -0,0 +1,137 @@ +(in-package "BCOMP") + + +(setf (get 'eval-when 't1) 't1eval-when) +(setf (get 'progn 't1) 't1progn) +(setf (get 'defun 't1) 't1top-macro) +(setf (get 'quote 't1) 't1ignore) +(setf (get 'defmacro 't1) 't1top-macro) +(setf (get 'defvar 't1) 't1top-macro) +(setf (get 'defparameter 't1) 't1top-macro) + + +(defun t1top-macro (x) + (let ((*top-form* x)) + (setq x (macroexpand x)) + (pass-1 x))) + + +(defun t1ignore (form) form nil) + +(defvar *changed* nil) +(defvar *FUNCTION-DECLS* nil) +(defvar *in-pass-1* nil) + +(defun execute-pass-1 ( &aux (eof '(nil)) tem + (*in-pass-1* t) + (*changed* + (make-array 40 :fill-pointer 0 :adjustable t))) + (sloop while (not (eq eof (setq tem (read *lsp-input* nil eof)))) + do (pass-1 tem)) + (setq *top-forms* (nreverse *top-forms*)) + ) + +(defvar *eval-when-defaults* :defaults) + +(dolist + (v '(si::*make-special si::*make-constant proclaim si::define-macro + make-package in-package shadow shadowing-import export unexport + si::define-structure + use-package unuse-package import provide require)) + (setf (get v 'eval-at-compile) t)) + + +;; return t if we do an eval, +(defun maybe-comp-eval (default-action form) + (or default-action + (and (symbolp (car form)) + (setq default-action (get (car form) 'eval-at-compile)))) + (cond + ((or (and default-action (eq :defaults *eval-when-defaults*)) + (and (consp *eval-when-defaults*)(member 'compile *eval-when-defaults* ))) + (comp-eval form) + t))) + +(defun t1eval-when (x &aux do-load do-compile) + (sloop for v in-list (second x) + do + (case v + (eval) + (load (setq do-compile t)) + (compile (setq do-compile t)) + (otherwise (comp-error "Bad arg to eval-when ~a" v)))) + (let ((*eval-when-defaults* (second x))) + (cond (do-compile (t1progn (cddr x)))))) + + +(defun walk-top-form (x &aux (*top-form* x)) + (let* (*contains-function* + (tem (walk-top x))) + (setq tem + (make-top-form + :lisp x + :walked tem + :funp *contains-function*)))) + +(defvar *variable-decls*) +(defvar *function-decls*) + +(defun pass-1 (x &aux *variable-decls* fd) + ;; fix for symbol macro + (cond ((atom x) (return-from pass-1 nil))) + (cond ((symbolp (car x)) + (cond ((setq fd (get (car x) 't1)) + (funcall fd x)) + ((macro-function (car x)) + (setq x (macroexpand x)) + (pass-1 x)) + (t + (maybe-comp-eval nil x) + (push (walk-top-form x) *top-forms*) + ))) + ((and (consp (car x)) (eq (caar x) 'lambda)) + (pass-1 `(funcall (function ,(car x)) ,@ (cdr x)))) + (t (comp-error "Unexpected form ~a" x)))) + +(setf (get 'si::defmacro* 'b1) 'b1-defmacro*) + + +(setf (get 'si::fset 't1) 't1-set) + +(setf (get 'mset 't1) 't1-set) + + +;; use for fset,define-macro and defvar +(defun t1-set (form &aux var val sform) + (maybe-comp-eval nil form) + (desetq (sform var val) form) + (or (and (consp var) (eq (car var) 'quote) + (symbolp (second var))) (error "expected a symbol")) + (push `(,sform ,var ,(walk-top-form val)) *top-forms*) + ) + + +(defun t1progn(form) + (sloop for v in-list form do (pass-1 v))) + +(defun b1-defmacro* (form where) + (let* ((tem (comp-eval form))) + (push 'list tem) + (b1-walk tem where))) + + +(defun comp-eval (form ) + (multiple-value-bind (error res) + (si::error-set `(eval ',form)) + (or error (return-from comp-eval res))) + (comp-error "Evaluation of ~s failed" form)) + + + + + + + + + + diff --git a/comp/top2.lsp b/comp/top2.lsp new file mode 100755 index 0000000..f9f12f7 --- /dev/null +++ b/comp/top2.lsp @@ -0,0 +1,1086 @@ +(in-package "BCOMP") +;; pass 2 c compilation + +(eval-when (compile eval load) + +(defparameter + *pass-2-vars* '( + *address-vector* + ;; At load time the index in *cfun-addresses* + ;; will be the address of the function. This *address-vector* is used + ;; at the end to create this vector in the .h file. + *next-data* + ;; is the next data index available + *next-label* + ;; is next label available number + *next-function* + ;; next function number as `3' in L3 + *blocks* + ;; number of '{' we have nested using open-block + *next-cvar* + ;; is next c variable number + *file-inline-templates* + *local-funs* + ;; are extra-local-funs to do + *local-inline-templates* + ;; inline templates + *top-level-closure-vars* + ;; call links. + *links* + ;; alist of forms to eval at load time and put in constant vector. + *load-time-forms* + ;; if not nil open a block + *do-pending-open* + )) + +(proclaim (cons 'special *pass-2-vars*)) + + ) + +(defun vararg-p (fd) + (let ((ll (fdata-ll fd))) + (or (ll &optional ll) + (ll &rest ll) + (ll &key ll)))) + +(eval-when (load compile eval) + +(defvar *illegal-names* (make-hash-table :size 100 :test 'equal)) +(unless +; (gethash "case" *illegal-names*) + (dolist (v'(;;C reserved words: + "do" "for" "sizeof" "typedef" "extern" "static" "auto" + "register" "void" "char" "short" "int" "long" "float" "double" + "signed" "unsigned" "struct" "union" "enum" "const" "volatile" "case" + "default" "if" "else" "switch" "while" "do" "for" "goto" "continue" + "break" + ;;varargs + "va_start" "va_end" "va_list" "va_dcl" "va_alist" + "stdin" "stdout" + "inline" + ;lisp specific: + "length" "elt" + "object" "car" "cdr" "list" + "number_plus" "number_times" "bool" fixnum" shortfloat" + "doublefloat" + )) + (setf (gethash v *illegal-names*) t))) + +(defvar *use-mangled-names* t) + +(defvar *used-names* + ;; bound by lets and constructions which bind variables + nil) + +(defun mangle-name (name name-type &aux p) + ;; NAME is a symbol which we wish to mangle, and name-type is + ;; 'var or 'function. + + (cond ((or (null *use-mangled-names*) (null name) + (null (setq p (symbol-package name)))) + (cond ((eq name-type 'var) *next-cvar*) + ((eq name-type 'function) + (incf *next-function*)) + (t (incf *next-cvar*)))) + (t (or (eq name-type 'var) + (setq p (get-package-shortname p))) + (let ((v (mangle name))) + (cond ((eq name-type 'var) + (do ((i 0) + (w v (setq w (format nil "V~a~a" (incf i) v)))) + ((not (or (gethash w *illegal-names*) + (member w *used-names* :test 'equal))) + (setq w (copy-seq w)) + (Push w *used-names*) + w))) + (t + (si::string-concatenate + (cond ((eq name-type 'function) "f") + ((eq name-type 'symbol) "s") + (t "u")) + p + v + ))))))) + +(defvar *package-names* nil) + +(defun get-package-shortname (x) + (or *package-names* + (setq *package-names* + `((,(find-package "LISP") . "L") + (,(find-package "SYSTEM") . "S") + (,(find-package "KEYWORD") . "K")))) + (let ((tem (cdr (assoc x *package-names*)))) + (cond (tem tem) + (t + (let((na (or (car (package-nicknames x)) + (package-name x)))) + (setq na (mangle (string-downcase na))) + (if (rassoc na *package-names*) + (error "You need to add another nickname: ~a is in use" na)) + (setq na (copy-seq na)) + (push (cons x na) *package-names*) + na))))) + +(defun next-cvar (&optional v &aux name) + (let ((n (incf *next-cvar*))) + (cond ((null v) n) + ((consp v) (setf (second v) n) v) + ((typep v 'var) + (cond ((var-special-p v) + (setf (var-special-p v) n)) + (t (setq name (var-name v)) + (setf (var-ind v) + (if (and name (symbol-package name)) + (copy-seq (mangle-name name 'var)) + n))))) + (t (wfs-error))))) + +(defun next-label() + (incf *next-label*)) + + (proclaim (cons 'special *pass-2-vars*)) + +(defun execute-pass-2 ( &aux (top *top-forms*) ) + (let #.*pass-2-vars* + (setq *next-data* 0 *next-label* 0 *next-function* 0 + *address-vector* (make-array 30 :adjustable t :fill-pointer 0)) + (terpri *c-output*) + (wr " +#include \"cmpinclude.h\" +#include \"" (pathname-name *h-output*) ".h\"") + (wr " + +init_code(){IdoInit(sizeof(VV)/sizeof(char *),VV);} + +") + (sloop for v in top do + (do-one-pass-2 v)) + (write-out-links) + (write-out-address-and-data) + (terpri *h-output*) + (wr-nl "") + ; (print *data*) + )) + +(defun do-one-pass-2 (x &aux df *local-funs* fd) + (cond ((consp x) + (cond ((and (symbolp (car x)) + (setq fd (get (car x) 'e2))) + (funcall fd x)) + (t (wfs-error)))) + ((typep x 'top-form) + (cond ((top-form-funp x) + (setq df (add-dummy-fun + (top-form-walked x)))) + (t (push-data 'd_eval_skip + (top-form-lisp x))))) + (t (wfs-error))) + (dolist (v *local-funs*) + (do-one-pass-2 v)) + (when df + (push-data 'd_eval_skip `(si::invoke ,df)))) + +(proclaim '(ftype (function () t) dummy-top)) + +(defun add-dummy-fun (x &aux ans) + ;; create a simple C function of no args which invokes the + ;; lisp form x in compiled form. returns the integer index + ;; of the *function-addresses* array where the C function's address resides. + (setq ans`(lambda-block ,(make-fun-data 'dummy-top nil nil nil nil x nil))) + (setf (fdata-ind (second ans)) (incf *next-function*)) + (e2-write-top (make-top-form :walked ans :funp t)) + (push-address (second ans)) + ) + +(defun car-get (x flag) + (and (consp x) (symbolp (car x)) + (get (car x) flag))) + + (setf (get 'write-top 'e2) 'e2-write-top) + +(defun e2-write-top (x &aux fd) + ;(print x) + ; for (lambda #S(fdata ..)) + ; sets the ind in #s(fdata ) and writes out the definition. + ; writes out the L20() { ..} + ; side .. + (cond ((and (typep x 'top-form) + (setq fd (car-get (top-form-walked x) 'e2))) + (return-from e2-write-top (funcall fd (top-form-walked x))))) + + (unless (and (consp x) (symbolp (car x))) + (wfs-error)) + (cond ((setq fd (get (car x) 'e2)) + (funcall fd x)) + (t (wfs-error))) + ) + + ;; writing out the .data file: + ;; each time something in *data-table* is first referenced we assign + ;; an index and put it in *data*. This normally happens while a function + ;; definition (and its local functions) are being written out. After + ;; that is written out (so all its constants are looked after) we push + ;; the (d_eval_skip (fset argd function-address-index "docstring")) + + (setf (get 'si::fset 'e2) 'e2fset) + (setf (get 'mset 'e2) 'e2fset) + +(defun push-address (x) + (let ((n (fill-pointer *address-vector*))) + (vector-push-extend x *address-vector*) + n)) + +(defun link-descriptor-from-decl (argl ret &aux (atypes 0) saw-optional + (min 0) (max 0) ) + (declare (fixnum min max atypes)) + (sloop for v in-list argl + when (eq v '&optional) + do (setq saw-optional t) + else + when (member v '#. (cons '* lambda-list-keywords)) + do (setq max 63) (return nil) + else + do +; (if (eq v 'short-float) (setq v 'double-float)) + (unless saw-optional + (incf min)) + (incf max) + (cond ((< max 7) + (setq atypes (+ atypes + (the fixnum (ash + (arg-type-code (promote-arg-type v)) + (the fixnum (* max 2))))) + )))) + ;; set the return type: + (setq atypes (logior atypes (arg-type-code (promote-arg-type ret)))) + + (let ((res 0)) + (declare (fixnum res)) + (setf res (make-argd min max atypes)) + (or (eql max min) + (setf (argd-flag-p res requires-nargs) t)) + (when (or (eql ret '*)(and (consp ret)(eq (car ret) 'values))) + (setf (argd-flag-p res sets-mv) t)) + res)) + +(defun make-argd (min max atypes &aux (result 0)) + (declare (fixnum min max atypes result)) + (setf (argd-minargs result) min) + (setf (argd-maxargs result) max) + (setf (argd-atypes result) atypes) + result) + +(defun describe-argd (argd) + (format t "~%min=~a,max=~a,atypes=~a,arg-types=~a,ret=~a +flags[set-mv=~a, requires-nargs=~a,requires-fun-passed=~a " + (argd-minargs argd) + (argd-maxargs argd) + (argd-atypes argd) + (argl-from-argd argd) + (ret-from-argd argd) + (argd-flag-p argd sets-mv) + (argd-flag-p argd requires-nargs) + (argd-flag-p argd requires-fun-passed))) + +;(defstruct arg-stepper (atype 0 :type fixnum)) +;(defvar *arg-stepper* (make-arg-stepper)) +; +;(defun init-arg-stepper (argd) (setf (arg-stepper-atype *arg-stepper*) +; (argd-atypes (the fixnum argd))) +; nil) +; +;(defun next-arg-type () +; (let* ((a (arg-stepper-atype *arg-stepper*)) +; (res (aref *promoted-arg-types* (the fixnum (logand a 3))))) +; (setf a (ash a -2)) +; (setf (arg-stepper-atype *arg-stepper*) a) +; res)) + +(defun argl-from-argd (argd &aux ans) + + (declare (fixnum argd)) + (let ((atypes (argd-atypes argd)) + (min (argd-minargs argd)) + (max (argd-maxargs argd)) + (i 0)) + (declare (fixnum atypes min max i)) + (sloop while (<= i 7) + do (setq atypes (ash atypes -2)) + (cond ((and (>= i min) (eql atypes 0)) + (if (< i max) (push '* ans)) + (return nil)) + ((eql i min) (push '&optional ans))) + (push (aref *promoted-arg-types* (logand atypes 3)) ans) + (setq i (+ i 1))) + (or (eq (car ans) '*) + (<= max 7) + (push '* ans)) + (nreverse ans))) + +(defun ret-from-argd (argd &aux ans) + (declare (Fixnum argd)) + (let ((tem (logand (argd-atypes argd) 3))) + (declare (fixnum tem)) + (setq ans (aref *promoted-arg-types* tem)) + (cond ((argd-flag-p argd sets-mv) '*) + (t ans)))) +) + +(defun fdata-to-argd(fdat &aux tem) + (cond ((setq tem (fdata-function-declaration fdat)) + (return-from fdata-to-argd (the fixnum(car tem))))) + (let* ((ll (fdata-ll fdat)) + (min (length (ll &required ll))) + (max (+ min (length (ll &optional ll)))) + (argd 0)) + (declare (fixnum min max argd)) + (cond ((or (ll &rest ll) + (ll &key ll)) + (setq max 63))) + (setq argd (make-argd min max 0)) + (setf (argd-flag-p argd requires-nargs ) (> max min)) + (setf (argd-flag-p argd sets-mv) t) + (setf (argd-flag-p argd requires-fun-passed)(fdata-closure-vars fdat)) + argd)) + +(defun get-install-form (fdat sym &aux tem) + (let ((argd (fdata-to-argd fdat)) + (n (push-address fdat))) + `(si::initfun ,sym ,n + ,argd,@ + (sloop for v in (fdata-closure-vars fdat) + do (setq tem (cdr (assoc v *top-level-closure-vars*))) + (or tem (setq tem (push-data 'dv (cons nil nil)))) + collect tem)))) + +(defun e2fset (form &aux sym fun fdat tem sform) + (desetq (sform sym fun) form) + (or (typep fun 'top-form) (wfs-error)) + (cond ((and (consp (setq tem (top-form-walked fun))) + (consp (cdr tem)) + (typep (setq fdat (cadr tem)) 'fdata)) + (e2-write-top fun) + (push-data 'd_eval_skip + (ecase sform + (si::fset + (get-install-form fdat sym)) + (mset + (cons 'si::initmacro (cdr (get-install-form fdat sym)))))) + ) + (t (setf (third form) (top-form-lisp (third form))) + + (push-data 'd_eval_skip form)))) + +(setf (get 'local-function 'e2) 'e2-local-function) + +(defun e2-local-function (x ) + (e2-write-top (second x)) + ) + + #+later + +(defun multiple-value-p (ret-type) + ;; return T if the ret-type is one for not a single value. + (or (eq ret-type '*) + (and (consp ret-type) (eq (car ret-type) 'values)))) + +(setf (get 'lambda-block 'e2) 'e2-lambda-block) +(setf (get 'lambda 'e2) 'e2-lambda-block) + +(defvar *temp-cvars* + ;; list of C Vars (ind type) which will be written out as the + ;; TEMP_CVARSi macro at the beginning. + ) + +(defvar *next-vcs* + ;; size of block of c stack reserved for this function + ;; declare by object Vcs[n]; + ) + +(defvar *exit* + ;; a CONS whose CAR + ;; 'function-return' indicates return from function after set + ;; 'next' control just continues + ;; a label struct do a goto this lavel + ;; Its CDR is a pointer into the control stack. The interval of the controlstack + ;; between this pointer and the current *control-stack*, must be unwound before jumping + ;; or setting a possibly special variable. + ) + +(defvar *closure-vars* nil) + +(defvar *fdata* nil) + +(defvar *used-function-saved-avma* nil + ;; is set to t if we need to + ;; save the entering avma address. +) + +(defun e2-lambda-block (x &aux (*next-cvar* 0) (*blocks* 0) fdat + *used-names* + (*next-vcs* 0) + (*next-label* 0) + *temp-cvars* + *closure-vars* + freturn-type + *control-stack* + ;; in this pass *control-stack* contains info about + ;; binding specials,saved-avma, tags so we know when + ;; we jump if we need a setjmp, or if we need to unwind. + ;; also for function-return. + *alloc-decls* + *fdata* + *used-function-saved-avma* + ) + (declare (special *fdata*)) + (setq fdat (second x)) + (setq *fdata* fdat) + (unless (fdata-ind fdat) + (setf (fdata-ind fdat) + (mangle-name (fdata-name fdat) 'function))) + (setq *closure-vars* (fdata-closure-vars fdat)) + + (wr-comment "function definition: " (fdata-name fdat)) + (wr" +static " (rep-type (setq freturn-type (function-return-type fdat))) +" " fdat"(") + (wr-h "static " (rep-type freturn-type) fdat "() ;"); + (write-args-and-open (fdata-ll fdat) (fdata-closure-vars fdat)) + (if (eq freturn-type 'double_ptr)(setq freturn-type 'double-float)) + (let* ((var (get-temp freturn-type)) + (value `(,(if (eq freturn-type 'mv) 'mv 'var) ,var))) + (valex value `(function-return ,var) (expr-b2 (fdata-form fdat)))) + (close-blocks) + (wr-h-temp-vars) + ;; This var is shared elsewhere and we want new reference mechanism. + (dolist (v *closure-vars*) (setf (var-ind v) nil)) + (when (ll &key (fdata-ll fdat)) + (let ((tem (push-address (list 'VK (fdata-ind fdat) )))) + (push-data 'd_eval_skip `(si::set-key-struct ,tem)))) + ) + +(defun wr-h-temp-vars( &aux type v) + (let ((*c-output* *h-output*)) + (wr " +#define TEMP_VARS" *fdata*) + (cond (*used-function-saved-avma* + (wr " long FunctionEntryAvma = avma;"))) + (dolist (w *temp-cvars*) + (let ((t1 (or (second w) t))) + (setq v (car w)) + (cond ((eq type t1) + (wr " ,V" v) ) + (t (or (null type) + (wr ";")) + (setq type t1) + (format *h-output* " ~a V~a" + (rep-type type) v))) + (cond ((eq type 'integer) + (format *h-output* "= 0,V~aalloc" v) + )) + )) + (and *temp-cvars* (format *h-output* ";")) + (unless (eql *next-vcs* 0) + (format *h-output* " object Vcs[~a];" *next-vcs*)) + )) + +(defun open-block () + (incf *blocks*) + (wr-nl "{")) + +(defun close-blocks() + (loop (if (<= *blocks* 0) (return nil)) + (wr "}")(incf *blocks* -1))) + +(defun rep-type (type) + (cond ((stringp type) (return-from rep-type type))) + (case type + ((character fixnum boolean) "int ") + ((gen integer) "GEN ") + (short-float "float ") + (double-float "double ") + (double_ptr "DoublePtr ") + (otherwise "object "))) + +(defun bind-special (var val) + (push 'bdsp *control-stack*) + ; (incf *bdsp*) + (or (var-ind var) (setf (var-ind var) (get-object (var-name var)))) + (wr-nl "BdSp("(var-ind var)","(list 'inline-loc t val)");") + ) + +(defun b2-bind-var (w v) + (cond + ((typep w 'var) + (cond + ((var-special-p w) + (bind-special w v)) + ((var-clb w) + (wr-nl) + (wr-vind (var-ind w)) + (wr "=MakeClosVar(" v ");") + (or (var-ind w) (wfs-error)) + ) + ((and (consp v) (eq (car v) 'var) + (eql (second v) (var-ind w)))) + (t + (wr-set-inline-loc w v)))) + + ;; save writing V3=V3 + ((and (consp w) (eq (car w) 'var)) + (cond ((and (typep v 'var) (eql (second w) (var-ind v)))) + (t (wr-set-inline-loc w v)))) + (t (wfs-error) + ;(wr-nl w "=" v ";") + ))) + +(defun b2-bind-var-b2 (var val &aux tem) + ;; like b2-bind-var-b2, but does a b2 eval on its second arg. + (if (plain-var-p var) (setq tem var ) (setq tem (get-temp t))) + (valex (list 'var tem) (next-exit) (expr-b2 val)) + (or (eq tem var) (b2-bind-var var tem))) + +(defun assign-reqds-and-optionals (ll fdat &aux (atypes 0) var tem type + (did-required nil) + (lis (ll &required ll))) + (declare (fixnum atypes)(boolean did-required)) + (let ((fdecl (fdata-function-declaration fdat))) + (cond (fdecl (setq atypes (argd-atypes(fdecl argd fdecl)))))) + (tagbody + again + (sloop for v on lis with vtype + do (setq var (if did-required (caar v) (car v))) + (setq type (aref *promoted-arg-types* (logand (setq atypes (ash atypes -2)) 3))) + (setq vtype (var-implementation-type var)) + (cond ((or (eq type vtype) + (eql (rep-type type) (rep-type vtype))) + (setq tem var)) + (t + (setq tem nil) + (cond ((plain-var-p var) + (next-cvar var) + (push var *alloc-decls*))))) + (setf (car v) (cons (list 'var (next-cvar tem) type) (car v)))) + (unless did-required + (setq did-required t) + (setq lis (ll &optional ll)) + (go again)) + )) + + ;; if not nil try to allocate all rest args on the c stack. + +(defun wr-decl-var (var) + (cond ((typep var 'var) + (if (var-volatile var) (wr "VOL ")) + (let ((type (var-type var))) + (cond ((eq type 'integer) + (wr "IDECL("var","var"__space,"var"__alloc);")) + (t + (wr (rep-type type) " ") + (wr-vind (var-ind var))(wr ";"))))) + ((and (consp var) (eq (car var) 'var)) + (wr (if (third var) (rep-type (third var)) + "object ") var ";")) + (t (wfs-error)))) + +(defvar *rest-on-stack* nil) + +(defvar *alloc-decls* nil) + +(defun write-args-and-open(ll closure-vars &aux reqds varargp va-start labels + deflt rest-var (fdat *fdata*) tem + (cfun (fdata-ind fdat))) + (assign-reqds-and-optionals ll fdat) + (setq reqds (ll &required ll)) + (wr-list (mapcar 'car reqds)) + (cond ((vararg-p fdat)(setq varargp t) + (if reqds (wr ",")) + (wr "va_alist) +")) + (t (wr ") +"))) + (sloop for v in reqds do (wr-decl-var (car v))) + (cond (varargp (wr "va_dcl "))) + (incf *blocks*) + (wr " +{ TEMP_VARS" fdat" + ") + (sloop for v in *alloc-decls* do (wr-decl-var v)) + (setq *alloc-decls* nil) + + ;; we must actually have the pointers in our function point to the closure cells. + ;; Otherwise if noone keeps a pointer to the closure itself during the call, + ;; the closure might be gc'd and the variables themselves be unprotected. + + (when closure-vars + (dolist (v closure-vars) + (allocate-var v 'kw)) + (wr "VOL object CLfun;") + (wr-nl "struct { ") + (write-alloc-decls (rep-type t)) + ;; the *& is to make sure this goes into the Cstack. + (wr "} *CLvars = (void *) (*&CLfun = fcall.fun, CLfun->cl.Env);")) + + (cond (varargp + (wr-nl "int Inargs = VFUN_NARGS - " + (length reqds)";va_list Iap;") + (dolist (v (ll &optional ll)) + (wr-decl-var (car v)) + (allocate-var (cadddr v) t)) + (write-alloc-decls (rep-type t)) + (when (ll &rest ll) + (setq rest-var (caar (ll &rest ll))) + (allocate-var rest-var t)) + (write-alloc-decls (rep-type t)) + + ;; Todo : Use a structure to get named args: + ;; struct { object V1,V2,...V10;} Vk; + ;; Refer Kw.V2 + (when (ll &key ll) + + (wr-nl " struct {") + + (dolist (v (ll &key ll)) (allocate-var (car v) 'kw)) + (write-alloc-decls (rep-type t)) + (dolist (v (ll &key ll)) (allocate-var (caddr v) 'kw)) + (wr-nl"") + (write-alloc-decls (rep-type t)) + + (wr "} Vk;")) + )) + + (cond ((and (setq tem (fdata-tail-label fdat))(label-referred tem)) + (wr "LA" tem ":;") + (push tem *control-stack*) + )) + + (sloop for v in reqds do + (b2-bind-var (cdr v) (car v))) + + (when varargp + (wr-nl "Inargs = VFUN_NARGS - " (length reqds) " ; ") + (when + (ll &optional ll) + (let (*control-stack*) + ;; don't double BDSP. These will be added below + + (dolist (opt (ll &optional ll)) + (push (next-label) labels) + (wr-nl "if( --Inargs < 0)") + (wr-go (car labels)) + (wr-nl "else {") + (unless va-start (setq va-start t) (wr-nl "va_start(Iap);")) + (b2-bind-var (car opt) (list 'next-var-arg)) + (b2-bind-var (cadr opt) (car opt)) + (wr "}") + (when (cadddr opt) (b2-bind-var (cadddr opt) (get-object t))) + )) + (setq labels (nreverse labels)) + (let ((label (next-label))) + (wr-go label) + + ;;; Bind unspecified optional parameters. + + (dolist-safe (opt (ll &optional ll)) + (wr-label (car labels)) + (pop labels) + (b2-bind-var-b2 (car opt) (caddr opt)) + (b2-bind-var (cadr opt) (car opt)) + (when (cadddr opt) (b2-bind-var (cadddr opt) (get-object nil)))) + (wr-label label) + )) + + ;; bind &rest arg + (when rest-var + (let ((dynamic-extent (or *rest-on-stack* + (eq 'dynamic-extent + (var-type rest-var)))) + (temp (get-temp t))) + (unless va-start (setq va-start t) (wr-nl "va_start(Iap);")) + (wr-nl temp "=" ) + (cond ((ll &key ll) + (cond (*rest-on-stack* + (wr "(ALLOCA_CONS(Inargs),ON_STACK_MAKE_LIST(Inargs));")) + (t (wr "make_list(Inargs);")))) + (dynamic-extent + (wr "(ALLOCA_CONS(Inargs),ON_STACK_LIST_VECTOR(Inargs,Iap));")) + (t (wr "list_vector(Inargs,Iap);"))) + + (b2-bind-var rest-var temp))) + + + ;; bind keywords + + (when (ll &key ll) + (unless va-start (setq va-start t) (wr-nl "va_start(Iap);")) + (setq deflt (mapcar 'cadr (ll &key ll))) + (let ((vkdefaults nil) + (n (length (ll &key ll)))) + (do* ((v deflt (cdr v)) + (kwds (ll &key ll) (cdr kwds)) + (kwd (car kwds) (car kwds))) + ((null v)) + (unless (and (dv-p (car v)) + (eq (third (car v)) nil)) + (setq vkdefaults t)) + (when (or (not (and (dv-p (car v)) + (progn (add-data (car v))))) + ;; the supplied-p variable is not there + (not (null (third kwd))) + ) + (setf Vkdefaults t) + (setf (car v) 0))) + (if (> (length deflt) 15) (setq vkdefaults t)) + + (open-block) + (let ((*c-output* *h-output*)) + (when vkdefaults + (terpri *h-output*) + (wr "static int VK" cfun + "defaults[" (length deflt) "]={") + (do ((v deflt(cdr v))(tem)) + ((null v)) + (cond ((eql (car v) 0) + (wr "-1")) + ;; must be location + ((and + (eq (caar v) 'dv) + (eq (setq tem (third (car v))) nil)) + (wr "-2")) + ;; fix these two to allow fixnum constants. + ((eq (caar v) 'dv) + (wr (get-dv-index (car v)))) + (t (wfs-error))) + (if (cdr v) (wr ","))) + (wr "};")) + (terpri *h-output*) + (wr "static struct { short n,allow_other_keys;" + "int *defaults;") + (wr-nl " int keys[" n "];") + (wr "} VK" cfun "key=") + + (wr "{" (length (ll &key ll)) "," + (if (ll &allow-other-keys ll) 1 0) + ",") + (if vkdefaults (wr "VK" cfun "defaults") + (wr "(int *)Cstd_key_defaults")) + (when (ll &key ll) + (wr ",{") + (do ((v (reverse (ll &key ll)) (cdr v))) + ((null v)) + ;; We write this list backwards for convenience + ;; in stepping through it in parse_key + (wr (second (add-data (fourth (car v)) ))) + (if (cdr v) (wr ","))) + (wr "}")) + (wr "};") + ) + (cond (rest-var + (wr-nl "parse_key_rest(" rest-var ",")) + (t (wr-nl "parse_key_new("))) + + (wr "Inargs,&Vk,&VK" cfun "key,Iap);") + ) + ;; end setup keys + ;; bind the keys + (dolist (kwd (ll &key ll)) + (cond ((not (eql 0 (pop deflt))) + ;; keyword default bound by parse_key.. and no supplied-p + (b2-bind (car kwd))) + (t + (wr-nl "if(" `(key-var ,(car kwd)) "==0){") + (b2-bind-var-b2 (car kwd) (cadr kwd)) + (unless (null (caddr kwd)) + (b2-bind-var (caddr kwd) (get-object nil))) + + (wr-nl "}else{") + (let (*control-stack*) + ;; don't do extr BdSP + (b2-bind (car kwd)) + (and (caddr kwd) (b2-bind-var (caddr kwd) (get-object t)))) + + (wr "}")))))) + + )) + +(defun b2-bind (w) + (cond ((var-special-p w) + (b2-bind-var w (var-special-p w))) + ((var-clb w) + (or (consp (var-ind w)) (wfs-error)) + (b2-bind-var w (list 'closure-var-loc w))) + (t nil))) + + +(setf (get 'var 'b2) 'b2-var) +(setf (get 'dv 'b2) 'b2-dv) + +(defun b2-dv (x ) + (unless (cadr x) (add-data x)) + (unwind-set x)) + +(defun b2-var (v) + ;; what about the strategy of having everything except var's + ;; eval'd into a temp var. + (unwind-set v) + v) + +(defun needs-temp (val sofar rest &aux tem) + ;; VAL is the result of a expr-b2 ? '(1val) and SOFAR is the list of + ;; results sofar and REST is the list of future arguments to expr-b2. + ;; We must create a temp variable and assign it to val if any evaluation + ;; of the things in rest or sofar might alter the value in VAL. + (and (null sofar) (null rest) + (return-from needs-temp nil)) + ;; if sofar is only vars and rest is null + ;; also would be ok. + (cond ((consp val) + (cond ((eq (car val) 'var) (return-from needs-temp nil)) + ((eq (car val) 'dv) + (if (or (numberp (third val)) + (keywordp (third val))) + (return-from needs-temp nil))) + ((eq (car val) 'call) + ;; symbol-function does not have side-effect, but + ;; we need to preeval both to make sure order is write. + ;; (foo (symbol-function 'bil) (deff 'bil)) + (cond ((not (side-effect-p val)) + (return-from needs-temp nil)))))) + ((typep val 'var) + (or (null (var-special-p val)) (wfs-error)) + (cond ((and (null (var-clb val))) + (return-from needs-temp nil))))) + (setq tem (get-temp (result-type val))) + (wr-nl tem "=" val ";") + tem) + +(defun sets-mv-p (loc) + (cond ((atom loc) nil) + ((eq (car loc) 'inline-loc) + (sets-mv-p (third loc))) + ((eq (car loc) 'inline-call) + (flag-p (opt flag (cddr loc)) mv)) + (t nil))) + +(defun unwind-avma (ctl-stack) + (sloop for v on *control-stack* + do + (cond ((eq v ctl-stack)(return nil)) + ((eq (car v) 'avma-bind-needed) + (cond ((member 'inner-avma (cdr v)) + (wr-nl "avma = InnerAvma;")) + (t (wr-nl "avma = FunctionEntryAvma;") + (setq *used-function-saved-avma* t))))))) + +(defun unwind-stack (ctl-stack) + ;; Does the unbinding of special variables, popping the CtlStack, + ;; Cases here must also appear in unwind-stack-p + (sloop for v on *control-stack* + until (eq v ctl-stack) + do + (case (car v) + (bdsp + (wr-nl "UnBdSp;")) + (ctl-push + (wr-nl "CtlPop;")) + (t (cond ((consp (car v)) + (case (caar v) + (progv-bind + (wr-nl "IunwindBdSp(" (cadar v) ");")) + (unwind-protect + (wr-nl "CtlPop;IcallUnwindFun(" (cadar v) ");")) + ))))))) + +(defun unwind-stack-p (ctl-stack) + (sloop for v on *control-stack* + until (eq v ctl-stack) + when + (or (eq (car v) 'bdsp) + (eq (car v) 'ctl-push) + (and (consp (car v)) + (or (eq (caar v) 'progv-bind) + (eq (caar v) 'unwind-protect)))) + do (return t))) + +(defun restore-function-avma () + (wr-nl "avma = EntryAvma;") + (setq *used-function-saved-avma* t)) + +(defun unwind-set (val &optional avma-bind) + (cond ((and (typep val 'var) + (var-special-p val) + (cdr *value*) + (unwind-stack-p (cdr *exit*))) + (setq val (replace-inline-by-temp val)))) + (cond ((second *value*) + (unwind-stack (cdr *exit*)) + (wr-set-inline-loc (second *value*) val)) + ((and (consp val) (eq (car val) 'inline-call)) + (let ((flag (opt flag (cddr val)))) + (cond ((flag-p flag set) + (wr-nl val ";"))) + (unwind-stack (cdr *exit*)))) + (t (unwind-stack (cdr *exit*)))) + + (cond ((and (eq (car *value*) 'mv) + ;; *MV-N-VALUES-SET* bound to t by values special form + (null *MV-N-VALUES-SET*) + (not (sets-mv-p val))) + ;; detect if val does a set of MV + ;; if not then we must + (wr "fcall.nvalues = 1;"))) + + (case (car *exit*) + (function-return + (or (eq (second *exit*) (second *value*)) + (wfs-error)) + ;; must make sure CLfun and so its closure vars are not gc'd. The + ;; usage *&CLfun may mean this touch can be empty, since I think ANSI + (unwind-avma nil) + (if *closure-vars* (wr "TOUCH_CLfun;")) + (let ((val (second *value*))) + (or (eq (car val) 'var) (wfs-error)) + (cond ((eq (third val) 'double-float) + (wr-nl "RETURN_DOUBLE_PTR(" val ");")) + (t (wr-nl "return " val ";"))))) + (next + (if avma-bind (unwind-avma (cdr *exit*)))) + (otherwise + (cond ((typep (car *exit*) 'label) + (unwind-avma (cdr *exit*)) + (wr-go (car *exit*))) + (t (wfs-error))))) + ;; remove the avma-bind which has just been used. + (if avma-bind (remove-avma-bind avma-bind)) + ) +(defun remove-avma-bind (avma-bind) + (cond ((eq *control-stack* avma-bind) + (setq *control-stack* (cdr avma-bind))) + ((eq (cddr *control-stack*) (cdr avma-bind)) + (setq *control-stack* (cons (car *control-stack*) (cdr avma-bind)))) + (t (wfs-error)))) + +(setf (get 'progn 'b2) 'b2-progn) + +(defun b2-progn (x) + (progn-b2 (third x))) + +(defun progn-b2 (body) + (sloop for v on body + do (if (cdr v) (valex '(ignore) (next-exit) (expr-b2 (car v))) + (expr-b2 (car v)))) + (or body (expr-b2 (get-object nil)))) + +(defun get-temp (type) + (cond ((eq type 'integer) (setq type 'gen))) + (let ((tem (list 'var (next-cvar) type))) + (push (cdr tem) *temp-cvars*) + tem)) + +(defun push-vcs () + (prog1 (list 'vcs *next-vcs*) (incf *next-vcs*))) + +(defun write-alloc-decls(str) + (when *alloc-decls* + (wr str) + (wr-list (nreverse *alloc-decls*)) + (wr ";") + (setq *alloc-decls* nil))) + +(defun allocate-var (v type) + (cond ((if (null v) (push `(var ,(next-cvar)) *alloc-decls*)) + (return-from allocate-var nil)) + ((typep v 'var) + (cond ((eq type 'kw) + (let ((ind (next-cvar v))) + (push (list 'var ind) *alloc-decls*) + (cond ((var-special-p v) + (setf (var-special-p v) `(var (kw ,ind)))) + (t (setf (var-ind v) (list 'kw ind)))))) + ((var-special-p v)) + (t (next-cvar v) + (push (list 'var (var-ind v)) *alloc-decls*)))))) + +(defun plain-var-p (x) + (and (typep x 'var) + (not (var-special-p x)) + (not (var-clb x)))) + +(setf (get 'let 'b2) 'b2-let) +(setf (get 'let* 'b2) 'b2-let) + +(defvar *last* nil) + +(defun next-exit () + ;; a hack to avoid some consing. + (cond ((and *last* (eq (cdr *last*) *control-stack*)) *last*) + (t (setq *last* (cons 'next *control-stack*))))) + +(defun b2-let (x &aux (*control-stack* *control-stack*) + (*blocks* 0) binds body + (*used-names* *used-names*) + todo ) + (desetq (binds body) (cddr x)) + (open-block) + (sloop for (var) in binds + when (not (var-special-p var)) + do (next-cvar var) + (wr-decl-var var)) + (sloop for (var val) in binds + do (cond ((plain-var-p var) + (valex (list 'var var) (next-exit) (expr-b2 val))) + (t (let ((tem (get-temp t))) + (valex (list 'var tem) (next-exit) (expr-b2 val)) + (if (eql (car x) 'let) (push (cons var tem) todo) + (b2-bind-var var tem)))))) + (sloop for (var . val) in (nreverse todo) + do (b2-bind-var var val)) + (progn-b2 body) + (close-blocks) + nil) + +(defun safe-system (x) + (unless (eql 0 (system x)) + (error "The command ~s failed" x))) + +(defun compile-and-add-data-file ( o-file &aux command dir) + (declare (special c-debug)) + (force-output *c-output*) + (force-output *data-output*) + (force-output *h-output*) + (if (eql *c-output* *standard-output*) + (return-from compile-and-add-data-file nil)) + (setq dir (namestring + (make-pathname :directory (or (pathname-directory *c-output*) + '(:current))))) + (setq command (format nil "(cd ~a ; ~a -c -I. -I/u/wfs/new-lisp/newh ~a ~a ~a )" + dir + compiler::*cc* + (namestring *c-output*) + (if c-debug "-g" "") + (if (> *speed* 0) "-O" "") + )) + + (cond (o-file + (safe-system command) + (with-open-file (st (get-output-pathname "o") :direction :output + :if-exists :append) + (setq o-file (truename st)) + (sloop for v in-array "" + do (write-char v st)) + (write-char #\N st)) + (system (format nil "cat ~a >> ~a" (namestring *data-output*) + (namestring o-file))))) + ) + +(defun disassemble1 (name) + (with-open-file (st "/tmp/wfs1.lsp" :direction :output) + (print `(in-package ,(package-name *package*))) + (let ((def (symbol-function name))) + (cond ((and (consp def) (eq (car def) 'lambda-block)) + (print `(defun ,name ,@ (cddr def)) st)) + (t (return-from disassemble1 'cant)))) + (force-output st) + (compile-file1 (pathname st) :c-file *standard-output*))) + diff --git a/comp/try.lsp b/comp/try.lsp new file mode 100755 index 0000000..35bd890 --- /dev/null +++ b/comp/try.lsp @@ -0,0 +1,26 @@ +(in-package "BCOMP" :use '("SLOOP" "LISP")) +(setq *print-pretty* t) +(defun compiler::boole3 (a b c) (boole a b c)) +(setq compiler::*cc* (concatenate 'string compiler::*cc* " -I../newh -I../h")) + +(let ((*load-verbose* nil)) + (dolist (v '( data defs macros var c-pass1 fasdmacros lambda top top1 + inline top2 stmt wr + bo1 + exit + defmacro + utils comptype + )) + (si::nload (format nil "~(~a~).lsp" v))) + (load "opts-base.lsp") + (let ((u "top2.o")) + (unless (get 'list 'bcomp-opt) + (if (probe-file u) (load u)) + (load "lisp-decls.doc") + (load "opts.lsp") + (if (probe-file U ) (si::nload "top2.lsp")) + )) + (or (fboundp 'do-some-tests) (load "../tests/all-tests.lsp")) + (load "mangle") + ) + diff --git a/comp/try1.lsp b/comp/try1.lsp new file mode 100755 index 0000000..c904697 --- /dev/null +++ b/comp/try1.lsp @@ -0,0 +1,8 @@ +(setq *load-verbose* nil) +(defun compiler::boole3 (a b c) (boole a b c)) +(load "sysdef.lsp") +(make::make :bcomp) +(load "smash-oldcmp.lsp") + +(setq *load-verbose* t) + diff --git a/comp/utils.lsp b/comp/utils.lsp new file mode 100755 index 0000000..8c73f8d --- /dev/null +++ b/comp/utils.lsp @@ -0,0 +1,166 @@ + +(in-package "BCOMP") + +(defmacro fdecl (key fd) `(nth ,(position key '(argd flag)) ,fd)) + +(defun comp-warn (fmt &rest l &aux (*print-length* 3) (*print-level* 3)) + (if *top-form* (format t ";~%~s is being compiled" *top-form*)) + (setq *top-form* nil) + (format t ";;~%Warning:") + (apply 'format t fmt l)) + +(defun comp-error (fmt &rest l &aux (*print-length* 3) (*print-level* 3)) + (setq *hard-error* t) + (format t "~%Error:") + (apply 'format t fmt l)) + +(defun add-prop (symbol-lis prop val) + (dolist-safe (v symbol-lis) + (or (symbolp v) (comp-error "Can't add ~a prop ~a to non symbol ~a" val prop v)) + (setf (get v prop) val))) + +(defun bad-proclamation () + (declare (special *procl*)) + (comp-error "The proclamation ~a was illegal." *procl*)) + + +(defun proclaim1 (x &aux ptype body (*procl* x) flag val tem) + (declare (special *space* *speed*)) +;; will eventually be proclaim. + (declare (special *procl*)) + (desetq (ptype . body) x) + (case ptype + (optimize (sloop for v in-list body + do (cond ((atom v) (setq flag v val 3)) + (t (desetq (flag val) v))) + (or (typep val 'fixnum) (bad-proclamation)) + (case flag + (safety (if (> (the fixnum val) 0) (setq *safety* val))) + (space (setq *space* val)) + (speed (setq *speed* val)) + (compilation-speed (setq *speed* 0)) + (t (comp-warn "Unknown optimize quality ~a" flag))))) + (special (dolist-safe (v body) (si::*make-special v))) + (type (desetq (ptype . body) body) + (setq ptype (comp-type ptype)) + (add-prop body 'proclaimed-variable-type ptype)) + (function + (let (name ) + (desetq (name . body) body) + (proclaim1 `(ftype (function ,@ body) ,name)))) + (ftype + (desetq (ptype . body) body) + (add-prop body 'proclaimed-function-declaration + (increment-function-decl ptype nil))) + (inline + (add-prop body 'proclaimed-inline t)) + (declaration + (add-prop body 'proclaimed-declaration t)) + (t (cond ((symbolp ptype) + (cond ((setq tem (get ptype 'comp-type)) + (add-prop body 'proclaimed-variable-type (comp-type ptype))) + ((get ptype 'proclaimed-declaration)) + (t (bad-proclamation)))) + (t (bad-proclamation)))))) + +(defun ftype-from-fdecl (fdecl &aux (n (fdecl argd fdecl))) +;; (setq fdecl (get fname 'proclaimed-fun57qction-declaration)) + (when n + (let ((args (argl-from-argd n)) + (ret (ret-from-argd n))) + `(ftype (function ,args ,ret))))) + +(defun describe-fdecl(fdecl) + (format t "Ftype is ~s, flags are " (ftype-from-fdecl fdecl)) + (print-flag (fdecl flag fdecl))) + + +(defun promote-arg-type (x) + (setq x (comp-type x)) + (case x + (fixnum 'fixnum) + ((t) t) +; (short-float 'short-float) + ((long-float double-float ) 'double_ptr) + (t (cond ((subtypep x 'fixnum) 'fixnum) + (t t))))) + +(defvar *promoted-arg-types* #( t fixnum double_ptr ;short-float + )) +(defun arg-type-code (x) + (cond ((eq x t) 0) + ((eq x 'fixnum) 1) + ((eq x 'double_ptr) 2) +; ((eq x 'short-float) 3) + (t (wfs-error) 0))) + +(defun increment-function-decl (new-prop old-decl &aux tem + args ret-types retl) + ;; produce a new function-decl with prop added. + (setq old-decl (list 0 (if old-decl (second old-decl) + #.(flags set ans mv touch-mv) + ))) + (cond ((atom new-prop) + (case new-prop + (inline (setf (flag-p (fdecl flag old-decl) notinline) nil)) + (notinline (setf (flag-p (fdecl flag old-decl) notinline) t)) + (t (wfs-error))) + old-decl) + ((eq (car new-prop) 'function) + (desetq (args . ret-types) (cdr new-prop)) + (tagbody + again + (cond ((null ret-types) (setq retl '*)) + ((atom ret-types) (comp-error "Bad return decl ~a" retl)) + ((cdr ret-types) (setq retl '*)) + ((eq (setq tem (car ret-types)) '*)(setq retl '*)) + ((and (consp tem) + (eq (car tem) 'values)) + (setq ret-types (cdr tem)) (go again)) + (t (setq retl (comp-type tem))))) + (setf (car old-decl) (link-descriptor-from-decl args retl)) + (cond ((not (eq retl '*)) + (setf (flag-p (second old-decl) mv) nil))) + old-decl) + (t (wfs-error)))) + +(defun function-declaration (v) + (or (symbolp v) (wfs-error)) + (or (cdr (assoc v *function-decls*)) + (get v 'proclaimed-function-declaration))) + + +(defun function-return-type (fdat &aux ret fdecl) + ;; returns (member *immediate-types*), T, or MV + ;; (member *immediate-types*), T, *, (values t t) (values) .. + (let ((fname (fdata-name fdat))) + (cond ((and fname (setq fdecl (get fname 'proclaimed-function-declaration))) + (setf (fdata-function-declaration fdat) fdecl) + (setq ret (ret-from-argd (fdecl argd fdecl))) + (cond ((eq ret '*) 'mv) + (t ret))) + (t 'mv)))) + +(defun the-list (x &aux (y x)) + (sloop while x + do (or (consp x) (comp-error "not a list ~a" x)) + (setq x (cdr x))) + y) + + + + + + + + + + + + + + + + + + diff --git a/comp/var.lsp b/comp/var.lsp new file mode 100755 index 0000000..6c764b1 --- /dev/null +++ b/comp/var.lsp @@ -0,0 +1,1147 @@ +;;Copyright William F. Schelter 1990, All Rights Reserved + + +(in-package "BCOMP") +(use-package "SLOOP") + +(setq SYSTEM:*INHIBIT-MACRO-SPECIAL* nil) +;(fmakunbound 'multiple-value-list) + +(defvar *default-desk* (make-desk t)) + +(defun get-desk (type) + (if (eq type t) *default-desk* (make-desk type))) + +(defun set-desk-type (desk new-type) + (cond ((eq desk *default-desk*) (make-desk new-type)) + (t (setf (desk-result-type desk) (type-and (desk-result-type desk) new-type)) + desk))) + +(setq SYSTEM:*INHIBIT-MACRO-SPECIAL* t) + +(do ((v '(QUOTE b1-quote + MACROLET b1-macrolet + symbol-macrolet b1-symbol-macrolet + MULTIPLE-VALUE-PROG1 b1-MULTIPLE-VALUE-PROG1 + UNWIND-PROTECT b1-unwind-protect + EVAL-WHEN b1-quote-first + LET b1-let + RETURN-FROM b1-return-from + MULTIPLE-VALUE-LIST b1-eval + IF b1-if + THE b1-the + PROGV b1-progv + FUNCTION b1-function + FLET b1-flet + COMPILER-LET b1-compiler-let + DECLARE b1-declare + TAGBODY b1-tagbody + LABELS b1-flet + PROGN b1-progn + LET* b1-let* + CATCH b1-catch + THROW b1-throw + BLOCK b1-block + GO b1-go + SETQ b1-setq + VALUES b1-values + LAMBDA-BLOCK b1-lambda-block + DONE-b1 b1-done-b1 + #+c-pass1 MULTIPLE-VALUE-BIND b1-multiple-value-bind + #+c-pass1 MULTIPLE-VALUE-setq b1-multiple-value-setq + + + ) (cddr v))) + ((null v)) + (setf (get (car v) 'b1) (second v))) + +(defmacro locally (&body body) + `(let nil ,@body)) + +(defvar *control-stack* + ;; When a special is bound 'bound-special is pushed + ;; When clb lambda is entered 'clb is pushed + ;; When save_avma is entered 'save-avma is pushed + ;; Thus go can tell whether the tag is acros 'clb or + ;; or else how many bds-unbinds it has to do before going. + nil) + +(defvar *walk-functions* + ;; bindings of functions and macros by flet,macrolet,labels + nil) + +(defvar *walk-variable-bindings* + ;; bindings of variables by let,lambda, let*, symbol-macrolet. + ;; + nil) + +(defvar *digest-line-info* (make-hash-table :test 'eq)) + +(defvar *line-info* nil) + +(defun walk-environment () + (list nil *walk-functions*)) + +(defun mapcar2 (f lis c &optional last) + (or last (setq last c)) + (do ((v lis (cdr v)) + (result) (ptr)) + ((null v) result) + (or (consp v) (comp-error "Expected a list of forms ~a" lis)) + (let ((tem (funcall (the (function (t t) t) f) + (car v) + (if (cdr v) c last)))) + (cond (ptr (setf (cdr ptr) (list tem)) + (setf ptr (cdr ptr))) + (t (setq result (setq ptr (list tem)))))))) + +(eval-when (compile eval load) + +(defun desetq-consp-check (val) + (or (consp val) (error "~a is not a cons" val))) + +(defun desetq1 (form val) + (cond ((symbolp form) + (cond (form ;(push form *desetq-binds*) + `(setf ,form ,val)))) + ((consp form) + `(progn + (desetq-consp-check ,val) + ,(desetq1 (car form) `(car ,val)) + ,@ (if (consp (cdr form)) + (list(desetq1 (cdr form) `(cdr ,val))) + (and (cdr form) `((setf ,(cdr form) (cdr ,val))))))) + (t (error "")))) + ) + +(defmacro desetq (form val) + (cond ((atom val) (desetq1 form val)) + (t (let ((value (gensym))) + `(let ((,value ,val)) , (desetq1 form value)))))) + +(defun b1-quote-two (form where &aux sform a b c) where + (desetq (sform a b . c) form) + (list* sform a b (mapcar2 'b1-walk c sform))) + +(eval-when (compile eval load) + +(defun wbind1 (v decls &aux var specialp tem) + (or (symbolp v) (comp-error "binding non symbol ~a")) + (if (null v) (comp-error "binding nil ~a")) + (sloop for w on-list (second decls) + when (eq (car w) v) do (setq specialp t)(setf (car w) nil)) + (if (si::specialp v) (setq specialp t)) + (setq var (makevar v specialp)) + (if specialp (push 'bound-special + *control-stack*)) + + (push var *walk-variable-bindings*) + (cond ((setq tem (assoc v (car decls))) + (setf (var-type var) (cdr tem)))) + var + ) + +(defmacro wbind (v decls) + `(setf ,v (wbind1 ,v ,decls))) + +(defun makevar (var specialp) + (or (symbolp var) (error "not a symbol ~a" var)) + (let ((v (make-var :name var))) + (when specialp (setf (var-special-p v) t) + (setf (var-ind v) (get-object var))) + (setf (var-type v) (or (get var 'proclaimed-variable-type) t)) + + v)) + +(defun canon-opt-arg (v type + &aux var val supplied-p keyword + (intern (eql type '&key))) + ;; (list var val supplied-p keyword) + (tagbody + (if intern (setq keyword v)) + (cond ((atom v) + (or (symbolp v) (go error)) + (setq var v)) + (t + (cond ((consp (car v)) + (or intern (go error)) + (setq intern nil) + (desetq (keyword var) (car v))) + (t + (setq keyword (car v) var (car v)))) + (or (consp (cdr v)) (go error)) + (setq val (cadr v)) + (if (consp (cddr v)) + (setq supplied-p (caddr v))))) + (or (symbolp keyword) (go error)) + (or (symbolp var ) (go error)) + (or (null intern) + (setq keyword (intern (symbol-name keyword) 'keyword))) + (return-from canon-opt-arg (list var val supplied-p keyword)) + error + (comp-error "bad ~a arg ~s" type v))) + +;;lambda-list-keywords has value: +;; '(&optional &rest &key &allow-other-keys &aux &whole &environment &body) + +(defun decode-ll (list) + (let (ll sections) + (do ((v list (cdr v)) + (this (list '&required))) + ((null v) (push (nreverse this) sections) + (setq sections (nreverse sections ))) + (cond ((member (car v) lambda-list-keywords) + (push (nreverse this) sections) + (setq this (list (car v)))) + (t (push (if (consp (car v)) (car v) + (if sections (list (car v) nil) (car v))) + this)))) + (do ((v (cons '&required lambda-list-keywords) (cdr v)) + tem) + ((eq (car v) '&whole) + (or (null sections) + (error "unrecognized or duplicate '&' keyword in lambda-list ~a" + sections))) + (cond ((setq tem (assoc (car v) sections)) + (or (eq (car sections) tem) + (error "~a in incorrect position" (car v))) + (setf sections (cdr sections)))) + (push tem ll) + ) + (setq ll (nreverse ll)) + (dolist (v (ll &required ll)) + (unless (symbolp v) (error "required arg not a symbol ~a" v))) + (if (ll &allow-other-keys ll) + (setf (cdr (ll &allow-other-keys ll)) t)) + (setf (ll &key ll) + (sloop for v in-list (ll &key ll) + collect (canon-opt-arg v '&key))) + (setf (ll &optional ll) + (sloop for v in-list (ll &optional ll) + collect (canon-opt-arg v '&optional))) + (setf ll (mapcar 'cdr ll)))) + +(defun lambda-bind-b1 (decoded clb decls) + (let ((*walk-variable-bindings* *walk-variable-bindings*) + (*control-stack* *control-stack*)) + (if clb (push 'clb *walk-variable-bindings*)) + (flet ((fbind1 ( l decls &aux v) + (sloop for w on l + do + (cond ((atom (car w)) (wbind (car w) decls)) + (t (setq v (car w)) + ; v = (list var val supplied-p keyword) + (setf (nth 1 v) (b1-walk (nth 1 v) 'bind)) + (wbind (nth 0 v) decls) + (setq v (cddr v)) + (if (car v) (wbind (car v) decls)) + (setq v (cdr v)) + (if (car v) (setf (car v) + (get-object (car v))))))))) + (fbind1 (ll &required decoded) decls) + (fbind1 (ll &optional decoded) decls) + (if (ll &rest decoded) (wbind (caar (ll &rest decoded)) decls)) + (fbind1 (ll &key decoded) decls)) + (add-remaining-special-decls decls) + *walk-variable-bindings*)) +;;end eval-when +) + +(defvar *contains-function* + ;; set if the form contains a lambda expression. + ) + +(defvar *setjmps* + ;; the number of setjmps encountered so far. + ;; tagbody with clb tags, unwind-protect, catch all lay down setjmps. + ) + +(defun bound-variables-volatile () + (dolist (v *walk-variable-bindings*) + (cond ((eql v 'clb) (return nil)) + ((typep v 'var) + (setf (var-volatile v) t))))) + +(defun check-used (binds pos &aux w) + (dolist (v binds) + (cond ((consp v) + (setq w (nth pos v)) + (if (typep w 'var) + (or (var-special-p w) (var-changed w ) (var-ref w ) + + (comp-warn "Variable ~s was not used" (var-name w)))))))) + +(defun add-remaining-special-decls (decls) + (sloop for v in (second decls) + when v + do (push (list v 'special (makevar v t)) *walk-variable-bindings*))) + +(defun b1-lambda-block (form where &optional (clb 'clb) + &aux sform name closure-record + result decls doc + (*control-stack* (cons clb *control-stack*)) + (*function-decls* *function-decls*) + (tail-label (make-label :identifier '#.(gensym "tail"))) + ll bod decoded) + where + (desetq (sform) form) (setq form (cdr form)) + ;; set + (setq *contains-function* t) + (cond ((eq sform 'lambda-block) + (desetq (name) form) + (setq form (cdr form)))) + (desetq (ll . bod) form) + (setq decoded (decode-ll ll)) + (desetq (decls bod doc) (grab-declares bod t)) + (cond ((and (null name) + (consp bod) + (consp (car bod)) + (eq (caar bod) 'block)) + (desetq (name) (cdar bod))) + ((and (symbolp name) (eq sform 'lambda-block)) + (setq bod `((block ,name ,. bod))))) + (when clb + (dolist (v *walk-variable-bindings*) + (and (typep v 'var) + (var-clb v) + (push (cons v (var-clb v)) closure-record)))) + + (let* ((*control-stack* *control-stack*) + (*walk-variable-bindings* + (lambda-bind-b1 decoded clb decls)) + (tail-recursion + (and (not (ll &optional decoded)) + (eq sform 'lambda) + (not (ll &key decoded)) + (not (ll &rest decoded)) + (list 'lambda-block name (ll &required decoded) tail-label)))) + + + (push tail-label *control-stack*) + (setq result + (b1-walk `(let* ,(ll &aux decoded) + ,@ (get-back-some-decls decls (mapcar 'car (ll &aux decoded))) + ,@ bod) tail-recursion)) + + (check-used *walk-variable-bindings* 1)) + (if (ll &aux decoded) + (setf ll (butlast ll (length (member '&aux ll))))) + `(,sform , (make-fun-data name closure-record clb decoded doc result tail-label + ) ))) + +(defun make-fun-data (name closure-record clb ll doc form tail-label &aux tem result) + (setq result (make-fdata :name name :ll ll :doc doc)) + (setf (fdata-form result) form) + (setf (fdata-tail-label result) tail-label) + (when clb + (dolist (v *walk-variable-bindings*) + (cond ((and (typep v 'var) + (setq tem (var-clb v))) + (if (> tem + (or (cdr (assoc v closure-record)) 0)) + (push v (fdata-closure-vars result))))))) + result) + +(defun declare-volatile (binds) + (dolist (v binds) + (or (and (consp v) (typep (car v) 'var) (wfs-error))) + (setf (var-volatile (car v)) t))) + +(defun find-bind (var &optional (set-clb t) &aux clb) + (cond ((and (consp var) (eq (car var) 'done-b1)) + (setq var (cdr var)))) + (dolist (v *walk-variable-bindings*) + (cond ((var-p v) + (when (or (eq var (var-name v)) + (eq var v)) + (cond ((and clb set-clb + (not (var-special-p v))) + (setf (var-clb v) + (+ 1 (the fixnum (or (var-clb v) 0)))))) + (return-from find-bind v))) + ((eq 'clb v) + (setq clb t)) + ((consp v) + (cond ((eq (car v) var) + (case (second v) + (special + (return-from find-bind (third v))) + (symbol-macro (return-from find-bind (cdr v))) + (otherwise (wfs-error)))))) + (t (wfs-error)))) + (or (si::specialp var) (keywordp var) + (comp-warn "~a is an unknown variable. Assuming it is special." var)) + (let ((tem (makevar var t))) + (push (list var 'special tem) *walk-variable-bindings*) + tem)) + + +(defun b1-macro-function (name) + (let ((tem (assoc name *walk-functions*))) + (cond (tem + (if (eq 'macro (cadr tem)) (third tem) nil)) + (t (macro-function name))))) + +(eval-when (compile) (proclaim '(function expand-fun (t) t))) + +(defun expand-fun (form &aux f) + (unless (and (consp form) (eq (car form) 'lambda-block)) + (return-from expand-fun form)) + (setq f (second form)) + (let* ((line-info (get f 'line-info)) + (*digest-line-info* + (if (and line-info *digest-line-info*) + (progn (clrhash *digest-line-info*) + (dotimes (i (length line-info)) + (setf (gethash (aref line-info i) + *digest-line-info*) + i)) + *digest-line-info*) + nil)) + (*line-info* line-info)) + (let ((result (walk-top form))) + (setf (car form) 'lambda-block-expanded) + (setf (cdr form) (cdr result)) + form))) + +(defun walk-top (form) + (let ((*walk-variable-bindings* nil) + (*control-stack* nil) + (*walk-functions* nil) + ) + (b1-walk form 'top))) + +(defun transfer-line-info (form result for-sure &aux tem) + ;; transfer the line info from FORM to RESULT. + ;; If FOR-SURE holds, do it even if this would destroy + ;; line info of RESULT. + (cond ((atom result) nil) + ((setq tem (gethash form *digest-line-info*)) + (when (or for-sure (not (gethash result *digest-line-info*))) + (remhash form *digest-line-info*) + (and *line-info* (setf (aref *line-info* tem) result)) + (setf (gethash result *digest-line-info*) tem))))) + +(defun b1-walk (form where &aux tem sym result (changed 0)) + (declare (fixnum changed)) + (setq + result + (cond ((atom form) + (cond + ((constantp form) + (cond ((symbolp form) + (get-object (symbol-value form))) + (t (get-object form)))) + ((symbolp form) + (let ((v (find-bind form t))) + (cond ((and (consp v) (eq (car v) 'symbol-macro)) + (b1-walk (second v) where)) + (t (or (var-ref v) (setf (var-ref v) t)) + v)))))) + ((symbolp (setq sym (car form))) + ;;possibly fix line info + (and *digest-line-info* + (cond ((setq tem (get sym 'wl)) + (funcall tem form)))) + (setq changed (fill-pointer *changed*)) + (cond ((setq tem (get sym 'b1)) + (funcall tem form where)) + ((and (setq tem (get sym 'bo1)) + (setq tem (funcall tem form where))) + (b1-walk tem where)) + ((b1-macro-function sym) + (b1-walk (macroexpand form (walk-environment)) where)) + ((setq tem (get sym 'si::structure-access)) + (let (arg res-type sd (index (cdr tem))) + (desetq (arg) (cdr form)) + (setq tem + (case (car tem) + (vector `(aref (the (array t) ,arg) ,index)) + (list `(nth ,index ,arg)) + (t + (setq sd (get (car tem) 'si::s-data)) + (or (null (cddr form)) (comp-warn "Too many args to ~a" sym)) + (cond ((null sd) (comp-warn "Structure not defined ~a" (car tem))) + (t + (setq res-type + (comp-type(aet-type (aref (si::s-data-raw sd) index)))) + (cond ((eq res-type t) + `(si::structure-ref ,arg ',(car tem) ,index)) + (t + `(the,res-type + (si::structure-ref + (the (struct ,res-type) ,arg) + ',(car tem) ,index))))))))) + (b1-walk tem where))) + ;; function application + (t + (do-call-b1 form where) + ))) + ((and (consp (car form)) + (eq (caar form) 'lambda)) + (b1-walk `(funcall (function ,(car form)) ,@ (cdr form)) where)) + (t (error "unrecognized form to eval ~a" form)))) + (when (and (consp result) + (consp (cdr result)) + (typep (second result) 'desk)) + (let ((tem + (let ((v *changed*)) + (declare (type (vector (t)) v)) + (sloop for i from changed below (fill-pointer v) + collect (aref v i))))) + (when tem + (if (eq (second result) *default-desk*) + (setf (second result) (make-desk t))) + (setf (desk-changed-vars (second result))tem) + ))) + (and *digest-line-info* (transfer-line-info form result t)) + result) + +(defun constant-call (sym arglist) + (and (sloop for v in arglist + always (and (consp v) (eq (car v) 'dv))) + (cons + (b1-walk (apply sym (mapcar 'caddr arglist)) 'call) + nil))) + +(defun do-call-b1 (form where &aux (sym (car form)) tem args) + (let* ((wf (cdr (assoc sym *walk-functions*))) + (res + `(call ,*default-desk* + ,(make-call-data sym + (setq args (mapcar2 'b1-walk (cdr form) + 'funcall)) + wf + (cdr (assoc sym *function-decls*)) + )))) + (cond (wf + ;; indicate a closure ref if necessary. + (if (third wf) (find-bind (var-name (third wf)))) + ) + ((setq tem (result-from-args sym args)) + (setf (second res) (set-desk-type (second res) tem))) + ((setq tem (get sym 'proclaimed-function-declaration)) + (setq tem (ret-from-argd (fdecl argd tem))) + (cond ((eq tem 'double_ptr) (setq tem 'double-float)) + ((eq tem '*) (setq tem 't))) + (setf (second res) (set-desk-type (second res) tem)))) + (cond ((and (member sym '(< > length + - * / )) + (setq tem (constant-call sym (call-data-arglist (third res))))) + (return-from do-call-b1 (car tem)))) + + ;; tail recursion???? + (cond ((and (consp where) + (eq (car where) 'lambda-block) + (eq (second where) sym) + (not (member 'bound-special *control-stack*)) + (not wf)) + (format t "~%;;Note: Replaced tail call of ~a by iteration." sym) + (let ((args (call-data-arglist (third res)))) + (sloop for v in args with s + do + (unless (cdr args) + (setq sets (list (cons 'done-b1 (car args)))) + (loop-finish)) + (setq s (gensym)) + for var in (third where) + collect (list s (cons 'done-b1 v)) into binds + unless (eq t (var-type var)) + collect (list 'type (var-type var) s) into decls + collect s into sets + finally + (setq res (b1-walk + `(let ,binds + ,(cons 'declare decls) + (assign-args ,@sets) + (go ,(label-identifier (nth 3 where)))) + 'let)))))) + + ;;ordinary functioncall + res)) + +(defun b1-quote-first (form where &aux sform fir bod) where + (desetq (sform fir . bod) form) + `(,sform ,fir ,@ (mapcar2 'b1-walk bod sform))) + +(defun b1-quote (form where &aux val) where + (desetq (nil val) form) + (and (cddr form) (comp-error "Two many args to quote ~a"form)) + (get-object val)) + +(defun b1-setq (form where &aux sform var bod val ans) where + (cond ((null (cdr form)) (return-from b1-setq (get-object nil)))) + (desetq (sform var val . bod) form) + (do () (nil) + (let ((v (find-bind var t))) + (setf (var-changed v) t) + (and (plain-var-p v) (vector-push-extend v *changed*)) + (setq val (b1-walk val sform)) + (push v ans) (push val ans) + (if bod (desetq (var val . bod) bod) + (return nil)))) + `(,sform, (make-desk (var-type (second ans))) ,@ (nreverse ans))) + +(defun b1-eval (form where &aux sform bod) where + (desetq (sform . bod) form) + `(,sform ,@ (mapcar2 'b1-walk bod sform))) + +;; using (control-jumped-back id) +;; +;; and (pass-values) + +(defun b1-tagbody (form where &aux sform bod + (*walk-variable-bindings* *walk-variable-bindings*) + (*control-stack* *control-stack*) + (longjmp-id (makevar nil nil)) + sym + (clb-ref (list 0 longjmp-id)) + ) + where + (desetq (sform . bod) form) + (push longjmp-id *walk-variable-bindings*) + (setq bod + (sloop for v in-list bod + when (or (integerp v) (symbolp v)) + collect (list 'done-b1 + 'label + (let ((tem (make-label :identifier v + :clb-reference + (cons nil clb-ref) + ))) + (push tem *control-stack*) + tem)) + else + collect v)) + (setq bod (mapcar2 'b1-walk bod sform)) + (cond ((var-clb longjmp-id) + (setq sym (gensym)) + (bound-variables-volatile) + `(let-control-stack + (let ,*default-desk* + ((,longjmp-id ,(b1-walk '(unique-id) 'let-var))) + (,(b1-walk + `(let ((,sym 0) + (ctl-came-back (control-jumped-back (done-b1 . ,longjmp-id)))) + (declare (fixnum ,sym)(boolean ctl-came-back)) + (if ctl-came-back + (progn (nlj-active-off)(setq ,sym (pass-values)))) + (switch ,sym + ,@ (sloop for v in bod with tem + when (and (consp v) + (eq (car v) 'label) + (setq tem (car (label-clb-reference (cadr v))))) + collect `(case ,tem) + collect (cons 'done-b1 v)))) + 'tagbody))))) + + (t + `(,sform ,*default-desk* ,bod)))) + + + + + +;; wrapper so you can avoid doing b1 twice on a form. +;; when we need to do it once to get the result type. + +(defun b1-done-b1 (form where) where (cdr form)) + +(defun b1-prog1 (form where &aux sform body first) + (desetq (sform first body) form) + (setq first (b1-walk first where)) + (let ((sym (gensym))) + (b1-walk + `(let ((,sym (done-b1 . ,first))) + (declare (type ,(result-type first) ,sym)) + ,@ (append body (list sym))) + where))) + +(defun b1-progn (form where &aux sform bod) where + (desetq (sform . bod) form) + (cond ((and (eq sform 'progn) (null (cdr bod))) + (b1-walk (car bod) where)) + (t (setq bod (mapcar2 'b1-walk bod sform where)) + `(progn ,(make-desk (result-type (car (last bod)))) ,bod )))) + +(defun b1-if (form where &aux sform test then else) where + (desetq (sform test then) form) + (setq form (cdddr form)) + (when (consp form) (setq else (car form)) (setq form (cdr form))) + (if form (error "Too many args to if")) + (setq test (b1-walk test sform)) + (setq then (b1-walk then where)) + (setq else (b1-walk else where)) + (cond ((and (consp test) (eq (car test) 'dv)) + (return-from b1-if + (if (eq (third test) nil) else then)))) + `(,sform ,(make-desk (type-and (result-type then) + (result-type else))) + ,test ,then ,else)) + +(defun b1-macrolet (form where &aux sform mbinds ll name body mbody funs) + (desetq (sform mbinds . body) form) + (do ((v mbinds (cdr v))) + ((atom v)) + (desetq ((name ll . mbody)) v) + (let ((fun (second (parse-macro name ll mbody t)))) + (push (list name 'macro fun) funs))) + (let ((*walk-functions* (nconc (nreverse funs) *walk-functions*))) + (b1-walk (cons 'progn body) where))) + +(defun b1-flet (form where &aux sform mbinds name ll body mbody + new-binds fun ans let-binds let-sets var fdat tem + (*walk-variable-bindings* *walk-variable-bindings*) + (*walk-functions* *walk-functions*)) + (desetq (sform mbinds . body) form) + (do ((v mbinds (cdr v))) + ((atom v)) + (desetq ((name ll . mbody)) v) + (setq fun `(lambda-block ,name ,ll ,@mbody)) + ;;a variable to hold a pointer to the function itself. + ;; so we don't have to cons up more than one copy of itself. + (setq var (makevar (gensym "flet") nil)) + (push var *walk-variable-bindings*) + (push (list name fun nil var) new-binds)) + (if (eq sform 'labels) + (setf *walk-functions* + (append new-binds *walk-functions*))) + (dolist (v new-binds) + (setq var (fourth v)) + (setq ans(b1-lambda-block (second v) sform 'clb )) + (setq fdat (second ans)) + (setf (third v) ans) + (cond ((setq tem (fdata-closure-vars fdat)) + (cond ((and (null (cdr tem)) + (eq (car tem) var)) + ;; if the only reason for it being a closure is the self reference var + ;; forget it. + (setf (fdata-closure-vars fdat) nil)) + (t + (setf (fdata-closure-self fdat) var) + (push (list var nil) let-binds) + (push `(pointer-to-funobj ,fdat) let-sets) + (push var let-sets)))) + (t (setf (fourth v) nil) + ))) + + (if (eq sform 'flet) + (setf *walk-functions* (append new-binds *walk-functions*))) + (setq body (mapcar2 'b1-walk body sform where)) + (setq ans + `(flet ,(make-desk (result-type (car (last body)))) + ,(reverse new-binds) ,body)) + (if let-binds + `(let ,(second ans) ,let-binds + ((setq ,*default-desk* ,@ let-sets) + ,ans)) + ans)) + +(defun b1-symbol-macrolet (x where &aux sform binds body expansion decls tem + new-binds name + ) + (desetq (sform binds . body) x) + (desetq (decls body) (grab-declares body t)) + (do ((v binds (cdr v))) + ((atom v)) + (desetq ((name expansion)) v) + (if (member name (car decls)) + (error "special declaration of symbol-macrolet var ~a" + name)) + (when (setq tem (assoc name (second decls))) + (setf expansion `(the , (cdr tem) ,expansion))) + (push (list name 'symbol-macro expansion) new-binds)) + (let ((*walk-variable-bindings* (nconc new-binds *walk-variable-bindings*))) + (b1-progn (cons 'progn body) where))) + +(defun b1-let (form where &optional compiler-let + &aux sform var vars body val + (*function-decls* *function-decls*) + (*walk-variable-bindings* *walk-variable-bindings*) + (*control-stack* *control-stack*) + decls + binds) + (desetq (sform vars . body) form) + (do ((v vars (cdr v))) + ((atom v)) + (cond ((consp (car v)) + (setq var (caar v)) + (setq val (cdar v)) + (and (not compiler-let) + (setq val (b1-walk (car val) sform)))) + (t (setq var (car v) val nil))) + (push (list var val) binds)) + (setq binds (nreverse binds)) + (if compiler-let + (return-from b1-let + (progv (mapcar 'car binds) (mapcar 'cadr binds) + (b1-progn (cons 'progn body) where)))) + (desetq (decls body) (grab-declares body nil)) + (dolist-safe (v binds) + (wbind (car v) decls)) + (add-remaining-special-decls decls) + (cond ((null vars) (b1-progn (cons 'progn body) where)) + (t (setq body (mapcar2 'b1-walk body sform where)) + (check-used binds 0) + `(let ,(make-desk (result-type (car (last body)))) + ,binds, body)))) + +(defun b1-compiler-let (form where) + (b1-let form where t)) + +(defun b1-let* (form where &aux sform var val binds + (*function-decls* *function-decls*) + (*control-stack* *control-stack*) + (*walk-variable-bindings* *walk-variable-bindings*) + vars body decls) + (desetq (sform vars . body) form) + (desetq (decls body) (grab-declares body nil)) + (do ((v vars (cdr v))) + ((atom v)) + (cond ((consp (car v)) + (setq var (caar v)) + (setq val (cdar v)) + (and (consp val) + (setq val (b1-walk (car val) sform)))) + (t (setq var (car v) val nil))) + (push (list var val) binds) + (wbind (caar binds) decls) + ) + (add-remaining-special-decls decls) + (setq binds (nreverse binds)) + (cond ((null vars) (b1-progn (cons 'progn body) where)) + (t (setq body (mapcar2 'b1-walk body sform where)) + (check-used binds 0) + `(let* ,(make-desk (result-type (car (last body)))) + ,binds, body))) + ) + +;; Scope of declarations: +;; Note Xrj13 voted that for +;; (let ((x 0)) (declare (fixnum x)) +;; .. (let ((x 5))(declare (type t x)) ..)) +;; then the inner declaration of x is also (and fixnum t) ie fixnum. +;; We DO NOT take advantage of this declaration, since it is very easy +;; for users to slip up on this, and since it is contrary to CltlI. The +;; Compiler has license to ignore type decls if it wants, and we do so here. +;; They explicitly say for +;; (let ((x 0)) (declare (special x)) +;; .. (let ((x 5)) ..)) +;; then the inner binding of x is NOT special unless there is another decl. +;; We do this. + +(defun grab-declares (form doc-allowed &aux (dec t) decls doc tem) doc-allowed + ;; return (cons form decls) + ;; decls == (list specials type-decls ..) + (if (stringp (car form)) (setq doc (car form) + form (cdr form))) + (sloop while dec + do + (setq tem (car form)) + (cond ((and (consp tem) (eq (car tem) 'declare)) + (setq form (cdr form)) + (dolist-safe (v (cdr tem)) (setq decls (grab-1-decl v decls)))) + ((eq tem (car form))(setq dec nil)) + (t (setq form (cons tem (car form)))))) +; (if (and doc (not decls)) (setq form (cons doc form))) + ;decls= (((v1 . type1) (v2 . type2) ..)(special-var1 special-var2 ..)) + (list decls form doc)) + +(defun get-back-some-decls (decls vars &aux specials types tem) +;; build up a declare to restore the decls. + (setq specials(sloop for v in vars when (member v (second decls)) + collect v )) + (setq types(sloop for v in vars + when (setq tem (assoc v (car decls))) + collect `(type ,(cdr tem) ,v))) + (cond (specials (push (cons 'special specials) types))) + (if types `((declare ,@ types))nil)) + +(defun b1-declare (form where &aux type vars) + where + (dolist (v (cdr form)) + (desetq (type . vars) v) + (cond ((eq type'special) + (sloop for w in-list vars + do (push (list v 'special (makevar v t)) *walk-variable-bindings*))) + ((member type '(ftype optimize function + ignore + declaration + dynamic-extent)) + nil) + ((member type '(inline notinline)) + (dolist-safe (v vars) + (push (cons v + (increment-function-decl type + (function-declaration v))) + *function-decls*))) + ((eq type 'type) + (desetq (type . vars) vars) + ;; do nothing. + ))) + nil) + +(defun b1-the (form where &aux sform type val tem) + ;; note this takes away the checking + (desetq (sform type val) form) + (setq val (b1-walk val where)) + (setq type (comp-type type)) + (cond ((and (consp val) (typep (setq tem (second val)) 'desk)) + (setf (second val) (set-desk-type tem type)) +; (unless (and (consp type) (eq (car type )'values) +; (consp (cdr type)) (consp (cddr type))) +; (setf (desk-single-value (second val)) t)) + val) + (t (setq tem (result-type val)) + (setq type (type-and tem type)) + `(the ,(make-desk type) ,val)))) + +(defun b1function-object (object where) + ;; this might be called by b1-funcall, b1-mapcar and others + ;; to avoid getting closure varialbes. They must promise to inline + ;; this, since the closure vars are not set up, for cross closure stuff. + + (cond ((matches object '(function (lambda . tem))) + + `(inline-function ,(b1-lambda-block (second object) 'function nil))) + (t (b1-walk object where )))) + +(defun b1-function (form where &aux sform body tem) where + (desetq (sform body) form) + (cond ((symbolp body) + (cond ((setq tem (assoc body *walk-functions*)) + (cons 'pointer-to-funobj (cddr tem))) + (t (b1-walk `(symbol-function ',body) where)))) + ((and (consp body) + (eq (car body) 'lambda)) + (b1-lambda-block body 'function 'clb)) + ;`(lambda-block ,(b1-lambda-block body 'function t)) + (t (error "unrecognized function ~a" body)))) + +(defun b1-go (form where &aux sform label clb result ) where + (desetq (sform label) form) + (sloop for v in *control-stack* + when (eq v 'clb) do (setq clb t) + else when (and (typep v 'label) + (eql (label-identifier v) label)) + do(setq result v) + (when clb + (setq clb (label-clb-reference v)) + (or (car clb) (setf (car clb) (incf (cadr clb)))) + (let ((tem (or (var-clb (third clb)) 0))) + (incf tem) + (setf (var-clb (third clb) ) tem))) + (return nil) + finally (comp-error "~a label is not found " label)) + (cond (clb (b1-walk `(progn (call-set-mv ,(car clb)) + (do-throw (done-b1 . ,(third clb))) nil) 'go)) + (t (setf (label-referred result) t) (list 'go result)))) + +;(defun b1-unwind-protect (x where &aux form cleanup +; (var (gensym)) +; ) +; (desetq (nil form . cleanup) x) +; (bound-variables-volatile) +; (b1-walk +; `(let ((,var (function (lambda () ,@ cleanup)))) +; (declare (dynamic-extent ,var)) +; (push-unwind-protect ,var) +; (multiple-value-prog1 +; ,form +; (pop-control-stack) +; (funcall ,var))) +; where)) + +(defun simple-b1 (x where &aux sform form) + (desetq (sform form) x) + `(,sform ,(b1-walk form where))) +(setf (get 'let-control-stack 'b1) 'simple-b1) + +(defun b1-unwind-protect (x where &aux form cleanup + (var (gensym)) + ) + (desetq (nil form . cleanup) x) + (bound-variables-volatile) + (b1-walk + `(let ((,var (function (lambda () ,@ cleanup)))) + (declare (dynamic-extent ,var)) + (let-control-stack (progn (push-unwind-protect ,var) ,form))) + where)) + +(defun b1-progv (x where &aux vars vals body bind) + (desetq (vars vals . body) (cdr x)) + (setq bind (b1-walk `(the fixnum (progv-bind ,vars ,vals)) 'progv)) + (let ((*control-stack* (cons 'progv *control-stack*))) + (setq body (mapcar2 'b1-walk body 'progv where)) + `(progv ,(make-desk (result-type (car (last body)))) + ,bind ,body))) + +(defun b1-catch (x where &aux tag bod ) + where + (desetq (tag . bod) (cdr x)) + (bound-variables-volatile) + `(let-control-stack + ,(b1-walk + `(if (control-jumped-back ,tag) (progn (nlj-active-off)(pass-values)) + (progn ,@ bod)) + 'catch))) + +(defun b1-throw (x where &aux tag bod form) where + (desetq ( tag form . bod ) (cdr x)) + (or (null bod) (comp-error "too many args to throw ~a" x)) + (let (sym) + (b1-walk + `(let ,(cond ((and (consp tag)(eq (car tag) 'quote))(setq sym tag) nil) + (t (setq sym (gensym)) `((,sym ,tag)))) + (call-set-mv ,form) + (do-throw ,sym) + nil) + 'throw))) + +;(defun b1-throw (x where &aux tag bod form) where +; (desetq ( tag form . bod ) (cdr x)) +; (or (null bod) (comp-error "too many args to throw ~a" x)) +; `(throw ,*default-desk* ,tag ,(b1-walk form 'throw))) + +(defun b1-multiple-value-prog1 (x where &aux first bod) + (desetq (nil first . bod) x) + `(multiple-value-prog1 ,*default-desk* ,(b1-walk first where) + ,(mapcar2 'b1-walk bod 'progn))) + +(defun b1-block (x where &aux sform tag bod + ( *control-stack* *control-stack*) + (*walk-variable-bindings* *walk-variable-bindings*) + block ans var) + (desetq (sform tag . bod) x) + (setq block (make-block (make-label :identifier tag + :clb-reference (setq var (makevar nil nil)) + ))) + (push var *walk-variable-bindings*) + (push block *control-stack*) + (or bod (setq bod '(nil))) + (setq bod (mapcar2 'b1-walk bod sform where)) + (setq ans `(,sform ,(make-desk (result-type (car (last bod)))) + ,block ,bod)) + (cond ((var-clb var) + (bound-variables-volatile) + (setq ans + `(let-control-stack + (let ,(second ans) , + `((,var ,(b1-walk '(unique-id) 'let-var))) + (,(b1-walk `(if (control-jumped-back (done-b1 . ,var)) + (progn + (nlj-active-off) + (pass-values)) + (done-b1 . ,ans)) + where)))))) + (t (setf (label-clb-reference (block-label block)) nil))) + ans + ) + +(defun b1-return-from (x where &aux clb tag block form bod) where + (desetq (nil tag . bod) x) + (cond ((null bod) (setq form nil)) + ((consp bod) (setq form (car bod)) + (or (null (cdr bod)) + (comp-error "Too many values for return-from ~a"x))) + (t (comp-error "Bad return from ~a" x))) + (sloop for v in *control-stack* + when (eq v 'clb) do (setq clb t) + else + when (and (typep v 'block) + (eql (label-identifier (block-label v)) tag)) + do (setq block v) + (when clb + (setq clb (label-clb-reference (block-label v))) + (cond ((var-clb clb) (incf (var-clb clb))) + (t (setf (var-clb clb) 1)))) + (return nil) + finally (comp-error "Could not find ~a tag to return from" block)) + (cond (clb + (b1-walk `(progn + (call-set-mv ,form) + (do-throw ,(cons 'done-b1 clb)) + nil + ) + 'return-from)) + (t (setq form (b1-walk form 'return-from)) + `(return-from ,(make-desk (result-type form)) ,block ,form)))) + +(defun b1-values (x where) + (let ((argl (mapcar2 'b1-walk (cdr x) where))) + `(values , (make-desk (if argl (result-type (car argl)) t)) ,argl))) + + + +;; Several WL functions for Walk to fix Line-info, and +;; make it more sensible for special forms. + +(do ((v '(let wl-let + let* wl-let + compiler-let wl-let + cond wl-cond + ) (cddr v))) + ((null v)) + (setf (get (car v) 'wl) (second v))) + +(defun wl-let (form &aux sform vars bod) + (desetq (sform vars . bod) form) + (dolist (v vars) + (if (consp v) + (transfer-line-info v (second v) nil)))) + +(defun wl-cond (form &aux clauses) + (desetq (nil . clauses) form) + (dolist (v clauses) + (or (consp v) (error "bad cond clause")) + (transfer-line-info v (if (consp (car v)) (car v) + (second v)) nil))) + +(defun use-expansion (do) + (if do (setf si::lambda-block-expanded (symbol-function 'si::expand-fun)) + (setf si::lambda-block-expanded nil))) + +(defmacro switch (test &body body &aux tem (tes (gensym ))) + (sloop for v in-list body + when + (and (consp v) (eq (car v) 'case) + (consp (cdr v)) + (null (cddr v))) + collect (setq tem (make-symbol (format nil "case~a_" (cadr v)))) into bod + and + collect (cons (cadr v) tem) into cases + else collect v into bod + finally + (return + `(tagbody + (let ((,tes ,test)) + (declare (fixnum ,tes)) + (cond ,@ (sloop for v in cases + when (typep (car v) 'fixnum) + collect `((eql ,tes ,(car v))(go ,(cdr v))) + else + collect `(t (go ,(cdr v)))))) + ,@ bod)))) + +;(switch n (case 0) 3) + + + + + + +;; +;;- Local variables: +;;- mode:lisp +;;- version-control:t +;;- End: + + + + + + + + + + + diff --git a/comp/wr.lsp b/comp/wr.lsp new file mode 100755 index 0000000..e36fdbf --- /dev/null +++ b/comp/wr.lsp @@ -0,0 +1,476 @@ +(in-package "BCOMP") +(defmacro wr (&rest l) + `(progn ,@ (mapcar #'(lambda (x) + (if (stringp x) `(princ ,x *c-output*) + `(wr1 ,x))) + l + ))) +(defmacro wr-nl (&rest l) + `(wr " + " ,@l)) + +(defmacro wr-h (&rest l) + `(progn (princ " + " *h-output*) + ,@ (mapcar #'(lambda (x) + (if (stringp x) `(princ ,x *h-output*) + `(wr1-h ,x))) + l))) + +(defun wr1 (x ) + (cond ((or (typep x 'fixnum)(stringp x)) (princ x *c-output*)) + ((consp x) + (or (symbolp (car x)) (wfs-error)) + (let ((fd (get (car x) 'wr))) + (or fd (wfs-error)) + (funcall fd x))) + ((typep x 'var) + (cond ((var-clb x) + (wr "ClosRef(" (list 'closure-var-loc x) ")")) + ((var-special-p x) + (or (var-ind x) (wfs-error)) + (cond ((= *safety* 0) + (wr "("(var-ind x)")->s.Bind" )) + (t (wr "symbol_value("(var-ind x)")" )))) + (t (or (var-ind x) (next-cvar x)) + (cond ((stringp (var-ind x)) (wr (var-ind x))) + (t (wr "V" (var-ind x))))))) + ((eq t x)(wr "Ct")) + ((eq nil x)(wr "Cnil")) + ((typep x 'label) + (or (label-ind x) (setf (label-ind x) (next-label))) + (wr (label-ind x))) + ((typep x 'fdata) + (let ((i (fdata-ind x))) + (if (stringp i) (wr i) (wr "L" i)))) + (t (wfs-error)))) + +(defun wr1-h (x &aux (*c-output* *h-output*)) + (wr1 x)) + +(setf (get 'dv 'wr) 'wr-dv) +(setf (get 'd_eval 'wr) 'wr-dv) + +(defun add-data (x &aux tem) + (or (and (consp x) (or (eq (car x) 'dv) + (eq (car x) 'd_eval))) + (wfs-error)) + (let ((item (third x))) + (unless (second x) + (cond + ((and (symbolp item) + (setq tem (get item 'dv))) + (setf (second x) tem)) + ((and (typep item 'fixnum) + (eql 0 (logand #. (lognot 1023) (the fixnum item)))) + (setf (cadr x) + (format nil "small_fixnum(~a)" item))) + (t (setf (second x) *next-data*) + (push-data (car x) (third x))))) + x)) + +;; Some things namely the keyword mechanism REQUIRES a constant which +;; has an index. This means that named ones will have to get an index +;; We could smash this place +(defun get-dv-index (x) + ;; a (dv which may have a string. We put an index in the fourth place.) + (cond ((typep (second x) 'fixnum) (second x)) + ((cdddr x) (fourth x)) + (t (setq x (nconc x (list *next-data*))) + (push-data (car x) (third x))))) + +(defun wr-dv (x) + (let ((tem (second x))) + (cond (tem + (cond ((typep tem 'fixnum) (wr "VV[" tem"]")) + (t (wr tem)))) + (t (add-data x) + (wr-dv x))))) + + +(setf (get 'var 'wr) 'wr-var) +(defun wr-var (x) + (cond ((and (consp x) (eq (car x) 'var)) + (wr-vind (second x))) + (t (wfs-error)))) + +(defun wr-vind (x) + (if (stringp x) (wr x) (wr "V" x))) + +(setf (get 'closure-var-loc 'wr) 'wr-closure-var-loc) +(defun wr-closure-var-loc (x &aux (var (second x))) + (cond ((member var *closure-vars*) + (wr "CLvars->") + (or (and (consp (var-ind var)) (eq (car (var-ind var)) 'kw)) + (wfs-error)) + (wr-vind (second (var-ind var)))) + (t (wr-vind (var-ind var))))) + +(setf (get 'key-var 'wr) 'wr-key-var) +(defun wr-key-var (x &aux (v (second x)) tem) + (or (typep v 'var) (wfs-error)) + (cond ((setq tem (var-special-p v)) + (wr tem)) + (t + (wr-vind (var-ind v))))) + + + +(setf (get 'vcs 'wr) 'wr-vcs) +(defun wr-vcs(x) + (wr "cs[" (second x)"]")) + +(setf (get 'kw 'wr) 'wr-kw) +(defun wr-kw(x) + (wr "k.") + (wr-vind (second x))) + +(setf (get 'vk 'wr) 'wr-vk) +(defun wr-vk (x) + (wr "&VK" (second x) "key")) + +(defun wr-comment (message &optional (symbol nil)) + (wr " +/* " message) + (and symbol (wr (mangle symbol))) + + (wr " */ +") + nil) + +(setf (get 'label 'wr) 'wr-label) +(defun wr-label (n &aux) + (when (consp n) + (or (eq (car n) 'label) (wfs-error)) + (setq n (second n))) + (wr " + LA" n ": ")) + +(defun wr-go (n) + (if (typep n 'label) + (or (label-ind n) (setq n (setf (label-ind n) (next-label))))) + (wr "goto LA" n ";")) + +(defun wr-list (l) + (do ((v l (cdr v))) + ((null v)) + (wr (car v)) + (or (null (cdr v)) (wr ",")))) + +(setf (get 'next-var-arg 'wr) 'wr-next-var-arg) +(defun wr-next-var-arg (x) + x (wr "va_arg(Iap,object)")) + + +(setf (get 'call 'wr) 'wr-call) +(defun wr-call (x) + (let* ((cdat (second x)) + (fname (call-data-fname cdat)) + (name (if (symbolp fname) (symbol-name fname) + (format nil "L~a" (fdata-ind fname))))) + (wr "CA_" name "(") + (wr-list (third x)) + (wr ")")) + ) + +(defmacro var-implementation-type (x) + `(cond ((and (plain-var-p ,x) + (not (and (consp (var-ind ,x)) (eq (car (var-ind ,x)) 'kw)))) + (var-type ,x)) + (t t))) + +(defun wr-set-inline-loc (a b &aux type) + (cond ((eq a b) (wr ";")(return-from wr-set-inline-loc nil))) + (cond((atom a) + (or (typep a 'var) (wfs-error)) + (cond ((var-special-p a) + (setq type 'special) + (wr-nl "(" (var-ind a) ")->s.Bind = ")) + (t (setq type (var-implementation-type a))))) + ((and (consp a) (eq (car a) 'var)) + (setq type (third a))) + (t (wfs-error))) + + (cond ((eq type 'integer) + (let ((val-type (value-type b))) + (case val-type + (fixnum (wr-nl "ISETQ_FIX(") ) + (integer (wr-nl "SETQ_II(") ) + (otherwise (wr-nl "SETQ_IO(") (setq val-type t))) + (setq b (list 'inline-loc val-type b)) + (wr a","a"__alloc," b ");") + (return-from wr-set-inline-loc nil))) + ((eq type 'special) + (setq type t)) + (t (wr-nl a "="))) + (case type + (fixnum (wr-fixnum-loc b)) + (character (wr-character-loc b)) + (gen (wr-integer-loc b)) + (double-float (wr-double-float-loc b)) + (double_ptr (wr-double_ptr-loc b)) + (short-float (wr-short-float-loc b)) + (boolean (wr-boolean-loc b)) + (t (wr-obj-loc b))) + (wr ";") + ) + +(defun wr-integer-loc (x) + (cond ((and (dv-p x) (typep (third x) 'fixnum)) + (setq x (list 'inline-loc 'fixnum x)))) + (case (value-type x) + (integer (wr x)) + (fixnum (wr "stoi(" x ")")) + (t (wr "otoi(" x ")")))) + + + +(defun value-type (x &aux tem) + ;; returns the representation type of form x + (setq tem + (cond ((consp x) + (cond ((eq (car x) 'dv) t) + + ((eq (car x) 'var) (or (third x) t)) + ((eq (car x) 'inline-call) (nth 3 x)) + ((eq (car x) 'inline-loc) (nth 1 x)) + ((eq (car x) 'let-control-stack) + (value-type (second x))) + ((eq (car x) 'next-var-arg) t) + )) + ((typep x 'var) + (var-implementation-type x)))) + + (unless tem + (comp-warn "Don't know type of ~a. Assuming type t" x)) + (or (memq tem '(fixnum integer short-float double-float character boolean double_ptr)) + (setq tem t)) + tem) + + +(setf (get 'inline-loc 'wr) 'wr-inline-loc) + +(defun wr-inline-loc (x &aux (y (third x)) (type (second x))) + (case type + (fixnum (wr-fixnum-loc y)) + (short-float (wr-short-float-loc y)) + (double-float (wr-double-float-loc y)) + (double_ptr (wr-double_ptr-loc y)) + (character (wr-character-loc y)) + ((gen integer) (wr-integer-loc y)) + (boolean (wr-boolean-loc y)) + (t (wr-obj-loc y)))) + +(setf (get 'fixnum 'loc) 'wr-fixnum) + +(defun wr-boolean-loc (x) + (let ((type (value-type x))) + (case type + (boolean (wr x)) + ((short-float double_ptr character long-float integer) (wr "1")) + (t (wr "(" x ")!=sLnil" ))))) + + +(defun wr-fixnum-loc (b) + (case (value-type b) + (fixnum (wr b)) + ((short-float long-float) (wr "(int)(" b")" )) + (double_ptr (wr "(int)(*(" b "))")) + (integer (wr "itos(" b")")) + (t + (cond ((and (consp b) (eq (car b) 'dv)) + (cond ((typep (third b) 'fixnum) + (wr (third b)) (return-from wr-fixnum-loc nil)) + (t (comp-warn "Not a fixnum ~a "(third b)))))) + (wr "fix(" b ")")))) + +(defun wr-character-loc (b) + (case (value-type b) + (character (wr b)) + ((short-float long-float) + (comp-error "Cant coerce float to character") + (wr "(int)(" b")" )) + (integer (wfs-todo)) + (t + (cond ((and (consp b) (eq (car b) 'dv)) + (cond ((typep (third b) 'character) + (wr (char-code (third b))) (return-from wr-character-loc nil)) + (t (comp-warn "Not a character ~a "(third b)))))) + (wr "char_code(" b ")")))) + + +(defun wr-double-float-loc (b) + (case (value-type b) + ((short-float fixnum) (wr "(double)(" b ")")) + (double-float (wr b)) + (double_ptr (wr "*(" b ")")) + (integer (wfs-todo)) + (t (wr "DFloat(" b ")")))) + +(defun wr-short-float-loc (b) + (case (value-type b) + ((short-float fixnum double-float) (wr "(float)(" b ")")) + (double_ptr (wr "(float)(*(" b "))")) + (integer (wfs-todo)) + (t (wr "SFloat(" b ")")))) + +(defun wr-double_ptr-loc (b &aux tem) + (case (value-type b) + ((short-float fixnum) + (setq tem (get-temp 'double_ptr)) + (wr "*"tem" = (double)(" b ")") ) + (double (wr "*("b")")) + (integer (wfs-todo)) + (t + ;;wrong + (object (wr "&(DFloat(" b "))"))))) + + +(defun wr-obj-loc (x) + (case (value-type x) + (short-float (wr "make_shortfloat(" x ")")) + (double-float (wr "Imake_doublefloat(" x ")")) + (double_ptr (wr "Imake_doublefloat(*(" x "))")) + (fixnum (wr "make_fixnum(" x ")")) + (integer + (wr "make_integer(" x ")")) + (character (wr "code_char(" x ")")) + (boolean (wr "(" x "? sLt : sLnil)")) + (t (wr x)))) + +(setf (get 'inline-call 'wr) 'wr-inline-call) + +(defun wr-inline-call (x ) +; (desetq (sform iargs arg-types res flags fstring) x) + (wr-inline-call1 (cadr x) (opt template (cddr x)))) + +(defun wr-link-call (lnk iargs &aux nochange) + (let* ((argd (link-argd lnk)) + (n (length iargs))) + (declare (fixnum argd )) + (cond ((< n (argd-minargs argd)) + (setf (argd-minargs argd) n)) + ((> n (argd-maxargs argd)) + (setf (argd-maxargs argd) n)) + (t (setq nochange t)) + (setf (argd-minargs (link-argd lnk)))) + (unless nochange + (setf (link-argd lnk) argd)) + (or (link-ind lnk) (setf (link-ind lnk) (mangle-name (link-fname lnk) 'function))) + (cond ((argd-flag-p argd requires-nargs) + (wr "(VFUN_NARGS=" n ","))) + + (wr "(*LnK" (link-ind lnk) ")(") + (wr-list iargs) + (wr ")") + (cond ((argd-flag-p argd requires-nargs) + (wr ")"))))) + +(defun wr-inline-call1 (iargs fstring &aux + (leng 0) wrote-paren + (ch #\space) (ind 0) (start 0) + (out *c-output*)) +;; $@i : write out all (nthcdr i args) in a comma separated list. +;; $i : write out arg i ( 0<= i < 10) +;; $# : write out (length iargs) +;; @i,j,..; i,j,.. are multiple eval'd. +;; $*i : push args starting at the ith onto value stack and pass the pointer +;; to the place where you start. + (declare (character ch) (fixnum ind leng start) + (string fstring)) + (cond ((stringp fstring)) + ((typep fstring 'link) + (wr-link-call fstring iargs) (return-from wr-inline-call1 nil)) + (t (return-from wr-inline-call1 (funcall fstring iargs)))) + (setq leng (length fstring)) + ;; save multiple eval'd args. @0,3; means args 0 and 3 need temps. + (cond ((eql (aref fstring 0) #\@) + (sloop for i from 1 below leng + until (eql (setq ch (aref fstring i)) #\;) + when (digit-char-p ch) + do (let ((tem (nth (setq ind (- (char-code ch )(char-code #\0))) + iargs))) + (unless (or (typep tem 'var) + (and (consp tem) + (or (eq (car tem) 'dv) + (eq (car tem) 'var)))) + (let ((v (get-temp (value-type + (nth ind iargs))))) + (setf (nth ind iargs) v) + (unless wrote-paren + (setq wrote-paren t) + (wr "(")) + (wr v "= " tem ",")))) + finally (setq start (+ 1 i))))) + + ;; write out the template. + (sloop for i from start below leng with l = (length iargs) + declare (fixnum l) + do (setq ch (aref (the string fstring) i)) + (cond + ((or (eql ch #\$) + (eql ch #\#);; compatibility with akcl + ) + (setq i (+ i 1)) + (setq ch (aref (the string fstring) i)) + (setq ind (- (char-code ch) (char-code #\0))) + (cond ((and (< ind 10) (>= ind 0)) + (if (>= ind l) + (comp-error "Bad inline template ~a" fstring)) + (wr (nth ind iargs))) + ((eql ch #\@) + (setq i (+ i 1)) + (let ((n (- (char-code (aref fstring i)) (char-code #\0)))) + (declare (fixnum n)) + (wr-list (nthcdr n iargs)))) + ((eql ch #\*) + (setq i (+ i 1)) + (let* ((n (- (char-code (aref fstring i)) (char-code #\0))) + (m (- (length iargs) n)) + (p (get-temp "object *"))) + (declare (fixnum n m)) + (wr "(" p "= (vs_top+=" m"),") + (sloop for v in (reverse (nthcdr n iargs)) + do (wr "*--"p" =" v",")) + (wr p ")"))) + ((eql ch #\# ) (wr (length iargs))) + (t (comp-error "Bad inline string ~s" fstring)))) + (t (write-char ch out)))) + ; + (if wrote-paren (wr ")")) + ) +(defun write-out-links( &aux lnk) + (dolist (v *file-inline-templates*) + (or (typep (setq lnk (nth 4 v)) 'link) (wfs-error)) + (let ((ind (link-ind lnk)) + (rett (rep-type (third v)))) + (wr " +static " rett "LnKT" ind "(va_alist)va_dcl +{va_list Iap; va_start(Iap); return ("rett ")Icall_proc" + (if (eq (third v) 'short-float) "_float(" "(") + (get-object (link-fname lnk)) "," + (link-argd lnk) + ",&LnK" (link-ind lnk ) ",Iap);}") + (wr-h "static "rett "LnKT"ind"(),(*LnK" + ind ")()=LnKT" ind ";") + ) + )) + +(defun write-out-address-and-data () + (let ((*c-output* *h-output*)) + (wr" +static object VV[" (max 1 (length *address-vector*) *next-data*) "]={") + (let ((l (length *address-vector*)) + (i 0)) + (declare (fixnum i l)) + (sloop while (< i l) + do (wr-nl "(void *)" (aref *address-vector* i)) + when (< (setq i (+ i 1)) l) + do (wr ",")) + (if (eql i 0) (wr 0)) + (wr "};"))) + (wt-data-file)) + +(setf (get 'address 'wr) 'wr-address) +(defun wr-address (x) + (wr "&" (second x))) \ No newline at end of file diff --git a/config.guess b/config.guess new file mode 100755 index 0000000..7f76b62 --- /dev/null +++ b/config.guess @@ -0,0 +1,1754 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright 1992-2022 Free Software Foundation, Inc. + +# shellcheck disable=SC2006,SC2268 # see below for rationale + +timestamp='2022-01-09' + +# This file 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 3 of the License, 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, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. +# +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess +# +# Please send patches to . + + +# The "shellcheck disable" line above the timestamp inhibits complaints +# about features and limitations of the classic Bourne shell that were +# superseded or lifted in POSIX. However, this script identifies a wide +# variety of pre-POSIX systems that do not have POSIX shells at all, and +# even some reasonably current systems (Solaris 10 as case-in-point) still +# have a pre-POSIX /bin/sh. + + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright 1992-2022 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +# Just in case it came from the environment. +GUESS= + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +tmp= +# shellcheck disable=SC2172 +trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 + +set_cc_for_build() { + # prevent multiple calls if $tmp is already set + test "$tmp" && return 0 + : "${TMPDIR=/tmp}" + # shellcheck disable=SC2039,SC3028 + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } + dummy=$tmp/dummy + case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in + ,,) echo "int x;" > "$dummy.c" + for driver in cc gcc c89 c99 ; do + if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then + CC_FOR_BUILD=$driver + break + fi + done + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; + esac +} + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if test -f /.attbin/uname ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +case $UNAME_SYSTEM in +Linux|GNU|GNU/*) + LIBC=unknown + + set_cc_for_build + cat <<-EOF > "$dummy.c" + #include + #if defined(__UCLIBC__) + LIBC=uclibc + #elif defined(__dietlibc__) + LIBC=dietlibc + #elif defined(__GLIBC__) + LIBC=gnu + #else + #include + /* First heuristic to detect musl libc. */ + #ifdef __DEFINED_va_list + LIBC=musl + #endif + #endif + EOF + cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` + eval "$cc_set_libc" + + # Second heuristic to detect musl libc. + if [ "$LIBC" = unknown ] && + command -v ldd >/dev/null && + ldd --version 2>&1 | grep -q ^musl; then + LIBC=musl + fi + + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + if [ "$LIBC" = unknown ]; then + LIBC=gnu + fi + ;; +esac + +# Note: order is significant - the case branches are not exclusive. + +case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ + /sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + echo unknown)` + case $UNAME_MACHINE_ARCH in + aarch64eb) machine=aarch64_be-unknown ;; + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + earmv*) + arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'` + endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'` + machine=${arch}${endian}-unknown + ;; + *) machine=$UNAME_MACHINE_ARCH-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently (or will in the future) and ABI. + case $UNAME_MACHINE_ARCH in + earm*) + os=netbsdelf + ;; + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # Determine ABI tags. + case $UNAME_MACHINE_ARCH in + earm*) + expr='s/^earmv[0-9]/-eabi/;s/eb$//' + abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"` + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case $UNAME_VERSION in + Debian*) + release='-gnu' + ;; + *) + release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + GUESS=$machine-${os}${release}${abi-} + ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE + ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE + ;; + *:SecBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/SecBSD.//'` + GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE + ;; + *:LibertyBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'` + GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE + ;; + *:MidnightBSD:*:*) + GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE + ;; + *:ekkoBSD:*:*) + GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE + ;; + *:SolidBSD:*:*) + GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE + ;; + *:OS108:*:*) + GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE + ;; + macppc:MirBSD:*:*) + GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE + ;; + *:MirBSD:*:*) + GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE + ;; + *:Sortix:*:*) + GUESS=$UNAME_MACHINE-unknown-sortix + ;; + *:Twizzler:*:*) + GUESS=$UNAME_MACHINE-unknown-twizzler + ;; + *:Redox:*:*) + GUESS=$UNAME_MACHINE-unknown-redox + ;; + mips:OSF1:*.*) + GUESS=mips-dec-osf1 + ;; + alpha:OSF1:*:*) + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + trap '' 0 + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case $ALPHA_CPU_TYPE in + "EV4 (21064)") + UNAME_MACHINE=alpha ;; + "EV4.5 (21064)") + UNAME_MACHINE=alpha ;; + "LCA4 (21066/21068)") + UNAME_MACHINE=alpha ;; + "EV5 (21164)") + UNAME_MACHINE=alphaev5 ;; + "EV5.6 (21164A)") + UNAME_MACHINE=alphaev56 ;; + "EV5.6 (21164PC)") + UNAME_MACHINE=alphapca56 ;; + "EV5.7 (21164PC)") + UNAME_MACHINE=alphapca57 ;; + "EV6 (21264)") + UNAME_MACHINE=alphaev6 ;; + "EV6.7 (21264A)") + UNAME_MACHINE=alphaev67 ;; + "EV6.8CB (21264C)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8AL (21264B)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8CX (21264D)") + UNAME_MACHINE=alphaev68 ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE=alphaev69 ;; + "EV7 (21364)") + UNAME_MACHINE=alphaev7 ;; + "EV7.9 (21364A)") + UNAME_MACHINE=alphaev79 ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + OSF_REL=`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` + GUESS=$UNAME_MACHINE-dec-osf$OSF_REL + ;; + Amiga*:UNIX_System_V:4.0:*) + GUESS=m68k-unknown-sysv4 + ;; + *:[Aa]miga[Oo][Ss]:*:*) + GUESS=$UNAME_MACHINE-unknown-amigaos + ;; + *:[Mm]orph[Oo][Ss]:*:*) + GUESS=$UNAME_MACHINE-unknown-morphos + ;; + *:OS/390:*:*) + GUESS=i370-ibm-openedition + ;; + *:z/VM:*:*) + GUESS=s390-ibm-zvmoe + ;; + *:OS400:*:*) + GUESS=powerpc-ibm-os400 + ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + GUESS=arm-acorn-riscix$UNAME_RELEASE + ;; + arm*:riscos:*:*|arm*:RISCOS:*:*) + GUESS=arm-unknown-riscos + ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + GUESS=hppa1.1-hitachi-hiuxmpp + ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + case `(/bin/universe) 2>/dev/null` in + att) GUESS=pyramid-pyramid-sysv3 ;; + *) GUESS=pyramid-pyramid-bsd ;; + esac + ;; + NILE*:*:*:dcosx) + GUESS=pyramid-pyramid-svr4 + ;; + DRS?6000:unix:4.0:6*) + GUESS=sparc-icl-nx6 + ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) GUESS=sparc-icl-nx7 ;; + esac + ;; + s390x:SunOS:*:*) + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL + ;; + sun4H:SunOS:5.*:*) + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-hal-solaris2$SUN_REL + ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-sun-solaris2$SUN_REL + ;; + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + GUESS=i386-pc-auroraux$UNAME_RELEASE + ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + set_cc_for_build + SUN_ARCH=i386 + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -m64 -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH=x86_64 + fi + fi + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=$SUN_ARCH-pc-solaris2$SUN_REL + ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-sun-solaris3$SUN_REL + ;; + sun4*:SunOS:*:*) + case `/usr/bin/arch -k` in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'` + GUESS=sparc-sun-sunos$SUN_REL + ;; + sun3*:SunOS:*:*) + GUESS=m68k-sun-sunos$UNAME_RELEASE + ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 + case `/bin/arch` in + sun3) + GUESS=m68k-sun-sunos$UNAME_RELEASE + ;; + sun4) + GUESS=sparc-sun-sunos$UNAME_RELEASE + ;; + esac + ;; + aushp:SunOS:*:*) + GUESS=sparc-auspex-sunos$UNAME_RELEASE + ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + GUESS=m68k-milan-mint$UNAME_RELEASE + ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + GUESS=m68k-hades-mint$UNAME_RELEASE + ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + GUESS=m68k-unknown-mint$UNAME_RELEASE + ;; + m68k:machten:*:*) + GUESS=m68k-apple-machten$UNAME_RELEASE + ;; + powerpc:machten:*:*) + GUESS=powerpc-apple-machten$UNAME_RELEASE + ;; + RISC*:Mach:*:*) + GUESS=mips-dec-mach_bsd4.3 + ;; + RISC*:ULTRIX:*:*) + GUESS=mips-dec-ultrix$UNAME_RELEASE + ;; + VAX*:ULTRIX*:*:*) + GUESS=vax-dec-ultrix$UNAME_RELEASE + ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + GUESS=clipper-intergraph-clix$UNAME_RELEASE + ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" +#ifdef __cplusplus +#include /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && + dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`"$dummy" "$dummyarg"` && + { echo "$SYSTEM_NAME"; exit; } + GUESS=mips-mips-riscos$UNAME_RELEASE + ;; + Motorola:PowerMAX_OS:*:*) + GUESS=powerpc-motorola-powermax + ;; + Motorola:*:4.3:PL8-*) + GUESS=powerpc-harris-powermax + ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + GUESS=powerpc-harris-powermax + ;; + Night_Hawk:Power_UNIX:*:*) + GUESS=powerpc-harris-powerunix + ;; + m88k:CX/UX:7*:*) + GUESS=m88k-harris-cxux7 + ;; + m88k:*:4*:R4*) + GUESS=m88k-motorola-sysv4 + ;; + m88k:*:3*:R3*) + GUESS=m88k-motorola-sysv3 + ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110 + then + if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \ + test "$TARGET_BINARY_INTERFACE"x = x + then + GUESS=m88k-dg-dgux$UNAME_RELEASE + else + GUESS=m88k-dg-dguxbcs$UNAME_RELEASE + fi + else + GUESS=i586-dg-dgux$UNAME_RELEASE + fi + ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + GUESS=m88k-dolphin-sysv3 + ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + GUESS=m88k-motorola-sysv3 + ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + GUESS=m88k-tektronix-sysv3 + ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + GUESS=m68k-tektronix-bsd + ;; + *:IRIX*:*:*) + IRIX_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/g'` + GUESS=mips-sgi-irix$IRIX_REL + ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id + ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + GUESS=i386-ibm-aix + ;; + ia64:AIX:*:*) + if test -x /usr/bin/oslevel ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=$UNAME_VERSION.$UNAME_RELEASE + fi + GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV + ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` + then + GUESS=$SYSTEM_NAME + else + GUESS=rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + GUESS=rs6000-ibm-aix3.2.4 + else + GUESS=rs6000-ibm-aix3.2 + fi + ;; + *:AIX:*:[4567]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if test -x /usr/bin/lslpp ; then + IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | \ + awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` + else + IBM_REV=$UNAME_VERSION.$UNAME_RELEASE + fi + GUESS=$IBM_ARCH-ibm-aix$IBM_REV + ;; + *:AIX:*:*) + GUESS=rs6000-ibm-aix + ;; + ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) + GUESS=romp-ibm-bsd4.4 + ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to + ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + GUESS=rs6000-bull-bosx + ;; + DPX/2?00:B.O.S.:*:*) + GUESS=m68k-bull-sysv3 + ;; + 9000/[34]??:4.3bsd:1.*:*) + GUESS=m68k-hp-bsd + ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + GUESS=m68k-hp-bsd4.4 + ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` + case $UNAME_MACHINE in + 9000/31?) HP_ARCH=m68000 ;; + 9000/[34]??) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if test -x /usr/bin/getconf; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case $sc_cpu_version in + 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 + 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case $sc_kernel_bits in + 32) HP_ARCH=hppa2.0n ;; + 64) HP_ARCH=hppa2.0w ;; + '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 + esac ;; + esac + fi + if test "$HP_ARCH" = ""; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if test "$HP_ARCH" = hppa2.0w + then + set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | + grep -q __LP64__ + then + HP_ARCH=hppa2.0w + else + HP_ARCH=hppa64 + fi + fi + GUESS=$HP_ARCH-hp-hpux$HPUX_REV + ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` + GUESS=ia64-hp-hpux$HPUX_REV + ;; + 3050*:HI-UX:*:*) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && + { echo "$SYSTEM_NAME"; exit; } + GUESS=unknown-hitachi-hiuxwe2 + ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) + GUESS=hppa1.1-hp-bsd + ;; + 9000/8??:4.3bsd:*:*) + GUESS=hppa1.0-hp-bsd + ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + GUESS=hppa1.0-hp-mpeix + ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) + GUESS=hppa1.1-hp-osf + ;; + hp8??:OSF1:*:*) + GUESS=hppa1.0-hp-osf + ;; + i*86:OSF1:*:*) + if test -x /usr/sbin/sysversion ; then + GUESS=$UNAME_MACHINE-unknown-osf1mk + else + GUESS=$UNAME_MACHINE-unknown-osf1 + fi + ;; + parisc*:Lites*:*:*) + GUESS=hppa1.1-hp-lites + ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + GUESS=c1-convex-bsd + ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + GUESS=c34-convex-bsd + ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + GUESS=c38-convex-bsd + ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + GUESS=c4-convex-bsd + ;; + CRAY*Y-MP:*:*:*) + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=ymp-cray-unicos$CRAY_REL + ;; + CRAY*[A-Z]90:*:*:*) + echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=t90-cray-unicos$CRAY_REL + ;; + CRAY*T3E:*:*:*) + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=alphaev5-cray-unicosmk$CRAY_REL + ;; + CRAY*SV1:*:*:*) + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=sv1-cray-unicos$CRAY_REL + ;; + *:UNICOS/mp:*:*) + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=craynv-cray-unicosmp$CRAY_REL + ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` + FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` + FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` + GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} + ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` + FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` + GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} + ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE + ;; + sparc*:BSD/OS:*:*) + GUESS=sparc-unknown-bsdi$UNAME_RELEASE + ;; + *:BSD/OS:*:*) + GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE + ;; + arm:FreeBSD:*:*) + UNAME_PROCESSOR=`uname -p` + set_cc_for_build + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi + else + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf + fi + ;; + *:FreeBSD:*:*) + UNAME_PROCESSOR=`/usr/bin/uname -p` + case $UNAME_PROCESSOR in + amd64) + UNAME_PROCESSOR=x86_64 ;; + i386) + UNAME_PROCESSOR=i586 ;; + esac + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL + ;; + i*:CYGWIN*:*) + GUESS=$UNAME_MACHINE-pc-cygwin + ;; + *:MINGW64*:*) + GUESS=$UNAME_MACHINE-pc-mingw64 + ;; + *:MINGW*:*) + GUESS=$UNAME_MACHINE-pc-mingw32 + ;; + *:MSYS*:*) + GUESS=$UNAME_MACHINE-pc-msys + ;; + i*:PW*:*) + GUESS=$UNAME_MACHINE-pc-pw32 + ;; + *:SerenityOS:*:*) + GUESS=$UNAME_MACHINE-pc-serenity + ;; + *:Interix*:*) + case $UNAME_MACHINE in + x86) + GUESS=i586-pc-interix$UNAME_RELEASE + ;; + authenticamd | genuineintel | EM64T) + GUESS=x86_64-unknown-interix$UNAME_RELEASE + ;; + IA64) + GUESS=ia64-unknown-interix$UNAME_RELEASE + ;; + esac ;; + i*:UWIN*:*) + GUESS=$UNAME_MACHINE-pc-uwin + ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + GUESS=x86_64-pc-cygwin + ;; + prep*:SunOS:5.*:*) + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=powerpcle-unknown-solaris2$SUN_REL + ;; + *:GNU:*:*) + # the GNU system + GNU_ARCH=`echo "$UNAME_MACHINE" | sed -e 's,[-/].*$,,'` + GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's,/.*$,,'` + GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL + ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + GNU_SYS=`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"` + GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC + ;; + *:Minix:*:*) + GUESS=$UNAME_MACHINE-unknown-minix + ;; + aarch64:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC=gnulibc1 ; fi + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + arc:Linux:*:* | arceb:Linux:*:* | arc32:Linux:*:* | arc64:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + arm*:Linux:*:*) + set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi + else + GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf + fi + fi + ;; + avr32*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + cris:Linux:*:*) + GUESS=$UNAME_MACHINE-axis-linux-$LIBC + ;; + crisv32:Linux:*:*) + GUESS=$UNAME_MACHINE-axis-linux-$LIBC + ;; + e2k:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + frv:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + hexagon:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + i*86:Linux:*:*) + GUESS=$UNAME_MACHINE-pc-linux-$LIBC + ;; + ia64:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + k1om:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + m32r*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + m68*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + mips:Linux:*:* | mips64:Linux:*:*) + set_cc_for_build + IS_GLIBC=0 + test x"${LIBC}" = xgnu && IS_GLIBC=1 + sed 's/^ //' << EOF > "$dummy.c" + #undef CPU + #undef mips + #undef mipsel + #undef mips64 + #undef mips64el + #if ${IS_GLIBC} && defined(_ABI64) + LIBCABI=gnuabi64 + #else + #if ${IS_GLIBC} && defined(_ABIN32) + LIBCABI=gnuabin32 + #else + LIBCABI=${LIBC} + #endif + #endif + + #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa64r6 + #else + #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa32r6 + #else + #if defined(__mips64) + CPU=mips64 + #else + CPU=mips + #endif + #endif + #endif + + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + MIPS_ENDIAN=el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + MIPS_ENDIAN= + #else + MIPS_ENDIAN= + #endif + #endif +EOF + cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'` + eval "$cc_set_vars" + test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } + ;; + mips64el:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + openrisc*:Linux:*:*) + GUESS=or1k-unknown-linux-$LIBC + ;; + or32:Linux:*:* | or1k*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + padre:Linux:*:*) + GUESS=sparc-unknown-linux-$LIBC + ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + GUESS=hppa64-unknown-linux-$LIBC + ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;; + PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;; + *) GUESS=hppa-unknown-linux-$LIBC ;; + esac + ;; + ppc64:Linux:*:*) + GUESS=powerpc64-unknown-linux-$LIBC + ;; + ppc:Linux:*:*) + GUESS=powerpc-unknown-linux-$LIBC + ;; + ppc64le:Linux:*:*) + GUESS=powerpc64le-unknown-linux-$LIBC + ;; + ppcle:Linux:*:*) + GUESS=powerpcle-unknown-linux-$LIBC + ;; + riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + s390:Linux:*:* | s390x:Linux:*:*) + GUESS=$UNAME_MACHINE-ibm-linux-$LIBC + ;; + sh64*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + sh*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + tile*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + vax:Linux:*:*) + GUESS=$UNAME_MACHINE-dec-linux-$LIBC + ;; + x86_64:Linux:*:*) + set_cc_for_build + LIBCABI=$LIBC + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_X32 >/dev/null + then + LIBCABI=${LIBC}x32 + fi + fi + GUESS=$UNAME_MACHINE-pc-linux-$LIBCABI + ;; + xtensa*:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + GUESS=i386-sequent-sysv4 + ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION + ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + GUESS=$UNAME_MACHINE-pc-os2-emx + ;; + i*86:XTS-300:*:STOP) + GUESS=$UNAME_MACHINE-unknown-stop + ;; + i*86:atheos:*:*) + GUESS=$UNAME_MACHINE-unknown-atheos + ;; + i*86:syllable:*:*) + GUESS=$UNAME_MACHINE-pc-syllable + ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + GUESS=i386-unknown-lynxos$UNAME_RELEASE + ;; + i*86:*DOS:*:*) + GUESS=$UNAME_MACHINE-pc-msdosdjgpp + ;; + i*86:*:4.*:*) + UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL + else + GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL + fi + ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL + else + GUESS=$UNAME_MACHINE-pc-sysv32 + fi + ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configure will decide that + # this is a cross-build. + GUESS=i586-pc-msdosdjgpp + ;; + Intel:Mach:3*:*) + GUESS=i386-pc-mach3 + ;; + paragon:*:*:*) + GUESS=i860-intel-osf1 + ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4 + fi + ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + GUESS=m68010-convergent-sysv + ;; + mc68k:UNIX:SYSTEM5:3.51m) + GUESS=m68k-convergent-sysv + ;; + M680?0:D-NIX:5.3:*) + GUESS=m68k-diab-dnix + ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + GUESS=m68k-unknown-lynxos$UNAME_RELEASE + ;; + mc68030:UNIX_System_V:4.*:*) + GUESS=m68k-atari-sysv4 + ;; + TSUNAMI:LynxOS:2.*:*) + GUESS=sparc-unknown-lynxos$UNAME_RELEASE + ;; + rs6000:LynxOS:2.*:*) + GUESS=rs6000-unknown-lynxos$UNAME_RELEASE + ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + GUESS=powerpc-unknown-lynxos$UNAME_RELEASE + ;; + SM[BE]S:UNIX_SV:*:*) + GUESS=mips-dde-sysv$UNAME_RELEASE + ;; + RM*:ReliantUNIX-*:*:*) + GUESS=mips-sni-sysv4 + ;; + RM*:SINIX-*:*:*) + GUESS=mips-sni-sysv4 + ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + GUESS=$UNAME_MACHINE-sni-sysv4 + else + GUESS=ns32k-sni-sysv + fi + ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + GUESS=i586-unisys-sysv4 + ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + GUESS=hppa1.1-stratus-sysv4 + ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + GUESS=i860-stratus-sysv4 + ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + GUESS=$UNAME_MACHINE-stratus-vos + ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + GUESS=hppa1.1-stratus-vos + ;; + mc68*:A/UX:*:*) + GUESS=m68k-apple-aux$UNAME_RELEASE + ;; + news*:NEWS-OS:6*:*) + GUESS=mips-sony-newsos6 + ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if test -d /usr/nec; then + GUESS=mips-nec-sysv$UNAME_RELEASE + else + GUESS=mips-unknown-sysv$UNAME_RELEASE + fi + ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + GUESS=powerpc-be-beos + ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + GUESS=powerpc-apple-beos + ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + GUESS=i586-pc-beos + ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + GUESS=i586-pc-haiku + ;; + x86_64:Haiku:*:*) + GUESS=x86_64-unknown-haiku + ;; + SX-4:SUPER-UX:*:*) + GUESS=sx4-nec-superux$UNAME_RELEASE + ;; + SX-5:SUPER-UX:*:*) + GUESS=sx5-nec-superux$UNAME_RELEASE + ;; + SX-6:SUPER-UX:*:*) + GUESS=sx6-nec-superux$UNAME_RELEASE + ;; + SX-7:SUPER-UX:*:*) + GUESS=sx7-nec-superux$UNAME_RELEASE + ;; + SX-8:SUPER-UX:*:*) + GUESS=sx8-nec-superux$UNAME_RELEASE + ;; + SX-8R:SUPER-UX:*:*) + GUESS=sx8r-nec-superux$UNAME_RELEASE + ;; + SX-ACE:SUPER-UX:*:*) + GUESS=sxace-nec-superux$UNAME_RELEASE + ;; + Power*:Rhapsody:*:*) + GUESS=powerpc-apple-rhapsody$UNAME_RELEASE + ;; + *:Rhapsody:*:*) + GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE + ;; + arm64:Darwin:*:*) + GUESS=aarch64-apple-darwin$UNAME_RELEASE + ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + if command -v xcode-select > /dev/null 2> /dev/null && \ + ! xcode-select --print-path > /dev/null 2> /dev/null ; then + # Avoid executing cc if there is no toolchain installed as + # cc will be a stub that puts up a graphical alert + # prompting the user to install developer tools. + CC_FOR_BUILD=no_compiler_found + else + set_cc_for_build + fi + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc + if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_PPC >/dev/null + then + UNAME_PROCESSOR=powerpc + fi + elif test "$UNAME_PROCESSOR" = i386 ; then + # uname -m returns i386 or x86_64 + UNAME_PROCESSOR=$UNAME_MACHINE + fi + GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE + ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = x86; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE + ;; + *:QNX:*:4*) + GUESS=i386-pc-qnx + ;; + NEO-*:NONSTOP_KERNEL:*:*) + GUESS=neo-tandem-nsk$UNAME_RELEASE + ;; + NSE-*:NONSTOP_KERNEL:*:*) + GUESS=nse-tandem-nsk$UNAME_RELEASE + ;; + NSR-*:NONSTOP_KERNEL:*:*) + GUESS=nsr-tandem-nsk$UNAME_RELEASE + ;; + NSV-*:NONSTOP_KERNEL:*:*) + GUESS=nsv-tandem-nsk$UNAME_RELEASE + ;; + NSX-*:NONSTOP_KERNEL:*:*) + GUESS=nsx-tandem-nsk$UNAME_RELEASE + ;; + *:NonStop-UX:*:*) + GUESS=mips-compaq-nonstopux + ;; + BS2000:POSIX*:*:*) + GUESS=bs2000-siemens-sysv + ;; + DS/*:UNIX_System_V:*:*) + GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE + ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + if test "${cputype-}" = 386; then + UNAME_MACHINE=i386 + elif test "x${cputype-}" != x; then + UNAME_MACHINE=$cputype + fi + GUESS=$UNAME_MACHINE-unknown-plan9 + ;; + *:TOPS-10:*:*) + GUESS=pdp10-unknown-tops10 + ;; + *:TENEX:*:*) + GUESS=pdp10-unknown-tenex + ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + GUESS=pdp10-dec-tops20 + ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + GUESS=pdp10-xkl-tops20 + ;; + *:TOPS-20:*:*) + GUESS=pdp10-unknown-tops20 + ;; + *:ITS:*:*) + GUESS=pdp10-unknown-its + ;; + SEI:*:*:SEIUX) + GUESS=mips-sei-seiux$UNAME_RELEASE + ;; + *:DragonFly:*:*) + DRAGONFLY_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL + ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case $UNAME_MACHINE in + A*) GUESS=alpha-dec-vms ;; + I*) GUESS=ia64-dec-vms ;; + V*) GUESS=vax-dec-vms ;; + esac ;; + *:XENIX:*:SysV) + GUESS=i386-pc-xenix + ;; + i*86:skyos:*:*) + SKYOS_REL=`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'` + GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL + ;; + i*86:rdos:*:*) + GUESS=$UNAME_MACHINE-pc-rdos + ;; + i*86:Fiwix:*:*) + GUESS=$UNAME_MACHINE-pc-fiwix + ;; + *:AROS:*:*) + GUESS=$UNAME_MACHINE-unknown-aros + ;; + x86_64:VMkernel:*:*) + GUESS=$UNAME_MACHINE-unknown-esx + ;; + amd64:Isilon\ OneFS:*:*) + GUESS=x86_64-unknown-onefs + ;; + *:Unleashed:*:*) + GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE + ;; +esac + +# Do we have a guess based on uname results? +if test "x$GUESS" != x; then + echo "$GUESS" + exit +fi + +# No uname command or uname output not recognized. +set_cc_for_build +cat > "$dummy.c" < +#include +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#include +#if defined(_SIZE_T_) || defined(SIGLOST) +#include +#endif +#endif +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); +#endif + +#if defined (vax) +#if !defined (ultrix) +#include +#if defined (BSD) +#if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +#else +#if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#endif +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#else +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname un; + uname (&un); + printf ("vax-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("vax-dec-ultrix\n"); exit (0); +#endif +#endif +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname *un; + uname (&un); + printf ("mips-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("mips-dec-ultrix\n"); exit (0); +#endif +#endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. +test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } + +echo "$0: unable to guess system type" >&2 + +case $UNAME_MACHINE:$UNAME_SYSTEM in + mips:Linux | mips64:Linux) + # If we got here on MIPS GNU/Linux, output extra information. + cat >&2 <&2 <&2 </dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = "$UNAME_MACHINE" +UNAME_RELEASE = "$UNAME_RELEASE" +UNAME_SYSTEM = "$UNAME_SYSTEM" +UNAME_VERSION = "$UNAME_VERSION" +EOF +fi + +exit 1 + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/config.sub b/config.sub new file mode 100755 index 0000000..dba16e8 --- /dev/null +++ b/config.sub @@ -0,0 +1,1890 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright 1992-2022 Free Software Foundation, Inc. + +# shellcheck disable=SC2006,SC2268 # see below for rationale + +timestamp='2022-01-03' + +# This file 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 3 of the License, 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, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). + + +# Please send patches to . +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +# The "shellcheck disable" line above the timestamp inhibits complaints +# about features and limitations of the classic Bourne shell that were +# superseded or lifted in POSIX. However, this script identifies a wide +# variety of pre-POSIX systems that do not have POSIX shells at all, and +# even some reasonably current systems (Solaris 10 as case-in-point) still +# have a pre-POSIX /bin/sh. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS + +Canonicalize a configuration name. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.sub ($timestamp) + +Copyright 1992-2022 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo "$1" + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Split fields of configuration type +# shellcheck disable=SC2162 +saved_IFS=$IFS +IFS="-" read field1 field2 field3 field4 <&2 + exit 1 + ;; + *-*-*-*) + basic_machine=$field1-$field2 + basic_os=$field3-$field4 + ;; + *-*-*) + # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two + # parts + maybe_os=$field2-$field3 + case $maybe_os in + nto-qnx* | linux-* | uclinux-uclibc* \ + | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ + | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ + | storm-chaos* | os2-emx* | rtmk-nova*) + basic_machine=$field1 + basic_os=$maybe_os + ;; + android-linux) + basic_machine=$field1-unknown + basic_os=linux-android + ;; + *) + basic_machine=$field1-$field2 + basic_os=$field3 + ;; + esac + ;; + *-*) + # A lone config we happen to match not fitting any pattern + case $field1-$field2 in + decstation-3100) + basic_machine=mips-dec + basic_os= + ;; + *-*) + # Second component is usually, but not always the OS + case $field2 in + # Prevent following clause from handling this valid os + sun*os*) + basic_machine=$field1 + basic_os=$field2 + ;; + zephyr*) + basic_machine=$field1-unknown + basic_os=$field2 + ;; + # Manufacturers + dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ + | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ + | unicom* | ibm* | next | hp | isi* | apollo | altos* \ + | convergent* | ncr* | news | 32* | 3600* | 3100* \ + | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ + | ultra | tti* | harris | dolphin | highlevel | gould \ + | cbm | ns | masscomp | apple | axis | knuth | cray \ + | microblaze* | sim | cisco \ + | oki | wec | wrs | winbond) + basic_machine=$field1-$field2 + basic_os= + ;; + *) + basic_machine=$field1 + basic_os=$field2 + ;; + esac + ;; + esac + ;; + *) + # Convert single-component short-hands not valid as part of + # multi-component configurations. + case $field1 in + 386bsd) + basic_machine=i386-pc + basic_os=bsd + ;; + a29khif) + basic_machine=a29k-amd + basic_os=udi + ;; + adobe68k) + basic_machine=m68010-adobe + basic_os=scout + ;; + alliant) + basic_machine=fx80-alliant + basic_os= + ;; + altos | altos3068) + basic_machine=m68k-altos + basic_os= + ;; + am29k) + basic_machine=a29k-none + basic_os=bsd + ;; + amdahl) + basic_machine=580-amdahl + basic_os=sysv + ;; + amiga) + basic_machine=m68k-unknown + basic_os= + ;; + amigaos | amigados) + basic_machine=m68k-unknown + basic_os=amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + basic_os=sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + basic_os=sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + basic_os=bsd + ;; + aros) + basic_machine=i386-pc + basic_os=aros + ;; + aux) + basic_machine=m68k-apple + basic_os=aux + ;; + balance) + basic_machine=ns32k-sequent + basic_os=dynix + ;; + blackfin) + basic_machine=bfin-unknown + basic_os=linux + ;; + cegcc) + basic_machine=arm-unknown + basic_os=cegcc + ;; + convex-c1) + basic_machine=c1-convex + basic_os=bsd + ;; + convex-c2) + basic_machine=c2-convex + basic_os=bsd + ;; + convex-c32) + basic_machine=c32-convex + basic_os=bsd + ;; + convex-c34) + basic_machine=c34-convex + basic_os=bsd + ;; + convex-c38) + basic_machine=c38-convex + basic_os=bsd + ;; + cray) + basic_machine=j90-cray + basic_os=unicos + ;; + crds | unos) + basic_machine=m68k-crds + basic_os= + ;; + da30) + basic_machine=m68k-da30 + basic_os= + ;; + decstation | pmax | pmin | dec3100 | decstatn) + basic_machine=mips-dec + basic_os= + ;; + delta88) + basic_machine=m88k-motorola + basic_os=sysv3 + ;; + dicos) + basic_machine=i686-pc + basic_os=dicos + ;; + djgpp) + basic_machine=i586-pc + basic_os=msdosdjgpp + ;; + ebmon29k) + basic_machine=a29k-amd + basic_os=ebmon + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + basic_os=ose + ;; + gmicro) + basic_machine=tron-gmicro + basic_os=sysv + ;; + go32) + basic_machine=i386-pc + basic_os=go32 + ;; + h8300hms) + basic_machine=h8300-hitachi + basic_os=hms + ;; + h8300xray) + basic_machine=h8300-hitachi + basic_os=xray + ;; + h8500hms) + basic_machine=h8500-hitachi + basic_os=hms + ;; + harris) + basic_machine=m88k-harris + basic_os=sysv3 + ;; + hp300 | hp300hpux) + basic_machine=m68k-hp + basic_os=hpux + ;; + hp300bsd) + basic_machine=m68k-hp + basic_os=bsd + ;; + hppaosf) + basic_machine=hppa1.1-hp + basic_os=osf + ;; + hppro) + basic_machine=hppa1.1-hp + basic_os=proelf + ;; + i386mach) + basic_machine=i386-mach + basic_os=mach + ;; + isi68 | isi) + basic_machine=m68k-isi + basic_os=sysv + ;; + m68knommu) + basic_machine=m68k-unknown + basic_os=linux + ;; + magnum | m3230) + basic_machine=mips-mips + basic_os=sysv + ;; + merlin) + basic_machine=ns32k-utek + basic_os=sysv + ;; + mingw64) + basic_machine=x86_64-pc + basic_os=mingw64 + ;; + mingw32) + basic_machine=i686-pc + basic_os=mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + basic_os=mingw32ce + ;; + monitor) + basic_machine=m68k-rom68k + basic_os=coff + ;; + morphos) + basic_machine=powerpc-unknown + basic_os=morphos + ;; + moxiebox) + basic_machine=moxie-unknown + basic_os=moxiebox + ;; + msdos) + basic_machine=i386-pc + basic_os=msdos + ;; + msys) + basic_machine=i686-pc + basic_os=msys + ;; + mvs) + basic_machine=i370-ibm + basic_os=mvs + ;; + nacl) + basic_machine=le32-unknown + basic_os=nacl + ;; + ncr3000) + basic_machine=i486-ncr + basic_os=sysv4 + ;; + netbsd386) + basic_machine=i386-pc + basic_os=netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + basic_os=linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + basic_os=newsos + ;; + news1000) + basic_machine=m68030-sony + basic_os=newsos + ;; + necv70) + basic_machine=v70-nec + basic_os=sysv + ;; + nh3000) + basic_machine=m68k-harris + basic_os=cxux + ;; + nh[45]000) + basic_machine=m88k-harris + basic_os=cxux + ;; + nindy960) + basic_machine=i960-intel + basic_os=nindy + ;; + mon960) + basic_machine=i960-intel + basic_os=mon960 + ;; + nonstopux) + basic_machine=mips-compaq + basic_os=nonstopux + ;; + os400) + basic_machine=powerpc-ibm + basic_os=os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + basic_os=ose + ;; + os68k) + basic_machine=m68k-none + basic_os=os68k + ;; + paragon) + basic_machine=i860-intel + basic_os=osf + ;; + parisc) + basic_machine=hppa-unknown + basic_os=linux + ;; + psp) + basic_machine=mipsallegrexel-sony + basic_os=psp + ;; + pw32) + basic_machine=i586-unknown + basic_os=pw32 + ;; + rdos | rdos64) + basic_machine=x86_64-pc + basic_os=rdos + ;; + rdos32) + basic_machine=i386-pc + basic_os=rdos + ;; + rom68k) + basic_machine=m68k-rom68k + basic_os=coff + ;; + sa29200) + basic_machine=a29k-amd + basic_os=udi + ;; + sei) + basic_machine=mips-sei + basic_os=seiux + ;; + sequent) + basic_machine=i386-sequent + basic_os= + ;; + sps7) + basic_machine=m68k-bull + basic_os=sysv2 + ;; + st2000) + basic_machine=m68k-tandem + basic_os= + ;; + stratus) + basic_machine=i860-stratus + basic_os=sysv4 + ;; + sun2) + basic_machine=m68000-sun + basic_os= + ;; + sun2os3) + basic_machine=m68000-sun + basic_os=sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + basic_os=sunos4 + ;; + sun3) + basic_machine=m68k-sun + basic_os= + ;; + sun3os3) + basic_machine=m68k-sun + basic_os=sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + basic_os=sunos4 + ;; + sun4) + basic_machine=sparc-sun + basic_os= + ;; + sun4os3) + basic_machine=sparc-sun + basic_os=sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + basic_os=sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + basic_os=solaris2 + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + basic_os= + ;; + sv1) + basic_machine=sv1-cray + basic_os=unicos + ;; + symmetry) + basic_machine=i386-sequent + basic_os=dynix + ;; + t3e) + basic_machine=alphaev5-cray + basic_os=unicos + ;; + t90) + basic_machine=t90-cray + basic_os=unicos + ;; + toad1) + basic_machine=pdp10-xkl + basic_os=tops20 + ;; + tpf) + basic_machine=s390x-ibm + basic_os=tpf + ;; + udi29k) + basic_machine=a29k-amd + basic_os=udi + ;; + ultra3) + basic_machine=a29k-nyu + basic_os=sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + basic_os=none + ;; + vaxv) + basic_machine=vax-dec + basic_os=sysv + ;; + vms) + basic_machine=vax-dec + basic_os=vms + ;; + vsta) + basic_machine=i386-pc + basic_os=vsta + ;; + vxworks960) + basic_machine=i960-wrs + basic_os=vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + basic_os=vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + basic_os=vxworks + ;; + xbox) + basic_machine=i686-pc + basic_os=mingw32 + ;; + ymp) + basic_machine=ymp-cray + basic_os=unicos + ;; + *) + basic_machine=$1 + basic_os= + ;; + esac + ;; +esac + +# Decode 1-component or ad-hoc basic machines +case $basic_machine in + # Here we handle the default manufacturer of certain CPU types. It is in + # some cases the only manufacturer, in others, it is the most popular. + w89k) + cpu=hppa1.1 + vendor=winbond + ;; + op50n) + cpu=hppa1.1 + vendor=oki + ;; + op60c) + cpu=hppa1.1 + vendor=oki + ;; + ibm*) + cpu=i370 + vendor=ibm + ;; + orion105) + cpu=clipper + vendor=highlevel + ;; + mac | mpw | mac-mpw) + cpu=m68k + vendor=apple + ;; + pmac | pmac-mpw) + cpu=powerpc + vendor=apple + ;; + + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + cpu=m68000 + vendor=att + ;; + 3b*) + cpu=we32k + vendor=att + ;; + bluegene*) + cpu=powerpc + vendor=ibm + basic_os=cnk + ;; + decsystem10* | dec10*) + cpu=pdp10 + vendor=dec + basic_os=tops10 + ;; + decsystem20* | dec20*) + cpu=pdp10 + vendor=dec + basic_os=tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + cpu=m68k + vendor=motorola + ;; + dpx2*) + cpu=m68k + vendor=bull + basic_os=sysv3 + ;; + encore | umax | mmax) + cpu=ns32k + vendor=encore + ;; + elxsi) + cpu=elxsi + vendor=elxsi + basic_os=${basic_os:-bsd} + ;; + fx2800) + cpu=i860 + vendor=alliant + ;; + genix) + cpu=ns32k + vendor=ns + ;; + h3050r* | hiux*) + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + cpu=m68000 + vendor=hp + ;; + hp9k3[2-9][0-9]) + cpu=m68k + vendor=hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + i*86v32) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=sysv32 + ;; + i*86v4*) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=sysv4 + ;; + i*86v) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=sysv + ;; + i*86sol2) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=solaris2 + ;; + j90 | j90-cray) + cpu=j90 + vendor=cray + basic_os=${basic_os:-unicos} + ;; + iris | iris4d) + cpu=mips + vendor=sgi + case $basic_os in + irix*) + ;; + *) + basic_os=irix4 + ;; + esac + ;; + miniframe) + cpu=m68000 + vendor=convergent + ;; + *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) + cpu=m68k + vendor=atari + basic_os=mint + ;; + news-3600 | risc-news) + cpu=mips + vendor=sony + basic_os=newsos + ;; + next | m*-next) + cpu=m68k + vendor=next + case $basic_os in + openstep*) + ;; + nextstep*) + ;; + ns2*) + basic_os=nextstep2 + ;; + *) + basic_os=nextstep3 + ;; + esac + ;; + np1) + cpu=np1 + vendor=gould + ;; + op50n-* | op60c-*) + cpu=hppa1.1 + vendor=oki + basic_os=proelf + ;; + pa-hitachi) + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 + ;; + pbd) + cpu=sparc + vendor=tti + ;; + pbb) + cpu=m68k + vendor=tti + ;; + pc532) + cpu=ns32k + vendor=pc532 + ;; + pn) + cpu=pn + vendor=gould + ;; + power) + cpu=power + vendor=ibm + ;; + ps2) + cpu=i386 + vendor=ibm + ;; + rm[46]00) + cpu=mips + vendor=siemens + ;; + rtpc | rtpc-*) + cpu=romp + vendor=ibm + ;; + sde) + cpu=mipsisa32 + vendor=sde + basic_os=${basic_os:-elf} + ;; + simso-wrs) + cpu=sparclite + vendor=wrs + basic_os=vxworks + ;; + tower | tower-32) + cpu=m68k + vendor=ncr + ;; + vpp*|vx|vx-*) + cpu=f301 + vendor=fujitsu + ;; + w65) + cpu=w65 + vendor=wdc + ;; + w89k-*) + cpu=hppa1.1 + vendor=winbond + basic_os=proelf + ;; + none) + cpu=none + vendor=none + ;; + leon|leon[3-9]) + cpu=sparc + vendor=$basic_machine + ;; + leon-*|leon[3-9]-*) + cpu=sparc + vendor=`echo "$basic_machine" | sed 's/-.*//'` + ;; + + *-*) + # shellcheck disable=SC2162 + saved_IFS=$IFS + IFS="-" read cpu vendor <&2 + exit 1 + ;; + esac + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $vendor in + digital*) + vendor=dec + ;; + commodore*) + vendor=cbm + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if test x$basic_os != x +then + +# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just +# set os. +case $basic_os in + gnu/linux*) + kernel=linux + os=`echo "$basic_os" | sed -e 's|gnu/linux|gnu|'` + ;; + os2-emx) + kernel=os2 + os=`echo "$basic_os" | sed -e 's|os2-emx|emx|'` + ;; + nto-qnx*) + kernel=nto + os=`echo "$basic_os" | sed -e 's|nto-qnx|qnx|'` + ;; + *-*) + # shellcheck disable=SC2162 + saved_IFS=$IFS + IFS="-" read kernel os <&2 + exit 1 + ;; +esac + +# As a final step for OS-related things, validate the OS-kernel combination +# (given a valid OS), if there is a kernel. +case $kernel-$os in + linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \ + | linux-musl* | linux-relibc* | linux-uclibc* ) + ;; + uclinux-uclibc* ) + ;; + -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* ) + # These are just libc implementations, not actual OSes, and thus + # require a kernel. + echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2 + exit 1 + ;; + kfreebsd*-gnu* | kopensolaris*-gnu*) + ;; + vxworks-simlinux | vxworks-simwindows | vxworks-spe) + ;; + nto-qnx*) + ;; + os2-emx) + ;; + *-eabi* | *-gnueabi*) + ;; + -*) + # Blank kernel with real OS is always fine. + ;; + *-*) + echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2 + exit 1 + ;; +esac + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +case $vendor in + unknown) + case $cpu-$os in + *-riscix*) + vendor=acorn + ;; + *-sunos*) + vendor=sun + ;; + *-cnk* | *-aix*) + vendor=ibm + ;; + *-beos*) + vendor=be + ;; + *-hpux*) + vendor=hp + ;; + *-mpeix*) + vendor=hp + ;; + *-hiux*) + vendor=hitachi + ;; + *-unos*) + vendor=crds + ;; + *-dgux*) + vendor=dg + ;; + *-luna*) + vendor=omron + ;; + *-genix*) + vendor=ns + ;; + *-clix*) + vendor=intergraph + ;; + *-mvs* | *-opened*) + vendor=ibm + ;; + *-os400*) + vendor=ibm + ;; + s390-* | s390x-*) + vendor=ibm + ;; + *-ptx*) + vendor=sequent + ;; + *-tpf*) + vendor=ibm + ;; + *-vxsim* | *-vxworks* | *-windiss*) + vendor=wrs + ;; + *-aux*) + vendor=apple + ;; + *-hms*) + vendor=hitachi + ;; + *-mpw* | *-macos*) + vendor=apple + ;; + *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*) + vendor=atari + ;; + *-vos*) + vendor=stratus + ;; + esac + ;; +esac + +echo "$cpu-$vendor-${kernel:+$kernel-}$os" +exit + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/configure b/configure new file mode 100755 index 0000000..0691b68 --- /dev/null +++ b/configure @@ -0,0 +1,11102 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.71. +# +# +# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +as_nop=: +if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else $as_nop + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + + +# Reset variables that may have inherited troublesome values from +# the environment. + +# IFS needs to be set, to space, tab, and newline, in precisely that order. +# (If _AS_PATH_WALK were called with IFS unset, it would have the +# side effect of setting IFS to empty, thus disabling word splitting.) +# Quoting is to prevent editors from complaining about space-tab. +as_nl=' +' +export as_nl +IFS=" "" $as_nl" + +PS1='$ ' +PS2='> ' +PS4='+ ' + +# Ensure predictable behavior from utilities with locale-dependent output. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# We cannot yet rely on "unset" to work, but we need these variables +# to be unset--not just set to an empty or harmless value--now, to +# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct +# also avoids known problems related to "unset" and subshell syntax +# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). +for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH +do eval test \${$as_var+y} \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done + +# Ensure that fds 0, 1, and 2 are open. +if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi +if (exec 3>&2) ; then :; else exec 2>/dev/null; fi + +# The user is always right. +if ${PATH_SEPARATOR+false} :; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + test -r "$as_dir$0" && as_myself=$as_dir$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="as_nop=: +if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else \$as_nop + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ) +then : + +else \$as_nop + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +blah=\$(echo \$(echo blah)) +test x\"\$blah\" = xblah || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null +then : + as_have_required=yes +else $as_nop + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null +then : + +else $as_nop + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null +then : + CONFIG_SHELL=$as_shell as_have_required=yes + if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null +then : + break 2 +fi +fi + done;; + esac + as_found=false +done +IFS=$as_save_IFS +if $as_found +then : + +else $as_nop + if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null +then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi +fi + + + if test "x$CONFIG_SHELL" != x +then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno +then : + printf "%s\n" "$0: This script requires a shell more modern than all" + printf "%s\n" "$0: the shells that I found on your system." + if test ${ZSH_VERSION+y} ; then + printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" + printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." + else + printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit +# as_fn_nop +# --------- +# Do nothing but, unlike ":", preserve the value of $?. +as_fn_nop () +{ + return $? +} +as_nop=as_fn_nop + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null +then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else $as_nop + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null +then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else $as_nop + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + +# as_fn_nop +# --------- +# Do nothing but, unlike ":", preserve the value of $?. +as_fn_nop () +{ + return $? +} +as_nop=as_fn_nop + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + printf "%s\n" "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +# Determine whether it's possible to make 'echo' print without a newline. +# These variables are no longer used directly by Autoconf, but are AC_SUBSTed +# for compatibility with existing Makefiles. +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +# For backward compatibility with old third-party macros, we provide +# the shell variables $as_echo and $as_echo_n. New code should use +# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. +as_echo='printf %s\n' +as_echo_n='printf %s' + + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='' +PACKAGE_TARNAME='' +PACKAGE_VERSION='' +PACKAGE_STRING='' +PACKAGE_BUGREPORT='' +PACKAGE_URL='' + +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_STDIO_H +# include +#endif +#ifdef HAVE_STDLIB_H +# include +#endif +#ifdef HAVE_STRING_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_header_c_list= +ac_subst_vars='LTLIBOBJS +LIBOBJS +use +GNU_LD +LEADING_UNDERSCORE +EXTRA_LOBJS +O2FLAGS +O3FLAGS +NIFLAGS +FINAL_CFLAGS +ALLOCA +NOTIFY +TCL_LIBS +TCL_DL_LIBS +TCL_LIB_SPEC +TK_XLIBSW +TK_BUILD_LIB_SPEC +TK_LIB_SPEC +TCL_INCLUDE +TK_INCLUDE +TK_XINCLUDES +TCL_LIBRARY +TK_LIBRARY +TK_CONFIG_PREFIX +TCLSH +INFO_DIR +EMACS_DEFAULT_EL +EMACS_SITE_LISP +EMACS +HAVE_SIGEMT +HAVE_SIGSYS +HAVE_SV_ONSTACK +USE_CLEANUP +HAVE_PUTENV +HAVE_SETENV +NO_PROFILE +RL_LIB +RL_OBJS +EGREP +GREP +CLSTANDARD +SYSTEM +FLISP +HAVE_LONG_LONG +PAGEWIDTH +DOUBLE_BIGENDIAN +WORDS_BIGENDIAN +LIBIBERTY +LIBBFD +BUILD_BFD +HAVE_OUTPUT_BFD +X_CFLAGS +X_LIBS +XMKMF +GMPDIR +GMP +HAVE_MALLOC_ZONE_MEMALIGN +MAKEINFO +GCL_CC +AWK +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +PRELINK_CHECK +host_os +host_vendor +host_cpu +host +build_os +build_vendor +build_cpu +build +VERSION +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +runstatedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +enable_machine +enable_widecons +enable_safecdr +enable_safecdrdbg +enable_prelink +enable_vssize +enable_bdssize +enable_ihssize +enable_frssize +enable_infodir +enable_emacsdir +enable_xgcl +enable_dlopen +enable_statsysbfd +enable_dynsysbfd +enable_custreloc +enable_debug +enable_static +enable_pic +enable_gprof +enable_dynsysgmp +with_x +enable_xdr +enable_cstackmax +enable_immfix +enable_fastimmfix +enable_ansi +enable_japi +enable_readline +enable_tcltk +enable_tkconfig +enable_tclconfig +enable_notify +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP +XMKMF' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir runstatedir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +X features: + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs + --enable-widecons will use a three word cons with simplified typing + --enable-safecdr will protect cdr from immfix and speed up type processing + --enable-safecdrdbg will debug safecdr code + --enable-prelink will insist that the produced images may be prelinked + --enable-vssize=XXXX will compile in a value stack of size XXX + --enable-bdssize=XXXX will compile in a binding stack of size XXX + --enable-ihssize=XXXX will compile in a invocation history stack of size XXX + --enable-frssize=XXXX will compile in a frame stack of size XXX + --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info + --enable-emacsdir=XXXX will manually specify the location for elisp files + --enable-xgcl=yes will compile in support for XGCL + --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images + --enable-statsysbfd uses a static system bfd library for loading and relocating object files + --enable-dynsysbfd uses a dynamic shared system bfd library for loading and relocating object files + --enable-custreloc uses custom gcl code if available for loading and relocationing object files + --enable-debug builds gcl with -g in CFLAGS to enable running under gdb + --enable-static will link your GCL against static as opposed to shared system libraries + --enable-pic builds gcl with -fPIC in CFLAGS + --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof + --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source + --enable-xdr=yes will compile in support for XDR + --enable-cstackmax=xxxx will ensure that the cstack begins below xxxx or fail + --enable-immfix will enable an immediate fixnum table above the C stack + --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained + --enable-ansi builds a large gcl aiming for ansi compliance + --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system + --enable-readline enables command line completion via the readline library + --enable-tcltk will try to build gcl-tk + --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh + --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh + --enable-notify=no will disable the automatic notification of gcl maintainers of successful builds/problems + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-x use the X Window System + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + XMKMF Path to xmkmf, Makefile generator for X Window System + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for configure.gnu first; this name is used for a wrapper for + # Metaconfig's "Configure" on case-insensitive file systems. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +configure +generated by GNU Autoconf 2.71 + +Copyright (C) 2021 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest.beam + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + } +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that +# executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; } +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: program exited with status $ac_status" >&5 + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +printf %s "checking for $2... " >&6; } +if eval test \${$3+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + eval "$3=yes" +else $as_nop + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +eval ac_res=\$$3 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES +# ---------------------------------------------------- +# Tries to find if the field MEMBER exists in type AGGR, after including +# INCLUDES, setting cache variable VAR accordingly. +ac_fn_c_check_member () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 +printf %s "checking for $2.$3... " >&6; } +if eval test \${$4+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +int +main (void) +{ +static $2 ac_aggr; +if (ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + eval "$4=yes" +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +int +main (void) +{ +static $2 ac_aggr; +if (sizeof ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + eval "$4=yes" +else $as_nop + eval "$4=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +eval ac_res=\$$4 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_member + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + } +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +printf %s "checking for $2... " >&6; } +if eval test \${$3+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. */ + +#include +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main (void) +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + eval "$3=yes" +else $as_nop + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func + +# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES +# -------------------------------------------- +# Tries to find the compile-time value of EXPR in a program that includes +# INCLUDES, setting VAR accordingly. Returns whether the value could be +# computed +ac_fn_c_compute_int () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main (void) +{ +static int test_array [1 - 2 * !(($2) >= 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_lo=0 ac_mid=0 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main (void) +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_hi=$ac_mid; break +else $as_nop + as_fn_arith $ac_mid + 1 && ac_lo=$as_val + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + done +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main (void) +{ +static int test_array [1 - 2 * !(($2) < 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_hi=-1 ac_mid=-1 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main (void) +{ +static int test_array [1 - 2 * !(($2) >= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_lo=$ac_mid; break +else $as_nop + as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + done +else $as_nop + ac_lo= ac_hi= +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main (void) +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_hi=$ac_mid +else $as_nop + as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +done +case $ac_lo in #(( +?*) eval "$3=\$ac_lo"; ac_retval=0 ;; +'') ac_retval=1 ;; +esac + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +static long int longval (void) { return $2; } +static unsigned long int ulongval (void) { return $2; } +#include +#include +int +main (void) +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + return 1; + if (($2) < 0) + { + long int i = longval (); + if (i != ($2)) + return 1; + fprintf (f, "%ld", i); + } + else + { + unsigned long int i = ulongval (); + if (i != ($2)) + return 1; + fprintf (f, "%lu", i); + } + /* Do not output a trailing newline, as this causes \r\n confusion + on some platforms. */ + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + echo >>conftest.val; read $3 &5 +printf %s "checking for $2... " >&6; } +if eval test \${$3+y} +then : + printf %s "(cached) " >&6 +else $as_nop + eval "$3=no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main (void) +{ +if (sizeof ($2)) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main (void) +{ +if (sizeof (($2))) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +else $as_nop + eval "$3=yes" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +eval ac_res=\$$3 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_type +ac_configure_args_raw= +for ac_arg +do + case $ac_arg in + *\'*) + ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append ac_configure_args_raw " '$ac_arg'" +done + +case $ac_configure_args_raw in + *$as_nl*) + ac_safe_unquote= ;; + *) + ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. + ac_unsafe_a="$ac_unsafe_z#~" + ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" + ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; +esac + +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.71. Invocation command line was + + $ $0$ac_configure_args_raw + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + printf "%s\n" "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Sanitize IFS. + IFS=" "" $as_nl" + # Save into config.log some information that might help in debugging. + { + echo + + printf "%s\n" "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + printf "%s\n" "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + printf "%s\n" "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + printf "%s\n" "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + printf "%s\n" "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + printf "%s\n" "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + printf "%s\n" "$as_me: caught signal $ac_signal" + printf "%s\n" "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +printf "%s\n" "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +if test -n "$CONFIG_SITE"; then + ac_site_files="$CONFIG_SITE" +elif test "x$prefix" != xNONE; then + ac_site_files="$prefix/share/config.site $prefix/etc/config.site" +else + ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" +fi + +for ac_site_file in $ac_site_files +do + case $ac_site_file in #( + */*) : + ;; #( + *) : + ac_site_file=./$ac_site_file ;; +esac + if test -f "$ac_site_file" && test -r "$ac_site_file"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +printf "%s\n" "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +printf "%s\n" "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Test code for whether the C compiler supports C89 (global declarations) +ac_c_conftest_c89_globals=' +/* Does the compiler advertise C89 conformance? + Do not test the value of __STDC__, because some compilers set it to 0 + while being otherwise adequately conformant. */ +#if !defined __STDC__ +# error "Compiler does not advertise C89 conformance" +#endif + +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ +struct buf { int x; }; +struct buf * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not \xHH hex character constants. + These do not provoke an error unfortunately, instead are silently treated + as an "x". The following induces an error, until -std is added to get + proper ANSI mode. Curiously \x00 != x always comes out true, for an + array size at least. It is necessary to write \x00 == 0 to get something + that is true only with -std. */ +int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) '\''x'\'' +int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), + int, int);' + +# Test code for whether the C compiler supports C89 (body of main). +ac_c_conftest_c89_main=' +ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); +' + +# Test code for whether the C compiler supports C99 (global declarations) +ac_c_conftest_c99_globals=' +// Does the compiler advertise C99 conformance? +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L +# error "Compiler does not advertise C99 conformance" +#endif + +#include +extern int puts (const char *); +extern int printf (const char *, ...); +extern int dprintf (int, const char *, ...); +extern void *malloc (size_t); + +// Check varargs macros. These examples are taken from C99 6.10.3.5. +// dprintf is used instead of fprintf to avoid needing to declare +// FILE and stderr. +#define debug(...) dprintf (2, __VA_ARGS__) +#define showlist(...) puts (#__VA_ARGS__) +#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) +static void +test_varargs_macros (void) +{ + int x = 1234; + int y = 5678; + debug ("Flag"); + debug ("X = %d\n", x); + showlist (The first, second, and third items.); + report (x>y, "x is %d but y is %d", x, y); +} + +// Check long long types. +#define BIG64 18446744073709551615ull +#define BIG32 4294967295ul +#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) +#if !BIG_OK + #error "your preprocessor is broken" +#endif +#if BIG_OK +#else + #error "your preprocessor is broken" +#endif +static long long int bignum = -9223372036854775807LL; +static unsigned long long int ubignum = BIG64; + +struct incomplete_array +{ + int datasize; + double data[]; +}; + +struct named_init { + int number; + const wchar_t *name; + double average; +}; + +typedef const char *ccp; + +static inline int +test_restrict (ccp restrict text) +{ + // See if C++-style comments work. + // Iterate through items via the restricted pointer. + // Also check for declarations in for loops. + for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) + continue; + return 0; +} + +// Check varargs and va_copy. +static bool +test_varargs (const char *format, ...) +{ + va_list args; + va_start (args, format); + va_list args_copy; + va_copy (args_copy, args); + + const char *str = ""; + int number = 0; + float fnumber = 0; + + while (*format) + { + switch (*format++) + { + case '\''s'\'': // string + str = va_arg (args_copy, const char *); + break; + case '\''d'\'': // int + number = va_arg (args_copy, int); + break; + case '\''f'\'': // float + fnumber = va_arg (args_copy, double); + break; + default: + break; + } + } + va_end (args_copy); + va_end (args); + + return *str && number && fnumber; +} +' + +# Test code for whether the C compiler supports C99 (body of main). +ac_c_conftest_c99_main=' + // Check bool. + _Bool success = false; + success |= (argc != 0); + + // Check restrict. + if (test_restrict ("String literal") == 0) + success = true; + char *restrict newvar = "Another string"; + + // Check varargs. + success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); + test_varargs_macros (); + + // Check flexible array members. + struct incomplete_array *ia = + malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); + ia->datasize = 10; + for (int i = 0; i < ia->datasize; ++i) + ia->data[i] = i * 1.234; + + // Check named initializers. + struct named_init ni = { + .number = 34, + .name = L"Test wide string", + .average = 543.34343, + }; + + ni.number = 58; + + int dynamic_array[ni.number]; + dynamic_array[0] = argv[0][0]; + dynamic_array[ni.number - 1] = 543; + + // work around unused variable warnings + ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' + || dynamic_array[ni.number - 1] != 543); +' + +# Test code for whether the C compiler supports C11 (global declarations) +ac_c_conftest_c11_globals=' +// Does the compiler advertise C11 conformance? +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L +# error "Compiler does not advertise C11 conformance" +#endif + +// Check _Alignas. +char _Alignas (double) aligned_as_double; +char _Alignas (0) no_special_alignment; +extern char aligned_as_int; +char _Alignas (0) _Alignas (int) aligned_as_int; + +// Check _Alignof. +enum +{ + int_alignment = _Alignof (int), + int_array_alignment = _Alignof (int[100]), + char_alignment = _Alignof (char) +}; +_Static_assert (0 < -_Alignof (int), "_Alignof is signed"); + +// Check _Noreturn. +int _Noreturn does_not_return (void) { for (;;) continue; } + +// Check _Static_assert. +struct test_static_assert +{ + int x; + _Static_assert (sizeof (int) <= sizeof (long int), + "_Static_assert does not work in struct"); + long int y; +}; + +// Check UTF-8 literals. +#define u8 syntax error! +char const utf8_literal[] = u8"happens to be ASCII" "another string"; + +// Check duplicate typedefs. +typedef long *long_ptr; +typedef long int *long_ptr; +typedef long_ptr long_ptr; + +// Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. +struct anonymous +{ + union { + struct { int i; int j; }; + struct { int k; long int l; } w; + }; + int m; +} v1; +' + +# Test code for whether the C compiler supports C11 (body of main). +ac_c_conftest_c11_main=' + _Static_assert ((offsetof (struct anonymous, i) + == offsetof (struct anonymous, w.k)), + "Anonymous union alignment botch"); + v1.i = 2; + v1.w.k = 5; + ok |= v1.i != 5; +' + +# Test code for whether the C compiler supports C11 (complete). +ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} +${ac_c_conftest_c99_globals} +${ac_c_conftest_c11_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + ${ac_c_conftest_c99_main} + ${ac_c_conftest_c11_main} + return ok; +} +" + +# Test code for whether the C compiler supports C99 (complete). +ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} +${ac_c_conftest_c99_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + ${ac_c_conftest_c99_main} + return ok; +} +" + +# Test code for whether the C compiler supports C89 (complete). +ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + return ok; +} +" + +as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H" +as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H" +as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H" +as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H" +as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H" +as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H" +as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H" +as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H" +as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H" + +# Auxiliary files required by this configure script. +ac_aux_files="config.guess config.sub" + +# Locations in which to look for auxiliary files. +ac_aux_dir_candidates="${srcdir}${PATH_SEPARATOR}${srcdir}/..${PATH_SEPARATOR}${srcdir}/../.." + +# Search for a directory containing all of the required auxiliary files, +# $ac_aux_files, from the $PATH-style list $ac_aux_dir_candidates. +# If we don't find one directory that contains all the files we need, +# we report the set of missing files from the *first* directory in +# $ac_aux_dir_candidates and give up. +ac_missing_aux_files="" +ac_first_candidate=: +printf "%s\n" "$as_me:${as_lineno-$LINENO}: looking for aux files: $ac_aux_files" >&5 +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in $ac_aux_dir_candidates +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + as_found=: + + printf "%s\n" "$as_me:${as_lineno-$LINENO}: trying $as_dir" >&5 + ac_aux_dir_found=yes + ac_install_sh= + for ac_aux in $ac_aux_files + do + # As a special case, if "install-sh" is required, that requirement + # can be satisfied by any of "install-sh", "install.sh", or "shtool", + # and $ac_install_sh is set appropriately for whichever one is found. + if test x"$ac_aux" = x"install-sh" + then + if test -f "${as_dir}install-sh"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}install-sh found" >&5 + ac_install_sh="${as_dir}install-sh -c" + elif test -f "${as_dir}install.sh"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}install.sh found" >&5 + ac_install_sh="${as_dir}install.sh -c" + elif test -f "${as_dir}shtool"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}shtool found" >&5 + ac_install_sh="${as_dir}shtool install -c" + else + ac_aux_dir_found=no + if $ac_first_candidate; then + ac_missing_aux_files="${ac_missing_aux_files} install-sh" + else + break + fi + fi + else + if test -f "${as_dir}${ac_aux}"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}${ac_aux} found" >&5 + else + ac_aux_dir_found=no + if $ac_first_candidate; then + ac_missing_aux_files="${ac_missing_aux_files} ${ac_aux}" + else + break + fi + fi + fi + done + if test "$ac_aux_dir_found" = yes; then + ac_aux_dir="$as_dir" + break + fi + ac_first_candidate=false + + as_found=false +done +IFS=$as_save_IFS +if $as_found +then : + +else $as_nop + as_fn_error $? "cannot find required auxiliary files:$ac_missing_aux_files" "$LINENO" 5 +fi + + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +if test -f "${ac_aux_dir}config.guess"; then + ac_config_guess="$SHELL ${ac_aux_dir}config.guess" +fi +if test -f "${ac_aux_dir}config.sub"; then + ac_config_sub="$SHELL ${ac_aux_dir}config.sub" +fi +if test -f "$ac_aux_dir/configure"; then + ac_configure="$SHELL ${ac_aux_dir}configure" +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' + and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +ac_config_headers="$ac_config_headers h/gclincl.h" + + +VERSION=`cat majvers`.`cat minvers` + + + +# +# Host information +# + + + + + + # Make sure we can run config.sub. +$SHELL "${ac_aux_dir}config.sub" sun4 >/dev/null 2>&1 || + as_fn_error $? "cannot run $SHELL ${ac_aux_dir}config.sub" "$LINENO" 5 + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +printf %s "checking build system type... " >&6; } +if test ${ac_cv_build+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "${ac_aux_dir}config.guess"` +test "x$ac_build_alias" = x && + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "${ac_aux_dir}config.sub" $ac_build_alias` || + as_fn_error $? "$SHELL ${ac_aux_dir}config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +printf "%s\n" "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +printf %s "checking host system type... " >&6; } +if test ${ac_cv_host+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "${ac_aux_dir}config.sub" $host_alias` || + as_fn_error $? "$SHELL ${ac_aux_dir}config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +printf "%s\n" "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +canonical=$host +my_host_kernel=`echo $host_os | awk '{j=split($1,A,"-");print A[1]}'` +my_host_system=`echo $host_os | awk '{j=split($1,A,"-");if (j>=2) print A[2]}'` + +cat >>confdefs.h <<_ACEOF +#define HOST_CPU "`echo $host_cpu | awk '{print toupper($0)}'`" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define HOST_KERNEL "`echo $my_host_kernel | awk '{print toupper($0)}'`" +_ACEOF + +if test "$my_host_system" != "" ; then + +cat >>confdefs.h <<_ACEOF +#define HOST_SYSTEM "`echo $my_host_system | awk '{print toupper($0)}'`" +_ACEOF + +fi +## host=CPU-COMPANY-SYSTEM +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: host=$host" >&5 +printf "%s\n" "host=$host" >&6; } + +use=unknown +case $canonical in + sh4*linux*) use=sh4-linux;; + *x86_64*linux*) use=amd64-linux;; + *x86_64*kfreebsd*) use=amd64-kfreebsd;; + *86*linux*) use=386-linux;; + *riscv64*linux*) use=riscv64-linux;; + *86*kfreebsd*) use=386-kfreebsd;; + *86*gnu*) use=386-gnu;; + m68k*linux*) use=m68k-linux;; + alpha*linux*) use=alpha-linux;; + mips*linux*) use=mips-linux;; + mipsel*linux*) use=mipsel-linux;; + sparc*linux*) use=sparc-linux;; + aarch64*linux*) use=aarch64-linux;; + arm*linux*hf) use=armhf-linux;; + arm*linux*) use=arm-linux;; + s390*linux*) use=s390-linux;; + ia64*linux*) use=ia64-linux;; + hppa*linux*) use=hppa-linux;; + powerpc*linux*) use=powerpc-linux;; + powerpc-*-darwin*) use=powerpc-macosx;; + *86*darwin*) use=386-macosx;; + i*mingw*|i*msys*) use=mingw;; + *cygwin*) + if $CC -v 2>&1 | fgrep ming > /dev/null ; + then use=mingw + else use=gnuwin95 + fi;; + *openbsd*) use=FreeBSD;; + sparc-sun-solaris*) use=solaris;; + i?86-pc-solaris*) use=solaris-i386;; +esac + +# Check whether --enable-machine was given. +if test ${enable_machine+y} +then : + enableval=$enable_machine; echo enable_machine=$enableval ; use=$enableval +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 +printf "%s\n" "use=$use" >&6; } + +def_dlopen="no" +def_statsysbfd="no" +def_custreloc="yes" +def_oldgmp="no" +def_pic="no"; +def_static="no"; +def_debug="no"; +case $use in + *kfreebsd) + ln -snf linux.defs h/$use.defs;; + *gnu) + ln -snf linux.defs h/$use.defs;; + *linux) + ln -snf linux.defs h/$use.defs; + case $use in + ia64*) + def_dlopen="yes" ; def_custreloc="no" ;; + hppa*) + def_pic="yes" ;; + esac;; +esac + +# Check whether --enable-widecons was given. +if test ${enable_widecons+y} +then : + enableval=$enable_widecons; if test "$enableval" = "yes" ; then +printf "%s\n" "#define WIDE_CONS 1" >>confdefs.h + fi +fi + + +# Check whether --enable-safecdr was given. +if test ${enable_safecdr+y} +then : + enableval=$enable_safecdr; if test "$enableval" = "yes" ; then + +printf "%s\n" "#define USE_SAFE_CDR 1" >>confdefs.h + + # Check whether --enable-safecdrdbg was given. +if test ${enable_safecdrdbg+y} +then : + enableval=$enable_safecdrdbg; if test "$enableval" = "yes" ; then +printf "%s\n" "#define DEBUG_SAFE_CDR 1" >>confdefs.h + fi +fi + + fi +fi + + +# Check whether --enable-prelink was given. +if test ${enable_prelink+y} +then : + enableval=$enable_prelink; if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi +fi + + + +# Check whether --enable-vssize was given. +if test ${enable_vssize+y} +then : + enableval=$enable_vssize; +printf "%s\n" "#define VSSIZE $enableval" >>confdefs.h + +fi + +# Check whether --enable-bdssize was given. +if test ${enable_bdssize+y} +then : + enableval=$enable_bdssize; +printf "%s\n" "#define BDSSIZE $enableval" >>confdefs.h + +fi + +# Check whether --enable-ihssize was given. +if test ${enable_ihssize+y} +then : + enableval=$enable_ihssize; +printf "%s\n" "#define IHSSIZE $enableval" >>confdefs.h + +fi + +# Check whether --enable-frssize was given. +if test ${enable_frssize+y} +then : + enableval=$enable_frssize; +printf "%s\n" "#define FRSSIZE $enableval" >>confdefs.h + +fi + + +# Check whether --enable-infodir was given. +if test ${enable_infodir+y} +then : + enableval=$enable_infodir; INFO_DIR=$enableval +else $as_nop + INFO_DIR=$prefix/share/info +fi + +INFO_DIR=`eval echo $INFO_DIR/` + +# Check whether --enable-emacsdir was given. +if test ${enable_emacsdir+y} +then : + enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval +else $as_nop + EMACS_SITE_LISP=$prefix/share/emacs/site-lisp +fi + +EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` + +# Check whether --enable-xgcl was given. +if test ${enable_xgcl+y} +then : + enableval=$enable_xgcl; +else $as_nop + enable_xgcl=yes +fi + + +# Check whether --enable-dlopen was given. +if test ${enable_dlopen+y} +then : + enableval=$enable_dlopen; +else $as_nop + enable_dlopen=$def_dlopen +fi + +# Check whether --enable-statsysbfd was given. +if test ${enable_statsysbfd+y} +then : + enableval=$enable_statsysbfd; +else $as_nop + enable_statsysbfd=$def_statsysbfd +fi + +# Check whether --enable-dynsysbfd was given. +if test ${enable_dynsysbfd+y} +then : + enableval=$enable_dynsysbfd; +else $as_nop + enable_dynsysbfd=no +fi + +# Check whether --enable-custreloc was given. +if test ${enable_custreloc+y} +then : + enableval=$enable_custreloc; +else $as_nop + enable_custreloc=$def_custreloc +fi + + +# Check whether --enable-debug was given. +if test ${enable_debug+y} +then : + enableval=$enable_debug; +else $as_nop + enable_debug=$def_debug +fi + +# Check whether --enable-static was given. +if test ${enable_static+y} +then : + enableval=$enable_static; +else $as_nop + enable_static=$def_static +fi + +# Check whether --enable-pic was given. +if test ${enable_pic+y} +then : + enableval=$enable_pic; +else $as_nop + enable_pic=$def_pic +fi + + +load_opt=0 +if test "$enable_dlopen" = "yes" ; then + load_opt=1 +fi +if test "$enable_statsysbfd" = "yes" ; then + case $load_opt in + 0) load_opt=1;; + 1) load_opt=2;; + esac +fi +if test "$enable_dynsysbfd" = "yes" ; then + case $load_opt in + 0) load_opt=1;; + 1) load_opt=2;; + 2) load_opt=3;; + esac +fi +if test "$enable_custreloc" = "yes" ; then + case $load_opt in + 0) load_opt=1;; + 1) load_opt=2;; + 2) load_opt=3;; + 3) load_opt=4;; + 4) load_opt=5;; + esac +fi + +if test "$load_opt" != "1" ; then + echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" + as_fn_error $? "loader option failure" "$LINENO" 5 +fi + + +# +# System programs +# + +# We set the default CFLAGS below, and don't want the autoconf default +# CM 20040106 +if test "$CFLAGS" = "" ; then + CFLAGS=" " +fi +if test "$LDFLAGS" = "" ; then + LDFLAGS=" " +fi + + + + + + + + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. +set dummy ${ac_tool_prefix}clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "clang", so it can be a program name with args. +set dummy clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +fi + + +test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion -version; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +printf %s "checking whether the C compiler works... " >&6; } +ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else $as_nop + ac_file='' +fi +if test -z "$ac_file" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +printf %s "checking for C compiler default output file name... " >&6; } +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +printf "%s\n" "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +printf %s "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else $as_nop + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +printf "%s\n" "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +printf %s "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +printf "%s\n" "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +printf %s "checking for suffix of object files... " >&6; } +if test ${ac_cv_objext+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +printf "%s\n" "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 +printf %s "checking whether the compiler supports GNU C... " >&6; } +if test ${ac_cv_c_compiler_gnu+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_compiler_gnu=yes +else $as_nop + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+y} +ac_save_CFLAGS=$CFLAGS +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +printf %s "checking whether $CC accepts -g... " >&6; } +if test ${ac_cv_prog_cc_g+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +else $as_nop + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +else $as_nop + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +printf "%s\n" "$ac_cv_prog_cc_g" >&6; } +if test $ac_test_CFLAGS; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +ac_prog_cc_stdc=no +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 +printf %s "checking for $CC option to enable C11 features... " >&6; } +if test ${ac_cv_prog_cc_c11+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c11=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c11_program +_ACEOF +for ac_arg in '' -std=gnu11 +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c11=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c11" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c11" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c11" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } + CC="$CC $ac_cv_prog_cc_c11" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + ac_prog_cc_stdc=c11 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 +printf %s "checking for $CC option to enable C99 features... " >&6; } +if test ${ac_cv_prog_cc_c99+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c99=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c99_program +_ACEOF +for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c99=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c99" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c99" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c99" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } + CC="$CC $ac_cv_prog_cc_c99" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + ac_prog_cc_stdc=c99 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 +printf %s "checking for $CC option to enable C89 features... " >&6; } +if test ${ac_cv_prog_cc_c89+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c89_program +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c89" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c89" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } + CC="$CC $ac_cv_prog_cc_c89" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + ac_prog_cc_stdc=c89 +fi +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +printf %s "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if test ${ac_cv_prog_CPP+y} +then : + printf %s "(cached) " >&6 +else $as_nop + # Double quotes because $CC needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + +else $as_nop + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + # Broken: success on invalid input. +continue +else $as_nop + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok +then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +printf "%s\n" "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + +else $as_nop + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + # Broken: success on invalid input. +continue +else $as_nop + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok +then : + +else $as_nop + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +add_arg_to_cflags() { + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for CFLAG $1" >&5 +printf %s "checking for CFLAG $1... " >&6; } + CFLAGS_ORI=$CFLAGS + CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" + +if test "$cross_compiling" = yes +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + CFLAGS="$CFLAGS_ORI $1";{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; };return 0 +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + CFLAGS=$CFLAGS_ORI + return 1 + +} + +assert_arg_to_cflags() { + if ! add_arg_to_cflags $1 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 +printf "%s\n" "cannot add $1 to CFLAGS" >&6; }; exit 1 ; fi + return 0 +} + +add_args_to_cflags() { + + while test "$#" -ge 1 ; do + add_arg_to_cflags $1 + shift + done +} + +add_arg_to_ldflags() { + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for LDFLAG $1" >&5 +printf %s "checking for LDFLAG $1... " >&6; } + LDFLAGS_ORI=$LDFLAGS + LDFLAGS="$LDFLAGS -Werror $1" + if test "$cross_compiling" = yes +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + LDFLAGS="$LDFLAGS_ORI $1";{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; };return 0 +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + LDFLAGS=$LDFLAGS_ORI + return 1 + +} + +assert_arg_to_ldflags() { + if ! add_arg_to_ldflags $1 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 +printf "%s\n" "cannot add $1 to LDFLAGS" >&6; }; exit 1 ; fi + return 0 +} + +add_args_to_ldflags() { + + while test "$#" -ge 1 ; do + add_arg_to_ldflags $1 + shift + done +} + +remove_arg_from_ldflags() { + + NEW_LDFLAGS="" + for i in $LDFLAGS; do + if ! test "$i" = "$1" ; then + NEW_LDFLAGS="$NEW_LDFLAGS $i" + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: removing $1 from LDFLAGS" >&5 +printf "%s\n" "removing $1 from LDFLAGS" >&6; } + fi + done + LDFLAGS=$NEW_LDFLAGS + + return 0 + +} + +add_args_to_cflags -fsigned-char -pipe -fcommon \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable + +add_args_to_ldflags -no-pie # -Wl,-z,lazy + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inline semantics" >&5 +printf %s "checking for inline semantics... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + inline int foo(int i) {return i;} + + int + bar(int i) {return foo(i);} + +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + if `nm conftest.o |grep foo |awk '{if (NF==3) exit(-1)}'` ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: new" >&5 +printf "%s\n" "new" >&6; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + extern inline int foo(int i) {return i;} + + int + bar(int i) {return foo(i);} + +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + if `nm conftest.o |grep foo |awk '{if (NF==3) exit(-1)}'` ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: old" >&5 +printf "%s\n" "old" >&6; } + +printf "%s\n" "#define OLD_INLINE 1" >>confdefs.h + + else + as_fn_error $? "need working inline semantics" "$LINENO" 5 + fi +else $as_nop + as_fn_error $? "need to probe inline semantics" "$LINENO" 5 +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + fi +else $as_nop + as_fn_error $? "need to probe inline semantics" "$LINENO" 5 +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 +printf %s "checking for clang... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #ifdef __clang__ + #define RET 0 + #else + #define RET 1 + #endif + +int +main (void) +{ + + return RET; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + clang="yes" + remove_arg_from_ldflags -pie + +printf "%s\n" "#define CLANG 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +case $use in + *mingw*) + assert_arg_to_cflags -fno-zero-initialized-in-bss + assert_arg_to_cflags -mms-bitfields + for i in makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp h/gclincl.h; do + cat $i.in | sed 's,^\r\n$,\r\n,g' >tmp && mv tmp $i.in; + done + OLD_LDFLAGS=$LDFLAGS + assert_arg_to_ldflags -pg + GPL_FLAG="-pg" + LDFLAGS=$OLD_LDFLAGS;; + *gnuwin*) + assert_arg_to_cflags -fno-zero-initialized-in-bss + assert_arg_to_cflags -mms-bitfields + assert_arg_to_ldflags -Wl,--stack,8000000 + OLD_LDFLAGS=$LDFLAGS + assert_arg_to_ldflags -pg + GPL_FLAG="-pg" + LDFLAGS=$OLD_LDFLAGS;; + 386-macosx) +# assert_arg_to_cflags -Wno-error=implicit-function-declaration + add_arg_to_cflags -Wno-incomplete-setjmp-declaration + assert_arg_to_ldflags -Wl,-no_pie + if test "$build_cpu" = "x86_64" ; then + assert_arg_to_cflags -m64 + assert_arg_to_ldflags -m64 + assert_arg_to_ldflags -Wl,-headerpad,72 + else + assert_arg_to_cflags -m32 + assert_arg_to_ldflags -m32 + assert_arg_to_ldflags -Wl,-headerpad,56 + fi;; + FreeBSD) assert_arg_to_ldflags -Z;; +esac + +if test "$enable_static" = "yes" ; then + assert_arg_to_ldflags -static + assert_arg_to_ldflags -Wl,-zmuldefs + +printf "%s\n" "#define STATIC_LINKING 1" >>confdefs.h + +fi + +TO3FLAGS="" +TO2FLAGS="" + +case "$use" in + *mingw*) + TFPFLAG="";; + m68k*)#FIXME gcc 4.x bug workaround + TFPFLAG="";; + *) + TFPFLAG="-fomit-frame-pointer";; +esac + +for ac_prog in gawk nawk awk +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_AWK+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_AWK="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AWK=$ac_cv_prog_AWK +if test -n "$AWK"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 +printf "%s\n" "$AWK" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$AWK" && break +done + +GCL_CC_ARGS=`echo $CC | ${AWK} '{$1="";print}'` +GCL_CC="`basename $CC` $GCL_CC_ARGS" +if echo $GCL_CC |grep gcc |grep -q win; then + GCL_CC=gcc +fi + + +# Check whether --enable-gprof was given. +if test ${enable_gprof+y} +then : + enableval=$enable_gprof; if test "$enableval" = "yes" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking working gprof" >&5 +printf %s "checking working gprof... " >&6; } + case $use in + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + m68k*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac + GP_FLAG="" + if test "$enableval" != "yes" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 +printf "%s\n" "disabled" >&6; } + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +printf "%s\n" "ok" >&6; } + OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg + assert_arg_to_cflags -pg + GP_FLAG="-pg" + CFLAGS=$OLD_CFLAGS + TFPFLAG="" + +printf "%s\n" "#define GCL_GPROF 1" >>confdefs.h + + fi + fi +fi + + +if test "$enable_debug" = "yes" ; then + assert_arg_to_cflags -g + # for subconfigurations + CFLAGS="$CFLAGS -g" +else + TO3FLAGS="-O3 $TFPFLAG" + TO2FLAGS="-O" +fi + +# gcc on ppc cannot compile our new_init.c with full opts --CM +TONIFLAGS="" +case $use in + powerpc*macosx) assert_arg_to_cflags -mlongcall;; + *linux) + case $use in + alpha*) + assert_arg_to_cflags -mieee +# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 + ;; + aarch64*) + TLIBS="$TLIBS -lgcc_s";; + hppa*) + assert_arg_to_cflags -mlong-calls + TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 + ;; + mips*) + case $canonical in + mips64*linux*) +# assert_arg_to_cflags -mxgot + assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) + +printf "%s\n" "#define SET_STACK_POINTER \"mov %%sp,%0\\n\\t\"" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to set stack pointer" >&5 +printf %s "checking how to set stack pointer... " >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: done" >&5 +printf "%s\n" "done" >&6; } + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; + powerpc*) + assert_arg_to_cflags -mlongcall + if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi + ;; + esac;; +esac +if test "$enable_pic" = "yes" ; then + assert_arg_to_cflags -fPIC +fi + + +FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` +#CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` +FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-fomit-frame-pointer$"|tr '\012' ' '` +FOOPT3=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O3$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O3$"|tr '\012' ' '` +FOOPT2=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O2$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O2$"|tr '\012' ' '` +FOOPT1=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O1$"|tr '\012' ' '` +TMPF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O$"|tr '\012' ' '` +FOOPT1="$FOOPT1$TMPF" +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O1$"|grep -v "^\-O$"|tr '\012' ' '` +FOOPT0=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O0$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` + +if test "$FOOPT0" != "" ; then + TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` + TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +else + if test "$FOOPT1" != "" ; then + TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` + TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` + else + if test "$FOOPT2" != "" ; then + TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` + TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` + fi + fi +fi + +if test "$FDEBUG" != "" ; then + TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` + TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` +fi + +if test "$FOMITF" != "" ; then + TO3FLAGS="$TO3FLAGS $FOMITF" +fi + +# Step 1: set the variable "system" to hold the name and version number +# for the system. This can usually be done via the "uname" command, but +# there are a few systems, like Next, where this doesn't work. + +for ac_prog in makeinfo +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_MAKEINFO+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$MAKEINFO"; then + ac_cv_prog_MAKEINFO="$MAKEINFO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_MAKEINFO="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MAKEINFO=$ac_cv_prog_MAKEINFO +if test -n "$MAKEINFO"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $MAKEINFO" >&5 +printf "%s\n" "$MAKEINFO" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$MAKEINFO" && break +done +test -n "$MAKEINFO" || MAKEINFO=""false"" + + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking system version (for dynamic loading)" >&5 +printf %s "checking system version (for dynamic loading)... " >&6; } +if machine=`uname -m` ; then true; else machine=unknown ; fi + +if test -f /usr/lib/NextStep/software_version; then + system=NEXTSTEP-`${AWK} '/3/,/3/' /usr/lib/NextStep/software_version` +else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unknown (cannot find uname command)" >&5 +printf "%s\n" "unknown (cannot find uname command)" >&6; } + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird + # results, and the version is kept in special file). + + if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then + system="MP-RAS-`${AWK} '{print $3}' '/etc/.relid'`" + fi + if test "`uname -s`" = "AIX" ; then + system=AIX-`uname -v`.`uname -r` + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $system" >&5 +printf "%s\n" "$system" >&6; } + fi +fi + +case $use in + *macosx) + ac_header= ac_cache= +for ac_item in $ac_header_c_list +do + if test $ac_cache; then + ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default" + if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then + printf "%s\n" "#define $ac_item 1" >> confdefs.h + fi + ac_header= ac_cache= + elif test $ac_header; then + ac_cache=$ac_item + else + ac_header=$ac_item + fi +done + + + + + + + + +if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes +then : + +printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h + +fi + for ac_header in malloc/malloc.h +do : + ac_fn_c_check_header_compile "$LINENO" "malloc/malloc.h" "ac_cv_header_malloc_malloc_h" "$ac_includes_default" +if test "x$ac_cv_header_malloc_malloc_h" = xyes +then : + printf "%s\n" "#define HAVE_MALLOC_MALLOC_H 1" >>confdefs.h + +else $as_nop + as_fn_error $? "need malloc.h on macosx" "$LINENO" 5 +fi + +done + ac_fn_c_check_member "$LINENO" "struct _malloc_zone_t" "memalign" "ac_cv_member_struct__malloc_zone_t_memalign" " + #include + +" +if test "x$ac_cv_member_struct__malloc_zone_t_memalign" = xyes +then : + +printf "%s\n" "#define HAVE_MALLOC_ZONE_MEMALIGN 1" >>confdefs.h + +fi + + + ;; +esac + + for ac_header in setjmp.h +do : + ac_fn_c_check_header_compile "$LINENO" "setjmp.h" "ac_cv_header_setjmp_h" "$ac_includes_default" +if test "x$ac_cv_header_setjmp_h" = xyes +then : + printf "%s\n" "#define HAVE_SETJMP_H 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking sizeof jmp_buf" >&5 +printf %s "checking sizeof jmp_buf... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + FILE *fp=fopen("conftest1","w"); + fprintf(fp,"%lu\n",sizeof(jmp_buf)); + fclose(fp); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + sizeof_jmp_buf=`cat conftest1` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $sizeof_jmp_buf" >&5 +printf "%s\n" "$sizeof_jmp_buf" >&6; } + +printf "%s\n" "#define SIZEOF_JMP_BUF $sizeof_jmp_buf" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi + +done + +# sysconf + for ac_header in unistd.h +do : + ac_fn_c_check_header_compile "$LINENO" "unistd.h" "ac_cv_header_unistd_h" "$ac_includes_default" +if test "x$ac_cv_header_unistd_h" = xyes +then : + printf "%s\n" "#define HAVE_UNISTD_H 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for sysconf in -lc" >&5 +printf %s "checking for sysconf in -lc... " >&6; } +if test ${ac_cv_lib_c_sysconf+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char sysconf (); +int +main (void) +{ +return sysconf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_c_sysconf=yes +else $as_nop + ac_cv_lib_c_sysconf=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_sysconf" >&5 +printf "%s\n" "$ac_cv_lib_c_sysconf" >&6; } +if test "x$ac_cv_lib_c_sysconf" = xyes +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking _SC_CLK_TCK" >&5 +printf %s "checking _SC_CLK_TCK... " >&6; } + hz=0 + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + FILE *fp=fopen("conftest1","w"); + fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); + fclose(fp); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 +printf "%s\n" "$hz" >&6; } +fi + +fi + +done + + +rm -f makedefsafter + +# Check whether --enable-dynsysgmp was given. +if test ${enable_dynsysgmp+y} +then : + enableval=$enable_dynsysgmp; +fi + + +if test "$enable_dynsysgmp" != "no" ; then + for ac_header in gmp.h +do : + ac_fn_c_check_header_compile "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" +if test "x$ac_cv_header_gmp_h" = xyes +then : + printf "%s\n" "#define HAVE_GMP_H 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __gmpz_init in -lgmp" >&5 +printf %s "checking for __gmpz_init in -lgmp... " >&6; } +if test ${ac_cv_lib_gmp___gmpz_init+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lgmp $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char __gmpz_init (); +int +main (void) +{ +return __gmpz_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_gmp___gmpz_init=yes +else $as_nop + ac_cv_lib_gmp___gmpz_init=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_init" >&5 +printf "%s\n" "$ac_cv_lib_gmp___gmpz_init" >&6; } +if test "x$ac_cv_lib_gmp___gmpz_init" = xyes +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for external gmp version" >&5 +printf %s "checking for external gmp version... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + +int +main (void) +{ + + #if __GNU_MP_VERSION > 3 + return 0; + #else + return -1; + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: good" >&5 +printf "%s\n" "good" >&6; } + TLIBS="$TLIBS -lgmp" + echo "#include \"gmp.h\"" >foo.c + echo "int main() {return 0;}" >>foo.c + MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` + rm -f foo.c +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi + +fi + +done + + if test "$MP_INCLUDE" = "" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Cannot use dynamic gmp lib" >&5 +printf "%s\n" "Cannot use dynamic gmp lib" >&6; } + fi + +fi + + +if test "$MP_INCLUDE" = "" ; then + + GMPDIR=gmp4 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking doing configure in gmp directory" >&5 +printf %s "checking doing configure in gmp directory... " >&6; } + echo + echo "#" + echo "#" + echo "# -------------------" + echo "# Subconfigure of GMP" + echo "#" + echo "#" + + if test "$use_common_binary" = "yes"; then + cd $GMPDIR && ./configure --build=$host && cd .. + else + cd $GMPDIR && ./configure --host=$host --build=$build && cd .. + fi + #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" + + echo "#" + echo "#" + echo "#" + echo "# Subconfigure of GMP done" + echo "# ------------------------" + echo "#" + + if test "$MP_INCLUDE" = "" ; then + cp $GMPDIR/gmp.h h/gmp.h + MP_INCLUDE=h/gmp.h + MPFILES=gmp_all + fi +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for leading underscore in object symbols" >&5 +printf %s "checking for leading underscore in object symbols... " >&6; } +cat>foo.c < +#include +int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} +EOFF +$CC -c foo.c -o foo.o +if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then + LEADING_UNDERSCORE=1 + +printf "%s\n" "#define LEADING_UNDERSCORE 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 +printf "%s\n" "\"yes\"" >&6; } +else + LEADING_UNDERSCORE="" + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 +printf "%s\n" "\"no\"" >&6; } +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking \"for GNU ld option -Map\"" >&5 +printf %s "checking \"for GNU ld option -Map\"... " >&6; } +touch map +$CC -o foo -Wl,-Map map foo.o >/dev/null 2>&1 +if test `cat map | wc -l` != "0" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 +printf "%s\n" "\"yes\"" >&6; } + +printf "%s\n" "#define HAVE_GNU_LD 1" >>confdefs.h + + GNU_LD=1 +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 +printf "%s\n" "\"no\"" >&6; } + GNU_LD= +fi +rm -f foo.c foo.o foo map + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for size of gmp limbs" >&5 +printf %s "checking for size of gmp limbs... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include "$MP_INCLUDE" + +int +main (void) +{ + + FILE *fp=fopen("conftest1","w"); + fprintf(fp,"%u",sizeof(mp_limb_t)); + fclose(fp); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + mpsize=`cat conftest1` +else $as_nop + as_fn_error $? "Cannot determine mpsize" "$LINENO" 5 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +printf "%s\n" "#define MP_LIMB_BYTES $mpsize" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $mpsize" >&5 +printf "%s\n" "$mpsize" >&6; } + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking _SHORT_LIMB" >&5 +printf %s "checking _SHORT_LIMB... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include "$MP_INCLUDE" + +int +main (void) +{ + + #ifdef _SHORT_LIMB + return 0; + #else + return 1; + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +printf "%s\n" "#define __SHORT_LIMB 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking _LONG_LONG_LIMB" >&5 +printf %s "checking _LONG_LONG_LIMB... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include "$MP_INCLUDE" + +int +main (void) +{ + + #ifdef _LONG_LONG_LIMB + return 0; + #else + return 1; + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +printf "%s\n" "#define __LONG_LONG_LIMB 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +GMP=1 + +printf "%s\n" "#define GMP 1" >>confdefs.h + + + +echo > makedefsafter +echo "MPFILES=$MPFILES" >> makedefsafter +echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +echo >> makedefsafter + + + +# +# X windows +# + +if test "$enable_xgcl" = "yes" ; then + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for X" >&5 +printf %s "checking for X... " >&6; } + + +# Check whether --with-x was given. +if test ${with_x+y} +then : + withval=$with_x; +fi + +# $have_x is `yes', `no', `disabled', or empty when we do not yet know. +if test "x$with_x" = xno; then + # The user explicitly disabled X. + have_x=disabled +else + case $x_includes,$x_libraries in #( + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( + *,NONE | NONE,*) if test ${ac_cv_have_x+y} +then : + printf %s "(cached) " >&6 +else $as_nop + # One or both of the vars are not set, and there is no cached value. +ac_x_includes=no +ac_x_libraries=no +# Do we need to do anything special at all? +ac_save_LIBS=$LIBS +LIBS="-lX11 $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +XrmInitialize () + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + # We can compile and link X programs with no special options. + ac_x_includes= + ac_x_libraries= +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS="$ac_save_LIBS" +# If that didn't work, only try xmkmf and file system searches +# for native compilation. +if test x"$ac_x_includes" = xno && test "$cross_compiling" = no +then : + rm -f -r conftest.dir +if mkdir conftest.dir; then + cd conftest.dir + cat >Imakefile <<'_ACEOF' +incroot: + @echo incroot='${INCROOT}' +usrlibdir: + @echo usrlibdir='${USRLIBDIR}' +libdir: + @echo libdir='${LIBDIR}' +_ACEOF + if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then + # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. + for ac_var in incroot usrlibdir libdir; do + eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" + done + # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. + for ac_extension in a so sl dylib la dll; do + if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && + test -f "$ac_im_libdir/libX11.$ac_extension"; then + ac_im_usrlibdir=$ac_im_libdir; break + fi + done + # Screen out bogus values from the imake configuration. They are + # bogus both because they are the default anyway, and because + # using them would break gcc on systems where it needs fixed includes. + case $ac_im_incroot in + /usr/include) ac_x_includes= ;; + *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; + esac + case $ac_im_usrlibdir in + /usr/lib | /usr/lib64 | /lib | /lib64) ;; + *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; + esac + fi + cd .. + rm -f -r conftest.dir +fi + + # Standard set of common directories for X headers. +# Check X11 before X11Rn because it is often a symlink to the current release. +ac_x_header_dirs=' +/usr/X11/include +/usr/X11R7/include +/usr/X11R6/include +/usr/X11R5/include +/usr/X11R4/include + +/usr/include/X11 +/usr/include/X11R7 +/usr/include/X11R6 +/usr/include/X11R5 +/usr/include/X11R4 + +/usr/local/X11/include +/usr/local/X11R7/include +/usr/local/X11R6/include +/usr/local/X11R5/include +/usr/local/X11R4/include + +/usr/local/include/X11 +/usr/local/include/X11R7 +/usr/local/include/X11R6 +/usr/local/include/X11R5 +/usr/local/include/X11R4 + +/opt/X11/include + +/usr/X386/include +/usr/x386/include +/usr/XFree86/include/X11 + +/usr/include +/usr/local/include +/usr/unsupported/include +/usr/athena/include +/usr/local/x11r5/include +/usr/lpp/Xamples/include + +/usr/openwin/include +/usr/openwin/share/include' + +if test "$ac_x_includes" = no; then + # Guess where to find include files, by looking for Xlib.h. + # First, try using that file with no special directory specified. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + # We can compile using X headers with no special include directory. +ac_x_includes= +else $as_nop + for ac_dir in $ac_x_header_dirs; do + if test -r "$ac_dir/X11/Xlib.h"; then + ac_x_includes=$ac_dir + break + fi +done +fi +rm -f conftest.err conftest.i conftest.$ac_ext +fi # $ac_x_includes = no + +if test "$ac_x_libraries" = no; then + # Check for the libraries. + # See if we find them without any special options. + # Don't add to $LIBS permanently. + ac_save_LIBS=$LIBS + LIBS="-lX11 $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +XrmInitialize () + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + LIBS=$ac_save_LIBS +# We can link X programs with no special library path. +ac_x_libraries= +else $as_nop + LIBS=$ac_save_LIBS +for ac_dir in `printf "%s\n" "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` +do + # Don't even attempt the hair of trying to link an X program! + for ac_extension in a so sl dylib la dll; do + if test -r "$ac_dir/libX11.$ac_extension"; then + ac_x_libraries=$ac_dir + break 2 + fi + done +done +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +fi # $ac_x_libraries = no + +fi +# Record the results. +case $ac_x_includes,$ac_x_libraries in #( + no,* | *,no | *\'*) : + # Didn't find X, or a directory has "'" in its name. + ac_cv_have_x="have_x=no" ;; #( + *) : + # Record where we found X for the cache. + ac_cv_have_x="have_x=yes\ + ac_x_includes='$ac_x_includes'\ + ac_x_libraries='$ac_x_libraries'" ;; +esac +fi +;; #( + *) have_x=yes;; + esac + eval "$ac_cv_have_x" +fi # $with_x != no + +if test "$have_x" != yes; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5 +printf "%s\n" "$have_x" >&6; } + no_x=yes +else + # If each of the values was on the command line, it overrides each guess. + test "x$x_includes" = xNONE && x_includes=$ac_x_includes + test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries + # Update the cache value to reflect the command line values. + ac_cv_have_x="have_x=yes\ + ac_x_includes='$x_includes'\ + ac_x_libraries='$x_libraries'" + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5 +printf "%s\n" "libraries $x_libraries, headers $x_includes" >&6; } +fi + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 +printf %s "checking for main in -lX11... " >&6; } +if test ${ac_cv_lib_X11_main+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lX11 $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main (void) +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_X11_main=yes +else $as_nop + ac_cv_lib_X11_main=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_X11_main" >&5 +printf "%s\n" "$ac_cv_lib_X11_main" >&6; } +if test "x$ac_cv_lib_X11_main" = xyes +then : + X_LIBS="$X_LIBS -lX11" +printf "%s\n" "#define HAVE_XGCL 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: missing x libraries -- cannot compile xgcl" >&5 +printf "%s\n" "missing x libraries -- cannot compile xgcl" >&6; } +fi + + +fi + + + + + +# +# Dynamic loading +# + +if test "$enable_dlopen" = "yes" ; then + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +printf %s "checking for dlopen in -ldl... " >&6; } +if test ${ac_cv_lib_dl_dlopen+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char dlopen (); +int +main (void) +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_dl_dlopen=yes +else $as_nop + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +printf "%s\n" "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes +then : + printf "%s\n" "#define HAVE_LIBDL 1" >>confdefs.h + + LIBS="-ldl $LIBS" + +else $as_nop + as_fn_error $? "Cannot find dlopen" "$LINENO" 5 +fi + + + TLIBS="$TLIBS -ldl -rdynamic" + assert_arg_to_cflags -fPIC + +printf "%s\n" "#define USE_DLOPEN 1" >>confdefs.h + + +fi + +if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then + for ac_header in bfd.h +do : + ac_fn_c_check_header_compile "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default" +if test "x$ac_cv_header_bfd_h" = xyes +then : + printf "%s\n" "#define HAVE_BFD_H 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for bfd_init in -lbfd" >&5 +printf %s "checking for bfd_init in -lbfd... " >&6; } +if test ${ac_cv_lib_bfd_bfd_init+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbfd -liberty $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char bfd_init (); +int +main (void) +{ +return bfd_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_bfd_bfd_init=yes +else $as_nop + ac_cv_lib_bfd_bfd_init=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_init" >&5 +printf "%s\n" "$ac_cv_lib_bfd_bfd_init" >&6; } +if test "x$ac_cv_lib_bfd_bfd_init" = xyes +then : + # + # Old binutils appear to need CONST defined to const + # + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking need to define CONST for bfd" >&5 +printf %s "checking need to define CONST for bfd... " >&6; } + if test "$cross_compiling" = yes +then : + as_fn_error $? "cannot use bfd" "$LINENO" 5 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #define IN_GCC + #include + +int +main (void) +{ + + symbol_info t; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +else $as_nop + if test "$cross_compiling" = yes +then : + as_fn_error $? "cannot use bfd" "$LINENO" 5 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #define CONST const + #define IN_GCC + #include + +int +main (void) +{ + + symbol_info t; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +printf "%s\n" "#define NEED_CONST 1" >>confdefs.h + +else $as_nop + as_fn_error $? "cannot use bfd" "$LINENO" 5 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi + +fi + +done + + +printf "%s\n" "#define HAVE_LIBBFD 1" >>confdefs.h + + + # + # BFD boolean syntax + # + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for useable bfd_boolean" >&5 +printf %s "checking for useable bfd_boolean... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #define IN_GCC + #include + bfd_boolean foo() {return FALSE;} + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +printf "%s\n" "#define HAVE_BFD_BOOLEAN 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + # + # bfd_link_info.output_bfd minimal configure change check + # + + ac_fn_c_check_member "$LINENO" "struct bfd_link_info" "output_bfd" "ac_cv_member_struct_bfd_link_info_output_bfd" " + #include + #include + +" +if test "x$ac_cv_member_struct_bfd_link_info_output_bfd" = xyes +then : + +printf "%s\n" "#define HAVE_OUTPUT_BFD 1" >>confdefs.h + +fi + + + + # + # FIXME: Need to workaround mingw before this point -- CM + # + if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then + echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c + MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` + rm -f foo.c foo + if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then + LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" + else + as_fn_error $? "cannot locate external libbfd.a" "$LINENO" 5 + fi + if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then + LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" + else + as_fn_error $? "cannot locate external libiberty.a" "$LINENO" 5 + fi + BUILD_BFD=copy_bfd + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 +printf %s "checking for inflate in -lz... " >&6; } +if test ${ac_cv_lib_z_inflate+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lz $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char inflate (); +int +main (void) +{ +return inflate (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_z_inflate=yes +else $as_nop + ac_cv_lib_z_inflate=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_z_inflate" >&5 +printf "%s\n" "$ac_cv_lib_z_inflate" >&6; } +if test "x$ac_cv_lib_z_inflate" = xyes +then : + TLIBS="$TLIBS -lz" +else $as_nop + as_fn_error $? "Need zlib for bfd linking" "$LINENO" 5 +fi + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 +printf %s "checking for dlsym in -ldl... " >&6; } +if test ${ac_cv_lib_dl_dlsym+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char dlsym (); +int +main (void) +{ +return dlsym (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_dl_dlsym=yes +else $as_nop + ac_cv_lib_dl_dlsym=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlsym" >&5 +printf "%s\n" "$ac_cv_lib_dl_dlsym" >&6; } +if test "x$ac_cv_lib_dl_dlsym" = xyes +then : + TLIBS="$TLIBS -ldl" +else $as_nop + as_fn_error $? "Need libdl for bfd linking" "$LINENO" 5 +fi + + + + + + else + TLIBS="$TLIBS -lbfd -liberty -ldl" + fi +fi + +# Check whether --enable-xdr was given. +if test ${enable_xdr+y} +then : + enableval=$enable_xdr; +fi + + +if test "$enable_xdr" != "no" ; then + XDR_LIB="" + ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" +if test "x$ac_cv_func_xdr_double" = xyes +then : + XDR_LIB=" " +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -ltirpc" >&5 +printf %s "checking for xdr_double in -ltirpc... " >&6; } +if test ${ac_cv_lib_tirpc_xdr_double+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltirpc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char xdr_double (); +int +main (void) +{ +return xdr_double (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_tirpc_xdr_double=yes +else $as_nop + ac_cv_lib_tirpc_xdr_double=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tirpc_xdr_double" >&5 +printf "%s\n" "$ac_cv_lib_tirpc_xdr_double" >&6; } +if test "x$ac_cv_lib_tirpc_xdr_double" = xyes +then : + XDR_LIB=tirpc +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 +printf %s "checking for xdr_double in -lgssrpc... " >&6; } +if test ${ac_cv_lib_gssrpc_xdr_double+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lgssrpc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char xdr_double (); +int +main (void) +{ +return xdr_double (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_gssrpc_xdr_double=yes +else $as_nop + ac_cv_lib_gssrpc_xdr_double=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 +printf "%s\n" "$ac_cv_lib_gssrpc_xdr_double" >&6; } +if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes +then : + XDR_LIB=gssrpc +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 +printf %s "checking for xdr_double in -lrpc... " >&6; } +if test ${ac_cv_lib_rpc_xdr_double+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lrpc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char xdr_double (); +int +main (void) +{ +return xdr_double (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_rpc_xdr_double=yes +else $as_nop + ac_cv_lib_rpc_xdr_double=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rpc_xdr_double" >&5 +printf "%s\n" "$ac_cv_lib_rpc_xdr_double" >&6; } +if test "x$ac_cv_lib_rpc_xdr_double" = xyes +then : + XDR_LIB=rpc +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 +printf %s "checking for xdr_double in -loncrpc... " >&6; } +if test ${ac_cv_lib_oncrpc_xdr_double+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-loncrpc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char xdr_double (); +int +main (void) +{ +return xdr_double (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_oncrpc_xdr_double=yes +else $as_nop + ac_cv_lib_oncrpc_xdr_double=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_oncrpc_xdr_double" >&5 +printf "%s\n" "$ac_cv_lib_oncrpc_xdr_double" >&6; } +if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes +then : + XDR_LIB=oncrpc +fi + +fi + +fi + +fi + +fi + + + if test "$XDR_LIB" != ""; then + +printf "%s\n" "#define HAVE_XDR 1" >>confdefs.h + + if test "$XDR_LIB" != " "; then + TLIBS="$TLIBS -l$XDR_LIB" + add_arg_to_cflags -I/usr/include/$XDR_LIB + fi + fi +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking __builtin_clzl" >&5 +printf %s "checking __builtin_clzl... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + unsigned long u; + long j; + if (__builtin_clzl(0)!=sizeof(long)*8) + return -1; + for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) + if (__builtin_clzl(u)!=j) + return -1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +printf "%s\n" "#define HAVE_CLZL 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking __builtin_ctzl" >&5 +printf %s "checking __builtin_ctzl... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + unsigned long u; + long j; + if (__builtin_ctzl(0)!=sizeof(long)*8) + return -1; + for (u=1,j=0;j&5 +printf "%s\n" "yes" >&6; } + +printf "%s\n" "#define HAVE_CTZL 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + +case $use in + sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7 + hppa*) ;; #FIXME + powerpc*) ;; #FIXME + alpha*) ;; #FIXME + ia64*) ;; #FIXME + *) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 +printf %s "checking __builtin___clear_cache... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + void *v,*ve; + __builtin___clear_cache(v,ve); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +printf "%s\n" "#define HAVE_BUILTIN_CLEAR_CACHE 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +;; +esac + +#AC_CONFIG_SUBDIRS($MY_SUBDIRS) + +# Find where Data begins. This is used by the storage allocation +# mechanism, in the PAGE macro. This offset is subtracted from +# addresses, in calculating a page for an address in the heap. + +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking size of long" >&5 +printf %s "checking size of long... " >&6; } +if test ${ac_cv_sizeof_long+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long" "$ac_includes_default" +then : + +else $as_nop + if test "$ac_cv_type_long" = yes; then + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (long) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_long=0 + fi +fi + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long" >&5 +printf "%s\n" "$ac_cv_sizeof_long" >&6; } + + + +printf "%s\n" "#define SIZEOF_LONG $ac_cv_sizeof_long" >>confdefs.h + + + +#### Memory areas and alignment + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for byte order" >&5 +printf %s "checking for byte order... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + /* Are we little or big endian? Adapted from Harbison&Steele. */ + union {long l;char c[sizeof(long)];} u; + u.l = 1; + return u.c[sizeof(long)-1] ? 1 : 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: little" >&5 +printf "%s\n" "little" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: big" >&5 +printf "%s\n" "big" >&6; } + +printf "%s\n" "#define WORDS_BIGENDIAN 1" >>confdefs.h + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for word order" >&5 +printf %s "checking for word order... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + /* Are we little or big endian? Adapted from Harbison&Steele. */ + union {double d;int l[sizeof(double)/sizeof(int)];} u; + u.d = 1.0; + return u.l[sizeof(double)/sizeof(int)-1] ? 0 : 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: little" >&5 +printf "%s\n" "little" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: big" >&5 +printf "%s\n" "big" >&6; } + +printf "%s\n" "#define DOUBLE_BIGENDIAN 1" >>confdefs.h + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + +# pagewidth +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pagewidth" >&5 +printf %s "checking for pagewidth... " >&6; } +case $use in + mips*) min_pagewidth=14;; + *) min_pagewidth=12;; +esac +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + #ifdef __CYGWIN__ + #define getpagesize() 4096 + #endif + +int +main (void) +{ + + size_t i=getpagesize(),j; + FILE *fp=fopen("conftest1","w"); + for (j=0;i>>=1;j++); + j=j<$min_pagewidth ? $min_pagewidth : j; + fprintf(fp,"%u",j); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + PAGEWIDTH=`cat conftest1` +else $as_nop + PAGEWIDTH=0 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $PAGEWIDTH" >&5 +printf "%s\n" "$PAGEWIDTH" >&6; } + +printf "%s\n" "#define PAGEWIDTH $PAGEWIDTH" >>confdefs.h + + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for required object alignment" >&5 +printf %s "checking for required object alignment... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + #define EXTER + #define INLINE + #include "$MP_INCLUDE" + #include "./h/enum.h" + #define OBJ_ALIGN + #include "./h/type.h" + #include "./h/lu.h" + #include "./h/object.h" + +int +main (void) +{ + + unsigned long i; + FILE *fp=fopen("conftest1","w"); + for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); + if (!i) return -1; + fprintf(fp,"%lu",i); + fclose(fp); + return 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + obj_align=`cat conftest1` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 +printf "%s\n" "$obj_align" >&6; } + +printf "%s\n" "#define OBJ_ALIGNMENT $obj_align" >>confdefs.h + +else $as_nop + as_fn_error $? "Cannot find object alignent" "$LINENO" 5 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C extension variable alignment" >&5 +printf %s "checking for C extension variable alignment... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + char *v __attribute__ ((aligned ($obj_align))); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + obj_align="__attribute__ ((aligned ($obj_align)))" +else $as_nop + as_fn_error $? "Need alignment attributes" "$LINENO" 5 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 +printf "%s\n" "$obj_align" >&6; } + +printf "%s\n" "#define OBJ_ALIGN $obj_align" >>confdefs.h + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C extension noreturn function attribute" >&5 +printf %s "checking for C extension noreturn function attribute... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + extern int v() __attribute__ ((noreturn)); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + no_return="__attribute__ ((noreturn))" +else $as_nop + no_return= +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $no_return" >&5 +printf "%s\n" "$no_return" >&6; } + +printf "%s\n" "#define NO_RETURN $no_return" >>confdefs.h + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking sizeof struct contblock" >&5 +printf %s "checking sizeof struct contblock... " >&6; } + +if test "$cross_compiling" = yes +then : + as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + #define EXTER + #define INLINE + #include "$MP_INCLUDE" + #include "h/enum.h" + #include "h/type.h" + #include "h/lu.h" + #include "h/object.h" + +int +main (void) +{ + + FILE *f=fopen("conftest1","w"); + fprintf(f,"%u",sizeof(struct contblock)); + fclose(f); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + sizeof_contblock=`cat conftest1` +else $as_nop + as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $sizeof_contblock" >&5 +printf "%s\n" "$sizeof_contblock" >&6; } + +printf "%s\n" "#define SIZEOF_CONTBLOCK $sizeof_contblock" >>confdefs.h + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for sbrk" >&5 +printf %s "checking for sbrk... " >&6; } +HAVE_SBRK="" +if test "$cross_compiling" = yes +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&5 +printf "%s\n" "no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&6; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + FILE *f; + if (!(f=fopen("conftest1","w"))) + return -1; + fprintf(f,"%p",sbrk(0)); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + HAVE_SBRK=1;{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&5 +printf "%s\n" "no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +if test "$use" = "386-macosx" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5 +printf "%s\n" "emulating sbrk for mac" >&6; }; + HAVE_SBRK=0 +fi + +if test "$HAVE_SBRK" = "1" ; then + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 +printf %s "checking for ADDR_NO_RANDOMIZE constant... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + FILE *f; + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%x",ADDR_NO_RANDOMIZE); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + ADDR_NO_RANDOMIZE=`cat conftest1` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_NO_RANDOMIZE" >&5 +printf "%s\n" "yes $ADDR_NO_RANDOMIZE" >&6; } +else $as_nop + ADDR_NO_RANDOMIZE=0 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no assuming 0x40000" >&5 +printf "%s\n" "no assuming 0x40000" >&6; } + +printf "%s\n" "#define ADDR_NO_RANDOMIZE 0x40000" >>confdefs.h + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5 +printf %s "checking for ADDR_COMPAT_LAYOUT constant... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + FILE *f; + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%x",ADDR_COMPAT_LAYOUT); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + ADDR_COMPAT_LAYOUT=`cat conftest1` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_COMPAT_LAYOUT" >&5 +printf "%s\n" "yes $ADDR_COMPAT_LAYOUT" >&6; } +else $as_nop + ADDR_COMPAT_LAYOUT=0 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + +printf "%s\n" "#define ADDR_COMPAT_LAYOUT 0" >>confdefs.h + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for ADDR_LIMIT_3GB constant" >&5 +printf %s "checking for ADDR_LIMIT_3GB constant... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + FILE *f; + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%x",ADDR_LIMIT_3GB); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + ADDR_LIMIT_3GB=`cat conftest1` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_LIMIT_3GB" >&5 +printf "%s\n" "yes $ADDR_LIMIT_3GB" >&6; } +else $as_nop + ADDR_LIMIT_3GB=0 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + +printf "%s\n" "#define ADDR_LIMIT_3GB 0" >>confdefs.h + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 +printf %s "checking for personality(ADDR_NO_RANDOMIZE) support... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int main(int argc,char *argv[],char *envp[]) { + #include "h/unrandomize.h" + return 0; + } + +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +printf "%s\n" "#define CAN_UNRANDOMIZE_SBRK 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 +printf %s "checking that sbrk is (now) non-random... " >&6; } + SBRK=0 + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) + return -1; + fprintf(f,"%p",sbrk(0)); + return 0; + } + +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + SBRK=`cat conftest1` +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + if test "$SBRK" = "0" ; then + as_fn_error $? "cannot trap sbrk" "$LINENO" 5 + fi + + SBRK1=0 + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%p",sbrk(0)); + return 0; + } + +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + SBRK1=`cat conftest1` +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + if test "$SBRK1" = "0" ; then + as_fn_error $? "cannot trap sbrk" "$LINENO" 5 + fi + if test "$SBRK" = "$SBRK1" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + echo "Cannot build with randomized sbrk. Your options:" + echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" + echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" + echo " - run sysctl kernel.randomize_va_space=0 before using gcl" + as_fn_error $? "exiting" "$LINENO" 5 + fi +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking CSTACK_DIRECTION" >&5 +printf %s "checking CSTACK_DIRECTION... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int main(int argc,char **argv,char **envp) { + FILE *fp = fopen("conftest1","w"); + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + fprintf(fp,"%d",(alloca(sizeof(void *))>alloca(sizeof(void *))) ? -1 : 1); + fclose(fp); + return 0; + } +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + cstack_direction=`cat conftest1` +else $as_nop + cstack_direction=0 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +printf "%s\n" "#define CSTACK_DIRECTION $cstack_direction" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 +printf "%s\n" "$cstack_direction" >&6; } + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking finding CSTACK_ALIGNMENT" >&5 +printf %s "checking finding CSTACK_ALIGNMENT... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int main(int argc,char **argv,char **envp) { + void *b,*c; + FILE *fp = fopen("conftest1","w"); + long n; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + b=alloca(sizeof(b)); + c=alloca(sizeof(c)); + n=b>c ? b-c : c-b; + n=n>sizeof(c) ? n : 1; + fprintf(fp,"%ld",n); + fclose(fp); + return 0; + } +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + cstack_alignment=`cat conftest1` +else $as_nop + cstack_alignment=0 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +printf "%s\n" "#define CSTACK_ALIGNMENT $cstack_alignment" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cstack_alignment" >&5 +printf "%s\n" "$cstack_alignment" >&6; } + +# Check whether --enable-cstackmax was given. +if test ${enable_cstackmax+y} +then : + enableval=$enable_cstackmax; if test "$enableval" != "" ; then +printf "%s\n" "#define CSTACKMAX $enableval" >>confdefs.h + fi +fi + + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 +printf %s "checking CSTACK_ADDRESS... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int + main(int argc,char **argv,char **envp) { + FILE *fp = fopen("conftest1","w"); + unsigned long i,j; + + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + j=1; + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)alloca(sizeof(void *)); + if ($cstack_direction==1) i-=j; + j--; + i+=j; + i&=~j; + fprintf(fp,"0x%lx",i-1); + fclose(fp); + return 0; + } +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + cstack_address=`cat conftest1` +else $as_nop + cstack_address=0 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +printf "%s\n" "#define CSTACK_ADDRESS $cstack_address" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cstack_address" >&5 +printf "%s\n" "$cstack_address" >&6; } + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking cstack bits" >&5 +printf %s "checking cstack bits... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int + main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); + long i,j; + + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + j=1; + j<<=$PAGEWIDTH; + j<<=16; + i=(long)&v; + if ($cstack_direction==1) i-=j; + j--; + i+=j; + i&=~j; + for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); + fprintf(fp,"%ld",j); + fclose(fp); + return 0; + } +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + cstack_bits=`cat conftest1` +else $as_nop + cstack_bits=0 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +printf "%s\n" "#define CSTACK_BITS $cstack_bits" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cstack_bits" >&5 +printf "%s\n" "$cstack_bits" >&6; } + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking NEG_CSTACK_ADDRESS" >&5 +printf %s "checking NEG_CSTACK_ADDRESS... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + int + main(int argc,char **argv,char **envp) { + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + return (long)$cstack_address<0 ? 0 : -1; + } +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + neg_cstack_address=1 + +printf "%s\n" "#define NEG_CSTACK_ADDRESS 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + neg_cstack_address=0 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +# Check whether --enable-immfix was given. +if test ${enable_immfix+y} +then : + enableval=$enable_immfix; +fi + + +# Check whether --enable-fastimmfix was given. +if test ${enable_fastimmfix+y} +then : + enableval=$enable_fastimmfix; +else $as_nop + enable_fastimmfix=64 +fi + + + +if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking finding default linker script" >&5 +printf %s "checking finding default linker script... " >&6; } + touch unixport/gcl.script + echo "int main() {return 0;}" >foo.c + $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ + $AWK '/==================================================/ {i=1-i;next} {if (i) print}' >gcl.script + rm -rf foo.c foo + + if test "`cat gcl.script | wc -l`" != "0" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: got it" >&5 +printf "%s\n" "got it" >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5 +printf "%s\n" "$as_me: trying to adjust text start" >&6;} + cp gcl.script gcl.script.def + + n=-1; + k=0; + lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; + max=0; + min=$lim; + while test $n -lt $lim ; do + j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script + # diff -u gcl.script.def gcl.script + echo "int main() {return 0;}" >foo.c + if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then + if test $n -lt $min ; then min=$n; fi; + if test $n -gt $max; then max=$n; fi; + elif test $max -gt 0 ; then + break; + fi; + n=`$AWK 'END {print n+1}' n=$n &5 +printf "%s\n" "$as_me: min log text start $min" >&6;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: max log text start $max" >&5 +printf "%s\n" "$as_me: max log text start $max" >&6;} + + if test $neg_cstack_address -eq 1 ; then #FIXME test this + if test $cstack_bits -lt $max ; then + max=$cstack_bits; + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: max log text start reduced to $max considering c stack address" >&5 +printf "%s\n" "$as_me: max log text start reduced to $max considering c stack address" >&6;} + fi + fi + + j=-1; + low_shft=""; + if test $min -le $max ; then + if test $max -ge $enable_fastimmfix && test "$enable_immfix" != "no" ; then + j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$max &5 +printf "%s\n" "$as_me: raising log text to $j for a $max bit wide low immfix table" >&6;} + else + j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$min &5 +printf "%s\n" "$as_me: lowering log text to $j to maximize data area" >&6;} + fi + fi + + if test "$low_shft" != "" ; then + +printf "%s\n" "#define LOW_SHFT $low_shft" >>confdefs.h + + +printf "%s\n" "#define OBJNULL (object)0x$j" >>confdefs.h + + else + +printf "%s\n" "#define OBJNULL NULL" >>confdefs.h + + fi + + # echo $j; + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5 +printf %s "checking our linker script... " >&6; } + if test "$j" -ne "-1" ; then + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: done" >&5 +printf "%s\n" "done" >&6; } + rm -f gcl.script.def + assert_arg_to_ldflags -Wl,-T,gcl.script + cp gcl.script unixport + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 +printf "%s\n" "none found or not needed" >&6; } + rm -f gcl.script gcl.script.def + fi + rm -rf foo.c foo + else + +printf "%s\n" "#define OBJNULL NULL" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: not found" >&5 +printf "%s\n" "not found" >&6; } + fi + +else + + +printf "%s\n" "#define OBJNULL NULL" >>confdefs.h + + +fi + +mem_top=0 +mem_range=0 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking mem top" >&5 +printf %s "checking mem top... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + +int +main (void) +{ + + unsigned long i,j,k,l; + FILE *fp = fopen("conftest1","w"); + + for (i=2,k=1;i;k=i,i<<=1); + l=$cstack_address; + l=$cstack_direction==1 ? (l>=1,i|=j); + if (j<(k>>3)) i=0; + j=1; + j<<=$PAGEWIDTH; + j<<=4; + j--; + i+=j; + i&=~j; + fprintf(fp,"0x%lx",i); + fclose(fp); + return 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + mem_top=`cat conftest1` +else $as_nop + mem_top="0x0" +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $mem_top" >&5 +printf "%s\n" "$mem_top" >&6; } + +if test "$mem_top" != "0x0" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5 +printf %s "checking finding upper mem half range... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + +int +main (void) +{ + + unsigned long j; + FILE *fp = fopen("conftest1","w"); + + for (j=1;j && !(j& $mem_top);j<<=1); + fprintf(fp,"0x%lx",j>>1); + fclose(fp); + return 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + mem_range=`cat conftest1` +else $as_nop + mem_range="0x0" +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5 +printf "%s\n" "$mem_range" >&6; } + if test "$mem_range" != "0x0" ; then + +printf "%s\n" "#define MEM_TOP $mem_top" >>confdefs.h + + +printf "%s\n" "#define MEM_RANGE $mem_range" >>confdefs.h + + fi +fi + +if test "$enable_immfix" != "no" ; then + if test "$mem_top" != "0x0" ; then + if test "$mem_range" != "0x0" ; then + +printf "%s\n" "#define IM_FIX_BASE $mem_top" >>confdefs.h + + +printf "%s\n" "#define IM_FIX_LIM $mem_range" >>confdefs.h + + fi + fi +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking sizeof long long int" >&5 +printf %s "checking sizeof long long int... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + +int +main (void) +{ + + if (sizeof(long long int) == 2*sizeof(long)) return 0; + return 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +printf "%s\n" "#define HAVE_LONG_LONG 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + + + for ac_header in dirent.h +do : + ac_fn_c_check_header_compile "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "$ac_includes_default" +if test "x$ac_cv_header_dirent_h" = xyes +then : + printf "%s\n" "#define HAVE_DIRENT_H 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for d_type" >&5 +printf %s "checking for d_type... " >&6; } + if test "$cross_compiling" = yes +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + struct dirent *d; + DIR *r=opendir("./"); + for (;(d=readdir(r)) && strcmp("configure",d->d_name);); + return d && d->d_type==DT_REG ? 0 : -1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +printf "%s\n" "#define HAVE_D_TYPE 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi + +done + +# ansi lisp +SYSTEM=ansi_gcl +CLSTANDARD=ANSI +# Check whether --enable-ansi was given. +if test ${enable_ansi+y} +then : + enableval=$enable_ansi; if test "$enable_ansi" = "no" ; then + SYSTEM=gcl + CLSTANDARD=CLtL1 + else + +printf "%s\n" "#define ANSI_COMMON_LISP 1" >>confdefs.h + + fi +else $as_nop + +printf "%s\n" "#define ANSI_COMMON_LISP 1" >>confdefs.h + +fi + + +FLISP="saved_$SYSTEM" + + + + +# Maximum number of pages + + + +# Check if Posix compliant getcwd exists, if not we'll use getwd. +ac_fn_c_check_func "$LINENO" "getcwd" "ac_cv_func_getcwd" +if test "x$ac_cv_func_getcwd" = xyes +then : + printf "%s\n" "#define HAVE_GETCWD 1" >>confdefs.h + +fi + +ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" +if test "x$ac_cv_func_getwd" = xyes +then : + printf "%s\n" "#define HAVE_GETWD 1" >>confdefs.h + +fi + +ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname" +if test "x$ac_cv_func_uname" = xyes +then : + +else $as_nop + +printf "%s\n" "#define NO_UNAME 1" >>confdefs.h + +fi + +ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" +if test "x$ac_cv_func_gettimeofday" = xyes +then : + +else $as_nop + printf "%s\n" "#define NO_GETTOD 1" >>confdefs.h + +fi + + + +ac_fn_c_check_header_compile "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_ioctl_h" = xyes +then : + printf "%s\n" "#define HAVE_SYS_IOCTL_H 1" >>confdefs.h + +fi + + +# OpenBSD has elf_abi.h instead of elf.h +ac_fn_c_check_header_compile "$LINENO" "elf.h" "ac_cv_header_elf_h" "$ac_includes_default" +if test "x$ac_cv_header_elf_h" = xyes +then : + printf "%s\n" "#define HAVE_ELF_H 1" >>confdefs.h + +fi +ac_fn_c_check_header_compile "$LINENO" "elf_abi.h" "ac_cv_header_elf_abi_h" "$ac_includes_default" +if test "x$ac_cv_header_elf_abi_h" = xyes +then : + printf "%s\n" "#define HAVE_ELF_ABI_H 1" >>confdefs.h + +fi + + +ac_fn_c_check_header_compile "$LINENO" "sys/sockio.h" "ac_cv_header_sys_sockio_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_sockio_h" = xyes +then : + printf "%s\n" "#define HAVE_SYS_SOCKIO_H 1" >>confdefs.h + +fi + + + +#-------------------------------------------------------------------- +# The code below deals with several issues related to gettimeofday: +# 1. Some systems don't provide a gettimeofday function at all +# (set NO_GETTOD if this is the case). +# 2. SGI systems don't use the BSD form of the gettimeofday function, +# but they have a BSDgettimeofday function that can be used instead. +# 3. See if gettimeofday is declared in the header file. +# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can +# declare it. +#-------------------------------------------------------------------- + +ac_fn_c_check_func "$LINENO" "BSDgettimeofday" "ac_cv_func_BSDgettimeofday" +if test "x$ac_cv_func_BSDgettimeofday" = xyes +then : + +printf "%s\n" "#define HAVE_BSDGETTIMEOFDAY 1" >>confdefs.h + +else $as_nop + ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" +if test "x$ac_cv_func_gettimeofday" = xyes +then : + +else $as_nop + +printf "%s\n" "#define NO_GETTOD 1" >>confdefs.h + +fi + +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +printf %s "checking for grep that handles long lines and -e... " >&6; } +if test ${ac_cv_path_GREP+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_prog in grep ggrep + do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + printf %s 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + printf "%s\n" 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +printf "%s\n" "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +printf %s "checking for egrep... " >&6; } +if test ${ac_cv_path_EGREP+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_prog in egrep + do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + printf %s 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + printf "%s\n" 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +printf "%s\n" "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "gettimeofday" >/dev/null 2>&1 +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5 +printf %s "checking for gettimeofday declaration... " >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: present" >&5 +printf "%s\n" "present" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5 +printf %s "checking for gettimeofday declaration... " >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: missing" >&5 +printf "%s\n" "missing" >&6; } + +printf "%s\n" "#define GETTOD_NOT_DECLARED 1" >>confdefs.h + +fi +rm -rf conftest* + + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for sin in -lm" >&5 +printf %s "checking for sin in -lm... " >&6; } +if test ${ac_cv_lib_m_sin+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char sin (); +int +main (void) +{ +return sin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_m_sin=yes +else $as_nop + ac_cv_lib_m_sin=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sin" >&5 +printf "%s\n" "$ac_cv_lib_m_sin" >&6; } +if test "x$ac_cv_lib_m_sin" = xyes +then : + LIBS="${LIBS} -lm" +else $as_nop + true +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for main in -lmingwex" >&5 +printf %s "checking for main in -lmingwex... " >&6; } +if test ${ac_cv_lib_mingwex_main+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lmingwex $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main (void) +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_mingwex_main=yes +else $as_nop + ac_cv_lib_mingwex_main=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mingwex_main" >&5 +printf "%s\n" "$ac_cv_lib_mingwex_main" >&6; } +if test "x$ac_cv_lib_mingwex_main" = xyes +then : + LIBS="${LIBS} -lmingwex" +else $as_nop + true +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for buggy maximum sscanf length" >&5 +printf %s "checking for buggy maximum sscanf length... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + +int +main (void) +{ + + char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; + int n, m; + double f; + char *endptr; + FILE *fp=fopen("conftest1","w"); + + n=sscanf(s,"%lf%n",&f,&m); + fprintf(fp,"%d",m); + fclose(fp); + return s[m]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5 +printf "%s\n" "none" >&6; } +else $as_nop + buggy_maximum_sscanf_length=`cat conftest1` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $buggy_maximum_sscanf_length" >&5 +printf "%s\n" "$buggy_maximum_sscanf_length" >&6; } + +printf "%s\n" "#define BUGGY_MAXIMUM_SSCANF_LENGTH $buggy_maximum_sscanf_length" >>confdefs.h + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + + +EXTRA_LOBJS= +# Check whether --enable-japi was given. +if test ${enable_japi+y} +then : + enableval=$enable_japi; if test "$enable_japi" = "yes" ; then + for ac_header in japi.h +do : + ac_fn_c_check_header_compile "$LINENO" "japi.h" "ac_cv_header_japi_h" "$ac_includes_default" +if test "x$ac_cv_header_japi_h" = xyes +then : + printf "%s\n" "#define HAVE_JAPI_H 1" >>confdefs.h + printf "%s\n" "#define HAVE_JAPI_H 1" >>confdefs.h + + EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" + LIBS="${LIBS} -ljapi -lwsock32" +fi + +done + fi +fi + + +# Should really find a way to check for prototypes, but this +# basically works for now. CM +# + for ac_header in math.h +do : + ac_fn_c_check_header_compile "$LINENO" "math.h" "ac_cv_header_math_h" "$ac_includes_default" +if test "x$ac_cv_header_math_h" = xyes +then : + printf "%s\n" "#define HAVE_MATH_H 1" >>confdefs.h + +printf "%s\n" "#define HAVE_MATH_H 1" >>confdefs.h + +fi + +done + for ac_header in complex.h +do : + ac_fn_c_check_header_compile "$LINENO" "complex.h" "ac_cv_header_complex_h" "$ac_includes_default" +if test "x$ac_cv_header_complex_h" = xyes +then : + printf "%s\n" "#define HAVE_COMPLEX_H 1" >>confdefs.h + +printf "%s\n" "#define HAVE_COMPLEX_H 1" >>confdefs.h + +fi + +done + +# +# For DBL_MAX et. al. on (only) certain Linux arches, apparently CM +# + for ac_header in values.h +do : + ac_fn_c_check_header_compile "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default" +if test "x$ac_cv_header_values_h" = xyes +then : + printf "%s\n" "#define HAVE_VALUES_H 1" >>confdefs.h + +printf "%s\n" "#define HAVE_VALUES_H 1" >>confdefs.h + +fi + +done + +# +# Sparc solaris keeps this in float.h, rework either/or with values.h later +# + for ac_header in float.h +do : + ac_fn_c_check_header_compile "$LINENO" "float.h" "ac_cv_header_float_h" "$ac_includes_default" +if test "x$ac_cv_header_float_h" = xyes +then : + printf "%s\n" "#define HAVE_FLOAT_H 1" >>confdefs.h + +printf "%s\n" "#define HAVE_FLOAT_H 1" >>confdefs.h + +fi + +done + +# +# The second alternative is for solaris. This needs to be +# a more comprehensive later, i.e. checking that the fpclass +# test makes sense. CM +# +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for isnormal" >&5 +printf %s "checking for isnormal... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #define _GNU_SOURCE + #include + +int +main (void) +{ + + float f; + return isnormal(f) || !isnormal(f) ? 0 : 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +printf "%s\n" "#define HAVE_ISNORMAL 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for fpclass of ieeefp.h" >&5 +printf %s "checking for fpclass of ieeefp.h... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + +int +main (void) +{ + + float f; + return fpclass(f)>=FP_NZERO || fpclass(f)>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for isfinite" >&5 +printf %s "checking for isfinite... " >&6; } +if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #define _GNU_SOURCE + #include + +int +main (void) +{ + + float f; + return isfinite(f) || !isfinite(f) ? 0 : 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +printf "%s\n" "#define HAVE_ISFINITE 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for finite()" >&5 +printf %s "checking for finite()... " >&6; } + if test "$cross_compiling" = yes +then : + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run test program while cross compiling +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + float f; + return finite(f) || !finite(f) ? 0 : 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + +printf "%s\n" "#define HAVE_FINITE 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + as_fn_error $? "no" "$LINENO" 5 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +#-------------------------------------------------------------------- +# Check for the existence of the -lsocket and -lnsl libraries. +# The order here is important, so that they end up in the right +# order in the command line generated by make. Here are some +# special considerations: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for sockets" >&5 +printf %s "checking for sockets... " >&6; } +tcl_checkBoth=0 +ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" +if test "x$ac_cv_func_connect" = xyes +then : + tcl_checkSocket=0 +else $as_nop + tcl_checkSocket=1 +fi + +if test "$tcl_checkSocket" = 1; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for main in -lsocket" >&5 +printf %s "checking for main in -lsocket... " >&6; } +if test ${ac_cv_lib_socket_main+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsocket $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main (void) +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_socket_main=yes +else $as_nop + ac_cv_lib_socket_main=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_main" >&5 +printf "%s\n" "$ac_cv_lib_socket_main" >&6; } +if test "x$ac_cv_lib_socket_main" = xyes +then : + TLIBS="$TLIBS -lsocket" +else $as_nop + tcl_checkBoth=1 +fi + +fi + + +if test "$tcl_checkBoth" = 1; then + tk_oldLibs=$TLIBS + TLIBS="$TLIBS -lsocket -lnsl" + ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept" +if test "x$ac_cv_func_accept" = xyes +then : + tcl_checkNsl=0 +else $as_nop + TLIBS=$tk_oldLibs +fi + +fi +ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" +if test "x$ac_cv_func_gethostbyname" = xyes +then : + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for main in -lnsl" >&5 +printf %s "checking for main in -lnsl... " >&6; } +if test ${ac_cv_lib_nsl_main+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lnsl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main (void) +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_nsl_main=yes +else $as_nop + ac_cv_lib_nsl_main=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_main" >&5 +printf "%s\n" "$ac_cv_lib_nsl_main" >&6; } +if test "x$ac_cv_lib_nsl_main" = xyes +then : + TLIBS="$TLIBS -lnsl" +fi + +fi + + +# readline +# Check whether --enable-readline was given. +if test ${enable_readline+y} +then : + enableval=$enable_readline; +fi + + +if test "$use" = "mingw" ; then + enable_readline=no +fi + +if test "$enable_readline" != "no" ; then + for ac_header in readline/readline.h +do : + ac_fn_c_check_header_compile "$LINENO" "readline/readline.h" "ac_cv_header_readline_readline_h" "#include + +" +if test "x$ac_cv_header_readline_readline_h" = xyes +then : + printf "%s\n" "#define HAVE_READLINE_READLINE_H 1" >>confdefs.h + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for rl_initialize in -lreadline" >&5 +printf %s "checking for rl_initialize in -lreadline... " >&6; } +if test ${ac_cv_lib_readline_rl_initialize+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lreadline $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char rl_initialize (); +int +main (void) +{ +return rl_initialize (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_readline_rl_initialize=yes +else $as_nop + ac_cv_lib_readline_rl_initialize=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_rl_initialize" >&5 +printf "%s\n" "$ac_cv_lib_readline_rl_initialize" >&6; } +if test "x$ac_cv_lib_readline_rl_initialize" = xyes +then : + +printf "%s\n" "#define USE_READLINE 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for el_getc in -lreadline" >&5 +printf %s "checking for el_getc in -lreadline... " >&6; } +if test ${ac_cv_lib_readline_el_getc+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lreadline $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char el_getc (); +int +main (void) +{ +return el_getc (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_readline_el_getc=yes +else $as_nop + ac_cv_lib_readline_el_getc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_el_getc" >&5 +printf "%s\n" "$ac_cv_lib_readline_el_getc" >&6; } +if test "x$ac_cv_lib_readline_el_getc" = xyes +then : + +printf "%s\n" "#define READLINE_IS_EDITLINE 1" >>confdefs.h + +fi + + # These tests discover differences between readline 4.1 and 4.3 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 +printf %s "checking for rl_completion_matches in -lreadline... " >&6; } +if test ${ac_cv_lib_readline_rl_completion_matches+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lreadline $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char rl_completion_matches (); +int +main (void) +{ +return rl_completion_matches (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_readline_rl_completion_matches=yes +else $as_nop + ac_cv_lib_readline_rl_completion_matches=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_rl_completion_matches" >&5 +printf "%s\n" "$ac_cv_lib_readline_rl_completion_matches" >&6; } +if test "x$ac_cv_lib_readline_rl_completion_matches" = xyes +then : + +printf "%s\n" "#define HAVE_DECL_RL_COMPLETION_MATCHES 1" >>confdefs.h + + +printf "%s\n" "#define HAVE_RL_COMPENTRY_FUNC_T 1" >>confdefs.h + +fi + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking RL_COMPLETION_ENTRY_FUNCTION_TYPE_FUNCTION" >&5 +printf %s "checking RL_COMPLETION_ENTRY_FUNCTION_TYPE_FUNCTION... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + extern Function *rl_completion_entry_function __attribute__((weak)); + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define RL_COMPLETION_ENTRY_FUNCTION_TYPE_FUNCTION 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking RL_COMPLETION_ENTRY_FUNCTION_TYPE_RL_COMPENTRY_FUNC_T" >&5 +printf %s "checking RL_COMPLETION_ENTRY_FUNCTION_TYPE_RL_COMPENTRY_FUNC_T... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define RL_COMPLETION_ENTRY_FUNCTION_TYPE_RL_COMPENTRY_FUNC_T 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + as_fn_error $? "Unknown rl_completion_entry_function return type" "$LINENO" 5 +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking RL_READLINE_NAME_TYPE_CHAR" >&5 +printf %s "checking RL_READLINE_NAME_TYPE_CHAR... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + extern char *rl_readline_name __attribute__((weak)); + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define RL_READLINE_NAME_TYPE_CHAR 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking RL_READLINE_NAME_TYPE_CONST_CHAR" >&5 +printf %s "checking RL_READLINE_NAME_TYPE_CONST_CHAR... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + extern const char *rl_readline_name __attribute__((weak)); + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define RL_READLINE_NAME_TYPE_CONST_CHAR 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + as_fn_error $? "Unknown rl_readline_name return type" "$LINENO" 5 +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware + RL_OBJS=gcl_readline.o +fi + +fi + +done +fi + + + + +# sockets + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking For network code for nsocket.c" >&5 +printf %s "checking For network code for nsocket.c... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + #include + + #include + #include + #include + + /************* for the sockets ******************/ + #include /* struct sockaddr, SOCK_STREAM, ... */ + #ifndef NO_UNAME + # include /* uname system call. */ + #endif + #include /* struct in_addr, struct sockaddr_in */ + #include /* inet_ntoa() */ + #include /* gethostbyname() */ + +int +main (void) +{ + + connect(0,(struct sockaddr *)0,0); + gethostbyname("jil"); + socket(AF_INET, SOCK_STREAM, 0); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + +printf "%s\n" "#define HAVE_NSOCKET 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking check for listen using fcntl" >&5 +printf %s "checking check for listen using fcntl... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include + +int +main (void) +{ + + FILE *fp=fopen("configure.in","r"); + int orig; + orig = fcntl(fileno(fp), F_GETFL); + if (! (orig & O_NONBLOCK )) return 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define LISTEN_USE_FCNTL 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + + +ac_fn_c_check_func "$LINENO" "profil" "ac_cv_func_profil" +if test "x$ac_cv_func_profil" = xyes +then : + +else $as_nop + +printf "%s\n" "#define NO_PROFILE 1" >>confdefs.h + +fi + + +ac_fn_c_check_func "$LINENO" "setenv" "ac_cv_func_setenv" +if test "x$ac_cv_func_setenv" = xyes +then : + +printf "%s\n" "#define HAVE_SETENV 1" >>confdefs.h + +else $as_nop + no_setenv=1 +fi + + +if test "$no_setenv" = "1" ; then + ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" +if test "x$ac_cv_func_putenv" = xyes +then : + +printf "%s\n" "#define HAVE_PUTENV 1" >>confdefs.h + +fi + + +fi + +ac_fn_c_check_func "$LINENO" "_cleanup" "ac_cv_func__cleanup" +if test "x$ac_cv_func__cleanup" = xyes +then : + +printf "%s\n" "#define USE_CLEANUP 1" >>confdefs.h + +fi + + +gcl_ok=no + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 +printf %s "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } + +case $system in + OSF*) + +printf "%s\n" "#define USE_FIONBIO 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 +printf "%s\n" "FIONBIO" >&6; } + ;; + SunOS-4*) + +printf "%s\n" "#define USE_FIONBIO 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 +printf "%s\n" "FIONBIO" >&6; } + ;; + ULTRIX-4.*) + +printf "%s\n" "#define USE_FIONBIO 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 +printf "%s\n" "FIONBIO" >&6; } + ;; + *) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5 +printf "%s\n" "O_NONBLOCK" >&6; } + ;; +esac + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking check for SV_ONSTACK" >&5 +printf %s "checking check for SV_ONSTACK... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + int joe=SV_ONSTACK; + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define HAVE_SV_ONSTACK 1" >>confdefs.h + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking check for SIGSYS" >&5 +printf %s "checking check for SIGSYS... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + int joe=SIGSYS; + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define HAVE_SIGSYS 1" >>confdefs.h + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking check for SIGEMT" >&5 +printf %s "checking check for SIGEMT... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + int joe=SIGEMT; + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define HAVE_SIGEMT 1" >>confdefs.h + + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + +ac_fn_c_check_func "$LINENO" "sigaltstack" "ac_cv_func_sigaltstack" +if test "x$ac_cv_func_sigaltstack" = xyes +then : + printf "%s\n" "#define HAVE_SIGALTSTACK 1" >>confdefs.h + +fi + +ac_fn_c_check_func "$LINENO" "feenableexcept" "ac_cv_func_feenableexcept" +if test "x$ac_cv_func_feenableexcept" = xyes +then : + printf "%s\n" "#define HAVE_FEENABLEEXCEPT 1" >>confdefs.h + +fi + + + for ac_header in dis-asm.h +do : + ac_fn_c_check_header_compile "$LINENO" "dis-asm.h" "ac_cv_header_dis_asm_h" "$ac_includes_default" +if test "x$ac_cv_header_dis_asm_h" = xyes +then : + printf "%s\n" "#define HAVE_DIS_ASM_H 1" >>confdefs.h + MLIBS=$LIBS + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5 +printf %s "checking for init_disassemble_info in -lopcodes... " >&6; } +if test ${ac_cv_lib_opcodes_init_disassemble_info+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lopcodes $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char init_disassemble_info (); +int +main (void) +{ +return init_disassemble_info (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_opcodes_init_disassemble_info=yes +else $as_nop + ac_cv_lib_opcodes_init_disassemble_info=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_opcodes_init_disassemble_info" >&5 +printf "%s\n" "$ac_cv_lib_opcodes_init_disassemble_info" >&6; } +if test "x$ac_cv_lib_opcodes_init_disassemble_info" = xyes +then : + printf "%s\n" "#define HAVE_LIBOPCODES 1" >>confdefs.h + + LIBS="-lopcodes $LIBS" + +fi + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +printf %s "checking for dlopen in -ldl... " >&6; } +if test ${ac_cv_lib_dl_dlopen+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char dlopen (); +int +main (void) +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_dl_dlopen=yes +else $as_nop + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +printf "%s\n" "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes +then : + #opcodes changes too quickly to link directly + + for ac_func in print_insn_i386 +do : + ac_fn_c_check_func "$LINENO" "print_insn_i386" "ac_cv_func_print_insn_i386" +if test "x$ac_cv_func_print_insn_i386" = xyes +then : + printf "%s\n" "#define HAVE_PRINT_INSN_I386 1" >>confdefs.h + LIBS="$MLIBS -ldl" +fi + +done +fi + +fi + +done + +#if test $use = "386-linux" ; then +ac_fn_c_check_header_compile "$LINENO" "asm/sigcontext.h" "ac_cv_header_asm_sigcontext_h" "$ac_includes_default" +if test "x$ac_cv_header_asm_sigcontext_h" = xyes +then : + printf "%s\n" "#define HAVE_ASM_SIGCONTEXT_H 1" >>confdefs.h + +fi + +ac_fn_c_check_header_compile "$LINENO" "asm/signal.h" "ac_cv_header_asm_signal_h" "$ac_includes_default" +if test "x$ac_cv_header_asm_signal_h" = xyes +then : + printf "%s\n" "#define HAVE_ASM_SIGNAL_H 1" >>confdefs.h + +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 +printf %s "checking for sigcontext...... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + +int +main (void) +{ + + struct sigcontext foo; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define SIGNAL_H_HAS_SIGCONTEXT 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: sigcontext of signal.h" >&5 +printf "%s\n" "sigcontext of signal.h" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT of signal.h" >&5 +printf "%s\n" "sigcontext NOT of signal.h" >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 +printf %s "checking for sigcontext...... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #ifdef HAVE_ASM_SIGCONTEXT_H + #include + #endif + #ifdef HAVE_ASM_SIGNAL_H + #include + #endif + +int +main (void) +{ + + struct sigcontext foo; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define HAVE_SIGCONTEXT 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: sigcontext asm files" >&5 +printf "%s\n" "sigcontext asm files" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 +printf "%s\n" "no sigcontext found" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + +# Extract the first word of "emacs", so it can be a program name with args. +set dummy emacs; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_path_EMACS+y} +then : + printf %s "(cached) " >&6 +else $as_nop + case $EMACS in + [\\/]* | ?:[\\/]*) + ac_cv_path_EMACS="$EMACS" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_path_EMACS="$as_dir$ac_word$ac_exec_ext" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +EMACS=$ac_cv_path_EMACS +if test -n "$EMACS"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $EMACS" >&5 +printf "%s\n" "$EMACS" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + + +# check for where the emacs site lisp directory is. +rm -f conftest.el +cat >> conftest.el <&5 +printf %s "checking emacs site lisp directory... " >&6; } +if [ "$EMACS_SITE_LISP" = "unknown" ] ; then + if [ "$EMACS" != "" ] ; then + EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + else + EMACS_SITE_LISP="" + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $EMACS_SITE_LISP" >&5 +printf "%s\n" "$EMACS_SITE_LISP" >&6; } + + +# check for where the emacs site lisp default.el is +rm -f conftest.el +cat >> conftest.el <&5 +printf %s "checking emacs default.el... " >&6; } +if [ "$EMACS" != "" ] ; then + EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +else + EMACS_DEFAULT_EL="" +fi +if test -f "${EMACS_DEFAULT_EL}" ; then true;else + if test -d $EMACS_SITE_LISP ; then + EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $EMACS_DEFAULT_EL" >&5 +printf "%s\n" "$EMACS_DEFAULT_EL" >&6; } + + + + +# check for where the emacs site lisp info/dir is +rm -f conftest.el +cat >> conftest.el <&5 +printf %s "checking emacs info/dir... " >&6; } +if test "$use" = "mingw" ; then + INFO_DIR=\$\(prefix\)/lib/gcl-$VERSION/info/ +else + if [ "$EMACS" != "" ] && [ "$INFO_DIR" = "unknown" ] ; then + INFO_DIR=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + fi +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $INFO_DIR" >&5 +printf "%s\n" "$INFO_DIR" >&6; } + + +# Check whether --enable-tcltk was given. +if test ${enable_tcltk+y} +then : + enableval=$enable_tcltk; +fi + +# Check whether --enable-tkconfig was given. +if test ${enable_tkconfig+y} +then : + enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval +else $as_nop + TK_CONFIG_PREFIX=unknown +fi + +# Check whether --enable-tclconfig was given. +if test ${enable_tclconfig+y} +then : + enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval +else $as_nop + TCL_CONFIG_PREFIX=unknown +fi + + +if test "$enable_tcltk" != "no" ; then + + if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else + + # Extract the first word of "tclsh", so it can be a program name with args. +set dummy tclsh; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_TCLSH+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$TCLSH"; then + ac_cv_prog_TCLSH="$TCLSH" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_TCLSH="tclsh" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_TCLSH" && ac_cv_prog_TCLSH="${TCLSH}" +fi +fi +TCLSH=$ac_cv_prog_TCLSH +if test -n "$TCLSH"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $TCLSH" >&5 +printf "%s\n" "$TCLSH" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + + if test "${TCLSH}" = "" ; then true ; else + + rm -f conftest.tcl + cat >> conftest.tcl <&5 +printf %s "checking for main in -llieee... " >&6; } +if test ${ac_cv_lib_lieee_main+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-llieee $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main (void) +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_lieee_main=yes +else $as_nop + ac_cv_lib_lieee_main=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lieee_main" >&5 +printf "%s\n" "$ac_cv_lib_lieee_main" >&6; } +if test "x$ac_cv_lib_lieee_main" = xyes +then : + have_ieee=1 +else $as_nop + have_ieee=0 +fi + + if test "$have_ieee" = "0" ; then + TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` + fi + TCL_STUB_LIBS="" + fi + +fi + + + + + + + + + + + + + + + + + + + + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 +printf %s "checking for tcl/tk... " >&6; } +if test -d "${TK_CONFIG_PREFIX}" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&5 +printf "%s\n" "using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: not found" >&5 +printf "%s\n" "not found" >&6; } +fi + +# Check whether --enable-notify was given. +if test ${enable_notify+y} +then : + enableval=$enable_notify; NOTIFY=$enable_notify + +fi + + + +# for sgbc the mprotect capabilities. + +# the time handling for unixtime, add timezone + for ac_header in sys/mman.h +do : + ac_fn_c_check_header_compile "$LINENO" "sys/mman.h" "ac_cv_header_sys_mman_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_mman_h" = xyes +then : + printf "%s\n" "#define HAVE_SYS_MMAN_H 1" >>confdefs.h + ac_fn_c_check_func "$LINENO" "mprotect" "ac_cv_func_mprotect" +if test "x$ac_cv_func_mprotect" = xyes +then : + printf "%s\n" "#define HAVE_MPROTECT 1" >>confdefs.h + +fi + +fi + +done +ac_fn_c_check_header_compile "$LINENO" "alloca.h" "ac_cv_header_alloca_h" "$ac_includes_default" +if test "x$ac_cv_header_alloca_h" = xyes +then : + printf "%s\n" "#define HAVE_ALLOCA_H 1" >>confdefs.h + +fi + +ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" +if test "x$ac_cv_type_size_t" = xyes +then : + +else $as_nop + +printf "%s\n" "#define size_t unsigned int" >>confdefs.h + +fi + +# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works +# for constant arguments. Useless! +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 +printf %s "checking for working alloca.h... " >&6; } +if test ${ac_cv_working_alloca_h+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +char *p = (char *) alloca (2 * sizeof (int)); + if (p) return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_working_alloca_h=yes +else $as_nop + ac_cv_working_alloca_h=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_working_alloca_h" >&5 +printf "%s\n" "$ac_cv_working_alloca_h" >&6; } +if test $ac_cv_working_alloca_h = yes; then + +printf "%s\n" "#define HAVE_ALLOCA_H 1" >>confdefs.h + +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 +printf %s "checking for alloca... " >&6; } +if test ${ac_cv_func_alloca_works+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test $ac_cv_working_alloca_h = yes; then + ac_cv_func_alloca_works=yes +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#ifndef alloca +# ifdef __GNUC__ +# define alloca __builtin_alloca +# elif defined _MSC_VER +# include +# define alloca _alloca +# else +# ifdef __cplusplus +extern "C" +# endif +void *alloca (size_t); +# endif +#endif + +int +main (void) +{ +char *p = (char *) alloca (1); + if (p) return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_func_alloca_works=yes +else $as_nop + ac_cv_func_alloca_works=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_alloca_works" >&5 +printf "%s\n" "$ac_cv_func_alloca_works" >&6; } +fi + +if test $ac_cv_func_alloca_works = yes; then + +printf "%s\n" "#define HAVE_ALLOCA 1" >>confdefs.h + +else + # The SVR3 libPW and SVR4 libucb both contain incompatible functions +# that cause trouble. Some versions do not even contain alloca or +# contain a buggy version. If you still want to use their alloca, +# use ar to extract alloca.o from them instead of compiling alloca.c. + +ALLOCA=\${LIBOBJDIR}alloca.$ac_objext + +printf "%s\n" "#define C_ALLOCA 1" >>confdefs.h + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 +printf %s "checking stack direction for C alloca... " >&6; } +if test ${ac_cv_c_stack_direction+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test "$cross_compiling" = yes +then : + ac_cv_c_stack_direction=0 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +find_stack_direction (int *addr, int depth) +{ + int dir, dummy = 0; + if (! addr) + addr = &dummy; + *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1; + dir = depth ? find_stack_direction (addr, depth - 1) : 0; + return dir + dummy; +} + +int +main (int argc, char **argv) +{ + return find_stack_direction (0, argc + !argv + 20) < 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO" +then : + ac_cv_c_stack_direction=1 +else $as_nop + ac_cv_c_stack_direction=-1 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_stack_direction" >&5 +printf "%s\n" "$ac_cv_c_stack_direction" >&6; } +printf "%s\n" "#define STACK_DIRECTION $ac_cv_c_stack_direction" >>confdefs.h + + +fi + + + +LDFLAGS="`echo $GPL_FLAG $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" + +LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + +CFLAGS="$CFLAGS $GP_FLAG" +FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + +# Work around bug with gcc on ppc -- CM +NIFLAGS="$CFLAGS $CPPFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + +CFLAGS="$CFLAGS $CPPFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + +O3FLAGS=$TO3FLAGS + +O2FLAGS=$TO2FLAGS + + + + + +if test -f h/$use.defs ; then + + + ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +printf "%s\n" "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +as_nop=: +if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else $as_nop + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + + +# Reset variables that may have inherited troublesome values from +# the environment. + +# IFS needs to be set, to space, tab, and newline, in precisely that order. +# (If _AS_PATH_WALK were called with IFS unset, it would have the +# side effect of setting IFS to empty, thus disabling word splitting.) +# Quoting is to prevent editors from complaining about space-tab. +as_nl=' +' +export as_nl +IFS=" "" $as_nl" + +PS1='$ ' +PS2='> ' +PS4='+ ' + +# Ensure predictable behavior from utilities with locale-dependent output. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# We cannot yet rely on "unset" to work, but we need these variables +# to be unset--not just set to an empty or harmless value--now, to +# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct +# also avoids known problems related to "unset" and subshell syntax +# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). +for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH +do eval test \${$as_var+y} \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done + +# Ensure that fds 0, 1, and 2 are open. +if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi +if (exec 3>&2) ; then :; else exec 2>/dev/null; fi + +# The user is always right. +if ${PATH_SEPARATOR+false} :; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + test -r "$as_dir$0" && as_myself=$as_dir$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + printf "%s\n" "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null +then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else $as_nop + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null +then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else $as_nop + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + +# Determine whether it's possible to make 'echo' print without a newline. +# These variables are no longer used directly by Autoconf, but are AC_SUBSTed +# for compatibility with existing Makefiles. +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +# For backward compatibility with old third-party macros, we provide +# the shell variables $as_echo and $as_echo_n. New code should use +# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. +as_echo='printf %s\n' +as_echo_n='printf %s' + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by $as_me, which was +generated by GNU Autoconf 2.71. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration files: +$config_files + +Configuration headers: +$config_headers + +Report bugs to the package provider." + +_ACEOF +ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` +ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config='$ac_cs_config_escaped' +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.71, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2021 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + printf "%s\n" "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + printf "%s\n" "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + printf "%s\n" "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + printf "%s\n" "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "h/gclincl.h") CONFIG_HEADERS="$CONFIG_HEADERS h/gclincl.h" ;; + "makedefc") CONFIG_FILES="$CONFIG_FILES makedefc" ;; + "windows/gcl.iss") CONFIG_FILES="$CONFIG_FILES windows/gcl.iss" ;; + "windows/sysdir.bat") CONFIG_FILES="$CONFIG_FILES windows/sysdir.bat" ;; + "windows/install.lsp") CONFIG_FILES="$CONFIG_FILES windows/install.lsp" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files + test ${CONFIG_HEADERS+y} || CONFIG_HEADERS=$config_headers +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +printf "%s\n" "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`printf "%s\n" "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + printf "%s\n" "/* $configure_input */" >&1 \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +printf "%s\n" "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + printf "%s\n" "/* $configure_input */" >&1 \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi + ;; + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + echo makedefc + cat makedefc + + echo add-defs1 $use + CC=$CC ./add-defs1 $use + +else + echo "Unable to guess machine type" + echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs +fi + diff --git a/configure-new.ac b/configure-new.ac new file mode 100644 index 0000000..760224b --- /dev/null +++ b/configure-new.ac @@ -0,0 +1,1040 @@ +AC_INIT() +AC_CONFIG_HEADER(h/gclincl.h) +# some parts of this configure script are taken from the tcl configure.in + +# Step 1: set the variable "system" to hold the name and version number +# for the system. This can usually be done via the "uname" command, but +# there are a few systems, like Next, where this doesn't work. + + +AC_MSG_CHECKING([system version (for dynamic loading)]) +if machine=`uname -m` ; then true; else machine=unknown ; fi + +AC_CHECK_PROGS(AWK,gawk nawk awk,"") + +AC_CHECK_PROGS(MAKEINFO,makeinfo,"false") +AC_SUBST(MAKEINFO) + +if test -f /usr/lib/NextStep/software_version; then + system=NEXTSTEP-`${AWK} '/3/,/3/' /usr/lib/NextStep/software_version` +else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + AC_MSG_RESULT([unknown (can't find uname command)]) + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird + # results, and the version is kept in special file). + + if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then + system=MP-RAS-`${AWK} '{print $3}' /etc/.relid'` + fi + if test "`uname -s`" = "AIX" ; then + system=AIX-`uname -v`.`uname -r` + fi + AC_MSG_RESULT($system) + fi +fi + +# Find where Data begins. This is used by the storage allocation +# mechanism, in the PAGE macro. This offset is subtracted from +# addresses, in calculating a page for an address in the heap. + +AC_PROG_CC +# can only test for numbers -- CM +# if test "${GCC}" -eq "yes" ; then +if [[ "${GCC}" = "yes" ]] ; then +# Allog for environment variable overrides on compiler selection -- CM +GCC=$CC +else +GCC="" +fi +# subst GCC not only under 386-linux, but where available -- CM +AC_SUBST(GCC) +AC_CHECK_SIZEOF(long *,0) +AC_CHECK_HEADERS(endian.h, + AC_MSG_CHECKING("endianness") + AC_TRY_RUN([#include + int main() { return BYTE_ORDER == __LITTLE_ENDIAN ? 0 : 1;}], + AC_DEFINE(LITTLE_END) AC_MSG_RESULT(little), + AC_MSG_RESULT(big),AC_MSG_RESULT(big))) +AC_SUBST(LITTLE_END) + +AC_MSG_CHECKING("finding DBEGIN") +AC_TRY_RUN([#include + #include +main() +{ + char *b = (void *) malloc(1000); + FILE *fp = fopen("conftest1","w"); + fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)0xffffff); + fclose(fp); + return 0; +}],dbegin=`cat conftest1`,dbegin=0,dbegin=0) +AC_DEFINE_UNQUOTED(DBEGIN,$dbegin \ +/* where data begins */ +) +AC_MSG_RESULT(got $dbegin) + + +AC_MSG_CHECKING("finding CSTACK_ADDRESS") +AC_TRY_RUN([#include +main() +{ + char *b ; + FILE *fp = fopen("conftest1","w"); + fprintf(fp,"%d",((int) &b)); + fclose(fp); + return 0; +}],cstack_address=`cat conftest1`,cstack_address=0,cstack_address=0) +AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address \ +) +AC_MSG_RESULT(got $cstack_address) + + + +AC_MSG_CHECKING("sizeof long long int") +AC_TRY_RUN([#include +main() +{ + if (sizeof(long long int) == 2*sizeof(long)) return 0; + return 1; +} +],[AC_DEFINE(HAVE_LONG_LONG) +AC_MSG_RESULT(yes)], +AC_MSG_RESULT(no), +AC_MSG_RESULT(no) +) + +AC_SUBST(HAVE_LONG_LONG) + +# readline +AC_ARG_ENABLE(readline, + [--enable-readine enables command line completion via the readline library ],, + enable_readline="yes") + +# ansi lisp +AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance, + --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="no") + +if test "$enable_ansi" = "yes" ; then + FLISP=saved_ansi_gcl; +else + FLISP=saved_gcl +fi + +AC_SUBST(FLISP) + +# pagewidth +AC_MSG_CHECKING(for pagewidth) +AC_TRY_RUN([#include + #include +int main() {size_t i=getpagesize(),j; + FILE *fp=fopen("conftest1","w"); + for (j=0;i>>=1;j++); + fprintf(fp,"%u",j); + return 0;}],PAGEWIDTH=`cat conftest1`,PAGEWIDTH=0,PAGEWIDTH=0) +AC_MSG_RESULT($PAGEWIDTH) +AC_DEFINE_UNQUOTED(PAGEWIDTH,$PAGEWIDTH) +AC_SUBST(PAGEWIDTH) + +# bfd probe + +AC_ARG_ENABLE(bfd, + [ --disable-bfd prevents gcl from using libbfd.a for fast object loading and symbol table lookups ] ,, + enable_bfd="yes") + + +# Maximum number of pages + +help="--enable-maxpage=XXXX will compile in a page table of size XXX (default ${default_maxpage})" +AC_ARG_ENABLE(maxpage,[ --enable-maxpage=XXXX will compile in a page table of size XXX (eg '--enable-maxpage=64*1024' would give 64K pages allowing 256 MB if pages are 4K each)] , +[AC_DEFINE_UNQUOTED(MAXPAGE,$enable_maxpage)] +) + +AC_ARG_ENABLE(vssize,[ --enable-vssize=XXXX will compile in a value stack of size XXX] , +[AC_DEFINE_UNQUOTED(VSSIZE,$enable_vssize)] +) + +AC_ARG_ENABLE(machine,[ --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs] , +[enable_machine=$enableval],[enable_machine=""]) + +AC_ARG_ENABLE(gmp,[ --enable-gmp=no will disable use of GMP gnu multiprecision arithmetic, (default is =yes)] , +[use_gmp=$enableval],[use_gmp="yes"]) + +AC_ARG_ENABLE(notify,[ --enable-notify=no will disable the automatic notification of gcl maintainers of successful builds/problems] , +[enable_notify=$enableval],[enable_notify="yes"]) + +AC_ARG_ENABLE(tkconfig,[ --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh ] , +[TK_CONFIG_PREFIX=$enableval],[TK_CONFIG_PREFIX="unknown"]) + + +AC_ARG_ENABLE(tclconfig,[ --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh ] , +[TCL_CONFIG_PREFIX=$enableval],[TCL_CONFIG_PREFIX="unknown"]) + + +AC_ARG_ENABLE(infodir,[ --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info ] , +[INFO_DIR=$enableval],[INFO_DIR="unknown"]) + + + + +# Check if Posix compliant getcwd exists, if not we'll use getwd. +AC_CHECK_FUNCS(getcwd) +AC_CHECK_FUNCS(getwd) +AC_CHECK_FUNC(uname, , AC_DEFINE(NO_UNAME)) +AC_CHECK_FUNC(gettimeofday, , AC_DEFINE(NO_GETTOD)) + + +AC_CHECK_HEADERS(sys/ioctl.h) + + +#-------------------------------------------------------------------- +# The code below deals with several issues related to gettimeofday: +# 1. Some systems don't provide a gettimeofday function at all +# (set NO_GETTOD if this is the case). +# 2. SGI systems don't use the BSD form of the gettimeofday function, +# but they have a BSDgettimeofday function that can be used instead. +# 3. See if gettimeofday is declared in the header file. +# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can +# declare it. +#-------------------------------------------------------------------- + +AC_CHECK_FUNC([BSDgettimeofday], + [AC_DEFINE(HAVE_BSDGETTIMEOFDAY)], + [AC_CHECK_FUNC([gettimeofday], , + [AC_DEFINE([NO_GETTOD])])]) + +AC_MSG_CHECKING([for gettimeofday declaration]) + +AC_EGREP_HEADER([gettimeofday], + [sys/time.h], + [AC_MSG_RESULT([present])], + [AC_MSG_RESULT([missing]) + AC_DEFINE(GETTOD_NOT_DECLARED)]) + + +AC_CHECK_LIB(m,sin,LIBS="${LIBS} -lm",true) +AC_CHECK_LIB(mingwex,main,LIBS="${LIBS} -lmingwex",true) + +# Should really find a way to check for prototypes, but this +# basically works for now. CM +# +AC_CHECK_HEADERS(math.h,AC_DEFINE(NEED_MATH_H)) + +# +# The second alternative is for solaris. This needs to be +# a more comprehensive later, i.e. checking that the fpclass +# test makes sense. CM +# +AC_MSG_CHECKING([for isnormal]) +AC_TRY_RUN([#define _GNU_SOURCE + #include + int main() { + float f; + return isnormal(f) || !isnormal(f) ? 0 : 1; + }], + AC_DEFINE(HAVE_ISNORMAL) AC_MSG_RESULT(yes), + AC_MSG_CHECKING([for fpclass in ieeefp.h]) + AC_TRY_RUN([#include + int main() { + float f; + return fpclass(f)>=FP_NZERO || fpclass(f) + int main() { + float f; + return isfinite(f) || !isfinite(f) ? 0 : 1; + }], + AC_DEFINE(HAVE_ISFINITE) AC_MSG_RESULT(yes), + AC_MSG_CHECKING([for finite()]) + AC_TRY_RUN([#include + int main() { + float f; + return finite(f) || !finite(f) ? 0 : 1; + }], + AC_DEFINE(HAVE_FINITE) AC_MSG_RESULT(yes), + HAVE_FINITE=0 AC_MSG_RESULT(no),HAVE_FINITE=0 AC_MSG_RESULT(no)) + ,HAVE_ISFINITE=0 AC_MSG_RESULT(no),HAVE_ISFINITE=0 AC_MSG_RESULT(no)) + + + +#-------------------------------------------------------------------- +# Check for the existence of the -lsocket and -lnsl libraries. +# The order here is important, so that they end up in the right +# order in the command line generated by make. Here are some +# special considerations: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- +AC_MSG_CHECKING([for sockets]) +tcl_checkBoth=0 +AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1) +if test "$tcl_checkSocket" = 1; then + AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", tcl_checkBoth=1) +fi + + +if test "$tcl_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs]) +fi +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) + +if test "$enable_readline" = "yes" ; then + AC_CHECK_LIB([readline], + [main], + [AC_DEFINE(HAVE_READLINE) + LIBS="$LIBS -lreadline -lncurses" + RL_OBJS=readline.o + RL_LIB=lsp/readline.o],, + [-lncurses]) +fi + +if test "$enable_bfd" = "yes" ; then + AC_CHECK_HEADER(bfd.h, + AC_CHECK_LIB(bfd,bfd_init, + if $CC -v 2>&1 | fgrep ming > /dev/null ; then + BFDLIB="-lbfd" + IBRLIB="-liberty" + else + echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c + MP=`$GCC [[ -Wl,-M ]] -static -o foo foo.c -lbfd -liberty 2>&1 | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` + rm -f foo.c foo + BFDLIB=`echo $MP | tr ' ' '\012' | grep libbfd.a` + IBRLIB=`echo $MP | tr ' ' '\012' | grep libiberty.a` + fi +# +# Old binutils appear to need CONST defined to const +# + AC_MSG_CHECKING(if need to define CONST for bfd) + AC_TRY_RUN([#define IN_GCC + #include + int main() { symbol_info t; return 0;}], + AC_MSG_RESULT(no) + AC_DEFINE(HAVE_LIBBFD) + LIBS="$LIBS $BFDLIB $IBRLIB", + AC_TRY_RUN([#define IN_GCC + #include + #define CONST const + int main() {symbol_info t; return 0;}], + AC_MSG_RESULT(yes) + AC_DEFINE(NEED_CONST) + AC_DEFINE(HAVE_LIBBFD) + LIBS="$LIBS $BFDLIB $IBRLIB", + AC_MSG_RESULT(cannot use bfd),AC_MSG_RESULT(cannot use bfd)), + AC_MSG_RESULT(cannot use bfd)) + + ,,-liberty)) +fi + +AC_SUBST(LIBS) +AC_SUBST(RL_OBJS) +AC_SUBST(RL_LIB) + +AC_MSG_CHECKING(For network code for nsocket.c) +AC_TRY_LINK([ +#include +#include +#include + +#include +#include +#include + +/************* for the sockets ******************/ +#include /* struct sockaddr, SOCK_STREAM, ... */ +#ifndef NO_UNAME +# include /* uname system call. */ +#endif +#include /* struct in_addr, struct sockaddr_in */ +#include /* inet_ntoa() */ +#include /* gethostbyname() */ +],[ connect(0,(struct sockaddr *)0,0); + gethostbyname("jil"); + socket(AF_INET, SOCK_STREAM, 0); + ], +[AC_DEFINE(HAVE_NSOCKET) + AC_MSG_RESULT(yes)], +AC_MSG_RESULT(no)) + + +AC_MSG_CHECKING(check for listen using fcntl) +AC_TRY_COMPILE([#include +#include +], +[FILE *fp=fopen("configure.in","r"); + int orig; + orig = fcntl(fileno(fp), F_GETFL); + if (! (orig & O_NONBLOCK )) return 0; +], +[AC_DEFINE(LISTEN_USE_FCNTL) + AC_MSG_RESULT(yes)], +AC_MSG_RESULT(no)) + + + + +AC_CHECK_FUNC(profil, ,[AC_DEFINE(NO_PROFILE)]) +AC_SUBST(NO_PROFILE) +AC_CHECK_FUNC(setenv,[AC_DEFINE(HAVE_SETENV)],no_setenv=1 ) +AC_SUBST(HAVE_SETENV) +if test "$no_setenv" = "1" ; then +AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV)],) +AC_SUBST(HAVE_PUTENV) +fi + +AC_CHECK_FUNC(_cleanup, [AC_DEFINE(USE_CLEANUP)],) +AC_SUBST(USE_CLEANUP) +gcl_ok=no + +AC_HEADER_EGREP(LITTLE_ENDIAN, ctype.h, gcl_ok=yes, gcl_ok=noo) +if test $gcl_ok = yes ; then +AC_DEFINE(ENDIAN_ALREADY_DEFINED) +fi + +AC_SUBST(ENDIAN_ALREADY_DEFINED) + + + + +# if test "x$enable_machine" = "x" ; then +AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) + +case $system in + OSF*) + AC_DEFINE(USE_FIONBIO) + AC_MSG_RESULT(FIONBIO) + ;; + SunOS-4*) + AC_DEFINE(USE_FIONBIO) + AC_MSG_RESULT(FIONBIO) + ;; + ULTRIX-4.*) + AC_DEFINE(USE_FIONBIO) + AC_MSG_RESULT(FIONBIO) + ;; + *) + AC_MSG_RESULT(O_NONBLOCK) + ;; +esac + + +AC_CANONICAL_HOST +canonical=$host +## host=CPU-COMPANY-SYSTEM +AC_MSG_RESULT(host=$host) + +use=unknown + +case $canonical in + older) + use=386-bsd;; + + *86-*-linux*) + use=386-linux; ln -snf linux.defs h/$use.defs;; + + m68k-*-linux*) + use=m68k-linux; ln -snf linux.defs h/$use.defs;; + + alpha*-*-linux*) + use=alpha-linux; ln -snf linux.defs h/$use.defs;; + + mips-*-linux*) + use=mips-linux; ln -snf linux.defs h/$use.defs;; + + mipsel-*-linux*) + use=mipsel-linux; ln -snf linux.defs h/$use.defs;; + + sparc*-*-linux*) + use=sparc-linux; ln -snf linux.defs h/$use.defs;; + + arm*-*-linux*) + use=arm-linux; ln -snf linux.defs h/$use.defs;; + + s390-*-linux*) + use=s390-linux; ln -snf linux.defs h/$use.defs;; + + ia64-*-linux*) + use=ia64-linux; ln -snf linux.defs h/$use.defs;; + + hppa-*-linux*) + use=hppa-linux; ln -snf linux.defs h/$use.defs;; + + powerpc-*-linux*) + use=powerpc-linux; ln -snf linux.defs h/$use.defs;; + + alpha-dec-osf) + use=alpha-osf1;; + + mips-dec-ultrix) + use=dec3100;; + + old) + use=dos-go32;; + + *86*-freebsd) + use=FreeBSD;; + + hp3*-*hpux*) + use=hp300;; + + hp3*-*-*bsd*) + use=hp300-bsd;; + + hppa*-*hpux*) + use=hp800;; + + mips-sgi-irix) + case $system in + IRIX5*) + use=irix5;; + IRIX6*) + use=irix6;; + IRIX3*) + use=sgi4d;; + esac ;; + + + m68k-apple-aux*) + use=mac2;; + + old) + use=mp386;; + + *86-ncr-sysv4) + use=ncr;; + + *[3-9]86-*netbsd*) + use=NetBSD;; + + old) + use=NeXT;; + + old) + use=NeXT30-m68k;; + + *86-*nextstep*) + use=NeXT32-i386;; + + *m68*-*nextstep*) + use=NeXT32-m68k;; + + *rs6000-*-aix4*) + use=rios;; + + *rs6000-*-aix3*) + use=rios-aix3;; + + old) + use=rt_aix;; + + old) + use=sgi;; + + sparc-sun-solaris*) + use=solaris;; + + i?86-pc-solaris*) + use=solaris-i386;; + + sparc-*-linux*) + use=sparc-linux;; + + old) + use=sun2r3;; + + old) + use=sun3;; + + m68*-sunos*) + use=sun3-os4;; + + old) + use=sun386i;; + + sparc*sunos*) + use=sun4;; + + *86-sequent-dynix) + use=symmetry;; + + u370*aix) + use=u370_aix;; + + old) + use=vax;; + + i*cygwin*) + if $CC -v 2>&1 | fgrep ming > /dev/null ; + then use=mingw + else use=gnuwin95 + fi;; + + +esac +AC_MSG_CHECKING(check for SV_ONSTACK) +AC_TRY_COMPILE([#include +int joe=SV_ONSTACK; +], +[], +[AC_DEFINE(HAVE_SV_ONSTACK) + AC_SUBST(HAVE_SV_ONSTACK) + AC_MSG_RESULT(yes)], +AC_MSG_RESULT(no)) + + +AC_MSG_CHECKING(check for SIGSYS) +AC_TRY_COMPILE([#include +int joe=SIGSYS; +], +[], +[AC_DEFINE(HAVE_SIGSYS) + AC_SUBST(HAVE_SIGSYS) + AC_MSG_RESULT(yes)], +AC_MSG_RESULT(no)) + + +AC_MSG_CHECKING(check for SIGEMT) +AC_TRY_COMPILE([#include +int joe=SIGEMT; +], +[], +[AC_DEFINE(HAVE_SIGEMT) + AC_SUBST(HAVE_SIGEMT) + AC_MSG_RESULT(yes)], +AC_MSG_RESULT(no)) + + + + +#if test $use = "386-linux" ; then + AC_CHECK_HEADERS(asm/sigcontext.h) + AC_CHECK_HEADERS(asm/signal.h) + AC_TRY_COMPILE([#include + long code; + ], + [ + void *p = ((void *)(((struct sigcontext_struct *)(&code)))); + ], + [ + sigcontext_struct_works=1; + AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT) + AC_MSG_RESULT("sigcontext in signal.h") + ], + + [sigcontext_struct_works=0; + AC_MSG_RESULT("sigcontext NOT in signal.h")] + ) + if test "$sigcontext_struct_works" = 0 ; then + AC_TRY_COMPILE([#include + #ifdef HAVE_ASM_SIGCONTEXT_H + #include + #endif + #ifdef HAVE_ASM_SIGNAL_H + #include + #endif + long code; + ], + [ + void *p = ((void *)(((struct sigcontext *)(&code)))); + ], + [ + sigcontext_works=1 ; + AC_DEFINE(HAVE_SIGCONTEXT) + AC_MSG_RESULT("use struct sigcontext") + ], + [ + sigcontext_works=0 ; + ]) + + + fi +# echo 'foo() {}' > conftest1.c +# $CC -S conftest1.c +# use_underscore=0 +# if fgrep _foo conftest1.s ; then use_underscore=1 ; fi +# if test $use_underscore = 0 ; then +# MPI_FILE=mpi-386_no_under.o +# else +# MPI_FILE=mpi-386d.o +# fi +# AC_SUBST(MPI_FILE) +# GCC=$CC +# if test -x /usr/bin/i386-glibc20-linux-gcc ; then +# GCC=/usr/bin/i386-glibc20-linux-gcc +# fi +# AC_SUBST(GCC) + +#fi + +AC_PATH_PROG(EMACS,emacs) + + +# check for where the emacs site lisp directory is. +rm -f conftest.el +cat >> conftest.el <&1 | sed -e /Loading/d | sed -e /load/d ` +else + EMACS_SITE_LISP="" +fi +AC_MSG_RESULT($EMACS_SITE_LISP) +AC_SUBST(EMACS_SITE_LISP) + +# check for where the emacs site lisp default.el is +rm -f conftest.el +cat >> conftest.el <&1 | sed -e /Loading/d | sed -e /load/d ` +else + EMACS_DEFAULT_EL="" +fi +if test -f "${EMACS_DEFAULT_EL}" ; then true;else + if test -d "$EMACS_SITE_LISP" ; then + EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el + fi +fi +AC_MSG_RESULT($EMACS_DEFAULT_EL) +AC_SUBST(EMACS_DEFAULT_EL) + + + +# check for where the emacs site lisp info/dir is +rm -f conftest.el +cat >> conftest.el <&1 | sed -e /Loading/d | sed -e /load/d ` +fi +if test -f "${INFO_DIR}dir" ; then true;else +if test -f /usr/info/dir ; then + INFO_DIR=/usr/info/ +else true; +fi +fi +AC_MSG_RESULT($INFO_DIR) +AC_SUBST(INFO_DIR) + +AC_MSG_CHECKING([for tcl/tk]) + + +if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else +rm -f conftest.tcl +cat >> conftest.tcl <> conftest.tcl <&1 | ${AWK} '/"source / {if (i++) next;sub("/[[^/]]*$","",$2);print $2}'` +fi + +fi +fi +#AC_MSG_CHECKING(TK_CONFIG_PREFIX=${TK_CONFIG_PREFIX}) +if test -f ${TK_CONFIG_PREFIX}/tkConfig.sh ; then . ${TK_CONFIG_PREFIX}/tkConfig.sh ; fi + +if test -d ${TK_CONFIG_PREFIX}/tk${TK_VERSION} ; then + TK_LIBRARY=${TK_CONFIG_PREFIX}/tk${TK_VERSION} + else + if test -d ${TK_CONFIG_PREFIX}/../tk${TK_VERSION} ; then + TK_LIBRARY=${TK_CONFIG_PREFIX}/../tk${TK_VERSION} + fi +fi +if test -d ${TK_CONFIG_PREFIX}/tcl${TCL_VERSION} ; then + TCL_LIBRARY=${TK_CONFIG_PREFIX}/tcl${TCL_VERSION} + else + if test -d ${TK_CONFIG_PREFIX}/../tcl${TCL_VERSION} ; then + TCL_LIBRARY=${TK_CONFIG_PREFIX}/../tcl${TCL_VERSION} + fi +fi +if test -f ${TK_CONFIG_PREFIX}/../include/tk.h ; then + TK_INCLUDE=-I${TK_CONFIG_PREFIX}/../include + else + if test -f /usr/include/tcl${TCL_VERSION}/tk.h ; then + TK_INCLUDE=-I/usr/include/tcl${TCL_VERSION} + fi +fi +if test -f ${TCL_CONFIG_PREFIX}/../include/tcl.h ; then + TCL_INCLUDE=-I${TCL_CONFIG_PREFIX}/../include + else + if test -f /usr/include/tcl${TCL_VERSION}/tcl.h ; then + TCL_INCLUDE=-I/usr/include/tcl${TCL_VERSION} + fi +fi +AC_CHECK_LIB(lieee,main,have_ieee=1,have_ieee=0) +if test "$have_ieee" = "0" ; then + TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` +fi +AC_CHECK_LIB(dl,dlopen,have_dl=1,have_dl=0) +if test "$have_dl" = "0" ; then + TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-ldl::g"` +fi + +AC_SUBST(TK_CONFIG_PREFIX) +AC_SUBST(TK_LIBRARY) +AC_SUBST(TCL_LIBRARY) +AC_SUBST(TK_XINCLUDES) +AC_SUBST(TK_INCLUDE) +AC_SUBST(TCL_INCLUDE) +AC_SUBST(TK_LIB_SPEC) +AC_SUBST(TK_BUILD_LIB_SPEC) +AC_SUBST(TK_XLIBSW) +AC_SUBST(TK_XINCLUDES) +AC_SUBST(TCL_LIB_SPEC) +AC_SUBST(TCL_DL_LIBS) +AC_SUBST(TCL_LIBS) + + + + + + +if test -d "${TK_CONFIG_PREFIX}" ; then +AC_MSG_RESULT([using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}]) +else +AC_MSG_RESULT([not found]) +fi + +NOTIFY=$enable_notify +AC_SUBST(NOTIFY) + + + + + +echo enable_machine=$enable_machine +if test "x$enable_machine" != "x" ; then + use=$enable_machine +fi + +## finally warn if we did not find a recognized machine.s +## +#if test "$use" = "unknown" ; then +#types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` +#echo got canonical=$canonical, but was not recognized. +#echo Unable to guess type to use. Try one of +#exit(1) +#fi + +AC_MSG_RESULT(use=$use) + + + + +# for sgbc the mprotect capabilities. + +# the time handling for unixtime, add timezone + +AC_MSG_CHECKING([alloca]) +AC_TRY_RUN([int main() { exit(alloca(500) != NULL ? 0 : 1);}], + ,gcl_ok=yes, gcl_ok=no,gcl_ok=no) +if test $gcl_ok = yes ; then + AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_ALLOCA) +else + AC_TRY_RUN([#include + int main() { exit(alloca(500) != NULL ? 0 : 1)}], + ,gcl_ok=yes, gcl_ok=no,gcl_ok=no) + if test $gcl_ok = yes ; then + AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_ALLOCA) + AC_DEFINE(NEED_ALLOCA_H) + fi +fi +if test $gcl_ok = no ; then AC_MSG_RESULT(no) ; fi + + + + + + + + + + +# alloca + +# dlopen etc +# idea make it so you do something dlopen(libX.so,RTLD_GLOBAL) +# then dlload("foo.o") a lisp file can refer to things in libX.so +# + +# what machine this is, and include then a machine specific hdr. +# and machine specific defs. + +# check bzero, + +# check getcwd, getwd etc.. + + + + +# check socket stuff.. + +# getrlimit + +# fionread or block + +rm -f makedefsafter + +MP_INLCUDE="" +if test $use_gmp = yes ; then + AC_MSG_CHECKING([use_gmp=yes, doing configure in gmp directory]) + case "${canonical}" in +# i[[5-9]]86* | pentium* | k6* | athlon*) +# (cd gmp ; ./configure --target=i486) ;; + *) + (cd gmp ; ./configure) ;; + esac + [[ "`ls -1 gmp/mpn/add_n.* 2>/dev/null`" != "" ]] || cp gmp/mpn/generic/*.c gmp/mpn/ + AC_MSG_CHECKING("for size of gmp limbs") + AC_TRY_RUN([#include + #include "h/gmp.h" + + int main() { + FILE *fp=fopen("conftest1","w"); + fprintf(fp,"%u",sizeof(mp_limb_t)); + fclose(fp); + return 0; +}],mpsize=`cat conftest1`,mpsize=0,mpsize=0) + if test "$mpsize" = "0" ; then + echo "Cannot determine mpsize" + exit 1 + fi + AC_DEFINE_UNQUOTED(MP_LIMB_BYTES,$mpsize) + AC_MSG_RESULT($mpsize) + GMP=1 + AC_DEFINE(GMP) + AC_SUBST(GMP) + MP_INCLUDE=h/gmp.h + echo > makedefsafter + echo 'MPFILES=${GMP_DIR}libgmp.a' >> makedefsafter + echo >> makedefsafter +fi +AC_SUBST(MP_INCLUDE) + +# redhat/cygnus released for some reason a buggy version of gcc, +# which no one else released. Catch that here. +AC_MSG_CHECKING([Checking for buggy gcc version from redhat]) +if 2>&1 $CC -v | fgrep "gcc version 2.96" > /dev/null + then + BROKEN_O4_OPT=1 + AC_DEFINE(BROKEN_O4_OPT) + AC_SUBST(BROKEN_O4_OPT) + echo ODIR_DEBUG=-O >> makedefsafter + echo >> makedefsafter + AC_MSG_RESULT([yes .. turning off -O4]) + else + AC_MSG_RESULT([no]) +fi + + +if test -f h/$use.defs ; then + + AC_SUBST(use) + AC_OUTPUT(makedefc) + echo makedefc + cat makedefc + + echo add-defs1 $use + CC=$CC ./add-defs1 $use + +else + echo "Unable to guess machine type" + echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs +fi diff --git a/configure.in b/configure.in new file mode 100644 index 0000000..a9cfe64 --- /dev/null +++ b/configure.in @@ -0,0 +1,2230 @@ +AC_INIT +AC_PREREQ([2.68]) +AC_CONFIG_HEADERS([h/gclincl.h]) + +VERSION=`cat majvers`.`cat minvers` +AC_SUBST(VERSION) + + +# +# Host information +# + + +AC_CANONICAL_HOST +canonical=$host +my_host_kernel=`echo $host_os | awk '{j=split($1,A,"-");print A[[1]]}'` +my_host_system=`echo $host_os | awk '{j=split($1,A,"-");if (j>=2) print A[[2]]}'` +AC_DEFINE_UNQUOTED(HOST_CPU,"`echo $host_cpu | awk '{print toupper($0)}'`",[Host cpu]) +AC_DEFINE_UNQUOTED(HOST_KERNEL,"`echo $my_host_kernel | awk '{print toupper($0)}'`",[Host kernel]) +if test "$my_host_system" != "" ; then + AC_DEFINE_UNQUOTED(HOST_SYSTEM,"`echo $my_host_system | awk '{print toupper($0)}'`",[Host system]) +fi +## host=CPU-COMPANY-SYSTEM +AC_MSG_RESULT(host=$host) + +use=unknown +case $canonical in + sh4*linux*) use=sh4-linux;; + *x86_64*linux*) use=amd64-linux;; + *x86_64*kfreebsd*) use=amd64-kfreebsd;; + *86*linux*) use=386-linux;; + *riscv64*linux*) use=riscv64-linux;; + *86*kfreebsd*) use=386-kfreebsd;; + *86*gnu*) use=386-gnu;; + m68k*linux*) use=m68k-linux;; + alpha*linux*) use=alpha-linux;; + mips*linux*) use=mips-linux;; + mipsel*linux*) use=mipsel-linux;; + sparc*linux*) use=sparc-linux;; + aarch64*linux*) use=aarch64-linux;; + arm*linux*hf) use=armhf-linux;; + arm*linux*) use=arm-linux;; + s390*linux*) use=s390-linux;; + ia64*linux*) use=ia64-linux;; + hppa*linux*) use=hppa-linux;; + powerpc*linux*) use=powerpc-linux;; + powerpc-*-darwin*) use=powerpc-macosx;; + *86*darwin*) use=386-macosx;; + i*mingw*|i*msys*) use=mingw;; + *cygwin*) + if $CC -v 2>&1 | fgrep ming > /dev/null ; + then use=mingw + else use=gnuwin95 + fi;; + *openbsd*) use=FreeBSD;; + sparc-sun-solaris*) use=solaris;; + i?86-pc-solaris*) use=solaris-i386;; +esac + +AC_ARG_ENABLE([machine],[ --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs], + [echo enable_machine=$enableval ; use=$enableval]) + +AC_MSG_RESULT([use=$use]) + +def_dlopen="no" +def_statsysbfd="no" +def_custreloc="yes" +def_oldgmp="no" +def_pic="no"; +def_static="no"; +def_debug="no"; +case $use in + *kfreebsd) + ln -snf linux.defs h/$use.defs;; + *gnu) + ln -snf linux.defs h/$use.defs;; + *linux) + ln -snf linux.defs h/$use.defs; + case $use in + ia64*) + def_dlopen="yes" ; def_custreloc="no" ;; + hppa*) + def_pic="yes" ;; + esac;; +esac + +AC_ARG_ENABLE([widecons],[ --enable-widecons will use a three word cons with simplified typing], + [if test "$enableval" = "yes" ; then AC_DEFINE([WIDE_CONS],[1],[three word cons]) fi]) + +AC_ARG_ENABLE([safecdr],[ --enable-safecdr will protect cdr from immfix and speed up type processing], + [if test "$enableval" = "yes" ; then + AC_DEFINE([USE_SAFE_CDR],[1],[protect cdr from immfix and speed up type processing]) + AC_ARG_ENABLE([safecdrdbg],[ --enable-safecdrdbg will debug safecdr code], + [if test "$enableval" = "yes" ; then AC_DEFINE([DEBUG_SAFE_CDR],[1],[debug safecdr code]) fi]) + fi]) + +AC_ARG_ENABLE([prelink],[ --enable-prelink will insist that the produced images may be prelinked], + [if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi]) +AC_SUBST(PRELINK_CHECK) + +AC_ARG_ENABLE([vssize],[ --enable-vssize=XXXX will compile in a value stack of size XXX], + [AC_DEFINE_UNQUOTED(VSSIZE,$enableval,[value stack size])]) +AC_ARG_ENABLE([bdssize],[ --enable-bdssize=XXXX will compile in a binding stack of size XXX], + [AC_DEFINE_UNQUOTED(BDSSIZE,$enableval,[binding stack size])]) +AC_ARG_ENABLE([ihssize],[ --enable-ihssize=XXXX will compile in a invocation history stack of size XXX], + [AC_DEFINE_UNQUOTED(IHSSIZE,$enableval,[invocation history stack size])]) +AC_ARG_ENABLE([frssize],[ --enable-frssize=XXXX will compile in a frame stack of size XXX], + [AC_DEFINE_UNQUOTED(FRSSIZE,$enableval,[frame stack size])]) + +AC_ARG_ENABLE([infodir],[ --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info], + [INFO_DIR=$enableval],[INFO_DIR=$prefix/share/info]) +INFO_DIR=`eval echo $INFO_DIR/` + +AC_ARG_ENABLE([emacsdir],[ --enable-emacsdir=XXXX will manually specify the location for elisp files], + [EMACS_SITE_LISP=$enableval],[EMACS_SITE_LISP=$prefix/share/emacs/site-lisp]) +EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` + +AC_ARG_ENABLE([xgcl],[ --enable-xgcl=yes will compile in support for XGCL],,[enable_xgcl=yes]) + +AC_ARG_ENABLE([dlopen],[ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images], + ,[enable_dlopen=$def_dlopen]) +AC_ARG_ENABLE([statsysbfd],[ --enable-statsysbfd uses a static system bfd library for loading and relocating object files], + ,[enable_statsysbfd=$def_statsysbfd]) +AC_ARG_ENABLE([dynsysbfd],[ --enable-dynsysbfd uses a dynamic shared system bfd library for loading and relocating object files], + ,[enable_dynsysbfd=no]) +AC_ARG_ENABLE([custreloc],[ --enable-custreloc uses custom gcl code if available for loading and relocationing object files], + ,[enable_custreloc=$def_custreloc]) + +AC_ARG_ENABLE([debug],[ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb], + ,[enable_debug=$def_debug]) +AC_ARG_ENABLE([static],[ --enable-static will link your GCL against static as opposed to shared system libraries], + ,[enable_static=$def_static]) +AC_ARG_ENABLE([pic],[ --enable-pic builds gcl with -fPIC in CFLAGS],,[enable_pic=$def_pic]) + +load_opt=0 +if test "$enable_dlopen" = "yes" ; then + load_opt=1 +fi +if test "$enable_statsysbfd" = "yes" ; then + case $load_opt in + 0) load_opt=1;; + 1) load_opt=2;; + esac +fi +if test "$enable_dynsysbfd" = "yes" ; then + case $load_opt in + 0) load_opt=1;; + 1) load_opt=2;; + 2) load_opt=3;; + esac +fi +if test "$enable_custreloc" = "yes" ; then + case $load_opt in + 0) load_opt=1;; + 1) load_opt=2;; + 2) load_opt=3;; + 3) load_opt=4;; + 4) load_opt=5;; + esac +fi + +if test "$load_opt" != "1" ; then + echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" + AC_MSG_ERROR([loader option failure]) +fi + + +# +# System programs +# + +# We set the default CFLAGS below, and don't want the autoconf default +# CM 20040106 +if test "$CFLAGS" = "" ; then + CFLAGS=" " +fi +if test "$LDFLAGS" = "" ; then + LDFLAGS=" " +fi + +AC_PROG_CC +AC_PROG_CPP +AC_SUBST(CC) + +add_arg_to_cflags() { + + AC_MSG_CHECKING([for CFLAG $1]) + CFLAGS_ORI=$CFLAGS + CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" + AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]],[[]])], + [CFLAGS="$CFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], + [AC_MSG_RESULT([no])], + [AC_MSG_RESULT([no])]) + CFLAGS=$CFLAGS_ORI + return 1 + +} + +assert_arg_to_cflags() { + if ! add_arg_to_cflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi + return 0 +} + +add_args_to_cflags() { + + while test "$#" -ge 1 ; do + add_arg_to_cflags $1 + shift + done +} + +add_arg_to_ldflags() { + + AC_MSG_CHECKING([for LDFLAG $1]) + LDFLAGS_ORI=$LDFLAGS + LDFLAGS="$LDFLAGS -Werror $1" + AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]],[[]])], + [LDFLAGS="$LDFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], + [AC_MSG_RESULT([no])], + [AC_MSG_RESULT([no])]) + LDFLAGS=$LDFLAGS_ORI + return 1 + +} + +assert_arg_to_ldflags() { + if ! add_arg_to_ldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi + return 0 +} + +add_args_to_ldflags() { + + while test "$#" -ge 1 ; do + add_arg_to_ldflags $1 + shift + done +} + +remove_arg_from_ldflags() { + + NEW_LDFLAGS="" + for i in $LDFLAGS; do + if ! test "$i" = "$1" ; then + NEW_LDFLAGS="$NEW_LDFLAGS $i" + else + AC_MSG_RESULT([removing $1 from LDFLAGS]) + fi + done + LDFLAGS=$NEW_LDFLAGS + + return 0 + +} + +add_args_to_cflags -fsigned-char -pipe -fcommon \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable + +add_args_to_ldflags -no-pie # -Wl,-z,lazy + +AC_MSG_CHECKING([for inline semantics]) +AC_COMPILE_IFELSE( + [AC_LANG_SOURCE([[ + inline int foo(int i) {return i;} + + int + bar(int i) {return foo(i);} + ]])], + [if `nm conftest.o |grep foo |awk '{if (NF==3) exit(-1)}'` ; then + AC_MSG_RESULT([new]) + else + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE([[ + extern inline int foo(int i) {return i;} + + int + bar(int i) {return foo(i);} + ]])], + [if `nm conftest.o |grep foo |awk '{if (NF==3) exit(-1)}'` ; then + AC_MSG_RESULT([old]) + AC_DEFINE([OLD_INLINE],[1],[extern inline semantics]) + else + AC_MSG_ERROR([need working inline semantics]) + fi], + [AC_MSG_ERROR([need to probe inline semantics])]) + fi], + [AC_MSG_ERROR([need to probe inline semantics])]) + +AC_MSG_CHECKING([for clang]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[ + #ifdef __clang__ + #define RET 0 + #else + #define RET 1 + #endif + ]], + [[ + return RET; + ]])], + [AC_MSG_RESULT([yes]) + clang="yes" + remove_arg_from_ldflags -pie + AC_DEFINE([CLANG],[1],[running clang compiler])], + [AC_MSG_RESULT([no])]) + +case $use in + *mingw*) + assert_arg_to_cflags -fno-zero-initialized-in-bss + assert_arg_to_cflags -mms-bitfields + for i in makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp h/gclincl.h; do + cat $i.in | sed 's,[^\r]\n$,\r\n,g' >tmp && mv tmp $i.in; + done + OLD_LDFLAGS=$LDFLAGS + assert_arg_to_ldflags -pg + GPL_FLAG="-pg" + LDFLAGS=$OLD_LDFLAGS;; + *gnuwin*) + assert_arg_to_cflags -fno-zero-initialized-in-bss + assert_arg_to_cflags -mms-bitfields + assert_arg_to_ldflags -Wl,--stack,8000000 + OLD_LDFLAGS=$LDFLAGS + assert_arg_to_ldflags -pg + GPL_FLAG="-pg" + LDFLAGS=$OLD_LDFLAGS;; + 386-macosx) +# assert_arg_to_cflags -Wno-error=implicit-function-declaration + add_arg_to_cflags -Wno-incomplete-setjmp-declaration + assert_arg_to_ldflags -Wl,-no_pie + if test "$build_cpu" = "x86_64" ; then + assert_arg_to_cflags -m64 + assert_arg_to_ldflags -m64 + assert_arg_to_ldflags -Wl,-headerpad,72 + else + assert_arg_to_cflags -m32 + assert_arg_to_ldflags -m32 + assert_arg_to_ldflags -Wl,-headerpad,56 + fi;; + FreeBSD) assert_arg_to_ldflags -Z;; +esac + +if test "$enable_static" = "yes" ; then + assert_arg_to_ldflags -static + assert_arg_to_ldflags -Wl,-zmuldefs + AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) +fi + +TO3FLAGS="" +TO2FLAGS="" + +case "$use" in + *mingw*) + TFPFLAG="";; + m68k*)#FIXME gcc 4.x bug workaround + TFPFLAG="";; + *) + TFPFLAG="-fomit-frame-pointer";; +esac + +AC_CHECK_PROGS(AWK,[gawk nawk awk]) +GCL_CC_ARGS=`echo $CC | ${AWK} '{$1="";print}'` +GCL_CC="`basename $CC` $GCL_CC_ARGS" +if echo $GCL_CC |grep gcc |grep -q win; then + GCL_CC=gcc +fi +AC_SUBST(GCL_CC) + +AC_ARG_ENABLE([gprof],[ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof], + [if test "$enableval" = "yes" ; then + AC_MSG_CHECKING([working gprof]) + case $use in + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + m68k*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac + GP_FLAG="" + if test "$enableval" != "yes" ; then + AC_MSG_RESULT([disabled]) + else + AC_MSG_RESULT([ok]) + OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg + assert_arg_to_cflags -pg + GP_FLAG="-pg" + CFLAGS=$OLD_CFLAGS + TFPFLAG="" + AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) + fi + fi]) + +if test "$enable_debug" = "yes" ; then + assert_arg_to_cflags -g + # for subconfigurations + CFLAGS="$CFLAGS -g" +else + TO3FLAGS="-O3 $TFPFLAG" + TO2FLAGS="-O" +fi + +# gcc on ppc cannot compile our new_init.c with full opts --CM +TONIFLAGS="" +case $use in + powerpc*macosx) assert_arg_to_cflags -mlongcall;; + *linux) + case $use in + alpha*) + assert_arg_to_cflags -mieee +# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 + ;; + aarch64*) + TLIBS="$TLIBS -lgcc_s";; + hppa*) + assert_arg_to_cflags -mlong-calls + TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 + ;; + mips*) + case $canonical in + mips64*linux*) +# assert_arg_to_cflags -mxgot + assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) + AC_DEFINE([SET_STACK_POINTER],["mov %%sp,%0\n\t"],[asm string to set the stack pointer]) + AC_MSG_CHECKING([how to set stack pointer]) + AC_MSG_RESULT([done]) + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; + powerpc*) + assert_arg_to_cflags -mlongcall + if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi + ;; + esac;; +esac +if test "$enable_pic" = "yes" ; then + assert_arg_to_cflags -fPIC +fi + + +FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` +#CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` +FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-fomit-frame-pointer$"|tr '\012' ' '` +FOOPT3=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O3$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O3$"|tr '\012' ' '` +FOOPT2=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O2$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O2$"|tr '\012' ' '` +FOOPT1=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O1$"|tr '\012' ' '` +TMPF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O$"|tr '\012' ' '` +FOOPT1="$FOOPT1$TMPF" +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O1$"|grep -v "^\-O$"|tr '\012' ' '` +FOOPT0=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O0$"|tr '\012' ' '` +CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` + +if test "$FOOPT0" != "" ; then + TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` + TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +else + if test "$FOOPT1" != "" ; then + TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` + TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` + else + if test "$FOOPT2" != "" ; then + TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` + TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` + fi + fi +fi + +if test "$FDEBUG" != "" ; then + TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` + TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` +fi + +if test "$FOMITF" != "" ; then + TO3FLAGS="$TO3FLAGS $FOMITF" +fi + +# Step 1: set the variable "system" to hold the name and version number +# for the system. This can usually be done via the "uname" command, but +# there are a few systems, like Next, where this doesn't work. + +AC_CHECK_PROGS(MAKEINFO,makeinfo,"false") +AC_SUBST(MAKEINFO) + +AC_MSG_CHECKING([system version (for dynamic loading)]) +if machine=`uname -m` ; then true; else machine=unknown ; fi + +if test -f /usr/lib/NextStep/software_version; then + system=NEXTSTEP-`${AWK} '/3/,/3/' /usr/lib/NextStep/software_version` +else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + AC_MSG_RESULT([unknown (cannot find uname command)]) + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird + # results, and the version is kept in special file). + + if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then + system="MP-RAS-`${AWK} '{print $3}' '/etc/.relid'`" + fi + if test "`uname -s`" = "AIX" ; then + system=AIX-`uname -v`.`uname -r` + fi + AC_MSG_RESULT($system) + fi +fi + +case $use in + *macosx) + AC_CHECK_HEADERS(malloc/malloc.h,,[AC_MSG_ERROR([need malloc.h on macosx])]) + AC_CHECK_MEMBER([struct _malloc_zone_t.memalign], + AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], + [ + #include + ]) + AC_SUBST(HAVE_MALLOC_ZONE_MEMALIGN) + ;; +esac + +AC_CHECK_HEADERS( + [setjmp.h], + [AC_MSG_CHECKING([sizeof jmp_buf]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + FILE *fp=fopen("conftest1","w"); + fprintf(fp,"%lu\n",sizeof(jmp_buf)); + fclose(fp); + ]])], + [sizeof_jmp_buf=`cat conftest1` + AC_MSG_RESULT($sizeof_jmp_buf) + AC_DEFINE_UNQUOTED(SIZEOF_JMP_BUF,$sizeof_jmp_buf,[sizeof jmp_buf])], + [AC_MSG_RESULT([no])])]) + +# sysconf +AC_CHECK_HEADERS( + [unistd.h], + [AC_CHECK_LIB( + [c],[sysconf], + [AC_MSG_CHECKING([_SC_CLK_TCK]) + hz=0 + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + FILE *fp=fopen("conftest1","w"); + fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); + fclose(fp); + ]], + [hz=`cat conftest1` + AC_DEFINE_UNQUOTED(HZ,$hz,[time system constant])])]) + AC_MSG_RESULT($hz)])]) + + +rm -f makedefsafter + +AC_ARG_ENABLE([dynsysgmp], + [ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source]) + +if test "$enable_dynsysgmp" != "no" ; then + AC_CHECK_HEADERS( + [gmp.h], + [AC_CHECK_LIB( + [gmp],[__gmpz_init], + [AC_MSG_CHECKING([for external gmp version]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + ]], + [[ + #if __GNU_MP_VERSION > 3 + return 0; + #else + return -1; + #endif + ]])], + [AC_MSG_RESULT([good]) + TLIBS="$TLIBS -lgmp" + echo "#include \"gmp.h\"" >foo.c + echo "int main() {return 0;}" >>foo.c + MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` + rm -f foo.c])])]) + + if test "$MP_INCLUDE" = "" ; then + AC_MSG_RESULT([Cannot use dynamic gmp lib]) + fi + +fi + + +if test "$MP_INCLUDE" = "" ; then + + GMPDIR=gmp4 + AC_MSG_CHECKING([doing configure in gmp directory]) + echo + echo "#" + echo "#" + echo "# -------------------" + echo "# Subconfigure of GMP" + echo "#" + echo "#" + + if test "$use_common_binary" = "yes"; then + cd $GMPDIR && ./configure --build=$host && cd .. + else + cd $GMPDIR && ./configure --host=$host --build=$build && cd .. + fi + #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" + + echo "#" + echo "#" + echo "#" + echo "# Subconfigure of GMP done" + echo "# ------------------------" + echo "#" + + if test "$MP_INCLUDE" = "" ; then + cp $GMPDIR/gmp.h h/gmp.h + MP_INCLUDE=h/gmp.h + MPFILES=gmp_all + fi +fi + +AC_MSG_CHECKING([for leading underscore in object symbols]) +cat>foo.c < +#include +int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} +EOFF +$CC -c foo.c -o foo.o +if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then + LEADING_UNDERSCORE=1 + AC_DEFINE(LEADING_UNDERSCORE,1,[symbol name mangling convention]) + AC_MSG_RESULT("yes") +else + LEADING_UNDERSCORE="" + AC_MSG_RESULT("no") +fi + + +AC_MSG_CHECKING("for GNU ld option -Map") +touch map +$CC -o foo [ -Wl,-Map ] map foo.o >/dev/null 2>&1 +if test `cat map | wc -l` != "0" ; then + AC_MSG_RESULT("yes") + AC_DEFINE(HAVE_GNU_LD,1,[gnu linker present]) + GNU_LD=1 +else + AC_MSG_RESULT("no") + GNU_LD= +fi +rm -f foo.c foo.o foo map + +AC_MSG_CHECKING([for size of gmp limbs]) +AC_RUN_IFELSE([AC_LANG_PROGRAM([[ + #include + #include "$MP_INCLUDE" + ]], + [[ + FILE *fp=fopen("conftest1","w"); + fprintf(fp,"%u",sizeof(mp_limb_t)); + fclose(fp); + ]])],[mpsize=`cat conftest1`],[AC_MSG_ERROR([Cannot determine mpsize])]) +AC_DEFINE_UNQUOTED(MP_LIMB_BYTES,$mpsize,[sizeof mp_limb in gmp library]) +AC_MSG_RESULT($mpsize) + +AC_MSG_CHECKING([_SHORT_LIMB]) +AC_RUN_IFELSE([AC_LANG_PROGRAM([[ + #include + #include "$MP_INCLUDE" + ]], + [[ + #ifdef _SHORT_LIMB + return 0; + #else + return 1; + #endif + ]])],[AC_DEFINE(__SHORT_LIMB,1,[short gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) + +AC_MSG_CHECKING([_LONG_LONG_LIMB]) +AC_RUN_IFELSE([AC_LANG_PROGRAM([[ + #include + #include "$MP_INCLUDE" + ]], + [[ + #ifdef _LONG_LONG_LIMB + return 0; + #else + return 1; + #endif + ]])],[AC_DEFINE(__LONG_LONG_LIMB,1,[long gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) + +GMP=1 +AC_DEFINE(GMP,1,[using gmp]) +AC_SUBST(GMP) +AC_SUBST(GMPDIR) +echo > makedefsafter +echo "MPFILES=$MPFILES" >> makedefsafter +echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +echo >> makedefsafter + + + +# +# X windows +# + +if test "$enable_xgcl" = "yes" ; then + + AC_PATH_X + + AC_CHECK_LIB(X11,main, + [X_LIBS="$X_LIBS -lX11" AC_DEFINE(HAVE_XGCL,1,[using xgcl])], + [AC_MSG_RESULT([missing x libraries -- cannot compile xgcl])]) + +fi + + +AC_SUBST(X_LIBS) +AC_SUBST(X_CFLAGS) + +# +# Dynamic loading +# + +if test "$enable_dlopen" = "yes" ; then + + AC_CHECK_LIB([dl],[dlopen],,AC_MSG_ERROR([Cannot find dlopen])) + + TLIBS="$TLIBS -ldl -rdynamic" + assert_arg_to_cflags -fPIC + AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) + +fi + +if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then + AC_CHECK_HEADERS( + [bfd.h], + AC_CHECK_LIB( + [bfd],[bfd_init], + # + # Old binutils appear to need CONST defined to const + # + AC_MSG_CHECKING([need to define CONST for bfd]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #define IN_GCC + #include + ]], + [[ + symbol_info t; + ]])], + AC_MSG_RESULT([no]), + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #define CONST const + #define IN_GCC + #include + ]], + [[ + symbol_info t; + ]])], + AC_MSG_RESULT([yes]) + AC_DEFINE(NEED_CONST,1,[binutils requires CONST definition]), + AC_MSG_ERROR([cannot use bfd]), + AC_MSG_ERROR([cannot use bfd])), + AC_MSG_ERROR([cannot use bfd])) + ,,-liberty)) + + AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) + + # + # BFD boolean syntax + # + + AC_MSG_CHECKING(for useable bfd_boolean) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #define IN_GCC + #include + bfd_boolean foo() {return FALSE;} + ]], + [[]])], + [AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_BFD_BOOLEAN,1,[bfd_boolean defined])], + [AC_MSG_RESULT(no)]) + + # + # bfd_link_info.output_bfd minimal configure change check + # + + AC_CHECK_MEMBER([struct bfd_link_info.output_bfd], + AC_DEFINE(HAVE_OUTPUT_BFD,1,[output_bfd element present]), [], + [[ + #include + #include + ]]) + AC_SUBST(HAVE_OUTPUT_BFD) + + # + # FIXME: Need to workaround mingw before this point -- CM + # + if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then + echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c + MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` + rm -f foo.c foo + if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then + LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" + else + AC_MSG_ERROR([cannot locate external libbfd.a]) + fi + if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then + LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" + else + AC_MSG_ERROR([cannot locate external libiberty.a]) + fi + BUILD_BFD=copy_bfd + AC_CHECK_LIB(z,inflate, + [TLIBS="$TLIBS -lz"], + AC_MSG_ERROR([Need zlib for bfd linking]),[]) + AC_CHECK_LIB(dl,dlsym, + [TLIBS="$TLIBS -ldl"], + AC_MSG_ERROR([Need libdl for bfd linking]),[]) + AC_SUBST(BUILD_BFD) + AC_SUBST(LIBBFD) + AC_SUBST(LIBIBERTY) + + else + TLIBS="$TLIBS -lbfd -liberty -ldl" + fi +fi + +AC_ARG_ENABLE([xdr],[ --enable-xdr=yes will compile in support for XDR]) + +if test "$enable_xdr" != "no" ; then + XDR_LIB="" + AC_CHECK_FUNC([xdr_double],XDR_LIB=" ", + [AC_CHECK_LIB([tirpc],[xdr_double],[XDR_LIB=tirpc], + [AC_CHECK_LIB([gssrpc],[xdr_double],[XDR_LIB=gssrpc], + [AC_CHECK_LIB([rpc],[xdr_double],[XDR_LIB=rpc], + [AC_CHECK_LIB([oncrpc],[xdr_double],[XDR_LIB=oncrpc])])])])]) + + if test "$XDR_LIB" != ""; then + AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) + if test "$XDR_LIB" != " "; then + TLIBS="$TLIBS -l$XDR_LIB" + add_arg_to_cflags -I/usr/include/$XDR_LIB + fi + fi +fi + + +AC_MSG_CHECKING([__builtin_clzl]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + unsigned long u; + long j; + if (__builtin_clzl(0)!=sizeof(long)*8) + return -1; + for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) + if (__builtin_clzl(u)!=j) + return -1; + ]])], + [AC_MSG_RESULT([yes]) + AC_DEFINE(HAVE_CLZL,[1],[clzl instruction])], + [AC_MSG_RESULT([no])]) + +AC_MSG_CHECKING([__builtin_ctzl]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + unsigned long u; + long j; + if (__builtin_ctzl(0)!=sizeof(long)*8) + return -1; + for (u=1,j=0;j + #include + #ifdef __CYGWIN__ + #define getpagesize() 4096 + #endif + ]], + [[ + size_t i=getpagesize(),j; + FILE *fp=fopen("conftest1","w"); + for (j=0;i>>=1;j++); + j=j<$min_pagewidth ? $min_pagewidth : j; + fprintf(fp,"%u",j); + ]])], + [PAGEWIDTH=`cat conftest1`], + [PAGEWIDTH=0]) +AC_MSG_RESULT($PAGEWIDTH) +AC_DEFINE_UNQUOTED(PAGEWIDTH,$PAGEWIDTH,[system pagewidth]) +AC_SUBST(PAGEWIDTH) + +AC_MSG_CHECKING([for required object alignment]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + #define EXTER + #define INLINE + #include "$MP_INCLUDE" + #include "./h/enum.h" + #define OBJ_ALIGN + #include "./h/type.h" + #include "./h/lu.h" + #include "./h/object.h" + ]], + [[ + unsigned long i; + FILE *fp=fopen("conftest1","w"); + for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); + if (!i) return -1; + fprintf(fp,"%lu",i); + fclose(fp); + return 0; + ]])], + [obj_align=`cat conftest1` + AC_MSG_RESULT($obj_align) + AC_DEFINE_UNQUOTED(OBJ_ALIGNMENT,$obj_align,[needed object alignment bytes])], + [AC_MSG_ERROR([Cannot find object alignent])]) + +AC_MSG_CHECKING([for C extension variable alignment]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]], + [[ + char *v __attribute__ ((aligned ($obj_align))); + ]])],[obj_align="__attribute__ ((aligned ($obj_align)))"],[AC_MSG_ERROR([Need alignment attributes])]) +AC_MSG_RESULT($obj_align) +AC_DEFINE_UNQUOTED(OBJ_ALIGN,$obj_align,[can use C extension for object alignment]) + +AC_MSG_CHECKING([for C extension noreturn function attribute]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]], + [[ + extern int v() __attribute__ ((noreturn)); + ]])], + [no_return="__attribute__ ((noreturn))"],[no_return=]) +AC_MSG_RESULT($no_return) +AC_DEFINE_UNQUOTED(NO_RETURN,$no_return,[can use C extension for functions that do not return]) + +AC_MSG_CHECKING([sizeof struct contblock]) + +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + #define EXTER + #define INLINE + #include "$MP_INCLUDE" + #include "h/enum.h" + #include "h/type.h" + #include "h/lu.h" + #include "h/object.h" + ]], + [[ + FILE *f=fopen("conftest1","w"); + fprintf(f,"%u",sizeof(struct contblock)); + fclose(f); + ]])], + [sizeof_contblock=`cat conftest1`], + [AC_MSG_ERROR([Cannot find sizeof struct contblock])], + [AC_MSG_ERROR([Cannot find sizeof struct contblock])]) + +AC_MSG_RESULT($sizeof_contblock) +AC_DEFINE_UNQUOTED(SIZEOF_CONTBLOCK,$sizeof_contblock,[sizeof linked list for contiguous pages]) + +AC_MSG_CHECKING([for sbrk]) +HAVE_SBRK="" +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + FILE *f; + if (!(f=fopen("conftest1","w"))) + return -1; + fprintf(f,"%p",sbrk(0)); + ]])], + [HAVE_SBRK=1;AC_MSG_RESULT([yes])], + AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), + AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) + +if test "$use" = "386-macosx" ; then + AC_MSG_RESULT([emulating sbrk for mac]); + HAVE_SBRK=0 +fi + +if test "$HAVE_SBRK" = "1" ; then + + AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + FILE *f; + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%x",ADDR_NO_RANDOMIZE); + ]])], + [ADDR_NO_RANDOMIZE=`cat conftest1` + AC_MSG_RESULT([yes $ADDR_NO_RANDOMIZE])], + [ADDR_NO_RANDOMIZE=0 + AC_MSG_RESULT([no assuming 0x40000]) + AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000,[punt guess for no randomize value])]) + + AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + FILE *f; + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%x",ADDR_COMPAT_LAYOUT); + ]])], + [ADDR_COMPAT_LAYOUT=`cat conftest1` + AC_MSG_RESULT([yes $ADDR_COMPAT_LAYOUT])], + [ADDR_COMPAT_LAYOUT=0 + AC_MSG_RESULT([no])] + AC_DEFINE_UNQUOTED(ADDR_COMPAT_LAYOUT,0,[constant to reserve upper 3Gb for C stack])) + + AC_MSG_CHECKING([for ADDR_LIMIT_3GB constant]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + FILE *f; + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%x",ADDR_LIMIT_3GB); + ]])], + [ADDR_LIMIT_3GB=`cat conftest1` + AC_MSG_RESULT([yes $ADDR_LIMIT_3GB])], + [ADDR_LIMIT_3GB=0 + AC_MSG_RESULT([no])] + AC_DEFINE_UNQUOTED(ADDR_LIMIT_3GB,0,[only 3Gb of address space])) + + AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) + AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int main(int argc,char *argv[],char *envp[]) { + #include "h/unrandomize.h" + return 0; + } + ]])], + [AC_MSG_RESULT(yes) + AC_DEFINE(CAN_UNRANDOMIZE_SBRK,1,[can prevent sbrk from returning random values])], + [AC_MSG_RESULT(no)]) + + AC_MSG_CHECKING([that sbrk is (now) non-random]) + SBRK=0 + AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) + return -1; + fprintf(f,"%p",sbrk(0)); + return 0; + } + ]])],[SBRK=`cat conftest1`]) + if test "$SBRK" = "0" ; then + AC_MSG_ERROR([cannot trap sbrk]) + fi + + SBRK1=0 + AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%p",sbrk(0)); + return 0; + } + ]])],[SBRK1=`cat conftest1`]) + if test "$SBRK1" = "0" ; then + AC_MSG_ERROR([cannot trap sbrk]) + fi + if test "$SBRK" = "$SBRK1" ; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + echo "Cannot build with randomized sbrk. Your options:" + echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" + echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" + echo " - run sysctl kernel.randomize_va_space=0 before using gcl" + AC_MSG_ERROR([exiting]) + fi +fi + +AC_MSG_CHECKING(CSTACK_DIRECTION) +AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int main(int argc,char **argv,char **envp) { + FILE *fp = fopen("conftest1","w"); + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + fprintf(fp,"%d",(alloca(sizeof(void *))>alloca(sizeof(void *))) ? -1 : 1); + fclose(fp); + return 0; + }]])], + [cstack_direction=`cat conftest1`],[cstack_direction=0]) +AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) +AC_MSG_RESULT($cstack_direction) + +AC_MSG_CHECKING([finding CSTACK_ALIGNMENT]) +AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int main(int argc,char **argv,char **envp) { + void *b,*c; + FILE *fp = fopen("conftest1","w"); + long n; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + b=alloca(sizeof(b)); + c=alloca(sizeof(c)); + n=b>c ? b-c : c-b; + n=n>sizeof(c) ? n : 1; + fprintf(fp,"%ld",n); + fclose(fp); + return 0; + }]])], + [cstack_alignment=`cat conftest1`],[cstack_alignment=0]) +AC_DEFINE_UNQUOTED(CSTACK_ALIGNMENT,$cstack_alignment,[C stack alignment]) +AC_MSG_RESULT($cstack_alignment) + +AC_ARG_ENABLE([cstackmax],[ --enable-cstackmax=xxxx will ensure that the cstack begins below xxxx or fail], + [if test "$enableval" != "" ; then AC_DEFINE_UNQUOTED([CSTACKMAX],$enableval,[cstack max]) fi]) + + +AC_MSG_CHECKING(CSTACK_ADDRESS) +AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int + main(int argc,char **argv,char **envp) { + FILE *fp = fopen("conftest1","w"); + unsigned long i,j; + + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + j=1; + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)alloca(sizeof(void *)); + if ($cstack_direction==1) i-=j; + j--; + i+=j; + i&=~j; + fprintf(fp,"0x%lx",i-1); + fclose(fp); + return 0; + }]])], + [cstack_address=`cat conftest1`],[cstack_address=0]) +AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address,[starting C stack address]) +AC_MSG_RESULT($cstack_address) + +AC_MSG_CHECKING([cstack bits]) +AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int + main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); + long i,j; + + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + j=1; + j<<=$PAGEWIDTH; + j<<=16; + i=(long)&v; + if ($cstack_direction==1) i-=j; + j--; + i+=j; + i&=~j; + for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); + fprintf(fp,"%ld",j); + fclose(fp); + return 0; + }]])], + [cstack_bits=`cat conftest1`],[cstack_bits=0]) +AC_DEFINE_UNQUOTED(CSTACK_BITS,$cstack_bits,[log starting C stack address]) +AC_MSG_RESULT($cstack_bits) + +AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) +AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include + int + main(int argc,char **argv,char **envp) { + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + return (long)$cstack_address<0 ? 0 : -1; + }]])], + [AC_MSG_RESULT(yes) + neg_cstack_address=1 + AC_DEFINE(NEG_CSTACK_ADDRESS,1,[C stack address is negative])], + [AC_MSG_RESULT(no) + neg_cstack_address=0]) + +AC_ARG_ENABLE([immfix],[ --enable-immfix will enable an immediate fixnum table above the C stack]) + +AC_ARG_ENABLE([fastimmfix],[ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained],,[enable_fastimmfix=64]) + + +if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec + + AC_MSG_CHECKING([finding default linker script]) + touch unixport/gcl.script + echo "int main() {return 0;}" >foo.c + $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ + $AWK '/==================================================/ {i=1-i;next} {if (i) print}' >gcl.script + rm -rf foo.c foo + + if test "`cat gcl.script | wc -l`" != "0" ; then + AC_MSG_RESULT(got it) + AC_MSG_NOTICE([trying to adjust text start]) + cp gcl.script gcl.script.def + + n=-1; + k=0; + lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; + max=0; + min=$lim; + while test $n -lt $lim ; do + j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script + # diff -u gcl.script.def gcl.script + echo "int main() {return 0;}" >foo.c + if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then + if test $n -lt $min ; then min=$n; fi; + if test $n -gt $max; then max=$n; fi; + elif test $max -gt 0 ; then + break; + fi; + n=`$AWK 'END {print n+1}' n=$n gcl.script + AC_MSG_RESULT([done]) + rm -f gcl.script.def + assert_arg_to_ldflags -Wl,-T,gcl.script + cp gcl.script unixport + else + AC_MSG_RESULT([none found or not needed]) + rm -f gcl.script gcl.script.def + fi + rm -rf foo.c foo + else + AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) + AC_MSG_RESULT([not found]) + fi + +else + + AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) + +fi + +mem_top=0 +mem_range=0 +AC_MSG_CHECKING(mem top) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + ]], + [[ + unsigned long i,j,k,l; + FILE *fp = fopen("conftest1","w"); + + for (i=2,k=1;i;k=i,i<<=1); + l=$cstack_address; + l=$cstack_direction==1 ? (l>=1,i|=j); + if (j<(k>>3)) i=0; + j=1; + j<<=$PAGEWIDTH; + j<<=4; + j--; + i+=j; + i&=~j; + fprintf(fp,"0x%lx",i); + fclose(fp); + return 0; + ]])], + [mem_top=`cat conftest1`],[mem_top="0x0"]) +AC_MSG_RESULT($mem_top) + +if test "$mem_top" != "0x0" ; then + AC_MSG_CHECKING(finding upper mem half range) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + ]], + [[ + unsigned long j; + FILE *fp = fopen("conftest1","w"); + + for (j=1;j && !(j& $mem_top);j<<=1); + fprintf(fp,"0x%lx",j>>1); + fclose(fp); + return 0; + ]])], + [mem_range=`cat conftest1`],[mem_range="0x0"]) + AC_MSG_RESULT($mem_range) + if test "$mem_range" != "0x0" ; then + AC_DEFINE_UNQUOTED(MEM_TOP,$mem_top,[beginning address for immediate fixnum range]) + AC_DEFINE_UNQUOTED(MEM_RANGE,$mem_range,[size of immediate fixnum address space]) + fi +fi + +if test "$enable_immfix" != "no" ; then + if test "$mem_top" != "0x0" ; then + if test "$mem_range" != "0x0" ; then + AC_DEFINE_UNQUOTED(IM_FIX_BASE,$mem_top,[beginning address for immediate fixnum range]) + AC_DEFINE_UNQUOTED(IM_FIX_LIM,$mem_range,[size of immediate fixnum address space]) + fi + fi +fi + +AC_MSG_CHECKING([sizeof long long int]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + ]], + [[ + if (sizeof(long long int) == 2*sizeof(long)) return 0; + return 1; + ]])], + [AC_DEFINE(HAVE_LONG_LONG,1,[long long is available]) AC_MSG_RESULT(yes)], + [AC_MSG_RESULT(no)]) + +AC_SUBST(HAVE_LONG_LONG) + +AC_CHECK_HEADERS([dirent.h], + AC_MSG_CHECKING([for d_type]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + struct dirent *d; + DIR *r=opendir("./"); + for (;(d=readdir(r)) && strcmp("configure",d->d_name);); + return d && d->d_type==DT_REG ? 0 : -1; + ]])], + [AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_D_TYPE,1,[have struct dirent d_type field])], + AC_MSG_RESULT([no]),AC_MSG_RESULT([no]))) + +# ansi lisp +SYSTEM=ansi_gcl +CLSTANDARD=ANSI +AC_ARG_ENABLE([ansi],[ --enable-ansi builds a large gcl aiming for ansi compliance], + [if test "$enable_ansi" = "no" ; then + SYSTEM=gcl + CLSTANDARD=CLtL1 + else + AC_DEFINE([ANSI_COMMON_LISP],[1],[ANSI compliant image]) + fi], + [AC_DEFINE([ANSI_COMMON_LISP],[1],[ANSI compliant image])]) + +FLISP="saved_$SYSTEM" +AC_SUBST(FLISP) +AC_SUBST(SYSTEM) +AC_SUBST(CLSTANDARD) + +# Maximum number of pages + + + +# Check if Posix compliant getcwd exists, if not we'll use getwd. +AC_CHECK_FUNCS(getcwd) +AC_CHECK_FUNCS(getwd) +AC_CHECK_FUNC(uname, , AC_DEFINE(NO_UNAME,1,[no uname call])) +AC_CHECK_FUNC(gettimeofday, , AC_DEFINE(NO_GETTOD)) + + +AC_CHECK_HEADERS(sys/ioctl.h) + +# OpenBSD has elf_abi.h instead of elf.h +AC_CHECK_HEADERS(elf.h elf_abi.h) + +AC_CHECK_HEADERS(sys/sockio.h) + + +#-------------------------------------------------------------------- +# The code below deals with several issues related to gettimeofday: +# 1. Some systems don't provide a gettimeofday function at all +# (set NO_GETTOD if this is the case). +# 2. SGI systems don't use the BSD form of the gettimeofday function, +# but they have a BSDgettimeofday function that can be used instead. +# 3. See if gettimeofday is declared in the header file. +# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can +# declare it. +#-------------------------------------------------------------------- + +AC_CHECK_FUNC([BSDgettimeofday], + [AC_DEFINE(HAVE_BSDGETTIMEOFDAY,1,[have bsdgettimeofday])], + [AC_CHECK_FUNC([gettimeofday], , + [AC_DEFINE([NO_GETTOD],1,[no gettimeofday call])])]) + +AC_EGREP_HEADER([gettimeofday], + [sys/time.h], + [AC_MSG_CHECKING([for gettimeofday declaration]) + AC_MSG_RESULT([present])], + [AC_MSG_CHECKING([for gettimeofday declaration]) + AC_MSG_RESULT([missing]) + AC_DEFINE(GETTOD_NOT_DECLARED,1,[No gettimeofday call -- fixme])]) + + +AC_CHECK_LIB(m,sin,LIBS="${LIBS} -lm",true) +AC_CHECK_LIB(mingwex,main,LIBS="${LIBS} -lmingwex",true) + +AC_MSG_CHECKING([for buggy maximum sscanf length]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + ]], + [[ + char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; + int n, m; + double f; + char *endptr; + FILE *fp=fopen("conftest1","w"); + + n=sscanf(s,"%lf%n",&f,&m); + fprintf(fp,"%d",m); + fclose(fp); + return s[m]; + ]])], + [AC_MSG_RESULT([none])], + [buggy_maximum_sscanf_length=`cat conftest1` + AC_MSG_RESULT([$buggy_maximum_sscanf_length]) + AC_DEFINE_UNQUOTED(BUGGY_MAXIMUM_SSCANF_LENGTH,$buggy_maximum_sscanf_length,[sscanf terminates prematurely (Windows XP)])]) + + +EXTRA_LOBJS= +AC_ARG_ENABLE([japi],[ --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system], + [if test "$enable_japi" = "yes" ; then + AC_CHECK_HEADERS([japi.h], + [AC_DEFINE(HAVE_JAPI_H) + EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" + LIBS="${LIBS} -ljapi -lwsock32"]) + fi]) + +# Should really find a way to check for prototypes, but this +# basically works for now. CM +# +AC_CHECK_HEADERS(math.h,AC_DEFINE(HAVE_MATH_H,1,[have math.h])) +AC_CHECK_HEADERS(complex.h,AC_DEFINE(HAVE_COMPLEX_H,1,[have complex.h])) + +# +# For DBL_MAX et. al. on (only) certain Linux arches, apparently CM +# +AC_CHECK_HEADERS(values.h,AC_DEFINE(HAVE_VALUES_H,1,[have values.h])) + +# +# Sparc solaris keeps this in float.h, rework either/or with values.h later +# +AC_CHECK_HEADERS(float.h,AC_DEFINE(HAVE_FLOAT_H,1,[have float.h])) + +# +# The second alternative is for solaris. This needs to be +# a more comprehensive later, i.e. checking that the fpclass +# test makes sense. CM +# +AC_MSG_CHECKING([for isnormal]) +AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #define _GNU_SOURCE + #include + ]], + [[ + float f; + return isnormal(f) || !isnormal(f) ? 0 : 1; + ]])], + [AC_DEFINE(HAVE_ISNORMAL,1,[Have isnormal function]) AC_MSG_RESULT(yes)], + [AC_MSG_CHECKING([for fpclass of ieeefp.h]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + ]], + [[ + float f; + return fpclass(f)>=FP_NZERO || fpclass(f) + ]], + [[ + float f; + return isfinite(f) || !isfinite(f) ? 0 : 1; + ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], + [AC_MSG_CHECKING([for finite()]) + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + float f; + return finite(f) || !finite(f) ? 0 : 1; + ]])], + [AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], + [AC_MSG_ERROR(no)])]) + +#-------------------------------------------------------------------- +# Check for the existence of the -lsocket and -lnsl libraries. +# The order here is important, so that they end up in the right +# order in the command line generated by make. Here are some +# special considerations: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- +AC_MSG_CHECKING([for sockets]) +tcl_checkBoth=0 +AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1) +if test "$tcl_checkSocket" = 1; then + AC_CHECK_LIB(socket, main, TLIBS="$TLIBS -lsocket", tcl_checkBoth=1) +fi + + +if test "$tcl_checkBoth" = 1; then + tk_oldLibs=$TLIBS + TLIBS="$TLIBS -lsocket -lnsl" + AC_CHECK_FUNC(accept, tcl_checkNsl=0, [TLIBS=$tk_oldLibs]) +fi +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [TLIBS="$TLIBS -lnsl"])) + +# readline +AC_ARG_ENABLE(readline,[ --enable-readline enables command line completion via the readline library ]) + +if test "$use" = "mingw" ; then + enable_readline=no +fi + +if test "$enable_readline" != "no" ; then + AC_CHECK_HEADERS([readline/readline.h], + AC_CHECK_LIB([readline],[rl_initialize], + [AC_DEFINE(USE_READLINE,1,[use readline library]) + AC_CHECK_LIB([readline],[el_getc],AC_DEFINE(READLINE_IS_EDITLINE,1,[readline is editline])) + # These tests discover differences between readline 4.1 and 4.3 + AC_CHECK_LIB([readline],[rl_completion_matches], + [AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES,1,[have readline completion matches]) + AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T,1,[have readline completion matches])]) + AC_MSG_CHECKING([RL_COMPLETION_ENTRY_FUNCTION_TYPE_FUNCTION]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + extern Function *rl_completion_entry_function __attribute__((weak)); + ]], + [[]])], + [AC_DEFINE(RL_COMPLETION_ENTRY_FUNCTION_TYPE_FUNCTION,1,[rl_completion_entry_function returns type Function]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no]) + AC_MSG_CHECKING([RL_COMPLETION_ENTRY_FUNCTION_TYPE_RL_COMPENTRY_FUNC_T]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); + ]], + [[]])], + [AC_DEFINE(RL_COMPLETION_ENTRY_FUNCTION_TYPE_RL_COMPENTRY_FUNC_T,1,[rl_completion_entry_function returns type rl_compentry_func_t]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no]) + AC_MSG_ERROR([Unknown rl_completion_entry_function return type])])]) + + AC_MSG_CHECKING([RL_READLINE_NAME_TYPE_CHAR]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + extern char *rl_readline_name __attribute__((weak)); + ]], + [[]])], + [AC_DEFINE(RL_READLINE_NAME_TYPE_CHAR,1,[rl_readline_name returns type char]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no]) + AC_MSG_CHECKING([RL_READLINE_NAME_TYPE_CONST_CHAR]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + extern const char *rl_readline_name __attribute__((weak)); + ]], + [[]])], + [AC_DEFINE(RL_READLINE_NAME_TYPE_CONST_CHAR,1,[rl_readline_name returns type const char]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no]) + AC_MSG_ERROR([Unknown rl_readline_name return type])])]) + TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware + RL_OBJS=gcl_readline.o]), + [],[AC_INCLUDES_DEFAULT([#include ])]) +fi + +AC_SUBST(RL_OBJS) +AC_SUBST(RL_LIB) + +# sockets + +AC_MSG_CHECKING([For network code for nsocket.c]) +AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + #include + + #include + #include + #include + + /************* for the sockets ******************/ + #include /* struct sockaddr, SOCK_STREAM, ... */ + #ifndef NO_UNAME + # include /* uname system call. */ + #endif + #include /* struct in_addr, struct sockaddr_in */ + #include /* inet_ntoa() */ + #include /* gethostbyname() */ + ]], + [[ + connect(0,(struct sockaddr *)0,0); + gethostbyname("jil"); + socket(AF_INET, SOCK_STREAM, 0); + ]])], + [AC_DEFINE(HAVE_NSOCKET,1,[can use nsocket library]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])]) + + +AC_MSG_CHECKING([check for listen using fcntl]) +AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #include + ]], + [[ + FILE *fp=fopen("configure.in","r"); + int orig; + orig = fcntl(fileno(fp), F_GETFL); + if (! (orig & O_NONBLOCK )) return 0; + ]])], + [AC_DEFINE(LISTEN_USE_FCNTL,1,[can use fcntl for listen function]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])]) + + +AC_CHECK_FUNC(profil, ,[AC_DEFINE(NO_PROFILE,1,[no profil system call])]) +AC_SUBST(NO_PROFILE) +AC_CHECK_FUNC(setenv,[AC_DEFINE(HAVE_SETENV,1,[have setenv call])],no_setenv=1 ) +AC_SUBST(HAVE_SETENV) +if test "$no_setenv" = "1" ; then + AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV,1,[have putenv call])],) + AC_SUBST(HAVE_PUTENV) +fi + +AC_CHECK_FUNC(_cleanup, [AC_DEFINE(USE_CLEANUP,1,[have _cleanup function])],) +AC_SUBST(USE_CLEANUP) +gcl_ok=no + +AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) + +case $system in + OSF*) + AC_DEFINE(USE_FIONBIO,1,[use fionbio for non-blocking io]) + AC_MSG_RESULT(FIONBIO) + ;; + SunOS-4*) + AC_DEFINE(USE_FIONBIO,1,[use fionbio for non-blocking io]) + AC_MSG_RESULT(FIONBIO) + ;; + ULTRIX-4.*) + AC_DEFINE(USE_FIONBIO,1,[use fionbio for non-blocking io]) + AC_MSG_RESULT(FIONBIO) + ;; + *) + AC_MSG_RESULT(O_NONBLOCK) + ;; +esac + + +AC_MSG_CHECKING(check for SV_ONSTACK) +AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + int joe=SV_ONSTACK; + ]], + [[]])], + [AC_DEFINE(HAVE_SV_ONSTACK,1,[have sv_onstack]) + AC_SUBST(HAVE_SV_ONSTACK) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])]) + +AC_MSG_CHECKING(check for SIGSYS) +AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + int joe=SIGSYS; + ]],[[]])], + [AC_DEFINE(HAVE_SIGSYS,1,[have SIGSYS signal]) + AC_SUBST(HAVE_SIGSYS) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])]) + + +AC_MSG_CHECKING(check for SIGEMT) +AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + int joe=SIGEMT; + ]],[[]])], + [AC_DEFINE(HAVE_SIGEMT,1,[have SIGEMT signal]) + AC_SUBST(HAVE_SIGEMT) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])]) + +AC_CHECK_FUNCS(sigaltstack) +AC_CHECK_FUNCS(feenableexcept) + +AC_CHECK_HEADERS(dis-asm.h, + MLIBS=$LIBS + AC_CHECK_LIB(opcodes,init_disassemble_info) + AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly + AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl"))) + +#if test $use = "386-linux" ; then +AC_CHECK_HEADERS(asm/sigcontext.h) +AC_CHECK_HEADERS(asm/signal.h) +AC_MSG_CHECKING([for sigcontext...]) +AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + ]], + [[ + struct sigcontext foo; + ]])], + [AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT,1,[have sigcontext of signal.h]) + AC_MSG_RESULT([sigcontext of signal.h])], + [AC_MSG_RESULT([sigcontext NOT of signal.h]) + AC_MSG_CHECKING([for sigcontext...]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ + #include + #ifdef HAVE_ASM_SIGCONTEXT_H + #include + #endif + #ifdef HAVE_ASM_SIGNAL_H + #include + #endif + ]], + [[ + struct sigcontext foo; + ]])], + [AC_DEFINE(HAVE_SIGCONTEXT,1,[have sigcontext]) + AC_MSG_RESULT(sigcontext asm files)], + [AC_MSG_RESULT([no sigcontext found])])]) + +AC_PATH_PROG(EMACS,emacs) + + +# check for where the emacs site lisp directory is. +rm -f conftest.el +cat >> conftest.el <&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + else + EMACS_SITE_LISP="" + fi +fi +AC_MSG_RESULT($EMACS_SITE_LISP) +AC_SUBST(EMACS_SITE_LISP) + +# check for where the emacs site lisp default.el is +rm -f conftest.el +cat >> conftest.el <&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +else + EMACS_DEFAULT_EL="" +fi +if test -f "${EMACS_DEFAULT_EL}" ; then true;else + if test -d $EMACS_SITE_LISP ; then + EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el + fi +fi +AC_MSG_RESULT($EMACS_DEFAULT_EL) +AC_SUBST(EMACS_DEFAULT_EL) + + + +# check for where the emacs site lisp info/dir is +rm -f conftest.el +cat >> conftest.el <&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + fi +fi + +AC_MSG_RESULT($INFO_DIR) +AC_SUBST(INFO_DIR) + +AC_ARG_ENABLE([tcltk],[ --enable-tcltk will try to build gcl-tk]) +AC_ARG_ENABLE([tkconfig], + [ --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh], + [TK_CONFIG_PREFIX=$enableval],[TK_CONFIG_PREFIX=unknown]) +AC_ARG_ENABLE([tclconfig], + [ --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh], + [TCL_CONFIG_PREFIX=$enableval],[TCL_CONFIG_PREFIX=unknown]) + +if test "$enable_tcltk" != "no" ; then + + if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else + + AC_CHECK_PROG(TCLSH,tclsh,tclsh,${TCLSH}) + + if test "${TCLSH}" = "" ; then true ; else + + rm -f conftest.tcl + cat >> conftest.tcl <, Wed Dec 14 18:55:19 2005 diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..b524b7c --- /dev/null +++ b/debian/changelog @@ -0,0 +1,4240 @@ +gcl (2.6.13-1) unstable; urgency=medium + + * New Upstream Release + + -- Camm Maguire Tue, 20 Dec 2022 10:35:44 -0500 + +gcl (2.6.12-131) unstable; urgency=medium + + * Version_2.6.13pre131 + + -- Camm Maguire Sat, 17 Dec 2022 12:15:58 -0500 + +gcl (2.6.12-130) unstable; urgency=medium + + * Version_2.6.13pre130 + + -- Camm Maguire Fri, 16 Dec 2022 12:41:29 -0500 + +gcl (2.6.12-129) unstable; urgency=medium + + * Version_2.6.13pre129 + + -- Camm Maguire Sun, 13 Nov 2022 07:55:14 -0500 + +gcl (2.6.12-128) unstable; urgency=medium + + * Version_2.6.13pre128 + + -- Camm Maguire Sat, 12 Nov 2022 11:02:31 -0500 + +gcl (2.6.12-126) unstable; urgency=medium + + * Version_2.6.13pre126 + + -- Camm Maguire Tue, 08 Nov 2022 19:43:41 -0500 + +gcl (2.6.12-125) unstable; urgency=medium + + * Version_2.6.13pre125 + + -- Camm Maguire Tue, 08 Nov 2022 15:33:25 -0500 + +gcl (2.6.12-124) unstable; urgency=medium + + * Version_2.6.13pre124 + + -- Camm Maguire Thu, 11 Aug 2022 13:16:42 -0400 + +gcl (2.6.12-123) unstable; urgency=medium + + * Version_2.6.13pre123 + + -- Camm Maguire Mon, 08 Aug 2022 13:00:55 -0400 + +gcl (2.6.12-122) unstable; urgency=medium + + * Version_2.6.13pre122 + + -- Camm Maguire Mon, 08 Aug 2022 11:50:22 -0400 + +gcl (2.6.12-121) unstable; urgency=medium + + * Version_2.6.13pre121 + + -- Camm Maguire Mon, 08 Aug 2022 11:45:30 -0400 + +gcl (2.6.12-120) unstable; urgency=medium + + * Version_2.6.13pre120 + + -- Camm Maguire Sun, 07 Aug 2022 12:26:10 -0400 + +gcl (2.6.12-119) unstable; urgency=medium + + * Version_2.6.13pre119 + + -- Camm Maguire Sun, 31 Jul 2022 12:00:02 -0400 + +gcl (2.6.12-118) unstable; urgency=medium + + * Bug fix: "emacs dependency should be "emacs | emacsen"", + thanks to Adrian Bunk (Closes: #1006617). + * Bug fix: "Please remove dependency on install-info", thanks to + hille42@web.de; (Closes: #1013691). + * Version_2.6.13pre118 + + -- Camm Maguire Tue, 12 Jul 2022 17:17:09 -0400 + +gcl (2.6.12-117) unstable; urgency=medium + + * Version_2.6.13pre114 + + -- Camm Maguire Sat, 25 Dec 2021 11:38:16 -0500 + +gcl (2.6.12-116) unstable; urgency=medium + + * Version_2.6.13pre113 + + -- Camm Maguire Wed, 22 Dec 2021 19:52:18 +0000 + +gcl (2.6.12-115) unstable; urgency=medium + + * Version_2.6.13pre112 + + -- Camm Maguire Fri, 17 Dec 2021 16:08:45 +0000 + +gcl (2.6.12-114) unstable; urgency=medium + + * Version_2.6.13pre111 + + -- Camm Maguire Thu, 16 Dec 2021 11:35:04 +0000 + +gcl (2.6.12-113) unstable; urgency=medium + + * Version_2.6.13pre110 + + -- Camm Maguire Thu, 16 Dec 2021 11:35:04 +0000 + +gcl (2.6.12-112) unstable; urgency=medium + + * Version_2.6.13pre109 + + -- Camm Maguire Wed, 15 Dec 2021 19:39:42 +0000 + +gcl (2.6.12-111) unstable; urgency=medium + + * Version_2.6.13pre108 + + -- Camm Maguire Thu, 11 Nov 2021 17:10:43 +0000 + +gcl (2.6.12-110) unstable; urgency=medium + + * Version_2.6.13pre107 + + -- Camm Maguire Thu, 11 Nov 2021 01:34:07 +0000 + +gcl (2.6.12-109) unstable; urgency=medium + + * Version_2.6.13pre106 + + -- Camm Maguire Wed, 10 Nov 2021 18:57:21 +0000 + +gcl (2.6.12-108) unstable; urgency=medium + + * Version_2.6.13pre105 + + -- Camm Maguire Tue, 09 Nov 2021 18:22:58 +0000 + +gcl (2.6.12-107) unstable; urgency=medium + + * Version_2.6.13pre103 + + -- Camm Maguire Tue, 09 Nov 2021 10:10:19 +0000 + +gcl (2.6.12-106) unstable; urgency=medium + + * Version_2.6.13pre102 + + -- Camm Maguire Thu, 04 Nov 2021 14:33:53 +0000 + +gcl (2.6.12-105) unstable; urgency=medium + + * Version_2.6.13pre101 + * Bug fix: "fails to start with glibc 2.33", thanks to Andreas Kloeckner + (Closes: #995323). + + -- Camm Maguire Sun, 10 Oct 2021 13:18:39 +0000 + +gcl (2.6.12-104) unstable; urgency=medium + + * Version_2.6.13pre100 + * standardize cstack start address on 32bit arm + + -- Camm Maguire Sun, 10 Oct 2021 12:44:51 +0000 + +gcl (2.6.12-103) unstable; urgency=medium + + * Bug fix: "Fails to install in unstable", thanks to Samuel Thibault + (Closes: #993480). + + -- Camm Maguire Sat, 04 Sep 2021 19:23:26 +0000 + +gcl (2.6.12-102) unstable; urgency=medium + + * Version_2.6.13pre99 + * Bug fix: "describe fails because gcl-si.info does not exist", thanks + to Leo Butler (Closes: #980003). + + -- Camm Maguire Fri, 29 Jan 2021 19:08:05 +0000 + +gcl (2.6.12-101) unstable; urgency=medium + + * Version_2.6.13pre98 + + -- Camm Maguire Sun, 17 Jan 2021 16:25:34 +0000 + +gcl (2.6.12-100) unstable; urgency=medium + + * Version_2.6.13pre97 + + -- Camm Maguire Fri, 04 Dec 2020 14:51:41 +0000 + +gcl (2.6.12-99) unstable; urgency=medium + + * Version_2.6.13pre95 + + -- Camm Maguire Sat, 28 Nov 2020 15:50:42 +0000 + +gcl (2.6.12-98) unstable; urgency=medium + + * Version_2.6.13pre94 + + -- Camm Maguire Tue, 29 Sep 2020 18:29:10 +0000 + +gcl (2.6.12-97) unstable; urgency=medium + + * Bug fix: "Removal of obsolete debhelper compat 5 and 6 in bookworm", + thanks to Niels Thykier (Closes: #965543). + * Version_2.6.13pre93 + + -- Camm Maguire Sat, 29 Aug 2020 16:23:07 +0000 + +gcl (2.6.12-96) unstable; urgency=high + + * Version_2.6.13pre92: Work around armhf strip bug producing undefined + instruction in .plt + + -- Camm Maguire Sun, 23 Aug 2020 17:53:14 +0000 + +gcl (2.6.12-95) unstable; urgency=high + + * Version_2_6_13pre90 + * build under GCL_MEM_MULTIPLE=0.1 + * Bug fix: "FTBFS: Unrecoverable error: Segmentation violation..", + thanks to Lucas Nussbaum (Closes: #952334). + + -- Camm Maguire Fri, 01 May 2020 12:55:02 +0000 + +gcl (2.6.12-94) unstable; urgency=medium + + * re-release to overcome hopefully transient buildd failure + + -- Camm Maguire Mon, 24 Feb 2020 20:02:52 +0000 + +gcl (2.6.12-93) unstable; urgency=medium + + * Version_2_6_13pre90 + + -- Camm Maguire Fri, 21 Feb 2020 19:06:56 +0000 + +gcl (2.6.12-92) unstable; urgency=medium + + * Version_2_6_13pre89 + + -- Camm Maguire Mon, 30 Dec 2019 15:46:22 +0000 + +gcl (2.6.12-91) unstable; urgency=medium + + * Version_2_6_13pre88 + + -- Camm Maguire Wed, 18 Dec 2019 20:14:09 +0000 + +gcl (2.6.12-90) unstable; urgency=medium + + * Version_2_6_13pre87 + * latest standards + + -- Camm Maguire Sun, 08 Dec 2019 19:27:24 +0000 + +gcl (2.6.12-89) unstable; urgency=medium + + * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks + to thierry.fauck@fr.ibm.com; (Closes: #942312). + * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes: + #944651). + + -- Camm Maguire Sat, 07 Dec 2019 23:27:53 +0000 + +gcl (2.6.12-88) unstable; urgency=medium + + * Source only upload + + -- Camm Maguire Fri, 11 Oct 2019 19:18:44 +0000 + +gcl (2.6.12-87) unstable; urgency=medium + + * Version_2_6_13pre84 + + -- Camm Maguire Sat, 06 Apr 2019 13:03:21 +0000 + +gcl (2.6.12-86) unstable; urgency=medium + + * Version_2_6_13pre83 + + -- Camm Maguire Tue, 02 Apr 2019 19:57:15 +0000 + +gcl (2.6.12-85) unstable; urgency=medium + + * Version_2_6_13pre82 + + -- Camm Maguire Thu, 28 Mar 2019 18:48:55 +0000 + +gcl (2.6.12-84) unstable; urgency=medium + + * Version_2_6_13pre80 + + -- Camm Maguire Thu, 21 Mar 2019 18:59:40 +0000 + +gcl (2.6.12-83) unstable; urgency=high + + * Version_2_6_13pre79 + * Fix acl2 arm builds (Closes: #919477). + + -- Camm Maguire Tue, 05 Feb 2019 21:54:42 +0000 + +gcl (2.6.12-82) unstable; urgency=high + + * Version_2_6_13pre74 + + -- Camm Maguire Sat, 02 Feb 2019 17:40:20 +0000 + +gcl (2.6.12-81) unstable; urgency=high + + * Version_2_6_13pre72 + * Fix to ppc64el for acl2 FTBFS bug + + -- Camm Maguire Mon, 21 Jan 2019 16:40:36 +0000 + +gcl (2.6.12-80) unstable; urgency=medium + + * Version_2_6_13pre71 + * Bug fix: "FTBFS on hppa - segmentation fault assembling gbc.s", thanks + to John David Anglin (Closes: #912071). + + -- Camm Maguire Tue, 30 Oct 2018 17:20:43 +0000 + +gcl (2.6.12-79) unstable; urgency=medium + + * Version_2_6_13pre70 + + -- Camm Maguire Mon, 29 Oct 2018 16:52:17 +0000 + +gcl (2.6.12-78) unstable; urgency=medium + + * rebuild against latest compilers and tools + * Version_2_6_13pre69 + + -- Camm Maguire Thu, 11 Oct 2018 16:40:48 +0000 + +gcl (2.6.12-77) unstable; urgency=medium + + * Version_2_6_13pre68 + * Bug fix: "GCL fails to load .o files it generates", thanks to Gong-Yi + Liao (Closes: #902475). Add support for R_X86_64_PLT32 relocs. + + -- Camm Maguire Tue, 24 Jul 2018 20:06:45 +0000 + +gcl (2.6.12-76) unstable; urgency=medium + + * Version_2_6_13pre67 + + -- Camm Maguire Fri, 23 Mar 2018 19:25:22 +0000 + +gcl (2.6.12-75) unstable; urgency=medium + + * Version_2_6_13pre65 + + -- Camm Maguire Wed, 21 Mar 2018 20:28:08 +0000 + +gcl (2.6.12-74) unstable; urgency=medium + + * Version_2_6_13pre63 + + -- Camm Maguire Sat, 17 Mar 2018 11:56:05 +0000 + +gcl (2.6.12-73) unstable; urgency=medium + + * Version_2_6_13pre62 + + -- Camm Maguire Wed, 14 Mar 2018 15:38:43 +0000 + +gcl (2.6.12-72) unstable; urgency=medium + + * Version_2_6_13pre61 + + -- Camm Maguire Tue, 13 Mar 2018 15:32:44 +0000 + +gcl (2.6.12-71) unstable; urgency=medium + + * Version_2_6_13pre60 + + -- Camm Maguire Mon, 12 Mar 2018 19:44:47 +0000 + +gcl (2.6.12-70) unstable; urgency=medium + + * Version_2_6_13pre59 + + -- Camm Maguire Mon, 12 Mar 2018 16:19:00 +0000 + +gcl (2.6.12-69) unstable; urgency=medium + + * Version_2_6_13pre58 + + -- Camm Maguire Fri, 09 Mar 2018 17:10:51 +0000 + +gcl (2.6.12-68) unstable; urgency=medium + + * Version_2_6_13pre57 + + -- Camm Maguire Sun, 04 Mar 2018 13:21:00 +0000 + +gcl (2.6.12-67) unstable; urgency=medium + + * Version_2_6_13pre55 + + -- Camm Maguire Sat, 03 Mar 2018 14:27:51 +0000 + +gcl (2.6.12-66) unstable; urgency=medium + + * Version_2_6_13pre54 + + -- Camm Maguire Fri, 02 Mar 2018 21:19:03 +0000 + +gcl (2.6.12-65) unstable; urgency=medium + + * Version_2_6_13pre52 + * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com; + (Closes: #802593). + + -- Camm Maguire Fri, 23 Feb 2018 15:55:23 +0000 + +gcl (2.6.12-64) unstable; urgency=medium + + * list_order.24 + + -- Camm Maguire Sun, 04 Feb 2018 13:26:27 +0000 + +gcl (2.6.12-63) unstable; urgency=medium + + * list_order.23 + + -- Camm Maguire Thu, 01 Feb 2018 18:36:29 +0000 + +gcl (2.6.12-62) unstable; urgency=medium + + * list_order.22 + + -- Camm Maguire Thu, 01 Feb 2018 01:05:10 +0000 + +gcl (2.6.12-61) unstable; urgency=medium + + * list_order.21 + + -- Camm Maguire Tue, 30 Jan 2018 21:13:13 +0000 + +gcl (2.6.12-60) unstable; urgency=medium + + * list_order.19 + + -- Camm Maguire Tue, 23 Jan 2018 18:11:59 +0000 + +gcl (2.6.12-59) unstable; urgency=medium + + * list_order.16 + + -- Camm Maguire Fri, 12 Jan 2018 03:25:08 +0000 + +gcl (2.6.12-58) unstable; urgency=medium + + * list_order.14 + + -- Camm Maguire Mon, 18 Sep 2017 15:45:10 +0000 + +gcl (2.6.12-57) unstable; urgency=medium + + * list_order.13 + + -- Camm Maguire Fri, 25 Aug 2017 13:44:10 +0000 + +gcl (2.6.12-56) unstable; urgency=medium + + * list_order.12 + + -- Camm Maguire Thu, 24 Aug 2017 19:12:50 +0000 + +gcl (2.6.12-55) unstable; urgency=medium + + * disable gprof on aarch64 + * Bug fix: "gcl FTBFS on arm64: Unrecoverable error: Segmentation + violation..", thanks to Adrian Bunk (Closes: #873052). + + -- Camm Maguire Thu, 24 Aug 2017 16:37:07 +0000 + +gcl (2.6.12-54) unstable; urgency=medium + + * list_order.11 + + -- Camm Maguire Wed, 23 Aug 2017 22:19:14 +0000 + +gcl (2.6.12-53) unstable; urgency=medium + + * list_order.9 + + -- Camm Maguire Sun, 18 Jun 2017 18:32:30 +0000 + +gcl (2.6.12-52) unstable; urgency=medium + + * list_order.8 + + -- Camm Maguire Thu, 15 Jun 2017 18:04:41 +0000 + +gcl (2.6.12-51) unstable; urgency=medium + + * list_order.7 + + -- Camm Maguire Wed, 14 Jun 2017 18:30:46 +0000 + +gcl (2.6.12-50) unstable; urgency=medium + + * list_order.6 + + -- Camm Maguire Tue, 13 Jun 2017 22:38:52 +0000 + +gcl (2.6.12-49) unstable; urgency=medium + + * list_order.5 + + -- Camm Maguire Thu, 08 Jun 2017 17:21:01 +0000 + +gcl (2.6.12-48) unstable; urgency=medium + + * list_order.1 + + -- Camm Maguire Sun, 28 May 2017 01:42:29 +0000 + +gcl (2.6.12-47) unstable; urgency=high + + * pathnames1.13 + + -- Camm Maguire Tue, 22 Nov 2016 04:53:35 +0000 + +gcl (2.6.12-46) unstable; urgency=high + + * pathnames1.12 + * Bug fix: "maintainer script(s) do not start on #!", thanks to + treinen@debian.org; (Closes: #843303). + + -- Camm Maguire Fri, 18 Nov 2016 18:27:53 +0000 + +gcl (2.6.12-45) unstable; urgency=high + + * pathnames1.11 + + -- Camm Maguire Mon, 31 Oct 2016 22:57:27 +0000 + +gcl (2.6.12-44) unstable; urgency=high + + * pathnames1.9 + + -- Camm Maguire Fri, 28 Oct 2016 17:04:38 +0000 + +gcl (2.6.12-43) unstable; urgency=medium + + * pathnames1.7 + + -- Camm Maguire Thu, 27 Oct 2016 03:46:32 +0000 + +gcl (2.6.12-42) unstable; urgency=medium + + * pathnames1.6 + * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey + (Closes: #837481). + * Bug fix: "FTBFS with compilers that default to -fPIE (patch + attached)", thanks to Adam Conrad (Closes: #822820). + + -- Camm Maguire Wed, 26 Oct 2016 23:04:57 +0000 + +gcl (2.6.12-41) unstable; urgency=medium + + * pathnames1.4, kfreebsd fix + + -- Camm Maguire Fri, 14 Oct 2016 01:17:18 +0000 + +gcl (2.6.12-40) unstable; urgency=medium + + * pathnames1.2 + * Bug fix: "popen arguments not quoted causes trouble and security + issues", thanks to axel (Closes: #802203). + + -- Camm Maguire Wed, 12 Oct 2016 18:09:26 +0000 + +gcl (2.6.12-39) unstable; urgency=medium + + * pathnames1.1 + * ansi-test clean target + + -- Camm Maguire Wed, 12 Oct 2016 01:32:05 +0000 + +gcl (2.6.12-38) unstable; urgency=medium + + * Version_2_6_13pre50 + + -- Camm Maguire Tue, 04 Oct 2016 19:45:38 +0000 + +gcl (2.6.12-37) unstable; urgency=medium + + * Version_2_6_13pre49 + + -- Camm Maguire Mon, 03 Oct 2016 14:54:09 +0000 + +gcl (2.6.12-36) unstable; urgency=medium + + * Version_2_6_13pre48 + + -- Camm Maguire Sat, 01 Oct 2016 12:10:25 +0000 + +gcl (2.6.12-35) unstable; urgency=medium + + * Version_2_6_13pre47 + + -- Camm Maguire Fri, 30 Sep 2016 21:21:43 +0000 + +gcl (2.6.12-34) unstable; urgency=medium + + * Version_2_6_13pre45 + + -- Camm Maguire Fri, 23 Sep 2016 19:42:37 +0000 + +gcl (2.6.12-33) unstable; urgency=medium + + * Version_2_6_13pre43 + + -- Camm Maguire Tue, 03 May 2016 16:17:03 +0000 + +gcl (2.6.12-32) unstable; urgency=medium + + * Version_2_6_13pre40 + * Bug fix: "[INTL:pt_BR] Brazilian Portuguese debconf templates + translation", thanks to Adriano Rafael Gomes (Closes: #811523). + + -- Camm Maguire Wed, 20 Apr 2016 15:18:35 +0000 + +gcl (2.6.12-31) unstable; urgency=medium + + * Version_2_6_13pre39 + + -- Camm Maguire Mon, 11 Apr 2016 00:41:11 +0000 + +gcl (2.6.12-30) unstable; urgency=medium + + * Version_2_6_13pre38 + + -- Camm Maguire Wed, 06 Apr 2016 00:20:15 +0000 + +gcl (2.6.12-29) unstable; urgency=medium + + * Version_2_6_13pre35; support latest binutils + * Bug fix: "gcl ftbfs on amd64 and i386 with binutils from + experimental", thanks to Matthias Klose (Closes: #803214). + + -- Camm Maguire Thu, 29 Oct 2015 15:20:27 +0000 + +gcl (2.6.12-28) unstable; urgency=medium + + * Version_2_6_13pre35; restore hppa build + + -- Camm Maguire Tue, 27 Oct 2015 20:00:46 +0000 + +gcl (2.6.12-27) unstable; urgency=medium + + * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal. + + -- Camm Maguire Tue, 27 Oct 2015 16:35:06 +0000 + +gcl (2.6.12-26) unstable; urgency=medium + + * Version_2_6_13pre32 + + -- Camm Maguire Fri, 23 Oct 2015 00:03:34 +0000 + +gcl (2.6.12-25) unstable; urgency=medium + + * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix + + -- Camm Maguire Fri, 16 Oct 2015 15:03:03 +0000 + +gcl (2.6.12-24) unstable; urgency=medium + + * Version_2_6_13pre30 + + -- Camm Maguire Fri, 16 Oct 2015 02:44:23 +0000 + +gcl (2.6.12-23) unstable; urgency=medium + + * Version_2_6_13pre29 + + -- Camm Maguire Thu, 15 Oct 2015 18:09:59 +0000 + +gcl (2.6.12-22) unstable; urgency=medium + + * Version_2_6_13pre27 + + -- Camm Maguire Tue, 13 Oct 2015 14:38:53 +0000 + +gcl (2.6.12-21) unstable; urgency=medium + + * Version_2_6_13pre26 + + -- Camm Maguire Wed, 07 Oct 2015 15:14:27 +0000 + +gcl (2.6.12-20) unstable; urgency=medium + + * Version_2_6_13pre25 + + -- Camm Maguire Thu, 01 Oct 2015 15:16:14 +0000 + +gcl (2.6.12-19) unstable; urgency=medium + + * Use-dpkg-buidflags-opt-levels-in-debian-rules, -O3 has bug in 5.2.1 + * Version_2_6_13pre24 + + -- Camm Maguire Wed, 30 Sep 2015 15:45:20 +0000 + +gcl (2.6.12-18) unstable; urgency=medium + + * Version_2_6_13pre22 + + -- Camm Maguire Tue, 29 Sep 2015 16:51:03 +0000 + +gcl (2.6.12-17) unstable; urgency=medium + + * Version_2_6_13pre20 + + -- Camm Maguire Sat, 26 Sep 2015 10:34:23 -0400 + +gcl (2.6.12-16) unstable; urgency=medium + + * Version_2_6_13pre19 + + -- Camm Maguire Fri, 25 Sep 2015 18:39:52 -0400 + +gcl (2.6.12-15) unstable; urgency=medium + + * Version_2_6_13pre18 + + -- Camm Maguire Fri, 25 Sep 2015 15:08:50 +0000 + +gcl (2.6.12-14) unstable; urgency=medium + + * Version_2_6_13pre17 + + -- Camm Maguire Thu, 28 May 2015 03:37:47 +0000 + +gcl (2.6.12-13) unstable; urgency=medium + + * Version_2_6_13pre16 + + -- Camm Maguire Fri, 15 May 2015 18:09:38 +0000 + +gcl (2.6.12-12) unstable; urgency=medium + + * Version_2_6_13pre13 + + -- Camm Maguire Fri, 01 May 2015 11:08:46 -0400 + +gcl (2.6.12-11) unstable; urgency=medium + + * Version_2_6_13pre12 + + -- Camm Maguire Thu, 30 Apr 2015 12:49:16 -0400 + +gcl (2.6.12-10) unstable; urgency=medium + + * rebuild in clean sid environment + + -- Camm Maguire Mon, 27 Apr 2015 15:34:15 -0400 + +gcl (2.6.12-9) unstable; urgency=medium + + * Version_2_6_13pre8b + * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes: + #777866). + + -- Camm Maguire Mon, 27 Apr 2015 12:32:49 -0400 + +gcl (2.6.12-8) unstable; urgency=medium + + * Version_2_6_13pre7 + + -- Camm Maguire Fri, 24 Apr 2015 13:38:30 -0400 + +gcl (2.6.12-7) unstable; urgency=medium + + * Version_2_6_13pre6 + + -- Camm Maguire Thu, 23 Apr 2015 13:43:45 -0400 + +gcl (2.6.12-6) unstable; urgency=medium + + * Version_2_6_13pre5 + + -- Camm Maguire Wed, 22 Apr 2015 17:14:16 -0400 + +gcl (2.6.12-5) unstable; urgency=medium + + * Version_2_6_13pre4 + + -- Camm Maguire Wed, 22 Apr 2015 10:25:36 -0400 + +gcl (2.6.12-4) unstable; urgency=medium + + * Version_2_6_13pre3a + + -- Camm Maguire Mon, 20 Apr 2015 13:26:36 -0400 + +gcl (2.6.12-3) unstable; urgency=medium + + * Version_2_6_13pre2 + + -- Camm Maguire Fri, 17 Apr 2015 15:50:37 -0400 + +gcl (2.6.12-2) unstable; urgency=medium + + * Version_2_6_13pre1 + + -- Camm Maguire Wed, 26 Nov 2014 11:12:46 -0500 + +gcl (2.6.12-1) unstable; urgency=medium + + * New upstream release + + -- Camm Maguire Tue, 28 Oct 2014 09:56:15 -0400 + +gcl (2.6.11-6) unstable; urgency=medium + + * 2.6.12pre5 + + -- Camm Maguire Thu, 23 Oct 2014 17:33:22 -0400 + +gcl (2.6.11-5) unstable; urgency=medium + + * 2.6.12pre4 + + -- Camm Maguire Sat, 18 Oct 2014 09:46:34 -0400 + +gcl (2.6.11-4) unstable; urgency=medium + + * 2.6.12pre3 + + -- Camm Maguire Thu, 16 Oct 2014 11:56:15 -0400 + +gcl (2.6.11-3) unstable; urgency=medium + + * 2.6.12pre2 + + -- Camm Maguire Sun, 28 Sep 2014 20:56:18 -0400 + +gcl (2.6.11-2) unstable; urgency=medium + + * 2.6.12pre1 + + -- Camm Maguire Fri, 19 Sep 2014 14:49:25 -0400 + +gcl (2.6.11-1) unstable; urgency=medium + + * New upstream release + + -- Camm Maguire Sat, 06 Sep 2014 12:28:46 -0400 + +gcl (2.6.10-54) unstable; urgency=medium + + * remove-debug-message-from-BUGGY_MAXIMUM_SSCANF_LENGTH-code + + -- Camm Maguire Fri, 05 Sep 2014 10:35:46 -0400 + +gcl (2.6.10-53) unstable; urgency=medium + + * ppc64le-support-headers + + -- Camm Maguire Wed, 03 Sep 2014 15:02:12 -0400 + +gcl (2.6.10-52) unstable; urgency=medium + + * accept-TMP-paths-with-types-versions + + -- Camm Maguire Fri, 29 Aug 2014 17:51:04 -0400 + +gcl (2.6.10-51) unstable; urgency=medium + + * fix-match-function-proclaim-skew + + -- Camm Maguire Fri, 29 Aug 2014 16:40:30 +0000 + +gcl (2.6.10-50) unstable; urgency=medium + + * trial_selinux_support + + -- Camm Maguire Thu, 21 Aug 2014 17:29:50 +0000 + +gcl (2.6.10-49) unstable; urgency=medium + + * R_ARM_JUMP24 + + -- Camm Maguire Wed, 20 Aug 2014 17:08:23 +0000 + +gcl (2.6.10-48) unstable; urgency=medium + + * try-SGC-for-aarch64 + + -- Camm Maguire Tue, 19 Aug 2014 18:35:22 +0000 + +gcl (2.6.10-47) unstable; urgency=medium + + * set-stack_guard-after-alloc-setup + * Bug fix: "work around build failure on AArch64", thanks to Matthias + Klose (Closes: #758101). + + -- Camm Maguire Thu, 14 Aug 2014 19:36:48 +0000 + +gcl (2.6.10-46) unstable; urgency=medium + + * R_AARCH64_LDST128_ABS_LO12_NC + + -- Camm Maguire Wed, 13 Aug 2014 21:39:50 +0000 + +gcl (2.6.10-45) unstable; urgency=medium + + * fix sh4 CLEAR_CACHE + + -- Camm Maguire Sun, 10 Aug 2014 20:12:03 +0000 + +gcl (2.6.10-44) unstable; urgency=medium + + * clear_protect_memory on all elf machines + + -- Camm Maguire Sat, 09 Aug 2014 00:55:17 +0000 + +gcl (2.6.10-43) unstable; urgency=medium + + * mips uses builtin_clear_cache like mipsel + + -- Camm Maguire Fri, 08 Aug 2014 23:42:42 +0000 + +gcl (2.6.10-42) unstable; urgency=medium + + * backport travel_push_new from master + + -- Camm Maguire Wed, 06 Aug 2014 20:14:14 +0000 + +gcl (2.6.10-41) unstable; urgency=medium + + * protos and CFLAGS for axiom extensions + + -- Camm Maguire Wed, 06 Aug 2014 01:54:38 +0000 + +gcl (2.6.10-40) unstable; urgency=medium + + * better solaris unexec fix + + -- Camm Maguire Mon, 04 Aug 2014 22:00:54 +0000 + +gcl (2.6.10-39) unstable; urgency=medium + + * earlier prelink_init, phys_pages w/o malloc + + -- Camm Maguire Mon, 04 Aug 2014 16:52:09 +0000 + +gcl (2.6.10-38) unstable; urgency=medium + + * error on overflow of array dimensions + + -- Camm Maguire Fri, 01 Aug 2014 14:35:44 +0000 + +gcl (2.6.10-37) unstable; urgency=medium + + * FILE * casts for windows feof wrapper + + -- Camm Maguire Thu, 31 Jul 2014 02:17:11 +0000 + +gcl (2.6.10-36) unstable; urgency=medium + + * better casts for frs_jmpbuf + + -- Camm Maguire Wed, 30 Jul 2014 17:00:06 +0000 + +gcl (2.6.10-35) unstable; urgency=medium + + * find_sym_ptable typo fix + + -- Camm Maguire Tue, 29 Jul 2014 18:08:57 +0000 + +gcl (2.6.10-34) unstable; urgency=medium + + * --enable-prelink configure arg; stack_chk_guard for 68k + + -- Camm Maguire Fri, 25 Jul 2014 20:39:10 +0000 + +gcl (2.6.10-33) unstable; urgency=medium + + * hurd stack_guard, ppc64 C_GC_OFFSET + + -- Camm Maguire Thu, 24 Jul 2014 21:46:24 +0000 + +gcl (2.6.10-32) unstable; urgency=medium + + * __stack_chk_guard fix for arm/sh4 + + -- Camm Maguire Wed, 23 Jul 2014 18:12:56 +0000 + +gcl (2.6.10-31) unstable; urgency=medium + + * dpkg-buildflags trial + + -- Camm Maguire Tue, 22 Jul 2014 20:06:10 +0000 + +gcl (2.6.10-30) unstable; urgency=medium + + * fix offsets ppc + + -- Camm Maguire Tue, 22 Jul 2014 17:12:27 +0000 + +gcl (2.6.10-29) unstable; urgency=medium + + * fix unexec file offsets + + -- Camm Maguire Tue, 22 Jul 2014 15:36:45 +0000 + +gcl (2.6.10-28) unstable; urgency=high + + * enable prelink + + -- Camm Maguire Fri, 18 Jul 2014 19:24:38 +0000 + +gcl (2.6.10-27) unstable; urgency=high + + * protect closure calls from gc + + -- Camm Maguire Wed, 16 Jul 2014 16:15:33 +0000 + +gcl (2.6.10-26) unstable; urgency=high + + * Bug fix: "packages should not build-depend on binutils-dev", thanks to + Matthias Klose (Closes: #754840). Please note that gcl has long + depended on binutils-dev for good reason -- happily it is no longer + necessary + + -- Camm Maguire Tue, 15 Jul 2014 16:04:04 +0000 + +gcl (2.6.10-25) unstable; urgency=high + + * rebuild to get gcc fixes on i386 + + -- Camm Maguire Fri, 11 Jul 2014 03:14:45 +0000 + +gcl (2.6.10-24) unstable; urgency=high + + * try default gcc 4.9 + * access libopcodes without link dependency via dlopen + * Bug fix: "please switch to emacs24", thanks to Gabriele Giacone + (Closes: #754012). + + -- Camm Maguire Wed, 09 Jul 2014 17:34:21 +0000 + +gcl (2.6.10-23) unstable; urgency=high + + * rebuild latest binutils + + -- Camm Maguire Sat, 05 Jul 2014 23:19:27 +0000 + +gcl (2.6.10-22) unstable; urgency=high + + * gcc-4.8 on i386, 4.9 has bugs at present + + -- Camm Maguire Fri, 04 Jul 2014 01:36:06 +0000 + +gcl (2.6.10-21) unstable; urgency=high + + * 2.6.11pre test 20 + + -- Camm Maguire Mon, 30 Jun 2014 22:43:27 +0000 + +gcl (2.6.10-20) unstable; urgency=high + + * 2.6.11pre test 19 + + -- Camm Maguire Sun, 29 Jun 2014 17:59:59 +0000 + +gcl (2.6.10-19) unstable; urgency=high + + * 2.6.11pre test 18 + + -- Camm Maguire Sun, 29 Jun 2014 16:00:07 +0000 + +gcl (2.6.10-18) unstable; urgency=high + + * 2.6.11pre test 17 + + -- Camm Maguire Sat, 28 Jun 2014 16:57:54 +0000 + +gcl (2.6.10-17) unstable; urgency=high + + * 2.6.11pre test 16 + + -- Camm Maguire Thu, 26 Jun 2014 18:06:42 +0000 + +gcl (2.6.10-16) unstable; urgency=high + + * 2.6.11pre test 15 + + -- Camm Maguire Wed, 18 Jun 2014 17:37:36 +0000 + +gcl (2.6.10-15) unstable; urgency=high + + * 2.6.11pre test 14 + + -- Camm Maguire Tue, 17 Jun 2014 00:39:35 +0000 + +gcl (2.6.10-14) unstable; urgency=high + + * 2.6.11pre test 13 + + -- Camm Maguire Sat, 14 Jun 2014 13:43:57 +0000 + +gcl (2.6.10-13) unstable; urgency=high + + * 2.6.11pre test 12 + + -- Camm Maguire Tue, 20 May 2014 16:00:22 +0000 + +gcl (2.6.10-12) unstable; urgency=high + + * 2.6.11pre test 11 + + -- Camm Maguire Fri, 16 May 2014 17:41:33 +0000 + +gcl (2.6.10-11) unstable; urgency=high + + * 2.6.11pre test 10 + + -- Camm Maguire Fri, 16 May 2014 13:18:07 +0000 + +gcl (2.6.10-10) unstable; urgency=high + + * 2.6.11pre test 9 + + -- Camm Maguire Wed, 07 May 2014 17:10:30 +0000 + +gcl (2.6.10-9) unstable; urgency=high + + * 2.6.11pre test 8 + + -- Camm Maguire Fri, 25 Apr 2014 19:53:10 +0000 + +gcl (2.6.10-8) unstable; urgency=high + + * 2.6.11pre test 7 + + -- Camm Maguire Mon, 21 Apr 2014 14:09:37 +0000 + +gcl (2.6.10-7) unstable; urgency=high + + * 2.6.11pre test 6 + + -- Camm Maguire Sat, 19 Apr 2014 17:52:17 +0000 + +gcl (2.6.10-6) unstable; urgency=high + + * 2.6.11pre test 5 + + -- Camm Maguire Fri, 18 Apr 2014 15:06:09 +0000 + +gcl (2.6.10-5) unstable; urgency=high + + * 2.6.11pre test 4 + + -- Camm Maguire Tue, 15 Apr 2014 20:30:13 +0000 + +gcl (2.6.10-4) unstable; urgency=high + + * 2.6.11pre test 3 + * Bug fix: "debian/rules uses DEB_BUILD_* macros instead of DEB_HOST_* + macros", thanks to Matthias Klose (Closes: #743520). + + -- Camm Maguire Wed, 09 Apr 2014 13:15:32 +0000 + +gcl (2.6.10-3) unstable; urgency=high + + * 2.6.11pre test 2 + + -- Camm Maguire Thu, 03 Apr 2014 14:24:23 +0000 + +gcl (2.6.10-2) unstable; urgency=high + + * 2.6.11pre test 1 + * Bug fix: "FTBFS: gcl_readline.d:472:39: error: 'CPPFunction' + undeclared (first use in this function)", thanks to David Suárez + (Closes: #741819). + + -- Camm Maguire Mon, 24 Mar 2014 15:47:01 +0000 + +gcl (2.6.10-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 13 Nov 2013 18:39:19 +0000 + +gcl (2.6.9-17) unstable; urgency=high + + * 2.6.10pre test 17 + + -- Camm Maguire Mon, 11 Nov 2013 19:41:45 +0000 + +gcl (2.6.9-16) unstable; urgency=high + + * 2.6.10pre test 16 + * Bug fix: "gcl 2.6.7+dfsga-20 needs 1 GB disk space on amd64", thanks + to Edi Meier (Closes: #714507). + * Bug fix: "[INTL:ja] New Japanese translation", thanks to victory + (Closes: #718925). + + -- Camm Maguire Sat, 09 Nov 2013 13:34:32 +0000 + +gcl (2.6.9-15) unstable; urgency=high + + * 2.6.10pre test 15 + + -- Camm Maguire Sat, 02 Nov 2013 22:21:16 +0000 + +gcl (2.6.9-14) unstable; urgency=high + + * 2.6.10pre test 14 + + -- Camm Maguire Wed, 23 Oct 2013 17:44:14 +0000 + +gcl (2.6.9-13) unstable; urgency=high + + * environment allocation unrandomize.h + + -- Camm Maguire Mon, 21 Oct 2013 00:20:16 +0000 + +gcl (2.6.9-12) unstable; urgency=high + + * 2.6.10pre test 13 + + -- Camm Maguire Fri, 18 Oct 2013 14:18:17 +0000 + +gcl (2.6.9-11) unstable; urgency=high + + * 2.6.10pre test 12, s390, mingw cleanup, make_bignum bug fix + + -- Camm Maguire Tue, 15 Oct 2013 23:32:09 +0000 + +gcl (2.6.9-10) unstable; urgency=high + + * fast-fixnums + + -- Camm Maguire Fri, 11 Oct 2013 15:05:58 +0000 + +gcl (2.6.9-9) unstable; urgency=high + + * 2.6.10pre test 10 and 11 + + -- Camm Maguire Wed, 02 Oct 2013 19:12:36 +0000 + +gcl (2.6.9-8) unstable; urgency=high + + * 2.6.10pre test 8 and 9 + + -- Camm Maguire Tue, 01 Oct 2013 21:00:19 +0000 + +gcl (2.6.9-7) unstable; urgency=high + + * 2.6.10pre test 6 and 7 + + -- Camm Maguire Mon, 30 Sep 2013 19:34:38 +0000 + +gcl (2.6.9-6) unstable; urgency=high + + * 2.6.10pre test 5 + + -- Camm Maguire Tue, 24 Sep 2013 17:03:24 +0000 + +gcl (2.6.9-5) unstable; urgency=high + + * 2.6.10pre test 4 + + -- Camm Maguire Mon, 23 Sep 2013 19:27:36 +0000 + +gcl (2.6.9-4) unstable; urgency=high + + * 2.6.10pre test 3 + + -- Camm Maguire Mon, 23 Sep 2013 16:30:09 +0000 + +gcl (2.6.9-3) unstable; urgency=high + + * 2.6.10pre test 2 + + -- Camm Maguire Sun, 22 Sep 2013 03:27:10 +0000 + +gcl (2.6.9-2) unstable; urgency=high + + * 2.6.10pre test + + -- Camm Maguire Sat, 21 Sep 2013 04:14:55 +0000 + +gcl (2.6.9-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 28 Aug 2013 16:49:18 +0000 + +gcl (2.6.7+dfsga-40) unstable; urgency=high + + * fix allocate functions + + -- Camm Maguire Tue, 06 Aug 2013 22:36:37 +0000 + +gcl (2.6.7+dfsga-39) unstable; urgency=high + + * lower initial contiguous and relblock allocations, set *ihs-top* + properly on startup, protect memory->cfd.cfd_start initialization from + gc + + -- Camm Maguire Mon, 05 Aug 2013 17:38:22 +0000 + +gcl (2.6.7+dfsga-38) unstable; urgency=high + + * robustify near oom handling to fix axiom compile of EXPEXPAN on mips + + -- Camm Maguire Fri, 02 Aug 2013 16:25:16 +0000 + +gcl (2.6.7+dfsga-37) unstable; urgency=high + + * ppc64 gprof fix + + -- Camm Maguire Fri, 26 Jul 2013 23:40:14 +0000 + +gcl (2.6.7+dfsga-36) unstable; urgency=high + + * min_pagewidth=14 on mips + + -- Camm Maguire Fri, 26 Jul 2013 02:20:56 +0000 + +gcl (2.6.7+dfsga-35) unstable; urgency=high + + * latest gcc on all platforms, no gprof ppc64, -O1 ia64, -O0 alpha + + -- Camm Maguire Thu, 25 Jul 2013 14:42:48 +0000 + +gcl (2.6.7+dfsga-34) unstable; urgency=high + + * sgc link_array mark fix;rb_end across save fix;more stable gcc on older arches + + -- Camm Maguire Tue, 23 Jul 2013 17:11:23 +0000 + +gcl (2.6.7+dfsga-33) unstable; urgency=high + + * fix mark_link_array for marked sLAlink_arrayA->s.s_dbind + + -- Camm Maguire Mon, 22 Jul 2013 19:00:43 +0000 + +gcl (2.6.7+dfsga-32) unstable; urgency=high + + * protect mark_link_array in sgc + + -- Camm Maguire Sat, 20 Jul 2013 00:16:07 +0000 + +gcl (2.6.7+dfsga-31) unstable; urgency=high + + * properly clean link array on gc + + -- Camm Maguire Fri, 19 Jul 2013 20:34:34 +0000 + +gcl (2.6.7+dfsga-30) unstable; urgency=high + + * fix gcl.script compiler::link, darwin compile warnings + + -- Camm Maguire Mon, 15 Jul 2013 20:35:03 +0000 + +gcl (2.6.7+dfsga-29) unstable; urgency=high + + * fix compiler::link in presence of gcl.script + + -- Camm Maguire Mon, 15 Jul 2013 16:23:33 +0000 + +gcl (2.6.7+dfsga-28) unstable; urgency=high + + * install unixport/gcl.script + + -- Camm Maguire Sat, 13 Jul 2013 18:42:28 +0000 + +gcl (2.6.7+dfsga-27) unstable; urgency=high + + * workaround for ia64 and hurd brk issues + + -- Camm Maguire Fri, 12 Jul 2013 21:44:54 +0000 + +gcl (2.6.7+dfsga-26) unstable; urgency=high + + * -- command line support, map-shared in unexec + + -- Camm Maguire Fri, 12 Jul 2013 00:52:35 +0000 + +gcl (2.6.7+dfsga-25) unstable; urgency=high + + * alpha, mips, 68k + + -- Camm Maguire Wed, 10 Jul 2013 18:29:37 +0000 + +gcl (2.6.7+dfsga-24) unstable; urgency=high + + * sgc and reloc fixes + + -- Camm Maguire Mon, 08 Jul 2013 13:56:33 +0000 + +gcl (2.6.7+dfsga-23) unstable; urgency=high + + * fix for maxima on kfbsd and sparc + + -- Camm Maguire Wed, 03 Jul 2013 19:19:16 +0000 + +gcl (2.6.7+dfsga-22) unstable; urgency=high + + * fix stack definition issues on i386 + + -- Camm Maguire Tue, 02 Jul 2013 18:27:54 +0000 + +gcl (2.6.7+dfsga-21) unstable; urgency=high + + * near out of memory robustification + + -- Camm Maguire Tue, 02 Jul 2013 15:32:58 +0000 + +gcl (2.6.7+dfsga-20) unstable; urgency=high + + * fix 3GB workaround for gprof + + -- Camm Maguire Fri, 21 Jun 2013 11:09:01 -0400 + +gcl (2.6.7+dfsga-19) unstable; urgency=high + + * work around 3GB personality/alloca/malloc bug + + -- Camm Maguire Fri, 21 Jun 2013 02:46:49 +0000 + +gcl (2.6.7+dfsga-18) unstable; urgency=high + + * alpha NULL_OR_ON_C_STACK, attempt to get 32 immfix space with + ADDR_LIMIT_3GB|ADDR_COMPAT_LAYOUT personality, clean compile with no + immfix + + -- Camm Maguire Thu, 20 Jun 2013 20:24:29 +0000 + +gcl (2.6.7+dfsga-17) unstable; urgency=high + + * small optimizations, #= nil fix + + -- Camm Maguire Wed, 19 Jun 2013 16:23:27 +0000 + +gcl (2.6.7+dfsga-16) unstable; urgency=high + + * no linker script on hurd;fix OBJ_ALIGN + + -- Camm Maguire Thu, 13 Jun 2013 15:35:00 +0000 + +gcl (2.6.7+dfsga-15) unstable; urgency=high + + * ia64 fix + + -- Camm Maguire Thu, 13 Jun 2013 02:38:47 +0000 + +gcl (2.6.7+dfsga-14) unstable; urgency=high + + * eliminate maxpage/dbegin, restore windows and macosx builds + + -- Camm Maguire Wed, 12 Jun 2013 21:42:29 +0000 + +gcl (2.6.7+dfsga-13) unstable; urgency=low + + * ia64/hurd/s390 and SGC + + -- Camm Maguire Sun, 09 Jun 2013 00:23:51 +0000 + +gcl (2.6.7+dfsga-12) unstable; urgency=low + + * ia64/hurd/s390 + + -- Camm Maguire Sat, 08 Jun 2013 15:24:46 +0000 + +gcl (2.6.7+dfsga-11) unstable; urgency=high + + * 2.6.9 test + + -- Camm Maguire Fri, 07 Jun 2013 21:46:41 +0000 + +gcl (2.6.7+dfsga-10) unstable; urgency=high + + * output mips make bug text to stderr + + -- Camm Maguire Sat, 25 May 2013 12:24:35 +0000 + +gcl (2.6.7+dfsga-9) unstable; urgency=high + + * mips make bug workaround + + -- Camm Maguire Wed, 22 May 2013 14:23:43 +0000 + +gcl (2.6.7+dfsga-8) unstable; urgency=high + + * revert doubled default maxpage + * export *read-eval* + + -- Camm Maguire Tue, 21 May 2013 14:42:05 +0000 + +gcl (2.6.7+dfsga-7) unstable; urgency=high + + * export ansi symbols + + -- Camm Maguire Sat, 11 May 2013 21:36:56 +0000 + +gcl (2.6.7+dfsga-6) unstable; urgency=high + + * fast hash-equal in compiler + + -- Camm Maguire Sat, 11 May 2013 19:11:42 +0000 + +gcl (2.6.7+dfsga-5) unstable; urgency=high + + * Bug fix: "FTBFS: cp: cannot stat + 'debian/tmp/usr/share/info/gcl-si.info': No such file or + directory", thanks to Lucas Nussbaum (Closes: #707490). + + -- Camm Maguire Fri, 10 May 2013 18:09:14 +0000 + +gcl (2.6.7+dfsga-4) unstable; urgency=high + + * sgc-on fix with latest gcc + + -- Camm Maguire Tue, 23 Apr 2013 18:45:11 +0000 + +gcl (2.6.7+dfsga-3) unstable; urgency=high + + * hash depth bug fix + * new s390 reloc + + -- Camm Maguire Thu, 24 Jan 2013 19:46:30 +0000 + +gcl (2.6.7+dfsga-2) unstable; urgency=high + + * more arm relocs supported;check default timezone dynamically;follow + bash ~ semantics in user-homedir-pathname + + -- Camm Maguire Mon, 21 Jan 2013 18:41:06 +0000 + +gcl (2.6.7+dfsga-1) unstable; urgency=high + + * Acknowledge Non-maintainer upload. + (thanks David Prévot ) + * Remove unused and non DFSG-compliant gmp3/gmp.* from source. + (Closes: #695721) + * Show translated debconf templates, thanks to Denis Barbier for the + analysis and the proposed fixes. (Closes: #691946) + * trim excess digits from printed floats + + -- Camm Maguire Tue, 15 Jan 2013 20:46:25 +0000 + +gcl (2.6.7-108) unstable; urgency=high + + * Depend on emacs23 | emacsen to allow wheezy propagation + + -- Camm Maguire Mon, 08 Oct 2012 18:08:36 +0000 + +gcl (2.6.7-107) unstable; urgency=high + + * mode 644 on ucf newfile + + -- Camm Maguire Wed, 03 Oct 2012 20:38:43 +0000 + +gcl (2.6.7-106) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Wed, 03 Oct 2012 16:52:10 +0000 + +gcl (2.6.7-105) unstable; urgency=high + + * restore #DEBHELPER# to postinst and postrm scripts + + -- Camm Maguire Mon, 01 Oct 2012 17:31:43 +0000 + +gcl (2.6.7-104) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Mon, 01 Oct 2012 15:32:52 +0000 + +gcl (2.6.7-103) unstable; urgency=high + + * sfaslelf.c: FIX_HIDDEN_SYMBOLS + + -- Camm Maguire Wed, 22 Aug 2012 15:13:12 +0000 + +gcl (2.6.7-102) unstable; urgency=high + + * Fix hash key distribution bug, bitvector equal bug + * distinguish car position in equal-hash of lists + + -- Camm Maguire Mon, 20 Aug 2012 17:33:26 +0000 + +gcl (2.6.7-101) unstable; urgency=high + + * add alpha, ppc, ppc64, and ia64 to __builtin__clear_cache exception + list as per gcc maintainers + * lintian cleanups + + -- Camm Maguire Sat, 05 May 2012 23:18:56 +0000 + +gcl (2.6.7-100) unstable; urgency=high + + * nil case keylist support + * Bug fix: "[INTL:da] Danish translation of the debconf templates gcl", + thanks to Joe Dalton (Closes: #666528). + + -- Camm Maguire Fri, 20 Apr 2012 02:25:26 +0000 + +gcl (2.6.7-99) unstable; urgency=low + + * case default error checking + + -- Camm Maguire Fri, 23 Mar 2012 14:14:44 +0000 + +gcl (2.6.7-98) unstable; urgency=low + + * restore traditional make-sequence,make-array, and coerce, and + optimize replace, as 2.6.8 compiler is still too weak re: inlines + + -- Camm Maguire Fri, 20 Jan 2012 19:55:45 +0000 + +gcl (2.6.7-97) unstable; urgency=low + + * evade __builtin___clear_cache on hppa + * make-array;make-sequence;replace;coerce + + -- Camm Maguire Fri, 20 Jan 2012 05:13:22 +0000 + +gcl (2.6.7-96) unstable; urgency=low + + * better XDR detection; no __builtin_clear_cache on sh4 + + -- Camm Maguire Wed, 18 Jan 2012 01:32:43 +0000 + +gcl (2.6.7-95) unstable; urgency=low + + * clear_cache after mprotect + + -- Camm Maguire Tue, 17 Jan 2012 03:54:56 +0000 + +gcl (2.6.7-94) unstable; urgency=low + + * optimize unwind at O0 to workaround gcc bug; centralize on + __builtin__clear_cache when available;arm_thm_call reloc support + + -- Camm Maguire Mon, 16 Jan 2012 20:10:07 +0000 + +gcl (2.6.7-93) unstable; urgency=low + + * remove C_GC_OFFSET for sparc64 + * remove ncurses dependency for readline + * Bug fix: "FTBFS: dpkg-buildpackage: error: dpkg-source -b gcl-2.6.7 + gave error exit status 2", thanks to Didier Raboud (Closes: #643131). + * Bug fix: "drops readline support if rebuilt", thanks to Sven Joachim + (Closes: #646735). + * lower opts on sparc64 asof gcc 4.6.1 + + -- Camm Maguire Wed, 11 Jan 2012 21:04:23 +0000 + +gcl (2.6.7-92) unstable; urgency=low + + * remove gprof on arm as mcount calls are 24/22bit -- marginally + accessible + + -- Camm Maguire Sat, 07 Jan 2012 02:42:06 +0000 + +gcl (2.6.7-91) unstable; urgency=low + + * s390x reloc support + * lower C optimization on ia64, arm and mips for now + + -- Camm Maguire Thu, 05 Jan 2012 17:30:01 +0000 + +gcl (2.6.7-90) unstable; urgency=low + + * libtirpc check for newest glibc + * read_preserving_whitespace fix + * armhf reloc support + * s390x support + * try C_GC_OFFSET for sparc64 + + -- Camm Maguire Wed, 04 Jan 2012 19:51:13 +0000 + +gcl (2.6.7-89) unstable; urgency=low + + * support new mips relocs + * lower opt to work around gcc 4.6 bug on arm + + -- Camm Maguire Wed, 11 May 2011 20:06:04 +0000 + +gcl (2.6.7-88) unstable; urgency=low + + * Bug fix: "FTBFS: gcl_arraylib.c:4:42: error: 'VV' undeclared + (first use in this function)", thanks to Lucas Nussbaum (Closes: + #625032). + + -- Camm Maguire Mon, 09 May 2011 16:00:21 +0000 + +gcl (2.6.7-87) unstable; urgency=low + + * mips reloc fix;configure default dlopen fix;clean rules and makefiles + + -- Camm Maguire Fri, 05 Nov 2010 13:29:05 +0000 + +gcl (2.6.7-86) unstable; urgency=low + + * remove binutils subdir, configure and make changes + + -- Camm Maguire Thu, 04 Nov 2010 17:55:48 +0000 + +gcl (2.6.7-85) unstable; urgency=low + + * fix mips relocs for non-static clines + + -- Camm Maguire Tue, 02 Nov 2010 13:56:40 +0000 + +gcl (2.6.7-84) unstable; urgency=low + + * better mips relocs, fix link on mingw32 + + -- Camm Maguire Sat, 30 Oct 2010 00:07:39 +0000 + +gcl (2.6.7-83) unstable; urgency=low + + * fix alpha stubs; fix sparc64 typo; print armhf relocs + + -- Camm Maguire Thu, 28 Oct 2010 13:43:16 +0000 + +gcl (2.6.7-82) unstable; urgency=low + + * mips64 fixes + + -- Camm Maguire Tue, 26 Oct 2010 18:20:04 +0000 + +gcl (2.6.7-81) unstable; urgency=low + + * sparc64;mips64 + + -- Camm Maguire Tue, 26 Oct 2010 03:33:52 +0000 + +gcl (2.6.7-80) unstable; urgency=low + + * alpha stubs; sgc mips kernel bug test; mips GPREL32 reloc + + -- Camm Maguire Mon, 25 Oct 2010 19:52:51 +0000 + +gcl (2.6.7-79) unstable; urgency=low + + * mips ld_bind_now, disable sgc workaround mips SIGBUS bug + + -- Camm Maguire Wed, 20 Oct 2010 15:31:59 +0000 + +gcl (2.6.7-78) unstable; urgency=low + + * mips local got relocs + + -- Camm Maguire Tue, 12 Oct 2010 17:15:35 +0000 + +gcl (2.6.7-77) unstable; urgency=low + + * workaround gcc alpha bug + * fix alpha reloc + + -- Camm Maguire Fri, 01 Oct 2010 21:25:11 +0000 + +gcl (2.6.7-76) unstable; urgency=low + + * fix page_multiple usage for runtime pagesize variance and stable mipsel builds + * sparc64 support + + -- Camm Maguire Fri, 01 Oct 2010 19:18:47 +0000 + +gcl (2.6.7-75) unstable; urgency=low + + * fix alpha bug + + -- Camm Maguire Tue, 28 Sep 2010 20:23:21 +0000 + +gcl (2.6.7-74) unstable; urgency=low + + * fix alpha relocs for axiom + + -- Camm Maguire Tue, 28 Sep 2010 16:07:38 +0000 + +gcl (2.6.7-73) unstable; urgency=low + + * sparc reloc updates + * fast-link fix + + -- Camm Maguire Fri, 24 Sep 2010 19:23:16 +0000 + +gcl (2.6.7-72) unstable; urgency=low + + * remove unused symbols from gcl_cmpopt.lsp + * reloc updates + * clear gcc warning + * default tilde expansion to HOME env in absence of passwd + * configure typo fix + + -- Camm Maguire Wed, 22 Sep 2010 19:32:52 +0000 + +gcl (2.6.7-71) unstable; urgency=low + + * print sparc64 relocs + + -- Camm Maguire Sat, 28 Aug 2010 14:50:00 +0000 + +gcl (2.6.7-70) unstable; urgency=low + + * sparc64/m68k + + -- Camm Maguire Fri, 27 Aug 2010 16:54:11 +0000 + +gcl (2.6.7-69) unstable; urgency=low + + * Bug fix: "non-standard gcc/g++ used for build (gcc-4.3)", thanks to + Matthias Klose (Closes: #594280). + + -- Camm Maguire Thu, 26 Aug 2010 19:08:39 +0000 + +gcl (2.6.7-68) unstable; urgency=low + + * ppc/mips elf reloc fixes + + -- Camm Maguire Mon, 23 Aug 2010 20:54:30 +0000 + +gcl (2.6.7-67) unstable; urgency=low + + * Fix compiler::link ansi combo + + -- Camm Maguire Sat, 21 Aug 2010 02:05:37 +0000 + +gcl (2.6.7-66) unstable; urgency=low + + * ppc autobuild fix + * Bug fix: "FTBFS: sfasli.c:139: error: invalid initializer", thanks to + Lucas Nussbaum (Closes: #593037). + * Bug fix: "FTBFS on powerpc: Error: The function TK::GET-AUTOLOADS is + undefined.", thanks to Mehdi Dogguy (Closes: #593191). + + -- Camm Maguire Fri, 20 Aug 2010 01:25:09 +0000 + +gcl (2.6.7-65) unstable; urgency=low + + * autobuilder fixes + + -- Camm Maguire Sat, 14 Aug 2010 11:30:46 +0000 + +gcl (2.6.7-64) unstable; urgency=low + + * configure fix + + -- Camm Maguire Fri, 13 Aug 2010 23:26:07 +0000 + +gcl (2.6.7-63) unstable; urgency=low + + * macosx support, ppc, i386 and x86_64 -- sfaslmacho.c + * windows/wine support -- sfaslcoff.c + * better custreloc support obviating my_plt -- sfaslelf.c + * debian default custreloc build where supported, all but ia64 and hppa + * fix mingw/wine path issues + + -- Camm Maguire Fri, 13 Aug 2010 16:08:49 +0000 + +gcl (2.6.7-62) unstable; urgency=high + + * more stable sgc detection via h/tsgc.h + * fix plt.h bug on hppa + * sublis1-inline fix for acl2 + + -- Camm Maguire Mon, 26 Jul 2010 16:03:54 +0000 + +gcl (2.6.7-61) unstable; urgency=high + + * mac osx support + * fix undef sgc bug in cmpinclude.h + + -- Camm Maguire Tue, 20 Jul 2010 14:50:19 +0000 + +gcl (2.6.7-60) unstable; urgency=high + + * fix sh4 support + + -- Camm Maguire Thu, 29 Apr 2010 18:09:04 +0000 + +gcl (2.6.7-59) unstable; urgency=high + + * fix hurd support + + -- Camm Maguire Fri, 23 Apr 2010 17:12:54 +0000 + +gcl (2.6.7-58) unstable; urgency=high + + * hurd support + * sh4 support + + -- Camm Maguire Fri, 23 Apr 2010 05:09:29 +0000 + +gcl (2.6.7-57) unstable; urgency=high + + * static function pointer wrapper for gcl_gmp_allocfun, stabilizing gmp + on hppa/ia64 + + -- Camm Maguire Mon, 12 Apr 2010 22:28:41 +0000 + +gcl (2.6.7-56) unstable; urgency=high + + * __builtin___clear_cache on arm + * gcc-4.3 on alpha + + -- Camm Maguire Thu, 28 Jan 2010 00:32:16 +0000 + +gcl (2.6.7-55) unstable; urgency=low + + * SGC fix, debian override fix, xgcl update + * SGC fix for relocatable and contiguous gmp storage + * configure fix for arm and hppa + + -- Camm Maguire Tue, 26 Jan 2010 19:43:08 +0000 + +gcl (2.6.7-54) unstable; urgency=low + + * robustify user_match, unrandomize, read-char-no-hang for sockets + * SA_SIGINFO for 386-linux + * if cmpinclude.h is not available, use *cmpinclude-string* in compiler-pass2 + + -- Camm Maguire Wed, 20 Jan 2010 19:02:28 +0000 + +gcl (2.6.7-53) unstable; urgency=low + + * revert round ratio to nearest + + -- Camm Maguire Tue, 05 Jan 2010 03:06:59 +0000 + +gcl (2.6.7-52) unstable; urgency=low + + * SIGINFO for kfreebsd-386 + + -- Camm Maguire Mon, 04 Jan 2010 17:49:05 +0000 + +gcl (2.6.7-51) unstable; urgency=low + + * user_match exscapes once only + + -- Camm Maguire Sun, 03 Jan 2010 05:31:20 +0000 + +gcl (2.6.7-50) unstable; urgency=low + + * gcc 4.4 warning cleanups + + -- Camm Maguire Thu, 31 Dec 2009 20:43:39 +0000 + +gcl (2.6.7-49) unstable; urgency=low + + * Bug fix: "/bin/sh: line 6: /bin/gcl: Permission denied", thanks to + Nobuhiro Iwamatsu (Closes: #561554). + + -- Camm Maguire Wed, 30 Dec 2009 23:04:39 +0000 + +gcl (2.6.7-48) unstable; urgency=low + + * round to nearest in ratio to double + + -- Camm Maguire Wed, 16 Dec 2009 15:01:55 +0000 + +gcl (2.6.7-47) unstable; urgency=low + + * Bug fix: "configure: error: Need zlib for bfd linking", thanks to + Cyril Brulebois (Closes: #560761). + * Bug fix: "Disfunctional maintainer address", thanks to Joerg Jaspert + (Closes: #560752). + + -- Camm Maguire Mon, 14 Dec 2009 19:06:45 +0000 + +gcl (2.6.7-46) unstable; urgency=low + + * support newer binutils with output_bfd element + * Fix 64bit interrupt bug + * reader error fix + * Ensure plt entries are not blank + * plt table reading fix + * Bug fix: "FTBFS: current binutils static libs need -lz", thanks to + Daniel Schepler (Closes: #521929). + * Bug fix: "replacing libreadline5-dev build dependency with + libreadline-dev", thanks to Matthias Klose (Closes: #553761). + * Bug fix: "crash after ctrl-C", thanks to Miroslaw Kwasniak (Closes: + #519903). + * Bug fix: "FTBFS with binutils-gold", thanks to Peter Fritzsche + (Closes: #554418). -ldl added to bfd linker args + * Bug fix: "[INTL:es] Spanish debconf template translation for gcl", + thanks to Francisco Javier Cuadrado (Closes: #508728). + * Bug fix: "[INTL:it] Italian translation", thanks to Vincenzo + Campanella (Closes: #560364). + * gcc error/warning cleanups + * fix plt table awk + + -- Camm Maguire Fri, 11 Dec 2009 17:45:14 +0000 + +gcl (2.6.7-45) unstable; urgency=high + + * proper word order detection macro, fixes armel + + -- Camm Maguire Mon, 01 Sep 2008 13:48:16 +0000 + +gcl (2.6.7-44) unstable; urgency=high + + * backoff on arm opts + * more careful handling of GCL_GPROF_START + + -- Camm Maguire Sat, 23 Aug 2008 21:28:52 +0000 + +gcl (2.6.7-43) unstable; urgency=low + + * redo unrandomize.h to enable compilation under -O2 -- FIXME; Closes: 494153 + + -- Camm Maguire Wed, 20 Aug 2008 21:18:43 +0000 + +gcl (2.6.7-42) unstable; urgency=low + + * more div/rem symbols for alpha + + -- Camm Maguire Sun, 03 Aug 2008 11:18:51 +0000 + +gcl (2.6.7-41) unstable; urgency=low + + * more div/rem symbols for arm and hppa + + -- Camm Maguire Sat, 02 Aug 2008 00:36:07 +0000 + +gcl (2.6.7-40) unstable; urgency=low + + * default gcc with pic enabled on mips/mipsel + + -- Camm Maguire Fri, 01 Aug 2008 13:28:00 -0400 + +gcl (2.6.7-39) unstable; urgency=high + + * gcc 4.2 for mips/mipsel for now + * __divdi3 et. al. symbols for ia64 and arm + * clean some compiler warnings + + -- Camm Maguire Fri, 01 Aug 2008 12:53:07 -0400 + +gcl (2.6.7-38) unstable; urgency=low + + * No infinite unrandomization loops + + -- Camm Maguire Thu, 31 Jul 2008 15:18:37 -0400 + +gcl (2.6.7-37) unstable; urgency=low + + * Non-maintainer upload to fix pending l10n issues + * Debconf templates and debian/control reviewed by the debian-l10n- + english team as part of the Smith review project. Closes: #457025 + * [Debconf translation updates] + - Portuguese. Closes: #457576 + - Czech. Closes: #457677 + - French. Closes: #458120 + - Finnish. Closes: #458255 + - Galician. Closes: #458529 + - Vietnamese. Closes: #459008 + - Russian. Closes: #459308 + - Dutch. Closes: #459541 + - German. Closes: #459887 + * [Lintian] Correct FSF address in debian/copyright + * [Lintian] Remove extra whitespaces at the end of + debian/in.gcl-doc.doc-base.tk + * [Lintian] Correct section in doc-base documents from Apps/Programming + to Programming + * Accept NMU + * Bug fix: "[INTL:sv] po-debconf file for gcl", thanks to Martin Ågren + (Closes: #492241). + * Bug fix: "gcl: FTBFS [amd64]: cannot trap sbrk", thanks to Daniel + Schepler (Closes: #487435). Modified and applied personality handling + patch. + * Bug fix: "gcl: Builds broken package with gcc-4.3", thanks to Daniel + Schepler (Closes: #467474). Added sincos to plttest.c + + -- Camm Maguire Thu, 31 Jul 2008 15:18:15 -0400 + +gcl (2.6.7-36) unstable; urgency=low + + * statsysbfd in Debian, incoporating modules into libgcl.a for + compiler::link support + + -- Camm Maguire Fri, 30 Nov 2007 12:03:31 -0500 + +gcl (2.6.7-35) unstable; urgency=low + + * drop gcc-3.4 on arm, Closes: #440421 + * Depend on emacs22 | emacsen, Closes: #440190 + * debconf translations Closes: #410683, Closes: #419736, Closes: #423706, Closes: #441408 + + -- Camm Maguire Fri, 23 Nov 2007 10:25:23 -0500 + +gcl (2.6.7-34) unstable; urgency=low + + * add read-byte,read-sequence,write-byte,write-sequence support + * fix some float parsing inaccuracies + * support GNU_HASH sections, Closes: #426135 + * safety 2 for certain low level functions in gcl_listlib.lsp, CLoses: + #415266 + + -- Camm Maguire Wed, 4 Jul 2007 16:23:25 -0400 + +gcl (2.6.7-33) unstable; urgency=low + + * Fix leading underscore behavior of my_plt + * add sqrt to plttest.c + * disable-nls added to the binutils subconfigures to avoid msgfmt + dependency + * remove -lintl from powerpc-macosx.defs + * update to make-user-init from cvs head to support hol88, fix link on + mingw + * solaris-i386 support + * fix read-char-no-hang on mingw + * fast compile without wrap-literals + * sigaltstack support + * fix cerror + + -- Camm Maguire Wed, 16 May 2007 12:45:40 -0400 + +gcl (2.6.7-32) unstable; urgency=low + + * static function pointers for hppa + + -- Camm Maguire Sun, 29 Oct 2006 02:15:13 -0500 + +gcl (2.6.7-31) unstable; urgency=low + + * no C optimization on hppa, gcc 4.x on hppa + * update cs.po, Closes: #389211 + + -- Camm Maguire Fri, 27 Oct 2006 13:06:55 -0400 + +gcl (2.6.7-30) unstable; urgency=low + + * make sure *tmp-dir* is set + * makeinfo is optional + + -- Camm Maguire Wed, 25 Oct 2006 17:37:54 -0400 + +gcl (2.6.7-29) unstable; urgency=low + + * Fix build issues on hppa and m68k + + -- Camm Maguire Sat, 21 Oct 2006 15:10:41 -0400 + +gcl (2.6.7-28) unstable; urgency=low + + * si::gettimeofday function for HOL88 build;macosx fixes + + -- Camm Maguire Wed, 18 Oct 2006 13:21:26 -0400 + +gcl (2.6.7-27) unstable; urgency=low + + * unrestricted gcc for alpha + * more default stack space + + -- Camm Maguire Tue, 17 Oct 2006 16:33:43 -0400 + +gcl (2.6.7-26) unstable; urgency=low + + * Fix large float read bug in c1constant-value + + -- Camm Maguire Mon, 16 Oct 2006 12:41:03 -0400 + +gcl (2.6.7-25) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 09:37:08 -0400 + +gcl (2.6.7-24) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 02:22:04 -0400 + +gcl (2.6.7-23) unstable; urgency=low + + * backoff to gcc-3.4 on alpha,arm,hppa, and m68k + + -- Camm Maguire Wed, 11 Oct 2006 10:16:59 -0400 + +gcl (2.6.7-22) unstable; urgency=low + + * HAVE_SYS_SOCKIO_H for solaris + * autolocbfd for solaris + * no -Wall when no gcc + * no -fomit-frame-pointer on m68k + * no profiling on mips + * $(AWK) instead of awk + * si::stat function + * fix 'the boolean type coersion error + * no varargs on cygwin + * while eval macro + * gensym counter fixes + * xgcl updates + + + -- Camm Maguire Fri, 15 Sep 2006 13:48:28 -0400 + +gcl (2.6.7-21) unstable; urgency=low + + * Fix socket write error + + -- Camm Maguire Wed, 6 Sep 2006 09:59:50 -0400 + +gcl (2.6.7-20) unstable; urgency=low + + * fix ia64 build + + -- Camm Maguire Thu, 31 Aug 2006 15:14:18 -0400 + +gcl (2.6.7-19) unstable; urgency=low + + * xgcl upgrade + * parse_number from cvs head with *read-base* fixes + * fix object_to_string + * install xgcl-2/sysdef.lisp + * fix info dir and emacs site lisp dir installation + * New xgcl readme + * Remove bashism from debian/rules, Closes: #376806, Closes: #385176. + * Fix dwdoc doc-base error, Closes: #385126 + + -- Camm Maguire Wed, 30 Aug 2006 12:13:46 -0400 + +gcl (2.6.7-18) unstable; urgency=low + + * remove emacs build dependency + * synch xgcl-2 with Novak edits + * fix build errors + * Remove power of two limit to MAXPAGE;fix X lib paths + * configure cleanup + * delete-file works on directories;build xgcl the old way;latest xgcl + from Gordon Novak + + -- Camm Maguire Wed, 23 Aug 2006 14:19:51 -0400 + +gcl (2.6.7-17) unstable; urgency=low + + * Bug fix: "gcl: [INTL:sv] Swedish debconf templates translation", + thanks to Daniel Nylander (Closes: #343695). + * Bug fix: "gcl: French debconf templates translation update", thanks to + Sylvain Archenault (Closes: #344629). + * clean xgcl-2/gmon.out + * cleanup latest gcc type-punning warnings + * defentry C proclamations and xgcl cleanup + + -- Camm Maguire Mon, 26 Jun 2006 16:45:09 +0000 + +gcl (2.6.7-16) unstable; urgency=high + + * Add missing build dependencies, omit html generation to avoid non-free + dependencies, CLoses: #372574. + + -- Camm Maguire Mon, 19 Jun 2006 14:05:59 +0000 + +gcl (2.6.7-15) unstable; urgency=low + + * Use internal gettext for bfd + * Restore xgcl2 + * Set compiler::*tmp-dir* at runtime + * report tmp-dir setting with system-banner to enable clean -eval - + batch operation; fix listen on socket streams; use (abs (getpid)) in + tmp names for Windows + * fix configure unbalanced quotes + * support for bignums in nth et.al. + * Fix branch cut of atanh + * Fix typep on simple-arrays + * prevent nested free errors + * revert atanh branch cut change + * Fix function documentation wrapping by compile + * cond evalmacro from cvs head + * Fix fixnum declarations in new smallnthcdr/bignthcdr + * fix simple-array typep + * updates for lsp/sys-proclaim + * xgcl integration + + -- Camm Maguire Fri, 9 Jun 2006 17:52:22 +0000 + +gcl (2.6.7-14) unstable; urgency=low + + * Add mount declaration to plt.c + + -- Camm Maguire Sun, 18 Dec 2005 12:56:51 +0000 + +gcl (2.6.7-13) unstable; urgency=low + + * Add feof to plttest.c for macosx + * plt related fixes for macosx + * fix configure + * Cleanup LEADING_UNDERSCORE case in plt.c et.al for macosx et.al. + * pass devices if present in compiler::get-temp-dir, fix disassemble + for new gazonk name pattern + + -- Camm Maguire Sat, 17 Dec 2005 15:22:40 +0000 + +gcl (2.6.7-12) unstable; urgency=low + + * Fix read-char-no-hang + * Strip emacs warnings when finding site-lisp directory + * mach-o update for latest binutils + * Latext bfd mach-o support from Aurelien + * revert to locbfd default on ppc-macosx + * More ppc macosx fixes from Aurelien + * revert a few macosx changes + * default to void * prototype on my_sbrk for latest macosx pending + Aureliens #ifdef + * Fix plt.h parsing on macosx + * Fix leading_underscore detection on mac + * macosx name mangling fixes + * multi-process safe gazonk names in compiler::*tmp-dir* + * Add underscore-mangled setjmp calls to plttest.c for macosx + * Fix POTFILES.in, Closes: #336207. + * Update templates, Closes: #324636 + * New French and Swedish translations, Closes: #333654, Closes: #336757. + + -- Camm Maguire Wed, 14 Dec 2005 18:52:49 +0000 + +gcl (2.6.7-11) unstable; urgency=low + + * Remove gcc-3.3 for arm in debian/rules + * make default maxpage depend on SIZEOF_LONG and PAGEWIDTH in a sane + fashion + + -- Camm Maguire Thu, 20 Oct 2005 00:08:37 +0000 + +gcl (2.6.7-10) unstable; urgency=low + + * Fix long-call gcc configure bug for ppc, add fdollars in + identifiers on arm + * remove gcc restrictions on arm + * revert 64bit coersion (gmp_big.c, maybe_replace_big) and replace with + code in siLnani (main.c) to get addresses from bignums. 2.7.0 will + have 64bit fixnums on 64bit machines, but this should not be + backported to 2.6.x + + -- Camm Maguire Wed, 12 Oct 2005 23:11:12 +0000 + +gcl (2.6.7-9) unstable; urgency=low + + * 64bit fixnum fasd data format fix from cvs head + + -- Camm Maguire Wed, 5 Oct 2005 18:49:50 +0000 + +gcl (2.6.7-8) unstable; urgency=low + + * Fix 64bit fixnum coersion bug using code from cvs HEAD + + -- Camm Maguire Fri, 30 Sep 2005 22:14:38 +0000 + +gcl (2.6.7-7) unstable; urgency=high + + * Scan .o file for init name when using dlopen + * Set init name using .o file instead of source file by default + * wrap-literals function from cvs head to allow optimizations using + compile or compile-file + * ADDR_NO_RANDOMIZE fix + + -- Camm Maguire Thu, 29 Sep 2005 17:50:56 +0000 + +gcl (2.6.7-6) unstable; urgency=high + + * Build bfd snapshot locally, Closes: #318681 + + -- Camm Maguire Tue, 20 Sep 2005 17:53:17 +0000 + +gcl (2.6.7-5) unstable; urgency=high + + * gcc-3.3 for arm + + -- Camm Maguire Thu, 15 Sep 2005 20:33:00 +0000 + +gcl (2.6.7-4) unstable; urgency=high + + * gcc 3.4 on arm to work around reserved '$' identifiers. + * gcl: French translation update + * French translation added, Closes: #325214 + * Czech translation added, Closes: #325869 + + -- Camm Maguire Thu, 15 Sep 2005 13:45:11 +0000 + +gcl (2.6.7-3) unstable; urgency=low + + * static wraper for compiled_regexp for ia64 + + -- Camm Maguire Sat, 10 Sep 2005 11:26:37 +0000 + +gcl (2.6.7-2) unstable; urgency=high + + * rebuild against libgmp3c2, Closes: #323765 + * 2.6.7 fixes all gcc 4.0 issues. Closes: #323979 + + -- Camm Maguire Wed, 24 Aug 2005 00:44:48 +0000 + +gcl (2.6.7-1) unstable; urgency=high + + * Fix (listen) with readline on + * fix control-d with readline + * libreadline5 support for Debian + * Support for pre-compiled regexps and new texinfo format + * Reenable run-process + * Push function 'accept into lisp, use select for 'listen on socket + streams + * New Upstream release version + * Native-reloc feature + * Add daemon capabilities to server sockets, document socket and + accept + * Some gcl-tk fixes + * Update wrapt-literals strategy to be consistent with CVS head -- + wrap evreything but symbols and integers, don't wrap when keeping + the gazonk files for linking in different images, this is really a + compile-file operation + * gcltk demo cleanups + * Probe-file, open_stream, and the like fail on directories + * Resolve symlinks in truename + * Place prototypes for defcfun in header files + * Support for unique init names for compiler::link and the like + * libreadline5 for Debian + * remove _o from init-names + * gcc-4.0 fixups + * Bug fix: "gcl: depends on binutils-dev <<= 2.1.5-999), so + uninstallable in unstable", thanks to Steve Langasek (Closes: + #318681). Rebuild with new release to autocompute this dep + * Bug fix: "gcl: Please switch to po-debconf", thanks to Lucas Wall + (Closes: #295930). Apply po-debconf patch + * Newer standards + + -- Camm Maguire Thu, 11 Aug 2005 15:00:26 +0000 + +gcl (2.6.6-1) unstable; urgency=high + + * New upstream release + * Allow .data section to be first in executable, as on solaris. Also + allow for new bfd section size semantics + * Don't try to write map file when not using GNU ld. Also allow + compile-file to process pathnames with whitespace on Windows + * Fix corner case fixnum arithmetic on 64bit machines + * Rework gmp_wrappers semantics for older gcc + * Explicitly mprotect loaded code pages PROT_EXEC on x86 Linux, as FC3 + now requires it. + * lisp-implementation-version is GCL + * Reader extension patch allowing for foo::(bar foobar) semantics + * a shell script variable fix in "unixport/makefile" for MSYS + * __MINGW32__ malloc initialisation fix in "o/alloc.c" + * Windows file/directory fixes in "o/unixfsys.c" + * MinGW32 -march in configure - removes deprecation warnings + * MinGW32 directory fix - "o/mingfile.c". + * Allow for sysconf to determine clock granularity at compile time to + fix time errors on the Itanium + * Disable SGC on macosx until the sgc/save problem can be fixed. + * Fix fixnum print bug on 64bit + * Fix nil types in room report + * 64bit fixes to fixnum_add and fixnum_sub + * Fix Mac SGC/save bug, at least in part + + -- Camm Maguire Sun, 16 Jan 2005 02:28:50 +0000 + +gcl (2.6.5-1) unstable; urgency=high + + * New gmp_wrappers.{c,h} files that prevent all GBC within gmp, + obviating the need for gmp patches and a local gmp configure. FIXME + -- extend to all gmp functions in a systematic way, and write header + information for future use in the compiler, making sure that plt.c + carries the needed gmp symbols at this point + * Build support for gmp_wrappers + * Support for gmp_wrappers in alloc_relblock/alloc_contblock;Support + for GCL_GPROF_START define in gprof functions + * dynsysgmp on by default; configure backs off to local gmp configure + and build automatically if needed either because gmp not present or + patched symbols are needed; autodetect and set the _start symbol + when using gprof + * Fix (setf (get ...) ...) return bug when interpreted + * Fix overwrite end of sgc_type_map bug + * Versioned depends on binutils-dev manually installed by Debian build + process + * New upstream release + * Proper binutils dependency for Debian + * head -1l -> head -n 1 for freebsd + * Cleanup gmp_wrapper code, check for in-place calls as write in one + step is not guaranteed in gmp according to its developers + * Rebuild against binutils 2.15, Closes: #266253, Closes: #263983 + + -- Camm Maguire Tue, 17 Aug 2004 18:22:27 +0000 + +gcl (2.6.4-1) unstable; urgency=high + + * New upstream release + * Make disassemble work when original system directory is gone + * New debian/support files for debconf image default selection support + * More descriptive compiled C function names for use in gprof when + profiling is compiled in + * Compiler fix for proclaimed vararg functions + * Allow sharp numbers to be bignums + * lintian fix in string-match + * Prototype for alloca for lint + * Improve gprof support + * Improve sgc page allocation which optimize-maximum-pages is in + effect and the hole is overrun + * Build a profiling set of images as well for Debian, toggle between + all four by default via debconf + * reset-sys-paths lisp function for moving image installation + directories, show profiling support in banner if present + * Fix typo in sys docs + * reset sys paths on installation + + -- Camm Maguire Thu, 5 Aug 2004 22:48:56 +0000 + +gcl (2.6.3-1) unstable; urgency=high + + * Correctly parse gcc version strings in gmp3 subconfigure on arm + * Fix variable capture error in dotimes macro + * Better sed separator for LI-CC in unixport/makefile + * Fix segfault in string-match + * vs_top=sup -> (reset-top) where possible in compiler. FIXME: a few + items of a different form which need to set *sup-used* too. + * Correct room report to show proper percentages when sgc is on + * Read in RELOC environment variable if set as default in debian/rules + * Remove local bfd libraries from libs variables as their objects are + incorporated into libgcl and as the source directory may not be + available at runtime + * Remove pcl/pcl_gazonk*lsp build-generated files from source + + -- Camm Maguire Thu, 15 Jul 2004 14:26:44 -0400 + +gcl (2.6.2-3) unstable; urgency=low + + * Fix value stack leak in rare compiled call sequence + + -- Camm Maguire Tue, 13 Jul 2004 10:17:02 -0400 + +gcl (2.6.2-2) unstable; urgency=low + + * New upstream point release + + -- Camm Maguire Tue, 13 Jul 2004 10:08:53 -0400 + +gcl (2.6.2-1) unstable; urgency=low + + * gcc-3.4 support + * Proper isnormal default courtesy of Magnus Henoch + * gclclean makefile target and other small makefile changes + * Proper check for C stack array body address in gbc.c and sgbc.c + * New upstream release + * acconfig.h update for isnormal default + * Fix bug in setting elements (si::aset) of 0 rank arrays uncovered by + the random tester + * No -fomit-frame-pointer on mingw + * Backport minimal ansi-test patches from HEAD to enable running of + the random tester + * installed tcl/tk patch for mingw + * Fix banner license detection code in lsp/gcl_mislib.lsp as + 8features* entries are now keywords + * o/makefile changes to work around trailing slash -I arguments gcc + bug on mingw + * Patch to mingwin.c:fix_filename to close long standing 'maxima + ignore-errors filename corruption' bug on mingw + * Check for too large rank supplied to make-array1 + * Fix potential stack overwrite bug in quick_call_sfun/eval.c + * Add -mprferred-stack-boundary=8 on amd64, as constant integers used + in a call must be retrievable with va_arg(,fixnum) + * Revert preferred-stack-boundary option on amd64 as it does not play + well with external libraries, also eliminate -m64 to allow for user + settings. Cast fixnum constant C arguments in gcl_cmploc.lsp + explicitly to (long) to ensure they can be extracted via + va_arg(,fixnum) + * reenable SA_SIGINFO on amd64 to restore SGC there + * Include elf.h in FreeBSD.h + * Allow for elf_abi.h in FreeBSD.h + * Add README.openbsd file + * readme.mingw updates + * solaris.h updates for custreloc option + * Close possibility of malloc failure due to intervening gbc arising + from the misordering of allocation calls + * C_GC_OFFSET is 2 on m68k-linux + * Add release notes, remove gcl document presumably based on dpANS for + now + * Fixup bad extern declaration of signals_handled in usig.c + + -- Camm Maguire Fri, 25 Jun 2004 22:43:52 +0000 + +gcl (2.6.1-39) unstable; urgency=high + + * Fix segfault in referencing (sgc_)type_map out of bounds which can + occurr when C stack is below heap, as on alpha. + * Cleanup compiler warnings on bcmp.c bzero.c and bcopy.c + * Clean up compiler warning in file.d + * Ensure set TLDFLAGS are used in finding DBEGIN in copnfigure.in, for + OpenBSD + + -- Camm Maguire Fri, 7 May 2004 21:50:03 +0000 + +gcl (2.6.1-38) unstable; urgency=low + + * Make *features* entries keywords -- add canonical host cpu and + kernel-system to *features*, disable h files specific + ADDITIONAL_FEATURES macro in main.c + * Fix merge-pathanames bug in concatenating default and supplied + directory lists + * Minor pathname and *features* fixes + * Fix recently introduced configure.in syntax bug + * Minor patches to support big gcl images -- all page integers must be + long ints, need stack space limits that scale with MAXPAGES at least + to allow free_map stack array in sgc_start. FIXME -- right now can + handle situations where page numbers are ints, but npage*PAGESIZE is + a long, need to handle npage >MAX_INT later. This is to support the + 'billion cons element acl2 image' requested by a gcl user + * Revert winnt features and debugging aids in configure.in + * OpenBSD support, gcc warning cleanups for long page integers + + -- Camm Maguire Mon, 3 May 2004 21:34:57 +0000 + +gcl (2.6.1-37) unstable; urgency=high + + * mprotect pages PROT_EXEC as CLEAR_CACHE step on amd64-linux + * Prevent recursive malloc calls for OpenBSD error reporting + * Push dummy 0 time for child runtime on windows to be compatible with + other platforms for now + * Make sure pages are mprotected PROT_EXEC for amd64 support + + -- Camm Maguire Tue, 13 Apr 2004 21:00:22 +0000 + +gcl (2.6.1-36) unstable; urgency=low + + * Improve optimize-maximum-pages algorithm + + -- Camm Maguire Tue, 6 Apr 2004 03:23:40 +0000 + +gcl (2.6.1-35) unstable; urgency=low + + * Fix sigcontext autodetection on sparc + + -- Camm Maguire Sun, 4 Apr 2004 19:26:48 +0000 + +gcl (2.6.1-34) unstable; urgency=low + + * Fix GNU_LD autodetection in configure.in + * Eliminate C_INCLUDE_PATH from shell script wrapper + * Use lisp rather than 'system touch' to make empty map file in + compiler::link + * fix small bug when info is passed bad second argument + * Don't try to open map file if doesn't stat (macosx) + * Add earlier forgotten branch patch to sfaslbfd.c for macosx + * Backport new eval-when keyword support from 2.7 to run random tester + * Perhormance improvement to gcl_seqlib.lsp -- no inner loop over + bignums + * Proper contblock/relblock determination when expanding string + streams + * Proper string type determination for *link-array* + * .ini files depend on plt.h + * plttest.c cannot depend on include.h + * Address longstanding FIXmE in gensym, so that two strings are not + allocated for each gensym + * Fix rare infinite loop bug in array.c + * Import si::info into 'user + * , -> # as sed separator + * Minro warning removals and fixups + * Binary searches through ordered arrays of referred and changed + variables for dramatic compiler performance improvement in the large + case -- support declarations and thereby optimizations of the form + (declare ((vector t) foo)), etc. + * Better 'time macro + * rebuild pcl_gaz* files + * cleanup room report and give more space to modern large heaps + * room report formatting + * Properly gensymmed time macro + * Allow for white space chars in compiled filenames + * Autodetect and work around sbrk randomization, e.g. on Fedora 1 + * Probe for sbrk before probing for randomized sbrk + * Openbsd changes -- maximize data seg resource if possible, avoid + mallocing error message when allocation routines fails + * Fix sigcontext configure tests + * Rename loop-finish -> sloop-finish in sloop package so that sloop + and ansi loop can be used simultaneously + * Handle arguments which are zero in LCM + * Fix typo in configure.in + * Improved dotimes macro which avoids unnecessary fixnum garbage + generation + * Backport of ignorable declaration keyword for new dotimes macro + * si::*OPTIMIZE-MAXIMUM-PAGES* support + * rebuild pcl generated lisp files + + -- Camm Maguire Sat, 3 Apr 2004 19:27:18 +0000 + +gcl (2.6.1-33) unstable; urgency=low + + * Remove extraneous symbols from plt.h, autodetect and correct for + leading underscore in object symbols + * complete readline version detection commit + * Backport support for new eval-when keywords + * Autodetect GNU ld and add -Wl,-Map only when appropriate + + -- Camm Maguire Wed, 10 Mar 2004 22:51:44 +0000 + +gcl (2.6.1-32) unstable; urgency=low + + * Try to automatically determine the form used for the explicitly + compiled in external function addresses in plt.c + * No need to explicitly write cr-lf on windows + * Autodetection of machine on FreeBSD + * Updated defs and h files for FreeBSD courtesy of Mark Murray + * Minor ifdefs needed for FreeBSD + * Refer to exported non-static C stub of fSmake_vector1 in plt.c + (needed on ia64) + * Readline 4.1/4.3 configure magic + + -- Camm Maguire Tue, 9 Mar 2004 01:58:43 +0000 + +gcl (2.6.1-31) unstable; urgency=low + + * Adjustments to vs_top reset logic to clear (hopefully last) + remaining bug found by the random-tester + * Allow args-info-referred-vars to match replaced vars, clearing bug + report submitted by Matt Kauffman + * Rework plt code yet again to be compatible with compiler::link for + axiom, and mingw32 + + -- Camm Maguire Mon, 8 Mar 2004 12:16:46 +0000 + +gcl (2.6.1-30) unstable; urgency=low + + * Fix rsym generated symbol tables for 64 bit platforms + * Make sure 'unwind' in frame.c does nt go below frs_org + * Do not define symbols with no value, either in bfd/rsym, or in + plt.c. Generates a clear and explicit error of an undefined symbol + when we've missed an address + * Define the external symbols known to be written at present in plt.c + * fix some more compiler errors found by the random tester -- all + related to proper unwinding of temporary reductions of vs_top from + te local supremum + + -- Camm Maguire Sat, 6 Mar 2004 02:05:59 +0000 + +gcl (2.6.1-29) unstable; urgency=low + + * Remove implicit dependency on gawk, optimize plt.c a little + + -- Camm Maguire Wed, 3 Mar 2004 16:08:30 +0000 + +gcl (2.6.1-28) unstable; urgency=low + + * make sure bfd fasload initializes dum.sm.sm_object1 for + read_fasl_vector + * When a tagbody contains ccb reference tags, and hence i itself + marked ccb, mark all the clb tags therein ccb too, as the tagbody + environment will be consed in c2tagbody-ccb. FIXME -- review this + logic carefully + * fix typoe in o/sfaslbfd.c + * Add code to unwind redefinitions of the stack supremum in c2expr-top + (used in c2multiple-value-prog1 and c2multiple-value-call in + evaluating arguments) on non-local exit + * Use new temporarry variables holding lisp stack supremum for lint + * Eliminate extraneous warning message when allocating fewer pages + than already allocated + * Rework internal plt symbol address capture + * Cleanup sfaslelf compiler warning + + -- Camm Maguire Wed, 3 Mar 2004 00:27:08 +0000 + +gcl (2.6.1-27) unstable; urgency=low + + * Modify default banner slightly + * Homebrew plt-like mechanism for ensuring that valid internal + addresses exist to which undefined symbols in compiled lisp objects + referring to external shared libraries can be relocated + * Make configure demand gettext when choosing --enable-locbfd + * Make sure references to ldb1, a stub conventionally optimized away, + can be resonled when optimization is turned off + * completion_matches -> rl_completion_matches in gcl_readline.d, + which is what is exported in the headers + + -- Camm Maguire Fri, 27 Feb 2004 23:50:49 +0000 + +gcl (2.6.1-26) unstable; urgency=low + + * Rework compiler::*ld-libs*, compiler::link, and unixport/makefile to + accomodate mingw need for firstfile.o and lastfile.o + * Remove incompatible -fomit-frame-pointer when compiling with -pg + profiling + * Load sys-proclaim.lisp files forimproved linking and smaller object + size across the board, install same for use with compiler::link + * Use pathnames instead of strings in compiler::link, also in image + init files, for Windows + * small mod to unixport/makefile re filtering of firstfile and + lastfile + * Backport zero divisor error cnditions from HEAD for + floor,ceiling,truncate + * Default to debug mode on hppa to work around gcc compiler + optimization bugs + * Add missing m4 and automake files in binutils directory to enable + automake and autoconf here + * Add mach-o specific files from cvs head to local bfd tree + * Add bfd/po makefiles + * Macosx defaults in configure.in + * bfd make and configure file changes to handle mach-o backend + * *gcl-version* -> *gcl-minor-version*,*gcl-extra-version* + * Support for more informative banner reading features list + * Support for both sigbus and sigsegv in sgbc.c as is customary in .h + files + * mach-o compatible changes in sfaslbfd.c + * Support for new debugging section names in sfaslelf.c + * powerpc-macosx h and defs files from cvs head + + -- Camm Maguire Wed, 25 Feb 2004 23:08:59 +0000 + +gcl (2.6.1-25) unstable; urgency=low + + * rl_putc_em a carriage return after invoking readline to ensure the + prompt in rl_putc_em_line is cleared. + * use standard sgc fault recovery element for hppa as recommended by + hppa kernel experts + * Store banner in si::*system-banner* for possible modification + in compatibly licensed programs + * exit with -1 when standard in ends in lisp debug mode + * Backport macosx files from cvs HEAD + * Document system return codes + + -- Camm Maguire Fri, 13 Feb 2004 20:44:54 +0000 + +gcl (2.6.1-24) unstable; urgency=low + + * Revert unixport/makefile link order fix for windows, breaks + compiler::link, find another way + * runtime SGC fault recovery test + * Protect read/fread in case SGC is enabled with safe (restartable) + versions + * SGC on for arm and hppa + * remove fast-link workaround now fixed for windows + * Backport HEAD makefile changes to clean .{c,h,data} files and + new_decl.h, remove said from repository (generated files) + + -- Camm Maguire Thu, 12 Feb 2004 05:56:29 +0000 + +gcl (2.6.1-23) unstable; urgency=low + + * Remove calls to init-readline with new automatic readline setup + + -- Camm Maguire Tue, 27 Jan 2004 20:27:20 +0000 + +gcl (2.6.1-22) unstable; urgency=low + + * Build depend on emacs21 | emacsen + + -- Camm Maguire Fri, 23 Jan 2004 22:01:15 +0000 + +gcl (2.6.1-21) unstable; urgency=low + + * Automatic readline initialization + * Add watch file + * Prevent circular error loops + * Prevent automatic optimization added to CFLAGS by autoconf + * Rework documentation installation in and outside of Debian + * Support user deined predicates at an elementary level in the form + '(satisfies foop) in gcl_predlib.lsp + * Install binary gcd algorithm for ~10% performance increase + * Rescale some default allocation parameters -- bignum allocation by + relblocks by default, default growth parameters are 1 (min), + 0.1*MAXPAGE (max), 0.5 (increase), 0.3 (percent free), holepage is + 4*MAXPAGE/1024, INIT_HOLEPAGE, INIT_NRBPAGE and RB_GETA scale + accordingly + * Clean windows/sysdir.bat + * Check for zero args in new gcd code + * Default hole is maxpages/10, holesize configure option added + * Fix syntax errors in older reloaction code: sfaslelf.c + + -- Camm Maguire Fri, 16 Jan 2004 16:57:50 +0000 + +gcl (2.6.1-20) unstable; urgency=low + + * Fix gcl-doc doc-base files + + -- Camm Maguire Tue, 30 Dec 2003 22:30:39 +0000 + +gcl (2.6.1-19) unstable; urgency=low + + * Fix bug in compiler::c2labels in which *ccb-vs* was missing a ocal + rebind + * Remove duplicate tags from compiled C switch statements + * Minor merges for DARWIN support + * Path to configure to make --enable-emacsdir work + * Check for readline/readline.h header before configuring for readline + * Improve system bfd library location detection + * Make sure external gmp lib is compatible via __GNU_MP_VERSION, else + backoff to local gmp build; prepend externally defined CFLAGS into + output CFLAGS, FINAL_CFLAGS, and NIFLAGS + * Remove --enable-gmp configure option; gmp is required for GCL + * Use --enable-emacsdir in debian/rules, make sure --enable-emacsdir + and --enable-infodir work when arg contains ${prefix} + * Fix typo in chap-6.texi + * Make sure to export SGC define from config.h to cmpinclude.h -- Now + that we used optimized structures in the compiler, we need at least + the definition of SGC_TOUCH there to prevent GBC errors. FIXME -- + handle header dependencies more robustly. Thanks to Robert Boyer + for the report + * Improve SGC define extraction for cmpinclude.h + * Fix variable reference errors which were occurring for compiled + local functions defined within closure-generating or other + environment stack pushing functions when safety is set to 3 (thanks + Paul Dietz for the report.). When constructing local functions and + closures within a 'mother' function, *ccb-vs* will hold the number + of closure environments stacked at the point of each closure + creation or call to a local function. This value is stored as the + cadr of a list pushed onto *local-funs*, and is read when writing + out the C code for the local function or closure, where it is used + to initialize *ccb-vs* and *initial-ccb-vs* for subsequent + processing. The latter is used as the reference point when + addressing variables in wt-ccb-vs, as the former could be still + further incremented within the closure or local function itself. + Local functions as opposed to closures do not increment *ccb-vs* and + do not push the environment. When a local function is defined + within a closure-generating flet/labels, or a tagbody or block which + pushes the environment, the value of *ccb-vs* written to the list + corresponding to the local function can be erroneously incremented + beyond the *initial-ccb-vs* value established before any environment + pushing operations were processed. It is this latter value which is + appropriate for use in wt-ccb-vs, as the local functions, unlike the + closures, receive an environment level with the mother generating + function. We therefore push *initial-ccb-vs* onto the end the list + pushed onto *local-funs* only when defining a local function, and use + it to initialize an added optional variable initialize-ccb-vs in + t3local-fun and t3local-dcfun, which default to the original ccb-vs. + We then bind *initial-ccb-vs* to this new optional parameter instead + of the former *ccb-vs, which was only appropriate for closures. + * Put in rudimentary logic for the selection of stack vs. heap storage + for bignums depending on the frame context. FIXME, this logic is + too conservative at present. SETQ_II and SETQ_IO take an additional + parameter which is malloc when *unwind-exit* is bound and contains + 'frame and alloca otherwise. New macro bignum-expansion-storage. + FIXME, ensure that IDECL does not need similar modification. + * Cleanup a few compiler warnings in the compiler + * Cleanup compiler warning in alloc.c + * Eliminate unneeded transformatio of contniguous pages to other pages + on save-system. + * malloc -> gcl_gmp_alloc in recent setjmp frame protected bignum + allocation + * Add -Wa,--execstack if on an exec-shield enabled system, can be + explicitly added otherwise by setting the CFLAGS variable before the + configure step + * Better execstack flag handling in configure + * Allow for commas in CFLAGS in sed command writing *cc* + * Preliminary gprof profiling support + * Rework html documentation generation and installation, Closes: + #221774 + * Remove parentheses from setf class-name info node in chap-7.texi + + -- Camm Maguire Tue, 30 Dec 2003 16:26:45 +0000 + +gcl (2.6.1-18) unstable; urgency=low + + * Portability patches to makefiles to support non-GNU grep (no -q), + and non-bash sh, C_INCLUDE_PATH=...;export C_INCLUDE_PATH + * copy the global *info* parameter in c1flet and c1labels to prevent + accumulation of old data -- FIXME -- make sure there are no other + copies required, and eventually replace this global parameter with + local variables + * Turn on some optimization on hppa, -O only + * Make all C defined functions installed into lisp static functions to + work around dynamic function descriptors on ia64, Closes: #217484, + Closes: #204789, (STATIC_FUNCTION_POINTERS define in config.h) + + -- Camm Maguire Thu, 6 Nov 2003 15:40:25 +0000 + +gcl (2.6.1-17) unstable; urgency=low + + * Repair weak symbol addition to the bfd symbol table in sfasli.c + * Be more thorough about adding fun-info to call-local info in + gcl_cmpflet.lsp, accompanying simplifications in gcl_cmpeval.lsp + (call-global lists have info updated by args already in (c1args args + info)), small changes in add-info in gcl_cmpinline.lsp, FIXME -- + study rational for *info* special variable in certain places as + opposed to more common copy-info + + -- Camm Maguire Thu, 30 Oct 2003 20:03:22 -0500 + +gcl (2.6.1-16) unstable; urgency=low + + * Fix sh syntax in debian/gcl.sh + * init_or_load1 -> gcl_init_or_load1 in xgcl-2/sysinit.lsp + * Load weak symbols as well as undefined symbols in + bfd_build_symbol_table, for the purposes of the static build + possibility + * Map t and nil stream indicators properly in optimized compiled + references to read_char1 and read_byte1 (in read.d) + + -- Camm Maguire Thu, 23 Oct 2003 16:43:15 +0000 + +gcl (2.6.1-15) unstable; urgency=low + + * Remove imod/ifloor functions in cmpaux.c and directly inline their + fixed equivalents in gcl_cmpopt.lsp + + -- Camm Maguire Mon, 13 Oct 2003 15:04:24 +0000 + +gcl (2.6.1-14) unstable; urgency=low + + * generate less garbage in add-info (gcl_cmpinline.lsp), enabling + maxima compile to complete in a finite time :-) + + -- Camm Maguire Fri, 10 Oct 2003 22:14:04 +0000 + +gcl (2.6.1-13) unstable; urgency=low + + * Fix compiler optimization bug in gcl_cmpopt.lsp -- missing parens + around inliner for max and min + * collect info structures for local functions in flet and labels + processing (gcl_cmpflet.lsp), and pass upwards to call-local and + call-global (gcl_cmpeval.lsp) to fix certain inlining bugs in via + more proper operation of args-info-changed-vars (gcl_cmpinline.lsp, + inline-args, gcl_cmplet.lsp, c2let) + * Fix an obviou int overflow in ifloor (o/cmpaux.c), handle more + proper fixnum/integer determination from declarations later + + -- Camm Maguire Fri, 10 Oct 2003 02:34:11 +0000 + +gcl (2.6.1-12) unstable; urgency=low + + * Restore mpz_to_mpz{1} in gmp_big.c, can be written by compiler + * tk8.4 patches + * Prevent destructive modification of bignum arguments in log_op/mp_op + in gmp_big.c + * Make sure to push stack variables onto newly allocated C variable + when inlining args and args cause side effects, in inline-args, + gcl_cmpinline.lsp + * Fix bug related to gcc-3.3 fixes in set_exponent in num_co.c + * Remove pcl_methods.c patch. as is apparently no longer needed, TODO + -- make sure VOL modifier is inserted where needed to prevent + longjmp clobbers + + -- Camm Maguire Thu, 2 Oct 2003 14:26:43 +0000 + +gcl (2.6.1-11) unstable; urgency=low + + * Add compilation step of compiling all lsp and cmpnew .lsp files from + an interpreted only saved_pre_gcl before the creation of saved_gcl - + - this enables us to use full optimization on these files while + getting the STREF constants right on 32bit and 64bit + * remove 'attic' from comment in gcl_loop.lsp + * configure changes for sizeof(struct contblock) detection + + -- Camm Maguire Wed, 24 Sep 2003 16:09:44 +0000 + +gcl (2.6.1-10) unstable; urgency=low + + * Mac OSX GET_FULL_PATH_SELF + * Preliminary subtypep checking for 'satisfies + * preliminary 'satisfies support in subtypep, more predicate type + pairs and reverse checking + * small compiler change to remove unused C variables from optimized + compiled macros + * Optional compiler init file is called gcl_cmpinit + * fasdmacros.lsp -> gcl_fasdmacros.lsp + * All cmpinit.lsp files named gcl_cmpinit.lsp; allow full lisp + optimization in all directories + * collectfn -> gcl_collectfn in lsp/gcl_auto.lsp + * collectfn -> gcl_collectfn in cmpnew/gcl_make-fn.lsp + * Make sure makefiles can generate sys-proclaim.lsp, regenerate these + files and recompile from lsp + * Rebuild with opts enabled + * Iterate sys-proclaim/rebuild generation once more + * Iterate sys-proclaim/rebuild for pcl and clcs + + -- Camm Maguire Tue, 23 Sep 2003 19:33:27 +0000 + +gcl (2.6.1-9) unstable; urgency=low + + * Close streams in fasldlsym.c + + -- Camm Maguire Tue, 16 Sep 2003 14:57:20 +0000 + +gcl (2.6.1-8) unstable; urgency=low + + * Add processor flag variable to flags in configure.in + * Autoadd full path to kcl_self to enable save-system when user moves + executable and calls without script wrapper + * Add special variables si::*collect-binary-modules* and si::*binary- + modules* as a facility for discovering the list of fasloaded objects + preceding a save-system is required for a subsequent compiler::link + * Add collectfn.lsp to distro + * Rename some files and init_ functions to eliminate namespace + conflicts when building images with compiler::link + * Enable compressed info reading + * Make sure no opt flags are set when enable debug is specified + * Use NIFlAGS to compile new_init with lower opts on ppc to work + around gcc bug, restore full opts to other files + + -- Camm Maguire Sun, 14 Sep 2003 02:18:28 +0000 + +gcl (2.6.1-7) unstable; urgency=low + + * Fix permissions bug in temporary gzipped file handling + * Propagate control changes correctly with package extension + * Newer standards + + -- Camm Maguire Tue, 9 Sep 2003 17:06:56 +0000 + +gcl (2.6.1-6) unstable; urgency=low + + * Remove build-dependency on autoconf as a temporary work around to + Debian autoconf's dependency bug on emacsen-common + + -- Camm Maguire Tue, 9 Sep 2003 15:29:06 +0000 + +gcl (2.6.1-5) unstable; urgency=low + + * Redefine temporary files in elisp/makefile + + -- Camm Maguire Mon, 8 Sep 2003 21:49:09 +0000 + +gcl (2.6.1-4) unstable; urgency=low + + * Fix to sfasli.c to avoid defining symbols in other than *UND* + sections + * Remove some 64 bit warnings + * Turn off def_static on ia64 for now -- its broken + + -- Camm Maguire Sat, 6 Sep 2003 17:22:10 +0000 + +gcl (2.6.1-3) unstable; urgency=low + + * Fix static detection fr ia64; contblock size detection on arm + * Fix gcc verion checking in gmp3 subconfigure, esp. for arm + * Escape all sgc code with #ifdef SGC + + -- Camm Maguire Fri, 5 Sep 2003 21:32:47 +0000 + +gcl (2.6.1-2) unstable; urgency=low + + * Add windows/install.lsp to clean target + * Add in macosx files to stable and cvs head + * Fix bad debelper postinst, Closes: #208765 + + -- Camm Maguire Fri, 5 Sep 2003 13:15:11 +0000 + +gcl (2.6.1-1) unstable; urgency=low + + * New upstream release + * Type-punning warning fixes + * small_fixnum overflow fixes + * off by one fix in cerror + * Fix compiler error which had not recognized defpackage as a package + operation + * Fix tkl.lisp call to open-named-socket + * Make values-list and nreconc signal errors when they should on + dotted lists. + * Avoid use of windows.h types as macros. + * New config.{sub,guess} + * Windows installer updates from CVS HEAD + * fix potential longjmp clobber in read.d;add some windows files to + main makefile clean target; + * Darwin revealed fixes to usig.c and unixtime.c + * Fix gbc time calculation in case of recursive gbc calls + * Run patch_sharp in LSharp_exclamation_reader to handle new case of + defpackage ops at head of fasl vector, required for maxima build + * Special symbol Dotnil has ordinary list Cnil for plist and hpack + * Small fixes for profiling support + * Restore pp() function for debugging; print out undefined symbol + names + * Small patch for fix xgcl demo (thanks Michael Koehne) + * Better bfd symbol table strategy + * Fix bfd table symbol counting for combined_table profiling + * amd64 linux support + * O6 -> O3 + * static linking on ia64 to work around current mechanism for runtime + generated function descriptors + * enable-static configure option + * Fix debian/gcl-doc.docs for latest texinfo file splitting policy, + Closes: #206017 + * Fix typo in o/sfasli.c + * Rework debian package structure to handle stable and cvs packages + simultaneously + * Add gazonk*.lsp to clean target + * syntax fix to lsp/gprof.hc + * Add support for SGC contblock pages + * Fixes to debian/rules + * Remove unused definitions of Vcs + * Increase default maxpages and stack sizes + * Maintain a persisten *system-directory* binding + * Push installed /h directory onto -I flags on cc command line + * Escape old in-package behavior with #ifdef ANSI_COMMON_LISP + * define HAVE_XDR in linux.h + * reduce resolution of contblock mark_table in gbc.c to match new + minimum granularity introduced via CPTR_ALIGN + * Remove exit function in main.c + + -- Camm Maguire Thu, 4 Sep 2003 02:20:52 +0000 + +gcl (2.5.3-2) unstable; urgency=low + + * gcc-3.3 all platforms + + -- Camm Maguire Mon, 7 Jul 2003 16:10:25 +0000 + +gcl (2.5.3-1) unstable; urgency=low + + * New upstream release + * Restore object_to_float and object_to_double, cmpaux.c, Closes: #195470. + * Remove obsolete functiion multiply-bignum-stack from documentation, + si-defs.texi + * Unstatic object_to_float, object_to_double + + -- Camm Maguire Mon, 2 Jun 2003 12:38:03 -0400 + +gcl (2.5.2-1) unstable; urgency=low + + * New upstream release + * Cleanup xdrfuns.c for Axiom + * Reenable xgcl build + + -- Camm Maguire Thu, 20 Mar 2003 09:15:54 -0500 + +gcl (2.5.1-1) unstable; urgency=high + + * some optimization now on hppa + * Add RELEASE-2.5.1 file + * Add dedication notice to the memory of W. Schelter + + -- Camm Maguire Sun, 2 Mar 2003 10:20:26 -0500 + +gcl (2.5.0.cvs20020625-80) unstable; urgency=low + + * enable japi configure flag, defaults to no + * enable -mlongcall on ppc when using gcc 3.3 or higher + * int -> fixnum in DEFUN function arguments for safety -- ensures + pointers and integers passed by lisp are of same size + * MYmake_fixnum macro simplification + * ufixnum typedef + * Prototypes for cmod et.al. -- restoring maxima build on ia64 + * Fix unaligned access message on ia64 generated by DFLT_aet_fix + * Integer va_arg uses fixnum + * Define __*i3 symbols used by GCL, supplied by libc, and written into + some GCL compiled objects, restores ARM build with ANSI image + * num_log.c miscompilation on ia64 apparently fixed, Closes: #156291 + * Ensure cmpinclude.h up to date in main makefile + + -- Camm Maguire Sat, 1 Mar 2003 17:33:29 -0500 + +gcl (2.5.0.cvs20020625-79) unstable; urgency=low + + * Fix Debian package install bug + + -- Camm Maguire Thu, 27 Feb 2003 23:17:55 -0500 + +gcl (2.5.0.cvs20020625-78) unstable; urgency=low + + * Add config.log config.status and config.cache to clean target + * Remove xgcl-2/debian directory + * Update clcs/sys-proclaim.lisp + + -- Camm Maguire Thu, 27 Feb 2003 18:48:38 -0500 + +gcl (2.5.0.cvs20020625-77) unstable; urgency=low + + * Lintian cleanups + * Don't strip libansi_gcl.a, need .data at end of .o, as with libgcl.a + * Take newlines out of doc string for init-cmp-anon + * Cleanup gcc-3.2 compiler warning + * 64 bit STREF fixes + * pcl and clcs need to have C rebuilt afresh, as 64 bit machines write + different STREF offsets into the C files + * Rework Debian package build a bit + * README.Debian explaining the toggling of the ANSI image + * Typo in debian/rules + * Remove debian/gcl.conffiles + + -- Camm Maguire Thu, 27 Feb 2003 15:56:11 -0500 + +gcl (2.5.0.cvs20020625-76) unstable; urgency=low + + * Debian Priority is optional + * Configure lowest common denominator on m68k to m68020 -- gcc-3.2 + can't handle m68000 -- no __mulsi3 + * Fix bit array bug + * Add upgraded-array-element-type + * Misc typep and subtypep fixes + * Proper error handling in certain array.c functions + * First needs exactly one arg + * Proper error handlin in LAST + * bit array allocation fixes in num_log.c + * eliminate Iapply_fun_n1 + * Dummy system find-class in traditional image, overwritten by pcl + version in ANSI + * Invalid variable is a program error, not a symbol is a type error + * Attempt at uninterned symbol support as slot names + * defstruct changes for ANSI conc-name handling + * Rework ansi build to follow existing pattern for traditional image, + enabling preliminary ansi support on dlopen systems + * Fix broken mingw probe in main makefile + * Rename pcl and clcs files to avoid init name conflict on dlopen + systems + * sys-proclaim for clcs + * Compiler goto indentation + * Compiler pointer cast in call_or_link_closure + * *keep-gaz* compiler variable to save anonymously generated lisp + * si::init-cmp-anon function to initialize anonymously generated and + compiled lisp from .text section of running executable + * Debian/rules builds and ships both images + * Check for small fixnum in make_fixnum macro + * Pass real integers to array functions to minimize fixnum garbage + * Larger SHARP_EQ_CONTEXT_SIZE in read.d + * Shadowing-import instead of import dummy symbols into common-lisp in + ansi_cl.lisp + * Rework object definition in makefiles + * Remove old gmp directory + * Remove old tests directory + * Reinsert JAPI configuration + * Spruce up clean target + * Use saved_gcl to recompile cmpnew files + * Toggle ansi image with GCL_ANSI environment variable + * Version 2.5.1 + + -- Camm Maguire Wed, 26 Feb 2003 21:31:04 -0500 + +gcl (2.5.0.cvs20020625-75) unstable; urgency=low + + * Export truename for dlopen systems + + -- Camm Maguire Fri, 14 Feb 2003 23:31:15 -0500 + +gcl (2.5.0.cvs20020625-74) unstable; urgency=low + + * Remove duplicates in apropos a la clisp + * Use static where possible, remove unused functions, decrease global + symbol count by about 1/3 (~ 600 global functions) + * Inline optimize cmod,cplus,ctimes and cdifference like maxima + * eliminate make-pure-array from lfun_list.lsp, not defined + * Prototypes for all possible compiler generated function calls + * relative symlink for cmpinclude.h in Debian package + + -- Camm Maguire Fri, 14 Feb 2003 20:17:31 -0500 + +gcl (2.5.0.cvs20020625-73) unstable; urgency=low + + * typep fixes for class types + * m68k Build-depend on gcc-2.95 as a temporary work around to bug + 179807 + * gcc-3.2 warning cleanups + * bfd_boolean syntax support for newer binutils + * gcc-3.2 on powerpc can't yet handle -O2 and higher + * Reenable gcc-3.2 for m68k and do some guesswork in configure + + -- Camm Maguire Mon, 10 Feb 2003 13:47:00 -0500 + +gcl (2.5.0.cvs20020625-72) unstable; urgency=high + + * Fix to siLbit_array_op for 0 dimension arrays + * Fixed aref of short-float vector + * nconc can take dotted lists + * tailp returns t if first arg is nil + * Repair nconc and tailp fixes + * varargs->stdarg for gcc 3.3 and higher + + -- Camm Maguire Sun, 9 Feb 2003 16:57:33 -0500 + +gcl (2.5.0.cvs20020625-71) unstable; urgency=high + + * ansi changes to sloop.lsp and conditions.lisp to fix symbol tests + * :definition-before-pcl -> definition-before-pcl + * Allow spaces in pathnames + * Significant fixes to gmp_num_log.c affecting bitwise ops on bignums + * Fix test segfault arising from faulty structure-type-included-type- + name in gcl-low.lisp ; Thanks Peter + * aref1 -> row-major-aref + * Fixes to certain numerical functions to handle denormalized floating + point numbers + * Number of argument check in IapplyVector + * Print offset bit vectors correctly + * Correct precision for formatting short and long doubles + * Added si::modf + * Do not trigger error in IapplyVector if max args is zero + * Fixes to with-package-iterator to cleanup compiler warnings + * :invalid-variable is a type error + * No max arg checking if &key or &rest present + * proper defun declarations in listlib.lsp + * class specifiers in typep, subtypep and coerce + * Corrections to allow-other-key processing in bind.c + * eval sfuns with argument error checking (in one place) + * copy-structure takes only one arg + * si::classp, si::class-of, and si::class-precedence-list overwritten + by pcl analogs when compiling ansi + * recompiled core lsp and compiler files + * restore dvi and html doc build for non-mingw + + -- Camm Maguire Fri, 24 Jan 2003 13:55:11 -0500 + +gcl (2.5.0.cvs20020625-70) unstable; urgency=high + + * loop fixes + * configure fixes + * :common-lisp in *features* + * :definition-before-clcs -> definition-before-clcs + * protect against sgc segfault within fread in fasdump.c -- fixes m68k + acl2 build + * SGC for s390 + + -- Camm Maguire Thu, 5 Dec 2002 08:02:17 -0500 + +gcl (2.5.0.cvs20020625-69) unstable; urgency=high + + * eval fix + * \-mlong-calls for arm + + -- Camm Maguire Mon, 25 Nov 2002 08:35:27 -0500 + +gcl (2.5.0.cvs20020625-68) unstable; urgency=high + + * enable emacsdir configure option + * reordered configure X lib detection for solaris + * redo integer declarations for gmp bignums to avoid compiler warnings + * Clear large and negative count errors for remove/delete + * Loop error fixes + * cache flush with page granularity on m68k + + -- Camm Maguire Thu, 21 Nov 2002 17:44:30 -0500 + +gcl (2.5.0.cvs20020625-67) unstable; urgency=high + + * Align cache flushes for powerpc and m68k on 32 byte boundaries, + should fix acl2 build + * Removed diagnostic SIGILL trapping in cmpaux.c + + -- Camm Maguire Tue, 12 Nov 2002 23:25:49 -0500 + +gcl (2.5.0.cvs20020625-66) unstable; urgency=high + + * Fix SIGILL trap in cmpaux.c + + -- Camm Maguire Mon, 11 Nov 2002 11:14:07 -0500 + +gcl (2.5.0.cvs20020625-65) unstable; urgency=high + + * Miscellaneous Freebsd patches + * non-recursive with-package-iterator + * map-into fill-pointer fixes + * changes to the user-init mechanism for portable acl2 build + + -- Camm Maguire Sun, 10 Nov 2002 12:33:59 -0500 + +gcl (2.5.0.cvs20020625-64) unstable; urgency=low + + * Fix epsilon calculations again to reenable arm build + + -- Camm Maguire Fri, 1 Nov 2002 07:08:33 -0500 + +gcl (2.5.0.cvs20020625-63) unstable; urgency=low + + * Add versioned dependency on the gcc used to build gcl + + -- Camm Maguire Tue, 29 Oct 2002 16:20:22 -0500 + +gcl (2.5.0.cvs20020625-62) unstable; urgency=low + + * with-package-iterator modifications + * with-package-iterator uses labels to correctly provide for recursion + * Fix doc directory problem with install target in info/makefile + * Fix info dir setting in configure + * Priority extra + + -- Camm Maguire Mon, 28 Oct 2002 23:45:07 -0500 + +gcl (2.5.0.cvs20020625-61) unstable; urgency=low + + * Placeholder support for optional condition in find-restart + * defpackage error on importing non-existent symbols + * working with-package-iterator macro + * various package errors reported as :package-error + * Destructuring-bind fixes + * delete-package error fix + * pcl functions use pcl-destructuring-bind for now -- fix later + * Trigger error if function calls use too many 'values' + * Maximum values increased to 50 + * Enable previously failing tests in multiple-value-{setq,prog1}.lsp + * prototype for system_time_zone_helper + * Initial changes for solaris support + * make -> $(MAKE) in makefiles + * Incorporated main GCL (ANSI) Lisp Documentation in distribution + + -- Camm Maguire Mon, 28 Oct 2002 04:31:33 -0500 + +gcl (2.5.0.cvs20020625-60) unstable; urgency=low + + * Still better acosh, courtesy of Barton Willis + * Better epsilon contant determination in ieee case + * Implicit tagbody in do-symbols and do-all-symbols + * Better epsilon handling in ieee case + * Add setf (values ... support + * invalid-function errors are type errors + * ecase and ccase take t and otherwise clauses + * ECASE/CCASE test fixes + * setf values fixes to use setf instead of setq when target value is + not a symbol + * ETYPECASE/CTYPECASE can take t and otherwise + * Backout of restart-clusters export + * fix handler.lisp + * Fix to bfd/GBC interaction + + -- Camm Maguire Wed, 23 Oct 2002 08:38:08 -0400 + +gcl (2.5.0.cvs20020625-59) unstable; urgency=low + + * wrong number of arguments, keyword errors in lambda list bindings, + are program errors + * acosh fix at -1.0 + * New config.sub and config.guess files and automatic updates in + binutils, gmp, and gmp3 subdirs + + -- Camm Maguire Wed, 16 Oct 2002 11:38:56 -0400 + +gcl (2.5.0.cvs20020625-58) unstable; urgency=low + + * GENSYM fixes + * add complement and constantly + * import certain symbols into common-lisp package + * Fix makefile bug in install target + * Prepend instead of overwrite C_INCLUDE_PATH in shell wrapper + * More shell variable fixes in main makefile + * Corrected order of push and pushnew + * Set bfd_error appropriately + * Report function for package-error in condition-definitions.lisp;fix + internal-package-error deinition and handling;export *restart- + clusters* to user error code specified in handler-case;package-error + error formatting changes;dummy optional argument added to compute- + restarts (for now);Paul Dietz patch to defpackage.lsp fixing several + tests (thanks);export/unexport error handling fixes + * Recompile c,h and data files + * Fix number of argument errors in debug.lsp;documentation support for + packages in defpackage.lsp and module.lsp;do-symbols loops over + inherited symbols too in packlib.lsp + * Reworked EXTRAS variable handling in unixport/makefile + * Build-depend on autotools-dev and automatic update of config.sub and + config.guess;newer config.sub and config.guess in cvs tree; Closes: + #164526 + * Remove stray comments in package.d + * elt errors of type type error + * bad-sequence limit returns type error + + -- Camm Maguire Tue, 15 Oct 2002 15:39:19 -0400 + +gcl (2.5.0.cvs20020625-57) unstable; urgency=low + + * Capitalization changes to names of special characters;graphic-char-p + fix + * fix shadowing of existing symbols in package.d + * (simple-)base-string not a subtype of (simple-)vector + * add package-error condition(preliminary);hash conditions only by the + error name, not the format string;pass error types for both + correctable and non-correctable situations;eliminate duplicate + loading of clcs/package.lisp;Allow t doc-types in documentation + (returning nil) for now;fix final type errors in predlib.lsp + (regarding base-string);other error functions to pass continuable + errors (needs cleaning up);package designators can be + characters;delete-package added;make-package doesn't :use lisp by + default;in-package returns error if package does not exist instead + of making the package(relatively big change -- need to address + instances of in-package in .lsp code);call make-package on relevant + packages in init_gcl.lsp.in and pcl/sys-package.lisp; + * \-ffunction-sections for hppa with no-optimization -- enables first + maxima build here + * separate lisp variables to specify optimization flags for level 2 + and 3 + * symbol-name throws a type error on bad input + * tk8.2 -> tk8.3 + * Fix bug in main makefile + * Newlines at end of test files + + -- Camm Maguire Wed, 9 Oct 2002 15:04:41 -0400 + +gcl (2.5.0.cvs20020625-56) unstable; urgency=high + + * ansi-test corrections; extra-libs option to LINK function; LINK doc + change; subtypep and string changes to pass more tests + * Add method-combination and structure-object symbols for ansi;remove + unused variables in debug.lsp;remove in-package system from + defstruct.lsp;make-keyword and defmacro temporary function + placeholders in destructuring_bind.lsp;predlib changes to fix ansi- + test type errors;break-call takes 2 args (sys-proclaim.lisp);char + and char-set protected by string dimension not fillpointer in + string.d;fix bug in string.d:member_char for vector types;redefine + slot reader and writer functions in pcl/impl/gcl/gcl-low.lisp + + -- Camm Maguire Sat, 5 Oct 2002 14:33:46 -0400 + +gcl (2.5.0.cvs20020625-55) unstable; urgency=high + + * Add LINK documentation to info pages + * 0 length last support + * make-sequence error check for 'null type and non-zero size + * Dotted-list support in member + * Reworked dotnil definitions and support macros + * add compile-file-pathname + * setup C_INCLUDE_PATH env variable in gcl shell wrapper + * POSITIVE-FIXNUM variable type,simple-error->type error where + indicated by various ansi tests, eq->eql in ldiff and tailp;proper + lists only in member et. al. + * rev keyword for member1 to reverse test arguments + * specific-error function to pass a given type of error from lisp + * set-exclusive-or preserves order of test arguments + * type-errors where appropriate in make-sequence + * nil keys accepted in remove/delete et.al. + * Reworked linking command line to ensure that certain symbols are + resolved in libgcl.a as opposed to certain system libraries, e.g. + gmp + * new gmp for m68k;no -ffloat-store for m68k a requested by user due + to performance impact (will alter test results in maxima + accordingly) + * libgclp.a for objects to be overriden by the C library if necessary + * readably support + * boolean type + * Missing ansi type support + * subtype code for boolean + * add missing ansi types as known types + * other preliminary subtype code for missing ansi types + * rework result-type check in make-sequence + * :element-type support in make-string (preliminary) + * (char ignores fill-pointer + * remove -O4 from debian/rules + + -- Camm Maguire Thu, 3 Oct 2002 01:52:45 -0400 + +gcl (2.5.0.cvs20020625-54) unstable; urgency=high + + * Fix delete et. al. :from-end error; typo in gbc.c + * character and string-char equal in type hierarchy + * concatenate/make-sequence fixes + * merge takes nil key argument + * make-sequence checks size against result type + * install endp macro for dotted list support + + -- Camm Maguire Tue, 24 Sep 2002 14:57:44 -0400 + +gcl (2.5.0.cvs20020625-53) unstable; urgency=high + + * Sleep with (in principle) microsecond precision + * nth-value macro added + * \-ffloat\-store and warning cleanups for m68k + * Compile hppa with debugging, will get a build but a broken one, ok + for now, Closes: #159591 + + -- Camm Maguire Fri, 20 Sep 2002 09:48:35 -0400 + +gcl (2.5.0.cvs20020625-52) unstable; urgency=high + + * Fixed gcc version bug in debian/rules + + -- Camm Maguire Thu, 12 Sep 2002 18:00:50 -0400 + +gcl (2.5.0.cvs20020625-51) unstable; urgency=high + + * static gmp for m68k + + -- Camm Maguire Thu, 12 Sep 2002 09:33:03 -0400 + +gcl (2.5.0.cvs20020625-50) unstable; urgency=high + + * Reworked static gmp target for new libgcl.a;gcc-3.2 for + hppa,ia64,and arm;libgmp2-dev for m68k;no rsym with + dynsysbfd;build_symbol_table earlier to shrink table size; + + -- Camm Maguire Thu, 12 Sep 2002 00:39:17 -0400 + +gcl (2.5.0.cvs20020625-49) unstable; urgency=high + + * Use old gmp for m68k until can pin down test failure with gmp3 + + -- Camm Maguire Tue, 10 Sep 2002 00:36:10 -0400 + +gcl (2.5.0.cvs20020625-48) unstable; urgency=high + + * Rework build and install so that custom images can be made without + the source tree, even when using dlopen + + -- Camm Maguire Mon, 9 Sep 2002 23:26:47 -0400 + +gcl (2.5.0.cvs20020625-47) unstable; urgency=high + + * Install cmpinclude.h in system include directory + + -- Camm Maguire Thu, 29 Aug 2002 23:31:55 -0400 + +gcl (2.5.0.cvs20020625-46) unstable; urgency=high + + * Keep a *much* smaller piece of gmp.h in cmpinclude.h, reducing image + size by almost 100k + * Check for _SHORT_LIMB and _LONG_LONG_LIMB in configure + * Remove build specific include directories from compile command in + final executable + * Include local regexp.h explicitly in cmpinclude.h, to eliminate + intereference with system regexp.h, and to fix bug in which gcl + compilation depended on existing build directories + * Correctly add directory paths to extra gmp file targets in + unixport/makefile for m68k + + -- Camm Maguire Thu, 29 Aug 2002 21:56:28 -0400 + +gcl (2.5.0.cvs20020625-45) unstable; urgency=high + + * Fix typo in rshift target for m68k + + -- Camm Maguire Wed, 28 Aug 2002 18:02:00 -0400 + +gcl (2.5.0.cvs20020625-44) unstable; urgency=high + + * Handle second argument to last; treat dotted lists correctly in + ldiff et. al., tailp fix + * optional key argument for assoc-if et.al.;eval getf deflt if in setf + * Fix infinite loop in assoc-if et.al. + * X_LIBS and X_CFLAGS determination in configure script + + -- Camm Maguire Wed, 21 Aug 2002 18:22:37 -0400 + +gcl (2.5.0.cvs20020625-43) unstable; urgency=high + + * Larger ihs stack;fix array-total-size-limit;check negative + fillp;allow #P + * don't make common_lisp package when not configuring with --enable- + ansi + * Patch gmp3/mpn/m68k/{l,r}shift.asm, restore gmp3 to m68k build + * Dynamic libgmp support, overriding with patched functions from local + source where necessary + + -- Camm Maguire Sun, 18 Aug 2002 12:10:55 -0400 + +gcl (2.5.0.cvs20020625-42) unstable; urgency=high + + * copy ansidecl.h and symcat.h in h/ for local bfd builds + * localize bfd.h includes to sfaslbfd.c + * take bfd/po out of the build loop + * import xgcl-2, but don't build by default + * oldgmp configure option, and made default for m68k as temporary + workaround + + -- Camm Maguire Mon, 12 Aug 2002 23:49:09 -0400 + +gcl (2.5.0.cvs20020625-41) unstable; urgency=high + + * Minor rules revision for i164 + + -- Camm Maguire Sun, 11 Aug 2002 13:49:03 -0400 + +gcl (2.5.0.cvs20020625-40) unstable; urgency=high + + * revamp CONST configure test for certain bfd versions + + -- Camm Maguire Sun, 11 Aug 2002 12:31:35 -0400 + +gcl (2.5.0.cvs20020625-39) unstable; urgency=high + + * gcc-3.1 for ia64 fixes a compilation bug in num_co.c for -O3 and + higher -- code takes address of a variable kept in a register + * compile num_log.c with -O only on ia64 to work around compiler bug + + -- Camm Maguire Sun, 11 Aug 2002 08:53:03 -0400 + +gcl (2.5.0.cvs20020625-38) unstable; urgency=high + + * check for long c statck addresses, fixing NULL_OR_ON_C_STACK macro + for ia64 + * Remove error in clean target + + -- Camm Maguire Sat, 10 Aug 2002 13:20:08 -0400 + +gcl (2.5.0.cvs20020625-37) unstable; urgency=high + + * Replace tmpnam and mktemp with less dangerous mkstemp + + -- Camm Maguire Fri, 9 Aug 2002 19:45:52 -0400 + +gcl (2.5.0.cvs20020625-36) unstable; urgency=high + + * Fix rsym compilation when not using bfd + + -- Camm Maguire Fri, 9 Aug 2002 19:10:16 -0400 + +gcl (2.5.0.cvs20020625-35) unstable; urgency=high + + * Don't build bfd/po subdir + * Build-depend on automake and gettext + + -- Camm Maguire Fri, 9 Aug 2002 14:36:58 -0400 + +gcl (2.5.0.cvs20020625-34) unstable; urgency=high + + * fix zero length array support + * reverse configure order for bfd and libiberty + + -- Camm Maguire Fri, 9 Aug 2002 11:52:38 -0400 + +gcl (2.5.0.cvs20020625-33) unstable; urgency=high + + * chmod +x for subconfigures + * dlopen for appropriate arches in debian/rules + * add custreloc configure option + + -- Camm Maguire Fri, 9 Aug 2002 10:16:55 -0400 + +gcl (2.5.0.cvs20020625-32) unstable; urgency=high + + * Local bfd build option to prepare for arch-specific patches + * Try default gmp3 build on m68k + * Fix merge-pathnames + + -- Camm Maguire Fri, 9 Aug 2002 00:13:16 -0400 + +gcl (2.5.0.cvs20020625-31) unstable; urgency=high + + * #undef bool in object.h for some gcc-3.1 installations + * New number_tan implementation using real tan, so optimized compiled + code will find symbol in -lm + + -- Camm Maguire Tue, 6 Aug 2002 18:37:52 -0400 + +gcl (2.5.0.cvs20020625-30) unstable; urgency=high + + * fix bug in cmpif.lsp and recompile compiler + * \-O6 \-fomit\-frame\-pointer for Linux, speed gain of ~ 10% + * clean saved_gcl_pcl + + -- Camm Maguire Mon, 5 Aug 2002 16:34:33 -0400 + +gcl (2.5.0.cvs20020625-29) unstable; urgency=high + + * Back out of hppa assembler register flush for hppa, apparently issue + is cleared by long/object function declaration fix + * Remove ansi2knr.1 man page, Closes: #155067 + * hppa still has gc leak, possibly due to faulty setjmp. Try Lamont + Jones' latest assembler to flush regs + + -- Camm Maguire Fri, 2 Aug 2002 20:50:21 -0400 + +gcl (2.5.0.cvs20020625-28) unstable; urgency=high + + * SGC support for alpha + * generic gmp3 build for m68k + * compiler changes to declare all functions as returning object, with + functions that actually return long being cast appropriately + * back out of m68k hack in eval.c and funlink.c + + -- Camm Maguire Fri, 2 Aug 2002 18:22:04 -0400 + +gcl (2.5.0.cvs20020625-27) unstable; urgency=high + + * Use generic lshift.c in gmp3 for m68k + * use SGC for ia64 + * m68k workaround, cast (object(*)()) to (long(*)()) in funlink.c and + eval.c + * GBC register spiil asm for hppa + * fix hash_equal declaration error in hash.d + + -- Camm Maguire Thu, 1 Aug 2002 18:12:49 -0400 + +gcl (2.5.0.cvs20020625-26) unstable; urgency=high + + * Remove extra load of tkl.o in install target of main makefile + * gcc-3.1 for hppa + * Remove gcc version spec for m68k + * \-fPIC for hppa, needed for dlopen + * cleanup gcc 3.1 warning in funlink.c + * cc instead of ld for -shared linking in fasldlsym.c (needed for + hppa) + + -- Camm Maguire Wed, 31 Jul 2002 18:46:54 -0400 + +gcl (2.5.0.cvs20020625-25) unstable; urgency=high + + * Move chmod +x gmp3/* into debian/rules + * Remove gclm.bat from Debian package + * Build-Depend on autoconf, Closes: #154909 + + -- Camm Maguire Wed, 31 Jul 2002 09:44:20 -0400 + +gcl (2.5.0.cvs20020625-24) unstable; urgency=high + + * chmod +x gmp3/configure + + -- Camm Maguire Wed, 31 Jul 2002 07:55:17 -0400 + +gcl (2.5.0.cvs20020625-23) unstable; urgency=high + + * 64bit SGC support + * SGC on by default for sparc-linux and mips(el)-linux + * Optimized logxor funtion + * Check for MP_LIMB_SIZE in fasdump.c, for 64bit support + * gbc fix for ia64 + * gmp3 import for ia64 + * system bzero, bcmp, and bcopy function prototypes + + -- Camm Maguire Tue, 30 Jul 2002 23:11:58 -0400 + +gcl (2.5.0.cvs20020625-22) unstable; urgency=high + + * ElfW macros in rsym*.c for 64bit + * Allow for 8 byte gmp mp_limbs + + -- Camm Maguire Thu, 25 Jul 2002 18:52:37 -0400 + +gcl (2.5.0.cvs20020625-21) unstable; urgency=high + + * Support for dlopen object loading where bfd is not yet working -- + ./configure --enable-dlopen + + -- Camm Maguire Thu, 25 Jul 2002 15:08:05 -0400 + +gcl (2.5.0.cvs20020625-20) unstable; urgency=high + + * Cleanups for --disable-bfd option + + -- Camm Maguire Wed, 24 Jul 2002 15:05:28 -0400 + +gcl (2.5.0.cvs20020625-19) unstable; urgency=high + + * 64bit fixes + + -- Camm Maguire Wed, 24 Jul 2002 12:16:42 -0400 + +gcl (2.5.0.cvs20020625-18) unstable; urgency=high + + * misc. lintian cleanups, mostly for 64 bit + + -- Camm Maguire Tue, 23 Jul 2002 23:35:03 -0400 + +gcl (2.5.0.cvs20020625-17) unstable; urgency=high + + * Fixed typeo in error.c preventing arm compilation + + -- Camm Maguire Mon, 22 Jul 2002 17:18:18 -0400 + +gcl (2.5.0.cvs20020625-16) unstable; urgency=high + + * Fix bad on_stack_list_vector args + + -- Camm Maguire Mon, 22 Jul 2002 16:10:16 -0400 + +gcl (2.5.0.cvs20020625-15) unstable; urgency=high + + * More lint changes for sundry arches + * Fixed bug in Iapply_ap + + -- Camm Maguire Sat, 20 Jul 2002 23:40:33 -0400 + +gcl (2.5.0.cvs20020625-14) unstable; urgency=high + + * include stdarg.h when defining _GNU_SOURCE + + -- Camm Maguire Sat, 20 Jul 2002 18:47:43 -0400 + +gcl (2.5.0.cvs20020625-13) unstable; urgency=high + + * Proper va_dcl declarations + + -- Camm Maguire Sat, 20 Jul 2002 10:40:02 -0400 + +gcl (2.5.0.cvs20020625-12) unstable; urgency=high + + * cvs updates for missing ptrdiff_t + + -- Camm Maguire Sat, 20 Jul 2002 08:41:37 -0400 + +gcl (2.5.0.cvs20020625-11) unstable; urgency=high + + * cvs changes to compile cleanly with -Wall + + -- Camm Maguire Sat, 20 Jul 2002 02:59:33 -0400 + +gcl (2.5.0.cvs20020625-10) unstable; urgency=high + + * Architecture any, though still have some issues + + -- Camm Maguire Fri, 12 Jul 2002 19:02:09 -0400 + +gcl (2.5.0.cvs20020625-9) unstable; urgency=high + + * cvs commits for 64bit support + + -- Camm Maguire Fri, 12 Jul 2002 18:01:21 -0400 + +gcl (2.5.0.cvs20020625-8) unstable; urgency=high + + * NULL_OR_ON_C_STACK macro correction for m68k + + -- Camm Maguire Fri, 12 Jul 2002 14:37:48 -0400 + +gcl (2.5.0.cvs20020625-7) unstable; urgency=high + + * arm is bigendian + + -- Camm Maguire Wed, 10 Jul 2002 18:04:22 -0400 + +gcl (2.5.0.cvs20020625-6) unstable; urgency=high + + * cvs updates for arm build + + -- Camm Maguire Tue, 9 Jul 2002 16:09:26 -0400 + +gcl (2.5.0.cvs20020625-5) unstable; urgency=high + + * CC environment variable setting in debian/rules to aid in porting + * gcc 2.95 for m68k + + -- Camm Maguire Sat, 6 Jul 2002 23:00:23 -0400 + +gcl (2.5.0.cvs20020625-4) unstable; urgency=high + + * gcc 3.0 for arm + * cachectl header for m68k + + -- Camm Maguire Mon, 1 Jul 2002 15:47:53 -0400 + +gcl (2.5.0.cvs20020625-3) unstable; urgency=high + + * Better libbfd detection for arm/alpha + + -- Camm Maguire Wed, 26 Jun 2002 17:27:21 -0400 + +gcl (2.5.0.cvs20020625-2) unstable; urgency=high + + * s390 support + + -- Camm Maguire Tue, 25 Jun 2002 21:25:35 -0400 + +gcl (2.5.0.cvs20020625-1) unstable; urgency=high + + * CVS updates, new s390 arch + + -- Camm Maguire Tue, 25 Jun 2002 19:26:36 -0400 + +gcl (2.5.0.cvs20020610-2) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Thu, 13 Jun 2002 08:42:32 -0400 + +gcl (2.5.0.cvs20020610-1) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Wed, 12 Jun 2002 23:04:57 -0400 + +gcl (2.5.0.cvs20020523-2) unstable; urgency=high + + * configure updates for better tk detection + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020523-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020429-1) unstable; urgency=high + + * Build-Depend on tk8.2-dev, Closes: #144330 + * New cvs updates + * Added sparc to arch list, Closes: #143465 + + -- Camm Maguire Mon, 29 Apr 2002 23:07:36 -0400 + +gcl (2.5.0.cvs20020219-2) unstable; urgency=medium + + * flavor ->debian-emacs-flavor in emacsen-startup + + -- Camm Maguire Mon, 4 Mar 2002 14:29:59 -0500 + +gcl (2.5.0.cvs20020219-1) unstable; urgency=medium + + * Updated package descriptions, Closes: #134402 + * Static linking of libbfd, Closes: #134647 + * Gcl currently only available on i386, arm and m68k as specified in + the Architecture control field, Closes: #133912 + + -- Camm Maguire Tue, 19 Feb 2002 12:04:29 -0500 + +gcl (2.5.0.cvs-3) unstable; urgency=medium + + * Build-depend on texi2html, Closes: #133699 + + -- Camm Maguire Wed, 13 Feb 2002 16:22:35 -0500 + +gcl (2.5.0.cvs-2) unstable; urgency=medium + + * Put in versioned dependency on binutils for libbfd support, rebuilt + with latest binutils, Closes: #133004 + + -- Camm Maguire Tue, 12 Feb 2002 13:19:12 -0500 + +gcl (2.5.0.cvs-1) unstable; urgency=medium + + * Latest patches from CVS, enabling libbfd relocations, among other + things + * /etc/emacs/site-start.d/50gcl.el as conffile, Closes: #132137 + * limited arm and m68k support + + -- Camm Maguire Mon, 4 Feb 2002 09:32:29 -0500 + +gcl (2.5.0-1) unstable; urgency=medium + + * New maintainer + * New upstream release + * New release so far builds only on i386, Closes: #116070, Closes: + #123371 + * New release so far builds only on i386, Closes: #115041 + * Gcl must currently use its own copy of gmp, as the upstream version + of gmp uses malloc, which interferes with gcl's garbage collection + and relocation scheme. The change from malloc to alloca has been + suggested to upstream gmp developers. Closes: #108910 + * Tcl/Tk support now in. Closes: #113197 + + -- Camm Maguire Fri, 21 Dec 2001 00:03:43 -0500 + +gcl (2.4.0-3) unstable; urgency=medium + + * Make gcl use libgmp3 package. (closes: #108910) + * Remove tk support. (closes: #108909) + * Fix stupid missing dependency line. (closes: #108907, #108908) + * Removed readme.mingw from the debian package, this package is not compiled under + mingw (windows gcc port). + * Close ITA bug. (closes: #112312) + + -- Baruch Even Sat, 22 Sep 2001 00:27:14 +0300 + +gcl (2.4.0-2) unstable; urgency=low + + * Change tclsh Build-Depends to tcl8.0 because apt is broken. (closes: #99261) + + -- JP Sugarbroad Wed, 30 May 2001 14:34:53 -0500 + +gcl (2.4.0-1) unstable; urgency=low + + * New upstream release + + -- JP Sugarbroad Sun, 13 May 2001 20:31:01 -0500 + +gcl (2.3.7+beta3-3) unstable; urgency=low + + * Move gcl-doc to section doc (closes: #78666) + + -- JP Sugarbroad Sun, 13 May 2001 20:26:28 -0500 + +gcl (2.3.7+beta3-2) unstable; urgency=low + + * Remove alpha from arch list + * Move tcl/tk from Depends to Suggests + + -- JP Sugarbroad Fri, 4 May 2001 16:24:11 -0500 + +gcl (2.3.7+beta3-1) unstable; urgency=low + + * New maintainer + * Repackaged with debhelper (closes: #42045, #86097, #91475, #91478) + * New upstream release (closes: #59577, #71096) + * Added sparc+alpha, removed m68k (closes: #87407) + + -- JP Sugarbroad Mon, 30 Apr 2001 19:07:49 -0500 + +gcl (2.2.1-6) unstable; urgency=low + + * Disable stripping of "saved_gcl" binary. (#45778) + + -- Steve Dunham Fri, 24 Sep 1999 14:39:15 -0400 + +gcl (2.2.1-5) unstable; urgency=low + + * Fix m68k build + + -- Steve Dunham Tue, 6 Jul 1999 09:45:09 -0400 + +gcl (2.2.1-4) unstable; urgency=low + + * Fix bug #31718 + + -- Steve Dunham Fri, 2 Jul 1999 11:11:12 -0400 + +gcl (2.2.1-3) unstable; urgency=low + + * Add m68k patches + + -- Steve Dunham Wed, 16 Dec 1998 14:25:46 -0500 + +gcl (2.2.1-2) unstable; urgency=low + + * Compile against libc6. New maintainer. + + -- Steve Dunham Wed, 5 Nov 1997 10:09:12 -0500 + +gcl (2.2.1-1) unstable; urgency=low + + * New upstream release; suggests tcl76, tk42. + * gcl-doc contains gcl-si and gcl-tk info pages. + * debian/rules: clean target removes temporary files from h and o + subdirectories (bug #5984). + + -- Karl Sackett Fri, 3 Jan 1997 10:16:40 -0600 + +gcl (2.2-5) unstable; urgency=low + + * Converted package to 2.1.1.0 standard. + * Stripped gcltkaux (bug #5074). + * gcl-si and gcl-tk info pages converted to HTML. + + -- Karl Sackett Tue, 5 Nov 1996 13:30:30 -0600 + +2.2-4 + * add-defs: patched locates for tk.tcl, init.tcl + * gcl-tk/tkAppInit.c: patched for tk4.1 support + * gcl-tk/tkMain.c: patched for tk4.1 support +2.2-3 + * Debian support files now partily architecture independent. + There are, however, no add-defs files except for 386-linux. + * Rebuilt package to correct corrupted upload problem. +2.2-2 + * Removed tk support from distribution. This was written to + use tk-3.6 and doesn't support tk-4.0 or tk-4.1. I am not aware + of any plans to upgrade the code. (Closes bug #2865) +2.2-1 + * Added Debian support files + * h/386-linux.defs: set OFLAG = -O2 + * h/386-linux.h: undid patch that swaped signal.h for sigcontext.h diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..b1bd38b --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +13 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..687792e --- /dev/null +++ b/debian/control @@ -0,0 +1,39 @@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 13), libeditreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl, gcc-11 +Standards-Version: 4.5.0 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4), ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/debian/control_ b/debian/control_ new file mode 100644 index 0000000..687792e --- /dev/null +++ b/debian/control_ @@ -0,0 +1,39 @@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 13), libeditreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl, gcc-11 +Standards-Version: 4.5.0 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4), ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/debian/control_cvs b/debian/control_cvs new file mode 100644 index 0000000..83eb81d --- /dev/null +++ b/debian/control_cvs @@ -0,0 +1,39 @@ +Source: gclcvs +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 13), libeditreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl, gcc-11 +Standards-Version: 4.5.0 + +Package: gclcvs +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gclcvs-doc +Description: GNU Common Lisp compiler, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gclcvs-doc package. + +Package: gclcvs-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4), ${misc:Depends} +Description: Documentation for GNU Common Lisp, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..c58a983 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,65 @@ +This package was debianized by JP Sugarbroad on +Mon, 30 Apr 2001 19:07:49 -0500. + +It was downloaded from http://savannah.gnu.org/projects/gcl + +Upstream Author: Bill Schelter + +Copyright: + + This package is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This package 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 + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA + 02110-1301, USA. + +On Debian GNU/Linux systems, the complete text of the GNU Lesser General +Public License can be found in `/usr/share/common-licenses/LGPL-2'. + +The source under xgcl-2 is + +Copyright (c) 1995 Gordon S. Novak Jr., Hiep Huu Nguyen, William F. Schelter, +and The University of Texas at Austin. + +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 1, or (at your option) +any later version. + +and + +;;********************************************************** +;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, +;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. + +;; All Rights Reserved + +;;Permission to use, copy, modify, and distribute this software and its +;;documentation for any purpose and without fee is hereby granted, +;;provided that the above copyright notice appear in all copies and that +;;both that copyright notice and this permission notice appear in +;;supporting documentation, and that the names of Digital or MIT not be +;;used in advertising or publicity pertaining to distribution of the +;;software without specific, written prior permission. + +;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL +;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, +;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +;;SOFTWARE. + +;;***************************************************************** + +On Debian GNU/Linux systems, the complete text of the GNU General +Public License can be found in `/usr/share/common-licenses/GPL-1'. diff --git a/debian/gcl.lintian-overrides b/debian/gcl.lintian-overrides new file mode 100644 index 0000000..35cdb23 --- /dev/null +++ b/debian/gcl.lintian-overrides @@ -0,0 +1,9 @@ +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12-prof/unixport/saved_ansi_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12-prof/unixport/saved_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12/unixport/saved_ansi_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12/unixport/saved_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12-prof/unixport/saved_ansi_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12-prof/unixport/saved_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12/unixport/saved_ansi_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12/unixport/saved_gcl +gcl: emacsen-common-without-dh-elpa diff --git a/debian/gcl.sh b/debian/gcl.sh new file mode 100755 index 0000000..9ea8018 --- /dev/null +++ b/debian/gcl.sh @@ -0,0 +1,28 @@ +#!/bin/sh + +EXT=@EXT@ +VERS=@VERS@ + +. /etc/default/gcl$EXT +if ! set | grep -q -w GCL_ANSI ; then GCL_ANSI=$DEFAULT_GCL_ANSI ; fi +if ! set | grep -q -w GCL_PROF ; then GCL_PROF=$DEFAULT_GCL_PROF ; fi + +if [ "$GCL_PROF" = "" ] ; then + DIR=/usr/lib/gcl-$VERS ; +else + DIR=/usr/lib/gcl-$VERS-prof ; +fi + +if [ "$GCL_ANSI" = "" ] ; then + EXE=saved_gcl; +else + EXE=saved_ansi_gcl; +fi +SYS=$DIR/unixport + +exec $SYS/$EXE -dir $SYS/ -libdir $DIR/ \ + -eval '(setq si::*allow-gzipped-file* t)' \ + -eval '(setq si::*tk-library* "/usr/lib/tk@TKVERS@")' \ + "$@" + +# other options: -load /tmp/foo.o -load jo.lsp -eval "(joe 3)" diff --git a/debian/gcl.templates b/debian/gcl.templates new file mode 100644 index 0000000..3bc069d --- /dev/null +++ b/debian/gcl.templates @@ -0,0 +1,38 @@ +# These templates have been reviewed by the debian-l10n-english +# team +# +# If modifications/additions/rewording are needed, please ask +# debian-l10n-english@lists.debian.org for advice. +# +# Even minor modifications require translation updates and such +# changes should be coordinated with translators and reviewers. + +Template: gcl@EXT@/default_gcl_ansi +Type: boolean +_Description: Use the work-in-progress ANSI build by default? + GCL is in the process of providing an ANSI compliant image in addition to + its traditional CLtL1 image still in production use. + . + Please see the README.Debian file for a brief description of these terms. + Choosing this option will determine which image will be used by default + when executing 'gcl@EXT@'. + . + This setting may be overridden by setting the GCL_ANSI + environment variable to any non-empty string for the ANSI build, and to + the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The + currently enforced build flavor will be reported in the initial startup + banner. + +Template: gcl@EXT@/default_gcl_prof +Type: boolean +_Description: Use the profiling build by default? + GCL has optional support for profiling via gprof. + . + Please see the documentation for si::gprof-start and si::gprof-quit + for details. As this build is slower than builds without gprof + support, it is not recommended for final production use. + . + Set the GCL_PROF environment variable to the empty string for more + optimized builds, or any non-empty string for profiling support; e.g. + GCL_PROF=t gcl@EXT@. If profiling is enabled, this will be reported + in the initial startup banner. diff --git a/debian/in.gcl-doc.README.Debian b/debian/in.gcl-doc.README.Debian new file mode 100644 index 0000000..b8d01a6 --- /dev/null +++ b/debian/in.gcl-doc.README.Debian @@ -0,0 +1,9 @@ +New in 2.6.2 +------------ + +The gcl.texi files and the resulting html, info, and pdf outputs have +been removed pending an enquiry into the copyright and license status +of the dpANS documents upon which they are presumably based. + + + -- Camm Maguire , Fri, 9 May 2014 19:08:59 +0000 diff --git a/debian/in.gcl-doc.doc-base.main b/debian/in.gcl-doc.doc-base.main new file mode 100644 index 0000000..e15579b --- /dev/null +++ b/debian/in.gcl-doc.doc-base.main @@ -0,0 +1,9 @@ +Document: gcl@EXT@-doc +Title: GNU Common Lisp Documentation +Author: W. Schelter +Abstract: A Common Lisp compiler and interpreter based on C +Section: Programming + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl/*.html diff --git a/debian/in.gcl-doc.doc-base.si b/debian/in.gcl-doc.doc-base.si new file mode 100644 index 0000000..faa0bc6 --- /dev/null +++ b/debian/in.gcl-doc.doc-base.si @@ -0,0 +1,12 @@ +Document: gcl@EXT@-si-doc +Title: GNU Common Lisp Documentation -- System Internals +Author: W. Schelter +Abstract: Documentation on GCL-specific Lisp system functions +Section: Programming + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/gcl-si*.pdf.gz /usr/share/doc/gcl@EXT@-doc/gcl-si*.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl-si/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl-si/*.html diff --git a/debian/in.gcl-doc.doc-base.tk b/debian/in.gcl-doc.doc-base.tk new file mode 100644 index 0000000..23d74ee --- /dev/null +++ b/debian/in.gcl-doc.doc-base.tk @@ -0,0 +1,12 @@ +Document: gcl@EXT@-tk-doc +Title: GNU Common Lisp Tk Interface Documentation +Author: W. Schelter +Abstract: Documentation for Graphical Interface to GCL using TCL/Tk +Section: Programming + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/gcl-tk*.pdf.gz /usr/share/doc/gcl@EXT@-doc/gcl-tk*.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl-tk/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl-tk/*.html diff --git a/debian/in.gcl-doc.doc-base.xgcl b/debian/in.gcl-doc.doc-base.xgcl new file mode 100644 index 0000000..a78b27b --- /dev/null +++ b/debian/in.gcl-doc.doc-base.xgcl @@ -0,0 +1,15 @@ +Document: gcl@EXT@-xgcl-doc +Title: GNU Common Lisp Documentation -- System Internals +Author: W. Schelter +Abstract: Documentation on GCL-specific Lisp system functions +Section: Programming + +Format: Text +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc.tex.gz + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/dwdoc/dwdoc1.html +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc/*.html diff --git a/debian/in.gcl-doc.docs b/debian/in.gcl-doc.docs new file mode 100644 index 0000000..2757ff2 --- /dev/null +++ b/debian/in.gcl-doc.docs @@ -0,0 +1,3 @@ +faq +readme +readme.xgcl diff --git a/debian/in.gcl-doc.info b/debian/in.gcl-doc.info new file mode 100644 index 0000000..b8f188c --- /dev/null +++ b/debian/in.gcl-doc.info @@ -0,0 +1,14 @@ +debian/tmp/usr/share/info/gcl@EXT@-si.info +debian/tmp/usr/share/info/gcl@EXT@-tk.info +debian/tmp/usr/share/info/gcl@EXT@-tk.info-1 +debian/tmp/usr/share/info/gcl@EXT@-tk.info-2 +debian/tmp/usr/share/info/gcl@EXT@.info +debian/tmp/usr/share/info/gcl@EXT@.info-1 +debian/tmp/usr/share/info/gcl@EXT@.info-2 +debian/tmp/usr/share/info/gcl@EXT@.info-3 +debian/tmp/usr/share/info/gcl@EXT@.info-4 +debian/tmp/usr/share/info/gcl@EXT@.info-5 +debian/tmp/usr/share/info/gcl@EXT@.info-6 +debian/tmp/usr/share/info/gcl@EXT@.info-7 +debian/tmp/usr/share/info/gcl@EXT@.info-8 +debian/tmp/usr/share/info/gcl@EXT@.info-9 diff --git a/debian/in.gcl-doc.install b/debian/in.gcl-doc.install new file mode 100644 index 0000000..8e31d17 --- /dev/null +++ b/debian/in.gcl-doc.install @@ -0,0 +1 @@ +debian/tmp/usr/share/doc/gcl@EXT@-doc diff --git a/debian/in.gcl.config b/debian/in.gcl.config new file mode 100644 index 0000000..0d960b1 --- /dev/null +++ b/debian/in.gcl.config @@ -0,0 +1,19 @@ +#!/bin/sh +CONFIGFILE=/etc/default/gcl@EXT@ +set -e +. /usr/share/debconf/confmodule + +# Load config file, if it exists. +if [ -e $CONFIGFILE ]; then + . $CONFIGFILE || true + + # Store values from config file into + # debconf db. + db_set gcl@EXT@/default_gcl_ansi $DEFAULT_GCL_ANSI + db_set gcl@EXT@/default_gcl_prof $DEFAULT_GCL_PROF +fi + +# Ask questions. +db_input medium gcl@EXT@/default_gcl_ansi || true +db_input medium gcl@EXT@/default_gcl_prof || true +db_go || true diff --git a/debian/in.gcl.docs b/debian/in.gcl.docs new file mode 100644 index 0000000..b50c945 --- /dev/null +++ b/debian/in.gcl.docs @@ -0,0 +1,2 @@ +ansi-tests/test_results +RELEASE-2.6.2.html diff --git a/debian/in.gcl.emacsen-compat b/debian/in.gcl.emacsen-compat new file mode 100644 index 0000000..573541a --- /dev/null +++ b/debian/in.gcl.emacsen-compat @@ -0,0 +1 @@ +0 diff --git a/debian/in.gcl.emacsen-install b/debian/in.gcl.emacsen-install new file mode 100644 index 0000000..ed97209 --- /dev/null +++ b/debian/in.gcl.emacsen-install @@ -0,0 +1,46 @@ +#! /bin/sh -e +# /usr/lib/emacsen-common/packages/install/#PACKAGE# + +# Written by Jim Van Zandt , borrowing heavily +# from the install scripts for gettext by Santiago Vila +# and octave by Dirk Eddelbuettel . + +FLAVOR=$1 +PACKAGE=gcl@EXT@ + +if [ ${FLAVOR} = emacs ]; then exit 0; fi + +echo install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR} + +#FLAVORTEST=`echo $FLAVOR | cut -c-6` +#if [ ${FLAVORTEST} = xemacs ] ; then +# SITEFLAG="-no-site-file" +#else +# SITEFLAG="--no-site-file" +#fi +FLAGS="${SITEFLAG} -q -batch -l path.el -f batch-byte-compile" + +ELDIR=/usr/share/emacs/site-lisp/${PACKAGE} +ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE} + +# Install-info-altdir does not actually exist. +# Maybe somebody will write it. +if test -x /usr/sbin/install-info-altdir; then + echo install/${PACKAGE}: install Info links for ${FLAVOR} + install-info-altdir --quiet --section "" "" --dirname=${FLAVOR} /usr/info/${PACKAGE}.info.gz +fi + +install -m 755 -d ${ELCDIR} +cd ${ELDIR} +FILES=`echo *.el` +cp ${FILES} ${ELCDIR} +cd ${ELCDIR} + +cat << EOF > path.el +(setq load-path (cons "." load-path) byte-compile-warnings nil) +EOF +${FLAVOR} ${FLAGS} ${FILES} +rm -f *.el path.el + +exit 0 + diff --git a/debian/in.gcl.emacsen-remove b/debian/in.gcl.emacsen-remove new file mode 100644 index 0000000..699eca1 --- /dev/null +++ b/debian/in.gcl.emacsen-remove @@ -0,0 +1,15 @@ +#!/bin/sh -e +# /usr/lib/emacsen-common/packages/remove/#PACKAGE# + +FLAVOR=$1 +PACKAGE=gcl@EXT@ + +if [ ${FLAVOR} != emacs ]; then + if test -x /usr/sbin/install-info-altdir; then + echo remove/${PACKAGE}: removing Info links for ${FLAVOR} + install-info-altdir --quiet --remove --dirname=${FLAVOR} /usr/info/#PACKAGE#.info.gz + fi + + echo remove/${PACKAGE}: purging byte-compiled files for ${FLAVOR} + rm -rf /usr/share/${FLAVOR}/site-lisp/${PACKAGE} +fi diff --git a/debian/in.gcl.emacsen-startup b/debian/in.gcl.emacsen-startup new file mode 100644 index 0000000..e64d9a8 --- /dev/null +++ b/debian/in.gcl.emacsen-startup @@ -0,0 +1,19 @@ +;; -*-emacs-lisp-*- +;; +;; Emacs startup file for the Debian GNU/Linux #PACKAGE# package +;; +;; Originally contributed by Nils Naumann +;; Modified by Dirk Eddelbuettel +;; Adapted for dh-make by Jim Van Zandt + +;; The #PACKAGE# package follows the Debian/GNU Linux 'emacsen' policy and +;; byte-compiles its elisp files for each 'emacs flavor' (emacs19, +;; xemacs19, emacs20, xemacs20...). The compiled code is then +;; installed in a subdirectory of the respective site-lisp directory. +;; We have to add this to the load-path: +(setq load-path (cons (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/gcl@EXT@") load-path)) + +(autoload 'run@EXT@ "gcl@EXT@" "" t) +(autoload 'dbl@EXT@ "dbl@EXT@" "" t) diff --git a/debian/in.gcl.install b/debian/in.gcl.install new file mode 100644 index 0000000..731600b --- /dev/null +++ b/debian/in.gcl.install @@ -0,0 +1,3 @@ +debian/tmp/usr/lib +debian/tmp/usr/bin +debian/tmp/usr/share/emacs diff --git a/debian/in.gcl.manpages b/debian/in.gcl.manpages new file mode 100644 index 0000000..0b22534 --- /dev/null +++ b/debian/in.gcl.manpages @@ -0,0 +1 @@ +debian/tmp/usr/share/man/man1/gcl@EXT@.1 diff --git a/debian/in.gcl.postinst b/debian/in.gcl.postinst new file mode 100644 index 0000000..8c25bab --- /dev/null +++ b/debian/in.gcl.postinst @@ -0,0 +1,41 @@ +#!/bin/sh +case "$1" in + configure) + +# CONFIGFILE=$(tempfile -m 644) + CONFIGFILE=$(mktemp) + set -e + . /usr/share/debconf/confmodule + + if [ "$1" = "configure" ] || [ "$1" = "reconfigure" ] ; then + + db_get gcl@EXT@/default_gcl_ansi + + if [ "$RET" = "true" ] ; then + DEFAULT_GCL_ANSI=t + else + DEFAULT_GCL_ANSI= + fi + + db_get gcl@EXT@/default_gcl_prof + + if [ "$RET" = "true" ] ; then + DEFAULT_GCL_PROF=y + else + DEFAULT_GCL_PROF= + fi + + echo "DEFAULT_GCL_ANSI=$DEFAULT_GCL_ANSI" >> $CONFIGFILE + echo "DEFAULT_GCL_PROF=$DEFAULT_GCL_PROF" >> $CONFIGFILE + + fi + + ucf --debconf-ok $CONFIGFILE /etc/default/gcl@EXT@ + ucfr gcl@EXT@ /etc/default/gcl@EXT@ + +# chmod 644 /etc/default/gcl@EXT@ + +esac + +#DEBHELPER# + diff --git a/debian/in.gcl.postrm b/debian/in.gcl.postrm new file mode 100644 index 0000000..5360f7d --- /dev/null +++ b/debian/in.gcl.postrm @@ -0,0 +1,22 @@ +#!/bin/sh + +set -e + +case "$1" in + purge) + for ext in '~' '%' .bak .ucf-new .ucf-old .ucf-dist; do + rm -f /etc/default/gcl@EXT@$ext + done + + rm -f /etc/default/gcl@EXT@ + + if which ucf >/dev/null; then + ucf --purge /etc/default/gcl@EXT@ + fi + if which ucfr >/dev/null; then + ucfr --purge gcl@EXT@ /etc/default/gcl@EXT@ + fi + ;; +esac + +#DEBHELPER# diff --git a/debian/old.in.gcl-doc.doc-base.main b/debian/old.in.gcl-doc.doc-base.main new file mode 100644 index 0000000..2d6f3d1 --- /dev/null +++ b/debian/old.in.gcl-doc.doc-base.main @@ -0,0 +1,12 @@ +Document: gcl@EXT@-doc +Title: GNU Common Lisp Documentation +Author: W. Schelter +Abstract: A Common Lisp compiler and interpreter based on C +Section: Apps/Programming + +Format: DVI +Files: /usr/share/doc/gcl@EXT@-doc/gcl.dvi.gz /usr/share/doc/gcl@EXT@-doc/gcl.dvi + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl/*.html diff --git a/debian/po/POTFILES.in b/debian/po/POTFILES.in new file mode 100644 index 0000000..3f9d3e6 --- /dev/null +++ b/debian/po/POTFILES.in @@ -0,0 +1 @@ +[type: gettext/rfc822deb] gcl.templates diff --git a/debian/po/cs.po b/debian/po/cs.po new file mode 100644 index 0000000..98002a1 --- /dev/null +++ b/debian/po/cs.po @@ -0,0 +1,139 @@ +# +# Translators, if you are not familiar with the PO format, gettext +# documentation is worth reading, especially sections dedicated to +# this format, e.g. by running: +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# +# Some information specific to po-debconf are available at +# /usr/share/doc/po-debconf/README-trans +# or http://www.debian.org/intl/l10n/po-debconf/README-trans +# +# Developers do not need to manually edit POT or PO files. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-24 13:21+0100\n" +"Last-Translator: Miroslav Kure \n" +"Language-Team: Czech \n" +"Language: cs\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Používat implicitně ANSI verzi (stále ve vývoji)?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL se nachází ve fázi, kdy kromě tradičního obrazu CLtL1 (který se stále " +"používá) poskytuje i obraz kompatibilní s ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Pro stručný popis těchto termínů si prosím přečtěte soubor README.Debian. " +"Touto odpovědí určujete, který obraz se spustí po zadání „gcl@EXT@“. " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Toto nastavení můžete přebít nastavením proměnné prostředí GCL_ANSI na " +"neprázdný řetězec (použije ANSI verzi) nebo na prázdnou hodnotu (použije " +"CLtL1 verzi). Například GCL_ANSI=t gcl@EXT@. Aktuálně použitá verze se " +"zobrazí na úvodní obrazovce." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Používat implicitně profilování?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL nyní podporuje profilování přes gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Podrobnosti naleznete v dokumentaci si::gprof-start a si::gprof-quit. Tato " +"verze je pomalejší než verze bez podpory gprof, tudíž ji nedoporučujeme pro " +"koncové produkční nasazení." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Toto nastavení můžete přebít nastavením proměnné prostředí GCL_PROF na " +"neprázdný řetězec (zapne profilování) nebo na prázdnou hodnotu (povolí lepší " +"optimalizace). Například GCL_PROF=t gcl@EXT@. Pokud je profilování zapnuto, " +"dozvíte se o tom z úvodní obrazovky." + +#~ msgid "" +#~ "GCL is one of the oldest free common lisp systems still in use. Several " +#~ "production systems have used it for over a decade. The common lisp " +#~ "standard in effect when GCL was first released is known as \"Common Lisp, " +#~ "the Language\" (CLtL1) after a book by Steele of the same name providing " +#~ "this specification. Subsequently, a much expanded standard was adopted " +#~ "by the American National Standards Institute (ANSI), which is still " +#~ "considered the definitive common lisp language specification to this " +#~ "day. GCL is in the process of providing an ANSI compliant image in " +#~ "addition to its traditional CLtL1 image still in production use. Setting " +#~ "this variable will determine which image you will use by default on " +#~ "executing 'gcl'. You can locally override this choice by setting the " +#~ "GCL_ANSI environment variable to any non-empty string for the ANSI build, " +#~ "and to the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl. You " +#~ "may be interested in reviewing the ANSI test results sketching the level " +#~ "of compliance achieved thus far in /usr/share/doc/gcl/test_results.gz. " +#~ "The flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL je jedním z nejstarších svobodných systémů common lispu, který se " +#~ "dosud používá. Několik produkčních systémů jej používá déle než dekádu. " +#~ "Při prvním vydání GCL byl v platnosti standard common lispu známý jako " +#~ "\"Common Lisp, the Language\" (CLtL1) pojmenovaný podle Steelovy knihy " +#~ "stejného jména, která tento standard definovala. Americkým národním " +#~ "institutem pro standardizaci (ANSI) pak byl přijat podstatně rozšířený " +#~ "standard, který se do dnešní doby považuje za konečnou specifikaci common " +#~ "lispu. Kromě tradičního CLtL1 se GCL snaží nabídnout i verzi odpovídající " +#~ "ANSI standardu. Nastavením této proměnné určíte, jakým způsobem se má " +#~ "binárka 'gcl' chovat. Lokálně můžete toto nastavení přepsat nastavením " +#~ "proměnné prostředí GCL_ANSI na neprázdný řetězec (zapne ANSI chování) " +#~ "nebo na prázdnou hodnotu (zapne CLtL1 chování). Například GCL_ANSI-t gcl. " +#~ "Aktuálně vybraný standard bude zobrazen v úvodní obrazovce prostředí. " +#~ "Zajímavé může být porovnání dosud dosažené shody s ANSI standardem v " +#~ "souboru /usr/share/doc/gcl/test_results.gz." diff --git a/debian/po/da.po b/debian/po/da.po new file mode 100644 index 0000000..11d3fc6 --- /dev/null +++ b/debian/po/da.po @@ -0,0 +1,97 @@ +# Danish translation gcl. +# Copyright (C) 2012 gcl & nedenstående oversættere. +# This file is distributed under the same license as the gcl package. +# Joe Hansen (joedalton2@yahoo.dk), 2012. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2012-03-31 12:42+0000\n" +"Last-Translator: Joe Hansen \n" +"Language-Team: Danish \n" +"Language: da\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Brug den foreløbige ANSI bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL er i gang med at tilbyde et ANSI-overholdende aftryk udover det " +"traditionelle CLtL1-aftryk som stadig er i produktionsbrug." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Se venligst filen README.Debian for en kort beskrivelse af disse termer. " +"Valg af denne indstilling vil bestemme hvilket aftryk som vil blive brugt " +"som standard, når der køres »gcl@EXT@«." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Denne indstilling kan overskrives ved at angive miljøvariablen GCL_ANSI til " +"enhver streng der ikke er tom for ANSI-bygningen, og til den tomme streng " +"for CLtL1-bygningen, f.eks. GCL_ANSI=t gcl@EXT@. Den aktuelt tvungne " +"byggevariant vil blive rapporteret i det oprindelige opstartsbanner." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Brug profileringen bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL har valgfri understøttelse for profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Se venligst dokumentationen for si::gprof-start og si::gprof-quit for " +"detaljer. Da denne bygning er langsommere end bygninger uden gprof-" +"understøttelse, så anbefales den ikke for endelig produktionsbrug." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Angiv miljøvariablen GCL_PROF til den tomme streng for bedre optimerede " +"bygninger, eller enhver streng der ikke er tom for " +"profileringsunderstøttelse; f.eks. GCL_PROF=t gcl@EXT@. Hvis profilering er " +"aktiveret, vil denne blive rapporteret i det oprindelige opstartsbanner." diff --git a/debian/po/de.po b/debian/po/de.po new file mode 100644 index 0000000..dafd73d --- /dev/null +++ b/debian/po/de.po @@ -0,0 +1,139 @@ +# Translation of gcl debconf templates to German +# Copyright (C) Stefan Bauer , 2007. +# Copyright (C) Helge Kreutzmann , 2007, 2008. +# This file is distributed under the same license as the gcl package. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-09 11:49+0100\n" +"Last-Translator: Stefan Bauer \n" +"Language-Team: de \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Verwende standardmig den sich in Arbeit befindlichen ANSI-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL ist derzeit dabei, zustzlich zu dem noch im Einsatz befindlichen " +"traditionellen CLtL1-Image ein ANSI-konformes Image bereitzustellen." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Bitte lesen Sie die Datei README.Debian fr eine kurze Beschreibung dieser " +"Begriffe. Die Wahl dieser Option bestimmen, welches Image standardmig " +"verwendet wird, wenn gcl@EXT@ ausgefhrt wird." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Diese Einstellung kann mit der Umgebungsvariablen GCL_ANSI berschrieben " +"werden. Jede nicht-leere Zeichenkette fhrt zur ANSI-Erstellung, und die " +"leere Zeichenkette fhrt zum CLtL1-Bau, z.B. GCL_ANSI=t gcl@EXT@. In der " +"Startmeldung wird die derzeit erzwungene Bauart berichtet." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Verwende standardmig den Profiling-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL besitzt optionale Untersttzung fr Profiling mittels Gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Bitte lesen Sie die Dokumentation fr si::gprof-start und si::gprof-quit fr " +"Details. Da ein solches Programm langsamer ist als ein Programm ohne Gprof-" +"Untersttzung, wird dies fr den Produktiveinsatz nicht empfohlen." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Setzen Sie die Umgebungsvariable GCL_PROF auf die leere Zeichenkette, um ein " +"optimiertes Programm zu erhalten oder auf irgendeine nicht-leere " +"Zeichenkette, fr Profiling-Untersttzung; z.B. GCL_PROF=t gcl@EXT@. Falls " +"Profiling aktiviert ist, wird dies in der Startmeldung angezeigt." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL arbeitet neben dem traditionellen CLtL1-Image fr den " +#~ "Produktiveinsatz zustzlich an der Bereitstellung eines kompatiblen ANSI-" +#~ "Images. Bitte beachten Sie die README.Debian-Datei fr eine kurze " +#~ "Beschreibung dieses Themas. Durch diese Variable definieren Sie, welches " +#~ "Image voreingestellt bei der Ausfhrung von gcl@EXT@ verwendet wird. " +#~ "Diese Auswahl kann lokal, durch einen nicht leeren Wert in der " +#~ "Umgebungsvariable GCL_ANSI fr den ANSI-Build, bzw. einen leeren Wert " +#~ "fr den CLtL1-Build, z.B. GCL_ANSI=t gcl@EXT@ definiert werden. Es " +#~ "erfolgt eine Meldung ber die aktive Erstellung im einfhrenden Start-" +#~ "Banner." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL besitzt optionale Untersttzung fr Profiling mit gprof. Bitte lesen " +#~ "Sie hierzu die Dokumentation von si::gprof-start und si::gprof-quit fr " +#~ "weiterfhrende Informationen. Da dieser Build langsamer ist als ohne " +#~ "gprof-Untersttzung, wird dieser Weg nicht fr den endgltig produktiven " +#~ "Einsatz empfohlen. Sie knnen die hier gemachten Angaben lokal ber die " +#~ "GCL_PROF-Umgebungsvariable durch einen beliebigen Wert ndern, bzw. durch " +#~ "einen leeren Wert fr das weitaus anpassungsfhigere Build, z.B. " +#~ "GCL_PROF=t gcl@EXT@. Falls Profiling aktiviert ist, erfolgt eine Meldung " +#~ "im einfhrenden Start-Banner." diff --git a/debian/po/es.po b/debian/po/es.po new file mode 100644 index 0000000..e4cb113 --- /dev/null +++ b/debian/po/es.po @@ -0,0 +1,209 @@ +# gcl po-debconf translation to Spanish +# Copyright (C) 2005, 2007, 2008 Software in the Public Interest +# This file is distributed under the same license as the gcl package. +# +# Changes: +# - Initial translation +# César Gómez Martín , 2005 +# +# - Updates +# Rudy Godoy Guillén , 2007 +# Francisco Javier Cuadrado , 2008 +# +# Traductores, si no conoce el formato PO, merece la pena leer la +# documentación de gettext, especialmente las secciones dedicadas a este +# formato, por ejemplo ejecutando: +# +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# +# Equipo de traducción al español, por favor, lean antes de traducir +# los siguientes documentos: +# +# - El proyecto de traducción de Debian al español +# http://www.debian.org/intl/spanish/ +# especialmente las notas de traducción en +# http://www.debian.org/intl/spanish/notas +# +# - La guía de traducción de po's de debconf: +# /usr/share/doc/po-debconf/README-trans +# o http://www.debian.org/intl/l10n/po-debconf/README-trans +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-45\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-12-04 20:00+0100\n" +"Last-Translator: Francisco Javier Cuadrado \n" +"Language-Team: Debian l10n spanish \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=utf-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Spanish\n" +"X-Poedit-Country: SPAIN\n" +"X-Poedit-SourceCharset: utf-8\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" +"¿Utilizar la generación ANSI todavía en desarrollo de manera predeterminada?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GL está en el proceso de proporcionar una imagen ANSI, además de su imagen " +"CLtL1 tradicional que todavía se usa." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor, véase el archivo README.Debian para una descripción corta de " +"estos términos. Eligiendo esta opción determinará que imagen se usará de " +"manera predeterminada al ejecutar «gcl@EXT@»." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Esta configuración se puede sobrescribir cambiando la variable de entorno " +"GCL_ANSI a cualquier cadena de caracteres no vacía para la generación ANSI, " +"y a una cadena de caracteres vacía para la generación CLtL1, por ejemplo: " +"«GCL_ANSI=t gcl@EXT@». El actual tipo de generación se mostrará en la " +"información inicial del arranque." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "¿Utilizar la generación con «profiling» de manera predeterminada?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL permite usar «profiling», de manera opcional, mediante gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor, véase la documentación para los detalles de «si::gprof-start» y " +"«si::gprof-quit». Ya que esta generación es más lenta que sin el uso de " +"gprof, no se recomienda para su uso final." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Cambie el valor de la variable de entorno GCL_PROF a una cadena de " +"caracteres vacía para generación más optimizadas, o a una cadena de " +"caracteres no vacía para usar el «profiling», por ejemplo: «GCL_PROF=t " +"gcl@EXT@». Si el «profiling» está activado, se mostrará en la información " +"inicial del arranque." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL está en proceso de incorporar una imagen compatible con ANSI en " +#~ "adición a su imagen CLtL1 tradicional que todavía se usa en producción. " +#~ "Por favor, véase el fichero README de Debian para una breve descripción " +#~ "acerca de estos términos. El definir esta variable determinará qué imagen " +#~ "utilizar de manera predeterminada cuando ejecute «gcl@EXT@».\n" +#~ "Puede anular esta elección localmente definiendo la variable de entorno " +#~ "GCL_ANSI a una cadena no vacía para la compilación ANSI, y a una vacía " +#~ "para la compilación CLtL1, ejemplo: GCL_ANSI=t gcl@EXT@. La versión de la " +#~ "compilación se indicará en el anuncio inicial de arranque." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "Ahora GCL tiene soporte opcional para perfilado a través de gprof. Por " +#~ "favor, mire la documentación de «si::gprof-start» y de «si::gprof-quit» y " +#~ "«si::gprof-quit» si desea más detalles. Dado que esta compilación es más " +#~ "lenta que otras sin soporte para gprof, no se recomienda usarlo en " +#~ "producción. Puede anular esta elección de forma local mediante el " +#~ "establecimiento de la variable de entorno GCL_PROF a cualquier cadena no " +#~ "vacía para soporte de perfiles, y a la cadena vacía para los paquetes más " +#~ "optimizados, es decir GCL_PROF=t gcl. Si el perfilado está activo se " +#~ "indicará en el anuncio inicial de arranque." + +#~ msgid "" +#~ "GCL is one of the oldest free common lisp systems still in use. Several " +#~ "production systems have used it for over a decade. The common lisp " +#~ "standard in effect when GCL was first released is known as \"Common Lisp, " +#~ "the Language\" (CLtL1) after a book by Steele of the same name providing " +#~ "this specification. Subsequently, a much expanded standard was adopted " +#~ "by the American National Standards Institute (ANSI), which is still " +#~ "considered the definitive common lisp language specification to this " +#~ "day. GCL is in the process of providing an ANSI compliant image in " +#~ "addition to its traditional CLtL1 image still in production use. Setting " +#~ "this variable will determine which image you will use by default on " +#~ "executing 'gcl'. You can locally override this choice by setting the " +#~ "GCL_ANSI environment variable to any non-empty string for the ANSI build, " +#~ "and to the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl. You " +#~ "may be interested in reviewing the ANSI test results sketching the level " +#~ "of compliance achieved thus far in /usr/share/doc/gcl/test_results.gz. " +#~ "The flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL es uno de los sistemas libres de «common lisp» más antiguos que " +#~ "todavía se usan. Varios sistemas en producción han estado usándolo " +#~ "durante más de una década. Cuando GCL se liberó por primera vez, el " +#~ "estándar «common lisp» se conocía como «Common Lisp, the " +#~ "Language» (CLtL1) después de un libro escrito por Steele que llevaba el " +#~ "mismo nombre y que proporcionaba esta especificación. Posteriormente se " +#~ "adoptó en el Instituto Nacional de Estándares Americano (ANSI) un " +#~ "estándar más extendido, que todavía se considera la especificación " +#~ "definitiva del lenguaje «common lisp» hasta hoy. GCL está en el proceso " +#~ "de proporcionar una imagen conforme a ANSI además de su imagen CltL1 " +#~ "tradicional que todavía se usa en producción. Al establecer esta variable " +#~ "se determinará la imagen por omisión que usará al ejecutar «gcl». Puede " +#~ "anular esta elección de forma local mediante el establecimiento de la " +#~ "variable de entorno GCL_ANSI a cualquier cadena no vacía para el paquete " +#~ "ANSI, y a la cadena vacía para el paquete CLtL1, i.e. GCL_ANSI=t gcl. " +#~ "Quizás esté interesado en revisar los resultados de las pruebas ANSI " +#~ "describiendo el nivel de conformidad logrado hasta ahora en /usr/share/" +#~ "doc/gcl/test_results.gz. Se informará del tipo de paquete usado en el " +#~ "anuncio inicial de arranque." diff --git a/debian/po/fi.po b/debian/po/fi.po new file mode 100644 index 0000000..e9dc116 --- /dev/null +++ b/debian/po/fi.po @@ -0,0 +1,95 @@ +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-29 23:28+0200\n" +"Last-Translator: Esko Arajärvi \n" +"Language-Team: Finnish \n" +"Language: fi\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Finnish\n" +"X-Poedit-Country: Finland\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Käytetäänkö kehitettävää ANSI-käännöstä oletuksena?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL:n on tarkoitus tarjota ANSI-yhteensopiva kuva perinteisen, vielä " +"tuotantokäytössä olevan CLtL1-kuvan lisäksi." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Tiedostosta README.Debian löytyy (englanniksi) näiden termien lyhyet " +"kuvaukset. Tämä valinta vaikuttaa siihen mitä kuvaa käytetään oletuksena " +"ajettaessa ”gcl@EXT@”." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Tämä asetus voidaan ohittaa asettamalla GCL_ANSI-ympäristömuuttuja. Jos " +"muuttujan arvo on mikä tahansa ei-tyhjä merkkijono, käytetään ANSI-" +"käännöstä, ja jos muuttujan arvo on tyhjä merkkijono, käytetään CLtL1-" +"käännöstä. Esimerkiksi: GCL_ANSI=t gcl@EXT@. Käytetty pakotettu käännöstapa " +"raportoidaan käynnistysruudussa." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Käytetäänkö profilointia oletuksena?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL tukee valinnaisesti profilointia gprofin avulla." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Katso yksityiskohdat (englanniksi) dokumentaatiosta kohdista si::gprof-start " +"ja si::gprof-quit. Koska tämä käännös on hitaampi kuin käännökset ilman " +"gprof-tukea, tätä ei suositella tuotantokäyttöön." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Aseta GCL_PROF-ympäristömuuttuja tyhjäksi merkkijonoksi käyttääksesi " +"optimoidumpia käännöksiä ja miksi tahansa ei-tyhjäksi merkkijonoksi " +"käyttääksesi profilointia. Esimerkiksi: GCL_PROF=t gcl@EXT@. Jos profilointi " +"on aktivoituna, se raportoidaan käynnistysruudussa." diff --git a/debian/po/fr.po b/debian/po/fr.po new file mode 100644 index 0000000..0a513f4 --- /dev/null +++ b/debian/po/fr.po @@ -0,0 +1,141 @@ +# Translation of gcl debconf templates to French +# Copyright (C) 2007 Sylvain Archenault +# This file is distributed under the same license as the iodine package. +# +# Sylvain Archenault , 2007. +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-1\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-23 13:03+0100\n" +"Last-Translator: Sylvain Archenault \n" +"Language-Team: French \n" +"Language: fr\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Faut-il utiliser la compilation ANSI par dfaut?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL est en passe de fournir une image respectant la norme ANSI en plus de " +"l'image traditionnelle CLtL1, toujours utilise en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Veuillez lire le fichier README.Debian pour une brve description de ces " +"termes. Le choix de cette option dterminera quelle image sera utilise par " +"dfaut en excutant gcl@EXT@." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Ce rglage peut tre chang en affectant la variable d'environnement " +"GCL_ANSI une chane non vide pour la compilation ANSI, et une chane vide " +"pour la compilation CLtL1, par exemple GCL_ANSI=t gcl@EXT@. Le type de " +"compilation sera affich dans le bandeau de dmarrage." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Faut-il utiliser le profilage par dfaut?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL permet optionnellement la gestion du profilage via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Veuillez vous reporter la documentation de si::gprof-start et si::" +"gprof-quit pour plus de dtails. Comme cet excutable est plus lent que " +"les excutables sans la gestion de gprof, il n'est pas recommand de " +"l'utiliser en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Veuillez affecter une chane vide la variable d'environnement GCL_PROF " +"pour des compilations optimises, ou une chane non vide pour avoir la " +"gestion du profilage; par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " +"activ, cela sera affich dans le bandeau de dmarrage." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL a pour but de fournir une image conforme la dfinition de " +#~ "l'ANSI en plus de son image traditionnelle CLtL1 qui est toujours " +#~ "utilise en production. Veuillez consulter le fichier README.Debian " +#~ "pour plus d'informations sur ces normes. Ce choix dterminera quelle " +#~ "norme vous allez utiliser par dfaut lors de l'excution de " +#~ "gcl@EXT@. Vous pouvez localement modifier ce choix en " +#~ "affectant une chane non vide la variable d'environnement GCL_ANSI " +#~ "pour une compilation respectant la norme dfinie par l'ANSI, et une " +#~ "chane vide pour une compilation en accord avec la norme CLtL1, par " +#~ "exemple GCL_ANSI=t gcl@EXT@. Le type de compilation sera affich dans " +#~ "le bandeau de dmarrage." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL gre dsormais le profilage via gprof. Veuillez consulter la " +#~ "documentation de si::gprof-start et de si::gprof-quit pour plus " +#~ "d'informations. La construction produite avec cette option est plus lente " +#~ "que la construction classique. Par consquent il n'est pas recommand " +#~ "de l'utiliser en production. Vous pouvez localement modifier ce choix en " +#~ "affectant la variable d'environnement GCL_PROF, une chane non vide " +#~ "pour activer le profilage, ou une chane vide pour une compilation " +#~ "optimise, par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " +#~ "activ, cela sera affich dans le bandeau de dmarrage." diff --git a/debian/po/gl.po b/debian/po/gl.po new file mode 100644 index 0000000..951ca9f --- /dev/null +++ b/debian/po/gl.po @@ -0,0 +1,138 @@ +# Galician translation of gclcvs's debconf templates +# This file is distributed under the same license as the gclcvs package. +# Jacobo Tarrio , 2007. +# +msgid "" +msgstr "" +"Project-Id-Version: gclcvs\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-01 13:38+0000\n" +"Last-Translator: Jacobo Tarrio \n" +"Language-Team: Galician \n" +"Language: gl\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "¿Empregar por defecto a versión ANSI que se está a facer?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Estase a traballar para que GCL forneza unha imaxe ANSI ademáis da imaxe " +"CLtL1 que aínda se emprega en produción." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Consulte o ficheiro README.Debian para ver unha descrición breve deses " +"termos. Ao establecer esa variable ha determinar a imaxe que ha empregar por " +"defecto ao executar \"gcl@EXT@\"." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Pode empregar a outra imaxe establecendo a variable de ambiente GCL_ANSI a " +"calquera cadea non baleira para empregar a versión ANSI, e á cadea baleira " +"para empregar a versión CLtL1; por exemplo, GCL_ANSI=t gcl@EXT@. Hase " +"informar da versión en uso no cartel que aparece ao iniciar o programa." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "¿Empregar por defecto a versión con cronometrado?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL agora ten soporte opcional de cronometrado mediante gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Consulte a documentación de si::gprof-start e si::gprof-quit para máis " +"detalles. Xa que esta versión é máis lenta que as que non teñen soporte de " +"gprof, non se recomenda que a empregue para o uso en produción." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Pode empregar unha versión distinta á seleccionada establecendo a variable " +"de ambiente GCL_PROF a calquera cadea non baleira para empregar o soporte de " +"cronometrado, ou á cadea baleira para as versións máis optimizadas; por " +"exemplo, GCL_PROF=t gcl@EXT@. Se está activado o cronometrado, hase informar " +"diso no cartel que aparece ao iniciar o programa." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "Estase a traballar para que GCL forneza unha imaxe ANSI ademáis da imaxe " +#~ "CLtL1 que aínda se emprega en produción. Consulte o ficheiro README." +#~ "Debian para ver unha descrición breve deses termos. Ao estabrecer esa " +#~ "variable ha determinar a imaxe que ha empregar por defecto ao executar " +#~ "\"gcl@EXT@\". Pode empregar a outra imaxe estabrecendo a variable de " +#~ "ambiente GCL_ANSI a calquera cadea non baleira para empregar a versión " +#~ "ANSI, e á cadea baleira para empregar a versión CLtL1; por exemplo, " +#~ "GCL_ANSI=t gcl@EXT@. Hase informar da versión en uso no cartel que " +#~ "aparece ao iniciar o programa." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL agora ten soporte opcional de cronometrado mediante gprof. Consulte a " +#~ "documentación de si::gprof-start e si::gprof-quit para máis detalles. Xa " +#~ "que esta versión é máis lenta que as que non teñen soporte de gprof, non " +#~ "se recomenda que a empregue para o uso en produción. Pode empregar unha " +#~ "versión distinta á seleccionada estabrecendo a variable de ambiente " +#~ "GCL_PROF a calquera cadea non baleira para empregar o soporte de " +#~ "cronometrado, ou á cadea baleira para as versións máis optimizadas; por " +#~ "exemplo, GCL_PROF=t gcl@EXT@. Se está activado o cronometrado, hase " +#~ "informar diso no cartel que aparece ao iniciar o programa." diff --git a/debian/po/it.po b/debian/po/it.po new file mode 100644 index 0000000..a488561 --- /dev/null +++ b/debian/po/it.po @@ -0,0 +1,102 @@ +# ITALIAN TRANSLATION OF GCL'S PO-DEBCONF FILE. +# COPYRIGHT (C) 2009 THE GCL'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# +# Vincenzo Campanella , 2009. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2009-11-29 08:39+0100\n" +"Last-Translator: Vincenzo Campanella \n" +"Language-Team: Italian \n" +"Language: it\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" +"Usare in modo predefinito la compilazione ANSI, che è in fase di " +"approntamento?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Accanto all'immagine tradizionale CLtL1, in uso in realtà produttive, GCL " +"sta preparando un'immagine conforme ad ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Per maggiori informazioni consultare il file «README.Debian». La scelta di " +"questa opzione determinerà quale immagine verrà utilizzata in modo " +"predefinito durante l'esecuzione di «gcl@EXT@»." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Questa impostazione può essere sovrascritta impostando la variabile " +"d'ambiente «GCL_ANSI» con una stringa non vuota per la compilazione ANSI e " +"con una stringa vuota per la compilazione CLtL1, per esempio: «GCL_ANSI=t " +"gcl@EXT@». Il tipo di compilazione attualmente in uso viene mostrato nella " +"schermata di avvio." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usare il profiling in modo predefinito?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL possiede un supporto opzionale per il profiling tramite gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Per maggiori dettagli consultare la documentazione per «si::gprof-start» e " +"«si::gprof-quit». Poiché questa compilazione è più lenta, rispetto a quella " +"senza supporto per gprof, non è raccomandata per un utilizzo in realtà " +"produttive." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Per compilazioni ottimizzate impostare la variabile d'ambiente «GCL_PROF» a " +"una stringa vuota, oppure per impostare il supporto al profiling impostarla " +"a una stringa non vuota, per esempio «GCL_PROF=t gcl@EXT@». La schermata " +"d'avvio indicherà se il profiling è abilitato." diff --git a/debian/po/ja.po b/debian/po/ja.po new file mode 100644 index 0000000..169782b --- /dev/null +++ b/debian/po/ja.po @@ -0,0 +1,96 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# victory , 2013. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2013-07-27 14:28+0000\n" +"PO-Revision-Date: 2013-07-27 23:28+0900\n" +"Last-Translator: victory \n" +"Language-Team: Japanese \n" +"Language: ja\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "未完成の ANSI ビルドをデフォルトで使用しますか?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL は未だに生産利用されている従来の CLtL1 イメージに加えて ANSI 準拠のイメー" +"ジを提供する過程にあります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"用語については README.Debian ファイルに簡単な説明があります。このオプションの" +"選択「gcl@EXT@」を実行するときにどのイメージをデフォルトで利用するのか決定する" +"ことになります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"この設定は、GCL_ANSI 環境変数に ANSI ビルドでは空白ではない任意の文字列、" +"CLtL1 ビルドでは空白文字列をセットすることで上書きできます。例えば GCL_ANSI=t " +"gcl@EXT@。現在実行しているビルドの種類は初期の開始時バナーで報告されます。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "デフォルトで profiling ビルドを使いますか?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "" +"GCL にはオプションで gprof 経由の profiling サポートがあります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"詳細については si::gprof-start や si::gprof-quit の文書を見てください。このビ" +"ルドは gprof サポートのないビルドより遅いため、最終的な生産利用にはお勧めしま" +"せん。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"ビルドをもっと最適化する場合は GCL_PROF 環境変数に空白文字列を、profiling をサ" +"ポートさせる場合は空白ではない任意の文字列をセットしてください。例えば GCL_" +"PROF=t gcl@EXT@。profiling が有効な場合、初期の開始時バナーで報告されます。" diff --git a/debian/po/nl.po b/debian/po/nl.po new file mode 100644 index 0000000..c46d99f --- /dev/null +++ b/debian/po/nl.po @@ -0,0 +1,101 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-01 21:15+0100\n" +"Last-Translator: Bart Cornelis \n" +"Language-Team: debian-l10n-dutch \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=utf-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Dutch\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Wilt u standaard de in-ontwikkeling-zijnde ansi-compilatie gebruiken?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL is bezig om, aanvullend op het traditionele CLtL1-compilatie dat nog " +"steeds in gebruik is, een aan ANSI voldoend compilatie te voorzien." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Meer informatie hierover vindt u in het bestand /usr/share/doc/gcl/README." +"Debian . Deze optie bepaalt welk compilatie standaard gebruikt wordt wanneer " +"u 'gcl@EXT@' uitvoert. " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Deze instelling kan altijd overstegen worden door de omgevingsvariabele " +"GCL_ANSI in te stellen op een niet-lege string om de ANSI-compilatie te " +"bekomen, en op een lege string om de CLtL1-compilatie te bekomen (bv. " +"GCL_ANSI=t gcl@EXT@). De momenteel afgedwongen compilatie-soort wordt " +"weergegeven in de initiële opstartbanier." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "" +"Wilt u standaard een compilatie met ondersteuning voor profilering gebruiken?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL heeft optionele ondersteuning voor profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Meer informatie vindt u in de documentatie voor si::gprof-start en si::gprof-" +"quit . Aangezien compilaties met gprof-ondersteuning trager zijn dan deze " +"zonder is dit niet aan te raden voor productie-gebruik." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Om een geoptimaliseerde compilatie te verkrijgen stelt u de " +"omgevingsvariabele GCL_PROF in op een lege string, of op een niet-lege " +"string als u profilering wilt ondersteunen (bv. GCL_PROF=t gcl@EXT@). Als " +"profilering geactiveerd is wordt dit weergegeven in de initiële " +"opstartbanier ." diff --git a/debian/po/pt.po b/debian/po/pt.po new file mode 100644 index 0000000..fb8b56b --- /dev/null +++ b/debian/po/pt.po @@ -0,0 +1,99 @@ +# translation of gcl debconf to Portuguese +# Copyright (C) 2007 Américo Monteiro +# This file is distributed under the same license as the gcl package. +# +# Américo Monteiro , 2007. +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-23 16:44+0000\n" +"Last-Translator: Américo Monteiro \n" +"Language-Team: Portuguese \n" +"Language: pt\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Usar a compilação 'ainda em desenvolvimento' ANSI por prédefinição? " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL está no processo de disponibilizar uma imagem compatível com ANSI como " +"adição à sua imagem tradicional CLtL1 ainda em utilização de produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor veja o ficheiro README.Debian para uma breve descrição destes " +"termos. Escolher esta opção irá determinar qual imagem será usada por " +"prédefinição ao executar 'gcl@EXT@'." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Esta opção pode ser sobreposta ao regular a variável de ambiente GCL_ANSI " +"para qualquer string não-vazia para a compilação ANSI, e para uma string " +"vazia para a compilação CLtL1, como por exemplo GCL_ANSI=t gcl@EXT@. O tipo " +"de compilação actualmente imposto será reportado no banner inicial de " +"arranque." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usar, como pré-definição, a compilação com 'profiling'?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "O GCL tem suporte opcional para 'profiling' via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor veja a documentação de si::gprof-start e si::gprof-quit para mais " +"detalhes. Como esta compilação é mais lenta do que as compilações sem o " +"suporte para gprof, não é recomendada para utilização de produção final." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Regule a variável de ambiente GCL_PROF para uma string vazia para mais " +"compilações optimizadas, ou para qualquer string não-vazia para suporte de " +"'profiling'; como por exemplo GCL_PROF=t gcl@EXT@. Se o 'profiling' estiver " +"activo, isto será reportado no banner inicial de arranque." diff --git a/debian/po/pt_BR.po b/debian/po/pt_BR.po new file mode 100644 index 0000000..74f2f03 --- /dev/null +++ b/debian/po/pt_BR.po @@ -0,0 +1,98 @@ +# Debconf translations for gcl. +# Copyright (C) 2016 THE gcl'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# Adriano Rafael Gomes , 2016. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2016-01-05 11:09-0200\n" +"Last-Translator: Adriano Rafael Gomes \n" +"Language-Team: Brazilian Portuguese \n" +"Language: pt_BR\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Usar a versão ANSI em desenvolvimento por padrão?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"O GCL está em processo de fornecer uma imagem de acordo com o padrão ANSI em " +"adição à sua imagem CLtL1 tradicional, ainda em uso em produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor, veja o arquivo README.Debian para uma breve descrição desses " +"termos. Escolher essa opção determinará qual imagem será usada por padrão ao " +"executar \"gcl@EXT@\"." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Essa configuração pode ser sobreposta definindo a variável de ambiente " +"GCL_ANSI para qualquer texto não vazio para a versão ANSI, e para um texto " +"vazio para a versão CLtL1, por exemplo, GCL_ANSI=t gcl@EXT@. O sabor da " +"versão atualmente definida será exibida na mensagem de inicialização." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usar a versão de \"profiling\" por padrão?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "O GCL tem suporte opcional a \"profiling\" via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor, veja a documentação para si::gprof-start e si::gprof-quit para " +"detalhes. Como essa versão é mais lenta que versões sem suporte a gprof, ela " +"não é recomendada para uso final em produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Defina a variável de ambiente GCL_PROF para um texto vazio para versões mais " +"otimizadas, ou para qualquer texto não vazio para ter suporte a \"profiling" +"\"; por exemplo, GCL_PROF=t gcl@EXT@. Se o \"profiling\" estiver habilitado, " +"isso será exibido na mensagem de inicialização." diff --git a/debian/po/ru.po b/debian/po/ru.po new file mode 100644 index 0000000..dfd56cb --- /dev/null +++ b/debian/po/ru.po @@ -0,0 +1,100 @@ +# translation of ru.po to Russian +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# +# Yuri Kozlov , 2008. +msgid "" +msgstr "" +"Project-Id-Version: 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-03 10:22+0300\n" +"Last-Translator: Yuri Kozlov \n" +"Language-Team: Russian \n" +"Language: ru\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" +"Plural-Forms: nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n%10>=2 && n" +"%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2);\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Использовать разрабатываемую ANSI сборку по умолчанию?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Помимо обычного образа CLtL1, используемого в повсеместной работе, GCL имеет " +"практически готовый образ, соответствующий ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Краткое описание приведено в файле README.Debian. Данным выбором " +"определяется, какой из образов будет использован по умолчанию при выполнении " +"'gcl@EXT@'." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Эта настройка может быть переопределена установкой переменной окружения " +"GCL_ANSI в непустое значение для ANSI сборки, а пустым значением выбирается " +"CLtL1 сборка, например GCL_ANSI=t gcl@EXT@. Текущий используемый тип сборки " +"будет показан при первом запуске." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Использовать по умолчанию профилируемую сборку?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL поддерживает необязательное профилирование через gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Подробней об этом смотрите в документации на si::gprof-start и si::gprof-" +"quit. Так как данная сборка работает медленнее чем без поддержки gprof, её " +"не рекомендуется использовать в реальной работе." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Задание переменной окружения GCL_PROF пустого значения включает более " +"оптимизированную сборку, а любое непустое -- поддержку профилирования; " +"например GCL_PROF=t gcl@EXT@. Если профилирование включено, то об этом будет " +"написано при первом запуске." diff --git a/debian/po/sv.po b/debian/po/sv.po new file mode 100644 index 0000000..9545624 --- /dev/null +++ b/debian/po/sv.po @@ -0,0 +1,106 @@ +# translation of gcl_2.6.7-36.1_sv.po to Swedish +# Translators, if you are not familiar with the PO format, gettext +# documentation is worth reading, especially sections dedicated to +# this format, e.g. by running: +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# Some information specific to po-debconf are available at +# /usr/share/doc/po-debconf/README-trans +# or http://www.debian.org/intl/l10n/po-debconf/README-trans +# Developers do not need to manually edit POT or PO files. +# +# Martin gren , 2008. +msgid "" +msgstr "" +"Project-Id-Version: gcl_2.6.7-36.1_sv\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-07-24 18:21+0200\n" +"Last-Translator: Martin gren \n" +"Language-Team: Swedish \n" +"Language: sv\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-1\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Anvnd det nnu inte frdiga ANSI-bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL arbetar p att tillhandahlla en ANSI-godknd bild frutom dess " +"traditionella CLtL1-bild som fortfarande anvnds i produktionsmiljn." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Se README.Debian-filen fr en versiktlig beskrivning av dessa termer. Nr " +"du vljer det hr alternativet avgrs vilken bild som kommer anvndas som " +"standard nr 'gcl@EXT@' krs." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Denna instllning kan verskridas genom att stta miljvariabeln GCL_ANSI " +"till en icke-tom strng fr ANSI-bygget, och till den tomma strngen fr " +"CLtL1-bygget, t. ex. GCL_ANSI=t gcl@EXT@. Det bygge som fr tillfllet " +"anvnds kommer anges i uppstartsutskriften." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Anvnd profileringsbygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL har valfritt std fr profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Se dokumentationen fr si::gprof-start och si::gprof-quit fr detaljer. " +"Eftersom detta bygge r lngsammare n byggen utan std fr gprof, " +"rekommenderas det inte fr slutlig anvndning i produktionsmilj." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Stt miljvariabeln GCL_PROF till den tomma strngen fr mer optimiserade " +"byggen, eller en icke-tom strng fr profileringsstd; t. ex. GCL_PROF=t " +"gcl@EXT@. Om profilering r aktiverad, kommer denna rapporteras i den " +"ursprungliga uppstartsutskriften." diff --git a/debian/po/templates.pot b/debian/po/templates.pot new file mode 100644 index 0000000..86276ce --- /dev/null +++ b/debian/po/templates.pot @@ -0,0 +1,82 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +#, fuzzy +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" +"Last-Translator: FULL NAME \n" +"Language-Team: LANGUAGE \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=CHARSET\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" diff --git a/debian/po/vi.po b/debian/po/vi.po new file mode 100644 index 0000000..d1fa6de --- /dev/null +++ b/debian/po/vi.po @@ -0,0 +1,98 @@ +# Vietnamese translation for GCL. +# Copyright © 2007 Free Software Foundation, Inc. +# Clytie Siddall , 2007 +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-04 16:27+1030\n" +"Last-Translator: Clytie Siddall \n" +"Language-Team: Vietnamese \n" +"Language: vi\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=1; plural=0;\n" +"X-Generator: LocFactoryEditor 1.7b1\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Dùng bản xây dựng đang phát triển ANSI theo mặc định không?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL đang phát triển chức năng cung cấp ảnh tùy theo ANSI thêm vào ảnh CLtL1 " +"truyền thống vẫn còn được sử dụng trong trường hợp sản xuất." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Xem tài liệu Đọc Đi (README.Debian) để tìm mô tả ngắn về các thuật ngữ này. " +"Bật tùy chọn này thì xác định ảnh nào cần dùng theo mặc định khi thực hiện " +"lệnh « gcl@EXT@ »." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Vẫn còn có thể ghi đè lên thiết lập này bằng cách đặt biến môi trường « " +"GCL_ANSI » thành bắt cứ chuỗi không rỗng cho bản xây dựng ANSI, và cho chuỗi " +"rỗng cho bản xây dựng CLtL1, v.d. « GCL_ANSI=t gcl@EXT@ ». Kiểu bản xây dựng " +"hiện thời được chọn sẽ được thông báo trên băng cờ khởi chạy đầu tiên." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Dùng bản xây dựng đo hiệu năng sử dụng theo mặc định không?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL có hỗ trợ tùy chọn để đo hiệu năng sử dụng thông qua gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Xem tài liệu hướng dẫn về « si::gprof-start » và « si::gprof-quit » để tìm " +"chi tiết. Vì bản xây dựng này chạy chậm hơn các bản xây dựng không hỗ trợ " +"gprof, không khuyên bạn sử dụng nó trong trường hợp sản xuất cuối cùng." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Đặt biến môi trường « GCL_PROF » thành chuỗi rỗng cho các bản xây dựng tối " +"ưu hơn, hoặc cho bất cứ chuỗi không rỗng nào để hỗ trợ chức năng đo hiệu " +"năng sử dụng, v.d. « GCL_PROF=t gcl@EXT@ ». Hiệu lực chức năng đo hiệu năng " +"sử dụng thì nó được thông báo trên băng cờ khởi chạy đầu tiên." diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..67a4307 --- /dev/null +++ b/debian/rules @@ -0,0 +1,281 @@ +#!/usr/bin/make -f +# Sample debian/rules that uses debhelper. +# GNU copyright 1997 by Joey Hess. +# +# This version is for a hypothetical package that builds an +# architecture-dependant package, as well as an architecture-independent +# package. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + +export GCL_MEM_MULTIPLE=0.1 + +# This is the debhelper compatability version to use. +ARCHT:=$(shell dpkg-architecture -qDEB_HOST_ARCH) + +MCC?=gcc-11 +# ifeq ($(ARCHT),alpha) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),mips) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),mipsel) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),ia64) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),armel) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),armhf) +# MCC:=gcc-4.6 +# endif + +#RELOC=locbfd +#RELOC?=statsysbfd +RELOC?=custreloc +ifeq ($(ARCHT),ia64) +RELOC=dlopen +endif +# ifeq ($(ARCHT),ppc64) +# RELOC=dlopen +# endif +#ifeq ($(ARCHT),hppa) +#RELOC=dlopen +#endif + +GMP?= + +DEBUG= + +ARCHCONF?= +ifeq ($(ARCHT),armhf) +ARCHCONF=--enable-cstackmax=0xc0000000 +endif +ifeq ($(ARCHT),armel) +ARCHCONF=--enable-cstackmax=0xc0000000 +endif + + +#ifeq ($(ARCHT),hppa) +#DEBUG=--enable-debug +#endif + +VERS=$(shell echo $$(cat majvers).$$(cat minvers)) +#EXT:=cvs + +CFG:=$(addsuffix /config.,.)# gmp4/configfsf. +# Bug in autoconf dependency on emacsen-common workaround +#CFGS:=$(addsuffix .ori,configure $(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG))) +CFGS:=$(addsuffix .ori,$(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG))) + +$(filter %.guess.ori,$(CFGS)): %.ori: /usr/share/misc/config.guess % + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $* + touch $@ + +$(filter %.sub.ori,$(CFGS)): %.ori: /usr/share/misc/config.sub % + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $* + touch $@ + +configure.ori: %.ori: configure.in + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + cd $(@D) && autoconf + touch $@ + +configure-%-stamp: $(CFGS) + + dh_testdir + + ! [ -e unixport/saved_pre_gcl ] || $(MAKE) clean + +# chmod -R +x gmp4/* + + [ "$*" != "trad" ] || FLAGS="--disable-ansi" ; \ + [ "$*" != "gprof" ] || FLAGS="--disable-ansi --enable-gprof" ; \ + [ "$*" != "ansi-gprof" ] || FLAGS="--enable-gprof" ; \ + eval `dpkg-buildflags --export=sh` && CC=$(MCC) ./configure \ + --host=$$(dpkg-architecture -qDEB_HOST_GNU_TYPE) \ + --disable-statsysbfd \ + --disable-custreloc \ + --disable-dlopen \ + --enable-prelink \ + --enable-$(RELOC) \ + $(GMP) \ + $(DEBUG) \ + $(ARCHCONF) \ + $$FLAGS \ + --prefix=/usr \ + --mandir=\$${prefix}/share/man \ + --enable-infodir=\$${prefix}/share/info \ + --enable-emacsdir=\$${prefix}/share/emacs/site-lisp + + touch $@ + + +build-%-stamp: configure-%-stamp + dh_testdir + + $(MAKE) + + rm -rf debian/$* + mkdir -p debian/$* + $(MAKE) install DESTDIR=$$(pwd)/debian/$* + [ "$(findstring gprof,$*)" = "" ] || (\ + tmp=debian/$*; old=/usr/lib/gcl-$(VERS); new=$$old-prof;\ + if [ "$(findstring ansi,$*)" = "" ] ; then i=saved_gcl ; else i=saved_ansi_gcl ; fi;\ + mv $$tmp/$$old $$tmp/$$new ;\ + echo "(si::reset-sys-paths \"$$new/\")(si::save-system \"debian/tmp-image\")" | $$tmp/$$new/unixport/$$i &&\ + mv debian/tmp-image $$tmp/$$new/unixport/$$i;) + + touch $@ + +bclean-stamp: + $(MAKE) clean + touch $@ + +ansi-tests/test_results: build-ansi-stamp + $(MAKE) $@ + +build: build-arch build-indep +build-arch: build-stamp +build-indep: build-stamp +build-stamp: build-gprof-stamp build-ansi-gprof-stamp build-trad-stamp build-ansi-stamp ansi-tests/test_results + touch $@ + +debian/control.rm: + rm -f `echo $@ | sed 's,\.rm$$,,1'` + +debian/control: debian/control.rm + cp debian/control_$(EXT) debian/control + +clean: debian/control debian/gcl.templates + dh_testdir + dh_testroot + rm -f *stamp + debconf-updatepo + + $(MAKE) clean + + dh_clean + rm -rf debian/gprof debian/ansi-gprof debian/trad debian/ansi $(INS) debian/substvars debian.upstream + rm -rf *stamp + for i in $(CFGS) ; do ! [ -e $$i ] || mv $$i $${i%.ori} ; done + +INS:=$(shell for i in debian/in.* ; do echo $$i | sed 's,in.,,1' ; done |sed "s,gcl,gcl$(EXT),g") + +$(INS): debian/gcl$(EXT)% : debian/in.gcl% + cat $< | sed 's,@EXT@,$(EXT),g' >$@ + +install: install-stamp +install-stamp: build-stamp debian/control $(INS) + dh_testdir + dh_testroot +# dh_clean -k + dh_prep + dh_installdirs + + mkdir -p debian/tmp + cp -a debian/ansi/* debian/tmp/ + cp -a debian/trad/* debian/tmp/ + cp -a debian/gprof/* debian/tmp/ + cp -a debian/ansi-gprof/* debian/tmp/ + + mv debian/tmp/usr/share/emacs/site-lisp debian/tmp/usr/share/emacs/foo + mkdir -p debian/tmp/usr/share/emacs/site-lisp + mv debian/tmp/usr/share/emacs/foo debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT) + + cat debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl.el |\ + sed "s,(provide 'gcl),(provide 'gcl$(EXT)),1" >tmp &&\ + mv tmp debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl$(EXT).el + [ "$(EXT)" = "" ] || rm debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl.el + + cat debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl.el |\ + sed "s,(provide 'dbl),(provide 'dbl$(EXT)),1" >tmp &&\ + mv tmp debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl$(EXT).el + [ "$(EXT)" = "" ] || rm debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl.el + + [ "$(EXT)" = "" ] || \ + for i in debian/tmp/usr/share/info/*.info*; do \ + mv $$i $$(echo $$i | sed "s,gcl,gcl$(EXT),g"); done + + mv debian/tmp/usr/share/doc debian/tmp/usr/share/foo + mkdir -p debian/tmp/usr/share/doc/gcl-doc + mv debian/tmp/usr/share/foo/* debian/tmp/usr/share/doc/gcl-doc + rmdir debian/tmp/usr/share/foo + + [ "$(EXT)" = "" ] || \ + mv debian/tmp/usr/share/doc/gcl-doc debian/tmp/usr/share/doc/gcl$(EXT)-doc + + [ "$(EXT)" = "" ] || \ + (cat debian/tmp/usr/share/man/man1/gcl.1 |sed -e 's, gcl , gcl$(EXT) ,g' 's, GCL , GCL$(EXT) ,g' >debian/foo && \ + mv debian/foo debian/tmp/usr/share/man/man1/gcl$(EXT).1) + + # cat debian/tmp/usr/lib/gcl-$(VERS)/gcl-tk/demos/index.lsp | \ + # sed "s,$$(pwd)/debian/tmp,,1" >debian/foo + # mv debian/foo debian/tmp/usr/lib/gcl-$(VERS)/gcl-tk/demos/index.lsp + + rm -f debian/tmp/usr/bin/*.exe debian/tmp/usr/bin/*.bat + + find debian/tmp -type f -name "*.lsp" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.lisp" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.el" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.tcl" -exec chmod ugo-x {} \; + + rm -f debian/tmp/usr/bin/gcl + TKVERS=$$(cat bin/gcl | grep /tk | head -1l | sed "s,.*/tk\([0-9.]*\)\").*,\1,1"); \ + cat debian/gcl.sh | sed -e "s,@EXT@,$(EXT),g" \ + -e "s,@VERS@,$(VERS),g" \ + -e "s,@TKVERS@,$$TKVERS,g" >debian/tmp/usr/bin/gcl$(EXT) + chmod 0755 debian/tmp/usr/bin/gcl$(EXT) + + rm -rf debian/tmp/usr/lib/gcl-$(VERS)/info + + dh_install + + touch $@ + +# Build architecture-independent files here. +# Pass -i to all debhelper commands in this target to reduce clutter. +binary-indep: build install + dh_testdir -i + dh_testroot -i + dh_installdocs -i + dh_installinfo -i + dh_installchangelogs ChangeLog -i + dh_link -i + dh_compress -i + dh_fixperms -i + dh_installdeb -i + dh_gencontrol -i + dh_md5sums -i + dh_builddeb -i + +binary-arch: build install #debian/substvars + dh_testdir -a + dh_testroot -a + dh_installdocs -a -XRELEASE-2.6.2.html + dh_installemacsen -a + dh_installman -a + dh_installdebconf -a + sed -i -e 's,@EXT@,$(EXT),g' debian/gcl$(EXT)/DEBIAN/templates + dh_installchangelogs ChangeLog -a + dh_strip -a -Xlibgcl -Xlibansi_gcl +# -Xgcl-$(VERS)-prof/unixport/saved_gcl -Xgcl-$(VERS)-prof/unixport/saved_ansi_gcl + dh_lintian -a + dh_link -a + dh_compress -a + dh_fixperms -a + dh_installdeb -a + dh_shlibdeps -a + dh_gencontrol -a -u"-Vgcc=$(MCC)" + dh_md5sums -a + dh_builddeb -a + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure +.PRECIOUS: configure-trad-stamp configure-ansi-stamp configure-gprof-stamp configure-ansi-gprof-stamp diff --git a/debian/source/format b/debian/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/debian/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/debian/source/include-binaries b/debian/source/include-binaries new file mode 100644 index 0000000..091df7a --- /dev/null +++ b/debian/source/include-binaries @@ -0,0 +1,4 @@ +info/gcl.pdf +info/gcl-si.pdf +info/gcl-tk.pdf +xgcl-2/dwdoc.pdf diff --git a/debian/source/lintian-overrides b/debian/source/lintian-overrides new file mode 100644 index 0000000..02ee68d --- /dev/null +++ b/debian/source/lintian-overrides @@ -0,0 +1,11 @@ +gcl source: source-is-missing [info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html] +gcl source: source-is-missing [info/gcl/Defsetf-Lambda-Lists.html] +gcl source: source-is-missing [info/gcl/Destructuring-Lambda-Lists.html] +gcl source: source-is-missing [info/gcl/Generic-Function-Lambda-Lists.html] +gcl source: source-is-missing [info/gcl/Macro-Lambda-Lists.html] +gcl source: source-is-missing [info/gcl/Ordinary-Lambda-Lists.html] +gcl source: source-is-missing [info/gcl/Specialized-Lambda-Lists.html] +gcl source: source-is-missing [info/gcl/The-_0022Compound-Type-Specifier-Arguments_0022-Section-of-a-Dictionary-Entry.html] +gcl source: source-is-missing [info/gcl/The-_0022Compound-Type-Specifier-Syntax_0022-Section-of-a-Dictionary-Entry.html] +gcl source: source-is-missing [info/gcl/defmethod.html] +gcl source: source-is-missing [info/gcl/loop.html] diff --git a/debian/texi.awk b/debian/texi.awk new file mode 100755 index 0000000..ccf9cdb --- /dev/null +++ b/debian/texi.awk @@ -0,0 +1,27 @@ +#!/usr/bin/awk -f + +/^@defun/ { + a=split($0,A,"("); + b=split($0,B,")"); + if (a==b) + print ; + else { + i=1; + c=$0; + } + next; +} +{ + if (i) { + sub("^ *",""); + c=c " " $0; + a=split(c,A,"("); + b=split(c,B,")"); + if (a==b) { + print c; + c=""; + i=0; + } + } else + print; +} diff --git a/debian/upstream/signing-key.asc b/debian/upstream/signing-key.asc new file mode 100644 index 0000000..741d314 --- /dev/null +++ b/debian/upstream/signing-key.asc @@ -0,0 +1,88 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1 + +mQGiBD1mWk0RBADdQYIiaNJJOHAZdBpzOBm31v5AlQa1jjYx1W6zKd+ECqZVdonw +e+CP/qpVCUXRYmQ3v/ZYpINtcRR2IckTQCs4fvYUAuQir2cpKmRqImnGhzFJ1pd9 +Rf2aqPspycMx9IlqKkeY1LwNahitQ93YwyCT1HUCTB0hIuNMtFNte18DpwCgwbYP +bBuLYCG/8g+MqoG7SBhN4hkEANafxrX2EEwUCpQlKGkw4P18wCinbs7tjgXwL7SK +WV9qpIDkUEnW2cnzfDBrNW24LtHt0qMsGa8sCJW30ZPUv0sebsyzVTJR0O5g6Lpi +zlznB1LtmbkDdd79R4Qrs01k+2OK2K0r54xnOlL+ZZQFamP3jvTZAKxyUGI2Fiqu +1O7OA/4xp5/WNyuIUWUho+nfhp0sakzAiC1aBHLtAvhL470sBm3xojM6w3vicTT2 +7rnzS1teeUnCOMK+CUzzITXHrnljCkyg8d6QqtlWJCc4T6tTYJNOuWte3AckYDaF +4HhJbwNamrDGKQJ0kYOqtquz5WE8EjkxwglRQSrGanxMXnCsB7QgQ2FtbSBNYWd1 +aXJlIDxjYW1tQGVuaGFuY2VkLmNvbT6IXwQTEQIAFwUCPWZaTQULBwoDBAMVAwID +FgIBAheAABIJEHMxtcBX8EXcB2VHUEcAAQFCkQCeL84DKju0u23VHI2a9S3CZwpw +cEMAn03Jgjje37YEbLCnfh/JN4zhcUeFiQCVAwUQPXktv1RjAAQhp2rpAQEynwP5 +AZT5Fmlc6FbnVeusUNz1jtEKysdFc7TBFZSdWK2ftjuQiiiYgLOSM6kLpc6DJxLU +0gc6FmQCme1G3wnQFpi5GXFlYcW5mfe3V5/0Paxcc/CijULb4IRU41KO3tTy7wpY +NARRB5I+MeLT39bpqljO0b7PRETncVnXgkm5PEJGV3C0HkNhbW0gTWFndWlyZSA8 +Y2FtbUBkZWJpYW4ub3JnPohgBBMRAgAgBQJJmevSAhsjBgsJCAcDAgQVAggDBBYC +AwECHgECF4AACgkQczG1wFfwRdxZywCeLfMYW3CQAi8e0C8NAauuIpZJx+wAoJAW +eBe0arj/lrwecpn26l63nC5KuQENBD1mWk4QBADRBvXyQ0uxFCkac7ZVSuwEJrbw +NdhS3ossQi+gm8aDPSokKFASs75SLNQMfIRhyToGcyplP75OYaMxvyih7DFGBLoB +kzCuhBJ09VgLC0BiuJAtEI5orQf9sNt7CwBEG2KZ/X4oHXmKitgP0F4xff9XociT +ZusPI90z9yg2treJ4wADBQP/aDZ839IYpwL6ZDZ8faVtgMz65lKaFkLzi/2pHWao +SEWYiGcLozizNt+w+qcyMGUDNkDMtTY0Y9cbC8Dn7r/0/CZW1UQ2D3fSeAfsgxEE +PnYYFiFr0Xyi+oDu7fkcV9wQdqLZ6OvR0SZqoJwLdmJqjTzz1TJTOfdTcSV/+POJ +qCuITgQYEQIABgUCPWZaTgASCRBzMbXAV/BF3AdlR1BHAAEBn/kAn2saGr0hmMfO +Nn4j36onyp18oNqYAKCTJZU26kWZcORo+FbyOMQ3+Yd8EZkBogQ6A9NcEQQAiUvw +61oHv/VZvl8uo5hTAaka2HEfECf5aMvG7N1ytUXzKTldnyEBGiqOdbLtF1wL2SUV +rdhX0VhH0fi19K2graTGqSQYzdA7uIIOQHOAZ5py5mKQr9zFkKyf5W4RKAbTIUAS +uTlSy1NiyKPMXdBlu0f5rkl/m5KODlf1nVtDposAoPuMTY9/D/cOqzB4fmEQ6gMG +M2/PA/9nHj4Mow5EkvSLsuAkn/mpI0Rv+ly1pmKJtbsJZIs1PWk/J47TRVigUgft +LOlfYMAHXwfF6svodOKF0eOaBjeZmyu1KnDDy9EWWhZwdoT08AD664/bbN1goNzE +XFlfD83yPWa1VrPNME2fq6jdY/WKZB5+viKu7yaMGGwQfjg9EwP/QCbz4cZvUiF5 +SmlI3u8+wgThk3DXnL9L3GlOASacET6wRFX6C3HYnRBTB0EypYJoUPIj7rt/Ptyl +CRHQtMUuSouyq/Smj5ybw8kvGRRH4SgfoghjL+q+sVGwIZiUQXu+g96vSSBuQTE2 +x8iZ8mXpPud7jjMc98CfjiB9/ujnqK+0MEVyaWMgU2hhcmtleSA8c2hhcmtleUBz +dXBlcmsucGh5c2ljcy5zdW55c2IuZWR1PohfBBMRAgAXBQI6A9NcBQsHCgMEAxUD +AgMWAgECF4AAEgkQclUlAyIk+rwHZUdQRwABAcGdAJ45RrdVItJxXhDiCWeXpHKq +DfkBIQCg97TpqcIbuDGD1r8gkSb6ErXA+4SJAJUDBRA6L65Bj/xAXv1aZ80BAVlU +A/oD8wBcQeTD3HzeBcK6SVygQZlQS2g8v7H4G91Fu9yTESbDdYLjmybniGwTgS7q +0/RbQDRCmh+fyBD38CmB2B23VdpXRYaChDeKTP+Lvg+mQn9zdMFkERD2/W40+TID +1g7lafk3XDe+dOX59Ie0qeCXcccsv8OfhJwoEwHKPC9ZeIhGBBARAgAGBQI87l/I +AAoJEHIxQb2lt4IBM5MAnj9wqSGdaLTfHAQb7xk36abh0vboAJwIGkIMfE7HkvbX +9nXqefmNfrns3IhGBBARAgAGBQI9eSPnAAoJEHMxtcBX8EXcnq8An2DneOdg2qBr +xF5ZBzEfGBcZHMbCAJ0Z+QKVo1/XQUVcHbGrHo+kF4IfmrQhRXJpYyBTaGFya2V5 +IDxzaGFya2V5QGRlYmlhbi5vcmc+iF8EExECABcFAjo5dzoFCwcKAwQDFQMCAxYC +AQIXgAASCRByVSUDIiT6vAdlR1BHAAEBo0MAoKXjeu7EYrx9uSrlC6rQHavvmq1u +AJsFXSfzM+lgT5lO9a3K0/N+Wr4ZRIhGBBARAgAGBQI87l/fAAoJEHIxQb2lt4IB +8BgAn3ZJz4t/JBnRhEB2I0BA5CiIxKtAAKCf5FHs+3/1vYmhtAX3ouSWyN0jFIhG +BBARAgAGBQI9eSPtAAoJEHMxtcBX8EXci7YAnRnwG8BddR4vdcvNGewRxCxweOrz +AKCgcm8lYWrd0Ubz4/CtelbxA16yV7kBDQQ6A9NrEAQAyXOKw6Zg+VjOiw10ZKtP +mQNmkEA5qUcGgcXKIPwwZ8sMZLzsqzdSM6UVwlN/1D/kH9U5Lkh1LqUxQ+NVC5Qm +bGV+Wq52I9id/lpYycfxNkjURk/wXnOdFCY55pJiS2851DiCBpNC/ClFZZe1Yhdd +HhUFnJrGRjaKTMoKI3sWUDsAAwYEAIuBP5eMx8I4qzVrt9tgDEx9LZZyd18jqC42 +FcMesLMdUi/UKOzrSr/tQ/eiOVMai/RUMmtoyvJzm6bt4UsO54Ynhhul4ySreB4h +4TA7C9vKYTvPmZ5hsOAmguhtvkGOiN+7cXUa35xpL1dbBjelJR8cSFJtAQn2PKkJ +JeS6N4LHiE4EGBECAAYFAjoD02sAEgkQclUlAyIk+rwHZUdQRwABAS1yAJwO6YAP +f1tU5MvrXRbHC52/dn82kgCgkxPi+HiFgqOc1FCfMByu9ZvzwGaZAaIEPKkVqhEE +AMqWl8BYusXdZEt7EE7gDfTtYgCCREiy3B2jTERJ4DXP0hPQDxBOQh6AW0JCtcxT +vuNOZnAlMqXKPvV4tc55dSYTBYW6U2ySN+xrHi9GvS9k5JjpsZdstS5MVkTppOS0 +nTEBw8KofAHBfFpwisCsz38P5ehLnbpm1M7WNXGxmvDTAKDFxuwQL9S8gRUhXIS3 +kAOkDW2eTwP+I5Xil4aIAUnw/JVUaP7wRGUYnFnIisgPftZ+k+R/RfirSlnpPMZr +cqC8JpR0Zm2jQ7jSzTdjj4yFM0PTdUg3mUo5IANd31XshDO7utppX8QBQ9c9PYml +PSVZTRLiDT50HB4rjsoLTlYQOMsFxG4v9v6ybKCvhmZRvD1J97Q5EEsD/3V+Kor5 +8j72RZwrjTspT7roljxyly5D/p6dqiNFLOHjjfuj3SYah7TAlAxtb7CFGsPdNJJf +jZvb//IzZw7XNG1EU9+PaV6mbTZNbrXavbKrIkz6AnLB9GDFE1oDWv7c2b5v5HVv +SO/hakFEDcgxSPzkMVkc7wGOq+6kClG8z2DMtC1CcmlhbiBSIEZ1cnJ5IChUcnVz +dCBObyBPbmUpIDxmYnJpYW5AbmFjLm5ldD6IZQQTEQIAHQUCPKkVqgUJBaOagAUL +BwoDBAMVAwIDFgIBAheAABIJEHIxQb2lt4IBB2VHUEcAAQHvmwCfV6KEnp4tIKHz +dZwBGsqnlKSBkpcAmgNdv300le8RtsGdhsDCRT6cUl1TiEYEEBECAAYFAjzqw3EA +CgkQclUlAyIk+rw0sgCg6jCNQKL71DqAifPm6o07tkkYoc0An3duMoIdm9g2qV2d +OSOpJn63WXKoiEYEEBECAAYFAj15JjIACgkQczG1wFfwRdyRHQCeK2xhxX1ccxDG +DzMYZKivG5uUdBoAnRJ62vbPCyQ1I9ihAf1nzygCdxrytC1CcmlhbiBSIEZ1cnJ5 +IChUcnVzdCBObyBPbmUpIDxiZnVycnlAbmFjLm5ldD6IZQQTEQIAHQUCPUsJiQUJ +BaOagAULBwoDBAMVAwIDFgIBAheAABIJEHIxQb2lt4IBB2VHUEcAAQHzcACfeVya +lc6NRe3Kle9aX9AXxljfdnUAniXqub/sS6WetxJwKrivk3WhyQnEiEYEEBECAAYF +Aj15JjgACgkQczG1wFfwRdxRyACgv7su7KfZvI07M31IcMtS0PHL4L4AoL5wr/os +n198CXGT8C5eXCRBVa8zuQENBDypFbgQBAC3VMeu+Qsa4IlZzzvFeB9sbnIr7e6P +TWuTR3EUnOzEd/h5k/bDdLW11uDnXyhbMSOXzGJaB9HbW5NXUuHIzTEwDzP+/hSJ +HNhc3YXREOs4YMrexeTgKEE3RFJ/ulTJ2EvTVdb7+uwKEMctKC+xaK/cIiRZt8Fg +Da1KjYBnpr5DvwADBQP5AaCubKcP0z202ys6EuvY/xIgYxJ95x/ermkV91cur7e1 +J9NqLOdbgj/yLcco9T92IBMm7zAnzDEtPC7UaqvrtuISvWc+z48Lk19AN7JOOH+g +2oIvspF4Gj2RVc7vijh7gMav5tIflZxqNi2U/QFYqgVTnE0facclV3w2IpMPUpyI +VAQYEQIADAUCPKkVuAUJBaOagAASCRByMUG9pbeCAQdlR1BHAAEB+GUAn0etwV2m +fUKduxyMlCzpoCtLBzy3AJ99bcVPGhgGkpMktMMRlLjPXiLgGA== +=tBlv +-----END PGP PUBLIC KEY BLOCK----- diff --git a/debian/watch b/debian/watch new file mode 100644 index 0000000..4e862f2 --- /dev/null +++ b/debian/watch @@ -0,0 +1,2 @@ +version=4 +options=pasv,pgpsigurlmangle=s/$/.sig/ ftp://ftp.gnu.org/pub/gnu/gcl gcl-([0-9.]*).tar.gz debian uupdate diff --git a/doc/bignum b/doc/bignum new file mode 100644 index 0000000..8a98dc1 --- /dev/null +++ b/doc/bignum @@ -0,0 +1,60 @@ + + +A directory mp was added to hold the new multi precision arithmetic +code. The layout and a fair amount of code in the mp directory is an +enhanced version of gpari version 34. The gpari c code was rewritten +to be more efficient, and gcc assembler macros were added to allow +inlining of operations not possible to do in C. On a 68K machine, +this allows the C version to be as efficient as the very carefully +written assembler in the gpari distribution. For the main machines, +an assembler file (produced by gcc) based on this new method, is +included. This is for sites which do not have gcc, or do not +wish to compile the whole system with gcc. + +Bignum arithmetic is much faster now. Many changes were made to +cmpnew also, to add 'integer' as a new type. It differs from +variables of other types, in that storage is associated to each such +variable, and assignments mean copying the storage. This allows a +function which does a good deal of bignum arithmetic, to do very +little consing in the heap. An example is the computation of PI-INV +in scratchpad, which calculates the inverse of pi to a prescribed +number of bits accuracy. That function is now about 20 times faster, +and no longer causes garbage collection. In versions of AKCL where +HAVE_ALLOCA is defined, the temporary storage growth is on the C +stack, although this often not so critical (for example it makes +virtually no difference in the PI-INV example, since in spite of the +many operations, only one storage allocation takes place. + +Below is the actual code for PI-INV + +On a sun3/280 (cli.com) + +Here is the comparison of lucid and akcl before and after +on that pi-inv. Times are in seconds with multiples of the +akcl time in parentheses. + +On a sun3/280 (cli.com) + +pi-inv akcl-566 franz lucid old kcl/akcl +---------------------------------------- +10000 3.3 9.2(2.8 X) 15.3 (4.6X) 92.7 (29.5 X) +20000 12.7 31.0(2.4 X) 62.2 (4.9X) 580.0 (45.5 X) + + +(defun pi-inv (bits &aux (m 0)) + (declare (integer bits m)) + (let* ((n (+ bits (integer-length bits) 11)) + (tt (truncate (ash 1 n) 882)) + (d (* 4 882 882)) + (s 0)) + (declare (integer s d tt n)) + (do ((i 2 (+ i 2)) + (j 1123 (+ j 21460))) + ((zerop tt) (cons s (- (+ n 2)))) + (declare (integer i j)) + (setq s (+ s (* j tt)) + m (- (* (- i 1) (- (* 2 i) 1) (- (* 2 i) 3))) + tt (truncate (* m tt) (* d (the integer (expt i 3)))))))) + + + diff --git a/doc/c-gc b/doc/c-gc new file mode 100644 index 0000000..1b980dc --- /dev/null +++ b/doc/c-gc @@ -0,0 +1,39 @@ + +We have implemented garbage collection of the c stack. +Thus any new cons or other data type, may be safely left +on the c stack or in a register, without fear of lossage +due to garbage collection. This enables us to write smaller +faster code. We have implemented a scheme for putting +frequently used variables, and those inside loops, into registers. +For example the compiled sloop.lsp file now has text size +48704, but had text size 53120 or 1.09 times larger. + +If functions are proclaimed to be of fixed number of args, +the code is also substantially better. For example if you +have the code: + +(proclaim '(function memb (t t) t)) +(defun memb (a b) + (sloop for v on b when (eq (car v) a) do (return v))) + + + +If we consider calls where a is the 4'th element of b, +then memb runs two times faster than before: On a sun 3-50 +19.6 seconds for 1,000,000 iterations, as opposed to 39.6 seconds +without the new modifications to c-gc and the compiler. + + +(defun try (n a b) (sloop for i below n do (memb a b))) + +Currently if the variable compiler::*c-gc* is not nil, +the compiler outputs code under the assumption that c-gc is working. +Very bad results would occur if such object code were loaded into a +kcl which did not examine the c stack. Also if you are wishing +to produce C code for use in an implementation without c-gc +you should set *c-gc* to nil. + + + + + diff --git a/doc/c-gc.doc b/doc/c-gc.doc new file mode 100644 index 0000000..7872d9a --- /dev/null +++ b/doc/c-gc.doc @@ -0,0 +1,32 @@ + +We have implemented garbage collection of the c stack. +Thus any new cons or other data type, may be safely left +on the c stack or in a register, without fear of lossage +due to garbage collection. This enables us to write smaller +faster code. We have implemented a scheme for putting +frequently used variables, and those inside loops, into registers. +For example the compiled sloop.lsp file now has text size +48704, but had text size 53120 or 1.09 times larger. + +If functions are proclaimed to be of fixed number of args, +the code is also substantially better. For example if you +have the code: + +(proclaim '(function memb (t t) t)) +(defun memb (a b) + (sloop for v on b when (eq (car v) a) do (return v))) + + + +If we consider calls where a is the 4'th element of b, +then memb runs two times faster than before: On a sun 3-50 +19.6 seconds for 1,000,000 iterations, as opposed to 39.6 seconds +without the new modifications to c-gc and the compiler. + + +(defun try (n a b) (sloop for i below n do (memb a b))) + +Currently if the variable compiler::*c-gc* is not nil, +the compiler outputs code under the assumption that c-gc is working. + + diff --git a/doc/compile-file-handling-of-top-level-forms b/doc/compile-file-handling-of-top-level-forms new file mode 100644 index 0000000..7609dc6 --- /dev/null +++ b/doc/compile-file-handling-of-top-level-forms @@ -0,0 +1,222 @@ +Forum: Compiler +Issue: COMPILE-FILE-HANDLING-OF-TOP-LEVEL-FORMS +References: CLtL pages 66-70, 143 +Category: CLARIFICATION +Edit history: V1, 07 Oct 1987 Sandra Loosemore + V2, 15 Oct 1987 Sandra Loosemore + V3, 15 Jan 1988 Sandra Loosemore + V4, 06 May 1988 Sandra Loosemore + V5, 20 May 1988 Sandra Loosemore + V6, 09 Jun 1988 Sandra Loosemore + V7, 16 Dec 1988 Sandra Loosemore + (Comments from Pitman, change DEFCONSTANT, etc.) + V8, 31 Dec 1988 Sandra Loosemore + (CLOS additions, etc.) + V9, 23 Jan 1989 Sandra Loosemore + (remove the CLOS additions again) +Status: Proposal CLARIFY passed Jan 89 + + +Problem Description: + +Standard programming practices assume that, when calls to defining +macros such as DEFMACRO and DEFVAR are processed by COMPILE-FILE, +certain side-effects occur that affect how subsequent forms in the +file are compiled. However, these side-effects are not mentioned in +CLtL, except for a passing mention that macro definitions must be +``seen'' by the compiler before it can compile calls to those macros +correctly. In order to write portable programs, users must know +exactly which defining macros have compile-time side-effects and what +those side-effects are. + +Inter-file compilation dependencies are distinct from, and not +addressed by, this issue. + + +Proposal: COMPILE-FILE-HANDLING-OF-TOP-LEVEL-FORMS:CLARIFY + +(1) Clarify that defining macros such as DEFMACRO or DEFVAR, appearing + within a file being processed by COMPILE-FILE, normally have + compile-time side effects which affect how subsequent forms in the + same file are compiled. A convenient model for explaining how these + side effects happen is that the defining macro expands into one or + more EVAL-WHEN forms, and that the calls which cause the compile-time + side effects to happen appear in the body of an (EVAL-WHEN (COMPILE) + ...) form. + +(2) The affected defining macros and their specific side effects are + as follows. In each case, it is identified what users must do to + ensure that their programs are conforming, and what compilers must do + in order to correctly process a conforming program. + + DEFTYPE: Users must ensure that the body of a DEFTYPE form is + evaluable at compile time if the type is referenced in subsequent type + declarations. The compiler must ensure that the DEFTYPE'd type + specifier is recognized in subsequent type declarations. If the + expansion of a type specifier is not defined fully at compile time + (perhaps because it expands into an unknown type specifier or a + SATISFIES of a named function that isn't defined in the compile-time + environment), an implementation may ignore any references to this type + in declarations and/or signal a warning. + + DEFMACRO, DEFINE-MODIFY-MACRO: The compiler must store macro + definitions at compile time, so that occurrences of the macro later on + in the file can be expanded correctly. Users must ensure that the + body of the macro is evaluable at compile time if it is referenced + within the file being compiled. + + DEFUN: DEFUN is not required to perform any compile-time side effects. + In particular, DEFUN does not make the function definition available + at compile time. An implementation may choose to store information + about the function for the purposes of compile-time error-checking + (such as checking the number of arguments on calls), or to enable the + function to be expanded inline. + + DEFVAR, DEFPARAMETER: The compiler must recognize that the variables + named by these forms have been proclaimed special. However, it must + not evaluate the initial value form or SETQ the variable at compile + time. + + DEFCONSTANT: The compiler must recognize that the symbol names a + constant. An implementation may choose to evaluate the value-form at + compile time, load time, or both. Therefore users must ensure that + the value-form is evaluable at compile time (regardless of whether or + not references to the constant appear in the file) and that it always + evaluates to the same value. + + DEFSETF, DEFINE-SETF-METHOD: The compiler must make SETF methods + available so that it may be used to expand calls to SETF later on in + the file. Users must ensure that the body of DEFINE-SETF-METHOD and + the complex form of DEFSETF are evaluable at compile time if the + corresponding place is referred to in a subsequent SETF in the same + file. The compiler must make these SETF methods available to + compile-time calls to GET-SETF-METHOD when its environment argument is + a value received as the &ENVIRONMENT parameter of a macro. + + DEFSTRUCT: The compiler must make the structure type name recognized + as a valid type name in subsequent declarations (as for DEFTYPE) and + make the structure slot accessors known to SETF. In addition, the + compiler must save enough information about the structure type so that + further DEFSTRUCT definitions can :INCLUDE a structure type defined + earlier in the file being compiled. The functions which DEFSTRUCT + generates are not defined in the compile time environment, although + the compiler may save enough information about the functions to code + subsequent calls inline. The #S reader syntax may or may not be + available at compile time. + + DEFINE-CONDITION: The rules are essentially the same as those for + DEFSTRUCT; the compiler must make the condition type recognizable as a + valid type name, and it must be possible to reference the condition + type as the parent-type of another condition type in a subsequent + DEFINE-CONDITION in the file being compiled. + + DEFPACKAGE: All of the actions normally performed by this macro at load + time must also be performed at compile time. + + +(3) The compile-time side effects may cause information about the + definition to be stored differently than if the defining macro had + been processed in the "normal" way (either interpretively or by loading + the compiled file). + + In particular, the information stored by the defining macros at + compile time may or may not be available to the interpreter (either + during or after compilation), or during subsequent calls to COMPILE or + COMPILE-FILE. For example, the following code is nonportable because + it assumes that the compiler stores the macro definition of FOO where + it is available to the interpreter: + + (defmacro foo (x) `(car ,x)) + (eval-when (eval compile load) + (print (foo '(a b c)))) + + A portable way to do the same thing would be to include the macro + definition inside the EVAL-WHEN: + + (eval-when (eval compile load) + (defmacro foo (x) `(car ,x)) + (print (foo '(a b c)))) + + + +Rationale: + +The proposal generally reflects standard programming practices. The +primary purpose of the proposal is to make an explicit statement that +CL supports the behavior that most programmers expect and many +implementations already provide. + +The primary point of controversy on this issue has been the treatment +of the initial value form by DEFCONSTANT, where there is considerable +variance between implementations. The effect of the current wording is +to legitimize all of the variants. + + +Current Practice: + +Many (probably most) Common Lisp implementations, including VaxLisp +and Lucid Lisp, are already largely in conformance. + +In VaxLisp, macro definitions that occur as a side effect of compiling +a DEFMACRO form are available to the compiler (even on subsequent +calls to COMPILE or COMPILE-FILE), but are not available to the +interpreter (even within the file being compiled). + +By default, Kyoto Common Lisp evaluates *all* top level forms as they +are compiled, which is clearly in violation of the behavior specified +on p 69-70 of CLtL. There is a flag to disable the compile-time +evaluation, but then macros such as DEFMACRO, DEFVAR, etc. do not make +their definitions available at compile-time either. + + +Cost to implementors: + +The intent of the proposal is specifically not to require the compiler +to have special knowledge about each of these macros. In +implementations whose compilers do not treat these macros as special +forms, it should be fairly straightforward to use EVAL-WHENs in their +expansions to obtain the desired compile-time side effects. + + +Cost to users: + +Since CLtL does not specify whether and what compile-time side-effects +happen, any user code which relies on them is, strictly speaking, +nonportable. In practice, however, most programmers already expect +most of the behavior described in this proposal and will not find it +to be an incompatible change. + + +Benefits: + +Adoption of the proposal will provide more definite guidelines on how +to write programs that will compile correctly under all CL +implementations. + + +Discussion: + +Reaction to a preliminary version of this proposal on the common-lisp +mailing list was overwhelmingly positive. More than one person +responded with comments to the effect of "but doesn't CLtL already +*say* that somewhere?!?" Others have since expressed a more lukewarm +approval. + +It has been suggested that this proposal should also include PROCLAIM. +However, since PROCLAIM is not a macro, its compile-time side effects +cannot be handled using the EVAL-WHEN mechanism. A separate proposal +seems more appropriate. + +Item (3) allows for significant deviations between implementations. +While there is some sentiment to the effect that the compiler should +store definitions in a manner identical to that of the interpreter, +other people believe strongly that compiler side-effects should be +completely invisible to the interpreter. The author is of the opinion +that since this is a controversial issue, further attempts to restrict +this behavior should be considered as separate proposals. + +It should be noted that user-written code-analysis programs must +generally treat these defining macros as special forms and perform +similar "compile-time" actions in order to correctly process +conforming programs. + diff --git a/doc/contributors b/doc/contributors new file mode 100644 index 0000000..ce5c067 --- /dev/null +++ b/doc/contributors @@ -0,0 +1,41 @@ + +sgi port was done by Eric Raible raible@orville.nas.nasa.gov + +thanks to Blewett (blewett@cinnamon.att.com) for +help in the initial stage of the sun4 port. + +Thanks to gabor@vuse.vanderbilt.edu for a good deal of work on the hp port. + +Thanks to riley@att.com for several suggestions, fixes and bug reports. + +Thanks to andrew@COMP.VUW.AC.NZ for several suggestions and help with hp bsd. + +Thanks to Doug Katzman for parts of the Iris 4D port. + +Thanks to pierson@encore.com for an encore port [which I unfortunately +did not integrate yet]. + +Thanks for Mike Sundt at washington, for updates on the vax port. + +Thanks to Richard Harris harrisr@turing.cs.rpi.edu for many bug +reports and fixes, as well as error handling code (available from him), +and for work on pcl. + +Thanks to BABECOOL for the gpari code. + +gene@corwin.CCS.Northeastern.EDU (gene cooperman) several bugs and bug fixes. + +Thanks to luke tierney luke@umnstat.stat.umn.edu for a bug fix. + +tomwe@comm.mot.com (Thomas Weigert) for the mac2 port to aux. + +Thanks to Noritake Yonezawa for NeXT port (yone@vcdew25.lsi.tmg.nec.CO.JP) + +Thanks to Rami Charif rcharif@math.utexas.edu for much of the work on the dos port + +Thanks to Bob Boyer boyer@cs.utexas.edu for innumerable suggestions and encouragement + +Thanks to Matteo Frigo who did work on an early linux port. + +Thanks to Bill Metzenthen for linux elf work (billm@jacobi.maths.monash.edu.au) + diff --git a/doc/debug b/doc/debug new file mode 100644 index 0000000..3ce0acb --- /dev/null +++ b/doc/debug @@ -0,0 +1,28 @@ +New Debugging Features: + +Search-stack: +(:s "cal") or (:s 'cal) searches the stack for a frame whose function or +special form has a name containing "cal", moves there to display the local +data. + +Break-locals: +:bl displays the args and locals of the current function. +(:bl 4) does this for 4 functions. + +(si:loc i) accesses the local(i): slot. +the *print-level* and *print-depth* are bound to si::*debug-print-level* + +Recall that kcl permits movement to previous frame (:p) and next frame (:n). +These also take numeric args eg. (:p 7) moves up 7 frames. + +If functions are interpreted, the arg values are displayed together +with their names. If the functions are using the C stack (ie proclaimed +functions), very little information is available. + + +Note you must have space < 3 in your optimize proclamation, in order for +the local variable names to be saved by the compiler. + +To Do: add setf method for si:loc. +add restart capability from various spots on the stack. + diff --git a/doc/enhancements b/doc/enhancements new file mode 100644 index 0000000..fa9036e --- /dev/null +++ b/doc/enhancements @@ -0,0 +1,146 @@ + + +@chapter Loading Object Code + +We will outline some of the features of the object loader, by William +Schelter. + +When you do @code{(load "foo.o")} the output from the C compiler, +must be loaded into static space in the running KCL, and references +to external symbols must be resolved. Originally KCL used the +loader from the underlying lisp system, calling it in a subshell, +to produce yet another file, which had the correct references +to externals. This was then read into kcl. The data vector (a lisp +readable vector at the end of the object file) was also read into KCL. + +Unfortunately some operating systems (such as System V) do not supply +a loader capable of doing this relocation, and in any event it is fairly +slow. Also there was no possiblity of incrementally adding new external +C symbols to an already running lisp, and then having future files refer +to them. For example you might have a function @code{search1} written +in C, which you wished to access directly in subsequently loaded files. +This was not possible since the loader only knew about the addresses +of the external symbols in the original saved image. + +The new scheme builds a list of the external symbols into a table +called @code{c_table}. This table is built by examining the current image. +It will be built automatically with the first call to load. Subsequent +calls just use this table. Of course there is the additional benefit, +that it is easy to add additional symbols to the table. + +For example if you have a file @file{try.c} which looks like + +@code@{init_code() +add_symbols(joe,&joe,pete,&pete,NULL); +@} + +joe(x) +object x +@{...@} + +pete() +@{...@} +} + +then joe and pete will be added to the symbol table of the current kcl. +You may refer to them as external variables in subsequent files, and +these files will load correctly, referencing these variables. It is an error +apply add_symbol twice, to the same variable. + +The loading of files has speeded up considerably, so that a small file +with only a few small functions in it, can be loaded in less than .05 seconds. + + +@chapter Metering and Profiling + +KCL utilities have been added, by W. Schelter, to allow one to +determine the percentage of time spent in individual functions. + +Usage involves deciding which block of code one wishes to profile, +that is to say what address range, and then allocating an appropriate +size @code{*profile-array*}. For example in the Sun version, if you +have loaded a few object files, then if you wish to meter all of kcl +and the files which you loaded you could allocate a 1 megabyte array. +This would give a roughly 2 to one reduction relative to the code +address range. Note that the loader prints out the address at which +code is loaded. There is also a function @code{si@:function-start +(fun)} which returns the start address of a compiled function. + +In the above example after loading the file lsp/profile.o you +could do +@code{(si:set-up-profile 1000000)} + +This allocates the 1 megabyte array, and also reads in the c symbol +table, if this has not already been done. It also gets the addresses +of all compiled function objects currently in the image, and keeps +them in a table. This table is called @code{combined_table} at the C +level. The function @code{si:set-up-combined (size-of-table)} sets up +a combined table for the lisp and C functions. This function is +called by the previous @code{si:set-up-profile} function, with a +default size-of-table of 6000. + +Now to turn profiling on you do @code{(si::prof 0 90)}. This will +start metering all addresses in the range of 0 (the first arg) to +1,000,000 * (256/90), where 90 is the second arg. To display the data +collected so far you can invoke @code{si::display-profile} with no +arguments. In order to clear the profile array you run +@code{(si::clear)}. A call of @(si::prof 500000 256) would +profile the code in the address range of 500,000 to 1,500,000. +You may switch the profiler off by specifying a 0 mapping, +ie @code{si::prof 0 0)}. It can then be restarted by supplying +a nonzero second argument. Of course if you start up again +with a scale different from the previous one, +without clearing the profile array, you will have gibberish. + +The argument list to the last call of @{si::prof} is stored in the +variable @code{si::*current-profile*}. + +Unless one is using a one to one mapping of the profile array +to the code, there is a possibility of quantization errors. +There is also the possibility of overflowing a slot in the profile +array, if the mapping is very coarse, or if the interval being measured +is very long. + +@code{ + 0.08% ( 9): _eql + 15.26% ( 1822): _equal + 0.01% ( 1): _Fquote + 0.01% ( 1): SET + 0.04% ( 5): _parse_key + 0.01% ( 1): _Fcond +... + 0.50% ( 60): RELIEVE-HYPS1 + 0.03% ( 4): REMAINDER + 0.01% ( 1): REMOVE-*2*IFS + 0.03% ( 3): REMOVE-TRIVIAL-EQUATIONS + 4.35% ( 520): REWRITE + 0.47% ( 56): REWRITE-CAR-V&C-APPLY$ +...} + +is a sample of the output. The first column represents percentage of +total time spent with the program counter in the range starting at +this function, up to the next named function. The second column is the +actual number of times that a profile interrupt landed in this section +of the code. Note the default display is by address, and as mentioned +before, one should beware of overlaps, in a coarse mapping. Functions +for which there were no ticks, are not displayed. + +Note we did not sort the output, since we wished to leave it in address +order. It is possible (because of roundoff if the second arg to prof +is small) that some calls could be credited to the adjacent function. +This could be spotted more easily if the order is by address. +It is trivial to sort the table by ticks in gnu emacs using the command +sort-columns. Have the point set at the beginning of column, in the first line +and the mark at the end of the column in the last line. + +Unfortunately the System V loader likes to separate the original C +functions of KCL, from those incrementally loaded, by about 2 megabytes. +This makes it awkward to meter both ranges simultaneously without using +a very large profile array. It is probably reasonable to rewrite the +basic interrupt call, to handle such an address configuration. This +has not yet been done. Of course you can always make two runs, and combine +the information for the two ranges. + + + + diff --git a/doc/fast-link b/doc/fast-link new file mode 100644 index 0000000..42cf627 --- /dev/null +++ b/doc/fast-link @@ -0,0 +1,158 @@ + Description of Fast Link option for KCL + +Author: Bill Schelter + +When we refer to times of function calls, without other qualification, +we will be referring to the simplest possible function of no args +returning nil: (defun foo () nil). This provides a good general indication +of the timing of all functions. + +The original KCL function calling system, distinguishes between +functions defined in the same file, proclaimed functions, as well as +having different calling mechanisms for different safety levels. + +Some disadvantages were that calling across files always took at least +50mu, in spite of proclamations or safety. Function calls inside a file +either were fast (10 mu (or 3mu for proclaimed)) at safety 0 but incapable +of being traced or redefined, or else as slow as cross file compilation. + +We wished to have a scheme which would allow tracing and redefinition, +of all calls, as well very fast calling. + +In order to do this we set up links in the calls, and these are modified +at the first call to the function, if the function is compiled. Recompiling +tracing, or redefining, undoes the link. +(use-fast-links t) turns this feature on, and it is on by default. +An argument of nil turns it off, so that all calls go through the function +symbol. + + +Some timings on the fast link compiling provided in this version of kcl. + +FILEA: +(proclaim '(optimize (safety 0))) + +(proclaim '(function blue() t)) +(proclaim '(function blue1 (t) t)) +(proclaim '(function blue2 (t t) t)) +(proclaim '(function blue-same-file() t)) + +(defun test-blue (n) + (sloop for i below n do (blue))) + +(defun test-blue1 (n) + (sloop for i below n do (blue1 nil))) + +(defun test-blue2 (n) + (sloop for i below n do (blue2 nil nil))) + +(defun test-blue-same-file (n) + (sloop for i below n do (blue-same-file))) + +FILEB: + +(defun blue () nil) +(defun blue1 (x)x nil) +(defun blue2 (x y) x y Compile and load FILEA then FILEB. + +Timings: We timed the invocation of blue,blue1, and blue2 +by executing the loops in fileA. We subtracted the time for +one empty loop iteration (2.7mu). + + +Call New Old + +(blue) 3.03 60.5 +(blue1 x) 4.1 62.2 +(blue2 x y) 5.1 64.3 +(blue-same-file) 3.03 2.73 + +As can be seen all calls of blue are substantially speeded up, except +for the calls in the same file, which are slightly slowed down. There +is however the advantage, that the calls in the same file can now be +traced or redefined. Also it is conceivable that the program might +want to change a definition dynamically. It is no longer necessary to +recompile the whole file. They are handled in exactly the same manner +as the non local calls. + +Since most software projects consist of more than one file, and +since it is customary to move key routines to a basic files at +the beginning of the system, we feel the importance of having fast +calls across files is important. For example in MAXIMA, there are +380 calls to ptimes, with naturally the large majority being in files +other than the basic definition. It is useful if the other calls +can be made faster too. Also when debugging some chunk of MAXIMA +code, it is useful to be able to trace ptimes, without having to load +in new definitions and recompile. + +Disadvantages: The link table data takes up approximately 10 words, +independent of the number of calls in a file to that function. + + + +Space: +I made a file with + + +(defun try (a b) a b + (foos a b)(foos a b)(foos a b)(foos a b)(foos a b) + (foos a b)(foos a b)(foos a b)(foos a b)(foos a b) + (foos a b)(foos a b)(foos a b)(foos a b)(foos a b) + (foos a b)(foos a b)(foos a b)(foos a b)(foos a b) + (foos a b)(foos a b)(foos a b)(foos a b)(foos a b) + ) +I compared the size with various settings of *fast-link-compile* +and with proclaiming foos. +DIFF means the size above the case with all calls to FOOS removed. + +text data bss dec DIFF FLC proclaimed Case SAMEFILE +1076 0 28 1104 836 nil nil I nil +1308 0 32 1340 892 nil nil Ia t +1296 4 28 1328 1060 t nil II nil +1436 4 32 1472 1056 t nil IIa t +684 4 28 716 448 t t III nil +244 0 24 268 0 t ; calls removed. IV nil +384 0 32 416 0 nil ;cals removed V t + + + +The reason II is bigger than I is that the vs_top and vs_base settings +are being performed in the file, in exactly the same manner as if the +definition for foos were in the file. FLC=nil with definition of foos +in the same file would also be higher. Should probably have a type +of proclamation which would favor the case I call in cases where speed +is irrelevant. But then why not go with III.. + + +Appendix: +Notes: +1)Empty loop takes 2.70 seconds for 1,000,000 iterations. +2)blue-same-file or blue + +>(time (test-blue 1000000)) +real time : 5.750 secs +run time : 5.733 secs +NIL + +>(trace blue) +(BLUE) + +>(test-blue 2) + 1> (BLUE) + <1 (BLUE NIL) + 1> (BLUE) + <1 (BLUE NIL) +NIL + +>(trace blue-same-file) +(BLUE-SAME-FILE) + +>(test-blue-same-file 2) + 1> (BLUE-SAME-FILE) + <1 (BLUE-SAME-FILE NIL) + 1> (BLUE-SAME-FILE) + <1 (BLUE-SAME-FILE NIL) +NIL + + + diff --git a/doc/format b/doc/format new file mode 100644 index 0000000..c7b528f --- /dev/null +++ b/doc/format @@ -0,0 +1,44 @@ + +We have added a user extensible feature to the common lisp +function format. + +For some applications, for example in maxima, it is very desirable +to be able to define a new control character, so that + +(format t "~%The polynomial ~m is not zero" polynomial) + +would work. It is desirable to extend format itself, since then +calls to the error and other functions which use format will work +correctly. For example: + +(error "~%The polynomial ~m is not zero" polynomial) + + +For an application to do this we would evaluate the following: + +(setf (get 'si::*indent-formatted-output* (char-code #\m)) 'maxima-print) + +(defun maxima-print (item stream colon atsign &rest l) + colon atsign l ;ignoring these + (internal-maxima-print item stream)) + +Note this extension is case sensitive, so that to have this apply to +capital M as well, the property for (char-code #\M) must be added as +well. + +A call with "~:m" would make colon=1 and atsign=0. +A call with "~@m" would make colon=0 and atsign=1. + +To Do: +The &rest l is currently unused, a future addition will probably +store into l the current column of the format output stream. + +This also implies that new print functions should return what they think is +the new column. Since I believe that 98% of the current calls to format +do not use column information in an important way, this is probably not worth +the additional hair involved. + +Numeric args are not passed. + + + \ No newline at end of file diff --git a/doc/funcall-comp b/doc/funcall-comp new file mode 100644 index 0000000..2841af1 --- /dev/null +++ b/doc/funcall-comp @@ -0,0 +1,35 @@ + +In AKCL version 1.78 I observe the following times + +(defun joe () nil) +(setq cfun #'joe) +(setq symbol 'joe) +after compilation (on a sun3/280) + +Form AKCL 1.78 KCL +(joe) 6.1 7.7 +(funcall cfun) 9.5 14.0 +(funcall symbol) 13.7 17.8 +(joe1) 2.1 2.5 + +times are in microseconds per call. +joe1 is the same as joe but with (proclaim '(function joe1 () t)) +The functions were in the same file, although this would not make +a difference for AKCL. + +A typical timing loop is +(defun foo1 (x n) (sloop for i below n do (funcall x))) +(defun foo2 ( n) (sloop for i below n do (joe))) +(defun foo3 ( n) (sloop for i below n do (joe1))) + +(time (foo1 #'joe 100000)) +(time (foo1 'joe 100000)) +(time (foo2 100000)) + +Note: An AKCL version >= 1.78 will be released in a few days +when I finish checking over the 8 and 16 bit arrays which have been +added. + + + + diff --git a/doc/funcall.lsp b/doc/funcall.lsp new file mode 100644 index 0000000..32ebbe9 --- /dev/null +++ b/doc/funcall.lsp @@ -0,0 +1,81 @@ + +I have been trying to improve funcall so that functions of a fixed +number of args can be funcalled with almost the same speed as +they can be called if the name is laid down in the file. Basically +I have made functions with a fixed number of args, first class +compiled-function objects, and removed the si::cdefn property stuff. +It is no longer necessary to have a global version of the function, +since one can now use the C stack version anywhere. I have made +compiled function objects slightly smaller, but with more information. +So the number of args and there types is encoded in these C functions. +It will soon be possible to do fast cross file calling of functions +with mixed fixnum and general args and one return value. + +After these changes: + +A comparison of calling a fixed arg function of 1 argument: +(the second time for KCL is for when the function is in a separate file). + + LUCID AKCL KCL +funcall 8.3 3.54 18.8 (funcall x nil) where x = #'foo +Direct call 7.44 2.78 3.16(23.4) (foo nil) + +(proclaim '(function foo (t) t)) +(defun line1 (x n) (sloop for i below n with y do (setq y (funcall x nil)))) +(defun line2 (n) (sloop for i below n with y do (setq y (foo nil)))) +(defun foo (x) x nil) + +It is able to detect that only one value from the funcall is desired, +because of the setq. In general the following macro can be used to inform +the compiler of this. + +(defmacro vfuncall (x &rest args) + `(the (values t) (funcall ,x ,@ args))) + +We can not lay down the new funcall code if multiple values might be desired: +(defun joe (x) (funcall x nil)) +will have its number of values returned depend on x. + +(defun joe (x) (the (values t) (funcall x nil))) +or +(defun joe (x) (setq x (funcall x nil))) + +would allow it however. + +Unfortunately GCL is much slower if the function to be funcalled does +not happen to be a compiled function which was compiled while +proclaimed with a fixed number of args and one value. Still there are +a number of critical applications where it is useful to have a very +fast funcall. I have no useful heuristic at the moment for 'guessing' +which kind of funcall I should lay down: One optimized for C stack or +one optimized for Lisp stack. I can only detect when it is safe to +lay down a C stack one. However if the function in question uses the +lisp stack, and is called via the C stack, the call will be twice as +slow as it used to be. This is very unfortunate! At the cost of +space I could avoid this, but the new funcall takes up less space than +the old one and I hate to lay down two types in the code just in +case.... The check as to type is being laid down, but a trick is +used to keep space different minimal. + +SPACE: + +I have also noted some size differences (as reported by size *.o) +where the amounts are the 'dec' = decimal representation of +text+data+bss in the object file. This is what gets loaded. +There is still room for improvement here. Most of the difference +is due to the fact that functions of fixed args only need one +entry now. + + +Before: After: +31340 basis.o 28348 +76584 code-1-a.o 63212 +94136 code-b-d.o 79136 +93372 code-e-m.o 75384 +125172 code-n-r.o 10524 +77148 code-s-z.o 61840 +15620 events.o 14504 +4036 genfact.o 3464 +27908 io.o 24544 +9132 ppr.o 8340 +42668 sloop.o 40484 diff --git a/doc/makefile b/doc/makefile new file mode 100644 index 0000000..980ebc3 --- /dev/null +++ b/doc/makefile @@ -0,0 +1,9 @@ +# a facility for displaying DOC files and completing on them +# requires gnu emacs, to be in the search path + +# A directory on peoples search path. + + +ELISP=gcl.el dbl.el ansi-doc.el lisp-complete.el sshell.el + +-include ../makedefs diff --git a/doc/multiple-values b/doc/multiple-values new file mode 100644 index 0000000..ef2e0fb --- /dev/null +++ b/doc/multiple-values @@ -0,0 +1,94 @@ + +Proclaimed functions of a fixed number of args are much more +efficient. It is still possible to pass multiple values +efficiently (but not quite with the CL semantics) + +Here are two examples, one using ordinary multiple-value-setq +and the other our-multiple-value-setq. +For 1,000,000 calls: + +Type : CL 2 values our 2 values 1 value +Time : 7.9 sec 3.5 2.35 +name : foo-mv foo-our-mv foo +Uses : multiple-value-setq our-multiple-value-setq Only 1 value passed. + +(defun foo-mv (n) + (let (x y) + (sloop for i below n + do (multiple-value-setq(x y) (goo-mv))))) + +(defun goo-mv () (values 1 2)) + + +And then an equivalent one: +(proclaim '(function foo-our-mv (t) t)) +(proclaim '(function goo-our-mv () t)) +(defun foo-our-mv (n) + (let (x y) + (sloop for i below n + do (our-multiple-value-setq (x y) (goo-our-mv))) + (list x y))) + +(defun goo-our-mv () (our-values 1 2)) + +The times: +>(time (foo-our-mv 1000000)) +real time : 3.617 secs +run time : 3.583 secs +(1 2) +>(time (foo-mv 1000000)) +real time : 8.033 secs +run time : 7.800 secs +(1 2) + +Here are the our-mv macros: + +(use-package "SLOOP") + + +(defmacro our-values (a &rest l) + (or (< (length l) (length *vals*)) (error "too many values")) + `(prog1 ,a ,@ (sloop for v in l + for u in *vals* + collect `(setq ,u ,v)))) + +(defmacro our-multiple-value-setq ((x &rest l) form) + (or (< (length l) (length *vals*)) (error "too many values")) + `(prog1 (setq ,x ,form) + ,@ (sloop for w in *vals* + for v in l + collect `(setq ,v ,w)))) + +(defvar *vals* + '(*val1* *val2* *val3* *val4* *val5* *val6* *val7* *val8* *val9* *val10*)) + + +(defvar *val1* nil) +(defvar *val2* nil) +(defvar *val3* nil) +(defvar *val4* nil) +(defvar *val5* nil) +(defvar *val6* nil) +(defvar *val7* nil) +(defvar *val8* nil) +(defvar *val9* nil) +(defvar *val10* nil) + +;; Note that this method does not penalize ordinary calls at all. +;; It is not the same as the common lisp multiple values in general: +;; 1) The information on how many values are being passed is not +;; recorded [ unless of course that number is one of the values ! ] +;; 2) If you ask for more values than were specified you will get +;; a random value. Common lisp values would say you get nil. +;; Now it is true that it would be possible to make AKCL pass multiple +;; values more efficiently, but this is really a large overhaul of the +;; system. There are lots of system functions, hand coded using the +;; old scheme. I have been thinking about ways to do this for the +;; last little while, but have not settled on anything. + +Bill + + + + + diff --git a/doc/profile b/doc/profile new file mode 100644 index 0000000..5dae63e --- /dev/null +++ b/doc/profile @@ -0,0 +1,45 @@ + +We have added a facility for determining the proportional amount of +time spent executing compiled lisp defined functions, as well as +internal c defined functions. + +This system works under Unix BSD or System V. + +To use this code load the file lsp/profile.o. + +SET-UP-PROFILE &optional (array-size 100000)(max-funs 6000) + + +must be called to allocate space for storing the profile information +as it is collected, and also to build a list of the functions from +the symbol table of the executable (defaults to "saved_kcl"). + +Once this has been done a call to + +PROF (start scale) + +START will correspond to the beginning of the profile array, and +the SCALE will mean that 256 bytes of code correspond to SCALE bytes in the +profile array. + +Thus if the profile array is 1,000,000 bytes long and the code segment is +5 megabytes long you can profile the whole thing using a scale of 50 +Note that long runs may result in overflow, and so an understating of the +time in a function. + +With a scale of 128 a sample loop overflowed some slots at 6,000,000 +times through the loop. + +There is very little slowdown in execution during profiling. No special +compilation is necessary. + +To display the result do + +(si::display-profile) + +To turn off profiling use (si::prof 0 0). + +(si::clear-profile) +clears the profile array for a new run. + + diff --git a/dos/dostimes.c b/dos/dostimes.c new file mode 100755 index 0000000..31ee839 --- /dev/null +++ b/dos/dostimes.c @@ -0,0 +1,19 @@ +#include +#include + +#ifdef __ZTC__ +#define HZ 100 +#endif + +times(x) +struct tms *x; +{ int hz; +struct rusage ru; +getrusage(RUSAGE_SELF,&ru); +hz = ru.ru_utime.tv_sec * HZ + + (ru.ru_utime.tv_usec *HZ)/1000000; +x->tms_utime = hz; +x->tms_stime = hz; +return 0; +} + diff --git a/dos/dum_dos.c b/dos/dum_dos.c new file mode 100755 index 0000000..8826f64 --- /dev/null +++ b/dos/dum_dos.c @@ -0,0 +1,9 @@ +#define DUM(a) int a(int n) { printf("dummy " #a " call %d\n",n); return 0;} +DUM(profil) +/* DUM(alarm) */ +DUM(getpid) +DUM(getuid) +DUM(popen) +DUM(pclose) +DUM(getpwuid) +DUM(getpwnam) diff --git a/dos/makefile b/dos/makefile new file mode 100644 index 0000000..4c9fb79 --- /dev/null +++ b/dos/makefile @@ -0,0 +1,27 @@ +.SUFFIXES: .o .c + +HDIR = ../h + +OFLAG = -O +ODIR = . + +-include ../makedefs + +DOS_ODIR=. + +CFLAGS = -I. -I$(HDIR) $(ODIR_DEBUG) + +.s.o: + $(CC) -c $(OFLAG) $(CFLAGS) $*.c + +.c.o: + $(CC) -c $(OFLAG) $(CFLAGS) $*.c + +OBJS = $(EXX_DOS) + +all: $(OBJS) + +clean: + rm -f $(OBJS) + + diff --git a/dos/read.s b/dos/read.s new file mode 100755 index 0000000..533a033 --- /dev/null +++ b/dos/read.s @@ -0,0 +1,41 @@ +/* This is file READ.S */ +/* +** Copyright (C) 1991 DJ Delorie, 24 Kirsten Ave, Rochester NH 03867-2954 +** +** This file is distributed under the terms listed in the document +** "copying.dj", available from DJ Delorie at the address above. +** A copy of "copying.dj" should accompany this file; if not, a copy +** should be available from where this file was obtained. This file +** may not be distributed without a verbatim copy of "copying.dj". +** +** This file is distributed WITHOUT ANY WARRANTY; without even the implied +** warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +*/ + + .text + .globl _read +_read: + pushl %eax + movl $0,%eax + cmp 8(%esp),%eax /* Is it stdin */ + jne NotStdin + cmp _interrupt_flag,%eax /* Any SIGINT Interrupt pending ? */ + je NoInterrupt + call _sigalrm +NoInterrupt: +NotStdin: + popl %eax + + pushl %ebx + pushl %esi + pushl %edi + movl 16(%esp),%ebx + movl 20(%esp),%edx + movl 24(%esp),%ecx + movb $0x3f,%ah + int $0x21 + popl %edi + popl %esi + popl %ebx + jb syscall_error + ret diff --git a/dos/readme b/dos/readme new file mode 100755 index 0000000..6221eac --- /dev/null +++ b/dos/readme @@ -0,0 +1,7 @@ + +This is the remnants of the port of akcl to dos under djgpp (version 1.06) +Unfortunately djgpp has changed and so it is not so straightforward to +make gcl work .. I would be happy if someone else does it! + +Bill Schelter + diff --git a/dos/sigman.s b/dos/sigman.s new file mode 100755 index 0000000..b5755e8 --- /dev/null +++ b/dos/sigman.s @@ -0,0 +1,49 @@ + + .globl _SignalManager +_SignalManager: + pushl %ebp + movl %esp,%ebp + /*------------------------------------------------------------------- + ** Save all registers + **-----------------------------------------------------------------*/ + pushl %eax + pushl %ebx + pushl %ecx + pushl %edx + pushl %esi + pushl %edi + pushf + pushl %es + pushl %ds +/* pushl %ss*/ + pushl %fs + pushl %gs + /*-----------------------------------------------------------------*/ + + movl 4(%ebp), %eax + shl $2, %eax + movl _SignalTable(%eax), %ebx + call %ebx + + /*------------------------------------------------------------------- + ** Restore registers + **-----------------------------------------------------------------*/ + popl %gs + popl %fs +/* popl %ss*/ + popl %ds + popl %es + popf + popl %edi + popl %esi + popl %edx + popl %ecx + popl %ebx + popl %eax + /*------------------------------------------------------------------*/ + + popl %ebp + add $4, %esp + + ret /* resume program */ + diff --git a/dos/signal.c b/dos/signal.c new file mode 100755 index 0000000..b3855eb --- /dev/null +++ b/dos/signal.c @@ -0,0 +1,109 @@ +/* This is file signal.c +** +** Copyright (C) 1992 Rami EL CHARIF and William SCHELTER +** rcharif@ma.utexas.edu wfs@cs.utexas.edu +** +** Signal package for djgpp versions 1.05, 1.06 +** version 0.0 alpha 03/30/1992 +** +** Send your comments or bugs report to +** rcharif@ma.utexas.edu or wfs@cs.utexas.edu +** +** This file is distributed WITHOUT ANY WARRANTY; without even the implied +** warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +*/ + +#include +#include +#include + +unsigned long SignalTable[_NSIG + 1] = { + (unsigned long)SIG_DFL, /* SIGHUP */ + (unsigned long)SIG_DFL, /* SIGINT +*/ + (unsigned long)SIG_DFL, /* SIGQUIT */ + (unsigned long)SIG_DFL, /* SIGILL */ + (unsigned long)SIG_DFL, /* SIGABRT */ + (unsigned long)SIG_DFL, /* SIGTRAP */ + (unsigned long)SIG_DFL, /* SIGIOT */ + (unsigned long)SIG_DFL, /* SIGEMT */ + (unsigned long)SIG_DFL, /* SIGFPE */ + (unsigned long)SIG_DFL, /* SIGKILL */ + (unsigned long)SIG_DFL, /* SIGBUS */ + (unsigned long)SIG_DFL, /* SIGSEGV +*/ + (unsigned long)SIG_DFL, /* SIGSYS */ + (unsigned long)SIG_DFL, /* SIGPIPE */ + (unsigned long)SIG_DFL, /* SIGALRM */ + (unsigned long)SIG_DFL, /* SIGTERM */ + (unsigned long)SIG_DFL, /* SIGURG */ + (unsigned long)SIG_DFL, /* SIGSTOP */ + (unsigned long)SIG_DFL, /* SIGTSTP */ + (unsigned long)SIG_DFL, /* SIGCONT */ + (unsigned long)SIG_DFL, /* SIGCHLD */ + (unsigned long)SIG_DFL, /* SIGCLD */ + (unsigned long)SIG_DFL, /* SIGTTIN */ + (unsigned long)SIG_DFL, /* SIGTTOU */ + (unsigned long)SIG_DFL, /* SIGIO */ + (unsigned long)SIG_DFL, /* SIGPOLL */ + (unsigned long)SIG_DFL, /* SIGXCPU */ + (unsigned long)SIG_DFL, /* SIGXFSZ */ + (unsigned long)SIG_DFL, /* SIGVTALRM */ + (unsigned long)SIG_DFL, /* SIGPROF */ + (unsigned long)SIG_DFL, /* SIGWINCH */ + (unsigned long)SIG_DFL, /* SIGUSR1 */ + (unsigned long)SIG_DFL /* SIGUSR2 */ + }; + +SignalHandler signal(int sig, SignalHandler action) +{ + extern void SignalManager(); + union REGS in, out; + SignalHandler hsigOld; + + in.h.ah = 1; + in.h.al = sig; + SignalTable[sig] = in.x.dx = (long)action; + in.x.cx = (long)SignalManager; + int86(0xfa, &in, &out); + hsigOld = (SignalHandler)out.x.dx; + return hsigOld; +} + +void SigInst() +{ + union REGS in, out; + extern void SignalManager(); + + in.h.ah = 0; + in.h.al = 0; + in.x.dx = (long)SignalManager; + +#ifdef DEBUG_SIG + printf("\nSignal Manager = %ld, %lx", in.x.dx, in.x.dx); +#endif + + int86(0xfa, &in, &out); + +} + +#ifndef NO_SIG_ALARM +unsigned int alarm(int culSeconds) +{ + + union REGS in, out; + + if (!culSeconds) { + in.h.ah = 3; /* Reset alarm */ + int86(0xfa, &in, &out); + } + else { + in.h.ah = 2; + in.x.dx = culSeconds; + int86(0xfa, &in, &out); + } + return in.x.cx; +} +#else +unsigned int alarm(int n) +{ return 0; } +#endif + diff --git a/dos/signal.h b/dos/signal.h new file mode 100755 index 0000000..87e252e --- /dev/null +++ b/dos/signal.h @@ -0,0 +1,137 @@ +/* This is file signal.h */ +/* This file may have been modified by DJ Delorie (Jan 1991). If so, +** these modifications are Coyright (C) 1991 DJ Delorie, 24 Kirsten Ave, +** Rochester NH, 03867-2954, USA. +*/ + +/* This may look like C code, but it is really -*- C++ -*- */ +/* +Copyright (C) 1989 Free Software Foundation + written by Doug Lea (dl@rocky.oswego.edu) + +This file is part of GNU CC. + +GNU CC is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY. No author or distributor +accepts responsibility to anyone for the consequences of using it +or for whether it serves any particular purpose or works at all, +unless he says so in writing. Refer to the GNU CC General Public +License for full details. + +Everyone is granted permission to copy, modify and redistribute +GNU CC, but only under the conditions described in the +GNU CC General Public License. A copy of this license is +supposed to have been given to you along with GNU CC so you +can know your rights and responsibilities. It should be in a +file named COPYING. Among other things, the copyright notice +and this notice must be preserved on all copies. +*/ + +#ifndef _signal_h +#pragma once + + +#ifdef __cplusplus +extern "C" { +#endif + +/* This #define KERNEL hack gets around bad function prototypes on most */ +/* systems. If not, you need to do some real work... */ +/******************* +* #define KERNEL +* #include +* #undef KERNEL +********************/ + +#ifndef _signal_h +#define _signal_h 1 +#endif + +/* The Interviews folks call this SignalHandler. Might as well conform. */ +/* Beware: some systems think that SignalHandler returns int. */ +typedef void (*SignalHandler) (); + +extern SignalHandler signal(int sig, SignalHandler action); +extern SignalHandler sigset(int sig, SignalHandler action); +extern SignalHandler ssignal(int sig, SignalHandler action); +extern int gsignal (int sig); +extern int kill (int pid, int sig); + +#ifndef hpux /* Interviews folks claim that hpux doesn't like these */ +struct sigvec; +extern int sigsetmask(int mask); +extern int sigblock(int mask); +extern int sigpause(int mask); +extern int sigvec(int sig, struct sigvec* v, struct sigvec* prev); +#endif + +/* The Interviews version also has these ... */ + +#define SignalBad ((SignalHandler)-1) +#define SignalDefault ((SignalHandler)0) +#define SignalIgnore ((SignalHandler)1) + +#ifdef __cplusplus +} +#endif +#define _SIGNAL_H +/** #include **/ +#ifdef _SIGNAL_H + +/* This file defines the fake signal functions and signal + number constants for 4.2 or 4.3 BSD-derived Unix system. */ + +#define SIG_DFL 0 +#if 0 +/*#ifndef SIG_DFL*/ +/* Fake signal functions. + These lines MUST be split! m4 will not change them otherwise. */ +#define SIG_ERR /* Error return. */ \ + ((void EXFUN((*), (int sig))) -1) +#define SIG_DFL /* Default action. */ \ + ((void EXFUN((*), (int sig))) 0) +#define SIG_IGN /* Ignore signal. */ \ + ((void EXFUN((*), (int sig))) 1) + +#endif +/* Signals. */ +#define SIGHUP 1 /* Hangup (POSIX). */ +#define SIGINT 2 /* Interrupt (ANSI). */ +#define SIGQUIT 3 /* Quit (POSIX). */ +#define SIGILL 4 /* Illegal instruction (ANSI). */ +#define SIGABRT SIGIOT /* Abort (ANSI). */ +#define SIGTRAP 5 /* Trace trap (POSIX). */ +#define SIGIOT 6 /* IOT trap (4.2 BSD). */ +#define SIGEMT 7 /* EMT trap (4.2 BSD). */ +#define SIGFPE 8 /* Floating-point exception (ANSI). */ +#define SIGKILL 9 /* Kill, unblockable (POSIX). */ +#define SIGBUS 10 /* Bus error (4.2 BSD). */ +#define SIGSEGV 11 /* Segmentation violation (ANSI). */ +#define SIGSYS 12 /* Bad argument to system call (4.2 BSD)*/ +#define SIGPIPE 13 /* Broken pipe (POSIX). */ +#define SIGALRM 14 /* Alarm clock (POSIX). */ +#define SIGTERM 15 /* Termination (ANSI). */ +#define SIGURG 16 /* Urgent condition on socket (4.2 BSD).*/ +#define SIGSTOP 17 /* Stop, unblockable (POSIX). */ +#define SIGTSTP 18 /* Keyboard stop (POSIX). */ +#define SIGCONT 19 /* Continue (POSIX). */ +#define SIGCHLD 20 /* Child status has changed (POSIX). */ +#define SIGCLD SIGCHLD /* Same as SIGCHLD (System V). */ +#define SIGTTIN 21 /* Background read from tty (POSIX). */ +#define SIGTTOU 22 /* Background write to tty (POSIX). */ +#define SIGIO 23 /* I/O now possible (4.2 BSD). */ +#define SIGPOLL SIGIO /* Same as SIGIO? (SVID). */ +#define SIGXCPU 24 /* CPU limit exceeded (4.2 BSD). */ +#define SIGXFSZ 25 /* File size limit exceeded (4.2 BSD). */ +#define SIGVTALRM 26 /* Virtual alarm clock (4.2 BSD). */ +#define SIGPROF 27 /* Profiling alarm clock (4.2 BSD). */ +#define SIGWINCH 28 /* Window size change (4.3 BSD, Sun). */ +#define SIGUSR1 30 /* User-defined signal 1 (POSIX). */ +#define SIGUSR2 31 /* User-defined signal 2 (POSIX). */ + +#endif /* included. */ + +#define _NSIG 32 /* Biggest signal number + 1. */ + +#endif + diff --git a/elisp/add-default.el b/elisp/add-default.el new file mode 100644 index 0000000..f4742ba --- /dev/null +++ b/elisp/add-default.el @@ -0,0 +1,4 @@ + +;;;BEGIN gcl addition +(autoload 'dbl "dbl" "Make a debugger to run lisp, maxima and or gdb in" t) +;;;END gcl addition diff --git a/elisp/ansi-doc.el b/elisp/ansi-doc.el new file mode 100755 index 0000000..2db99ec --- /dev/null +++ b/elisp/ansi-doc.el @@ -0,0 +1,92 @@ +;; Copyright William F. Schelter. 1994 +;; Licensed by GNU public license. + +;; This file contains function find-ansi-doc which finds documentation in the +;; standard common lisp ansi documentation (1350 pages!), and puts it on +;; the screen at the correct page using xdvi. If there is more than one +;; reference it successively finds them. You need dpANS2/*.dvi +;; dpANS2/index.idx from parcftp.xerox.com (13.1.64.94) You also need +;; xdvi. You may gzip the .dvi files and it will unzip them into tmp +;; as needed. + + +(defvar ansi-doc-dir "/usr/local/doc/dpANS2") +(defvar ansi-doc-alist nil) + +(defun create-index-el-from-index-idx () + (interactive) + (let (tem) + (cond ((not ansi-doc-alist) + (setq tem (concat ansi-doc-dir "/index.el")) + (or (file-exists-p tem) + (progn + (shell-command + (concat "echo '(setq ansi-doc-alist (quote (( ' > " tem)) + (shell-command + (concat "cat " ansi-doc-dir "/index.idx " + "| sed " + " -e 's/\\!9\\([A-Z]\\):\\([^\\!]*\\)\\!\\!/)(\"\\2\" \\1/g' " + " -e 's:{$\\\\spLT \\$}:<:g' " + " -e 's:{$\\\\spGT $}:>:g' " + " -e 's:\\\\&:\\&:g' " + " -e 's:\\([0-9]\\),:\\1:g'" + " -e 's:\\([A0-9][0-9]*\\)--\\([0-9][0-9]*\\):(\\1 . \\2):g'" + " | sort -r " + " >> " tem)) + (shell-command (concat "echo '))))' >> " tem)))) + + )))) +(defun maybe-gzip-to-tmp (file &optional dir) + "If file exists with .gz added to it, then unzip it to /tmp and +return that file otherwise return file" + (let (tmp-file) + (cond ((file-exists-p (concat file ".gz")) + (setq tmp-file + (file-name-nondirectory file)) + (or (file-exists-p tmp-file) + (progn (message "gzipping %s in /tmp for future use" file) + (shell-command (concat "gzip -dc < " file ".gz > " + tmp-file )))) + tmp-file) + (t file)))) + +(defun find-ansi-doc () + "Find the documentation in the ansi draft on a particular function +or topic. If there are several pieces of documentation then go through +them successively. Requires copying the " + (interactive ) + (let (x tem name lis first chap tmp-chap) + (or ansi-doc-alist + (progn + (create-index-el-from-index-idx ) + (load (concat ansi-doc-dir "/index.el")))) + (setq name (completing-read "Doc on: " ansi-doc-alist nil t)) + (progn (setq ans nil) (setq lis ansi-doc-alist) + (while lis + (cond ((equal (car (car lis)) name) + (setq ans (append ans (cdr (cdr (car lis))))))) + (setq lis (cdr lis))) + ) + (setq tem ans) + (if (cdr tem) (setq first "First") (setq first "")) + (while tem + (setq x (car tem)) + (setq chap (concat ansi-doc-dir + (downcase (format "/chap-%s.dvi" (car x))))) + (setq chap (maybe-gzip-to-tmp chap)) + (message "%s Doc in Chapter %s page %s) %s .." first (car x) (cdr x)) + (if (cdr tem) (setq first "Next") (setq next "Final")) + (shell-command (concat "xdvi -expert -xoffset .2 -yoffset -.2 " + " -paper 7.2x8.5 " + " -display " + (or x-display-name ":0") + " -geometry -2-2 +" (+ (cdr x) 2)" " + chap + )) + (setq tem (cdr tem)) + + ) + ) + (message nil) + + ) diff --git a/elisp/dbl.el b/elisp/dbl.el new file mode 100755 index 0000000..9d91a57 --- /dev/null +++ b/elisp/dbl.el @@ -0,0 +1,685 @@ +;; Run gcl,maxima,gdb etc under Emacs all possibly all in one buffer. +;; +;; This file is part of GNU Emacs. +;; Copyright (C) 1998 William F. Schelter + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY. No author or distributor accepts responsibility +;; to anyone for the consequences of using it or for whether it serves +;; any particular purpose or works at all, unless he says so in writing. +;; Refer to the GNU Emacs General Public License for full details. + +;; Everyone is granted permission to copy, modify and redistribute GNU +;; Emacs, but only under the conditions described in the GNU Emacs +;; General Public License. A copy of this license is supposed to have +;; been given to you along with GNU Emacs so you can know your rights and +;; responsibilities. It should be in a file named COPYING. Among other +;; things, the copyright notice and this notice must be preserved on all +;; copies. + +;; Description of DBL interface: + +;; A facility is provided for the simultaneous display of the source code +;; in one window, while using dbl to step through a function in the +;; other. A small arrow in the source window, indicates the current +;; line. + +;; Starting up: + +;; In order to use this facility, invoke the command DBL to obtain a +;; shell window with the appropriate command bindings. You will be asked +;; for the name of a file to run. Dbl will be invoked on this file, in a +;; window named *dbl-foo* if the file is foo. + +;; M-s steps by one line, and redisplays the source file and line. + +;; You may easily create additional commands and bindings to interact +;; with the display. For example to put the dbl command next on \M-n +;; (def-dbl :next "\M-n") + +;; This causes the emacs command dbl-next to be defined, and runs +;; dbl-display-frame after the command. + +;; dbl-display-frame is the basic display function. It tries to display +;; in the other window, the file and line corresponding to the current +;; position in the dbl window. For example after a dbl-step, it would +;; display the line corresponding to the position for the last step. Or +;; if you have done a backtrace in the dbl buffer, and move the cursor +;; into one of the frames, it would display the position corresponding to +;; that frame. + +;; dbl-display-frame is invoked automatically when a filename-and-line-number +;; appears in the output. + + +(require 'sshell) +(require 'smart-complete) +(define-key sshell-mode-map "\ep" 'smart-complete) +(define-key sshell-mode-map "\M-p" 'smart-complete) +(require 'gcl) +(autoload 'maxima-mode "maxima-mode" "Major mode for editing maxima code and interacting with debugger" t) +(autoload 'gcl-mode "gcl" "Major mode for editing maxima code and interacting with debugger" t) +(or (rassoc 'maxima-mode auto-mode-alist) +(setq auto-mode-alist (cons '("\\.ma?[cx]\\'" . maxima-mode) auto-mode-alist)) +) +(or (rassoc 'gcl-mode auto-mode-alist) +(setq auto-mode-alist (cons '("\\.li?sp\\'" . gcl-mode) auto-mode-alist)) +) + +(defvar dbl-prompt-pattern + "\\(^\\|\n\\)[^ >]*[>$)%#:][>]*[ ]*" + ; "(^|\n)\\[^ >]*[>$)%#:][>]*[ ]*+" + "A regexp to recognize the prompt for dbl or dbl+.") +; + +(defvar downcase-filenames-for-dbl + (string-match "nt[45]" system-configuration) + "Force the case to be lower when sending a break command" + ) + +(defvar dbl-subshell-switches + (list "bash" (if (string-match "nt[45]" system-configuration) '("--noediting" "-i") '("-i")) + ) + "Alternating list of regexp for the shell name, and list of switches to pass" + ) + +(defvar dbl-filter-accumulator nil) +(defvar dbl-mode-map nil + "Keymap for dbl-mode.") + +(if dbl-mode-map + nil + (setq dbl-mode-map (copy-keymap sshell-mode-map)) + (define-key dbl-mode-map "\C-cl" 'dbl-find-and-display-line) + ) + +(define-key ctl-x-map " " 'dbl-break) +;(define-key ctl-x-map "&" 'send-dbl-command) + +;;Of course you may use `def-dbl' with any other dbl command, including +;;user defined ones. + +(defmacro def-dbl (name key &optional doc) + (let* ((fun (intern (format "dbl-%s" (read name)))) + ) + (list 'progn + (list 'defun fun '(arg) + (or doc "") + '(interactive "p") + (list 'dbl-call name 'arg)) + (list 'define-key 'dbl-mode-map key (list 'quote fun))))) + +(def-dbl ":step %p" "\M-s" "Step one source line with display") +(def-dbl ":step %p" "\C-c\C-s" "Step one source line with display") +(def-dbl ":stepi %p" "\C-c\t" "Step one instruction with display") +(def-dbl ":next %p" "\M-n" "Step one source line (skip functions)") +(def-dbl ":next %p" "\C-c\C-n" "Step one source line (skip functions)") +(def-dbl ":r" "\M-c" "Continue with display") + +(def-dbl ":finish" "\C-c\C-f" "Finish executing current function") +(def-dbl ":up %p" "\C-cu" "Go up N stack frames (numeric arg) with display") +(def-dbl ":down %p" "\C-cd" "Go down N stack frames (numeric arg) with display") + + +(defun dbl-mode () + "Major mode for interacting with an inferior Lisp or Maxima process. +It is like an ordinary shell, except that it understands certain special +redisplay commands sent by the process, such as redisplay a source file +in the other window, positioning a little arrow `==>', at a certain +line, typically the line where you are stopped in the debugger. + +It uses completion based on the form of your current prompt, allowing +you to keep separate the commands you type at the debugger level and +the lisp or maxima level. + +The source files should be viewed using gcl mode for lisp, and maxima-mode +for maxima. + + +\\{dbl-mode-map} + +\\[dbl-display-frame] displays in the other window +the last line referred to in the dbl buffer. + +\\[dbl-:step] and \\[dbl-:next] in the dbl window, +call dbl to step and next and then update the other window +with the current file and position. +o +If you are in a source file, you may select a point to break +at, by doing \\[dbl-break]. + +Commands: +Many commands are inherited from shell mode. +Additionally we have: + +\\[dbl-display-frame] display frames file in other window +\\[dbl-:step] advance one line in program +\\[dbl-:next] advance one line in program (skip over calls). +\\[send-dbl-command] used for special printing of an arg at the current point. +C-x SPACE sets break point at current line. + +You may also enter keyword break commands. + +:a show-break-variables +:b simple-backtrace +:bds break-bds +:bl break-locals +:blocks break-blocks +:break insert a break point here +:bs break-backward-search-stack +:bt dbl-backtrace +:c break-current +:delete (lambda (&rest l) (iterate-over-bkpts l delete) (values)) +:disable [n1 .. nk] disable break points. [see :info :bkpt] +:down [n] move n frames down +:enable [n1 n2 ..nk] enable break points +:env describe-environment +:fr [n] show this frame +:fs break-forward-search-stack +:functions break-functions +:go break-go +:h break-help +:help break-help +:ihs ihs-backtrace +:info :bkpt show break points. +:loc loc +:m break-message +:n break-next +:next step-next +:p break-previous +:q break-quit +:r resume +:resume (lambda () resume) +:s search-stack +:step step-into +:t throw-macsyma-top +:up move up one frame +:vs break-vs + +" + (interactive) + (kill-all-local-variables) + (setq major-mode 'dbl-mode) + (setq mode-name "Inferior Dbl") + (setq mode-line-process '(": %s")) + (use-local-map dbl-mode-map) + (make-local-variable 'last-input-start) + (setq last-input-start (make-marker)) + (make-local-variable 'last-input-end) + (setq last-input-end (make-marker)) + (make-local-variable 'dbl-last-frame) + (setq dbl-last-frame nil) + (make-local-variable 'dbl-last-frame-displayed-p) + (setq dbl-last-frame-displayed-p t) + (make-local-variable 'dbl-delete-prompt-marker) + (setq dbl-delete-prompt-marker nil) + (make-local-variable 'dbl-filter-accumulator) + (setq dbl-filter-accumulator nil) + (make-local-variable 'shell-prompt-pattern) + (setq shell-prompt-pattern dbl-prompt-pattern) + (run-hooks 'sshell-mode-hook 'dbl-mode-hook)) + +(defvar current-dbl-buffer nil) + +(defvar dbl-command-name (if (file-exists-p "/bin/bash") "/bin/bash" + "/bin/sh") + "Pathname for executing dbl.") + + +(defun dbl (p) + + "Makes a dbl buffer, suitable for running an inferior + gcl. You are prompted for a name for the buffer. After the shell + starts you should start up your lisp program (eg gcl). The bufferd + has special keybindings for stepping and viewing sources. Enter the + debug loop with (si::dbl) or :dbl in a debug loop. " + + (interactive "p") + + (let ( tem + (dir default-directory) + ;; important for winnt version of emacs + (binary-process-input t) + (binary-process-output nil) + switches + (name (concat "dbl" (if (equal p 1) "" p) "")) + ) + + (switch-to-buffer (concat "*" name "*")) + (or (bolp) (newline)) + (insert "Current directory is " default-directory "\n") + (let ((tem dbl-subshell-switches) switches) + (while tem + (cond ((string-match (car tem) dbl-command-name) + (setq switches (nth 1 tem)) (setq tem nil)) + (t (setq tem (nthcdr 2 tem))))) + (apply 'make-sshell name dbl-command-name nil switches)) + (dbl-mode) + (make-local-variable 'sshell-prompt-pattern) + (setq sshell-prompt-pattern dbl-prompt-pattern) + (goto-char (point-min)) + (insert " +Welcome to DBL a Debugger for Lisp, Maxima, Gdb and others. + +You start your program as usually would in a shell. For Lisp and +Maxima the debugger commands begin with a ':', and there is +completion. Typing ':' should list all the commands. In GCL these +are typed when in the debugger, and in Maxima they may be typed at any +time. To see the wonderful benefits of this mode, type C-h m. + +Note you may also use this mode to run gdb. In fact I often debug +MAXIMA over GCL using gdb, thus having three debuggers at once. +To run gdb and enable the automatic line display, you must supply +the `--fullname' keyword as in: + + gdb your-file --fullname +") + (goto-char (point-max)) + (set-process-filter (get-buffer-process (current-buffer)) 'dbl-filter) + (set-process-sentinel (get-buffer-process (current-buffer)) 'dbl-sentinel) + (dbl-set-buffer))) + +(defun dbl-set-buffer () + (cond ((eq major-mode 'dbl-mode) + (setq current-dbl-buffer (current-buffer))))) + +;; This function is responsible for inserting output from DBL +;; into the buffer. +;; Aside from inserting the text, it notices and deletes +;; each filename-and-line-number; +;; that DBL prints to identify the selected frame. +;; It records the filename and line number, and maybe displays that file. +(defun dbl-filter (proc string) + (let ((inhibit-quit t)) + (set-buffer (process-buffer proc)) + (goto-char (point-max)) + (insert string) + (goto-char (point-max)) + )) + + +(defun dbl-filter (proc string) + (let ((inhibit-quit t)) + (if dbl-filter-accumulator + (dbl-filter-accumulate-marker proc + (concat dbl-filter-accumulator string)) + (dbl-filter-scan-input proc string)) + )) + + +(defun dbl-filter-accumulate-marker (proc string) + (setq dbl-filter-accumulator nil) + (if (> (length string) 1) + (if (= (aref string 1) ?\032) + (let ((end (string-match "\n" string))) + (if end + (progn + (setq me string) + (cond ((string-match + "\032\032\\([A-Za-z]?:?[^:]*\\):\\([0-9]*\\):[^\n]+\n" + string) + (setq dbl-last-frame + (cons + (match-string 1 string) + (string-to-int (match-string 2 string)))) + + (cond ((equal (cdr dbl-last-frame) 0) + ;(message "got 0") + ;(sit-for 1) + (setq overlay-arrow-position nil) + (setq dbl-last-frame nil) + ) + (t (setq dbl-last-frame-displayed-p nil)) + ))) + + (dbl-filter-scan-input proc + (substring string (1+ end)))) + (setq dbl-filter-accumulator string))) + (dbl-filter-insert proc "\032") + (dbl-filter-scan-input proc (substring string 1))) + (setq dbl-filter-accumulator string))) + +(defun dbl-filter-scan-input (proc string) + (if (equal string "") + (setq dbl-filter-accumulator nil) + (let ((start (string-match "\032" string))) + (if start + (progn + ;; to do fix this so that if dbl-last-frame + ;; changed, then set the current text property.. + ;; + (dbl-filter-insert proc (substring string 0 start)) + + (dbl-filter-accumulate-marker proc + (substring string start)) + ) + (dbl-filter-insert proc string))))) + +(defun dbl-filter-insert (proc string) + (let (moving + output-after-point + (old-buffer (current-buffer)) + start) + (set-buffer (process-buffer proc)) + ;; test to see if we will move the point. We want that the + ;; window-point of the buffer, should be equal to process-mark. + (setq moving (>= (window-point (get-buffer-window (process-buffer proc))) + (- (process-mark proc) 0))) + (setq output-after-point (< (point) (process-mark proc))) + (unwind-protect + (save-excursion + ;; Insert the text, moving the process-marker. + (goto-char (process-mark proc)) + (setq start (point)) + (insert string) + (set-marker (process-mark proc) (point)) + ; (setq bill (cons (list 'hi (process-mark proc) (marker-position (process-mark proc)) (point)) bill)) + (dbl-maybe-delete-prompt) + ;; Check for a filename-and-line number. + (dbl-display-frame + ;; Don't display the specified file + ;; unless (1) point is at or after the position where output appears + ;; and (2) this buffer is on the screen. + (or output-after-point + (not (get-buffer-window (current-buffer)))) + ;; Display a file only when a new filename-and-line-number appears. + t) + ) + (if moving + (set-window-point + (get-buffer-window (process-buffer proc)) + (process-mark proc))) + (set-buffer old-buffer)) + )) + +(defun dbl-sentinel (proc msg) + (cond ((null (buffer-name (process-buffer proc))) + ;; buffer killed + ;; Stop displaying an arrow in a source file. + (setq overlay-arrow-position nil) + (set-process-buffer proc nil)) + ((memq (process-status proc) '(signal exit)) + ;; Stop displaying an arrow in a source file. + (setq overlay-arrow-position nil) + ;; Fix the mode line. + (setq mode-line-process + (concat ": " + (symbol-name (process-status proc)))) + (let* ((obuf (current-buffer))) + ;; save-excursion isn't the right thing if + ;; process-buffer is current-buffer + (unwind-protect + (progn + ;; Write something in *compilation* and hack its mode line, + (set-buffer (process-buffer proc)) + ;; Force mode line redisplay soon + (set-buffer-modified-p (buffer-modified-p)) + (if (eobp) + (insert ?\n mode-name " " msg) + (save-excursion + (goto-char (point-max)) + (insert ?\n mode-name " " msg))) + ;; If buffer and mode line will show that the process + ;; is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (delete-process proc)) + ;; Restore old buffer, but don't restore old point + ;; if obuf is the dbl buffer. + (set-buffer obuf)))))) + + +(defun dbl-refresh () + "Fix up a possibly garbled display, and redraw the arrow." + (interactive) + (redraw-display) + (dbl-display-frame)) + +(defun dbl-display-frame (&optional nodisplay noauto) + "Find, obey and delete the last filename-and-line marker from DBL. +The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n. +Obeying it means displaying in another window the specified file and line." + (interactive) + (dbl-set-buffer) + (and dbl-last-frame (not nodisplay) + (or (not dbl-last-frame-displayed-p) (not noauto)) + (progn (dbl-display-line (car dbl-last-frame) (cdr dbl-last-frame)) + (setq dbl-last-frame-displayed-p t)))) + + +;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen +;; and that its line LINE is visible. +;; Put the overlay-arrow on the line LINE in that buffer. + + + +(defun dbl-find-file (file) + (cond ((file-exists-p file) + (find-file-noselect file)) + ((get-buffer file)) + (t (find-file-noselect file)))) + +(defvar dbl-dirs nil) + +(defun search-path (file dirs) + (let ((paths (symbol-value dirs)) + true-file) + (cond ((file-exists-p file) (setq true-file file)) + (t + (while paths + (let ((tem (expand-file-name file (or (car paths) default-directory)))) + (if (file-exists-p tem) (setq true-file tem)) + (setq paths (cdr paths)))))) + + (cond (true-file) + (t (setq paths (symbol-value dirs)) + (set dirs + (append paths + (list (file-name-directory + (read-file-name + (format "%s = %s, add path :" dirs paths)))))) + (search-path file dirs))))) + + +(defun dbl-find-line () + "If the current buffer has a process, then look first for a file-line +property, and if none, then search for a regexp. +If a non process buffer, just return current file and line number. +" + (interactive) + (save-excursion + (end-of-line) + (cond ((get-buffer-process (current-buffer)) + (cond + ((save-excursion + (beginning-of-line) + (get-text-property (point) 'file-line))) + ((progn (end-of-line) (re-search-backward " \\([^: ]+\\):\\([0-9]+\\)" 300 nil)) + (setq file (buffer-substring (match-beginning 1) (match-end 1))) + (setq line (buffer-substring (match-beginning 2) (match-end 2))) + (setq line (read line)) + (and (integerp line) + (setq file (search-path file 'dbl-dirs)) + (list file line))))) + (t (list (buffer-file-name) (+ 1 (count-lines (point)))))))) + +(defun dbl-find-and-display-line () + (interactive) + (let ((res (dbl-find-line))) + (and res (apply 'dbl-display-line res)))) + +(defun dbl-display-line (true-file line) + (let* ((buffer (dbl-find-file true-file)) + (window (display-buffer buffer t)) + (pos)) + (save-excursion + (set-buffer buffer) + (save-restriction + (widen) + (goto-line line) + (setq pos (point)) + (setq overlay-arrow-string "=>") + (or overlay-arrow-position + (setq overlay-arrow-position (make-marker))) + (set-marker overlay-arrow-position (point) (current-buffer))) + (cond ((or (< pos (point-min)) (> pos (point-max))) + (widen) + (goto-char pos)))) + (set-window-point window overlay-arrow-position))) + +(defvar dbl-gdb-command-alist '((":step %p" . "step %p") + (":next %p" . "next %p") + (":stepi" . "stepi %p") + (":r" . "r") + (":finish" . "finish") + (":up %p" . "up %p") + ( ":down %p" . "down %p"))) + +(defun dbl-call (command numeric) + "Invoke dbl COMMAND displaying source in other window." + (interactive) + (save-excursion + (goto-char (point-max)) + (beginning-of-line) + (let (com) + (cond ((or (looking-at "(gdb") + (member major-mode '(c-mode c++-mode))) + (if (setq com (assoc command dbl-gdb-command-alist)) + (setq command (cdr com)))))) + + + ;; to do put in hook here to recognize whether at + ;; maxima or lisp level. + + (setq command (dbl-subtitute-% command numeric)) + (goto-char (point-max)) + (setq dbl-delete-prompt-marker (point-marker)) + (dbl-set-buffer) + (send-string (get-buffer-process current-dbl-buffer) + (concat command "\n")))) + +(defun dbl-subtitute-% (command n) + (let* (result + (in-dbl (get-buffer-process (current-buffer))) + file-line + ) + (cond ((string-match "%[fl]" command) + (cond (in-dbl (setq file-line (dbl-find-line))) + (t (setq file-line + (list (buffer-file-name) + (+ 1 (count-lines + (point))))))))) + (while (and command (string-match "\\([^%]*\\)%\\([adeflp]\\)" command)) + (let ((letter (string-to-char (substring command (match-beginning 2)))) + subst) + (cond ((eq letter ?p) + (setq subst (if n (int-to-string n) ""))) + ((eq letter ?f) + (setq subst (or (car file-line) "unknown-file"))) + ((eq letter ?l) + (setq subst (if (cadr file-line) + (int-to-string (cadr file-line)) + "unknown-line"))) + ((eq letter ?a) + (setq subst (dbl-read-address)))) + (setq result (concat result + (substring command (match-beginning 1) (match-end 1)) + subst))) + (setq command (substring command (match-end 2)))) + (concat result command))) + + + +(defun dbl-maybe-delete-prompt () + (if (and dbl-delete-prompt-marker + (> (point-max) (marker-position dbl-delete-prompt-marker))) + (let (start) + (goto-char dbl-delete-prompt-marker) + (setq start (point)) + (beginning-of-line) + (delete-region (point) start) + (setq dbl-delete-prompt-marker nil)))) + +(defun dbl-break () + "Set DBL breakpoint at this source line." + (interactive) + (cond ((eq major-mode 'lisp-mode) + (save-excursion + (end-of-line) + (let (name + at where) + (setq where (point)) + (mark-defun) + (search-forward "(def") + (forward-sexp 2) + (setq at (point)) + (forward-sexp -1) + (setq name (buffer-substring (point) at)) + (beginning-of-line) + (setq name (format "(si::break-function '%s %s t)" name (count-lines 1 where))) + (other-window 1) + (if (get-buffer-process (current-buffer)) + (setq current-dbl-buffer (current-buffer))) + (message name) + (send-string (get-buffer-process current-dbl-buffer) + (concat name "\n")) + (other-window 1) + ))) + (t + + (let ((file-name (file-name-nondirectory buffer-file-name)) + (line (save-restriction + (widen) + (1+ (count-lines 1 (point)))))) + (and downcase-filenames-for-dbl + (setq file-name (downcase file-name))) + (send-string (get-buffer-process current-dbl-buffer) + (concat "break " file-name ":" line "\n")))))) + + +(defun dbl-read-address() + "Return a string containing the core-address found in the buffer at point." + (save-excursion + (let ((pt (dot)) found begin) + (setq found (if (search-backward "0x" (- pt 7) t)(dot))) + (cond (found (forward-char 2)(setq result + (buffer-substring found + (progn (re-search-forward "[^0-9a-f]") + (forward-char -1) + (dot))))) + (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1) + (dot))) + (forward-char 1) + (re-search-forward "[^0-9]") + (forward-char -1) + (buffer-substring begin (dot))))))) + + +(defvar dbl-commands nil + "List of strings or functions used by send-dbl-command. +It is for customization by you.") + +(defun send-dbl-command (arg) + + "This command reads the number where the cursor is positioned. It + then inserts this ADDR at the end of the dbl buffer. A numeric arg + selects the ARG'th member COMMAND of the list dbl-print-command. If + COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise + (funcall COMMAND ADDR) is inserted. eg. \"p (rtx)%s->fld[0].rtint\" + is a possible string to be a member of dbl-commands. " + + + (interactive "P") + (let (comm addr) + (if arg (setq comm (nth arg dbl-commands))) + (setq addr (dbl-read-address)) + (if (eq (current-buffer) current-dbl-buffer) + (set-mark (point))) + (cond (comm + (setq comm + (if (stringp comm) (format comm addr) (funcall comm addr)))) + (t (setq comm addr))) + (switch-to-buffer current-dbl-buffer) + (goto-char (dot-max)) + (insert-string comm))) + +(provide 'dbl) diff --git a/elisp/doc-to-texi.el b/elisp/doc-to-texi.el new file mode 100755 index 0000000..f540fab --- /dev/null +++ b/elisp/doc-to-texi.el @@ -0,0 +1,126 @@ + +(load "../gcl-tk/convert.el") +;(let ((i 2000)) (while (> i 0) (do-one) (setq i (- i 1)))) + +(defun get-match (i) (buffer-substring (match-beginning i) (match-end i))) +(defun list-matches (l) + (let (ans) + (while l + (setq ans (cons (get-match (car l)) ans))) + (nreverse ans))) +(defun do-one () + (interactive) + + () + (beginning-of-line) + (re-search-forward "" nil t) + (let ((beg (point)) + def + (end (save-excursion (re-search-forward "" nil t) (point)))) + (cond ((looking-at "F\\([^\n]+\\)\n\\([^\n]+\\) in \\([A-Z_a-z]+\\) package[:]?[\n ]\\(Args\\|Syntax\\): ") + (let ((fun (get-match 1)) + (type (get-match 2)) + (package (get-match 3)) + args body) + (goto-char (match-end 0)) + (cond ((equal (get-match 4) "Syntax") + (setq args "") + (beginning-of-line)) + (t + (setq args + (progn (let ((beg (point))) + (forward-sexp 1) + (buffer-substring beg (point))))))) + + (setq body (buffer-substring (point) (- end 1))) + (delete-region beg end ) + (save-excursion + (get-buffer-create package) + (set-buffer package) + (goto-char (point-max)) + (insert + (if (equal type "Function") + (setq def "@defun") + (concat (setq def "@deffn") " {" type "}")) + " " + fun " " args "\nPackage:" package "\n" + body) + (insert "\n@end " (substring def 1) "\n") + ))) + ((looking-at "V\\([^\n]+\\)\n\\([^\n]+\\) in \\([A-Z_a-z]+\\) package:\n") + (let ((fun (get-match 1)) + (type (get-match 2)) + (package (get-match 3)) + args body) + (goto-char (match-end 0)) + (setq body (buffer-substring (point) (- end 1))) + (delete-region beg end ) + (save-excursion + (get-buffer-create package) + (set-buffer package) + (goto-char (point-max)) + (insert (if (string-match "^\\*" fun) + (setq def "@defvar") + (concat (setq def "@defvr")" {Constant}")) + " " + fun " " "\nPackage:" package "\n" + body ) + (insert "\n@end " (substring def 1) "\n"))))))) + + +(defun do-some () + (interactive) + (while (re-search-forward "{Constant}" nil t) + (let* ((tem (read-char )) + (u + (cdr (assoc tem + '((?s . "{Special Variable}") + (?d . "{Declaration}")))))) + (if u (replace-match u))))) + +(setq b-alist '((?n . "number.texi") + (?s . "sequence.texi") + (?c . "character.texi") + (?l . "list.texi") + (?i . "io.texi") + (?a . "internal.texi") + (?f . "form.texi") + (?C . "compile.texi") + (?S . "symbol.texi") + (?t . "system.texi") + (?d . "structure.texi") + (?I . "iteration.texi") + (?u . "user-interface.texi") + (?d . "doc.texi") + (?b . "type.texi") + )) +(defun try1 () + (interactive) + (while (re-search-forward "\n@def" nil t) + (let ((beg (match-beginning 0)) me tem + (end (save-excursion (re-search-forward "\n@end def[a-z]+" nil t) + (point)))) + (sit-for 0 300) + (setq tem (read-char )) + (cond ((setq tem (cdr (assoc tem b-alist))) + (setq me (buffer-substring beg end)) + (delete-region beg end) + (forward-char -2) + (save-excursion + (get-buffer-create tem) + (set-buffer tem) + (goto-char (point-max)) + (insert me "\n"))))))) + + + +(setq xall (mapcar 'cdr b-alist)) + +;(let ((all xall)) (while all (set-buffer (car all)) (write-file (car all)) (setq all (cdr all)))) +;(let ((all xall)) (while all (find-file (car all)) (setq all (cdr all)))) +(let ((all xall) x) (while all (set-buffer (car all)) (goto-char (point-min)) (insert "@node " (setq x (capitalize (car all))) "\n@chapter "x"\n") (write-file (car all)) (set-buffer "gcl-si.texi")(goto-char (point-max)) (insert "\\n@include " (car all) "\n") (setq all (cdr all)))) + + +(let ((all xall) x) (while all (switch-to-buffer (car all)) (goto-char (point-min)) (insert "@node " (setq x (capitalize (car all))) "\n@chapter "x"\n") (save-buffer) (set-buffer "gcl-si.texi")(goto-char (point-max)) (insert "\\n@include " (car all) "\n") (setq all (cdr all)))) + +(let ((all xall) x) (while all (switch-to-buffer (car all)) (goto-char (point-min)) (insert "@node " (setq x (capitalize (car all))) "\n@chapter "x"\n") (save-buffer) (set-buffer "gcl-si.texi")(goto-char (point-max)) (insert "\\n@include " (car all) "\n") (setq all (cdr all)))) diff --git a/elisp/gcl.el b/elisp/gcl.el new file mode 100755 index 0000000..92305c9 --- /dev/null +++ b/elisp/gcl.el @@ -0,0 +1,375 @@ +;; Copyright William F. Schelter. 1994 +;; Licensed by GNU public license. + +;; You should copy isp-complete.el to the emacs/lisp directory. + +;; Some commands and macros for dealing with lisp +;; M-X run : run gcl or another lisp +;; m-c-x ; evaluate defun in the other window or in the last lisp which you were using. +;; m-c-x ; with a numeric arg : compile the current defun in the other window +;; m-c-d ; disassemble in other window. +;; M-x macroexpand-next : macro expand the next sexp in other window. +;; C-h d Find documentation on symbol where the cursor is. +;; C-h / Find documentation on all strings containing a given string. +;; M-p complete the current input by looking back through the buffer to see what was last typed +;; using this prompt and this beginning. Useful in shell, in lisp, in gdb,... + + +(setq lisp-mode-hook 'remote-lisp) + +(autoload 'lisp-complete "lisp-complete" nil t) +(autoload 'smart-complete "smart-complete" nil t) + +;(global-set-key "p" 'lisp-complete) +(global-set-key "p" 'smart-complete) + +(defun remote-lisp (&rest l) + (and (boundp 'lisp-mode-map) + lisp-mode-map + (progn + (define-key lisp-mode-map "\e\C-d" 'lisp-send-disassemble) + (define-key lisp-mode-map "\e\C-x" 'lisp-send-defun-compile) + (make-local-variable 'lisp-package) + (setq lisp-package nil) + (and (boundp 'remote-lisp-hook) (funcall remote-lisp-hook)) + ))) + + +(defvar search-back-for-lisp-package-p nil) + +;; look at the beginning of buffer to try to find an in package statement +(defun get-buffer-package () + + "Returns what it thinks is the lisp package for the current buffer. +It caches this information in the local variable `lisp-package'. It +obtains the information from searching for the first in-package from +the beginning of the file. Since in common lisp, there is only +supposed to be one such statement, it should be able to determine +this. By setting lisp-package to t, you may disable its search. This +will also disable the automatic inclusion of an in-package statement +in the tmp-lisp-file, used for sending forms to the current +lisp-process." + + (cond ((eq lisp-package t) nil) + (search-back-for-lisp-package-p + (save-excursion + (cond ((re-search-backward "^[ \t]*(in-package " nil t) + (goto-char (match-end 0)) + (read (current-buffer)))))) + (lisp-package lisp-package) + (t + (setq + lisp-package + (let (found success) + (save-excursion + (goto-char (point-min)) + (while (not found) + (if (and (setq success (search-forward "(in-package " 1000 t)) + (not (save-excursion + (beginning-of-line) + (looking-at "[ \t]*;")))) + (setq found (read (current-buffer)))) + (if (>= (point) 980) (setq found t)) + (or success (setq found t)) + )) + found))))) + + +(defun run (arg) + "Run an inferior Lisp process, input and output via buffer *lisp*." + (interactive "sEnter name of file to run: ") + (require 'sshell) + ;; in emacs 19 uncomment: + ;;(require 'inf-lisp) + (setq lisp-mode-hook 'remote-lisp) + (switch-to-buffer (make-sshell (concat arg "-lisp") arg nil "-i")) + (make-local-variable 'shell-prompt-pattern) + (setq sshell-prompt-pattern "^[^#%)>]*[#%)>]+ *") + (cond ((or (string-match "maxima" arg) (string-match "affine" arg) + (save-excursion (sleep-for 2) + (re-search-backward "maxima" + (max 1 (- (point) 300)) + t))) + (require 'maxima-mode) + (inferior-maxima-mode) + (goto-char (point-max)) + ) + (t + (if (boundp 'inferior-lisp-mode) + (inferior-lisp-mode) + (funcall lisp-mode-hook)) + ))) + +(defun lisp-send-disassemble (arg) + (interactive "P") + (if arg + ( lisp-send-defun-compile "disassemble-h") + ( lisp-send-defun-compile "disassemble")) + ) + +(defvar time-to-throw-away nil) +(defvar telnet-new-line "") + +(defun lisp-send-defun-compile (arg) + + "Send the current defun (or other form) to the lisp-process. If there +is a numeric arg, the form (compile function-name) is also sent. The +value of lisp-process will be the process of the other exposed window (if +there is one) or else the global value of lisp-process. If the +...received message is not received, probably either the reading of +the form caused an error. If the process does not have telnet in +its name, then we write a tmp file and load it. +If :sdebug is in *features*, then si::nload is used instead of +ordinary load, in order to record line information for debugging. + +The value of `lisp-package' if non nil, will be used in putting an +in-package statement at the front of the tmp file to be loaded. +`lisp-package' is determined automatically on a per file basis, +by get-buffer-package. +" + + (interactive "P") + (other-window 1) + (let* ((proc (or (get-buffer-process (current-buffer)) lisp-process)) + def beg + (this-lisp-process proc) + (lisp-buffer (process-buffer this-lisp-process)) + fun) + (other-window 1) + (save-excursion + (end-of-defun) + (let ((end (dot)) (buffer (current-buffer)) + (proc (get-process this-lisp-process))) + (setq lisp-process proc) + (beginning-of-defun) + (save-excursion + (cond ((and arg (looking-at "(def")) (setq def t)) + (t (setq arg nil))) + (cond (def (forward-char 2)(forward-sexp 1) + (setq fun (read buffer)) + (setq fun (prin1-to-string fun)) + (message (format + "For the lisp-process %s: %s" + (prin1-to-string this-lisp-process) fun))))) + (cond ((equal (char-after (1- end)) ?\n) + (setq end (1- end)) )) + (setq beg (dot)) + (my-send-region this-lisp-process beg end) + )) + + + (send-string this-lisp-process + (concat ";;end of form" "\n" telnet-new-line)) + (cond (arg + (if (numberp arg) (setq arg "compile")) + (send-string this-lisp-process (concat "(" arg "'" fun ")" + telnet-new-line)))) + (and time-to-throw-away + (string-match "telnet"(buffer-name (process-buffer proc))) + (dump-output proc time-to-throw-away)) + (cond (nil ;(get-buffer-window lisp-buffer) + (select-window (get-buffer-window lisp-buffer)) + (goto-char (point-max))) + (t nil)))) + +(fset 'lisp-eval-defun (symbol-function 'lisp-send-defun-compile)) + +(defvar telnet-new-line "") +(defvar tmp-lisp-file (concat "/tmp/" (user-login-name) ".lsp")) + +(defun get-buffer-clear (name) + (let ((cb (current-buffer)) + (buf (get-buffer-create name))) + (set-buffer buf) + (erase-buffer) + (set-buffer cb) + buf)) + +(defmacro my-with-output-to-temp-buffer (name &rest body) + (append (list + 'let + (list (list 'standard-output (list 'get-buffer-clear name)))) + body)) + + +(defun my-send-region (proc beg end) + (cond ((or (string-match "telnet" (process-name proc))) + (send-region proc beg end)) + (t + (let ((package (get-buffer-package))) + (save-excursion + (my-with-output-to-temp-buffer "*tmp-gcl*" + (if (and package (not (eq package t))) + (prin1 (list 'in-package package))) + (princ ";!(:line ") + (prin1 + (let ((na (buffer-file-name (current-buffer)))) + (if na (expand-file-name na) + (buffer-name (current-buffer)))) + ) + (princ (- (count-lines (point-min) (+ beg 5)) 1)) + (princ ")\n") + (set-buffer "*tmp-gcl*") + (write-region (point-min) (point-max) tmp-lisp-file nil nil))) + (write-region beg end tmp-lisp-file t nil) + (message "sending ..") + (send-string + proc + (concat "(lisp::let ((*load-verbose* nil)) (#+sdebug si::nload #-sdebug load \"" + tmp-lisp-file + "\")#+gcl(setq si::*no-prompt* t)(values))\n ") + ) + (message (format "PACKAGE: %s ..done" + (if (or (not package) (eq package t)) + "none" + package))) + + + )))) + +(defun dump-output (proc seconds) + "dump output for PROCESS for SECONDS or to \";;end of form\"" + (let ((prev-filter (process-filter proc)) (already-waited 0)) + (unwind-protect (progn (set-process-filter proc 'dump-filter) + (while (< already-waited seconds) + (sleep-for 1)(setq already-waited + (1+ already-waited)))) + (set-process-filter proc prev-filter)))) + + + +(defun dump-filter (proc string) +; (setq she (cons string she)) + (let ((ind (string-match ";;end of form" string))) + (cond (ind (setq string (substring + string + (+ ind (length + ";;end of form")))) + + (message "... received.") + (setq already-waited 1000) + (set-process-filter proc prev-filter) + (cond (prev-filter (funcall prev-filter proc string)) + (t string))) + (t "")))) + + +;;(process-filter (get-process "lisp")) +(defun macroexpand-next () + "macroexpand current form" + (interactive) + (save-excursion + (let ((beg (point))) + (forward-sexp ) + (message "sending macro") + + (let* ((current-lisp-process + (or (get-buffer-process (current-buffer)) + (prog2 (other-window 1) + (get-buffer-process (current-buffer)) + (other-window 1))))) + (send-string current-lisp-process "(macroexpand '") + (send-region current-lisp-process beg (point) ) + (send-string current-lisp-process ")\n"))))) + +(defun delete-comment-char (arg) + (while (and (> arg 0) (looking-at comment-start)) (delete-char 1) + (setq arg (1- arg)))) + +(defun mark-long-comment () + (interactive) + (let ((at (point))) + (beginning-of-line) + (while(and (not (eobp)) + (or (looking-at comment-start) + ;(looking-at "[ ]*\n") + )) + (forward-line 1)) + (set-mark (point)) + (goto-char at) + (while(and (not (bobp)) + (or (looking-at comment-start) + ;(looking-at "[ ]*\n") + )) + (forward-line -1)) + (or (bobp )(forward-line 1)))) + + +(defun fill-long-comment () + (interactive) + (mark-long-comment) + (let ((beg (min (dot) (mark))) + (end (max (dot) (mark))) (n 0)m) + (narrow-to-region beg end) + (goto-char (point-min)) + (while (looking-at ";") + (forward-char 1)) + (setq n (- (point) beg)) + (goto-char (point-min)) + (while (not (eobp)) + (setq m n) + (while (> m 0) + (cond ((looking-at ";") + (delete-char 1) + (cond ((looking-at " ")(delete-char 1)(setq m 0))) + (setq m (- m 1))) + (t (setq m 0)))) + (forward-line 1)) + (fill-region (dot-min) (dot-max)) + (goto-char (point-min)) + (while (not (eobp)) + (cond ((looking-at "\n") + nil) + (t(insert ";; "))) + (forward-line 1)) + (goto-char (point-min)) + (set-mark (point-max)) + (widen))) + +(defun comment-region (arg) + "Comments the region, with a numeric arg deletes up to arg comment +characters from the beginning of each line in the region. The region stays, +so a second comment-region adds another comment character" + (interactive "P") + (save-excursion + (let ((beg (dot)) + (ok t)(end (mark))) + (comment-region1 beg end arg)))) + +(defun comment-region1 (beg end arg) + (let ((ok t)) + (cond((> beg end) + (let ((oth end)) + (setq end beg beg oth)))) + (narrow-to-region beg end) + (goto-char beg) + (unwind-protect + (while ok + (cond (arg + (delete-comment-char arg)) + (t (insert-string comment-start))) + (if (< end (dot)) (setq ok nil) + (if (search-forward "\n" end t) nil (setq ok nil))) ) + (widen)))) + +(defun trace-expression () + (interactive) + (save-excursion + (forward-sexp ) + (let ((end (point))) + (forward-sexp -1) + (other-window 1) + (let* ((proc (get-buffer-process (current-buffer))) + (current-lisp-process (or proc lisp-process))) + (other-window 1) + (message "Tracing: %s" (buffer-substring (point) end)) + (send-string current-lisp-process "(trace ") + (send-region current-lisp-process (point) end) + (send-string current-lisp-process ")\n"))))) + +(defun gcl-mode () + (interactive) + (lisp-mode) + ) + +(provide 'gcl) \ No newline at end of file diff --git a/elisp/makefile b/elisp/makefile new file mode 100644 index 0000000..6ee4b3f --- /dev/null +++ b/elisp/makefile @@ -0,0 +1,18 @@ + + +-include ../makedefs + +install: + mkdir -p $(DESTDIR)$(EMACS_SITE_LISP) + cp *.el $(DESTDIR)$(EMACS_SITE_LISP) + if [ "$(EMACS_DEFAULT_EL)" != "" ] ; then \ + if test -f "$(DESTDIR)${EMACS_DEFAULT_EL}" ; then \ + cat $(DESTDIR)${EMACS_DEFAULT_EL} | sed -e '/BEGIN gcl/,/END gcl/d' > $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default ; \ + mv $(DESTDIR)${EMACS_DEFAULT_EL} $(DESTDIR)${EMACS_DEFAULT_EL}.prev ; \ + rm -f $(DESTDIR)${EMACS_DEFAULT_EL}c ; \ + cat add-default.el >> $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default ; cp $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default $(DESTDIR)${EMACS_DEFAULT_EL} ; \ + rm -f $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default ; else \ + cp add-default.el $(DESTDIR)${EMACS_DEFAULT_EL} ; fi ; \ + chmod a+r $(DESTDIR)${EMACS_DEFAULT_EL} ; fi + + diff --git a/elisp/man1-to-texi.el b/elisp/man1-to-texi.el new file mode 100755 index 0000000..258ad20 --- /dev/null +++ b/elisp/man1-to-texi.el @@ -0,0 +1,414 @@ +;;;;if you are in a buffer which has a man page you can try +;; M-x doit, to do an at least partial conversion of tcl tk man pages to +;; texinfo + +;; file for converting the tcl/tk man pages to texinfo and suitable for gcl/tk +; .bp begin new page +; .br break output line here +; .sp n insert n spacing lines +; .ls n (line spacing) n=1 single, n=2 double space +; .na no alignment of right margin +; .ce n center next n lines +; .ul n underline next n lines +; .sz +n add n to point size +; +; Requests +; Request Cause If no Explanation +; Break Argument +; +; .B t no t=n.t.l.* Text is in bold font. +; .BI t no t=n.t.l. Join words, alternating bold +; and italic. +; .BR t no t=n.t.l. Join words, alternating bold +; and roman. +; .DT no .5i 1i... Restore default tabs. +; .HP i yes i=p.i.* Begin paragraph with hanging +; indent. Set prevailing indent to i. +; .I t no t=n.t.l. Text is italic. +; .IB t no t=n.t.l. Join words, alternating italic +; and bold. +; +; .IP x i yes x="" Same as .TP with tag x. +; .IR t no t=n.t.l. Join words, alternating italic +; and roman. +; .IX t no - Index macro, for Sun internal +; use. +; .LP yes - Begin left-aligned paragraph. +; Set prevailing indent to .5i. +; .PD d no d=.4v Set vertical distance between +; paragraphs. +; .PP yes - Same as .LP. +; .RE yes - End of relative indent. +; Restores prevailing indent. +; .RB t no t=n.t.l. Join words, alternating roman +; and bold. +; .RI t no t=n.t.l. Join words, alternating roman +; and italic. +; .RS i yes i=p.i. Start relative indent, +; increase indent by i. Sets prevailing indent to +; .5i for nested indents. +; .SB t no - Reduce size of text by 1 +; point, make text boldface. +; .SH t yes - Section Heading. +; .SM t no t=n.t.l. Reduce size of text by 1 +; point. +; .SS t yes t=n.t.l. Section Subheading. +; .TH n s d f m +; yes - Begin reference page n, of +; section s; d is the date of the most +; recent change. If present, f +; is the left page footer; m is the +; main page (center) header. +; Sets prevailing indent and tabs to .5i. +; .TP i yes i=p.i. Begin indented paragraph, with +; the tag given on the next text +; line. Set prevailing indent +; to i. +; +; .TX t p no - Resolve the title abbreviation +; t; join to punctuation mark (or text) p. * +; n.t.l. = next text line; p.i. = prevailing +; indent +; .HS name section [date [version]] +; Replacement for .TH in other man pages. See below for valid +; section names. +; +; .AP type name in/out [indent] +; Start paragraph describing an argument to a library procedure. +; type is type of argument (int, etc.), in/out is either "in", "out", +; or "in/out" to describe whether procedure reads or modifies arg, +; and indent is equivalent to second arg of .IP (shouldn't ever be +; needed; use .AS below instead) +; +; .AS [type [name]] +; Give maximum sizes of arguments for setting tab stops. Type and +; name are examples of largest possible arguments that will be passed +; to .AP later. If args are omitted, default tab stops are used. +; +; .BS +; Start box enclosure. From here until next .BE, everything will be +; enclosed in one large box. +; +; .BE +; End of box enclosure. +; +; .VS +; Begin vertical sidebar, for use in marking newly-changed parts +; of man pages. +; +; .VE +; End of vertical sidebar. +; +; .DS +; Begin an indented unfilled display. +; +; .DE +; End of indented unfilled display. +; + +(defun do-replace (lis &optional not-in-string) + (let (x case-fold-search) + (while lis + (setq x (car lis)) (setq lis (cdr lis)) + (goto-char (point-min)) + (message "doing %s " x) + (while (re-search-forward (nth 0 x) nil t) + (and not-in-string + (progn (forward-char -1) + (not (in-a-string)))) + (let ((f (nth 1 x))) + (cond ((stringp f) + (replace-match f t)) + (t (let ((i 0) ans) + (while (match-beginning i) + (setq ans (cons (buffer-substring + (match-beginning i) + (match-end i)) ans)) + (setq i (+ i 1))) + (setq ans (nreverse ans)) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) + (match-end 0)) + (apply f ans))))))))) + + + + +(defun doit () + (interactive) + (texinfo-mode) + (goto-char (point-min)) + (do-replace '(("@" "@@") + ("^[.]VS\n" "") + ("^[.]VE\n" "") + )) + (goto-char (point-min)) + (insert "@setfilename foo.info") + (insert "\n") + (do-tables) +; (do-nf) + (do-replace + '( + (".SH \"SEE ALSO\"\n\\([^\n]*\\)" "@xref{\\1}") + ("^[.]SH NAME" "") + ("^'[\\]\"[^\n]*\n" "") + ("^'[/]\"[^\n]*\n" "") + ("^[.]so[^\n]+\n" "") + ("[.]HS \\([^ \n]+\\)\\([^\n]*\\)\n" + "@node \\1\n@subsection \\1\n") + ("^[.]VS\n" "") + ("^[.]VE\n" "") + (".nf\nName:\t\\([^\n]*\\)\nClass:\t\\([^\n]*\\)\nCommand-Line Switch:\t\\([^\n]*\\)\n.fi\n" do-keyword) + ("Name:\t\\([^\n]*\\)\nClass:\t\\([^\n]*\\)\nCommand-Line Switch:\t\\([^\n]*\\)\n" do-keyword) + ("Name:\t\\([^\n]*\\)\n" "@*@w{ Name: @code{\\1}}\n") + ("Class:\t\\([^\n]*\\)\n" "@*@w{ Class: @code{\\1}}\n") + ("Command-Line Switch:\t\\([^\n]*\\)\n" "@*@w{ Keyword: @code{\\1}}\n") + ("[\\]-\\([a-z]\\)" ":\\1") + ("^[.]nf\n" "@example\n") + ("^[.]fi\n" "@end example\n") + ("^[.]ta[^\n]*\n" do-ta) + ("^[.]IP\n" "\n") + ("[\\]f\\([A-Z]\\)\\([^\\\n]*\\)[\\]f" + do-font) + ("^\\([^\n]+\\)\n[.]br" "@*@w{\\1}@*") + ("^[.]SH \\([^\n]*\\)" + (lambda (a0 a1) + (insert "@unnumberedsubsec " (capitalize a1)))) + ("[\\]fR" "") + + ("^[.]BS" "@cartouche") + ("^[.]BE" "@end cartouche") + ("^[.]sp \\([0-9]\\)" "@sp \\1") + ("^[.]sp" "@sp 1") + ("^[.]LP\n" "\n\n") + ("^[.][LP]P" "") + ("^[.]DS[^\n]*\n" "\n@example\n") + ("^[.]DE[^\n]*\n" "@end example\n\n") + ("^[.]DS[^\n]*\n" "\n@example\n") + ("^[.]DE[^\n]*\n" "@end example\n\n") + ("^[.]RS\n" "") ; relative indent increased.. + ("^[.]rE\n" "") + ("^[\\]&\\([^\n]*\\)\n" "@*@w{ \\1}\n") +; ("Command-Line Switch" "Keyword") + ("pathName }@b{\\([a-z]\\)" "pathName }@b{:\\1") + ("[\\]0" " ") + ("%\\([a-z#]\\)\\([^a-zA-Z0-9%]\\)" "|%\\1|\\2") + ("^[.]TP[^\n]*\n" "@item ") + )) + (add-keywords) + ) + +(defun do-font (ign a b) + (let ((ch (assoc (aref a 0) + '((?R . "@r{") + (?I . "@i{") + (?B . "@b{"))))) + (cond (ch (insert (cdr ch) b "}\\f") + (forward-char -2) + ) + (t (error "unknown leter %s" a))))) + +(defun do-keyword (ign name class key) + (insert "@table \n@item @code{"key "}" + "\n@flushright\nName=@code{\""name"\"} Class=@code{\""class "\"}\n" + "@end flushright\n@sp 1\n") + (save-excursion + (cond ((re-search-forward "[.]LP\\|[.]BE\\|[.]SH" nil t) + (beginning-of-line) + (insert "@end table\n"))))) + + + + +(defun try () + (interactive) + (if (get-buffer "foo.texi") + (kill-buffer (get-buffer "foo.texi"))) + + (if (get-buffer "foo.info") + (kill-buffer (get-buffer "foo.info"))) + + (find-file "foo.n") + (toggle-read-only 0) + (doit) + (write-file "foo.texi") + (makeinfo-buffer )) + +(defun foo () + (re-search-forward "\n\\|\\([\\]f[a-zA-Z]\\)" nil t) + (list (match-beginning 0) (match-beginning 1) (match-beginning 2))) + +(defun list-current-line () + (beginning-of-line) + (let (ans at-end (beg (point))) + (save-excursion + (while (not at-end) + (re-search-forward "\n\\|\\([\\]f[a-zA-Z]\\)" nil t) + (if (match-beginning 1) (replace-match "") + (setq at-end t)))) + (setq at-end nil) + (beginning-of-line) + (while (not at-end) + (re-search-forward "[\t\n]" nil t) + (let ((x (buffer-substring beg (- (point) 1)))) + (or (equal x "") + (setq ans (cons x ans)))) + + (setq beg (point)) + (setq at-end (equal (char-after (- (point) 1)) ?\n))) + (nreverse ans) + )) + +(defun do-ta (a0) + (let ((beg (point)) + items (vec (make-vector 10 0)) i (tot 0) surplus) + (while (not (looking-at "[.][LDI]")) + (cond ((looking-at "[.]")(forward-line 1)) + (t + (setq items (cons (list-current-line) items)) + (let ((tem (car items)) + (i 0)) + (while tem + (aset vec i (max (real-length (car tem)) (aref vec i))) + (setq i (+ i 1)) + (setq tem (cdr tem))) + )))) +; (message "%s" (list beg (point))) +; (sit-for 1) + + (delete-region beg (point)) +; (forward-line -2) +; (message "%s" vec) +; (sit-for 2) + (setq items (nreverse items)) + (setq i 0) + (while (< i (length vec)) (setq tot (+ (aref vec i) tot)) (setq i (+ i 1))) + (setq surplus (/ (- 70 tot) (+ 1 (length (car items))))) + (while items + (setq tem (car items)) + (setq i 0) + (let (ans x) + (insert "") + (while tem + (insert (tex-center (car tem) (+ (aref vec i) surplus) 'left + (real-length (car tem)))) + (setq tem (cdr tem)) (setq i (+ i 1))) + (insert "\n")) + (setq items (cdr items))) + ) + ) + + + + + + + +(defun real-length (item) + (let* ((n (length item)) (m (- n 1)) (start 0)) + (while (setq start (string-match "[\\]f" item start)) + (setq n (- n 3)) + (if (< start m) (setq start (+ start 1)))) + n)) + + +(defun do-tables () + (goto-char (point-min)) + (while (re-search-forward "^[.]TP" nil t) + (beginning-of-line) + (insert "\n@table @asis\n") + (forward-line 2) + (re-search-forward "^[.]\\(LP\\|BE\\|SH\\)" nil t) + (beginning-of-line) + (insert "@end table\n") + )) +(defun do-nf () + (goto-char (point-min)) + (while (re-search-forward "^[.]nf" nil t) + (forward-line 1) (beginning-of-line) + (while (not (looking-at "[.]fi")) + (insert "@w{" ) (end-of-line) (insert "}") + (forward-line 1) (beginning-of-line)))) + +(defun add-keywords () + (let ((tem tk-control-options)x lis l y) + (while tem + (setq l (car tem)) + (setq tem (cdr tem)) + (setq x (symbol-name (car l ))) + (setq lis (car (cdr l))) + (while lis + (cond ((atom lis) (setq lis nil)) + (t (setq y (symbol-name (car lis))) + (do-replace (list (list (concat x " "y "") + (concat x " :"y "") + ))))) + (setq lis (cdr lis)))))) + +(setq tk-control-options + '((after fixnum) + (exit fixnum) + (lower window) + (place pathName (-anchor -bordermode -height + -in -relheight -relwidth + -relx -rely -width -x -y)) + (send interpreter ) + ;(TKVARS "invalid command name \"tkvars\"") + (winfo (atom atomname cells children class containing + depth exists fpixels geometry height id + interps ismapped name parent pathname pixels + reqheight reqwidth rgb rootx rooty screen + screencells screendepth screenheight screenmmheight + screenmmwidth screenvisual screenwidth toplevel + visual vrootheight vrootwidth vrootx vrooty width x y) ) + (focus (default none) ) + (option (add clear get readfile)) + (raise pathname) + (tk colormodel) + (tkwait ( variable visible window) ) + (wm (aspect client command deiconify focusmodel frame geometry grid group iconbitmap iconify iconmask iconname iconposition iconwindow maxsize minsize overrideredirect positionfrom protocol sizefrom state title trace transient withdraw)) + (destroy window) + (grab (current release set status)) + (pack window (-after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, -side) argggg) + (selection (clear get handle own)) + (tkerror "") + (update (idletasks)) + )) + +(setq tk-widget-options + '( + (button (activate configure deactivate flash invoke)) + (listbox ( configure curselection delete get insert nearest + scan select size xview yview)) + (scale ( configure get set)) + (canvas ( addtag bbox bind canvasx canvasy configure coords + create dchars delete dtag find focus gettags + icursor index insert itemconfigure lower move + postscript raise scale scan select type xview yview)) + (menu ( activate add configure delete disable enable + entryconfigure index invoke post unpost yposition)) + (scrollbar ( configure get set)) + (checkbutton + ( activate configure deactivate deselect flash + invoke select toggle)) + (menubutton + ( activate configure deactivate)) + (text ( compare configure debug delete get index insert + mark scan tag yview)) + (entry ( configure delete get icursor index insert scan select view)) + (message ( configure)) + (frame ( configure)) + (label ( configure)) + (radiobutton + ( activate configure deactivate deselect flash invoke select)) + (toplevel ( configure)) + )) + +(setq manual-sections + '(after bind button canvas checkbutton destroy entry exit focus foo frame grab label lbSingSel listbox lower menu menubar menubutton message option options pack-old pack place radiobutton raise scale scrollbar selection send text tk tkerror tkvars tkwait toplevel update winfo wm)) + +;(setq widgets (sort (mapcar 'car tk-widget-options) 'string-lessp)) +;(let ((m manual-sections)(tem widgets)) (while tem (setq manual-sections (delete (car tem) manual-sections))(setq tem (cdr tem)))) + + + diff --git a/elisp/readme b/elisp/readme new file mode 100755 index 0000000..c7c29fd --- /dev/null +++ b/elisp/readme @@ -0,0 +1,7 @@ + +dbl.el: mode for source level debugging lisp much like the authors gdb.el +gcl.el: mode for interacting with gcl +sshell.el: old fashioned shell mode, used by dbl.el. +lisp-complete.el: a history mechanism based on the prompt. + + diff --git a/elisp/smart-complete.el b/elisp/smart-complete.el new file mode 100644 index 0000000..b8b88f2 --- /dev/null +++ b/elisp/smart-complete.el @@ -0,0 +1,154 @@ +;; This file is part of GNU Emacs. +;; Copyright (C) 1998 William F. Schelter + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY. No author or distributor accepts responsibility +;; to anyone for the consequences of using it or for whether it serves +;; any particular purpose or works at all, unless he says so in writing. +;; Refer to the GNU Emacs General Public License for full details. + +;; Everyone is granted permission to copy, modify and redistribute GNU +;; Emacs, but only under the conditions described in the GNU Emacs +;; General Public License. A copy of this license is supposed to have +;; been given to you along with GNU Emacs so you can know your rights and +;; responsibilities. It should be in a file named COPYING. Among other +;; things, the copyright notice and this notice must be preserved on all +;; copies. + + + +;; By Bill Schelter wfs@math.utexas.edu + +;; Completion on forms in the buffer. Does either a line or an sexp. +;; Uses the current prompt and the beginning of what you have typed. +;; Thus If the buffer contained + +;; (dbm:3) load("jo" +;; (C11) lo("ji") +;; (gdb) last +;; maxima>>4 +;; /home/bil# ls +;; then if you are at a prompt +;; "(C15) l" would match lo("ji") only, not "last", not "ls" nor load(" +;; and the commands with the (gdb) prompt would only match ones +;; starting with (gdb) .. + + +;; also if the command is a lisp sexp and this would be longer than the +;; current line, it grabs the whole thing. sometimes we have different +;; prompts, for different programs and we dont want to confuse the input +;; from one with input for another. Generally the prompt matches a +;; previous prompt, with numbers matching any number, and if there are +;; '/' then match anything up to a shell prompt terminator. Note it does +;; this without additional consing or building up huge lists of inputs. + + +(if (boundp 'comint-mode-map) + (define-key comint-mode-map "\ep" 'smart-complete) + ) + +(if (boundp 'sshell-mode-map) + (define-key sshell-mode-map "\ep" 'smart-complete) + (define-key sshell-mode-map "\M-p" 'smart-complete) + ) + +(defun get-match-n (i ) + (buffer-substring (match-beginning i) (match-end i))) + +(defun smart-complete () + "Begin to type the command and then type M-p. You will be + offered in the minibuffer a succession of choices, which + you can say 'n' to to get the next one, or 'y' or 'space' + to grab the current one. + + Thus to get the last command starting with 'li' you type + liM-py +" + (interactive ) + (let ((point (point)) new str tem prompt) + (save-excursion + (beginning-of-line) + (cond ((looking-at sshell-prompt-pattern) + (setq prompt (get-match-n 0)) + (setq str (buffer-substring (match-end 0) point))) + (t (error "Your prompt on this line does not match sshell-prompt-pattern"))) + + (setq new (smart-complete2 prompt str)) + ) + (cond (new + (delete-region (setq tem (- point (length str))) point) + (goto-char tem) + (insert new))))) + +(defun smart-complete2 (prompt str) + (let ((pt (point)) found + (pat (concat (regexp-for-this-prompt prompt) + "\\(" (regexp-quote str) "\\)" )) + offered (not-yet t) + ) + (setq bill pat) + (while (and not-yet + (re-search-backward pat nil t)) + (goto-char (match-beginning 1)) + (setq at (match-beginning 1)) + (goto-char at) + (setq this (buffer-substring at + (save-excursion (end-of-line) (point)))) + (or (member this offered) + (equal this str) + (progn (setq offered (cons this offered)) + ;; do this so the display does not shift... + (goto-char pt) + (setq not-yet + (not (y-or-n-p (concat "Use: " this " ")))))) + (cond (not-yet (goto-char at) (beginning-of-line) (forward-char -1)) + (t (setq found + (save-excursion + (buffer-substring + at + (progn (goto-char at) + (max (save-excursion + (end-of-line) (point)) + (save-excursion + (forward-sexp 1)(point))) + ))))))) + (or found (message "No more matches")) + found + )) + + +;; return a regexp for this prompt but with numbers replaced. + +(defun split-string-gcl (s bag) + (cond ((equal (length s) 0) '("")) + ((string-match bag s) + (if (= (match-beginning 0) 0) + (cons "" (split-string-gcl (substring s (match-end 0)) bag)) + (cons (substring s 0 (match-beginning 0)) + (split-string-gcl (substring s (match-end 0)) bag)))) + (t (cons s nil)))) + +;; Return a regexp which matches the current prompt, and which +;; allows things like +;; "/foo/bar# " to match "any# " +;; "(C12) " to match "(C1002) " but not (gdb) nor "(D12) " +;; if the prompt appears to be a pathname (ie has /) then +;; allow any beginning, otherwise numbers match numbers... +(defun regexp-for-this-prompt (prompt ) + (let ((wild (cond ((string-match "/" prompt) "[^ >#%()]+") + (t "[0-9]+")))) + (let ((tem (split-string-gcl prompt wild)) (ans "")) + (while tem + (setq ans (concat ans (regexp-quote (car tem)))) + (cond ((cdr tem) (setq ans (concat ans wild)))) + (setq tem (cdr tem))) + ans))) + + +(provide 'smart-complete) + + + + + + diff --git a/elisp/sshell.el b/elisp/sshell.el new file mode 100755 index 0000000..c80f9bf --- /dev/null +++ b/elisp/sshell.el @@ -0,0 +1,379 @@ + +;; Run subshell under Emacs +;; Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. +;; Modifications by William Schelter +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 1, or (at your option) +;; any later version. + +;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; The following is a "simple shell" much like the one in version 18 +;; of emacs. Unfortunately cmint breaks most code which tries to use +;; the shell mode, and is rather complex. + +;; This mode uses a better completion mechanism (smart-complete.el), +;; in that it should +;; find the input you really want with your typing less keystrokes, +;; and easier keystrokes to type + + + + + +(defvar last-input-start nil + "In a sshell-mode buffer, marker for start of last unit of input.") +(defvar last-input-end nil + "In a sshell-mode buffer, marker for end of last unit of input.") + +(defvar sshell-mode-map nil) + +(defvar sshell-directory-stack nil + "List of directories saved by pushd in this buffer's sshell.") + +(defvar sshell-popd-regexp "popd" + "*Regexp to match subsshell commands equivalent to popd.") + +(defvar sshell-pushd-regexp "pushd" + "*Regexp to match subsshell commands equivalent to pushd.") + +(defvar sshell-cd-regexp "cd" + "*Regexp to match subsshell commands equivalent to cd.") + +(defvar explicit-sshell-file-name nil + "*If non-nil, is file name to use for explicitly requested inferior sshell.") + + +;In loaddefs.el now. +(defconst sshell-prompt-pattern + "\\(^\\|\n\\)[^ >]*[>$)%#:][>]*[ ]*" + "*Regexp used by Newline command to match subsshell prompts. +Anything from beginning of line up to the end of what this pattern matches +is deemed to be prompt, and is not reexecuted.") + +(defun sshell-mode () + "Major mode for interacting with an inferior sshell. +Sshell name is same as buffer name, sans the asterisks. +Return at end of buffer sends line as input. +Return not at end copies rest of line to end and sends it. + +The following commands imitate the usual Unix interrupt and +editing control characters: +\\{sshell-mode-map} + +Entry to this mode calls the value of sshell-mode-hook with no args, +if that value is non-nil. + +cd, pushd and popd commands given to the sshell are watched +by Emacs to keep this buffer's default directory +the same as the sshell's working directory. +Variables sshell-cd-regexp, sshell-pushd-regexp and sshell-popd-regexp +are used to match these command names. + +You can send text to the sshell (or its subjobs) from other buffers +using the commands process-send-region, process-send-string +and lisp-send-defun." + (interactive) + (kill-all-local-variables) + (setq major-mode 'sshell-mode) + (setq mode-name "Sshell") + (setq mode-line-process '(": %s")) + (use-local-map sshell-mode-map) + (make-local-variable 'sshell-directory-stack) + (setq sshell-directory-stack nil) + (make-local-variable 'last-input-start) + (setq last-input-start (make-marker)) + (make-local-variable 'last-input-end) + (setq last-input-end (make-marker)) + (run-hooks 'sshell-mode-hook)) + +(if sshell-mode-map + nil + (setq sshell-mode-map (make-sparse-keymap)) + (define-key sshell-mode-map "\t" 'sshell-complete-filename) + (define-key sshell-mode-map "\C-m" 'sshell-send-input) + (define-key sshell-mode-map "\C-c\C-d" 'sshell-send-eof) + (define-key sshell-mode-map "\C-c\C-u" 'kill-sshell-input) + (define-key sshell-mode-map "\C-c\C-w" 'backward-kill-word) + (define-key sshell-mode-map "\C-c\C-c" 'interrupt-sshell-subjob) + (define-key sshell-mode-map "\C-c\C-z" 'stop-sshell-subjob) + (define-key sshell-mode-map "\C-c\C-\\" 'quit-sshell-subjob) + (define-key sshell-mode-map "\C-c\C-o" 'kill-output-from-sshell) + (define-key sshell-mode-map "\C-c\C-r" 'show-output-from-sshell) + (define-key sshell-mode-map "\C-c\C-y" 'copy-last-sshell-input)) + + +(defun sshell-complete-filename () + (interactive) + (let* ((p (point)) tem beg + (ff + (save-excursion + (skip-chars-backward "[a-z---_0-9$/A-Z~#.]") + (buffer-substring (setq beg (point)) p)))) + (setq dir (or (file-name-directory ff) default-directory)) + (setq file (file-name-nondirectory ff)) + (cond ((and (setq tem (file-name-completion (or file "") dir)) + (not (equal tem file))) + (cond ((eq tem t)) + (t + (delete-region beg p) + (insert (concat dir tem))))) + (t + (let ((lis (file-name-all-completions file dir))) + (with-output-to-temp-buffer "*completions*" + (display-completion-list lis)) + ))))) + +(defvar explicit-csh-args + (if (eq system-type 'hpux) + ;; -T persuades HP's csh not to think it is smarter + ;; than us about what terminal modes to use. + '("-i" "-T") + '("-i")) + "Args passed to inferior sshell by M-x sshell, if the sshell is csh. +Value is a list of strings, which may be nil.") + + +(defun sshell () + "Run an inferior sshell, with I/O through buffer *sshell*. +If buffer exists but sshell process is not running, make new sshell. +Program used comes from variable explicit-sshell-file-name, + or (if that is nil) from the ESHELL environment variable, + or else from SHELL if there is no ESHELL. +If a file ~/.emacs_SHELLNAME exists, it is given as initial input + (Note that this may lose due to a timing error if the sshell + discards input when it starts up.) +The buffer is put in sshell-mode, giving commands for sending input +and controlling the subjobs of the sshell. See sshell-mode. +See also variable sshell-prompt-pattern. + +The sshell file name (sans directories) is used to make a symbol name +such as `explicit-csh-arguments'. If that symbol is a variable, +its value is used as a list of arguments when invoking the sshell. +Otherwise, one argument `-i' is passed to the sshell. + +Note that many people's .cshrc files unconditionally clear the prompt. +If yours does, you will probably want to change it." + (interactive) + (let* ((prog (or explicit-sshell-file-name + (getenv "ESHELL") + (getenv "SHELL") + "/bin/sh")) + (name (file-name-nondirectory prog))) + (switch-to-buffer + (apply 'make-sshell "shell" prog + (if (file-exists-p (concat "~/.emacs_" name)) + (concat "~/.emacs_" name)) + (let ((symbol (intern-soft (concat "explicit-" name "-args")))) + (if (and symbol (boundp symbol)) + (symbol-value symbol) + '("-i"))))))) + +(defun make-sshell (name program &optional startfile &rest switches) + (let ((buffer (get-buffer-create (concat "*" name "*"))) + proc status size) + (setq proc (get-buffer-process buffer)) + (if proc (setq status (process-status proc))) + (save-excursion + (set-buffer buffer) + ;; (setq size (buffer-size)) + (if (memq status '(run stop)) + nil + (if proc (delete-process proc)) + (setq proc (apply 'start-process name buffer + (or program explicit-sshell-file-name + (getenv "ESHELL") + (getenv "SHELL") + "/bin/sh") + switches)) + + (cond (startfile + ;;This is guaranteed to wait long enough + ;;but has bad results if the sshell does not prompt at all + ;; (while (= size (buffer-size)) + ;; (sleep-for 1)) + ;;I hope 1 second is enough! + (sleep-for 1) + (goto-char (point-max)) + (insert-file-contents startfile) + (setq startfile (buffer-substring (point) (point-max))) + (delete-region (point) (point-max)) + (process-send-string proc startfile))) + (setq name (process-name proc))) + (goto-char (point-max)) + (set-marker (process-mark proc) (point)) + (sshell-mode)) + buffer)) + +(defvar sshell-set-directory-error-hook 'ignore + "Function called with no arguments when sshell-send-input +recognizes a change-directory command but gets an error +trying to change Emacs's default directory.") + +(defun sshell-send-input () + "Send input to subsshell. +At end of buffer, sends all text after last output + as input to the subsshell, including a newline inserted at the end. +When not at end, copies current line to the end of the buffer and sends it, +after first attempting to discard any prompt at the beginning of the line +by matching the regexp that is the value of sshell-prompt-pattern if possible. +This regexp should start with \"^\"." + (interactive) + (or (get-buffer-process (current-buffer)) + (error "Current buffer has no process")) + (end-of-line) + (if (eobp) + (progn + (move-marker last-input-start + (process-mark (get-buffer-process (current-buffer)))) + (insert ?\n) + (move-marker last-input-end (point))) + (beginning-of-line) + ;; Exclude the sshell prompt, if any. + (re-search-forward sshell-prompt-pattern + (save-excursion (end-of-line) (point)) + t) + (let ((copy (buffer-substring (point) + (progn (forward-line 1) (point))))) + (goto-char (point-max)) + (move-marker last-input-start (point)) + (insert copy) + (move-marker last-input-end (point)))) + ;; Even if we get an error trying to hack the working directory, + ;; still send the input to the subsshell. + (condition-case () + (save-excursion + (goto-char last-input-start) + (sshell-set-directory)) + (error (funcall sshell-set-directory-error-hook))) + (let ((process (get-buffer-process (current-buffer))) + (s (buffer-substring last-input-start last-input-end)) + ) + ;; avoid sending emacs's idea of what an international character + ;; set string is to a subprocess.. + (if (fboundp 'string-make-unibyte) + (setq s (string-make-unibyte s))) + (process-send-string process s) + (set-marker (process-mark process) (point)))) + +;;; If this code changes (sshell-send-input and sshell-set-directory), +;;; the customization tutorial in +;;; info/customizing-tutorial must also change, since it explains this +;;; code. Please let marick@gswd-vms.arpa know of any changes you +;;; make. + + +(defun sshell-set-directory () + (cond ((and (looking-at sshell-popd-regexp) + (memq (char-after (match-end 0)) '(?\; ?\n))) + (if sshell-directory-stack + (progn + (cd (car sshell-directory-stack)) + (setq sshell-directory-stack (cdr sshell-directory-stack))))) + ((looking-at sshell-pushd-regexp) + (cond ((memq (char-after (match-end 0)) '(?\; ?\n)) + (if sshell-directory-stack + (let ((old default-directory)) + (cd (car sshell-directory-stack)) + (setq sshell-directory-stack + (cons old (cdr sshell-directory-stack)))))) + ((memq (char-after (match-end 0)) '(?\ ?\t)) + (let (dir) + (skip-chars-forward "^ ") + (skip-chars-forward " \t") + (if (file-directory-p + (setq dir + (expand-file-name + (substitute-in-file-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^\n \t;") + (point))))))) + (progn + (setq sshell-directory-stack + (cons default-directory sshell-directory-stack)) + (cd dir))))))) + ((looking-at sshell-cd-regexp) + (cond ((memq (char-after (match-end 0)) '(?\; ?\n)) + (cd (getenv "HOME"))) + ((memq (char-after (match-end 0)) '(?\ ?\t)) + (let (dir) + (forward-char 3) + (skip-chars-forward " \t") + (if (file-directory-p + (setq dir + (expand-file-name + (substitute-in-file-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^\n \t;") + (point))))))) + (cd dir)))))))) + +(defun sshell-send-eof () + "Send eof to subsshell (or to the program running under it)." + (interactive) + (process-send-eof)) + +(defun kill-output-from-sshell () + "Kill all output from sshell since last input." + (interactive) + (goto-char (point-max)) + (beginning-of-line) + (kill-region last-input-end (point)) + (insert "*** output flushed ***\n") + (goto-char (point-max))) + +(defun show-output-from-sshell () + "Display start of this batch of sshell output at top of window. +Also put cursor there." + (interactive) + (set-window-start (selected-window) last-input-end) + (goto-char last-input-end)) + +(defun copy-last-sshell-input () + "Copy previous sshell input, sans newline, and insert before point." + (interactive) + (insert (buffer-substring last-input-end last-input-start)) + (delete-char -1)) + +(defun interrupt-sshell-subjob () + "Interrupt this sshell's current subjob." + (interactive) + (interrupt-process nil t)) + +(defun kill-sshell-subjob () + "Send kill signal to this sshell's current subjob." + (interactive) + (kill-process nil t)) + +(defun quit-sshell-subjob () + "Send quit signal to this sshell's current subjob." + (interactive) + (quit-process nil t)) + +(defun stop-sshell-subjob () + "Stop this sshell's current subjob." + (interactive) + (stop-process nil t)) + +(defun kill-sshell-input () + "Kill all text since last stuff output by the sshell or its subjobs." + (interactive) + (kill-region (process-mark (get-buffer-process (current-buffer))) + (point))) +(require 'smart-complete) + +(provide 'sshell) \ No newline at end of file diff --git a/eval.html b/eval.html new file mode 100755 index 0000000..042cde5 --- /dev/null +++ b/eval.html @@ -0,0 +1,106 @@ + + +Tcl Evaluator-In-A-Page + + + + + + +

Tcl Evaluator-in-a-Page

+

[Sun Home | Tcl +Plugin | Demos]

+

+

+

+Below is a little evaluator for Tcl commands. Type any valid Tcl command +in and see the result immediately. Check out our quick tour of the +Tcl syntax. For example, to create a new +button, type the following: +

+button .b -text hello -background red
+pack .b
+
When you're done with the button, type: +
+destroy .b
+
and it's gone. You may also want to use the puts +command to output results from within loops. For example: +
+foreach proc [info procs] {
+    puts "$proc [info args $proc]"
+}
+
+
+ +

+ +

+To learn more about Tcl, read either Brent +Welch'sor John Ousterhout's +Tcl books. Many more Tcl and Tk resources are available here. + + +

Source:

+

+

+

+Here is the source for the evaluator application: +

+
+# A frame, scrollbar, and text
+frame .eval
+set _t [text .eval.t -width 40 -height 15 -yscrollcommand {.eval.s set}]
+scrollbar .eval.s -command {.eval.t yview}
+pack .eval.s -side left -fill y
+pack .eval.t -side right -fill both -expand true
+pack .eval -fill both -expand true
+
+# Insert the prompt and initialize the limit mark
+.eval.t insert insert "Tcl eval log\n"
+set prompt "tcl> "
+.eval.t insert insert $prompt
+.eval.t mark set limit insert
+.eval.t mark gravity limit left
+focus .eval.t
+
+# Keybindings that limit input and eval things
+bind .eval.t <Return> { _Eval .eval.t ; break }
+bind .eval.t <Any-Key> {
+	if [%W compare insert < limit] {
+		%W mark set insert end
+	}
+}
+bindtags .eval.t {.eval.t Text all}
+
+proc _Eval { t } {
+	global prompt
+	set command [$t get limit end]
+	if [info complete $command] {
+		$t insert insert \n
+		set err [catch {uplevel #0 $command} result]
+		if {[string length $result] > 0} {
+		    $t insert insert $result\n
+		}
+		$t insert insert $prompt
+		$t see insert
+		$t mark set limit insert
+		return
+	} else {
+		$t insert insert \n
+	}
+}
+proc puts {args} {
+    if {[string match -nonewline* $args]} {
+	set args [lrange $args 1 end]
+	set nonewline 1
+    }
+    .eval.t insert end [lindex $args end]	;# Ignore file specifier
+    if ![info exists nonewline] {
+	.eval.t insert end \n
+    }
+}
+
+ + + + diff --git a/eval.tcl b/eval.tcl new file mode 100755 index 0000000..85ef6c3 --- /dev/null +++ b/eval.tcl @@ -0,0 +1,79 @@ +# A frame, scrollbar, and text +frame .eval +set _t [text .eval.t -width 40 -height 15 -yscrollcommand {.eval.s set}] +scrollbar .eval.s -command {.eval.t yview} +pack .eval.s -side left -fill y +pack .eval.t -side right -fill both -expand true +pack .eval -fill both -expand true + +# Insert the prompt and initialize the limit mark +.eval.t insert insert "Tcl eval log\n" +set prompt "tcl> " +.eval.t insert insert $prompt +.eval.t mark set limit insert +.eval.t mark gravity limit left +focus .eval.t + +# Keybindings that limit input and eval things +bind .eval.t { _Eval .eval.t ; break } +bind .eval.t { + if [%W compare insert < limit] { + %W mark set insert end + } +} +bind .eval.t { + if {[%W tag nextrange sel 1.0 end] != ""} { + %W delete sel.first sel.last + } elseif [%W compare insert > limit] { + %W delete insert-1c + %W see insert + } + break +} +bindtags .eval.t {.eval.t Text all} + +proc _Eval { t } { + global prompt + set command [$t get limit end] + if [info complete $command] { + $t insert insert \n + $t mark set limit insert + set err [catch {uplevel #0 $command} result] + if {[string length $result] > 0} { + $t insert insert $result\n + } + $t insert insert $prompt + $t see insert + $t mark set limit insert + return + } else { + $t insert insert \n + } +} + +rename puts putsSystem +proc puts args { + if {[llength $args] > 3} { + error "invalid arguments" + } + set newline "\n" + if {[string match "-nonewline" [lindex $args 0]]} { + set newline "" + set args [lreplace $args 0 0] + } + if {[llength $args] == 1} { + set chan stdout + set string [lindex $args 0]$newline + } else { + set chan [lindex $args 0] + set string [lindex $args 1]$newline + } + if [regexp (stdout|stderr) $chan] { + .eval.t mark gravity limit right + .eval.t insert limit $string + .eval.t see limit + .eval.t mark gravity limit left + } else { + putsSystem -nonewline $chan $string + } +} diff --git a/faq b/faq new file mode 100755 index 0000000..2d00d24 --- /dev/null +++ b/faq @@ -0,0 +1,85 @@ + +october 22, 1995 + +=============== +Question: +On my dec alpha-osf1 and irix 5 can i save an image with compiled functions? + +Answer: + +These two systems use the o/fasldlsym.c module, which uses the system +call dl_open to do the loading of object files, from dynamic +libraries. While this provides fast loading of .o files into a +running image we do not know where those objects are located, or how +to save an image once they are loaded. So in short the answer is NO, +not at the moment.. These unixes no longer support the simple old 'ld +-A' option which let one build a .o and read it into memory where one +wanted. + +If you have a large system with a lot of preinitialization code, you COULD build +an image in the same manner the actual lisp itself is built. Ie essentially +add more files to the main link. si::save-system does work, it just wont work +after you dynamically load in .o files. + +I do this for the build of maxima (in version >= maxima-5.1). Look at +the files maxima-5.1/src/{makefile,sysinit.lsp}. Basically you need +to compile your files with the :system-p t flag, so that an init +function for each file based on the file name is produced. Then you +have to arrange for those init functions to be called at startup, then +you save as is done in building the lisp. + +============= +Question: +Are tcl 7.4 and tk 4.0 compatible with gcl 2.2. + +Answer: Not really. Some things will work but others wont. The demos +in the demos directory certainly wont all work, they are based on tk +3.6. They presumably could be rewritten based on their newer +counterparts. I do not know of what other changes are necessary... +In some sense the separation between gcl and tcl/tk is fairly complete +so in PRINCIPLE the changes required should only be those to user +code, caused by changes to the tk library. One would need to add +perhaps some new calls to def-widget, eg in tkl.lisp adding + +(def-widget listbox) + +if 'listbox' were a new widget type. + +(def-control send) +(def-control raise) + +if 'send' or 'control' were new functions.. + +Also one should update the gcl-tk info stuff from the using +gcl-2.2/elisp/man1-to-texi.el you can also use + +You can use gcl-2.2/gcl-tk/convert.el as a start on using emacs to +convert other (tcl/tk 4.0) code to lisp, to have their new demos in lisp +for testing purposes. + +============ +Question: Is there a port to mach 10 on the mac. + +Answer: +Not yet. This would be good.. Emacs is ported there. I dont know if it +saves itself however...i had heard it does not. I believe they are using the +macintosh native executable format.... + +=========== + + + + + + + + + + + + + + + + + diff --git a/gcl-tk/comm.c b/gcl-tk/comm.c new file mode 100755 index 0000000..7ac93a6 --- /dev/null +++ b/gcl-tk/comm.c @@ -0,0 +1,283 @@ + +#include + + +#ifndef NO_DEFUN +#ifndef DEFUN +#define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,doc) ret fname +#endif +#endif + + +#ifndef HZ +#define HZ 60 +#endif + +#ifndef SET_TIMEVAL +#define SET_TIMEVAL(t,timeout) \ + t.tv_sec = timeout/HZ; t.tv_usec = (int) ((timeout%HZ)*(1000000.0)/HZ) +#endif + + +DEFUN_NEW("CHECK-FD-FOR-INPUT",object,fScheck_fd_for_input, + SI,2,2,NONE,OI,IO,OO,OO,(fixnum fd,fixnum timeout), + +"Check FD a file descriptor for data to read, waiting TIMEOUT clicks \ +for data to become available. Here there are \ +INTERNAL-TIME-UNITS-PER-SECOND in one second. Return is 1 if data \ +available on FD, 0 if timeout reached and -1 if failed.") +{ + fd_set inp; + int n; + struct timeval t; + + SET_TIMEVAL(t,timeout); + FD_ZERO(&inp); + FD_SET(fd, &inp); + n = select(fd + 1, &inp, NULL, NULL, &t); + if (n < 0) + return make_fixnum1(-1); + else if (FD_ISSET(fd, &inp)) + return make_fixnum1(1); + else + return make_fixnum1(0); +} +#ifdef STATIC_FUNCTION_POINTERS +object +fScheck_fd_for_input(fixnum fd,fixnum timeout) { + return FFN(fScheck_fd_for_input)(fd,timeout); +} +#endif + + + +#define MAX_PACKET 1000 +#define MUST_CONFIRM 2000 +#define OUR_SOCK_MAGIC 0206 + + +/* Each write and read will be of a packet including information about + how many we have read and written. + Sometimes we must read more messages, in order to check whether + the one being sent has info about bytes_received. + */ + + + + +struct connection_state * +setup_connection_state(int fd) +{ struct connection_state * res; + res = (void *)malloc(sizeof(struct connection_state)); + bzero(res,sizeof(struct connection_state)); + res->fd = fd; + res->read_buffer_size = READ_BUFF_SIZE; + res->read_buffer = (void *)malloc(READ_BUFF_SIZE); + res->valid_data = res->read_buffer; + res->max_allowed_in_pipe = MAX_ALLOWED_IN_PIPE; + res->write_timeout = 30* 100; + return res; +} + +/* P is supposed to start with a hdr and run N bytes. */ +static void +scan_headers(sfd) + struct connection_state *sfd; +{ struct our_header *hdr; + char *p = sfd->valid_data + sfd->next_packet_offset; + int n = sfd->valid_data_size - sfd->next_packet_offset; + int length,received; + while (n >= HDR_SIZE) + { hdr = (void *)p; + if (hdr->magic != OUR_SOCK_MAGIC) + abort(); + GET_2BYTES(&hdr->received, received); + STORE_2BYTES(&hdr->received, 0); + sfd->bytes_sent_not_received -= received; + GET_2BYTES(&hdr->length, length); + p += length; + n -= length; + } +} + +static int +write1(struct connection_state *,const char *,int); + + +static void +send_confirmation(struct connection_state *sfd) +{ write1(sfd,0,0); +} + + +/* read from SFD to buffer P M bytes. Allow TIMEOUT + delay while waiting for data to arrive. + return number of bytes actually read. + The data arrives on the pipe packetized, but is unpacketized + by this function. It gets info about bytes that have + been received by the other process, and updates info in the state. + +*/ + +static int +read1(sfd,p,m,timeout) +struct connection_state* sfd; +char *p; +int timeout; +int m; +{ int nread=0; + int wanted = m; + int length; + struct our_header *hdr; + if (wanted == 0) + goto READ_SOME; + TRY_PACKET: + if (sfd->next_packet_offset > 0) + { int mm = (sfd->next_packet_offset >= wanted ? wanted : + sfd->next_packet_offset); + { bcopy(sfd->valid_data,p,mm); + p += mm; + sfd->valid_data+= mm; + sfd->valid_data_size -= mm; + sfd->next_packet_offset -= mm; + + } + wanted -= mm; + if (0 == wanted) return m; + + } + /* at beginning of a packet */ + + if (sfd->valid_data_size >= HDR_SIZE) + { hdr = (void *) sfd->valid_data; + GET_2BYTES(&hdr->length,length); + } + else goto READ_SOME; + if (length > sfd->valid_data_size) + goto READ_SOME; + /* we have a full packet available */ + {int mm = (wanted <= length - HDR_SIZE ? wanted : length - HDR_SIZE); + /* mm = amount to copy */ + { bcopy(sfd->valid_data+HDR_SIZE,p,mm); + p += mm; + sfd->valid_data+= (mm +HDR_SIZE); + sfd->valid_data_size -= (mm +HDR_SIZE); + sfd->next_packet_offset = length - (mm + HDR_SIZE); + wanted -= mm; + } + if (0 == wanted) return m; + goto TRY_PACKET; + } + + READ_SOME: + if (sfd->read_buffer_size - sfd->valid_data_size < MAX_PACKET) + { char *tmp ; + tmp = (void *) malloc(2* sfd->read_buffer_size); + if (tmp == 0) error("out of free space"); + bcopy(sfd->valid_data,tmp,sfd->valid_data_size); + free(sfd->read_buffer); + sfd->valid_data = sfd->read_buffer = tmp; + sfd->read_buffer_size *= 2; + } + if(sfd->read_buffer_size - (sfd->valid_data - sfd->read_buffer) < MAX_PACKET) + { bcopy(sfd->valid_data,sfd->read_buffer,sfd->valid_data_size); + sfd->valid_data=sfd->read_buffer;} + /* there is at least a packet size of space available */ + if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0)) + again: + {char *start = sfd->valid_data+sfd->valid_data_size; + nread = SAFE_READ(sfd->fd,start, + sfd->read_buffer_size - (start - sfd->read_buffer)); + } + if (nread<0) + {if (errno == EAGAIN) goto again; + return -1;} + if (nread == 0) + { + return 0; + } + sfd->total_bytes_received += nread; + sfd->bytes_received_not_confirmed += nread; + sfd->valid_data_size += nread; + if(sfd->bytes_received_not_confirmed > MUST_CONFIRM) + send_confirmation(sfd); + scan_headers(sfd); + goto TRY_PACKET; + } + + +/* send BYTES chars from buffer P to CONNECTION. + They are packaged up with a hdr */ + +static void +write_timeout_error(char *); + +static void +connection_failure(char *); + +int +write1(sfd,p,bytes) + struct connection_state *sfd; + const char *p; + int bytes; +{ + int bs; + int to_send = bytes; + BEGIN: + bs = sfd->bytes_sent_not_received; + if (bs > sfd->max_allowed_in_pipe) + {read1(sfd,0,0,sfd->write_timeout); + if (bs > sfd->bytes_sent_not_received) + goto BEGIN; + write_timeout_error(""); + } + {struct our_header *hdr; + char buf[MAX_PACKET]; + int n_to_send = + (bytes > MAX_PACKET -HDR_SIZE ? MAX_PACKET : bytes+HDR_SIZE); + hdr = (void *) buf; + STORE_2BYTES(&hdr->length, n_to_send); + hdr->magic = OUR_SOCK_MAGIC; + STORE_2BYTES(&hdr->received, sfd->bytes_received_not_confirmed); + sfd->bytes_received_not_confirmed =0; + sfd->bytes_sent_not_received += n_to_send; + bcopy(p, buf+HDR_SIZE,n_to_send - HDR_SIZE); + + AGAIN: + { int n = write(sfd->fd,buf,n_to_send); + if (n == n_to_send); + else if (n < 0) + { if (errno == EAGAIN) + { goto AGAIN; + } + else connection_failure(""); + } + else abort(); + } + p += (n_to_send -HDR_SIZE); + bytes -= (n_to_send -HDR_SIZE); + if (bytes==0) return to_send; + goto BEGIN; + } + +} + +DEFUN_NEW("CLEAR-CONNECTION",object,fSclear_connection,SI,1,1,NONE,OI,OO,OO,OO,(fixnum fd), + "Read on FD until nothing left to read. Return number of bytes read") +{char buffer[0x1000]; + int n=0; + while (fix(FFN(fScheck_fd_for_input)(fd,0))) + { n+=read(fd,buffer,sizeof(buffer)); + } + + return make_fixnum1(n); +} +#ifdef STATIC_FUNCTION_POINTERS +object +fSclear_connection(fixnum fd) { + return FFN(fSclear_connection)(fd); +} +#endif + + + diff --git a/gcl-tk/convert.el b/gcl-tk/convert.el new file mode 100755 index 0000000..db8ccf3 --- /dev/null +++ b/gcl-tk/convert.el @@ -0,0 +1,246 @@ + +(defun try () + (interactive) + (goto-char (point-min)) + (if (looking-at "#") (insert ";;")) + (grab-variables) + (goto-char (point-min)) + + (do-replacements '(("\n\\([ \t]*\\)#" "\n\\1;;") + ("catch {destroy $w}" + "(if (winfo :exists w) (destroy w))") + ("\\[tk colormodel [$]w\\] == \"color\"" + "equal (tk :colormodel w) \"color\"") + )) + (goto-char (point-min)) + (replace-proc) + (goto-char (point-min)) + (replace-if) + (goto-char (point-min)) + + (separate-lines) + (goto-char (point-min)) + (replace-keywords) + (do-replacements '(("@[$]tk_library\\([^ \t\n]+\\)" + "\"@\" : *tk-library* : \"\\1\""))) + (goto-char (point-min)) + + (replace-$-in-string) + (goto-char (point-min)) + (do-replacements *replacements*) + (goto-char (point-min)) + (do-replacements '(( "[$]\\([a-z0-9A-Z]+\\)\\([)} \n]\\)" "\\1\\2"))) + (do-replacements + '(( " \\([0-9][0-9.]*[cmpi]\\)" " \"\\1\"") + ("\\(:create\\|:tag\\|:add\\|:scan\\:select\\:mark\\) \\([a-z]\\)" + "\\1 :\\2") +; (":add \\([a-z]\\)" ":add '\\1") + + )) + + (do-replacements '(("\\([ \t]\\)[.]\\([a-z0-9A-Z.]*\\)" "\\1'.\\2") + ("'[.] " "'|.| ") + ("((conc " "(funcall (conc ")) + t) + ) + +(defun grab-variables () + (let (tem) + (setq the-variables nil) + (while (re-search-forward "[$]\\([a-zA-Z0-9]+\\)" nil t) + (setq tem (buffer-substring (match-beginning 1) (match-end 1))) + (or (member tem the-variables) + (setq the-variables (cons tem the-variables)))))) + +(defun separate-lines () + (interactive) + (while (re-search-forward "\n[ \t]*[^;#() \n]" nil t) + (forward-char -1) + (cond ((or (looking-at "}") + (looking-at "for"))) + (t + ; (forward-sexp -1) + (insert "(") + (re-search-forward "[^\\]\n" nil t) + (forward-char -1)(insert ")") + )))) + +(defun replace-keywords () + (interactive) + (while (re-search-forward "\\([ \t]\\)-\\([a-zA-Z]\\)" nil t) + (replace-match "\\1:\\2") + (forward-sexp 1) + (skip-chars-forward " ") + (cond ((looking-at "[a-z]") + (insert "\"")(forward-sexp 1) + (insert "\"")))) + (goto-char (point-min)) + (while (re-search-forward "(\\([^ ]+\\)" nil t) + (let ((tem (buffer-substring (match-beginning 1)(match-end 0)))) +; (message (princ tem)) (sit-for 1) + (cond ((equal tem "defun")(forward-line 1)(beginning-of-line)) + ((member tem '("defun" "set"))) + (t + (skip-chars-forward " ") + (cond ((looking-at "[a-z]") + (insert ":")))))))) + + +(defvar the-variables nil) + + +(defun replace-$-in-string () + (interactive) + (let (tem beg (end (make-marker ))) + (while + (re-search-forward "\\([^\\]\\)[$]\\([a-zA-Z0-9]+\\)" nil t) + (forward-char -1) + (cond ((in-a-string) + (goto-char this-string-began ) + (setq beg (point)) + (insert "(tk-conc ") + (setq beg (point)) + (forward-sexp 1) + (set-marker end (point)) + (insert ")") + (goto-char beg) + (while + (re-search-forward "\\([^\\]\\)[$]\\([a-zA-Z0-9]+\\)" end t) + (replace-match "\\1\" \\2 \"")) + (goto-char (- beg 2)) + (while (re-search-forward " \"\"" end t) + (replace-match "")) + (set-marker end nil) + )) + + ))) + + + + + + + +(defun change-{-to-paren () + (interactive) + (let (end) + (cond ((search-forward "{" nil t) + (forward-char -1) + (let ((p (point))) + (forward-sexp 1) + (delete-region (- (point) 1)(point)) + (insert ")") + (setq end (point)) + (goto-char p) + (delete-region p (+ p 1)) + (insert "(")) + (goto-char end) + t)))) + + +(defun in-a-string () + (interactive) + (save-excursion + (save-match-data + (let ((p (point)) (c 0)) + (beginning-of-line) + (while (re-search-forward "[^\\]\"" p t) + (setq this-string-began (+ 1 (match-beginning 0))) + (setq c (+ c 1))) + (eql 1 (mod c 2)))))) + + +(defun replace-proc () + (interactive) + (while (re-search-forward "[ \t\n]\\(proc\\) " nil t) + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1) + (match-end 0)) + (insert "(defun ") + (forward-sexp 1) + (skip-chars-forward " \n\t") + (cond + ((looking-at "{{") + (change-{-to-paren) + (forward-sexp -1) + (forward-char 1) + (insert "&optional ") + (change-{-to-paren)) + ((looking-at "{") + (change-{-to-paren))) + (change-{-to-paren) + (forward-sexp -1) + (delete-char 1))) + +(defun replace-if () + (interactive) + (while (re-search-forward "[ \t\n]\\(if\\) " nil t) + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1) + (match-end 0)) + (insert "(if ") + (skip-chars-forward " \n\t") + (cond + ((looking-at "{") + (change-{-to-paren))) + (skip-chars-forward " \n\t") + (cond + ((looking-at "{") + (change-{-to-paren) + (save-excursion + (forward-sexp -1) + (forward-char 1) (insert "progn ")))) + (skip-chars-forward " \n\t") + (cond + ((looking-at "else") + (replace-match ";;else \n") + (skip-chars-forward " \n\t") + (cond + ((looking-at "{") + (change-{-to-paren) + (save-excursion + (forward-sexp -1) + (forward-char 1) (insert "progn ")))) + (insert ")") + )))) + +(setq *replacements* + '( + ("[$]\\([a-zA-Z0-9]+\\)[.][$]\\([a-zA-Z0-9]+\\)[.]\\([a-z0-9A-Z.]+\\)" + "(conc \\1 '|.| \\2 '.\\3)") + ("[$]\\([a-zA-Z0-9]+\\)[.][$]\\([a-zA-Z0-9)]+\\)" + "(conc \\1 '|.| \\2)") + ("[$]\\([a-zA-Z0-9]+\\)[.]\\([a-z0-9A-Z.)]+\\)" "(conc \\1 '.\\2\)") + ("\\(<[a-z0-9A-Z---]+>\\)" "\"\\1\"") + ("[[]expr \\([a-z$A-Z0-9]+\\)\\([ ]*[+---*][ ]*\\)\\([a-z$A-Z0-9]+\\)\\]" + "(\\2 \\1 \\3)") + ("[[]expr \\([a-z$A-Z0-9]+\\)\\]" "\\1") + ("($\\([a-z0-9A-Z]+\\)[.]\\([a-z0-9A-Z.]+\\)" "(funcall (conc \\1 '.\\2)") + ("($\\([a-z0-9A-Z]+\\)" "(funcall \\1") + ("[[]$\\([a-z0-9A-Z]+\\)\\([^]]+\\)\\]" "(funcall \\1\\2)") + ("[{]$\\([a-z0-9A-Z]+\\)\\([^}]+\\)\\}" "(funcall \\1\\2)") + ("[\\]\n" "\n") + ("\n\\([ \t]*\\)#" "\n\\1;") + ("(set " "(setq ") + ("tk_menuBar" "tk-menu-bar") + ("@\\([$a-zA-Z0-9]+\\),\\([$a-zA-Z0-9]+\\)" "(aT \\1 \\2)") + ("\\(:variable\\)[ ]+\"\\([a-zA-Z0-9]+\\)\"" "\\1 '\\2") + ("\\(:textvariable\\)[ ]+\"\\([a-zA-Z0-9]+\\)\"" "\\1 '\\2") + (":font -" ":font :") + (":create \\([a-z]+\\)" ":create \"\\1\"") + )) + + +(defun do-replacements (lis &optional not-in-string) + (let (x) + (while lis + (setq x (car lis)) (setq lis (cdr lis)) + (goto-char (point-min)) + (while (re-search-forward (nth 0 x) nil t) + (and not-in-string + (progn (forward-char -1) + (not (in-a-string)))) + (replace-match (nth 1 x) t))))) + + + diff --git a/gcl-tk/decode.tcl b/gcl-tk/decode.tcl new file mode 100644 index 0000000..66b696d --- /dev/null +++ b/gcl-tk/decode.tcl @@ -0,0 +1,321 @@ +# this file contains the protocol for receiving connections from GCL and +# other lisps [or other languages] +# The communication is via a socket, and the data is packaged up into +# packets, which we track letting the other side know how much is actually +# received. This protocol is to prevent problems with flooding a +# communications channel. The sender knows how many bytes are in the pipe. +# the outer wrapper is +# { char magic; +# unsigned short length; /* including the header */ +# unsigned short received; /* incremental number of bytes received at the +# other end of the channel */ +# + +# (MAGIC1 MAGIC2 TYPE FLAG BODY-LENGTH NIL NIL MSG-INDEX NIL NIL) + + + +set GclMTypes { m_not_used + m_create_command + m_reply + m_call + m_tcl_command + m_tcl_command_wait_response + m_tcl_clear_connection + m_tcl_link_text_variable + m_set_lisp_loc + m_tcl_set_text_variable + m_tcl_unlink_text_variable} + + +proc GclDecodeMsg { msg } { + +# char magic1; \06 +# char magic2; 'A' +# char type; m_* +# unsigned char flag; +# unsigned char size[3]; /* of body */ +# unsigned char msg_id[3]; +# char body[1]; + + global GclMTypes + if { [string match "\06A*" $msg] } { + binary scan [string range $msg 2 end] ccsc type flag bodyLo bodyHi + set bodyLength [expr ($bodyLo & 0xffff)+ ($bodyHi >> 16)] + set index [msgIndex $msg] + set ans "xMsg-id=$index, type= [lindex $GclMTypes $type], length=$bodyLength, body=[string range $msg 10 [expr 10 + $bodyLength-1]]" + } else {set ans "invalidmsg:<$msg>" } +} + +#proc GclmsgIndex { msg } { +# binary scan [string range $msg 7 9] sc indLo indHi +# set index [expr ($indLo & 0xffff)+ ($indHi >> 16)] +# return $index +#} + +proc Gclget3Bytes { s } { + binary scan $s "sc" lo hi + return [expr { ($lo & 0xffff) + ($hi << 16) }] +} + +proc GclMake3Bytes { n } { + return [ string range [binary format i $n] 0 2] +} + +proc debugSend { msg } { + puts stderr $msg + flush stderr +} +proc GclAnswerSocket { host port pid } { + global GclSock GclPdata GclPacket + set sock [socket $host $port] + setupPacket $sock + fconfigure $sock -blocking 0 -translation {binary binary} + # debugSend fconfigure:$sock:[fconfigure $sock] + set GclSock $sock + catch { unset GclPdata(data,$sock) } + fileevent $sock readable "GclReadAndAct1 $sock" + set GclPdata(pid,$sock) $pid + return $sock +} + +proc setupPacket { sock } { + global GclPacket + # data including 5 byte headers + set GclPacket(indata,$sock) "" + set GclPacket(received,$sock) 0 + set GclPacket(sent_not_received,$sock) 0 + # the data after stripping headers + set GclPacket(outdata,$sock) "" +} + + +proc GclRead1 { sock } { + global GclPacket + upvar #0 GclPacket(indata,$sock) indata + set recd 0 + append indata [read $sock] + set ll 0 + while { [set l [string length $indata]] >= 5 } { + binary scan $indata "css" magic length received + # debugSend "magic=$magic,length=$length,received:=$received,indata=$indata" + # -122 = signedchar(0206) + if { $magic != -122 } { + error "bad magic" + } + # debugSend "test: $l >= $length + 5" + if { $l >= $length } { + append GclPacket(outdata,$sock) [string range $indata 5 [expr $length -1]] + set indata [string range $indata $length end] + incr recd $received + incr ll $length + } else { break + } + + } + incr GclPacket(received,$sock) $ll + if { $recd } { + incr GclPacket(sent_not_received,$sock) -$recd + } + if { $GclPacket(received,$sock) > 1500 } { + sendReceiveConfirmation $sock + } + set res $GclPacket(outdata,$sock) + set GclPacket(outdata,$sock) "" + # debugSend "GclRead1--><$res>" + return $res +} + + +proc sendReceiveConfirmation { sock } { + GclWrite1 $sock "" +} + +proc GclWrite1 { sock data } { + global GclPacket + # debugSend "entering GclWrite1" + set length [expr 5 + [string length $data]] + set hdr \206[binary format ss $length $GclPacket(received,$sock)] + # debugSend "hdr=$hdr, [array get GclPacket *]" + set GclPacket(received,$sock) 0 + incr GclPacket(sent_not_received,$sock) $length + #debugSend "GclWrite1:<$hdr$data>" + puts -nonewline $sock $hdr$data + flush $sock +} + +proc GclReadAndAct1 { sock } { + global GclPdata GclMTypes + upvar #0 GclPdata(data,$sock) msg + set read [GclRead1 $sock] + + if { [string length $read] == 0 } { + if { [eof $sock] } { + # debugSend "exitting since $sock is closed" + exit 1 + } + return "" + + } + + append msg $read + while { [set l [string length $msg]] >= 10 } { + #debugSend "msg=<$msg>" + #debugSend [GclDecodeMsg $msg] + binary scan $msg sccsc magic type flag bodyLo bodyHi + if { $magic != 16646 } { + error "bad magic:[string range $msg 0 1]" + } + set bodyLength [expr ($bodyLo & 0xffff)+ ($bodyHi >> 16)] + if { $l >= 10+$bodyLength } { + set toeval [list [lindex $GclMTypes $type] $msg [string range $msg 10 [expr 10 + $bodyLength-1]]] + set msg [string range $msg [expr 10 + $bodyLength] end] + #debugSend toeval=$toeval + if { [catch { eval $toeval } err] } { + puts stderr "error in [lindex $toeval 0] [string range [lindex $toeval 1 ] 0 13]... [lindex $toeval 2]: $err" + flush stderr + } + } + } +} + + + + +proc GclGetCString {s } { + return [string range $s 0 [expr [string first \0 $s] -1]] +} + +set GclSockMsgId 0 + +proc sock_write_str {typeflag text } { + global GclSock GclSockMsgId + set msg "\06A$typeflag[GclMake3Bytes [string length $text]][GclMake3Bytes [incr GclSockMsgId]]$text" + #debugSend sending:[GclDecodeMsg $msg] + GclWrite1 $GclSock $msg + +} + +proc GclGenericCommand { n arg } { + global GclSock + # 2 == [lsearch $GclMTypes m_reply] + sock_write_str "\3\0" "[GclMake3Bytes $n]$arg" + signalParent $GclSock +} + +proc GclGenericCommandStringify { n arglist lis } { + global GclSock + set i 0 + set ans "[GclMake3Bytes $n](" + foreach v $lis { + if { "s" == "[string range $arglist $i $i]" } { + append ans " \"" $v "\"" + } else { append ans " " $v + } + } + append ans ")" + sock_write_str "\3\0" $ans + signalParent $GclSock +} + + +proc m_create_command { msg body } { + #debugSend "in m_create_command" + set n [Gclget3Bytes $body] + set arglist [GclGetCString [string range $body 3 end]] +# "debugSend callback_$n:args=\$args ; GclGenericCommandStringify $n $arglist \$args" \ + + if { "$arglist" == "" } { + proc callback_$n { { arg1 "" } } "GclGenericCommand $n \$arg1" + } else { + proc callback_$n { args } "GclGenericCommandStringify $n $arglist \$args" + } + +} + + +proc m_tcl_command { msg body } { + + set body [string trimright $body "\0"] + # set body [GclGetCString $body] + # set fail [catch { eval $body } res] + # set fail [catch { eval $body } res] + eval $body + # set com "update idletasks" + #after cancel $com + #after 5 $com + # update idletasks + # puts stderr "doing $body" ; flush stderr + # debugSend "in eval of <$body>: fail=$fail,res=<$res>" +} + +proc m_tcl_command_wait_response { msg body } { + global GclSock + set body [string trimright $body "\0"] +# set body [GclGetCString $body] + set fail [catch { eval $body } res] + # 2 == [lsearch $GclMTypes m_reply] + sock_write_str "\2\0" "$fail[string range $msg 7 9]$res" + # debugSend " signalParent $GclSock" + # no need to signal other side is waiting. + # signalParent $GclSock +} + +proc m_tcl_clear_connection { msg body } { + global GclSock + flush $GclSock + set GclPdata($GclSock,data) "" +} + +proc m_tcl_set_text_variable { msg body } { + set n [string first \0 $body] + set [string range $body 0 [expr $n -1]] [string range $body [expr $n+1] end] +} + +proc m_tcl_link_text_variable { msg body } { + global GclPdata + set i [Gclget3Bytes $body] + set name [string range $body 3 end] + uplevel #0 trace variable wu $name "GclTellLispVarChanged $i" +} + +proc signalParent1 {sock } { + global GclPdata GclPacket + if { $GclPacket(sent_not_received,$sock) } { + exec kill -s SIGUSR1 $GclPdata(pid,$sock) & + } +} + + +proc signalParent {sock } { + global delay + set com "signalParent1 $sock" + after cancel $com + after 5 $com +} + + +proc GclTellLispVarChanged { i name1 name2 op } { + global GclPdata + upvar #0 $name1 val + # 8 == [lsearch $GclMTypes m_set_lisp_loc] + sock_write_str \8\0 "[GclMake3Bytes $i]$val" + signalParent $GclSock + +} + +proc m_tcl_unlink_text_variable { msg body } { + set i [Gclget3Bytes $body] + set name [string range $body 3 end] + trace vdelete $name wu "GclTellLispVarChanged $i" +} + + + + + + + + + + diff --git a/gcl-tk/demos-4.1/items.lisp b/gcl-tk/demos-4.1/items.lisp new file mode 100755 index 0000000..a9d8b6e --- /dev/null +++ b/gcl-tk/demos-4.1/items.lisp @@ -0,0 +1,305 @@ +;;# items.lisp -- This demo has been converted for tk4.1 from the +;; corresponding tcl demo program. +;; +;; This demonstration script creates a canvas that displays the +;; canvas item types. +;; +;; @(#) :items.tcl 1.5 95/10/04 15:00:39 + +(defun positionwindow (w) + (wm :geometry w "+60+25") +) +(setq w '.items) +(if (winfo :exists w) (destroy w)) +(toplevel w) +(wm :title w "Canvas Item Demonstration") +(wm :iconname w "Items") +(positionWindow w) +(setq c (conc w '.frame.c)) +(setq font :Adobe-times-medium-r-normal--*-180* ) +(label (conc w '.msg) :font font :wraplength "5i" :justify "left" :text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area.") +(pack (conc w '.msg) :side "top") + +(frame (conc w '.buttons)) +(pack (conc w '.buttons) :side "bottom" :expand "y" :fill "x" :pady "2m") +(button (conc w '.buttons.dismiss) :text "Dismiss" :command (tk-conc "destroy " w)) +(button (conc w '.buttons.code) :text "See Code" :command (tk-conc "showCode " w)) +(pack (conc w '.buttons.dismiss) (conc w '.buttons.code) :side "left" :expand 1) + +(frame (conc w '.frame)) +(pack (conc w '.frame) :side "top" :fill "both" :expand "yes") + +(canvas c :scrollregion "0c 0c 30c 24c" :width "15c" :height "10c" + :relief "sunken" :borderwidth 2 + :xscrollcommand (tk-conc w ".frame.hscroll set") + :yscrollcommand (tk-conc w ".frame.vscroll set")) +(scrollbar (conc w '.frame.vscroll) :command (tk-conc c " yview")) +(scrollbar (conc w '.frame.hscroll) :orient "horiz" :command (tk-conc c " xview")) +(pack (conc w '.frame.hscroll) :side "bottom" :fill "x") +(pack (conc w '.frame.vscroll) :side "right" :fill "y") +(pack c :in (conc w '.frame) :expand "yes" :fill "both") + +;; Display a 3x3 rectangular grid. + +(funcall c :create "rect" "0c" "0c" "30c" "24c" :width 2) +(funcall c :create "line" "0c" "8c" "30c" "8c" :width 2) +(funcall c :create "line" "0c" "16c" "30c" "16c" :width 2) +(funcall c :create "line" "10c" "0c" "10c" "24c" :width 2) +(funcall c :create "line" "20c" "0c" "20c" "24c" :width 2) + +(setq font1 :Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*) +(setq font2 :Adobe-Helvetica-Bold-R-Normal--*-240-*-*-*-*-*-*) +(if (> (winfo :depth c :return 'number) 1) (progn + (setq blue "DeepSkyBlue3") + (setq red "red") + (setq bisque "bisque3") + (setq green "SeaGreen3") +) ;;else + (progn + (setq blue "black") + (setq red "black") + (setq bisque "black") + (setq green "black") +)) + +;; Set up demos within each of the areas of the grid. + +(funcall c :create "text" "5c" '.2c :text "Lines" :anchor "n") +(funcall c :create "line" "1c" "1c" "3c" "1c" "1c" "4c" "3c" "4c" :width "2m" :fill blue + :cap "butt" :join "miter" :tags "item") +(funcall c :create "line" "4.67c" "1c" "4.67c" "4c" :arrow "last" :tags "item") +(funcall c :create "line" "6.33c" "1c" "6.33c" "4c" :arrow "both" :tags "item") +(funcall c :create "line" "5c" "6c" "9c" "6c" "9c" "1c" "8c" "1c" "8c" "4.8c" "8.8c" "4.8c" "8.8c" "1.2c" + "8.2c" "1.2c" "8.2c" "4.6c" "8.6c" "4.6c" "8.6c" "1.4c" "8.4c" "1.4c" "8.4c" "4.4c" + :width 3 :fill red :tags "item") +(funcall c :create "line" "1c" "5c" "7c" "5c" "7c" "7c" "9c" "7c" :width '.5c + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" + :arrow "both" :arrowshape "15 15 7" :tags "item") +(funcall c :create "line" "1c" "7c" "1.75c" "5.8c" "2.5c" "7c" "3.25c" "5.8c" "4c" "7c" :width '.5c + :cap "round" :join "round" :tags "item") + +(funcall c :create "text" "15c" '.2c :text "Curves (smoothed :lines)" :anchor "n") +(funcall c :create "line" "11c" "4c" "11.5c" "1c" "13.5c" "1c" "14c" "4c" :smooth "on" + :fill blue :tags "item") +(funcall c :create "line" "15.5c" "1c" "19.5c" "1.5c" "15.5c" "4.5c" "19.5c" "4c" :smooth "on" + :arrow "both" :width 3 :tags "item") +(funcall c :create "line" "12c" "6c" "13.5c" "4.5c" "16.5c" "7.5c" "18c" "6c" + "16.5c" "4.5c" "13.5c" "7.5c" "12c" "6c" :smooth "on" :width "3m" :cap "round" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :fill red :tags "item") + +(funcall c :create "text" "25c" '.2c :text "Polygons" :anchor "n") +(funcall c :create "polygon" "21c" "1.0c" "22.5c" "1.75c" "24c" "1.0c" "23.25c" "2.5c" + "24c" "4.0c" "22.5c" "3.25c" "21c" "4.0c" "21.75c" "2.5c" :fill green + :outline "black" :width 4 :tags "item") +(funcall c :create "polygon" "25c" "4c" "25c" "4c" "25c" "1c" "26c" "1c" "27c" "4c" "28c" "1c" + "29c" "1c" "29c" "4c" "29c" "4c" :fill red :smooth "on" :tags "item") +(funcall c :create "polygon" "22c" "4.5c" "25c" "4.5c" "25c" "6.75c" "28c" "6.75c" + "28c" "5.25c" "24c" "5.25c" "24c" "6.0c" "26c" "6c" "26c" "7.5c" "22c" "7.5c" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" + :outline "black" :tags "item") + +(funcall c :create "text" "5c" "8.2c" :text "Rectangles" :anchor "n") +(funcall c :create "rectangle" "1c" "9.5c" "4c" "12.5c" :outline red :width "3m" :tags "item") +(funcall c :create "rectangle" "0.5c" "13.5c" "4.5c" "15.5c" :fill green :tags "item") +(funcall c :create "rectangle" "6c" "10c" "9c" "15c" :outline "" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :fill blue :tags "item") + +(funcall c :create "text" "15c" "8.2c" :text "Ovals" :anchor "n") +(funcall c :create "oval" "11c" "9.5c" "14c" "12.5c" :outline red :width "3m" :tags "item") +(funcall c :create "oval" "10.5c" "13.5c" "14.5c" "15.5c" :fill green :tags "item") +(funcall c :create "oval" "16c" "10c" "19c" "15c" :outline "" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :fill blue :tags "item") + +(funcall c :create "text" "25c" "8.2c" :text "Text" :anchor "n") +(funcall c :create "rectangle" "22.4c" "8.9c" "22.6c" "9.1c") +(funcall c :create "text" "22.5c" "9c" :anchor "n" :font font1 :width "4c" + :text "A short string of text, word-wrapped, justified left, and anchored north (at :the top). The rectangles show the anchor points for each piece of text." :tags "item") +(funcall c :create "rectangle" "25.4c" "10.9c" "25.6c" "11.1c") +(funcall c :create "text" "25.5c" "11c" :anchor "w" :font font1 :fill blue + :text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." + :justify "center" :tags "item") +(funcall c :create "rectangle" "24.9c" "13.9c" "25.1c" "14.1c") +(funcall c :create "text" "25c" "14c" :font font2 :anchor "c" :fill red :stipple "gray50" + :text "Stippled characters" :tags "item") + +(funcall c :create "text" "5c" "16.2c" :text "Arcs" :anchor "n") +(funcall c :create "arc" "0.5c" "17c" "7c" "20c" :fill green :outline "black" + :start 45 :extent 270 :style "pieslice" :tags "item") +(funcall c :create "arc" "6.5c" "17c" "9.5c" "20c" :width "4m" :style "arc" + :outline blue :start -135 :extent 270 + :outlinestipple "@" : *tk-library* : "/demos/images/gray25.bmp" :tags "item") +(funcall c :create "arc" "0.5c" "20c" "9.5c" "24c" :width "4m" :style "pieslice" + :fill "" :outline red :start 225 :extent -90 :tags "item") +(funcall c :create "arc" "5.5c" "20.5c" "9.5c" "23.5c" :width "4m" :style "chord" + :fill blue :outline "" :start 45 :extent 270 :tags "item") + +(funcall c :create "text" "15c" "16.2c" :text "Bitmaps" :anchor "n") +(funcall c :create "bitmap" "13c" "20c" :bitmap "@" : *tk-library* : "/demos/images/face.bmp" :tags "item") +(funcall c :create "bitmap" "17c" "18.5c" + :bitmap "@" : *tk-library* : "/demos/images/noletter.bmp" :tags "item") +(funcall c :create "bitmap" "17c" "21.5c" + :bitmap "@" : *tk-library* : "/demos/images/letters.bmp" :tags "item") + +(funcall c :create "text" "25c" "16.2c" :text "Windows" :anchor "n") +(button (conc c '.button) :text "Press Me" :command `(butpress ',c "red")) +(funcall c :create "window" "21c" "18c" :window (conc c '.button) :anchor "nw" :tags "item") +(entry (conc c '.entry) :width 20 :relief "sunken") +(funcall (conc c '.entry) :insert "end" "Edit this text") +(funcall c :create "window" "21c" "21c" :window (conc c '.entry) :anchor "nw" :tags "item") +(scale (conc c '.scale) :from 0 :to 100 :length "6c" :sliderlength '.4c + :width '.5c :tickinterval 0) +(funcall c :create "window" "28.5c" "17.5c" :window (conc c '.scale) :anchor "n" :tags "item") +(funcall c :create "text" "21c" "17.9c" :text "Button": :anchor "sw") +(funcall c :create "text" "21c" "20.9c" :text "Entry": :anchor "sw") +(funcall c :create "text" "28.5c" "17.4c" :text "Scale": :anchor "s") + +;; Set up event bindings for canvas: + +(funcall c :bind "item" "" `(itemEnter ',c)) +(funcall c :bind "item" "" `(itemLeave ',c)) +(bind c "<2>" (tk-conc c " scan mark %x %y")) +(bind c "" (tk-conc c " scan dragto %x %y")) +(bind c "<3>" `(itemMark ',c |%x| |%y|)) +(bind c "" `(itemStroke ',c |%x| |%y|)) +(bind c "" `(itemsUnderArea ',c)) +(bind c "<1>" `(itemStartDrag ',c |%x| |%y|)) +(bind c "" `(itemDrag ',c |%x| |%y|)) +(focus c) + +;; Utility procedures for highlighting the item under the pointer: + + +(defvar *restorecmd* nil) + +(defun itemEnter (c &aux type bg) + ; (global :*restorecmd*) + (let ((current (funcall c :find "withtag" "current" :return 'string))) + (if (equal current "") (return-from itementer nil)) + (itemleave nil) + + (setq type (funcall c :type current :return 'string)) + (if (equal type "window") + (progn + (itemLeave nil) + (return-from itemEnter nil))) + (if (equal type "bitmap") + (progn + (setq bg (nth 4 + (funcall c :itemconf current :background + :return 'list-strings))) + (push `(,c :itemconfig ',current :background ',bg) *restorecmd*) + (funcall c :itemconfig current :background "SteelBlue2") + (return-from itemEnter nil))) + (setq fill (nth 4 (funcall c :itemconfig current :fill + :return 'list-strings))) + (if (or (member type '("rectangle" "oval" "arg") :test 'equal) + (equal fill "")) + (progn + (setq outline (nth 4 (funcall c :itemconfig current :outline :return 'list-strings))) + (push `(,c :itemconfig ',current :outline ',outline) *restorecmd*) + (funcall c :itemconfig current :outline "SteelBlue2")) + (progn + (push `(,c :itemconfig ',current :fill ,fill) *restorecmd*) + (funcall c :itemconfig current :fill "SteelBlue2"))) + ) + ) + +(defun itemLeave (c) +; (global :*restorecmd*) + (let ((tem *restorecmd*)) + (setq *restorecmd* nil) + (dolist (v tem) + (eval v)))) + + +;; Utility procedures for stroking out a rectangle and printing what's +;; underneath the rectangle's area. + +(defun itemMark (c x y) +; (global :areaX1 areaY1) + (setq areaX1 (funcall c :canvasx x :return 'string)) + (setq areaY1 (funcall c :canvasy y :return 'string)) + (funcall c :delete "area") +) + +(defun itemStroke (c x y ) + (declare (special areaX1 areaY1 areaX2 areaY2)) + (or *recursive* + (let ((*recursive* t)) + (setq x (funcall c :canvasx x :return 'string)) + (setq y (funcall c :canvasy y :return 'string)) + (progn + (setq areaX2 x) + (setq areaY2 y) + ;; this next return 'stringis simply for TIMING!!! + ;; to make it wait for the result before going into subsequent!! + (funcall c :delete "area" :return 'string) + (funcall c :addtag "area" "withtag" + (funcall c :create "rect" areaX1 areaY1 x y + :outline "black" :return 'string)) + + )))) + +(defun itemsUnderArea (c) +; (global :areaX1 areaY1 areaX2 areaY2) + (setq area (funcall c :find "withtag" "area" :return 'string)) + (setq me c) + (setq items "") + (dolist (i + (funcall c :find "enclosed" areaX1 areaY1 areaX2 areaY2 + :return 'list-strings)) + (if (search "item" (funcall c :gettags i :return 'string)) + (setq items (tk-conc items " " i)))) + (print (tk-conc "Items enclosed by area: " items)) + (setq items "") + (dolist (i + (funcall c :find "overlapping" areaX1 areaY1 areaX2 areaY2 + :return 'list-strings)) + (if (search "item" (funcall c :gettags i :return 'string)) + (setq items (tk-conc items " " i)))) + (print (tk-conc "Items overlapping area: " items)) + (terpri) + (force-output) +) + +(setq areaX1 0) +(setq areaY1 0) +(setq areaX2 0) +(setq areaY2 0) + +;; Utility procedures to support dragging of items. + +(defun itemStartDrag (c x y) +; (global :lastX lastY) + (setq lastX (funcall c :canvasx x :return 'number)) + (setq lastY (funcall c :canvasy y :return 'number)) +) + +(defun itemDrag (c x y) +; (global :lastX lastY) + (setq x (funcall c :canvasx x :return 'number)) + (setq y (funcall c :canvasy y :return 'number)) + (funcall c :move "current" (- x lastX) (- y lastY)) + (setq lastX x) + (setq lastY y) +) + +(defvar *recursive* nil) +(defun itemDrag (c x y) +; (global :lastX lastY) + (cond (*recursive* ) + (t (let ((*recursive* t)) + (setq x (funcall c :canvasx x :return 'number)) + (setq y (funcall c :canvasy y :return 'number)) + (funcall c :move "current" (- x lastX) (- y lastY)) + (setq lastX x) + (setq lastY y))))) + +;; Procedure that's invoked when the button embedded in the canvas +;; is invoked. + +(defun butPress (w color) + (setq i (funcall w :create "text" "25c" "18.1c" :text "Ouch!!" + :fill color :anchor "n" :return 'string)) + (after 500 (tk-conc w " delete " i)) +) diff --git a/gcl-tk/demos-4.2/widget b/gcl-tk/demos-4.2/widget new file mode 100755 index 0000000..2ee3341 --- /dev/null +++ b/gcl-tk/demos-4.2/widget @@ -0,0 +1,376 @@ +#!/bin/sh +# the next line restarts using wish \ +exec wish4.2 "$0" "$@" + +# widget -- +# This script demonstrates the various widgets provided by Tk, +# along with many of the features of the Tk toolkit. This file +# only contains code to generate the main window for the +# application, which invokes individual demonstrations. The +# code for the actual demonstrations is contained in separate +# ".tcl" files is this directory, which are sourced by this script +# as needed. +# +# SCCS: @(#) widget 1.21 96/10/04 17:09:34 + +eval destroy [winfo child .] +wm title . "Widget Demonstration" + +#---------------------------------------------------------------- +# The code below create the main window, consisting of a menu bar +# and a text widget that explains how to use the program, plus lists +# all of the demos as hypertext items. +#---------------------------------------------------------------- + +set font -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-* +frame .menuBar +pack .menuBar -side top -fill x +menubutton .menuBar.file -text File -menu .menuBar.file.m -underline 0 +menu .menuBar.file.m +.menuBar.file.m add command -label "About ... " -command "aboutBox" \ + -underline 0 -accelerator "" +.menuBar.file.m add sep +.menuBar.file.m add command -label "Quit" -command "exit" -underline 0 +pack .menuBar.file -side left +bind . aboutBox + +frame .textFrame +scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ + -takefocus 1 +pack .s -in .textFrame -side right -fill y -padx 1 +text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \ + -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0 +pack .t -in .textFrame -expand y -fill both -padx 1 +pack .textFrame -expand yes -fill both -padx 1 -pady 2 + +frame .statusBar +label .statusBar.lab -text " " -relief sunken -bd 1 \ + -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w +label .statusBar.foo -width 8 -relief sunken -bd 1 \ + -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w +pack .statusBar.lab -side left -padx 2 -expand yes -fill both +pack .statusBar.foo -side left -padx 2 +pack .statusBar -side top -fill x -pady 2 + +# Create a bunch of tags to use in the text widget, such as those for +# section titles and demo descriptions. Also define the bindings for +# tags. + +.t tag configure title -font -*-Helvetica-Bold-R-Normal--*-180-*-*-*-*-*-* + +# We put some "space" characters to the left and right of each demo description +# so that the descriptions are highlighted only when the mouse cursor +# is right over them (but not when the cursor is to their left or right) +# +.t tag configure demospace -lmargin1 1c -lmargin2 1c + + +if {[winfo depth .] == 1} { + .t tag configure demo -lmargin1 1c -lmargin2 1c \ + -underline 1 + .t tag configure visited -lmargin1 1c -lmargin2 1c \ + -underline 1 + .t tag configure hot -background black -foreground white +} else { + .t tag configure demo -lmargin1 1c -lmargin2 1c \ + -foreground blue -underline 1 + .t tag configure visited -lmargin1 1c -lmargin2 1c \ + -foreground #303080 -underline 1 + .t tag configure hot -foreground red -underline 1 +} +.t tag bind demo { + invoke [.t index {@%x,%y}] +} +set lastLine "" +.t tag bind demo { + set lastLine [.t index {@%x,%y linestart}] + .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" + .t config -cursor hand2 + showStatus [.t index {@%x,%y}] +} +.t tag bind demo { + .t tag remove hot 1.0 end + .t config -cursor xterm + .statusBar.lab config -text "" +} +.t tag bind demo { + set newLine [.t index {@%x,%y linestart}] + if {[string compare $newLine $lastLine] != 0} { + .t tag remove hot 1.0 end + set lastLine $newLine + + set tags [.t tag names {@%x,%y}] + set i [lsearch -glob $tags demo-*] + if {$i >= 0} { + .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" + } + } + showStatus [.t index {@%x,%y}] +} + +# Create the text for the text widget. + +.t insert end "Tk Widget Demonstrations\n" title +.t insert end { +This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration. If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code. + +} +.t insert end "Labels, buttons, checkbuttons, and radiobuttons" title +.t insert end " \n " {demospace} +.t insert end "1. Labels (text and bitmaps)." {demo demo-label} +.t insert end " \n " {demospace} +.t insert end "2. Buttons." {demo demo-button} +.t insert end " \n " {demospace} +.t insert end "3. Checkbuttons (select any of a group)." {demo demo-check} +.t insert end " \n " {demospace} +.t insert end "4. Radiobuttons (select one of a group)." {demo demo-radio} +.t insert end " \n " {demospace} +.t insert end "5. A 15-puzzle game made out of buttons." {demo demo-puzzle} +.t insert end " \n " {demospace} +.t insert end "6. Iconic buttons that use bitmaps." {demo demo-icon} +.t insert end " \n " {demospace} +.t insert end "7. Two labels displaying images." {demo demo-image1} +.t insert end " \n " {demospace} +.t insert end "8. A simple user interface for viewing images." \ + {demo demo-image2} +.t insert end " \n " {demospace} + +.t insert end \n {} "Listboxes" title +.t insert end " \n " {demospace} +.t insert end "1. 50 states." {demo demo-states} +.t insert end " \n " {demospace} +.t insert end "2. Colors: change the color scheme for the application." \ + {demo demo-colors} +.t insert end " \n " {demospace} +.t insert end "3. A collection of famous sayings." {demo demo-sayings} +.t insert end " \n " {demospace} + +.t insert end \n {} "Entries" title +.t insert end " \n " {demospace} +.t insert end "1. Without scrollbars." {demo demo-entry1} +.t insert end " \n " {demospace} +.t insert end "2. With scrollbars." {demo demo-entry2} +.t insert end " \n " {demospace} +.t insert end "3. Simple Rolodex-like form." {demo demo-form} +.t insert end " \n " {demospace} + +.t insert end \n {} "Text" title +.t insert end " \n " {demospace} +.t insert end "1. Basic editable text." {demo demo-text} +.t insert end " \n " {demospace} +.t insert end "2. Text display styles." {demo demo-style} +.t insert end " \n " {demospace} +.t insert end "3. Hypertext (tag bindings)." {demo demo-bind} +.t insert end " \n " {demospace} +.t insert end "4. A text widget with embedded windows." {demo demo-twind} +.t insert end " \n " {demospace} +.t insert end "5. A search tool built with a text widget." {demo demo-search} +.t insert end " \n " {demospace} + +.t insert end \n {} "Canvases" title +.t insert end " \n " {demospace} +.t insert end "1. The canvas item types." {demo demo-items} +.t insert end " \n " {demospace} +.t insert end "2. A simple 2-D plot." {demo demo-plot} +.t insert end " \n " {demospace} +.t insert end "3. Text items in canvases." {demo demo-ctext} +.t insert end " \n " {demospace} +.t insert end "4. An editor for arrowheads on canvas lines." {demo demo-arrow} +.t insert end " \n " {demospace} +.t insert end "5. A ruler with adjustable tab stops." {demo demo-ruler} +.t insert end " \n " {demospace} +.t insert end "6. A building floor plan." {demo demo-floor} +.t insert end " \n " {demospace} +.t insert end "7. A simple scrollable canvas." {demo demo-cscroll} +.t insert end " \n " {demospace} + +.t insert end \n {} "Scales" title +.t insert end " \n " {demospace} +.t insert end "1. Vertical scale." {demo demo-vscale} +.t insert end " \n " {demospace} +.t insert end "2. Horizontal scale." {demo demo-hscale} +.t insert end " \n " {demospace} + +.t insert end \n {} "Menus" title +.t insert end " \n " {demospace} +.t insert end "1. A window containing several menus and cascades." \ + {demo demo-menu} +.t insert end " \n " {demospace} + +.t insert end \n {} "Common Dialogs" title +.t insert end " \n " {demospace} +.t insert end "1. Message boxes." {demo demo-msgbox} +.t insert end " \n " {demospace} +.t insert end "2. File selection dialog." {demo demo-filebox} +.t insert end " \n " {demospace} +.t insert end "3. Color picker." {demo demo-clrpick} +.t insert end " \n " {demospace} + +.t insert end \n {} "Miscellaneous" title +.t insert end " \n " {demospace} +.t insert end "1. The built-in bitmaps." {demo demo-bitmap} +.t insert end " \n " {demospace} +.t insert end "2. A dialog box with a local grab." {demo demo-dialog1} +.t insert end " \n " {demospace} +.t insert end "3. A dialog box with a global grab." {demo demo-dialog2} +.t insert end " \n " {demospace} + +.t configure -state disabled +focus .s + +# positionWindow -- +# This procedure is invoked by most of the demos to position a +# new demo window. +# +# Arguments: +# w - The name of the window to position. + +proc positionWindow w { + wm geometry $w +300+300 +} + +# showVars -- +# Displays the values of one or more variables in a window, and +# updates the display whenever any of the variables changes. +# +# Arguments: +# w - Name of new window to create for display. +# args - Any number of names of variables. + +proc showVars {w args} { + catch {destroy $w} + toplevel $w + wm title $w "Variable values" + label $w.title -text "Variable values:" -width 20 -anchor center \ + -font -Adobe-helvetica-medium-r-normal--*-180-*-*-*-*-*-* + pack $w.title -side top -fill x + set len 1 + foreach i $args { + if {[string length $i] > $len} { + set len [string length $i] + } + } + foreach i $args { + frame $w.$i + label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w + label $w.$i.value -textvar $i -anchor w + pack $w.$i.name -side left + pack $w.$i.value -side left -expand 1 -fill x + pack $w.$i -side top -anchor w -fill x + } + button $w.ok -text OK -command "destroy $w" + pack $w.ok -side bottom -pady 2 +} + +# invoke -- +# This procedure is called when the user clicks on a demo description. +# It is responsible for invoking the demonstration. +# +# Arguments: +# index - The index of the character that the user clicked on. + +proc invoke index { + global tk_library + set tags [.t tag names $index] + set i [lsearch -glob $tags demo-*] + if {$i < 0} { + return + } + set cursor [.t cget -cursor] + .t configure -cursor watch + update + set demo [string range [lindex $tags $i] 5 end] + uplevel [list source [file join $tk_library demos $demo.tcl]] + update + .t configure -cursor $cursor + + .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars" +} + +# showStatus -- +# +# Show the name of the demo program in the status bar. This procedure +# is called when the user moves the cursor over a demo description. +# +proc showStatus index { + global tk_library + set tags [.t tag names $index] + set i [lsearch -glob $tags demo-*] + set cursor [.t cget -cursor] + if {$i < 0} { + .statusBar.lab config -text " " + set newcursor xterm + } else { + set demo [string range [lindex $tags $i] 5 end] + .statusBar.lab config -text "Run the \"$demo\" sample program" + set newcursor hand2 + } + if [string compare $cursor $newcursor] { + .t config -cursor $newcursor + } +} + + +# showCode -- +# This procedure creates a toplevel window that displays the code for +# a demonstration and allows it to be edited and reinvoked. +# +# Arguments: +# w - The name of the demonstration's window, which can be +# used to derive the name of the file containing its code. + +proc showCode w { + global tk_library + set file [string range $w 1 end].tcl + if ![winfo exists .code] { + toplevel .code + frame .code.buttons + pack .code.buttons -side bottom -fill x + button .code.buttons.dismiss -text Dismiss -command "destroy .code" + button .code.buttons.rerun -text "Rerun Demo" -command { + eval [.code.text get 1.0 end] + } + pack .code.buttons.dismiss .code.buttons.rerun -side left \ + -expand 1 -pady 2 + frame .code.frame + pack .code.frame -expand yes -fill both -padx 1 -pady 1 + text .code.text -height 40 -wrap word\ + -xscrollcommand ".code.xscroll set" \ + -yscrollcommand ".code.yscroll set" \ + -setgrid 1 -highlightthickness 0 -pady 2 -padx 3 + scrollbar .code.xscroll -command ".code.text xview" \ + -highlightthickness 0 -orient horizontal + scrollbar .code.yscroll -command ".code.text yview" \ + -highlightthickness 0 -orient vertical + + grid .code.text -in .code.frame -padx 1 -pady 1 \ + -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid .code.yscroll -in .code.frame -padx 1 -pady 1 \ + -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news +# grid .code.xscroll -in .code.frame -padx 1 -pady 1 \ +# -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid rowconfig .code.frame 0 -weight 1 -minsize 0 + grid columnconfig .code.frame 0 -weight 1 -minsize 0 + } else { + wm deiconify .code + raise .code + } + wm title .code "Demo code: [file join $tk_library demos $file]" + wm iconname .code $file + set id [open [file join $tk_library demos $file]] + .code.text delete 1.0 end + .code.text insert 1.0 [read $id] + .code.text mark set insert 1.0 + close $id +} + +# aboutBox -- +# +# Pops up a message box with an "about" message +# +proc aboutBox {} { + tk_messageBox -icon info -type ok -title "About Widget Demo" -message \ +"Tk widget demonstration\n\n\ +Copyright (c) 1996 Sun Microsystems, Inc." +} + diff --git a/gcl-tk/demos-4.2/widget.lisp b/gcl-tk/demos-4.2/widget.lisp new file mode 100755 index 0000000..33123a5 --- /dev/null +++ b/gcl-tk/demos-4.2/widget.lisp @@ -0,0 +1,385 @@ +;;#!/bin/sh +;; the next line restarts using wish +;(exec :wish4.2 (tk-conc 0) "$@") +(in-package "TK") +;; widget -- +;; This script demonstrates the various widgets provided by Tk, +;; along with many of the features of the Tk toolkit. This file +;; only contains code to generate the main window for the +;; application, which invokes individual demonstrations. The +;; code for the actual demonstrations is contained in separate +;; ".tcl" files is this directory, which are sourced by this script +;; as needed. +;; +;; SCCS: @(#) :widget 1.21 96/10/04 17:09:34 + +(apply 'destroy (winfo :child '|.| :return 'list)) +(wm :title '|.| "Widget Demonstration") + +;;---------------------------------------------------------------- +;; The code below create the main window, consisting of a menu bar +;; and a text widget that explains how to use the program, plus lists +;; all of the demos as hypertext items. +;;---------------------------------------------------------------- + +(setq font '-*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-*) +(frame '.menuBar) +(pack '.menuBar :side "top" :fill "x") +(menubutton '.menuBar.file :text "File" :menu '.menuBar.file.m :underline 0) +(menu '.menuBar.file.m) +(.menuBar.file.m :add :command :label "About '... " :command "aboutBox" + :underline 0 :accelerator "") +(.menuBar.file.m :add :sep) +(.menuBar.file.m :add :command :label "Quit" :command "exit" :underline 0) +(pack '.menuBar.file :side "left") +(bind '|.| "" 'aboutBox) + +(frame '.textFrame) +(scrollbar '.s :orient "vertical" :command '(.t :yview) :highlightthickness 0 + :takefocus 1) +(pack '.s :in '.textFrame :side "right" :fill "y" :padx 1) +(text '.t :yscrollcommand '(.s :set) :wrap "word" :width 60 :height 30 :font font + :setgrid 1 :highlightthickness 0 :padx 4 :pady 2 :takefocus 0) +(pack '.t :in '.textFrame :expand "y" :fill "both" :padx 1) +(pack '.textFrame :expand "yes" :fill "both" :padx 1 :pady 2) + +(frame '.statusBar) +(label '.statusBar.lab :text " " :relief "sunken" :bd 1 + :font :*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* :anchor "w") +(label '.statusBar.foo :width 8 :relief "sunken" :bd 1 + :font :*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* :anchor "w") +(pack '.statusBar.lab :side "left" :padx 2 :expand "yes" :fill "both") +(pack '.statusBar.foo :side "left" :padx 2) +(pack '.statusBar :side "top" :fill "x" :pady 2) + +;; Create a bunch of tags to use in the text widget, such as those for +;; section titles and demo descriptions. Also define the bindings for +;; tags. + +(.t :tag :configure "title" :font :*-Helvetica-Bold-R-Normal--*-180-*-*-*-*-*-*) + +;; We put some "space" characters to the left and right of each demo description +;; so that the descriptions are highlighted only when the mouse cursor +;; is right over them (but :not when the cursor is to their left or right) +;; +(.t :tag :configure "demospace" :lmargin1 "1c" :lmargin2 "1c") + + +(if (equal (winfo :depth '|.| :return 'number) 1) (progn + (.t :tag :configure "demo" :lmargin1 "1c" :lmargin2 "1c" + :underline 1) + (.t :tag :configure "visited" :lmargin1 "1c" :lmargin2 "1c" + :underline 1) + (.t :tag :configure "hot" :background "black" :foreground "white") + ) ;;else + (progn + (.t :tag :configure "demo" :lmargin1 "1c" :lmargin2 "1c" + :foreground "blue" :underline 1) + (.t :tag :configure "visited" :lmargin1 "1c" :lmargin2 "1c" + :foreground "#303080" :underline 1) + (.t :tag :configure "hot" :foreground "red" :underline 1) +)) +(.t :tag :bind "demo" "" + '(invoke (.t index "@%x,%y")) +) + +(setq lastLine "") +(.t :tag :bind "demo" "" '(progn + (setq lastLine (.t :index "@" : |%x| :"," : |%y| "linestart" :return 'number)) + (.t :tag :add "hot" (tk-conc lastLine " +1 chars") (tk-conc lastLine " lineend -1 chars")) + (.t :config :cursor "hand2") + (showStatus (.t :index "@" : |%x| :"," : |%y| :return 'number)) + )) + +(.t :tag :bind "demo" "" '(progn + (.t :tag :remove "hot" 1.0 end) + (.t :config :cursor "xterm") + (.statusBar.lab :config :text "") +) +(.t :tag :bind "demo" "" '(progn + (setq newLine [.t index {@%x,%y linestart}]) + (if ([string :compare newLine $lastLine] != 0) (progn + (.t :tag :remove "hot" 1.0 end) + (setq lastLine newLine) + + (setq tags [.t tag names {@%x,%y}]) + (setq i [lsearch :glob tags "demo-*"]) + (if (funcall i >= 0) {) + (.t :tag :add "hot" (tk-conc lastLine " +1 chars") (tk-conc lastLine " lineend -1 chars")) + ) + ) + (showStatus (.t :index "@%x,%y" :return 'number)) +)) + +;; Create the text for the text widget. + +(.t :insert end "Tk Widget Demonstrations\n" title) +(.t :insert end {) +(This :application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration. (if :you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code.) + +} +(setq *newline* " + ") +(.t :insert :end "Labels, buttons, checkbuttons, and radiobuttons" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. Labels (text :and bitmaps)." "demo demo-label") +(.t :insert :end " \n " "demospace") +(.t :insert :end "2. Buttons." "demo demo-label") +(.t :insert :end *newline* "demospace") +(.t :insert :end "3. Checkbuttons (select :any of a group)." "demo demo-check") +(.t :insert :end *newline* "demospace") +(.t :insert :end "4. Radiobuttons (select :one of a group).""demo demo-radio") +(.t :insert :end *newline* "demospace") +(.t :insert :end "5. A 15-puzzle game made out of buttons.""demo demo-puzzle") +(.t :insert :end *newline* "demospace") +(.t :insert :end "6. Iconic buttons that use bitmaps." "demo demo-icon") +(.t :insert :end *newline* "demospace") +(.t :insert :end "7. Two labels displaying images." "demo demo-image1") +(.t :insert :end *newline* "demospace") +(.t :insert :end "8. A simple user interface for viewing images." + "demo demo-image2") +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Listboxes" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. 50 states." "demo demo-states") +(.t :insert :end *newline* "demospace") +(.t :insert :end "2. Colors: change the color scheme for the application." + "demo demo-colors") +(.t :insert :end *newline* "demospace") +(.t :insert :end "3. A collection of famous sayings." "demo demo-sayings") +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Entries" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. Without scrollbars." "demo demo-entry1") +(.t :insert :end *newline* "demospace") +(.t :insert :end "2. With scrollbars." "demo demo-entry2") +(.t :insert :end *newline* "demospace") +(.t :insert :end "3. Simple Rolodex-like form." "demo demo-form") +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Text" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. Basic editable text." "demo demo-text") +(.t :insert :end *newline* "demospace") +(.t :insert :end "2. Text display styles." "demo demo-style") +(.t :insert :end *newline* "demospace") +(.t :insert :end "3. Hypertext (tag :bindings)." "demo demo-bind") +(.t :insert :end *newline* "demospace") +(.t :insert :end "4. A text widget with embedded windows." "demo demo-twind") +(.t :insert :end *newline* "demospace") +(.t :insert :end "5. A search tool built with a text widget." "demo demo-search") +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Canvases" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. The canvas item types." "demo demo-items") +(.t :insert :end *newline* "demospace") +(.t :insert :end "2. A simple 2-D plot." "demo demo-plot") +(.t :insert :end *newline* "demospace") +(.t :insert :end "3. Text items in canvases." "demo demo-ctext") +(.t :insert :end *newline* "demospace") +(.t :insert :end "4. An editor for arrowheads on canvas lines." "demo demo-arrow") +(.t :insert :end *newline* "demospace") +(.t :insert :end "5. A ruler with adjustable tab stops." "demo demo-ruler") +(.t :insert :end *newline* "demospace") +(.t :insert :end "6. A building floor plan." "demo demo-floor") +(.t :insert :end *newline* "demospace") +(.t :insert :end "7. A simple scrollable canvas." "demo demo-cscroll") +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Scales" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. Vertical scale." "demo demo-vscale") +(.t :insert :end *newline* "demospace") +(.t :insert :end "2. Horizontal scale." "demo demo-hscale") +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Menus" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. A window containing several menus and cascades." + (demo demo-menu)) +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Common Dialogs" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. Message boxes." "demo demo-msgbox") +(.t :insert :end *newline* "demospace") +(.t :insert :end "2. File selection dialog." "demo demo-filebox") +(.t :insert :end *newline* "demospace") +(.t :insert :end "3. Color picker." "demo demo-clrpick") +(.t :insert :end *newline* "demospace") + +(.t :insert :end *newline* : "Miscellaneous" "title") +(.t :insert :end *newline* "demospace") +(.t :insert :end "1. The built-in bitmaps." "demo demo-bitmap") +(.t :insert :end *newline* "demospace") +(.t :insert :end "2. A dialog box with a local grab." "demo demo-dialog1") +(.t :insert :end *newline* "demospace") +(.t :insert :end "3. A dialog box with a global grab." "demo demo-dialog2") +(.t :insert :end *newline* "demospace") + +(.t :configure :state "disabled") +(focus '.s) + +;; positionWindow -- +;; This procedure is invoked by most of the demos to position a +;; new demo window. +;; +;; Arguments: +;; w - The name of the window to position. + +(defun positionWindow w + (wm :geometry w +300+300) +) + +;; showVars -- +;; Displays the values of one or more variables in a window, and +;; updates the display whenever any of the variables changes. +;; +;; Arguments: +;; w - Name of new window to create for display. +;; args - Any number of names of variables. + +(defun showVars (w args) + (if (winfo :exists w) (destroy :w)) + (toplevel w) + (wm :title w "Variable values") + (label (conc w '."title") :text "Variable values:" :width 20 :anchor "center" + :font :Adobe-helvetica-medium-r-normal--*-180-*-*-*-*-*-*) + (pack (conc w '."title") :side "top" :fill "x") + (setq len 1) + foreach i args { +( (if ([string :length $i] > len) (progn ) + (setq len [string length $i]) +( )) + } + foreach i args { + (frame (conc w '|.| i)) + (label (conc w '|.| i '.name) :text (tk-conc i ": ") :width ( + len 2) :anchor "w") + (label (conc w '|.| i '.value) :textvar i :anchor "w") + (pack (conc w '|.| i '.name) :side "left") + (pack (conc w '|.| i '.value) :side "left" :expand 1 :fill "x") + (pack (conc w '|.| i) :side "top" :anchor "w" :fill "x") + } + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.ok) :side "bottom" :pady 2) +) + +;; invoke -- +;; This procedure is called when the user clicks on a demo description. +;; It is responsible for invoking the demonstration. +;; +;; Arguments: +;; index - The index of the character that the user clicked on. + +(defun invoke index + (global :tk_library) + (setq tags [.t tag names $index]) + (setq i [lsearch :glob tags demo-*]) + (if (funcall i < 0) (progn + (return) + ) + (setq cursor [.t cget :cursor]) + (.t :configure :cursor "watch") + (update) + (setq demo [string range [lindex tags $i] 5 end]) + (uplevel [list source [file join $tk_library demos (conc demo '.tcl)]]) + (update) + (.t :configure :cursor cursor) + + (.t :tag :add visited (tk-conc index " linestart +1 chars") (tk-conc index " lineend -1 chars")) +) + +;; showStatus -- +;; +;; Show the name of the demo program in the status bar. This procedure +;; is called when the user moves the cursor over a demo description. +;; +(defun showStatus (index ) + ;(global :tk_library) +; (setq index (round index)) + (setq tags (.t :tag "names" index :return 'string)) + (setq i (lsearch "-glob" tags "demo-*" :return 'number)) + (setq cursor (.t :cget :cursor :return 'string)) + (if (< i 0) (progn + (.statusBar.lab :config :text " ") + (setq newcursor "xterm") + ) ;;else + (progn + (setq demo + (string :range (lindex tags i :return 'string) 5 "end" + :return 'string)) + (.statusBar.lab :config :text (tk-conc "Run the \"" demo "\" sample program")) + (setq newcursor "hand2") + )) + (if (string :compare cursor newcursor :return 'boolean) + (.t :config :cursor newcursor) + ) +) + + +;; showCode -- +;; This procedure creates a toplevel window that displays the code for +;; a demonstration and allows it to be edited and reinvoked. +;; +;; Arguments: +;; w - The name of the demonstration's window, which can be +;; used to derive the name of the file containing its code. + +(defun showCode w + (global :tk_library) + (setq file [string range w 1 end].tcl) + (if ![winfo exists '.code] { + (toplevel '.code) + (frame '.code.buttons) + (pack '.code.buttons :side "bottom" :fill "x") + (button '.code.buttons.dismiss :text "Dismiss" :command "destroy '.code") + (button '.code.buttons.rerun :text "Rerun Demo" :command {) + (eval [.code.text get 1.0 end]) + } + (pack '.code.buttons.dismiss '.code.buttons.rerun :side "left" + :expand 1 :pady 2) + (frame '.code.frame) + (pack '.code.frame :expand "yes" :fill "both" :padx 1 :pady 1) + (text '.code.text :height 40 :wrap "word +" :xscrollcommand ".code.xscroll set" + :yscrollcommand ".code.yscroll set" + :setgrid 1 :highlightthickness 0 :pady 2 :padx 3) + (scrollbar '.code.xscroll :command ".code.text xview" + :highlightthickness 0 :orient "horizontal") + (scrollbar '.code.yscroll :command ".code.text yview" + :highlightthickness 0 :orient "vertical") + + (grid '.code.text :in '.code.frame :padx 1 :pady 1 + :row 0 :column 0 :rowspan 1 :columnspan 1 :sticky "news") + (grid '.code.yscroll :in '.code.frame :padx 1 :pady 1 + :row 0 :column 1 :rowspan 1 :columnspan 1 :sticky "news") +;; grid '.code.xscroll :in '.code.frame :padx 1 :pady 1 +;; :row 1 :column 0 :rowspan 1 :columnspan 1 :sticky "news" + (grid :rowconfig '.code.frame 0 :weight 1 :minsize 0) + (grid :columnconfig '.code.frame 0 :weight 1 :minsize 0) + } else { + (wm :deiconify '.code) + (raise '.code) + } + (wm :title '.code (tk-conc "Demo code: [file join " tk "_library demos " file "]")) + (wm :iconname '.code file) + (setq id [open [file join $tk_library demos $file]]) + (.code.text :delete 1.0 end) + (.code.text :insert 1.0 [read $id]) + (.code.text :mark set insert 1.0) + (close id) +) + +;; aboutBox -- +;; +;; Pops up a message box with an "about" message +;; +(defun aboutBox () + (tk_messageBox :icon "info" :type "ok" :title "About Widget Demo" :message +"Tk widget demonstration\\n\\n +Copyright (c) 1996 Sun Microsystems, Inc.") +) + diff --git a/gcl-tk/demos/gc-monitor.lisp b/gcl-tk/demos/gc-monitor.lisp new file mode 100755 index 0000000..f5dda63 --- /dev/null +++ b/gcl-tk/demos/gc-monitor.lisp @@ -0,0 +1,158 @@ + +;; bug in aix c compiler on optimize?? +#+aix3 (eval-when (compile) (proclaim '(optimize (speed 0)))) + +(in-package "TK") + +(defvar *gc-monitor-types* + '(cons fixnum string si::relocatable-blocks stream)) + +(defvar *special-type-background* "red") + +(defun make-one-graph (top type) + (let* ((f (conc top '.type type))) + (setf (get type 'frame) f) + (setf (get type 'canvas) (conc top '.canvas type)) + (frame f ) + (canvas (get type 'canvas) :relief "sunken" :width "8c" :height ".4c") + (label (conc f '.data)) + (button (conc f '.label) :text (string-capitalize (symbol-name type)) + :background "gray90" + :command `(draw-status ',type t)) + (pack (conc f '.label) (conc f '.data) :side "left" :anchor "w" :padx "4m") + (pack f :side "top" :anchor "w" :padx "1c") + (pack (get type 'canvas) :side "top" :expand 1 :pady "2m") + )) + +(defvar *prev-special-type* nil) + +(defvar *time-to-stay-on-type* 0) + + +(defvar *values-array* (make-array 20 :fill-pointer 0)) +(defun push-multiple-values (&rest l) + (declare (:dynamic-extent l)) + (dolist (v l) (vector-push-extend v *values-array*))) + +(defun draw-status (special-type &optional clicked) + (setf (fill-pointer *values-array*) 0) + (let ((max-size 0) (ar *values-array*) (i 0) (width 7.0s0) + (ht ".15c")) + (declare (fixnum max-size) (short-float width)(type (array (t)) ar)) + (dolist (v *gc-monitor-types*) + (let ((fp (fill-pointer *values-array*)) + ) + (multiple-value-call 'push-multiple-values (si::allocated v)) + (setq max-size (max max-size (aref ar (the fixnum (+ fp 1))))))) + ; (nfree npages maxpage nppage gccount nused) + (dolist (v *gc-monitor-types*) + (let* ((nfree (aref ar i)) + (npages (aref ar (setq i(+ i 1)))) + (nppage (aref ar (setq i(+ i 2)))) + (gccount (aref ar (setq i (+ i 1)))) + (nused (aref ar (setq i (+ i 1)))) + (wid (/ (the short-float(* npages width)) max-size)) + (f (get v 'frame)) + (tot (* npages nppage)) + (width-used (the short-float + (/ (the short-float + (* wid (the fixnum + (- tot + (the fixnum nfree))))) + tot)))) + (declare (fixnum nppage npages tot) + (short-float wid)) + (setq i (+ i 1)) + (funcall (get v 'canvas) :delete "graph") + (funcall (get v 'canvas) :create "line" + 0 ht + width-used : "c" ht + :width "3m" :tag "graph" :fill "red") + (funcall (get v 'canvas) :create "line" + width-used : "c" ht + wid : "c" ht + :width "3m" :tag "graph" :fill "aquamarine4" ) + (funcall (conc f '.data) :configure :text + gccount : " gc's for ": npages : + " pages (used=" : nused : ")") + (cond ((eql special-type v) + (cond + (clicked + (let ((n (* max-size 2))) + (.gc.amount :configure :length "8c" + :label "Allocate: " : (or special-type "") + :tickinterval (truncate n 4) :to n) + (.gc.amount :set npages) + + ))))))) + (set-label-background *prev-special-type* "pink") + + (setq *prev-special-type* special-type) + (set-label-background special-type *special-type-background*) + ) + ) + + + +(defun do-allocation () + (when *prev-special-type* + (allocate *prev-special-type* + (.gc.amount :get :return 'number) + t) + (draw-status *prev-special-type*))) + +(defun set-label-background (type colour) + (and (get type 'frame) + (let ((label (conc (get type 'frame) '.label))) + (funcall label :configure :background colour)))) + + +(defun mkgcmonitor() + (let (si::*after-gbc-hook*) + (toplevel '.gc) + (wm :title '.gc "GC Monitor") + (wm :title '.gc "GC") + (or (> (read-from-string (winfo :depth '.gc)) 1) + (setq *special-type-background* "white")) + (message '.gc.msg :font :Adobe-times-medium-r-normal--*-180* :aspect 400 + :text + "GC monitor displays after each garbage collection the amount of space used (red) and free (green) of the types in the list *gc-monitor-types*. Clicking on a type makes its size appear on the scale at the bottom, and double clicking on the scale causes actual allocation!") + (pack '.gc.msg :side "top") + (dolist (v *gc-monitor-types*) + (make-one-graph '.gc v) + ) + (.gc :configure :borderwidth 4 :relief "ridge") + ;; it is important to create the frame first, so that + ;; it is earlier... and the others will show. + (frame '.gc.ff) + (button '.gc.ok :text "QUIT" + :command `(progn (setq si::*after-gbc-hook* nil) + (destroy '.gc))) + + (scale '.gc.amount :label "Amount :" :width ".3c" + :orient "horizontal" :to 100) + (pack '.gc.amount) + (button '.gc.reset :text "RESET Number Used" + :command '(progn (dolist (v *gc-monitor-types*) + (set-label-background v "gray90")) + (si::reset-number-used) + (draw-status *prev-special-type*))) + (button '.gc.update :text "Update" + :command '(draw-status *prev-special-type*)) + + (pack '.gc.ok '.gc.reset '.gc.update :expand 1 :fill "x" + :in '.gc.ff :padx 3 :pady 2 :side 'left) + + (pack '.gc.ff :expand 1 :fill "x") + (bind '.gc.amount "" + 'do-allocation) + + + + (draw-status nil)) + (setq si::*after-gbc-hook* 'draw-status) + ) + + + + \ No newline at end of file diff --git a/gcl-tk/demos/mkArrow.tcl b/gcl-tk/demos/mkArrow.tcl new file mode 100755 index 0000000..ea6ece8 --- /dev/null +++ b/gcl-tk/demos/mkArrow.tcl @@ -0,0 +1,203 @@ +# mkArrow w +# +# Create a top-level window containing a canvas demonstration that +# allows the user to experiment with arrow shapes. +# +# Arguments: +# w - Name to use for new top-level window. + +# This file implements a canvas widget that displays a large line with +# an arrowhead and allows the shape of the arrowhead to be edited +# interactively. The only procedure that should be invoked from outside +# the file is the first one, which creates the canvas. + +proc mkArrow {{w .arrow}} { + global tk_library + upvar #0 demo_arrowInfo v + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Arrowhead Editor Demonstration" + wm iconname $w "Arrow" + set c $w.c + + frame $w.frame1 -relief raised -bd 2 + canvas $c -width 500 -height 350 -relief raised + button $w.ok -text "OK" -command "destroy $w" + pack $w.frame1 -side top -fill both + pack $w.ok -side bottom -pady 5 + pack $c -expand yes -fill both + message $w.frame1.m -font -Adobe-Times-Medium-R-Normal-*-180-* -aspect 300 \ + -text "This widget allows you to experiment with different widths and arrowhead shapes for lines in canvases. To change the line width or the shape of the arrowhead, drag any of the three boxes attached to the oversized arrow. The arrows on the right give examples at normal scale. The text at the bottom shows the configuration options as you'd enter them for a line." + pack $w.frame1.m + + set v(a) 8 + set v(b) 10 + set v(c) 3 + set v(width) 2 + set v(motionProc) arrowMoveNull + set v(x1) 40 + set v(x2) 350 + set v(y) 150 + set v(smallTips) {5 5 2} + set v(count) 0 + if {[winfo depth $c] > 1} { + set v(bigLineStyle) "-fill SkyBlue1" + set v(boxStyle) "-fill {} -outline black -width 1" + set v(activeStyle) "-fill red -outline black -width 1" + } else { + set v(bigLineStyle) "-fill black -stipple @$tk_library/demos/bitmaps/grey.25" + set v(boxStyle) "-fill {} -outline black -width 1" + set v(activeStyle) "-fill black -outline black -width 1" + } + arrowSetup $c + $c bind box "$c itemconfigure current $v(activeStyle)" + $c bind box "$c itemconfigure current $v(boxStyle)" + $c bind box1 <1> {set demo_arrowInfo(motionProc) arrowMove1} + $c bind box2 <1> {set demo_arrowInfo(motionProc) arrowMove2} + $c bind box3 <1> {set demo_arrowInfo(motionProc) arrowMove3} + $c bind box "\$demo_arrowInfo(motionProc) $c %x %y" + bind $c "arrowSetup $c" +} + +# The procedure below completely regenerates all the text and graphics +# in the canvas window. It's called when the canvas is initially created, +# and also whenever any of the parameters of the arrow head are changed +# interactively. The argument is the name of the canvas widget to be +# regenerated, and also the name of a global variable containing the +# parameters for the display. + +proc arrowSetup c { + upvar #0 demo_arrowInfo v + $c delete all + + # Create the arrow and outline. + + eval "$c create line $v(x1) $v(y) $v(x2) $v(y) -width [expr 10*$v(width)] \ + -arrowshape {[expr 10*$v(a)] [expr 10*$v(b)] [expr 10*$v(c)]} \ + -arrow last $v(bigLineStyle)" + set xtip [expr $v(x2)-10*$v(b)] + set deltaY [expr 10*$v(c)+5*$v(width)] + $c create line $v(x2) $v(y) $xtip [expr $v(y)+$deltaY] \ + [expr $v(x2)-10*$v(a)] $v(y) $xtip [expr $v(y)-$deltaY] \ + $v(x2) $v(y) -width 2 -capstyle round -joinstyle round + + # Create the boxes for reshaping the line and arrowhead. + + eval "$c create rect [expr $v(x2)-10*$v(a)-5] [expr $v(y)-5] \ + [expr $v(x2)-10*$v(a)+5] [expr $v(y)+5] $v(boxStyle) \ + -tags {box1 box}" + eval "$c create rect [expr $xtip-5] [expr $v(y)-$deltaY-5] \ + [expr $xtip+5] [expr $v(y)-$deltaY+5] $v(boxStyle) \ + -tags {box2 box}" + eval "$c create rect [expr $v(x1)-5] [expr $v(y)-5*$v(width)-5] \ + [expr $v(x1)+5] [expr $v(y)-5*$v(width)+5] $v(boxStyle) \ + -tags {box3 box}" + + # Create three arrows in actual size with the same parameters + + $c create line [expr $v(x2)+50] 0 [expr $v(x2)+50] 1000 \ + -width 2 + set tmp [expr $v(x2)+100] + $c create line $tmp [expr $v(y)-125] $tmp [expr $v(y)-75] \ + -width $v(width) \ + -arrow both -arrowshape "$v(a) $v(b) $v(c)" + $c create line [expr $tmp-25] $v(y) [expr $tmp+25] $v(y) \ + -width $v(width) \ + -arrow both -arrowshape "$v(a) $v(b) $v(c)" + $c create line [expr $tmp-25] [expr $v(y)+75] [expr $tmp+25] \ + [expr $v(y)+125] -width $v(width) \ + -arrow both -arrowshape "$v(a) $v(b) $v(c)" + + # Create a bunch of other arrows and text items showing the + # current dimensions. + + set tmp [expr $v(x2)+10] + $c create line $tmp [expr $v(y)-5*$v(width)] \ + $tmp [expr $v(y)-$deltaY] \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x2)+15] [expr $v(y)-$deltaY+5*$v(c)] \ + -text $v(c) -anchor w + set tmp [expr $v(x1)-10] + $c create line $tmp [expr $v(y)-5*$v(width)] \ + $tmp [expr $v(y)+5*$v(width)] \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x1)-15] $v(y) -text $v(width) -anchor e + set tmp [expr $v(y)+5*$v(width)+10*$v(c)+10] + $c create line [expr $v(x2)-10*$v(a)] $tmp $v(x2) $tmp \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x2)-5*$v(a)] [expr $tmp+5] \ + -text $v(a) -anchor n + set tmp [expr $tmp+25] + $c create line [expr $v(x2)-10*$v(b)] $tmp $v(x2) $tmp \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x2)-5*$v(b)] [expr $tmp+5] \ + -text $v(b) -anchor n + + $c create text $v(x1) 310 -text "-width $v(width)" \ + -anchor w -font -Adobe-Helvetica-Medium-R-Normal-*-180-* + $c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \ + -anchor w -font -Adobe-Helvetica-Medium-R-Normal-*-180-* + + incr v(count) +} + +# The procedures below are called in response to mouse motion for one +# of the three items used to change the line width and arrowhead shape. +# Each procedure updates one or more of the controlling parameters +# for the line and arrowhead, and recreates the display if that is +# needed. The arguments are the name of the canvas widget, and the +# x and y positions of the mouse within the widget. + +proc arrowMove1 {c x y} { + upvar #0 demo_arrowInfo v + set newA [expr ($v(x2)+5-[$c canvasx $x])/10] + if {$newA < 1} { + set newA 1 + } + if {$newA > 25} { + set newA 25 + } + if {$newA != $v(a)} { + $c move box1 [expr 10*($v(a)-$newA)] 0 + set v(a) $newA + } +} + +proc arrowMove2 {c x y} { + upvar #0 demo_arrowInfo v + set newB [expr ($v(x2)+5-[$c canvasx $x])/10] + if {$newB < 1} { + set newB 1 + } + if {$newB > 25} { + set newB 25 + } + set newC [expr ($v(y)+5-[$c canvasy $y]-5*$v(width))/10] + if {$newC < 1} { + set newC 1 + } + if {$newC > 20} { + set newC 20 + } + if {($newB != $v(b)) || ($newC != $v(c))} { + $c move box2 [expr 10*($v(b)-$newB)] [expr 10*($v(c)-$newC)] + set v(b) $newB + set v(c) $newC + } +} + +proc arrowMove3 {c x y} { + upvar #0 demo_arrowInfo v + set newWidth [expr ($v(y)+5-[$c canvasy $y])/5] + if {$newWidth < 1} { + set newWidth 1 + } + if {$newWidth > 20} { + set newWidth 20 + } + if {$newWidth != $v(width)} { + $c move box3 0 [expr 5*($v(width)-$newWidth)] + set v(width) $newWidth + } +} diff --git a/gcl-tk/demos/mkBasic.lisp b/gcl-tk/demos/mkBasic.lisp new file mode 100755 index 0000000..4a87fce --- /dev/null +++ b/gcl-tk/demos/mkBasic.lisp @@ -0,0 +1,69 @@ +;;# mkBasic w +;; +;; Create a top-level window that displays a basic text widget. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(in-package "TK") +(defvar *basic-message* " +This window is a text widget. It displays one or more lines of text +and allows you to edit the text. Here is a summary of the things you +can do to a text widget: + +1. Scrolling. Use the scrollbar to adjust the view in the text window. + +2. Scanning. Press mouse button 2 in the text window and drag up or down. +This will drag the text at high speed to allow you to scan its contents. + +3. Insert text. Press mouse button 1 to set the insertion cursor, then +type text. What you type will be added to the widget. You can backspace +over what you've typed using either the backspace key, the delete key, +or Control+h. + +4. Select. Press mouse button 1 and drag to select a range of characters. +Once you've released the button, you can adjust the selection by pressing +button 1 with the shift key down. This will reset the end of the +selection nearest the mouse cursor and you can drag that end of the +selection by dragging the mouse before releasing the mouse button. +You can double-click to select whole words, or triple-click to select +whole lines. + +5. Delete. To delete text, select the characters you'd like to delete +and type Control+d. + +6. Copy the selection. To copy the selection either from this window +or from any other window or application, select what you want, click +button 1 to set the insertion cursor, then type Control+v to copy the +selection to the point of the insertion cursor. + +7. Resize the window. This widget has been configured with the \"setGrid\" +option on, so that if you resize the window it will always resize to an +even number of characters high and wide. Also, if you make the window +narrow you can see that long lines automatically wrap around onto +additional lines so that all the information is always visible. + +When you're finished with this demonstration, press the \"OK\" button +below.") + + +(defun mkBasic (&optional (w '.basic)) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Text Demonstration - Basic Facilities") + (wm :iconname w "Text Basics") + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (scrollbar (conc w '.s) :relief "flat" :command (tk-conc w ".t yview")) + (text (conc w '.t) :relief "raised" :bd 2 :yscrollcommand + (tk-conc w ".s set") :setgrid "true") + + (pack (conc w '.ok) :side 'bottom :fill "x") + (pack (conc w '.s) :side 'right :fill "y") + (pack (conc w '.t) :expand 'yes :fill 'both) + (funcall (conc w '.t) :insert 0.0 *basic-message*) + (funcall (conc w '.t) :mark 'set 'insert 0.0) + (bind w "" (tk-conc "focus " w ".t")) +) + + diff --git a/gcl-tk/demos/mkBasic.tcl b/gcl-tk/demos/mkBasic.tcl new file mode 100755 index 0000000..28a13af --- /dev/null +++ b/gcl-tk/demos/mkBasic.tcl @@ -0,0 +1,61 @@ +# mkBasic w +# +# Create a top-level window that displays a basic text widget. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkBasic {{w .basic}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Text Demonstration - Basic Facilities" + wm iconname $w "Text Basics" + button $w.ok -text OK -command "destroy $w" + text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true + scrollbar $w.s -relief flat -command "$w.t yview" + pack $w.ok -side bottom -fill x + pack $w.s -side right -fill y + pack $w.t -expand yes -fill both + $w.t insert 0.0 {\ +This window is a text widget. It displays one or more lines of text +and allows you to edit the text. Here is a summary of the things you +can do to a text widget: + +1. Scrolling. Use the scrollbar to adjust the view in the text window. + +2. Scanning. Press mouse button 2 in the text window and drag up or down. +This will drag the text at high speed to allow you to scan its contents. + +3. Insert text. Press mouse button 1 to set the insertion cursor, then +type text. What you type will be added to the widget. You can backspace +over what you've typed using either the backspace key, the delete key, +or Control+h. + +4. Select. Press mouse button 1 and drag to select a range of characters. +Once you've released the button, you can adjust the selection by pressing +button 1 with the shift key down. This will reset the end of the +selection nearest the mouse cursor and you can drag that end of the +selection by dragging the mouse before releasing the mouse button. +You can double-click to select whole words, or triple-click to select +whole lines. + +5. Delete. To delete text, select the characters you'd like to delete +and type Control+d. + +6. Copy the selection. To copy the selection either from this window +or from any other window or application, select what you want, click +button 1 to set the insertion cursor, then type Control+v to copy the +selection to the point of the insertion cursor. + +7. Resize the window. This widget has been configured with the "setGrid" +option on, so that if you resize the window it will always resize to an +even number of characters high and wide. Also, if you make the window +narrow you can see that long lines automatically wrap around onto +additional lines so that all the information is always visible. + +When you're finished with this demonstration, press the "OK" button +below.} + $w.t mark set insert 0.0 + bind $w "focus $w.t" +} diff --git a/gcl-tk/demos/mkBitmaps.tcl b/gcl-tk/demos/mkBitmaps.tcl new file mode 100755 index 0000000..f8994a6 --- /dev/null +++ b/gcl-tk/demos/mkBitmaps.tcl @@ -0,0 +1,46 @@ +# mkBitmaps w +# +# Create a top-level window that displays all of Tk's built-in bitmaps. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkBitmaps {{w .bitmaps}} { + global tk_library + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Bitmap Demonstration" + wm iconname $w "Bitmaps" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -width 4i \ + -text "This window displays all of Tk's built-in bitmaps, along with the names you can use for them in Tcl scripts. Click the \"OK\" button when you've seen enough." + frame $w.frame + bitmapRow $w.frame.0 error gray25 gray50 hourglass + bitmapRow $w.frame.1 info question questhead warning + button $w.ok -text OK -command "destroy $w" + pack $w.msg -side top -anchor center + pack $w.frame -side top -expand yes -fill both + pack $w.ok -side bottom -fill both +} + +# The procedure below creates a new row of bitmaps in a window. Its +# arguments are: +# +# w - The window that is to contain the row. +# args - The names of one or more bitmaps, which will be displayed +# in a new row across the bottom of w along with their +# names. + +proc bitmapRow {w args} { + frame $w + pack $w -side top -fill both + set i 0 + foreach bitmap $args { + frame $w.$i + pack $w.$i -side left -fill both -pady .25c -padx .25c + label $w.$i.bitmap -bitmap $bitmap + label $w.$i.label -text $bitmap -width 9 + pack $w.$i.label $w.$i.bitmap -side bottom + incr i + } +} diff --git a/gcl-tk/demos/mkButton.tcl b/gcl-tk/demos/mkButton.tcl new file mode 100755 index 0000000..e112b8f --- /dev/null +++ b/gcl-tk/demos/mkButton.tcl @@ -0,0 +1,33 @@ +# mkButton w +# +# Create a top-level window that displays a bunch of buttons. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkButton {{w .b1}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Button Demonstration" + wm iconname $w "Buttons" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "Four buttons are displayed below. If you click on a button, it will change the background of the button area to the color indicated in the button. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + + pack $w.msg -side top -fill both + pack $w.frame -side top -expand yes -fill both + pack $w.ok -side bottom -fill both + + button $w.frame.b1 -text "Peach Puff" \ + -command "$w.frame config -bg PeachPuff1" + button $w.frame.b2 -text "Light Blue" \ + -command "$w.frame config -bg LightBlue1" + button $w.frame.b3 -text "Sea Green" \ + -command "$w.frame config -bg SeaGreen2" + button $w.frame.b4 -text "Yellow" \ + -command "$w.frame config -bg Yellow1" + pack $w.frame.b1 $w.frame.b2 $w.frame.b3 $w.frame.b4 -side top \ + -expand yes -pady 2 +} diff --git a/gcl-tk/demos/mkCanvText.lisp b/gcl-tk/demos/mkCanvText.lisp new file mode 100755 index 0000000..dda7351 --- /dev/null +++ b/gcl-tk/demos/mkCanvText.lisp @@ -0,0 +1,110 @@ +;;# mkCanvText w +;; +;; Create a top-level window containing a canvas displaying a text +;; string and allowing the string to be edited and re-anchored. +;; +;; Arguments: +;; w - Name to use for new top-level window. +(in-package "TK") +(defun mkCanvText ({w .ctext}) + (catch {destroy w}) + (toplevel w) + (dpos w) + (wm :title w "Canvas Text Demonstration") + (wm :iconname w "Text") + (setq c (conc w '.c)) + + (message (conc w '.msg) :font -Adobe-Times-Medium-R-Normal-*-180-* :width 420 + :relief "raised" :bd 2 :text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can point, click, and type. You can also select and then delete with Control-d. You can copy the selection with Control-v. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification.") + (canvas c :relief "raised" :width 500 :height 400) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) :side "top" :fill "both") + (pack (conc w '.c) :side "top" :expand "yes" :fill "both") + (pack (conc w '.ok) :side "bottom" :pady 5 :anchor "center") + + (setq font :Adobe-helvetica-medium-r-*-240-*) + + (funcall c :create rectangle 245 195 255 205 :outline "black" :fill "red") + + ;; First, create the text item and give it bindings so it can be edited. + + (funcall c :addtag text withtag (funcall c create text 250 200 :text "This is just a string of text to demonstrate the text facilities of canvas widgets. You can point, click, and type. You can also select and then delete with Control-d." :width 440 :anchor "n" :font font :justify "left")) + (funcall c :bind text "<1>" (textB1Press c |%x| |%y|)) + (funcall c :bind text "" (textB1Move c %x %y)) + (funcall c :bind text "" (tk-conc c " select adjust current @%x,%y")) + (funcall c :bind text "" (funcall 'textB1Move c |%x| |%y|)) + (funcall c :bind text "" (tk-conc c " insert text insert %A")) + (funcall c :bind text "" (tk-conc c " insert text insert %A")) + (funcall c :bind text "" (tk-conc c " insert text insert \\n")) + (funcall c :bind text "" (funcall 'textBs c)) + (funcall c :bind text "" (funcall 'textBs c)) + (funcall c :bind text "" (tk-conc c " dchars text sel.first sel.last")) + (funcall c :bind text "" (tk-conc c " insert text insert \[selection get\]")) + + ;; Next, create some items that allow the text's anchor position + ;; to be edited. + + (setq x 50) + (setq y 50) + (setq color LightSkyBlue1) + (mkTextConfig c x y :anchor "se" color) + (mkTextConfig c (+ x 30) y :anchor "s" color) + (mkTextConfig c (+ x 60) y :anchor "sw" color) + (mkTextConfig c x (+ y 30) :anchor "e" color) + (mkTextConfig c (+ x 30) (+ y 30) :anchor "center" color) + (mkTextConfig c (+ x 60) (+ y 30) :anchor "w" color) + (mkTextConfig c x (+ y 60) :anchor "ne" color) + (mkTextConfig c (+ x 30) (+ y 60) :anchor "n" color) + (mkTextConfig c (+ x 60) (+ y 60) :anchor "nw" color) + (setq item (funcall c create rect (+ x 40) (+ y 40) (+ x 50) (+ y 50) + :outline "black" :fill "red")) + (funcall c :bind item "<1>" (tk-conc c " itemconf text :anchor ")center"") + (funcall c :create text (+ x 45) (- y 5) :text "{Text Position}" :anchor "s" + :font -Adobe-times-medium-r-normal--*-240-* :fill "brown") + + ;; Lastly, create some items that allow the text's justification to be + ;; changed. + + (setq x 350) + (setq y 50) + (setq color SeaGreen2) + (mkTextConfig c x y :justify "left" color) + (mkTextConfig c (+ x 30) y :justify "center" color) + (mkTextConfig c (+ x 60) y :justify "right" color) + (funcall c :create text (+ x 45) (- y 5) :text "Justification" :anchor "s" + :font -Adobe-times-medium-r-normal--*-240-* :fill "brown") + + (funcall c :bind config "" (tk-conc "textEnter " c)) + (funcall c :bind config "" (tk-conc c " itemconf current :fill \$textConfigFill")) +) + +(defun mkTextConfig (w x y option value color) + (setq item (funcall w create rect x y (+ x 30) (+ y 30) + :outline "black" :fill color :width 1)) + (funcall w :bind item "<1>" (tk-conc w " itemconf text " option " " value)) + (funcall w :addtag "config" "withtag" item) +) + +(setq textConfigFill "") + +(defun textEnter (w) + (global :textConfigFill) + (setq textConfigFill [lindex (funcall w :itemconfig "current" :fill) 4]) + (funcall w :itemconfig "current" :fill "black") +) + +(defun textB1Press (w x y) + (funcall w :icursor "current" (aT x y)) + (funcall w :focus "current") + (focus w) + (funcall w :select "from" "current" (aT x y)) +) + +(defun textB1Move (w x y) + (funcall w :select "to current" (aT x y)) +) + +(defun textBs (w &aux char) + (setq char (atoi (funcall w :index "text" "insert")) - 1) + (if (>= char 0) (funcall w :dchar "text" char)) +) diff --git a/gcl-tk/demos/mkCanvText.tcl b/gcl-tk/demos/mkCanvText.tcl new file mode 100755 index 0000000..4bd28b1 --- /dev/null +++ b/gcl-tk/demos/mkCanvText.tcl @@ -0,0 +1,110 @@ +# mkCanvText w +# +# Create a top-level window containing a canvas displaying a text +# string and allowing the string to be edited and re-anchored. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkCanvText {{w .ctext}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Canvas Text Demonstration" + wm iconname $w "Text" + set c $w.c + + message $w.msg -font -Adobe-Times-Medium-R-Normal-*-180-* -width 420 \ + -relief raised -bd 2 -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can point, click, and type. You can also select and then delete with Control-d. You can copy the selection with Control-v. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification." + canvas $c -relief raised -width 500 -height 400 + button $w.ok -text "OK" -command "destroy $w" + pack $w.msg -side top -fill both + pack $w.c -side top -expand yes -fill both + pack $w.ok -side bottom -pady 5 -anchor center + + set font -Adobe-helvetica-medium-r-*-240-* + + $c create rectangle 245 195 255 205 -outline black -fill red + + # First, create the text item and give it bindings so it can be edited. + + $c addtag text withtag [$c create text 250 200 -text "This is just a string of text to demonstrate the text facilities of canvas widgets. You can point, click, and type. You can also select and then delete with Control-d." -width 440 -anchor n -font $font -justify left] + $c bind text <1> "textB1Press $c %x %y" + $c bind text "textB1Move $c %x %y" + $c bind text "$c select adjust current @%x,%y" + $c bind text "textB1Move $c %x %y" + $c bind text "$c insert text insert %A" + $c bind text "$c insert text insert %A" + $c bind text "$c insert text insert \\n" + $c bind text "textBs $c" + $c bind text "textBs $c" + $c bind text "$c dchars text sel.first sel.last" + $c bind text "$c insert text insert \[selection get\]" + + # Next, create some items that allow the text's anchor position + # to be edited. + + set x 50 + set y 50 + set color LightSkyBlue1 + mkTextConfig $c $x $y -anchor se $color + mkTextConfig $c [expr $x+30] [expr $y] -anchor s $color + mkTextConfig $c [expr $x+60] [expr $y] -anchor sw $color + mkTextConfig $c [expr $x] [expr $y+30] -anchor e $color + mkTextConfig $c [expr $x+30] [expr $y+30] -anchor center $color + mkTextConfig $c [expr $x+60] [expr $y+30] -anchor w $color + mkTextConfig $c [expr $x] [expr $y+60] -anchor ne $color + mkTextConfig $c [expr $x+30] [expr $y+60] -anchor n $color + mkTextConfig $c [expr $x+60] [expr $y+60] -anchor nw $color + set item [$c create rect [expr $x+40] [expr $y+40] [expr $x+50] [expr $y+50] \ + -outline black -fill red] + $c bind $item <1> "$c itemconf text -anchor center" + $c create text [expr $x+45] [expr $y-5] -text {Text Position} -anchor s \ + -font -Adobe-times-medium-r-normal--*-240-* -fill brown + + # Lastly, create some items that allow the text's justification to be + # changed. + + set x 350 + set y 50 + set color SeaGreen2 + mkTextConfig $c $x $y -justify left $color + mkTextConfig $c [expr $x+30] [expr $y] -justify center $color + mkTextConfig $c [expr $x+60] [expr $y] -justify right $color + $c create text [expr $x+45] [expr $y-5] -text {Justification} -anchor s \ + -font -Adobe-times-medium-r-normal--*-240-* -fill brown + + $c bind config "textEnter $c" + $c bind config "$c itemconf current -fill \$textConfigFill" +} + +proc mkTextConfig {w x y option value color} { + set item [$w create rect [expr $x] [expr $y] [expr $x+30] [expr $y+30] \ + -outline black -fill $color -width 1] + $w bind $item <1> "$w itemconf text $option $value" + $w addtag config withtag $item +} + +set textConfigFill {} + +proc textEnter {w} { + global textConfigFill + set textConfigFill [lindex [$w itemconfig current -fill] 4] + $w itemconfig current -fill black +} + +proc textB1Press {w x y} { + $w icursor current @$x,$y + $w focus current + focus $w + $w select from current @$x,$y +} + +proc textB1Move {w x y} { + $w select to current @$x,$y +} + +proc textBs {w} { + set char [expr {[$w index text insert] - 1}] + if {$char >= 0} {$w dchar text $char} +} diff --git a/gcl-tk/demos/mkCheck.tcl b/gcl-tk/demos/mkCheck.tcl new file mode 100755 index 0000000..42451ce --- /dev/null +++ b/gcl-tk/demos/mkCheck.tcl @@ -0,0 +1,33 @@ +# mkCheck w +# +# Create a top-level window that displays a bunch of check buttons. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkCheck {{w .c1}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Checkbutton demonstration" + wm iconname $w "Checkbuttons" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "Three checkbuttons are displayed below. If you click on a button, it will toggle the button's selection state and set a Tcl variable to a value indicating the state of the checkbutton. Click the \"See Variables\" button to see the current values of the variables. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + frame $w.frame2 + + pack $w.msg -side top -fill both + pack $w.frame -side top -expand yes -fill both + pack $w.frame2 -side bottom -fill both + + checkbutton $w.frame.b1 -text "Wipers OK" -variable wipers -relief flat + checkbutton $w.frame.b2 -text "Brakes OK" -variable brakes -relief flat + checkbutton $w.frame.b3 -text "Driver Sober" -variable sober -relief flat + pack $w.frame.b1 $w.frame.b2 $w.frame.b3 -side top -pady 2 -expand yes \ + -anchor w + + button $w.frame2.ok -text OK -command "destroy $w" + button $w.frame2.vars -text "See Variables" \ + -command "showVars $w.dialog wipers brakes sober" + pack $w.frame2.ok $w.frame2.vars -side left -expand yes -fill both +} diff --git a/gcl-tk/demos/mkDialog.tcl b/gcl-tk/demos/mkDialog.tcl new file mode 100755 index 0000000..ce34202 --- /dev/null +++ b/gcl-tk/demos/mkDialog.tcl @@ -0,0 +1,63 @@ +# mkDialog w msgArgs list list ... +# +# Create a dialog box with a message and any number of buttons at +# the bottom. +# +# Arguments: +# w - Name to use for new top-level window. +# msgArgs - List of arguments to use when creating the message of the +# dialog box (e.g. text, justifcation, etc.) +# list - A two-element list that describes one of the buttons that +# will appear at the bottom of the dialog. The first element +# gives the text to be displayed in the button and the second +# gives the command to be invoked when the button is invoked. + +proc mkDialog {w msgArgs args} { + catch {destroy $w} + toplevel $w -class Dialog + wm title $w "Dialog box" + wm iconname $w "Dialog" + + # Create two frames in the main window. The top frame will hold the + # message and the bottom one will hold the buttons. Arrange them + # one above the other, with any extra vertical space split between + # them. + + frame $w.top -relief raised -border 1 + frame $w.bot -relief raised -border 1 + pack $w.top $w.bot -side top -fill both -expand yes + + # Create the message widget and arrange for it to be centered in the + # top frame. + + eval message $w.top.msg -justify center \ + -font -Adobe-times-medium-r-normal--*-180* $msgArgs + pack $w.top.msg -side top -expand yes -padx 3 -pady 3 + + # Create as many buttons as needed and arrange them from left to right + # in the bottom frame. Embed the left button in an additional sunken + # frame to indicate that it is the default button, and arrange for that + # button to be invoked as the default action for clicks and returns in + # the dialog. + + if {[llength $args] > 0} { + set arg [lindex $args 0] + frame $w.bot.0 -relief sunken -border 1 + pack $w.bot.0 -side left -expand yes -padx 10 -pady 10 + button $w.bot.0.button -text [lindex $arg 0] \ + -command "[lindex $arg 1]; destroy $w" + pack $w.bot.0.button -expand yes -padx 6 -pady 6 + bind $w "[lindex $arg 1]; destroy $w" + focus $w + + set i 1 + foreach arg [lrange $args 1 end] { + button $w.bot.$i -text [lindex $arg 0] \ + -command "[lindex $arg 1]; destroy $w" + pack $w.bot.$i -side left -expand yes -padx 10 + set i [expr $i+1] + } + } + bind $w [list focus $w] + focus $w +} diff --git a/gcl-tk/demos/mkEntry.lisp b/gcl-tk/demos/mkEntry.lisp new file mode 100755 index 0000000..8fee802 --- /dev/null +++ b/gcl-tk/demos/mkEntry.lisp @@ -0,0 +1,30 @@ +;;# mkEntry w +;; +;; Create a top-level window that displays a bunch of entries. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(in-package "TK") +(defun mkEntry (&optional (w '.e1)) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Entry Demonstration") + (wm :iconname w "Entries") + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 200 + :text "Three different entries are displayed below. You can add characters by pointing, clicking and typing. The usual emacs control characters control editing. Thus control-b back a char, control-f forward a char, control-a begin line, control-k kill rest of line, control-y yank. For entries that are too large to fit in the window all at once, you can scan through the entries by dragging with mouse button 2 pressed. Click the \"OK\" button when you've seen enough.") + (frame (conc w '.frame) :borderwidth 10) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) (conc w '.frame) (conc w '.ok) :side "top" :fill "both") + + (entry (conc w '.frame.e1) :relief "sunken") + (entry (conc w '.frame.e2) :relief "sunken") + (entry (conc w '.frame.e3) :relief "sunken") + (pack (conc w '.frame.e1) (conc w '.frame.e2) (conc w '.frame.e3) :side "top" :pady 5 :fill "x") + + (funcall (conc w '.frame.e1) :insert 0 "Initial value") + (funcall (conc w '.frame.e2) :insert "end" "This entry contains a long value, much too long ") + (funcall (conc w '.frame.e2) :insert "end" "to fit in the window at one time, so long in fact ") + (funcall (conc w '.frame.e2) :insert "end" "that you'll have to scan or scroll to see the end.") +) diff --git a/gcl-tk/demos/mkEntry.tcl b/gcl-tk/demos/mkEntry.tcl new file mode 100755 index 0000000..da0266c --- /dev/null +++ b/gcl-tk/demos/mkEntry.tcl @@ -0,0 +1,29 @@ +# mkEntry w +# +# Create a top-level window that displays a bunch of entries. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkEntry {{w .e1}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Entry Demonstration" + wm iconname $w "Entries" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 200 \ + -text "Three different entries are displayed below. You can add characters by pointing, clicking and typing. You can delete by selecting and typing Control-d. Backspace, Control-h, and Delete may be typed to erase the character just before the insertion point, Control-W erases the word just before the insertion point, and Control-u clears the entry. For entries that are too large to fit in the window all at once, you can scan through the entries by dragging with mouse button 2 pressed. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg $w.frame $w.ok -side top -fill both + + entry $w.frame.e1 -relief sunken + entry $w.frame.e2 -relief sunken + entry $w.frame.e3 -relief sunken + pack $w.frame.e1 $w.frame.e2 $w.frame.e3 -side top -pady 5 -fill x + + $w.frame.e1 insert 0 "Initial value" + $w.frame.e2 insert end "This entry contains a long value, much too long " + $w.frame.e2 insert end "to fit in the window at one time, so long in fact " + $w.frame.e2 insert end "that you'll have to scan or scroll to see the end." +} diff --git a/gcl-tk/demos/mkEntry2.lisp b/gcl-tk/demos/mkEntry2.lisp new file mode 100755 index 0000000..82ab8ba --- /dev/null +++ b/gcl-tk/demos/mkEntry2.lisp @@ -0,0 +1,39 @@ +;;# mkEntry2 - +;; +;; Create a top-level window that displays a bunch of entries with +;; scrollbars. +;; +;; Arguments: +;; w - Name to use for new top-level window. +(IN-package "TK") +(defun mkEntry2 (&optional (w '.e2)) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Entry Demonstration") + (wm :iconname w "Entries") + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 200 + :text "Three different entries are displayed below, with a scrollbar for each entry. You can add characters by pointing, clicking and typing. You can delete by selecting and typing Control-d. Backspace, Control-h, and Delete may be typed to erase the character just before the insertion point, Control-W erases the word just before the insertion point, and Control-u clears the entry. For entries that are too large to fit in the window all at once, you can scan through the entries using the scrollbars, or by dragging with mouse button 2 pressed. Click the \"OK\" button when you've seen enough.") + (frame (conc w '.frame) :borderwidth 10) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) (conc w '.frame) (conc w '.ok) :side "top" :fill "both") + + (entry (conc w '.frame.e1) :relief "sunken" :xscrollcommand (tk-conc w ".frame.s1 set")) + (scrollbar (conc w '.frame.s1) :relief "sunken" :orient "horiz" :command + (tk-conc w ".frame.e1 xview")) + (frame (conc w '.frame.f1) :width 20 :height 10) + (entry (conc w '.frame.e2) :relief "sunken" :xscrollcommand (tk-conc w ".frame.s2 set")) + (scrollbar (conc w '.frame.s2) :relief "sunken" :orient "horiz" :command + (tk-conc w ".frame.e2 xview")) + (frame (conc w '.frame.f2) :width 20 :height 10) + (entry (conc w '.frame.e3) :relief "sunken" :xscrollcommand (tk-conc w ".frame.s3 set")) + (scrollbar (conc w '.frame.s3) :relief "sunken" :orient "horiz" :command + (tk-conc w ".frame.e3 xview")) + (pack (conc w '.frame.e1) (conc w '.frame.s1) (conc w '.frame.f1) (conc w '.frame.e2) (conc w '.frame.s2) + (conc w '.frame.f2) (conc w '.frame.e3) (conc w '.frame.s3) :side "top" :fill "x") + + (funcall (conc w '.frame.e1) :insert 0 "Initial value") + (funcall (conc w '.frame.e2) :insert 'end "This entry contains a long value, much too long ") + (funcall (conc w '.frame.e2) :insert 'end "to fit in the window at one time, so long in fact ") + (funcall (conc w '.frame.e2) :insert 'end "that you'll have to scan or scroll to see the end.") +) diff --git a/gcl-tk/demos/mkEntry2.tcl b/gcl-tk/demos/mkEntry2.tcl new file mode 100755 index 0000000..306c410 --- /dev/null +++ b/gcl-tk/demos/mkEntry2.tcl @@ -0,0 +1,39 @@ +# mkEntry2 - +# +# Create a top-level window that displays a bunch of entries with +# scrollbars. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkEntry2 {{w .e2}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Entry Demonstration" + wm iconname $w "Entries" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 200 \ + -text "Three different entries are displayed below, with a scrollbar for each entry. You can add characters by pointing, clicking and typing. You can delete by selecting and typing Control-d. Backspace, Control-h, and Delete may be typed to erase the character just before the insertion point, Control-W erases the word just before the insertion point, and Control-u clears the entry. For entries that are too large to fit in the window all at once, you can scan through the entries using the scrollbars, or by dragging with mouse button 2 pressed. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg $w.frame $w.ok -side top -fill both + + entry $w.frame.e1 -relief sunken -xscrollcommand "$w.frame.s1 set" + scrollbar $w.frame.s1 -relief sunken -orient horiz -command \ + "$w.frame.e1 xview" + frame $w.frame.f1 + entry $w.frame.e2 -relief sunken -xscrollcommand "$w.frame.s2 set" + scrollbar $w.frame.s2 -relief sunken -orient horiz -command \ + "$w.frame.e2 xview" + frame $w.frame.f2 + entry $w.frame.e3 -relief sunken -xscrollcommand "$w.frame.s3 set" + scrollbar $w.frame.s3 -relief sunken -orient horiz -command \ + "$w.frame.e3 xview" + pack $w.frame.e1 $w.frame.s1 $w.frame.f1 $w.frame.e2 $w.frame.s2 \ + $w.frame.f2 $w.frame.e3 $w.frame.s3 -side top -fill x + + $w.frame.e1 insert 0 "Initial value" + $w.frame.e2 insert end "This entry contains a long value, much too long " + $w.frame.e2 insert end "to fit in the window at one time, so long in fact " + $w.frame.e2 insert end "that you'll have to scan or scroll to see the end." +} diff --git a/gcl-tk/demos/mkFloor.tcl b/gcl-tk/demos/mkFloor.tcl new file mode 100755 index 0000000..b033087 --- /dev/null +++ b/gcl-tk/demos/mkFloor.tcl @@ -0,0 +1,1276 @@ +# mkFloor w +# +# Create a top-level window containing a canvas that displays the +# floorplan for DEC's Western Research Laboratory. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkFloor {{w .cfloor}} { + global c tk_library currentRoom colors + catch {destroy $w} + toplevel $w +# dpos $w + wm title $w "Floorplan Canvas Demonstration" + wm iconname $w "Floorplan" + wm minsize $w 100 100 + set c $w.frame2.c + + message $w.msg -font *-Times-Medium-R-Normal-*-180-* -width 800 \ + -relief raised -bd 2 -text "This window contains a canvas widget showing the floorplan of Digital Equipment Corporation's Western Research Laboratory. It has three levels. At any given time one of the levels is active, meaning that you can see its room structure. To activate a level, click the left mouse button anywhere on it. As the mouse moves over the active level, the room under the mouse lights up and its room number appears in the \"Room:\" entry. You can also type a room number in the entry and the room will light up." + frame $w.frame2 -relief raised -bd 2 + button $w.ok -text "OK" -command "destroy $w" + pack $w.msg -side top -fill both + pack $w.frame2 -side top -fill both -expand yes + pack $w.ok -side bottom -pady 5 + + scrollbar $w.frame2.vscroll -relief sunken -command "$c yview" + scrollbar $w.frame2.hscroll -orient horiz -relief sunken -command "$c xview" + canvas $c -width 900 -height 500 -xscrollcommand "$w.frame2.hscroll set" \ + -yscrollcommand "$w.frame2.vscroll set" + pack $w.frame2.hscroll -side bottom -fill x + pack $w.frame2.vscroll -side right -fill y + pack $c -in $w.frame2 -expand yes -fill both + + # Create an entry for displaying and typing in current room. + + entry $c.entry -width 10 -relief sunken -bd 2 -textvariable currentRoom + + # Choose colors, then fill in the floorplan. + + if {[winfo depth $c] > 1} { + set colors(bg1) #c0a3db55dc28 + set colors(outline1) #70207f868000 + set colors(bg2) #aeb8c6eec7ad + set colors(outline2) #59b466056666 + set colors(bg3) #9cfab288b333 + set colors(outline3) #43474c834ccd + set colors(offices) Black + set colors(active) #dae0f278f332 + } else { + set colors(bg1) white + set colors(outline1) black + set colors(bg2) white + set colors(outline2) black + set colors(bg3) white + set colors(outline3) black + set colors(offices) Black + set colors(active) black + } + floorDisplay $c 3 + + # Set up event bindings for canvas: + + $c bind floor1 <1> "floorDisplay $c 1" + $c bind floor2 <1> "floorDisplay $c 2" + $c bind floor3 <1> "floorDisplay $c 3" + $c bind room \ + "set currentRoom \$floorLabels(\[$c find withtag current\]) + update idletasks" + $c bind room {set currentRoom ""} + bind $c <2> "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" + bind $c "unset currentRoom" + bind $c "focus $c.entry" + set currentRoom "" + trace variable currentRoom w "roomChanged $c" +} + +set activeFloor "" + +# The following procedure recreates the floorplan display in the canvas +# given by "w". The floor given by "active" (1, 2, or 3) is displayed +# on top, with office structure visible. + +proc floorDisplay {w active} { + global floorLabels floorItems colors activeFloor + + if {$activeFloor == $active} { + return + } + + $w delete all + set activeFloor $active + + # First go through the three floors, displaying the backgrounds for + # each floor. + + bg1 $w $colors(bg1) $colors(outline1) + bg2 $w $colors(bg2) $colors(outline2) + bg3 $w $colors(bg3) $colors(outline3) + + # Raise the background for the active floor so that it's on top. + + $w raise floor$active + + # Create a dummy item just to mark this point in the display list, + # so we can insert highlights here. + + $w create rect 0 100 1 101 -fill {} -outline {} -tags marker + + # Add the walls and labels for the active floor, along with + # transparent polygons that define the rooms on the floor. + # Make sure that the room polygons are on top. + + catch {unset floorLabels} + catch {unset floorItems} + fg$active $w $colors(offices) + $w raise room + + # Offset the floors diagonally from each other. + + $w move floor1 2c 2c + $w move floor2 1c 1c + + # Create items for the room entry and its label. + + $w create window 600 100 -anchor w -window $w.entry + $w create text 600 100 -anchor e -text "Room: " + $w config -scrollregion [$w bbox all] +} + +# This procedure is invoked whenever the currentRoom variable changes. +# It highlights the current room and unhighlights any previous room. + +proc roomChanged {w args} { + global currentRoom floorItems colors + $w delete highlight + if [catch {set item $floorItems($currentRoom)}] { + return + } + set new [eval \ + "$w create polygon [$w coords $item] -fill $colors(active) \ + -tags highlight"] + $w raise $new marker +} + +# The following procedures are invoked to instantiate various portions +# of the building floorplan. The bodies of these procedures were +# generated automatically from database files describing the building. + +proc bg1 {w fill outline} { + $w create poly 347 80 349 82 351 84 353 85 363 92 375 99 386 104 \ + 386 129 398 129 398 162 484 162 484 129 559 129 559 133 725 \ + 133 725 129 802 129 802 389 644 389 644 391 559 391 559 327 \ + 508 327 508 311 484 311 484 278 395 278 395 288 400 288 404 \ + 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 \ + 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 \ + 342 331 347 332 351 334 354 336 357 341 359 340 360 335 363 \ + 331 365 326 366 304 366 304 355 258 355 258 387 60 387 60 391 \ + 0 391 0 337 3 337 3 114 8 114 8 25 30 25 30 5 93 5 98 5 104 7 \ + 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 34 221 \ + 22 223 17 227 13 231 8 236 4 242 2 246 0 260 0 283 1 300 5 \ + 321 14 335 22 348 25 365 29 363 39 358 48 352 56 337 70 \ + 344 76 347 80 \ + -tags {floor1 bg} -fill $fill + $w create line 386 129 398 129 -fill $outline -tags {floor1 bg} + $w create line 258 355 258 387 -fill $outline -tags {floor1 bg} + $w create line 60 387 60 391 -fill $outline -tags {floor1 bg} + $w create line 0 337 0 391 -fill $outline -tags {floor1 bg} + $w create line 60 391 0 391 -fill $outline -tags {floor1 bg} + $w create line 3 114 3 337 -fill $outline -tags {floor1 bg} + $w create line 258 387 60 387 -fill $outline -tags {floor1 bg} + $w create line 484 162 398 162 -fill $outline -tags {floor1 bg} + $w create line 398 162 398 129 -fill $outline -tags {floor1 bg} + $w create line 484 278 484 311 -fill $outline -tags {floor1 bg} + $w create line 484 311 508 311 -fill $outline -tags {floor1 bg} + $w create line 508 327 508 311 -fill $outline -tags {floor1 bg} + $w create line 559 327 508 327 -fill $outline -tags {floor1 bg} + $w create line 644 391 559 391 -fill $outline -tags {floor1 bg} + $w create line 644 389 644 391 -fill $outline -tags {floor1 bg} + $w create line 559 129 484 129 -fill $outline -tags {floor1 bg} + $w create line 484 162 484 129 -fill $outline -tags {floor1 bg} + $w create line 725 133 559 133 -fill $outline -tags {floor1 bg} + $w create line 559 129 559 133 -fill $outline -tags {floor1 bg} + $w create line 725 129 802 129 -fill $outline -tags {floor1 bg} + $w create line 802 389 802 129 -fill $outline -tags {floor1 bg} + $w create line 3 337 0 337 -fill $outline -tags {floor1 bg} + $w create line 559 391 559 327 -fill $outline -tags {floor1 bg} + $w create line 802 389 644 389 -fill $outline -tags {floor1 bg} + $w create line 725 133 725 129 -fill $outline -tags {floor1 bg} + $w create line 8 25 8 114 -fill $outline -tags {floor1 bg} + $w create line 8 114 3 114 -fill $outline -tags {floor1 bg} + $w create line 30 25 8 25 -fill $outline -tags {floor1 bg} + $w create line 484 278 395 278 -fill $outline -tags {floor1 bg} + $w create line 30 25 30 5 -fill $outline -tags {floor1 bg} + $w create line 93 5 30 5 -fill $outline -tags {floor1 bg} + $w create line 98 5 93 5 -fill $outline -tags {floor1 bg} + $w create line 104 7 98 5 -fill $outline -tags {floor1 bg} + $w create line 110 10 104 7 -fill $outline -tags {floor1 bg} + $w create line 116 16 110 10 -fill $outline -tags {floor1 bg} + $w create line 119 20 116 16 -fill $outline -tags {floor1 bg} + $w create line 122 28 119 20 -fill $outline -tags {floor1 bg} + $w create line 123 32 122 28 -fill $outline -tags {floor1 bg} + $w create line 123 68 123 32 -fill $outline -tags {floor1 bg} + $w create line 220 68 123 68 -fill $outline -tags {floor1 bg} + $w create line 386 129 386 104 -fill $outline -tags {floor1 bg} + $w create line 386 104 375 99 -fill $outline -tags {floor1 bg} + $w create line 375 99 363 92 -fill $outline -tags {floor1 bg} + $w create line 353 85 363 92 -fill $outline -tags {floor1 bg} + $w create line 220 68 220 34 -fill $outline -tags {floor1 bg} + $w create line 337 70 352 56 -fill $outline -tags {floor1 bg} + $w create line 352 56 358 48 -fill $outline -tags {floor1 bg} + $w create line 358 48 363 39 -fill $outline -tags {floor1 bg} + $w create line 363 39 365 29 -fill $outline -tags {floor1 bg} + $w create line 365 29 348 25 -fill $outline -tags {floor1 bg} + $w create line 348 25 335 22 -fill $outline -tags {floor1 bg} + $w create line 335 22 321 14 -fill $outline -tags {floor1 bg} + $w create line 321 14 300 5 -fill $outline -tags {floor1 bg} + $w create line 300 5 283 1 -fill $outline -tags {floor1 bg} + $w create line 283 1 260 0 -fill $outline -tags {floor1 bg} + $w create line 260 0 246 0 -fill $outline -tags {floor1 bg} + $w create line 246 0 242 2 -fill $outline -tags {floor1 bg} + $w create line 242 2 236 4 -fill $outline -tags {floor1 bg} + $w create line 236 4 231 8 -fill $outline -tags {floor1 bg} + $w create line 231 8 227 13 -fill $outline -tags {floor1 bg} + $w create line 223 17 227 13 -fill $outline -tags {floor1 bg} + $w create line 221 22 223 17 -fill $outline -tags {floor1 bg} + $w create line 220 34 221 22 -fill $outline -tags {floor1 bg} + $w create line 340 360 335 363 -fill $outline -tags {floor1 bg} + $w create line 335 363 331 365 -fill $outline -tags {floor1 bg} + $w create line 331 365 326 366 -fill $outline -tags {floor1 bg} + $w create line 326 366 304 366 -fill $outline -tags {floor1 bg} + $w create line 304 355 304 366 -fill $outline -tags {floor1 bg} + $w create line 395 288 400 288 -fill $outline -tags {floor1 bg} + $w create line 404 288 400 288 -fill $outline -tags {floor1 bg} + $w create line 409 290 404 288 -fill $outline -tags {floor1 bg} + $w create line 413 292 409 290 -fill $outline -tags {floor1 bg} + $w create line 418 297 413 292 -fill $outline -tags {floor1 bg} + $w create line 421 302 418 297 -fill $outline -tags {floor1 bg} + $w create line 422 309 421 302 -fill $outline -tags {floor1 bg} + $w create line 421 318 422 309 -fill $outline -tags {floor1 bg} + $w create line 421 318 417 325 -fill $outline -tags {floor1 bg} + $w create line 417 325 411 330 -fill $outline -tags {floor1 bg} + $w create line 411 330 405 332 -fill $outline -tags {floor1 bg} + $w create line 405 332 397 333 -fill $outline -tags {floor1 bg} + $w create line 397 333 344 333 -fill $outline -tags {floor1 bg} + $w create line 344 333 340 334 -fill $outline -tags {floor1 bg} + $w create line 340 334 336 336 -fill $outline -tags {floor1 bg} + $w create line 336 336 335 338 -fill $outline -tags {floor1 bg} + $w create line 335 338 332 342 -fill $outline -tags {floor1 bg} + $w create line 331 347 332 342 -fill $outline -tags {floor1 bg} + $w create line 332 351 331 347 -fill $outline -tags {floor1 bg} + $w create line 334 354 332 351 -fill $outline -tags {floor1 bg} + $w create line 336 357 334 354 -fill $outline -tags {floor1 bg} + $w create line 341 359 336 357 -fill $outline -tags {floor1 bg} + $w create line 341 359 340 360 -fill $outline -tags {floor1 bg} + $w create line 395 288 395 278 -fill $outline -tags {floor1 bg} + $w create line 304 355 258 355 -fill $outline -tags {floor1 bg} + $w create line 347 80 344 76 -fill $outline -tags {floor1 bg} + $w create line 344 76 337 70 -fill $outline -tags {floor1 bg} + $w create line 349 82 347 80 -fill $outline -tags {floor1 bg} + $w create line 351 84 349 82 -fill $outline -tags {floor1 bg} + $w create line 353 85 351 84 -fill $outline -tags {floor1 bg} +} + +proc bg2 {w fill outline} { + $w create poly 559 129 484 129 484 162 398 162 398 129 315 129 \ + 315 133 176 133 176 129 96 129 96 133 3 133 3 339 0 339 0 391 \ + 60 391 60 387 258 387 258 329 350 329 350 311 395 311 395 280 \ + 484 280 484 311 508 311 508 327 558 327 558 391 644 391 644 \ + 367 802 367 802 129 725 129 725 133 559 133 559 129 \ + -tags {floor2 bg} -fill $fill + $w create line 350 311 350 329 -fill $outline -tags {floor2 bg} + $w create line 398 129 398 162 -fill $outline -tags {floor2 bg} + $w create line 802 367 802 129 -fill $outline -tags {floor2 bg} + $w create line 802 129 725 129 -fill $outline -tags {floor2 bg} + $w create line 725 133 725 129 -fill $outline -tags {floor2 bg} + $w create line 559 129 559 133 -fill $outline -tags {floor2 bg} + $w create line 559 133 725 133 -fill $outline -tags {floor2 bg} + $w create line 484 162 484 129 -fill $outline -tags {floor2 bg} + $w create line 559 129 484 129 -fill $outline -tags {floor2 bg} + $w create line 802 367 644 367 -fill $outline -tags {floor2 bg} + $w create line 644 367 644 391 -fill $outline -tags {floor2 bg} + $w create line 644 391 558 391 -fill $outline -tags {floor2 bg} + $w create line 558 327 558 391 -fill $outline -tags {floor2 bg} + $w create line 558 327 508 327 -fill $outline -tags {floor2 bg} + $w create line 508 327 508 311 -fill $outline -tags {floor2 bg} + $w create line 484 311 508 311 -fill $outline -tags {floor2 bg} + $w create line 484 280 484 311 -fill $outline -tags {floor2 bg} + $w create line 398 162 484 162 -fill $outline -tags {floor2 bg} + $w create line 484 280 395 280 -fill $outline -tags {floor2 bg} + $w create line 395 280 395 311 -fill $outline -tags {floor2 bg} + $w create line 258 387 60 387 -fill $outline -tags {floor2 bg} + $w create line 3 133 3 339 -fill $outline -tags {floor2 bg} + $w create line 3 339 0 339 -fill $outline -tags {floor2 bg} + $w create line 60 391 0 391 -fill $outline -tags {floor2 bg} + $w create line 0 339 0 391 -fill $outline -tags {floor2 bg} + $w create line 60 387 60 391 -fill $outline -tags {floor2 bg} + $w create line 258 329 258 387 -fill $outline -tags {floor2 bg} + $w create line 350 329 258 329 -fill $outline -tags {floor2 bg} + $w create line 395 311 350 311 -fill $outline -tags {floor2 bg} + $w create line 398 129 315 129 -fill $outline -tags {floor2 bg} + $w create line 176 133 315 133 -fill $outline -tags {floor2 bg} + $w create line 176 129 96 129 -fill $outline -tags {floor2 bg} + $w create line 3 133 96 133 -fill $outline -tags {floor2 bg} + $w create line 315 133 315 129 -fill $outline -tags {floor2 bg} + $w create line 176 133 176 129 -fill $outline -tags {floor2 bg} + $w create line 96 133 96 129 -fill $outline -tags {floor2 bg} +} + +proc bg3 {w fill outline} { + $w create poly 159 300 107 300 107 248 159 248 159 129 96 129 96 \ + 133 21 133 21 331 0 331 0 391 60 391 60 370 159 370 159 300 \ + -tags {floor3 bg} -fill $fill + $w create poly 258 370 258 329 350 329 350 311 399 311 399 129 \ + 315 129 315 133 176 133 176 129 159 129 159 370 258 370 \ + -tags {floor3 bg} -fill $fill + $w create line 96 133 96 129 -fill $outline -tags {floor3 bg} + $w create line 176 129 96 129 -fill $outline -tags {floor3 bg} + $w create line 176 129 176 133 -fill $outline -tags {floor3 bg} + $w create line 315 133 176 133 -fill $outline -tags {floor3 bg} + $w create line 315 133 315 129 -fill $outline -tags {floor3 bg} + $w create line 399 129 315 129 -fill $outline -tags {floor3 bg} + $w create line 399 311 399 129 -fill $outline -tags {floor3 bg} + $w create line 399 311 350 311 -fill $outline -tags {floor3 bg} + $w create line 350 329 350 311 -fill $outline -tags {floor3 bg} + $w create line 350 329 258 329 -fill $outline -tags {floor3 bg} + $w create line 258 370 258 329 -fill $outline -tags {floor3 bg} + $w create line 60 370 258 370 -fill $outline -tags {floor3 bg} + $w create line 60 370 60 391 -fill $outline -tags {floor3 bg} + $w create line 60 391 0 391 -fill $outline -tags {floor3 bg} + $w create line 0 391 0 331 -fill $outline -tags {floor3 bg} + $w create line 21 331 0 331 -fill $outline -tags {floor3 bg} + $w create line 21 331 21 133 -fill $outline -tags {floor3 bg} + $w create line 96 133 21 133 -fill $outline -tags {floor3 bg} + $w create line 107 300 159 300 159 248 107 248 107 300 \ + -fill $outline -tags {floor3 bg} +} + +proc fg1 {w color} { + global floorLabels floorItems + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor1 room}] + set floorLabels($i) 101 + set {floorItems(101)} $i + $w create text 358 209 -text 101 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor1 room}] + set floorLabels($i) {Pub Lift1} + set {floorItems(Pub Lift1)} $i + $w create text 323 223 -text {Pub Lift1} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor1 room}] + set floorLabels($i) {Priv Lift1} + set {floorItems(Priv Lift1)} $i + $w create text 323 188 -text {Priv Lift1} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 42 389 42 337 1 337 1 389 -fill {} -tags {floor1 room}] + set floorLabels($i) 110 + set {floorItems(110)} $i + $w create text 21.5 363 -text 110 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 59 389 59 385 90 385 90 337 44 337 44 389 -fill {} -tags {floor1 room}] + set floorLabels($i) 109 + set {floorItems(109)} $i + $w create text 67 363 -text 109 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 51 300 51 253 6 253 6 300 -fill {} -tags {floor1 room}] + set floorLabels($i) 111 + set {floorItems(111)} $i + $w create text 28.5 276.5 -text 111 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 98 248 98 309 79 309 79 248 -fill {} -tags {floor1 room}] + set floorLabels($i) 117B + set {floorItems(117B)} $i + $w create text 88.5 278.5 -text 117B -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 51 251 51 204 6 204 6 251 -fill {} -tags {floor1 room}] + set floorLabels($i) 112 + set {floorItems(112)} $i + $w create text 28.5 227.5 -text 112 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 6 156 51 156 51 203 6 203 -fill {} -tags {floor1 room}] + set floorLabels($i) 113 + set {floorItems(113)} $i + $w create text 28.5 179.5 -text 113 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 85 169 79 169 79 192 85 192 -fill {} -tags {floor1 room}] + set floorLabels($i) 117A + set {floorItems(117A)} $i + $w create text 82 180.5 -text 117A -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 77 302 77 168 53 168 53 302 -fill {} -tags {floor1 room}] + set floorLabels($i) 117 + set {floorItems(117)} $i + $w create text 65 235 -text 117 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 51 155 51 115 6 115 6 155 -fill {} -tags {floor1 room}] + set floorLabels($i) 114 + set {floorItems(114)} $i + $w create text 28.5 135 -text 114 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 95 115 53 115 53 168 95 168 -fill {} -tags {floor1 room}] + set floorLabels($i) 115 + set {floorItems(115)} $i + $w create text 74 141.5 -text 115 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 87 113 87 27 10 27 10 113 -fill {} -tags {floor1 room}] + set floorLabels($i) 116 + set {floorItems(116)} $i + $w create text 48.5 70 -text 116 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 89 91 128 91 128 113 89 113 -fill {} -tags {floor1 room}] + set floorLabels($i) 118 + set {floorItems(118)} $i + $w create text 108.5 102 -text 118 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 178 128 178 132 216 132 216 91 163 91 163 112 149 112 149 128 -fill {} -tags {floor1 room}] + set floorLabels($i) 120 + set {floorItems(120)} $i + $w create text 189.5 111.5 -text 120 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 79 193 87 193 87 169 136 169 136 192 156 192 156 169 175 169 175 246 79 246 -fill {} -tags {floor1 room}] + set floorLabels($i) 122 + set {floorItems(122)} $i + $w create text 131 207.5 -text 122 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 138 169 154 169 154 191 138 191 -fill {} -tags {floor1 room}] + set floorLabels($i) 121 + set {floorItems(121)} $i + $w create text 146 180 -text 121 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 99 300 126 300 126 309 99 309 -fill {} -tags {floor1 room}] + set floorLabels($i) 106A + set {floorItems(106A)} $i + $w create text 112.5 304.5 -text 106A -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 128 299 128 309 150 309 150 248 99 248 99 299 -fill {} -tags {floor1 room}] + set floorLabels($i) 105 + set {floorItems(105)} $i + $w create text 124.5 278.5 -text 105 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 174 309 174 300 152 300 152 309 -fill {} -tags {floor1 room}] + set floorLabels($i) 106B + set {floorItems(106B)} $i + $w create text 163 304.5 -text 106B -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 176 299 176 309 216 309 216 248 152 248 152 299 -fill {} -tags {floor1 room}] + set floorLabels($i) 104 + set {floorItems(104)} $i + $w create text 184 278.5 -text 104 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 138 385 138 337 91 337 91 385 -fill {} -tags {floor1 room}] + set floorLabels($i) 108 + set {floorItems(108)} $i + $w create text 114.5 361 -text 108 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 256 337 140 337 140 385 256 385 -fill {} -tags {floor1 room}] + set floorLabels($i) 107 + set {floorItems(107)} $i + $w create text 198 361 -text 107 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 300 353 300 329 260 329 260 353 -fill {} -tags {floor1 room}] + set floorLabels($i) Smoking + set {floorItems(Smoking)} $i + $w create text 280 341 -text Smoking -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 314 135 314 170 306 170 306 246 177 246 177 135 -fill {} -tags {floor1 room}] + set floorLabels($i) 123 + set {floorItems(123)} $i + $w create text 245.5 190.5 -text 123 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 217 248 301 248 301 326 257 326 257 310 217 310 -fill {} -tags {floor1 room}] + set floorLabels($i) 103 + set {floorItems(103)} $i + $w create text 259 287 -text 103 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 396 188 377 188 377 169 316 169 316 131 396 131 -fill {} -tags {floor1 room}] + set floorLabels($i) 124 + set {floorItems(124)} $i + $w create text 356 150 -text 124 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 397 226 407 226 407 189 377 189 377 246 397 246 -fill {} -tags {floor1 room}] + set floorLabels($i) 125 + set {floorItems(125)} $i + $w create text 392 217.5 -text 125 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 399 187 409 187 409 207 474 207 474 164 399 164 -fill {} -tags {floor1 room}] + set floorLabels($i) 126 + set {floorItems(126)} $i + $w create text 436.5 185.5 -text 126 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 409 209 409 229 399 229 399 253 486 253 486 239 474 239 474 209 -fill {} -tags {floor1 room}] + set floorLabels($i) 127 + set {floorItems(127)} $i + $w create text 436.5 231 -text 127 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 501 164 501 174 495 174 495 188 490 188 490 204 476 204 476 164 -fill {} -tags {floor1 room}] + set floorLabels($i) MShower + set {floorItems(MShower)} $i + $w create text 488.5 184 -text MShower -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 497 176 513 176 513 204 492 204 492 190 497 190 -fill {} -tags {floor1 room}] + set floorLabels($i) Closet + set {floorItems(Closet)} $i + $w create text 502.5 190 -text Closet -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 476 237 476 206 513 206 513 254 488 254 488 237 -fill {} -tags {floor1 room}] + set floorLabels($i) WShower + set {floorItems(WShower)} $i + $w create text 494.5 230 -text WShower -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 486 131 558 131 558 135 724 135 724 166 697 166 697 275 553 275 531 254 515 254 515 174 503 174 503 161 486 161 -fill {} -tags {floor1 room}] + set floorLabels($i) 130 + set {floorItems(130)} $i + $w create text 638.5 205 -text 130 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 308 242 339 242 339 248 342 248 342 246 397 246 397 276 393 276 393 309 300 309 300 248 308 248 -fill {} -tags {floor1 room}] + set floorLabels($i) 102 + set {floorItems(102)} $i + $w create text 367.5 278.5 -text 102 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 397 255 486 255 486 276 397 276 -fill {} -tags {floor1 room}] + set floorLabels($i) 128 + set {floorItems(128)} $i + $w create text 441.5 265.5 -text 128 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 510 309 486 309 486 255 530 255 552 277 561 277 561 325 510 325 -fill {} -tags {floor1 room}] + set floorLabels($i) 129 + set {floorItems(129)} $i + $w create text 535.5 293 -text 129 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 696 281 740 281 740 387 642 387 642 389 561 389 561 277 696 277 -fill {} -tags {floor1 room}] + set floorLabels($i) 133 + set {floorItems(133)} $i + $w create text 628.5 335 -text 133 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 742 387 742 281 800 281 800 387 -fill {} -tags {floor1 room}] + set floorLabels($i) 132 + set {floorItems(132)} $i + $w create text 771 334 -text 132 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 800 168 800 280 699 280 699 168 -fill {} -tags {floor1 room}] + set floorLabels($i) 134 + set {floorItems(134)} $i + $w create text 749.5 224 -text 134 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 726 131 726 166 800 166 800 131 -fill {} -tags {floor1 room}] + set floorLabels($i) 135 + set {floorItems(135)} $i + $w create text 763 148.5 -text 135 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 340 360 335 363 331 365 326 366 304 366 304 312 396 312 396 288 400 288 404 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 342 331 347 332 351 334 354 336 357 341 359 -fill {} -tags {floor1 room}] + set floorLabels($i) {Ramona Stair} + set {floorItems(Ramona Stair)} $i + $w create text 368 323 -text {Ramona Stair} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 30 23 30 5 93 5 98 5 104 7 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 87 90 87 90 23 -fill {} -tags {floor1 room}] + set floorLabels($i) {University Stair} + set {floorItems(University Stair)} $i + $w create text 155 77.5 -text {University Stair} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 282 37 295 40 312 49 323 56 337 70 352 56 358 48 363 39 365 29 348 25 335 22 321 14 300 5 283 1 260 0 246 0 242 2 236 4 231 8 227 13 223 17 221 22 220 34 260 34 -fill {} -tags {floor1 room}] + set floorLabels($i) {Plaza Stair} + set {floorItems(Plaza Stair)} $i + $w create text 317.5 28.5 -text {Plaza Stair} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 220 34 260 34 282 37 295 40 312 49 323 56 337 70 350 83 365 94 377 100 386 104 386 128 220 128 -fill {} -tags {floor1 room}] + set floorLabels($i) {Plaza Deck} + set {floorItems(Plaza Deck)} $i + $w create text 303 81 -text {Plaza Deck} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 257 336 77 336 6 336 6 301 77 301 77 310 257 310 -fill {} -tags {floor1 room}] + set floorLabels($i) 106 + set {floorItems(106)} $i + $w create text 131.5 318.5 -text 106 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 146 110 162 110 162 91 130 91 130 115 95 115 95 128 114 128 114 151 157 151 157 153 112 153 112 130 97 130 97 168 175 168 175 131 146 131 -fill {} -tags {floor1 room}] + set floorLabels($i) 119 + set {floorItems(119)} $i + $w create text 143.5 133 -text 119 -fill $color -anchor c -tags {floor1 label} + $w create line 155 191 155 189 -fill $color -tags {floor1 wall} + $w create line 155 177 155 169 -fill $color -tags {floor1 wall} + $w create line 96 129 96 169 -fill $color -tags {floor1 wall} + $w create line 78 169 176 169 -fill $color -tags {floor1 wall} + $w create line 176 247 176 129 -fill $color -tags {floor1 wall} + $w create line 340 206 307 206 -fill $color -tags {floor1 wall} + $w create line 340 187 340 170 -fill $color -tags {floor1 wall} + $w create line 340 210 340 201 -fill $color -tags {floor1 wall} + $w create line 340 247 340 224 -fill $color -tags {floor1 wall} + $w create line 340 241 307 241 -fill $color -tags {floor1 wall} + $w create line 376 246 376 170 -fill $color -tags {floor1 wall} + $w create line 307 247 307 170 -fill $color -tags {floor1 wall} + $w create line 376 170 307 170 -fill $color -tags {floor1 wall} + $w create line 315 129 315 170 -fill $color -tags {floor1 wall} + $w create line 147 129 176 129 -fill $color -tags {floor1 wall} + $w create line 202 133 176 133 -fill $color -tags {floor1 wall} + $w create line 398 129 315 129 -fill $color -tags {floor1 wall} + $w create line 258 352 258 387 -fill $color -tags {floor1 wall} + $w create line 60 387 60 391 -fill $color -tags {floor1 wall} + $w create line 0 337 0 391 -fill $color -tags {floor1 wall} + $w create line 60 391 0 391 -fill $color -tags {floor1 wall} + $w create line 3 114 3 337 -fill $color -tags {floor1 wall} + $w create line 258 387 60 387 -fill $color -tags {floor1 wall} + $w create line 52 237 52 273 -fill $color -tags {floor1 wall} + $w create line 52 189 52 225 -fill $color -tags {floor1 wall} + $w create line 52 140 52 177 -fill $color -tags {floor1 wall} + $w create line 395 306 395 311 -fill $color -tags {floor1 wall} + $w create line 531 254 398 254 -fill $color -tags {floor1 wall} + $w create line 475 178 475 238 -fill $color -tags {floor1 wall} + $w create line 502 162 398 162 -fill $color -tags {floor1 wall} + $w create line 398 129 398 188 -fill $color -tags {floor1 wall} + $w create line 383 188 376 188 -fill $color -tags {floor1 wall} + $w create line 408 188 408 194 -fill $color -tags {floor1 wall} + $w create line 398 227 398 254 -fill $color -tags {floor1 wall} + $w create line 408 227 398 227 -fill $color -tags {floor1 wall} + $w create line 408 222 408 227 -fill $color -tags {floor1 wall} + $w create line 408 206 408 210 -fill $color -tags {floor1 wall} + $w create line 408 208 475 208 -fill $color -tags {floor1 wall} + $w create line 484 278 484 311 -fill $color -tags {floor1 wall} + $w create line 484 311 508 311 -fill $color -tags {floor1 wall} + $w create line 508 327 508 311 -fill $color -tags {floor1 wall} + $w create line 559 327 508 327 -fill $color -tags {floor1 wall} + $w create line 644 391 559 391 -fill $color -tags {floor1 wall} + $w create line 644 389 644 391 -fill $color -tags {floor1 wall} + $w create line 514 205 475 205 -fill $color -tags {floor1 wall} + $w create line 496 189 496 187 -fill $color -tags {floor1 wall} + $w create line 559 129 484 129 -fill $color -tags {floor1 wall} + $w create line 484 162 484 129 -fill $color -tags {floor1 wall} + $w create line 725 133 559 133 -fill $color -tags {floor1 wall} + $w create line 559 129 559 133 -fill $color -tags {floor1 wall} + $w create line 725 149 725 167 -fill $color -tags {floor1 wall} + $w create line 725 129 802 129 -fill $color -tags {floor1 wall} + $w create line 802 389 802 129 -fill $color -tags {floor1 wall} + $w create line 739 167 802 167 -fill $color -tags {floor1 wall} + $w create line 396 188 408 188 -fill $color -tags {floor1 wall} + $w create line 0 337 9 337 -fill $color -tags {floor1 wall} + $w create line 58 337 21 337 -fill $color -tags {floor1 wall} + $w create line 43 391 43 337 -fill $color -tags {floor1 wall} + $w create line 105 337 75 337 -fill $color -tags {floor1 wall} + $w create line 91 387 91 337 -fill $color -tags {floor1 wall} + $w create line 154 337 117 337 -fill $color -tags {floor1 wall} + $w create line 139 387 139 337 -fill $color -tags {floor1 wall} + $w create line 227 337 166 337 -fill $color -tags {floor1 wall} + $w create line 258 337 251 337 -fill $color -tags {floor1 wall} + $w create line 258 328 302 328 -fill $color -tags {floor1 wall} + $w create line 302 355 302 311 -fill $color -tags {floor1 wall} + $w create line 395 311 302 311 -fill $color -tags {floor1 wall} + $w create line 484 278 395 278 -fill $color -tags {floor1 wall} + $w create line 395 294 395 278 -fill $color -tags {floor1 wall} + $w create line 473 278 473 275 -fill $color -tags {floor1 wall} + $w create line 473 256 473 254 -fill $color -tags {floor1 wall} + $w create line 533 257 531 254 -fill $color -tags {floor1 wall} + $w create line 553 276 551 274 -fill $color -tags {floor1 wall} + $w create line 698 276 553 276 -fill $color -tags {floor1 wall} + $w create line 559 391 559 327 -fill $color -tags {floor1 wall} + $w create line 802 389 644 389 -fill $color -tags {floor1 wall} + $w create line 741 314 741 389 -fill $color -tags {floor1 wall} + $w create line 698 280 698 167 -fill $color -tags {floor1 wall} + $w create line 707 280 698 280 -fill $color -tags {floor1 wall} + $w create line 802 280 731 280 -fill $color -tags {floor1 wall} + $w create line 741 280 741 302 -fill $color -tags {floor1 wall} + $w create line 698 167 727 167 -fill $color -tags {floor1 wall} + $w create line 725 137 725 129 -fill $color -tags {floor1 wall} + $w create line 514 254 514 175 -fill $color -tags {floor1 wall} + $w create line 496 175 514 175 -fill $color -tags {floor1 wall} + $w create line 502 175 502 162 -fill $color -tags {floor1 wall} + $w create line 475 166 475 162 -fill $color -tags {floor1 wall} + $w create line 496 176 496 175 -fill $color -tags {floor1 wall} + $w create line 491 189 496 189 -fill $color -tags {floor1 wall} + $w create line 491 205 491 189 -fill $color -tags {floor1 wall} + $w create line 487 238 475 238 -fill $color -tags {floor1 wall} + $w create line 487 240 487 238 -fill $color -tags {floor1 wall} + $w create line 487 252 487 254 -fill $color -tags {floor1 wall} + $w create line 315 133 304 133 -fill $color -tags {floor1 wall} + $w create line 256 133 280 133 -fill $color -tags {floor1 wall} + $w create line 78 247 270 247 -fill $color -tags {floor1 wall} + $w create line 307 247 294 247 -fill $color -tags {floor1 wall} + $w create line 214 133 232 133 -fill $color -tags {floor1 wall} + $w create line 217 247 217 266 -fill $color -tags {floor1 wall} + $w create line 217 309 217 291 -fill $color -tags {floor1 wall} + $w create line 217 309 172 309 -fill $color -tags {floor1 wall} + $w create line 154 309 148 309 -fill $color -tags {floor1 wall} + $w create line 175 300 175 309 -fill $color -tags {floor1 wall} + $w create line 151 300 175 300 -fill $color -tags {floor1 wall} + $w create line 151 247 151 309 -fill $color -tags {floor1 wall} + $w create line 78 237 78 265 -fill $color -tags {floor1 wall} + $w create line 78 286 78 309 -fill $color -tags {floor1 wall} + $w create line 106 309 78 309 -fill $color -tags {floor1 wall} + $w create line 130 309 125 309 -fill $color -tags {floor1 wall} + $w create line 99 309 99 247 -fill $color -tags {floor1 wall} + $w create line 127 299 99 299 -fill $color -tags {floor1 wall} + $w create line 127 309 127 299 -fill $color -tags {floor1 wall} + $w create line 155 191 137 191 -fill $color -tags {floor1 wall} + $w create line 137 169 137 191 -fill $color -tags {floor1 wall} + $w create line 78 171 78 169 -fill $color -tags {floor1 wall} + $w create line 78 190 78 218 -fill $color -tags {floor1 wall} + $w create line 86 192 86 169 -fill $color -tags {floor1 wall} + $w create line 86 192 78 192 -fill $color -tags {floor1 wall} + $w create line 52 301 3 301 -fill $color -tags {floor1 wall} + $w create line 52 286 52 301 -fill $color -tags {floor1 wall} + $w create line 52 252 3 252 -fill $color -tags {floor1 wall} + $w create line 52 203 3 203 -fill $color -tags {floor1 wall} + $w create line 3 156 52 156 -fill $color -tags {floor1 wall} + $w create line 8 25 8 114 -fill $color -tags {floor1 wall} + $w create line 63 114 3 114 -fill $color -tags {floor1 wall} + $w create line 75 114 97 114 -fill $color -tags {floor1 wall} + $w create line 108 114 129 114 -fill $color -tags {floor1 wall} + $w create line 129 114 129 89 -fill $color -tags {floor1 wall} + $w create line 52 114 52 128 -fill $color -tags {floor1 wall} + $w create line 132 89 88 89 -fill $color -tags {floor1 wall} + $w create line 88 25 88 89 -fill $color -tags {floor1 wall} + $w create line 88 114 88 89 -fill $color -tags {floor1 wall} + $w create line 218 89 144 89 -fill $color -tags {floor1 wall} + $w create line 147 111 147 129 -fill $color -tags {floor1 wall} + $w create line 162 111 147 111 -fill $color -tags {floor1 wall} + $w create line 162 109 162 111 -fill $color -tags {floor1 wall} + $w create line 162 96 162 89 -fill $color -tags {floor1 wall} + $w create line 218 89 218 94 -fill $color -tags {floor1 wall} + $w create line 218 89 218 119 -fill $color -tags {floor1 wall} + $w create line 8 25 88 25 -fill $color -tags {floor1 wall} + $w create line 258 337 258 328 -fill $color -tags {floor1 wall} + $w create line 113 129 96 129 -fill $color -tags {floor1 wall} + $w create line 302 355 258 355 -fill $color -tags {floor1 wall} + $w create line 386 104 386 129 -fill $color -tags {floor1 wall} + $w create line 377 100 386 104 -fill $color -tags {floor1 wall} + $w create line 365 94 377 100 -fill $color -tags {floor1 wall} + $w create line 350 83 365 94 -fill $color -tags {floor1 wall} + $w create line 337 70 350 83 -fill $color -tags {floor1 wall} + $w create line 337 70 323 56 -fill $color -tags {floor1 wall} + $w create line 312 49 323 56 -fill $color -tags {floor1 wall} + $w create line 295 40 312 49 -fill $color -tags {floor1 wall} + $w create line 282 37 295 40 -fill $color -tags {floor1 wall} + $w create line 260 34 282 37 -fill $color -tags {floor1 wall} + $w create line 253 34 260 34 -fill $color -tags {floor1 wall} + $w create line 386 128 386 104 -fill $color -tags {floor1 wall} + $w create line 113 152 156 152 -fill $color -tags {floor1 wall} + $w create line 113 152 156 152 -fill $color -tags {floor1 wall} + $w create line 113 152 113 129 -fill $color -tags {floor1 wall} +} + +proc fg2 {w color} { + global floorLabels floorItems + set i [$w create polygon 748 188 755 188 755 205 758 205 758 222 800 222 800 168 748 168 -fill {} -tags {floor2 room}] + set floorLabels($i) 238 + set {floorItems(238)} $i + $w create text 774 195 -text 238 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 726 188 746 188 746 166 800 166 800 131 726 131 -fill {} -tags {floor2 room}] + set floorLabels($i) 237 + set {floorItems(237)} $i + $w create text 763 148.5 -text 237 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 497 187 497 204 559 204 559 324 641 324 643 324 643 291 641 291 641 205 696 205 696 291 694 291 694 314 715 314 715 291 715 205 755 205 755 190 724 190 724 187 -fill {} -tags {floor2 room}] + set floorLabels($i) 246 + set {floorItems(246)} $i + $w create text 600 264 -text 246 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 694 279 643 279 643 314 694 314 -fill {} -tags {floor2 room}] + set floorLabels($i) 247 + set {floorItems(247)} $i + $w create text 668.5 296.5 -text 247 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 232 250 308 250 308 242 339 242 339 246 397 246 397 255 476 255 476 250 482 250 559 250 559 274 482 274 482 278 396 278 396 274 232 274 -fill {} -tags {floor2 room}] + set floorLabels($i) 202 + set {floorItems(202)} $i + $w create text 285.5 260 -text 202 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 53 228 53 338 176 338 233 338 233 196 306 196 306 180 175 180 175 169 156 169 156 196 176 196 176 228 -fill {} -tags {floor2 room}] + set floorLabels($i) 206 + set {floorItems(206)} $i + $w create text 143 267 -text 206 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 277 6 277 6 338 51 338 -fill {} -tags {floor2 room}] + set floorLabels($i) 212 + set {floorItems(212)} $i + $w create text 28.5 307.5 -text 212 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 557 276 486 276 486 309 510 309 510 325 557 325 -fill {} -tags {floor2 room}] + set floorLabels($i) 245 + set {floorItems(245)} $i + $w create text 521.5 300.5 -text 245 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 560 389 599 389 599 326 560 326 -fill {} -tags {floor2 room}] + set floorLabels($i) 244 + set {floorItems(244)} $i + $w create text 579.5 357.5 -text 244 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 601 389 601 326 643 326 643 389 -fill {} -tags {floor2 room}] + set floorLabels($i) 243 + set {floorItems(243)} $i + $w create text 622 357.5 -text 243 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 688 316 645 316 645 365 688 365 -fill {} -tags {floor2 room}] + set floorLabels($i) 242 + set {floorItems(242)} $i + $w create text 666.5 340.5 -text 242 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 802 367 759 367 759 226 802 226 -fill {} -tags {floor2 room}] + set floorLabels($i) {Barbecue Deck} + set {floorItems(Barbecue Deck)} $i + $w create text 780.5 296.5 -text {Barbecue Deck} -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 755 262 755 314 717 314 717 262 -fill {} -tags {floor2 room}] + set floorLabels($i) 240 + set {floorItems(240)} $i + $w create text 736 288 -text 240 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 755 316 689 316 689 365 755 365 -fill {} -tags {floor2 room}] + set floorLabels($i) 241 + set {floorItems(241)} $i + $w create text 722 340.5 -text 241 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 755 206 717 206 717 261 755 261 -fill {} -tags {floor2 room}] + set floorLabels($i) 239 + set {floorItems(239)} $i + $w create text 736 233.5 -text 239 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 695 277 643 277 643 206 695 206 -fill {} -tags {floor2 room}] + set floorLabels($i) 248 + set {floorItems(248)} $i + $w create text 669 241.5 -text 248 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 676 135 676 185 724 185 724 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 236 + set {floorItems(236)} $i + $w create text 700 160 -text 236 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 675 135 635 135 635 145 628 145 628 185 675 185 -fill {} -tags {floor2 room}] + set floorLabels($i) 235 + set {floorItems(235)} $i + $w create text 651.5 160 -text 235 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 626 143 633 143 633 135 572 135 572 143 579 143 579 185 626 185 -fill {} -tags {floor2 room}] + set floorLabels($i) 234 + set {floorItems(234)} $i + $w create text 606 160 -text 234 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 557 135 571 135 571 145 578 145 578 185 527 185 527 131 557 131 -fill {} -tags {floor2 room}] + set floorLabels($i) 233 + set {floorItems(233)} $i + $w create text 552.5 158 -text 233 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 476 249 557 249 557 205 476 205 -fill {} -tags {floor2 room}] + set floorLabels($i) 230 + set {floorItems(230)} $i + $w create text 516.5 227 -text 230 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 476 164 486 164 486 131 525 131 525 185 476 185 -fill {} -tags {floor2 room}] + set floorLabels($i) 232 + set {floorItems(232)} $i + $w create text 500.5 158 -text 232 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 476 186 495 186 495 204 476 204 -fill {} -tags {floor2 room}] + set floorLabels($i) 229 + set {floorItems(229)} $i + $w create text 485.5 195 -text 229 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 474 207 409 207 409 187 399 187 399 164 474 164 -fill {} -tags {floor2 room}] + set floorLabels($i) 227 + set {floorItems(227)} $i + $w create text 436.5 185.5 -text 227 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 399 228 399 253 474 253 474 209 409 209 409 228 -fill {} -tags {floor2 room}] + set floorLabels($i) 228 + set {floorItems(228)} $i + $w create text 436.5 231 -text 228 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 397 246 397 226 407 226 407 189 377 189 377 246 -fill {} -tags {floor2 room}] + set floorLabels($i) 226 + set {floorItems(226)} $i + $w create text 392 217.5 -text 226 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 377 169 316 169 316 131 397 131 397 188 377 188 -fill {} -tags {floor2 room}] + set floorLabels($i) 225 + set {floorItems(225)} $i + $w create text 356.5 150 -text 225 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 234 198 306 198 306 249 234 249 -fill {} -tags {floor2 room}] + set floorLabels($i) 224 + set {floorItems(224)} $i + $w create text 270 223.5 -text 224 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 270 179 306 179 306 170 314 170 314 135 270 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 223 + set {floorItems(223)} $i + $w create text 292 157 -text 223 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 268 179 221 179 221 135 268 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 222 + set {floorItems(222)} $i + $w create text 244.5 157 -text 222 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 177 179 219 179 219 135 177 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 221 + set {floorItems(221)} $i + $w create text 198 157 -text 221 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 299 327 349 327 349 284 341 284 341 276 299 276 -fill {} -tags {floor2 room}] + set floorLabels($i) 204 + set {floorItems(204)} $i + $w create text 324 301.5 -text 204 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 234 276 297 276 297 327 257 327 257 338 234 338 -fill {} -tags {floor2 room}] + set floorLabels($i) 205 + set {floorItems(205)} $i + $w create text 265.5 307 -text 205 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 256 385 256 340 212 340 212 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 207 + set {floorItems(207)} $i + $w create text 234 362.5 -text 207 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 210 340 164 340 164 385 210 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 208 + set {floorItems(208)} $i + $w create text 187 362.5 -text 208 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 115 340 162 340 162 385 115 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 209 + set {floorItems(209)} $i + $w create text 138.5 362.5 -text 209 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 89 228 89 156 53 156 53 228 -fill {} -tags {floor2 room}] + set floorLabels($i) 217 + set {floorItems(217)} $i + $w create text 71 192 -text 217 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 89 169 97 169 97 190 89 190 -fill {} -tags {floor2 room}] + set floorLabels($i) 217A + set {floorItems(217A)} $i + $w create text 93 179.5 -text 217A -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 89 156 89 168 95 168 95 135 53 135 53 156 -fill {} -tags {floor2 room}] + set floorLabels($i) 216 + set {floorItems(216)} $i + $w create text 71 145.5 -text 216 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 179 51 135 6 135 6 179 -fill {} -tags {floor2 room}] + set floorLabels($i) 215 + set {floorItems(215)} $i + $w create text 28.5 157 -text 215 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 227 6 227 6 180 51 180 -fill {} -tags {floor2 room}] + set floorLabels($i) 214 + set {floorItems(214)} $i + $w create text 28.5 203.5 -text 214 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 275 6 275 6 229 51 229 -fill {} -tags {floor2 room}] + set floorLabels($i) 213 + set {floorItems(213)} $i + $w create text 28.5 252 -text 213 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 114 340 67 340 67 385 114 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 210 + set {floorItems(210)} $i + $w create text 90.5 362.5 -text 210 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 59 389 59 385 65 385 65 340 1 340 1 389 -fill {} -tags {floor2 room}] + set floorLabels($i) 211 + set {floorItems(211)} $i + $w create text 33 364.5 -text 211 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 393 309 350 309 350 282 342 282 342 276 393 276 -fill {} -tags {floor2 room}] + set floorLabels($i) 203 + set {floorItems(203)} $i + $w create text 367.5 292.5 -text 203 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 99 191 91 191 91 226 174 226 174 198 154 198 154 192 109 192 109 169 99 169 -fill {} -tags {floor2 room}] + set floorLabels($i) 220 + set {floorItems(220)} $i + $w create text 132.5 208.5 -text 220 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor2 room}] + set floorLabels($i) {Priv Lift2} + set {floorItems(Priv Lift2)} $i + $w create text 323 188 -text {Priv Lift2} -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor2 room}] + set floorLabels($i) {Pub Lift 2} + set {floorItems(Pub Lift 2)} $i + $w create text 323 223 -text {Pub Lift 2} -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor2 room}] + set floorLabels($i) 218 + set {floorItems(218)} $i + $w create text 136 149.5 -text 218 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor2 room}] + set floorLabels($i) 219 + set {floorItems(219)} $i + $w create text 132.5 180 -text 219 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor2 room}] + set floorLabels($i) 201 + set {floorItems(201)} $i + $w create text 358 209 -text 201 -fill $color -anchor c -tags {floor2 label} + $w create line 641 186 678 186 -fill $color -tags {floor2 wall} + $w create line 757 350 757 367 -fill $color -tags {floor2 wall} + $w create line 634 133 634 144 -fill $color -tags {floor2 wall} + $w create line 634 144 627 144 -fill $color -tags {floor2 wall} + $w create line 572 133 572 144 -fill $color -tags {floor2 wall} + $w create line 572 144 579 144 -fill $color -tags {floor2 wall} + $w create line 398 129 398 162 -fill $color -tags {floor2 wall} + $w create line 174 197 175 197 -fill $color -tags {floor2 wall} + $w create line 175 197 175 227 -fill $color -tags {floor2 wall} + $w create line 757 206 757 221 -fill $color -tags {floor2 wall} + $w create line 396 188 408 188 -fill $color -tags {floor2 wall} + $w create line 727 189 725 189 -fill $color -tags {floor2 wall} + $w create line 747 167 802 167 -fill $color -tags {floor2 wall} + $w create line 747 167 747 189 -fill $color -tags {floor2 wall} + $w create line 755 189 739 189 -fill $color -tags {floor2 wall} + $w create line 769 224 757 224 -fill $color -tags {floor2 wall} + $w create line 802 224 802 129 -fill $color -tags {floor2 wall} + $w create line 802 129 725 129 -fill $color -tags {floor2 wall} + $w create line 725 189 725 129 -fill $color -tags {floor2 wall} + $w create line 725 186 690 186 -fill $color -tags {floor2 wall} + $w create line 676 133 676 186 -fill $color -tags {floor2 wall} + $w create line 627 144 627 186 -fill $color -tags {floor2 wall} + $w create line 629 186 593 186 -fill $color -tags {floor2 wall} + $w create line 579 144 579 186 -fill $color -tags {floor2 wall} + $w create line 559 129 559 133 -fill $color -tags {floor2 wall} + $w create line 725 133 559 133 -fill $color -tags {floor2 wall} + $w create line 484 162 484 129 -fill $color -tags {floor2 wall} + $w create line 559 129 484 129 -fill $color -tags {floor2 wall} + $w create line 526 129 526 186 -fill $color -tags {floor2 wall} + $w create line 540 186 581 186 -fill $color -tags {floor2 wall} + $w create line 528 186 523 186 -fill $color -tags {floor2 wall} + $w create line 511 186 475 186 -fill $color -tags {floor2 wall} + $w create line 496 190 496 186 -fill $color -tags {floor2 wall} + $w create line 496 205 496 202 -fill $color -tags {floor2 wall} + $w create line 475 205 527 205 -fill $color -tags {floor2 wall} + $w create line 558 205 539 205 -fill $color -tags {floor2 wall} + $w create line 558 205 558 249 -fill $color -tags {floor2 wall} + $w create line 558 249 475 249 -fill $color -tags {floor2 wall} + $w create line 662 206 642 206 -fill $color -tags {floor2 wall} + $w create line 695 206 675 206 -fill $color -tags {floor2 wall} + $w create line 695 278 642 278 -fill $color -tags {floor2 wall} + $w create line 642 291 642 206 -fill $color -tags {floor2 wall} + $w create line 695 291 695 206 -fill $color -tags {floor2 wall} + $w create line 716 208 716 206 -fill $color -tags {floor2 wall} + $w create line 757 206 716 206 -fill $color -tags {floor2 wall} + $w create line 757 221 757 224 -fill $color -tags {floor2 wall} + $w create line 793 224 802 224 -fill $color -tags {floor2 wall} + $w create line 757 262 716 262 -fill $color -tags {floor2 wall} + $w create line 716 220 716 264 -fill $color -tags {floor2 wall} + $w create line 716 315 716 276 -fill $color -tags {floor2 wall} + $w create line 757 315 703 315 -fill $color -tags {floor2 wall} + $w create line 757 325 757 224 -fill $color -tags {floor2 wall} + $w create line 757 367 644 367 -fill $color -tags {floor2 wall} + $w create line 689 367 689 315 -fill $color -tags {floor2 wall} + $w create line 647 315 644 315 -fill $color -tags {floor2 wall} + $w create line 659 315 691 315 -fill $color -tags {floor2 wall} + $w create line 600 325 600 391 -fill $color -tags {floor2 wall} + $w create line 627 325 644 325 -fill $color -tags {floor2 wall} + $w create line 644 391 644 315 -fill $color -tags {floor2 wall} + $w create line 615 325 575 325 -fill $color -tags {floor2 wall} + $w create line 644 391 558 391 -fill $color -tags {floor2 wall} + $w create line 563 325 558 325 -fill $color -tags {floor2 wall} + $w create line 558 391 558 314 -fill $color -tags {floor2 wall} + $w create line 558 327 508 327 -fill $color -tags {floor2 wall} + $w create line 558 275 484 275 -fill $color -tags {floor2 wall} + $w create line 558 302 558 275 -fill $color -tags {floor2 wall} + $w create line 508 327 508 311 -fill $color -tags {floor2 wall} + $w create line 484 311 508 311 -fill $color -tags {floor2 wall} + $w create line 484 275 484 311 -fill $color -tags {floor2 wall} + $w create line 475 208 408 208 -fill $color -tags {floor2 wall} + $w create line 408 206 408 210 -fill $color -tags {floor2 wall} + $w create line 408 222 408 227 -fill $color -tags {floor2 wall} + $w create line 408 227 398 227 -fill $color -tags {floor2 wall} + $w create line 398 227 398 254 -fill $color -tags {floor2 wall} + $w create line 408 188 408 194 -fill $color -tags {floor2 wall} + $w create line 383 188 376 188 -fill $color -tags {floor2 wall} + $w create line 398 188 398 162 -fill $color -tags {floor2 wall} + $w create line 398 162 484 162 -fill $color -tags {floor2 wall} + $w create line 475 162 475 254 -fill $color -tags {floor2 wall} + $w create line 398 254 475 254 -fill $color -tags {floor2 wall} + $w create line 484 280 395 280 -fill $color -tags {floor2 wall} + $w create line 395 311 395 275 -fill $color -tags {floor2 wall} + $w create line 307 197 293 197 -fill $color -tags {floor2 wall} + $w create line 278 197 233 197 -fill $color -tags {floor2 wall} + $w create line 233 197 233 249 -fill $color -tags {floor2 wall} + $w create line 307 179 284 179 -fill $color -tags {floor2 wall} + $w create line 233 249 278 249 -fill $color -tags {floor2 wall} + $w create line 269 179 269 133 -fill $color -tags {floor2 wall} + $w create line 220 179 220 133 -fill $color -tags {floor2 wall} + $w create line 155 191 110 191 -fill $color -tags {floor2 wall} + $w create line 90 190 98 190 -fill $color -tags {floor2 wall} + $w create line 98 169 98 190 -fill $color -tags {floor2 wall} + $w create line 52 133 52 165 -fill $color -tags {floor2 wall} + $w create line 52 214 52 177 -fill $color -tags {floor2 wall} + $w create line 52 226 52 262 -fill $color -tags {floor2 wall} + $w create line 52 274 52 276 -fill $color -tags {floor2 wall} + $w create line 234 275 234 339 -fill $color -tags {floor2 wall} + $w create line 226 339 258 339 -fill $color -tags {floor2 wall} + $w create line 211 387 211 339 -fill $color -tags {floor2 wall} + $w create line 214 339 177 339 -fill $color -tags {floor2 wall} + $w create line 258 387 60 387 -fill $color -tags {floor2 wall} + $w create line 3 133 3 339 -fill $color -tags {floor2 wall} + $w create line 165 339 129 339 -fill $color -tags {floor2 wall} + $w create line 117 339 80 339 -fill $color -tags {floor2 wall} + $w create line 68 339 59 339 -fill $color -tags {floor2 wall} + $w create line 0 339 46 339 -fill $color -tags {floor2 wall} + $w create line 60 391 0 391 -fill $color -tags {floor2 wall} + $w create line 0 339 0 391 -fill $color -tags {floor2 wall} + $w create line 60 387 60 391 -fill $color -tags {floor2 wall} + $w create line 258 329 258 387 -fill $color -tags {floor2 wall} + $w create line 350 329 258 329 -fill $color -tags {floor2 wall} + $w create line 395 311 350 311 -fill $color -tags {floor2 wall} + $w create line 398 129 315 129 -fill $color -tags {floor2 wall} + $w create line 176 133 315 133 -fill $color -tags {floor2 wall} + $w create line 176 129 96 129 -fill $color -tags {floor2 wall} + $w create line 3 133 96 133 -fill $color -tags {floor2 wall} + $w create line 66 387 66 339 -fill $color -tags {floor2 wall} + $w create line 115 387 115 339 -fill $color -tags {floor2 wall} + $w create line 163 387 163 339 -fill $color -tags {floor2 wall} + $w create line 234 275 276 275 -fill $color -tags {floor2 wall} + $w create line 288 275 309 275 -fill $color -tags {floor2 wall} + $w create line 298 275 298 329 -fill $color -tags {floor2 wall} + $w create line 341 283 350 283 -fill $color -tags {floor2 wall} + $w create line 321 275 341 275 -fill $color -tags {floor2 wall} + $w create line 375 275 395 275 -fill $color -tags {floor2 wall} + $w create line 315 129 315 170 -fill $color -tags {floor2 wall} + $w create line 376 170 307 170 -fill $color -tags {floor2 wall} + $w create line 307 250 307 170 -fill $color -tags {floor2 wall} + $w create line 376 245 376 170 -fill $color -tags {floor2 wall} + $w create line 340 241 307 241 -fill $color -tags {floor2 wall} + $w create line 340 245 340 224 -fill $color -tags {floor2 wall} + $w create line 340 210 340 201 -fill $color -tags {floor2 wall} + $w create line 340 187 340 170 -fill $color -tags {floor2 wall} + $w create line 340 206 307 206 -fill $color -tags {floor2 wall} + $w create line 293 250 307 250 -fill $color -tags {floor2 wall} + $w create line 271 179 238 179 -fill $color -tags {floor2 wall} + $w create line 226 179 195 179 -fill $color -tags {floor2 wall} + $w create line 176 129 176 179 -fill $color -tags {floor2 wall} + $w create line 182 179 176 179 -fill $color -tags {floor2 wall} + $w create line 174 169 176 169 -fill $color -tags {floor2 wall} + $w create line 162 169 90 169 -fill $color -tags {floor2 wall} + $w create line 96 169 96 129 -fill $color -tags {floor2 wall} + $w create line 175 227 90 227 -fill $color -tags {floor2 wall} + $w create line 90 190 90 227 -fill $color -tags {floor2 wall} + $w create line 52 179 3 179 -fill $color -tags {floor2 wall} + $w create line 52 228 3 228 -fill $color -tags {floor2 wall} + $w create line 52 276 3 276 -fill $color -tags {floor2 wall} + $w create line 155 177 155 169 -fill $color -tags {floor2 wall} + $w create line 110 191 110 169 -fill $color -tags {floor2 wall} + $w create line 155 189 155 197 -fill $color -tags {floor2 wall} + $w create line 350 283 350 329 -fill $color -tags {floor2 wall} + $w create line 162 197 155 197 -fill $color -tags {floor2 wall} + $w create line 341 275 341 283 -fill $color -tags {floor2 wall} +} + +proc fg3 {w color} { + global floorLabels floorItems + set i [$w create polygon 89 228 89 180 70 180 70 228 -fill {} -tags {floor3 room}] + set floorLabels($i) 316 + set {floorItems(316)} $i + $w create text 79.5 204 -text 316 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 115 368 162 368 162 323 115 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 309 + set {floorItems(309)} $i + $w create text 138.5 345.5 -text 309 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 164 323 164 368 211 368 211 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 308 + set {floorItems(308)} $i + $w create text 187.5 345.5 -text 308 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 256 368 212 368 212 323 256 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 307 + set {floorItems(307)} $i + $w create text 234 345.5 -text 307 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 244 276 297 276 297 327 260 327 260 321 244 321 -fill {} -tags {floor3 room}] + set floorLabels($i) 305 + set {floorItems(305)} $i + $w create text 270.5 301.5 -text 305 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 251 219 251 203 244 203 244 219 -fill {} -tags {floor3 room}] + set floorLabels($i) 324B + set {floorItems(324B)} $i + $w create text 247.5 211 -text 324B -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 251 249 244 249 244 232 251 232 -fill {} -tags {floor3 room}] + set floorLabels($i) 324A + set {floorItems(324A)} $i + $w create text 247.5 240.5 -text 324A -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 223 135 223 179 177 179 177 135 -fill {} -tags {floor3 room}] + set floorLabels($i) 320 + set {floorItems(320)} $i + $w create text 200 157 -text 320 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 114 368 114 323 67 323 67 368 -fill {} -tags {floor3 room}] + set floorLabels($i) 310 + set {floorItems(310)} $i + $w create text 90.5 345.5 -text 310 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 23 277 23 321 68 321 68 277 -fill {} -tags {floor3 room}] + set floorLabels($i) 312 + set {floorItems(312)} $i + $w create text 45.5 299 -text 312 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 23 229 68 229 68 275 23 275 -fill {} -tags {floor3 room}] + set floorLabels($i) 313 + set {floorItems(313)} $i + $w create text 45.5 252 -text 313 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 68 227 23 227 23 180 68 180 -fill {} -tags {floor3 room}] + set floorLabels($i) 314 + set {floorItems(314)} $i + $w create text 45.5 203.5 -text 314 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 95 179 95 135 23 135 23 179 -fill {} -tags {floor3 room}] + set floorLabels($i) 315 + set {floorItems(315)} $i + $w create text 59 157 -text 315 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 99 226 99 204 91 204 91 226 -fill {} -tags {floor3 room}] + set floorLabels($i) 316B + set {floorItems(316B)} $i + $w create text 95 215 -text 316B -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 91 202 99 202 99 180 91 180 -fill {} -tags {floor3 room}] + set floorLabels($i) 316A + set {floorItems(316A)} $i + $w create text 95 191 -text 316A -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 97 169 109 169 109 192 154 192 154 198 174 198 174 226 101 226 101 179 97 179 -fill {} -tags {floor3 room}] + set floorLabels($i) 319 + set {floorItems(319)} $i + $w create text 141.5 209 -text 319 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 65 368 58 368 58 389 1 389 1 333 23 333 23 323 65 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 311 + set {floorItems(311)} $i + $w create text 29.5 361 -text 311 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor3 room}] + set floorLabels($i) 318 + set {floorItems(318)} $i + $w create text 132.5 180 -text 318 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor3 room}] + set floorLabels($i) 317 + set {floorItems(317)} $i + $w create text 136 149.5 -text 317 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 274 194 274 221 306 221 306 194 -fill {} -tags {floor3 room}] + set floorLabels($i) 323 + set {floorItems(323)} $i + $w create text 290 207.5 -text 323 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 306 222 274 222 274 249 306 249 -fill {} -tags {floor3 room}] + set floorLabels($i) 325 + set {floorItems(325)} $i + $w create text 290 235.5 -text 325 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 263 179 224 179 224 135 263 135 -fill {} -tags {floor3 room}] + set floorLabels($i) 321 + set {floorItems(321)} $i + $w create text 243.5 157 -text 321 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 314 169 306 169 306 192 273 192 264 181 264 135 314 135 -fill {} -tags {floor3 room}] + set floorLabels($i) 322 + set {floorItems(322)} $i + $w create text 293.5 163.5 -text 322 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor3 room}] + set floorLabels($i) {Pub Lift3} + set {floorItems(Pub Lift3)} $i + $w create text 323 223 -text {Pub Lift3} -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor3 room}] + set floorLabels($i) {Priv Lift3} + set {floorItems(Priv Lift3)} $i + $w create text 323 188 -text {Priv Lift3} -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 350 284 376 284 376 276 397 276 397 309 350 309 -fill {} -tags {floor3 room}] + set floorLabels($i) 303 + set {floorItems(303)} $i + $w create text 373.5 292.5 -text 303 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 272 203 272 249 252 249 252 230 244 230 244 221 252 221 252 203 -fill {} -tags {floor3 room}] + set floorLabels($i) 324 + set {floorItems(324)} $i + $w create text 262 226 -text 324 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 299 276 299 327 349 327 349 284 341 284 341 276 -fill {} -tags {floor3 room}] + set floorLabels($i) 304 + set {floorItems(304)} $i + $w create text 324 301.5 -text 304 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor3 room}] + set floorLabels($i) 301 + set {floorItems(301)} $i + $w create text 358 209 -text 301 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 397 246 377 246 377 185 397 185 -fill {} -tags {floor3 room}] + set floorLabels($i) 327 + set {floorItems(327)} $i + $w create text 387 215.5 -text 327 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 316 131 316 169 377 169 377 185 397 185 397 131 -fill {} -tags {floor3 room}] + set floorLabels($i) 326 + set {floorItems(326)} $i + $w create text 356.5 150 -text 326 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 308 251 242 251 242 274 342 274 342 282 375 282 375 274 397 274 397 248 339 248 339 242 308 242 -fill {} -tags {floor3 room}] + set floorLabels($i) 302 + set {floorItems(302)} $i + $w create text 319.5 261 -text 302 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 70 321 242 321 242 200 259 200 259 203 272 203 272 193 263 180 242 180 175 180 175 169 156 169 156 196 177 196 177 228 107 228 70 228 70 275 107 275 107 248 160 248 160 301 107 301 107 275 70 275 -fill {} -tags {floor3 room}] + set floorLabels($i) 306 + set {floorItems(306)} $i + $w create text 200.5 284.5 -text 306 -fill $color -anchor c -tags {floor3 label} + $w create line 341 275 341 283 -fill $color -tags {floor3 wall} + $w create line 162 197 155 197 -fill $color -tags {floor3 wall} + $w create line 396 247 399 247 -fill $color -tags {floor3 wall} + $w create line 399 129 399 311 -fill $color -tags {floor3 wall} + $w create line 258 202 243 202 -fill $color -tags {floor3 wall} + $w create line 350 283 350 329 -fill $color -tags {floor3 wall} + $w create line 251 231 243 231 -fill $color -tags {floor3 wall} + $w create line 243 220 251 220 -fill $color -tags {floor3 wall} + $w create line 243 250 243 202 -fill $color -tags {floor3 wall} + $w create line 155 197 155 190 -fill $color -tags {floor3 wall} + $w create line 110 192 110 169 -fill $color -tags {floor3 wall} + $w create line 155 192 110 192 -fill $color -tags {floor3 wall} + $w create line 155 177 155 169 -fill $color -tags {floor3 wall} + $w create line 176 197 176 227 -fill $color -tags {floor3 wall} + $w create line 69 280 69 274 -fill $color -tags {floor3 wall} + $w create line 21 276 69 276 -fill $color -tags {floor3 wall} + $w create line 69 262 69 226 -fill $color -tags {floor3 wall} + $w create line 21 228 69 228 -fill $color -tags {floor3 wall} + $w create line 21 179 75 179 -fill $color -tags {floor3 wall} + $w create line 69 179 69 214 -fill $color -tags {floor3 wall} + $w create line 90 220 90 227 -fill $color -tags {floor3 wall} + $w create line 90 204 90 202 -fill $color -tags {floor3 wall} + $w create line 90 203 100 203 -fill $color -tags {floor3 wall} + $w create line 90 187 90 179 -fill $color -tags {floor3 wall} + $w create line 90 227 176 227 -fill $color -tags {floor3 wall} + $w create line 100 179 100 227 -fill $color -tags {floor3 wall} + $w create line 100 179 87 179 -fill $color -tags {floor3 wall} + $w create line 96 179 96 129 -fill $color -tags {floor3 wall} + $w create line 162 169 96 169 -fill $color -tags {floor3 wall} + $w create line 173 169 176 169 -fill $color -tags {floor3 wall} + $w create line 182 179 176 179 -fill $color -tags {floor3 wall} + $w create line 176 129 176 179 -fill $color -tags {floor3 wall} + $w create line 195 179 226 179 -fill $color -tags {floor3 wall} + $w create line 224 133 224 179 -fill $color -tags {floor3 wall} + $w create line 264 179 264 133 -fill $color -tags {floor3 wall} + $w create line 238 179 264 179 -fill $color -tags {floor3 wall} + $w create line 273 207 273 193 -fill $color -tags {floor3 wall} + $w create line 273 235 273 250 -fill $color -tags {floor3 wall} + $w create line 273 224 273 219 -fill $color -tags {floor3 wall} + $w create line 273 193 307 193 -fill $color -tags {floor3 wall} + $w create line 273 222 307 222 -fill $color -tags {floor3 wall} + $w create line 273 250 307 250 -fill $color -tags {floor3 wall} + $w create line 384 247 376 247 -fill $color -tags {floor3 wall} + $w create line 340 206 307 206 -fill $color -tags {floor3 wall} + $w create line 340 187 340 170 -fill $color -tags {floor3 wall} + $w create line 340 210 340 201 -fill $color -tags {floor3 wall} + $w create line 340 247 340 224 -fill $color -tags {floor3 wall} + $w create line 340 241 307 241 -fill $color -tags {floor3 wall} + $w create line 376 247 376 170 -fill $color -tags {floor3 wall} + $w create line 307 250 307 170 -fill $color -tags {floor3 wall} + $w create line 376 170 307 170 -fill $color -tags {floor3 wall} + $w create line 315 129 315 170 -fill $color -tags {floor3 wall} + $w create line 376 283 366 283 -fill $color -tags {floor3 wall} + $w create line 376 283 376 275 -fill $color -tags {floor3 wall} + $w create line 399 275 376 275 -fill $color -tags {floor3 wall} + $w create line 341 275 320 275 -fill $color -tags {floor3 wall} + $w create line 341 283 350 283 -fill $color -tags {floor3 wall} + $w create line 298 275 298 329 -fill $color -tags {floor3 wall} + $w create line 308 275 298 275 -fill $color -tags {floor3 wall} + $w create line 243 322 243 275 -fill $color -tags {floor3 wall} + $w create line 243 275 284 275 -fill $color -tags {floor3 wall} + $w create line 258 322 226 322 -fill $color -tags {floor3 wall} + $w create line 212 370 212 322 -fill $color -tags {floor3 wall} + $w create line 214 322 177 322 -fill $color -tags {floor3 wall} + $w create line 163 370 163 322 -fill $color -tags {floor3 wall} + $w create line 165 322 129 322 -fill $color -tags {floor3 wall} + $w create line 84 322 117 322 -fill $color -tags {floor3 wall} + $w create line 71 322 64 322 -fill $color -tags {floor3 wall} + $w create line 115 322 115 370 -fill $color -tags {floor3 wall} + $w create line 66 322 66 370 -fill $color -tags {floor3 wall} + $w create line 52 322 21 322 -fill $color -tags {floor3 wall} + $w create line 21 331 0 331 -fill $color -tags {floor3 wall} + $w create line 21 331 21 133 -fill $color -tags {floor3 wall} + $w create line 96 133 21 133 -fill $color -tags {floor3 wall} + $w create line 176 129 96 129 -fill $color -tags {floor3 wall} + $w create line 315 133 176 133 -fill $color -tags {floor3 wall} + $w create line 315 129 399 129 -fill $color -tags {floor3 wall} + $w create line 399 311 350 311 -fill $color -tags {floor3 wall} + $w create line 350 329 258 329 -fill $color -tags {floor3 wall} + $w create line 258 322 258 370 -fill $color -tags {floor3 wall} + $w create line 60 370 258 370 -fill $color -tags {floor3 wall} + $w create line 60 370 60 391 -fill $color -tags {floor3 wall} + $w create line 0 391 0 331 -fill $color -tags {floor3 wall} + $w create line 60 391 0 391 -fill $color -tags {floor3 wall} + $w create line 307 250 307 242 -fill $color -tags {floor3 wall} + $w create line 273 250 307 250 -fill $color -tags {floor3 wall} + $w create line 258 250 243 250 -fill $color -tags {floor3 wall} +} diff --git a/gcl-tk/demos/mkForm.lisp b/gcl-tk/demos/mkForm.lisp new file mode 100755 index 0000000..54576e9 --- /dev/null +++ b/gcl-tk/demos/mkForm.lisp @@ -0,0 +1,54 @@ +;;# mkForm w +;; +;; Create a top-level window that displays a bunch of entries with +;; tabs set up to move between them. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(in-package "TK") +(defvar *tablist*) + +(defun mkForm (&optional (w '.form)) + (setq *tablist* nil) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Form Demonstration") + (wm :iconname w "Form") + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :width "4i" + :text "This window contains a simple form where you can type in the various entries and use tabs to move circularly between the entries. Click the \"OK\" button or type return when you're done.") + (dolist (i '(f1 f2 f3 f4 f5)) + (frame (conc w '|.| i) :bd "1m") + (entry (conc w '|.| i '.entry) :relief "sunken" :width 40) + (bind (conc w '|.| i '.entry) "" '(Tab *tabList*)) + (bind (conc w '|.| i '.entry) "" `(destroy ',w)) + (label (conc w '|.| i '.label)) + (pack (conc w '|.| i '.entry) :side "right") + (pack (conc w '|.| i '.label) :side "left") + (push (conc i '.entry) *tablist*)) + (setq *tablist* (nreverse *tablist*)) + (funcall (conc w '.f1.label) :config :text "Name: ") + (funcall (conc w '.f2.label) :config :text "Address: ") + (funcall (conc w '.f5.label) :config :text "Phone: ") + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) (conc w '.f1) (conc w '.f2) (conc w '.f3) + (conc w '.f4) (conc w '.f5) (conc w '.ok) :side "top" :fill "x") + +) + +;; The procedure below is invoked in response to tabs in the entry +;; windows. It moves the focus to the next window in the tab list. +;; Arguments: +;; +;; list - Ordered list of windows to receive focus + +(defun Tab (list) + (setq i (position (focus :return t) list)) + (cond ((null i) (setq i 0)) + (t (incf i) + (if (>= i (length list) ) + (setq i 0)))) + (focus (nth i list )) +) + diff --git a/gcl-tk/demos/mkForm.tcl b/gcl-tk/demos/mkForm.tcl new file mode 100755 index 0000000..a8971f0 --- /dev/null +++ b/gcl-tk/demos/mkForm.tcl @@ -0,0 +1,52 @@ +# mkForm w +# +# Create a top-level window that displays a bunch of entries with +# tabs set up to move between them. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkForm {{w .form}} { + global tabList + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Form Demonstration" + wm iconname $w "Form" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -width 4i \ + -text "This window contains a simple form where you can type in the various entries and use tabs to move circularly between the entries. Click the \"OK\" button or type return when you're done." + foreach i {f1 f2 f3 f4 f5} { + frame $w.$i -bd 1m + entry $w.$i.entry -relief sunken -width 40 + bind $w.$i.entry "Tab \$tabList" + bind $w.$i.entry "destroy $w" + label $w.$i.label + pack $w.$i.entry -side right + pack $w.$i.label -side left + } + $w.f1.label config -text Name: + $w.f2.label config -text Address: + $w.f5.label config -text Phone: + button $w.ok -text OK -command "destroy $w" + pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 $w.ok -side top -fill x + set tabList "$w.f1.entry $w.f2.entry $w.f3.entry $w.f4.entry $w.f5.entry" +} + +# The procedure below is invoked in response to tabs in the entry +# windows. It moves the focus to the next window in the tab list. +# Arguments: +# +# list - Ordered list of windows to receive focus + +proc Tab {list} { + set i [lsearch $list [focus]] + if {$i < 0} { + set i 0 + } else { + incr i + if {$i >= [llength $list]} { + set i 0 + } + } + focus [lindex $list $i] +} diff --git a/gcl-tk/demos/mkHScale.lisp b/gcl-tk/demos/mkHScale.lisp new file mode 100755 index 0000000..579edce --- /dev/null +++ b/gcl-tk/demos/mkHScale.lisp @@ -0,0 +1,38 @@ +;;# mkHScale w +;; +;; Create a top-level window that displays a horizontal scale. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(in-package "TK") + +(defun mkHScale (&optional (w '.scale2)) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Horizontal Scale Demonstration") + (wm :iconname w "Scale") + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 + :text "A bar and a horizontal scale are displayed below. (if :you click or drag mouse button 1 in the scale, you can change the width of the bar. Click the \"OK\" button when you're finished.") + (frame (conc w '.frame) :borderwidth 10) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) (conc w '.frame) (conc w '.ok) :side "top" :fill "x") + + (frame (conc w '.frame.top) :borderwidth 15) + (scale (conc w '.frame.scale) :orient "horizontal" :length 280 :from 0 :to 250 + :command (tk-conc "setWidth " w ".frame.top.inner") :tickinterval 50 + :bg "Bisque1") + (frame (conc w '.frame.top.inner) :width 20 :height 40 :relief "raised" :borderwidth 2 + :bg "SteelBlue1") + (pack (conc w '.frame.top) :side "top" :expand "yes" :anchor "sw") + (pack (conc w '.frame.scale) :side "bottom" :expand "yes" :anchor "nw") + + + (pack (conc w '.frame.top.inner) :expand "yes" :anchor "sw") + (funcall (conc w '.frame.scale) :set 20) +) + +(defun setWidth (w width) + (funcall w :config :width ${width} :height 40) +) diff --git a/gcl-tk/demos/mkHScale.tcl b/gcl-tk/demos/mkHScale.tcl new file mode 100755 index 0000000..f481cb9 --- /dev/null +++ b/gcl-tk/demos/mkHScale.tcl @@ -0,0 +1,35 @@ +# mkHScale w +# +# Create a top-level window that displays a horizontal scale. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkHScale {{w .scale2}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Horizontal Scale Demonstration" + wm iconname $w "Scale" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "A bar and a horizontal scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the width of the bar. Click the \"OK\" button when you're finished." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg $w.frame $w.ok -side top -fill x + + frame $w.frame.top -borderwidth 15 + scale $w.frame.scale -orient horizontal -length 280 -from 0 -to 250 \ + -command "setWidth $w.frame.top.inner" -tickinterval 50 \ + -bg Bisque1 + pack $w.frame.top -side top -expand yes -anchor sw + pack $w.frame.scale -side bottom -expand yes -anchor nw + + frame $w.frame.top.inner -relief raised -borderwidth 2 \ + -bg SteelBlue1 + pack $w.frame.top.inner -expand yes -anchor sw + $w.frame.scale set 20 +} + +proc setWidth {w width} { + $w config -width $width +} diff --git a/gcl-tk/demos/mkIcon.tcl b/gcl-tk/demos/mkIcon.tcl new file mode 100755 index 0000000..2e10494 --- /dev/null +++ b/gcl-tk/demos/mkIcon.tcl @@ -0,0 +1,48 @@ +# mkIcon w +# +# Create a top-level window that displays a bunch of iconic +# buttons. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkIcon {{w .icon}} { + global tk_library + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Iconic Button Demonstration" + wm iconname $w "Icons" + label $w.msg -wraplength 5i -justify left -text "This window shows three ways of using bitmaps or images in radiobuttons and checkbuttons. On the left are two radiobuttons, each of which displays a bitmap and an indicator. In the middle is a checkbutton that displays a different image depending on whether it is selected or not. On the right is a checkbutton that displays a single bitmap but changes its background color to indicate whether or not it is selected." +pack $w.msg -side top +frame $w.buttons +pack $w.buttons -side bottom -fill x -pady 2m +button $w.buttons.dismiss -text Dismiss -command "destroy $w" +pack $w.buttons.dismiss -side left -expand 1 + +image create bitmap flagup \ + -file [file join $tk_library demos images flagup.bmp] \ + -maskfile [file join $tk_library demos images flagup.bmp] +image create bitmap flagdown \ + -file [file join $tk_library demos images flagdown.bmp] \ + -maskfile [file join $tk_library demos images flagdown.bmp] +frame $w.frame -borderwidth 10 +pack $w.frame -side top + +checkbutton $w.frame.b1 -image flagdown -selectimage flagup \ + -indicatoron 0 +$w.frame.b1 configure -selectcolor [$w.frame.b1 cget -background] +checkbutton $w.frame.b2 \ + -bitmap @[file join $tk_library demos images letters.bmp] \ + -indicatoron 0 -selectcolor SeaGreen1 +frame $w.frame.left +pack $w.frame.left $w.frame.b1 $w.frame.b2 -side left -expand yes -padx 5m + +radiobutton $w.frame.left.b3 \ + -bitmap @[file join $tk_library demos images letters.bmp] \ + -variable letters -value full +radiobutton $w.frame.left.b4 \ + -bitmap @[file join $tk_library demos images noletter.bmp] \ + -variable letters -value empty +pack $w.frame.left.b3 $w.frame.left.b4 -side top -expand yes +} diff --git a/gcl-tk/demos/mkItems.lisp b/gcl-tk/demos/mkItems.lisp new file mode 100755 index 0000000..5a4598b --- /dev/null +++ b/gcl-tk/demos/mkItems.lisp @@ -0,0 +1,358 @@ +;;# mkItems w +;; +;; Create a top-level window containing a canvas that displays the +;; various item types and allows them to be selected and moved. This +;; demo can be used to test out the point-hit and rectangle-hit code +;; for items. +;; +;; Arguments: +;; w - Name to use for new top-level window. +(in-package "TK") +(defvar *color-display* nil) +(defun mkItems (&optional (w '.citems)) + (declare (special c tk_library)) + (if (winfo :exists w :return 'boolean) + (destroy w)) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Canvas Item Demonstration") + (wm :iconname w "Items") + (wm :minsize w 100 100) + (setq c (conc w '.frame2.c)) + + (message (conc w '.msg) :font :Adobe-Times-Medium-R-Normal--*-180-* :width "13c" + :bd 2 :relief "raised" :text #u"This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area.") + (frame (conc w '.frame2) :relief "raised" :bd 2) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) :side "top" :fill "x") + (pack (conc w '.frame2) :side "top" :fill "both" :expand "yes") + (pack (conc w '.ok) :side "bottom" :pady 5 :anchor "center") + + (scrollbar (conc w '.frame2.vscroll) :relief "sunken" :command (tk-conc c " yview")) + (scrollbar (conc w '.frame2.hscroll) :orient "horiz" :relief "sunken" :command (tk-conc c " xview")) + (canvas c :scrollregion "0c 0c 30c 24c" :width "15c" :height "10c" + :relief "sunken" :borderwidth 2 + :xscrollcommand (tk-conc w ".frame2.hscroll set") :yscrollcommand (tk-conc w ".frame2.vscroll set")) + (pack (conc w '.frame2.hscroll) :side "bottom" :fill "x") + (pack (conc w '.frame2.vscroll) :side "right" :fill "y") + (pack c :in (conc w '.frame2) :expand "yes" :fill "both") + + ;; Display a 3x3 rectangular grid. + + (funcall c :create "rect" "0c" "0c" "30c" "24c" :width 2) + (funcall c :create "line" "0c" "8c" "30c" "8c" :width 2) + (funcall c :create "line" "0c" "16c" "30c" "16c" :width 2) + (funcall c :create "line" "10c" "0c" "10c" "24c" :width 2) + (funcall c :create "line" "20c" "0c" "20c" "24c" :width 2) + + (setq font1 :Adobe-Helvetica-Medium-R-Normal--*-120-*) + (setq font2 :Adobe-Helvetica-Bold-R-Normal--*-240-*) + (if (> (winfo :depth c :return 'number) 1) + (progn + (setq *color-display* t) + (setq blue "DeepSkyBlue3") + (setq red "red") + (setq bisque "bisque3") + (setq green "SeaGreen3")) + (progn + (setq blue "black") + (setq red "black") + (setq bisque "black") + (setq green "black"))) + + ;; Set up demos within each of the areas of the grid. + + (funcall c :create "text" "5c" ".2c" :text "Lines" :anchor "n") + (funcall c :create "line" "1c" "1c" "3c" "1c" "1c" "4c" "3c" "4c" :width "2m" :fill blue + :cap "butt" :join "miter" :tags "item") + (funcall c :create "line" "4.67c" "1c" "4.67c" "4c" :arrow "last" :tags "item") + (funcall c :create "line" "6.33c" "1c" "6.33c" "4c" :arrow "both" :tags "item") + (funcall c :create "line" + "5c" "6c" "9c" "6c" "9c" "1c" "8c" "1c" "8c" "4.8c" "8.8c" "4.8c" "8.8c" "1.2c" + "8.2c" "1.2c" "8.2c" "4.6c" "8.6c" "4.6c" "8.6c" "1.4c" "8.4c" "1.4c" "8.4c" "4.4c" :fill "red" + :width 3 :tags "item") + (funcall c :create "line" "1c" "5c" "7c" "5c" "7c" "7c" "9c" "7c" + :width ".5c" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" + :arrow "both" :arrowshape "15 15 7" :tags "item") + (funcall c :create "line" "1c" "7c" "1.75c" "5.8c" "2.5c" "7c" "3.25c" + "5.8c" "4c" "7c" :width ".5c" + :cap "round" :join "round" :tags "item") + + (funcall c :create "text" "15c" ".2c" :text "Curves (smoothed :lines)" :anchor "n") + (funcall c :create "line" "11c" "4c" "11.5c" "1c" "13.5c" "1c" "14c" + "4c" :smooth "on" + :fill blue :tags "item") + (funcall c :create "line" "15.5c" "1c" "19.5c" "1.5c" "15.5c" "4.5c" + "19.5c" "4c" :smooth "on" + :arrow "both" :width 3 :tags "item") + (funcall c :create "line" "12c" "6c" "13.5c" "4.5c" "16.5c" "7.5c" "18c" "6c" + "16.5c" "4.5c" "13.5c" "7.5c" "12c" "6c" :smooth "on" :width "3m" :cap "round" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :fill red :tags "item") + + (funcall c :create "text" '25c ".2c" :text "Polygons" :anchor "n") + (funcall c :create "polygon" "21c" "1.0c" "22.5c" "1.75c" "24c" "1.0c" + "23.25c" "2.5c" + "24c" "4.0c" "22.5c" "3.25c" "21c" "4.0c" "21.75c" "2.5c" + :fill green :tags + "item") + (funcall c :create "polygon" "25c" "4c" "25c" "4c" "25c" "1c" "26c" "1c" "27c" "4c" "28c" "1c" + "29c" "1c" "29c" "4c" "29c" "4c" :fill red :smooth "on" :tags "item") + (funcall c :create "polygon" "22c" "4.5c" "25c" "4.5c" "25c" "6.75c" "28c" "6.75c" + "28c" "5.25c" "24c" "5.25c" "24c" "6.0c" "26c" "6c" "26c" "7.5c" "22c" "7.5c" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :tags "item") + + (funcall c :create "text" "5c" "8.2c" :text "Rectangles" :anchor "n") + (funcall c :create "rectangle" "1c" "9.5c" "4c" "12.5c" :outline red :width "3m" :tags "item") + (funcall c :create "rectangle" "0.5c" "13.5c" "4.5c" "15.5c" :fill green :tags "item") + (funcall c :create "rectangle" "6c" "10c" "9c" "15c" :outline "" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :fill blue :tags "item") + + (funcall c :create "text" "15c" "8.2c" :text "Ovals" :anchor "n") + (funcall c :create "oval" "11c" "9.5c" "14c" "12.5c" :outline red :width "3m" :tags "item") + (funcall c :create "oval" "10.5c" "13.5c" "14.5c" "15.5c" :fill green :tags "item") + (funcall c :create "oval" "16c" "10c" "19c" "15c" :outline "" + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :fill blue :tags "item") + + (funcall c :create "text" "25c" "8.2c" :text "Text" :anchor "n") + (funcall c :create "rectangle" "22.4c" "8.9c" "22.6c" "9.1c") + (funcall c :create "text" "22.5c" "9c" :anchor "n" :font font1 :width "4c" + :text "A short string of text, word-wrapped, justified left, and anchored north (at :the top). The rectangles show the anchor points for each piece of text." :tags "item") + (funcall c :create "rectangle" "25.4c" "10.9c" "25.6c" "11.1c") + (funcall c :create "text" "25.5c" "11c" :anchor "w" :font font1 :fill blue + :text #u"Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." + :justify "center" :tags "item") + (funcall c :create "rectangle" "24.9c" "13.9c" "25.1c" "14.1c") + (funcall c :create "text" "25c" "14c" :font font2 :anchor "c" :fill red + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" + :text "Stippled characters" :tags "item") + + (funcall c :create "text" "5c" "16.2c" :text "Arcs" :anchor "n") + (funcall c :create "arc" "0.5c" "17c" "7c" "20c" :fill green :outline "black" + :start 45 :extent 270 :style "pieslice" :tags "item") + (funcall c :create "arc" "6.5c" "17c" "9.5c" "20c" :width "4m" :style "arc" + :fill blue :start -135 :extent 270 + :stipple "@" : *tk-library* : "/demos/images/gray25.bmp" :tags "item") + (funcall c :create "arc" "0.5c" "20c" "9.5c" "24c" :width "4m" :style "pieslice" + :fill "" :outline red :start 225 :extent -90 :tags "item") + (funcall c :create "arc" "5.5c" "20.5c" "9.5c" "23.5c" :width "4m" :style "chord" + :fill blue :outline "" :start 45 :extent 270 :tags "item") + + (funcall c :create "text" "15c" "16.2c" :text "Bitmaps" :anchor "n") + (funcall c :create "bitmap" "13c" "20c" :bitmap "@" : *tk-library* : "/demos/images/face.bmp" :tags "item") + (funcall c :create "bitmap" "17c" "18.5c" + :bitmap "@" : *tk-library* : "/demos/images/noletter.bmp" :tags "item") + (funcall c :create "bitmap" "17c" "21.5c" + :bitmap "@" : *tk-library* : "/demos/images/letters.bmp" :tags "item") + + (funcall c :create "text" "25c" "16.2c" :text "Windows" :anchor "n") + (button (conc c '.button) :text "Press Me" :command `(butPress ',c ',red)) + (funcall c :create "window" "21c" "18c" :window (conc c '.button) :anchor "nw" :tags "item") + (bind "Entry" "" '(emacs-move %W %A )) + (bind "Entry" "" "") + (entry (conc c '.entry) :width 20 :relief "sunken") + (funcall (conc c '.entry) :insert "end" "Edit this text") + (funcall c :create "window" "21c" "21c" :window (conc c '.entry) :anchor "nw" :tags "item") + (scale (conc c '.scale) :from 0 :to 100 :length "6c" :sliderlength '.4c + :width ".5c" :tickinterval 0) + (funcall c :create "window" "28.5c" "17.5c" :window (conc c '.scale) :anchor "n" :tags "item") + (funcall c :create "text" "21c" "17.9c" :text "Button" :anchor "sw") + (funcall c :create "text" "21c" "20.9c" :text "Entry" :anchor "sw") + (funcall c :create "text" "28.5c" "17.4c" :text "Scale" :anchor "s") + + ;; Set up event bindings for canvas: + + (funcall c :bind "item" "" `(itemEnter ',c)) + (funcall c :bind "item" "" `(itemLeave ',c)) + (bind c "<2>" (tk-conc c " scan mark %x %y")) + (bind c "" (tk-conc c " scan dragto %x %y")) + (bind c "<3>" `(itemMark ',c |%x| |%y|)) + (bind c "" `(itemStroke ',c |%x| |%y|)) + (bind c "" `(itemsUnderArea ',c)) + (bind c "<1>" `(itemStartDrag ',c |%x| |%y|)) + (bind c "" `(itemDrag ',c |%x| |%y|)) + (bind w "" `(focus ',c)) +) + +;; Utility procedures for highlighting the item under the pointer: + +(defvar *restorecmd* nil) + +(defun itemEnter (c &aux type bg) + ; (global :*restorecmd*) + (let ((current (funcall c :find "withtag" "current" :return 'string))) + (if (equal current "") (return-from itementer nil)) + (itemleave nil) + (if (not *color-display*) + (progn + (itemLeave nil) + (return-from itementer nil))) + (setq type (funcall c :type current :return 'string)) + (if (equal type "window") + (progn + (itemLeave nil) + (return-from itemEnter nil))) + (if (equal type "bitmap") + (progn + (setq bg (nth 4 + (funcall c :itemconf current :background + :return 'list-strings))) + (push `(,c :itemconfig ',current :background ',bg) *restorecmd*) + (funcall c :itemconfig current :background "SteelBlue2") + (return-from itemEnter nil))) + (setq fill (nth 4 (funcall c :itemconfig current :fill + :return 'list-strings))) + (if (or (member type '("rectangle" "oval" "arg") :test 'equal) + (equal fill "")) + (progn + (setq outline (nth 4 (funcall c :itemconfig current :outline :return 'list-strings))) + (push `(,c :itemconfig ',current :outline ',outline) *restorecmd*) + (funcall c :itemconfig current :outline "SteelBlue2")) + (progn + (push `(,c :itemconfig ',current :fill ,fill) *restorecmd*) + (funcall c :itemconfig current :fill "SteelBlue2"))) + ) + ) + +(defun itemLeave (c) +; (global :*restorecmd*) + (let ((tem *restorecmd*)) + (setq *restorecmd* nil) + (dolist (v tem) + (eval v)))) + + +;; Utility procedures for stroking out a rectangle and printing what's +;; underneath the rectangle's area. + +(defun itemMark (c x y) +; (global :areaX1 areaY1) + (setq areaX1 (funcall c :canvasx x :return 'string)) + (setq areaY1 (funcall c :canvasy y :return 'string)) + (funcall c :delete "area") +) + +(defun itemStroke (c x y ) + (declare (special areaX1 areaY1 areaX2 areaY2)) + (or *recursive* + (let ((*recursive* t)) + (setq x (funcall c :canvasx x :return 'string)) + (setq y (funcall c :canvasy y :return 'string)) + (progn + (setq areaX2 x) + (setq areaY2 y) + ;; this next return 'stringis simply for TIMING!!! + ;; to make it wait for the result before going into subsequent!! + (funcall c :delete "area" :return 'string) + (funcall c :addtag "area" "withtag" + (funcall c :create "rect" areaX1 areaY1 x y + :outline "black" :return 'string)) + + )))) + +(defun itemsUnderArea (c) +; (global :areaX1 areaY1 areaX2 areaY2) + (setq area (funcall c :find "withtag" "area" :return 'string)) + (setq me c) + (setq items "") + (dolist (i + (funcall c :find "enclosed" areaX1 areaY1 areaX2 areaY2 + :return 'list-strings)) + (if (search "item" (funcall c :gettags i :return 'string)) + (setq items (tk-conc items " " i)))) + (print (tk-conc "Items enclosed by area: " items)) + (setq items "") + (dolist (i + (funcall c :find "overlapping" areaX1 areaY1 areaX2 areaY2 + :return 'list-strings)) + (if (search "item" (funcall c :gettags i :return 'string)) + (setq items (tk-conc items " " i)))) + (print (tk-conc "Items overlapping area: " items)) + (terpri) + (force-output) +) + +(setq areaX1 0) +(setq areaY1 0) +(setq areaX2 0) +(setq areaY2 0) + +;; Utility procedures to support dragging of items. + +(defvar *lastX* 0) +(defvar *lastY* 0) + + +(defun itemStartDrag (c x y) +; (global :*lastX* *lastY*) + (setq *lastX* (funcall c :canvasx x :return 'number)) + (setq *lastY* (funcall c :canvasy y :return 'number)) +) + +(defun itemDrag (c x y) +; (global :*lastX* *lastY*) + (setq x (funcall c :canvasx x :return 'number)) + (setq y (funcall c :canvasy y :return 'number)) + (funcall c :move "current" (- x *lastX*) (- y *lastY*)) + (setq *lastX* x) + (setq *lastY* y) +) + +(defvar *recursive* nil) +(defun itemDrag (c x y) +; (global :*lastX* *lastY*) + (cond (*recursive* ) + (t (let ((*recursive* t)) + (setq x (funcall c :canvasx x :return 'number)) + (setq y (funcall c :canvasy y :return 'number)) + (funcall c :move "current" (- x *lastX*) (- y *lastY*)) + (setq *lastX* x) + (setq *lastY* y))))) + +;; Procedure that's invoked when the button embedded in the "canvas" +;; is invoked. + +(defun butPress (w color) + (setq i (funcall w :create "text" "25c" "18.1c" :text "Ouch!!" + :fill color :anchor "n" :return 'string)) + (after 500 (tk-conc w " delete " i)) +) + +(defvar *last-kill* "") +;(bind ".citems.frame2.c.entry" "" '(emacs-move %W %A )) +(defun emacs-move (a key) + (let* ((win a) + ;; if this window is from tcl it is not yet a lisp function. + ;; steal it... build it into coerce-result... + (foo (or (fboundp win) (setf (symbol-function win) + (make-widget-instance win nil)))) + (pos (funcall win :index "insert" :return 'number)) + char + new) + (setq new + (case (setq char (aref key 0)) + (#\^B (max 0 (- pos 1))) + (#\^F (max 0 (+ pos 1))) + (#\^A 0) + (#\^E "end"))) +; (print (list a char key)) + (cond (new + (funcall win :icursor new)) + ((eql char #\^D) + (funcall win :delete pos )) + ((or (eql char #\^K) + (eql char #\v)) + (setq *last-kill* (subseq (funcall win :get :return 'string) pos)) + (funcall win :delete pos "end" )) + ((eql char #\^Y) + (funcall win :insert pos *last-kill*)) + (t (funcall win :insert pos key))))) + + + + + + + + diff --git a/gcl-tk/demos/mkItems.tcl b/gcl-tk/demos/mkItems.tcl new file mode 100755 index 0000000..7719347 --- /dev/null +++ b/gcl-tk/demos/mkItems.tcl @@ -0,0 +1,271 @@ +# mkItems w +# +# Create a top-level window containing a canvas that displays the +# various item types and allows them to be selected and moved. This +# demo can be used to test out the point-hit and rectangle-hit code +# for items. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkItems {{w .citems}} { + global c tk_library + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Canvas Item Demonstration" + wm iconname $w "Items" + wm minsize $w 100 100 + set c $w.frame2.c + + message $w.msg -font -Adobe-Times-Medium-R-Normal--*-180-* -width 13c \ + -bd 2 -relief raised -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area." + frame $w.frame2 -relief raised -bd 2 + button $w.ok -text "OK" -command "destroy $w" + pack $w.msg -side top -fill x + pack $w.frame2 -side top -fill both -expand yes + pack $w.ok -side bottom -pady 5 -anchor center + + canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ + -xscroll "$w.frame2.hscroll set" -yscroll "$w.frame2.vscroll set" + scrollbar $w.frame2.vscroll -relief sunken -command "$c yview" + scrollbar $w.frame2.hscroll -orient horiz -relief sunken -command "$c xview" + pack $w.frame2.hscroll -side bottom -fill x + pack $w.frame2.vscroll -side right -fill y + pack $c -in $w.frame2 -expand yes -fill both + + # Display a 3x3 rectangular grid. + + $c create rect 0c 0c 30c 24c -width 2 + $c create line 0c 8c 30c 8c -width 2 + $c create line 0c 16c 30c 16c -width 2 + $c create line 10c 0c 10c 24c -width 2 + $c create line 20c 0c 20c 24c -width 2 + + set font1 -Adobe-Helvetica-Medium-R-Normal--*-120-* + set font2 -Adobe-Helvetica-Bold-R-Normal--*-240-* + if {[winfo depth $c] > 1} { + set blue DeepSkyBlue3 + set red red + set bisque bisque3 + set green SeaGreen3 + } else { + set blue black + set red black + set bisque black + set green black + } + + # Set up demos within each of the areas of the grid. + + $c create text 5c .2c -text Lines -anchor n + $c create line 1c 1c 3c 1c 1c 4c 3c 4c -width 2m -fill $blue \ + -cap butt -join miter -tags item + $c create line 4.67c 1c 4.67c 4c -arrow last -tags item + $c create line 6.33c 1c 6.33c 4c -arrow both -tags item + $c create line 5c 6c 9c 6c 9c 1c 8c 1c 8c 4.8c 8.8c 4.8c 8.8c 1.2c \ + 8.2c 1.2c 8.2c 4.6c 8.6c 4.6c 8.6c 1.4c 8.4c 1.4c 8.4c 4.4c \ + -width 3 -fill $red -tags item + $c create line 1c 5c 7c 5c 7c 7c 9c 7c -width .5c \ + -stipple @$tk_library/demos/bitmaps/grey.25 \ + -arrow both -arrowshape {15 15 7} -tags item + $c create line 1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c \ + -cap round -join round -tags item + + $c create text 15c .2c -text "Curves (smoothed lines)" -anchor n + $c create line 11c 4c 11.5c 1c 13.5c 1c 14c 4c -smooth on \ + -fill $blue -tags item + $c create line 15.5c 1c 19.5c 1.5c 15.5c 4.5c 19.5c 4c -smooth on \ + -arrow both -width 3 -tags item + $c create line 12c 6c 13.5c 4.5c 16.5c 7.5c 18c 6c \ + 16.5c 4.5c 13.5c 7.5c 12c 6c -smooth on -width 3m -cap round \ + -stipple @$tk_library/demos/bitmaps/grey.25 -fill $red -tags item + + $c create text 25c .2c -text Polygons -anchor n + $c create polygon 21c 1.0c 22.5c 1.75c 24c 1.0c 23.25c 2.5c \ + 24c 4.0c 22.5c 3.25c 21c 4.0c 21.75c 2.5c -fill $green -tags item + $c create polygon 25c 4c 25c 4c 25c 1c 26c 1c 27c 4c 28c 1c \ + 29c 1c 29c 4c 29c 4c -fill $red -smooth on -tags item + $c create polygon 22c 4.5c 25c 4.5c 25c 6.75c 28c 6.75c \ + 28c 5.25c 24c 5.25c 24c 6.0c 26c 6c 26c 7.5c 22c 7.5c \ + -stipple @$tk_library/demos/bitmaps/grey.25 -tags item + + $c create text 5c 8.2c -text Rectangles -anchor n + $c create rectangle 1c 9.5c 4c 12.5c -outline $red -width 3m -tags item + $c create rectangle 0.5c 13.5c 4.5c 15.5c -fill $green -tags item + $c create rectangle 6c 10c 9c 15c -outline {} \ + -stipple @$tk_library/demos/bitmaps/grey.25 -fill $blue -tags item + + $c create text 15c 8.2c -text Ovals -anchor n + $c create oval 11c 9.5c 14c 12.5c -outline $red -width 3m -tags item + $c create oval 10.5c 13.5c 14.5c 15.5c -fill $green -tags item + $c create oval 16c 10c 19c 15c -outline {} \ + -stipple @$tk_library/demos/bitmaps/grey.25 -fill $blue -tags item + + $c create text 25c 8.2c -text Text -anchor n + $c create rectangle 22.4c 8.9c 22.6c 9.1c + $c create text 22.5c 9c -anchor n -font $font1 -width 4c \ + -text "A short string of text, word-wrapped, justified left, and anchored north (at the top). The rectangles show the anchor points for each piece of text." -tags item + $c create rectangle 25.4c 10.9c 25.6c 11.1c + $c create text 25.5c 11c -anchor w -font $font1 -fill $blue \ + -text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." \ + -justify center -tags item + $c create rectangle 24.9c 13.9c 25.1c 14.1c + $c create text 25c 14c -font $font2 -anchor c -fill $red \ + -stipple @$tk_library/demos/bitmaps/grey.5 \ + -text "Stippled characters" -tags item + + $c create text 5c 16.2c -text Arcs -anchor n + $c create arc 0.5c 17c 7c 20c -fill $green -outline black \ + -start 45 -extent 270 -style pieslice -tags item + $c create arc 6.5c 17c 9.5c 20c -width 4m -style arc \ + -fill $blue -start -135 -extent 270 \ + -stipple @$tk_library/demos/bitmaps/grey.25 -tags item + $c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \ + -fill {} -outline $red -start 225 -extent -90 -tags item + $c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \ + -fill $blue -outline {} -start 45 -extent 270 -tags item + + $c create text 15c 16.2c -text Bitmaps -anchor n + $c create bitmap 13c 20c -bitmap @$tk_library/demos/bitmaps/face -tags item + $c create bitmap 17c 18.5c \ + -bitmap @$tk_library/demos/bitmaps/noletters -tags item + $c create bitmap 17c 21.5c \ + -bitmap @$tk_library/demos/bitmaps/letters -tags item + + $c create text 25c 16.2c -text Windows -anchor n + button $c.button -text "Press Me" -command "butPress $c $red" + $c create window 21c 18c -window $c.button -anchor nw -tags item + entry $c.entry -width 20 -relief sunken + $c.entry insert end "Edit this text" + $c create window 21c 21c -window $c.entry -anchor nw -tags item + scale $c.scale -from 0 -to 100 -length 6c -sliderlength .4c \ + -width .5c -tickinterval 0 + $c create window 28.5c 17.5c -window $c.scale -anchor n -tags item + $c create text 21c 17.9c -text Button: -anchor sw + $c create text 21c 20.9c -text Entry: -anchor sw + $c create text 28.5c 17.4c -text Scale: -anchor s + + # Set up event bindings for canvas: + + $c bind item "itemEnter $c" + $c bind item "itemLeave $c" + bind $c <2> "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" + bind $c <3> "itemMark $c %x %y" + bind $c "itemStroke $c %x %y" + bind $c "itemsUnderArea $c" + bind $c <1> "itemStartDrag $c %x %y" + bind $c "itemDrag $c %x %y" + bind $w "focus $c" +} + +# Utility procedures for highlighting the item under the pointer: + +proc itemEnter {c} { + global restoreCmd + + if {[winfo depth $c] <= 1} { + set restoreCmd {} + return + } + set type [$c type current] + if {$type == "window"} { + set restoreCmd {} + return + } + if {$type == "bitmap"} { + set bg [lindex [$c itemconf current -background] 4] + set restoreCmd [list $c itemconfig current -background $bg] + $c itemconfig current -background SteelBlue2 + return + } + set fill [lindex [$c itemconfig current -fill] 4] + if {(($type == "rectangle") || ($type == "oval") || ($type == "arc")) + && ($fill == "")} { + set outline [lindex [$c itemconfig current -outline] 4] + set restoreCmd "$c itemconfig current -outline $outline" + $c itemconfig current -outline SteelBlue2 + } else { + set restoreCmd "$c itemconfig current -fill $fill" + $c itemconfig current -fill SteelBlue2 + } +} + +proc itemLeave {c} { + global restoreCmd + + eval $restoreCmd +} + +# Utility procedures for stroking out a rectangle and printing what's +# underneath the rectangle's area. + +proc itemMark {c x y} { + global areaX1 areaY1 + set areaX1 [$c canvasx $x] + set areaY1 [$c canvasy $y] + $c delete area +} + +proc itemStroke {c x y} { + global areaX1 areaY1 areaX2 areaY2 + set x [$c canvasx $x] + set y [$c canvasy $y] + if {($areaX1 != $x) && ($areaY1 != $y)} { + $c delete area + $c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \ + -outline black] + set areaX2 $x + set areaY2 $y + } +} + +proc itemsUnderArea {c} { + global areaX1 areaY1 areaX2 areaY2 + set area [$c find withtag area] + set items "" + foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] { + if {[lsearch [$c gettags $i] item] != -1} { + lappend items $i + } + } + puts stdout "Items enclosed by area: $items" + set items "" + foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] { + if {[lsearch [$c gettags $i] item] != -1} { + lappend items $i + } + } + puts stdout "Items overlapping area: $items" +} + +set areaX1 0 +set areaY1 0 +set areaX2 0 +set areaY2 0 + +# Utility procedures to support dragging of items. + +proc itemStartDrag {c x y} { + global lastX lastY + set lastX [$c canvasx $x] + set lastY [$c canvasy $y] +} + +proc itemDrag {c x y} { + global lastX lastY + set x [$c canvasx $x] + set y [$c canvasy $y] + $c move current [expr $x-$lastX] [expr $y-$lastY] + set lastX $x + set lastY $y +} + +# Procedure that's invoked when the button embedded in the canvas +# is invoked. + +proc butPress {w color} { + set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n] + after 500 "$w delete $i" +} diff --git a/gcl-tk/demos/mkLabel.lisp b/gcl-tk/demos/mkLabel.lisp new file mode 100755 index 0000000..e1c63b4 --- /dev/null +++ b/gcl-tk/demos/mkLabel.lisp @@ -0,0 +1,35 @@ +;;# mkLabel w +;; +;; Create a top-level window that displays a bunch of labels. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(in-package "TK") +(defun mkLabel (&optional (w '.l1)) +; (global :tk_library) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Label Demonstration") + (wm :iconname w "Labels") + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 + :text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right. Labels are pretty boring because you can't do anything with them. Click the \"OK\" button when you've seen enough.") + (frame (conc w '.left)) + (frame (conc w '.right)) + (button (conc w '.ok) :text "OK" :command `(destroy ',w)) + (pack (conc w '.msg) :side "top") + (pack (conc w '.ok) :side "bottom" :fill "x") + (pack (conc w '.left) (conc w '.right) :side "left" :expand "yes" :padx 10 :pady 10 :fill "both") + + (label (conc w '.left.l1) :text "First label") + (label (conc w '.left.l2) :text "Second label, raised just for fun" :relief "raised") + (label (conc w '.left.l3) :text "Third label, sunken" :relief "sunken") + (pack (conc w '.left.l1) (conc w '.left.l2) (conc w '.left.l3) + :side "top" :expand "yes" :pady 2 :anchor "w") + + (label (conc w '.right.bitmap) :bitmap "@": *tk-library* : "/demos/images/face" + :borderwidth 2 :relief "sunken") + (label (conc w '.right.caption) :text "Tcl/Tk Proprietor") + (pack (conc w '.right.bitmap) (conc w '.right.caption) :side "top") +) diff --git a/gcl-tk/demos/mkLabel.tcl b/gcl-tk/demos/mkLabel.tcl new file mode 100755 index 0000000..f73f1c6 --- /dev/null +++ b/gcl-tk/demos/mkLabel.tcl @@ -0,0 +1,34 @@ +# mkLabel w +# +# Create a top-level window that displays a bunch of labels. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkLabel {{w .l1}} { + global tk_library + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Label Demonstration" + wm iconname $w "Labels" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right. Labels are pretty boring because you can't do anything with them. Click the \"OK\" button when you've seen enough." + frame $w.left + frame $w.right + button $w.ok -text OK -command "destroy $w" + pack $w.msg -side top + pack $w.ok -side bottom -fill x + pack $w.left $w.right -side left -expand yes -padx 10 -pady 10 -fill both + + label $w.left.l1 -text "First label" + label $w.left.l2 -text "Second label, raised just for fun" -relief raised + label $w.left.l3 -text "Third label, sunken" -relief sunken + pack $w.left.l1 $w.left.l2 $w.left.l3 \ + -side top -expand yes -pady 2 -anchor w + + label $w.right.bitmap -bitmap @$tk_library/demos/images/face.bmp \ + -borderwidth 2 -relief sunken + label $w.right.caption -text "Tcl/Tk Proprietor" + pack $w.right.bitmap $w.right.caption -side top +} diff --git a/gcl-tk/demos/mkListbox.lisp b/gcl-tk/demos/mkListbox.lisp new file mode 100755 index 0000000..821235d --- /dev/null +++ b/gcl-tk/demos/mkListbox.lisp @@ -0,0 +1,42 @@ +(in-package "TK") + +(defun mklistbox (&optional (w '.listbox)) + (toplevel w ) + (dpos w) + (wm :title w "Listbox Demonstration (50 states)") + (wm :iconname w "Listbox") + (wm :minsize w 1 1) + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 + :text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. Click the OK button when you've seen enough.") + (frame (conc w '.frame) :borderwidth 10) + (button (conc w '.ok) :text "OK" :command `(destroy ',w)) + (pack (conc w '.frame) :side "top" :expand "yes" :fill "y") + (pack (conc w '.ok) :side "bottom" :fill "x") + (scrollbar (conc w '.frame '.scroll) :relief "sunken" :command + (tk-conc w ".frame.list yview")) + (listbox (conc w '.frame.list) :yscroll (tk-conc w ".frame.scroll set") + :relief "sunken" + :setgrid 1) + (pack (conc w '.frame.scroll) :side "right" :fill "y") + (pack (conc w '.frame.list) :side "left" :expand "yes" :fill "both") + (funcall (conc w '.frame.list) + :insert 0 + "Alabama" "Alaska" "Arizona" "Arkansas" "California" + "Colorado" "Connecticut" "Delaware" "Florida" "Georgia" "Hawaii" "Idaho" "Illinois" + "Indiana" "Iowa" "Kansas" "Kentucky" "Louisiana" "Maine" "Maryland" + "Massachusetts" "Michigan" "Minnesota" "Mississippi" "Missouri" + "Montana" "Nebraska" "Nevada" "New Hampshire" "New Jersey" "New Mexico" + "New York" "North Carolina" "North Dakota" + "Ohio" "Oklahoma" "Oregon" "Pennsylvania" "Rhode Island" + "South Carolina" "South Dakota" + "Tennessee" "Texas" "Utah" "Vermont" "Virginia" "Washington" + "West Virginia" "Wisconsin" "Wyoming") + w) + + + + + + + + diff --git a/gcl-tk/demos/mkListbox.tcl b/gcl-tk/demos/mkListbox.tcl new file mode 100755 index 0000000..a116170 --- /dev/null +++ b/gcl-tk/demos/mkListbox.tcl @@ -0,0 +1,41 @@ +# mkListbox w +# +# Create a top-level window that displays a listbox with the names of the +# 50 states. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkListbox {{w .l1}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Listbox Demonstration (50 states)" + wm iconname $w "Listbox" + wm minsize $w 1 1 + + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg -side top + pack $w.frame -side top -expand yes -fill y + pack $w.ok -side bottom -fill x + + scrollbar $w.frame.scroll -relief sunken -command "$w.frame.list yview" + listbox $w.frame.list -yscroll "$w.frame.scroll set" -relief sunken \ + -setgrid 1 + pack $w.frame.scroll -side right -fill y + pack $w.frame.list -side left -expand yes -fill both + + $w.frame.list insert 0 Alabama Alaska Arizona Arkansas California \ + Colorado Connecticut Delaware Florida Georgia Hawaii Idaho Illinois \ + Indiana Iowa Kansas Kentucky Louisiana Maine Maryland \ + Massachusetts Michigan Minnesota Mississippi Missouri \ + Montana Nebraska Nevada "New Hampshire" "New Jersey" "New Mexico" \ + "New York" "North Carolina" "North Dakota" \ + Ohio Oklahoma Oregon Pennsylvania "Rhode Island" \ + "South Carolina" "South Dakota" \ + Tennessee Texas Utah Vermont Virginia Washington \ + "West Virginia" Wisconsin Wyoming +} diff --git a/gcl-tk/demos/mkListbox2.tcl b/gcl-tk/demos/mkListbox2.tcl new file mode 100755 index 0000000..008ea17 --- /dev/null +++ b/gcl-tk/demos/mkListbox2.tcl @@ -0,0 +1,95 @@ +# mkListbox2 w +# +# Create a top-level window containing a listbox showing a bunch of +# colors from the X color database. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkListbox2 {{w .l2}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Listbox Demonstration (colors)" + wm iconname $w "Listbox" + wm minsize $w 1 1 + + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "A listbox containing several color values is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. If you double-click button 1 on a color, then the background for the window will be changed to that color. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg -side top + pack $w.ok -side bottom -fill x + pack $w.frame -side top -expand yes -fill y + + scrollbar $w.frame.scroll -relief sunken -command "$w.frame.list yview" + listbox $w.frame.list -yscroll "$w.frame.scroll set" -relief sunken \ + -setgrid 1 + pack $w.frame.list $w.frame.scroll -side left -fill y + + $w.frame.list insert 0 snow1 snow2 snow3 snow4 seashell1 seashell2 \ + seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \ + AntiqueWhite4 bisque1 bisque2 bisque3 bisque4 PeachPuff1 \ + PeachPuff2 PeachPuff3 PeachPuff4 NavajoWhite1 NavajoWhite2 \ + NavajoWhite3 NavajoWhite4 LemonChiffon1 LemonChiffon2 \ + LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2 cornsilk3 \ + cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2 \ + honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 \ + LavenderBlush3 LavenderBlush4 MistyRose1 MistyRose2 \ + MistyRose3 MistyRose4 azure1 azure2 azure3 azure4 \ + SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 RoyalBlue1 \ + RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4 \ + DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 \ + SteelBlue2 SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 \ + DeepSkyBlue3 DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 \ + SkyBlue4 LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 \ + LightSkyBlue4 SlateGray1 SlateGray2 SlateGray3 SlateGray4 \ + LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 \ + LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 \ + LightBlue4 LightCyan1 LightCyan2 LightCyan3 LightCyan4 \ + PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 \ + CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 turquoise1 \ + turquoise2 turquoise3 turquoise4 cyan1 cyan2 cyan3 cyan4 \ + DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \ + DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 \ + aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \ + DarkSeaGreen4 SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 \ + PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \ + SpringGreen2 SpringGreen3 SpringGreen4 green1 green2 \ + green3 green4 chartreuse1 chartreuse2 chartreuse3 \ + chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \ + DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 \ + DarkOliveGreen4 khaki1 khaki2 khaki3 khaki4 \ + LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 \ + LightGoldenrod4 LightYellow1 LightYellow2 LightYellow3 \ + LightYellow4 yellow1 yellow2 yellow3 yellow4 gold1 gold2 \ + gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4 \ + DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 \ + RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1 \ + IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 \ + sienna4 burlywood1 burlywood2 burlywood3 burlywood4 wheat1 \ + wheat2 wheat3 wheat4 tan1 tan2 tan3 tan4 chocolate1 \ + chocolate2 chocolate3 chocolate4 firebrick1 firebrick2 \ + firebrick3 firebrick4 brown1 brown2 brown3 brown4 salmon1 \ + salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2 \ + LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 \ + DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 coral1 \ + coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \ + OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 red1 red2 red3 \ + red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \ + HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \ + LightPink1 LightPink2 LightPink3 LightPink4 PaleVioletRed1 \ + PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \ + maroon2 maroon3 maroon4 VioletRed1 VioletRed2 VioletRed3 \ + VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \ + orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \ + MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 \ + DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \ + purple2 purple3 purple4 MediumPurple1 MediumPurple2 \ + MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \ + thistle4 + bind $w.frame.list \ + "$w config -bg \[lindex \[selection get\] 0\] + $w.frame config -bg \[lindex \[selection get\] 0\] + $w.msg config -bg \[lindex \[selection get\] 0\]" +} diff --git a/gcl-tk/demos/mkListbox3.tcl b/gcl-tk/demos/mkListbox3.tcl new file mode 100755 index 0000000..7d8b9eb --- /dev/null +++ b/gcl-tk/demos/mkListbox3.tcl @@ -0,0 +1,34 @@ +# mkListbox3 w +# +# Create a top-level window containing a listbox with a bunch of well-known +# sayings. The listbox can be scrolled or scanned in two dimensions. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkListbox3 {{w .l3}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Listbox Demonstration (well-known sayings)" + wm iconname $w "Listbox" + wm minsize $w 1 1 + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "The listbox below contains a collection of well-known sayings. You can scan the list using either of the scrollbars or by dragging in the listbox window with button 2 pressed. Click the \"OK\" button when you're done." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg -side top + pack $w.ok -side bottom -fill x + pack $w.frame -side top -expand yes -fill y + + scrollbar $w.frame.yscroll -relief sunken -command "$w.frame.list yview" + scrollbar $w.frame.xscroll -relief sunken -orient horizontal \ + -command "$w.frame.list xview" + listbox $w.frame.list -width 20 -height 10 -yscroll "$w.frame.yscroll set" \ + -xscroll "$w.frame.xscroll set" -relief sunken -setgrid 1 + pack $w.frame.yscroll -side right -fill y + pack $w.frame.xscroll -side bottom -fill x + pack $w.frame.list -expand yes -fill y + + $w.frame.list insert 0 "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth" +} diff --git a/gcl-tk/demos/mkPlot.lisp b/gcl-tk/demos/mkPlot.lisp new file mode 100755 index 0000000..01c58a6 --- /dev/null +++ b/gcl-tk/demos/mkPlot.lisp @@ -0,0 +1,81 @@ +(in-package "TK") +;;# mkPlot w +;; +;; Create a top-level window containing a canvas displaying a simple +;; graph with data points that can be moved interactively. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(defun mkPlot ( &optional (w '.plot ) &aux c font x y item) + (toplevel w ) + (dpos w) + (wm :title w "Plot Demonstration " : w) + (wm :iconname w "Plot") + (setq c (conc w '.c)) + + (message (conc w '.msg) :font :Adobe-Times-Medium-R-Normal-*-180-* :width 400 + :bd 2 :relief "raised" :text "This window displays a canvas widget containing a simple 2-dimensional plot. You can doctor the data by dragging any of the points with mouse button 1.") + (canvas c :relief "raised" :width 450 :height 300) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) (conc w '.c) :side "top" :fill "x") + (pack (conc w '.ok) :side "bottom" :pady 5) + + (setq font :Adobe-helvetica-medium-r-*-180-*) + + (funcall c :create "line" 100 250 400 250 :width 2) + (funcall c :create "line" 100 250 100 50 :width 2) + (funcall c :create "text" 225 20 :text "A Simple Plot" :font font :fill "brown") + + (sloop for i to 10 do + (setq x (+ 100 (* i 30))) + (funcall c :create "line" x 250 x 245 :width 2) + (funcall c :create "text" x 254 :text (* 10 i) :anchor "n" :font font)) + + (sloop for i to 5 do + (setq y (- 250 (* i 40))) + (funcall c :create "line" 100 y 105 y :width 2) + (funcall c :create "text" 96 y :text (* i 50) : ".0" :anchor "e" :font font)) + + (sloop for point in '((12 56) (20 94) (33 98) (32 120) (61 180) + (75 160) (98 223)) + do + (setq x (+ 100 (* 3 (nth 0 point)))) + (setq y (- 250 (truncate (* 4 (nth 1 point)) 5))) + (setq item (funcall c :create "oval" (- x 6) (- y 6) + (+ x 6) (+ y 6) :width 1 :outline "black" + :fill "SkyBlue2" :return 'string )) + (funcall c :addtag "point" "withtag" item) + ) + + + (funcall c :bind "point" "" c : " itemconfig current -fill red") + (funcall c :bind "point" "" c : " itemconfig current -fill SkyBlue2") + (funcall c :bind "point" "<1>" `(plotdown ',c |%x| |%y|)) + (funcall c :bind "point" "" c : " dtag selected") + (bind c "" `(plotmove ',c |%x| |%y|)) +) + +(defvar plotlastX 0) +(defvar plotlastY 0) + +(defun plotDown (w x y) + (funcall w :dtag "selected") + (funcall w :addtag "selected" "withtag" "current") + (funcall w :raise "current") + (setq plotlastY y) + (setq plotlastX x) +) + +(defun plotMove (w x y &aux ) + (let ((oldx plotlastX) + (oldy plotlastY)) + ;; Note plotmove may be called recursively... since + ;; the funcall may call something which calls this. + ;; so we must set the global plotlastx before the funcall.. + (setq plotlastx x) + (setq plotlastY y) + (funcall w :move "selected" (- x oldx) (- y oldy)) + ) + ) + diff --git a/gcl-tk/demos/mkPlot.tcl b/gcl-tk/demos/mkPlot.tcl new file mode 100755 index 0000000..6cecea6 --- /dev/null +++ b/gcl-tk/demos/mkPlot.tcl @@ -0,0 +1,75 @@ +# mkPlot w +# +# Create a top-level window containing a canvas displaying a simple +# graph with data points that can be moved interactively. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkPlot {{w .plot}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Plot Demonstration" + wm iconname $w "Plot" + set c $w.c + + message $w.msg -font -Adobe-Times-Medium-R-Normal-*-180-* -width 400 \ + -bd 2 -relief raised -text "This window displays a canvas widget containing a simple 2-dimensional plot. You can doctor the data by dragging any of the points with mouse button 1." + canvas $c -relief raised -width 450 -height 300 + button $w.ok -text "OK" -command "destroy $w" + pack $w.msg $w.c -side top -fill x + pack $w.ok -side bottom -pady 5 + + set font -Adobe-helvetica-medium-r-*-180-* + + $c create line 100 250 400 250 -width 2 + $c create line 100 250 100 50 -width 2 + $c create text 225 20 -text "A Simple Plot" -font $font -fill brown + + for {set i 0} {$i <= 10} {incr i} { + set x [expr {100 + ($i*30)}] + $c create line $x 250 $x 245 -width 2 + $c create text $x 254 -text [expr 10*$i] -anchor n -font $font + } + for {set i 0} {$i <= 5} {incr i} { + set y [expr {250 - ($i*40)}] + $c create line 100 $y 105 $y -width 2 + $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font + } + + foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} + {75 160} {98 223}} { + set x [expr {100 + (3*[lindex $point 0])}] + set y [expr {250 - (4*[lindex $point 1])/5}] + set item [$c create oval [expr $x-6] [expr $y-6] \ + [expr $x+6] [expr $y+6] -width 1 -outline black \ + -fill SkyBlue2] + $c addtag point withtag $item + } + + $c bind point "$c itemconfig current -fill red" + $c bind point "$c itemconfig current -fill SkyBlue2" + $c bind point <1> "plotDown $c %x %y" + $c bind point "$c dtag selected" + bind $c "plotMove $c %x %y" +} + +set plot(lastX) 0 +set plot(lastY) 0 + +proc plotDown {w x y} { + global plot + $w dtag selected + $w addtag selected withtag current + $w raise current + set plot(lastX) $x + set plot(lastY) $y +} + +proc plotMove {w x y} { + global plot + $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] + set plot(lastX) $x + set plot(lastY) $y +} diff --git a/gcl-tk/demos/mkPuzzle.tcl b/gcl-tk/demos/mkPuzzle.tcl new file mode 100755 index 0000000..1e8d226 --- /dev/null +++ b/gcl-tk/demos/mkPuzzle.tcl @@ -0,0 +1,59 @@ +# mkPuzzle w +# +# Create a top-level window containing a 15-puzzle game. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkPuzzle {{w .p1}} { + global xpos ypos + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "15-Puzzle Demonstration" + wm iconname $w "15-Puzzle" + + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "A 15-puzzle appears below as a collection of buttons. Click on any of the pieces next to the space, and that piece will slide over the space. Continue this until the pieces are arranged in numerical order from upper-left to lower-right. Click the \"OK\" button when you've finished playing." + frame $w.frame -width 120 -height 120 -borderwidth 2 -relief sunken \ + -bg Bisque3 + button $w.ok -text OK -command "destroy $w" + pack $w.msg -side top + pack $w.frame -side top -padx 5 -pady 5 + pack $w.ok -side bottom -fill x + + set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12} + for {set i 0} {$i < 15} {set i [expr $i+1]} { + set num [lindex $order $i] + set xpos($num) [expr ($i%4)*.25] + set ypos($num) [expr ($i/4)*.25] + button $w.frame.$num -relief raised -text $num \ + -command "puzzle.switch $w $num" + place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \ + -relwidth .25 -relheight .25 + } + set xpos(space) .75 + set ypos(space) .75 +} + +# Procedure invoked by buttons in the puzzle to resize the puzzle entries: + +proc puzzle.switch {w num} { + global xpos ypos + if {(($ypos($num) >= ($ypos(space) - .01)) + && ($ypos($num) <= ($ypos(space) + .01)) + && ($xpos($num) >= ($xpos(space) - .26)) + && ($xpos($num) <= ($xpos(space) + .26))) + || (($xpos($num) >= ($xpos(space) - .01)) + && ($xpos($num) <= ($xpos(space) + .01)) + && ($ypos($num) >= ($ypos(space) - .26)) + && ($ypos($num) <= ($ypos(space) + .26)))} { + set tmp $xpos(space) + set xpos(space) $xpos($num) + set xpos($num) $tmp + set tmp $ypos(space) + set ypos(space) $ypos($num) + set ypos($num) $tmp + place $w.frame.$num -relx $xpos($num) -rely $ypos($num) + } +} diff --git a/gcl-tk/demos/mkRadio.lisp b/gcl-tk/demos/mkRadio.lisp new file mode 100755 index 0000000..8f5a4ce --- /dev/null +++ b/gcl-tk/demos/mkRadio.lisp @@ -0,0 +1,61 @@ +(in-package "TK") +;;# mkRadio w +;; +;; Create a top-level window that displays a bunch of radio buttons. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(defun mkRadio (&optional (w '.r1)) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Radiobutton Demonstration") + (wm :iconname w "Radiobuttons") + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 + :text "Two groups of radiobuttons are displayed below. If you click on a button then the button will become selected exclusively among all the buttons in its group. A Tcl variable is associated with each group to indicate which of the group's buttons is selected. Click the \"See Variables\" button to see the current values of the variables. Click the \"OK\" button when you've seen enough.") + (frame (conc w '.frame) :borderwidth 10) + (frame (conc w '.frame2)) + (pack (conc w '.msg) :side "top") + (pack (conc w '.msg) :side "top") + (pack (conc w '.frame) :side "top" :fill "x" :pady 10) + (pack (conc w '.frame2) :side "bottom" :fill "x") + + (frame (conc w '.frame.left)) + (frame (conc w '.frame.right)) + (pack (conc w '.frame.left) (conc w '.frame.right) :side "left" :expand "yes") + + (radiobutton (conc w '.frame.left.b1) :text "Point Size 10" :variable 'size + :relief "flat" :value 10) + (radiobutton (conc w '.frame.left.b2) :text "Point Size 12" :variable 'size + :relief "flat" :value 12) + (radiobutton (conc w '.frame.left.b3) :text "Point Size 18" :variable 'size + :relief "flat" :value 18) + (radiobutton (conc w '.frame.left.b4) :text "Point Size 24" :variable 'size + :relief "flat" :value 24) + (pack (conc w '.frame.left.b1) (conc w '.frame.left.b2) (conc w '.frame.left.b3) (conc w '.frame.left.b4) + :side "top" :pady 2 :anchor "w") + + (radiobutton (conc w '.frame.right.b1) :text "Red" :variable 'color + :relief "flat" :value "red") + (radiobutton (conc w '.frame.right.b2) :text "Green" :variable 'color + :relief "flat" :value "green") + (radiobutton (conc w '.frame.right.b3) :text "Blue" :variable 'color + :relief "flat" :value "blue") + (radiobutton (conc w '.frame.right.b4) :text "Yellow" :variable 'color + :relief "flat" :value "yellow") + (radiobutton (conc w '.frame.right.b5) :text "Orange" :variable 'color + :relief "flat" :value "orange") + (radiobutton (conc w '.frame.right.b6) :text "Purple" :variable 'color + :relief "flat" :value "purple") + (pack (conc w '.frame.right.b1) (conc w '.frame.right.b2) (conc w '.frame.right.b3) + (conc w '.frame.right.b4) (conc w '.frame.right.b5) (conc w '.frame.right.b6) + :side "top" :pady 2 :anchor "w") + + (button (conc w '.frame2.ok) :text "OK" :command (tk-conc "destroy " w) :width 12) + (button (conc w '.frame2.vars) :text "See Variables" :width 12 + :command `(showvars (conc ',w '.dialog) '(size color))) + (pack (conc w '.frame2.ok) (conc w '.frame2.vars) :side "left" :expand "yes" :fill "x") +) + + diff --git a/gcl-tk/demos/mkRadio.tcl b/gcl-tk/demos/mkRadio.tcl new file mode 100755 index 0000000..0087fef --- /dev/null +++ b/gcl-tk/demos/mkRadio.tcl @@ -0,0 +1,58 @@ +# mkRadio w +# +# Create a top-level window that displays a bunch of radio buttons. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkRadio {{w .r1}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Radiobutton Demonstration" + wm iconname $w "Radiobuttons" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "Two groups of radiobuttons are displayed below. If you click on a button then the button will become selected exclusively among all the buttons in its group. A Tcl variable is associated with each group to indicate which of the group's buttons is selected. Click the \"See Variables\" button to see the current values of the variables. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + frame $w.frame2 + pack $w.msg -side top + pack $w.msg -side top + pack $w.frame -side top -fill x -pady 10 + pack $w.frame2 -side bottom -fill x + + frame $w.frame.left + frame $w.frame.right + pack $w.frame.left $w.frame.right -side left -expand yes + + radiobutton $w.frame.left.b1 -text "Point Size 10" -variable size \ + -relief flat -value 10 + radiobutton $w.frame.left.b2 -text "Point Size 12" -variable size \ + -relief flat -value 12 + radiobutton $w.frame.left.b3 -text "Point Size 18" -variable size \ + -relief flat -value 18 + radiobutton $w.frame.left.b4 -text "Point Size 24" -variable size \ + -relief flat -value 24 + pack $w.frame.left.b1 $w.frame.left.b2 $w.frame.left.b3 $w.frame.left.b4 \ + -side top -pady 2 -anchor w + + radiobutton $w.frame.right.b1 -text "Red" -variable color \ + -relief flat -value red + radiobutton $w.frame.right.b2 -text "Green" -variable color \ + -relief flat -value green + radiobutton $w.frame.right.b3 -text "Blue" -variable color \ + -relief flat -value blue + radiobutton $w.frame.right.b4 -text "Yellow" -variable color \ + -relief flat -value yellow + radiobutton $w.frame.right.b5 -text "Orange" -variable color \ + -relief flat -value orange + radiobutton $w.frame.right.b6 -text "Purple" -variable color \ + -relief flat -value purple + pack $w.frame.right.b1 $w.frame.right.b2 $w.frame.right.b3 \ + $w.frame.right.b4 $w.frame.right.b5 $w.frame.right.b6 \ + -side top -pady 2 -anchor w + + button $w.frame2.ok -text OK -command "destroy $w" -width 12 + button $w.frame2.vars -text "See Variables" -width 12\ + -command "showVars $w.dialog size color" + pack $w.frame2.ok $w.frame2.vars -side left -expand yes -fill x +} diff --git a/gcl-tk/demos/mkRuler.lisp b/gcl-tk/demos/mkRuler.lisp new file mode 100755 index 0000000..33bbb04 --- /dev/null +++ b/gcl-tk/demos/mkRuler.lisp @@ -0,0 +1,140 @@ +;;# mkRuler w +;; +;; Create a canvas demonstration consisting of a ruler. +;; +;; Arguments: +;; w - Name to use for new top-level window. +;; This file implements a canvas widget that displays a ruler with tab stops +;; that can be set individually. The only procedure that should be invoked +;; from outside the file is the first one, which creates the canvas. + +(in-package "TK") + +(defun mkRuler (&optional (w '.ruler)) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Ruler Demonstration") + (wm :iconname w "Ruler") + (setq c (conc w '.c)) + + (message (conc w '.msg) :font :Adobe-Times-Medium-R-Normal-*-180-* :width "13c" + :relief "raised" :bd 2 :text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. (if :you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button.") + (canvas c :width "14.8c" :height "2.5c" :relief "raised") + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) (conc w '.c) :side "top" :fill "x") + (pack (conc w '.ok) :side "bottom" :pady 5) + (setf *v* (gensym)) + (setf (get *v* 'grid) '.25c) + (setf (get *v* 'left) (winfo :fpixels c "1c" :return t)) + (setf (get *v* 'right) (winfo :fpixels c "13c" :return t)) + (setf (get *v* 'top) (winfo :fpixels c "1c" :return t)) + (setf (get *v* 'bottom) (winfo :fpixels c "1.5c" :return t)) + (setf (get *v* 'size) (winfo :fpixels c '.2c :return t)) + (setf (get *v* 'normalStyle) '(:fill "black")) + (if (> (read-from-string (winfo :depth c)) 1) + (progn + (setf (get *v* 'activeStyle) '(:fill "red" :stipple "")) + (setf (get *v* 'deleteStyle) + `(:stipple "@" : ,*tk-library* :"/demos/bitmaps/grey.25" + :fill "red")) + );;else + (progn + (setf (get *v* 'activeStyle) '(:fill "black" :stipple "" )) + (setf (get *v* 'deleteStyle) + `(:stipple "@" : ,*tk-library* : "/demos/bitmaps/grey.25" + :fill "black")) + )) + + (funcall c :create "line" "1c" "0.5c" "1c" "1c" "13c" "1c" "13c" "0.5c" :width 1) + (dotimes + (i 12) + (let (( x (+ i 1))) + (funcall c :create "line" x :"c" "1c" x :"c" "0.6c" :width 1) + (funcall c :create "line" x :".25c" "1c" x :".25c" "0.8c" :width 1) + (funcall c :create "line" x :".5c" "1c" x :".5c" "0.7c" :width 1) + (funcall c :create "line" x :".75c" "1c" x :".75c" "0.8c" :width 1) + (funcall c :create "text" x :".15c" '.75c :text i :anchor "sw") + )) + (funcall c :addtag "well" "withtag" + (funcall c :create "rect" "13.2c" "1c" "13.8c" "0.5c" + :outline "black" :fill + (nth 4 (funcall c :config :background + :return 'list-strings)))) + (funcall c :addtag "well" "withtag" + (rulerMkTab c (winfo :pixels c "13.5c" :return t) + (winfo :pixels c '.65c :return t))) + + (funcall c :bind "well" "<1>" `(rulerNewTab ',c |%x| |%y|)) + (funcall c :bind "tab" "<1>" `(demo_selectTab ',c |%x| |%y|)) + (bind c "" `(rulerMoveTab ',c |%x| |%y|)) + (bind c "" `(rulerReleaseTab ',c)) +) + +(defun rulerMkTab (c x y) + + (funcall c :create "polygon" x y (+ x (get *v* 'size)) + (+ y (get *v* 'size)) + (- x (get *v* 'size)) + (+ y (get *v* 'size)) + :return 'string + ) + +) + +(defun rulerNewTab (c x y) + + (funcall c :addtag "active" "withtag" (rulerMkTab c x y)) + (funcall c :addtag "tab" "withtag" "active") + (setf (get *v* 'x) x) + (setf (get *v* 'y) y) + (rulerMoveTab c x y) +) +(defvar *recursive* nil) +;; prevent recursive calls +(defun rulerMoveTab (c x y &aux cx cy (*recursive* *recursive*) ) + (cond (*recursive* (return-from rulerMoveTab)) + (t (setq *recursive* t))) + (if (equal (funcall c :find "withtag" "active" :return 'string) "") + (return-from rulerMoveTab nil)) + (setq cx (funcall c :canvasx x (get *v* 'grid) :return t)) + (setq cy (funcall c :canvasy y :return t)) + (if (< cx (get *v* 'left))(setq cx (get *v* 'left))) + (if (> cx (get *v* 'right))(setq cx (get *v* 'right))) + + (if (and (>= cy (get *v* 'top)) (<= cy (get *v* 'bottom))) + (progn + (setq cy (+ 2 (get *v* 'top))) + (apply c :itemconf "active" (get *v* 'activestyle))) + + (progn + (setq cy (- cy (get *v* 'size) 2)) + (apply c :itemconf "active"(get *v* 'deletestyle))) + ) + (funcall c :move "active" (- cx (get *v* 'x)) + (- cy (get *v* 'y)) ) + (setf (get *v* 'x) cx) + (setf (get *v* 'y) cy) + ) + +(defun demo_selectTab (c x y) + + (setf (get *v* 'x) (funcall c :canvasx x (get *v* 'grid) :return t)) + (setf (get *v* 'y) (+ 2 (get *v* 'top))) + (funcall c :addtag "active" "withtag" "current") + (apply c :itemconf "active" (get *v* 'activeStyle)) + (funcall c :raise "active") +) + +(defun rulerReleaseTab (c ) + + (if (equal (funcall c :find "withtag" "active" :return 'string) + "") (return-from rulerReleaseTab nil)) + + (if (not (eql (get *v* 'y) (+ 2 (get *v* 'top)))) + (funcall c :delete "active") + (progn + (apply c :itemconf "active" (get *v* 'normalStyle)) + (funcall c :dtag "active") + ) +)) diff --git a/gcl-tk/demos/mkRuler.tcl b/gcl-tk/demos/mkRuler.tcl new file mode 100755 index 0000000..da861f8 --- /dev/null +++ b/gcl-tk/demos/mkRuler.tcl @@ -0,0 +1,125 @@ +# mkRuler w +# +# Create a canvas demonstration consisting of a ruler. +# +# Arguments: +# w - Name to use for new top-level window. +# This file implements a canvas widget that displays a ruler with tab stops +# that can be set individually. The only procedure that should be invoked +# from outside the file is the first one, which creates the canvas. + +proc mkRuler {{w .ruler}} { + global tk_library + upvar #0 demo_rulerInfo v + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Ruler Demonstration" + wm iconname $w "Ruler" + set c $w.c + + message $w.msg -font -Adobe-Times-Medium-R-Normal-*-180-* -width 13c \ + -relief raised -bd 2 -text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button." + canvas $c -width 14.8c -height 2.5c -relief raised + button $w.ok -text "OK" -command "destroy $w" + pack $w.msg $w.c -side top -fill x + pack $w.ok -side bottom -pady 5 + + set v(grid) .25c + set v(left) [winfo fpixels $c 1c] + set v(right) [winfo fpixels $c 13c] + set v(top) [winfo fpixels $c 1c] + set v(bottom) [winfo fpixels $c 1.5c] + set v(size) [winfo fpixels $c .2c] + set v(normalStyle) "-fill black" + if {[winfo depth $c] > 1} { + set v(activeStyle) "-fill red -stipple {}" + set v(deleteStyle) "-stipple @$tk_library/demos/bitmaps/grey.25 \ + -fill red" + } else { + set v(activeStyle) "-fill black -stipple {}" + set v(deleteStyle) "-stipple @$tk_library/demos/bitmaps/grey.25 \ + -fill black" + } + + $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1 + for {set i 0} {$i < 12} {incr i} { + set x [expr $i+1] + $c create line ${x}c 1c ${x}c 0.6c -width 1 + $c create line $x.25c 1c $x.25c 0.8c -width 1 + $c create line $x.5c 1c $x.5c 0.7c -width 1 + $c create line $x.75c 1c $x.75c 0.8c -width 1 + $c create text $x.15c .75c -text $i -anchor sw + } + $c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \ + -outline black -fill [lindex [$c config -bg] 4]] + $c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \ + [winfo pixels $c .65c]] + + $c bind well <1> "rulerNewTab $c %x %y" + $c bind tab <1> "demo_selectTab $c %x %y" + bind $c "rulerMoveTab $c %x %y" + bind $c "rulerReleaseTab $c" +} + +proc rulerMkTab {c x y} { + upvar #0 demo_rulerInfo v + $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \ + [expr $x-$v(size)] [expr $y+$v(size)] +} + +proc rulerNewTab {c x y} { + upvar #0 demo_rulerInfo v + $c addtag active withtag [rulerMkTab $c $x $y] + $c addtag tab withtag active + set v(x) $x + set v(y) $y + rulerMoveTab $c $x $y +} + +proc rulerMoveTab {c x y} { + upvar #0 demo_rulerInfo v + if {[$c find withtag active] == ""} { + return + } + set cx [$c canvasx $x $v(grid)] + set cy [$c canvasy $y] + if {$cx < $v(left)} { + set cx $v(left) + } + if {$cx > $v(right)} { + set cx $v(right) + } + if {($cy >= $v(top)) && ($cy <= $v(bottom))} { + set cy [expr $v(top)+2] + eval "$c itemconf active $v(activeStyle)" + } else { + set cy [expr $cy-$v(size)-2] + eval "$c itemconf active $v(deleteStyle)" + } + $c move active [expr $cx-$v(x)] [expr $cy-$v(y)] + set v(x) $cx + set v(y) $cy +} + +proc demo_selectTab {c x y} { + upvar #0 demo_rulerInfo v + set v(x) [$c canvasx $x $v(grid)] + set v(y) [expr $v(top)+2] + $c addtag active withtag current + eval "$c itemconf active $v(activeStyle)" + $c raise active +} + +proc rulerReleaseTab c { + upvar #0 demo_rulerInfo v + if {[$c find withtag active] == {}} { + return + } + if {$v(y) != [expr $v(top)+2]} { + $c delete active + } else { + eval "$c itemconf active $v(normalStyle)" + $c dtag active + } +} diff --git a/gcl-tk/demos/mkScroll.tcl b/gcl-tk/demos/mkScroll.tcl new file mode 100755 index 0000000..f125db4 --- /dev/null +++ b/gcl-tk/demos/mkScroll.tcl @@ -0,0 +1,84 @@ +# mkScroll w +# +# Create a top-level window containing a simple canvas that can +# be scrolled in two dimensions. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkScroll {{w .cscroll}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Scrollable Canvas Demonstration" + wm iconname $w "Canvas" + wm minsize $w 100 100 + set c $w.frame.c + + message $w.msg -font -Adobe-Times-Medium-R-Normal-*-180-* -aspect 300 \ + -relief raised -bd 2 -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout." + frame $w.frame -relief raised -bd 2 + button $w.ok -text "OK" -command "destroy $w" + pack $w.msg -side top -fill x + pack $w.ok -side bottom -pady 5 + pack $w.frame -side top -expand yes -fill both + + canvas $c -scrollregion {-10c -10c 50c 20c} \ + -xscrollcommand "$w.frame.hscroll set" -yscrollcommand "$w.frame.vscroll set" + scrollbar $w.frame.vscroll -relief sunken -command "$c yview" + scrollbar $w.frame.hscroll -orient horiz -relief sunken -command "$c xview" + pack $w.frame.vscroll -side right -fill y + pack $w.frame.hscroll -side bottom -fill x + pack $c -expand yes -fill both + + set bg [lindex [$c config -bg] 4] + for {set i 0} {$i < 20} {incr i} { + set x [expr {-10 + 3*$i}] + for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} { + $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \ + -outline black -fill $bg -tags rect + $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \ + -anchor center -tags text + } + } + + $c bind all "scrollEnter $c" + $c bind all "scrollLeave $c" + $c bind all <1> "scrollButton $c" + bind $c <2> "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" +} + +proc scrollEnter canvas { + global oldFill + set id [$canvas find withtag current] + if {[lsearch [$canvas gettags current] text] >= 0} { + set id [expr $id-1] + } + set oldFill [lindex [$canvas itemconfig $id -fill] 4] + if {[winfo depth $canvas] > 1} { + $canvas itemconfigure $id -fill SeaGreen1 + } else { + $canvas itemconfigure $id -fill black + $canvas itemconfigure [expr $id+1] -fill white + } +} + +proc scrollLeave canvas { + global oldFill + set id [$canvas find withtag current] + if {[lsearch [$canvas gettags current] text] >= 0} { + set id [expr $id-1] + } + $canvas itemconfigure $id -fill $oldFill + $canvas itemconfigure [expr $id+1] -fill black +} + +proc scrollButton canvas { + global oldFill + set id [$canvas find withtag current] + if {[lsearch [$canvas gettags current] text] < 0} { + set id [expr $id+1] + } + puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]" +} diff --git a/gcl-tk/demos/mkSearch.lisp b/gcl-tk/demos/mkSearch.lisp new file mode 100755 index 0000000..dcb46a7 --- /dev/null +++ b/gcl-tk/demos/mkSearch.lisp @@ -0,0 +1,135 @@ +;;# mkTextSearch w +(in-package "TK") + +;; +;; Create a top-level window containing a text widget that allows you +;; to load a file and highlight all instances of a given string. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(defun mkTextSearch (&optional (w '.search) &aux (textwin (conc w '.t))) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Text Demonstration - Search and Highlight") + (wm :iconname w "Text Search") + + (frame (conc w '.file)) + (label (conc w '.file.label) :text "File name:" :width 13 :anchor "w") + (entry (conc w '.file.entry) :width 40 :relief "sunken" :bd 2 + :textvariable 'fileName) + (button (conc w '.file.button) :text "Load File" + :command `(TextLoadFile ',textwin fileName)) + (pack (conc w '.file.label) (conc w '.file.entry) :side "left") + (pack (conc w '.file.button) :side "left" :pady 5 :padx 10) + (bind (conc w '.file.entry) "" + `(progn + (TextLoadFile ',textwin fileName) + (focus (conc ',w '.string.entry)))) + (frame (conc w '.string)) + (label (conc w '.string.label) :text "Search string:" :width 13 :anchor "w") + (entry (conc w '.string.entry) :width 40 :relief "sunken" :bd 2 + :textvariable 'searchString) + (button (conc w '.string.button) :text "Highlight" + :command `(TextSearch ',textwin searchString "search")) + (pack (conc w '.string.label) (conc w '.string.entry) :side "left") + (pack (conc w '.string.button) :side "left" :pady 5 :padx 10) + (bind (conc w '.string.entry) "" `(TextSearch + ',textwin searchString "search")) + + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (text textwin :relief "raised" :bd 2 :yscrollcommand (tk-conc w ".s set") + :setgrid "true") + (scrollbar (conc w '.s) :relief "flat" :command (tk-conc w ".t yview")) + (pack (conc w '.file) (conc w '.string) :side "top" :fill "x") + (pack (conc w '.ok) :side "bottom" :fill "x") + (pack (conc w '.s) :side "right" :fill "y") + (pack textwin :expand "yes" :fill "both") + + ;; Set up display styles for text highlighting. + (let* (com + (bg (if (> (read-from-string (winfo :depth w)) 1) + "SeaGreen4" "black")) + on + + (fun #'(lambda () + (when (myerrorset + (progn (funcall textwin + :tag + :configure "search" + :background (if on bg "") + :foreground (if on "white" "")) + t)) + (setq on (not on)) + (myerrorset (after 500 com)) + )))) + (setq com (tcl-create-command fun nil nil)) + (setq bil fun) + (funcall fun )) + (funcall textwin :insert 0.0 + " +This window demonstrates how to use the tagging facilities in text +widgets to implement a searching mechanism. First, type a file name +in the top entry, then type or click on \"Load File\". Then +type a string in the lower entry and type or click on +\"Load File\". This will cause all of the instances of the string to +be tagged with the tag \"search\", and it will arrange for the tag's +display attributes to change to make all of the strings blink. +" +) + (funcall textwin :mark :set 'insert 0.0) + (bind w "" (tk-conc "focus " w ".file.entry")) +) +(setq fileName "") +(setq searchString "") + +;; The utility procedure below loads a file into a text widget, +;; discarding the previous contents of the widget. Tags for the +;; old widget are not affected, however. +;; Arguments: +;; +;; w - The window into which to load the file. Must be a +;; text widget. +;; file - The name of the file to load. Must be readable. + +(defun TextLoadFile (w file) + (with-open-file + (st file) + (let ((ar (make-array 3000 :element-type 'string-char :fill-pointer 0)) + (n (file-length st)) + m) + (funcall w :delete "1.0" 'end) + (while (> n 0) + (setq m (min (array-total-size ar) n)) + (setq n (- n m)) + (si::fread ar 0 m st) + (setf (fill-pointer ar) m) + (funcall w :insert 'end ar))))) + + + +;; The utility procedure below searches for all instances of a +;; given string in a text widget and applies a given tag to each +;; instance found. +;; Arguments: +;; +;; w - The window in which to search. Must be a text widget. +;; string - The string to search for. The search is done using +;; exact matching only; no special characters. +;; tag - Tag to apply to each instance of a matching string. + +(defun TextSearch (w string tag) + (funcall w :tag :remove 'search 0.0 'end) + (let ((mark "mine") + (m (length string))) + (funcall w :mark :set "mine" "0.0") + (while (funcall w :compare mark '< 'end :return 'boolean) + (let ((s (funcall w :get mark mark : " + 3000 chars" :return 'string)) + (n 0) tem) + (while (setq tem (search string s :start2 n)) + (funcall w :tag :add 'search + mark : " + " : tem : " chars" + mark : " + " : (setq n (+ tem m)) : " chars")) + (funcall w :mark :set mark mark : " + " : (- 3000 m) : " chars"))))) + diff --git a/gcl-tk/demos/mkSearch.tcl b/gcl-tk/demos/mkSearch.tcl new file mode 100755 index 0000000..fc4772f --- /dev/null +++ b/gcl-tk/demos/mkSearch.tcl @@ -0,0 +1,140 @@ +# mkTextSearch w +# +# Create a top-level window containing a text widget that allows you +# to load a file and highlight all instances of a given string. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkTextSearch {{w .search}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Text Demonstration - Search and Highlight" + wm iconname $w "Text Search" + + frame $w.file + label $w.file.label -text "File name:" -width 13 -anchor w + entry $w.file.entry -width 40 -relief sunken -bd 2 -textvariable fileName + button $w.file.button -text "Load File" \ + -command "TextLoadFile $w.t \$fileName" + pack $w.file.label $w.file.entry -side left + pack $w.file.button -side left -pady 5 -padx 10 + bind $w.file.entry " + TextLoadFile $w.t \$fileName + focus $w.string.entry + " + + frame $w.string + label $w.string.label -text "Search string:" -width 13 -anchor w + entry $w.string.entry -width 40 -relief sunken -bd 2 \ + -textvariable searchString + button $w.string.button -text "Highlight" \ + -command "TextSearch $w.t \$searchString search" + pack $w.string.label $w.string.entry -side left + pack $w.string.button -side left -pady 5 -padx 10 + bind $w.string.entry "TextSearch $w.t \$searchString search" + + button $w.ok -text OK -command "destroy $w" + text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true + scrollbar $w.s -relief flat -command "$w.t yview" + pack $w.file $w.string -side top -fill x + pack $w.ok -side bottom -fill x + pack $w.s -side right -fill y + pack $w.t -expand yes -fill both + + # Set up display styles for text highlighting. + + if {[winfo depth $w] > 1} { + TextToggle "$w.t tag configure search -background \ + SeaGreen4 -foreground white" 800 "$w.t tag configure \ + search -background {} -foreground {}" 200 + } else { + TextToggle "$w.t tag configure search -background \ + black -foreground white" 800 "$w.t tag configure \ + search -background {} -foreground {}" 200 + } + $w.t insert 0.0 {\ +This window demonstrates how to use the tagging facilities in text +widgets to implement a searching mechanism. First, type a file name +in the top entry, then type or click on "Load File". Then +type a string in the lower entry and type or click on +"Load File". This will cause all of the instances of the string to +be tagged with the tag "search", and it will arrange for the tag's +display attributes to change to make all of the strings blink. +} + $w.t mark set insert 0.0 + bind $w "focus $w.file.entry" +} +set fileName "" +set searchString "" + +# The utility procedure below loads a file into a text widget, +# discarding the previous contents of the widget. Tags for the +# old widget are not affected, however. +# Arguments: +# +# w - The window into which to load the file. Must be a +# text widget. +# file - The name of the file to load. Must be readable. + +proc TextLoadFile {w file} { + set f [open $file] + $w delete 1.0 end + while {![eof $f]} { + $w insert end [read $f 10000] + } + close $f +} + +# The utility procedure below searches for all instances of a +# given string in a text widget and applies a given tag to each +# instance found. +# Arguments: +# +# w - The window in which to search. Must be a text widget. +# string - The string to search for. The search is done using +# exact matching only; no special characters. +# tag - Tag to apply to each instance of a matching string. + +proc TextSearch {w string tag} { + $w tag remove search 0.0 end + scan [$w index end] %d numLines + set l [string length $string] + for {set i 1} {$i <= $numLines} {incr i} { + if {[string first $string [$w get $i.0 $i.1000]] == -1} { + continue + } + set line [$w get $i.0 $i.1000] + set offset 0 + while 1 { + set index [string first $string $line] + if {$index < 0} { + break + } + incr offset $index + $w tag add $tag $i.[expr $offset] $i.[expr $offset+$l] + incr offset $l + set line [string range $line [expr $index+$l] 1000] + } + } +} + +# The procedure below is invoked repeatedly to invoke two commands +# at periodic intervals. It normally reschedules itself after each +# execution but if an error occurs (e.g. because the window was +# deleted) then it doesn't reschedule itself. +# Arguments: +# +# cmd1 - Command to execute when procedure is called. +# sleep1 - Ms to sleep after executing cmd1 before executing cmd2. +# cmd2 - Command to execute in the *next* invocation of this +# procedure. +# sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again. + +proc TextToggle {cmd1 sleep1 cmd2 sleep2} { + catch { + eval $cmd1 + after $sleep1 [list TextToggle $cmd2 $sleep2 $cmd1 $sleep1] + } +} diff --git a/gcl-tk/demos/mkStyles.lisp b/gcl-tk/demos/mkStyles.lisp new file mode 100755 index 0000000..6a62bb7 --- /dev/null +++ b/gcl-tk/demos/mkStyles.lisp @@ -0,0 +1,135 @@ +;;# mkStyles w +;; +;; Create a top-level window with a text widget that demonstrates the +;; various display styles that are available in texts. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(in-package "TK") +(defun mkStyles (&optional (w '.styles) &aux (textwin (conc w '.t)) ) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Text Demonstration - Display Styles") + (wm :iconname w "Text Styles") + + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (scrollbar (conc w '.s) :relief "flat" :command (tk-conc w ".t yview")) + (text textwin :relief "raised" :bd 2 :yscrollcommand (tk-conc w ".s set") :setgrid "true" + :width 70 :height 28) + (pack (conc w '.ok) :side "bottom" :fill "x") + (pack (conc w '.s) :side "right" :fill "y") + (pack textwin :expand "yes" :fill "both") + + ;; Set up display styles + + (funcall textwin :tag :configure 'bold :font :Adobe-Courier-Bold-O-Normal-*-120-*) + (funcall textwin :tag :configure 'big :font :Adobe-Courier-Bold-R-Normal-*-140-*) + (funcall textwin :tag :configure 'verybig :font :Adobe-Helvetica-Bold-R-Normal-*-240-*) + (if (> (read-from-string (winfo :depth w)) 1) + (progn + (funcall textwin :tag :configure 'color1 :background "#eed5b7") + (funcall textwin :tag :configure 'color2 :foreground "red") + (funcall textwin :tag :configure 'raised :background "#eed5b7" + :relief "raised" + :borderwidth 1) + (funcall textwin :tag :configure 'sunken :background "#eed5b7" + :relief "sunken" + :borderwidth 1) + ) ;;else + (progn + (funcall textwin :tag :configure 'color1 :background "black" :foreground "white") + (funcall textwin :tag :configure 'color2 :background "black" :foreground "white") + (funcall textwin :tag :configure 'raised :background "white" :relief "raised" + :borderwidth 1) + (funcall textwin :tag :configure 'sunken :background "white" :relief "sunken" + :borderwidth 1) + )) + (funcall textwin :tag :configure 'bgstipple :background "black" :borderwidth 0 + :bgstipple "gray25") + (funcall textwin :tag :configure 'fgstipple :fgstipple "gray50") + (funcall textwin :tag :configure 'underline :underline "on") + + (funcall textwin :insert 0.0 " +Text widgets like this one allow you to display information in a +variety of styles. Display styles are controlled using a mechanism +called " ) + (insertWithTags textwin "tags" 'bold) + (insertWithTags textwin ". Tags are just textual names that you can apply to one +or more ranges of characters within a text widget. You can configure +tags with various display styles. (if :you do this, then the tagged +characters will be displayed with the styles you chose. The +available display styles are: +" +) + (insertWithTags textwin " +1. Font." 'big) + (insertWithTags textwin " You can choose any X font, ") + (insertWithTags textwin "large" "verybig") + (insertWithTags textwin " or ") + (insertWithTags textwin "small. +") + + (insertWithTags textwin " +2. Color." 'big) + (insertWithTags textwin " You can change either the ") + (insertWithTags textwin "background" "color1") + (insertWithTags textwin " or ") + (insertWithTags textwin "foreground" "color2") + (insertWithTags textwin " +color, or ") + (insertWithTags textwin "both" "color1" "color2") + (insertWithTags textwin ". +") + + (insertWithTags textwin " +3. Stippling." 'big) + (insertWithTags textwin " You can cause either the ") + (insertWithTags textwin "background" 'bgstipple) + (insertWithTags textwin " or ") + (insertWithTags textwin "foreground" 'fgstipple) + (insertWithTags textwin " +information to be drawn with a stipple fill instead of a solid fill. +") + (insertWithTags textwin " +4. Underlining." 'big) + (insertWithTags textwin " You can ") + (insertWithTags textwin "underline" "underline") + (insertWithTags textwin " ranges of text. +") + (insertWithTags textwin " +5. 3-D effects." 'big) + (insertWithTags textwin +" You can arrange for the background to be drawn +with a border that makes characters appear either ") + (insertWithTags textwin "raised" "raised") + (insertWithTags textwin " or ") + (insertWithTags textwin "sunken" "sunken") + (insertWithTags textwin ". +") + (insertWithTags textwin " +6. Yet to come." 'big) + (insertWithTags textwin +" More display effects will be coming soon, such +as the ability to change line justification and perhaps line spacing.") + (funcall textwin :mark :set 'insert 0.0) + (bind w "" (tk-conc "focus " w ".t")) +) + +;; The procedure below inserts text into a given text widget and +;; applies one or more tags to that text. The arguments are: +;; +;; w Window in which to insert +;; text Text to insert (it's :inserted at the "insert" mark) +;; args One or more tags to apply to text. (if :this is empty +;; then all tags are removed from the text. + + +(defun insertWithTags (w text &rest args) + (let (( start (funcall w :index 'insert :return 'string))) + (funcall w :insert 'insert text) + (dolist (v (funcall w :tag :names start :return 'list-strings)) + (funcall w :tag :remove v start 'insert)) + (dolist (i args) + (funcall w :tag :add i start 'insert)))) diff --git a/gcl-tk/demos/mkStyles.tcl b/gcl-tk/demos/mkStyles.tcl new file mode 100755 index 0000000..04c08f5 --- /dev/null +++ b/gcl-tk/demos/mkStyles.tcl @@ -0,0 +1,128 @@ +# mkStyles w +# +# Create a top-level window with a text widget that demonstrates the +# various display styles that are available in texts. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkStyles {{w .styles}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Text Demonstration - Display Styles" + wm iconname $w "Text Styles" + + button $w.ok -text OK -command "destroy $w" + text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true \ + -width 70 -height 28 + scrollbar $w.s -relief flat -command "$w.t yview" + pack $w.ok -side bottom -fill x + pack $w.s -side right -fill y + pack $w.t -expand yes -fill both + + # Set up display styles + + $w.t tag configure bold -font -Adobe-Courier-Bold-O-Normal-*-120-* + $w.t tag configure big -font -Adobe-Courier-Bold-R-Normal-*-140-* + $w.t tag configure verybig -font -Adobe-Helvetica-Bold-R-Normal-*-240-* + if {[winfo depth $w] > 1} { + $w.t tag configure color1 -background #eed5b7 + $w.t tag configure color2 -foreground red + $w.t tag configure raised -background #eed5b7 -relief raised \ + -borderwidth 1 + $w.t tag configure sunken -background #eed5b7 -relief sunken \ + -borderwidth 1 + } else { + $w.t tag configure color1 -background black -foreground white + $w.t tag configure color2 -background black -foreground white + $w.t tag configure raised -background white -relief raised \ + -borderwidth 1 + $w.t tag configure sunken -background white -relief sunken \ + -borderwidth 1 + } + $w.t tag configure bgstipple -background black -borderwidth 0 \ + -bgstipple gray25 + $w.t tag configure fgstipple -fgstipple gray50 + $w.t tag configure underline -underline on + + $w.t insert 0.0 {\ +Text widgets like this one allow you to display information in a +variety of styles. Display styles are controlled using a mechanism +called } + insertWithTags $w.t tags bold + insertWithTags $w.t {. Tags are just textual names that you can apply to one +or more ranges of characters within a text widget. You can configure +tags with various display styles. If you do this, then the tagged +characters will be displayed with the styles you chose. The +available display styles are: +} + insertWithTags $w.t { +1. Font.} big + insertWithTags $w.t { You can choose any X font, } + insertWithTags $w.t large verybig + insertWithTags $w.t { or } + insertWithTags $w.t {small. +} + insertWithTags $w.t { +2. Color.} big + insertWithTags $w.t { You can change either the } + insertWithTags $w.t background color1 + insertWithTags $w.t { or } + insertWithTags $w.t foreground color2 + insertWithTags $w.t { +color, or } + insertWithTags $w.t both color1 color2 + insertWithTags $w.t {. +} + insertWithTags $w.t { +3. Stippling.} big + insertWithTags $w.t { You can cause either the } + insertWithTags $w.t background bgstipple + insertWithTags $w.t { or } + insertWithTags $w.t foreground fgstipple + insertWithTags $w.t { +information to be drawn with a stipple fill instead of a solid fill. +} + insertWithTags $w.t { +4. Underlining.} big + insertWithTags $w.t { You can } + insertWithTags $w.t underline underline + insertWithTags $w.t { ranges of text. +} + insertWithTags $w.t { +5. 3-D effects.} big + insertWithTags $w.t { You can arrange for the background to be drawn +with a border that makes characters appear either } + insertWithTags $w.t raised raised + insertWithTags $w.t { or } + insertWithTags $w.t sunken sunken + insertWithTags $w.t {. +} + insertWithTags $w.t { +6. Yet to come.} big + insertWithTags $w.t { More display effects will be coming soon, such +as the ability to change line justification and perhaps line spacing.} + + $w.t mark set insert 0.0 + bind $w "focus $w.t" +} + +# The procedure below inserts text into a given text widget and +# applies one or more tags to that text. The arguments are: +# +# w Window in which to insert +# text Text to insert (it's inserted at the "insert" mark) +# args One or more tags to apply to text. If this is empty +# then all tags are removed from the text. + +proc insertWithTags {w text args} { + set start [$w index insert] + $w insert insert $text + foreach tag [$w tag names $start] { + $w tag remove $tag $start insert + } + foreach i $args { + $w tag add $i $start insert + } +} diff --git a/gcl-tk/demos/mkTear.tcl b/gcl-tk/demos/mkTear.tcl new file mode 100755 index 0000000..5ba01ae --- /dev/null +++ b/gcl-tk/demos/mkTear.tcl @@ -0,0 +1,19 @@ +# mkTear w +# +# Create a top-level window that displays a help message on tear-off +# menus. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkTear {{w .t1}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Information On Tear-Off Menus" + wm iconname $w "Info" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 250 \ + -text "To tear off a menu, press mouse button 2 over the menubutton for the menu, then drag the menu with button 2 held down. You can reposition a torn-off menu by pressing button 2 on it and dragging again. To unpost the menu, click mouse button 1 over the menu's menubutton. Click the \"OK\" button when you're finished with this window." + button $w.ok -text OK -command "destroy $w" + pack $w.msg $w.ok -pady 5 +} diff --git a/gcl-tk/demos/mkTextBind.lisp b/gcl-tk/demos/mkTextBind.lisp new file mode 100755 index 0000000..19d7cf7 --- /dev/null +++ b/gcl-tk/demos/mkTextBind.lisp @@ -0,0 +1,108 @@ +;;# mkTextBind w +;; +;; Create a top-level window that illustrates how you can bind +;; Tcl commands to regions of text in a text widget. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(in-package "TK") +(defun mkTextBind (&optional (w '.bindings) &aux bold normal + (textwin (conc w '.t ) )) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (dpos w) + (wm :title w "Text Demonstration - Tag Bindings") + (wm :iconname w "Text Bindings") + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (scrollbar (conc w '.s) :relief "flat" :command (tk-conc w ".t yview")) + (text textwin :relief "raised" :bd 2 :yscrollcommand + (tk-conc w ".s set") :setgrid "true" + :width 60 :height 28 + :font "-Adobe-Helvetica-Bold-R-Normal-*-120-*") + + (pack (conc w '.ok) :side "bottom" :fill "x") + (pack (conc w '.s) :side "right" :fill "y") + (pack textwin :expand "yes" :fill "both") + + ;; Set up display styles + + (if (> (read-from-string (winfo :depth w)) 1) + (progn + (setq bold '(:foreground "red")) + (setq normal '(:foreground "")) + );;else + (progn + (setq bold '(:foreground "white" :background "black")) + (setq normal '(:foreground "" :background "")) + )) + (funcall textwin :insert 0.0 +"The same tag mechanism that controls display styles in text +widgets can also be used to associate Tcl commands with regions +of text, so that mouse or keyboard actions on the text cause +particular Tcl commands to be invoked. For example, in the +text below the descriptions of the canvas demonstrations have +been tagged. When you move the mouse over a demo description +the description lights up, and when you press button 3 over a +description then that particular demonstration is invoked. + +This demo package contains a number of demonstrations of Tk's +canvas widgets. Here are brief descriptions of some of the +demonstrations that are available: +" +) + (let ((blank-lines (format nil "~2%"))) + (insertWithTags textwin +"1. Samples of all the different types of items that can be +created in canvas widgets." "d1") + (insertWithTags textwin blank-lines) + (insertWithTags textwin +"2. A simple two-dimensional plot that allows you to adjust +the :positions of the data points." "d2") + (insertWithTags textwin blank-lines) + (insertWithTags textwin +"3. Anchoring and justification modes for text items." "d3") + (insertWithTags textwin blank-lines) + (insertWithTags textwin +"4. An editor for arrow-head shapes for line items." "d4") + (insertWithTags textwin blank-lines) + (insertWithTags textwin +"5. A ruler with facilities for editing tab stops." "d5") + (insertWithTags textwin blank-lines) + (insertWithTags textwin +"6. A grid that demonstrates how canvases can be scrolled." "d6")) + + (dolist (tag '("d1" "d2" "d3" "d4" "d5" "d6")) + (funcall textwin :tag :bind tag "" + `(,textwin :tag :configure ,tag ,@bold)) + (funcall textwin :tag :bind tag "" + `(,textwin :tag :configure ,tag ,@normal)) + ) + (funcall textwin :tag :bind "d1" "<3>" 'mkItems) + (funcall textwin :tag :bind "d2" "<3>" 'mkPlot) + (funcall textwin :tag :bind "d3" "<3>" "mkCanvText") + (funcall textwin :tag :bind "d4" "<3>" "mkArrow") + (funcall textwin :tag :bind "d5" "<3>" 'mkRuler) + (funcall textwin :tag :bind "d6" "<3>" "mkScroll") + + (funcall textwin :mark 'set 'insert 0.0) + (bind w "" (tk-conc "focus " w ".t")) +) + +;; The procedure below inserts text into a given text widget and +;; applies one or more tags to that text. The arguments are: +;; +;; w Window in which to insert +;; text Text to insert (it's :inserted at the "insert" mark) +;; args One or more tags to apply to text. (if :this is empty +;; then all tags are removed from the text. + +(defun insertWithTags (w text &rest args) + (let (( start (funcall w :index 'insert :return 'string))) + (funcall w :insert 'insert text) + (dolist (v (funcall w :tag "names" start :return 'list-strings)) + (funcall w :tag 'remove v start "insert")) + (dolist (i args) + (funcall w :tag 'add i start 'insert)))) + + diff --git a/gcl-tk/demos/mkTextBind.tcl b/gcl-tk/demos/mkTextBind.tcl new file mode 100755 index 0000000..368d768 --- /dev/null +++ b/gcl-tk/demos/mkTextBind.tcl @@ -0,0 +1,100 @@ +# mkTextBind w +# +# Create a top-level window that illustrates how you can bind +# Tcl commands to regions of text in a text widget. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkTextBind {{w .bindings}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Text Demonstration - Tag Bindings" + wm iconname $w "Text Bindings" + button $w.ok -text OK -command "destroy $w" + text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true \ + -width 60 -height 28 \ + -font "-Adobe-Helvetica-Bold-R-Normal-*-120-*" + scrollbar $w.s -relief flat -command "$w.t yview" + pack $w.ok -side bottom -fill x + pack $w.s -side right -fill y + pack $w.t -expand yes -fill both + + # Set up display styles + + if {[winfo depth $w] > 1} { + set bold "-foreground red" + set normal "-foreground {}" + } else { + set bold "-foreground white -background black" + set normal "-foreground {} -background {}" + } + $w.t insert 0.0 {\ +The same tag mechanism that controls display styles in text +widgets can also be used to associate Tcl commands with regions +of text, so that mouse or keyboard actions on the text cause +particular Tcl commands to be invoked. For example, in the +text below the descriptions of the canvas demonstrations have +been tagged. When you move the mouse over a demo description +the description lights up, and when you press button 3 over a +description then that particular demonstration is invoked. + +This demo package contains a number of demonstrations of Tk's +canvas widgets. Here are brief descriptions of some of the +demonstrations that are available: + +} + insertWithTags $w.t \ +{1. Samples of all the different types of items that can be +created in canvas widgets.} d1 + insertWithTags $w.t \n\n + insertWithTags $w.t \ +{2. A simple two-dimensional plot that allows you to adjust +the positions of the data points.} d2 + insertWithTags $w.t \n\n + insertWithTags $w.t \ +{3. Anchoring and justification modes for text items.} d3 + insertWithTags $w.t \n\n + insertWithTags $w.t \ +{4. An editor for arrow-head shapes for line items.} d4 + insertWithTags $w.t \n\n + insertWithTags $w.t \ +{5. A ruler with facilities for editing tab stops.} d5 + insertWithTags $w.t \n\n + insertWithTags $w.t \ +{6. A grid that demonstrates how canvases can be scrolled.} d6 + + foreach tag {d1 d2 d3 d4 d5 d6} { + $w.t tag bind $tag "$w.t tag configure $tag $bold" + $w.t tag bind $tag "$w.t tag configure $tag $normal" + } + $w.t tag bind d1 <3> mkItems + $w.t tag bind d2 <3> mkPlot + $w.t tag bind d3 <3> mkCanvText + $w.t tag bind d4 <3> mkArrow + $w.t tag bind d5 <3> mkRuler + $w.t tag bind d6 <3> mkScroll + + $w.t mark set insert 0.0 + bind $w "focus $w.t" +} + +# The procedure below inserts text into a given text widget and +# applies one or more tags to that text. The arguments are: +# +# w Window in which to insert +# text Text to insert (it's inserted at the "insert" mark) +# args One or more tags to apply to text. If this is empty +# then all tags are removed from the text. + +proc insertWithTags {w text args} { + set start [$w index insert] + $w insert insert $text + foreach tag [$w tag names $start] { + $w tag remove $tag $start insert + } + foreach i $args { + $w tag add $i $start insert + } +} diff --git a/gcl-tk/demos/mkVScale.lisp b/gcl-tk/demos/mkVScale.lisp new file mode 100755 index 0000000..e47d031 --- /dev/null +++ b/gcl-tk/demos/mkVScale.lisp @@ -0,0 +1,40 @@ +(in-package "TK") +;;# mkVScale w +;; +;; Create a top-level window that displays a vertical scale. +;; +;; Arguments: +;; w - Name to use for new top-level window. + +(defun mkVScale (&optional (w '.vscale )) +; (catch {destroy w}) + (toplevel w) + (dpos w) + (wm :title w "Vertical Scale Demonstration") + (wm :iconname w "Scale") + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 + :text "A bar and a vertical scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the height of the bar. Click the OK button when you're finished.") + (frame (conc w '.frame) :borderwidth 10) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.msg) (conc w '.frame) (conc w '.ok)) + + (scale (conc w '.frame.scale) :orient "vertical" :length 280 :from 0 :to 250 + :command #'(lambda (height) + ; (print height) + (setHeight (conc w '.frame.right.inner) height)) + :tickinterval 50 + :bg "Bisque1") + (frame (conc w '.frame.right) :borderwidth 15) + (frame (conc w '.frame.right.inner) :width 40 :height 20 :relief "raised" + :borderwidth 2 :bg "SteelBlue1") + (pack (conc w '.frame.scale) :side "left" :anchor "ne") + (pack (conc w '.frame.right) :side "left" :anchor "nw") + (funcall (conc w '.frame.scale) :set 20) + + + (pack (conc w '.frame.right.inner) :expand "yes" :anchor "nw") +) + +(defun setHeight (w height) + (funcall w :config :width 40 :height height) +) diff --git a/gcl-tk/demos/mkVScale.tcl b/gcl-tk/demos/mkVScale.tcl new file mode 100755 index 0000000..1889a9b --- /dev/null +++ b/gcl-tk/demos/mkVScale.tcl @@ -0,0 +1,35 @@ +# mkVScale w +# +# Create a top-level window that displays a vertical scale. +# +# Arguments: +# w - Name to use for new top-level window. + +proc mkVScale {{w .scale1}} { + catch {destroy $w} + toplevel $w + dpos $w + wm title $w "Vertical Scale Demonstration" + wm iconname $w "Scale" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \ + -text "A bar and a vertical scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the height of the bar. Click the \"OK\" button when you're finished." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg $w.frame $w.ok + + scale $w.frame.scale -orient vertical -length 280 -from 0 -to 250 \ + -command "setHeight $w.frame.right.inner" -tickinterval 50 \ + -bg Bisque1 + frame $w.frame.right -borderwidth 15 + pack $w.frame.scale -side left -anchor ne + pack $w.frame.right -side left -anchor nw + $w.frame.scale set 20 + + frame $w.frame.right.inner -width 40 -height 20 -relief raised \ + -borderwidth 2 -bg SteelBlue1 + pack $w.frame.right.inner -expand yes -anchor nw +} + +proc setHeight {w height} { + $w config -height $height +} diff --git a/gcl-tk/demos/mkdialog.lisp b/gcl-tk/demos/mkdialog.lisp new file mode 100755 index 0000000..5fd6284 --- /dev/null +++ b/gcl-tk/demos/mkdialog.lisp @@ -0,0 +1,64 @@ +;;# mkDialog w msgArgs list list '... +(in-package "TK") +;; +;; Create a dialog box with a message and any number of buttons at +;; the bottom. +;; +;; Arguments: +;; w - Name to use for new top-level window. +;; msgArgs - List of arguments to use when creating the message of the +;; dialog box (e.g. :text, justifcation, etc.) +;; list - A two-element list that describes one of the buttons that +;; will appear at the bottom of the dialog. The first element +;; gives the text to be displayed in the button and the second +;; gives the command to be invoked when the button is invoked. + +(defun mkDialog (w msgArgs &rest args) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w :class "Dialog") + (wm :title w "Dialog box") + (wm :iconname w "Dialog") + + ;; Create two frames in the main window. The top frame will hold the + ;; message and the bottom one will hold the buttons. Arrange them + ;; one above the other, with any extra vertical space split between + ;; them. + + (frame (conc w '.top) :relief "raised" :border 1) + (frame (conc w '.bot) :relief "raised" :border 1) + (pack (conc w '.top) (conc w '.bot) :side "top" :fill "both" :expand "yes") + + ;; Create the message widget and arrange for it to be centered in the + ;; top frame. + + (apply 'message (conc w '.top.msg) :justify "center" + :font :Adobe-times-medium-r-normal--*-180* msgArgs) + (pack (conc w '.top.msg) :side "top" :expand "yes" :padx 3 :pady 3) + + ;; Create as many buttons as needed and arrange them from left to right + ;; in the bottom frame. Embed the left button in an additional sunken + ;; frame to indicate that it is the default button, and arrange for that + ;; button to be invoked as the default action for clicks and returns in + ;; the dialog. + + (if (> (length args) 0) + (let ((i 1) arg) + (setq arg (nth 0 args)) + (frame (conc w '.bot.0) :relief "sunken" :border 1) + (pack (conc w '.bot.0) :side "left" :expand "yes" :padx 10 :pady 10) + (button (conc w '.bot.0.button) :text (nth 0 arg) + :command `(progn ,(nth 1 arg)(destroy ',w))) + (pack (conc w '.bot.0.button) :expand "yes" :padx 6 :pady 6) + (bind w "" `(progn ,(nth 1 arg)(destroy ',w))) + (focus w) + (dolist (arg (cdr args)) + (setq i (+ i 1)) + (button (conc w '.bot. i) :text (nth 0 arg) + :command `(progn ,(nth 1 arg)(destroy ',w))) + (pack (conc w '.bot. i) :side "left" :expand "yes" :padx 10) + + ) + )) + (bind w "" `(focus ',w)) + (focus w) +) diff --git a/gcl-tk/demos/nqthm-stack.lisp b/gcl-tk/demos/nqthm-stack.lisp new file mode 100755 index 0000000..436eceb --- /dev/null +++ b/gcl-tk/demos/nqthm-stack.lisp @@ -0,0 +1,61 @@ +(in-package "TK") +;; turn on history; +;(MAINTAIN-REWRITE-PATH t) + + +(defun nqthm-stack (&optional (w '.nqthm)) + (toplevel w) + (dpos w) + (wm :title w "Nqthm Stack Frames") + (wm :iconname w "Nqthm Stack") + (wm :minsize w 1 1) + (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 + :text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. Click the OK button when you've seen enough.") + (frame (conc w '.frame) :borderwidth 10) + (button (conc w '.ok) :text "OK" :command `(destroy ',w)) + (button (conc w '.redo) :text "Show Frames" :command + `(show-frames)) + (checkbutton (conc w '.rew) :text "Maintain Frames" + :variable '(boolean user::do-frames) + :command '(user::MAINTAIN-REWRITE-PATH user::do-frames)) + (pack (conc w '.frame) :side "top" :expand "yes" :fill "y") + (pack (conc w '.rew)(conc w '.redo) (conc w '.ok) :side "bottom" :fill "x") + (scrollbar (conc w '.frame '.scroll) :relief "sunken" + :command + (tk-conc w ".frame.list yview")) + (listbox (conc w '.frame.list) :yscroll (tk-conc w ".frame.scroll set") + :relief "sunken" + :setgrid 1) + (pack (conc w '.frame.scroll) :side "right" :fill "y") + (pack (conc w '.frame.list) :side "left" :expand "yes" :fill "both") + (setq *list-box* (conc w '.frame.list))) + +(in-package "USER") + +(defun tk::show-frames() + (funcall tk::*list-box* :delete 0 "end") + (apply tk::*list-box* :insert 0 + (sloop::sloop for i below user::REWRITE-PATH-STK-PTR + do (setq tem (aref user::REWRITE-PATH-STK i)) + (setq tem + (display-rewrite-path-token + (nth 0 tem) + (nth 3 tem))) + (cond ((consp tem) (setq tem (format nil "~a" tem)))) + collect tem))) + + + +(defun display-rewrite-path-token (prog term) + (case prog + (ADD-EQUATIONS-TO-POT-LST + (access linear-lemma name term)) + (REWRITE-WITH-LEMMAS + (access rewrite-rule name term)) + ((REWRITE REWRITE-WITH-LINEAR) + (ffn-symb term)) + ((SET-SIMPLIFY-CLAUSE-POT-LST SIMPLIFY-CLAUSE) + "clause") + (t (er hard (prog term) + |Unexpected| |prog| |in| |call| |of| display-rewrite-path-token + |on| (!ppr prog nil) |and| (!ppr term (quote |.|)))))) \ No newline at end of file diff --git a/gcl-tk/demos/showVars.lisp b/gcl-tk/demos/showVars.lisp new file mode 100755 index 0000000..d3f84a7 --- /dev/null +++ b/gcl-tk/demos/showVars.lisp @@ -0,0 +1,28 @@ +(in-package "TK") +;;# showVars w var var var '... +;; +;; Create a top-level window that displays a bunch of global variable values +;; and keeps the display up-to-date even when the variables change value +;; +;; Arguments: +;; w - Name to use for new top-level window. +;; var - Name of variable to monitor. + +(defun showVars (w args) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (wm :title w "Variable values") + (label (conc w '.title) :text "Variable values:" :width 20 :anchor "center" + :font :Adobe-helvetica-medium-r-normal--*-180*) + (pack (conc w '.title) :side "top" :fill "x") + (dolist (i args) + (frame (conc w '|.| i)) + (label (conc w '|.| i '.name) :text (tk-conc i ": ")) + (label (conc w '|.| i '.value) :textvariable + (list (or (get i 'text-variable-type) t) i)) + (pack (conc w '|.| i '.name) (conc w '|.| i '.value) :side "left") + (pack (conc w '|.| i) :side "top" :anchor "w") + ) + (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w)) + (pack (conc w '.ok) :side "bottom" :pady 2) +) diff --git a/gcl-tk/demos/showVars.tcl b/gcl-tk/demos/showVars.tcl new file mode 100755 index 0000000..69b4f92 --- /dev/null +++ b/gcl-tk/demos/showVars.tcl @@ -0,0 +1,26 @@ +# showVars w var var var ... +# +# Create a top-level window that displays a bunch of global variable values +# and keeps the display up-to-date even when the variables change value +# +# Arguments: +# w - Name to use for new top-level window. +# var - Name of variable to monitor. + +proc showVars {w args} { + catch {destroy $w} + toplevel $w + wm title $w "Variable values" + label $w.title -text "Variable values:" -width 20 -anchor center \ + -font -Adobe-helvetica-medium-r-normal--*-180* + pack $w.title -side top -fill x + foreach i $args { + frame $w.$i + label $w.$i.name -text "$i: " + label $w.$i.value -textvar $i + pack $w.$i.name $w.$i.value -side left + pack $w.$i -side top -anchor w + } + button $w.ok -text OK -command "destroy $w" + pack $w.ok -side bottom -pady 2 +} diff --git a/gcl-tk/demos/tclIndex b/gcl-tk/demos/tclIndex new file mode 100755 index 0000000..c90e20a --- /dev/null +++ b/gcl-tk/demos/tclIndex @@ -0,0 +1,83 @@ +# Tcl autoload index file, version 2.0 +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# element name is the name of a command and the value is +# a script that loads the command. + +set auto_index(mkCheck) [list source [file join $dir mkCheck.tcl]] +set auto_index(mkListbox2) [list source [file join $dir mkListbox2.tcl]] +set auto_index(mkLabel) [list source [file join $dir mkLabel.tcl]] +set auto_index(mkListbox3) [list source [file join $dir mkListbox3.tcl]] +set auto_index(mkPuzzle) [list source [file join $dir mkPuzzle.tcl]] +set auto_index(puzzle.switch) [list source [file join $dir mkPuzzle.tcl]] +set auto_index(mkArrow) [list source [file join $dir mkArrow.tcl]] +set auto_index(arrowSetup) [list source [file join $dir mkArrow.tcl]] +set auto_index(arrowMove1) [list source [file join $dir mkArrow.tcl]] +set auto_index(arrowMove2) [list source [file join $dir mkArrow.tcl]] +set auto_index(arrowMove3) [list source [file join $dir mkArrow.tcl]] +set auto_index(mkBasic) [list source [file join $dir mkBasic.tcl]] +set auto_index(mkBitmaps) [list source [file join $dir mkBitmaps.tcl]] +set auto_index(bitmapRow) [list source [file join $dir mkBitmaps.tcl]] +set auto_index(mkButton) [list source [file join $dir mkButton.tcl]] +set auto_index(mkCanvText) [list source [file join $dir mkCanvText.tcl]] +set auto_index(mkTextConfig) [list source [file join $dir mkCanvText.tcl]] +set auto_index(textEnter) [list source [file join $dir mkCanvText.tcl]] +set auto_index(textB1Press) [list source [file join $dir mkCanvText.tcl]] +set auto_index(textB1Move) [list source [file join $dir mkCanvText.tcl]] +set auto_index(textBs) [list source [file join $dir mkCanvText.tcl]] +set auto_index(mkDialog) [list source [file join $dir mkDialog.tcl]] +set auto_index(mkEntry) [list source [file join $dir mkEntry.tcl]] +set auto_index(mkEntry2) [list source [file join $dir mkEntry2.tcl]] +set auto_index(mkFloor) [list source [file join $dir mkFloor.tcl]] +set auto_index(floorDisplay) [list source [file join $dir mkFloor.tcl]] +set auto_index(roomChanged) [list source [file join $dir mkFloor.tcl]] +set auto_index(bg1) [list source [file join $dir mkFloor.tcl]] +set auto_index(bg2) [list source [file join $dir mkFloor.tcl]] +set auto_index(bg3) [list source [file join $dir mkFloor.tcl]] +set auto_index(fg1) [list source [file join $dir mkFloor.tcl]] +set auto_index(fg2) [list source [file join $dir mkFloor.tcl]] +set auto_index(fg3) [list source [file join $dir mkFloor.tcl]] +set auto_index(mkForm) [list source [file join $dir mkForm.tcl]] +set auto_index(Tab) [list source [file join $dir mkForm.tcl]] +set auto_index(mkHScale) [list source [file join $dir mkHScale.tcl]] +set auto_index(setWidth) [list source [file join $dir mkHScale.tcl]] +set auto_index(mkIcon) [list source [file join $dir mkIcon.tcl]] +set auto_index(iconCmd) [list source [file join $dir mkIcon.tcl]] +set auto_index(mkItems) [list source [file join $dir mkItems.tcl]] +set auto_index(itemEnter) [list source [file join $dir mkItems.tcl]] +set auto_index(itemLeave) [list source [file join $dir mkItems.tcl]] +set auto_index(itemMark) [list source [file join $dir mkItems.tcl]] +set auto_index(itemStroke) [list source [file join $dir mkItems.tcl]] +set auto_index(itemsUnderArea) [list source [file join $dir mkItems.tcl]] +set auto_index(itemStartDrag) [list source [file join $dir mkItems.tcl]] +set auto_index(itemDrag) [list source [file join $dir mkItems.tcl]] +set auto_index(butPress) [list source [file join $dir mkItems.tcl]] +set auto_index(mkListbox) [list source [file join $dir mkListbox.tcl]] +set auto_index(mkPlot) [list source [file join $dir mkPlot.tcl]] +set auto_index(plotDown) [list source [file join $dir mkPlot.tcl]] +set auto_index(plotMove) [list source [file join $dir mkPlot.tcl]] +set auto_index(mkRadio) [list source [file join $dir mkRadio.tcl]] +set auto_index(mkRuler) [list source [file join $dir mkRuler.tcl]] +set auto_index(rulerMkTab) [list source [file join $dir mkRuler.tcl]] +set auto_index(rulerNewTab) [list source [file join $dir mkRuler.tcl]] +set auto_index(rulerMoveTab) [list source [file join $dir mkRuler.tcl]] +set auto_index(demo_selectTab) [list source [file join $dir mkRuler.tcl]] +set auto_index(rulerReleaseTab) [list source [file join $dir mkRuler.tcl]] +set auto_index(mkScroll) [list source [file join $dir mkScroll.tcl]] +set auto_index(scrollEnter) [list source [file join $dir mkScroll.tcl]] +set auto_index(scrollLeave) [list source [file join $dir mkScroll.tcl]] +set auto_index(scrollButton) [list source [file join $dir mkScroll.tcl]] +set auto_index(mkTextSearch) [list source [file join $dir mkSearch.tcl]] +set auto_index(TextLoadFile) [list source [file join $dir mkSearch.tcl]] +set auto_index(TextSearch) [list source [file join $dir mkSearch.tcl]] +set auto_index(TextToggle) [list source [file join $dir mkSearch.tcl]] +set auto_index(mkStyles) [list source [file join $dir mkStyles.tcl]] +set auto_index(insertWithTags) [list source [file join $dir mkStyles.tcl]] +set auto_index(mkTear) [list source [file join $dir mkTear.tcl]] +set auto_index(mkTextBind) [list source [file join $dir mkTextBind.tcl]] +set auto_index(insertWithTags) [list source [file join $dir mkTextBind.tcl]] +set auto_index(mkVScale) [list source [file join $dir mkVScale.tcl]] +set auto_index(setHeight) [list source [file join $dir mkVScale.tcl]] +set auto_index(showVars) [list source [file join $dir showVars.tcl]] diff --git a/gcl-tk/demos/widget.lisp b/gcl-tk/demos/widget.lisp new file mode 100755 index 0000000..a785686 --- /dev/null +++ b/gcl-tk/demos/widget.lisp @@ -0,0 +1,220 @@ + +(in-package "TK") +;; +;; This "script" demonstrates the various widgets provided by Tk, +;; along with many of the features of the Tk toolkit. This file +;; only contains code to generate the main window for the +;; application, which invokes individual demonstrations. The +;; code for the actual demonstrations is contained in separate +;; ".tcl" files is this directory, which are auto-loaded by Tcl +;; when they are needed. To find the code for a particular +;; demo, look below for the procedure that's invoked by its menu +;; entry, then grep for the file that contains the procedure +;; definition. + +(tk-do (concatenate 'string + "set auto_path \"" *tk-library* "/demos " "$auto_path\"")) + +;; add teh current path to the auto_path so that we find the +;; .tcl demos for older demos not in new releases.. +(tk-do (concatenate 'string + "lappend auto_path [file dirname " (namestring (truename si::*load-pathname*)) "]")) + + +;(setq si::*load-path* (cons (tk-conc si::*lib-directory* "gcl-tk/demos/") si::*load-path*)) +(load (merge-pathnames "index.lsp" si::*load-pathname*)) + +(wm :title '|.| "Widget Demonstration") + +;;------------------------------------------------------- +;; The code below create the main window, consisting of a +;; menu bar and a message explaining the basic operation +;; of the program. +;;------------------------------------------------------- + +(frame '.menu :relief "raised" :borderwidth 1) +(message '.msg :font :Adobe-times-medium-r-normal--*-180* :relief "raised" :width 500 +:borderwidth 1 :text "This application demonstrates the widgets provided by the GCL Tk toolkit. The menus above are organized by widget type: each menu contains one or more demonstrations of a particular type of widget. To invoke a demonstration, press mouse button 1 over one of the menu buttons above, drag the mouse to the desired entry in the menu, then release the mouse button.) +(To exit this demonstration, invoke the \"Quit\" entry in the \"Misc\" menu.") + +(pack '.menu :side "top" :fill "x") +(pack '.msg :side "bottom" :expand "yes" :fill "both") + +;;------------------------------------------------------- +;; The code below creates all the menus, which invoke procedures +;; to create particular demonstrations of various widgets. +;;------------------------------------------------------- + +(menubutton '.menu.button :text "Labels/Buttons" :menu '.menu.button.m + :underline 7) +(menu '.menu.button.m) +(.menu.button.m :add 'command :label "Labels" :command "mkLabel" :underline 0) +(.menu.button.m :add 'command :label "Buttons" :command "mkButton" :underline 0) +(.menu.button.m :add 'command :label "Checkbuttons" :command "mkCheck" + :underline 0) +(.menu.button.m :add 'command :label "Radiobuttons" :command 'mkRadio + :underline 0) +(.menu.button.m :add 'command :label "15-puzzle" :command "mkPuzzle" :underline 0) +(.menu.button.m :add 'command :label "Iconic buttons" :command "mkIcon" + :underline 0) + +(menubutton '.menu.listbox :text "Listboxes" :menu '.menu.listbox.m + :underline 0) +(menu '.menu.listbox.m) +(.menu.listbox.m :add 'command :label "States" :command 'mkListbox :underline 0) +(.menu.listbox.m :add 'command :label "Colors" :command "mkListbox2" :underline 0) +(.menu.listbox.m :add 'command :label "Well-known sayings" :command "mkListbox3" + :underline 0) + +(menubutton '.menu.entry :text "Entries" :menu '.menu.entry.m + :underline 0) +(menu '.menu.entry.m) +(.menu.entry.m :add 'command :label "Without scrollbars" :command 'mkentry + :underline 4) +(.menu.entry.m :add 'command :label "With scrollbars" :command 'mkEntry2 + :underline 0) +(.menu.entry.m :add 'command :label "Simple form" :command 'mkForm + :underline 0) + +(menubutton '.menu.text :text "Text" :menu '.menu.text.m :underline 0) +(menu '.menu.text.m) +(.menu.text.m :add 'command :label "Basic text" :command 'mkBasic + :underline 0) +(.menu.text.m :add 'command :label "Display styles" :command 'mkStyles + :underline 0) +(.menu.text.m :add 'command :label "Command bindings" :command 'mkTextBind + :underline 0) +(.menu.text.m :add 'command :label "Search" :command "mkTextSearch" + :underline 0) + +(menubutton '.menu.scroll :text "Scrollbars" :menu '.menu.scroll.m + :underline 0) +(menu '.menu.scroll.m) +(.menu.scroll.m :add 'command :label "Vertical" :command "mkListbox2" :underline 0) +(.menu.scroll.m :add 'command :label "Horizontal" :command "mkEntry2" :underline 0) + +(menubutton '.menu.scale :text "Scales" :menu '.menu.scale.m :underline 2) +(menu '.menu.scale.m) +(.menu.scale.m :add 'command :label "Vertical" :command 'mkVScale :underline 0) +(.menu.scale.m :add 'command :label "Horizontal" :command 'mkHScale :underline 0) + +(menubutton '.menu.canvas :text "Canvases" :menu '.menu.canvas.m + :underline 0) +(menu '.menu.canvas.m) +(.menu.canvas.m :add 'command :label "Item types" :command 'mkItems :underline 0) +(.menu.canvas.m :add 'command :label "2-D plot" :command 'mkPlot :underline 0) +(.menu.canvas.m :add 'command :label "Text" :command "mkCanvText" :underline 0) +(.menu.canvas.m :add 'command :label "Arrow shapes" :command "mkArrow" :underline 0) +(.menu.canvas.m :add 'command :label "Ruler" :command 'mkRuler :underline 0) +(.menu.canvas.m :add 'command :label "Scrollable canvas" :command "mkScroll" + :underline 0) +(.menu.canvas.m :add 'command :label "Floor plan" :command "mkFloor" + :underline 0) + +(menubutton '.menu.menu :text "Menus" :menu '.menu.menu.m :underline 0) +(menu '.menu.menu.m) +(.menu.menu.m :add 'command :label "Print hello" :command '(print "Hello") + :accelerator "Control+a" :underline 6) +(bind '|.| "" '(print "Hello")) +(.menu.menu.m :add 'command :label "Print goodbye" :command + '(print "Goodbye") :accelerator "Control+b" :underline 6) +(bind '|.| "" '(format t "Goodbye")) +(.menu.menu.m :add 'command :label "Light blue background" + :command '(.msg :configure :bg "LightBlue1") :underline 0) +(.menu.menu.m :add 'command :label "Info on tear-off menus" :command "mkTear" + :underline 0) +(.menu.menu.m :add 'cascade :label "Check buttons" :menu '.menu.menu.m.check + :underline 0) +(.menu.menu.m :add 'cascade :label "Radio buttons" :menu '.menu.menu.m.radio + :underline 0) +(.menu.menu.m :add 'command :bitmap "@": *tk-library* :"/demos/bitmaps/pattern" + :command ' + (mkDialog '.pattern '(:text "The menu entry you invoked displays a bitmap rather than a text string. Other than this, it is just like any other menu entry." :aspect 250 ))) + + +(menu '.menu.menu.m.check) +(.menu.menu.m.check :add 'check :label "Oil checked" :variable 'oil) +(.menu.menu.m.check :add 'check :label "Transmission checked" :variable 'trans) +(.menu.menu.m.check :add 'check :label "Brakes checked" :variable 'brakes) +(.menu.menu.m.check :add 'check :label "Lights checked" :variable 'lights) +(.menu.menu.m.check :add 'separator) +(.menu.menu.m.check :add 'command :label "Show current values" + :command '(showVars '.menu.menu.dialog '(oil trans brakes lights))) +(.menu.menu.m.check :invoke 1) +(.menu.menu.m.check :invoke 3) + +(menu '.menu.menu.m.radio) +(.menu.menu.m.radio :add 'radio :label "10 point" :variable 'pointSize :value 10) +(.menu.menu.m.radio :add 'radio :label "14 point" :variable 'pointSize :value 14) +(.menu.menu.m.radio :add 'radio :label "18 point" :variable 'pointSize :value 18) +(.menu.menu.m.radio :add 'radio :label "24 point" :variable 'pointSize :value 24) +(.menu.menu.m.radio :add 'radio :label "32 point" :variable 'pointSize :value 32) +(.menu.menu.m.radio :add 'sep) +(.menu.menu.m.radio :add 'radio :label "Roman" :variable 'style :value "roman") +(.menu.menu.m.radio :add 'radio :label "Bold" :variable 'style :value "bold") +(.menu.menu.m.radio :add 'radio :label "Italic" :variable 'style :value "italic") +(.menu.menu.m.radio :add 'sep) +(.menu.menu.m.radio :add 'command :label "Show current values" :command + '(showVars '.menu.menu.dialog '(pointSize style))) +(.menu.menu.m.radio :invoke 1) +(.menu.menu.m.radio :invoke 7) + +(menubutton '.menu.misc :text "Misc" :menu '.menu.misc.m :underline 1) +(menu '.menu.misc.m) +(.menu.misc.m :add 'command :label "Modal dialog (local grab)" :command ' + (progn + (mkDialog '.modal '(:text "This dialog box is a modal one. It uses Tk's \"grab\" command to create a \"local grab\" on the dialog box. The grab prevents any pointer related events from getting to any other windows in the application. If you press the \"OK\" button below (or hit the Return key) then the dialog box will go away and things will return to normal." :aspect 250 :justify "left") '("OK" nil) '("Hi" (print "hi"))) + (wm :geometry '.modal "+10+10") + (tk-wait-til-exists '.modal) + ; (tkwait :visibility '.modal) + (grab '.modal) + (tkwait :window '.modal) + ) + :underline 0) +(.menu.misc.m + :add 'command :label "Modal dialog (global grab)" + :command + '(progn + (mkDialog '.modal '(:text "This is another modal dialog box. However, in this case a \"global grab\" is used, which locks up the display so you can't talk to any windows in any applications anywhere, except for the dialog. If you press the \"OK\" button below (or hit the Return key) then the dialog box will go away and things will return to normal." :aspect 250 :justify "left") '("OK" nil) '("Hi" (print "hi1"))) + + (wm :geometry '.modal "+10+10") + (tk-wait-til-exists '.modal) + ;(tkwait :visibility '.modal) + (grab :set :global '.modal) + (tkwait :window '.modal) + ) + :underline 0) +(.menu.misc.m :add 'command :label "Built-in bitmaps" :command "mkBitmaps" + :underline 0) +(.menu.misc.m :add 'command :label "GC monitor" + :command 'mkgcmonitor :underline 0) +(.menu.misc.m :add 'command :label "Quit" :command "destroy ." :underline 0) + +(pack '.menu.button '.menu.listbox '.menu.entry '.menu.text '.menu.scroll + '.menu.scale '.menu.canvas '.menu.menu '.menu.misc :side "left") + +;; Set up for keyboard-based menu traversal + +(bind '|.| "" + '(progn + (if (and (equal |%d| "NotifyVirtual") + (equal |%m| "NotifyNormal")) + (focus '.menu) + ))) + +;; make the meta key do traversal bindings +(bind '.menu "" "tk_traverseToMenu %W %A") + +(tk-menu-bar '.menu '.menu.button '.menu.listbox '.menu.entry '.menu.text + '.menu.scroll '.menu.scale '.menu.canvas '.menu.menu '.menu.misc) + +;; Position a dialog box at a reasonable place on the screen. + +(defun dpos (w) + (wm :geometry w "+60+25") +) + +;; some of the widgets are tcl and need this. +(tk-do "proc dpos w { + wm geometry $w +300+300 +}") diff --git a/gcl-tk/dir.sed b/gcl-tk/dir.sed new file mode 100755 index 0000000..5b3a2db --- /dev/null +++ b/gcl-tk/dir.sed @@ -0,0 +1,3 @@ +/DIR=/a\ +DIR=/home/wfs/gcl-2.0/gcl-tk +/DIR=/d diff --git a/gcl-tk/gcl-1.tcl b/gcl-tk/gcl-1.tcl new file mode 100755 index 0000000..9fc32bb --- /dev/null +++ b/gcl-tk/gcl-1.tcl @@ -0,0 +1,39 @@ + +set LongestMatchPossible 3000 + +proc MarkRegexps { w regexp tag tags {start 0.0} {end end}} { + upvar #0 LongestMatchPossible longest + $w mark set MaRe $start + set found 0 + while {[$w compare MaRe < $end]} { + set began MaRe + set text [$w get MaRe "MaRe + [expr 10 * $longest] chars"] + set limit [expr 9 * $longest] + set begin 0 + set last "-1 -1" + while {[regexp -indices $regexp $text all j1 j2 j3 j4 j5 j6 j7 j8 \ + j9 ]} { + incr found + set i 1 + set endmatch [lindex $all 1] + $w tag add $tag "MaRe + [expr $begin + [lindex $all 0]] chars" \ + "MaRe + [expr $begin + [lindex $all 1]] chars" + foreach ta $tags { + set all [set j$i] + incr i + if { $all != "-1 -1" } { +# puts stdout "ta=$ta taa=[set $ta]" +# puts stdout "found $endmatch: `[string range $text [lindex $all 0] [lindex $all 1]]'" + $w tag add $ta "MaRe + [expr $begin + [lindex $all 0]] chars" \ + "MaRe + [expr $begin + [lindex $all 1]] chars" } + } +# puts stdout "found $endmatch: `[string range $text [expr $endmatch - 10] \ +[expr $endmatch + 4]]'" + set text [string range $text $endmatch end] + incr begin $endmatch + if {[expr $begin >= $limit]} { set limit $begin ;break} + } + $w mark set MaRe "MaRe + $limit chars" +} +# puts stdout "found $found matches" +} diff --git a/gcl-tk/gcl.tcl b/gcl-tk/gcl.tcl new file mode 100755 index 0000000..4a081ad --- /dev/null +++ b/gcl-tk/gcl.tcl @@ -0,0 +1,55 @@ + +# some extensions for gcl +# of course these could be in lisp, but keeping them on the +# tk side of the pipe can cut down overhead. for large things +# like getting a file + +proc TextLoadFile {w file} { + set f [open $file] + $w delete 1.0 end + while {![eof $f]} { + $w insert end [read $f 10000] + } + close $f +} + +proc insertWithTags {w text args} { + set start [$w index insert] + $w insert insert $text + foreach tag [$w tag names $start] { + $w tag remove $tag $start insert + } + foreach i $args { + $w tag add $i $start insert + } +} +# in WINDOW if TAG is set at INDEX then return the range +# of indices for which tag is set including index. + +proc get_tag_range {w tag index} { + set i 1 + set index [$w index $index] + set range "" + set ok 0 +# puts stdout $index + foreach v [$w tag names $index] { if {$v == $tag} {set ok 1}} + while $ok { + set range [$w tag nextrange $tag "$index -$i chars" "$index +1 char"] + if {[llength $range ] >= 2} { break;} + if {[$w compare "$index - $i chars" <= "0.0 + 1 chars" ]} { break;} + set i [expr $i + 1] + } + return $range +} + +proc MultipleTagAdd {win tag start l} { + set prev -1 + foreach v $l { puts stdout $v + if { "$prev" == "-1" } { + set prev $v + } else { + $win tag add $tag "$start + $prev chars" "$start + $v chars" + set prev -1 +}}} + + diff --git a/gcl-tk/gcl_cmpinit.lsp b/gcl-tk/gcl_cmpinit.lsp new file mode 100755 index 0000000..4bb83bd --- /dev/null +++ b/gcl-tk/gcl_cmpinit.lsp @@ -0,0 +1 @@ +(load "tk-package.lsp") \ No newline at end of file diff --git a/gcl-tk/gcl_guisl.h b/gcl-tk/gcl_guisl.h new file mode 100755 index 0000000..5794d47 --- /dev/null +++ b/gcl-tk/gcl_guisl.h @@ -0,0 +1,9 @@ + +static L1(); +static L2(); +static char * VVi[2]={ +#define Cdata VV[1] +(char *)(L1), +(char *)(L2) +}; +#define VV ((object *)VVi) diff --git a/gcl-tk/gcltksrv.bat b/gcl-tk/gcltksrv.bat new file mode 100755 index 0000000..ffee8d0 --- /dev/null +++ b/gcl-tk/gcltksrv.bat @@ -0,0 +1,8 @@ +set GCL_TK_DIR=c:/cvs/gcl/gcl-tk +set TCL_LIBRARY=c:/lang/tcl/lib/tcl8.3 +set TK_LIBRARY=c:/lang/tcl/lib/tcl8.3 +start %GCL_TK_DIR%/gcltkaux %1 %2 %3 + + + + diff --git a/gcl-tk/gcltksrv.in b/gcl-tk/gcltksrv.in new file mode 100755 index 0000000..072f295 --- /dev/null +++ b/gcl-tk/gcltksrv.in @@ -0,0 +1,31 @@ +#!/bin/sh +# where to find bitmaps, +# and the class bindings in /usr/local/lib/tk/tk.tcl +GCL_TK_DIR=/home/wfs/gcl-2.0/gcl-tk +TK_XLIB_DIR=/usr/local/X11R6/lib +if [ -d "${TK_XLIB_DIR}" ] ; then + export LD_LIBRARY_PATH + LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${TK_XLIB_DIR} +fi + +#check to see if TK_LIBRARY set in users environment ok.. +if [ -f ${TK_LIBRARY}/tk.tcl ] ;then true; +else +TK_LIBRARY=/var/X11/lib/X11/tk + if [ -f ${TK_LIBRARY}/tk.tcl ] ;then export TK_LIBRARY ; fi +export TK_LIBRARY +fi +if [ -f ${TCL_LIBRARY}/init.tcl ] ;then true; +else +TCL_LIBRARY=/usr/local/lib/tcl + if [ -f ${TCL_LIBRARY}/init.tcl ] ; then export TCL_LIBRARY ; fi +fi +if [ $# -ge 4 ] ;then +DISPLAY=$4 ; +export DISPLAY; +fi +exec ${GCL_TK_DIR}/gcltkaux $1 $2 $3 + + + + diff --git a/gcl-tk/gcltksrv.in.interp b/gcl-tk/gcltksrv.in.interp new file mode 100755 index 0000000..e45d8ff --- /dev/null +++ b/gcl-tk/gcltksrv.in.interp @@ -0,0 +1,15 @@ +#!/bin/sh +# comment \ +export GCL_TK_DIR ; \ +GCL_TK_DIR=/d2/wfs/gcl-2.3/gcl-tk +#comment \ +export DISPLAY; DISPLAY=$4 ; exec wish "$0" "$@" +set host [lindex $argv 0] +set port [lindex $argv 1] +set pid [lindex $argv 2] +source $env(GCL_TK_DIR)/decode.tcl +GclAnswerSocket $host $port $pid + + + + diff --git a/gcl-tk/gcltksrv.prev b/gcl-tk/gcltksrv.prev new file mode 100755 index 0000000..9ca8fe8 --- /dev/null +++ b/gcl-tk/gcltksrv.prev @@ -0,0 +1,22 @@ +#!/bin/sh +# where to find bitmaps, +# and the class bindings in /usr/local/lib/tk/tk.tcl +TK_LIBRARY=/var/X11/lib/X11/tk +DIR=/d19/staff/wfs/ngcl-2.0/gcl-tk +TK_LIBRARY=/public/lib/tk +DIR=/d19/staff/wfs/ngcl-2.0/gcl-tk +#put correct dir +if [ -f ${TK_LIBRARY}/tk.tcl ] ; then true; +else +TK_LIBRARY=/usr/local/lib/tk +export TK_LIBRARY +fi +if [ $# -ge 4 ] ;then +DISPLAY=$4 ; +export DISPLAY; +fi +exec ${DIR}/gcltkaux $1 $2 $3 + + + + diff --git a/gcl-tk/guis.c b/gcl-tk/guis.c new file mode 100755 index 0000000..f162047 --- /dev/null +++ b/gcl-tk/guis.c @@ -0,0 +1,509 @@ +/* + Copyright (C) 1994 Rami el Charif, W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#define IN_GUIS + +#include +#include +#include +#ifdef __cplusplus +extern "C" { +#endif + +#include + +#ifndef _WIN32 +# include +# ifdef PLATFORM_NEXT +# include +# include +# else +# include +# include +# endif +#endif + +/* #include */ + +#include + +#ifndef _WIN32 +#include +#endif + +#include +#include +#include +#ifdef __cplusplus +#ifdef PLATFORM_NEXT +extern unsigned long inet_addr( char *cp ); +extern char *inet_ntoa ( struct in_addr in ); +#endif +} +#endif +#ifdef PLATFORM_LINUX +#include +#endif +#include + +#ifdef __svr4__ +#include +#endif + +#ifdef PLATFORM_NEXT /* somehow, this is getting lost... */ +#undef bzero +#define bzero(b,len) memset(b,0,len) +#endif + + +#include "guis.h" + +#ifndef TRUE +#define TRUE (1) +#define FALSE (0) +#endif + +FILE *pstreamDebug; +int fDebugSockets; + +/* #ifdef PLATFORM_SUNOS */ +/* static void notice_input( ); */ +/* #else */ +/* static void notice_input(); */ +/* #endif */ + +int hdl = -1; + +void TkX_Wish (); + +pid_t parent; + +int debug; + +#ifdef _WIN32 + +#include +#include + +/* Keep track of socket initialisations */ +int w32_socket_initialisations = 0; + +WSADATA WSAData; + + +/* Use threads instead of fork() */ +/* Struct to hold args for thread. */ +typedef struct _TAS { + char **argv; + int argc; + int rv; + int delay; +} TAS; + +#endif + +#include "comm.c" + +#ifdef _WIN32 + +#define SET_SESSION_ID() 0 + +UINT WINAPI tf1 ( void *tain ) +{ + TAS *ta = (TAS *) tain; + UINT rv = 0; + if (SET_SESSION_ID() == -1) { + fprintf ( stderr, "tf: Error - set session id failed : %d\n", errno ); + } + if ( w32_socket_init() >= 0 ) { + dsfd = sock_connect_to_name ( ta->argv[1], atoi ( ta->argv[2] ), 0); + if ( dsfd ) { + fprintf ( stderr, "connected to %s %s\n", ta->argv[1], ta->argv[2] ); + TkX_Wish ( ta->argc, ta->argv ); + fprintf ( stderr, "Wish shell done\n" ); + sock_close_connection ( dsfd ); + ta->rv = 0; + } else { + fprintf ( stderr, + "Error: Can't connect to socket host=%s, port=%s, errno=%d\n", + ta->argv[1], ta->argv[2], errno ); + fflush ( stderr ); + ta->rv = -1; + } + w32_socket_exit(); + } else { + fprintf ( stderr, "tf: Can't initialise sockets - w32_socket_init failed.\n" ); + } + _endthreadex ( 0 ); + return ( 0 ); +} + +int w32_socket_init(void) +{ + int rv = 0; + if (w32_socket_initialisations++) { + rv = 0; + } else { + if (WSAStartup(0x0101, &WSAData)) { + w32_socket_initialisations = 0; + fprintf ( stderr, "WSAStartup failed\n" ); + WSACleanup(); + rv = -1; + } + } + + return rv; +} + +int w32_socket_exit(void) +{ + int rv = 0; + + if ( w32_socket_initialisations == 0 || + --w32_socket_initialisations > 0 ) { + rv = 0; + } else { + rv = WSACleanup(); + } + + return rv; +} + +#endif + + +/* Start up our Graphical User Interface connecting to + NETWORK-ADDRESS on PORT to process PID. If fourth + argument WAITING causes debugging flags to be turned + on and also causes a wait in a loop for WAITING seconds + (giving a human debugger time to attach to the forked process). + */ + +#ifdef SGC +int sgc_enabled=0; +#endif + +int delay; +int main(argc, argv,envp) +int argc; +char *argv[]; +char *envp[]; +{ + int rv = 0; + { + int i = argc; + pstreamDebug = stderr; + while (--i > 3) { + if (strcmp(argv[i],"-delay")==0) + { delay = atoi(argv[i+1]);} + if (strcmp(argv[i],"-debug")==0) + {debug = 1; fDebugSockets = -1;} + } + } + + if (argc >= 4) { + +#ifdef _WIN32 + UINT dwThreadID; + HANDLE hThread; + TAS targs; + void *pTA = (void *) &targs; + targs.argv = argv; + targs.argc = argc; + targs.rv = 0; + targs.delay = delay; + + hThread = (HANDLE) _beginthreadex ( + NULL, + 0, + tf1, + pTA, + 0, + &dwThreadID + ); + if ( 0 == hThread ) { + dfprintf ( stderr, "Error: Couldn't create thread.\n" ); + rv = -1; + } + if ( WAIT_OBJECT_0 != WaitForSingleObject ( hThread, INFINITE ) ) { + dfprintf ( stderr, "Error: Couldn't wait for thread to exit.\n" ); + rv = -1; + } + CloseHandle ( hThread ); + +#else /* _WIN32 */ + pid_t p; + + parent = atoi(argv[3]); + dfprintf(stderr,"guis, parent is : %d\n", parent); + +#ifdef MUST_USE_VFORK + p = vfork(); +#else + p = fork(); +#endif + dfprintf(stderr, "guis, vfork returned : %d\n", p); + + if (p == -1) + { + dfprintf(stderr, "Error !!! vfork failed %d\n", errno); + + return -1; + } + else if (p) + { + dfprintf(stderr, "guis,vforked child : %d\n", p); + + _exit(p); + /* + return p; + */ + } + else + { + +#ifndef SET_SESSION_ID +#if defined(__svr4__) || defined(ATT) +#define SET_SESSION_ID() setsid() +#else +#ifdef BSD +#define SET_SESSION_ID() (setpgrp() ? -1 : 0) +#endif +#endif +#endif + + if (SET_SESSION_ID() == -1) + { dfprintf(stderr, "Error !!! setsid failed : %d\n", errno); + } + + + dsfd = sock_connect_to_name(argv[1], atoi(argv[2]), 0); + if (dsfd) { + dfprintf(stderr, "connected to %s %s" + , argv[1], argv[2]); + /* give chance for someone to attach with gdb and + to set waiting to 0 */ + while (-- delay >=0) sleep(1); + { + TkX_Wish(argc, argv); + } + + dfprintf(stderr, "Wish shell done\n"); + + sock_close_connection(dsfd); + return 0; + } else { + dfprintf(stderr, + "Error !!! Can't connect to socket host=%s, port=%s, errno=%d\n" + , argv[1], argv[2], errno); + fflush(stderr); + return -1; + } + } +#endif /* _WIN32 */ + } else { + int i; + fprintf ( stderr, "gcltkaux: Error - expecting more arguments, but found:\n" ); + fflush(stderr); + for ( i = 0; ifd ); + free(sfd->read_buffer); + free(sfd); + +} + + +/* #ifdef PLATFORM_SUNOS */ +/* static void */ +/* notice_input( int sig, int code, struct sigcontext *s, char *a ) */ +/* #else */ +/* static void */ +/* notice_input( sig ) */ +/* int sig; */ +/* #endif */ +/* { */ +/* signal( SIGIO, notice_input ); */ +/* dfprintf(stderr, "\nNoticed input!\n" ); */ + +/* } */ + +static int message_id; + +int +sock_write_str2( sfd, type, hdr, + hdrsize,text, length ) + +struct connection_state *sfd; +enum mtype type; + char *hdr; +int hdrsize; +const char *text; +int length; + +{ + char buf[0x1000]; + char *p = buf; + int m; + int n_written; + struct message_header *msg; + msg = (struct message_header *) buf; + + if (length == 0) + length = strlen(text); + m = length + hdrsize; + + msg->magic1=MAGIC1; + msg->magic2=MAGIC2; + msg->type = type; + msg->flag = 0; + STORE_3BYTES(msg->size,m); + STORE_3BYTES(msg->msg_id,message_id); + message_id++; + p = buf + MESSAGE_HEADER_SIZE; + bcopy(hdr,p,hdrsize); + p+= hdrsize; + + if (sizeof(buf) >= (length + hdrsize + MESSAGE_HEADER_SIZE)) + { bcopy(text,p,length); + n_written = write1(sfd,buf,(length + hdrsize + MESSAGE_HEADER_SIZE)); + } + else + { n_written = write1(sfd,buf, hdrsize + MESSAGE_HEADER_SIZE); + n_written += write1(sfd, text, length); + } + + if (n_written != (length + hdrsize + MESSAGE_HEADER_SIZE)) + {perror("sock_write_str: Did not write full message"); + return -1;} + return n_written; + +} + + +#define READ_BUF_STRING_AVAIL 1 +#define READ_BUF_DATA_ON_PORT 2 + + + +#define DEFAULT_TIMEOUT_FOR_TK_READ (100 * HZ) + + + +struct message_header * +guiParseMsg1(sfd,buf,bufleng) + char *buf; +int bufleng; +struct connection_state *sfd; +{ int m; + int body_length; + int tot; + struct message_header *msg; + msg = (struct message_header *) buf; + m= read1(sfd,(void *)msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ); + if (m == MESSAGE_HEADER_SIZE) + { + if ( msg->magic1!=MAGIC1 + || msg->magic2!=MAGIC2) + { fprintf(stderr,"bad magic..flushing buffers"); + while(read1(sfd,buf,bufleng,0) > 0); + return 0;} + GET_3BYTES(msg->size,body_length); + tot = body_length+MESSAGE_HEADER_SIZE; + if (tot >= bufleng) + {msg = (void *)malloc(tot+1); + bcopy(buf,msg,MESSAGE_HEADER_SIZE);} + m = read1(sfd,(void *)&(msg->body), + body_length,DEFAULT_TIMEOUT_FOR_TK_READ); + if (m == body_length) + { return msg;}} + if (m < 0) exit(1); + { static int bad_read_allowed=4; + if (bad_read_allowed-- < 0) exit(1); + } + + dfprintf(stderr,"reading from lisp timed out or not enough read"); + return 0; +} + +void +error(s) + char *s; +{ fprintf(stderr,"%s",s); abort(); +} + +void +write_timeout_error(s) + char *s; +{ fprintf(stderr,"write timeout: %s",s); abort(); +} +void +connection_failure(s) + char *s; +{ fprintf(stderr,"connection_failure:%s",s); abort(); +} + +object +make_fixnum1(long i) { + + static union lispunion lu; + + lu.FIX.FIXVAL=i; + return &lu; + +} diff --git a/gcl-tk/guis.h b/gcl-tk/guis.h new file mode 100755 index 0000000..0d69247 --- /dev/null +++ b/gcl-tk/guis.h @@ -0,0 +1,104 @@ +#ifndef _GUIS_H_ +#define _GUIS_H_ + +#include + +#define NO_PRELINK_UNEXEC_DIVERSION +#define IMMNUM_H +#define GMP_WRAPPERS_H +#define ERROR_H +#undef INLINE + +#include "include.h" + +#ifdef NeXT +typedef int pid_t; +#endif + +#ifndef _ANSI_ARGS_ +#ifdef __STDC__ +#define _ANSI_ARGS_(x) x +#else +#define _ANSI_ARGS_(x) () +#endif +#endif + +#define STRING_HEADER_FORMAT "%4.4d" +#define CB_STRING_HEADER (5) +/* +#define GET_STRING_SIZE_FROM_HEADER(__buf, __plgth) \ +sscanf(__buf, STRING_HEADER_FORMAT, __plgth); +*/ + +/* sscanf is braindead on SunOS */ +#define GET_STRING_SIZE_FROM_HEADER(__buf, __plgth) \ +{\ + __buf[CB_STRING_HEADER - 1] = 0;\ + *__plgth = atoi(__buf);\ + __buf[4] = '';\ +} + +/* need to have opportunity to collapse message to reduce trafic */ +#define MSG_STRAIGHT_TCL_CMD 0 +#define MSG_CREATE_COMMAND 1 +/* +#define MSG_ +*/ + +typedef struct _guiMsg { + + pid_t pidSender; + int vMajor; + int vMinor; + int idx; + int fSignal; + int fAck; + int IdMsg; + char *szData; + char *szMsg; + +} guiMsg; + +#define MSG_IDX(__p) (__p->idx) +#define MSG_COMMAND(__p) (__p->IdMsg) +#define MSG_NEED_ACK(__p) (__p->fAck) +#define MSG_NEED_SIGNAL_PARENT(__p) (__p->fSignal) +#define MSG_TCL_STR(__p) (__p->szData) +#define MSG_DATA_STR(__p) (__p->szData) +/* +#define MSG_(__p) (__p->) +*/ + +#include "sheader.h" +struct message_header * guiParseMsg1(); + + +extern pid_t parent; + +struct connection_state * +sock_connect_to_name(); +void sock_close_connection( ); +int sock_read_str(); + +guiMsg *guiParseMsg(); +void guiFreeMsg(); + +void +guiCreateThenBindCallback(); +int guiBindCallback(); + +#endif + +int +sock_write_str2(struct connection_state *,enum mtype, char *, + int,const char *,int); + + +object +fSclear_connection(fixnum); + + +object +fScheck_fd_for_input(fixnum,fixnum); + +#define SI_makefun(a_,b_,c_) diff --git a/gcl-tk/helpers.lisp b/gcl-tk/helpers.lisp new file mode 100755 index 0000000..c90c5b9 --- /dev/null +++ b/gcl-tk/helpers.lisp @@ -0,0 +1,21 @@ + +(in-package "TK") + +(setq controls '( + after exit lower place send tkvars winfo focus option raise tk tkwait wm destroy grab pack selection tkerror update tk_listboxSingleSelect)) + +(setq widgets '( + button listbox scale canvas menu scrollbar checkbutton menubutton text entry message frame label radiobutton toplevel )) + + +(defun get-options (com) + (let ((tem (funcall com "jo" :return 'string)) + (cond ((equal (subseq tem 0 (length s)) + s) + (setq tem (subseq tem (length s))) + (setq tem (substitute #\space #\, tem)) + (setq tem (list-string tem)) + (setq tem (delete "or" tem :test 'equal)) + + (mapcar #'(lambda (x) (intern (string-upcase x) :keyword)) tem) + )))) diff --git a/gcl-tk/index.lsp b/gcl-tk/index.lsp new file mode 100755 index 0000000..a95a71c --- /dev/null +++ b/gcl-tk/index.lsp @@ -0,0 +1,55 @@ + +(in-package "TK") +(AUTOLOAD 'FILE-TO-STRING '|info|) +(AUTOLOAD 'ATOI '|info|) +(AUTOLOAD 'INFO-GET-TAGS '|info|) +(AUTOLOAD 'RE-QUOTE-STRING '|info|) +(AUTOLOAD 'GET-MATCH '|info|) +(AUTOLOAD 'GET-NODES '|info|) +(AUTOLOAD 'GET-INDEX-NODE '|info|) +(AUTOLOAD 'NODES-FROM-INDEX '|info|) +(AUTOLOAD 'GET-NODE-INDEX '|info|) +(AUTOLOAD 'ALL-MATCHES '|info|) +(AUTOLOAD 'NODE-OFFSET '|info|) +(AUTOLOAD 'SETUP-INFO '|info|) +(AUTOLOAD 'GET-INFO-CHOICES '|info|) +(AUTOLOAD 'ADD-FILE '|info|) +(AUTOLOAD 'INFO-ERROR '|info|) +(AUTOLOAD 'INFO-GET-FILE '|info|) +(AUTOLOAD 'WAITING '|info|) +(AUTOLOAD 'END-WAITING '|info|) +(AUTOLOAD 'INFO-SUBFILE '|info|) +(AUTOLOAD 'INFO-NODE-FROM-POSITION '|info|) +(AUTOLOAD 'SHOW-INFO '|info|) +(AUTOLOAD 'INFO-AUX '|info|) +(AUTOLOAD 'INFO-SEARCH '|info|) +(AUTOLOAD 'IDESCRIBE '|info|) +(AUTOLOAD 'INFO '|info|) +(AUTOLOAD 'DEFAULT-INFO-HOTLIST '|info|) +(AUTOLOAD 'ADD-TO-HOTLIST '|info|) +(AUTOLOAD 'LIST-MATCHES '|info|) +(AUTOLOAD 'SIMPLE-LISTBOX '|tinfo|) +(AUTOLOAD 'INSERT-STANDARD-LISTBOX '|tinfo|) +(AUTOLOAD 'LISTBOX-MOVE '|tinfo|) +(AUTOLOAD 'NEW-WINDOW '|tinfo|) +(AUTOLOAD 'INSERT-INFO-CHOICES '|tinfo|) +(AUTOLOAD 'OFFER-CHOICES '|tinfo|) +(AUTOLOAD 'GET-INFO-APROPOS '|tinfo|) +(AUTOLOAD 'SHOW-INFO-KEY '|tinfo|) +(AUTOLOAD 'MKINFO '|tinfo|) +(AUTOLOAD 'INFO-TEXT-SEARCH '|tinfo|) +(AUTOLOAD 'PRINT-NODE '|tinfo|) +(AUTOLOAD 'INFO-SHOW-HISTORY '|tinfo|) +(AUTOLOAD 'SHOW-THIS-NODE '|tinfo|) +(AUTOLOAD 'SCROLL-SET-FIX-XREF-CLOSURE '|tinfo|) +(AUTOLOAD 'FIX-XREF '|tinfo|) +(AUTOLOAD 'INSERT-FONTIFIED '|tinfo|) +(AUTOLOAD 'SECTION-HEADER '|tinfo|) +(AUTOLOAD 'INSERT-STRING '|tinfo|) +(AUTOLOAD 'INSERT-STRING-WITH-REGEXP '|tinfo|) +(AUTOLOAD 'COUNT-CHAR '|tinfo|) +(AUTOLOAD 'START-OF-ITH-LINE '|tinfo|) +(AUTOLOAD 'INDEX-TO-POSITION '|tinfo|) + +(SETQ SYSTEM::*LOAD-PATH* + (APPEND '("/usr/local/gcl-2.2/gcl-tk/") SYSTEM::*LOAD-PATH*)) \ No newline at end of file diff --git a/gcl-tk/intrs.h b/gcl-tk/intrs.h new file mode 100755 index 0000000..e69de29 diff --git a/gcl-tk/makefile b/gcl-tk/makefile new file mode 100644 index 0000000..037d730 --- /dev/null +++ b/gcl-tk/makefile @@ -0,0 +1,76 @@ + +.SUFFIXES: +.SUFFIXES: .o .lsp .lisp .c + +CC=cc +LD_ORDINARY_CC=${CC} +GCLTKCC=${CC} +# Need libX11.a and libtcl.a, machine.defs may say where.. + +CC = gcc +HDIR = ../h +ODIR = ../o + +GCLIB = ../o/gcllib.a + + +-include ../makedefs + + +CFLAGS1=$(CFLAGS) -I../o -I../h ${TK_INCLUDE} ${TCL_INCLUDE} ${TK_XINCLUDES} + + +all: gcltksrv tkl.o tinfo.o demos/gc-monitor.o gcltkaux + (cd demos ; \ + echo '(load "../tkl.o")(TK::GET-AUTOLOADS (directory "*.lisp"))' | ../../unixport/$(FLISP)) + +.lisp.o: + echo "(compile-file \"$*.lisp\" :c-file nil :c-debug nil)" | ../unixport/$(FLISP) + +.lsp.o: + echo "(compile-file \"$*.lsp\" :c-file nil :c-debug nil)" | ../unixport/$(FLISP) + + + +GUIOS = guis.o tkAppInit.o tkMain.o + +clean:: + rm -f ${GUIOS} $(OFILES) gcltkaux gcltksrv *.o */*.o demos/index.lsp *.fn demos/*.fn + +.c.o: + $(GCLTKCC) -c $(filter-out -pg,$(CFLAGS1)) -fPIE ${ODIR_DEBUG} $*.c + + +# for some reason -lieee is on various linux systems in the list of requireds.. + +gcltkaux: $(GUIOS) + $(LD_ORDINARY_CC) $(GUIOS) $(filter-out %gcl.script,$(LDFLAGS)) -pie -o gcltkaux ${TK_LIB_SPEC} ${TCL_LIB_SPEC} + +gcltksrv: makefile + cat gcltksrv.in | sed -e "s!TK_LIBRARY=.*!TK_LIBRARY=${TK_LIBRARY}!g" \ + -e "s!TCL_LIBRARY=.*!TCL_LIBRARY=${TCL_LIBRARY}!g" \ + -e "s!TK_XLIB_DIR=.*!TK_XLIB_DIR=${TK_XLIB_DIR}!g" \ + -e "s!GCL_TK_DIR=.*!GCL_TK_DIR=${GCLDIR}/gcl-tk!g" > gcltksrv + chmod a+x gcltksrv + +gcltksrv.interp: makefile + cat gcltksrv.in.interp | sed -e "s!TK_LIBRARY=.*!TK_LIBRARY=${TK_LIBRARY}!g" \ + -e "s!TK_XLIB_DIR=.*!TK_XLIB_DIR=${TK_XLIB_DIR}!g" \ + -e "s!TCL_LIBRARY=.*!TCL_LIBRARY=${TCL_LIBRARY}!g" \ + -e "s!GCL_TK_DIR=.*!GCL_TK_DIR=${GCLDIR}/gcl-tk!g" > gcltksrv.interp + chmod a+x gcltksrv.interp + +INTERESTING=*.lsp *.lisp tk*.c guis.c sockets.c comm.c Makefile demos/*.lisp *.h + +tar: + tar cvf - ${INTERESTING} | gzip -c > /u/wfs/sock-`date +%y%m%d`.tgz +tags: + etags *.lsp *.lisp tk*.c guis.c sockets.c guis.h our_io.c + +tkAppInit.o : tkAppInit.c +tkMain.o : tkMain.c +tkXAppInit.o : tkXAppInit.c +tkXshell.o : tkXshell.c +guis.o : guis.c guis.h comm.c sheader.h +sockets.c: our_io.c sheader.h +socketsl.o: socketsl.lisp sockets.c diff --git a/gcl-tk/makefile.prev b/gcl-tk/makefile.prev new file mode 100644 index 0000000..07fff6f --- /dev/null +++ b/gcl-tk/makefile.prev @@ -0,0 +1,129 @@ + +.SUFFIXES: +.SUFFIXES: .o .lsp .lisp .c + +CC=cc +LD_ORDINARY_CC=${CC} +# Need libX11.a and libtcl.a, machine.defs may say where.. + +CC = gcc +HDIR = ../h +ODIR = ../o + +GCLIB = ../o/gcllib.a + +# begin makedefs + +# use=386-linux + +LIBS= -lm + + + +GCLDIR=/d2/wfs/gcl-2.3 +SHELL=/bin/sh +MACHINE=386-linux +TK_CONFIG_PREFIX="/usr/lib" +TCL_CONFIG_PREFIX="/usr/lib" +#could not find dir so using: +INFO_DIR="unknown" +TK_INCLUDE="-I/usr/include" +TK_VERSION=4.1 +TCL_VERSION=7.5 +TK_LIB_SPEC=-L/usr/lib -ltk +TK_LIBRARY=/usr/lib/tk4.1 +TCL_LIBRARY=/usr/lib/tcl7.5 +TK_BUILD_LIB_SPEC=-L/usr/src/tk4.1/unix -ltk +TK_XLIBSW=-L/usr/X11R6/lib -lX11 +TK_XLIB_DIR=/usr/X11R6/lib +TK_XINCLUDES=# no special path needed +TCL_LIB_SPEC=-L/usr/lib -ltcl +TCL_DL_LIBS=-ldl +TCL_LIBS=-ldl -lieee -lm +HAVE_X11=-DHAVE_X11 + +# Machine dependent makefile definitions for intel 386,486 running linux + +LBINDIR=/usr/local/bin + +OFLAG = -O +LIBS = -lm + +ODIR_DEBUG= -O4 + +# This CC string will be used for compilation of the system, +# and also in the compiler::*cc* variable for later compilation of +# lisp files. +# (the -pipe is just since our file system is slow..) +CC = gcc -pipe -fwritable-strings -DVOL=volatile -I$(GCLDIR)/o -fsigned-char +LDCC=${CC} +# note for linuxaout on an elf machine add -b i486-linuxaout +# CC = gcc -pipe -fwritable-strings -DVOL=volatile -I$(GCLDIR)/o -fsigned-char -b i486-linuxaout + +# Enable the fastloading mechanism which does not use ld -A +# requires c/rel_.. machine dependent code. + +RSYM = rsym +SFASL = $(ODIR)/sfasl.o + + +MPFILES= $(MPDIR)/mpi-386d.o $(MPDIR)/libmport.a + + +# When using SFASL it is good to have (si::build-symbol-table) +INITFORM=(si::build-symbol-table) + +# Use symbolic links +SYMB=-s + +LIBFILES=bsearch.o + +# the make to use for saved_kcp the profiler. +KCP=kcp-bsd +# end makedefs + +CFLAGS1=$(CFLAGS) -I../o -I../h ${TK_INCLUDE} ${TK_XINCLUDES} + +all: gcltkaux tkl.o tinfo.o gcltksrv demos/gc-monitor.o + +.lisp.o: + echo "(compile-file \"$*.lisp\" :c-file nil :c-debug nil)" | ../unixport/saved_gcl + +.lsp.o: + echo "(compile-file \"$*.lsp\" :c-file t :c-debug t)" | ../unixport/saved_gcl + + + +GUIOS = guis.o tkAppInit.o tkMain.o + +clean:: + rm -f ${GUIOS} $(OFILES) gcltkaux gcltksrv *.o */*.o + +.c.o: + $(CC) -c $(CFLAGS1) ${ODIR_DEBUG} $*.c + + +gcltkaux: $(GUIOS) + $(LD_ORDINARY_CC) $(GUIOS) -o gcltkaux ${TK_LIB_SPEC} ${TK_BUILD_LIB_SPEC} ${TK_XLIBSW} ${TK_XINCLUDES} ${TCL_LIB_SPEC} ${TCL_DL_LIBS} ${TCL_LIBS} ${LIBS} ${GCLIB} + +gcltksrv: makefile + cat gcltksrv.in | sed -e "s:TK_LIBRARY=.*:TK_LIBRARY=${TK_LIBRARY}:g" \ + -e "s:TK_XLIB_DIR=.*:TK_XLIB_DIR=${TK_XLIB_DIR}:g" \ + -e "s:GCL_TK_DIR=.*:GCL_TK_DIR=${GCLDIR}/gcl-tk:g" > gcltksrv + chmod a+x gcltksrv + +INTERESTING=*.lsp *.lisp tk*.c guis.c sockets.c comm.c Makefile demos/*.lisp *.h + +tar: + tar cvf - ${INTERESTING} | gzip -c > /u/wfs/sock-`date +%y%m%d`.tgz +tags: + etags *.lsp *.lisp tk*.c guis.c sockets.c guis.h our_io.c + +tkAppInit.o : tkAppInit.c +tkMain.o : tkMain.c +tkXAppInit.o : tkXAppInit.c +tkXshell.o : tkXshell.c +guis.o : guis.c guis.h comm.c sheader.h +sockets.c: our_io.c sheader.h +socketsl.o: socketsl.lisp sockets.c + diff --git a/gcl-tk/ngcltksrv b/gcl-tk/ngcltksrv new file mode 100755 index 0000000..7c2438a --- /dev/null +++ b/gcl-tk/ngcltksrv @@ -0,0 +1,12 @@ +#!/bin/sh +#comment \ +export DISPLAY=$4 ; host=$1;port=$2 ;pid=$3 ; exec wish "$0" "$@" +set host [lindex $argv 0] +set port [lindex $argv 1] +set pid [lindex $argv 2] +source /home/wfs/gcl-2.3/gcl-tk/decode.tcl +GclAnswerSocket $host $port $pid + + + + diff --git a/gcl-tk/our_io.c b/gcl-tk/our_io.c new file mode 100755 index 0000000..8300f3a --- /dev/null +++ b/gcl-tk/our_io.c @@ -0,0 +1,109 @@ + +#include + + +#ifndef NO_DEFUN +#ifndef DEFUN +#define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,doc) ret fname +#endif +#endif + + +#ifndef HZ +#define HZ 60 +#endif + +#ifndef SET_TIMEVAL +#define SET_TIMEVAL(t,timeout) \ + t.tv_sec = timeout/HZ; t.tv_usec = (int) ((timeout%HZ)*(1000000.0)/HZ) +#endif + + +DEFUN("CHECK-FD-FOR-INPUT",int,fScheck_fd_for_input, + SI,0,0,NONE,II,IO,OO,OO, + +"Check FD a file descriptor for data to read, waiting TIMEOUT clicks \ +for data to become available. Here there are \ +INTERNAL-TIME-UNITS-PER-SECOND in one second. Return is 1 if data \ +available on FD, 0 if timeout reached and -1 if failed.") + + (fd,timeout) +int fd; +int timeout; +{ + fd_set inp; + int n; + struct timeval t; + + SET_TIMEVAL(t,timeout); + FD_ZERO(&inp); + FD_SET(fd, &inp); + n = select(fd + 1, &inp, NULL, NULL, &t); + if (n < 0) + return -1; + else if (FD_ISSET(fd, &inp)) + return 1; + else + return 0; +} + + +/* read from FD into BUF, M bytes allowing TIMEOUT if necessary. + return number of bytes read. + + */ +our_read(fd,buf,m,timeout) + int fd,m,timeout; + char *buf; +{ int r,tot=0; + char *p = buf; + while(tot < m && (fScheck_fd_for_input(fd,timeout)>0)) + { r = read(fd,p,m); + if (r == 0) return tot; + if (r == -1) + { if (errno != EAGAIN) + return -1;} + else { + tot += r; + p += r; + }} + return tot; +} + +/* write to FD file descriptor from BUF sending NBYTES. */ + +our_write(fd,buf,nbytes) + char *buf; + int fd,nbytes; + +{ int result = 0; + int m; + int n = nbytes; + char *p=buf; + while (n>0) + { m=write(fd,p,n); + if (m< 0) + { perror("write failed:"); + return -1;} + if (m==0) + { fprintf(stderr, + "write failed? 0 bytes written nbytes %d [%s] lost:", + n,p + ); + return result; + } + + p+= m; + n-= m; + result+= m; + } + if (n>0) + { perror("Could not write all data:"); + return result; + } + /* should not happen */ + if (result!= nbytes) abort(); + return result; +} + + diff --git a/gcl-tk/sheader.h b/gcl-tk/sheader.h new file mode 100755 index 0000000..6f47287 --- /dev/null +++ b/gcl-tk/sheader.h @@ -0,0 +1,112 @@ + +#define MAGIC1 '' +#define MAGIC2 'A' + + +/* SIZE in BYTES 10+N + magic1 1 + magic2 1 + type (id) 1 the TYPE of message. callback, command, etc...[an enum!] + flag 1 things like, do acknowledge, etc. + size of actual_body 3 N Use PUSH_LONG to store, POP_LONG to read + msg_index 3 counter inc'd on each message sent, PUSH_SHORT to write.. + actual_body N data +*/ + +enum mtype { + m_not_used, + m_create_command, + m_reply, + m_call, + m_tcl_command, + m_tcl_command_wait_response, + m_tcl_clear_connection, /* clear tk connection and command buff */ + m_tcl_link_text_variable, + m_set_lisp_loc, + m_tcl_set_text_variable, + m_tcl_unlink_text_variable +}; + +struct message_header { + char magic1; + char magic2; + char type; + unsigned char flag; + unsigned char size[3]; + unsigned char msg_id[3]; + char body[1]; +}; + +#ifndef SIGNAL_PARENT_WAITING_RESPONSE +#define SIGNAL_PARENT_WAITING_RESPONSE 1 +#endif + + + + +#define BYTE_S 8 +#define BYTE_MASK (~(~0UL << BYTE_S)) + +#define GET_3BYTES(p,ans) do{ unsigned char* __p = (unsigned char *) p; \ + ans = BYTE_MASK&(*__p++); \ + ans += (BYTE_MASK&((*__p++)))<<1*BYTE_S; \ + ans += (BYTE_MASK&((*__p++)))<<2*BYTE_S;} while(0) + +#define GET_2BYTES(p,ans) do{ unsigned char* __p = (unsigned char *) p; \ + ans = BYTE_MASK&(*__p++); \ + ans += (BYTE_MASK&((*__p++)))<<1*BYTE_S; \ + } while(0) + + +/* store an unsigned int n into the character pointer so that + low order byte occurs first */ + +#define STORE_2BYTES(p,n) do{ unsigned char* __p = (unsigned char *) p; \ + *__p++ = (n & BYTE_MASK);\ + *__p++ = ((n >> BYTE_S) & BYTE_MASK); \ + }\ + while (0) + +#define STORE_3BYTES(p,n) do{ unsigned char* __p = (unsigned char *) p; \ + *__p++ = (n & BYTE_MASK);\ + *__p++ = ((n >> BYTE_S) & BYTE_MASK); \ + *__p++ = ((n >> (2*BYTE_S)) & BYTE_MASK);}\ + while (0) +#define MESSAGE_HEADER_SIZE 10 + + +#define HDR_SIZE 5 +struct our_header +{ unsigned char magic; + unsigned char length[2]; /* length of packet including HDR_SIZE */ + unsigned char received[2]; /* tell other side about how many bytes received. + incrementally */ +}; + +struct connection_state +{ int fd; + int total_bytes_sent; + int total_bytes_received; + int bytes_sent_not_received; + int bytes_received_not_confirmed; + int next_packet_offset; /* offset from valid_data for start of next packet*/ + char *read_buffer; + int read_buffer_size; + char *valid_data; + int valid_data_size; + int max_allowed_in_pipe; + int write_timeout; +}; + +#define MAX_ALLOWED_IN_PIPE PAGESIZE +#define READ_BUFF_SIZE (PAGESIZE<<1) + +extern struct connection_state *dsfd; + +#define fScheck_dsfd_for_input(sf,timeout) \ + (sf->valid_data_size > 0 ? make_fixnum1(1) : fScheck_fd_for_input(sf->fd,timeout)) + +#define OBJ_TO_CONNECTION_STATE(x) \ + ((struct connection_state *)(void *)((x)->ust.ust_self)) + +struct connection_state * setup_connection_state(); diff --git a/gcl-tk/socketsl.lisp b/gcl-tk/socketsl.lisp new file mode 100755 index 0000000..ba1d2f7 --- /dev/null +++ b/gcl-tk/socketsl.lisp @@ -0,0 +1,27 @@ +(in-package "SI") + + + +; (clines "#define our_read_with_offset(fd,buffer,offset,nbytes,timeout) our_read(fd,&((buffer)->ust.ust_self[offset]),nbytes,timeout)") +;;(defun our-read-with-offset (fd buffer offset bytes-to-read timeout) +;; (return bytes read) +;(defentry our-read-with-offset (int object int int int) (int "our_read_with_offset")) +(clines "#define our_write_object(fd,buffer,nbytes) our_write(fd,buffer->ust.ust_self,nbytes)") +;; (defun our-write (fd buffer nbytes) (return bytes-written)) + +(defentry our-write (int object int ) (int "our_write_object")) +(defentry print-to-string1 (object object object) (object print_to_string1)) + +;(clines "#define symbol_value_any(x) ((x)->s.s_dbind)") +;(defentry symbol-value-any (object) (object symbol_value_any)) + +;(clines "#define get_signals_allowed() signals_allowed") +;(defentry signals-allowed () (int "get_signals_allowed")) +;(defentry install_default_signals ()(int "install_default_signals")) + +;(defentry unblock-signal (int) (int "unblock_signal")) + + +(defentry getpid () (int "getpid")) + + diff --git a/gcl-tk/socks.h b/gcl-tk/socks.h new file mode 100755 index 0000000..53a14e0 --- /dev/null +++ b/gcl-tk/socks.h @@ -0,0 +1,31 @@ +#ifndef _H_SOCKS +#define _H_SOCKS + +#include "obj.h" + +obj sock_open_named_socket( obj name, bool async ); +void sock_close_named_socket( obj named_socket ); + +obj sock_connect_to_name( obj host_id, obj name, bool async ); +obj sock_accept_connection( obj named_socket, bool async ); + +obj sock_hostname_to_hostid( obj hostname, obj *aliases ); +obj sock_hostid_to_hostname( obj hostid, obj *aliases ); +bool sock_hostid_eq( obj hostid1, obj hostid2 ); + +/* items is a list of objects returned from + sock_open_named_socket, sock_connect_to_name, + or sock_accept_connection with async = YES +*/ + +obj sock_collect_data( obj items ); + +void sock_write( obj connection, const char *text, UINT_32 length ); + +/* sock_read should return 0 on EOF */ + +UINT_32 sock_read( obj connection, char *buffer, UINT_32 max_len ); +void sock_close_connection( obj connection ); + +#endif /* _H_SOCKS */ + diff --git a/gcl-tk/sysdep-sunos.h b/gcl-tk/sysdep-sunos.h new file mode 100755 index 0000000..8174785 --- /dev/null +++ b/gcl-tk/sysdep-sunos.h @@ -0,0 +1,9 @@ +#ifndef _SYSDEP_SUNOS_H_ +#define _SYSDEP_SUNOS_H_ + +#include + +#define memmove(d,s,c) bcopy(s,d,c) +#define strerror(err) (perror(err),0) + +#endif diff --git a/gcl-tk/tinfo.lsp b/gcl-tk/tinfo.lsp new file mode 100755 index 0000000..41e205c --- /dev/null +++ b/gcl-tk/tinfo.lsp @@ -0,0 +1,588 @@ +;; Copyright (C) 1994 W. Schelter + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; + +(in-package "TK") + + + +(eval-when (compile eval) +(defmacro f (op x y) + `(the ,(if (get op 'compiler::predicate) 't 'fixnum) + (,op (the fixnum ,x) (the fixnum ,y)))) +(defmacro while (test &body body) + `(sloop while ,test do ,@ body)) + +(or (boundp '*info-window*) + (si::aload "info")) +) +(defun simple-listbox (w) + (let ((listbox (conc w '.frame.list)) + (scrollbar(conc w '.frame.scroll))) + (frame (conc w '.frame)) + (scrollbar scrollbar :relief "sunken" :command + (tk-conc w ".frame.list yview")) + (listbox listbox :yscroll (tk-conc w ".frame.scroll set") + :relief "sunken" + :setgrid 1) + (pack scrollbar :side "right" :fill "y") + (pack listbox :side "left" :expand "yes" :fill "both")) + (conc w '.frame)) + + +(defun insert-standard-listbox (w lis &aux print-entry) + (funcall w :delete 0 'end) + (setf (get w 'list) lis) + (setq print-entry (get w 'print-entry)) + (dolist (v lis) + (funcall w :insert 'end + (if print-entry (funcall print-entry v) v)))) + +(defun listbox-move (win key |%y|) + |%y| + (let ((amt (cdr (assoc key '(("Up" . -1) + ("Down" . 1) + ("Next" . 10) + ("Prior" . -10)) + :test 'equal)))) + (cond (amt + (funcall win :yview + (+ (funcall win :nearest 0 :return 'number) amt)))))) + +(defun new-window (name &aux tem) + (cond ((not (fboundp name)) name) + ((winfo :exists name :return 'boolean) + (let ((i 2)) + (while (winfo :exists (setq tem (conc name i )) :return 'boolean) + (setq i (+ i 1))) + tem)) + (t name))) + + +(defun insert-info-choices (listbox list &aux file position-pattern prev) + (funcall listbox :delete 0 'end) + (sloop for i from 0 for name in list + do (setq file nil position-pattern nil) + (progn ;decode name + (cond ((and (consp name) (consp (cdr name))) + (setq file (cadr name) + name (car name)))) + (cond ((consp name) + (setq position-pattern (car name) name (cdr name))))) + (funcall listbox :insert 'end + (format nil "~@[~a :~]~@[(~a)~]~a." + position-pattern + (if (eq file prev) nil (setq prev file)) name))) + (setf (get listbox 'list)list)) + +(defun offer-choices (list info-dirs &optional (w (new-window '.info)) + &aux listbox) + (toplevel w) + (simple-listbox w) + (setq listbox (conc w '.frame.list)) + (insert-info-choices listbox list) + (bind listbox "" + #'(lambda () + (show-info + (nth (atoi (funcall listbox :curselection :return 'string) + 0) + (get listbox 'list))))) + (button (conc w '.ok) :text "Quit " :command `(destroy ',w)) + (frame (conc w '.apro)) + (label(conc w '.apro.label) :text "Apropos: ") + (entry (conc w '.apro.entry) :relief "sunken") + (pack (conc w '.apro.label) (conc w '.apro.entry) :side "left" + :expand "yes") + (pack + (conc w '.frame) (conc w '.ok) + (conc w '.apro) :side "top" :fill "both") + (bind (conc w '.apro.entry) "" + #'(lambda() + (insert-info-choices + listbox + (info-aux (funcall (conc w '.apro.entry) + :get :return 'string) + info-dirs) + ))) + (bind w "" `(focus ',(conc w '.apro.entry))) + w +) + + +(defun get-info-apropos (win file type) + (cond ((and win + (winfo :exists win :return 'boolean)) + (let ((old (get win 'info-data))) + (unless (eq old *current-info-data*) + (setf (get win 'info-data) *current-info-data*) + (funcall (conc win '.frame.list) :delete 0 'end)) + (raise win) + (focus win) + win)) + (t (offer-choices file type nil)))) +(defun show-info-key (win key) + (let ((node (get win 'node)) name) + (or node (info-error "No Node?")) + (setq name (if + (f >= (string-match + (si::string-concatenate key + #u":[ \t]+([^\n\t,]+)[\n\t,]") + (node string node) + (node header node) + (node begin node)) + 0) + (get-match (node string node) 1))) + (if name (show-info name nil)))) +(defun mkinfo (&optional (w '.info_text) &aux textwin menu + ) + (if (winfo :exists w :return 'boolean) (destroy w)) + (toplevel w) + (wm :title w "Info Text Window") + (wm :iconname w "Info") + (frame (setq menu (conc w '.menu )):relief "raised" :borderwidth 1) + (setq textwin (conc w '.t)) + (pack menu :side "top" :fill "x") + (button (conc menu '.quit) :text "Quit" :command + `(destroy ',w)) + + (menubutton (conc menu '.file) :text "File" :relief 'raised + :menu (conc menu '.File '.m) :underline 0) + (menu (conc menu '.file '.m)) + (funcall (conc menu '.file '.m) + :add 'command + :label "Hotlist" + :command '(show-info (tk-conc "("(default-info-hotlist) + ")") + nil)) + (funcall (conc menu '.file '.m) + :add 'command + :label "Add to Hotlist" + :command `(add-to-hotlist ',textwin)) + (funcall (conc menu '.file '.m) + :add 'command + :label "Top Dir" + :command `(show-info "(dir)" nil)) + + (button (conc menu '.next) :text "Next" :relief 'raised + :command `(show-info-key ',textwin "Next")) + (button (conc menu '.prev) :text "Previous" :relief 'raised + :command `(show-info-key ',textwin "Prev")) + (button (conc menu '.up) :text "Up" :relief 'raised + :command `(show-info-key ',textwin "Up")) + (button (conc menu '.info) :text "Info" :relief 'raised + :command `(if (winfo :exists ".info") + (raise '.info) + (offer-choices nil si::*default-info-files*) + )) + (button (conc menu '.last) :text "Last" :relief 'raised + :command `(info-show-history ',textwin 'last)) + (button (conc menu '.history) :text "History" :relief 'raised + :command `(info-show-history ',textwin 'history)) + + (pack (conc menu '.file) + (conc menu '.quit) (conc menu '.next) (conc menu '.prev) + (conc menu '.up) (conc menu '.prev) + (conc menu '.last) (conc menu '.history) (conc menu '.info) + :side "left") +; (entry (conc menu '.entry) :relief "sunken") +; (pack (conc menu '.entry) :expand "yes" :fill "x") + +; (pack (conc menu '.next) +; :side "left") + + + (bind w "" `(focus ',menu)) + +; (tk-menu-bar menu (conc menu '.next) ) +; (bind menu "" "tk_traverseToMenu %W %A") + (scrollbar (conc w '.s) :relief "flat" :command (tk-conc w ".t yview")) + (text textwin :relief "raised" :bd 2 + :setgrid "true" + :state 'disabled) + (funcall textwin :configure + :yscrollcommand + (scroll-set-fix-xref-closure + textwin + (conc w '.s)) + ) + + (bind menu "" `(show-info-key ',textwin "Next")) + (bind menu "" `(show-info-key ',textwin "Up")) + (bind menu "" `(show-info-key ',textwin "Prev")) + (bind menu "" (nth 4(funcall (conc menu '.last) + :configure :command :return + 'list-strings))) + +;; SEARCHING: this needs to be speeded up and fixed. +; (bind (conc menu '.entry) "" +; `(info-text-search ',textwin ',menu %W %A %K)) +; (bind (conc menu '.entry) "" +; `(info-text-search ',textwin ',menu %W %A %K)) + +; (bind menu "" #'(lambda () (focus (menu '.entry)))) + + + + + (pack (conc w '.s) :side 'right :fill "y") + (pack textwin :expand 'yes :fill 'both) + (funcall textwin :mark 'set 'insert 0.0) + (funcall textwin :tag :configure 'bold + :font :Adobe-Courier-Bold-O-Normal-*-120-*) + (funcall textwin :tag :configure 'big :font + :Adobe-Courier-Bold-R-Normal-*-140-*) + (funcall textwin :tag :configure 'verybig :font + :Adobe-Helvetica-Bold-R-Normal-*-240-*) + (funcall textwin :tag :configure 'xref + :font :Adobe-Courier-Bold-O-Normal-*-120-* ) + (funcall textwin :tag :configure 'current_xref + :underline 1 ) + (funcall textwin :tag :bind 'xref "" + "eval [concat %W { tag add current_xref } [get_tag_range %W xref @%x,%y]]") + + (funcall textwin :tag :bind 'xref "" + "%W tag remove current_xref 0.0 end") + (funcall textwin :tag :bind 'xref "<3>" + `(show-this-node ',textwin |%x| |%y|)) + (focus menu) +;; (bind w "" (tk-conc "focus " w ".t")) + ) + + +(defun info-text-search (textwin menu entry a k &aux again + (node (get textwin 'node))) + (or node (tk-error "cant find node index")) +; (print (list entry a k )) + (cond ((equal k "Delete") + (let ((n (funcall entry :index 'insert :return 'number))) + (funcall entry :delete (- n 1)))) + ((>= (string-match "Control" k) 0)) + ((equal a "") (setq again 1)) + ((>= (string-match "[^-]" a) 0) + (funcall entry :insert 'insert a) (setq again 0)) + (t (focus menu) )) + (or again (return-from info-text-search nil)) + (print (list 'begin-search entry a k )) + + (let* ( + (ind (funcall textwin :index 'current :return 'string)) + (pos (index-to-position ind + (node string node) + (node begin node) + (node end node) + + )) + (where + (info-search (funcall entry :get :return 'string) + (+ again (node-offset node) pos)))) + ;; to do mark region in reverse video... + (cond ((>= where 0) + (let ((node (info-node-from-position where))) + (print-node node (- where (node-offset node))))) + (t (funcall entry :flash ))))) + +(defvar *last-history* nil) +(defun print-node (node initial-offset &aux last) +; "print text from node possibly positioning window at initial-offset +;from beginning of node" + + (setq last (list node initial-offset)) + (let ((text '.info_text) textwin tem) + (or (winfo :exists text :return 'boolean) + (mkinfo text)) + (setq + textwin (conc text '.t)) + (funcall textwin :configure :state 'normal) + (cond ((get textwin 'no-record-history) + (remprop textwin 'no-record-history)) + ((setq tem (get textwin 'node)) + (setq *last-history* nil) + (push + (format nil #u"* ~a:\t(~a)~a.\tat:~a" + (node name tem) + (node file tem) + (node name tem) + (funcall textwin :index "@0,0" :return 'string) + ) + (get textwin 'history)))) + (setf (get textwin 'node) node) + (funcall textwin :delete 0.0 'end) + (funcall textwin :mark :set 'insert "1.0") + (cond ((> initial-offset 0) + ;; insert something to separate the beginning of what + ;; we want to show and what goes before. + (funcall textwin :insert "0.0" #u"\n") + (funcall textwin :mark :set 'display_at 'end) + (funcall textwin :mark :set 'insert 'end) + (funcall textwin :yview 'display_at) + (insert-fontified textwin (node string node) + (+ (node begin node) initial-offset) + (node end node)) + (funcall textwin :mark :set 'insert "0.0") + (insert-fontified textwin (node string node) + (node begin node) + (+ (node begin node) initial-offset)) +) + (t + (insert-fontified textwin (node string node) + (node begin node) + (node end node)))) + (funcall textwin :configure :state 'disabled) + (raise text) + textwin + )) + + + +(defun info-show-history (win type) + (let ((his (get win 'history))) + (cond ((stringp type) + (if (f >= (string-match #u":\t([^\t]+)[.]\tat:([0-9.]+)" type) 0) + (let ((pos (get-match type 2)) + (w (show-info (get-match type 1) nil))) + (setf (get win 'no-record-history) t) + (or (equal "1.0" pos) + (funcall w :yview pos))))) + ((eq type 'last) + (info-show-history win (if *last-history* + (pop *last-history*) + (progn (setq *last-history* + (get win 'history)) + (pop *last-history*))))) + ((eq type 'history) + (let* ((w '.info_history) + (listbox (conc w '.frame.list))) + (cond ((winfo :exists w :return 'boolean)) + (t + (toplevel w) + (simple-listbox w) + (button (conc w '.quit) :text "Quit" :command + `(destroy ',w)) + (pack (conc w '.frame) (conc w '.quit) + :expand "yes" :fill 'both) + )) + (insert-standard-listbox listbox his) + (raise w) + (bind listbox "" `(info-show-history + ',listbox + (car (selection :get + :return + 'list-strings))))))))) + + + +(defun show-this-node (textwin x y) + (let ((inds (get_tag_range textwin 'xref "@": x :",": y :return + 'list-strings))) + (cond ((and inds (listp inds) (eql (length inds) 2)) + (show-info (nsubstitute #\space #\newline + (apply textwin :get :return 'string inds)) + nil)) + (t (print inds))))) + +(defun scroll-set-fix-xref-closure (wint wins &aux prev) + #'(lambda (&rest l) + (or (equal l prev) + (progn (setq prev l) + (fix-xref wint) + (apply wins :set l))))) + + +(defvar *recursive* nil) + +;(defun fix-xref-faster (win &aux (all'(" ")) tem) +; (unless +; *recursive* +; (let* ((*recursive* t) s +; (pat #u"\n\\* ([^:\n]+)::|\n\\* [^:\n]+:[ \t]*(\\([^,\n\t]+\\)[^,.\n\t]*)[^\n]?|\n\\* [^:\n]+:[ \t]*([^,(.\n\t]+)[^\n]?") +; (beg (funcall win :index "@0,0 linestart -1 char" :return 'string)) +; (end (funcall win :index "@0,1000 lineend" :return 'string))) +; (cond ((or (f >= (string-match "possible_xref" +; (funcall win :tag :names beg :return 'string)) 0) +; (not (equal "" +; (setq tem (funcall win :tag :nextrange "possible_xref" beg end +; :return 'string))))) +; (if tem (setq beg (car (list-string tem)))) +; (let ((s (funcall win :get beg end :return 'string)) +; (j 0) i) +; (with-tk-command +; (pp "MultipleTagAdd" no_quote) +; (pp win normal) +; (pp "xref" normal) +; (pp beg normal) +; (pp "{" no_quote) +; (while (f >= (string-match pat s j) 0) +; (setq i (if (f >= (match-beginning 1) 0) 1 2)) +; (pp (match-beginning i) no_quote) +; (pp (match-end i) no_quote) +; (setq j (match-end 0)) +; ) +; (pp "}" no_quote) +; (send-tcl-cmd *tk-connection* tk-command nil))) +; (funcall win :tag :remove "possible_xref" beg end) +; ))))) + +(defun fix-xref (win &aux tem) + (unless + *recursive* + (let* ((*recursive* t) + (pat #u"\n\\* ([^:\n]+)::|\n\\* [^:\n]+:[ \t]*(\\([^,\n\t]+\\)[^,.\n\t]*)[^\n]?|\n\\* [^:\n]+:[ \t]*([^,(.\n\t]+)[^\n]?") + (beg (funcall win :index "@0,0 linestart -1 char" :return 'string)) + (end (funcall win :index "@0,1000 lineend" :return 'string))) + (cond ((or (f >= (string-match "possible_xref" + (funcall win :tag :names beg :return 'string)) 0) + (not (equal "" + (setq tem (funcall win :tag :nextrange + "possible_xref" beg end + :return 'string))))) + (if tem (setq beg (car (list-string tem)))) + (let ((s (funcall win :get beg end :return 'string)) + (j 0) i) + (while (f >= (string-match pat s j) 0) + (setq i + (if (f >= (match-beginning 1) 0) 1 + (if (f >= (match-beginning 2) 0) 2 + 3))) + (funcall win :tag :add "xref" + beg : "+" : (match-beginning i) : " chars" + beg : "+" : (match-end i) : " chars") + (setq j (match-end 0)))) + (funcall win :tag :remove "possible_xref" beg end) + ))))) + +(defun insert-fontified (window string beg end) + "set fonts in WINDOW for string with " +; (waiting window) +; (print (list beg end)) + (insert-string-with-regexp + window string beg end + #u"\n([^\n]+)\n[.=_*-][.=*_-]+\n|\\*Note ([^:]+)::" + '((1 section-header) + (2 "xref") + )) + (funcall window :tag :add "possible_xref" "0.0" "end") + (fix-xref window) + (end-waiting window) + ) + +(defun section-header (win string lis &aux (i (car lis))) + (let ((mark 'insert)) + (insert-string win string (match-beginning 0) + (match-end i)) + (funcall win :insert mark #u"\n") + (funcall win :tag :add + (cdr (assoc (aref string (f + (match-end i) 2)) + '((#\= . "verybig") + (#\_ . "big") + (#\- . "big") + (#\. . "bold") + (#\* . "bold") + ))) + "insert - " : (f - (match-end i) (f + (match-beginning i ) -1 )) + : " chars" + "insert -1 chars") + ;;make index count be same.. + (let ((n (f - (f - (match-end 0) + (match-end i)) 1))) + (declare (fixnum n)) + (if (>= n 0) + (funcall win :insert mark (make-string n ))) + ))) + + +(defun insert-string (win string beg end) + (and (> end beg) + (let ((ar (make-array (- end beg) :element-type 'string-char + :displaced-to string :displaced-index-offset beg))) + (funcall win :insert 'insert ar)))) + +(defun insert-string-with-regexp (win string beg end regexp reg-actions + &aux (i 0) temi + (*window* win) *match-data*) + (declare (special *window* *match-data*)) + (declare (fixnum beg end i)) + (while (f >= (string-match regexp string beg end) 0) + (setq i 1) + (setq temi nil) + (loop (or (< i 10) (return nil)) + (cond ((f >= (match-beginning i) 0) + (setq temi (assoc i reg-actions)) + (return nil))) + (setq i (+ i 1))) + (cond ;(t nil) + ((functionp (second temi)) + (insert-string win string beg (match-beginning 0)) + (funcall (second temi) win string temi)) + ((stringp (second temi)) + (insert-string win string beg (match-end 0)) + (dolist + (v (cdr temi)) + (funcall win :tag :add v + "insert -" : (f - (match-end 0) (match-beginning i)) : " chars" + "insert -" :(f - (match-end 0) (match-end i)): " chars" + + ) + )) + (t (info-error "bad regexp prop"))) + (setq beg (match-end 0)) + (or (<= beg end) (error "hi")) + ) + (insert-string win string beg end)) + +(defun count-char (ch string beg end &aux (count 0)) +; "Count the occurrences of CH in STRING from BEG to END" + (declare (character ch)) + (declare (string string)) + (declare (fixnum beg end count)) + (while (< beg end) + (if (eql (aref string beg) ch) (incf count)) + (incf beg)) + count) + +(defun start-of-ith-line (count string beg &optional (end -1)) + (declare (string string)) + (declare (fixnum beg end count)) + (if (< end 0) (setq end (length string))) + (cond ((eql count 1) beg) + (t (decf count) + (while (< beg end) + (if (eql (aref string beg) #\newline) + (progn (decf count) + (incf beg) + (if (<= count 0) (return-from start-of-ith-line beg))) + (incf beg))) + beg))) + +(defun index-to-position (index string beg &optional (end -1) &aux (count 0)) +; "Find INDEX of form \"line.char\" in STRING with 0.0 at BEG and +; up to END. Result is a fixnum string index" + (declare (string string index)) + (declare (fixnum beg end count)) + (if (< end 0) (setq end (length string))) + (let* ((line (atoi index 0)) + (charpos (atoi index (+ 1 (position #\. index))))) + (declare (fixnum line charpos)) + (setq count (start-of-ith-line line string beg end)) + (print (list count charpos)) + (+ count charpos))) + + + +;;; Local Variables: *** +;;; mode:lisp *** +;;; version-control:t *** +;;; comment-column:0 *** +;;; comment-start: ";;; " *** +;;; End: *** + diff --git a/gcl-tk/tk-package.lsp b/gcl-tk/tk-package.lsp new file mode 100755 index 0000000..de8cff4 --- /dev/null +++ b/gcl-tk/tk-package.lsp @@ -0,0 +1,33 @@ +(in-package "TK" :use '("LISP" "SLOOP")) +(in-package "SI") +(import '( +string begin end header name + info-subfile + file tags +end-waiting +si::match-beginning si::idescribe + si::setup-info + si::autoload + si::idescribe + si::*default-info-files* + si::*info-paths* + si::*info-window* + si::info + si::get-match + si::print-node + si::offer-choices + si::match-end si::string-match + si::*case-fold-search* + si::*current-info-data* + si::info-data + si::node + si::info-aux + si::info-error + si::*tk-library* + si::*tk-connection* + si::show-info + si::tkconnect + si::*match-data*) + "TK") + + diff --git a/gcl-tk/tkAppInit.c b/gcl-tk/tkAppInit.c new file mode 100755 index 0000000..976a383 --- /dev/null +++ b/gcl-tk/tkAppInit.c @@ -0,0 +1,112 @@ +/* + * tkAppInit.c -- + * + * Provides a default version of the Tcl_AppInit procedure for + * use in wish and similar Tk-based applications. + * + * Copyright (c) 1993 The Regents of the University of California. + * All rights reserved. + * + * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR + * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT + * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF + * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO + * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. + */ + +/* #ifndef lint */ +/* static char rcsid[] = "/usr/home/gah/repository/blt/tkAppInit.c,v 1.3 1994/04/02 04:37:26 gah Exp SPRITE (Berkeley) $Revision"; */ +/* #endif */ + +#include "tk.h" + +/* + * The following variable is a special hack that allows applications + * to be linked using the procedure "main" from the Tk library. The + * variable generates a reference to "main", which causes main to + * be brought in from the library (and all of Tk and Tcl with it). + */ + +extern int main(); +int *tclDummyMainPtr = (int *) main; + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in interp->result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + Tk_Window mmain; +/* + extern int Blt_Init _ANSI_ARGS_((Tcl_Interp *interp)); +*/ + mmain = Tk_MainWindow(interp); + + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ +/* + if (Blt_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } +*/ + if (Tcl_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + if (Tk_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ + + /* for version tk 3.5: + tcl_RcFileName = "~/.wishrc"; + */ + Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); + return TCL_OK; +} diff --git a/gcl-tk/tkMain.c b/gcl-tk/tkMain.c new file mode 100755 index 0000000..4081161 --- /dev/null +++ b/gcl-tk/tkMain.c @@ -0,0 +1,712 @@ +/* + * main.c -- + * + * This file contains the main program for "wish", a windowing + * shell based on Tk and Tcl. It also provides a template that + * can be used as the basis for main programs for other Tk + * applications. + * + * Copyright (c) 1990-1993 The Regents of the University of California. + * All rights reserved. + * + * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR + * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT + * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF + * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO + * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. + */ + +/* #ifndef lint */ +/* static char rcsid[] = "$Header$ SPRITE (Berkeley)"; */ +/* #endif */ + +#include +#include +#include +#include +#include + + + +#if (TK_MINOR_VERSION==0 && TK_MAJOR_VERSION==4) +#define TkCreateMainWindow Tk_CreateMainWindow +#endif +#if TCL_MAJOR_VERSION >= 8 +#define INTERP_RESULT(interp) Tcl_GetStringResult(interp) +#else +#define INTERP_RESULT(interp) (interp)->result +#endif + + +/*-------------------------------------------------------------------*/ +#include +#include +#include +#include + +int writable_malloc=0; /*FIXME, don't wrap fopen here, exclude notcomp.h or equivalent */ + +#include "guis.h" +struct connection_state *dsfd; +/*-------------------------------------------------------------------*/ + +/* + * Declarations for various library procedures and variables (don't want + * to include tkInt.h or tkConfig.h here, because people might copy this + * file out of the Tk source directory to make their own modified versions). + */ + +/* extern void exit _ANSI_ARGS_((int status)); */ +extern int isatty _ANSI_ARGS_((int fd)); +/* +extern int read _ANSI_ARGS_((int fd, char *buf, size_t size)); +*/ +extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); + +/* + * Global variables used by the main program: + */ + +/* static Tk_Window mainWindow; The main window for the application. If + * NULL then the application no longer + * exists. */ +static Tcl_Interp *interp; /* Interpreter for this application. */ +char *tcl_RcFileName; /* Name of a user-specific startup script + * to source if the application is being run + * interactively (e.g. "~/.wishrc"). Set + * by Tcl_AppInit. NULL means don't source + * anything ever. */ +static Tcl_DString command; /* Used to assemble lines of terminal input + * into Tcl commands. */ +static int tty; /* Non-zero means standard input is a + * terminal-like device. Zero means it's + * a file. */ +static char errorExitCmd[] = "exit 1"; + +/* + * Command-line options: + */ + +static int synchronize = 0; +static char *fileName = NULL; +static char *name = NULL; +static char *display = NULL; +static char *geometry = NULL; +int debug = 0; + +static void guiCreateCommand _ANSI_ARGS_((int idLispObject, int iSlot , char *arglist)); + +void +dfprintf(FILE *fp,char *s,...) { + + va_list args; + + if (debug) { + va_start(args,s); + fprintf(fp,"\nguis:"); + vfprintf(fp,s,args); + fflush(fp); + va_end(args); + } +} + +#define CMD_SIZE 4000 +#define SIGNAL_ERROR TCL_signal_error + +static void +TCL_signal_error(x) + char *x; +{char buf[300] ; + sprintf(buf,"error %s",x); + Tcl_Eval(interp,buf); + dfprintf(stderr,x); +} + + + +static Tk_ArgvInfo argTable[] = { + {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName, + "File from which to read commands"}, + {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry, + "Initial geometry for window"}, + {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display, + "Display to use"}, + {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name, + "Name to use for application"}, + {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, + "Use synchronous mode for display server"}, + {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL, + (char *) NULL} +}; + +/* + * Declaration for Tcl command procedure to create demo widget. This + * procedure is only invoked if SQUARE_DEMO is defined. + */ + +extern int SquareCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char *argv[])); + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void StdinProc _ANSI_ARGS_((ClientData clientData, + int mask)); + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * Main program for Wish. + * + * Results: + * None. This procedure never returns (it exits the process when + * it's done + * + * Side effects: + * This procedure initializes the wish world and then starts + * interpreting commands; almost anything could happen, depending + * on the script being interpreted. + * + *---------------------------------------------------------------------- + */ +/* +int +main(argc, argv) +*/ + +/* FIXME, should come in from tk header or not be called */ +EXTERN Tk_Window TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp * interp, + char * screenName, char * baseName)); + +void +TkX_Wish (argc, argv) + int argc; /* Number of arguments. */ + char **argv; /* Array of argument strings. */ +{ + char *args, *p; + const char *msg; + char buf[20]; + int code; + + interp = Tcl_CreateInterp(); +#ifdef TCL_MEM_DEBUG + Tcl_InitMemory(interp); +#endif + + /* + * Parse command-line arguments. + */ + + if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, (const char **)argv, argTable, 0) + != TCL_OK) { + fprintf(stderr, "%s\n", INTERP_RESULT(interp)); + exit(1); + } + if (name == NULL) { + if (fileName != NULL) { + p = fileName; + } else { + p = argv[0]; + } + name = strrchr(p, '/'); + if (name != NULL) { + name++; + } else { + name = p; + } + } + + /* + * If a display was specified, put it into the DISPLAY + * environment variable so that it will be available for + * any sub-processes created by us. + */ + + if (display != NULL) { + Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); + } + + /* + * Initialize the Tk application. + */ + +/* mainWindow = TkCreateMainWindow(interp, display, name/\* , "Tk" *\/); */ +/* if (mainWindow == NULL) { */ +/* fprintf(stderr, "%s\n", INTERP_RESULT(interp)); */ +/* exit(1); */ +/* } */ +/* #ifndef __MINGW32__ */ +/* if (synchronize) { */ +/* XSynchronize(Tk_Display(mainWindow), True); */ +/* } */ +/* #endif */ +/* Tk_GeometryRequest(mainWindow, 200, 200); */ +/* Tk_UnmapWindow(mainWindow); */ + + /* + * Make command-line arguments available in the Tcl variables "argc" + * and "argv". Also set the "geometry" variable from the geometry + * specified on the command line. + */ + + args = Tcl_Merge(argc-1, (const char **)argv+1); + Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); + ckfree(args); + sprintf(buf, "%d", argc-1); + Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0], + TCL_GLOBAL_ONLY); + if (geometry != NULL) { + Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY); + } + + /* + * Set the "tcl_interactive" variable. + */ + + tty = isatty(dsfd->fd); + Tcl_SetVar(interp, "tcl_interactive", + ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); + + /* + * Add a few application-specific commands to the application's + * interpreter. + */ + +/* #ifdef SQUARE_DEMO */ +/* Tcl_CreateCommand(interp, "square", SquareCmd, (ClientData) mainWindow, */ +/* (void (*)()) NULL); */ +/* #endif */ + + /* + * Invoke application-specific initialization. + */ + + if (Tcl_AppInit(interp) != TCL_OK) { + fprintf(stderr, "Tcl_AppInit failed: %s\n", INTERP_RESULT(interp)); + } + + /* + * Set the geometry of the main window, if requested. + */ + + if (geometry != NULL) { + code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL); + if (code != TCL_OK) { + fprintf(stderr, "%s\n", INTERP_RESULT(interp)); + } + } + + /* + * Invoke the script specified on the command line, if any. + */ + + if (fileName != NULL) { + code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL); + if (code != TCL_OK) { + goto error; + } + tty = 0; + } else { + /* + * Commands will come from standard input, so set up an event + * handler for standard input. If the input device is aEvaluate the + * .rc file, if one has been specified, set up an event handler + * for standard input, and print a prompt if the input + * device is a terminal. + */ + + if (tcl_RcFileName != NULL) { + Tcl_DString buffer; + char *fullName; + FILE *f; + + fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer); + if (fullName == NULL) { + fprintf(stderr, "%s\n", INTERP_RESULT(interp)); + } else { + f = fopen(fullName, "r"); + if (f != NULL) { + code = Tcl_EvalFile(interp, fullName); + if (code != TCL_OK) { + fprintf(stderr, "%s\n", INTERP_RESULT(interp)); + } + fclose(f); + } + } + Tcl_DStringFree(&buffer); + } + + dfprintf(stderr, "guis : Creating file handler for %d\n", dsfd->fd); +#ifndef __MINGW32__ + Tk_CreateFileHandler(dsfd->fd, TK_READABLE, StdinProc, (ClientData) 0); +#endif + } + fflush(stdout); + Tcl_DStringInit(&command); + + /* + * Loop infinitely, waiting for commands to execute. When there + * are no windows left, Tk_MainLoop returns and we exit. + */ + + Tk_MainLoop(); + + /* + * Don't exit directly, but rather invoke the Tcl "exit" command. + * This gives the application the opportunity to redefine "exit" + * to do additional cleanup. + */ + + Tcl_Eval(interp, "exit"); + exit(1); + +error: + msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + if (msg == NULL) { + msg = INTERP_RESULT(interp); + } + dfprintf(stderr, "%s\n", msg); + Tcl_Eval(interp, errorExitCmd); + return; /* Needed only to prevent compiler warnings. */ +} + +static char *being_set_by_lisp; + +static char * +tell_lisp_var_changed( + clientData, + interp, + name1, + name2, + flags) + + ClientData clientData; + Tcl_Interp *interp; + char *name1; + char *name2; + int flags; + +{ + + if (being_set_by_lisp == 0) + { const char *val = Tcl_GetVar2(interp,name1,name2, TCL_GLOBAL_ONLY); + char buf[3]; + STORE_3BYTES(buf,(long) clientData); + if(sock_write_str2(dsfd, m_set_lisp_loc, buf, 3 , + val, strlen(val)) + < 0) + { /* what do we want to do if the write failed */} +#ifndef __MINGW32__ + if (parent > 0) kill(parent, SIGUSR1); +#endif + } + else + /* avoid going back to lisp if it is lisp that is doing the setting! */ + if (strcmp(being_set_by_lisp,name1)) + { fprintf(stderr,"recursive setting of vars %s??",name1);} + /* normal */ + return 0; +} + + +/* + *---------------------------------------------------------------------- + * + * StdinProc -- + * + * This procedure is invoked by the event dispatcher whenever + * standard input becomes readable. It grabs the next line of + * input characters, adds them to a command being assembled, and + * executes the command if it's complete. + * + * Results: + * None. + * + * Side effects: + * Could be almost arbitrary, depending on the command that's + * typed. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +StdinProc(clientData, mask) + ClientData clientData; /* Not used. */ + int mask; /* Not used. */ +{ + int fNotDone; + char *cmd; + int code, count; + struct message_header *msg; + char buf[0x4000]; + msg = (struct message_header *) buf; + + /* + * Disable the stdin file handler while evaluating the command; + * otherwise if the command re-enters the event loop we might + * process commands from stdin before the current command is + * finished. Among other things, this will trash the text of the + * command being evaluated. + */ + dfprintf(stderr, "\nguis : Disabling file handler for %d\n", dsfd->fd); + +/* Tk_CreateFileHandler(dsfd->fd, 0, StdinProc, (ClientData) 0); */ + + do + { + + msg = guiParseMsg1(dsfd,buf,sizeof(buf)); + + if (msg == NULL) + { + /*dfprintf(stderr, "Yoo !!! Empty command\n"); */ + if (debug)perror("zero message"); +#ifndef __MINGW32__ + Tk_CreateFileHandler(dsfd->fd, TK_READABLE, StdinProc, (ClientData) 0); +#endif + return; + } + + /* Need to switch to table lookup */ + switch (msg->type){ + case m_create_command: + { + int iSlot; + GET_3BYTES(msg->body,iSlot); + guiCreateCommand(0, iSlot, &(msg->body[3])); + } + break; + case m_tcl_command : + case m_tcl_command_wait_response: + count = strlen(msg->body); + cmd = Tcl_DStringAppend(&command, msg->body, count); + + code = Tcl_RecordAndEval(interp, cmd, 0); + + if (msg->type == m_tcl_command_wait_response + || code) + { + char buf[4]; + char *p = buf, *string; + /*header */ + *p++ = (code ? '1' : '0'); + bcopy(msg->msg_id,p,3); + /* end header */ + string = (char *)INTERP_RESULT(interp); + if(sock_write_str2(dsfd, m_reply, buf, 4, string, strlen(string)) + < 0) + { /* what do we want to do if the write failed */} + + if (msg->type == m_tcl_command_wait_response) + { /* parent is waiting so dong signal */ ;} +#ifndef __MINGW32__ + else + if (parent> 0)kill(parent, SIGUSR1); +#endif + } + + Tcl_DStringFree(&command); + break; + case m_tcl_clear_connection: + /* we are stuck... */ + { + Tcl_DStringInit(&command); + Tcl_DStringFree(&command); + fSclear_connection(dsfd->fd); + } + break; + case m_tcl_set_text_variable: + { int n = strlen(msg->body); + if(being_set_by_lisp) fprintf(stderr,"recursive set?"); + /* avoid a trace on this set!! */ + + being_set_by_lisp = msg->body; + Tcl_SetVar2(interp,msg->body,0,msg->body+n+1, + TCL_GLOBAL_ONLY); + being_set_by_lisp = 0; + } + break; + + case m_tcl_link_text_variable: + {long i; + GET_3BYTES(msg->body,i); + Tcl_TraceVar2(interp,msg->body+3 ,0, + TCL_TRACE_WRITES + | TCL_TRACE_UNSETS + | TCL_GLOBAL_ONLY + , tell_lisp_var_changed, (ClientData) i); + } + break; + + case m_tcl_unlink_text_variable: + {long i; + GET_3BYTES(msg->body,i); + Tcl_UntraceVar2(interp,msg->body+3 ,0, + TCL_TRACE_WRITES + | TCL_TRACE_UNSETS + | TCL_GLOBAL_ONLY + , tell_lisp_var_changed, (ClientData) i); + } + break; + + default : + dfprintf(stderr, "Error !!! Unknown command %d\n" + , msg->type); + } + fNotDone = fix(fScheck_dsfd_for_input(dsfd,0)); + + if (fNotDone > 0) + { + dfprintf(stderr, "\nguis : in StdinProc, not done, executed %s" + , msg->body); + + } + } while (fNotDone > 0); + + + /* Tk_CreateFileHandler(dsfd->fd, TK_READABLE, StdinProc, (ClientData) 0); */ + if ((void *)msg != (void *) buf) + free ((void *) msg); +} + +/* ----------------------------------------------------------------- */ +typedef struct _ClientDataLispObject { + int id; + int iSlot; + char *arglist; +} ClientDataLispObject; + +static int +TclGenericCommandProcedure( clientData, + pinterp, + argc, argv) + ClientData clientData; + Tcl_Interp *pinterp; + int argc; + char *argv[]; +{ + char szCmd[CMD_SIZE]; + ClientDataLispObject *pcdlo = (ClientDataLispObject *)clientData; + int cb=0; + char *q = szCmd; + char *p = pcdlo->arglist; + + STORE_3BYTES(q,(pcdlo->iSlot)); + q += 3; + if (p == 0) + { char *arg = (argc > 1 ? argv[1] : ""); + int m = strlen(arg); + if (m > CMD_SIZE -50) + SIGNAL_ERROR("too big command"); + bcopy(arg,q,m); + q += m ;} + else + { int i,n; + *q++ = '('; + n = strlen(p); + for (i=1; i< argc; i++) + { if (i < n && p[i]=='s') { *q++ = '"';} + strcpy(q,argv[i]); + q+= strlen(argv[i]); + if (i < n && p[i]=='s') { *q++ = '"';} + } + *q++ = ')'; + } + *q = 0; + + dfprintf(stderr, "TclGenericCommandProcedure : %s\n" + , szCmd + ); + + if (sock_write_str2(dsfd,m_call, "",0, szCmd, q-szCmd) == -1) + { + dfprintf(stderr, + "Error\t(TclGenericCommandProcedure) !!!\n\tFailed to write [%s] to socket %d (%d) cb=%d\n" + , szCmd, dsfd->fd, errno, cb); + + } +#ifndef __MINGW32__ + if (parent > 0)kill(parent, SIGUSR1); +#endif + return TCL_OK; +} + + + +static void +guiCreateCommand( idLispObject, iSlot , arglist) + int idLispObject; int iSlot ; char *arglist; +{ + char szNameCmdProc[2000],*c; + ClientDataLispObject *pcdlo; + + sprintf(szNameCmdProc, "callback_%d",iSlot); + + pcdlo = (ClientDataLispObject *)malloc(sizeof(ClientDataLispObject)); + pcdlo->id = idLispObject; + pcdlo->iSlot = iSlot; + if (arglist[0] == 0) + { pcdlo->arglist = 0;} + else + {c= malloc(strlen(arglist)+1); + strcpy(c,arglist); + pcdlo->arglist = c;} + Tcl_CreateCommand(interp + , szNameCmdProc, TclGenericCommandProcedure + , (ClientData *)pcdlo, free); + dfprintf(stderr, "TCL creating callback : %s\n", szNameCmdProc); + +/* guiBindCallback(szNameCmdProc, szTclObject, szModifier,arglist); */ +} + +/* +int +guiBindCallback(char *szNameCmdProc, char *szTclObject, char *szModifier,char* arglist) +{ + int code; + char szCmd[2000]; + + sprintf(szCmd, "bind %s %s {%s %s}" + , szTclObject + , szModifier + , szNameCmdProc + , (arglist ? arglist : "") + ); + dfprintf(stderr, "TCL BIND : %s\n", szCmd); + + code = Tcl_Eval(interp, szCmd); + if (code != TCL_OK) + { + dfprintf(stderr, "TCL Error int bind : %s\n", INTERP_RESULT(interp)); + + } + return code; +} +*/ +/* static void */ +/* guiDeleteCallback(szCallback) */ +/* char *szCallback; */ +/* { */ +/* dfprintf(stderr, "Tcl Deleting command : %s\n", szCallback); */ + +/* Tcl_DeleteCommand(interp, szCallback); */ +/* } */ + +/* */ + diff --git a/gcl-tk/tkXAppInit.c b/gcl-tk/tkXAppInit.c new file mode 100755 index 0000000..cc4743a --- /dev/null +++ b/gcl-tk/tkXAppInit.c @@ -0,0 +1,131 @@ +/* + * tkXAppInit.c -- + * + * Provides a default version of the Tcl_AppInit procedure for use with + * applications built with Extended Tcl and Tk. This is based on the + * the UCB Tk file tkAppInit.c + * + *----------------------------------------------------------------------------- + * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans. + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, provided + * that the above copyright notice appear in all copies. Karl Lehenbauer and + * Mark Diekhans make no representations about the suitability of this + * software for any purpose. It is provided "as is" without express or + * implied warranty. + *----------------------------------------------------------------------------- + * $Id$ + *----------------------------------------------------------------------------- + * Copyright (c) 1993 The Regents of the University of California. + * All rights reserved. + * + * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR + * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT + * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF + * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO + * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. + */ + +#ifndef lint +static char rcsid[] = "$Header$ SPRITE (Berkeley)"; +#endif /* not lint */ + +#include "tclExtend.h" +#include "tk.h" +#include + +/* + * The following variable is a special hack that allows applications + * to be linked using the procedure "main" from the Tk library. The + * variable generates a reference to "main", which causes main to + * be brought in from the library (and all of Tk and Tcl with it). + */ + +EXTERN int main _ANSI_ARGS_((int argc, + char **argv)); +int *tclDummyMainPtr = (int *) main; + +/* + * The following variable is a special hack that insures the tcl + * version of matherr() is used when linking against shared libraries + * Only define if matherr is used on this system. + */ + +#if defined(DOMAIN) && defined(SING) +EXTERN int matherr _ANSI_ARGS_((struct exception *)); +int *tclDummyMathPtr = (int *) matherr; +#endif + + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in interp->result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + Tk_Window main; + + main = Tk_MainWindow(interp); + + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ + + if (TclX_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + if (TkX_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ + + tcl_RcFileName = "~/.tclrc"; + return TCL_OK; +} diff --git a/gcl-tk/tkXshell.c b/gcl-tk/tkXshell.c new file mode 100755 index 0000000..4ba1202 --- /dev/null +++ b/gcl-tk/tkXshell.c @@ -0,0 +1,445 @@ +/* + * tkXshell.c + * + * Version of Tk main that is modified to build a wish shell with the Extended + * Tcl command set and libraries. This makes it easier to use a different + * main. + *----------------------------------------------------------------------------- + * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans. + * + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, provided + * that the above copyright notice appear in all copies. Karl Lehenbauer and + * Mark Diekhans make no representations about the suitability of this + * software for any purpose. It is provided "as is" without express or + * implied warranty. + *----------------------------------------------------------------------------- + * $Id$ + *----------------------------------------------------------------------------- + */ + +/* + * main.c -- + * + * This file contains the main program for "wish", a windowing + * shell based on Tk and Tcl. It also provides a template that + * can be used as the basis for main programs for other Tk + * applications. + * + * Copyright (c) 1990-1993 The Regents of the University of California. + * All rights reserved. + * + * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR + * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT + * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF + * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO + * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. + */ + +#ifdef __cplusplus +# include "tcl++.h" +# include +#else +# include "tclExtend.h" +#endif + +#include "tk.h" + +/*-------------------------------------------------------------------*/ +#include +#include +#include + +int sock_write( int connection, const char *text, int length ); +int sock_read( int connection, char *buffer, int max_len ); + +extern int hdl; +extern pid_t parent; +/*-------------------------------------------------------------------*/ + +/* + * Declarations for various library procedures and variables (don't want + * to include tkInt.h or tkConfig.h here, because people might copy this + * file out of the Tk source directory to make their own modified versions). + */ + +extern void exit _ANSI_ARGS_((int status)); +extern int isatty _ANSI_ARGS_((int fd)); +/* +extern int read _ANSI_ARGS_((int fd, char *buf, size_t size)); +*/ +extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); + +/* + * Global variables used by the main program: + */ + +static Tk_Window mainWindow; /* The main window for the application. If + * NULL then the application no longer + * exists. */ +static Tcl_Interp *interp; /* Interpreter for this application. */ +char *tcl_RcFileName ; /* Name of a user-specific startup script + * to source if the application is being run + * interactively (e.g. "~/.wishrc"). Set + * by Tcl_AppInit. NULL means don't source + * anything ever. */ +static Tcl_DString command; /* Used to assemble lines of terminal input + * into Tcl commands. */ +static int gotPartial = 0; /* Partial command in buffer. */ +static int tty; /* Non-zero means standard input is a + * terminal-like device. Zero means it's + * a file. */ +static char exitCmd[] = "exit"; +static char errorExitCmd[] = "exit 1"; + +/* + * Command-line options: + */ + +static int synchronize = 0; +static char *fileName = NULL; +static char *name = NULL; +static char *display = NULL; +static char *geometry = NULL; + +static Tk_ArgvInfo argTable[] = { + {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName, + "File from which to read commands"}, + {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry, + "Initial geometry for window"}, + {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display, + "Display to use"}, + {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name, + "Name to use for application"}, + {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, + "Use synchronous mode for display server"}, + {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL, + (char *) NULL} +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static void StdinProc _ANSI_ARGS_((ClientData clientData, + int mask)); +static void SignalProc _ANSI_ARGS_((int signalNum)); + +/* + *---------------------------------------------------------------------- + * + * TkX_Wish -- + * + * Main program for Wish. + * + * Results: + * None. This procedure never returns (it exits the process when + * it's done + * + * Side effects: + * This procedure initializes the wish world and then starts + * interpreting commands; almost anything could happen, depending + * on the script being interpreted. + * + *---------------------------------------------------------------------- + */ + +void +TkX_Wish (argc, argv) + int argc; /* Number of arguments. */ + char **argv; /* Array of argument strings. */ +{ + char *args, *p, *msg; + char buf[20]; + int code; + + interp = Tcl_CreateInterp(); +#ifdef TCL_MEM_DEBUG + Tcl_InitMemory(interp); +#endif + + /* + * Parse command-line arguments. + */ + + if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0) + != TCL_OK) { + fprintf(stderr, "%s\n", interp->result); + exit(1); + } + if (name == NULL) { + if (fileName != NULL) { + p = fileName; + } else { + p = argv[0]; + } + name = strrchr(p, '/'); + if (name != NULL) { + name++; + } else { + name = p; + } + } + + /* + * If a display was specified, put it into the DISPLAY + * environment variable so that it will be available for + * any sub-processes created by us. + */ + + if (display != NULL) { + Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); + } + + /* + * Set the "tcl_interactive" variable. + */ + tty = isatty(hdl); + Tcl_SetVar(interp, "tcl_interactive", + ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); + + tty = isatty(hdl); + + /* + * Initialize the Tk application. + */ + + mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk"); + if (mainWindow == NULL) { + fprintf(stderr, "%s\n", interp->result); + exit(1); + } + Tk_SetClass(mainWindow, "Tk"); + if (synchronize) { + XSynchronize(Tk_Display(mainWindow), True); + } + Tk_GeometryRequest(mainWindow, 200, 200); + + /* + * Make command-line arguments available in the Tcl variables "argc" + * and "argv". Also set the "geometry" variable from the geometry + * specified on the command line. + */ + + args = Tcl_Merge(argc-1, argv+1); + Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); + ckfree(args); + sprintf(buf, "%d", argc-1); + Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0], + TCL_GLOBAL_ONLY); + if (geometry != NULL) { + Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY); + } + + /* + * Invoke application-specific initialization. + */ + + if (Tcl_AppInit(interp) != TCL_OK) { + TclX_ErrorExit (interp, 255); + } + + /* + * Set the geometry of the main window, if requested. + */ + + if (geometry != NULL) { + code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL); + if (code != TCL_OK) { + fprintf(stderr, "%s\n", interp->result); + } + } + + /* + * Invoke the script specified on the command line, if any. + */ + + if (fileName != NULL) { + code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL); + if (code != TCL_OK) { + goto error; + } + tty = 0; + } else { + TclX_EvalRCFile (interp); + + /* + * Commands will come from standard input. Set up a handler + * to receive those characters and print a prompt if the input + * device is a terminal. + */ + tclErrorSignalProc = SignalProc; + Tk_CreateFileHandler(hdl, TK_READABLE, StdinProc, (ClientData) 0); + if (tty) { + TclX_OutputPrompt (interp, 1); + } + } + tclSignalBackgroundError = Tk_BackgroundError; + + fflush(stdout); + Tcl_DStringInit(&command); + + /* + * Loop infinitely, waiting for commands to execute. When there + * are no windows left, Tk_MainLoop returns and we exit. + */ + + Tk_MainLoop(); + + /* + * Don't exit directly, but rather invoke the Tcl "exit" command. + * This gives the application the opportunity to redefine "exit" + * to do additional cleanup. + */ + + Tcl_GlobalEval(interp, exitCmd); + exit(1); + +error: + msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + if (msg == NULL) { + msg = interp->result; + } + fprintf(stderr, "%s\n", msg); + Tcl_GlobalEval(interp, errorExitCmd); + exit (1); +} + +/* + *---------------------------------------------------------------------- + * + * SignalProc -- + * + * Function called on a signal generating an error to clear the stdin + * buffer. + *---------------------------------------------------------------------- + */ + +static void +SignalProc (signalNum) + int signalNum; +{ + tclGotErrorSignal = 0; + Tcl_DStringFree (&command); + gotPartial = 0; + if (tty) { + fputc ('\n', stdout); + TclX_OutputPrompt (interp, !gotPartial); + } +} + +/* + *---------------------------------------------------------------------- + * + * StdinProc -- + * + * This procedure is invoked by the event dispatcher whenever + * standard input becomes readable. It grabs the next line of + * input characters, adds them to a command being assembled, and + * executes the command if it's complete. + * + * Results: + * None. + * + * Side effects: + * Could be almost arbitrary, depending on the command that's + * typed. + * + *---------------------------------------------------------------------- + */ + +#define BUFFER_SIZE 4000 + +static void +StdinProc(clientData, mask) + ClientData clientData; /* Not used. */ + int mask; /* Not used. */ +{ + char input[BUFFER_SIZE+1]; + char *cmd; + int code, count; + + count = read(hdl, input, BUFFER_SIZE); + if (count <= 0) + { + if (!gotPartial) + { + if (tty) + { + Tcl_VarEval(interp, "exit", (char *) NULL); + exit(1); + } + else + { + Tk_DeleteFileHandler(hdl); + } + return; + } + else + { + count = 0; + } + } + cmd = Tcl_DStringAppend(&command, input, count); + + fprintf(stderr, "TK command : %s\n", cmd); + fflush(stderr); + + if (count != 0) + { + if ((input[count-1] != '\n') && (input[count-1] != ';')) + { + gotPartial = 1; + goto exitPoint; + } + if (!Tcl_CommandComplete(cmd)) + { + fprintf(stderr, "Partial command\n", cmd); + fflush(stderr); + + gotPartial = 1; + goto exitPoint; + } + } + gotPartial = 0; + +/* +* Disable the stdin file handler; otherwise if the command +* re-enters the event loop we might process commands from +* stdin before the current command is finished. Among other +* things, this will trash the text of the command being evaluated. +*/ + + Tk_CreateFileHandler(hdl, 0, StdinProc, (ClientData) 0); + code = Tcl_RecordAndEval(interp, cmd, 0); + Tk_CreateFileHandler(hdl, TK_READABLE, StdinProc, (ClientData) 0); + if (tty) + TclX_PrintResult (interp, code, cmd); + else + { + char buf[1024]; + sprintf(buf, "%d %s", code, interp->result); + sock_write(hdl, buf, strlen(buf)); + kill(parent, SIGUSR1); + } + Tcl_DStringFree(&command); + + exitPoint: + if (tty) + { + TclX_OutputPrompt (interp, !gotPartial); + } +} + diff --git a/gcl-tk/tkl.lisp b/gcl-tk/tkl.lisp new file mode 100755 index 0000000..f8fdee1 --- /dev/null +++ b/gcl-tk/tkl.lisp @@ -0,0 +1,1559 @@ +;; Copyright (C) 1994 W. Schelter + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; + + + +(eval-when (load eval compile) +(in-package "TK") +) + +(eval-when (compile) +(proclaim '(ftype (function (t fixnum fixnum) fixnum) set-message-header + get-number-string)) +(proclaim '(ftype (function (t t fixnum) t) store-circle)) +(proclaim '(ftype (function (t fixnum) t) get-circle)) +(proclaim '(ftype (function (t fixnum fixnum fixnum) fixnum) + push-number-string)) +) + +(defvar *tk-package* (find-package "TK")) + +(eval-when (compile eval load) + +(defconstant *header* '(magic1 magic2 type flag body-length nil nil msg-index nil nil)) + +;;enum print_arglist_codes {..}; +(defvar *print-arglist-codes* + '( + normal + no_leading_space + join_follows + end_join + begin_join + begin_join_no_leading_space + no_quote + no_quote_no_leading_space + no_quote_downcase + no_quotes_and_no_leading_space + + )) + +(defconstant *mtypes* + '( m_not_used + m_create_command + m_reply + m_call + m_tcl_command + m_tcl_command_wait_response + m_tcl_clear_connection + m_tcl_link_text_variable + m_set_lisp_loc + m_tcl_set_text_variable + m_tcl_unlink_text_variable + m_lisp_eval + m_lisp_eval_wait_response + )) + +(defconstant *magic1* #\) +(defconstant *magic2* #\A) + + +(defvar *some-fixnums* (make-array 3 :element-type 'fixnum)) +(defmacro msg-index () `(the fixnum + (aref (the (array fixnum) *some-fixnums*) 0))) +;;; (defmacro safe-car (x) +;;; (cond ((symbolp x) `(if (consp ,x) (car ,x) (if (null ,x) nil +;;; (not-a-cons ,x)))) +;;; (t (let ((sym (gensym))) +;;; `(let ((,sym ,x)) +;;; (safe-car ,sym)))))) +;;; (defmacro safe-cdr (x) +;;; (cond ((symbolp x) `(if (consp ,x) (cdr ,x) (if (null ,x) nil +;;; (not-a-cons ,x)))) +;;; (t (let ((sym (gensym))) +;;; `(let ((,sym ,x)) +;;; (safe-cdr ,sym)))))) + + +(defun desetq-consp-check (val) + (or (consp val) (error "~a is not a cons" val))) + +(defun desetq1 (form val) + (cond ((symbolp form) + (cond (form ;(push form *desetq-binds*) + `(setf ,form ,val)))) + ((consp form) + `(progn + (desetq-consp-check ,val) + ,(desetq1 (car form) `(car ,val)) + ,@ (if (consp (cdr form)) + (list(desetq1 (cdr form) `(cdr ,val))) + (and (cdr form) `((setf ,(cdr form) (cdr ,val))))))) + (t (error "")))) + +(defmacro desetq (form val) + (cond ((atom val) (desetq1 form val)) + (t (let ((value (gensym))) + `(let ((,value ,val)) , (desetq1 form value)))))) +(defmacro while (test &body body) + `(sloop while ,test do ,@ body)) + +) + +(defmacro nth-value (n form) + `(multiple-value-bind ,(make-list (+ n 1) :initial-element 'a) ,form a)) + +(defvar *tk-command* nil) + +(defvar *debugging* nil) +(defvar *break-on-errors* nil) + +(defvar *tk-connection* nil ) + +;; array of functions to be invoked from lisp. +(defvar *call-backs* (make-array 20 :fill-pointer 0 :adjustable t )) + +;;array of message half read. Ie read header but not body. +(defvar *pending* nil) + +;;circular array for replies,requests esp for debugging +;; replies is used for getting replies. +(defvar *replies* (make-array (expt 2 7)) "circle of replies to requests in *requests*") + +;; these are strings +(defvar *requests* (make-array (expt 2 7))) + +;; these are lisp forms +(defvar *request-forms* (make-array 40)) + + +(defvar *read-buffer* (make-array 400 :element-type 'standard-char + :fill-pointer 0 :static t)) + +(defvar *text-variable-locations* + (make-array 10 :fill-pointer 0 :adjustable t)) + + + + +(defmacro pos (flag lis) + (or + (member flag (symbol-value lis)) + (error "~a is not in ~a" flag lis)) + (position flag (symbol-value lis))) + + + + + +;;; (defun p1 (a &aux tem) +;;; ;;Used for putting A into a string for sending a command to TK +;;; (cond +;;; ((and (symbolp a) (setq tem (get a 'tk-print))) +;;; (format *tk-command* tem)) +;;; ((keywordp a) +;;; (format *tk-command* "-~(~a~)" a)) +;;; ((numberp a) +;;; (format *tk-command* "~a" a)) +;;; ((stringp a) +;;; (format *tk-command* "\"~a\"" a)) +;;; ((and (consp a)(eq (car a) 'a)) +;;; (format *tk-command* "~a" (cdr a))) +;;; ((and (consp a)(eq (car a) 'd)) +;;; (format *tk-command* "~(~a~)" (cdr a))) +;;; ((and (symbolp a) +;;; (eql (aref (symbol-name a) 0) +;;; #\.)) +;;; (format *tk-command* "~(~a~)" a)) +;;; (t (error "unrecognized term ~s" a)))) + + +(defvar *command-strings* + (sloop for i below 2 collect + (make-array 200 :element-type 'standard-char :fill-pointer 0 :adjustable t))) + +(defvar *string-streams* (list (make-string-input-stream "") (make-string-input-stream ""))) + +(defmacro with-tk-command (&body body) + `(let (tk-command (*command-strings* *command-strings*)) + (declare (type string tk-command)) + (setq tk-command (grab-tk-command)) + ,@ body)) + +(defun grab-tk-command( &aux x) + ;; keep a list of available *command-strings* and grab one + (cond + ((cdr *command-strings*)) + (t + (setq x (list (make-array 70 + :element-type 'standard-char + :fill-pointer 0 :adjustable t)) + ) + (or *command-strings* (error "how??")) + + (setq *command-strings* (nconc *command-strings* x)))) + (let ((x (car *command-strings*))) + (setq *command-strings* (cdr *command-strings*)) + (setf (fill-pointer x ) #.(length *header*)) + x + )) + +(defun print-to-string (str x code) + (cond ((consp x) + (cond ((eq (car x) 'a) + (setq x (cdr x) + code (pos no_quote *print-arglist-codes*))) + ((eq (car x) 'd) + (setq x (cdr x) + code (pos no_quote_downcase *print-arglist-codes*))) + (t (error "bad arg ~a" x))))) + (while (null (si::print-to-string1 str x code)) + (cond ((typep x 'bignum) + (setq x (format nil "~a" x))) + (t (setq str (adjust-array str + (the fixnum + (+ (the fixnum + (array-total-size str)) + (the fixnum + (+ + (if (stringp x) + (length (the string x)) + 0) + 70)))) + :fill-pointer (fill-pointer str) + :element-type 'string-char))))) + str) + +(defmacro pp (x code) + (let ((u `(pos ,code *print-arglist-codes*))) + `(print-to-string tk-command ,x ,u))) + +(defun print-arglist (to-string l &aux v in-join x) +;; (sloop for v in l do (p :| | v)) + (while l + (setq v (cdr l)) + (setq x (car l)) + (cond + ((eql (car v) ': ) + (print-to-string to-string x + (if in-join + (pos join_follows *print-arglist-codes*) + (pos begin_join *print-arglist-codes*))) + (setq in-join t) + (setq v (cdr v))) + (in-join + (print-to-string to-string x (pos end_join *print-arglist-codes*)) + (setq in-join nil)) + (t;; code == (pos normal *print-arglist-codes*) + (print-to-string to-string x (pos normal *print-arglist-codes*)))) + + (setq l v) + )) + +(defmacro p (&rest l) + `(progn ,@ (sloop for v in l collect `(p1 ,v)))) + +(defvar *send-and-wait* nil "If not nil, then wait for answer and check result") + +(defun tk-call (fun &rest l &aux result-type) + (with-tk-command + (pp fun no_leading_space) + (setq result-type (prescan-arglist l nil nil)) + (print-arglist tk-command l) + (cond (result-type + (call-with-result-type tk-command result-type)) + (t (send-tcl-cmd *tk-connection* tk-command nil) + (values))))) + +(defun tk-do (str &rest l &aux ) + (with-tk-command + (pp str no_quotes_and_no_leading_space) + ;; leading keyword printed without '-' at beginning. + (while l + (pp (car l) no_quotes_and_no_leading_space) + (setq l (cdr l))) + (call-with-result-type tk-command 'string))) + +(defun tk-do-no-wait (str &aux (n (length str))) + (with-tk-command + (si::copy-array-portion str tk-command 0 #.(length *header*) n) + (setf (fill-pointer tk-command) (the fixnum (+ n #.(length *header*)))) + (let () + (send-tcl-cmd *tk-connection* tk-command nil)))) + +(defun fsubseq (s &optional (b 0) (e (length s))) + (make-array (- e b) :element-type (array-element-type s) :displaced-to s :displaced-index-offset b :fill-pointer (- e b))) + +(defun send-tcl-cmd (c str send-and-wait ) + ;(notice-text-variables) + (or send-and-wait (setq send-and-wait *send-and-wait*)) + ; (setq send-and-wait t) + (vector-push-extend (code-char 0) str) + (let ((msg-id (set-message-header str + (if send-and-wait + (pos m_tcl_command_wait_response *mtypes*) + (pos m_tcl_command *mtypes*)) + (the fixnum + (- (length str) + #.(length *header*)))))) + + (cond (send-and-wait + (if *debugging* + (store-circle *requests* (fsubseq str #.(length *header*)) + msg-id)) + (store-circle *replies* nil msg-id) + (execute-tcl-cmd c str)) + (t (store-circle *requests* nil msg-id) + (write-to-connection c str))))) + + +(defun send-tcl-create-command (c str) + (vector-push-extend (code-char 0) str) + (set-message-header str (pos m_create_command *mtypes*) + (- (length str) #.(length *header*))) + (write-to-connection c str)) + +(defun write-to-connection (con string &aux tem) + (let* ((*sigusr1* t) + ;; dont let us get interrupted while writing!! + (n (length string)) + (fd (caar con)) + (m 0)) + (declare (Fixnum n m)) + (or con (error "Trying to write to non open connection ")) + (if *debugging* (describe-message string)) + (or (typep fd 'string) + (error "~a is not a connection" con)) + (setq m (si::our-write fd string n)) + (or (eql m n) (error "Failed to write ~a bytes to file descriptor ~a" n fd)) + (setq tem *sigusr1*) + ;; a signal at this instruction would not be noticed...since it + ;; would set *sigusr1* to :received but that would be too late for tem + ;; since the old value will be popped off the binding stack at the next 'paren' + ) + (cond ((eq tem :received) + (read-and-act nil))) + t) + + +(defun coerce-string (a) + (cond ((stringp a) a) + ((fixnump a) (format nil "~a" a)) + ((numberp a) (format nil "~,2f" (float a))) + ((keywordp a) + (format nil "-~(~a~)" a)) + ((symbolp a) + (format nil "~(~a~)" a)) + (t (error "bad type")))) +;;2 decimals + +(defun my-conc (a b) + (setq a (coerce-string a)) + (setq b (coerce-string b)) + (concatenate 'string a b )) + +;; In an arglist 'a : b' <==> (tk-conc a b) +;; eg: 1 : "b" <==> "1b" +; "c" : "b" <==> "cb" +; 'a : "b" <==> "ab" +; '.a : '.b <==> ".a.b" +; ':ab : "b" <==> "abb" + +;;Convenience for concatenating symbols, strings, numbers +;; (tk-conc '.joe.bill ".frame.list yview " 3) ==> ".joe.bill.frame.list yview 3" +(defun tk-conc (&rest l) + (declare (:dynamic-extent l)) + (let ((tk-command + (make-array 30 :element-type 'standard-char + :fill-pointer 0 :adjustable t))) + (cond ((null l)) + (t (pp (car l) no_quote_no_leading_space))) + (setq l (cdr l)) + (while (cdr l) + (pp (car l) join_follows) (setq l (cdr l))) + (and l (pp (car l) no_quote_no_leading_space)) + tk-command + )) + + +;;; (defun verify-list (l) +;;; (loop +;;; (cond ((null l)(return t)) +;;; ((consp l) (setq l (cdr l))) +;;; (t (error "not a true list ~s"l))))) + +;;; (defun prescan-arglist (l pathname name-caller &aux result-type) +;;; (let ((v l) tem prev a b c) +;;; (verify-list l) +;;; (sloop while v +;;; do +;;; (cond +;;; ((keywordp (car v)) +;;; (setq a (car v)) +;;; (setq c (cdr v)) +;;; (setq b (car c) c (cadr c)) +;;; (cond ((eq a :bind) +;;; (cond ((setq tem (cdddr v)) +;;; (or (eq (cadr tem) ': ) +;;; (setf (car tem) +;;; (tcl-create-command (car tem) +;;; nil +;;; t)))))) +;;; ((eq c ': )) +;;; ((member a'(:yscroll :command +;;; :xscroll +;;; :yscrollcommand +;;; :xscrollcommand +;;; :scrollcommand +;;; )) +;;; (cond ((setq tem (cdr v)) +;;; (setf (car tem) +;;; (tcl-create-command (car tem) +;;; (or (get a 'command-arg) + +;;; (get name-caller +;;; 'command-arg)) +;;; nil))))) +;;; ((eq (car v) :return) +;;; (setf result-type (cadr v)) +;;; (cond (prev +;;; (setf (cdr prev) (cddr v))) +;;; (t (setf (car v) '(a . "")) +;;; (setf (cdr v) (cddr v))))) +;;; ((eq (car v) :textvariable) +;;; (setf (second v) (link-variable b 'string))) +;;; ((member (car v) '(:value :onvalue :offvalue)) +;;; (let* ((va (get pathname 'variable)) +;;; (type (get va 'linked-variable-type)) +;;; (fun (cdr (get type +;;; 'coercion-functions)))) +;;; (or va +;;; (error +;;; "Must specify :variable before :value so that we know the type")) +;;; (or fun (error "No coercion-functions for type ~s" type)) +;;; (setf (cadr v) (funcall fun b)))) +;;; ((eq (car v) :variable) +;;; (let ((va (second v)) +;;; (type (cond ((eql name-caller 'checkbutton) 'boolean) +;;; (t 'string)))) +;;; (cond ((consp va) +;;; (desetq (type va) va) +;;; (or (symbolp va) +;;; (error "should be :variable (type symbol)")))) +;;; (setf (get pathname 'variable) va) +;;; (setf (second v) +;;; (link-variable va type)))) +;;; ))) +;;; (setq prev v) +;;; (setq v (cdr v)) +;;; )) +;;; result-type +;;; ) + + +(defun prescan-arglist (l pathname name-caller &aux result-type) + (let ((v l) tem prev a ) +; (verify-list l) ; unnecessary all are from &rest args. +; If pathname supplied, then this should be an alternating list +;; of keywords and values..... + (sloop while v + do (setq a (car v)) + (cond + ((keywordp a) + (cond + ((eq (car v) :return) + (setf result-type (cadr v)) + (cond (prev + (setf (cdr prev) (cddr v))) + (t (setf (car v) '(a . "")) + (setf (cdr v) (cddr v))))) + ((setq tem (get a 'prescan-function)) + (funcall tem a v pathname name-caller))))) + (setq prev v) + (setq v (cdr v))) + result-type)) + +(eval-when (compile eval load) +(defun set-prescan-function (fun &rest l) + (dolist (v l) (setf (get v 'prescan-function) fun))) +) + + +(set-prescan-function 'prescan-bind :bind) +(defun prescan-bind + (x v pathname name-caller &aux tem) + name-caller pathname x + (cond ((setq tem (cdddr v)) + (or + (keywordp (car tem)) + (eq (cadr tem) ': ) + (setf (car tem) + (tcl-create-command (car tem) + nil + t)))))) + +(set-prescan-function 'prescan-command :yscroll :command + :postcommand + :xscroll + :yscrollcommand + :xscrollcommand + :scrollcommand) + +(defun prescan-command (x v pathname name-caller &aux tem arg) + x pathname + (setq arg (cond (( member v '(:xscroll + :yscrollcommand + :xscrollcommand + :scrollcommand)) + + 'aaaa) + ((get name-caller 'command-arg)))) + (cond ((setq tem (cdr v)) + (cond ((eq (car tem) :return ) :return) + (t + (setf (car tem) + (tcl-create-command (car tem) arg nil))))))) + +(defun prescan-value (a v pathname name-caller) + a name-caller + (let* ((va (get pathname ':variable)) + (type (get va 'linked-variable-type)) + (fun (cdr (get type + 'coercion-functions)))) + (or va + (error + "Must specify :variable before :value so that we know the type")) + (or fun (error "No coercion-functions for type ~s" type)) + (setq v (cdr v)) + (if v + (setf (car v) (funcall fun (car v)))))) + +(set-prescan-function 'prescan-value :value :onvalue :offvalue) + +(set-prescan-function + #'(lambda (a v pathname name-caller) + a + (let ((va (second v)) + (type (cond ((eql name-caller 'checkbutton) 'boolean) + (t 'string)))) + (cond ((consp va) + (desetq (type va) va) + (or (symbolp va) + (error "should be :variable (type symbol)")))) + (cond (va + (setf (get pathname a) va) + (setf (second v) + (link-variable va type)))))) + :variable :textvariable) + +(defun make-widget-instance (pathname widget) + ;; ??make these not wait for response unless user is doing debugging.. + (or (symbolp pathname) (error "must give a symbol")) + #'(lambda ( &rest l &aux result-type (option (car l))) + (declare (:dynamic-extent l)) + (setq result-type (prescan-arglist l pathname widget)) + (if (and *break-on-errors* (not result-type)) + (store-circle *request-forms* + (cons pathname (copy-list l)) + (msg-index))) + (with-tk-command + (pp pathname no_leading_space) + ;; the leading keyword gets printed with no leading - + (or (keywordp option) + (error "First arg to ~s must be an option keyword not ~s" + pathname option )) + (pp option no_quote) + (setq l (cdr l)) + ;(print (car l)) + (cond ((and (keywordp (car l)) + (not (eq option :configure)) + (not (eq option :config)) + (not (eq option :itemconfig)) + (not (eq option :cget)) + (not (eq option :postscript)) + ) + (pp (car l) no_quote) + (setq l (cdr l)))) + (print-arglist tk-command l) + (cond (result-type + (call-with-result-type tk-command result-type)) + (t (send-tcl-cmd *tk-connection* tk-command nil) + (values)))))) + +(defmacro def-widget (widget &key (command-arg 'sssss)) + `(eval-when (compile eval load) + (setf (get ',widget 'command-arg) ',command-arg) + (defun ,widget (pathname &rest l)(declare (:dynamic-extent l)) + (widget-function ',widget pathname l)))) + + +;; comand-arg "asaa" means pass second arg back as string, and others not quoted + ;; ??make these always wait for response + ;; since creating a window failure is likely to cause many failures. +(defun widget-function (widget pathname l ) + (or (symbolp pathname) + (error "First arg to ~s must be a symbol not ~s" widget pathname)) + (if *break-on-errors* + (store-circle *request-forms* (cons pathname (copy-list l)) + (msg-index))) + (prescan-arglist l pathname widget) + (with-tk-command + (pp widget no_leading_space) + (pp pathname normal) + (print-arglist tk-command l ) + (multiple-value-bind (res success) + (send-tcl-cmd *tk-connection* tk-command t) + (if success + (setf (symbol-function pathname) + (make-widget-instance pathname widget)) + (error + "Cant define ~(~a~) pathnamed ~(~a~): ~a" + widget pathname res))) + pathname)) +(def-widget button) +(def-widget listbox) +(def-widget scale :command-arg a) +(def-widget canvas) +(def-widget menu) +(def-widget scrollbar) +(def-widget checkbutton) +(def-widget menubutton) +(def-widget text) +(def-widget entry) +(def-widget message) +(def-widget frame) +(def-widget label) +(def-widget |image create photo|) +(def-widget |image create bitmap|) +(def-widget radiobutton) +(def-widget toplevel) + +(defmacro def-control (name &key print-name before) + (cond ((null print-name )(setq print-name name)) + (t (setq print-name (cons 'a print-name)))) + `(defun ,name (&rest l) + ,@ (if before `((,before ',print-name l))) + (control-function ',print-name l))) + +(defun call-with-result-type (tk-command result-type) + (multiple-value-bind + (res suc) + (send-tcl-cmd *tk-connection* tk-command t) + (values (if result-type (coerce-result res result-type) res) + suc))) + +(defun control-function (name l &aux result-type) + ;(store-circle *request-forms* (cons name l) (msg-index)) + (setq result-type (prescan-arglist l nil name)) + (with-tk-command + (pp name normal) + ;; leading keyword printed without '-' at beginning. + (cond ((keywordp (car l)) + (pp (car l) no_quote) + (setq l (cdr l)))) + (print-arglist tk-command l) + (call-with-result-type tk-command result-type))) + + +(dolist (v + '( |%%| |%#| |%a| |%b| |%c| |%d| |%f| |%h| |%k| |%m| |%o| |%p| |%s| |%t| + |%v| |%w| |%x| |%y| |%A| |%B| |%D| |%E| |%K| |%N| |%R| |%S| |%T| |%W| |%X| |%Y|)) + (progn (setf (get v 'event-symbol) + (symbol-name v)) + (or (member v '(|%d| |%m| |%p| |%K| ;|%W| + |%A|)) + (setf (get v 'event-symbol) + (cons (get v 'event-symbol) 'fixnum ))))) + +(defvar *percent-symbols-used* nil) +(defun get-per-cent-symbols (expr) + (cond ((atom expr) + (and (symbolp expr) (get expr 'event-symbol) + (pushnew expr *percent-symbols-used*))) + (t (get-per-cent-symbols (car expr)) + (setq expr (cdr expr)) + (get-per-cent-symbols expr)))) + + +(defun reserve-call-back ( &aux ind) + (setq ind (fill-pointer *call-backs*)) + (vector-push-extend nil *call-backs* ) + ind) + +;; The command arg: +;; For bind windowSpec SEQUENCE COMMAND +;; COMMAND is called when the event SEQUENCE occurs to windowSpec. +;; If COMMAND is a symbol or satisfies (functionp COMMAND), then +;; it will be funcalled. The number of args supplied in this +;; case is determined by the widget... for example a COMMAND for the +;; scale widget will be supplied exactly 1 argument. +;; If COMMAND is a string then this will be passed to the graphics +;; interpreter with no change, +;; This allows invoking of builtin functionality, without bothering the lisp process. +;; If COMMAND is a lisp expression to eval, and it may reference +;; details of the event via the % constructs eg: %K refers to the keysym +;; of the key pressed (case of BIND only). A function whose body is the +;; form, will actually be constructed which takes as args all the % variables +;; actually appearing in the form. The body of the function will be the form. +;; Thus (print (list |%w| %W) would turn into #'(lambda(|%w| %W) (print (list |%w| %W))) +;; and when invoked it would be supplied with the correct args. + +(defvar *arglist* nil) +(defun tcl-create-command (command arg-data allow-percent-data) + (with-tk-command + (cond ((or (null command) (equal command "")) + (return-from tcl-create-command "")) + ((stringp command) + (return-from tcl-create-command command))) + (let (*percent-symbols-used* tem ans name ind) + (setq ind (reserve-call-back)) + (setq name (format nil "callback_~d" ind)) + ;; install in tk the knowledge that callback_ind will call back to here. + ;; and tell it arg types expected. + ;; the percent commands are handled differently + (push-number-string tk-command ind #.(length *header*) 3) + (setf (fill-pointer tk-command) #.(+ (length *header*) 3)) + (if arg-data (pp arg-data no_leading_space)) + (send-tcl-create-command *tk-connection* tk-command) + (if (and arg-data allow-percent-data) (error "arg data and percent data not allowed")) + (cond ((or (symbolp command) + (functionp command))) + (allow-percent-data + (get-per-cent-symbols command) + (and *percent-symbols-used* (setq ans "")) + (sloop for v in *percent-symbols-used* + do (setq tem (get v 'event-symbol)) + (cond ((stringp tem) + (setq ans (format nil "~a \"~a\"" ans tem))) + ((eql (cdr tem) 'fixnum) + (setq ans (format nil "~a ~a" ans (car tem)))) + (t (error "bad arg")))) + (if ans (setq ans (concatenate 'string "{(" ans ")}"))) + (setq command `(lambda ,*percent-symbols-used* + ,command)) + (if ans (setq name (concatenate 'string "{"name " " ans"}")))) + (t (setq command `(lambda (&rest *arglist*) ,command)))) + (setf (aref *call-backs* ind) command) + ;; the command must NOT appear as "{[...]}" or it will be eval'd. + (cons 'a name) + ))) + +(defun bind (window-spec &optional sequence command type) + "command may be a function name, or an expression which + may involve occurrences of elements of *percent-symbols* + The expression will be evaluated in an enviroment in which + each of the % symbols is bound to the value of the corresponding + event value obtained from TK." + (cond ((equal sequence :return) + (setq sequence nil) + (setq command nil))) + (cond ((equal command :return) + (or (eq type 'string) + (tkerror "bind only returns type string")) + (setq command nil)) + (command + (setq command (tcl-create-command command nil t)))) + (with-tk-command + (pp 'bind no_leading_space) + (pp window-spec normal) + (and sequence (pp sequence normal)) + (and command (pp command normal)) + (send-tcl-cmd *tk-connection* tk-command (or (null sequence)(null command))))) + +(defmacro tk-connection-fd (x) `(caar ,x)) + +(def-control after) +(def-control exit) +(def-control lower) +(def-control place) +(def-control send) +(def-control tkvars) +(def-control winfo) +(def-control focus) +(def-control option) +(def-control raise) +(def-control tk) +;; problem on waiting. Waiting for dialog to kill self +;; wont work because the wait blocks even messages which go +;; to say to kill... +;; must use +;; (grab :set :global .fo) +;; and sometimes the gcltkaux gets blocked and cant accept input when +;; in grabbed state... +(def-control tkwait) +(def-control wm) +(def-control destroy :before destroy-aux) +(def-control grab) +(def-control pack) +(def-control selection) +(def-control tkerror) +(def-control update) +(def-control tk-listbox-single-select :print-name "tk_listboxSingleSelect") +(def-control tk-menu-bar :print-name "tk_menuBar") +(def-control tk-dialog :print-name "tk_dialog") +(def-control get_tag_range) + +(def-control lsearch) +(def-control lindex) + + +(defun tk-wait-til-exists (win) + (tk-do (tk-conc "if ([winfo exists " win " ]) { } else {tkwait visibility " win "}"))) + +(defun destroy-aux (name l) + name + (dolist (v l) + (cond ((stringp v)) + ((symbolp v) + (dolist (prop '(:variable :textvariable)) + (remprop v prop)) + (fmakunbound v) + ) + (t (error "not a pathname : ~s" v)))) + + ) + +(defvar *default-timeout* (* 100 internal-time-units-per-second)) + +(defun execute-tcl-cmd (connection cmd) + (let (id tem (time *default-timeout*)) + (declare (fixnum time)) + (setq id (get-number-string cmd (pos msg-index *header*) 3)) + (store-circle *replies* nil id) + (write-to-connection connection cmd) + (loop + (cond ((setq tem (get-circle *replies* id)) + (cond ((or (car tem) (null *break-on-errors*)) + (return-from execute-tcl-cmd (values (cdr tem) (car tem)))) + (t (cerror "Type :r to continue" "Cmd failed: ~a : ~a " + (subseq cmd (length *header*) + (- (length cmd) 1) + ) + (cdr tem)) + (return (cdr tem)) + )))) + (cond ((> (si::check-state-input + (tk-connection-fd connection) 10) 0) + (read-and-act id) + )) + (setq time (- time 10)) + (cond ((< time 0) + (cerror ":r resumes waiting for *default-timeout*" + "Did not get a reply for cmd ~a" cmd) + (setq time *default-timeout*) + ))))) + +(defun push-number-string (string number ind bytes ) + (declare (fixnum ind number bytes)) + ;; a number #xabcdef is stored "" where is (code-char #xef) + (declare (string string)) + (declare (fixnum number bytes )) + (sloop while (>= bytes 1) do + (setf (aref string ind) + (the character (code-char + (the fixnum(logand number 255))))) + (setq ind (+ ind 1)) + (setq bytes (- bytes 1)) +; (setq number (* number 256)) + (setq number (ash number -8)) + nil)) + +(defun get-number-string (string start bytes &aux (number 0)) + ;; a number #xabcdef is stored "" where is (code-char #xef) + (declare (string string)) + (declare (fixnum number bytes start)) + (setq start (+ start (the fixnum (- bytes 1)))) + (sloop while (>= bytes 1) do + (setq number (+ number (char-code (aref string start)))) + (setq start (- start 1) bytes (- bytes 1)) + (cond ((> bytes 0) (setq number (ash number 8))) + (t (return number))))) + + +(defun quit () (tkdisconnect) (bye)) + +(defun debugging (x) + (setq *debugging* x)) + +(defmacro dformat (&rest l) + `(if *debugging* (dformat1 ,@l))) +(defun dformat1 (&rest l) + (declare (:dynamic-extent l)) + (format *debug-io* "~%Lisp:") + (apply 'format *debug-io* l)) + +(defvar *sigusr1* nil) +;;??NOTE NOTE we need to make it so that if doing code inside an interrupt, +;;then we do NOT do a gc for relocatable. This will kill US. +;;One hack would be that if relocatable is low or cant be grown.. then +;;we just set a flag which says run our sigusr1 code at the next cons... +;;and dont do anything here. Actually we can always grow relocatable via sbrk, +;;so i think it is ok.....??...... + +(defun system::sigusr1-interrupt (x) + x + (cond (*sigusr1* + (setq *sigusr1* :received)) + (*tk-connection* + (let ((*sigusr1* t)) + (dformat "Received SIGUSR1. ~a" + (if (> (si::check-state-input + (tk-connection-fd *tk-connection*) 0) 0) "" + "No Data left there.")) + ;; we put 4 here to wait for a bit just in case + ;; data comes + (si::check-state-input + (tk-connection-fd *tk-connection*) 4 ) + (read-and-act nil))))) +(setf (symbol-function 'si::SIGIO-INTERRUPT) (symbol-function 'si::sigusr1-interrupt)) + + +(defun store-circle (ar reply id) + (declare (type (array t) ar) + (fixnum id)) + (setf (aref ar (the fixnum (mod id (length ar)))) reply)) + +(defun get-circle (ar id) + (declare (type (array t) ar) + (fixnum id)) + (aref ar (the fixnum (mod id (length ar))))) + +(defun decode-response (str &aux reply-from ) + (setq reply-from (get-number-string str + #.(+ 1 (length *header*)) + 3)) + (values + (fsubseq str #.(+ 4 (length *header*))) + (eql (aref str #.(+ 1 (length *header*))) #\0) + reply-from + (get-circle *requests* reply-from))) + +(defun describe-message (vec) + + (let ((body-length (get-number-string vec (pos body-length *header*) 3)) + (msg-index (get-number-string vec (pos msg-index *header*) 3)) + (mtype (nth (char-code (aref vec (pos type *header*))) *mtypes*)) + success from-id requ + ) + (format t "~%Msg-id=~a, type=~a, leng=~a, " msg-index mtype body-length) + (case mtype + (m_reply + (setq from-id (get-number-string vec #.(+ 1 (length *header*)) + 3)) + (setq success (eql (aref vec #.(+ 0 (length *header*))) + #\0)) + (setq requ (get-circle *requests* from-id)) + (format t "result-code=~a[bod:~s](form msg ~a)[hdr:~s]" + success + (subseq vec #.(+ 4 (length *header*))) + from-id + (subseq vec 0 (length *header*)) + ) + ) + ((m_create_command m_call + m_lisp_eval + m_lisp_eval_wait_response) + (let ((islot (get-number-string vec #.(+ 0 (length *header*)) 3))) + (format t "islot=~a(callback_~a), arglist=~s" islot islot + (subseq vec #.(+ 3 (length *header*)))))) + ((m_tcl_command m_tcl_command_wait_response + M_TCL_CLEAR_CONNECTION + ) + (format t "body=[~a]" (subseq vec (length *header*)) )) + ((m_tcl_set_text_variable) + (let* ((bod (subseq vec (length *header*))) + (end (position (code-char 0) bod)) + (var (subseq bod 0 end))) + (format t "name=~s,val=[~a],body=" var (subseq bod (+ 1 end) + (- (length bod) 1)) + bod))) + ((m_tcl_link_text_variable + m_tcl_unlink_text_variable + m_set_lisp_loc) + + (let (var (islot (get-number-string vec #.(+ 0 (length *header*)) 3))) + (format t "array_slot=~a,name=~s,type=~s body=[~a]" islot + (setq var (aref *text-variable-locations* islot)) + (get var 'linked-variable-type) + (subseq vec #.(+ 3 (length *header*)))))) + + (otherwise (error "unknown message type ~a [~s]" mtype vec ))))) + +(defun clear-tk-connection () + ;; flush both sides of connection and discard any partial command. + (cond + (*tk-connection* + (si::clear-connection-state (car (car *tk-connection*))) + (setq *pending* nil) + (with-tk-command + (set-message-header tk-command (pos m_tcl_clear_connection *mtypes*) 0) + (write-to-connection *tk-connection* tk-command)) + ))) + +(defun read-tk-message (ar connection timeout &aux + (n-read 0)) + (declare (fixnum timeout n-read) + (string ar)) + (cond (*pending* + (read-message-body *pending* connection timeout))) + + (setq n-read(si::our-read-with-offset (tk-connection-fd connection) + ar 0 #.(length *header*) timeout)) + (setq *pending* ar) + (cond ((not (eql n-read #.(length *header*))) + (cond ((< n-read 0) + (tkdisconnect) + (cerror ":r to resume " + "Read got an error, have closed connection")) + (t (error "Bad tk message")))) + (t + (or (and + (eql (aref ar (pos magic1 *header*)) *magic1*) + (eql (aref ar (pos magic2 *header*)) *magic2*)) + (error "Bad magic")) + (read-message-body ar connection timeout)))) + +(defun read-message-body (ar connection timeout &aux (m 0) (n-read 0)) + (declare (fixnum m n-read)) + (setq m (get-number-string ar (pos body-length *header*) 3)) + (or (>= (array-total-size ar) (the fixnum (+ m #.(length *header*)))) + (setq ar (adjust-array ar (the fixnum (+ m 40))))) + (cond (*pending* + (setq n-read (si::our-read-with-offset (tk-connection-fd connection) + ar + #.(length *header*) m timeout)) + (setq *pending* nil) + (or (eql n-read m) + (error "Failed to read ~a bytes" m)) + (setf (fill-pointer ar) (the fixnum (+ m #.(length *header*)))))) + (if *debugging* (describe-message ar)) + ar) + +(defun tkdisconnect () + (cond (*tk-connection* + (si::close-sd (caar *tk-connection*)) + (si::close-fd (cadr *tk-connection*)))) + (setq *sigusr1* t);; disable it... + (setq *pending* nil) + (setf *tk-connection* nil) + + ) + +(defun read-and-act (id) + id + (when + *tk-connection* + (let* ((*sigusr1* t) tem fun string) + (with-tk-command + (tagbody + TOP + (or (> (si::check-state-input + (tk-connection-fd *tk-connection*) 0) 0) + (return-from read-and-act)) + (setq string (read-tk-message tk-command *tk-connection* *default-timeout*)) + + (let ((type (char-code (aref string (pos type *header*)))) + from-id success) + (case + type + (#.(pos m_reply *mtypes*) + (setq from-id (get-number-string tk-command #.(+ 1 (length *header*)) + 3)) + (setq success (eql (aref tk-command #.(+ 0 (length *header*))) + #\0)) + (cond ((and (not success) + *break-on-errors* + (not (get-circle *requests* from-id))) + (cerror + ":r to resume ignoring" + "request ~s failed: ~s" + (or (get-circle *request-forms* from-id) "") + (subseq tk-command #.(+ 4 (length *header*)))))) + + (store-circle *replies* + (cons success + (if (eql (length tk-command) #.(+ 4 (length *header*))) "" + (fsubseq tk-command #.(+ 4 (length *header*))))) + from-id)) + (#.(pos m_call *mtypes*) + ;; Can play a game of if read-and-act called with request-id: + ;; When we send a request which waits for an m_reply, we note + ;; at SEND time, the last message id received from tk. We + ;; dont process any funcall's with lower id than this id, + ;; until after we get the m_reply back from tk. + (let ((islot + (get-number-string tk-command #.(+ 0 (length *header*))3)) + (n (length tk-command))) + (declare (fixnum islot n)) + (setq tem (our-read-from-string tk-command + #.(+ 0 (length *header*)3))) + (or (< islot (length *call-backs*)) + (error "out of bounds call back??")) + (setq fun (aref (the (array t) *call-backs*) islot)) + (cond ((equal n #.(+ 3 (length *header*))) + (funcall fun)) + (t + (setq tem (our-read-from-string + tk-command + #.(+ 3(length *header*)))) + (cond ((null tem) (funcall fun)) + ((consp tem) (apply fun tem)) + (t (error "bad m_call message "))))))) + (#.(pos m_set_lisp_loc *mtypes*) + (let* ((lisp-var-id (get-number-string tk-command #.(+ 0 (length *header*)) + 3)) + (var (aref *text-variable-locations* lisp-var-id)) + (type (get var 'linked-variable-type)) + val) + (setq val (coerce-result (fsubseq tk-command #.(+ 3 (length *header*))) type)) + (setf (aref *text-variable-locations* (the fixnum + ( + lisp-var-id 1))) + val) + (set var val))) + (otherwise (format t "Unknown response back ~a" tk-command))) + + (if (eql *sigusr1* :received) + (dformat "<>")) + (go TOP) + )))))) + +(defun our-read-from-string (string start) + (let* ((s (car *string-streams*)) + (*string-streams* (cdr *string-streams*))) + (or s (setq s (make-string-input-stream ""))) + (assert (array-has-fill-pointer-p string)) + (setf (fill-pointer string) start) + (si::c-set-stream-object0 s string) + (read s nil nil))) + + +(defun atoi (string) + (if (numberp string) string + (our-read-from-string string 0))) + + +(defun conc (a b &rest l &aux tem) + (declare (:dynamic-extent l)) + (sloop + do + (or (symbolp a) (error "not a symbol ~s" a)) +; (or (symbolp b) (error "not a symbol ~s" b)) + (cond ((setq tem (get a b))) + (t (setf (get a b) + (setq tem (intern (format nil "~a~a" a b) + *tk-package* + ))))) + while l + do + (setq a tem b (car l) l (cdr l))) + tem) + + + + +(defun dpos (x) (wm :geometry x "+60+25")) + +(defun string-list (x) + (let ((tk-command + (make-array 30 :element-type 'standard-char :fill-pointer 0 :adjustable t))) + (string-list1 tk-command x) + tk-command)) + +(defun string-list1 (tk-command l &aux x) + ;; turn a list into a tk list + (desetq (x . l) l) + (pp x no_leading_space) + (while l + (desetq (x . l) l) + (cond ((atom x) + (pp x normal)) + ((consp x) + (pp "{" no_quote) + (string-list1 tk-command x) + (pp '} no_leading_space))))) + +(defun list-string (x &aux + (brace-level 0) + skipping (ch #\space) + (n (length x)) + ) + (declare (Fixnum brace-level n) + (string x) + (character ch)) + (if (eql n 0) (return-from list-string nil)) + (sloop for i below n + with beg = 0 and ans + do (setq ch (aref x i)) + (cond + ((eql ch #\space) + (cond (skipping nil) + ((eql brace-level 0) + (if (> i beg) + (setq ans (cons (fsubseq x beg i) ans))) + + (setq beg (+ i 1)) + ))) + (t (cond (skipping (setq skipping nil) + (setq beg i))) + (case ch + (#\{ (cond ((eql brace-level 0) + (setq beg (+ i 1)))) + (incf brace-level)) + (#\} (cond ((eql brace-level 1) + (setq ans (cons (fsubseq x beg i) ans)) + (setq skipping t))) + (incf brace-level -1))))) + finally + (unless skipping + (setq ans (cons (fsubseq x beg i) ans))) + (return (nreverse ans)) + )) + +;; unless keyword :integer-value, :string-value, :list-strings, :list-forms +;; (foo :return 'list) "ab 2 3" --> (ab 2 3) +;; (foo :return 'list-strings) "ab 2 3" --> ("ab" "2" "3") ;;ie +;; (foo :return 'string) "ab 2 3" --> "ab 2 3" +;; (foo :return 't) "ab 2 3" --> AB +;; (foo :return 'boolean) "1" --> t + + +(defun coerce-result (string key) + (case key + (list (our-read-from-string (tk-conc "("string ")") 0)) + (string string) + (number (our-read-from-string string 0)) + ((t) (our-read-from-string string 0)) + (t (let ((funs (get key 'coercion-functions))) + (cond ((null funs) + (error "Undefined coercion for type ~s" key))) + (funcall (car funs) string))))) + +;;convert "2c" into screen units or points or something... + )) + +;; If loc is suitable for handing to setf, then +;; (setf loc (coerce-result val type) +;; (radio-button + +(defvar *unbound-var* "") + +(defun link-variable (var type) + (let* ((i 0) + (ar *text-variable-locations*) + (n (length ar)) + tem + ) + (declare (fixnum i n) + (type (array (t)) ar)) + (cond ((stringp var) + (return-from link-variable var)) + ((symbolp var)) + ((and (consp var) + (consp (cdr var))) + (setq type (car var)) + (setq var (cadr var)))) + (or (and (symbolp type) + (get type 'coercion-functions)) + (error "Need coercion functions for type ~s" type)) + (or (symbolp var) (error "illegal text variable ~s" var)) + (setq tem (get var 'linked-variable-type)) + (unless (if (and tem (not (eq tem type))) + (format t "~%;;Warning: ~s had type ~s, is being changed to type ~s" + var tem type + ))) + (setf (get var 'linked-variable-type) type) + (while (< i n) + (cond ((eq (aref ar i) var) + (return-from link-variable var)) + ((null (aref ar i)) + (return nil)) + (t (setq i (+ i 2))))) +;; i is positioned at the write place + (cond ((= i n) + (vector-push-extend nil ar) + (vector-push-extend nil ar))) + (setf (aref ar i) var) + (setf (aref ar (the fixnum (+ i 1))) + (if (boundp var) + (symbol-value var) + *unbound-var*)) + (with-tk-command + (push-number-string tk-command i #.(length *header*) 3) + (setf (fill-pointer tk-command) #. (+ 3 (length *header*))) + (pp var no_quotes_and_no_leading_space) + (vector-push-extend (code-char 0) tk-command) + (set-message-header tk-command (pos m_tcl_link_text_variable *mtypes*) + (- (length tk-command) #.(length *header*))) + (write-to-connection *tk-connection* tk-command))) + (notice-text-variables) + var) + +(defun unlink-variable (var ) + (let* ((i 0) + (ar *text-variable-locations*) + (n (length ar)) + + ) + (declare (fixnum i n) + (type (array (t)) ar)) + (while (< i n) + (cond ((eq (aref ar i) var) + (setf (aref ar i) nil) + (setf (aref ar (+ i 1)) nil) + (return nil) + ) + (t (setq i (+ i 2))))) + + (cond ((< i n) + (with-tk-command + (push-number-string tk-command i #.(length *header*) 3) + (setf (fill-pointer tk-command) #. (+ 3 (length *header*))) + (pp var no_quotes_and_no_leading_space) + (vector-push-extend (code-char 0) tk-command) + (set-message-header tk-command (pos m_tcl_unlink_text_variable *mtypes*) + (- (length tk-command) #.(length *header*))) + (write-to-connection *tk-connection* tk-command)) + var)))) + +(defun notice-text-variables () + (let* ((i 0) + (ar *text-variable-locations*) + (n (length ar)) + tem var type + ) + (declare (fixnum i n) + (type (array (t)) ar)) + (tagbody + (while (< i n) + (unless (or (not (boundp (setq var (aref ar i)))) + (eq (setq tem (symbol-value var)) + (aref ar (the fixnum (+ i 1))))) + (setf (aref ar (the fixnum (+ i 1))) tem) + (setq type (get var 'linked-variable-type)) + (with-tk-command + ;(push-number-string tk-command i #.(length *header*) 3) + ;(setf (fill-pointer tk-command) #. (+ 3 (length *header*))) + (pp var no_quote_no_leading_space) + (vector-push (code-char 0) tk-command ) + (case type + (string (or (stringp tem) (go error))) + (number (or (numberp tem) (go error))) + ((t) (setq tem (format nil "~s" tem ))) + (t + (let ((funs (get type 'coercion-functions))) + (or funs (error "no writer for type ~a" type)) + (setq tem (funcall (cdr funs) tem))))) + (pp tem no_quotes_and_no_leading_space) + (vector-push (code-char 0) tk-command ) + (set-message-header tk-command (pos m_tcl_set_text_variable *mtypes*) + (- (length tk-command) #.(length *header*))) + (write-to-connection *tk-connection* tk-command))) + (setq i (+ i 2))) + (return-from notice-text-variables) + error + (error "~s has value ~s which is not of type ~s" (aref ar i) + tem type) + ))) +(defmacro setk (&rest l) + `(prog1 (setf ,@ l) + (notice-text-variables))) + +(setf (get 'boolean 'coercion-functions) + (cons #'(lambda (x &aux (ch (aref x 0))) + (cond ((eql ch #\0) nil) + ((eql ch #\1) t) + (t (error "non boolean value ~s" x)))) + #'(lambda (x) (if x "1" "0")))) + +(setf (get 't 'coercion-functions) + (cons #'(lambda (x) (our-read-from-string x 0)) + #'(lambda (x) (format nil "~s" x)))) + +(setf (get 'string 'coercion-functions) + (cons #'(lambda (x) + (cond ((stringp x) x) + (t (format nil "~s" x)))) + 'identity)) + + +(setf (get 'list-strings 'coercion-functions) + (cons 'list-string 'list-to-string)) +(defun list-to-string (l &aux (x l) v (start t)) + (with-tk-command + (while x + (cond ((consp x) + (setq v (car x))) + (t (error "Not a true list ~s" l))) + (cond (start (pp v no_leading_space) (setq start nil)) + (t (pp v normal))) + (setf x (cdr x))) + (fsubseq tk-command #.(length *header*)))) + + + +(defvar *tk-library* nil) +(defun tkconnect (&key host can-rsh gcltksrv (display (si::getenv "DISPLAY")) + (args "") + &aux hostid (loopback "127.0.0.1")) + (if *tk-connection* (tkdisconnect)) + (or display (error "DISPLAY not set")) + (or *tk-library* (setq *tk-library* (si::getenv "TK_LIBRARY"))) + (or gcltksrv + (setq gcltksrv + (cond (host "gcltksrv") + ((si::getenv "GCL_TK_SERVER")) + ((probe-file (tk-conc si::*lib-directory* "gcl-tk/gcltksrv"))) + (t (error "Must setenv GCL_TK_SERVER "))))) + (let ((pid (if host -1 (si::getpid))) + (tk-socket (si::open-named-socket 0)) + ) + (cond ((not host) (setq hostid loopback)) + (host (setq hostid (si::hostname-to-hostid (si::gethostname))))) + (or hostid (error "Can't find my address")) + (setq tk-socket (si::open-named-socket 0)) + (if (pathnamep gcltksrv) (setq gcltksrv (namestring gcltksrv))) + (let ((command + (tk-conc gcltksrv " " hostid " " + (cdr tk-socket) " " + pid " " display " " + args + ))) + (print command) + (cond ((not host) (si::system command)) + (can-rsh + (si::system (tk-conc "rsh " host " " command + " < /dev/null &"))) + (t (format t "Waiting for you to invoke GCL_TK_SERVER, +on ~a as in: ~s~%" host command ))) + (let ((ar *text-variable-locations*)) + (declare (type (array (t)) ar)) + (sloop for i below (length ar) by 2 + do (remprop (aref ar i) 'linked-variable-type))) + (setf (fill-pointer *text-variable-locations*) 0) + (setf (fill-pointer *call-backs*) 0) + + (setq *tk-connection* (si::accept-socket-connection tk-socket )) + (if (eql pid -1) + (si::SET-SIGIO-FOR-FD (car (car *tk-connection*)))) + (setf *sigusr1* nil) + (tk-do (tk-conc "source " si::*lib-directory* "gcl-tk/gcl.tcl")) + ))) + + + +(defun children (win) + (let ((ans (list-string (winfo :children win)))) + (cond ((null ans) win) + (t (cons win (mapcar 'children ans)))))) + + +;; read nth item from a string in + + + +(defun nth-a (n string &optional (separator #\space) &aux (j 0) (i 0) + (lim (length string)) ans) + (declare (fixnum j n i lim)) + (while (< i lim) + (cond ((eql j n) + (setq ans (our-read-from-string string i)) + (setq i lim)) + ((eql (aref string i) separator) + (setq j (+ j 1)))) + (setq i (+ i 1))) + ans) + + + +(defun set-message-header(vec mtype body-length &aux (m (msg-index)) ) + (declare (fixnum mtype body-length m) + (string vec) ) + (setf (aref vec (pos magic1 *header*)) *magic1*) + (setf (aref vec (pos magic2 *header*)) *magic2*) +; (setf (aref vec (pos flag *header*)) (code-char (make-flag flags))) + (setf (aref vec (pos type *header*)) (code-char mtype)) + (push-number-string vec body-length (pos body-length *header*) 3) + (push-number-string vec m (pos msg-index *header*) 3) + (setf (msg-index) (the fixnum (+ m 1))) + m) + +(defun get-autoloads (&optional (lis (directory "*.lisp")) ( out "index.lsp") + &aux *paths* + ) + (declare (special *paths*)) + (with-open-file + (st out :direction :output) + (format st "~%(in-package ~s)" (package-name *package*)) + (dolist (v lis) (get-file-autoloads v st)) + (format st "~%(in-package ~s)" (package-name *package*)) + (format st "~2%~s" `(setq si::*load-path* (append ',*paths* si::*load-path*))) + + )) + + + +(defun get-file-autoloads (file &optional (out t) + &aux (eof '(nil)) + (*package* *package*) + saw-package + name ) + (declare (special *paths*)) + (setq name (pathname-name (pathname file))) + (with-open-file + (st file) + (if (boundp '*paths*) + (pushnew (namestring (make-pathname :directory + (pathname-directory + (truename st)))) + *paths* :test 'equal)) + (sloop for tem = (read st nil eof) + while (not (eq tem eof)) + do (cond ((and (consp tem) (eq (car tem) 'defun)) + (or saw-package + (format t "~%;;Warning:(in ~a) a defun not preceded by package declaration" file)) + (format out "~%(~s '~s '|~a|)" + 'si::autoload + (second tem) name)) + ((and (consp tem) (eq (car tem) 'in-package)) + (setq saw-package t) + (or (equal (find-package (second tem)) *package*) + (format out "~%~s" tem)) + (eval tem)) + )))) + +;; execute form return values as usual unless error +;; occurs in which case if symbol set-var is supplied, set it +;; to the tag, returning the tag. +(defmacro myerrorset (form &optional set-var) + `(let ((*break-enable* nil)(*debug-io* si::*null-io*) + (*error-output* si::*null-io*)) + (multiple-value-call 'error-set-help ',set-var + (si::error-set ,form)))) + +(defun error-set-help (var tag &rest l) + (cond (tag (if var (set var tag))) ;; got an error + (t (apply 'values l)))) + +;;; Local Variables: *** +;;; mode:lisp *** +;;; version-control:t *** +;;; comment-column:0 *** +;;; comment-start: ";;; " *** +;;; End: *** + + + + + diff --git a/gcl-tk/tktst.c b/gcl-tk/tktst.c new file mode 100755 index 0000000..745ef36 --- /dev/null +++ b/gcl-tk/tktst.c @@ -0,0 +1,231 @@ +/*-*-c++-*-*/ + +#include +#include +#include +#include + +Tcl_Interp *tcliMain; /* Main and only tcl interpreter instance */ + +static Tk_Window mainWindow; /* The main window for the application. If + * NULL then the application no longer + * exists. */ + +static int tty; /* Non-zero means standard input is a + * terminal-like device. Zero means it's + * a file. */ + +static int synchronize = 1; +static char *szname = "TCL/TK-Scheme"; +static char *szdisplay = NULL; /* "unix:0.0"; */ + +static Tcl_DString command; /* Used to assemble lines of terminal input + * into Tcl commands. */ +static int gotPartial = 0; /* Partial command in buffer. */ + +static char exitCmd[] = "exit"; +static char errorExitCmd[] = "destroy ."; + +extern int isatty _ANSI_ARGS_((int fd)); +/* +int __TclX_AppInit(Tcl_Interp *interp) { return TCL_OK; } +*/ +/* + *---------------------------------------------------------------------- + * + * StdinProc -- + * + * This procedure is invoked by the event dispatcher whenever + * standard input becomes readable. It grabs the next line of + * input characters, adds them to a command being assembled, and + * executes the command if it's complete. + * + * Results: + * None. + * + * Side effects: + * Could be almost arbitrary, depending on the command that's + * typed. + * + *---------------------------------------------------------------------- + */ + +static void +StdinProc(ClientData clientData, int mask) +{ +#define BUFFER_SIZE 4000 + char input[BUFFER_SIZE+1]; + char *cmd; + int code, count; + + count = read(fileno(stdin), input, BUFFER_SIZE); + if (count <= 0) { + if (!gotPartial) { + if (tty) { + Tcl_VarEval(tcliMain, "exit", (char *) NULL); + exit(1); + } + else { + Tk_DeleteFileHandler(0); + } + return; + } + else { + count = 0; + } + } + cmd = Tcl_DStringAppend(&command, input, count); + if (count != 0) { + if ((input[count-1] != '\n') && (input[count-1] != ';')) { + gotPartial = 1; + goto exitPoint; + } + if (!Tcl_CommandComplete(cmd)) { + gotPartial = 1; + goto exitPoint; + } + } + gotPartial = 0; + + /* + * Disable the stdin file handler; otherwise if the command + * re-enters the event loop we might process commands from + * stdin before the current command is finished. Among other + * things, this will trash the text of the command being evaluated. + */ + + Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0); + code = Tcl_RecordAndEval(tcliMain, cmd, 0); + Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0); + if (tty) + TclX_PrintResult (tcliMain, code, cmd); + Tcl_DStringFree(&command); + + exitPoint: + if (tty) { + TclX_OutputPrompt (tcliMain, !gotPartial); + } +} + +/* + *---------------------------------------------------------------------- + * + * SignalProc -- + * + * Function called on a signal generating an error to clear the stdin + * buffer. + *---------------------------------------------------------------------- + */ +static void +SignalProc (int signalNum) +{ + tclGotErrorSignal = 0; + Tcl_DStringFree (&command); + gotPartial = 0; + if (tty) { + fputc ('\n', stdout); + TclX_OutputPrompt (tcliMain, !gotPartial); + } +} + +char *TclTkInit() +{ + tcliMain = Tcl_CreateInterp(); + + mainWindow = Tk_CreateMainWindow(tcliMain, szdisplay, szname, "Tk"); + if (mainWindow == NULL) + fprintf(stderr, "Unable to create mainWindow : %s\n", tcliMain->result); + + Tk_SetClass(mainWindow, "Tk"); + if (synchronize) + XSynchronize(Tk_Display(mainWindow), True); + + Tk_GeometryRequest(mainWindow, 200, 200); + /* + if (__TclX_AppInit(tcliMain) != TCL_OK) + TclX_ErrorExit (tcliMain, 255); + */ + Tcl_AppInit(tcliMain); + + return "."; +} + +void TclTkMainLoop() +{ + /* + * Set the "tcl_interactive" variable. + */ + tty = isatty(0); + Tcl_SetVar(tcliMain, "tcl_interactive", + tty ? "1" : "0", TCL_GLOBAL_ONLY); +/* + TclX_EvalRCFile (tcliMain); +*/ + /* + * Commands will come from standard input. Set up a handler + * to receive those characters and print a prompt if the input + * device is a terminal. + */ + tclErrorSignalProc = SignalProc; + Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0); + if (tty) + TclX_OutputPrompt (tcliMain, 1); + + Tk_MainLoop(); + Tcl_GlobalEval(tcliMain, exitCmd); + +} + +main() +{ + TclTkInit(); + TclTkMainLoop(); +} + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + Tk_Window main; + + main = Tk_MainWindow(interp); + + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ + + if (Tcl_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + if (Tk_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + if (TclX_Init(interp) == TCL_ERROR) + return TCL_ERROR; + + if (TkX_Init(interp) == TCL_ERROR) + return TCL_ERROR; + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ + + tcl_RcFileName = "~/.wishrc"; + return TCL_OK; +} diff --git a/gcl.ico b/gcl.ico new file mode 100644 index 0000000000000000000000000000000000000000..e7f6e515796060935a3b9f6d4aebb42097fbb6f5 GIT binary patch literal 23502 zcmeHO2UJzZ(;tf15KyuAuCc^kqhiGfQPHT0Vv8EF#aI9f1fLpIEMP_KV%K0pj7EtK z#V974*h`EiwisiHB8KeUZ)We^`|f+Z2k74<=X@ut`*wF`cIG#;161ULf}E+^&7!X~7D zR!PcZ8|#%D0#rpCs1m#|lUS? zDOo1(;E)i5P$c%^({;iLYGN9vQIf{1ZL^4Xm`ag-yoCm&sam}?dCs4yD%#2pFEo|O zn#AWtFTzA%_1T4})~Lk5Mhv=q@t03x`v zQ^JTpo4S*&kQ8Bp+9dx%?Zthuo#N{q8KR1(Q8Oha49lc2Ax6!lH1eCQ&ZcHc5*3}X zsdgt)N{TneK)SC|A~kWfg&i!|NnB{vn25@g6?-rj9(h>3ZfHr<*fC!={mh`w@C}$58FD&9sH!{3+6F3zOj1;dhO%E2+bWKU#a=8#!T@=JLXd#BWI+5Nsct)gH zBt*4P)V8g=N~2$G^$Ifv=Xh|CuexlJGs-NU7Rjdv`{oqUN*2>!~ii|Nj7HO7#;i~DtRnoys=4tx=6l`f#i;%u;%@BJ9!c_Hy zX*z;K)U8CLYYiH8&5E{Q+p7CdNJ_E>N~0%cb>R!@QWthiNh^M3+SLynEIHt{H)p7Gib6gz< z4ZeAM(#EVq+6+>pqSuE2-D>OG8G|{(K+>w@qFIfZk3*m4Z*IyO;gn-2X;k*KS{0HP zW|;euhGi0;(bmw^tI30X^?D{1o0|+0)mdVX`yc)9ihzu}<#`GZX_TDRLi{@5FJ(+4 z^A~`?LWRMCzBaycq1upC96j6ooz5_p4&X z;j2=mVNSIw5LK=`%&S=gVwyC8RZSYhnsQ}fbGdS`rutj3y;dzqC|@4-SF8xTYSn~o zwcmz>`t@ON!$z>XNmDrRPBZwbd2=|CGbbF&l?#rzxxwi?dEl&*Bb;}3hO_zH;4-#< z%$E-?xOu=S#Bd(-)xt&K8v61J`hC;c32tKl+c{m}0kz%S;ePJi@H^(G4i4}f^B*~K zz;n!hIy!=aGU-mv@Y2Nv6r!WwFHu%O`!CTBb9IHE3KoPrn198XDrkq5ED0woRDka) zSBB)ORp1Kxc)oEHc!0E(Exlk$yLK?s_dQsI<%%|KAf|0Qi0;@CB0lT|GyVNxPQQK- z^?rAV@$-X~AAA5?+qQ-ESl@yFElA&j^wlet!-nO{Vau|muzl%L*t2{o#Ky+Lw(Z;C zs|_1q$BrEkzk4_APDp?Q`}afQ*I&c2xsi|@6$vT3;vp&NC>%R>98MoQ1}9IRgwrXf z;p}&3;llazaO3P*xP0LPT)KD(u3o(g*Dqg&8#jK0pMU-t^Dl7w_HDR#=Pum2dk^m4 zy9bXRJ%%Swo`g6G5=`3VW5 z4LIsdv0|d=t_lVPwR4p&+kc9sf|1DYYL;m~#sWY>T==x|4IFbj6lw1||WuQD>v#WUIgRXcz?}ulO?qy0t zpOVF4fU6sX;5B@^k7U9&t3 zf~i;um|Ln8MB!O&KAx>MIOl+Mu6f}LJbQeJeRt=~4Lk8nvJTH5Yw_H%4s(3LLa-0x zu(Jf7yRgsPvSqSRJ8d7d4HlTUDaRW`6~_E3g##1Ybwe;%bO4WaLos)?(V>l_6TE^jhe)%D@Axry@Na=Z=E;PsF2mdO}+95|C7>5`0&^I$SDW5zbbr23IgfCu-LP z1s!gRPE?gnf8MTeD&X z#N*j)_3BlyX4Psum#u~Ev1?%S=8do|E)L?iZiOA&w!$8)@7TT*cJ0~;@$m_euqOfb z?~I27@$vBG-o3DI-#$p(e*h8_6X6Ke70+?seG6y5{SMBaISc2{;~DP4MYwqRB3#CN;X^#jJ%;DcpF`S)B$`z$qsED@eIvy#W=#8FKfH_qYs z)K-VoHW4VXgnleiKrP$)lj~P5KFAc*%EP-rw7Ek>L?K(sIsfAf(o@!NuHI?5gImrb zdXL!r&un#gpvEHo=$V*hKKVxK!Hr%sEdREf={#M|RIRgY-YtikJIvSBQ)O_;s->%5 zw`JvKUC&__qNa$|5vG9CPS<0ke`R0@b<(Cm=`GBJqEY5FyxhHycUm7JnT^eJS zZ*tNCNcz@rQ-sMoQJ1C4!HH)1Xdkx<_3!HJ?raq!^5 zy`(Xz11btODj;gAw?REsBZ4RP-;a!=ooEq_PPRgSBE#f~@IQ&-$$qMymG5sdZUE^$ zRI=fB1)bwRGTC^YFuCBGz;$}u>wU)O9nDk1)nMvt9 zFHO8mFizI2QiRFnn$Z5B;+(8xi67ljo&AY+t`*ig0;-Yrs~bYIfrZrPdB#&u_ZeWV z#%_CQMgK0t>~d`~><2}^zsY7r1nytEQ_CjE|A%5S?sT7upDsXI%nsrgzg2L?hE>`O z5cdV(?wQBKandrg$EH*q>PJaBtMMg>(CMp%IQi+M3OiSb6q8#C2 zR^`^pmHF`l`}u(-OZfR~>Y7)(S^n;ii?ipC(7UU7bKRaWDsdV~kA0hx0=xj$0bW)?a_A7xQbke&IViy(e&_J2;8*7W(rQ`n91` zCky-7O|)e^?xnq8Yu{-~eWYD>*v*YUw6aE9@cr@Q`7YG?!isnL3(FY1K$)OH11;?C z@8B);NAKEYVW04v`Vimu8RCD%)s6!!0--$xvsE&Qf_5{I=v)IL(YIL%*vE;g3qyB-T{MtNK7a|^E7Xjj*` znONc&#?gAVB}X)??ckN0w9k~q?1fqGGm~lKu}WP4{Qu2tjM=|kKZWykO_fS~-QYod zW>^@X6&A);jt%6=J$vwP%2nWdkpGM2n9F%B=7IIR$!41!baG~KOQP9*u{Dalf#xS= znrgBx+PkjbU~?j7vQzaMuv7pAV@4Q6#{E_yn=)tFc6C)Qqd)p-UbTfL)g<>P*~a%_ zgh5Z|QGRh?AUC0odum)>D;|m1*M#f(>)W?2^ec+GPfCNjXkU$k1wXJ)-&gY2X#eTcr~FfsiG?j+#)C?g5Z4MXaA4y-+<3Eso_wFDC%=(1 zr@mGx7IJ*Jg9Ce5v?z|lDj@(eLdDOr-u zE?k&J7AsEkLmwY~JRBW4$LriW#Pmt0PMp4DTefT&U$tgUw&IbRs@_o(PC0mYu+sUR z=6ZZj6)Zw_^|r-)!1E_BTUPKtMJ(jR)vH%Xm99@T4Ek-gN&d#;XZ+)GWqGWP@zwn` z$G`$lZ^ZY46l;l=pR7}9^v_m%(ekAX-$Zdv{$Ocq{%aV>E}MkwHMB-e7TmN68xR%6 z@LVOvkL*yQ@y0|LWX`}>CDmV)6Z|FR$_V{(evwVe)Fxbb-r%8hhPH~Yz4i}}AM+z0 z_2+y0^kcW5JfVIfkyTlzQnr^>!8>ZSVI6PT_M5jzcC*=EGWR8a!|)o-xwAO4@d2I% z8QqJ>B<;zz7AubDtxWCTMt(Tv8r7?@FZb<}-F5s#z_TLXjxi%YD2Hv_NaRfM68{v& z=YrNp`YUy4ZT6kJJ6jYR%WmJlFUE^-Qxb!XCFvRG_deNHc<$U{ENkb^#V%a`G0X8^ zx^1hFCtLQ$zr%^t$Y(qL3;s&v z&qj=RCgxDYQ>tJgix+dlnTsu``L^WI#nC2SDR2PK6Mv|_b|j~c!rSjQirWJ z`5`mO$vTzx+6$0(I!#;|#rR)9<00kC+q}MIN1v3jXHW7GzrZ(alh}KC;=@NQvTr{w zt_i9i*}^aNS=*EJtjfJjo6^0Y+!OWqW!29X|8?%Y{qde1&nEue-@v`Q)#HGFyh+a~ zYGdw?S$|G}f6HZ^Y{l+BntAR16S1K6LVJkJhV?`1j;=N0dZS@6(!_HKqFd{bdy*}l z)NkF#7Tp$2;-u23AL}|++B@*<$3FIOQ+m{@rMz3bIPuMoWhy&#U%aaoX93)X<@o`t;+jBh>~fdTPW(bz_$EAuF2Tmo6>F{sVjm@OPxxyUhN1CpO>VYd(v3k|2un=`j^fhCQGu2-y{)X}W z6X$JnH#en!=mh1k_8vjQAm%#WH0k*1{z)dIUy>$E$usJ?`r?Jsuv-r{P#puY?&N-A z#Ge^W@~D*lVyUmYG3ZxG)Zd^ze#Ov2t6$eLQ6XPlDN-VOJ zF_vv(Nj&R(6lpCnxAO1KXRchuA3c4pTKk)RPu#xEeQe;c#$~Tf{%F3lmR;Xx`|dsv zv8MP~W%59VRxfQ5HLg9Lkxn|jh7V=WUo-xMAAJ+^zqzxM;@zM=>o9sO5072VHXhik z9K3X1`R3=Jpzu|QB;9(v$AK&5INn<_><0tMt;D?J928<2UoV za-K7{z-)}Wtn2Zo=aL;d(DOD%K6D>ClwG)dS;k6~nqP*fo2vxN+%nfRxa{}eAE`Pt zmXxP%lyT=~6{?7D1t``c$2vN(rxmNnw!VI?=Rf%(XvWz(UXe#Qhf1GsmAd zuc9<-rYN)yP_{M20BstwO^nt!b&yv0jda3|nb)jRl}*sruZ){9meLO@v%-&j1@8|? zj^T3+e)7o^fnVB{F{4t_WND9Qi%#(vHz5dN0)Osg-aiSqEsW9!Yo5TX^&!mEUR0@) z;)(S|Uy64K7C3ETd0qTlwrpW3XU^~;TQ;*_wfJWjzlN33yS)b0tFs1vUHN+hK4x|O zd$TpW^?L)mYmxk*q|E_inPnffr{0&JdH$Tfj}q(Ch@a}#8F7m}h~8CIZrz5jJ${s? z;Qy3XBqs7$yeD41V8LtY`TE*bo}l59_%bWcpy4WM77a zvgEFQB5oYV5TDnx87o)W>Sj~FHhz5Vks}Ph$I5p6$D!=}gNHKRQ>1Px<@`oq)Q9zI z*+%Sd7$XI*)#BQ|2Zd=t-5t)F^d)p)6%Xre!@<-T^aNkV?lM9NPhd-vphM6dOu0njre8TSknAiS+F3Vf9@Q1&wlC|{yD!=yp-6x z#2mzLX4jyucl|o?%lM7R>!yx9dYE-)e-C0q(AS1Nd$OJrCbChB7qX#|^Z59P26OFF{8v>CP0K`$l^r|uN4Y+ce9wE_+2dvjo&5by+t4DYn2`LR?=VAu1)thN?**unDMzOyq)~|-06)RU!T&Kuy=HjB;eiggYHuZTUnZ75)zl|u2`gUKwOd-yY zZlOnw>NnurMSXVjChQtxC+n{g2Pw<(+t$q(&rcWP-+gFnR&zkK10v>%b0W&?>r2{` zrPL+cRNA6RzT_F#gt3pL+oBoQ3Sq+iU#Zlso4DQ~ZhfAw{ox$@sA?sBZD2nglhkk2 zMYbf}o?Xd*WB3aeWKC!-s<@Ruu?*d|o%JhRf*(@xX1Y%Qb^M6&a+4-X_wL=5L4}Ga wOVJm6A1>ldVT3dGDi6YI)6`HOC3aYf(oPw z{6Lf~`rStkuAZ(Q4z4e+iru~gl2+DwK)nU}ozDNh14IS<{yF}s!~Ur|^(P0i-`8l) z{3%iWEeV|eQ#u1Y_cxvR^W4Fof+k4V&JL(~4&=0du2B7RB|A0k-z%a(4Hf7KkpI^` z5`V7T`kz<+w0R7aL74JfZaW|Ic`w2Cjn6 z!hr1e7z6`+_$>WC=^70>eQ*zr|3_gre`{P<}A}iMtXY2i)P(c7HPg4C!0KvZ#HNb^5Cu!+Uoj!9G;IaR#qyn9w{;$gOASxOv z>Jv04PSVkyI!R4022?Up(_CW~IeAyt@&dQpD^XgO`0P?;9^Q+3->t;N-Cy^s(D5bc z@6PR6dq`aRP!__kn)uj8?MIHMB4S4xn*c^|6^tA@X~>y zop)GD-q*H~`p-L=KoHQu;{T?UcbC30oVa5? zi%%XTnc@kNBhRH%F9yNI#cL|JXF53)Q}f!btIF3Di`Xfk7s7Hqs|wl|uJ`@C)&8RI zaIB5_YH#H>ILCRiQaf*-{81gMsFCZm|D1uh`o7a>z!NjvXYJIb#>}?Vdk)G7`a;evuL}>LH3RtD(oF?3H=J_~yPqD#<0>C_kC^N?mEtxS zdW)a0k}l$Kwm!N+qSM3P&KdHM&9cUpZyvY{_0@${*1!Ga zdMs-~K;lL0iE?w{sr(-N(pFCBZW-t%WCzg`DEHzpb#}q!YV^^Se}zV&(7`qb^V4(7V}5?t9UEaamV$2h~+D-pWkFa8oCw^SZ(sHXL zzP0MipyME(n*|nyZ68Nm6lO0wp$I-T(I&Gji*8n((e8vLdBx#9Hl4v{lIw^YDm0Q7 z@8x)a+)IvsGwi-wdZ(x{!}OeD(WZxX#={vms)<|3}Q zMUp1Y&po2sZSSA+VBepnfF9L%xym-Q?zr)7%O=eGD9lc{uQnDLSyKggN>ww%5_+8> zYpzBzWbLG-8fEo6?s&I0AIM`0=pIaJ+pYV#Ezhm}AiMN*hq$)|`(I@$q}=OkmW?QV z`;cO@$DYtg#E`YeDr*0MY>0Klr!eGV?MkU{ys(>a>2fERc5!K&cE&=@jvJ&ATjTF~ zJXpH5%GTw0?W>(3c-Q%M<$HiBzY2@U-$wlM4fXT0AqgeQQb2}aVbUaneu=kFBWjNI zi>$(EssN5hosobaSx1_f^@&kH_VZTy3G3_DsG!fjw*t_GYgL1!i68;kD3fBLky**d zts^OCjjmH3upUElY0$$}mW-@YWO}0hj>qTnph|JpD?x&6>ppexho45g<*VI2YHYjJ z_2)&S-Co_$hDU{+-=~1m!?XQpR9{vD10AiHW9?m+Z>4dtWz<;gWpt2H)b{We+kRhL z<^dwX9J`6y&zgPT$ptXrZT8%_)8`+S&MnrWK0O}mH#N;K-m`9eIRg9TVg$YM6O++& z>xK%8b%Lrg?Na`lCULgr;+Lezp-OW7N)=B@P*@JW>49q==-1Tlq^Jc6*{@3hJu$8p zKZ|*XKK<;d-ZzZwdYF-uY`xXhQAq(k?A-FmZ)sRRQaa~tItEQoo6c!D;e#e!^tdjM zYF-rCfwRTHXOMY*kTzs(g?~Ou?=X}4qkqpO`TOg&P2;|8C9&3K9Fd@PIYNr}rH71K zYx!b|BMXnd7tQ7(r>&uxDRNk6)J*kL)L!_(E0W$+*G)C)*q0YApSCq*$Kbj0roVn2 zCCLTJQ9!>apzogpk`_HYo@!iCzeBp=NG&`CKS;H`c4cN(V146Ox!c)yc(U`_7+a=b z2^eA7xJm(OsQSA=_7G#Eun{A*1EUQ?Ba@bca*@-C9 zhL_-{{>UvzaScMeTbwCM=fE*#ob0WQa7kDQums|YZr*7)X7z5T9D?$+mk5L4sn+gAhNmGvk!e4WpO z4_`Li_r_q!&Qugok$#{n@5cnT52w#_>Sg2oAUl?THn=p;VLI}tJ2^Pwlm4)*?TBQW z`)V0__2;-X=K{4)Wr_Dnz>|^_XIeyfUTUP@r1bA7e)WV*W?q`&Pbu3qeIYh2r&c_i zo`V%S(xZTmTNhG&acm|Gt=)xVcRn64mi;MWd31ac1mRx0UPt8tYQ?Jsf;=-DW!g`|MYy2c2;%S@D5b>tDxyU;2(b(+v6V56$y+|9oTk5-5 zF6qu?>Z2UO?A$Hs;xXYAnaP>6Q_p?-KW+=Z#Js?)+&nhpCQMxkc;E$HVe}y<+LI)v zM-Q|rk^QB`SZCKYPN~ z&1YN>9LQ%FROWS;tnavSCUo2sU6|WPFTpz?8+kA1OS}U;Yr+#4r#_h8UA#k7GS8=g z#K#FSgx40>2gq8*U!N(UpQk9GcaURya-HdxZ@tk_ug2w15QX9w>&DIn!Qw%+3bW(+ z072&FC4<62!*nv13nXI~R~m7~u&A6CG>ajJoKRLkn*4}$QtTBP>&x?V(XbNIj@~gk zRG%_%@EGy4kT-ul_y6UAGXB>#`D;PY{jnsds6dqe4;WhsfUAEo_KANJHE>2v1LOcE zr1_mr(w_X2Xld!_PSMfPo<4o%41mS|Gf`1fQ=gaD^)Eu6#z>AC&rcrF!l$4OuGLLu|YH^sZY>Sf&RhR0ImPM_CGQ9 z34k;JW7E=61K9}=suR>qG@z3J$iAyfd%+R_*({>**>o5GV%#~gOIEwQ?yvXwRK)cY zK9pH|{E$!;NX#jhWPNPo**q|Ria+G^88-INBsKNi3d2Ez>l~N`>~EZH>-8r2FV_A) zKy7JFV+Y@ecLmk$W2?tEWVB2i{UTEfYdXf)aDuY;o;dlxP5V^)b7CF;7n4(;1csBA z<`gxx%fDv9-IKZi#k6j(;zhGdcUivo&+#Z<)U$Hm6XO+Ed3`BCpYMZp*$+C80f~9l z5Z1?ufCa+F&M&FPAzFKDU|yMW^>xC6}l#8ryJ5e`>ySWzQhbYp>N1zp?PPZq$O)V5atX zK6&19;Vo+rl{L&@wW{?Fug760#_$mN2 z;QNm2INLXl>-f{|xB35iZHW-AU`4x#LEc^9HN#xeMGd+OZ>!en4PLsvMbTFO*KKtd zVU)iAmFOqD^ai(w4qT)(%BqJdgOn$=2TNEphe=a~G$N>|j%xfjGV4^In-#=Ol0ED(7dmz%Dy!aY%P$0-Q+a~(pPKp@pto!oHvMYP(`4sX(1kMCFP%yJE}xJJz0T9{P(ZP9>Vw(ByU5lQ5HgM#qqYR;Jo6q> z+b~?oaRFQP`hpJba$0@k5KIi*MSg{!IZ~m3Krtx&qGM(7PA+VwJ_G=c$k$Ns8N{V0 z7ReQ%5~nQ7YLZ(6QqtCj;>iU#I~LN%p)6&dUog`_M*uSjjJ+e*EF&9rsY%gP1mhSq zafOk%C_can@2d6s)W>-5*6lu2?@`3c-cQB~j&h>P;*})Gue+O@YMlCtxX%6a;Q$Pt zpnx(WD4@cxz2rG>$bklUiDZurZwFvvqT1#TKDuei1^`itqht>R7C)u2;WVK}0nrw* z?~jFxJn3)X;hGh+$=PBk_M-dMk04Vw_V%o^^K7S*B)cn+xMRrj$GWQ{frU#YdVKjj zFA&}dUv>nG_^&`lzIs_#tt&rDxt4tL=T}?W<5MV^6B4vlNJBl?6 zC%r-ohYy1@J`i|1n$of!V7D_QEUx>-_L`TmFjtn7G2H$_rBduXuJ(^Sff8s>!F23O38(I8~J%n`?&Rjq2uyv!+Q1?*PFJi3XYf0&9ZPO7rjOO z!|oMd*ovsJ$Ys|!n6S&6+04M{kGL077sKQxL$y9$rhvRo@oUL~%ko9A>!r_F6OW0j-s zzVpydpLifI87xYmn`|1xyV}9N=~NzouBh(KT^U6SCj~(^XXTxnuzM)T({c(Zi~Q{*$op>r@6x(1?AuidRN!>_K?;X3{YeLajac7@AGhW6Qb3=07@J!Bk|`kK zit7q#1)`$Y@7eP>f4E|7GDdcA)X|@?%-ir`I7^i=e8cA$_Dg1ys93OwXtXD-zSV=R zNCLETGm<2}!j8_A0y&g&w)DG(U z8KKv=75(=Ut_n<=(Xq(H`j}K6|@vnHBdN{oYBK&1%3ULw4t3^9kzTlQp5_&A z#OA}QTu5S!Bo=G3B`!P{SjHDiD4?Wb*qY6US?peu02dM= z+Xvv&I@lTJrBoV+@a|{44s3mN%)fu*Q6O1=eEF)$R7elZ<9i@IflghQ2gXH1G!x70* zcV4)tXm8(+BcdGp_9Os`6W7)7-(U9~XkBo!aNFz?-njWw}OP`;XYUWwK;VrQg) zXx_l}p@d+PhSdr+x>h$|u=V+J~OJX~BJr&!n}1{V;7#NLetXtCj6o>f>ud{bQ8tRkND zu%ni8>TQPOGfn|ARMxajadi(YjaaTiLd0QrAYzr&g?<~|K4i;xGQPJ~5@RZ8MhQ_4 z$E~auW4ak%bBqv=TzMl2jZcw&o38eCkkY+le|eEM**FCa{D9PrK&@vo(c8bZ^S{cv z81WP8h82#lOb>$nOlxh6`DD5&@T%a-O?}P+r_W*OMJGfzIilYQpriY}8cN3S4~M^b z;)|_$8CCj@LV5(cUXYxK(SQ;NuORmIMVS{raZMBdQdqJUpZE2OFkKgTaey`DP3M6PI> ziHctZCqvRLuz;9Jo$*T8c!1#$UK&N@E^+9*_~Bys7&Q^_;l^q4l53AT2h;7Z6(5F6 znw8>t4vF|cMc004H|(2Fxtu(GTJLUj1Nyo3Gftj5+VzZ0Pbqbsiqa4Yk zL64fo+T`Ulbw~w9MhHEX(f3nby`v1@!^yU*q{69cB?CBpO~t1Rmy_=8JuB$35;Qf^pdRHLsdFxvf zdp4z~xk}XanZYm#NUEZHE%68TD4n?F(_xFfUE~qK`C#O_S#J(&P)@WUqh*%qryh@` z6cwWSY(0UlY+>A=URD#+N(J_#9)gON?^(*kZe;>&ZCF*6wmpB=)S+vXRaEGaYJV3%T6LRiBq(TO)ns~dCM^xiSngOm$fbo_7z|I8b4^s`^`P= z9;`Ltl54(#idOKmR!-~pzs-%+C$BVVKrCgg;yCiI5{E8+&%nchQynD=7Y=`rpM2 zvMH`@qrLIvfEU5!QO_r8Z<1$v)phKGc}98sr6K6FD1yKSN4&s2_z%TQASHvCVzqW)lmf@)_HdIthM)k5%(@EZ0saB=a;M@ z<_+{aFY%>(7r1(-R1GtEJdf(#!F9lJ-3nqD`~#JC3Md(4y3yzzmDyN?`eO3jvye)# zy{J0N>*}!1x9}}@`9ztX;jOV>^}baI{XS^bJ_j(|_Xa%&jhzdomaea{O;OjE z)Ct(1iBbts3zPQTJ&)$njd%~aq9ZoU|8pw;9}DQ;p+kLytZ+7oz96Ddol61fVI-!{ z35Nyfxwm_lD!I5m#0s>$>4_TOazrD3K?_&P&?DLba*8Ny z<^oh#6dLar&^@n=Y#@46LCvpiO>otgg&yPQo~aB939G)Xo3p~DlRdPtr*Hz8o95+! z-(^^SM;vNVnl0aO^KFN>gH(1^OkY-Oc&GSuUE!{0E`$5z0SW#Q_ARFrmK5N_nR}a! zsy%3L0=(G{IYGSMs{sA+w*(1N2MvTt z6L&sqT*WjYqPQT8KVE#Ujx%Ht7^^upI!yHnDx7fZS8245BMEfw1oT=eg!gXU&Z`Q` zqVY|nfc&^{;3V~x_mES>l@%Q^@-rM<7i*t>;80CZ-MVcjXQRPU{S3^d?gCYz z)1F0AXw%e0My=QW)zn*j23JfYd3M<8)6S`jxQ7NGNv)EKH)EcLx;d3CztENz=TaopVvO8yV~nXKtY9y`nTq&@SJfz=XMc}tz{wX&Z=Iwu0kehZ0yb1B?ACay zL;_baCYyBMo36(WcJ)|H20d}*5Bu)J_#WUDPjAx>n0(~?^Gt2-{QZbdfdVIQ9kwMw$*GiFUKOj z>1W_u4GXF_1r43rbg$>0nW&o4UK0Gr_hLaA`ggG`!ZKm$WOHINhX3Qr70;;1LDJ>B z{mHL8VS&HiWvh%mH<>`5dF}9ks(IAeGPlKEICw``Ycs!G7VaR?KQK4ukx{EmodKVs zGdVB0Ob(RCt)N7qHaL_K7LhJI`Dmmv(yxoe6G_|O%@23Q5ghq!atyiFkJ)D@f+6pr;L1~g2Odcz226wt}lXGs;L6q-dz znTLDeA#f|ndTpEea#;aS*vb8^tC|v+!oiEu37#|63T$1puP)0v95{hUS+x<&A@qI7Wm}>;lM67^ZcU0}8Da-2 ze-@=tuHH{aPS{0kY{f>qt+=PUJEVbPdd+g8TkZ8 z%^%fS#Xml_NsDT0S`mV+@bD2UF%!58KUrrGS%KXz9!&2)*jw{vG!P8~+c{Pl6AFqp zeU0u;W)|XneP1fp1ce-AA;<8u#Ip*aS4sv9 z545HdGj1OI1*k@7&O})>Gdr(`n%YGH0XS!wraE_r+kt<*?0voNH0ARVWm@m41HP*x#5cOW4tM}KhP2u<%n)b5>xq|<>)$pN zuuamT__Nx+hp$JZNk86_NFJ~#jqvmPN{r!af#DSjAGZ_&BZr(sAL7}$z@ciYfhQcV zgeJZfb*C%f&Jm?oeRE}6QGT%X_Vo)FX3nultRxIzB%OU*8(IaUKfKimp~AO09!y7u z%WDNQArQh5LEv%MV}V12t!=c#g_OW6sxe&*$M<)tuv#K(RZ@tl$!sD%eNF9XOs0dv|s_t_^VV zeFBl$*UU0+-;xv~F&#lJ1lR{#Zk5<5WiQ;Pfb!xIYm*%ZqX`mriV;h5so$4)!TJsp z2cOgP%$yL|2qDi6zuPE*7m+O2&Bh2PX%=oosJ3HHf6vbfENzW`ny0F?!`laznnPt0 z`~6m2rErMuQR184ca@i;R$^j;B+`^S*c4Ay=x&O2da=hoPe>(mYahX_y`RfTsfBAZ z7-zE)R$o8`Ja(*b+GW3`@Hb|q%ZXn))c>I8 z@>tT=V-}2U<{dKc&ev!)I!mh*^88WZf2sT7e`M1z!Z(ha9AMulpz%`ya^v&N)aVYq z_CUPK^jVac`#P>u!qxMSjxw~*SzEJ<@{t|cYPHrUZ_piQY{^|N3p+2m$W`7BlR6~z zb~Wv4Q$Vk2>NI#OIAjd7`17xk4OKo;KzBUJZnJLpU-S8mdCBxO%63*Xu&> z*e8L1>Ii_R4-S8{%_QghaelFwhO(9N#S6zPg12Gx;;{l97y#i*`SpMP{4s4oXK=G? z;IiimZ^9`Y7vxMEYd+4T6>!IPVdACE3-=yC9)OR<5A8VbM4%D8Eoy1e)?SUvM!k4J zce1KNaLF?2RtMP8GF0uj9J1b35AFIE7nwP4+Yx~b+}|~;-b|O7B(b&E8f|si-%f*?nkat zOMNMi(us}IsBt5V!xjt}EZz2zpiX}pNH}q0ATFYYgGxH8vv%{F=$esWeohB_j81z4 zt=;_Q^h1k$_T#Oi!7gXg*UbkPk86v)WmWf(Nz(AK2(BkXMucDSzHc#*u-Vw>ZUJ%y zh#^(zEV_ICfCAdJ-HevJqr$Jh%>?h!h$6j}ob0^z?zD|J*O?O((9?0NL)Y{8Wt}?L zkv)GPIxp#5=8`wq3_gfVB}mhanO82w$WIELZ_CwSqq;jQOV4HWr@>nEebMLOe}i#i>+XOHiH*<_yO-I|TYhAaEaXUK!K}lYcb2 zuD32WQ^)2QzT1tqTqBxk3MBcEESy)syZT$mMRIEfcaUFim;&050xG3}Ww382Qu(pI zz|A!AvGzgl4|d7}oPDW`0B*0fr2$SgCA1Et5Vxe&(|rL2KIpED-Vu9xa>A8tJTXk3t6z1!CgK7=8+<*vcX%wYf>}uey>NxTRX|k2%vy zRX~^hqIq>Aedb4>FD_7v@ji6$cy!A=abL7}{QG5(SjfDhx&`3%m5yn? z^X7>?`xHb-Y?@KSF;$Uc^enSEb_p(+svv5;yY=Rk@O$}&#s1cttaERQ5had|kCcjx z(bI1tg+l!d?=(%r>sU;|L-j@MhNLk<>4W+lb4)^(Cw%u?J8PU%=ym?HE{{VH~a(q+U%aes$=OskGw{RSnPNUL9Jv@G+I|q19{M7zX3%8V>Me2N$l&a z5JexQ9>RTF7zsGnWgh0^BN_Dg^dCLd?it|5k)8*>JZyP*rFSsXr+k6~4!>>hK&VCb z5qAJI19pnNpHsGryzgWpztnRF*lpksPrYLG^Z75w43|+^pC2=+?;Re934DJt2#geN z33VN@-vMv_da2BOD;szHq7KkG$5)B{C4ng!8bIg8(UIXe6h`|emqUHUP$h}>mfns| zazxJjIZc{ zS;vfO3~>8aWO58Xh(7bO@)b7=1@w&81Wqd-pnNspjkIjf@bHGtr5qs)culi&hi@V4 z8Rpf=HP*Ql>EQYw*q=IG-5)K82Aomn4io&> z+QTtpW*jxyy|)X91q5RAaC)a@p5T;QRoBMMX5OSdMD9I`2;f*@+TzNAOSj1=1?9tP zkp)0hNn~s`d9!eRQQ=AC7U{kZ6S)(<8Ca5m-MsxLX7+Huy^$+uY74_YL6FP;^~0UZ z9rBFym52sL{oxp~*Rfga!rJ#M6c8#Q7dEyVgnEcM$d|eBVnLP_9knjZ)2gZ+=Y~uD#%{B2+i3n^6Kc;drIkb$j9* zEnUIB=LT$g;=TSu-uLvAK_AeKesBk;*nIgiPXSjSjcu4s0Ifp!xUXlhf6nF9osL_} z&;Z7()E(vL)_&WPK2NVc;k(9U|BO8-Nij+HhiuFg5S#H|$vK23Iet;U;!o(6ns0h8 z=WkXykyaaoS(o7gi$A84V-@^?Ym#T@qq_)NyAX7(G=1PNh>0Cm~Bw@=02 zxMvV360u?^(-|g@uTMaeJ?swKuUm9FYvjk~E|6QXSrm{O5cJXqL&gYn#COFIOsX)> z5Hg=iV}V7=W++GDENlR|=)rho5zLJPz7-qL${msnm7M4l#kbO`)t5{owJJ`j+z zf-Sbp0b|tx`w2A2f(CZ_tcatwH##xf{Wk#uSRseP|J7^@1=R7j8F2F^0RBa5@{QOj zSda146thlTNlFujyh65l2862sH1@k&NSuf-Y)RAtQw(dp3R!i?FM)jQ+bWAEsoI`_vI z0^{3c5;o+VD@6{?qX6?|FqW6l3n+{Xhd`6eif2h`EC!(KhwN*-IBH@Q4$} z39F;1?~xH5xx+i|FO1kPznR}`hC#D5!ZG0p8N4cbZt|>&Z~?Js>E$I^pujt%JzW92 z{XsAg4CqypTv^eRVA|`ImrE|5L55tcLOPp2HDV+*HD6My4|swJj;q?PB|Nh`+q)eY z&EC5maQw{HWfI3Y53V7Kc+T$dqaRT_)TMG&cuTNn1ZCH z%Yvxpta72WfXJy-E+tcMgifMC8k<{G#v%{XjEzIk$K&v2)EzTFR9Ed$sw>^)OmA|) zI8TYPe~f&(QtdODT;XZTk!|; z2FoViO$eo5Npmn#Kd%t zV*l{cunoRUvvb zX=QybboOfWBl<^0|JY$;MgQ!Q2~4GcWU_IgGb+TlSWd}uylhpbnS4!tU+mM{%@X7J zPl8N%pBxH_=}e{}>9hq`gmrq6P{ppr?!7Je;!Mj=DK<-&?Ef5(JBQJJ4H=Hbpm@0H zaPTNBB53#@znU2^D9{q<{k1-v6tMU^pIp8ki(Q}J(5KODEOieux!5p>U`$x~=xv9@ z;C+>_MT*#_O(_52%2!x2!Ctq3cCNLVab0EL6uHtZ&_c=4KjVdAs9gZCZR94|!?ib$ z@fJ?MUD8AEf!*AJiy6z#L4d{dw_g|CZS(ET>PMrQ8yo#d96 zzY|u-I!J!nKgKQfhEHAsb( zSHYv&O!+w=ag5x$#79tB*xT*0? zkI9@ofLq1{xps-TXjZr4OH8v+_7i(3v=^wz&i@;rPuS8x7{ksF3k)?rE&ml+bvMCD z_*_I(g&UvTwvt zGhU3HV%j9*S_wK?7!~l#CgdRm@cn#~DkCaf$}v{Q@n3}$QQ0rslUsp_Z{Cjm3wXq< zH@epjBXsxe%{E6kLNPvRI9I$yX49{6Kn%wyMqkOkAhr`f2X9ve{7C+aA4O+jxn4(vz#*9r+zbaU8kvFlAUOsKLy>AM!2wCl9FY_qASyt$On9PiFl9hiz4DS{$=^8!gIF zpM)Elw!?byu(4D15DDS;e@&kFwRk<=J&$%0WE_b9TRq#YDBVe+fD|okAw00}DwPn0 z$r>doP9D;Q3(lMb)#m)OmtLz@MFQ zh~32sFE8aMmhi3QLoJMN)qgtocy^Yiy4rHmfyAPCQm6f8R{wh71Et_4s>96QRVc7E zCm3x7)hXlq6nEgn2U}KN09Qp5A_Ao{2pijf7)M9E8p`l^M&+1(t08Of*q6Rn2K>bZ zKZ^iBcJm}8eam>wDoC2gVx{M!@S!~Q%-KO=gJX~8;kMZOz=*~i%mA}r#cqTIompU#EStl%z;X~rs2bpCOUYe643S==It35q)|t>At4IB& zfA`PyqXPrwj8rvOYnlN<``Of0g`dee@QgswSUYu<(O> z5zJx7>gbC^#I>D{2VeuFbgdzhLu8Uopd`aGoU^(EaWia>%SZ6o6bm4j9x1ZlD}9`O zG1bC%$a4K0EWr!5Zi`2eAF`GMCRQqZ8K!6EhC7REb~s%_Y#O$tM)B(4iolDR7Wh;h zVg?uBZ%nF(iQ(UEtt=sso(Db+n1-#gw$t7(--Bcm_ns*vf4ZDuo1xISc_W@}{g>7e zIqz)R(dWNT0dY(KNzXK@C-$2P`yt^0QLOmTRp-D~aqb8(KPe!<66zT*4=JDbGuH|# z4F}w!?*hEv6t-_8nKm-@f6*w0VH$SBF4d$~x6-%>6$c2ONo@Mk(ynTgkv_OQUa6o=(5sfH9=gp}lQB~1_q5IxE3=f!Z_mTil@2``aLmbTroV%?WMbNm zcpuU(!|2Y8*fNbL5(yLcQn%zRgSL->6NVy(ld1hg8KFr5qq7 z{9+HpNf+)`CSY~zT*qTYo?Kt=YJ2-h%I@m99;0+2H>Do+U=KODa_nK)2ae}V^Br*! zEq=&q2AloMh&jnR0MEGKhJA41%V2q&Pfr>GvE>y|cBp798dah=GkiTx<-nvR&Yh`X zagNGvaneYhAn<(sp`%T7M0w{sl-oFgS_24bnzx4A&-br<=L}<-@oJXQ+~GlUBwJjw zp;F0N-Qfmy!nGVs!qf+`JROqwT&vd)?C-`+-Un@ul$Ym}9>&vsbrGK#Y?tM=5j97PuYve3(B??GV?GT&*TM=yHmnW^Ze#HHp)gH>5r-c_&K-GlU z2mLJFnz^nH)8#>VTS1brJkNmGS$N3eG{AqRNGM>vX!L9J4_#=FfE_fs&;FHsy zH2r6G;}gZ_?$R|&>M*PE%r&W#vfrFe@;NiT_xMs1YK{D~&kHHyln^1_eWq>U(GdUS z-0KO+6qN>9!Hlr`A)NQ&SA`cBS1VE_{N_T~Y8K-nj@tVO+PFfjeX1~VZW%7(hkE?t zN%*^i%bE9fAAd2bNzN6_Jv4vJMJ-=0sh{GWx~v6}+Ii94XWi%M=2%LSUSNZJss%L| zlOHetR^Jn^TduFSg{*b_pmk^B?8u8T%;R`2)*Uwld?Oq9L5LLHsT1PccP=H^KJQnH zi1HoI;QYDR!O>oePo0Gw2R8BXfIDhBP(~sBXA0*GB)s{y*V4ggym-?#6igrI6d&ZX zq|I=HYdTCT7g6E3cT(-gcgTO@UOD_A44O=-mglI~)NMlU|@zr8qR0_Rv zRx-z1DHZa+u5-;YE0HQ_hvh;sq=n5!5qOzrJZBiEH7V5G>)q$QKj5*rT!ktpYAg;) z+-GQwOG&smK*kV5C?J|m=GHCRoT%e!8-+F|lB6P|KPD7ZZ|Z9|j-4l5X!rgQ_cvT( zxm2wbd0mb^QPj%*GQNVjV786Gj%{kLHnRR!7q{}>p`@Ed^FH3q@&Sa*c2FfBqD z4J>;Grgdkql@A$TKj|B?P}x^`I`Qk83(q-nG3AA33 zZju-4vZ%@YBi!ePY~DM(9xiy5C8O$b6<)fUrtBWC=(lcp%&!!pwhu`tdFA_c`%We6 zI8?2I({i$zpTh=^?ELa3783Vk#60FKuP*zQ*W5Sky~RQ2I(Pv`AQgYeUOw4Ffb4Dp z5j*g}`7IXBla(DR`xX+ zu+sh6%Z>!GMMglVSqQB@Sh?ZCn7UZ0F_O|j|FXEdMon+0_VvXGabD)@r>OfYRs_Pq z%+*Ey&^uf2R@=(2_q+L?P*sVTiq?HDMb~$&MvtvZ=0CUo-QG~p**A|`-oREp3=+V? zvHCi;w&(rIjrVKfj9ZQp>YqE_t-T|&gg@S07iC-nHxSClITs+-4$HE0XzVW#33aDS z<1cdm|QlRVBhAd9AiaJemq)C7h%3Yu($?53}mTafGLYtt?`~+ z%k>tI44JLj>j|1y?kYGaCSg2K*CVcm+~eGORkeg`Y3UyeA8S-iRtksF$2lafqi%OK zCIuXJNTfLO+(hqNwPIk)O~ggkC5`yTa%aEg>y_P3f`xti?o}S))SK<=LD%6CK6GQt zD5D9yi(;E$0I&=Hi^41*&v#|Fvc?Kkn9$J_5SNasb9;~;pdNVrn(j170rIYrvDIKkiS1Ww7U@3 z?!MFxN{V0tot@xum)WtIX3*j2)}Q^2jZrS(B2i(dA!68bIbofJbsjE+{S<@+!!>=_ zi!rjc?_w-QzlMw;^C+NhR^brYfnP!!Re}3P3jz&(5S>N9gkm#h?Ki6BMVKpLlZ&+p zlbO_dZxxF66pG(U;xckfxP;j00s+BLRqhwYH8Nl$pOemxd&r0L%6di`_#61JDxU3> z+O0#o-V9CEJjE~-?i8@%Iz}p_uWpk`dp9`)F~zJ9nS(-yyrC%mDjn)uipn<5Fa{03 z(~QeAdx&fMS;{1}#gs?=LF|2ssus3>Tn1+^Eqv7!@7VH3E(<3RU**Oa^(fku_6hw+ ziJrbklaPGzCcSc*=1hC;lFWhh7mX<1U^S2zW zCubjHph<^}5gi4WTh7fz9|2zoSmUO0h;lv6{N#6s9 z!0AtI^iKjt)!wvqOHYnuZz9XdhCoO$6Y|X4ho#;xCVX&b=QxPG(hT`kv-R$K#GzrD zc@2Cfo_L3B-)PZFy3!PR1Pxz4^wyan%ZyE8-J+)C8&IjrfkBSICOlw&2Cl1DQ7WxT z{1&l^rtJZw*+Ba!p#Rqxq?5veQ=k&CGC}a<0 z|WVgeSP087?KAzQ~PxDljN%L34_|V|D%&H4~M#Y|0k6eC8Q)7%hY7a)+)>- z3=)$))X0*^mL;;yh(gF%Lb6P?{o%kglKjIi* zLt&pLah;EE8SB)lK$Ls?oe$(_H*{z(TQp&xe&Y0Ey;3W_TrV3InBgwLTs?jgF*M%B4ibWT3WcMio z-Y$OlGu)3fPq|r~pQ|NSUUqvHSy{n{B#BCUS-hM*f(*)2()Jan@w)ekHm@LV@|`&I zj4zfYaW0SbEYJwDh1T)W|JENK7?eF#_IeVN7s+~??*7)_pTEtY0$*H%fQZLP&wz-9 zf};c`)>H3?n*w7mV(G)QuwaUxfXj^acKIA;Tn^0<2cl1}wU&DlPd#zm>WMsbFK`E1(N_um-G&)mM+k0EuW22%45e3UF@8RUoF9^| zc3#w24Y%>h4lq^^Hy5=KKNRptG?SW$3*Fy#cJw)ngJ46_fWORs$~!udvpQ-^DK))#9&IC;Pd* zws*33Pkjg7V1!DwAtzjF4feoQ_w8%q6N1!`TTiq~_iVOkPPPMnplwJ$6fN`tpxpi_0LnDF-dAsuCwzlMI;+j_%KH4d1 zdTk^L54mi-zj#+&#Fg-0$SwMI09z zZ$&8iY;w4gXVcyE(f<7DE+B`7V|QIBx%zueN%mV^NW-9mUe3|wTX9Qv>&3uzEu3v_ z?srRnls`}{?7$1_9l(!s2V*>Far?aWR7Ii-y8Vhy8R7JP>$y2e5!YM(d*j8H9;s}3 zdA`C^wA(Qvwo_EwZjBc_d`N7)dH=mmo^=_iWzCfF#YbynYAxTc-^=z#z)vOy{Wksn zB^p?QCc~GzZ`Rt#CPsFlnqWRF)<07*9h8)rPQLyl8?5>73~~if^DYp5wx5hTVo!=I z^S{W@gWZ{tT-Iy#PwC)$3dir+}g$B+YyEqxBvH)$v{_~G+pB6az>7+fr zx!#k*W&4Mezbce;rc2tdZLz+<(AJ543ZmVzJFS5b<$H~nWnFD~(a1`lPj!nY$s^aw zYmcReck`j%I^g<`Xou&Gh)g+;oJC|Vqv(5A5aa;6MSjtA)yss=SDx<0k;ZB<1~vJ;$1aV zCn4#*M-@?S==JGNss2nQt5)Cm08PP(XkSN?DXMRqkAX^s%DxcKQ4me6?!Xk+uW7Kj z5!5R!s&~Hnq|qJDgjpQPK99VW9j<#MhlwtlT%?9%7j6*}-sc~hRyZF#aP@C#`}<~> zv+-0GzwuOIAOqm6tkPuI@sy5;Mla}BQCh1kvogp-yDBG5o3V<`#1@^rn@tg6RN|le zEiy3g16wM=JMy+qE&UEL;bki#rA)pPCchMN`2`XA_HAaQq-?{+@Uht?9|-cUF#OYp z+`-++eoPm-bs3hbK8qfxvd4!<0RMuVBH}y3r0!UCu)ZxZJ2CvDm;C}yiwx5T&>B1=OXxly>yt@8P+!#)4}SO+OZ_Wdz+h<{6%L>%rmB6D*Cjv0t-q;OzwXV= z%)Y%c?}~MTA(2OLS4_U<9}eL>99=ATeDeN-har-ha1U~)(8T?!xZ$<;e65e8 zsGA&%4K&FPe8T&QF`XO|Gt=+n9^Q^iGeEDD<~TXb)yfJb zuM%w61!lh|^s91g5q}x6Jif^h#7owm#YuU?LZ^!6eruM0WJ}>#q;8t_epks#EkolZ zyC&86(O@X!-1{LPyjH{%$>7|Ga>_pLfu1Ta+1!Q;CNd`$c!tdS42CHYKWT?Zj%xUV z4D1r&6)W#UEr14uFj|j>mfq)zYeNDzt^q80Ifvk_ea2X14{X2ISi$jvZ5*Nv=OY?5 zuk^wNlVxcgU+mj7`=EW$W$2=8o?aK)+&ZNE(`o({oGjydN)|k2mL06lQO%q5%!pfJ zs@OOmrS>o<5h-CMjO1hYUFB7HVU{g73i3wRI)e4@Gz=cN+PRkUVO>3c;jXIWlWl>1 z_-|AU0506;w!>(bApLe_yg*_CC5fDKy{%Y_MKi}?lYgF*fA1wg?{3MaY~Lquf9axF z>od+JNYZ>vs?ANC!-lToyPTLUJ_tR2FXE|tsyvD6?YI>971SuOU4(xT)(sh}KA>f9e0%0(A zVTB?a!^oUULzVI5ItKYX%xIa1GMdN8M#=i;4a&t&94pT2mV&w; zihl@Qg?ess$egzP(L$W@mB{&lKm`m3oCfFE?K?$5aUB0B0=sqY0@h@Be^5P@0YAK` z%^dGZDbt0XcgS=t9LQHSZLn%b#ZBRn-l&&Z77 z`;nbM--S_5jp`fHta~B3K&W1>sjFu3q(2UIQT+6Tp@~E&@5A;!nHy+JYE!RD((R-b z*XJ$cTh3Ier8OO)>9kWI*&D^%`tek!S)Te9-7q0-znXY@kRqe8)LCEYuub##KJnL0 zPuwsrzRK@EWH$wyox8uvWYpR8*M0Q~zug{X{>)GH(Gu|EY6fxuapUl0BOygD9sZU^ zDHSY$0BoO1cg^!Tvy!_j03lZ72)}e%V;Unw6o6IxxwlCmP^&>|rTX@@;}^a@P>1ib zxuHjLaS4&0eHbD))&EjU(L90C(*E7D_VEw=%RY^lSBElVroN1wPLkTsYM0!ygE0Zy z(P8p1WWuRj*_*NbvXMfX{v*v;b(-WICYjj=9s(2EV8S4pacRz7?h@tN^xU4N9RDsZ z1@HV#j^p=xZ>bclcpcDR$PgInz*P3BaIttcGPAivE4Wm(7kH7VM;y)8)9PyW487~j zl*PJm$>MJ}NG~oroqqM)b*^;HfgnAVaQ4RS%+{R&xSx5XY8BS*+Ry^7#x!cibR)h( z#EyJ<3%R|2HdA6;r#dDbmE9OL!uM2wvT<2?Jh`ES)Aj}mAml04;~ zHatSKtCtbEz#H#V?D{jn81|^JT{eDEg?FZ98dtw{Za_QfB3z&jJyZ0|32hONv>r;| zC{dTcL0e7uBz2Vll$ao{NgV7U-*@@Fy_TN>>K;#$L$*8K;O}^O*-&xhP;l>o%p8=z zjjWw!)G0{X`5xw|Ik~yI@b>$;tboaP?&VSM=8NsufSI|!lK+s%yz5xYx#*0}8JbS( z)4sDE%XEaHBVmL9S< zd`;w=Zwq-{q?nWMF~Q^ zML|pf^F;?S_Vo1pBre58SKzRQLCsOSO%7om?AN)xH3S=3rdk_5l)3@b-$>oz=9d(Dm&eizZjV1aY>X@X)vA+RaJ zj@Ifi!16*6M97j#J`2zx$wI+weQyHg95I%<$+2e!+YVt*|IhNU6Eq)~kM&Y0OKNzu z2=x&`mt+@u(0HFg2kZxkyoD9mA`tjFzoy@F8^Z^x*g-&5i6bPC9zo**s> zZdDgEa|mX#l;x)V2ugBOxi^Ilf8%BM`Ow7ceeQNc?Rf#6>p(zmi}~_>#UThDYk$a7 z`+IANG+Gn61?^T>LbOzDlarnMg%Z*E=&D0osMbmhJ<>97 z&iC3k#y1i^EYBb1w_ddl(|U6-aR#k-#|nJQ-nTV}qhbXBY zy~$D6ITYD1u399&PTA-!%2n_)Fw&j_Z70;qXx`D<09*U;KsyLJK$T_I@eRV-0$)!R zOFS!PCxtYAnqEW1)sM5=ZS9x!CEIqTVeg`{c5gwa<}mzhcT>HAtWEN>%agUi2;11X zgq^#<<#J`(_N9vLD=Xs?ewkf&0k|5+h-x1LDl~VD?ES#?DQnoGl99Y<-+_Ac;Ub3A zJH#*8wO=g=Fp01!;8L+m@Izieu~EOS+XM5(5JUKC!HS-?(w_CVtF{%m@HS6=gb#*d z=(K@P$hJjzgHM-nJ(?bWc@(ulN6A0w(L@jtumvo7A&jYTd3Z-0J;4$+tS~$+WTXDDcvmC#x^oztCOmJaV&NW5QK&{54TDX z*r_WEN_z4V9OmpFV~)Az`AHqb{XW@$3ExWOha;*%rb`7j?=M{;>(B#d+Go9&qj$;e zw{(jQK5zTrM8|1v7o(4NT@fT+>T-Q7E&Wz|MhP~QO9AZ_H1R=Faf!fVVW|O&hB!(F2SZN-I@UZ zb0Xt2ny^<&XU_Y9KT}A+X-`Y?_-z)&wjx1)GNPYQ4e^mGvfReV}_>((rnLT&Bz1KNCCX=Xs`h zZb3gsiD7w?^%LSF<7hm2u5-PR+H_`g@*KD&0MX}q@L*!rRtzPm_XW{W^_?(r)ebbO zRCY;P26EU&8H^AOIp}v@5U&;`I#ozNzFI#UDR^(JKuOz>D0oTEm8-|aD0a|k*D_t< zShrtb-Q#tkqRh@DwwVVA8n7O%0@Gl_WZb~p(!yG2Dq8u{-4Lt8qmcuI1`i-NH#vCB zhFFJj8>@8Nih1fFcAn56Scwf|kH8Wts!*+jtb@fBy?8-elLBmwGH@+>aLLdqvOmb( zkw4YuqO-8^ehH3T;E?){lKgi$loKQB!6wYbmi9v%MW?i`6A1gow2Kp zSgPcjZP9;E=?a!2&t8fdtLUF82^aag_d_U1>1txM_hW593B8zxs}^(%Z4h(^zQ-Bc z!h88M&o_h$(P_6{Ij{1V79-_XyRr4rraz()^Vz_55h|<|!Vc>Kia`ig0Wds)wbl0Z zk_})ljJc!f`drBQcH`gRd2Vi`Mn-jNYSGWmrk$O$t*z)AAJj88{{H>@`uc`@ zdeXnX`S|#fiHYkP8}RP$ih+Ub>g)gi_vz^9V|h6<0000MbVXQnQ*UN;cVTj60B31t zGH`BZATlm8E;Tu~t{(sZAOJ~3K~#9!?R{-S;z+YL6M})nVAKdm1Ob<+FlIeeOl=`I-{uICTUud*p^alg@ zQ!c*@@H3@SDf-CQ))~CKz;_3w0sdxL7XDuDm)fuG_Dd-mpPcj4-{2$jb+Gud1KdQZ zT!!`G2mZlFfqx7J!y$+3pB}JZ0t&p)G-aB%%;71Q28ditj=#;n`F~5R<9`7xS_HW1 z6-PT7yKQUNf*+QJNLquz;49CyG61aC$pjWi)@bkUS~P}06TSlf`7y5A81%)DJl~hW z;#ko#@R*iW#xaD4-`(AvOxlyz*=#a_-{EfZ&*D|;4+xg>%L^f29+rWjj)$)R z-~?8jOjcI-!2Bcu^r*wNCyT!QKLZv{I~c-FK-^F|;AeSwJe&YXv&j&Ug0Xvketdj9 zS>4d5(1OoeT<9#EeK;AyWaZ;Yc{b^GCqRka?(xb3f0;jGBvcSDyYS!7 z&(E99YPH&Ic4^Fx#Up(PF2MvP)K0svuhx05w}{q&1!(%Jn7{e=`T1-h3cGxC#h7up z1ufs_{4auqlY%+#&lc0EZQDT*jfWa?2cU0(thI+PWl)9iZ~fks z7Ev}AfnPnGKes%G`RDU_r`oHYgH#Fz8N|;GTF-j1-yS)@yW8zF1#7;?TbYlu(+ikx zc>I33Z?$ItRKBj&R8_Cl+)&qbSq%7BJqsgLRaMip2I4heEEdaNr`S2~%;=HO1KW6} zQsgRuiR+h#uu!Qzng)5bu4r}DXSHk=rxxqfYRs2BO{q(O*St8I_lmvFya#eGrXQ4q zZ}ZY`_xn?c)i;Nx0sM**J^LKX0^$sJ>rlOaB16CG$uwwRKqn)Q}UExQ5-FLz?!{I zwJFdVyn)uo#SnuI@SfYRun9#|bx$=N$Cq#qjYcDS206k@GQ)aZlKi^sDUO|4+>b`{ z(W2O!<1=+*=32L~U|=C!0!QH$q^}N8$r59(i=gw_eLo_H=fS$Z!yL^6xbBy^(Gu9V z$oCAJ=JUgIzm{G)ffnMI*vgPYcsQe8vzM(=Yq5k!gRg>h6?FVpG3=MDa(gxfrqVo# z0T^ygmSGdV?8we4Sj1qu9_si|z!pfqX)AZ%x?hfPJIL`!!3{~|g4hN}ffj);GS&$3 zr|bi7CBw%7tjpl13k30C{+rhQeQUIAEl_(!EW*JmzvNim^)`m#s*dbw`J4Mo_^Soq z#jm2S=XCrhut1CK0>J}TS6R(*Lgq*+$b=*}R3F7dULPndMh%1r_KJV<)62`t`;w zed%=wQmBFi_-n)QOeSl!Aajzr%;hd~02eSB-aO$z`k6;w0Rp;DDcD4EwpDuIQoX;`H^pVfd!$ z=&lAUaF!J!?}j*J-)q3<4CLKR=H%q^p2Jm*H(fd|&4NbQFgAvakETfW)6LUUCX>mD zZ+0TR^-o}x`#IZJLemXFS2i5iG(8h_NexNfkh5zF9)@Xv{P_Ts35wY9Wi6OK-H7cV z39F>HN*j_soZFHTf<9!X>Y0Eu*bihVCip5^0t|>FNsTOsDDao-NKC=`Pck`>#wDo6 zh#CV3C3B6?l{PqEW`@BeAmP>C)z#I_Q-(hn!Tfcw${1#p+SaR`S3IX4TfNT?St(py zO{0e@c2GSW<3m|!Ht_rfytno=U+4Dj)9Wyx#?6(Oe_8C2B*Oe<3#3qL=$oJSnCG}k z;q3J6Y!C3_UqsfbqIKA=wEha#ZVAux+PMHIt~QwTRj`N$m z-8b+Z`#rnfs0)$)?EGp&vVlwD`6J#c@AiVa&x~zg$;`ffzP>(1xNZ=w(GpneAHV|2 zwENaHuehPfSg3v-EG0NSJ(~&|a!G{UfD?*Q!K7RQZKdd5N}esDYUhkK`2eAh$` zoPSd8PnqhHZe0gUHgq+A^t^NU{ETqn_rN|B=T+kPuYm>rRk>p~>XH+J9}Vi~i=z<& zYdv4%Q#~OK7e%ffCNI`59)McblqrtsIg!`-Sz2>@p#$Xm z31esH`5DoA%HU%m$A1~D_OLt(6vfHcUD%55epzRQo>q81 zz74;^Rh)AjE&nswc56ZI@2uMkG{>v66eot@WfhM0kB$H?d@Nus`WDFH*EtK+m15}N z!a4OiItyO~i+NgbM2`iEE9Ur_Wlhl81t(jRq>!9XVedW*7E^0!YII+w4K?(#+rTpO zKYstdMYwiA66ss5r2uR2HO>Ncr8k&osJ?@q^jE=x=XHZ0Kt)c(6G6n;#A^44ZD3xN z=^m?@&KJQ_Lr@YxjU5to+BZ>SVk@Su>Z$o)32*%8&z~O%7k{dM2Me$Q6Ier+-FHmw z%VOw-l3D-3pKFg;p0ifD*`HW|l_YzzABK+LEa&qIz9A|3AH*fVyGRXGTirQY4VIn| zHl-DQ{rZJy!IuuN{{<`%jh9mCb&5gq`a?M;{3lmZVP~cfF`}HU)xbN&z=oMFc#n0R zHQ1(;DurP!9Nz-ZA0k?yR$9y6yxE)#yX_uemD)T+b2^5*6a~tLOot4*1G*ZP@x#r} zhmOh|w{Ub6@$O{~BJ0lXwBf0)>80lf$L#Lm?het~KO(ShGAm$x$|)^bFBVuR38Ra( zMH;5TddMOSvSH z&^VNWU<{)Ge+Pj9VG0Dml3F+2O|Y0Do7(snpcQTA z5}Yki!KF^1Xl}|Sfp|*BLllQNs>U>p$N~fkff`$M5P=oo&WU$#p1`)v7mGl1O{VH8 zPLw@;TzPnSK-LmqaWU+C0W63U%DKE^Y#hBfsvA0f4P?Xwu?xlpSn%Qk7JayQD2#(p zl}r~fG}2(1vgrnQ_+&qkwLlI>qhfEiYuSq9=z3aV>tIeKU<#Mzi6RB02XkE$_$%%2 z$*RsAFNmliwqBezfDX);Q=d27{I_q92M-q1GK&g!8^D1EFHB>e2lGM~1 zMAWV(1>?#A9}ka}N|1Mfx6HJ2?CUkh%isO_aVrEdbJA)R!4{f2D2LSNYwq~q+hYX; zk%L9dj{XM46`$5wARZDb>NTt!S@K=fR4zjGPyw(iFi`q0Kmj}eT6hdB$(vw-o~aR7 zf{uGPCzs&HpHG=)cwos=dk53#HCTR(!cwUmR4PQ5$A@uV!vmr;Sj_c3zra-xft9&m z0=7%Wc6(Gnf3e1rLE9ptI13lu@9kaZs) z#5%ALa&Nc=tWXNgg4p~sgw#)$OIvZ7R0E=?IV(5-uns`M|M<2sD{NEaBkY0-nK#uA2q91QlIC z4MER_T>tcR(wd`k-*6V?8XiM~m`Hh`2uKQNDujx7_s^eS0YpZ4lYs|-3~$G9DHk|M zW8=F-4xcVF`E;1$IudZL$G!t+0S$YgUSQxb&eH}7yu`X-y!xZz%~@c)pRoW zg$g%iwBtMB0wP%WaG-wE&Z5j@)eFJaf<^&|zdhnIoFWv*!AiHpS`ruypo)hl{XiMl z!38U5-Go+rx-2N+7O+^&2;DIUi%ac_6n44F`WRT4diYYBs$hphXGPW{H7|h-K2~7! z6+v(0Dt^$hvvYX3^KAQdim*6m_T?PZJLzvBvAJM;# zM369!DDwP#T2K%ta_tKRaPZJKK0x-pxQKWcefU68)1JPLcXK{6);Cn|=p;w64%x!v zH!q~OfMvBI%n8jLOp~KnvGFkffzoZT>TPI(P{Z9lBA&Jfu9QYJ}&SFn3rVzVdasKSHOIv z#T-I$088RhxMB$j(; zo2Q$rtFyh+=jTIWuG?F%U)-&@P0nypMFa}C2kE1hh6^#|_XE`JU=Aa!Vv3wiuclXa z!M+B9?7#|y)~`E0_+cJDp4z(szhnzoA;gxh6iMN)#C>m#@YwznV1agjwWe-p*3zeU zphjJ%!Yve<5$*-hkt|&k;KlCA3H(5~KpJT?h!@a*KeCnx6&?Iu+F_m5JU@LrEV*9c zfZIWSD8N|-zK5)P1Jr=EuJ-l>TKm5VE+OX;u&_o3Y-ZXS^#Ccbh2KaDFIJ=wZ6U|% zqseS&GtWW0rxh=_Kfu1hHyWsQVVzqtY#gf0$t7kp++SWIU^g5s;I19i_2g8Lau$0A zLI$9*q%`Hh!-`g^&?*9}Yx){egy`{v^tdMO-AB0iAnyGM0Rk$;=~l2z=9ydyzok6V zdA0jFum*k5CEFJXYZ4a^&R9S8(T?!jtqfk)iID@mGEaiJz?ne2;O`w_1@_MH{`Vd) zz8Zd74Ds-(@J%pQq^`N-B1KLxivt%B^gwEmu-_t3`}0sFgotWN->KnoqKB6uB zz2=c(T=*HV`a@u>EKBPW@Bp*pco%o#;E0?6+yrL);ApiFu9FNGMdB_R&vf^DI^E-+ zZv~2{qeP@)Hl_v#BqY%)5mv;!uuKb=KzaaNr^H-8kHp||&UqblB1Ge<6IfIBJ(m~@ zDIWW;NnH3Du&f-&hNq^%GDD9u7FQ+QK=b4D6Q1C-#B4|yuo>J7G8f@RgRB@C%o{v^ zpE5f4avEu{r0<9ovTx)waf)z)-~!7LUqT2wXI_+YVqPKVS9t{_E`2)TGEW{KeCP8c zSSz-$J9{%XYb#joKruk#q%8_Q1YPp|TXYD7%iua3EWuZTvvQp92-exD7}v0cz3CNb zou}M=3w$iRM9{WeX$9ZD$E%1ViZg!Aj7dSo`Mg+M09-^6B1go%1G9iN{Gn+0@AL?xPa%vN`&__v6PGWzeHGc{k^82YAc+VI@yeA!k zznZ~>Al!G5&c^X1-NQpuzLNtX>f~NtW%va%ri)Tp1R%!I%3X4|P7L&l!Pw+3TSdDe zd#+SVU#_AQe&;mbW(z-7yHjfSt#WBvuRBg-OD>sNBT1(tp!ibYX_{~R<+j}qWh2XY z;@=H=Nnp{I(|ign=7MvQ^*vPY-%$!zt{yOMqpZ9tRgTPN-Db7gnG4Nzf^HWLbc#=M zWNj9K=7T?_r~F0cd$BE~)0yX$xN!1Ou!ikYsSJKYV>_RCHCjU~!o_2nvFkk9_HDGn zu)$hYfMb?q z3(aya@0ya_NC)Z?m-EV&xbU50zfG{(?NYxq%7YrAKdDWtq)Vbj#1Vg>Y~CxT{WBAY z>H0Q_3F`OUWiHUtrvboOB6Gs-BiZmrLQ}!|K)F)T#dsEDQ&H zPYb~L;r=K%q|2iNCuu@hC#x<{J1y1&TCR;JFhetaOP?@k-LfuF{t3FH}CYS=efM6%B*IX zTkJ?WE{qnK4BszT%OppB^~w1o$iL}PKr;+N{tUU)GoM~j3}j2@QLb?pZyiA&|`)d>_myKdsio?ZkPs(Ic`=c z-vf%;e#dvQ_e*|5MPMa`yMWe=iZheJOIw?}yAT(K;4FH2I`MWaz*@VhSPG9cW~{$} z^#c0cR?>;8z7smWso@&mzfo)(U(4CbS|;FD&rg2a7teWrP-FNDMNO2Oq&@eenX^7P6CZNo7G_HC|~zAsc>`@AD&#{v4*_GA5(QE z^vQbE#zWlQez#QaTh^dF>6d0@3t8>>c-HME1-w+d3!2BW8)2Hm!OqA`+!sctGuN>c zeh#dD$r^154|Fh$OvdA~Z<~kKQ^^n4D|WVkr8*5s34Y(+ievQCy;H!rrl$}6JP863 zI&X*qk>muk+MTr9gVONDdTp16<6oW zt8XVqZUbxB-<{UCfmJgdlhP>o)lp1xFlv(P|IKwUoCe77Z*ho;uB^>uwk2bTg;Gu8 z=MA*Viob{&t8BHcetCjbk1vzs0ak?1W|QOd1T2mf09nfA)2ZCzzEHR(7aJZa=FCq% z4wg0Sw{6!=Z5kpFli#y(`H0gfG7#6RwY37G?OrMKSRqae2G+7QC#(ADo9NK51&I_M z{ai`LL)RUYRB7-!osM3)!WvFyi2z3B;KO0x+U?s)I?F~j(2tV?9)?6jKTD*LQXD?m zUIn=OHPGDDCcs1?SmP)`XGIESv*x5yi_%wH5V_t(chSgNAcbBUEEy9{R$ZW`W+;2(i#R0&!Sa~7?N$fDijRO|DddN8ScGGB z(P?HiMakRK-0OK29IJViIu$f|?ffzIa{)x_Y1ap0sjNd`Is{V}t1H~&71;YX6)CW+ zJ_Mg?Z3|dN3>N3!L!PM+CF|}=1U=0pdWD9AP zi0qTWE}n_NlX#};Dk|VLs-8D{MP3TN(l=rPF`JaWL!dlV9l^jhAY`aw~7MBR_+AvqyVfyZKT;BeP-dI@h=x#$*-kd z2LLOS_(|+qW(zP5R&io8F1yZ{5%-OdRmt--h&rbyqY*f+bU0XT9+&MpxP^M!xd!Jr zSaD4@GT1%`RvW+y<+K<{7zzup)=o9ROyPl2>+ zSj;yFEN<4(5(pV7g4sJS4~M9?S*S*4#Fw*JOb{w{H?Z+;3G37Wu5+-3;IgH_(g9~} zoOVqjDcl5W8*-WC4y+7d`RPr72kCRL))vVTR`cbub${}7gIDPV&2wt0^CR6|_5FVy zo?%T>xaHd3H<^^)3TA(IcCjfG=IYh}WdW99WJ4^_&ofQ2>GBop)aRXZy!WihTXGx> z-xNo3$$g=4O_Dwnsm^V0a29}-RnrIjSpdt&1I%O_xJau-nxcqe_;ho1cKRH+K1o~LMXm>lwFa;}f6GmA4Ggh1PU&~_fo51ZhR61y%FM|34fSlu zvq>d8={2xiEP}f1xXu=^n74LD8VAuu-pt{6GTdy~HrVKG7lSo?0nRegVrY62fTc+B zMcdD)mIN592Xfc~*20T)TY<3NP`9429wd?LUZ4S3o}0e555qKASl9)o$^xt$Da<-i ze+CH9CCNtyV@lzSpDFSt2q(J9)KHbum$%IOzNxZq_!S!lJF}!&+a&J07d6J)1Z&W? zY{ixRw*unv_XG4RkCJVmhXY`VyUuB#nG#dY6;1)gWa=zpeeQJtSl}{lIVknO`Nbr* zm4glLFfN)Mtjpj0yvD$MhFCRtczu0FDHnKiRJ0o|We%sUtvDlnd|0dUKsyCdK=T|1 zzmuGFkKwl@Hcz_1BnsYw_%n3g1WOtpV6cNE!88r9A|vvimy1#E@^WeijnIG%7%K|Z zi!)upCyjjOD==2f+fwl$OQy#FtyTU7GqUWQThl<%)95xN7qH6PJ3Q|RAL=r9A84Ve zH~cN}JRO!DU_$dByiezqX;d71el9wBVo$!AWzCxBlQ`hyJ#*HPsKpDu zUEJM)&LRgslgp8x1%BzWxR~0Qu>!Ki8d}2kh6!O|IOYLHQuSeLAg(MOR)vxQ4&C?w zqe#w!z$_r_=Q$g6khkq@UjlY193^Q+nauqZ7*ulPY-)Z3qL6qLaJ<>8ZE7!gZ#*6o zOhj|qHP@j(Wm-C4DyBS^f#JzPl<|*#U}wIp-cN&k9n`F;g)7BipioVd)m$k$5)r;X zfCbvuOSe0bLSKfskBwm!o*aN#|E*=l#zH=yZOP*@K@fx6eV(hy(~|B%I!sAsX|St& zcr5?`4>CzaK~zH1m6>b0*=)8}tI41yY7ouV8>xnEp^^ z5Wz$jXm`oc{Y@T|7t>-Q`#$zE3K^xh2ZcfqF$1lve-KQ1> zdwWlqF3yROc2o{T^w;i3LCOXTS?G_aFX0I8h zs-dSSd>;keN|0}W_=Pn?cipV60#d%3m~7^FAu}W%xUSv_;g!F~QW{voV?r$R1^%kn z6<1L-SC!Cl@f=A__mfc3dl*xaGNs9jnhMSEnWVdEa8YJGQ)U#0BPgnhZNFm35_M1y zGWTF9TD<)jW}^s6T=BEY7UgEW1(pUhfz7xYo?yAO7ftgF!_6{mlw}ym-eCd)3r+AI zg72#*RNU#X6<<$RuF9sXt65#oVy89cOHP9^U)Hh0*~NxkDV+tx7>hzjI#r}(%0O|k zNK#8*68qRlK{BY(B1Qqc<(OVuJAp$F4x*=fOfsSLRnfSNH^p1!EUTOg8%&pokF~Eh zyU-2lF(ylXh{i2G5=rh%r+KgLe7Q{vcypMHsxc)TKV0zYDLSwQ6@PUYez~zwT==fL zhgkZ6=}S4$QH!nsR>A69!$~Jld>1vXnpVIc?%d()q3ed83%I)!89!E5i?*q7PT#^R zAMQB=-kho;R#-g!5P^l9b+s*(>62hNT5x(rX~IeWG0s{mV6}(kCRV~bhF+JXhWX{q zFg!X@RXoX}WUI%=ByEh&!4_cNRp-mZ2z?{O6p}HP{XZtfvBE24W zHjEu-bT}A;)ddZ2jRFl6Y$!L_*LS01+d>GaCCv@Syc#3AtwAdatbLMK)bPtaZ6pj0 zBp3Lqa)9ORcX3Yh-l6OLGgz)~pC&mh*o{dv7+M8u0&>^|)(WxSvGMiRPo{zTh&h@Y zDXjR6lmeLh+_DI(e7OOT;npCy&jVjoc)^Oe2-&$tDKz|l1}oS(5g!X(p_YG2k_j;EnpIR>CAg7iPulK5JS zsx28`ogXL(zA^SMIG~z*yu9UU0ate3`*O3(r2oW^BPsym{l{+N)^=-R*q@ZUyXSM* zhbz}YYzeRUDgU$ffRW#vTXBt zW9T-{gokeB+u z%UQsLDxPKOuoDJ>V}&{sJc<@IafU-Agy6NztHt7SnpYgzsmq3m9>4P@SSAdJ5lw7A zgHU1jf&(sst9-S0bBVokboFnEDsS2iGc;Mv3$P}g=KU#d-jmiCYhVqJXVuPP-nz8w z*lZq;xrGby4p^Q?&Bh@f(?I?}G#;pLOw>yxDp`(*wCG?qF@Uw4;?0G_8%~GmTi0ZM zPxWNF>h&ao>XG+)SjP&pfx&U8netbM$FKl$d~xv*#RShQY2RtECbMR>xEujmfvTz! z1hS6)H_n1BfZB1r8pt0YMeQy`lO5vc{nf^nbl%d)o_3FBB>YwGPB)7`({E!tmk&|`@{1%p+(*8PFAcyD0 zQ7)I6+WETX)_|ISRqzftRWjJWf&l3uZnBfKaX5_|t@h@#YPH!bE*AIq8K8;mxgPfS zW^aqROq~VEwW`F;y6)mOkfJf^J+|2Nj5n>^-xa*%nPKpa6Jo{LNg9x?<&*+iU92CX zyRB0@&=pT+cn13(SelEiO$r3kg=o-raktX(;xNGqgVOU!^?cTx0|Vcm08Ii3U%RlS zGh5Q6%yUC<+Yl)1>9W!*NEGE$#EId#Q}eQ47Q?JzFuVe&2+lf6GLnkC(7d!-Z^-4a z3HoG&=?iDq_Bb%L8b|9*iUrgN*zn3=p~8oUcUx-Wk3_sagdF z2G)XAP7m$EILPN&7Hc>?zKpA5^GKiiNmU+2!?9Svd9R>oc78aJn?~a>&KHZuc*`hk z8{Bz|q;Ms1WVUvmMPQ*lY=S~rq99V=1Z>IigO*F`cg14V>*?Vl#!0kIqs~pgjg3YCP(=<)VJn$fp_m*TZONIO!ZKStp+WyzrV_~DB*JumJVf$kyJeI z9PQuo&MOxWA0I-6#Qi(tWa({SO^%z$TFd)fhNs5xo*X}@UC~`UC&KiQw0eqxikWHy zs>}Guk>2NZOtAtou*gz!9F;&J!J zh#N6Qmg9M?b7=}JLMz$_mA3Omc?T1q(%s5p2}lAb(KjvX+;k`^bwq7G9XK{c!62d4 zLqUX{O@X&)mD`n7E`+TB&b_-x))4*1j^ZBf5mpElG8UimipvD=>hp`^6}4J=3#{k^ zQHPdi5uZgFNrO$Wurv*1q}rR4AR=#_M*VkaCx4RVqPaOte?)H+>Npb@HC<7MfgIlr z77U7aa9}Aak%ZJ1HfJCXJ`z2VXpLVRyWmU2Ov~G?h<7k7s2~hIIGB=iD{s7VOO03l zd}jQPY`zgX3Ear-_LW5s7+!C}dFt?4bXO1(*b?u;>55GC z0VVubIa-%bvv`}k7?75809IX5iirPhunsB)v`eg`0pXq5DLza$Jf^o9ht=^A1ncDCL?~*}4cV5pnHh{Gu!I zjy^&wo{vie_QARS)HsdSh_At_)gc!ppeM9M6DiRsWo41m^b*+j=RQ$ZP4ObuXu9eO`1H)59XEU%(R3(-^BQuM8HVh?<7C{)iUggrO0w!P}?Yb6OOWS3X8eE4;TR@fLq%Y(hw# z2tPG)(IRusS1WI6&Gg@RKQ$Uf>;%vgO*yEG$z{~`Wp(hzh`0bHfQgzTE`LdSbbq_N zPrAGb5AIO3O39^Hfh`D9a9Z@@w_~nks|)Xqw-F({RywbIaI{)t5z$gg8*y2wZaNexRK^8eyQ_Dl|pG<-Z=+1JJBK$Sr9ZD>s@Ae@?un7xbjl* z5|J1=mBYm+!;W{K8T1X_dZb6~r;bcJp zSIS+5_4hfy&A}6bs~X|8SaQVTAvS?oi*wO!Y{hTeaHuDuUsQ*Bh!k<-d@TMlqR&OW zM`#z5^>?9W-q{IfF4A4dU)aZF+oCJ;H=}~(Z zF6<+6ES?u9quBa`qa#K&exG{s!t1}k@FVgakK?UGYtNIBEYlQ&suBi?bo}+5?Sd*X zTzr-Je0>$Z4{lzMV@hmVSd_$wz+$X)Uir|VPj(ZBXIr7udz+z$h|pUvn_8=$5?ysl zA9%BUn!yt22Jfyg_)86CG{bwPaPMw)bst}Sf$jhF_$S;M=SpW zSpO%RD804b*VirmWqgD)|F6aH|0~Yf=rWypz)b(Y<9|*J{|nZC$A7{4PmlixtKdea TV0*c#00000NkvXXu0mjfKTrFX literal 0 HcmV?d00001 diff --git a/gcl1.jpg b/gcl1.jpg new file mode 100755 index 0000000000000000000000000000000000000000..a5ff7653035c29b5aca38124520710d114b0602e GIT binary patch literal 17006 zcmbum2Ut_h_BR@e6s4*NA`m(v3ep6mL`9mEC`FnO=}o0chXh3F5Slb8A|So@uF`ui zQUwA5q$ae4lpB4|ch3LZ=lkw+pL-|Sv-ix}Gg;Ht{MK3%;wgU+dI2(ON!nF$Uf50rq~7i2~2<90FaSB|GNLBq5slo{>G%}PafsP zzbUeRQbJ6BQx{3){t4uN%N_qsr~|}oZAp|@q?qb&4%xqQvQyLkog+b_kO53c@&9^9 z`ftvi|K$9w^Nf@R09;7z_}>PK%|GP-Es6O5hxWJ4|MbA0wvyUO{@|bMU;RN#$^~3{ zPKy5YK_KapB0ZAsI;6)-_W^7GGUESkGzb78RfktL++J=DZ{OOy;kNYQerWA%X~X^R zF)HAeA`KF855Vx30I()iN~&xg@E$-%LqkJLLq|(X$9(DHC1w^zIyy!cwkuayu3TYb zru!TIb^9mre~-!NFI}Q%pl4!WV7kh{z;N|X#BlYWBFz79DjA)8c0FL3m|7E zqhKZ@E&?b4G{jCa5Q)nRWPbyR;Xi?bGz%#&P*Ky+Uc5w_WB*Mg1CUevFCr6wjFOCk zoRa(kH5JVT3OY#=k(q*$=d$>PhtDjo@VW*`P+g77u6)GD&!YR?Qc}w8-Iy}9K)l|; z%Au9J^tCTl!Gezy^sQBXRuxLj{ZR9 zrojt!>jVCh3FLC^#<7vdu1_FKze2w-6VR+z*Xv>;VcntAcLQc;ow=B;V8CYsU$M2v zr>rHjt`ZLCTrLjo#?1kqQUQ|Mu|3Xq$jK8t<5A>@WE11F&VDJ0NM{RszgJdt4{Oq^(Uu#(BX#jQf;9DZFSmda?5Gc(WVA>hyZF$kcXYW z{7Pu5pu3=~r4u-dzugmfI)GFH%2baK0ql(zx>_akrAs)B6Y*fY9nf+~{iZFhDb_SzxX7*=zl0(*XdRRuq7PxsaS1orAQ zgq)PQ8&$Un_pWv&vwbJ%ADkO@b%4N($F2UFE4&ZeGE5Zha5n1}90xm9x8jp88hLpfJuM+{)hvE*s0Unhz zZQ}>Z%lk+3Tfm`mTLh%YV8+S8k7^^N#`}P~))d=yET64+5>uY_Db94?z0{{_E^T~O zv1WWi=QIGQQ$$D`?n!3Q@w?qv(C=x(wnna-3}mI_+adyF7$2c%!d6^g5dmxgPr7$u zI-T&}ruc0lU@E4FQ2o)nw=0J$jeQ(q>?5$R)K3Jc@3ucI^P6Fy3+ELwQh-NnLkp*@ zE?6}Aj$D%;K^qeR56#c=@ASLjYVzow#b_|oFxlj9spFO#St=64Cu<2U$f%gw6L$DE zUb-!oBG~;~wEz)-*)GSv=N=tNwN3A`KCg72SR)w&K3<{%KGX9>Q1jJ(T0M@6;&|Sk+;) zDMxpc^kuS17Z2kGV_8L^uN({Krf_Ada+v#hl=DPY57frve1<-OaFZ#6k%iv@9er6)*7WUXyKY1i zk*8>ww`k>%FA;g$GrBaXa#)dN zxhStvGWBTFq$lRK|M*gT%o+=s5UeTXKQIW6_ZR^QK8%a{I8 zCtl9Q0DxmP)nd=m8;#O!xi%!ci_UClVI<+&Wi0FJRJ}Thu(pcd@!R>FsSS1)TH9(Y z%(D4u=X$Mm3O(&JA1re1V|-w9(M~{V*2@pS|C%o=2}Bn%1Z^c zlDrNgKvg6lXYrS76PLmA2=qffTD6=A=$*mmE#O~l!L8=-&7R%MH&>ii173Wsy7X?g zr?V`Mo~a7c<|iicuvbO(%!2tD{Mzp|X3nfz*sWuCp*#-}v{OlQzD>*AfC(*&BH_0~ zGak4F(lA}bN)LrfkD5G;en^dCYTf4znfo!Z{HQT%zwpe^2y)`vr+9J?#yh&+CTkIM zcOYu8)8()mau?VNTp|K!UsW1cKyLdDEYZU~;OsJfkqZi`4UNkirF5ckp31@H4rS#F zD|g&Cg7>Z#C--*pMCOF@^l? zj#bm>+jb6-xmG?}AF>b1=`JTMxPvMhsOFynZm_Q{B$I3GJvl9^C@O3H^pJ~^{FM0$}GIlGMz7w?hWc&ZOW2z<@TBElb^RTK}omHVIDTb(uo4FQk=|Np${=l^|&`13FN{zosM{;MC5 zkpYPRACU6{5(xbVIg|f8P>`M|C`mC1=~4a(7pN}$4OCRr)HKx8RJ61gFOm@Ue+M!O z3W^Jq7ig)dXz4G~UZiLIgPa*j_?r~|b))+y_21?Go%#nk`;*x4 z1f8!+#AQ>n{DWLqB(GT>@VmV`6i}AZi~mw(<^DtZu~0%z^*vU7>$e@_t2Bbav=`Z~ zzfV+A&8>MpVQ`ZjwTAwKo^3oneEbJN{~rLfth$lCcUVe6L+|Y7nXsIOv4c-|YGGsF z&n?WY`%g?9eIwF}n)>IqvHu`#iVLLfq@tvupm_anu>bJFGZM#Cu0e4U*_8)ZzmKi( zJz~+dbUT#fmr{OrEnZLHi&fPRYWH#J)yKiC`Uxbxg6+ECJr#B#>$e6nsGRDKo5B-o z==X`aHUG`B>iEdMt+KgUEgvv}UxF_&50VuZRSY|CSyVjT00 zY$4qs#1WE0cr;FHrZJrh|&E#3Ll?tKi0d2BYeW^g6<-TfNZXxL_ng#GO7$xc*OxThS7t5CqV-V z|4KKbk5AJ|3kz>doDYgm|4P0chY3k<8}uv_E7wec^~piM+F5OI3h60}rWVdQx(4Y9 z>_U14dDB8>J)i{$m!D@QP2{IyzqXlPm1 zWfoC-o9b5bHhW!0p7L=t_-Wn5%jMHk-CW^%NW>#5RbA$VwAUTMf>s?df@%%q&2li+9V=V)+&5y;tQ$NFe2c?z%frL5g<Nc`fAzv93MKVxyww;K8iH5zLv)hD?feLlv%mY*!&X@A7j+oh@A=K+l8s z<5_4ni|;5OGwx^qc5CjCVkH^#@*p99*^h!io{^D9?u!{vAOg}v*?Ilp$j_=5e)c{8;_DpZrHDM1D0z zQ&p@oMT0!Y?!iWk5$(5Gv4M=7pN;3BXNvc}2woRYiv>l0-(Y;!JSBy<6$z|yaY|~q z+V>?ZKn87n$9nz9s{cO6rKMcYQ5dr-MH{T}7;HlX{L-AuD5H8odYA7%$a^u!QLed?87tbXp{gnu(|YC(7|+H)N#n4xaN)gc!RezRTe zmQ1q;|GjaZY)J%s%dha0qPT6Y&~s?50NJ^qyrXnFc)zT?_;+=mN15YH)6`(|fGf=P z&R{g!!8m+K3n~05PH4G#ll`?Qr_^JYA9pEoAB3F)G%4+yZ{5U@#pUybC0|vpe4rM@ zR+>1VIptw?aYJP2ihj#j*@{ATQ$?nx!_~9m$Nj2Lt|ZcT#`@RUPj0zvf3ZkoP6vx~ z^DC(?zl7?;h8+l2K94qLbkOUanZBrH?)b%_PRFFJiA48{wC{+3+wbzL>6SMGJ`aTj zCC>m)l#g)`fs=d!1wLbrDM=f^?!O2iY^yc&oQbu`Gj1erLlR+FW55W)Q%eebj%nAAj_Sfi~IAY+2AE8ue26|}e2q?eDXitSYf zjMr%HiKOq>_~t~?yw|=CtbkJNWF4^W&^R?~3g$~uX20VItL#w>Rjdn(!+>}|-2{() z7AaWkXohw_{no^ zcTuHswV!iZk|PNW;&iSON@1w5>ap|6^*g>3k49@iVy26&o%ioVw?@2pvW`d?jego( zeObejR$6XrHhblpT7%v}ce}1fT2yK;01@|*K5$j$QFEgrSaW(D3GXslkKvSL6Wk#C z(RKarW=8}N$Nnt@F(iYBoE+(@bV4-NGIA51jW`!!$}W#ODZS>gtDb=5sJxLe&NoL) zG41$BKiKdytXCE33H9+%q;76$TiKz;T@;!lzdt-d#in!E({HS>K7E%6uo2^F!~jd2 z?zg9SXf8UNPwv%bSn0+N!HUfLC%}@KdwUv69iMm8Um=Bi`&Ik4A$c`TFYdp1))7L^ z6qd~vL9sw?8teS8efiJM1u=pROF^xcHYFX~o~Nz1~pa=xXt7h0X;K0fpH5S?4o02YCkZNyosUBBcKc zydQv$CHN2l_nOXXNXYUjec<&k0R}Bk{{oi39Rnr;hVMabAwCeJW>m?kHde%dYP(zT z^_QlY^s_VH@RJP)acC##*TfD&a&u+wDOby5Rl9bMws=^vSe05M z)(0`7P&yiR-O0pjcnFgcI_7(?K-B6Hdu~*MF;oaP>;!!Yi-9S6%!~NoUyJlssH~qe z(Hl-jp4LZ!kkucF087acKR>-S$1skZ`rqe}3fM30+4jE04>4{m3J8SKS`BD6k~G&) z&mFQfJ#QUl^~0ac4_`Cs{C0JWrOdMY{49nUKP9v|gsjHGuIP38Jb?7X`qvXKwN_$8 zyJUGCO~PqlX^ML1?_t9M$Lr3DL+-b&rUh&EGuGRM*xDLUs^tRXk2SBDSkOxZP=6J- zpUk35pgefXmi>3@AOF{^$IXyNXp(g0W({2O!+3#E9!!w?J|RDQ{b+1hu;~n~ zf^phrA)8-=S3!(o^Q|SWOLS^eIJM@1rSo>&Mc6MtP7AoBQ;v5Kev(l*4(A3Oq}~E{ z`iBq!e1NYVvOQa#hsus6I|UJDvt#-fuPyxhXp@8L#pMTc)D{K!x>|d*wDGN_8Q26&G=TXtEVT34ZilV2Z+hp zPHrDp+(IZBO(4FMw#2|v(}{qKwyTOkxfCwoE_4YIaA0;4%wHziL$<&T(k^dAU5)P? zu^18{FTNU5)bpcN)zYywz1zxLgSuglaod;SI}s49TFv#0YwW#URK_}4hb-m*_0i)7 z7cyPrMi*b#EjC1WgnDR!jTAR7#_e)=IQNe7kuAsQ5DlW+JBOQwFOJ#;%JW90vP5@K zA<|1AIc3)_JR(a+h2NVQpW1ZdPlAVVSN|Tur7`NCm}RY$-$-oa5i4qBP% z>U5Glt&>wHJ}@#!2>ne2oN=Dh!hbG`g{ROuRxuhAUXtJ%y!i}%2;>IdvduX1vMj22 zC_VV@CZ9y_A`8s;V8CT1)4}DNu_&YcN#>{O3Jz>~FqbS^Xpd84k9>ePc;M9o85tg< z;~1X)teu#jV-EPVIMyT&gv>dFeb@Qy-pd|7PKI;@#o1SHveU=pP;0)P#P>O;SNd;M zzNEnkr%ImKar)Xi4>HbfNi82ZPlprEHKTg45{cm97s@+U_mh%+@^rYH;o+|R!qh)q zR~g(*7O!dZp9vi(UfOLN@&o6b1Z!iWh2_~3!Bezenn%o)nrP-tvxu(*NJ{|d#dtZN zW$A@UyVwJva2$iJr~jF>?8s5*eD%<|RUUg;*VLM#s}{~uHgt~S2#8u9a;yGE7h15N znFI{823l)iLY)!&yqJVxnHV}H({W@w&2l}zy_N=H=&XF=%Td z-HkjypMq@}-DOAi_ox@kOT%63X%0p$@$#H~w)_d1uEN(Z>mb@4EW7CL#>kSfbpikg zz%1FG@=Mzt{j`PZ*SuY?;%scz{kRvhPK`iSia7VC9q0hNeN+NhHKAu}9 zB|N8n9HhoeZ_~dfJXb!0AHh;U!}6%iO{~=Ea67H^(AxU@)`0<7a{L0NAp6Wb{ap!P zeCYZ!@re18gAOgaOyP}kO!uW-Wyn-*LTRLk$X2USiA5da_d(#4r;7}CMzY+HVfC7l zkF{hr-&=|ud?*n>Me7N+wHWKsUIkzE_RhOc?QTluN8i|j*2TqCk3Xa`ZSIE5dD1YB zeulPG1FO^Q@v6FKGYhLupkG7tB(ru?%x&d zO#{XX$VoU&n)dUXZ))F{_7Q2~e*mi>OR!%eId)jzbEx=TgwYL!$oAL=DvpR1Osx-l zR}Jeaq6F1;1&*oL_mj)G<1asr$*B6as$Q9eAsO0-Qjg52CQ$H4P2!8cpQ?Ewg>yic zO|BT-q2*N6m1`h8&B?J7+hw(Pfs+flx3n%&cb$UI=>2#l5sIamN-0-39vo*Kf^o}V zLE~*mo)5^6JW&PlS1*5^5>r1P&%JuMeq&^djF(&t`$;qKj)KN0pk~n ztw6j4s7ust@!_T~Ym!~-+p|lCl9@)y_4bgYs=)#+%D>}i1xa82c$(A(4t-iVVcXnR z*B-biN{vfM+ADH0Q_DU>9-W69f=_v_j@teA)X%uXz_^4Lf20UWyQw>L+Uo&0{FoXR`; zwrc7W3HaWXbN#O#q}tJ|r(U zXc<_+`<4h0ic@$kRLG-BCx0<`_meiLdRDwwJykvWJd>5=-~9D`E^R@t3(lqRG(}wg zdVg3>OSBs*Km`+E<<2oW1%CGFw0A&|w3&ZKN2STECq*K9ZA3gaeov(xk}Yq0Ua;mq zmnzBfbYB{G^u8Nql@6Z;y;kZX0?5p}a3c0VzK)zD*<(K)XG8tRL@j91z*sMQ@T zx?c$hkW=s;)}V>8o*C+%-agzsupUX+>bb(V7gnEx@f=AXRh>mJoVlYdEfG#PYQ!`LK78$&N>!(B zDne$QELEfL2ScTx|(g#6>p*U-pB>qU0$0wZZjnUF2EfaZ9VPQE7=DM8Zc2-zd@Wihl(Rw zqct-v8TW1*A>ZN(AkTdm`@*cQ3}^Fxpo{OFzhJ;(2@a%SyfXlx3yV^Tw^x)L$jSi5 zUSsYSRlwU_r+^(f`>Ei{8NAUwx1OdKml|BtzU+0WfK8ckD6f^l7k1+!xqbk zF-r2FAQ+2*wnKpHtw8K&3~;iCpdDJ1g$frt8YKcEG^NEby;+!^$oDpIH2GNg4cM1O zk{68wmQ(}V4o1Lq;b&~;8YIh8JQ1MHc$OdUl=Z1SF1ag8$+OmX23EX4a+XxU?%0#c zQ1=qPS`nzs$6@{a?Gwrb;lMuReqVlU{n?M1^7GX-Lg7n-$rwqeV~oRVwIhC>tNo|i zT8#35iBQVh0eWZEkIrvfRTMQvDx%&!rZbFXxH?|sXWPSIv>upFAKbUrtfrh*eSBqN zo3A6DD)%G?`k( z$lZ}lW0WR;WAFSa#QMaRYjE6h+=7Mf88es1V3ynsp~2kiniZb6dZoN?es%PB!wK)? zlrOngoOr2qP^6%fIu>U(phzU}OyXSCecR$^!$=N`4%9vNC>U?Fzn`2ijVsPpM2z7$ zid5f@gk3&o?d5uOIZRX8JfrG?R6n?+r4eyc_vUY!O?m6W+`iNyM8RXVsJBvi54u>L zfoSL0%LehW`|YnNC8M%PYIBknT9JEy<=rRB_(-w-o@25jMhM;2Ora_tL)30*n&f6i z*zS8OD)7h%rmtM0tQ}KXGHd#Te*%}y;VY1T#o(B`_(dGadY2J8mI<40g5NOUmQ$O+ z5@vqypRst#pu8+B6F-3EqPlhHn+!O42+6N=R?M0>ON){0 zCnqQbuV)>Y?ZW#!W!6^%NNNTVkP6f%0v?>THuv3kE_G#IGl|O>g&HJ~Fl({$#X3ZO zh`KCVtX`qsmN!JP@PUN3K!)ng2BV_CX4ZD%6lp=Xm=fGr(Ub%uf{xGr(C8E1$x+|yFCnLSC!O=C}EL;{NVqa1&VL_mo)t*}Yl{Jj-)BWoM<^|lBGh7l`Ydh~-+ z6QVzQ)G^j*PA+IcD7l4{&ZsRokg6(kJA%VORZD9Gs(>hYy?U4MOCe%Q1GtfVq$KNx zn0AZg2(ao#7X!(}obz^3DFE`UV!Tx4jfY6sZuW_T(M^zwQ<7!3o7Mw&!E`gvdag)t z!m|W>tMItf$EGJTeW%#x(Ro|!0--F`<9B$fYoFDBzeq`yc~s^bbK8o8lA2otf#WQn zww~UWaFhrz=C=+&-9w3C20??svGybr!^GRREAB|s1Lt=cgdB@*L+YP-_C2HSD!YRD z!GLbLL45GZ#5PGMV%d3Cw5yfY2iM8G0fPv1`hVfa{TSxN#?2Nx=B3=+?hfASdqm~N z%+Xi=NvBwk{@(SCz8Z@^62JOXkwT^Fm_I`L#+|En`752`kM44O5k51mIae04cdXiW z`@lmPc7wPpOv?qnOD1dvA6aRvIxhE~Y&vbio7v6z88gd{_6MAK zF!jST_Qi}zZ<`}$CwGUfA92I+=^qTY`lXG#>2!Nx?@eoWLhj zxgmxu+uq*5lD;TC>Gh-W7iNQt=Eg?Nm6%E)g*sh{dp^ngx4m;B$eCE!0s(t~r{`B) zBt38SNtwDWXv@SEA2FmZoP+WYj&OGALpV9=b=aAhXAe@|>RWij)+!&tzg3S2@Ks_g z0Npuqzdg#usXnyn|3w8WhIySslO1@Fua)AO3wh??LbLiz=ciy*CVj|F=f9p8;xuWg zw9CMdYi$nkBfU!xQU1EFTra0>C!LwRB6UI|D0a+$0n?D;yGo8-G+v)DFsHq&gG)Or z31$UTK$LfEYo*Q4i%96tMeC_WL}NNX9+| zZ~8hX-%&JP1?ZClMxI4Ien9bcL6)4_WlfL#2985OE(HHc=m-}Q$b{* zQ_Ww+IE(uj_Fk)kD-YZgdN#$x*;XI$kd3d4=K<^|l5$ma6NIPD!9@+5g28RTX4^y&?So3V4T#H^#fM#{q@`k99&2{TzstE0gcmW$jcDKR z=FrEp2+6dOG#hQT>+58&D;5651Uk-gj8ZqQ1zh}$2Z-j|&N?4E3`kf9N`qaclqdQ1 zy@t0iTA}Y?!%uwTU%QV?*U|IXD>UcL&+{5u2z0&S2dR4u-0G*(Y?e*7(SSkM}H#j`Z9`@e2|_3mD5YIl4iDaBOIDo+6(UFaBI5Db1}_#^#`_;J%TgjTO>Nx-kq?N6X=Bs z&wEl^+U=HlDsnLv^Av9}59=yDyOI13bBW*%L5Yk!y5v`WR}&F!@`ihB$pXH;HF%<# zD@L~bdg01S+OEu-E%#S8KS*3dgsOJi&#rpz+b-mU*#-WNIs``1gLlO8ULR-3KdXy4 z`GLB0F5Gid>`tz6wuj>Mm;IcwWx>BSnQ*anjL3p4;W(&3MjavmUA!J+2H;2*z-)52RP*Yp}IC+xo)c`NLN;$z&+$G5%3)tCr; zb_*b<-Q@$O9mt?(h}qkaS-uY7Zv_77WlTG;Ivkqmd26oF(}2?`P$|9onq<5sMXEH~ z)dM?gUxSgpu9Qx)2X99Df|FmhYOFrJbuBR9`qu1Wlq)kwV0pqpUA>{Axev0h8XQCn>z+?t!bGugMvU%v;5c?qh1tcz+Q9RT}`D>rJK&eRw-QQE8sV%7i4?91$&Z{ z!1qNTST{lI+7YhxQU`rh;cd0GsErREv<=OpN9WC<&xTk1jI2FBe=e4|?84z9AItc? zihWU4yn`+wjFU19$Zc+bgp1f`CVt_h(AJKYHF*Hiwbo&SN%;rA^3yaR6oZb&@y>l> zBgF%@=-p|!4c*;`*^euosZ?Eg+0Oq5fET2^nYs5zMv5aL&`M`GHqk9sy;NDk~jXU(9(EL?}4d<0! z5Xorp-K!2HKQBb7-2-N3M8k_|x)|nR<2zVGIpHXT9;z(@fje9nOfa_s!_%f)}+xbjyD7 z+|vABorKW7_FqF0ZaeC|^f_t#xW|F#+Wrs?g1L#v!UJ_qRWCA(EqJWF|D4jObV!~q z#T9{V>i5%@2dAB!Y>3E<$eK7cH!fO5+|0R)ov8v@hPhqv z&`1dIv5!wC5ip7OAi;c)1#Fa%h@50RD9M>3%y3x&+e>hpZ~eVytQv;+w&|Mtp-^;v zoT$o7Ld#Sk#_fS)pN-4b6(XRVUdx%#rvnK#NG5A>6FwFyy-0Q6Rrx z-Z5hkGz&H?0ri90VotTE#Qd>y{&U(1d36aT%4Bs-O$|2&`k1gPPoG{cQsUF;k%x9p zZ%aRw7f~Au7bk7X08f|fbyrnp0_RB4`sig()=8zMasNKf z@lyUmxfcJD(A9R_2I~eh?i&t;7Rr_>&c(=G8E7)2*T+Ateo=v0kcWS^%k8|a_BXTgHCmPkA5 zp)`kG;su;e$59(;CSD-S;pQ4BEP6jw%GDvL^&k~$>&Y-cmG}FAkre|8?|Lm zUbjm#psn`{(9}qKaF3ysXz@l>hR9+)2pg6|9Eo0bDhn4Yz-jQptL6WvP1eEvbn5jhB z#yKMbB%Tzs+Onoais7tnnAHefv_yc2)ctmQwDmmGFHYRZc7PSBrn5^YZ^FWVfAzQm z>^QQ*P;`lfQ}i7UEiO*sr@D@h2kVpT-K1s=-Nk+Q{MmG3b+d32&9NrMwlA%CflfNcaj~gr?_%dGja5hb?nl=mAd~bEh2V=w9B{Z7VmuQM&1Vgfn7A$CW-srH$HzMFvNjiXrCTMnIB@pah;W< zOrvAdIGU(8NY;=$>yIJ}v>Ec=sDHNKTTv^($OvGf(8F`x7R6bq?J3Y6A|NQK?tZ!5 z+guo>7Gv9GzP+47?{3GX-PxkETyJX)E2+2AdPyrow0E172n9Wshos3 zNdPl%T?Sc|jl;fy>)d+1e~Mdip(RmazHjf@{ThC= zP!!sKA}x6|BjRh*y^n(B0W3xJdGyL=FFa$EkjP(>G7rCGmfw6&@_KfVjKQtNCt2Vf zLWD_rbMG#VM>>|#1<5z+GqDHa^-1FtoB)r%ox-+$cz65xLHSD={yr6_i{l}~l^JzUj?t0H&%-Wx8ipDa> z)bBI$?Fv;YX6;g`TTdM(03JWK`5|-9v&^pbqXX1$rpD8-`redzX6}pj7+csEPQxQ8 zSPJ$_epc}(Y=Y2JY`=_71f}^h8B`>wlL>=$J7vHpR*YEQDVQ3f^AGT>VAN_Snb)o4 z>PeFnfjg~xTKQrV!0>T`ghEnNh=4DOkRzxT3^8~PT1>`+c2wY)5#Y!Q5dc&oNs9)O zf3>IqHpW$s1ql!V3F12>Pdem?r1>7haH}IY1ZbmvW4dsoxLo1ImeoKSea+qZJ0D}~ zeZCw1=CN|1YCL=Jj9Y<-$Ap4-V?8DG!B%w7r6;tqTD>p zi^}O?7}f<(Uz{EjW#G(x>Yl>Hd9&MrOimvnECyD}NLxS2kN!uvqQ!9QYU?kSKV>C0 zEd}L2=0|fSZk71FWM?o;$}Xl6$}hd4V6_l6eNq>-U9-WreFN@|_s?7=P`8cuRLDcP z{6i{rRuZuB<%XCla`Rs}@+9GxNk&59zcQ)qk?&M)ZEilPs>=9I`7}85jmj%XtrZWq zz?GMKG>C_Y=Pxx$a{156u0O}v+GG(QJ6-wIkzWc5`__7H$FGF(pHc%2OTOoHx*^kD zzqu!dQEV79Waa2o1*C)^uB^Hj?__pmas-Q-g&{zu=u;e1`>#)VyPW*zpa*n0 z_g8xZxC5O-m^U7l_LXy=j0kM%YP&N3^5U!WVEl0T9Es`~=#~mhIsdEMq9B-|@_xVK zR_X`1(ec+>rR$qSfC}a_ckv}T$j8?2Co!rwdn#O4(tB#sByaX8z(TF|HX-grKwwr) z#rID_wl-1{nF_EOiW#8)7c$_K*bv=XR&K_B4(aLJe2h9Bcllr+iQnnjDL5shrhXYk zOpSz4yvhHJ^HM<8EKS+BlI%KjslMorur0XCKL<(GLNadpm`t?2 zUcS$BR2Sqs(fvMc(!%NXQvUdlF5(~Ocb?awdvx7WN-^4s;ATf~wd@&Ai$2ZpPaNHB zd)+9gZPNXuH1o?Zn72A%TTgrTqRj3^obm8Uxka>wocL>{)^WVb3HT-KSAIfeHYZmD zN1AJmI`+^9_5?VFTfnXuRFhm%X?psrm$+DstuNc;T%nHlS6yXO2cP zSxFq<9tH)C+kxB5gK9quh%XMwL~usbMmPXpe}yc@ZJP9c zBg`|1oYqQ8Qrm4y;+d2P${XfRwE-17F@w}-_7rl^doDRxUUZVC&ANpB%)|^qIP|QN zKp`^+vBhpAe}mTdHG2{0t-L+o0MRID7~|>qndGHAbi84uci!Lh{dglQRX%-73j4yu z)o7J^t@ZHD>@MER32`W$Y7=`zy#+tER1`m>a{q!6^-E<+2`}WV=9!4cTJ>f=cq#&$r#y;fu&Jl)Y?17H}F`ccjzPXIOa*P*U8WHeu-8Sy6 zjzL=$<>Z$TQ2WDKc+4jzUnI+%(g>nktHL*DaT40ziuIaZJ`;10PFV}CrRhj{-9ylU z+F|1N+rh3JSsZ323qN&EX6nX&E_6Exv}}$wWqG`$8TNd3SDHs{=;X!q!)DczyhbU{Ye|VI=iQ6h)x;%m@#$( zN)~7A-YzLXM>&DNG2xWq*L|`I z-{p@j3DTXF3C!{_KkXUXbOXE)V%%4cG(rQKtpgnrv$B@a@m%(igIS-TRw2_Cf}hqy z%r1emi%2JLCv`fIl1e_v*N*vu@UZBB%DhQI&dzvbh6yL|);eah@@ zpcXcyw|R9N&hb3sS;Ux!s)))ITPdr)WsMmr`Pk&!n>Q~5owpmP*Ow0lqXj9lZo9_h zpF?}VyVQ<7Rm~u!G6>?AIy(6#JSvPa*T2@!ZCsf>p4q-2r{V@#W*UGzRA{9nArWE6 z=f)rJKSG+ONty~F7blPULb<>V3dL7wEXzYQKDV-GHImltAD47Ne|k`tky2}J>7>rZ z=^P4fh?viQuSNjJ=Eg(1>#K5f_bCmNBmmxxg7-;%FKY0t+Q^U8HRNWq+OwSGYgzns?_Ue!6C$6ydAs!2NtYB}me)SFSaQ;)F z7`1nb-y0mO8P}2r3H8HDP}E|2_+7Ymok_6HT~&}SLPz$LF~Qoyr#(yTsOPv%7Ht?e zIHA!!bU|Y?0u;i?pxA*}kWT%F+S2blkZKIa-X*CMYzlu0iVfQm{M#ph)1=1VT7qC~ zNe6#`6Tm;Evi^|T?2hX|q9pK^WI-|%z(cuKP->(@97>Qa_-|)|!Qe7#5cEs@U~NH3 z6SJ^9l8m*&k{o@vHk>hbzysMc*S$-Bvj+*a_At?}bTswZoIfVcESM-_>1+!7#C7BN z29t9!klri&V^?UmNv^2ReJ6(N`ybP0A8Eban&)S?hCH`V%8a@x{DdyynT`ILa0KwL z`?ZXqnQ^)q(J6 z4U8^noLf5fzH6+SWPQBJcs_Jyk+-UI2P9%i`FtT@c3d_!DFfql(N!rBs45jB2>XiR zqVXndGUi;mVV9(29>P@fKse$~{CDfPK=O%;SFT2h-h83Y9Fdpo>2xbr#VNuZR^nrM zE@p?C!FMJaVj(Zsl-+Pc>$8KqT6fOTC1W*%o(X#vJ<9o$y zfQuHE**>p_Xub;jWHzsNH6vu7x6NKBN3|-Ww&gOy11|?u=!x>@q-MqE}9_raxDYst=c%# zvRfbg*sRYDx}GA{Yu|`1jG! Ne{_QXH%a2p{|iL@$p8QV literal 0 HcmV?d00001 diff --git a/gcl2.jpg b/gcl2.jpg new file mode 100644 index 0000000000000000000000000000000000000000..9952256c274f4baa3b78803e1ff9b872ac6e284d GIT binary patch literal 5737 zcmbW4cUV(Tm&b4DAc{!nB}$}7L^{%_wY%p&=guE9&&>Ip`@J(~C_|Jf;5th}~9_msY%XQ%3slBp_yHX4W&TJZI1HNM91TB>jIjN*%z?1o(lj(t?Bm z8g>vZJBZQxrKhK(qmK5c_5*b6 z^cOBk-DBX;w`LS}0ZYG%PGf?q7S(eabZ=a~Y2zBi%)-UZ!^qPshPQj?bBy=_6{hto4bdnm$#2^@as2kLqgwSV`Agt6B0jsOiItl z%*w`p$;mA)DJ7Maf32we-q6_8+|t_C-qYLHKQK5nJo0;bW_E6VVR31Bb8CBNcW?jT zko=bm1knB)i~9aI*#F>Sr*hHI(b3W|{^bJEcu}2}osRyJ6vKsk`i#~t9KzDCn82#h zX+`zS(3=JuoHnlAEL@jmev54WMf(@o{|+qZ|3&s+VE@fE0QmO zEdTO6OSeX{Zb;fB#+6G|Itu?2dcwG?XyB@E`m7hP5Th4V<^Mic^)9axteJ$vlCwr- ze2v(L;lpE$Q54|bA>Yh(k7Ppw8)uI*AGe3+fN)I%E^(%xgE4-L%*`#F@k z-+ybz`BH!&e`OJ&(y6Jzw+<@ovX*l9BTm)7kruruK%V|G8>ac&Bi(`g_5Ad&L3*2- zRq-LdD_It@a*C{;=2mnRz$f>mY*EcwNkiAEwQx73v zk>0J^afxFntI`r~bNBPyIDyRzupwfY z=SfjY)jg^+8R|`%$6u(KIp=qs|7E=LE(M??dn1%k_4Ng8ziOc9B)>4O^ya4l zmNB${?AW&|OL)2By(T$lE*$mD%!^oQoT2aFcX~&%ASiL2E7Gp)R()1(^kc?#6XOz# z6z}B+gS4B57O}d&oL2Ma92Tk)FK0Y?jnvikC(Wvim{Nf46Auc2`E=}iMm ziq_?Zn=H)fwvzuTCy9~|6ORxS;1olwUEjvMSLXkzKJ7gfvA0+q&W`aL*J{bP-|auf z+x~th;$`eVxuKi2kJTF{dVXJ${Aa4n^s4ZCy$h}n8KfOe&P1K8R6wrvr@SFw!4Bhp zT};P{1ON7I-Ovd+$BSgqkJqm8*vvmwY-ZaCUVce7GWwF!@-f*=QRIQ8F#>liy{0vz z61tRKn)DpoCOLHY^y^Uv`;JgPnPp2m?A_X$(Db}%66zdMi(e$N;!BQWE5XEAaG1=+ zcs(OHL{hfEw4VZ424R8Afebnp5v|c5`JD?_5a7964jGRhN=I-h_GdYFtx0rSz@D*B zT~RSakjLm)Hvh#5|!p-GE3|#f6a=V|BA=k z-2PP`gU$`9#Oo?k?M6nicQ=#=1$`kF5k)Axov-_{dZy9T+6PnJsXunwFno!NkLQ!a+qu(>kQZa2NWRa~VatLGXM?q&b+Sfd|PdTgbL9>)H>e`Z&pd>Mn7 z&FN|1{;`el(t>i^yo_;0k)|I$?r~iUNPC<5MgP4>w;4=Z^*b7M$365p1Q}F<{u3=O zzuZh}Xh=%ml6U*8QB>bP+M!!}O5dec)XzKQ*FT6Vr>~o@UeILy0sB=N+Sy-VcD$Q> zRSag>cOzU<=Rx3q3YPZMCjK3Fg9S(DYyJw1*K_>Q1b)cln6Pko*(b~AnWv9n*iET6 z8=uRAx|_5}g~@mG>@`kK%t2S(p@?CooYrGU1!vYw!CAL87t5WA zYa0zg3|Wwqjmh8Uw-hKqNS2rr8S-~l+cwqx-gPCmJiD=6W-XEIXvZD-hAetT5sUKP z4>!IKwDr3S47F0{*I$ z_ySw>Q|l&Qc?*Qp!poBB?XmC1=xRksmEiH@F=(Jn=aPWQ95LLCErBGHf8A4>G+@4j z2K$kQZ5Q|z2OBM**&jqAL{VIK0pqp>>;m`wz7J1FG=uw3trn0wBj`UEu`f91}a(_DpdL*omSZ7WS<{oOkE;A0#wM z=61volc`X~dO&7RlWqbo$43Yl+yNDQ{Yt5sJ39VIwbvhbzTl z!UE#sQLgnR<=0XP(`h=Z6E$HbK5R;z{$0Kn;srb>G7|ljFBtQUSDH}6Efr0kPi8!4 z{RS_Xx@56v6KcmPz`5rrxlcnbkH|X>h>iS)oW>FxFa>z!adK0C(X%dox>)(r1+%I111q6}?Mr|9+SpBD*;C+o8fs`Q|$* zf!z$ae>~+S@-zgkjD(FKTIO%YI+a%`2wrQIh=8SG&*#eL4(PqP*TmPH@05n(=6ln9 zG6qY|AP5DrxuVKqs)VKDW-~ZFJDM0I@&@Wln%pW)8!>EXYvVPGPQznvs6$tY`-x+= zc4$_(mH>9qSNe1CK~MP1^*2c-4JN67OeB3j7T{r!DpeF#T!3O?MJXRNVrHcX>? zZGDXOQDdi4r#vJDwt)9aP>=4k94g@$OVOcLdrirvt7KW?M}BK!=EM}n1w)<%NUWALt0!HW&&KcPbj%De8a%+U}Wd);f%n~yk42l7W zN?n;waLa^z5ab<^pc!7mvXC#_0kX_~=M+I-8@}{H8lb+|! zW)vVNyl`JBWC6Qp?X5OpKR*;Apnj=Rs@VB{E$!=rU;+kxP`Th}2h)@6J*C~R-JEtz z%<@7BCU=^@vs2F8)Dw(Noa zJ@+uNafbq^)Q$J1k4=ALR4WIrbIwJf6Xj;X!w323(SuPlQeF7y<_f1T_3ua2`ZqGLUQ3a6z>Ov@-gdO6aa~%0B6)1ag(JKpcZoCi+PNn*C1DfZyiy9 zDWSQq`bpc7bl&CWgT!k%J#XcoEP*wTUuwDfyDhRUSpM+37ilrUVHhc`_}PTZ8%>P+ z<1thVzaMcHA<_AQXxqZa?|90eG9vQx$5S1~s&kW}t;Ce{c-QP~eFL4F7P8OOGtp}9 zYkt-3#@IrMx~ZVs4A@-^?}3n#y3h4hmIlwU){r%XzyEumH}g0z>q`;K6PlrG4Z%A~ zuvUV)(L@y_eacOOrxnkL^035A#V=-N{T z%e(MK@Sm&okqziDF$9Y0=y2#F&MF4_O0vmo&mo@sb%ebUw>#%xWeJ?{35$|>sl#2w zru!n%?3*Gr8SF~~S)ZxfaTqGF+T>wk)_K!8;;2r^PzH8Y*`p-%AT~`g!INBlB^KDi zx9n^EuBC06L87b>y6D(P)ds@V&$G*>afUwm7`~5%k*zseNhWflF{m)JMqX64|B-cJ^+ohU|QT z>+NT>c=R84y%wjJFCwoR=^wroCFGkJKdbV((_wx_oY0VEH(HTNMdW?nBa){eue!1YfoE*S$z9bYK7UjR%<4z#X~>qC!Pau7 z7oe}gK6)lOJaBn*zV5txj>(NXMu9dTp}g{WRV(_!DKJ}3aP(U+Xd$T#8@u2~y?U=- zbBw9ln7tHnQGci4$=71jF3wn&Oql&#&Wo^d{@zAo{DxM6hHaabnz5pW4&PltC?wwZ zY0|~hKWZnhRVoZur^?ien{6)VU#b0;;+N#OGis97V}`4;>~XMFaV4syzluyCwx~$8 znlENXZw+c$XS``PDSy(-iFsR^Mlx;zUl@Kk(0Eb6Xlu9*d^%6n{#OZdDtMSf_ye)K z1zqNFuTkqjoG5qnV625nMPm01K}rnWo~X$h@COFYK1#6}xhJ+35QiIDIKpN5>h4hk z6WbG}0G?r-okuCoClQzmvi?cbg%oF46c^pzJ^ z98zhp;{S4nIEJJrY6Dc+UX+W*S?Crut(%CavP}0}TG8cNRItlR59ERBKdb|n>VY)X zQ4XmLJaN0(C&_22LWJ+RQ&-p|^HEn0``apaLDF&@QkiO~ZN}=7LHAwu(DQ~tpq^wn M0M>^C7|QT}08Bw60ssI2 literal 0 HcmV?d00001 diff --git a/git.tag b/git.tag new file mode 100644 index 0000000..67dfda8 --- /dev/null +++ b/git.tag @@ -0,0 +1,2 @@ +"Version_2_6_13" + diff --git a/gmp.patch b/gmp.patch new file mode 100644 index 0000000..f4106d9 --- /dev/null +++ b/gmp.patch @@ -0,0 +1,19 @@ +diff -ruN ../libgmp3-4.0.1/mpn/generic/mul_n.c gmp/mpn/generic/mul_n.c +--- ../libgmp3-4.0.1/mpn/generic/mul_n.c Thu Jun 28 19:04:08 2001 ++++ gmp/mpn/generic/mul_n.c Sun Jul 28 14:01:36 2002 +@@ -1144,9 +1144,15 @@ + * multiplication will take much longer than malloc()/free(). */ + mp_limb_t wsLen, *ws; + wsLen = MPN_TOOM3_MUL_N_TSIZE (n); ++#ifdef BAD_ALLOCA + ws = __GMP_ALLOCATE_FUNC_LIMBS ((size_t) wsLen); ++#else ++ ws = TMP_ALLOC ((size_t) wsLen * sizeof(mp_limb_t)); ++#endif + mpn_toom3_mul_n (p, a, b, n, ws); ++#ifdef BAD_ALLOCA + __GMP_FREE_FUNC_LIMBS (ws, (size_t) wsLen); ++#endif + } + #if WANT_FFT || TUNE_PROGRAM_BUILD + else diff --git a/gmp4/.gdbinit b/gmp4/.gdbinit new file mode 100644 index 0000000..473d74f --- /dev/null +++ b/gmp4/.gdbinit @@ -0,0 +1,43 @@ +# Copyright 1999 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * the GNU Lesser General Public License as published by the Free +# Software Foundation; either version 3 of the License, or (at your +# option) any later version. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP Library 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 copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +define pz +set __gmpz_dump ($) +end + +define pq +set __gmpz_dump ($->_mp_num) +echo / +set __gmpz_dump ($->_mp_den) +end + +define pf +set __gmpf_dump ($) +end + diff --git a/gmp4/.pc/.quilt_patches b/gmp4/.pc/.quilt_patches new file mode 100644 index 0000000..6857a8d --- /dev/null +++ b/gmp4/.pc/.quilt_patches @@ -0,0 +1 @@ +debian/patches diff --git a/gmp4/.pc/.quilt_series b/gmp4/.pc/.quilt_series new file mode 100644 index 0000000..c206706 --- /dev/null +++ b/gmp4/.pc/.quilt_series @@ -0,0 +1 @@ +series diff --git a/gmp4/.pc/.version b/gmp4/.pc/.version new file mode 100644 index 0000000..0cfbf08 --- /dev/null +++ b/gmp4/.pc/.version @@ -0,0 +1 @@ +2 diff --git a/gmp4/.pc/4a6d258b467f.patch/mpn/powerpc64/mode64/gcd_1.asm b/gmp4/.pc/4a6d258b467f.patch/mpn/powerpc64/mode64/gcd_1.asm new file mode 100644 index 0000000..8762bbb --- /dev/null +++ b/gmp4/.pc/4a6d258b467f.patch/mpn/powerpc64/mode64/gcd_1.asm @@ -0,0 +1,122 @@ +dnl PowerPC-64 mpn_gcd_1. + +dnl Copyright 2000-2002, 2005, 2009, 2011-2013 Free Software Foundation, Inc. + +dnl This file is part of the GNU MP Library. +dnl +dnl The GNU MP Library is free software; you can redistribute it and/or modify +dnl it under the terms of either: +dnl +dnl * the GNU Lesser General Public License as published by the Free +dnl Software Foundation; either version 3 of the License, or (at your +dnl option) any later version. +dnl +dnl or +dnl +dnl * the GNU General Public License as published by the Free Software +dnl Foundation; either version 2 of the License, or (at your option) any +dnl later version. +dnl +dnl or both in parallel, as here. +dnl +dnl The GNU MP Library is distributed in the hope that it will be useful, but +dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +dnl or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +dnl for more details. +dnl +dnl You should have received copies of the GNU General Public License and the +dnl GNU Lesser General Public License along with the GNU MP Library. If not, +dnl see https://www.gnu.org/licenses/. + +include(`../config.m4') + +C cycles/bit (approx) +C POWER3/PPC630 ? +C POWER4/PPC970 8.5 +C POWER5 ? +C POWER6 10.1 +C POWER7 9.4 +C Numbers measured with: speed -CD -s16-64 -t48 mpn_gcd_1 + +C INPUT PARAMETERS +define(`up', `r3') +define(`n', `r4') +define(`v0', `r5') + +EXTERN_FUNC(mpn_mod_1) +EXTERN_FUNC(mpn_modexact_1c_odd) + +ASM_START() +PROLOGUE(mpn_gcd_1,toc) + mflr r0 + std r30, -16(r1) + std r31, -8(r1) + std r0, 16(r1) + stdu r1, -128(r1) + + ld r7, 0(up) C U low limb + or r0, r5, r7 C x | y + + neg r6, r0 + and r6, r6, r0 + cntlzd r31, r6 C common twos + subfic r31, r31, 63 + + neg r6, r5 + and r6, r6, r5 + cntlzd r8, r6 + subfic r8, r8, 63 + srd r5, r5, r8 + mr r30, r5 C v0 saved + + cmpdi r4, BMOD_1_TO_MOD_1_THRESHOLD + blt L(bmod) + CALL( mpn_mod_1) + b L(reduced) +L(bmod): + li r6, 0 + CALL( mpn_modexact_1c_odd) +L(reduced): + +define(`mask', `r0')dnl +define(`a1', `r4')dnl +define(`a2', `r5')dnl +define(`d1', `r6')dnl +define(`d2', `r7')dnl +define(`cnt', `r9')dnl + + neg. r6, r3 + and r6, r6, r3 + cntlzd cnt, r6 + subfic cnt, cnt, 63 + li r12, 63 + bne L(mid) + b L(end) + + ALIGN(16) +L(top): + and a1, r10, mask C d - a + andc a2, r11, mask C a - d + and d1, r3, mask C a + andc d2, r30, mask C d + or r3, a1, a2 C new a + subf cnt, cnt, r12 + or r30, d1, d2 C new d +L(mid): srd r3, r3, cnt + sub. r10, r30, r3 C r10 = d - a + subc r11, r3, r30 C r11 = a - d + neg r8, r10 + and r8, r8, r10 + subfe mask, mask, mask + cntlzd cnt, r8 + bne L(top) + +L(end): sld r3, r30, r31 + + addi r1, r1, 128 + ld r0, 16(r1) + ld r30, -16(r1) + ld r31, -8(r1) + mtlr r0 + blr +EPILOGUE() diff --git a/gmp4/.pc/applied-patches b/gmp4/.pc/applied-patches new file mode 100644 index 0000000..be365ca --- /dev/null +++ b/gmp4/.pc/applied-patches @@ -0,0 +1,2 @@ +arm-asm-nothumb.patch +4a6d258b467f.patch diff --git a/gmp4/.pc/arm-asm-nothumb.patch/mpn/generic/div_qr_1n_pi1.c b/gmp4/.pc/arm-asm-nothumb.patch/mpn/generic/div_qr_1n_pi1.c new file mode 100644 index 0000000..229ee09 --- /dev/null +++ b/gmp4/.pc/arm-asm-nothumb.patch/mpn/generic/div_qr_1n_pi1.c @@ -0,0 +1,277 @@ +/* mpn_div_qr_1n_pi1 + + Contributed to the GNU project by Niels Möller + + THIS FILE CONTAINS INTERNAL FUNCTIONS WITH MUTABLE INTERFACES. IT IS ONLY + SAFE TO REACH THEM THROUGH DOCUMENTED INTERFACES. IN FACT, IT IS ALMOST + GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE. + + +Copyright 2013 Free Software Foundation, Inc. + +This file is part of the GNU MP Library. + +The GNU MP Library is free software; you can redistribute it and/or modify +it under the terms of either: + + * the GNU Lesser General Public License as published by the Free + Software Foundation; either version 3 of the License, or (at your + option) any later version. + +or + + * the GNU General Public License as published by the Free Software + Foundation; either version 2 of the License, or (at your option) any + later version. + +or both in parallel, as here. + +The GNU MP Library 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 copies of the GNU General Public License and the +GNU Lesser General Public License along with the GNU MP Library. If not, +see https://www.gnu.org/licenses/. */ + +#include "gmp.h" +#include "gmp-impl.h" +#include "longlong.h" + +#if GMP_NAIL_BITS > 0 +#error Nail bits not supported +#endif + +#ifndef DIV_QR_1N_METHOD +#define DIV_QR_1N_METHOD 2 +#endif + +/* FIXME: Duplicated in mod_1_1.c. Move to gmp-impl.h */ + +#if defined (__GNUC__) + +#if HAVE_HOST_CPU_FAMILY_x86 && W_TYPE_SIZE == 32 +#define add_mssaaaa(m, s1, s0, a1, a0, b1, b0) \ + __asm__ ( "add %6, %k2\n\t" \ + "adc %4, %k1\n\t" \ + "sbb %k0, %k0" \ + : "=r" (m), "=r" (s1), "=&r" (s0) \ + : "1" ((USItype)(a1)), "g" ((USItype)(b1)), \ + "%2" ((USItype)(a0)), "g" ((USItype)(b0))) +#endif + +#if HAVE_HOST_CPU_FAMILY_x86_64 && W_TYPE_SIZE == 64 +#define add_mssaaaa(m, s1, s0, a1, a0, b1, b0) \ + __asm__ ( "add %6, %q2\n\t" \ + "adc %4, %q1\n\t" \ + "sbb %q0, %q0" \ + : "=r" (m), "=r" (s1), "=&r" (s0) \ + : "1" ((UDItype)(a1)), "rme" ((UDItype)(b1)), \ + "%2" ((UDItype)(a0)), "rme" ((UDItype)(b0))) +#endif + +#if defined (__sparc__) && W_TYPE_SIZE == 32 +#define add_mssaaaa(m, sh, sl, ah, al, bh, bl) \ + __asm__ ( "addcc %r5, %6, %2\n\t" \ + "addxcc %r3, %4, %1\n\t" \ + "subx %%g0, %%g0, %0" \ + : "=r" (m), "=r" (sh), "=&r" (sl) \ + : "rJ" (ah), "rI" (bh), "%rJ" (al), "rI" (bl) \ + __CLOBBER_CC) +#endif + +#if defined (__sparc__) && W_TYPE_SIZE == 64 +#define add_mssaaaa(m, sh, sl, ah, al, bh, bl) \ + __asm__ ( "addcc %r5, %6, %2\n\t" \ + "addccc %r7, %8, %%g0\n\t" \ + "addccc %r3, %4, %1\n\t" \ + "clr %0\n\t" \ + "movcs %%xcc, -1, %0" \ + : "=r" (m), "=r" (sh), "=&r" (sl) \ + : "rJ" (ah), "rI" (bh), "%rJ" (al), "rI" (bl), \ + "rJ" ((al) >> 32), "rI" ((bl) >> 32) \ + __CLOBBER_CC) +#if __VIS__ >= 0x300 +#undef add_mssaaaa +#define add_mssaaaa(m, sh, sl, ah, al, bh, bl) \ + __asm__ ( "addcc %r5, %6, %2\n\t" \ + "addxccc %r3, %4, %1\n\t" \ + "clr %0\n\t" \ + "movcs %%xcc, -1, %0" \ + : "=r" (m), "=r" (sh), "=&r" (sl) \ + : "rJ" (ah), "rI" (bh), "%rJ" (al), "rI" (bl) \ + __CLOBBER_CC) +#endif +#endif + +#if HAVE_HOST_CPU_FAMILY_powerpc && !defined (_LONG_LONG_LIMB) +/* This works fine for 32-bit and 64-bit limbs, except for 64-bit limbs with a + processor running in 32-bit mode, since the carry flag then gets the 32-bit + carry. */ +#define add_mssaaaa(m, s1, s0, a1, a0, b1, b0) \ + __asm__ ( "add%I6c %2, %5, %6\n\t" \ + "adde %1, %3, %4\n\t" \ + "subfe %0, %0, %0\n\t" \ + "nor %0, %0, %0" \ + : "=r" (m), "=r" (s1), "=&r" (s0) \ + : "r" (a1), "r" (b1), "%r" (a0), "rI" (b0)) +#endif + +#if defined (__s390x__) && W_TYPE_SIZE == 64 +#define add_mssaaaa(m, s1, s0, a1, a0, b1, b0) \ + __asm__ ( "algr %2, %6\n\t" \ + "alcgr %1, %4\n\t" \ + "lghi %0, 0\n\t" \ + "alcgr %0, %0\n\t" \ + "lcgr %0, %0" \ + : "=r" (m), "=r" (s1), "=&r" (s0) \ + : "1" ((UDItype)(a1)), "r" ((UDItype)(b1)), \ + "%2" ((UDItype)(a0)), "r" ((UDItype)(b0)) __CLOBBER_CC) +#endif + +#if defined (__arm__) && W_TYPE_SIZE == 32 +#define add_mssaaaa(m, sh, sl, ah, al, bh, bl) \ + __asm__ ( "adds %2, %5, %6\n\t" \ + "adcs %1, %3, %4\n\t" \ + "movcc %0, #0\n\t" \ + "movcs %0, #-1" \ + : "=r" (m), "=r" (sh), "=&r" (sl) \ + : "r" (ah), "rI" (bh), "%r" (al), "rI" (bl) __CLOBBER_CC) +#endif +#endif /* defined (__GNUC__) */ + +#ifndef add_mssaaaa +#define add_mssaaaa(m, s1, s0, a1, a0, b1, b0) \ + do { \ + UWtype __s0, __s1, __c0, __c1; \ + __s0 = (a0) + (b0); \ + __s1 = (a1) + (b1); \ + __c0 = __s0 < (a0); \ + __c1 = __s1 < (a1); \ + (s0) = __s0; \ + __s1 = __s1 + __c0; \ + (s1) = __s1; \ + (m) = - (__c1 + (__s1 < __c0)); \ + } while (0) +#endif + +#if DIV_QR_1N_METHOD == 1 + +/* Divides (uh B^n + {up, n}) by d, storing the quotient at {qp, n}. + Requires that uh < d. */ +mp_limb_t +mpn_div_qr_1n_pi1 (mp_ptr qp, mp_srcptr up, mp_size_t n, mp_limb_t uh, + mp_limb_t d, mp_limb_t dinv) +{ + ASSERT (n > 0); + ASSERT (uh < d); + ASSERT (d & GMP_NUMB_HIGHBIT); + ASSERT (MPN_SAME_OR_SEPARATE_P (qp, up, n)); + + do + { + mp_limb_t q, ul; + + ul = up[--n]; + udiv_qrnnd_preinv (q, uh, uh, ul, d, dinv); + qp[n] = q; + } + while (n > 0); + + return uh; +} + +#elif DIV_QR_1N_METHOD == 2 + +mp_limb_t +mpn_div_qr_1n_pi1 (mp_ptr qp, mp_srcptr up, mp_size_t n, mp_limb_t u1, + mp_limb_t d, mp_limb_t dinv) +{ + mp_limb_t B2; + mp_limb_t u0, u2; + mp_limb_t q0, q1; + mp_limb_t p0, p1; + mp_limb_t t; + mp_size_t j; + + ASSERT (d & GMP_LIMB_HIGHBIT); + ASSERT (n > 0); + ASSERT (u1 < d); + + if (n == 1) + { + udiv_qrnnd_preinv (qp[0], u1, u1, up[0], d, dinv); + return u1; + } + + /* FIXME: Could be precomputed */ + B2 = -d*dinv; + + umul_ppmm (q1, q0, dinv, u1); + umul_ppmm (p1, p0, B2, u1); + q1 += u1; + ASSERT (q1 >= u1); + u0 = up[n-1]; /* Early read, to allow qp == up. */ + qp[n-1] = q1; + + add_mssaaaa (u2, u1, u0, u0, up[n-2], p1, p0); + + /* FIXME: Keep q1 in a variable between iterations, to reduce number + of memory accesses. */ + for (j = n-2; j-- > 0; ) + { + mp_limb_t q2, cy; + + /* Additions for the q update: + * +-------+ + * |u1 * v | + * +---+---+ + * | u1| + * +---+---+ + * | 1 | v | (conditional on u2) + * +---+---+ + * | 1 | (conditional on u0 + u2 B2 carry) + * +---+ + * + | q0| + * -+---+---+---+ + * | q2| q1| q0| + * +---+---+---+ + */ + umul_ppmm (p1, t, u1, dinv); + add_ssaaaa (q2, q1, -u2, u2 & dinv, CNST_LIMB(0), u1); + add_ssaaaa (q2, q1, q2, q1, CNST_LIMB(0), p1); + add_ssaaaa (q2, q1, q2, q1, CNST_LIMB(0), q0); + q0 = t; + + umul_ppmm (p1, p0, u1, B2); + ADDC_LIMB (cy, u0, u0, u2 & B2); + u0 -= (-cy) & d; + + /* Final q update */ + add_ssaaaa (q2, q1, q2, q1, CNST_LIMB(0), cy); + qp[j+1] = q1; + MPN_INCR_U (qp+j+2, n-j-2, q2); + + add_mssaaaa (u2, u1, u0, u0, up[j], p1, p0); + } + + q1 = (u2 > 0); + u1 -= (-q1) & d; + + t = (u1 >= d); + q1 += t; + u1 -= (-t) & d; + + udiv_qrnnd_preinv (t, u0, u1, u0, d, dinv); + add_ssaaaa (q1, q0, q1, q0, CNST_LIMB(0), t); + + MPN_INCR_U (qp+1, n-1, q1); + + qp[0] = q0; + return u0; +} + +#else +#error Unknown DIV_QR_1N_METHOD +#endif diff --git a/gmp4/AUTHORS b/gmp4/AUTHORS new file mode 100644 index 0000000..fbe298d --- /dev/null +++ b/gmp4/AUTHORS @@ -0,0 +1,100 @@ +Authors of GNU MP (in chronological order of initial contribution) + +Torbjörn Granlund Main author + +John Amanatides Original version of mpz/pprime_p.c + +Paul Zimmermann mpn/generic/mul_fft.c, now defunct dc_divrem_n.c, + rootrem.c, old mpz/powm.c, old toom3 code. + +Ken Weber Now defunct mpn/generic/bdivmod.c, old mpn/generic/gcd.c + +Bennet Yee Previous versions of mpz/jacobi.c mpz/legendre.c + +Andreas Schwab mpn/m68k/lshift.asm, mpn/m68k/rshift.asm + +Robert Harley Old mpn/generic/mul_n.c, previous versions of files in + mpn/arm + +Linus Nordberg Random number framework, original autoconfery + +Kent Boortz MacOS 9 port, now defunct. + +Kevin Ryde Most x86 assembly, new autoconfery, and countless other + things (please see the GMP manual for complete list) + +Gerardo Ballabio gmpxx.h and C++ istream input + +Pedro Gimeno Mersenne Twister random generator, other random number + revisions + +Jason Moxham Previous versions of mpz/fac_ui.c and gen-fac_ui.c + +Niels Möller gen-jacobitab.c, + mpn/generic/hgcd2.c, hgcd.c, hgcd_step.c, + hgcd_appr.c, hgcd_matrix.c, hgcd_reduce.c, + gcd.c, gcdext.c, matrix22_mul.c, + gcdext_1.c, gcd_subdiv_step.c, gcd_lehmer.c, + gcdext_subdiv_step.c, gcdext_lehmer.c, + jacobi_2.c, jacbase.c, hgcd_jacobi.c, hgcd2_jacobi.c + matrix22_mul1_inverse_vector.c, + toom_interpolate_7pts, mulmod_bnm1.c, dcpi1_bdiv_qr.c, + dcpi1_bdiv_q.c, sbpi1_bdiv_qr.c, sbpi1_bdiv_q.c, + sec_invert.c, + toom_eval_dgr3_pm1.c, toom_eval_dgr3_pm2.c, + toom_eval_pm1.c, toom_eval_pm2.c, toom_eval_pm2exp.c, + divexact.c, mod_1_1.c, div_qr_2.c, + div_qr_2n_pi1.c, div_qr_2u_pi1.c, broot.c, + brootinv.c, + mpn/x86/k7/invert_limb.asm, mod_1_1.asm, + mpn/x86_64/invert_limb.asm, + invert_limb_table.asm, mod_1_1.asm, + div_qr_2n_pi1.asm, div_qr_2u_pi1.asm, + mpn/x86_64/core2/aorsmul_1.asm, + mpz/nextprime.c, divexact.c, gcd.c, gcdext.c, + jacobi.c, combit.c, mini-gmp/mini-gmp.c. + +Marco Bodrato mpn/generic/toom44_mul.c, toom4_sqr.c, toom53_mul.c, + toom62_mul.c, toom43_mul.c, toom52_mul.c, toom54_mul.c, + toom_interpolate_6pts.c, toom_couple_handling.c, + toom63_mul.c, toom_interpolate_8pts.c, + toom6h_mul.c, toom6_sqr.c, toom_interpolate_12pts.c, + toom8h_mul.c, toom8_sqr.c, toom_interpolate_16pts.c, + mulmod_bnm1.c, sqrmod_bnm1.c, nussbaumer_mul.c, + toom_eval_pm2.c, toom_eval_pm2rexp.c, + mullo_n.c, invert.c, invertappr.c; + mpz/fac_ui.c, 2fac_ui.c, mfac_uiui.c, oddfac_1.c, + primorial_ui.c, prodlimbs.c, goetgheluck_bin_uiui.c. + +David Harvey mpn/generic/add_err1_n.c, add_err2_n.c, + add_err3_n.c, sub_err1_n.c, sub_err2_n.c, + sub_err3_n.c, mulmid_basecase.c, mulmid_n.c, + toom42_mulmid.c, + mpn/x86_64/mul_basecase.asm, aors_err1_n.asm, + aors_err2_n.asm, aors_err3_n.asm, + mulmid_basecase.asm, + mpn/x86_64/core2/aors_err1_n.asm. + +Martin Boij mpn/generic/perfpow.c + +Marc Glisse gmpxx.h improvements + +David Miller mpn/sparc32/ultrasparct1/{addmul_1,mul_1,submul_1}.asm + mpn/sparc64/ultrasparct3/{mul_1,addmul_1,submul_1}.asm + mpn/sparc64/ultrasparct3/{add_n,sub_n}.asm + mpn/sparc64/ultrasparct3/{popcount,hamdist}.asm + mpn/sparc64/ultrasparct3/cnd_aors_n.asm + mpn/sparc64/{rshift,lshift,lshiftc}.asm + mpn/sparc64/tabselect.asm + +Mark Sofroniou mpn/generic/mul_fft.c type cleanup. + +Ulrich Weigand Changes to support powerpc64le: + configure.ac, mpn/powerpc64/{elf,aix,darwin}.m4, + mpn/powerpc32/{darwin,elf}.m4, + mpn/powerpc64/mode64/{dive_1,divrem_1,divrem_2}.asm, + mpn/powerpc64/mode64/{gcd_1,invert_limb,mode1o}.asm, + mpn/powerpc64/mode64/{mod_1_1,mod_1_4}.asm, + mpn/powerpc64/mode64/p7/gcd_1.asm, + mpn/powerpc64/p6/{lshift,lshiftc,rshift}.asm, + mpn/powerpc64/vmx/popcount.asm. diff --git a/gmp4/COPYING b/gmp4/COPYING new file mode 100644 index 0000000..94a9ed0 --- /dev/null +++ b/gmp4/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 3 of the License, 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, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/gmp4/COPYING.LESSERv3 b/gmp4/COPYING.LESSERv3 new file mode 100644 index 0000000..fc8a5de --- /dev/null +++ b/gmp4/COPYING.LESSERv3 @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/gmp4/COPYINGv2 b/gmp4/COPYINGv2 new file mode 100644 index 0000000..d159169 --- /dev/null +++ b/gmp4/COPYINGv2 @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 of the License, 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, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/gmp4/COPYINGv3 b/gmp4/COPYINGv3 new file mode 100644 index 0000000..2a00065 --- /dev/null +++ b/gmp4/COPYINGv3 @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 3 of the License, 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, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/gmp4/ChangeLog b/gmp4/ChangeLog new file mode 100644 index 0000000..540c025 --- /dev/null +++ b/gmp4/ChangeLog @@ -0,0 +1,32941 @@ +2014-03-24 Torbjorn Granlund + + * Version 6.0.0 released. + + * mpn: Update countless gmp-mparam.h files. + +2014-03-22 Torbjorn Granlund + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*): Bump version info. + * gmp-h.in: Bump version. + +2014-03-17 Torbjorn Granlund + + * configure.ac: Remove clipper, i960, ns32k, pyr, a29k, z8000. + * mpn/clipper: Remove directory and all its files. + * mpn/i960: Likewise. + * mpn/ns32k: Likewise. + * mpn/pyr: Likewise. + * mpn/a29k: Likewise. + * mpn/z8000: Likewise. + * mpn/Makefile.am (TARG_DIST): Purge removed directories. + * doc/gmp.texi: Remove special mentions of removed architectures. + +2014-03-12 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpz_probab_prime_p): Micro-optimisation. + +2014-03-12 Torbjorn Granlund + + * mpn/x86/bd2/gmp-mparam.h: New file. + * mpn/x86_64/bd2/gmp-mparam.h: New file. + +2014-03-06 Niels Möller + + * tests/mpz/t-pprime_p.c (check_composites): New function. + (check_primes): New function. + (main): Call them. Also use TESTS_REPS. + + * mini-gmp/mini-gmp.c (gmp_millerrabin): New internal function. + (mpz_probab_prime_p): New function. + * mini-gmp/mini-gmp.h (mpz_probab_prime_p): Declare it. + * mini-gmp/tests/t-pprime_p.c: New test program. + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): Added t-pprime_p. + +2014-03-03 Niels Möller + + * mini-gmp/mini-gmp.c (mpz_congruent_p): New function. + * mini-gmp/mini-gmp.h: Declare it. + * mini-gmp/tests/t-cong.c: New file, based on tests/mpz/t-cong.c. + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): Added t-cong. + + * mini-gmp/tests/testutils.c (dump): New function. Deleted static + functions in other files. + (mpz_set_str_or_abort): Moved function here, from... + * mini-gmp/tests/t-cmp_d.c: ... old location. + + * mini-gmp/tests/t-reuse.c (dump3): Renamed, from ... + (dump): ...old name. + +2014-03-01 Niels Möller + + * mpn/generic/sec_powm.c (mpn_sec_powm): Clarify comment and + asserts. + +2014-02-28 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c (fake_cpuid): Handle id 7, make bold claims. + +2014-02-27 Torbjorn Granlund + + * mpn/x86_64/fat/fat_entry.asm: Zero ecx for the benefit of new BMI2 + feature test. + + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec_init): Run CPUVEC_SETUP_coreihwl + conditionally on BMI2 availability. + + * config.guess: Revert "coreihwl" to "coreisbr" if cpuid indicates that + BMI2 is missing. + (x86 cpuid, 2 variants): Zero ecx for the benefit of new BMI2 feature + test. + +2014-02-21 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpn_sqrtrem): New function. + * mini-gmp/mini-gmp.h: Declare it. + * mini-gmp/tests/t-sqrt.c: Test it. + +2014-02-17 Niels Möller + + * mpn/generic/div_qr_1.c (mpn_div_qr_1): Revert yesterday's fix. + Hopefully no longer needed. + + * mpn/s390_64/gmp-mparam.h (DIV_QR_1_NORM_THRESHOLD): Up to 1. + * mpn/s390_64/z10/gmp-mparam.h (DIV_QR_1_NORM_THRESHOLD): Up to 1. + + * tune/tuneup.c (tune_div_qr_1): Ensure DIV_QR_1_NORM_THRESHOLD, + DIV_QR_1_UNNORM_THRESHOLD >= 1. + +2014-02-16 Marco Bodrato + + * mpn/generic/div_qr_1.c: Disallow DIV_QR_1_NORM_THRESHOLD==0. + +2014-02-15 Torbjorn Granlund + + * tests/mpn/t-div.c: Fix typo. + +2014-02-15 Marco Bodrato + + * doc/gmp.texi (mpz_roinit_n, MPZ_ROINIT_N): Document that + at least a readable limb is required. + * mini-gmp/mini-gmp.c (mpz_div_qr): init + set = init_set . + +2014-02-14 Niels Möller + + * doc/gmp.texi (Low-level Functions): Update docs for + mpn_sec_powm, to specify that left-over exponent bits must be + zero. + +2014-02-11 Niels Möller + + * Makefile.am (EXTRA_DIST): Distribute COPYING.LESSERv3, + COPYINGv2, and COPYINGv3. + + * doc/gmp.texi (Low-level Functions): Updated mpn_sec_powm docs. + + * mpn/generic/sec_powm.c (mpn_sec_powm): Replaced exponent limb + count argument by bit count. Don't leak high exponent bits, and + drop the requirement that the most significant exponent limb is + non-zero. + (mpn_sec_powm_itch): Analogous interface change. + * gmp-h.in: Updated prototypes. + * mpz/powm_sec.c (mpz_powm_sec): Update mpn_sec_powm* calls. + * tune/tuneup.c (tune_powm_sec): Likewise. Also deleted code + fiddling with the high exponent bits. + +2014-02-10 Marco Bodrato + + * mini-gmp/tests/t-limbs.c: New test for mpz_limbs_*. + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): Add it. + +2014-02-09 Niels Möller + + * tune/tuneup.c (tune_powm_sec): Avoid timing of the nonsensical + parameters nbits = 1, winsize = 2. Decrement tabulated values, to + better match the > comparison when the table is used. + + * mpn/generic/sec_powm.c (win_size): Comment why we always get + win_size(eb) <= eb. Make the table const. + (mpn_sec_powm): Deleted handling of winsize > initial ebi. For + now, replaced with an ASSERT_ALWAYS. + +2014-02-08 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpz_realloc2, mpz_limbs_read, mpz_limbs_modify + mpz_limbs_write, mpz_limbs_finish, mpz_roinit_n): New functions. + (mpn_perfect_square_p): New function. + * mini-gmp/mini-gmp.h: Declare them. + + * mini-gmp/tests/t-mul.c: Use roinit and limbs_read to test mpn. + * mini-gmp/tests/t-sqrt.c: Test also mpn_perfect_square_p. + +2014-02-08 Niels Möller + + * mpn/generic/sec_invert.c (mpn_cnd_neg_itch): #if:ed out unused + function. + + * mpn/generic/sec_div.c: Simplified code for the normalized case. + + * tests/mpn/t-div.c (main): Test mpn_sec_div_qr and mpn_sec_div_r + with normalized d. + +2014-02-04 Niels Möller + + * doc/gmp.texi (Low-level Functions): Document mpn_sec_add_1 and + mpn_sec_sub_1. + +2014-02-03 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpn_rootrem): Allow NULL argument. + + * mini-gmp/mini-gmp.c (mpn_zero): New function. + (mpz_perfect_square_p): New function. + * mini-gmp/mini-gmp.h: Declare them. + + * mini-gmp/tests/t-sqrt.c: Test mpz_perfect_square_p. + * mini-gmp/tests/t-root.c: Test also 1-th root, allow perfect powers. + +2014-01-29 Torbjorn Granlund + + * doc/gmp.texi (Floating-point Functions): Revise. + +2014-01-29 Niels Möller + + * README: Don't refer to specific COPYING* files, instead refer to + manual for details. + + * COPYING.LIB: Renamed, to... + * COPYING.LESSERv3: ... new name. + * COPYING: Renamed, to... + * COPYINGv3: ... new name. + * COPYINGv2: New file, GPLv2. + + * doc/gmp.texi (Copying): Document dual licensing. + +2014-01-27 Torbjorn Granlund + + * Update library files license to use LGPL3+ and GPL2+. + +2014-01-27 Marco Bodrato + + * tests/mpn/t-aors_1.c: Check sec_aors_1 red zones (not smart). + + * mpn/generic/sec_aors_1.c: Mark the 2nd argument as const. + * gmp-h.in (mpn_sec_add_1, mpn_sec_sub_1): Likewise. + +2014-01-24 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c (fake_cpuid_table): Use proper steamroller and + excavator values. + + * config.guess: Amend last AMD change. + + * mpn/s390_64/lshift.asm: Align loop. + * mpn/s390_64/rshift.asm: Likewise. + * mpn/s390_64/lshiftc.asm: Likewise. + * mpn/s390_64: Add z10 cycle numbers. + +2014-01-23 Marco Bodrato + + * printf/repl-vsnprintf.c: Feed case 'z' in switch (type) with case 'z' + in switch (fchar). + + * mini-gmp/tests/t-aorsmul.c: New file, test for mpz_{add,sub}mul{,_ui} + * mini-gmp/tests/Makefile: Add t-aorsmul. + +2014-01-21 Marco Bodrato + + * acinclude.m4 (GMP_FUNC_VSNPRINTF): Get rid of varargs. + +2014-01-20 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec_init): Fix duplicate entries for + AMD "jaguar". + + * demos/expr: Get rid of varargs code and references. + +2014-01-19 Torbjorn Granlund + + * config.guess: Add new AMD CPUs (piledriver, steamroller, excavator, + jaguar). + * config.sub: Corresponding updates. + * configure.ac: Likewise. + * acinclude.m4 (X86_64_PATTERN): Likewise. + * mpn/x86_64/fat/fat.c: Likewise. + + * Rename mpn_sec_minvert => mpn_sec_invert, many files affected. + * mpn/generic/sec_invert.c: New name for sec_minvert.c. + + * doc/gmp.texi: Undocument mpz_array_init. + + * acinclude.m4 (GMP_C_STDARG): Comment out. + * configure.ac: Suppress GMP_C_STDARG invocation. + + * Get rid of varargs code and references, many file affected. + + * Use mpq_t in favour of MP_RAT, many mpq files affected. + + * Get rid of BYTES_PER_MP_LIMB, most files affected. + + * mpz/iset.c: Avoid overflow in allocation computation. + * mpz/mul.c: Likewise. + * mpf/init.c: Likewise. + * mpf/init2.c: Likewise. + * mpf/iset.c: Likewise. + * mpf/iset_d.c: Likewise. + * mpf/iset_si.c: Likewise. + * mpf/iset_str.c: Likewise. + * mpf/iset_ui.c: Likewise. + + * mpz/array_init.c: Avoid two overflow scenarios in allocation + computation. + + * mpn/s390_64/z10/gmp-mparam.h: New file. + + * mpz/clears.c: Call __gmp_free_func ourselves instead of via + mpz_clears. + * mpf/clears.c: Analogous change. + * mpq/clears.c: Analogous change. + + * mpz/clear.c: Add cast to avoid overflow of (later ignored) argument. + * mpf/clear.c: Likewise. + +2014-01-19 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpn_popcount): New function. + (mpz_popcount): Use it. + (mpz_addmul_ui, mpz_addmul, mpz_submul_ui, mpz_submul): Added. + * mini-gmp/mini-gmp.h: Declare them. + +2014-01-18 Niels Möller + + * tests/mpn/t-aors_1.c: Test also mpn_sec_add_1 and mpn_sec_sub_1. + + * tests/mpn/t-minvert.c (main): Pass smallest allowed bit_size + argument to mpn_sec_minvert. + +2014-01-18 Marc Glisse + + * doc/gmp.texi (C++ Interface Limitations): Warn against C++11 auto. + +2014-01-18 Marco Bodrato + + * tests/t-parity.c: Use 1UL to generate unsigned constants. + * tests/t-constants.c: Disable a non portable (unneeded) check. + +2014-01-18 Niels Möller + + * mpn/generic/sec_aors_1.c (mpn_sec_add_1, mpn_sec_sub_1): New + file. + + * mpn/generic/sec_minvert.c (mpn_sec_add_1_itch, mpn_sec_add_1): + Deleted static definitions. + (mpn_cnd_swap): Use volatile. + + * configure.ac (gmp_mpn_functions): sec_add_1 and sec_sub_1. + (GMP_MULFUNC_CHOICES): Set up for sec_aors_1. + +2014-01-16 Niels Möller + + * tune/common.c (speed_mpn_sec_minvert): New function. + * tune/speed.h: Declare it. + (SPEED_ROUTINE_MPN_SEC_MINVERT): New macro. + * tune/speed.c (routine): Added mpn_sec_minvert. + + * mini-gmp/mini-gmp.c (mp_bits_per_limb): New const value. + * mini-gmp/mini-gmp.h: Declare it. + +2014-01-12 Marc Glisse + + * demos/expr/expr.h: Add extern "C" for C++. + +2014-01-11 Torbjorn Granlund + + * doc/gmp.texi (Notes for Particular Systems): Add items about old + NetBSD and current FreeBSD m4 problems. Add item about FreeBSD's + broken limits.h. + +2014-01-05 Marco Bodrato + + * gmp-impl.h: Declare all _itch functions using ATTRIBUTE_CONST. + +2014-01-05 Torbjorn Granlund + + * configure.ac (alpha): Set extra_functions conditionally. + + * gmp-h.in (mpn_sec_minvert): Remove formal parameters. + + * doc/gmp.texi: Improve doc for several functions. + + * mpn/generic/sec_tabselect.c: Declare input arg using 'const'. + * gmp-h.in: Analogous change. + + * gmp-h.in: Declare all itch functions using __GMP_ATTRIBUTE_PURE. + * gmp-impl.h: Likewise. + +2014-01-05 Marco Bodrato + + * tests/mpn/t-minvert.c: Always compare with mpz_invert results, + add red zone to scratch. + * tests/mpn/t-sizeinbase.c: New test. + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-sizeinbase.c . + * tests/mpn/t-div.c: Use mpn_sec_div_*_itch(). + + * mpn/generic/pow_1.c: Micro-optimisation. + +2014-01-04 Torbjorn Granlund + + * acinclude.m4 (GMP_PROG_M4): Avoid hex output, since case varies. + +2014-01-03 Torbjorn Granlund + + * config.guess: Support newer haswell, broadwell, silvermont. + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec_init): Likewise. + + * acinclude.m4 (GMP_PROG_M4): Check that eval's radix argument work. + + * mpz/invert.c: Rely on gcdext for all operands, removing faulty + special case. + * tests/mpz/t-invert.c: Enforce correct behaviour for |mod| = 1. + +2014-01-02 Niels Möller + + * doc/gmp.texi (Low-level Functions): Document mpn_sizeinbase. + + Enable previously unused mpn_sizeinbase function. + * configure.ac (gmp_mpn_functions): Added sizeinbase. + * gmp-h.in (mpn_sizeinbase): New prototype. + +2014-01-02 Marc Glisse + + * gmp-impl.h: Always include . + * tests/mpn/t-get_d.c: Remove comment about + + * gmp-h.in (__GMP_USHRT_MAX): Use the promoted type. + * gmp-impl.h (USHRT_HIGHBIT, SHRT_MIN, SHRT_MAX): Likewise. + * tests/t-constants.c: Adapt printf strings. + * tests/t-gmpmax.c: Likewise. + + * tests/mpn/t-hgcd_appr.c (hgcd_appr_valid_p): Add parentheses. + +2014-01-01 Torbjorn Granlund + + * doc/gmp.texi (Low-level Functions for cryptography): Update interface + for mpn_sec_div_qr and fix typos in mpn_sec_minvert text. + + * mpn/generic/sec_div.c: Rewrite to make mpn_sec_div_qr return high + quotient limb. + * gmp-h.in (mpn_sec_div_qr): Update declaration. + * tests/mpn/t-div.c: Adapt. + +2013-12-31 Niels Möller + + * doc/gmp.texi (Low-level Functions for cryptography): Document + mpn_sec_minvert. + +2013-12-30 Marc Glisse + + * doc/gmp.texi (C++ interface internals): Break long line. + +2013-12-30 Torbjorn Granlund + + * doc/gmp.texi (Low-level Functions for cryptography): New section. + +2013-12-29 Niels Möller + + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-minvert. + * tests/mpn/t-minvert.c: New file. + + * configure.ac (gmp_mpn_functions): Added sec_minvert. + * gmp-h.in (mpn_sec_minvert, mpn_sec_minvert_itch): New + declarations. + * mpn/generic/sec_minvert.c (mpn_sec_minvert) + (mpn_sec_minvert_itch): New functions. + (mpn_sec_add_1, mpn_cnd_neg, mpn_cnd_swap, mpn_sec_eq_ui): New + helper functions. + +2013-12-28 Torbjorn Granlund + + * mpn/generic/sec_powm.c: Fix an ASSERT. + + * gmp-h.in (mpn_sec_mul, mpn_sec_mul_itch): New declarations. + * gmp-h.in (mpn_sec_sqr, mpn_sec_sqr_itch): Likewise. + * mpn/generic/sec_mul.c: New file. + * mpn/generic/sec_sqr.c: New file. + + * gmp-h.in (mpn_sec_powm, mpn_sec_powm_itch): New declarations. + * gmp-h.in (mpn_sec_div_qr, mpn_sec_div_qr_itch): Likewise. + * gmp-h.in (mpn_sec_div_r, mpn_sec_div_r_itch): Likewise. + * gmp-impl: Remove declarations of above functions. + + * configure.ac (gmp_mpn_functions): Add sec_mul and sec_sqr. + +2013-12-26 Marco Bodrato + + * Update many file's encoding to UTF-8. + * doc/tasks.html: Update accordingly. + * doc/projects.html: Likewise. + +2013-12-26 Torbjorn Granlund + + * configure.ac: Rename mpn_blah_sec to mpn_sec_blah. + * gmp-impl.h: Corresponding changes. + * mpn/asm-defs.m4: Corresponding changes. + * tune/Makefile.am: Corresponding changes. + * tune/common.c: Corresponding changes. + * tune/speed.c: Corresponding changes. + * tune/speed.h: Corresponding changes. + * tune/tuneup.c: Corresponding changes. + * mpz/powm_sec.c: Update calls. + * tests/mpn/t-div.c: Likewise. + + * mpn/generic/sec_powm.c: New name for mpn/generic/powm_sec.c. + * mpn/generic/sec_div.c: New name for mpn/generic/sb_div_sec.c. + * mpn/generic/sec_pi1_div.c: New name for mpn/generic/sbpi1_div_sec.c. + * mpn/generic/sec_tabselect.c: New name for mpn/generic/tabselect.c. + + * mpn/alpha/sec_tabselect.asm: New name for tabselect.asm. + * mpn/arm/neon/sec_tabselect.asm: New name for tabselect.asm. + * mpn/arm/sec_tabselect.asm: New name for tabselect.asm. + * mpn/ia64/sec_tabselect.asm: New name for tabselect.asm + * mpn/powerpc32/sec_tabselect.asm: New name for tabselect.asm + * mpn/powerpc64/sec_tabselect.asm: New name for tabselect.asm + * mpn/sparc64/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86/mmx/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/bd1/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/core2/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/coreinhm/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/coreisbr/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/fastsse/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/k10/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/pentium4/sec_tabselect.asm: New name for tabselect.asm + * mpn/x86_64/sec_tabselect.asm: New name for tabselect.asm + +2013-12-25 Torbjorn Granlund + + * mpz/powm_sec.c: Handle 0^e mod m specially. + * mpn/generic/powm_sec.c: ASSERT that the base is non-zero. + +2013-12-23 Torbjorn Granlund + + * mpn/generic/powm_sec.c (redcify): Use passed scratch instead of + locally allocated. + (mpn_powm_sec_itch): Accommodate mpn_sb_div_r_sec's scratch needs. + +2013-12-20 Mark Sofroniou + + * mpn/generic/mul_fft.c: Major overhaul of types. + +2013-12-18 Torbjorn Granlund + + * doc/gmp.texi (Low-level Functions): Rewrite mpn_set_str docs. + +2013-12-14 Ulrich Weigand + + * mpn/powerpc32/darwin.m4: Allow (and ignore) optional + 'toc' parameter to PROLOGUE_cpu. + * mpn/powerpc32/elf.m4: Likewise. + +2013-12-09 Ulrich Weigand + + * configure.ac: Check for ELFv2 ABI on PowerPC. + * mpn/powerpc64/elf.m4: Set assembler ABI version for ELFv2 + and use appropriate PROLOGUE_cpu/EPILOGUE_cpu sequences. + Support optional 'toc' parameter to PROLOGUE_cpu. + * mpn/powerpc64/aix.m4: Allow (and ignore) optional + 'toc' parameter to PROLOGUE_cpu. + * mpn/powerpc64/darwin.m4: Likewise. + + * mpn/powerpc64/mode64/dive_1.asm (mpn_divexact_1): Add 'toc' + parameter to PROLOGUE. + * mpn/powerpc64/mode64/divrem_1.asm (mpn_divrem_1): Likewise. + * mpn/powerpc64/mode64/divrem_2.asm (mpn_divrem_2): Likewise. + * mpn/powerpc64/mode64/gcd_1.asm (mpn_gcd_1): Likewise. + * mpn/powerpc64/mode64/invert_limb.asm (mpn_invert_limb): Likewise. + * mpn/powerpc64/mode64/mod_1_1.asm (mpn_mod_1_1p_cps): Likewise. + * mpn/powerpc64/mode64/mod_1_4.asm (mpn_mod_1s_4p_cps): Likewise. + * mpn/powerpc64/mode64/mode1o.asm (mpn_modexact_1c_odd): Likewise. + * mpn/powerpc64/mode64/p7/gcd_1.asm (mpn_gcd_1): Likewise. + * mpn/powerpc64/p6/lshift.asm (mpn_lshift): Likewise. + * mpn/powerpc64/p6/lshiftc.asm (mpn_lshiftc): Likewise. + * mpn/powerpc64/p6/rshift.asm (mpn_rshift): Likewise. + * mpn/powerpc64/vmx/popcount.asm (mpn_popcount): Likewise. + +2013-12-07 Niels Möller + + * configfsf.sub: Updated to version 2013-10-01, from gnulib. + * configfsf.guess: Updated to version 2013-11-29, from gnulib. + +2013-12-03 Torbjorn Granlund + + * mpn/generic/div_qr_1.c: Make constant args asm inlines become limbs. + * mpn/generic/div_qr_1n_pi1.c: Likewise. + * mpn/generic/div_qr_2.c: Likewise. + * mpn/generic/div_qr_2.c: Likewise. + * mpn/generic/mod_1_1.c: Likewise. + * mpn/generic/mod_1_2.c: Likewise. + * mpn/generic/mod_1_3.c: Likewise. + * mpn/generic/mod_1_4.c: Likewise. + * mpn/generic/mulmid_basecase.c: Likewise. + * mpn/generic/mulmod_bnm1.c: Likewise. + * mpn/generic/sqrmod_bnm1.c: Likewise. + * mpn/sparc64/divrem_1.c: Likewise. + * mpn/sparc64/mod_1_4.c: Likewise. + + * mpn/generic/toom_interpolate_7pts.c (BINVERT_15): Fix typo. + +2013-11-11 Torbjorn Granlund + + * mpn/x86_64/dos64.m4 (CALL): Provide to override default. + +2013-11-08 Torbjorn Granlund + + * mpn/x86_64/x86_64-defs.m4 (CALL): Swap PIC test and macro defn. + + * mpn/generic/div_qr_2.c: Test HAVE_HOST_CPU_FAMILY_x86, not i386. + + * doc/gmp.texi: Update many URLs. + +2013-11-04 Torbjorn Granlund + + * configure.ac: Set symbol OPENBSD for x86-openbsd hosts. + * mpn/x86_64/fat/fat_entry.asm (PRETEND_PIC): New name for + PIC_OR_DARWIN. + (PRETEND_PIC): Set also for OPENBSD. + +2013-10-29 Torbjorn Granlund + + * printf/doprnt.c (__gmp_doprnt): Use memcpy instead of strcpy. + +2013-10-24 Torbjorn Granlund + + * mpn/generic/div_qr_1u_pi2.c: New file. + * mpn/generic/div_qr_1n_pi2.c: New file. + +2013-10-24 Niels Möller + + * mpn/x86_64/div_qr_1n_pi1.asm: Bugfixes, for case n == 1 and + in-place operation. + * mpn/x86_64/k8/div_qr_1n_pi1.asm: Likewise. + + * mpn/generic/div_qr_1n_pi1.c (mpn_div_qr_1n_pi1): Bug fixes, + off-by-one MPN_INCR_U, and support for in-place operation. + +2013-10-24 Torbjorn Granlund + + * mpn/x86/fat/fat.c (fake_cpuid_table): Add Haswell. + +2013-10-23 Torbjorn Granlund + + * mpn/x86_64/x86_64-defs.m4 (oplist): New define, data from `regnum'. + (regnum): Use x86_lookup, feed oplist. + +2013-10-22 Niels Möller + + * tests/devel/try.c: Support mpn_div_qr_1n_pi1. + + * mpn/x86_64/k8/div_qr_1n_pi1.asm: Moved the below k10 file here. + Applied tweak from Torbjörn to get it to run well on k8. + + * mpn/x86_64/k10/div_qr_1n_pi1.asm: New file (renamed above). + Differs from generic x86_64 version by using cmov. + + * mpn/x86_64/div_qr_1n_pi1.asm: Reordered arguments to second mul. + Deleted misleading cycle annotations. + +2013-10-21 Niels Möller + + * configure.ac: Add HAVE_NATIVE_mpn_div_qr_1n_pi1 to config.in. + + * mpn/generic/div_qr_1n_pi1.c (mpn_div_qr_1n_pi1): Fix typos + affecting ASSERT. + +2013-10-20 Niels Möller + + * mpn/x86_64/div_qr_1n_pi1.asm: New file. + + * tune/div_qr_1_tune.c (__gmpn_div_qr_1n_pi1): Check + div_qr_1n_pi1_method only when !HAVE_NATIVE_mpn_div_qr_1n_pi1. + + * mpn/asm-defs.m4 (define_mpn): Add div_qr_1n_pi1. + + * tune/common.c (speed_mpn_div_qr_1): New function, replacing... + (speed_mpn_div_qr_1n, speed_mpn_div_qr_1u): ... deleted functions + (speed_mpn_div_qr_1n_pi1, speed_mpn_div_qr_1n_pi1_1) + (speed_mpn_div_qr_1n_pi1_2): New functions. + * gmp-impl.h [TUNE_PROGRAM_BUILD]: Declare div_qr_1-related tuning + variables. + * tune/tuneup.c (speed_mpn_div_qr_1_tune, tune_div_qr_1): New + functions. + (div_qr_1n_pi1_method, div_qr_1_norm_threshold) + (div_qr_1_unnorm_threshold): New globals. + * tune/speed.c (routine): Replaced mpn_div_qr_1n and mpn_div_qr_1u + by mpn_div_qr_1, requiring ".r" parameter. Added mpn_div_qr_1n_pi1 + and variants. + * tune/speed.h (SPEED_ROUTINE_MPN_DIV_QR_1): Use the "r" parameter + as divisor. + * tune/div_qr_1n_pi1_2.c: New file. + * tune/div_qr_1n_pi1_1.c: New file. + * tune/div_qr_1_tune.c: New file. + * tune/Makefile.am (libspeed_la_SOURCES): Added div_qr_1n_pi1_1.c, + div_qr_1n_pi1_2.c, and div_qr_1_tune.c. + + * tune/speed.c (routine): Added mpn_div_qr_1n and mpn_div_qr_1u. + * tune/speed.h (SPEED_ROUTINE_MPN_DIV_QR_1): New macro. + (speed_mpn_div_qr_1n, speed_mpn_div_qr_1u): Declare. + * tune/common.c (speed_mpn_div_qr_1n, speed_mpn_div_qr_1u): New + functions. + + * gmp-impl.h (mpn_div_qr_1n_pi1): Declare function. + * gmp-h.in (mpn_div_qr_1): Declare function. + * configure.ac (gmp_mpn_functions): Added div_qr_1 and + div_qr_1n_pi1. + * mpn/generic/div_qr_1.c (mpn_div_qr_1): New file and function. + * mpn/generic/div_qr_1n_pi1.c (mpn_div_qr_1n_pi1): New file and + function. + * tests/mpn/t-div.c (main): Test mpn_div_qr_1. + +2013-10-17 Torbjorn Granlund + + * configure.ac (alpha): Pass -mieee via gcc_cflags_maybe. + +2013-10-16 Torbjorn Granlund + + * config.guess: Let AMD64 cpuid bit override pessimistic cpu guesses. + + * mpn/alpha/unicos.m4 (DATASTART): Accept optional align parameter. + * mpn/alpha/divrem_2.asm: Use provided gp mechanisms. + * mpn/alpha/default.m4 (PROLOGUE): Provide "..ng" post-gp label. + * mpn/alpha/invert_limb.asm: Align table to 8-byte boundary. Make code + work if table is not fully aligned. Properly test for BWX. + +2013-10-15 Torbjorn Granlund + + * mpn/alpha/default.m4 (DATASTART): Use RODATA instead of DATA; + accept optional align parameter. + * mpn/alpha/invert_limb.asm: Align table. + * mpn/alpha/ev5/diveby3.asm: Likewise. + +2013-10-11 Torbjorn Granlund + + * mpn/x86/k7/mod_1_1.asm: Use 'subl' form to avoid ambiguity. + * mpn/x86/k7/mod_1_4.asm: Likewise. + + * configure.ac (X86_64_PATTERN): Append "cc" to cclist_64 and + cclist_x32. + +2013-10-08 Torbjorn Granlund + Marc Glisse + + * tests/mpf/reuse.c (main): Compare addresses instead of names. + Use larger numbers for exponents. + +2013-10-08 Marc Glisse + + * doc/mdate-sh, doc/texinfo.tex, install-sh, missing, ylwrap: Remove. + * .bootstrap: Use autoreconf (and in particular automake -a). + + * gmp-h.in: Remove __need_size_t. Include , not . + + * tests/mpf/reuse.c (main): Use small numbers as exponents. + +2013-10-05 Torbjorn Granlund + + * mpn/x86_64/atom/aorsmul_1.asm: Slight tweak. + + * doc/gmp.texi (ABI and ISA): Document x32. + + * mpn/sparc64/ultrasparct3/dive_1.asm: Use our register names. + +2013-09-24 Torbjorn Granlund + + * mpn/x86_64/atom/redc_1.asm: New file. + +2013-09-23 Torbjorn Granlund + + * mpn/x86_64/bobcat/redc_1.asm: Make the code for 1 <= n <= 3 work. + +2013-09-22 Torbjorn Granlund + + * mpn/x86_64/coreisbr/redc_1.asm: Slightly tweak basecase code. + + * mpn/x86_64/core2/redc_1.asm: New file. + + * mpn/x86_64/bobcat/redc_1.asm: New file. + +2013-09-21 Torbjorn Granlund + + * mpn/x86_64/coreinhm/redc_1.asm: New file. + +2013-09-21 Marc Glisse + + * tests/mpn/t-mulmid.c: Cast arguments of printf to int to match %d. + * tests/rand/t-urbui.c: Use 1UL for unsigned constant. + * mpn/generic/get_str.c: Avoid temporarily pointing outside an array. + +2013-09-20 Torbjorn Granlund + + * mpn/x86_64/coreisbr/redc_1.asm: New file. + + * mpn/x86_64/k8/redc_1.asm: Complete rewrite. + + * mpn/x86_64/coreisbr/mullo_basecase.asm: Postpone pushes, short- + circuit a branch. + * mpn/x86_64/coreihwl/mullo_basecase.asm: Short-circuit a branch. + + * mpn/x86_64/core2/mullo_basecase.asm: New file. + +2013-09-19 Torbjorn Granlund + + * mpn/x86_64/fastsse/copyi-palignr.asm: Allocate more stack under DOS. + +2013-09-18 Torbjorn Granlund + + * mpn/x86_64/core2/mul_basecase.asm: New file. + * mpn/x86_64/core2/sqr_basecase.asm: New file. + + * mpn/x86_64/coreihwl/mullo_basecase.asm: New file. + * mpn/x86_64/coreisbr/mullo_basecase.asm: New file. + +2013-09-16 Torbjorn Granlund + + * mpn/x86_64/fastsse/copyi-palignr.asm: Preserve xmm6-xmm8 under DOS. + +2013-09-15 Torbjorn Granlund + + * mpn/x86_64/tabselect.asm: Use R8 for bit testing. + + * mpn/x86_64/coreihwl/mul_basecase.asm: Replace mul_1 code. + + * mpn/x86_64/coreisbr/aorsmul_1.asm: Rewrite. + +2013-09-12 Torbjorn Granlund + + * mpn/ia64/gcd_1.asm: Use dep for combining table base and low bits. + + * mpn/x86_64/fastsse/com-palignr.asm: Implement temp fix to properly + handle overlap. + +2013-09-10 Torbjorn Granlund + + * mpn/x86_64/fastsse/copyi-palignr.asm: Rewrite rp != up (mod 16) code + to make it handle any allowed overlap. + +2013-09-09 Torbjorn Granlund + + * mpn/x86_64/atom/com.asm: New file, grabbing fastsse code. + + * mpn/x86_64/bd1/copyi.asm: New file, grabbing fastsse code. + * mpn/x86_64/bd1/copyd.asm: Likewise. + * mpn/x86_64/bd1/com.asm: Likewise. + + * mpn/x86_64/fastavx/copyi.asm: New file. + * mpn/x86_64/fastavx/copyd.asm: New file. + +2013-09-05 Torbjorn Granlund + + * mpn/x86_64/coreihwl/aorsmul_1.asm: Streamline. + +2013-09-04 Torbjorn Granlund + + * mpn/x86_64/coreihwl/sqr_basecase.asm: Implement larger "corner". + Misc tuning. + +2013-09-03 Torbjorn Granlund + + * mpn/x86_64/coreihwl/redc_1.asm: New file. + + * mpn/x86_64/x86_64-defs.m4 (mulx): Handle negative offsets. + +2013-08-31 Torbjorn Granlund + + * mpn/x86_64/coreisbr/sqr_basecase.asm: New file. + + * mpn/x86_64/sqr_diag_addlsh1.asm: New file. + +2013-08-30 Torbjorn Granlund + + * mpn/x86_64/fat/mul_basecase.c: New file. + * mpn/x86_64/fat/sqr_basecase.c: New file. + * mpn/x86_64/fat/mullo_basecase.c: New file. + * mpn/x86_64/fat/redc_1.c: New file. + +2013-08-29 Torbjorn Granlund + + * mpn/x86_64/k8/mul_basecase.asm: Move top-level basecase file to k8 + subdir. + * mpn/x86_64/k8/sqr_basecase.asm: Likewise. + * mpn/x86_64/k8/redc_1.asm: Likewise. + * mpn/x86_64/k8/mullo_basecase.asm: Likewise. + * mpn/x86_64/k8/mulmid_basecase.asm: Likewise. + + * mpn/ia64/aors_n.asm: Clean up some bundlings. + + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec_init): Support Haswell. + (fake_cpuid_table): Likewise. + + * configure.ac (x86): Remove any mulx paths. Let bwl path = hwl path. + (fat_path): Add coreihwl. + + * mpn/x86_64/coreihwl/aorsmul_1.asm: Move from `mulx' directory, use + mulx() macro. + * mpn/x86_64/coreihwl/mul_1.asm: Likewise. + * mpn/x86_64/coreihwl/mul_2.asm: Likewise. + * mpn/x86_64/coreihwl/mul_basecase.asm: Likewise. + * mpn/x86_64/coreihwl/sqr_basecase.asm: Likewise. + + * mpn/x86_64/x86_64-defs.m4 (mulx): New macro. + (regnum, regnumh, ix): Supporting macros. + +2013-08-28 Torbjorn Granlund + + * mpn/x86_64/coreisbr/divrem_1.asm: New file. + +2013-08-23 Torbjorn Granlund + + * mpn/x86_64/fastsse/com-palignr.asm: New file, closely based on + copyi-palignr.asm. + + * mpn/x86_64/fastsse/copyi.asm Use "test R8(reg)" instead of "bt". + * mpn/x86_64/fastsse/copyd-palignr.asm: Likewise. + * mpn/x86_64/fastsse/copyi-palignr.asm: Likewise. + * mpn/x86_64/fastsse/lshift-movdqu2.asm: Likewise. + * mpn/x86_64/fastsse/lshiftc-movdqu2.asm: Likewise. + * mpn/x86_64/fastsse/rshift-movdqu2.asm: Likewise. + * mpn/x86_64/fastsse/tabselect.asm: Likewise. + + * mpn/sparc64/ultrasparct3/sqr_diag_addlsh1.asm: New file. + + * mpn/alpha/aorslsh2_n.asm: New file. + * mpn/alpha/aorslsh1_n.asm: Rewrite. + * mpn/alpha/ev6/aorslsh1_n.asm: New file. + +2013-08-21 Torbjorn Granlund + + * mpn/alpha/sqr_diag_addlsh1.asm: New file. + * mpn/alpha/sqr_diagonal.asm: Remove. + * mpn/alpha/ev6/sqr_diagonal.asm: Remove. + +2013-08-20 Torbjorn Granlund + + * mpn/powerpc32/sqr_diag_addlsh1.asm: New file. + * mpn/powerpc32/sqr_diagonal.asm: Remove. + +2013-08-15 Torbjorn Granlund + + * mpn/x86_64/coreihwl/mulx/sqr_basecase.asm: New file. + +2013-08-05 Torbjorn Granlund + + * mpn/x86_64/coreisbr/aors_n.asm: Complete rewrite. + +2013-08-04 Torbjorn Granlund + + * mpn/x86_64/coreihwl/mulx/mul_basecase.asm: New file. + + * mpn/x86_64/bd1/mul_2.asm: New file. + + * mpn/x86_64/coreihwl/gmp-mparam.h: New file. + +2013-08-03 Torbjorn Granlund + + * mpn/x86_64/coreihwl/mulx/mul_2.asm: New file. + * mpn/x86_64/coreihwl/mulx/addmul_2.asm: New file. + + * mpn/x86_64/coreinhm/aorsmul_1.asm: New file. + + * mpn/x86_64/coreisbr/mul_basecase.asm: Save some O(n) and O(1) cycles. + + * mpn/x86_64/coreisbr/mul_2.asm: New file. + +2013-08-02 Torbjorn Granlund + + * mpn/x86_64/coreisbr/addmul_2.asm: Complete rewrite. + +2013-08-01 Torbjorn Granlund + + * mpn/x86_64/bd1/mul_basecase.asm: New file. + + * mpn/x86_64/coreisbr/mul_basecase.asm: New file. + + * mpn/x86_64/coreihwl/aorsmul_1.asm: New file. + +2013-07-31 Torbjorn Granlund + + * mpn/x86_64/atom/mul_2.asm: New file. + * mpn/x86_64/atom/addmul_2.asm: New file. + * mpn/x86_64/atom/mul_1.asm: New file. + * mpn/x86_64/atom/aorsmul_1.asm: New file. + + * mpn/x86_64/coreihwl/mul_1.asm: New file. + + * configure.ac (x86): Add Haswell-specific path. + + * configure.in (fat_functions): Add cnd_add_n, cnd_sub_n.. + * gmp-impl.h (struct cpuvec_t): Add fields for new fat functions. + * gmp-impl.h: Adjust corresponding declarations. + + * mpn/x86_64/x86_64-defs.m4 (CPUVEC_FUNCS_LIST): Add new fat functions. + * mpn/x86/x86-defs.m4 (CPUVEC_FUNCS_LIST): Likewise. + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec): Likewise. + * mpn/x86/fat/fat.c (__gmpn_cpuvec): Likewise. + +2013-07-30 Torbjorn Granlund + + * mpn/x86_64/coreisbr/popcount.asm: New file. + +2013-07-23 Torbjorn Granlund + + * mpn/x86_64/bobcat/aors_n.asm: New file. + + * mpn/x86_64/pentium4/aorslshC_n.asm: Remove a spurious emms insn. + + * mpn/x86_64/bd1/aorrlsh1_n.asm: New file. + * mpn/x86_64/bd1/sublsh1_n.asm: New file. + +2013-07-22 Torbjorn Granlund + + * mpn/powerpc64/mode64/mod_1_1.asm: Handle little-endian mode. + * mpn/powerpc64/mode64/mod_1_4.asm: Likewise. + +2013-07-16 Torbjorn Granlund + + * doc/gmp.texi: Declare countless of function arguments as 'const'. + +2013-07-15 Torbjorn Granlund + + * mpn/x86_64/core2/aors_n.asm: Rewrite. + + * mpn/generic/sb_div_sec.c: Compute inverse as floor(B^2/(dh+1)), per + Niels' suggestion. + * mpn/generic/sbpi1_div_sec.c: Remove inverse rounding-up code. + +2013-07-14 Torbjorn Granlund + + * mpn/powerpc64/mode64/divrem_1.asm: Remove explicit nop after CALL. + * mpn/powerpc64/mode64/divrem_2.asm: Likewise. + * mpn/powerpc64/mode64/mod_1_1.asm: Likewise. + * mpn/powerpc64/mode64/mod_1_4.asm: Likewise. + +2013-07-13 Torbjorn Granlund + + * mpn/x86/atom/cnd_add_n.asm: New file. + * mpn/x86/atom/cnd_sub_n.asm: New file.o + +2013-07-12 Torbjorn Granlund + + * mpn/generic/sbpi1_div_sec.c: Partial rewrite. + +2013-07-11 Torbjorn Granlund + + * mpn/x86_64/cnd_aors_n.asm: Tweak for better speed on K8, bobcat, bd1, + NHM, Atom. + +2013-07-05 Torbjorn Granlund + + * mpn/powerpc64/p7/copyi.asm: Handle n = 0. + * mpn/powerpc64/p7/copyd.asm: Likewise. + +2013-07-04 Torbjorn Granlund + + * mpn/powerpc64/mode64/p7/aormul_2.asm: New file. + + * mpn/powerpc64/darwin.m4 (EXTRA_REGISTER): New define. + * mpn/powerpc64/aix.m4: New define (actually undefine). + * mpn/powerpc64/elf.m4: Likewise. + +2013-07-03 Torbjorn Granlund + + * mpn/powerpc64/com.asm: Rewrite. + + * mpn/powerpc64/p7/copyi.asm: New file. + * mpn/powerpc64/p7/copyd.asm: New file. + +2013-07-02 Torbjorn Granlund + + * mpn/powerpc64/mode64/gcd_1.asm: New file. + * mpn/powerpc64/mode64/p7/gcd_1.asm: New file. + +2013-07-01 Torbjorn Granlund + + * configure.ac: Comment out AC_PROG_F77. + + * mpn/powerpc64/mode64/rsh1add_n.asm: Remove. + * mpn/powerpc64/mode64/rsh1sub_n.asm: Remove. + * mpn/powerpc64/mode64/rsh1aors_n.asm: New file, code not based on + removed files. + +2013-06-28 Marc Glisse + + * cxx/ismpf.cc: Use GMP_DECIMAL_POINT. + * cxx/osmpf.cc: Likewise. + * tests/cxx/t-locale.cc: Likewise. + +2013-06-28 Torbjorn Granlund + + * mpn/powerpc64/mode64/p7/aorsorrlshC_n.asm: New file. + * mpn/powerpc64/mode64/p7/aorsorrlsh1_n.asm: New file. + * mpn/powerpc64/mode64/p7/aorsorrlsh2_n.asm: New file. + + * mpn/powerpc64/mode64/aorsorrlshC_n.asm: Use alias regname. + +2013-06-27 Torbjorn Granlund + + * mpn/powerpc64/mode64/p7/aors_n.asm: New file. + +2013-06-22 Torbjorn Granlund + + * aorslshC_n.asm, aorslsh2_n.asm, aorslsh1_n.asm: Remove. + * aorsorrlshC_n.asm, aorsorrlsh1_n.asm, aorsorrlsh2_n.asm: New files. + +2013-06-19 Torbjorn Granlund + + * mpn/powerpc64/p6/lshift.asm: Rewrite switching-into-loop code. + * mpn/powerpc64/p6/rshift.asm: Likewise. + * mpn/powerpc64/p6/lshiftc.asm: Likewise. + +2013-06-17 Torbjorn Granlund + + * mpn/powerpc64/p6/lshift.asm: Fix typo in label reference. + For 32-bit mode, zero extend `n' argument and split retval. + * mpn/powerpc64/p6/rshift.asm: Likewise. + * mpn/powerpc64/p6/lshiftc.asm: Likewise. + +2013-06-10 Torbjorn Granlund + + * mpn/generic/mu_div_q.c: Remove obsolete comment. + +2013-06-09 Marc Glisse + + * mpn/generic/get_d.c (mpn_get_d): Avoid signed overflow. + * mpz/kronzs.c (mpz_kronecker_si): Use ABS_CAST. + +2013-05-31 Torbjorn Granlund + + * mpn/generic/mu_div_q.c: Call mpn_mu_divappr_q for entire division, + never just for tail. (This fixes performance issues at the expense of + memory needs.) + +2013-05-26 Torbjorn Granlund + + * configure.ac (*sparc*-*-*): Major overhaul. + +2013-05-22 Torbjorn Granlund + + * doc/gmp.texi (Reporting Bugs): Ask for configure's output. + + * mpn/ia64/divrem_2.asm: Don't clobber f16-f18. + +2013-05-20 Torbjorn Granlund + + * mpn/arm/udiv.asm: Change spacing to work around binutils bug. + +2013-05-16 Torbjorn Granlund + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*): Bump version info. + + * tests/misc.c (tests_hardware_getround, tests_hardware_setround): + Avoid assembly dependency unless WANT_ASSEMBLY. + + * configure.ac (WANT_ASSEMBLY): Conditionally define. + +2013-05-14 Torbjorn Granlund + + * configure.ac (arm1156): Don't fall back to plain v6 compiler option. + +2013-05-11 Torbjorn Granlund + + * mpn/x86_64/coreisbr/mul_1.asm: Handle n = 1 for DOS64. Streamline. + * mpn/x86_64/coreisbr/aorsmul_1.asm: Streamline. + +2013-05-10 Torbjorn Granlund + + * mpn/x86_64/coreisbr/aorsmul_1.asm: Fix, then enable DOS64 support. + * mpn/x86_64/coreisbr/mul_1.asm: Enable DOS64 support. + + * mpn/x86/p6/mmx/gmp-mparam.h: Set down SQR_TOOM2_THRESHOLD to parent + directory value. + +2013-05-09 Torbjorn Granlund + + * configure.ac (--enable-fake-cpuid): New option. + * mpn/x86_64/fat/fat.c (WANT_FAKE_CPUID): Remove defaulting. + * mpn/x86/fat/fat.c (WANT_FAKE_CPUID): Likewise. + + * mpn/x86_64/bd1/mul_1.asm: Fix typo. + +2013-05-07 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c (fake_cpuid): Handle 0x80000001 request. + (fake_cpuid_available): Remove unused function. + + * mpn/generic/mod_1_1.c: Cast constant udiv_rnnd_preinv arguments. + * mpn/generic/mod_1_2.c: Likewise. + * mpn/generic/mod_1_3.c: Likewise. + * mpn/generic/mod_1_4.c: Likewise. + * mpn/generic/divrem_2.c: Likewise. + +2013-05-06 Torbjorn Granlund + + * config.guess (power*): Handle all ppc970 variants. + +2013-05-03 David S. Miller + + * tune/common.c (speed_mpn_addlsh1_n, speed_mpn_sublsh1_n, + speed_mpn_rsblsh1_n, speed_mpn_addlsh2_n, speed_mpn_sublsh2_n, + speed_mpn_rsblsh2_n): Don't define if these routines are macros. + * tune/speed.c (routine): Likewise don't table if they are macros. + + * mpn/sparc64/ultrasparct3/addmul_1.asm: Add T4 and T3 timings. + * mpn/sparc64/ultrasparct3/aormul_4.asm: Likewise. + * mpn/sparc64/ultrasparct3/aorslsh_n.asm: Likewise. + * mpn/sparc64/ultrasparct3/cnd_aors_n.asm: Likewise. + * mpn/sparc64/ultrasparct3/submul_1.asm: Likewise. + +2013-05-03 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/aorslsh_n.asm: Invoke INITCY where it has + effect. + + * gmp-impl.h: Amend last change. + * tests/devel/try.c (choice_array): Don't try to table addlsh1_n etc if + a macro. + +2013-05-02 Torbjorn Granlund + + * mpn/arm/copyd.asm: Suppress dead pointer update. + * mpn/arm/copyi.asm: Likewise. + * mpn/arm/neon/logops_n.asm: Likewise. + * mpn/arm/neon/tabselect.asm: Likewise. + * mpn/arm/rshift.asm: Likewise. + * mpn/arm/tabselect.asm: Likewise. + * mpn/arm/v6/dive_1.asm: Likewise + * mpn/arm/v7a/cora15/neon/copyi.asm: Likewise. + + * mpn/arm/v7a/cora15/neon/com.asm: New file. + +2013-05-01 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/aormul_4.asm: New file. + + * configure.ac (GMP_MULFUNC_CHOICES): Support mul_3 + addmul_3 and + mul_4 + addmul_4. + + * mpn/sparc64/ultrasparct3/aormul_2.asm: Optimise lead-in code. + + * mpn/sparc64/ultrasparct3/missing.m4 (addxccc): Allow g2 as input. + (umulxhi): Save and restore o7 to allow it as in/out parameter. + +2013-04-29 Torbjorn Granlund + + * mpn/arm/v7a/cora15/cnd_aors_n.asm: New file, was mis-named. + + * mpn/sparc64/ultrasparct3/addmul_1.asm: Rewrite. + + * mpn/sparc64/ultrasparct3/submul_1.asm: Rewrite. + + * mpn/sparc64/ultrasparct3/cnd_aors_n.asm: New file. + + * gmp-impl.h: Override mpn_addlsh1_n, mpn_addlsh2_n, mpn_sublsh1_n, etc + with mpn_addlsh_n, etc when !HAVE_NATIVE the former but HAVE_NATIVE the + latter. + + * mpn/sparc64/ultrasparct3/aorslsh_n.asm: New file. + + * configure.ac (sparc-*-*): Recognise t5 along with t3 and t4. + Remove sparc64/ultrasparct1 from path_64 for T3, T3, and T5. + +2013-04-27 Mike Frysinger + + * configure.ac (arm*-*-*): Set up path also for plainest CPU variants. + +2013-04-27 Torbjorn Granlund + + * mpn/arm/v6/popham.asm: New file. + + * mpn/arm/v7a/cora15/cnd-aors_n.asm: New file. + +2013-04-25 Torbjorn Granlund + + * mpn/arm/mod_34lsub1.asm: Clear carry smarter. + + * mpn/arm/v7a/cora15/logops_n.asm: Conditionally suppress conditionally + used code. + + * mpn/arm/v7a/cora15/submul_1.asm: New file. + +2013-04-24 Torbjorn Granlund + + * mpn/arm/v7a/cora15/com.asm: New file. + + * mpn/arm/v7a/cora15/logops_n.asm: New file. + +2013-04-19 Torbjorn Granlund + + * mpn/arm/v7a/cora15/aors_n.asm: New file. + + * mpn/arm/v7a/cora15/addmul_1.asm: Rewrite. + +2013-04-18 Torbjorn Granlund + + * mpn/alpha/tabselect.asm: New file. + +2013-04-17 Torbjorn Granlund + + * mpn/powerpc32/tabselect.asm: New file. + + * longlong.h (arm64 count_trailing_zeros): New. + + * mpn/arm64/invert_limb.asm: New file. + + * mpn/generic/dive_1.c: Rewrite to use Hensel division also for + size = 1. + + * mpn/generic/mod_1_1.c (add_mssaaaa): Provide VIS3 variant. + + * configure.ac: Remove "missing" from extra_functions_64 for coreibwl. + + * mpn/sparc64/ultrasparct3/mul_1.asm: Decrease loop alignment. + * mpn/sparc64/ultrasparct3/aormul_2.asm: Likewise. + +2013-04-16 Torbjorn Granlund + + * mpn/alpha/invert_limb.asm: Generate table. + * mpn/powerpc64/mode64/invert_limb.asm: Likewise. + * mpn/s390_64/invert_limb.asm: Likewise. + * mpn/sparc64/ultrasparct3/invert_limb.asm: Likewise. + * mpn/x86_64/invert_limb_table.asm: Likewise. + +2013-04-15 David S. Miller + + * mpn/sparc32/sparc-defs.m4 (LEA64): New macro. + * mpn/sparc64/gcd_1.asm: Use it. + * mpn/sparc64/ultrasparct3/dive_1.asm: Likewise. + * mpn/sparc64/ultrasparct3/invert_limb.asm: Likewise. + * mpn/sparc64/ultrasparct3/mode1o.asm: Likewise. + + * mpn/sparc64/gcd_1.asm: Use RODATA, TYPE, and SIZE. + +2013-04-15 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/invert_limb.asm: Avoid addend for GOT entry, + it is not portable. + + * mpn/sparc64/tabselect.asm: New file. + + * mpn/x86/mmx/tabselect.asm: New file. + * configure.ac (x86): Add x86/mmx to path for relevant CPUs. + + * mpn/sparc64/gcd_1.asm: Use rdpc for PIC. + * mpn/sparc64/ultrasparct3/mode1o.asm: Use rdpc for PIC. + * mpn/sparc64/ultrasparct3/dive_1.asm: Use rdpc for PIC. + * mpn/sparc64/ultrasparct3/invert_limb.asm: Handle PIC, use rdpc. + + * Revert remaining parts of recent sparc LEA changes. + +2013-04-14 David S. Miller + + * mpn/sparc32/v9/sqr_diagonal.asm: Revert LEA and INT32 changes. + * mpn/sparc64/gcd_1.asm: Likewise. + +2013-04-13 Torbjorn Granlund + + * mpn/x86_64/bd1/tabselect.asm: New file. + * mpn/x86_64/coreisbr/tabselect.asm: New file. + * mpn/x86_64/k10/tabselect.asm: New file. + * mpn/x86_64/coreinhm/tabselect.asm: New file. + * mpn/x86_64/core2/tabselect.asm: New file. + * mpn/x86_64/pentium4/tabselect.asm: New file. + + * mpn/x86_64/fastsse/tabselect.asm: New file. + * mpn/arm/neon/tabselect.asm: Rewrite. + * mpn/arm/tabselect.asm: Rewrite. + * mpn/powerpc64/tabselect.asm: Rewrite. + * mpn/x86_64/tabselect.asm: Rewrite. + + * tune/speed.h (SPEED_ROUTINE_MPN_TABSELECT): Implement special code, + making .r argument be table width. + +2013-04-11 David S. Miller + + * mpn/sparc32/sparc-defs.m4 (LEA): Remove unused local label. + (LEA_LEAF): Likewise. + +2013-04-11 Niels Möller + + * mpn/arm/v6/submul_1.asm: New file, using the corresponding + addmul_1 loop + complement trick. + +2013-04-10 David S. Miller + + * acinclude.m4 (GMP_ASM_SPARC_GOTDATA, + GMP_ASM_SPARC_SHARED_THUNKS): New feature tests. + * configure.ac: Call GMP_ASM_SPARC_GOTDATA and + GMP_ASM_SPARC_SHARED_THUNKS on sparc. + * mpn/sparc32/sparc-defs.m4 (LEA, LEA_LEAF, LEA_THUNK): New macros. + * mpn/sparc32/udiv.asm: Convert over to LEA, LEA_LEAF, and LEA_THUNK. + * mpn/sparc32/v8/addmul_1.asm: Likewise. + * mpn/sparc32/v8/mul_1.asm: Likewise. + * mpn/sparc32/v8/supersparc/udiv.asm: Likewise. + * mpn/sparc32/v8/udiv.asm: Likewise. + * mpn/sparc64/gcd_1.asm: Likewise. + * mpn/sparc64/ultrasparct3/dive_1.asm: Likewise. + * mpn/sparc64/ultrasparct3/invert_limb.asm: Likewise. + * mpn/sparc64/ultrasparct3/mode1o.asm: Likewise. + * mpn/sparc32/v9/sqr_diagonal.asm: Likewise and use INT32. + +2013-04-09 Torbjorn Granlund + + * longlong.h (sparc64): Test __VIS__ instead of __sparc_vis3. + + * config.guess (sparc*): Invoke set_cc_for_build to get $dummy. + +2013-04-08 Torbjorn Granlund + + * config.guess: Rework tmp file names, make sure to remove tmp files. + + * mpn/arm/dive_1.asm: Rewrite count-trailing-zeros code, using private + table. + + * mpn/arm: Canonicalise arm assembly to use old style "mov ... lsl" for + shift ops. + +2013-04-07 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/mod_34lsub1.asm: New file. + + * longlong.h (sparc64): Define umul_ppmm, add_ssaaaa, and + count_leading_zeros conditionally under the symbol __sparc_vis3. + + * mpn/arm/dive_1.asm: New file. + * mpn/arm/v6/dive_1.asm: New file. + + * mpn/arm/v6t2/mode1o.asm: Make trivial change to avoid v6t2... + * mpn/arm/v6/mode1o.asm: ...instruction, move file accordingly. + + * mpn/powerpc64/mode64/invert_limb.asm: Put all multiplies low-limb first. + +2013-04-04 David S. Miller + + * mpn/sparc64/ultrasparct3/add_n.asm: Rewrite. + * mpn/sparc64/ultrasparct3/sub_n.asm: Rewrite. + + * mpn/sparc64/ultrasparct3/invert_limb.asm: Align table. + +2013-04-04 Torbjorn Granlund + + * mpn/sparc32/sparc-defs.m4: Provide dummy lzcnt. + + * tests/mpn/logic.c: Seed using RANDS, then use mpz_rrandomb. + + * tests/mpn/t-div.c (random_word): Remove. Let callers invoke urandom. + + * mpn/sparc64/ultrasparct3/mul_1.asm: Rewrite. + + * mpn/sparc64/ultrasparct3/bdiv_dbm1c.asm: New file. + * mpn/sparc64/ultrasparct3/dive_1.asm: New file. + * mpn/sparc64/ultrasparct3/invert_limb.asm: New file. + * mpn/sparc64/ultrasparct3/mod_1_4.asm: New file. + * mpn/sparc64/ultrasparct3/mode1o.asm: New file. + +2013-04-03 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/aormul_2.asm: Reschedule for better speed. + +2013-04-02 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/missing.m4: Misc tweaks. + (lzcnt): New. + * mpn/sparc64/ultrasparct3/missing.asm (__gmpn_lzcnt): New function. + + * mpn/sparc32/sparc-defs.m4: Put FAKE_T3 stuff here... + * mpn/sparc64/ultrasparct3/aormul_2.asm: ...moved from here. + + * mpn/sparc64/ultrasparc1234/lshift.asm: Remove. + * mpn/sparc64/ultrasparc1234/rshift.asm: Remove. + +2013-04-01 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/missing.m4 (umulxhi): Don't clobber retaddr, + allowing use in functions that does not do save/restore. + + * mpn/sparc64/gcd_1.asm: Tweak for tighter loop. + +2013-03-31 David S. Miller + + * mpn/sparc64/lshift.asm: New file. + * mpn/sparc64/rshift.asm: New file. + * mpn/sparc64/lshiftc.asm: New file. + +2013-03-31 Torbjorn Granlund + + * mpn/sparc64/ultrasparct1/lshift.asm: Remove. + * mpn/sparc64/ultrasparct1/rshift.asm: Remove. + * mpn/sparc64/ultrasparct1/lshiftc.asm: Remove. + +2013-03-29 Torbjorn Granlund + + * mpn/sparc64/ultrasparct3/aormul_2.asm: Always do mulx before umulxhi. + +2013-03-28 Torbjorn Granlund + + * mpn/sparc64/mod_1_4.c (mpn_mod_1s_4p): Make precomputed arg 'const'. + (mpn_mod_1s_4p_cps): Update from generic code. + +2013-03-27 Torbjorn Granlund + + * mpn/generic/trialdiv.c: Make variables 'const' to match tables. + + * mpn/generic/mod_1_1.c (mpn_mod_1_1p): Make precomputed arg 'const'. + * mpn/generic/mod_1_2.c (mpn_mod_1s_2p): Likewise. + * mpn/generic/mod_1_3.c (mpn_mod_1s_3p): Likewise. + * mpn/generic/mod_1_4.c (mpn_mod_1s_4p): Likewise. + * gmp-impl.h: Update prototypes. + + * mpn/x86_64/mulx/aorsmul_1.asm: New file. + * mpn/x86_64/mulx/addmul_1.asm: Remove. + +2013-03-26 Niels Möller + + Make mpn_cnd_add_n and mpn_cnd_sub_n public. + * doc/gmp.texi (Low-level Functions): Document mpn_cnd_add_n and + mpn_cnd_sub_n. + * gmp-h.in (mpn_cnd_add_n, mpn_cnd_sub_n): Moved prototypes + here... + * gmp-impl.h: ... from here. + +2013-03-26 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/cnd_add_n.asm: New file. + * mpn/x86/pentium4/sse2/cnd_sub_n.asm: New file. + * mpn/x86/cnd_aors_n.asm: New file. + +2013-03-25 David S. Miller + + * mpn/sparc64/ultrasparct3/hamdist.asm: New file. + * mpn/sparc64/ultrasparct3/popcount.asm: New file. + +2013-03-25 Torbjorn Granlund + + * mpn/ia64/aorsorrlshC_n.asm: Generalised from aorslshC_n.asm. + * mpn/ia64/aorsorrlsh1_n.asm: Generalised from aorslsh1_n.asm. + * mpn/ia64/aorsorrlsh2_n.asm: Generalised from aorslsh2_n.asm. + +2013-03-24 Torbjorn Granlund + + * mpn/arm/v7a/cora15/neon/aorsorrlshC_n.asm: New file. + * mpn/arm/v7a/cora15/neon/aorsorrlsh2_n.asm: New file. + * mpn/arm/v7a/cora15/neon/aorsorrlsh1_n.asm: New file. + * mpn/arm/v7a/cora15/neon/rsh1aors_n.asm: New file. + + * configure.ac (GMP_MULFUNC_CHOICES): Support add+sub+rsb lsh files. + + * tests/refmpn.c (refmpn_addlsh_nc, refmpn_sublsh_nc): Remove silly + assert of mp_limb being non-negative. + +2013-03-21 Torbjorn Granlund + + * mpn/arm/neon/lshiftc.asm: New file. + + * mpn/arm/v6/sqr_basecase.asm: Trim 'sqr_diag_addlsh1' loop. + + * gen-trialdivtab.c: Output just raw data, remove actual variables. + * mpn/generic/trialdiv.c: Put variables from gen-trialdivtab.c here, + and make them 'const'. + +2013-03-20 Torbjorn Granlund + + * config.guess: Rework arm CPU recognition. + * config.sub: Corresponding updates. + * configure.ac: Likewise. + + * mpn/x86_64/mulx/adx/addmul_1.asm: Let FAKE_MULXADX be off by default. + + * mpn/arm/v7a/cora15/neon/copyi.asm: Move from "..". + * mpn/arm/v7a/cora15/neon/copyd.asm: Likewise. + + * config.guess: Tack on "neon" for appropriate arm CPUs. + * configure.ac (arm*-*-*): Recognise neon suffix for a8, a9, and a15. + +2013-03-19 Marco Bodrato + + * mpf/fits_u.h: Accept numbers truncating to zero before checking the + sign. + * tests/mpf/t-fits.c: Check new edges. + +2013-03-19 Torbjorn Granlund + + * tests/arm32check.c: Get printing of clobbered register right. + + * mpn/arm/neon/popcount.asm: New file. + * mpn/arm/neon/hamdist.asm: New file. + + * tests/Makefile.am (EXTRA_libtests_la_SOURCES): Add arm32call.asm and + arm32check.c. + +2013-03-18 Torbjorn Granlund + + * configure.ac (arm*-*-*): Define CALLING_CONVENTIONS_OBJS. + + * tests/arm32call.asm: New file. + * tests/arm32check.c: New file. + + * mpn/arm/arm-defs.m4 (LEA): Rewrite to properly handle repeated use. + (EPILOGUE_cpu): Define. + + * mpn/arm/v6/addmul_3.asm: Make code work for PIC. + + * tests/x86call.asm: Modernise asm syntax. + * tests/amd64call.asm: Likewise. + + * mpn/x86/darwin.m4 (m4append): Move definition from here... + * mpn/asm-defs.m4: ...to here. + +2013-03-18 Marco Bodrato + + * doc/gmp.texi (--enable-fat): No quote in concept index. + + * mpf/swap.c: Reduce the number of variables. + +2012-03-17 Marc Glisse + + * tests/cxx/t-do-exceptions-work-at-all-with-this-compiler.cc: New file. + * tests/cxx/Makefile.am: Add new file. Reorder the tests. + +2013-03-17 Torbjorn Granlund + + * mpn/generic/mul_fft.c: Use TMP_BALLOC*, but combine several areas. + + * mpz/powm_ui.c (mod): Use TMP_BALLOC in mu code. + + * mpn/arm/v6/addmul_3.asm: New file. + + * mpn/arm/v7a/cora15/copyd.asm: Tweak. + + * mpn/arm64/copyi.asm: New file. + * mpn/arm64/copyd.asm: New file. + +2013-03-16 Torbjorn Granlund + + * mpn/arm/v6/addmul_2.asm: Tweak for better A9 performance. + +2013-03-14 Torbjorn Granlund + + * mpn/ia64/cnd_aors_n.asm: New file. + + * mpn/arm64/cnd_aors_n.asm: New file. + + * mpn/arm64/aors_n.asm (ADDSUB): Remove unused definition. + + * mpn/ia64/aors_n.asm: Remove a redundant ASM_START. + + * mpn/arm/cnd_aors_n.asm: Avoid ARM conditional insn execution. + + * mpn/x86_64/missing.asm: Move from mulx/adx since we cannot currently + prune missing.asm from path. + * mpn/x86_64/mulx/adx/missing-call.m4: Likewise. + * mpn/x86_64/mulx/adx/missing-inline.m4: Likewise. + * mpn/x86_64/mulx/adx/addmul_1.asm: Update hardwired path. + +2013-03-13 Marco Bodrato + + * mpz/cong_2exp.c: Write loops in a cleaner way. + * mini-gmp/mini-gmp.c: Likewise. + * gmp-impl.h (mpz_zero_p): Likewise. + +2013-03-12 Niels Möller + + New names mpn_cnd_add_n and mpn_cnd_sub_n. + * mpn/generic/cnd_add_n.c (mpn_cnd_add_n): Renamed file and + function, from addcnd.c:mpn_addcnd_n. + * mpn/generic/cnd_sub_n.c (mpn_cnd_sub_n): Renamed, from + subcnd.c:mpn_subcnd_n. + * mpn/arm/cnd_aors_n.asm: Renamed file, from aorscnd.asm, and + renamed functions. + * mpn/x86_64/cnd_aors_n.asm: Analogous renaming. + * mpn/powerpc64/mode64/cnd_aors_n.asm: Analogous renaming. + * gmp-impl.h (mpn_cnd_add_n, mpn_cnd_add_n): Updated prototypes + with new names. + * configure.ac: Updated for new names. + * tests/refmpn.c (refmpn_cnd_add_n): Renamed, from refmpn_addcnd_n. + (refmpn_cnd_sub_n): Renamed, from refmpn_subcnd_n. + * tests/tests.h (refmpn_cnd_add_n, refmpn_cnd_sub_n): Updated + prototypes with new names. + * tune/common.c (speed_mpn_cnd_add_n): Renamed, from + speed_mpn_addcnd_n, call mpn_cnd_add_n. + (speed_mpn_cnd_sub_n): Renamed, from speed_mpn_subcnd_n, call + mpn_cnd_sub_n. + * tune/speed.h (speed_mpn_cnd_add_n, speed_mpn_cnd_sub_n): Updated + prototypes with new names. + * tune/speed.c (routine): Updated list with new names. + * tests/devel/try.c: Updated for new mpn_cnd_* names. + * mpn/generic/sbpi1_div_sec.c: Likewise. + * mpn/generic/powm_sec.c: Likewise. + +2013-03-12 Torbjorn Granlund + + * configure.ac: Add "missing" to extra_functions_64 for coreibwl. + + * mpn/x86_64/mulx/adx/addmul_1.asm: Simplify. Make FAKE_MULXADX the + default awaiting proper qemu behaviour. + +2013-03-11 Torbjorn Granlund + + * mpn/x86_64/aorscnd_n.asm: Read 32 bits for 'n' arguments on DOS64. + + * tests/mpz/t-powm_ui.c: Test larger arguments. General cleanup. + + * mpz/powm_ui.c (mod): Adhere to mpn_mu_div_qr's overlap requirements. + +2013-03-10 Niels Möller + + * mpn/generic/sbpi1_div_sec.c: Update calls of mpn_addcnd_n and + mpn_subcnd_n. + * mpn/generic/powm_sec.c (MPN_REDC_1_SEC, MPN_REDC_2_SEC) + (mpn_powm_sec): Update calls of mpn_subcnd_n. + + * tests/tests.h (refmpn_addcnd_n, refmpn_subcnd_n): Update + declarations. + * tests/refmpn.c (refmpn_addcnd_n, refmpn_subcnd_n): Similar + reorder of arguments. + * tests/devel/try.c (call): Pass condition first, for + TYPE_ADDCND_N and TYPE_SUBCND_N. + + * tune/common.c (speed_mpn_addcnd_n, speed_mpn_subcnd_n): Update + to pass condition as first argument. + + * gmp-impl.h (mpn_addcnd_n, mpn_subcnd_n): Updated declarations. + + * mpn/generic/addcnd_n.c (mpn_addcnd_n): Reordered arguments, make + condition the first argument. + * mpn/generic/subcnd_n.c (mpn_subcnd_n): Likewise. + * mpn/arm/aorscnd_n.asm: Likewise. + * mpn/x86_64/aorscnd_n.asm: Likewise. + * mpn/powerpc64/mode64/aorscnd_n.asm: Likewise. + +2013-03-10 Torbjorn Granlund + + * mpn/x86_64/mulx/adx/missing.asm: Simulate some mulx/adx insns. + * mpn/x86_64/mulx/adx/missing-call.m4: Call variant. + * mpn/x86_64/mulx/adx/missing-inline.m4: Inline variant. + + * mpn/sparc64/ultrasparct3/missing.asm: Simulate some v9-2011 insns. + * mpn/sparc64/ultrasparct3/missing.m4: Inline or invoke missing.asm for + v9-2011 insn. + + * configure.ac: Strip `haswell' from paths for now. + + * mpn/x86_64/mulx/addmul_1.asm: New. + * mpn/x86_64/mulx/mul_1.asm: Rewrite file from `haswell' subdir. + * mpn/x86_64/mulx/adx/addmul_1.asm: Likewise. + * mpn/x86_64/haswell: Remove. + + * mpn/arm/v7a/cora15/mul_1.asm: New file. + * mpn/arm/v7a/cora15/addmul_1.asm: New file. + +2013-03-09 Marco Bodrato + + * tests/mpz/t-cong_2exp.c: Improve coverage. + +2013-03-09 Torbjorn Granlund + + * mpn/sparc64/ultrasparc1234/add_n.asm: Use g5 instead of g4. + * mpn/sparc64/ultrasparc1234/sub_n.asm: Likewise. + + * mpn/sparc64/ultrasparct3/aormul_2.asm: Fix a typo. + +2013-03-07 Torbjorn Granlund + + * mpn/arm/v7a/cora9/gmp-mparam.h: New file. + + * configure.ac (GMP_MULFUNC_CHOICES): Support mul_2 + addmul_2. + + * mpn/sparc64/ultrasparct3/aormul_2.asm: New file. + + * mpn/sparc64/ultrasparct3/submul_1.asm: Optimise out two carry + propagating adds. + +2013-03-06 David Miller + + * config.guess: Recognize UltraSparc T4 under Linux. + * configure.ac: Add sparc64/ultrasparct3 to path_64 when T3 or T4. + Append -xarch=v8plusd or -xarch=v9d to command line, as needed. + * mpn/sparc64/ultrasparct3/mul_1.asm: New file. + * mpn/sparc64/ultrasparct3/addmul_1.asm: New file. + * mpn/sparc64/ultrasparct3/submul_1.asm: New file. + * mpn/sparc64/ultrasparct3/add_n.asm: New file. + * mpn/sparc64/ultrasparct3/sub_n.asm: New file. + + * mpn/sparc32/ultrasparct1/mul_1.asm: Unroll main loop one time, add + T2/T3/T4 timings. + * mpn/sparc32/ultrasparct1/addmul_1.asm: Likewise. + * mpn/sparc32/ultrasparct1/submul_1.asm: Likewise. + +2013-03-04 Torbjorn Granlund + + * mpn/arm/neon/lorrshift.asm: New file. + +2013-03-03 Torbjorn Granlund + + * mpn/arm/v7a/cora15/copyd.asm: New file. + * mpn/arm/v7a/cora15/copyi.asm: New file. + + * mpn/arm64/logops_n.asm: New file. + * mpn/arm64/gcd_1.asm: New file. + * mpn/arm64/aorsmul_1.asm: New file. + * mpn/arm64/addmul_1.asm: Remove. + * mpn/arm64/aors_n.asm: Complete rewrite. + + * mpn/arm/tabselect.asm: New file. + * mpn/arm/neon/tabselect.asm: New file. + + * mpn/arm/copyi.asm: Software pipeline. + * mpn/arm/copyd.asm: Likewise. + + * config.guess: Rework tmp file handling to resemble configfsf.guess's. + +2013-03-03 Niels Möller + + * doc/gmp.texi (Integer Special Functions): Document + mpz_limbs_read, mpz_limbs_write, mpz_limbs_modify, + mpz_limbs_finish, mpz_roinit_n and MPZ_ROINIT_N. + + * mpz/roinit_n.c (mpz_roinit_n): Normalize the input. + +2013-02-27 Niels Möller + + * tune/common.c (speed_measure): Increase repetition count if we + get a zero measurement. + +2013-02-27 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpz_div_q_2exp): Adjust only if needed. + (mpn_common_scan): New service function to unify scan loops. + (mpz_scan0, mpz_scan1): Simplify by using mpn_common_scan. + (mpz_make_odd): Simplify, assume in-place operation on positive. + (mpn_scan0, mpn_scan1): New functions. + * mini-gmp/mini-gmp.h (mpn_scan0, mpn_scan1): New declarations. + * mini-gmp/tests/t-scan.c: Test also mpn_scan0 and mpn_scan1. + +2013-02-26 Niels Möller + + * tests/mpz/t-limbs.c (check_roinit): Test MPZ_ROINIT_N only if + compiler supports c99. + +2013-02-25 Niels Möller + + * mini-gmp/tests/t-double.c (testmain): Declare double variables + as volatile, to drop extended precision. + + * mini-gmp/tests/testutils.c (testfree): New function. Use it + everywhere where test programs deallocate storage allocated via + the mini-gmp allocation functions, including uses of mpz_get_str + for various test failure messages. + + * mpz/limbs_finish.c (mpz_limbs_finish): New file and function. + * mpz/limbs_modify.c (mpz_limbs_modify): New file and function. + * mpz/limbs_read.c (mpz_limbs_read): New file and function. + * mpz/limbs_write.c (mpz_limbs_write): New file and function. + * mpz/roinit_n.c (mpz_roinit_n): New file and function. + * gmp-h.in: Declare new functions. + (MPZ_ROINIT_N): New macro. + * mpz/Makefile.am (libmpz_la_SOURCES): Added new files. + * Makefile.am (MPZ_OBJECTS): Added new object files. + + * tests/mpz/t-limbs.c: New testcase. + * tests/mpz/Makefile.am (check_PROGRAMS): Added t-limbs. + +2013-02-22 Torbjorn Granlund + + * configure.ac: Fix typo in adx/mulx path stripping code. + * config.sub: Match coreibwl. + +2013-02-20 Niels Möller + + * tests/mpq/t-get_d.c (check_random): Rewrote to make test less + dependent on float operations. Fixes problem with m68k-linux and + extended float precision. + +2013-02-20 Torbjorn Granlund + + * mpn/x86_64/haswell/mulx/adx/addmul_1.asm: New file. + + * configure.ac: Support coreibwl. Use proper name for ADX extension. + * acinclude.m4 (GMP_ASM_X86_ADX): Rename from GMP_ASM_X86_ADOX. + + * tests/tests.h (TESTS_REPS): Keep count >= 1. + +2013-02-19 Marco Bodrato + + * mini-gmp/mini-gmp.c: Move asserts to work-around a compiler bug. + (mpz_export): Reorder branches. + (mpz_mul_ui): Avoid temporary allocation (mpn_mul_1 can work in-place). + + * mini-gmp/tests/t-reuse.c: Fix typo causing the same negation + condition to be applied to all operands. (See 2013-02-03, Torbjorn) + +2013-02-17 Marco Bodrato + + * gmpxx.h (mpq_class, mpf_class) [init_ui, init_si, assign_si]: + Optimise _si using _ui for positive arguments. + (__gmp_hypot_function): Use _mul_ui to square an ui, abs for si. + + * mini-gmp/mini-gmp.c (mpz_mul): Read sizes just once. + (mpn_set_str_other): Remove a redundant variable. + (mpz_abs_add): Use SWAP once, to order sizes. + (mpz_mul_ui): Micro-optimisation. + (mpz_rootrem): Use _init2 before _setbit. + (mpz_set_str): Optimise-out a variable. + (mpz_import): Normalise only if needed. + (mpn_div_qr_1): Speed-up the d=1 case, delaying a branch. + + * rand/randmts.c: Use init2, as size of variables is known in advance. + (mangle_seed): Get a single argument. + + * mpz/remove.c: Delay allocation in the generic case; use swap + instead of set. + * mpn/generic/remove.c: Delay (possibly smaller) allocation. + +2013-02-17 Marc Glisse + + * cxx/osdoprnti.cc: Use and rather than + and (revert 2002-12-21). + + * tests/cxx/Makefile.am: Link with libm. + * tests/cxx/t-ops2.cc: Comment about more tests. Use rather + than and using namespace. Don't include . + + * gmpxx.h (__GMPXX_BITS_TO_LIMBS, __GMPQ_NUM_DBL_LIMBS, + __GMPQ_DEN_DBL_LIMBS, __GMPXX_TMPQ_D): New macros. + (__gmp_binary_plus, __gmp_binary_minus, __gmp_binary_multiplies, + __gmp_binary_divides, __gmp_binary_equal, __gmp_binary_less, + __gmp_cmp_function): Use __GMPXX_TMPQ_D. + * tests/cxx/t-ops2.cc: Test __GMPXX_TMPQ_D on DBL_MIN, DBL_MAX. + + * gmpxx.h (__gmp_binary_multiplies, __gmp_binary_divides): Use + __GMPXX_CONSTANT_TRUE. + +2013-02-16 Marc Glisse + + * gmpxx.h: Include . + +2013-02-16 Torbjorn Granlund + + * mpn/Makefile.am (TARG_DIST): Add arm64. + + * mpn/x86_64/x86_64-defs.m4 (PROTECT): Emit '.hidden' instead of + '.protected" to please Sun's assembler, but also for semantic reasons. + +2013-02-15 Torbjorn Granlund + + * configure.ac (arm64*-*-*): Match this. + + * mpn/arm64/aors_n.asm: New file. + * mpn/arm64/addmul_1.asm: New file. + * mpn/arm64/mul_1.asm: New file. + +2013-02-15 Marc Glisse + + * gmpxx.h (__GMPXX_DEFINE_ARITHMETIC_CONSTRUCTORS, + __GMPXX_DEFINE_ARITHMETIC_ASSIGNMENTS): New macros. + (mpz_class, mpq_class, mpf_class) [init_ui, init_si, init_d, + assign_ui, assign_si, assign_d]: New functions. + (__gmp_expr::__gmp_expr, __gmp_expr::operator=): Replace with macros. + (__GMPXX_CONSTANT_TRUE): New macro. + +2013-02-15 Marco Bodrato + + * gmp-impl.h (NEG_CAST, ABS_CAST): Use __GMP_CAST. + * mpz/fits_s.h: Use NEG_CAST. + +2013-02-14 Marc Glisse + + * gmpxx.h (__gmp_binary_greater): Forward to __gmp_binary_less. + (__gmp_binary_equal): Forward to itself after swapping operands. + +2013-02-14 Marco Bodrato + + * mp_dv_tab.c (__gmp_digit_value_tab): Remove a line of unused values. + * mpf/set_str.c: Update offset accordingly. + * mpz/inp_str.c: Likewise. + * mpz/set_str.c: Likewise. + + * gmp-h.in (mpq_cmp_ui): Optimise comparison with 1/1. + * tests/mpq/t-cmp_ui.c: Test special comparisons: 0/1, 1/1. + + * mpz/clrbit.c: Reorganise branches. + * mpz/setbit.c: Likewise. + * mpz/combit.c: Same micro-optimisations as in set/clr. + + * mpz/aors_ui.h: No realloc if size was zero. + * mpz/ior.c: Use macros: MPZ_REALLOC and MPN_INCR_U. + + * gmp-impl.h (NEG_CAST): New macro, used by ABS_CAST. + * mpq/cmp_si.c: Use NEG_CAST. + * mpz/cmp_si.c: Reorganise branches. + +2013-02-13 Torbjorn Granlund + + * acinclude.m4 (GMP_ASM_X86_MULX, GMP_ASM_X86_ADOX): New feature tests. + * configure.ac: Use new feature tests. + + * mpn/x86_64/haswell/mulx/mul_1.asm: File moved to cope with older + assemblers. + * configure.ac: Update haswell path to include "mulx". + +2013-02-12 Torbjorn Granlund + + * configure.ac: Recognise haswell. + * config.guess: Recognise haswell. + * config.sub: Match haswell. + + * mpn/x86_64/haswell/mul_1.asm: New file, mainly for testing HNI. + +2013-02-12 Marco Bodrato + + * gmp-impl.h (MPZ_PROVOKE_REALLOC): Remove unused macro. + * gen-fac.c (gen_consts): Remove obsolete code, use swap instead of set. + * mini-gmp/mini-gmp.c (fac_ui, bin_uiui): Use shorter and faster code. + + * mpn/generic/mulmod_bnm1.c: Reorganise branches. + * mini-gmp/mini-gmp.c: Reduce branches. + + * mpz/bin_ui.c: Avoid a copy when n < 0. + * mpz/mfac_uiui.c: Reduce memory usage. + * mpz/primorial_ui.c: Use MPZ_NEWALLOC. + + * mpz/import.c: Use BITS_TO_LIMBS and MPZ_NEWALLOC. + * mpz/inp_raw.c: Likewise. + * mpz/rrandomb.c: Likewise. + * mpz/urandomb.c: Likewise. + * mpn/generic/random2.c: Likewise. + + * mpn/generic/brootinv.c: Micro-optimisation. + + * mpf/set_str.c: Don't chech base==0 when base is strictly positive. + +2013-02-10 Torbjorn Granlund + + * Version 5.1.1 released. + +2013-02-07 Marco Bodrato + + * tune/speed.h (SPEED_ROUTINE_MPN_MUL): Use operands from struct s. + * tune/README: Document new parameter syntax mpn_mul.<#> . + +2013-02-06 Niels Möller + + * tests/mpz/t-jac.c (check_large_quotients): Rewrote. Now uses a + more efficient method for generating the test inputs. + +2013-02-05 Torbjorn Granlund + + * tests/mpn/t-div.c: Limit random dbits to avoid an infinite loop. + +2013-02-03 Torbjorn Granlund + + * tests/mpz/reuse.c: Fix typo causing the same negation condition to be + applied to all operands. Fix condition for when to invoke mpz_remove. + Make different-size random operands. + +2013-02-02 Marco Bodrato + + * mpz/remove.c: Correct the sign in case of reuse. + +2013-02-01 Torbjorn Granlund + + * gmp-impl.h (DIGITS_IN_BASE_PER_LIMB): Add a cast. + (LIMBS_PER_DIGIT_IN_BASE): Likewise. + + * tests/refmpn.c (refmpn_mul): Use toom6h instead of toom44 for the + largest operands. + +2013-01-31 Torbjorn Granlund + + * mpn/generic/toom44_mul.c: Revert last change in favour of a simple + change (thanks Marco!). + * mpn/generic/toom4_sqr.c: Likewise. + +2013-01-30 Torbjorn Granlund + + * mpn/generic/toom44_mul.c (MAYBE_mul_toom44): Take toom6h and toom8h + into account, using new macro MUL_NEXTALG_THRESHOLD. + * mpn/generic/toom4_sqr.c (MAYBE_sqr_toom4): Likewise. + +2013-01-26 Marco Bodrato + + * mpz/remove.c: init+set=init_set, cast before shifting. + + * mpz/cmp_si.c: Use ABS_CAST. + +2013-01-26 Torbjorn Granlund + + * tests/mpn/logic.c: Set things up to always test library logops, not + gmp-impl.h's inlined variants. Test also mpn_com. + + * tests/mpn/t-mod_1.c: Test also mpn_mod_1s_3p. + + * mpn/generic/mod_1_3.c: Swap some lines to make it similar to mod_4.c. + + * tests/mpz/reuse.c: Fix typo in last change. + +2013-01-23 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpz_cmpabs_d, mpz_cmp_d): Simplify. + (mpz_set_str): Behaviour more adherent to the real GMP. + + * mini-gmp/tests/t-str.c: Cast size_t to unsigned long, for printf. + * mini-gmp/tests/t-import.c: Likewise. + * mini-gmp/tests/t-comb.c: Remove an unused var. + * mini-gmp/tests/t-div.c: Remove unused args passed to fprintf. + * mini-gmp/tests/t-double.c: Use float immediates with float vars. + +2013-01-22 Torbjorn Granlund + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*): Bump version info. + * gmp-h.in: Bump version. + + * tests/mpz/reuse.c: Delete always zero 'failures' and code depending + on it. Replace rotating progress with real measure. + + * Makefile.am (check-mini-gmp): Fix typo in last change. + +2013-01-22 Niels Möller + + * mini-gmp/mini-gmp.c (mpz_cmp_d): Simplified, just sort out + signs, then call mpz_cmpabs_d. + + * mini-gmp/tests/testutils.h: Include stdio.h and stdlib.h. + (numberof): New define. + + * mini-gmp/tests/t-cmp_d.c: New file, copied from + tests/mpz/t-cmp_d.c with minor changes. + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): Added t-cmp_d, + + * mini-gmp/mini-gmp.c (mpz_cmpabs_d): New function. + * mini-gmp/mini-gmp.h: Declare it. + +2013-01-21 Niels Möller + + * mini-gmp/tests/t-str.c (testmain): Test mpz_out_str, using + the tmpfile function for i/o. + +2013-01-20 Torbjorn Granlund + + * Makefile.am (check-mini-gmp): Set also DYLD_LIBRARY_PATH for the + benefit of Darwin. + + * tests/mpn/t-div.c: Test mpn_sb_div_qr_sec and mpn_sb_div_r_sec. + (main): Separate divisor into normalised (dnp) and unnormalised (dup), + pass appropriate variant to each function. + (main): Make negative `test' index value mean divisor bits, for better + small operands coverage. + (main): Put random junk at qp[] instead of zeroing. + + * tests/mpz/t-remove.c: Back out last change which left `divisor_size' + uninitialised; achieve change's aim with a parameter tweak. + +2013-01-20 Marco Bodrato + + * mini-gmp/tests/testutils.c (testhalves): New function, test default + memory functions. + * mini-gmp/tests/testutils.h (testhalves): Declare it + * mini-gmp/tests/t-logops.c: Use testhalves. + + * mini-gmp/mini-gmp.c (mpz_init_set_str): New function. + * mini-gmp/mini-gmp.h (mpz_init_set_str): Declare it. + * mini-gmp/tests/t-str.c: Test mpz_init_set_str. + +2013-01-20 Torbjorn Granlund + + * tests/memory.c (PTRLIMB): New macro, used for conformant casting. + +2013-01-19 Marco Bodrato + + * mini-gmp/tests/t-double.c (testmain): Get the current free + function using mp_get_memory_functions. + * mini-gmp/tests/t-str.c (testmain): Likewise. + + * mini-gmp/tests/testutils.h (tu_free): Remove declaration. + + * mini-gmp/tests/testutils.c (block_check, tu_free): Mark static. + + * tests/mpz/t-set_str.c: Check also failing conditions. + + * tests/mpz/t-remove.c: Test removal of 1. + +2013-01-18 Niels Möller + + * mini-gmp/tests/t-str.c (test_small): New function, exercising + parsing of whitespace and base prefixes. + (testmain): Call it. + + * mini-gmp/tests/t-gcd.c (gcdext_valid_p): Fixed memory leak. + + * mini-gmp/tests/t-double.c (testmain): Call tu_free rather than + free, for storage allocated by mpz_get_str. + * mini-gmp/tests/t-str.c (testmain): Likewise. + + * mini-gmp/tests/testutils.c (block_init, block_check): New + functions. + (tu_alloc, tu_realloc, tu_free): New functions. + (main): Use mp_set_memory_functions. + * mini-gmp/tests/testutils.h (tu_free): Declare. + + * mini-gmp/tests/testutils.h: New file, declarations for test + programs. + + * mini-gmp/tests/testutils.c (main): New file, with shared main + function for all the test programs. Also includes mini-gmp.c. + Calls testmain after initialization. All other test programs + updated to define testmain rather than main. + +2013-01-18 Marco Bodrato + + * mini-gmp/tests/t-signed.c: Slightly larger coverage. + * mini-gmp/tests/t-double.c: Test also mpz_init_set_d. + +2013-01-18 Torbjorn Granlund + + * mpn/generic/set_str.c (normalization_steps): Eliminate set-but-unused + variable. + + * mini-gmp/tests/t-div.c: Test mpz_divisible_p and mpz_divisible_ui_p. + + * tests/tests.h (TESTS_REPS): Fix printf argument type clashes. + + * mini-gmp/tests/t-div.c: Test also mpz_mod, mpz_mod_ui. Compare + mpz_divisible_p just to ceil, to save time. + + * mini-gmp/mini-gmp.c: Prefix some names with GMP_. + +2013-01-16 Marco Bodrato + + * mini-gmp/tests/t-double.c: Test mpz_cmp_d. + * mini-gmp/mini-gmp.c (mpz_cmp_d): Correct multiword comparison. + + * mini-gmp/mini-gmp.c (mpz_set_str): Handle the empty string. + * mini-gmp/tests/t-str.c: Test base <= 0. + +2013-01-15 Niels Möller + + * mini-gmp/tests/t-str.c (main): Use x->_mp_d rather than x[0]._mp_d. + * mini-gmp/tests/t-invert.c (main): Likewise. + + * mini-gmp/tests/t-mul.c (main): Test mpn_mul_n and mpn_sqr. + + * mini-gmp/tests/hex-random.h (enum hex_random_op): New value + OP_SQR. + + * mini-gmp/tests/mini-random.c (mini_random_op3): Renamed, from... + (mini_random_op): ... old name. Updated callers. + (mini_random_op2): New function. + + * mini-gmp/tests/hex-random.c (hex_random_op3): Renamed, from... + (hex_random_op): ... old name. Updated callers. + (hex_random_op2): New function. + +2013-01-15 Marco Bodrato + + * mini-gmp/tests/t-logops.c: Improve popcount/hamdist testing. + * mini-gmp/tests/t-signed.c: Test more cases. + +2013-01-15 Torbjorn Granlund + + From Mike Frysinger: + * configure.ac: Add x32 ABI for x86_64. + +2013-01-14 Niels Möller + + * mini-gmp/tests/t-str.c (main): Added tests for mpn_get_str and + mpn_set_str. + +2013-01-14 Marco Bodrato + + * doc/gmp.texi (gmp_version): Remove "was used" repetition. + (Upward compatibility): Mention mpn_bdivmod, GMP 4 -> GMP 5. + +2013-01-13 Marc Glisse + + * doc/gmp.texi: Let mpn_sqrtrem reference mpn_perfect_square_p instead + of mpz_perfect_square_p. + +2013-01-11 Marco Bodrato + + * mini-gmp/tests/t-comb.c: New test program, testing both + mpz_fac_ui and mpz_bin_uiui. + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): Added t-comb. + + * mini-gmp/mini-gmp.c (mpz_mul_si): Simplify. + (mpz_mul_ui, mpz_mul, mpz_div_qr): Replace init+REALLOC with init2. + + * mini-gmp/mini-gmp.c (NEG_CAST): New macro. + (mpz_mul_si, mpz_set_si, mpz_cmp_si): Use NEG_CAST. + + * mini-gmp/mini-gmp.c (mpz_set_si, mpz_cmp_si): Simplify by using + the _ui variant. + + * mini-gmp/tests/t-root.c: Use mpz_ui_pow_ui, when base fits an ui. + + * mini-gmp/tests/t-mul.c: Test also mpz_mul_si. + * mini-gmp/tests/t-sub.c: Test also mpz_ui_sub. + + * mini-gmp/mini-gmp.c (mpz_fits_slong_p): Correct range. + * mini-gmp/tests/t-signed.c: New test program, for get/set/cmp_si. + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): Added t-signed. + + * mini-gmp/mini-gmp.c (mpz_hamdist): Handle different sizes. + * mini-gmp/tests/t-logops.c: Test also popcount and hamdist. + +2013-01-10 Marco Bodrato + + * mpz/export.c: Less restrictive ASSERTs. + * mini-gmp/mini-gmp.c (mpz_export, mpz_import): Likewise. + * mini-gmp/tests/t-import.c: Test also size=0 or count=0. + +2013-01-10 Torbjorn Granlund + + * mini-gmp/tests/t-import.c (main): Don't drop off function end. + + * Makefile.am (check-mini-gmp): Set LD_LIBRARY_PATH to allow testing + with dynamic main GMP build. + +2013-01-09 Marco Bodrato + + * mini-gmp/mini-gmp.c (mpz_export): Support op=0 countp=NULL. + +2013-01-08 Niels Möller + + * mini-gmp/tests/t-import.c: New test program, testing both + mpz_import and mpz_export. + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): Added t-import. + + * mini-gmp/tests/mini-random.c (mini_rrandomb_export): New + function. + * mini-gmp/tests/mini-random.h: Declare it. + * mini-gmp/tests/hex-random.c (hex_rrandomb_export): New function. + * mini-gmp/tests/hex-random.h: Declare it. + + * mini-gmp/mini-gmp.c (mpz_export): Compute accurate word count up + front, to avoid generating any high zero words. + +2013-01-07 Marco Bodrato + + * mini-gmp/README: Document base limitation for conversions. + * mini-gmp/mini-gmp.c (mpz_set_str): Remove goto. + (mpz_import, mpz_export): Correctly use order/endianness. + +2013-01-05 Torbjorn Granlund + + * longlong.h (aarch64): Make add_ssaaaa and sub_ddmmss actually work. + +2013-01-04 Marco Bodrato + + From shuax: + * mini-gmp/mini-gmp.c (mpz_import): Reset limb after storing it. + +2013-01-04 Torbjorn Granlund + + From Marko Lindqvist: + * configure.ac: Use AC_CONFIG_HEADERS instead of the obsolete + AM_CONFIG_HEADER. + +2013-01-02 Marco Bodrato + + * tests/mpz/bit.c: Wider testing for mpz_combit. + * tests/mpz/logic.c: Check the -2^n case. + + * mpz/ior.c: Fixed an allocation bug in the -2^n case. + +2012-12-31 Torbjorn Granlund + + * mpn/generic/get_d.c: Minor reorg, add vax D code. + + * gmp-impl.h (double_extract): New union type for vax D floats. + + * tests/mpq/t-get_d.c (check_random): Limit exponents on vax. + +2012-12-30 Marco Bodrato + + * tests/mpz/bit.c (check_clr_extend): Check _set shrink. + +2012-12-29 Torbjorn Granlund + + * demos/calc/calc.c: Remove generated file from repo. + * demos/calc/calc.h: Likewise. + * demos/calc/calclex.c: Likewise. + +2012-12-27 Torbjorn Granlund + + * mpn/generic/get_d.c: Complete rewrite of non-IEEE code. + + * tests/mpq/t-get_d.c (main): Suppress check_random for vax. + +2012-12-25 Torbjorn Granlund + + * mpn/x86_64/bdiv_q_1.asm: Use LEA for binvert_limb_table. + +2012-12-23 Torbjorn Granlund + + * tests/mpz/t-get_d.c (check_onebit): Decrease vax limit to avoid + overflow in last, unused 'want' value. + + * config.guess: Recognise AMD family 22 as a future bobcat. + +2012-12-21 Torbjorn Granlund + + * configure.ac: Rename configure.in. + +2012-12-17 Torbjorn Granlund + + * Version 5.1.0 released. + + * configure.in (none-*-*): Allow this again, but print a warning. + +2012-12-17 Marco Bodrato + + * mpz/n_pow_ui.c: Fix typos in an ASSERT. + +2012-12-16 Torbjorn Granlund + + * mpn/generic/mu_div_qr.c (mpn_preinv_mu_div_qr): Explicitly use + MPN_COPY_INCR for slightly overlapping copy. + +2012-12-15 Marco Bodrato + + * tests/mpn/toom-sqr-shared.h: Skip ALLOCs if the test is skipped. + +2012-12-13 Torbjorn Granlund + + * mpn/x86_64/dos64.m4 (PIC): Move definition early. + (JMPENT): Remove PIC variant. + + * mpn/x86_64/darwin.m4 (JUMPTABSECT): Define to .text, instead of + something sensible. + +2012-12-12 Torbjorn Granlund + + * mpn/x86_64/x86_64-defs.m4 (JMPENT): New macro. + * mpn/x86_64/dos64.m4: Likewise. + * mpn/x86_64/darwin.m4: Likewise. + * mpn/x86_64/mod_34lsub1.asm: Use JMPENT to properly support PIC. + * mpn/x86_64/mullo_basecase.asm: Likewise. + * mpn/x86_64/sqr_basecase.asm: Likewise. + +2012-12-11 Torbjorn Granlund + + * mpn/x86_64/mod_34lsub1.asm: Try different jump table for the benefit + of broken Apple linkers. + +2012-12-09 Torbjorn Granlund + + * configure.in: Make GMP_NONSTD_ABI ABI specific. + +2012-12-08 Torbjorn Granlund + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*): Bump version info. + * gmp-h.in: Bump version. + +2012-12-06 Marco Bodrato + + * tests/mpq/reuse.c: New test (adapted from mpf/reuse.c). + * tests/mpq/Makefile.am (check_PROGRAMS): Add reuse. + + * mpz/abs.c: Use NEWALLOC. + * mpz/neg.c: Likewise. + * mpz/com.c: Reduce branches. + +2012-12-05 Niels Möller + + * mpn/generic/brootinv.c (mpn_brootinv): Make valgrind happier, at + the cost of a redundant MPN_ZERO. + + * mpz/jacobi.c (mpz_jacobi): Check for asize == 0 or bsize == 0 + before using the low limbs. + +2012-12-05 Torbjorn Granlund + + * mpn/generic/set_str.c (mpn_dc_set_str): Work around a valgrind issue. + + * mpz/powm_ui.c: Don't assume >= 2 limbs in mod argument. + + * tests/tests.h (TESTS_REPS): Handle float GMP_CHECK_REPFACTOR. + + * longlong.h: Refine cpp test for vax. + * tests/mpn/t-get_d.c: Likewise. + * tests/mpz/t-get_d.c: Likewise. + * tests/mpz/t-cmp_d.c: Likewise. + * tests/mpz/t-get_d.c: Likewise. + * tests/mpq/t-get_d.c: Likewise. + * tests/mpf/t-get_d.c: Likewise. + +2012-11-30 Torbjorn Granlund + + * gen-fac.c (gen_consts): Correct printf types. + + * mpn/arm/v7a/cora15/gmp-mparam.h: New file. + + * configure.in (arm*-*-*): New compiler optional "tune". Pass value for + selected processors. Add more specific path components. + +2012-11-29 Torbjorn Granlund + + From Andoni Morales Alastruey: + * longlong.h: Conditionalise ARM asm on !__thumb__. + +2012-11-28 Torbjorn Granlund + + * config.guess (arm*-*-*): Support specific ARM processors. + * config.sub: Match arm CPUs. + * configure.in (arm*-*-*): Likewise. + + * mpz/powm.c: Move new_b out since it lives on through b. + + * configure.in (arm*-*-*): Pass -marm to deal with compilers defaulting + to thumb code. + +2012-11-26 Torbjorn Granlund + + * tests/cxx/t-ops2.cc (checkz): Reduce huge numbers to avoid vax + overflow. + +2012-11-25 Torbjorn Granlund + + * mpn/generic/get_d.c: Reinsert non-IEEE code. + + * mpn/vax/add_n.asm: New file. + * mpn/vax/add_n.s: Remove. + * mpn/vax/addmul_1.asm: New file. + * mpn/vax/addmul_1.s: Remove. + * mpn/vax/lshift.asm: New file. + * mpn/vax/lshift.s: Remove. + * mpn/vax/mul_1.asm: New file. + * mpn/vax/mul_1.s: Remove. + * mpn/vax/rshift.asm: New file. + * mpn/vax/rshift.s: Remove. + * mpn/vax/sub_n.asm: New file. + * mpn/vax/sub_n.s: Remove. + * mpn/vax/submul_1.asm: New file. + * mpn/vax/submul_1.s: Remove. + + * mpn/vax/elf.m4: New file. + * configure.in (vax*-*-*elf*): New case, grabbing vax/elf.m4. + + * tests/mpn/t-get_d.c (check_onebit): Get vax bounds right. + (main): Switch off check_rand for vax. + +2012-11-22 Niels Möller + + * mini-gmp/tests/run-tests: Copied latest version from GNU Nettle. + Minor fix to the use of $EMULATOR, and proper copyright notice. + +2012-11-16 Torbjorn Granlund + + * mpn/generic/powm_sec.c (redcify): Use mpn_sb_div_r_sec. + + * mpn/generic/sb_div_sec.c: New file. + * mpn/generic/sbpi1_div_sec.c: New file. + * configure.in (gmp_mpn_functions): Add new files. + * gmp-impl.h: Declare new functions. + +2012-11-12 Torbjorn Granlund + + * longlong.h: Add ARM64 support. + * longlong.h: Add AVR support. + + * mpn/powerpc64/mode64/divrem_1.asm: Tune, simplify. + + * mpq/md_2exp.c: Use MPN_COPY_INCR, not MPN_COPY_DECR. + * tests/mpq/t-md_2exp.c (check_random): New function. + +2012-11-10 Torbjorn Granlund + + * mpn/generic/remove.c (mpn_bdiv_qr_wrap): Make static. + +2012-11-04 Torbjorn Granlund + + * mpz/powm_ui.c: Rewrite. + +2012-11-01 Niels Möller + + * mpn/generic/brootinv.c (mpn_brootinv): Input size in limbs + rather than bits. Use single-precision iterations for the first + limb. + * mpn/generic/perfpow.c (is_kth_power): Update mpn_brootinv call. + * tests/mpn/t-brootinv.c (main): Likewise. + * tune/speed.h (SPEED_ROUTINE_MPN_BROOTINV): Likewise. + * gmp-impl.h (mpn_brootinv): Updated prototype. + + * mpn/generic/hgcd2.c (mpn_hgcd2): Removed redundant loop exit + tests in the single-precision loop. + + * mpz/combit.c (mpz_combit): Rewrite, optimizing for the common + case. + +2012-10-31 Niels Möller + + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-brootinv. + * tests/mpn/t-brootinv.c: New file + + * mpn/generic/broot.c (mpn_broot_invm1): Avoid a mullo_n in the + loop, and do powering as a plain mpn_sqr followed by mpn_powlo. + + * tune/speed.c (routine): Added mpn_broot, mpn_broot_invm1, + mpn_brootinv. + + * tune/common.c (speed_mpn_broot, speed_mpn_broot_invm1) + (speed_mpn_brootinv): New functions. + * tune/speed.h (SPEED_ROUTINE_MPN_BROOT) + (SPEED_ROUTINE_MPN_BROOTINV): New macros. + + * mpn/generic/broot.c (mpn_broot_invm1): Made non-static (mainly + for benchmarking). + * gmp-impl.h (mpn_broot_invm1): Declare it. + +2012-10-28 Torbjorn Granlund + + * configure.in (gmp_mpn_functions): Add new files. + * gmp-impl.h: Declare new functions. + * mpn/generic/perfpow.c: Overhaul. + (binv_root, binv_sqroot): Remove. + * mpn/generic/brootinv.c: New file, code from overhauled binv_root. + * mpn/generic/bsqrtinv.c: New file, code from overhauled binv_sqroot. + * mpn/generic/bsqrt.c: New file. + + * tests/mpn/t-broot.c: Add a forgotten TMP_MARK. + +2012-10-28 Niels Möller + + * mpn/generic/broot.c (mpn_broot): New file and function. + * configure.in (gmp_mpn_functions): Add broot. + * gmp-impl.h (mpn_broot): Declare. + * tests/mpn/t-broot.c: New testcase. + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-broot. + +2012-10-27 Torbjorn Granlund + + * mpn/generic/remove.c: Get remainder allocation right. + +2012-10-25 Torbjorn Granlund + + * longlong.h: De-support old POWER asm syntax. + + * tests/mpz/t-remove.c: Run more tests, but use a tad smaller operands. + + * mpn/generic/remove.c (mpn_bdiv_qr_wrap): New function. + (mpn_remove): Call mpn_bdiv_qr_wrap. + * mpz/remove.c: Enable suppressed mpn_remove call. + +2012-10-17 Torbjorn Granlund + + * mpz/powm_ui.c (mpz_powm_ui): Deflect to mpz_powm for large exponent. + +2012-09-10 Torbjorn Granlund + + * demos/factorize.c: Rewrite no more current form. Implement Lucas + prime proving, and make its use the default. + * demos/primes.h: New file. + +2012-08-24 Torbjorn Granlund + + * demos/factorize.c: Overhaul. + +2012-08-06 Marco Bodrato + + * doc/gmp.texi (mpn_neg): Correctly document returned type. + + * gmp-impl.h (_mpz_newalloc, log_n_max): mark with inline (spotted by Niels). + +2012-07-28 Marc Glisse + + * gmpxx.h (std::common_type): New partial specializations with builtin + types. + * tests/cxx/t-cxx11.cc: Test it. + +2012-07-21 Torbjorn Granlund + + * mpn/powerpc32/vmx/mod_34lsub1.asm: Fix r0 clobbering issue with + "large" code affecting elf+darwin PIC. + +2012-07-21 Marc Glisse + + * gmpxx.h (__GMPXX_CONSTANT): Disable for g++-3.4. + +2012-06-26 Torbjorn Granlund + + * Makefile.am (LIBMP_LT_*): Remove these. + +2012-06-26 Marc Glisse + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*): Update comment for 5.1.0. + +2012-06-24 Marco Bodrato + + * configure.in (CALLING_CONVENTIONS_OBJS): Disable any use of + assembly code with the --disable-assembly option. + * mpz/oddfac_1.c: Use the ASSERT_CODE macro. + * gen-trialdivtab.c (mpz_log2): Use mpz_sizeinbase (., 2). + + * gmp-impl.h (MPN_SIZEINBASE_16): Replace with MPN_SIZEINBASE_2EXP + from mpz/export.c . + * mpz/export.c (MPN_SIZEINBASE_2EXP): Removed. + * mpn/generic/sizeinbase.c: Use MPN_SIZEINBASE. + + * mpz/nextprime.c: Use MPN_SIZEINBASE_2EXP to count bits. + * mpn/generic/perfpow.c: Likewise. + * mpn/generic/rootrem.c: Likewise. + * mpz/get_d_2exp.c: Likewise. + * mpn/generic/powm_sec.c: Likewise, nailify. + * mpn/generic/powlo.c: Likewise. + * mpn/generic/powm.c: Likewise. + + * mini-gmp/mini-gmp.c (mpz_div_r_2exp, mpz_div_q_2exp): Improve + adjustment condition. + +2012-06-23 Marc Glisse + + * gmpxx.h (numeric_limits): Make content public. + * cxx/limits.cc: New file, proper declarations. + * Makefile.am: List new file. + * cxx/Makefile.am: Likewise. + * cxx/t-misc.cc: Add minimal test for numeric_limits. + +2012-06-09 Marc Glisse + + * gmpxx.h (__gmp_resolve_expr::srcptr_type): New typedef. + (__gmp_temp): Wrapper for mp*_class, the constructor copies the + precision of its second argument for mpf_t. + (__gmp_expr::eval(p, prec)): Remove. + (__gmp_expr::eval(p)): Use __gmp_temp. + (__gmp_set_expr): Never pass prec to eval(). + +2012-06-08 Marco Bodrato + + * gmp-impl.h (__GMP_WITHIN_CONFIGURE): Use the same #if as in gmp-h.in. + (MPN_NORMALIZE_NOT_ZERO): Tighter ASSERT. + (MPZ_NEWALLOC): New macro. + * mpq: Use the new macro when possible. + * mpz/bin_uiui.c: Likewise. + * mpz/oddfac_1.c: Likewise. + * mpz/prodlimbs.c: Likewise. + + * mini-gmp/mini-gmp.c (mpz_realloc): remove a branch. + +2012-06-04 Torbjorn Granlund + + * mpn/powerpc64/aix.m4 (ASM_START): Claim machine type "any". + +2012-06-03 Niels Möller + + * mpn/generic/gcdext.c (mpn_gcdext): Deleted code for handling + impossible case u1 == 0, Simplified test for unlikely case u0 == 0. + +2012-06-02 Torbjorn Granlund + + * mpn/arm/lshiftc.asm: New file. + +2012-06-01 Torbjorn Granlund + + * mpn/arm/aorslsh1_n.asm: Use cmp/cmn instead of subs/adds in more + places. + + * mpz/get_str.c: Don't strip leading zeros since current mpn_get_str + won't generate any. Misc streamlining. + * mpz/out_str.c: Analogous changes. + + * tests/mpz/io.c: Use a wider range of bases. + + * tests/mpz/t-cong.c (check_random): Rewrite random generation for + exponentially distributed operand sizes. + +2012-06-01 Marco Bodrato + + * mpq: Use more macros and MPZ_REALLOC return value when possible. + + * gmp-impl.h (LIMBS): Removed, was an alias for PTR. + * mpz/combit.c: Use PTR and CNST_LIMB. + + * tests/mpn/t-bdiv.c: Test also mpn_bdiv_qr. + * mpn/generic/bdiv_qr.c: Add an ASSERT. + + * mpn/generic/remove.c: Add a zero limb to use bdiv_qr... + +2012-05-31 Marc Glisse + + * gmpxx.h (mpq_class::mpq_class): Handle mpq_class(0,1). + * tests/cxx/t-constr.cc: Test it. + +2012-05-30 Torbjorn Granlund + + * mpn/x86_64 (FUNC_ENTRY): New name for DOS64_ENTRY. + * mpn/x86_64 (FUNC_EXIT): New name for DOS64_EXIT. + +2012-05-29 Marco Bodrato + + * mpz/remove.c: Optimise branches. + + * mpn/generic/toom6h_mul.c: less branches in the LIKELY balanced path. + * mpn/generic/toom8h_mul.c: Likewise. + +2012-05-29 Torbjorn Granlund + + * mpn/arm/v5/mod_1_1.asm: New file. + +2012-05-28 Niels Möller + + * mpn/generic/gcdext.c (compute_v): Simplified carry handling a + bit, reduced stated scratch need from 2n+1 to 2n. Also comment and + ASSERT improvements. + +2012-05-27 Torbjorn Granlund + + * config.guess: Add new x86 CPUs. + * mpn/x86/fat/fat.c: Likewise. + * mpn/x86_64/fat/fat.c: Likewise. + +2012-05-27 Marco Bodrato + + * mpn/x86_64/fat/fat.c: abort iff longmode-capable-bit is turned off. + + * mpn/generic/toom8h_mul.c: mark UNLIKELY branches. + +2012-05-26 Torbjorn Granlund + + * mpz: Use MPZ_REALLOC return value when possible. + +2012-05-25 Marco Bodrato + + * mini-gmp/tests/t-div.c: Test all _qr, _q, _r variants. + * mini-gmp/tests/t-lcm.c: Test the _ui variant. + + * mini-gmp/mini-gmp.c (mpz_mod, mpz_mod_ui): New functions. + * mini-gmp/mini-gmp.h (mpz_mod, mpz_mod_ui): Prototypes. + + * mpz/scan1.c: Simplify, and add a shortcut for scan1(z, 0). + +2012-05-24 Torbjorn Granlund + + * mpz/n_pow_ui.c: Cast non-limb count_leading_zeros argument. + +2012-05-24 Marco Bodrato + + * mpz/remove.c: Support negative divisor. + * tests/mpz/t-remove.c: Test negative divisor. + +2012-05-23 Torbjorn Granlund + + * tests/mpz/reuse.c: Major rewrite. + +2012-05-23 Marco Bodrato + + * mpz/sqrt.c: Further simplify. + * mpz/sqrtrem.c: Likewise. + + * Mark failing branches with UNLIKELY. Many files affected. + +2012-05-22 Torbjorn Granlund + + * mpz/sqrt.c: Allocate less for overlapping operands, simplify. + * mpz/sqrtrem.c: Likewise. + +2012-05-21 Marco Bodrato + + * mpn/generic/toom8_sqr.c: Reduce branches for recursion. + * mpn/generic/toom8h_mul.c: Likewise. + + * tests/mpn/t-toom8h.c: Don't use GMP_NUMB_BITS when not yet defined. + +2012-05-20 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Rewrite. + +2012-05-19 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Generate larger operands for better gcd code + coverage; distribute size exponentially. + +2012-05-17 Marco Bodrato + + * mpf/pow_ui.c: Simplify. + * tests/mpf/reuse.c (dsi_func): Exercise pow_ui. + + * tests/mpf/t-set_ui.c (check_data): LONG_HIGHBIT -> ULONG_HIGHBIT. + * tests/mpf/t-set.c (check_random): New check, both set and init_set. + + * tests/cxx/t-ops.cc (check_mpq): Check squaring. + * tests/mpq/t-equal.c (check_various): Check different den-size. + + * mpn/generic/mullo_n.c: Disable MAYBE_ if WANT_FAT_BINARY. + * mpz/cmpabs_d.c: Remove an unused branch. + + * tests/mpz/t-get_d_2exp.c (check_zero): New check. + * tests/mpz/t-inp_str.c: A few more cases. + * tests/mpz/t-cmp_d.c: More bases and symbols, a few cases. + + * mpz/rootrem.c: Correctly handle odd roots of negatives. + * tests/mpz/t-root.c: Test it. + +2012-05-16 Torbjorn Granlund + + * tests/mpf/t-eq.c (check_random): New function, meat from old main(). + (check_data): New function. + +2012-05-13 Torbjorn Granlund + + * mpn/arm/rsh1aors_n.asm: New file. + * mpn/arm/v5/mod_1_2.asm: New file. + +2012-05-11 Marc Glisse + + * gmpxx.h (explicit operator bool): New functions. + * tests/cxx/t-cxx11.cc: Test the above. + +2012-05-10 Marco Bodrato + + * gmp-impl.h (__gmpn_cpuvec_initialized): Was __gmpn_cpuvec.initialized + * mpn/x86/fat/fat.c: Use separated _initialized variable. + * mpn/x86_64/fat/fat.c: Likewise. + * tests/mpn/t-fat.c: Likewise. + + * mpn/generic/toom2_sqr.c: Override global __gmpn_cpuvec_initialized. + * mpn/generic/toom22_mul.c: Likewise. + * mpn/generic/toom3_sqr.c: Likewise. + * mpn/generic/toom33_mul.c: Likewise. + +2012-05-09 Marco Bodrato + + * mini-gmp/mini-gmp.c: merge mpz_rootrem and mpz_sqrtrem. + + * mpn/generic/sqrtrem.c (invsqrttab): Reduce size removing common byte. + + * mpz/bin_uiui.c (mul3, mul4, mul8): Remove unneeded shifts. + (MAXFACS): Redefine, using the shared (safer) log_n_max. + +2012-05-08 Torbjorn Granlund + + * mpn/minithres/gmp-mparam.h (REDC_1_TO_REDC_N_THRESHOLD): Up to 9, for + coherency with ASSERT in mpn/generic/redc_n.c. + +2012-05-07 Marco Bodrato + + * mpn/minithres/gmp-mparam.h: Updated TOOM6 and FAC_DSC. + * tests/mpn/toom-sqr-shared.h: Don't test if no range. + + * mpz/oddfac_1.c: Add ASSERTs to warn about small threshold. + * tune/tuneup.c: Update minimal threshold for FAC_DSC. + +2012-05-06 Torbjorn Granlund + + * mpn/arm/v6/sqr_basecase.asm: Simplify n=4 code. + +2012-05-05 Marco Bodrato + + * mpn/generic/invert.c: Mark a branch UNLIKELY. + * tune/tuneup.c (tune_fac_u): Update DSC_THRESHOLD minimum. + * gmp-impl.h (FAC_???_THRESHOLD): Update default values. + (ABOVE_THRESHOLD): New definition with __builtin_constant_p. + + * mpn/generic/toom22_mul.c: Disable MAYBE_ if WANT_FAT_BINARY. + * mpn/generic/toom33_mul.c: Likewise. + * mpn/generic/toom2_sqr.c: Likewise. + * mpn/generic/toom3_sqr.c: Likewise. + +2012-05-04 Torbjorn Granlund + + * tune/tuneup.c: Measure POWM_SEC_TABLE after the REDC thresholds. + +2012-05-03 Torbjorn Granlund + + * mpn/generic/powm_sec.c: Use redc_2. + (INNERLOOP): Use this mechanism, like plain powm.c. + (WANT_CACHE_SECURITY): Remove, feature now unconditional. + +2012-05-02 Torbjorn Granlund + + * mpz/bin_uiui.c: Make use of CNST_LIMB. + +2012-05-02 Marco Bodrato + + * mpz/mfac_uiui.c: Support limb != ui. + +2012-05-02 Torbjorn Granlund + + * mpn/arm/logops_n.asm: Work around register clobbering issue. + + * mpn/arm/aorscnd_n.asm: New file. + +2012-05-01 Torbjorn Granlund + + * configure.in: Put arm dirs in path in proper prio order. + + * mpn/arm/logops_n.asm: New file. + + * mpz/2fac_ui.c: Fix assumed typo. + + * mpn/arm/v6/gmp-mparam.h: New file. + + * mpn/arm/v5/gcd_1.asm: Hack for undefined BMOD_1_TO_MOD_1_THRESHOLD. + * mpn/arm/v6t2/gcd_1.asm: Likewise. + +2012-04-30 Torbjorn Granlund + + * mpn/arm/v6/sqr_basecase.asm: New file. + +2012-04-30 Marco Bodrato + + * mpn/generic/comb_tables.c: New file. + * configure.in: Add it. + * gen-fac.c: Define table limits. + * gmp-impl.h: Declare tables. + (log_n_max): New static function. + * mpz/2fac_ui.c: Use shared tables. + * mpz/bin_uiui.c: Likewise. + * mpz/oddfac_1.c: Likewise. + * mpz/primorial_ui.c: Likewise. + + * mpz/mfac_uiui.c: New file. + * Makefile.am: Compile it. + * mpz/Makefile.am (libmpz_la_SOURCES): Add mpz_mfac_uiui.c + * gmp-h.in (mpz_mfac_uiui): Declare. + + * tests/mpz/t-mfac_uiui.c: New file. + * tests/mpz/Makefile.am: Run it. + + * doc/gmp.texi: Document mpz_mfac_uiui, collapsing with other factorial functions. + + * tests/mpz/t-lcm.c: Test zero too. + + * mpz/prodlimbs.c: Simplify threshold (should be tuned, not guessed). + +2012-04-29 Torbjorn Granlund + + * mpn/arm/aors_n.asm: Tune for more stable performance. + + * mpn/arm/aorslsh1_n.asm: New file. + + * mpn/arm/mod_34lsub1.asm: New file. + + * mpn/arm/v6t2/divrem_1.asm: New file. + +2012-04-28 Torbjorn Granlund + + * mpn/thumb/add_n.asm: New file. + * mpn/thumb/sub_n.asm: New file. + * mpn/thumb/add_n.s: Remove broken code. + * mpn/thumb/sub_n.s: Likewise. + + * mpn/arm/v6/addmul_1.asm: Rewrite for stable speed, smaller size. + * mpn/arm/v6/mul_1.asm: Likewise. + +2012-04-27 Torbjorn Granlund + + * configure.in: Search arm/v6t2 for arm7. + + * mpn/arm/v5/gcd_1.asm: New file. + * mpn/arm/v6t2/gcd_1.asm: New file. + + * mpn/arm/mode1o.asm: New file. + * mpn/arm/v6t2/mode1o.asm: New file. + + * mpn/arm/arm-defs.m4 (LEA): New define. + * mpn/arm/invert_limb.asm: Use LEA. + +2012-04-26 Marco Bodrato + + * mpz/bin_uiui.c (bc_bin_uiui): Nail support. + * tests/cxx/t-ops2.cc: Test 0/3. + * oddfac_1.c: assume n > 26. + * tests/mpz/t-jac.c (mpn_jacobi_n): Enlarge tested sizes. + +2012-04-24 Torbjorn Granlund + + * mpn/arm/v6/addmul_2.asm: New file. + * mpn/arm/v6/mul_2.asm: New file. + +2012-04-23 Torbjorn Granlund + + * mpn/arm/aorsmul_1.asm: Tweak loop control for a 6% speed increase. + +2012-04-22 Torbjorn Granlund + + * configure.in: Recognise ARM sub-architectures. + + * configfsf.guess: Update to current FSF version. + * configfsf.sub: Likewise. + + * mpn/arm/bdiv_dbm1c.asm: New file. + + * mpn/arm/v6/mul_1.asm: New file. + * mpn/arm/v6/addmul_1.asm: New file. + +2012-04-22 Marco Bodrato + + * gen-fac.c: Renamed, was gen-fac_ui.c . + * Makefile.am: Renamed gen-fac.c and fac_table.h . + * gmp-impl.h: #include "fac_table.h". + * mpz/oddfac_1.c: Use generated constant. + * mpz/bin_ui.c: Small optimisations. + + * tune/common.c (speed_mpz_bin_ui): New function. + * tune/speed.h: Declare it. + * tune/speed.c: Use it. + +2012-04-21 Torbjorn Granlund + + * mpn/arm/mul_1.asm: Cleanup. + * mpn/arm/copyi.asm: Cleanup, assume allocate-on-write cache. + * mpn/arm/copyd.asm: Likewise. + + * mpn/arm/add_n.asm: Delete. + * mpn/arm/sub_n.asm: Delete. + * mpn/arm/aors_n.asm: New file, made from old files. + + * mpn/arm/addmul_1.asm: Delete. + * mpn/arm/submul_1.asm: Delete. + * mpn/arm/aorsmul_1.asm: New file, made from old files. + + * mpn/arm/com.asm: New file. + * mpn/arm/lshift.asm: New file. + * mpn/arm/rshift.asm: New file. + +2012-04-20 Torbjorn Granlund + + * tests/mpq/io.c: New file. + * tests/mpq/Makefile.am: Run it. + + * mpz/clrbit.c: Simplify along the lines of setbit.c. + +2012-04-20 Marco Bodrato + + * mpz/setbit.c: Simplify. + + * gmp-impl.h (LOG2C): Define. + * mpz/fac_ui.c (LOG2C): Remove. + * mpz/2fac_ui.c (LOG2C): Remove. + * mpz/oddfac_1.c (LOG2C): Remove. + * mpn/generic/binvert.c (LOG2C): Remove. + * mpn/generic/invertappr.c (LOG2C): Remove. + + * mpz/bin_uiui.c (mpz_goetgheluck_bin_uiui): Move declarations, + and assume that n and k are not small. + +2012-04-19 Torbjorn Granlund + + * tests/mpz/Makefile.am (check_PROGRAMS): Add t-remove. + + * tests/mpz/t-remove.c: Clear out mpz variables. + + * tests/mpz/t-cong.c (check_random): Use much larger numbers. + (check_data): Check congruences mod 0. + + * tests/mpz/t-divis.c: Test divisibility by zero. + + * tests/mpz/reuse.c: Test mpz_mod. + + * mpz/setbit.c: Remove dead code. Use CNST_LIMB. + * mpz/clrbit.c: Use CNST_LIMB. + +2012-04-19 Marco Bodrato + + * primesieve.c: New file, with functions from mpz/oddfac_1.c . + * mpz/oddfac_1.c (bitwise_primesieve): Re-moved. + * Makefile.am (libgmp_la_SOURCES): Add primesieve.c . + * gmp-impl.h (gmp_primesieve): Declare. + + * mpz/bin_uiui.c (mpz_goetgheluck_bin_uiui): New, factor-based + implementation. + * tests/mpz/t-bin.c: Extend tests, to cover _goetgheluck. + + * mpz/primorial_ui.c: New file. + * mpz/Makefile.am (libmpz_la_SOURCES): Add mpz/primorial_ui.c + * Makefile.am (MPZ_OBJECTS): Add mpz/primorial_ui$U.lo + * gmp-h.in (mpz_primorial_ui): Declare. + * tests/mpz/t-primorial_ui.c: New test for the new function. + * tests/mpz/Makefile.am (check_PROGRAMS): Add t-primorial_ui. + * doc/gmp.texi: Short documentation for the new function. + +2012-04-17 Torbjorn Granlund + + * mpn/x86_64/coreisbr/aorsmul_1.asm: Fix some DOS64 issues. + * mpn/x86_64/coreisbr/mul_1.asm: Likewise. + + * mpn/x86_64/fastsse/lshiftc-movdqu2.asm: Adhere to DOS64 register + partitioning rules. + + * mpn/x86_64/fastsse/copyi-palignr.asm: Implement temporary workaround + to overlap issue. + +2012-04-17 Marco Bodrato + + * mpz/bin_uiui.c: Support small limbs (fallback on bin_ui). + + * tests/mpn/toom-sqr-shared.h: Use a restricted range. + * tests/mpn/t-toom2-sqr.c: Specify correct range. + * tests/mpn/t-toom3-sqr.c: Likewise. + * tests/mpn/t-toom4-sqr.c: Likewise. + * tests/mpn/t-toom6-sqr.c: Likewise. + * tests/mpn/t-toom8-sqr.c: Likewise, but extended. + * tests/mpn/Makefile.am (check_PROGRAMS): Add t-toom?-sqr tests. + + * mpn/generic/sbpi1_bdiv_q.c: Move ASSERTs, to support qp = np. + +2012-04-17 Torbjorn Granlund + + * mpn/x86_64/copyd.asm: Rewrite. + * mpn/x86_64/copyi.asm: Rewrite. + +2012-04-16 Torbjorn Granlund + + * mpn/x86_64/fastsse/lshift-movdqu2.asm: Add DOS entry/exit sequences. + * mpn/x86_64/fastsse/rshift-movdqu2.asm: Likewise. + * mpn/x86_64/fastsse/lshiftc-movdqu2.asm: Likewise. + + * mpn/x86_64/x86_64-defs.m4 (palignr): New macro. + (x86_opcode_regxmm, x86_opcode_regxmm_list): New, made from x86 mmx + counterparts. + (x86_lookup): Copy from x86/x86-defs.m4. + * mpn/x86_64/fastsse/copyd-palignr.asm: Use palignr macro. + * mpn/x86_64/fastsse/copyi-palignr.asm: Likewise. + +2012-04-15 Marco Bodrato + + * tests/mpz/t-bin.c: Add more tests on small values. + * mpz/bin_uiui.c (mpz_bdiv_bin_uiui): Smaller temporary areas. + +2012-04-15 Torbjorn Granlund + + * mpn/x86_64/fastsse/copyd-palignr.asm: New file. + * mpn/x86_64/fastsse/copyi-palignr.asm: New file. + * mpn/x86_64/core2/copyd.asm: New file. + * mpn/x86_64/core2/copyi.asm: New file. + * mpn/x86_64/nano/copyd.asm: New file. + * mpn/x86_64/nano/copyi.asm: New file. + * mpn/x86_64/atom/copyd.asm: New file. + * mpn/x86_64/atom/copyi.asm: New file. + +2012-04-13 Marco Bodrato + + * mpz/bin_uiui.c: Rewrite (some parts are Torbjorn's). + * gen-fac_ui.c: Generate new constants for bin_uiui. + + * mini-gmp/mini-gmp.h (mpz_fac_ui, mpz_bin_uiui): New definitions. + * mini-gmp/mini-gmp.c (mpz_fac_ui, mpz_bin_uiui): Trivial + implementation. + + * tests/mpz/t-fac_ui.c: Check Wilson's theorem on a big value. + + * mpn/generic/invert.c: Remove support for scratch == NULL. + * tune/speed.h (SPEED_ROUTINE_MPN_MUPI_DIV_QR): Allocate scratch + space for mpn_invert. + + * mpz/mul_i.h: Small clean-up. + + * tests/mpn/toom-sqr-shared.h: New file. + * tests/mpn/t-toom2-sqr.c: New file. + * tests/mpn/t-toom3-sqr.c: New file. + * tests/mpn/t-toom4-sqr.c: New file. + * tests/mpn/t-toom6-sqr.c: New file. + * tests/mpn/t-toom8-sqr.c: New file. + * tests/mpn/Makefile.am (EXTRA_DIST): Add toom-sqr-shared.h . + + * mpn/generic/toom62_mul.c: Use add_n, sub_n, when possible. + +2012-04-12 Torbjorn Granlund + + * mpn/x86_64/fastsse/lshift-movdqu2.asm: New file. + * mpn/x86_64/fastsse/rshift-movdqu2.asm: New file. + * mpn/x86_64/fastsse/lshiftc-movdqu2.asm: New file. + * mpn/x86_64/coreisbr/lshift.asm: New file. + * mpn/x86_64/coreisbr/rshift.asm: New file. + * mpn/x86_64/coreisbr/lshiftc.asm: New file. + * mpn/x86_64/k10/lshift.asm: New file. + * mpn/x86_64/k10/rshift.asm: New file. + * mpn/x86_64/k10/lshiftc.asm: New file. + + * mpn/x86_64/fastsse/lshift.asm: Simplify to very basic form. + +2012-04-11 Niels Möller + + * Makefile.am (check-mini-gmp): Pass -I../.. in EXTRA_CFLAGS, to + locate gmp.h. + +2012-04-11 Marco Bodrato + + * mini-gmp/mini-gmp.h (mpz_root, mpz_rootrem): define (correctly). + * mini-gmp/mini-gmp.c (mpz_rootrem): Extended code from _root. + (mpz_root): Use mpz_rootrem. + (mpz_mul_ui): Correctly handle negative operands. + + * mini-gmp/tests/Makefile (CHECK_PROGRAMS): add t-root. + * mini-gmp/tests/t-root.c: New file. + * mini-gmp/tests/t-reuse.c: Enable root{,rem} tests. + +2012-04-10 Marco Bodrato + + * gen-fac_ui.c (mpz_root): Remove. + * mini-gmp/mini-gmp.c (mpz_root): New, support negative operands. + * mini-gmp/mini-gmp.h (mpz_root): define. + (mpz_out_str): Test also __STDIO_LOADED (for VMS). + * mpz/2fac_ui.c: Cosmetic change. + +2012-04-07 Torbjorn Granlund + + * mpn/ia64/gcd_1.asm: Rewrite inner loop to use ctz table. + +2012-04-05 Torbjorn Granlund + + * mpn/powerpc64/p7/popcount.asm: Properly extend arg n for mode32. + * mpn/powerpc64/p7/hamdist.asm: Likewise. + +2012-04-04 Torbjorn Granlund + + * mpn/powerpc64/p7/popcount.asm: New file. + * mpn/powerpc64/p7/hamdist.asm: New file. + + * longlong.h (ARM count_leading_zeros): Enable for more arch versions. + + * mpn/x86_64/gcd_1.asm: Make room for DOS64 regparm shadow area. + * mpn/x86_64/core2/gcd_1.asm: Likewise. + +2012-04-03 Torbjorn Granlund + + * mpn/x86_64/coreisbr/aorrlsh_n.asm: Make it actually work for DOS64. + +2012-04-02 Marco Bodrato + + * mpz/oddfac_1.c: Initialize size for ASSERT. + +2012-04-02 Torbjorn Granlund + + * gmp-h.in (_GMP_H_HAVE_FILE): Test also __STDIO_LOADED (for VMS). + + * gmp-impl.h (doprnt_format_t, etc): Remove bogus __GMP_DECLSPECs. + +2012-03-30 Marco Bodrato + + * mpn/x86_64/sqr_basecase.asm: Speed-up for small cases. + +2012-03-29 Torbjorn Granlund + + * mpn/sparc64/gcd_1.asm: New file. + +2012-03-27 Torbjorn Granlund + + * config.guess: Fix typo in coreisbr recognition. + +2012-03-26 Marco Bodrato + + * mpn/x86_64/gcd_1.asm: Reduce latency. + * mpn/x86_64/mul_basecase.asm: Save one jump. + + * mpz/iset_ui.c: Don't realloc. + +2012-03-20 Marco Bodrato + + * mp_clz_tab.c: Add __clz_tab[128]. + * longlong.h (count_trailing_zeros): Use it in pure C variant. + +2012-03-20 Torbjorn Granlund + + * configure.in (x86 fat_path): Add many missing directories. + * mpn/x86/fat/fat.c (__gmpn_cpuvec_init): Rewrite. + (fake_cpuid_table): Add many more CPUs. + + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec_init): Minor spacing cleanup. + +2012-03-19 Torbjorn Granlund + + * mpn/x86/x86-defs.m4 (CALL, PIC_WITH_EBX): New macros. + * mpn/x86/darwin.m4: Likewise. + * mpn/x86/k7/gcd_1.asm: Use new macros to support PIC. + * mpn/x86/p6/gcd_1.asm: Likewise. + +2012-03-19 Marco Bodrato + + * gen-fac_ui.c: Generate more constants (possible mini-mpz_root). + * mpz/oddfac_1.c: Improve ASSERTs. + (log_n_max): Use precomputed table. + + * longlong.h (_PROTO): Remove. + +2012-03-18 Torbjorn Granlund + + * longlong.h (count_trailing_zeros): Write better pure C default + variant. + + * mpn/x86/p6/gcd_1.asm: Remove forgotten x86_64 reference. + + * mpn/x86/p6/gmp-mparam.h: Update, to get BMOD_1_TO_MOD_1_THRESHOLD + defined for fat binaries. + +2012-03-17 Torbjorn Granlund + + * mpn/x86/k7/gcd_1.asm: Rewrite. + * mpn/x86/p6/gcd_1.asm: New file. + + * mpn/x86_64/core2/gcd_1.asm: Conditionally suppress reduction calls. + * mpn/x86_64/gcd_1.asm: Rewrite. + +2012-03-15 Torbjorn Granlund + + * mpn/generic/gcd_1.c: Parameterise zerotab code. + + * mpn/x86_64/nano/gcd_1.asm: New file, grabbing core2 asm file. + + * mpn/x86_64/core2/gcd_1.asm: Speed up loop code, simplify non-loop + code. + +2012-03-13 Torbjorn Granlund + + * mpn/x86_64/core2/gcd_1.asm: Add hack to support fat builds. + + * mpn/x86_64/core2/gcd_1.asm: Shorten critical path. + +2012-03-12 Torbjorn Granlund + + * mpn/x86_64/core2/gcd_1.asm: New file. + * mpn/x86_64/k10/gcd_1.asm: New file, grabbing core2 asm file. + * mpn/x86_64/bd1/gcd_1.asm: Likewise. + + * mpn/x86_64/bobcat/sqr_basecase.asm: New file. + * mpn/x86_64/bobcat/mul_basecase.asm: Minor tuning. + +2012-03-10 Torbjorn Granlund + + * configure.in (fat_functions): Add addlsh1_n, addlsh2_n, addmul_2, + mullo_basecase, redc_1, redc_2, sublsh1_n. + + * gmp-impl.h (struct cpuvec_t): Add fields for new fat functions. + * gmp-impl.h: Adjust corresponding declarations. + + * mpn/generic/redc_2.c (mpn_addmul_2): Make static. + + * mpn/x86_64/fat/fat_entry.asm (FAT_INIT): Expand before fat_init to + reduce branch offsets. Pass plain 0,1,3... in %al since we'd else run + out of 8-bit range. + + * mpn/x86_64/fat/fat_entry.asm (fat_init): Scale passed index value. + * mpn/x86/fat/fat_entry.asm (fat_init): Use movzbl for expanding index + value. + + * mpn/x86_64/x86_64-defs.m4 (CPUVEC_FUNCS_LIST): Add new fat functions. + * mpn/x86/x86-defs.m4 (CPUVEC_FUNCS_LIST): Likewise. + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec): Likewise. + * mpn/x86/fat/fat.c (__gmpn_cpuvec): Likewise. + + * mpn/x86_64/fat/redc_2.c: New file. + * mpn/x86/fat/mullo_basecase.c: New file. + * mpn/x86/fat/redc_1.c: New file. + * mpn/x86/fat/redc_2.c: New file. + + * tests/mpn/t-fat.c: Test mullo_basecase. + +2012-03-08 Torbjorn Granlund + + * mpn/x86_64/coreisbr/addmul_2.asm: Port to DOS64. + +2012-02-29 Marc Glisse + + * gmpxx.h: Ignore partial C++11 support in g++-4.6. + * tests/cxx/t-cxx11.cc: Likewise. + + * gmpxx.h (operator""): New functions. + * tests/cxx/t-cxx11.cc: Test the above. + * doc/gmp.texi: Document the above. + +2012-03-08 Marco Bodrato + + * acinclude.m4 (GMP_H_ANSI): Remove. + * configure.in: Don't use GMP_H_ANSI. + * gmp-h.in (__GMP_HAVE_PROTOTYPES): Remove. + +2012-03-08 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c (fake_cpuid_table): Recognise "bulldozer". + (__gmpn_cpuvec_init): Overhaul to match configure.in. + + * configure.in: Adjust bulldozer path_64. + +2012-03-07 Torbjorn Granlund + + * configure.in (x86_64 fat_path): List recently added AMD directories. + + * mpn/x86_64/bobcat/copyi.asm: New file. + * mpn/x86_64/bobcat/copyd.asm: New file. + + * config.guess: Handle AMD 11h correctly. + + * tune/tuneup.c (tune_redc): Better handle situation where redc_2 is + never faster. + +2012-03-06 Torbjorn Granlund + + * mpn/x86_64/bobcat/mul_basecase.asm: New file. + +2012-03-04 Torbjorn Granlund + + * mpn/x86_64/bobcat/mul_1.asm: New file. + * mpn/x86_64/bobcat/aorsmul_1.asm: New file. + +2012-03-04 Marco Bodrato + + * mpz/invert.c: Remove mod 0 branch. + * tests/mpz/t-invert.c: Avoid testing mod 0. + * doc/gmp.texi (mpz_invert): Specify mod 0 is not handled. + + * gmp-h.in (__gmp_signed, __gmp_const): Remove. + (__GMP_HAVE_TOKEN_PASTE, __GMP_HAVE_CONST): Remove. + * gmp-impl.h: Strip __GMP_HAVE_TOKEN_PASTE and __GMP_HAVE_CONST. + * demos/expr/: Strip __gmp_const usage from all files. + + * tests/mpz/t-powm.c (allsizes_seen): Require unsigned*. + +2012-03-03 Torbjorn Granlund + + * mpn/x86_64/k8/gmp-mparam.h: New file. + * mpn/x86_64/k10/gmp-mparam.h: New file. + + * mpn/generic/hgcd_step.c (mpn_hgcd_step): Remove unused variables. + * mpn/generic/hgcd_jacobi.c (hgcd_jacobi_step): Likewise. + * mpn/generic/hgcd_reduce.c (hgcd_matrix_apply): Likewise. + * mpn/generic/mu_bdiv_qr.c: Likewise. + * mpz/jacobi.c: Likewise. + * mpz/mod.c: Likewise. + + * mpn/generic/toom42_mul.c: Remove unread variable. + * mpn/generic/set_str.c (mpn_set_str_compute_powtab): Likewise. + * mpn/generic/rootrem.c (mpn_rootrem_internal): Likewise. + * tests/refmpn.c (refmpn_mul): Likewise. + * mpn/generic/hgcd_appr.c (mpn_hgcd_appr): Propagate mask computation + into ASSERT, remove variable. + + * gmp-h.in (__GMP_PROTO): Remove. + * Strip __GMP_PROTO usage from all files. + * Strip prototype parameter names from all files. + +2012-03-01 Marco Bodrato + + * doc/gmp.texi (mpz_invert): Correctly document result range. + * tests/mpz/t-invert.c: Small range correction. + +2012-03-01 Torbjorn Granlund + + * mpn/x86_64/mullo_basecase.asm: New file. + +2012-02-29 Marc Glisse + + * gmpxx.h (std::numeric_limits): New partial specialization. + +2012-02-29 Niels Möller + + * mini-gmp/tests/t-reuse.c: New test case, based on + tests/mpz/reuse.c. + + * mini-gmp/mini-gmp.c (mpz_cdiv_r_ui): New function. + (mpz_fdiv_r_ui): New function. + (mpz_tdiv_r_ui): New function. + (mpz_powm_ui): New function. + (mpz_pow_ui): New function. + (mpz_ui_pow_ui): Use mpz_pow_ui. + (mpz_gcdext): Fixed input/output overlap, for the case of one + input being zero. + (mpz_sqrtrem): Fix for the case r NULL, U zero. + + * Makefile.am (check-mini-gmp): Use $(MAKE). + (clean-mini-gmp): New target. + (clean-local, distclean-local): New automake targets. Depend on + clean-mini-gmp. + +2012-02-28 Niels Möller + + * Makefile.am (check-mini-gmp): New target, for running the + mini-gmp testsuite. + + * mini-gmp/tests/Makefile (srcdir, MINI_GMP_DIR): New make + variables. These can be overridden when using a separate build + directory. + (EXTRA_CFLAGS): Renamed, was OPTFLAGS. + + * mini-gmp/mini-gmp.c (mpz_abs_add): Don't cache limb pointers + over MPZ_REALLOC, since that breaks in-place operation. Bug + spotted by Torbjörn. + (mpz_and, mpz_ior, mpz_xor): Likewise. + (mpz_cmp): Fixed comparison of negative numbers. + +2012-02-27 Torbjorn Granlund + + * mpn/x86_64/fastsse/lshiftc.asm: New file. + * mpn/x86_64/fastsse/com.asm: New file. + + * mpn/x86_64/bd1/popcount.asm: New file. + * mpn/x86_64/bd1/hamdist.asm: New file. + + * mpn/x86_64/fastsse/copyi.asm: New file. + * mpn/x86_64/fastsse/copyd.asm: New file. + * mpn/x86_64/fastsse/lshift.asm: New file. + +2012-02-26 Torbjorn Granlund + + * mpn/x86_64/coreisbr/addmul_2.asm: New file. + + * tests/devel/try.c (param_init): Don't require addmul_N to handle + overlap. + + * mpn/x86_64/bd1/mul_1.asm: New file. + * mpn/x86_64/bd1/aorsmul_1.asm: New file. + +2012-02-26 Marco Bodrato + + * mpz/2fac_ui.c: New file: implements n!!. + * Makefile.am (MPZ_OBJECTS): Add mpz/2fac_ui. + * gmp-h.in: Declare mpz_2fac_ui. + * tests/mpz/t-fac.c: Test mpz_2fac_ui. + * doc/gmp.texi: Document mpz_2fac_ui. + * mpz/Makefile.am (libmpz_la_SOURCES): Add 2fac_ui.c. + + * mpz/oddfac_1.c (mpz_oddfac_1): Use umul_ppmm when size = 2. + +2012-02-26 Niels Möller + + * mini-gmp: New subdirectory. For use by GMP bootstrap, and as a + fallback for applications needing bignums but not high + performance. + + * bootstrap.c: New file, replacing dumbmp.c. Uses mini-gmp for the + standard GMP functions, and then defines the few functions + particular for the bootstrap. + * dumbmp.c: Deleted file. A few functions moved to bootstrap.c. + + * gen-bases.c: Include bootstrap.c, not dumbmp.c. + * gen-fac_ui.c: Likewise. + * gen-trialdivtab.c: Likewise. + * gen-fib.c: Include bootstrap.c, not dumbmp.c. Use assert rather + than ASSERT. Deleted casts of xmalloc return value. + * gen-psqr.c: Likewise. + (COLLAPSE_ELEMENT): Use memmove rather than mem_copyi. + + * Makefile.am: Replaced all uses of dumbmp.c by bootstrap.c. + (EXTRA_DIST, dist-hook): Arrange for distribution of the mini-gmp + files. + +2012-02-24 Marco Bodrato + + * mpz/invert.c: Use ABSIZ, MPZ_EQUAL_1_P. + * mpz/abs.c: Collapse MPZ_REALLOC(x,.) and PTR(x). + * mpz/aors_ui.h: Likewise. + * mpz/com.c: Likewise. + * mpz/neg.c: Likewise. + + * mpz/invert.c: Reply "no-inverse" when modulus is zero. + * tests/mpz/t-invert.c: Add more checks. + * doc/gmp.texi (mpz_invert): Inverse can not be zero. + +2012-02-24 Torbjorn Granlund + + * tests/mpn/logic.c: New file. + * tests/mpn/Makefile.am (check_PROGRAMS): Add logic. + + * tests/mpz/t-invert.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add t-invert. + +2012-02-24 Marc Glisse + + * tests/mpq/t-cmp.c: Move NUM and DEN macros... + * tests/mpq/t-cmp_ui.c: Likewise... + * gmp-impl.h: ... to here. + + * mpq/abs.c: Use NUM, DEN, SIZ, ALLOC, PTR, MPZ_REALLOC. + * mpq/aors.c: Likewise. + * mpq/canonicalize.c: Likewise. + * mpq/clear.c: Likewise. + * mpq/cmp.c: Likewise. + * mpq/cmp_si.c: Likewise. + * mpq/cmp_ui.c: Likewise. + * mpq/div.c: Likewise. + * mpq/equal.c: Likewise. + * mpq/get_d.c: Likewise. + * mpq/get_den.c: Likewise. + * mpq/get_num.c: Likewise. + * mpq/get_str.c: Likewise. + * mpq/init.c: Likewise. + * mpq/inp_str.c: Likewise. + * mpq/inv.c: Likewise. + * mpq/md_2exp.c: Likewise. + * mpq/mul.c: Likewise. + * mpq/neg.c: Likewise. + * mpq/set.c: Likewise. + * mpq/set_d.c: Likewise. + * mpq/set_den.c: Likewise. + * mpq/set_f.c: Likewise. + * mpq/set_num.c: Likewise. + * mpq/set_si.c: Likewise. + * mpq/set_str.c: Likewise. + * mpq/set_ui.c: Likewise. + * mpq/set_z.c: Likewise. + * mpq/swap.c: Likewise. + + * tests/mpq/t-inv.c: New test file. + * tests/mpq/Makefile.am: Add the above. + + * gmpxx.h (__gmp_set_expr): Use mpq_set_z. + + * mpq/md_2exp.c: Collapse MPZ_REALLOC(x,.) and PTR(x). + * mpq/set_d.c: Likewise. + * mpq/set_f.c: Likewise. + +2012-02-24 Niels Möller + + * mpn/x86_64/core2/aorsmul_1.asm: Added mpn_addmul_1c and + mpn_submul_1c entry points. + +2012-02-23 Marc Glisse + + * mpz/abs.c: Use ALLOC, SIZ, ABSIZ, PTR, MPZ_REALLOC. + * mpz/aors_ui.h: Likewise. + * mpz/array_init.c: Likewise. + * mpz/cdiv_q.c: Likewise. + * mpz/cdiv_qr.c: Likewise. + * mpz/cdiv_r.c: Likewise. + * mpz/clear.c: Likewise. + * mpz/clrbit.c: Likewise. + * mpz/cmp_si.c: Likewise. + * mpz/com.c: Likewise. + * mpz/fdiv_q.c: Likewise. + * mpz/fdiv_qr.c: Likewise. + * mpz/fdiv_r.c: Likewise. + * mpz/get_si.c: Likewise. + * mpz/get_str.c: Likewise. + * mpz/init.c: Likewise. + * mpz/inp_str.c: Likewise. + * mpz/iset.c: Likewise. + * mpz/iset_d.c: Likewise. + * mpz/iset_si.c: Likewise. + * mpz/iset_str.c: Likewise. + * mpz/iset_ui.c: Likewise. + * mpz/mod.c: Likewise. + * mpz/neg.c: Likewise. + * mpz/out_str.c: Likewise. + * mpz/random2.c: Likewise. + * mpz/set_si.c: Likewise. + * mpz/set_str.c: Likewise. + * mpz/set_ui.c: Likewise. + * mpz/setbit.c: Likewise. + * mpz/sqrt.c: Likewise. + * mpz/swap.c: Likewise. + * mpz/tdiv_r_2exp.c: Likewise. + + * tests/cxx/t-ops.cc: Test mpz_abs reallocation. + +2012-02-23 Torbjorn Granlund + + * mpn/x86_64/core2/rsh1aors_n.asm: Complete rewrite. + * mpn/x86_64/coreisbr/rsh1aors_n.asm: Move old core2 code here. + + * mpn/x86_64/redc_1.asm: Make it work for DOS64 (broken in last edit). + +2012-02-20 Marco Bodrato + + * mpn/generic/toom_interpolate_8pts.c: Compute carry iif non-trivial. + + * mpz/gcdext.c: Adapt to relaxed mpn_gcdext's input requirements. + + * mpz/and.c: Use mpn_ logic everywhere. Reduce branches. + * mpz/ior.c: Likewise. + * mpz/xor.c: Likewise. + +2012-02-20 Torbjorn Granlund + + * mpn/x86_64/coreisbr/mul_1.asm: New file. + + * mpn/x86_64/coreisbr/aorsmul_1.asm: New file. + + * mpn/x86_64/mod_34lsub1.asm: Avoid ",pt" branch hint since many + assemblers don't support it. + +2012-02-19 Torbjorn Granlund + + * mpn/generic/redc_1.c: Put back mpn_add_n call, return its carry. + Reintroduce previously removed RP argument. + * mpn/x86_64/redc_1.asm: Likewise. + + * mpn/generic/redc_2.c: Remove mpn_sub_n call, return carry from + mpn_add_n call. + + * gmp-impl.h (mpn_redc_1, mpn_redc_2): Now return an mp_limb_t. + + * tune/speed.h (SPEED_ROUTINE_REDC_1): Adopt to pass RP argument. + + * tests/refmpn.c (refmpn_redc_1): Adopt to new redc_1 interface. + + * mpn/generic/powm.c (MPN_REDC_1): Pass rp parameter to mpn_redc_1. + * mpn/generic/powm_sec.c (MPN_REDC_1_SEC): Likewise. + * mpn/generic/powm.c (MPN_REDC_2): New macro, use for mpn_redc_2. + +2012-02-18 Marc Glisse + + * gmpxx.h (std::common_type): New partial specialization in C++11. + * tests/cxx/t-cxx11.cc: Test it. + + * gmpxx.h: Don't declare long double functions that are never defined. + + * gmpxx.h (__gmp_binary_expr): Let things happen in place: q=q*q+z*z + becomes tmp=z*z, q=q*q, q+=tmp. + * tests/cxx/t-binary.cc: More variable reuse tests. + +2012-02-17 Marc Glisse + + * gmp-h.in (__GMP_WITHIN_GMP): Test with #ifdef instead of #if, for + the benefit of applications using gcc -Wundef. + (__GMP_WITHIN_GMPXX): Likewise. + +2012-02-16 Marc Glisse + + * gmpxx.h (__gmp_binary_expr): Let things happen in place: e=a*b-c*d + becomes tmp=c*d, e=a*b, e-=tmp. + * tests/cxx/t-binary.cc: More variable reuse tests. + +2012-02-15 Niels Möller + + * tune/tuneup.c (mul_toom43_to_toom54_threshold): New global. + (tune_mul): Added tuning of MUL_TOOM43_TO_TOOM54_THRESHOLD. + * tune/speed.h (SPEED_ROUTINE_MPN_TOOM43_FOR_TOOM54_MUL): New macro. + (SPEED_ROUTINE_MPN_TOOM54_FOR_TOOM43_MUL): New macro. + Prototypes for corresponding functions. + * tune/common.c (speed_mpn_toom43_for_toom54_mul): New function. + (speed_mpn_toom54_for_toom43_mul): New function. + + * gmp-impl.h (MPN_TOOM43_MUL_MINSIZE): Corrected constant. + (MPN_TOOM53_MUL_MINSIZE): Likewise. + (MPN_TOOM54_MUL_MINSIZE): New constant. + (mpn_toom54_mul): Added prototype. + (MUL_TOOM43_TO_TOOM54_THRESHOLD): New threshold. Default value and + tuning setup. + +2012-02-14 Niels Möller + + * mpn/generic/toom54_mul.c: New file, originally contributed by + Marco. + * gmp-impl.h (mpn_toom54_mul_itch): New function. + * configure.in (gmp_mpn_functions): Added toom54_mul. + * tests/mpn/t-toom54.c: New file. + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-toom54. + +2012-02-13 Niels Möller + + * configure.in: Display summary of options. + +2012-02-11 Torbjorn Granlund + + * tests/tests.h (TESTS_REPS): Print any non-standard repetitions. + +2012-02-11 Marco Bodrato + + * doc/gmp.texi (Factorial): Shortly describe current algorithm. + (Multiplication Algorithms): Add Toom[68]'n'half, (too) shortly. + * gmp-impl.h (ASSERT_ALWAYS): Consider failures UNLIKELY. + +2012-02-10 Niels Möller + + * tests/mpz/t-gcd.c (gcdext_valid_p): Enforce slightly stricter + bound for cofactors. + + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_hook): Corrected + handling of unlikely (maybe impossible?) case u1n < un. Related to + the 2012-02-05 bugfix of gcdext_subdiv_step.c in the gmp-5.0 repo. + +2012-02-09 Marco Bodrato + + * gmp-impl.h (mpn_toom3*_itch): Support any recursion depth. + * tests/refmpn.c (refmpn_mul): Restore tight allocations. + + * mpz/oddfac_1.c (mpz_oddfac_1): Get ready for n!! + * gmp-impl.h (mpz_oddfac_1): Update signature. + * mpz/fac_ui.c (mpz_fac_ui): Update call to mpz_oddfac_1. + +2012-02-09 Marc Glisse + + * gmp-impl.h (ABS_CAST): New macro. + * mpf/cmp_si.c: Use ABS_CAST. + * mpf/get_si.c: Use ABS_CAST. + * mpf/iset_si.c: Use ABS_CAST. + * mpf/set_si.c: Use ABS_CAST. + * mpq/set_si.c: Use ABS_CAST. + * mpz/cmp_si.c: Use ABS_CAST. + * mpz/get_si.c: Use ABS_CAST. + * mpz/iset_si.c: Use ABS_CAST. + * mpz/mul_i.h: Use ABS_CAST. + * mpz/set_si.c: Use ABS_CAST. + +2012-02-08 Torbjorn Granlund + + * mpn/powerpc32/divrem_2.asm: Fix off-by-one condition in invert_limb + code. + +2012-02-08 Niels Möller + + * doc/gmp.texi (mpz_gcdext): Clarified corner cases in cofactor + canonicalization. + +2012-02-07 Niels Möller + + * mpn/generic/gcdext.c (mpn_gcdext): Fixed assert, related to the + special case A = (2k+1) G, B = 2 G. Fix copied from gmp-5.0 repo. + +2012-02-06 Niels Möller + + * mpn/generic/hgcd_matrix.c (hgcd_matrix_update_q): Fixed carry + handling bug. Fix copied from gmp-5.0 repo, where the function is + found in hgcd.c. + + * tests/mpz/t-gcd.c (main): Use mpz_rrandomb for test operands, + not mpz_urandomb. Change copied from gmp-5.0 repo. + * tests/mpn/t-hgcd.c (main): Likewise. + +2012-02-04 Marco Bodrato + + * tests/refmpn.c (refmpn_mul): More conservative allocations. + +2012-02-03 Torbjorn Granlund + + * mpn/x86_64/bd1/gmp-mparam.h: New file. + + * longlong.h (udiv_qrnnd from sdiv_qrnnd): Declare udiv_w_sdiv. + + * mpn/generic/udiv_w_sdiv.c: Use c89 function header. + +2012-02-03 Marco Bodrato + + * mpz/fac_ui.c: mpz_oddfac_1 removed, with many related functions. + * mpz/oddfac_1.c: New file, mpz_oddfac_1 implementation. + * gmp-impl.h: mpz_oddfac_1 declaration. + * Makefile.am (MPZ_OBJECTS): add mpz/oddfac_1$U.lo . + * mpz/Makefile.am (libmpz_la_SOURCES): add oddfac_1.c . + * tune/Makefile.am (fac_ui.c): include mpz/oddfac_1.c . + +2012-02-02 Marco Bodrato + + * mpn/generic/toom_interpolate_16pts.c: Correct an unlikely 32-bit bug. + +2012-02-02 Torbjorn Granlund + + * mpn/generic/toom63_mul.c: Allow s+t==n by adjusting an ASSERT. + * mpn/generic/toom_interpolate_8pts.c: Perform final incr iff s+t!=n. + + * tests/mpn/t-toom6h.c (MIN_BN): Make more consistent with ASSERT in + tested function. + +2012-02-01 Torbjorn Granlund + + * tests/mpn/t-mul.c: New file. + * tests/mpn/Makefile.am: Compile it. + +2012-02-01 Marc Glisse + + * gmpxx.h: Remove check for g++ older than 2.91. + +2012-02-01 Niels Möller + + * mpn/generic/mul.c: Added diagram on where toom functions can be + called. + +2012-02-01 Marc Glisse + + * gmpxx.h (__gmp_unary_expr): Make the constructor explicit. + (__gmp_expr(__gmp_expr&&)): New move constructors. + (__gmp_expr::operator=(__gmp_expr&&)): New move assignments. + (swap): Mark as noexcept. + (__GMPXX_USE_CXX11): New macro. + (__GMPXX_NOEXCEPT): New macro. + * tests/cxx/t-cxx11.cc: New file. + * tests/cxx/Makefile.am: Added t-cxx11. + +2012-01-31 Torbjorn Granlund + + * mpn/generic/powm_sec.c (SQR_BASECASE_LIM): New name for + SQR_BASECASE_MAX. + (SQR_BASECASE_LIM, fat variant): Define to read __gmpn_cpuvec. + (SQR_BASECASE_LIM, native variant): Define to SQR_TOOM2_THRESHOLD + straight, without arithmetic. + (mpn_local_sqr): Use BELOW_THRESHOLD as per Marco's suggestion. + +2012-01-30 Torbjorn Granlund + + * tests/mpz/t-powm.c: Ensure all sizes are seen. + +2012-01-30 Marc Glisse + + * gmpxx.h (__gmp_binary_expr): Let things happen in place: d=a+b+c + when d != c. + * tests/cxx/t-binary.cc: Test variable reuse: c=a+b+c. + +2012-01-28 Marc Glisse + + * gmpxx.h: Don't compute -LONG_MIN. + + * doc/gmp.texi (gmp_randclass::get_z_bits): Use mp_bitcnt_t. + * gmpxx.h: Replace unsigned long with mp_bitcnt_t. + +2012-01-27 Torbjorn Granlund + + * Upgrade to libtool 2.4.2. + +2012-01-26 Marco Bodrato + + * tests/mpz/t-fac_ui.c: Increase default test cases. + + * mpz/prodlimbs.c: New file, mpz_prodlimbs implementation. + * gmp-impl.h: mpz_prodlimbs declaration. + * Makefile.am (MPZ_OBJECTS): add mpz/prodlimbs$U.lo . + * mpz/Makefile.am (libmpz_la_SOURCES): add prodlimbs.c . + (fac_ui.h): remove target (moved up one directory). + * mpz/fac_ui.c: mpz_prodlimbs removed, micro-optimisations. + +2012-01-25 Torbjorn Granlund + + * tune/tuneup.c: Remove unused tuneup variables. + +2012-01-20 Marco Bodrato + + * mpz/fac_ui.c: Reduce branches in basecases. + +2012-01-18 Marc Glisse + + * doc/gmp.texi (mpf_class::mpf_class): Use mp_bitcnt_t. + +2012-01-17 Torbjorn Granlund + + * configure.in: Add ultrasparc T4 support. + + * demos/isprime.c (main): Run 25 millerrabin tests. + +2012-01-16 Marco Bodrato + + * mpz/fac_ui.c (SIEVE_SEED): Define value for small limb size. + (mpz_oddswing_1): Reduce the number of divisions. + (mpz_oddfac_1): Reduce memory usage. + * mpn/minithres/gmp-mparam.h: Correct minimum for FAC_DSC_. + * tune/tuneup.c (tune_fac_ui): Likewise. + +2012-01-15 Niels Möller + + * mpz/scan0.c (mpz_scan0): Use ~(mp_bitcnt_t) 0, rather than + ULONG_MAX, when returning "infinity". + * mpz/scan1.c (mpz_scan1): Likewise. + +2012-01-12 Torbjorn Granlund + + * tests/t-popc.c: Test longer bit strings. + +2012-01-12 Marco Bodrato + + * mpz/divexact.c: Tight realloc, delayed if variables are reused. + * mpz/lcm.c: Smaller temp space, avoid goto. + * gmp-impl.h (popc_limb): avoid double & (for 8-bits limb). + +2012-01-10 Marco Bodrato + + * mpn/minithres/gmp-mparam.h: New FAC_ODD_ and FAC_DSC_ thresholds. + * tune/tuneup.c (tune_fac_ui): Correct minimum for FAC_DSC_. + +2012-01-07 Torbjorn Granlund + + * mpz/mul_2exp.c: Rewrite. + * mpz/tdiv_q_2exp.c: Rewrite. + +2012-01-05 Marco Bodrato + + * gen-fac_ui.c: Remove currently unused constants; add new odd + double factorial table. + * mpz/fac_ui.c (RECURSIVE_PROD_THRESHOLD): Increase default. + (mpz_oddfac_1): New function: a merge of _bc_odd and _dsc_odd. + (mpz_prodlimbs): More in-place computations. + + * tune/tuneup.c (tune_fac_ui): min_is_always for FAC_ODD_. + +2012-01-02 Marco Bodrato + + * tune/tuneup.c (tune_fac_ui): Compute FAC_DSC before FAC_ODD. + +2011-12-31 Torbjorn Granlund + + * Makefile.am (fac_ui.h): Put file in top-level dir, not in mpz. + +2011-12-31 Marco Bodrato + + * tune/Makefile.am (fac_ui.c): New target. + (nodist_tuneup_SOURCES,CLEANFILES): Add fac_ui.c. + * tune/tuneup.c (mpz_fac_ui_tune): Declare prototype. + (fac_odd_threshold,fac_dsc_threshold): New global variables. + (speed_mpz_fac_ui_tune,tune_fac_ui): New functions. + (all): Call tune_fac_ui. + * gmp-impl.h (FAC_ODD_THRESHOLD,FAC_DSC_THRESHOLD): + New thresholds: default values, and setup for tuning. + (FAC_DSC_THRESHOLD_LIMIT): Define (when tuning). + * mpz/fac_ui.c (FAC_ODD_THRESHOLD,FAC_DSC_THRESHOLD): + Default values removed. + +2011-12-30 Torbjorn Granlund + + * mpz/hamdist.c: Fix typo in a return statement. + + * mpn/generic/powm_sec.c (SQR_BASECASE_MAX): Set safely from + SQR_TOOM2_THRESHOLD. + +2011-12-17 Torbjorn Granlund + + * tests/mpz/t-perfpow.c: Decrease default # of tests. + +2011-12-16 Torbjorn Granlund + + * tests/refmpn.c (AORS_1): Fix typo in variable type. + +2011-12-10 Torbjorn Granlund + + * mpn/generic/sbpi1_bdiv_q.c: Delay quotient limb stores in order to + allow quotient and dividend to completely overlap. + * mpn/generic/sbpi1_bdiv_qr.c: Likewise. + +2011-12-10 Marco Bodrato + + * mpz/fac_ui.c: fac_bc_ui inlined in fac_ui. + +2011-12-08 Torbjorn Granlund + + * mpn/generic/powm_sec.c: Handle fat binaries better. + + * mpz/fac_ui.c (mpz_bc_fac_1): Fix typo in allocation size. + + * mpn/x86/fat/com.c: New file. + + * mpn/x86_64/pentium4/aors_n.asm: Make it actually work for DOS64. + * mpn/x86_64/pentium4/rsh1aors_n.asm: Conditionalise jump on DOS64 + to avoid overhead for standard ABIs. + + * mpn/x86_64/gcd_1.asm: Support DOS64. + +2011-12-07 Torbjorn Granlund + + * configure.in: Fix typo making HAVE_NATIVE_mpn_X fail for fat + functions. + + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec_init): Add a missing break. + +2011-12-07 Marco Bodrato + + * gen-fac_ui.c: Generate two more tables: odd factorial, swing. + + * mpz/fac_ui.c: Rewrite. + +2011-12-06 Niels Möller + + * mpn/generic/hgcd.c (mpn_hgcd): Use hgcd_reduce for first + recursive call. + +2011-12-06 Torbjorn Granlund + + * tune/mod_1_1-1.c: Redefine the mpn_ functions, not __gmpn_ (for the + benefit of fat builds). + * tune/mod_1_1-2.c: Likewise. + +2011-12-05 Torbjorn Granlund + + * mpn/x86/fat/lshiftc.c: New file. + * mpn/x86/fat/mod_1_1.c: New file. + * mpn/x86/fat/mod_1_2.c: New file. + * mpn/x86/fat/mod_1_4.c: New file. + + * mpn/x86/fat/diveby3.c: Remove no longer fat function. + * mpn/x86_64/fat/diveby3.c: Likewise. + + * mpn/x86_64/fat/gcd_1.c: Remove since always provided as asm. + * mpn/x86_64/fat/mode1o.c: Likewise. + + * configure.in (fat_functions): Update to more relevant function set. + Add special handling for mod_1_N_cps functions. + * gmp-impl.h (struct cpuvec_t) : Corresponding changes. Also add + vrious declarations for new functions. + * mpn/x86/x86-defs.m4 (CPUVEC_FUNCS_LIST): Corresponding changes. + * mpn/x86_64/x86_64-defs.m4 (CPUVEC_FUNCS_LIST): Corresponding changes. + * mpn/x86/fat/fat.c (__gmpn_cpuvec): Corresponding changes. + * mpn/x86_64/fat/fat.c (__gmpn_cpuvec): Corresponding changes. + + * mpn/x86_64: Port most remaining x86_64 files to DOS64. + + * mpn/x86_64/coreisbr/aors_n.asm: Add forgotten DOS64_EXIT. + + * mpn/x86_64/x86_64-defs.m4 (LEA): Handle non-PIC code. + * mpn/x86_64/darwin.m4 (LEA): Likewise. + +2011-12-04 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c (MAKE_FMS): Rewrite to handle modern CPUs. + * mpn/x86/fat/fat.c (MAKE_FMS): Likewise. + + * mpn/x86_64/darwin.m4 (PROTECT): Define to potentially useful value. + +2011-12-02 Torbjorn Granlund + + * mpn/x86_64/invert_limb_table.asm: Use PROTECT. + * mpn/x86_64/invert_limb.asm: Likewise. + + * mpn/x86_64/darwin.m4 (PROTECT, IFELF): New defines. + * mpn/x86_64/dos64.m4 (PROTECT, IFELF): New defines. + * mpn/x86_64/x86_64-defs.m4 (PROTECT, IFELF): New defines. + +2011-12-01 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c: Copy fake cpuid code from x86/fat/fat.c. + + * mpn/x86_64 (STD64, IFSTD): New names for ELF64, IFELF (since these + denote all standard calling conventions). + + * mpn/x86_64: Add DOS64 ABI support to more files. + + * mpn/x86_64/mod_1_1.asm: Finish DOS64 support. + * mpn/x86_64/mod_1_2.asm: Likewise. + * mpn/x86_64/mod_1_4.asm: Likewise. + + * configure.in: Add GMP_NONSTD_ABI also for fat builds. + + * mpn/x86_64/fat/fat_entry.asm: Rewrite to support DOS64. + + * mpn/x86_64/dos64.m4 (IFDOS, IFSTD): New defines. + * mpn/x86_64/x86_64-defs (IFDOS, IFSTD): New defines. + + * mpn/x86_64/dive_1.asm: Add DOS64 ABI support. + * mpn/x86_64/mode1o.asm: Likewise. + + * mpn/x86_64/mod_34lsub1.asm: Enable for DOS64. + + * mpn/x86_64/invert_limb.asm: Wrap .protected decl. + + * gmp-impl.h (DECL_divexact_1): Fix typo in return type. + + * mpn/x86_64/dos64.m4 (LEA): New define. + (PIC): Define. + +2011-11-29 Torbjorn Granlund + + * mpn/x86_64: Add DOS64 ABI support to most files. + +2011-11-28 Torbjorn Granlund + + * mpn/x86_64/mul_basecase.asm: Support ABI DOS64. + * mpn/x86_64/sqr_basecase.asm: Support ABI DOS64. + * mpn/x86_64/aorsmul_1.asm: Support ABI DOS64. + * mpn/x86_64/mul_1.asm: Support ABI DOS64. + + * mpn/x86_64/x86_64-defs.m4 (DOS64_ENTRY, DOS64_EXIT): New, empty defs. + + * mpn/x86_64/dos64.m4: New file. + + * mpn/asm-defs.m4 (ABI_SUPPORT): New dummy macro. + + * configure.in (64-bit mingw/cygwin): Define HOST_DOS64,GMP_NONSTD_ABI. + No longer clear out path_64. + (mpn code selection loop): Handle GMP_NONSTD_ABI. + + * mpn/generic/udiv_w_sdiv.c: Use CNST_LIMB for some constants. + +2011-11-25 Torbjorn Granlund + + * x86/*: Many new gmp-mparam.h file for 64-bit CPUs in 32-bit mode. + + * configure.in: Overhaul x86/x86_64 support, merging three case + statements into one. + +2011-11-24 Torbjorn Granlund + + * doc/gmp.texi (Formatted Output Strings): Clarify rules for mpf_t + precision. + + * mpn/powerpc32/p7/gmp-mparam.h: New file. + + * tune/tuneup.c (tune_mu_div, tune_mu_bdiv): Up min_size to karatsuba's + threshold. + +2011-11-22 Torbjorn Granlund + + * mpn/powerpc64/mode64/p6/aorsmul_1.asm: New file. + + * configure.in: Don't fail fat builds under 64-bit DOS. + + * mpn/powerpc64/mode64/aors_n.asm: Align loop for slightly better + power5 performance. + +2011-11-21 Torbjorn Granlund + + * gmp-h.in (__GNU_MP_RELEASE): Renamed from typo name. + +2011-11-20 Torbjorn Granlund + + * configure.in: Split x86 CPUs into more subtypes for more accurate + passing of gcc flags. + + * mpn/powerpc32/p3-p7/aors_n.asm: New file. + + * configure.in: Pass -m32 for powerpc64 with abi=32, using via _maybe + mechanism. + + * configure.in: Support powerpc32/p3-p7 directory for affected CPUs. + +2011-11-17 Torbjorn Granlund + + * tune/speed.c (routine): Add mpn_tabselect. + * tune/common.c (speed_mpn_tabselect): New function. + * tune/speed.h (SPEED_ROUTINE_MPN_COPY_CALL): New macro, made from + old SPEED_ROUTINE_MPN_COPY. + (SPEED_ROUTINE_MPN_COPY): Just invoke SPEED_ROUTINE_MPN_COPY_CALL. + (SPEED_ROUTINE_MPN_TABSELECT): New macro. + +2011-11-17 Niels Möller + + * tune/tuneup.c (tune_hgcd_appr): Increase stop_since_change. + +2011-11-16 Torbjorn Granlund + + * mpn/powerpc32/tabselect.asm: New file. + + * mpn/powerpc64/mode64/aorscnd_n.asm: New file. + +2011-11-15 Niels Möller + + * tune/speed.h (speed_mpn_hgcd_appr_lehmer): New prototype. + (mpn_hgcd_lehmer_itch): Likewise. + (mpn_hgcd_appr_lehmer): Likewise. + (mpn_hgcd_appr_lehmer_itch): Likewise. + (MPN_HGCD_LEHMER_ITCH): Deleted macro. + + * tune/speed.c (routine): Added mpn_hgcd_appr_lehmer. + + * tune/common.c (speed_mpn_hgcd_lehmer): Use mpn_hgcd_lehmer_itch + rather than similarly named macro. + (speed_mpn_hgcd_appr_lehmer): New function. + + * tune/Makefile.am (libspeed_la_SOURCES): Added + hgcd_appr_lehmer.c. + + * tune/hgcd_appr_lehmer.c: New file. + + * tune/tuneup.c (tune_hgcd_appr): Increased min_size to 50; some + machines got small thresholds which appear to be bogus. + +2011-11-15 Torbjorn Granlund + + * mpn/generic/powm_sec.c (mpn_local_sqr): Remove forgotten TMP_* calls. + (redcify): Likewise. + (mpn_powm_sec): Likewise. + + * mpn/generic/powm_sec.c (mpn_powm_sec): Rework scratch usage + (mpn_powm_sec_itch): Rewrite. + + * mpn/generic/powm_sec.c (mpn_powm_sec): Use mpn_tabselect also in + initialisation. + + * configure.in: Amend 2011-11-03 gcc_cflags change. + + * mpn/powerpc64/tabselect.asm: New file. + * mpn/x86_64/tabselect.asm: New file. + * mpn/x86/tabselect.asm: New file. + * mpn/ia64/tabselect.asm: New file. + + * mpn/asm-defs.m4 (define_mpn): Add tabselect. + + * configure.in (gmp_mpn_functions): Add tabselect. + (HAVE_NATIVE): Add entries for addncd_n, subcnd_n, tabselect. + + * mpn/generic/powm_sec.c: Remove mpn_tabselect implementation. + * mpn/generic/tabselect.c: New file with removed code. + +2011-11-13 Torbjorn Granlund + + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add powm_sec.c. + + * mpn/generic/powm_sec.c (win_size): Use POWM_SEC_TABLE + (POWM_SEC_TABLE): Define default. + + * tune/tuneup.c (tune_powm_sec): New function computing POWM_SEC_TABLE. + (all): Call new function. + + * mpn/generic/powm_sec.c (win_size): Define only when + TUNE_PROGRAM_BUILD is not set. + +2011-11-13 Niels Möller + + * tune/tuneup.c (tune_hgcd_appr): Use default min_size. + (tune_hgcd_reduce): Increase max_size and step_factor, to 7000 + and 0.04, respectively. + +2011-11-11 Torbjorn Granlund + + * mpn/powerpc64/mode64/sqr_diag_addlsh1.asm: Remove. + +2011-11-11 Niels Möller + + * tune/hgcd_reduce_2.c: New file. + * tune/hgcd_reduce_1.c: New file. + + * tune/tuneup.c (hgcd_appr_threshold): New threshold variable. + (hgcd_reduce_threshold): Likewise. + (tune_hgcd_appr): New function. + (tune_hgcd_reduce): New function. + (all): Call tune_hgcd_appr and tune_hgcd_reduce. + + * tune/speed.h (speed_mpn_hgcd_reduce): Declaration. + (speed_mpn_hgcd_reduce_[12]): Likewise. + (mpn_hgcd_reduce_[12]): Likewise. + (SPEED_ROUTINE_MPN_HGCD_REDUCE_CALL): New macro. + + * tune/speed.c (routine): Added mpn_hgcd_reduce, + mpn_hgcd_reduce_1, and mpn_hgcd_reduce_2. + + * tune/common.c (speed_mpn_hgcd_reduce): New function. + (speed_mpn_hgcd_reduce_[12]): Likewise. + + * tune/Makefile.am (libspeed_la_SOURCES): Added hgcd_reduce_1.c + hgcd_reduce_2.c. + (TUNE_MPN_SRCS_BASIC): Added hgcd_appr.c and hgcd_reduce.c. + + * mpn/generic/hgcd_appr.c (submul, hgcd_matrix_apply): Deleted + functions, earlier copied to hgcd_reduce.c. + (mpn_hgcd_appr): Use hgcd_reduce. + +2011-11-09 Torbjorn Granlund + + * mpn/powerpc64/mode64/sqr_basecase.asm: New file. + + * mpn/x86_64/aorscnd_n.asm: New file. + + * tune/speed.c (routine): Add measuring of mpn_addcnd_n, mpn_subcnd_n. + * tune/common.c (speed_mpn_addcnd_n,speed_mpn_subcnd_n): New functions. + * tune/speed.h: Declare them. + + * tests/devel/try.c: Add tests for mpn_addcnd_n and mpn_subcnd_n. + * tests/refmpn.c (refmpn_addcnd_n, refmpn_subcnd_n): New functions. + * tests/tests.h: Declare them. + + * configure.in (gmp_mpn_functions): Add addcnd_n and subcnd_n. + +2011-11-07 Torbjorn Granlund + + * mpn/generic/redc_1.c: Just reduce U operand using Hensel norm, but + not fully canonically; leave add_n and conditional sub_n to caller. + Therefore omit R argument. + + * mpn/generic/redc_1_sec.c: Remove. + + * gmp-impl.h (mpn_redc_1): Update declaration. + (mpn_redc_1_sec): Remove declaration. + + * configure.in (gmp_mpn_functions): Remove redc_1. + + * mpn/x86_64/redc_1.asm: Adopt to new defined functionality/interface. + * tune/speed.h (SPEED_ROUTINE_REDC_1): Likewise. + + * tests/refmpn.c (refmpn_redc_1): Likewise; also call refmpn_addmul_1 + instead of mpn_addmul_1. + + * mpn/generic/powm.c (MPN_REDC_1): New macro, use for mpn_redc_1. + * mpn/generic/powm_sec.c (MPN_REDC_1_SEC): New macro, use for + mpn_redc_1_sec. + +2011-11-03 Torbjorn Granlund + + * dumbmp.c (mpz_sub): Abort for non-handled case. + + * mpn/powerpc64/mode64/lshiftc.asm: Move file from here... + * mpn/powerpc64/lshiftc.asm: ...to here, with trivial modifications. + + * configure.in: Pass -m32 in more cases, using _maybe mechanism. + Inherit default gcc_cflags in more places. + + * mpn/powerpc64/mode64/p7/gmp-mparam.h: New file. + +2011-11-02 Torbjorn Granlund + + * mpn/s390_64/invert_limb.asm: Slight optimisation. + + * configure.in (s390): Set gcc_32_cflags_maybe. + + * mpn/s390_32/gmp-mparam.h: Put in proper data. + * mpn/s390_32/esame/gmp-mparam.h: New file. + + * mpn/x86_64/bobcat/gmp-mparam.h: New file. + + * mpn/s390_32/lshift.asm: New file. + * mpn/s390_32/rshift.asm: New file. + * mpn/s390_32/lshiftc.asm: New file. + +2011-10-31 Torbjorn Granlund + + * mpn/powerpc64/sqr_diagonal.asm: Move from here... + * mpn/powerpc64/mode32/sqr_diagonal.asm: ...to here. + + * mpn/powerpc64/mode64/sqr_diag_addlsh1.asm: New file. + + * mpn/s390_64/sqr_basecase.asm: Rewrite sqr_diag_addlsh1 code. + * mpn/s390_32/esame/sqr_basecase.asm: Likewise. + +2011-10-29 Torbjorn Granlund + + * mpn/s390_64/lshift.asm: Complete rewrite. + * mpn/s390_64/rshift.asm: Likewise. + + * mpn/s390_64/lshiftc.asm: New file. + +2011-10-28 Torbjorn Granlund + + * mpn/s390_32/esame/aors_n.asm: New file, with rewritten add/sub code. + +2011-10-27 Torbjorn Granlund + + From Per Olofsson: + * gmp-impl.h (BSWAP_LIMB): Rename variable to avoid BSWAP_LIMB_FETCH + clash. + + * mpn/s390_32/esame/mul_basecase.asm: New file. + + * mpn/s390_32/esame/sqr_basecase.asm: New file. + + * mpn/s390_32/logops_n.asm: New file. + + * mpn/s390_64/logops_n.asm: Fix rp=up code. Remove a leftover insn. + +2011-10-26 Niels Möller + + * gmp-impl.h (mpn_hgcd_reduce, mpn_hgcd_reduce_itch): Added + prototypes. + (HGCD_APPR_THRESHOLD): Set up threshold for tuning. + (HGCD_REDUCE_THRESHOLD): Likewise. + + * configure.in (gmp_mpn_functions): Added hgcd_reduce. + + * mpn/generic/hgcd_reduce.c: New file. + +2011-10-24 Torbjorn Granlund + + * mpn/x86_64/sqr_basecase.asm: Put intermediate result into R, don't + allocate any stack space. + +2011-10-23 Torbjorn Granlund + + * mpn/s390_64/logops_n.asm: Use nc, oc, xc when possible. + + * tune/common.c (speed_mpn_and_n, speed_mpn_andn_n, etc): + Pass correct input args. + + * mpn/s390_64/mod_34lsub1.asm: Use llgfr for zero extensions. + + * mpn/s390_64/mul_basecase.asm: New file. + + * mpn/s390_64/sqr_basecase.asm: New file. + * mpn/s390_64/sqr_diag_addlsh1.asm: Removed, lives on in sqr_basecase. + + * mpn/s390_64/bdiv_dbm1c.asm: Shave off 1 c/l. + + * mpn/s390_64/aorrlsh1_n.asm: New file, developed from aorslsh1_n.asm. + * mpn/s390_64/sublsh1_n.asm: New file. + * mpn/s390_64/aorslsh1_n.asm: Remove file. + +2011-10-22 Torbjorn Granlund + + * mpn/s390_64/logops_n.asm: New file. + + * mpn/s390_64/aors_n.asm: New file, with rewritten add/sub code. + +2011-10-20 Torbjorn Granlund + + * tune/speed.h (SPEED_ROUTINE_MPN_SQR_DIAL_ADDLSH1_CALL): New macro. + * tune/common.c (speed_mpn_sqr_diag_addlsh1): New function. + * tune/speed.c (routine): Measure mpn_sqr_diag_addlsh1. + + * mpn/s390_64/sqr_diag_addlsh1.asm: Rewrite like s390_32/esame code. + + * mpn/s390_32/esame/sqr_diag_addlsh1.asm: Save just needed registers. + +2011-10-19 Torbjorn Granlund + + * mpn/s390_32/esame/add_n.asm: Rewrite, similar to s390_64 code. + * mpn/s390_32/esame/add_n.asm: Likewise. + +2011-10-17 Torbjorn Granlund + + * mpn/s390_32/esame/aorslsh1_n.asm: New file. + +2011-10-16 Torbjorn Granlund + + * mpn/s390_32/esame/sqr_diag_addlsh1.asm: New file. + + * mpn/s390_32/copyi.asm: New file. + * mpn/s390_32/copyd.asm: New file. + + * mpn/s390_64/copyd.asm: Optimise. + + * mpn/s390_64/copyi.asm: Rewrite along the lines of glibc memcpy. + + * mpn/s390_64/aorslsh1_n.asm: New file. + + * mpn/s390_64/mod_34lsub1.asm: New file. + + * mpn/s390_64/sqr_diag_addlsh1.asm: New file. + +2011-10-15 Torbjorn Granlund + + * configure.in (s390): Rewrite support to handle known CPUs. + * config.guess: Recognise s390 CPUs. + * config.sub: Match s390 CPUs. + * acinclude.m4 (S390_PATTERN, S390X_PATTERN): New defines. + +2011-10-14 Torbjorn Granlund + + From Per Olofsson: + * mpn/generic/popham.c: Add __GMP_NOTHROW to make it match gmp.h. + * mpn/generic/gcd_1.c: Separate declarations and initialisers for the + benefit of C++. + + * configure.in: AC_DEFINE HAVE_HOST_CPU_s390_zarch. + * longlong.h (s390): Use it. + (s390 umul_ppmm): Fix typo in pure C variant. + +2011-10-13 Torbjorn Granlund + + * longlong.h (s390): Put back an accidentally deleted #else. + + * configure.in (s390): Unset extra_functions for s390x. + +2011-10-12 Torbjorn Granlund + + * mpn/s390_64/lshift.asm: Reduce register usage. + * mpn/s390_64/rshift.asm: Likewise. + + * longlong.h (s390 umul_ppmm): With new-enough gcc, avoid asm. + + From Andreas Krebbel: + * longlong.h (s390 umul_ppmm): Support 32-bit limbs with gcc using + 64-bit registers. + (s390 udiv_qrnnd): Likewise. + +2011-10-11 Torbjorn Granlund + + * configure.in (s390x): Pass -mzarch to gcc in 32-bit mode. + + * longlong.h (s390x): Add __CLOBBER_CC for relevant asm patterns. + * mpn/generic/mod_1_1.c (s390x add_mssaaaa): Likewise. + + * mpn/s390_64/copyd.asm: New file. + +2011-10-10 Niels Möller + + * mpn/generic/hgcd_appr.c: Deleted debugging code. + + * tests/mpn/t-hgcd_appr.c (main): Added -v flag. + (hgcd_appr_valid_p): Increased margin of non-minimality for + divide-and-conquer algorithm. Display bit counts only if + -v is used. + + * mpn/generic/hgcd_appr.c (submul): New (static) function. + (hgcd_matrix_apply): New function. + (mpn_hgcd_appr_itch): Account for divide-and-conquer algorithm. + (mpn_hgcd_appr): Implemented divide-and-conquer. + +2011-10-10 Torbjorn Granlund + + * mpn/generic/mod_1_1.c (add_mssaaaa): Add s390x variant. Put arm code + inside __GNUC__. + + * tune/time.c (STCK): Use proper memory constraint. + + From Marco Trudel: + * tests/mpz/t-scan.c (check_ref): Fix loop end bound. + +2011-10-10 Niels Möller + + * gmp-impl.h: (HGCD_APPR_THRESHOLD): New threshold. + + * mpn/generic/hgcd_appr.c (mpn_hgcd_appr): Interface change. + Destroy inputs, let caller make working copies if needed. + (mpn_hgcd_appr_itch): Reduced scratch need. + * gmp-impl.h: Updated mpn_hgcd_appr prototype. + * tests/mpn/t-hgcd_appr.c (one_test): Make working copies for + hgcd_appr. + * tune/common.c (speed_mpn_hgcd_appr): Use SPEED_ROUTINE_MPN_HGCD_CALL. + * tune/speed.h (SPEED_ROUTINE_MPN_HGCD_APPR_CALL): Deleted. + +2011-10-09 Torbjorn Granlund + + * mpn/s390_64/copyi.asm: New file. + * mpn/s390_64/lshift.asm: New file. + * mpn/s390_64/rshift.asm: New file. + + * mpn/s390_64/add_n.asm: Rewrite using lmg/stmg. + * mpn/s390_64/sub_n.asm: Likewise. + + * mpn/s390_64/invert_limb.asm: Save a callee-saves register less. + + * tune/time.c (getrusage_backwards_p): Properly cast printed values. + + * longlong.h (s390x): Put back UDItype casts to make gcc reloading use + right more for constants. + (s390x count_leading_zeros): Disable until we support z10 specifically. + (s390x add_ssaaaa): Remove algsi/slgsi until we support z10. + +2011-10-09 Niels Möller + + * mpn/generic/hgcd_matrix.c (mpn_hgcd_matrix_adjust): Declare + matrix argument const. + +2011-10-08 Niels Möller + + * tests/mpn/t-hgcd_appr.c (hgcd_appr_valid_p): Adjusted the + allowed margin of non-minimality for hgcd_appr. + + * mpn/generic/hgcd_appr.c (mpn_hgcd_appr): Fixed handling of + extra_bits, starting at zero, to ensure that we don't produce too + small remainders. Added a final reduction loop when we we + otherwise terminate with extra_bits > 0, to make the returned + remainders closer to minimal. + +2011-10-07 Torbjorn Granlund + + * longlong.h (s390): Add 32-bit zarch umul_ppmm and udiv_qrnnd. + (s390): Overhaul 32-bit and 64-bit code. + +2011-10-07 Niels Möller + + * tune/speed.h (speed_mpn_hgcd_appr): New prototype. + (SPEED_ROUTINE_MPN_HGCD_APPR_CALL): New macro. + * tune/common.c (speed_mpn_hgcd_appr): New function. + * tune/speed.c (routine): Added mpn_hgcd_appr. + + * tests/mpn/t-hgcd_appr.c: New file. + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-hgcd_appr. + + * configure.in (gmp_mpn_functions): Added hgcd_step and hgcd_appr. + + * gmp-impl.h: Added prototypes for mpn_hgcd_step, + mpn_hgcd_appr_itch and mpn_hgcd_appr. + + * mpn/generic/hgcd_appr.c: New file. + + * mpn/generic/hgcd_step.c: New file, extracted from hgcd.c. + (mpn_hgcd_step): Renamed, from... + * mpn/generic/hgcd.c (hgcd_step): ...old name. Renamed and moved + to hgcd_step.c. + (hgcd_hook): Also moved to hgcd_step.c. + (mpn_hgcd): Updated for hgcd_step renaming. + +2011-10-06 Torbjorn Granlund + + * mpn/s390_64/invert_limb.asm: New file. + +2011-10-04 Torbjorn Granlund + + * mpn/s390_64/submul_1.asm: New file. + * mpn/s390_32/esame/submul_1.asm: New file. + + * mpn/generic/mulmid.c (mpn_mulmid): Move a TMP_DECL to block start. + + * mpn/Makefile.am (TARG_DIST): Add s390_32 and s390_64, remove s390 and + z8000x. + + * doc/gmp.texi (Custom Allocation): Rephrase a paragraph. + + * demos/factorize.c: Run 25 Miller-Rabin tests. + + * mpz/nextprime.c: Run 25 mpz_millerrabin tests (was 10). + +2011-10-03 Torbjorn Granlund + + * configure.in: Support s390x. + + * longlong.h: Add support for 64-bit s390x. + + * mpn/s390_64: New directory. + * mpn/s390_64/add_n.asm: New file. + * mpn/s390_64/sub_n.asm: New file. + * mpn/s390_64/mul_1.asm: New file. + * mpn/s390_64/addmul_1.asm: New file. + * mpn/s390_64/bdiv_dbm1c.asm: New file. + * mpn/s390_64/gmp-mparam.h: New file, taken from x86_64. + + * mpn/s390_32: Directory renamed from mpn/s390. + * mpn/s390_32/gmp-mparam.h: New file, taken from x86_64. + * mpn/s390_32/esame/add_n.asm: New file. + * mpn/s390_32/esame/sub_n.asm: New file. + * mpn/s390_32/esame/mul_1.asm: New file. + * mpn/s390_32/esame/addmul_1.asm: New file. + * mpn/s390_32/esame/bdiv_dbm1c.asm: New file. + +2011-10-03 Niels Möller + + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-mulmid. + * tests/mpn/t-mulmid.c: New file. + + mulmid-related assembly for x86_64, from David Harvey: + * mpn/asm-defs.m4 (define_mpn): Added [add,sub]_err[1,2,3]_n and + mulmid_basecase. Also use m4_not_for_expansion on the + corresponding OPERATION_* symbols. + * mpn/x86_64/aors_err1_n.asm: New file. + * mpn/x86_64/aors_err2_n.asm: Likewise. + * mpn/x86_64/aors_err3_n.asm: Likewise. + * mpn/x86_64/mulmid_basecase.asm: Likewise. + * mpn/x86_64/core2/aors_err1_n.asm: Likewise. + * mpn/x86_64/gmp-mparam.h (MULMID_TOOM42_THRESHOLD): New value. + * mpn/x86_64/core2/gmp-mparam.h (MULMID_TOOM42_THRESHOLD): Likewise. + + Tuning of mulmid, from David Harvey: + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Added mulmid.c + mulmid_n.c toom42_mulmid.c. + * tune/speed.h: Prototypes for mulmid-related functions. + (struct speed_params): Increased max number of sources to 5. + (SPEED_ROUTINE_MPN_BINARY_ERR_N_CALL): New macro. + (SPEED_ROUTINE_MPN_BINARY_ERR1_N): Likewise. + (SPEED_ROUTINE_MPN_BINARY_ERR2_N): Likewise. + (SPEED_ROUTINE_MPN_BINARY_ERR3_N): Likewise. + (SPEED_ROUTINE_MPN_MULMID): Likewise. + (SPEED_ROUTINE_MPN_MULMID_N): Likewise. + (SPEED_ROUTINE_MPN_TOOM42_MULMID): Likewise. + * tune/common.c (mpn_[add,sub]_err[1,2,3]_n): New functions. + (speed_mpn_mulmid_basecase): New function. + (speed_mpn_mulmid): New function. + (speed_mpn_mulmid_n): New function. + (speed_mpn_toom42_mulmid): New function. + * tune/speed.c (routine): Added mpn_[add,sub]_err[1,2,3]_n, + mpn_mulmid_basecase, mpn_toom42_mulmid, mpn_mulmid_n, and + mpn_mulmid. + * tune/tuneup.c (mulmid_toom42_threshold): New threshold variable. + (tune_mulmid): New function. + (all): Call tune_mulmid. + + Testing of mulmid, from David Harvey: + * tests/refmpn.c (AORS_ERR1_N): New macro. + (refmpn_add_err1_n, refmpn_sub_err1_n): New functions. + (AORS_ERR2_N): New macro. + (refmpn_add_err2_n, refmpn_sub_err2_n): New functions. + (AORS_ERR3_N): New macro. + (refmpn_add_err3_n, refmpn_sub_err3_n): New functions. + (refmpn_mulmid_basecase): New function. + (refmpn_toom42_mulmid): New function, wrapper for + refmpn_mulmid_basecase. + (refmpn_mulmid_n): Likewise. + (refmpn_mulmid): Likewise. + * tests/tests.h: Prototypes for new functions. + * tests/devel/try.c (NUM_SOURCES): Increased to 5. + (struct try_t): Use NUM_SOURCES and NUM_DESTS constants. + (SIZE_4, SIZE_6, SIZE_DIFF_PLUS_3, SIZE_ODD): New constants. + (OVERLAP_NOT_DST2): New flag. + (param_init): New mulmid-related operation types. + (mpn_toom42_mulmid_fun): New function. + (choice_array): Added mulmid-related entries. + (overlap_array): Extended for larger NUM_SOURCES. + (OVERLAP_COUNT): Handle OVERLAP_NOT_DST2. + (call): Support mulmid-related functions. + (pointer_setup): Handle SIZE_4, SIZE_6, and SIZE_DIFF_PLUS_3. + (SIZE_ITERATION): Handle SIZE_ODD. + (SIZE2_FIRST): Handle SIZE_CEIL_HALF. + (SIZE2_LAST): Likewise. + + Implementation of mulmid, from David Harvey: + * mpn/generic/add_err1_n.c (mpn_add_err1_n): New file and function. + * mpn/generic/add_err2_n.c (mpn_add_err2_n): Likewise. + * mpn/generic/add_err3_n.c (mpn_add_err3_n): Likewise. + * mpn/generic/sub_err1_n.c (mpn_sub_err1_n): Likewise. + * mpn/generic/sub_err2_n.c (mpn_sub_err2_n): Likewise. + * mpn/generic/sub_err3_n.c (mpn_sub_err3_n): Likewise. + * mpn/generic/mulmid_basecase.c (mpn_mulmid_basecase): Likewise. + * mpn/generic/mulmid_n.c (mpn_mulmid_n): Likewise. + * mpn/generic/toom42_mulmid.c (mpn_toom42_mulmid): Likewise. + * configure.in (gmp_mpn_functions): Added mulmid-related + functions. + (GMP_MULFUNC_CHOICES): Handle aors_err1_n, aors_err2_n, and + aors_err3_n. + * gmp-impl.h: Added prototypes for mulmid functions. + (MPN_TOOM42_MULMID_MINSIZE): New constant. + (MULMID_TOOM42_THRESHOLD): New threshold. + (mpn_toom42_mulmid_itch): New macro. + +2011-10-03 Niels Möller + + * tune/tune-gcd-p.c (main): Fixed broken loop conditions. + +2011-09-26 Torbjorn Granlund + + * mpn/sh/sh2/submul_1.asm: Make this old submul_1 implementation + actually compute intended function. + + * longlong.h (SH): Recognise predefs for all SH processors as defined + by current gcc versions. + +2011-09-25 Torbjorn Granlund + + * mpn/sh: Migrate files to '.asm'. + * configure.in: Recognise sh3 and sh4. + +2011-09-21 Marc Glisse + + * gmpxx.h (mpz_class::swap): New function. + (mpq_class::swap): Likewise. + (mpf_class::swap): Likewise. + (swap): New function. + * tests/cxx/t-assign.cc: Test the above. + * doc/gmp.texi (swap): Document the above. + +2011-08-21 Marc Glisse + + * tests/cxx/t-ops2.cc: check mul-div by 2. + + * gmpxx.h (__GMPXX_CONSTANT): New macro (__builtin_constant_p). + (__gmp_binary_lshift): Move before multiplication. Optimize x << 0. + (__gmp_binary_rshift): Move before division. Optimize x >> 0. + (__gmp_binary_plus): Optimize x + 0. Rewrite rational + integer. + (__gmp_binary_minus): Optimize x - 0 and 0 - x. + Rewrite rational - integer. + (__gmp_binary_multiplies): Optimize x * 2^n. + (__gmp_binary_divides): Optimize x / 2^n. + (__gmp_binary_*): Deduplicate code for symmetric operations. + +2011-08-18 Torbjorn Granlund + + * printf/doprntf.c (__gmp_doprnt_mpf): For DOPRNT_CONV_FIXED, ask for + one more digit. + +2011-08-17 Torbjorn Granlund + + * mpf/sub.c: Fix typo in copy condition. Delay an allocation. + +2011-08-12 Torbjorn Granlund + + * gmp-impl.h (LIMBS_PER_DIGIT_IN_BASE): Fix typo. + +2011-08-10 Torbjorn Granlund + + * gmp-impl.h (DIGITS_IN_BASEGT2_FROM_BITS): New. + (DIGITS_IN_BASE_FROM_BITS): Compute more accurate result. + (MPN_SIZEINBASE): Use DIGITS_IN_BASEGT2_FROM_BITS. + + * tests/rand/t-lc2exp.c (check_bigc): Call abort after reporting error. + +2011-08-09 Torbjorn Granlund + + * mpz/out_str.c (mpz_out_str): Reinsert accidentally deleted str_size + adjustment. + + * gmp-impl.h (DIGITS_IN_BASE_FROM_BITS): Simplify, also avoiding + overflow for base 2. + +2011-08-07 Torbjorn Granlund + + * gmp-impl.h (struct bases): Add log2b and logb2 field, remove + chars_per_limb_exactly field. + (DIGITS_IN_BASE_FROM_BITS): New. + (DIGITS_IN_BASE_PER_LIMB): New. + (LIMBS_PER_DIGIT_IN_BASE): New. + * gen-bases.c: Generate log2b and logb2 fields; do not generate + chars_per_limb_exactly field. + * mpf/get_str.c mpf/out_str.c mpf/set_str.c mpn/generic/get_str.c + mpn/generic/sizeinbase.c mpq/get_str.c mpz/inp_str.c mpz/out_str.c + mpz/set_str.c printf/doprntf.c tune/speed.h tune/tuneup.c: + Use new macros. + +2011-08-04 Torbjorn Granlund + + * dumbmp.c (mpz_root): Reinsert accidentally removed line. + +2011-08-03 Torbjorn Granlund + + * dumbmp.c (mpz_tdiv_qr): Correctly handle dividend value being equal + to divisor value. + (mpz_root): Create reasonable starting approximation. + (mpz_sqrt): New function. + (mpz_mul_2exp): Add faster block shifting code, disabled for now. + +2011-07-15 Torbjorn Granlund + + * mpn/arm/invert_limb.asm: Swap around some registers to silence 'as' + warnings. + +2011-07-14 Torbjorn Granlund + + * mpn/generic/dcpi1_bdiv_q.c (mpn_dcpi1_bdiv_q): Get mpn_sub_1 size + argument right. + +2011-07-04 Torbjorn Granlund + + * tests/misc/t-locale.c: Disable test for mingw. + + * configure.in (x86_64 *-*-mingw*): Handle also cygwin here; clear out + extra_functions_64. + +2011-07-02 Torbjorn Granlund + + * config.guess: Don't print newline in x86 cpuid function. + Rewrite x86-64 cpu recognition asm code to work under Windoze. + +2011-06-16 Torbjorn Granlund + + * acinclude.m4 (GMP_ASM_RODATA): Fix typo in 2011-04-20 change. + + * configure.in: Surround tr ranges with [] for portability. + +2011-05-25 Niels Möller + + * tune/tune-gcd-p.c (search): New function to search for minimum. + (main): Replaced slow linear search. + +2011-05-24 Niels Möller + + * tune/Makefile.am (EXTRA_PROGRAMS): Added tune-gcd-p. Also added + related automake variables. + + * mpn/Makefile.am (tune-gcd-p): Deleted target. + + * tune/tune-gcd-p.c: New file, extracted from mpn/generic/gcd.c + and updated. + * mpn/generic/gcd.c: Deleted the corresponding code, including + main function. + +2011-05-23 Niels Möller + + * mpz/jacobi.c (mpz_jacobi): Simplified by swapping operands when + needed, to get asize >= bsize. Use the reciprocity law generalized + to work when one operand is even. + +2011-05-22 Niels Möller + + * mpz/jacobi.c (mpz_jacobi): Another bugfix for the asize == 1 + case. Sometimes, powers of two in b were taken into account twice. + +2011-05-21 Niels Möller + + * mpz/jacobi.c (mpz_jacobi): The handling of asize == 1 was + broken. Rewrote it. + + * tests/mpz/t-jac.c (mpz_nextprime_step): Sanity check that prime + candidate and step has no common factor. + (check_data): Added some test cases related to the asize == 1 case + in mpz_jacobi. + +2011-05-20 Niels Möller + + * gmp-impl.h: Jacobi-related prototypes. + + * configure.in (gmp_mpn_functions): Added jacobi_2, jacobi, + hgcd2_jacobi, hgcd_jacobi, and removed jacobi_lehmer. + + * mpz/jacobi.c (STRIP_TWOS): Deleted macro. + (mpz_jacobi): Partially rewritten, to no longer makes the A + operand odd. Use new mpn_jacobi_n. + + * mpn/generic/jacobi_lehmer.c: Deleted file. + + * mpn/generic/jacobi.c (mpn_jacobi_n): New subquadratic jacobi + implementation. Supersedes jacobi_lehmer.c. + + * mpn/generic/hgcd_jacobi.c (mpn_hgcd_jacobi): New file and + function. A copy of mpn_hgcd, using mpn_hgcd2_jacobi, and with calls to + mpn_jacobi_update when appropriate. + + * mpn/generic/jacobi_2.c (mpn_jacobi_2): New file. Extracted from + jacobi_lehmer.c. + * mpn/generic/hgcd2_jacobi.c (mpn_hgcd2_jacobi): Likewise. + + * mpn/generic/hgcd.c (hgcd_hook): Avoid using NULL. + +2011-05-19 Niels Möller + + * tune/hgcd_lehmer.c (__gmpn_hgcd_itch): Don't rename symbols for + the functions moved to hgcd_matrix.c. + + * configure.in (gmp_mpn_functions): Added hgcd_matrix. + + * mpn/generic/hgcd.c (hgcd_matrix_update_1): Deleted. Several other + helper functions moved to hgcd_matrix.c, see below. + (hgcd_hook): New function. + (hgcd_step): Simplified, using mpn_gcd_subdiv_step and hgcd_hook. + + * mpn/generic/hgcd_matrix.c: New file. + (mpn_hgcd_matrix_init): Moved here, from hgcd.c. + (mpn_hgcd_matrix_update_q): Likewise. + (mpn_hgcd_matrix_mul_1): Likewise. + (mpn_hgcd_matrix_mul): Likewise. + (mpn_hgcd_matrix_adjust): Likewise. + + * mpn/generic/gcd_subdiv_step.c (mpn_gcd_subdiv_step): New + argument s, for use by hgcd. + * gmp-impl.h (mpn_gcd_subdiv_step): Update declaration. + + * mpn/generic/gcd.c (mpn_gcd): Pass s = 0 to mpn_gcd_subdiv_step. + * mpn/generic/gcdext.c (mpn_gcdext): Likewise. Also added an ASSERT. + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_n): Likewise. + (mpn_gcdext_hook): Added some ASSERTs. + * mpn/generic/jacobi_lehmer.c (mpn_jacobi_lehmer): Likewise. + +2011-05-17 Niels Möller + + * doc/gmp.texi (mpn_gcd, mpn_gcdext): Document input requirements: + Must have un >= vn > 0, and V normalized. + * mpn/generic/gcdext.c (mpn_gcdext): Added ASSERT for input + normalization. + * mpn/generic/gcd.c (mpn_gcd): Added ASSERTs for input + requirements. + +2011-05-15 Marc Glisse + + * gmpxx.h (operator<<): Dedup. + * tests/cxx/t-iostream.cc: Test on compound types. + + * gmpxx.h (__gmp_binary_expr): Let things happen in place: c=(a+b)/2. + +2011-05-10 Marc Glisse + + * gmpxx.h (__gmp_unary_expr): Let things happen in place: c=-(a+b). + (operator>>): Clean the commenting out. + * tests/cxx/t-iostream.cc: New file. + * tests/cxx/Makefile.am: Added t-iostream. + +2011-05-10 Niels Möller + + * doc/gmp.texi (mpz_gcd): Document that gcd(0,0) = 0. + (mpz_gcdext): Document range for cofactors. + +2011-05-09 Niels Möller + + * mpz/gcdext.c (mpz_gcdext): Increased sp allocation to bsize+1 limbs. + * doc/gmp.texi (mpn_gcdext): Fixed documentation of allocation + requirements; one extra limb is still needed for S. + +2011-05-09 Torbjorn Granlund + + * mpn/x86/fat/gmp-mparam.h (BMOD_1_TO_MOD_1_THRESHOLD): Define. + * mpn/x86_64/fat/gmp-mparam.h (BMOD_1_TO_MOD_1_THRESHOLD): Define. + +2011-05-08 Marc Glisse + + * gmpxx.h: Replace unsigned long with mp_bitcnt_t in many places. + * doc/gmp.texi: Likewise. + +2011-05-06 Marc Glisse + + * gmpxx.h (mpz_class): Make constructor from mp[qf]_class explicit. + (mpq_class): Make constructor from mpf_class explicit. + * doc/gmp.texi: Document the above. + * NEWS: Likewise, and mention the EOF istream fix. + * tests/cxx/t-mix.cc: New file. + * tests/cxx/Makefile.am: Added t-mix. + + * tests/cxx/t-assign.cc: Minor tweak. + * tests/cxx/t-misc.cc: Likewise. + + * gmpxx.h (__gmp_resolve_temp): Remove. + (__gmp_set_expr): Remove some overloads. + (mpq_class): mpz_init_set the numerator and denominator instead of + mpq_init + mpq_set. + (mpz_class): Dedup the string constructors. + (mpq_class): Likewise. + + * tests/cxx/t-ops3.cc: New file. + * tests/cxx/Makefile.am: Added t-ops3. + +2011-05-05 Torbjorn Granlund + + * mpz/gcdext.c: Correct sgn computation. + Use MPZ_REALLOC. + +2011-05-05 Marc Glisse + + * mpn/x86_64/fat/fat.c: Update for Sandy Bridge. + * config.guess: warning to keep it in sync with fat.c. + +2011-05-05 Torbjorn Granlund + + * mpn/x86_64/fat/fat_entry.asm (PIC_OR_DARWIN): New symbol. Use it to + work around Darwin problems. + +2011-05-04 Niels Möller + + * mpz/gcdext.c (mpz_gcdext): Reduced temporary allocations. Use + mpz_divexact when computing the second cofactor. + +2011-05-03 David Harvey + + * configure.in: make invert_limb_table work correctly with + --disable-assembly (from Niels Möller) + +2011-05-02 Marc Glisse + + * .bootstrap: libtoolize doesn't need -c. + + * configfsf.guess: Update to version of 2011-02-02. + * configfsf.sub: Update to version of 2011-03-23. + +2011-05-02 Niels Möller + + * mpz/gcdext.c (mpz_gcdext): Don't allocate extra limbs at the end + of mpn_gcdext parameters. + + * doc/gmp.texi (mpn_gcdext): Updated doc. + +2011-05-01 Niels Möller + + * mpn/generic/div_qr_2u_pi1.c (mpn_div_qr_2u_pi1): Fixed ASSERT. + +2011-04-30 Marc Glisse + + * gmp-h.in (mpz_cdiv_q_2exp): Use mp_bitcnt_t to match the definition + and the documentation. + (mpz_remove): Likewise. + (mpf_eq): Likewise. + + * ltmain.sh: Remove. + * .bootstrap: Let libtoolize generate ltmain.sh. + + * tests/cxx/t-ops2.cc: Add a couple tests. + * tests/cxx/t-rand.cc: Likewise. + + * doc/gmp.texi (mpf_urandomb): Explicit the fact that it does not + change the precision. + + * gmp-h.in (__GMP_EXTERN_INLINE): Recent g++ uses gnu_inline. + +2011-04-28 Torbjorn Granlund + + * configure.in (x86_64): Support bobcat specifically. + (x86): Match bobcat and bulldozer, handle like k10. + +2011-04-28 David Harvey + + * README.HG: update autotools version numbers. + +2011-04-27 Torbjorn Granlund + + * tune/speed.h (speed_cyclecounter): Always use PIC variant when + compiled with Apple's GCC. + + * mpn/x86/darwin.m4 (LEA): Complete rewrite. + (m4append): New macro. + +2011-04-26 Torbjorn Granlund + + * mpn/sparc32/sparc-defs.m4 (changecom): Don't redefine '!' as it + interferes with expressions. + +2011-04-20 Torbjorn Granlund + + * acinclude.m4 (GMP_ASM_RODATA): Make 'foo' larger to avoid clang + problems. + +2011-04-12 Niels Möller + + * mpn/x86_64/invert_limb.asm [PIC]: Declare mpn_invert_limb_table + as .protected. + +2011-04-11 Torbjorn Granlund + + * mpn/x86/k7/invert_limb.asm: Use deflit for Darwin bug workaround. + Undo 2011-03-28 change. + + * mpn/asm-defs.m4 (define_mpn): Use deflit. + +2011-04-10 Niels Möller + + * mpn/asm-defs.m4 (define_mpn): Added invert_limb_table. + + * configure.in: Add invert_limb_table to extra_functions_64 on + x86_64. + + * mpn/x86_64/invert_limb.asm: Changed references from approx_tab + mpn_invert_limb_table. + + * mpn/x86_64/invert_limb_table.asm (mpn_invert_limb_table): New + file. Extracted approximation table from invert_limb.asm, renamed + and made global. + +2011-03-30 Niels Möller + + * mpn/x86_64/div_qr_2u_pi1.asm: New file. + + * configure.in (gmp_mpn_functions): Add div_qr_2u_pi1. + + * gmp-impl.h (mpn_div_qr_2u_pi1): Declare. + + * mpn/generic/div_qr_2u_pi1.c (mpn_div_qr_2u_pi1): Moved to + separate file, from... + * mpn/generic/div_qr_2.c: ... old location. + + * mpn/generic/div_qr_2n_pi1.c: Renamed file, from... + * mpn/generic/div_qr_2_pi1_norm.c: ...old name. + * mpn/x86_64/div_qr_2n_pi1.asm: Renamed file, from... + * mpn/x86_64/div_qr_2_pi1_norm.asm: ...old name. + + * gmp-impl.h (mpn_div_qr_2n_pi1): Use new name in declaration. + * tune/speed.h (speed_mpn_div_qr_2n): Likewise. + (speed_mpn_div_qr_2u): Likewise. + + * tune/tuneup.c (tune_div_qr_2): Use new name speed_mpn_div_qr_2n. + + * tune/speed.c (routine): Use new names mpn_div_qr_2n and + mpn_div_qr_2u, also on the command line. + + * tune/common.c (speed_mpn_div_qr_2n): Renamed, from... + (speed_mpn_div_qr_2_norm): ... old name. + (speed_mpn_div_qr_2u): Renamed, from... + (speed_mpn_div_qr_2_unnorm): ... old name. + + * mpn/generic/div_qr_2_pi1_norm.c (mpn_div_qr_2n_pi1): Renamed, + from... + (mpn_div_qr_2_pi1_norm): ...old name. + * mpn/x86_64/div_qr_2_pi1_norm.asm: Likewise. + + * mpn/generic/div_qr_2.c (mpn_div_qr_2n_pi2): Renamed, from... + (mpn_div_qr_2_pi2_norm): ... old name. + (mpn_div_qr_2u_pi1): Renamed, from... + (mpn_div_qr_2_pi1_unnorm): ... old name. + (mpn_div_qr_2): Call functions using new names. + + * mpn/asm-defs.m4: Renamed div_qr_2-functions to new names. + +2011-03-29 Niels Möller + + * mpn/x86_64/div_qr_2_pi1_norm.asm: Updated to use a separate rp + argument. + + * gmp-impl.h (mpn_div_qr_2_pi1_norm): Updated declaration. + * gmp-h.in (mpn_div_qr_2): Likewise. + + * tests/mpn/t-div.c (main): Adapted to new mpn_div_qr2 interface. + * tune/speed.h (SPEED_ROUTINE_MPN_DIV_QR_2): Likewise. + + * mpn/generic/div_qr_2.c (mpn_div_qr_2_pi2_norm): Added rp + argument. Don't clobber the input dividend. + (mpn_div_qr_2_pi1_unnorm): Likewise. + (mpn_div_qr_2): Likewise. + * mpn/generic/div_qr_2_pi1_norm.c (mpn_div_qr_2_pi1_norm): Likewise. + +2011-03-29 Niels Möller + + * mpn/x86/k7/invert_limb.asm: Use mov rather than push and pop. + Earlier load of divisor from stack. + +2011-03-28 Torbjorn Granlund + + * mpn/x86/k7/invert_limb.asm: Protect movzwl register parameters from + being interpreted as m4 macro parameters. + +2011-03-22 Niels Möller + + * mpn/x86_64/div_qr_2_pi1_norm.asm: Copied optimized inner loop + from divrem_2.asm. + + * mpn/x86_64/div_qr_2_pi1_norm.asm: First working, but poorly + optimized, implementation. + + * mpn/asm-defs.m4 (define_mpn): Added div_qr_2_pi[12]_*norm. + + * mpn/generic/div_qr_2_pi1_norm.c (mpn_div_qr_2_pi1_norm): Moved + to separate file, from... + * mpn/generic/div_qr_2.c: ... old location. + + * gmp-impl.h (mpn_div_qr_2_pi1_norm): Declare. + + * configure.in (gmp_mpn_functions): Added div_qr_2_pi1_norm. + +2011-03-22 Torbjorn Granlund + + * configure.in (powerpc): Reinsert lost AIX cpu_path 32-bit handling. + Reinsert lost linux/bsd cpu_path handling. + + * mpn/generic/mod_1_1.c: Disable powerpc asm for _LONG_LONG_LIMB. + * mpn/generic/div_qr_2.c: Likewise. + + * mpn/generic/div_qr_2.c: Use asm just for gcc. + Make powerpc add_sssaaaa work for 32-bit case, and use less strict + constraints. + +2011-03-21 Niels Möller + + * tune/tuneup.c (div_qr_2_pi2_threshold): New global variable. + (tune_div_qr_2): New function. + (all): Call tune_div_qr_2. + + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Added div_qr_2.c. + + * gmp-impl.h (DIV_QR_2_PI2_THRESHOLD): Setup for tuning. + + New 4/2 division loop, based on Torbjörn's work: + * mpn/generic/div_qr_2.c (add_sssaaaa, add_csaac): New macros. + (udiv_qr_4by2): New macro. + (invert_4by2): New function. + (mpn_div_qr_2_pi2_norm): New function. + (DIV_QR_2_PI2_THRESHOLD): New threshold. + (mpn_div_qr_2_pi1_norm): Renamed, from... + (mpn_div_qr_2_norm): ... old name. + (mpn_div_qr_2_pi1_unnorm): Renamed, from... + (mpn_div_qr_2_unnorm): ... old name. + (mpn_div_qr_2): Use mpn_div_qr_2_pi2_norm for large enough + normalized divisors. + + * gmp-impl.h (udiv_qr_3by2): Avoid a copy. + +2011-03-21 Torbjorn Granlund + + * configure.in (hppa): Under linux, treat 64-bit processors as if they + were 32-bit processors. + + * mpn/generic/addcnd_n.c: New file. + * mpn/asm-defs.m4 (define_mpn): Add addcnd_n and subcnd_n. + * configure.in (gmp_mpn_functions): Add addcnd_n. + * gmp-impl.h (mpn_addcnd_n): Declare. + + * mpn/generic/subcnd_n.c: Combine nails and non-nails functions. + + * gmp-impl.h (invert_pi1): Prepend _ to local variables, protect + parameters within () where necessary. + + * mpn/asm-defs.m4 (define_mpn): Add div_qr_2. + * configure.in (gmp_mpn_functions): Reinsert mercurial-bug-removed + line. + +2011-03-20 Torbjorn Granlund + + * configure.in (powerpc): Add cpu_path for all three ABIs. + Rename "aix64" to "mode64" for consistency. + +2011-03-16 Marc Glisse + + * gmpxx.h (__gmp_binary_not_equal): Remove, use !__gmp_binary_equal. + (__gmp_binary_less_equal): Remove, use !__gmp_binary_greater. + (__gmp_binary_greater_equal): Remove, use !__gmp_binary_less. + * tests/cxx/t-ops2.cc: Typo. + +2011-03-20 Niels Möller + + * tune/common.c (speed_mpn_div_qr_2_norm): New function. + (speed_mpn_div_qr_2_unnorm): New function. + * tune/speed.c (routine): Recognize above functions. + * tune/speed.h: Declarations for above functions. + (SPEED_ROUTINE_MPN_DIV_QR_2): New macro. + + * tests/mpn/t-div.c (main): Added tests for mpn_divrem_2 and + mpn_div_qr_2. + + * mpn/generic/div_qr_2.c (mpn_div_qr_2): New file and function. + Intended to eventually replace divrem_2. + * configure.in (gmp_mpn_functions): Add div_qr_2. + +2011-03-16 Marc Glisse + + * gmpxx.h (__gmp_set_expr): Remove broken declarations. + +2011-03-19 Torbjorn Granlund + + * mpz/fac_ui.c (mpz_fac_ui): Use MPZ_REALLOC for standard, conditional + reallocation. + +2011-03-19 Niels Möller + + * mpn/generic/divrem_2.c (mpn_divrem_2): Fixed comment and assert + regarding q and n overlap. + +2011-03-16 Marc Glisse + + * gmpxx.h (__mpz_set_ui_safe): New inline function. + (__mpz_set_si_safe): Likewise. + (__GMPXX_TMPZ_UI): Use the new function. + (__GMPXX_TMPZ_SI): Likewise. + (__GMPXX_TMPQ_UI): Likewise. + (__GMPXX_TMPQ_SI): Likewise. + * tests/cxx/t-ops2.cc: test converting 0 to stack mpq_t. + +2011-03-15 Marc Glisse + + * gmpxx.h (__GMPXX_TMPQ_UI): New macro. + (__GMPXX_TMPQ_SI): New macro. + (struct __gmp_binary_multiplies): Rewrite, using the new macros. + (struct __gmp_binary_divides): Likewise. + + * gmpxx.h (__GMPZ_ULI_LIMBS): Rewrite. + * tests/cxx/t-ops2.cc: test converting ULONG_MIN to stack mpq_t. + +2011-03-15 Marco Bodrato + + * mpn/generic/toom_interpolate_16pts.c: Remove ambiguity. + +2011-03-14 Torbjorn Granlund + + * tune/tuneup.c (tune_mul): Set tuning min size considering print skew. + + * doc/gmp.texi: Make reference to "Formatted I/O" chapters from type + specific I/O sections. + + * mpn/alpha/add_n.asm: Add _nc entry point. + * mpn/alpha/sub_n.asm: Likewise. + * mpn/mips64/add_n.asm: Likewise. + * mpn/mips64/sub_n.asm: Likewise. + * mpn/sparc64/ultrasparc1234/add_n.asm: Likewise. + * mpn/sparc64/ultrasparc1234/sub_n: Likewise. + +2011-03-13 Marc Glisse + + * tests/cxx/t-ops2.cc: New file. + * tests/cxx/Makefile.am: Added t-ops2. + +2011-03-13 Torbjorn Granlund + + * mpn/generic/toom32_mul.c (mpn_toom32_mul): Make 'hi' be limb-sized + for better code. + + * gmp-impl.h (MPN_IORD_U): Handle x86_64 as well as x86_32. Generate + no code for incrementing by constant 0. + +2011-03-12 Marc Glisse + + * gmpxx.h: Rename __GMPXX_TMP_* to __GMPXX_TMPZ_*. Use in more places. + +2011-03-12 Torbjorn Granlund + + * mpn/powerpc64/rshift.asm: Accept/return values correctly also for + 32-bit ABI. + * mpn/powerpc64/lshift.asm: Likewise. + + * tune/powerpc.asm: Use powerpc syntax, not power syntax. + + * tune/common.c (speed_udiv_qrnnd_preinv1, etc): Remove. + * tune/speed.c (routine): Remove udiv_qrnnd_preinv1, etc. + +2011-03-12 Marc Glisse + + * tests/cxx/t-istream.cc: Restrict mpq test in t-istream -s. + + * gmpxx.h: Remove leftover #undefs. + +2011-03-11 Torbjorn Granlund + + * gmp-impl.h (udiv_qrnnd_preinv1, udiv_qrnnd_preinv2, + udiv_qrnnd_preinv2gen): Remove obsolete macros. + (udiv_qrnnd_preinv): New name for udiv_qrnnd_preinv3. + +2011-03-11 Marco Bodrato + + * gmp-impl.h: Declare many mpn_{sub,add}lsh*_n_ip[12] functions/macros. + * mpn/generic/toom_interpolate_5pts.c: Use mpn_sublsh1_n_ip1. + + * tests/devel/try.c: Tests for {add,sub}lsh*_n_ip[12]. + * tests/refmpn.c: New reference for mpn_{add,sub}lsh*_n_ip[12]. + * tests/tests.h: Declarations for reference functions above. + + * tune/common.c: New speed_mpn_{add,sub}lsh*_n_ip[12] functions. + * tune/speed.h: Prototypes for functions above. + * tune/speed.c: Support for mpn_{add,sub}lsh*_n_ip[12]. + + * mpn/x86/k7/sublsh1_n.asm: Replaced generic sublsh1 code with faster _ip1. + * mpn/x86/atom/sublsh1_n.asm: Changed PROLOGUE accordingly. + + * configure.in: Define HAVE_NATIVE_mpn_addlsh*_n*_ip[12]. + * mpn/asm-defs.m4: Declare mpn_addlsh*_n*_ip[12]. + +2011-03-10 Marc Glisse + + * tests/cxx/t-istream.cc: Explicit conversion to streampos. + +2011-03-10 Torbjorn Granlund + + * mpn/x86/atom/sse2/mul_basecase.asm: Suppress wind-down rp updates. + + * Move new aorrlsh_n.asm to new k8 dir. Revert + mpn/x86_64/aorrlsh_n.asm. + * configure.in: Setup path for new k8 directory. + +2011-03-10 Marco Bodrato + + * mpn/x86/pentium4/sse2/bdiv_dbm1c.asm: New file, was in atom. + * mpn/x86/atom/sse2/bdiv_dbm1c.asm: Grab file above. + +2011-03-09 Torbjorn Granlund + + * mpn/x86_64/aorrlsh_n.asm: Complete rewrite. + + * mpn/x86_64/core2/aorrlsh_n.asm: New file, grabbing another asm file. + +2011-03-09 Marc Glisse + + * tests/cxx/t-ostream.cc: Use bool instead of int. + * tests/cxx/t-istream.cc: Likewise. + * tests/cxx/t-misc.cc: Likewise. + + * cxx/ismpznw.cc: Don't clear eofbit. + * cxx/ismpq.cc: Likewise. + * cxx/ismpf.cc: Likewise. + * tests/cxx/t-istream.cc: Test accordingly. + +2011-03-09 Marco Bodrato + + * mpn/x86/atom/sse2/bdiv_dbm1c.asm: New file. + +2011-03-09 Marc Glisse + + * doc/gmp.texi: Remove void return type from constructors. Document + explicit constructors. Document mpf_class::mpf_class(mpf_t). + +2011-03-07 Marco Bodrato + + * mpn/x86/atom/sse2/sqr_basecase.asm: Postponed pushes. Cleaned + outer loop exit. + +2011-03-07 Torbjorn Granlund + + * mpn/x86_64/gcd_1.asm: Workaround Oracle assembler bug. + + * mpn/x86/atom/sse2/mul_basecase.asm: Replace addmul_1 loops. + Tweak outer loop rp updates. + +2011-03-06 Torbjorn Granlund + + * mpn/x86/atom/sse2/sqr_basecase.asm: New file. + +2011-03-05 Torbjorn Granlund + + * mpn/x86_64/bdiv_dbm1c.asm: Write proper feed-in code. + +2011-03-04 Torbjorn Granlund + + * mpn/x86_64/addmul_2.asm: Rewrite for linear performance. + +2011-03-03 Torbjorn Granlund + + * mpn/generic/mod_1_1.c (add_mssaaaa): Canonicalise layout. Add arm + variant. Enable sparc64 code and powerpc code (the latter for 32-bit + and 64-bit). + + * mpn/generic/sqrtrem.c (mpn_dc_sqrtrem): Use mpn_addlsh1_n. + + * gmp-impl.h (mpn_addlsh_nc, mpn_rsblsh_nc): Declare. + * mpn/asm-defs.m4: Likewise. + + * mpn/x86_64/coreisbr/aorrlsh_n.asm: Disable mpn_rsblsh_n due to + carry-in issues. + * mpn/x86_64/coreinhm/aorrlsh_n.asm: Likewise. + * mpn/x86_64/coreisbr/aorrlsh2_n.asm: Likewise. + +2011-03-03 Niels Möller + + * mpn/generic/mod_1_1.c (add_mssaaaa): For x86 and x86_64, treat m + as in output operand only. Added sparc32 implementation. Also + added #if:ed out attempts at sparc64 and powerpc64. + + * tune/tuneup.c (tune_mod_1): Record result of MOD_1_1P_METHOD + measurement for use by mpn_mod_1_tune. And omit measurement if + mpn_mod_1_1p is native assembly code. + + * mpn/generic/mod_1.c (mpn_mod_1_1p) [TUNE_PROGRAM_BUILD]: Macro + to check mod_1_1p_method and call the right function. + (mpn_mod_1_1p_cps) [TUNE_PROGRAM_BUILD]: Likewise. + + * gmp-impl.h (MOD_1_1P_METHOD) [TUNE_PROGRAM_BUILD]: Define macro. + (mod_1_1p_method) [TUNE_PROGRAM_BUILD]: Declare variable. + +2011-03-02 Torbjorn Granlund + + * mpn/x86_64/coreinhm/aorrlsh_n.asm: New file. + * mpn/x86_64/coreisbr/aorrlsh_n.asm: New file. + +2011-03-01 Niels Möller + + * mpn/x86_64/mod_1_1.asm (mpn_mod_1_1p_cps): Eliminated a neg and + two mov instructions. + + * mpn/x86/k7/mod_1_1.asm (mpn_mod_1_1p_cps): Simplified + computation, analogous to recent x86_64/mod_1_1.asm changes. + (mpn_mod_1_1p): Corresponding changes. Don't shift b. + + * mpn/sparc64/mod_1_4.c (mpn_mod_1s_4p_cps): Use udiv_rnnd_preinv + rather than udiv_rnd_preinv. + (mpn_mod_1s_4p): Likewise. + +2011-03-01 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/mul_1.asm: Swap entry insns to share more code + between entry points. + * mpn/x86/pentium4/sse2/addmul_1.asm: Likewise. + + * mpz/divegcd.c: Rewrite, as per Marc Glisse's suggestion. Also fix + problem with passing a longlong limb to a _ui function. + + * gmp-impl.h (udiv_qrnnd_preinv3): Cast truth value to mask's type. + (udiv_rnnd_preinv): Likewise. + * mpn/generic/mod_1_1.c (mpn_mod_1_1p): Likewise. + +2011-02-28 Niels Möller + + * mpn/generic/mod_1_1.c (add_mssaaaa): Typo fix, define + add_mssaaaa, not add_sssaaaa. + + * tune/tuneup.c (tune_mod_1): Measure mpn_mod_1_1_1 and + mpn_mod_1_1_2, to set MOD_1_1P_METHOD. + + * tune/speed.c (routine): Added mpn_mod_1_1_1 and mpn_mod_1_1_2. + + * tune/speed.h: Declare speed_mpn_mod_1_1_1, speed_mpn_mod_1_1_2, + mpn_mod_1_1p_1, mpn_mod_1_1p_2, mpn_mod_1_1p_cps_1, and + mpn_mod_1_1p_cps_2. + + * tune/common.c (speed_mpn_mod_1_1_1): New function. + (speed_mpn_mod_1_1_2): New function. + + * tune/Makefile.am (libspeed_la_SOURCES): Added mod_1_1-1.c + mod_1_1-2.c. + + * tune/mod_1_1-1.c: New file. + * tune/mod_1_1-2.c: New file. + + * mpn/generic/mod_1_1.c: Implemented an algorithm with fewer + multiplications, configured via MOD_1_1P_METHOD. + + * mpn/x86_64/mod_1_1.asm (mpn_mod_1_1p_cps): Simplified + computation of B2modb, use B^2 mod (normalized b). + (mpn_mod_1_1p): Corresponding changes. Don't shift b. + + * mpn/generic/mod_1_1.c (mpn_mod_1_1p_cps): Use udiv_rnnd_preinv rather + than udiv_rnd_preinv. + (mpn_mod_1_1p): Likewise. + * mpn/generic/mod_1_4.c: Analogous changes. + * mpn/generic/mod_1_3.c: Analogous changes. + * mpn/generic/mod_1_2.c: Analogous changes. + * mpn/generic/mod_1.c: Analogous changes. + * mpn/generic/pre_mod_1.c: Analogous changes. + + * gmp-impl.h (udiv_qrnnd_preinv3): Eliminated unpredictable branch + using masking logic. Further optimization of the nl == constant 0 + case, similar to udiv_rnd_preinv. + (udiv_rnnd_preinv): Likewise. + (udiv_rnd_preinv): Deleted, use udiv_rnnd_preinv with nl == 0 + instead. + + * tests/mpn/t-divrem_1.c (check_data): Added testcase to exercise + the nl == constant 0 special case in udiv_qrnnd_preinv3. + +2011-02-28 Torbjorn Granlund + + * mpn/generic/rootrem.c (mpn_rootrem): Combine two similar scalar + divisions. Misc minor cleanup. + + * mpn/x86/atom/sse2/aorsmul_1.asm: Shorten software pipeline. + + * mpn/x86/atom/mul_basecase.asm: Remove file no longer used. + + * mpn/generic/rootrem.c (mpn_rootrem_internal): Delay O(log(U)) + allocations until they are known to be needed. + +2011-02-27 Marco Bodrato + + * mpn/x86/atom/sse2/mul_1.asm: New code. + +2011-02-27 Niels Möller + + * gmp-impl.h (udiv_rnnd_preinv): New macro. + +2011-02-27 Torbjorn Granlund + + * mpn/x86/atom/sse2/mul_basecase.asm: New file. + +2011-02-26 Marco Bodrato + + * mpn/x86/atom/sse2/aorsmul_1.asm: Optimise non-loop code. + +2011-02-26 Torbjorn Granlund + + * mpn/powerpc64/mode64/aorsmul_1.asm: Add MULFUNC_PROLOGUE. + * mpn/m68k/mc68020/aorsmul_1.asm: Likewise. + + * mpn/powerpc64/mode64/aorsmul_1.asm: Add missing MULFUNC_PROLOGUE. + * mpn/m68k/mc68020/aorsmul_1.asm: Likewise. + +2011-02-25 Torbjorn Granlund + + * mpn/x86/atom/sse2/aorsmul_1.asm: New file. + * mpn/x86/atom/aorsmul_1.asm: File removed. + +2011-02-25 Marco Bodrato + + * mpn/x86/atom/sse2/divrem_1.asm: New file (was in x86/atom). + * mpn/x86/atom/sse2/mul_1.asm: Likewise. + * mpn/x86/atom/sse2/popcount.asm: Likewise. + * mpn/x86/atom/divrem_1.asm: ReMoved (in sse2/ now). + * mpn/x86/atom/mul_1.asm: Likewise. + * mpn/x86/atom/popcount.asm: Likewise. + + * configure.in: Set up mmx path for atom. + * mpn/x86/atom/mmx/copyd.asm: New file (was in x86/atom). + * mpn/x86/atom/mmx/copyi.asm: Likewise. + * mpn/x86/atom/mmx/hamdist.asm: Likewise. + * mpn/x86/atom/copyd.asm: ReMoved (in mmx/ now). + * mpn/x86/atom/copyi.asm: Likewise. + * mpn/x86/atom/hamdist.asm: Likewise. + +2011-02-24 Torbjorn Granlund + + * mpn/x86/atom/sse2/mod_1_1.asm: New file. + * mpn/x86/atom/sse2/mod_1_4.asm: New file. + * configure.in: Set up sse2 path for atom. + + * mpn/x86/p6/sse2/mod_1_1.asm: New file. + * mpn/x86/p6/sse2/mod_1_4.asm: Fix typo in MULFUNC_PROLOGUE. + +2011-02-24 Niels Möller + + * mpn/x86/k7/mod_1_1.asm (mpn_mod_1_1p): Rewrite using the same + algorithm as the x86_64 version. + +2011-02-23 Marco Bodrato + + * mpn/x86/atom/logops_n.asm: New file (same loop as aors_n). + +2011-02-23 Niels Möller + + * mpn/x86_64/mod_1_1.asm (mpn_mod_1_1p): Shaved off one + instruction and one register in the inner loop. Rearranged + registers slightly, and no longer needs the callee-save register + %r12. + +2011-02-22 Torbjorn Granlund + + * configure.in: Export SHLD_SLOW and SHRD_SLOW to config.m4, also + fixing typo in exporting code. + + * mpn/x86_64/nano/gmp-mparam.h (SHLD_SLOW, SHRD_SLOW): Define. + * mpn/x86_64/atom/gmp-mparam.h (SHLD_SLOW, SHRD_SLOW): Define. + +2011-02-22 Niels Möller + + * mpn/x86_64/mod_1_1.asm (mpn_mod_1_1p): Rewrite. + +2011-02-22 Marco Bodrato + + * mpn/x86/atom/lshiftc.asm: New file (a copy of lshift.asm with a handful of neg added). + +2011-02-21 Torbjorn Granlund + + * mpn/x86/aors_n.asm: Move _nc entry to after main code. Align loop + and _n entry for claimed performance. Normalise mnemonic usage. + + * mpn/x86/atom/aorrlsh1_n.asm: New file (code from rsblsh_1, slightly + slower for addlsh_1 for large operands, but much faster for small). + * mpn/x86/atom/addlsh1_n.asm: Remove. + * mpn/x86/atom/rsblsh1_n.asm: Remove. + +2011-02-20 Marc Glisse + + * mpq/aors.c: Rewrite to remove redundant division. + +2011-02-20 Torbjorn Granlund + + * mpn/x86/atom/lshift.asm: New file. + * mpn/x86/atom/rshift.asm: Normalise mnemonic usage. + + * gmp-impl.h (mpn_divexact_by7): Relax inclusion condition. + + * mpz/divegcd.c (mpz_divexact_by5): New conditionally enabled function. + (mpz_divexact_by3): Wrap inside appropriate conditions. + (mpz_divexact_gcd): Rewrite. + + * mpn/x86/bdiv_dbm1c.asm: Save a jump. + +2011-02-20 Marco Bodrato + + * mpn/x86/atom/aorslshC_n.asm: New file. + * mpn/x86/atom/sublsh2_n.asm: New file. + + * mpn/x86/atom/aors_n.asm: New code. + * mpn/x86/atom/rshift.asm: Atom64 code adapted to 32-bit. + * mpn/x86/atom/lshift.asm: Likewise. + +2011-02-19 Torbjorn Granlund + + * mpn/x86_64/atom/rsh1aors_n.asm: New file. + + * mpn/x86_64/atom/lshift.asm: New file. + * mpn/x86_64/atom/rshift.asm: New file. + * mpn/x86_64/atom/lshiftc.asm: New file. + +2011-02-17 Marco Bodrato + + * mpn/x86/atom/aorsmul_1.asm: Small improvements for small sizes. + * mpn/x86/atom/aorrlshC_n.asm: Tiny size improvements. + +2011-02-16 Torbjorn Granlund + + * configure.in: Fix k8/k10 32-bit path setup problem. + +2011-02-16 Marco Bodrato + + * mpn/x86/atom/aorsmul_1.asm: Revive an old k7/aorsmul. + +2011-02-14 Marco Bodrato + + * gmp-impl.h (mpn_sublsh_n): Declare. + * mpn/asm-defs.m4: Likewise. + + * mpn/x86/atom/aorrlshC_n.asm: New file (was k7). + * mpn/x86/k7/aorrlshC_n.asm: ReMoved. + * mpn/x86/atom/aorrlsh2_n.asm: Grab atom/aorrlshC_n.asm. + * mpn/x86/atom/rsblsh1_n.asm: Grab atom/aorrlshC_n.asm. + +2011-02-13 Torbjorn Granlund + + * mpn/x86_64/atom/aorrlsh2_n.asm: New file. + +2011-02-12 Torbjorn Granlund + + * mpn/x86_64/aorrlsh_n.asm: Minor tweaks, update c/l numbers. + + * mpn/x86_64/atom/sublsh1_n.asm: New file. + + * mpn/x86_64/atom/aorrlsh1_n.asm: New file. + +2011-02-11 Torbjorn Granlund + + * mpn/powerpc64/mode64/mod_1_1.asm: Fix Darwin syntax issues. + +2011-02-10 Torbjorn Granlund + + * mpn/powerpc64/mode64/mod_1_4.asm: Tune away a cycle for 970. + +2011-02-11 Marco Bodrato + + * mpn/x86/k7/addlsh1_n.asm: Faster core loop (Torbjorn's). + + * configure.in: Add HAVE_NATIVE_{add,sub,rsb}lsh{,1,2}_nc. + * tests/tests.h: refmpn_{add,sub,rsb}lsh{,1,2}_nc prototypes. + * tests/refmpn.c: New refmpn_{add,sub,rsb}lsh{,1,2}_nc. + * tests/devel/try.c: Tests for mpn_{add,sub,rsb}lsh{,1,2}_nc. + + * mpn/x86/k7/aorrlshC_n.asm: New file. + * mpn/x86/atom/aorrlsh2_n.asm: Grab k7/aorrlshC_n.asm. + * mpn/x86/atom/rsblsh1_n.asm: Grab k7/aorrlshC_n.asm. + +2011-02-06 Marco Bodrato + + * mpn/x86/k7/addlsh1_n.asm: New file. + * mpn/x86/k7/sublsh1_n.asm: New file. + * mpn/x86/atom/addlsh1_n.asm: Grab k7/addlsh1_n.asm. + * mpn/x86/atom/sublsh1_n.asm: Grab k7/sublsh1_n.asm. + +2011-02-05 Torbjorn Granlund + + * gmp-impl.h (mpn_addlsh1_nc, mpn_addlsh2_nc, mpn_sublsh1_nc, + mpn_sublsh2_nc, mpn_rsblsh1_nc, mpn_rsblsh2_nc): Declare. + * mpn/asm-defs.m4: Likewise. + + * mpn/x86_64/coreisbr/aorrlshC_n.asm: New file. + * mpn/x86_64/coreisbr/aorrlsh1_n.asm: New file. + * mpn/x86_64/coreisbr/aorrlsh2_n.asm: New file. + + * mpn/x86_64/coreisbr/aors_n.asm: New file, based on old + atom/aors_n.asm. + * mpn/x86_64/atom/aors_n.asm: Grab coreisbr/aors_n.asm. + +2011-02-05 Marco Bodrato + + * gmp-impl.h (mpn_toom6_mul_n_itch): Handle threshold == zero. + (mpn_toom8_mul_n_itch): Likewise. + (MPN_TOOM6H_MIN, MPN_TOOM8H_MIN): Define. + * tests/mpn/t-toom6h.c: No tests below MPN_TOOM6H_MIN. + * tests/mpn/t-toom8h.c: No tests below MPN_TOOM8H_MIN. + + * mpz/lucnum_ui.c: Use mpn_addlsh2_n. + +2011-02-04 Torbjorn Granlund + + * mpn/x86_64/atom/rsh1aors_n.asm: Add a MULFUNC_PROLOGUE. + * mpn/x86_64/atom/dive_1.asm: Likewise. + * mpn/x86_64/atom/popcount.asm: Likewise. + * mpn/x86_64/core2/popcount.asm: Likewise. + * mpn/x86_64/coreinhm/hamdist.asm: Likewise. + * mpn/x86_64/coreinhm/popcount.asm: Likewise. + * mpn/x86_64/nano/popcount.asm: Likewise. + * mpn/x86_64/pentium4/popcount.asm: Likewise. + +2011-02-04 Marco Bodrato + + * mpn/x86/atom/mode1o.asm: New file, grabbing another asm file. + * mpn/x86/atom/mul_1.asm: Claim mul_1c. + +2011-02-02 Niels Möller + + * tune/speed.h (SPEED_ROUTINE_MPN_HGCD_CALL): Fixed one + speed_operand_dst call. + +2011-02-01 Torbjorn Granlund + + * tune/speed.h (struct speed_params): Allow for 4 dst operands. + * tune/common.c (TOLERANCE): Increase from 0.5% to 1%. + + * tune/speed.h (SPEED_ROUTINE_MPN_HGCD_CALL): New macro, mainly based + on old speed_mpn_hgcd, but with speed_operand_src calls (as suggested + by Niels). + * tune/common.c (speed_mpn_hgcd): Invoke SPEED_ROUTINE_MPN_HGCD_CALL. + (speed_mpn_hgcd_lehmer): Likewise. + + * configure.in: Set up 32-bit x86 paths for new corei* CPU strings. + +2011-01-31 Torbjorn Granlund + + * config.guess: Recognise new Intel processors. + + * config.guess: Support 'coreinhm' and 'coreisbr'. + * config.sub: Likewise. + * configure.in: Likewise. + +2011-01-30 Torbjorn Granlund + + * configure.in: Support x86/geode. + * mpn/x86/geode/gmp-mparam.h: New file. + +2011-01-29 Marco Bodrato + + * mpn/x86/atom/addlsh1_n.asm: Removed. + * mpn/x86/atom/rsh1add_n.asm: Likewise. + +2011-01-28 Torbjorn Granlund + + * mpn/alpha/ev6/slot.pl: Add some missing insns. + +2011-01-28 Marco Bodrato + + * mpn/x86/atom/copyd.asm: New file, grabbing another asm file. + * mpn/x86/atom/copyi.asm: Likewise. + * mpn/x86/atom/aors_n.asm: Likewise. + * mpn/x86/atom/addlsh1_n.asm: Likewise. + * mpn/x86/atom/aorsmul_1.asm: Likewise. + * mpn/x86/atom/bdiv_q_1.asm: Likewise. + * mpn/x86/atom/dive_1.asm: Likewise. + * mpn/x86/atom/divrem_1.asm: Likewise. + * mpn/x86/atom/hamdist.asm: Likewise. + * mpn/x86/atom/logops_n.asm: Likewise. + * mpn/x86/atom/lshift.asm: Likewise. + * mpn/x86/atom/mod_34lsub1.asm: Likewise. + * mpn/x86/atom/mul_1.asm: Likewise. + * mpn/x86/atom/mul_basecase.asm: Likewise. + * mpn/x86/atom/popcount.asm: Likewise. + * mpn/x86/atom/rsh1add_n.asm: Likewise. + * mpn/x86/atom/rshift.asm: Likewise. + * mpn/x86/atom/sqr_basecase.asm: Likewise. + +2011-01-27 Torbjorn Granlund + + * mpn/x86_64/atom/rsh1aors_n.asm: New file, grabbing another asm file. + * mpn/x86_64/atom/popcount.asm: Likewise. + * mpn/x86_64/atom/dive_1.asm: Likewise. + * mpn/x86_64/nano/popcount.asm: Likewise. + +2011-01-26 Torbjorn Granlund + + * mpn/alpha/invert_limb.asm: Complete rewrite. + +2011-01-25 Torbjorn Granlund + + * mpn/powerpc32/invert_limb.asm: New file. + +2011-01-25 Marco Bodrato + + * mpn/x86/pentium4/sse2/bdiv_q_1.asm: New file. + * mpn/x86/k7/bdiv_q_1.asm: New file. + +2011-01-24 Torbjorn Granlund + + * tune/tuneup.c (tune_mul_n, tune_sqr): Loop, re-measuring thresholds + until no tiny ranges remain. + +2011-01-23 Torbjorn Granlund + + * mpn/ia64/mul_2.asm: Tweak to 1.5 c/l, less overhead. + + * mpn/ia64/addmul_2.asm: Rewrite, adding mpn_addmul_2s entry point. + +2011-01-22 Torbjorn Granlund + + * mpn/ia64/aors_n.asm: Fix some incorrect bundle types. + + * mpn/ia64/sqr_diagonal.asm: Remove. + + * mpn/ia64/sqr_diag_addlsh1.asm: New file. + + * mpn/ia64/ia64-defs.m4: Define some shorter convenience mnemonics. + + * mpn/generic/sqr_basecase.c (MPN_SQR_DIAG_ADDLSH1): New macro, using + new function mpn_sqr_diag_addlsh1 or defining its equivalent. + + * gmp-impl.h (mpn_addmul_2s): Declare. + (mpn_sqr_diag_addlsh1): Declare. + * mpn/asm-defs.m4 (define_mpn): Add addmul_2s and sqr_diag_addlsh1. + + * configure.in: Add HAVE_NATIVEs for mpn_sqr_diag_addlsh1 and + mpn_addmul_2s. + (gmp_mpn_functions_optional): Add sqr_diag_addlsh1. + +2011-01-21 Marco Bodrato + + * tests/devel/try.c: Initial support for mpn_bdiv_q_1. + * mpn/x86/pentium/bdiv_q_1.asm: New file. + * mpn/x86/p6/bdiv_q_1.asm: New file. + +2011-01-20 Torbjorn Granlund + + * tune/speed.c (run_gnuplot): Update to current gnuplot syntax. + + * mpn/powerpc64/mode64/aorsmul_1.asm: Trim away 0.5 c/l for submul_1 + for POWER5. + +2011-01-19 Torbjorn Granlund + + * mpn/x86_64/core2/rsh1aors_n.asm: New file. + +2011-01-18 Marco Bodrato + + * mpn/x86/bdiv_q_1.asm: New file (same core alg. as dive_1). + +2011-01-15 Marco Bodrato + + * mpn/generic/divexact.c: Avoid COPY if not needed. + +2011-01-14 Torbjorn Granlund + + * gmp-impl.h (struct cpuvec_t): Add field bmod_1_to_mod_1_threshold. + * configure.in (fat_thresholds): Add BMOD_1_TO_MOD_1_THRESHOLD. + +2011-01-13 Marco Bodrato + + * mpz/mul.c: Remove redundant size computation. + +2011-01-08 Torbjorn Granlund + + * tests/devel/try.c (types enum): Add TYPE_MUL_5 and TYPE_MUL_6. + (param_init): Support new types. + (choice_array): Support testing of mpn_mul_5 and mpn_mul_6. + (call): Support new routines. + + * tests/refmpn.c (refmpn_mul_5, refmpn_mul_6): New functions. + * tests/tests.h (refmpn_mul_5, refmpn_mul_6): Declare. + Remove parameter names from some other functions. + + * gmp-impl.h (mpn_mul_5, mpn_mul_6): Declare. + * mpn/asm-defs.m4: Likewise, also declare mpn_addmul_5, mpn_addmul_6, + mpn_addmul_7, and mpn_addmul_8. + + * configure.in (gmp_mpn_functions_optional): Add mul_5 and mul_6. + + * tune/speed.c (routine): Add measuring of mpn_mul_5 and mpn_mul_6. + * tune/common.c (speed_mpn_mul_5, speed_mpn_mul_6): New functions. + * tune/speed.h: Declare new functions. + +2011-01-03 Marco Bodrato + + * mpz/aors.h: Remove #ifdef BERKELEY_MP, and cleanup. + * mpz/cmp.c: Likewise. + * mpz/gcd.c: Likewise. + * mpz/mul.c: Likewise. + * mpz/powm.c: Likewise. + * mpz/set.c: Likewise. + * mpz/sqrtrem.c: Likewise. + * mpz/tdiv_qr.c: Likewise. + +2010-12-28 Torbjorn Granlund + + * mpn/minithres/gmp-mparam.h: Update with several recent thresholds. + +2010-12-19 Torbjorn Granlund + + * mpn/x86/k7/mod_1_1.asm: Canonicalise cmov forms. + * mpn/x86/k7/mod_1_4.asm: Likewise. + * mpn/x86/pentium4/sse2/mod_1_1.asm: Likewise. + * mpn/x86/pentium4/sse2/mod_1_4.asm: Likewise. + * mpn/x86_64/core2/divrem_1.asm: Likewise. + * mpn/x86_64/divrem_1.asm: Likewise. + * mpn/x86_64/mod_1_1.asm: Likewise. + * mpn/x86_64/mod_1_2.asm: Likewise. + * mpn/x86_64/mod_1_4.asm: Likewise. + + * mpn/x86/k7/gcd_1.asm: Rewrite. Remove slow 'div' loop. Call + mpn_mod_1 for operands with mode than BMOD_1_TO_MOD_1_THRESHOLD limbs. + Misc cleanups. + +2010-12-18 Torbjorn Granlund + + * mpn/x86_64/gcd_1.asm: Call mpn_mod_1 for operands with mode than + BMOD_1_TO_MOD_1_THRESHOLD limbs. + + * configure.in: Generalise code for putting THRESHOLDs in config.m4. + Add BMOD_1_TO_MOD_1_THRESHOLD to list. + + * mpn/x86_64/core2/divrem_1.asm: Tweak slightly, correct cycle counts. + + * mpn/x86_64/addmul_2.asm: Remove constant index. + * mpn/x86_64/lshiftc.asm: Likewise. + * mpn/x86_64/pentium4/lshift.asm: Likewise. + * mpn/x86_64/pentium4/lshiftc.asm: Likewise. + * mpn/x86_64/pentium4/rshift.asm: Likewise. + +2010-12-16 Torbjorn Granlund + + * mpn/x86_64/mod_34lsub1.asm: Complete rewrite. + * mpn/x86_64/pentium4/mod_34lsub1.asm: New file, old + mpn/x86_64/mod_34lsub1.asm. + +2010-12-15 Torbjorn Granlund + + * mpn/powerpc64/vmx/popcount.asm: Rewrite to use vperm count table. + +2010-12-14 Torbjorn Granlund + + * mp-h.in: Remove. + * configure.in: Remove mp-h.in from AC_OUTPUT invocation. + +2010-12-13 Torbjorn Granlund + + * mpz/mod.c: Rewrite. + + * mpn/x86_64/corei/popcount.asm: New file. + * mpn/x86_64/corei/hamdist.asm: New file. + + * mpn/x86_64/k10/hamdist.asm: New file. + + * configure.in: Amend last change for lame /bin/sh. + +2010-12-12 Torbjorn Granlund + + * configure.in: Comment out M4=m4-not-needed. + + * mpn/x86_64/k10/popcount.asm: New file. + * configure.in: Setup special path for k10 and later AMD CPUs. + Remove special x86_64'k8' path, since directory is non-existent. + +2010-12-11 Torbjorn Granlund + + * mpn/sparc32/ultrasparct1: New directory. + * mpn/sparc32/ultrasparct1/add_n.asm: New file. + * mpn/sparc32/ultrasparct1/sub_n.asm: New file. + * mpn/sparc32/ultrasparct1/mul_1.asm: New file. + * mpn/sparc32/ultrasparct1/addmul_1.asm: New file. + * mpn/sparc32/ultrasparct1/submul_1.asm: New file. + * mpn/sparc32/ultrasparct1/sqr_diagonal.asm: New file. + + * config.guess: Support Ultrasparc T2 and T3. + * config.sub: Likewise. + * configure.in: Likewise. + + * config.guess: Generalise BSD Sparc recognition by allowing any + caps (needed for OpenBSD which spells things innovatively). + +2010-12-01 Torbjorn Granlund + + * config.guess: Match new AMD processors, allow finer distinctions + among old ones. + * acinclude.m4 (X86_64_PATTERN): Likewise. + * config.sub: Likewise. + * configure.in: Rudimentarily support new AMD processors. + + * configure.in (--enable_assembly): New option. + (target none-*-*): Disable, give error. + +2010-11-29 Torbjorn Granlund + + * mpn/x86/x86-defs.m4 (LEA): Support non-PIC code. + * mpn/x86/darwin.m4 (LEA): Likewise. + + * tests/amd64call.asm: Rewrite for code size, and to match calls and + returns. + + * tests/x86call.asm: Rewrite for code size, to support PIC, and to + match calls and returns. + * tests/x86check.c: Rewrite. + +2010-11-22 Torbjorn Granlund + + * mpz/get_str.c: Make all bases either work or return an error. + * mpz/out_str.c: Likewise. + * mpq/get_str.c: Likewise. + * mpf/get_str.c: Likewise. + +2010-11-14 Torbjorn Granlund + + * tests/misc/t-printf.c: Add explicit casts for type conversions. + * mpn/generic/toom62_mul.c: Likewise. + +2010-11-13 Torbjorn Granlund + + * mpn/generic/get_d.c: Misc cleanup. Fail with a syntax error for + non-IEEE fp formats. + + * tests/devel/try.c (malloc_region): Add explicit casts for type + conversions. + + * acinclude.m4 (GMP_ASM_RODATA): Make test code snippet C++ compatible. + (GMP_C_DOUBLE_FORMAT): Likewise. + (GMP_FUNC_VSNPRINTF): Likewise. + + * config.guess (x86): Make test C snippet C++ compatible. + +2010-11-12 Torbjorn Granlund + + * Makefile.am: Remove mpbsd. + * configure.in: Remove mpbsd. + * doc/configuration: Remove mpbsd mentions. + * doc/gmp.texi: Remove mpbsd docs. + * tests/Makefile.am: Remove mpbsd. + * libmp.sym: Remove. + * mpbsd: Remove directory and files. + * tests/mpbsd: Remove directory and files. + +2010-11-11 Torbjorn Granlund + + * mpn/x86_64/atom/aors_n.asm: Don't rely on ZF after 'bt' insn. + Use 64-bit 'test' to support operands of 2^32 limbs and more. + + * rand: New directory, move rand*.c and randmt.h here. + * rand/Makefile.am: New file. + * Makefile.am (SUBDIRS): Add rand. + (RANDOM_OBJECTS): New variable. + (libgmp_la_SOURCES): Remove random objects. + (libgmp_la_DEPENDENCIES): Add RANDOM_OBJECTS. + * configure.in (AC_OUTPUT): Add rand/Makefile. + + * ansi2knr.1: File removed. + * ansi2knr.c: File removed. + +2010-11-10 Torbjorn Granlund + + Make it possible to compile GMP with g++: + + * gmp-impl.h: Declare __gmp_digit_value_tab here. + * mpbsd/min.c: ...not here. + * mpbsd/xtom.c: ...nor here. + * mpf/set_str.c: ...nor here. + * mpz/inp_str.c: ...nor here. + * mpz/set_str.c: ...nor here. + + * mpn/generic/toom43_mul.c: Add casts for logical operations on enums. + * mpn/generic/toom44_mul.c: Likewise. + * mpn/generic/toom4_sqr.c: Likewise. + * mpn/generic/toom52_mul.c: Likewise. + * mpn/generic/toom53_mul.c: Likewise. + * mpn/generic/toom62_mul.c: Likewise. + + * mpz/clrbit.c: Clean up typing using MPZ_REALLOC. + * mpz/setbit.c: Likewise. + + * mpz/powm.c: Avoid variable name 'new'. + + * randlc2x.c: Add explicit casts for type conversions. + * tests/misc/t-printf.c: Likewise. + * tests/misc/t-scanf.c: Likewise. + * tests/misc.c: Likewise. + * tests/mpz/convert.c: Likewise. + * tests/refmpn.c: Likewise. + + * tests/tests.h: Unconditionally use for now. + + * tests/memory.c: Include "tests.h. + + * mp_get_fns.c: Add a __GMP_NOTHROW for coherency with prototype. + * mp_set_fns.c: Likewise. + * mpf/cmp.c: Likewise. + * mpf/cmp_si.c: Likewise. + * mpf/cmp_ui.c: Likewise. + * mpf/fits_s.h: Likewise. + * mpf/fits_u.h: Likewise. + * mpf/get_dfl_prec.c: Likewise. + * mpf/get_prc.c: Likewise. + * mpf/get_si.c: Likewise. + * mpf/get_ui.c: Likewise. + * mpf/int_p.c: Likewise. + * mpf/set_dfl_prec.c: Likewise. + * mpf/set_prc_raw.c: Likewise. + * mpf/size.c: Likewise. + * mpf/swap.c: Likewise. + * mpq/equal.c: Likewise. + * mpq/swap.c: Likewise. + * mpz/cmp.c: Likewise. + * mpz/cmp_si.c: Likewise. + * mpz/cmp_ui.c: Likewise. + * mpz/cmpabs.c: Likewise. + * mpz/cmpabs_ui.c: Likewise. + * mpz/cong_2exp.c: Likewise. + * mpz/divis_2exp.c: Likewise. + * mpz/fits_s.h: Likewise. + * mpz/get_si.c: Likewise. + * mpz/hamdist.c: Likewise. + * mpz/scan0.c: Likewise. + * mpz/scan1.c: Likewise. + * mpz/sizeinbase.c: Likewise. + * mpz/swap.c: Likewise. + * mpz/tstbit.c: Likewise. + * tal-reent.c: Likewise. + +2010-11-09 Torbjorn Granlund + + * configure.in: Get rid of K&R support. + * Makefile.am: Likewise. + * mpn/Makefile.am: Likewise. + * doc/configuration: Update docs wrt K&R support. + * doc/gmp.texi: Likewise. + + * configure.in (AC_INIT): Amend bug reporting address with manual + reference. + +2010-11-06 Torbjorn Granlund + + * config.guess: If cpuid says we have 32bit-only x86 but + configfsf.guess return x86_64, return the latter. + + * mpn/x86_64/aors_n.asm: Rewrite not to rely on ZF after 'bt' insn. + +2010-10-09 Torbjorn Granlund + + * mpn/generic/trialdiv.c: Update documentation. + +2010-10-04 Torbjorn Granlund + + * mpn/x86_64/gcd_1.asm: Use m4_lshift to avoid << operator. + * mpn/x86_64/aorrlshC_n.asm: Likewise. + * mpn/x86_64/pentium4/aorslshC_n.asm: Likewise. + * mpn/x86/k7/gcd_1.asm: Likewise. + +2010-08-20 Niels Möller + + Suggested by Ozkan Sezer: + * configure.in: If $M4 is already set in the environment, don't + touch it. Fixed the case that no assembler files are used, and + GMP_PROG_M4 is omitted. + +2010-08-08 Torbjorn Granlund + + * mpn/x86_64/fat/fat.c: Recognise many more processors. + +2010-06-30 Torbjorn Granlund + + * mpn/x86_64/divrem_2.asm: Tune. + +2010-06-19 Niels Möller + + * tune/speed.h (SPEED_ROUTINE_MPN_MOD_1_1): Pass normalized + divisor to the benchmarked function. + +2010-06-15 Torbjorn Granlund + + * mpn/x86_64/mod_1_1.asm (mpn_mod_1_1p_cps): Rewrite. + * mpn/x86_64/mod_1_2.asm (mpn_mod_1s_2p_cps): Rewrite. + * mpn/x86_64/mod_1_4.asm (mpn_mod_1s_4p_cps): Rewrite. + + * gmp-impl.h (udiv_rnd_preinv): Simplify. + + * mpn/x86/k7/mod_1_1.asm: New file. + * mpn/x86/pentium4/sse2/mod_1_1.asm (mpn_mod_1_1p_cps): Rewrite. + * mpn/x86/k7/mod_1_4.asm (mpn_mod_1s_4p_cps): Rewrite. + * mpn/x86/pentium4/sse2/mod_1_4.asm (mpn_mod_1s_4p_cps): Rewrite. + + * mpn/generic/mod_1_1.c (mpn_mod_1_1p_cps): Store results as they are + computed. + * mpn/generic/mod_1_2.c (mpn_mod_1s_2p_cps): Likewise. + * mpn/generic/mod_1_4.c (mpn_mod_1s_4p_cps): Likewise. + + * mpn/x86/k7/invert_limb.asm: Moved from mpn/x86/invert_limb.asm. + +2010-06-15 Niels Möller + + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-mod_1. + * tests/mpn/t-mod_1.c: New file. + +2010-05-25 Torbjorn Granlund + + * mpn/generic/mu_div_qr.c (mpn_preinv_mu_div_qr_itch): Trim out space + for inverse, since that is passed in already. + +2010-05-24 Torbjorn Granlund + + * mpn/generic/mu_div_qr.c (mpn_preinv_mu_div_qr_itch): New function. + * gmp-impl.h: Declare it. + * tune/common.c (speed_mpn_mupi_div_qr): Use new itch function. + * tune/speed.h (SPEED_ROUTINE_MPN_MUPI_DIV_QR): Pass parameters right + for new itch function. + + * mpn/powerpc32/lshiftc.asm: New file. + +2010-05-22 Torbjorn Granlund + + * tune/tuneup.c (tune_mod_1): Revert to version of 2010-05-06. + +2010-05-17 Torbjorn Granlund + + * configure.in (ia64): Get 32-bit sizeof test right. + + * tune/tuneup.c (tune_mod_1): Undo unintensional change to tuning of + PREINV_MOD_1_TO_MOD_1_THRESHOLD. + +2010-05-16 Torbjorn Granlund + + * mpn/sparc64/mod_1.c: Rewrite. + * mpn/sparc64/sparc64.h (umul_ppmm_s): New macro. + * mpn/sparc64/mod_1_4.c: New file. + + * mpn/generic/divrem_1.c: Minor cleanup. + * mpn/generic/mod_1.c: Likewise. + * mpn/generic/mod_1_1.c: Likewise. + * mpn/generic/mod_1_2.c: Likewise. + * mpn/generic/mod_1_3.c: Likewise. + * mpn/generic/mod_1_4.c: Likewise. + + * configure.in (ia64-hpux): Do sizeof tests for 32-bit and 64-bit ABI. + + * tune/tuneup.c (tune_mod_1): Completely finish MOD_1_N tuning before + tuning MOD_1U_TO_MOD_1_1_THRESHOLD. + +2010-05-14 Torbjorn Granlund + + * mpn/generic/redc_2.c: Use asm code just for GNU C. + +2010-05-13 Torbjorn Granlund + + * mpn/sparc64/ultrasparc1234: New directory. Move all code that uses + floating-point into this directory. + * configure.in: Point to ultrasparc1234 for appropriate CPUs. + + * mpn/sparc64/ultrasparct1/add_n.asm: New file. + * mpn/sparc64/ultrasparct1/addlsh2_n.asm: New file. + * mpn/sparc64/ultrasparct1/addmul_1.asm: New file. + * mpn/sparc64/ultrasparct1/lshift.asm: New file. + * mpn/sparc64/ultrasparct1/mul_1.asm: New file. + * mpn/sparc64/ultrasparct1/rsblsh2_n.asm: New file. + * mpn/sparc64/ultrasparct1/rshift.asm: New file. + * mpn/sparc64/ultrasparct1/sublsh1_n.asm: New file. + * mpn/sparc64/ultrasparct1/sublshC_n.asm: New file. + * mpn/sparc64/ultrasparct1/addlsh1_n.asm: New file. + * mpn/sparc64/ultrasparct1/addlshC_n.asm: New file. + * mpn/sparc64/ultrasparct1/lshiftc.asm: New file. + * mpn/sparc64/ultrasparct1/rsblsh1_n.asm: New file. + * mpn/sparc64/ultrasparct1/rsblshC_n.asm: New file. + * mpn/sparc64/ultrasparct1/sub_n.asm: New file. + * mpn/sparc64/ultrasparct1/sublsh2_n.asm: New file. + * mpn/sparc64/ultrasparct1/submul_1.asm: New file. + * mpn/sparc64/ultrasparct1/gmp-mparam.h: New file. + + * configure.in: Give ultrasparct1 and ultrasparct2 special code path. + + * mpn/x86_64/pentium4/gmp-mparam.h: Disable mpn_addlsh_n, mpn_rsblsh_n. + +2010-05-12 Niels Möller + + * mpz/jacobi.c (mpz_jacobi): Fixed off-by-one error in use of + scratch space. + + * tune/common.c (speed_mpz_powm_sec): New function. + * tune/speed.h: Declare speed_mpz_powm_sec. + * tune/speed.c (routine): Added speed_mpz_powm_sec. + + * tune/common.c (speed_mpn_addlsh_n, speed_mpn_sublsh_n) + (speed_mpn_rsblsh_n): New functions. + * tune/speed.h: Declare new functions. + * tune/speed.c (routine): Add new functions. + +2010-05-12 Torbjorn Granlund + + * mpn/x86_64/mod_1_4.asm: Tune for more processors. + + * mpn/x86_64/pentium4/lshiftc.asm: New file. + +2010-05-11 Niels Möller + + * mpz/jacobi.c (mpz_jacobi): Deleted old implementation. + Reorganized new implementation, to handle small inputs efficiently. + + * tests/mpz/t-jac.c (check_large_quotients): Reduced test sizes. + (check_data): One more input pair related to a fixed bug. + (main): Enable check_large_quotients. + +2010-05-10 Torbjorn Granlund + + * mpn/x86_64/aorrlsh2_n.asm: Fix typo. + +2010-05-09 Torbjorn Granlund + + * mpn/x86_64/aorrlshC_n.asm: New file based on aorrlsh2_n.asm. + * mpn/x86_64/aorrlsh2_n.asm: Now just include aorrlshC_n.asm. + * mpn/x86_64/core2/aorrlsh1_n.asm: New file, include ../aorrlshC_n.asm. + * mpn/x86_64/core2/aorrlsh2_n.asm: Likewise. + + * mpn/x86_64/core2/sublshC_n.asm: New file based on aorslsh1_n.asm. + * mpn/x86_64/core2/aorslsh1_n.asm: Remove. + * mpn/x86_64/core2/sublsh1_n.asm: Just include sublshC_n.asm. + * mpn/x86_64/core2/sublsh2_n.asm: Likewise. + +2010-05-08 Torbjorn Granlund + + * mpn/x86_64/atom/gmp-mparam.h: Disable mpn_rsh1add_n, mpn_rsh1sub_n. + + * mpn/x86_64/pentium4/aorslshC_n.asm: New file based on aorslsh1_n.asm. + * mpn/x86_64/pentium4/aorslsh1_n.asm: Now just include aorslshC_n.asm. + * mpn/x86_64/pentium4/aorslsh2_n.asm: New file. + +2010-05-07 Torbjorn Granlund + + * mpn/sparc64: Support operands of >= 2^32 limbs. + + * mpn/sparc64/lshiftc.asm: New file. + + * mpn/ia64/divrem_2.asm: Complete rewrite. + +2010-05-06 Torbjorn Granlund + + * tune/tuneup.c (all): Don't call tune_divrem_2. + + * mpn/generic/divrem_2.c: Complete rewrite. + + * tune/tuneup.c (tune_mod_1): Fix typo. + +2010-05-05 Torbjorn Granlund + + * mpn/x86_64/mod_1_1.asm (mpn_mod_1_1p): Use macro register names. + (mpn_mod_1_1p_cps): Rewrite. + + * mpn/generic/mod_1_1.c (mpn_mod_1_1p_cps): Micro-optimise. + + * longlong.h: Undo 2009-03-01 change for powerpc64, it gives poor code. + + * mpn/x86/pentium4/sse2/mod_1_1.asm: New file. + + * mpn/powerpc64/mode64/mod_1_1.asm: New file. + + * tune/tuneup.c (tune_mod_1): Use more typical divisor, for the benefit + of machines with early-out multipliers. + +2010-05-04 Torbjorn Granlund + + * tune/tuneup.c (tune_mod_1): Fix typo. + + * mpn/generic/mod_1_1.c: Undo last change. + * mpn/x86_64/mod_1_1.asm: Likewise. + +2010-05-03 Niels Möller + + * mpn/generic/jacobi_lehmer.c (jacobi_hook): New function. + (mpn_jacobi_subdiv_step): Deleted function. + (mpn_jacobi_lehmer): Use general mpn_gcd_subdiv_step. + + * mpn/generic/gcd_subdiv_step.c (mpn_gcd_subdiv_step): Reorganized + to use a single hook function. + * mpn/generic/gcdext.c (mpn_gcdext): Adapted to new hook + interface. + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_hook): New unified hook + function. + * mpn/generic/gcd.c (gcd_hook): Renamed from gcd_done, and adapted + to new hook interface. + * gmp-impl.h (gcd_subdiv_step_hook): New typedef, now a function + type, not a struct. + (mpn_gcdext_hook): Declare. + +2010-05-03 Torbjorn Granlund + + * mpn/generic/mod_1_1.c: Avoid multiply for 2 limb feed-in. + * mpn/generic/mod_1_2.c: Likewise. + * mpn/generic/mod_1_3.c: Likewise. + * mpn/generic/mod_1_4.c: Likewise. + * mpn/x86_64/mod_1_1.asm: Likewise. + * mpn/x86_64/mod_1_2.asm: Likewise. + * mpn/x86_64/mod_1_4.asm: Likewise. + * mpn/x86/k7/mod_1_4.asm: Likewise. + * mpn/x86/pentium4/sse2/mod_1_4.asm: Likewise. + * mpn/alpha/ev6/mod_1_4.asm: Likewise. + + * tune/tuneup.c (tune_mod_1): Measure MOD_1_1_TO_MOD_1_2_THRESHOLD and + MOD_1_2_TO_MOD_1_4_THRESHOLD before MOD_1U_TO_MOD_1_1_THRESHOLD for + correctness. + + * mpn/powerpc64/sqr_diagonal.asm: Complete rewrite. + + * mpn/powerpc64/mode64/mod_1_4.asm: New file. + +2010-05-02 Torbjorn Granlund + + * config.guess: Recognise power7. + + * configure.in: Major overhaul of powerpc support. + + * mpn/powerpc64/p6/lshift.asm: New file. + * mpn/powerpc64/p6/lshiftc.asm: Likewise. + * mpn/powerpc64/p6/rshift.asm: Likewise. + +2010-04-30 Torbjorn Granlund + + * configure.in (powerpc64): Support CPU specific mode-less subdirs. + + * mpn/powerpc64/aix.m4 (PROLOGUE_cpu): Use "named csect" making + requested alignment actually honoured. + +2010-04-30 Niels Möller + + * mpn/generic/jacobi_lehmer.c (mpn_jacobi_2): Fixed handling of + the case bl == 1. Fixed missing application of reciprocity. + +2010-04-29 Niels Möller + + * configure.in (gmp_mpn_functions): Deleted gcdext_subdiv_step. + + * mpn/generic/gcdext.c (mpn_gcdext): Use new generalized + mpn_gcd_subdiv_step. + + * mpn/generic/gcdext_lehmer.c (gcdext_update): New function. + (gcdext_done): New function. + (gcdext_hook): New const hook struct. + (mpn_gcdext_lehmer_n): Use new generalized mpn_gcd_subdiv_step. + + * mpn/generic/gcd.c (gcd_done): New function. + (gcd_hook): New const hook struct. + (mpn_gcd): Adapted to new mpn_gcd_subdiv_step interface. + + * mpn/generic/gcd_subdiv_step.c (mpn_gcd_subdiv_step): Reorganized + function. Added hook function pointers to the argument list, so + the same function can be used for gcd, gcdext, and jacobi. + + * gmp-impl.h (struct gcd_subdiv_step_hook): New struct. + (mpn_gcdext_subdiv_step): Deleted prototype. + (struct gcdext_ctx): New struct. + (gcdext_hook): Declare const struct. + (mpn_gcd_subdiv_step): Updated prototype. + + * mpn/generic/gcdext_subdiv_step.c: Deleted file. + +2010-04-28 Torbjorn Granlund + + * mpn/powerpc64/lshift.asm: Rewrite. + * mpn/powerpc64/rshift.asm: Likewise. + * mpn/powerpc64/mode64/lshiftc.asm: New file. + + * mpn/powerpc64/aix.m4: Align functions to 32-byte boundary. + * mpn/powerpc64/darwin.m4: Likewise. + * mpn/powerpc64/elf.m4: Likewise. + +2010-04-28 Niels Möller + + * tests/mpz/t-jac.c (check_data): Added some more test cases. + + * mpn/generic/jacobi_lehmer.c (mpn_jacobi_2): Bugfix, count + trailing zeros, not leading. + +2010-04-27 Torbjorn Granlund + + * mpn/powerpc64/mode64/p6/mul_basecase.asm: New file. + +2010-04-23 Niels Möller + + * gmp-impl.h (MPN_GCD_LEHMER_N_ITCH): Deleted. + (mpn_gcd_lehmer_n): Deleted declaration. + + * mpn/generic/gcd.c (gcd_2): Moved from gcd_lehmer.c. + (mpn_gcd): Inlined the code from mpn_gcd_lehmer_n. Also use + MPN_GCD_SUBDIV_STEP_ITCH rather than MPN_GCD_LEHMER_N_ITCH. + +2010-04-22 Torbjorn Granlund + + * mpn/powerpc64/mode64/bdiv_dbm1c.asm: Swap multiply insns to make them + consecutive, for the benefit of POWER6. + + * mpn/powerpc64/mode64/p6/gmp-mparam.h: New file. + +2010-04-21 Torbjorn Granlund + + * mpn/generic/gcd_lehmer.c: Deleted file. + + * mpn/powerpc64/mode64/divrem_1.asm: Swap multiply insns to make them + consecutive, for the benefit of POWER6. + * mpn/powerpc64/mode64/dive_1.asm: Likewise. + * mpn/powerpc64/mode64/divrem_2.asm: Likewise. + * mpn/powerpc64/mode64/mul_1.asm: Likewise. + * mpn/powerpc64/mode64/aorsmul_1.asm: Likewise. + + * mpn/powerpc64/mode64/aorslshC_n.asm: Swap ldx operands as a temporary + workaround for POWER6 pipeline glitch. + +2010-04-19 Niels Möller + + * mpz/jacobi.c (mpz_jacobi): New implementation using + mpn_jacobi_lehmer. Currently #if:ed out. + + * mpn/generic/jacbase.c (mpn_jacobi_base) + [JACOBI_BASE_METHOD < 4]: Support inputs with a >= b. + + * gmp-impl.h (mpn_jacobi_lehmer): Added prototype. + (jacobi_table): Declare. + (mpn_jacobi_init): New inline function. + (mpn_jacobi_finish): Likewise. + (mpn_jacobi_update): Likewise. + + * mpn/generic/jacobi_lehmer.c (mpn_jacobi_lehmer): New file, new + function. + + * configure.in (gmp_mpn_functions): Added jacobi_lehmer. + +2010-04-14 Niels Möller + + * configure.in (gmp_mpn_functions): Added + matrix22_mul1_inverse_vector. + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Added + matrix22_mul1_inverse_vector.c. + + * gmp-impl.h (mpn_matrix22_mul1_inverse_vector): Updated for + rename of mpn_matrix22_mul1_inverse_vector. + * mpn/generic/gcd_lehmer.c (mpn_gcd_lehmer_n): Likewise. + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_n): Likewise. + * mpn/generic/hgcd.c (hgcd_step): Likewise. + + * mpn/generic/matrix22_mul1_inverse_vector.c + (mpn_matrix22_mul1_inverse_vector): New file, function moved and + renamed... + * mpn/generic/hgcd2.c (mpn_hgcd_mul_matrix1_inverse_vector): + ...from here. + +2010-04-12 Torbjorn Granlund + + * tests/mpn/t-toom6h.c (SIZE_LOG): Define. + * tests/mpn/t-toom8h.c (SIZE_LOG): Likewise. + +2010-04-10 Torbjorn Granlund + + * mpn/ia64/lorrshift.asm: Rewrite feed-in and wind-down code. + + * mpn/ia64/aorslsh1_n.asm: Adapt to new aorslsh1_n. + * mpn/ia64/aorslsh1_n.asm: Likewise. + + * mpn/ia64/aors_n.asm: Complete rewrite. + * mpn/ia64/aorslsh1_n.asm: Likewise. + + * mpn/ia64/add_n_sub_n.asm: Misc cleanups. Add slotting comments. + + * mpn/ia64/lshiftc.asm: New file. + + * mpn/x86_64/pentium4/gmp-mparam.h: No longer disable rsh1add_n and + rsh1sub_n; instead disable rsblsh1_n, addlsh2_n, rsblsh2_n. + + * mpn/x86/divrem_2.asm: Use "orb" instead of "or" to work around + Solaris assembler bug. + * mpn/x86_64/mpn/x86_64/divrem_2.asm: Likewise. + + * mpn/x86/aors_n.asm: Use operand-less shift-by-1 insn form. + * mpn/x86/pentium/aors_n.asm: Likewise. + * mpn/x86_64/invert_limb.asm: Likewise. + + * mpn/x86_64/pentium4/aors_n.asm: Let non-nc code fall into nc code. + + * mpn/x86_64/pentium4/rsh1aors_n.asm: New file. + +2010-03-25 Torbjorn Granlund + + * mpn/ia64/add_n_sub_n.asm: New file. + + * mpn/generic/toom33_mul.c: Fix mpn_add_n_sub_n usage. + * mpn/generic/toom3_sqr.c: Likewise. + * mpn/generic/toom63_mul.c: Likewise. + + * mpn/generic/add_n_sub_n.c: Renamed from addsub_n.c. + +2010-03-23 Torbjorn Granlund + + * mpn/x86_64/divrem_2.asm: Use mpn_invert_limb instead of div insn. + + * mpn/ia64/aorslshC_n.asm: New file, generalised from last iteration of + aorslsh1_n.asm. + * mpn/ia64/aorslsh1_n.asm: Use aorslshC_n.asm. + * mpn/ia64/aorslsh1_n.asm: New file, use aorslshC_n.asm. + +2010-03-20 Torbjorn Granlund + + * mpn/powerpc64/mode64/invert_limb.asm: Rewrite to exploit cancellation + in the Newton iteration. + +2010-03-20 Marco Bodrato + + * mpn/generic/toom_interpolate_8pts.c: Use mpn_sublsh2_n. + +2010-03-20 Torbjorn Granlund + + * mpn/powerpc64/mode64/aorslshC_n.asm: New file, generalised from + last iteration of aorslsh1_n.asm. + * mpn/powerpc64/mode64/aorslsh1_n.asm: Use aorslshC_n.asm. + * mpn/powerpc64/mode64/aorslsh1_n.asm: New file, use aorslshC_n.asm. + +2010-03-19 Torbjorn Granlund + + * mpn/x86_64/nano/dive_1.asm: New file. + + * mpn/x86_64/divrem_1.asm: Avoid shld since it is slow on several CPU + types. Unconditionally provide code for normalised and unnormalised + divisors. Cleanup labels. + + * mpn/x86_64/core2/divrem_1.asm: Remove special code for normalised + divisors. Cleanup labels. + + * mpn/generic/toom_interpolate_6pts.c: Call mpn_sublsh2_n and + mpn_sublsh_n with correct args. + + * tests/devel/try.c: Use enum for TYPE_*. + + * tests/devel/try.c: Test mpn_sublsh2_n. + * tests/refmpn.c (refmpn_sublsh2_n): New function. + * tests/tests.h (refmpn_sublsh2_n): Declare. + + * mpn/powerpc64/mode64/aorslsh1_n.asm: New file, with faster + mpn_addlsh1_n and mpn_sublsh1_n. + * mpn/powerpc64/mode64/addlsh1_n.asm: Delete. + * mpn/powerpc64/mode64/sublsh1_n.asm: Delete. + +2010-03-18 Torbjorn Granlund + + * configure.in (*-*-aix): Define gcc_32_cflags_maybe, ar_32_flags and + nm_32_flags. + + * mpn/x86/pentium4/sse2/addlsh1_n.asm: Tune for slightly better speed. + Misc cleanups. Add cycle table. + + * mpn/x86_64/copyi.asm: Update cycle table. + * mpn/x86_64/copyd.asm: Likewise. + * mpn/x86_64/rsh1aors_n.asm: Likewise. + * mpn/x86_64/dive_1.asm: Likewise. + + * mpn/x86/pentium4/sse2/add_n.asm: Misc cleanups. Add cycle table. + * mpn/x86/pentium4/sse2/sub_n.asm: Likewise. + +2010-03-16 Torbjorn Granlund + + * mpn/x86_64/divrem_1.asm: Use mpn_invert_limb instead of div insn. + * mpn/x86_64/core2/divrem_1.asm: Likewise. + + * tune/speed.c (routine): Add FLAG_R_OPTIONAL for many binops. + +2010-03-15 Torbjorn Granlund + + * mpn/alpha/ev6/mod_1_4.asm (mpn_mod_1s_4p_cps): Rewrite. + + * mpn/ia64/aors_n.asm: Insert explicitly typed nops to trigger intended + bundling. + * mpn/ia64/aorslsh1_n.asm: Likewise. + * mpn/ia64/dive_1.asm: Likewise. + +2010-03-13 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/submul_1.asm: Rewrite. + + * mpn/powerpc64/mode64/aorsmul_1.asm: New file, faster than old code + for both mpn_addmul_1 and mpn_submul_1. + * mpn/powerpc64/mode64/addmul_1.asm: Remove. + * mpn/powerpc64/mode64/submul_1.asm: Remove. + +2010-03-11 Niels Möller + + * mpn/generic/gcd_lehmer.c (gcd_2): Use sub_ddmmss. + + * mpn/generic/jacbase.c (mpn_jacobi_base): Reorganized the + JACOBI_BASE_METHOD 4 slightly. Now requires that b > 1. + +2010-03-10 Torbjorn Granlund + + * mpn/x86_64/divrem_1.asm: Make fraction code take documented # of + cycles. Annotate code for more CPUs. Misc cleanups. + * mpn/x86_64/core2/divrem_1.asm: Annotate code for more CPUs. + + * mpn/alpha/ev6/mod_1_4.asm: New file. + + * mpn/ia64/mod_34lsub1.asm: New file. + + * doc/gmp.texi (Language Bindings): Update Python site, add Ruby. + +2010-03-10 Niels Möller + + * tune/tuneup.c (tune_jacobi_base): Consider mpn_jacobi_base_4. + * tune/speed.c (routine): Added mpn_jacobi_base_4. + * tune/common.c (speed_mpn_jacobi_base_4): New function. + * tune/speed.h (speed_mpn_jacobi_base_4): Declare it. + * tune/Makefile.am (libspeed_la_SOURCES): Added jacbase4.c. + * tune/jacbase4.c: New file. + + * mpn/generic/jacbase.c (mpn_jacobi_base): New function, for + JACOBI_BASE_METHOD 4. + +2010-03-09 Niels Möller + + * tests/mpz/t-jac.c (check_large_quotients): Also generate inputs + with large quotients and a large gcd. + +2010-03-09 Marco Bodrato + + * tests/mpz/t-bin.c (randomwalk): New test-generator function. + +2010-03-07 Torbjorn Granlund + + * tune/speed.c (routine): Force r argument for several mod_1 calls. + +2010-03-06 Torbjorn Granlund + + * mpn/x86_64/divrem_1.asm: Disable SPECIAL_CODE_FOR_NORMALIZED_DIVISOR. + Misc clean up. + + * mpn/x86_64/mod_1_1.asm: New file. + * mpn/x86_64/mod_1_2.asm: New file. + * mpn/x86_64/mod_1_4.asm: Update cycle counts. + + * tests/tests.h (TESTS_REPS): Fix typo. + +2010-03-03 Torbjorn Granlund + + * mpn/x86_64/core2/divrem_1.asm: New file. + +2010-02-26 Niels Möller + + * tune/speed.c (routine): Added udiv_qrnnd_preinv3. + + * tune/common.c (speed_udiv_qrnnd_preinv3): New function. + * tune/speed.h: Added prototype for it. + +2010-02-26 Niels Möller + + * tests/mpz/t-jac.c (check_large_quotients): New test. Currently + disabled, since it's quite slow. + (mpz_nextprime_step): New function. + +2010-02-26 Torbjorn Granlund + + * mpn/pa64/aors_n.asm: Fix typo in last change. + +2010-02-25 Niels Möller + + * tests/mpz/t-jac.c (ref_jacobi): New reference implementation, + using factorization and legendre symbols computed by powm. + + * tests/devel/try.c (param_init, call): Don't pass negative values + for the second argument to mpz_jacobi and refmpz_jacobi. + + * tests/refmpz.c (refmpz_jacobi): Require that b is odd and positive. + + * tests/devel/try.c (param_init): Support mpz_legendre. + (choice_array): Added mpz_kronecker (apparently forgotten) and + mpz_legendre. + (call): Added TYPE_MPZ_LEGENDRE. + (try_one): Added support for DATA_SRC1_ODD_PRIME. + + * tests/refmpz.c (refmpz_legendre): Rewrote using powm. + +2010-02-25 Torbjorn Granlund + + * config.guess: Make "corei" default for unrecognised Intel P6 CPUs. + + * tests/mpz/t-perfpow.c (check_random): Use mp_limb_t type for limb + variables. + + * tests/mpn/t-toom6h.c (COUNT): Define. + * tests/mpn/t-toom8h.c (COUNT): Define. + + * tests/mpn/t-div.c: Cast a switch index to placate HP's cc. + * tests/mpn/t-bdiv.c: Likewise. + + * mpn/pa64/aors_n.asm: Fix support of the 2.0n ABI. + +2010-02-24 Marco Bodrato + + * tests/mpz/t-bin.c (data): Replace (2k,k), tested by twos (). + * tests/mpf/t-inp_str.c (data): Test also "+" in the exponent. + +2010-02-23 Torbjorn Granlund + + * mpn/generic/mod_1_3.c: Cast a switch index to placate HP's cc. + + * mpn/generic/sqrtrem.c: Use CNST_LIMB. + +2010-02-20 Niels Möller + + * tune/speed.h (mpn_gcd_accel): Deleted prototype. + (mpn_hgcd_lehmer): New prototype. + (MPN_HGCD_LEHMER_ITCH): New macro (previously in gmp-impl.h). + + * tune/Makefile.am (libspeed_la_SOURCES): Added hgcd_lehmer.c. + * tune/hgcd_lehmer.c: New file. + * tune/gcd_accel.c: Deleted obsolete file. + + * gmp-impl.h (MPN_HGCD_LEHMER_ITCH): Deleted macro. + + * mpn/generic/hgcd.c (mpn_hgcd_lehmer): Deleted function, + (mpn_hgcd): Don't call mpn_hgcd_lehmer, instead use inlined loop + around hgcd_step. + (mpn_hgcd_itch): Substitute n for MPN_HGCD_LEHMER_ITCH (n). + +2010-02-19 Niels Möller + + * Makefile.am (mpn/jacobitab.h): Added the rules needed to + generate this file. + + * gen-jacobitab.c: New file. + +2010-02-19 Torbjorn Granlund + + * mpn/generic/powm.c: Honour SQR_BASECASE_THRESHOLD in innerloop + expansions. + +2010-02-16 Niels Möller + + * tune/time.c (cgt_works_p): Added rudimentary sanity check for + clock_gettime working. + +2010-02-15 Niels Möller + + * tune/time.c (speed_time_init): Make use of cycle counter + configurable, via the speed_option_cycles_broken flag. + * tune/common.c (speed_option_cycles_broken): New global variable. + (speed_option_set): Recognize option "cycles-broken". + + * tune/time.c (cycles_works_p): Deleted hack to disable cycle + counter on linux. Needs to be replaced by something more + selective. + +2010-02-11 Niels Möller + + * tune/time.c (speed_time_init): Fix speed_time_string when using + clock_gettime. + (cycles_works_p): On linux, don't use the cycle counter. + + * tune/Makefile.am: Add $(TUNE_LIBS) when linking programs. + + * configure.in: Check if -lrt is needed for clock_gettime, and if + so, add that flag to TUNE_LIBS. + +2010-02-07 Torbjorn Granlund + + * tune/tuneup.c (tune_redc): Set min_size and min_is_always when + measuring REDC_1_TO_REDC_2_THRESHOLD. + (tune_mod_1): Set min_size for PREINV_MOD_1_TO_MOD_1_THRESHOLD. + + * mpn/x86_64/aorrlsh_n.asm (cnt): Fix a typo. + * mpn/x86_64/lshsub_n.asm: Likewise. + +2010-02-05 Torbjorn Granlund + + * Version 5.0.1 released. + + * mpn/generic/powm.c: Use rp target area for power table computation in + order to use less scratch. + + * mpn/generic/binvert.c (mpn_binvert_itch): Enable more economical + mpn_mulmod_bnm1_itch call. + + * mpn/generic/mu_div_qr.c: Remove always true #if. + * mpn/generic/mu_divappr_q.c: Likewise. + * mpn/generic/mu_bdiv_q.c: Likewise. + * mpn/generic/mu_bdiv_qr.c: Likewise. + +2010-02-01 Torbjorn Granlund + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*, LIBMP_LT_*): + Bump version info. + + * mpn/powerpc64/mode64/gmp-mparam.h: Remove {MUL,SQR}_FFT_TABLE2. + * mpn/x86/p6/gmp-mparam.h: Likewise. + * mpn/x86/p6/mmx/gmp-mparam.h: Likewise. + * mpn/generic/mul_fft.c: Don't depend on FFT_TABLE2, it was broken. + +2010-01-29 Torbjorn Granlund + + * mpn/generic/mul_fft.c (mpn_mul_fft_internal): Remove arguments n, m, + k and rec; add argument sqr. Don't call mpn_mul_fft_decompose here, + instead do that in all callers. + (mpn_mul_fft): Trim allocation when squaring, and use TMP_ALLOC*, not + explicit alloc/free. + (mpn_fft_div_2exp_modF): Avoid a scalar division. + (mpn_fft_mul_modF_K): Replace some multiplies by K with shifting by k. + (mpn_fft_mul_2exp_modF): Make function more symmetrical. + +2010-01-27 Torbjorn Granlund + + * mpn/generic/mu_div_q.c (mpn_mu_div_q_itch): Rewrite. + * mpn/generic/mu_div_qr.c (mpn_mu_div_qr_itch): Re-enable + better mulmod itch estimate. + * mpn/generic/mu_divappr_q.c (mpn_mu_divappr_q_itch): Likewise. + * mpn/generic/mu_bdiv_qr.c (mpn_mu_bdiv_qr_itch): Likewise. + * mpn/generic/mu_bdiv_q.c (mpn_mu_bdiv_q_itch): Likewise. + +2010-01-27 Marco Bodrato + + * mpn/generic/mu_div_qr.c (mpn_mu_div_qr_itch): Disabled guessed + estimate, enabled a conservative one. + * mpn/generic/mu_divappr_q.c (mpn_mu_divappr_q_itch): Likewise. + * mpn/generic/mu_bdiv_qr.c (mpn_mu_bdiv_qr_itch): Likewise. + * mpn/generic/mu_bdiv_q.c (mpn_mu_bdiv_q_itch): Likewise. + +2010-01-26 Marco Bodrato + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1): Partial rewrite to + reduce memory usage. + * mpn/generic/sqrmod_bnm1.c (mpn_sqrmod_bnm1): Likewise. + (mpn_sqrmod_bnm1_next_size): New function. + + * gmp-impl.h (mpn_mulmod_bnm1_itch): Accepts 3 parameters now. + (mpn_sqrmod_bnm1_itch): New inline function. + (mpn_sqrmod_bnm1_next_size): Declaration and mangling. + * mpn/generic/nussbaumer_mul.c: Use the new functions. + + * mpn/generic/invertappr.c (mpn_ni_invertappr): Use new syntax for + mpn_mulmod_bnm1_itch. + * mpn/generic/mu_divappr_q.c (mpn_mu_divappr_q_itch): Likewise. + * mpn/generic/mu_bdiv_qr.c (mpn_mu_bdiv_qr_itch): Likewise. + * mpn/generic/mu_bdiv_q.c (mpn_mu_bdiv_q_itch): Likewise. + * mpn/generic/mu_div_qr.c (mpn_mu_div_qr_itch): Likewise. + * mpn/generic/binvert.c (mpn_binvert_itch): Likewise. + * tune/speed.h (SPEED_ROUTINE_MPN_MULMOD_BNM1_CALL): Likewise. + (SPEED_ROUTINE_MPN_MULMOD_BNM1_ROUNDED): Likewise. + + * tests/mpn/t-sqrmod_bnm1.c, tests/mpn/t-mulmod_bnm1.c: Test + reduced memory usage. + +2010-01-25 Torbjorn Granlund + + * tune/tuneup.c (INSERT_FFTTAB): New macro, like old insertion code but + also inserting a sentinel. + (fftmes): Use INSERT_FFTTAB for inserting new measurements. + Limit k range to best_k - 4 ... best_k + 4. + +2010-01-23 Torbjorn Granlund + + * gmp-h.in (__GNU_MP_VERSION_PATCHLEVEL): Bump. + (__GMP_MP_RELEASE): New macro. + + * mpf/div.c: Rewrite to use mpn_div_q. + +2010-01-21 Torbjorn Granlund + + * Add FFT_TABLE3 tables for a basic set of machines. + + * configure.in: Use -mtune=nocona for 64-bit pentium4. + + * config.guess: Recognise many more Intel processors. + + * tune/common.c: Whitespace cleanup. + (speed_mpn_matrix22_mul): Rewrite. + +2010-01-21 Niels Möller + + * mpn/generic/nussbaumer_mul.c (mpn_nussbaumer_mul): Take + advantage of new mpn_mulmod_bnm1 interface, to reduce allocation. + + * tests/mpn/t-mulmod_bnm1.c (ref_mulmod_bnm1, main): Adapted to + mpn_mulmod_bnm1 interface change. + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1): Interface change, + in case an + bn < rn, only write an + bn output limbs. New input + requirement, an + bn > rn/2. + * mpn/generic/sqrmod_bnm1.c (mpn_sqrmod_bnm1): Corresponding + changes. + +2010-01-19 Torbjorn Granlund + + * tune/tuneup.c (fftmes): Round up initial n according to initial k. + Limit k to 24 in loop. Remove an obsolete always-true condition. + Remove a redundant trace printout. + +2010-01-18 Torbjorn Granlund + + * tune/tuneup.c (fftmes): New function + (fft): Rewrite. + (mpn_mul_fft_lcm): New function, copied from mpn/generic/mul_fft.c. + (fftfill): New function, code taken from mul_fft.c (mpn_mul_fft). + (cached_measure): New function. + + * gmp-impl.h (struct fft_table_nk): Moved from mul_fft.c. + (MUL_FFT_TABLE3, SQR_FFT_TABLE3): Provide dummy versions for tuneup + builds. + (FFT_TABLE3_SIZE): Increase value for tuneup builds. + + * mpn/generic/mul_fft.c: Handle a new FFT threshold table type ("3"). + Misc cleanups to old table type code. + +2010-01-16 Torbjorn Granlund + + * mpn/x86_64/darwin.m4: Fix typo in last change. + +2010-01-15 Torbjorn Granlund + + * gmp-h.in (__GMP_EXTERN_INLINE): Remove "extern" for newer Sun C. + + * gmp-impl.h (GMP_LIMB_BYTES): New define. + + * mpn/x86_64/darwin.m4 (LEA): New define. + + * mpn/x86/invert_limb.asm (approx_tab): Use DEF_OBJECT. + Rename and globalise it to work around Mac OS bug. + + With Philip McLaughlin: + * mpn/x86_64/gcd_1.asm (ctz_table): Don't use local prefix, but + use DEF_OBJECT...END_OBJECT. + Keep stack pointer at ABI mandated alignment over call. + +2010-01-12 Torbjorn Granlund + + * tune/speed.c (routine): Remove obsolete mpn_dc_tdiv_qr and + mpn_dc_div_qr_n. + * tune/common.c (speed_mpn_dc_tdiv_qr, speed_mpn_dcpi1_div_qr_n): + Remove now unused functions. + * tune/speed.h (SPEED_ROUTINE_MPN_DC_DIVREM_N, + SPEED_ROUTINE_MPN_DC_DIVREM_SB, SPEED_ROUTINE_MPN_DC_TDIV_QR): Remove + now unused macros. + + * mpn/x86_64/fat/fat_entry.asm (mpn_cpuid_available): Remove function. + + * ltmain.sh: Upgrade from 1.5.24 to 2.2.6b. + * ylwrap: New file. + * .bootstrap: Remove explicit versions. + + * doc/gmp.texi (Block-wise Barrett Division): New node. + + * mpn/generic/powm.c: Change some #if to plain 'if' to avoid fat build + problems. + +2010-01-11 Torbjorn Granlund + + * tune/speed.h (SPEED_ROUTINE_MPN_PI1_DIV): Accept arguments for size + restrictions. + * tune/common.c (speed_mpn_sbpi1_div_qr, speed_mpn_dcpi1_div_qr, + (speed_mpn_sbpi1_divappr_q, speed_mpn_dcpi1_divappr_q): Pass size + limits for SPEED_ROUTINE_MPN_PI1_DIV. + + * tune/speed.c (routine): Allow .r argument for mpn_sbpi1_divappr_q and + mpn_dcpi1_divappr_q. + +2010-01-08 Torbjorn Granlund + + * Version 5.0.0 released. + + * mpn/generic/div_q.c: Handle mpn_*_divappr_q returning high limb + everywhere. + +2010-01-07 Torbjorn Granlund + + * Update MUL_FFT_TABLE2 and SQR_FFT_TABLE2 for many machines. + + * mpn/generic/mu_div_q.c: Account for divisor truncation error as well + as mpn_mu_divappr_q's error. + + * mpn/generic/mu_div_q.c: Handle mpn_preinv_mu_divappr_q returning a + high limb. + + * tests/mpn/t-bdiv.c: Move a random call for debugability. + * tests/mpn/t-div.c: Likewise. + + * mpn/generic/mu_divappr_q.c: Rewrite quotient round-up code. + + * mpn/generic/mu_div_qr.c: Handle carry-out from a carry propagation + subtract. + * mpn/generic/mu_divappr_q.c: Likewise. + + * mpn/generic/mu_divappr_q.c + (mpn_preinv_mu_divappr_q, mpn_mu_divappr_q): Declare dividend constant. + * gmp-impl.h: Likewise. + + * perfpow.c (mpn_perfect_power_p): Call mpn_divexact instead of + mpn_bdiv_q (with too little scratch space!). + + From Niels Möller: + * tests/mpn/t-div.c (check_one): Get rid of the poorly managed variable + tn. + + * mpn/minithres/gmp-mparam.h: Add all lately defined thresholds. + + * mpn/generic/div_q.c: Use SB division for small quotients as well as + small divisors. Fix typo in itch call. + +2010-01-06 Niels Möller + + * tests/mpn/t-div.c (check_one): Checking based on multiplication, + refmpn_mul, rather than refmpn_tdiv_qr. + +2010-01-06 Marco Bodrato + + * mpn/generic/toom8h_mul.c: Avoid overflows of mp_size_t. + +2010-01-06 Torbjorn Granlund + + * gmp-h.in (__GNU_MP__): Bump. + (__GNU_MP_VERSION,__GNU_MP_VERSION_MINOR,__GNU_MP_VERSION_PATCHLEVEL): + Bump version info. + * mp-h.in (__GNU_MP__): Bump. + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*, LIBMP_LT_*): + Bump version info. + + * doc/gmp.texi: Rewrite mpn_gcdext text. Remove some out-of-date + text in Algorithms chapter. + + * mpn/generic/div_q.c: Properly handle np=scratch. Fix critical typo + in final adjustment code. Misc cleanups. + + * mpn/generic/rootrem.c: Use mpn_div_q. + * mpz/tdiv_q.c: Likewise. + + * tests/mpn/t-div.c: Test mpn_div_q. + (SIZE_LOG): Up to 17. + + * mpn/generic/div_q.c: New file. + * configure.in (gmp_mpn_functions): Add div_q. + + * mpn/generic/mu_div_q.c: Actually declare dividend constant. + +2010-01-04 Torbjorn Granlund + + * tune/tuneup.c (fft): Separate tuning of modf and full products. + (struct fft_param_t): New field, mul_modf_function. + (tune_fft_sqr): Fix typo. + (tune_fft_mul, tune_fft_sqr): Initialise mul_modf_function field. + * tune/common.c (speed_mpn_fft_mul, speed_mpn_fft_sqr): New functions. + + * tune/speed.h (SPEED_ROUTINE_MPN_MULMOD_BNM1_ROUNDED): Clean up. + + * mpn/generic/mul.c: Simplify rational expression. + + * gmp-impl.h: Cleanup threshold variables; remove obsolete ones and + make all possibly needed definitions for existing ones. + * tune/tuneup.c (tune_mul): Write fractions-compensated values to + threshold variables. + +2010-01-03 Marco Bodrato + + * tune/common.c, tune/speed.c, tune/speed.h: Support measuring + mpn_toom43_mul. + + * mpn/generic/toom_interpolate_6pts.c: Small reorganisation. + +2010-01-03 Torbjorn Granlund + + * gmp-impl.h (MUL_TO_MULMOD_BNM1_FOR_2NXN_THRESHOLD): Default to + INV_MULMOD_BNM1_THRESHOLD/2 instead. + + * gmp-impl.h (INV_APPR_THRESHOLD, INV_MULMOD_BNM1_THRESHOLD): Default + here... + * mpn/generic/invert.c, mpn/generic/invertappr.c: ...not here. + + * tests/mpn/t-div.c: Rewrite operand generation code. + +2010-01-02 Torbjorn Granlund + + * gmp-impl.h (MUL_TO_MULMOD_BNM1_FOR_2NXN_THRESHOLD): Default to + INV_MULMOD_BNM1_THRESHOLD. + +2010-01-02 Marco Bodrato + + * mpn/generic/dcpi1_div_q.c: Handle divappr approximation problem more + efficiently. + * mpn/generic/mu_div_q.c: Likewise. + + * mpn/generic/invert.c: Remove duplicated code. + +2010-01-01 Torbjorn Granlund + + * gmp-impl.h (MUL_TO_MULMOD_BNM1_FOR_2NXN_THRESHOLD): Default to 0. + + * mpn/generic/mu_div_qr.c: Rewrite to use mpn_mulmod_bnm1. Clean up + scratch usage. Improve itch functions. + * mpn/generic/mu_divappr_q.c: Likewise. + * mpn/generic/mu_bdiv_qr.c: Likewise. + * mpn/generic/mu_div_q.c: Likewise. + + * mpn/generic/dcpi1_bdiv_qr.c: Add parameter ASSERTs. + * mpn/generic/dcpi1_bdiv_q.c: Likewise. + + * tests/mpn/t-bdiv.c: Replace with unit testing code, based on t-div.c. + Increase COUNT to 500. + + * tests/mpn/t-div.c: Avoid generating too small test operands. + Move SB suppression limit downwards. Increase COUNT to 200. + +2009-12-31 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Handle numerator/remainder overlap in MU case. + + * tests/tests.h (TESTS_REPS): New macro. + * tests/mpz/dive.c: Use larger operands, decrease default reps, use + TESTS_REPS. + * tests/mpz/convert.c: Likewise. + * tests/mpz/t-sqrtrem.c: Likewise. + * tests/mpz/reuse: Likewise. + * tests/mpz/t-root.c: Likewise. + * tests/mpz/t-tdiv.c: Likewise. + * tests/mpz/t-gcd.c: Likewise. + * tests/mpz/t-powm.c: Likewise. + +2009-12-31 Marco Bodrato + + * mpn/generic/toom8_sqr.c (SQR_TOOM8_MAX): Avoid overflow. + * mpn/generic/toom6_sqr.c (SQR_TOOM6_MAX): Likewise. + + * mpn/generic/mulmod_bnm1.c: Don't mention MISUSE any more, + simply consider UNLIKELY any unexpected size. + +2009-12-31 Torbjorn Granlund + + * tune/tuneup.c (speed_mpn_sbordcpi1_div_qr): New function. + (tune_mu_div): Use it. + +2009-12-30 Torbjorn Granlund + + * tune/tuneup.c (tune_mu_bdiv, tune_dc_bdiv, tune_mu_div) + (tune_dc_div): Clear global s.r to make speed functions do 2n/n. + + * tune/speed.c (routine): New entries for mpn_mu_div_qr and + mpn_mupi_div_qr. Allow .r parameter for mpn_sbpi1_div_qr, + mpn_dcpi1_div_qr. + * tune/speed.h (SPEED_ROUTINE_MPN_PI1_DIV, SPEED_ROUTINE_MPN_MU_DIV_QR) + (SPEED_ROUTINE_MPN_MUPI_DIV_QR): Handle .r parameter. + + * tests/mpz/t-tdiv.c: Increase operands size again. + + * mpn/generic/tdiv_qr.c: Attempt to choose between DC and MU cleverer. + + * mpn/generic/tdiv_qr.c: Don't overwrite rp with unnecessary temporary + alloc. + +2009-12-29 Torbjorn Granlund + + * tune/tuneup.c (tune_mu_div): Tune MUPI_DIV_QR_THRESHOLD. + * tune/speed.h (struct speed_params): Allow 3 source operands. + (SPEED_ROUTINE_MPN_MUPI_DIV_QR): New macro. + * tune/common.c (speed_mpn_mupi_div_qr): New function. + + * mpn/generic/tdiv_qr.c: Call mpn_mu_div_qr. + + * tests/mpz/t-tdiv.c: Use larger test operands. + + * mpn/generic/mu_div_qr.c (mpn_mu_div_qr2): Remove code for dn==1. + + * mpz/mul.c: Call mpn_sqr directly. Use PTR,SIZ,ALLOC. + + * tune/tuneup.c (tune_mu_div): Set min_size to 6, DC functions require + this. + + * tests/mpn/t-div.c: Call mu_div functions with operands that generate + a high quotient limb. + + * mpn/generic/mu_div_qr.c: Rewrite to return a high quotient limb, + to let dividend argument be constant, and as a general cleanup. + * mpn/generic/mu_divappr_q.c: Likewise. + * mpn/generic/mu_div_q.c: Likewise. + * gmp-impl.h: Update declarations of changed functions. + + * mpn/generic/invertappr.c (mpn_invertappr): Allocate scratch space + when caller passed NULL. + +2009-12-28 Torbjorn Granlund + + * mpn/generic/toom_couple_handling.c: Prefix name with mpn_. + * gmp-impl.h: Likewise. + * mpn/generic/toom63_mul.c: Likewise. + * mpn/generic/toom6_sqr.c: Likewise. + * mpn/generic/toom6h_mul.c: Likewise. + * mpn/generic/toom8_sqr.c: Likewise. + * mpn/generic/toom8h_mul.c: Likewise. + + * configure.in (gmp_mpn_functions_optional) Move "com" from here... + (gmp_mpn_functions): ...to here. + * mpn/generic/com.c: New file. + * (mpn_com): New name for mpn_com_n. Make public. + * (mpn_neg): Analogous changes. + + * tune/tuneup.c (tune_mu_div, tune_mu_bdiv): Set step_factor. + + * tune/common.c, tune/speed.c, tune/speed.h: Support measuring + mpn_lshiftc. + + * tests/devel/try.c: Test mpn_lshiftc. + * tests/refmpn.c (refmpn_com): New function. + (refmpn_lshiftc): Likewise. + + * configure.in (gmp_mpn_functions_optional) Move lshiftc from here... + (gmp_mpn_functions): ...to here. + * mpn/generic/lshiftc.c: New file. + * mpn/x86_64/lshiftc.asm: New file. + * mpn/x86_64/core2/lshiftc.asm: New file. + * mpn/generic/mul_fft.c (mpn_lshiftc): Remove. + + * mpn/x86_64/core2/lshift.asm: Tweak for better Core iN performance. + * mpn/x86_64/core2/rshift.asm: Likewise. + +2009-12-27 Marco Bodrato + + * mpn/generic/mul.c: Use toom6h and toom8h for almost balanced. + + * mpn/generic/mullo_n.c (mpn_dc_mullo_n): New ratio, to be used in + Toom-8 range. + +2009-12-27 Torbjorn Granlund + + * (mpn_sqr): New name for mpn_sqr_n. Many files affected. + + * tune/tuneup.c (tune_mullo): Up step_factor for MULLO_MUL_N_THRESHOLD. + (tune_invertappr, tune_invert, tune_binvert): Let max_size default. + + * tune/tuneup.c (tune_mu_div, tune_mu_bdiv) New functions. + * tune/speed.h (SPEED_ROUTINE_MPN_MU_DIV_Q): New macro. + (SPEED_ROUTINE_MPN_MU_DIV_QR): Likewise. + (SPEED_ROUTINE_MPN_MU_BDIV_Q): Likewise. + (SPEED_ROUTINE_MPN_MU_BDIV_QR): Likewise. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add bdiv_q.c and bdiv_qr.c. + * tune/common.c (speed_mpn_mu_div_qr): New function. + (speed_mpn_mu_divappr_q): Likewise. + (speed_mpn_mu_div_q): Likewise. + (speed_mpn_mu_bdiv_q): Likewise. + (speed_mpn_mu_bdiv_qr): Likewise. + + * mpn/*/gmp-mparam.h: Fix incorrect MOD_1U_TO_MOD_1_1_THRESHOLD 0 + values. + + * gmp-impl.h (MODEXACT_1_ODD_THRESHOLD): Remove. + (BMOD_1_TO_MOD_1_THRESHOLD): New parameter, with the reverse meaning of + MODEXACT_1_ODD_THRESHOLD. + (MPN_MOD_OR_MODEXACT_1_ODD): Use BMOD_1_TO_MOD_1_THRESHOLD. + * mpn/generic/divis.c, mpz/{cong.c,cong_ui.c,divis_ui.c}: Likewise. + * tune/tuneup.c (tune_modexact_1_odd): Tune BMOD_1_TO_MOD_1_THRESHOLD; + Do not assume native mpn_modexact_1_odd is faster than mpn_mod_1. + (tuned_speed_mpn_mod_1): Remove variable. + (tune_mod_1): Fix thinkos. Suppress printing of "always" etc. + (all): Measure for divrem_1, mod_1, divexact_1, etc first, since Toom + depends on some of them. + + * mpn/generic/toom22_mul.c (TOOM22_MUL_REC): New name for + TOOM22_MUL_MN_REC. + +2009-12-26 Niels Möller + + * tests/mpn/t-toom32.c (MIN_AN, MIN_BN, MAX_BN): Relax + requirements a bit. + + * mpn/generic/toom32_mul.c (mpn_toom32_mul): Relax requirement on + input sizes, to support s+t>=n (used to be s+t>=n+2). Keep high + limbs of the evaluated values in scalar variables. + + * mpn/generic/sbpi1_divappr_q.c (mpn_sbpi1_divappr_q): Remove + unused variables. + + * mpn/generic/toom32_mul.c (mpn_toom32_mul): Fixed left-over use + of mpn_addsub_n which should be mpn_add_n_sub_n. + +2009-12-26 Marco Bodrato + + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add new toom files (spotted by Torbjorn). + + * gmp-impl.h (mpn_toom6_sqr_itch): Rename to mpn_toom6_mul_n_itch and redefine. + (mpn_toom8_sqr_itch): Rename to mpn_toom8_mul_n_itch and redefine. + * mpn/generic/mul_n.c: Use renamed _itch macros. + +2009-12-25 Niels Möller + + * tests/mpn/t-toom32.c (MIN_AN, MIN_BN, MAX_BN): Tightened requirements. + * gmp-impl.h (mpn_toom32_mul_itch): Updated. Less scratch needed + by toom32 itself, and also the pointwise multiplications are + currently mpn_mul_n with no supplied scratch. + * mpn/generic/toom32_mul.c (mpn_toom32_mul): Reorganized + interpolation to use less scratch space. No longer supports the + most extreme size ratios. + +2009-12-25 Torbjorn Granlund + + * tune/tuneup.c (tune_preinv_mod_1): Purge. + (tune_mod_1): Use speed_mpn_mod_1_tune for + PREINV_MOD_1_TO_MOD_1_THRESHOLD + + * mpn/generic/dcpi1_divappr_q.c: Handle 2n/n properly. Don't use full + precision in mpn_sbpi1_divappr_q call. Misc cleanup. + + * tune/tuneup.c (tune_mod_1): Add a check_size for + PREINV_MOD_1_TO_MOD_1_THRESHOLD. + +2009-12-24 Torbjorn Granlund + + * tune/mod_1_div.c (MOD_1N_TO_MOD_1_1_THRESHOLD, + (MOD_1U_TO_MOD_1_1_THRESHOLD): Set. + * tune/mod_1_inv.c (MOD_1N_TO_MOD_1_1_THRESHOLD, + (MOD_1U_TO_MOD_1_1_THRESHOLD): Set. + + * gmp-impl.h (USE_PREINV_MOD_1): Remove. + (MPN_MOD_OR_PREINV_MOD_1): Define to choose functions dynamically in + terms of PREINV_MOD_1_TO_MOD_1_THRESHOLD (used to choose statically + using USE_PREINV_MOD_1). + * mpn/generic/perfsqr.c (PERFSQR_MOD_PP): Corresponding updates. + + * tune/tuneup.c (tune_mod_1): Rewrite. + * gmp-impl.h (MOD_1N_TO_MOD_1_1_THRESHOLD): New. + (MOD_1U_TO_MOD_1_1_THRESHOLD): New name for MOD_1_1_THRESHOLD. + (MOD_1_1_TO_MOD_1_2_THRESHOLD): Mew name for MOD_1_2_THRESHOLD. + (MOD_1_2_TO_MOD_1_4_THRESHOLD): New name for MOD_1_4_THRESHOLD. + * mpn/generic/mod_1.c: Corresponding updates. + +2009-12-24 Marco Bodrato + + * mpn/generic/mul_n.c: Use also toom6h and toom8h. + * mpn/generic/sqr_n.c: Use also toom6 and toom8. + * gmp-impl.h: Initial support for tuning of Toom-6half and Toom-8half. + * tune/tuneup.c: Tune Toom-6half and Toom-8half thresholds. + +2009-12-24 Torbjorn Granlund + + * mpn/generic/mod_1_4.c: Get ASSERT right. + * mpn/generic/mod_1_3.c: Likewise. + * mpn/generic/mod_1_2.c: Likewise. + + * mpn/generic/powm_sec.c: Use SQR_TOOM2_THRESHOLD as limit for a native + mpn_sqr_basecase, not TUNE_SQR_TOOM2_MAX. + +2009-12-23 Marco Bodrato + + * tune/common.c, tune/speed.c, tune/speed.h: Support for measuring + mpn_toom8h_mul and mpn_toom8_sqr speed. + + * mpn/generic/toom_eval_pm2exp.c: Fix ASSERTs. + + * mpn/generic/toom8h_mul.c: New file. + * mpn/generic/toom8_sqr.c: New file. + * mpn/generic/toom_interpolate_16pts.c: New file. + * gmp-impl.h: Provide corresponding declarations. + * configure.in (gmp_mpn_functions): List toom_interpolate_16pts, + toom8h_mul, and toom8h_sqr. + * tests/mpn/t-toom8h.c: New test program. + + * mpn/generic/toom6_sqr.c: New file, was part of toom6h_mul. + * mpn/generic/toom6h_mul.c: Removed _sqr. + + * mpn/generic/mulmod_bnm1.c: Nailify CRT. + * mpn/generic/sqrmod_bnm1.c: Likewise. + + * mpn/generic/mullo_n.c: Split dc_mullo_n function; + ALLOC memory at once. + + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Update. + + * mpn/generic/toom6h_mul.c: Add prefix to toom_interpolate_12pts. + * mpn/generic/toom_interpolate_12pts.c: Likewise. + + * mpn/generic/invertappr.c (mpn_bc_invertappr): Use mpn_divrem_2. + * mpn/generic/invert.c: Faster basecase, use mpn_sbpi1_div_q. + + * mpn/generic/toom_eval_pm2exp.c: Assert support for degree 3. + * mpn/generic/toom6h_mul.c: Avoid obsolete _itch function. + +2009-12-23 Torbjorn Granlund + + * tune/common.c, tune/speed.c, tune/speed.h: Support for measuring + mpn_mod_1_1p, mpn_mod_1s_2p, mpn_mod_1s_3p, mpn_mod_1s_4p. + + * tests/mpz/t-powm.c: Test mpz_powm_sec. + + * mpz/powm_sec.c: New file. + * gmp-h.in: Declare it. + * Makefile.am, mpz/Makefile.am: Compile it. + * doc/gmp.texi: Document it. + + * mpn/generic/powm_sec.c (mpn_powm_sec_itch): New function. + (mpn_powm_sec): Use passed scratch, no local allocation. + Allow exp argument = 1. + (win_size): Start loop from 1. + + * mpn/generic/powm.c (win_size): Start loop from 1. + +2009-12-22 Torbjorn Granlund + + * tests/mpn/t-div.c: New file. + * tests/mpn/Makefile.am: Compile it. + + * mpn/generic/mu_divappr_q.c: Handle quotient overflow. + + * mpn/generic/mu_div_q.c (mpn_mu_div_q_itch): New function. + +2009-12-22 Niels Möller + + * mpn/generic/sbpi1_div_q.c: Use udiv_qr_3by2. Intended to change + nothing after preprocessing. + + * mpn/generic/sbpi1_divappr_q.c: For the last call to udiv_qr_3by2, + avoid using memory locations as output parameters, and revert to + explicitly copying n1 and n0 to memory. + + * gmp-impl.h (udiv_qr_3by2): Tweaked to expand to precisely the + same code as was used before the introduction of this macro. + Eliminated some local variables, instead do multiple updates to + the output parameters. + +2009-12-22 Torbjorn Granlund + + * tests/mpn/t-toom6h.c (MIN_AN): Set to MUL_TOOM6H_THRESHOLD to avoid + invalid recursive sizes. + + * tests/mpn/t-bdiv.c: Get itch function calls right. + + * mpn/generic/mu_bdiv_q.c (mpn_mu_bdiv_q_itch): Rewrite. + * mpn/generic/mu_bdiv_qr.c (mpn_mu_bdiv_qr_itch): Simplify. + + * mpn/generic/bdiv_qr.c (mpn_bdiv_qr): Simplify, don't allocate. + (mpn_bdiv_qr_itch): Conditionalise on MU_BDIV_QR_THRESHOLD. + +2009-12-18 Niels Möller + + * tests/mpn/t-bdiv.c: Add red-zones. + +2009-12-21 Torbjorn Granlund + + * mpn/generic/sbpi1_div_q.c: Fix fixup code to work for qn = 0. + + * mpn/generic/dcpi1_divappr_q.c: Handle qn = 1 and qn = 2 for initial + quotient block (code block copied from dcpi1_div_qr.c). + + * mpn/generic/dcpi1_div_qr.c: Rewrite singular case giving q limb of + GMP_NUMB_MAX. Remove an impossible qn = 0 case. + + * mpn/generic/dcpi1_bdiv_q.c: Remove a spurious mpn_sub_1. + + * mpn/generic/mul.c: Put back call to mpn_mul_n. + + * tune/tuneup.c (all): Call tune_mulmod_bnm1 before tuning fft due to + dependency on mulmod_bnm1 from both mul_fft_mul and from mullo_n. + + * mpn/generic/dcpi1_divappr_q.c: ASSERT that dn >= 6 and nn > dn. + * mpn/generic/dcpi1_div_q.c: ASSERT that dn >= 6 and nn-dn >= 3. + * mpn/generic/dcpi1_div_qr.c: ASSERT that dn >= 6 and nn-dn >= 3. + + * mpn/generic/bdiv_q_1.c (mpn_pi1_bdiv_q_1): Renamed from + mpn_bdiv_q_1_pi1. + * All references changed. + + * configure.in: Add --enable-old-fft-full. + * tune/speed.c (routine): Conditionalise mpn_mul_fft_full references on + WANT_OLD_FFT_FULL. + * tune/common.c (speed_mpn_mul_fft_full) + (speed_mpn_mul_fft_full_sqr): Likewise. + * mpn/generic/mul_fft.c (mpn_mul_fft_full): Include iff + WANT_OLD_FFT_FULL. + +2009-12-21 Marco Bodrato + + * gmp-impl.h (mpn_toom6h_mul_itch): New inline function. + (MUL_TOOM6H_THRESHOLD): Default value. + (SQR_TOOM6_THRESHOLD): Default value. + * mpn/generic/toom6h_mul.c: Remove definitions moved to gmp-impl.h. + * tune/common.c, tune/speed.c, tune/speed.h: Support for measuring + mpn_toom6h_mul and mpn_toom6_sqr speed. + + * mpn/generic/toom63_mul.c: Remove unused TMP_*. + + * mpn/generic/toom_eval_pm2rexp.c: New file. + * gmp-impl.h: Provide corresponding declaration. + * configure.in (gmp_mpn_functions): List toom_eval_pm2rexp. + * mpn/generic/toom6h_mul.c: Use shared toom_eval_pm2rexp. + + * mpn/generic/toom_couple_handling.c: New file, helper function + for high degree Toom. + * gmp-impl.h: Provide corresponding declaration. + * configure.in (gmp_mpn_functions): List toom_couple_handling. + * mpn/generic/toom6h_mul.c: Use shared toom_couple_handling. + * mpn/generic/toom63_mul.c: Likewise. + + * mpn/generic/toom6h_mul.c: New file. + * mpn/generic/toom_interpolate_12pts.c: New file. + * gmp-impl.h: Provide corresponding declarations. + * configure.in (gmp_mpn_functions): List toom_interpolate_12pts, + toom6h_mul. + * tests/mpn/t-toom6h.c: New test program. + + * tests/mpn/t-mulmod_bnm1.c (ref_mulmod_bnm1): Use ref_mul. + * tests/mpn/t-sqrmod_bnm1.c (ref_sqrmod_bnm1): Likewise. + +2009-12-20 Marco Bodrato + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1): New CRT. + * mpn/generic/sqrmod_bnm1.c (mpn_sqrmod_bnm1): Likewise. + +2009-12-20 Torbjorn Granlund + + * Change all bit counts for bignums to use mp_bitcnt_t. + + * mpn/generic/bdivmod.c: File removed. All references purged. + + * mpn/generic/mul_fft.c (mpn_mul_fft_full): Disable. + + * gmp-impl.h: Define mpn_fft_mul as an alias for mpn_nussbaumer_mul. + * mpn/generic/mul.c: Refer mpn_fft_mul. + * mpn/generic/mul_n.c: Likewise. + * mpn/generic/sqr_n.c: Likewise. + * mpn/generic/mullo_n.c: Likewise. + + * mpn/generic/mul.c: Loop also over mpn_nussbaumer_mul, as suggested by + Marco. Use TMP_SALLOC_LIMBS in more places. Clean up ws allocation. + +2009-12-19 Marco Bodrato + + * mpn/generic/toom_interpolate_8pts.c: Nailify. + +2009-12-19 Torbjorn Granlund + + * mpn/generic/mul.c: Major rewrite. Use toom43, toom53, toom63. + Call mpn_nussbaumer_mul for largest operands. + + * tune/speed.h (SPEED_ROUTINE_MPN_TOOM32_FOR_TOOM43_MUL): New macro. + (SPEED_ROUTINE_MPN_TOOM43_FOR_TOOM32_MUL): New macro. + (SPEED_ROUTINE_MPN_TOOM32_FOR_TOOM53_MUL): New macro. + (SPEED_ROUTINE_MPN_TOOM53_FOR_TOOM32_MUL): New macro. + (SPEED_ROUTINE_MPN_TOOM42_FOR_TOOM53_MUL): New macro. + (SPEED_ROUTINE_MPN_TOOM53_FOR_TOOM42_MUL): New macro. + * tune/common.c (speed_mpn_toom63_mul): New function. + (speed_mpn_toom32_for_toom43_mul): New function. + (speed_mpn_toom43_for_toom32_mul): New function. + (speed_mpn_toom32_for_toom53_mul): New function. + (speed_mpn_toom53_for_toom32_mul): New function. + (speed_mpn_toom42_for_toom53_mul): New function. + (speed_mpn_toom53_for_toom42_mul): New function. + * tune/tuneup.c (tune_mul_n): New name for old tune_mul. + (tune_sqr_n): New name for old tune_sqr. + (tune_mul): New function, for unbalanced multiplication. + * gmp-impl.h: Provide declarations for corresponding threshold vars. + + * gmp-impl.h (mpn_rsh1add_nc, mpn_rsh1sub_nc): Declare. + * mpn/asm-defs.m4: Likewise. + * configure.in: Add corresponding HAVE_NATIVEs. + * mpn/x86_64/rsh1aors_n.asm: Add _nc entry point. + +2009-12-18 Niels Möller + + * mpz/divexact.c: Rewrite to use mpn_divexact. + + * mpn/generic/bdiv_q_1.c (mpn_bdiv_q_1): Deleted some unused + variables. + + * mpn/generic/toom52_mul.c (mpn_toom52_mul) + [HAVE_NATIVE_mpn_add_n_sub_n]: Moved declaration of cy to avoid a + compiler warning. + + * gmp-impl.h (gmp_pi1_t): Eliminated inv21 member. + (invert_pi1): ...and don't store it here. + + * mpn/generic/toom63_mul.c (mpn_toom63_mul): Simplified + calculation of block size n. + * gmp-impl.h (mpn_toom63_mul_itch): Likewise. + + * mpn/generic/toom_eval_pm2exp.c (mpn_toom_eval_pm2exp): Fixed + output asserts. + +2009-12-18 Torbjorn Granlund + + * tests/mpn/t-toom63.c: New test program. + +2009-12-18 Marco Bodrato + + * mpn/generic/invert.c: Nailify. + * mpn/generic/invertappr.c: Nailify. + * mpn/generic/mulmod_bnm1.c: Nailify. + * mpn/generic/sqrmod_bnm1.c: Nailify. + + * tests/mpn/t-invert.c: New test program. + + * mpn/generic/toom63_mul.c: New file. + * mpn/generic/toom_interpolate_8pts.c: New file. + * gmp-impl.h: Provide corresponding declarations. + * configure.in (gmp_mpn_functions): List toom_interpolate_8pts and + toom63_mul. + +2009-12-17 Torbjorn Granlund + + * mpn/generic/mul.c: Move allocation of ws to where it is used. + Identify toom22, 32, 42, in that order (in two places). Use midline + between toom22, 32, 42. + * mpn/generic/toom22_mul.c (TOOM22_MUL_MN_REC): Call also + mpn_toom32_mul. + + * doc/gmp.texi: Update References section. Update Contributors + section. Misc updates. + + * gmp-impl.h: Renew default values for all THRESHOLDs. + +2009-12-17 Niels Möller + + * mpn/generic/divexact.c (mpn_divexact): Don't require that the + dividend is normalized. Use MPN_DIVREM_OR_PREINV_DIVREM_1. When + shifting, allocate and process only the low qn+1 limbs. Eliminated + code for the impossible case nn < qn. + + * mpn/generic/dcpi1_div_qr.c (mpn_dcpi1_div_qr): Added some input + asserts. + + * mpn/generic/dcpi1_div_qr.c (mpn_dcpi1_div_qr): In the case that + the initial quotient block is a single limb, use 3/2 division, + thereby eliminating the only use of gmp_pi1_t->inv21. + +2009-12-17 Marco Bodrato + + * mpn/generic/invert.c: Added some comment. + * mpn/generic/invertappr.c: Slightly better threshold handling. + * gmp-impl.h (INV_NEWTON_THRESHOLD): Default to 200. + + * mpn/generic/nussbaumer_mul.c: New file. + * configure.in (gmp_mpn_functions): Add nussbaumer_mul. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add nussbaumer_mul. + * gmp-impl.h (mpn_nussbaumer_mul): Added prototype and name-mangling. + * tune/speed.h (speed_mpn_nussbaumer_mul): Declare function. + * tune/common.c (speed_mpn_nussbaumer_mul): New function. + * tune/speed.c (routine): Add speed_mpn_nussbaumer_mul. + + * mpn/generic/sqrmod_bnm1.c: New file. + * configure.in (gmp_mpn_functions): Add sqrmod_bnm1. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add sqrmod_bnm1. + * gmp-impl.h (mpn_sqrmod_bnm1): Added prototype and name-mangling. + (SQRMOD_BNM1_THRESHOLD): support for the new threshold. + * tune/speed.h (speed_mpn_sqrmod_bnm1): Declare function. + * tune/common.c (speed_mpn_sqrmod_bnm1): New function. + * tune/speed.c (routine): Add speed_mpn_sqrmod_bnm1. + * tests/mpn/t-mulmod_bnm1.c: Attribution. + * tests/mpn/t-sqrmod_bnm1.c: New test file. + * tests/mpn/Makefile.am (check_PROGRAMS): Add t-sqrmod_bnm1. + + * tune/tuneup.c: Tune SQRMOD_BNM1_THRESHOLD. + + * mpn/generic/nussbaumer_mul.c (mpn_nussbaumer_mul): Mimic fft_mul, + use squaring if operands coincide. + * tune/speed.h (speed_mpn_nussbaumer_mul_sqr): Declare function. + * tune/common.c (speed_mpn_nussbaumer_mul_sqr): New function. + * tune/speed.c (routine): Add speed_mpn_nussbaumer_mul_sqr. + +2009-12-17 Torbjorn Granlund + + * mpn/generic/bdiv_q.c (mpn_bdiv_q_itch): Rewrite. + +2009-12-16 Torbjorn Granlund + + * tests/mpn/t-bdiv.c (bdiv_q_valid_p, bdiv_qr_valid_p): Call refmpn_mul + instead of refmpn_mul_basecase. + * tests/mpn/toom-shared.h: Likewise. + * tests/refmpn.c (refmpn_mullo_n,refmpn_sqr,refmpn_mul_any): Likewise. + + * minithres/gmp-mparam.h: Add new thresholds, trim old values. + + * mpn/generic/powm.c: Use mp_bitcnt_t for bit counts. + Handle REDC_1_TO_REDC_N_THRESHOLD < MUL_TOOM22_THRESHOLD in + non-WANT_REDC_2 INNERLOOP expansion code. + * mpn/generic/powm_sec.c: Use mp_bitcnt_t for bit counts. + +2009-12-16 Niels Möller + + * tests/mpz/t-gcd.c (main): Added test case to exercise the + unlikely u0 == u1 case in mpn_gcdext_lehmer_n. + + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_n): Get ASSERT + right. + +2009-12-16 Torbjorn Granlund + + * tests/mpz/t-mul.c: Misc cleanups. + (mul_basecase): Remove. + (ref_mpn_mul): Remove. + * tests/refmpn.c (refmpn_mul): New function, mainly from t-mul.c's + ref_mpn_mul. + (refmpn_mullo_n): Add a missing free. + + * tune/speed.c (routine): Measure speed_mpn_{sb,dc}pi1_div_qr, + mpn_{sb,dc}pi1_divappr_q, mpn_{sb,dc}pi1_bdiv_qr, and + mpn_{sb,dc}pi1_bdiv_q. + + * mpn/generic/invertappr.c: New file, meat from invert.c. + * mpn/generic/invert.c: Leave just mpn_invert.c. + * configure.in (gmp_mpn_functions): Add invertappr. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add invertappr.c. + * gmp-impl.h (mpn_invert_itch, mpn_invertappr_itch): New macros. + +2009-12-15 Torbjorn Granlund + + * mpn/generic/gcdext_subdiv_step.c: Get an ASSERT right. + +2009-12-15 Niels Möller + + * mpn/generic/sbpi1_div_qr.c (mpn_sbpi1_div_qr): A very small step + towards nail support. + +2009-12-15 Marco Bodrato + + * gmp-impl.h (mpn_ni_invertappr): Added prototype and name-mangling. + * mpn/generic/mulmod_bnm1.c: Comment representation of class [0]. + +2009-12-14 Niels Möller + + * mpn/generic/sbpi1_divappr_q.c (mpn_sbpi1_divappr_q): Use + udiv_qr_3by2. + +2009-12-14 Torbjorn Granlund + + * tune/tuneup.c (tune_binvert): Remove BINV_MULMOD_BNM1_THRESHOLD + tuning, it was always zero and caused BINV_NEWTON_THRESHOLD to be + wrong (as pointed out by Marco). + * (BINV_MULMOD_BNM1_THRESHOLD): Clean from other files too. + +2009-12-14 Marco Bodrato + + * mpn/generic/invert.c: Improved comments. + (mpn_bc_invertappr): Conditionally re-enable mpn_dcpi1_divappr_q. + +2009-12-14 Niels Möller + + * gmp-impl.h (udiv_qr_3by2): Fix typo in argument list. + +2009-12-13 Niels Möller + + * gmp-impl.h (udiv_qr_3by2): New macro. + * mpn/generic/sbpi1_div_qr.c (mpn_sbpi1_div_qr): Use udiv_qr_3by2. + +2009-12-13 Torbjorn Granlund + + * mpn/generic/dcpi1_divappr_q.c (mpn_dcpi1_divappr_q): Avoid a buffer + overrun. + + * mpn/generic/mul_fft.c (mpn_mul_fft_full): Handle carry-out from 2nd + mpn_mul_fft, add an ASSERT for the 1st mpn_mul_fft. Replace some + comments on cc's range with ASSERTs. + + * mpn/generic/gcdext.c (compute_v): Normalise tp[] after mpn_mul. + + * mpz/powm.c: Rework buffer handling. + +2009-12-13 Niels Möller + + * tests/mpn/toom-shared.h (main): Use refmpn_mul_basecase to check + results (slow!). Iteration counts of all toom tests reduced + considerably. + +2009-12-13 Marco Bodrato + + * mpn/generic/invert.c (mpn_invertapp): Split in _bc and _ni. + (mpn_bc_invertappr): New function, the basecase. + (mpn_ni_invertapp): New function, Newton iteration. + (mpn_invert): Use mpn_ni_invertapp. + * tune/tuneup.c (tune_invert): Min for INV_APPR_THRESHOLD. + (tune_invertappr): Min for INV_NEWTON_THRESHOLD. + + * tune/speed.h (SPEED_ROUTINE_MPN_NI_INVERTAPPR): New macro. + (speed_mpn_ni_invertappr): Declare function. + * tune/common.c (speed_mpn_ni_invertappr): New function. + * tune/speed.c (routine): Add speed_mpn_ni_invertappr. + + * tune/tuneup.c (tune_invertappr): Use speed_mpn_ni_invertappr to + tune INV_MULMOD_BNM1_THRESHOLD. + +2009-12-12 Torbjorn Granlund + + * mpn/generic/mu_bdiv_qr.c (mpn_mu_bdiv_qr_itch): Rewrite. + +2009-12-12 Marco Bodrato + + * tests/mpn/t-mulmod_bnm1.c (main): Disable B^n+1 stressing test + for odd sizes. + + * mpn/generic/invert.c: Complete rewrite. Uses Newton iterations. + * gmp-impl.h (mpn_invertappr): Added prototype and name-mangling. + (mpn_invertappr_itch): Added prototype and name-mangling. + (INV_APPR_THRESHOLD): Support for a new tunable const. + * tune/speed.h (SPEED_ROUTINE_MPN_INVERTAPPR): New macro. + (speed_mpn_invertappr): Declare function. + * tune/common.c (speed_mpn_invertappr): New function. + * tune/speed.c (routine): Add speed_mpn_invertappr. + * tune/tuneup.c (tune_invertappr): New function: was tune_invert. + (tune_invert): Now tune only INV_APPR_THRESHOLD. + (all): Enable call to tune_invert and tune_invertappr. + +2009-12-11 Torbjorn Granlund + + * mpn/generic/binvert.c: Use mpn_mulmod_bnm1 instead of FFT wrapping. + Old, evidently broken wrapping code removed. + * tune/tuneup.c (tune_binvert): Tune BINV_MULMOD_BNM1_THRESHOLD. + * gmp-impl.h: Provide declarations for corresponding threshold var. + + * tests/mpn/t-bdiv.c (COUNT): Decrease to keep run time reasonable. + + * tune/tuneup.c (tune_invert): Tune INV_MULMOD_BNM1_THRESHOLD. + * gmp-impl.h: Provide declarations for corresponding threshold var. + + * tests/mpn/t-mulmod_bnm1.c: Avoid a division by zero. + + * configure.in: Set up different paths for different 64-bit sparc + processors. + * mpn/sparc64/ultrasparc34/gmp-mparam.h: New file. + +2009-12-10 Torbjorn Granlund + + * mpn/*/gmp-mparam.h: Regenerate many of these files. + +2009-12-10 Niels Möller + + * gmp-impl.h (mpn_divexact): Removed scratch pointer from + prototype. + * mpn/generic/gcdext.c (divexact): Deleted, moved to... + * mpn/generic/divexact.c (mpn_divexact): New implementation (moved + from gcdext.c). The bidirectional divexact is kept but #if:ed out. + Interface change, since the new code doesn't take a scratch + argument. + + * tests/mpn/t-mulmod_bnm1.c (main): Ensure that an >= bn. Lowered + MIN_N to 1. Various fixes to handle n == 1 properly. + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1): Small interface + change, require an >= bn. + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1): Fixed non-recursive + case to not write beyond end of result area. + +2009-12-09 Torbjorn Granlund + + * tune/speed.h (SPEED_ROUTINE_MPN_MULMOD_BNM1_CALL): New macro, made + from now deleted SPEED_ROUTINE_MPN_MULMOD_BNM1. + * tune/common.c (speed_mpn_bc_mulmod_bnm1): New function. + (speed_mpn_mulmod_bnm1): Use SPEED_ROUTINE_MPN_MULMOD_BNM1_CALL. + * tune/speed.c (routine): Add mpn_bc_mulmod_bnm1. + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1_next_size): Rewrite. + + * tune/tuneup.c (tune_mulmod_bnm1): Rewrite. + +2009-12-08 Marco Bodrato + + * mpn/generic/mulmod_bnm1.c (mpn_bc_mulmod_bnm1, + mpn_bc_mulmod_bnp1): Added a parameter for scratch area, possibly + same as result area (as suggested by Niels Möller). + (mpn_mulmod_bnm1): Calls changed accordingly. + +2009-12-08 Niels Möller + + * mpn/generic/gcdext_1.c (mpn_gcdext_1) [GCDEXT_1_USE_BINARY]: Use + table lookup for count_trailing_zeros. Binary algorithm still + disabled by default. + + * mpn/generic/gcdext.c (divexact): Local definition of divexact, + using mpn_bdiv_q. + (compute_v): Use it. + + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-bdiv. + + * tests/mpn/t-bdiv.c: New file. + + * mpn/generic/bdiv_q.c (mpn_bdiv_q): Fixed bad quotient length, + should have qn == nn. + + * mpn/generic/bdiv_qr.c (mpn_bdiv_qr): Pass correct nn length to + the lower-level functions. + +2009-12-08 Torbjorn Granlund + + * tune/speed.h (SPEED_ROUTINE_MPN_MULMOD_BNM1_ROUNDED): New define. + * tune/common.c (speed_mpn_mulmod_bnm1_rounded): New function. + * tune/speed.c (routine): Add mpn_mulmod_bnm1_rounded for measuring + mpn_mulmod_bnm1 at recommended sizes. + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1_next_size): Rewrite. + (mpn_bc_mulmod_bnm1): Use mpn_add_n instead of mpn_add. + + * tune/speed.c (routine): Add mpn_invert. + + * tune/tuneup.c (tune_invert): New function. + * tune/speed.h (SPEED_ROUTINE_MPN_INVERT): New macro. + * tune/common.c (speed_mpn_invert): New function. + * gmp-impl.h: Provide declarations for corresponding threshold var. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add invert.c. + +2009-12-08 Marco Bodrato + + * tests/devel/try.c: Test mpn_addlsh2_n and mpn_{add,sub}lsh_n; + mpn_rsblsh_n now tests all shift values. + * tests/refmpn.c (refmpn_addlsh_n, refmpn_sublsh_n): New functions. + (refmpn_addlsh1_n): Use generic refmpn_addlsh_n. + (refmpn_sublsh1_n): Use generic refmpn_sublsh_n. + (refmpn_addlsh2_n): New function. + * tests/tests.h: Declare new functions. + +2009-12-06 Torbjorn Granlund + + * tune/tuneup.c (tune_mulmod_bnm1): Up min_size to 12. + + * Globally: Rename *mullow* to *mullo*, *MULLOW* to *MULLO*. + + * configure.in: Don't include ev5 directory for ev6* and ev7. Misc + alpha path cleanups. + * mpn/alpha/add_n.asm: Replaced by mpn/alpha/ev5/add_n.asm. + * mpn/alpha/sub_n.asm: Replaced by mpn/alpha/ev5/sub_n.asm. + * mpn/alpha/lshift.asm: Replaced by mpn/alpha/ev5/lshift.asm. + * mpn/alpha/rshift.asm: Replaced by mpn/alpha/ev5/rshift.asm. + * mpn/alpha/com_n.asm: New, moved from mpn/alpha/ev5/rshift.asm. + * mpn/alpha/ev5/diveby3.asm: New, moved from mpn/alpha/diveby3.asm. + + * mpn/powerpc64/mode64/diveby3.asm: Remove, it is slower than + mpn_bdiv_dbm1c on all hardware. + + * mpn/generic/powm_sec.c: Rework logic for mpn_sqr_basecase size limit. + + * gmp-impl.h (mpn_redc_1_sec): Declare. + * configure.in (gmp_mpn_functions): Add redc_1_sec. + +2009-12-06 Marco Bodrato + + * tests/devel/try.c (try_one): DATA_SRC0_HIGHBIT sets the high bit. + +2009-12-05 Marco Bodrato + + * mpn/generic/toom_eval_dgr3_pm1.c: Change return value: 0 or ~0. + * mpn/generic/toom_eval_dgr3_pm2.c: Likewise. + * mpn/generic/toom_eval_pm1.c: Likewise. + * mpn/generic/toom_eval_pm2exp.c: Likewise. + * mpn/generic/toom_eval_pm2.c: Rewrite to use mpn_addlsh2_n. + + * mpn/generic/toom_interpolate_5pts.c: Param sa is a flag, not a sign. + + * mpn/generic/toom33_mul.c: Adapt to changes above. + * mpn/generic/toom3_sqr.c: Likewise. + * mpn/generic/toom42_mul.c: Likewise. + * mpn/generic/toom43_mul.c: Reduce branches. + * mpn/generic/toom44_mul.c: Likewise. + * mpn/generic/toom53_mul.c: Likewise. + * mpn/generic/toom62_mul.c: Likewise. + + * mpn/generic/toom52_mul.c: Use toom_eval_ functions. + + * mpn/generic/toom4_sqr.c: Avoid C99 construct. + * mpn/generic/toom_interpolate_7pts.c: Likewise. + +2009-12-05 Torbjorn Granlund + + * mpn/generic/redc_1_sec.c: New file. + * mpn/generic/powm_sec.c: Use redc_1_sec. Use dummy full subtract + instead of mpn_cmp since the latter leaks to the side channel. + (mpn_local_sqr_n): New function, with associated macros. + (mpn_powm_sec): Use mpn_local_sqr_n. + + * configure.in (HAVE_NATIVE): Add missing functions, then sort. + +2009-12-04 Torbjorn Granlund + + * tune/tuneup.c (tune_dc_div): Up min_size to 6. + (tune_mod_1): Set MOD_1_1_THRESHOLD min_size to 2. + + * tune/speed.h: Negate "binvert"-type inverses, as required. + + * mpn/generic/redc_1.c: Add ASSERTs. + * mpn/generic/redc_2.c: Likewise. + + * mpn/generic/sbpi1_bdiv_q.c: Simplify loops, indexing. + +2009-12-03 Yann Droneaud + + * acinclude.m4 ([long long reliability test 1]): Add a "static" for C99 + inline semantics compatibility. + +2009-12-03 Torbjorn Granlund + + * configure.in: Move intptr_t test into common AC_CHECK_TYPES. + + * mpn/generic/gcdext.c: Add a TMP_FREE. + +2009-12-03 Niels Möller + + * mpn/generic/gcdext_1.c (mpn_gcdext_1) [GCDEXT_1_USE_BINARY]: + Added various masking tricks. + + * mpn/generic/gcdext_1.c (mpn_gcdext_1) [GCDEXT_1_USE_BINARY]: + Reimplemented binary gcdext, with proper canonicalization. + + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_n): Handle v == 0 + from mpn_gcdext_1. + * mpn/generic/gcdext_1.c (mpn_gcdext_1): Allow inputs with a < b, + assertions fixed accordingly. + +2009-12-03 Torbjorn Granlund + + * tune/tuneup.c: Tune DC_DIVAPPR_Q_THRESHOLD. Rewrite + DC_DIV_QR_THRESHOLD tuning code. + (tune_dc_div): Rewrite. + * tune/speed.h (SPEED_ROUTINE_MPN_PI1_DIV): New macro. + * tune/common.c (speed_mpn_sbpi1_div_qr, speed_mpn_dcpi1_div_qr, + speed_mpn_sbpi1_divappr_q, speed_mpn_sbpi1_bdiv_qr): New functions. + * gmp-impl.h: Provide declarations for corresponding threshold vars. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add dcpi1_divappr_q.c. + + * tune/tuneup.c (tune_binvert): Up max_size. + +2009-12-02 Marco Bodrato + + * tests/devel/try.c: Test mpn_rsblsh2_n and mpn_rsblsh_n. + * tests/refmpn.c (refmpn_rsblsh_n, refmpn_rsblsh2_n): New functions. + (refmpn_rsblsh1_n): Use generic refmpn_rsblsh_n. + * tests/tests.h: Declare new functions. + +2009-12-03 Niels Möller + + * mpn/generic/gcdext_subdiv_step.c (mpn_gcdext_subdiv_step): + Select the right cofactor in the cases A == B or A == 2B. + + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_n): Deleted + handling of ap[0] == 0 and bp[0] == 0; these cases don't happen. + Select the right cofactor in the case ap[0] == bp[0]. + * mpn/generic/gcdext.c (mpn_gcdext): Analogous changes. + +2009-12-02 Niels Möller + + * gmp-h.in (mpn_gcdext_1): Updated prototype. + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_n): Updated for + signed cofactors from gcdext_1. + * mpn/generic/gcdext_1.c (mpn_gcdext_1): Use Euclid's algorithm, + and return signed cofactors. + +2009-12-02 Torbjorn Granlund + + * doc/gmp.texi (Low-level Functions): Document mpn_sqr_n. + + * tune/speed.c (routine): Add mpn_binvert. + + * tune/tuneup.c: Tune BINV_NEWTON_THRESHOLD. + (tune_binvert): New function. + * tune/speed.h (SPEED_ROUTINE_MPN_BINVERT): New macro. + * tune/common.c (speed_mpn_binvert): New function. + * gmp-impl.h: Provide declarations for corresponding threshold var. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add binvert.c. + + * tune/tuneup.c: Tune DC_BDIV_QR_THRESHOLD and DC_BDIV_Q_THRESHOLD. + (tune_dc_bdiv): New function. + (tune_dc_div): New name for tune_dc. + * tune/speed.h (SPEED_ROUTINE_MPN_PI1_BDIV_QR, + SPEED_ROUTINE_MPN_PI1_BDIV_Q): New macros. + * tune/common.c (speed_mpn_sbpi1_bdiv_qr, speed_mpn_dcpi1_bdiv_qr, + speed_mpn_sbpi1_bdiv_q, speed_mpn_dcpi1_bdiv_q): New functions. + * gmp-impl.h: Provide declarations for corresponding threshold vars. + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add dcpi1_bdiv_qr.c and + dcpi1_bdiv_q.c. + +2009-12-01 Marco Bodrato + + * mpn/generic/toom53_mul.c: Removed double computation of vinf. + + * mpn/x86_64/aorrlsh_n.asm: Correct return value for rsblsh_n. + * mpn/asm-defs.m4 (define_mpn): Add rsblsh_n. + * gmp-impl.h (mpn_rsblsh_n): Added prototype and name-mangling. + + * mpn/generic/fib2_ui.c: Reduce the amount of temporary storage. + Use mpn_rsblsh_n. + +2009-12-01 Torbjorn Granlund + + * mpn/generic/redc_n.c: Rework temp allocation. + + * mpn/generic/dcpi1_bdiv_qr.c (mpn_dcpi1_bdiv_qr_n_itch): Add pi1 also + to this function. + + * mpn/generic/dcpi1_bdiv_q.c: Get the mpn_sbpi1_bdiv_q call right. + Misc cleanups. + + * tune/speed.c (routine): Fix typo in last change. + Add mpn_redc_2. + + * tune/speed.h (SPEED_ROUTINE_REDC_N): Set min size properly. + +2009-12-01 Niels Möller + + * tune/speed.c (routine): Added mpn_toom42_mul and mpn_redc_n. + * tune/speed.h (SPEED_ROUTINE_MPN_TOOM42_MUL): New macro. + (speed_mpn_toom42_mul): Declare function. + * tune/common.c (speed_mpn_toom42_mul): New function. + * gmp-impl.h (MPN_TOOM42_MUL_MINSIZE): New constant. + +2009-11-30 Marco Bodrato + + * mpn/generic/fib2_ui.c: Use mpn_rsblsh2_n. + +2009-11-29 Torbjorn Granlund + + * mpn/x86_64/pentium4/gmp-mparam.h + (HAVE_NATIVE_mpn_addlsh1_n, HAVE_NATIVE_mpn_sublsh1_n): Don't undef. + + * Makefile.am (EXTRA_DIST): Remove macos. + +2009-11-28 Torbjorn Granlund + + * tune/tuneup.c (tune_redc): Set min_size to 16 for redc_n tuning. + + * mpn/x86_64/sqr_basecase.asm (SQR_TOOM2_THRESHOLD_MAX): Avoid quoting + to allow configure.in parse it more easily. Trim from 120 to 80. + +2009-11-28 Marco Bodrato + + * mpn/generic/mulmod_bnm1.c: Basecases made simpler, this also corrects + a bug affecting previous version. + +2009-11-28 Torbjorn Granlund + + * configure.in: Handle atom also in 32-bit mode. + * mpn/x86/atom/gmp-mparam.h: New file. + + * gmp-impl.h (MULMOD_BNM1_THRESHOLD): Default. + + * mpn/generic/redc_n.c: Use mpn_mulmod_bnm1 instead of mpn_mul_n. + + * Use TMP_ALLOC_LIMBS consistently. + * Finish renaming BITS_PER_MP_LIMB to GMP_LIMB_BITS. + + * macos: Remove entire directory. + +2009-11-27 Torbjorn Granlund + + * mpn/x86_64/corei/gmp-mparam.h: New file. + * mpn/x86_64/core2/gmp-mparam.h: Now for just core2. + * mpn/powerpc64/mode64/p3/gmp-mparam.h: New file. + * mpn/powerpc64/mode64/p4/gmp-mparam.h: New file. + * mpn/powerpc64/mode64/p5/gmp-mparam.h: New file. + + * config.guess: Return "corei" for core i7 and core i5. + * config.sub: Recognise "corei". + * acinclude.m4 (X86_64_PATTERN): Add corei. + * configure.in (powerpc): Set up more CPU-specific paths. + (x86): Handle corei. + + * mpz/powm.c: Allow input operand overlap also when exponent = 1. + Misc cleanups. + +2009-11-26 Marco Bodrato + + * tests/mpn/t-mulmod_bnm1.c: New test file. + * tests/mpn/Makefile.am (check_PROGRAMS): Add t-mulmod_bnm1. + + * mpn/generic/mullow_n.c: Comments on Mulders' trick implementation. + +2009-11-26 Torbjorn Granlund + + * mpn/generic/powm.c: Make comments reflect current code state. + + * tests/devel/try.c: Make mpn_mullow_n testing actually work. + +2009-11-25 Torbjorn Granlund + + * mpz/powm.c: Clean up unused defs. + +2009-11-24 Torbjorn Granlund + + * tune/tuneup.c (tune_redc): Rewrite. + * mpn/generic/powm.c: Use REDC_1_TO_REDC_2_THRESHOLD, + REDC_1_TO_REDC_N_THRESHOLD, and REDC_2_TO_REDC_N_THRESHOLD. + Get rid of previous REDC params, including LOCAL_REDC_N_THRESHOLD. + (WANT_REDC_2): Define. + * gmp-impl.h: Corresponding changes. + +2009-11-23 Torbjorn Granlund + + * mpn/generic/powm.c: Fix typo. + Define LOCAL_REDC_N_THRESHOLD, use in REDC_2_THRESHOLD... + REDC_N_THRESHOLD chain. + +2009-11-22 Torbjorn Granlund + + * tune/tuneup.c (tune_mullow): Set min_size to 1. + + * mpn/generic/powm_sec.c: Use just mpn_mul_basecase and + mpn_sqr_basecase for multiplication and squaring. + + * tune/tuneup.c: Tune REDC_2_THRESHOLD and REDC_N_THRESHOLD. + (tune_redc): New function. + (tune_powm): Remove function. + * tune/speed.h (SPEED_ROUTINE_REDC_2, SPEED_ROUTINE_REDC_N): New. + * tune/common.c (speed_mpn_redc_2, speed_mpn_redc_n): New. + + * mpz/powm.c: Complete rewrite. Use mpn_powm and mpn_powlo. + * mpn/generic/powm.c: Rewrite. + * mpn/generic/redc_n.c: New file. + * configure.in (gmp_mpn_functions): Add redc_n. + * gmp-impl.h (REDC_2_THRESHOLD, REDC_N_THRESHOLD): Default, and define + for tuneup. + +2009-11-21 Marco Bodrato + + * mpn/generic/mullow_n.c: Disable Mulders' trick for small operands, + use fft for bigger ones. + * tests/mpn/t-mullo.c: New test file. + +2009-11-22 Torbjorn Granlund + + * tune/tuneup.c (tune_mullow): Rewrite. + +2009-11-21 Marco Bodrato + + * gmp-impl.h: Removed unused macros (CACHED_ABOVE_THRESHOLD and + CACHED_BELOW_THRESHOLD). + + * mpn/generic/mullow_n.c: Use Mulders' trick. + * tune/tuneup.c (tune_mullow): MULLOW_MUL_N_THRESHOLD range of + search depends on FFT tuning; + (all): Anticipate tune_fft_{mul,sqr}. + + * tune/speed.c (routine): Add entry related to mpn_mulmod_bnm1. + +2009-11-19 Niels Möller + + * mpn/generic/toom_eval_dgr3_pm2.c (mpn_toom_eval_dgr3_pm2) + [HAVE_NATIVE_mpn_add_n_sub_n]: Fixed typo in mpn_add_n_sub_n call + (spotted by Marco Bodrato). + * mpn/generic/toom_eval_pm2.c (mpn_toom_eval_pm2): Likewise. + * mpn/generic/toom_eval_pm2exp.c (mpn_toom_eval_pm2exp): Likewise. + + * mpn/generic/toom_eval_pm2.c (mpn_toom_eval_pm2) [HAVE_NATIVE_mpn_addlsh_n]: + Fixed missing declaration. + + * mpn/asm-defs.m4 (define_mpn): Add addlsh_n. + * gmp-impl.h (mpn_addlsh_n): Added prototype and name-mangling. + +2009-11-19 Niels Möller + + * mpn/generic/toom_eval_pm2.c (mpn_toom_eval_pm2): New file. + * mpn/generic/toom53_mul.c (mpn_toom53_mul): Use mpn_toom_eval_pm2. + * mpn/generic/toom62_mul.c (mpn_toom62_mul): Likewise. + * configure.in (gmp_mpn_functions): Added toom_eval_dgr3_pm2. + +2009-11-18 Torbjorn Granlund + + * gmp-impl.h (mpn_and_n, etc): Adapt to now-public logic functions. + + * config.guess: Recognise VIA nano. + * config.sub: Likewise. + * configure.in: Generalise x86_64 support; recognise VIA nano. + +2009-11-16 Torbjorn Granlund + + * tune/speed.c (routine): Add measurement of mpn_addlsh2_n, + mpn_sublsh2_n, mpn_rsblsh2_n. + * tune/common.c: Add speed routines for lsh2 functions. + + * mpn/generic/divis.c: Use MU_BDIV_QR_THRESHOLD. + + * configure.in (gmp_mpn_functions_optional): Add *lsh_n functions. + + * mpn/generic/toom_eval_pm2exp.c: Make HAVE_NATIVE_mpn_addlsh_n code + work. + + * mpn/x86_64/aorrlsh2_n.asm: Optimise inner loop. + + * configure.in (gmp_mpn_functions_optional): Remove copyi,copyd, they + are now in gmp_mpn_functions. Analogously move logical functions. + +2009-11-16 Marco Bodrato + + * mpn/generic/toom53_mul.c: Use addlsh2 for evaluation (and fix typo). + * mpn/generic/toom_eval_dgr3_pm2.c: Likewise (affects toom44 and 43). + + * mpn/asm-defs.m4: Fix comments for op_lsh2 new functions. + * gmp-impl.h: Likewise. + * tests/mpz/t-fac_ui.c: Fix a comment. + +2009-11-15 Torbjorn Granlund + + * mpn/x86_64/aorrlsh2_n.asm: New file. + * configure.in: Add support for addlsh2_n, sublsh2_n, and rsblsh2_n, + including mulfuncs. + * gmp-impl.h (mpn_addlsh2_n, mpn_sublsh2_n, mpn_rsblsh2_n): Declare. + * mpn/asm-defs.m4: Likewise. + + * mpn/generic/copyi.c: New file. + * mpn/generic/copyd.c: Likewise. + * mpn/generic/zero.c: Likewise. + * gmp-h.in: Declare new functions. + * configure.in (gmp_mpn_functions): Add new functions. + +2009-11-15 Marco Bodrato + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1_next_size): fix typo + + * mpn/generic/toom33_mul.c: Use rsblsh1 for evaluation. + * mpn/generic/toom3_sqr.c: Likewise. + +2009-11-14 Torbjorn Granlund + + * mpn/generic/toom52_mul.c: Use mpn_addlsh1_n. + + * mpn/generic/toom52_mul.c: Toggle the right flag bit in an + HAVE_NATIVE_mpn_add_n_sub_n arm. + + * tests/mpz/t-remove.c: New file. + + * mpn/generic/remove.c: Major overhaul. Add parameter 'cap'. + + * mpn/generic/binvert.c: Fix typo in last change. + + * mpn/generic/bdiv_qr.c: Make it actually work. Also use passed-in + scratch space. + + * mpn/generic/mu_bdiv_qr.c: Reset FFT parameters for each call. + +2009-11-12 Torbjorn Granlund + + * mpn/x86/k7/gcd_1.asm (MASK): Compute from MAXSHIFT. + +2009-11-11 Torbjorn Granlund + + * mpn/generic/binvert.c: Simplify, fix comments. + + * tests/devel/try.c: Test mpn_invert and mpn_binvert. + + * tests/refmpn.c (refmpn_invert, refmpn_binvert): New functions. + * tests/tests.h: Declare new functions. + +2009-11-10 Torbjorn Granlund + + * configure.in: Supply compiler options for atom in 32-bit mode. + + * acinclude.m4 (X86_64_PATTERN): New. + * configure.in: Setup and use X86_64_PATTERN. + + * mpn/x86_64/fat/fat.c: New file. + * mpn/x86_64/fat/fat_entry.asm: New file. + * mpn/x86_64/fat: Copy C placeholder files from mpn/x86/fat. + * mpn/x86_64/x86_64-defs.m4 (CPUVEC_FUNCS_LIST): New, copied from + mpn/x86/x86-defs.m4. + * configure.in: Move down x86 fat setup code until after ABI has been + determined; generalise to handle x86_64. + +2009-11-09 Torbjorn Granlund + + * mpn/x86/fat/mod_1.c: New file. + + * acinclude.m4 (GMP_C_FOR_BUILD_ANSI): Avoid poor quoting. + +2009-11-08 Torbjorn Granlund + + * gmp-impl.h (MPN_LOGOPS_N_INLINE): Rewrite, update interface. Callers + updated. + * mpn/generic/logops_n.c: New file. + * doc/gmp.texi (Low-level Functions): Document logical mpn functions. + +2009-11-07 Torbjorn Granlund + + * tune/speed.h (SPEED_ROUTINE_MPN_MULMOD_BNM1): Adapt to new + mpn_mulmod_bnm1 interface. + +2009-11-07 Marco Bodrato + + * mpn/generic/mulmod_bnm1.c: New interface, with size + specified for all operands in mpn_mulmod_bnm1. + * gmp-impl.h: Changed mpn_mulmod_bnm1 prototype. + +2009-11-05 Torbjorn Granlund + + * mpn/x86/k7/gcd_1.asm: Actually use div-reduced value. + Mnemonic cleanup. + + * mpn/x86_64/gcd_1.asm: New file. + +2009-11-03 Torbjorn Granlund + + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add sqr_n.c. + +2009-11-03 Marco Bodrato + + * mpn/generic/toom_interpolate_6pts.c: removed an addmul_1 and cleanup. + +2009-11-02 Torbjorn Granlund + + * configure.in (gmp_mpn_functions): Remove obsolete functions + dc_divrem_n and sb_divrem_mn. + * gmp-impl.h: Misc cleanup. + (mpn_sb_divrem_mn, mpn_dc_divrem_n): Remove. + (DIV_DC_THRESHOLD): Remove. + * mpn/generic/dc_divrem_n.c: Remove. + * mpn/generic/sb_divrem_mn.c: Remove. + * mpn/generic/tdiv_qr.c: Use DC_DIV_QR_THRESHOLD, not DIV_DC_THRESHOLD. + + * tests/devel/try.c: Replace mpn_sb_divrem_mn by mpn_sbpi1_div_qr. + * tests/refmpn.c (refmpn_sb_div_qr): New name for refmpn_sb_divrem_mn. + + * tune/Makefile.am (libspeed_la_SOURCES): Remove sb_div.c and sb_inv.c. + (TUNE_MPN_SRCS_BASIC): Remove sb_divrem_mn.c. + * tune/common.c (speed_mpn_dcpi1_div_qr_n): New function. + Remove mpn_sb_divrem_mn related functions. + * tune/speed.c (routine): Remove entries related to mpn_dc_divrem and + mpn_sb_divrem. + (routine): New entry for mpn_dc_div_qr_n. + * tune/speed.h (SPEED_ROUTINE_MPN_DC_DIVREM_CALL): Compute inverse + needed by pi1 calls. + (SPEED_ROUTINE_MPN_SB_DIVREM_M3): Remove. + * tune/tuneup.c (tune_sb_preinv): Remove. + (tune_dc): Update to measure DC_DIV_QR_THRESHOLD. + + * mpn/generic/sb_divappr_q.c: Remove. + +2009-11-01 Torbjorn Granlund + + * gmp-impl.h: Misc minor cleanups. + +2009-10-31 Torbjorn Granlund + + * gmp-impl.h (toom itch functions): Simplify, make some into macros. + (MPN_KARA_MUL_N_TSIZE, MPN_KARA_SQR_N_TSIZE): Remove. + * mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): Remove. + * mpn/generic/mul_n.c (mpn_sqr_n): Move from here... + * mpn/generic/sqr_n.c: ...to this new file. + * configure.in (gmp_mpn_functions): Add sqr_n. + + * Globally change + MUL_TOOM3_THRESHOLD => MUL_TOOM33_THRESHOLD, + MUL_KARATSUBA_THRESHOLD => MUL_TOOM22_THRESHOLD, + SQR_KARATSUBA_THRESHOLD => SQR_TOOM2_THRESHOLD, + and associated names analogously. + +2009-10-31 Niels Möller + + * mpn/generic/toom_interpolate_7pts.c: Changed evaluation points, + replacing -1/2 by -2. + * mpn/generic/toom44_mul.c: Updated to use new evaluation points, + and use mpn_toom_eval_dgr3_pm2. + * mpn/generic/toom4_sqr.c (mpn_toom4_sqr): Likewise. + * mpn/generic/toom53_mul.c (mpn_toom53_mul): Updated to use new + evaluation points, and use mpn_toom_eval_pm1 and + mpn_toom_eval_pm2exp. + * mpn/generic/toom62_mul.c (mpn_toom62_mul): Likewise. + + * mpn/generic/toom_eval_pm2exp.c: New file. + * mpn/generic/toom_eval_pm1.c: New file. + + * mpn/generic/toom43_mul.c (mpn_toom43_mul): Use + mpn_toom_eval_dgr3_pm2. + +2009-10-30 Torbjorn Granlund + + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add toom2* and toom3* files. + +2009-10-30 Niels Möller + + * configure.in (gmp_mpn_functions): Added toom_eval_dgr3_pm2. + * gmp-impl.h: Added prototype for mpn_toom_eval_dgr3_pm2. + * mpn/generic/toom_eval_dgr3_pm2.c: New file. + +2009-10-29 Niels Möller + + * mpn/generic/toom43_mul.c (mpn_toom43_mul): Use + mpn_toom_eval_dgr3_pm1. + * mpn/generic/toom42_mul.c (mpn_toom42_mul): Likewise. + +2009-10-29 Torbjorn Granlund + + * mpn/generic/mulmod_bnm1.c: Replace some add_1 by INCR. + + * gmp-impl.h (mpn_mulmod_bnm1_itch): New macro. + + * mpn/generic/mulmod_bnm1.c (mpn_mulmod_bnm1): Call mpn_mul_fft. + (mpn_mulmod_bnm1_next_size): Adopt to SS FFT. + + * mpn/generic/mul_fft.c (mpn_mul_fft): Make it return high limb. + (mpn_mul_fft_internal): Likewise. + + * mpn/generic/mulmod_bnm1.c: New file, by Niels Möller. + * configure.in (gmp_mpn_functions): Add mulmod_bnm1. + * gmp-impl.h: Add related declarations. + * tune/tuneup.c: Tune MULMOD_BNM1_THRESHOLD. + * tune/speed.h (SPEED_ROUTINE_MPN_MULMOD_BNM1): New macro. + * tune/common.c (speed_mpn_mulmod_bnm1): New function. + * Makefile.am (TUNE_MPN_SRCS_BASIC): Add mulmod_bnm1.c. + + * gmp-impl.h (mpn_kara_mul_n, mpn_kara_sqr_n): Remove declarations. + * tune/common.c: Remove/rename kara functions. + * tune/speed.h: Likewise. + + * tests/devel/try.c: Clean up usage of %p printf arguments. + + * gmp-impl.h: Update MUL/SQR MINSIZE macros to reflect new function + names and limitations + * tune/tuneup.c: Use updated macro names. + * tune/speed.h: Likewise. + * tests/devel/try.c: Test new mul/sqr functions, remove old tests. + +2009-10-29 Niels Möller + + * tune/speed.c: Added support for mpn_toom4_sqr, + + * tune/speed.h (SPEED_ROUTINE_MPN_TOOM4_SQR): New macro. + (SPEED_ROUTINE_MPN_KARA_MUL_N): Deleted. + (SPEED_ROUTINE_MPN_TOOM3_MUL_N): Deleted. + (SPEED_ROUTINE_MPN_TOOM2_SQR): Use mpn_toom2_sqr_itch. + + * gmp-impl.h (mpn_toom3_mul_n, mpn_toom3_sqr_n): Remove + declarations. + (mpn_toom2_sqr_itch): Add margin for recursive calls. + +2009-10-28 Niels Möller + + * mpn/generic/mul_n.c (mpn_kara_mul_n): Deleted old Karatsuba + implementation. + (mpn_kara_sqr_n): Likewise deleted. + + * mpn/generic/mul_n.c (mpn_sqr_n): Use mpn_toom2_sqr and + mpn_toom3_sqr, not the old implementations. + + * gmp-impl.h (MPN_TOOM3_MUL_N_TSIZE): Deleted, replaced by + mpn_toom33_mul_itch. + (MPN_TOOM3_SQR_N_TSIZE): Deleted, replaced by + mpn_toom3_sqr_itch. + (mpn_toom33_mul_itch): Needs more scratch. + (mpn_toom3_sqr_itch): Likewise. + * tune/speed.h (SPEED_ROUTINE_MPN_TOOM3_MUL_N): Use + mpn_toom33_mul_itch. + (SPEED_ROUTINE_MPN_TOOM3_SQR_N): Use mpn_toom3_sqr_itch. + * mpn/generic/mul_n.c (mpn_mul_n): Use mpn_toom33_mul_itch. + (mpn_sqr_n): Use mpn_toom3_sqr_itch. + + * mpn/generic/toom33_mul.c (mpn_toom33_mul): Avoid TMP_ALLOC. Needs + some more supplied scratch instead. + * mpn/generic/toom3_sqr.c (mpn_toom3_sqr): Likewise. + +2009-10-26 Torbjorn Granlund + + * gmp-impl.h (invert_pi1): Streamline, as suggested by Niels. + +2009-10-24 Torbjorn Granlund + + * mpn/generic/bdiv_q.c: Update to call new functions. + * mpn/generic/bdiv_qr.c: Likewise. + * mpn/generic/binvert.c: Likewise. + * mpn/generic/divexact.c: Likewise. + * mpn/generic/divis.c: Likewise. + * mpn/generic/perfpow.c: Likewise. + * mpn/generic/tdiv_qr.c: Likewise. + * mpn/generic/dcpi1_bdiv_q.c: New file. + * mpn/generic/dcpi1_bdiv_qr.c: New file. + * mpn/generic/dcpi1_div_q.c: New file. + * mpn/generic/dcpi1_div_qr.c: New file. + * mpn/generic/dcpi1_divappr_q.c: New file. + * mpn/generic/sbpi1_bdiv_q.c: New file. + * mpn/generic/sbpi1_bdiv_qr.c: New file. + * mpn/generic/sbpi1_div_q.c: New file. + * mpn/generic/sbpi1_div_qr.c: New file. + * mpn/generic/sbpi1_divappr_q.c: New file. + * mpn/generic/dc_bdiv_q.c: Removed. + * mpn/generic/dc_bdiv_qr.c: Removed. + * mpn/generic/dc_div_q.c: Removed. + * mpn/generic/dc_div_qr.c: Removed. + * mpn/generic/dc_divappr_q.c: Removed. + * mpn/generic/sb_bdiv_q.c: Removed. + * mpn/generic/sb_bdiv_qr.c: Removed. + * mpn/generic/sb_div_q.c: Removed. + * mpn/generic/sb_div_qr.c: Removed. + + * configure.in (gmp_mpn_functions): Add new division functions, remove + obsolete division functions. + + * gmp-impl.h: Add declarations of new division functions, remove + corresponding obsolete declarations. + (gmp_pi1_t, gmp_pi2_t): New types. + (invert_pi1): New macro for computing 2/1 and 3/2 inverses. + +2009-10-23 Niels Möller + + * gmp-impl.h (mpn_toom62_mul_itch): New function. + + * tests/mpn/t-toom53.c: New test program. + * tests/mpn/t-toom62.c: New test program. + +2009-10-23 Torbjorn Granlund + + * mpn/generic/get_d.c: Fix code handling denorms for 64-bit machines. + * tests/mpf/t-get_d.c (test_denorms): New function. + +2009-10-23 Niels Möller + + * mpn/generic/toom52_mul.c (mpn_toom52_mul): Use supplied scratch + space, not TMP_ALLOC. Interface change, now requires input sizes + such that s + t >= 5. + + * gmp-impl.h (mpn_toom52_mul_itch): New function. + + * tests/mpn/t-toom52.c: New test program. + +2009-10-22 Torbjorn Granlund + + * mpn/x86_64/sqr_basecase.asm: Tune for speed and a 7% size decrease. + +2009-10-22 Niels Möller + + * tests/mpn/t-toom44.c: New test program. + * tests/mpn/t-toom33.c: New test program. + + * tests/mpn/toom-shared.h (main): Reorganized input generation. + Users are now supposed to define macros MAX_AN, MIN_BN and MAX_BN. + Updated existing toom test programs. + +2009-10-22 Torbjorn Granlund + + * tests/devel/try.c: Fix typos in last change. + +2009-10-21 Torbjorn Granlund + + * mpn/asm-defs.m4 (define_mpn): Add mullow_basecase. + + * tests/devel/try.c: Test mpn_mullow_n. + + * tests/refmpn.c (refmpn_mullow_n): New function. + * tests/tests.h: Declare it. + +2009-10-21 Niels Möller + + * tests/mpn/toom-shared.h (main): Check for writes outside of the + product or scratch area. + + * gmp-impl.h (mpn_toom43_mul_itch): New function. + + * mpn/generic/toom43_mul.c (mpn_toom43_mul): Use supplied scratch + space, not TMP_ALLOC. Interface change, now requires input sizes + such that s + t >= 5. + +2009-10-20 Niels Möller + + * tests/mpn/toom-shared.h (MIN_BLOCK): New constant, which can be + overridden by users. Needed by t-toom42 and t-toom43. + + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-toom32, + t-toom42 and t-toom43. + * tests/mpn/t-toom43.c: New test program. + * tests/mpn/t-toom42.c: New test program. + * tests/mpn/t-toom32.c: New test program. + + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-toom22. + * tests/mpn/t-toom22.c: New test file. + * tests/mpn/toom-shared.h: New file. Test framework for Toom + functions. + +2009-10-14 Niels Möller + + * mpn/generic/hgcd.c (mpn_hgcd_itch): Thanks to the new + mpn_matrix22_mul_strassen, the scratch need is reduced by 16%. + +2009-10-14 Marco Bodrato + + * mpn/generic/matrix22_mul.c (mpn_matrix22_mul_strassen): New + Strassen-like algorithm, to reduce the amount of temporary + storage. + (mpn_matrix22_mul_itch): Updated to reflect the reduced storage + need. + +2009-10-03 Torbjorn Granlund + + * Rename mpn_addsub_n to mpn_add_n_sub_n. + +2009-10-01 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Call mpn_divrem_1 and mpn_dc_div_qr instead of + old functions. + + * mpn/generic/mul_n.c: Call toom22 and toom33 instead of old functions. + + * mpn/generic/toom42_mul.c (TOOM42_MUL_N_REC): Renamed from + TOOM22_MUL_N_REC. Unconditionally call the generic mpn_mul_n. + * mpn/generic/toom32_mul.c: Analogous changes. + +2009-09-28 Niels Möller + + * mpn/x86_64/invert_limb.asm: Rewrite. Exploit cancellation in the + Newton iteration. + +2009-09-27 Niels Möller + + * mpn/x86/invert_limb.asm: Reduce register usage. Eliminated $1 + arguments to add, sub and shift. + +2009-09-25 Niels Möller + + * mpn/x86/invert_limb.asm: New file. + +2009-09-24 Torbjorn Granlund + + * mpn/generic/toom33_mul.c: Use new toom functions for all recursive + products. + * mpn/generic/toom3_sqr.c: Likewise. + * mpn/generic/toom44_mul.c: Likewise. + * mpn/generic/toom4_sqr.c: Likewise. + + * mpn/generic/add_n.c: Relax operand overlap ASSERTs. + * mpn/generic/sub_n.c: Likewise. + +2009-09-15 Torbjorn Granlund + + Suggested by Uwe Mueller: + * printf/doprnt.c: Use "%ld" for exponent printing. + * printf/doprntf.c (__gmp_doprnt_mpf): Make expval "long". + +2009-09-14 Torbjorn Granlund + + * configure.in: Handle mingw64. + * gmp-impl.h (gmp_intptr_t): Declare. + * tests/amd64check.c (calling_conventions_values): Use CNST_LIMB. + * tests/memory.c: Use gmp_intptr_t; print pointers using C90 "%p". + * tests/misc.c: Use gmp_intptr_t. + * tests/mpq/t-get_str.c: Print pointers using C90 "%p". + +2009-08-12 Torbjorn Granlund + + * mpn/generic/mod_1_1.c (mpn_mod_1_1p_cps): Remove silly ASSERT code. + + * mpn/asm-defs.m4 (define_mpn): Remove mod_1s_1p, add mod_1_1p. + + * mpn/arm/invert_limb.asm: Complete rewrite. + + * longlong.h: Document LONGLONG_STANDALONE and NO_ASM. + +2009-08-05 Torbjorn Granlund + + * tests/mpz/dive_ui.c (check_random): Avoid zero divisors. + +2009-07-31 Torbjorn Granlund + + * mpn/generic/mod_1_1.c: Tweak to handle any modulus (possibility + pointed out by Per Austrin). + (mpn_mod_1_1p): Renamed from mpn_mod_1s_1p. + (mpn_mod_1_1p_cps): Renamed from mpn_mod_1s_1p_cps. + *mpn/generic/mod_1.c (mpn_mod_1): Reorganise to call mpn_mod_1_1p for + any modulus. + +2009-07-28 Torbjorn Granlund + + * configure.in: Pass arch for x86 also in 64-bit mode. + +2009-07-26 Torbjorn Granlund + + * config.guess (_cpuid): Recognise more Intel "Core" processors. + +2009-07-13 Torbjorn Granlund + + * mpf/eq.c: Rewrite. + + * tests/mpf/t-eq.c: New test. + +2009-07-06 Torbjorn Granlund + + * gmp-impl.h (__mp_bases): Remove this alias. + + * mpf/get_str.c: Use less overflow prone expression for computing limb + allocation. + * mpz/inp_str.c: Likewise. + * mpf/set_str.c: Likewise. + * mpz/set_str.c: Likewise. + +2009-07-03 Niels Möller + + * mpn/generic/gcd_1.c (mpn_gcd_1): Use masking tricks to reduce + the number of branches in the loop. + +2009-06-28 Torbjorn Granlund + + * demos/factorize.c (factor_using_pollard_rho): Rewrite. + + * mpz/clears.c: New file. + * mpq/clears.c: New file. + * mpf/clears.c: New file. + * gmp-h.in (mpz_clears, mpq_clears, mpf_clears): Declare. + * mpz/Makefile.am: Add clears.c. + * mpq/Makefile.am: Add clears.c. + * mpf/Makefile.am: Add clears.c. + * Makefile.am: Add these also to respective OBJECTS variables. + * doc/gmp.texi: Document inits function and clears functions. + +2009-06-20 Torbjorn Granlund + + * mp-h.in (mp_bitcnt_t): Declare here too. + +2009-06-19 Torbjorn Granlund + + * mpq/inits.c: New file. + * mpf/inits.c: New file. + * gmp-h.in (mpz_inits, mpq_inits, mpf_inits): Declare . + + * mpn/generic/remove.c: New file. + * configure.in (gmp_mpn_functions): Add remove. + * gmp-impl.h (mpn_remove): Declare. + + * gmp-h.in (mp_bitcnt_t): New basic type. + * mpn/generic/perfpow.c (mp_bitcnt_t): Remove private definition. + + * mpn/generic/bdiv_qr.c: Make it actually work. + + * mpn/x86_64/core2/aorsmul_1.asm: Rewrite to use shorter pipeline and + to need fewer registers. + +2009-06-17 Torbjorn Granlund + + * mpn/x86_64/rsh1aors_n.asm: New file. + * mpn/x86_64/rsh1add_n.asm: Remove. + * mpn/x86_64/rsh1sub_n.asm: Remove. + + * mpz/inits.c: New file. + + * gen-trialdivtab.c: Wrap limb constants into CNST_LIMB. + + With Martin Boij: + * mpn/generic/perfpow.c (binv_root, binv_sqroot): Change from being + recursive to being iterative. + (mpn_perfect_power_p): Reorganise temp memory usage to avoid a buffer + overrun. Trim allocation of next and prev. Never create oversize + products in the multiplicity binary search. + + * mpn/generic/dc_div_q.c: Add missing TMP_FREE. + +2009-06-16 Torbjorn Granlund + + Revert: + * mpn/generic/perfpow.c (perfpow): Test exponents up to ub, inclusive. + +2009-06-16 Martin Boij + + * mpn/generic/perfpow.c (logs): Use more conservative table. + +2009-06-15 Torbjorn Granlund + + * mpn/pa64/aors_n.asm: New file. + * mpn/pa64/add_n.asm: Remove. + * mpn/pa64/sub_n.asm: Remove. + + * mpn/generic/perfpow.c (perfpow): Test exponents up to ub, inclusive. + +2009-06-14 Torbjorn Granlund + + * mpn/x86_64/bdiv_q_1.asm: Optimise away a mov insn. + * mpn/x86_64/dive_1.asm: Likewise. + + * mpn/generic/perfpow.c (binv_root): Use mpn_bdiv_q_1, not + mpn_divexact_itch for 2-adic division. + (all functions): Micro optimise. + + * Makefile.am (libmp_la_SOURCES): Add nextprime.c. + +2009-06-13 Torbjorn Granlund + + * gmp-h.in (mpn_perfect_power_p): Declare. + * configure.in (gmp_mpn_functions): Add perfpow. + * mpz/perfpow.c: Now trivial, simply calls mpn_perfect_power_p. + +2009-06-13 Martin Boij + + * mpn/generic/perfpow.c: New file. + * tests/mpz/t-perfpow.c: Rewrite. + +2009-06-12 Torbjorn Granlund + + * mpn/generic/bdiv_qr.c: New file. + * mpn/generic/bdiv_q.c: New file. + * configure.in (gmp_mpn_functions): Add bdiv_qr and bdiv_q. + * gmp-impl.h: Declare new functions. + + * nextprime.c: New file. + * gmp-impl.h (gmp_primesieve_t, gmp_init_primesieve, gmp_nextprime): + Declare. + * Makefile.am (libgmp_la_SOURCES): Add nextprime.c. + +2009-06-11 Torbjorn Granlund + + * mpn/generic/trialdiv.c: New file. + * gen-trialdivtab.c: New file. + * configure.in (gmp_mpn_functions): Add trialdiv. + * gmp-impl.h (mpn_trialdiv): Declare + * Makefile.am: Add rules for gen-trialdivtab and trialdiv. + + * longlong.h (arm count_leading_zeros): Define for armv5. + + * gmp-impl.h: Move down toom itch functions to after we've #defined + all THRESHOLDs. + + * dumbmp.c (isprime): Replace with slightly less inefficient code. + (mpz_tdiv_r): New function. + +2009-06-11 Niels Möller + + Support for mpn_toom32_mul in speed: + * tune/speed.c (routine): Added mpn_toom32_mul. + * tune/speed.h (SPEED_ROUTINE_MPN_TOOM32_MUL): New macro. + * tune/common.c (speed_mpn_toom32_mul): New function. + + * gmp-impl.h (mpn_toom32_mul_itch): Count scratch space needed + for the calls to mpn_toom22_mul. + (ABOVE_THRESHOLD): Moved this and related macros so it can be used + by mpn_toom32_mul_itch. + (mpn_toom22_mul_itch): Count scratch space for recursive calls. + +2009-06-11 Torbjorn Granlund + + * mpn/x86/k7/mod_1_4.asm: New file, mainly for k7, but perhaps useful + also for k6 and non-sse p6. + +2009-06-10 Torbjorn Granlund + + * mpn/x86_64/mod_1_4.asm: Minor size reducing tweaks. + + * mpn/x86/mod_1.asm: Remove obsolete file. + * mpn/x86/k7/mmx/mod_1.asm: Likewise. + * mpn/x86/pentium4/sse2/mod_1.asm: Likewise. + * mpn/x86/p6/mod_1.asm: Likewise. + * mpn/x86/pentium/mod_1.asm: Likewise. + +2009-06-08 Niels Möller + + * mpn/generic/toom4_sqr.c (mpn_toom4_sqr): Reorganized, to reduce + the need for scratch space, and get rid of TMP_ALLOC. Also use + mpn_toom_eval_dgr3_pm1. + + * mpn/generic/toom_interpolate_6pts.c (mpn_toom_interpolate_6pts): + Stricter ASSERTs based on maximum size of polynomial coefficients. + Improved comments on the signedness of intermediate values. + +2009-06-07 Torbjorn Granlund + + * mpn/generic/toom2_sqr.c: Make it actually work. + + * mpn/generic/toom3_sqr.c: Reduce local scratch space. + +2009-06-05 Torbjorn Granlund + + * mpn/generic/mul_fft.c (FFT_TABLE2_SIZE): Default to 200. + (MUL_FFT_TABLE2_SIZE, SQR_FFT_TABLE2_SIZE): Let these decide + FFT_TABLE2_SIZE if they are defined. + (struct nk): Use bit field. + +2009-06-05 Niels Möller + + * mpn/generic/toom44_mul.c (mpn_toom44_mult): Use + mpn_toom_eval_dgr3_pm1. + + * mpn/generic/toom_eval_dgr3_pm1.c: New file. + + * mpn/generic/toom_interpolate_7pts.c (mpn_toom_interpolate_7pts): + Minor cleanup, use mpn_add rather than mpn_add_n + MPN_INCR_U. + + * mpn/generic/toom44_mul.c (mpn_toom44_mul): Reorganized, to + reduce the need for scratch space, and get rid of TMP_ALLOC. + +2009-06-05 Torbjorn Granlund + + * mpn/generic/toom_interpolate_7pts.c: Fall back mpn_divexact_byN to + mpn_bdiv_q_1_pi1, if the latter is NATIVE. + +2009-06-04 Torbjorn Granlund + + * mpn/x86_64/bdiv_q_1.asm: New file. + + * configure.in (HAVE_NATIVE): Add recently added functions. + (GMP_MULFUNC_CHOICES): Handle addlsh_n, sublsh_n, rsblsh_n. + + * tune/common.c (speed_mpn_bdiv_q_1, speed_mpn_bdiv_q_1_pi1): + New functions. + * tune/speed.c (routine): Add mpn_bdiv_q_1 and mpn_bdiv_q_1_pi1. + * tune/speed.h (SPEED_ROUTINE_MPN_BDIV_Q_1_PI1): New #define. + (SPEED_ROUTINE_MPN_BDIV_Q_1): Mew #define. + + * configure.in (gmp_mpn_functions): Add bdiv_q_1. + * mpn/generic/bdiv_q_1.c: New file. + * mpn/asm-defs.m4 (define_mpn): Add mpn_bdiv_q_1 and mpn_bdiv_q_1_pi1. + * gmp-impl.h (mpn_bdiv_q_1, mpn_bdiv_q_1_pi1): Declare. + + * mpn/x86_64/lshift.asm: Cleanup. + * mpn/x86_64/rshift.asm: Cleanup. + + * mpn/x86_64/addlsh1_n.asm: Removed. + * mpn/x86_64/aorrlsh1_n.asm: Generalised addlsh1_n.asm to handle + addlsh1_n and rsblsh1_n functionality. + + * tests/refmpn.c (refmpn_rsblsh1_n): New function. + * tests/devel/try.c: Test mpn_rsblsh1_n. + * tests/tests.h: Declare refmpn_rsblsh1_n. + * tune/common.c (speed_mpn_rsblsh1_n): New function. + * tune/speed.c (routine): Add mpn_rsblsh1_n. + * tune/speed.h (mpn_rsblsh1_n): Declare. + + * configure.in (gmp_mpn_functions_optional): Add rsblsh1_n. + (GMP_MULFUNC_CHOICES): Handle rsblsh1_n defined with a mulfunc. + * mpn/asm-defs.m4 (define_mpn): Add rsblsh1_n. + * gmp-impl.h (mpn_rsblsh1_n): Declare. + + * mpn/generic/toom32_mul.c: Consistently use TOOM22_MUL_N_REC. + +2009-06-03 Marco Bodrato + + * mpn/generic/toom43_mul.c: New file. + * mpn/generic/toom52_mul.c: New file. + * mpn/generic/toom_interpolate_6pts.c: New file. + +2009-06-03 Torbjorn Granlund + + * configure.in (gmp_mpn_functions): Add toom43_mul, toom52_mul, and + toom_interpolate_6pts, but also some previously forgotten functions. + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Likewise. + * gmp-impl.h: Declare new functions. Sort toom function declarations. + + * gmp-impl.h: Rename toom4_* flags enum to toom7_*. Relevant C files + updated. + + * mpn/generic/toom_interpolate_7pts (divexact_2exp): Remove. + +2009-06-02 Torbjorn Granlund + + * demos/factorize.c: Add -q command line option. + +2009-06-02 Marco Bodrato + + * mpn/generic/toom_interpolate_7pts.c: Streamline, resulting in speed + improvements. + + * mpn/generic/toom_interpolate_5pts.c: Likewise, but also completely + do away with explicit scratch space. + * gmp-impl.h (mpn_toom_interpolate_5pts): Update prototype. + + * mpn/generic/mul_n.c (mpn_toom3_sqr_n, mpn_toom3_mul_n): + Update toom_interpolate_5pts call without scratch space parameter. + * mpn/generic/toom3_sqr.c: Likewise. + * mpn/generic/toom42_mul.c: Likewise. + * mpn/generic/toom33_mul.c: Likewise. + + * mpn/generic/toom33_mul.c: Reduce local scratch space. + * mpn/generic/toom32_mul.c: Rewrite to not use local scratch space. + +2009-06-02 Torbjorn Granlund + + * mpn/generic/toom22_mul.c (TOOM22_MUL_MN_REC): New macro, use it for + oo point. + +2009-06-01 Torbjorn Granlund + + * mpn/generic/mul.c: Loop to avoid excessive recursion in toom33 and + toom44 slicing code. + + * mpz/remove.c: Correctly handle multiplicity that does not fit an int. + + * Makefile.am (dist-hook): Check library version consistency. + + * mpn/generic/mul.c: Rewrite. + +2009-05-29 Torbjorn Granlund + + * tests/mpz/t-divis.c (check_random): Create huge test operands. + + * mpn/generic/toom44_mul.c: Allocate temp space using one TMP_ALLOC + call, not multiple TMP_SALLOC. + * mpn/generic/toom4_sqr.c: Likewise. + + * gmp-impl.h (mpn_toom22_mul_itch): Replace totally wrong code. + + * mpn/generic/mullow_n.c: Relax overlap requirement implied by ASSERT. + + * mpn/generic/divis.c: Rewrite. + + * gmp-impl.h (mpn_mu_bdiv_qr): Now returns mp_limb_t. + (mpn_toom2_sqr_itch): Simplify. + + * mpn/generic/mu_bdiv_qr.c: Implement properly. + +2009-05-27 Torbjorn Granlund + + * mpn/generic/mod_1_1.c: Add proper ASSERT functionality cps function. + * mpn/generic/mod_1_2.c: Likewise. + * mpn/generic/mod_1_3.c: Likewise. + * mpn/generic/mod_1_4.c: Likewise. + + * tune: Add speed measuring of toom22, toom33, and toom44. + + * mpn/generic/toom22_mul.c: Handle potentially unbalanced coefficient + product better. + +2009-05-26 Torbjorn Granlund + + * tests/mpz/t-mul.c (ref_mpn_mul): Use mpn_toom44_mul in FFT range for + better huge-operands performance. + +2009-05-24 Torbjorn Granlund + + * acinclude.m4 (GMP_ASM_LSYM_PREFIX): Try "$L" too, before "$". + +2009-05-23 Torbjorn Granlund + + * gmp-impl.h (mpn_mod_1s_1p,mpn_mod_1s_2p,mpn_mod_1s_3p,mpn_mod_1s_4p): + Declare using __GMP_ATTRIBUTE_PURE. + + * tune/tuneup.c (tune_mod_1): Specify check_size for measuring mod_1_N + functions. + (one): Remove redundant size loop exit condition. + +2009-05-20 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/mod_1_4.asm: New file. + * mpn/x86/p6/sse2/mod_1_4.asm: New file (grabbing pentium4 code). + +2009-05-18 Torbjorn Granlund + + * gmp-h.in (__GNU_MP_VERSION_MINOR): Bump to 4. + (__GNU_MP_VERSION_PATCHLEVEL): Set to -1. + + * mpn/x86_64/mod_1_4.asm: New file. + + * mpn/asm-defs.m4: Correct names for mod_1_N functions. + Add defines for corresponding cps functions. + + * mpn/generic/mod_1_2.c: Support any sizes > 1. + * mpn/generic/mod_1_3.c: Likewise. + * mpn/generic/mod_1_4.c: Likewise. + +2009-05-12 Torbjorn Granlund + + * Version 4.3.1 released. + +2009-05-11 Torbjorn Granlund + + * gmp-h.in (__GNU_MP_VERSION_MINOR): Bump. + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*, LIBMP_LT_*): + Bump version info. + +2009-05-09 Torbjorn Granlund + + * tests/mpz: Add MPZ_CHECK_FORMAT to many tests. + +2009-05-07 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/mul_basecase.asm: Avoid L(ret), "ret" is + defined in x86-defs.m4. + +2009-05-06 Torbjorn Granlund + + * mpn/x86/p6/aors_n.asm: Use L() for labels. + * mpn/x86/pentium4/sse2/addmul_1.asm: Likewise. + * mpn/x86/pentium4/sse2/mul_1.asm: Likewise. + * mpn/x86/pentium4/sse2/mul_basecase.asm: Likewise. + * mpn/x86/pentium4/sse2/sqr_basecase.asm: Likewise. + * mpn/x86_64/lshift.asm: Likewise. + * mpn/x86_64/rshift.asm: Likewise. + + * tests/cxx/t-locale.cc (point_string): Declare as extern "C" to + placate compilers that mangle variable names. + +2009-05-04 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Generate operands that are multiple of each other. + +2009-05-01 Torbjorn Granlund + + * gmp-h.in (__GMP_EXTERN_INLINE): Support for more systems. + (gmp_randinit_set): Add missing __GMP_DECLSPEC. + +2009-04-28 Torbjorn Granlund + + * mpn/generic/neg_n.c: New file. + * configure.in (gmp_mpn_functions): Add neg_n. + * mpn/asm-defs.m4 (define_mpn): Add neg_n. + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Add neg_n.c. + * gmp-h.in: Handle mpn_neg_n properly. + + * mpn/generic/toom_interpolate_7pts.c (divexact_2exp): Nailify. + + * mpn/generic/gcdext.c: Change some MPN_NORMALIZE to + MPN_NORMALIZE_NOT_ZERO. + * mpn/generic/gcdext_lehmer.c: Likewise. + Add a MPN_NORMALIZE_NOT_ZERO. + + * mpn/generic/binvert.c: Remove own mpn_neg_n. + + * tests/mpz/t-gcd.c: Add some MPZ_CHECK_FORMAT calls. + +2009-04-27 Torbjorn Granlund + + * mpn/Makefile.am (TARG_DIST): Add minithres. + + * mpn/generic/bdiv_dbm1c.c: Handle nails. + +2009-04-26 Torbjorn Granlund + + * config.guess: Recognise more POWER processor types. + +2009-04-25 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/popcount.asm: Work around Apple reloc bug. + * mpn/x86/darwin.m4: Define symbol "DARWIN". + +2009-04-19 Torbjorn Granlund + + * mpn/generic/powm.c (mpn_redc_n): Use ASSERT_ALWAYS, not abort(). + * mpn/generic/powm_sec.c: Likewise. + + * mpn/powerpc64/aix.m4 (EXTERN_FUNC): New define. Add dummy variants + for other m4 files. + * mpn/powerpc64/mode64/divrem_1.asm: Use EXTERN_FUNC. + * mpn/powerpc64/mode64/divrem_1.asm: Likewise. + +2009-04-16 Torbjorn Granlund + + * mpn/x86_64/x86_64-defs.m4 (JUMPTABSECT): New define. + * mpn/x86_64/darwin.m4: Likewise. + * mpn/x86_64/sqr_basecase.asm: Rework switch code using JUMPTABSECT. + + * tune/common.c (speed_mpn_hgcd, speed_mpn_hgcd_lehmer): + Remove an unused variable. + + * mpn/x86/x86-defs.m4 (LEA): Get SIZE arguments right. + +2009-04-14 Torbjorn Granlund + + * Version 4.3.0 released. + + * scanf/doscan.c (__gmp_doscan): Pad 3-operand scanf call with dummy + argument. + * scanf/sscanffuns.c (scan): Disable vsscanf variant for now. + +2009-04-13 Torbjorn Granlund + + * scanf/sscanffuns.c (scan): Rewrite to use stdarg. + + * tests/mpz/t-root.c: Rewrite. Add unconditional gcc 4.3.2 tests. + +2009-04-09 Torbjorn Granlund + + * mpn/generic/powm.c: New file. + * mpn/generic/powlo.c: New file. + * mpn/generic/powm_sec.c: New file. + * configure.in (gmp_mpn_functions): List new functions. + +2009-04-08 Torbjorn Granlund + + * mpz/urandomm.c: Amend last fix. + +2009-04-06 Torbjorn Granlund + + * configure.in: Support Sun cc for x86_64. + + * mpz/urandomm.c: Handle operand overlap. + +2009-03-11 Torbjorn Granlund + + * configure.in (powerpc): Brave removing -Wa,-mppc64, in the hope that + GCC now passes the proper options. + +2009-03-09 Torbjorn Granlund + + * mpn/x86_64/divrem_1.asm: Add a nop to save a cycle in unnormalised + case. + +2009-03-05 Torbjorn Granlund + + * ia64/gmp-mparam.h, arm/gmp-mparam.h, x86/p6/mmx/gmp-mparam.h, + pa32/hppa2_0/gmp-mparam.h sparc32/v9/gmp-mparam.h: Update. + +2009-03-03 Torbjorn Granlund + + * mpn/ia64/bdiv_dbm1c.asm: Accept/return carry. + +2009-03-02 Torbjorn Granlund + + * configure.in (64-bit sparc/solaris): Pass -xO3, not -O3 to solaris + system compiler. + +2009-03-01 Torbjorn Granlund + + * longlong.h (mips, powerpc): Provide assembly-free umul_ppmm for newer + gcc. + +2009-02-04 Torbjorn Granlund + + * mpn/generic/redc_2.c: Remove code for testing and timing. Update + to current FSF header. + * mpn/generic/redc_1.c: Update to current FSF header. + +2009-01-21 Torbjorn Granlund + + * mpz/powm.c (redc): Remove. + (mpz_powm): Use mpn_redc_1 instead of redc. + + * tests/mpz/t-powm.c: Rewrite reference code. + +2009-01-18 Torbjorn Granlund + + * tests/mpz: Increase reps for many tests. + + * mpn/generic/rootrem.c (mpn_rootrem_internal): Use MPN_DECR_U instead of + mpn_sub_1 (works around gcc 4.3 bugs and is also faster). + +2009-01-16 Torbjorn Granlund + + * tests/tests.h: Declare refmpn_divrem_2. + +2009-01-15 Torbjorn Granlund + + * mpz/perfpow.c: Add TMP_FREE before every return statement. + + * mpn/generic/rootrem.c (mpn_rootrem_internal): Add a missing TMP_FREE. + + * configure.in (gcc_cflags, gcc_64_cflags): Revert from -O3 to -O2, + the change was accidental and cause too much miscompilation. + +2009-01-14 Torbjorn Granlund + + * tune/tuneup.c (tune_mod_1): Run MOD_1_x_THRESHOLD tests also when + longlong.h specified UDIV_PREINV_ALWAYS. + + * mpn/generic/mod_1.c (mpn_mod_1): Properly check for normalisation + divisor. + +2009-01-13 Torbjorn Granlund + + * tune/tuneup.c (tune_mod_1): Tune for MOD_1_1_THRESHOLD, + MOD_1_2_THRESHOLD, and MOD_1_4_THRESHOLD. + + * mpn/generic/mod_1.c: Rewrite. + * mpn/generic/mod_1_1.c: New file. + * mpn/generic/mod_1_2.c: New file. + * mpn/generic/mod_1_3.c: New file. + * mpn/generic/mod_1_4.c: New file. + * configure.in (gmp_mpn_functions): Add mod_1_*. + * mpn/asm-defs.m4 (define_mpn): Add mod_1_*. + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Add mod_1_*.c. + * gmp-impl.h: Declare new mpn_mod_1s_* functions and associated + THRESHOLD macros. + (udiv_rnd_preinv): New macro. + +2009-01-12 Torbjorn Granlund + + * tune/tuneup.c (tune_gcd_dc,tune_gcdext_dc): Lower step_factor to 0.1. + +2009-01-08 Torbjorn Granlund + + * tests/mpz/t-nextprime.c: New test file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add t-nextprime. + + From Niels Möller: + * mpz/nextprime.c: Handle large prime gaps by limiting incr. + +2009-01-04 Torbjorn Granlund + + * mpz/and.c, mpz/ior.c, mpz/xor.c: Re-read only necessary source + pointers after reallocation. Misc cleanup. + + * gmp-impl.h (MPN_TOOM44_MAX_N): New define, replaces MPN_TOOM3_MAX_N. + + * mpn/x86/fat/diveby3.c: New file. + +2008-12-30 Niels Möller + + * doc/gmp.texi (Greatest Common Divisor Algorithms): Updated + section on GCD algorithms. + +2008-12-29 Torbjorn Granlund + + * doc/gmp.texi (Multiplication Algorithms): Add descriptions of Toom-4 + and unbalanced multiplication. + (Radix to Binary): Add warning that text is outdated, + (Contributors): Fix typos. + + * mpn/generic/toom*.c: Use coherent MAYBE_ macros for trimming + unreachable recursive functions. + * gmp-impl.h: Update toom itch functions. + + * mpn/x86_64/sqr_basecase.asm: Slightly increase stack allocation, to + placate tuneup. + +2008-12-28 Torbjorn Granlund + + * mpn/x86_64/pentium4/aors_n.asm: Tune prologue code. + + * mpn/x86_64/pentium4/aorslsh1_n.asm: New file. + + * mpn/x86_64/darwin.m4: Define symbol "DARWIN". + * mpn/x86_64/invert_limb.asm: Work around darwin quirks. + + * mpn/x86_64/sqr_basecase.asm: Further optimize, support Darwin. + + * mpn/x86_64/invert_limb.asm: New file. + +2008-12-27 Torbjorn Granlund + + * mpn/x86_64/core2/aorslsh1_n.asm: New file. + +2008-12-26 Torbjorn Granlund + + * mpz/perfpow.c: Handle negative arguments properly. + * tests/mpz/t-perfpow.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add t-perfpow. + +2008-12-23 Torbjorn Granlund + + * tests/mpz/t-mul.c (dump_abort): Improve error message. + + * gcd.c gcd_subdiv_step.c gcdext.c gcdext_subdiv_step.c: + Remove private mpn_zero_p. + + * tune/tuneup.c (tune_mul): Tune for MUL_TOOM44_THRESHOLD. + (tune_sqr): Tune for SQR_TOOM4_THRESHOLD. + + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Add toom44_mul.c and + toom4_sqr.c. + + * configure.in (gmp_mpn_functions): Toom function updates. + + * Rename mpn/mul_toomMN.c to mpn/toomMN_mul.c. Function names changed + accordingly. + + * mpn/toomMN_mul.c: Add scratch parameter. Do recursive multiplies + properly. Misc tuning. Remove CHECK and TIMING code. + + * mpn/toom2_sqr.c, mpn/toom3_sqr.c, mpn/toom4_sqr.c: New files. + + * gmp-impl.h (mpn_toomMN_mul_itch): Several new functions. + (mpn_zero_p): New functions. + Add various TOOM4/TOOM44 related parameters. + Update mpn_toomMN_mul prototypes. + + * mpn/generic/mul_n.c (mpn_mul_n): Call mpn_toom44_mul. Use TMP_BALLOC + instead of malloc. + (mpn_sqr_n): Analogous changes. + + * mpn/generic/mul.c: Update unbalanced toom code to pass scratch space. + +2008-12-21 Torbjorn Granlund + + * mpz/nextprime.c: Add TMP_SDECL/MARK/FREE. + +2008-12-20 Torbjorn Granlund + + * mpn/generic/sqrtrem.c (mpn_sqrtrem1): Rewrite, improve interface. + (invsqrttab): New table, remove table approx_tab. + (mpn_sqrtrem2): Optimize, update mpn_sqrtrem1 call. + (mpn_sqrtrem): Update mpn_sqrtrem1 call. + +2008-12-18 Torbjorn Granlund + + * mpz/nextprime.c: Run 10 mpz_millerrabin tests (was 5). + Give credit to authors. + + * mpn/x86_64/redc_1.asm: Align stack as mandated by ABI. + + * mpn/x86_64/divrem_2.asm: Add some comments. + + * mpn/x86_64/darwin.m4: New file. + * configure.in: Use x86_64/darwin.m4. + +2008-12-15 Torbjorn Granlund + + * doc/projects.html: Remove GCD and division projects, update text on + multiplication. + + * doc/tasks.html: Add a caution about that the file is somewhat + outdated. + +2008-12-14 Torbjorn Granlund + + * mpn/alpha/ev6/aorsmul_1.asm: New file (same code for mpn_addmul_1, + much improved for mpn_submul_1). + * mpn/alpha/ev6/addmul_1: File removed. + * mpn/alpha/ev6/submul_1: File removed. + +2008-12-09 Torbjorn Granlund + + From David Harvey: + * mpn/x86_64/mul_basecase.asm: Further tweaks for code size and speed. + + * mpn/powerpc64/mode64/divrem_1.asm: Rewrite. + + * mpn/powerpc64/mode64/mul_basecase.asm: New file. + +2008-12-08 Torbjorn Granlund + + * mpn/powerpc64/mode64/gmp-mparam.h: New file. + + * gmp-impl.h: Additional cleanups. + (mpn_set_str_compute_powtab): New prototype. + (mpn_powm, mpn_powlo): New prototypes. + + * mpz/pow_ui.c: Handle some small exponents locally. + +2008-12-07 Torbjorn Granlund + + * mpn/generic/set_str.c: Remove prototypes (they are in gmp-impl.h). + + * tune/set_strs.c, tune/set_strb.c: Make prototypes effective by moving + the #define mpn_set_str* before including gmp-impl.h. + + * All files: Change _PROTO => __GMP_PROTO. + + * tune/speed.c (routine): Remove non-working choice mpn_set_str_subquad. + * tune/common.c (speed_mpn_dc_set_str): Remove, it is broken. + + * mpn/generic/toom_interpolate_7pts.c (divexact_2exp): Make this static, + and inline it. + + * gmp-impl.h: Major cleanup. + (Remove formal parameter names. Use __GMP_PROTO consistently. Move + __GMP_PROTO and __MPN use to adjacent lines for declared function. + Fix typos. Remove code inside #if 0.) + + * configure.in (gmp_mpn_functions): Add mul_toom33. Reformat. + +2008-12-05 Torbjorn Granlund + + * mpn/generic/redc_1.c: New file. + * mpn/generic/redc_2.c: New file. + + * configure.in (gmp_mpn_functions): List redc_1 and redc_2. + (HAVE_NATIVE): Likewise. + + * tune/common.c (speed_mpn_redc_1): Renamed from speed_redc. + * tune/speed.c (routine): Remove "redc", and "mpn_redc_1". + * tune/speed.h (SPEED_ROUTINE_REDC_1): Renamed from SPEED_ROUTINE_REDC. + Updated call. + * tune/tuneup.c (tune_powm): Update redc call. + +2008-12-04 Torbjorn Granlund + + * mpn/x86_64/sqr_basecase.asm: Inline a combined diagonal product code + and addlsh1 loop. Misc cleanup. + +2008-12-02 Torbjorn Granlund + + * mpn/x86_64/sqr_basecase.asm: New file. + +2008-11-30 Torbjorn Granlund + + * mpn/generic/sqr_basecase.c: Fix typo in mpn_addmul_2s variant. + +2008-11-28 Torbjorn Granlund + + * mpn/x86_64/redc_1.asm: Rewrite. + +2008-11-27 Torbjorn Granlund + + * tests/refmpn.c (refmpn_redc_1): New function. + +2008-11-25 Torbjorn Granlund + + * mpn/x86/k7/aorsmul_1.asm: Actually handle mpn_submul_1. + +2008-11-23 Torbjorn Granlund + + * mpn/x86_64/divrem_1.asm: Rewrite. + + * alpha/divrem_2.asm: New file. + * powerpc32/divrem_2.asm: New file. + * powerpc64/mode64/divrem_2.asm: New file. + * x86/divrem_2.asm: New file. + * x86_64/divrem_2.asm: New file. + * tests/refmpn.c (refmpn_divrem_2): New function. + +2008-11-22 Torbjorn Granlund + + * mpn/x86/k7/mul_1.asm: Rewrite for smaller size and better speed. + * mpn/x86/k7/aorsmul_1.asm: Likewise. + + * acinclude.m4 (GMP_VERSION): Include last component even when zero. + +2008-11-21 Torbjorn Granlund + + * mpn/x86_64/README: Rewrite. + + * tests/devel/try.c (malloc_region, mprotect_maybe): Add casts for + printf type correctness. + + * gmp-h.in (__GNU_MP_VERSION_MINOR): Bump. + + * Makefile.am (LIBGMP_LT_*, LIBGMPXX_LT_*, LIBMP_LT_*): + Bump version info. + +2008-11-20 Torbjorn Granlund + + * gmp-impl.h: Rename modlimb_invert to binvert_limb. + * tune/speed.h: Likewise. + * tune/modlinv.c: Likewise. + * tune/common.c: Likewise. + * tests/t-modlinv.c: Likewise. + * tests/t-constants.c: Likewise. + * mpn/sparc64/mode1o.c: Likewise. + * mpn/alpha/dive_1.c: Likewise. + * mpn/sparc64/dive_1.c: Likewise. + * mpn/generic/mode1o.c: Likewise. + * mpn/generic/dive_1.c: Likewise. + * mpn/generic/bdivmod.c: Likewise. + * mpn/alpha/mode1o.asm: Likewise. + * mpn/asm-defs.m4: Likewise. + * mpn/ia64/mode1o.asm: Likewise. + * mpn/powerpc32/README: Likewise. + * mpn/powerpc32/mode1o.asm: Likewise. + * mpn/powerpc64/mode64/dive_1.asm: Likewise. + * mpn/powerpc64/mode64/mode1o.asm: Likewise. + * mpn/x86/dive_1.asm: Likewise. + * mpn/x86/k6/mmx/dive_1.asm: Likewise. + * mpn/x86/k6/mode1o.asm: Likewise. + * mpn/x86/k7/dive_1.asm: Likewise. + * mpn/x86/k7/mode1o.asm: Likewise. + * mpn/x86/p6/dive_1.asm: Likewise. + * mpn/x86/p6/mode1o.asm: Likewise. + * mpn/x86/pentium/dive_1.asm: Likewise. + * mpn/x86/pentium/mode1o.asm: Likewise. + * mpn/x86/pentium4/sse2/dive_1.asm: Likewise. + * mpn/x86/pentium4/sse2/mode1o.asm: Likewise. + * mpn/x86_64/dive_1.asm: Likewise. + * mpn/x86_64/mode1o.asm: Likewise. + + * mpn/x86_64/aors_n.asm: Replace with slightly faster, more alignment + neutral loop. + +2008-11-18 Torbjorn Granlund + + * configure.in: Remove gcd_finda related declarations. + * gmp-impl.h (mpn_gcd_finda): Remove declaration. + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Remove gcd_finda. + * mpn/asm-defs.m4: Remove define_mpn(gcd_finda). + * mpn/x86/k6/gcd_finda.asm: Remove file. + * tests/devel/try.c (param_init): Remove mpn_gcd_finda. + (choice_array): Remove mpn_gcd_finda. + * tests/mpn/t-instrument.c (check): Remove testing of mpn_gcd_finda. + * tests/refmpn.c (refmpn_gcd_finda): Remove. + * tests/tests.h (refmpn_gcd_finda): Remove declaration. + * tune/common.c (speed_mpn_gcd_finda): Remove. + * tune/gcd_finda_gen.c: Remove file. + * tune/speed.h (speed_mpn_gcd_finda): Remove declaration. + * tune/speed.c (routine): Remove mpn_gcd_finda entry. + + * tests/mpz/t-powm.c: Print test number when failing a test. + + * mpn/x86_64/redc_1.asm (CALL): Move from here... + * mpn/x86_64/x86_64-defs.m4: ...to here. + + * gmp-impl.h (mpn_jacobi_base): Remove parameter names. + +2008-11-11 Torbjorn Granlund + + * tests/mpf/t-conv.c: Add some specific tests, supplementing the random + tests. + +2008-11-09 Torbjorn Granlund + + * mpf/set_str.c: Default 'base' before letting exp_base inherit it. + + * tests/cxx/t-prec.cc: Use the right precision for all float constants. + +2008-11-08 Torbjorn Granlund + + * doc/gmp.texi (Float Comparison): Update mpf_eq documentation. + + * mpf/eq.c: Compare the right number of bits. + +2008-11-02 Torbjorn Granlund + + Undo, it made testing too slow: + * tests/mpz/t-mul.c: Use slower geometric progression for operand + sizes. + + * mpn/x86/k7/mod_34lsub1.asm: Use movzb for masking low 8 bits. + +2008-10-31 Niels Möller + + * mpn/generic/hgcd2.c (div1): New function (taken from old gcdext + implementation) + (mpn_hgcd2): Use single precision for the second half of the work. + +2008-10-30 Torbjorn Granlund + + * mpn/x86/p6/sse2/gmp-mparam.h: New file. + +2008-10-29 Torbjorn Granlund + + * configure.in (x86 fat_path): Add "x86/p6/sse2". + + * mpn/x86/fat/fat.c (__gmpn_cpuvec_init): Recognize sse2 capable p6 + (pentiumm, core2). + + * mpn/x86/p6/sse2/mul_1.asm: New file. + * mpn/x86/p6/sse2/addmul_1.asm: New file. + * mpn/x86/p6/sse2/submul_1.asm: New file. + * mpn/x86/p6/sse2/mul_basecase.asm: New file. + * mpn/x86/p6/sse2/sqr_basecase.asm: New file. + * mpn/x86/p6/sse2/popcount.asm: New file. + + * mpn/x86/fat/fat.c (__gmpn_cpuvec_init): Handle "extended" fields for + model and family. + +2008-10-28 Torbjorn Granlund + + From Mickael Gastineau: + * gmp-h.in (gmp_urandomm_ui, gmp_urandomb_ui): Add __GMP_DECLSPEC. + +2008-10-27 Torbjorn Granlund + + * gmp-h.in (mpn_gcdext_1): Remove bogus __GMP_ATTRIBUTE_PURE. + +2008-10-27 Niels Möller + + * tune/common.c (speed_mpn_hgcd): Call mpn_hgcd_matrix_init once + for each call to mpn_hgcd. + (speed_mpn_hgcd_lehmer): Likewise. + +2008-10-26 Torbjorn Granlund + + * configure.in: Point to p6/sse2 for pentiumm and core2. + + * gmp-impl.h (mpn_add_nc, mpn_sub_nc): Move these macros to after fat + definitions. + + * tune/common.c, tune/speed.c, tune/speed.h: + Add speed measurement of mpn_bdiv_dbm1c. + +2008-10-24 Torbjorn Granlund + + * mpn/x86_64/gmp-mparam.h (MUL_FFT_TABLE2, SQR_FFT_TABLE2): Extend. + + * mpz/nextprime.c: Move declarations to function beginning. + +2008-10-23 Niels Möller + + * gmp-impl.h (DECL_gcdext_1): Deleted. + +2008-10-22 Torbjorn Granlund + + * mpn/x86_64/atom/aors_n.asm: New file. + * mpn/x86_64/atom/gmp-mparam.h: New file. + +2008-10-21 Torbjorn Granlund + + With Neils Möller: + * mpz/nextprime.c: Rewrite. + + * tests/devel/try.c (main): Use strtol for 's' and 'S' optargs. + + * mpn/x86_64/pentium4/rshift.asm: Misc cleanups. + * mpn/x86_64/pentium4/lshift.asm: Likewise. + + * mpn/x86_64/pentium4/aors_n.asm: Use fewer registers. + + * configure.in: Set up specific path for x86_64/atom. + +2008-10-21 Niels Möller + + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Removed + qstack.c. + * mpn/generic/qstack.c: Deleted obsolete file. + +2008-10-20 Torbjorn Granlund + + * mpn/x86_64/core2/aorsmul_1.asm: New file. + +2008-10-19 Torbjorn Granlund + + * mpn/x86_64/aors_n.asm: Remove redundant MULFUNC_PROLOGUE. + + * gmp-impl.h (popc_limb): Remove redundant checks of GMP_LIMB_BITS + inside several of these macros. + +2008-10-17 Torbjorn Granlund + + * tests/mpz/t-mul.c: Use slower geometric progression for operand + sizes. Do every other tests for same size operands. + +2008-10-15 Torbjorn Granlund + + * mpn/x86_64/mul_basecase.asm: Simplify addressing in epilogue. + + * mpn/mips64/divrem_1.asm: Remove file, it is n32-only, and uses an old + algorithm. + + * config.guess, config.sub, configure.in: Support Intel Atom processor. + +2008-10-10 Torbjorn Granlund + + * mpq/mul.c: Fix typo in last change. + +2008-10-09 Torbjorn Granlund + + * tests/refmpn.c (refmpn_sb_divrem_mn): Work around a gcc bug. + +2008-10-08 Torbjorn Granlund + + * mpq/mul.c: Use TMP_ALLOC. Cleanup. + * mpq/div.c: Likewise. + + * mpn/x86_64/mul_basecase.asm: Use lea directly for loading entry point + addresses. + +2008-10-09 Niels Möller + + * mpn/x86/k7/gmp-mparam.h: Updated GCD-related values. + +2008-10-05 Torbjorn Granlund + + * mpn/generic/mul_fft.c (mpn_mul_fft_internal): Do store + mpn_fft_norm_modF return value, if (rec). + +2008-10-04 Torbjorn Granlund + + * mpn/x86_64/aorsmul_1.asm: Replace with faster code. + * mpn/x86_64/mul_1.asm: Likewise. + * mpn/x86_64/addmul_2.asm: Likewise. + * mpn/x86_64/mul_2.asm: Likewise. + * mpn/x86_64/mul_basecase.asm: Likewise. + +2008-10-02 Torbjorn Granlund + + * mpn/minithres/gmp-mparam.h: Update FFT values. + +2008-10-02 Niels Möller + + * hgcd.c (mpn_hgcd_matrix_mul): Fixed normalization bug. + +2008-09-24 Torbjorn Granlund + + * configure.in: Handle --enable-minithres. + * mpn/minithres/gmp-mparam.h: Update all values. + +2008-09-22 Torbjorn Granlund + + * tune/speed.c (routine): New entry for mpn_mul. + * tune/speed.h (SPEED_ROUTINE_MPN_MUL): Renamed from + SPEED_ROUTINE_MPN_MUL_BASECASE. + (speed_mpn_mul): Renamed from speed_mpn_mul_basecase. + (SPEED_ROUTINE_MPN_MUL): Allocate our own memory of xp operand. + + * tune/common.c: Corresponding changes. + +2008-09-22 Niels Möller + + * mpn/generic/gcdext.c (hgcd_mul_matrix_vector): New function, + replaces addmul2_n. Needs less copying. + (mpn_gcdext): Use hgcd_mul_matrix_vector. Updated for interface + change in mpn_gcdext_subdiv_step + + * mpn/generic/hgcd.c (hgcd_matrix_mul_1): Rewritten to use + mpn_hgcd_mul_matrix1_vector. + (hgcd_step): Updated for interface change in + mpn_hgcd_mul_matrix1_inverse_vector. + + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_n): Updated for + interface changes in mpn_hgcd_mul_matrix1_vector, + mpn_hgcd_mul_matrix1_inverse_vector and mpn_gcdext_subdiv_step. + + * mpn/generic/gcd_lehmer.c (mpn_gcd_lehmer_n): Updated for + interface change in mpn_hgcd_mul_matrix1_inverse_vector. + + * mpn/generic/gcdext_subdiv_step.c (mpn_gcdext_subdiv_step): Use + separate scratch arguments for the quotient and for the cofactor + update. + + * mpn/generic/hgcd2.c (mpn_hgcd_mul_matrix1_vector): Interface + change. Store first element in rp and leave ap unmodified. No + additional scratch space or copying needed. Callers that require + modification in place still need to copy one of the inputs. + (mpn_hgcd_mul_matrix1_inverse_vector): Likewise. + +2008-09-22 Niels Möller + + * mpn/generic/hgcd.c (hgcd_matrix_mul_1): Use mpn_addaddmul_1msb0. + * mpn/generic/hgcd2.c (mpn_hgcd_mul_matrix1_vector): Likewise. + + * mpn/generic/gcd.c: Use libspeed for timing measurements. + + * gmp-impl.h: Declare mpn_addaddmul_1msb0. + * mpn/asm-defs.m4: Added addaddmul_1msb0. + * mpn/x86_64/addaddmul_1msb0.asm: New file. + * configure.in (gmp_mpn_functions_optional): Added + addaddmul_1msb0. + (HAVE_NATIVE): List addaddmul_1msb0. + +2008-09-21 Torbjorn Granlund + + * mpn/generic/get_str.c (GET_STR_DC_THRESHOLD): Remove default. + (GET_STR_PRECOMPUTE_THRESHOLD): Likewise. + Misc code cleanups. + + * gmp-impl.h (mpn_dc_set_str_itch): Allocate GMP_LIMB_BITS more limbs. + + Revert: + * mpn/generic/set_str.c: + (mpn_dc_set_str): Remove impossible case, replace by an ASSERT. + +2008-09-18 Torbjorn Granlund + + * mpn/alpha/ev6/gmp-mparam.h (DIVEXACT_BY3_METHOD): Define. + + * mpn/ia64/diveby3.asm: Remove. + * mpn/x86/diveby3.asm: Remove. + * mpn/x86/k6/diveby3.asm: Remove. + * mpn/x86/k7/diveby3.asm: Remove. + * mpn/x86/p6/diveby3.asm: Remove. + * mpn/x86/pentium/diveby3.asm: Remove. + * mpn/x86_64/diveby3.asm: Remove. + * mpn/x86/pentium4/sse2/diveby3.asm: Remove. + + * configure.in (HAVE_NATIVE): List divexact_by3c. + + * gmp-impl.h (mpn_divexact_by3c): Override gmp-h.in's definition. + (DIVEXACT_BY3_METHOD): Don't default to 0 if + HAVE_NATIVE_mpn_divexact_by3c. + +2008-09-18 Niels Möller + + * mpn/generic/gcd.c (main): Added code for tuning of CHOOSE_P. + + * mpn/generic/hgcd.c (mpn_hgcd_matrix_mul): Assert that inputs are + normalized. + +2008-09-17 Niels Möller + + * mpn/generic/gcdext.c (mpn_gcdext): p = n/5 caused a + slowdown for large inputs. As a compromise, use p = n/2 for the + first iteration, and p = n/3 for the rest. Handle the first + iteration specially, since the initial u0 and u1 are trivial. + + * mpn/x86_64/gmp-mparam.h (GCDEXT_DC_THRESHOLD): Reduced threshold + from 409 to 390. + + * mpn/generic/gcdext.c (CHOOSE_P): New macro. Use p = n/5. + (mpn_gcdext): Use CHOOSE_P, and generalized the calculation of + scratch space. + + * tune/tuneup.c (tune_hgcd): Use default step factor. + + * mpn/x86_64/gmp-mparam.h: (GCD_DC_THRESHOLD): Reduced from 493 to + 412. + + * mpn/generic/gcd.c (CHOOSE_P): New macro, to determine the + split when calling hgcd. Use p = 2n/3, as that seems better than + the more obvious split p = n/2. + (mpn_gcd): Use CHOOSE_P, and generalized the calculation of + scratch space. + +2008-09-16 Torbjorn Granlund + + * mpn/generic/toom_interpolate_7pts.c: Use new mpn_divexact_byN + functions. + + * gmp-impl.h (mpn_divexact_by3, mpn_divexact_by5, mpn_divexact_by7, + mpn_divexact_by9, mpn_divexact_by11, mpn_divexact_by13, + mpn_divexact_by15): New macros, defined in terms of mpn_bdiv_dbm1. + + * configure.in (gmp_mpn_functions): List bdiv_dbm1c. + (HAVE_NATIVE): Likewise. + * mpn/asm-defs.m4: Define bdiv_dbm1c. + * gmp-impl.h (mpn_bdiv_dbm1c): Declare. + (mpn_bdiv_dbm1): New macro. + * mpn/generic/bdiv_dbm1c.c: New file. + * mpn/alpha/bdiv_dbm1c.asm: New file. + * mpn/ia64/bdiv_dbm1c.asm: New file. + * mpn/powerpc32/bdiv_dbm1c.asm: New file. + * mpn/powerpc64/mode64/bdiv_dbm1c.asm: New file. + * mpn/x86/bdiv_dbm1c.asm: New file. + * mpn/x86_64/bdiv_dbm1c.asm: New file. + + * mpn/generic/diveby3.c: Add mpn_bdiv_dbm1c based function. + Choose function depending on DIVEXACT_BY3_METHOD. + * gmp-impl.h (DIVEXACT_BY3_METHOD): Provide default. + +2008-09-16 Niels Möller + + * mpn/generic/hgcd.c (mpn_hgcd_addmul2_n): Moved function to + gcdext.c, where it is used. + * mpn/generic/gcdext.c (addmul2_n): Moved and renamed, was + mpn_hgcd_addmul2_n. Made static. Deleted input normalization. + Deleted rn argument. + (mpn_gcdext): Updated calls to addmul2_n, and added assertions. + + * gmp-impl.h (MPN_HGCD_MATRIX_INIT_ITCH): Increased storage by 4 limbs. + (MPN_HGCD_LEHMER_ITCH): Reduced storage by one limb. + (MPN_GCD_SUBDIV_STEP_ITCH): Likewise. + (MPN_GCD_LEHMER_N_ITCH): Likewise. + + * mpn/generic/hgcd.c (mpn_hgcd_matrix_init): Use two extra limbs. + (hgcd_step): Use overlapping arguments to mpn_tdiv_qr. + (mpn_hgcd_matrix_mul): Deleted normalization code. Tighter bounds + for the element size of the product. Needs two extra limbs of + storage for the elements. + (mpn_hgcd_itch): Updated storage calculation. + + * mpn/generic/gcd_subdiv_step.c (mpn_gcd_subdiv_step): Use + overlapping arguments to mpn_tdiv_qr. Use mpn_zero_p. + + * mpn/generic/gcd.c (mpn_gcd): Use mpn_zero_p. + +2008-09-15 Niels Möller + + * mpn/generic/hgcd.c (mpn_hgcd_matrix_init): Updated for deleted + tp pointer. + (hgcd_matrix_update_q): Likewise. + (mpn_hgcd_matrix_mul): Likewise. + (mpn_hgcd_itch): Updated calculation of scratch space. + + * gmp-impl.h (struct hgcd_matrix): Deleted tp pointer. + (MPN_HGCD_MATRIX_INIT_ITCH): Reduced storage. + (mpn_hgcd_step, MPN_HGCD_STEP_ITCH): Deleted declarations. + +2008-09-15 Niels Möller + + * mpn/x86_64/gmp-mparam.h (MATRIX22_STRASSEN_THRESHOLD): New + threshold. + + * mpn/generic/hgcd.c (mpn_hgcd_matrix_mul): Use mpn_matrix22_mul. + (mpn_hgcd_itch): Updated calculation of scratch space. Use + count_leading_zeros to get the recursion depth. + + * mpn/generic/gcd.c (mpn_gcd): Fixed calculation of scratch space, + and use mpn_hgcd_itch. + +2008-09-15 Niels Möller + + * tune/tuneup.c (tune_matrix22_mul): New function. + (all): Use it. + + * tune/common.c (speed_mpn_matrix22_mul): New function. + + * tune/Makefile.am (TUNE_MPN_SRCS_BASIC): Added matrix22_mul.c. + + * tests/mpn/t-matrix22.c: Use MATRIX22_STRASSEN_THRESHOLD to + select sizes for tests. + + * gmp-impl.h (MATRIX22_STRASSEN_THRESHOLD): New threshold + + * configure.in (gmp_mpn_functions): Added matrix22_mul. + * gmp-impl.h: Added declarations for mpn_matrix22_mul and related + functions. + + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Added + matrix22_mul.c. + * tests/mpn/Makefile.am (check_PROGRAMS): Added t-matrix22. + + * tests/mpn/t-matrix22.c: New file. + * mpn/generic/matrix22_mul.c: New file. + +2008-09-11 Niels Möller + + * tune/tuneup.c: Updated tuning of gcdext. + + * mpn/x86_64/gmp-mparam.h (GCDEXT_DC_THRESHOLD): Reduced threshold + from 713 to 409. + +2008-09-11 Niels Möller + + * gmp-impl.h: Updated for gcdext changes. + (GCDEXT_DC_THRESHOLD): New constant, renamed from + GCDEXT_SCHOENHAGE_THRESHOLD. + + * mpn/generic/gcdext.c (compute_v): Accept non-normalized a and b + as inputs. + (mpn_gcdext): Rewrote and simplified. Now uses the new mpn_hgcd + interface. + + * mpn/generic/hgcd.c (mpn_hgcd_addmul2_n): Renamed from addmul2_n + and made non-static. Changed interface to take non-normalized + inputs, and only two size arguments. + (mpn_hgcd_matrix_mul): Simplified using new mpn_hgcd_addmul2_n. + + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_itch): Deleted + function. + (mpn_gcdext_lehmer_n): Renamed from mpn_gcd_lehmer. Now takes + inputs of equal size. Moved the code for the division step to a + separate function... + * mpn/generic/gcdext_subdiv_step.c (mpn_gcdext_subdiv_step): New + file, new function. + + * configure.in (gmp_mpn_functions): Added gcdext_subdiv_step. + +2008-09-10 Torbjorn Granlund + + * tests/devel/anymul_1.c: Include . + + * gmp-h.in: Unconditionally include . + +2008-09-10 Niels Möller + + * tune/common.c: #if:ed out speed_mpn_gcd_binary and + speed_mpn_gcd_accel. + * tune/speed.c (routine): #if:ed out mpn_gcd_binary, mpn_gcd_accel + and find_a. + * tune/Makefile.am (libspeed_la_SOURCES): Removed gcd_bin.c + gcd_accel.c gcd_finda_gen.c. + * tune/tuneup.c: Enable tuning of GCD_DC_THRESHOLD. + + * mpn/generic/gcd.c (mpn_gcd): Rewrote and simplified. Now uses + the new mpn_hgcd interface. + + * */gmp-mparam.h: Renamed GCD_SCHOENHAGE_THRESHOLD to + GCD_DC_THRESHOLD. + + * mpn/generic/gcd_lehmer.c (mpn_gcd_lehmer_n): Renamed (was + mpn_gcd_lehmer). Now takes inputs of equal size. + + * mpn/generic/gcd_lehmer.c (mpn_gcd_lehmer): Reintroduced gcd_2, + to get better performance for small inputs. + + * mpn/generic/hgcd.c: Don't hardcode small HGCD_THRESHOLD. + * mpn/x86_64/gmp-mparam.h (HGCD_THRESHOLD): Reduced from 145 to + 120. + * */gmp-mparam.h: Renamed HGCD_SCHOENHAGE_THRESHOLD to + HGCD_THRESHOLD. + +2008-09-09 Torbjorn Granlund + + * doc/gmp.texi: Fix a typo and clarify mpn_gcdext docs. + +2008-09-09 Niels Möller + + * tune/common.c (speed_mpn_hgcd, speed_mpn_hgcd_lehmer): Adapted + to new hgcd interface. + + * gmp-impl.h (MPN_HGCD_LEHMER_ITCH): New macro. + + * hgcd.c (mpn_hgcd_lehmer): Renamed function, from hgcd_base. Made + non-static. + + * gcd_lehmer.c (mpn_gcd_lehmer): Use hgcd2 also for n == 2. + + * gcdext_lehmer.c (mpn_gcdext_lehmer): Simplified code for + division step. Added proper book-keeping of swaps, which affect + the sign of the returned cofactor. + + * tests/mpz/t-gcd.c (one_test): Display co-factor when mpn_gcdext + fails. + + * gcd_lehmer.c (mpn_gcd_lehmer): At end of loop, need to handle + the special case n == 1 correctly. + + * gcd_subdiv_step.c (mpn_gcd_subdiv_step): Simplified function. + The special cancellation logic is not needed here. + +2008-09-08 Torbjorn Granlund + + * mpn/generic/invert.c: Add working but slow code. + + * mpn/x86_64/x86_64-defs.m4 (R32, R8): New macros. + + * mpn/ia64/submul_1.asm: Move some labels for broader assembler + compatibility. + + * gmp-impl.h (mpn_mul_3, mpn_mul_4): Declare. + * tests/tests.h (refmpn_mul_3, refmpn_mul_4): Declare. + * tests/try.c (param_init): Set things up for mpn_mul_3 and mpn_mul_4. + (choice_array): Likewise. + (call): Likewise. + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): + Add mul_3.c and mul_4. + * mpn/asm-defs.m4: Define mul_3 and mul_4. + * tests/refmpn.c (refmpn_mul_N): New function. + (refmpn_mul_2): Remove old definition, call refmpn_mul_N. + (refmpn_mul_3, refmpn_mul_4): New functions. + * tune/common.c (speed_mpn_mul_3, speed_mpn_mul_4): New functions. + * tune/speed.h (speed_mpn_mul_3, speed_mpn_mul_4): Declare. + * tune/speed.c (routine): New entries for mpn_mul_2 and mpn_mul_3. + + * ltmain.sh: Update to libtool 1.5.24. + + * mpn/generic/mul_toom22.c: Compute s and t more cleverly. + +2008-09-08 Niels Möller + + * tests/mpn/t-hgcd.c: Updated tests. Rewrite of hgcd_ref. + + * mpn/generic/gcdext_lehmer.c (mpn_gcdext_lehmer_itch): New function. + (mpn_gcdext_lehmer): Various bugfixes. + + * gcdext.c (mpn_gcdext): Allocate scratch space for gcdext_lehmer. + + * mpn/generic/gcd_lehmer.c (gcd_2): ASSERT that inputs are odd. + (mpn_gcd_lehmer): Added tp argument, for scratch space. Make both + arguments odd before calling gcd_2. + + * mpn/generic/hgcd.c (mpn_hgcd): Allow the trivial case n <= 2, + and return 0 immediately. + + * gmp-impl.h (MPN_EXTRACT_NUMB): New macro. + + * configure.in (gmp_mpn_functions): Added gcdext_lehmer. + +2008-09-05 Torbjorn Granlund + + * mpn/generic/toom_interpolate_7pts.c: Use mpn_divexact_by3c instead of + divexact_odd. + + * doc/texinfo.tex: Update to 2007-06-29.13. + + * doc/gmp.texi: Update GMP site URL. Fix some typos. + + * demos/pexpr.c (main): Allow bases up to 62. + + * gmp-impl.h: Remove formal parameter names from function prototypes. + + * config.guess: Recognize recent AMD and Itanium CPUs. + Default X86 CPU recognition to configfsf.guess' value. + + * configure.in: Handle core2 separately from athlon64. + +2008-09-05 Niels Möller + + * */Makefile.in, configure, aclocal.m4, config.in: Removed files + from repository. They're instead generated by automake and + autoconf before distribution. + +2008-08-25 Torbjorn Granlund + + * mpf/set_str.c: Allocate mantissa space based on mantissa size, + not on destination variable space. + * mpf/set_str.c: Accept unary plus before exponent. + +2008-08-06 Torbjorn Granlund + + * mpn/generic/mul_toom22.c: Add statistics gathering functionality, + triggered by cpp predef STAT. + + From David Harvey: + * mpn/generic/mul_toom22.c: Decrease scratch space usage. + +2008-08-02 Torbjorn Granlund + + * tests/misc/t-scanf.c: Avoid negative arguments to _ui functions. + * tests/misc/t-printf.c: Likewise. + + * acinclude.m4 (X86_PATTERN): Add geode. + + * acinclude.m4 (CL_AS_NOEXECSTACK): Avoid -q flag to grep. + +2008-08-01 Torbjorn Granlund + + * acinclude.m4 (CL_AS_NOEXECSTACK): New. + * configure.in: Use CL_AS_NOEXECSTACK. + * mpn/Makeasm.am: Use ASM_FLAGS (defined by CL_AS_NOEXECSTACK). + + * gmpxx.h (__GMP_DBL_LIMBS): Use DBL_MAX_EXP instead of + std::numeric_limits::max_exponent for better portability. + +2008-07-29 Torbjorn Granlund + + * gmpxx.h (__GMP_DBL_LIMBS): New #define. + (__GMP_ULI_LIMBS): New #define. + (__GMPXX_TMP_UI): New macro. + (__GMPXX_TMP_SI): New macro. + (__GMPXX_TMP_D): New macro. + (struct __gmp_binary_and): Rewrite, using the new macros. + (struct __gmp_binary_ior): Likewise. + (struct __gmp_binary_xor): Likewise. + +2008-07-28 Torbjorn Granlund + + * tests/cxx/t-binary.cc: Add some tests for logical operations. + +2008-07-24 Torbjorn Granlund + + * gmpxx.h: Use __GMPZ_* instead of __GMPZZ_* for bitwise ops, remove + __GMPZZ_*. + Remove repeated #undefs. + (__gmp_alloc_cstring): Declare freefunc as extern "C". + +2008-07-23 Torbjorn Granlund + + * gmp-h.in (__GMP_CC): New define, undocumented for now. + (__GMP_CFLAGS): Likewise. + +2008-07-21 Torbjorn Granlund + + * tests/amd64check.c: Fix a printf type clash. + + * mpz/realloc.c: Amend last fix. + + * gmp-h.in: Include for C++. + * gmp-h.in: Handle new gcc 4.3 inline semantics defaults. + + * configfsf.guess: Update to version of 2008-04-14. + * configfsf.sub: Update to version of 2008-06-16. + + * configure.in: Separate core2 and athlon64 flags handling. + +2008-06-19 Torbjorn Granlund + + * config.guess: Recognize pentiumm and AMD geode. + * config.sub: Likewise. + * configure.in: Likewise. + +2008-06-02 Torbjorn Granlund + + * configure.in: Disallow odd nails sizes. + * configure.in: Inherit default gcc_cflags/gcc_64_cflags everywhere. + +2008-05-23 Torbjorn Granlund + + * mpz/init2.c: Rewrite to avoid internal overflow and to detect mpz_t + overflow. + * mpz/realloc2.c: Likewise. + * mpz/realloc.c: Detect mpz_t overflow. + +2008-05-22 Torbjorn Granlund + + * configure.in (sparc): Remove -fast, it causes documented + miscompilation. + + * config.guess: Properly handle the "extended" variants of x86 cpuid. + +2008-05-09 Torbjorn Granlund + + * gmp-impl.h (mpn_mul_fft): Now void. + (udiv_qrnnd_preinv3): Special case for constant (nl). + +2008-05-08 Torbjorn Granlund + + * mpn/generic/mul_fft.c: Clean up types in TRACE (printf (...)). + (TRACE): Redefine to allow command line control. + (mpn_mul_fft_internal): Now void, remove return value. + (mpn_mul_fft): Likewise. + (MPN_FFT_TABLE2_SIZE): Up size fro 256 to 512. + (mpn_fft_fft): Call mpn_fft_mul_2exp_modF just once instead of twice, + then add/subtract result. Get rid of temp allocation as a result. + Remove some redundant CNST_LIMB. + (mpn_fft_fftinv): Analogous changes. + (mpn_fft_sub_modF): Re-enable, now needed by mpn_fft_fft and + mpn_fft_fftinv. + +2008-03-10 Torbjorn Granlund + + * tests/mpz/t-mul.c (main): Let GMP_CHECK_FFT mean largest allowed + power-of-2 of test operands. + +2008-02-28 Torbjorn Granlund + + * tests/cxx/t-binary.cc (check_mpz): Expect floor rounding for right + shift. + +2008-02-27 Torbjorn Granlund + + * mpz/mul_i.h: Check sml's size (not the signed small_mult). + + * longlong.h (umul_ppmm) [alpha]: Define using __builtin_alpha_umulh + when possible. + + * longlong.h (count_trailing_zeros): Force destination register mode. + + * gmpxx.h (struct __gmp_binary_rshift): Use floor rounding, not + truncation. + + * gmpxx.h (__gmp_binary_and, __gmp_binary_ior, __gmp_binary_xor): + Add variants with unsigned long int argument. + + * config.sub: Recog geode. + * config.guess: Likewise. + * acinclude.m4 (X86_PATTERN): Likewise. + +2008-02-10 Torbjorn Granlund + + * mpn/x86/p6/aors_n.asm: Use Zdisp to work around GNU as bug. + * mpn/x86/x86-defs.m4 (Zdisp): Add more instructions. + +2008-02-08 Torbjorn Granlund + + * mpn/x86_64/aors_n.asm: New file. + * mpn/x86_64/add_n.asm: Delete. + * mpn/x86_64/sub_n.asm: Delete. + +2008-02-07 Torbjorn Granlund + + * mpn/x86/k6/mmx/dive_1.asm: Fix typo in last change. + +2007-12-10 Torbjorn Granlund + + * mpf/set_str.c (mpf_set_str): Write own code for converting the + exponent, avoids strtol base < 36 limitation. + +2007-10-28 Torbjorn Granlund + + * gmp-impl.h (mpn_dc_get_str_itch): New macro. + (mpn_dc_get_str_powtab_alloc): New macro. + (struct powers): Add field "shift". + + * mpn/generic/get_str.c: Compute powers without low zero limbs; all + functions modified. Correct temporary allocation. Misc cleanups. + + * mpn/generic/set_str.c: Compute powers without low zero limbs; all + functions modified. + (mpn_dc_set_str): Remove impossible case, replace by an ASSERT. + +2007-10-26 Torbjorn Granlund + + * mpn/generic/set_str.c: Remove default thresholds, not in gmp-impl.h. + (mpn_dc_set_str): Insert ASSERT_ALWAYS in a presumably dead code arm. + +2007-10-22 Torbjorn Granlund + + * gmp-impl.h (mpn_add_nc): Define as inline function, unless NATIVE. + (mpn_sub_nc): Likewise. + +2007-10-17 Torbjorn Granlund + + * tests/misc/t-printf.c: Fix a printf type clash. + * tests/mpq/t-get_str.c: Likewise. + * tests/mpz/t-import.c: Likewise. + + * acinclude.m4: Conditionally disable some tests when compiled by a C++ + compiler. + + * gmp-impl.h (udiv_qrnnd_preinv3): Remove an unused variable. + + * mpn/generic/hgcd.c: Add some WANT_ASSERTs to shut up warnings. + +2007-10-08 Torbjorn Granlund + + * mpn/powerpc64/elf.m4 (LEAL): Define as an alias for LEA. + * mpn/powerpc32/darwin.m4 (LEAL): Likewise. + * mpn/powerpc64/aix.m4: Likewise. + + * mpn/powerpc64/vmx/popcount.asm: Use LEAL. + + * mpn/powerpc64/darwin.m4 (LEAL): New name for LEA, since it is only + usable for local symbols. + (LEA): Replace with code for external references. + + * mpn/powerpc32/vmx/mod_34lsub1.asm: Use LEAL. + +2007-10-07 Torbjorn Granlund + + * mpn/x86/dive_1.asm: Use LEA, remove explicit movl_eip_*. + * mpn/x86/k6/mode1o.asm: Likewise. + * mpn/x86/k6/mmx/dive_1.asm: Likewise. + * mpn/x86/k7/dive_1.asm: Likewise. + * mpn/x86/k7/mode1o.asm: Likewise. + * mpn/x86/p6/dive_1.asm: Likewise. + * mpn/x86/p6/mode1o.asm: Likewise. + * mpn/x86/pentium4/sse2/dive_1.asm: Likewise. + * mpn/x86/pentium4/sse2/mode1o.asm: Likewise. + * mpn/x86/pentium4/sse2/popcount.asm: Likewise. + + * mpn/x86/p6/aors_n.asm: Table cycle counts. + + * mpn/x86/k7/mod_34lsub1.asm: Fix over-optimistic cycle count claims. + + * mpn/x86/x86-defs.m4 (DEF_OBJECT, END_OBJECT): New define's. + + * mpn/x86/darwin.m4 (LEA): Put also movl_eip_XX into EPILOGUE_cpu. + Expect target register to have prepended %. + + * mpn/x86_64/add_n.asm: Use L() for labels. + * mpn/x86_64/addlsh1_n.asm: Likewise. + * mpn/x86_64/addmul_2.asm: Likewise. + * mpn/x86_64/aorrlsh_n.asm: Likewise. + * mpn/x86_64/aorsmul_1.asm: Likewise. + * mpn/x86_64/com_n.asm: Likewise. + * mpn/x86_64/copyd.asm: Likewise. + * mpn/x86_64/copyi.asm: Likewise. + * mpn/x86_64/diveby3.asm: Likewise. + * mpn/x86_64/logops_n.asm: Likewise. + * mpn/x86_64/lshsub_n.asm: Likewise. + * mpn/x86_64/mul_1.asm: Likewise. + * mpn/x86_64/mul_2.asm: Likewise. + * mpn/x86_64/mul_basecase.asm: Likewise. + * mpn/x86_64/popham.asm: Likewise. + * mpn/x86_64/redc_1.asm: Likewise. + * mpn/x86_64/rsh1add_n.asm: Likewise. + * mpn/x86_64/rsh1sub_n.asm: Likewise. + * mpn/x86_64/rshift.asm: Likewise. + * mpn/x86_64/sub_n.asm: Likewise. + * mpn/x86_64/sublsh1_n.asm Likewise. + * mpn/x86_64/pentium4/aors_n.asm: Likewise. + * mpn/x86_64/pentium4/lshift.asm: Likewise. + * mpn/x86_64/pentium4/rshift.asm: Likewise. + + * mpn/x86_64/x86_64-defs.m4: New file, defining LEA, DEF_OBJECT, and + END_OBJECT. + + * mpn/generic/mul.c: Put TMP_DECL as last decl. + +2007-10-06 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/popcount.asm: New file. + +2007-09-26 Torbjorn Granlund + + * mpz/get_str.c: Cast a char index to int to shut up compilers. + + * mpn/generic/dc_div_qr.c: Pass dummy scratch argument to mpn_invert. + * mpn/generic/dc_divappr_q.c: Likewise. + * mpn/generic/mu_div_qr.c: Likewise. + * mpn/generic/mu_divappr_q.c: Likewise. + * mpn/generic/mu_div_q.c: Likewise. + * mpn/generic/divexact.c: Likewise. + + * mpn/generic/invert.c: New file, placeholder for now. + +2007-09-24 Torbjorn Granlund + + * mpn/generic/toom_interpolate_5pts.c: New file, contents from + mpn/generic/mul_n.c + * mpn/generic/mul_n.c (mpn_toom3_interpolate): Function removed. + + * mpn/generic/toom_interpolate_7pts.c: New file. + + * mpn/x86/k7/mmx/popham.asm: Table cycle counts. + + * mpn/x86/k6/README: Update URLs. + + * mpn/powerpc32/README: Update URL's, company names. + + * mpn/generic/get_d.c: Complete rewrite. + + * mpn/generic/mul_toom33.c: New file. + + * mpn/generic/mul_toom22.c: Make orthogonal with other toomXY files. + * mpn/generic/mul_toom32.c: Likewise. + * mpn/generic/mul_toom42.c: Likewise. + + * mpn/alpha/invert_limb.asm: Update cycle counts. Fix a comment typo. + + * mpf/get_str.c: Include stdlib.h, not stdio.h for NULL. + + * doc/gmp.texi: Fix a typo. + + * memory.c (__gmp_default_allocate, __gmp_default_reallocate): + Cast size operands in error fprintf's. + + * longlong.h (sub_ddmmss) [powerpc 64]: Add more variants for constant + args. + + * gmp-impl.h (udiv_qrnnd_preinv3): New define. + * gmp-impl.h (ULONG_PARITY): Exclude masquerading __INTEL_COMPILER from + ia64 asm. + + * gmp-h.in (mpn_neg_n): New function. + +2007-09-18 Torbjorn Granlund + + * demos/pexpr.c (main): Add -v option. + (enum op_t): New tag TIMING. + (mpz_eval_expr): Execute TIMING. + (fns): Add TIMING entry. + + * gmp-impl.h: Add decls and THRESHOLDs for new toom multiplication + functions and division functions. + +2007-09-10 Torbjorn Granlund + + * mpn/powerpc32/addlsh1_n.asm: Use L() for labels. + * mpn/powerpc32/sublsh1_n.asm: Likewise. + +2007-09-09 Torbjorn Granlund + + * mpn/x86/x86-defs.m4 (LEA): New define. + * mpn/x86/darwin.m4: New file, for now just defining LEA. + * configure.in: Pick up x86/darwin.m4. + * mpn/x86/*: Use LEA for PIC references. + + * configure.in: For X86/32, treat core2 like pentium3. + +2007-09-06 Torbjorn Granlund + + * tests/amd64check.c (calling_conventions_values): Put constants, + dynamic values in this array (was in scalars). + (calling_conventions_check): Corresponding changes. + * tests/amd64call.asm: Rewrite to be PIC, smaller, using amd64check.c's + array. + +2007-09-04 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/mul_basecase.asm: Misc cleanups. + * mpn/x86/pentium4/sse2/sqr_basecase.asm: Likewise. + + * mpn/x86_64/mod_34lsub1.asm: Optimize loop, reduce code size. + + * tests/amd64call.asm: Remove bogus no-op moves. + +2007-09-03 Torbjorn Granlund + + From Richard Guenther: + * gmp-h.in (__GMP_EXTERN_INLINE): Declare conditionally on + __GNUC_STDC_INLINE__. + + * tests/cxx/t-locale.cc: #include , for abort. + + * mpn/x86_64/core2/popcount.asm: New file. + * mpn/x86_64/pentium4/popcount.asm: New file. + + * mpn/x86_64/addmul_2.asm: New file. + * mpn/x86_64/mul_2.asm: New file. + + * mpn/x86_64/aorsmul_1.asm: Use 32-bit mov for zeroing registers + (saves space). + +2007-09-01 Torbjorn Granlund + + * configure.in: Handle athlon64, core2, and pentium4 separately for + 64-bit ABI. + + * config.sub: Recog athlon64, core2, and opteron. + + * config.guess: Do two x86 variants, for 32-bit ABI and 64-bit ABI. + Return "athlon64" and "core2", not x86_64. + +2007-08-31 Torbjorn Granlund + + From Patrick Pelissier: + * gmp-h.in: Don't refer to FILE from C++ unless we've seen FILE. + +2007-08-30 Torbjorn Granlund + + * demos/isprime.c: Include string.h for strcmp. + + * demos/factorize.c (main): Declare to int. + +2007-06-22 Torbjorn Granlund + + * mpn/x86_64/pentium4/lshift.asm: Minor tuning. + * mpn/x86_64/pentium4/rshift.asm: Likewise. + +2007-05-30 Torbjorn Granlund + + * mpn/powerpc64/mode64/aors_n.asm: Add _nc entry points. + +2007-05-22 Torbjorn Granlund + + * tests/memory.c: Cast calls to new mem* calls to avoid unaligned ops. + +2007-05-16 Torbjorn Granlund + + * tests/mpz/convert.c: Tweak operand sizes for best coverage. + + * tests/memory.c: Add red zones around allocations. + +2007-05-15 Torbjorn Granlund + + * mpn/ia64/mul_1.asm: Make mul_1c entry point actually work. + + * mpn/generic/set_str.c (mpn_dc_set_str): Avoid calling mpn_add_n when + ln == 0. + + * tests/mpz/convert.c (string_urandomb): New function. + (main): Use it by enabling ifdef'ed out code. + +2007-04-30 Torbjorn Granlund + + * mpn/x86_64/mul_basecase.asm: Complete rewrite. + + * mpn/x86_64/copyi.asm: Use short shift-by-one form. Misc cleanups. + * mpn/x86_64/copyi.asm: Likewise. + * mpn/x86_64/popham.asm: Likewise. + + * mpn/x86_64/aorsmul_1.asm: Cleanup formatting. + +2007-04-25 Torbjorn Granlund + + * mpz/divexact.c: Handle undefined case of |N| < |D| to avoid segfaults. + +2007-02-24 Torbjorn Granlund + + * doc/gmp.texi (Toom 3-Way Multiplication): Fix typo. + (mpz_scan0, mpz_scan1): Fix typos. + (Float Internals): Rewrite paragraph about struct types. + +2007-02-12 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/sqr_basecase.asm: Complete rewrite (except + diagonal code). + +2007-02-05 Torbjorn Granlund + + * mpn/generic/mul_fft.c (mpn_fft_fft): New name for mpn_fft_fft_sqr, + old mpn_fft_fft removed. + (mpn_mul_fft_internal): Call mpn_fft_fft separately for each operand. + (mpn_fft_add_modF): Rewrite to avoid random branches. + (mpn_fft_sub_modF): Likewise. + + * mpn/x86/pentium4/sse2/addmul_1.asm: Complete rewrite. + * mpn/x86/pentium4/sse2/mul_1.asm: Complete rewrite. + * mpn/x86/pentium4/sse2/mul_basecase.asm: Complete rewrite, based on + new addmul and mul code. + +2007-01-31 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_sb_get_str): Get loop count for frac + development right. + + * mpn/powerpc32/vmx/mod_34lsub1.asm: New file. + + * mpn/powerpc32/aors_n.asm: New file, complete rewrite. + * mpn/powerpc32/add_n.asm: Remove. + * mpn/powerpc32/sub_n.asm: Remove. + +2007-01-25 Torbjorn Granlund + + * mpn/x86_64/core2/aors_n.asm: Add _nc entry points, minor cleanups. + + * mpn/x86_64/core2/lshift.asm: Rewrite. + * mpn/x86_64/core2/rshift.asm: Rewrite. + + * mpn/x86_64/pentium4/lshift.asm: Swap some loop insns for a small + speedup. + * mpn/x86_64/pentium4/rshift.asm: New file, based on lshift.asm. + + * mpn/x86_64/pentium4/gmp-mparam.h: New file. + + * mpn/x86_64/pentium4/aors_n.asm: Complete rewrite of add/subtract + code. + * mpn/x86_64/pentium4/add_n.asm: Remove. + * mpn/x86_64/pentium4/sub_n.asm: Remove. + +2007-01-20 Torbjorn Granlund + + * mpn/x86_64/lshift.asm: Add special case for cnt=1. + +2007-01-19 Torbjorn Granlund + + * mpn/x86_64/aorsmul_1.asm: New file, written from scratch, finally at + 3.0 c/l on K8 (addmul_1 was 3.3; submul_1 was 3.5). + * mpn/x86_64/addmul_1.asm: Remove. + * mpn/x86_64/submul_1.asm: Remove. + +2006-12-29 Torbjorn Granlund + + * randmt.c (__gmp_randclear_mt): Initialize ALLOC field, like in + __gmp_randinit_mt_noseed. + (__gmp_randclear_mt, __gmp_randinit_mt_noseed): Make similar functions + look similar. + (__gmp_randclear_mt): Pass actually allocated size. + + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Add mul_toom22.c, + mul_toom32.c, mul_toom42.c. + + * configure.in: Recognize athlon64 and core2 as alternatives to x86_64. + Provide special settings for core2. + + * configure.in (gmp_mpn_functions): Add mul_toom22, mul_toom32, + mul_toom42. + + * mpn/generic/mul_toom22.c: New file. + * mpn/generic/mul.c: Use mpn_mul_toom22. Trim cutoff points between + the mpn_mul_toomN2 functions. Handle balanced operands at function + entry. + +2006-12-29 Marco Bodrato + + * mpn/generic/mul_n.c: Rewrite interpolation code. + +2006-12-28 Torbjorn Granlund + + * mpn/generic/mul_toom32.c: New file. + * mpn/generic/mul_toom42.c: New file. + * mpn/generic/mul.c: Use mpn_mul_toom32 and mpn_mul_toom42 for + unbalanced operands. + +2006-12-17 Torbjorn Granlund + + * mpn/x86_64/aorrlsh_n.asm: New file. + * mpn/x86_64/lshsub_n.asm: New file. + + * mpn/x86_64/core2/aors_n.asm: New file. + * mpn/x86_64/core2/lshift.asm: New file. + * mpn/x86_64/core2/rshift.asm: New file. + + * mpn/x86/p6/aors_n.asm: Replace K7 grabbing code with P6 specific + code. + + * mpn/x86/p6/lshsub_n.asm: New file. + +2006-11-23 Torbjorn Granlund + + * tune/speed.h (SPEED_ROUTINE_MPN_MUL_BASECASE): Allocate space for xp + locally, s->xp might be insufficient. + +2006-11-22 Torbjorn Granlund + + * randmt.c (__gmp_randinit_mt_noseed): Initialize ALLOC field of result + param. + +2006-11-06 Torbjorn Granlund + + * tune/set_strp.c: New file. + +2006-11-04 Torbjorn Granlund + + * extract-dbl.c: Rewrite to handle nails better, and for general + optimization. + + * mpz/bin_uiui.c: Simplify. + + * longlong.h (umul_ppmm) [mmix]: New. + + * tune/tuneup.c, tune/common.c, tune/speed.c, tune/speed.h, + tune/set_strb.c, tune/set_strs.c: Add tuning and speed measurements + of separate SET_STR_DC_THRESHOLD and SET_STR_PRECOMPUTE_THRESHOLD. + Add tuning and speed measurement of mpn_addsub_n. + +2006-10-31 Torbjorn Granlund + + * gmpxx.h: Remove ternary stuff, it is hardly an optimization and it + writes to destination before reading all source operands. + +2006-10-25 Torbjorn Granlund + + * mpn/generic/set_str.c: Complete rewrite. + * mpn/generic/get_str.c: Likewise. + + * gmp-impl.h (struct powers, powers_t): New types. + Restructure GET_STR_* and SET_STR_* thresholds. + +2006-09-21 Torbjorn Granlund + + * mpn/generic/rootrem.c: Remove some redundant casts. + +2006-07-12 Torbjorn Granlund + + * mpn/alpha/ev6/nails/addmul_2.asm: Make it run at claimed speed. + * mpn/alpha/ev6/nails/addmul_4.asm: Likewise. + + * mpf/get_str.c: Avoid copying result when not needed. Misc cleanups. + + * tests/amd64call.asm: Use jmp instead of jmpq to placate Solaris. + +2006-06-30 Torbjorn Granlund + + * configure.in (powerpc-*): Remove repeated path component. + +2006-06-15 Torbjorn Granlund + + * configure.in: (ia64-*-linux*): Don't use -O3. + +2006-06-14 Torbjorn Granlund + + * mpq/get_str.c: Fix upper base limit boundary in an ASSERT. + + * tests/refmpn.c (refmpn_sb_divrem_mn): Use ASSERT_CARRY for add-back. + +2006-05-31 Torbjorn Granlund + + * tests/mpz/t-set_d.c (check_data): Add more data points. + + * mpz/set_d.c: Handle negative return values from __gmp_extract_double. + +2006-05-17 Torbjorn Granlund + + * configure.in: Clear out gcc_cflags_cpu and gcc_cflags_arch for a fat + build. + +2006-05-16 Torbjorn Granlund + + * demos/primes.c (find_primes): Increase mpz_probab_prime_p cnt to 10. + + * mpn/generic/addsub_n.c: Fix criteria form when to call _nc functions. + +2006-05-12 Torbjorn Granlund + + * config.guess: Recognize more ppc processor types. + +2006-05-11 Torbjorn Granlund + + * tune/speed.c (usage): Update URL for gnuplot and quickplot. + +2006-05-10 Torbjorn Granlund + + * configure.in (powerpc-*-*): Pass -maltivec to assembler for + appropriate CPUs. + +2006-05-08 Torbjorn Granlund + + * mpn/powerpc32/aix.m4 (LEA): Remove [RW] attribute. + +2006-05-03 Torbjorn Granlund + + * mpn/powerpc64/vmx/popcount.asm: Conditionally zero extend n. + +2006-04-27 Torbjorn Granlund + + * mpz/divexact.c: Call mpz_tdiv_q for large operands. + + * configure.in (powerpc-*-darwin): Remove -fast, it affects PIC. + +2006-04-26 Torbjorn Granlund + + * config.guess: Try to recognize Ultrasparc T1 (as ultrasparct1). + * config.sub: Handle ultrasparct1. + +2006-04-25 Torbjorn Granlund + + * mpn/sparc64/gmp-mparam.h: Retune, without separation of GNUC and + non-GNUC data. + +2006-04-20 Torbjorn Granlund + + * tests/mpz/convert.c: Increase operands range. + +2006-04-19 Torbjorn Granlund + + * configure.in: Support powerpc eABI. + * mpn/powerpc32/eabi.m4: New file. + + * configure.in: Support powerpc *bsd. + * mpn/powerpc64/elf.m4: New name for mpn/powerpc64/linux64.m4. + * mpn/powerpc32/elf.m4: New name for mpn/powerpc32/linux.m4. + + * mpn/powerpc64/linux64.m4 (ASM_END): Quote TOC_ENTRY. + +2006-04-18 Torbjorn Granlund + + * configure.in (gmp_mpn_functions_optional): Add lshiftc. + (HAVE_NATIVE): Add lshiftc. + + * mpn/powerpc64/mode64/invert_limb.asm: Use LEA, not LDSYM. + * mpn/powerpc64/mode64/mode1o.asm: Likewise. + * mpn/powerpc64/mode64/dive_1.asm: Likewise. + + * mpn/powerpc64/linux64.m4 (TOC_ENTRY): Define to empty. + * mpn/powerpc64/aix.m4 (TOC_ENTRY): Likewise. + * mpn/powerpc32/aix.m4 (TOC_ENTRY): Likewise. + + * mpn/powerpc32/aix.m4 (EXTERN): New, copied form powerpc64/aix.m4. + * mpn/powerpc32/mode1o.asm: Use EXTERN. + * mpn/powerpc32/linux.m4 (EXTERN): Provide dummy definition. + * mpn/powerpc32/darwin.m4 (EXTERN): Likewise. + +2006-04-13 Torbjorn Granlund + + * mpn/generic/mul_fft.c: Use new thresholds mechanism if MUL_FFT_TABLE2 + is defined. + (mpn_lshiftc): New name for mpn_lshift_com (for consistency with some + stuff already in 4.1.4. + (mpn_fft_mul_2exp_modF): Reorganize initial operand reductions to avoid + divisions. + + * tests/devel/try.c (choice_array): Add mpn_addsub_n[c]. + +2006-04-11 Torbjorn Granlund + + * aclocal.m4: Regenerate with patched libtool. + + * mpn/asm-defs.m4 (ASM_END): Provide (empty) default. + +2006-04-08 Torbjorn Granlund + + * configure.in (gmp_mpn_functions_optional): Add addsub. + + * gmpxx.h: Remove missed MPFR references. + + * gmp-impl.h (LIMBS_PER_DOUBLE): Adjust formula to not be pessimistic. + + * gmp-impl.h (TMP_*, WANT_TMP_DEBUG): Don't expect marker argument; + define TMP_SALLOC and TMP_BALLOC. + + * mpn/minithres/gmp-mparam.h: New file. + + * tests/mpz/t-io_raw.c: Fix printf type/arg mismatches. + * tests/mpz/t-export.c: Likewise. + * tests/mpz/io.c: Likewise. + * tests/t-constants.c: Likewise. + + * mpn/ia64/popcount.asm: Append "cond.dptk" to conditional branches to + placate icc. + * mpn/ia64/hamdist.asm: Likewise. + * mpn/ia64/lorrshift.asm: Likewise. + * mpn/ia64/dive_1.asm: Likewise. + +2006-04-05 Torbjorn Granlund + + * tal-notreent.c (__gmp_tmp_mark): Add "struct" tag for tmp_marker. + (__gmp_tmp_free): Likewise. + + * mpn/generic/mul_fft.c: Optimize many scalar divisions and mod + operations into masks and shifts. + (mpn_fft_mul_modF_K): Fix a spurious ASSERT_NOCARRY. + +2006-03-26 Torbjorn Granlund + + * Version 4.2 released. + + * mpn/powerpc64/aix.m4 (LEA): Renamed from LDSYM. + * mpn/powerpc64/darwin.m4: Likewise. + * mpn/powerpc64/linux64.m4: Likewise. + * mpn/powerpc64/vmx/popcount.asm: Use LEA, not LDSYM. + +2006-03-23 Torbjorn Granlund + + * gmp-impl.h: (class gmp_allocated_string): Prefix strlen with std::. + + * gmpxx.h (__GMP_DEFINE_TERNARY_EXPR2): Remove for now. + (struct __gmp_ternary_addmul2): Likewise. + (struct __gmp_ternary_submul2): Likewise. + + * gmpxx.h: #include . + (struct __gmp_alloc_cstring): Prefix strlen with std::. + + * mpn/x86/pentium/com_n.asm: Add TEXT and ALIGN. + * mpn/x86/pentium/copyi.asm: Likewise. + * mpn/x86/pentium/copyd.asm: Likewise. + +2006-03-22 Torbjorn Granlund + + * gmp-h.in: Add a "using std::FILE" for C++. + (_GMP_H_HAVE_FILE): Check also _ISO_STDIO_ISO_H. + + * gmpxx.h: Remove mpfr code. + * tests/cxx: Likewise. + + * gmp-impl.h (FORCE_DOUBLE): Rename a tempvar to avoid a clash with + GNU/Linux public include file. + + * configure.in (powerpc64, darwin): New optional, gcc_cflags_subtype. + Grab powerpc32/darwin.m4 for ABI=mode32. + + * configure.in: Use host_cpu whenever just the cpu type is needed. + +2006-03-08 Torbjorn Granlund + + * mpz/get_si.c: Fix a typo. + + * tests/mpq/t-get_d.c (check_random): Improve random generation for + nails. + +2006-02-28 Torbjorn Granlund + + * tests/mpq/t-get_d.c (check_random): New function. + (main): Call check_random. + + * mpq/set_d.c: Make choices based on LIMBS_PER_DOUBLE, not + BITS_PER_MP_LIMB. Make it work for LIMBS_PER_DOUBLE == 4. + Use MPZ_REALLOC. + + * mpz/set_d.c: Make it work for LIMBS_PER_DOUBLE == 4. + + * extract-dbl.c: Make it work for LIMBS_PER_DOUBLE > 3. + +2006-02-27 Torbjorn Granlund + + * mpz/cmp_d.c: Declare `i'. + * mpz/cmpabs_d.c: Likewise. + +2006-02-23 Torbjorn Granlund + + * mpn/powerpc32/vmx/copyd.asm: Set right VRSAVE bits. + * mpn/powerpc32/vmx/copyi.asm: Likewise. + +2006-02-22 Torbjorn Granlund + + * mpn/powerpc32/vmx/logops_n.asm: New file. + + * mpn/powerpc32/diveby3.asm: Rewrite. + +2006-02-21 Torbjorn Granlund + + * mpn/powerpc32/vmx/copyi.asm: New file. + * mpn/powerpc32/vmx/copyd.asm: New file. + +2006-02-17 Torbjorn Granlund + + * mpn/alpha/ev6/nails/aors_n.asm (CYSH): Import proper setting from + deleted mpn_sub_n. + +2006-02-16 Torbjorn Granlund + + * mpn/alpha/ev6/addmul_1.asm: Correct slotting comments. + +2006-02-15 Torbjorn Granlund + + * tests/devel/anymul_1.c: Copy error reporting code from addmul_N.c. + + * tests/devel/addmul_N.c: New file. + * tests/devel/mul_N.c: New file. + + * mpn/alpha/default.m4 (PROLOGUE_cpu): Align functions at 16-byte + boundary. + + * mpn/alpha/ev6/nails/aors_n.asm: New file. + * mpn/alpha/ev6/nails/add_n.asm: Remove. + * mpn/alpha/ev6/nails/sub_n.asm: Remove. + + * mpn/alpha/ev6/nails/addmul_1.asm: Rewrite. + * mpn/alpha/ev6/nails/submul_1.asm: Likewise. + * mpn/alpha/ev6/nails/mul_1.asm: Likewise. + + * mpn/alpha/ev6/nails/addmul_2.asm: Use L() for labels. + * mpn/alpha/ev6/nails/addmul_3.asm: Use L() for labels. + * mpn/alpha/ev6/nails/addmul_4.asm: Use L() for labels. + +2006-02-13 Torbjorn Granlund + + * mpn/powerpc32/diveby3.asm: Trivially reorder loop insns to save + 1 c/l. + + * mpn/x86_64/dive_1.asm: Use movabsq to support large model non-PIC. + + * mpn/x86_64/rsh1add_n.asm: Replace high register with rbx. + * mpn/x86_64/rsh1sub_n.asm: Likewise. + +2006-02-10 Torbjorn Granlund + + * mpn/powerpc64/sqr_diagonal.asm: Software pipeline. + + * mpn/powerpc64/vmx/popcount.asm: Add prefetching. + +2006-02-07 Torbjorn Granlund + + * mpn/powerpc64/mode64/diveby3.asm: Rewrite. + +2006-02-04 Torbjorn Granlund + + * mpn/powerpc64/vmx/popcount.asm: Remove mpn_hamdist partial code. + Move compare for huge n so that it is always executed. + +2006-02-03 Torbjorn Granlund + + * mpn/powerpc32/linux.m4 (LEA): Add support for PIC. + + * configure.in (powerpc): New optional, gcc_cflags_subtype. + + * mpn/x86_64/pentium4/add_n.asm: New file. + * mpn/x86_64/pentium4/sub_n.asm: New file. + * mpn/x86_64/pentium4/lshift.asm: New file. + + * mpn/powerpc64/linux64.m4 (PROLOGUE_cpu): Align function start to + 16-multiple. + * mpn/powerpc64/aix.m4: Likewise. + * mpn/powerpc64/darwin.m4: Likewise. + + * mpn/powerpc64/copyi.asm: Align loop to 16-multiple. + * mpn/powerpc64/copyd.asm: Likewise + + * configure.in (powerpc): Add vmx to relevant paths. + + * mpn/powerpc64/linux64.m4 (DEF_OBJECT): Accept 2nd argument, for + alignment. + * mpn/powerpc64/aix.m4: Likewise. + * mpn/powerpc64/darwin.m4: Likewise. + + * mpn/powerpc32/linux.m4 (DEF_OBJECT, END_OBJECT): New macros, + inherited from powerpc64 versions. + * mpn/powerpc32/aix.m4: Likewise. + * mpn/powerpc32/darwin.m4: Likewise. + + * mpn/powerpc64/vmx/popcount.asm: New file, for ppc32 and ppc64. + * mpn/powerpc32/vmx/popcount.asm: New file, grabbing above file. + +2006-01-22 Torbjorn Granlund + + * configure.in: Generalize OS-dependent patterns for powerpcs. + +2006-01-20 Torbjorn Granlund + + * mpn/x86_64/popham.asm: Optimize. + + * config.guess: Recognize power4 and up under linux-gnu. + * config.sub: Generalize power recognition code. + * acinclude.m4 (POWERPC64_PATTERN): Add 64-bit powerpc processors. + * configure.in: Recognize powerpc processors masquerading as power + processors. + +2006-01-19 Torbjorn Granlund + + * mpn/x86_64/logops_n.asm: Rewrite for more stable speed and smaller + code. + * mpn/x86_64/com_n.asm: Likewise. + +2006-01-18 Torbjorn Granlund + + * mpn/x86_64/addlsh1_n.asm: Rewrite to use indexed addressing. + * mpn/x86_64/sublsh1_n.asm: Likewise. + +2006-01-17 Torbjorn Granlund + + * mpn/generic/diveby3.c: Use GMP standard parameter names. Nailify + alternative code. Use restrict for params. + + * configure.in: Recognize andn_n as not needing nailification. + + * tests/mpq/t-equal.c (check_various): Disable a test that gives common + factors for GMP_NUMB_BITS == 62. + +2006-01-16 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_sb_get_str): Fix digit count computation, + was inaccurate for nails. + +2006-01-15 Torbjorn Granlund + + * mpn/x86_64/mode1o.asm: Remove unneeded carry register zeroing. + +2006-01-08 Torbjorn Granlund + + * mpn/alpha/ev6/sqr_diagonal.asm: New file. + +2006-01-06 Torbjorn Granlund + + * mpn/powerpc64/mode64/mod_34lsub1.asm: Tune to 1.5 c/l. + + * mpn/generic/mullow_n.c (MUL_BASECASE_ALLOC): New #define. + (mpn_mullow_n): Use it. + + * mpn/powerpc64/mode64/dive_1.asm: Use EXTERN. + * mpn/powerpc64/mode64/mode1o.asm: Likewise. + + * mpn/powerpc64/aix.m4 (EXTERN): Define to import symbol. + (LDSYM): Remove [RW] attribute. + * mpn/powerpc64/linux64.m4 (EXTERN): Dummy definition. + * mpn/powerpc64/darwin.m4 (EXTERN): Likewise. + +2006-01-05 Torbjorn Granlund + + * mpn/powerpc64/mode64/mode1o.asm: New file. + + * mpn/powerpc64/mode64/dive_1.asm: Use L() for labels. Invoke ASM_END. + + * mpn/powerpc64/mode64/invert_limb.asm: Invoke ASM_END. + + * mpn/powerpc64/linux64.m4: Move toc entry generation from direct at + DEF_OBJECT to delayed via LDSYM, define ASM_END to output it. + * mpn/powerpc64/aix.m4: Likewise. + * mpn/powerpc64/darwin.m4: Define a dummy ASM_END. + + * mpn/powerpc64/mode64/addmul_1.asm: Add POWER5 timings. + * mpn/powerpc64/mode64/mul_1.asm: Likewise. + + * mpn/powerpc64/mode64/submul_1.asm: Tweak to save 1.5 c/l for POWER5. + +2006-01-04 Torbjorn Granlund + + * mpn/powerpc64/mode64/dive_1.asm: New file. + + * mpn/powerpc64/mode64/invert_limb.asm: Add missing ASM_START. + + * mpn/powerpc64/mode64/addmul_1.asm: Fix a comment typo. + + * mpn/x86_64/diveby3.asm: Rewrite. + +2006-01-03 Torbjorn Granlund + + * configure.in: Update bugs reporting address. + + * mpn/powerpc64/mode64/diveby3.asm: Trim a cycle off of POWER4 timing. + Misc cleanup. + +2006-01-02 Torbjorn Granlund + + * mpn/powerpc64/linux64.m4 (CALL): New macro. + * mpn/powerpc64/aix.m4: Likewise. + * mpn/powerpc64/darwin.m4: Likewise, also define macro "DARWIN". + +2005-12-28 Torbjorn Granlund + + * mpn/powerpc64/mode64/mod_34lsub1.asm: New file. + +2005-12-26 Torbjorn Granlund + + * mpn/x86_64/mod_34lsub1.asm: New file. + +2005-12-20 Torbjorn Granlund + + * mpn/x86_64/submul_1.asm: Save a push/pop by not using register r12. + Use addq instead of leaq for pointer updates; schedule them. (These + changes shaves one cycle of overhead and 0.25 c/l.) + +2005-12-18 Torbjorn Granlund + + * mpf/ui_div.c: Implement workaround for GCC bug triggered on alpha. + * mpf/set_q.c: Likewise. + +2005-12-16 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Remove statement with no effect. + Rename dead variable to `dummy'. + +2005-12-15 Torbjorn Granlund + + * demos/pexpr.c (setup_error_handler): Add a missing ";". + +2005-11-27 Torbjorn Granlund + + * mpn/generic/mul.c: Crudely call mpn_mul_fft_full before checking + for unbalanced operands. + + * mpn/generic/mul_fft.c: Remove many scalar divisions. + (mpn_mul_fft_lcm): Simplify. + (mpn_mul_fft_decompose): Rewrite to handle arbitrarily unbalanced + operands. + +2005-11-22 Torbjorn Granlund + + * configure.in: Properly recognize all 32-bit Solaris releases. + +2005-11-10 Torbjorn Granlund + + * mpn/generic/mul_fft.c: Inline mpn_fft_mul_2exp_modF, + mpn_fft_add_modF and mpn_fft_normalize. + +2005-11-02 Torbjorn Granlund + + * tests/mpz/reuse.c: Increase operand size, decrease # of reps. + + * mpz/rootrem.c: Adapt to new mpn_rootrem. + * mpz/root.c: Likewise. + + * tests/mpz/reuse.c: Test mpz_rootrem. + + With Paul Zimmermann: + * mpn/generic/rootrem.c: Complete rewrite. + +2005-10-31 Torbjorn Granlund + + * mpz/pprime_p.c (mpz_probab_prime_p): Considerably limit trial + dividing. + + * mpz/perfpow.c (mpz_perfect_power_p): Use mpz_divisible_ui_p instead + of mpz_tdiv_ui. + + * mpz/divegcd.c: Correct probability number for GCD == 1. + + * mpn/x86_64/mul_basecase.asm: Remove an obsolete comment. + + * mpn/x86: Add cycle counts for array of x86 processors. + + * mpn/x86/k7/mod_34lsub1.asm: Remove spurious mentions of ebp. + + * mpn/powerpc32: Add POWER5 timings. + + * mpn/powerpc32/README: Describe global reference variations. + + * mpn/ia64/divrem_2.asm: Add some comments. + + * mpn/ia64/divrem_1.asm: Reformat. + + * mpn/ia64/addmul_2.asm: Correct a comment on slotting. + * mpn/ia64/logops_n.asm: Likewise. + + * mpn/ia64/addmul_1.asm: Remove a redundant preg mutex decl. + + * mpn/generic/dive_1.c: Whitespace cleanup. + + * mpn/alpha/ev6/nails/addmul_1.asm: Correct comments on slotting. + * mpn/alpha/ev6/nails/addmul_2.asm: Likewise. + * mpn/alpha/ev6/nails/addmul_4.asm: Likewise. + + * mpf/out_str.c: List some allocation improvement ideas. + + * doc/gmp.texi: Update many URLs and email addresses. + + * gmp-h.in (_GMP_H_HAVE_FILE): Check also _STDIO_H_INCLUDED. + +2005-10-26 Torbjorn Granlund + + * tune/tuneup.c (tune_mullow): Update param.max_size for each threshold + measurement. + + * configure.in (POWERPC64_PATTERN/*-*-darwin*): Set + SPEED_CYCLECOUNTER_OBJ_mode64 and cyclecounter_size_mode64. + (POWERPC64_PATTERN/*-*-linux*): Likewise. + +2005-10-03 Torbjorn Granlund + + * demos/factorize.c (factor_using_division_2kp): Honor verbose flag. + (factor_using_pollard_rho): Divide out new factor before it's + clobbered. Don't stop factoring after a composite factor was found. + +2005-09-17 Torbjorn Granlund + + * demos/pexpr.c (fns): Add factorial keywords. + +2005-08-16 Torbjorn Granlund + + * tune/Makefile.am (EXTRA_DIST): Change "amd64" => "x86_64". + * mpn/Makefile.am (TARG_DIST): Change "amd64" => "x86_64". + +2005-08-15 Torbjorn Granlund + + * configure.in: Change "amd64" => "x86_64". + +2005-06-13 Torbjorn Granlund + + * mpn/generic/pre_mod_1.c: Canonicalize variable names. + + * mpn/generic/divrem.c: Rate qxn test as UNLIKELY. + + * mpn/generic/gcdext.c (sanity_check_row): Invoke TMP_MARK. + + * tune/tuneup.c (tune_mullow): Fix all max_size fields. + + * gmp-impl.h (SQR_TOOM3_THRESHOLD_LIMIT): New #define. + * tune/tuneup.c (tune_sqr): Use SQR_TOOM3_THRESHOLD_LIMIT. + (sqr_toom3_threshold): Initialize from SQR_TOOM3_THRESHOLD_LIMIT. + + * mpn/generic/mul_n.c (mpn_sqr_n): Use SQR_TOOM3_THRESHOLD_LIMIT. + + * gmp-impl.h (mpn_nand_n, mpn_iorn_n, mpn_nior_n, mpn_xnor_n): + Handle nails. + +2005-06-13 Niels Möller + + * mpn/generic/gcdext.c (gcdext_schoenhage): Check for the + (unlikely) case that one of the hgcd/euclid steps results in two + remainders of one limb each. Then use gcdext_1. + +2005-06-12 Torbjorn Granlund + + * mpn/alpha/ev6/sub_n.asm: Analogous changes as to add_n.asm last. + +2005-06-11 Torbjorn Granlund + + * mpn/alpha/ev6/add_n.asm: Rewrite inner loop to load later. + Add mpn_add_nc entry. + + * mpn/alpha/ev6/addmul_1.asm: Remove redundant initial loads. + +2005-06-09 Torbjorn Granlund + + * mpn/ia64/dive_1.asm: Fix issues with HP-UX. + +2005-06-08 Torbjorn Granlund + + * mpn/ia64/diveby3.asm: Update TODO list. + + * mpn/ia64/mode1o.asm: Fix comment typos. + + * mpn/ia64/dive_1.asm: New file. + +2005-06-07 Torbjorn Granlund + + * mpn/ia64/mode1o.asm: Add prefetching. + + * mpn/generic/dive_1.c: Use variable h for upper umul_ppmm result. + +2005-06-06 Torbjorn Granlund + + * mpn/ia64/hamdist.asm: Complete rewrite. + * mpn/ia64/popcount.asm: Rewrite to use multi-pronged feed-in. + + * mpn/ia64/aors_n.asm: Rewrite feed-in code. + * mpn/ia64/rsh1aors_n.asm: Likewise. + * mpn/ia64/aorslsh1_n.asm: Likewise. + * mpn/ia64/lorrshift.asm: Likewise. + +2005-06-04 Torbjorn Granlund + + * tests/devel/try.c (choice_array): Exclude mpn_preinv_mod_1 unless + USE_PREINV_MOD_1. + (choice_array): Exclude mpn_sqr_basecase if SQR_KARATSUBA_THRESHOLD + is zero. + +2005-06-03 Torbjorn Granlund + + * mpn/alpha/ev6/addmul_1.asm: Prefix all labels with "$". + * mpn/alpha/ev6/mul_1.asm: Likewise. + +2005-06-02 Torbjorn Granlund + + * tests/refmpn.c (refmpn_divmod_1c_workaround): Implement workaround + to gcc 3.4.x bug triggered on powerpc64 with 32-bit ABI. + +2005-06-01 Torbjorn Granlund + + * tests/devel/try.c (main): Fix a typo. + +2005-05-31 Torbjorn Granlund + + * mpn/alpha/ev6/addmul_1.asm: Rewrite for L1 cache, add prefetch. + +2005-05-30 Torbjorn Granlund + + * tests/misc.c (tests_rand_start): Mask random seed to 32 bits. + +2005-05-29 Torbjorn Granlund + + * mpn/powerpc64/mode32/mul_1.asm: Handle BROKEN_LONGLONG_PARAM. + * mpn/powerpc64/mode32/addmul_1.asm: Likewise. + * mpn/powerpc64/mode32/submul_1.asm: Likewise. + + * mpn/powerpc32/mode1o.asm: Rewrite to actually work. + + * mpn/powerpc32/aix.m4 (LEA): New macro. + (ASM_END): New macro. + + * mpn/powerpc32/linux.m4: New file. + * mpn/powerpc32/darwin.m4: New file. + * configure.in: Use linux.m4 and darwin.m4. + (powerpc64-linux-gnu): Add support for mode32. + +2005-05-25 Torbjorn Granlund + + * mpn/generic/mullow_n.c: Remove FIXME mentioning fixed flaw. + + * tests/mpz/t-cmp_d.c (check_one): Fix printf fmt string typo. + + * demos/isprime.c: #include stdlib.h. + * tests/rand/t-urbui.c: Likewise. + * tests/rand/t-urmui.c: Likewise. + + * tests/mpz/t-popcount.c (check_random): Remove spurious printf arg. + + * mpn/ia64/lorrshift.asm: Cleanup code layout. + * mpn/ia64/popcount.asm: Likewise. + +2005-05-24 Torbjorn Granlund + + * tests/devel/try.c (param_init) [TYPE_GET_STR]: Set retval field. + (compare): Handle SIZE_GET_STR as SIZE_RETVAL. + + * tests/refmpn.c (refmpn_get_str): Rewrite to make it work. + +2005-05-23 Torbjorn Granlund + + * mpn/amd64/add_n.asm: Add mpn_add_nc entry point. + * mpn/amd64/sub_n.asm: Add mpn_sub_nc entry point. + + * longlong.h (many places): Remove lvalue casts. + + * gmp-impl.h (MPF_SIGNIFICANT_DIGITS): Cast prec to avoid overflow + for > 4G digits. + + * mpn/alpha/ev6/add_n.asm: Prefetch using ldl. + * mpn/alpha/ev6/sub_n.asm: Likewise. + + * mpn/alpha/ev6/slot.pl (optable): Recognize negq and ldl. + + * mpn/ia64/aors_n.asm: Prefetch using lfetch. + * mpn/ia64/lorrshift.asm: Likewise. + * mpn/ia64/popcount.asm: Likewise. + * mpn/ia64/diveby3.asm: Likewise. + +2005-05-22 Torbjorn Granlund + + * mpn/alpha/ev67/popcount.asm: Prefetch. + * mpn/alpha/ev67/hamdist.asm: Prefetch. + + * longlong.h (add_ssaaaa) [x86]: Remove lvalue casts. + (sub_ddmmss) [x86]: Likewise. + + * tests/devel/try.c (param_init) [TYPE_MPZ_JACOBI]: Add DATA_SRC1_ODD. + (param_init) [TYPE_MPZ_KRONECKER]: Clear inherited DATA_SRC1_ODD. + (param_init) [TYPE_DIVEXACT_1]: Use symbolic name DIVISOR_LIMB. + +2005-05-21 Torbjorn Granlund + + * tests/devel/try.c (param_init) [TYPE_MPZ_JACOBI]: Initialize divisor + field according to UDIV_NEEDS_NORMALIZATION. + + * mpz/mul_i.h: Remove left-over TMP_XXXX marker arguments. + +2005-05-20 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/addmul_1.asm (mpn_addmul_1c): Put carry in + proper register. + + * mpn/generic/sqr_basecase.c (mpn_sqr_basecase, addmul_2 version): + Avoid accesses out-of-bound in MPN_SQR_DIAGONAL applicate code. + +2005-05-19 Torbjorn Granlund + + * mpn/alpha/diveby3.asm: Make it actually work. + + * gmp-impl.h (MULLOW_BASECASE_THRESHOLD_LIMIT): New #define. + * mpn/generic/mullow_n.c: Use fixed stack allocation for the smallest + operands; use TMP_S* allocation for medium operands. + + * gmp-impl.h: Remove nested TUNE_PROGRAM_BUILD test. + +2005-05-18 Torbjorn Granlund + + * mpn/generic/mul_n.c: Make squaring and multiplication code more + similar. Use TMP_S* functions. + + * gmp-impl.h (TMP_DECL, TMP_MARK, TMP_FREE): Get rid of argument. + (TMP_SALLOC): New macro for "small" allocations. + (TMP_BALLOC): New macro for "big" allocations. + (TMP_SDECL, TMP_SMARK, TMP_SFREE): New macros for functions that use + just TMP_SALLOC. + (WANT_TMP_ALLOCA): Make default functions choose alloca or reentrant + functions, depending on size. + + * *.c: Remove TMP_XXXX marker arguments. + + * acinclude.m4 (WANT_TMP): Want tal-reent.lo also for alloca case. + +2005-05-16 Torbjorn Granlund + + * mpn/ia64/gmp-mparam.h: Further extend FFT tables. + +2005-05-15 Torbjorn Granlund + + * gmp-impl.h (udiv_qrnnd_preinv2): Pull an add into add_ssaaaa. + (udiv_qrnnd_preinv2gen): Likewise. + +2005-05-14 Torbjorn Granlund + + * longlong.h (add_ssaaaa) [x86_64]: Restrict allowed immediate + operands. + * (sub_ddmmss) [x86_64]: Likewise. + +2005-05-02 Torbjorn Granlund + + * acinclude.m4 (GMP_HPC_HPPA_2_0): Make gmp_tmp_v1 sed pattern handle + version numbers like B.11.X.32509-32512.GP. + + * mpn/m68k/aors_n.asm: Correct MULFUNC_PROLOGUE. + + * mpn/powerpc64/mode64/aors_n.asm: Add a MULFUNC_PROLOGUE. + + * mpf/inp_str.c: Use plain int for mpf_set_str return value (works + around gcc 4 bug). + + * acinclude.m4 (GMP_ASM_POWERPC_PIC_ALWAYS): Handle darwin's assembly + syntax. + (long long reliability test 1): New GMP_PROG_CC_WORKS_PART test. + (long long reliability test 2): New GMP_PROG_CC_WORKS_PART test. + + * configure.in: Add mode64 support for darwin. Use darwin.m4. + Add cflags_opt flags for mode32 darwin. + + * mpn/powerpc64: Use L() for all asm files. + + * mpn/asm-defs.m4 (PIC_ALWAYS): Define PIC just iff PIC_ALWAYS = "yes". + + * mpn/powerpc64/darwin.m4: New file. + + * mpn/powerpc64/linux64.m4: Remove TOCREF, add LDSYM. + Rework DEF_OBJECT to need just one argument. + * mpn/powerpc64/aix.m4: Likewise. + + * mpn/powerpc64/mode64/invert_limb.asm: Load approx_tab address with + LDSYM. Optimize somewhat. Remove 2nd DEF_OBJECT operand. + +2005-05-01 Torbjorn Granlund + + * mpn/generic/popham.c: Compute final summation differently for 64-bit. + + * tests/mpz/t-popcount.c (check_random): New function. + (main): Call it. + +2005-04-28 Torbjorn Granlund + + * mpn/amd64/add_n.asm: Use r9 instead of rbx to save push/pop. + * mpn/amd64/sub_n.asm: Likewise. + +2005-04-09 Torbjorn Granlund + + * mpn/powerpc64/copyi.asm: If HAVE_ABI_mode32, ignore upper 32 bits of + mp_size_t argument. + * mpn/powerpc64/copyd.asm: Likewise. + * mpn/powerpc64/sqr_diagonal.asm: Likewise. + * mpn/powerpc64/lshift.asm: Likewise. + * mpn/powerpc64/rshift.asm: Likewise. + * mpn/powerpc64/logops_n.asm: Likewise. + * mpn/powerpc64/com_n.asm: Likewise. + +2005-04-08 Torbjorn Granlund + + * mpn/generic/rootrem.c: Allocate PP_ALLOC limbs also for qp. + +2005-04-07 Torbjorn Granlund + + * mpn/powerpc32/add_n.asm: Add nc entry point. + * mpn/powerpc32/sub_n.asm: Likewise. + + * mpn/amd64/*.asm: Add Prescott/Nocona cycle/limb numbers. + + * mpn/alpha/add_n.asm: Add correct cycle/limb numbers. + * mpn/alpha/sub_n.asm: Likewise. + * mpn/alpha/ev5/add_n.asm: Likewise. + * mpn/alpha/ev5/sub_n.asm: Likewise. + +2005-03-31 Torbjorn Granlund + + * mpn/x86/k7/gmp-mparam.h: Fix typo in last change. + +2005-03-19 Torbjorn Granlund + + * mpn/amd64/gmp-mparam.h: Update. + + * mpn/alpha/gmp-mparam.h: Update. + * mpn/alpha/ev5/gmp-mparam.h: Update. + * mpn/alpha/ev6/gmp-mparam.h: Update. + + * mpn/ia64/gmp-mparam.h: Update. + + * mpn/x86/p6/mmx/gmp-mparam.h: Update. + * mpn/x86/pentium4/sse2/gmp-mparam.h: Update. + * mpn/x86/k7/gmp-mparam.h: Update. + + * tests/mpz/t-gcd.c (main): Honor command line reps argument. + + * tune/speed.h (SPEED_ROUTINE_MPN_GCD_CALL): Simplify and correct code + for generating test operands. + +2005-03-17 Niels Möller + + * mpn/generic/hgcd.c (qstack_adjust): New argument d, saying how much + to adjust the top quotient. + (hgcd_adjust): The quotient can be off by either 1 or 2. + +2005-03-16 Torbjorn Granlund + + * tests/mpz/t-gcd.c (MAX_SCHOENHAGE_THRESHOLD): Set to largest of + gcd,gcdext thresholds. + +2005-03-15 Niels Möller + + * mpn/generic/gcdext.c (gcdext_schoenhage): When calling gcdext_lehmer, + reuse all temporary limb storage, including the storage used for the + qstack. + +2005-03-09 Torbjorn Granlund + + * mpn/amd64/logops_n.asm: Add MULFUNC_PROLOGUE. + +2005-03-05 Torbjorn Granlund + + * mpn/amd64/gmp-mparam.h: Extend MUL_FFT_TABLE and SQR_FFT_TABLE. + * mpn/ia64/gmp-mparam.h: Likewise. + +2005-02-17 Torbjorn Granlund + + * mpn/ia64/divrem_1.asm: Add preinv entry point. + +2005-01-13 Torbjorn Granlund + + * gmp-impl.h (MPN_SIZEINBASE): Count bits in type size_t. + (MPN_SIZEINBASE_16): Likewise. + +2004-12-17 Torbjorn Granlund + + * tune/speed.c (run_gnuplot): Use lines, not linespoints. + Output a reset gnuplot command initially. + +2004-12-04 Torbjorn Granlund + + * mpn/generic/random2.c (gmp_rrandomb): Rework again. + * mpz/rrandomb.c (gmp_rrandomb): Likewise. + + * mpn/amd64/redc_1.asm: Call via PLT when PIC. + +2004-11-29 Torbjorn Granlund + + * mpn/amd64/divrem_1.asm: Add preinv entry point. + * mpn/amd64/gmp-mparam.h: Set USE_PREINV_DIVREM_1 to 1. + +2004-11-24 Torbjorn Granlund + + * mpn/alpha/diveby3.asm: Use correct prefetch instruction. + +2004-11-19 Torbjorn Granlund + + * mpn/alpha/diveby3.asm: Add ",gp" glue in PROLOGUE. + Add r31 dummy operand to `br' instruction. + +2004-11-17 Torbjorn Granlund + + * mpn/powerpc64/mode64/addmul_1.asm: Rewrite. + * mpn/powerpc64/mode64/mul_1.asm: Rewrite. + + * configure.in: Invoke AC_C_RESTRICT. + +2004-11-16 Torbjorn Granlund + + * mpn/alpha/diveby3.asm: New file. + +2004-11-13 Torbjorn Granlund + + * mpn/amd64/popham.asm: New file. + +2004-11-12 Torbjorn Granlund + + * mpn/amd64/add_n.asm: Correct cycle count. + * mpn/amd64/sub_n.asm: Likewise. + + * mpn/amd64/dive_1.asm: Speed divisors with many factors of 2. + +2004-11-11 Torbjorn Granlund + + * mpn/amd64/dive_1.asm: New file. + +2004-11-10 Torbjorn Granlund + + * mpn/generic/popham.c: Add comment. + +2004-11-09 Torbjorn Granlund + + * mpn/amd64/com_n.asm: New file. + + * mpn/amd64/logops_n.asm: New file. + +2004-11-08 Torbjorn Granlund + + * mpn/powerpc64/com_n.asm: New file. + +2004-11-05 Torbjorn Granlund + + * mpn/amd64/diveby3.asm: New file. + + * config.guess: Strip any PPC string in /proc/cpuinfo. + Recognize 970 in that code. + +2004-11-01 Torbjorn Granlund + + * mpn/amd64/mul_basecase.asm: New file. + + * mpn/amd64/redc_1.asm: New file. + +2004-10-25 Torbjorn Granlund + + * mpn/powerpc64/mode64/addlsh1_n.asm: Correct cycle counts. + + * mpn/powerpc64/README: Update POWER5/PPC970 pipeline information. + + * mpn/generic/mul_basecase.c (MAX_LEFT): Add comment. + + * doc/gmp.texi: Consistently use "x86" denotation. + (Assembler SIMD Instructions): Mention SSE2 usage. + + * demos/pexpr.c (main): Handle "negative" base in mpz_sizeinbase call. + +2004-10-18 Torbjorn Granlund + + * mpn/powerpc64/mode64/submul_1.asm: Shave 2 cycles/limb with new carry + inversion trick. + +2004-10-16 Torbjorn Granlund + + * configure.in: Support icc under x86. + (ia64-*-linux*): Pass -no-gcc to icc. + +2004-10-15 Torbjorn Granlund + + * longlong.h (ia64 umul_ppmm): Add version for icc. + + * configure.in: Support icc under ia64-*-linux*. + + * acinclude.m4: New "compiler works" test for icc 8.1 bug. + (GMP_PROG_CC_IS_GNU): Don't let Intel's icc fool us it is GCC. + +2004-10-14 Torbjorn Granlund + + * mpn/generic/gcdext.c: Add a few missing TMP_MARK. + +2004-10-14 Torbjorn Granlund + + * acinclude.m4 (GMP_ASM_W32): Try also "data4". + + * mpn/ia64/logops_n.asm: Don't use naked "br", rejected by Intel + assembler. + * mpn/ia64/aors_n.asm: Likewise. + + * mpn/ia64/divrem_2.asm: Add ".prologue". + + * mpn/ia64/hamdist.asm: Put alloc first in bundle, enforced by the + Intel assembler. + + * longlong.h: Exclude masquerading __INTEL_COMPILER from ia64 asm. + * gmp-impl.h: Likewise. + +2004-10-12 Torbjorn Granlund + + * mpn/ia64/mul_2.asm: Rewrite function entry code, write new code for + n=2. + * mpn/ia64/addmul_2.asm: Likewise. + + * tests/devel/try.c: Handle mpn_mul_2 like mpn_addmul_2. + + * tune/speed.c (routine): Make R parameter optional for mpn_mul_2. + +2004-10-11 Torbjorn Granlund + + * mpn/sparc64/addmul_1.asm: Update a comment. + + * tests/devel/aors_n.c: #include tests.h. + * tests/devel/anymul_1.c: Likewise. + * tests/devel/shift.c: Likewise. + * tests/devel/copy.c: Likewise. + + * tests/devel/aors_n.c: Handle also mpn_addlsh1_n, mpn_sublsh1_n, + mpn_rsh1add_n, and mpn_rsh1sub_n. + + * mpn/ia64/submul_1.asm: Add TODO item. + + * mpn/ia64/aors_n.asm: Rewrite function entry code (again). + * mpn/ia64/aorslsh1_n.asm: Likewise. + * mpn/ia64/logops_n.asm: Likewise. + + * mpn/ia64/rsh1aors_n.asm: Tune function entry and feed-in code. + * mpn/ia64/lorrshift.asm: Likewise. Remove several spurious loads. + + * tests/devel/Makefile.am (EXTRA_PROGRAMS): Updates for yesterday's + file removals and additions. + +2004-10-10 Torbjorn Granlund + + * mpn/ia64/copyi.asm: Tune function entry code. + * mpn/ia64/copyd.asm: Likewise. + + * mpn/ia64/logops_n.asm: Tune function entry and feed-in code for speed + and size. + * mpn/ia64/aors_n.asm: Likewise. + + * mpn/powerpc64/logops_n.asm: Correct cycles counts. + * mpn/powerpc64/mode64/aors_n.asm: Likewise. + + * tests/devel/copy.c: Handle both MPN_COPY_INCR and MPN_COPY_DECR. + + * tests/devel/logops_n.c: New file, handle all logical operations. + + * tests/devel/anymul_1.c: New file, handle mpn_mul_1, mpn_addmul_1, and + mpn_submul_1 + * tests/devel/mul_1.c: Remove. + * tests/devel/addmul_1.c: Remove. + * tests/devel/submul_1.c: Remove. + + * tests/devel/shift.c: New file, handle mpn_lshift and mpn_rshift. + * tests/devel/lshift.c: Remove. + * tests/devel/rshift.c: Remove. + + * tests/devel/aors_n.c: New file, handle mpn_add_n and mpn_sub_n. + * tests/devel/add_n.c: Remove. + * tests/devel/sub_n.c: Remove. + +2004-10-09 Torbjorn Granlund + + * mpn/powerpc64/linux64.m4: Define DEF_OBJECT, END_OBJECT, and TOCREF. + * mpn/powerpc64/aix.m4: Likewise. + * mpn/powerpc64/mode64/invert_limb.asm: Use DEF_OBJECT, END_OBJECT, and + TOCREF for approx_tab. + + * mpn/amd64/mul_1.asm: Add mpn_mul_1c entry point. + +2004-10-08 Torbjorn Granlund + + * mpn/powerpc64/copyi.asm: New file. + * mpn/powerpc64/copyd.asm: New file. + * gmp-h.in: Remove PPC MPN_COPY variants. + * gmp-impl.h: Likewise. + + * mpn/powerpc64/logops_n.asm: New file. + + * mpn/powerpc64/mode64/invert_limb.asm: New file. + +2004-10-07 Torbjorn Granlund + + * mpn/powerpc64/mode64/aors_n.asm: New file, optimized for POWER4 and + its derivatives. + * mpn/powerpc64/mode64/add_n.asm: Delete. + * mpn/powerpc64/mode64/sub_n.asm: Delete. + + * configfsf.guess: Patch HP-UX code to accommodate HP compiler's new + inability to read from stdin. + + * mpn/powerpc64/mode64/addsub_n.asm: Remove accidentally added file. + +2004-10-02 Torbjorn Granlund + + * mpn/amd64/README: Update for new developments, fix typos. + + * mpn/amd64/mul_1.asm: Tweak addressing (3.25 => 3.0 cycles/limb). + + * mpn/amd64/addmul_1.asm: Remove unreachable code block. + +2004-09-30 Torbjorn Granlund + + * mpn/amd64/addmul_1.asm: Rewrite, now 3.25 cycles/limb. + + * mpn/ia64/addmul_1.asm: Slightly enhance cross-jumping for code + density. + * mpn/ia64/mul_1.asm: Analogous changes. + +2004-09-29 Torbjorn Granlund + + * gmp-impl.h (x86 ULONG_PARITY): Work around GCC change of "q" register + flag. + +2004-09-28 Torbjorn Granlund + + * mpn/ia64/divrem_1.asm: Add cycle counts to loop. + + * mpn/ia64/divrem_2.asm: New file. + +2004-09-28 Paul Zimmermann + + * mpn/generic/mul_fft.c (mpn_mul_fft): Fix a bug in the choice of the + recursive fft parameters. + +2004-09-20 Torbjorn Granlund + + * tests/misc.c (tests_rand_start): Default to strtoul for re-seeding. + + * tests/mpz/t-mul.c (ref_mpn_mul): Fudge tmp allocation for toom3. + +2004-09-19 Torbjorn Granlund + + * tests/misc.c (tests_rand_start): Shift tv_usec for better seeding. + +2004-09-18 Torbjorn Granlund + + * tests/misc.c (tests_rand_start): Invoke fflush after printing seed. + + * tests/mpz/t-mul.c (main): Check environment for GMP_CHECK_FFT, run + extra FFT tests if set. + (ref_mpn_mul): Use library code for kara and toom, but skewded so that + we never use the same algorithm that we're testing. + (mul_kara): Delete. + (debug_mp): Print just one line of large numbers. + (ref_mpn_mul): Rework usage of tp temporary space. + +2004-09-15 Torbjorn Granlund + + * mpn/ia64/mul_2.asm: For HAVE_ABI_32, convert vp. + * mpn/ia64/addmul_2.asm: Likewise. + +2004-09-13 Torbjorn Granlund + + * mpn/ia64/invert_limb.asm: Rewrite. + + * mpn/ia64/logops_n.asm: Insert some more stops. + +2004-09-12 Torbjorn Granlund + + * mpn/ia64/gmp-mparam.h: Update. + * mpn/amd64/gmp-mparam.h: Update. + + * mpn/ia64/sqr_diagonal.asm: Shave off a few cycles. + +2004-09-11 Torbjorn Granlund + + * mpn/ia64/mul_2.asm: New file. + * mpn/ia64/addmul_2.asm: New file. + + * mpn/ia64/addmul_1.asm: Tune a cycle from prologue. + + * mpn/ia64/lorrshift.asm: Insert stops after several branches. + * mpn/ia64/aorslsh1_n.asm: Likewise. + * mpn/ia64/rsh1aors_n.asm: Likewise. + + * mpn/generic/sqr_basecase.c: In variant for HAVE_NATIVE_mpn_addmul_2, + accumulate carry also for when HAVE_NATIVE_mpn_addlsh1_n. + +2004-09-07 Torbjorn Granlund + + * mpn/ia64/submul_1.asm: Rewrite. + + * mpn/ia64/addmul_1.asm: Format to placate HP-UX assembler. + * mpn/ia64/mul_1.asm: Likewise. + +2004-09-02 Torbjorn Granlund + + * mpn/ia64/mul_1.asm: Optimize feed-in code. + * mpn/ia64/addmul_1.asm: Rewrite feed-in code. + +2004-08-29 Torbjorn Granlund + + * tests/mpz/t-sizeinbase.c: Disable mpz_fake_bits and check_sample. + +2004-07-16 Torbjorn Granlund + + * mpn/ia64/addmul_1.asm: Format to placate HP-UX assembler. + +2004-06-17 Kevin Ryde + + * doc/gmp.texi: Use @. when sentence ends with a capital, for good + spacing in tex. + (Language Bindings): Add gmp-d, reported by Ben Hinkle. Update SWI + Prolog URL, reported by Jan Wielemaker. + +2004-06-09 Torbjorn Granlund + + * configure.in: Handle --enable-fat. Use that to enable x86 fat + builds, remove magic meaning of i386-*-*. + +2004-06-03 Kevin Ryde + + * gmp-impl.h (memset): Use a local char* pointer, in case parameter is + something else (eg. tune/common.c). Reported by Emmanuel Thomé. + +2004-06-01 Kevin Ryde + + * config.guess (i?86-*-*): Avoid "Illegal instruction" message which + goes to stdout on 80386 freebsd4.9. + +2004-05-23 Niels Möller + + * mpn/generic/gcdext.c (gcdext_1_u): New function. + (mpn_gcdext): Use it. + +2004-05-23 Torbjorn Granlund + + * mpn/generic/gcdext.c (gcdext_1_odd): Use masking to avoid jumps. + +2004-05-22 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/addmul_1.asm: Add Prescott cycle numbers. + + * mpn/amd64/divrem_1.asm: Shave a cycle from fraction development code. + + * mpn/powerpc32/lshift.asm: Add more cycle numbers. + * mpn/powerpc32/rshift.asm: Likewise. + + * mpn/ia64/addmul_1.asm: Reformat. + +2004-05-21 Torbjorn Granlund + + * gmp-impl.h (mpn_mullow_n, mpn_mullow_basecase): Declare. + + * tune/Makefile.am: Compile gcdext.c. + + * gmp-impl.h (GET_STR_THRESHOLD_LIMIT): Lower outrageous value to 150. + (GCDEXT_SCHOENHAGE_THRESHOLD): Set reasonable default. Override when + TUNE_PROGRAM_BUILD. + (GCDEXT_THRESHOLD): Remove. + + * tune/tuneup.c (gcdext_schoenhage_threshold): New variable. + (gcdext_threshold): Remove variable. + (tune_gcd_schoenhage): Lower step_factor to 0.1. + (tune_gcdext_schoenhage): New function, based on tune_gcd_schoenhage. + (tune_gcdext): Remove function. + (all): Corresponding changes. + +2004-05-21 Niels Möller + + * mpn/generic/gcdext.c: Complete rewrite. Uses fast Lehmer code for + small operands, and Schoenhage code for large operands. + + * tune/speed.h (SPEED_ROUTINE_MPN_GCD_CALL): Ensure first operand is + not smaller than 2nd operand. + +2004-05-17 Kevin Ryde + + * gmp-h.in (mpz_get_ui): Use #if instead of plain if, and for nails + use ?: same as normal case, to avoid warnings from Borland C++ 6.0. + Reported by delta trinity. + +2004-05-15 Kevin Ryde + + * tune/time.c (getrusage_backwards_p): New function + (speed_time_init): Use it to exclude broken netbsd1.4.1 getrusage. + * configure.in (m68*-*-netbsd1.4*): Remove code pretending getrusage + doesn't exist. + * tune/README (NetBSD 1.4.1 m68k): Update notes. + + * configure.in (mips*-*-* ABI=n32): Remove gcc_n32_ldflags and + cc_n32_ldflags, libtool knows to put the linker in n32 mode. + +2004-05-15 Torbjorn Granlund + + * config.guess (powerpc*-*-*): Add more processor types to mfpvr code. + * configure.in: Generalize powerpc subtype matching code. + + * mpz/fac_ui.c: Misc cleanups, spelling corrections. + +2004-05-14 Kevin Ryde + + * mpf/sub.c: When one operand cancels high limbs of the other, strip + high zeros on the balance before truncating to destination precision. + Truncating first loses accuracy and can lead to a result 0 despite + operands being not equal. Reported by John Abbott. + Also, ensure exponent is zero when result is zero, for instance if + operands are exactly equal. + * tests/mpf/t-sub.c (check_data): New function, exercising these. + +2004-05-12 Kevin Ryde + + * configure.in (AC_PROG_RANLIB): New macro, supposedly required by + automake, though it doesn't complain. + + * demos/expr/Makefile.am (ARFLAGS): Add a default setting, to + workaround an automake bug. + +2004-05-10 Kevin Ryde + + * */Makefile.in, install-sh, aclocal.m4: Update to automake 1.8.4. + + * doc/gmp.texi (Demonstration Programs): Add a remark about expression + evaluation in the main gmp library. + + * demos/expr/exprfa.c (mpf_expr_a): Correction to mpX_init, use + mpf_init2 to follow requested precision. + * demos/expr/exprza.c, demos/expr/exprqa.c: Use wrappers for mpX_init, + to make parameters match. + + * demos/expr/run-expr.c: Don't use getopt, to avoid needing configury + for optarg declaration. Remove TRY macro, rename foo and bar to var_a + and var_b, for clarity. + * demos/expr/expr-impl.h: Don't use expr-config.h. + * configure.in (demos/expr/expr-config.h): Remove. + * demos/expr/expr-config.in: Remove file. + +2004-05-08 Kevin Ryde + + * doc/configuration (Configure): Update for current automake not + copying acinclude.m4 into aclocal.m4. + + * configure.in, Makefile.am, doc/gmp.texi, doc/configuration, + tests/cxx/Makefile.am, demos/expr/Makefile.am, demos/expr/README, + demos/expr/expr.c, demos/expr/expr.h, demos/expr/expr-config-h.in, + demos/expr/expr-impl.h, demos/expr/run-expr.c, demos/expr/t-expr.c: + MPFR now published separately, remove various bits. + * mpfr/*, tests/cxx/t-headfr.cc, demos/expr/exprfr.c, + demos/expr/exprfra.c: Remove. + +2004-05-07 Kevin Ryde + + * tests/cxx/Makefile.am (TESTS_ENVIRONMENT): Amend c++ shared library + path hack, on k62-unknown-dragonfly1.0 /usr/bin/make runs its commands + "set -e", so we need an "|| true" in case there's nothing to copy (for + instance in a static build). + +2004-05-06 Kevin Ryde + + * mpn/alpha/mode1o.c: Remove, in favour of ... + * mpn/alpha/mode1o.asm: New file. + * mpn/alpha/alpha-defs.m4 (bwx_available_p): New macro. + + * tune/amd64.asm: Save rbx in r10 rather than on the stack. + + * configure.in (x86_64-*-*): Try also "-march=k8 -mno-sse2", in case + we're in ABI=32 on an old OS not supporting xmm regs. + (GMP_GCC_PENTIUM4_SSE2, GMP_OS_X86_XMM): Run these tests under + -march=k8 too, and not under ABI=64. + + * doc/gmp.texi (Converting Integers): For mpz_get_d, note truncation + and overflows. For mpz_get_d_2exp note truncation, note result if + OP==0, and cross reference libc frexp. + (Rational Conversions): For mpq_get_d, note truncation and overflows. + (Converting Floats): For mpf_get_d, note truncation and overflows. + For mpf_get_d_2exp, note truncation, note result if OP==0. + (Assembler Code Organisation): Note nails subdirectories. + Clarification of get_d_2exp OP==0 reported by Sylvain Pion. + +2004-05-05 Torbjorn Granlund + + * mpn/generic/mullow_n.c, mpn/generic/mullow_basecase.c: New files + (mainly by Niels Möller). + * configure.in, mpn/Makefile.am: Add them. + + * gmp-impl.h (MULLOW_BASECASE_THRESHOLD, MULLOW_DC_THRESHOLD, + MULLOW_MUL_N_THRESHOLD): Override for TUNE_PROGRAM_BUILD. + + * tune/Makefile.am: Compile mullow_n.c. + * tune/common.c (speed_mpn_mullow_n, speed_mpn_mullow_basecase): + New functions. + * tune/speed.c (routine): Add entries for mpn_mullow_n and + mpn_mullow_basecase. + * tune/speed.h (SPEED_ROUTINE_MPN_MULLOW_N_CALL, + SPEED_ROUTINE_MPN_MULLOW_BASECASE): New #defines. + * tune/tuneup.c (tune_mullow): New function. + + * gmp-impl.h (invert_limb): Compute branch-freely. + +2004-05-02 Kevin Ryde + + * mpn/amd64/mode1o.asm: Use movabsq to support large model non-PIC. + Use 32-bit insns to save code bytes, and to save a couple of cycles on + the initial setup multiplies. + +2004-05-01 Kevin Ryde + + * doc/gmp.texi (References): Update gcc online docs url to + gcc.gnu.org. + + * configure.in (mips*-*-irix[6789]*): Correction to m4 quoting of this + pattern. (Believe the mips64*-*-* part also used picks up all current + irix6 tuples anyway.) Reported by Rainer Orth. + +2004-04-30 Kevin Ryde + + * acinclude.m4 (GMP_PROG_CC_X86_GOT_EAX_EMITTED, + GMP_ASM_X86_GOT_EAX_OK): New macros. + (GMP_PROG_CC_WORKS): Use them to detect an old gas bug tickled by + recent gcc. Reported by David Newman. + + * doc/gmp.texi (Reentrancy): Note also gmp_randinit_default as an + alternative to gmp_randinit. + +2004-04-29 Torbjorn Granlund + + * configfsf.guess: Update to 2004-03-12. + * configfsf.sub: Likewise. + +2004-04-27 Torbjorn Granlund + + * mpz/rrandomb.c (gmp_rrandomb): Rework to avoid extra limb allocation + and to generate even numbers. + * mpn/generic/random2.c (gmp_rrandomb): Likewise. + +2004-04-25 Kevin Ryde + + * gmp-impl.h (FORCE_DOUBLE): Don't use an asm with a match constraint + on a memory output, apparently not supported and provokes a warning + from gcc 3.4. + +2004-04-24 Kevin Ryde + + * longlong.h (count_leading_zeros_gcc_clz, + count_trailing_zeros_gcc_ctz): New macros. + (count_leading_zeros, count_trailing_zeros) [x86]: Use them on gcc + 3.4. + + * configure.in (x86-*-* gcc_cflags_cpu): Give a -mtune at the start of + each option list, for use by gcc 3.4 to avoid deprecation warnings + about -mcpu. + + * mpz/aorsmul.c, mpz/aorsmul_i.c, mpz/cfdiv_q_2exp.c, + mpz/cfdiv_r_2exp.c, mpq/aors.c, mpf/ceilfloor.c: Give REGPARM_ATTR() + on function definition too, as demanded by gcc 3.4. + +2004-04-22 Kevin Ryde + + * tests/rand/t-lc2exp.c (check_bigc1): New test. + + * doc/fdl.texi: Tweak @appendixsubsec -> @appendixsec to match our + preference for this in an @appendix, and because texi2pdf doesn't + support @appendixsubsec directly within an @appendix. + +2004-04-20 Kevin Ryde + + * doc/texinfo.tex: Update to 2004-04-07.08 from texinfo 4.7. + * doc/gmp.texi, mpfr/mpfr.texi (@copying): Don't put a line break in + @ref within @copying, recent texinfo.tex doesn't like that. + + * demos/perl/GMP.xs (static_functable): Treat cygwin the same as mingw + DLLs. + + * */Makefile.in, install-sh: Update to automake 1.8.3. + * ltmain.sh, aclocal.m4, configure: Update to libtool 1.5.6. + + * gmp-impl.h (LIMB_HIGHBIT_TO_MASK): Use a compile-time constant + expression, rather than a configure test. + * acinclude.m4, configure.in (GMP_C_RIGHT_SHIFT): Remove, no longer + needed. + * tests/t-hightomask.c: New file. + * tests/Makefile.am (check_PROGRAMS): Add it. + + * macos/configure (parse_top_configure): Look for PACKAGE_NAME and + PACKAGE_VERSION now used by autoconf. + (what_objects): Only demand 9 object files, as for instance occurs in + the scanf directory. + (asm files): Transform labels L(foo) -> Lfoo. Take func name from + PROLOGUE to support empty "EPILOGUE()". Recognise and substitute + register name "define()"s. + * macos/Makefile.in (CmnObjs): Add tal-notreent.o. + +2004-04-19 Torbjorn Granlund + + * tune/speed.h (SPEED_ROUTINE_MPN_ROOTREM): New #define. + (speed_mpn_rootrem): Declare. + * tune/common.c (speed_mpn_rootrem): New function. + * tune/speed.c (routine): Add entry for mpn_rootrem. + +2004-04-16 Kevin Ryde + + * doc/fdl.texi: Update from FSF, just fixing a couple of typos. + + * macos/configure, macos/Makefile.in: Add printf and scanf directories. + + * tests/mpz/t-gcd.c (check_data): New function, exercising K6 + gcd_finda bug. + +2004-04-14 Kevin Ryde + + * doc/gmp.texi (Reentrancy, Random State Initialization): Note + gmp_randinit use of gmp_errno is not thread safe. Reported by Vincent + Lefèvre. + + * doc/gmp.texi (Random State Initialization): Add index entries for + gmp_errno and constants. + + * mpn/m68k/README: Update _SHORT_LIMB -> __GMP_SHORT_LIMB. + + * configure.in (--enable-mpbsd): Typo Berkley -> Berkeley in help msg. + +2004-04-12 Kevin Ryde + + * demos/perl/GMP.xs (static_functable): New macro, use it for all + function tables, to support mingw DLL builds. + * demos/perl/INSTALL (NOTES FOR PARTICULAR SYSTEMS): Remove note on + DLLs, should be ok now. + + * demos/perl/sample.pl: Print the module and library versions in use. + + * demos/perl/GMP.pm, Makefile.PL (VERSION): Set to '2.00'. + * demos/perl/GMP.pm (COPYRIGHT): New in the doc section. + + * Makefile.am: Note 4.1.3 libtool versioning info, and REVISION policy. + + * tal-debug.c: Add for abort. + +2004-04-07 Torbjorn Granlund + + * tests/refmpf.c (refmpf_add_ulp): Adjust exponent when needed. + + * mpn/generic/random2.c: Rewrite (clone mpz/rrandomb.c). + +2004-04-07 Kevin Ryde + + * mpn/x86/k6/gcd_finda.asm: Correction jbe -> jb in initial setups. + Zero flag is wrong here, it relects only the high limb of the compare, + leading to n1>=n2 not satisfied and wrong results. cp[1]==0x7FFFFFFF + with cp[0]>=0x80000001 provokes this. + + * doc/gmp.texi (BSD Compatible Functions): Note "pow" name clash under + the pow function description too. + (Language Bindings): Add XEmacs (betas at this stage). Reported by + Jerry James. + + * tests/refmpn.c (refmpn_mod2): Correction to ASSERTs, r==a is allowed. + + * gen-psqr.c (generate_mod): Cast mpz_invert_ui_2exp args, for K&R. + * gen-bases.c, gen-fib.c, gen-psqr.c: For mpz_out_str, use stdout + instead of 0, in case a K&R treats int and FILE* params differently. + +2004-04-04 Kevin Ryde + + * gmp-impl.h (BSWAP_LIMB) [amd64]: New macro. + (FORCE_DOUBLE): Use this for amd64 too. + + * tests/amd64check.c, tests/amd64call.asm: New files, derived in part + from x86check.c and x86call.asm. + * tests/Makefile.am (EXTRA_libtests_la_SOURCES): Add them. + * configure.in (x86_64-*-* ABI=64): Use them. + +2004-04-03 Kevin Ryde + + * mpn/amd64/mode1o.asm: New file. + * mpn/amd64/amd64-defs.m4 (ASSERT): New macro. + + * mpn/x86/k7/mmx/divrem_1.asm, mpn/x86/pentium4/sse2/divrem_1.asm: Add + note on how "dr" part of algorithm is handled. + + * mpn/x86/k7/dive_1.asm, mpn/x86/k7/mod_34lsub1.asm, + mpn/x86/k7/mode1o.asm: Note Hammer (32-bit mode) speeds. + +2004-03-31 Kevin Ryde + + * doc/gmp.texi (Language Bindings): Add GOO, MLGMP and Numerix. + + * mpf/mul_2exp.c, mpf/div_2exp.c: Rate u==0 as UNLIKELY. + +2004-03-28 Torbjorn Granlund + + * mpn/amd64/divrem_1.asm: Trim a few cycles. + +2004-03-27 Torbjorn Granlund + + * mpn/amd64/sublsh1_n.asm: Fix typo. + + * mpn/generic/divrem_1.c: Fix typo. + + * mpn/generic/sqr_basecase.c: Fix typo. + + * mpn/amd64/divrem_1.asm: New file. + +2004-03-20 Kevin Ryde + + * longlong.h (power, powerpc): Add comments on how we select this code. + + * gmp-h.in (mpz_get_ui): Use ?: instead of mask style, gcc treats the + two identically but ?: is a bit clearer. + + * insert-dbl.c: Remove file, no longer used, scaling is now integrated + in mpn_get_d. + * Makefile.am (libgmp_la_SOURCES): Remove insert-dbl.c. + * gmp-impl.h (__gmp_scale2): Remove prototype. + +2004-03-17 Kevin Ryde + + * mpn/x86/fat/fat.c (__gmpn_cpuvec_init, fake_cpuid_table): Add x86_64. + + * mpq/get_d.c: Use mpn_tdiv_qr, demand den>0 per canonical form. + +2004-03-16 Torbjorn Granlund + + * mpn/generic/sqr_basecase.c: Add versions using mpn_addmul_2 and + mpn_addmul_2s. + +2004-03-14 Kevin Ryde + + * mpf/mul_ui.c: Incorporate carry from low limbs, for exactness. + * tests/mpf/t-mul_ui.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + + * mpf/div.c: Use mpn_tdiv_qr. Use just one TMP_ALLOC. Use full + divisor, since truncating can lose accuracy. + * tests/mpf/t-div.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + + * tests/mpf/t-set_q.c, tests/mpf/t-ui_div.c (check_various): Amend + bogus 99/4 test. + * tests/mpf/t-ui_div.c (check_rand): Exercise r==v overlap. + + * tests/refmpf.c, tests/tests.h (refmpf_set_overlap): New function. + + * mpf/cmp_si.c [nails]: Correction, cast vval in exp comparisons, for + when vval=-0x800..00 and limb==longlong. + + * mpf/cmp_si.c [nails]: Correction, return usign instead of 1 when + uexp==2 but value bigger than an mp_limb_t. + * tests/mpf/t-cmp_si.c (check_data): Add test cases. + + * tests/trace.c (mpf_trace): Use ABS(mp_trace_base) to allow for + negative bases used for upper case hex in integer traces. + +2004-03-12 Torbjorn Granlund + + * mpn/generic/sb_divrem_mn.c: Correct header comment. + +2004-03-11 Kevin Ryde + + * aclocal.m4, configure, ltmain.sh: Downgrade to libtool 1.5, version + 1.5.2 doesn't remove .libs/*.a files when rebuilding, which is bad for + development when changing contents or with duplicate named files like + we have. + + Revert this, ie restore AR_FLAGS=cq: + * acinclude.m4 (GMP_PROG_AR): Remove AR_FLAGS=cq, libtool 1.5.2 now + does this itself on detecting duplicate object filenames in piecewise + linking mode. + + * randbui.c, randmui.c [longlong+nails]: Correction to conditionals + for second limb. + + * mpz/aors_ui.h, mpz/cdiv_q_ui.c, mpz/cdiv_qr_ui.c, mpz/cdiv_r_ui.c, + mpz/cdiv_ui.c, mpz/fdiv_q_ui.c, mpz/fdiv_qr_ui.c, mpz/fdiv_r_ui.c, + mpz/fdiv_ui.c, mpz/gcd_ui.c, mpz/iset_ui.c, mpz/lcm_ui.c, + mpz/set_ui.c, mpz/tdiv_q_ui.c, mpz/tdiv_qr_ui.c, mpz/tdiv_r_ui.c, + mpz/tdiv_ui.c, mpz/ui_sub.c, mpf/div_ui.c, mpf/mul_ui.c + [longlong+nails]: Amend #if to avoid warnings about shift amount. + +2004-03-07 Kevin Ryde + + * mpf/reldiff.c: Use rprec+ysize limbs for d, to ensure accurate + result. Inline mpf_abs(d,d) and mpf_cmp_ui(x,0), and rate the latter + UNLIKELY. + + * mpf/ui_div.c: Use mpn_tdiv_qr. Use just one TMP_ALLOC. Use full + divisor, since truncating can lose accuracy. + * tests/mpf/t-ui_div.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + + * mpf/set_q.c: Expand TMP_ALLOC_LIMBS_2, to make conditional clearer + and avoid 1 limb alloc when not wanted. + + * gmp-impl.h (WANT_TMP_DEBUG): Define to 0 if not defined. + (TMP_ALLOC_LIMBS_2): Use "if" within macro rather than "#if", for less + preprocessor conditionals. + + * mpf/mul_2exp.c, mpf/div_2exp.c: Add some comments. + + * tests/refmpn.c (refmpn_sb_divrem_mn, refmpn_tdiv_qr): Nailify. + +2004-03-04 Kevin Ryde + + * gen-psqr.c (print): Add CNST_LIMB in PERFSQR_MOD_TEST, for benefit + of K&R. + * tests/mpn/t-perfsqr.c (PERFSQR_MOD_1): Use CNST_LIMB for K&R. + + * doc/configuration (Configure): Remove mkinstalldirs, no longer used. + + * acinclude.m4 (GMP_PROG_AR): Remove AR_FLAGS=cq, libtool 1.5.2 now + does this itself on detecting duplicate object filenames in piecewise + linking mode. + + * configure.in (hppa2.0*-*-*): Test sizeof(long) == 4 or 8 to verify + ABI=2.0n versus ABI=2.0w. In particular this lets CC=cc_bundled + correctly fall back to ABI=2.0n (we don't automatically add CC=+DD64 + to that compiler, currently). + + * doc/gmp.texi (Reentrancy): Note C++ mpf_class constructors using + global default precision. + (Random State Miscellaneous): Describe gmp_urandomb_ui as giving N + bits. + (C++ Interface Floats): Describe operator= copying the value, not the + precision, and what this can mean about copy constructor versus + default constructor plus assignment. + + * mpf/set_q.c: Use mpn_tdiv_qr rather than mpn_divrem, so no shifting. + Don't truncate the divisor, it can make the result inaccurate. + * tests/mpf/t-set_q.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + + * mpf/set.c: Use MPN_COPY_INCR, in case r==u and ABSIZ(u) > PREC(r)+1. + No actual bug here, because MPN_COPY has thusfar been an alias for + MPN_COPY_INCR, only an ASSERT failure. + * tests/mpf/t-set.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + + * mpf/set.c, mpf/iset.c: Do MPN_COPY last, for possible tail call. + + * mpf/set_d.c: Rate d==0 as UNLIKELY. Store size before extract call, + to shorten lifespan of "negative". + + * mpf/init.c, mpf/init2.c, mpf/iset_d.c, mpf/iset_si.c, + mpf/iset_str.c, mpf/iset_ui.c: Store prec before alloc call, for one + less live quantity across that call. + * mpf/init.c, mpf/init2.c, mpf/iset_str.c: Store size and exp before + alloc call, to overlap with other operations. + + * tests/refmpf.c, tests/tests.h (refmpf_fill, refmpf_normalize, + refmpf_validate, refmpf_validate_division): New functions. + + * tests/refmpn.c, tests/tests.h (refmpn_copy_extend, + refmpn_lshift_or_copy_any, refmpn_rshift_or_copy_any): New functions. + + * tal-debug.c: Add for strcmp. + + * tests/cxx/t-istream.cc (check_mpz, check_mpq, check_mpf): Use size_t + for loop index, to quieten g++ warning. + +2004-03-02 Kevin Ryde + + * tests/mpn/t-hgcd.c: Use __GMP_PROTO on prototypes. + +2004-03-01 Torbjorn Granlund + + With Karl Hasselström: + * mpn/generic/dc_divrem_n.c (mpn_dc_div_2_by_1): New function, with + meat from old mpn_dc_divrem_n. Accept scratch parameter. Rewrite to + avoid a recursive call. + (mpn_dc_div_3_by_2): New function, with meat from old + mpn_dc_div_3_halves_by_2. Accept scratch parameter. + (mpn_dc_divrem_n): Now just allocate scratch space and call new + mpn_dc_div_2_by_1. + +2004-02-29 Kevin Ryde + + * longlong.h (count_leading_zeros) [alpha gcc]: New version, inlining + mpn/alpha/cntlz.asm cmpbge technique. + + * aclocal.m4, configure, install-sh, missing, ltmain.sh, + */Makefile.in: Update to automake 1.8.2 and libtool 1.5.2. + + * doc/gmp.texi (C++ Interface Integers): Note / and % rounding follows + C99 / and %. + (Exact Remainder): Index entries for divisibility testing algorithm. + + * tune/time.c (speed_endtime): Return 0.0 for negative time measured. + Revise usage comments for clarity. + * tune/common.c (speed_measure): Recognise speed_endtime 0.0 for + failed measurement. + + * tests/mpn/t-get_d.c (check_rand): Correction to nhigh_mask setup. + +2004-02-27 Torbjorn Granlund + + * tune/tuneup.c (tune_dc, tune_set_str): Up param.step_factor. + + * tests/mpz/t-gcd.c: Decrease # of tests to 50. + +2004-02-27 Kevin Ryde + + * tests/devel/try.c: Add a comment that this is not for Cray systems. + + * mpf/set_q.c: Don't support den(q)<0, demand canonical form in the + usual way. + +2004-02-24 Torbjorn Granlund + + From Kevin: + * mpn/generic/mul_fft.c (mpn_fft_add_modF): Loop until normalization + criterion met. + +2004-02-22 Kevin Ryde + + * acinclude.m4 (GMP_PROG_CC_WORKS, GMP_OS_X86_XMM, GMP_PROG_CXX_WORKS): + Remove files that might look like compiler output, so our "||" + alternatives are not fooled. + + * acinclude.m4 (GMP_PROG_CC_WORKS): Add test for lshift_com code + mis-compiled by certain IA-64 HP cc at +O3. + + * gmp-impl.h (USE_LEADING_REGPARM): Disable under prof or gprof, for + the benefit of freebsd where .mcount clobbers registers. Spotted by + Torbjorn. + * configure.in (WANT_PROFILING_PROF, WANT_PROFILING_GPROF): New + AC_DEFINEs. + +2004-02-21 Kevin Ryde + + * configure.in (sparc64-*-*bsd*): Amend -m32 setup for ABI=32, so it's + not used in ABI=64 on the BSD systems. + +2004-02-18 Niels Möller + + * tests/mpz/t-gcd.c (gcdext_valid_p): New function. + (ref_mpz_gcd): Deleted function. + (one_test): Rearranged to call mpz_gcdext first, so that the + returned value can be validated. + (main): Don't use ref_mpz_gcd. + +2004-02-18 Torbjorn Granlund + + * gmp-impl.h (MPN_TOOM3_MAX_N): Move to !WANT_FFT section. + + * tests/mpz/t-mul.c: Exclude special huge operands unless WANT_FFT. + + * mpz/rrandomb.c (gmp_rrandomb): Rewrite. + + * mpn/generic/mul_n.c (mpn_toom3_sqr_n): Remove write-only variable c5. + +2004-02-18 Kevin Ryde + + * mpf/iset_si.c, mpf/iset_ui.c, mpf/set_si.c, mpf/set_ui.c [nails]: + Always store second limb, to avoid a conditional. + + * tests/mpf/t-get_ui.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + * tests/mpf/t-get_si.c (check_limbdata): Further tests. + * gmp-impl.h (MP_EXP_T_MAX, MP_EXP_T_MIN): New defines. + + * mpf/get_ui.c, mpf/get_si.c: Remove size==0 test, it's covered by + other conditions. Attempt greater clarity by expressing conditions as + based on available data range. + * mpf/get_si.c [nails]: Correction, don't bail on exp > abs_size, + since may still have second limb above radix point available. + * mpf/get_ui.c: Nailify. + +2004-02-16 Kevin Ryde + + * mpz/scan0.c, mpz/scan1.c: Use count_trailing_zeros, instead of + count_leading_zeros on limb&-limb. + + * mpf/sqrt.c: Use "/ 2" for exp, avoiding C undefined behaviour on + ">>" of negatives. Correction to comment, exp is rounded upwards. + SIZ(r) always prec now, no need for tsize expression. Store EXP(r) + and SIZ(r) where calculated to reduce variable lifespans. Make tsize + mp_size_t not mp_exp_t, though of course those are currently the same. + + * gmp-h.in (GMP_ERROR_ALLOCATE, GMP_ERROR_BAD_STRING, + GMP_ERROR_UNUSED_ERROR): Remove, never used or documented, and we + don't want to use globals for communicating error information. + + * mpz/gcd_ui.c [nails]: Correction, actually return a value. + + * mpn/generic/addmul_1.c, mpn/generic/submul_1.c [nails==1]: Add code. + +2004-02-15 Kevin Ryde + + * tests/mpz/t-jac.c (check_data): Remove unnecessary variable + "answer". + +2004-02-14 Torbjorn Granlund + + * mpn/ia64/aors_n.asm: Break a group with a RAW conflict. + +2004-02-14 Kevin Ryde + + * acinclude.m4 (GMP_C_RIGHT_SHIFT): Note that it's "long"s which we're + concerned about. + + * mpn/generic/mul_n.c: Add some remarks about toom3 high zero + stripping. + + * mpn/generic/scan0.c, mpn/generic/scan1.c: Remove design issue + remarks. What to do about going outside `up' space is a problem, but + anything to address it would be an incompatible change. + +2004-02-12 Torbjorn Granlund + + * tests/mpn/t-hgcd.c: Remove unused variables. + + * mpn/ia64/hamdist.asm: Remove bundling incompatible with HP-UX + assembler. Misc HP-UX changes. + * mpn/ia64/gcd_1.asm: Add some syntax to placid the HP-UX assembler. + +2004-02-11 Kevin Ryde + + * longlong.h (power, powerpc): Use HAVE_HOST_CPU_FAMILY_power and + HAVE_HOST_CPU_FAMILY_powerpc rather than various cpp defines. + + * gmp-impl.h: Add remarks about limits.h and Cray etc. + + * mpn/ia64/mul_1.asm: Don't put .pred directives on labelled lines, + hpux 11.23 assembler doesn't like that. + * mpn/ia64/README: Add a note on this. + + * dumbmp.c (mpz_mul): Set ALLOC(r) for new data block used. Reported + by Jason Moxham. + + * mpn/pa32/README, mpn/pa64/README (REFERENCES): New sections. + +2004-02-10 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Decrease # of tests run. + + * mpn/*/gmp-mparam.h: Add HGCD values, update TOOM values. + +2004-02-01 Torbjorn Granlund + + From Kevin: + * config.guess: Recognize AMD's hammer processors, return x86_64. + +2004-01-31 Niels Möller + + * mpn/generic/hgcd.c (mpn_cmp_sum3): Declare static. + +2004-01-25 Niels Möller + + * tests/mpn/Makefile.am (check_PROGRAMS): Add t-hgcd. + + * mpn/generic/hgcd.c (hgcd_jebelean): Simplify, use mpn_cmp_sum3. + (mpn_cmp_sum3): New function. + (mpn_diff_smaller_p): Remove. + (hgcd_final, hgcd_jebelean, hgcd_small_1, hgcd_small_2, euclid_step): + Remove tp,talloc arguments. Callers changed. + +2004-01-25 Torbjorn Granlund + + * tune/tuneup.c (all): Reenable calls of tune_gcd_schoenhage and + tune_hgcd. + + * mpn/generic/gcd.c: Reenable Schoenhage code. + + With Niels Möller: + * mpn/generic/hgcd.c: Add const and inline to several functions. + (qstack_push_start qstack_push_end qstack_push_quotient): Remove. + (euclid_step): Insert removed functions here. + (hgcd_adjust): Simplify, don't handle d != 1. + (qstack_adjust): Corresponding changes. + (mpn_hgcd2_lehmer_step): Remove redundant tests for bh against zero. + (hgcd_start_row_p): Tweak. + (hgcd_final): Shorten life of ralloc. + +2004-01-24 Kevin Ryde + + * tests/mpf/t-sqrt.c (check_rand1): Further diagnostic printouts. + + * mpn/generic/sqrtrem.c (mpn_sqrtrem): Add ASSERT_MPN. + (mpn_dc_sqrtrem): Add casts for K&R. + + * mpf/sqrt_ui.c: Nailify. + + * mpf/set_z.c: Do MPN_COPY last, for possible tail call. + + * doc/gmp.texi (Miscellaneous Float Functions): For mpf_random2, note + exponent is in limbs. + + * mpn/ia64/README: Add remark about concentrating on itanium-2. + +2004-01-22 Kevin Ryde + + * mpf/sqrt.c: Change tsize calculation to get prec limbs result + always, previously got prec+1 when exp was odd. + * tests/mpf/t-sqrt.c (check_rand1): New function, code from main. + (check_rand2): New function. + + * mpf/sqrt_ui.c: Change rsize calculation to get prec limbs result, + previously got prec+1. + * tests/mpf/t-sqrt_ui.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + + * tests/refmpf.c, tests/tests.h (refmpf_add_ulp, + refmpf_set_prec_limbs): New functions. + + * mpz/get_d_2exp.c, mpf/get_d_2exp.c: Remove x86+m68k force to double, + mpn_get_d now does this. Remove res==1.0 check for round upwards, + mpn_get_d now rounds towards zero. Move exp store to make mpn_get_d a + tail call. + + * configure.in (x86-*-*): Use ABI=32 rather than ABI=standard. + Use gcc -m32 when available, to force mode on bi-arch amd64 gcc. + * configure.in, acinclude.m4 (x86_64-*-*): Merge into plain x86 setups + as ABI=64. Support ABI=32, using athlon code. Use gcc -mcpu=k8, + -march=k8. + (amd64-*-*): Remove pattern, config.sub only gives x86_64. + * doc/gmp.texi (ABI and ISA): Add x86_64 dual ABIs. + + * mpn/amd64/README: Add reference to ABI spec. + +2004-01-17 Niels Möller + + * mpn/generic/hgcd.c (hgcd_adjust): Backed out mpn_addlsh1_n + change for now. + + * mpn/generic/hgcd.c (hgcd_adjust): Fixed calls of mpn_addlsh1_n. + +2004-01-17 Kevin Ryde + + * tune/README: Remove open/mpn versions of toom3, no longer exist. + * tune/powerpc64.asm: Remove unused L(again). + * tune/time.c (mftb): Note single mftb possible for powerpc64. + + * mpn/generic/mode1o.c: Use "c + + * mpn/generic/hgcd.c (mpn_diff_smaller_p): Use MPN_DECR_U. + (hgcd_adjust): Use mpn_addlsh1_n when available. + +2004-01-16 Kevin Ryde + + * configure.in (powerpc64-*-linux*): Try gcc64. Try -m64 with + "cflags_maybe" to get it used in all probing. Add sizeof-long-8 test + to check the mode is right if -m64 is not applicable. + +2004-01-15 Kevin Ryde + + * configure.in (--with-readline=detect): Check for readline/readline.h + and readline/history.h. Report result of detection. + +2004-01-14 Niels Möller + + * tune/speed.c (routine): Disabled speed_mpn_hgcd_lehmer. + * tune/common.c (speed_mpn_hgcd_lehmer): Disabled function. + + * mpn/generic/hgcd.c (mpn_hgcd_lehmer_itch, mpn_hgcd_lehmer) + (mpn_hgcd_equal): Deleted functions. + + * mpn/generic/gcd.c (hgcd_start_row_p): Deleted function. + (gcd_schoenhage): Deleted assertion code using mpn_hgcd_lehmer. + + * mpn/generic/hgcd.c (hgcd_final): Fixed ASSERT typos. + (mpn_hgcd): To use Lehmer's algorithm, call hgcd_final directly, + not mpn_hgcd_lehmer. + + * mpn/generic/gcd.c (gcd_schoenhage): Updated for changes to + mpn_hgcd and mpn_hgcd_fix. (Schoenhage code is still disabled). + + * gmp-impl.h (mpn_hgcd_fix): Updated prototype. + + * mpn/generic/hgcd.c (mpn_hgcd_fix): Replaced a bunch of arguments + by a pointer const struct hgcd_row *s. Updated callers. + + * mpn/generic/hgcd.c (hgcd_start_row_p): Use const for the input. + Moved function definition before hgcd_jebelean. + (hgcd_jebelean): Interface change, analogous to hgcd2. + (mpn_hgcd_fix): Normalize v. Require that v > 0. + (hgcd_adjust): Fix bug in carry update. + (mpn_hgcd): Reorganized again, to adapt to mpn_hgcd/hgcd_jebelean + now sometimes returning 1. Reintroduced hgcd_adjust. + + * mpn/generic/hgcd.c (hgcd_final): Streamlined logic for the first + hgcd2 call. + + * mpn/generic/hgcd2.c (mpn_hgcd2): Interface change. Return 1 + instead of 2, in the no progress case r0=A, r1=B. + + * mpn/generic/hgcd.c (hgcd_adjust): Changed arguments and return + value. Now takes a struct hgcd_row * and the uv size, and returns + updated uvsize. + (hgcd_final): Special handling of the case hgcd2 returning 1. Now + uses hgcd_adjust, instead of a full Euclid division. + +2004-01-13 Niels Möller + + * mpn/generic/hgcd.c (euclid_step, hgcd_case0): Merged into a + single function euclid_step. + (mpn_hgcd): Reorganized the logic for the second recursive call. + Avoid unnecessary Euclid steps. + + * tests/mpn/t-hgcd.c (hgcd_values): One more test value. + + * tests/mpn/t-hgcd.c (hgcd_values): Added values that trigged the + hgcd_jebelean bug. + + * mpn/generic/hgcd.c (hgcd_jebelean): Fixed off by one error. + (mpn_hgcd): Simplified the logic for the first recursive call. Now + it uses only the correct values from the recursive call, and + doesn't do tricks with hgcd_adjust (hgcd_adjust will probably be + reintroduced later, though). + + * tests/mpn/t-hgcd.c (mpz_mpn_equal, hgcd_ref_equal) + (hgcd_ref_init, hgcd_ref_clear): New functions. + (hgcd_ref): Reference implementation of hgcd, using mpz. + (one_test): Use hgcd_ref. Don't use mpn_hgcd_lehmer. + (main): Skip one_step if both input values are zero. + +2004-01-12 Niels Möller + + * mpn/generic/hgcd.c (hgcd_final): Rewritten, now uses Lehmer + steps instead of a division loop. + (mpn_hgcd_lehmer): Deleted old Lehmer code, instead just + initialize and then call hgcd_final. + + * tests/tests.h: Added refmpn_free_limbs prototype. + * tests/refmpn.c (refmpn_free_limbs): New function. + + * tests/mpn/t-hgcd.c: Try the same kind of random inputs as for + mpz/t-gcd. + +2004-01-11 Niels Möller + + * mpn/generic/hgcd.c (mpn_hgcd_lehmer): Rewritten, after some more + analysis of the size reduction for one Lehmer step. + + * tests/mpn/t-hgcd.c: New file. + +2004-01-11 Torbjorn Granlund + + With Niels Möller: + * mpn/generic/hgcd.c (hgcd_normalize): Fix ASSERTs. + (hgcd_mul): Normalize R[1].uvp[1]. Add some more ASSERTs. + (hgcd_update_uv): Streamline. ASSERT that input and output is + normalized. + +2004-01-11 Kevin Ryde + + * mpn/alpha/ev6/slot.pl: New file, derived in part from + mpn/x86/k6/cross.pl. + + * mpn/alpha/alpha-defs.m4 (ASSERT): New macro. + + * mpn/asm-defs.m4 (m4_ifdef): New macro, avoiding OSF 4.0 m4 bug. + (m4_assert_defined): Use it. + + * mpn/alpha/default.m4, mpn/alpha/unicos.m4 (LDGP): New macro. + * mpn/alpha/ev67/gcd_1.asm: Use it to re-establish gp after jsr. + + * configure.in, demos/calc/Makefile.am: Use -lcurses or -lncurses with + readline, when available. + + * longlong.h (sub_ddmmss) [generic]: Use alal, since the former can be done without waiting for __x, + helping superscalar chips, in particular alpha ev5 and ev6. + + * longlong.h (sub_ddmmss) [ia64]: New macro. + + * tests/t-sub.c: New file. + * tests/Makefile.am (check_PROGRAMS): Add it. + * tests/refmpn.c, tests/tests.h (refmpn_sub_ddmmss): New function. + +2004-01-09 Kevin Ryde + + * mpn/x86/p6/mod_34lsub1.asm: New file, derived in part from + mpn/x86/mod_34lsub1.asm. + + * configure.in (IA64_PATTERN): Use -mtune on gcc 3.4. + +2004-01-07 Kevin Ryde + + * gmp-h.in, mp-h.in (__GMP_SHORT_LIMB): Renamed from _SHORT_LIMB, to + keep in our namespace. (Not actually used anywhere currently.) + Reported by Patrick Pelissier. + + * mp-h.in: Use "! defined (__GMP_WITHIN_CONFIGURE)" in the same style + as gmp-h.in (though mp-h.in is not actually used during configure). + + * mp-h.in (__GMP_DECLSPEC_EXPORT, __GMP_DECLSPEC_IMPORT) [__GNUC__]: + Use __dllexport__ and __dllimport__ to keep out of application + namespace. Same previously done in gmp-h.in. + +2004-01-06 Kevin Ryde + + * configfsf.sub, configfsf.guess: Update to 2004-01-05. + * configure.in (amd64-*-* | x86_64-*-*): Update comments on what + configfsf.sub does. + +2004-01-04 Kevin Ryde + + * mpn/alpha/README (REFERENCES): Add tru64 assembly manuals. + (ASSEMBLY RULES): Note what gcc says about !literal! etc. + +2004-01-03 Kevin Ryde + + * mpn/alpha/ev67/gcd_1.asm: New file. + + * mpn/x86/pentium4/sse2/rsh1add_n.asm: New file, derived in part from + mpn/x86/pentium4/sse2/addlsh1_n.asm. + + * mpn/x86/p6/p3mmx/popham.asm: Note measured speeds. + + * mpn/ia64/hamdist.asm: Correction to inputs vs locals in alloc (makes + no difference to the generated code). Corrections to a couple of + comments. + + * mpn/x86/pentium4/sse2/addlsh1_n.asm (PARAM_CARRY): Remove macro, not + used, no such parameter. + + * mpn/generic/gcd.c: Use for NULL. + + * doc/gmp.texi (Single Limb Division): Correction to tex expression + for (1/2)x1. And minor wording tweaks elsewhere. + + * gmp-impl.h (mpn_rsh1add_n, mpn_rsh1sub_n): Correction to comments + about how carries returned. + + * longlong.h (umul_ppmm) [generic]: Add comments about squaring + (dropped from tasks list) + +2003-12-31 Kevin Ryde + + * demos/perl/GMP.xs (scan0, scan1): Return ~0 for not-found. + * demos/perl/GMP.pm: Describe this, remove the note about ULONG_MAX + being the same as ~0 (which is not true in old perl). + * demos/perl/test.pl: Update tests. + * demos/perl/typemap (gmp_UV): New type. + + * demos/perl/test.pl (fits_slong_p): Comment out uv_max test, it won't + necessarily exceed a long. + + * demos/perl/GMP.pm: Add a remark about get_str to the bugs section. + + * mpn/generic/sqrtrem.c, mpz/fac_ui.c, tests/mpf/reuse.c: Add casts + for K&R. + * tests/mpf/t-muldiv.c: Make ulimb, vlimb into ulongs, which is how + they're used, for the benefit of K&R calling. + + * doc/gmp.texi (Square Root Algorithm): Add a summary of the algorithm. + And add further index entries in various places. + + * mpz/lucnum_ui.c, mpz/lucnum2_ui.c: Use mpn_addlsh1_n when available. + + * gmp-impl.h, mpn/generic/mul_n.c (mpn_addlsh1_n, mpn_sublsh1_n, + mpn_rsh1add_n, mpn_rsh1sub_n): Move descriptions to gmp-impl.h with + the prototypes, for ease of locating. + +2003-12-30 Torbjorn Granlund + + * tune/tuneup.c (all): Disable calls of tune_gcd_schoenhage and + tune_hgcd for now. + +2003-12-29 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Rewrite, based on suggestions by Kevin. + + * mpn/ia64/mul_1.asm: Amend TODO list. + + * mpn/sparc64/README: Remove mpn_Xmul_2, done. + Add blurb about L1 cache conflicts. + + * mpn/generic/gcd.c: Disable Schoenhage code for now. + +2003-12-29 Kevin Ryde + + * mpn/generic/mul_fft.c, mpz/root.c, mpq/cmp_ui.c: Add casts for K&R. + +2003-12-27 Kevin Ryde + + * tests/mpz/t-mul.c (mul_kara, mul_basecase): Use __GMP_PROTO. + + * mpn/generic/gcd.c (NHGCD_SWAP4_2, NHGCD_SWAP3_LEFT), + mpn/generic/hgcd.c (HGCD_SWAP4_LEFT, HGCD_SWAP4_RIGHT, HGCD_SWAP4_2, + HGCD_SWAP3_LEFT): Aggregate initializers for automatics is an + ANSI-ism, avoid. + + * Makefile.am (AUTOMAKE_OPTIONS): Restore this, giving no directory on + ansi2knr to avoid a circular build rule. + * configure.in (AM_INIT_AUTOMAKE): Note options also in Makefile.am. + + * configure.in (cflags_maybe): Don't loop adding cflags_maybe if the + user has set CFLAGS. + +2003-12-24 Torbjorn Granlund + + * mpn/generic/gcd.c (gcd_schoenhage_itch): Avoid unary "+". + (mpn_gcd): Allocate scratch space on heap for gcd_schoenhage. + (mpn_gcd): Don't invoke MPN_NORMALIZE on input operands. + +2003-12-23 Kevin Ryde + + * configure.in (*sparc*-*-*): Test sizeof(long)==4 or 8 for ABIs, to + get the right mode when the user sets the CFLAGS. + (testlist): Introduce "any__testlist" to apply to all compilers. + + * demos/perl/typemap (MPZ_ASSUME, MPQ_ASSUME, MPF_ASSUME): Remove + output rules, these are only meant for inputs. + (MPZ_MUTATE): Remove, not used since changes for magic. + + * demos/perl/GMP.xs (mpz_class_hv, mpq_class_hv, mpf_class_hv): New + variables, initialized in BOOT. + * demos/perl/GMP.xs, demos/perl/typemap: Use them and explicit + sv_bless, to save a gv_stashpv for every new object. + +2003-12-22 Kevin Ryde + + * mpn/alpha/mode1o.c, mpn/alpha/dive_1.c: Moved from ev5/mode1o.c and + ev5/dive_1.c, these are good for ev4, and would like them in a generic + alpha build. + +2003-12-21 Kevin Ryde + + * doc/gmp.texi (Integer Logic and Bit Fiddling): Say "bitwise" in + mpz_and, mpz_ior and mpz_xor, to avoid any confusion with what C means + by "logical". Reported by Rüdiger Schütz. + + * gmp-h.in (_GMP_H_HAVE_FILE): Note why defined(EOF) is not good. + +2003-12-20 Torbjorn Granlund + + * mpn/generic/hgcd.c (mpn_diff_smaller_p): Use mpn_cmp instead of + mpn_sub_n where possible. Use mp_size_t for relevant variables. + +2003-12-20 Kevin Ryde + + * tune/speed.h (SPEED_TMP_ALLOC_LIMBS): Correction to last change, + don't want "- 1" on the TMP_ALLOC_LIMBS. + + * demos/expr/expr.h: Test #ifdef MPFR_VERSION_MAJOR for when mpfr.h is + included, not GMP_RNDZ which is now an enum. + + * demos/expr/exprfra.c (e_mpfr_ulong_p): Use mpfr_integer_p and + mpfr_fits_ulong_p. + (e_mpfr_get_ui_fits): Use mpfr_get_ui. + + * mpfr/*: Update to mpfr cvs head 2003-12-20. + + * configure, config.in: Update to autoconf 2.59. + * */Makefile.in, configure, aclocal.m4, ansi2knr.c, install-sh, + doc/mdate-sh: Update to automake 1.8. + + * mkinstalldirs: Remove, not required by automake 1.8. + * doc/gmp.texi (Build Options): HTML is a usual target in automake 1.8. + + * configure.in (AC_PREREQ): Require autoconf 2.59. + (AM_INIT_AUTOMAKE): Require automake 1.8. + (AC_C_INLINE): Use rather than GMP_C_INLINE, now has #ifndef + __cplusplus we want. + (gettimeofday): Use AC_CHECK_FUNCS rather than our workaround code, + autoconf now ok. + + * acinclude.m4 (GMP_C_INLINE): Remove. + (GMP_H_EXTERN_INLINE): Use AC_C_INLINE. + (GMP_PROG_AR): Comment on automake $ARFLAGS. + +2003-12-19 Niels Möller + + * mpn/generic/hgcd.c (mpn_diff_smaller_p): Rewrote function. Tried + to explain how it works. + (slow_diff_smaller_p, wrap_mpn_diff_smaller_p) [WANT_ASSERT]: Use + CPP to wrap assertion checks around all calls to + mpn_diff_smaller_p. + + * mpn/generic/hgcd.c (mpn_addmul2_n_1) [nails]: Fixed carry handling. + + * mpn/generic/hgcd.c (mpn_diff_smaller_p) [nails]: Use + GMP_NUMB_MAX, not MP_LIMB_T_MAX. + (mpn_hgcd_itch): Improved size calculation. + (mpn_hgcd_max_recursion): Moved function from qstack.c. Should to + be recompiled when HGCD_SCHOENHAGE_THRESHOLD is tuned. + + * mpn/generic/qstack.c (mpn_hgcd_max_recursion): ... moved from + here. + +2003-12-19 Torbjorn Granlund + + * tests/mpf/t-get_d.c: Print message before aborting. + + * mpn/generic/hgcd2.c (mpn_hgcd2): Substitute always-zero variable + with 0. Remove bogus comment. + + * mpn/generic/get_d.c: Make ONE_LIMB case actually work for nails. + +2003-12-18 Niels Möller + + * mpn/generic/hgcd.c (hgcd_update_r): Assert that the output r2 is + smaller than the input r1. + +2003-12-18 Torbjorn Granlund + + * mpz/get_d.c: Don't include longlong.h. + + * tests/mpz/t-mul.c (ref_mpn_mul): Handle un == vn specially, to avoid + a dummy r/w outside of allocated area. + +2003-12-18 Kevin Ryde + + * mpn/alpha/unicos.m4 (ALIGN): Add comments on what GCC does. + + * configure.in (fat setups), acinclude.m4 (GMP_INIT): Obscure + include() from automake 1.8 aclocal. + * acinclude.m4: Quote names in AC_DEFUN, for automake 1.8 aclocal. + +2003-12-17 Niels Möller + + * tune/common.c (speed_mpn_hgcd, speed_mpn_hgcd_lehmer) [nails]: + Enabled code also for GMP_NAIL_BITS > 0. + * tune/speed.c [nails]: Enable speed_mpn_hgcd and + speed_mpn_hgcd_lehmer. + * tune/tuneup.c (tune_hgcd) [nails]: Likewise. + + * mpn/generic/gcd.c [nails]: Use Schönhage's algorithm also for + GMP_NAIL_BITS > 0. + + * mpn/generic/hgcd.c [nails]: Enable the code for GMP_NAIL_BITS > 0. + (MPN_EXTRACT_LIMB) [nails]: Handle nails. + (__gmpn_hgcd_sanity): Allocate temporaries on the heap, not on the + stack. Also check that r[i] >= r[i+1]. + (mpn_hgcd2_lehmer_step) [nails]: Handle nails. + (mpn_hgcd_lehmer): When we temporarily have r3 > r2, avoid + trigging that assert in __gmpn_hgcd_sanity. + (mpn_hgcd): Likewise. + + * mpn/generic/hgcd2.c (div2) [nails]: Alternative nail-aware + version. + (SUB_2): New macro of Kevin's, which reduces do sub_ddmmss in the + non-nail case. + (HGCD2_STEP): Use SUB_2, not sub_ddmmss. Added alternative version + for K&R compilers. + (mpn_hgcd2) [nails]: Use SUB_2, not sub_ddmmss. New nail-aware + code for checking Jebelean's condition. + +2003-12-13 Kevin Ryde + + * mpq/get_d.c: Amend comments per mpn_get_d change. + (limb2dbl): Remove, no longer used. + + * gmp-impl.h (DIVREM_1_NORM_THRESHOLD etc) [nails]: Correction to + comments, MP_SIZE_T_MAX means preinv never. + + * gmp-impl.h (DIVEXACT_1_THRESHOLD, MODEXACT_1_ODD_THRESHOLD) [nails]: + Remove overrides, divexact_1 and modexact_1 have been nailified. + + * mpz/inp_str.c (mpz_inp_str_nowhite): Use ASSERT_ALWAYS for EOF value + requirement. + + * tests/refmpn.c (refmpn_rsh1add_n, refmpn_rsh1sub_n): Parens around + GMP_NUMB_BITS - 1 with ">>", to quieten gcc -Wall. + * tests/t-constants.c (main), tests/t-count_zeros.c (check_clz), + tests/t-modlinv.c (one), tests/mpz/t-jac.c (try_si_zi), + tests/mpq/t-get_d.c (check_onebit): : Correction to printfs. + * tests/mpn/t-fat.c: Add for memcpy. + * tests/mpz/t-scan.c (check_ref): Remove unused variable "isigned". + * tests/mpq/t-get_d.c (check_onebit): Remove unused variable "limit". + * tests/mpf/t-set_si.c, tests/mpf/t-set_ui.c (check_data): Braces for + initializers. + * tests/devel/try.c (mpn_divexact_by3_fun, mpn_modexact_1_odd_fun): + Correction to return values. + + * doc/gmp.texi (Miscellaneous Integer Functions): Note mpz_sizeinbase + can be used to locate the most significant bit. Reword a bit for + clarity. + +2003-12-12 Niels Möller + + * mpn/generic/hgcd.c (__gmpn_hgcd_sanity): Fixed stack buffer + overrun. + * mpn/generic/hgcd.c: Improved comments. + +2003-12-11 Torbjorn Granlund + + * gmp-impl.h: Change asm => __asm__, tabify. + * mpz/get_d_2exp.c: Likewise. + * mpf/get_d_2exp.c: Likewise. + + * tests/cxx/t-ops.cc: #if .. #endif out tests that cause ambiguities. + +2003-12-10 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Generate operands with sizes as a geometric + progression, to allow for larger operands and less varying timing. + + * tune/tuneup.c (tune_gcd_schoenhage): Set param.step_factor. + (tune_hgcd): Likewise. + +2003-12-10 Kevin Ryde + + * demos/perl/test.pl: Should be $] for perl version in old perl. + + * configure.in (sparc64-*-*): Single block of gcc configs for all + systems, on unknown systems try both ABI 32 and 64. + + * configure.in (LIBGMP_LDFLAGS, LIBGMPXX_LDFLAGS): New AC_SUBSTs with + options to generate .def files with windows DLLs. + * Makefile.am (libgmp_la_LDFLAGS, libgmpxx_la_LDFLAGS): Use them. + + * mpn/generic/gcd.c: Use ABOVE_THRESHOLD / BELOW_THRESHOLD, to follow + convention and cooperate with tune/tuneup.c. + + * tune/tuneup.c (tune_gcd_schoenhage): Increase max_size to 3000, side + default 1000 is approx the crossover point on athlon. + + * tune/common.c, tune/speed.c, tune/speed.h, tune/speed-ext.c, + tune/tuneup.c (SPEED_TMP_ALLOC_LIMBS): Take variable as parameter + rather than returning a value, avoids alloca in a function call. + * tune/common.c, tune/speed.h (speed_tmp_alloc_adjust): Remove, now + inline in SPEED_TMP_ALLOC_LIMBS, and using ptr-NULL for alignment + extraction. + + * gmpxx.h (__gmp_binary_equal, __gmp_binary_not_equal, + __gmp_binary_less, __gmp_binary_less_equal, __gmp_binary_greater, + __gmp_binary_greater_equal, __gmp_cmp_function): Use mpfr_cmp_si and + mpfr_cmp_d. + * tests/cxx/t-ops.cc: Exercise this. + + * demos/perl/Makefile.PL: Don't install sample.pl and test2.pl. + + * demos/perl/GMP.xs (use_sv): Prefer PV over IV or NV to avoid any + rounding. + * demos/perl/test.pl: Exercise this. + + * demos/perl/GMP/Mpf.pm (overload_string): Corrections to $# usage. + * demos/perl/test.pl: Exercise this. + +2003-12-08 Kevin Ryde + + * demos/perl/GMP.pm: Correction to canonicalize example. + + * demos/perl/GMP.xs: New type check scheme, support magic scalars, + support UV when available. Remove some unused local variables. + (coerce_long): Check range of double. + (get_d_2exp): Remove stray printf. + + * demos/perl/test.pl: Exercise magic, rearrange to make it clearer + what's being tested. + +2003-12-07 Kevin Ryde + + * mpn/generic/hgcd.c (mpn_hgcd): Use BELOW_THRESHOLD, to follow the + convention of N for strtol. + + * tests/misc/t-scanf.c (test_sscanf_eof_ok): New function. + (check_misc): Use it to suppress tests broken by libc. + And should be EOF rather than -1 in various places. + +2003-12-06 Torbjorn Granlund + + * tune/common.c (speed_mpn_hgcd, speed_mpn_hgcd_lehmer): + Move SPEED_TMP_ALLOC_LIMBS invocations out from calls. + + * mpn/generic/get_str.c (mpn_get_str, POW2_P case): + Don't append extra '\0' byte. + +2003-12-05 Niels Möller + + * tune/common.c (speed_mpn_hgcd_lehmer, speed_mpn_hgcd): + Updated for the renaming hgcd_sanity -> ASSERT_HGCD. + + * mpn/generic/gcd.c (gcd_schoenhage): TMP_DECL must be the final + declaration in the declaration section of a block. + + * tune/speed.h (mpn_gcd_accel): Added prototype. + +2003-12-05 Torbjorn Granlund + + * randmt.c (__gmp_mt_recalc_buffer): Put parens around "&" expressions + inside "!=". + + * mpf/get_str.c: Remove unused variable "fracn". + +2003-12-03 Kevin Ryde + + * configure.in, Makefile.am (LIBGMP_LDFLAGS, LIBGMPXX_LDFLAGS): New + AC_SUBSTs, use them to create .def files with Windows DLLs. + * doc/gmp.texi (Notes for Particular Systems): Update notes on mingw + DLL with MS C. + + * mpz/export.c: Allow NULL for countp. + * doc/gmp.texi (Integer Import and Export): Describe this. + Suggested by Jack Lloyd. + + * mpn/x86/p6/aors_n.asm: New file, grabbing the K7 code. + Superiority of this reported by Patrick Pelissier. + +2003-11-30 Kevin Ryde + + * mpn/alpha/ev67/popcount.asm, mpn/alpha/ev67/hamdist.asm: New files. + + * mpn/alpha/ev67: New directory. + * configure.in (alphaev67, alphaev68, alphaev7*): Use it. + + * doc/gmp.texi (GMPrefu, GMPpxrefu): Change back to plain ref and + pxref, remove macros. + (GMPreftopu, GMPpxreftopu): Remove URL parameter, rename to GMPreftop + and GMPpxreftop. + (Debugging): Remove debauch, seems to have disappeared. + (Language Bindings): Corrections to URLs for CLN, Omni F77, Pike. + +2003-11-29 Kevin Ryde + + * demos/perl/GMP/Mpf.pm (overload_string): Use $OFMT to avoid warnings + about $#. + + * demos/perl/GMP.xs (fits_slong_p): Use LONG_MAX+1 to avoid possible + rounding of 0x7F..FF in a double on 64-bit systems. + + * configure.in (ppc601-*-*): Remove this case, it never matched + anything, the name adopted is powerpc601. + (powerpc601-*-*): Use gcc -mcpu=601, xlc -qarch=601. + + * configure.in: Introduce ${cc}_cflags_maybe, used if they work. + (*sparc*-*-*) [ABI=32]: Add gcc_cflags_maybe=-m32 to force that mode. + + * doc/gmp.texi (Introduction to GMP): Add AMD64 to optimizations list. + (Build Options): Add cpu types alphaev7 and amd64. Update texinfo + html cross reference. + +2003-11-28 Niels Möller + + * tune/tuneup.c (tune_hgcd): Disable if GMP_NAIL_BITS > 0. + * tune/speed.c (routine): Likewise. + * tune/common.c (speed_mpn_hgcd, speed_mpn_hgcd_lehmer): Likewise. + + * mpn/generic/gcd.c, mpn/generic/hgcd.c, mpn/generic/hgcd2.c + [GMP_NAIL_BITS]: Disabled new code if we have nails. + + * mpn/generic/gcd.c (MPN_LEQ_P): Copied macro definition (needed + for compilation with --enable-assert). + + * tune/tuneup.c (hgcd_schoenhage_threshold, + gcd_schoenhage_threshold): New variables. + (tune_hgcd, tune_gcd_schoenhage): New functions. + (all): Call tune_hgcd and tune_gcd_schoenhage. + + * tune/common.c (speed_mpn_hgcd, speed_mpn_hgcd_lehmer) + (speed_mpn_gcd_accel): New functions. + * tune/speed.c (routine): Added mpn_hgcd, mpn_hgcd_lehmer and + mpn_gcd _accel. + * tune/speed.h: Added corresponding prototypes. + + * tune/gcd_accel.c: New file. + + * tune/gcd_bin.c (GCD_SCHOENHAGE_THRESHOLD): Set to MP_SIZE_T_MAX. + + * tune/Makefile.am (libspeed_la_SOURCES): Added gcd_accel.c. + (TUNE_MPN_SRCS_BASIC): Added hgcd.c. + + * mpn/x86/k7/gmp-mparam.h (HGCD_SCHOENHAGE_THRESHOLD) + (GCD_SCHOENHAGE_THRESHOLD): Tuned values. + + * mpn/generic/gcd.c (mpn_gcd, gcd_binary_odd): Renamed the + old mpn_gcd function (which implements accelerated binary gcd) to + gcd_binary_odd. + (gcd_binary): New function, with the additional book keeping + needed when using gcd_binary_odd to compute the gcd of non-odd + numbers. + (hgcd_tdiv): New function. + (gcd_lehmer): New function, currently #if:ed out. + (hgcd_start_row_p): New function, duplicated from hgcd.c. + (gcd_schoenhage_itch): New function. + (gcd_schoenhage): New function. + (mpn_gcd): New advertised gcd function, which calls + mpn_gcd_binary_odd or mpn_gcd_schoenhage, depending on the size of + the input. + + * mpn/generic/hgcd.c (mpn_hgcd2_lehmer_step): Renamed function + (was lehmer_step), and made non-static. Updated callers. + + * gmp-impl.h (GCD_LEHMER_THRESHOLD): #if:ed out this macro. + (mpn_hgcd2_lehmer_step): Added prototype. + +2003-11-27 Niels Möller + + * tests/mpz/t-gcd.c (gcd_values): Moved definition, so that we + don't need to forward declare the array. + +2003-11-26 Niels Möller + + * mpn/generic/hgcd.c (mpn_hgcd2_fix): Deleted duplicate definition + (the function belongs to hgcd2.c). + +2003-11-26 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Generate random operands up to 32767 bits; + decrease # of test to 1000. + (gcd_values): Remove oversize test case. + +2003-11-26 Niels Möller + + * gmp-impl.h: Added name mangling for hgcd-related functions. Also + use __GMP_PROTO. + (MPN_LEQ_P, MPN_EXTRACT_LIMB): Moved macros to hgcd.c. + * mpn/generic/hgcd.c, mpn/generic/hgcd2.c, mpn/generic/qstack.c: + Adapted to name changes. + + * tests/mpz/t-gcd.c (main): Added some tests with non-random + input. + +2003-11-25 Niels Möller + + * gmp-impl.h (MPN_LEQ_P, MPN_EXTRACT_LIMB): New macros. + (struct qstack, struct hgcd2_row, struct hgcd2, struct hgcd_row) + (struct hgcd): New structs. Also added prototypes for new hgcd, + hgcd2, qstack and gcd functions. + + * configure.in (gmp_mpn_functions): Added hgcd2, hgcd and qstack. + + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Added hgcd2.c, + hgcd.c and qstack.c. + + * mpn/generic/hgcd.c, mpn/generic/hgcd2.c, mpn/generic/qstack.c: + New files, needed for the sub-quadratic gcd. + +2003-11-25 Kevin Ryde + + * doc/gmp.texi (Language Bindings): Add Axiom. + +2003-11-22 Kevin Ryde + + * mpn/alpha/README: More notes on assembler syntax variations. + + * mpn/alpha/alpha-defs.m4, mpn/alpha/unicos.m4 (unop): Should be ldq_u + not bis, and move to alpha-defs.m4 since it can be happily used + everywhere. + + * mpn/alpha/alpha-defs.m4, mpn/alpha/default.m4, mpn/alpha/unicos.m4 + (bigend): Move to alpha-defs.m4 and base it on HAVE_LIMB_BIG_ENDIAN or + HAVE_LIMB_LITTLE_ENDIAN, so as not to hard code system endianness. + + * mpn/alpha/alpha-defs.m4: New file. + * configure.in (alpha*-*-*): Use it. + +2003-11-21 Kevin Ryde + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-11-21. + + * mpn/alpha/ev5/com_n.asm: Change "not" to "ornot r31", since "not" + isn't recognised by on Cray Unicos. Add missing "gp" to PROLOGUE. + * mpn/alpha/README: Add a note on "not". + +2003-11-19 Torbjorn Granlund + + * mpn/alpha/aorslsh1_n.asm: Slightly rework feed-in code, avoiding + spurious reads beyond operand limits. + + * mpn/alpha/ev5/com_n.asm: Add ASM_START/ASM_END. + + * mpn/generic/mul_fft.c (mpn_fft_zero_p): Remove unused function. + (mpn_lshift_com): Make static, nailify properly. + +2003-11-19 Kevin Ryde + + * mpn/generic/diveby3.c: Use a "q" variable to make it clearer what + the code is doing. + + * mpn/powerpc32/750/lshift.asm, mpn/powerpc32/750/rshift.asm: New + files. + + * mpn/alpha/ev5/com_n.asm: New file. + + * doc/gmp.texi (Assembler Functional Units, Assembler Writing Guide): + New sections by Torbjorn, tweaked by me. + +2003-11-17 Torbjorn Granlund + + * mpn/powerpc32: Add power4/powerpc970 cycle counts. + Use cmpwi instead of cmpi to placate darwin. + +2003-11-15 Kevin Ryde + + * config.guess: Add comments on MacOS "machine" command. + + * tests/devel/try.c (main): Use gmp_randinit_default explicitly on + __gmp_rands, since RANDS doesn't allow seeding. + + * doc/gmp.texi (Assigning Integers): Remove notes on possible change + to disallow whitespace, this would be an incompatible change and + really can't be made. + (Toom 3-Way Multiplication): Updates for Paul's new code. + + * mpn/generic/mul_n.c (toom3_interpolate, mpn_toom3_mul_n): Put + if/else braces around whole of #if code, for readability. + + * tests/refmpn.c (refmpn_addlsh1_n, refmpn_sublsh1_n, + refmpn_rsh1add_n, refmpn_rsh1sub_n): Add ASSERTs for operand overlaps + etc. + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-11-15. + +2003-11-14 Torbjorn Granlund + + * mpn/alpha/aorslsh1_n.asm: Use Cray-friendly syntax for "br". + +2003-11-13 Torbjorn Granlund + + * mpn/alpha/aorslsh1_n.asm: New file. + +2003-11-12 Kevin Ryde + + * acinclude.m4 (GMP_PROG_CC_WORKS): Add case provoking AIX power2 + assembler, test code by Torbjorn. + * configure.in (power*-*-*): Add a comment about -mcpu=rios2 fallback. + + * tune/speed.c (main): Use gmp_randinit_default explicitly on + __gmp_rands, since RANDS doesn't allow seeding. + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-11-12. + + * gmp-impl.h, randmt.h (__gmp_randinit_mt_noseed): Move prototype to + gmp-impl.h, for use by RANDS. + + * mpn/Makeasm.am (.s, .S, .asm): Quote $< in test -f, per automake. + (.obj): Use test -f and $(CYGPATH_W) as per automake. + +2003-11-11 Kevin Ryde + + * configure.in: Make umul and udiv standard-optional objects, rather + than under various extra_functions. + + * mpn/pa32/hppa1_1/pa7100/add_n.asm, + mpn/pa32/hppa1_1/pa7100/addmul_1.asm, + mpn/pa32/hppa1_1/pa7100/lshift.asm, + mpn/pa32/hppa1_1/pa7100/rshift.asm, + mpn/pa32/hppa1_1/pa7100/sub_n.asm, + mpn/pa32/hppa1_1/pa7100/submul_1.asm: Use LDEF for labels. + + * mpf/set_str.c: Don't use memcmp for decimal point testing, just a + loop is enough and avoids any chance of memcmp reading past the end of + the given string. + + * randmts.c, randmt.h: New files. + * Makefile.am (libgmp_la_SOURCES): Add them. + * randmt.c: Move seeding to randmts.c, common defines in randmt.h. + * gmp-impl.h (RANDS): Use __gmp_randinit_mt_noseed. + * tests/misc.c (tests_rand_start): Use gmp_randinit_default + explicitly, not RANDS. + + * mpn/ia64/ia64-defs.m4 (PROLOGUE_cpu): Use 32-byte alignment, for the + benefit of itanium 2. + * mpn/ia64/gcd_1.asm: Remove own .align 32. + + * mpn/ia64/ia64-defs.m4 (ALIGN): New define, using IA64_ALIGN_OK. + * mpn/ia64/hamdist.asm: Use ALIGN instead of .align. + + * acinclude.m4 (GMP_ASM_IA64_ALIGN_OK): New macro. + * configure.in (IA64_PATTERN): Use it. + * mpn/ia64/README: Add notes on gas big endian align problem. + +2003-11-10 Torbjorn Granlund + + * mpn/ia64/mul_1.asm: Rewrite. + +2003-11-08 Torbjorn Granlund + + * mpn/x86/aors_n.asm: Align loop to a multiple of 16. Also align + M4_function_n to a multiple of 16, to minimize alignment padding. + Update P6 cycle counts reflecting improvements with new alignment. + +2003-11-07 Kevin Ryde + + * gmp-impl.h (HAVE_HOST_CPU_alpha_CIX): New define. + (ULONG_PARITY, popc_limb): Use it, to pick up ev7 as well as 67 and 68. + * longlong.h (count_leading_zeros, count_trailing_zeros): Ditto. + + * doc/gmp.texi (Notes for Package Builds): Add notes on multi-ABI + system packaging. + (ABI and ISA): Add GNU/Linux ABI=64. + (Binary GCD): Add notes on 1x1 GCD algorithms. + + * mpn/alpha/README: Add some literature references. + + * mpn/ia64/mode1o.asm: Various corrections to initial checkin. + * mpn/ia64/ia64-defs.m4 (ASSERT): Correction to arg quoting. + +2003-11-05 Torbjorn Granlund + + * mpn/powerpc64/linux64.m4: New file. + * configure.in (POWERPC64_PATTERN): Handle *-*-linux*. + Use linux64.m4. + + * mpn/ia64/logops_n.asm: New file. + +2003-11-05 Kevin Ryde + + * tune/freq.c (freq_sysctl_hw_model): Relax to just look for "%u MHz", + for the benefit of sparc cypress under netbsd 1.6.1. + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-11-05. + + * mpn/alpha/ev5/dive_1.c: New file. + + * configure.in (x86_64-*-*): Accept together with amd64-*-*. + + * tune/speed.c: Check range of -x,-y,-w,-W alignment specifiers. + * tune/speed.h (CACHE_LINE_SIZE): Amend comments. + +2003-11-04 Torbjorn Granlund + + * tune/speed.c: Fix typo in testing HAVE_NATIVE_mpn_modexact_1_odd. + +2003-11-03 Kevin Ryde + + * mpn/ia64/hamdist.asm: New file. + * mpn/ia64/mode1o.asm: New file. + * mpn/ia64/ia64-defs.m4 (ASSERT): New macro. + + * tests/mpz/t-set_d.c (check_2n_plus_1): New test. + +2003-11-01 Kevin Ryde + + * mpz/fac_ui.c (BSWAP_ULONG) [limb==2*long]: Remove this case, it + provokes code gen problems on HP cc. + (BSWAP_ULONG) [generic]: Rename __dst variable to avoid conflicts with + BITREV_ULONG. + Fix by Jason Moxham. + + * mpn/powerpc32/mode1o.asm: Use 16-bit i*i for early out, no need to + truncate divisor. Amend stated 750/7400 speeds, and note operands + that give the extremes. + + * mpz/set_d.c: Don't use a special case for d < MP_BASE_AS_DOUBLE, gcc + 3.3 -mpowerpc64 on darwin gets ulonglong->double casts wrong. + + * mpn/generic/diveby3.c: Show a better style carry handling in the + alternative pipelined sample code. + + Revert this, the longlong.h macros need -mpowerpc64: + * acinclude.m4 (GMP_GCC_POWERPC64): New macro. + * configure.in (powerpc64-*-darwin*): Use it to exclude -mpowerpc64 + when bad. + +2003-10-31 Torbjorn Granlund + + * mpn/powerpc64/mode64/submul_1.asm: Move an instruction to save a + cycle on POWER4. + + * mpn/powerpc64/mode64/divrem_1.asm: Fix several syntax problems + revealed on Mac OS X. + + * mpn/powerpc64/mode64/*.asm: Add cycle counts for POWER4. + + * mpn/powerpc64/sqr_diagonal.asm: Rewrite to save a cycle on POWER4. + +2003-10-31 Kevin Ryde + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-10-31. + + * mpn/powerpc64/README: Add subdirectory organisation notes. + + * tests/mpn/t-get_d.c: Don't use limits.h, LONG_MIN is wrong on gcc + 2.95 with -mcpu=ultrasparc. + + * acinclude.m4 (GMP_GCC_POWERPC64): New macro. + * configure.in (powerpc64-*-darwin*): Use it to exclude -mpowerpc64 + when bad. + + * configure.in (powerpc64-*-darwin*) [ABI=mode32]: Use gcc -mcpu flags. + + * mpn/ia64/divrem_1.asm, mpn/ia64/gcd_1.asm: Use "C" for comments. + * mpn/ia64/README, mpn/ia64/ia64-defs.m4: Note this. + + * mpn/ia64/ia64-defs.m4: Renamed from default.m4, per other defs files. + * configure.in (IA64_PATTERN): Update GMP_INCLUDE_MPN. + + * doc/gmp.texi (Notes for Particular Systems): Remove m68k ABI notes + for -mshort and PalmOS, now works. + (References): Correction, GMP Square Root proof already there, just + wanting URL from RRRR 4475. + +2003-10-29 Kevin Ryde + + * configure.in (sparc*-*-*): Use gcc -m32 when that option works, to + force 32-bit mode on dual 32/64 configurations like GNU/Linux. + (sparc64-*-linux*): Add support for ABI=64. + + * mpn/generic/pre_divrem_1.c: In fraction part, use CNST_LIMB(0) with + udiv_qrnnd_preinv to avoid warning about shift > type. + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-10-29. + + * tests/cxx/t-istream.cc: Avoid tellg() checks if putback() doesn't + update that, avoids certain g++ 2.96 problems. + + * tests/mpn/t-fat.c: New file. + * tests/mpn/Makefile.am (check_PROGRAMS): Add it. + + * configure.in (CPUVEC_INSTALL, ITERATE_FAT_THRESHOLDS): New macros + for fat.h. + * mpn/x86/fat/fat.c (__gmpn_cpuvec_init): Use CPUVEC_INSTALL instead + of memcpy. Correction to location of "initialized" set. Improve + various comments. + +2003-10-27 Torbjorn Granlund + + * mpn/sparc64/mul_1.asm: Change addcc => add in a few places. + * mpn/sparc64/addmul_1.asm: Likewise. + + * mpn/sparc32/v9/mul_1.asm: Apply cross-jumping. + * mpn/sparc32/v9/addmul_1.asm: Likewise. + * mpn/sparc32/v9/submul_1.asm: Likewise. + * mpn/sparc32/v9/sqr_diagonal.asm: Likewise. + +2003-10-27 Kevin Ryde + + * tests/cxx/t-misc.cc: Don't use , on g++ 2.95.4 (debian 3.0) + -mcpu=ultrasparc LONG_MIN is wrong and kills the compile. + + * tests/cxx/t-istream.cc: Correction to tellg tests, don't assume + streampos is zero based. + + * configure.in (HAVE_HOST_CPU_FAMILY_alpha): New define for config.h. + * mpn/generic/get_d.c: Use it instead of __alpha for alpha workaround, + since Cray cc doesn't define __alpha. + + * mpn/x86/README: Revise PIC coding notes a bit, add gcc visibility + attribute. + +2003-10-25 Kevin Ryde + + * mpn/ia64/gcd_1.asm: New file. + + * tune/many.pl: Allow for PROLOGUE(fun,...), as used on alpha. + + * doc/gmp.texi (C++ Formatted Input): Describe base indicator handling. + + * tests/cxx/t-istream.cc: New file. + * tests/cxx/Makefile.am: Add it. + + * cxx/ismpznw.cc: New file, integer input without whitespace ... + * cxx/ismpz.cc: ... from here. + * gmp-impl.h (__gmpz_operator_in_nowhite): Add prototype. + * cxx/ismpq.cc: Rewrite using mpz input routines. Change to accept a + separate base indicator on numerator and denominator. Fix base + indicator case where "123/0456" would stop at "123/0". + * Makefile.am, cxx/Makefile.am: Add cxx/ismpznw.cc. + + * tests/mpz/t-set_d.c: New file, derived from tests/mpz/t-set_si.c + * tests/mpz/Makefile.am (check_PROGRAMS): Add it. + + * mpn/m68k/lshift.asm, mpn/m68k/rshift.asm: Support 16-bit int and + stack alignment. + * mpn/m68k/README: Add notes on this. + * configure.in (SIZEOF_UNSIGNED): New define in config.m4. + * mpn/m68k/m68k-defs.m4 (m68k_definsn): Add cmpw, movew. + Reported by Patrick Pelissier. + + * mpn/m68k/t-m68k-defs.pl: Don't use -> with hashes, to avoid + deprecation warnings from perl 5.8. + + * configure.in (viac3-*-*): Use just x86/pentium in $path not x86/p6. + If gcc is to be believed the old C3s don't have cmov. + + * Makefile.am: Amend comments about not building from libtool + convenience libraries. + + * mpn/asm-defs.m4 (PROLOGUE): Use m4_file_seen, for correct filename + in missing EPILOGUE error messages. + (m4_file_seen): Amend comments about where used. + + * Makefile.am (CXX_OBJECTS): Remove $U, C++ files are not subject to + ansi2knr rules. + + * gmp-h.in (mpn_divmod_1): Use __GMP_CAST, to avoid warnings in + applications using g++ -Wold-style-cast. + + * mpn/z8000/README: New file. + +2003-10-22 Kevin Ryde + + * mpn/generic/get_d.c (CONST_1024, CONST_NEG_1023, + CONST_NEG_1022_SUB_53): Replace ALPHA_WORKAROUND with a non-gcc-ism, + and use on Cray Unicos alpha too, which has the same problem. + + * configure.in (powerpc64-*-darwin*): Make ABI=32 available as the + final fallback, remove mode64 until we know how it will work. + + * doc/gmp.texi (Build Options): Add powerpc970 to available CPUs. + (ABI and ISA): Add mode32 for Darwin. + + * configure.in (gettimeofday): Use an explicit AC_TRY_LINK, to avoid + known autoconf 2.57 problems with gettimeofday in AC_CHECK_FUNCS on + HP-UX. + + * configure.in (powerpc*-*-*): Use ABI=32 instead of ABI=standard for + the default 32-bit ABI. Fixes powerpc64-*-aix* which is documented as + choices "aix64 32" but had "aix64 standard". + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-10-22. + + * doc/gmp.texi (Notes for Particular Systems): Note m68k gcc -mshort + and PalmOS calling conventions not supported. Reported by Patrick + Pelissier. + (References): Add Paul Zimmermann's Inria 4475 paper. + +2003-10-21 Torbjorn Granlund + + * mpn/ia64/submul_1.asm: Slightly reschedule loop to accommodate + Itanium 2 getf.sig latency. + +2003-10-21 Kevin Ryde + + * tests/mpn/t-instrument.c: Add mpn_addlsh1_n, mpn_rsh1add_n, + mpn_rsh1sub_n, mpn_sub_nc, mpn_sublsh1_n. Typo in mpn_preinv_divrem_1 + conditional. + +2003-10-20 Torbjorn Granlund + + * mpn/powerpc64/mode32/add_n.asm: New file. + * mpn/powerpc64/mode32/sub_n.asm: New file. + * mpn/powerpc64/mode32/mul_1.asm: New file. + * mpn/powerpc64/mode32/addmul_1.asm: New file. + * mpn/powerpc64/mode32/submul_1.asm: New file. + +2003-10-19 Torbjorn Granlund + + * longlong.h (AMD64): __x86_64__ => __amd64__. + (64-bit powerpc): Only define carry-dependent macros if + !_LONG_LONG_LIMB. + + * acinclude.m4 (POWERPC64_PATTERN): Add powerpc970-*-*. + + * configure.in (POWERPC64_PATTERN): Handle *-*-darwin*. + (POWERPC64_PATTERN, *-*-aix*): Prepend powerpc64/mode64 to path_aix64. + + * mpn/powerpc64/mode64/mul_1.asm: Change cal => addi. + * mpn/powerpc64/mode64/addmul_1.asm: Likewise. + * mpn/powerpc64/mode64/submul_1.asm: Likewise. + * mpn/powerpc64/sqr_diagonal.asm: Likewise. + + * mpn/powerpc64/mode64/mul_1.asm: Move from "..". + * mpn/powerpc64/mode64/addmul_1.asm: Likewise. + * mpn/powerpc64/mode64/submul_1.asm: Likewise. + * mpn/powerpc64/mode64/divrem_1.asm: Likewise. + * mpn/powerpc64/mode64/rsh1sub_n.asm: Likewise. + * mpn/powerpc64/mode64/add_n.asm: Likewise. + * mpn/powerpc64/mode64/addsub_n.asm: Likewise. + * mpn/powerpc64/mode64/sub_n.asm: Likewise. + * mpn/powerpc64/mode64/addlsh1_n.asm: Likewise. + * mpn/powerpc64/mode64/diveby3.asm: Likewise. + * mpn/powerpc64/mode64/rsh1add_n.asm: Likewise. + * mpn/powerpc64/mode64/sublsh1_n.asm: Likewise. + + * mpn/powerpc64/lshift.asm: Handle mode32 ABI. + * mpn/powerpc64/rshift.asm: Likewise. + * mpn/powerpc64/umul.asm: Likewise. + + * tune/powerpc64.asm: Make it actually work. + +2003-10-19 Kevin Ryde + + * mpn/generic/get_d.c: Add a workaround for alpha gcc signed constant + comparison bug. + + * gmpxx.h (gmp_randclass gmp_randinit_lc_2exp_size constructor): Throw + std::length_error if size is too big. + * tests/cxx/t-rand.cc (check_randinit): Exercise this. + + * mpn/x86/pentium4/sse2/addlsh1_n.asm: New file, derived in part from + mpn/x86/pentium4/sse2/add_n.asm. + + * doc/gmp.texi (C++ Interface Integers, C++ Interface Rationals, C++ + Interface Floats): Note std::invalid_argument exception for invalid + strings to constructors and operator=. + (C++ Interface Random Numbers): Note std::length_error exception for + size too big in gmp_randinit_lc_2exp_size. + +2003-10-18 Kevin Ryde + + * mpfr/*: Update to mpfr-2-0-2-branch 2003-10-18. + + * gmpxx.h (mpz_class, mpq_class, mpf_class, mpfr_class constructors + and operator= taking string or char*): Throw std::invalid_argument if + string cannot be converted. + * tests/cxx/t-constr.cc, tests/cxx/t-assign.cc: Exercise this. + + * cxx/ismpz.cc, cxx/ismpq.cc, cxx/ismpf.cc: Use istream std::locale + ctype facet for isspace when available. Only accept space at the + start of the input, same as g++ libstdc++. Use ASSERT_NOCARRY to + check result of mpz_set_str etc. + * cxx/ismpf.cc: Don't accept "@" for exponent indicator. + + * tune/speed.c, tune/speed.h, tune/common.c, tune/Makefile.am: Remove + _open and _mpn variants of mpn_toom3_mul_n, only one style now. + * tune/mul_n_open.c, tune/mul_n_mpn.c: Remove files. + + * gmp-impl.h (LIMB_HIGHBIT_TO_MASK): New macro. + (udiv_qrnnd_preinv2, udiv_qrnnd_preinv2gen): Use it. + + * tests/mpz/t-import.c, tests/mpz/t-export.c: Use octal for character + constants, hex is an ANSI-ism. + + * mpn/alpha/ev5/mode1o.c: Corrections to ASSERTs, as per + mpn/generic/mode1o.c. + + * mpn/generic/diveby3.c: Add commented out alternative code and notes + for taking the multiply off the dependent chain. Amend/clarify some + of the other comments. + + * configure.in (powerpc970-*-*): Use gcc -mcpu=970 when available. + (powerpc7400-*-*): Fallback on gcc -mcpu=750 if -mcpu=7400 not + available. + + * doc/gmp.texi (C++ Formatted Input): Note locale digit grouping not + supported. + (C++ Formatted Input, C++ Formatted Output): Cross reference class + interface on overloading. + + * mpn/m68k/README: Add various ideas from doc/tasks.html. + + * mpn/m88k/README: New file. + +2003-10-16 Torbjorn Granlund + + * config.sub: Recognize powerpc970. + +2003-10-15 Torbjorn Granlund + + * config.guess: Recognize powerpc970 under MacOS. + +2003-10-15 Kevin Ryde + + * configure.in, acinclude.m4 (GMP_C_RIGHT_SHIFT): New test. + * gmp-impl.h (LIMB_HIGHBIT_TO_MASK): New macro. + (udiv_qrnnd_preinv2, udiv_qrnnd_preinv2gen): Use it. + + * mpn/amd64/amd64-defs.m4: New file, with a non-aligning PROLOGUE. + * configure.in (amd64-*-*): Use it. + * mpn/amd64/addlsh1_n.asm: Add ALIGN(16). + + * mpfr/*: Update to mpfr cvs 2003-10-15. + + * mpn/generic/get_d.c: Rewrite, simplifying and truncating towards + zero unconditionally. + * tests/mpn/t-get_d.c: Add various further tests. + * gmp-impl.h (FORCE_DOUBLE): New macro. + + * gmp-h.in (__mpz_struct): Add comment on __mpz_struct getting into + C++ mangled function names. + + * doc/gmp.texi (Build Options): Update notes for new doc subdir. + (Low-level Functions): Note mpn functions don't check for zero limbs + etc, it's up to an application to strip. + + * doc/configuration (Configure): mdate-sh now in doc subdir, add + generated fat.h. + +2003-10-14 Torbjorn Granlund + + * mpn/ia64/lorrshift.asm: Rewrite. + + * mpn/ia64/diveby3.asm: Remove explicit bundling; add branch hints. + +2003-10-13 Torbjorn Granlund + + * mpn/ia64/diveby3.asm: New file. + +2003-10-13 Kevin Ryde + + * mpn/powerpc32/mod_34lsub1.asm: New file. + + * mpn/powerpc32/diveby3.asm, mpn/powerpc64/diveby3.asm: src[] in + second operand of mullw, to allow possible early-out, which the + 0xAA..AB inverse cannot give. This improvement noticed by Torbjorn. + + * acinclude.m4 (GMP_ASM_LSYM_PREFIX): Print to config.log whether + local label is purely temporary or appears in object files, for + development purposes. + + * doc/gmp.texi, doc/fdl.texi, doc/texinfo.tex, doc/mdate-sh: Moved + from top-level. + * doc/Makefile.am: New file. + * configure.in (AC_OUTPUT): Add doc/Makefile. + * Makefile.am (SUBDIRS): Move doc subdirectory from EXTRA_DIST. + (info_TEXINFOS, gmp_TEXINFOS): Moved to doc/Makefile.am. + * mpfr/Makefile.am (mpfr_TEXINFOS): fdl.texi now in doc subdir. + (TEXINFO_TEX): texinfo.tex now in doc subdir. + (AM_MAKEINFOFLAGS): Set -I to doc subdir. + + * mpz/and.c: For positive/positive, use mpn_and_n, rate a realloc as + UNLIKELY. + + * mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): Don't test + for high zero limbs. + +2003-10-12 Torbjorn Granlund + + * mpn/powerpc64/diveby3.asm: New file (trivial edits of + powerpc32/diveby3.asm). + + * mpn/powerpc32/diveby3.asm: Update cycle counts with more processors. + * mpn/powerpc32/sqr_diagonal.asm: Likewise. + + * mpn/pa64/add_n.asm: Correct PA8500 cycle counts. + * mpn/pa64/sub_n.asm: Likewise. + + * mpn/m68k/aors_n.asm (INPUT PARAMETERS): Fix typo. + * mpn/m68k/lshift.asm: Likewise. + * mpn/m68k/rshift.asm: Likewise. + + * mpn/m68k/README: Correct an URL; add some STATUS comments. + + * mpn/ia64/aorslsh1_n.asm: Avoid shrp when shl/shr works just as well. + + * mpn/powerpc32/addlsh1_n.asm: New file. + * mpn/powerpc32/sublsh1_n.asm: New file. + +2003-10-12 Kevin Ryde + + * mpn/sparc64/divrem_1.c, mpn/sparc64/mod_1.c: New files. + * mpn/sparc64/sparc64.h (HALF_ENDIAN_ADJ, count_leading_zeros_32, + invert_half_limb, udiv_qrnnd_half_preinv): New macros. + + * gmp-impl.h (udiv_qrnnd_preinv2): Use a ? : for getting the n1 bit, + so as not to depend on signed right shifts being arithmetic. + + * mpn/powerpc32/diveby3.asm: New file. + + * mpn/generic/divrem_1.c: Use CNST_LIMB(0) to avoid warnings from + udiv_qrnnd_preinv about shift count when int + + * mpn/ia64/rsh1aors_n.asm: New file. + + * mpn/asm-defs.m4: Handle rsh1aors_n. + + * configure.in (tmp_mulfunc): Handle rsh1aors_n. + +2003-10-11 Kevin Ryde + + * mpn/x86/pentium4/sse2/diveby3.asm: Remove non-PIC RODATA memory + access for 0xAAAAAAAB constant. + + * gmp-impl.h (popc_limb, ULONG_PARITY) [ev67, ev68]: Add gcc asm + versions using ctpop. + + * mpn/x86/k6/aorsmul_1.asm: Tweak some comments, remove M4_description + and M4_desc_retval used only in comments. + + * mpn/x86/k6/mul_basecase.asm: Add comment on using mpn_mul_1. + +2003-10-09 Torbjorn Granlund + + * mpn/powerpc64/addlsh1_n.asm: Tweak for 0.25 c/l better loop speed. + * mpn/powerpc64/sublsh1_n.asm: Likewise. + +2003-10-09 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-10-09. + + * tests/devel/try.c (_SC_PAGESIZE): Define from _SC_PAGE_SIZE on + systems which use that, eg. hpux 9. + +2003-10-07 Kevin Ryde + + * tune/freq.c (freq_sysctl_hw_model): Correction to last sscanf change. + + * configure.in: Check for psp_iticksperclktick in struct pst_processor. + * tune/freq.c (freq_pstat_getprocessor): Use this. + + * tests/devel/try.c (divisor_array): Add a couple of half-limb values. + + * acinclude.m4 (GMP_PROG_CC_WORKS): Correction to last change, need to + set result "yes" when cross compiling. + +2003-10-06 Torbjorn Granlund + + * mpn/generic/mul_n.c: Use __GMPN_ADD_1/_GMPN_SUB_1 instead of + mpn_add_1 and mpn_sub_1. + + * mpn/pa64/aorslsh1_n.asm: Schedule register save and restore code. + +2003-10-05 Torbjorn Granlund + + * mpn/pa64/mul_1.asm: Misc comment cleanups. + * mpn/pa64/addmul_1.asm: Likewise. + * mpn/pa64/submul_1.asm: Likewise. + + * mpn/pa64/README: Correct cycle counts. + + * mpn/pa64/aorslsh1_n.asm: New file. + +2003-10-04 Kevin Ryde + + * tune/freq.c (freq_sysctl_hw_model, freq_sunos_sysinfo, + freq_sco_etchw, freq_bsd_dmesg, freq_irix_hinv): Demand matching of + MHz etc at end of sscanf format string. In particular need this for + freq_bsd_dmesg on i486-pc-freebsd4.7 to avoid the 486 cpu being used + for the frequency. + + * tests/misc.c, tests/tests.h (tests_setjmp_sigfpe, + tests_sigfpe_handler, tests_sigfpe_done, tests_sigfpe_target, + tests_dbl_mant_bits): New. + + * configure.in (viac3*-*-*): Add gcc VIA c3 options. + + * mpfr/*: Update to mpfr cvs 2003-10-04. + + * tests/refmpn.c (refmpn_addlsh1_n, refmpn_sublsh1_n, + refmpn_rsh1add_n, refmpn_rsh1sub_n): Add ASSERTs for operand overlaps. + * tests/tests.h (refmpn_addlsh1_n, refmpn_sublsh1_n, refmpn_rsh1add_n, + refmpn_rsh1sub_n): Add prototypes. + + * tests/devel/try.c, tune/many.pl: Add mpn_addlsh1_n, mpn_sublsh1_n, + mpn_rsh1add_n, mpn_rsh1sub_n. + +2003-10-03 Torbjorn Granlund + + * tests/refmpn.c (refmpn_addlsh1_n, refmpn_sublsh1_n, refmpn_rsh1add_n, + refmpn_rsh1sub_n): New functions. + +2003-10-03 Paul Zimmermann + + * mpn/generic/mul_n.c (toom3_interpolate): Use mpn_add_1/mpn_sub_1 + instead of MPN_INCR_/MPN_DECR_U. + +2003-10-02 Torbjorn Granlund + + * configure.in (ia64*-*-hpux*): Fall back to +O1, not +O. + +2003-10-02 Kevin Ryde + + * configure.in (ia64*-*-hpux*): For cc, let +O optimization level + fallback if +O3 doesn't work. + + * acinclude.m4 (GMP_PROG_CC_WORKS): Add a test of __builtin_alloca + when available, to pick up Itanium HP-UX cc internal errors in +O2. + Provoking code by Torbjorn. + +2003-10-01 Torbjorn Granlund + + * mpn/ia64/gmp-mparam.h: Retune. + + * mpn/asm-defs.m4: Handle aorslsh1_n. + + * configure.in (tmp_mulfunc): Handle aorslsh1_n. + + * mpn/ia64/aorslsh1_n.asm: New file. + + * mpn/ia64/aors_n.asm: New file, complete rewrite of mpn_add_n and + mpn_sub_n. + * mpn/ia64/add_n.asm: Replace by aors_n.asm. + * mpn/ia64/sub_n.asm: Replace by aors_n.asm. + +2003-10-01 Kevin Ryde + + * acinclude.m4 (GMP_C_DOUBLE_FORMAT): Make bad ARM last byte into a + separate case and consider it non-IEEE, since it looks like this is + due to some sort of restricted or incorrect software floats. + + * demos/calc/Makefile.am: Use automake yacc/lex support, seems fine in + separate objdir now. + + * cxx/dummy.cc: Moved from top-level dummy.cc. + * Makefile.am (libgmpxx_la_SOURCES): Update to cxx/dummy.cc, + correction to comment about this. + +2003-09-30 Torbjorn Granlund + + * demos/pexpr.c: Correct documentation of -split. + (TIME): Remove cast of result to double. + (main): Change timing variables to int. + (main): #ifdef LIMIT_RESOURCE_USAGE, don't convert numbers of more than + 100000 digits. + +2003-09-28 Torbjorn Granlund + + * mpn/*/*.asm: Clean up spacing, tabify. + + * mpn/alpha/rshift.asm: Table cycle counts. + * mpn/alpha/lshift.asm: Likewise. + * mpn/alpha/ev5/rshift.asm: Likewise. + * mpn/alpha/ev5/lshift.asm: Likewise. + * mpn/alpha/ev6/add_n.asm: Likewise. + * mpn/alpha/ev6/sub_n.asm: Likewise. + + * mpn/ia64/lorrshift.asm: Amend comments about performance. + + * mpn/pa64/mul_1.asm: Fix comment typo. + * mpn/pa64/addmul_1.asm: Likewise. + * mpn/pa64/submul_1.asm: Likewise. + + * mpn/amd64/addlsh1_n.asm: Save/restore carry using two insn to break + recurrency. Add remarks about possible further speedup. + * mpn/amd64/sublsh1_n.asm: Likewise. + + * mpn/amd64/rsh1add_n.asm: Add remarks about possible further speedup. + * mpn/amd64/rsh1sub_n.asm: Likewise. + +2003-09-27 Torbjorn Granlund + + * mpn/powerpc64/README: Update with POWER4/PPC970 pipeline info. + + * mpn/powerpc64/rsh1add_n.asm: New file. + * mpn/powerpc64/rsh1sub_n.asm: New file. + * mpn/powerpc64/rshift.asm: Rewrite. + * mpn/powerpc64/lshift.asm: Rewrite. + +2003-09-26 Torbjorn Granlund + + * mpn/powerpc64/addlsh1_n.asm: New file. + * mpn/powerpc64/sublsh1_n.asm: New file. + +2003-09-25 Torbjorn Granlund + + * tune/common.c (speed_mpn_addlsh1_n, speed_mpn_sublsh1_n, + speed_mpn_rsh1add_n, speed_mpn_rsh1sub_n): Conditionalize on + corresponding HAVE_NATIVE_*. + +2003-09-25 Kevin Ryde + + * mpz/combit.c: Use GMP_NUMB_BITS not BITS_PER_MP_LIMB. + + * demos/expr/exprfr.c: Allow for mpfr_inf_p, mpfr_nan_p and + mpfr_number_p merely returning non-zero, rather than 1 or 0. + + * demos/expr/exprfr.c, demos/expr/t-expr.c: Add erf, integer_p, zeta. + + * demos/expr/Makefile.am (LDADD): Update comments on $(LIBM). + +2003-09-24 Torbjorn Granlund + + * tune/speed.c (routine): Add entries for mpn_addlsh1_n, mpn_sublsh1_n, + mpn_rsh1add_n, and mpn_rsh1sub_n. + + * tune/speed.h: Declare speed_mpn_addlsh1_n, speed_mpn_sublsh1_n, + speed_mpn_rsh1add_n, and speed_mpn_rsh1sub_n. + + * tune/common.c (speed_mpn_addlsh1_n, speed_mpn_sublsh1_n, + speed_mpn_rsh1add_n, speed_mpn_rsh1sub_n): New functions. + + * gmp-impl.h: Declare mpn_addlsh1_n, mpn_sublsh1_n, mpn_rsh1add_n, and + mpn_rsh1sub_n. + + * mpn/asm-defs.m4: Add define_mpn's for addlsh1_n, sublsh1_n, + rsh1add_n, and rsh1sub_n. + + * mpn/powerpc64/*.asm: Add cycle counts in consistent style. Misc + styling edits. + + * mpn/amd64/gmp-mparam.h: Retune. + + * configure.in: Add #undefs for HAVE_NATIVE_mpn_addlsh1_n, + HAVE_NATIVE_mpn_sublsh1_n, HAVE_NATIVE_mpn_rsh1add_n, + HAVE_NATIVE_mpn_rsh1sub_n. + (gmp_mpn_functions_optional): List addlsh1_n, sublsh1_n, rsh1add_n, + and rsh1sub_n. + + * mpn/amd64/addlsh1_n.asm: New file. + * mpn/amd64/sublsh1_n.asm: New file. + * mpn/amd64/rsh1add_n.asm: New file. + * mpn/amd64/rsh1sub_n.asm: New file. + +2003-09-24 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-09-24. + + * acinclude.m4 (GMP_C_DOUBLE_FORMAT): Remove conftest* temporary files. + +2003-09-23 Torbjorn Granlund + + * gmp-impl.h (MUL_TOOM3_THRESHOLD, SQR_TOOM3_THRESHOLD): Now 128. + +2003-09-23 Kevin Ryde + + * gmp-h.in (gmp_randinit_set): Use __gmp_const rather than const. + +2003-09-22 Torbjorn Granlund + + * tune/mul_n_mpn.c: (__gmpn_sqr_n): New #define. + * tune/mul_n_open.c (__gmpn_sqr_n): New #define. + + * mpn/generic/mul.c (mpn_sqr_n): Move from here... + * mpn/generic/mul_n.c (mpn_sqr_n): ...to here. + (mpn_sqr_n): Allocate workspace for toom3 using TMP_* mechanism except + for very large operands when !WANT_FFT. + + * mpn/generic/mul_n.c: Add a missing ";". Misc comment fixes. + + * mpn/generic/mul.c: Remove spurious #include . + + * mpn/x86/k7/gmp-mparam.h: Retune. + + * mpn/generic/mul_n.c (mpn_mul_n): Allocate workspace for toom3 using + TMP_* mechanism except for very large operands when !WANT_FFT. + + * gmp-impl.h (MPN_TOOM3_MUL_N_TSIZE, MPN_TOOM3_SQR_N_TSIZE): + Define conditionally on WANT_FFT and HAVE_NATIVE_mpn_sublsh1_n. + (MPN_TOOM3_MAX_N): New #define. + + * mpn/amd64/gmp-mparam.h: Retune. + + * mpn/Makefile.am (TARG_DIST): Add amd64. + + * mpn/generic/sqr_basecase.c: Use mpn_addlsh1_n when available. + + * mpn/generic/mul_n.c: Use proper form for HAVE_NATIVE macros. + +2003-09-22 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-09-22. + +2003-09-21 Kevin Ryde + + * mpn/x86/pentium4/sse2/gmp-mparam.h (USE_PREINV_DIVREM_1, + USE_PREINV_MOD_1): Set to 1 for new asm versions. + + * mpfr/*: Update to mpfr cvs 2003-09-21. + +2003-09-21 Paul Zimmermann + + * mpn/generic/mul_n.c (mpn_toom3_mul_n): Conditionally use + mpn_sublsh1_n, mpn_rsh1add_n and mpn_rsh1sub_n, in addition to + mpn_addlsh1_n. Avoid all copying, at the expense of some additional + workspace. + + * gmp-impl.h (MPN_TOOM3_MUL_N_TSIZE, MPN_TOOM3_SQR_N_TSIZE): Accommodate + latest toom3 code. + +2003-09-19 Kevin Ryde + + * mpn/x86/pentium4/sse2/divrem_1.asm, mpn/x86/pentium4/sse2/mod_1.asm: + New files. + +2003-09-16 Kevin Ryde + + * tune/speed.c (run_one): Don't scale the -1.0 not-available return. + Print "n/a" for times not-available. + +2003-09-13 Paul Zimmermann + + * mpn/generic/mul_n.c (toom3_interpolate): New function. + (mpn_toom3_mul_n, mpn_toom3_sqr_n): Call toom3_interpolate. + +2003-09-12 Torbjorn Granlund + + * mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): Remove unused + variables. + (mpn_toom3_mul_n, mpn_toom3_sqr_n): Use offset `+ 1', not `+ 2' in last + MPN_DECR_U calls. + +2003-09-12 Paul Zimmermann + + * mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): Rewrite. + +2003-09-12 Torbjorn Granlund + + * gmp-impl.h (MPN_KARA_MUL_N_TSIZE, MPN_KARA_SQR_N_TSIZE): Reformulate + to use the same form as MPN_TOOM3_MUL_N_TSIZE. + (MPN_TOOM3_MUL_N_TSIZE, MPN_TOOM3_SQR_N_TSIZE): Update for new Toom3 + code requirements. + * mpn/generic/mul_n.c (evaluate3, interpolate3, add2Times): Remove. + (USE_MORE_MPN): Remove. + +2003-08-31 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-08-31. + +2003-08-30 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-08-30. + +2003-08-29 Torbjorn Granlund + + * mpn/amd64/copyi.asm: New file. + * mpn/amd64/copyd.asm: New file. + * mpn/amd64/README: New file. + +2003-08-28 Torbjorn Granlund + + * mpn/amd64/lshift.asm: New file. + * mpn/amd64/rshift.asm: New file. + * mpn/amd64/gmp-mparam.h: Retune. + +2003-08-23 Kevin Ryde + + * tune/freq.c (freq_getsysinfo): Correction to speed_cycletime value + established. + + * mpz/rootrem.c, gmp-h.in, gmp.texi (mpz_rootrem): Don't return + exactness indication, can get that from testing the remainder. + + * mpn/x86/k7/aors_n.asm, mpn/x86/k7/mmx/copyi.asm: Amend to comments + about loads and stores and what speed should be possible. + +2003-08-22 Torbjorn Granlund + + * mpn/amd64/add_n.asm: New file. + * mpn/amd64/sub_n.asm: New file. + * mpn/amd64/mul_1.asm: New file. + * mpn/amd64/addmul_1.asm: New file. + * mpn/amd64/submul_1.asm: New file. + +2003-08-19 Kevin Ryde + + * longlong.h (add_ssaaaa, sub_ddmmss) [hppa 64]: Move down into main + __GNUC__ block. Exclude for _LONG_LONG_LIMB (ie. ABI=2.0n) since + these forms are only for ABI=2.0w. + + * longlong.h (count_leading_zeros) [__mcpu32__]: Check __mcpu32__ to + avoid bfffo on GCC 3.4 in CPU32 mode. Reported by Bernardo Innocenti. + + * longlong.h (count_trailing_zeros) [x86_64]: Use "%q0" to force + 64-bit register destination. Pointed out by Torbjorn. + + * mpz/combit.c: Correction to carry handling when extending a + negative, and use __GMPN_ADD_1. Correction to complement limb for a + negative when there's a non-zero low limb. + * tests/mpz/bit.c (check_clr_extend, check_com_negs): Exercise these. + + * demos/perl/GMP.xs, demos/perl/GMP.pm, demos/perl/test.pl: Add + get_d_2exp. + * demos/perl/GMP.xs, demos/perl/GMP.pm, demos/perl/GMP/Rand.pm, + demos/perl/test.pl: Add gmp_urandomb_ui, gmp_urandomm_ui. + (GMP::Rand::randstate): Accept a randstate object to copy. + * demos/perl/GMP.xs, demos/perl/GMP.pm, demos/perl/GMP/Mpz.pm, + demos/perl/test.pl: Add combit, rootrem. + +2003-08-19 Torbjorn Granlund + + * tune/Makefile.am (EXTRA_DIST): Add amd64.asm. + +2003-08-17 Kevin Ryde + + * gmpxx.h [__MPFR_H]: Include full for inlines. + * tests/cxx/t-headfr.cc: New file, exercising this. + * tests/cxx/Makefile.am: Add it. + + * tests/cxx/t-constr.cc: Include config.h for WANT_MPFR. + + * gmpxx.h: Correction to temp variable type in mpf -> mpfr assignment. + Reported by Derrick Bass. + * tests/cxx/t-assign.cc (check_mpfr): Exercise this. + + * configure.in (WANT_MPFR): AC_DEFINE this, for the benefit of + tests/cxx/t-*.cc. (Was always meant to have been defined.) + * tests/cxx/Makefile.am (INCLUDES): Add -I$(top_srcdir)/mpfr. + + * gmpxx.h: __gmp_default_rounding_mode -> __gmpfr_default_rounding_mode + (struct __gmp_hypot_function): Correction to mpfr_hypot addition. + * tests/cxx/t-misc.cc (check_mpfr_hypot): Corrections to mpfr/long + tests. + +2003-08-16 Torbjorn Granlund + + * configure.in (amd64): New. + + * mpn/amd64/gmp-mparam.h: New file. + + * tune/amd64.asm: New file, derived in part from tune/pentium.asm. + +2003-08-15 Kevin Ryde + + * tune/freq.c (freq_irix_hinv): Reinstate, for the benefit of IRIX 6.2. + (freq_attr_get_invent): Conditionalize on INFO_LBL_DETAIL_INVENT too. + +2003-08-14 Kevin Ryde + + * mpq/get_d.c: Use mpn_get_d. + * tests/mpq/t-get_d.c (check_onebit): New test. + + * gmp.texi (Notes for Particular Systems): Under x86 cpu types, note + i386 is a fat binary, remove pentium4 recommendation since i386 is now + quite reasonable for p4. + (Notes for Particular Systems): Under Windows DLLs, remove caveat + about --enable-cxx now ok, update .lib creation for new libtool, + remove .exp not needed for MS C. + (Notes for Package Builds): i386 is a fat binary. + (Reentrancy): Remove SCO ctype.h note, don't want to list every system + misfeature, and was quite possibly for non-threading mode anyway. + (Autoconf): Remove notes on gmp 2 detection, too old to want to + encourage anyone to use. + (Karatsuba Multiplication): Correction to threshold increase/decrease + for a and b terms. Reported by Richard Brent and Paul Zimmermann. + Also add various further index entries. + + * tune/freq.c (freq_attr_get_invent): New function. + (freq_irix_hinv): Remove, in favour or freq_attr_get_invent. + * configure.in (AC_CHECK_FUNCS): Add attr_get. + (AC_CHECK_HEADERS): Add invent.h, sys/attributes.h, sys/iograph.h. + +2003-08-03 Kevin Ryde + + * tune/tuneup.c (tune_mul): Use MUL_KARATSUBA_THRESHOLD_LIMIT. + +2003-08-02 Kevin Ryde + + * mpn/asm-defs.m4: Tweak some comments, add hpux11 to m4wrap 0xFF + problem systems. + + * configure.in (*-*-sco3.2v5*): Remove lt_cv_archive_cmds_need_lc=no, + since libtool no longer uses it. This was a workaround fixing ctype.h + in SCO 5 shared libraries; not sure if libtool now gets it right on + its own, let's hope so. + + * configure.in, acinclude.m4 (GMP_PROG_HOST_CC): Remove, libtool no + longer demands HOST_CC. + + * configure.in: When C or C++ compiler not found, refer user to + config.log. + + * configure.in (i386-*-*): Turn i386 into a fat binary build. + * mpn/x86/fat/fat.c, mpn/x86/fat/fat_entry.asm, + mpn/x86/fat/gmp-mparam.h, mpn/x86/fat/gcd_1.c, mpn/x86/fat/mode1o.c: + New files. + * gmp-impl.h (struct cpuvec_t) [x86 fat]: New structure. + * longlong.h (COUNT_LEADING_ZEROS_NEED_CLZ_TAB) [x86 fat]: Define. + * mpn/asm-defs.m4 (foreach): New macro. + * mpn/x86/x86-defs.m4 (CPUVEC_FUNCS_LIST): New define. + * mpn/x86/sqr_basecase.asm: New file, primarily as a fallback for fat + binaries. + * mpn/x86/p6/gmp-mparam.h, mpn/x86/p6/mmx/gmp-mparam.h: Add comments + about fat binary SQR_KARATSUBA_THRESHOLD for p6 and p6/mmx. + + * configure.in: Add various supports for fat binaries, via fat_path, + fat_functions and fat_thresholds variables. + * acinclude.m4 (GMP_STRIP_PATH): Mung $fat_path too. + (GMP_FAT_SUFFIX, GMP_REMOVE_FROM_LIST): New macros. + * gmp-impl.h: Add various supports for fat binaries. + (DECL_add_n etc): New macros. + (mpn_mul_basecase etc): Define only if not already defined. + * mpn/asm-defs.m4 (m4_config_gmp_mparam): Mention fat binary. + (MPN): Use m4_unquote, for the benefit of fat binary name expansion. + * doc/configuration: Notes on fat binaries. + * gmp-impl.h (MUL_TOOM3_THRESHOLD_LIMIT): Define always. + (MUL_KARATSUBA_THRESHOLD_LIMIT): New define. + * mpn/generic/mul.c, mpn/generic/mul_n.c: Use these. + * tune/divrem1div.c, tune/divrem1inv.c, tune/mod_1_div.c, + tune/mod_1_inv.c: Define OPERATION_divrem_1 and OPERATION_mod_1, to + tell fat.h what's being done. + + * config.guess (alpha-*-*): Update comments on what configfsf.guess + does and doesn't do for us. + +2003-07-31 Kevin Ryde + + * config.guess: Remove $dummy.o files everywhere, in case vendor + compilers produce that even when not asked. + + * demos/perl/GMP.xs (class_or_croak): Rename "class" parameter to + avoid C++ keyword. + (coerce_ulong, coerce_long): Move croaks to stop g++ 3.3 complaining + about uninitialized variables. + + * demos/perl/INSTALL: Add notes on building with a DLL. + + * longlong.h (count_trailing_zeros) [x86_64]: Ensure bsfq destination + is a 64-bit register. Diagnosed by Francois G. Dorais. + +2003-07-31 Torbjorn Granlund + + * longlong.h [ppc]: Remove nested test for vxworks. + +2003-07-24 Kevin Ryde + + * gmpxx.h (struct __gmp_binary_multiplies): Use mpz_mul_si for + mpz*long and long*mpz. + * tests/cxx/t-ops.cc (check_mpz): Exercise mpz*long and mpz*ulong. + + * cxx/ismpf.cc: Use std::locale decimal point when available. Expect + localeconv available always. + * tests/cxx/t-locale.cc: Enable check_input tests. + + * gmpxx.h (struct __gmp_hypot_function): Use mpfr_hypot. + * tests/cxx/t-misc.cc (check_mpfr_hypot): New tests. + + * tests/cxx/t-assign.cc, tests/cxx/t-binary.cc, tests/cxx/t-ops.cc, + tests/cxx/t-prec.cc, tests/cxx/t-ternary.cc, tests/cxx/t-unary.cc: + Include config.h for WANT_MPFR. + + * tests/mpz/bit.c (check_single): Correction to a diagnostic print. + +2003-07-24 Niels Möller + + * mpz/combit.c: New file. + * Makefile.am, mpz/Makefile.am: Add it. + * gmp-h.in (mpz_combit): Add prototype. + * tests/mpz/bit.c (check_single): Exercise mpz_combit. + +2003-07-16 Kevin Ryde + + * mpn/generic/get_d.c: Correction to infinity handling for large exp. + +2003-07-14 Kevin Ryde + + * mpz/get_d.c, mpz/get_d_2exp.c, mpf/get_d.c, mpf/get_d_2exp.c: Use + mpn_get_d. + + * mpn/generic/get_d.c: New file, based on mpz/get_d.c and insert-dbl.c. + * configure.in, mpn/Makefile.am: Add it. + * gmp-impl.h (mpn_get_d): Add prototype. + + * tests/mpn/t-get_d.c: New file. + * tests/mpn/Makefile.am: Add it. + + * tests/mpz/t-get_d_2exp.c (check_onebit, check_round): Test negatives. + (check_onebit): Add a few more bit sizes. + + * tests/misc.c, tests/tests.h (tests_isinf): New function. + +2003-07-12 Kevin Ryde + + * configure.in (GMP_PROG_CXX_WORKS): Include $CPPFLAGS, same as + automake does in the actual build. + + * acinclude.m4 (GMP_PROG_CXX_WORKS): In the namespace test, declare + namespace before trying to use. In std iostream test, provoke a + failure from Compaq C++ in pre-standard mode. + +2003-07-08 Kevin Ryde + + * acinclude.m4 (GMP_PROG_CC_WORKS): Use separate compiles for various + known problems, and indicate to the user the reason for rejecting. + (GMP_PROG_CXX_WORKS): Ditto, and insist on being able to execute each + compiled program. + +2003-07-05 Kevin Ryde + + * config.sub: Add comments to our alias transformations. + + * configfsf.sub, configfsf.guess: Update to 2003-07-04. + + * acinclude.m4 (GMP_PROG_CC_WORKS, GMP_PROG_CC_WORKS_LONGLONG): Show + failing program in config.log, per other autoconf tests. + + * configure.in (i786-*-*): Recognise as pentium4, per configfsf.sub. + +2003-06-28 Kevin Ryde + + * mpz/get_d_2exp.c, mpf/get_d_2exp.c: Avoid res==1.0 when floats round + upwards. + + * tests/mpz/t-get_d_2exp.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add it. + * tests/mpf/t-get_d_2exp.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + * tests/x86call.asm, test/tests.h (x86_fldcw, x86_fstcw): New + functions. + * tests/misc.c, tests/tests.h (tests_hardware_getround, + tests_hardware_setround): New functions. + +2003-06-25 Kevin Ryde + + * mpn/sparc64/dive_1.c: New file. + + * mpn/sparc64/sparc64.h: New file. + * mpn/sparc64/mode1o.c: Remove things now in sparc64.h. + + * mpfr/*: Update to mpfr cvs 2003-06-25. + + * acinclude.m4 (GMP_PROG_CC_WORKS): In last change provoking gnupro + gcc, don't use ANSI style function definition. + +2003-06-22 Kevin Ryde + + * mpn/pa32/hppa1_1/udiv.asm: Remove .proc, .entry, .exit and .procend, + handled by PROLOGUE and EPILOGUE. Comment out .callinfo, per other + asm files. + + * gmpxx.h (mpz_class __gmp_binary_divides, __gmp_binary_modulus): Fix + long/mpz and long%mpz for dividend==LONG_MIN divisor==-LONG_MIN. + (mpz_class __gmp_binary_modulus): Fix mpz%long for negative dividend. + * tests/cxx/t-ops.cc (check_mpz): Add test cases for these, merging + operator/ and operator% sections for clarity. + +2003-06-21 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-06-21. + + * acinclude.m4 (GMP_PROG_CC_WORKS): Add code by Torbjorn provoking an + ICE from gcc 2.9-gnupro-99r1 under -O2 -mcpu=ev6. + * configure.in (alpha*-*-* gcc_cflags_cpu): Fallback on -mcpu=ev56 for + this compiler. + + * gmpxx.h (get_d): Remove comments about long double, double is + correct for get_d, a future long double form would be get_ld. + +2003-06-19 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-06-19. + + * mpn/generic/dive_1.c: Share src[0] fetch among all cases. No need + for separate final umul_ppmm in even case, make it part of the loop. + + * mpz/get_d_2exp.c, mpq/set_si.c, mpq/set_ui.c: Nailify. + + * mpf/iset_si.c: Rewrite using mpf/set_si.c code, in particular this + nailifies it. + * tests/mpf/t-set_si.c: Nailify tests. + + * mpf/iset_ui.c: Nailify, as per mpf/set_ui.c + * tests/mpf/t-set_ui.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + +2003-06-15 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-06-15. + + * mpn/x86/k6/mode1o.asm: Remove a bogus ASSERT. + +2003-06-12 Kevin Ryde + + * configure.in (--enable-assert): Emit WANT_ASSERT to config.m4. + * mpn/powerpc32/powerpc-defs.m4, mpn/x86/x86-defs.m4 (ASSERT): Check + WANT_ASSERT is defined. + + * mpn/sparc32/v9/udiv.asm: Amend heading, this file is for sparc v9. + + * tests/cxx/Makefile.am (TESTS_ENVIRONMENT): In libtool openbsd hack, + discard error messages from cp, for the benefit of --disable-shared or + systems not using names libgmp.so.*. + + * tests/devel/try.c (try_one): When overlapping, copy source data + after filling dst. Previously probably used only DEADVAL in + overlapping cases. + +2003-06-11 Torbjorn Granlund + + * mpf/random2.c: Rewrite. Ignore sign of exp parameter. + +2003-06-10 Kevin Ryde + + * mpn/sparc64/mode1o.c: New file. + +2003-06-09 Torbjorn Granlund + + * mpn/powerpc32/lshift.asm: Add more cycle counts. + * mpn/powerpc32/rshift.asm: Add more cycle counts. + + * mpn/ia64/addmul_1.asm: Reformat comments for 80 columns. + + * gmp-impl.h (udiv_qrnnd_preinv1): New name for udiv_qrnnd_preinv. + (udiv_qrnnd_preinv2): New name for udiv_qrnnd_preinv2norm. + (udiv_qrnnd_preinv): New #define, making udiv_qrnnd_preinv2 + the default. + * tune/speed.c: Corresponding changes. + * tune/speed.h: Likewise. + * tune/common.c: Likewise. + + * mpf/get_str.c: Simplify `off' computation. + + * longlong.h: Tabify. + +2003-06-09 Kevin Ryde + + * gmp.texi (ABI and ISA): FreeBSD has sparc64 too, just say "BSD" to + cover all flavours. + * configure.in: Ditto in some comments. + + * mpfr/*: Update to mpfr cvs 2003-06-09. + + * tests/cxx/Makefile.am (LDADD): Add -L$(top_builddir)/$(LIBS), for + the benefit of gcc 3.2 on itanium2-hp-hpux11.22. + + * tune/many.pl (mul_2): Add speed routine settings. + (MAKEFILE): Close when done, for the benefit of development hackery. + +2003-06-08 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-06-08. + + * mpn/x86/x86-defs.m4 (femms): Remove fallback to emms. + (cmovCC, psadbw): Remove simulated versions. + (cmov_available_p, psadbw_available_p): Remove. + This trickery was only ever for development purposes on machines + without those instructions. Removing it simplifies gmp and in + particular avoids complications for fat binary builds. Development + can be done with a wrapper around "as" if really needed. + + * mpn/x86/divrem_1.asm: Don't use loop_or_decljnz, now K6 has its own + mpn/x86/k6/divrem_1.asm. Amend K6 comments now moved to there. + * mpn/x86/x86-defs.m4 (loop_or_decljnz): Remove, no longer used. + + * mpn/x86/k6/divrem_1.asm: New file, derived from mpn/x86/divrem_1.asm. + + * mpn/x86/k6/pre_mod_1.asm: Remove comments now in mpn/x86/mod_1.asm. + + * mpn/x86/mod_1.asm: Put mpn_mod_1c after mpn_mod_1 for better branch + prediction. Put done_zero at end for less wastage in alignment. Use + decl+jnz unconditionally since in fact it's ok on k6. Amend comments. + +2003-06-07 Kevin Ryde + + * mpn/generic/mode1o.c: Fix ASSERTs on return value. + + * gmp.texi (Build Options): Add viac3 and viac32 cpu types. + (ABI and ISA): Note on sparcv9 ABI=32 vs ABI=64 speed. More indexing. + + * configfsf.guess, configfsf.sub: Update to 2003-06-06. + * config.guess: Remove $RANDOM hack supporting netbsd 1.4, not needed + by new configfsf.guess. + +2003-06-06 Torbjorn Granlund + + * mpn/ia64/submul_1.asm: Add branch over .align block. + +2003-06-05 Torbjorn Granlund + + * longlong.h (add_ssaaaa) [pa64]: Output zero operand as register 0. + Allow more immediate operands. + (sub_ddmmss) [pa64]: Likewise. + (add_ssaaaa) [pa32]: Likewise. + (sub_ddmmss) [pa32]: Likewise. + + * mpn/pa64: Change ".level 2.0W" to ".level 2.0w" to please + picky GNU assembler. + +2003-06-05 Kevin Ryde + + * gmp.texi (Integer Special Functions): In mpz_array_init, fix type + shown for integer_array and give an example use. + +2003-06-04 Torbjorn Granlund + + * mpf/set_str.c (mpf_set_str): Work around gcc 2 bug triggered on + alpha. + +2003-06-03 Kevin Ryde + + * mpn/x86/pentium/README: Add 7 c/l mmx mul_1, tweak wordings. + + * acinclude.m4 (GMP_C_DOUBLE_FORMAT): Use octal char constants in test + program, hex is not supported by K&R. + +2003-06-02 Torbjorn Granlund + + * mpn/mips64/divrem_1.asm: New file. + +2003-06-01 Torbjorn Granlund + + * mpn/powerpc32/lshift.asm: Reformat code. + * mpn/powerpc32/rshift.asm: Reformat code. + +2003-05-30 Kevin Ryde + + * tests/misc.c (tests_start): Set stdout and stderr to unbuffered, to + avoid any chance of losing output on segv etc. + +2003-05-28 Torbjorn Granlund + + * mpf/get_str.c: Move label `done' to match TMP_MARK and TMP_FREE. + Remove redundant variable prec. + +2003-05-26 Torbjorn Granlund + + * tests/mpz/convert.c: Test bases up to 62. + + * tests/mpf/t-conv.c: Test bases up to 62. + + * demos/pexpr.c: Don't iterate to get accurate timing. + + * mpf/set_str.c (mpn_pow_1_highpart): Cleanup. + + * mp_dv_tab.c: Fix typo. + + * mpf/get_str.c: Rewrite (now sub-quadratic). + +2003-05-22 Kevin Ryde + + * tests/mpn/t-divrem_1.c: New file. + * tests/mpn/Makefile.am: Add it. + +2003-05-22 Torbjorn Granlund + + * config.sub: Recognize viac3* processors. + +2003-05-20 Torbjorn Granlund + + * mpn/sparc64/addmul_2.asm: New file. + +2003-05-19 Torbjorn Granlund + + * configure.in: Recognize alphaev7* as alphaev67. + + * config.guess: Recognize viac3* processors. + * configure.in: Set up path for viac3* processors. + * acinclude.m4 (X86_PATTERN): Include viac3* processors. + +2003-05-19 Kevin Ryde + + * tune/freq.c (freq_pstat_getprocessor): New function. + (freq_all): Use it. + * configure.in (AC_CHECK_HEADERS): Add sys/pstat.h. + (AC_CHECK_FUNCS): Add pstat_getprocessor. + +2003-05-15 Kevin Ryde + + * mpn/generic/mul_fft.c (mpn_mul_fft_decompose): Remove "inline", + since the code is a bit too big. gcc doesn't actually inline when + alloca (TMP_ALLOC) is used anyway. + +2003-05-13 Kevin Ryde + + * gmp.texi (Notes for Particular Systems): Libtool directory is .libs + not _libs for mingw dll. Reported by Andreas Fabri. + +2003-05-07 Kevin Ryde + + * acinclude.m4 (GMP_PROG_CC_WORKS): Add code to generate sse2/xmm code + from gcc -march=pentium4, to check the assembler supports that. + (GMP_GCC_PENTIUM4_SSE2, GMP_OS_X86_XMM): New macros. + * configure.in (pentium4-*-*): Use them to see if gcc -march=pentium4 + (with sse2) is ok. + +2003-05-06 Kevin Ryde + + * mpz/com.c: Rate size==0 as UNLIKELY, fix comment to mpn_add_1. + + * tune/freq.c (): Include only when needed for + getsysinfo(), to avoid a problem with this file on AIX 5.1. + +2003-05-03 Torbjorn Granlund + + * mpf/set_str.c: Do not ignore supposedly superfluous digits (in part + reverting last change). + +2003-05-03 Kevin Ryde + + * gmp.texi: Use @code for files in @cindex entries, it looks nicer + than @file. + + * Makefile.am: Note gmp 4.1.1 and 4.1.2 version info. + + * configure.in, acinclude.m4 (GMP_CRAY_OPTIONS): New macro for Cray + system setups, letting AC_REQUIRE do its job instead of a hard coded + AC_PROG_EGREP. + + * config.guess: Amend fake RANDOM to avoid ". configfsf.guess" which + segfaults on Debian "ash" 0.4.16. + +2003-05-01 Kevin Ryde + + * configure.in (AC_CHECK_FUNCS): Add getsysinfo. + (AC_CHECK_HEADERS): Add sys/sysinfo.h and machine/hal_sysinfo.h. + * tune/freq.c (freq_getsysinfo): New function. + (freq_all): Use it. + (freq_sysctlbyname_i586_freq, freq_sysctlbyname_tsc_freq, + freq_sysctl_hw_cpufrequency, freq_sysctl_hw_model): Set + speed_cycletime before trying to print it, when verbose. + +2003-04-28 Torbjorn Granlund + + * mpf/set_str.c: Major overhaul. + (mpn_pow_1_highpart): New helper function, meat extracted from + mpf_set_str. + +2003-04-24 Kevin Ryde + + * acinclude.m4 (GMP_GCC_ARM_UMODSI): Quote result string against m4. + + * configure, ltmain.sh, aclocal.m4: Update to libtool 1.5. + + * longlong.h (add_ssaaaa) [all]: Remove first "%" commutative in each, + since gcc only supports one per asm. + + * printf/doprnt.c: Add M for mp_limb_t. + * tests/misc/t-printf.c: Exercise this. + + * tests/mpz/t-cmp_d.c: Test infinities. + * tests/mpf/t-cmp_d.c: New file. + * tests/mpf/Makefile.am: Add it. + + * mpz/cmp_d.c, mpz/cmpabs_d.c, mpf/cmp_d.c: NaN invalid, Inf bigger + than any value. + * mpz/set_d.c, mpq/set_d.c, mpf/set_d.c: Nan or Inf invalid. + + * configure.in (AC_CHECK_FUNCS): Add raise. + * invalid.c: New file. + * Makefile.am: Add it. + * gmp-impl.h (__gmp_invalid_operation): Add prototype. + (DOUBLE_NAN_INF_ACTION): New macro. + + * tests/trace.c, tests/tests.h (d_trace): New function. + * tests/misc.c, tests/tests.h (tests_infinity_d): New function. + * tests/misc.c (mpz_erandomb, mpz_errandomb): Use gmp_urandomm_ui. + + * tune/tuneup.c, tune/common.c, tests/devel/try.c: Cast various + mp_size_t values for printf %ld in case mp_size_t==int. Use + gmp_printf for mp_limb_t values. + + * gmp.texi (Nomenclature and Types): Add mp_exp_t, mp_size_t, + gmp_randstate_t. Note ulong for bit counts and size_t for byte + counts. Don't bother with @noindent. + (Debugging): New valgrind is getting MMX/SSE. + (Integer Comparisons): mpz_cmp_d and mpz_cmpabs_d on NaNs and Infs. + (Float Comparison): mpf_cmp_d behaviour on NaNs and Infs. + (Low-level Functions): Note with mpn_hamdist what hamming distance is. + (Formatted Output Strings): Add type M. + (Internals): Remove remarks on ulong bits and size_t bytes. Move int + field remarks to ... + (Integer Internals, Float Internals): ... here. + +2003-04-19 Kevin Ryde + + * configure.in (*sparc*-*-* ABI=32): Add umul to extra_functions. + + * mpn/x86/p6/mul_basecase.asm: New file. + +2003-04-18 Kevin Ryde + + * configure.in (m68060-*-*): Fallback to gcc -m68000 when -m68060 not + available, and don't use mpn/m68k/mc68020 asm routines. (Avoids 32x32 + mul and 64/32 div which trap to the kernel on 68060. Advice by + Richard Zidlicky.) + * mpn/m68k/README: Update notes on directory usage. + + * tests/cxx/Makefile.am (TESTS_ENVIRONMENT): Add a hack to let the + test programs run with a shared libgmpxx on openbsd 3.2. + + * gmp.texi (Language Bindings): Add Guile. + +2003-04-12 Kevin Ryde + + * configure.in (cygwin*, mingw*, pw32*, os2*): Add + -Wl,--export-all-symbols to GMP_LDFLAGS, no longer the default in + latest mingw and libtool. + + * acinclude.m4 (GMP_ASM_COFF_TYPE): New macro. + * configure.in (x86s): Use it. + * mpn/x86/x86-defs.m4 (COFF_TYPE): New macro. + (PROLOGUE_cpu): Use it, for the benefit of mingw DLLs. + + * gmp-impl.h (mpn_copyi, mpn_copyd): Add __GMP_DECLSPEC. + + * gmp.texi (Known Build Problems): Remove windows test program .exe + repeated built, fixed by new libtool. Remove MacOS C++ shared library + creation, fixed by new libtool. + (Notes for Package Builds, Known Build Problems): Remove DESTDIR notes + on libgmpxx, fixed in new libtool. + +2003-04-10 Torbjorn Granlund + + * configure.in: Match turbosparc. + * config.guess: Recognize turbosparc (just for *bsd for now). + +2003-04-09 Kevin Ryde + + * mpf/mul_ui.c [nails]: Call mpf_mul to handle v > GMP_NUMB_MAX. + + * tests/mpz/t-mul.c (main): Don't try FFT sizes when FFT disabled via + MP_SIZE_T_MAX, eg. for nails. + + * tests/cxx/t-ternary.cc: Split up tests to help compile speed and + memory usage. + + * tests/devel/try.c: Print seed under -R, add -E to reseed, use ulong + for seed not uint. + + * gmp.texi: Add @: after various abbreviations, more index entries. + (leftarrow): New macro, for non-tex. + (Random State Initialization): Remove commented gmp_randinit_lc, not + going to be implemented. + (Random Number Algorithms): New section. + (References): Add Matsumoto and Nishimura on Mersenne Twister, add + Bertot, Magaud and Zimmermann on GMP Square Root. + +2003-04-06 Kevin Ryde + + * tests/mpz/t-gcd_ui.c: New file. + * tests/mpz/Makefile.am: Add it. + + * mpz/gcd_ui.c: Correction to return value on longlong limb systems, + limb might not fit a ulong. + +2003-04-04 Kevin Ryde + + * configure, aclocal.m4, ltmain.sh: Update to libtool cvs snapshot + 2003-04-02. + +2003-04-02 Kevin Ryde + + * configure.in (*-*-cygwin*): No longer force lt_cv_sys_max_cmd_len, + libtool has addressed this now. + (AC_PROVIDE_AC_LIBTOOL_WIN32_DLL): Remove this, libtool _LT_AC_LOCK + no longer needs it. + + * acinclude.m4 (GMP_PROG_AR): Also set ac_cv_prog_AR and + ac_cv_prog_ac_ct_AR when adding flags to AR, so they're not lost by + libtool's call to AC_CHECK_TOOL. + +2003-04-01 Kevin Ryde + + * configure, aclocal.m4, ltmain.sh: Update to libtool cvs snapshot + 2003-03-31. + + * configure.in (AC_PROG_F77): Add a dummy AC_PROVIDE to stop libtool + running F77 probes. + + * randlc2x.c (gmp_rand_lc_struct): Add comments about what exactly is + in each field. + (randseed_lc): Rename seedp to seedz to avoid confusion with seedp in + the lc function. Suggested by Pedro Gimeno. + (gmp_randinit_lc_2exp): Use __GMP_ALLOCATE_FUNC_TYPE. No need for + "+1" in mpz_init2 of _mp_seed. Don't bother with mpz_init2 for _mp_a. + +2003-03-29 Kevin Ryde + + * configure.in (m68k-*-*): Use -O2, no longer need to fallback to -O. + * acinclude.m4 (GMP_GCC_M68K_OPTIMIZE): Remove macro. + + * configure.in (AC_CHECK_TYPES): Add notes on why tested. + + * gmp.texi (GMPrefu, GMPpxrefu, GMPreftopu, GMPpxreftopu): New macros, + use them for all external references to get URLs into HTML output. + (Random State Initialization): Add gmp_randinit_set. + (Random State Miscellaneous): New section. + +2003-03-29 Kevin Ryde + + * randbui.c, randmui.c: New files. + * Makefile.am: Add them. + * gmp-h.in (gmp_urandomb_ui, gmp_urandomm_ui): Add prototypes. + * tests/rand/t-urbui.c, tests/rand/t-urmui.c: New files. + * tests/rand/Makefile.am: Add them. + + * gmp-impl.h (gmp_randstate_srcptr): New typedef. + (gmp_randfnptr_t): Add randiset_fn. + * randiset.c: New file. + * Makefile.am: Add it. + * gmp-h.in (gmp_randinit_set): Add prototype. + * randlc2x.c, randmt.c: Add gmp_randinit_set support. + * tests/rand/t-iset.c: New file. + * tests/rand/Makefile.am: Add it. + + * tests/misc.c, tests/tests.h (call_rand_algs): New function. + +2003-03-27 Kevin Ryde + + * mpz/bin_uiui.c: Use plain "*" for kacc products rather than + umul_ppmm since high not needed, except for an ASSERT now amended. + +2003-03-26 Kevin Ryde + + * demos/expr/exprfr.c (cbrt, cmpabs, exp2, gamma, nextabove, + nextbelow, nexttoward): New functions. + * demos/expr/t-expr.c: Exercise these. + + * mpfr/*: Update to mpfr cvs 2003-03-26. + + * gmp-impl.h (MPZ_REALLOC): Use UNLIKELY, to expect no realloc. + + * tune/time.c (cycles_works_p): Scope variables down to relevant part + to avoid warnings about unused. + + * configfsf.guess, configfsf.sub: Update to 2003-02-22. + * config.guess: Fake a $RANDOM variable when running configfsf.guess, + to workaround a problem on m68k NetBSD 1.4.1. + + * mpz/fac_ui.c: Remove unused variable "z1". + + * tune/freq.c (freq_irix_hinv): Allow "Processor 0" line from IRIX 6.5. + +2003-03-24 Torbjorn Granlund + + * randlc2x.c (randget_lc): Remove write-only variable rn. + * mpf/eq.c: Remove write-only variable usign. + * gen-psqr.c (main): Remove write-only variable numb_bits. + +2003-03-17 Torbjorn Granlund + + * Makefile.am (libgmp_la_SOURCES): Add mp_dv_tab.c. + (libmp_la_SOURCES): Add mp_dv_tab.c. + + * mpn/alpha/invert_limb.asm: Add a few comments. + + * mp_dv_tab.c: New file, defining __gmp_digit_value_tab. + + * mpz/set_str.c: Get rid of function digit_value_in_base and use table + __gmp_digit_value_tab instead. + * mpz/inp_str.c: Likewise. + * mpf/set_str.c: Likewise. + * mpbsd/min.c: Likewise. + * mpbsd/xtom.c: Likewise. + + * mpz/set_str.c: Allow bases <= 62. Return error for invalid bases. + * mpz/inp_str.c: Likewise. + * mpf/set_str.c: Likewise. + * mpz/out_str.c: Likewise. + * mpz/get_str.c: Likewise. + * mpf/get_str.c: Likewise. + + * mpz/inp_str.c: Restructure to allocate more string space just + before needed. + * mpbsd/min.c: Likewise. + + * longlong.h (__udiv_qrnnd_c): Remove redundant casts. + (32-bit sparc): Test HAVE_HOST_CPU_supersparc in addition to various + sparc_v8 spellings. + +2003-03-17 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-03-17. + +2003-03-15 Kevin Ryde + + * Makefile.am (EXTRA_libgmp_la_SOURCES): Use this for TMP_ALLOC + sources, instead of a libdummy.la. + +2003-03-16 Torbjorn Granlund + + * config.guess: Recognize supersparc and microsparc for *BSD systems. + Generalize some superscalar recognition patterns. + +2003-03-14 Torbjorn Granlund + + * mpn/sparc64/udiv.asm: New file. + +2003-03-13 Torbjorn Granlund + + * mpn/sparc64: Table cycle counts. Update some comments. + + * mpn/powerpc64/divrem_1.asm: New file. + +2003-03-10 Torbjorn Granlund + + * mpn/generic/mul.c (mpn_mul): Don't blindly expect + MUL_KARATSUBA_THRESHOLD to be a constant. + +2003-03-07 Torbjorn Granlund + + * mpn/generic/mul.c (mpn_mul): New operand splitting code for + avoiding cache misses when un >> MUL_KARATSUBA_THRESHOLD > vn. + (MUL_BASECASE_MAX_UN): New #define, default to 500 for now. + +2003-03-07 Kevin Ryde + + * Makefile.am: Put gmp.h and mp.h under $(exec_prefix)/include. + * gmp.texi (Build Options): Add notes on this. + Reported by Vincent Lefèvre. + +2003-03-06 Kevin Ryde + + * configure.in (alpha*-*-* gcc): Add asm option before testing -mcpu, + for the benefit of gcc 2.9-gnupro-99r1 on alphaev68-dec-osf5.1 which + doesn't otherwise put the assembler in the right mode for -mcpu=ev6. + +2003-03-05 Torbjorn Granlund + + * mpn/powerpc32/powerpc-defs.m4: Set up renaming for v registers. + + * mpz/powm.c (redc): Instead of repeated mpn_incr_u invocations, + accumulate carries and add at the end. + (mpz_powm): Trim tp allocation, now as redc doesn't need carry guard. + +2003-02-25 Torbjorn Granlund + + * mpn/x86/pentium4/copyd.asm: Correct header comment. + + * mpn/arm/addmul_1.asm: Correct cycle counts. + * mpn/arm/submul_1.asm: Likewise. + +2003-02-20 Kevin Ryde + + * demos/factorize.c (factor_using_pollard_rho): Test k>0 to avoid + infinite loop if k=0 and gcd!=1 reveals a factor. Reported by John + Pongsajapan. + + * gmp.texi, fdl.texi: Update to FDL version 1.2. + +2003-02-18 Torbjorn Granlund + + * mpn/arm/mul_1.asm: Fix typo introduced in last change. + +2003-02-17 Torbjorn Granlund + + * mpn/ia64/gmp-mparam.h: Retune. + + * mpn/sparc64/copyi.asm: Add some header comments. + * mpn/sparc64/copyd.asm: Likewise. + + * mpn/arm/mul_1.asm: Put vl operand last for umull/umlal. + Add some header comments. + * mpn/arm/addmul_1.asm: Rewrite. + * mpn/arm/submul_1.asm: Rewrite. + * mpn/arm/gmp-mparam.h: Retune. + +2003-02-16 Torbjorn Granlund + + * mpn/arm/copyi.asm: New file. + * mpn/arm/copyd.asm: New file. + +2003-02-16 Kevin Ryde + + * acinclude.m4 (GMP_C_DOUBLE_FORMAT): Tolerate incorrect last data + byte seen on an arm system. + +2003-02-15 Torbjorn Granlund + + * mpn/arm/gmp-mparam.h: Retune. + +2003-02-13 Torbjorn Granlund + + * mpn/powerpc32/750/com_n.asm: Add more cycle counts. + +2003-02-13 Kevin Ryde + + * configure.in (AC_PREREQ): Bump to 2.57. + + * configure.in, acinclude.m4 (GMP_GCC_WA_OLDAS): New macro, applying + -Wa,-oldas only when necessary. + + * configure.in (powerpc*-*-*): Don't use -Wa,-mppc with gcc, it + overrides options recent gcc adds for -mcpu, making generated code + fail to assemble. + + * tune/tuneup.c (mpn_fft_table): Remove definition, it's in mul_fft.c. + +2003-02-12 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/gmp-mparam.h: Retune. + * mpn/x86/k7/gmp-mparam.h: Retune. + * mpn/x86/k6/gmp-mparam.h: Retune. + * mpn/x86/p6/gmp-mparam.h: Retune. + * mpn/x86/p6/mmx/gmp-mparam.h: Retune. + + * tests/mpz/t-mul.c (main): Rewrite FFT testing code. + +2003-02-10 Torbjorn Granlund + + * config.guess: Recognize "power2" systems. + + * mpn/powerpc64/gmp-mparam.h: Fix indentation. + * mpn/power/gmp-mparam.h: Retune. + * mpn/alpha/ev6/nails/gmp-mparam.h: Retune. + * mpn/sparc64/gmp-mparam.h: Retune. + * mpn/pa64/gmp-mparam.h: Retune. + * mpn/sparc32/v8/supersparc/gmp-mparam.h: Retune. + * mpn/sparc32/v8/gmp-mparam.h: Retune. + * mpn/mips64/gmp-mparam.h: Retune. + * mpn/alpha/ev6/gmp-mparam.h: Retune. + * mpn/powerpc32/gmp-mparam.h: Retune. + * mpn/powerpc32/750/gmp-mparam.h: Retune. + * mpn/alpha/ev5/gmp-mparam.h: Retune. + * mpn/m68k/gmp-mparam.h: Retune. + * mpn/cray/gmp-mparam.h: Set GET_STR_PRECOMPUTE_THRESHOLD. + + * configure.in: Undo this, problem doesn't happen any more: + (mips64*-*-*): Pass just -O1 to cc, to work around compiler bug. + +2003-02-03 Kevin Ryde + + * gmp-impl.h (MPN_NORMALIZE, MPN_NORMALIZE_NOT_ZERO): Add parens + around macro parameters. Reported by Jason Moxham. + +2003-02-01 Kevin Ryde + + * gmp.texi (Low-level Functions): No overlap permitted by mpn_mul_n. + Reported by Jason Moxham. + (Formatted Input Strings): Correction to strtoul cross reference + formatting. + (BSD Compatible Functions): Add index entry for MINT. + +2003-01-29 Torbjorn Granlund + + * gmp-impl.h (mpn_mul_fft): Now returns int. + +2003-01-29 Paul Zimmermann + + * mpn/generic/mul_fft.c: Major rewrite. + +2003-01-25 Kevin Ryde + + * config.guess (powerpc*-*-*): Remove $dummy.core file when mfpvr + fails on NetBSD. + (trap): Remove $dummy.core on abnormal termination too. + + * mpfr/*: Update to mpfr cvs 2003-01-25. + +2003-01-24 Torbjorn Granlund + + * mpn/ia64/README: Update cycle counts to match current code. + +2003-01-18 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-01-18. + +2003-01-17 Torbjorn Granlund + + * gmp.texi: Canonicalize URLs. + +2003-01-15 Kevin Ryde + + * gmp.texi (Notes for Particular Systems): Add hardware floating point + precision mode. + + * mpfr/*, configure, aclocal.m4, config.in: Update to mpfr cvs + 2003-01-15. + +2003-01-11 Kevin Ryde + + * mpfr/*: Update to mpfr cvs 2003-01-11. + +2003-01-09 Kevin Ryde + + * mpfr/get_str.c: Update to mpfr cvs 2003-01-09. + + * doc/configuration: Various updates. + +2003-01-06 Torbjorn Granlund + + * mpn/alpha/copyi.asm: Avoid `nop' mnemonic, unsupported on Cray. + * mpn/alpha/copyd.asm: Likewise. + +2003-01-05 Kevin Ryde + + * demos/expr/t-expr.c (check_r): Tolerate mpfr_set_str new return + value. + + * configure, aclocal.m4 (*-*-osf4*, *-*-osf5*): Regenerate with + libtool patch to avoid bash printf option problem when building shared + libraries with cxx. + + * configure.in (pentium4-*-*): Use "-march=pentium4 -mno-sse2" since + sse2 causes buggy code from gcc 3.2.1 and is only supported on new + enough kernels. + + * acinclude.m4 (GMP_PROG_NM): Add some notes about failures, per + report by Krzysztof Kozminski. + + * gmp-h.in (mpz_mdivmod_ui, mpz_mmod_ui): Add parens around "r". + + * gmp-h.in (__GMP_CAST): New macro, clean to g++ -Wold-style-cast. + (GMP_NUMB_MASK, mpz_cmp_si, mpq_cmp_si, mpz_odd_p, mpn_divexact_by3, + mpn_divmod): Use it. Reported by Krzysztof Kozminski. + (mpz_odd_p): No need for the outermost cast to "int". + * tests/cxx/t-cast.cc: New file. + * tests/cxx/Makefile.am: Add it. + +2003-01-04 Kevin Ryde + + * mpfr/set_str.c: Update to mpfr cvs 2003-01-04. + + * demos/expr/exprfra.c (e_mpfr_number): Tolerate recent mpfr_set_str + returning count of characters accepted. + +2003-01-03 Torbjorn Granlund + + * mpn/alpha/copyi.asm: New file. + * mpn/alpha/copyd.asm: New file. + +2003-01-03 Kevin Ryde + + * demos/expr/t-expr.c: Use __gmpfr on some mpfr internals that have + changed. + + * mpfr/*, aclocal.m4, config.in, configure: Update to mpfr cvs + 2003-01-03. + + * gmp.texi (Introduction to GMP): Mention release announcements + mailing list, and put home page and ftp before mailing lists. + +2002-12-28 Torbjorn Granlund + + * mpn/generic/mul_fft.c (mpn_fft_next_size): Simplify. + +2002-12-28 Kevin Ryde + + * acinclude.m4 (M68K_PATTERN): New macro. + (GMP_GCC_M68K_OPTIMIZE): Use it to avoid m6811 and friends. + * configure.in: Ditto. + + * tests/mpz/t-import.c, tests/mpz/t-export.c: Use '\xHH' to avoid + warnings about char overflows. + * acinclude.m4 (GMP_C_DOUBLE_FORMAT): Ditto. + +2002-12-28 Pedro Gimeno + + * randmt.c (randseed_mt, default_state): Fix off-by-one bug on padding. + (randseed_mt): Add ASSERT checking result of mpz_export. + +2002-12-24 Kevin Ryde + + * gmp.texi (Integer Import and Export): Clarify treatment of signs, + reported by Kent Boortz. + + * randmt.c: Use gmp_uint_least32_t. + (randseed_mt): Add nails to mpz_export in case mt[i] more than 32 bits. + + * gmp-impl.h (gmp_uint_least32_t): New typedef, replacing GMP_UINT32. + * configure.in (AC_CHECK_TYPES): Add uint_least32_t. + (AC_CHECK_SIZEOF): Add unsigned short. + +2002-12-22 Kevin Ryde + + * gmp-impl.h (ULONG_PARITY) [generic C]: Mask result to a single bit. + (ULONG_PARITY) [_CRAY, __ia64]: New macros. + * tests/t-parity.c: New test. + * tests/Makefile.am (check_PROGRAMS): Add it. + + * longlong.h (count_trailing_zeros) [ia64]: New macro. + + * tests/t-count_zeros.c (check_various): Remove unused variable "n". + + * mpn/x86/README: Revise notes on PIC, PLT and GOT. + + * demos/perl/GMP.xs, demos/perl/GMP.pm, demos/perl/test.pl: Add "mt" + to GMP::Rand::randstate. + +2002-12-22 Pedro Gimeno + + * randmt.c (randseed_mt): Fix bug that might cause the generator to + return all zeros with certain seeds. Fix WARM_UP==0 case. + (gmp_randinit_mt): Initialize to a known state by default. + (randget_mt): Remove check for uninitialized buffer: no longer needed. + (recalc_buffer): Use ?: instead of two-element array. + + * tests/rand/t-mt.c: New test. + * tests/rand/Makefile.am (check_PROGRAMS): Add it. + +2002-12-21 Kevin Ryde + + * cxx/osdoprnti.cc: Use and rather than + and . No need for . + + * demos/expr/expr.c, demos/expr/exprfa.c, demos/expr/exprfra.c, + demos/expr/exprza.c: Use mp_get_memory_functions, not + __gmp_allocate_func etc. + * demos/expr/t-expr.c: Don't use gmp-impl.h. + (numberof): New macro. + + * gmp-h.in, gmp-impl.h (__gmp_allocate_func, __gmp_reallocate_func, + __gmp_free_func): Move declarations to gmp-impl.h + + * mp_get_fns.c: New file. + * Makefile.am (libgmp_la_SOURCES, libmp_la_SOURCES): Add it. + * gmp-h.in (mp_get_memory_functions): Add prototype. + * gmp.texi (Custom Allocation): Add mp_get_memory_functions, refer to + "free" not "deallocate" function. + * gmpxx.h (struct __gmp_alloc_cstring): Use mp_get_memory_functions, + not __gmp_free_func. + + * gmp-impl.h [__cplusplus]: Add for strlen. + (gmp_allocated_string): Hold length in a field. + * cxx/osdoprnti.cc, cxx/osmpf.cc: Use this. + +2002-12-20 Torbjorn Granlund + + * tests/mpz/t-perfsqr.c (check_sqrt): Print more variables upon + failure. + + * mpn/generic/rootrem.c: In Newton loop, pad qp with leading zero. + +2002-12-19 Torbjorn Granlund + + * mpn/generic/rootrem.c: Allocate 1.585 (log2(3)) times more space + for pp temporary to allow for worst case overestimate of root. + Add some asserts. + + * tests/mpz/t-root.c: Generalize and speed up. + +2002-12-19 Kevin Ryde + + * tests/cxx/t-rand.cc (check_randinit): Add gmp_randinit_mt test. + + * gmp-h.in: Don't bother trying to support Compaq C++ in pre-standard + I/O mode. + * gmp.texi (Notes for Particular Systems): Compaq C++ must be used in + "standard" iostream mode. + +2002-12-18 Torbjorn Granlund + + * mpn/alpha/mod_34lsub1.asm: Add code for big-endian, using existing + little-endian code only if HAVE_LIMB_LITTLE_ENDIAN is defined. + +2002-12-18 Kevin Ryde + + * configure.in (HAVE_LIMB_BIG_ENDIAN, HAVE_LIMB_LITTLE_ENDIAN): New + defines in config.m4. + +2002-12-17 Torbjorn Granlund + + * printf/printffuns.c (gmp_fprintf_reps): Make it actually work + for padding > 256. + +2002-12-17 Kevin Ryde + + * tune/freq.c: Add for memcmp. + + * mpz/pprime_p.c: Use MPN_MOD_OR_MODEXACT_1_ODD. + + * gmp.texi (Formatted Output Strings): %a and %A are C99 not glibc. + (Formatted Input Strings): Type "l" is for double too. Hex floats are + accepted for mpf_t. + (Formatted Input Functions): Describe tightened parse rule, clarify + return value a bit. + + * scanf/doscan.c: Add hex floats, tighten matching to follow C99, for + instance "0x" is no longer acceptable to "%Zi". + Rename "invalid" label to avoid "invalid" variable, SunOS cc doesn't + like them the same. + * tests/misc/t-scanf.c: Update tests. + * tests/misc/t-locale.c (check_input): Don't let "0x" appear from fake + decimal point. + + * config.guess (sparc*-*-*): Look at BSD sysctl hw.model to recognise + ultrasparcs. + + * mpfr/tests/dummy.c: New file. + * mpfr/tests/Makefile.am (libfrtests_a_SOURCES): Add it. + +2002-12-14 Kevin Ryde + + * mpbsd/Makefile.am (nodist_libmpbsd_la_SOURCES): Move these mpz + sources to libmpbsd_la_SOURCES directly, automake 1.7.2 now gets the + ansi2knr setups right for sources in other directories. + + * mpfr/tests/Makefile.am: Add libfrtests.a in preparation for new mpfr. + +2002-12-13 Kevin Ryde + + * mpfr/Makefile.am (mpfr_TEXINFOS, AM_MAKEINFOFLAGS): Allow for + fdl.texi in recent mpfr. + + * configure.in (AC_PROG_EGREP): Ensure this is run outside the Cray + conditional AC_EGREP_CPP. + + * configure.in (alpha*-*-*): Use gcc -Wa,-oldas if it works, to avoid + problems with new compaq "as" on OSF 5.1. + + * mpn/Makefile.am (EXTRA_DIST): Remove Makeasm.am, automake 1.7.2 does + it automatically. + + * acinclude.m4 (AC_LANG_FUNC_LINK_TRY(C)): Remove this hack, fixed by + autoconf 2.57. + + * configure.in (AC_CONFIG_LIBOBJ_DIR): Set to mpfr, for the benefit of + new mpfr using LIBOBJ. + + * configure.in: (AM_INIT_AUTOMAKE): Use "gnu no-dependencies + $(top_builddir)/ansi2knr". + * */Makefile.am (AUTOMAKE_OPTIONS): Remove, now in configure.in. + + * configure, config.in, INSTALL.autoconf: Update to autoconf 2.57. + * */Makefile.in, configure, aclocal.m4, install-sh, mkinstalldirs: + Update to automake 1.7.2. + + * gmp.texi (Build Options): Add hppa64 to cpu types. + (ABI and ISA): Add gcc to hppa 2.0. + (Debugging): Add maximum debuggability config options. + (Language Bindings): Add Arithmos, reported by Johan Vervloet. + (Formatted Output Strings): 128 bits is about 40 digits, ll is only + for long long not long double. + (Formatted Input Strings): ll is only for long long not long double. + + * mpz/divis.c, mpz/divis_ui.c, mpz/cong.c, mpz/cong_ui.c: Allow d=0, + under the rule n==c mod d iff exists q satisfying n=c+q*d. + * gmp.texi (Integer Division): Describe this. + Suggested by Jason Moxham. + +2002-12-13 Pedro Gimeno + + * randlc2x.c (lc): Remove check for seedn < an, which is now + superfluous. Add ASSERT to ensure it's correct. Add ASSERT to check + precondition of __GMPN_ADD. + (gmp_randinit_lc_2exp): Avoid reallocation by allocating one extra bit + for both seed and a. Simplify seedn < p->_cn case. + + * tests/rand/t-lc2exp.c (check_bigs): Test negative seeds. + +2002-12-12 Torbjorn Granlund + + * mpn/pa32/pa-defs.m4 (PROLOGUE_cpu): Zap spurious argument to `.proc'. + Add empty `.callinfo'. + +2002-12-11 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/addmul_1.asm: Don't reuse `ret' symbol for a + label. + +2002-12-11 Kevin Ryde + + * configure.in (hppa*-*-*): Don't use gcc -mpa-risc-2-0 in ABI=1.0. + + * mpn/pa32/pa-defs.m4: New file, arranging for .proc/.procend. + * configure.in (hppa*-*-*): Use it. + + * printf/doprnt.c: Comments on "ll" versus "L". + + * tests/mpz/t-div_2exp.c: Reduce tests, especially the random ones. + +2002-12-11 Torbjorn Granlund + + * mpz/get_d.c (limb2dbl): New macro for conversion to `double'. + Define it to something non-trivial for 64-bit hppa. + * mpq/get_d.c: Likewise. + * mpf/get_d.c: Likewise. + + * mpn/x86/pentium4/sse2/addmul_1.asm: Unroll to save one c/l. + +2002-12-09 Kevin Ryde + + * tune/Makefile.am: Don't use -static under --disable-static, it tends + not to work. + * configure.in (ENABLE_STATIC): New AM_CONDITIONAL. + + * gmp-h.in: Use instead of with Compaq C++ in + pre-standard I/O mode. + + * tests/mpz/t-jac.c, tests/mpz/t-scan.c: Reduce tests. + +2002-12-08 Kevin Ryde + + * configure.in (*-*-ultrix*): Remove forcible --disable-shared, + believe this was a generic problem with libtool, now gone. + +2002-12-08 Torbjorn Granlund + + * gmp-impl.h (USE_LEADING_REGPARM): Disable for PIC code generation. + +2002-12-07 Torbjorn Granlund + + * tests/cxx/t-misc.cc (check_mpq): Use 0/1 for canonical 0 in + mpq_cmp_ui calls. + + * configure.in (hppa2.0*-*-*): Pass +O2 instead of +O3 to work around + compiler bug with mpfr/tests/tdiv. + +2002-12-07 Kevin Ryde + + * configure.in (hppa2.0*-*-* ABI=2.0n): Make -mpa-risc-2-0 optional. + New hppa-level-2.0 test using GMP_HPPA_LEVEL_20 to detect assembler + support for 2.0n. + * acinclude.m4 (GMP_PROG_CC_WORKS): Add code that provokes an error + from gcc -mpa-risc-2-0 if the assembler doesn't know 2.0 instructions. + (GMP_HPPA_LEVEL_20): New macro. + +2002-12-07 Pedro Gimeno + + * gmp-impl.h (gmp_randfnptr_t.randseed_fn) Return void. + (LIMBS_PER_ULONG, MPN_SET_UI): New macros. + (MPZ_FAKE_UI): Rename couple of parameters. + + * randlc2x.c (gmp_rand_lc_struct): _mp_c and _mp_c_limbs replaced + with mpn style _cp and _cn. All callers changed. + (randseed_lc): Fix limbs(seed) > bits_to_limbs(m2exp) case. + Remove return value. + (gmp_randinit_lc_2exp): Attempt to avoid redundant reallocation. + + * randmt.c (mangle_seed): New function by Kevin. + (randseed_mt): Use it instead of mpz_powm, for performance. Remove + return value. Remove commented out code (an inferior alternative to + mpz_export). + + * randsdui.c (gmp_randseed_ui): Use MPZ_FAKE_UI. + + * tests/rand/t-lc2exp.c (check_bigm, check_bigs): New tests. + * tests/rand/t-urndmm.c: Add L to constants in calls, for K&R. + +2002-12-06 Torbjorn Granlund + + * configure.in: Remove -g. + (hppa*-*-*): Pass -Wl,+vnocompatwarnings with +DA2.0. + +2002-12-05 Torbjorn Granlund + + * mpn/pa64/sqr_diagonal.asm: Remove .entry, .proc, .procend. + * mpn/pa64/udiv.asm: Likewise. + +2002-12-05 Kevin Ryde + + * mpn/pa64/sub_n.asm: Remove space in "sub, db" which gas objects to. + * mpn/pa64/*.asm, tune/hppa2.asm: Use ".level 2.0" for 2.0n, since gas + doesn't like ".level 2.0N". + + * configure.in (hppa*-*-*): Group path and flags choices, for clarity. + (hppa1.0*-*-*): Use gcc -mpa-risc-1-0 when available. + (hppa2.0*-*-*): Ditto -mpa-risc-2-0. + (*-*-hpux*): Exclude ABI=2.0w for hpux[1-9] and hpux10, rather than + the converse of allowing it for hpux1[1-9]; ie. list the bad systems + rather than try to guess the good systems. + (hppa2.0*-*-*) [ABI=2.0n ABI=2.0w]: Add gcc to likely compilers. + (hppa*-*-*) [gcc]: Test sizeof(long) to differentiate a 32-bit or + 64-bit build of the compiler. + (hppa64-*-*): Add this as equivalent to hppa2.0-*-*. + * acinclude.m4 (GMP_C_TEST_SIZEOF): New macro. + + * tests/tests.h (ostringstream::str): Must null-terminate + ostrstream::str() for the string constructor. + +2002-12-04 Torbjorn Granlund + + * mpn/pa32/hppa1_1/udiv.asm: Don't wrap symbol to INT64 in L() stuff. + + * longlong.h (mpn_udiv_qrnnd_r based udiv_qrnnd): Fix typo. + + * mpn/powerpc32/powerpc-defs.m4: Define float registers with `f' + prefix. + +2002-12-04 Kevin Ryde + + * gmp.texi (Floating-point Functions): Note the mantissa is binary and + decimal fractions cannot be represented exactly. Suggested by Serge + Winitzki. + (Known Build Problems): Note libtool stripping options when linking. + Reported by Vincent Lefevre. + + * acinclude.m4 (GMP_ASM_LABEL_SUFFIX): Don't make an empty result a + failure, that's a valid result. + (GMP_ASM_GLOBL): Establish this from the host cpu type. + (IA64_PATTERN): New macro. + (GMP_PROG_EXEEXT_FOR_BUILD, GMP_C_FOR_BUILD_ANSI, + GMP_CHECK_LIBM_FOR_BUILD): Remove temporary files created. + * configure.in: Use IA64_PATTERN. + +2002-12-03 Torbjorn Granlund + + * tune/hppa.asm: Use config.m4. + * tune/hppa2.asm: Likewise. + * tune/hppa2w.asm: Likewise. + + * mpn/pa64: Use LDEF. + +2002-12-03 Kevin Ryde + + * INSTALL: Use return rather than exit in the example programs. + Suggested by Richard Dawe. + + * gmp.texi (Build Options): Move non-unix notes to ... + (Notes for Particular Systems): ... here. Mention MS Interix, + reported by Paul Leyland. + (C++ Interface Random Numbers): Add gmp_randinit_mt to examples. + + * acinclude.m4 (GMP_ASM_LABEL_SUFFIX): Must test empty suffix first, + for the benefit of hppa hp-ux. + (GMP_ASM_UNDERSCORE): Grep the output of "nm" instead of trying to + construct an asm file, and in case of failure fallback on no + underscore and a warning. + + * longlong.h (count_leading_zeros, count_trailing_zeros) [ev67, ev68]: + Restrict __asm__ ctlz and cttz to __GNUC__. + + * gen-psqr.c (HAVE_CONST, const): New macros. + + * tests/cxx/t-rand.cc (check_randinit): Add gmp_randinit_mt. + +2002-12-02 Torbjorn Granlund + + * gmp-impl.h: Split popc_limb again, combined version gives too many + compiler warnings. + +2002-12-01 Torbjorn Granlund + + * mpn/generic/gcdext.c (div1): Disable unused function. + + * mpz/root.c: Don't include stdlib.h or longlong.h. + * mpz/rootrem.c: Likewise. + + * extract-dbl.c: abort => ASSERT_ALWAYS. + * mpz/set_d.c: Likewise. + * mpn/generic/tdiv_qr.c: Likewise. + + * gen-psqr.c (f_cmp_fraction, f_cmp_divisor): Change parameter to + `const void *', to match qsort spec. + +2002-12-01 Kevin Ryde + + * gmp.texi (Integer Division): Fix a couple of @math's for tex. + Use @dots in more places. + + * tests/cxx/t-locale.cc: Test non std::locale systems too. + * tests/cxx/clocale.c: New file, reinstating what was localeconv.c, + and subverting nl_langinfo too. + * tests/cxx/Makefile.am (t_locale_SOURCES): Add it. + + * tests/tests.h (ostringstream, istringstream): Provide fakes of these + if not available. + * tests/cxx/t-locale.cc, tests/cxx/t-ostream.cc: Remove . + * configure.in (AC_CHECK_HEADERS) [C++]: Add . + +2002-11-30 Torbjorn Granlund + + * printf/doprnt.c (__gmp_doprnt): Comment out a `break' to shut up + compiler warnings. + + * mpn/ia64/invert_limb.asm: Add `many' hints to return insns. + + * mpn/ia64/divrem_1.asm: Allocate more local registers; put b0 in + one of them. + + * mpn/ia64/popcount.asm: Properly restore register ar.lc. + + * longlong.h (umul_ppmm) [ia64]: Form both product parts in asm. + + * mpz/bin_uiui.c: Cast umul_ppmm operands. + + * scanf/doscan.c (gmpscan): Remove unused label store_get_digits. + + * gmp-impl.h: #undef MIN and MAX before #defining. + + * mpn/ia64/copyi.asm: Add `;' after bundle declarators. + * mpn/ia64/copyd.asm: Likewise. + + * mpn/ia64/divrem_1.asm: Add some syntax to placid the HP-UX assembler. + +2002-11-30 Kevin Ryde + + * configure.in (AC_CHECK_HEADERS): Add nl_types.h. + * tests/misc/t-locale.c: Use this, for nl_item on netbsd 1.4.1. + +2002-11-29 Torbjorn Granlund + + * tests/devel/addmul_1.c: Provide prototype for mpn_print. + (OPS): Account for function overhead. + * tests/devel/{submul_1.c,mul_1.c,add_n.c,sub_n.c}: Likewise. + + * mpn/ia64/addmul_1.asm: Rewrite. + +2002-11-28 Torbjorn Granlund + + * mpn/ia64/sqr_diagonal.asm: Don't allocate any registers. + + * mpn/ia64/submul_1.asm: Adapt to Itanium 2. + + * mpn/ia64/mul_1.asm: Fix typo in HAVE_ABI_32 code. + + * mpn/ia64/add_n.asm: Rewrite. + * mpn/ia64/sub_n.asm: Rewrite. + +2002-11-28 Kevin Ryde + + * mpn/Makefile.am (nodist_EXTRA_libmpn_la_SOURCES): Use this rather + than libdummy. + * tests/Makefile.am (EXTRA_libtests_la_SOURCES): Use this for + x86call.asm and x86check.c rather than libdummy. + +2002-11-27 Torbjorn Granlund + + * tests/mpz/t-mul.c: Implement reference Karatsuba multiplication. + Rewrite testing scheme to run fewer really huge tests. + +2002-11-26 Torbjorn Granlund + + * tests: Decrease repetition count for some of the slowest tests. + + * mpn/ia64/divrem_1.asm: New file. + +2002-11-25 Torbjorn Granlund + + * mpfr/tests/tdiv.c: Decrease number of performed tests. + +2002-11-23 Torbjorn Granlund + + * mpn/ia64/mul_1.asm: Rewrite. + +2002-11-23 Kevin Ryde + + * mpn/ia64/README: Add some references. + + * gmp.texi (Build Options): Add itanium and itanium2, mention DocBook + and XML from makeinfo, add texinfo top level cross reference. + (Integer Division): Try to clarify 2exp functions a bit. + (C++ Interface Floats): Giving bad string to constructor is undefined. + (C++ Interface Integers, C++ Interface Rationals): Ditto, and show + default base in prototype, not the description. + + * config.sub, config.guess, configure.in (itanium, itanium2): New cpu + types. + + * tests/misc/t-printf.c, tests/misc/t-scanf.c (check_misc): Suppress + %zd test on glibc prior to 2.1, it's not supported. + +2002-11-22 Torbjorn Granlund + + * mpn/ia64/copyi.asm: Optimize for Itanium 2. + * mpn/ia64/copyd.asm: Likewise. + +2002-11-20 Torbjorn Granlund + + * mpn/ia64/sqr_diagonal.asm: New file. + + * mpn/ia64/submul_1.asm: Handle vl == 0 specially. + +2002-11-20 Kevin Ryde + + * tests/cxx/t-locale.cc: Test with locales imbued into stream, use + , eliminated some C-isms. istream tests disabled, not yet + locale-ized. + * tests/cxx/Makefile.am (t_locale_SOURCES): Remove localeconv.c. + * tests/cxx/localeconv.c: Remove file. + + * configure.in (AC_CHECK_TYPES) [C++]: Add std::locale. + * printf/doprntf.c: Add decimal point parameter, remove localeconv use. + * gmp-impl.h (__gmp_doprnt_mpf): Update prototype, bump symbol to + __gmp_doprnt_mpf2 to protect old libgmpxx. + * cxx/osmpf.cc: Use this with ostream locale decimal_point facet. + * printf/doprnt.c: Ditto, with GMP_DECIMAL_POINT. + + * gmp-h.in: More comments on __declspec for windows DLLs. + + * mpf/set_str.c, scanf/doscan.c: Cast through "unsigned char" for + decimal point string, same as input chars. + + * configure.in (AC_CHECK_HEADERS): Add langinfo.h. + (AC_CHECK_FUNCS): Add nl_langinfo. + * gmp-impl.h (GMP_DECIMAL_POINT): New macro. + * mpf/out_str.c, mpf/set_str.c, scanf/doscan.c: Use it, and don't + bother with special code for non-locale systems. + * tests/misc/t-locale.c: Subvert nl_langinfo too. + + * configure.in, acinclude.m4 (GMP_ASM_X86_GOT_UNDERSCORE): New macro. + * mpn/x86/x86-defs.m4 (_GLOBAL_OFFSET_TABLE_): New macro, inserting + extra underscore for OpenBSD. + * mpn/x86/README (_GLOBAL_OFFSET_TABLE_): Update notes. + Reported by Christian Weisgerber. + + * tests/cxx/t-rand.cc (check_randinit): New function, collecting up + constructor tests. + + * tests/cxx/t-ostream.cc: Use instead of , use + compare instead of strcmp. + + * gmpxx.h (__gmp_randinit_lc_2exp_size_t): Return type is int. + +2002-11-18 Kevin Ryde + + * tune/speed.c (r_string): Use CNST_LIMB with bits, spotted by + Torbjorn. + +2002-11-19 Torbjorn Granlund + + * mpn/ia64/mul_1.asm: Remove redundant cmp from prologue code. + Streamline prologue. + * mpn/ia64/addmul_1.asm: Likewise. + * mpn/ia64/submul_1.asm: New file. + * mpn/ia64/submul_1.c: Remove. + +2002-11-17 Torbjorn Granlund + + * mpn/generic/popham.c: New file, using new faster algorithm. + * mpn/generic/popcount.c: Remove. + * mpn/generic/hamdist.c: Remove. + + * mpn/ia64/addmul_1.asm: Don't clobber callee-saves register f16. + * mpn/ia64/mul_1.asm: Likewise. + + * mpn/ia64/addmul_1.asm: Add pred.rel declarations. Resolve RAW + hazards for condition code registers, duplicating code as needed. Add + prediction to all branches. + * mpn/ia64/mul_1.asm: Likewise. + * mpn/ia64/add_n.asm: Likewise. + * mpn/ia64/sub_n.asm: Likewise. + * mpn/ia64/copyi.asm: Likewise. + * mpn/ia64/copyd.asm: Likewise. + + * mpn/generic/random2.c: Add a cast to silence some compilers. + +2002-11-16 Torbjorn Granlund + + * mpz/powm.c: Cap allocation by limiting k to 10 (512 precomputed + values). + +2002-11-16 Kevin Ryde + + * configure.in, gmp.texi: Remove powerpc64 ABI=32L, doesn't work and + is unlikely to ever do so. + * configure.in: Allow ABI=32 for powerpc64. + Reported by David Edelsohn. + +2002-11-14 Kevin Ryde + + * mpn/Makefile.am (nodist_libdummy_la_SOURCES): Add addmul_2.c + addmul_3.c addmul_4.c addmul_5.c addmul_6.c addmul_7.c addmul_8.c. + + * gmp-h.in (__GMP_DECLSPEC_EXPORT, __GMP_DECLSPEC_IMPORT) [__GNUC__]: + Use __dllexport__ and __dllimport__ to keep out of application + namespace. + +2002-11-14 Gerardo Ballabio + + * gmpxx.h (__gmp_randinit_default_t, __gmp_randinit_lc_2exp_t, + __gmp_randinit_lc_2exp_size_t): Use extern "C" { typedef ... }, for + the benefit of g++ prior to 3.2. + +2002-11-12 Kevin Ryde + + * gmpxx.h (gmp_randclass constructors): Patch from Roberto Bagnara to + use extern "C" on C function pointer arguments. + +2002-11-09 Kevin Ryde + + * configure.in, Makefile.am, printf/Makefile.am, + printf/repl-vsnprintf.c: Handle vsnprintf replacement with C + conditionals. + + * acinclude.m4 (AC_LANG_FUNC_LINK_TRY(C)): Workaround troubles recent + HP cc +O3 causes for AC_CHECK_FUNCS. + + * gmp.texi (Notes for Particular Systems): Add Sparc app regs. + (Debugging): Note gcc -fstack options to detect overflow. + (Formatted Output Strings, Formatted Input Strings): Format strings + are not multibyte. + +2002-11-06 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Remove a bogus assert. + +2002-11-05 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Remove two dead mpn_divrem_2 calls. + +2002-11-04 Kevin Ryde + + * acinclude.m4 (GMP_C_INLINE): Don't define "inline" for C++. + + * demos/expr/expr-impl.h (stdarg.h): Test __DECC same as gmp.h. + + * mpbsd/mtox.c, printf/obprintf.c, printf/obvprintf.c, + scanf/vsscanf.c, demos/expr/expr.c, demos/expr/exprf.c, + demos/expr/exprfa.c, demos/expr/exprfr.c, demos/expr/exprq.c, + demos/expr/exprz.c, demos/expr/exprza.c: Add for strlen and + memcpy. + +2002-11-02 Kevin Ryde + + * longlong.h: Test __x86_64__ not __x86_64. Reported by Andreas + Jaeger. + + * mpz/import.c, mpz/export.c: Use char* subtract from NULL to get + pointer alignment, for the benefit of Cray vector systems. + + * cxx/ismpf.cc: Use . + * tests/cxx/t-locale.cc: No need to conditionalize . + + * scanf/doscan.c: Don't use isascii, rely on C99 ctype.h. + + * gmp.texi (Build Options): Describe CC_FOR_BUILD, cross reference + texinfo manual. + (ABI and ISA): Add powerpc620 and powerpc630 to powerpc64, add NetBSD + and OpenBSD sparc64. + (Notes for Package Builds): Cross reference libtool manual. + (Notes for Particular Systems): Add OpenBSD to non-MMX versions of gas. + (Known Build Problems): Add MacOS X C++ shared libraries. + +2002-10-31 Kevin Ryde + + * gmp-impl.h, tune/speed.c, tune/speed.h, tune/common.c, tune/many.pl, + tests/devel/try.c, tests/tests.h, tests/refmpn.c (mpn_addmul_5, + mpn_addmul_6, mpn_addmul_7, mpn_addmul_8): Add testing and measuring. + * configure.in (config.in): Add #undefs of HAVE_NATIVE_mpn_addmul_5, + HAVE_NATIVE_mpn_addmul_6, HAVE_NATIVE_mpn_addmul_7, + HAVE_NATIVE_mpn_addmul_8. + (gmp_mpn_functions_optional): Add addmul_5 addmul_6 addmul_7 addmul_8. + + * tests/devel/try.c (ASSERT_CARRY): Remove, now in gmp-impl.h + (try_one): Do dest setups after sources, for benefit of + dst0_from_src1. + +2002-11-01 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Avoid quadratic behaviour for + sub-division when numerator is more than twice the size of the + denominator. Simplify loop logic for the same case. Clean up a + few comments. + +2002-10-29 Torbjorn Granlund + + * configure.in (*-cray-unicos*): Pass -hnofastmd again. + +2002-10-25 Torbjorn Granlund + + * tests/tadd.c: Disable test of denorms. + +2002-10-23 Linus Nordberg + + * gmp.texi (Introduction to GMP): Update section about mailing + lists. + +2002-10-23 Kevin Ryde + + * gmp-h.in (__GMP_ATTRIBUTE_PURE): Suppress this when + __GMP_NO_ATTRIBUTE_CONST_PURE is defined. + * gmp-impl.h (ATTRIBUTE_CONST): Ditto. + * tune/common.c: Use __GMP_NO_ATTRIBUTE_CONST_PURE. + + * tune/speed.h, tune/many.pl: Remove ATTRIBUTEs from prototypes. + * tune/speed.h: Remove various "dummy" variables attempting to keep + "pure" calls live, no longer necessary. They weren't sufficient for + recent MacOS cc anyway. + +2002-10-21 Torbjorn Granlund + + * mpn/cray/ieee/addmul_1.c: Handle overlap as in mul_1.c. + * mpn/cray/ieee/submul_1.c: Likewise. + +2002-10-19 Kevin Ryde + + * configure.in (sparcv9 etc -*-*bsd*): Add support for NetBSD and + OpenBSD sparc64. Reported by Christian Weisgerber. + (AC_CHECK_HEADERS): Add sys/param.h for sys/sysctl.h on *BSD. + + * demos/calc/calc.y: Change ={ to {, needed for bison 1.50. + + * longlong.h (count_leading_zeros, count_trailing_zeros) [x86_64]: + Should be UDItype. + + * mpz/set_str.c, mpf/set_str.c, mpbsd/xtom.c, scanf/sscanffuns.c: Cast + chars through "unsigned char" to zero extend, required by C99 ctype.h. + +2002-10-18 Torbjorn Granlund + + * tests/mpz/t-root.c: Test also mpz_rootrem. + + * mpn/generic/rootrem.c: Avoid overflow problem when n is huge. + + * mpz/root.c: Avoid overflow problems in allocation computation; also + simplify it. Misc cleanups. + + * mpz/rootrem.c: New file. + * Makefile.am, mpz/Makefile.am, gmp-h.in: Add them. + +2002-10-17 Torbjorn Granlund + + * gmp-impl.h (popc_limb): Combine variants. + +2002-10-14 Kevin Ryde + + * configure.in (AC_CHECK_HEADERS): Add sys/time.h for sys/resource.h + test, needed by SunOS, and next autoconf will insist headers actually + compile. + +2002-10-08 Kevin Ryde + + * tune/time.c (speed_time_init): Allow for Cray times() apparently + being a cycle counter. + + * dumbmp.c (mpz_get_str): Fix buf size allocation. + + * tests/trace.c, tests/tests.h (mp_limb_trace): New function. + + * tune/speed-ext.c (SPEED_EXTRA_PROTOS): Use __GMP_PROTO. + * tests/devel/try.c (malloc_region): Add a cast for SunOS cc. + + * configure.in (AC_CHECK_FUNCS): Add strerror. + (AC_CHECK_DECLS): Add sys_errlist, sys_nerr. + * tune/time.c, tests/devel/try.c: Use them. + +2002-10-05 Kevin Ryde + + * configure.in (AC_CHECK_HEADERS): Test float.h, not in SunOS cc. + * printf/repl-vsnprintf.c: Use this. + + * configure.in (*sparc*-*-*): Collect up various options for clarity, + use gcc -mcpu=supersparc and ultrasparc3, use cc -xchip, don't use + -xtarget=native, use cc configs with acc, merge SunOS bundled cc and + SunPRO cc configs. + + * gmp-impl.h (gmp_randfnptr_t): Use __GMP_PROTO. + (MPZ_REALLOC): Cast _mpz_realloc return value to mp_ptr, for the + benefit of SunOS cc which requires pointers of the same type on the + two legs of a ?:. + + * dumbmp.c (mpz_realloc): Add a cast to avoid a warning from SunOS cc. + + * acinclude.m4: Allow for i960 b.out default cc output. + + * gmp.texi (Random State Initialization): Add gmp_randinit_mt. + (Perfect Square Algorithm): Describe new mpn_mod_34lsub1 use. + (Factorial Algorithm): Describe Jason's new code. + (Binomial Coefficients Algorithm): Ideas about improvements + moved to doc/projects.html. + (Contributors): Add Jason Moxham and Pedro Gimeno. + +2002-10-03 Kevin Ryde + + * gen-psqr.c: New file. + * Makefile.am, mpn/Makefile.am: Use it to generate mpn/perfsqr.h. + * mpn/generic/perfsqr.c: Use generated data, put mod 256 data into + limbs to save space, use mpn_mod_34lsub1 when good. + * tests/mpn/t-perfsqr.c: New file. + * tests/mpn/Makefile.am (check_PROGRAMS): Add it. + * tests/mpz/t-perfsqr.c (check_modulo): New test. + (check_sqrt): New function holding current tests. + + * configure.in (AC_INIT): Modernize to package name and version here + rather than AM_INIT_AUTOMAKE, add bug report email. + (AC_CONFIG_SRCDIR): New macro. + + * gmp-impl.h (ROUND_UP_MULTIPLE): Fix for non-power-of-2 moduli (not + normal in current uses), clarify the comments a bit. + +2002-09-30 Kevin Ryde + + * mpn/Makeasm.am (.s.lo): Add --tag=CC for the benefit of CCAS!=CC, + same as .S.lo and .asm.lo. + + * Makefile.am (gen-fac_ui, gen-fib, gen-bases): Quote source files in + test -f stuff to avoid Sun make rewriting them. + +2002-09-28 Kevin Ryde + + * tests/devel/try.c, tune/speed.c: Avoid strings longer than C99 + guarantees. + + * tests/refmpn.c, tests/tests.h (refmpn_zero_extend, refmpn_normalize, + refmpn_sqrtrem): New functions. + * tests/devel/try.c (TYPE_SQRTREM): Use refmpn_sqrtrem. + (compare): Correction to tr->dst_size subscripting. + + * dumbmp.c: Add several new functions, allow for initial n + + * dumbmp.c (mpz_pow_ui, mpz_addmul_ui, mpz_root): New functions. + * gen-fac_ui.c: New file. + * mpz/fac_ui.c: Rewrite. + +2002-09-26 Kevin Ryde + + * tests/cxx/localeconv.c: New file, split from t-locale.cc. + * tests/cxx/t-locale.cc: Use it. + * tests/cxx/Makefile.am (t_locale_SOURCES): Add it. + + * tests/cxx/Makefile.am: Updates for Gerardo's new test programs. + +2002-09-26 Gerardo Ballabio + + * gmpxx.h (__gmp_cmp_function): Bug fixes in double/mpq and + double/mpfr comparisons. + + * tests/cxx/t-assign.cc, tests/cxx/t-binary.cc, tests/cxx/t-constr.cc, + tests/cxx/t-ternary.cc, tests/cxx/t-unary.cc: Revise and add various + tests, including some for mpfr, some split from t-expr.cc. + * tests/cxx/t-locale.cc: Modernize include files. + * tests/cxx/t-ostream.cc: Modernize include files, use cout rather + than printf for diagnostics. + * tests/cxx/t-misc.cc, tests/cxx/t-rand.cc: New file, split from + t-allfuns.cc. + * tests/cxx/t-ops.cc: New file, some split from t-allfuns.cc. + * tests/cxx/t-prec.cc: New file. + * tests/cxx/t-allfuns.cc, tests/cxx/t-expr.cc: Remove files. + +2002-09-25 Torbjorn Granlund + + * configure.in (*-cray-unicos*): Remove -hscalar0, it causes too much + performance loss. Let's trust Cray to fix their compilers. + +2002-09-24 Torbjorn Granlund + + * mpn/powerpc32/add_n.asm: Rewrite. + * mpn/powerpc32/sub_n.asm: Rewrite. + +2002-09-24 Pedro Gimeno + + * randlc2x.c: Prepare for nails by changing type of _mp_c to mpz_t, + make _mp_seed fixed-size, disallow SIZ(a)==0 to optimize comparisons + for mpn_mul. + * gmp-impl.h (MPZ_FAKE_UI): New macro. + + * randmt.c: Some constants made long for K&R compliance; remove UL at + the end of other constants; use mp_size_t where appropriate; use + mpz_export to split the seed. + + * gmp-impl.h: Remove type cast in RNG_FNPTR and RNG_STATE, to allow + them to be used as lvalues. + * randclr.c, randlc2x.c, randmt.c, randsd.c: All callers changed. + + * mpz/urandomm.c: Replace mpn_cmp with MPN_CMP. + + * tests/rand/gen.c: Get rid of gmp_errno. + +2002-09-24 Kevin Ryde + + * gmp.texi (Custom Allocation): Keep allocate_function etc out of the + function index by using @deftypevr. + More index entries. + +2002-09-24 Gerardo Ballabio + + * gmpxx.h (mpfr_class constructors from strings): Precision was set + incorrectly, fixed. + +2002-09-23 Torbjorn Granlund + + * mpf/urandomb.c: Don't crash for overlarge nbits argument. + Let nbits==0 mean to fill number with random bits. + +2002-09-21 Torbjorn Granlund + + * mpn/alpha/mod_34lsub1.asm: Add r31 dummy operand to `br' instruction. + +2002-09-20 Gerardo Ballabio + + * gmpxx.h (__gmp_binary_equal, __gmp_binary_not_equal): Fix broken + mpq/double functions. + +2002-09-18 Torbjorn Granlund + + * randmt.c (randget_mt): Fix typo. + +2002-09-18 Kevin Ryde + + * gmp-impl.h (_gmp_rand): Avoid evaluating "state" more than once, for + the benefit places calling it with RANDS. + + * randmt.c (randseed_mt): Use mpz_init for mod and seed1, for safety. + + * tune/tuneup.c (sqr_karatsuba_threshold): Initialize to + TUNE_SQR_KARATSUBA_MAX so mpn_sqr_n works for randmt initialization. + + * gmp.texi (Integer Comparisons): Remove mention of non-existent + mpz_cmpabs_si, reported by Conrad Curry. + + * tune/speed.c, tune/speed.h, tune/common.c: Add gmp_randseed, + gmp_randseed_ui and mpz_urandomb. + +2002-09-18 Pedro Gimeno + + * tests/rand/gen.c: Add mt, remove lc and bbs. + + * Makefile.am (libgmp_la_SOURCES): Add randmt.c, remove randlc.c and + randraw.c. + + * randmt.c: New file. + * gmp-h.in (gmp_randinit_mt): Add prototype. + * randdef.c: Use gmp_randinit_mt. + + * gmp-impl.h (RNG_FNPTR, RNG_STATE): New macros. + (gmp_randfnptr_t): New structure. + (_gmp_rand): Now a macro not a function. + * gmp-h.in (__gmp_randata_lc): Remove, now internal to randlc2x.c. + (__gmp_randstate_struct): Revise comments on field usage. + * randsd.c, randclr.c: Use function pointer scheme. + * randsdui.c: Use gmp_randseed. + * randraw.c: Remove file. + * randlc2x.c: Collect up lc_2exp related code from randsd.c, randclr.c + and randraw.c, use function pointer scheme, integrate seed==0/a==0 + into main case and fix case where bits(a) < m2exp. + + * randlc.c: Remove file, never documented and never worked. + * gmp-h.in (gmp_randinit_lc): Remove prototype. + +2002-09-16 Torbjorn Granlund + + * mpn/alpha/mod_34lsub1.asm: New file. + +2002-09-16 Kevin Ryde + + * configure.in, acinclude.m4 (GMP_C_RESTRICT): Remove this, not + currently used, and #define restrict upsets Microsoft C headers on + win64. Reported by David Librik. + + * configure.in (x86): Add gcc 3.2 -march and -mcpu flags, remove some + unnecessary -march=i486 fallbacks. + + * gmp.texi (Notes for Particular Systems): Note cl /MD is required for + Microsoft C and MINGW to cooperate on I/O. Explained by David Librik. + (Language Bindings): Add linbox. + * gmp.texi (Language Bindings): + +2002-09-12 Kevin Ryde + + * mpz/aorsmul_i.c: Allow for w==x overlap with nails. Test + BITS_PER_ULONG > GMP_NUMB_BITS rather than GMP_NAIL_BITS != 0. + * tests/mpz/t-aorsmul.c: Test this. + + * tune/common.c: mpn_mod_34lsub1 only exists for GMP_NUMB_BITS%4==0 + * tune/speed.c: Add mpn_mod_34lsub1. + +2002-09-10 Pedro Gimeno + + * rand.c: Remove old disabled BBS code. + * mpf/urandomb.c: Use BITS_TO_LIMBS. + +2002-09-10 Kevin Ryde + + * gmp.texi (Multiplication Algorithms): FFT is now enabled by default. + +2002-09-10 Pedro Gimeno + + * mpz/urandomm.c: Use mpn level functions, avoid an infinite loop if + _gmp_rand forever returns all "1" bits. + * tests/rand/t-urndmm.c: New file + * tests/rand/Makefile.am (check_PROGRAMS): Add it. + + * gmp-impl.h (BITS_TO_LIMBS): New macro. + * mpz/urandomb.c: Use it, and use MPZ_REALLOC. + +2002-09-08 Kevin Ryde + + * acinclude.m4 (GMP_GCC_WA_MCPU): New macro. + * configure.in (alpha*-*-*): Use it to avoid -Wa,-mev67 if gas isn't + new enough to know ev67. Reported by David Bremner. + +2002-07-30 Gerardo Ballabio + + * gmpxx.h (__gmpz_value etc): Remove, use mpz_t etc instead. + (__gmp_expr): Reorganise specializations, use __gmp_expr not + mpz_class etc. + (mpfr evals): Remove mode parameter, was always + __gmp_default_rounding_mode anyway. + +2002-09-07 Kevin Ryde + + * gmp-h.in, mp-h.in: Use #ifdef for tests, for the benefit of + applications using gcc -Wundef. + + * longlong.h: Define COUNT_LEADING_ZEROS_NEED_CLZ_TAB for all alphas, + since mpn/alpha/cntlz.asm always goes into libgmp.so, even for ev67 + and ev68 which don't need it. Reported by David Bremner. + + * gmp.texi (Demonstration Programs): New section, expanding on what + was under "Build Options". + (Converting Floats): Don't need \ for _ in @var within @math. + Add and amend various index entries. + + * demos/qcn.c: Add -p prime limit option. + +2002-08-30 Kevin Ryde + + * mpz/pprime_p.c: Handle small negatives with isprime, in particular + must do so for n==-2. + * tests/mpz/t-pprime_p.c: New file. + * tests/mpz/Makefile.am: Add it. + +2002-08-26 Torbjorn Granlund + + * gmp.texi (Converting Floats): Fix typo in mpf_get_d_2exp docs, + reported by Paul Zimmermann. + +2002-08-26 Kevin Ryde + + * configure.in: Echo the ABI being tried for the compilers. + (powerpc*-*-*): Use powerpc64/aix.m4 for ABI=aix64 too. + (AC_CHECK_FUNCS): Add strtol, for tests/rand/gen.c. + +2002-08-24 Kevin Ryde + + * configure.in (HAVE_HOST_CPU_, HAVE_HOST_CPU_FAMILY_, HAVE_NATIVE_): + Setup templates for these using AH_VERBATIM rather than acconfig.h, + preferred by latest autoconf. Prune lists to just things used. + * acconfig.h: Remove file. + + * mpn/powerpc32/mode1o.asm: Forgot ASM_START. + + * tune/time.c (have_cgt_id): Renamed from HAVE_CGT_ID so avoid + confusion with autoconf outputs, and turn it into a "const" variable. + +2002-08-23 Torbjorn Granlund + + * configure.in: Choose powerpc32/aix.m4 or powerpc64/aix.m4 based on + ABI, not configuration triple. + + * mpz/pprime_p.c: Partially undo last change--handle small and + negative numbers in the same test. + +2002-08-22 Kevin Ryde + + * gmp-impl.h (MUL_FFT_THRESHOLD, SQR_FFT_THRESHOLD): Note + mpn/generic/mul_fft.c is not nails-capable, and don't bother setting + other FFT data for nails. + + * configfsf.guess: Update to 2002-08-19. + * configfsf.sub: Update to 2002-08-20. + + * config.guess (powerpc*-*-*): Use a { } construct to suppress SIGILL + message on AIX. + +2002-08-20 Kevin Ryde + + * gmp.texi (Build Options): Add ia64 under cpu types. + (ABI and ISA): Describe IRIX 6 ABI=o32. + (Notes for Particular Systems): Remove -march=pentiumpro, now ok. + (Known Build Problems): Binutils 2.12 is ok for libgmp.a. + (Emacs): New section. + (Language Bindings): Update MLton URL, reported by Stephen Weeks. + (Prime Testing Algorithm): New section. + Don't put a blank line after @item in @table since it can make a page + break between the heading and the entry. + Misc tweaks elsewhere, in particular more index entries. + + * mpz/millerrabin.c: Need x to be size+1 for change to urandomm. + + * gmp-impl.h: Comments on the use of __GMP_DECLSPEC. + + * tune/time.c (freq_measure_mftb_one): Use struct_timeval, for the + benefit of mingw. + + * tests/refmpn.c, tests/tests.h (ref_addc_limb, ref_subc_limb): + Renamed from add and sub, following gmp-impl.h ADDC_LIMB and SUBC_LIMB. + +2002-08-17 Kevin Ryde + + * mpn/powerpc32/mode1o.asm: New file. + * configure.in, acinclude.m4 (GMP_ASM_POWERPC_PIC_ALWAYS): New macro. + * mpn/asm-defs.m4: Use it to help setting up PIC. + + * configure.in (AC_PREREQ): Bump to 2.53. + + * mpn/powerpc32/powerpc-defs.m4 (ASSERT): New macro. + (PROLOGUE_cpu): New macro, giving ALIGN(4) not 8. + +2002-08-16 Torbjorn Granlund + + * mpn/m68k/lshift.asm: Fix typo in !scale_available_p code. + * mpn/m68k/rshift.asm: Likewise. + +2002-08-16 Kevin Ryde + + * configure.in (--enable-profiling=instrument): New option. + * gmp.texi (Profiling): Describe it. + * mpn/x86/x86-defs.m4 (PROLOGUE_cpu, call_instrument, ret_internal): + Add support. + (call_mcount): Share PIC setups with call_instrument. + * mpn/x86/*.asm: Use ret_internal. + * mpn/asm-defs.m4 (m4_unquote): New macro. + * tests/mpn/t-instrument.c: New file. + * tests/mpn/Makefile.am: Add it. + + * mpn/alpha/umul.asm: Add ASM_END. + +2002-08-12 Kevin Ryde + + * mpz/pprime_p.c: Fake up a local mpz_t to take abs(n), rather than + using mpz_init etc. + + * mpz/millerrabin.c: Use mpz_urandomm for uniform selection of x, + reported by Jason Moxham. Exclude x==n-1, ie. -1 mod n. Use + gmp_randinit_default. + + * mpn/alpha/umul.asm: Use "r" registers, for the benefit of Unicos. + + * tests/devel/try.c: Add mpn_copyi and mpn_copyd. + +2002-08-09 Kevin Ryde + + * Makefile.am: Remove configure.lineno from DISTCLEANFILES and gmp.tmp + from MOSTLYCLEANFILES, automake does these itself now. + + * */Makefile.in, aclocal.m4, configure, install-sh, missing, + mkinstalldirs: Update to automake 1.6.3. + + * mpn/ia64/README: Some notes on assembler syntax. + + * mpn/ia64/add_n.asm, mpn/ia64/sub_n.asm: Add .body. + * mpn/ia64/add_n.asm, mpn/ia64/addmul_1.asm, mpn/ia64/mul_1.asm, + mpn/ia64/sub_n.asm: Position .save ar.lc just before relevant + instruction. + * mpn/ia64/addmul_1.asm, mpn/ia64/mul_1.asm: Add .save ar.pfs and pr. + * mpn/ia64/copyd.asm, mpn/ia64/copyi.asm: Correction to .body position. + * mpn/ia64/lorrshift.asm: Add .prologue stuff. + + * configure.in (*-*-unicos*): Remove forcible --disable-shared, + libtool gets this right itself now. + +2002-08-07 Kevin Ryde + + * mpn/x86/pentium/mmx/hamdist.asm: New file, adapted from + mpn/x86/pentium/mmx/popham.asm. + * mpn/x86/pentium/mmx/popham.asm: Remove file, not faster than plain + mpn/x86/pentium/popcount.asm for the popcount. + + * mpn/alpha/umul.asm: Use PROLOGUE/EPILOGUE, rename it mpn_umul_ppmm. + * configure.in (alpha*-*-*): Add umul to extra_functions. + + * mpz/remove.c: Make src==0 return 0, not do DIVIDE_BY_ZERO. + +2002-08-05 Torbjorn Granlund + + * acconfig.h: Remove spurious undefs for mpn_divrem_newton and + mpn_divrem_classic. + +2002-08-05 Kevin Ryde + + * tests/refmpn.c, tests/tests.h, tests/misc/t-printf.c, + tests/mpf/t-trunc.c, tests/mpn/t-mp_bases.c, tests/mpn/t-scan.c, + tests/mpq/t-cmp_ui.c, tests/mpz/bit.c, tests/mpz/t-aorsmul.c, + tests/mpz/t-powm_ui.c tests/mpz/t-root.c, tests/mpz/t-scan.c: More + care with long and mp_size_t parameters, for the benefit of K&R. + + * demos/perl/GMP.pm, demos/perl/GMP.xs, demos/perl/GMP/Mpz.pm, + demos/perl/test.pl: Add mpz_import and mpz_export. + * demos/perl/GMP.pm: Remove "preliminary" warning. + + * mpn/lisp/gmpasm-mode.el: Set add-log-current-defun-header-regexp to + pick up m4 defines etc. + + * Makefile.am (libgmpxx_la_DEPENDENCIES): libgmp.la should be here, + not libgmpxx_la_LIBADD, for the benefit of "make -j2". + + * mpn/ia64/*.asm [hpux ABI=32]: Extend 32-bit operands to 64-bits, not + optimal and might not be sufficient, but seems to work. + +2002-08-03 Kevin Ryde + + * gmp.texi (Profiling): Use a table and expand for clarity. + (Integer Special Functions): New section for mpz_array_init, + _mpz_realloc, mpz_getlimbn and mpz_size, to discourage their use. + + * configure.in (*-*-msdosdjgpp*): Remove forcible --disable-shared, + libtool gets this right itself now. + +2002-07-30 Kevin Ryde + + * mpn/powerpc32/lshift.asm, mpn/powerpc32/rshift.asm: Lose final mr, + and make final stwu into an stw. + + * gmp.texi (Known Build Problems): An easier workaround for DESTDIR, + using LD_LIBRARY_PATH. + (C++ Interface MPFR): Remove mpfrxx.h. + + * mpfrxx.h: Remove file. + * Makefile.am: Remove mpfrxx.h. + * tests/cxx/Makefile.am: Add Gerardo's new test programs. + +2002-07-30 Gerardo Ballabio + + * gmpxx.h: Use mpz_addmul etc for ternary a+b*c etc. Reorganise some + macros for maintainability. Merge mpfrxx.h. + * tests/cxx/t-constr.cc, tests/cxx/t-expr.cc: Various updates. + * tests/cxx/t-assign.cc, tests/cxx/t-binary.cc, + tests/cxx/t-ternary.cc, tests/cxx/t-unary.cc: New files. + +2002-07-27 Kevin Ryde + + * longlong.h (count_trailing_zeros) [ia64 __GNUC__]: Don't use + __builtin_ffs for now, doesn't seem to work. + + * configure.in: Establish CONFIG_SHELL to avoid a problem with + AC_LIBTOOL_SYS_MAX_CMD_LEN on ia64-*-hpux*. + + * tune/speed.h (SPEED_ROUTINE_MPN_GCD_FINDA): Don't let calls to + mpn_gcd_finda go dead. + + * mpn/generic/tdiv_qr.c: Inline mpn_rshift and MPN_COPY of 2 limbs. + +2002-07-24 Kevin Ryde + + * demos/primes.c: Use __GMP_PROTO and don't use signed, for the + benefit of K&R. + + * demos/calc/calclex.l: Add for strcmp. + + * mpn/ia64/invert_limb.asm: Use .rodata which works on ia64-*-hpux* + and should be standard, rather than worrying about RODATA. + + * gmp.texi (Function Classes): Add cross references. + (Integer Import and Export): Fix return value grouping. + + * mpn/lisp/gmpasm-mode.el (gmpasm-comment-start-regexp): Add // for + ia64. Add notes on what the various styles are for. + + * mpn/ia64/default.m4 (ASM_START): Define to empty, not dnl, so as not + to kill text on the same line. + (EPILOGUE_cpu): Force a newline after "#", so as not to suppress macro + expansion in the rest of the EPILOGUE line. + +2002-07-21 Kevin Ryde + + * tune/speed.h: Fix some missing _PROTOs. + + * Makefile.am (DISTCLEANFILES): Add configure.lineno. + + * acinclude.m4 (GMP_C_DOUBLE_FORMAT): Define + HAVE_DOUBLE_IEEE_BIG_ENDIAN and HAVE_DOUBLE_IEEE_LITTLE_ENDIAN in + config.m4 too. + * mpn/ia64/invert_limb.asm: Add big-endian data. + + * tests/mpz/t-jac.c (try_si_zi): Correction to "a" parameter type. + +2002-07-20 Kevin Ryde + + * mpz/bin_ui.c, mpz/jacobi.c, mpz/pprime_p.c, mpn/generic/divis.c: + More care with long and mp_size_t parameters, for the benefit of K&R. + + * gmp-impl.h (invert_limb): Use parens around macro arguments. + (mpn_invert_limb): Give prototype and define unconditionally. + + * gmp-impl.h (CACHED_ABOVE_THRESHOLD, CACHED_BELOW_THRESHOLD): New + macros. + * mpn/generic/sb_divrem_mn.c: Use them to help gcc let preinv code go + dead when not wanted. + +2002-07-17 Kevin Ryde + + * tests/refmpz.c (refmpz_hamdist): Ensure mp_size_t parameters are + that type, for the benefit of hpux ia64 bundled cc ABI=64. + + * configure.in (ia64*-*-hpux*): Need +DD64 in cc_64_cppflags to get + the right headers for ansi2knr. + + * acinclude.m4 (GMP_TRY_ASSEMBLE, GMP_ASM_UNDERSCORE): Use $CPPFLAGS + with $CCAS and when linking, as done by the makefiles. + (GMP_ASM_X86_MMX, GMP_ASM_X86_SSE2): Show $CPPFLAGS in diagnostics. + + * gmp-impl.h (ieee_double_extract): Setup using HAVE_DOUBLE_IEEE_*. + (GMP_UINT32): New define, 32 bit type for ieee_double_extract. + * configure.in: Add AC_CHECK_SIZEOF unsigned. + * configure.in, acinclude.m4 (GMP_IMPL_H_IEEE_FLOATS): Remove. + (GMP_C_DOUBLE_FORMAT): Instead warn about unknown float here. + + * configure.in, acinclude.m4 (GMP_C_SIZES): Remove. + * acinclude.m4 (GMP_INCLUDE_GMP_H_BITS_PER_MP_LIMB): Remove this + scheme, not required. + * configure.in (unsigned long, mp_limb_t): Run AC_CHECK_SIZEOF for + these unconditionally, check mp_limb_t against gmp-mparam.h values. + * gmp-impl.h (BYTES_PER_MP_LIMB, BITS_PER_MP_LIMB): Define based on + SIZEOF_MP_LIMB_T if not provided by gmp-mparam.h. + (BITS_PER_ULONG): Define here now. + + * gmp.texi (ABI and ISA): Add HP-UX IA-64 choices. + (Random State Initialization): Typo in m2exp described for + gmp_randinit_lc_2exp_size. + (Formatted Output Functions): Clarify gmp_obstack_printf a bit. + (Formatted Input Strings): Typo in %n summary. + + * mpz/inp_raw.c (NTOH_LIMB_FETCH): Use simple generic default, since + endianness detection is now cross-compile friendly. + * mpz/out_raw.c (HTON_LIMB_STORE): Ditto. + + * mpz/fib_ui.c: Nailify. + * mpz/random.c: Nailify. + + * mpfr/acinclude.m4 (MPFR_CONFIGS): Patch by Vincent for an apparent + float rounding gremlin on powerpc. + +2002-07-15 Kevin Ryde + + * Makefile.am (PRINTF_OBJECTS): Avoid ending in a backslash, hpux ia64 + make doesn't like that. + + * mpn/ia64/*.asm: Add .sptk to unconditional branches, add ";" after + .mib etc, for the benefit of hpux. + + * configure.in (ia64*-*-*): Use ABI=64 on non-HPUX systems, for + consistency. + + * gmp-impl.h (ieee_double_extract): Test __sparc__, used by gcc 3.1. + Reported by nix@esperi.demon.co.uk. + * mpfr/mpfr-math.h (_MPFR_NAN_BYTES etc): Ditto. + +2002-07-13 Kevin Ryde + + * mpn/powerpc32/rshift.asm: Rewrite, transformed from lshift.asm. + + * tune/tuneup.c (DIVEXACT_1_THRESHOLD, MODEXACT_1_ODD_THRESHOLD): + Always zero for native mpn_divexact_1, mpn_modexact_1_odd. + + * gmp-h.in (__GMP_EXTERN_INLINE): Don't use this during configure, + ie. __GMP_WITHIN_CONFIGURE, to avoid needing dependent routines. + * acinclude.m4 (GMP_H_EXTERN_INLINE): Consequent changes. + + * gmp-impl.h, mpn/asm-defs.m4 (mpn_addmul_2, mpn_addmul_3, + mpn_addmul_4): Add prototypes and defines. + + * gmp.texi (Number Theoretic Functions): Clarify return value. + Reported by Peter Keller. + +2002-07-10 Kevin Ryde + + * configure.in, acinclude.m4 (GMP_PROG_LEX): Remove this in favour of + AM_PROG_LEX, now ok when lex is missing. + + * longlong.h (count_leading_zeros) [pentiummmx]: Don't use __clz_tab + variant under LONGLONG_STANDALONE. + (count_trailing_zeros) [ia64 __GNUC__]: Use __builtin_ffs. + + * gmp-impl.h (popc_limb): Add an ia64 asm version. + (DItype): Use HAVE_LONG_LONG to choose long long, avoiding _LONGLONG + which is in gcc but means something unrelated in MS Visual C 7.0. + Reported by David Librik. + + * mpz/divexact.c: Add an ASSERT that den divides num. + + * mpn/asm-defs.m4 (LDEF): New macro. + (INT32, INT64): Use it. + * mpn/pa32/*.asm: Use it. + * mpn/pa32/README: Update notes on labels. + + * tests/refmpn.c, tests/tests.h, tests/t-bswap.c (ref_bswap_limb): + Renamed from refmpn_bswap_limb. + * tests/t-bswap.c: Add tests_start/tests_end for randomization. + + * tests/refmpn.c, tests/tests.h (ref_popc_limb): New function. + * tests/t-popc.c: New file. + * tests/Makefile.am: Add it. + + * mpn/ia64/invert_limb.asm: Use RODATA since ".section .rodata" is not + accepted by ia64-*-hpux*. + + * acinclude.m4 (GMP_ASM_BYTE): New macro. + (GMP_ASM_ALIGN_LOG, GMP_ASM_W32): Use it. + (GMP_ASM_LABEL_SUFFIX): Use test compiles, not $host. + (GMP_ASM_GLOBL): Ditto, and add .global for ia64-*-hpux*. + (GMP_ASM_GLOBL_ATTR): Use GMP_ASM_GLOBL result, not $host. + (GMP_ASM_LSYM_PREFIX): Allow any "a-z" nm symbol code, add ".text" to + test program, required by ia64-*-hpux*. + (GMP_ASM_LABEL_SUFFIX): Make LABEL_SUFFIX just the value, not a "$1:", + the former being how it's currently being used in fact. + + * configure.in, acinclude.m4 (GMP_PROG_CC_WORKS_LONGLONG): New macro. + * configure.in (ia64-*-hpux*): Add 32 and 64 bit ABI modes. + +2002-07-06 Kevin Ryde + + * tests/cxx/t-allfuns.cc: New file. + * tests/cxx/Makefile.am: Add it. + + * mpz/clrbit.c, mpz/setbit.c: Only MPN_NORMALIZE if high limb changes + to zero. Use _mpz_realloc return value. + + * gmp.texi (Build Options, C++ Formatted Output, C++ Formatted Input): + Cross reference to Headers and Libraries for libgmpxx stuff. + (Low-level Functions): mpn_divexact_by3 result based on GMP_NUMB_BITS. + mpn_set_str takes "unsigned char *", reported by Mark Sofroniou. + (C++ Interface General): Describe linking with libgmpxx and libgmp. + +2002-07-01 Kevin Ryde + + * tune/tuneup.c, gmp-impl.h: Eliminate the array of thresholds in + one(), tune just one at a time and let the callers hand dependencies. + Eliminate the second_start_min hack, handle SQR_KARATSUBA_THRESHOLD + oddities in tune_sqr() instead. + + * mpn/pa64/umul.asm, mpn/pa64/udiv.asm, mpn/asm-defs.m4, acconfig.h, + longlong.h, tune/speed.c, tune/speed.h, tune/common.c, tune/many.pl, + tests/devel/try.c: Introduce mpn_umul_ppmm_r and mpn_udiv_qrnnd_r + rather than having variant parameter order for mpn_umul_ppmm and + mpn_udiv_qrnnd on pa64. + + * gmp-h.in (mpz_export): Remove a spurious parameter name. + * gmp-impl.h (mpn_rootrem): Use __MPN. + +2002-06-29 Kevin Ryde + + * longlong.h (udiv_qrnnd) [hppa32]: Remove mpn_udiv_qrnnd version, the + general mechanism for that suffices. + + * mpf/inp_str.c: Fix returned count of chars read, reported by Paul + Zimmermann. Also fix a memory leak for invalid input. + * tests/mpf/t-inp_str.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + + * tests/devel/try.c (mpn_mod_34lsub1): Only exists for + GMP_NUMB_BITS%4==0. + (SIZE2_FIRST): Respect option_firstsize2 for "fraction" case. + + * mpn/generic/diveby3.c: Further nailifications. + * gmp-impl.h (MODLIMB_INVERSE_3): Allow for GMP_NUMB_BITS odd. + (GMP_NUMB_CEIL_MAX_DIV3, GMP_NUMB_CEIL_2MAX_DIV3): New constants. + * tests/t-constants.c: Check them. + + * gmp-h.in (__GMP_CRAY_Pragma): New macro. + (__GMPN_COPY_REST): Use it. + * gmp-impl.h (CRAY_Pragma): Use it. + +2002-06-25 Kevin Ryde + + * mpz/import.c, mpz/export.c: Cast data pointer through "char *" in + alignment tests, for the benefit of Cray vector systems. + + * configure.in (x86-*-*): Remove -march=pentiumpro check, seems ok + with current code. + * acinclude.m4 (GMP_GCC_MARCH_PENTIUMPRO, GMP_GCC_VERSION_GE): Remove + macros, no longer needed + + * acinclude.m4 (GMP_ASM_RODATA): Remove temporary files. + + * configure.in (GMP_ASM_GLOBL_ATTR): Reposition to avoid duplication + through AC_REQUIRE. + +2002-06-23 Kevin Ryde + + * tests/mpz/t-fib_ui.c (check_fib_table): Check table values, not just + that they're non-zero. + + * acinclude.m4 (GMP_GCC_ARM_UMODSI): Match bad "gcc --version" output + exactly, rather than parsing it with GMP_GCC_VERSION_GE. + (GMP_ASM_UNDERSCORE): Use GLOBL_ATTR. + + * mpn/pa32/udiv.asm, mpn/pa32/hppa1_1/udiv.asm, mpn/pa64/udiv.asm: + Renamed from udiv_qrnnd.asm, for consistency with other udiv's. + * mpn/pa64/umul.asm: Renamed from umul_ppmm.asm likewise. + * configure.in (hppa*-*-*): Update extra_functions. + (NAILS_SUPPORT): Remove umul_ppmm, udiv_qrnnd, udiv_fp, udiv_nfp from + nails-neutral list, no longer needed. + + * gmp-h.in (__DECC): Add notes on testing this for ANSI-ness. + (__GMP_EXTERN_INLINE): Add static __inline for DEC C. + (mpz_mod_ui): Move up to main section, it's still documented. + +2002-06-22 Kevin Ryde + + * mpz/jacobi.c, mpz/kronsz.c, mpz/kronuz.c, mpz/kronzs.c, + mpz/kronzu.c: Allow for odd GMP_NUMB_BITS, tweak a few variable setups. + * gmp-impl.h (JACOBI_STRIP_LOW_ZEROS): New macro. + + * mpn/generic/mod_34lsub1.c: Nailify. + * tests/devel/try.c (CNST_34LSUB1): Nailify. + * gmp-impl.h (ADDC_LIMB): New macro. + + * gmpxx.h (mpf_class::get_str): Make exponent mp_exp_t&, default + base=10 and ndigits=0. + (mpz_class::set_str, mpq_class::set_str, mpf_class::set_str): Add + versions accepting "const char *". + * mpfrxx.h (mpfr_class::get_str, mpfr_class::set_str): Ditto, and + uncommenting set_str and operator=. + * gmp.texi (C++ Interface Integers, C++ Interface Rationals) + (C++ Interface Floats): Update. + + * gmp-impl.h (modlimb_invert): Merge the <=64bits and general versions. + (const, signed): Move to near top of file, fixes --enable-alloca=debug + on K&R. + + * gen-fib.c: New file, derived from mainline in mpn/generic/fib2_ui.c. + * dumbmp.c (mpz_init_set_ui): New function. + * Makefile.am, mpn/Makefile.am: Generate fib_table.h, mpn/fib_table.c. + * gmp-impl.h: Use fib_table.h, add __GMP_DECLSPEC to __gmp_fib_table + (for the benefit of tests/mpz/t-fib_ui.c). + * mpn/generic/fib2_ui.c: Remove __gmp_fib_table and generating code. + + * Makefile.am: Add mp.h to BUILT_SOURCES, distclean all BUILT_SOURCES, + use += more. + + * acinclude.m4 (GMP_ASM_M68K_INSTRUCTION, GMP_ASM_M68K_BRANCHES): + Don't let "unknown" get into the cache variables. + (GMP_ASM_TEXT): See what assembles, don't hard-code hpux and aix. + (GMP_PROG_EXEEXT_FOR_BUILD): Add ,ff8 for RISC OS, per autoconf cvs. + (GMP_PROG_CPP_FOR_BUILD): Restructure per AC_PROG_CPP, print correct + result if CPP_FOR_BUILD overrides the cache variable. + (GMP_PROG_CC_FOR_BUILD_WORKS): New macro split from + GMP_PROG_CC_FOR_BUILD. Allow for "conftest" default compiler output. + * configure.in, acinclude.m4 (GMP_PROG_HOST_CC): Reinstate this, + separating HOST_CC establishment from GMP_PROG_CC_FOR_BUILD. + + * configure.in (mpn_objs_in_libgmp): Move mpn/mp_bases.lo ... + * Makefile.am (MPN_OBJECTS): ... to here, add $U, and arrange + MPN_OBJECTS to be common between libgmp and libmp. + +2002-06-20 Torbjorn Granlund + + * mpn/generic/mul_n.c (TOOM3_MUL_REC, TOOM3_SQR_REC): Don't check if + basecase is to be invoked when *_TOOM3_THRESHOLD is more than 3 times + the corresponding *_THRESHOLD. + +2002-06-20 Kevin Ryde + + * mpn/ia64/submul_1.c: Add missing TMP_DECL, TMP_MARK, TMP_FREE. + Reported by Paul Zimmermann. + + * configure.in, acinclude.m4 (AC_DEFINE): Make templates read "Define + to 1", for clarity as per autoconf. + * acinclude.m4 (GMP_OPTION_ALLOCA): Group WANT_TMP templates. + +2002-06-20 Gerardo Ballabio + + * gmpxx.h, mpfrxx.h: Remove mpz_classref, let mpq_class::get_num and + mpq_class::get_den return mpz_class& as per the documentation. + Reported by Roberto Bagnara. + +2002-06-18 Kevin Ryde + + * tests/rand/t-lc2exp.c: New file. + * tests/rand/Makefile.am: Add it, and use tests/libtests.la. + + * randraw.c (lc): Pad seed==0 case with zero limbs, return same + (m2exp+1)/2 bits as normal, right shift "c" result as normal. + + * configure.in: Don't bother with line numbers in some diagnostics. + (*-*-mingw*): Use -mno-cygwin if it works, suggested by delta trinity. + + * tests/mpz/Makefile.am, tests/mpq/Makefile.am, + tests/misc/Makefile.am, (CLEANFILES): Set to *.tmp for test program + temporaries, to get t-scanf.tmp and reduce future maintenance. + +2002-06-16 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_dc_get_str): Pass scratch memory area in + new `tmp' parameter. Trim allocation needs by reusing input parameter. + +2002-06-15 Torbjorn Granlund + + * mpn/sparc32/v9/udiv.asm: New file. + +2002-06-15 Kevin Ryde + + * acinclude.m4 (GMP_GCC_VERSION_GE): Correction to recognising mingw + gcc 3.1 version number. Reported by Jim Fougeron. + + * configure.in (AC_PROVIDE_AC_LIBTOOL_WIN32_DLL): New define, to make + AC_LIBTOOL_WIN32_DLL work with autoconf 2.53. + + * acinclude.m4 (GMP_C_SIZES): Establish BITS_PER_MP_LIMB as a value, + not an expression, for the benefit of the gen-bases invocation. + + * config.guess (CC_FOR_BUILD): Try c99, same as configfsf.guess. + +2002-06-15 Paul Zimmermann + + * mpfr/set_q.c: Allow for 1 bit numerator or denominator. + +2002-06-14 Kevin Ryde + + * configure.in (AC_C_BIGENDIAN): Use new style action parameters. + + * randlc2x.c: Allow for a<0, allow for c>=2^m2exp. + * randraw.c (lc): Allow for a==0. + + * mpn/sparc32/udiv.asm: Renamed from udiv_fp.asm. Don't know if float + is the best way for v7, but it's what configure has chosen since gmp 3. + * configure.in (*sparc*-*-* ABI=32): extra_functions="udiv" for all, + in particular sparc32/v8/udiv.asm is faster (on ultrasparc2) than + udiv_fp previously used for v9 chips. + + * gen-bases.c: New file, derived from mpn/mp_bases.c. + * dumbmp.c: New file, mostly by Torbjorn, some by me. + * configure.in, acinclude.m4 (GMP_PROG_CC_FOR_BUILD, + GMP_PROG_CPP_FOR_BUILD, GMP_PROG_EXEEXT_FOR_BUILD, + GMP_C_FOR_BUILD_ANSI, GMP_CHECK_LIBM_FOR_BUILD): New macros. + (GMP_PROG_HOST_CC): Remove, superceded by GMP_PROG_CC_FOR_BUILD. + * Makefile.am: Run gen-bases to create mp_bases.h and mpn/mp_bases.c. + * gmp-impl.h: Use mp_bases.h. + * mpn/mp_bases.c: Remove file. + * mpn/Makefile.am: mp_bases.c now in nodist_libmpn_la_SOURCES. + + * tests/mpz/t-cmp_d.c (check_one_2exp): Use volatile to force to + double, fixes gcc 3.1 with -O4. Reported by Michael Lee. + * configure.in (AC_C_VOLATILE): New macro. + + * tests/misc/t-scanf.c: (fromstring_gmp_fscanf): Add missing va_end. + Don't mix varargs and fixed args functions, not good on x86_64. + Reported by Marcus Meissner. + + * Makefile.am (EXTRA_DIST): Remove mpfr/README, now in mpfr/Makefile.in + + * configure, config.in, INSTALL.autoconf: Update to autoconf 2.53. + * */Makefile.in, install-sh, mdate-sh, missing, aclocal.m4, configure: + Update to automake 1.6.1. + * configfsf.guess, configfsf.sub: Update to 2002-05-29. + +2002-06-12 Kevin Ryde + + * acinclude.m4 (GMP_GCC_VERSION_GE): Recognise mingw gcc 3.1 version. + (GMP_PROG_CC_WORKS): Allow for a_out.exe, as per autoconf. + (GMP_GCC_NO_CPP_PRECOMP, GMP_ASM_UNDERSCORE): Ditto, plus a.exe. + +2002-06-09 Torbjorn Granlund + + * randraw.c (lc): Remove broken ASSERT_ALWAYS. + + * mpn/x86: Update gmp-mparam.h files with current measures *_THRESHOLD + values. + * mpn/x86/p6/mmx/gmp-mparam.h: New file. + +2002-06-09 Kevin Ryde + + * mpn/x86/*/gmp-mparam.h (USE_PREINV_DIVREM_1): Add tuned settings. + + * acconfig.h (HAVE_NATIVE_mpn_preinv_divrem_1): New template. + + * tests/refmpn.c, tests/tests.h (refmpn_chars_per_limb, + refmpn_big_base): New functions. + * tests/mpn/t-mp_bases.c: Use them, and don't test big_base_inverted + unless it's being used. + + * gmp.texi (Notes for Particular Systems): Using Microsoft C with DLLs. + (Known Build Problems): Notes on MacOS and GCC. + (Integer Logic and Bit Fiddling): Use ULONG_MAX for maximum ulong. + (Low-level Functions): mpn_get_str accepts base==256. + (Formatted Output Functions): Note output is not atomic. + (Internals): Note mp_size_t for limb counts. + + * mp-h.in, gmp-h.in (mp_ptr, mp_srcptr, mp_size_t, mp_exp_t): Remove + these types from mp.h, not needed. + + * mpfr/tests/tadd.c, mpfr/tests/tmul.c (check): Apply a hack to the + parameter order to make sparc gcc 2.95.2 happy. + + * doc/configuration: Notes on bootstrapping. + +2002-06-08 Kevin Ryde + + * mpfr/tests/tsqrt.c, mpfr/tests/tsqrt_ui.c: Suppress tests if sqrt is + not affected by mpfr_set_machine_rnd_mode. + + * mpfr/mul_2si.c: Workaround a mips gcc 2.95.3 bug under -O2 -mabi=n32. + + * configure.in (alphev56): Fix to use ev5 path. + +2002-06-06 Kevin Ryde + + * gmp-h.in: Use __gmp_const not const, in a number of places. + + * configure.in (sparc): Use ABI=32 instead of ABI=standard on v7 and + v8, for consistency with v9 choices. + (sparc64): Restrict GMP_ASM_SPARC_REGISTER to ABI=64. + (x86): Move MMX $path munging to before printout. + (CCAS): Move upward to support this. + + * gmp-impl.h (modlimb_invert): Merge macros for specific limb sizes, + add a version for arbitrary limb size, use GMP_NUMB_BITS. + (modlimb_invert, MODLIMB_INVERSE_3): Fix comments to say GMP_NUMB_BITS. + + * gmp-h.in (__GMP_LIKELY, __GMP_UNLIKELY): New macros. + (mpz_getlimbn, mpz_perfect_square_p, mpz_popcount): Use them, make the + fetch or mpn call likely, unconditionally calculate the alternative so + as to avoid an "else" clause. + * gmp-impl.h (LIKELY, UNLIKELY): Aliases. + + * configure.in, mpfr/tests/Makefile.am: Add $LIBM to $LIBS for + MPFR_CONFIGS so it detects fesetround, and let it go through to + $MPFR_LIBS. + * mpfr/rnd_mode.c: Use gmp-impl.h to get MPFR_HAVE_FESETROUND. + + * tests/mpz/t-sizeinbase.c: Disable fake bits test, such pointer + setups are bogus and have been seen failing on hppa. + + * tests/misc.c, tests/refmpz.c, tests.tests.h, tests/mpz/t-cong.c: + Rename mpz_flipbit to refmpz_combit and move from misc.c to refmpz.c. + +2002-06-05 Torbjorn Granlund + + * tests/mpz/t-powm_ui.c Print proper routine name in error message. + +2002-06-03 Kevin Ryde + + * tune/time.c, tune/freq.c, tune/speed.h: Add powerpc mftb support. + (FREQ_MEASURE_ONE): Move to speed.h, fix tv_sec factor. + (freq_measure): Use for mftb measuring too. + * tune/powerpc.asm, tune/powerpc64.asm: New files. + * configure.in, tune/Makefile.am: Add them. + + * gmp-impl.h (popc_limb): Add versions for Cray and fallback for + arbitrary limb size. + + * mpn/sparc32/sparc-defs.m4: New file. + * configure.in (sparc*-*-*): Use it. + * acinclude.m4 (GMP_ASM_SPARC_REGISTER): New macro. + * configure.in (sparc64): Use it. Also, use -Wc,-m64 for linking. + * mpn/sparc64/add_n.asm, mpn/sparc64/addmul_1.asm, + mpn/sparc64/copyd.asm, mpn/sparc64/copyi.asm, mpn/sparc64/lshift.asm, + mpn/sparc64/mul_1.asm, mpn/sparc64/rshift.asm, + mpn/sparc64/sqr_diagonal.asm, mpn/sparc64/sub_n.asm, + mpn/sparc64/submul_1.asm: Use REGISTER for .register. + +2002-06-01 Kevin Ryde + + * mpz/powm_ui.c: Fix for result range in certain circumstances. + + * mpn/x86/k6/diveby3.asm: Speedup to 10 c/l, same as divexact_1. + Anomaly pointed out by Alexander Kruppa. + +2002-05-31 Torbjorn Granlund + + * mpz/export.c: Cast pointer via `unsigned long' when checking + alignment to avoid compiler warnings. + +2002-05-29 Kevin Ryde + + * gmp-impl.h (BSWAP_LIMB): Versions for m68k, powerpc, and arbitrary + limb size. + * configure.in, acconfig.h (HAVE_HOST_CPU_FAMILY_m68k): New define. + +2002-05-27 Torbjorn Granlund + + * mpn/generic/mul_basecase.c: Improve MAX_LEFT handling, returning + when possible. Add code for mpn_addmul_5 and mpn_addmul_6. + +2002-05-25 Kevin Ryde + + * tune/tuneup.c: Misc nailifications, and disable preinv thresholds + with nails. + * tune/speed.h: Use GMP_NUMB_HIGHBIT with mpn_sb_divrem_mn and + mpn_divrem_2. + * mpz/powm.c (redc): Nailify q. + + * tests/mpn/t-scan.c: Reduce the amount of testing, to go faster. + +2002-05-23 Torbjorn Granlund + + * Version 4.1 released. + + * mpn/alpha/ev6/nails/gmp-mparam.h: New file. + + * tests/devel/add_n.c (refmpn_add_n): Nailify. + * tests/devel/sub_n.c (refmpn_sub_n): Nailify. + * tests/devel/addmul_1.c (refmpn_addmul_1): Nailify. + * tests/devel/submul_1.c (refmpn_submul_1): Nailify. + + * mpn/alpha/ev6/nails/add_n.asm: New file. + * mpn/alpha/ev6/nails/sub_n.asm: New file. + * mpn/alpha/ev6/nails/mul_1.asm: New file. + * mpn/alpha/ev6/nails/submul_1.asm: New file. + +2002-05-22 Torbjorn Granlund + + * mpn/alpha/ev6/nails/addmul_1.asm: New file. + + * mpz/inp_str.c (mpz_inp_str_nowhite): Nailify. + + * mpn/generic/mul_basecase.c: Update pointers before conditional + MAX_LEFT break statements. + +2002-05-21 Torbjorn Granlund + + * tests/mpz/t-gcd.c: Test mpz_gcd_ui. + + * mpz/lcm_ui.c: Nailify. + + * mpz/gcd_ui.c: Nailify. Make it work as documented, allowing + NULL to be passed for result parameter. Fix gcd(0,0) case. + + * mpz/set_str.c: Nailify. + + * randlc2x.c (gmp_randinit_lc_2exp): Nailify. + + From Jakub Jelinek: + * longlong.h (add_ssaaaa,sub_ddmmss) [64-bit sparc]: + Make it actually work. + +2002-05-18 Torbjorn Granlund + + * mpf/ui_div.c: Shut up compiler warning. + + * mpn/generic/mul_basecase.c: Use mpn_addmul_2, mpn_addmul_3, and + mpn_addmul_4, as available. + + * mpn/alpha/ev6/nails/addmul_2.asm: Adjust NAILS_SUPPORT decls. + * mpn/alpha/ev6/nails/addmul_3.asm: Likewise + * mpn/alpha/ev6/nails/addmul_4.asm: Likewise. + + * configure.in (*-cray-unicos*): Back again to -hscalar0. + (gmp_mpn_functions_optional): Add mul_3, mul_4, addmul_2, addmul_3, + and addmul_4. + * acconfig.h: Add #undefs for new optional mpn functions. + +2002-05-18 Kevin Ryde + + * gmp.texi (Integer Import and Export): Mention Cray unfilled words. + + * mpz/set_d.c, mpq/set_d.c: Use LIMBS_PER_DOUBLE for the output of + __gmp_extract_double. Reported by Henrik Johansson. + +2002-05-17 Torbjorn Granlund + + * mpn/alpha/ev6/nails/addmul_2.asm: New file. + * mpn/alpha/ev6/nails/addmul_3.asm: New file. + * mpn/alpha/ev6/nails/addmul_4.asm: New file. + + * mpn/generic/dump.c: Rewrite and nailify. + +2002-05-16 Kevin Ryde + + * mpfr/Makefile.am (EXTRA_DIST): Add BUGS file. + +2002-05-15 Torbjorn Granlund + + * configure.in (*-cray-unicos*): Remove -hscalar0, add -hnofastmd + as workaround for compiler bug. + (mips64*-*-*): Pass just -O1 to cc, to work around compiler bug. + +2002-05-14 Torbjorn Granlund + + * configure.in (*-cray-unicos*): Pass -hscalar0 to work around + compiler bug for mpz/import.c. + +2002-05-11 Torbjorn Granlund + + * mpz/import.c: Cast pointer via `unsigned long' when checking + alignment to avoid compiler warnings. + + * mpn/generic/rootrem.c: Adjust allocation of qp temporary area. + +2002-05-09 Kevin Ryde + + * mpz/import.c: Corrections to size store, special case tests, and + general case ACCUMULATE. + * tests/mpz/t-import.c, tests/mpz/t-export.c: More test data. + +2002-05-09 Torbjorn Granlund + + * mpn/generic/rootrem.c: Use temp space for root, copy value in place + before returning. + * mpz/root.c: Don't allocate extra limb for root value. + * mpz/perfpow.c: Undo last change. + +2002-05-08 Torbjorn Granlund + + * gmp-impl.h (powerpc BSWAP_LIMB_FETCH): Rename local variable to make + it not clash with caller. + + * mpn/generic/rootrem.c: New file. + * configure.in (gmp_mpn_functions): Add rootrem and pow_1. + * mpn/Makefile.am (nodist_libdummy_la_SOURCES): Add rootrem.c and + pow_1.c + * gmp-impl.h (mpn_rootrem): Add declaration. + * mpz/perfpow.c: Amend allocations for mpn_rootrem requirements. + * mpz/root.c: Rewrite to use mpn_rootrem. + +2002-05-08 Kevin Ryde + + * gmp-impl.h (MUL_KARATSUBA_THRESHOLD etc): Remove forced nail values. + + * mpf/fits_u.h, mpf/fits_s.h, tests/mpf/t-fits.c: Ignore fraction + part, making the code match the documentation. + + * gmpxx.h (struct __gmp_binary_minus): Use mpz_ui_sub. + +2002-05-07 Kevin Ryde + + * mpn/powerpc32/README: New file. + + * mpz/root.c: Use unsigned long with mpz_sub_ui not mp_limb_t. + + * tune/README: Misc updates including sparc32/v9 smoothness, low res + timebase, and mpn_add_n operand overlaps. + * tune/many.pl: Add udiv.asm support. + + * gmp.texi (Build Options): A couple of --build better as --host. + (Known Build Problems, Notes for Package Builds): Add DESTDIR problem. + (Compatibility with older versions): Compatible with 4.x versions. + (Converting Integers): Remove mpz_get_ui + mpz_tdiv_q_2exp decompose. + (Integer Import and Export): New section. + (Miscellaneous Integer Functions): Clarify mpz_sizeinbase returns 1 + for operand of 0. + (Language Bindings): Add GNU Pascal. + (Low-level Functions): Add GMP_NUMB_MAX. + + * tests/mpz/t-import.c, tests/mpz/t-export.c, tests/mpz/t-get_d.c: + New tests. + * tests/mpz/Makefile.am: Add them. + + * mpz/import.c, mpz/export.c: New files. + * Makefile.am, mpz/Makefile.am, gmp-h.in: Add them. + + * gmp-h.in, gmp-impl.h (GMP_NUMB_MAX): Move to gmp.h. + * gmp-impl.h (CNST_LIMB): Add cast to mp_limb_t to ensure unsigned. + (CRAY_Pragma, MPN_REVERSE, MPN_BSWAP, MPN_BSWAP_REVERSE, + ASSERT_ALWAYS_LIMB, ASSERT_ALWAYS_MPN): New macros. + (MPZ_CHECK_FORMAT): Use ASSERT_ALWAYS_MPN. + +2002-05-07 Torbjorn Granlund + + * mpz/aors_ui.h: Nailify. + + * tests/mpz/t-addsub.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add t-addsub. + + * mpz/ui_sub.c: New file. + * mpz/Makefile.am (libmpz_la_SOURCES): Add ui_sub.c. + * Makefile.am (MPZ_OBJECTS): Ditto. + * gmp-h.in (mpz_ui_sub): Add declaration. + + * gmp-impl.h (MPZ_REALLOC): Rewrite to allow the use of _mpz_realloc + return value. + + * gmp-h.in (mpn_pow_1): Add declaration. + + * mpn/generic/pow_1.c: Handle exp <= 1. Reverse rp/tp parity scheme + for bn == 1 arm. + + * Rename MP_LIMB_T_HIGHBIT => GMP_LIMB_HIGHBIT. + +2002-05-06 Torbjorn Granlund + + * demos/pexpr.c (main): Don't call mpz_sizeinbase with negative base. + + * randraw.c (lc): Remove an unused variable. + + * mpn/generic/get_str.c: Clarify an algorithm description. + + * tests/mpf/t-trunc.c: Nailify. + * tests/mpf/t-set_si.c: Disable for nails. + + * mpf/cmp_si.c: Nailify. + * mpf/cmp_ui.c: Nailify. + * mpf/div.c: Nailify. + * mpf/div_2exp.c: Nailify. + * mpf/div_ui.c: Nailify. + * mpf/eq.c: Nailify. + * mpf/get_d.c: Nailify. + * mpf/get_d_2exp.c: Nailify. + * mpf/get_si.c: Nailify. + * mpf/get_str.c: Nailify. + * mpf/get_ui.c: Nailify. + * mpf/mul_2exp.c: Nailify. + * mpf/random2.c: Nailify. + * mpf/set_q.c: Nailify. + * mpf/set_si.c: Nailify. + * mpf/set_str.c: Nailify. + * mpf/set_ui.c: Nailify. + * mpf/sub.c: Nailify. + * mpf/ui_div.c: Nailify. + * mpf/ui_sub.c: Nailify. + * mpf/urandomb.c: Nailify. + + * gmp-impl.h (__GMPF_BITS_TO_PREC, __GMPF_PREC_TO_BITS): Nailify. + + * mpz/get_si.c: Misc variable name changes. + + * mpf/fits_u.h: Rewrite - nailify. + * mpf/fits_s.h: Likewise. + + * mpz/mod.c: Disambiguate if-statement with extra {}. + + * mpf/int_p.c: Fix type of size variables. + * mpf/get_ui: Likewise. + * mpf/get_si: Likewise. + * mpq/equal.c: Likewise. + * mpq/get_d.c: Likewise. + * mpz/cmp_d.c: Likewise. + * mpz/cmpabs_d.c: Likewise. + * mpz/divis_2exp.c: Likewise. + * mpz/kronuz.c: Likewise. + * mpz/kronzu.c: Likewise. + * mpz/kronzs.c: Likewise. + * mpz/kronsz.c: Likewise. + * mpz/scan0.c: Likewise. + * mpz/scan1.c: Likewise. + * mpz/tstbit.c: Likewise. + * mpz/cong_2exp.c: Likewise. + * mpz/divis.c: Likewise. + +2002-05-04 Torbjorn Granlund + + * mpn/generic/gcd.c: Additional nailify changes. + +2002-05-04 Kevin Ryde + + * gmp-h.in (__GNU_MP_VERSION): Set to 4.1. + * Makefile.am (-version-info): Bump for new release. + +2002-04-30 Torbjorn Granlund + + * mpn/generic/divrem_1.c: Additional nailify changes. + * mpn/generic/mod_1.c: Likewise. + + * tests/mpq/t-get_d.c: Print floats with all 16 digits. + + * mpq/get_d.c: Nailify. + + * tests/mpq/t-set_f.c: Disable for nails. + + * mpz/get_d.c: Nailify. + + * gmp-impl.h (LIMBS_PER_DOUBLE, MP_BASE_AS_DOUBLE): Nailify. + + * gmp-h.in (__GMPZ_FITS_UTYPE_P): Cast maxval to before shifting it. + + * extract-dbl.c: Nailify. + +2002-04-29 Torbjorn Granlund + + * mpq/md_2exp.c (mord_2exp): Nailify. + + * mpq/cmp_ui.c: Nailify. + + * mpq/cmp.c (mpq_cmp): Nailify. + + * mpn/generic/gcd.c: Nailify. GNUify code layout. + + * mpn/generic/gcdext.c: Nailify. Misc changes. + + * tests/mpz/t-sqrtrem.c: Let argv[1] mean # of repetitions. + * tests/mpz/t-gcd.c: Likewise. + + * mpz/gcd.c: Nailify. + + * mpn/generic/random.c: Nailify. + + * gmp-impl.h (modlimb_invert): Nailify. + +2002-04-27 Torbjorn Granlund + + * mpn/generic/gcdext.c (div2): Remove qh parameter. + (mpn_gcdext): Streamline double-limb code. + Move GCDEXT_THRESHOLD check to after initial division. + +2002-04-27 Kevin Ryde + + * gmp-impl.h (JACOBI_MOD_OR_MODEXACT_1_ODD): Allow for odd + GMP_NUMB_BITS. + + * tune/time.c (sgi_works_p): Allow for 64-bit counter, and fix + SGI_CYCLECNTR_SIZE handling. + + * demos/expr/exprfr.c: Add nan and inf constants. + * demos/expr/t-expr.c: Exercise them. + +2002-04-26 Torbjorn Granlund + + * mpz/cmp_ui.c: Fix overflow conditions for nails. + + * gmp-h.in (mpz_get_ui): Fix typo from last change. + + * mpz/n_pow_ui.c: Adjust allocation for nails. + (GMP_NUMB_HALFMAX): Renamed from MP_LIMB_T_HALFMAX. + Fix umul_ppmm invocation for for nails. + +2002-04-24 Torbjorn Granlund + + * mpn/generic/gcdext.c: Simplify by using mpn_tdiv_qr instead of + mpn_divmod. + +2002-04-24 Kevin Ryde + + * configure.in (*-*-cygwin*): Give a sensible default command line + limit, to avoid blowups reported by Jim Fougeron on windows 9x. + (--enable-nails): Make the default 2, since mp_bases has data for that. + + * mpfr/mpfr-math.h (__mpfr_nan): Use a "double" for the bytes, to + avoid a mis-conversion on alpha gcc 3.0.2. + (_MPFR_INFP_BYTES, _MPFR_INFM_BYTES): Should be a zero mantissa. + +2002-04-23 Torbjorn Granlund + + * mpz/dive_ui.c: Fix typo. + + * mpz/fits_s.h: Rewrite. + + * mpz/jacobi.c: Nailify. + * mpz/kronuz.c: Additional nailify changes. + * mpz/kronsz.c: Likewise. + +2002-04-23 Kevin Ryde + + * demos/expr/Makefile.am (LDADD): Add $(LIBM) for the benefit of mpfr. + + * mpz/divis_ui.c, mpz/cong_ui.c: Nailify. + * mpn/generic/bdivmod.c, mpz/divexact.c, mpz/dive_ui.c: Nailify. + * mpn/generic/sb_divrem_mn.c, mpn/generic/divrem.c, + mpn/generic/divrem_2.c: Nailify ASSERTs. + * mpn/x86/k6/mmx/logops_n.asm, mpn/x86/k6/mmx/com_n.asm: Nailify. + * mpz/inp_raw.c, mpz/out_raw.c: Nailify. + * mpz/kronzu.c, mpz/kronuz.c, mpz/kronzs.c, mpz/kronsz.c: Nailify. + * mpn/generic/divis.c, mpz/cong.c, mpz/cong_2exp.c: Nailify. + * gmp-impl.h (NEG_MOD): Nailify. + + * gmp-impl.h, mpn/mp_bases.c: Add back GMP_NUMB_BITS==30 bases data. + + * mpfr/get_d.c: Patch from Paul to avoid problem with constant folding + in gcc on OSF. + + * mpn/lisp/gmpasm-mode.el: Remove mention of defunct LF macro. + +2002-04-22 Torbjorn Granlund + + * demos/pexpr.c: Handle "binomial" operator. + + * mpz/cmp_ui.c: Move assignments of `up' out of conditionals. + + * mpn/generic/gcdext.c: Fix fencepost error in STAT code. + + * gmp-impl.h (mpn_com_n): Nailify. + + * tests/mpz/t-cdiv_ui.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add t-cdiv_ui. + * mpz/cdiv_qr_ui.c: Nailify. + * mpz/cdiv_q_ui.c: Nailify. + * mpz/cdiv_r_ui.c: Nailify. + * mpz/cdiv_ui.c: Nailify. + + * tests/misc/t-printf.c (CHECK_N): Add cast to allow `char' to be an + unsigned type. + * tests/misc/t-scanf.c: Likewise. + + * mpz/mul_i.h: Rework nails code to handle parameter overlap. + + * tests/mpz/t-set_f.c: Disable for nails. + +2002-04-21 Torbjorn Granlund + + * mpz/set_si.c: Add cast to support LONG_LONG_LIMB. + * mpz/iset_si.c: Likewise. + + * mpz/bin_ui.c: Nailify. + * mpz/bin_uiui.c: Nailify. + + * mpz/cmpabs_ui.c: Nailify. + + * tests/mpz/t-aorsmul.c: Nailify. + * mpz/aorsmul_i.c (mpz_addmul_ui, mpz_submul_ui): Nailify better. + +2002-04-20 Torbjorn Granlund + + * tests/mpz/t-fdiv_ui.c: Check mpz_fdiv_ui. + * tests/mpz/t-tdiv_ui.c: Check mpz_tdiv_ui. + + * mpz/tdiv_ui.c: Rewrite nails code. + * mpz/fdiv_ui.c: Nailify. + + * tests/mpz/t-tdiv_ui.c: Check returned remainders. + * tests/mpz/t-fdiv_ui.c: Merge in recent t-tdiv_ui changes. + + * mpz/tdiv_q_ui.c: Remove spurious TMP_* calls. + + * mpz/fdiv_qr_ui.c: Nailify. + * mpz/fdiv_q_ui.c: Nailify. + * mpz/fdiv_r_ui.c: Nailify. + + * mpz/get_si.c: Misc nailify changes to shut up compiler warnings. + + * mpz/ui_pow_ui.c: Fix typo in last change. + +2002-04-20 Kevin Ryde + + * tests/misc/t-printf.c, tests/misc/t-scanf.c: Check all %n types. + + * mpn/x86/k7/mmx/divrem_1.asm, mpn/x86/p6/mmx/divrem_1.asm + (mpn_preinv_divrem_1): New entrypoint. + (mpn_divrem_1): Avoid a branch when testing high + + * tests/mpz/t-scan.c: Nailify. + + * mpz/tdiv_qr_ui.c: Nailify. + * mpz/tdiv_q_ui.c: Nailify. + * mpz/tdiv_r_ui.c: Nailify. + * mpz/tdiv_ui.c: Nailify. + + * mpz/cmp_ui.c: Nailify. + + * mpz/ui_pow_ui.c: Misc nailify changes to shut up compiler warnings. + + * mpz/scan0.c: Nailify. + * mpz/scan1.c: Nailify. + + * tests/mpz/t-sizeinbase.c (mpz_fake_bits): Nailify. + +2002-04-18 Torbjorn Granlund + + * mpz/aorsmul_i.c: Nailify. + + * mpz/cmp_si.c: Nailify (botched). + + * mpz/ui_pow_ui.c: Nailify. + + * gmp-h.in (__GMPZ_FITS_UTYPE_P): Nailify. + + * mpz/fits_s.h: Nailify. + + * tests/mpz/bit.c (check_tstbit): Nailify. + + From Paul Zimmermann: + * mpn/generic/sqrtrem.c: Nailify. + + * mpz/n_pow_ui.c: Nailify. + + * mpz/cfdiv_r_2exp.c: Nailify. + + * randraw.c (lc): Undo: Let mpn_rshift put result in place to avoid + extra MPN_COPY. + +2002-04-17 Torbjorn Granlund + + * mpz/clrbit.c: Add two GMP_NUMB_MASK masks after addition. + + * mpn/generic/random2.c (LOGBITS_PER_BLOCK): Decrease to 4. + + * gmp-impl.h (nail DIV_DC_THRESHOLD): Decrease to 50 to allow fast + division. + + * mpn/generic/random2.c: Nailify. + + * mpz/fac_ui.c: Nailify. + + * mpz/mul_i.h: #if ... #endif code block to shut up gcc warnings. + + * mpn/generic/sqrtrem.c: Adopt to GNU coding standards. + (mpn_dc_sqrtrem): New name for mpn_dq_sqrtrem. + Partial nailification. + + * configure.in: As a temporary hack, clear extra_functions for nails + builds. + + * gmp-h.in (mpz_get_ui): #if ... #endif else code block to shut up gcc + warnings. + +2002-04-17 Kevin Ryde + + * texinfo.tex: Update to 2002-03-26.08 per texinfo 4.2. + * gmp.texi: Must have @top in @ifnottex (or @contents doesn't come out + in one run). + + * mpn/generic/scan0.c, mpn/generic/scan1.c: Nailify. + + * tests/mpn/t-scan.c: New file. + * tests/mpn/Makefile.am (check_PROGRAMS): Add it. + + * tests/refmpn.c, tests/tests.h (refmpn_tstbit): Use unsigned long for + bit index. + (refmpn_setbit, refmpn_clrbit, refmpn_scan0, refmpn_scan1): New + functions. + + * mpfr/cmp_ui.c (mpfr_cmp_si_2exp): Fix b==0 i!=0 case. + +2002-04-17 Gerardo Ballabio + + * gmpxx.h, mpfrxx.h: Remove mpfr_class bool combinations, remove + mpfr_class::get_str2, use mp_rnd_t for rounding modes, use + 8*sizeof(double) for mpfr_t's holding doubles. + +2002-04-17 Torbjorn Granlund + + * mpz/powm.c: Nailify. + * mpz/powm_ui.c: Nailify. + +2002-04-16 Torbjorn Granlund + + * mpz/hamdist.c: Nailify. + * tests/misc.c (urandom): Nailify. + + * mpz/get_si.c: Nailify. + * gmp-h.in (mpz_get_ui): Nailify. Streamline (and probably upset + memory checkers). + + * gmp-impl.h (mp_bases[10] values): Add versions for GMP_NUMB_BITS + being 28, 60, and 63. + * mpn/mp_bases.c: Add tables for GMP_NUMB_BITS being 28, 60, and 63. + + * mpz/iset_si.c: Nailify. + * mpz/iset_ui.c: Nailify + + * tests/mpz/convert.c (main): Print test number in error message. + + * mpn/generic/get_str.c (mpn_sb_get_str): Shift up `frac' into nails + field after bignum division. + +2002-04-16 Kevin Ryde + + * gmp-h.in, gmp-impl.h (GMP_NAIL_MASK): Move to gmp.h. + + * gmp.texi: Use @documentdescription and @copying, per texinfo 4.2. + (Low-level Functions): Clarify mpn_gcd overlap requirements, rewrite + mpn_set_str description, add nails section. + (C++ Interface General): Remove bool from types that mix with classes. + (Language Bindings): Add STklos, GNU Smalltalk, Regina. + (Binary to Radix, Radix to Binary): Describe new code. + (Assembler Cache Handling): More notes, mostly by Torbjorn. + + * macos/configure (%vars): Remove __GMP from substitutions, per change + to main configure. + + * mpn/generic/dive_1.c: Nailify. + * mpn/generic/mode1o.c: Nailify, remove bogus ASSERT in commented-out + alternate implementation. + * gmp-impl.h (SUBC_LIMB): New macro. + + * tests/devel/try.c (validate_divexact_1): Correction to compare. + (udiv_qrnnd): New testing. + (SHIFT_LIMIT): Nailify. + (-b): New option, remove spurious "H" from getopt string. + + * mpz/clrbit.c: Nailify. + * tests/mpz/t-hamdist.c: Nailify. + * gmp-impl.h (MPN_FIB2_SIZE): Nailify. + (PP): Nailify conditionals. + * tests/mpz/t-fib_ui.c (MPZ_FIB_SIZE_FLOAT): Nailify. + + * configure.in, acinclude.m4: Establish GMP_NAIL_BITS and + GMP_LIMB_BITS for gmp-h.in configure tests. + + * mpfr/*, configure.in: Update to final mpfr 2.0.1. + * mpfr/acinclude.m4 (MPFR_CONFIGS): Use $host, not uname stuff. + * mpfr/tests/tout_str.c: Patch from Paul for denorm fprintf tests. + +2002-04-15 Torbjorn Granlund + + * mpn/generic/divrem_1.c (EXTRACT): Remove. + + * tests/mpz/t-tdiv_ui.c (dump_abort): Accept argument for error string. + + * mpz/rrandomb.c: Nailify. Needs further work. + + * mpn/generic/mod_1.c: Nailify. + + * gmp-impl.h: Set various *_THRESHOLD values to be used for nails to + avoid not yet qualified algorithms. + (MPZ_CHECK_FORMAT): Check that nail part is zero. + + * tests/mpz/t-mul.c (main): Test squaring even for huge operands. + (base_mul): Nailify. + (dump_abort): Accept argument for error string. Print product + difference. + + * mpn/generic/set_str.c: Nailify. + + * gmp-h.in (__GMPN_ADD, __GMPN_SUB): Nailify. + +2002-04-14 Torbjorn Granlund + + * randraw.c (lc): Return non-nonsense return value for seed=0 case. + Check for m2exp being non-zero early; remove all other tests of m2exp. + Remove redundant MPN_ZERO call. + Let mpn_rshift put result in place to avoid extra MPN_COPY. + Remove confusing comment before function `lc' describing BBS algorithm. + Misc simplification and cleanups. + Nailify. Needs further work. + + * mpz/set_si.c: Nailify. + * mpz/set_ui.c: Nailify. + * mpz/mul_i.h: Nailify. + + * tests/mpz/t-mul_i.c: Actually test _ui routines. Add some more test + values. + + * mpn/generic/mul_n.c: Finish nailifying toom3 code. + +2002-04-13 Kevin Ryde + + * mpfr/*: Update to another new mpfr 2.0.1. + * configure.in, Makefile.am, mpfr/Makefile.am, mpfr/tests/Makefile.am: + Use MPFR_CONFIGS macro, establish separate MPFR_CFLAGS for mpfr build. + + * mpfr/tests/Makefile.am: Correction to convenience rule for libmpfr.a. + +2002-04-11 Kevin Ryde + + * mpfr/set_q.c: gmp-impl.h before mpfr.h to avoid _PROTO redefine. + + * mpfr/*, configure.in: Update to new mpfr 2.0.1. + + * tests/refmpn.c (refmpn_udiv_qrnnd, refmpn_divmod_1c_workaround): + Fixes for nails. + + * tests/t-constants.c (MODLIMB_INVERSE_3): Nailify tests. + (MP_BASES_BIG_BASE_INVERTED_10, MP_BASES_NORMALIZATION_STEPS_10): Only + check these under USE_PREINV_DIVREM_1. + * tests/t-modlinv.c: Nailify tests. + +2002-04-11 Gerardo Ballabio + + * gmpxx.h: Remove bool combinations, remove mpf_class::get_str2, only + need now. + +2002-04-11 Torbjorn Granlund + + * mpn/generic/diveby3.c: Nailify. + * gmp-impl.h (MODLIMB_INVERSE_3): Nailify. + + * mpn/generic/mul_n.c: Nailify Toom3 code. + +2002-04-10 Kevin Ryde + + * gmp-impl.h (MPN_KARA_MUL_N_MINSIZE, MPN_KARA_SQR_N_MINSIZE): Set to + 3, as needed by nails case. + + * mpn/generic/addmul_1.c, mpn/generic/submul_1.c [nails]: Fix vl + assert, add rp,n and up,n asserts. + + * mpfr/Makefile.am: Add new mpfr-math.h, install mpf2mpfr.h. + +2002-04-10 Torbjorn Granlund + + * mpn/generic/divrem_1.c: Nailify. Update mp_size_t variables to use + `n' suffix instead of `size' suffix. + * mpn/generic/divrem_2.c: Likewise. + * mpn/generic/sb_divrem_mn.c: Nailify. + * mpn/generic/tdiv_qr.c: Nailify. + (SHL): Remove silly macro. + + * mpn/generic/mul_n.c (mpn_kara_mul_n): Replace open-coded increment by + mpn_incr_u call. Handle nails in ws[n] increment. + * mpn/generic/mul_n.c (mpn_kara_sqr_n): Likewise. + + * gmp-h.in (GMP_NUMB_MASK): New #define. + (__GMPN_AORS_1): Add version for nails. + + * gmp-impl.h (GMP_NUMB_MASK): Comment out, now in gmp.h. + (mpn_incr_u): Don't assume `incr' is non-zero. + (mpn_decr_u): Similarly. + +2002-04-09 Kevin Ryde + + * mpfr/*, configure.in: Update to mpfr 2.0.1. + + * tests/refmpn.c (refmpn_mul_1c, lshift_make): Corrections for nails. + * tssts/refmpn.c, tests/tests.h (refmpn_cmp_allowzero): New function. + + * mpn/generic/mul_1.c [nails]: Fix vl assert, add {up,n} assert. + + * mpn/pa32/hppa1_1/pa7100/addmul_1.asm, + mpn/pa32/hppa1_1/pa7100/submul_1.asm: Rename "size" define, to avoid + ELF .size directive. Reported by LaMont Jones. + + * tests/mpz/t-set_si.c: Add nails support. + +2002-04-05 Torbjorn Granlund + + * gmp-impl.h: Replace nail mpn_incr_u, mpn_decr_u with faster versions. + (mp_bases[10] values): Check GMP_NUMB_BITS instead of BITS_PER_MP_LIMB. + Add GMP_NUMB_BITS == 30 version. + (__gmp_doprnt, etc): Remove parameter names. + + * mpn/generic/mul_n.c: Nailify Karatsuba code. + * mpn/generic/get_str.c: Nailify. + * mpn/generic/sqr_basecase.c: Nailify. + * mpn/generic/lshift.c: Nailify. + * mpn/generic/rshift.c: Likewise. + * mpn/generic/add_n.c: Nailify. Revamp non-nail code. + * mpn/generic/sub_n.c: Likewise. + * mpn/generic/mul_1.c: Likewise. + * mpn/generic/addmul_1.c: Likewise. + * mpn/generic/submul_1.c: Likewise. + +2002-04-02 Kevin Ryde + + * gmp-impl.h (BSWAP_LIMB_FETCH, BSWAP_LIMB_STORE) [powerpc]: + Corrections to constraints, and restrict to bigendian. + +2002-03-31 Kevin Ryde + + * tests/mpz/dive.c: Better diagnostics. + + * tests/devel/try.c (mpn_get_str, mpn_umul_ppmm_r): New tests. + + * tests/misc.c, tests/tests.h (byte_diff_lowest, byte_diff_highest): + New functions. + + * tests/t-bswap.c: New file. + * tests/Makefile.am (check_PROGRAMS): Add it. + + * tests/mpn/t-aors_1.c, tests/mpn/t-iord_u.c: Add nails support. + + * gmp-impl.h (MPN_IORD_U) [x86]: Eliminate unnecessary jiord and iord, + rename "n" to incr per generic versions, restrict to nails==0. + (mpn_incr_u, mpn_decr_u): Add nails support. + (GMP_NAIL_LOWBIT, GMP_NUMB_MAX): New macros. + + * tests/trace.c, tests/tests.h (byte_trace, byte_tracen): New + functions. + * tests/trace.c: Handle NULL operands. + + * tests/refmpn.c, tests/devel/try.c, tune/speed.c: Add preliminary + nail support. + + * tests/refmpn.c, test/tests.h (byte_overlap_p, refmpn_equal_anynail, + refmpn_umul_ppmm_r, refmpn_udiv_qrnnd_r, refmpn_get_str, + refmpn_bswap_limb, refmpn_random, refmpn_random2, refmpn_bswap_limb): + New functions. + + * gmp-impl.h, tests/refmpn.c (ASSERT_LIMB): Renamed from + ASSERT_MP_LIMB_T. + + * mpn/x86/*/*.asm, mpn/powerpc32/*/*.asm, mpn/powerpc64/*/*.asm: Put + speeds after the copyright notice, so as to keep that clear. + +2002-03-29 Kevin Ryde + + * configure.in (powerpc*-*-aix*): Correction to xlc -qarch selection, + for 32-bit mode. + +2002-03-28 Torbjorn Granlund + + * mpn: Fix spacing in many files. + + * mpn/generic/aorsmul_1.c: Split into addmul_1.c and submul_1.c. + * mpn/generic/aors_n.c: Split into add_n.c and sub_n.c. + + * mpn/pa64/add_n.asm: Trim another 0.125 cycle/limb. Fix a comment. + * mpn/pa64/sub_n.asm: Likewise. + + * mpn/pa64/mul_1.asm: Change comclr, comb to proper forms cmpclr, cmpb. + * mpn/pa64/addmul_1.asm: Likewise. + * mpn/pa64/submul_1.asm: Likewise. + +2002-03-28 Kevin Ryde + + * gmp.texi (Converting Integers): Fix type of exp in mpz_get_d_2exp, + reported by epl@unimelb.edu.au. + (References): Update Burnikel and Ziegler URL, reported by Keith + Briggs. + + * gmp-h.in, mp-h.in, configure.in, acinclude.m4: Remove __GMP from + AC_SUBSTs, since autoconf says leading "_" in makefile variables is + not portable. + + * demos/expr/run-expr.c: Declare optarg, optind, opterr if necessary. + * configure.in, demos/expr/expr-config-h.in: Configs for this. + +2002-03-27 Torbjorn Granlund + + * mpn/Makefile.am (TARG_DIST): Remove pa64w and hppa, add pa32. + + * configure.in (path_20w): Remove pa64w. + + * mpn/pa64/udiv_qrnnd.asm: Tweak for PA8000 performance comparative to + that on PA8500. + +2002-03-26 Torbjorn Granlund + + * mpn/pa32: New name for mpn/hppa. + * configure.in: Corresponding changes. + + * mpn/pa64/umul_ppmm.asm: New file, generalized for both 2.0N and 2.0W. + * mpn/pa64/umul_ppmm.S: Remove. + + * mpn/pa64/udiv_qrnnd.asm: Generalize for both 2.0N and 2.0W. + * mpn/pa64w/udiv_qrnnd.asm: Remove. + +2002-03-26 Kevin Ryde + + * mpfr/tests/tdiv.c, mpfr/tests/tui_div.c: Don't depend on nan and inf + handling in "double", for the benefit of alpha. + + * configure (hppa2.0w): Set path to "pa64w pa64". + + * acinclude.m4, configure.in (GMP_C_INLINE): New macro. + * acinclude.m4 (GMP_H_EXTERN_INLINE): Use it, and fix "yes" handling. + +2002-03-25 Torbjorn Granlund + + * mpn/pa64w/add_n.s: Remove. + * mpn/pa64w/sub_n.s: Remove. + * mpn/pa64w/lshift.s: Remove. + * mpn/pa64w/rshift.s: Remove. + * mpn/pa64w/mul_1.S: Remove. + * mpn/pa64w/addmul_1.S: Remove. + * mpn/pa64w/submul_1.S: Remove. + * mpn/pa64w/sqr_diagonal.asm: Remove. + + * mpn/pa64/mul_1.asm: New file with twice faster code; generalized + for both 2.0N and 2.0W. + * mpn/pa64/submul_1.asm: Likewise. + * mpn/pa64/mul_1.S: Remove. + * mpn/pa64/submul_1.S: Remove. + + * mpn/pa64/sqr_diagonal.asm: Generalize for both 2.0N and 2.0W. + + * mpn/pa64/add_n.asm: New file, generalized for both 2.0N and 2.0W. + * mpn/pa64/sub_n.asm: Likewise. + * mpn/pa64/lshift.asm: Likewise. + * mpn/pa64/rshift.asm: Likewise. + * mpn/pa64/add_n.s: Remove. + * mpn/pa64/sub_n.s: Remove. + * mpn/pa64/lshift.s: Remove. + * mpn/pa64/rshift.s: Remove. + +2002-03-24 Kevin Ryde + + * gmp-impl.h (BSWAP_LIMB_FETCH, BSWAP_LIMB_STORE): New macros. + * mpz/inp_raw.c, mpz/out_raw.c: Use them. + * acconfig.h (HAVE_HOST_CPU): Add some powerpc types. + + * mpn/powerpc32/750/com_n.asm: New file. + + * mpfr/tests/tout_str.c: Disable random tests, since they fail on + alphaev56-unknown-freebsd4.1 and do nothing by default. + + * mpfr/tests/tsqrt.c: Don't depend on nan, inf or -0 in "double", for + the benefit of alpha. + * mpfr/sqrt.c: Clear nan flag on -0. + + * demos/factorize.c: Use mpn_random() instead of random(), to avoid + portability problems. + + * demos/isprime.c (print_usage_and_exit): Declare as "void" to avoid + warnings. + + * demos/pexpr.c (setup_error_handler): Corrections to sigstack code. + + * demos/calc/calc.y: Add some `;'s to make bison 1.34 happy. + +2002-03-23 Torbjorn Granlund + + * mpn/pa64/addmul_1.asm: New file with twice faster code; generalized + for both 2.0N and 2.0W. + +2002-03-22 Kevin Ryde + + * tune/time.c: Add SGI hardware counter measuring method, change some + abort()s into ASSERT_FAIL()s. + + * configure.in (AC_CHECK_HEADERS): Add fcntl.h and sys/syssgi.h. + (AC_CHECK_FUNCS): Add syssgi. + + * configure.in, mpfr/Makefile.am, mpfr/tests/Makefile.am: Use + -mieee-with-inexact or -ieee_with_inexact for mpfr on alpha, so + denorms work. + + * mpfr/isinteger.c: Fix a memory leak. + +2002-03-21 Torbjorn Granlund + + * tune/speed.c (struct choice_t): Make `r' an mp_limb_t. + +2002-03-21 Kevin Ryde + + * configure.in (HAVE_LIMB_BIG_ENDIAN, HAVE_LIMB_LITTLE_ENDIAN): Use an + AH_VERBATIM and better explanation. + * acinclude.m4 (GMP_C_DOUBLE_FORMAT): Similarly for the HAVE_DOUBLE + constants. + + * gmp.texi (Number Theoretic Functions): Clarify sign of GCD returned + by mpz_gcdext. + + * demos/pexpr.c, demos/pexpr-config-h.in, configure.in: Use an + autoconf test for stack_t. + + * configure.in, gmp-h.in, mp-h.in, macos/configure, tests/mpz/reuse.c, + tests/mpf/reuse.c: Use __GMP_LIBGMP_DLL to enable windows declspec, + don't require _WIN32 (etc), remove __GMP_LIBGMP_SHARED and + __GMP_LIBGMP_STATIC. + + * gmp-impl.h (mp_bases): Add __GMP_DECLSPEC, for the benefit of + tests/t-constants.c. + + * tune/many.pl, tune/speed.h: Remove suffix hack for back.asm. + +2002-03-21 Paul Zimmermann + + * mpfr/sin_cos.c (mpfr_sin_cos): New file. + * mpfr/mpfr.h, mpfr/mpfr.texi, mpfr/Makefile.am: Add it. + * mpfr/tan.c: Fix sign in 2nd and 4th quadrants. + + * mpfr/log10.c: Fix hangs on certain inputs. + +2002-03-20 Torbjorn Granlund + + * demos/pexpr.c (setup_error_handler): Declare `s', the first + sigaltstack parameter, using `stack_t' just on AIX. + +2002-03-19 Torbjorn Granlund + + * mpn/powerpc32/mul_1.asm: Use free caller-saves registers instead + of the callee-saves r30 and r31. + +2002-03-19 Kevin Ryde + + * tune/freq.c (freq_proc_cpuinfo): Recognise powerpc "clock", where + previously got the wrong result from "bogomips". + + * mpn/powerpc32/add_n.asm, mpn/powerpc32/sub_n.asm: Rewrite, faster on + 750, and smaller too. + * mpn/powerpc32/*.asm: Use L(), add some measured speeds. + + * longlong.h (count_trailing_zeros) [vax]: Add a version using ffs, + but commented out. + +2002-03-17 Kevin Ryde + + * tune/speed.c, tune/speed.h, tune/common.c, many.pl: Use optional + ".r" to specify operand overlaps for mpn_add_n, mpn_sub_n and logops. + Remove mpn_add_n_inplace and mpn_add_n_self. + * tune/many.pl: Fix MULFUNC_PROLOGUE parsing. + + * gmp.texi (Known Build Problems): Note `make' problem with long + libgmp.la dependencies list. + + * printf/doprnt.c, scanf/doscan.c (%zn): Remove test of non-existent + HAVE_SIZE_T, just use size_t unconditionally. + * printf/doprnt.c (%zd etc): Fix 'z' type parsing. + * tests/misc/t-printf.c, tests/misc/t-scanf.c: More tests. + + * configure.in: Use AC_COPYRIGHT. + Add m4_pattern_allow(GMP_MPARAM_H_SUGGEST). + + * tune/Makefile.am (libdummy.la): Remove this, sqr_basecase.c already + gets an ansi2knr rule from nodist_tuneup_SOURCES. + + * longlong.h (count_leading_zeros) [pentiumpro gcc<3]: Test + HAVE_HOST_CPU_i686 too. + + * mpz/out_raw.c (HTON_LIMB_STORE): Fix a typo in big endian #if. + +2002-03-14 Kevin Ryde + + * mpn/x86/pentium/com_n.asm, mpn/x86/pentium/logops_n.asm, + mpn/x86/k6/mmx/com_n.asm: Add nails support. + + * texinfo.tex: Update to 2002-03-01.06 (per texinfo 4.1). + * gmp.texi (@ma): Remove, @math does this now. + + * mpfr/tests/reuse.c: Clear op1 and op2 flags only in their respective + outer loops. + + * configure.in (--enable-cxx): Correction to the default stated in the + help string. + (power*-*-aix*, not powerpc): Use aix.m4, don't run + GMP_ASM_POWERPC_R_REGISTERS or use powerpc-defs.m4. + +2002-03-13 Torbjorn Granlund + + * mpn/sparc32/gmp-mparam.h: New file. + +2002-03-13 Kevin Ryde + + * demos/expr/exprfr.c: More mpfr functions, corrections to agm, cos, + sin, rename log2 constant to loge2 to make room for log2 function. + * demos/expr/t-expr.c: More tests. + + * mpz/inp_raw.c (NTOH_LIMB_FETCH) [generic 16bit]: Remove spurious "+". + + * mpfr/acos.c: Avoid a memory leak for certain operands. + + * acinclude.m4, configure.in (GMP_C_DOUBLE_FORMAT): New macro. + + * acinclude.m4 (GMP_HPC_HPPA_2_0, GMP_ASM_UNDERSCORE, + GMP_ASM_ALIGN_LOG, GMP_ASM_LSYM_PREFIX, GMP_ASM_W32, GMP_ASM_X86_MMX): + Change ac_objext to OBJEXT, which is the documented variable. + + * config.guess (powerpc*-*-*): Use #ifdef on constants POWER_630 etc + in the AIX test, since old versions don't have them all. + +2002-03-11 Kevin Ryde + + * configure.in (LIBC211): New AC_DEFINE, for mpfr. + + * configure.in (mips*-*-*): Support ABI=o32 on irix 6, allow gcc 2.7.2 + to fall back on it, but detect it doesn't work with gcc 2.95. Use + single mips-defs.m4 for both mips32 and mips64. + * acinclude.m4 (GMP_GCC_MIPS_O32): New macro. + * mpn/mips32/mips-defs.m4: Renamed from mips.m4. + * mpn/mips64/mips.m4: Remove (was a copy of mips32/mips.m4). + + * mpn/powerpc32/750: New directory. + * configure.in (powerpc740, powerpc750, powerpc7400): Use it. + * mpn/powerpc32/750/gmp-mparam.h: New file. + + * config.sub, gmp.texi (ultrasparc1): Remove this, just use plain + "ultrasparc". + +2002-03-10 Kevin Ryde + + * mpfr: Update to 20020301, except internal_ceil_exp2.c, + internal_ceil_log2.c, internal_floor_log2.c renamed to i_ceil_exp2.c, + i_ceil_log2.c, i_floor_log2.c to be unique in DOS 8.3. And sqrtrem.c + removed since no longer required. + * mpfr/mpfr.texi: Fix some formatting. + * mpfr/tests/reuse.c: Patch by Paul to fix test4 variable handling. + * mpfr/sinh.c: Patch by Paul to fix err calculation when t==0. + * mpfr/tests/tget_d.c: Disable until portability of rnd_mode.c can be + sorted out. + + * configure.in (powerpc*-*-*): Separate gcc and xlc cpu flags setups + for clarity. + + * longlong.h (count_leading_zeros, count_trailing_zeros) [x86_64]: New + macros. + +2002-03-07 Kevin Ryde + + * gmp.texi (Build Options): Note all the ultrasparcs accepted. + (Language Bindings): Add Math::BigInt::GMP. + + * config.sub (ultrasparc2i): New cpu type. + * config.guess (sparc-*-*, sparc64-*-*): Add some exact CPU detection. + +2002-03-05 Kevin Ryde + + * longlong.h (count_leading_zeros, count_trailing_zeros) [alphaev67, + alphaev68]: Use ctlz and cttz insns (as per gcc longlong.h). + (count_leading_zeros) [sparclite]: Fix parameter order (as per gcc + longlong.h). + * acconfig.h (HAVE_HOST_CPU_alphaev68): New define. + + * config.guess [i?86-*-*]: Suppress error messages if compiler not + found or test program won't run. + [rs6000-*-*, powerpc-*-*]: Force code alignment for mfpvr test. + +2002-03-04 Torbjorn Granlund + + * mpn/generic/pow_1.c: New file. + +2002-03-03 Kevin Ryde + + * gmp.texi (Build Options): Note compiler must be able to fully link, + add alphapca57 and alphaev68, give a clearer example of MPN_PATH + (Debugging): Add notes on valgrind. + (C++ Formatted Output): Clarify mpf showbase handling, in particular + note "00.4" in octal. + + * printf/doprntf.c: Do a showbase on octal float fractions, for + instance "00.4" where previously it gave "0.4". + * tests/cxx/t-ostream.cc: Update. + + * gmp-h.in, mp-h.in (__GMP_DECLSPEC, __GMP_DECLSPEC_XX): Test + __WIN32__ for Borland C, reported by "delta trinity". + + * gmp-h.in, mp-h.in: Use for size_t under C++, suggested by + Hans Aberg some time ago. + * gmp-h.in (): Move to top of file for clarity. + + * Makefile.am (libgmpxx_la_SOURCES): Use dummy.cc to force C++. + (CXX_OBJECTS): Add osfuns$U.lo. + * dummy.cc: New file. + * cxx/Makefile.am (INCLUDES): Use __GMP_WITHIN_GMPXX. + (libcxx_la_SOURCES): Add osfuns.cc. + * gmp-h.in (__GMP_DECLSPEC_XX): New define, use it on libgmpxx funs. + * gmp-impl.h: Add __GMP_DECLSPEC to libgmp functions used by libgmpxx. + + * longlong.h (COUNT_TRAILING_ZEROS_TIME): Remove, no longer used. + + * gmp-impl.h (MPN_SIZEINBASE, MPN_SIZEINBASE_16): Correction to + __totbits for nails. + + * gmp-impl.h (JACOBI_LS0): Test size before limb, to pacify valgrind. + (JACOBI_0LS): Ditto, and fix parens around arguments. + + * mpn/x86/x86-defs.m4 (call_mcount): Add a counter to make data labels + unique, since simplified L() scheme no longer gives that effect. + (notl_or_xorl_GMP_NUMB_MASK): New macro. + Add m4_assert_numargs in a few places. + + * configure.in (*sparc*): Fix cycle counter setups for ABI=64. + +2002-02-28 Torbjorn Granlund + + * mpn/vax/gmp-mparam.h: New file. + +2002-02-28 Kevin Ryde + + * gmp-h.in (gmp_errno, gmp_version): Move into extern "C" block, + reported by librik@panix.com. + + * gmp-h.in, mp-h.in (__GMP_DECLSPEC_EXPORT, __GMP_DECLSPEC_IMPORT): + Use __declspec(dllexport) and __declspec(dllimport) on Borland. + * gmp-h.in (_GMP_H_HAVE_FILE): Test __STDIO_H for Borland. + Reported by "delta trinity". + + * gmp-impl.h (va_copy): Fall back on memcpy, not "=". + + * mpn/generic/pre_mod_1.c: Add a comment about obsolescence. + + * tune/time.c (MICROSECONDS_P): Don't trust time differences of 1 + microsecond. + + * tests/cxx/t-ostream.cc: Use "const char *" not just "char *" for + test data strings, avoids warnings on Sun CC. + +2002-02-27 Torbjorn Granlund + + * configure.in: For sparc under solaris2.[7-9], pass -fsimple=1 to + disable some crazy -fast optimizations. + +2002-02-25 Torbjorn Granlund + + * configure.in: For sparc under solaris2.[7-9], pass -fns=no to enable + denorm handling under -fast. + +2002-02-25 Kevin Ryde + + * configure.in (alpha*-*-*): Rearrange -mcpu selection for gcc, + provide an ev67 -> ev6 fallback. Fix -arch,-tune selection for DEC C. + Allow ~ for space in optional options lists. + + * tune/tuneup.c (tune_preinv_divrem_1): Compare against an assembler + mpn_divrem_1 if it exists, not the generic C mpn_divrem_1_div. + (tune_preinv_mod_1): Ditto with mpn_mod_1. + + * tune/time.c (DIFF_SECS_ROUTINE): Eliminate the unused "type" + parameter, try to make the code a bit clearer. + + * tune/freq.c: Reduce the period measured for cycles versus + gettimeofday, add cycles versus microsecond getrusage. + + * mpz/array_init.c: "i" should be mp_size_t, noticed by E. Khong. + +2002-02-24 Torbjorn Granlund + + * configure.in: For sparc under solaris2.[7-9], pass -fast instead of + other optimization options. + +2002-02-23 Kevin Ryde + + * mpn/asm-defs.m4 (GMP_NUMB_MASK): New macro. + (PROLOGUE, EPILOGUE): Relax quoting for the benefit of tune/many.pl + when GSYM_PREFIX non-empty. + + * tune/time.c, tune/speed.h (speed_time_init): Include clock tick + period in speed_time_string. + * tune/time.c, configure.in (clock_gettime): New measuring method. + + * tune/many.pl: Add -DHAVE_NATIVE_mpn_foo to C objects, to avoid + conflicts with a macro version in gmp-impl.h, eg. mpn_com_n. + +2002-02-22 Torbjorn Granlund + + * demos/pexpr.c: Increase RLIMIT_STACK to 4Mibyte. + +2002-02-22 Kevin Ryde + + * tune/tuneup.c: Don't confuse gcc with mipspro cc in diagnostic. + +2002-02-20 Torbjorn Granlund + + * configure.in (mips*-*-irix[6789]*]): Set `extra_functions_n32', not + `extra_functions'. + + * printf/doprnt.c: Conditionally include inttypes.h. + * printf/repl-vsnprintf.c: Likewise. + * scanf/doscan.c: Likewise. + +2002-02-20 Kevin Ryde + + * mpn/x86/k7/mmx/com_n.asm: New file. + + * mpz/n_pow_ui.c (SWAP_RP_TP): Use ASSERT_CODE on ralloc and talloc, + to ensure they needn't live past the initial allocs in a normal build. + + * mpn/generic/mod_34lsub1.c: Note this is for internal use. + +2002-02-19 Torbjorn Granlund + + * Clean up *_THRESHOLD names. Many files affected. + + * mpn/mips32: Asm-ify 32-bit mips code. + Move files from `mips2' to `mips32' directory. + * mpn/mips64: Move files from `mips3' to `mips64' directory. + * configure.in: Change `mips2' => `mips32' and `mips3' => `mips64'. + +2002-02-19 Kevin Ryde + + * acinclude.m4, configure.in (GMP_PROG_LEX): New macro. + + * tune/tuneup.c (one): Start next threshold at a max of previous ones, + in order to get a good starting point for TOOM3_SQR_THRESHOLD if + KARATSUBA_SQR_THRESHOLD is 0 (ie. using mpn_mul_basecase only). + + * configure.in, tune/tuneup.c (GMP_MPARAM_H_SUGGEST): New AC_DEFINE + replacing GMP_MPARAM_H_FILENAME. Suggest a new file in a cpu specific + subdirectory rather than mpn/generic. + + * acinclude.m4 (POWERPC64_PATTERN): New macro. + * configure.in (powerpc*-*-*): Use it. + (powerpc*-*-*): Use umul in 32L and aix64. + (mips*-*-*): Use umul, 32 and 64 bit versions. + +2002-02-18 Torbjorn Granlund + + * longlong.h: Add basic x86-64 support. + +2002-02-17 Torbjorn Granlund + + * demos/pexpr.c: Support `-X' for upper case hex, make `-x' output + lower case hex. + + * mpn/mips2/umul.s: Make it actually work. + * mpn/mips3/umul.asm: New file. + + * mpn/mips2/gmp-mparam.h: New file. + +2002-02-16 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_sb_get_str): Round frac upwards after + umul_ppmm calls. + +2002-02-16 Kevin Ryde + + * config.guess (alpha-*-*): Do alpha exact cpu probes on any system, + and only if configfsf.guess gives a plain "alpha". + + * acinclude.m4 (GMP_PROG_CC_WORKS): Detect a gcc 3.0.3 powerpc64 + linker invocation problem. + +2002-02-15 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_sb_get_str): For base 10, develop initial + digits using umul_ppmm, then switch to plain multiplication. + + * config.guess: Rewrite Alpha subtype detection code for *bsd systems. + +2002-02-15 Kevin Ryde + + * gmp.texi (Build Options): Note powerpc exact cpu types. + (Debugging): Advertise DEBUG in memory.c. + + * config.sub, config.guess: Add some powerpc exact cpus. + * configure.in: Add configs for them. + + * memory.c [__NeXT__]: Remove unused #define of "static". + (__gmp_default_allocate, __gmp_default_reallocate): Print size if + allocation fails, don't use perror. + + * gmp-h.in: g++ 3 demands __GMP_NOTHROW is before other attributes. + +2002-02-14 Torbjorn Granlund + + * mpn/alpha/mul_1.asm: Fix typo preventing build on T3E systems. + +2002-02-14 Kevin Ryde + + * tune/tuneup.c (tune_set_str): Increase max_size, for the benefit of + alpha. + + * macos/README: Bug reports to bug-gmp@gnu.org, clarify MacOS X a bit. + + * mpn/generic/gcdext.c [WANT_GCDEXT_ONE_STEP]: Add missing TMP_FREE. + + * tune/speed.c, tune/tuneup.c: Allow for speed_cycletime of 0.0 in + some diagnostic printouts. + * tune/time.c (speed_cycletime): Note can be 0.0. + +2002-02-12 Torbjorn Granlund + + * mpn/alpha/mul_1.asm: Add mpn_mul_1c entry. + + * mpn/pa64w/sqr_diagonal.asm: Use L() for labels. + +2002-02-11 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_sb_get_str): Change declaration of rp to + accommodate tuneup compiles. + +2002-02-11 Kevin Ryde + + * mpn/alpha/default.m4, mpn/alpha/unicos.m4 (PROLOGUE_cpu): Add + noalign option. + * mpn/alpha/default.m4 (PROLOGUE_cpu): use ALIGN instead of ".align". + + * gmp.texi (Debugging): Notes on Checker. + (Other Multiplication): Move note on float FFTs to here. + (Assembler Floating Point): New text and revisions by Torbjorn, + picture formatting by me. + Simplify tex pictures elsewhere a bit, share heights, eliminate some + gaps at line joins. + +2002-02-11 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_sb_get_str): Rewrite to generate fraction + limbs and use multiplication for digit development. Trim allocation of + buf. Get rid of code for !USE_MULTILIMB. + +2002-02-10 Torbjorn Granlund + + * mpn/generic/set_str.c (mpn_set_str): Undo this: + Change invocations of mpn_add_1 to instead use mpn_incr_u. + + * tests/mpz/convert.c: Free str only after it is used in error message. + + * mpn/generic/get_str.c (mpn_sb_get_str): Combine tail code for base 10 + and generic bases. + + * mpn/mp_bases.c: Add entries for base 256. Remove __ prefix from + table name. + * gmp-impl.h (__mp_bases): Remove superfluous mp_ part of name, making + it __gmpn_bases instead of __gmpn_mp_bases. + (mp_bases): New #define. + * tune/speed.h (SPEED_ROUTINE_MPN_SET_STR): Allow bases up to 256. + (SPEED_ROUTINE_MPN_GET_STR): Likewise. + +2002-02-09 Torbjorn Granlund + + * mpn/generic/set_str.c (mpn_set_str): Use mpn_mul_1c if available. + Change invocations of mpn_add_1 to instead use mpn_incr_u. + +2002-02-09 Kevin Ryde + + * mpz/array_init.c, mpz/cfdiv_q_2exp.c, mpz/cfdiv_r_2exp.c, + mpz/cong_2exp.c, mpz/divis_2exp.c, mpz/hamdist.c, mpz/init2.c, + mpz/mul_2exp.c, mpz/realloc2.c, mpz/scan0.c, mpz/scan1.c, + mpz/setbit.c, mpz/tdiv_q_2exp.c, mpz/tdiv_r_2exp.c, mpz/tstbit.c, + mpz/urandomb.c: Use GMP_NUMB_BITS. + + * mpz/iset_str.c [__CHECKER__]: Store a dummy value to the low limb to + stop it appearing uninitialized. + + * gmp-h.in (__GMP_NOTHROW): New macro. + (mp_set_memory_functions, mpz_cmp, mpz_cmp_si, mpz_cmp_ui, mpz_cmpabs, + mpz_cmpabs_ui, mpz_congruent_2exp_p, mpz_divisible_2exp_p, + mpz_fits_sint_p, mpz_fits_slong_p, mpz_fits_sshort_p, mpz_fits_uint_p, + mpz_fits_ulong_p, mpz_fits_ushort_p, mpz_get_si, mpz_get_ui, + mpz_getlimbn, mpz_hamdist, mpz_popcount, mpz_scan0, mpz_scan1, + mpz_size, mpz_sizeinbase, mpz_swap, mpz_tstbit, mpq_equal, mpq_swap, + mpf_cmp, mpf_cmp_si, mpf_cmp_ui, mpf_fits_sint_p, mpf_fits_slong_p, + mpf_fits_sshort_p, mpf_fits_uint_p, mpf_fits_ulong_p, + mpf_fits_ushort_p, mpf_get_default_prec, mpf_get_prec, mpf_get_si, + mpf_get_ui, mpf_integer_p, mpf_set_default_prec, mpf_set_prec_raw, + mpf_size, mpf_swap, mpn_add_1, mpn_cmp, mpn_hamdist, mpn_popcount, + mpn_sub_1): Use it. + + * gmp-impl.h (MPN_SIZEINBASE, MPN_SIZEINBASE_16): New macros from + mpn_sizeinbase, and use GMP_NUMB_BITS. + * mpz/get_str.c, mpz/sizeinbase.c, mpbsd/mout.c, tune/speed.h: Use + MPN_SIZEINBASE. + * mpbsd/mtox.c: Use MPN_SIZEINBASE_16. + + * configure.in, mpn/Makefile.am, gmp-impl.h (mpn_sizeinbase): Remove. + * mpn/generic/sizeinbase.c: Remove file. + + * gmp-impl.h (MPN_GET_STR_SIZE): Remove. + * tests/mpn/t-g_str_size.c: Remove file. + * tests/mpn/Makefile.am: Update. + + * Makefile.am (dist-hook): Don't distribute cvs merge ".#" files. + +2002-02-08 Torbjorn Granlund + + * configure.in: Override extra_functions for all sparcv8 systems, not + just supersparc. + +2002-02-06 Kevin Ryde + + * tune/tuneup.c (tune_mul, tune_sqr): Disable FFTs until tuned. + * tune/speed.h (SPEED_ROUTINE_MPN_SET_STR): Fix memory clobber in + destination cache priming. + + * printf/doprnt.c: Fix parsing of %s and %p conversions. + * tests/misc/t-printf.c (check_misc): Add some tests. + +2002-02-03 Torbjorn Granlund + + * mpn/sparc32/v8/udiv.asm: New file, from v8/supersparc. + + * mpn/generic/set_str.c: Rename indigits_per_limb => chars_per_limb. + Remove redundant chars_per_limb. Reverse 4 loops in basecase code for + speed. Use MP_BASES_CHARS_PER_LIMB_10. + +2002-02-03 Kevin Ryde + + * acinclude.m4 (GMP_PROG_NM): Ensure -B or -p get used when doing a + cross compile with the native nm, helps OSF for instance. + (GMP_ASM_LSYM_PREFIX): Remove ".byte 0" for the benefit of irix 6, + allow "N" from nm for OSF, allow for "t" for other systems, but prefer + no mention of the symbol at all. + + * tune/tuneup.c (print_define_remark): New function. + Turn some "#if"s into plain "if"s. + + * tune/tuneup.c, gmp-impl.h, tune/Makefile.am + (GET_STR_BASECASE_THRESHOLD, GET_STR_PRECOMPUTE_THRESHOLD): Tune these. + * mpn/generic/get_str.c [TUNE_PROGRAM_BUILD]: Cope with non-constant + GET_STR_PRECOMPUTE_THRESHOLD. + +2002-02-02 Torbjorn Granlund + + * mpn/generic/get_str.c (mpn_get_str): Fix typo in a declaration. + +2002-02-02 Kevin Ryde + + * mpn/generic/set_str.c: Use MP_PTR_SWAP and POW2_P, add __GMP_PROTO + to convert_blocks prototype, disable SET_STR_BLOCK_SIZE sanity check. + + * tune/set_strb.c, tune/set_strs.c: New files. + * tune/speed.h, tune/speed.c, tune/common.c,tune/Makefile.am: Add them. + * tune/tuneup.c: Tune SET_STR_THRESHOLD. + (DEFAULT_MAX_SIZE): Renamed from MAX_SIZE, allow any param.max_size[]. + +2002-02-01 Torbjorn Granlund + + * tests/mpz/convert.c: Increase operand size. Add (yet disabled) code + for testing with random strings. + + * mpn/generic/get_str.c (mpn_get_str): Rewrite to become sub-quadratic. + (mpn_dc_get_str, mpn_sb_get_str): New functions. + +2002-01-31 Kevin Ryde + + * gmpxx.h (cmp): Renamed from "compare". + + * configure.in (AC_C_BIGENDIAN): Don't abort when cross compiling. + (PROLOGUE): Allow new style optional second parameter when grepping. + + * acinclude.m4 (GMP_HPC_HPPA_2_0, GMP_ASM_UNDERSCORE, + GMP_ASM_ALIGN_LOG, GMP_ASM_LSYM_PREFIX, GMP_ASM_W32, GMP_ASM_X86_MMX): + Use $ac_objext for object filenames. + (GMP_ASM_UNDERSCORE): Use CCAS to assemble. + + * demos/pexpr-config-h.in: New file. + * configure.in: Generate demos/pexpr-config.h. + (AC_CHECK_FUNCS): Add clock, cputime, setrlimit, sigaction, + sigaltstack, sigstack. + * acinclude.m4 (GMP_SUBST_CHECK_FUNCS, GMP_SUBST_CHECK_HEADERS): New + macros. + * demos/pexpr.c: Use pexpr-config.h, not various #ifdefs. + (setup_error_handler): Use signal if sigaction not available, allow + for SIGBUS missing on mingw. + (main): Use time() for random seed if gettimeofday not available. + (cleanup_and_exit): Move SIGFPE out of LIMIT_RESOURCE_USAGE. + +2002-01-30 Torbjorn Granlund + + * mpn/generic/set_str.c: Rewrite to become sub-quadratic. + (convert_blocks): New function. + +2002-01-30 Kevin Ryde + + * gmp-impl.h (GMP_NUMB_MASK, GMP_NAIL_MASK, GMP_NUMB_HIGHBIT, + ASSERT_MPN, ASSERT_MP_LIMB_T): New macros. + + * mpn/generic/fib2_ui.c: Use GMP_NUMB_BITS, simplify the data + generator program, share __gmp_fib_table initializers between bit + sizes, cope with bit sizes other than those specifically setup. + * gmp-impl.h (FIB_TABLE_LIMIT, FIB_TABLE_LUCNUM_LIMIT): Corresponding + rearrangement of conditionals. + * tests/mpz/t-fib_ui.c (check_fib_table): New test. + +2002-01-28 Kevin Ryde + + * mpz/set_si.c, mpz/iset_si.c: Store to _mp_d[0] unconditionally, use + an expression for _mp_size. + + * mpz/init.c, mpz/init2.c, mpz/iset.c, mpq/init.c [__CHECKER__]: Store + dummy values to low limbs to stop them appearing uninitialized. + +2002-01-26 Kevin Ryde + + * mpfr/mpfr-test.h (MAX, MIN, ABS): Use instead a patch from Paul and + Vincent. + +2002-01-24 Kevin Ryde + + * configure.in: Extra quoting to get argument help messages right. + + * gmp.texi (Efficiency): Suggest hex or octal for input and output. + (Formatted Output Strings): Mention "*" for width and precision. + + * mpn/generic/sizeinbase.c: New file, adapted from mpz/sizeinbase.c. + Use POW2_P, use __mp_bases[base].big_base for log2(base). + * configure.in, mpn/Makefile.am: Add it. + * gmp-impl.h: Add prototype. + * mpz/sizeinbase.c, tune/speed.h, mpn/generic/get_str.c, + mpz/get_str.c, mpbsd/mout.c, mpbsd/mtox.c: Use it. + * mpz/get_str.c: Write directly to user buffer, skip at most one + leading zero, eliminate special case for x==0. + * mpbsd/mtox.c: Allocate exact result space at the start, eliminate + special case for x==0. + * mpbsd/mout.c: Only need to skip one high zero with mpn_sizeinbase. + + * configure.in (--enable-nails): New option. + (GMP_NAIL_BITS, GMP_LIMB_BITS, GMP_NUMB_BITS): New defines for gmp.h + and config.m4. + * gmp-h.in: Add templates. + + * mpfr/mpfr-test.h (MAX, MIN, ABS): Use #ifndef to avoid a redefine + error on AIX xlc. + +2002-01-23 Torbjorn Granlund + + * mpn/generic/get_str.c: Correct type of `out_len'. + +2002-01-22 Kevin Ryde + + * mpn/generic/pre_divrem_1.c: Corrections to some ASSERTs. + + * mpfr/mul_ui.c: Don't call mpn_lshift with 0 shift. + + * mpfr/mpz_set_fr.c: Produce correct mpz_t for f==0. + +2002-01-21 Torbjorn Granlund + + * longlong.h (32-bit powerpc add_ssaaaa): Remove spurious commutative + declaration. + (64-bit powerpc add_ssaaaa): Likewise. + +2002-01-20 Kevin Ryde + + * acinclude.m4 (GMP_FUNC_VSNPRINTF): Use %n to better detect sparc + solaris 2.7 problems. + +2002-01-19 Torbjorn Granlund + + * demos/pexpr.c (mpz_eval_expr): Optimize s^rhs for -1 <= s <= 1. + (cleanup_and_exit): Improve error message wording. + +2002-01-19 Kevin Ryde + + * mpfr/mpfr.h (_PROTO): Use __GMP_PROTO, for compatibility with + gmp-impl.h. + +2002-01-17 Torbjorn Granlund + + * mpfr/mpfr-test.h: Test "__hpux", not "hpux". Mask off mrand48 + return value to 31 bits to work around sloppy mpfr #include practices. + + * mpfr/tests/*.c: Use #include "", not <>, for gmp.h and mpfr.h. + Make sure to #include mpfr-test.h from all files that use random(). + +2002-01-17 Kevin Ryde + + * gmp-impl.h (__GMP_REALLOCATE_FUNC_MAYBE_TYPE): New macro. + * gmp-impl.h, mpz/get_str.c, mpz/out_raw.c, mpq/get_str.c, + mpq/set_str.c, mpf/get_str.c, printf/asprntffuns.c, printf/doprnt.c, + printf/repl-vsnprintf.c, printf/snprntffuns.c, scanf/doscan.c, + mpbsd/mtox.c: Some fixes to compile as C++. + + * mpn/generic/jacbase.c (JACOBI_BASE_METHOD): New tuned parameter, + replacing COUNT_TRAILING_ZEROS_TIME test. Add a third method too. + * tune/speed.c, tune/speed.h, tune/common.c, tune/Makefile.am: Add + measuring of mpn_jacobi_base methods. + * tune/jacbase1.c, tune/jacbase2.c, tune/jacbase3.c: New files. + * tune/tuneup.c (JACOBI_BASE_METHOD): Tune this. + * mpn/x86/*/gmp-mparam.h (COUNT_TRAILING_ZEROS_TIME): Remove macro. + + * gmp-h.in: Use __gmp prefix on variables in inlines. + + * gmp-impl.h (MPN_COPY_INCR, MPN_COPY_DECR): Remove __i, unused. + + * mpn/generic/mul_fft.c: Use HAVE_NATIVE_mpn_addsub_n, not ADDSUB. + Use CNST_LIMB for some constants. + +2002-01-15 Kevin Ryde + + * tests/mpbsd/Makefile.am: Add a convenience rule for ../libtests.la. + + * printf/Makefile.am: libdummy.la should be in EXTRA_LTLIBRARIES. + + * mpf/out_str.c: Use MPF_SIGNIFICANT_DIGITS, so mpf_out_str and + mpf_get_str give the same for ndigits==0. + + * mpfr/exceptions.c (mpfr_set_emin, mpfr_set_emax): Work around a + powerpc64 gcc 3.0 -O2 bug. + + * tests/memory.c, tests/tests.h (tests_memory_validate): New function. + +2002-01-14 Kevin Ryde + + * mpn/generic/sb_divrem_mn.c, mpn/generic/divrem_1.c, + mpn/generic/divrem_2.c, mpn/generic/mod_1.c: Don't use UMUL_TIME and + UDIV_TIME, just default to preinv. + * gmp-impl.h (USE_PREINV_DIVREM_1, USE_PREINV_MOD_1): Ditto. + (DIVEXACT_1_THRESHOLD, MODEXACT_1_ODD_THRESHOLD): Don't use UMUL_TIME + and UDIV_TIME, make default thresholds 0. + (UDIV_NORM_PREINV_TIME, UDIV_UNNORM_PREINV_TIME): Remove macros. + * mpn/x86/*/gmp-mparam.h (UMUL_TIME, UDIV_TIME, + UDIV_NORM_PREINV_TIME): Remove macros. + + * gmp.texi (Headers and Libraries): New section, being the header + notes from "GMP Basics" and some new stuff. + (Parameter Conventions): Notes on "const" parameters. + (Formatted Output Strings): Add type N, tweak some wording. + + * tests/refmpn.c (refmpn_divmod_1c): Avoid a bug in i386 gcc 3.0. + +2002-01-12 Kevin Ryde + + * mpz/root.c: Add , for abort(). + + * mpfr/tests/Makefile.am (AUTOMAKE_OPTIONS): Add ansi2knr. + * mpfr/mpfr.h, mpfr/mpfr-tests.h, reuse.c, tadd.c, tadd_ui.c, tagm.c, + tatan.c, tcmp2.c, tcos.c, tdiv.c, tdiv_ui.c, teq.c, texp.c, + tget_str.c, thyperbolic.c, tlog.c, tmul.c, tout_str.c, tpow.c, + trandom.c, tset_z.c, tsin.c, tsqrt.c, tsqrt_ui.c, tsub_ui.c, ttan.c, + tui_div.c: Fixes for K&R. + + * tests/misc/t-scanf.c (check_misc, check_misc): + + * tests/mpz/t-inp_str.c, tests/mpq/t-inp_str.c, tests/misc/t-scanf.c: + Avoid strings in ASSERT, not enjoyed by K&R. + * gmp-impl.h (ASSERT): Note this. + + * tests/tests.h (refmpn_mod_34lsub1): Add __GMP_PROTO. + + * mpbsd/Makefile.am: Avoid an automake problem with ansi2knr and + sources in a different directory. + + * printf/repl-vsnprintf.c: Test HAVE_LONG_DOUBLE for long double. + + * mpn/Makefile.am (nodist_libdummy_la_SOURCES): Add mod_34lsub1.c, + mul_2.c, pre_divrem_1.c. + + * gmp-h.in, gmp-impl.h (mpn_add_nc, mpn_addmul_1c, mpn_addsub_n, + mpn_addsub_nc, mpn_divrem_1c, mpn_dump, mpn_mod_1c, mpn_mul_1c, + mpn_mul_basecase, mpn_sqr_n, mpn_sqr_basecase, mpn_sub_nc, + mpn_submul_1c): Move to gmp-impl.h, since they're undocumented. + + * gmp-impl.h (mpn_reciprocal): Remove, unused. + + * tune/many.pl (cntlz, cnttz): Use new SPEED_ROUTINE_COUNT_ZEROS. + +2002-01-11 Kevin Ryde + + * mpn/hppa/*.asm, mpn/pa64/*.asm, mpn/pa64w/*.asm: Use L(). + +2002-01-08 Kevin Ryde + + * mpn/asm-defs.m4 (PROLOGUE, EPILOGUE): New scheme, optional function + name to EPILOGUE, check for missing or wrong function name EPILOGUE. + * mpn/alpha/unicos.m4, mpn/alpha/default.m4, mpn/m68k/m68k-defs.m4, + mpn/mips3/mips.m4, mpn/ia64/default.m4, mpn/powerpc32/aix.m4, + mpn/powerpc64/aix.m4, mpn/x86/x86-defs.m4: Consequent updates, add a + few more asserts. + * mpn/alpha/unicos.m4, mpn/alpha/default.m4, mpn/alpha/cntlz.asm, + mpn/alpha/invert_limb.asm (PROLOGUE_GP): Change to an optional "gp" + parameter on plain PROLOGUE. + + * gmp.texi (Low-level Functions): mpn_get_str doesn't clobber an extra + limb, and doesn't clobber at all for power of 2 bases. + (Language Bindings): Add python gmpy. + + * mpz/get_str.c: Determine realloc size arithmetically. + + * mpbsd/mtox.c: Size memory block returned to actual space needed. + * gmp.texi (BSD Compatible Functions): Describe this. + + * mpz/get_str.c: Don't copy mpn_get_str input for power of 2 bases. + * mpbsd/mtox.c: Ditto, and as a side effect avoid a memory leak from a + missing TMP_FREE. + + * mpz/get_str.c, mpbsd/mout.c: No longer need for +1 limb for + mpn_get_str clobber. + + * gmp-impl.h (MPN_GET_STR_SIZE): New macro. + * mpn/generic/get_str.c, mpz/get_str.c, mpbsd/mout.c, mpbsd/mtox.c, + tune/speed.h: Use it. + * tests/mpn/t-g_str_size.c: New test. + * tests/mpn/Makefile.am: Add it. + + * gmp-impl.h (POW2_P): New macro. + * mpn/generic/get_str.c, tests/misc.c: Use it. + + * printf/doprnt.c: Add "N" for mpn, share some code between N, Q and Z. + * tests/misc/t-printf.c: Add tests. + * gmp-impl.h (ASSERT_CODE): New macro. + + * tests/mpbsd/t-mtox.c: New test. + * tests/mpbsd/Makefile.am: Add it. + (allfuns_LDADD): Don't link against libgmp when testing everything in + libmp can link. + +2002-01-07 Torbjorn Granlund + + * gmp-impl.h (MPN_COPY_INCR, MPN_COPY_DECR): Rewrite generic versions. + +2002-01-06 Kevin Ryde + + * mpn/generic/pre_divrem_1.c: Don't support size==0. + * tests/devel/try.c: Update. + + * mpn/generic/get_str.c: Add special case for base==10. + * gmp-impl.h (MP_BASES_CHARS_PER_LIMB_10, MP_BASES_BIG_BASE_10, + MP_BASES_BIG_BASE_INVERTED_10, MP_BASES_NORMALIZATION_STEPS_10): New + constants. + * tests/t-constants.c: Add checks. + * mpn/mp_bases.c [GENERATE_TABLE]: Print defines for gmp-impl.h, print + all standard bits-per-limb by default. + + * demos/pexpr.c, demos/expr/expr.h, demos/expr/expr-impl.h: Use + __GMP_PROTO. + + * gmp-h.in (mpn_divexact_by3c): Remove variables from prototype, to + keep out of application namespace. + +2002-01-04 Torbjorn Granlund + + * gmp-impl.h: Move _PROTO declaration to before its first usages. + +2002-01-04 Kevin Ryde + + * gmp-h.in, mp-h.in, tests/tests.h: Rename _PROTO to __GMP_PROTO, and + don't use #ifndef just define it ourselves. + * gmp-impl.h: Provide _PROTO as an alias for __GMP_PROTO, to avoid big + edits internally, for the moment. + +2002-01-03 Torbjorn Granlund + + * tune/speed.c (usage): Insert "\n\" into a string. + +2001-12-30 Torbjorn Granlund + + * mpn/pa64/udiv_qrnnd.c: Remove file. + * mpn/pa64w/udiv_qrnnd.c: Remove file. + + * gmp-impl.h (MPN_IORD_U): Change formatting (labels in pos 0, insns + indented by tab). + (MPN_INCR_U): Use "addl $1,foo; jc", not "incl foo; jz". + + * gmp-impl.h (udiv_qrnnd_preinv): Use plain subtract, not sub_ddmmss, + in one more case. + +2001-12-30 Kevin Ryde + + * mpn/generic/get_str.c (udiv_qrnd_unnorm): New macro. + Use "do while" for dig_per_u loop since it's non-zero. + * acconfig.h (HAVE_HOST_CPU_m68k etc): Add templates. + + * mpn/generic/mul_basecase.c, mpz/mul.c, mpz/n_pow_ui.c, + mpn/x86/pentium/mul_2.asm, tests/devel/try.c, tests/tests.h, + tests/refmpn.c, tune/speed.c, tune/speed.h, tune/common.c, + tune/many.pl (mpn_mul_2): New parameter style. + * gmp-impl.h (mpn_mul_2): Add prototype. + * configure.in (gmp_mpn_functions_optional): Add mul_2. + + * longlong.h (__vxworks__): Remove from powerpc tests, not correct, + not on its own at least. + + * tune/speed.c: Add "aas" to specify 0xAA..AA data. + + * tune/tuneup.c (print_define_end): Indicate "never" and "always". + +2001-12-29 Torbjorn Granlund + + * mpq/set_d.c: ANSI-fy. + * mpz/invert.c: Use PTR and SIZ (cosmetic change). + + * mpz/cong.c: Rename `xor' to `sign' to avoid C++ reserved word. + +2001-12-28 Torbjorn Granlund + + * mpn/sparc64/sqr_diagonal.asm: New file. + +2001-12-28 Kevin Ryde + + * mpn/generic/get_str.c: Avoid one mpn_divrem_1 by running main loop + only until msize==1. + + * tune/tuneup.c: Break up all() for clarity. + (USE_PREINV_DIVREM_1, USE_PREINV_MOD_1): Compare against plain + division udiv_qrnnd, not the tuned and possibly preinv version. + + * tune/freq.c: Split sysctl and sysctlbyname probes into separate + functions, shorten some identifiers, put descriptions inside + functions, define functions unconditionally and do nothing if + requisites not available. + + * mpz/inp_raw.c: Avoid a gcc 3.0 powerpc64 bug on AIX. + + * acinclude.m4, configure.in (GMP_C_RESTRICT): New macro. + + * mpfr/sin.c: Patch from Paul to fix sign of sin(3pi/2). + + * demos/calc/calc.y: Improve some error messages. + +2001-12-28 Torbjorn Granlund + + * mpn/sparc64/mul_1.asm: Rename r72 -> r80. + * mpn/sparc64/addmul_1.asm: Likewise. + +2001-12-27 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Misc formatting cleanups. + For switch case 2, replace `dn' with its value (2). + +2001-12-25 Torbjorn Granlund + + * tests/devel/mul_1.c: Add FIXED_XLIMB. + * tests/devel/addmul_1.c: Likewise. + * tests/devel/submul_1.c: Likewise. + + * tests/devel/add_n.c: Improve error message. + Accept command line argument for # of tests. + * tests/devel/sub_n.c: Likewise. + + * tests/devel/: Remove CLOCK settings. + + * mpn/sparc32/v9/mul_1.asm: Rewrite. + * mpn/sparc32/v9/addmul_1.asm: Rewrite. + * mpn/sparc32/v9/submul_1.asm: Rewrite. + +2001-12-24 Torbjorn Granlund + + * mpn/sparc64/mul_1.asm: Get rid of global constant 0.0 (L(noll)). + * mpn/sparc64/addmul_1.asm: Likewise. + +2001-12-23 Torbjorn Granlund + + * mpn/generic/get_str.c: Move final ASSERT to just before zero fill + loop. + +2001-12-22 Torbjorn Granlund + + * mpn/generic/get_str.c: Move ASSERTs out of loops. Split digit + generation code into two loops, saving a test of msize in the loop. + +2001-12-22 Kevin Ryde + + * mpn/x86/x86-defs.m4, mpn/x86/*/*.asm: Remove L / LF scheme putting + function name in local labels. + + * mpn/generic/get_str.c: Use mpn_preinv_divrem_1, add a couple of + ASSERTs. + + * mpn/generic/pre_divrem_1.c: New file. + * configure.in (gmp_mpn_functions): Add it. + * gmp-impl.h (mpn_preinv_divrem_1): Add prototype. + (USE_PREINV_DIVREM_1, MPN_DIVREM_OR_PREINV_DIVREM_1): New macros. + * tests/devel/try.c, tune/speed.c, tune/speed.h, tune/common.c, + tune/many.pl, tune/Makefile.am (mpn_preinv_divrem_1): Add testing and + measuring. + * tune/tuneup.c: Determine USE_PREINV_DIVREM_1. + * tune/pre_divrem_1.c: New file. + * tests/refmpn.c, tests/tests.h (refmpn_preinv_divrem_1): New function. + + * tests/mpz/t-io_raw.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add it. + + * mpz/inp_raw.c, mpz/out_raw.c: Rewrite. + * acinclude.m4, configure.in (AC_C_BIGENDIAN): New test. + * gmp-impl.h (BSWAP_LIMB): New macro. + + * acinclude.m4 (GMP_PROG_CC_WORKS): For a native compile, demand + executables will run, per AC_PROG_CC. This detects ABI=64 is unusable + in a native sparc solaris 7 build with the kernel in 32-bit mode. + * gmp.texi (ABI and ISA): Add notes on this, add an example configure + setting an ABI. + + * tune/tuneup.c, configure.in: Print the gmp-mparam.h filename. + * tune/tuneup.c: Print the CPU frequency. + + * tune/time.c, tune/speed.h: Add s390 "stck" method, flatten + conditionals in speed_time_init a bit, use have_* variables to let + some code go dead in speed_starttime and speed_endtime. + + * tune/freq.c (speed_cpu_frequency_irix_hinv): New function. + + * Makefile.am, configure.in: Restore mpfr. + + * configure.in: Add --with-readline, AC_PROG_YACC and AM_PROG_LEX. + * demos/calc/calc.y, demos/calc/calclex.l: Add readline support, add + lucnum function. + * demos/calc/Makefile.am: Add calcread.c, calc-common.h, use $(YACC), + $(LEX) and $(LEXLIB). + * demos/calc/calcread.c, demos/calc/calc-common.h, + demos/calc/calc-config-h.in, demos/calc/README: New files. + + * configure.in: Put demos/expr configs in expr-config.h. + * demos/expr/expr-config-h.in: New file. + * demos/expr/expr-impl.h: Renamed from expr-impl-h.in, get configs + from expr-config.h. + * demos/expr/Makefile.am: Update. + + * demos/expr/exprfr.c: Use mpfr_sin and mpfr_cos, remove some spurious + returns. + +2001-12-20 Torbjorn Granlund + + * mpn/sparc64/mul_1.asm: Trim an instruction. + * mpn/sparc64/addmul_1.asm: Likewise. + + * mpn/ia64/add_n.asm: Rewrite. + * mpn/ia64/sub_n.asm: Rewrite. + +2001-12-19 Torbjorn Granlund + + * mpn/ia64/mul_1.asm: Rewrite. + * mpn/ia64/addmul_1.asm: Rewrite. + * mpn/ia64/submul_1.c: Use TMP_ALLOC_LIMBS. + + * tests/devel/mul_1.c: Improve error message. + Accept command line argument for # of tests. + * tests/devel/addmul_1.c: Likewise. + * tests/devel/submul_1.c: Likewise. + +2001-12-18 Torbjorn Granlund + + * mpn/mips3/mul_1.asm: Add NOPs to save a cycle on R1x000. + +2001-12-18 Kevin Ryde + + * gmpxx.h (gmp_randclass): Don't allow copy constructors or "=", + implementation by Gerardo. + + * gmp-h.in (operator<<, operator>>): Remove parameter names from + prototypes, to keep out of user namespace. + + * acinclude.m4 (GMP_FUNC_VSNPRINTF): Let the test program work as C++. + +2001-12-16 Torbjorn Granlund + + * mpn/sparc64/mul_1.asm: Rewrite. + * mpn/sparc64/addmul_1.asm: Rewrite. + * mpn/sparc64/submul_1.asm: Rewrite. + + * mpn/sparc64/addmul1h.asm: Remove. + * mpn/sparc64/submul1h.asm: Remove. + * mpn/sparc64/mul1h.asm: Remove. + +2001-12-15 Kevin Ryde + + * gmp-h.in (mpn_add, mpn_add_1, mpn_cmp, mpn_sub, mpn_sub_1): Follow + __GMP_INLINE_PROTOTYPES for whether to give prototype with inline. + + * configure.in (i686*-*-*, pentiumpro-*-*, pentium[23]-*-*, + athlon-*-*, pentium4-*-*): Fall back on -march=pentium if + -march=pentiumpro or higher is not good (eg. solaris cmov). + +2001-12-12 Torbjorn Granlund + + * gmp-impl.h (MPN_ZERO): Rewrite generic version to be similar to + powerpc version. + +2001-12-12 Kevin Ryde + + * acinclude.m4 (GMP_PROG_CC_WORKS): Detect cmov problems with gcc + -march=pentiumpro on solaris 2.8. + + * tune/common.c, tune/speed.h: Allow for commas in count_leading_zeros + and count_trailing_zeros macros. + + * demos/expr/Makefile.am: Distribute exprfr.c and exprfra.c. + + * tune/Makefile.am (speed_ext_SOURCES): Should be speed-ext.c. + +2001-12-10 Torbjorn Granlund + + * mpn/s390/addmul_1.asm: New file. + * mpn/s390/submul_1.asm: New file. + * mpn/s390/mul_1.asm: New file. + * mpn/s390/gmp-mparam.h: Update. + +2001-12-07 Kevin Ryde + + * gmp-h.in, mp-h.in, gmp-impl.h: __GMP_DECLSPEC at start of + prototypes, for the benefit of Microsoft C. + + * gmp.texi (Introduction to GMP): Mention ABI and ISA section. + (Known Build Problems): Recommend GNU sed on solaris 2.6. + (Assigning Integers): Direct feedback to bug-gmp. + (References): Typo Knuth vol 2 is from 1998. + + * gmpxx.h (gmp_randclass): Add initializers for gmp_randinit_default + and gmp_randinit_lc_2exp_size. + gmp.texi (C++ Interface Random Numbers): Describe them. + + * tests/misc/t-locale.c, tests/cxx/t-locale.cc: Ensure mpf_clear is + done when the localconv override doesn't work. Reported by Mike + Jetzer. + + * printf/doprnti.c: Don't showbase on a zero mpq denominator. + * tests/misc/t-printf.c, tests/cxx/t-ostream.c: Add test cases. + +2001-12-04 Kevin Ryde + + * gmp.texi (Known Build Problems): Update to gmp_randinit_lc_2exp_size + for the sparc solaris 2.7 problem. + (Reentrancy): SCO ctype.h affects all text-based input functions. + (Formatted Output Strings): Correction to the mpf example. + (Single Limb Division): Correction, should be q-1 not q+1. + (Extended GCD): Clarify why single-limb is inferior. + (Raw Output Internals): Clarify size is twos complement, note limb + order means _mp_d doesn't get directly read or written. + (Contributors): Clarify mpz_jacobi. + And a couple of formatting tweaks elsewhere. + + * tests/cxx/t-headers.cc: New file. + * tests/cxx/Makefile.am: Add it. + + * gmpxx.h: Add , needed by mpf_class::get_str2. + + * gmp-h.in (mpq_inp_str, mpn_hamdist): Add __GMP_DECLSPEC. + +2001-12-01 Torbjorn Granlund + + * Version 4.0 released. + + * mpfr/README: Replace contents with explanation of why mpfr is gone. + +2001-12-01 Kevin Ryde + + * Makefile.am, configure.in: Temporarily remove mpfr, just leave a + README. + + * mpn/Makefile.am (EXTRA_DIST): Add Makeasm.am. + +2001-11-30 Gerardo Ballabio + + * tests/cxx/t-constr.cc, tests/cxx/t-expr.cc: New files. + * tests/cxx/Makefile.am (check_PROGRAMS): Add them. + +2001-11-30 Kevin Ryde + + * mpfr: Update to 2001-11-16. Patch TMP handling of agm.c and sqrt.c, + use plain mpn_sqrtrem in sqrt.c, separate .c files for floor and ceil, + disable an expression style assert in add1.c. + + * mpn/s370: Rename to s390. + * configure.in (s3[6-9]0*-*-*): Update. + * mpn/Makefile.am (TARG_DIST): Add s390. + + * mpz/fits_s.c, mpf/fits_s.c, mpf/fits_u.c: Remove files, unused since + change to .h style. + +2001-11-29 Torbjorn Granlund + + * gmp-h.in: Declare mpz_get_d_2exp and mpf_get_d_2exp. + * Makefile.am: Add mpz/get_d_2exp$U.lo and mpf/get_d_2exp$U.lo. + * mpf/Makefile.am: Add get_d_2exp.c. + * mpz/Makefile.am: Add get_d_2exp.c. + +2001-11-29 Kevin Ryde + + * mpn/*/gmp-mparam.h: Update measured thresholds. + * mpn/s370/gmp-mparam.h: New file. + + * mpz/millerrabin.c: Mark for internal use only, for now. + * gmp.texi (Number Theoretic Functions): Remove documentation. + +2001-11-28 Torbjorn Granlund + + * mpf/get_d_2exp.c: New file. + * mpz/get_d_2exp.c: New file. + + * mpz/realloc2.c: Fix typo. Make more similar to mpz_realloc. + * mpz/realloc.c: Use __GMP_REALLOCATE_FUNC_LIMBS. + +2001-11-27 Gerardo Ballabio + + * gmpxx.h, mpfrxx.h: Various updates and improvements. + +2001-11-27 Kevin Ryde + + * gmp.texi (Useful Macros and Constants): Add gmp_version, add @findex + for mp_bits_per_limb. + + * demos/perl/GMP.pm, demos/perl/GMP.xs: Use new style gmp_randinit's. + * demos/perl/test.pl: Update for this, and for mpz_perfect_power_p + handling of 0 and 1. + +2001-11-26 Torbjorn Granlund + + * mpz/realloc.c: Clear variable when decreasing allocation to less than + needed. Misc updates. + +2001-11-25 Kevin Ryde + + * tests/misc/t-locale.c: Avoid printf in the normal case, since the + replacement localeconv breaks it on SunOS 4. + + * gmp.texi (Build Options, Notes for Package Builds): Note libgmpxx + depends on libgmp from same GMP version. + + * acinclude.m4, configure.in (GMP_FUNC_SSCANF_WRITABLE_INPUT): New + test. + * scanf/sscanf.c, scanf/vsscanf.c: Use it to ensure sscanf input is + writable, if necessary. + + * tests/misc/t-scanf.c: Ensure sscanf arguments are writable, always. + * configure.in (AC_CHECK_DECLS): Remove sscanf, no longer required. + + * configure.in (none-*-*): Fix default CFLAGS setups. + + * doc/configuration: Misc updates. + +2001-11-23 Kevin Ryde + + * mpz/init2.c, mpz/realloc2.c: New files. + * Makefile.am, mpz/Makefile.am: Add them. + * gmp-h.in: Add prototypes. + * gmp.texi (Efficiency): Mention these instead of _mpz_realloc. + (Initializing Integers): Add documentation, reword other parts. + +2001-11-22 Torbjorn Granlund + + * mpn/cray/ieee/addmul_1.c: Fix logic for more_carries scalar loop. + * mpn/cray/ieee/submul_1.c: Likewise. + +2001-11-20 Kevin Ryde + + * gmp.texi (Known Build Problems): Note an out of memory on DJGPP. + (Function Classes): Update function counts. + Misc tweaks elsewhere. + + * configure.in (AC_CHECK_DECLS): Add sscanf. + * tests/misc/t-scanf.c: Use it, for the benefit of SunOS 4. + + * tal-debug.c, gmp-impl.h: More checks of TMP_DECL/TMP_MARK/TMP_FREE + consistency. + + * mpfr/Makefile.am (AR): Explicit AR=@AR@ to override automake + default, necessary for powerpc64 ABI=aix64. + +2001-11-18 Torbjorn Granlund + + * mpz/powm.c: Move TMP_MARK to before any TMP_ALLOCs. + +2001-11-18 Kevin Ryde + + * configure.in (--enable-fft): Make this the default. + * gmp.texi (Build Options): Update. + + * Makefile.am (libmp_la_DEPENDENCIES): Revise mpz objects needed by + new mpz/powm.c. + + * gmp.texi (Random State Initialization): Add gmp_randinit_default and + gmp_randinit_lc_2exp_size, mark gmp_randinit as obsolete. + (Random State Seeding): New section, taken from "Random State + Initialization" and "Random Number Functions". + + * configure.in (AC_CHECK_DECLS): Add fgetc, fscanf, ungetc. + * scanf/fscanffuns.c: Use these, for the benefit of SunOS 4. + + * gmp-impl.h, gmp-h.in (__gmp_default_fp_limb_precision): Move back to + gmp-impl.h now not required for inlined mpf. + + * randlc2s.c (gmp_randinit_lc_2exp_size): New file, the size-based LC + selection from rand.c. + * rand.c (gmp_randinit): Use it. + * randdef.c (gmp_randinit_default): New file. + * gmp-impl.h (RANDS): Use it. + (ASSERT_CARRY): New macro. + * gmp-h.in (gmp_randinit_default, gmp_randinit_lc_2exp_size: Add + prototypes. + * Makefile.am (libgmp_la_SOURCES): Add randdef.c and randlc2s.c. + + * printf/asprntffuns.c: Include config.h before using its defines. + + * gmp-impl.h: Move C++ to top of file to avoid the memset + redefine upsetting configure tests. Remove since + in gmp.h suffices. + +2001-11-16 Kevin Ryde + + * gmp.texi (Integer Exponentiation): mpz_powm supports negative + exponents. + (Assigning Floats, I/O of Floats, C++ Formatted Output, C++ Formatted + Input): Decimal point follows locale. + (Formatted Output Strings): %n accepts any type. + (Formatted Input Strings): New section. + (Formatted Input Functions): New section. + (C++ Class Interface): Corrections and clarifications suggested by + Gerardo. + + * scanf/doscan.c, scanf/fscanf.c, scanf/fscanffuns.c, scanf/scanf.c, + scanf/sscanf.c, scanf/sscanffuns.c, scanf/vfscanf.c, scanf/vscanf.c, + scanf/vsscanf.c, scanf/Makefile.am, tests/misc/t-scanf.c: New files. + * gmp-h.in, gmp-impl.h, Makefile.am, configure.in: Consequent + additions. + + * tests/misc: New directory. + * tests/misc/Makefile.am: New file. + * tests/misc/t-locale.c: New file. + * tests/misc/t-printf.c: Moved from tests/printf. + * tests/printf: Remove directory. + * configure.in, tests/Makefile.am: Update. + + * tests/cxx/t-locale.cc: New file. + * tests/cxx/Makefile.am: Add it. + + * mpf/set_str.c, cxx/ismpf.cc: Use localeconv for the decimal point. + + * acinclude.m4 (GMP_ASM_X86_MCOUNT): Update to $lt_prog_compiler_pic + for current libtool, recognise non-PIC style mcount in windows DLLs. + + * gmp-impl.h (__gmp_replacement_vsnprintf): Add prototype. + + * gmp-impl.h (__gmp_rands, __gmp_rands_initialized, + modlimb_invert_table): Add __GMP_DECLSPEC for the benefit of test + programs using them from a windows DLL. + * longlong.h (__clz_tab): Ditto. + + * mpn/x86/t-zdisp2.pl: New file. + + * mpn/x86/pentium4/README: New file. + +2001-11-15 Torbjorn Granlund + + * mpz/powm.c (HANDLE_NEGATIVE_EXPONENT): #define to 1. + * tests/mpz/reuse.c (main): Use mpz_invert to avoid undefined mpz_powm + cases. + +2001-11-14 Torbjorn Granlund + + * mpz/powm_ui.c: Rewrite along the lines of mpz/powm.c (except still no + redc). + * mpz/powm.c: Adjust for negative b, after exponentiation done. Add + (still disabled) code for handling negative exponents. Misc cleanups. + +2001-11-14 Kevin Ryde + + * mpf/out_str.c: Use localeconv for the decimal point. + + * tests/misc.c (tests_rand_end): Use time() if gettimeofday() not + available (eg. on mingw). + +2001-11-11 Kevin Ryde + + * gmp-h.in: Remove parameter names from prototypes, to keep out of + application namespace. + +2001-11-08 Kevin Ryde + + * acinclude.m4 (GMP_GCC_VERSION_GE): Fix sed regexps to work on + Solaris 8. + + * printf/doprnt.c: Support %n of all types, per glibc. + + * gmp-h.in, gmp-impl.h, mpf/abs.c, mpf/neg.c, mpf/get_prc.c, + mpf/get_dfl_prec.c, mpf/set_dfl_prec.c, mpf/set_prc_raw.c, + mpf/set_si.c, mpf/set_ui.c, mpf/size.c: Revert mpf inlining, in order + to leave open the possibility of keeping binary compatibility if mpf + becomes mpfr. + + * mpn/x86/k7/mmx/lshift.asm, mpn/x86/k7/mmx/rshift.asm: Use Zdisp to + force code size for computed jumps. + * mpn/x86/k6/mod_34lsub1.asm, mpn/x86/k6/k62mmx/copyd.asm: Use Zdisp + to force good code alignment. + * mpn/x86/x86-defs.m4 (Zdisp): More instructions. + + * mpn/x86/pentium/sqr_basecase.asm, mpn/x86/k7/mmx/mod_1.asm, + mpn/x86/k7/mmx/popham.asm: Remove some unnecessary "0" address offsets. + + * mpq/set_si.c, mpq/set_ui.c: Set _mp_den._mp_size correctly if den==0. + +2001-11-07 Torbjorn Granlund + + * mpn/hppa/hppa1_1/udiv_qrnnd.asm: Work around gas bug. + + * mpn/asm-defs.m4 (PROLOGUE): Change alignment to 8 (probably a good + idea in general; required for hppa/hppa1_1/udiv_qrnnd.asm). + +2001-11-06 Torbjorn Granlund + + * gmp-impl.h (MPN_COPY_INCR): Prepend local variable by `__'. + (MPN_COPY_DECR): Likewise. + +2001-11-05 Torbjorn Granlund + + * mpz/powm.c: Call mpn functions, not mpz functions, for computation + mod m. Streamline allocations to use a mixture of stack allocation and + heap allocation. Add currently disabled phi(m) exponent reduction + code. Misc optimizations and cleanups. + +2001-11-05 Kevin Ryde + + * mpq/inp_str.c: Remove unused variable "ret". + + * mpn/x86/k7/sqr_basecase.asm: Fix a 0(%edi) to use Zdisp, so the + computed jumps hit the right spot on old gas. + + * mpq/canonicalize.c: DIVIDE_BY_ZERO if denominator is zero. + + * mpn/lisp/gmpasm-mode.el (comment-start-skip): Correction to the way + the first \( \) pair is setup. + (gmpasm-font-lock-keywords): Don't fontify the space before a "#" etc. + Misc tweaks to some comments. + +2001-11-03 Torbjorn Granlund + + * tests/refmpn.c (refmpn_overlap_p): Reverse return values. + +2001-11-02 Kevin Ryde + + * tune/many.pl: Setup CFLAGS_PIC and ASMFLAGS_PIC, since that's no + longer done by configure. + + * mpn/x86/pentium4/mmx/popham.asm: New file. + + * mpn/x86/x86-defs.m4 (psadbw): New macro. + * mpn/x86/k7/mmx/popham.asm: Use it. + + * tests/refmpn.c (refmpn_overlap_p): New function, independent of + MPN_OVERLAP_P. + +2001-10-31 Torbjorn Granlund + + * tests/mpz/t-powm.c: Print proper error message when finding + discrepancy. + +2001-10-31 Kevin Ryde + + * mpn/x86/pentium/mod_34lsub1.asm: New file. + * mpn/x86/k7/mod_34lsub1.asm: New file. + * mpn/x86/mod_34lsub1.asm: New file. + +2001-10-30 Kevin Ryde + + * tests/printf/t-printf.c (check_misc): Add checks from the glibc docs. + (check_vasprintf, check_vsnprintf): Run these unconditionally. + + * gmp-impl.h (ASSERT_MPQ_CANONICAL): New macro. + * mpq/cmp.c, mpq/cmp_si.c, mpq/cmp_ui.c, mpq/equal.c: Add ASSERTs for + canonical inputs, where correctness depends on it. + + * mpn/lisp/gmpasm-mode.el (comment-start-skip): Add "dnl". + +2001-10-27 Torbjorn Granlund + + * demos/pexpr.c: Remove some unused variables. + (main): Allocate more buffer space to accommodate minus sign. + +2001-10-27 Kevin Ryde + + * gmp-impl.h, mpn/asm-defs.m4, configure.in, tune/speed.h, + tune/speed.c, tune/common.c, tune/many.pl, tests/devel/try.c: Add + mpn_mod_34lsub1. + * tests/refmpn.c, tests/tests.h (refmpn_mod_34lsub1): New function. + + * mpn/generic/mod_34lsub1.c: New file. + * mpn/x86/k6/mod_34lsub1.asm: New file. + * mpn/x86/pentium4/sse2/mod_34lsub1.asm: New file. + * mpn/x86/x86-defs.m4 (Zdisp): Add another instruction. + + * gmp-h.in, gmpxx.h: Use not whole . + + * gmp.texi (Known Build Problems): Add note on test programs with + Windows DLLs. + +2001-10-26 Kevin Ryde + + * tests/mpq/t-get_d.c: Limit the size of "eps" for vax. + + * gmp.texi (maybepagebreak): New macro, use it in a few places. + (Notes for Particular Systems): C++ Windows DLLs are not supported. + (Known Build Problems): Note sparc solaris 2.7 gcc 2.95.2 shared + library problems. + (Autoconf): Tweak version numbers shown. + (Integer Roots): mpz_perfect_square_p and mpz_perfect_power_p consider + 0 and 1 perfect powers, mpz_perfect_power_p accepts negatives. + (Number Theoretic Functions): Add mpz_millerrabin, combined with a + reworded mpz_probab_prime_p. + (Formatted Output Strings): Misc clarifications. + (Formatted Output Functions): gmp_asprintf, gmp_vasprintf, + gmp_snprintf, gmp_vsnprintf always available. + (C++ Formatted Output): Misc rewordings. + (Formatted Input): New chapter. + (C++ Class Interface): New chapter, by Gerardo and me. + (Language Bindings): Update GMP++ now in GMP. + (C++ Interface Internals): New section, by Gerardo and me. + + * printf/repl-vsnprintf.c: New file. + * configure.in, acinclude.m4, Makefile.am, printf/Makefile.am: Use it + if libc vsnprintf missing or bad. + * configure.in (AC_CHECK_FUNCS): Add strnlen. + + * printf/snprntffuns.c, printf/vasprintf.c: Use + __gmp_replacement_vsnprintf if libc vsnprintf not available. + * printf/asprintf.c, printf/snprintf.c, printf/vasprintf.c, + printf/vsnprintf.c: Provide these functions unconditionally. + * acinclude.m4 (GMP_FUNC_VSNPRINTF): Remove warning about omissions + when vsnprintf not available. + +2001-10-24 Kevin Ryde + + * configure, aclocal.m4: Regenerate with a libtool patch for a stray + quote in AC_LIBTOOL_PROG_LD_SHLIBS under mingw and cygwin. + + * gmp-impl.h (modlimb_invert): More comments. + + * printf/doprnt.c, printf/doprnti.c: Use the precision field to print + leading zeros. + * tests/printf/t-printf.c: Test this. + * cxx/osdoprnti.cc, gmp-impl.h: Ignore precision in operator<<. + + * tune/speed.c, tune/speed.h, tune/common.c: Add mpn_mul_1_inplace. + +2001-10-23 Torbjorn Granlund + + * mpz/pprime_p.c (mpz_millerrabin): Remove function and its descendant. + + * mpz/millerrabin.c: New file with code from pprime.c. + * mpz/Makefile.am: Compile millerrabin.c. + * Makefile.am (MPZ_OBJECTS): Ditto. + * gmp-h.in: Declare mpz_millerrabin. + +2001-10-22 Torbjorn Granlund + + * tests/mpz/t-perfsqr.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add it. + + * demos/factorize.c (factor): Check for number to factor == 0. + (main): When invoked without arguments, read from stdin. + + * mpz/perfpow.c: Add code to handle negative perfect powers ((-b)^odd). + Treat 0 and 1 as perfect powers. + + * mpn/sparc32/v9/sqr_diagonal.asm: Jump past .align. + +2001-10-21 Torbjorn Granlund + + * mpn/generic/perfsqr.c (sq_res_0x100): Remove bogus final `,'. + (mpn_perfect_square_p): Suppress superfluous `&1' in sq_res_0x100 test. + (mpn_perfect_square_p, O(n) test): Improve comments. Combine remainder + tests for some small primes. Don't share code for different limb + sizes. Use single `if' with many `||' for better code density. + +2001-10-22 Kevin Ryde + + * demos/perl/GMP.xs (mutate_mpz, tmp_mpf_grow): Make these "static". + + * mpn/x86/pentium/popcount.asm, mpn/x86/pentium/hamdist.asm + (mpn_popcount_table): Use GSYM_PREFIX. + +2001-10-19 Kevin Ryde + + * mpn/x86/*.asm: Add some measured speeds on various x86s. + + * tests/mpz/reuse.c, tests/mpf/reuse.c: Disable tests when using a + windows DLL, because certain global variable usages won't compile. + + * configure.in (AC_CHECK_FUNCS): Add alarm. + * tests/spinner.c: Conditionalize alarm and SIGALRM availability, for + the benefit of mingw32. + + * acinclude.m4 (GMP_ASM_TYPE, GMP_ASM_SIZE): Suppress .type and .size + on COFF. + + * acinclude.m4 (GMP_PROG_HOST_CC): New macro. + * configure.in: Use it for windows DLL cross-compiles. + * aclocal.m4, configure: Regenerate with libtool patch to hold HOST_CC + in the generated libtool script. + + * aclocal.m4, configure: Regenerate with libtool patch to suppress + warnings when probing command line limit on FreeBSD. + + * demos/qcn.c (M_PI): Define if not already provided, helps mingw32. + +2001-10-17 Kevin Ryde + + * printf/doprnt.c: Use for intmax_t. + + * longlong.h: Recognise __sparcv8 for gcc on Solaris. Reported by + Mark Mentovai . + + * gmp-impl.h (gmp_allocated_string): No need for inline on member funs. + +2001-10-16 Kevin Ryde + + * gmp.texi (Debugging): Add mpatrol. + (Integer Comparisons, Comparing Rationals, Float Comparison): Index + entries for sign tests. + (I/O of Floats): Clarify mpf_out_str exponent is in decimal. + (C++ Formatted Output): mpf_t operator<< exponent now in decimal. + (FFT Multiplication): Use an ascii art sigma. + (Contributors): Add Gerardo Ballabio. + + * cxx/osfuns.cc (__gmp_doprnt_params_from_ios): Always give mpf_t + exponent in decimal, irrespective of ios::hex or ios::oct. + * tests/cxx/t-ostream.cc (check_mpf): Update. + + * printf/doprnt.c: Support %lln and %hhn. + + * mpn/x86/pentium4/sse2/submul_1.asm: Use a psubq to negate the + initial carry (helps the submul_1c case), and improve the comments. + +2001-10-11 Kevin Ryde + + * acinclude.m4, configure.in (GMP_IMPL_H_IEEE_FLOATS): New macro. + + * ltmain.sh: Send some rm errors to /dev/null, helps during compiles + on Solaris 2.7 and HP-UX 10. + + * tal-notreent.c: Renamed from stack-alloc.c. + * Makefile.am, acinclude.m4, gmp-impl.h: Update. + + * gmp-h.in: Don't give both prototypes and inlines, except on gcc. + + * gmp-h.in, gmp-impl.h: Use #includes to get necessary standard + classes, add std:: to prototypes. + * cxx/*.cc, tests/cxx/t-ostream.cc: Add "use namespace std". + * acinclude.m4 (GMP_PROG_CXX_WORKS): Ditto. + + * tests/*/Makefile.in, mpfr/tests/Makefile.in: Regenerate with + automake patch to avoid Ultrix problem with empty $(TESTS). + + * */Makefile.in: Regenerate with automake patch to only rm *_.c in + "make clean" when ansi2knr actually in use, helps DOS 8.3. + + * Makefile.in: Regenerate with automake patch to fix stamp-h + numbering, avoiding an unnecessary config.status run. + +2001-10-09 Torbjorn Granlund + + * mpn/hppa/hppa1_1/udiv_qrnnd.asm: Use L macros for labels. + Quote L reloc operator. + + * gmp-impl.h: Declare class string. + + * mpn/asm-defs.m4 (INT32, INT64): Quote $1 to prevent further + expansion. + + * mpn/alpha/ev6/mul_1.asm: New file. + +2001-10-09 Kevin Ryde + + * gmp.texi (Introduction to GMP): Add pentium 4 to optimized CPUs. + (Build Options): Note macos directory. + (Notes for Package Builds): GMP 4 series binary compatible with 3. + (Known Build Problems): Remove $* and ansi2knr note, now fixed, except + possibly under --host=none. + (Formatted Output Strings): Remove -1 prec for all digits. + + * mpz/add.c, mpz/sub.c: Don't use mpz path on #include (helps macos). + * mpbsd/Makefile.am (INCLUDES): Add -I$(top_srcdir)/mpz. + + * printf/doprnt.c, tests/printf/t-printf.c: Remove support for %.*Fe + prec -1 meaning all digits. + + * acinclude.m4 (GMP_PROG_AR): Override libtool, use AR_FLAGS="cq". + (GMP_HPC_HPPA_2_0): Print version string to config.log. + + * Makefile.am (AUTOMAKE_OPTIONS): Remove check-news (permission notice + in NEWS file is too big). + (dist-hook): Don't distribute numbered or unnumbered emacs backups. + + * Makefile.am, cxx/Makefile.am: Updates for Gerardo's stuff. + +2001-10-09 Gerardo Ballabio + + * cxx/isfuns.cc: New file. + * gmp-impl.h: Add prototypes. + * cxx/ismpf.cc, cxx/ismpq.cc, cxx/ismpz.cc: New files. + * gmp-h.in: Add prototypes. + * gmpxx.h, mpfrxx.h: New files. + +2001-10-08 Kevin Ryde + + * configure.in (with_tags): Establish a default based on --enable-cxx. + + * aclocal.m4: Regenerate with libtool patches for sed char range to + help Cray, LTCC quotes and +Z warnings grep to help HP-UX. + + * gmp-impl.h (doprnt_format_t, doprnt_memory_t, doprnt_reps_t, + doprnt_final_t): Use _PROTO. + +2001-10-05 Torbjorn Granlund + + * mpn/asm-defs.m4 (INT32, INT64): Use LABEL_SUFFIX. + + * mpn/hppa: Convert files to `.asm'. + +2001-10-05 Kevin Ryde + + * mpn/Makeasm.am (.S files): Revert to separate CPP and CCAS, use + cpp-ccas, and only pass CPPFLAGS to CPP, not whole CFLAGS. + * mpn/cpp-ccas: New file. + * mpn/Makefile.am (EXTRA_DIST): Add it. + + * tune/common.c, tune/speed.h: Change SPEED_ROUTINE_MPN_COPY_CALL uses + to SPEED_ROUTINE_MPN_COPY or new SPEED_ROUTINE_MPN_COPY_BYTES. Avoids + macro expansion problems on Cray. + + * configure.in (AC_PROG_CXXCPP): Add this, to make libtool happier. + +2001-10-04 Torbjorn Granlund + + * mpz/rrandomb.c (gmp_rrandomb): Change bit_pos to be 0-based (was + 1-based); shift 2 (was 1) when making bit mask. These two changes + avoid undefined shift counts. + (gmp_rrandomb): Avoid most calls to _gmp_rand by caching random values. + + * mpn/generic/random2.c: Changes for mirroring mpz/rrandomb.c. + +2001-10-04 Kevin Ryde + + * gmp.texi (Build Options): Add --enable-cxx. + (Notes for Particular Systems): Mention pentium4 performance and SSE2. + (Known Build Problems): Remove vax jsobgtr note, no longer needed. + (Converting Floats): Tweak mpf_get_str description. + (Low-level Functions): Correction to mpn_gcdext destination space + requirements. + (C++ Formatted Output): New section. + (Language Bindings): Add ALP + (Contributors): Add Paul Zimmermann's square root, update my things. + + * acinclude.m4 (GMP_PROG_CC_IS_GNU, GMP_PROG_CXX_WORKS): Send compiler + errors to config.log. + + * mpq/Makefile.am (INCLUDES): Remove -DOPERATION_$*, not needed. + + * mpn/x86/*.asm: Change references to old README.family to just README. + + * mpz/README: Remove file, now adequately covered in the manual. + +2001-10-03 Torbjorn Granlund + + * mpn/x86/pentium4/copyi.asm: New file. + * mpn/x86/pentium4/copyd.asm: New file. + + * gmp-impl.h: Implement separate MPN_COPY_INCR and MPN_COPY_DECR + macros for CRAY systems. + (CRAY _MPN_COPY): Delete. + +2001-10-02 Kevin Ryde + + * tests/mpz/t-popcount.c (check_data): Use "~ (unsigned long) 0" to + avoid compiler warnings on sco. + + * mpbsd/Makefile.am: Compile mpz files directly, no copying. + Use mpz/add.c and mpz/sub.c rather than mpz/aors.c. + (INCLUDES): Remove -DOPERATION_$*, no longer needed (by mpz). + + * mpz/aors.h: Renamed from mpz/aors.c. + * mpz/add.c, mpz/sub.c: New files, using mpz/aors.h. + * mpz/aors_ui.h: Renamed from mpz/aors_ui.c. + * mpz/add_ui.c, mpz/sub_ui.c: New files, using mpz/aors_ui.h. + * mpz/fits_s.h: Renamed and adapted from mpz/fits_s.c. + * mpz/fits_sshort.c, mpz/fits_sint.c, mpz/fits_slong.c: New files. + * mpz/mul_i.h: Renamed from mpz/mul_siui.c. + * mpz/mul_ui.c, mpz/mul_ui.c: New files, using mpz/mul_i.h. + * mpz/Makefile.am: Consequent updates. + (INCLUDES): Remove -DOPERATION_$*. + + * mpf/fits_s.h: Renamed and adapted from mpf/fits_s.c. + * mpf/fits_sshort.c, mpf/fits_sint.c, mpf/fits_slong.c: New files. + * mpf/fits_u.h: Renamed and adapted from mpf/fits_u.c. + * mpf/fits_ushort.c, mpf/fits_uint.c, mpf/fits_ulong.c: New files. + * mpf/Makefile.am: Consequent updates. + (INCLUDES): Remove -DOPERATION_$*. + + * cxx/osfuns.cc (__gmp_doprnt_params_from_ios): Don't use ios::hex etc + as cases in a switch, they're not constant in g++ 3.0. + + * mpn/Makeasm.am (.s.o, .s.obj, .S.o, .S.obj, .asm.o, .asm.obj): + Locate source file with test -f the same as automake. + (.S): Let CCAS do the preprocessing, and run libtool for .S.lo. + (.asm.lo): Run libtool via m4-ccas to get new style foo.lo right. + (COMPILE_FLAGS): Add $(DEFAULT_INCLUDES), per new automake. + * mpn/m4-ccas: New file. + * mpn/Makefile.am (EXTRA_DIST): Add it. + * mpn/asm-defs.m4: Add m4_not_for_expansion(`DLL_EXPORT'). + * mpn/x86/x86-defs.m4: Undefine PIC if DLL_EXPORT is set. + * configure.in (CFLAGS_PIC, ASMFLAGS_PIC): Remove, no longer needed. + + * acinclude.m4 (GMP_FUNC_VSNPRINTF): Warn what's omitted when + vsnprintf not available. + + * mpn/underscore.h: Remove file, not used since m68k converted to asm. + * mpn/Makefile.am (EXTRA_DIST): Remove it. + + * tests/refmpz.c: Add , for free(). + +2001-10-01 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/submul_1.asm: Apply some algebraic + simplifications. + * mpn/x86/pentium4/sse2/addmul_1.asm: Comment. + +2001-10-01 Kevin Ryde + + * configure.in (--enable-cxx): New option for C++ support. + Add cxx and tests/cxx subdirectories. + * ltmain.sh, aclocal.m4: Update to libtool 2001-09-30. + + * cxx/Makefile.am, cxx/Makefile.in, cxx/osdoprnti.cc, cxx/osfuns.cc, + cxx/osmpf.cc, cxx/osmpq.cc, cxx/osmpz.cc: New files. + * Makefile.am: Add them, in new libgmpxx. + * gmp-h.in, gmp-impl.h: Prototypes and support. + * tests/cxx/Makefile.am, tests/cxx/Makefile.in, + tests/cxx/t-ostream.cc: New files. + + * tune/speed.h (SPEED_ROUTINE_MPN_GCD_CALL, + SPEED_ROUTINE_MPN_GCDEXT_ONE): mpn_gcdext needs size+1 for + destinations. Found by Torbjorn. + + * gmp-h.in (__GNU_MP__, __GNU_MP_VERSION): Bump to 4.0. + * mp-h.in (__GNU_MP__): Ditto. + * gmp.texi, Makefile.am, compat.c: Amend version 3.2 to 4.0. + + * acinclude.m4 (GMP_PROG_CXX_WORKS): New macro. + (GMP_PROG_CC_WORKS): Write "conftest" test program, not a.out. + + * gmp-impl.h (struct gmp_asprintf_t): Moved from printf/vasprintf.c. + (GMP_ASPRINTF_T_INIT): New macro. + (GMP_ASPRINTF_T_NEED): New macro, adapted from vasprintf.c NEED(). + * printf/vasprintf.c: Use these. + + * printf/asprntffuns.c: New file. + * printf/Makefile.am, Makefile.am: Add it. + * printf/asprntffuns.c, printf/vasprintf.c, gmp-impl.h + (__gmp_asprintf_memory, __gmp_asprintf_reps, __gmp_asprintf_final): + Move to asprntffuns.c, rename to __gmp and make global, remove + spurious formal parameters from __gmp_asprintf_final. + + * configure.in (j90-*-*, sv1-*-*): Don't duplicate $path in $add_path. + (*-*-mingw*): Don't assemble with -DPIC (as per cygwin). + + * printf/snprntffuns.c (gmp_snprintf_final): Remove spurious formal + parameters. + + * tune/tuneup.c (POWM_THRESHOLD): Reduce stop_factor to 1.1 to help + Cray vector systems. + + * tests/misc.c (tests_rand_start): Print GMP_CHECK_RANDOMIZE=NN to + facilitate cut and paste when re-running. + * tests/mpz/t-inp_str.c (check_data): Add more diagnostic prints. + +2001-09-30 Kent Boortz + + * macos/configure, macos/Makefile.in, macos/README: Updates for gmp 4. + * gmp-h.in (_GMP_H_HAVE_FILE): Recognise Apple MPW. + +2001-09-30 Torbjorn Granlund + + * mpn/cray/ieee/submul_1.c: Rewrite. Streamline multiplications; + use `majority' logic. + +2001-09-27 Torbjorn Granlund + + * gmp-h.in (__GMPN_AORS_1): Rewrite to work around Cray compiler bug. + +2001-09-26 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/gmp-mparam.h: New file. + +2001-09-26 Kevin Ryde + + * mpn/x86/pentium4/sse2/dive_1.asm: New file. + * mpn/x86/pentium4/sse2/submul_1.asm: New file. + * mpn/x86/pentium4/sse2/sqr_basecase.asm: New file. + + * mpn/x86/pentium/copyi.asm: New file, based on past work by Torbjorn. + * mpn/x86/pentium/copyi.asm: New file, ditto. + * mpn/x86/pentium/com_n.asm: Rewrite, ditto. + + * printf/snprntffuns.c (gmp_snprintf_format): Copy va_list in case + vsnprintf trashes it. + * printf/vasprintf.c (gmp_asprintf_format): Ditto. + * gmp-impl.h, doprnt.c (va_copy): Move to gmp-impl.h. + + * tests/mpz/t-cmp_d.c (check_low_z_one): Patch by Torbjorn for vax + limited float range. + +2001-09-23 Torbjorn Granlund + + * mpn/vax/lshift.s: Change `jsob*' to `sob*'. + * mpn/vax/rshift.s: Likewise. + +2001-09-23 Kevin Ryde + + * mpn/x86/pentium4/sse2/mul_basecase.asm: Some simple but real code. + + * printf/doprnt.c: Use va_copy for va_list variables, copy function + parameter in case it's call-by-reference. + + * tune/freq.c (speed_cpu_frequency_bsd_dmesg): New function. + (speed_cpu_frequency_table): Use it. + + * tune/many.pl (popcount, hamdist): Fix declared return value. + (sb_divrem_mn): Remove a spurious duplicate entry. + (CLEAN): Add tmp-$objbase.c when using that for .h files. + (macro_speed): Give a default for .h files. + Add ATTRIBUTE_CONST or __GMP_ATTRIBUTE_PURE as appropriate. + + * tune/speed.h (SPEED_ROUTINE_MPN_MOD_CALL, + SPEED_ROUTINE_MPN_PREINV_MOD_1, SPEED_ROUTINE_MPN_POPCOUNT, + SPEED_ROUTINE_MPN_HAMDIST, SPEED_ROUTINE_MPN_GCD_1N, + SPEED_ROUTINE_MPN_GCD_1_CALL, SPEED_ROUTINE_MPZ_JACOBI): Use return + values so gcc 3 won't discard calls to pure or const functions. + (mpn_mod_1_div, mpn_mod_1_inv): Add __GMP_ATTRIBUTE_PURE. + +2001-09-22 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/mul_basecase.asm: New file, placeholder + for real code, hiding the default x86 mul_basecase.asm. + +2001-09-22 Kevin Ryde + + * configure.in (AC_PREREQ): Bump to 2.52. + (m4_pattern_forbid, m4_pattern_allow): New calls, forbid GMP_. + (AC_CHECK_HEADERS): Remove sys/types.h, already done by autoconf. + * acinclude.m4, configure.in (GMP_GCC_NO_CPP_PRECOMP): New macro. + + * tests/devel/try.c (TYPE_PREINV_MOD_1): Don't run size==0. + (malloc_region): Need fd=-1 for mmap MAP_ANON on BSD. + +2001-09-20 Torbjorn Granlund + + * mpz/cong.c (mpz_congruent_p): Fix one-limb c + + * mpn/x86/pentium4/sse2/diveby3.asm: New file. + * mpn/x86/pentium4/sse2/mode1o.asm: New file. + +2001-09-16 Kevin Ryde + + * printf/doprnt.c: '#' means showpoint and showtrailing for %e, %f, %g. + * tests/printf/t-printf.c (check_f): More test cases. + +2001-09-15 Torbjorn Granlund + + * gmp-h.in (__GMPN_AORS_1): Remove param TEST, add OP and CB. + Postpone zeroing of (cout). + (__GMPN_ADD_1, __GMPN_SUB_1): Corresponding changes. + +2001-09-14 Kevin Ryde + + * ChangeLog: Merge in tests/rand/ChangeLog. + * tests/rand/ChangeLog: Remove file. + + * printf/doprnt.c: Fix handling of a plain format after a GMP one; no + need to protect against negative precision internally. + * tests/printf/t-printf.c (check_misc): More checks. + +2001-09-12 Torbjorn Granlund + + * mpn/cray/ieee/invert_limb.c: Add a PROLOGUE in a comment to have + HAVE_NATIVE_... defined. + +2001-09-11 Kevin Ryde + + * configure.in, gmp-h.in (__GMP_HAVE_HOST_CPU_FAMILY_power, + __GMP_HAVE_HOST_CPU_FAMILY_powerpc): New AC_SUBSTs. + * gmp-h.in (__GMPN_COPY_INCR): Use them to select the power/powerpc + code, rather than preprocessor defines. + + * acinclude.m4, configure.in (GMP_H_ANSI): New macro. + + * gmp-h.in (__GMP_EXTERN_INLINE): Add a definition for SCO 8 cc. + + * gmp-h.in, version.c (gmp_version): Make the pointer "const" as well + as the string. + + * acinclude.m4, configure.in (GMP_PROG_CC_IS_XLC): Recognise xlc when + invoked under another name (cc, xlc128, etc). + * acinclude.m4 (GMP_PROG_CC_IS_GCC): Print a message when recognised. + +2001-09-11 Torbjorn Granlund + + * gmp-h.in: Let __DECC mean __GMP_HAVE_CONST, etc. + * mp-h.in: Likewise. + +2001-09-10 Torbjorn Granlund + + * mpn/x86/pentium4/mmx/lshift.asm: New file. + * mpn/x86/pentium4/mmx/rshift.asm: New file. + + * tests/mpn/t-iord_u.c (check_incr_data): Work around HP compiler bug. + (check_decr_data): Likewise. + +2001-09-08 Kevin Ryde + + * gmp.texi (Integer Logic and Bit Fiddling): Update mpz_hamdist + behaviour, clarify mpz_popcount a touch. + (Language Bindings): Add mlton, fix alphabetical order. + (Single Limb Division): Describe 2 or 1/2 limbs at a time style. + + * configure.in (AC_CHECK_FUNCS): Add mmap. + * tests/devel/try.c (malloc_region): Use mmap if available. + + * tests/refmpz.c, tests/tests.h (refmpz_hamdist): New function. + * tests/mpz/t-hamdist.c: New file. + * tests/mpz/Makefile.am: Add it. + + * mpz/hamdist.c: Support neg/neg operands. + + * macos/Makefile.in: Remove dual compile of mpq/aors.c and + mpn/generic/popham.c. + + * gmp-impl.h (popc_limb): New macro, adapted from mpn/generic/popham.c. + For 64-bits reuse 0x33...33 constant. + * mpn/generic/popcount.c, mpn/generic/hamdist.c: Split from popham.c, + use popc_limb macro, remove unused "i", don't bother with "register" + qualifiers. + * mpn/generic/popham.c: Remove file. + + * ltmain.sh, configure, aclocal.m4: Update to libtool 1.4.1, with one + ltdll.c generation patch. + * doc/configuration: Misc updates, note libtool patch used. + + * mpn/x86/pentium4/sse2/mul_1.asm: Use pointer increments not indexed + addressing, to get 4.0 c/l flat. + + * tests/mpq/t-cmp_si.c (check_data): Use ULONG_MAX for denominators. + + * tests/misc.c (mpz_negrandom): Use given rstate, not RANDS. + +2001-09-07 Torbjorn Granlund + + * mpn/x86/pentium4/sse2/addmul_1.asm: New file. + +2001-09-04 Kevin Ryde + + * tune/freq.c: Define a HAVE for each speed_cpu_frequency routine to + avoid duplicating conditionals. + (speed_cpu_frequency_sco_etchw): New function. + (speed_cpu_frequency_table): Use it. + * tune/README: Mention SCO openunix 8 /etc/hw. + + * mpz/fib_ui.c: Use ?: to avoid a gcc 3 bug on powerpc64. + Store back a carry for limb + + * configure.in (m68k-*-*): Let m68k mean 68000, not 68020. + * gmp.texi (Notes for Particular Systems): Update. + + * gmp-impl.h (union ieee_double_extract) [m68k]: Use longs, since int + might be only 16 bits. + + * tests/mpq/t-aors.c: New file. + * tests/mpq/Makefile.am: Add it. + + * tests/refmpq.c: New file. + * tests/Makefile.am: Add it. + * tests/tests.h: Add prototypes. + + * mpq/aors.c: Share object code for mpq_add and mpq_sub. + * Makefile.am, mpq/Makefile.am: Single mpq/aors.lo now. + + * tests/devel/try.c (TYPE_SUBMUL_1): Use correct reference routine. + +2001-08-30 Kevin Ryde + + * mpn/x86/x86-defs.m4 (cmov_available_p): Add pentium4. + + * gmp-h.in: Put #define renamings with prototypes. + Remove commented out #defines of gmp-impl.h things. + (mpn_invert_limb): Remove #define, already in gmp-impl.h. + (mpn_lshiftc, mpn_rshiftc): Remove #defines, unused. + (mpn_addsub_nc): Add prototype to #define. + +2001-08-28 Kevin Ryde + + * gmp.texi: Switch to GFDL. + (Top): Arrange copyright and conditions to appear here too. For + clarity have all this before the miscellaneous macro definitions. + (Copying): Refer to COPYING.LIB file, mention plain GPL2 in demo + programs. + (Contributors, References): Use @appendix rather than @unnumbered. + (GNU Free Documentation License): New appendix. + (@contents): Move to start of document, use only for tex (not html). + (Debugging): Add leakbug. + (Build Options): Add pentium4. + (I/O of Rationals): Add mpq_inp_str. + + * fdl.texi: New file, with two @appendix directive tweaks. + * Makefile.am (gmp_TEXINFOS): Add it. + + * tests/mpz/io.c: Check mpz_inp_str return against ftell, send error + messages just to stdout. + + * mpz/inp_str.c, gmp-impl.h (__gmpz_inp_str_nowhite): New function, + and share a __gmp_free_func call. + * mpq/inp_str.c: New file. + * Makefile.am, mpq/Makefile.am: Add it. + * tests/mpq/t-inp_str.c: New file. + * tests/mpq/Makefile.am (check_PROGRAMS): Add it. + + * configure.in, acconfig.h (HAVE_HOST_CPU_FAMILY_power, + HAVE_HOST_CPU_FAMILY_powerpc, HAVE_HOST_CPU_FAMILY_x86): AC_DEFINEs + for processor families. + * gmp-impl.h: Use them, rather than cpp defines. + + * demos/Makefile.am (primes_LDADD): Use $(LIBM), for log(). + + * tune/many.pl, tune/Makefile.am: Fix some from clean and distclean. + +2001-08-26 Kevin Ryde + + * tests/devel/try.c (ARRAY_ITERATION): Make types match on "?:" legs. + (TYPE_MPZ_JACOBI, TYPE_MPZ_KRONECKER): Remove some superseded code. + + * tests/printf/t-printf.c (check_plain): Don't compare "all digits" + precision against plain printf. + + * tune/Makefile.am: Eliminate empty TUNE_MPZ_SRCS. + + * configure, config.in, INSTALL.autoconf: Update to autoconf 2.52. + * */Makefile.in, mdate-sh, missing, aclocal.m4, configure: Update to + automake 1.5. + * configfsf.guess, configfsf.sub: Update to 2001-08-23. + +2001-08-24 Torbjorn Granlund + + * demos/primes.c: Complete rewrite. + +2001-08-24 Kevin Ryde + + * longlong.h: Test __ppc__ for apple darwin cc, reported by Jon + Becker. Also test __POWERPC__, PPC and __vxworks__. + + * tune/speed.h (speed_cyclecounter) [x86]: Don't clobber ebx in PIC. + +2001-08-22 Kevin Ryde + + * configure.in (x86 mmx): Correction to mmx path stripping. + +2001-08-17 Kevin Ryde + + * configure.in, acinclude.m4, Makefile.am, printf/Makefile.am, + tests/printf/Makefile.am, gmp-h.in, gmp-impl.h, gmp.texi: Remove C++ + support, for the time being. + * printf/doprntfx.cc, doprntix.cc, osfuns.cc, osmpf.cc, osmpq.cc, + osmpz.cc, tests/printf/t-ostream.cc: Remove files. + + * printf/doprnt.c, printf/doprntf.c, gmp-impl.h: Use a single + __gmp_doprnt_mpf, rather than a separate ndigits calculation. + * printf/doprnt.c, printf/doprntf.c, gmp-impl.h, gmp.texi, + tests/printf/t-printf.c: Let empty or -1 prec mean all digits for mpf. + * printf/doprnt.c, tests/printf/t-printf.c: Accept h or l in %n; let + negative "*" style width mean left justify. + + * gmp-impl.h, mpf/get_str.c (MPF_SIGNIFICANT_DIGITS): New macro, + extracted from mpf/get_str.c. + + * libmp.sym: New file. + * Makefile.am (libmp_la_LDFLAGS): Use it. + (DISTCLEANFILES): Remove asm-syntax.h, no longer generated. + Remove some comments about "make check". + + * demos/perl/GMP.pm, GMP.xs, GMP/Mpf.pm: Add printf and sprintf, + change get_str to string/exponent for floats, remove separate + mpf_get_str. + * demos/perl/GMP/Mpf.pm (overload_string): Use $# (default "%.g"). + * demos/perl/typemap: Fix some duplicate string entries. + * demos/perl/test.pl: Update tests, split overloaded constants into ... + * demos/perl/test2.pl: ... this new file. + * demos/perl/Makefile.PL (clean): Add test.tmp. + +2001-08-16 Kevin Ryde + + * printf/snprntffuns.c (gmp_snprintf_format): Correction to bufsize-1 + return value handling. + + * demos/calc/calc.y: Reposition "%{" so copyright notice gets into + generated files. + + * INSTALL: Use gmp_printf. + +2001-08-14 Kevin Ryde + + * mpz/inp_str.c: Fix return value (was 1 too big). + * tests/mpz/t-inp_str.c: New file. + * tests/mpz/Makefile.am: Add it. + + * mpn/x86/pentium4/sse2/add_n.asm: New file. + * mpn/x86/pentium4/sse2/sub_n.asm: New file. + * mpn/x86/pentium4/sse2/mul_1.asm: New file. + +2001-08-12 Kevin Ryde + + * printf/sprintffuns.c, printf/doprntf.c: Don't use sprintf return + value (it's a pointer on SunOS 4). + + * acinclude.m4 (GMP_ASM_X86_SSE2, GMP_STRIP_PATH): New macros. + * configure.in: Add pentium4 support. + * mpn/x86/pentium4, mpn/x86/pentium4/mmx, mpn/x86/pentium4/sse2: New + directories. + * mpn/x86/README: Update. + +2001-08-10 Torbjorn Granlund + + * demos/pexpr.c (setup_error_handler): Catch also SIGABRT. + +2001-07-31 Kevin Ryde + + * tests/refmpn.c (refmpn_mul_1c): Allow low to high overlaps. + + * gmp-h.in, gmp-impl.h (_gmp_rand): Move prototype to gmp-impl.h. + + * tune/Makefile.am (EXTRA_DIST): Add many.pl. + +2001-07-28 Kevin Ryde + + * gmp.texi (Random Number Functions): Old rand functions no longer use + the C library. + + * configure.in, acinclude.m4 (GMP_FUNC_VSNPRINTF): New macro. + + * mpn/generic/get_str.c: Add an ASSERT for high limb non-zero. + +2001-07-24 Kevin Ryde + + * gmp.texi (Build Options): Add --enable-cxx. + (Converting Floats): Note mpf_get_str only generates accurately + representable digits. + (Low-level Functions): Note mpn_get_str requires non-zero high limb. + (Formatted Output): New chapter. + (Multiplication Algorithms): Use @quotation with @multitable. + (Toom-Cook 3-Way Multiplication): Ditto. + + * tests/memory.c (tests_free_nosize): New function. + * tests/tests.h (tests_allocate etc): Add prototypes. + + * tests/printf: New directory. + * tests/printf/Makefile.am, t-printf.c, t-ostream.cc: New files. + * configure.in, tests/Makefile.am: Add them. + + * configure.in, acinclude.m4 (GMP_PROG_CXX): New macro. + * configure.in (--enable-cxx): New option. + (AC_CHECK_HEADERS): Add locale.h and sys/types.h, remove unistd.h. + (AC_CHECK_TYPES): Add intmax_t, long double, long long, ptrdiff_t, + quad_t. + (AC_CHECK_FUNCS): Add localeconv, memset, obstack_vprintf, snprintf, + strchr, vsnprintf. + (AC_CHECK_DECLS): Add vfprintf. + + * gmp-h.in, gmp-impl.h: Additions for gmp_printf etc. + + * printf: New directory. + * printf/Makefile.am, asprintf.c, doprnt.c, doprntf.c, doprntfx.cc, + doprnti.c, doprntix.cc, fprintf.c, obprintf.c, obprntffuns.c, + obvprintf.c, osfuns.cc, osmpf.cc, osmpq.cc, osmpz.cc, printf.c, + printffuns.c, snprintf.c, snprntffuns.c, sprintf.c, sprintffuns.c, + vasprintf.c, vfprintf.c, vprintf.c, vsnprintf.c, vsprintf.c: New + files. + * configure.in, Makefile.am: Add them. + + * configure.in (HAVE_INLINE): Remove AC_DEFINE, unused. + (AC_CHECK_TYPES): Don't test for void, assume it always exists. + + * gmp-impl.h (__GMP_REALLOCATE_FUNC_MAYBE): New macro. + * mpz/get_str.c, mpq/get_str.c, mpf/get_str.c: Use it. + + * gmp-impl.h (mpn_fib2_ui): Use __MPN. + (MPN_COPY_DECR): Fix an ASSERT. + (CAST_TO_VOID): Remove macro. + + * gmp-h.in (mpq_out_str): Give #define even without prototype. + (mpz_cmp_d, mpz_cmpabs_d): Corrections to #defines. + + * tests/devel/try.c: Add mpn_add and mpn_sub, don't use CAST_TO_VOID. + +2001-07-23 Torbjorn Granlund + + * config.guess: Recognize pentium4. + * config.sub: Recognize pentium4. + +2001-07-17 Kevin Ryde + + * gmp-h.in (__GMPN_AORS_1): Remove x86 and gcc versions, leave just + one version. + (__GMPN_ADD, __GMPN_SUB): New macros, rewrite of mpn_add and mpn_sub. + (mpn_add, mpn_sub): Use them. + (__GMPN_COPY_REST): New macro. + + * gmp-h.in, gmp-impl.h, acinclude.m4: Remove __GMP_ASM_L and + __GMP_LSYM_PREFIX, revert to ASM_L in gmp-impl.h and AC_DEFINE of + LSYM_PREFIX. + +2001-07-11 Kevin Ryde + + * gmp-h.in (__GMPN_ADD_1 etc) [x86]: Don't use this on egcs 2.91. + + * mpz/fits_uint.c, fits_ulong.c, mpz/fits_ushort.c: Split up fits_u.c. + * mpz/fits_u.c: Remove file. + * mpz/Makefile.am, macos/Makefile.in: Update. + + * tests/refmpn.c,tests.h (refmpn_copy): New function. + * tests/devel/try.c (TYPE_ZERO): No return value from call. + (TYPE_MODEXACT_1_ODD, TYPE_MODEXACT_1C_ODD): Share call with + TYPE_MOD_1 and TYPE_MOD_1C. + (MPN_COPY, __GMPN_COPY, __GMPN_COPY_INCR): Add testing. + +2001-07-10 Kevin Ryde + + * gmp-h.in (__GMPN_COPY): Add form to help gcc on power and powerpc. + * gmp-impl.h (MPN_COPY_INCR, MPN_COPY_DECR, MPN_ZERO): Ditto. + * mpn/powerpc64/copyi.asm, mpn/powerpc64/copyd.asm: Remove files. + + * mpz/tdiv_ui.c: Eliminate some local variables (seems to save code on + i386 gcc 2.95.x), remove a bogus comment about quotient. + + * errno.c, gmp-impl.h (__gmp_exception, __gmp_divide_by_zero, + __gmp_sqrt_of_negative): New functions. + * gmp-impl.h (GMP_ERROR, DIVIDE_BY_ZERO, SQRT_OF_NEGATIVE): Use them. + + * randclr.c, randraw.c: Use ASSERT(0) for unrecognised algorithms. + +2001-07-07 Kevin Ryde + + * configure.in (powerpc*-*-*): Use -no-cpp-precomp for Darwin. + + * tests/mpbsd/t-itom.c: Renamed from t-misc.c. + * tests/mpbsd/t-misc.c: Remove file. + * tests/mpbsd/Makefile.am: Update. + + * tests/mpf/t-set_si.c,t-cmp_si.c,t-gsprec.c: Split from t-misc.c. + * tests/mpf/t-misc.c: Remove file. + * tests/mpf/Makefile.am: Update. + + * tests/mpz/t-oddeven.c,t-set_si.c,t-cmp_si.c: Split from t-misc.c. + * tests/mpz/t-misc.c: Remove file. + * tests/mpz/Makefile.am: Update. + + * stack-alloc.c: Add some alignment ASSERTs. + + * gmp-impl.h (MPN_NORMALIZE): Add notes on x86 repe/scasl slow. + + * tests/devel/try.c (MPN_ZERO): Add testing. + * tune/speed.c,speed.h,common.c,many.pl (MPN_ZERO): Add measuring. + + * mpn/x86/divrem_1.asm: Update a remark about gcc and "loop". + + * tests/mpq/t-cmp_si.c: New file. + * tests/mpq/Makefile.am: Add it. + + * tests/misc.c,tests.h (mpq_set_str_or_abort): New function. + + * mpq/cmp_si.c: New file. + * Makefile.am, mpq/Makefile.am: Add it. + * gmp-h.in (mpq_cmp_si): Add prototype. + * gmp.texi (Comparing Rationals): Add doco. + + * gmp-h.in (_GMP_H_HAVE_FILE): Add _FILE_DEFINED for microsoft, add + notes on what symbols are for what systems. + +2001-07-06 Torbjorn Granlund + + * longlong.h (ibm032 umul_ppmm): Fix typo. + * longlong.h (sparclite sdiv_qrnnd): Fix typo. + +2001-07-03 Kevin Ryde + + * mpz/bin_ui.c (DIVIDE): Use MPN_DIVREM_OR_DIVEXACT_1. + * mpz/bin_uiui.c (MULDIV): Ditto, and use local variables for size and + pointer. + + * acinclude.m4 (GMP_INCLUDE_GMP_H): New macro, use it everywhere gmp.h + is wanted at configure time. + * acinclude.m4, configure.in (GMP_H_EXTERN_INLINE, GMP_H_HAVE_FILE): + New macros. + + * gmp-h.in (__GMP_EXTERN_INLINE): Set to "inline" for C++. + (mpn_add, mpn_sub): Use new style __GMP_EXTERN_INLINE. + * gmp-h.in, mp-h.in, gmp-impl.h (_EXTERN_INLINE): Remove, unused. + * mpn/generic/add.c, mpn/generic/sub.c: New files. + * mpn/generic/inlines.c: Remove file. + * configure.in, mpn/Makefile.am: Update. + + * gmp.texi (GMP Basics): Note the need for stdio.h to get FILE + prototypes. + +2001-07-01 Kevin Ryde + + * gmp.texi (Build Options, Reentrancy): Updates for new + --enable-alloca behaviour. + (Debugging): Describe --enable-alloca=debug. + (Miscellaneous Integer Functions): Note mpz_sizeinbase ignores signs. + (Low-level Functions): Give a formula for mpn_gcdext cofactor. + (Factorial Algorithm): New section. + (Binomial Coefficients Algorithm): New section. + Misc tweaks elsewhere. + + * mpf/set_prc.c: Merge the two truncation conditionals, misc cleanups, + no functional changes. + + * mpn/*/gmp-mparam.h (DIVEXACT_1_THRESHOLD): Add tuned values. + * gmp-impl.h (DIVEXACT_1_THRESHOLD): Make the default 0 when + 2*UMUL_TIME < UDIV_TIME. + + * mpn/x86/p6/dive_1.asm: New file. + + * mpn/x86/dive_1.asm: New file. + * mpn/x86/gmp-mparam.h (DIVEXACT_1_THRESHOLD): Use it always. + + * tests/refmpn.c, tests.h (refmpn_zero): New function. + * tests/devel/try.c: Use it. + + * tests/refmpn.c (refmpn_sb_divrem_mn): Use refmpn_cmp, not mpn_cmp. + + * tests/mpf/t-get_d.c (main): Use || not |. + + * tests/misc.c, tests/t-modlinv.c, tests/mpq/t-get_str.c, + tests/mpf/reuse.c: Add string.h. + +2001-06-29 Kevin Ryde + + * tune/speed.h (SPEED_ROUTINE_MPN_FIB2_UI, + SPEED_ROUTINE_COUNT_ZEROS_C): Corrections to TMP block handling. + + * gmp-impl.h (MPN_TOOM3_MUL_N_MINSIZE, MPN_TOOM3_SQR_N_MINSIZE): + Corrections to these to account for adding tD into E. + (MPN_INCR_U, MPN_DECR_U) [WANT_ASSERT]: Add size + assertions, since mpn_add_1 and mpn_sub_1 from gmp.h don't get them. + (MPN_DIVREM_OR_DIVEXACT_1): Add an assert of no remainder. + + * assert.c: Add stdlib.h for abort prototype. + * tests/spinner.c, trace.c, t-constants.c, t-count_zeros.c, + t-gmpmax.c, t-modlinv.c: Ditto. + * tests/mpz/t-bin.c, t-cmp.c, t-get_si.c, t-misc.c, t-popcount.c, + t-set_str.c, t-sizeinbase.c: Ditto. + * tests/mpq/t-equal.c, t-get_str.c, t-set_f.c, t-set_str.c: Ditto. + * tests/mpf/t-fits.c, t-get_d.c, t-get_si.c, t-int_p.c, t-misc.c, + t-trunc.c: Ditto. + * tests/mpbsd/allfuns.c, t-misc.c: Ditto. + + * mpn/generic/mul_n.c, mpz/cfdiv_r_2exp.c: Use MPN_INCR_U rather than + mpn_incr_u. + + * tests/devel/try.c (TYPE_SB_DIVREM_MN): More fixes for calling method. + + * mpn/x86/k6/cross.pl: More insn exceptions. + +2001-06-23 Kevin Ryde + + * gmp-h.in (__GMPN_ADD_1, __GMPN_SUB_1) [i386]: Fix some asm output + constraints. + + * gmp-impl.h (modlimb_invert): Mask after shifting, so mask constant + fits a signed byte. + + * tests/devel/try.c (TYPE_SB_DIVREM_MN): Fix initial fill of quotient + with garbage. + +2001-06-20 Kevin Ryde + + * config.guess (rs6000-*-aix4* | powerpc-*-aix4*): Suppress error + messages if $CC_FOR_BUILD or program don't work. + + * mpz/sqrt.c,sqrtrem.c: Special case for op==0, to avoid TMP_ALLOC(0). + * tests/refmpf.c (refmpf_add, refmpf_sub): Avoid TMP_ALLOC(0). + + * tests/mpn/t-aors_1.c: New file. + * tests/mpn/Makefile.am: Add it. + + * gmp-h.in (__GMPN_ADD_1, __GMPN_SUB_1): New macros, rewrite of + mpn_add_1 and mpn_sub_1, better code for src==dst and/or n==1, + separate versions for gcc x86, gcc generic, and non-gcc. + (mpn_add_1, mpn_sub_1): Use them. + (mpn_add, mpn_sub): Ditto, to get inlines on all compilers. + (extern "C") [__cplusplus]: Let this encompass the extern inlines too. + * mpn/generic/add_1.c,sub_1.c: New files, force code from gmp.h. + * configure.in, mpn/Makefile.am: Add them. + + * acinclude.m4 (GMP_ASM_LSYM_PREFIX): AC_SUBST __GMP_LSYM_PREFIX + rather than AC_DEFINE LSYM_PREFIX. + * gmp-h.in (__GMP_LSYM_PREFIX): New substitution. + (__GMP_ASM_L): New macro. + * gmp-impl.h (ASM_L): Use it. + + * acinclude.m4, configure.in (GMP_C_ATTRIBUTE_MALLOC): New macro. + * gmp-impl.h: Use it for all the malloc based TMP_ALLOCs. + + * stack-alloc.h: Remove file. + * tal-reent.c: New file. + * Makefile.am: Update. + + * acinclude.m4, configure.in (GMP_OPTION_ALLOCA): New macro, add + malloc-reentrant method, use stack-alloc.c as malloc-notreentrant, + make "reentrant" the default. + * gmp-impl.h (__TMP_ALIGN): Moved from stack-alloc.c, use a union to + determine the value, and demand only 4 bytes align on 32-bit systems. + * gmp-impl.h (WANT_TMP_NOTREENTRANT): Move global parts of + stack-alloc.h to here, allow non power-of-2 __TMP_ALIGN in TMP_ALLOC. + * gmp-impl.h: Extend extern "C" to TMP_ALLOC declarations. + * stack-alloc.c (tmp_stack): Move private parts of stack-alloc.h to + here, use gmp-impl.h. + + * gmp-impl.h (TMP_ALLOC_LIMBS_2): New macro. + * mpz/fib_ui.c, mpz/jacobi.c, mpq/cmp.c, mpn/generic/fib2_ui.c: Use it. + + * mpfr/exp2.c: Patch by Paul to match TMP_MARK and TMP_FREE in loop. + * mpfr/sqrt.c: Scope nested TMP_DECL into nested { } block, patch by + Paul, tweaked by me. + * mpfr/agm.c: Ditto, and add a final TMP_FREE(marker2). + + * gmp-h.in (mpn_cmp): Add __GMP_ATTRIBUTE_PURE. + + * INSTALL: Clarify "make install", tweak formatting a bit. + +2001-06-17 Kevin Ryde + + * configure.in, Makefile.am, gmp-impl.h: Add a debugging TMP_ALLOC, + selected with --enable-alloca=debug. + * tal-debug.c: New file. + * configure.in, Makefile.am: Compile stack-alloc.c only for + --disable-alloca. + * assert.c (__gmp_assert_header): New function, split from + __gmp_assert_fail. + + * mpz/lcm.c: Don't TMP_MARK and then just return. Remove unnecessary + _mpz_realloc prototype. + + * mpn/generic/mul.c (mpn_sqr_n): Use __gmp_allocate_func for toom3 + temporary workspace. + +2001-06-15 Kevin Ryde + + * tests/mpz/t-set_f.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add it. + + * mpz/set_f.c: Share MPN_COPY between pad and trunc cases, do exp<=0 + test earlier, store SIZ(w) earlier. + + * tests/t-count_zeros.c: New file. + * tests/t-gmpmax.c: New file. + * tests/Makefile.am (check_PROGRAMS): Add them. + + * mp_clz_tab.c: Compile the table only if longlong.h says it's needed; + add an internal-use-only comment. + * tune/common.c: Force a __clz_tab for convenience when testing. + + * mpn/x86/pentium/gmp-mparam.h, mpn/x86/pentium/mmx/gmp-mparam.h: Add + COUNT_LEADING_ZEROS_NEED_CLZ_TAB, for mod_1.asm. + + * longlong.h (count_leading_zeros) [pentium]: Decide to go with float + method for p54. + (count_leading_zeros) [alpha]: Add COUNT_LEADING_ZEROS_NEED_CLZ_TAB. + (__clz_tab): Provide a prototype only if it's needed. + + * tests/trace.c (mpz_trace): Don't use = on structures. + (mpn_trace): Set _mp_alloc when creating mpz. + +2001-06-12 Kevin Ryde + + * mpn/x86/divrem_1.asm: Amend some comments about P5 speed. + + * tune/README: Clarify reconfigure on gmp-mparam.h update. + + * mpn/x86/p6/copyd.asm: New file. + * mpn/x86/p6/README: Update copyd and mod_1. + * mpn/x86/copyd.asm: Amend some comments. + + * gmp-impl.h (__builtin_constant_p): Add dummy for non-gcc. + (mpn_incr_u, mpn_decr_u): Recognise incr==1 at compile time in the + generic code on gcc. + + * gmp-impl.h (ASSERT_ZERO_P, ASSERT_MPN_NONZERO_P): New macros. + * mpn/generic/gcd_1.c, mpn/generic/mul_fft.c: Use them. + * mpz/get_d.c: Add a private mpn_zero_p. + * mpfr/trunc.c: Use own mpn_zero_p. + * tune/speed.h (SPEED_ROUTINE_MPN_GCD_1N): Use refmpn_zero_p. + * gmp-impl.h (mpn_zero_p): Remove, no longer needed. + + * gmp-h.in, gmp-impl.h: Move MPN_CMP to gmp.h as __GMPN_CMP, leave an + MPN_CMP alias in gmp-impl.h. + * gmp-h.in (mpn_cmp): Add an inline version. + * mpn/generic/cmp.c: Use __GMP_FORCE_mpn_cmp to get code from gmp.h. + + * acinclude.m4 (GMP_C_ATTRIBUTE_MODE): New macro. + * configure.in: Call it. + * gmp-impl.h (SItype etc): Use it. + + * randraw.c (lc): Change mpn_mul_basecase->mpn_mul, + mpn_incr_u->MPN_INCR_U, abort->ASSERT_ALWAYS(0). + + * longlong.h (count_leading_zeros) [pentiumpro]: Work around a partial + register stall on gcc < 3. + + * gmp.texi (Introduction to GMP): Add IA-64. + (Notes for Particular Systems): i386 means generic x86. + + * tests/t-modlinv.c: Use tests_start and tests_end. + +2001-06-10 Kevin Ryde + + * gmp.texi (Number Theoretic Functions): mpz_jacobi only defined for b + odd. Separate the jacobi/legendre/kronecker descriptions. + (Low-level Functions): Document mpn_mul_1 "incr" overlaps. + (Language Bindings): New chapter. + + * mpz/jacobi.c: Don't retaining old behaviour of mpz_jacobi on even b + (it wasn't documented in 3.1.1). + * mpz/jacobi.c, gmp-h.in (mpz_kronecker, mpz_legendre): Remove + separate entrypoints, just #define to mpz_jacobi. + * compat.c (__gmpz_legendre): Add compatibility entrypoint. + + * mpn/generic/mul_1.c: Allow "incr" style overlaps. + * tests/devel/try.c (param_init): Test this. + + * mpf/mul_ui.c: Do size==0 test earlier. + +2001-06-08 Kevin Ryde + + * gmp-impl.h (ULONG_HIGHBIT, UINT_HIGHBIT, USHRT_HIGHBIT): Cast + ULONG_MAX etc to unsigned long etc before attempting to right shift. + + * acinclude.m4 (GMP_ASM_LSYM_PREFIX): Add an AC_DEFINE of LSYM_PREFIX. + * gmp-impl.h (ASM_L): New macro. + (mpn_incr_u, mpn_decr_u, MPN_INCR_U, MPN_DECR_U): Add i386 optimized + versions. + + * mpn/hppa/*.s,S,asm: Use .label so the code works with gas on hppa + GNU/Linux too, reported by LaMont Jones . + * mpn/hppa/README: Add some notes on this. + * acinclude.m4 (GMP_ASM_LABEL_SUFFIX): Ditto. + + * mpn/Makefile.am (nodist_libdummy_la_SOURCES): Add dive_1.c, + fib2_ui.c. + + * tests/mpn/t-iord_u.c: New file. + * tests/mpn/Makefile.am (check_PROGRAMS): Add it. + + * configure.in (mips*-*-irix[6789]*): Make ABI=n32 the default, same + as in gmp 3.1. + * gmp.texi (ABI and ISA): Update. + + * gmp.texi (Build Options): Misc tweaks. + (Notes for Particular Systems): Describe windows DLL handling. + (Known Build Problems): DJGPP needs bash 2.04. + (Number Theoretic Functions): mpz_invert returns 0<=r + + * configure.in, gmp-h.in, mp-h.in: Add support for windows DLLs. + +2001-05-26 Kevin Ryde + + * gmp.texi (ABI and ISA, Reentrancy): Minor tweaks + (Notes for Package Builds): Note gmp.h is a generated file. + (Notes for Particular Systems): -march=pentiumpro is used for gcc + 2.95.4 and up. + (Assembler Loop Unrolling): Mention non power-of-2 unrolling. + (Internals): New chapter. + * mpf/README: Remove file. + + * demos/expr/README: Miscellaneous rewordings. + + * demos/perl: New directory. + * demos/Makefile.am: Add it. + * demos/perl/INSTALL, Makefile.PL, GMP.pm, GMP.xs, typemap, + GMP/Mpz.pm, GMP/Mpq.pm, GMP/mpf.pm, GMP/Rand.pm, sample.pl, test.pl: + New files. + + * configure, aclocal.m4: Update to autoconf 2.50. + + * configure, aclocal.m4, ltmain.sh: Update to libtool 1.4. + + * configure, aclocal.m4, missing, ansi2knr.c, */Makefile.in: Update to + automake 1.4f. + * Makefile.am: Conditionalize mpfr in $(SUBDIRS) to handle mpfr.info. + * mpfr/Makefile.am (INFO_DEPS): Remove previous mpfr.info handling. + * mpn/Makefile.am (GENERIC_SOURCES): Remove this, just put mp_bases.c + in libmpn_la_SOURCES. + * tests/Makefile.am (tests.h): Move from EXTRA_HEADERS to + libtests_la_SOURCES. + * ltconfig: Remove file, no longer needed. + + * Makefile.am (gmp-impl.h, longlong.h, stack-alloc.h): Move from + EXTRA_DIST to libgmp_la_SOURCES, so they get included in TAGS. + * tests/rand/Makefile.am (gmpstat.h): Move to libstat_la_SOURCES + similarly. + + * config.guess (68k-*-*): Use $SHELL not "sh", tweak some comments. + + * mpfr/mpfr.texi (Introduction to MPFR): Tweak table formatting, note + non-free programs must be able to be re-linked. + +2001-05-20 Kevin Ryde + + * mpn/powerpc64/addmul_1.asm, mpn/powerpc64/mul_1.asm, + mpn/powerpc64/submul_1.asm: Add carry-in entrypoints. + +2001-05-17 Kevin Ryde + + * gmp.texi (ge): Fix definition for info. + (Notes for Particular Systems): Mention 68k dragonball and cpu32. + (Efficiency): Add static linking, more about in-place operations, + describe mpq+/-integer using addmul. + (Reporting Bugs): A couple of words about self-contained reports. + (Floating-point Functions): Note exponent limitations of mpf_get_str + and mpf_set_str. + (Initializing Floats): Clarify mpf_get_prec, mpf_set_prec and + mpf_set_prec_raw a bit. + (Float Comparison): Note current mpf_eq deficiencies. + + * gmp-h.in (__GMP_HAVE_CONST, __GMP_HAVE_PROTOTYPES, + __GMP_HAVE_TOKEN_PASTE): Merge GNU ansidecl.h tests for ANSI compilers. + * demos/expr/expr-impl-h.in: Ditto. + + * gmp-impl.h (BITS_PER_MP_LIMB): Define from __GMP_BITS_PER_MP_LIMB if + not already in gmp-mparam.h. + * tests/t-constants.c (BITS_PER_MP_LIMB, __GMP_BITS_PER_MP_LIMB): + Check these are the same. + + * gmp-h.in (mpf_get_default_prec, mpf_get_prec, mpf_set_default_prec, + mpf_set_prec_raw): Provide "extern inline" versions, use __GMPF on the + macros. + * mpf/get_dfl_prc.c, mpf/get_prc.c, mpf/set_dfl_prc.c, + mpf/set_prc_raw.c: Get code from gmp.h using __GMP_FORCE. + + * gmp-h.in, gmp-impl.h (__gmp_default_fp_limb_precision): Move from + gmp-impl.h to gmp-h.in. + (__GMPF_BITS_TO_PREC, __GMPF_PREC_TO_BITS): Ditto, and use __GMPF + prefix and add a couple of casts. + * gmp-h.in (__GMP_MAX): New macro. + * mpf/init2.c mpf/set_prc.c: Update for __GMPF prefix. + + * gmp-h.in (__GMP_BITS_PER_MP_LIMB): New templated define. + * acinclude.m4 (GMP_C_SIZES): Add AC_SUBST __GMP_BITS_PER_MP_LIMB, + remove AC_DEFINE BITS_PER_MP_LIMB. + +2001-05-13 Kevin Ryde + + * gmp-h.in, gmp.texi, Makefile.am, mpz/Makefile.am, tests/mpz/t-pow.c: + Remove mpz_si_pow_ui, pending full si support. + * mpz/si_pow_ui.c: Remove file. + +2001-05-11 Kevin Ryde + + * mpn/x86/pentium/dive_1.asm: New file. + + * mpn/powerpc32/umul.asm: Use r on registers. + * mpn/powerpc64/umul.asm: New file. + * configure.in (powerpc*-*-*): Enable umul in extra_functions. + + * tests/refmpn.c, tests/tests.h (refmpn_umul_ppmm): Use same arguments + as normal mpn_umul_ppmm. + (refmpn_mul_1c): Update. + * tests/devel/try.c, tune/many.pl: Add some umul_ppmm testing support. + + * mpn/x86/k6/mmx/popham.asm, mpn/x86/k7/mmx/popham.asm: Don't support + size==0. + * mpn/x86/pentium/popcount.asm, mpn/x86/pentium/hamdist.asm: Ditto, + and shave a couple of cycles from the PIC entry code. + + * mpz/mul.c: Use mpn_mul_1 for size==1 and mpn_mul_2 (if available) + for size==2, to avoid copying; do vsize==0 test earlier. + + * mpf/sub.c: Test r!=u before calling mpf_set. + * mpf/add.c: Ditto, and share mpf_set between usize==0 and vsize==0. + + * mpn/generic/tdiv_qr.c, mpq/get_d.c, mpf/div.c, mpf/set_q.c, + mpf/set_str.c, mpf/ui_div.c: Test for high bit set, not for + count_leading_zeros zero. + + * acinclude.m4 (GMP_PROG_AR, GMP_PROG_NM): Print a message if extra + flags are added. + + * tests/mpz/t-mul_i.c: New file. + * tests/mpz/Makefile.am: Add it. + + * mpz/mul_siui.c (mpz_mul_si): Fix for -0x80..00 on long long limb. + + * gmp-h.in (mpf_set_si, mpf_set_ui): Revert last change, set exp to 0 + when n==0. + * mpf/ceilfloor.c, mpf/trunc.c: Fix exp to 0 when setting r to 0. + * gmp-impl.h (MPF_CHECK_FORMAT): Check exp==0 when size==0. + +2001-05-07 Kevin Ryde + + * gmp-h.in (mpf_set_si, mpf_set_ui): Don't bother setting _mp_exp to 0 + when n==0 (use 1 unconditionally). + * tests/mpf/t-misc.c (check_mpf_set_si): Don't demand anything of + _mp_exp when _mp_size is zero. + + * mpn/x86/README: Note gas _GLOBAL_OFFSET_TABLE_ with leal problem. + + * gmp-h.in (mpz_fits_uint_p, mpz_fits_ulong_p, mpz_fits_ushort_p): + Provide these as "extern inline"s. + (__GMP_UINT_MAX, __GMP_ULONG_MAX, __GMP_USHRT_MAX): New macros. + (mpz_popcount): Use __GMP_ULONG_MAX. + * gmp-impl.h (UINT_MAX, ULONG_MAX, USHRT_MAX): Use __GMP_U*_MAX, if + not already defined. + * mpz/fits_u.c: Use the code from gmp.h. + +2001-05-06 Kevin Ryde + + * mpn/x86/k7/dive_1.asm: New file. + * mpn/x86/k7/gcd_1.asm: New file. + * mpn/asm-defs.m4 (m4_count_trailing_zeros): New macro. + + * gmp-h.in (mpz_get_ui, mpz_getlimbn, mpz_set_q, mpz_perfect_square_p, + mpz_popcount, mpz_size, mpf_set_ui, mpf_set_si, mpf_size): Provide + these as "extern inlines". + Use just one big extern "C" block. + * mpz/getlimbn.c, mpz/get_ui.c, mpz/perfsqr.c, mpz/popcount.c + mpz/set_q.c, mpz/size.c, mpf/set_si.c, mpf/set_ui.c, mpf/size.c: Use + __GMP_FORCE to get code from gmp.h. + +2001-05-03 Kevin Ryde + + * extract-dbl.c: Add ASSERT d>=0. + + * gmp.texi (Efficiency): Add mpz_addmul etc for mpz+=integer, add + mpz_neg etc in-place. + (Integer Arithmetic): Add mpz_addmul, mpz_submul, mpz_submul_ui. + (Initializing Rationals): Add mpq_set_str. + (Low-level Functions): mpn_set_str requires strsize >= 1. + + * gmp-h.in (__GMP_EXTERN_INLINE, __GMP_ABS): New macros. + (mpz_abs, mpq_abs, mpf_abs, mpz_neg, mpq_neg, mpf_neg): Provide inline + versions. + * mpz/abs.c, mpq/abs.c, mpf/abs.c, mpz/neg.c, mpq/neg.c, mpf/neg.c: + Add suitable __GMP_FORCE to turn off inline versions. + + * tests/mpz/t-aorsmul.c,t-cmp_d.c,t-popcount,t-set_str.c: New files. + * tests/mpz/Makefile.am: Add them. + + * mpz/aorsmul_i.c: New file, rewrite of addmul_ui.c. Add + mpz_submul_ui entrypoint, share more code between some of the + conditionals, use mpn_mul_1c if available. + * mpz/addmul_ui.c: Remove file. + * mpz/aorsmul.c: New file. + * Makefile.am, mpz/Makefile.am: Update. + * gmp-h.in (mpz_addmul, mpz_submul, mpz_submul_ui): Add prototypes. + * gmp-impl.h (mpz_aorsmul_1): Add prototype. + + * tests/mpq/t-set_str.c: New file. + * tests/mpq/Makefile.am: Add it. + + * mpq/set_str.c: New file. + * Makefile.am, mpq/Makefile.am: Add it. + * gmp-h.in (mpq_set_str): Add prototype. + + * mpz/set_str.c: Fix for trailing white space on zero, eg. "0 ". + * mpn/generic/set_str.c: Add ASSERT str_len >= 1. + + * gmp-h.in, gmp-impl.h (mpn_incr_u, mpn_decr_u): Move to gmp-impl.h. + * gmp-impl.h (MPN_INCR_U, MPN_DECR_U): New macros. + +2001-04-30 Kevin Ryde + + * tests/mpz/t-lcm.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add it. + + * mpz/lcm.c: Add one limb special case. + + * mpz/lcm_ui.c: New file. + * Makefile.am, mpz/Makefile.am: Add it. + * gmp-h.in (mpz_lcm_ui): Add prototype. + * gmp.texi (Number Theoretic Functions): Add mpz_lcm_ui, document lcm + now always positive. + + * mp-h.in (mp_size_t, mp_exp_t): Fix typedefs to match gmp-h.in. + + * gmp-h.in (mpn_add_1, mpn_add, mpn_sub_1, mpn_sub): Remove K&R + function defines (ansi2knr will handle mpn/inline.c, and just ansi is + enough for gcc extern inline). + + * gmp-h.in (__GMP_HAVE_TOKEN_PASTE): New macro. + (__MPN): Use it. + * gmp-impl.h (CNST_LIMB): Ditto. + + * gmp-h.in, mp-h.in (__gmp_const, __gmp_signed, _PROTO, __MPN): Use + ANSI forms on Microsoft C. + (__GMP_HAVE_CONST): New define. + * gmp-impl.h (const, signed): Use it. + + * demos/expr/expr-impl-h.in (): Use this with Microsoft C. + (HAVE_STDARG): New define. + * demos/expr/expr.c,exprz.c,exprq.c,exprf.c,exprfr.c: Use it. + + * acinclude.m4 (GMP_C_STDARG): New macro. + * configure.in: Call it. + * rand.c: Use it. + + * configure.in (AC_PROG_CC_STDC): New test. + +2001-04-25 Kevin Ryde + + * mpn/x86/k6/mmx/dive_1.asm: New file. + * mpn/x86/x86-defs.m4 (Zdisp): Two more insns. + + * mpn/x86/pentium/mul_2.asm: New file. + * mpn/asm-defs.m4: Add define_mpn(mul_2). + * acconfig.h (HAVE_NATIVE_mpn_divexact_1, mul_2): Add templates. + + * configure.in (ABI): Use AC_ARG_VAR. + + * tests/devel/try.c: Run reference function when validate fails. + + * mpq/get_str.c: Fixes for negative bases. + * tests/mpq/t-get_str.c: Check negative bases. + * tests/misc.c,tests.h (__gmp_allocate_strdup, strtoupper): New + functions. + +2001-04-24 Torbjorn Granlund + + * mpz/lcm.c (mpz_lcm): Make result always positive. + + * gmp-h.in (mpz_inp_binary, mpz_out_binary): Remove declarations. + +2001-04-22 Kevin Ryde + + * mpn/powerpc64/addsub_n.asm: Use config.m4 not asm-syntax.m4. + + * mpz/cmp_d.c, mpz/cmpabs_d.c: New files. + * Makefile.am, mpz/Makefile.am: Add them. + * mpf/cmp_d.c, mpf/get_dfl_prec.c: New files. + * Makefile.am, mpf/Makefile.am: Add them. + * gmp-h.in (mpz_cmp_d, mpz_cmpabs_d, mpf_cmp_d, mpf_get_default_prec): + Add prototypes. + * gmp.texi: Add documentation. + + * mpf/set_prc.c: Avoid a realloc call if already the right precision. + + * gmp-impl.h (MPF_BITS_TO_PREC, MPF_PREC_TO_BITS): New macros. + * mpf/get_prc.c, init2.c, set_dfl_prec.c, set_prc.c, set_prc_raw.c: + Use them. + +2001-04-20 Kevin Ryde + + * tests/devel/try.c: Don't test size==0 on mpn_popcount and + mpn_hamdist; add testing for mpn_divexact_1; print some limb values + with mpn_trace not printf. + + * mpz/popcount.c, mpz/hamdist.c: Don't pass size==0 to mpn_popcount + and mpn_hamdist. + * mpn/generic/popham.c: Don't support size==0. + + * config.guess (m68k-*-*): Detect m68010, return m68360 for cpu32, + cleanup the nesting a bit. + + * gmp.texi (Integer Division): Fix mpz_congruent_2exp_p "c" type. + (Integer Division): Add mpz_divexact_ui. + (Number Theoretic Functions): Fix mpz_nextprime return type. + (Exact Remainder): Divisibility tests now implemented. + And more index entries in a few places. + + * tests/mpz/dive_ui.c: New file. + * tests/mpz/Makefile.am (check_PROGRAMS): Add it. + + * mpz/dive_ui.c: New file. + * Makefile.am, mpz/Makefile.am: Add it. + * gmp-h.in (mpz_divexact_ui): Add prototype. + + * tune/many.pl, tune/speed.h: Add special mpn_back_to_back for + development. + + * gmp-impl.h (MPN_DIVREM_OR_DIVEXACT_1): New macro. + * mpz/divexact.c: Use it. + + * gmp-impl.h (DIVEXACT_1_THRESHOLD): New threshold. + * tune/tuneup.c: Tune it. + + * tune/speed.c,speed.h,common.c,many.pl: Add measuring of + mpn_divexact_1, mpn_copyi, mpn_copyd. + + * mpn/generic/dive_1.c: New file. + * configure.in (gmp_mpn_functions): Add it. + * gmp-impl.h (mpn_divexact_1): Add prototype. + * mpn/asm-defs.m4: Add define_mpn(divexact_1). + + * tests/mpn: New directory. + * tests/Makefile.am: Add it. + * tests/mpn/Makefile.am: New file. + * configure.in (AC_OUTPUT): Add it. + * tests/mpn/t-asmtype.c: New file. + + * configure, config.in: Update to autoconf 2.49d. + + * configure.in, gmp-h.in, mp-h.in, demos/expr/expr-impl-h.in: Revert + to generating gmp.h, mp.h and expr-impl.h with AC_OUTPUT and AC_SUBST. + + * configure.in (m68*-*-*): Oops, m683?2 is 68000, m68360 is cpu32. + * mpn/m68k/m68k-defs.m4 (scale_available_p): Ditto. + + * configure.in (underscore, asm_align): Remove these variables, unused. + (GMP_ASM_*): Sort by AC_REQUIREs, to avoid duplication. + * acinclude.m4 (GMP_ASM_UNDERSCORE, GMP_ASM_ALIGN_LOG): Remove support + for actions, no longer needed. + +2001-04-17 Kevin Ryde + + * config.guess (m68k-*-*): Look for cpu in linux kernel /proc/cpuinfo. + + * acinclude.m4 (GMP_GCC_MARCH_PENTIUMPRO): The -mpentiumpro problem is + fixed in 2.95.4, so test for that. + (GMP_ASM_TYPE): Amend some comments. + + * tune/freq.c (speed_cpu_frequency_sysctl): Avoid having unused + variables on GNU/Linux. + + * mpn/asm-defs.m4 (m4_instruction_wrapper): Fix a quoting problem if + the name of the file is a macro. + +2001-04-15 Kevin Ryde + + * mpn/powerpc64/*.asm: Add speeds on ppc630. + + * acconfig.h: Add dummy templates for _LONG_LONG_LIMB and HAVE_MPFR. + * configure.in: Ensure config.in is the last AM_CONFIG_HEADER, + which autoheader requires. + + * mpn/x86/pentium/popcount.asm: New file. + * mpn/x86/pentium/hamdist.asm: New file. + + * mpn/asm-defs.m4: (m4_popcount): New macro. + Amend a few comments elsewhere. + + * acinclude.m4 (GMP_ASM_RODATA): If possible, grep compiler output for + the right directive. + + * tune/speed.c: Print clock speed in MHz, not cycle time. + + * configure.in (AC_CHECK_HEADERS): Check for sys/processor.h. + * tune/freq.c (speed_cpu_frequency_processor_info): Require + to exist, to differentiate the different + processor_info on Darwin. + (speed_cpu_frequency_sysctlbyname): Remove hw.model test which is in + speed_cpu_frequency_sysctl. + (speed_cpu_frequency_sysctl): Add hw.cpufrequency for Darwin. + + * gmp-impl.h (MPN_LOGOPS_N_INLINE, mpn_and_n ... mpn_xnor_n): Use a + single expression argument for the different operations, necessary for + the Darwin "smart" preprocessor. + + * mpn/m68k/t-m68k-defs.pl: Allow white space in m4_definsn and + m4_defbranch. + + * tune/many.pl: Change RM_TMP_S to RM_TMP to match mpn/Makeasm.am, + avoid a possibly undefined array in a diagnostic, add more renaming to + hamdist. + +2001-04-13 Kevin Ryde + + * ltmain.sh, aclocal.m4, configure, config.in: Update to libtool 1.3d. + * configure.in: Change ac_ to lt_ in lt_cv_archive_cmds_need_lc and + lt_cv_proc_cc_pic. + + * config.guess (m68*-*-*): Detect exact cpu with BSD sysctl hw.model, + detect 68000/68010 with trapf, detect 68302 with bfffo. + +2001-04-11 Kevin Ryde + + * acinclude.m4 (GMP_ASM_M68K_INSTRUCTION, GMP_ASM_M68K_ADDRESSING, + GMP_ASM_M68K_BRANCHES): New macros. + * configure.in: Use them, remove old 68k configs, use mc68020 udiv and + umul. + + * mpn/m68k/m68k-defs.m4: New file. + * mpn/m68k/t-m68k-defs.pl: New file. + * mpn/m68k/*.asm: New files, converted from .S. Merge add_n and sub_n + to aors_n, ditto mc68020 addmul_1 and submul_1 to aorsmul_1. No + object code changes (except .type and .size now used on NetBSD 1.4). + * mpn/m68k/README: New file. + * mpn/m68k/*.S, */*.S, syntax.h: Remove files. + + * configure.in (m68*-*-netbsd1.4*): Pretend getrusage doesn't exist. + * tune/README: Update. + + * configure.in (powerpc*-*-*): For the benefit of Darwin 1.3, add cc + to cclist, make gcc_cflags -Wa,-mppc optional. + +2001-04-06 Kevin Ryde + + * mpn/lisp/gmpasm-mode.el (gmpasm-comment-start-regexp): Add | for 68k. + (gmpasm-mode-syntax-table): Add to comments. + + * tests/mpz/reuse.c (dsi_div_func_names): Add names for cdiv_[qr]_2exp. + +2001-04-04 Kevin Ryde + + * acinclude.m4 (GMP_M4_M4WRAP_SPURIOUS): Fix test so as to actually + detect the problem, add notes on m68k netbsd 1.4.1. + + * gmp.texi (Compatibility with older versions): Note libmp + compatibility. + +2001-04-03 Kevin Ryde + + * tests/mpz/reuse.c: Add mpz_cdiv_q_2exp and mpz_cdiv_r_2exp. + + * tests/mpz/t-pow.c: Drag in refmpn.o when testing mpz_pow_ui etc with + refmpn_mul_2. + + * tune/speed.c,speed.h,common.c,many.pl: Add measuring of mpn_com_n + and mpn_mul_2. + * tests/devel/try.c: Add testing of mpn_mul_2, and a + DATA_MULTIPLE_DIVISOR attribute. + + * gmp.texi (Build Options): List more m68k's. + (Build Options): Add cross reference to tex2html. + (Notes for Particular Systems): Add m68k means 68020 or up. + (Rational Conversions): New section, with mpq_get_d, mpq_set_d and + mpq_set_f from Miscellaneous, and new mpq_set_str. + (Applying Integer Functions): Move mpq_get_num, mpq_get_den, + mpq_set_num and mpq_set_den from Misc. + (Miscellaneous Rational Functions): Remove section. + (Custom Allocation): Partial rewrite for various clarifications. + (References): Improve line breaks near URLs. + + * acinclude.m4 (GMP_GCC_M68K_OPTIMIZE): New macro. + * configure.in (m68*-*-*): Use it to run gcc 2.95.x at -O not -O2. + (m680?0-*-*, m683?2-*-*, m68360-*-*): Add optional gcc -m options. + + * tests/mpz/t-cmp.c: New file. + * tests/mpz/t-sizeinbase.c: New file. + * tests/mpz/Makefile.am: Add them. + + * gmp-impl.h (MPN_CMP): New macro. + * mpz/cmp.c,cmpabs.c: Use it, and minor cleanups too. + + * tests/mpq/t-equal.c: New file. + * tests/mpq/t-get_str.c: New file. + * tests/mpq/Makefile.am: Add them. + + * mpq/get_str.c: New file. + * Makefile.am, mpq/Makefile.am: Add it. + * gmp-h.in (mpq_get_str): Add prototype. + + * mpq/equal.c: Rewrite using inline compare loops. + + * tests/refmpn.c,tests.h (refmpn_mul_2): Fix parameter order. + * mpz/n_pow_ui.c: Fix mpn_mul_2 calls parameter order. + +2001-03-29 Kevin Ryde + + * tests/mpf/t-trunc.c: New file. + * tests/mpf/Makefile.am (check_PROGRAMS): Add it. + * gmp-impl.h (MPF_CHECK_FORMAT): New macro. + + * mpf/trunc.c: New file, rewrite of integer.c, preserve prec+1 in + copy, don't copy if unnecessary. + * mpf/ceilfloor.c: New file likewise, and use common subroutine for + ceil and floor. + * mpf/integer.c: Remove file. + * Makefile.am, mpf/Makefile.am, macos/Makefile.in: Update. + + * acinclude.m4 (GMP_GCC_VERSION_GE): New macro. + (GMP_GCC_MARCH_PENTIUMPRO): Use it, remove CCBASE parameter (don't + bother checking it's gcc). + (GMP_GCC_ARM_UMODSI): New macro. + * configure.in (GMP_GCC_MARCH_PENTIUMPRO): Update parameters. + (arm*-*-*): Use GMP_GCC_ARM_UMODSI. + * gmp.texi (Notes for Particular Systems): Add arm gcc requirements. + +2001-03-28 Kevin Ryde + + * gmp.texi (Converting Integers): Document mpz_getlimbn using absolute + value and giving zero for N out of range, move to end of section. + + * tests/refmpn.c (refmpn_tdiv_qr): Use refmpn_divmod_1 rather than + refmpn_divrem_1. + * tests/tests.h: Add some prototypes that were missing. + + * mpz/tdiv_q_ui.c: Remove a comment that belonged to mpz_tdiv_r_ui. + +2001-03-26 Torbjorn Granlund + + * mpn/generic/gcdext.c: Handle carry overflow after m*n multiply code + in both arms. Partially combine multiply arms. + +2001-03-24 Kevin Ryde + + * longlong.h: Add comments to P5 count_leading_zeros. + + * demos/expr/exprz.c,t-expr.c,README: Add congruent_p and divisible_p. + +2001-03-23 Kevin Ryde + + * gmp.texi (GMPceil, GMPfloor, ge, le): New macros. + (Integer Division, mpn_cmp, mpn_sqrtrem, Algorithms): Use them. + (mpn_bdivmod): Refer to mp_bits_per_limb, not BITS_PER_MP_LIMB, and + improve formatting a bit. + (mpn_lshift, mpn_rshift): Clarify the return values, and use {rp,n} + for the destination. + Miscellaneous minor rewordings in a few places. + + * mpn/arm/arm-defs.m4: New file. + * configure.in (arm*-*-*): Use it. + * mpn/arm/*.asm: Use changecom and registers from arm-defs.m4, use L() + for local labels. + + * mpn/x86/k6/mmx/com_n.asm: Relax code alignment (same speed). + + * gmp-h.in (__GMP_ATTRIBUTE_PURE): Use __pure__ to avoid application + namespace. + + * gmp-impl.h (ABS): Add parens around argument. + +2001-03-20 Kevin Ryde + + * acinclude.m4 (GMP_PROG_M4): Use AC_ARG_VAR on $M4. + + * acinclude.m4 (GMP_M4_M4WRAP_SPURIOUS): New macro. + * configure.in: Use it. + * mpn/asm-defs.m4: Ditto. + +2001-03-18 Kevin Ryde + + * mpn/x86/pentium/logops_n.asm: New file. + + * mpn/x86/k6/k62mmx/copyd.asm: Rewrite, smaller and simpler, faster on + small sizes, slower on big sizes (about half the time). + * mpn/x86/k6/k62mmx/copyi.asm: Remove file, in favour of generic x86. + * mpn/x86/copyi.asm: Add some comments. + * mpn/x86/k6/README: Update. + + * mpn/x86/k6/gcd_1.asm: New file. + + * gmp-impl.h (NEG_MOD): Fix type of __dnorm. + + * acinclude.m4 (GMP_C_SIZES): Fix use of __GMP_WITHIN_CONFIGURE. + +2001-03-15 Kevin Ryde + + * gmp.texi (GMPabs): New macro. + (Float Comparison - mpf_reldiff): Use it. + (Integer Comparisons - mpz_cmpabs): Ditto, puts "abs" in info. + (Reentrancy): Update notes on old random functions. + (Karatsuba Multiplication): Better characterize the effect of basecase + speedups on the thresholds, pointed out by Torbjorn. + + * tune/README: Notes on the 1x1 div threshold for mpn_gcd_1. + + * tests/misc.c (mpz_pow2abs_p, mpz_flipbit, mpz_errandomb, + mpz_errandomb_nonzero, mpz_negrandom): New functions. + (mpz_erandomb, mpz_erandomb_nonzero): Use urandom(). + * tests/spinner.c (spinner_wanted, spinner_tick): Make global. + * tests/tests.h: Update prototypes. + + * tests/mpz/t-cong.c, tests/mpz/t-cong_2exp.c: New files. + * tests/mpz/Makefile.am (check_PROGRAMS): Add them. + + * mpz/cong.c, mpz/cong_2exp.c, mpz/cong_ui.c: New files. + * Makefile.am, mpz/Makefile.am: Add them. + * gmp-impl.h (NEG_MOD): New macro. + * gmp-h.in (mpz_congruent_p, mpz_congruent_2exp_p, + mpz_congruent_ui_p): Add prototypes. + * gmp.texi (Integer Division, Efficiency): Add documentation. + + * mpq/aors.c: No need for ABS on denominator sizes. + + * gmp-impl.h (mpn_divisible_p): Use __MPN. + + * gmp-impl.h (LOW_ZEROS_MASK): New macro. + * mpz/divis_ui.c, mpn/generic/divis.c: Use it. + + * mpz/setbit.c: Fix normalization for case of a negative ending up + with a zero high limb. + * tests/mpz/bit.c (check_single): New test for this problem. + + * configure.in (none-*-*): Fix cclist for default ABI=long. + +2001-03-10 Kevin Ryde + + * mpz/cfdiv_q_2exp.c: Don't scan for non-zero limbs if they don't + matter to the rounding. + + * mpz/get_ui.c: Fetch _mp_d[0] unconditionally, so the code can come + out branch-free. + +2001-03-08 Kevin Ryde + + * tests/devel/try.c (param_init): Fix reference functions for and_n + and nand_n. + + * tune/speed.c, tests/devel/try.c: Seed RANDS, not srandom etc. + * configure.in (AC_CHECK_FUNCS): Remove srand48 and srandom. + * macos/configure (coptions): Remove random/srandom, now unnecessary. + + * configure.in (gmp.h, mp.h, demos/expr/expr-impl.h): Generate using + AM_CONFIG_HEADER. + (_LONG_LONG_LIMB, HAVE_MPFR): Change to AC_DEFINEs. + * gmp-h.in, mp-h.in, demos/expr/expr-impl-h.in: Change to #undef's. + * acinclude.m4 (GMP_FUNC_ALLOCA, GMP_C_SIZES): Use gmp-h.in, not gmp.h. + * Makefile.am (EXTRA_DIST): Remove gmp-h.in and mp-h.in, now done + automatically. + * acinclude.m4 (GMP_FUNC_ALLOCA), gmp-impl.h: Set and use + __GMP_WITHIN_CONFIGURE rather than GMP_FUNC_ALLOCA_TEST. + + * mpf/random2.c: Use _gmp_rand and RANDS instead of random() for the + exponent, ensures full range of values too. + + * tests/mpz/t-div_2exp.c (check_various): Start with d based on i, but + don't let it go negative. + + * tune/tuneup.c (KARATSUBA_MUL_THRESHOLD): Limit probing to + TOOM3_MUL_THRESHOLD_LIMIT, the size of the workspace in mul_n.c. + Use a -1 with this too, so size + + * mpn/cray/cfp/mul_1.c: Don't call mpn_add_n with size 0. + * mpn/cray/cfp/addmul_1.c: Likewise. + * mpn/cray/cfp/submul_1.c: Don't call mpn_sub_n with size 0. + + * tests/mpz/t-div_2exp.c (check_various): Start 2nd d loop from 0 + (avoid problems with Cray compilers). + +2001-03-06 Torbjorn Granlund + + * mpn/cray/ieee/submul_1.c: Don't call mpn_sub_n with size 0. + + * mpn/cray/ieee/mul_basecase.c: New file. + * mpn/cray/ieee/sqr_basecase.c: New file, derived from mul_basecase.c. + +2001-03-06 Kevin Ryde + + * tests/devel/try.c (pointer_setup): Allow dst_size == SIZE_SIZE2 for + the benefit of mpn_tdiv_qr. + + * tune/tuneup.c (all): Start karatsuba probing at size==4, for the + benefit of cray t90 ieee which has speed oddities at size==2. + + * gmp-impl.h (USE_LEADING_REGPARM): Use __GMP_GNUC_PREREQ. + Use __GMP_ATTRIBUTE_PURE and ATTRIBUTE_CONST in a few places. + + * gmp-h.in (__GMP_GNUC_PREREQ) New macro. + (__GMP_ATTRIBUTE_PURE): New macro, use it in many places. + + * gmp-impl.h, gmp-h.in (mpn_jacobi_base): Move prototype to + gmp-impl.h, use ATTRIBUTE_CONST. + + * tune/speed.h (speed_cyclecounter): Inline asm version for i386. + + * mpz/cfdiv_r_2exp.c (cfdiv_r_2exp): Only reread "up" after second + realloc, first is under w!=u. + +2001-03-05 Torbjorn Granlund + + * mpn/cray/sub_n.c: Rewrite using `majority' logic. + + * mpz/cfdiv_r_2exp.c (cfdiv_r_2exp): Reread `up' after realloc of w. + + * mpn/cray/ieee/mul_1.c: Rewrite. Streamline multiplications; + use `majority' logic. + * mpn/cray/ieee/addmul_1.c: Likewise. + + * mpn/cray/add_n.c: Rewrite using `majority' logic. + +2001-03-04 Torbjorn Granlund + + * longlong.h (CRAY udiv_qrnnd): No longer conditional on CRAYMPP. + (64-bit hppa add_ssaaaa): New. + (64-bit hppa sub_ddmmss): New. + + * mpn/cray/ieee/invert_limb.c: New file. + + * gmp-impl.h (RANDS): Add a `,0' to make it compile on more compilers. + +2001-03-03 Kevin Ryde + + * mpz/n_pow_ui.c (ULONG_PARITY): Move to gmp-impl.h. + * gmp-impl.h (ULONG_PARITY): i386 part from n_pow_ui.c, new generic + form by Torbjorn. + + * tests/mpz/t-div_2exp.c: New file, rewrite of t-2exp.c. + * tests/mpz/t-2exp.c: Remove file. + * tests/mpz/Makefile.am (check_PROGRAMS): Update. + + * gmp-h.in (mpz_cdiv_q_2exp, mpz_cdiv_q_2exp): Add prototypes. + * gmp.texi (Integer Division): Add mpz_cdiv_q_2exp and mpz_cdiv_q_2exp. + + * mpz/cfdiv_q_2exp.c: New file, partial rewrite of fdiv_q_2exp.c, add + mpz_cdiv_q_2exp entrypoint. + * mpz/cfdiv_r_2exp.c: New file, rewrite of fdiv_r_2exp.c, use all mpn, + add mpz_cdiv_r_2exp entrypoint. + * mpz/fdiv_q_2exp.c, mpz/fdiv_r_2exp.c: Remove files. + * mpz/Makefile.am (libmpz_la_SOURCES): Update. + * Makefile.am (MPZ_OBJECTS): Ditto. + + * gmp-impl.h (USE_LEADING_REGPARM): Use __i386__ same as longlong.h + (REGPARM_2_1, REGPARM_3_1, REGPARM_ATTR): New macros. + * mpz/jacobi.c (jac_or_kron): Use them. + + * configure.in (HAVE_ABI_$ABI): Re-enable this for config.m4, with + dots changed to underscores (necessary for hppa). + + * tests/mpz/t-divis.c, tests/mpz/t-divis_2exp.c: New files. + * tests/mpz/Makefile.am (check_PROGRAMS): Add them. + + * gmp-h.in (mpz_divisible_p, mpz_divisible_ui_p, + mpz_divisible_2exp_p): Add prototypes. + * gmp.texi (Integer Division): Add mpz_divisible_p. + (Efficiency): Add remarks about divisibility testing. + + * mpz/divis.c, mpz/divis_ui.c, mpz/divis_2exp.c: New files. + * mpz/Makefile.am (libmpz_la_SOURCES): Add them. + * Makefile.am (MPZ_OBJECTS): Ditto. + + * mpn/generic/divis.c: New file. + * configure.in (gmp_mpn_functions): Add it. + * mpn/Makefile.am (nodist_libdummy_la_SOURCES): Ditto. + * gmp-impl.h (mpn_divisible_p): Add prototype. + + * urandom.h: Remove file. + * Makefile.am (EXTRA_DIST): Remove it. + + * tests/mpz/convert.c, dive.c, io.c, logic.c, reuse.c, t-2exp.c, + t-fdiv.c, t-fdiv_ui.c, t-gcd.c, t-jac.c, t-mul.c, t-pow.c, + t-powm.c, t-powm_ui.c, t-root.c, t-sqrtrem.c, t-tdiv.c, + t-tdiv_ui.c: Use RANDS, initialized by tests_rand_start. + + * tests/mpz/t-pow.c: New file, being t-pow_ui renamed and with some + further tests added. + * tests/mpz/t-pow_ui.c: Remove file. + * tests/mpz/Makefile.am (check_PROGRAMS): Update. + + * tests/t-modlinv.c: Don't use urandom.h. + * tests/mpz/bit.c, tests/mpz/t-scan.c: Ditto. + * tests/mpq/t-cmp.c, tests/mpq/t-cmp_ui.c, tests/mpq/t-get_d.c: Ditto. + * tests/mpf/reuse.c, t-add.c, t-conv.c, t-dm2exp.c, t-muldiv.c, + t-sqrt.c, t-sub.c: Ditto. + + * tests/misc.c (tests_rand_start, tests_rand_end): New functions. + (tests_start, tests_end): Use them. + (urandom): New function. + * tests/tests.h: Add prototypes. + + * mpz/random.c: Rewrite using mpz_urandomb and RANDS. + * mpn/generic/random.c: Rewrite using _gmp_rand and RANDS. + * mpn/generic/random2.c: Use RANDS not random() etc. + + * gmp-impl.h (__gmp_rands, __gmp_rands_initialized): Add externs. + (gmp_randstate_ptr): New typedef. + (RANDS, RANDS_CLEAR): New macros. + + * rands.c: New file. + * Makefile.am (libgmp_la_SOURCES): Add it. + + * configure.in (mpn_objs_in_libmp): New AC_SUBST. + * Makefile.am (libmp_la_DEPENDENCIES): Use it. + +2001-03-02 Torbjorn Granlund + + * mpn/pa64/udiv_qrnnd.asm: New file. + +2001-03-01 Kevin Ryde + + * mpbsd/rpow.c: New file. + * mpbsd/Makefile.am (libmpbsd_la_SOURCES): Add it + (nodist_libmpbsd_la_SOURCES): Remove pow_ui.c. + * Makefile.am (MPBSD_OBJECTS): Add rpow.lo, remove pow_ui.lo. + (libmp_la_DEPENDENCIES): Add mpz/n_pow_ui.lo. + + * mpz/ui_pow_ui.c: Rewrite using mpz_n_pow_ui. + * mpz/pow_ui.c: Ditto, and no longer provide rpow for mpbsd. + + * mpz/n_pow_ui.c: New file, rewrite of pow_ui.c and ui_pow_ui.c. Use + less temporary memory, strip factors of 2 from the base, use mpn_mul_2 + if available. + * mpz/si_pow_ui.c: New file. + * mpz/Makefile.am (libmpz_la_SOURCES): Add them. + * Makefile.am (MPZ_OBJECTS): Ditto. + * gmp-impl.h (mpz_n_pow_ui): Add prototype. + * gmp-h.in (mpz_si_pow_ui): Add prototype. + * gmp.texi (Integer Exponentiation): Add mpz_si_pow_ui. + + * acinclude.m4 (GMP_C_SIZES): Add BITS_PER_ULONG. + Correction to mp_limb_t working check. + * configure.in (limb_chosen): New variable. + * tests/t-constants.c (BITS_PER_ULONG): Check this value. + Add some reminders about tests that fail on Cray. + + * tests/refmpn.c (refmpn_mul_2): New function. + * tests/refmpz.c (refmpz_pow_ui): Copied from tests/mpz/t-pow_ui.c + * tests/tests.h: Add prototypes. + + * configure.in (none-*-*): Add ABI=longlong. + * doc/configuration (Long long limb testing): Describe it. + + * gmp.texi (Low-level Functions): Move some commented out remarks ... + * mpn/generic/mul_basecase.c: ... to here. + + * mpn/x86/README: Note "%=" as an alternative to "1:" in __asm__. + + * tests/trace.c (mp_trace_start): Print "bin" for binary. + + * mpn/generic/dump.c: Add a couple of casts to keep gcc quiet. + + * gmp-h.in (mpn_incr_u, mpn_decr_u): Add parens around arguments. + + * mpbsd/mout.c, mpbsd/mtox.c (num_to_text): Remove unused variable. + + * mpfr/set_d.c (mpfr_get_d2): Declare "q" for 64-bit limbs. + +2001-02-28 Torbjorn Granlund + + * mpn/pa64w/udiv_qrnnd.asm: Tune. + +2001-02-27 Torbjorn Granlund + + * mpn/pa64w/udiv_qrnnd.asm: New file. + +2001-02-26 Torbjorn Granlund + + * longlong.h (arm): Optimize sub_ddmmss by testing for constant + operands. + * mpn/arm/invert_limb.asm: New file. + +2001-02-24 Torbjorn Granlund + + * mpn/generic/lshift.c: Rewrite. + * mpn/generic/rshift.c: Rewrite. + + * longlong.h: Use UWtype for external interfaces that expect mp_limb_t. + + * longlong.h (arm): #define invert_limb. + + * mpn/arm: Make labels have local scope. + + * configure.in (arm*-*-*): Set extra_functions. + * longlong.h (arm): #define udiv_qrnnd. + * mpn/arm/udiv.asm: New file. + +2001-02-24 Kevin Ryde + + * tune/many.pl: Add mpn_count_leading_zeros, mpn_count_trailing_zeros + and mpn_invert_limb. Add count_leading_zeros, count_trailing_zeros + from a .h file. Correction to modexact_1_odd prototype. Support + ansi2knr. + * tune/speed.h, tune/common.c: Consequent changes. + + * demos/expr/*: Make a few more functions available in expressions, + create only libexpr.a, misc minor updates. + + * mpn/Makeasm.am: Add some comments about suffix ordering. + + * tests/refmpn.c (rshift_make, lshift_make): No need to compare + unsigned to zero. + + * mpq/mul.c: Detect and optimize squaring. + +2001-02-23 Torbjorn Granlund + + * mpn/mips3: Convert files to `.asm'. + + * mpn/arm: Convert files to `.asm'. Misc cleanups. + * mpn/arm/submul_1.asm: New file. + +2001-02-21 Kevin Ryde + + * tune/tuneup.c (all): Only one compiler print should match, no need + for #undef PRINTED_COMPILER. + + * mpfr/mpfr.h (mpfr_sgn): Use mpfr_cmp_ui (patch from Paul). + + * mpz/fib_ui.c: Update some remarks about alternative algorithms. + * gmp.texi (Fibonacci Numbers Algorithm): Ditto. + (Assigning Floats): Clarify mpf_swap swaps the precisions too. + (Low-level Functions): Try to be clearer about negative cofactors. + +2001-02-21 Torbjorn Granlund + + * mpn/sparc64/copyi.asm: Streamline for small operands. + * mpn/sparc64/add_n.asm: Likewise. + * mpn/sparc64/sub_n.asm: Likewise. + + * mpn/sparc64/copyd.asm: New file. + +2001-02-20 Torbjorn Granlund + + * mpn/sparc64/lshift.asm: Rewrite. + * mpn/sparc64/rshift.asm: Rewrite. + +2001-02-19 Torbjorn Granlund + + * mpn/sparc64/add_n.asm: Rewrite using `majority' logic. + * mpn/sparc64/sub_n.asm: Likewise. + + * tune/tuneup.c (all): Recognise DECC and MIPSpro compilers. + + * mpn/pa64/sqr_diagonal.asm: Use PROLOGUE/EPILOGUE. + * mpn/pa642/sqr_diagonal.asm: Likewise. + + * configure.in (HAVE_ABI_$abi): Disable for now. + + * mpn/asm-defs.m4 (PROLOGUE): Use LABEL_SUFFIX. + + * acinclude.m4 (GMP_ASM_ATTR): New check, for hppa oddities. + +2001-02-18 Torbjorn Granlund + + * mpn/hppa/hppa1_1/gmp-mparam.h: New file. + * mpn/hppa/hppa2_0/gmp-mparam.h: New file. + + * mpn/pa64/sqr_diagonal.asm: New file. + * mpn/pa64w/sqr_diagonal.asm: New file. + * mpn/hppa/hppa1_1/sqr_diagonal.asm: New file. + * mpn/hppa/hppa2_0/sqr_diagonal.asm: New file. + + * mpn/sparc32/v9/add_n.asm: Use `fitod' instead of `fxtod' for dummy + FA-pipeline insns. + * mpn/sparc32/v9/sub_n.asm: Likewise. + +2001-02-18 Kevin Ryde + + * gmp.texi (Known Build Problems): Notes on make, $* and K&R, misc + tweaks elsewhere. + (Low-level Functions): Use {} notation in mpn_sqrtrem. + (Basecase Multiplication): Mention BASECASE_SQR_THRESHOLD. + + * mpfr/isnan.c (mpfr_number_p): Infinity is not a number. + * mpfr/out_str.c: Pass strlen+1 for the block size to free. + * mpfr/get_str.c: Correction for realloc to strlen+1. + + * acinclude.m4 (GMP_C_SIZES): Generate an error if mp_limb_t doesn't + seem to work for some reason. + +2001-02-16 Torbjorn Granlund + + * mpn/sparc32/v9/gmp-mparam.h: Retune. + + * mpn/sparc32/v9/add_n.asm: New file. + * mpn/sparc32/v9/sub_n.asm: New file. + + * mpn/sparc32/v9/mul_1.asm: Tune function entry. + * mpn/sparc32/v9/addmul_1.asm: Likewise. + * mpn/sparc32/v9/submul_1.asm: Likewise. + + * mpn/sparc32/v9/sqr_diagonal.asm: New file. + +2001-02-16 Kevin Ryde + + * configure.in: Fix flags selection when $CC is a compiler known to us. + + * demos/expr/exprfr.c (e_mpfr_cos, e_mpfr_sin): mpfr_sin_cos now + allows NULL for one parameter. + + * mpfr/*: Update to 20010215. + * mpfr/trunc.c: Use -DOPERATION scheme, and gmp mpn_zero_p. + * mpfr/sqrt.c: Use plain mpn_sqrtrem, not mpn_sqrtrem_new. + * mpfr/sqrtrem.c: Remove file. + * mpfr/Makefile.am (libmpfr_a_SOURCES): Add isnan.c and set_ui.c, + remove sqrtrem.c and srandom.h. + + * configfsf.guess: Update to 2001-02-13. + * configfsf.sub: Update to 2001-02-16. + * config.sub (j90, t90): Remove special handing, configfsf.sub now ok. + + * Makefile.am (MPF_OBJECTS): Add a couple of missing $U's. + + * tune/tuneup.c: Identify compiler used (GCC and Sun C so far). + +2001-02-15 Torbjorn Granlund + + * mpn/sparc32/v9/mul_1.asm: Change `ld' to `lduw' and `st' to `stw'. + * mpn/sparc32/v9/addmul_1.asm: Likewise. + * mpn/sparc32/v9/submul_1.asm: Likewise. + +2001-02-14 Torbjorn Granlund + + * mpn/mips3/mips.m4: New file. + * configure.in (mips*-*-irix[6789]*): Use mips3/mips.m4. + + * mpn/powerpc64/sqr_diagonal.asm: New file. + + * mpn/mips3/sqr_diagonal.asm: New file. + +2001-02-12 Torbjorn Granlund + + * mpn/powerpc32/sqr_diagonal.asm: New file. + + * mpn/generic/sqr_basecase.c: Remove declaration of mpn_sqr_diagonal. + Fix typo in header comment. + +2001-02-12 Kevin Ryde + + * mpn/generic/mul.c, mpn/generic/mul_n.c, gmp-impl.h: Use + mpn_mul_basecase for squaring below new BASECASE_SQR_THRESHOLD. + * tune/tuneup.c gmp-impl.h: Tune BASECASE_SQR_THRESHOLD. + + * Makefile.am (libgmp.la, libmp.la): Revert change to build from + mpn/libmpn.la etc, go back to explicitly listed objects. + + * configure.in: Recognise sparc64-*-*, not just sparc64-*-linux*. + +2001-02-11 Torbjorn Granlund + + * mpn/asm-defs.m4 (sqr_diagonal): New define_mpn. + + * mpn/alpha/sqr_diagonal.asm: New file. + +2001-02-11 Kevin Ryde + + * gmp.texi (Low-level Functions): Note mpn_get_str clobbers its input + plus 1 extra limb. + + * mpfr/add.c,agm.c,exp2.c,exp3.c,generic.c,log2.c,pi.c,print_raw.c, + set_d.c,sin_cos.c,sqrtrem.c,sub.c: Apply some tweaks for K&R. + * tests/mpz/reuse.c, tests/mpq/t-md_2exp.c, demos/pexpr.c, + demos/expr/t-expr.c: Ditto. + + * configure.in (HAVE_ABI_$abi): New define in config.m4. + + * gmp-impl.h (mpn_sqr_diagonal): Add prototype and define. + * tune/speed.c,speed.h,common.c,many.pl: Add measuring of + mpn_sqr_diagonal. + + * gmp.texi, acinclude.m4: Mention x86 solaris 2.7 has the reg->reg + movq bug the same as 2.6. + + * mpfr/Makefile.am (EXTRA_DIST): Add mpfr-test.h and mpf2mpfr.h. + + * mpn/x86/README: Merge contents of README.family. + * mpn/x86/README.family: Remove file. + + * mpn/Makefile.am (nodist_libdummy_la_SOURCES): Add mode1o, gcd_finda, + invert_limb, sqr_diagonal; remove mod_1_rs; sort alphabetically. + +2001-02-10 Torbjorn Granlund + + * configure.in (gmp_mpn_functions_optional): List sqr_diagonal. + + * mpn/powerpc32/aix.m4: Use unnamed csects. + * mpn/powerpc64/aix.m4: Likewise. + + * acconfig.h: Add #undef of mpn_sqr_diagonal. + Remove lots of spacing. + + * configure.in (syntax testing section): Match power* instead of + powerpc*. + * mpn/power: Convert files to `.asm'. + Prefix umul_ppmm and sdiv_qrnnd. + Update some comments. + +2001-02-09 Kevin Ryde + + * acconfig.h: Add HAVE_NATIVE_mpn_modexact_1_odd and + HAVE_NATIVE_mpn_modexact_1c_odd. + + * configure.in (CCAS): Don't override a user selection. + + * mpq/cmp_ui.c: DIVIDE_BY_ZERO if den2==0. + +2001-02-08 Torbjorn Granlund + + * mpn/generic/sqr_basecase.c: Use mpn_sqr_diagonal when appropriate. + +2001-02-07 Kevin Ryde + + * gmp.texi (Low-level Functions): mpn_preinv_mod_1 now undocumented. + + * mpn/generic/random2.c (myrandom): Use rand() on mingw. + + * mpn/alpha/gmp-mparam.h: Update tuned parameters. + +2001-02-05 Torbjorn Granlund + + * mpn/alpha/ev6/gmp-mparam.h: Retune. + +2001-02-05 Kevin Ryde + + * Makefile.am (libgmp, libmp): Construct from mpn/libmpn.la etc rather + than explicitly listed objects. + + * urandom.h: Use rand() on mingw. + + * mpn/powerpc64/lshift.asm,addsub_n.asm: Use r1 not 1. + +2001-02-04 Torbjorn Granlund + + * mpn/ia64/copyi.asm: New file. + * mpn/ia64/copyd.asm: New file. + +2001-02-04 Kevin Ryde + + * mpn/alpha/ev5/gmp-mparam.h, mpn/mips3/gmp-mparam.h, + mpn/powerpc32/gmp-mparam.h, mpn/powerpc64/gmp-mparam.h, + mpn/sparc64/gmp-mparam.h, mpn/x86/*/gmp-mparam.h: + Update tuned parameters. + + * mpn/x86/i486: New directory. + * configure.in (i486-*-*): Use it. + * mpn/x86/i486/gmp-mparam.h: New file. + + * mpn/x86/pentium/mode1o.asm: New file. + * mpn/x86/p6/mode1o.asm: New file. + + * tune/many.pl: Use $(ASMFLAGS_PIC) and $(CFLAGS_PIC). + + * gmp.texi (Integer Division): Another rewording of 2exp divisions. + +2001-02-03 Torbjorn Granlund + + * mpn/arm/gmp-mparam.h: Tune. + + * mpn/ia64/popcount.asm: Put a `;;' break at end of main loop. + + * configure.in (arm*-*-*): Set gcc_cflags in order to pass + $fomit_frame_pointer. + + * tests/mpz/t-mul.c (base_mul): Remove an unused variable. + +2001-02-02 Torbjorn Granlund + + * demos/pexpr.c (TIME): New macro. + (main): Use TIME--print timing more accurately. + (setup_error_handler): Increase RLIMIT_DATA to 16 Mibyte. + + * longlong.h (arm): Add __CLOBBER_CC to add_ssaaaa and sub_ddmmss. + +2001-02-02 Kevin Ryde + + * configure.in: Don't remove gmp-mparam.h and mpn source links under + --no-create since in that case they're not re-created. + + * demos/expr: New directory. + * Makefile.am (SUBDIRS, allprogs): Add it. + * demos/expr/README, Makefile.am, expr.c, exprv.c, exprz.c, exprza.c, + exprq.c, exprqa.c, exprfa.c, exprf.c, exprfr.c, exprfra.c, expr.h, + expr-impl-h.in, run-expr.c, t-expr.c: New files. + * configure.in: Generate demos/expr/Makefile & demos/expr/expr-impl.h. + + * Makefile.am: Remove mpfr from main libgmp. + * mpfr/Makefile.am: Build and install separate libmpfr.a. + * mpfr/*: Update to mpfr 2001. + + * gmp-h.in (__GNU_MP_VERSION_MINOR): Bump to 2. + * Makefile.am (libtool -version-info): Bump appropriately. + * NEWS: Updates. + + * tune/divrem1div.c, tune/divrem1inv.c, tune/divrem2div.c, + tune/divrem2inv.c: Renamed from divrem_1_div.c, divrem_1_inv.c, + divrem_2_div.c, divrem_2_inv.c, to be unique in DOS 8.3 filenames. + * tune/Makefile.am (libspeed_la_SOURCES): Update. + + * mpn/x86/*/README, mpn/x86/README.family: Misc updates. + * tune/README: Misc updates. + * doc/configuration: Misc updates. + + * mpn/x86/pentium/mmx/gmp-mparam.h: Change UDIV_PREINV_TIME to + UDIV_NORM_PREINV_TIME. + + * mpz/pprime_p.c: Use ASSERT_ALWAYS instead of abort. + + * rand.c (__gmp_rand_lc_scheme): Add "const". + (struct __gmp_rand_lc_scheme_struct): Make astr "const char *". + + * demos/calc/calc.y, demos/calc/calclex.l: Add kron function. + + * tests/devel/try.c: Partial rewrite, new scheme of function types, + allow result validation functions, add sqrtrem and jacobi testing. + * tune/many.pl: Corresponding updates. + * tests/devel/Makefile.am: Add a convenience rule for libtests.la. + + * tests/refmpz.c: New file. + * tests/Makefile.am: Add it. + * tests/misc.c (mpz_erandomb, mpz_erandomb_nonzero): New functions. + * tests/tests.h: Add prototypes. + + * mpn/x86/k6/cross.pl: Add a couple more exceptions. + + * gmp.texi: Don't use @nicode{'\0'}, it doesn't come out right in tex. + (Introduction to GMP): Mention Cray vector systems. + (Build Options): Describe --enable-mpfr, refer to its manual. Add + Crays under supported CPUs. + (Debugging): Add notes on source file paths. + (Autoconf): New section. + (Assigning Integers): Note truncation by mpz_set_d, mpz_set_q and + mpz_set_f. + (Converting Integers): Note the size mpz_get_str allocates. + (Floating-point Functions): Rewrite introduction, clarifying some + points about precision handling. + (Converting Floats): Note the size mpf_get_str allocates, and that it + gives an empty string for zero. Add mpf_get_si and mpf_get_ui. + (Float Comparison): Give the formula mpf_reldiff calculates. + (Miscellaneous Float Functions): Add mpf_integer_p and mpf_fits_*_p. + (Random Number Functions): Misc rewordings for clarity. + (Random State Initialization): Ditto. + (Custom Allocation): Remove note on deallocate_function called with 0, + misc rewording and clarifications. + (Exact Remainder): New section. + (Binary GCD): A few words on initial reduction using division. + (Accelerated GCD): Refer to exact remainder section. + (Extended GCD): Extra remarks on single versus double selection. + (Jacobi Symbol): Update for mpz/jacobi.c rewrite and modexact_1_odd. + (Modular Powering Algorithm): Refer to exact remainder section. + (Assembler SIMD Instructions): Update remarks on MMX. + (Contributors): Amend to "Divide and Conquer" division. + (References): Tweak some formatting. Add "Proof of GMP Fast Division + and Square Root Implementations" by Paul Zimmermann. + +2001-01-31 Torbjorn Granlund + + * configure.in: Don't ever pass -mips3; let ABI flags imply ISA. + +2001-01-31 Kevin Ryde + + * tune/time.c: Remove unnecessary longlong.h. + (speed_endtime): Add some extra diagnostics. + + * tests/mpz/t-fdiv_ui.c, tests/mpz/t-tdiv_ui.c: Use unsigned long for + the divisor, not mp_limb_t. + * tests/mpz/t-jac.c (try_base): Use %llu for long long limb. + * tests/trace.c: Add for strlen. + + * tune/freq.c (speed_cpu_frequency_proc_cpuinfo): Ignore "cycle + frequency" of 0, allow "BogoMIPS" as well as "bogomips". + + * macos/Makefile.in: Add mpf/fits_s.c and mpf/fits_u.c objects. + +2001-01-30 Torbjorn Granlund + + * longlong.h: Add add_ssaaaa and sub_ddmmss for 64-bit sparc. + +2001-01-29 Torbjorn Granlund + + * mpn/powerpc64/addmul_1.asm: Prefix registers with an `r'. + * mpn/powerpc64/submul_1.asm: Likewise. + * mpn/powerpc64/mul_1.asm: Likewise. + + * configure.in (alpha*-*-*): Amend last change to handle pca*. + +2001-01-29 Kevin Ryde + + * tune/speed.h (SPEED_ROUTINE_INVERT_LIMB_CALL): Don't let the + compiler optimize everything away. + + * tune/speed.c, tune/speed.h, tune/common.c, tune/Makefile.am: Measure + operator_div, operator_mod, mpn_divrem_2_div, mpn_divrem_2_inv, + mpn_sb_divrem_m3, mpn_sb_divrem_m3_div, mpn_sb_divrem_m3_inv, + mpn_dc_divrem_sb_div, mpn_dc_divrem_sb_inv. + * tune/divrem_2_div.c, tune/divrem_2_inv.c, tune/sb_div.c, + tune/sb_inv.c: New files. + + * tune/tuneup.c, gmp-impl.h, tune/speed.h, tune/common.c, + tune/Makefile.am: Tune SB_PREINV_THRESHOLD and DIVREM_2_THRESHOLD. + + * mpn/generic/divrem_2.c: Use new DIVREM_2_THRESHOLD. + * mpn/generic/sb_divrem_mn.c: Use new SB_PREINV_THRESHOLD. + + * mpn/x86/p6/mmx/lshift.asm, mpn/x86/p6/mmx/rshift.asm: New files, + just m4 include()ing the P55 code. + * configure.in (pentium[23]-*-*): Remove x86/pentium/mmx from path. + +2001-01-27 Kevin Ryde + + * configure.in (AC_CHECK_FUNCS): Add srand48. + * tune/speed.c: Use this test. + + * acinclude.m4 (GMP_GCC_MARCH_PENTIUMPRO): Allow "egcs-" prefix on gcc + --version, warn if the format is unrecognised. + (GMP_COMPARE_GE): Guard against empty $1 not only on last arg. + (GMP_INIT, GMP_FINISH, GMP_PROG_M4): Obscure or eliminate literal + "dnl"s since autoconf thinks they indicate faulty macros. + + * mpz/get_str.c, mpf/get_str.c: Make allocated string block exactly + strlen(str)+1 bytes. + * mpz/dump.c, mpf/dump.c, tests/mpz/convert.c: Use this size when + freeing. + * tests/mpf/t-conv.c: Ditto, and ensure x==0 is exercised. + + * tests/mpz/t-fits.c: New file. + * tests/mpz/Makefile.am: Add it. + + * tests/mpf/t-fits.c: New file. + * tests/mpf/t-get_si.c: New file. + * tests/mpf/t-int.c: New file. + * tests/mpf/Makefile.am: Add them. + + * mpf/fits_s.c: New file. + * mpf/fits_u.c: New file. + * mpf/get_si.c: New file. + * mpf/get_ui.c: New file. + * mpf/int_p.c: New file. + * Makefile.am, mpf/Makefile.am: Add them. + * gmp-h.in (mpf_fits_*_p, mpf_get_si, mpf_get_ui, mpf_integer_p): Add + prototypes. + + * tests/memory.c (tests_allocate, tests_reallocate): Guard against + size==0. + + * tests/mpz/*.c, tests/mpq/*.c, tests/mpf/*.c: Uses tests_start and + tests_end. + + * gmp-impl.h (USE_LEADING_REGPARM): Fix conditionals. + +2001-01-23 Kevin Ryde + + * configure.in, mpn/Makeasm.am (ASMFLAGS_PIC): New substitution, + allowing -DPIC to be suppressed on cygwin. + (CFLAGS_PIC): New substitution, use it and $(CCAS) directly, rather + than $(LIBTOOL), avoiding a problem with FreeBSD 2.2.8. + + * mpn/x86/k6/mode1o.asm, mpn/x86/k7/mode1o.asm: Remove an unnecessary + +[.-L(here)] from _GLOBAL_OFFSET_TABLE_, avoids a segv from gas 1.92.3. + * mpn/x86/README.family: Add notes on the problem. + +2001-01-20 Torbjorn Granlund + + * configure.in (alpha*-*-*): Default `flavour' to ev4. + +2001-01-19 Kevin Ryde + + * assert.c, gmp-impl.h (__gmp_assert_fail): Change return type to + void, since it's no longer used in expressions. + + * mpn/x86/addsub_n.S: Remove file, since it doesn't work and it upsets + tune/many.pl. + + * mpz/jacobi.c: Rewrite, but still binary algorithm; accept zero and + negative denominators; merge mpz_jacobi and mpz_legendre, add + mpz_kronecker; use mpn directly, add special cases for size==1. + * gmp.texi (Number Theoretic Functions): Update. + * gmp-h.in (mpz_kronecker): Add prototype. + * gmp-impl.h (USE_LEADING_REGPARM): New macro. + * tests/mpz/t-jac.c: Test mpz_kronecker. + * mpz/legendre.c: Remove file. + * Makefile.am, mpz/Makefile.am: Update. + + * longlong.h (alpha count_leading_zeros): Use __attribute__ ((const)) + when possible, add parameter to prototype. + (ia64 udiv_qrnnd): Use for all compilers, not just gcc. + (pentium count_trailing_zeros): Use count_leading_zeros. + + * acinclude.m4 (GMP_C_ATTRIBUTE_CONST, GMP_C_ATTRIBUTE_NORETURN): New + macros. + * configure.in: Use them. + * gmp-impl.h (ATTRIBUTE_CONST, ATTRIBUTE_NORETURN): New macros. + (mpn_invert_limb): Add ATTRIBUTE_CONST. + (__gmp_assert_fail): Add ATTRIBUTE_NORETURN. + +2001-01-18 Kevin Ryde + + * gmp-h.in, gmp-impl.h (__gmp_allocate_func, __gmp_reallocate_func, + __gmp_free_func): Move prototypes from gmp-impl.h to gmp-h.in, for the + benefit of gmp++.h. + + * gmp-impl.h, tests/misc.c, tests/tests.h: Move MPZ_SET_STR_OR_ABORT + and MPF_SET_STR_OR_ABORT to mpz_set_str_or_abort and + mpf_set_str_or_abort in libtests. + * tests/mpz/convert.c, tests/mpz/t-bin.c, tests/mpz/t-get_si.c, + tests/mpz/t-jac.c, tests/mpz/t-misc.c, tests/mpq/t-md_2exp.c, + tests/mpq/t-set_f.c, tests/mpf/t-conv.c, tests/mpf/t-misc.c: Update. + + * mpn/generic/sqrtrem.c: Use MPN_COPY_INCR (for when rp==NULL). + + * tests/mpz/reuse.c: Only run mpz_divexact_gcd on positive divisors. + +2001-01-18 Torbjorn Granlund + + * demos/pexpr.c (main): Accept -vml option. + (fns): List `hamdist', `pow', `nextprime'. + (mpz_eval_expr): Return -1 for `popc' of negative. + (mpz_eval_expr): Handle `hamdist', `pow', `nextprime'. + +2001-01-15 Kevin Ryde + + * mpn/alpha/ev5/mode1o.c: New file. + + * tune/freq.c (speed_cpu_frequency_measure): Check cycles_works_p + before running speed_cyclecounter. + * tune/speed.h (cycles_works_p): Add prototype. + +2001-01-13 Torbjorn Granlund + + * tests/rand/t-rand.c (farr): Fix typo. + (zarr): Fix typo. + +2001-01-12 Kevin Ryde + + * mpz/kronsz.c: Don't depend on right shifting a negative. + + * mpn/x86/gmp-mparam.h: New file. + + * mpn/x86/pentium/mmx/mul_1.asm: New file. + +2001-01-11 Torbjorn Granlund + + * mpz/kronsz.c: Temporary workaround for Cray right shift oddities. + Explicitly compare against zero in tests. + +2001-01-10 Kevin Ryde + + * mpz/kronzs.c: Don't depend on right shifting a negative. + +2001-01-09 Torbjorn Granlund + + * tests/t-constants.c: Disable some undefined tests. + (CHECK_MAX_S): Remove workaround for gcc 2.95.2 bug recently added. + +2001-01-09 Kevin Ryde + + * tests/t-constants.c: Add more diagnostics. + (CHECK_MAX_S): Fix for gcc 2.95.2 -mpowerpc64 -maix64. + + * mpn/x86/k6/mode1o.asm: New file. + * mpn/x86/k7/mode1o.asm: New file. + + * mpn/asm-defs.m4 (modexact_1_odd, modexact_1c_odd): New define_mpn's. + (__clz_tab, modlimb_invert_table, PROLOGUE, EPILOGUE): Add asserts for + GSYM_PREFIX. + * mpn/x86/x86-defs.m4 (Zdisp): Add a movzbl. + + * tests/mpz/t-jac.c (check_a_zero): New test. + (check_squares_zi): Fix to use (a^2/b), not (a*b/b); revert last + change avoiding a,b=0, both are fine. + (try_2den): Don't use mpz_kronecker_ui for the expected answer. + (try_*): Call abort rather than exit. + + * mpz/kronzu.c, mpz/kronzs.c: Fix for a=0. + + * tune/tuneup.c (USE_PREINV_MOD_1): Fix to use new DATA_HIGH_LT_R. + +2001-01-08 Torbjorn Granlund + + * urandom.h: Amend 2000-11-21 change to also handle cygwin. + +2001-01-08 Kevin Ryde + + * tune/many.pl: Updates for move to tests/devel, add modexact_1_odd, + don't assume C files can't have carry-in entrypoints, remove + $(TRY_TESTS_OBJS) now in libtests. + + * tests/devel/try.c, tests/refmpn.c, tests/tests.h: Remove + mpn_mod_1_rshift testing. + + * tune/tuneup.c (fft_step_size): Test for overflow using the actual + mp_size_t, don't use BITS_PER_INT. + + * tune/speed.c (r_string): "r" is a limb, use BITS_PER_MP_LIMB and + change LONG_ONES to LIMB_ONES. + * tune/time.c (M_2POWU): Use INT_MAX rather than BITS_PER_INT. + + * extract-dbl.c (BITS_PER_PART): Use BITS_PER_MP_LIMB not + BITS_PER_LONGINT. + + * mpz/inp_raw.c, mpz/out_raw.c: Add private defines of BITS_PER_CHAR. + * mpz/fac_ui.c, tests/mpz/t-fac_ui.c: Don't use BITS_PER_LONGINT. + * tests/mpz/t-get_si.c: Don't use BITS_PER_LONGINT, do the LONG_MAX + tests with some explicit code. + + * mpn/*/gmp-mparam.h, acinclude.m4, tests/t-constants.c + (BITS_PER_LONGINT, BITS_PER_INT, BITS_PER_SHORTINT, BITS_PER_CHAR): + Remove defines, remove probings, remove tests. + + * tune/tuneup.c (MODEXACT_1_ODD_THRESHOLD): Add tuning. + + * tune/speed.c,speed.h,common.c: Add measuring of mpn_modexact_1_odd, + mpn_gcd_finda, and an "N" form for mpn_gcd_1. + + * tests/mpz/t-jac.c (check_squares_zi): Ensure random a,b != 0. + +2001-01-07 Kevin Ryde + + * configure.in (gmp_mpn_functions): Add mode1o, remove mod_1_rs. + + * mpn/generic/mod_1_rs.c: Remove file, no longer needed. + * gmp-h.in (mpn_mod_1_rshift): Remove prototype and define. + + * mpq/set_f.c: Use MPN_STRIP_LOW_ZEROS_NOT_ZERO. + + * mpz/kronzu.c, mpz/kronzs.c, mpz/kronuz.c, mpz/kronsz.c: Use + mpn_modexact_1_odd, new style MPN_STRIP_LOW_ZEROS_NOT_ZERO, and new + JACOBI macros. Various rearrangements supporting all this. + + * mpn/generic/gcd_1.c: Use mpn_modexact_1_odd, reduce u%v if u much + bigger than v when size==1, some rearrangements supporting this. + + * gmp-impl.h (JACOBI_*): More macros, add some casts to "int". + (MPN_STRIP_LOW_ZEROS_NOT_ZERO): Add a "low" parameter. + (mpn_modexact_1_odd, mpn_modexact_1c_odd): Add prototype and defines. + (MODEXACT_1_ODD_THRESHOLD): New threshold. + (MPN_MOD_OR_MODEXACT_1_ODD, JACOBI_MOD_OR_MODEXACT_1_ODD): New macros. + + * mpn/generic/mode1o.c: New file. + + * tests/mpz/reuse.c: Add testing of mpz_divexact_gcd. + * tests/mpz/t-fac_ui.c: Use libtests for memory leak checking. + * tests/mpz/t-fib_ui.c: Add a usage comment. + + * tests/mpz/bit.c: Use libtests. + * tests/mpz/t-scan.c: Remove unused subroutines. + * tests/devel/try.c: Use libtests, define PROT_NONE if the system + doesn't. + + * tests/spinner.c, tests/x86check.c: Use tests.h. + * tests/trace.c: Use tests.h, add mpf_trace. + * tests/refmpn.c: Use tests.h, add refmpn_malloc_limbs_aligned, + refmpn_tstbit, refmpn_neg. + + * tune/common.c, tune/speed.h: Update for functions moved to + tests/misc.c. + + * tune/Makefile.am, tests/mpz/Makefile.am, tests/mpq/Makefile.am, + tests/mpf/Makefile.am: Use tests/libtests.la. + + * configure.in (AC_OUTPUT): Update for new directories. + (x86 CALLING_CONVENTIONS_OBJS): Use .lo for libtests.la, allow + ansi2knr on x86check.c. + + * tests/Makefile.am: Establish new libtests.la convenience library, + add mpz, mpq, mpf, mpbsd subdirectories. + * tests/tests.h: New file. + * mpn/tests/ref.h,try.h: Remove files, now in tests.h. + + * tests/mpf/ref.c: Move to tests/refmpf.c, rename functions to refmpf. + * tests/mpf/t-add.c, tests/mpf/t-sub.c: Use libtests. + * tests/mpf/Makefile.am: Update. + + * tests/memory.c: New file. + * tests/misc.c: New file, a few subroutines from the test programs. + + * mpz/tests, mpq/tests, mpf/tests, mpbsd/tests: Move directories to + tests/mpz etc. + * mpz/Makefile.am, mpq/Makefile.am, mpf/Makefile.am, mpbsd/Makefile.am + (SUBDIRS): Remove. + + * tests/devel: New directory. + * mpn/tests/*.c: Move programs to tests/devel. + * mpn/tests/Makefile.am, mpn/tests/README: Move to tests/devel, update. + + * mpn/tests/ref.c: Move to tests/refmpn.c. + * mpn/tests/spinner.c,trace.c,x86call.asm,x86check.c: Move to tests + directory. + + * tests/t-constants.c: Add checks of HIGHBIT, MAX and MIN constants, + simplify ANSI vs K&R stringizing, use correct printf format types, do + all tests before aborting. + +2001-01-05 Torbjorn Granlund + + * mpn/cray/ieee/gmp-mparam.h: Retune. + +2001-01-05 Kevin Ryde + + * configure.in (mp.h): Only create this under --enable-mpbsd. + + * demos/calc: New subdirectory, move demos/calc* to it. + * demos/calc/Makefile.am: New file, split from demos/Makefile.am. + * demos/Makefile.am: Update. + * configure.in (AC_OUTPUT): Add demos/calc/Makefile. + + * tests/t-constants.c (CALC_BITS_PER_TYPE etc): Use a run-time test + for how many bits work in a give type, don't assume bits==8*sizeof. + +2001-01-04 Kevin Ryde + + * mpz/fits_s.c, mpz/fits_u.c: New files, split from fits.c, use plain + UINT_MAX etc, not MPZ_FITS_UTYPE_SDT etc. + * mpz/fits.c: Remove file. + * mpz/Makefile.am, macos/Makefile.in: Update. + + * gmp-impl.h (UNSIGNED_TYPE_MAX etc): Remove these generic forms. + (MPZ_FITS_[SU]TYPE_SDT): Remove these. + (UINT_MAX etc): Provide a full set of defaults. + * gmp-h.in (__GMP_MP_SIZE_T_INT): New define. + + * mpz/tests/t-scan.c: New file. + * mpz/tests/Makefile.am (check_PROGRAMS): Add it. + + * mpz/scan0.c, mpz/scan1.c: Rewrite, don't read beyond allocated + memory, support negatives, return ULONG_MAX for no bit found. + * gmp.texi (Integer Logic and Bit Fiddling): Update. + +2001-01-03 Torbjorn Granlund + + * mpz/tests/dive.c: Generate test operands using new random functions. + * mpz/tests/io.c: Likewise. + * mpz/tests/logic.c: Likewise. + * mpz/tests/t-2exp.c: Likewise. + + * stack-alloc.c (__gmp_tmp_alloc): Round `now' to required alignment. + + * stack-alloc.h (__TMP_ALIGN): Append `L'. + + * gmp-impl.h: For Cray, #include limits.h. + (LONG_MIN): New #define. + (ULONG_HIGHBIT): #define in terms of ULONG_MAX. + (LONG_HIGHBIT): #define as LONG_MIN. + (USHRT_MAX): New name for USHORT_MAX. + (SHRT_MAX): New name for SHORT_MAX. + (SHRT_MIN): New #define. + (USHORT_HIGHBIT,SHORT_HIGHBIT): Removed. + + * mpbsd/tests/t-misc.c (check_itom [data]): *SHORT* => *SHRT*; + remove code disabling a test for Cray. + + * tests/t-constants.c (CHECK_CONSTANT): Cast parameters to long. + + * mpn/generic/mul_n.c (mpn_kara_sqr_n): Remove unused variable `t'. + (mpn_kara_mul_n): Likewise. + + * mpz/fac_ui.c (MPZ_SET_1_NZ): Actually use `__z'. + + * mpz/tests/t-jac.c + (main, check_squares_zi): Generate test operands using new random + functions. + + All changes below on this date for enabling `make; make check' + with C++ compilers: + + * mpz/tests/t-pow_ui.c (debug_mp, ref_mpz_pow_ui): Provide prototypes. + + * mpz/tests/t-mul.c (debug_mp, base_mul, ref_mpz_mul): + Provide prototypes. + (dump_abort): Provide prototype and declare properly for C++. + + * mpz/tests/t-jac.c: #include stdlib.h and sys/time.h. + + * mpz/tests/t-fdiv.c + (dump_abort): Provide prototype and declare properly for C++. + (debug_mp): Provide prototype. + * mpz/tests/t-fdiv_ui.c: Likewise. + * mpz/tests/t-gcd.c: Likewise. + * mpz/tests/t-powm.c: Likewise. + * mpz/tests/t-powm_ui.c: Likewise. + * mpz/tests/t-sqrtrem.c: Likewise. + * mpz/tests/t-tdiv_ui.c: Likewise. + * mpz/tests/t-tdiv.c: Likewise. + + * mpz/tests/t-2exp.c: #include stdlib.h and sys/time.h. + Remove #include of longlong.h. + + * mpz/tests/io.c: #include config.h, stdlib.h, sys/time.h, and + conditionally unistd.h. + + * mpz/tests/dive.c: #include stdlib.h and sys/time.h. + (dump_abort): Provide prototype and declare properly for C++. + (debug_mp): Provide prototype. + * mpz/tests/logic.c: Likewise. + + * mpz/tests/convert.c (debug_mp): Provide prototype. + * mpz/tests/t-root.c (debug_mp): Likewise. + + * mpz/tests/bit.c: #include stdlib.h and sys/time.h. + + * mpq/tests/t-get_d.c: #include stdlib.h and sys/time.h. + (dump): Provide prototype and declare properly for C++. + + * mpq/tests/t-cmp_ui.c: #include stdio.h, stdlib.h and sys/time.h. + (ref_mpq_cmp_ui): Declare properly for C++. + + * mpq/tests/t-cmp.c: #include stdlib.h and sys/time.h. + (ref_mpq_cmp): Declare properly for C++. + (dump): Delete unused function. + + * mpf/random2.c (myrandom): New function. + (mpf_random2): Use it. + + * mpn/generic/random2.c: #include stdlib.h (for random/mrand48). + (myrandom): New function. + (mpn_random2): Use it. + + * mpf/tests/t-add.c: #include stdlib.h and sys/time.h. + (oo): Remove unused function. + * mpf/tests/t-conv.c: Likewise. + * mpf/tests/t-sub.c: Likewise. + * mpf/tests/t-dm2exp.c: Likewise. + * mpf/tests/t-muldiv.c: Likewise. + * mpf/tests/t-sqrt.c: Likewise. + + * mpf/tests/reuse.c: #include stdlib.h and sys/time.h. + Use PROTO on some typedefs. + (oo): Remove function. + (dump_abort): Call mpf_dump instead of oo. + + * mpf/set_str.c: #include stdlib.h (for strtol). + + * mpf/random2.c: #include stdlib.h (for random/mrand48). + * mpn/alpha/udiv_arnnd: File deleted. + + * Remove K&R function headers. + +2001-01-02 Torbjorn Granlund + + * mpn/generic/mul.c: Clean up spacing and indentation. + + * mpn/generic/mul_fft.c (mpn_fft_add_modF): Use mpn_decr_u. + Clean up spacing and indentation. + + * extract-dbl.c: Generalize to handle smaller limb sizes. + +2001-01-01 Torbjorn Granlund + + * mpbsd/mout.c: Output newline after "0". + +2000-12-31 Torbjorn Granlund + + * ltmain.sh: Remove space between `#!' and `$SHELL' when generating + `libtool'. + + * mpbsd/tests/t-misc.c (check_itom): Exclude test for all Cray + vector systems. Correct comment. + +2000-12-31 Kevin Ryde + + * gmp.texi (ABI and ISA): New enough gcc needed for mips n32 etc, gcc + 2.95 needed for sparc 64-bit ABI, gcc 2.8 needed for -mv8plus. + + * configure.in ([cjt]90,sv1-cray-unicos*): Preserve user specified + MPN_PATH, amend test program indenting. + (none-*-*): Add -DNO_ASM to gcc to disable longlong.h asm macros in + generic C. + + * config.sub (j90, t90): Preserve these, don't let configfsf.sub turn + them into c90. + + * config.guess (m68k-*-nextstep*,m68k-*-openstep*): Don't transform + m68k to m68020, since m68k is already interpreted as 68020. + +2000-12-30 Kevin Ryde + + * mpq/neg.c: Rewrite, use mpn, avoid denominator copy if unnecessary. + + * mpz/tstbit.c: Rewrite, slightly simplified. + * mpz/tests/bit.c (check_tstbit): New test, and add a couple more + diagnostics elsewhere. + + * configure.in (x86 gcc_cflags_cpu): Add -m486 for gcc 2.7.2. + (ccbase): Only use a known compiler in eval statements (avoids + problems with non-symbol characters). + (ccbase): Use GMP_PROG_CC_IS_GNU to identify gcc installed under a + different name. + (cclist): Use same style $abi as other variables. + + * acinclude.m4 (GMP_PROG_CC_IS_GNU): New macro. + (GMP_GCC_MARCH_PENTIUMPRO): Use $ccbase to identify gcc. + (GMP_ASM_TYPE): Define TYPE to empty, not "dnl", when no .type needed. + (GMP_ASM_SIZE): Ditto for SIZE, which ensures EPILOGUE on the last + line of a file doesn't leave a tab and no newline. + (GMP_ASM_UNDERSCORE): Add a prototype for C++. + + * configure.in (sys/mman.h, mprotect): New tests. + * mpn/tests/try.c: Use them, and HAVE_UNISTD_H too. + + * configure.in (getopt.h): Remove test. + * tune/speed.c, mpn/tests/try.c (getopt.h): Remove include, since + plain getopt() is in . + + * configure.in, gmp-h.in (mips*-*-irix6*): Set limb_n32=longlong + rather than using _ABIN32. + +2000-12-29 Torbjorn Granlund + + * mpz/tests/reuse.c: Rename dump_abort => dump. + * mpz/tests/reuse.c: Generate operands using gmp_rand*. + * mpz/tests/convert.c: Likewise. + + * configure.in: Detect T90-ieee systems; move Cray path + selection to after AC_PROG_CC. Invoke AC_PROG_CPP. + * mpn/cray/cfp: New directory. Move cfp specific files here. + * mpn/cray/cfp/mulwwc90.s: New file. + * mpn/cray/cfp/mulwwj90.s: New file. + * mpn/cray/mulww.s: Delete. + +2000-12-27 Torbjorn Granlund + + * mpn/cray/ieee/mul_1.c: New file. + * mpn/cray/ieee/addmul_1.c: New file. + * mpn/cray/ieee/submul_1.c: New file. + * mpn/cray/ieee/gmp-mparam.h: New file. + + * mpn/cray/gmp-mparam.h: Disable UMUL_TIME and UDIV_TIME. + + * mpn/cray/hamdist.c: New file. + * mpn/cray/popcount.c: New file. + * mpn/cray/rshift.c: New file. + * mpn/cray/lshift.c: New file. + + * longlong.h: Add count_leading_zeros for _CRAY. + Reorganize _CRAY stuff. + +2000-12-24 Kevin Ryde + + * configure.in (alpha*-cray-unicos*): Disable SPEED_CYCLECOUNTER_OBJ, + as tune/alpha.asm doesn't suit. + + * mpn/generic/sqrtrem.c, mpz/pow_ui.c, mpz/powm_ui.c, mpf/get_str.c, + mpf/set_str.c: Use mpn_sqr_n when applicable, not mpn_mul_n. + +2000-12-23 Torbjorn Granlund + + * mpn/generic/mul_fft.c: Reformat. + (mpn_fft_neg_modF): Remove. + (mpn_fft_mul_2exp_modF): Inline mpn_fft_neg_modF. + + * mpn/cray/gmp-mparam.h: Retune. + + * configure.in (*-cray-unicos*): Pass `-O3 -htask0'. + (vax*-*-*): Fix typo. + + * mpn/cray/mul_1.c: Use dynamic arrays, get rid of TMP_*. + * mpn/cray/addmul_1.c: Likewise. + * mpn/cray/submul_1.c: Likewise. + * mpn/cray/add_n.c: Likewise. + * mpn/cray/sub_n.c: Likewise. + + * configure.in (default cc_cflags,cc_64_cflags): Remove -g/add -O. + (mips*-*-irix[6789]*]): Remove -g from cc_*_cflags. + +2000-12-22 Torbjorn Granlund + + * mpn/generic/mul_n.c: Delete K&R function headers. + + * mpn/generic/mul_n.c (mpn_kara_mul_n): Clean up type confusion + between mp_limb_t and mp_size_t. + (mpn_kara_sqr_n): Likewise. + + * mpn/generic/mul_n.c (mpn_kara_mul_n): Use mpn_incr_u. + (mpn_kara_sqr_n): Likewise. + + * mpn/generic/mul_n.c (mpn_kara_mul_n): Change handling of `sign' + to work around GCC 2.8.1 MIPS bug. + + * configure.in (implied alpha*-cray-unicos*): Remove -g from cc_cflags. + +2000-12-21 Torbjorn Granlund + + * mpn/alpha/invert_limb.asm: Simplify a bit. + Add handling of bigend systems. + * mpn/alpha/unicos.m4: Define `bigend'. + * mpn/alpha/default.m4: Define `bigend' (to expand to nothing). + + * tests/t-constants.c (CHECK_CONSTANT): Print using %lx. + + * mpn/alpha/gmp-mparam.h: Remove sizes for plain C types. + * mpn/alpha/ev5/gmp-mparam.h: Likewise. + * mpn/alpha/ev6/gmp-mparam.h: Likewise. + + * mpn/alpha/unicos.m4: Define LEA. + * mpn/alpha/default.m4: Likewise. + * mpn/alpha/invert_limb.asm: Use LEA for loading symbolic addresses. + * mpn/alpha/cntlz.asm: Likewise. + + * mpn/alpha/cntlz.asm: Don't use `ldbu', use slightly slower + `ldq_u' + `extbl' instead. + + * mpn/alpha/unicos.m4: Define EXTERN. + * mpn/alpha/default.m4: Define EXTERN (to expand to nothing). + * mpn/alpha/cntlz.asm: Declare __clz_tab usign `EXTERN' (for the + benefit of Unicos). + +2000-12-21 Kevin Ryde + + * mpn/alpha/unicos.m4 (GSYM_PREFIX): Define for the benefit of + __clz_tab. + +2000-12-20 Torbjorn Granlund + + * longlong.h: Add udiv_qrnnd and count_leading_zeros for _CRAYMPP + systems. + +2000-12-19 Torbjorn Granlund + + * configure.in (*sparc*-*-*): Remove -g from cc_cflags and acc_cflags. + + * mpn/generic/sqrtrem.c (mpn_sqrtrem): Separate `limb' values from + `size' values. + + * configure.in (*-cray-unicos*): Add `-Wa,-B' to cc_cflags. + + * demos/pexpr.c (rstate): New variable. + (main): Initialize rstate. + (enum op_t): Add RANDOM. + (fns): Add field for RANDOM. + (mpz_eval_expr): Handle RANDOM. + +2000-12-19 Kevin Ryde + + * mpn/generic/sqrtrem.c: Rewrite by Paul Zimmermann, based on his + Karatsuba Square Root algorithm. + * gmp.texi (Square Root Algorithm): Update. + + * tune/many.pl: New file. + + * mpn/tests/try.c,ref.[ch] (mpn_preinv_mod_1, mpn_sb_divrem_mn, + mpn_tdiv_qr, mpn_gcd_finda, mpn_kara_mul_n, mpn_kara_sqr_n, + mpn_toom3_mul_n, mpn_toom3_sqr_n): Add testing. + * mpn/tests/ref.c: Cast some "0"s in function calls. + + * mpn/x86/k7/mmx/mod_1.asm: Add preinv_mod_1 entrypoint, remove extra + variable for loop termination. + + * mpn/x86/p6/mmx/mod_1.asm: Remove file, in favour of the following. + * mpn/x86/p6/mod_1.asm: New file. + + * mpn/x86/pentium/mod_1.asm: New file. + +2000-12-18 Torbjorn Granlund + + * configure.in (mips*-*-irix[6789]*): Pass options to compiler using + `-Wc'. + +2000-12-18 Kevin Ryde + + * mpn/x86/k6/pre_mod_1.asm: New file. + + * tune/tuneup.c (USE_PREINV_MOD_1): Tune this, rearrange mpn_divrem_1 + and mpn_mod_1 handling in support of it. + * tune/Makefile.am: Consequent changes to divrem_1.c and mod_1.c. + + * gmp-impl.h (USE_PREINV_MOD_1, MPN_MOD_OR_PREINV_MOD_1): New macros. + * mpn/generic/perfsqr.c, mpz/pprime_p.c: Use MPN_MOD_OR_PREINV_MOD_1. + + * configure.in: Let an asm mod_1 provide a preinv_mod_1 entrypoint. + + * mpn/alpha/default.m4: Remove some newlines, add some asserts. + (r0 etc, f0 etc): Use defreg and deflit. + (PROLOGUE, PROLOGUE_GP, EPILOGUE): Use GSYM_PREFIX. + * mpn/alpha/unicos.m4: Remove some newlines, add some asserts. + * mpn/alpha/invert_limb.asm: Remove unused second DATASTART parameter. + * mpn/alpha/cntlz.asm: Use mpn_count_leading_zeros and __clz_tab. + + * mpn/asm-defs.m4 (changecom): Comments on portability. + (__clz_tab, modlimb_invert_table): New macros, matching gmp-impl.h. + (count_leading_zeros, count_trailing_zeros): New define_mpn's. + (PROLOGUE etc): Comments on usage, add some asserts. + (OPERATION_[lr]shift): Use m4_not_for_expansion, for the benefit of + lorrshift multifunc. + + * mpn/Makeasm.am (RM_TMP): New variable controlling tmp-*.s + removal, for development purposes. + + * mpz/fac_ui.c: Fix for long long limb by using mpn_mul_1 not + mpz_mul_ui, and note some possible enhancements. + + * mpz/tests/t-fac_ui.c: New test. + * mpz/tests/Makefile.am (check_PROGRAMS): Add it. + * macos/Makefile.in: Ditto, and add t-fib_ui too. + + * mpn/generic/[lr]shift.c: Remove some DEBUG code adequately covered + by new parameter ASSERTs. + + * longlong.h (count_trailing_zeros): Assert x!=0. + + * doc/configuration: Updates for new configure things, add some notes + on test setups. + +2000-12-16 Torbjorn Granlund + + * configure.in (*-*-aix): Pass -qmaxmem=20000 to xlc also for 64-bit + compiles. + * configure.in: Disable shared libs for *-*-ultrix*. + +2000-12-15 Torbjorn Granlund + + * configure.in (powerpc*-*-*): Pass -Wa,-mppc when using gcc. + + * gmp-impl.h (_EXTERN_INLINE): #define different for GCC and other + compilers. + + * gmp-h.in (__gmp_inline): Remove. + * mp-h.in: Likewise. + * mpn/generic/gcd.c: Use `inline' instead of `__gmp_inline'. + + * configure.in (mips*-*-irix[6789]*): Define *_ldflags. + +2000-12-14 Torbjorn Granlund + + * mpn/generic/pre_mod_1.c: Use proper type for udiv_qrnnd + parameter `dummy'. + + * mpn/generic/divrem_1.c: Use explicit `!= 0' in if statement. + * mpn/generic/mod_1.c: Likewise. + +2000-12-14 Kevin Ryde + + * config.guess (mips-*-irix[6789]*): Transform to mips64. + (m68k-*-nextstep* | m68k-*-openstep*): Transform to m68020. + +2000-12-13 Torbjorn Granlund + + * tests/t-constants.c (main): Conditionalize use of PP_INVERTED. + + * mpn/mp_bases.c: Handle 4-bit limbs. + (main): Add code for generating tables. + + * mpn/generic/popham.c: Handle limb bitsizes of 4, 8, 16. + Suffix all 32-bit constant with `L'. + Use CNST_LIMB for 64-bit constants. + +2000-12-13 Kevin Ryde + + * gmp-impl.h (FIB_THRESHOLD): Defaults for 4,8,16 bits per limb, and + an arbitrary fallback default. + (modlimb_invert): Add efficient code for 8,16 (or 4) bits per limb. + + * configure.in (mips3, mips64): Don't bother with o32 (mips2 32-bit + limb) on IRIX 6. + + * Makefile.am (SUBDIRS): Put "tests" first so tests/t-constants.c is + run first, to pick up any limb size mismatch. + + * tune/tuneup.c (DIVREM_1, MOD_1): Fix result values, were off by 1. + + * mpz/fib_ui.c (table1, table2): Add data for 4,8,16 bits per limb. + +2000-12-12 Torbjorn Granlund + + * gmp-impl.h (LIMBS_PER_DOUBLE): Define for any limb bitsize. + +2000-12-11 Torbjorn Granlund + + * mpn/mp_bases.c: Add tables for 8-bit and 16-bit limbs. + Round existing `double' values properly. + + * gmp-h.in (__gmp_randstate_struct): Prefix field names with _mp_ + to keep out of user name space. + (__gmp_randata_lc): Likewise. + * randclr.c, randlc.c, randlc2x.c, randraw.c, randsd.c, randsdui.c: + Corresponding changes. + + * gmp-impl.h (PP): #define for machines with BITS_PER_MP_LIMB + of 2, 4, 8, and 16. + (PP_FIRST_OMITTED): New, define for various BITS_PER_MP_LIMB. + (PP_MASK): Remove. + (PP_MAXPRIME): Remove. + + * mpn/generic/perfsqr.c: Generalize PP handling for machines with + limbs of < 32 bits. Allow PP_INVERTED to be undefined. + * mpz/pprime_p.c: Likewise. + +2000-12-10 Torbjorn Granlund + + * mpn/generic/mul_1.c: Declare parameters in C89 style. + +2000-12-10 Kevin Ryde + + * tune/Makefile.am (speed_LDFLAGS, speed_ext_LDFLAGS, tune_LDFLAGS): + Don't use -all-static, as gcc 2.95.2 on i386 solaris 8 doesn't like + it. + + * configure.in (mips3,mips64): Add ABI=64, name the others ABI=n32 and + ABI=o32. + * mpn/mips3/gmp-mparam.h (BITS_PER_LONGINT): Remove #define and let + configure determine it, since it varies with ABI=64 or ABI=n32. + * gmp.texi (ABI and ISA): Update. + (mpz_mod_ui): Remark that it's identical to mpz_fdiv_r_ui. + (mpn_divexact_by3): Qualify a statement needing mp_bits_per_limb even. + + * mul_fft.c (mpn_fft_mul_modF_K etc): Patch by Paul Zimmermann to fix + results in certain cases of recursing into a further FFT. + +2000-12-09 Torbjorn Granlund + + * mpz/cmpabs.c: Remove unused variable. + * mpz/rrandomb.c: Likewise. + * mpz/xor.c: Likewise. + +2000-12-07 Torbjorn Granlund + + * mpn/generic/gcdext.c: Handle double carry when computing s1. + Merge two code blocks for computing s0 and s1. + +2000-12-07 Kevin Ryde + + * configure.in (hppa*-*-*): Remove -Aa -D_HPUX_SOURCE from + cc_cflags/cppflags, and instead let AM_C_PROTOTYPES add it, or -Ae, + whichever works. + + * configure.in (*-*-aix[34]*): Disable shared by default, but let + the user override that, if desired. + * gmp.texi (Notes for Particular Systems): Update. + +2000-12-06 Torbjorn Granlund + + * mpq/cmp_ui.c: Streamline. + +2000-12-06 Kevin Ryde + + * tune/divrem_1_div.c,divrem_1_inv.c,mod_1_div.c,mod_1_inv.c, + gcdext_double.c: New files for measuring. + * tune/Makefile.am (libspeed_la_SOURCES): Add them. + * tune/speed.c,speed.h,common.c: Add measuring of them. + (mpn_preinv_mod_1, mpz_jacobi, mpz_powm_ui): Add measuring. + + * speed.c (getopt_long): Don't use this, just plain getopt. + * configure.in (getopt_long): Remove test. + + * gmp-impl.h (MPN_KARA_MUL_N_TSIZE, MPN_KARA_MUL_N_MINSIZE, + MPN_TOOM3_MUL_N_TSIZE, MPN_TOOM3_MUL_N_MINSIZE): New macros, and + assume toom3 square tsize was meant to be the same as the mul (both + are overestimates). + * tune/tuneup.c, mpn/generic/mul.c, mpn/generic/mul_n.c: Use them. + * mpn/generic/mul_n.c (mpn_toom3_sqr_n): Fix an ASSERT to use + TOOM3_SQR_THRESHOLD not TOOM3_MUL_THRESHOLD, add a few that might + be more realistic size checks. + * tune/speed.h (SPEED_ROUTINE_MPN_MUL_N_TSPACE etc): Use minsize. + + * mpn/generic/divrem_1.c: Partial rewrite, merge fractional part + calculation, skip a divide step in more cases, introduce + DIVREM_1_NORM_THRESHOLD and DIVREM_1_UNNORM_THRESHOLD. + * mpn/generic/mod_1.c: Partial rewrite, skip a divide step in more + cases, introduce MOD_1_NORM_THRESHOLD, MOD_1_UNNORM_THRESHOLD. + * longlong.h (UDIV_PREINV_ALWAYS): New define, set for alpha and ia64. + * tune/tuneup.c (DIVREM_1_NORM_THRESHOLD, DIVREM_1_UNNORM_THRESHOLD, + MOD_1_NORM_THRESHOLD, MOD_1_UNNORM_THRESHOLD): Tune these. + * gmp-impl.h [TUNE_PROGRAM_BUILD]: Support for this. + * tune/Makefile.am (TUNE_MPN_SRCS): Add divrem_1.c and mod_1.c. + + * gmp-impl.h (UDIV_NORM_PREINV_TIME): Renamed from UDIV_PREINV_TIME. + * mpn/generic/perfsqr.c, mpn/generic/sb_divrem_mn.c, + mpn/x86/*/gmp-mparam.h: Ditto. + * gmp-impl.h (UDIV_UNNORM_PREINV_TIME): New define. + + * configure.in (AC_C_INLINE, HAVE_INLINE): New test and define. + * gmp-impl.h (inline): Remove, use config.h. + (_EXTERN_INLINE): Redefine based on HAVE_INLINE. + (mpn_zero_p): Use HAVE_INLINE. + + * acinclude.m4 (GMP_PROG_AR, GMP_PROG_NM): Don't add flags to a user + selected $AR or $NM. + + * tune/tuneup.c (all): Print how long the tuning took. + + * configure.in (AM_C_PROTOTYPES): Use this, not GMP_ANSI2KNR. + * acinclude.m4 (GMP_ANSI2KNR): Remove. + + * Makefile.am (gmp.h, mp.h): In DISTCLEANFILES not CLEANFILES. + + * gmp-h.in (mpn_divmod, mpn_divmod_1, mpn_divexact_by3): Cast some + zeros, for the benefit of K&R if long!=int. + + * mpn/lisp/gmpasm-mode.el (gmpasm-comment-start-regexp): Add "*" for + the benefit of cray. + + * compat.c (mpn_divexact_by3, mpn_divmod_1): Return types should be + mp_limb_t, not int, and need an actual "return". + +2000-12-05 Torbjorn Granlund + + * mpn/sparc32/v8/supersparc/gmp-mparam.h: Retune. + * mpn/alpha/gmp-mparam.h: Tune for 21064. + + * longlong.h: Reformat to avoid newlines within strings. + + * gmp-impl.h (inline): Disable if GCC has defined __STRICT_ANSI__. + + * configure.in: Do a `mkdir tune' before creating tune/sqr_basecase.c. + + * Makefile.am: Treat mp.h analogously to gmp.h. + + configure.in (*-*-aix): Pass -qmaxmem=20000 to xlc. + + * mp-h.in: Renamed from mp.h. + Add #define for _LONG_LONG_LIMB. + Move some other fixes from gmp-h.in. + * mp.h: Removed. + * configure.in: Generate mp.h from mp-h.in like we handle + gmp-h.in/gmp.h. + +2000-12-04 Torbjorn Granlund + + * acinclude.m4: Fix typo testing for bad HP compiler. + +2000-12-03 Torbjorn Granlund + + * mpbsd/tests/t-misc.c (check_itom): Exclude some tests for Cray + CFP systems. + + * longlong.h (CRAYIEEE umul_ppmm): New. + + * mpn/cray/gmp-mparam.h (BITS_PER_SHORTINT): 32 => 64. + (*_THRESHOLD): Tune. + + * configure.in: Disable shared libs for *-*-unicos*. + +2000-12-03 Kevin Ryde + + * configure.in, tune/Makefile.am: Create tune/sqr_basecase.c during + configure, and use it unconditionally in $(nodist_tuneup_SOURCES). + Fixes a problem with sqr_basecase.lo under --disable-static. + +2000-12-01 Torbjorn Granlund + + * mpf/tests/t-get_d.c (LOW_BOUND,HIGH_BOUND): #define for non-IEEE + Cray systems. + + * gmp-impl.h (union ieee_double_extract): Test for _CRAYIEEE. + +2000-11-30 Torbjorn Granlund + + * mpz/tests/t-mul.c (base_mul): Fix re-evaluation problems in macro + invocations. + (ref_mpz_mul): New name from mpz_refmul. Make static. + (base_mul): New name for _mpn_mul_classic. + +2000-11-30 Kevin Ryde + + * configure.in: Rewrite of CC/CFLAGS selection scheme, introduce a + notion of ABI, merge compiler and mpn path selection, add flags + selection for AR and NM, let CC without CFLAGS work. + (AC_PROG_CC): Use this, not GMP_SELECT_CC. + * acinclude.m4 (GMP_PROG_CC_WORKS): Don't use AC_TRY_COMPILE, combine + cc/cflags parameter. + (GMP_PROG_CC_FIND, GMP_CHECK_CC_64BIT, GMP_PROG_CC_SELECT): Remove. + * gmp.texi (Installing GMP): Updates for new scheme. + + * configure.in (AC_CANONICAL_HOST): Use this and $host, not $target. + * acinclude.m4, acconfig.h, longlong.h, mpn/x86/x86-defs.m4, + mpn/x86/k7/mmx/popham.asm: Ditto, renaming HAVE_TARGET_CPU to + HAVE_HOST_CPU. + * gmp.texi (Build Options, and elsewhere): Update. + + * acinclude.m4 (GMP_COMPARE_GE): New macro. + (GMP_GCC_MARCH_PENTIUMPRO): Use it, add CC parameter, check for GCC. + (GMP_HPC_HPPA_2_0): New macro, adapted from GMP_CHECK_CC_64BIT. + + * acinclude.m4 (GMP_PROG_AR): New macro, using AC_CHECK_TOOL, adding + GMP flags. + * configure.in: Use it + + * gmp-h.in: Renamed from gmp.h. + (@define_LONG_LONG_LIMB@): Placeholder for instantiation. + (__GNU_MP__): Bump to 3. + * acinclude.m4 (GMP_VERSION): Get version from gmp-h.in. + * configure.in: Create gmp.h from gmp-h.in to set _LONG_LONG_LIMB. + * gmp.texi.h (ABI and ISA): Mention this. + * acconfig.h (_LONG_LONG_LIMB): Remove undef. + * Makefile.am: Distribute gmp-h.in, not gmp.h. + + * configure.in (AC_PROG_CPP, AC_PROG_INSTALL, AC_PROG_LN_S): Remove, + dragged in by other macros. + (gmp_asm_syntax_testing): Renamed from gmp_no_asm_syntax_testing. + (AC_EXEEXT, AC_OBJEXT): Remove, done automatically by libtool. + * configure.in, acinclude.m4: Remove "" from "`foo`", being + unnecessary and not portable. + + * configure.in (GMP_LDFLAGS): New AC_SUBST flags for libtool link. + (powerpc64*-*-aix*): Use for -Wc,-maix to fix shared library creation, + but can't build shared and static at the same time. + * Makefile.am (libgmp_la_LDFLAGS, libmp_la_LDFLAGS): Use + $(GMP_LDFLAGS). + * gmp.texi (Notes for Particular Systems): Update AIX problem + + * configure.in (AC_CONFIG_LINKS): Use where needed, not via gmp_links. + (gmp_srclinks): Build up as needed, not via gmp_links. + + * acinclude.m4 (GMP_INIT): Do CONFIG_TOP_SRCDIR and asm-defs.m4 here. + * configure.in (asm-defs.m4): Consequent changes. + + * acinclude.m4 (GMP_INCLUDE_MPN): Using include_mpn(), replacing + GMP_INCLUDE and GMP_SINCLUDE. + * configure.in (gmp_m4postinc): Remove this scheme, use + GMP_INCLUDE_MPN instead. + + * configure.in (*-*-sco3.2v5*): Force ac_cv_archive_cmds_need_lc=no, + until libtool does this itself. + * gmp.texi (Known Build Problems): Remove SCO -lc problem. + + * configure, INSTALL.autoconf, etc: Update to autoconf 2000-11-29. + * acinclude.m4 (GMP_C_SIZES): Use AC_CHECK_SIZEOF. + * gmp.texi (Known Build Problems): Remove version.c sed/config.h + problem, fixed. + + * ltmain.sh, aclocal.m4: Update to libtool 2000-11-25. + * ltconfig: No longer required, but leave an empty dummy for automake. + * gmp.texi (Known Build Problems): Remove SunOS native ar ranlib + problem, fixed. + + * */Makefile.in, aclocal.m4: Update to automake 2000-11-25. + * mpbsd/tests/Makefile.am, mpfr/tests/Makefile.am (check_PROGRAMS): + Remove dummy, no longer required. + * mpbsd/tests/dummy.c, mpfr/tests/dummy.c: Remove files. + * depcomp: Remove file, no longer required (with no-dependencies). + + * texinfo.tex: Update to 2000-11-09. + * gmp.texi (Build Options): Mention PDF from gmp.texi. + * Makefile.am (MOSTLYCLEANFILES): Add gmp.tmp, from new texinfo.tex. + + * gmp.texi (Build Options): List alphaev56, alphapca56, alphaev67, + hppa2.0n and power among supported CPUs. + +2000-11-30 Torbjorn Granlund + + * mpz/tests/t-mul.c: Increase max operand size from 2^17 bits + to 2^19 bits. Misc cleanups. + +2000-11-26 Kevin Ryde + + * tune/tuneup.c (FIB_THRESHOLD): Cope better with different speeds of + odd and even sizes. + + * longlong.h (alpha): Use udiv_qrnnd and count_leading_zeros on all + compilers, not just gcc. + + * pre_mod_1.c: Use conditional subtract to always skip a division. + (UMUL_TIME, UDIV_TIME): Remove defaults, now in longlong.h. + +2000-11-22 Torbjorn Granlund + + * mpn/pa64w/gmp-mparam.h: Retune. + * mpn/pa64/gmp-mparam.h: Retune. + * mpn/sparc64/gmp-mparam.h: Retune. + +2000-11-22 Kevin Ryde + + * gmp-impl.h (ABOVE_THRESHOLD, BELOW_THRESHOLD): New macros. + * mpn/generic/gcdext.c: Use them. + + * mpn/generic/gcdext.c [WANT_GCDEXT_ONE_STEP]: Force only one step. + * tune/gcdextos.c, tune/gcdextod.c: New files, one step gcdext, single + and double. + * tune/Makefile.am (libspeed_la_SOURCES): Add them. + (TUNE_MPN_SRCS): Remove gcdext.c. + * tune/speed.h, tune/common.c, tune/speed.c: Add measuring. + * tune/tuneup.c: Use for GCDEXT_THRESHOLD, plus check if double limb + is ever better. Should be more accurate, and hopefully faster. + + * tune/gcdext_single.c: New file, gcdext forced to single limbs. + * tune/Makefile.am: Add it. + * tune/speed.h, tune/common.c, tune/speed.c: Add measuring, and of + invert_limb. + + * tune/speed.h (speed_params r): Use mp_limb_t, not long. + * tune/speed.h, tune/common.c: Don't "switch" on "r". + * tune/speed.c (r_string): Accept limb sized constants. + (choice scale): Add a scale factor (eg. "2.33*mpn_add_n"). + * tune/common.c (SPEED_ROUTINE_UDIV_QRNND_A): Default r to + __mp_bases[10].big_base, being a full limb value. + + * configure.in (alphapca56*-*-*): Use ev5 mpn path. + (am29000*-*-*): Remove this, leave the canonical a29k. + (z8k*-*-*, z8kx*-*-*): Changed from z8000, since z8k is canonical. + (gmp_mpn_functions_optional): Add invert_limb, use for alpha and ia64. + + * configure.in (alloca): Accept yes/no/detect, generate an error if + "yes" but not available. + * gmp.texi (Build Options): Update. + + * acinclude.m4 (GMP_TRY_ASSEMBLE): Make conftest.out available. + (GMP_ASM_ALIGN_FILL_0x90): Use it. + + * acinclude.m4 (GMP_ASM_X86_MMX) [*-*-solaris*]: Check for solaris + 2.6 "as" movq bug. + * gmp.texi (Notes for Particular Systems): Update x86 MMX note. + +2000-11-21 Torbjorn Granlund + + * tune/Makefile.am (EXTRA_DIST): List hppa2w.asm. + + * tune/hppa2.asm: Change level directive to "2.0n". + * tune/hppa2w.asm: New file. + * configure.in [SPEED_CYCLECOUNTER_OBJS switch]: Separate out hppa2.0w. + + * mpn/pa64/gmp-mparam.h (BITS_PER_LONGINT): 64 => 32. + +2000-11-21 Kevin Ryde + + * urandom.h (random): No prototype if glibc stdlib.h has already + provided it (avoids an int32_t/long conflict). + + * tune/Makefile.am (LDFLAGS): Use -all-static. + (speed-dynamic): Dynamic linked version of speed.c. + * tune/README: Update. + + * mpn/generic/gcd.c (find_a): Use native version if available. + * acconfig.h (HAVE_NATIVE_mpn_gcd_finda): Add #undef. + * gmp-impl.h (mpn_gcd_finda): Add prototype and define. + * mpn/asm-defs.m4 (mpn_gcd_finda): New define_mpn. + * tune/gcd_finda_gen.c: #undef any HAVE_NATIVE_mpn_gcd_finda. + * configure.in (gmp_mpn_functions_optional): Add gcd_finda. + * mpn/x86/k6/gcd_finda.asm: New file. + + * tune/tuneup.c (POWM_THRESHOLD): Slightly bigger size steps. + + * gmp-impl.h (__GMP_IMPL_H__): Protect against multiple inclusion. + * tune/gcd_bin.c, tune/powm_mod.c, tune/powm_redc.c: Use #undef after + gmp-impl.h to force thresholds. + * tune/tuneup.c (print_define, fft): No need for #ifndefs on + thresholds any more. + +2000-11-20 Torbjorn Granlund + + * mpz/tests/t-powm.c: Analogous changes as made 2000-11-12 to t-mul.c. + * mpz/tests/t-powm_ui.c: Likewise. + * mpz/tests/t-pow_ui.c: Likewise. + * mpz/tests/t-root.c: Likewise. + + * configure.in [compiler switch]: Pass "-Aa -D_HPUX_SOURCE" to cc for + all hppa versions. + + * mpn/hppa/hppa1_1/udiv_qrnnd.S: Reference data using PC relative + addressing (was r19 relative addressing). + +2000-11-18 Torbjorn Granlund + + * rand.c: (__gmp_rand_lc_scheme): Convert strings to hexadecimal. + (gmp_randinit): Expect strings in hexadecimal. + +2000-11-18 Kevin Ryde + + * configfsf.guess, configfsf.sub: Update to 2000-11-16. + * config.guess (alpha*-*-openbsd*): Do exact cpu detection. + +2000-11-14 Torbjorn Granlund + + * mpz/tests/t-fdiv.c: Analogous changes as made 2000-11-12 to t-mul.c. + * mpz/tests/t-tdiv_ui.c: Likewise. + * mpz/tests/t-fdiv_ui.c: Likewise. + * mpz/tests/t-sqrtrem.c: Likewise. + * mpz/tests/t-gcd.c: Likewise. + +2000-11-13 Kevin Ryde + + * mpn/Makeasm.am: New file, splitting out assembler rules. + * mpn/Makefile.am, tune/Makefile.am: Use it. + + * mpn/Makefile.am (@CPP@): Remove this, automake already gives it. + + * configure.in (AC_CHECK_LIBM): New test, and AC_SUBST it. + * Makefile.am (MPFR_LIBADD_OPTION): Use it. + * demos/Makefile.am (qcn_LDADD): Ditto. + * tune/Makefile.am (libspeed_la_LIBADD): Ditto. + * tests/rand/Makefile.am (libstat_la_LIBADD): Ditto. + + * tune/time.c (timeval_diff_secs): Better calculation. + (read_real_time): New measuring method for AIX power/powerpc. + (speed_endtime): Protect against negative times. + * tune/common.c (speed_measure): Protect against big reps. + * tune/freq.c (speed_cpu_frequency_measure_one): Better timeval diff. + * tune/speed.h (TIMEVAL_DIFF_SEC,USEC): Remove macros. + * configure.in: (sys/systemcfg.h, read_real_time): New tests. + +2000-11-13 Torbjorn Granlund + + * mpz/tests/t-mul.c: Remove #include urandom.h. + * mpz/tests/t-tdiv.c: Likewise. + + * configure.in [SPEED_CYCLECOUNTER_OBJS switch]: + Declare hppa.asm as just 32 bits (cyclecounter_size=1). + +2000-11-12 Torbjorn Granlund + + * mpz/tests/t-mul.c + (main): Generate random numbers using gmp_rand* functions. + (main): Distribute random numbers non-uniformly. + (main): Seed by current time if GMP_CHECK_RANDOMIZE is set. + (_mpn_mul_classic): Streamline. + * mpz/tests/t-tdiv.c: Analogous changes. + + * demos/pexpr.c (HAVE_sigaltstack): Fix typo in testing for _UNICOS. + Also test for __hpux. + +2000-11-11 Torbjorn Granlund + + * mpn/alpha/ev5/gmp-mparam.h: Retune. + + * mpn/alpha/ev6/gmp-mparam.h: Retune. + + * mpn/alpha/ev6/add_n.asm: Misc cleanups. + + * mpn/alpha/ev6/sub_n.asm: New file. + +2000-11-10 Torbjorn Granlund + + * configure.in [path switch] (alphaev6*-*-*): Add alpha/ev5 to path. + + * mpn/alpha/ev6/add_n.asm: New file. + +2000-11-10 Kevin Ryde + + * mpz/powm.c (redc): Make global under WANT_REDC_GLOBAL. + * tune/powm_mod.c, tune/powm_redc.c: New files. + * tune/Makefile.am (libspeed_la_SOURCES): Add them. + * tune/*: Add measuring of redc, mpz_mod, mpz_powm_mod, mpz_powm_redc. + + * tune/tuneup.c (POWM_THRESHOLD): Determine from redc and mpz_mod. + * tune/Makefile.am (TUNE_MPZ_SRCS): Remove powm. + +2000-11-10 Torbjorn Granlund + + * mpn/mips3/gmp-mparam.h: Retune. + + * configure.in (os_64bit): Rename to check_64bit_compiler. + +2000-11-09 Torbjorn Granlund + + * configure.in [SPEED_CYCLECOUNTER_OBJS switch]: Choose hppa/hppa2 code + depending on $CC64. + +2000-11-09 Kevin Ryde + + * mpn/x86/pentium/mul_1.asm: Unroll 2x, saving 1 c/l when in L1. + Add 1c entrypoint. + * mpn/x86/pentium/aorsmul_1.asm: Add 1c entrypoints, shave a couple + of cycles at entry and exit. + + * configure.in (power1,2,2sc): Support these as synonyms for plain + power. + + * acinclude.m4 (GMP_ASM_X86_SHLDL_CL): GMP_DEFINE WANT_SHLDL_CL here. + (GMP_ASM_X86_MMX, GMP_ASM_X86_SHLDL_CL): Add X86 into the names. + * configure.in: Consequent changes. + + * gmp.texi (Notes for Particular Systems): Remarks about power/powerpc. + (Reentrancy): Remarks about simultaneous writing. + (Reporting Bugs): Ask for configfsf.guess. + +2000-11-08 Kevin Ryde + + * acinclude.m4 (GMP_FUNC_ALLOCA): New macro. + * configure.in: Use it. + * gmp-impl.h (alloca): Conditionals and setups as per autoconf + (should make alloca available on more non-gcc compilers). + + * acinclude.m4: Misc reformatting, simplify some quoting. + (GMP_ASM_UNDERSCORE, GMP_ASM_X86_MCOUNT): Use $CC $CFLAGS $CPPFLAGS. + (GMP_ASM_UNDERSCORE, GMP_ASM_ALIGN_FILL_0x90, GMP_ASM_RODATA): Put + AC_REQUIREs outside AC_CACHE_CHECK. + (GMP_C_SIZES): Use $srcdir/gmp.h, not -I; use $CPPFLAGS. + (GMP_ASM_UNDERSCORE): Use "gmp_compile" variable, and only rm + conftes1* conftes2*. + (GMP_PROG_NM): New macro, require it in appropriate GMP_ASM_*. + (GMP_TRY_ASSEMBLE): New macro, use it in various GMP_ASM_*. + * configure.in: Use GMP_PROG_NM. + + * mpn/tests/spinner.c (spinner_signal): Use RETSIGTYPE. + (spinner_init): Force output to unbuffered. + + * mpn/x86/README.family: Notes about GOT table and imul, misc updates. + * mpn/x86/k7/diveby3.asm: Change to 3 operands for immediate imul. + * mpn/x86/k6/diveby3.asm: Ditto. + +2000-11-06 Torbjorn Granlund + + * urandom.h: Simplify and make it work properly for 64-bit + machines also in environments without `random'. + +2000-11-04 Torbjorn Granlund + + * configure.in [path switch]: Don't match rs6000-*-*, in + particular don't assume POWER. + + * tune/tuneup.c (fft): Remove usleep calls. + + * config.guess: Don't pass "$@" when it is known to be empty. + + * Makefile.am (EXTRA_DIST): List configfsf.guess and configfsf.sub. + +2000-11-04 Kevin Ryde + + * configfsf.guess, configfsf.sub: Moved from config.guess and + config.sub. + * config.guess, config.sub: New files, wrappers around around + configfsf versions. + * configfsf.guess: Update to FSF 2000-10-23. + * configfsf.sub: Update to FSF 2000-10-25. + + * acinclude.m4 (GMP_ASM_POWERPC_R_REGISTERS): New macro. + * mpn/powerpc32/powerpc-defs.m4: New file, regmap.m4 r0 etc macros + conditionalized by GMP_ASM_POWERPC_R_REGISTERS. + * mpn/powerpc32/regmap.m4: Remove file. + * configure.in (powerpc*-*-*): Use all this. + + * mpz/divegcd.c: New file, providing mpz_divexact_gcd. + * Makefile.am, mpz/Makefile.am: Add it. + * gmp-impl.h (mpz_divexact_gcd): Add prototype. + * mpq/aors.c,canonicalize.c,div.c,mul.c: Use it. + + * longlong.h [pentium] (count_leading_zeros): New macro. + (__clz_tab): Always provide prototype. + * acconfig.h (HAVE_TARGET_CPU_): Add x86s. + + * tune/speed.[ch],common.c (count_leading_zeros, + count_trailing_zeros, __udiv_qrnnd_c): Add measuring. + + * configure.in (X86_PATTERN): Move from here ... + * acinclude.m4 (X86_PATTERN): ... to here. + (GMP_ASM_RODATA): Use it. + + * configure.in (srandom): New test. + * mpn/tests/try.c: Use it. + * tune/speed.c: Ditto, and conditionalize getrusage and headers. + +2000-11-02 Kevin Ryde + + * mpn/Makefile.am (nodist_libdummy_la_SOURCES): Add udiv_qrnnd.c + and udiv_w_sdiv.c. + + * mpn/generic/mul_n.c (mpn_kara_sqr_n): Remove a duplicate + subtract at the evaluate stage. + +2000-11-01 Torbjorn Granlund + + * configure.in [compiler switch] (sparc64-*-linux*): Spell + gmp_xoptcflags_gcc properly, and pass same options as for other + sparcv9 configs. + + * tune/speed.h (SPEED_ROUTINE_MPN_GET_STR): Fix type of wsize. + +2000-10-31 Torbjorn Granlund + + * configure.in [compiler switch] (sparc64-*-linux*): Remove -mvis + from gmp_xoptflags_gcc, this might not be an ultrasparc. + Remove -m32 from gmp_cflags_gcc; add -Wa,-xarch=v8plus. + +2000-10-29 Torbjorn Granlund + + * mpn/ia64/lorrshift.asm: New file. + + * configure.in: New mulfunc `lorrshift' for lshift and rshift. + +2000-10-29 Kevin Ryde + + * mpn/generic/mul_n.c (mpn_kara_sqr_n): Delete code performing + superfluous mpn_sub_n calls. + + * configure.in (found_asm, M4): Account for SPEED_CYCLECOUNTER_OBJ, + for the benefit of targets whose only .asm is a cycle counter. + + * tune/tuneup.c (fft): Remove bogus usleep calls. + +2000-10-28 Torbjorn Granlund + + * mpn/ia64/invert_limb.asm: Get return value for 0x800...00 right. + + * tune/Makefile.am (EXTRA_DIST): Add ia64.asm. + + * tune/ia64.asm: Fix typo. + + * add_n.asm addmul_1.asm mul_1.asm popcount.asm sub_n.asm: + Preserve ar.lc as required by ABI. + * longlong.h (ia64 udiv_qrnnd): New. + + * configure.in [path switch] (ia64*-*-*): Set extra_functions. + * mpn/ia64/invert_limb.asm: New file. + +2000-10-27 Torbjorn Granlund + + * configure.in [compiler switch]: + Get rid of c89 for all hppa flavours--it is an evil compiler! + + * tune/speed.h (SPEED_ROUTINE_MPN_SET_STR): Fix type of xp. + (SPEED_ROUTINE_MPN_GET_STR): Fix type of wp. + +2000-10-27 Kevin Ryde + + * gmp.texi (Fibonacci Number Algorithm): New section. + + * mpz/tests/t-fib_ui.c: New file. + * mpz/tests/Makefile.am (check_PROGRAMS): Add it. + + * mpz/fib_ui.c: Rewrite, same formulas but using mpn functions and + some lookup tables, much faster at small to moderate sizes. + * gmp-impl.h (MPZ_FIB_SIZE): New macro. + (FIB_THRESHOLD): Establish default here. + * tune/tuneup.c (FIB_THRESHOLD): Start search after the new table + data. + + * mpn/x86/x86-defs.m4 (mcount_movl_GOT_ebx): Rename from movl_GOT_ebx, + and don't use GSYM_PREFIX with _GLOBAL_OFFSET_TABLE_. + + * tune/freq.c (speed_cpu_frequency_measure): New test comparing + gettimeofday and speed_cyclecounter, should cover many systems. + +2000-10-27 Torbjorn Granlund + + * mpn/ia64/gmp-mparam.h: Retune. + +2000-10-26 Torbjorn Granlund + + * longlong.h (ia64): Set UMUL_TIME and UDIV_TIME. + + * mpn/ia64/submul_1.c: Fix typo. + +2000-10-25 Kevin Ryde + + * tune/freq.c (speed_cpu_frequency_sysctl): New test, supporting + hw.model for BSD flavours. + * configure.in (sysctl, sys/param.h): New tests. + +2000-10-24 Torbjorn Granlund + + * tune/freq.c: Explicitly #include config.h before other include files. + + * mpz/tests/reuse.c (FAIL2): New #define. + (main): Use FAIL2. Now this test properly returns non-zero exit + status when it fails. + + * mpn/powerpc32/gmp-mparam.h: Retune. + * mpn/powerpc64/gmp-mparam.h: Retune. + +2000-10-24 Kevin Ryde + + * mpn/x86/k6/cross.pl: Support 8 and 16 byte code alignment. + + * mpq/aors.c, mpq/canonicalize.c: Skip two mpz_divexact calls if + gcd gives 1, which should be 60% of the time. + * gmp-impl.h (MPZ_EQUAL_1_P): New macro. + * mpq/mul.c, mpq/div.c: Use it, and a new DIV_OR_SET. + + * tune/tuneup.c (xp_block, yp_block): Initialize these with random + data. Fixes GCD_ACCEL and GCDEXT thresholds, and latest POWM. + +2000-10-23 Torbjorn Granlund + + * configure.in [SPEED_CYCLECOUNTER_OBJS switch]: Add ia64 case. + + * mpn/ia64/gmp-mparam.h: Fill in some parameters. + + * mpn/ia64/submul_1.c: New file. + + * tune/ia64.asm: New file. + + * gmp-impl.h (union ieee_double_extract): Handle ia64. + + * mpn/mp_bases.c: Decrease chars_per_bit_exactly for entry 1 to + work around buggy ia64-linux. + + * longlong.h (ia64 umul_ppmm): Update register flags to match new GCC. + +2000-10-22 Torbjorn Granlund + + * mpn/alpha/ev6/gmp-mparam.h (DC_THRESHOLD): Update. + * mpn/alpha/ev6/submul_1.asm: New file. + +2000-10-22 Kevin Ryde + + * tune/gcd_bin.c: New file. + * tune/gcd_finda_gen.c: New file. + * tune/Makefile.am (libspeed_la_SOURCES): Add them. + * tune/speed.[ch],common.c (mpn_gcd_binary, find_a): Add measuring. + + * * (__gmp_allocate_func etc): Rename from _mp_allocate_func etc. + (__gmp_default_allocate etc): Rename from _mp_default_allocate etc. + * gmp-impl.h (__GMP_REALLOCATE_FUNC_TYPE, + __GMP_REALLOCATE_FUNC_LIMBS): New macros. + + * gmp-impl.h (DC_THRESHOLD): Establish default here, set to 3*KARA + since that's the measured average. + * mpn/generic/dc_divrem_n.c, mpn/generic/tdiv_qr.c (DC_THRESHOLD): + Remove default. + +2000-10-21 Torbjorn Granlund + + * mpn/Makefile.am (TARG_DIST): Add ia64. + +2000-10-21 Kevin Ryde + + * *: Change BZ -> DC. + * mpn/generic/dc_divrem_n.c: Renamed from bz_divrem_n.c. + + * doc/multiplication: Remove file, now in the manual. + * doc/assembly_code: Ditto. + * tune/README: Remove some parts now in the manual. + + * gmp.texi (@m etc): Add and use some new macros. + (Integer Division - mpz_[cft]div_*): Merge descriptions, for brevity + and to emphasise similarities. + (Low-Level Functions - mpn_[lr]shift): Specify count as 1 to + mp_bits_per_limb-1. + (Algorithms): New chapter. + (References): Add some papers. + + * mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): Remove some + unused variables. + * mpn/generic/mul_fft.c (mpn_fft_best_k): Ditto. + + * tune/freq.c: New file, split from time.c. + * tune/time.c: Rewrite, now more automated. + * configure.in, tune/*: Consequent changes. + +2000-10-20 Torbjorn Granlund + + * mpn/ia64/default.m4: New file. + * configure.in [config.m4 switch] (ia64*-*-*): Use ia64/default.m4. + + * mpn/ia64/mul_1.asm: New file. + * mpn/ia64/addmul_1.asm: New file. + * mpn/ia64/add_n.asm: New file. + * mpn/ia64/sub_n.asm: New file. + * mpn/ia64/popcount.asm: New file. + * mpn/ia64/README: New file. + + * mpn/alpha/cntlz.asm: Override `.set noat' from ASM_START. + + * configure.in (HAVE_TARGET_CPU_*): Support hppa1.0, hppa1.1, hppa2.0 + by sed'ing the period into `_'. + + * acconfig.h: Add #undefs for hppa targets. + + * longlong.h (udiv_qrnnd): Fix typo in last change. + + * mpz/tstbit.c: Rewrite (partly to work around GCC 2.95.2 HPPA bug). + + * configure.in [path switch]: + (hppa2.0*-*-*): For non-CC64 case, update path. + + * configure.in [compiler switch]: + (hppa2.0w-*-*): Match with same regexp in both places. + (hppa*-*-*): New case. + (all hppa alternatives): Don't inherit default gmp_cflags_cc, + gmp_cflags_c89. + +2000-10-18 Torbjorn Granlund + + * configure.in (alpha*-*-*): Define gmp_xoptcflags_gcc like for + alpha*-*-osf*. + + * longlong.h (x86 udiv_qrnnd): Change `d' => `dx' to avoid K&R C + stringification. + +2000-10-15 Kevin Ryde + + * doc/configuration: Updates. + + * demos/calc.y: Remove some comments. + +2000-10-14 Kevin Ryde + + * gmp.texi (Parameter Conventions, Memory Management): New sections + split from "Variable Conventions". + (Efficiency, Debugging, Profiling): New sections in "GMP Basics". + (Reentrancy): Some rewording, add note on standard I/O. + (Build options): Add --enable-assert and --enable-profiling. + + * configure.in (--enable-profiling): New option. + * acinclude.m4 (GMP_ASM_X86_MCOUNT): New macro, finding how to profile. + * mpn/x86/x86-defs.m4 (PROLOGUE_cpu, call_mcount): Profiling support. + + * acinclude.m4, configure.in (GMP_ASM_*): Rename from GMP_CHECK_ASM_*, + to follow autoconf conventions. + + * configure.in: Run GMP_CHECK_ASM tests only if needed. + * acinclude.m4 (GMP_CHECK_ASM_MMX): Don't use GMP_CHECK_ASM_TEXT. + + * mpn/x86/x86-defs.m4 (ASSERT): Allow no condition, to just emit code. + +2000-10-13 Kevin Ryde + + * mpq/md_2exp.c: New file. + * mpq/Makefile.am (libmpq_la_SOURCES): Add it. + * Makefile.am (MPQ_OBJECTS): Ditto. + * gmp.h (mpq_mul_2exp, mpq_div_2exp): Add prototypes. + * gmp.texi (Rational Arithmetic): Add documentation. + + * mpq/tests/t-md_2exp.c: New file. + * mpq/tests/Makefile.am (check_PROGRAMS): Add it. + + * mpn/generic/perfsqr.c: Add/amend some comments. + + * gmp.texi (Known Build Problems): Note VERSION problem with old + sed, do some minor rewording. + (Build Options): Add cygwin and djgpp URLs, mention INSTALL.autoconf, + mention HTML. + (Getting the Latest Version of GMP): Move this ... + (Introduction to GMP): ... to here. + (Compatibility with older versions): Just refer to 2.x and 3.x, not + every minor version. + (Initializing Integers): Note restrictions on mpz_array_init'ed + variables. + (Integer Logic and Bit Fiddling): Note bits are numbered from 0. + + * INSTALL.autoconf: New file. + * Makefile.am (EXTRA_DIST): Add it. + + * tune/Makefile.am, tune/tuneup.c, configure.in, gmp-impl.h: New + scheme for recompiled objects used by tune program. Don't use + libgmptune.a, make better use of libtool, work with ansi2knr. + + * tune/speed.h,common.c (SPEED_ROUTINE_MPZ_POWM): Use s->yp and + s->xp_block, make exponent a fixed size. + +2000-10-07 Torbjorn Granlund + + * mpn/mips3/gmp-mparam.h: Retune. + + * mpn/generic/mul_n.c (USE_MORE_MPN): Revert last change. + +2000-10-06 Torbjorn Granlund + + * mpn/mips3/add_n.s: Decrease carry recurrence from 4 to 3 cycles. + * mpn/mips3/sub_n.s: Likewise. + +2000-10-04 Torbjorn Granlund + + * configure.in (sparc64-*-linux*): Set path according to CC64. + +2000-10-04 Kevin Ryde + + * acinclude.m4 (GMP_CHECK_ASM_UNDERSCORE): Use LABEL_SUFFIX, not a + hard-coded ":". + + * config.sub: Don't demand "86" in CPU name for SCO. + + * configure.in (supersparc-*-*): Remove -DSUPERSPARC. + * longlong.h: Use HAVE_TARGET_CPU_supersparc. + + * configure.in (HAVE_TARGET_CPU_*): AC_DEFINE from $target_cpu. + * acconfig.h: Add #undefs, but only for targets of interest. + +2000-10-03 Torbjorn Granlund + + * mpn/alpha/cntlz.asm: Rewrite. + + * mp_clz_tab.c (__clz_tab): Half table size to 128 entires. + * longlong.h (count_leading_zeros): Demand just 128 entries from + __clz_tab. + + * configure.in (mips-sgi-irix6.*): Pass -mips3 in addition to options + for n32 ABI. + + * longlong.h: Move NO_ASM test around all assembly code. + From gcc: + * longlong.h (count_leading_zeros): Sparclite scan instruction was + being invoked incorrectly. + Replace __mc68332__ with __mcpu32__. + Add ARC support. + +2000-10-02 Torbjorn Granlund + + * mpn/mips3/gmp-mparam.h: Retune for both gcc and cc. + + * mpn/generic/mul_n.c (USE_MORE_MPN): Remove exception for __mips. + (interpolate3): Cast mp_limb_t variables to mp_limb_signed_t + when testing sign bit. + + * mpn/alpha/ev6/gmp-mparam.h: Retune. + * mpn/powerpc32/gmp-mparam.h: Retune. + * mpn/powerpc64/gmp-mparam.h: Retune. + * mpn/x86/pentium/gmp-mparam.h: Retune. + * mpn/x86/pentium/mmx/gmp-mparam.h: Retune. + * mpn/sparc32/v9/gmp-mparam.h: Retune. + * mpn/x86/k6/gmp-mparam.h: Retune. + * mpn/x86/p6/gmp-mparam.h: Retune. + * mpn/x86/k7/gmp-mparam.h: Retune. + * mpn/sparc64/gmp-mparam.h: Retune. + + * mpn/m68k/gmp-mparam.h: New file. + * mpn/alpha/ev5/gmp-mparam.h: New file. + + * gmp-impl.h (default MPN_COPY): Remove final `;'. + + * tune/time.c (speed_endtime): Rewrite. + + * tune/speed.h (SPEED_ROUTINE_MPZ_POWM): Set base to a large value, + not 2. + + * demos/pexpr.c (setup_error_handler): Fix typo. + + * mpz/powm.c (redc): New function, based on old mpz_redc. Don't + multiply here. + (mpz_redc): Remove. + (mpz_powm): Major changes, partially reverting to mpn calls. + Multiply before calling redc. + (mpz_powm): Use TMP_ allocation. + (mpz_powm): Refine calculation of k (width of exponent window). + (mpz_powm): Cast constants to mp_limb_t before left shifting. + + * longlong.h: Use ia64 count_leading_zeros just when __GNUC__. + +2000-09-29 Kevin Ryde + + * acinclude.m4 (GMP_C_SIZES): New macro. + * configure.in: Use it. + * acconfig.in (BYTES_PER_MP_LIMB etc): Add #undefs. + * mpn/generic/gmp-mparam.h (BYTES_PER_MP_LIMB etc): Remove #defines. + * gmp.texi (Known Build Problems): Remove 64-bit generic C + gmp-mparam.h problem, now fixed. + + * configure.in: Only run GMP_PROG_M4 if it's actually needed. + +2000-09-27 Torbjorn Granlund + + * demos/pexpr.c: Clean up code for systems not supporting + sigaltstack. Handle old Linux without sigaltstack. Properly + disable all stuff related to sigaltstack under Unicos. + + * mpn/alpha/ev6/addmul_1.asm: Use explicit offset for all load and + store insns. Helps old gas. + + * longlong.h (count_leading_zeros): Define for ia64. + +2000-09-27 Paul Zimmermann + + * mpn/generic/bz_divrem_n.c: Fix qhl handling, simplify. + +2000-09-27 Kevin Ryde + + * mpn/Makefile.in (.SUFFIXES): Regenerate with patched automake to + get .s before .c, which is needed to override ansi2knr .c rules. + + * gmp.texi (mpn_sqrtrem): Fix r2p==NULL return value description + to match the code (change by Torbjorn). + (mpn_gcd, mpn_gcdext, mpn_sqrtrem, mpn_tdiv_qr): Note most + significant limbs must be non-zero. + (mpn_gcd, mpn_gcdext, mpn_sqrtrem): Clarify destination size + requirements. + (mpn_gcd_1): Clarify value must be non-zero, not just size. + + * gmp-impl.h (mpn_zero_p): New inline function. + * mpn/generic/inlines.c: Add gmp-impl.h. + * mpf/integer.c, mpz/get_d.c, mpn/generic/mul_fft.c: Use it. + + * mpn/generic/gcd.c: Use MPN_COPY_INCR not MPN_COPY. + * mpf/add_ui.c: Ditto. + * mpf/add.c: Ditto, and fix test to skip copy. + +2000-09-26 Kevin Ryde + + * gmp-impl.h, longlong.h, mpn/generic/*.c: Add ASSERTs for various + parameter restrictions. + + * gmp-impl.h (UDIV_PREINV_TIME): New macro. + * mpn/generic/sb_divrem_mn.c: Use it. + * mpn/generic/perfsqr.c: Ditto. + * mpn/x86/*/gmp-mparam.h (UDIV_PREINV_TIME): Add values. + + * macos/Makefile.in: Add mpz/tests/t-get_si.c, mpf/tests/t-set_f.c, + and new multi-function mpz and mpq files. + +2000-09-25 Kevin Ryde + + * randlc.c, randlc2x.c, randsd.c, mpz/urandomb.c, mpz/urandomm.c: + Use mpz_ptr and mpz_srcptr for parameters. + * gmp.h (gmp_randinit_lc, gmp_randinit_lc_2exp, gmp_randseed, + mpz_urandomb, mpz_urandomm): Corresponding change to prototypes. + * randsdui.c: Remove wrong K&R parameters part. + +2000-09-12 Kevin Ryde + + * gmp-impl.h (mpn_tdiv_qr): Move prototype from here ... + * gmp.h (mpn_tdiv_qr): ... to here. + + * gmp.texi (Miscellaneous Rational Functions): Comment-out and + move version 1 compatibility note to "Compatibility" section. + (Rational Number Functions): Ditto for canonicalization note. + +2000-09-10 Kevin Ryde + + * mpn/x86/pentium/com_n.asm: New file. + + * gmp.texi (Rational Arithmetic): Add mpq_abs. + (Miscellaneous Rational Functions): Merge and simplify descriptions of + mpq_get_num, mpq_get_den, mpq_set_num, mpq_set_den. + + * mpq/abs.c: New file. + * mpq/Makefile.am (libmpq_la_SOURCES): Add it. + * Makefile.am (MPQ_OBJECTS): Add it. + * gmp.h (mpq_abs): Add prototype. + + * mpq/set_den.c: Don't discard sign when copying, this makes the + code match the manual. + +2000-09-07 Torbjorn Granlund + + * tune/alpha.asm: Rewrite to actually work right. + +2000-09-07 Kevin Ryde + + * tune/common.c,speed.[ch]: Add measuring of mpn_sqrtrem, + mpn_get_str, mpn_set_str. + * tune/README: Various updates. + +2000-09-06 Torbjorn Granlund + + * mpz/fits.c: Correct type of `data'. + +2000-09-06 Kevin Ryde + + * gmp.texi (Build Options): Clarify where to find CFLAGS. + (Known Build Problems): Note SCO -lc problem. + + * tune/speed.h (SPEED_ROUTINE_MPN_GCD_CALL): Fix for sizes > 512 limbs. + + * doc/multiplication: Corrections and additions suggested by Paul. + + * tune/modlinv.c: New file with alternate modlimb_inverts. + * tune/Makefile.am, tune/speed.[ch]: Add measuring of them. + * tune/speed.c (FLAG_NODATA): New attribute, use for mpz_bin_uiui, + mpz_fib_ui, mpz_fac_ui. + + * mpn/x86/t-zdisp.sh: New file. + + * tests/t-modlinv.c: New file. + * tests/Makefile.am (check_PROGRAMS): Add it. + + * mpq/tests/t-set_f.c: New file. + * mpq/tests/Makefile.am (check_PROGRAMS): Add it. + + * gmp-impl.h (MPQ_CHECK_FORMAT): New macro. + * mpq/tests/t-get_d.c: Use it. + + * mpq/set_f.c: New file. + * mpq/Makefile.am (libmpq_la_SOURCES): Add it. + * Makefile.am (MPQ_OBJECTS): Ditto. + * gmp.h: Add prototype. + * gmp.texi (Miscellaneous Rational Functions): Document mpq_set_f, + correct return type of mpq_set_d. + +2000-09-03 Kevin Ryde + + * mpz/aors_ui.c: New file merging add_ui.c and sub_ui.c, no object + code changes. + * mpz/add_ui.c, mpz/sub_ui.c: Remove files. + * mpz/Makefile.am: Update. + + * gmp-impl.h (MPZ_FITS_STYPE_SDT, MPZ_FITS_UTYPE_SDT): New macros. + * mpz/fits.c: New file merging six separate fits*.c. + * mpz/fits_sshort_p.c, fits_sint_p.c, fits_slong_p.c, fits_ushort_p.c, + fits_uint_p.c, fits_ulong_p.c: Remove files + * mpz/Makefile.am: Use new fits.c, change object names from + fits_*_p.lo to fits_*.lo to avoid SunOS 4 native "ar" warnings. + * Makefile.am (MPZ_OBJECTS): Change from fits_*_p.lo to fits_*.lo. + + * acinclude.m4 (GMP_CHECK_ASM_RODATA): New macro, defining RODATA. + * configure.in: Use it. + * mpn/x86/k[67]/mmx/popham.asm: Use it. + + * mpn/x86/*/*.asm: Use "TEXT" not ".text". + +2000-09-02 Kevin Ryde + + * mpq/aors.c: New file merging add.c and sub.c, no object code changes. + * mpq/add.c, mpq/sub.c: Remove files. + * mpq/Makefile.am: Update. + + * mpz/aors.c: New file merging add.c and sub.c, no object code changes. + * mpz/add.c, mpz/sub.c: Remove files. + * mpz/Makefile.am, mpbsd/Makefile.am: Update. + + * configure.in: Re-apply "PROLOGUE.*" regexp change for the + benefit of alpha PROLOGUE_GP, lost in path search reorganisation. + + * mpn/x86/x86-defs.m4 (jadcl0, cmov_simulate, ASSERT, + movl_text_address): Don't use "1:" style labels. + (Zdisp): Rearrange a bit, switch to all hex. + * mpn/x86/README.family: Note SCO "as" doesn't support "1:" style + local labels, misc rewordings. + +2000-08-29 Torbjorn Granlund + + * demos/primes.c: Include string.h. + + * config.guess (x86 variant recog code): Remove dummy*.o files + generated by some compilers. + +2000-08-28 Kevin Ryde + + * acinclude.m4 (GMP_CHECK_ASM_ALIGN_FILL_0x90): Fix Solaris 2.8 + warning message suppression, add notes about SCO. + + * Makefile.am (MPZ_OBJECTS etc): Move some comments. + +2000-08-25 Kevin Ryde + + * mpz/pprime_p.c (mpz_millerrabin): Fix a TMP_FREE. + + * gmp.texi (Copying): Refer to Lesser not Library GPL. + (GMP and Reentrancy): Note stack-alloc.c is not reentrant, and + that SCO is potentially not reentrant. + + * acinclude.m4 (GMP_CHECK_ASM_UNDERSCORE): Test by attempting to + link with or without an underscore. + * gmp.texi (Known Build Problems): Remove SunOS 4 native grep + GSYM_PREFIX problem, now fixed. + + * gmp-impl.h (MODLIMB_INVERSE_3): New constant. + * mpn/generic/diveby3.c: Use it instead of own INVERSE_3. + * mpn/generic/mul_n.c: Ditto. + * tests/t-constants.c: Check it, and PP_INVERTED too. + + * acinclude.m4 (GMP_GCC_MARCH_PENTIUMPRO): New macro. + * configure.in [p6 and athlon] (gmp_optcflags_gcc): Use it to + possibly add -march=pentiumpro. + + * gmp-impl.h (MPZ_SET_STR_OR_ABORT, MPF_SET_STR_OR_ABORT): New macros. + * mpz/tests/t-bin.c, mpz/tests/t-get_si.c, mpz/tests/t-jac.c, + mpz/tests/t-misc.c: Use them. + * mpf/tests/t-conv.c, mpf/tests/t-misc.c: Ditto. + * mpz/tests/convert.c: Ditto and amend diagnostics slightly. + * mpz/tests/t-misc.c (check_mpz_set_si): Remove a superfluous init. + * mpz/tests/io.c: Differentiate between I/O and data conversion errors. + + * mpn/generic/aors_n.c: New file merging add_n and sub_n, no + object code changes. + * mpn/generic/add_n.c: Remove file. + * mpn/generic/sub_n.c: Remove file. + + * mpn/generic/aorsmul_1.c: New file merging addmul_1 and submul_1, + no object code changes. + * mpn/generic/addmul_1.c: Remove file. + * mpn/generic/submul_1.c: Remove file. + + * mpn/generic/popham.c: New file merging popcount and hamdist, no + object code changes. + * mpn/generic/popcount.c: Remove file. + * mpn/generic/hamdist.c: Remove file. + +2000-08-24 Torbjorn Granlund + + * gmp-impl.h (mpn_com_n): Fix typo. + +2000-08-23 Torbjorn Granlund + + * demos/primes.c (main): Don't call mpz_probab_prime_p for numbers + that are known to be prime after sieving. + (main): Declare and initialize max_s_prime_squared. + (MAX_S_PRIME): Increase. + (ST_SIZE): Increase. + +2000-08-23 Kevin Ryde + + * gmp-impl.h (ASSERT_ALWAYS): Change to statement style. + (JACOBI_TWO_U_BIT1): Remove ASSERT. + (MPZ_CHECK_FORMAT): Use ASSERT_ALWAYS as a statement. + +2000-08-21 Torbjorn Granlund + + * gmp-impl.h (ASSERT): Use do..while for dummy version. + + * mpf/get_str.c: Don't set n_digits from digits_computed_so_far + when the converted operand becomes zero. Misc cleanups. + +2000-08-21 Kevin Ryde + + * mpz/fdiv_r_2exp.c, mpz/lcm.c, mpz/urandomm.c: Add missing + TMP_MARK/FREE, avoiding memory leak when using stack-alloc.c. + +2000-08-20 Kevin Ryde + + * mpz/set.c [BERKELEY_MP] (move): Add conditionals to build as + "move" for libmp. + * mpbsd/Makefile.am: Use mpz/set.c, not move.c. + * Makefile.am (MPBSD_OBJECTS): Corresponding change. + * mpbsd/move.c: Remove file. + + * mpn/Makefile.am, mpz/Makefile.am, mpq/Makefile.am, mpf/Makefile.am, + mpbsd/Makefile.am (-DOPERATION_foo): Use "foo" even for ansi2knr + "foo_" objects. Do this with the makefiles to keep the sources + cleaner. + * mpz/mul_siui.c, mpf/integer.c: Revert to plain OPERATION_* forms. + + * mpn/lisp/gmpasm-mode.el (gmpasm-remove-from-list): Renamed from + gmpasm-delete-from-list, because it's non-destructive. + (gmpasm-font-lock-keywords): Add some more keywords. + +2000-08-16 Kevin Ryde + + * tune/mul_n_mpn.c, tune/mul_n_open.c: New files, being forced + open-coded and mpn #includes of mpn/generic/mul_n.c. + * tune/*: Add measuring of them. + * tune/speed.c: Print command line into *.gnuplot file. + + * mpn/generic/mul_n.c (USE_MORE_MPN): Change to #if not #ifdef for + using the value, add #ifndef for providing the default. + * mpn/sparc64/gmp-mparam.h (USE_MORE_MPN): Add #ifndef. + + * tests/t-constants.c: New file. + * tests/Makefile.am (check_PROGRAMS): Add it. + + * mpz/get_si.c: Use LONG_MAX, not BITS_PER_MP_LIMB, so the result + doesn't depend on limb size when outside the range of a long + (though such results are not actually documented). + * mpz/tests/t-get_si.c: New file. + * mpz/tests/Makefile.am (check_PROGRAMS): Add it. + + * mpn/tests/try.c (call): Cast popcount and hamdist calls, + for the benefit of long long limb. + +2000-08-15 Kevin Ryde + + * mp.h (mp_set_memory_functions): Add missing #define. + * mpbsd/tests/allfuns.c (mp_set_memory_functions): Verify its + existence. + + * mpf/tests/t-misc.c (check_mpf_getset_prec): New test, verifying + reverted behaviour of mpf_get_prec. + + * mpn/tests/ref.c (refmpn_strip_twos): Use refmpn_copyi, not + MPN_COPY_INCR. + + * mpz/mul_siui.c, mpf/integer.c: Recognise OPERATION_*_ forms + produced under ansi2knr. + + * configure.in (mpn_objects, mpn_objs_in_libgmp): Add $U to .c + objects when ansi2knr in use. + + * mpn/Makefile.am (AUTOMAKE_OPTIONS): Enable ansi2knr. + (libdummy.la): Add this, not built, to create ansi2knr style rules + for all potential .c files. + * mpz/Makefile.am, mpq/Makefile.am, mpf/Makefile.am, mpfr/Makefile.am, + mpbsd/Makefile.am, mpq/tests/Makefile.am, tests/Makefile.am + (AUTOMAKE_OPTIONS): Enable ansi2knr (now everywhere). + * Makefile.am (MPZ_OBJECTS, MPQ_OBJECTS, MPF_OBJECTS, MPFR_OBJECTS, + MPBSD_OBJECTS, libmp_la_DEPENDENCIES): Add $U to all .lo filenames. + +2000-08-03 Torbjorn Granlund + + * mpn/alpha/ev6/addmul_1.asm: Correct number of cycles to 3.5/28. + +2000-08-02 Torbjorn Granlund + + * Version 3.1 released. + + * gmp.texi: Rephrase mpf_urandomb documentation. + + * mpn/alpha/ev6: New directory with ev6/21264 optimized code. + * mpn/alpha/ev6/addmul_1.asm: New file. + * mpn/alpha/ev6/gmp-mparam.h: New file. + +2000-08-02 Kevin Ryde + + * demos/factorize.c (random): Don't use "inline". + + * mpfr/log.c, mpfr/mul_ui.c, mpfr/round.c, mpfr/set.c, mpfr/set_d.c: + Corrections to K&R parts. + + * Makefile.am (EXTRA_HEADERS): Omit $(MPFR_HEADERS_OPTION). + * mpfr/Makefile.am (EXTRA_DIST): Add mpfr.h. + + * gmp.texi (Known Build Problems): Note problem stripping libgmp.a. + +2000-08-02 Kent Boortz + + * mpfr: Integrated experimental version of mpfr-0.4. + * configure.in: Changes for option --enable-mpfr. + * Makefile.am: Changes for option --enable-mpfr. + +2000-08-01 Torbjorn Granlund + + * mpn/generic/popcount.c: Disable SPARC v9 popc_limb pattern. + * mpn/generic/hamdist.c: Likewise. + +2000-08-01 Kevin Ryde + + * mpn/tests/try.c (try_init): Account for ALIGNMENTS when sizing + source and dest regions. + +2000-07-31 Torbjorn Granlund + + * mpf/get_str.c: Develop three extra digits, not just one. + +2000-07-31 Kevin Ryde + + * gmp.texi (References): Add URL for invariant division. + +2000-07-30 Kevin Ryde + + * tune/time.c (speed_cpu_frequency_proc_cpuinfo): Add support for + alpha linux "cycle frequency". + + * mpn/sparc64/gmp-mparam.h: Re-run tune program for FFT thresholds. + +2000-07-29 Kevin Ryde + + * gmp.texi (ABI and ISA): Add sparc64-*-linux*. + * configure.in [sparc64-*-linux*] (gmp_cflags64_gcc): Same flags + as under solaris. + + * configure.in (--enable-fft): New option, default "no". + * gmp.texi (Build Options): Describe it. + * mpn/generic/mul.c, mpn/generic/mul_n.c [WANT_FFT]: Use it. + * tune/tuneup.c [WANT_FFT]: By default don't probe FFTs if not enabled. + * NEWS: Multiplication optionally using FFT. + + * tune/README: Notes on FFT and GCD thresholds, other minor updates. + + * Makefile.am: Expunge the macos generated files update stuff. + +2000-07-28 Kevin Ryde + + * mpn/x86/*/gmp-mparam.h: Add some FFT thresholds. + +2000-07-28 Kent Boortz + + * macos/Asm*, macos/CmnObj, macos/Mp*: Delete directories. + * macos/Makefile: Delete file. + * macos/Makefile.cw: Delete file. + * macos/config.h: Delete file. + * macos/Asm/*.s: Delete files. + * macos/configure: Create target directories. Don't transform + '(C)' to '(;)' in a 'dnl' line comment in .asm file. + * Makefile.am: Delete macos targets. + * macos/README: Reflect that we reverted back to a build + process that require ""macos/configure" to run on MacOS. + This imply that MacPerl is needed for a build in MacOS. + +2000-07-27 Kevin Ryde + + * mpn/generic/mul_fft.c: New file, by Paul Zimmermann, minor mods + applied. + * configure.in (gmp_mpn_functions): Add it. + * mpn/generic/mul.c, mpn/generic/mul_n.c: Use it. + * doc/multiplication: Describe it (briefly). + + * gmp-impl.h (FFT_MUL_THRESHOLD etc): New thresholds. + (mpn_fft_best_k, mpn_fft_next_size, mpn_mul_fft, mpn_mul_fft_full): + New functions. + (numberof, TMP_ALLOC_TYPE etc, _MP_ALLOCATE_FUNC_TYPE etc, + UNSIGNED_TYPE_MAX etc): New macros. + + * tune/*: Add FFT threshold tuning and speed measuring. + * tune/common.c: Avoid huge macro expansions for umul and udiv. + + * mpz/tests/t-bin.c, mpz/tests/t-jac.c, mpz/tests/t-misc.c, + mpbsd/tests/t-misc.c, mpf/tests/t-misc.c, mpn/tests/try.c, + mpn/tests/spinner.c: Use new gmp-impl.h macros. + + * demos/Makefile.am (BUILT_SOURCES): Don't need calc.c etc under this. + +2000-07-27 Torbjorn Granlund + + * mpn/ia64/gmp-mparam.h: New file. + +2000-07-26 Torbjorn Granlund + + * demos/isprime.c: Handle any number of arguments and print + classification for each. Add `-q' option for old behaviour. + +2000-07-26 Kevin Ryde + + * gmp.texi (Build Options): Mention djgpp stack size. + (Notes for Package Builds): New section. + (Compatibility with older versions): Update for 3.1, add mpf_get_prec. + + * demos/factorize.c [__GLIBC__]: Don't declare random() under glibc. + + * gmp.h (gmp_version): Add prototype and define. + + * Makefile.am: Keep macos directory generated files up-to-date + during development and on a "make dist". + +2000-07-25 Torbjorn Granlund + + * mpn/hppa/gmp-mparam.h: Update threshold values from new `tune' run. + + * mpn/pa64/gmp-mparam.h: Fill in values from `make tune' run. + * mpn/pa64w/gmp-mparam.h: Likewise. + * mpn/mips3/gmp-mparam.h: Likewise. + + * tune/hppa2.asm: Fix typo in .level directive. + + * configure.in: Add sparc64-*-linux* support (from Jakub Jelinek). + * configure: Regenerate. + + * mpn/sparc64/rshift.asm: Use %g5 instead of volatile stack frame area + for return value (from Jakub Jelinek). + * mpn/sparc64/lshift.asm: Likewise. + + * mpf/get_prc.c: Revert Aug 8, 1996 change. + + * version.c: No longer static. + + * mpn/pa64/gmp-mparam.h: Only #define *_THRESHOLD if not already + defined. + * mpn/pa64w/gmp-mparam.h: Likewise. + * mpn/arm/gmp-mparam.h: Likewise. + * mpn/mips3/gmp-mparam.h: Likewise. + +2000-07-25 Kevin Ryde + + * INSTALL: It's "info -f ./gmp.info" to be sure of hitting the + gmp.info in the current directory. + + * Makefile.am (libmp_la_DEPENDENCIES): Add mpz/cmp.lo, for last + mpz/powm.c fix. + + * mpn/sparc64/addmul1h.asm, mpn/sparc64/submul1h.asm: Renamed from + addmul_1h.asm, submul_1h.asm to avoid name conflicts on an 8.3 + filesystem. + * mpn/sparc64/addmul_1.asm, mpn/sparc64/submul_1.asm, + mpn/sparc64/mul_1.asm: Update include_mpn()s. + +2000-07-24 Torbjorn Granlund + + * Update header of all files previously under the Library GPL + to instead be under the Lesser GPL. + + * COPYING.LIB: Now Lesser GPL. + * demos/primes.c: Change license to GPL (was Library GPL). + * demos/isprime.c: Change license to GPL (was Library GPL). + + * gmp.h (error code enum): Add GMP_ERROR_BAD_STRING (currently unused). + + * mpz/tests/t-mul.c: Default SIZE to a function of TOOM3_MUL_THRESHOLD. + Improve error messages. Decrease reps. + +2000-07-22 Kevin Ryde + + * tune/speed.h: Decrease the amount of data used for gcd and powm + measuring, to make the tune go a bit faster. + +2000-07-21 Kent Boortz + + * macos/Asm*, macos/CmnObj, macos/Mp*: Directories no longer created + from configure script, now part of dist. + * macos/Makefile + * macos/Makefile.cw + * macos/config.h + * macos/Asm/*.s + New files and directories that is the output from configure. This way + no Perl installation is required to build on MacOS, just MPW. + * macos/configure: Added prefix '__g' to exported assembler labels. + Changed to handle new m4 syntax instead of the old cpp syntax in asm. + * macos/Makefile.in: Corrected 'clean' target, added 'distclean' + and 'maintainer_clean'. Added "mpn/mp_bases.c" to build. + * macos/README: Reflect the new build process without configure. + Corrected the file structure for Apple MPW installation. + +2000-07-21 Torbjorn Granlund + + * mpf/tests/t-muldiv.c: Relax error limit. Make precision depend + on SIZE. Misc changes. + + * configure: Regenerate. + +2000-07-20 Kent Boortz + + * macos/Makefile.in: Removed hard coded targets, added special + targets found in Makefile.am files. + * macos/configure: Generate targets from top configure script and + Makefile.am files. Made script runnable from Unix for testing. + * macos/README: Notes about search paths for includes, contributed + by Marco Bambini. + * configure.in: Added comment about lines that the "macos/configure" + script depend on. + +2000-07-20 Torbjorn Granlund + + * mpz/powm.c (mpz_powm): After final mpz_redc call, subtract `mod' + from result if it is greater than `mod'. + +2000-07-19 Torbjorn Granlund + + * mpn/hppa/gmp-mparam.h: Fill in values from `make tune' run. + * mpn/alpha/gmp-mparam.h: Likewise. + * mpn/powerpc32/gmp-mparam.h: Likewise. + + * tune/hppa.asm: New file. + * tune/hppa2.asm: New file. + * configure.in (SPEED_CYCLECOUNTER_OBJS): Set for hppa2*-*-* and + hppa*-*-*. + * tune/Makefile.am (EXTRA_DIST): Add hppa.asm and hppa2.asm. + + * tune/speed.h (SPEED_ROUTINE_MPN_BZ_DIVREM_CALL): Declare `marker'; + invoke TMP_FREE. + + * mpn/hppa/hppa1_1/udiv_qrnnd.S: Use "%" instead of "'" for + reloc/symbol delimiter. + +2000-07-16 Torbjorn Granlund + + * mpn/powerpc64/gmp-mparam.h: Update with output from tune utility. + * mpn/powerpc64/copyi.asm: New file. + * mpn/powerpc64/copyd.asm: New file. + +2000-07-16 Kevin Ryde + + * tune/*: Add measuring for umul_ppmm and udiv_qrnnd. + +2000-07-14 Kevin Ryde + + * mpn/x86/k6/k62mmx: New directory. + * configure.in (k6[23]*-*-*): Use it. + * mpn/x86/k6/k62mmx/copyi.asm, mpn/x86/k6/k62mmx/copyd.asm: Move from + mmx directory, improve code alignment a bit. + * mpn/x86/k6/k62mmx/lshift.asm, mpn/x86/k6/k62mmx/rshift.asm: Ditto, + and improve addressing modes for pre-CXT cores. + * mpn/x86/x86-defs.m4 (Zdisp): Add an instruction. + * mpn/x86/k6/mmx/lshift.asm, mpn/x86/k6/mmx/rshift.asm: New files, + suiting plain K6. + * mpn/x86/README, mpn/x86/k6/README: Updates. + * mpn/x86/k6/mmx/*.asm: Update some comments. + + * mpn/tests/Makefile.am: Use $(MAKE) in .asm rules, not "m". + * tune/Makefile.am: Use $(EXEEXT) and libtool --config objdir, for + the benefit of djgpp. + + * */Makefile.in: Regenerate with patched automake that adds + $(EXEEXT) to EXTRA_PROGRAMS. + + * mpn/tests/try.c: Add #ifdef to SIGBUS, for the benefit of djgpp. + * config.guess: Recognise pc:*:*:* as an x86, for djgpp. + + * configure: Regenerate with patched autoconf to fix temp file + ".hdr" which is invalid on a DOS 8.3 filesystem, and to fix two + sed substitutes that clobbered a ":" in $srcdir (eg. a DOS drive + spec). + + * mpz/tests/io.c: Use one fp opened "w+", since separately opened + input and output doesn't work on MS-DOS 6.21. + + * tests/rand/Makefile.am (allprogs): Pseudo-target to build everything. + (CLEANFILES): Add EXTRA_PROGRAMS and EXTRA_LTLIBRARIES. + (manual-test, manual-bigtest): Add $(EXEEXT) to dependencies. + + * tests/rand/*/Makefile.in: Regenerate with patched automake that adds + $(EXEEXT) to EXTRA_PROGRAMS. + +2000-07-13 Torbjorn Granlund + + * mpz/tests/t-root.c: Also test mpz_perfect_power_p. + Generate `nth' so that there will be fewer trivial values. + + * mpz/root.c: Reverse return value in tests for detecting root of +1 + and -1. + + * mpz/perfpow.c: Use TMP_ALLOC interface. + +2000-07-12 Torbjorn Granlund + + * mpz/perfpow.c (primes): Make it const. + +2000-07-06 Kevin Ryde + + * mpn/x86/k6/cross.pl: New file. + + * mpn/x86/*/gmp-mparam.h: Updates to thresholds, conditionalize + all _TIME defines. + * mpn/x86/pentium/mmx/gmp-mparam.h: New file. + * mpn/sparc64/gmp-mparam.h: Update thresholds. + * mpn/sparc32/v9/gmp-mparam.h: Ditto. + +2000-07-04 Kevin Ryde + + * NEWS: Updates. + * mpn/x86/*/README: Miscellaneous updates. + + * tune/speed-ext.c: New file. + * tune/Makefile.am: Add it. + * tune/README: Updates. + * tune/speed.h (SPEED_ROUTINE_MPN_DIVREM_2): Bug fixes. + + * demos/calc.y,calclex.l: New files. + * demos/calc.c,calc.h,calclex.c: New files, generated from .y and .l. + * demos/Makefile.am: Add them. + + * gmp.h (mpq_swap, mpf_swap): Add prototypes and defines. + +2000-07-01 Kevin Ryde + + * gmp.texi (ABI and ISA): New section, bringing together ABI notes. + (Build Options): Add MPN_PATH, various updates. + (Build Options): Add note on setting CFLAGS when setting CC. + (Notes for Particular Systems): Add -march=pentiumpro problem. + (Known Build Problems): Note on gmp-mparam.h for 64-bit generic C. + (GMP Variable Conventions): Add some info on user defined functions. + (Reporting Bugs): Minor rewording. + + * configure.in (MPN_PATH): Renamed from mpn_path. + + * gmp-impl.h (ULONG_MAX,ULONG_HIGHBIT,...,SHORT_MAX): New defines. + * mp[zf]/tests/t-misc.c: Use them. + + * mpbsd/tests/t-misc.c: New file. + * mpbsd/tests/Makefile.am: Add it. + + * Makefile.am (LIBGMP_LT_*, LIBMP_LT_*): Bump version info. + * gmp.h (__GNU_MP_VERSION_*): Bump to 3.1. + + * mpf/tests/Makefile.am (AUTOMAKE_OPTIONS): Add ansi2knr. + + * Makefile.am (libmp_la_SOURCES): Add mp_set_fns.c, accidentally + omitted in gmp 3.0.x. + * gmp.texi (Custom Allocation): Note this is available in mpbsd, + and some minor rewording. + +2000-06-30 Torbjorn Granlund + + * demos/factorize.c (random): New function, defined conditionally. + (factor_using_pollard_rho): Use it, not mrand48. + + * mpn/cray/README: New file. + +2000-06-30 Kevin Ryde + + * mpn/x86/pentium/aorsmul_1.asm: Add MULFUNC_PROLOGUE. + + * mpz/tests/t-jac.c: Test limbs on mpn_jacobi_base, not just ulongs. + + * gmp-impl.h, mpn/tests/try.c, mpn/tests/spinner.c, tune/speed.c: + Use config.h unconditionally, not under HAVE_CONFIG_H. + + * demos/pexpr.c [__DJGPP__]: Patch by Richard Dawe to not use + setup_error_handler on djgpp. + + * tune/*: Locate data to help direct-mapped caches, add measuring + of mpz_init/clear, mpz_add and mpz_bin_uiui, various cleanups. + * configure.in (AC_CHECK_FUNCS): Add popen. + +2000-06-29 Torbjorn Granlund + + * mpf/mul_2exp.c: Streamline criterion for whether to use mpn_lshift or + mpn_rshift. Increase precision when exp is a multiple of + BITS_PER_MP_LIMB primarily to make exp==0 be a noop. + * mpf/div_2exp.c: Analogous changes. + + * mpf/tests/t-dm2exp.c: Set u randomly in loop. Perform more + mpf_mul_2exp testing. + + * configure.in: Recognize cray vector processors with a broad `*'; + move after alpha* not to match that. + +2000-06-28 Kevin Ryde + + * mpz/tests/io.c: Use a disk file, not a pipe, switch to ansi2knr + style, switch from MP_INT to mpz_t, add a couple of error checks. + * mpz/tests/Makefile.am (CLEANFILES): Add io.tmp, in case io.c fails. + +2000-06-27 Torbjorn Granlund + + * mpf/tests/t-get_d.c: Be more lax about relative error, to handle Cray + floating point format. + + * mpq/tests/t-get_d.c: Decrease default reps to 1000. + + * mpf/tests/t-conv.c: Correct type of `bexp'. + + * configure.in (cray vector machines): Don't inherit gmp_cflags_cc. + + * tune/Makefile.am (EXTRA_DIST): Delete sparc64.asm. + + * configure.in (cray vector machines): Set extra_functions. + + * mpn/cray/mulww.f: New file with vectorizing cray code. + * mpn/cray/mulww.s: Generated from mulww.f. + * mpn/cray/mul_1.c: New file. + * mpn/cray/addmul_1.c: New file. + * mpn/cray/submul_1.c: New file. + * mpn/cray/add_n.c: New file. + * mpn/cray/sub_n.c: New file. + +2000-06-26 Kevin Ryde + + * acinclude.m4 (GMP_CHECK_ASM_ALIGN_FILL_0x90): Fix so it actually + detects solaris 2.6, and also suppress warning on solaris 2.8. + * configure.in (SPEED_CYCLECOUNTER): Remove spurious "athlon" from + sparc case. + + * mpn/lisp/gmpasm-mode.el: Move keymap to the top of the docstring. + +2000-06-21 Kevin Ryde + + * mpn/generic/mul_n.c (mpn_kara_mul_n, mpn_kara_sqr_n): Use + mp_size_t for n2. + (mpn_toom3_mul_n, mpn_toom3_sqr_n): Use mp_size_t for size + parameters and "l" variables. + * gmp-impl.h (mpn_toom3_mul_n, mpn_toom3_sqr_n): Update prototypes. + + * mpbsd/itom.c, mpbsd/sdiv.c: Add casts for correct handling of + -0x80...00 on systems with sizeof(short)==sizeof(int). + + * mpz/tests/t-misc.c: Move "bin" test from here ... + * mpz/tests/t-bin.c: ... to here, and add a new (2k,k) test too. + * mpz/tests/Makefile.am (check_PROGRAMS): Add t-bin. + + * mpz/bin_ui.c [_LONG_LONG_LIMB]: Use mpn_divrem_1, since kacc is + a limb not a ulong. + * mpz/bin_uiui.c [_LONG_LONG_LIMB]: Ditto, and use mpn_mul_1 too, + since nacc is a limb. + + * mpf/tests/t-misc.c (check_mpf_set_si, check_mpf_cmp_si): + New file, testing mpf_set_si, mpf_init_set_si, and mpf_cmp_si. + * mpf/tests/Makefile.am (check_PROGRAMS): Add it. + + * mpz/tests/t-misc.c (check_mpz_set_si, check_mpz_cmp_si): + New tests, for mpz_set_si, mpz_init_set_si, and mpz_cmp_si. + + * mpz/set_si.c, mpz/iset_si.c, mpz/cmp_si.c [_LONG_LONG_LIMB]: Fix + handling of -0x80..00. + * mpf/set_si.c, mpf/iset_si.c, mpf/cmp_si.c [_LONG_LONG_LIMB]: Ditto. + +2000-06-19 Torbjorn Granlund + + * demos/primes.c: Properly handle arguments `m +n'. + +2000-06-17 Torbjorn Granlund + + * config.sub: Recognize k5 and k6 with common pattern. + + * mpq/tests/t-get_d.c: Also test mpq_set_d. Misc improvements. + + * mpq/set_d.c: Special case 0.0. Don't call mpn_rshift with 0 count. + Allocate correct amount of memory for numerator. Delete spurious + ASSERT_ALWAYS(1). + +2000-06-17 Kevin Ryde + + * mpz/perfsqr.c: Fix so that zero is considered a perfect square. + (Was wrongly calling mpn_perfect_square_p with size==0.) + +2000-06-16 Kevin Ryde + + * configure.in: Set k5*-*-* to use basic i386 code until there's + something specific. Add path=x86 as a default for x86s. + + * acinclude.m4 (GMP_CHECK_ASM_ALIGN_LOG): Generate + ALIGN_LOGARITHMIC setting, not a full ALIGN definition. + (GMP_CHECK_ASM_ALIGN_FILL_0x90): New test. + * configure.in [x86-*-*]: Use GMP_CHECK_ASM_ALIGN_FILL_0x90. + * mpn/asm-defs.m4 (ALIGN): New macro. + * mpn/x86/x86-defs.m4 (ALIGN): Remove supplementary definition. + + * tune/*: Plain "unsigned" for speed_cyclecounter. + * configure.in: Use tune/sparcv9.asm for 32 and 64 bit modes. + * tune/sparc64.asm: Remove file. + +2000-06-15 Torbjorn Granlund + + * mpn/x86/k7/mmx/copyi.asm: Use `testb' instead of `test'. + * mpn/x86/k7/mmx/copyd.asm: Likewise. + + * mpn/x86/k7/mmx/lshift.asm: Avoid using `~' (Solaris as problems). + * mpn/x86/k7/mmx/rshift.asm: Likewise. + * mpn/x86/k6/aors_n.asm: Likewise. + * mpn/x86/k7/aors_n.asm: Likewise. + * mpn/x86/k7/mul_basecase.asm: Likewise. + +2000-06-13 Torbjorn Granlund + + * tune/sparcv9.asm: Tune, deleting two instructions. + + * tune/alpha.asm: Update to unified speed_cyclecounter. + +2000-06-11 Kevin Ryde + + * mpz/tests/reuse.c (FAIL): Add a K&R version. + Use _PROTO on some typedefs. + * mpz/tests/t-misc.c: Add gmp-impl.h for "const". + + * configure.in: Rework mpn multi-function and optional files. + Names standardized, no need for explicit declarations, all picked + up in one $path traversal. + * doc/configuration: Updates. + + * tests/rand/t-rand.c (main): Change "usage" to work with K&R. + +2000-06-10 Kevin Ryde + + * mpn/x86/pentium/mmx/popham.asm, mpn/x86/p6/mmx/popham.asm, + mpn/x86/p6/p3mmx/popham.asm, mpn/x86/p6/diveby3.asm: Add + MULFUNC_PROLOGUE for correct HAVE_NATIVE_* matching. + + * mpn/x86/x86-defs.m4 (cmov_bytes_tttn): Use eval() on expressions. + (cmov_available_p): Switch to list CPUs which do have cmov. + * mpn/x86/p6/sqr_basecase.asm, mpn/x86/k6/sqr_basecase.asm, + mpn/x86/k7/sqr_basecase.asm: Use eval() for multiplication. + * mpn/x86/README.family: Various updates. + +2000-06-09 Kevin Ryde + + * mpbsd/tests/allfuns.c (main): Call exit() instead of doing return. + + * doc/tasks.html, doc/projects.html: Moved from projects directory. + * doc/multiplication: New file. + * Makefile.am (EXTRA_DIST): Remove projects, add doc. + + * Makefile.am (libgmp_la_LIBADD, libmp_la_LIBADD): Remove + unnecessary -lm. + * INSTALL: Remove -lm from instructions. + * demos/Makefile.am (qcn_LDADD): Add -lm. + + * tune/*: Add measuring for mpn_divrem_2 and modlimb_invert, + improve addsub_n. Switch to unified speed_cyclecounter. + * configure.in: Update configs for speed_cyclecounter. + + * gmp-impl.h (MP_LIMB_T_MAX, MP_LIMB_T_HIGHBIT): New macros. + * mpn/generic/diveby3.c, mpn/generic/mul_n.c, mpn/generic/gcd.c, + tune/speed.c, mpn/tests/ref.c: Use them. + + * mpn/tests/spinner.c: Remove setitimer, just alarm is enough. + * configure.in (AC_CHECK_FUNCS): Remove setitimer. + * mpn/tests/x86call.asm: Start with junk in %eax, %ecx, %edx. + * mpn/tests/ref.[ch] (refmpn_addsub_nc): New function. + * mpn/tests/try.c: Add some support for mpn_addsub_nc. + * mpn/tests/Makefile.am (EXTRA_PROGRAMS): Remove addsub_n and + addsub_n_2 which don't currently build. + * mpn/tests/copy.c: Test MPN_COPY_INCR, not __gmpn_copy. + + * tests/rand/Makefile.am (libstat_la_LIBADD): Add -lm, no longer on + libgmp.la. + (findlc_LDADD): Use libstat.la. + (AUTOMAKE_OPTIONS): Use ansi2knr. + +2000-06-08 Torbjorn Granlund + + * configure.in (alpha*-*-osf*): Default `flavour' to ev6 for ev6 and + higher. + (alpha*-*-*): Likewise. + (alpha*-*-osf*: gmp_optcflags_cc): Move -arch/-tune flags from + gmp_xoptcflags_gcc. + + * mpn/Makefile.am (TARG_DIST): Add pa64w. + + * longlong.h: Wrap 64-bit hppa code in #ifndef LONGLONG_STANDALONE. + +2000-06-07 Torbjorn Granlund + + * mpz/remove.c: Fail for `src' being zero. + + * mpz/tests/reuse.c: Test more functions. + (FAIL): New define. + + * mpz/tests/t-powm.c: Loop during operand generation while they + are mathematically ill-defined (used to just skip such tests). + + * mpz/powm.c (mpz_redc): Clean up argument declarations. + + * configure.in (gmp_cflags64_gcc): Don't add bogus -mWHAT option. + (sparcv9-*-solaris2.[7-9]], gmp_cflags64_gcc): + Inherit from previous gmp_cflags64_gcc; pass `-m64 -mptr64'. + (ia64*-*-*): New. + + * mpn/generic/dump.c: Make it work when an mp_limb_t is not `long'. + + * mpf/set_prc.c: MPN_COPY => MPN_COPY_INCR. + +2000-06-06 Torbjorn Granlund + + * mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): + Use mpn_incr_u for final carry propagation. + + * mpz/tests/t-gcd.c: Add calls to mpz_gcdext with argument t == NULL. + + * mpz/tests/reuse.c: Major rewrite; test many more functions. + + * mpz/powm_ui.c: When exp is 0, change res assign order in order + to handle argument overlap. + * mpz/powm.c: When exp is 0, change res assign order in order + to handle argument overlap. Handle negative exp and mod arguments. + + * mpz/gcdext.c: Rework code after mpn_gcdext call to handle + argument overlap. + + * mpz/fdiv_qr.c: Read dividend->_mp_size before calling mpz_tdiv_qr + in order to handle argument overlap. + * mpz/cdiv_qr.c: Likewise. + + * mpf/tests/reuse.c: Fix typo that effectively disabled `dis_funcs' + tests. Clean up test for mpf_ui_div. + +2000-06-06 Kevin Ryde + + * mpn/x86/p6/sqr_basecase.asm: New file. + * mpn/x86/mod_1.asm: Avoid one conditional jump. + * mpn/x86/p6/gmp-mparam.h: Update thresholds, #ifndef UMUL_TIME + and UDIV_TIME, add COUNT_TRAILING_ZEROS_TIME. + + * mp_minv_tab.c: New file. + * Makefile.am (libgmp_la_SOURCES, libmp_la_SOURCES): Add it. + * gmp-impl.h (modlimb_invert): New macro. + * mpz/powm.c: Remove mpz_dmprepare, use modlimb_invert instead. + * mpn/generic/bdivmod.c: Use modlimb_invert instead of a loop. + * mpn/generic/gcd.c: Inline two small mpn_bdivmod calls, use + MPN_COPY_INCR not MPN_COPY in one place. + +2000-06-05 Torbjorn Granlund + + * mpf/tests/reuse.c (dsi_funcs): Add mpf_mul_2exp and mpf_div_2exp. + (main): Clean up test for mpf_div_ui. + + * mpf/mul_2exp.c: Correct criterion for whether to use mpn_lshift or + mpn_rshift. MPN_COPY => MPN_COPY_INCR. Coerce the two assignments to + r->_mp_size. + + * mpf/div_2exp.c: Use mpn_rshift instead of mpn_lshift when overlap + so requires. MPN_COPY => MPN_COPY_INCR. + + * mpf/tests/t-dm2exp.c: Correct type of res_prec. + +2000-06-04 Kevin Ryde + + * mpz/bin_uiui.c: Fix result for n==0 and n==k. + * mpz/bin_ui.c: Fix result for k>n, add support for n<0. + * gmp.texi (Number Theoretic Functions): Update mpz_bin_ui to + note n<0 is supported. + + * mpz/tests/t-misc.c: New file. + * mpz/tests/Makefile.am (check_PROGRAMS): Add it. + +2000-05-31 Kevin Ryde + + * tune/speed.* (FLAG_R_OPTIONAL): New option for routines, use on + mpn_gcd_1 and mpn_mul_basecase. + * tune/README: Update. + + * tune/alpha.asm: New file, by Torbjorn. + * tune/Makefile.am (EXTRA_DIST): Add it. + * configure.in (alpha*-*-*): Use it. + +2000-05-31 Linus Nordberg + + * doc/configuration: New file. + +2000-05-30 Torbjorn Granlund + + * mpn/generic/mul_basecase.c: Call mpn_mul_2 and mpn_addmul_2 + if available. Don't include longlong.h. + + * doc/isa_abi_headache: New file. + +2000-05-30 Linus Nordberg + + * configure.in (NM): Use AC_PROG_NM rather than AC_CHECK_TOOL to + find `nm'. (AC_PROG_NM comes with Libtool and is needed to get + the `-B' option (BSD compatible output) included in $NM.) + (AR): Use AC_CHECK_PROG rather than AC_CHECK_TOOL to find `ar'. + (Now that NM isn't a cross compilation tool, don't give the + impression that we know how to cross compile.) + (CCAS): Remove spurious comment. + + * gmp.texi (Notes for Particular Systems): Remove comment about + using GNU `nm' on AIX since system nm now works. + +2000-05-29 Torbjorn Granlund + + * mpn/power/mul_1.s: Remove [PR] from first word in function + descriptor. + * mpn/power/addmul_1.s: Likewise. + * mpn/power/submul_1.s: Likewise. + +2000-05-28 Kevin Ryde + + * configure.in, tune/*: Change pentium rdtsc cycle scheme to + HAVE_SPEED_CYCLECOUNTER and SPEED_CYCLECOUNTER_OBJS. + * tune/pentium.asm: Renamed and converted from rdtsc.asm. + * tune/sparcv9.asm: New file, by Torbjorn. + * tune/sparc64.asm: New file. + * tune/tuneup.c: Put a limit on gcdext search. + + * gmp.h (mp_set_memory_functions): Add extern "C". + * mp.h (__GNU_MP__): Bump to "3". + * mpz/add.c,mul.c,powm.c,sub.c,sqrtrem.c,tdiv_qr.c [BERKELEY_MP]: + Include mp.h for mpbsd compile. + * mpz/gcd.c: Ditto, and remove _mpz_realloc declaration. + + * gmp.texi (Integer Functions): Flatten @subsections into @sections. + (Floating-point Functions): Ditto. + (Integer Random Numbers): Split from miscellaneous as a sep section. + (Installing GMP): Make nodes for the sections. + Add more "@cindex"s. + (Known Build Problems): Remove SunOS get_d problem, believed fixed. + (Notes for Particular Systems): Remove HPPA note since now PIC. + (References): URL for Jebelean. + +2000-05-27 Torbjorn Granlund + + * mpn/pa64w: New directory, contents based on corresponding mpn/pa64 + files. + * configure.in (hppa2.0w-*-*): New. + * mpz/tests/io.c (_INCLUDE_POSIX_SOURCE): Define when __hpux before + including stdio.h. + * gmp-impl.h: Always define DItype and UDItype. + +2000-05-27 Kevin Ryde + + * tune/common.c (speed_measure): Correction to array sorting, + better diagnostic when measuring fails. + * tune/time.c: Add microsecond accurate getrusage method. + + * tune/time.c (speed_cpu_frequency_processor_info): New function. + * configure.in (AC_CHECK_FUNCS): Add processor_info. + +2000-05-26 Linus Nordberg + + * gmp.texi (Installing GMP): Shared libraries work for AIX < 4.3 + if using GNU nm. + +2000-05-26 Torbjorn Granlund + + * tune/tuneup.c (SIGNED_TYPE_MAX): Shift `-1' instead of `1' to + avoid signed overflow. + + * demos/pexpr.c (setup_error_handler): Don't call sigaltstack on + Unicos. + +2000-05-25 Torbjorn Granlund + + * insert-dbl.c: Work around GCC 2.8 bug. + * extract-dbl.c: Likewise. + + * config.sub: Allow i586, i686, i786 again. + + * config.guess: Use X86CPU for lots more systems. + +2000-05-25 Linus Nordberg + + * mpbsd/tests/dummy.c (main): Call exit() instead of doing return + (some old SysV machines don't get this correct, I've heard.) + +2000-05-25 Kevin Ryde + + * mpf/iset_str.c: Initialize _mp_size and _mp_exp to 0, in case no + digits in string, so it's the same as a separate init and set_str. + +2000-05-24 Torbjorn Granlund + + * mpz/tests/reuse.c: Use mpz_random2 instead of mpz_random. + + * mpz/divexact.c: Read pointers after reallocation. + Compare `quot' and `den' instead of `qp' and `dp' in overlap check. + Use MPN_COPY_INCR for copying from `np'. + + (*-*-aix4.[3-9]*): Disable shared libs just for problematic AIX + versions. + * configure.in (*-cray-unicos*): Disable asm syntax checking; set + compiler explicitly. + * configure.in (hppa*-*-*): Remove code disabling shared libs. + +2000-05-24 Linus Nordberg + + * acinclude.m4 (GMP_PROG_CC_WORKS): Don't report progress to user + when doing the AIX specific test to avoid "nested output". + +2000-05-22 Kevin Ryde + + * mp.h (_PROTO): Copy from gmp.h, use on prototypes. + Add extern "C" too. + * mpbsd/tests/Makefile.am (AUTOMAKE_OPTIONS): Enable ansi2knr. + * mpbsd/tests/allfuns.c: Don't execute mout, just link to it. + (main): ANSI style definition. + + * gmp-impl.h (MP_BASE_AS_DOUBLE): Change the expression to + something that works on SunOS native cc. Seems to fix the + mp*_get_d problems. + + * mpn/tests/ref.c (refmpn_strip_twos): Use MPN_COPY_INCR. + * mpn/tests/Makefile.am: Let .asm.o rules work with absolute $srcdir. + +2000-05-21 Kevin Ryde + + * mpn/x86/k7/sqr_basecase.asm: Replace file with K7 specific code. + * mpn/x86/k7/README: Update. + * mpn/x86/k7/gmp-mparam.h: Tune thresholds. + (COUNT_TRAILING_ZEROS_TIME): New define. + * mpn/x86/k6/gmp-mparam.h: Ditto. + + * mpn/x86/pentium/mmx/popham.asm: New file (include_mpn of K6 version). + * mpn/x86/p6/diveby3.asm: New file (include_mpn of P5 version). + * mpn/x86/p6/mmx/popham.asm: New file (include_mpn of K6 version). + * mpn/x86/p6/p3mmx/popham.asm: New file (include_mpn of K7 version). + * configure.in (pentium3-*-*): Add p3mmx to $path. + + * gmp.texi (Integer Arithmetic): Clarify mpz_jacobi op2; add + mpz_*_kronecker_*. + (Miscellaneous Integer Functions): Add mpz_odd_p and mpz_even_p. + (Low-level Functions): Put mpn_divmod_1 with mpn_divrem_1 and note + it's now a macro. + (References): Add Henri Cohen. + + * gmp.h (mpn_addmul_1c, mpn_divrem_1c, mpn_mod_1c, mpn_mul_1c, + mpn_submul_1c): Add prototypes. + (mpz_odd_p, mpz_even_p): New macros. + + * mpn/asm-defs.m4 (m4wrap_prepend): New macro. + (m4_error): Use it. + (m4_not_for_expansion): Corrections to OPERATION symbols. + More comments about variations between m4 versions. + * mpn/x86/x86-defs.m4 (PROLOGUE): Use m4wrap_prepend (fixes error + exit under BSD m4, previously m4_error printed the message but the + exit code was 0). + + * gmp.h (mpn_divmod_1): Change to a macro calling mpn_divrem_1. + * mpn/generic/divrem_1.c: Move divmod_1.c code to here, make it + static and call it __gmpn_divmod_1_internal. + * mpn/generic/divmod_1.c: Remove file. + * configure.in (gmp_mpn_functions): Remove divmod_1. + * mpn/asm-defs.m4 (define_mpn): Remove divmod_1 and divmod_1c. + * compat.c (mpn_divmod_1): Add compatibility function. + * tune/*: Remove mpn_divmod_1 measuring (leave just divrem_1). + + * acconfig.h (HAVE_NATIVE_mpn_*): Add some missing carry-in + variants, remove divmod_1. + + * mpn/x86/diveby3.asm: Use imul, update comments. + + * demos/qcn.c: New file. + * demos/Makefile.am (EXTRA_PROGRAMS): Add it. + + * mpz/tests/t-jac.c: New file. + * mpz/tests/Makefile.am (check_PROGRAMS): Add it. Enable ansi2knr. + + * mpz/kronsz.c: New file. + * mpz/kronuz.c: New file. + * mpz/kronzs.c: New file. + * mpz/kronzu.c: New file. + * mpz/Makefile.am (libmpz_la_SOURCES): Add them. + * Makefile.am (MPZ_OBJECTS): Add them. + * gmp-impl.h (JACOBI_*, MPN_STRIP_LOW_ZEROS_NOT_ZERO): New macros. + * gmp.h (mpz_*_kronecker_*): New defines and prototypes. + + * mpn/generic/jacbase.c: New file. + * mpn/generic/mod_1_rs.c: New file. + * configure.in (gmp_mpn_functions): Add them. + * gmp.h (mpn_jacobi_base, mpn_mod_1_rshift): New defines and + prototypes. + * longlong.h (COUNT_TRAILING_ZEROS_TIME): New define. + * mpn/tests/ref.c (refmpn_mod_1_rshift): New function. + * mpn/tests/try.c: Add mpn_mod_1_rshift. + * tune/*: Add measuring for mpn_jacobi_base. + + * acinclude.m4 (GMP_FINISH): Add ifdefs to allow multiple + inclusion of config.m4. + (GMP_PROG_M4): Put "good" message through to config.log. + + * mpz/powm.c: Use a POWM_THRESHOLD for where redc stops. + * tune/*: Add mpz_powm measuring, and tune POWM_THRESHOLD. + * gmp-impl.h [TUNE_PROGRAM_BUILD] (POWM_THRESHOLD): Conditional + redefinition for use when tuning. + + * mpz/powm_ui.c: Use DIVIDE_BY_ZERO. + + * mpz/iset_str.c: Initialize _mp_size to 0, in case no digits in + string; this makes it the same as a separate init and set_str. + +2000-05-20 Kevin Ryde + + * mpn/asm-defs.m4: Note &,|,^ aren't bitwise in BSD m4 eval(). + * mpn/x86/k6/sqr_basecase.asm: Use "%" not "&" in m4 eval()s. + + * mpn/x86/x86-defs.m4 (Zdisp): Yet more instruction forms. + +2000-05-19 Linus Nordberg + + * acinclude.m4 (GMP_CHECK_CC_64BIT): Don't use shell variable + `ac_compile' for our own compile command string since other + Autoconf macros may depend on it. + +2000-05-19 Kevin Ryde + + * mpn/generic/mul_n.c (mpn_toom3_mul_n, mpn_toom3_sqr_n): Fix + carry propagation in final coefficient additions. + +2000-05-18 Linus Nordberg + + * configure.in: Set NM before looking for compiler since + GMP_CHECK_CC_64BIT needs it. + + * acinclude.m4 (GMP_CHECK_CC_64BIT): Don't execute on target. + (GMP_PROG_CC_FIND): Before checking if the compiler knows how to + produce 64-bit code, verify that it works at all. The background + is that /usr/ucb/cc on Solaris 7 successfully compiles in 64-bit + mode but fails when doing final link. + (GMP_PROG_CC_WORKS): Report to user what's happening. + +2000-05-17 Linus Nordberg + + * config.guess: Use X86CPU for x86 Cygwin. + +2000-05-16 Kevin Ryde + + * mpn/x86/p6/mmx/divrem_1.asm: New file. + * mpn/x86/p6/mmx/mod_1.asm: New file. + * mpn/x86/p6/README: Update. + * mpn/x86/divrem_1.asm: Update comments. + * mpn/x86/mod_1.asm: Ditto. + +2000-05-14 Kevin Ryde + + * tune/speed.h: Run gcd functions on a set of data. + + * mpn/tests/try.c: New file. + * mpn/tests/try.h: New file. + * mpn/tests/spinner.c: New file. + * mpn/tests/trace.c: New file. + * mpn/tests/x86call.asm: New file. + * mpn/tests/x86check.c: New file. + * mpn/tests/ref.c (refmpn_hamdist): Allow size==0. + (refmpn_gcd): New function, and other additions supporting it. + * mpn/tests/ref.h: More prototypes. + * mpn/tests/Makefile.am: Add try program, use ansi2knr. + + * mpn/x86/k7/mmx/popham.asm: New file. + * mpn/x86/k6/mmx/popham.asm: New file. + * mpn/x86/k6/sqr_basecase.asm: Unroll the addmul, for approx 1.3x + speedup above 15 limbs. + * mpn/x86/k7/README: Update. + * mpn/x86/k6/README: Update, and add notes on plain K6 and pre-CXT + K6-2 problems. + * configure.in (k6*-*-*, athlon-*-*): Add popham. + + * mpn/x86/pentium/diveby3.asm: New file. + * mpn/x86/pentium/README: Update. + + * gmp.texi (Installing GMP): Add note on bad OpenBSD 2.6 m4. + (Reporting Bugs): Ask for config.m4 if asm file related. + (I/O of Rationals): New section, add mpq_out_str. + (References): Add url for on-line gcc manuals. + A few node and menu updates. + + * INSTALL: Better command line argument checking for test progs. + Change MP -> GMP. + + * configure.in (WANT_ASSERT, USE_STACK_ALLOC, HAVE_PENTIUM_RDTSC): + Put descriptions here, not in acconfig.h. + (CALLING_CONVENTIONS_OBJS): New AC_SUBST (for mpn/tests/try). + (HAVE_CALLING_CONVENTIONS): New AC_DEFINE. + (AC_CHECK_HEADERS): Add sys/time.h. + (AC_CHECK_FUNCS): Add getpagesize, setitimer. + (KARATSUBA_SQR_THRESHOLD): Strip trailing comments from the + #define when passing through to config.m4. + * acconfig.h (PACKAGE, VERSION, WANT_ASSERT, USE_STACK_ALLOC, + HAVE_PENTIUM_RDTSC): No need for #undefs, autoheader gets them + from configure.in. + + * acinclude.m4 (GMP_PROG_M4): Check for broken OpenBSD 2.6 m4 + eval(), put messages into config.log. + * mpn/asm-defs.m4: Add notes and test for OpenBSD 2.6 m4. + + * mpq/out_str.c: New file. + * mpq/Makefile.am (libmpq_la_SOURCES): Add it. + * Makefile.am (MPQ_OBJECTS): Ditto. + * gmp.h (mpq_out_str): New define and prototype. + +2000-05-12 Kevin Ryde + + * configure.in (CONFIG_TOP_SRCDIR): Fix to use $srcdir not + $top_srcdir (which doesn't exist). + * acinclude.m4 (GMP_C_ANSI2KNR): Fix setting U=_. + * gmp-impl.h (mpn_com_n, MPN_LOGOPS_N_INLINE): Fix missing "do" + (not currently used, probably no ill effect anyway). + +2000-05-11 Torbjorn Granlund + + * randraw.c (lc): Major overhaul (pending rewrite). + (_gmp_rand): Rewrite. + +2000-05-08 Torbjorn Granlund + + * mpz/tests/convert.c: Call free via _mp_free_func. + * mpf/tests/t-conv.c: Likewise. + + * memory.c: Add code enabled for DEBUG that adds special patterns + around allocated blocks. + +2000-05-05 Linus Nordberg + + * gmp.texi (Miscellaneous Float Functions): Correct parameter list + for mpf_urandomb(). + + * configure.in: Invoke AC_REVISION. + +2000-05-05 Kevin Ryde + + * gmp.texi: Use @dircategory and @direntry. + (Installing GMP): Clarification for --target, updates on SunOS + problems. + (Integer Arithmetic): Add mpz_mul_si. + (Initializing Rationals): Add mpq_swap. + (Assigning Floats): Add mpf_swap. + (Low-level Functions): Add mpn_divexact_by3c, and details of what + the calculation actually gives. + (Low-level Functions): Note extra space needed by mpn_gcdext, + clarify the details a bit. + + * compat.c: New file, entry points for upward binary compatibility. + (mpn_divexact_by3): Compatibility function. + * Makefile.am (libgmp_la_SOURCES): Add compat.c. + + * mpn/tests/ref.c: Rearrange macros for ansi2knr. + (div1): Renamed from div to avoid library function. + (refmpn_divexact_by3c, refmpn_gcd_1, refmpn_popcount, + refmpn_hamdist): New functions. + * mpn/tests/ref.h: Add extern "C", add new prototypes. + + * gmp.h (gmp_randinit, etc): Add extern "C". + (_mpq_cmp_ui): Fix prototype name from mpq_cmp_ui. + (mpn_divexact_by3): Now a macro calling mpn_divexact_by3c. + (mpn_divexact_by3c): New prototype and define. + + * mpn/x86/diveby3.asm: Change to mpn_divexact_by3c. + * mpn/x86/k6/diveby3.asm: Ditto. + * mpn/generic/diveby3.c: Ditto. + * mpn/asm-defs.m4: Ditto on the define_mpn. + * acconfig.h (HAVE_NATIVE_mpn_divexact_by3c): New define. + + * mpq/swap.c: New file, derived from mpz/swap.c. + * mpf/swap.c: Ditto. + * mpq/Makefile.am: Add swap.c. + * mpf/Makefile.am: Ditto. + * Makefile.am: Add two new "swap.lo"s. + + * mpn/x86/k6/mmx/com_n.asm: Fix an addressing bug (fortunately + this code hasn't been used anywhere yet). + + * mpn/x86/k7/mmx/divrem_1.asm: New file. + * mpn/x86/k7/mmx/mod_1.asm: New file. + * mpn/x86/k7/diveby3.asm: New file. + * mpn/x86/k7/README: Update. + + * mpn/x86/k7/aorsmul_1.asm: Use new cmovCC, no object code change. + * mpn/x86/k7/mul_basecase.asm: Ditto. + * mpn/x86/p6/aorsmul_1.asm: Ditto. + + * mpn/x86/x86-defs.m4 (defframe_empty_if_zero): Eval the argument. + (cmovCC): New macros, replacing individual cmovCC_reg_reg forms. + (Zdisp): Recognise more instructions. + (shldl,etc): Use m4_instruction_wrapper(). + (ASSERT, movl_text_address): New macros. + + * mpn/asm-defs.m4: Add remarks on SunOS /usr/bin/m4 and new + OpenBSD m4. + (m4_assert_numargs_internal_check): Remove a spurious parameter. + (m4_empty_if_zero): Eval the argument. + (m4_assert, m4_assert_numargs_range, m4_config_gmp_mparam, + m4_instruction_wrapper): New macros. + +2000-05-04 Linus Nordberg + + * gmp.texi (Reporting Bugs): Be explicit about output from running + a command. + +2000-05-02 Torbjorn Granlund + + * mpn/generic/bz_divrem_n.c (mpn_bz_divrem_n): Handle non-zero return + from first mpn_bz_div_3_halves_by_2 call. + (mpn_bz_divrem_aux): Likewise. + +2000-04-30 Kevin Ryde + + * tune/* (GCD_ACCEL_THRESHOLD, GCDEXT_THRESHOLD): Tune these. + + * mpn/generic/gcdext.c (GCDEXT_THRESHOLD): Rename from THRESHOLD, + use with >=, adjust default to 17 accordingly. + Use new *_SWAP macros. + + * mpn/generic/gcd.c (GCD_ACCEL_THRESHOLD): Rename from + ACCEL_THRESHOLD, use with >=, adjust default to 5 accordingly. + Use new *_SWAP macros. + + * mpf/get_str.c, mpf/set_str.c, mpf/sub.c, mpz/add.c, mpz/ior.c, + mpz/and.c, mpz/sub.c, mpz/xor.c, mpz/ui_pow_ui.c, + mpn/generic/mul.c: Use new *_SWAP macros. + + * stack-alloc.h: Add extern "C" around prototypes. + + * gmp-impl.h: (MP_PTR_SWAP, etc): New macros. + (_mp_allocate_func, etc): Use _PROTO. + [TUNE_PROGRAM_BUILD]: More changes in tune program build part. + +2000-04-28 Torbjorn Granlund + + * mpn/pa64/add_n.s: Add `,entry' to export directive. + * mpn/pa64/addmul_1.S, mpn/pa64/lshift.s, mpn/pa64/mul_1.S, + mpn/pa64/rshift.s, mpn/pa64/sub_n.s, mpn/pa64/submul_1.S, + mpn/pa64/umul_ppmm.S: Likewise. + * mpn/hppa/hppa1_1/udiv_qrnnd.S: New name for udiv_qrnnd.s. + Add PIC support. + +2000-04-29 Kevin Ryde + + * gmp-impl.h [TUNE_PROGRAM_BUILD] (TOOM3_MUL_THRESHOLD_LIMIT): New + define. + * mpn/generic/mul_n.c [TUNE_PROGRAM_BUILD] (mpn_mul_n): Use + TOOM3_MUL_THRESHOLD_LIMIT, not a hard coded 500. + + * memory.c: Use for malloc etc, and use _PROTO. + * stack-alloc.c: Don't use C++ reserved word "this". + * urandom.h: Put extern "C" around prototypes. + * mpz/powm.c: Switch a couple of parameters to "const", which they + are, to satisfy g++. + + * randraw.c, stack-alloc.c, mpbsd/mout.c, mpbsd/mtox.c: Add casts to + help g++. + + * stack-alloc.c: Provide dual ANSI/K&R function definitions. + * mpz/addmul_ui.c,get_d.c,inp_str.c,perfpow.c,powm.c,pprime_p.c, + rrandomb.c,set_str.c,ui_pow_ui.c: Ditto. + * mpf/integer.c,set_str.c: Ditto. + * mpbsd/min.c,xtom.c: Ditto. + * mpn/generic/bz_divrem_n.c,dump.c,gcd_1.c,get_str.c,hamdist.c, + popcount.c,random.c,random2.c,set_str.c: Ditto. + + * rand.c: Use for NULL. + * mpz/gcd_ui.c,gcdext.c,mul.c,perfpow.c,powm_ui.c,root.c,sqrt.c, + sqrtrem.c: Ditto + * mpf/sqrt.c,sqrt_ui.c: Ditto. + * mpn/generic/perfsqr.c,sqrtrem.c: Ditto. + + * gmp-impl.h (NULL, malloc, realloc, free): Don't define/declare. + (extern "C"): Add around function prototypes. + (mpn_kara_mul_n, mpn_kara_sqr_n, mpn_toom3_mul_n, mpn_toom3_sqr_n): + Add prototypes. + [TUNE_PROGRAM_BUILD] (FIB_THRESHOLD): Add necessary redefinitions for + use by tune program. + * mpn/generic/mul_n.c: Remove mpn_toom3_mul_n prototype. + + * acinclude.m4 (GMP_C_ANSI2KNR): New macro. + (GMP_CHECK_ASM_MMX, GMP_CHECK_ASM_SHLDL_CL): Fix to use + $gmp_cv_check_asm_text which is what GMP_CHECK_ASM_TEXT sets. + * configure.in (GMP_C_ANSI2KNR): Use this instead of AM_C_PROTOTYPES, + for reasons described with its definition. + + * demos/Makefile.am (ansi2knr): Use $(top_builddir) nor $(top_srcdir). + + * mpz/fib_ui.c (FIB_THRESHOLD): Rename from FIB_THRES, for consistency. + (FIB_THRESHOLD): Conditionalize so gmp-mparam.h can define a value. + (mpz_fib_bigcase): Use >= FIB_THRESHOLD, same as main mpz_fib_ui. + * tune/tuneup.c,Makefile.am (FIB_THRESHOLD): Tune this. + + * configure.in (*-*-aix* gmp_m4postinc): Fix setting (don't overwrite + a value just stored). + +2000-04-26 Kevin Ryde + + * mpn/sparc32/udiv_fp.asm: Use mpn_udiv_qrnnd macro. + * mpn/sparc32/udiv_nfp.asm: Ditto. + * mpn/sparc32/v8/supersparc/udiv.asm: Ditto. + * mpn/sparc32/umul.asm: Name the function mpn_umul_ppmm. + * mpn/sparc32/v8/umul.asm: Ditto. + * mpn/powerpc32/umul.asm: Ditto. + + * mpn/x86/syntax.h: Remove file, since now unused. + + * configure.in (x86): Remove -DBROKEN_ALIGN and -DOLD_GAS + previously used by .S files. + (x86 extra_functions): Add udiv and umul. + (GMP_PROG_M4): Use this instead of AC_CHECK_PROG(M4,m4,...) + (HAVE_NATIVE_*): Loosen up the regexp to "PROLOGUE.*" so as to + accept PROLOGUE_GP on alpha. + + * acconfig.h (HAVE_NATIVE_mpn_umul_ppmm, udiv_qrnnd, invert_limb): + New template defines. + * mpn/asm-defs.m4 (mpn_umul_ppmm, mpn_udiv_qrnnd): New define_mpn()s. + * longlong.h (umul_ppmm, udiv_qrnnd): Use a library version if + it's available and an asm macro isn't. + * gmp-impl.h (invert_limb): Ditto. + + * gmp-impl.h (ASSERT_NOREALLOC): Not a good idea, remove it. + + * acinclude.m4 (GMP_PROG_M4): New macro. + +2000-04-25 Linus Nordberg + + * gmp.texi (Random State Initialization): Correct arguments to + `gmp_randinit'. + + * acinclude.m4 (GMP_VERSION): Change `eval' --> `m4_eval'. Fix + from Kevin. + * aclocal.m4: Regenerate. + +2000-04-25 Kevin Ryde + + * mpn/x86/aors_n.asm: Remove parentheses around an immediate that + Solaris "as" doesn't like, change by Torbjorn. + +2000-04-24 Kevin Ryde + + * configure.in (AC_CHECK_FUNCS): Add strtoul. + + * mpn/generic/mul_n.c [TUNE_PROGRAM_BUILD] (mpn_mul_n): Bigger + array for karatsuba temporary space for tune program build. + (mpn_toom3_sqr_n) Remove an unused variable. + + * demos/Makefile.am (AUTOMAKE_OPTIONS): Add ansi2knr. + Add "allprogs:" pseudo-target. + * demos/factorize.c, demos/isprime.c: Switch to ANSI functions, + rely on ansi2knr. + + * gmp.texi (Getting the Latest Version of GMP): Add reference to + ftp.gnu.org mirrors list. + * INSTALL: Add arg count check to example programs. + + * mpn/x86/*/*.asm: Convert to FORTRAN ... or rather to + FORTRAN-style "C" commenting to support Solaris "as". + * mpn/x86/x86-defs.m4: Ditto, and add another Zdisp insn. + * mpn/asm-defs.m4 (C): Update comments. + * mpn/x86/README.family: Add a note on commenting, remove + description of .S files. + + * mpn/sparc64/addmul_1.asm, mul_1.asm, submul_1.asm: Use + include_mpn(). + +2000-04-23 Torbjorn Granlund + + * config.sub: Merge with FSF version of April 23. + + * mpn/powerpc32: Use dnl/C instead of `#' for comments. + + * config.guess: Get "model" limit between pentium 2 and pentium3 right. + Get rid of code determining `_' prefix; use double labels instead. + * config.guess: Partially merge with FSF version of April 22. + (Don't bring over NetBSD changes for now.) + +2000-04-23 Kevin Ryde + + * tune/Makefile.am, tune/README, tune/common.c, tune/rdtsc.asm, + tune/speed.c, tune/speed.h, tune/time.c, tune/tuneup.c: New files. + * tune/Makefile.in: New file, generated from Makefile.am. + + * gmp-impl.h (ASSERT_NOREALLOC,TMP_ALLOC_LIMBS): New macros. + [TUNE_PROGRAM_BUILD] Further mods for tune program builds. + + * mpz/Makefile.am: Add -DOPERATION_$* for new mul_siui.c. + Add rules to build mul_si and mul_ui from a common mul_siui.c. + * mpz/mul_siui.c: New file, derived from and replacing mul_ui.c. + * gmp.h (mpz_mul_si): New prototype and define. + + * mpn/tests/*.c [__i386__] (CLOCK): Don't use floating point in + CLOCK because cpp can't handle floats in #if's (TIMES is derived + from CLOCK by default). + + * mpn/asm-defs.m4 (include_mpn): New macro. + (m4_assert_numargs) Changes to implementation. + + * mpf/Makefile.am: Add -DOPERATION_$* for new integer.c. + Remove explicit rules for floor.o etc. + * mpf/integer.c: Use OPERATION_$* for floor/ceil/trunc. + + * mpn/Makefile.am: Put "tests" in SUBDIRS. + * mpn/tests/Makefile.am: New file providing rules to build test + programs, nothing done in a "make all" or "make check" though. + * mpn/tests/README: New file. + + * acconfig.h (HAVE_PENTIUM_RDTSC): New define. + + * configure.in (x86): Rearrange target cases. + Add mulfunc aors_n and aorsmul_1 for x86 and pentium (now all x86s). + Remove asm-syntax.h generation not needed. + Remove now unused family=x86. + (sparc) Remove unused family=sparc. + (HAVE_PENTIUM_RDTSC) New AC_DEFINE and AM_CONDITIONAL. + (AM_C_PROTOTYPES) New test, supporting ansi2knr. + (AC_CHECK_HEADERS) Add getopt.h, unistd.h and sys/sysctl.h for + tune progs. + (AC_CHECK_FUNCS) Add getopt_long, sysconf and sysctlbyname for + tune progs. + (config.m4 CONFIG_TOP_SRCDIR) Renamed from CONFIG_SRCDIR. + (config.m4 asm-defs.m4) Use CONFIG_TOP_SRCDIR and include(). + (gmp_m4postinc) Use include_mpn(). + (gmp_links) Omit asm-defs.m4/asm.m4 and gmp_m4postinc's. + (MULFUNC_PROLOGUE) Fix regexps so all functions get AC_DEFINE'd. + (PROLOGUE) Ditto (native copyi and copyd were unused in gmp 3). + (KARATSUBA_SQR_THRESHOLD) Copy from gmp-mparam.h into config.m4. + (AC_OUTPUT) Add tune/Makefile, mpn/tests/Makefile. + + * Makefile.am (AUTOMAKE_OPTIONS): Add ansi2knr. + (SUBDIRS): Add tune, reorder directories. + (MPZ_OBJECTS): Add mpz/mul_si.lo. + (libmp_la_SOURCES): Use this for top-level objects, not .lo's. + * ansi2knr.c, ansi2knr.1: New files, provided by automake. + + * mpn/x86/aors_n.asm: Convert add_n.S and sub_n.S to a + multi-function aors_n.asm, no object code change. + * mpn/x86/pentium/aors_n.asm: Ditto. + * mpn/x86/aorsmul_1.asm: Ditto for addmul/submul. + * mpn/x86/pentium/aorsmul_1.asm: Ditto. + + * mpn/x86/lshift.asm, mpn/x86/mul_1.asm, mpn/x86/mul_basecase.asm, + mpn/x86/rshift.asm: Convert from .S, no object code change. + * mpn/x86/pentium/lshift.asm, mpn/x86/pentium/mul_1.asm, + mpn/x86/pentium/mul_basecase.asm, mpn/x86/pentium/rshift.asm: Ditto. + + * gmp.texi (Reporting Bugs): Itemize the list of things to include. + (Miscellaneous Float Functions): Correct typo in mpf_ceil etc + argument types. + Change @ifinfo -> @ifnottex for benefit of makeinfo --html. + Remove unnecessary @iftex's around @tex. + +2000-04-22 Torbjorn Granlund + + * config.guess: Generalize x86 cpu determination code. + Now works on Solaris. + + * mpz/nextprime.c: Rewrite still disabled code. + + * configure.in: Specifically match freebsd[3-9]. + +2000-04-21 Torbjorn Granlund + + * rand.c: Call mpz_clear for otherwise leaking mpz_t. + + * mpz/pprime_p.c (mpz_probab_prime_p): Merge handling of negative + n into code for handling small positive n. Merge variables m and n. + After dividing, simply call mpz_millerrabin. + (isprime): Local variables now use attribute `long'. + (mpz_millerrabin): New static function, based on code from + mpz_probab_prime_p. + (millerrabin): Now simple workhorse for mpz_millerrabin. + +2000-04-19 Torbjorn Granlund + + * gmp-impl.h: Fix parenthesis error in test for __APPLE_CC__. + +2000-04-18 Linus Nordberg + + * NEWS: Add info about shared libraries. Remove reference to + gmp_randinit_lc. + +2000-04-17 Torbjorn Granlund + + * Version 3.0 released. + + * mpn/arm/add_n.S: New version from Robert Harley. + * mpn/arm/addmul_1.S: Likewise. + * mpn/arm/mul_1.S: Likewise. + * mpn/arm/sub_n.S: Likewise. + + * gmp.h (__GNU_MP_VERSION_PATCHLEVEL): Now 0. + +2000-04-17 Linus Nordberg + + * configure.in (hppa2.0*-*-*): Pass `+O3' to cc/c89 in 64-bit mode + to avoid compiler bug. + (ns32k*-*-*): Fix typo in path. Change by Kevin. + (alpha*-*-osf*): New case. Pass assembly flags for architecture + to gcc. + (alpha*-*-*): Don't bother searching for cc. + * configure: Regenerate. + + * Makefile.am (EXTRA_DIST): Add `macos', `.gdbinit'. + * Makefile.in: Regenerate. + * mpn/Makefile.am (EXTRA_DIST): Add `m88k', `lisp'. + * mpn/Makefile.in: Regenerate. + +2000-04-16 Kevin Ryde + + * README: Updates, and don't duplicate the example in INSTALL. + * INSTALL: Minor updates. + * gmp.texi (Installing MP): Minor edits, restore CC/CFLAGS description. + +2000-04-16 Linus Nordberg + + * configure.in (*-*-cygwin*): Select BSD_SYNTAX to avoid + .type/.size in PROLOGUE for ELF_SYNTAX. Override ALIGN definition + from x86/syntax.h. + (gmp_xoptcflags_${CC}): New set of variables, indicating + ``exclusive optional cflags''. + (most sparcs): Use gmp_xoptcflags instead of gmp_optcflags to + ensure that we pass CPU type to older gcc. + (CFLAGS): CFLAGS on the command line was spoiled. + * configure: Regenerate. + +2000-04-16 Linus Nordberg + + * configure.in: Invoke AC_PROG_LIBTOOL directly. + + * acinclude.m4 (GMP_PROG_CC_FIND): Quote source variable when + setting CC64 and CFLAGS64. + (GMP_PROG_CC_SELECT): Cache result. + (GMP_PROG_LIBTOOL): Remove. + + * aclocal.m4: Regenerate. + * configure: Regenerate. + +2000-04-16 Linus Nordberg + + * tests/rand/t-rand.c (main): Add non-ANSI function declaration. + Don't use `const'. + +2000-04-16 Torbjorn Granlund + + * mpn/generic/dump.c: Suppress output of leading zeros. + + * mpz/inp_str.c: Fix memory leakage. + + * mpz/tests/reuse.c (dss_func_division): Add a final 1. + + * longlong.h (alpha count_leading_zeros): Wrap in __MPN. + * mpn/alpha/cntlz.asm: Use __gmpn prefix (by means of __MPN). + + * longlong.h (__umul_ppmm, __udiv_qrnnd): Wrap in __MPN. + * mpn/alpha/udiv_qrnnd.S: Use __gmpn prefix. + * mpn/hppa/udiv_qrnnd.s: Likewise. + * mpn/hppa/hppa1_1/udiv_qrnnd.s: Likewise. + * mpn/pa64/udiv_qrnnd.c: Likewise (by means of __MPN). + * mpn/pa64/umul_ppmm.S: Likewise. + * mpn/sparc32/udiv_fp.asm: Likewise (by means of MPN). + * mpn/sparc32/udiv_nfp.asm: Likewise (by means of MPN). + * mpn/sparc32/v8/supersparc/udiv.asm: Likewise (by means of MPN). + + * mpn/generic/tdiv_qr.c: Work around gcc 2.7.2.3 i386 register handling + bug. + + * mpn/generic/tdiv_qr.c: Use udiv_qrnnd instead of mpn_divrem_1 + when computing appropriate quotient; mpn_divrem_1 writes too + many quotient limbs. + + * mpn/asm-defs.m4: invert_normalized_limb => invert_limb. + * mpn/alpha/invert_limb.asm: mpn_invert_normalized_limb => + mpn_invert_limb. + * gmp.h: Likewise. + * gmp-impl.h (alpha specific): invert_normalized_limb => invert_limb; + wrap with __MPN. + * longlong.h (alpha udiv_qrnnd): Likewise. + +2000-04-16 Kevin Ryde + + * gmp.h (mp_set_memory_functions,mp_bits_per_limb,gmp_errno): Add + #defines so the library symbols are __gmp_*. + * errno.c: Include gmp.h. + * gmp-impl.h (_mp_allocate_func,etc): Add #defines to __gmp_*. + (__clz_tab): New #define to __MPN(clz_tab). + * stack-alloc.c (__gmp_allocate_func,etc): Change from _mp_*. + + * Makefile.am (libmp_la_DEPENDENCIES): Add some mpz files needed + for new mpz_powm (pow in libmp). + (EXTRA_DIST): Add projects directory. + + * mpn/*: Change __mpn to __gmpn. + * gmp.h (__MPN): Ditto. + * stack_alloc.c,stack-alloc.h: Change __tmp to __gmp_tmp. + + * mpn/generic/sb_divrem_mn.c (mpn_sb_divrem_mn): Avoid gcc 2.7.2.3 + i386 register handling bug (same as previously in mpn_divrem_classic). + + * mpn/generic/divrem.c: Now contains mpn_divrem, which is not an + internal function, so remove warning comment. + + * gmp.texi (Compatibility with Version 2.0.x): Source level only. + +2000-04-16 Linus Nordberg + + * configure.in (hppa1.0*): Prefer c89 to cc. + * configure: Regenerate. + +2000-04-15 Linus Nordberg + + * configure.in: If `mpn_path' is set by user on configure command + line, use that as path. + * configure: Regenerate. + +2000-04-15 Linus Nordberg + + * configure.in (hppa2.0*): Use path "hppa/hppa1_1 hppa" if no + 64-bit compiler was found. + * configure: Regenerate. + +2000-04-15 Linus Nordberg + + * configure.in: Honor `CC' and `CFLAGS' set by user on configure + command line. + * acinclude.m4: (GMP_PROG_CC_SELECT): Set CFLAGS if not set already. + * aclocal.m4: Regenerate. + * configure: Regenerate. + +2000-04-15 Linus Nordberg + + * acinclude.m4 (GMP_PROG_CC_FIND): Remove debug output. Remove + commented out code. + * aclocal.m4: Regenerate. + * configure: Regenerate. + + * configure.in: Make all `-mcpu' options to gcc optional. + * configure: Regenerate. + + * tests/rand/Makefile.am: Don't do anything for target 'all'. + * tests/rand/Makefile.in: Regenerate. + +2000-04-15 Kevin Ryde + + * README: Small updates. + * NEWS: Add some things about 3.0. + + * mpz/Makefile.am (EXTRA_DIST): Remove dmincl.c. + + * Makefile.am: Use -version-info on libraries, not -release. + + * mpz/tdiv_qr.c: Add mdiv function header #ifdef BERKELEY_MP. + * mpbsd/Makefile.am: Use mpz/tdiv_qr.c, not mdiv.c. + * Makefile.am (MPBSD_OBJECTS): Change mdiv.lo to tdiv_qr.lo. + (libmp_la_DEPENDENCIES): Add mp_clz_tab.lo. + * mpbsd/mdiv.c: Remove file. + + * config/mt-linux,mt-m68k,mt-m88110,mt-ppc,mt-ppc64-aix,mt-pwr, + mt-sprc8-gcc,mt-sprc9-gcc,mt-supspc-gcc,mt-vax,mt-x86, + mpn/config/mt-pa2hpux,mt-sprc9,t-oldgas,t-ppc-aix,t-pwr-aix: + Remove configure fragments not used since change to autoconf. + + * mpn/generic/bz_divrem_n.c,sb_divrem_mn.c: Add comment that + internal functions are changeable and shouldn't be used directly. + +2000-04-15 Linus Nordberg + + * configure.in: Remove debug output. + * configure: Regenerate. + +2000-04-15 Torbjorn Granlund + + * mpn/generic/tdiv_qr.c: Don't use alloca directly. + + * mpz/tdiv_qr.c: Fix typo. + * mpz/tdiv_r.c: Fix typo. + * mpz/tdiv_q.c: Fix typo. + + * configure.in: Disable -march=pentiumpro due to apparent compiler + problems. + + * mpz/powm.c: Replace with new code from Paul Zimmermann. + + * mpz/tdiv_q.c: Remove debug code. + + * mpn/generic/divrem.c: Remove C++ style `//' commented-out code. + * mpn/generic/sb_divrem_mn.c: Likewise. + +2000-04-14 Torbjorn Granlund + + * mpz/cdiv_q.c: Change temp allocation for new requirements of + mpz_tdiv_qr. + * mpz/fdiv_q.c: Likewise. + + * mpn/sparc64/gmp-mparam.h: Set up parameters for TOOM3. + + * mpz/dmincl.c: Delete file. + * mpz/tdiv_qr.c: Rewrite using mpn_tdiv_qr. + * mpz/tdiv_r.c: Likewise. + * mpz/tdiv_q.c: Likewise. + + * mpn/generic/tdiv_qr.c: New file. + * mpn/generic/bz_divrem_n.c: New file. + * mpn/generic/sb_divrem_mn.c: New file. + + * gmp-impl.h (MPZ_REALLOC): New macro. + (mpn_sb_divrem_mn): Declare. + (mpn_bz_divrem_n): Declare. + (mpn_tdiv_qr): Declare. + + * configure.in (gmp_mpn_functions): Delete divrem_newt and divrem_1n; + add tdiv_qr, bz_divrem_n, and sb_divrem_mn. + * mpn/generic/divrem_newt.c: Delete file. + * mpn/generic/divrem_1n.c: Delete file. + + * gmp.h (mpn_divrem_newton): Remove declaration. + (mpn_divrem_classic): Remove declaration. + + * gmp.h (mpn_divrem): Remove function definition. + * mpn/generic/divrem.c: Replace mpn_divrem_classic with a + mpn_divrem wrapper. + +2000-04-14 Kevin Ryde + + * mpf/dump.c, mpz/dump.c, mpn/generic/dump.c, + mpn/generic/divrem.c, mpn/generic/divrem_1n.c, + mpn/generic/divrem_2.c, mpn/generic/divrem_newt.c, + mpn/generic/mul.c, mpn/generic/mul_basecase.c, + mpn/generic/mul_n.c, mpn/generic/sqr_basecase.c, + mpn/generic/udiv_w_sdiv.c: Add comment that internal functions are + changeable and shouldn't be used directly. + + * mpq/div.c: Use DIVIDE_BY_ZERO (previously didn't get an + exception on zero divisor). + + * mpf/tests/t-get_d.c, mpz/tests/reuse.c: Add K&R function + definitions. + * mpz/tests/t-2exp.c: Don't use ANSI-ism 2ul. + + * gmp.texi (Installing MP): Build problem notes for GSYM_PREFIX + and ranlib on native SunOS. + Particular systems notes about AIX and HPPA shared libraries + disabled. + (MP Basics): Add that undocumented things shouldn't be used. + (Introduction to MP): Add to CPUs listed. + + * acinclude.m4 (GMP_CHECK_ASM_UNDERSCORE): Don't depend on C + having "void". + +2000-04-13 Linus Nordberg + + * mpn/pa64/udiv_qrnnd.c (__udiv_qrnnd64): Add K&R function + definition. + + * configure.in: Disable shared libraries for hppa*. + (mips-sgi-irix6.*): Fix flags for 64-bit gcc. + (hppa2.0*-*-*): Prefer c89 to cc. + * configure: Regenerate. + + * gmp.h (gmp_randalg_t): Remove comma after last element. + + * tests/rand/t-rand.c: Add copyright notice. + +2000-04-13 Kevin Ryde + + * mpn/generic/mul_n.c, mpn/generic/gcdext.c, mpz/nextprime.c, + mpz/remove.c, mpz/root.c: Add K&R function definitions. + * mpz/rrandomb.c: Fix typo in K&R part. + * stack-alloc.c: Add K&R style function pointer declarations. + + * mpz/root.c: Use SQRT_OF_NEGATIVE on even roots of negatives. + Use DIVIDE_BY_ZERO on a "zero'th" root. + + * configure: Regenerate with autoconf backpatched to fix --srcdir + absolute path wildcards that bash doesn't like, change by Linus. + + * gmp.texi (Integer Arithmetic): Document mpz_nextprime. + (Miscellaneous Integer Functions): Fix mpz_fits_* formatting. + (Installing MP): Comment-out CC and CFLAGS description. + +2000-04-13 Linus Nordberg + + * rand.c (gmp_randinit): Don't combine va_alist with ordinary + arguments for non STDC. + +2000-04-13 Torbjorn Granlund + + * mpz/nextprime.c: Use proper names of new random types and functions. + + * mpz/rrandomb.c: New file. + * mpz/Makefile.am: List it. + * mpz/Makefile.in: Regenerate. + * Makefile.am: Here too. + * Makefile.in: Regenerate. + * gmp.h: Declare mpz_rrandomb. + +2000-04-12 Linus Nordberg + + * Makefile.am, demos/Makefile.am, mpbsd/Makefile.am, + mpbsd/tests/Makefile.am, mpf/Makefile.am, mpf/tests/Makefile.am, + mpn/Makefile.am, mpq/Makefile.am, mpq/tests/Makefile.am, + mpz/Makefile.am, mpz/tests/Makefile.am, tests/Makefile.am, + tests/rand/Makefile.am (AUTOMAKE_OPTIONS): Add 'no-dependencies'. + + * Makefile.in, demos/Makefile.in, mpbsd/Makefile.in, + mpbsd/tests/Makefile.in, mpf/Makefile.in, mpf/tests/Makefile.in, + mpn/Makefile.in, mpq/Makefile.in, mpq/tests/Makefile.in, + mpz/Makefile.in, mpz/tests/Makefile.in, tests/Makefile.in, + tests/rand/Makefile.in: Regenerate. + +2000-04-12 Linus Nordberg + + * randlc.c (gmp_randinit_lc): Disable function. + * gmp.texi (Random State Initialization): Remove gmp_randinit_lc. + + * acinclude.m4 (GMP_CHECK_CC_64BIT): Compiling an empty main + successfully with `-n32' will have to suffice on irix6. + * aclocal.m4: Regenerate. + + * configure.in (sparc): Don't pass -D_LONG_LONG_LIMB to compiler. + (mips-sgi-irix6.*): Use compiler option `-n32' rather than `-64' + for 64-bit `cc'. Add options for gcc. + * configure: Regenerate. + + * mpf/urandomb.c (mpf_urandomb): Add third parameter 'nbits'. If + 'nbits' doesn't make even limbs, shift up result before + normalizing. + + * gmp.h (mpf_urandomb): Add parameter to prototype. + + * mpf/urandom.c: Rename file to ... + * mpf/urandomb.c: ... this. + * Makefile.am (MPF_OBJECTS): Change urandom.lo --> urandomb.lo. + * Makefile.in: Regenerate. + * mpf/Makefile.am (libmpf_la_SOURCES): Change urandom.c --> urandomb.c. + * mpf/Makefile.in: Regenerate. + + * config.in: Regenerate for HAVE_DECL_OPTARG. + + * randraw.c (_gmp_rand): Fix bug with _LONG_LONG_LIMB. + (lc): Change return type. + Use one temporary storage instead of two. + Handle seed of size 0. + Avoid modulus operation in some cases. + Abort if M is not a power of 2. + Fix bug with 64-bit limbs. + Fix bug with small seed, small A and large M. + + * tests/rand/gen.c (main): Include gmp.h. Remove macros MIN, MAX. Add + option '-q'. Don't demand argument N. Change parameters in call + to mpf_urandomb. + + * tests/rand/t-rand.c: New file for testing random number generation. + + * tests/rand/Makefile.am: Run t-rand for 'make check'. + (test, bigtest): Rename to manual-test, manual-bigtest. + * tests/rand/Makefile.in: Regenerate. + +2000-04-12 Kevin Ryde + + * gmp-impl.h: Include config.h before TMP_ALLOC, so + --disable-alloca works. + + * mpbsd/Makefile.am: Don't recompile top-level sources here. + * Makefile.am (libmp_la_DEPENDENCIES): Put objects here instead, + add errno.lo and stack-alloc.lo. + + * mpn/asm-defs.m4: Add a test and message for the unsuitable SunOS m4. + * gmp.texi (Installing MP): Update note on SunOS m4 failure. + + * acconfig.h: Add copyright notice using @TOP@. + + * stack-alloc.c: Use _mp_allocate_func, not malloc. + * gmp.texi (Installing MP): Note this under --disable-alloca. + + * gmp.texi (Comparison Functions): mpz_cmp_abs => mpz_cmpabs. + (Integer Arithmetic): mpz_prime_p not yet implemented, comment out. + (Float Arithmetic): mpf_pow_ui now implemented, uncomment-out. + (Miscellaneous Float Functions): Add mpf_ceil, mpf_floor, mpf_trunc. + (Low-level Functions): Add mpn_random2, with mpn_random. + + * mpn/m68k/mc68020/udiv.S: Rename from udiv.s. + * mpn/m68k/mc68020/umul.S: Ditto. + + * mpn/alpha/umul.asm: Rename from umul.s, remove .file and + compiler identifiers. + + * mpn/powerpc32/syntax.h: Removed, no longer used. + + * mpn/a29k/udiv.s: Remove .file and compiler identifiers. + * mpn/a29k/umul.s: Ditto. + + * mpn/tests/ref.c: Use WANT_ASSERT. + * mpn/tests/ref.h: Use _PROTO. + + * mpbsd/configure.in: Removed, no longer required. + + * mpf/div.c: Use DIVIDE_BY_ZERO. + * mpf/div_ui.c: Ditto. + * mpf/ui_div.c: Ditto. + * mpq/inv.c: Ditto. + * mpf/sqrt.c: Use SQRT_OF_NEGATIVE. + * mpz/sqrt.c: Ditto. + * mpz/sqrtrem.c: Ditto. + + * gmp-impl.h (GMP_ERROR,SQRT_OF_NEGATIVE): New macros. + (DIVIDE_BY_ZERO): Use GMP_ERROR. + (__mp_bases): #define to __MPN(mp_bases). + +2000-04-11 Linus Nordberg + + * tests/rand/stat.c (main): Initialize `l1runs' at declaration. + +2000-04-11 Kevin Ryde + + * mpz/fib_ui.c: Add K&R function definitions. + + * mpbsd/tests/Makefile.am (TESTS): Add a dummy test to avoid a + shell problem with an empty "for tst in $(TESTS) ; ...". + * mpbsd/tests/dummy.c: New file. + +2000-04-10 Torbjorn Granlund + + * mpz/bin_uiui.c: Delete several unused variables. + Add copyright notice. + * mpz/bin_ui.c: Add copyright notice. + + * longlong.h: Declare __count_leading_zeros for alpha. + +2000-04-10 Linus Nordberg + + * rand.c (gmp_randinit): Change parameter list to (rstate, alg, ...). + * gmp.h: Change prototype accordingly. + * mpz/pprime_p.c (millerrabin): Change call accordingly. + + * configure.in: Check for `optarg'. + * configure: Regenerate. + + * mpn/Makefile.am: Remove incorrect comment. + * mpn/Makefile.in: Regenerate. + + * gmp.h: Rename most of the random number functions, structs and some + of the struct members. + * rand.c (gmp_randinit): Likewise. + * randclr.c (gmp_randclear): Likewise. + * randlc.c (gmp_randinit_lc): Likewise. + * randlc2x.c (gmp_randinit_lc_2exp): Likewise. + * randraw.c (lc): Likewise. + (_gmp_rand_getraw): Likewise. + * randsd.c (gmp_randseed): Likewise. + * randsdui.c (gmp_randseed_ui): Likewise. + * gmp.texi: Likewise. + + * gmp.texi: Use three hyphens for a dash. + (Low-level Functions): Remove documentation for gmp_rand_getraw. + (Random Number Functions): Add info on where to find documentation + on the random number functions. + + * tests/rand/Makefile.am (test, bigtest): Quote argument to grep. + * tests/rand/Makefile.in: Regenerate. + + * tests/rand/gen.c: Declare optarg, optind, opterr if not already + declared. + (main): Use new names for the random stuff. + (main): Don't use strtoul() if we don't have it. Use strtol() + instead, if we have it. Otherwise, use atoi(). + (main): Use srandom/srandomdev for __FreeBSD__ only. + (main): Use new parameter order to gmp_randinit(). + + * tests/rand/stat.c: Declare optarg, optind, opterr if not already + declared. + +2000-04-10 Torbjorn Granlund + + * mpz/pprime_p.c: Pass 0L for mpz_scan1. mpz_mmod => mpz_mod. + (millerrabin): Use new random interface. + (millerrabin): ... and don't forget to call gmp_randclear. + + * mpz/nextprime.c: New file. + * gmp.h: Declare mpz_nextprime. + * mpz/Makefile.am: List nextprime.c. + * mpz/Makefile.in: Regenerate. + * Makefile.am: List mpz/nextprime.lo. + * Makefile.in: Regenerate. + +2000-04-10 Kevin Ryde + + * move-if-change, mpz/tests/move-if-change, mpq/tests/move-if-change, + mpf/tests/move-if-change: Remove, no longer used. + + * Makefile.am (SUBDIRS): Add tests, demos, mpbsd. + (libmp.la): New target, conditional on WANT_MPBSD. + (libgmp_la_LIBADD): Add -lm. + (AUTOMAKE_OPTIONS): Add check-news. + (include_HEADERS): Setup to install gmp.h and possibly mp.h. + (DISTCLEANFILES): Add generated files. + (check): Remove explicit target (now uses check-recursive). + + * configure.in: Use AM_CONFIG_HEADER. + Add --enable-mpbsd setting automake conditional WANT_MPBSD. + Output demos/Makefile, mpbsd/Makefile and mpbsd/tests/Makefile. + + * mpz/Makefile.am: Add SUBDIRS=tests, shorten INCLUDES since now + using AM_CONFIG_HEADER. + * mpq/Makefile.am: Ditto. + * mpf/Makefile.am: Ditto, and add DISTCLEANFILES. + * mpn/Makefile.am: Shorten INCLUDES, amend some comments. + * mpz/tests/Makefile.am: Use TESTS and $(top_builddir). + * mpf/tests/Makefile.am: Ditto. + * mpq/tests/Makefile.am: Ditto. + * demos/Makefile.am: New file. + + * mpbsd/Makefile.am: New file, derived from old mpbsd/Makefile.in. + * mpbsd/Makefile.in: Now generated from Makefile.am. + * mpbsd/realloc.c: Removed, use mpz/realloc.c instead. + * mpbsd/tests/Makefile.am: New file. + * mpbsd/tests/Makefile.in: New file, generated from Makefile.am. + * mpbsd/tests/allfuns.c: New file. + + * gmp.texi (Top): Use @ifnottex, to help makeinfo --html. + (Installing MP): Describe --enable-mpbsd and demo programs. + + * tests/rand/statlib.c: mpz_cmp_abs => mpz_cmpabs. + + * tests/rand/Makefile.am (LDADD): Don't need -lm (now in libgmp.la). + (EXTRA_PROGRAMS): Not noinst_PROGRAMS. + (INCLUDES): Shorten to -I$(top_srcdir) now using AM_CONFIG_HEADER. + +2000-04-09 Torbjorn Granlund + + * mpz/urandomm.c: Get type of count right. + Simplify computation of nbits. + +2000-04-08 Torbjorn Granlund + + * mpz/urandomb.c: Fix reallocation condition. + Simplify size computation. + +2000-04-08 Linus Nordberg + + * acinclude.m4 (GMP_CHECK_CC_64BIT): Add special handling for + HPUX. + (GMP_CHECK_ASM_W32): Ditto. + * aclocal.m4: Regenerate. + + * mpn/Makefile.am: Use $(CCAS) for assembling. + (.asm.obj): Add rule. + * mpn/Makefile.in: Regenerate. + + * gmp.texi (Miscellaneous Integer Functions): Fix typos. + + * configure.in: Never pass `-h' to grep. + (mips-sgi-irix6.[2-9]*): Try to find 64-bit compiler. + (hppa1.0*-*-*): New flag for cc. + (hppa2.0*-*-*): Try to find 64-bit compiler. Chose path, set + CCAS. + * configure: Regenerate. + +2000-04-08 Torbjorn Granlund + + * mpz/bin_ui.c: Don't depend on ANSI C features. + * mpz/bin_uiui.c: Likewise. + + * Makefile.am (MPZ_OBJECTS): mpz/cmp_abs* => mpz/cmpabs*. + (MPQ_OBJECTS): Add mpq/set_d.lo. + (MPZ_OBJECTS): Add mpz/fits*.lo. + * Makefile.in: Regenerate. + + * mpz/cmpabs.c: New name for mpz/cmp_abs.c. + * mpz/cmpabs_ui.c: New name for mpz/cmp_abs_ui.c. + * mpz/Makefile.am: Corresponding changes. + * mpz/Makefile.in: Regenerate. + * gmp.h: mpz_cmp_abs* => mpz_cmpabs*. + + * mpz/addmul_ui.c (mpn_neg1): Don't depend on ANSI C features. + + * mpz/invert.c: Use TMP_MARK since we invoke MPZ_TMP_INIT. + + * gmp.h (mpq_set_d): Declare correctly. + (mpz_root): Use _PROTO. + (mpz_remove): Use _PROTO. + (mpf_pow_iu): Use _PROTO. + + * mpn/asm-defs.m4 (MPN_PREFIX): Revert previous change. + * gmp.h (__MPN): Revert previous change. + + * mpz/perfpow.c: De-ANSI-fy. Add copyright notice. + + * mpz/set_d.c: Misc cleanups. + + * mpq/set_d: New file. + * gmp.h: Declare mpq_set_d. + * mpq/Makefile.am: List set_d.c. + * mpq/Makefile.in: Regenerate. + +2000-04-07 Torbjorn Granlund + + * mpz/fits_sint_p.c: New file. + * mpz/fits_slong_p.c: New file. + * mpz/fits_sshort_p.c: New file. + * mpz/fits_uint_p.c: New file. + * mpz/fits_ulong_p.c: New file. + * mpz/fits_ushort_p.c: New file. + * gmp.h: Declare mpz_fits_*. + * mpz/Makefile.am: List fits_* files. + * mpz/Makefile.in: Regenerate. + +2000-04-06 Kevin Ryde + + * gmp.texi (Installing MP): Add known build problem SunOS 4.1.4 m4 + failure. + + * mpn/x86/pentium/gmp-mparam.h: Tune thresholds. + * mpn/x86/p6/gmp-mparam.h: Ditto. + * mpn/x86/k6/gmp-mparam.h: Tune thresholds, add UMUL_TIME, UDIV_TIME. + * mpn/x86/k7/gmp-mparam.h: Tune thresholds, amend UMUL_TIME. + + * mpn/generic/mul_n.c (mpn_kara_mul_n): Add an ASSERT. + (mpn_kara_sqr_n): Add an ASSERT, use KARATSUBA_SQR_THRESHOLD. + (mpn_toom3_sqr_n): Eliminate second evaluate3. + + * gmp-impl.h (mpn_com_n,MPN_LOGOPS_N_INLINE): Don't allow size==0. + (tune_mul_threshold,tune_sqr_threshold): Conditionalize + declarations on TUNE_PROGRAM_BUILD. + + * mpn/generic/sqr_basecase.c: Add an assert. + +2000-04-05 Torbjorn Granlund + + * gmp.h, mpn/asm-defs.m4: List the same functions for __MPN, but + leave some commented out. + + * gmp-impl.h (MPN_LOGOPS_N_INLINE): Optimize. + (mpn_com_n): Optimize. + + * gmp.h (__MPN): Make it use __gmpn instead of __mpn for consistency. + * mpn/asm-defs.m4 (MPN_PREFIX): Likewise. + + * gmp.h (GMP_ERROR_ALLOCATE): New errcode. + + * gmp-impl.h (MPN_MUL_N_RECURSE): Delete. + (MPN_SQR_RECURSE): Delete. + + * gmp-impl.h (TARGET_REGISTER_STARVED): New define. + + * gmp-impl.h (mpn_kara_sqr_n): Remap with __MPN. + (mpn_toom3_sqr_n): Likewise. + (mpn_kara_mul_n): Likewise. + (mpn_toom3_mul_n): Likewise. + (mpn_reciprocal): Likewise. + + * gmp-impl.h (__gmpn_mul_n): Remove declaration. + (__gmpn_sqr): Likewise. + * gmp.h (mpn_sqr_n): Declare/remap. + * mpn/generic/mul.c (mpn_sqr_n): New name for mpn_sqr. + + * gmp.h (mpn_udiv_w_sdiv): Move __MPN remap from here... + * gmp-impl.h: ...to here. + +2000-04-05 Linus Nordberg + + * gmp.texi (Top): Add `Random Number Functions' to menu. + (Introduction to MP): Fix typo. + (MP Basics): Create menu for all sections. Move `Random Number + Functions' to its own chapter. Add nodes for all sections. + (Function Classes): Mention random generation functions under + miscellaneous. + (Miscellaneous Integer Functions): Update mpz_urandomb, + mpz_urandomm. + (Low-level Functions): Remove mpn_rawrandom. + (Random State Initialization): Update. + + * mpf/urandom.c (mpf_urandomb): Remove SIZE parameter. Normalize + result correctly. + + * gmp.h (mpf_urandomb): Remove SIZE parameter. + + * randraw.c (gmp_rand_getraw): Handle the case where (1) the LC + scheme doesn't generate even limbs and (2) more than one LC + invocation is necessary to produce the requested number of bits. + +2000-04-05 Torbjorn Granlund + + * mpn/generic/mul_n.c (INVERSE_3): New name for THIRD, define for + any BITS_PER_MP_LIMB. + (MP_LIMB_T_MAX): New. + (mpn_divexact3_n): Remove. + (interpolate3): Use mpn_divexact_by3 instead of mpn_divexact3_n. + +2000-04-05 Kevin Ryde + + * gmp-impl.h (KARATSUBA_MUL_THRESHOLD<2): Remove cpp test. + (tune_mul_threshold,tune_sqr_threshold): Add declarations, used in + development only. + + * mpn/x86/k7/sqr_basecase.asm: New file, only a copy of k6 for now. + +2000-04-04 Torbjorn Granlund + + * gmp-impl.h (TOOM3_MUL_THRESHOLD): Provide default. + (TOOM3_SQR_THRESHOLD): Provide default. + + * mpn/generic/mul_n.c: Rewrite (mostly by Robert Harley). + * mpn/generic/mul.c: Rewrite (mostly by Robert Harley). + + * configure.in (sparcv9 64-bit OS): Set extra_functions. + +2000-04-04 Linus Nordberg + + * mpn/generic/rawrandom.c: Remove file and replace with randraw.c + on top level. + (mpn_rawrandom): Rename to gmp_rand_getraw. + + * randraw.c: New file; essentially a copy of + mpn/generic/rawrandom.c. + (gmp_rand_getraw): New function (formerly known as mpn_rawrandom). + + * mpz/urandomb.c (mpz_urandomb): Change mpn_rawrandom --> + gmp_rand_getraw. + * mpz/urandomm.c (mpz_urandomb): Ditto. + * mpf/urandom.c (mpf_urandomb): Ditto. + + * gmp.h (gmp_rand_getraw): Add function prototype. + (mpn_rawrandom): Remove function prototype. + + * Makefile.am (libgmp_la_SOURCES): Add randraw.c. + * Makefile.in: Regenerate. + + * configure.in (gmp_mpn_functions): Remove rawrandom. + * configure: Regenerate. + +2000-04-04 Linus Nordberg + + * gmp.h (GMP_ERROR enum): Remove comma after last enumeration + since the AIX compiler (xlc) doesn't like that. + + * randlc.c (gmp_rand_init_lc): Allocate enough space for seed to + hold any upcoming seed. + * randlc2x.c (gmp_rand_init_lc_2exp): Likewise. + + * mpn/generic/rawrandom.c: Remove debugging code. + (mpn_lc): Don't reallocate seed. + + * mpz/urandomm.c (mpz_urandomm): Implement function. + + * mpz/urandomb.c (mpz_urandomb): Fix typo in function definition. + +2000-04-04 Kevin Ryde + + * make.bat: Removed (no longer works, no longer supported). + * mpn/msdos/asm-syntax.h: Removed (was used only by make.bat). + +2000-04-03 Torbjorn Granlund + + * mpn/generic/brandom.c: New file, replacing random2. + +2000-04-02 Torbjorn Granlund + + * mpn/sparc32/v9/submul_1.asm: Change some carry-form instructions + into their plain counterparts. + + * mpn/sparc64/copyi.asm: Avoid executing ALIGN. + + * mpn/sparc64/mul_1.asm: Handle overlap of rp/sp. + * mpn/sparc64/addmul_1.asm: Likewise. + * mpn/sparc64/submul_1.asm: Likewise. + +2000-04-01 Linus Nordberg + + * gmp.h: Fix function prototypes for randomization functions. + (__gmp_rand_lc_scheme_struct): Replace `m' with `m2exp'. Remove + unused `bits'. + (__gmp_rand_data_lc): Add `m2exp' as another way of representing + the modulus. + (__gmp_rand_state_struct): Remove unused `size'. + + * rand.c (__gmp_rand_scheme): Use better multipliers. Remove test + schemes. Replace `m' with `m2exp'. + (gmp_rand_init): Change parameters and return type. Use `m2exp' + instead of `m'. Set `gmp_errno' on error. Disable BBS algorithm. + + * randlc.c (gmp_rand_init_lc): Don't use malloc(). Change + parameters. + + * randclr.c (gmp_rand_clear): Don't use free(). Disable BBS + algorithm. Set `gmp_errno' on error. + + * randlc2x.c (gmp_rand_init_lc_2exp): New function. + * randsd.c (gmp_rand_seed): New function. + * randsdui.c (gmp_rand_seed_ui): New function. + * randlcui.c: Remove unused file. + + * mpn/generic/rawrandom.c (mpn_rawrandom): Rewrite. + (mpn_lc): New static function. + + * mpz/urandomb.c (mpz_urandomb): Use ABSIZ() instead of SIZ() for + determining size of ROP. + + * mpf/urandom.c (mpf_urandomb): Add third parameter, nbits. (Not + used yet!) + Change parameter order to mpn_rawrandom(). + + * Makefile.am (libgmp_la_SOURCES): Add errno.c, randlc2x.c, + randsd.c, randsdui.c. Remove randui.c. + (MPZ_OBJECTS): Rename urandom.lo --> urandomb.lo. Add urandomm.lo. + * Makefile.in: Regenerate. + + * mpz/Makefile.am (libmpz_la_SOURCES): Change urandom.c --> + urandomb.c. Add urandomm.c. + * mpz/Makefile.in: Regenerate. + + * tests/rand/Makefile.am (noinst_PROGRAMS): Change findcl --> findlc. + Add gen.static. + * tests/rand/Makefile.in: Regenerate. + + * tests/rand/gen.c (main): Add mpz_urandomm. Add command line options + `-C', `-m', extend `-a'. Use *mp*_*rand*() with new parameters. Call + gmp_rand_seed(). + +2000-04-01 Kevin Ryde + + * acinclude.m4 (GMP_CHECK_ASM_DATA): Plain .data for hpux. + * configure.in (CCAS): No CFLAGS, they're added when it's used. + (CONFIG_SRCDIR): New define for config.m4. + * mpn/sparc64/addmul_1.asm: Use it for an include(). + * mpn/sparc64/submul_1.asm: Ditto. + * mpn/sparc64/mul_1.asm: Ditto. + +2000-03-31 Linus Nordberg + + * mpz/urandom.c: Rename to... + * mpz/urandomb.c: ...this. + + * mpz/urandomb.c (mpz_urandomb): Change operand order in call to + mpn_rawrandom(). Use ABSIZ() instead of SIZ() when checking size + of ROP. + + * mpz/urandomm.c: New file. + +2000-03-31 Kevin Ryde + + * acinclude.m4 (GMP_CHECK_ASM_MMX): Give a warning when mmx code + will be omitted. + +2000-03-30 Torbjorn Granlund + + * mpn/sparc64/mul_1h.asm: New file. + * mpn/sparc64/addmul_1h.asm: New file. + * mpn/sparc64/submul_1h.asm: New file. + * mpn/sparc64/mul_1.asm: Rewrite. + * mpn/sparc64/addmul_1.asm: Rewrite. + * mpn/sparc64/submul_1.asm: Rewrite. + +2000-03-28 Torbjorn Granlund + + * mpn/sparc32/v9/mul_1.asm: Fix typo in branch prediction. + * mpn/sparc32/v9/addmul_1.asm: Likewise. + * mpn/sparc32/v9/submul_1.asm: Likewise. + +2000-03-25 Kevin Ryde + + * mpn/lisp/gmpasm-mode.el: Fix some comment detection, use custom, + fontify more keywords, turn into a standalone mode. + + * stamp-vti: New file, generated together with version.texi. + + * acinclude.m4 (GMP_VERSION,GMP_HEADER_GETVAL): New macros. + * configure.in (AM_INIT_AUTOMAKE): Use GMP_VERSION. + +2000-03-24 Kevin Ryde + + * INSTALL: Updates for new configure system. + + * configure.in: Add gmp_optcflags_gcc for the x86s, setting -mcpu + and -march. + +2000-03-23 Torbjorn Granlund + + * demos/pexpr.c (mpz_eval_expr): Properly initialize rhs/lhs + for ROOT. + +2000-03-23 Kevin Ryde + + * config.guess (i?86:*:*:*): Use uname -m if detection program fails. + + * mpn/x86/README: Remove remarks on the now implemented MMX shifts. + * mpn/x86/k6/README: Add speed of mpn_divexact_by3, update mpn_mul_1. + + * gmp.texi (Installing MP): Corrections to target CPUs. + + * version.c: Use VERSION from config.h, add copyright comment, + restore "const" somehow lost. + + * configure.in (a29k*-*-*): Fix directory name. + +2000-03-22 Torbjorn Granlund + + * demos/pexpr.c (op_t): Add ROOT. + (fns): Add ROOT. + (mpz_eval_expr): Add ROOT. + + * mpz/root.c: Handle roots of negative numbers. + Fix other border cases. + Fix rare memory leakage. + + * errno.c: New file. + +2000-03-21 Torbjorn Granlund + + * gmp.h (error number enum): New anonymous enum. + (gmp_errno): New. + + * gmp.h (__GNU_MP_VERSION, __GNU_MP_VERSION_MINOR): Bump for GMP 3.0. + +2000-03-20 Torbjorn Granlund + + * mpn/alpha/unicos.m4 (FLOAT64): New define. + * mpn/alpha/default.m4 (FLOAT64): New define. + * mpn/alpha/invert_limb.asm (C36): Use FLOAT64. + +2000-03-21 Kevin Ryde + + * mpn/x86/k6/diveby3.asm: Tiny speedup. + + * acinclude.m4 (GMP_CHECK_ASM_SHLDL_CL): New macro. + * configure.in: Use it, set WANT_SHLDL_CL in config.m4. + * mpn/x86/x86-defs.m4 (shldl,shrdl,shldw,shrdw): New macros, using + WANT_SHLDL_CL. + * mpn/x86/k6/mmx/lshift.asm: Use shldl macro. + * mpn/x86/k7/mmx/lshift.asm: Ditto. + * mpn/x86/pentium/mmx/lshift.asm: Ditto. + * mpn/x86/k6/mmx/rshift.asm: Use shrdl macro. + * mpn/x86/k7/mmx/rshift.asm: Ditto. + * mpn/x86/pentium/mmx/rshift.asm: Ditto. + * mpn/x86/README.family: Add a note about this. + +2000-03-20 Linus Nordberg + + * mpn/generic/rawrandom.c (mpn_rawrandom): Handle seed value of 0 + correctly. + + * configure.in: Fix detection of alpha flavour. + Set compiler options for `sparcv8'. + * configure: Regenerate. + + * rand.c (__gmp_rand_scheme): Clean up some. Use slightly better + multipliers. + + * configure.in (AC_OUTPUT): Add tests/Makefile and + tests/rand/Makefile. + + * acinclude.m4 (AC_CANONICAL_BUILD): Define to + `_AC_CANONICAL_BUILD' to deal with incompatibilities between + Autoconf and Libtool. + (AC_CHECK_TOOL_PREFIX): Likewise. + + * Makefile.am (EXTRA_DIST): Add directory `tests'. + + * mkinstalldirs: Update (Automake 2000-03-17). + * ltconfig: Update (Libtool 2000-03-17). + * ltmain.sh: Ditto. + + * configure: Regenerate with new autoconf/-make/libtool suite. + * aclocal.m4: Ditto. + * config.in: Ditto. + * all Makefile.in's: Ditto. + +2000-03-20 Torbjorn Granlund + + * demos/pexpr.c (main): Don't allow `-N' for base, require `-bN'. + + * mpn/alpha/unicos.m4 (cvttqc): New define. + * mpn/alpha/invert_limb.asm: Use new define for cvttqc. + +2000-03-19 Kevin Ryde + + * mpn/x86/k6/sqr_basecase.asm: Tiny amendments for 3x3 case. + + * gmp.texi: Use @include version.texi. + Use @email and @uref. + (Installing MP): Rewrite for new configure. + (Low-level Functions): Add mpn_divexact_by3. + + * configure.in (--enable-alloca): New option. + * acconfig.h (USE_STACK_ALLOC): For --disable-alloca. + +2000-03-18 Kent Boortz + + * macos: New directory with macos port files. + +2000-03-17 Torbjorn Granlund + + * gmp-impl.h (union ieee_double_extract): Check _CRAYMPP. + + * mpn/asm-defs.m4 (invert_normalized_limb): Define. + + * mpn/alpha: Translate `.s' files to `.asm'. + + * configure: Regenerate. + + * mpn/alpha/invert_limb.asm: Replace dash in file name with underscore. + * configure.in: Corresponding change. + + * configure.in: Assign special "path" for alphaev6. + + * mpn/alpha/unicos.m4: New file. + * configure.in (alpha*-cray-unicos*): [This part of the change + commited 2000-03-13 by linus] + * mpn/alpha/default.m4: New file. + * configure.in (alpha*-*-*): Use it. + +2000-03-17 Kevin Ryde + + * mpn/x86/pentium/rshift.S: Use plain rcrl (not rcrl $1) for + shift-by-1 case, significant speedup. + * mpn/x86/pentium/README: Add shift-by-1 speed. + +2000-03-16 Torbjorn Granlund + + * config.guess: Handle Cray T3D/E. + +2000-03-15 Kevin Ryde + + * mpn/generic/diveby3.c: New file. + * mpn/x86/diveby3.asm: New file. + * mpn/x86/k6/diveby3.asm: New file. + * gmp.h (mpn_divexact_by3): Prototype and define. + * mpn/asm-defs.m4: define_mpn(divexact_by3). + * configure.in (gmp_mpn_functions): Add diveby3. + + * mpn/x86/pentium/sqr_basecase.asm: A few better addressing modes. + + * configure.in: Add AC_C_STRINGIZE and AC_CHECK_TYPES((void)). + * gmp-impl.h (ASSERT): Use them. + + * mpn/x86/k7/mmx/lshift.asm: New file. + * mpn/x86/k7/mmx/rshift.asm: Rewrite simple loop and return value + handling, add some pictures. + +2000-03-14 Torbjorn Granlund + + * mpn/sparc32/v8/mul_1.asm: Make PIC actually work. + * mpn/sparc32/v8/addmul_1.asm: Likewise. + + * mpn/sparc32/v8/mul_1.asm: Use m4 ifdef, not cpp #if. + * mpn/sparc32/v8/addmul_1.asm: Likewise. + + * mpn/asm-defs.m4 (C): New define for comments. + * mpn/sparc32: Start comments with `C'. + + * config.guess: Remove `SunOS 6' handling. + Recognize sun4m and sun4d architectures under old SunOS. + +2000-03-14 Linus Nordberg + + * configure.in (gmp_srclinks): Set to list of links created by + configure. + * configure: Regenerate. + + * Makefile.am (libgmp_la_LDFLAGS): Set version info. + (DISTCLEANFILES): Include @gmp_srclinks@. + * Makefile.in: Regenerate. + +2000-03-13 Linus Nordberg + + * configure.in: Remove some changequote's by quoting the strings + containing `[]'. + Add support for `alpha*-cray-unicos*'. + AC_DEFINE `_LONG_LONG_LIMB' instead of passing it in CFLAGS. + Conditionalize the assembler syntax checks. + * configure: Regenerate. + * config.in: Regenerate. + + * acinclude.m4 (GMP_PROG_CCAS): Remove macro. + * aclocal.m4: Regenerate. + +2000-03-13 Kevin Ryde + + * mpn/x86/p6/README: New file. + + * mpn/x86/k6/mul_1.asm: Rewrite, smaller and slightly faster. + + * mpn/lisp/gmpasm-mode.el: Rewrite assembler comment detection and + handling. + + * configure.in: Separate mmx directories for each x86 flavour. + * configure: Regenerate. + +2000-03-12 Kevin Ryde + + * mpn/x86/x86-defs.m4 (ALIGN): Supplement definition from + config.m4 so as to pad with nops not zeros on old gas. + + * mpn/x86/k7/mmx/copyd.asm: Use plain emms (femms is just an alias + for emms now). + * mpn/x86/k7/mmx/copyi.asm: Ditto. + * mpn/x86/k7/mmx/rshift.asm: Ditto. + * mpn/x86/x86-defs.m4: Amend comments. + + * mpn/x86/mod_1.asm: Add comments on speeds. + + * mpn/x86/pentium/mmx/lshift.asm: New file. + * mpn/x86/pentium/mmx/rshift.asm: New file. + * mpn/x86/pentium/README: Add speeds of various routines. + +2000-03-10 Linus Nordberg + + * configure.in: Reorganize. + Use AC_CHECK_TOOL to find `ar'. + Add post-includes `regmap.m4' and `aix.m4' for AIX targets. + asm-syntax.h is not needed for PPC or sparc anymore. + (powerpc64-*-aix*): Compiler is always 64-bit. Use `-q64 + -qtune=pwr3' to xlc and `-maix64 -mpowerpc64' to gcc. Pass `-X + 64' to `ar' and `nm'. + (pentiummmx): Use GMP_CHECK_ASM_MMX and avoid MMX assembly path if + assembler is not MMX capable. + (pentium[23]): Likewise. + (athlon): Likewise. + (k6*): Likewise. + * configure: Regenerate. + + * acinclude.m4 (GMP_PROG_CC_WORKS): New macro. + (GMP_PROG_CC_FIND): Use GMP_PROG_CC_WORKS instead of + AC_TRY_COMPILER. Make sure that the *first* working 32-bit + compiler is used if no 64-bit compiler is found. + (GMP_CHECK_ASM_MMX): New macro. + * aclocal.m4: Regenerate. + + * Makefile.in: Regenerate. (CC_TEST removed.) + * mpf/Makefile.in: Likewise. + * mpn/Makefile.in: Likewise. + * mpq/Makefile.in: Likewise. + * mpz/Makefile.in: Likewise. + * mpf/tests/Makefile.in: Likewise. + * mpq/tests/Makefile.in: Likewise. + * mpz/tests/Makefile.in: Likewise. + + * acconfig.h (_LONG_LONG_LIMB): Add. + + * gmp-impl.h: Include config.h only if HAVE_CONFIG_H is defined. + +2000-03-09 Kevin Ryde + + * mpn/x86/pentium/mul_basecase.S: Small speedup by avoiding an AGI. + + * mpn/x86/k7/mmx/copyd.asm: Tiny speedup by avoiding popl. + * mpn/x86/k7/mmx/copyi.asm: Ditto. + * mpn/x86/k7/mul_basecase.asm: Ditto. + +2000-03-07 Torbjorn Granlund + + * config.guess: Better recognize POWER/PowerPC processor type. + +2000-03-07 Kevin Ryde + + * mpn/generic/addsub_n.c: Use HAVE_NATIVE_* now in config.h. + + * mpn/asm-defs.m4: Add comments about SysV m4. + (m4_log2): Don't use <<. + (m4_lshift,m4_rshift): New macros. + +2000-03-06 Torbjorn Granlund + + * mpn/powerpc32/regmap.m4: Map cr0 => `0', etc. + +2000-03-06 Kevin Ryde + + * mpn/tests/ref.c (refmpn_divexact_by3): New function. + * mpn/tests/ref.h: Prototype. + + * acconfig.h (WANT_ASSERT): New define. + * configure.in (--enable-assert): Turn on WANT_ASSERT. + * assert.c: New file. + * Makefile.am: Add to build. + * gmp-impl.h (ASSERT): New macro. + (ASSERT_NOCARRY) Renamed from assert_nocarry. + (MPZ_CHECK_FORMAT): Use ASSERT_ALWAYS. + * mpn/tests/ref.c: Use ASSERT. + * mpf/get_str.c: Use ASSERT_ALWAYS. + * mpf/set_str.c: Remove old assert macro. + + * mpn/x86/x86-defs.m4 (cmovnz_ebx_ecx): New macro. + * mpn/x86/p6/aorsmul_1.asm: Use cmov. + + * mpn/x86/lshift.S: Use %dl with testb, not %edx. No object code + change, testb was still getting generated. + * mpn/x86/rshift.S: Ditto. + +2000-03-03 Torbjorn Granlund + + * longlong.h: Add IA-64 support. + + * mpn/powerpc32: Misc cleanups. + * mpn/powerpc32/aix.m4: New file (mainly by Linus). + * mpn/powerpc64/aix.m4: New file (mainly by Linus). + * mpn/powerpc64: Translate `.S' files to `.asm'. + + * configure.in: Fix tyops. + * configure: Regenerate. + +2000-03-02 Torbjorn Granlund + + * mpn/powerpc32/regmap.m4: New file. + * mpn/powerpc32: Translate `.S' files to `.asm'. + * configure.in: Use mpn/powerpc32/regmap.m4 for powerpc targets + except some weird ones. + +2000-03-03 Kevin Ryde + + * mpn/lisp/gmpasm-mode.el: Suppress postscript comment prefixes in + filladapt. + + * mpn/x86/pentium/sqr_basecase.asm: New file. + * mpn/x86/pentium/gmp-mparam.h (KARATSUBA_SQR_THRESHOLD): Update. + + * configure.in: Add --enable-assert, enable k6 logops functions. + + * mpn/x86/k6/mmx/copyi.asm: Use m4 for divide, not as. + * mpn/x86/k6/mmx/copyd.asm: Ditto. + * mpn/x86/README.family: Add a note on this. + +2000-03-02 Kevin Ryde + + * mpn/x86/k6/aors_n.asm: Don't use stosl. + * mpn/x86/copyi.asm: Use cld to clear direction flag. + * mpn/x86/divrem_1.asm: Ditto. + * mpn/x86/README.family: Add a note on this. + + * mpn/x86/k6/mmx/copyi.asm: Rewrite. + * mpn/x86/k6/mmx/copyd.asm: New file. + * mpn/x86/k6/README: Update, and small amendments. + + * mpn/x86/x86-defs.m4 (Zdisp): New macro. + * mpn/asm-defs.m4 (m4_stringequal_p): New macro. + + * mpn/x86/p6/aorsmul_1.asm: Use Zdisp to force zero displacements. + * mpn/x86/k6/aorsmul_1.asm: Ditto. + * mpn/x86/k6/mul_1.asm: Ditto. + * mpn/x86/k6/mul_basecase.asm: Ditto. + * mpn/x86/k7/aors_n.asm: Ditto. + * mpn/x86/k7/aorsmul_1.asm: Ditto. + * mpn/x86/k7/mul_1.asm: Ditto. + * mpn/x86/k7/mul_basecase.asm: Ditto. + * mpn/x86/README.family: Add a note on this. + +2000-02-27 Kevin Ryde + + * mpn/generic/divrem.c (mpn_divrem_classic): Patch to avoid gcc + 2.7.2.3 i386 register handling bug. + + * mpn/x86/k6/aors_n.asm: Rewrite. + * mpn/x86/k6/mmx/lshift.asm: Rewrite. + * mpn/x86/k6/mmx/rshift.asm: Rewrite. + * mpn/x86/k6/README: Update. + + * mpn/x86/k7/mmx/copyd.asm: Support size==0. + * mpn/x86/k7/mmx/copyi.asm: Ditto. + * mpn/x86/k6/mmx/copyi.asm: Ditto. + * gmp-impl.h: Comment size==0 allowed in MPN_COPY_INCR and + MPN_COPY_DECR. + * configure.in: Enable x86 copyi, copyd; add k6 com_n. + +2000-02-25 Torbjorn Granlund + + * demos/pexpr.c (power): Move factorial handing code from `factor' + to `power'. + + * demos/factorize.c (factor_using_pollard_rho): Move resetting of `c' + to before checking for a non-zero gcd. + +2000-02-25 Kevin Ryde + + * mpn/asm-defs.m4 (MULFUNC_PROLOGUE): New macro by Linus. + * mpn/x86/k6/aors_n.asm: Use MULFUNC_PROLOGUE. + * mpn/x86/k6/aorsmul_1.asm: Ditto. + * mpn/x86/k7/aors_n.asm: Ditto. + * mpn/x86/k7/aorsmul_1.asm: Ditto. + * mpn/x86/p6/aorsmul_1.asm: Ditto. + + * mpn/tests/ref.c (refmpn_copyi,refmpn_copyd): Allow size==0. + + * gmp-impl.h: Move mpn_and_n, mpn_andn_n, mpn_com_n, mpn_ior_n, + mpn_iorn_n, mpn_nand_n, mpn_nior_n, mpn_xor_n and mpn_xorn_n here + from gmp.h. Use HAVE_NATIVE_mpn_* to make these functions or + inlines. + + * gmp-impl.h: Move mpn_copyd, mpn_copyi here from gmp.h. + * gmp-impl.h (MPN_COPY_INCR): Use mpn_copyi if available. + * gmp-impl.h (MPN_COPY_DECR): Use mpn_copyd if available. + + * mpn/x86/k6/mmx/com_n.asm: Moved into mmx subdirectory. + * mpn/x86/k6/mmx/copyi.asm: Ditto. + * mpn/x86/k6/mmx/lshift.asm: Ditto. + * mpn/x86/k6/mmx/rshift.asm: Ditto. + * mpn/x86/k7/mmx/rshift.asm: Ditto. + * mpn/x86/k6/mmx/logops_n.asm: New file. + * configure.in (k6*-*-*): Add logops_n.asm. + * mpn/x86/k6/README: Update. + + * mpn/x86/k7/mmx/copyi.asm: New file. + * mpn/x86/k7/mmx/copyd.asm: New file. + * mpn/x86/k7/README: Update. + +2000-02-24 Kevin Ryde + + * mpn/x86/x86-defs.m4 (femms): Generate emms if 3dnow not available. + * mpn/x86/x86-defs.m4 (FRAME_popl): New macro. + + * Makefile.am: Add info_TEXINFOS = gmp.texi + + * mpn/x86/divrem_1.asm: Moved from mpn/x86/k6, allow size==0, + conditionalize loop versus decl/jnz. + * mpn/x86/mod_1.asm: Ditto. + * mpn/x86/divmod_1.asm: Removed. + * gmp.texi (mpn_divrem_1,mpn_mod_1): Add that size==0 is allowed. + * mpn/tests/ref.c (refmpn_divrem_1c,etc): Allow size==0. + + * mpn/x86/k6/aors_n.asm: Avoid gas 1.92.3 leal displacement + expression problem. + * mpn/x86/k6/aorsmul_1.asm: Ditto. + * mpn/x86/k6/mul_1.asm: Ditto. + * mpn/x86/k6/mul_basecase.asm: Ditto + * mpn/x86/k7/aors_n.asm: Ditto. + * mpn/x86/k7/aorsmul_1.asm: Ditto. + * mpn/x86/k7/mul_1.asm: Ditto. + * mpn/x86/k7/mul_basecase.asm: Ditto. + * mpn/x86/k7/rshift.asm: Ditto. + * mpn/x86/p6/aorsmul_1.asm: Ditto. + * mpn/x86/README.family: Describe problem. + +2000-02-24 Linus Nordberg + + * acinclude.m4 (GMP_CHECK_ASM_LSYM_PREFIX): Add dummy symbol to + testcase to avoid nm failure. Try nm before piping to grep. + + * acconfig.h: Undef HAVE_NATIVE_func for every mpn function found + in gmp.h. + + * configure.in: Invoke AC_CONFIG_HEADERS. + Don't invoke AM_CONFIG_HEADER; it makes autoconf confused. + Dig out entry points declared in assembly code and AC_DEFINE proper + HAVE_NATIVE_func. + + * mpn/asm-defs.m4 (MULFUNC_PROLOGUE): New macro. + + * mpn/x86/p6/aorsmul_1.asm: Use MULFUNC_PROLOGUE. + * mpn/x86/k6/aors_n.asm: Likewise. + + * Makefile.am (EXTRA_DIST): Add config.in; needed when we don't + use AM_CONFIG_HEADER in configure.in. + + * mpn/Makefile.am (INCLUDES): Add `-I..' for config.h and + gmp-mparam.h. + * mpf/Makefile.am: Likewise. + * mpq/Makefile.am: Likewise. + * mpz/Makefile.am: Likewise. + + * mpf/tests/Makefile.am (INCLUDES): Add `-I../..' for config.h and + gmp-mparam.h. + * mpq/tests/Makefile.am: Likewise. + * mpz/tests/Makefile.am: Likewise. + + * configure: Regenerate. + * aclocal.m4: Regenerate. + * config.in: Regenerate. + * Makefile.in: Regenerate. + * mpf/Makefile.in: Regenerate. + * mpn/Makefile.in: Regenerate. + * mpq/Makefile.in: Regenerate. + * mpz/Makefile.in: Regenerate. + * mpf/tests/Makefile.in: Regenerate. + * mpq/tests/Makefile.in: Regenerate. + * mpz/tests/Makefile.in: Regenerate. + +2000-02-23 Kevin Ryde + + * mpn/x86/addmul_1.S: Amend comments, this code no longer used by + PentiumPro. + * mpn/x86/submul_1.S: Ditto. + + * mpn/x86/k6/com_n.asm: Rewrite, smaller but same speed. + + * mpn/x86/addmul_1.S: Add PROLOGUE and EPILOGUE to get .type and + .size for ELF. Rename #define size to n to avoid .size. + * mpn/x86/lshift.S: Ditto. + * mpn/x86/mul_1.S: Ditto. + * mpn/x86/mul_basecase.S: Ditto. + * mpn/x86/rshift.S: Ditto. + * mpn/x86/submul_1.S: Ditto. + * mpn/x86/udiv.S: Ditto. + * mpn/x86/umul.S: Ditto. + * mpn/x86/pentium/add_n.S: Ditto. + * mpn/x86/pentium/addmul_1.S: Ditto. + * mpn/x86/pentium/lshift.S: Ditto. + * mpn/x86/pentium/mul_1.S: Ditto. + * mpn/x86/pentium/mul_basecase.S: Ditto. + * mpn/x86/pentium/rshift.S: Ditto. + * mpn/x86/pentium/sub_n.S: Ditto. + * mpn/x86/pentium/submul_1.S: Ditto. + +2000-02-22 Linus Nordberg + + * acinclude.m4 (GMP_INIT): Use temporary file cnfm4p.tmp for + post-defines. + (GMP_FINISH): Ditto. + (GMP_DEFINE): Add third optional argument specifying location in + outfile. + (GMP_DEFINE_RAW): New macro. + * aclocal.m4: Regenerate. + + * configure.in: Add `HAVE_TARGET_CPU_$target_cpu' using + GMP_DEFINE_RAW. + * configure: Regenerate. + + * mpz/tests/Makefile.am: New test t-root. + * mpz/tests/Makefile.in: Regenerate. + +2000-02-22 Torbjorn Granlund + + * mpz/root.c: Complete rewrite; still primitive, but at least correct. + * mpz/tests/t-root.c: New test. + +2000-02-22 Kevin Ryde + + * mpn/x86/k7/mul_basecase.asm: New file. + * mpn/x86/k7/README: Add mpn_mul_basecase speed. + * mpn/x86/k7/gmp-mparam.h: New file. + + * mpn/x86/x86-defs.m4 (loop_or_decljnz,cmov_bytes): New macros. + * mpn/asm-defs.m4 (m4_ifdef_anyof_p): New macro. + + * mpn/x86/k6/aorsmul_1.asm: New file. + * mpn/x86/k6/addmul_1.S: Removed (was a copy of pentium version). + * mpn/x86/k6/submul_1.S: Removed (was a copy of pentium version). + + * mpn/x86/p6/aorsmul_1.asm: Use OPERATION_addmul_1 and + OPERATION_submul_1. + * mpn/x86/k6/aors_n.asm: Use OPERATION_add_n and OPERATION_sub_n. + * configure.in: Declare multi-function files for k6 and p6. + + * configure.in: Add HAVE_TARGET_CPU_$target_cpu for config.m4. + * mpn/asm-defs.m4 (define_not_for_expansion): New macro. + + * mpn/generic/divrem_1n.c (__gmpn_divrem_1n): New file, split from + mpn/generic/divrem_1.c. + * mpn/generic/divrem_1.c: Ditto. + * configure.in (gmp_mpn_functions): Ditto. + +2000-02-21 Torbjorn Granlund + + * gmp.h: Undo 1996-10-06 NeXT change, it was clearly improperly + written. + +2000-02-21 Linus Nordberg + + * configure.in: Link /mpn/asm-defs.m4 to mpn/asm.m4. + * configure: Regenerate. + +2000-02-21 Linus Nordberg + + * mpn/x86/k7/aorsmul_1.asm: Change OPERATION_ADDMUL --> + OPERATION_addmul_1. Change OPERATION_SUBMUL --> + OPERATION_submul_1. + + * mpn/x86/k7/aors_n.asm: Change OPERATION_ADD --> OPERATION_add_n. + Change OPERATION_SUB --> OPERATION_sub_n. + + * mpn/Makefile.am: Pass -DOPERATION_$* to preprocessors. + * mpn/Makefile.in: Regenerate. + + * configure.in: Symlink mpn/asm-defs.m4 to build-dir/mpn. Link + multi-function files to mpn/.asm and remove function + name from `gmp_mpn_functions'. + * configure: Regenerate. + + * acinclude.m4 (GMP_FINISH): Tell user what we're doing. + * aclocal.m4: Regenerate. + +2000-02-21 Kevin Ryde + + * gmp-impl.h: Rename __gmpn_mul_basecase to mpn_mul_basecase and + __gmpn_sqr_basecase to mpn_sqr_basecase, remove __gmpn prototypes. + * mpn/x86/mul_basecase.S: Ditto. + * mpn/x86/pentium/mul_basecase.S: Ditto. + + * configure.in (gmp_m4postinc): Use x86-defs.m4 on athlon-*-* too. + +2000-02-20 Kevin Ryde + + * acinclude.m4 (GSYM_PREFIX): Drop $1, change by Linus. + * mpn/asm-defs.m4 (PROLOGUE,EPILOGUE): Use GSYM_PREFIX as a + string, change by Linus. + * mpn/x86/x86-defs.m4: Use GSYM_PREFIX as a string. + + * mpn/x86/k6/gmp-mparam.h: New file. + * mpn/asm-defs.m4 (m4_warning): New macro. + + * mpn/x86/README: Amendments per new code and directories. + * mpn/x86/README.family: New file. + * mpn/x86/k6/README: New file. + * mpn/x86/k7/README: New file. + + * mpn/generic/mul_n.c: Rename __gmpn_mul_basecase to + mpn_mul_basecase and __gmpn_sqr_basecase to mpn_sqr_basecase. + * mpn/generic/mul_basecase.c: Ditto. + * mpn/generic/sqr_basecase.c: Ditto. + * mpn/generic/mul.c: Ditto. + +2000-02-19 Linus Nordberg + + * configure.in: Don't try to symlink more than one multi-func + file. + * configure: Regenerate. + +2000-02-18 Linus Nordberg + + * acinclude.m4 (GMP_CHECK_ASM_UNDERSCORE): GMP_DEFINE + `GSYM_PREFIX'. Run ACTIONs even when value is found in cache. + (GMP_CHECK_ASM_ALIGN_LOG): GMP_DEFINE `ALIGN'. Run ACTIONs even + when value is found in cache. + * aclocal.m4: Regenerate. + + * configure.in: Don't define GSYM_PREFIX or ALIGN. + Add mechanism for multi-function files. + * configure: Regenerate. + +2000-02-18 Kevin Ryde + + * configure.in (gmp_m4postinc): Enable x86-defs.m4. + * mpn/x86/k7/mul_1.asm: Fix include. + * mpn/x86/k6/mul_basecase.S: Removed (copy of the pentium version). + * mpn/x86/k6/mul_basecase.asm: New file. + * mpn/x86/k6/sqr_basecase.asm: New file. + * mpn/x86/k6/com_n.asm: New file. + * mpn/x86/k6/copyi.asm: New file. + * gmp.texi (Low-level Functions): Clarify mpn overlaps permitted. + * gmp-impl.h (MPN_OVERLAP_P): New macro. + * gmp-impl.h (assert_nocarry): New macro. + * mpn/tests/ref.c: New file, based in part on other mpn/tests/*.c. + * mpn/tests/ref.h: New file. + +2000-02-17 Linus Nordberg + + * Makefile.am (dist-hook): Don't include any emacs backup files + (*.~*) in dist. + * Makefile.in: Regenerate. + +2000-02-17 Torbjorn Granlund + + * mpn/sparc32/v9/mul_1.asm: Use `rd' to get current PC; get rid of + getpc function. + * mpn/sparc32/v9/addmul_1.asm: Likewise. + * mpn/sparc32/v9/submul_1.asm: Likewise. + +2000-02-17 Kevin Ryde + + * gmp.h: Add prototypes and defines for mpn_and_n, mpn_andn_n, + mpn_com_n, mpn_copyd, mpn_copyi, mpn_ior_n, mpn_iorn_n, + mpn_mul_basecase, mpn_nand_n, mpn_nior_n, mpn_sqr_basecase, + mpn_xor_n, mpn_xorn_n. + + * mpn/asm-defs.m4: Many additions making up initial version. + * mpn/asm-defs.m4 (L): Use defn(`LSYM_PREFIX'). + * mpn/x86/x86-defs.m4: New file. + * mpn/x86/k6/aors_n.asm: New file. + * mpn/x86/k6/divmod_1.asm: New file. + * mpn/x86/k6/divrem_1.asm: New file. + * mpn/x86/k6/lshift.S: Removed (was a copy of the pentium version). + * mpn/x86/k6/lshift.asm: New file. + * mpn/x86/k6/mod_1.asm: New file. + * mpn/x86/k6/mul_1.S: Removed (was a copy of the pentium version). + * mpn/x86/k6/mul_1.asm: New file. + * mpn/x86/k6/rshift.S: Removed (was a copy of the pentium version). + * mpn/x86/k6/rshift.asm: New file. + * mpn/x86/k7/aors_n.asm: New file. + * mpn/x86/k7/aorsmul_1.asm: New file. + * mpn/x86/k7/mul_1.asm: New file. + * mpn/x86/k7/rshift.asm: New file. + * mpn/x86/p6/aorsmul_1.asm: New file. + * mpn/x86/copyi.asm: New file. + * mpn/x86/copyd.asm: New file. + * mpn/lisp/gmpasm-mode.el: New file. + +2000-02-16 Torbjorn Granlund + + * mpn/sparc32/v9/mul_1.asm: Conditionalize for PIC. + * mpn/sparc32/v9/addmul_1.asm: Likewise. + * mpn/sparc32/v9/submul_1.asm: Likewise. + * mpn/sparc32/v8/supersparc/udiv.asm: Likewise. + * mpn/sparc32/udiv_fp.asm: Likewise. + +2000-02-16 Linus Nordberg + + * configure.in: Add mechanism for including target specific + m4-files in config.m4. + * configure: Regenerate. + + * acinclude.m4 (GMP_PROG_CCAS): Begin assembly lines (except + labels) with a tab character. HP-UX demands it. + (GMP_CHECK_ASM_SIZE): Ditto. + (GMP_CHECK_ASM_LSYM_PREFIX): Ditto. + (GMP_CHECK_ASM_LABEL_SUFFIX): Set to empty string for HP-UX. + (GMP_CHECK_ASM_GLOBL): Change `.xport' --> `.export'. + * aclocal.m4: Regenerate. + +2000-02-16 Linus Nordberg + + * acinclude.m4 (GMP_CHECK_ASM_LSYM_PREFIX): Define LSYM_PREFIX as + the prefix only, no argument. + * aclocal.m4: Regenerate. + * configure: Regenerate. + + * mpn/asm-defs.m4 (L): No argument to LSYM_PREFIX. + +2000-02-15 Linus Nordberg + + * acinclude.m4: Prefix all temporary shell variables with + `gmp_tmp_'. + (GMP_PROG_CC_FIND): Use defaults if no arguments are passed. + Quote use of arguments. + (GMP_PROG_CCAS): New macro. + (GMP_INIT): New macro. + (GMP_FINISH): New macro. + (GMP_INCLUDE): New macro. + (GMP_SINCLUDE): New macro. + (GMP_DEFINE): New macro. + (GMP_CHECK_ASM_LABEL_SUFFIX): New macro. + (GMP_CHECK_ASM_TEXT): New macro. + (GMP_CHECK_ASM_DATA): New macro. + (GMP_CHECK_ASM_GLOBL): New macro. + (GMP_CHECK_ASM_TYPE): New macro. + (GMP_CHECK_ASM_SIZE): New macro. + (GMP_CHECK_ASM_LSYM_PREFIX): New macro. + (GMP_CHECK_ASM_W32): New macro. + * aclocal.m4: Regenerate. + + * configure.in: Find m4 and nm for target. + Use new macros to create config.m4. + Prefix all temporary shell variables with `tmp_'. + Pass `-X 64' to nm for 64-bit PPC target with 64-bit compiler. + * configure: Regenerate. + + * Makefile.am (dist-hook): *Really* remove all CVS dirs in + dist. + * Makefile.in: Regenerate. + + * mpn/Makefile.am: Add target for building .lo and .o from + .asm. + Pass -DPIC to preprocessor (CPP/m4) when building .lo. + Build .o a second time for target .lo, without -DPIC to + preprocessor. + (SUFFIX): Add `.asm'. + (EXTRA_DIST): Add asm-defs.m4. + * mpn/Makefile.in: Regenerate. + + * mpf/Makefile.in: Regenerate. + * mpf/tests/Makefile.in: Regenerate. + * mpq/Makefile.in: Regenerate. + * mpq/tests/Makefile.in: Regenerate. + * mpz/Makefile.in: Regenerate. + * mpz/tests/Makefile.in: Regenerate. + +2000-02-15 Torbjorn Granlund + + * mpn/sparc32/udiv_fp.asm: Change `RODATA' to `DATA'. + * mpn/sparc32/v8/supersparc/udiv.asm: Likewise. + * mpn/sparc32/v9/addmul_1.asm: Likewise. + * mpn/sparc32/v9/submul_1.asm: Likewise. + * mpn/sparc32/v9/mul_1.asm: Likewise. + + * mpn/sparc32/add_n.asm: Rename `size' -> `n'. + * mpn/sparc32/sub_n.asm: Likewise. + + * sparc32: Rename `.s' and `.S' files to `.asm'. + * sparc64: Rename `.s' and `.S' files to `.asm'. + +2000-02-11 Torbjorn Granlund + + * config.sub: Adopt to new config.guess sparc naming conventions. + + * config.guess (sun4u:SunOS:5.*:*): Change `sparc9' to `sparcv9'. + * config.guess (sun4m:SunOS:5.*:*): Change to sun4[md]:SunOS:5.*:* and + change `sparc8' to `sparcv8'. + + * mpn/x86/add_n.S: Use PROLOGUE/EPILOGUE. + * mpn/x86/sub_n.S: Likewise. + + * mpn/x86/syntax.h (PROLOGUE): New name for PROLOG. + * mpn/x86/syntax.h (EPILOGUE): New name for EPILOG. + +2000-02-11 Linus Nordberg + + * configure.in: Better path for 64-bit sparc without 64-bit cc. + Change sparc8 --> sparcv8. + Change sparc9 --> sparcv9. + * configure: Regenerate. + +2000-02-10 Linus Nordberg + + * configure.in: Use Autoconf. + * Makefile.am: New file. + + * AUTHORS: New file. + * COPYING: New file. + * acinclude.m4: New file. + * acconfig.h: New file. + + * configure: Generate. + * Makefile.in: Generate. + * aclocal.m4: Generate. + * config.in: Generate. + + * install.sh: Remove. + * install-sh: New file from Automake. + * missing: New file from Automake. + * ltconfig: New file from Libtool. + * ltmain.sh: New file from Libtool. + + * mpf/Makefile.am: New file. + * mpf/Makefile.in: Generate. + * mpf/configure.in: Remove. + * mpf/tests/Makefile.am: New file. + * mpf/tests/Makefile.in: Generate. + * mpf/tests/configure.in: Remove. + + * mpn/Makefile.am: New file. + * mpn/Makefile.in: Generate. + * mpn/configure.in: Remove. + + * mpq/Makefile.am: New file. + * mpq/Makefile.in: Generate. + * mpq/configure.in: Remove. + * mpq/tests/Makefile.am: New file. + * mpq/tests/Makefile.in: Generate. + * mpq/tests/configure.in: Remove. + + * mpz/Makefile.am: New file. + * mpz/Makefile.in: Generate. + * mpz/configure.in: Remove. + * mpz/tests/Makefile.am: New file. + * mpz/tests/Makefile.in: Generate. + * mpz/tests/configure.in: Remove. + +2000-02-10 Torbjorn Granlund + + * mpn/x86/add_n.S: Don't use label L0 twice. + * mpn/x86/sub_n.S: Likewise. + +2000-01-20 Linus Nordberg + + * demos/pexpr.c: Don't use setup_error_handler() in windoze. + +2000-01-19 Torbjorn Granlund + + * demos/pexpr.c (sigaltstack): #define to sigstack for AIX. + (setup_error_handler): Don't write to ss_size and ss_flags + on AIX. + +2000-01-11 Torbjorn Granlund + + * mpn/configure.in (hppa2.0*-*-*): Move assignment of + target_makefile_frag to where it belongs. + +1999-12-21 Torbjorn Granlund + + * longlong.h (v9 umul_ppmm): New #define. + (v9 udiv_qrnnd): New #define. + +1999-12-14 Torbjorn Granlund + + * mpn/generic/divmod_1.c: Use invert_limb. + * mpn/generic/mod_1.c: Use invert_limb. + + * gmp-impl.h (invert_limb): Put definition here. + * mpn/generic/divrem.c (invert_limb): Delete definition. + * mpn/generic/divrem_2.c (invert_limb): Delete definition. + + * gmp.h (mpn_divrem): Inhibit for non-gcc. + But declare (undo 1999-11-22 change). + + * gmp-impl.h (DItype,UDItype): Do these also if _LONG_LONG_LIMB. + + * longlong.h: Move 64-bit hppa code out of __GNUC__ conditional. + + * stack-alloc.c (HSIZ): New #define. + (__tmp_alloc): Use HSIZ instead of sizeof(tmp_stack). + +1999-12-10 Torbjorn Granlund + + * config.sub: Clean up handling of x86 CPUs: Properly recognize + Amd CPUs as unique entities. Use manufacturer's names of + processors ("pentium", etc); still match ambiguous names like + "i586", "i686", "p6" but be conservative in interpreting them. + + * configure.in: Recognize x86 CPU types known by config.guess. + * mpn/configure.in: Likewise. Add x86/mmx path component as + appropriate. + (athlon-*-*): Fix typo. + + * config.guess: Update x86 recog code to initially match + more than just i386. + Call K6-2 and K6-III for "k62" and "k63" respectively. + + * config.guess: Recognize x86 CPU types. + Update code for FreeBSD, NetBSD, OpenBSD, Linux. + +1999-12-08 Torbjorn Granlund + + * mpf/pow_ui.c: Avoid final squaring in loop. + +1999-12-07 Torbjorn Granlund + + * gmp-impl.h (udiv_qrnnd_preinv2gen): Prefix local variables with `_'. + (udiv_qrnnd_preinv2norm): Likewise. + From Kevin Ryde: + (HAVE_ALLOCA): #define also if defined (alloca). + +1999-12-04 Torbjorn Granlund + + * mpn/tests/add_n.c: Set OPS from CLOCK. + * mpn/tests/sub_n.c: Likewise. + * mpn/tests/mul_1.c: Likewise. + * mpn/tests/addmul_1.c: Likewise. + * mpn/tests/submul_1.c: Likewise. + + * mpn/tests/lshift.c: Update from add_n.c. + * mpn/tests/rshift.c: Likewise. + +1999-12-03 Torbjorn Granlund + + * mpn/powerpc64/copy.S: New file. + +1999-12-02 Torbjorn Granlund + + * mpn/sparc64/copy.s: New file. + + * mpn/tests/copy.c: New file. + + * mpn/configure.in: Recognize more Amd CPUs; Set special paths for + k7 CPU. + + * configure.in: Recognize Amd x86 CPUs. + + * mpz/fdiv_r_2exp.c: In rounding code, read in->_mp_size before + writing to res->_mp_size. + + * mpn/powerpc64/*.S: Clean up assembly syntax, add function headers. + * mpn/powerpc64/gmp-mparam.h: (KARATSUBA_MUL_THRESHOLD): #define. + (KARATSUBA_SQR_THRESHOLD): #define. + + * mpn/tests/add_n.c (main): Only print test number if TIMES==1 + and not printing. + (main): Don't run reference code if NOCHECK. + * mpn/tests/sub_n.c: Likewise. + * mpn/tests/mul_1.c: Likewise. + * mpn/tests/addmul_1.c: Likewise. + * mpn/tests/submul_1.c: Likewise. + + * mpn/tests/lshift.c: (main): Only print test number if TIMES==1 + and not printing. + * mpn/tests/rshift.c: Likewise. + +1999-11-22 Torbjorn Granlund + + * gmp.h (mpz_init_set_str): Declare using __gmp_const. + (mpz_set_str): Likewise. + (mpf_init_set_str): Likewise. + (mpf_set_str): Likewise. + (mpn_set_str): Likewise. + (__gmp_0): Likewise. + (mpn_divrem): Remove separate declaration; it's defined later in + this file. + + * gmp.h: Replace "defined (__STD__)' by (__STDC__-0) in + expressions involving more than one term, to handle Sun's compiler + that most helpfully sets __STDC__ to 0. + * gmp-impl.h: Likewise. + * longlong.h: Likewise. + +1999-11-21 Torbjorn Granlund + + * mpn/sparc64/gmp-mparam.h (KARATSUBA_MUL_THRESHOLD): #define. + (KARATSUBA_SQR_THRESHOLD): #define. + + * mpn/sparc64/lshift.s: Compensate stack references for odd stack ptr. + * mpn/sparc64/rshift.s: Likewise. + + * mpn/sparc64/addmul_1.s: Propagate carry properly. + * mpn/sparc64/submul_1.s: Likewise. + + * mpn/sparc64/sub_n.s: Rewrite. + + * mpn/sparc64/sub_n.s: Get operand order for main subcc right + (before scrapping this code for new code). + +1999-11-20 Torbjorn Granlund + + * mpn/sparc64/add_n.s: Rewrite. + +1999-11-17 Torbjorn Granlund + + * mpn/x86/syntax.h (PROLOG): New #define. + (EPILOG): New #define. + + * gmp.h (mpn_addsub_n): Declare. + * gmp.h (mpn_add_nc): Declare. + * gmp.h (mpn_sub_nc): Declare. + * mpn/powerpc64/addsub_n.S: New file. + +1999-11-17 Torbjorn Granlund + + * mpn/alpha/gmp-mparam.h + (KARATSUBA_MUL_THRESHOLD): Only #define #ifndef. + (KARATSUBA_SQR_THRESHOLD): Likewise. + +1999-11-14 Torbjorn Granlund + + * mpn/x86/mul_1.S: Unroll and optimize for P6 and K7. + +1999-11-09 Torbjorn Granlund + + * mpn/x86/p6/gmp-mparam.h + (KARATSUBA_MUL_THRESHOLD): Only #define #ifndef. + (KARATSUBA_SQR_THRESHOLD): Likewise. + +1999-11-05 Torbjorn Granlund + + * mpn/generic/addsub_n.c: New file. + +1999-11-02 Torbjorn Granlund + + * config.guess: Handle alpha:FreeBSD with alpha:NetBSD. + + * configure.in (vax*-*-*): New case. + * config/mt-vax: New file. + * mpn/vax/add_n.s: Rewrite. + * mpn/vax/sub_n.s: Rewrite. + +1999-10-31 Torbjorn Granlund + + * mpn/vax/rshift.s: New file. + * mpn/vax/lshift.s: New file. + +1999-10-29 Torbjorn Granlund + + * config.sub: Handle k5 and k6. + * mpn/configure.in: Recognize k6. + + * mpf/tests/t-get_d.c (LOW_BOUND, HIGH_BOUND): New #defines. + (main): Tighten error bounds to 14 digits. + + * longlong.h (default umul_ppmm, when smul_ppmm exists): + Rename __m0 => __xm0, __m1 => __xm1. + (default smul_ppmm): Likewise. + +1999-10-11 Torbjorn Granlund + + * config.guess: Reverse the test for POWER vs PowerPC. + * config.guess (sun4m:SunOS:5.*:*): New case. + * config.guess (sun4u:SunOS:5.*:*): New case. + +1999-09-29 Torbjorn Granlund + + * mpn/generic/divrem_2.c: Clean up comments. + +1999-09-23 Torbjorn Granlund + + * mpz/tests/Makefile.in: Use move-if-change when generating binaries. + * mpf/tests/Makefile.in: Likewise. + * mpq/tests/Makefile.in: Likewise. + * mpz/tests/move-if-change: New file. + * mpf/tests/move-if-change: New file. + * mpq/tests/move-if-change: New file. + + * gmp.h (mpn_incr_u): New macro (from mpn/generic/mul_n.c). + (mpn_decr_u): New macro. + + * mpn/generic/mul_n.c (mpn_incr): Delete. + * mpn/generic/mul_n.c: Update usages mpn_incr => mpn_incr_u. + * mpn/generic/divrem_newt.c: Use mpn_incr_u and mpn_decr_u instead of + mpn_add_1 and mpn_sub_1. + * mpn/generic/sqrtrem.c: Likewise. + * mpz/cdiv_q_ui.c: Likewise. + * mpz/cdiv_qr_ui.c: Likewise. + * mpz/fdiv_q_ui.c: Likewise. + * mpz/fdiv_qr_ui.c: Likewise. + + * mpn/generic/sqrtrem.c: Start single-limb Newton iteration from 18 + bits. + +1999-07-27 Torbjorn Granlund + + * mpn/generic/divrem_1.c (__gmpn_divrem_1n): New function. + + * mpn/generic/divrem_2.c: New file, code from divrem.c, `case 2:'. + * mpn/Makefile.in: Compile divrem_2.c. + * make.bat: Compile divrem_2.c. + * mpn/configure.in (functions): Add divrem_2. + * gmp.h: Declare mpn_divrem_2. + + * mpn/generic/divrem.c: Delete special cases, handle just divisors + of more than 2 limbs. + * gmp.h (mpn_divrem): Call mpn_divrem_1, mpn_divrem_2, as appropriate. + + * mpn/generic/divrem.c: Rework variable usage for better register + allocation. + +1999-07-26 Torbjorn Granlund + + * mpn/alpha/ev5/add_n.s: Rewrite for better ev6 speed. + * mpn/alpha/ev5/sub_n.s: Likewise. + +1999-07-21 Torbjorn Granlund + + * longlong.h (alpha): Define umul_ppmm for cc. + + * gmp-impl.h (DItype, UDItype): Define for non-gcc if _LONGLONG is + defined. + +1999-07-15 Torbjorn Granlund + + * longlong.h (powerpc64 count_leading_zeros): Fix typo. + (powerpc64 add_ssaaaa): Fix typos. + (powerpc64 sub_ddmmss): Fix typos. + +1999-07-14 Torbjorn Granlund + + * mpz/tests/Makefile.in: Pass XCFLAGS when linking. + * mpf/tests/Makefile.in: Likewise. + * mpq/tests/Makefile.in: Likewise. + * mpn/Makefile.in (.S.o): Pass XCFLAGS. + + * longlong.h: Add support for 64-bit PowerPC. + * config.sub: Handle "powerpc64". + * configure.in: Likewise. + * mpn/configure.in: Suppress use of config/t-ppc-aix for now, + it seems compiler passes proper options. + * mpn/powerpc64/*.S: New files. + + * Makefile.in (FLAGS_TO_PASS): Pass "AR=$(AR)". + +1999-07-07 Torbjorn Granlund + + * demos/pexpr.c (factor): Change alloca call to a malloc/free pair. + + * mpn/powerpc32/syntax.h: Add #define's for crN. + + * gmp.h (gmp_rand_algorithm): Remove spurious `,'. + +1999-07-05 Torbjorn Granlund + + * mpn/generic/divrem_1.c: Normalize divisor when needed. + +1999-07-02 Torbjorn Granlund + + * mpn/configure.in (powerpc*-apple-mach): New configuration. + * mpn/powerpc32/*: Add support for apple-macho syntax. + * mpn/powerpc32/syntax.h: New file. + * gmp-impl.h: Don't use `__attribute__' syntax for Apple's perversion + of GCC. + +1999-05-26 Linus Nordberg + + * rand.c (gmp_rand_init): Fix typo. + + * mpn/generic/rawrandom.c (mpn_rawrandom): Count bits, not limbs, + to keep track of how many rounds to do in loop. Clean up + temporary allocation. Update `seedsize' inside loop. Mask off + the correct number of bits from final result. Init `mcopyp' even + when not normalizing `m'. + + * randlc.c (gmp_rand_init_lc): Fix typo (don't call + mpz_init_set_ui()). + + * mpn/generic/rawrandom.c (mpn_rawrandom): Set SIZ(s->seed) when + reallocating. + + * tests/rand/Makefile (test, bigtest): Add 33-bit tests. + + * tests/rand/gen.c (main): Set precision of variable passed to + mpf_urandomb(). Add option `-p'. + +1999-05-25 Linus Nordberg + + * randcm.c: Remove. + * randcmui.c: Remove. + * Makefile.in: Remove randcm and randcmui. + * make.bat: Ditto. + * gmp-impl.h: Remove prototypes for __gmp_rand_init_common() and + __gmp_rand_init_common_ui(). + * randlc.c (gmp_rand_init_lc): Don't call + __gmp_rand_init_common(). + + * randlcui.c (gmp_rand_init_lc_ui): Don't call + __gmp_rand_init_common_ui(). + + * gmp.h (__gmp_rand_state_struct): Remove unused member `maxval'. + * randclr.c (gmp_rand_clear): Remove reference to s->maxval. + * randcm.c (__gmp_rand_init_common): Ditto + + * mpn/generic/rawrandom.c (mpn_rawrandom): Don't calculate nlimbs + twice. + + * gmp.h (__gmp_rand_dist): Remove. + +1999-05-24 Linus Nordberg + + * mpn/generic/rawrandom.c: Clean up comments. + + * gmp.texi: Add documentation for random number generation. + +1999-05-21 Linus Nordberg + + * gmp.h: Typedef `gmp_rand_state' as an array with one element. + Change prototypes accordingly. + * gmp-impl.h: Change prototypes using `gmp_rand_state'. + * rand.c (gmp_rand_init): Take `gmp_rand_state' as argument + instead of a pointer to a `gmp_rand_state'. + * mpf/urandom.c (mpf_urandomb): Ditto. + * mpz/urandom.c (mpz_urandomb): Ditto. + * mpn/generic/rawrandom.c (mpn_rawrandom): Ditto. + * randcmui.c (__gmp_rand_init_common_ui): Ditto. + * randlc.c (gmp_rand_init_lc): Ditto. + * randlcui.c (gmp_rand_init_lc_ui): Ditto. + * randui.c (gmp_rand_init_ui): Ditto. + * randcm.c (__gmp_rand_init_common): Ditto. + * randclr.c (gmp_rand_clear): Ditto. + + * tests/rand/gen.c (main): Pass `s' to rand-funcs instead of address + of `s'. + +1999-05-20 Linus Nordberg + + * Makefile.in: Rename randi.c --> rand.c, randi_lc.c --> randlc.c, + randicom.c --> randcm.c. Add randui.c, randcmui.c, randlcui.c. + * make.bat: Ditto. + + * gmp.h: Add prototypes for gmp_rand_init_ui() and + gmp_rand_init_lc_ui(). + * gmp-impl.h: Add prototypes for __gmp_rand_init_common() and + __gmp_rand_init_common_ui(). + + * randlc.c, randcm.c, randclr.c, rand.c: Change #include of + to "gmp.h". + * randclr.c: Include stdlib.h for free(). + * rand.c: Include gmp-impl.h. + +1999-05-12 Torbjorn Granlund + + * mpn/configure.in: Put generic m68k alternative last. + +1999-05-04 Torbjorn Granlund + + * demos/pexpr.c (setup_error_handler): Use sigemptyset to create + empty set (for portability). + (fns): Fix typo '#if #if'. + (mpz_eval_expr): Implement FERMAT and MERSENNE. + + * demos/pexpr.c: Cast longjmp argument via long to silent warnings on + 64-bit hosts. + +1999-05-03 Torbjorn Granlund + + * demos/pexpr.c: Add #defines for GMP 1.x and 2.0 compatibility. + + * demos/pexpr.c (setup_error_handler): New function; take signal + handler setup code from main(), with major modifications to use modern + signal interface. + (main): Remove signal handler setup code; call setup_error_handler. + +1999-04-29 Linus Nordberg + + * tests/rand/findcl.c (main): Add option '-i' for interval factor. + Separate v and merit lose figures. Add '-v' for version. + +1999-04-28 Linus Nordberg + + * tests/rand/statlib.c: Change debugging stuff. + + * tests/rand/gmpstat.h: Add debug values definitions. + + * tests/rand/findcl.c (main): Print low and high merit on startup. + Print version string on startup. Catch SEGV and HUP. Add option -d + for debug. Fix bug making test for v too hard. + (sh_status): New function. + (sh_status): Flush stdout. Add RCSID. + +1999-04-27 Linus Nordberg + + * tests/rand/Makefile (clean): Add target. + +1999-04-27 Linus Nordberg + + * tests/rand/stat.c: Include gmpstat.h. + Add global int g_debug. + + * tests/rand/spect.c: Include . + + * tests/rand/findcl.c (main): Input is `m', not all factors of `m'. + Print only the very first matching multiplier. Include . + Flush stdout. Print "done." when done. + + * tests/rand/spect.c: Move everything but main() to statlib.c. + + * tests/rand/findcl.c: New file. + + * tests/rand/gmpstat.h: New file. + + * tests/rand/statlib.c (merit, merit_u, f_floor, vz_dot, + spectral_test): New functions. + +1999-04-27 Torbjorn Granlund + + * mpn/configure.in: Fix typo, "sparc-*)" was "sparc)". + +1999-04-21 Torbjorn Granlund + + * config.sub: Recognize ev6. + +1999-04-12 Linus Nordberg + + * urandom.c: Split up into randclr.c, randi.c, randi_lc.c, + randicom.c. + * randclr.c, randi.c, randi_lc.c, randicom.c: New files. + * Makefile.in: Remove urandom. Add randclr, randi, randi_lc, + randicom. + * make.bat: Ditto + +1999-03-31 Torbjorn Granlund + + * configure.in (sparc9-*-solaris2.[789]*, etc): New alternative. + * mpn/configure.in: Use mt-sprc9 also for ultrasparc*-*-solaris2*. + +1999-03-30 Linus Nordberg + + * urandom.c (__gmp_rand_scheme): Change NULL->0. + Include "gmp.h" instead of . + +1999-03-29 Linus Nordberg + + * gmp.h (__gmp_rand_data_lc): Now holds a, c, m instead of scheme + struct. + (__gmp_rand_lc_scheme_struct): Remove mpz_t's `a' and `m'. + + * tests/rand/stat.c (f_freq): Don't print 2nd level results if doing + 1st level. + + * tests/rand/gen.c (main): Set default algorithm to mpz_urandomb. + (main): Add option -c. + +1999-03-24 Linus Nordberg + + * tests/rand/Makefile (GMPINC): Rename to GMPH. + (GMPH): Add gmp-mparam.h. + (CFLAGS): Add -I$(GMPLIBDIR)/mpn + +1999-03-23 Linus Nordberg + + * Makefile.in: Compile top-dir/urandom.c. + * make.bat: Ditto. + + * mpn/Makefile.in: Compile rawrandom.c. + * make.bat: Ditto. + + * mpn/configure.in (functions): Add rawrandom. + + * gmp.h (__gmp_rand_scheme_struct): Rename to + __gmp_rand_lc_scheme_struct. + (__gmp_rand_data_lc): Remove member 'n'. Allocate a + __gmp_rand_lc_scheme_struct instead of a pointer to one. + Add prototype for gmp_rand_init_lc(), mpn_rawrandom(). + New prototype for mpz_urandomb(). + + * urandom.c: New file. + (__gmp_rand_init_common): New function. + (gmp_rand_init_lc): New function. + (gmp_rand_init): Don't init data_lc->n. Call gmp_rand_init_lc() + and __gmp_rand_init_common(). + (gmp_rand_clear): Remove reference to data_lc->n. + + * mpz/urandom.c (gmp_rand_init, gmp_rand_clear): Move to new file + urandom.c in top-dir. + (mpz_urandomb): Add function parameter nbits. Call mpn_rawrandom(). + + * mpf/urandom.c (mpf_urandomb): Call mpn_rawrandom(). + + * mpn/generic/rawrandom.c: New file. + (mpn_rawrandom): New function. + +1999-03-17 Torbjorn Granlund + + * extract-dbl.c: When packing result, adjust exp when sc == 0. + + * mpf/tests/t-get_d.c: New file. + * mpf/tests/Makefile.in: Compile t-get_d.c. + +1999-03-16 Linus Nordberg + + * mpz/urandom.c (__gmp_rand_scheme): Add extra braces around the + mpz_t members. + + * make.bat: Compile mpz/urandom.c and mpf/urandom.c + + * tests/rand/statlib.c (ks_table): Use mpf_pow_ui() and exp(). + + * tests/rand/gen.c: Include unistd.h for getopt. + +1999-03-15 Linus Nordberg + + * mpz/urandom.c (gmp_rand_init): New function. + (gmp_rand_clear): New function. + (mpz_urandomb): New function. + + * mpz/Makefile.in: Compile urandom.c + + * mpf/urandom.c (mpf_urandomb): New function. + + * mpf/Makefile.in: Compile urandom.c. + + * gmp.h (__gmp_rand_state_struct, __gmp_rand_scheme_struct): New + structs for randomization functions. + (gmp_rand_dist, gmp_rand_alogrithm): New enums for randomization + functions. + (mpz_urandomb, mpf_urandomb): Add prototype. + (gmp_rand_init, gmp_rand_clear): Add prototype. + + * tests/rand/gen.c, stat.c, statlib.c, statlib.h: New files. + * tests/rand/Makefile, tests/rand/ChangeLog: New files. + +1999-03-15 Torbjorn Granlund + + * .gdbinit: New file. + + * mpz/dump.c: New file. + * mpz/Makefile.in: Compile dump.c. + * make.bat: Likewise. + * gmp.h (mpz_dump): Declare. + +1999-03-14 Torbjorn Granlund + + * mpz/tests/reuse.c: Also test mpz_invert and mpz_divexact. + + * mpz/tests/convert.c: Update to GMP 2 variable syntax. + +1999-03-13 Torbjorn Granlund + + * mpf/README: New file. + * mpz/README: New file. + + * mpf/pow_ui.c: New file. + * mpf/Makefile.in: Compile pow_ui.c. + * make.bat: Likewise. + * gmp.h (mpf_pow_ui): Declare. + +1999-03-12 Torbjorn Granlund + + * mpn/configure.in: Stage 1 of rewrite. + * mpn/underscore.h: New name for bsd.h. + * mpn/sysv.h: Deleted. + + * mpn/m68k/*: Don't include sysdep.h. + + * mpn/pa64/README: New file. + +1999-03-11 Torbjorn Granlund + + * mpn/powerpc32/add_n.S: Add support for both AIX and ELF syntax. + Renamed from `.s'. + * mpn/powerpc32/sub_n.S: Likewise. + * mpn/powerpc32/lshift.S: Likewise. + * mpn/powerpc32/rshift.S: Likewise. + * mpn/powerpc32/mul_1.S: Likewise. + * mpn/powerpc32/addmul_1.S: Likewise. + * mpn/powerpc32/submul_1.S: Likewise. + + * mpn/powerpc32/umul.S: New file. + * mpn/sparc32/v8/umul.S: New file. + * mpn/sparc32/umul.S: New file. + * mpn/x86/umul.S: New file. + * mpn/x86/udiv.S: New file. + + * mpn/Makefile.in (mul_basecase.o): Delete rule. + +1999-02-22 Torbjorn Granlund + + * configure.in (hppa2.0*-*-*): Force use of GCC. + + * extract-dbl.c: Handle IEEE denormalized numbrs. Clean up. + +1998-12-02 Torbjorn Granlund + + * mpn/Makefile.in (CCAS): New macro. + (.s.o): Use CCAS. + (.S.o): Likewise. + + * mpn/Makefile.in (mul_basecase.o): Add dependency. + (sqr_basecase.o): Likewise. + (mod_1.o): Likewise. + + * demos/pexpr.c (cputime): Test also __hpux. + (cleanup_and_exit): Check SIGXCPU only #ifdef LIMIT_RESOURCE_USAGE. + + * mpz/tests/t-2exp.c: Use urandom, not random. + + * mpn/configure.in (arm*-*-*): New alternative. + +1998-11-30 Torbjorn Granlund + + * gmp-impl.h (union ieee_double_extract): Special case for + little-endian arm. + (LIMBS): Alias for PTR. + +1998-11-26 Torbjorn Granlund + + * longlong.h (m68000 umul_ppmm): Use `muluw', not `mulu'. + (m68k stuff): Clean up; add coldfire support. + +1998-11-23 Torbjorn Granlund + + * mpn/mips3/gmp-mparam.h (KARATSUBA_MUL_THRESHOLD): #define. + (KARATSUBA_SQR_THRESHOLD): #define. + + * mpn/sparc32/v9/README: New file. + +1998-11-20 Torbjorn Granlund + + * mpn/x86/README: New file. + + * mpn/arm/gmp-mparam.h: New file. + * mpn/pa64/gmp-mparam.h: New file. + * mpn/hppa/gmp-mparam.h: New file. + * mpn/x86/pentium/gmp-mparam.h: New file. + * mpn/sparc32/v9/gmp-mparam.h: New file. + * mpn/powerpc32/gmp-mparam.h: New file. + * mpn/x86/p6/gmp-mparam.h: New file. + + * mpn/alpha/gmp-mparam.h (KARATSUBA_MUL_THRESHOLD): #define. + (KARATSUBA_SQR_THRESHOLD): #define. + + * mpn/configure.in: Point to x86/p6 when appropriate. + + * mpn/power/umul.s: New file. + * mpn/power/sdiv.s: New file. + * mpn/pa64/addmul_1.S: New file. + * mpn/pa64/submul_1.S: New file. + * mpn/pa64/mul_1.S: New file. + * mpn/pa64/udiv_qrnnd.c: New file. + * mpn/pa64/umul_ppmm.S: New file. + * mpn/mips2/umul.s: New file. + * mpn/m68k/mc68020/umul.s: New file. + * mpn/m68k/mc68020/udiv.s: New file. + * mpn/hppa/hppa1_1/umul.s: New file. + * mpn/alpha/umul.s: New file. + * mpn/a29k/udiv.s: New file. + * mpn/a29k/umul.s: New file. + +1998-11-17 Torbjorn Granlund + + * mpn/x86/mul_basecase.S: New file for non-pentiums. + * mpn/x86/mul_basecase.S: Move to mpn/x86/pentium. + +1998-11-16 Torbjorn Granlund + + * make.bat: Compile mul_basecase.c and sqr_basecase.c. + +1998-11-10 Torbjorn Granlund + + * mpz/invert.c: Defer writing to parameter `invert' until + end. + +1998-11-03 Torbjorn Granlund + + * mpn/pa64/udiv_qrnnd.c: Handle more border cases. + +1998-10-29 Torbjorn Granlund + + * insert-dbl.c: Special case biased exponents < 1; Get boundary for + Inf right. + + * longlong.h (COUNT_LEADING_ZEROS_NEED_CLZ_TAB): New #define. + +1998-10-28 Torbjorn Granlund + + * mpn/powerpc32/submul_1.s: Rewrite, optimizing for PPC604. + * mpn/powerpc32/addmul_1.s: Likewise. + * mpn/powerpc32/lshift.s: Likewise. + +1998-10-23 Torbjorn Granlund + + * config/mt-sprc9-gcc (XCFLAGS): Add -Wa,-xarch=v8plus. + + * mpn/sparc32/v9/submul_1.s: New file. + +1998-10-21 Torbjorn Granlund + + * mpn/config/mt-pa2hpux: New file. + * mpn/configure.in (hppa2.0*-*-*): Use new 64-bit code. + + * config.sub: Recognize hppa2.0 as CPU type. + + * longlong.h (64-bit hppa): Add umul_ppmm and udiv_qrnnd. + * mpn/pa64/mul_1.S: New file. + * mpn/pa64/addmul_1.S: New file. + * mpn/pa64/submul_1.S: New file. + * mpn/pa64/umul_ppmm.S: New file. + * mpn/pa64/udiv_qrnnd.c: New file. + +1998-10-20 Torbjorn Granlund + + * mpz/pprime_p.c: Pass 1L, not 1, to mpz_cmp_ui. + + * mpz/fdiv_q_2exp.c: Cast `long' argument to `mp_limb_t' for mpn calls. + * mpz/gcd_ui.c: Likewise. + * mpz/add_ui.c: Likewise. + * mpz/sub_ui.c: Likewise. + +1998-10-19 Torbjorn Granlund + + * mpn/generic/bdivmod.c: Avoid using switch statement with mp_limb_t + index. + +1998-10-17 Torbjorn Granlund + + * mpn/sparc32/v9/mul_1.s: Misc cleanups. + * mpn/sparc32/v9/addmul_1.s: Misc cleanups. + +1998-10-16 Torbjorn Granlund + + * mpn/tests/{add,sub,}mul_1.c: Print xlimb using mpn_print. + + * mpz/tests/t-powm.c (SIZE): Increase to 50. + (EXP_SIZE): New parameter; use it for computing exp_size. + +1998-10-15 Torbjorn Granlund + + * mpn/generic/divrem_newt.c: Use TMP_ALLOC interface. + + * mpn/generic/sqrtrem.c: Check BITS_PER_MP_LIMB before defining + assembly variants of SQRT. + +1998-10-14 Torbjorn Granlund + + * mpn/tests: Clean up timing routines. Don't include longlong.h + where it is not needed. + (mpn_print): Handle printing when _LONG_LONG_LIMB. + * mpn/tests/{add,sub,}mul_1.c: Generate xlimb with mpn_random2 + and do it whether TIMES != 1 or not. + + * mpn/generic/mul_n.c: Delay assignment of `sign' for lower + register pressure. + + * mpn/sparc32/v9/mul_1.s: New file. + + * config/mt-sprc9-gcc: New file. + * configure.in: Use it. + + * mpn/configure.in: Use sparc64 for Solaris 2.7 and later with a + sparc v9 CPU. + * mpn/configure.in: Use sparc32/v9 for Solaris 2.6 or earlier with + a sparc v9 CPU. + + * mpf/sub.c: In initial code for ediff == 0, limit precision + before jumping to `normalize'. + +1998-10-13 Torbjorn Granlund + + * mpn/hppa/hppa2_0/add_n.s: New file. + * mpn/hppa/hppa2_0/sub_n.s: New file. + * mpn/configure.in: Handle hppa2.0 (32-bit code for now). + + * config.guess: Update from egcs 1.1. + (9000/[3478]??:HP-UX:*:*): Properly return 2.0 for all known 2.0 + machines. + +1998-10-07 Torbjorn Granlund + + * mpz/root.c (mpz_root): New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_root): Declare. + + * mpz/perfpow.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_perfect_power_p): Declare. + + * mpz/remove.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_remove): Declare. + + * mpz/bin_ui.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_bin_ui): Declare. + + * mpz/bin_uiui.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_bin_uiui): Declare. + +1998-09-16 Torbjorn Granlund + + * longlong.h: Test for __powerpc__ in addition to _ARCH_PPC. + +Sat Sep 5 17:22:28 1998 Torbjorn Granlund + + * mpf/cmp_si.c: Compare most significant mantissa limb before + trying to deduce anything from the limb count. + * mpf/cmp_ui.c: Likewise. + +Tue Aug 18 10:24:39 1998 Torbjorn Granlund + + * mpz/pprime_p.c (mpz_probab_prime_p): Add new code block + for doing more dividing. + +Sat Aug 15 18:43:17 1998 Torbjorn Granlund + + * mpn/generic/divrem_newt.c: New name for divrem_newton.c. + * mpn/Makefile.in: Corresponding changes. + * mpn/configure.in: Likewise. + +Wed Aug 12 23:07:09 1998 Torbjorn Granlund + + * config.guess: Handle powerpc for NetBSD. + +Tue Jul 28 23:10:55 1998 Torbjorn Granlund + + * mpz/fib_ui.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_fib_ui): Declare. + +Wed Jun 17 22:52:58 1998 Torbjorn Granlund + + * make.bat: Fix typo, `asm-synt.h' => `asm-syntax.h'. + +Wed Jun 3 11:27:32 1998 Torbjorn Granlund + + * config/mt-pwr: New file. + * config/mt-ppc: New file. + * configure.in: Use the new files. + +Tue Jun 2 13:04:17 1998 Torbjorn Granlund + + * mpn/sparc32/v9/addmul_1.s: New file. + * mpn/config/mt-sprc9: New file. + * mpn/configure.in: Use mt-sprc9. + +Tue May 26 11:24:18 1998 Torbjorn Granlund + + * demos/factorize.c (factor_using_pollard_rho): Pass correct + parameters in recursive calls; join the two recursion arms. + + * mpf/set_q.c: Set result sign. + When normalizing the numerator, don't allow it to increase in size + beyond prec. + +Tue May 19 17:28:14 1998 Torbjorn Granlund + + * demos/factorize.c (factor_using_division): Call fflush + also for the factor 2. + +Mon May 18 15:51:01 1998 Torbjorn Granlund + + * make.bat: Pass -fomit-frame-pointer. Do not pass -g. + +Tue May 5 01:42:50 1998 Torbjorn Granlund + + * mpz/Makefile.in (LOCAL_CC): Remove definition. + + * gmp.h: Get rid of GMP_SMALL stuff. + * mpz/Makefile.in: Likewise. + * mpq/Makefile.in: Likewise. + * mpf/Makefile.in: Likewise. + + * mpz/invert.c: Fix typo in comment. + +Mon May 4 23:05:32 1998 Torbjorn Granlund + + * mpn/generic/sqrtrem.c: Check that __arch64__ is not defined + before defining sparc SQRT. + +Mon Apr 20 19:16:17 1998 Torbjorn Granlund + + * mpn/generic/gcdext.c: Allow gp to be NULL. + +1998-04-03 Torbjorn Granlund + + * mpn/configure.in: Recognize `alphaev5*', not `alphaev5'. + + * config.guess: Handle CPU variants for NetBSD. + +Mon Mar 16 13:07:54 1998 Torbjorn Granlund + + * mpz/pprime_p.c: Use mpn_mod_1/mpn_preinv_mod_1 for computing mod PP, + not mpz_tdiv_r_ui (which expects an `unsigned long'). + (mpz_probab_prime_p): Change type of `r' to mp_limb_t. + +Thu Mar 12 17:19:04 1998 Torbjorn Granlund + + * gmp.h (mpf_ceil, mpf_floor, mpf_trunc): Add declarations. + + * config.guess: Update from FSF version. + * config.sub: Likewise. + + * config.guess: Add special handling of alpha-*-NetBSD. + +Wed Mar 11 00:55:34 1998 Torbjorn Granlund + + * mpz/inp_str.c: Update from set_str.c. + Properly increment `nread' when skipping minus sign. + + * mpz/set_str.c: Check for empty string after having skipped + leading zeros. + +Mon Mar 9 19:28:00 1998 Torbjorn Granlund + + * mpz/set_str.c: Skip leading zeros. + +Wed Mar 4 19:29:16 1998 Torbjorn Granlund + + * gmp.h (mpz_cmp_si): Cast argument before calling mpz_cmp_ui. + + * demos/factorize.c: Rewrite. + +1998-02-04 Torbjorn Granlund + + * configure.in (i[3456]86* etc): Check if using gcc before + choosing mt-x86. + + * configure.in (m68*-*-*): New alternative. + * config/mt-m68k: New file. + + * mpn/alpha/invert-limb.s: Put tables in text segment, + since not all systems support "rdata". + +Wed Feb 4 02:20:57 1998 Torbjorn Granlund + + * gmp.h (__GNU_MP_VERSION_SNAP): New #define. + (__GNU_MP_VERSION_MINOR): Now 1. + +Wed Jan 28 22:29:36 1998 Torbjorn Granlund + + * longlong.h (alpha udiv_qrnnd): #define UDIV_NEEDS_NORMALIZATION. + +Wed Jan 28 20:28:19 1998 Torbjorn Granlund + + * mpz/pprime_p.c (mpz_probab_prime_p): Delete 59 from tried divisors. + +Mon Jan 26 01:39:02 1998 Torbjorn Granlund + + * mpz/pprime_p.c (mpz_probab_prime_p): Major overhaul: Check small + numbers specifically; check small factors, then perform a fermat test. + +Tue Jan 13 14:58:28 1998 Torbjorn Granlund + + * longlong.h (alpha udiv_qrnnd): Call __mpn_invert_normalized_limb + and udiv_qrnnd_preinv. + +Wed Jan 7 01:52:54 1998 Torbjorn Granlund + + * mpn/configure.in (alpha*, extra_functions): Add invert-limb and + remove udiv_qrnnd. + + * mpn/tests/divrem.c: Get allocations right. + + * mpn/generic/divrem.c: Conditionally pre-invert most significant + divisor limb. + +Tue Jan 6 23:08:54 1998 Torbjorn Granlund + + * mpn/generic/divrem_1.c: Rename variables to comply to conventions. + Make `i' have type `mp_size_t'. + +Tue Dec 30 22:21:42 1997 Torbjorn Granlund + + * mpz/tdiv_qr_ui.c: Return the remainder. + * mpz/tdiv_r_ui.c: Likewise. + * mpz/tdiv_q_ui.c: Likewise. + * gmp.h: Change return type of mpz_tdiv_qr_ui, mpz_tdiv_r_ui, + mpz_tdiv_q_ui. + + * mpz/tdiv_ui.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_tdiv_ui): Declare. + +Fri Nov 7 04:21:15 1997 Torbjorn Granlund + + * mpf/integer.c (FUNC_NAME): Fix bogus test for mpf_trunc. + + * demos/isprime.c: New file. + + Sat Nov 1 19:32:25 1997 Torbjorn Granlund + + * mpz/cmp_abs.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_cmp_abs): Declare. + + * mpz/cmp_abs_ui.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_cmp_abs_ui): Declare. + +Sat Sep 27 04:49:52 1997 Torbjorn Granlund + + * mpz/fdiv_r_2exp.c: Get allocation for `tmp' right. + + * mpz/fdiv_q_2exp.c: In final result adjustment code, handle + that intermediate result is zero. + + * mpz/tests/t-2exp.c: New file. + * mpz/tests/Makefile.in: Handle t-2exp.c. + +Fri Sep 26 16:29:21 1997 Torbjorn Granlund + + * mpz/divexact.c: Fix typo in test for whether to copy numerator to + quotient and move that statement to after handling quotient and + denominator overlap. Misc cleanups. + + * mpn/generic/gcd.c: Change count argument of mpn_lshift/mpn_rshift + calls to `unsigned int'. + * mpz/divexact.c: Likewise. + +Mon Sep 22 02:19:52 1997 Torbjorn Granlund + + * mpz/tests/t-powm.c: Decrease `reps' to 2500. + + * mpz/tests/t-pow_ui.c: New file. + * mpz/tests/Makefile.in: Handle t-pow_ui.c. + + * mpz/ui_pow_ui.c: Get special cases for exponent and base right. + + * mpz/pow_ui.c: Increase temp space allocation by 1 limb. + Split `rsize' into two variables; compute space allocation into + `ralloc'. + +Sun Sep 7 04:15:12 1997 Torbjorn Granlund + + * mpn/pa64/lshift.s: New file. + * mpn/pa64/rshift.s: New file. + * mpn/pa64/sub_n.s: New file. + +Sat Sep 6 19:14:13 1997 Torbjorn Granlund + + * mpn/pa64/add_n.s: New file. + * mpn/pa64: New directory. + +Tue Aug 19 16:17:09 1997 Torbjorn Granlund + + * mpz/swap.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_swap): Declare. + + * mpn/generic/mul_n.c: Push assignment of x and y pointers into the + if/else clauses in several places. (Decreases register pressure.) + +Mon Aug 18 03:29:50 1997 Torbjorn Granlund + + * mpn/thumb/add_n.s: New file. + * mpn/thumb/sub_n.s: New file. + * mpn/arm/add_n.s: New file. + * mpn/arm/sub_n.s: New file. + + * mpz/powm.c: After mpn_mul_n and mpn_mul calls, adjust product size + if most significant limb is zero. + * mpz/powm_ui.c: Likewise. + +Fri Aug 15 02:13:57 1997 Torbjorn Granlund + + * mpn/arm/m/mul_1.s: New file. + * mpn/arm/m/addmul_1.s: New file. + + * mpn/powerpc32/mul_1.s: Rewrite. + + * mpn/alpha/mul_1.s: Prefix labels with `.'. + +Mon Aug 11 02:37:16 1997 Torbjorn Granlund + + * mpn/powerpc32/add_n.s: Rewrite. + * mpn/powerpc32/sub_n.s: Rewrite. + +Sun Aug 10 17:07:15 1997 Torbjorn Granlund + + * mpn/powerpc32/addmul_1.s: Delete obsolete comments. + * mpn/powerpc32/submul_1.s: Likewise. + +Fri Jul 25 20:07:54 1997 Torbjorn Granlund + + * mpz/addmul_ui.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_addmul_ui): Declare. + + * mpz/setbit.c: Add missing code after final `else'. + +Tue Jul 22 17:45:01 1997 Torbjorn Granlund + + * mpn/sh/add_n.s: Fix typo. + * mpn/sh/sub_n.s: Likewise. + + * longlong.h (ns32k count_trailing_zeros): Fix typo. + + * insert-dbl.c: Check for exponent overflow and return Inf. + + * mpz/get_d.c: Rewrite to avoid rounding errors. + +Thu May 29 11:51:07 1997 Torbjorn Granlund + + * mpq/add.c: Swap some usages of tmp1 and tmp2 to make sure + their allocation suffices. + * mpq/sub.c: Likewise. + +Wed Apr 16 02:24:25 1997 Torbjorn Granlund + + * demos/pexpr.c: New file. + + * mpn/generic/mul_n.c: Misc optimizations from Robert Harley. + + * gmp-impl.h (MPZ_PROVOKE_REALLOC): New #define. + +Sat Apr 12 17:54:04 1997 Torbjorn Granlund + + * mpz/tstbit.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_tstbit): Declare. + + * mpz/tests/logic.c: Use MPZ_CHECK_FORMAT. + * mpz/tests/bit.c: New test. + * mpz/tests/Makefile.in: Handle bit.c. + + * mpz/ior.c: In -OP2,+OP1 case, normalize OP2 after call to mpn_sub_1. + + * gmp-impl.h (MPZ_CHECK_FORMAT): New #define. + +Thu Apr 10 00:30:14 1997 Torbjorn Granlund + + * longlong.h (POWER/PowerPC): Test _ARCH_PWR instead of _IBMR2. + +Wed Apr 9 18:23:31 1997 Torbjorn Granlund + + * gmp-impl.h: Move defaulting of UMUL_TIME and UDIV_TIME from here... + * longlong.h: ...to here. + +Sun Mar 30 12:16:23 1997 Torbjorn Granlund + + * mpn/generic/next_prime.c: New file. + + * mpn/generic/perfsqr.c: Remove definitions of PP and PP_INVERTED. + * gmp-impl.h: Put them here. + +Fri Mar 28 08:18:05 1997 Torbjorn Granlund + + * gmp-impl.h (MPN_COPY_INCR, MPN_COPY_DECR): Define as inline asm for + for x86, but leave disabled for now. + +Fri Feb 28 02:39:47 1997 Torbjorn Granlund + + * mpn/Makefile.in (.S.o): Pass SFLAGS and CFLAGS also to compiler + for assembly phase. + (.s.o): Pass SFLAGS. + +Wed Feb 26 06:46:08 1997 Torbjorn Granlund + + * mpn/configure.in: For Pentium Pro, use default code, not Pentium + optimized code. + + * mpn/x86/addmul_1.S: Unroll and optimize for Pentium Pro. + * mpn/x86/submul_1.S: Likewise. + +Thu Feb 13 08:26:09 1997 Torbjorn Granlund + + * mpf/Makefile.in: Compile floor.o, ceil.o and trunc.o (from + integer.c). + * make.bat: Likewise. + +Wed Feb 5 05:58:44 1997 Torbjorn Granlund + + * mpn/configure.in (alpha*): Add cntlz to extra_functions. + +Wed Feb 4 03:30:45 1997 Torbjorn Granlund + + * mpf/integer.c: New file (supporting mpf_floor, mpf_ceil, mpf_trunc). + +Mon Feb 3 14:21:36 1997 Torbjorn Granlund + + * make.bat: Fix typo, set_dfl_prc => set_dfl_prec. + +Sun Feb 2 02:34:33 1997 Torbjorn Granlund + + * mpf/out_str.c: After outputting `-', decrement n_digits. + +Wed Jan 8 02:50:20 1997 Torbjorn Granlund + + * mpn/generic/divrem.c: qextra_limbs => qxn. + +Wed Dec 18 07:50:46 1996 Torbjorn Granlund + + * mpz/tests/t-tdiv.c (SIZE): Increase to 200. + +Tue Dec 17 19:32:48 1996 Torbjorn Granlund + + * mpn/generic/divrem.c (mpn_divrem_classic): New name for mpn_divrem. + * gmp.h (mpn_divrem): New function. + * mpn/generic/divrem_newton.c: New file. + * mpn/configure.in (functions): Add divrem_newton. + * make.bat: Likewise. + +Thu Dec 12 17:55:13 1996 Torbjorn Granlund + + * gmp.h (_GMP_H_HAVE_FILE): Test also __dj_include_stdio_h_. + +Sat Dec 7 09:40:06 1996 Torbjorn Granlund + + * mpn/alpha/invert-limb.s: New file. + +Thu Dec 5 01:25:31 1996 Torbjorn Granlund + + * mpz/ui_pow_ui.c (mpz_pow2): New (static) function. + (mpz_ui_pow_ui): Rewrite. + + * make.bat: `pre_mod_1.c' => `pre_mod_.c'. Fix typo in path to + gmp-mpar.h. + +Fri Nov 15 00:49:55 1996 Torbjorn Granlund + + * mpz/ui_pow_ui.c: Rewrite for better speed. + +Fri Nov 1 16:36:56 1996 Torbjorn Granlund + + * Makefile.in (recursive make rules): Use `&&' instead of `;' as + delimiter. + +Fri Oct 25 17:12:36 1996 Torbjorn Granlund + + * gmp-impl.h (Cray/uxp MPN_COPY): Really declare as inline. + +Thu Oct 24 15:08:19 1996 Torbjorn Granlund + + * mpn/fujitsu/rshift.c: Fix typo in loop boundaries. + +Fri Oct 18 03:13:54 1996 Torbjorn Granlund + + * mpn/configure.in: Recognize `nextstep' for m68k variants; likewise + for x86 variants. + + * mpn/x86/syntax.h (INSND): New macro. + * mpn/x86/[lr]shift.S: Use INSND. + * mpn/x86/pentium/[lr]shift.S: Likewise. + * mpn/config/t-oldgas (SFLAGS): Pass -DOLD_GAS. + + * gmp-impl.h: In code for determining endianness, test also + __BIG_ENDIAN__ and __hppa__. Remove test of __NeXT__. + +Wed Oct 16 03:50:34 1996 Torbjorn Granlund + + * mpf/set_str.c: Let `prec' determine precision used in + exponentiation code; decrease allocation accordingly. + + * mpn/vax: Change `jsob*' to `sob*' in all files. + +Tue Oct 15 03:54:06 1996 Torbjorn Granlund + + * longlong.h (m88110 udiv_qrnnd): Change type of intermediate quotient + to DImode (divu.d generates a 64-bit quotient). + + * configure.in (m88110*): Fix typo. + + * mpf/get_str.c: Compute exp_in_base using `double' to avoid overflow. + + * gmp-impl.h (struct bases): Change type of chars_per_bit_exactly from + float to double. + * mpn/mp_bases.c (__mp_bases): Give 17 digits for chars_per_bit_exactly + field. + + * mpf/get_str.c: Let `prec' determine precision used in + exponentiation code; decrease allocation accordingly. + +Sun Oct 13 03:31:53 1996 Torbjorn Granlund + + * longlong.h: Major cleanup. + (__udiv_qrnnd_c): Compute remainders using multiply and subtract, + not explicit `%' operator. + (C umul_ppmm): Get rid of a redundant __ll_lowpart. + + * mpz/invert.c: Properly detect all operands that would yield an + undefined inverse; make sure the inverse is always positive. + + * mpz/xor.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_xor): Declare. + + * mpz/tests/logic.c: Also test mpz_xor. + + * mpz/lcm.c: Special case for when either operand equals 0. + +Sat Oct 12 01:57:09 1996 Torbjorn Granlund + + * mpn/generic/gcd.c (find_a): Don't inline on x86. + + * Makefile.in (CFLAGS): Default to just `-g'. + + * configure.in: Recognize 386 and 486 wherever other x86 cpus are + recognized. + * configure.in: Use mt-x86 for all x86 cpus. + * config/mt-x86: New file. + + * mpn/alpha/cntlz.s: New file. + +Tue Oct 8 00:16:18 1996 Torbjorn Granlund + + * longlong.h: Define smul_ppmm for Fujitsu vpp/uxp. + Rewrite umul_ppmm to actually work on the hardware. + + * mpn/x86/sub_n.S: Avoid parens around displacement of `leal'. + * mpn/x86/add_n.S: Likewise. + + * mpn/x86/syntax.h (R): Define differently depending on __STDC__. + +Mon Oct 7 16:48:08 1996 Torbjorn Granlund + + * longlong.h: Don't test for __NeXT__ in outer 68k conditional; + add test for __m68k__. + +Sun Oct 6 00:59:09 1996 Torbjorn Granlund + + * gmp.h: Declare mpn_random. + * make.bat: Compile mpn/generic/random.c. + + * longlong.h: Define umul_ppmm for Fujitsu vpp/uxp. + + * gmp-impl.h: Protect definitions using `__attribute__ ((mode (...)))' + with test also for __GNUC_MINOR__. + + * gmp.h: Don't define macros using __builtin_constant_p when using + NeXT's compiler. + +Fri Oct 4 16:53:50 1996 Torbjorn Granlund + + * mpz/lcm.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h (mpz_lcm): Declare. + +Wed Sep 25 00:06:21 1996 Torbjorn Granlund + + * mpq/tests/t-cmp_ui.c: Make sure numerator and denominator of `b' is + within limits of an `unsigned long int'. + + * mpz/tests/t-powm_ui.c: Change type of exp2 to `unsigned long int'. + +Tue Sep 24 18:58:20 1996 Torbjorn Granlund + + * mpz/powm_ui.c: Make result always positive. + + * urandom.h (urandom): Make it return mp_limb_t. + + * gmp-impl.h (CNST_LIMB): New macro. + * mpn/mp_bases.c: Use CNST_LIMB. + * mpn/generic/hamdist.c (popc_limb): Likewise. + * mpn/generic/popcount.c (popc_limb): Likewise. + * mpn/generic/perfsqr.c: Likewise. + +Fri Sep 20 03:08:10 1996 Torbjorn Granlund + + * mpz/pprime_p.c: When n <= 3, don't clear out n before using it. + +Wed Sep 18 11:22:45 1996 Torbjorn Granlund + + * mpn/fujitsu/mul_1.c: New file. + * mpn/fujitsu/addmul_1.c: New file. + * mpn/fujitsu/sub_n.c: New file. + * mpn/fujitsu/add_n.c: Mew file. + +Sun Sep 15 03:13:02 1996 Torbjorn Granlund + + * mpn/generic/random.c: New file. + * mpn/configure.in (functions): Add `random'. + + * gmp-impl.h (MPN_COPY): Define as annotated inline function for + Crays and Fujitsu VPPs. + + * gmp.h (mp_size_t): Define as `int' for non-MPP Cray. + (mp_exp_t): Likewise. + + * configure.in: Add support for Fujitsu VPP machines. + * mpn/configure.in: Likewise. + * config.guess: Likewise. + * config.sub: Likewise. + + * mpn/fujitsu/rshift.c: New file. + * mpn/fujitsu/lshift.c: New file. + * mpn/fujitsu: New directory, for Fujitsu VPP machines. + +Wed Sep 11 11:34:38 1996 Torbjorn Granlund + + * mpn/generic/mul_n.c (__gmpn_mul_n): New name for impn_mul_n. + Call __gmpn_mul_basecase, not impn_mul_n_basecase; update parameter + list to work with __gmpn_mul_basecase. + (__gmpn_sqr): New name for impn_sqr_n. + Call __gmpn_sqr_basecase, not impn_sqr_n_basecase; update parameter + list to work with __gmpn_sqr_basecase. + (mpn_mul_n): Update calls to match new names and parameter conventions. + * gmp-impl.h (MPN_MUL_N_RECURSE): Likewise. + (MPN_SQR_RECURSE): New name for MPN_SQR_N_RECURSE. + Update calls to match new names and parameter conventions. + * mpn/generic/mul.c: Never perform multiply explicitly here, call + __gmpn_mul_basecase instead. + Update calls to match new names and parameter conventions. + + * mpn/x86/mul_basecase.S: New file. + * mpn/generic/mul_basecase.c: New file. + * mpn/generic/sqr_basecase.c: New file. + +Wed Sep 4 02:59:21 1996 Torbjorn Granlund + + * mpz/set_str.c: Let `0b' and `0B' mean base 2. + +Fri Aug 30 00:44:00 1996 Torbjorn Granlund + + * longlong.h (x86 umul_ppmm): Work around GCC bug that was + triggered by Aug 28 change. + + * mpbsd/min.c (digit_value_in_base): New function. + + * mpz/set_str.c: Refine allocation size computation, use + chars_per_bit_exactly instead of chars_per_limb. + + * mpbsd/Makefile.in (.c.o): Add -D_mpz_realloc=_mp_realloc. + +Wed Aug 28 02:52:14 1996 Torbjorn Granlund + + * longlong.h (x86 umul_ppmm): Don't cast result operands. + (x86 udiv_qrnnd): Likewise. + (default smul_ppmm): Fix typo, umul_ppmm => smul_ppmm. + (default umul_ppmm): New #define using smul_ppmm. + (vax smul_ppmm): New #define. + (vax umul_ppmm): Delete. + (POWER umul_ppmm): Delete. + (IBM 370 smul_ppmm): New #define. + (IBM 370 umul_ppmm): Delete. + (IBM RT/ROMP smul_ppmm): New #define. + (IBM RT/ROMP umul_ppmm): Delete. + +Tue Aug 27 01:03:25 1996 Torbjorn Granlund + + * gmp-impl.h (__gmp_0): Make it `const'. + + * mpn/Makefile.in (clean mostlyclean): Comment out recursive clean + of `tests'. + + * mpn/generic/mul.c: Identify when we do squaring, and call + impn_sqr_n_basecase/impn_sqr_n as appropriate. Use + KARATSUBA_MUL_THRESHOLD and KARATSUBA_SQR_THRESHOLD. + Don't #define KARATSUBA_THRESHOLD. + + * mpn/generic/mul_n.c: Don't #define KARATSUBA_THRESHOLD. + (impn_mul_n, impn_sqr_n): Rewrite, based on code contributed by + Robert Harley. + (impn_sqr_n_basecase): Rewrite. + + * gmp-impl.h (KARATSUBA_MUL_THRESHOLD): New #define. + (KARATSUBA_SQR_THRESHOLD): Likewise. + (MPN_SQR_N_RECURSE): Use KARATSUBA_SQR_THRESHOLD. + (MPN_MUL_N_RECURSE): Use KARATSUBA_MUL_THRESHOLD. + + * configure.in: Fix typo in last change. + +Mon Aug 26 22:25:18 1996 Torbjorn Granlund + + * mpn/generic/random2.c: Fix typo, `alpha__' => `__alpha'. + * mpf/random2.c: Likewise. + +Sun Aug 25 00:07:09 1996 Torbjorn Granlund + + * mpz/tests/t-mul.c: Also test squaring. + +Fri Aug 16 05:12:08 1996 Torbjorn Granlund + + * mp_clz_tab.c (__clz_tab): Declare as `const'. + * version.c (gmp_version): Likewise. + * mpn/generic/sqrtrem.c (even_approx_tab, odd_approx_tab): Likewise. + +Thu Aug 15 02:34:47 1996 Torbjorn Granlund + + * gmp.h: Fix typo, `mips__' => `__mips'. + + * mpf/set_str.c: Allow a number to start with a period, if next + position contains a digit. + +Tue Aug 13 18:41:25 1996 Torbjorn Granlund + + * mpz/gcdext.c: Get cofactor sign right for negative input operands. + Clean up code for computing tt. + + * mpz/invert.c: Get rid of variable `rv'. + + * mpz/divexact.c: Test for zero divisor in special case for zero + dividend. + +Mon Aug 12 18:04:07 1996 Torbjorn Granlund + + * mpz/?div_*_ui.c: Special case for division by 0. + * mpz/tdiv_q.c: Likewise. + +Sat Aug 10 14:45:26 1996 Torbjorn Granlund + + * mpz/dmincl.c: Special case for division by 0. + + * mpz/tdiv_*_ui.c: Delete special case for dividend being 0; handle + it when computing size after mpn_divmod_1 call. + + * mp_bpl.c: (__gmp_junk): New variable. + (__gmp_0): New constant. + + * gmp-impl.h (DIVIDE_BY_ZERO): New #define. + +Fri Aug 9 20:03:27 1996 Torbjorn Granlund + + * mpz/divexact.c: Test for dividend being zero before testing + for small divisors. + +Thu Aug 8 13:20:23 1996 Torbjorn Granlund + + * configure.in: Require operating system specification for cpus + where assembly syntax differs between system. + + * Makefile.in (many targets): Change `-' action prefix to `@'. + + * mpn/Makefile.in: (distclean): Fix typo. + + * mpq/cmp_ui.c: Rename function to _mpq_cmp_ui. + (mpq_cmp_ui): #undef deleted. + * mpz/cmp_si.c: Rename function to _mpz_cmp_si. + (mpz_cmp_si): #undef deleted. + * mpz/cmp_ui.c: Rename function to _mpz_cmp_ui. + (mpz_cmp_ui): #undef deleted. + * Makefile.in: Corresponding changes. + + * mpf/get_prc.c: Return the *highest* precision achievable. + + * mpf/get_str.c: Complete rewrite. + + * mpf/set_str.c (swapptr): New #define. + (assert): New #define. + * mpf/set_str.c: Set prec to one more than the saved _mp_prec. + Misc cleanups. + + * mpz/set_str.c: #include string.h. + * mpf/out_str.c: #include string.h. + * mpbsd/xtom.c: #include string.h and ctype.h. + * mpbsd/mout.c: #include string.h. + +Wed Aug 7 11:46:04 EDT 1996 Ken Weber + + * mpn/generic/gcd.c: Reorder mpn_gcd argument list. + * mpz/gcd.c: Change call to mpn_gcd. + * gmp.texi: Update manual entry on mpn_gcd. + * mpn/generic/bdivmod.c: Delete limb cache to make mpn_bdivmod + reentrant. + +Wed Aug 7 02:15:38 1996 Torbjorn Granlund + + * mpf/get_str.c: Rewrite code for converting integral part of a + number with both an integral and fractional part. + + * mpf/set_str.c: Get rid of variable xxx. New variables madj and radj. + In exp_in_base==0 case, add madj to msize for EXP field. + + * mpz/tests/t-gcd.c: Test deleted. Rename t-gcd2.c to t-gcd.c. + Increase reps to 2000. + * mpz/tests/t-gcd2.c: Get rid of mpz_refgcd. + + * mpf/set_str.c: Ignore excess limbs in MP,MSIZE. + +Thu Jul 25 04:39:10 1996 Torbjorn Granlund + + * mpn/configure.in: Fix typo in setting path, "sparc" => "sparc32". + +Wed Jul 24 02:27:02 1996 Torbjorn Granlund + + * mpn/generic/gcdext.c: Reorganize and clean up. Get rid of all + signed limb arithmetic. + +Mon Jul 22 02:39:56 1996 Torbjorn Granlund + + * mpn/generic/gcdext.c (mpn_gcdext): For large enough operands, + work with most significant *two* limbs. + (div2): New function (two variants). + (THRESHOLD): New #define. + + * mpz/gcdext.c: Fix typo in MPZ_TMP_INIT call. + + * longlong.h (alpha UMUL_TIME): Now 30. + (alpha UDIV_TIME): Now 350. + (x86 UMUL_TIME): Now 10 (let Pentium decide). + (SuperSPARC UDIV_TIME): Override default. + + * extract-dbl.c (MP_BASE_AS_DOUBLE): Don't redefine here. + + * extract-dbl.c: New name for extract-double.c. + * insert-dbl.c: New name for insert-double.c. + * Makefile.in: Corresponding changes. + * make.bat: Likewise. + + * mpz/Makefile.in (.c.o): Don't pass non-portable `-f' to cp. + * mpq/Makefile.in: Likewise. + * mpf/Makefile.in: Likewise. + +Sat Jul 20 01:35:18 1996 Torbjorn Granlund + + * mpz/getlimbn.c: Take ABS of integer->_mp_size. + + * mpz/divexact.c: Use mpn_divmod_1 if divisor is a single limb. + +Thu Jul 18 00:31:15 1996 Torbjorn Granlund + + * mpn/generic/popcount.c (popc_limb): Use different masking trick + for first step (due to David Seal). + * mpn/generic/hamdist.c (popc_limb): Likewise. + +Wed Jul 17 23:21:48 1996 Torbjorn Granlund + + * mpn/generic/divrem.c: In MPN_COPY_DECR call, copy dsize - 1 limbs. + +Sun Jul 14 17:47:46 1996 Torbjorn Granlund + + * configure.in: Handle sparc9, sparc64, and ultrasparc like sparc8. + +Thu Jul 11 14:05:54 1996 J.T. Conklin + + * longlong.h (mc680x0): Define umul_ppmm, udiv_qrnnd, sdiv_qrnnd + for the '020, '030, '040, and '332. Define count_leading_zeros + for the '020, '030, '040, and '060. + +Sun Jul 14 15:24:53 1996 Torbjorn Granlund + + From Joe Keane: + * mpq/equal.c: Take ABS of num1_size before passing it to mpn_cmp. + +Fri Jul 12 17:11:17 1996 Torbjorn Granlund + + * mpn/generic/sqrtrem.c (SQRT): New asm for x86, but leave it + disabled for now. + + * mpn/generic/sqrtrem.c: Use MP_BASE_AS_DOUBLE. + +Wed Jul 10 03:17:45 1996 Torbjorn Granlund + + * cre-mparam.c: Delete obsolete file. + + * gmp.h: #define _LONG_LONG_LIMB if __mips && _ABIN32. + * longlong.h: Test __mips instead of __mips__. + +Sun Jul 7 23:19:13 1996 Torbjorn Granlund + + * longlong.h (_PROTO): Define, unless already defined. + (alpha __udiv_qrnnd): Declare using _PROTO. + (hppa __udiv_qrnnd): Likewise. + (sparc __udiv_qrnnd): Likewise. + +Mon Jul 1 01:44:30 1996 Torbjorn Granlund + + * config.guess: Update from master version; add Cray x90 handling. + +Wed Jun 26 05:35:02 1996 Torbjorn Granlund + + * mpn/power/add_n.s (__mpn_add_n): Work around GAS bug. + * mpn/power/sub_n.s (__mpn_sub_n): Likewise. + + * insert-double.c: Rework loop to avoid potential overflow. + + * mpq/get_d.c: For vax, if qsize > N_QLIMBS, ignore excess limbs. + + * mpq/tests/t-get_d.c (SIZE): Special case for vax. + + * gmp.h (mpX_cmp_ui): #define also when ! __GNUC__. + +Mon Jun 24 17:13:21 1996 Torbjorn Granlund + + * longlong.h (vax sdiv_qrnnd): Fix typo. + +Sat Jun 15 01:33:33 1996 Torbjorn Granlund + + * gmp.h: Support `small' and `large' type and function variants, + controlled by GMP_SMALL. + + * mpz/Makefile.in (.c.o): Compile each function twice, for small and + large variant. + (MPZS_OBJS): New variable. + (libmpz.a): Include MPZS_OBJS in archive. + * mpf/Makefile.in: Analogous changes. + * mpq/Makefile.in: Analogous changes. + + * gmp.h: Prefix all functions with __gmp, to allow namespace-clean + internal calls. + + * mp.h: Rip out __MP_SMALL__ stuff. + (__mpz_struct): mp_size_t => int. + + * mpz/invert.c: #include "gmp-impl.h". + Use MPZ_TMP_INIT, not mpz_init. + + * mpz/gcdext.c: Rewrite to call mpn_gcdext. + +Fri Jun 14 18:05:29 1996 Torbjorn Granlund + + * mpn/generic/gcdext.c (s0size): New parameter. + * gmp.h (mpn_gcdext): Update prototype. + + * mpn/generic/gcdext.c: Major rewrite. + +Mon Jun 10 00:14:27 1996 Torbjorn Granlund + + * mpn/generic/dump.c: Add missing `else'. + +Fri Jun 7 03:35:12 1996 Torbjorn Granlund + + * Makefile.in (gmp_toc.html): Pass -expandinfo to texi2html. + +Thu Jun 6 19:00:53 1996 Torbjorn Granlund + + * Version 2.0.2 released. + + * install.sh: New file. + * Makefile.in (INSTALL): Use install.sh. + (install-normal): New name for target `install'. + (install): New dummy target. + + * mpz/pow_ui.c: Swap tests for (e == 0) and (bsize == 0). + * mpz/ui_pow_ui.c: Swap tests for (e == 0) and (blimb == 0). + + * config/mt-linux (AR_FLAGS): New file. + * configure.in: Use config/mt-linux for all linux systems. + +Tue Jun 4 03:42:18 1996 Torbjorn Granlund + + * Version 2.0.1 released. + + * mpf/tests/ref.c: Cast result of TMP_ALLOC to the right pointer type. + + * extract-double.c: Test _GMP_IEEE_FLOATS with #if, not plain if. + + * insert-double.c: Don't #include stdlib.h. + + * gmp-impl.h (union ieee_double_extract): Test sparc and __sparc. + Do not test __sparc__. + + * mpf/reldiff.c: Change declaration to work around irix5 compiler bug. + * mpq/equal.c: Likewise. + + * mpn/generic/gcd.c: Delete spurious comma at end of enumeration. + + * mpn/generic/gcdext.c: Add K&R declaration syntax. + * stack-alloc.h: Likewise. + * insert-double.c: Likewise. + * extract-double.c: Likewise. + * mpf/tests/reuse.c: Likewise. + * mpz/tests/reuse.c: Likewise. + * mpf/tests/t-sub.c: Likewise. + * mpf/tests/t-add.c: Likewise. + * mpf/tests/t-muldiv.c: Likewise. + * mpf/tests/t-conv.c: Likewise. + * mpf/tests/ref.c: Likewise. + + * mpn/config/t-oldgas: Renamed from t-freebsd. + * mpn/configure.in: Use t-oldgas for freebsd, netbsd, and some linux + configurations. + + * mpn/powerpc32/mul_1.s: Really clear cy before entering loop. + * mpn/powerpc32/*.s: Fix power/powerpc syntax issues. + + * mpn/config/t-ppc-aix: New file. + * mpn/configure.in: Use t-ppc-aix for powerpc like t-pwr-aix for power. + +Wed May 29 02:07:31 1996 Torbjorn Granlund + + * gmp.h (mp_bits_per_limb): Change qualifier from `const' to + __gmp_const. + + * gmp.h (mpf_init_set_str): Add `const' qualifier for 2nd parameter. + * mpf/iset_str.c: Likewise. + +Mon May 27 00:15:58 1996 Torbjorn Granlund + + * gmp-impl.h: Declare __gmp_extract_double. + + * mpz/set_q.c: Delete unused variables. + + * gmp.h (mpq_equal): Declare. + + * mpf/eq.c: mpf_cmp2 -> mpf_eq. + +Fri May 24 03:20:44 1996 Torbjorn Granlund + + * mpz/iset_d.c: Don't include . + + * insert-double.c (__gmp_scale2): New name for scal2. + * mpz/get_d.c: Corresponding change. + * mpf/get_d.c: Likewise. + * mpq/get_d.c: Likewise. + * gmp-impl.h: Declare __gmp_scale2. + + * mpn/generic/scan0.c: Clarify comment. + + * mpz/set_q.c: New file. + * Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h: Declare mpz_set_q. + + * insert-double.c: New file. + * Makefile.in: Compile it. + * make.bat: Likewise. + + * mpz/get_d.c: New file. + * mpz/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h: Declare mpz_get_d. + + * mpf/get_d.c: New file. + * mpf/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h: Declare mpf_get_d. + + * make.bat: Compile things in alphabetical order. + + * gmp-impl.h (MP_BASE_AS_DOUBLE): New #define. + (LIMBS_PER_DOUBLE): New #define. + + * extract-double.c: New file. + * Makefile.in: Compile it. + * make.bat: Likewise. + * mpz/set_d.c: Rewrite to use __gmp_extract_double. + * mpf/set_d.c: Likewise. + + * mpn/configure.in: Use t-pwr-aix also for aix 3.2.4 and up. + +Wed May 22 02:48:35 1996 Torbjorn Granlund + + * gmp-impl.h: Rework code for defining ieee_double_extract. + (IEEE_DOUBLE_BIG_ENDIAN): Macro removed. + (_GMP_IEEE_FLOATS): New macro. + * mpn/vax/gmp-mparam.h: Delete. + + * mpn/config/t-pwr-aix: New file. + * mpn/configure.in: Use t-pwr-aix for aix 4 and later. + +Mon May 20 16:30:31 1996 Torbjorn Granlund + + * gmp.h: In code for setting _GMP_H_HAVE_FILE, test more symbols. + + * mpf/tests/t-add.c (oo): Add some `l' printf modifiers. + * mpf/tests/t-sub.c (oo): Likewise. + * mpf/tests/t-conv.c (oo): Likewise. + * mpf/tests/t-sqrt.c (oo): Likewise. + + * mpz/tests/t-mul.c (_mpn_mul_classic): Remove unused variables. + + * mpn/{pyr,i960,clipper}/*.s: Add missing copyright headers. + +Fri May 17 02:24:43 1996 Torbjorn Granlund + + * mpz/set_d.c: Call _mpz_realloc. + + * mpq/set_z.c: New file. + * mpq/Makefile.in: Compile it. + * make.bat: Likewise. + * gmp.h: Declare mpq_set_z. + + * mp?/Makefile.in (libmp?.a): Depend on Makefile, not Makefile.in. + * mpf/Makefile.in (test): Delete spurious target. + * mpq/Makefile.in (test): Likewise. + + * mpf/out_str.c: Use `e' to separate exponent when base <= 10. + + * mpn/configure.in: Treat ultrasparc just like sparc v8, + until 64-bit compilers are ready. + + * mpf/set_d.c: Make it work for 64-bit machines. + +Thu May 16 20:53:57 1996 Torbjorn Granlund + + * gmp-impl.h: Set IEEE_DOUBLE_BIG_ENDIAN to 0 for little-endian + machines. + * mpn/x86/gmp-mparam.h: Delete file. + + * configure.in: Treat microsparc like sparc8. + + * urandom.h: Test __alpha instead of __alpha__, since the former + is the standard symbol. + * mpn/generic/random2.c: Likewise. + * mpf/random2.c: Likewise. + +Tue May 14 13:42:39 1996 Torbjorn Granlund (tege@tiny.matematik.su.se) + + * mpz/set_f.c: New file. + * mpz/Makefile.in: Compile it. + * gmp.h: Declare mpz_set_f. + + * mpf/set_q.c: Simplify expression in rsize == nsize if-then-else arms. + +Tue May 14 13:03:07 1996 Torbjorn Granlund (tege@tiny.matematik.su.se) + + * make.bat: Add all new files. + +Sun May 12 22:24:36 1996 Torbjorn Granlund + + * mpf/set_z.c: New file. + * mpf/Makefile.in: Compile it. + * gmp.h: Declare mpf_set_z. + +Sat May 11 19:26:25 1996 Torbjorn Granlund + + * gmp.h: Declare mpf_set_q. + + * mpf/set_q.c: Compute prec-1 limbs in mpn_divrem call. + +Fri May 10 17:37:38 1996 Torbjorn Granlund + + * mpf/set_q.c: New file. + * mpf/Makefile.in: Compile it. + + * config.sub: Recognize sparc8. + +Wed May 8 09:19:11 1996 Torbjorn Granlund + + * mpf/tests/t-dm2exp.c: New file. + + * mpf/tests/t-add.c: Correct header comment. + * mpf/tests/t-sub.c: Likewise. + * mpf/tests/t-sqrt.c: Likewise. + + * mpf/div.c: Misc variable name cleanups. + * mpf/div_ui.c: Base more closely on mpf/div.c. + * mpf/ui_div.c: Likewise. + + * mpz/tests/Makefile.in (check): Depend on Makefile. + * mpq/tests/Makefile.in (check): Likewise. + * mpf/tests/Makefile.in (check): Likewise. + + * mpf/tests/t-muldiv.c: New file. + * mpf/tests/Makefile.in: Compile and run `t-muldiv'. + (t-ref.o): Delete spurious rule. + + * mpf/sqrt.c: Properly detect negative input operand. + + * mpf/sqrt_ui.c: Delete spurious header comment. + * mpf/sqrt.c: Likewise. + * mpz/sqrt.c: Likewise. + + * mpz/tests/reuse.c (main): Read `reps' from command line. + + * mpf/tests/reuse.c: New file. + * mpf/tests/Makefile.in: Compile and run `reuse'. + + * mpf/mul_ui.c: Disable code for removing low zero limbs. + + * mpf/div.c: Fix condition for when vp and qp overlaps. + + * mpf/add_ui.c: When sum equals u, copy up to prec+1 limbs. + + * mpf/out_str.c: Don't output '\n' after exponent. + + * mpf/add_ui.c: New special case for when U is completely cancelled. + +Wed Apr 24 05:33:28 1996 Torbjorn Granlund + + * Version 2.0 released. + + * All files: Update FSF's address. + + * Makefile.in (gmp_toc.html): New name for gmp.html. + (TAGS): Depend on force. + + * mpf/tests/t-conv.c: Pass -base to mpf_set_str. + +Sat Apr 20 03:54:06 1996 Torbjorn Granlund + + * Makefile.in (ps): New target, depend on gmp.ps. + +Fri Apr 19 14:03:15 1996 Torbjorn Granlund + + * mpf/out_str.c: Print `@' before exponent, not `e'. + + * make.bat: Update from Makefiles. + +Thu Apr 18 01:22:05 1996 Torbjorn Granlund + + * mpf/set_str.c: If parameter `base' is negative, expect exponent + to be decimal, otherwise in the same base as the mantissa. + +Wed Apr 17 17:28:36 1996 Torbjorn Granlund + + * mpf/set_dfl_prec.c: Don't return anything. + * gmp.h: Corresponding changes. + + * mpf/set_dfl_prec.c: Use `unsigned long int' for bit counts. + * mpf/init2.c: Likewise. + * mpf/get_prc.c: Likewise. + * mpf/set_prc.c: Likewise. + * mpf/set_prc_raw.c: Likewise. + * mpz/popcount.c: Likewise. + * mpz/hamdist.c: Likewise. + * mpz/scan1.c: Likewise. + * mpz/scan0.c: Likewise. + * mpn/generic/popcount.c: Likewise. + * mpn/generic/hamdist.c: Likewise. + * mpn/generic/scan1.c: Likewise. + * mpn/generic/scan0.c: Likewise. + * gmp.h: Likewise. + + * mpf/eq.c: New file, based on mpf/diff.c. + * mpf/diff.c: Delete. + * mpf/Makefile.in: Corresponding changes. + * gmp.h: Likewise. + + * mpf/reldiff.c: New file. + * mpf/Makefile.in: Compile it. + * gmp.h: Declare mpf_reldiff. + + * mpz/iset_d.c: New file. + * mpz/Makefile.in: Compile it. + * gmp.h: Declare mpz_init_set_d. + +Tue Apr 16 16:28:31 1996 Torbjorn Granlund + + * Makefile.in (gmp.html): Pass -acc to texi2html. + +Mon Apr 15 16:20:24 1996 Torbjorn Granlund + + * mpf/set_str.c: Switch off code for defaulting the base from the + leading characters. + + * gmp.h (mp?_sign): Delete. + (mp?_sgn): New macros. + +Fri Apr 12 17:23:33 1996 Torbjorn Granlund + + * Makefile.in (gmp.dvi): Delete tmp.* at end of rule. + +Wed Apr 10 22:52:02 1996 Torbjorn Granlund (tege@tiny.matematik.su.se) + + * mpf/random2.c: Change of `exp' param, mp_size_t => mp_exp_t. + * gmp.h: Corresponding change. + + * gmp.h (mp_bits_per_limb): Make it const. + +Sat Mar 30 01:20:23 1996 Torbjorn Granlund + + * configure.in: Re-enable recognition of with_gcc. + + * mpf/Makefile.in (.c.o): Pass XCFLAGS. + * mpn/Makefile.in (.c.o): Likewise. + * mpz/Makefile.in (.c.o): Likewise. + * mpq/Makefile.in (.c.o): Likewise. + * mpbsd/Makefile.in (.c.o): Likewise. + * mpf/tests/Makefile.in (.c.o): Likewise. + * mpz/tests/Makefile.in (.c.o): Likewise. + * mpq/tests/Makefile.in (.c.o): Likewise. + + * Makefile.in (XCFLAGS): Default to empty. + (FLAGS_TO_PASS): Pass on XCFLAGS. + (.c.o): Pass XCFLAGS. + + * config/mt-m88110 (XCFLAGS): Define instead of CC. + * config/mt-sprc8-gcc (XCFLAGS): Likewise. + * config/mt-supspc-gcc (XCFLAGS): Likewise. + + * configure: Don't default CC to "gcc -O2" is -with-gcc=no was + specified. + +Mon Mar 25 01:07:54 1996 Torbjorn Granlund + + * urandom.h: Test for __SVR4 in addition to __svr4__. + + * mp_bpl.c (mp_bits_per_limb): Declare as `const'. + + * Makefile.in (CFLAGS): `-O2' => `-O'. + * mpn/Makefile.in (CFLAGS): Likewise. + + * gmp-impl.h: Get rid of obsolete field access macros. + + * mpn/mp_bases.c (__mp_bases): 1e39 => 1e38 to work around Solaris + cc compiler bug. + + * gmp.h (__MPN): Make it work also for non-ANSI compilers. + +Thu Mar 21 01:07:54 1996 Torbjorn Granlund + + * mpf/sub.c: New special case for ediff <= 1 before generic code. + Simplify generic code for ediff == 0. + Rename uexp => exp. + +Mon Mar 11 18:24:57 1996 Torbjorn Granlund + + * mpf/tests/*.c: Use ref_mpf_sub for error calculation. + * mpf/tests/Makefile.in: Link ref.o to all executables. + + * mpf/tests/t-sub.c: Make u = v + 1 with 50% probability. + +Sun Mar 10 21:03:17 1996 Torbjorn Granlund (tege@tiny.matematik.su.se) + + * mpf/get_str.c: In digit development loop for fractions, change + loop condition from `<' to `<='. + +Thu Mar 7 04:58:11 1996 Torbjorn Granlund + + * mpn/mp_bases.c (__mp_bases): 1e100 => 1e39 to avoid overflow warning. + +Wed Mar 6 01:10:42 1996 Torbjorn Granlund + + * mpf/tests/t-sqrt.c: New file. + * mpf/tests/Makefile.in: Corresponding changes. + + * mpf/sqrt.c: Special case for square root of zero. + + * mpq/add.c: Clean up variable names. + * mpq/sub.c: Update from mpq/add.c. + + * mpz/divexact.c: abs => ABS. + * mpz/gcd.c: Likewise. Rewrite final fixup code, to decrease + allocation. Misc cleanups. + +Tue Mar 5 22:24:56 1996 Torbjorn Granlund + + * mpn/configure.in: Recognize linuxoldld as a synonym for linuxaout. + + * gmp.h (mpn_add, mpn_add_1, mpn_sub, mpn_sub_1): Add prototypes. + + * mpn/configure.in: Use t-freebsd also for netbsd. + +Mon Mar 4 15:13:28 1996 Torbjorn Granlund + + * mpq/Makefile.in (cmp.o): Depend on longlong.h. + + * mpq/equal.c: New file. + * mpq/Makefile.in: Corresponding changes. + + * mpf/tests/t-add.c: New file. + * mpf/tests/t-sub.c: Renamed from t-addsub.c. + * mpf/tests/ref.c: New file. + * mpf/tests/Makefile.in: Corresponding changes. + + * gmp-impl.h (SIZ, ABSIZ, PTR, EXP, PREC, ALLOC): New #defines. + +Sun Mar 3 07:45:46 1996 Torbjorn Granlund + + * mpf/set_str.c: In exponentiation code, allocate 3 extra + limbs, not just 2. + + * mpf/get_str.c: Allocate sufficient space for tstr. + When calculating exp_in_base, round result down. + + * mpf/tests/t-conv.c: New file. + * mpf/tests/Makefile.in: Corresponding changes. + + * mp_bpl.c: New file. + * gmp.h: Declare it. + * Makefile.in: Corresponding changes. + +Sat Mar 2 06:27:56 1996 Torbjorn Granlund + + * mpf/set_prc_raw.c: New file. + * mpf/set_prc.c: Renamed from set_prec.c. + * mpf/get_prc.c: New file. + * mpf/Makefile.in: Corresponding changes. + * gmp.h: Declare new functions. + + * mpn/generic/gcdext.c: Add copyright header. + +Fri Mar 1 01:22:24 1996 Torbjorn Granlund + + * mpn/configure.in: For ppc601, search "power" before "powerpc32". + + * mp?/Makefile.in (AR_FLAGS): New variable. + (libmp?.a): Use it. + + * make.bat: New file. + * mpn/msdos: New directory. + * mpn/msdos/asm-syntax.h: New file. + + * mpn/Makefile.in (distclean maintainer-clean): Delete asm-syntax.h. + + * config.sub: Recognize [ctj]90-cray. + + * mpn/configure.in: Recognize [ctj]90-cray-unicos*. + + * mpn/generic/gcdext.c: Don't use alloca directly, use TMP_* macros. + + * mpn/generic/gcd.c: Split increment from use of USIZE to avoid + undefined behaviour. + +Thu Feb 29 04:11:24 1996 Torbjorn Granlund + + * Makefile.in (install-info-files): Update for new install-info + behaviour. + + * mpn/power/add_n.s: Rewrite. + * mpn/power/sub_n.s: Rewrite. + +Wed Feb 28 01:34:30 1996 Torbjorn Granlund + + * mpz/pow_ui.c: Compute allocation more aggressively for small bases. + * mpz/ui_pow_ui.c: Likewise. + + * mpn/mp_bases.c (__mp_bases): Put huge value in 2nd field for index 1. + + * mpn/generic/sqrtrem.c: sizeof (mp_limb_t) => BYTES_PER_MP_LIMB. + * mpn/generic/gcd.c: Likewise. + (SIGN_BIT): Compute differently. + +Mon Feb 26 00:07:36 1996 Torbjorn Granlund + + * All files: mp_limb => mp_limb_t, mp_limb_signed => mp_limb_signed_t. + + * Makefile.in (install, install-bsdmp, install-info-files): Depend + on installdirs. chmod all installed files. + +Sun Feb 25 01:47:41 1996 Torbjorn Granlund + + * mpbsd/configure.in: Delete debugging code. + + * All Makefile.in: Update clean targets. + + * Makefile.in (AR_FLAGS): New variable. + (libgmp.a): Use it. + (libmp.a): Likewise. + + * VERSION: Delete file. + + * Makefile.in (installdirs): New target. + * mkinstalldirs: New file (from the texinfo package). + + * Makefile.in (INSTALL, INSTALL_DATA, INSTALL_PROGRAM): New variables. + (MAKEINFO, MAKEINFOFLAGS, TEXI2DVI): New variables. + (install-info): New target. + (install, install-bsdmp): Depend on install-info. + ($(srcdir)/gmp.info): Changed from plain gmp.info; put info files + into source directory. + (distclean, mostlyclean): New targets. + (maintainer-clean): New name for realclean. + (uninstall): New target. + (TAGS): New target. + (info, dvi): New targets. + (.PHONY): Assign. + + * Makefile.in (install, install-bsdmp): Use INSTALL_DATA. + + * mp{n,z,f,bsd}/move-if-change: Delete. + + * mpbsd/Makefile.in (stamp-stddefh): Delete target. + + * Makefile.in (.c.o): Pass CFLAGS last. + * mpbsd/Makefile.in (.c.o): Likewise. + * mpf/Makefile.in (.c.o): Likewise. + * mpq/Makefile.in (.c.o): Likewise. + * mpz/Makefile.in (.c.o): Likewise. + * mpn/Makefile.in (.c.o): Likewise. + (.S.o): Likewise. + + * memory.c: Change allocation error message. + + * Makefile.in (install): Prefix gmp.h with $(srcdir). + (install-bsdmp): Prefix mp.h with $(srcdir). + + * mp{n,z,f,bsd}/{configure,config.sub}: Delete. + + * Makefile.in (gmp.dvi): Set TEXINPUTS also for 2nd tex invocation + (install targets): Install gmp.info-N. + +Sat Feb 24 03:36:52 1996 Torbjorn Granlund + + * mpf/get_str.c: Fix typo. + + * mpz/legendre.c: Clarify expression with extra parens. + + * version.c (gmp_version): Not static. + + * mpf/iset_str.c: Properly return error code. + + * mpf/add.c: Delete unused variables. + * mpf/inp_str.c: Likewise. + * mpq/get_d.c: Likewise. + + * mpn/generic/dump.c: #include . + * mpf/dump.c: Likewise. + * mpf/set_str.c: #include . + (strtol): Declare. + + * gmp.h: mpn_sqrt => mpn_sqrtrem. + + * Makefile.in (clean, realclean): Clean in mpbsd. + (check): Test in mpf. + + * mpf/Makefile.in (clean): Clean in tests. + * mpq/Makefile.in (clean): Clean in tests. + + * mpf/tests/Makefile.in: New file. + * mpf/tests/configure.in: New file. + * mpf/tests/t-addsub.c: New file. + + * mpf/sub_ui.c: Simply call mpf_sub for now. + + * mpf/sub.c: Increase prec by 1. + * mpf/ui_sub.c: Likewise. + +Fri Feb 23 00:59:54 1996 Torbjorn Granlund + + * mpf/ui_sub.c: Fix typos. + + * mpf/get_str.c: When allocating space for tmp, allow for an extra + limb. In code for fraction conversion, add special case for bases + that are a power of 2. + + * mpf/out_str.c: Output leading "0.". + Default base to 10, before computing string allocation. + + * mpf/get_str.c: Make variables for string size have type size_t. + * gmp.h: Corresponding change. + + * mpf/random2.c: Allow creation of prec+1 large mantissas. + + * mpf/add_ui.c: Don't abort if u < 0; special case for u <= 0. + Fix typo in MPN_COPY offset. + * mpf/sub_ui.c: Analogous changes. + + * mpf/set_prec.c: Rewrite. + + * mpf/init2.c: Compute precision as in set_prec.c. + + * mpf/div_2exp.c: Special case for u == 0. + * mpf/mul_2exp.c: Likewise. Write r->_mp_size always. + + * mpf/sqrt_ui.c: mpn_sqrt => mpn_sqrtrem. + * mpf/sqrt.c: Likewise. When computing new exponent, round quotient + towards -infinity. + + * mpf/add.c: Fix typos. + * mpf/sub.c: Fix typos. + +Thu Feb 22 00:24:48 1996 Torbjorn Granlund + + * mpz/Makefile.in (stamp-stddefh): Delete target. + (test): Delete target. + * Makefile.in (stamp-stddefh): Delete target. + (cre-stddefh.o): Delete target. + (gmp.dvi): Set TEXINPUTS before invoking tex. + + * cre-stddefh.c: Delete. + + * mpz/sqrt.c: Fix typo. + + * mpz/powm.c: Special case for mod == 0. + * mpz/powm_ui.c: Likewise. + + * mpz/get_si.c: Handle -0x80000000 correctly. + + * mpz/inp_str.c: Now returns size_t. + Make it return number of bytes read or error indication. + * mpf/inp_str.c: Likewise. + + * mpz/out_raw.c: Replace by mpz/out_binary.c, with modifications. + * mpz/inp_raw.c: Rewrite, using mpz/inp_binary as a base. + * mpz/inp_binary.c: Delete. + + * mpn/Makefile.in (XCFLAGS): Remove variable. + (.c.o): Don't pass XCFLAGS. + (SFLAGS): Set to nothing. + (.S.o): Pass SFLAGS, not XCFLAGS. + + * mpn/config/t-freebsd (SFLAGS): New name for XCFLAGS. + + * mpf/out_str.c: Make return number of bytes written or error + indication. + * mpz/out_str.c: Likewise. + * gmp.h: Corresponding changes. + + * gmp.h (__mpz_struct): mp_size_t => int. + (__mpq_struct): Likewise. + (__mpf_struct): Likewise. + (mp_size_t): int => long int. + + * mpn/cray: New directory. + * mpn/cray/gmp-mparam.h: New file. + * mpn/configure.in: Recognize cray variants. + + * Makefile.in: Set defaults for prefix, libdir, etc. + (install): New target. + (install-bsdmp): New target. + (gmp.html): New target. + + * stack-alloc.c (__tmp_alloc): Cast void ptrs to char * in comparison. + +Wed Feb 21 04:35:02 1996 Torbjorn Granlund + + * gmp.h: Sort mpn declarations. + (mpn_gcdext): Add declaration. + + * mpn/generic/divrem_1.c: New file. + * mpn/Makefile.in (divrem_1.o): New rule. + * configure.in (functions): Add divrem_1. + + * mpn/generic/divmod.c: Delete file. + * mpn/configure.in (functions): Delete divmod. + * Makefile.in (divmod.o): Delete rule. + * gmp.h (mpn_divmod): New #define. + + * gmp.h (mpn_next_bit_set): Delete spurious declaration. + + * mpn/generic/divrem.c (default case): In code assigning + most_significant_q_limb, move reassignment of n0 into if statement. + + * gmp.h (mpf_inp_str): Fix typo. + (mpf_out_str): Make prototype match reality. + * mpf/inp_str.c: New file. + * mpf/out_str.c: New file. + * mpf/Makefile.in: Compile new files. + + * mpn/Makefile.in (dump.o): Fix dependency path. + (inlines.o): Likewise. + + * mpn/configure.in: Make m68060 be the same as m68000. Clean up + m68k configs. + +Tue Feb 20 01:35:11 1996 Torbjorn Granlund + + * mpn/generic/sqrtrem.c: Renamed from sqrt. + * mpn/configure.in (functions): Corresponding change. + * mpn/Makefile.in: Likewise. + * mpz/sqrtrem.c: Likewise. + * mpz/sqrt.c: Likewise. + * mpn/generic/perfsqr.c: Likewise. + + * Makefile.in (clean): Also remove libmp.a. + Don't compile cre-conv-tab.c or mp_bases.c. + cre-conv-tab.c: Delete file. + (gmp.ps): New rule. + + * mpn/mp_bases.c: New file. + * mpn/Makefile.in: Compile mp_bases.c. + + * mpz/set_str.c: Skip initial whitespace. + * mpf/set_str.c: Likewise. + * mpbsd/xtom.c: Likewise. + + * gmp.h: Add missing mpz declarations. + Delete all formal parameter names from declarations. + + * mpn/Makefile.in: Add dependencies for .c files. + + * Makefile.in (check): Write recursive make calls separately, not as + a loop. + (FLAGS_TO_PASS): New variable. Use it for most recursive makes. + +Mon Feb 19 01:02:20 1996 Torbjorn Granlund + + * mpn/Makefile.in (.S.o): Pipe cpp output to grep in order to delete + lines starting with #. + (CPP): Set to $(CC) -E to avoid gcc dependency. + + * mpn/m68k/syntax.h (moveql): Define to moveq for MIT_SYNTAX. + + * mpn/hppa/hppa1_1/pa7100/addmul_1.S: Fix typo in s1_ptr alignment + code. + * mpn/hppa/hppa1_1/pa7100/submul_1.S: Likewise. + + * gmp.h: Fix typos in #defines of recently added mpn functions. + + * mpz/inp_str.c: Skip all whitespace, not just plain space. + * mpbsd/min.c: Likewise. + + * mpn/configure.in (functions): Add gcdext. + * mpn/generic/gcdext.c: New file. + + * mpz/legendre.c: mpz_div_2exp => mpz_tdiv_q_2exp. + + * gmp.h: Surround mpn declarations with extern "C" { ... }. + + * Makefile.in (check): New target. + + * mpq/get_d.c: Update comments. Use rsize instead of dsize + N_QLIMBS + when possible. Add special case for nsize == 0. + + * gmp.h (mpq_get_d): Add declaration. + (mpq_canonicalize): Likewise. + (mpq_cmp_ui): Likewise. + (mpf_diff): Likewise. + (mpf_ui_sub): Likewise. + (mpf_set_prec): Likewise. + (mpf_random2): Likewise. + + * gmp.h (mpz_cmp_ui): New #define. + (mpz_cmp_si): New #define. + (mpq_cmp_ui): New #define. + (mpz_sign): New #define. + (mpq_sign): New #define. + (mpf_sign): New #define. + (mpq_numref): New #define. + (mpq_denref): New #define. + + * mpq/set_z.c: File deleted. + * mpq/Makefile.in: Corresponding changes. + +Sun Feb 18 01:34:47 1996 Torbjorn Granlund + + * mpbsd/sdiv.c: Use _mp_realloc, not _mpz_realloc. + + * mpz/inp_binary.c: Default stream to stdin. + * mpz/inp_str.c: Likewise. + * mpz/inp_raw.c: Likewise. + * mpz/out_binary.c: Default stream to stdout. + * mpz/out_raw.c: Likewise. + * mpz/out_str.c: Likewise. + + * mpbsd/realloc.c: New file. + * mpbsd/Makefile.in: Corresponding changes. + + * mpbsd/min.c: Rewrite (base on mpz/inp_str.c). + * mpbsd/mtox.c: Rewrite (base on mpz/get_str.c). + + * mpbsd/mout.c: Rewrite (base on mpz/out_str) but make it output + spaces in each 10th position. + * mpbsd/xtom.c: Rewrite (base on mpz/set_str). + + * mpq/tests/Makefile.in (st-cmp): New file. + * mpq/tests/configure.in (srcname): New file. + + * mpz/tests/configure.in (srcname): Fix typo. + + * mpq/cmp.c: Add check using number of significant bits, to avoid + general multiplication. + +Sat Feb 17 11:58:30 1996 Torbjorn Granlund + + * mpq/cmp_ui.c: Store cy_limb after the mpn_mul_1 calls. + + * mpq/tests: New directory. + * mpq/tests/t-cmp.c: New file. + * mpq/tests/t-cmp_ui.c: New file. + + * mpz/tests/dive.c (main): Generate zero numerator. + (get_random_size) : Delete. + + * mpz/divexact.c: Add special case for 0/x. + + * gmp.h (mpz_mod): Add declaration. + +Fri Feb 16 18:18:39 1996 Andreas Schwab + + * mpn/m68k/*: Rewrite code not to use the INSN macros. + (L): New macro to properly prefix local labels for ELF. + +Fri Feb 16 00:20:56 1996 Torbjorn Granlund + + * gmp-impl.h (ieee_double_extract): Use plain `unsigned int' for + fields. + * mpn/generic/inlines.c (_FORCE_INLINES): New #define. Delete + conditional __GNUC__. + * gmp.h (mpn_add, mpn_sub, mpn_add_1, mpn_sub_1): + Only define these if __GNUC__ || _FORCE_INLINES. + * mpf/random2.c: Add missing parameter in non-ANSI header. + * mpn/generic/gcd.c (SIGN_BIT): Do as #define to work around bug + in AIX compilers. + * mpq/get_d.c: #define N_QLIMBS. + * mpz/divexact.c: Obscure division by 0 to silent compiler warnings. + * stack-alloc.c: Cast void* pointer to char* before doing arithmetic + on it. + + * Makefile.in (mpbsd/libmpbsd.a): New rule. + * configure.in (configdirs): Add mpbsd. + + * gmp.h: Add declarations for a few missing mpn functions. + + * Makefile.in (libmp.a): New rule. + + * mpbsd/mdiv.c: #include "dmincl.c", not "mpz_dmincl.c" + * gmp.h: Move #define of __GNU_MP__ into the `#if __GNU_MP__' block. + * mp.h: Likewise. Update typedefs from gmp.h. + * mpbsd/configure.in: New file. + * mpbsd/Makefile.in: New file. + * mpbsd/configure: Link to master configure. + * mpbsd/config.sub: Link to master config.sub. + + * Makefile.in: Set RANLIB_TEST. + * (libgmp.a): Use it. + * (libgmp.a): Do ranlib before moving the libgmp.a to the build + directory. + * mp?/Makefile.in: Don't use or set RANLIB. + +Thu Feb 15 16:38:41 1996 Torbjorn Granlund + + * mpz/add_ui.c: MP_INT => mpz_t. + * mpz/cmp_ui.c: Likewise. + * mpz/fac_ui.c: Likewise. + * mpz/inp_binary.c: Likewise. + * mpz/inp_raw.c: Likewise. + * mpz/legendre.c: Likewise. + * mpz/jacobi.c: Likewise. + * mpz/out_binary.c: Likewise. + * mpz/out_raw.c: Likewise. + * mpz/random2.c: Likewise. + * mpz/random.c: Likewise. + * mpz/realloc.c: Likewise. + + * mpz/legendre.c: __mpz_2factor(X) => mpz_scan1(X,0), + __mpz_odd_less1_2factor => mpz_scan1(X,1). + * mpz/ntsup.c: File deleted. + * mpz/Makefile.in: Corresponding changes. + + * mpz/pprime_p: Use mpz_scan1 to avoid looping. + + * mpz/fac_ui.c: Type of `k' and `p' is `unsigned long'. + * mpz/pprime_p.c: Pass long to *_ui functions. + * mpz/gcdext.c: Likewise. + * mpz/fdiv_r_2exp.c: Likewise. + * mpz/fac_ui.c: Likewise. + + * mpz/powm.c: Don't use mpn_rshift when mod_shift_cnt is 0. + + * mpz/tests/Makefile.in (st-sqrtrem): Fix typo. + + * mpz/cmp_ui.c: #undef mpz_cmp_ui. + * mpz/cmp_si.c: #undef mpz_cmp_si. + * gmp.h (mpz_cmp_ui): New #define. + (mpz_cmp_si): New #define. + +Wed Feb 14 22:11:24 1996 Torbjorn Granlund + + * gmp.h: Test __cplusplus in addition to __STDC__. + * gmp-impl.h: Likewise. + + * gmp.h: Surround declarations with extern "C" { ... }. + +Tue Feb 13 15:20:45 1996 Torbjorn Granlund + + * mpz/fdiv_r_2exp.c: Use MPN_NORMALIZE. + * mpz/tdiv_r_2exp.c: Likewise. + + * mpz/fdiv_r_2exp.c: New file. + * mpz/fdiv_q_2exp.c: New file. + * mpz/tdiv_r_2exp.c: Renamed from mpz/mod_2exp.c. + * mpz/tdiv_q_2exp.c: Renamed from mpz/div_2exp.c + * mpz/Makefile.in: Corresponding changes. + + * mpz/scan0.c,scan1.c: New files. + * mpz/Makefile.in: Compile them. + + * gmp.h (mpn_normal_size): Delete. + + * config.guess: Update from Cygnus version. + + * mpn/m68k/rshift.S: Use INSN2 macro for lea instructions. + * mpn/m68k/lshift.S: Likewise. + + * mpn/configure.in: Fix configuration for plain 68000. + +Mon Feb 12 01:06:06 1996 Torbjorn Granlund + + * mpz/tests/t-powm.c: Generate negative BASE operand. + + * mpz/powm.c: Make result always positive. + +Sun Feb 11 01:44:56 1996 Torbjorn Granlund + + * mpz/tests/*.c: Add t- prefix. + * mpz/tests/Makefile.in: Corresponding changes. + * mpz/tests/configure.in: Update srctrigger. + + * mpz/tests/gcd.c: Generate negative operands. + * mpz/tests/gcd2.c: Likewise. + + * mpz/gcdext.c: At end, if G is negative, negate all G, S, and T. + +Thu Feb 8 17:16:12 UTC 1996 Ken Weber + + * mp{z,n}/gcd.c: Change mpn_gcd interface. + * gmp.h: Ditto. + * gmp.texi: update documentation. + +Mon Feb 7 23:58:43 1996 Andreas Schwab + + * mpn/m68k/{lshift,rshift}.S: New files. + * mpn/m68k/syntax.h: New ELF_SYNTAX macros. + (MEM_INDX, R, PROLOG, EPILOG): New macros. + * mpn/m68k/*.S: Use R macro with register name. Use PROLOG and EPILOG + macros. Rename `size' to `s_size' or s1_size to avoid clash with ELF + .size directive. + * mpn/configure.in: New target m68k-*-linux*. + +Wed Feb 7 07:41:31 1996 Torbjorn Granlund + + * Makefile.in (cre-conv-tab): Workaround for SunOS make. + + * mpz/tests/reuse.c: New file. + * mpz/tests/Makefile.in: Handle reuse.c. + +Tue Feb 6 11:56:24 UTC 1996 Ken Weber + + * mpz/gcd.c: Fix g->size when one op is 0 and g == other op. + +Tue Feb 6 01:36:39 1996 Torbjorn Granlund + + * gmp.h (mpz_divexact): Delete parameter names. + (mpz_lcm): Delete spurious declaration. + + * mpz/dmincl.c: Fix typo. + +Mon Feb 5 01:11:56 1996 Torbjorn Granlund + + * mpn/generic/gcd.c (gcd_2): Declare consistently. + + * mpz/tdiv_q.c: Optimize division by a single-limb divisor. + * mpz/dmincl.c: Likewise. + + * mpz/add.c: Use MPN_NORMALIZE instead of mpn_normal_size. + * mpz/sub.c: Likewise. + * mpn/generic/sqrt.c: Likewise. + + * mpn/tests/{add_n,sub_n,lshift,rshift}.c: Put garbage in the + destination arrays. + +Fri Feb 2 02:21:27 1996 Torbjorn Granlund + + * mpz/{jacobi.c,legendre.c,ntsup.c,invert.c}: New files. + * mpz/Makefile.in: Compile them. + + * mpn/Makefile.in (INCLUDES): Don't search in `generic'. + +Thu Feb 1 02:15:11 1996 Torbjorn Granlund + + Change from Ken Weber: + * mpz/divexact.c: Make it work when quot is identical to either input. + + * mpf/ui_sub.c: New file. + * mpf/Makefile.in: Compile it. + + * gmp-impl.h (MPZ_TMP_INIT): alloca -> TMP_ALLOC. + * mpz/{c,f}div_{q,qr,r}.c: Use TMP_DECL/TMP_MARK/TMP_FREE since + these use MPZ_TMP_INIT. + * mpz/mod.c: Likewise. + * mpq/{add,sub}.c: Likewise. + * mpq/canonicalize: Likewise. + + * mpq/{add,sub,mul,div}.c: Use mpz_divexact. MP_INT -> mpz_t. + * mpq/canonicalize.c: Likewise. + +Wed Jan 31 01:45:00 1996 Torbjorn Granlund + + * mpn/generic/gcd.c: Misc changes from Ken. + + * mpz/tests/gcd2.c: New file. + * mpz/tests/Makefile.in: Handle gcd2.c. + + * mpn/generic/gcd.c (mpn_gcd): When GCD == ORIG_V, return vsize, + not orig_vsize. Fix parameter declaration. + + * mpz/mod_ui.c: Delete file. + * mpz/Makefile.in: Don't try to compile mod_ui. + + * mpz/cdiv_*_ui.c): Make them work right. + * gmp.h: Declare cdiv*. + +Tue Jan 30 02:22:56 1996 Torbjorn Granlund + + * mpz/{cdiv_q.c,cdiv_q_ui.c,cdiv_qr.c,cdiv_qr_ui.c,cdiv_r.c, + cdiv_r_ui.c,cdiv_ui.c}: New files. + * mpz/Makefile.in: Compile them. + + * All files: Make file permissions right. + + Changes from Ken Weber: + * mpn/generic/accelgcd.c: Delete. + * mpn/generic/bingcd.c: Delete. + * mpn/generic/numbits.c: Delete. + * mpn/generic/gcd.c: New file. + * mpn/configure.in (functions): Update accordingly. + * mpz/divexact.c: New file. + * mpz/Makefile.in: Compile divexact.c. + * mpz/gcd.c: Rewrite to accommodate for gcd changes in mpn. + * gmp.h: declare new functions, delete obsolete declarations. + * mpz/tests/dive.c: New file. + * mpz/tests/Makefile.in: Handle dive.c. + +Mon Jan 29 03:53:24 1996 Torbjorn Granlund + + * mpz/random.c: Handle negative SIZE parameter. + + * mpz/tests/tdiv(_ui).c: New name for tst-dm(_ui).c. + * mpz/tests/tst-mdm(_ui).c: Delete. + * mpz/tests/fdiv(_ui).c: New test based in tst-mdm(_ui). + * mpz/tests/*.c: Get rid of tst- prefix for DOS 8+3 naming. + * mpz/tests/Makefile.in: Corresponding changes. + * mpz/tests/configure.in: Update srctrigger. + + * mpn/generic/divmod.c: Update from divrem. + * mpn/generic/divrem.c: Misc cleanups. + +Sun Jan 28 03:25:08 1996 Torbjorn Granlund + + * All files: Use new TMP_ALLOC interface. + + * mpz/powm_ui.c: Make Jan 25 changes to powm.c also here. + + * mpz/tests/powm_ui.c: New file. + * mpz/tests/Makefile.in: Add rules for tst-powm and tst-powm_ui. + + * Makefile.in: Update dependency list. + * mpf/Makefile.in: Likewise. + * mpz/Makefile.in: Likewise. + * mpq/Makefile.in: Likewise. + * Makefile.in: Set RANLIB simply to ranlib, and allow configure + to override it. + + * mpz/Makefile.in (conf): Delete spurious target. + (mp_bases.c): Delete. + (cre-conv-tab rules): Delete. + + * Makefile.in (cre-conv-tab): Greatly simplify. + +Sat Jan 27 13:38:15 1996 Torbjorn Granlund + + * stack-alloc.c: New file. + * stack-alloc.h: New file. + + * gmp.h (__gmp_inline): Define using __inline__. + +Thu Jan 25 00:28:37 1996 Torbjorn Granlund + + * mpn/generic/scan0.c: New file. + * mpn/generic/scan1.c: Renamed from next_bit.c. + * mpn/configure.in (functions): Include scan0 and scan1. + + * mpn/m68k/*: #include sysdep.h. Use C_GLOBAL_NAME. + + * configure: Update from Cygnus version. + * config.guess: Likewise. + * config.sub: Likewise. + * configure: Pass --nfp to recursive configures. + + * mpz/tests/tst-*.c: Adjust SIZE and reps. + + * mpz/powm.c: Move esize==0 test earlier. + In final reduction of rp,rsize, don't call mpn_divmod unless + reduction is really needed. + + * mpz/tests/tst-powm.c: Fix thinko in checking code. + + * All files: Get rid of `__' prefix from mpn_* calls and declarations. + * gmp.h: #define __MPN. + * gmp.h: Use __MPN in #defines for mpn calls. + + * mpn/generic/mul_n.c: Prepend `i' to internal routines. + * gmp-impl.h: Add #defines using __MPN for those internal routines. + + * mpn/generic/sqrt.c: Change call to mpn_mul to mpn_mul_n. + +Wed Jan 24 13:28:19 1996 Torbjorn Granlund + + * mpn/sparc32/udiv_fp.S: New name for udiv_qrnnd.S. + * mpn/sparc32/udiv_nfp.S: New name for v8/udiv_qrnnd.S. + * mpn/sparc32/v8/supersparc: New directory. + * mpn/sparc32/v8/supersparc/udiv.S: New file. + +Tue Jan 23 01:10:11 1996 Torbjorn Granlund + + This major contribution is from Ken Weber: + * mpn/generic/accelgcd.c: New file. + * mpn/generic/bdivmod.c: New file. + * mpn/generic/bingcd.c: New file. + * mpn/generic/gcd_1.c: Rewrite. + * mpn/generic/numbits.c: New file (to go away soon). + * mpz/gcd.c: Rewrite. + * mpz/tests/tst-gcd.c (SIZE): Now 128. + * gmp.h: Declare new functions. + * mpn/configure.in (functions): List new files. + * gmp-impl.h (MPN_SWAP): Delete. + (MPN_LESS_BITS_LIMB, MPN_LESS_BITS, MPN_MORE_BITS): Delete. + (MPN_COMPL_INCR, MPN_COMPL): Delete. + +Mon Jan 22 02:04:59 1996 Torbjorn Granlund + + * gmp.h (mpn_name): New #define. + + * mpn/m88k/mc88110/addmul_1.s: New file. + * mpn/m88k/mc88110/add_n.S: New file. + * mpn/m88k/mc88110/sub_n.S: New file. + + * mpn/m88k/sub_n.s: Correctly initialize carry. + + * mpn/sparc32/{add_n.S,sub_n.S,lshift.S,rshift.S): `beq' => `be'. + +Sun Jan 21 00:04:35 1996 Torbjorn Granlund + + * mpn/sparc64/addmul_1.s: New file. + * mpn/sparc64/submul_1.s: New file. + * mpn/sparc64/rshift.s: New file. + +Sat Jan 20 00:32:54 1996 Torbjorn Granlund + + * mpz/iset.c: Fix typo introduced Dec 25. + +Wed Jan 17 13:16:44 1996 Torbjorn Granlund + + * config/mt-sprc8-gcc: New name for mt-sparc8-gcc. + * config/mt-sparcv8-gcc: Delete. + * configure.in: Corresponding changes. + +Tue Jan 16 16:31:01 1996 Torbjorn Granlund + + * gmp-impl.h: #include alloca.h when necessary. + + * longlong.h: Test __alpha instead of __alpha__, since the former + is the standard symbol. + +Mon Jan 15 18:06:57 1996 Torbjorn Granlund + + * mpn/sparc64/mul_1.s: Swap operands of mulx instructions. + * mpn/sparc64/lshift.s: New file. + +Fri Dec 29 17:34:03 1995 Torbjorn Granlund + + * mpn/x86/pentium/add_n.S: Get rid of #defines for register names. + * mpn/x86/pentium/sub_n.S: Likewise. + +Thu Dec 28 03:16:57 1995 Torbjorn Granlund + + * mpn/x86/pentium/mul_1.S: Rework loop to avoid AGI between update + of loop induction variable and load insn at beginning of loop. + * mpn/x86/pentium/addmul_1.S: Likewise. + * mpn/x86/pentium/submul_1.S: Likewise. + +Mon Dec 25 23:22:55 1995 Torbjorn Granlund + + * All files: Prefix user-visible structure fields with _mp_. + +Fri Dec 22 20:42:17 1995 Torbjorn Granlund + + * mpn/configure.in (m68k configs): Terminate path variable with + plain "m68k". + +Fri Dec 22 03:29:33 1995 Torbjorn Granlund + + * mpn/sparc32/add_n.S: Update from sub_n.S to fix bugs, and to + clean things up. + + * mpn/configure.in (m68k configs): Update #include path for new + mpn directory organization. + +Tue Dec 12 02:53:02 1995 Torbjorn Granlund + + * gmp.h: Prefix all structure field with _mp_. + * gmp-impl.h: Define access macros for these fields. + +Sun Dec 10 00:47:17 1995 Torbjorn Granlund + + * mpn/alpha/addmul_1.s: Prefix labels with `.'. + * mpn/alpha/submul_1.s: Likewise. + * mpn/alpha/[lr]shift.s: Likewise. + * mpn/alpha/udiv_qrnnd.S: Likewise. + * mpn/alpha/ev5/[lr]shift.s: Likewise. + + * mpn/alpha/ev5/lshift.s: Fix typos. + +Fri Dec 1 14:28:20 1995 Torbjorn Granlund + + * mpn/Makefile.in (.SUFFIXES): Define. + +Wed Nov 29 23:11:57 1995 Torbjorn Granlund + + * mpn/sparc64/{add_n.s, sub_n.s}: New files. + +Tue Nov 28 06:03:13 1995 Torbjorn Granlund + + * mpn/x86/syntax.h: Handle ELF_SYNTAX. + Rename GAS_SYNTAX => BSD_SYNTAX. + + * mpn/configure.in: Handle linuxelf and SysV for x86 variants. + +Mon Nov 27 01:32:12 1995 Torbjorn Granlund + + * mpn/hppa/hppa1_1/pa7100/submul_1.S: New file. + +Sun Nov 26 04:30:47 1995 Torbjorn Granlund + + * mpn/hppa/hppa1_1/pa7100/addmul_1.S: New file. + + * mpn/sparc32/add_n.S: Rewrite to use 64 bit loads/stores. + * mpn/sparc32/sub_n.S: Likewise. + +Fri Nov 17 00:18:46 1995 Torbjorn Granlund + + * mpn/configure.in: Handle m68k on NextStep. + +Thu Nov 16 02:30:26 1995 Torbjorn Granlund + + * mpn: Reorganize machine-specific directories. + * mpn/configure.in: Corresponding changes. + (sh, sh2): Handle these. + (m68k targets): Create asm-syntax.h. + +Thu Nov 9 02:20:50 1995 Torbjorn Granlund + + * mpn/generic/mul_n.c (____mpn_sqr_n): Delete code that calls abort. + (____mpn_mul_n): Likewise. + +Tue Nov 7 03:25:12 1995 Torbjorn Granlund + + * mpf/get_str.c: In exponentiation code (two places), don't swap + input and output areas when calling mpn_mul_1. + * mpf/set_str.c: Likewise. + +Fri Nov 3 02:35:58 1995 Torbjorn Granlund + + * mpf/Makefile.in: Make sure all objects are listed in dependency list; + delete spurious entries. + + * mpf/mul.c: Handle U or V being 0. Allow prec+1 for result precision. + + * mpf/set_prec.c: New computation of limb precision. + * mpf/set_dfl_prec.c: Likewise. + + * mpf/random2.c: Fix typo computing exp. + * mpf/get_str.c: In (uexp > usize) case, set n_limbs as a function of + the user-requested number of digits, n_digits. + +Thu Nov 2 16:25:07 1995 Torbjorn Granlund + + * mpn/generic/divrem.c (case 2): Don't move np vector back, it is + never read. + (default case): Put most significant limb from np in new variable n2; + decrease size argument for MPN_COPY_DECR; use n2 instead of np[dsize]. + +Wed Nov 1 02:59:53 1995 Torbjorn Granlund + + * mpn/sparc/[lr]shift.S: New files. + +Tue Oct 31 00:08:12 1995 Torbjorn Granlund + + * mpz/gcd_ui.c: Set w->size unconditionally when v is zero. + + * gmp-impl.h (assert): Delete definition. + + * mpf/sub.c: Delete all assert calls. Delete variable `cy'. + + * mpf/neg.c: Use prec+1 as precision. Optimize for when arguments + are the same. + * mpf/abs.c: Likewise. + * mpf/{set,neg,abs}.c: Make structure and variable names similar. + +Mon Oct 30 12:45:26 1995 Torbjorn Granlund + + * mpf/random2.c (random): Test __SVR4 in addition to __svr4__. + * mpn/generic/random2.c (random): Likewise. + +Sun Oct 29 01:54:28 1995 Torbjorn Granlund + + * mpf/div.c: Special handle U or V being 0. + + * mpf/random2.c: New file. + + * longlong.h (i860 rshift_rhlc): Define. + (i960 udiv_qrnnd): Define. + (i960 count_leading_zeros): Define. + (i960 add_ssaaaa): Define. + (i960 sub_ddmmss): Define. + (i960 rshift_rhlc): Define. + +Sat Oct 28 19:09:15 1995 Torbjorn Granlund + + * mpn/pentium/rshift.S: Fix and generalize condition for when to use + special code for shift by 1. + * mpn/pentium/lshift.S: Likewise. + +Thu Oct 26 00:02:56 1995 Torbjorn Granlund + + * gmp.h: #undef __need_size_t. + * mp.h: Update from gmp.h. + +Wed Oct 25 00:17:27 1995 Torbjorn Granlund + + * mpf/Makefile.in: Compile set_prec.c. + * mpf/realloc.c: Delete this file. + * mpf/Makefile.in: Delete mentions of realloc.c. + + * gmp.h (__mpf_struct): Get rid of `alloc' field. + * mpf/clear.c: Likewise. + * mpf/init*.c: Likewise. + * mpf/set_prec.c: Likewise. + * mpf/iset*.c: Likewise. + + * mpf/iset_str.c: New file. + + * mpn/configure.in: Handle pyramid. + + * mpf/set.c: Use prec+1 as precision. + + * mpf/set_prec.c: New file. + +Tue Oct 24 00:56:41 1995 Torbjorn Granlund + + * mpn/generic/divrem.c: New file. Will replace mpn/generic/divmod.c + when rest of source is converted. + * mpn/configure.in (functions): Add `divrem' + * mpn/generic/set_str.c: Never call __mpn_mul_1 with zero size. + + * mpf/get_str.c: Completely rewritten. + * mpf/add.c: Fix several problems. + * mpf/sub.c: Compare operands from most significant end until + first difference, exclude skipped limbs from computation. + Accordingly simplify normalization code. + * mpf/set_str.c: Fix several problems. + * mpf/dump.c: New file. + * mpf/Makefile.in: Compile dump.c. + * mpf/init2.c: Set prec field correctly. + +Sun Oct 22 03:02:09 1995 Torbjorn Granlund + + * cre-conv-tab.c: #include math.h; don't declare log and floor. + +Sat Oct 21 23:04:10 1995 Torbjorn Granlund + + * mpf/mul_ui.c: Handle U being 0. + +Wed Oct 18 19:39:27 1995 Torbjorn Granlund + + * mpn/generic/set_str.c: Correctly handle input like "000000000000". + Misc cleanups. + +Tue Oct 17 15:14:13 1995 Torbjorn Granlund + + * longlong.h: Define COUNT_LEADING_ZEROS_0 for machines where + appropriate. + +Mon Oct 16 19:14:43 1995 Torbjorn Granlund + + * mpf/add.c: Rewrite. + * mpf/set_str.c: New file. Needs more work. + +Sat Oct 14 00:14:04 1995 Torbjorn Granlund + + * mpf/div_2exp.c: Vastly simplify. + * mpf/mul_2exp.c: Likewise. + + * mpf/sub.c: Rewrite. + + * gmp-impl.h (udiv_qrnnd_preinv2gen): Terminate comment. + + * mpf/dump.c: Free allocated memory. + + * gmp-impl.h (assert): Define. + +Wed Oct 11 13:31:00 1995 Torbjorn Granlund + + * mpn/pentium/rshift.S: Install new code to optimize shift-by-1. + +Tue Oct 10 00:37:21 1995 Torbjorn Granlund + + * mpn/pentium/lshift.S: Install new code to optimize shift-by-1. + + * mpn/powerpc32/{lshift.s,rshift.s}: New files. + + * configure.in: Fix typo. + +Sat Oct 7 08:17:09 1995 Torbjorn Granlund + + * longlong.h (smul_ppmm): Correct type of __m0 and __m1. + +Wed Oct 4 16:31:28 1995 Torbjorn Granlund + + * mpn/configure.in: Handle alphaev5. + * mpn/ev4: New name for alpha subdir. + * mpn/ev5: New subdir. + * mpn/ev5/lshift.s: New file. + +Tue Oct 3 15:06:45 1995 Torbjorn Granlund + + * mpn/alpha/mul_1.s: Avoid static increments of pointers; use + corresponding offsets in ldq and stq instructions instead. + (Loop): Swap cmpult and stq to save one cycle on EV5. + + * mpn/tests/{add_n.s,sub_n.s,lshift.s,rshift.s,mul_1.s,addmul_1.s, + submul_1.s}: Don't check results if NOCHECK is defined. + +Mon Oct 2 11:40:18 1995 Torbjorn Granlund + + * longlong.h (mips umul_ppmm [32 and 64 bit versions]): + Make new variants, based on GCC version number, that use `l' and `h' + constraints instead of explicit mflo and mfhi instructions + +Sun Oct 1 00:17:47 1995 Torbjorn Granlund + + * mpn/mc88100/add_n.s: Decrease unrolling factor from 16 to 8. + * mpn/mc88100/sub_n.s: Likewise. + + * config/mt-m88110: New file. + * configure.in: Use it. + + * mpn/mc88110/mul_1.s: Fix thinko. + +Sat Sep 30 21:28:19 1995 Torbjorn Granlund + + * mpz/set_d.c: Declare `size' at function start. + + * experimental: New directory for mpx and mpz2. + + * mpz/tdiv_q.c: Clarify comments. + * mpz/{mod.c,mod_ui.c}: New file, for math mod function. + + * mpn/sh2/{mul_1.s,addmul_1.s,submul_1.s}: New files. + + * mpn/sh/{add_n.s,sub_n.s}: New files. + + * mpn/pyr/{add_n.s,sub_n.s,mul_1.s,addmul_1.s}: New files. + + * mpn/i960/{add_n.s,sub_n.s}: New files. + + * mpn/alpha/addmul_1.s (Loop): Move decrement of r18 to before umulh, + to save cycles on EV5. + * mpn/alpha/submul_1.s: Ditto. + * mpn/alpha/mul_1.s: Ditto. + +Thu Sep 28 02:48:59 1995 Torbjorn Granlund + + * gmp.h (mp_limb, mp_limb_signed): Define as `long long' if + _LONG_LONG_LIMB is defined. + + * longlong.h (m88110): Test __m88110__, not __mc88110__ + + * mpn/mc88110/mul_1.s: Rewrite. + +Tue Sep 26 23:29:05 1995 Torbjorn Granlund + + * config.sub: Update from current Cygnus version. + + * mpn/configure.in: Recognize canonical m88*, not mc88*. + +Fri Sep 22 14:58:05 1995 Torbjorn Granlund + + * mpz/set_d.c: New file. + * mpz/Makefile.in: Build new files. + + * mpq/get_d.c: Replace usage of scalbn with ldexp. + + * mpn/{vax,i386}/gmp-mparam.h: New files. + * gmp-impl.h (ieee_double_extract): Define here. + * mpf/set_d.c (ieee_double_extract): Not here. + +Thu Sep 21 00:56:36 1995 Torbjorn Granlund + + * longlong.h (C umul_ppmm): Use UWtype, not USItype for temps. + (udiv_qrnnd): For cases implemented with call to __udiv_qrnnd, + protect with new symbol LONGLONG_STANDALONE. + (68000 umul_ppmm): Use %# prefix for immediate constants. + +Wed Sep 20 15:36:23 1995 Torbjorn Granlund + + * mpn/generic/divmod_1.c: Handle + divisor_limb == 1 << (BITS_PER_MP_LIMB - 1) + specifically also when normalization_steps != 0. + +Mon Sep 18 15:42:30 1995 Torbjorn Granlund + + * mpq/get_d.c: New file. + +Sun Sep 17 02:04:36 1995 Torbjorn Granlund + + * longlong.h (pyr): Botch up for now. + +Sat Sep 16 00:11:50 1995 Torbjorn Granlund + + * mpn/clipper/mul_1.s: New file. + * mpn/clipper/add_n.s: New file. + * mpn/clipper/sub_n.s: New file. + * mpn/configure.in: Handle clipper*-*-*. + + * mpn/configure.in: Recognize rs6000-*-*. + +Fri Sep 15 00:41:34 1995 Torbjorn Granlund + + * mpn/alpha/add_n.s: New file. + * mpn/alpha/sub_n.s: New file. + + * mpn/mips3: New name for mpn/r4000. + * mpn/mips2: New name for mpn/r3000. + * mpn/configure.in: Corresponding changes. + + * mpn/generic/perfsqr.c (primes): Delete. + (residue_map): Delete. + +Thu Sep 14 00:07:58 1995 Torbjorn Granlund + + * mpn/r3000/sub_n.s: Fix typo. + + * dm_trunc.c: Delete spurious file. + + * mpz/out_binary.c: Fix typo. + + * mpn/configure.in (per-target): Make mips*-*-irix6* imply r4000. + + * gmp-impl.h: For sparc and sgi, include alloca.h. + + * mpn/z8000/mul_1.s: Replace `test r' with `and r,r'. Replace + `ldk r,#0' with `xor r,r'. + +Wed Sep 6 00:58:38 1995 Torbjorn Granlund + + * mpz/inp_binary.c: New file. + * mpz/out_binary.c: New file. + * mpz/Makefile.in: Build new files. + +Tue Sep 5 22:53:51 1995 Torbjorn Granlund + + * gmp.h (__mpz_struct): Change `long int' => `mp_size_t' for alloc + and size fields. + +Sat Sep 2 17:47:59 1995 Torbjorn Granlund + + * mpn/r4000/{add_n.s,sub_n.s}: Optimize away some pointer arithmetic. + * mpn/r3000/{add_n.s,sub_n.s,lshift.s,rshift.s}: New files, + derived from r4000 code. + +Fri Sep 1 05:35:52 1995 Torbjorn Granlund + + * mpn/r3000/mul_1.s: Fix typo. + + * mpn/powerpc32: Fix some old vs new mnemonic issues. + + * mpn/powerpc32/{add_n.s,sub_n.s}: New files. + * mpn/r4000/{add_n.s,sub_n.s,lshift.s,rshift.s}: New files. + +Wed Aug 30 10:43:47 1995 Torbjorn Granlund + + * mpn/r3000/mul_1.s ($LC1): Use addiu for immediate add. + * mpn/r4000/{mul_1.s,addmul_1.s,submul_1.s}: New files. + + * config.guess: Update to latest FSF revision. + +Mon Aug 28 02:18:13 1995 Torbjorn Granlund + + * mpz/out_str.c: Cast str to char * in fputs call. + + * gmp-impl.h: Define UQItype, SItype, and USItype also + when not __GNUC__. + +Fri Aug 25 01:45:04 1995 Torbjorn Granlund + + * mpn/i386/syntax.h: Renamed from asm-syntax.h. + * mpn/mc68020/syntax.h: Renamed from asm-syntax.h. + * mpn/configure.in: Corresponding changes. + +Sun Aug 13 19:20:04 1995 Torbjorn Granlund + + * mpn/generic/random2.c: Test __hpux, not hpux. + +Sat Apr 15 20:50:33 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/sparc/add_n.S: Make it work for PIC. + * mpn/sparc/sub_n.s: Likewise. + * mpn/sparc8/addmul_1.S: Likewise. + * mpn/sparc8/mul_1.S: Likewise. + * mpn/i386/add_n.S: Likewise. + * mpn/i386/sub_n.S: Likewise. + +Thu Apr 13 23:15:03 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/configure.in: Don't search power subdir for generic ppc configs. + Add some ppc cpu-specific configs. Misc clean up. + +Mon Apr 10 00:16:35 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpz/ui_pow_ui.c: Delete spurious code to handle negative results. + +Sun Apr 9 12:38:11 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * longlong.h (SPARC v8 udiv_qrnnd): Generate remainder in C, + not in asm. + + * mpn/generic/sqrt.c (SQRT): Test for __SOFT_FLOAT. + +Tue Mar 28 00:19:52 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/generic/hamdist.c (popc_limb): Make Mar 16 change here too. + +Fri Mar 17 23:29:22 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * longlong.h (SH umul_ppmm): Define. + +Thu Mar 16 16:40:44 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/generic/popcount.c (popc_limb): Rearrange 32 bit case + to help CSE. + +Fri Mar 10 20:03:49 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/powerpc32/mul_1.s: Clear cy before entering loop. + Rearrange loop to save a cycle. + * mpn/powerpc32/addmul_1.s: New file. + * mpn/powerpc32/submul_1.s: New file. + +Fri Feb 17 22:44:45 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/configure.in: Set target_makefile_frag for freebsd + in new case stmt. + * mpn/config/t-freebsd: New file. + * mpn/Makefile.in: Add #### for frag insertion. + (XCFLAGS): Clear by default. + (.c.o, .S.o rules): Pass XCFLAGS. + +Tue Feb 7 16:27:50 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * longlong.h (68000 umul_ppmm): Merge improvements from henderson. + +Tue Jan 24 04:23:20 1995 Torbjorn Granlund (tege@tiny.cygnus.com) + + * longlong.h (default umul_ppmm): Store input parameters in temporaries + to avoid reading them twice. + (default smul_ppmm): New definition. + +Thu Dec 29 04:20:07 1994 Jim Meyering (meyering@comco.com) + + * generic/perfsqr.c (__mpn_perfect_square_p): Remove declaration + of unused variable. + * generic/pre_mod_1.c (__mpn_preinv_mod_1): Likewise. + * mpz/powm.c (pow): Likewise. + + * mpz/and.c (mpz_and): Use {} instead of `;' for empty else clause + to placate `gcc -Wall'. + * mpz/ior.c (mpz_ior): Likewise. + +Wed Dec 28 13:31:40 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/m*68*/*.S: #include asm-syntax.h, not asm.h. + +Mon Dec 26 17:15:36 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * longlong.h: Test for more symbols, in __mc68000__ case. + + * mpn/mpn/config.sub: Recognize m68060. + * mpn/configure.in: Change mc* to m* for 68k targets. + * mpn/Makefile.in (.S.o): Delete spurious creation of temp .c file. + +Mon Dec 19 01:56:30 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * config.sub: Recognize pentium as a valid CPU. + * mpn/configure.in: Handle pentium specifically, to use new assembly + code. + +Mon Dec 19 00:13:01 1994 Jim Meyering (meyering@comco.com) + + * gmp.h: Define _GMP_H_HAVE_FILE if FILE, __STDIO_H__, or H_STDIO + is defined. + * gmp.h: test _GMP_H_HAVE_FILE instead of FILE everywhere else. + +Mon Dec 19 00:04:54 1994 Kent Boortz (boortz@sics.se) + + * Makefile.in (recursive makes): Pass CFLAGS. + +Sun Dec 18 22:34:49 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/pentium: New directory. + + * mpz/pprime.c: Make sure to mpz_clear all temporaries. + + * longlong.h: Don't use udiv instruction when SUPERSPARC is defined. + * configure.in: Handle supersparc*-. + * config/mt-supspc-gcc: New file. + * config/mt-sparc8-gcc: New name for mt-sparcv8-gcc. + +Mon Dec 12 22:22:10 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/i386/*.S: #include "asm-syntax.h", not "asm.h". + #include sysdep.h before asm-syntax.h. + + * mpn/mc68020/asm-syntax.h: #undef ALIGN before defining it. + * mpn/i386/asm-syntax.h: Likewise. + + * mpn/mc68020/asm-syntax.h: New name for asm.h. + * mpn/i386/asm-syntax.h: New name for asm.h. + +Tue Dec 6 21:55:25 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpz/array_init.c: Fix typo in declaration. + +Fri Nov 18 19:50:52 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/Makefile.in (.S.o): Pass CFLAGS and INCLUDES. + +Mon Nov 14 00:34:12 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/generic/random2.c (random): Test for __svr4__. + +Wed Oct 12 23:28:16 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * cre-conv-tab.c (main): Avoid upper-case X in printf format string. + +Tue Aug 23 17:16:35 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpz/perfsqr.c: Use mpn_perfect_square_p. + * mpn/generic/perfsqr.c: New file. + +Wed Jul 6 13:46:51 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpz/array_init.c: New file. + * mpz/Makefile.in: Compile array_init. + * gmp.h: Declare mpz_array_init. + +Mon Jul 4 01:10:03 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpz/add.c: Fix bogus comment. + * mpz/sub.c: Likewise. + +Sat Jul 2 02:14:56 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpn/generic/pre_mod_1.c: New file. + * mpz/perfsqr.c: Use __mpn_preinv_mod_1 when faster. + +Fri Jul 01 22:10:19 1994 Richard Earnshaw (rwe11@cl.cam.ac.uk) + + * longlong.h (arm umul_ppmm): Fix typos in last change. Mark + hard-coded registers with "%|" + +Thu Jun 30 03:59:33 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpz/perfsqr.c: Define PP, etc, for machines with 64 bit limbs. + Use __mpn_mod_1. + * mpz/perfsqr.c: Don't clobber REM in quadratic residue check loop. + +Wed Jun 29 18:45:41 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpn/generic/sqrt.c (SQRT): New asm for IBM POWER2. + + * mpz/gcd_ui.c: Return 0 if result does not fit an unsigned long. + + * gmp.h: Use "defined (__STDC__)" consistently. + +Tue Jun 28 18:44:58 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * gmp.h (mpz_get_si): Don't use "signed" keyword for return type. + + * mpz/tests/Makefile.in: Use CFLAGS for linking. + + * Makefile.in (CFLAGS): Use -O2 here. + * mpn/Makefile (CFLAGS): Not here. + + * mpq/cmp_ui.c: Fix typo. + * mpq/canonicalize.c: Fix typo. + * mpz/gcd_ui.c: Handle gcd(0,v) and gcd(u,0) correctly. + * mpn/generic/gcd_1.c: Fix braino in last change. + +Mon Jun 27 16:10:27 1994 Torbjorn Granlund (tege@rtl.cygnus.com) + + * mpz/gcd_ui.c: Change return type and return result. + Allow destination param to be NULL. + * gmp.h: Corresponding change. + * mpn/generic/gcd_1.c: Handle zero return from mpn_mod_1. + +Tue Jun 14 02:17:43 1994 Torbjorn Granlund (tege@tiny.cygnus.com) + + * mpn/i386/asm.h (ALIGN): Make it take a parameter. + * mpn/i386/*.S: Use ALIGN to align all loops. + + * mpn/i386/*.S: Move colon inside C_GLOBAL_NAME expression. + (Makes old versions of GAS happy.) + +Sat May 28 01:43:54 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * Many files: Delete unused variables and labels. + * mpn/generic/dump.c: cast printf width argument to int. + +Wed May 25 00:42:37 1994 Torbjorn Granlund (tege@thepub.cygnus.com) + + * mpz/gcd.c (mpz_gcd): Normalize after __mpn_sub calls. + (xmod): Ignore return value of __mpn_divmod. + (xmod): Improve normalization code. + +Sat May 21 01:30:09 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpz/gcdext.c: Cosmetic changes. + + * mpz/fdiv_ui.c: New file. + +Fri May 20 00:24:53 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpz/tests/Makefile.in: Use explicit rules for running tests, + not a shell loop. + (clean): Delete stmp-*. + + * mpz/Makefile.in: Update. + + * mpz/div_ui.c: Don't include longlong.h. + * mpz/dm_ui.c: Likewise. + + * mpz/fdiv_q.c, mpz/fdiv_q_ui.c, mpz/fdiv_qr.c, mpz/fdiv_qr_ui.c, + mpz/fdiv_r.c, mpz/fdiv_r_ui.c: New files. Code partly from deleted + mdm.c, mdm_ui.c, etc, partly rewritten. + * mpz/dm_floor_ui.c, mpz/dm_floor.c: Delete. + * mpz/mdm.c, mpz/mdm_ui.c, mpz/mdiv.c, mpz/mdiv_ui.c, mpz/mmod.c, + mpz/mmod_ui.c: Delete. + + * mpz/tdiv_q.c, mpz/tdiv_q_ui.c, mpz/tdiv_qr.c, mpz/tdiv_qr_ui.c, + mpz/tdiv_r.c, mpz/tdiv_r_ui.c: + New names for files implementing truncating division. + * mpz/div_ui.c, mpz/dm_ui.c, mpz/mod_ui.c: Simplify. + + * mpn/Makefile.in (.S.o): Don't rely on CPP being defined, use CC + instead. + (clean): Delete tmp-*. + +Thu May 19 01:37:44 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpz/cmp.c: Call __mpn_cmp. + + * mpz/popcount.c: Fix typo. + + * mpz/powm_ui.c: Simplify main loop. Keep principal operand size + smaller than MSIZE when possible. + * mpz/powm.c: Likewise. + + * mpn/generic/sqrt.c: Move alloca calls into where the memory is + needed. Simplify. + + * gmp.h: (_PROTO): New macro. + Add many function declarations; use _PROTO macro in all declarations. + + * mpf/*.c: Prepend mpn calls with __. + +Wed May 18 20:57:06 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpf/*ui*.c: Make ui argument `long' for consistency with mpz + functions. + + * mpf/div_ui.c: Simplify. + +Tue May 17 01:05:14 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpz/*.c: Prepend mpn calls with __. + + * mpz/mul_ui.c: Use mpn_mul_1. + +Mon May 16 17:19:41 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpn/i386/mul_1.S: Use C_GLOBAL_NAME. + * mpn/i386/mul_1.S, mpn/i386/addmul_1.S, mpn/i386/submul_1.S: + Nuke use of LAB. + +Sat May 14 14:21:02 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * gmp-impl.h: Don't define abort here. + + * mpz/pow_ui.c: Increase temporary allocation. + * mpz/ui_pow_ui.c: Likewise. + + * gmp.h (mpz_add_1, mpz_sub_1): Don't call memcpy. + + * All Makefile.in: Delete spurious -I arguments. + Update dependencies. + + * mpz/popcount.c: New file. + * mpz/hamdist.c: New file. + + * All configure: Latest version from Cygnus. + + * mpq/Makefile.in: New file. + * mpq/configure.in: New file. + * Makefile.in, configure.in: Enable compilation of mpq. + + * mpq/set_z.c: Fix typos. + * mpq/canonicalize.c: Fix typos. + * mpq/cmp_ui.c: Fix typos. + + * mpf/add_ui.c: Read U->D into UP always. Delete spurious MPN_COPY. + * mpf/sub_ui.c: Likewise. + + * gmp-impl.h: Don't redefine alloca. + + * COPYING.LIB: Renamed from COPYING. + +Wed May 11 01:45:44 1994 Torbjorn Granlund (tege@adder.cygnus.com) + + * mpz/powm_ui.c: When shifting E left by C+1, handle out-of-range + shift counts. Fix typo when testing negative_result. + * mpz/powm.c: Likewise. + + * mpz/ui_pow_ui.c: New file. + * mpz/Makefile.in: Update. + + * mpz/pow_ui.c: Call __mpn_mul_n instead of __mpn_mul when possible. + + * mpz/div.c, mpz/div_ui.c, mpz/gcd.c: Prefix external mpn calls. + * mpz/gcd.c: Declare mpn_xmod. + + * mpz/powm.c: Major changes to accommodate changed mpn semantics. + * mpz/powm_ui.c: Update from mpz/powm.c. + + * mpz/tests/tst-io.c: New file. + * mpz/tests/tst-logic: New file. + * mpz/tests/Makefile.in: Update. + + * mpz/inp_str.c: Get base right when checking for first digit. + * mpz/inp_str.c: Allocate more space for DEST when needed. + + * mpz/com.c: Use mpn_add_1 and mpn_sub_1. + * mpz/and.c, mpz/ior.c: Likewise. Simplify somewhat. + + * mpz/add_ui.c: Use mpn_add_1 and mpn_sub_1. + Rename parameters to be consistent with mpz/sub_ui. + General simplifications. + * mpz/sub_ui.x: Likewise. + +Tue Aug 10 19:41:16 1993 Torbjorn Granlund (tege@prudens.matematik.su.se) + + * mpf: New directory. + * mpf/*.c: Merge basic set of mpf functions. + + * Many logs missing... + +Sun Apr 25 18:40:26 1993 Torbjorn Granlund (tege@pde.nada.kth.se) + + * memory.c: Use #if instead of #ifdef for __STDC__ for consistency. + * bsd/xtom.c: Likewise. + + * mpz/div.c: Remove free_me and free_me_size and their usage. + Use mpn_divmod for division; corresponding changes in return value + convention. + * mpz/powm.c: `carry_digit' => `carry_limb'. + * bsd/sdiv.c: Clarify comment. + +Sun Apr 25 00:31:28 1993 Torbjorn Granlund (tege@pde.nada.kth.se) + + * longlong.h (__udiv_qrnnd_c): Make all variables `unsigned long int'. + +Sat Apr 24 16:23:33 1993 Torbjorn Granlund (tege@pde.nada.kth.se) + + * longlong.h (__udiv_qrnnd_c): Make all variables `unsigned long int'. + + * gmp-impl.h: #define ABS. + * (Many files): Use ABS instead of abs. + + * mpn/generic/sqrt.c, mpz/clrbit.c, mpz/get_si.c, mpz/mod_2exp.c, + mpz/pow_ui.c: Cast 1 to mp_limb before shifting. + + * mpz/perfsqr.c: Use #if, not plain if for exclusion of code for + non-32-bit machines. + +Tue Apr 20 13:13:58 1993 Torbjorn Granlund (tege@du.nada.kth.se) + + * mpn/generic/sqrt.c: Handle overflow for intermediate quotients by + rounding them down to fit. + + * mpz/perfsqr.c (PP): Define in hexadecimal to avoid GCC warnings. + + * mpz/inp_str.c (char_ok_for_base): New function. + (mpz_inp_str): Use it. + +Sun Mar 28 21:54:06 1993 Torbjorn Granlund (tege@cyklop.nada.kth.se) + + * mpz/inp_raw.c: Allocate x_index, not xsize limbs. + +Mon Mar 15 11:44:06 1993 Torbjorn Granlund (tege@pde.nada.kth.se) + + * mpz/pprime.c: Declare param `const'. + * gmp.h: Add declarations for mpz_com. + +Thu Feb 18 14:10:34 1993 Torbjorn Granlund (tege@pde.nada.kth.se) + + * mpq/add.c, mpq/sub.c: Call mpz_clear for t. + +Fri Feb 12 20:27:34 1993 Torbjorn Granlund (tege@cyklop.nada.kth.se) + + * mpz/inp_str.c: Recog minus sign as first character. + +Wed Feb 3 01:36:02 1993 Torbjorn Granlund (tege@cyklop.nada.kth.se) + + * mpz/iset.c: Handle 0 size. + +Tue Feb 2 13:03:33 1993 Torbjorn Granlund (tege@cyklop.nada.kth.se) + + * mpz/mod_ui.c: Initialize dividend_size before it's used. + +Mon Jan 4 09:11:15 1993 Torbjorn Granlund (tege@sics.se) + + * bsd/itom.c: Declare param explicitly 'signed'. + * bsd/sdiv.c: Likewise. + + * mpq/cmp.c: Remove unused variable tmp_size. + * mpz/powm_ui.c: Fix typo in esize==0 if stmt. + * mpz/powm.c: Likewise. + +Sun Nov 29 01:16:11 1992 Torbjorn Granlund (tege@sics.se) + + * mpn/generic/divmod_1.c (mpn_divmod_1): Handle + divisor_limb == 1 << (BITS_PER_MP_LIMB - 1) + specifically. + + * Reorganize sources. New directories mpn, mpn/MACH, mpn/generic, + mpz, mpq, bsd. Use full file name for change logs hereafter. + +Wed Oct 28 17:40:04 1992 Torbjorn Granlund (tege@jupiter.sics.se) + + * longlong.h (__hppa umul_ppmm): Fix typos. + (__hppa sub_ddmmss): Swap input arguments. + + * mpz_perfsqr.c (mpz_perfect_square_p): Avoid , before } in + initializator. + +Sun Oct 25 20:30:06 1992 Torbjorn Granlund (tege@jupiter.sics.se) + + * mpz_pprime.c (mpz_probab_prime_p): Handle numbers <= 3 + specifically (used to consider all negative numbers prime). + + * mpz_powm_ui: `carry_digit' => `carry_limb'. + + * sdiv: Handle zero dividend specifically. Replace most code in + this function with a call to mpn_divmod_1. + +Fri Sep 11 22:15:55 1992 Torbjorn Granlund (tege@tarrega.sics.se) + + * mpq_clear: Don't free the MP_RAT! + + * mpn_lshift, mpn_rshift, mpn_rshiftci: Remove `long' from 4:th arg. + +Thu Sep 3 01:47:07 1992 Torbjorn Granlund (tege@jupiter.sics.se) + + * All files: Remove leading _ from mpn function names. + +Wed Sep 2 22:21:16 1992 Torbjorn Granlund (tege@jupiter.sics.se) + + Fix from Jan-Hein Buhrman: + * mpz_mdiv.c, mpz_mmod.c, mpz_mdm.c: Make them work as documented. + + * mpz_mmod.c, mpz_mdm.c: Move decl of TEMP_DIVISOR to reflect its + life. + +Sun Aug 30 18:37:15 1992 Torbjorn Granlund (tege@jupiter.sics.se) + + * _mpz_get_str: Use mpz_sizeinbase for computing out_len. + * _mpz_get_str: Don't remove leading zeros. Abort if there are some. + +Wed Mar 4 17:56:56 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * gmp.h: Change definition of MP_INT to make the & before params + optional. Use typedef to define it. + * mp.h: Use typedef to define MINT. + +Tue Feb 18 14:38:39 1992 Torbjorn Granlund (tege@zevs.sics.se) + + longlong.h (hppa umul_ppmm): Add missing semicolon. Declare type + of __w1 and __w0. + +Fri Feb 14 21:33:21 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Make default count_leading_zeros work for machines > + 32 bits. Prepend `__' before local variables to avoid conflicts + with users' variables. + + * mpn_dm_1.c: Remove udiv_qrnnd_preinv ... + * gmp-impl.h: ... and put it here. + * mpn_mod_1: Use udiv_qrnnd_preinv if it is faster than udiv_qrnnd. + +Tue Feb 11 17:20:12 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_mul: Enhance base case by handling small multiplicands. + * mpn_dm_1.c: Revert last change. + +Mon Feb 10 11:55:15 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_dm_1.c: Don't define udiv_qrnnd_preinv unless needed. + +Fri Feb 7 16:26:16 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_mul: Replace code for base case. + +Thu Feb 6 15:10:42 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_dm_1.c (_mpn_divmod_1): Add code for avoiding division by + pre-inverting divisor. + +Sun Feb 2 11:10:25 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Make __LLDEBUG__ work differently. + (_IBMR2): Reinsert old code. + +Sat Feb 1 16:43:00 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h (#ifdef _IBMR2): Replace udiv_qrnnd with new code + using floating point operations. Don't define + UDIV_NEEDS_NORMALIZATION any longer. + +Fri Jan 31 15:09:13 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Define UMUL_TIME and UDIV_TIME for most machines. + * longlong.h (#ifdef __hppa): Define umul_ppmm. + +Wed Jan 29 16:41:36 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_cmp: Only one length parameter, assume operand lengths are + the same. Don't require normalization. + * mpq_cmp, mpz_add, mpz_sub, mpz_gcd, mpn_mul, mpn_sqrt: Change for + new mpn_cmp definition. + +Tue Jan 28 11:18:55 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * _mpz_get_str: Fix typo in comment. + +Mon Jan 27 09:44:16 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * Makefile.in: Add new files. + + * mpn_dm_1.c: New file with function _mpn_divmod_1. + * mpz_dm_ui.c (mpz_divmod_ui): Use _mpn_divmod_1. + * mpz_div_ui: Likewise. + + * mpn_mod_1.c: New file with function _mpn_mod_1. + * mpz_mod_ui: Use _mpn_mod_1. + +Thu Jan 23 18:54:09 1992 Torbjorn Granlund (tege@zevs.sics.se) + + Bug found by Paul Zimmermann (zimmermann@inria.inria.fr): + * mpz_div_ui.c (mpz_div_ui), mpz_dm_ui.c (mpz_divmod_ui): + Handle dividend == 0. + +Wed Jan 22 12:02:26 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_pprime.c: Use "" for #include. + +Sun Jan 19 13:36:55 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_rshiftci.c (header): Correct comment. + +Wed Jan 15 18:56:04 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_powm, mpz_powm_ui (if (bsize > msize)): Do alloca (bsize + 1) + to make space for ignored quotient at the end. (The quotient might + always be an extra limb.) + +Tue Jan 14 21:28:48 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_powm_ui: Fix comment. + * mpz_powm: Likewise. + +Mon Jan 13 18:16:25 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * tests/Makefile.in: Prepend $(TEST_PREFIX) to Makefile target. + +Sun Jan 12 13:54:28 1992 Torbjorn Granlund (tege@zevs.sics.se) + + Fixes from Kazumaro Aoki: + * mpz_out_raw: Take abs of size to handle negative values. + * mpz_inp_raw: Reallocate before reading ptr from X. + * mpz_inp_raw: Store, don't read, size to x->size. + +Tue Jan 7 17:50:25 1992 Torbjorn Granlund (tege@zevs.sics.se) + + * gmp.h, mp.h: Remove parameter names from prototypes. + +Sun Dec 15 00:09:36 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * tests/Makefile.in: Prepend "./" to file names when executing + tests. + + * Makefile.in: Fix many problems. + +Sat Dec 14 01:00:02 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_sqrt.c: New file with _mpn_sqrt. + * mpz_sqrt, mpz_sqrtrem, mpz_perfect_square_p: Use _mpn_sqrt. + * msqrt.c: Delete. Create from mpz_sqrtrem.c in Makefile.in. + * mpz_do_sqrt.c: Delete. + * Makefile.in: Update to reflect these changes. + + * Makefile.in, configure, configure.subr: New files + (from bothner@cygnus.com). + * dist-Makefile: Delete. + + * mpz_fac_ui: Fix comment. + + * mpz_random2: Rewrite a bit to make it possible for the most + significant limb to be == 1. + + * mpz_pprime.c (mpz_probab_prime_p): Remove \t\n. + +Fri Dec 13 23:10:02 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_do_sqrt: Simplify special case for U == 0. + * m*sqrt*.c, mpz_perfsqr.c (mpz_perfect_square_p): + Rename _mpz_impl_sqrt to _mpz_do_sqrt. + +Fri Dec 13 12:52:28 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * gmp-impl.h (MPZ_TMP_INIT): Cast to the right type. + +Thu Dec 12 22:17:29 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_add, mpn_sub, mpn_mul, mpn_div: Change type of several + variables to mp_size. + +Wed Dec 11 22:00:34 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_rshift.c: Fix header comments. + +Mon Dec 9 17:46:10 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Released 1.2. + + * gmp-impl.h (MPZ_TMP_INIT): Cast alloca return value. + + * dist-Makefile: Add missing dependency for cre-mparam. + + * mpz_mdiv.c, mpz_mmod.c, mpz_mdm.c, mpz_mdiv_ui.c, + mpz_mmod_ui.c, mpz_mdm_ui.c: Remove obsolete comment. + + * dist-Makefile (clean): clean in tests subdir too. + * tests/Makefile: Define default values for ROOT and SUB. + + * longlong.h (__a29k__ udiv_qrnnd): Change "q" to "1" for operand + 2 constraint. + +Mon Nov 11 00:06:05 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_sizeinb.c (mpz_sizeinbase): Special code for size == 0. + +Sat Nov 9 23:47:38 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Released 1.1.94. + + * dist-Makefile, Makefile, tests/Makefile: Merge tests into + distribution. + +Fri Nov 8 22:57:19 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * gmp.h: Don't use keyword `signed' for non-ANSI compilers. + +Thu Nov 7 22:06:46 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Cosmetic changes to keep it identical to gcc2 version + of longlong.h. + * longlong.h (__ibm032__): Fix operand order for add_ssaaaa and + sub_ddmmss. + +Mon Nov 4 00:36:46 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_mul: Fix indentation. + + * mpz_do_sqrt: Don't assume 32 bit limbs (had constant + 4294967296.0). + * mpz_do_sqrt: Handle overflow in conversion from double returned + by SQRT to mp_limb. + + * gmp.h: Add missing function definitions. + +Sun Nov 3 18:25:25 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_pow_ui: Change type of `i' to int. + + * ChangeLog: Add change log entry. + * ChangeLog: Add change log entry. + * ChangeLog: Add change log entry. + * ChangeLog: Add change log entry. + * ChangeLog: Add change log entry. + * ChangeLog: Add change log entry. + * ChangeLog: Add change log entry. + * ChangeLog: Add change log entry. +Stack overflow. + + * mpz_pow_ui.c: Fix typo in comment. + + * dist-Makefile: Create rpow.c from mpz_powm_ui.c. + * mpz_powm_ui.c: Add code for rpow. + * rpow.c: Delete this file. The rpow function is now implemented + in mpz_powm_ui.c. + + * mpz_fac_ui.c: New file. + * gmp.h, dist-Makefile: Add stuff for mpz_fac_ui. + + Bug found by John Amanatides (amana@sasquatch.cs.yorku.ca): + * mpz_powm_ui, mpz_powm: Call _mpn_mul in the right way, with + the first argument not smaller than the second. + +Tue Oct 29 13:56:55 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * cre-conv-tab.c (main), cre-mparam.c (main): Fix typo in output + header text. + +Mon Oct 28 00:35:29 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_random2: Handle size == 0. + + * gmp-impl.h (struct __mp_bases): Rename chars_per_limb_exactly to + chars_per_bit_exactly, and change its definition. + * cre-conv-tab.c (main): Output field according to its new + definition. + * mpz_out_str, _mpz_get_str, mpz_sizeinb, mout: + Use chars_per_bit_exactly. + + * mpz_random2: Change the loop termination condition in order to + get a large most significant limb with higher probability. + + * gmp.h: Add declaration of new mpz_random2 and mpz_get_si. + * mpz_get_si.c: New file. + * dist-Makefile: Add mpz_random2 and mpz_get_si. + + * mpz_sizeinb.c (mpz_sizeinbase): Special code for base being a + power of 2, giving exact result. + + * mpn_mul: Fix MPN_MUL_VERIFY in various ways. + * mpn_mul: New macro KARATSUBA_THRESHOLD. + * mpn_mul (karatsuba's algorithm): Don't write intermediate results + to prodp, use temporary pp instead. (Intermediate results can be + larger than the final result, possibly writing into hyperspace.) + * mpn_mul: Make smarter choice between Karatsuba's algorithm and the + shortcut algorithm. + * mpn_mul: Fix typo, cy instead of xcy. Unify carry handling code. + +Sun Oct 27 19:57:32 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_mul: In non-classical case, choose Karatsuba's algorithm only + when usize > 1.5 vsize. + + * mpn_mul: Break between classical and Karatsuba's algorithm at + KARATSUBA_THRESHOLD, if defined. Default to 8. + + * mpn_div: Kludge to fix stray memory read. + +Sat Oct 26 20:06:14 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_gcdext: Handle a = b = 0. Remove memory leakage by calling + mpz_clear for all temporary variables. + + * mpz_gcd: Reduce w_bcnt in _mpn_lshift call to hold that + function's argument constraints. Compute wsize correctly. + + * mpz_gcd: Fix typo in comment. + + * memory.c (_mp_default_allocate, _mp_default_reallocate): Call + abort if allocation fails, don't just exit. + +Fri Oct 25 22:17:20 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_random2.c: New file. + +Thu Oct 17 18:06:42 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Bugs found by Pierre-Joseph Gailly (pjg@sunbim.be): + * mpq_cmp: Take sign into account, don't just compare the + magnitudes. + * mpq_cmp: Call _mpn_mul in the right way, with the first argument + not smaller than the second. + +Wed Oct 16 19:27:32 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_random: Ensure the result is normalized. + +Tue Oct 15 14:55:13 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_clrbit: Support non-ANSI compilers. + +Wed Oct 9 18:03:28 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h (68k add_ssaaaa, sub_ddmmss): Generalize constraints. + +Tue Oct 8 17:42:59 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_mdm_ui: Add comments. + + * mpz_mdiv: Use MPZ_TMP_INIT instead of mpz_init. + * mpz_init_ui: Change spacing and header comment. + +Thu Oct 3 18:36:13 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * dist-Makefile: Prepend `./' before some filenames. + +Sun Sep 29 14:02:11 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Released 1.1 (public). + + * mpz_com: New name of mpz_not. + * dist-Makefile: Change mpz_not to mpz_com. + +Tue Sep 24 12:44:11 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Fix header comment. + +Mon Sep 9 15:16:24 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Released 1.0.92. + + * mpn_mul.c (_mpn_mul): Handle leading zero limbs in non-Karatsuba + case. + + * longlong.h (m68000 umul_ppmm): Clobber one register less by + slightly rearranging the code. + +Sun Sep 1 18:53:25 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * dist-Makefile (stamp-stddefh): Fix typo. + +Sat Aug 31 20:41:31 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Released 1.0.91. + + * mpz_mdiv.c, mpz_mmod.c, mpz_mdm.c, mpz_mdiv_ui.c, + mpz_mmod_ui.c, mpz_mdm_ui.c: New files and functions. + * gmp.h, gmp.texi: Define the new functions. + +Fri Aug 30 08:32:56 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_gcdext: Compute t argument from the other quantities at the + end, of the function, not in the loop. New feature: Allow t to be + NULL. + + * mpz_add.c, mpz_sub.c, mpz_mul.c, mpz_powm.c, mpz_gcd.c: Don't + include "mp.h". Use type name `MP_INT' always. + + * dist-Makefile, mpz_cmp.c: Merge mcmp.c from mpz_cmp.c. + +Wed Aug 28 00:45:11 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * dist-Makefile (documentation): Go via tmp.texi to avoid the + creation of gmp.dvi if any errors occur. Make tex read input + from /dev/null. + +Fri Aug 23 15:58:52 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h (68020, i386): Don't define machine-dependent + __umulsidi3 (so the default definition is used). + * longlong.h (all machines): Cast all operands, sources and + destinations, to `unsigned long int'. + * longlong.h: Add gmicro support. + +Thu Aug 22 00:28:29 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Rename BITS_PER_LONG to LONG_TYPE_SIZE. + * longlong.h (__ibm032__): Define count_leading_zeros and umul_ppmm. + * longlong.h: Define UMUL_TIME and UDIV_TIME for some CPUs. + * _mpz_get_str.c: Add code to do division by big_base using only + umul_qrnnd, if that is faster. Use UMUL_TIME and UDIV_TIME to + decide which variant to use. + +Wed Aug 21 15:45:23 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h (__sparc__ umul_ppmm): Move two insn from end to the + nops. (Saves two insn.) + + * longlong.h (__sparc__ umul_ppmm): Rewrite in order to avoid + branch, and to permit input/output register overlap. + + * longlong.h (__29k__): Remove duplicated udiv_qrnnd definition. + * longlong.h (__29k__ umul_ppmm): Split asm instructions into two + asm statements (gives better code if either the upper or lower + part of the product is unused. + +Tue Aug 20 17:57:59 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * _mpz_get_str.c (outside of functions): Remove + num_to_ascii_lower_case and num_to_ascii_upper_case. Use string + constants in the function instead. + +Mon Aug 19 00:37:42 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * cre-conv-tab.c (main): Output table in hex. Output 4 fields, not + 3, for components 0 and 1. + + * gmp.h: Add declaration of mpq_neg. + + Released 1.0beta.13. + + * _mpz_set_str.c (mpz_set_str): Cast EOF and SPC to char before + comparing to enum literals SPC and EOF. This makes the code work + for compilers where `char' is unsigned. (Bug found by Brian + Beuning). + + Released 1.0beta.12. + + * mpz_mod_ui: Remove references to quot. Remove quot_ptr, quot_size + declarations and assignment code. + +Sun Aug 18 14:44:26 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_mod_ui: Handle dividend < 0. + + Released 1.0beta.11. + + * mpz_dm_ui, mpz_div_ui, mpz_mod_ui, sdiv: Make them share the same + general structure, variable names, etc. + + * sdiv: Un-normalize the remainder in n1 before it is negated. + + * longlong.h: Mention UDIV_NEEDS_NORMALIZATION in description of + udiv_qrnnd. + + * mpz_dm_ui.c (mpz_divmod_ui), mpz_div_ui.c (mpz_div_ui): Increment + the quotient size if the dividend size is incremented. (Bug found + by Brian Beuning.) + + * mpz_mod_ui: Shift back the remainder, if UDIV_NEEDS_NORMALIZATION. + (Bug found by Brian Beuning.) + + * mpz_mod_ui: Replace "digit" by "limb". + + * mpz_perfsqr.c (mpz_perfect_square_p): Disable second test case + for non-32-bit machines (PP is hardwired for such machines). + * mpz_perfsqr.c (outside of functions): Define PP value with an L. + + * mpn_mul.c (_mpn_mul): Add verification code that is activated if + DEBUG is defined. Replace "digit" by "limb". + * mpn_mul.c (_mpn_mul: Karatsuba's algorithm: 4.): Normalize temp + after the addition. + * mpn_mul.c (_mpn_mul: Karatsuba's algorithm: 1.): Compare u0_size + and v0_size, and according to the result, swap arguments in + recursive call. (Don't violate mpn_mul's own argument + constraints.) + +Fri Aug 16 13:47:12 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Released 1.0beta.10. + + * longlong.h (IBMR2): Add udiv_qrnnd. + + * mpz_perfsqr: Remove unused variables. + + * mpz_and (case for different signs): Initialize loop variable i! + + * dist-Makefile: Update automatically generated dependencies. + * dist-Makefile (madd.c, msub.c, pow.c, mult.c, gcd.c): Add mp.h, + etc to dependency file lists. + + * longlong.h (add_ssaaaa, sub_ddmmss [C default versions]): Make __x + `unsigned long int'. + * longlong.h: Add `int' after `unsigned' and `long' everywhere. + +Wed Aug 14 18:06:48 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Add ARM, i860 support. + + * mpn_lshift, mpn_rshift, mpn_rshiftci: Rename *_word with *_limb. + +Tue Aug 13 21:57:43 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * _mpz_get_str.c, _mpz_set_str.c, mpz_sizeinb.c (mpz_sizeinbase), + mpz_out_str.c, mout.c: Remove declaration of __mp_bases. + * gmp-impl.h: Put it here, and make it `const'. + * cre-conv-tab.c (main): Make struct __mp_bases `const'. + +Mon Aug 12 17:11:46 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * cre-conv-tab.c (main): Use %lu in printf for long ints. + + * dist-Makefile: Fix cre-* dependencies. + + * cre-conv-tab.c (main): Output field big_base_inverted. + + * gmp-impl.h (struct bases): New field big_base_inverted. + * gmp-impl.h (struct bases): Change type of chars_per_limb_exactly + to float (in order to keep the structure smaller). + + * mp.h, gmp.h: Change names of macros for avoiding multiple + includes. + +Fri Aug 9 18:01:36 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * _mpz_get_str: Only shift limb array if normalization_steps != 0 + (optimization). + + * longlong.h (sparc umul_ppmm): Use __asm__, not asm. + * longlong.h (IBMR2 umul_ppmm): Refer to __m0 and __m1, not to m0 + and m1 (overlap between output and input operands did not work). + * longlong.h: Add VAX, ROMP and HP-PA support. + * longlong.h: Sort the machine dependent code in alphabetical order + on the CPU name. + * longlong.h: Hack comments. + +Thu Aug 8 14:13:36 1991 Torbjorn Granlund (tege@zevs.sics.se) + + Released 1.0beta.9. + + * longlong.h: Define BITS_PER_LONG to 32 if it's not already + defined. + * Define __BITS4 to BITS_PER_LONG / 4. + * Don't assume 32 bit word size in "count_leading_zeros" C macro. + Use __BITS4 and BITS_PER_LONG instead. + + * longlong.h: Don't #undef internal macros (reverse change of Aug 3). + + * longlong.h (68k): Define add_ssaaaa sub_ddmmss, and umul_ppmm + even for plain mc68000. + + * mpq_div: Flip the sign of the numerator *and* denominator of the + result if the intermediate denominator is negative. + + * mpz_and.c, mpz_ior.c: Use MPN_COPY for all copying operations. + + * mpz_and.c: Compute the result size more conservatively. + * mpz_ior.c: Likewise. + + * mpz_realloc: Never allocate zero space even if NEW_SIZE == 0. + + * dist-Makefile: Remove madd.c, msub.c, pow.c, mult.c, gcd.c from + BSDMP_SRCS. + + * dist-Makefile: Create mult.c from mpz_mul.c. + * mult.c: Delete this file. + + * _mpz_set_str: Normalize the result (for bases 2, 4, 8... it was + not done properly if the input string had many leading zeros). + +Sun Aug 4 16:54:14 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * dist-Makefile (gcd.c, pow.c, madd.c, msub.c): Make these targets + work with VPATH and GNU MP. + + * mpz_gcd: Don't call mpz_set; inline its functionality. + + * mpq_mul, mpq_div: Fix several serious typos. + + * mpz_dmincl, mpz_div: Don't normalize the quotient if it's already + zero. + + * mpq_neg.c: New file. + + * dist-Makefile: Remove obsolete dependencies. + + * mpz_sub: Fix typo. + + Bugs found by Pierre-Joseph Gailly (pjg@sunbim.be): + * mpq_mul, mpq_div: Initialize tmp[12] variables even when the gcd + is just 1. + * mpz_gcd: Handle gcd(0,v) and gcd(u,0) in special cases. + +Sat Aug 3 23:45:28 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h: Clean up comments. + * longlong.h: #undef internal macros. + +Fri Aug 2 18:29:11 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpq_set_si, mpq_set_ui: Canonicalize 0/x to 0/1. + * mpq_set_si, mpq_set_ui: Cosmetic formatting changes. + + * mpz_dmincl.c: Normalize the remainder before shifting it back. + + * mpz_dm_ui.c (mpz_divmod_ui): Handle rem == dividend. + + * mpn_div.c: Fix comment. + + * mpz_add.c, mpz_sub.c: Use __MP_INT (not MP_INT) for intermediate + type, in order to work for both GNU and Berkeley functions. + + * dist-Makefile: Create gcd.c from mpz_gcd.c, pow.c from mpz_powm, + madd.c from mpz_add.c, msub.c from mpz_sub.c. + respectively. + * pow.c, gcd.c, mpz_powmincl.c, madd.c, msub.c: Remove these. + * mpz_powm.c, mpz_gcd.c, mpz_add.c, mpz_sub.c: #ifdef for GNU and + Berkeley function name variants. + * dist-Makefile: Add created files to "clean" target. + +Tue Jul 16 15:19:46 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpq_get_den: No need for absolute value of the size, the + denominator is always positive. + + * mpz_get_ui: If the operand is zero, return zero. Don't read the + limb array! + + * mpz_dmincl.c: Don't ignore the return value from _mpn_rshift, it + is the size of the remainder. + +Mon Jul 15 11:08:05 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * Several files: Remove unused variables and functions. + + * gmp-impl.h: Declare _mpz_impl_sqrt. + + * mpz_dm_ui (mpz_divmod_ui), sdiv: Shift back the remainder if + UDIV_NEEDS_NORMALIZATION. (Fix from Brian Beuning.) + + * mpz_dm_ui.c, sdiv: Replace *digit with *limb. + + * mpz_ior: Add missing else statement in -OP1 | -OP2 case. + * mpz_ior: Add missing else statement in OP1 | -OP2 case. + * mpz_ior: Swap also OP1 and OP2 pointers in -OP1 & OP2 case. + * mpz_ior: Duplicate _mpz_realloc code. + + * mpz_and: Add missing else statement in -OP1 & -OP2 case. + * mpz_and: Rewrite OP1 & -OP2 case. + * mpz_and: Swap also OP1 and OP2 pointers in -OP1 & OP2 case. + + * mpz_gcdext: Loop in d1.size (not b->size). (Fix from Brian + Beuning.) + + * mpz_perfsqr: Fix argument order in _mpz_impl_sqrt call. (Fix from + Brian Beuning.) + +Fri Jul 12 17:10:33 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpq_set.c, mpq_set_ui.c, mpq_set_si.c, mpq_inv.c, + mpq_get_num.c, mpq_get_den.c, mpq_set_num.c, mpq_set_den.c: + New files. + + * mpz_dmincl.c: Remove second re-allocation of rem->d. It + was never executed. + + * dist-Makefile: Use `-r' instead of `-x' for test for ranlib (as + some unixes' test doesn't have the -r option). + + * *.*: Cast allocated pointers to the appropriate type (makes old C + compilers happier). + + * cre-conv-tab.c (main): Divide max_uli by 2 and multiply again + after conversion to double. (Kludge for broken C compilers.) + + * dist-Makefile (stamp-stddefh): New target. Test if "stddef.h" + exists in the system and creates a minimal one if it does not + exist. + * cre-stddefh.c: New file. + * dist-Makefile: Make libgmp.a and libmp.a depend on stamp-stddefh. + * dist-Makefile (clean): Add some more. + * gmp.h, mp.h: Unconditionally include "stddef.h". + +Thu Jul 11 10:08:21 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * min: Do ungetc of last read character. + * min.c: include stdio.h. + + * dist-Makefile: Go via tmp- files for cre* redirection. + * dist-Makefile: Add tmp* to "clean" target. + + * dist-Makefile: Use LOCAL_CC for cre*, to simplify cross + compilation. + + * gmp.h, mp.h: Don't define NULL here. + * gmp-impl.h: Define it here. + +Wed Jul 10 14:13:33 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_mod_2exp: Don't copy too much, overwriting most significant + limb. + + * mpz_and, mpz_ior: Don't read op[12]_ptr from op[12] when + reallocating res, if op[12]_ptr got their value from alloca. + + * mpz_and, mpz_ior: Clear up comments. + + * cre-mparam.c: Output parameters for `short int' and `int'. + + * mpz_and, mpz_ior: Negate negative op[12]_size in several places. + +Tue Jul 9 18:40:30 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * gmp.h, mp.h: Test for _SIZE_T defined before typedef'ing size_t. + (Fix for Sun lossage.) + + * gmp.h: Add declaration of mpq_clear. + + * dist-Makefile: Check if "ranlib" exists, before using it. + * dist-Makefile: Add mpz_sqrtrem.c and mpz_size.c. + * mpz_powm: Fix typo, "pow" instead of "mpz_powm". + +Fri Jul 5 19:08:09 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * move: Remove incorrect comment. + + * mpz_free, mpq_free: Rename to *_clear. + * dist-Makefile: Likewise. + * mpq_add, mpq_sub, mpq_mul, mpq_div: Likewise. + + * mpz_dmincl.c: Don't call "move", inline its functionality. + +Thu Jul 4 00:06:39 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * Makefile: Include dist-Makefile. Fix dist target to include + dist-Makefile (with the name "Makefile" in the archive). + + * dist-Makefile: New file made from Makefile. Add new mpz_... + functions. + + * mpz_powincl.c New file for mpz_powm (Berkeley MP pow) + functionality. Avoids code duplication. + * pow.c, mpz_powm.c: Include mpz_powincl.c + + * mpz_dmincl.c: New file containing general division code. Avoids + code duplication. + * mpz_dm.c (mpz_divmod), mpz_mod.c (mpz_mod), mdiv.c (mdiv): Include + mpz_dmincl.c. + + * _mpz_get_str: Don't call memmove, unless HAS_MEMMOVE is defined. + Instead, write the overlapping memory copying inline. + + * mpz_dm_ui.c: New name for mpz_divmod_ui.c (SysV file name limit). + + * longlong.h: Don't use #elif. + * mpz_do_sqrt.c: Likewise. + + * longlong.h: Use __asm__ instead of asm. + * longlong.h (sparc udiv_qrnnd): Make it to one string over several + lines. + + * longlong.h: Preend __ll_ to B, highpart, and lowpart. + + * longlong.h: Move array t in count_leading_zeros to the new file + mp_clz_tab.c. Rename the array __clz_tab. + * All files: #ifdef for traditional C compatibility. + +Wed Jul 3 11:42:14 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_and: Initialize res_ptr always (used to be initialized only + when reallocating). + + * longlong.h (umul_ppmm [C variant]): Make __ul...__vh + `unsigned int', and cast the multiplications. This way + compilers more easily can choose cheaper multiplication + instructions. + + * mpz_mod_2exp: Handle input argument < modulo argument. + * mpz_many: Make sure mp_size is the type for sizes, not int. + + * mpz_init, mpz_init_set*, mpq_init, mpq_add, mpq_sub, mpq_mul, + mpq_div: Change mpz_init* interface. Structure pointer as first + arg to initialization function, no longer *return* struct. + +Sun Jun 30 19:21:44 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * Rename mpz_impl_sqrt.c to mpz_do_sqrt.c to satisfy SysV 14 + character file name length limit. + + * Most files: Rename MINT to MP_INT. Rename MRAT to MP_RAT. + * mpz_sizeinb.c: New file with function mpz_sizeinbase. + * mp_bases.c: New file, with array __mp_bases. + * _mpz_get_str, _mpz_set_str: Remove struct bases, use extern + __mp_bases instead. + * mout, mpz_out_str: Use array __mp_bases instead of function + _mpz_get_cvtlen. + * mpz_get_cvtlen.c: Remove. + * Makefile: Update. + +Sat Jun 29 21:57:28 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * longlong.h (__sparc8__ umul_ppmm): Insert 3 nop:s for wr delay. + * longlong.h (___IBMR2__): Define umul_ppmm, add_ssaaaa, sub_ddmmss. + * longlong.h (__sparc__): Don't call .umul; expand asm instead. + Don't define __umulsidi3 (i.e. use default definition). + +Mon Jun 24 17:37:23 1991 Torbjorn Granlund (tege@amon.sics.se) + + * _mpz_get_str.c (num_to_ascii_lower_case, num_to_ascii_upper_case): + Swap 't' and 's'. + +Sat Jun 22 13:54:01 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_gcdext.c: New file. + + * mpn_mul: Handle carry and unexpected operand sizes in last + additions/subtractions. (Bug trigged when v1_size == 1.) + + * mp*_alloc*: Rename functions to mp*_init* (files to mp*_iset*.c). + * mpq_*: Call mpz_init*. + + * mpz_pow_ui, rpow: Use _mpn_mul instead of mult. Restructure. + +Wed May 29 20:32:33 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_get_cvtlen: multiply by size. + +Sun May 26 15:01:15 1991 Torbjorn Granlund (tege@bella.nada.kth.se) + + Alpha-release 0.95. + + Fixes from Doug Lea (dl@g.oswego.edu): + * mpz_mul_ui: Loop to MULT_SIZE (not PROD_SIZE). Adjust PROD_SIZE + correctly. + * mpz_div: Prepend _ to mpz_realloc. + * mpz_set_xs, mpz_set_ds: Fix typos in function name. + +Sat May 25 22:51:16 1991 Torbjorn Granlund (tege@bella.nada.kth.se) + + * mpz_divmod_ui: New function. + + * sdiv: Make the sign of the remainder correct. + +Thu May 23 15:28:24 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * Alpha-release 0.94. + + * mpz_mul_ui: Include longlong.h. + + * mpz_perfsqr.c (mpz_perfect_square_p): Call _mpz_impl_sqrt instead + of msqrt. + + * mpz_impl_sqrt: Don't call "move", inline its functionality. + + * mdiv: Use MPN_COPY instead of memcpy. + * rpow, mpz_mul, mpz_mod_2exp: Likewise. + * pow.c: Likewise, and fix bug in the size arg. + + * xtom: Don't use mpz_alloc, inline needed code instead. Call + _mpz_set_str instead of mpz_set_str. + + * Makefile: Make two libraries, libmp.a and libgmp.a. + +Thu May 22 20:25:29 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * Add manual to distribution. + * Fold in many missing routines described in the manual. + * Update Makefile. + +Wed May 22 13:48:46 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_set_str: Make it handle 0x prefix OK. + +Sat May 18 18:31:02 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * memory.c (_mp_default_reallocate): Swap OLD_SIZE and NEW_SIZE + arguments. + * mpz_realloc (_mpz_realloc): Swap in call to _mp_reallocate_func. + * min: Likewise. + +Thu May 16 20:43:05 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * memory.c: Make the default allocations functions global. + * mp_set_fns (mp_set_memory_functions): Make a NULL pointer mean the + default memory function. + +Wed May 8 20:02:42 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_div: Handle DEN the same as QUOT correctly by copying DEN->D + even if no normalization is needed. + * mpz_div: Rework reallocation scheme, to avoid excess copying. + + * mpz_sub_ui.c, mpz_add_ui.c: New files. + + * mpz_cmp.c, mpz_cmp_ui.c: New files. + + * mpz_mul_2exp: Handle zero input MINT correctly. + + * mpn_rshiftci: Don't handle shift counts > BITS_PER_MP_DIGIT. + + * mpz_out_raw.c, mpz_inp_raw.c: New files for raw I/O. + +Tue May 7 15:44:58 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_rshift: Don't handle shift counts > BITS_PER_MP_DIGIT. + * mpz_div_2exp: Don't call _mpn_rshift with cnt > BITS_PER_MP_DIGIT. + * gcd, mpz_gcd: Likewise. + + * gcd, mpz_gcd: Handle common 2 factors correctly. + +Mon May 6 20:22:59 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * gmp-impl.h (MPN_COPY): Inline a loop instead of calling memcpy. + + * gmp-impl.h, mpz_get_str, rpow: Swap DST and SRC in TMPCOPY* macros. + +Sun May 5 15:16:23 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpz_div: Remove test for QUOT == 0. + +Sun Apr 28 20:21:04 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * pow: Don't make MOD normalization in place, as it's a bad idea to + write on an input parameter. + * pow: Reduce BASE if it's > MOD. + * pow, mult, mpz_mul: Simplify realloc code. + +Sat Apr 27 21:03:11 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * Install multiplication using Karatsuba's algorithm as default. + +Fri Apr 26 01:03:57 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * msqrt: Store in ROOT even for U==0, to make msqrt(0) defined. + + * mpz_div_2exp.c, mpz_mul_2exp.c: New files for shifting right and + left, respectively. + * gmp.h: Add definitions for mpz_div_2exp and mpz_mul_2exp. + + * mlshift.c, mrshift.c: Remove. + +Wed Apr 24 21:39:22 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * mpn_mul: Check only for m2_size == 0 in function header. + +Mon Apr 22 01:31:57 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * karatsuba.c: New file for Karatsuba's multiplication algorithm. + + * mpz_random, mpz_init, mpz_mod_2exp: New files and functions. + + * mpn_cmp: Fix header comment. + +Sun Apr 21 00:10:44 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * pow: Switch off initial base reduction. + +Sat Apr 20 22:06:05 1991 Torbjorn Granlund (tege@echnaton.sics.se) + + * mpz_get_str: Don't generate initial zeros for initial word. + Used to write outside of allocated storage. + +Mon Apr 15 15:48:08 1991 Torbjorn Granlund (tege@zevs.sics.se) + + * _mpz_realloc: Make it accept size in number of mp_digits. + * Most functions: Use new _mpz_realloc definition. + + * mpz_set_str: Remove calls _mp_free_func. + + * Most functions: Rename mpn_* to _mpn_*. Rename mpz_realloc to + _mpz_realloc. + * mpn_lshift: Redefine _mpn_lshift to only handle small shifts. + * mdiv, mpz_div, ...: Changes for new definition of _mpn_lshift. + * msqrt, mp*_*shift*: Define cnt as unsigned (for speed). + +Sat Apr 6 14:05:16 1991 Torbjorn Granlund (tege@musta.nada.kth.se) + + * mpn_mul: Multiply by the first digit in M2 in a special + loop instead of zeroing the product area. + + * mpz_abs.c: New file. + + * sdiv: Implement as mpz_div_si for speed. + + * mpn_add: Make it work for second source operand == 0. + + * msub: Negate the correct operand, i.e. V before swapping, not + the smaller of U and V! + * madd, msub: Update abs_* when swapping operands, and not after + (optimization). + +Fri Apr 5 00:19:36 1991 Torbjorn Granlund (tege@black.nada.kth.se) + + * mpn_sub: Make it work for subtrahend == 0. + + * madd, msub: Rewrite to minimize mpn_cmp calls. Ensure + mpn_cmp is called with positive sizes (used to be called + incorrectly with negative sizes sometimes). + + * msqrt: Make it divide by zero if fed with a negative number. + * Remove if statement at end of precision calculation that was + never true. + + * itom, mp.h: The argument is of type short, not int. + + * mpz_realloc, gmp.h: Make mpz_realloc return the new digit pointer. + + * mpz_get_str.c, mpz_set_str.c, mpz_new_str.c: Don't include mp.h. + + * Add COPYING to distribution. + + * mpz_div_ui.c, mpz_div_si.c, mpz_new_ui.c, mpz_new_si.c: New files. + +Fri Mar 15 00:26:29 1991 Torbjorn Granlund (tege@musta.nada.kth.se) + + * Add Copyleft headers to all files. + + * mpn_mul.c, mpn_div.c: Add header comments. + * mult.c, mdiv.c: Update header comments. + + * mpq_add.c, mpq_sub.c, mpq_div.c, mpq_new.c, mpq_new_ui.c, + mpq_free.c: New files for rational arithmetics. + + * mpn_lshift.c: Avoid writing the most significant word if it is 0. + + * mdiv.c: Call mpn_lshift for the normalization. + * mdiv.c: Remove #ifdefs. + + * Makefile: Add ChangeLog to DISTFILES. + + * mpn_div.c: Make the add_back code work (by removing abort()). + * mpn_div.c: Make it return if the quotient is size as compared + with the difference NSIZE - DSIZE. If the stored quotient is + larger than that, return 1, otherwise 0. + * gmp.h: Fix mpn_div declaration. + * mdiv.c: Adopt call to mpn_div. + * mpz_div.c: New file (developed from mdiv.c). + + * README: Update routine names. + +Thu Mar 14 18:45:28 1991 Torbjorn Granlund (tege@musta.nada.kth.se) + + * mpq_mul.c: New file for rational multiplication. + + * gmp.h: Add definitions for rational arithmetics. + + * mpn_div: Kludge the case where the high numerator digit > the + high denominator digit. (This code is going to be optimized later.) + + * New files: gmp.h for GNU specific functions, gmp-common.h for + definitions common for mp.h and gmp.h. + + * Ensure mp.h just defines what BSD mp.h defines. + + * pow.c: Fix typo for bp allocation. + + * Rename natural number functions to mpn_*, integer functions to + mpz_*. + +Tue Mar 5 18:47:04 1991 Torbjorn Granlund (tege@musta.nada.kth.se) + + * mdiv.c (_mp_divide, case 2): Change test for estimate of Q from + "n0 >= r" to "n0 > r". + + * msqrt: Tune the increasing precision scheme, to do fewer steps. + +Tue Mar 3 18:50:10 1991 Torbjorn Granlund (tege@musta.nada.kth.se) + + * msqrt: Use the low level routines. Use low precision in the + beginning, and increase the precision as the result converges. + (This optimization gave a 6-fold speedup.) diff --git a/gmp4/INSTALL b/gmp4/INSTALL new file mode 100644 index 0000000..2099840 --- /dev/null +++ b/gmp4/INSTALL @@ -0,0 +1,370 @@ +Installation Instructions +************************* + +Copyright (C) 1994-1996, 1999-2002, 2004-2013 Free Software Foundation, +Inc. + + Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. This file is offered as-is, +without warranty of any kind. + +Basic Installation +================== + + Briefly, the shell command `./configure && make && make install' +should configure, build, and install this package. The following +more-detailed instructions are generic; see the `README' file for +instructions specific to this package. Some packages provide this +`INSTALL' file but do not implement all of the features documented +below. The lack of an optional feature in a given package is not +necessarily a bug. More recommendations for GNU packages can be found +in *note Makefile Conventions: (standards)Makefile Conventions. + + The `configure' shell script attempts to guess correct values for +various system-dependent variables used during compilation. It uses +those values to create a `Makefile' in each directory of the package. +It may also create one or more `.h' files containing system-dependent +definitions. Finally, it creates a shell script `config.status' that +you can run in the future to recreate the current configuration, and a +file `config.log' containing compiler output (useful mainly for +debugging `configure'). + + It can also use an optional file (typically called `config.cache' +and enabled with `--cache-file=config.cache' or simply `-C') that saves +the results of its tests to speed up reconfiguring. Caching is +disabled by default to prevent problems with accidental use of stale +cache files. + + If you need to do unusual things to compile the package, please try +to figure out how `configure' could check whether to do them, and mail +diffs or instructions to the address given in the `README' so they can +be considered for the next release. If you are using the cache, and at +some point `config.cache' contains results you don't want to keep, you +may remove or edit it. + + The file `configure.ac' (or `configure.in') is used to create +`configure' by a program called `autoconf'. You need `configure.ac' if +you want to change it or regenerate `configure' using a newer version +of `autoconf'. + + The simplest way to compile this package is: + + 1. `cd' to the directory containing the package's source code and type + `./configure' to configure the package for your system. + + Running `configure' might take a while. While running, it prints + some messages telling which features it is checking for. + + 2. Type `make' to compile the package. + + 3. Optionally, type `make check' to run any self-tests that come with + the package, generally using the just-built uninstalled binaries. + + 4. Type `make install' to install the programs and any data files and + documentation. When installing into a prefix owned by root, it is + recommended that the package be configured and built as a regular + user, and only the `make install' phase executed with root + privileges. + + 5. Optionally, type `make installcheck' to repeat any self-tests, but + this time using the binaries in their final installed location. + This target does not install anything. Running this target as a + regular user, particularly if the prior `make install' required + root privileges, verifies that the installation completed + correctly. + + 6. You can remove the program binaries and object files from the + source code directory by typing `make clean'. To also remove the + files that `configure' created (so you can compile the package for + a different kind of computer), type `make distclean'. There is + also a `make maintainer-clean' target, but that is intended mainly + for the package's developers. If you use it, you may have to get + all sorts of other programs in order to regenerate files that came + with the distribution. + + 7. Often, you can also type `make uninstall' to remove the installed + files again. In practice, not all packages have tested that + uninstallation works correctly, even though it is required by the + GNU Coding Standards. + + 8. Some packages, particularly those that use Automake, provide `make + distcheck', which can by used by developers to test that all other + targets like `make install' and `make uninstall' work correctly. + This target is generally not run by end users. + +Compilers and Options +===================== + + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. Run `./configure --help' +for details on some of the pertinent environment variables. + + You can give `configure' initial values for configuration parameters +by setting variables in the command line or in the environment. Here +is an example: + + ./configure CC=c99 CFLAGS=-g LIBS=-lposix + + *Note Defining Variables::, for more details. + +Compiling For Multiple Architectures +==================================== + + You can compile the package for more than one kind of computer at the +same time, by placing the object files for each architecture in their +own directory. To do this, you can use GNU `make'. `cd' to the +directory where you want the object files and executables to go and run +the `configure' script. `configure' automatically checks for the +source code in the directory that `configure' is in and in `..'. This +is known as a "VPATH" build. + + With a non-GNU `make', it is safer to compile the package for one +architecture at a time in the source code directory. After you have +installed the package for one architecture, use `make distclean' before +reconfiguring for another architecture. + + On MacOS X 10.5 and later systems, you can create libraries and +executables that work on multiple system types--known as "fat" or +"universal" binaries--by specifying multiple `-arch' options to the +compiler but only a single `-arch' option to the preprocessor. Like +this: + + ./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ + CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ + CPP="gcc -E" CXXCPP="g++ -E" + + This is not guaranteed to produce working output in all cases, you +may have to build one architecture at a time and combine the results +using the `lipo' tool if you have problems. + +Installation Names +================== + + By default, `make install' installs the package's commands under +`/usr/local/bin', include files under `/usr/local/include', etc. You +can specify an installation prefix other than `/usr/local' by giving +`configure' the option `--prefix=PREFIX', where PREFIX must be an +absolute file name. + + You can specify separate installation prefixes for +architecture-specific files and architecture-independent files. If you +pass the option `--exec-prefix=PREFIX' to `configure', the package uses +PREFIX as the prefix for installing programs and libraries. +Documentation and other data files still use the regular prefix. + + In addition, if you use an unusual directory layout you can give +options like `--bindir=DIR' to specify different values for particular +kinds of files. Run `configure --help' for a list of the directories +you can set and what kinds of files go in them. In general, the +default for these options is expressed in terms of `${prefix}', so that +specifying just `--prefix' will affect all of the other directory +specifications that were not explicitly provided. + + The most portable way to affect installation locations is to pass the +correct locations to `configure'; however, many packages provide one or +both of the following shortcuts of passing variable assignments to the +`make install' command line to change installation locations without +having to reconfigure or recompile. + + The first method involves providing an override variable for each +affected directory. For example, `make install +prefix=/alternate/directory' will choose an alternate location for all +directory configuration variables that were expressed in terms of +`${prefix}'. Any directories that were specified during `configure', +but not in terms of `${prefix}', must each be overridden at install +time for the entire installation to be relocated. The approach of +makefile variable overrides for each directory variable is required by +the GNU Coding Standards, and ideally causes no recompilation. +However, some platforms have known limitations with the semantics of +shared libraries that end up requiring recompilation when using this +method, particularly noticeable in packages that use GNU Libtool. + + The second method involves providing the `DESTDIR' variable. For +example, `make install DESTDIR=/alternate/directory' will prepend +`/alternate/directory' before all installation names. The approach of +`DESTDIR' overrides is not required by the GNU Coding Standards, and +does not work on platforms that have drive letters. On the other hand, +it does better at avoiding recompilation issues, and works well even +when some directory options were not specified in terms of `${prefix}' +at `configure' time. + +Optional Features +================= + + If the package supports it, you can cause programs to be installed +with an extra prefix or suffix on their names by giving `configure' the +option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. + + Some packages pay attention to `--enable-FEATURE' options to +`configure', where FEATURE indicates an optional part of the package. +They may also pay attention to `--with-PACKAGE' options, where PACKAGE +is something like `gnu-as' or `x' (for the X Window System). The +`README' should mention any `--enable-' and `--with-' options that the +package recognizes. + + For packages that use the X Window System, `configure' can usually +find the X include and library files automatically, but if it doesn't, +you can use the `configure' options `--x-includes=DIR' and +`--x-libraries=DIR' to specify their locations. + + Some packages offer the ability to configure how verbose the +execution of `make' will be. For these packages, running `./configure +--enable-silent-rules' sets the default to minimal output, which can be +overridden with `make V=1'; while running `./configure +--disable-silent-rules' sets the default to verbose, which can be +overridden with `make V=0'. + +Particular systems +================== + + On HP-UX, the default C compiler is not ANSI C compatible. If GNU +CC is not installed, it is recommended to use the following options in +order to use an ANSI C compiler: + + ./configure CC="cc -Ae -D_XOPEN_SOURCE=500" + +and if that doesn't work, install pre-built binaries of GCC for HP-UX. + + HP-UX `make' updates targets which have the same time stamps as +their prerequisites, which makes it generally unusable when shipped +generated files such as `configure' are involved. Use GNU `make' +instead. + + On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot +parse its `' header file. The option `-nodtk' can be used as +a workaround. If GNU CC is not installed, it is therefore recommended +to try + + ./configure CC="cc" + +and if that doesn't work, try + + ./configure CC="cc -nodtk" + + On Solaris, don't put `/usr/ucb' early in your `PATH'. This +directory contains several dysfunctional programs; working variants of +these programs are available in `/usr/bin'. So, if you need `/usr/ucb' +in your `PATH', put it _after_ `/usr/bin'. + + On Haiku, software installed for all users goes in `/boot/common', +not `/usr/local'. It is recommended to use the following options: + + ./configure --prefix=/boot/common + +Specifying the System Type +========================== + + There may be some features `configure' cannot figure out +automatically, but needs to determine by the type of machine the package +will run on. Usually, assuming the package is built to be run on the +_same_ architectures, `configure' can figure that out, but if it prints +a message saying it cannot guess the machine type, give it the +`--build=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name which has the form: + + CPU-COMPANY-SYSTEM + +where SYSTEM can have one of these forms: + + OS + KERNEL-OS + + See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the machine type. + + If you are _building_ compiler tools for cross-compiling, you should +use the option `--target=TYPE' to select the type of system they will +produce code for. + + If you want to _use_ a cross compiler, that generates code for a +platform different from the build platform, you should specify the +"host" platform (i.e., that on which the generated programs will +eventually be run) with `--host=TYPE'. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Defining Variables +================== + + Variables not defined in a site shell script can be set in the +environment passed to `configure'. However, some packages may run +configure again during the build, and the customized values of these +variables may be lost. In order to avoid this problem, you should set +them in the `configure' command line, using `VAR=value'. For example: + + ./configure CC=/usr/local2/bin/gcc + +causes the specified `gcc' to be used as the C compiler (unless it is +overridden in the site shell script). + +Unfortunately, this technique does not work for `CONFIG_SHELL' due to +an Autoconf limitation. Until the limitation is lifted, you can use +this workaround: + + CONFIG_SHELL=/bin/bash ./configure CONFIG_SHELL=/bin/bash + +`configure' Invocation +====================== + + `configure' recognizes the following options to control how it +operates. + +`--help' +`-h' + Print a summary of all of the options to `configure', and exit. + +`--help=short' +`--help=recursive' + Print a summary of the options unique to this package's + `configure', and exit. The `short' variant lists options used + only in the top level, while the `recursive' variant lists options + also present in any nested packages. + +`--version' +`-V' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`--cache-file=FILE' + Enable the cache: use and save the results of the tests in FILE, + traditionally `config.cache'. FILE defaults to `/dev/null' to + disable caching. + +`--config-cache' +`-C' + Alias for `--cache-file=config.cache'. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`--prefix=DIR' + Use DIR as the installation prefix. *note Installation Names:: + for more details, including other options available for fine-tuning + the installation locations. + +`--no-create' +`-n' + Run the configure checks, but stop before creating any output + files. + +`configure' also accepts some other, not widely useful, options. Run +`configure --help' for more details. diff --git a/gmp4/INSTALL.autoconf b/gmp4/INSTALL.autoconf new file mode 100644 index 0000000..0600b32 --- /dev/null +++ b/gmp4/INSTALL.autoconf @@ -0,0 +1,228 @@ +Copyright (C) 1994-1996, 1999-2002 Free Software Foundation, Inc. + + This file is free documentation; the Free Software Foundation gives +unlimited permission to copy, distribute and modify it. + +Basic Installation +================== + + These are generic installation instructions. + + The `configure' shell script attempts to guess correct values for +various system-dependent variables used during compilation. It uses +those values to create a `Makefile' in each directory of the package. +It may also create one or more `.h' files containing system-dependent +definitions. Finally, it creates a shell script `config.status' that +you can run in the future to recreate the current configuration, and a +file `config.log' containing compiler output (useful mainly for +debugging `configure'). + + It can also use an optional file (typically called `config.cache' +and enabled with `--cache-file=config.cache' or simply `-C') that saves +the results of its tests to speed up reconfiguring. (Caching is +disabled by default to prevent problems with accidental use of stale +cache files.) + + If you need to do unusual things to compile the package, please try +to figure out how `configure' could check whether to do them, and mail +diffs or instructions to the address given in the `README' so they can +be considered for the next release. If you are using the cache, and at +some point `config.cache' contains results you don't want to keep, you +may remove or edit it. + + The file `configure.ac' (or `configure.in') is used to create +`configure' by a program called `autoconf'. You only need +`configure.ac' if you want to change it or regenerate `configure' using +a newer version of `autoconf'. + +The simplest way to compile this package is: + + 1. `cd' to the directory containing the package's source code and type + `./configure' to configure the package for your system. If you're + using `csh' on an old version of System V, you might need to type + `sh ./configure' instead to prevent `csh' from trying to execute + `configure' itself. + + Running `configure' takes awhile. While running, it prints some + messages telling which features it is checking for. + + 2. Type `make' to compile the package. + + 3. Optionally, type `make check' to run any self-tests that come with + the package. + + 4. Type `make install' to install the programs and any data files and + documentation. + + 5. You can remove the program binaries and object files from the + source code directory by typing `make clean'. To also remove the + files that `configure' created (so you can compile the package for + a different kind of computer), type `make distclean'. There is + also a `make maintainer-clean' target, but that is intended mainly + for the package's developers. If you use it, you may have to get + all sorts of other programs in order to regenerate files that came + with the distribution. + +Compilers and Options +===================== + + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. Run `./configure --help' +for details on some of the pertinent environment variables. + + You can give `configure' initial values for configuration parameters +by setting variables in the command line or in the environment. Here +is an example: + + ./configure CC=c89 CFLAGS=-O2 LIBS=-lposix + + *Note Defining Variables::, for more details. + +Compiling For Multiple Architectures +==================================== + + You can compile the package for more than one kind of computer at the +same time, by placing the object files for each architecture in their +own directory. To do this, you must use a version of `make' that +supports the `VPATH' variable, such as GNU `make'. `cd' to the +directory where you want the object files and executables to go and run +the `configure' script. `configure' automatically checks for the +source code in the directory that `configure' is in and in `..'. + + If you have to use a `make' that does not support the `VPATH' +variable, you have to compile the package for one architecture at a +time in the source code directory. After you have installed the +package for one architecture, use `make distclean' before reconfiguring +for another architecture. + +Installation Names +================== + + By default, `make install' will install the package's files in +`/usr/local/bin', `/usr/local/man', etc. You can specify an +installation prefix other than `/usr/local' by giving `configure' the +option `--prefix=PATH'. + + You can specify separate installation prefixes for +architecture-specific files and architecture-independent files. If you +give `configure' the option `--exec-prefix=PATH', the package will use +PATH as the prefix for installing programs and libraries. +Documentation and other data files will still use the regular prefix. + + In addition, if you use an unusual directory layout you can give +options like `--bindir=PATH' to specify different values for particular +kinds of files. Run `configure --help' for a list of the directories +you can set and what kinds of files go in them. + + If the package supports it, you can cause programs to be installed +with an extra prefix or suffix on their names by giving `configure' the +option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. + +Optional Features +================= + + Some packages pay attention to `--enable-FEATURE' options to +`configure', where FEATURE indicates an optional part of the package. +They may also pay attention to `--with-PACKAGE' options, where PACKAGE +is something like `gnu-as' or `x' (for the X Window System). The +`README' should mention any `--enable-' and `--with-' options that the +package recognizes. + + For packages that use the X Window System, `configure' can usually +find the X include and library files automatically, but if it doesn't, +you can use the `configure' options `--x-includes=DIR' and +`--x-libraries=DIR' to specify their locations. + +Specifying the System Type +========================== + + There may be some features `configure' cannot figure out +automatically, but needs to determine by the type of machine the package +will run on. Usually, assuming the package is built to be run on the +_same_ architectures, `configure' can figure that out, but if it prints +a message saying it cannot guess the machine type, give it the +`--build=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name which has the form: + + CPU-COMPANY-SYSTEM + +where SYSTEM can have one of these forms: + + OS KERNEL-OS + + See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the machine type. + + If you are _building_ compiler tools for cross-compiling, you should +use the `--target=TYPE' option to select the type of system they will +produce code for. + + If you want to _use_ a cross compiler, that generates code for a +platform different from the build platform, you should specify the +"host" platform (i.e., that on which the generated programs will +eventually be run) with `--host=TYPE'. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Defining Variables +================== + + Variables not defined in a site shell script can be set in the +environment passed to `configure'. However, some packages may run +configure again during the build, and the customized values of these +variables may be lost. In order to avoid this problem, you should set +them in the `configure' command line, using `VAR=value'. For example: + + ./configure CC=/usr/local2/bin/gcc + +will cause the specified gcc to be used as the C compiler (unless it is +overridden in the site shell script). + +`configure' Invocation +====================== + + `configure' recognizes the following options to control how it +operates. + +`--help' +`-h' + Print a summary of the options to `configure', and exit. + +`--version' +`-V' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`--cache-file=FILE' + Enable the cache: use and save the results of the tests in FILE, + traditionally `config.cache'. FILE defaults to `/dev/null' to + disable caching. + +`--config-cache' +`-C' + Alias for `--cache-file=config.cache'. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`configure' also accepts some other, not widely useful, options. Run +`configure --help' for more details. + diff --git a/gmp4/Makefile.am b/gmp4/Makefile.am new file mode 100644 index 0000000..8567c0e --- /dev/null +++ b/gmp4/Makefile.am @@ -0,0 +1,445 @@ +## Process this file with automake to generate Makefile.in + + +# Copyright 1991, 1993, 1994, 1996, 1997, 1999-2004, 2006-2009, 2011-2014 Free +# Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * the GNU Lesser General Public License as published by the Free +# Software Foundation; either version 3 of the License, or (at your +# option) any later version. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP Library 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 copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +# The following options are the same as AM_INIT_AUTOMAKE in configure.in, +# except no $(top_builddir) on ansi2knr. That directory is wanted for the +# Makefiles in subdirectories, but here we must omit it so automake gives +# the actual ansi2knr build rule, not "cd $(top_builddir) && make ansi2knr". +# +# AUTOMAKE_OPTIONS = 1.8 gnu no-dependencies + + +# Libtool -version-info for libgmp.la and libmp.la. See "Versioning" in the +# libtool manual. +# +# CURRENT:REVISION:AGE +# +# 1. No interfaces changed, only implementations (good): Increment REVISION. +# +# 2. Interfaces added, none removed (good): Increment CURRENT, increment +# AGE, set REVISION to 0. +# +# 3. Interfaces removed (BAD, breaks upward compatibility): Increment +# CURRENT, set AGE and REVISION to 0. +# +# Do this separately for libgmp, libgmpxx and libmp, and only for releases. +# +# GMP -version-info +# release libgmp libgmpxx libmp +# 2.0.x - - - +# 3.0 3:0:0 - 3:0:0 +# 3.0.1 3:1:0 - 3:0:0 +# 3.1 4:0:1 - 4:0:1 +# 3.1.1 4:1:1 - 4:1:1 +# 4.0 5:0:2 3:0:0 4:2:1 +# 4.0.1 5:1:2 3:1:0 4:3:1 +# 4.1 6:0:3 3:2:0 4:4:1 +# 4.1.1 6:1:3 3:3:0 4:5:1 +# 4.1.2 6:2:3 3:4:0 4:6:1 +# 4.1.3 6:3:3 3:5:0 4:7:1 +# 4.1.4 6:3:3 3:5:0 4:7:1 WRONG, same as 4.1.3! +# 4.2 6:0:3 3:2:0 4:4:1 REALLY WRONG, same as 4.1! +# 4.2.1 7:1:4 4:1:1 4:10:1 WRONG for libgmpxx +# 4.2.2 7:2:4 4:2:0 4:11:1 +# 4.2.3 7:3:4 4:3:0 4:12:1 +# 4.2.4 7:4:4 4:4:0 4:13:1 +# 4.3.0 8:0:5 5:0:1 4:14:1 +# 4.3.1 8:1:5 5:1:1 4:15:1 WRONG Really used same as 4.3.0 +# 4.3.2 8:2:5 5:2:1 4:16:1 +# 5.0.0 9:0:6 6:0:2 4:20:1 Should have been 10:0:0 +# 5.0.1 10:1:0 6:1:2 4:21:1 +# 5.0.2 10:2:0 6:2:2 4:22:1 +# 5.0.3 10:3:0 6:3:2 4:23:1 +# 5.0.4 10:4:0 6:4:2 4:24:1 +# 5.0.5 10:5:0 6:5:2 4:25:1 +# 5.1.0 11:0:1 7:0:3 - +# 5.1.1 11:1:1 7:1:3 - +# 5.1.2 11:2:1 7:2:3 - +# 6.0.0 12:0:2 8:0:4 - +# +# Starting at 3:0:0 is a slight abuse of the versioning system, but it +# ensures we're past soname libgmp.so.2, which was used on Debian GNU/Linux +# packages of gmp 2. Pretend gmp 2 was 2:0:0, so the interface changes for +# gmp 3 mean 3:0:0 is right. +# +# We interpret "implementation changed" in item "1." above as meaning any +# release, ie. the REVISION is incremented every time (if nothing else). +# Even if we thought the code generated will be identical on all systems, +# it's still good to get the shared library filename (like +# libgmpxx.so.3.0.4) incrementing, to make it clear which GMP it's from. + +LIBGMP_LT_CURRENT = 12 +LIBGMP_LT_REVISION = 0 +LIBGMP_LT_AGE = 2 + +LIBGMPXX_LT_CURRENT = 8 +LIBGMPXX_LT_REVISION = 0 +LIBGMPXX_LT_AGE = 4 + + +SUBDIRS = tests mpn mpz mpq mpf printf scanf rand cxx demos tune doc + +EXTRA_DIST = configfsf.guess configfsf.sub .gdbinit INSTALL.autoconf \ + COPYING.LESSERv3 COPYINGv2 COPYINGv3 + + +if WANT_CXX +GMPXX_HEADERS_OPTION = gmpxx.h +endif +EXTRA_DIST += gmpxx.h + +# gmp.h and mp.h are architecture dependent, mainly since they encode the +# limb size used in libgmp. For that reason they belong under $exec_prefix +# not $prefix, strictly speaking. +# +# $exec_prefix/include is not in the default include path for gcc built to +# the same $prefix and $exec_prefix, which might mean gmp.h is not found, +# but anyone knowledgeable enough to be playing with exec_prefix will be able +# to address that. +# +includeexecdir = $(exec_prefix)/include +include_HEADERS = $(GMPXX_HEADERS_OPTION) +nodist_includeexec_HEADERS = gmp.h +lib_LTLIBRARIES = libgmp.la $(GMPXX_LTLIBRARIES_OPTION) + +BUILT_SOURCES = gmp.h + +DISTCLEANFILES = $(BUILT_SOURCES) config.m4 @gmp_srclinks@ + +# Tell gmp.h it's building gmp, not an application, used by windows DLL stuff. +INCLUDES=-D__GMP_WITHIN_GMP + + +MPF_OBJECTS = mpf/init$U.lo mpf/init2$U.lo mpf/inits$U.lo mpf/set$U.lo \ + mpf/set_ui$U.lo mpf/set_si$U.lo mpf/set_str$U.lo mpf/set_d$U.lo \ + mpf/set_z$U.lo mpf/iset$U.lo mpf/iset_ui$U.lo mpf/iset_si$U.lo \ + mpf/iset_str$U.lo mpf/iset_d$U.lo mpf/clear$U.lo mpf/clears$U.lo \ + mpf/get_str$U.lo mpf/dump$U.lo mpf/size$U.lo mpf/eq$U.lo mpf/reldiff$U.lo \ + mpf/sqrt$U.lo mpf/random2$U.lo mpf/inp_str$U.lo mpf/out_str$U.lo \ + mpf/add$U.lo mpf/add_ui$U.lo mpf/sub$U.lo mpf/sub_ui$U.lo mpf/ui_sub$U.lo \ + mpf/mul$U.lo mpf/mul_ui$U.lo mpf/div$U.lo mpf/div_ui$U.lo \ + mpf/cmp$U.lo mpf/cmp_d$U.lo mpf/cmp_ui$U.lo mpf/cmp_si$U.lo \ + mpf/mul_2exp$U.lo mpf/div_2exp$U.lo mpf/abs$U.lo mpf/neg$U.lo \ + mpf/set_q$U.lo mpf/get_d$U.lo mpf/get_d_2exp$U.lo mpf/set_dfl_prec$U.lo \ + mpf/set_prc$U.lo mpf/set_prc_raw$U.lo mpf/get_dfl_prec$U.lo \ + mpf/get_prc$U.lo mpf/ui_div$U.lo mpf/sqrt_ui$U.lo \ + mpf/ceilfloor$U.lo mpf/trunc$U.lo mpf/pow_ui$U.lo \ + mpf/urandomb$U.lo mpf/swap$U.lo \ + mpf/fits_sint$U.lo mpf/fits_slong$U.lo mpf/fits_sshort$U.lo \ + mpf/fits_uint$U.lo mpf/fits_ulong$U.lo mpf/fits_ushort$U.lo \ + mpf/get_si$U.lo mpf/get_ui$U.lo \ + mpf/int_p$U.lo + +MPZ_OBJECTS = mpz/abs$U.lo mpz/add$U.lo mpz/add_ui$U.lo \ + mpz/aorsmul$U.lo mpz/aorsmul_i$U.lo mpz/and$U.lo mpz/array_init$U.lo \ + mpz/bin_ui$U.lo mpz/bin_uiui$U.lo \ + mpz/cdiv_q$U.lo mpz/cdiv_q_ui$U.lo \ + mpz/cdiv_qr$U.lo mpz/cdiv_qr_ui$U.lo \ + mpz/cdiv_r$U.lo mpz/cdiv_r_ui$U.lo mpz/cdiv_ui$U.lo \ + mpz/cfdiv_q_2exp$U.lo mpz/cfdiv_r_2exp$U.lo \ + mpz/clear$U.lo mpz/clears$U.lo mpz/clrbit$U.lo \ + mpz/cmp$U.lo mpz/cmp_d$U.lo mpz/cmp_si$U.lo mpz/cmp_ui$U.lo \ + mpz/cmpabs$U.lo mpz/cmpabs_d$U.lo mpz/cmpabs_ui$U.lo \ + mpz/com$U.lo mpz/combit$U.lo \ + mpz/cong$U.lo mpz/cong_2exp$U.lo mpz/cong_ui$U.lo \ + mpz/divexact$U.lo mpz/divegcd$U.lo mpz/dive_ui$U.lo \ + mpz/divis$U.lo mpz/divis_ui$U.lo mpz/divis_2exp$U.lo mpz/dump$U.lo \ + mpz/export$U.lo mpz/mfac_uiui$U.lo \ + mpz/2fac_ui$U.lo mpz/fac_ui$U.lo mpz/oddfac_1$U.lo mpz/prodlimbs$U.lo \ + mpz/fdiv_q_ui$U.lo mpz/fdiv_qr$U.lo mpz/fdiv_qr_ui$U.lo \ + mpz/fdiv_r$U.lo mpz/fdiv_r_ui$U.lo mpz/fdiv_q$U.lo \ + mpz/fdiv_ui$U.lo mpz/fib_ui$U.lo mpz/fib2_ui$U.lo mpz/fits_sint$U.lo \ + mpz/fits_slong$U.lo mpz/fits_sshort$U.lo mpz/fits_uint$U.lo \ + mpz/fits_ulong$U.lo mpz/fits_ushort$U.lo mpz/gcd$U.lo \ + mpz/gcd_ui$U.lo mpz/gcdext$U.lo mpz/get_d$U.lo mpz/get_d_2exp$U.lo \ + mpz/get_si$U.lo mpz/get_str$U.lo mpz/get_ui$U.lo mpz/getlimbn$U.lo \ + mpz/hamdist$U.lo \ + mpz/import$U.lo mpz/init$U.lo mpz/init2$U.lo mpz/inits$U.lo \ + mpz/inp_raw$U.lo mpz/inp_str$U.lo mpz/invert$U.lo \ + mpz/ior$U.lo mpz/iset$U.lo mpz/iset_d$U.lo mpz/iset_si$U.lo \ + mpz/iset_str$U.lo mpz/iset_ui$U.lo mpz/jacobi$U.lo mpz/kronsz$U.lo \ + mpz/kronuz$U.lo mpz/kronzs$U.lo mpz/kronzu$U.lo \ + mpz/lcm$U.lo mpz/lcm_ui$U.lo mpz/limbs_finish$U.lo \ + mpz/limbs_modify$U.lo mpz/limbs_read$U.lo mpz/limbs_write$U.lo \ + mpz/lucnum_ui$U.lo mpz/lucnum2_ui$U.lo \ + mpz/millerrabin$U.lo mpz/mod$U.lo mpz/mul$U.lo mpz/mul_2exp$U.lo \ + mpz/mul_si$U.lo mpz/mul_ui$U.lo \ + mpz/n_pow_ui$U.lo mpz/neg$U.lo mpz/nextprime$U.lo \ + mpz/out_raw$U.lo mpz/out_str$U.lo mpz/perfpow$U.lo mpz/perfsqr$U.lo \ + mpz/popcount$U.lo mpz/pow_ui$U.lo mpz/powm$U.lo mpz/powm_sec$U.lo \ + mpz/powm_ui$U.lo mpz/primorial_ui$U.lo \ + mpz/pprime_p$U.lo mpz/random$U.lo mpz/random2$U.lo \ + mpz/realloc$U.lo mpz/realloc2$U.lo mpz/remove$U.lo mpz/roinit_n$U.lo \ + mpz/root$U.lo mpz/rootrem$U.lo mpz/rrandomb$U.lo mpz/scan0$U.lo \ + mpz/scan1$U.lo mpz/set$U.lo mpz/set_d$U.lo mpz/set_f$U.lo \ + mpz/set_q$U.lo mpz/set_si$U.lo mpz/set_str$U.lo mpz/set_ui$U.lo \ + mpz/setbit$U.lo \ + mpz/size$U.lo mpz/sizeinbase$U.lo mpz/sqrt$U.lo \ + mpz/sqrtrem$U.lo mpz/sub$U.lo mpz/sub_ui$U.lo mpz/swap$U.lo \ + mpz/tdiv_ui$U.lo mpz/tdiv_q$U.lo mpz/tdiv_q_2exp$U.lo \ + mpz/tdiv_q_ui$U.lo mpz/tdiv_qr$U.lo mpz/tdiv_qr_ui$U.lo \ + mpz/tdiv_r$U.lo mpz/tdiv_r_2exp$U.lo mpz/tdiv_r_ui$U.lo \ + mpz/tstbit$U.lo mpz/ui_pow_ui$U.lo mpz/ui_sub$U.lo mpz/urandomb$U.lo \ + mpz/urandomm$U.lo mpz/xor$U.lo + +MPQ_OBJECTS = mpq/abs$U.lo mpq/aors$U.lo \ + mpq/canonicalize$U.lo mpq/clear$U.lo mpq/clears$U.lo \ + mpq/cmp$U.lo mpq/cmp_si$U.lo mpq/cmp_ui$U.lo mpq/div$U.lo \ + mpq/get_d$U.lo mpq/get_den$U.lo mpq/get_num$U.lo mpq/get_str$U.lo \ + mpq/init$U.lo mpq/inits$U.lo mpq/inp_str$U.lo mpq/inv$U.lo \ + mpq/md_2exp$U.lo mpq/mul$U.lo mpq/neg$U.lo mpq/out_str$U.lo \ + mpq/set$U.lo mpq/set_den$U.lo mpq/set_num$U.lo \ + mpq/set_si$U.lo mpq/set_str$U.lo mpq/set_ui$U.lo \ + mpq/equal$U.lo mpq/set_z$U.lo mpq/set_d$U.lo \ + mpq/set_f$U.lo mpq/swap$U.lo + +MPN_OBJECTS = mpn/fib_table$U.lo mpn/mp_bases$U.lo + +PRINTF_OBJECTS = \ + printf/asprintf$U.lo printf/asprntffuns$U.lo \ + printf/doprnt$U.lo printf/doprntf$U.lo printf/doprnti$U.lo \ + printf/fprintf$U.lo \ + printf/obprintf$U.lo printf/obvprintf$U.lo printf/obprntffuns$U.lo \ + printf/printf$U.lo printf/printffuns$U.lo \ + printf/snprintf$U.lo printf/snprntffuns$U.lo \ + printf/sprintf$U.lo printf/sprintffuns$U.lo \ + printf/vasprintf$U.lo printf/vfprintf$U.lo printf/vprintf$U.lo \ + printf/vsnprintf$U.lo printf/vsprintf$U.lo \ + printf/repl-vsnprintf$U.lo + +SCANF_OBJECTS = \ + scanf/doscan$U.lo scanf/fscanf$U.lo scanf/fscanffuns$U.lo \ + scanf/scanf$U.lo scanf/sscanf$U.lo scanf/sscanffuns$U.lo \ + scanf/vfscanf$U.lo scanf/vscanf$U.lo scanf/vsscanf$U.lo + +RANDOM_OBJECTS = \ + rand/rand$U.lo rand/randclr$U.lo rand/randdef$U.lo rand/randiset$U.lo \ + rand/randlc2s$U.lo rand/randlc2x$U.lo rand/randmt$U.lo \ + rand/randmts$U.lo rand/rands$U.lo rand/randsd$U.lo rand/randsdui$U.lo \ + rand/randbui$U.lo rand/randmui$U.lo + +# no $U for C++ files +CXX_OBJECTS = \ + cxx/isfuns.lo cxx/ismpf.lo cxx/ismpq.lo cxx/ismpz.lo cxx/ismpznw.lo \ + cxx/limits.lo cxx/osdoprnti.lo cxx/osfuns.lo \ + cxx/osmpf.lo cxx/osmpq.lo cxx/osmpz.lo + +# In libtool 1.5 it doesn't work to build libgmp.la from the convenience +# libraries like mpz/libmpz.la. Or rather it works, but it ends up putting +# PIC objects into libgmp.a if shared and static are both built. (The PIC +# objects go into mpz/.libs/libmpz.a, and thence into .libs/libgmp.a.) +# +# For now the big lists of objects above are used. Something like mpz/*.lo +# would probably work, but might risk missing something out or getting +# something extra. The source files for each .lo are listed in the +# Makefile.am's in the subdirectories. +# +# Currently, for libgmp, unlike libmp below, we're not using +# -export-symbols, since the tune and speed programs, and perhaps some of +# the test programs, want to access undocumented symbols. + +libgmp_la_SOURCES = gmp-impl.h longlong.h \ + assert.c compat.c errno.c extract-dbl.c invalid.c memory.c \ + mp_bpl.c mp_clz_tab.c mp_dv_tab.c mp_minv_tab.c mp_get_fns.c mp_set_fns.c \ + version.c nextprime.c primesieve.c +EXTRA_libgmp_la_SOURCES = tal-debug.c tal-notreent.c tal-reent.c +libgmp_la_DEPENDENCIES = @TAL_OBJECT@ \ + $(MPF_OBJECTS) $(MPZ_OBJECTS) $(MPQ_OBJECTS) \ + $(MPN_OBJECTS) @mpn_objs_in_libgmp@ \ + $(PRINTF_OBJECTS) $(SCANF_OBJECTS) $(RANDOM_OBJECTS) +libgmp_la_LIBADD = $(libgmp_la_DEPENDENCIES) +libgmp_la_LDFLAGS = $(GMP_LDFLAGS) $(LIBGMP_LDFLAGS) \ + -version-info $(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE) + + +# We need at least one .cc file in $(libgmpxx_la_SOURCES) so automake will +# use $(CXXLINK) rather than the plain C $(LINK). cxx/dummy.cc is that +# file. + +if WANT_CXX +GMPXX_LTLIBRARIES_OPTION = libgmpxx.la +endif +libgmpxx_la_SOURCES = cxx/dummy.cc +libgmpxx_la_DEPENDENCIES = $(CXX_OBJECTS) libgmp.la +libgmpxx_la_LIBADD = $(libgmpxx_la_DEPENDENCIES) +libgmpxx_la_LDFLAGS = $(GMP_LDFLAGS) $(LIBGMPXX_LDFLAGS) \ + -version-info $(LIBGMPXX_LT_CURRENT):$(LIBGMPXX_LT_REVISION):$(LIBGMPXX_LT_AGE) + + + +install-data-hook: + @echo '' + @echo '+-------------------------------------------------------------+' + @echo '| CAUTION: |' + @echo '| |' + @echo '| If you have not already run "make check", then we strongly |' + @echo '| recommend you do so. |' + @echo '| |' + @echo '| GMP has been carefully tested by its authors, but compilers |' + @echo '| are all too often released with serious bugs. GMP tends to |' + @echo '| explore interesting corners in compilers and has hit bugs |' + @echo '| on quite a few occasions. |' + @echo '| |' + @echo '+-------------------------------------------------------------+' + @echo '' + + +# The "test -f" support for srcdir!=builddir is similar to the automake .c.o +# etc rules, but with each foo.c explicitly, since $< is not portable +# outside an inference rule. +# +# A quoted 'foo.c' is used with the "test -f"'s to avoid Sun make rewriting +# it as part of its VPATH support. See the autoconf manual "Limitations of +# Make". +# +# Generated .h files which are used by gmp-impl.h are BUILT_SOURCES since +# they must exist before anything can be compiled. +# +# Other generated .h files are also BUILT_SOURCES so as to get all the +# build-system stuff over and done with at the start. Also, dependencies on +# the .h files are not properly expressed for the various objects that use +# them. + +EXTRA_DIST += bootstrap.c + +fac_table.h: gen-fac$(EXEEXT_FOR_BUILD) + ./gen-fac $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >fac_table.h || (rm -f fac_table.h; exit 1) +BUILT_SOURCES += fac_table.h + +gen-fac$(EXEEXT_FOR_BUILD): gen-fac$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-fac$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-fac$(U_FOR_BUILD).c -o gen-fac$(EXEEXT_FOR_BUILD) +DISTCLEANFILES += gen-fac$(EXEEXT_FOR_BUILD) +EXTRA_DIST += gen-fac.c + + +fib_table.h: gen-fib$(EXEEXT_FOR_BUILD) + ./gen-fib header $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >fib_table.h || (rm -f fib_table.h; exit 1) +BUILT_SOURCES += fib_table.h + +mpn/fib_table.c: gen-fib$(EXEEXT_FOR_BUILD) + ./gen-fib table $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mpn/fib_table.c || (rm -f mpn/fib_table.c; exit 1) +BUILT_SOURCES += mpn/fib_table.c + +gen-fib$(EXEEXT_FOR_BUILD): gen-fib$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-fib$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-fib$(U_FOR_BUILD).c -o gen-fib$(EXEEXT_FOR_BUILD) +DISTCLEANFILES += gen-fib$(EXEEXT_FOR_BUILD) +EXTRA_DIST += gen-fib.c + + +mp_bases.h: gen-bases$(EXEEXT_FOR_BUILD) + ./gen-bases header $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mp_bases.h || (rm -f mp_bases.h; exit 1) +BUILT_SOURCES += mp_bases.h + +mpn/mp_bases.c: gen-bases$(EXEEXT_FOR_BUILD) + ./gen-bases table $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mpn/mp_bases.c || (rm -f mpn/mp_bases.c; exit 1) +BUILT_SOURCES += mpn/mp_bases.c + +gen-bases$(EXEEXT_FOR_BUILD): gen-bases$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-bases$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-bases$(U_FOR_BUILD).c -o gen-bases$(EXEEXT_FOR_BUILD) $(LIBM_FOR_BUILD) +DISTCLEANFILES += gen-bases$(EXEEXT_FOR_BUILD) +EXTRA_DIST += gen-bases.c + + +trialdivtab.h: gen-trialdivtab$(EXEEXT_FOR_BUILD) + ./gen-trialdivtab $(GMP_LIMB_BITS) 8000 >trialdivtab.h || (rm -f trialdivtab.h; exit 1) +BUILT_SOURCES += trialdivtab.h + +gen-trialdivtab$(EXEEXT_FOR_BUILD): gen-trialdivtab$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-trialdivtab$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-trialdivtab$(U_FOR_BUILD).c -o gen-trialdivtab$(EXEEXT_FOR_BUILD) $(LIBM_FOR_BUILD) +DISTCLEANFILES += gen-trialdivtab$(EXEEXT_FOR_BUILD) +EXTRA_DIST += gen-trialdivtab.c + + +mpn/jacobitab.h: gen-jacobitab$(EXEEXT_FOR_BUILD) + ./gen-jacobitab >mpn/jacobitab.h || (rm -f mpn/jacobitab.h; exit 1) +BUILT_SOURCES += mpn/jacobitab.h + +gen-jacobitab$(EXEEXT_FOR_BUILD): gen-jacobitab$(U_FOR_BUILD).c + $(CC_FOR_BUILD) `test -f 'gen-jacobitab$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-jacobitab$(U_FOR_BUILD).c -o gen-jacobitab$(EXEEXT_FOR_BUILD) +DISTCLEANFILES += gen-jacobitab$(EXEEXT_FOR_BUILD) +EXTRA_DIST += gen-jacobitab.c + + +mpn/perfsqr.h: gen-psqr$(EXEEXT_FOR_BUILD) + ./gen-psqr $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mpn/perfsqr.h || (rm -f mpn/perfsqr.h; exit 1) +BUILT_SOURCES += mpn/perfsqr.h + +gen-psqr$(EXEEXT_FOR_BUILD): gen-psqr$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-psqr$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-psqr$(U_FOR_BUILD).c -o gen-psqr$(EXEEXT_FOR_BUILD) $(LIBM_FOR_BUILD) +DISTCLEANFILES += gen-psqr$(EXEEXT_FOR_BUILD) +EXTRA_DIST += gen-psqr.c + +# Distribute mini-gmp. Test sources copied by dist-hook. +EXTRA_DIST += mini-gmp/README mini-gmp/mini-gmp.c mini-gmp/mini-gmp.h \ + mini-gmp/tests/Makefile mini-gmp/tests/run-tests + +# Avoid: CVS - cvs directories +# *~ - emacs backups +# .#* - cvs merge originals +# +# *~ and .#* only occur when a whole directory without it's own Makefile.am +# is distributed, like "doc" or the mpn cpu subdirectories. +# +dist-hook: + -find $(distdir) \( -name CVS -type d \) -o -name "*~" -o -name ".#*" \ + | xargs rm -rf + cp "$(srcdir)"/mini-gmp/tests/*.[ch] "$(distdir)/mini-gmp/tests" +# grep -F $(VERSION) $(srcdir)/Makefile.am \ +# | grep -q "^# *$(VERSION) *$(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE) *$(LIBGMPXX_LT_CURRENT):$(LIBGMPXX_LT_REVISION):$(LIBGMPXX_LT_AGE)" +# test -z "`sed -n 's/^# *[0-9]*\.[0-9]*\.[0-9]* *\([0-9]*:[0-9]*:[0-9]*\) *\([0-9]*:[0-9]*:[0-9]*\) *\([0-9]*:[0-9]*:[0-9]*\).*/A\1\nB\2\nC\3/p' $(srcdir)/Makefile.am | grep -v 'A6:3:3\|B3:5:0\|C4:7:1' | sort | uniq -d`" + +.PHONY: check-mini-gmp clean-mini-gmp + +check-mini-gmp: + abs_srcdir="`cd $(srcdir) && pwd`" ; \ + $(MKDIR_P) mini-gmp/tests \ + && cd mini-gmp/tests \ + && LD_LIBRARY_PATH="../../.libs:$$LD_LIBRARY_PATH" \ + DYLD_LIBRARY_PATH="../../.libs:$$DYLD_LIBRARY_PATH" \ + $(MAKE) -f "$$abs_srcdir/mini-gmp/tests/Makefile" \ + VPATH="$$abs_srcdir/mini-gmp/tests" \ + srcdir="$$abs_srcdir/mini-gmp/tests" \ + MINI_GMP_DIR="$$abs_srcdir/mini-gmp" \ + LDFLAGS="-L../../.libs" \ + LIBS="-lgmp -lm" \ + CC="$(CC_FOR_BUILD)" EXTRA_CFLAGS="-g -I../.." check + +clean-mini-gmp: + if [ -d mini-gmp/tests ] ; then \ + abs_srcdir="`cd $(srcdir) && pwd`" ; \ + cd mini-gmp/tests \ + && $(MAKE) -f "$$abs_srcdir/mini-gmp/tests/Makefile" clean ; \ + fi + +clean-local: clean-mini-gmp +distclean-local: clean-mini-gmp diff --git a/gmp4/Makefile.in b/gmp4/Makefile.in new file mode 100644 index 0000000..001ae3b --- /dev/null +++ b/gmp4/Makefile.in @@ -0,0 +1,1476 @@ +# Makefile.in generated by automake 1.14.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# Copyright 1991, 1993, 1994, 1996, 1997, 1999-2004, 2006-2009, 2011-2014 Free +# Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * the GNU Lesser General Public License as published by the Free +# Software Foundation; either version 3 of the License, or (at your +# option) any later version. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP Library 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 copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + +# The following options are the same as AM_INIT_AUTOMAKE in configure.in, +# except no $(top_builddir) on ansi2knr. That directory is wanted for the +# Makefiles in subdirectories, but here we must omit it so automake gives +# the actual ansi2knr build rule, not "cd $(top_builddir) && make ansi2knr". +# +# AUTOMAKE_OPTIONS = 1.8 gnu no-dependencies + +# Libtool -version-info for libgmp.la and libmp.la. See "Versioning" in the +# libtool manual. +# +# CURRENT:REVISION:AGE +# +# 1. No interfaces changed, only implementations (good): Increment REVISION. +# +# 2. Interfaces added, none removed (good): Increment CURRENT, increment +# AGE, set REVISION to 0. +# +# 3. Interfaces removed (BAD, breaks upward compatibility): Increment +# CURRENT, set AGE and REVISION to 0. +# +# Do this separately for libgmp, libgmpxx and libmp, and only for releases. +# +# GMP -version-info +# release libgmp libgmpxx libmp +# 2.0.x - - - +# 3.0 3:0:0 - 3:0:0 +# 3.0.1 3:1:0 - 3:0:0 +# 3.1 4:0:1 - 4:0:1 +# 3.1.1 4:1:1 - 4:1:1 +# 4.0 5:0:2 3:0:0 4:2:1 +# 4.0.1 5:1:2 3:1:0 4:3:1 +# 4.1 6:0:3 3:2:0 4:4:1 +# 4.1.1 6:1:3 3:3:0 4:5:1 +# 4.1.2 6:2:3 3:4:0 4:6:1 +# 4.1.3 6:3:3 3:5:0 4:7:1 +# 4.1.4 6:3:3 3:5:0 4:7:1 WRONG, same as 4.1.3! +# 4.2 6:0:3 3:2:0 4:4:1 REALLY WRONG, same as 4.1! +# 4.2.1 7:1:4 4:1:1 4:10:1 WRONG for libgmpxx +# 4.2.2 7:2:4 4:2:0 4:11:1 +# 4.2.3 7:3:4 4:3:0 4:12:1 +# 4.2.4 7:4:4 4:4:0 4:13:1 +# 4.3.0 8:0:5 5:0:1 4:14:1 +# 4.3.1 8:1:5 5:1:1 4:15:1 WRONG Really used same as 4.3.0 +# 4.3.2 8:2:5 5:2:1 4:16:1 +# 5.0.0 9:0:6 6:0:2 4:20:1 Should have been 10:0:0 +# 5.0.1 10:1:0 6:1:2 4:21:1 +# 5.0.2 10:2:0 6:2:2 4:22:1 +# 5.0.3 10:3:0 6:3:2 4:23:1 +# 5.0.4 10:4:0 6:4:2 4:24:1 +# 5.0.5 10:5:0 6:5:2 4:25:1 +# 5.1.0 11:0:1 7:0:3 - +# 5.1.1 11:1:1 7:1:3 - +# 5.1.2 11:2:1 7:2:3 - +# 6.0.0 12:0:2 8:0:4 - +# +# Starting at 3:0:0 is a slight abuse of the versioning system, but it +# ensures we're past soname libgmp.so.2, which was used on Debian GNU/Linux +# packages of gmp 2. Pretend gmp 2 was 2:0:0, so the interface changes for +# gmp 3 mean 3:0:0 is right. +# +# We interpret "implementation changed" in item "1." above as meaning any +# release, ie. the REVISION is incremented every time (if nothing else). +# Even if we thought the code generated will be identical on all systems, +# it's still good to get the shared library filename (like +# libgmpxx.so.3.0.4) incrementing, to make it clear which GMP it's from. + + +VPATH = @srcdir@ +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = . +DIST_COMMON = INSTALL NEWS README AUTHORS ChangeLog \ + $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/configure $(am__configure_deps) \ + $(srcdir)/config.in $(srcdir)/gmp-h.in \ + $(am__include_HEADERS_DIST) COPYING compile config.guess \ + config.sub install-sh missing ylwrap ltmain.sh +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ + configure.lineno config.status.lineno +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = config.h +CONFIG_CLEAN_FILES = gmp.h gmp-mparam.h +CONFIG_CLEAN_VPATH_FILES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__uninstall_files_from_dir = { \ + test -z "$$files" \ + || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ + || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ + $(am__cd) "$$dir" && rm -f $$files; }; \ + } +am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(includedir)" \ + "$(DESTDIR)$(includeexecdir)" +LTLIBRARIES = $(lib_LTLIBRARIES) +am__DEPENDENCIES_1 = $(MPF_OBJECTS) $(MPZ_OBJECTS) $(MPQ_OBJECTS) \ + $(MPN_OBJECTS) $(PRINTF_OBJECTS) $(SCANF_OBJECTS) \ + $(RANDOM_OBJECTS) +am_libgmp_la_OBJECTS = assert.lo compat.lo errno.lo extract-dbl.lo \ + invalid.lo memory.lo mp_bpl.lo mp_clz_tab.lo mp_dv_tab.lo \ + mp_minv_tab.lo mp_get_fns.lo mp_set_fns.lo version.lo \ + nextprime.lo primesieve.lo +libgmp_la_OBJECTS = $(am_libgmp_la_OBJECTS) +AM_V_lt = $(am__v_lt_@AM_V@) +am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) +am__v_lt_0 = --silent +am__v_lt_1 = +libgmp_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(libgmp_la_LDFLAGS) $(LDFLAGS) -o $@ +am_libgmpxx_la_OBJECTS = dummy.lo +libgmpxx_la_OBJECTS = $(am_libgmpxx_la_OBJECTS) +libgmpxx_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \ + $(CXXFLAGS) $(libgmpxx_la_LDFLAGS) $(LDFLAGS) -o $@ +@WANT_CXX_TRUE@am_libgmpxx_la_rpath = -rpath $(libdir) +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ +depcomp = +am__depfiles_maybe = +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) +LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CXXFLAGS) $(CXXFLAGS) +AM_V_CXX = $(am__v_CXX_@AM_V@) +am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@) +am__v_CXX_0 = @echo " CXX " $@; +am__v_CXX_1 = +CXXLD = $(CXX) +CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \ + $(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CXXLD = $(am__v_CXXLD_@AM_V@) +am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@) +am__v_CXXLD_0 = @echo " CXXLD " $@; +am__v_CXXLD_1 = +SOURCES = $(libgmp_la_SOURCES) $(EXTRA_libgmp_la_SOURCES) \ + $(libgmpxx_la_SOURCES) +DIST_SOURCES = $(libgmp_la_SOURCES) $(EXTRA_libgmp_la_SOURCES) \ + $(libgmpxx_la_SOURCES) +RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \ + ctags-recursive dvi-recursive html-recursive info-recursive \ + install-data-recursive install-dvi-recursive \ + install-exec-recursive install-html-recursive \ + install-info-recursive install-pdf-recursive \ + install-ps-recursive install-recursive installcheck-recursive \ + installdirs-recursive pdf-recursive ps-recursive \ + tags-recursive uninstall-recursive +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__include_HEADERS_DIST = gmpxx.h +HEADERS = $(include_HEADERS) $(nodist_includeexec_HEADERS) +RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \ + distclean-recursive maintainer-clean-recursive +am__recursive_targets = \ + $(RECURSIVE_TARGETS) \ + $(RECURSIVE_CLEAN_TARGETS) \ + $(am__extra_recursive_targets) +AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \ + cscope distdir dist dist-all distcheck +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \ + $(LISP)config.in +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +CSCOPE = cscope +DIST_SUBDIRS = $(SUBDIRS) +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +distdir = $(PACKAGE)-$(VERSION) +top_distdir = $(distdir) +am__remove_distdir = \ + if test -d "$(distdir)"; then \ + find "$(distdir)" -type d ! -perm -200 -exec chmod u+w {} ';' \ + && rm -rf "$(distdir)" \ + || { sleep 5 && rm -rf "$(distdir)"; }; \ + else :; fi +am__post_remove_distdir = $(am__remove_distdir) +am__relativize = \ + dir0=`pwd`; \ + sed_first='s,^\([^/]*\)/.*$$,\1,'; \ + sed_rest='s,^[^/]*/*,,'; \ + sed_last='s,^.*/\([^/]*\)$$,\1,'; \ + sed_butlast='s,/*[^/]*$$,,'; \ + while test -n "$$dir1"; do \ + first=`echo "$$dir1" | sed -e "$$sed_first"`; \ + if test "$$first" != "."; then \ + if test "$$first" = ".."; then \ + dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \ + dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \ + else \ + first2=`echo "$$dir2" | sed -e "$$sed_first"`; \ + if test "$$first2" = "$$first"; then \ + dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \ + else \ + dir2="../$$dir2"; \ + fi; \ + dir0="$$dir0"/"$$first"; \ + fi; \ + fi; \ + dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \ + done; \ + reldir="$$dir2" +DIST_ARCHIVES = $(distdir).tar.gz +GZIP_ENV = --best +DIST_TARGETS = dist-gzip +distuninstallcheck_listfiles = find . -type f -print +am__distuninstallcheck_listfiles = $(distuninstallcheck_listfiles) \ + | sed 's|^\./|$(prefix)/|' | grep -v '$(infodir)/dir$$' +distcleancheck_listfiles = find . -type f -print +ABI = @ABI@ +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AS = @AS@ +ASMFLAGS = @ASMFLAGS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@ +CC = @CC@ +CCAS = @CCAS@ +CC_FOR_BUILD = @CC_FOR_BUILD@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CPP_FOR_BUILD = @CPP_FOR_BUILD@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXFLAGS = @CXXFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFN_LONG_LONG_LIMB = @DEFN_LONG_LONG_LIMB@ +DEFS = @DEFS@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +EXEEXT_FOR_BUILD = @EXEEXT_FOR_BUILD@ +FGREP = @FGREP@ +GMP_LDFLAGS = @GMP_LDFLAGS@ +GMP_LIMB_BITS = @GMP_LIMB_BITS@ +GMP_NAIL_BITS = @GMP_NAIL_BITS@ +GREP = @GREP@ +HAVE_CLOCK_01 = @HAVE_CLOCK_01@ +HAVE_CPUTIME_01 = @HAVE_CPUTIME_01@ +HAVE_GETRUSAGE_01 = @HAVE_GETRUSAGE_01@ +HAVE_GETTIMEOFDAY_01 = @HAVE_GETTIMEOFDAY_01@ +HAVE_HOST_CPU_FAMILY_power = @HAVE_HOST_CPU_FAMILY_power@ +HAVE_HOST_CPU_FAMILY_powerpc = @HAVE_HOST_CPU_FAMILY_powerpc@ +HAVE_SIGACTION_01 = @HAVE_SIGACTION_01@ +HAVE_SIGALTSTACK_01 = @HAVE_SIGALTSTACK_01@ +HAVE_SIGSTACK_01 = @HAVE_SIGSTACK_01@ +HAVE_STACK_T_01 = @HAVE_STACK_T_01@ +HAVE_SYS_RESOURCE_H_01 = @HAVE_SYS_RESOURCE_H_01@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LEX = @LEX@ +LEXLIB = @LEXLIB@ +LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ +LIBCURSES = @LIBCURSES@ +LIBGMPXX_LDFLAGS = @LIBGMPXX_LDFLAGS@ +LIBGMP_DLL = @LIBGMP_DLL@ +LIBGMP_LDFLAGS = @LIBGMP_LDFLAGS@ +LIBM = @LIBM@ +LIBM_FOR_BUILD = @LIBM_FOR_BUILD@ +LIBOBJS = @LIBOBJS@ +LIBREADLINE = @LIBREADLINE@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +M4 = @M4@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SPEED_CYCLECOUNTER_OBJ = @SPEED_CYCLECOUNTER_OBJ@ +STRIP = @STRIP@ +TAL_OBJECT = @TAL_OBJECT@ +TUNE_LIBS = @TUNE_LIBS@ +TUNE_SQR_OBJ = @TUNE_SQR_OBJ@ +U_FOR_BUILD = @U_FOR_BUILD@ +VERSION = @VERSION@ +WITH_READLINE_01 = @WITH_READLINE_01@ +YACC = @YACC@ +YFLAGS = @YFLAGS@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +am__leading_dot = @am__leading_dot@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +gmp_srclinks = @gmp_srclinks@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +mpn_objects = @mpn_objects@ +mpn_objs_in_libgmp = @mpn_objs_in_libgmp@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +LIBGMP_LT_CURRENT = 12 +LIBGMP_LT_REVISION = 0 +LIBGMP_LT_AGE = 2 +LIBGMPXX_LT_CURRENT = 8 +LIBGMPXX_LT_REVISION = 0 +LIBGMPXX_LT_AGE = 4 +SUBDIRS = tests mpn mpz mpq mpf printf scanf rand cxx demos tune doc + +# The "test -f" support for srcdir!=builddir is similar to the automake .c.o +# etc rules, but with each foo.c explicitly, since $< is not portable +# outside an inference rule. +# +# A quoted 'foo.c' is used with the "test -f"'s to avoid Sun make rewriting +# it as part of its VPATH support. See the autoconf manual "Limitations of +# Make". +# +# Generated .h files which are used by gmp-impl.h are BUILT_SOURCES since +# they must exist before anything can be compiled. +# +# Other generated .h files are also BUILT_SOURCES so as to get all the +# build-system stuff over and done with at the start. Also, dependencies on +# the .h files are not properly expressed for the various objects that use +# them. + +# Distribute mini-gmp. Test sources copied by dist-hook. +EXTRA_DIST = configfsf.guess configfsf.sub .gdbinit INSTALL.autoconf \ + COPYING.LESSERv3 COPYINGv2 COPYINGv3 gmpxx.h bootstrap.c \ + gen-fac.c gen-fib.c gen-bases.c gen-trialdivtab.c \ + gen-jacobitab.c gen-psqr.c mini-gmp/README mini-gmp/mini-gmp.c \ + mini-gmp/mini-gmp.h mini-gmp/tests/Makefile \ + mini-gmp/tests/run-tests +@WANT_CXX_TRUE@GMPXX_HEADERS_OPTION = gmpxx.h + +# gmp.h and mp.h are architecture dependent, mainly since they encode the +# limb size used in libgmp. For that reason they belong under $exec_prefix +# not $prefix, strictly speaking. +# +# $exec_prefix/include is not in the default include path for gcc built to +# the same $prefix and $exec_prefix, which might mean gmp.h is not found, +# but anyone knowledgeable enough to be playing with exec_prefix will be able +# to address that. +# +includeexecdir = $(exec_prefix)/include +include_HEADERS = $(GMPXX_HEADERS_OPTION) +nodist_includeexec_HEADERS = gmp.h +lib_LTLIBRARIES = libgmp.la $(GMPXX_LTLIBRARIES_OPTION) +BUILT_SOURCES = gmp.h fac_table.h fib_table.h mpn/fib_table.c \ + mp_bases.h mpn/mp_bases.c trialdivtab.h mpn/jacobitab.h \ + mpn/perfsqr.h +DISTCLEANFILES = $(BUILT_SOURCES) config.m4 @gmp_srclinks@ \ + gen-fac$(EXEEXT_FOR_BUILD) gen-fib$(EXEEXT_FOR_BUILD) \ + gen-bases$(EXEEXT_FOR_BUILD) \ + gen-trialdivtab$(EXEEXT_FOR_BUILD) \ + gen-jacobitab$(EXEEXT_FOR_BUILD) gen-psqr$(EXEEXT_FOR_BUILD) + +# Tell gmp.h it's building gmp, not an application, used by windows DLL stuff. +INCLUDES = -D__GMP_WITHIN_GMP +MPF_OBJECTS = mpf/init$U.lo mpf/init2$U.lo mpf/inits$U.lo mpf/set$U.lo \ + mpf/set_ui$U.lo mpf/set_si$U.lo mpf/set_str$U.lo mpf/set_d$U.lo \ + mpf/set_z$U.lo mpf/iset$U.lo mpf/iset_ui$U.lo mpf/iset_si$U.lo \ + mpf/iset_str$U.lo mpf/iset_d$U.lo mpf/clear$U.lo mpf/clears$U.lo \ + mpf/get_str$U.lo mpf/dump$U.lo mpf/size$U.lo mpf/eq$U.lo mpf/reldiff$U.lo \ + mpf/sqrt$U.lo mpf/random2$U.lo mpf/inp_str$U.lo mpf/out_str$U.lo \ + mpf/add$U.lo mpf/add_ui$U.lo mpf/sub$U.lo mpf/sub_ui$U.lo mpf/ui_sub$U.lo \ + mpf/mul$U.lo mpf/mul_ui$U.lo mpf/div$U.lo mpf/div_ui$U.lo \ + mpf/cmp$U.lo mpf/cmp_d$U.lo mpf/cmp_ui$U.lo mpf/cmp_si$U.lo \ + mpf/mul_2exp$U.lo mpf/div_2exp$U.lo mpf/abs$U.lo mpf/neg$U.lo \ + mpf/set_q$U.lo mpf/get_d$U.lo mpf/get_d_2exp$U.lo mpf/set_dfl_prec$U.lo \ + mpf/set_prc$U.lo mpf/set_prc_raw$U.lo mpf/get_dfl_prec$U.lo \ + mpf/get_prc$U.lo mpf/ui_div$U.lo mpf/sqrt_ui$U.lo \ + mpf/ceilfloor$U.lo mpf/trunc$U.lo mpf/pow_ui$U.lo \ + mpf/urandomb$U.lo mpf/swap$U.lo \ + mpf/fits_sint$U.lo mpf/fits_slong$U.lo mpf/fits_sshort$U.lo \ + mpf/fits_uint$U.lo mpf/fits_ulong$U.lo mpf/fits_ushort$U.lo \ + mpf/get_si$U.lo mpf/get_ui$U.lo \ + mpf/int_p$U.lo + +MPZ_OBJECTS = mpz/abs$U.lo mpz/add$U.lo mpz/add_ui$U.lo \ + mpz/aorsmul$U.lo mpz/aorsmul_i$U.lo mpz/and$U.lo mpz/array_init$U.lo \ + mpz/bin_ui$U.lo mpz/bin_uiui$U.lo \ + mpz/cdiv_q$U.lo mpz/cdiv_q_ui$U.lo \ + mpz/cdiv_qr$U.lo mpz/cdiv_qr_ui$U.lo \ + mpz/cdiv_r$U.lo mpz/cdiv_r_ui$U.lo mpz/cdiv_ui$U.lo \ + mpz/cfdiv_q_2exp$U.lo mpz/cfdiv_r_2exp$U.lo \ + mpz/clear$U.lo mpz/clears$U.lo mpz/clrbit$U.lo \ + mpz/cmp$U.lo mpz/cmp_d$U.lo mpz/cmp_si$U.lo mpz/cmp_ui$U.lo \ + mpz/cmpabs$U.lo mpz/cmpabs_d$U.lo mpz/cmpabs_ui$U.lo \ + mpz/com$U.lo mpz/combit$U.lo \ + mpz/cong$U.lo mpz/cong_2exp$U.lo mpz/cong_ui$U.lo \ + mpz/divexact$U.lo mpz/divegcd$U.lo mpz/dive_ui$U.lo \ + mpz/divis$U.lo mpz/divis_ui$U.lo mpz/divis_2exp$U.lo mpz/dump$U.lo \ + mpz/export$U.lo mpz/mfac_uiui$U.lo \ + mpz/2fac_ui$U.lo mpz/fac_ui$U.lo mpz/oddfac_1$U.lo mpz/prodlimbs$U.lo \ + mpz/fdiv_q_ui$U.lo mpz/fdiv_qr$U.lo mpz/fdiv_qr_ui$U.lo \ + mpz/fdiv_r$U.lo mpz/fdiv_r_ui$U.lo mpz/fdiv_q$U.lo \ + mpz/fdiv_ui$U.lo mpz/fib_ui$U.lo mpz/fib2_ui$U.lo mpz/fits_sint$U.lo \ + mpz/fits_slong$U.lo mpz/fits_sshort$U.lo mpz/fits_uint$U.lo \ + mpz/fits_ulong$U.lo mpz/fits_ushort$U.lo mpz/gcd$U.lo \ + mpz/gcd_ui$U.lo mpz/gcdext$U.lo mpz/get_d$U.lo mpz/get_d_2exp$U.lo \ + mpz/get_si$U.lo mpz/get_str$U.lo mpz/get_ui$U.lo mpz/getlimbn$U.lo \ + mpz/hamdist$U.lo \ + mpz/import$U.lo mpz/init$U.lo mpz/init2$U.lo mpz/inits$U.lo \ + mpz/inp_raw$U.lo mpz/inp_str$U.lo mpz/invert$U.lo \ + mpz/ior$U.lo mpz/iset$U.lo mpz/iset_d$U.lo mpz/iset_si$U.lo \ + mpz/iset_str$U.lo mpz/iset_ui$U.lo mpz/jacobi$U.lo mpz/kronsz$U.lo \ + mpz/kronuz$U.lo mpz/kronzs$U.lo mpz/kronzu$U.lo \ + mpz/lcm$U.lo mpz/lcm_ui$U.lo mpz/limbs_finish$U.lo \ + mpz/limbs_modify$U.lo mpz/limbs_read$U.lo mpz/limbs_write$U.lo \ + mpz/lucnum_ui$U.lo mpz/lucnum2_ui$U.lo \ + mpz/millerrabin$U.lo mpz/mod$U.lo mpz/mul$U.lo mpz/mul_2exp$U.lo \ + mpz/mul_si$U.lo mpz/mul_ui$U.lo \ + mpz/n_pow_ui$U.lo mpz/neg$U.lo mpz/nextprime$U.lo \ + mpz/out_raw$U.lo mpz/out_str$U.lo mpz/perfpow$U.lo mpz/perfsqr$U.lo \ + mpz/popcount$U.lo mpz/pow_ui$U.lo mpz/powm$U.lo mpz/powm_sec$U.lo \ + mpz/powm_ui$U.lo mpz/primorial_ui$U.lo \ + mpz/pprime_p$U.lo mpz/random$U.lo mpz/random2$U.lo \ + mpz/realloc$U.lo mpz/realloc2$U.lo mpz/remove$U.lo mpz/roinit_n$U.lo \ + mpz/root$U.lo mpz/rootrem$U.lo mpz/rrandomb$U.lo mpz/scan0$U.lo \ + mpz/scan1$U.lo mpz/set$U.lo mpz/set_d$U.lo mpz/set_f$U.lo \ + mpz/set_q$U.lo mpz/set_si$U.lo mpz/set_str$U.lo mpz/set_ui$U.lo \ + mpz/setbit$U.lo \ + mpz/size$U.lo mpz/sizeinbase$U.lo mpz/sqrt$U.lo \ + mpz/sqrtrem$U.lo mpz/sub$U.lo mpz/sub_ui$U.lo mpz/swap$U.lo \ + mpz/tdiv_ui$U.lo mpz/tdiv_q$U.lo mpz/tdiv_q_2exp$U.lo \ + mpz/tdiv_q_ui$U.lo mpz/tdiv_qr$U.lo mpz/tdiv_qr_ui$U.lo \ + mpz/tdiv_r$U.lo mpz/tdiv_r_2exp$U.lo mpz/tdiv_r_ui$U.lo \ + mpz/tstbit$U.lo mpz/ui_pow_ui$U.lo mpz/ui_sub$U.lo mpz/urandomb$U.lo \ + mpz/urandomm$U.lo mpz/xor$U.lo + +MPQ_OBJECTS = mpq/abs$U.lo mpq/aors$U.lo \ + mpq/canonicalize$U.lo mpq/clear$U.lo mpq/clears$U.lo \ + mpq/cmp$U.lo mpq/cmp_si$U.lo mpq/cmp_ui$U.lo mpq/div$U.lo \ + mpq/get_d$U.lo mpq/get_den$U.lo mpq/get_num$U.lo mpq/get_str$U.lo \ + mpq/init$U.lo mpq/inits$U.lo mpq/inp_str$U.lo mpq/inv$U.lo \ + mpq/md_2exp$U.lo mpq/mul$U.lo mpq/neg$U.lo mpq/out_str$U.lo \ + mpq/set$U.lo mpq/set_den$U.lo mpq/set_num$U.lo \ + mpq/set_si$U.lo mpq/set_str$U.lo mpq/set_ui$U.lo \ + mpq/equal$U.lo mpq/set_z$U.lo mpq/set_d$U.lo \ + mpq/set_f$U.lo mpq/swap$U.lo + +MPN_OBJECTS = mpn/fib_table$U.lo mpn/mp_bases$U.lo +PRINTF_OBJECTS = \ + printf/asprintf$U.lo printf/asprntffuns$U.lo \ + printf/doprnt$U.lo printf/doprntf$U.lo printf/doprnti$U.lo \ + printf/fprintf$U.lo \ + printf/obprintf$U.lo printf/obvprintf$U.lo printf/obprntffuns$U.lo \ + printf/printf$U.lo printf/printffuns$U.lo \ + printf/snprintf$U.lo printf/snprntffuns$U.lo \ + printf/sprintf$U.lo printf/sprintffuns$U.lo \ + printf/vasprintf$U.lo printf/vfprintf$U.lo printf/vprintf$U.lo \ + printf/vsnprintf$U.lo printf/vsprintf$U.lo \ + printf/repl-vsnprintf$U.lo + +SCANF_OBJECTS = \ + scanf/doscan$U.lo scanf/fscanf$U.lo scanf/fscanffuns$U.lo \ + scanf/scanf$U.lo scanf/sscanf$U.lo scanf/sscanffuns$U.lo \ + scanf/vfscanf$U.lo scanf/vscanf$U.lo scanf/vsscanf$U.lo + +RANDOM_OBJECTS = \ + rand/rand$U.lo rand/randclr$U.lo rand/randdef$U.lo rand/randiset$U.lo \ + rand/randlc2s$U.lo rand/randlc2x$U.lo rand/randmt$U.lo \ + rand/randmts$U.lo rand/rands$U.lo rand/randsd$U.lo rand/randsdui$U.lo \ + rand/randbui$U.lo rand/randmui$U.lo + + +# no $U for C++ files +CXX_OBJECTS = \ + cxx/isfuns.lo cxx/ismpf.lo cxx/ismpq.lo cxx/ismpz.lo cxx/ismpznw.lo \ + cxx/limits.lo cxx/osdoprnti.lo cxx/osfuns.lo \ + cxx/osmpf.lo cxx/osmpq.lo cxx/osmpz.lo + + +# In libtool 1.5 it doesn't work to build libgmp.la from the convenience +# libraries like mpz/libmpz.la. Or rather it works, but it ends up putting +# PIC objects into libgmp.a if shared and static are both built. (The PIC +# objects go into mpz/.libs/libmpz.a, and thence into .libs/libgmp.a.) +# +# For now the big lists of objects above are used. Something like mpz/*.lo +# would probably work, but might risk missing something out or getting +# something extra. The source files for each .lo are listed in the +# Makefile.am's in the subdirectories. +# +# Currently, for libgmp, unlike libmp below, we're not using +# -export-symbols, since the tune and speed programs, and perhaps some of +# the test programs, want to access undocumented symbols. +libgmp_la_SOURCES = gmp-impl.h longlong.h \ + assert.c compat.c errno.c extract-dbl.c invalid.c memory.c \ + mp_bpl.c mp_clz_tab.c mp_dv_tab.c mp_minv_tab.c mp_get_fns.c mp_set_fns.c \ + version.c nextprime.c primesieve.c + +EXTRA_libgmp_la_SOURCES = tal-debug.c tal-notreent.c tal-reent.c +libgmp_la_DEPENDENCIES = @TAL_OBJECT@ \ + $(MPF_OBJECTS) $(MPZ_OBJECTS) $(MPQ_OBJECTS) \ + $(MPN_OBJECTS) @mpn_objs_in_libgmp@ \ + $(PRINTF_OBJECTS) $(SCANF_OBJECTS) $(RANDOM_OBJECTS) + +libgmp_la_LIBADD = $(libgmp_la_DEPENDENCIES) +libgmp_la_LDFLAGS = $(GMP_LDFLAGS) $(LIBGMP_LDFLAGS) \ + -version-info $(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE) + + +# We need at least one .cc file in $(libgmpxx_la_SOURCES) so automake will +# use $(CXXLINK) rather than the plain C $(LINK). cxx/dummy.cc is that +# file. +@WANT_CXX_TRUE@GMPXX_LTLIBRARIES_OPTION = libgmpxx.la +libgmpxx_la_SOURCES = cxx/dummy.cc +libgmpxx_la_DEPENDENCIES = $(CXX_OBJECTS) libgmp.la +libgmpxx_la_LIBADD = $(libgmpxx_la_DEPENDENCIES) +libgmpxx_la_LDFLAGS = $(GMP_LDFLAGS) $(LIBGMPXX_LDFLAGS) \ + -version-info $(LIBGMPXX_LT_CURRENT):$(LIBGMPXX_LT_REVISION):$(LIBGMPXX_LT_AGE) + +all: $(BUILT_SOURCES) config.h + $(MAKE) $(AM_MAKEFLAGS) all-recursive + +.SUFFIXES: +.SUFFIXES: .c .cc .lo .o .obj +am--refresh: Makefile + @: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + echo ' cd $(srcdir) && $(AUTOMAKE) --gnu --ignore-deps'; \ + $(am__cd) $(srcdir) && $(AUTOMAKE) --gnu --ignore-deps \ + && exit 0; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu --ignore-deps Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu --ignore-deps Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + echo ' $(SHELL) ./config.status'; \ + $(SHELL) ./config.status;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + $(SHELL) ./config.status --recheck + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + $(am__cd) $(srcdir) && $(AUTOCONF) +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + $(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS) +$(am__aclocal_m4_deps): + +config.h: stamp-h1 + @test -f $@ || rm -f stamp-h1 + @test -f $@ || $(MAKE) $(AM_MAKEFLAGS) stamp-h1 + +stamp-h1: $(srcdir)/config.in $(top_builddir)/config.status + @rm -f stamp-h1 + cd $(top_builddir) && $(SHELL) ./config.status config.h +$(srcdir)/config.in: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + ($(am__cd) $(top_srcdir) && $(AUTOHEADER)) + rm -f stamp-h1 + touch $@ + +distclean-hdr: + -rm -f config.h stamp-h1 +gmp.h: $(top_builddir)/config.status $(srcdir)/gmp-h.in + cd $(top_builddir) && $(SHELL) ./config.status $@ + +install-libLTLIBRARIES: $(lib_LTLIBRARIES) + @$(NORMAL_INSTALL) + @list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \ + list2=; for p in $$list; do \ + if test -f $$p; then \ + list2="$$list2 $$p"; \ + else :; fi; \ + done; \ + test -z "$$list2" || { \ + echo " $(MKDIR_P) '$(DESTDIR)$(libdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(libdir)" || exit 1; \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \ + } + +uninstall-libLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \ + for p in $$list; do \ + $(am__strip_dir) \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \ + done + +clean-libLTLIBRARIES: + -test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES) + @list='$(lib_LTLIBRARIES)'; \ + locs=`for p in $$list; do echo $$p; done | \ + sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \ + sort -u`; \ + test -z "$$locs" || { \ + echo rm -f $${locs}; \ + rm -f $${locs}; \ + } + +libgmp.la: $(libgmp_la_OBJECTS) $(libgmp_la_DEPENDENCIES) $(EXTRA_libgmp_la_DEPENDENCIES) + $(AM_V_CCLD)$(libgmp_la_LINK) -rpath $(libdir) $(libgmp_la_OBJECTS) $(libgmp_la_LIBADD) $(LIBS) + +libgmpxx.la: $(libgmpxx_la_OBJECTS) $(libgmpxx_la_DEPENDENCIES) $(EXTRA_libgmpxx_la_DEPENDENCIES) + $(AM_V_CXXLD)$(libgmpxx_la_LINK) $(am_libgmpxx_la_rpath) $(libgmpxx_la_OBJECTS) $(libgmpxx_la_LIBADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +.c.o: + $(AM_V_CC)$(COMPILE) -c -o $@ $< + +.c.obj: + $(AM_V_CC)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.c.lo: + $(AM_V_CC)$(LTCOMPILE) -c -o $@ $< + +.cc.o: + $(AM_V_CXX)$(CXXCOMPILE) -c -o $@ $< + +.cc.obj: + $(AM_V_CXX)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.cc.lo: + $(AM_V_CXX)$(LTCXXCOMPILE) -c -o $@ $< + +dummy.lo: cxx/dummy.cc + $(AM_V_CXX)$(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -c -o dummy.lo `test -f 'cxx/dummy.cc' || echo '$(srcdir)/'`cxx/dummy.cc + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +distclean-libtool: + -rm -f libtool config.lt +install-includeHEADERS: $(include_HEADERS) + @$(NORMAL_INSTALL) + @list='$(include_HEADERS)'; test -n "$(includedir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(includedir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(includedir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(includedir)'"; \ + $(INSTALL_HEADER) $$files "$(DESTDIR)$(includedir)" || exit $$?; \ + done + +uninstall-includeHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(include_HEADERS)'; test -n "$(includedir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(includedir)'; $(am__uninstall_files_from_dir) +install-nodist_includeexecHEADERS: $(nodist_includeexec_HEADERS) + @$(NORMAL_INSTALL) + @list='$(nodist_includeexec_HEADERS)'; test -n "$(includeexecdir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(includeexecdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(includeexecdir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(includeexecdir)'"; \ + $(INSTALL_HEADER) $$files "$(DESTDIR)$(includeexecdir)" || exit $$?; \ + done + +uninstall-nodist_includeexecHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(nodist_includeexec_HEADERS)'; test -n "$(includeexecdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(includeexecdir)'; $(am__uninstall_files_from_dir) + +# This directory's subdirectories are mostly independent; you can cd +# into them and run 'make' without going through this Makefile. +# To change the values of 'make' variables: instead of editing Makefiles, +# (1) if the variable is set in 'config.status', edit 'config.status' +# (which will cause the Makefiles to be regenerated when you run 'make'); +# (2) otherwise, pass the desired values on the 'make' command line. +$(am__recursive_targets): + @fail=; \ + if $(am__make_keepgoing); then \ + failcom='fail=yes'; \ + else \ + failcom='exit 1'; \ + fi; \ + dot_seen=no; \ + target=`echo $@ | sed s/-recursive//`; \ + case "$@" in \ + distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ + *) list='$(SUBDIRS)' ;; \ + esac; \ + for subdir in $$list; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + dot_seen=yes; \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || eval $$failcom; \ + done; \ + if test "$$dot_seen" = "no"; then \ + $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ + fi; test -z "$$fail" + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-recursive +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ + include_option=--etags-include; \ + empty_fix=.; \ + else \ + include_option=--include; \ + empty_fix=; \ + fi; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test ! -f $$subdir/TAGS || \ + set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \ + fi; \ + done; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-recursive + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscope: cscope.files + test ! -s cscope.files \ + || $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS) +clean-cscope: + -rm -f cscope.files +cscope.files: clean-cscope cscopelist +cscopelist: cscopelist-recursive + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + -rm -f cscope.out cscope.in.out cscope.po.out cscope.files + +distdir: $(DISTFILES) + $(am__remove_distdir) + test -d "$(distdir)" || mkdir "$(distdir)" + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done + @list='$(DIST_SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + $(am__make_dryrun) \ + || test -d "$(distdir)/$$subdir" \ + || $(MKDIR_P) "$(distdir)/$$subdir" \ + || exit 1; \ + dir1=$$subdir; dir2="$(distdir)/$$subdir"; \ + $(am__relativize); \ + new_distdir=$$reldir; \ + dir1=$$subdir; dir2="$(top_distdir)"; \ + $(am__relativize); \ + new_top_distdir=$$reldir; \ + echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \ + echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \ + ($(am__cd) $$subdir && \ + $(MAKE) $(AM_MAKEFLAGS) \ + top_distdir="$$new_top_distdir" \ + distdir="$$new_distdir" \ + am__remove_distdir=: \ + am__skip_length_check=: \ + am__skip_mode_fix=: \ + distdir) \ + || exit 1; \ + fi; \ + done + $(MAKE) $(AM_MAKEFLAGS) \ + top_distdir="$(top_distdir)" distdir="$(distdir)" \ + dist-hook + -test -n "$(am__skip_mode_fix)" \ + || find "$(distdir)" -type d ! -perm -755 \ + -exec chmod u+rwx,go+rx {} \; -o \ + ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \ + ! -type d ! -perm -400 -exec chmod a+r {} \; -o \ + ! -type d ! -perm -444 -exec $(install_sh) -c -m a+r {} {} \; \ + || chmod -R a+r "$(distdir)" +dist-gzip: distdir + tardir=$(distdir) && $(am__tar) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz + $(am__post_remove_distdir) + +dist-bzip2: distdir + tardir=$(distdir) && $(am__tar) | BZIP2=$${BZIP2--9} bzip2 -c >$(distdir).tar.bz2 + $(am__post_remove_distdir) + +dist-lzip: distdir + tardir=$(distdir) && $(am__tar) | lzip -c $${LZIP_OPT--9} >$(distdir).tar.lz + $(am__post_remove_distdir) + +dist-xz: distdir + tardir=$(distdir) && $(am__tar) | XZ_OPT=$${XZ_OPT--e} xz -c >$(distdir).tar.xz + $(am__post_remove_distdir) + +dist-tarZ: distdir + @echo WARNING: "Support for shar distribution archives is" \ + "deprecated." >&2 + @echo WARNING: "It will be removed altogether in Automake 2.0" >&2 + tardir=$(distdir) && $(am__tar) | compress -c >$(distdir).tar.Z + $(am__post_remove_distdir) + +dist-shar: distdir + @echo WARNING: "Support for distribution archives compressed with" \ + "legacy program 'compress' is deprecated." >&2 + @echo WARNING: "It will be removed altogether in Automake 2.0" >&2 + shar $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).shar.gz + $(am__post_remove_distdir) + +dist-zip: distdir + -rm -f $(distdir).zip + zip -rq $(distdir).zip $(distdir) + $(am__post_remove_distdir) + +dist dist-all: + $(MAKE) $(AM_MAKEFLAGS) $(DIST_TARGETS) am__post_remove_distdir='@:' + $(am__post_remove_distdir) + +# This target untars the dist file and tries a VPATH configuration. Then +# it guarantees that the distribution is self-contained by making another +# tarfile. +distcheck: dist + case '$(DIST_ARCHIVES)' in \ + *.tar.gz*) \ + GZIP=$(GZIP_ENV) gzip -dc $(distdir).tar.gz | $(am__untar) ;;\ + *.tar.bz2*) \ + bzip2 -dc $(distdir).tar.bz2 | $(am__untar) ;;\ + *.tar.lz*) \ + lzip -dc $(distdir).tar.lz | $(am__untar) ;;\ + *.tar.xz*) \ + xz -dc $(distdir).tar.xz | $(am__untar) ;;\ + *.tar.Z*) \ + uncompress -c $(distdir).tar.Z | $(am__untar) ;;\ + *.shar.gz*) \ + GZIP=$(GZIP_ENV) gzip -dc $(distdir).shar.gz | unshar ;;\ + *.zip*) \ + unzip $(distdir).zip ;;\ + esac + chmod -R a-w $(distdir) + chmod u+w $(distdir) + mkdir $(distdir)/_build $(distdir)/_inst + chmod a-w $(distdir) + test -d $(distdir)/_build || exit 0; \ + dc_install_base=`$(am__cd) $(distdir)/_inst && pwd | sed -e 's,^[^:\\/]:[\\/],/,'` \ + && dc_destdir="$${TMPDIR-/tmp}/am-dc-$$$$/" \ + && am__cwd=`pwd` \ + && $(am__cd) $(distdir)/_build \ + && ../configure \ + $(AM_DISTCHECK_CONFIGURE_FLAGS) \ + $(DISTCHECK_CONFIGURE_FLAGS) \ + --srcdir=.. --prefix="$$dc_install_base" \ + && $(MAKE) $(AM_MAKEFLAGS) \ + && $(MAKE) $(AM_MAKEFLAGS) dvi \ + && $(MAKE) $(AM_MAKEFLAGS) check \ + && $(MAKE) $(AM_MAKEFLAGS) install \ + && $(MAKE) $(AM_MAKEFLAGS) installcheck \ + && $(MAKE) $(AM_MAKEFLAGS) uninstall \ + && $(MAKE) $(AM_MAKEFLAGS) distuninstallcheck_dir="$$dc_install_base" \ + distuninstallcheck \ + && chmod -R a-w "$$dc_install_base" \ + && ({ \ + (cd ../.. && umask 077 && mkdir "$$dc_destdir") \ + && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" install \ + && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" uninstall \ + && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" \ + distuninstallcheck_dir="$$dc_destdir" distuninstallcheck; \ + } || { rm -rf "$$dc_destdir"; exit 1; }) \ + && rm -rf "$$dc_destdir" \ + && $(MAKE) $(AM_MAKEFLAGS) dist \ + && rm -rf $(DIST_ARCHIVES) \ + && $(MAKE) $(AM_MAKEFLAGS) distcleancheck \ + && cd "$$am__cwd" \ + || exit 1 + $(am__post_remove_distdir) + @(echo "$(distdir) archives ready for distribution: "; \ + list='$(DIST_ARCHIVES)'; for i in $$list; do echo $$i; done) | \ + sed -e 1h -e 1s/./=/g -e 1p -e 1x -e '$$p' -e '$$x' +distuninstallcheck: + @test -n '$(distuninstallcheck_dir)' || { \ + echo 'ERROR: trying to run $@ with an empty' \ + '$$(distuninstallcheck_dir)' >&2; \ + exit 1; \ + }; \ + $(am__cd) '$(distuninstallcheck_dir)' || { \ + echo 'ERROR: cannot chdir into $(distuninstallcheck_dir)' >&2; \ + exit 1; \ + }; \ + test `$(am__distuninstallcheck_listfiles) | wc -l` -eq 0 \ + || { echo "ERROR: files left after uninstall:" ; \ + if test -n "$(DESTDIR)"; then \ + echo " (check DESTDIR support)"; \ + fi ; \ + $(distuninstallcheck_listfiles) ; \ + exit 1; } >&2 +distcleancheck: distclean + @if test '$(srcdir)' = . ; then \ + echo "ERROR: distcleancheck can only run from a VPATH build" ; \ + exit 1 ; \ + fi + @test `$(distcleancheck_listfiles) | wc -l` -eq 0 \ + || { echo "ERROR: files left in build directory after distclean:" ; \ + $(distcleancheck_listfiles) ; \ + exit 1; } >&2 +check-am: all-am +check: $(BUILT_SOURCES) + $(MAKE) $(AM_MAKEFLAGS) check-recursive +all-am: Makefile $(LTLIBRARIES) $(HEADERS) config.h +installdirs: installdirs-recursive +installdirs-am: + for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(includedir)" "$(DESTDIR)$(includeexecdir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: $(BUILT_SOURCES) + $(MAKE) $(AM_MAKEFLAGS) install-recursive +install-exec: install-exec-recursive +install-data: install-data-recursive +uninstall: uninstall-recursive + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-recursive +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + -test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." + -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) +clean: clean-recursive + +clean-am: clean-generic clean-libLTLIBRARIES clean-libtool clean-local \ + mostlyclean-am + +distclean: distclean-recursive + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-hdr distclean-libtool distclean-local distclean-tags + +dvi: dvi-recursive + +dvi-am: + +html: html-recursive + +html-am: + +info: info-recursive + +info-am: + +install-data-am: install-includeHEADERS + @$(NORMAL_INSTALL) + $(MAKE) $(AM_MAKEFLAGS) install-data-hook +install-dvi: install-dvi-recursive + +install-dvi-am: + +install-exec-am: install-libLTLIBRARIES \ + install-nodist_includeexecHEADERS + +install-html: install-html-recursive + +install-html-am: + +install-info: install-info-recursive + +install-info-am: + +install-man: + +install-pdf: install-pdf-recursive + +install-pdf-am: + +install-ps: install-ps-recursive + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-recursive + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -rf $(top_srcdir)/autom4te.cache + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-recursive + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-recursive + +pdf-am: + +ps: ps-recursive + +ps-am: + +uninstall-am: uninstall-includeHEADERS uninstall-libLTLIBRARIES \ + uninstall-nodist_includeexecHEADERS + +.MAKE: $(am__recursive_targets) all check install install-am \ + install-data-am install-strip + +.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am \ + am--refresh check check-am clean clean-cscope clean-generic \ + clean-libLTLIBRARIES clean-libtool clean-local cscope \ + cscopelist-am ctags ctags-am dist dist-all dist-bzip2 \ + dist-gzip dist-hook dist-lzip dist-shar dist-tarZ dist-xz \ + dist-zip distcheck distclean distclean-compile \ + distclean-generic distclean-hdr distclean-libtool \ + distclean-local distclean-tags distcleancheck distdir \ + distuninstallcheck dvi dvi-am html html-am info info-am \ + install install-am install-data install-data-am \ + install-data-hook install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am \ + install-includeHEADERS install-info install-info-am \ + install-libLTLIBRARIES install-man \ + install-nodist_includeexecHEADERS install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs installdirs-am maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-compile \ + mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am uninstall-includeHEADERS \ + uninstall-libLTLIBRARIES uninstall-nodist_includeexecHEADERS + + +install-data-hook: + @echo '' + @echo '+-------------------------------------------------------------+' + @echo '| CAUTION: |' + @echo '| |' + @echo '| If you have not already run "make check", then we strongly |' + @echo '| recommend you do so. |' + @echo '| |' + @echo '| GMP has been carefully tested by its authors, but compilers |' + @echo '| are all too often released with serious bugs. GMP tends to |' + @echo '| explore interesting corners in compilers and has hit bugs |' + @echo '| on quite a few occasions. |' + @echo '| |' + @echo '+-------------------------------------------------------------+' + @echo '' + +fac_table.h: gen-fac$(EXEEXT_FOR_BUILD) + ./gen-fac $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >fac_table.h || (rm -f fac_table.h; exit 1) + +gen-fac$(EXEEXT_FOR_BUILD): gen-fac$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-fac$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-fac$(U_FOR_BUILD).c -o gen-fac$(EXEEXT_FOR_BUILD) + +fib_table.h: gen-fib$(EXEEXT_FOR_BUILD) + ./gen-fib header $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >fib_table.h || (rm -f fib_table.h; exit 1) + +mpn/fib_table.c: gen-fib$(EXEEXT_FOR_BUILD) + ./gen-fib table $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mpn/fib_table.c || (rm -f mpn/fib_table.c; exit 1) + +gen-fib$(EXEEXT_FOR_BUILD): gen-fib$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-fib$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-fib$(U_FOR_BUILD).c -o gen-fib$(EXEEXT_FOR_BUILD) + +mp_bases.h: gen-bases$(EXEEXT_FOR_BUILD) + ./gen-bases header $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mp_bases.h || (rm -f mp_bases.h; exit 1) + +mpn/mp_bases.c: gen-bases$(EXEEXT_FOR_BUILD) + ./gen-bases table $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mpn/mp_bases.c || (rm -f mpn/mp_bases.c; exit 1) + +gen-bases$(EXEEXT_FOR_BUILD): gen-bases$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-bases$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-bases$(U_FOR_BUILD).c -o gen-bases$(EXEEXT_FOR_BUILD) $(LIBM_FOR_BUILD) + +trialdivtab.h: gen-trialdivtab$(EXEEXT_FOR_BUILD) + ./gen-trialdivtab $(GMP_LIMB_BITS) 8000 >trialdivtab.h || (rm -f trialdivtab.h; exit 1) + +gen-trialdivtab$(EXEEXT_FOR_BUILD): gen-trialdivtab$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-trialdivtab$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-trialdivtab$(U_FOR_BUILD).c -o gen-trialdivtab$(EXEEXT_FOR_BUILD) $(LIBM_FOR_BUILD) + +mpn/jacobitab.h: gen-jacobitab$(EXEEXT_FOR_BUILD) + ./gen-jacobitab >mpn/jacobitab.h || (rm -f mpn/jacobitab.h; exit 1) + +gen-jacobitab$(EXEEXT_FOR_BUILD): gen-jacobitab$(U_FOR_BUILD).c + $(CC_FOR_BUILD) `test -f 'gen-jacobitab$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-jacobitab$(U_FOR_BUILD).c -o gen-jacobitab$(EXEEXT_FOR_BUILD) + +mpn/perfsqr.h: gen-psqr$(EXEEXT_FOR_BUILD) + ./gen-psqr $(GMP_LIMB_BITS) $(GMP_NAIL_BITS) >mpn/perfsqr.h || (rm -f mpn/perfsqr.h; exit 1) + +gen-psqr$(EXEEXT_FOR_BUILD): gen-psqr$(U_FOR_BUILD).c bootstrap.c + $(CC_FOR_BUILD) `test -f 'gen-psqr$(U_FOR_BUILD).c' || echo '$(srcdir)/'`gen-psqr$(U_FOR_BUILD).c -o gen-psqr$(EXEEXT_FOR_BUILD) $(LIBM_FOR_BUILD) + +# Avoid: CVS - cvs directories +# *~ - emacs backups +# .#* - cvs merge originals +# +# *~ and .#* only occur when a whole directory without it's own Makefile.am +# is distributed, like "doc" or the mpn cpu subdirectories. +# +dist-hook: + -find $(distdir) \( -name CVS -type d \) -o -name "*~" -o -name ".#*" \ + | xargs rm -rf + cp "$(srcdir)"/mini-gmp/tests/*.[ch] "$(distdir)/mini-gmp/tests" +# grep -F $(VERSION) $(srcdir)/Makefile.am \ +# | grep -q "^# *$(VERSION) *$(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE) *$(LIBGMPXX_LT_CURRENT):$(LIBGMPXX_LT_REVISION):$(LIBGMPXX_LT_AGE)" +# test -z "`sed -n 's/^# *[0-9]*\.[0-9]*\.[0-9]* *\([0-9]*:[0-9]*:[0-9]*\) *\([0-9]*:[0-9]*:[0-9]*\) *\([0-9]*:[0-9]*:[0-9]*\).*/A\1\nB\2\nC\3/p' $(srcdir)/Makefile.am | grep -v 'A6:3:3\|B3:5:0\|C4:7:1' | sort | uniq -d`" + +.PHONY: check-mini-gmp clean-mini-gmp + +check-mini-gmp: + abs_srcdir="`cd $(srcdir) && pwd`" ; \ + $(MKDIR_P) mini-gmp/tests \ + && cd mini-gmp/tests \ + && LD_LIBRARY_PATH="../../.libs:$$LD_LIBRARY_PATH" \ + DYLD_LIBRARY_PATH="../../.libs:$$DYLD_LIBRARY_PATH" \ + $(MAKE) -f "$$abs_srcdir/mini-gmp/tests/Makefile" \ + VPATH="$$abs_srcdir/mini-gmp/tests" \ + srcdir="$$abs_srcdir/mini-gmp/tests" \ + MINI_GMP_DIR="$$abs_srcdir/mini-gmp" \ + LDFLAGS="-L../../.libs" \ + LIBS="-lgmp -lm" \ + CC="$(CC_FOR_BUILD)" EXTRA_CFLAGS="-g -I../.." check + +clean-mini-gmp: + if [ -d mini-gmp/tests ] ; then \ + abs_srcdir="`cd $(srcdir) && pwd`" ; \ + cd mini-gmp/tests \ + && $(MAKE) -f "$$abs_srcdir/mini-gmp/tests/Makefile" clean ; \ + fi + +clean-local: clean-mini-gmp +distclean-local: clean-mini-gmp + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/gmp4/NEWS b/gmp4/NEWS new file mode 100644 index 0000000..f8c5229 --- /dev/null +++ b/gmp4/NEWS @@ -0,0 +1,891 @@ +Copyright 1996, 1999-2014 Free Software Foundation, Inc. + +Verbatim copying and distribution of this entire article is permitted in any +medium, provided this notice is preserved. + + +Changes between GMP version 5.1.* and 5.2.0 + + BUGS FIXED + * The function mpz_invert now considers any number invertible in Z/1Z. + + * The mpn multiply code now handles operands of more than 2^31 limbs + correctly. (Note however that the mpz code is limited to 2^32 bits on + 32-bit hosts and 2^37 bits on 64-bit hosts.) + + * Contains all fixes from release 5.1.3. + + SPEEDUPS + * Plain division of large operands is faster and more monotonous in operand + size. + + * Major speedup for ARM, in particular ARM Cortex-A15, thanks to improved + assembly. + + * Major speedup for SPARC T4/T5 and speedup also for T3, thanks to a lot of + new assembly. + + * Speedup for Intel Sandy Bridge, Ivy Bridge, Haswell, thanks to rewritten + and vastly expanded assembly support. Speedup also for the older Core 2 + and Nehalem. + + * Faster mixed arithmetic between mpq_class and double. + + * With g++, optimise more operations when one argument is a simple constant. + + FEATURES + * Support for new Intel and AMD CPUs. + + * Support for ARM64 alias Aarch64 alias ARMv8. + + * New public functions mpn_sec_mul and mpn_sec_sqr, implementing side-channel + silent multiplication and squaring. + + * New public functions mpn_sec_div_qr and mpn_sec_div_r, implementing + side-channel silent division. + + * New public functions mpn_cnd_add_n and mpn_cnd_sub_n. Side-channel silent + conditional addition and subtraction. + + * New public function mpn_sec_powm, implementing side-channel silent modexp. + + * New public function mpn_sec_invert, implementing side-channel silent + modular inversion. + + * Better support for applications which use the mpz_t type, but nevertheless + need to call some of the lower-level mpn functions. See the documentation + for mpz_limbs_read and related functions. + + MISC + * This release will not work on NetBSD 5.x, FreeBSD 7.x, 8.x or 9 series + before 9.3. The reason is that the m4 command is not correctly + implemented. (Workaround: Use an older GMP release, or install GNU m4 from + /usr/ports and tell GMP to use it.) + + * This release will not build properly on FreeBSD/amd64 before version 10 + using the 32-bit ABI (once a working m4 is installed). The reason is + broken limits.h. (Workaround: Use an older GMP release if using the 32-bit + ABI on these FreeBSD releases is important.) + + * This release will not work reliably on FreeBSD 10.0 for i386 or amd64 using + the 32-bit ABI. The reason is bugs in the compiler 'clang'. Depending on + CPU-dependent compiler flags, GMP may or may not be miscompiled in a + particular build. (Workaround: Compiling gcc from /usr/ports should work, + except that gcc circularly depends on GMP; we have not been able to test + that workaround due to FreeBSD 10.0 bugs affecting its ability to run under + KVM and Xen.) + + * This release will not compile on FreeBSD before version 10 for i386, + targeting any modern AMD processor. The reason is bugs in the old gcc + bundled with FreeBSD. (Workaround: install a less obsolete gcc from + /usr/ports and tell GMP to use it, or override the -march=amdfam10 + GMP configure command line argument.) + + +Changes between GMP version 5.1.2 and 5.1.3 + + BUGS FIXED + * The internal functions mpn_sbpi1_div_qr_sec mpn_sbpi1_div_r_sec could + compute garbage with a low probability. They are now rewritten, and the + test code has been improved. + + * A bug in the ia64 implementation of mpn_divrem_2, clobbering some + callee-save registers, has been fixed. This is an internal + function, with the bug manifesting itself as miscomputation in, + e.g., mpn_sqrtrem. + + * The documentation now correctly says 'const' for input arguments. + + SPEEDUPS + * None. + + FEATURES + * None. + + MISC + * None. + + +Changes between GMP version 5.1.1 and 5.1.2 + + BUGS FIXED + * A bug in mpz_powm_ui triggered by base arguments of at least 15000 decimal + digits or mod arguments of at least 7500 decimal digits has been fixed. + + * An AMD Bulldozer specific bug affecting the 64-bit Windows ABI has been + fixed. This bug was in a key function (mpn_mul_1) and made both Bulldozer + specific builds and fat builds run on Bulldozer completely non-functional. + + SPEEDUPS + * None. + + FEATURES + * None. + + MISC + * Fixes and generalisations to the test suite. + + * Minor portability enhancements. + + +Changes between GMP version 5.1.0 and 5.1.1 + + BUGS FIXED + * On Windows 64-bit, an error causing link errors about + __gmp_binvert_limb_table has been fixed. + + * Aarch64 alias ARM64 support now works. + + * A possible buffer overrun in mpz_ior has been fixed. + + * A rare sign flip in mpz_remove has been fixed. + + * A bug causing problems with mpf numbers with absolute value >= 2^31 has + been fixed. + + * Several bugs in mini-gmp have been fixed. + + * A bug caused by automake, related to the 'distcheck' target, has been fixed + by upgrading the automake used for GMP release engineering. + + SPEEDUPS + * None. + + FEATURES + * Preliminary support for the x32 ABI under x86-64. + + MISC + * The mini-gmp testsuite now tests the entire set of functions. + + * Various improvements of the GMP testsuite. + + +Changes between GMP version 5.0.* and 5.1.0 + + BUGS FIXED + * When reading a C++ number (like mpz_class) in an istream reaches the end + of the stream, the eofbit is now set. + + * The result sign of mpz_rootrem's remainder is now always correct. + + * The mpz_remove function now handles negative divisors. + + * Contains all fixes from release 5.0.5. + + SPEEDUPS + * The n-factorial and n-over-k functions have been reimplemented for great + speedups for small and large operands. + + * New subquadratic algorithm for the Kronecker/Jacobi/Legendre symbol. + + * Major speedup for ARM, in particular ARM Cortex-A9 and A15, thanks to broad + assembly support. + + * Significant speedup for POWER6 and POWER7 thanks to improved assembly. + + * The performance under M$ Windows' 64-bit ABI has been greatly improved + thanks to complete assembly support. + + * Minor speed improvements of many functions and for many platforms. + + FEATURES + * Many new CPUs recognised. + + * New functions for multi-factorials, and primorial: mpz_2fac_ui, + mpz_mfac_uiui and mpz_primorial_ui. + + * The mpz_powm_sec function now uses side-channel silent division for + converting into Montgomery residues. + + * The fat binary mechanism is now more robust in its CPU recognition. + + MISC + * Inclusion of assembly code is now controlled by the configure options + --enable-assembly and --disable-assembly. The "none" CPU target is gone. + + * In C++, the conversions mpq_class->mpz_class, mpf_class->mpz_class and + mpf_class->mpq_class are now explicit. + + * Includes "mini-gmp", a small, portable, but less efficient, implementation + of a subset of GMP's mpn and mpz interfaces. Used in GMP bootstrap, but it + can also be bundled with applications as a fallback when the real GMP + library is unavailable. + + * The ABIs under AIX are no longer called aix32 and aix64, but mode64 and 32. + This is more consistent with other powerpc systems. + + * The coverage of the testsuite has been improved, using the lcov tool. See + also https://gmplib.org/devel/lcov/. + + * It is now possible to compile GMP using a C++ compiler. + + * K&R C compilers are no longer supported. + + * The BSD MP compatibility functions have been removed. + + +Changes between GMP version 5.0.4 and 5.0.5 + + BUGS FIXED + * A bug causing AMD 11h processors to be treated like AMD 10h has been fixed. + The 11h processors do not correctly handle all 10h (aka K10) instructions, + and GMP's use of these instructions results in major miscomputations (not + as one would have hoped CPU traps of some 'illegal instruction' sort). + + * A bug affecting recent Intel Sandy Bridge CPUs resulting in configuration + failures has been fixed. + + SPEEDUPS + * None. + + FEATURES + * A couple of tests added to the self-check suite. + + MISC + * None. + + +Changes between GMP version 5.0.3 and 5.0.4 + + BUGS FIXED + * Thresholds in mpn_powm_sec for both fat and non-fat builds are now used + safely, plugging a one-word buffer overrun introduced in the 5.0.3 release + (for non-fat) and a multi-word buffer overrun that existed since 5.0 (for + fat). (We have not been able to provoke malign stack smashing in any of + the ~100 configurations explored by the GMP nightly builds, but the bug + should be assumed to be exploitable.) + + * Two bugs in multiplication code causing incorrect computation with + extremely low probability have been fixed. + + * A bug in the test suite causing buffer overruns during "make check", + sometimes leading to subsequent malloc crashes, has been fixed. + + * Two bugs in the gcd code have been fixed. They could lead to incorrect + results, but for uniformly distributed random operands, the likelihood for + that is infinitesimally small. (There was also a third bug, but that was + an incorrect ASSERT, which furthermore was not enabled by default.) + + * A bug affecting 32-bit PowerPC division has been fixed. The bug caused + miscomputation for certain divisors in the range 2^32 ... 2^64-1 (about 1 + in 2^30 of these). + + SPEEDUPS + * None, except indirectly through recognition of new CPUs, and through better + tuning parameters. + + FEATURES + * Some more tests added to the self-check suite. + + * The AMD "Bulldozer" CPU is now recognised. + + MISC + * None. + + +Changes between GMP version 5.0.2 and 5.0.3 + + BUGS FIXED + * A few minor bugs related to portability fixed. + + * A slight timing leak of the powm_sec functions have been sealed. (This + leak could possibly be used to extract the most significant few bits of the + exponent. "Few" here means at most 10.) + + * The mpz_nextprime function now runs a safer number of pseudo-random prime + tests. + + * A bug in division code possibly causing incorrect computation was fixed. + + SPEEDUPS + * None, except indirectly through recognition of new CPUs, and through better + tuning parameters. + + FEATURES + * New CPUs recognised. + + * IBM S/390 are now supported in both 31/32-bit and 64-bit mode. (We have + not been able to fully test this on any multilib machine, since IBM expired + our guest account a few days before our release.) + + MISC + * None. + + +Changes between GMP version 5.0.1 and 5.0.2 + + BUGS FIXED + * Many minor bugs related to portability fixed. + + * The support for HPPA 2.0N now works, after an assembly bug fix. + + * A test case type error has been fixed. The symptom of this bug was + spurious 'make check' failures. + + SPEEDUPS + * None, except indirectly through recognition of new CPUs. + + FEATURES + * Fat builds are now supported for 64-bit x86 processors also under Darwin. + + MISC + * None. + + +Changes between GMP version 5.0.0 and 5.0.1 + + BUGS FIXED + * Fat builds fixed. + + * Fixed crash for huge multiplies when old FFT_TABLE2 type of parameter + selection tables' sentinel was smaller than multiplied operands. + + * The solib numbers now reflect the removal of the documented but preliminary + mpn_bdivmod function; we correctly flag incompatibility with GMP 4.3. GMP + 5.0.0 has this wrong, and should perhaps be uninstalled to avoid confusion. + + SPEEDUPS + * Multiplication of large numbers has indirectly been sped up through better + FFT tuning and processor recognition. Since many operations depend on + multiplication, there will be a general speedup. + + FEATURES + * More Core i3, i5 an Core i7 processor models are recognised. + + * Fixes and workarounds for Mac OS quirks should make this GMP version build + using many of the different versions of "Xcode". + + MISC + * The amount of scratch memory needed for multiplication of huge numbers has + been reduced substantially (but is still larger than in GMP 4.3.) + + * Likewise, the amount of scratch memory needed for division of large numbers + has been reduced substantially. + + * The FFT tuning code of tune/tuneup.c has been completely rewritten, and + new, large FFT parameter selection tables are provided for many machines. + + * Upgraded to the latest autoconf, automake, libtool. + + +Changes between GMP version 4.3.X and 5.0.0 + + BUGS FIXED + * None (contains the same fixes as release 4.3.2). + + SPEEDUPS + * Multiplication has been overhauled: + (1) Multiplication of larger same size operands has been improved with + the addition of two new Toom functions and a new internal function + mpn_mulmod_bnm1 (computing U * V mod (B^n-1), B being the word base. + This latter function is used for the largest products, waiting for a + better Schoenhage-Strassen U * V mod (B^n+1) implementation. + (2) Likewise for squaring. + (3) Multiplication of different size operands has been improved with the + addition of many new Toom function, and by selecting underlying + functions better from the main multiply functions. + + * Division and mod have been overhauled: + (1) Plain "schoolbook" division is reimplemented using faster quotient + approximation. + (2) Division Q = N/D, R = N mod D where both the quotient and remainder + are needed now runs in time O(M(log(N))). This is an improvement of + a factor log(log(N)) + (3) Division where just the quotient is needed is now O(M(log(Q))) on + average. + (4) Modulo operations using Montgomery REDC form now take time O(M(n)). + (5) Exact division Q = N/D by means of mpz_divexact has been improved + for all sizes, and now runs in time O(M(log(N))). + + * The function mpz_powm is now faster for all sizes. Its complexity has + gone from O(M(n)log(n)m) to O(M(n)m) where n is the size of the modulo + argument and m is the size of the exponent. It is also radically + faster for even modulus, since it now partially factors such modulus + and performs two smaller modexp operations, then uses CRT. + + * The internal support for multiplication yielding just the lower n limbs + has been improved by using Mulders' algorithm. + + * Computation of inverses, both plain 1/N and 1/N mod B^n have been + improved by using well-tuned Newton iterations, and wrap-around + multiplication using mpn_mulmod_bnm1. + + * A new algorithm makes mpz_perfect_power_p asymptotically faster. + + * The function mpz_remove uses a much faster algorithm, is better tuned, + and also benefits from the division improvements. + + * Intel Atom and VIA Nano specific optimisations. + + * Plus hundreds of smaller improvements and tweaks! + + FEATURES + * New mpz function: mpz_powm_sec for side-channel quiet modexp + computations. + + * New mpn functions: mpn_sqr, mpn_and_n, mpn_ior_n, mpn_xor_n, mpn_nand_n, + mpn_nior_n, mpn_xnor_n, mpn_andn_n, mpn_iorn_n, mpn_com, mpn_neg, + mpn_copyi, mpn_copyd, mpn_zero. + + * The function mpn_tdiv_qr now allows certain argument overlap. + + * Support for fat binaries for 64-bit x86 processors has been added. + + * A new type, mp_bitcnt_t for bignum bit counts, has been introduced. + + * Support for Windows64 through mingw64 has been added. + + * The cofactors of mpz_gcdext and mpn_gcdext are now more strictly + normalised, returning to how GMP 4.2 worked. (Note that also release + 4.3.2 has this change.) + + MISC + * The mpn_mul function should no longer be used for squaring, + instead use the new mpn_sqr. + + * The algorithm selection has been improved, the number of thresholds have + more than doubled, and the tuning and use of existing thresholds have + been improved. + + * The tune/speed program can measure many of new functions. + + * The mpn_bdivmod function has been removed. We do not consider this an + incompatible change, since the function was marked as preliminary. + + * The testsuite has been enhanced in various ways. + + +Changes between GMP version 4.3.1 and 4.3.2 + + Bugs: + * Fixed bug in mpf_eq. + * Fixed overflow issues in mpz_set_str, mpz_inp_str, mpf_set_str, and + mpf_get_str. + * Avoid unbounded stack allocation for unbalanced multiplication. + * Fixed bug in FFT multiplication. + + Speedups: + * None, except that proper processor recognition helps affected processors. + + Features: + * Recognise more "Core 2" processor variants. + * The cofactors of mpz_gcdext and mpn_gcdext are now more strictly + normalised, returning to how GMP 4.2 worked. + + +Changes between GMP version 4.3.0 and 4.3.1 + + Bugs: + * Fixed bug in mpn_gcdext, affecting also mpz_gcdext and mpz_invert. + The bug could cause a cofactor to have a leading zero limb, which + could lead to crashes or miscomputation later on. + * Fixed some minor documentation issues. + + Speedups: + * None. + + Features: + * Workarounds for various issues with Mac OS X's build tools. + * Recognise more IBM "POWER" processor variants. + + +Changes between GMP version 4.2.X and 4.3.0 + + Bugs: + * Fixed bug in mpz_perfect_power_p with recognition of negative perfect + powers that can be written both as an even and odd power. + * We might accidentally have added bugs since there is a large amount of + new code in this release. + + Speedups: + * Vastly improved assembly code for x86-64 processors from AMD and Intel. + * Major improvements also for many other processor families, such as + Alpha, PowerPC, and Itanium. + * New sub-quadratic mpn_gcd and mpn_gcdext, as well as improved basecase + gcd code. + * The multiply FFT code has been slightly improved. + * Balanced multiplication now uses 4-way Toom in addition to schoolbook, + Karatsuba, 3-way Toom, and FFT. + * Unbalanced multiplication has been vastly improved. + * Improved schoolbook division by means of faster quotient approximation. + * Several new algorithms for division and mod by single limbs, giving + many-fold speedups. + * Improved nth root computations. + * The mpz_nextprime function uses sieving and is much faster. + * Countless minor tweaks. + + Features: + * Updated support for fat binaries for x86_32 include current processors + * Lots of new mpn internal interfaces. Some of them will become public + in a future GMP release. + * Support for the 32-bit ABI under x86-apple-darwin. + * x86 CPU recognition code should now default better for future + processors. + * The experimental nails feature does not work in this release, but + it might be re-enabled in the future. + + Misc: + * The gmp_version variable now always contains three parts. For this + release, it is "4.3.0". + + +Changes between GMP version 4.2.3 and 4.2.4 + + Bugs: + * Fix bug with parsing exponent '+' sign in mpf. + * Fix an allocation bug in mpf_set_str, also affecting mpf_init_set_str, and + mpf_inp_str. + + Speedups: + * None, except that proper processor recognition helps affected processors. + + Features: + * Recognize new AMD processors. + + +Changes between GMP version 4.2.2 and 4.2.3 + + Bugs: + * Fix x86 CPU recognition code to properly identify recent AMD and Intel + 64-bit processors. + * The >> operator of the C++ wrapper gmpxx.h now does floor rounding, not + truncation. + * Inline semantics now follow the C99 standard, and works with recent GCC + releases. + * C++ bitwise logical operations work for more types. + * For C++, gmp.h now includes cstdio, improving compiler compatibility. + * Bases > 36 now work properly in mpf_set_str. + + Speedups: + * None, except that proper processor recognition helps affected processors. + + Features: + * The allocation functions now detect overflow of the mpz_t type. This means + that overflow will now cause an abort, except when the allocation + computation itself overflows. (Such overflow can probably only happen in + powering functions; we will detect powering overflow in the future.) + + +Changes between GMP version 4.2.1 and 4.2.2 + + * License is now LGPL version 3. + + Bugs: + * Shared library numbers corrected for libcxx. + * Fixed serious bug in gmpxx.h where a=a+b*c would generate garbage. + Note that this only affects C++ programs. + * Fix crash in mpz_set_d for arguments with large negative exponent. + * Fix 32-bit ABI bug with Itanium assembly for popcount and hamdist. + * Fix assembly syntax problem for powerpc-ibm-aix with AIX native assembler. + * Fix problems with x86 --enable-fat, where the compiler where told to + generate code for the build machine, not plain i386 code as it should. + * Improved recognition of powerpc systems wrt Altivec/VMX capability. + * Misc minor fixes, mainly workarounds for compiler/assembler bugs. + + Speedups: + * "Core 2" and Pentium 4 processors, running in 64-bit mode will get a + slight boost as they are now specifically recognized. + + Features: + * New support for x86_64-solaris + * New, rudimentary support for x86-apple-darwin and x86_64-apple-darwin. + (Please see https://gmplib.org/macos.html for more information.) + + +Changes between GMP version 4.2 and 4.2.1 + + Bugs: + * Shared library numbers corrected. + * Broken support for 32-bit AIX fixed. + * Misc minor fixes. + + Speedups: + * Exact division (mpz_divexact) now falls back to plain division for large + operands. + + Features: + * Support for some new systems. + + +Changes between GMP version 4.1.4 and 4.2 + + Bugs: + * Minor bug fixes and code generalizations. + * Expanded and improved test suite. + + Speedups: + * Many minor optimizations, too many to mention here. + * Division now always subquadratic. + * Computation of n-factorial much faster. + * Added basic x86-64 assembly code. + * Floating-point output is now subquadratic for all bases. + * FFT multiply code now about 25% faster. + * Toom3 multiply code faster. + + Features: + * Much improved configure. + * Workarounds for many more compiler bugs. + * Temporary allocations are now made on the stack only if small. + * New systems supported: HPPA-2.0 gcc, IA-64 HP-UX, PowerPC-64 Darwin, + Sparc64 GNU/Linux. + * New i386 fat binaries, selecting optimised code at runtime (--enable-fat). + * New build option: --enable-profiling=instrument. + * New memory function: mp_get_memory_functions. + * New Mersenne Twister random numbers: gmp_randinit_mt, also now used for + gmp_randinit_default. + * New random functions: gmp_randinit_set, gmp_urandomb_ui, gmp_urandomm_ui. + * New integer functions: mpz_combit, mpz_rootrem. + * gmp_printf etc new type "M" for mp_limb_t. + * gmp_scanf and friends now accept C99 hex floats. + * Numeric input and output can now be in bases up to 62. + * Comparisons mpz_cmp_d, mpz_cmpabs_d, mpf_cmp_d recognise infinities. + * Conversions mpz_get_d, mpq_get_d, mpf_get_d truncate towards zero, + previously their behaviour was unspecified. + * Fixes for overflow issues with operands >= 2^31 bits. + + Caveats: + * mpfr is gone, and will from now on be released only separately. Please see + www.mpfr.org. + + +Changes between GMP version 4.1.3 and 4.1.4 + +* Bug fix to FFT multiplication code (crash for huge operands). +* Bug fix to mpf_sub (miscomputation). +* Support for powerpc64-gnu-linux. +* Better support for AMD64 in 32-bit mode. +* Upwardly binary compatible with 4.1.3, 4.1.2, 4.1.1, 4.1, 4.0.1, 4.0, + and 3.x versions. + + +Changes between GMP version 4.1.2 and 4.1.3 + +* Bug fix for FFT multiplication code (miscomputation). +* Bug fix to K6 assembly code for gcd. +* Bug fix to IA-64 assembly code for population count. +* Portability improvements, most notably functional AMD64 support. +* mpz_export allows NULL for countp parameter. +* Many minor bug fixes. +* mpz_export allows NULL for countp parameter. +* Upwardly binary compatible with 4.1.2, 4.1.1, 4.1, 4.0.1, 4.0, and 3.x + versions. + + +Changes between GMP version 4.1.1 and 4.1.2 + +* Bug fixes. + + +Changes between GMP version 4.1 and 4.1.1 + +* Bug fixes. +* New systems supported: NetBSD and OpenBSD sparc64. + + +Changes between GMP version 4.0.1 and 4.1 + +* Bug fixes. +* Speed improvements. +* Upwardly binary compatible with 4.0, 4.0.1, and 3.x versions. +* Asymptotically fast conversion to/from strings (mpz, mpq, mpn levels), but + also major speed improvements for tiny operands. +* mpn_get_str parameter restrictions relaxed. +* Major speed improvements for HPPA 2.0 systems. +* Major speed improvements for UltraSPARC systems. +* Major speed improvements for IA-64 systems (but still sub-optimal code). +* Extended test suite. +* mpfr is back, with many bug fixes and portability improvements. +* New function: mpz_ui_sub. +* New functions: mpz_export, mpz_import. +* Optimization for nth root functions (mpz_root, mpz_perfect_power_p). +* Optimization for extended gcd (mpz_gcdext, mpz_invert, mpn_gcdext). +* Generalized low-level number format, reserving a `nails' part of each + limb. (Please note that this is really experimental; some functions + are likely to compute garbage when nails are enabled.) +* Nails-enabled Alpha 21264 assembly code, allowing up to 75% better + performance. (Use --enable-nails=4 to enable it.) + + +Changes between GMP version 4.0 and 4.0.1 + +* Bug fixes. + + +Changes between GMP version 3.1.1 and 4.0 + +* Bug fixes. +* Speed improvements. +* Upwardly binary compatible with 3.x versions. +* New CPU support: IA-64, Pentium 4. +* Improved CPU support: 21264, Cray vector systems. +* Support for all MIPS ABIs: o32, n32, 64. +* New systems supported: Darwin, SCO, Windows DLLs. +* New divide-and-conquer square root algorithm. +* New algorithms chapter in the manual. +* New malloc reentrant temporary memory method. +* New C++ class interface by Gerardo Ballabio (beta). +* Revamped configure, featuring ABI selection. +* Speed improvements for mpz_powm and mpz_powm_ui (mainly affecting small + operands). +* mpz_perfect_power_p now properly recognizes 0, 1, and negative perfect + powers. +* mpz_hamdist now supports negative operands. +* mpz_jacobi now accepts non-positive denominators. +* mpz_powm now supports negative exponents. +* mpn_mul_1 operand overlap requirements relaxed. +* Float input and output uses locale specific decimal point where available. +* New gmp_printf, gmp_scanf and related functions. +* New division functions: mpz_cdiv_q_2exp, mpz_cdiv_r_2exp, mpz_divexact_ui. +* New divisibility tests: mpz_divisible_p, mpz_divisible_ui_p, + mpz_divisible_2exp_p, mpz_congruent_p, mpz_congruent_ui_p, + mpz_congruent_2exp_p. +* New Fibonacci function: mpz_fib2_ui. +* New Lucas number functions: mpz_lucnum_ui, mpz_lucnum2_ui. +* Other new integer functions: mpz_cmp_d, mpz_cmpabs_d, mpz_get_d_2exp, + mpz_init2, mpz_kronecker, mpz_lcm_ui, mpz_realloc2. +* New rational I/O: mpq_get_str, mpq_inp_str, mpq_out_str, mpq_set_str. +* Other new rational functions: mpq_abs, mpq_cmp_si, mpq_div_2exp, + mpq_mul_2exp, mpq_set_f. +* New float tests: mpf_integer_p, mpf_fits_sint_p, mpf_fits_slong_p, + mpf_fits_sshort_p, mpf_fits_uint_p, mpf_fits_ulong_p, mpf_fits_ushort_p. +* Other new float functions: mpf_cmp_d, mpf_get_default_prec, mpf_get_si, + mpf_get_ui, mpf_get_d_2exp. +* New random functions: gmp_randinit_default, gmp_randinit_lc_2exp_size. +* New demo expression string parser (see demos/expr). +* New preliminary perl interface (see demos/perl). +* Tuned algorithm thresholds for many more CPUs. + + +Changes between GMP version 3.1 and 3.1.1 + +* Bug fixes for division (rare), mpf_get_str, FFT, and miscellaneous minor + things. + + +Changes between GMP version 3.0 and 3.1 + +* Bug fixes. +* Improved `make check' running more tests. +* Tuned algorithm cutoff points for many machines. This will improve speed for + a lot of operations, in some cases by a large amount. +* Major speed improvements: Alpha 21264. +* Some speed improvements: Cray vector computers, AMD K6 and Athlon, Intel P5 + and Pentium Pro/II/III. +* The mpf_get_prec function now works as it did in GMP 2. +* New utilities for auto-tuning and speed measuring. +* Multiplication now optionally uses FFT for very large operands. (To enable + it, pass --enable-fft to configure.) +* Support for new systems: Solaris running on x86, FreeBSD 5, HP-UX 11, Cray + vector computers, Rhapsody, Nextstep/Openstep, MacOS. +* Support for shared libraries on 32-bit HPPA. +* New integer functions: mpz_mul_si, mpz_odd_p, mpz_even_p. +* New Kronecker symbol functions: mpz_kronecker_si, mpz_kronecker_ui, + mpz_si_kronecker, mpz_ui_kronecker. +* New rational functions: mpq_out_str, mpq_swap. +* New float functions: mpf_swap. +* New mpn functions: mpn_divexact_by3c, mpn_tdiv_qr. +* New EXPERIMENTAL function layer for accurate floating-point arithmetic, mpfr. + To try it, pass --enable-mpfr to configure. See the mpfr subdirectory for + more information; it is not documented in the main GMP manual. + + +Changes between GMP version 3.0 and 3.0.1 + +* Memory leaks in gmp_randinit and mpz_probab_prime_p fixed. +* Documentation for gmp_randinit fixed. Misc documentation errors fixed. + + +Changes between GMP version 2.0 and 3.0 + +* Source level compatibility with past releases (except mpn_gcd). +* Bug fixes. +* Much improved speed thanks to both host independent and host dependent + optimizations. +* Switch to autoconf/automake/libtool. +* Support for building libgmp as a shared library. +* Multiplication and squaring using 3-way Toom-Cook. +* Division using the Burnikel-Ziegler method. +* New functions computing binomial coefficients: mpz_bin_ui, mpz_bin_uiui. +* New function computing Fibonacci numbers: mpz_fib_ui. +* New random number generators: mpf_urandomb, mpz_rrandomb, mpz_urandomb, + mpz_urandomm, gmp_randclear, gmp_randinit, gmp_randinit_lc_2exp, + gmp_randseed, gmp_randseed_ui. +* New function for quickly extracting limbs: mpz_getlimbn. +* New functions performing integer size tests: mpz_fits_sint_p, + mpz_fits_slong_p, mpz_fits_sshort_p, mpz_fits_uint_p, mpz_fits_ulong_p, + mpz_fits_ushort_p. +* New mpf functions: mpf_ceil, mpf_floor, mpf_pow_ui, mpf_trunc. +* New mpq function: mpq_set_d. +* New mpz functions: mpz_addmul_ui, mpz_cmpabs, mpz_cmpabs_ui, mpz_lcm, + mpz_nextprime, mpz_perfect_power_p, mpz_remove, mpz_root, mpz_swap, + mpz_tdiv_ui, mpz_tstbit, mpz_xor. +* New mpn function: mpn_divexact_by3. +* New CPU support: DEC Alpha 21264, AMD K6 and Athlon, HPPA 2.0 and 64, + Intel Pentium Pro and Pentium-II/III, Sparc 64, PowerPC 64. +* Almost 10 times faster mpz_invert and mpn_gcdext. +* The interface of mpn_gcd has changed. +* Better support for MIPS R4x000 and R5000 under Irix 6. +* Improved support for SPARCv8 and SPARCv9 processors. + + +Changes between GMP version 2.0 and 2.0.2 + +* Many bug fixes. + + +Changes between GMP version 1.3.2 and 2.0 + +* Division routines in the mpz class have changed. There are three classes of + functions, that rounds the quotient to -infinity, 0, and +infinity, + respectively. The first class of functions have names that begin with + mpz_fdiv (f is short for floor), the second class' names begin with mpz_tdiv + (t is short for trunc), and the third class' names begin with mpz_cdiv (c is + short for ceil). + + The old division routines beginning with mpz_m are similar to the new + mpz_fdiv, with the exception that some of the new functions return useful + values. + + The old function names can still be used. All the old functions names will + now do floor division, not trunc division as some of them used to. This was + changed to make the functions more compatible with common mathematical + practice. + + The mpz_mod and mpz_mod_ui functions now compute the mathematical mod + function. I.e., the sign of the 2nd argument is ignored. + +* The mpq assignment functions do not canonicalize their results. A new + function, mpq_canonicalize must be called by the user if the result is not + known to be canonical. +* The mpn functions are now documented. These functions are intended for + very time critical applications, or applications that need full control over + memory allocation. Note that the mpn interface is irregular and hard to + use. +* New functions for arbitrary precision floating point arithmetic. Names + begin with `mpf_'. Associated type mpf_t. +* New and improved mpz functions, including much faster GCD, fast exact + division (mpz_divexact), bit scan (mpz_scan0 and mpz_scan1), and number + theoretical functions like Jacobi (mpz_jacobi) and multiplicative inverse + (mpz_invert). +* New variable types (mpz_t and mpq_t) are available that makes syntax of + mpz and mpq calls nicer (no need for & before variables). The MP_INT and + MP_RAT types are still available for compatibility. +* Uses GNU configure. This makes it possible to choose target architecture + and CPU variant, and to compile into a separate object directory. +* Carefully optimized assembly for important inner loops. Support for DEC + Alpha, Amd 29000, HPPA 1.0 and 1.1, Intel Pentium and generic x86, Intel + i960, Motorola MC68000, MC68020, MC88100, and MC88110, Motorola/IBM + PowerPC, National NS32000, IBM POWER, MIPS R3000, R4000, SPARCv7, + SuperSPARC, generic SPARCv8, and DEC VAX. Some support also for ARM, + Clipper, IBM ROMP (RT), and Pyramid AP/XP. +* Faster. Thanks to the assembler code, new algorithms, and general tuning. + In particular, the speed on machines without GCC is improved. +* Support for machines without alloca. +* Now under the LGPL. + +INCOMPATIBILITIES BETWEEN GMP 1 AND GMP 2 + +* mpq assignment functions do not canonicalize their results. +* mpz division functions round differently. +* mpz mod functions now really compute mod. +* mpz_powm and mpz_powm_ui now really use mod for reduction. diff --git a/gmp4/README b/gmp4/README new file mode 100644 index 0000000..013899d --- /dev/null +++ b/gmp4/README @@ -0,0 +1,116 @@ +Copyright 1991, 1996, 1999, 2000, 2007 Free Software Foundation, Inc. + +This file is part of the GNU MP Library. + +The GNU MP Library is free software; you can redistribute it and/or modify +it under the terms of either: + + * the GNU Lesser General Public License as published by the Free + Software Foundation; either version 3 of the License, or (at your + option) any later version. + +or + + * the GNU General Public License as published by the Free Software + Foundation; either version 2 of the License, or (at your option) any + later version. + +or both in parallel, as here. + +The GNU MP Library 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 copies of the GNU General Public License and the +GNU Lesser General Public License along with the GNU MP Library. If not, +see https://www.gnu.org/licenses/. + + + + + + + THE GNU MP LIBRARY + + +GNU MP is a library for arbitrary precision arithmetic, operating on signed +integers, rational numbers, and floating point numbers. It has a rich set of +functions, and the functions have a regular interface. + +GNU MP is designed to be as fast as possible, both for small operands and huge +operands. The speed is achieved by using fullwords as the basic arithmetic +type, by using fast algorithms, with carefully optimized assembly code for the +most common inner loops for lots of CPUs, and by a general emphasis on speed +(instead of simplicity or elegance). + +GNU MP is believed to be faster than any other similar library. Its advantage +increases with operand sizes for certain operations, since GNU MP in many +cases has asymptotically faster algorithms. + +GNU MP is free software and may be freely copied on the terms contained in the +files COPYING* (see the manual for information on which license(s) applies to +which components of GNU MP). + + + + OVERVIEW OF GNU MP + +There are five classes of functions in GNU MP. + + 1. Signed integer arithmetic functions (mpz). These functions are intended + to be easy to use, with their regular interface. The associated type is + `mpz_t'. + + 2. Rational arithmetic functions (mpq). For now, just a small set of + functions necessary for basic rational arithmetics. The associated type + is `mpq_t'. + + 3. Floating-point arithmetic functions (mpf). If the C type `double' + doesn't give enough precision for your application, declare your + variables as `mpf_t' instead, set the precision to any number desired, + and call the functions in the mpf class for the arithmetic operations. + + 4. Positive-integer, hard-to-use, very low overhead functions are in the + mpn class. No memory management is performed. The caller must ensure + enough space is available for the results. The set of functions is not + regular, nor is the calling interface. These functions accept input + arguments in the form of pairs consisting of a pointer to the least + significant word, and an integral size telling how many limbs (= words) + the pointer points to. + + Almost all calculations, in the entire package, are made by calling these + low-level functions. + + 5. Berkeley MP compatible functions. + + To use these functions, include the file "mp.h". You can test if you are + using the GNU version by testing if the symbol __GNU_MP__ is defined. + +For more information on how to use GNU MP, please refer to the documentation. +It is composed from the file doc/gmp.texi, and can be displayed on the screen +or printed. How to do that, as well how to build the library, is described in +the INSTALL file in this directory. + + + + REPORTING BUGS + +If you find a bug in the library, please make sure to tell us about it! + +You should first check the GNU MP web pages at https://gmplib.org/, under +"Status of the current release". There will be patches for all known serious +bugs there. + +Report bugs to gmp-bugs@gmplib.org. What information is needed in a useful bug +report is described in the manual. The same address can be used for suggesting +modifications and enhancements. + + + + +---------------- +Local variables: +mode: text +fill-column: 78 +End: diff --git a/gmp4/acinclude.m4 b/gmp4/acinclude.m4 new file mode 100644 index 0000000..138e2f5 --- /dev/null +++ b/gmp4/acinclude.m4 @@ -0,0 +1,3989 @@ +dnl GMP specific autoconf macros + + +dnl Copyright 2000-2006, 2009, 2011, 2013, 2014 Free Software Foundation, Inc. +dnl +dnl This file is part of the GNU MP Library. +dnl +dnl The GNU MP Library is free software; you can redistribute it and/or modify +dnl it under the terms of either: +dnl +dnl * the GNU Lesser General Public License as published by the Free +dnl Software Foundation; either version 3 of the License, or (at your +dnl option) any later version. +dnl +dnl or +dnl +dnl * the GNU General Public License as published by the Free Software +dnl Foundation; either version 2 of the License, or (at your option) any +dnl later version. +dnl +dnl or both in parallel, as here. +dnl +dnl The GNU MP Library is distributed in the hope that it will be useful, but +dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +dnl or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +dnl for more details. +dnl +dnl You should have received copies of the GNU General Public License and the +dnl GNU Lesser General Public License along with the GNU MP Library. If not, +dnl see https://www.gnu.org/licenses/. + + +dnl Some tests use, or must delete, the default compiler output. The +dnl possible filenames are based on what autoconf looks for, namely +dnl +dnl a.out - normal unix style +dnl b.out - i960 systems, including gcc there +dnl a.exe - djgpp +dnl a_out.exe - OpenVMS DEC C called via GNV wrapper (gnv.sourceforge.net) +dnl conftest.exe - various DOS compilers + + +define(IA64_PATTERN, +[[ia64*-*-* | itanium-*-* | itanium2-*-*]]) + +dnl Need to be careful not to match m6811, m6812, m68hc11 and m68hc12, all +dnl of which config.sub accepts. (Though none of which are likely to work +dnl with GMP.) +dnl +define(M68K_PATTERN, +[[m68k-*-* | m68[0-9][0-9][0-9]-*-*]]) + +define(POWERPC64_PATTERN, +[[powerpc64-*-* | powerpc64le-*-* | powerpc620-*-* | powerpc630-*-* | powerpc970-*-* | power[3-9]-*-*]]) + +define(S390_PATTERN, +[[s390-*-* | z900esa-*-* | z990esa-*-* | z9esa-*-* | z10esa-*-* | z196esa-*-*]]) + +define(S390X_PATTERN, +[[s390x-*-* | z900-*-* | z990-*-* | z9-*-* | z10-*-* | z196-*-*]]) + +define(X86_PATTERN, +[[i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-* | viac3*-*-* | geode*-*-* | atom-*-*]]) + +define(X86_64_PATTERN, +[[athlon64-*-* | k8-*-* | k10-*-* | bobcat-*-* | jaguar-*-* | bulldozer-*-* | piledriver-*-* | steamroller-*-* | excavator-*-* | pentium4-*-* | atom-*-* | core2-*-* | corei*-*-* | x86_64-*-* | nano-*-*]]) + +dnl GMP_FAT_SUFFIX(DSTVAR, DIRECTORY) +dnl --------------------------------- +dnl Emit code to set shell variable DSTVAR to the suffix for a fat binary +dnl routine from DIRECTORY. DIRECTORY can be a shell expression like $foo +dnl etc. +dnl +dnl The suffix is directory separators / or \ changed to underscores, and +dnl if there's more than one directory part, then the first is dropped. +dnl +dnl For instance, +dnl +dnl x86 -> x86 +dnl x86/k6 -> k6 +dnl x86/k6/mmx -> k6_mmx + +define(GMP_FAT_SUFFIX, +[[$1=`echo $2 | sed -e '/\//s:^[^/]*/::' -e 's:[\\/]:_:g'`]]) + + +dnl GMP_REMOVE_FROM_LIST(listvar,item) +dnl ---------------------------------- +dnl Emit code to remove any occurrence of ITEM from $LISTVAR. ITEM can be a +dnl shell expression like $foo if desired. + +define(GMP_REMOVE_FROM_LIST, +[remove_from_list_tmp= +for remove_from_list_i in $[][$1]; do + if test $remove_from_list_i = [$2]; then :; + else + remove_from_list_tmp="$remove_from_list_tmp $remove_from_list_i" + fi +done +[$1]=$remove_from_list_tmp +]) + + +dnl GMP_STRIP_PATH(subdir) +dnl ---------------------- +dnl Strip entries */subdir from $path and $fat_path. + +define(GMP_STRIP_PATH, +[GMP_STRIP_PATH_VAR(path, [$1]) +GMP_STRIP_PATH_VAR(fat_path, [$1]) +]) + +define(GMP_STRIP_PATH_VAR, +[tmp_path= +for i in $[][$1]; do + case $i in + */[$2]) ;; + *) tmp_path="$tmp_path $i" ;; + esac +done +[$1]="$tmp_path" +]) + + +dnl GMP_INCLUDE_GMP_H +dnl ----------------- +dnl Expand to the right way to #include gmp-h.in. This must be used +dnl instead of gmp.h, since that file isn't generated until the end of the +dnl configure. +dnl +dnl Dummy value for GMP_LIMB_BITS is enough +dnl for all current configure-time uses of gmp.h. + +define(GMP_INCLUDE_GMP_H, +[[#define __GMP_WITHIN_CONFIGURE 1 /* ignore template stuff */ +#define GMP_NAIL_BITS $GMP_NAIL_BITS +#define GMP_LIMB_BITS 123 +$DEFN_LONG_LONG_LIMB +#include "$srcdir/gmp-h.in"] +]) + + +dnl GMP_HEADER_GETVAL(NAME,FILE) +dnl ---------------------------- +dnl Expand at autoconf time to the value of a "#define NAME" from the given +dnl FILE. The regexps here aren't very rugged, but are enough for gmp. +dnl /dev/null as a parameter prevents a hang if $2 is accidentally omitted. + +define(GMP_HEADER_GETVAL, +[patsubst(patsubst( +esyscmd([grep "^#define $1 " $2 /dev/null 2>/dev/null]), +[^.*$1[ ]+],[]), +[[ + ]*$],[])]) + + +dnl GMP_VERSION +dnl ----------- +dnl The gmp version number, extracted from the #defines in gmp-h.in at +dnl autoconf time. Two digits like 3.0 if patchlevel <= 0, or three digits +dnl like 3.0.1 if patchlevel > 0. + +define(GMP_VERSION, +[GMP_HEADER_GETVAL(__GNU_MP_VERSION,gmp-h.in)[]dnl +.GMP_HEADER_GETVAL(__GNU_MP_VERSION_MINOR,gmp-h.in)[]dnl +.GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp-h.in)]) + + +dnl GMP_SUBST_CHECK_FUNCS(func,...) +dnl ------------------------------ +dnl Setup an AC_SUBST of HAVE_FUNC_01 for each argument. + +AC_DEFUN([GMP_SUBST_CHECK_FUNCS], +[m4_if([$1],,, +[_GMP_SUBST_CHECK_FUNCS(ac_cv_func_[$1],HAVE_[]m4_translit([$1],[a-z],[A-Z])_01) +GMP_SUBST_CHECK_FUNCS(m4_shift($@))])]) + +dnl Called: _GMP_SUBST_CHECK_FUNCS(cachevar,substvar) +AC_DEFUN([_GMP_SUBST_CHECK_FUNCS], +[case $[$1] in +yes) AC_SUBST([$2],1) ;; +no) [$2]=0 ;; +esac +]) + + +dnl GMP_SUBST_CHECK_HEADERS(foo.h,...) +dnl ---------------------------------- +dnl Setup an AC_SUBST of HAVE_FOO_H_01 for each argument. + +AC_DEFUN([GMP_SUBST_CHECK_HEADERS], +[m4_if([$1],,, +[_GMP_SUBST_CHECK_HEADERS(ac_cv_header_[]m4_translit([$1],[./],[__]), +HAVE_[]m4_translit([$1],[a-z./],[A-Z__])_01) +GMP_SUBST_CHECK_HEADERS(m4_shift($@))])]) + +dnl Called: _GMP_SUBST_CHECK_HEADERS(cachevar,substvar) +AC_DEFUN([_GMP_SUBST_CHECK_HEADERS], +[case $[$1] in +yes) AC_SUBST([$2],1) ;; +no) [$2]=0 ;; +esac +]) + + +dnl GMP_COMPARE_GE(A1,B1, A2,B2, ...) +dnl --------------------------------- +dnl Compare two version numbers A1.A2.etc and B1.B2.etc. Set +dnl $gmp_compare_ge to yes or no according to the result. The A parts +dnl should be variables, the B parts fixed numbers. As many parts as +dnl desired can be included. An empty string in an A part is taken to be +dnl zero, the B parts should be non-empty and non-zero. +dnl +dnl For example, +dnl +dnl GMP_COMPARE($major,10, $minor,3, $subminor,1) +dnl +dnl would test whether $major.$minor.$subminor is greater than or equal to +dnl 10.3.1. + +AC_DEFUN([GMP_COMPARE_GE], +[gmp_compare_ge=no +GMP_COMPARE_GE_INTERNAL($@) +]) + +AC_DEFUN([GMP_COMPARE_GE_INTERNAL], +[ifelse(len([$3]),0, +[if test -n "$1" && test "$1" -ge $2; then + gmp_compare_ge=yes +fi], +[if test -n "$1"; then + if test "$1" -gt $2; then + gmp_compare_ge=yes + else + if test "$1" -eq $2; then + GMP_COMPARE_GE_INTERNAL(m4_shift(m4_shift($@))) + fi + fi +fi]) +]) + + +dnl GMP_PROG_AR +dnl ----------- +dnl GMP additions to $AR. +dnl +dnl A cross-"ar" may be necessary when cross-compiling since the build +dnl system "ar" might try to interpret the object files to build a symbol +dnl table index, hence the use of AC_CHECK_TOOL. +dnl +dnl A user-selected $AR is always left unchanged. AC_CHECK_TOOL is still +dnl run to get the "checking" message printed though. +dnl +dnl If extra flags are added to AR, then ac_cv_prog_AR and +dnl ac_cv_prog_ac_ct_AR are set too, since libtool (cvs 2003-03-31 at +dnl least) will do an AC_CHECK_TOOL and that will AR from one of those two +dnl cached variables. (ac_cv_prog_AR is used if there's an ac_tool_prefix, +dnl or ac_cv_prog_ac_ct_AR is used otherwise.) FIXME: This is highly +dnl dependent on autoconf internals, perhaps it'd work to put our extra +dnl flags into AR_FLAGS instead. +dnl +dnl $AR_FLAGS is set to "cq" rather than leaving it to libtool "cru". The +dnl latter fails when libtool goes into piecewise mode and is unlucky +dnl enough to have two same-named objects in separate pieces, as happens +dnl for instance to random.o (and others) on vax-dec-ultrix4.5. Naturally +dnl a user-selected $AR_FLAGS is left unchanged. +dnl +dnl For reference, $ARFLAGS is used by automake (1.8) for its ".a" archive +dnl file rules. This doesn't get used by the piecewise linking, so we +dnl leave it at the default "cru". +dnl +dnl FIXME: Libtool 1.5.2 has its own arrangements for "cq", but that version +dnl is broken in other ways. When we can upgrade, remove the forcible +dnl AR_FLAGS=cq. + +AC_DEFUN([GMP_PROG_AR], +[dnl Want to establish $AR before libtool initialization. +AC_BEFORE([$0],[AC_PROG_LIBTOOL]) +gmp_user_AR=$AR +AC_CHECK_TOOL(AR, ar, ar) +if test -z "$gmp_user_AR"; then + eval arflags=\"\$ar${abi1}_flags\" + test -n "$arflags" || eval arflags=\"\$ar${abi2}_flags\" + if test -n "$arflags"; then + AC_MSG_CHECKING([for extra ar flags]) + AR="$AR $arflags" + ac_cv_prog_AR="$AR $arflags" + ac_cv_prog_ac_ct_AR="$AR $arflags" + AC_MSG_RESULT([$arflags]) + fi +fi +if test -z "$AR_FLAGS"; then + AR_FLAGS=cq +fi +]) + + +dnl GMP_PROG_M4 +dnl ----------- +dnl Find a working m4, either in $PATH or likely locations, and setup $M4 +dnl and an AC_SUBST accordingly. If $M4 is already set then it's a user +dnl choice and is accepted with no checks. GMP_PROG_M4 is like +dnl AC_PATH_PROG or AC_CHECK_PROG, but tests each m4 found to see if it's +dnl good enough. +dnl +dnl See mpn/asm-defs.m4 for details on the known bad m4s. + +AC_DEFUN([GMP_PROG_M4], +[AC_ARG_VAR(M4,[m4 macro processor]) +AC_CACHE_CHECK([for suitable m4], + gmp_cv_prog_m4, +[if test -n "$M4"; then + gmp_cv_prog_m4="$M4" +else + cat >conftest.m4 <<\EOF +dnl Must protect this against being expanded during autoconf m4! +dnl Dont put "dnl"s in this as autoconf will flag an error for unexpanded +dnl macros. +[define(dollarhash,``$][#'')ifelse(dollarhash(x),1,`define(t1,Y)', +``bad: $][# not supported (SunOS /usr/bin/m4) +'')ifelse(eval(89),89,`define(t2,Y)', +`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4) +')ifelse(eval(9,9),10,`define(t3,Y)', +`bad: eval() doesnt support radix in eval (FreeBSD 8.x,9.0,9.1,9.2 m4) +')ifelse(t1`'t2`'t3,YYY,`good +')] +EOF +dnl ' <- balance the quotes for emacs sh-mode + echo "trying m4" >&AC_FD_CC + gmp_tmp_val=`(m4 conftest.m4) 2>&AC_FD_CC` + echo "$gmp_tmp_val" >&AC_FD_CC + if test "$gmp_tmp_val" = good; then + gmp_cv_prog_m4="m4" + else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" +dnl $ac_dummy forces splitting on constant user-supplied paths. +dnl POSIX.2 word splitting is done only on the output of word expansions, +dnl not every word. This closes a longstanding sh security hole. + ac_dummy="$PATH:/usr/5bin" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + echo "trying $ac_dir/m4" >&AC_FD_CC + gmp_tmp_val=`($ac_dir/m4 conftest.m4) 2>&AC_FD_CC` + echo "$gmp_tmp_val" >&AC_FD_CC + if test "$gmp_tmp_val" = good; then + gmp_cv_prog_m4="$ac_dir/m4" + break + fi + done + IFS="$ac_save_ifs" + if test -z "$gmp_cv_prog_m4"; then + AC_MSG_ERROR([No usable m4 in \$PATH or /usr/5bin (see config.log for reasons).]) + fi + fi + rm -f conftest.m4 +fi]) +M4="$gmp_cv_prog_m4" +AC_SUBST(M4) +]) + + +dnl GMP_M4_M4WRAP_SPURIOUS +dnl ---------------------- +dnl Check for spurious output from m4wrap(), as described in mpn/asm-defs.m4. +dnl +dnl The following systems have been seen with the problem. +dnl +dnl - Unicos alpha, but its assembler doesn't seem to mind. +dnl - MacOS X Darwin, its assembler fails. +dnl - NetBSD 1.4.1 m68k, and gas 1.92.3 there gives a warning and ignores +dnl the bad last line since it doesn't have a newline. +dnl - NetBSD 1.4.2 alpha, but its assembler doesn't seem to mind. +dnl - HP-UX ia64. +dnl +dnl Enhancement: Maybe this could be in GMP_PROG_M4, and attempt to prefer +dnl an m4 with a working m4wrap, if it can be found. + +AC_DEFUN([GMP_M4_M4WRAP_SPURIOUS], +[AC_REQUIRE([GMP_PROG_M4]) +AC_CACHE_CHECK([if m4wrap produces spurious output], + gmp_cv_m4_m4wrap_spurious, +[# hide the d-n-l from autoconf's error checking +tmp_d_n_l=d""nl +cat >conftest.m4 <&AC_FD_CC +cat conftest.m4 >&AC_FD_CC +tmp_chars=`$M4 conftest.m4 | wc -c` +echo produces $tmp_chars chars output >&AC_FD_CC +rm -f conftest.m4 +if test $tmp_chars = 0; then + gmp_cv_m4_m4wrap_spurious=no +else + gmp_cv_m4_m4wrap_spurious=yes +fi +]) +GMP_DEFINE_RAW(["define(,<$gmp_cv_m4_m4wrap_spurious>)"]) +]) + + +dnl GMP_PROG_NM +dnl ----------- +dnl GMP additions to libtool AC_PROG_NM. +dnl +dnl Note that if AC_PROG_NM can't find a working nm it still leaves +dnl $NM set to "nm", so $NM can't be assumed to actually work. +dnl +dnl A user-selected $NM is always left unchanged. AC_PROG_NM is still run +dnl to get the "checking" message printed though. +dnl +dnl Perhaps it'd be worthwhile checking that nm works, by running it on an +dnl actual object file. For instance on sparcv9 solaris old versions of +dnl GNU nm don't recognise 64-bit objects. Checking would give a better +dnl error message than just a failure in later tests like GMP_ASM_W32 etc. +dnl +dnl On the other hand it's not really normal autoconf practice to take too +dnl much trouble over detecting a broken set of tools. And libtool doesn't +dnl do anything at all for say ranlib or strip. So for now we're inclined +dnl to just demand that the user provides a coherent environment. + +AC_DEFUN([GMP_PROG_NM], +[dnl Make sure we're the first to call AC_PROG_NM, so our extra flags are +dnl used by everyone. +AC_BEFORE([$0],[AC_PROG_NM]) +gmp_user_NM=$NM +AC_PROG_NM + +# FIXME: When cross compiling (ie. $ac_tool_prefix not empty), libtool +# defaults to plain "nm" if a "${ac_tool_prefix}nm" is not found. In this +# case run it again to try the native "nm", firstly so that likely locations +# are searched, secondly so that -B or -p are added if necessary for BSD +# format. This is necessary for instance on OSF with "./configure +# --build=alphaev5-dec-osf --host=alphaev6-dec-osf". +# +if test -z "$gmp_user_NM" && test -n "$ac_tool_prefix" && test "$NM" = nm; then + $as_unset lt_cv_path_NM + gmp_save_ac_tool_prefix=$ac_tool_prefix + ac_tool_prefix= + NM= + AC_PROG_NM + ac_tool_prefix=$gmp_save_ac_tool_prefix +fi + +if test -z "$gmp_user_NM"; then + eval nmflags=\"\$nm${abi1}_flags\" + test -n "$nmflags" || eval nmflags=\"\$nm${abi2}_flags\" + if test -n "$nmflags"; then + AC_MSG_CHECKING([for extra nm flags]) + NM="$NM $nmflags" + AC_MSG_RESULT([$nmflags]) + fi +fi +]) + + +dnl GMP_PROG_CC_WORKS(cc+cflags,[ACTION-IF-WORKS][,ACTION-IF-NOT-WORKS]) +dnl -------------------------------------------------------------------- +dnl Check if cc+cflags can compile and link. +dnl +dnl This test is designed to be run repeatedly with different cc+cflags +dnl selections, so the result is not cached. +dnl +dnl For a native build, meaning $cross_compiling == no, we require that the +dnl generated program will run. This is the same as AC_PROG_CC does in +dnl _AC_COMPILER_EXEEXT_WORKS, and checking here will ensure we don't pass +dnl a CC/CFLAGS combination that it rejects. +dnl +dnl sparc-*-solaris2.7 can compile ABI=64 but won't run it if the kernel +dnl was booted in 32-bit mode. The effect of requiring the compiler output +dnl will run is that a plain native "./configure" falls back on ABI=32, but +dnl ABI=64 is still available as a cross-compile. +dnl +dnl The various specific problems we try to detect are done in separate +dnl compiles. Although this is probably a bit slower than one test +dnl program, it makes it easy to indicate the problem in AC_MSG_RESULT, +dnl hence giving the user a clue about why we rejected the compiler. + +AC_DEFUN([GMP_PROG_CC_WORKS], +[AC_MSG_CHECKING([compiler $1]) +gmp_prog_cc_works=yes + +# first see a simple "main()" works, then go on to other checks +GMP_PROG_CC_WORKS_PART([$1], []) + +GMP_PROG_CC_WORKS_PART([$1], [function pointer return], +[/* The following provokes an internal error from gcc 2.95.2 -mpowerpc64 + (without -maix64), hence detecting an unusable compiler */ +void *g() { return (void *) 0; } +void *f() { return g(); } +]) + +GMP_PROG_CC_WORKS_PART([$1], [cmov instruction], +[/* The following provokes an invalid instruction syntax from i386 gcc + -march=pentiumpro on Solaris 2.8. The native sun assembler + requires a non-standard syntax for cmov which gcc (as of 2.95.2 at + least) doesn't know. */ +int n; +int cmov () { return (n >= 0 ? n : 0); } +]) + +GMP_PROG_CC_WORKS_PART([$1], [double -> ulong conversion], +[/* The following provokes a linker invocation problem with gcc 3.0.3 + on AIX 4.3 under "-maix64 -mpowerpc64 -mcpu=630". The -mcpu=630 + option causes gcc to incorrectly select the 32-bit libgcc.a, not + the 64-bit one, and consequently it misses out on the __fixunsdfdi + helper (double -> uint64 conversion). */ +double d; +unsigned long gcc303 () { return (unsigned long) d; } +]) + +GMP_PROG_CC_WORKS_PART([$1], [double negation], +[/* The following provokes an error from hppa gcc 2.95 under -mpa-risc-2-0 if + the assembler doesn't know hppa 2.0 instructions. fneg is a 2.0 + instruction, and a negation like this comes out using it. */ +double fneg_data; +unsigned long fneg () { return -fneg_data; } +]) + +GMP_PROG_CC_WORKS_PART([$1], [double -> float conversion], +[/* The following makes gcc 3.3 -march=pentium4 generate an SSE2 xmm insn + (cvtsd2ss) which will provoke an error if the assembler doesn't recognise + those instructions. Not sure how much of the gmp code will come out + wanting sse2, but it's easiest to reject an option we know is bad. */ +double ftod_data; +float ftod () { return (float) ftod_data; } +]) + +GMP_PROG_CC_WORKS_PART([$1], [gnupro alpha ev6 char spilling], +[/* The following provokes an internal compiler error from gcc version + "2.9-gnupro-99r1" under "-O2 -mcpu=ev6", apparently relating to char + values being spilled into floating point registers. The problem doesn't + show up all the time, but has occurred enough in GMP for us to reject + this compiler+flags. */ +#include /* for memcpy */ +struct try_t +{ + char dst[2]; + char size; + long d0, d1, d2, d3, d4, d5, d6; + char overlap; +}; +struct try_t param[6]; +int +param_init () +{ + struct try_t *p; + memcpy (p, ¶m[ 2 ], sizeof (*p)); + memcpy (p, ¶m[ 2 ], sizeof (*p)); + p->size = 2; + memcpy (p, ¶m[ 1 ], sizeof (*p)); + p->dst[0] = 1; + p->overlap = 2; + memcpy (p, ¶m[ 3 ], sizeof (*p)); + p->dst[0] = 1; + p->overlap = 8; + memcpy (p, ¶m[ 4 ], sizeof (*p)); + memcpy (p, ¶m[ 4 ], sizeof (*p)); + p->overlap = 8; + memcpy (p, ¶m[ 5 ], sizeof (*p)); + memcpy (p, ¶m[ 5 ], sizeof (*p)); + memcpy (p, ¶m[ 5 ], sizeof (*p)); + return 0; +} +]) + +# __builtin_alloca is not available everywhere, check it exists before +# seeing that it works +GMP_PROG_CC_WORKS_PART_TEST([$1],[__builtin_alloca availability], +[int k; int foo () { __builtin_alloca (k); }], + [GMP_PROG_CC_WORKS_PART([$1], [alloca array], +[/* The following provokes an internal compiler error from Itanium HP-UX cc + under +O2 or higher. We use this sort of code in mpn/generic/mul_fft.c. */ +int k; +int foo () +{ + int i, **a; + a = __builtin_alloca (k); + for (i = 0; i <= k; i++) + a[i] = __builtin_alloca (1 << i); +} +])]) + +GMP_PROG_CC_WORKS_PART([$1], [abs int -> double conversion], +[/* The following provokes an internal error from the assembler on + power2-ibm-aix4.3.1.0. gcc -mrios2 compiles to nabs+fcirz, and this + results in "Internal error related to the source program domain". + + For reference it seems to be the combination of nabs+fcirz which is bad, + not either alone. This sort of thing occurs in mpz/get_str.c with the + way double chars_per_bit_exactly is applied in MPN_SIZEINBASE. Perhaps + if that code changes to a scaled-integer style then we won't need this + test. */ + +double fp[1]; +int x; +int f () +{ + int a; + a = (x >= 0 ? x : -x); + return a * fp[0]; +} +]) + +GMP_PROG_CC_WORKS_PART([$1], [long long reliability test 1], +[/* The following provokes a segfault in the compiler on powerpc-apple-darwin. + Extracted from tests/mpn/t-iord_u.c. Causes Apple's gcc 3.3 build 1640 and + 1666 to segfault with e.g., -O2 -mpowerpc64. */ + +#if defined (__GNUC__) && ! defined (__cplusplus) +typedef unsigned long long t1;typedef t1*t2; +static __inline__ t1 e(t2 rp,t2 up,int n,t1 v0) +{t1 c=0,x,r;int i;if(v0){c=1;for(i=1;i> tnc; + high_limb = low_limb << cnt; + for (i = n - 1; i != 0; i--) + { + low_limb = *up++; + *rp++ = ~(high_limb | (low_limb >> tnc)); + high_limb = low_limb << cnt; + } + return retval; +} +int +main () +{ + unsigned long cy, rp[2], up[2]; + up[0] = ~ 0L; + up[1] = 0; + cy = lshift_com (rp, up, 2L, 1); + if (cy != 1L) + return 1; + return 0; +} +#else +int +main () +{ + return 0; +} +#endif +]) + +GMP_PROG_CC_WORKS_PART_MAIN([$1], [mpn_lshift_com optimization 2], +[/* The following is mis-compiled by Intel ia-64 icc version 1.8 under + "icc -O3", After several calls, the function writes partial garbage to + the result vector. Perhaps relates to the chk.a.nc insn. This code needs + to be run to show the problem, but that's fine, the offending cc is a + native-only compiler so we don't have to worry about cross compiling. */ + +#if ! defined (__cplusplus) +#include +void +lshift_com (rp, up, n, cnt) + unsigned long *rp; + unsigned long *up; + long n; + unsigned cnt; +{ + unsigned long high_limb, low_limb; + unsigned tnc; + long i; + up += n; + rp += n; + tnc = 8 * sizeof (unsigned long) - cnt; + low_limb = *--up; + high_limb = low_limb << cnt; + for (i = n - 1; i != 0; i--) + { + low_limb = *--up; + *--rp = ~(high_limb | (low_limb >> tnc)); + high_limb = low_limb << cnt; + } + *--rp = ~high_limb; +} +int +main () +{ + unsigned long *r, *r2; + unsigned long a[88 + 1]; + long i; + for (i = 0; i < 88 + 1; i++) + a[i] = ~0L; + r = malloc (10000 * sizeof (unsigned long)); + r2 = r; + for (i = 0; i < 528; i += 22) + { + lshift_com (r2, a, + i / (8 * sizeof (unsigned long)) + 1, + i % (8 * sizeof (unsigned long))); + r2 += 88 + 1; + } + if (r[2048] != 0 || r[2049] != 0 || r[2050] != 0 || r[2051] != 0 || + r[2052] != 0 || r[2053] != 0 || r[2054] != 0) + abort (); + return 0; +} +#else +int +main () +{ + return 0; +} +#endif +]) + + +# A certain _GLOBAL_OFFSET_TABLE_ problem in past versions of gas, tickled +# by recent versions of gcc. +# +if test "$gmp_prog_cc_works" = yes; then + case $host in + X86_PATTERN) + # this problem only arises in PIC code, so don't need to test when + # --disable-shared. We don't necessarily have $enable_shared set to + # yes at this point, it will still be unset for the default (which is + # yes); hence the use of "!= no". + if test "$enable_shared" != no; then + GMP_PROG_CC_X86_GOT_EAX_EMITTED([$1], + [GMP_ASM_X86_GOT_EAX_OK([$1],, + [gmp_prog_cc_works="no, bad gas GOT with eax"])]) + fi + ;; + esac +fi + +AC_MSG_RESULT($gmp_prog_cc_works) +case $gmp_prog_cc_works in + yes) + [$2] + ;; + *) + [$3] + ;; +esac +]) + +dnl Called: GMP_PROG_CC_WORKS_PART(CC+CFLAGS,FAIL-MESSAGE [,CODE]) +dnl A dummy main() is appended to the CODE given. +dnl +AC_DEFUN([GMP_PROG_CC_WORKS_PART], +[GMP_PROG_CC_WORKS_PART_MAIN([$1],[$2], +[$3] +[int main () { return 0; }]) +]) + +dnl Called: GMP_PROG_CC_WORKS_PART_MAIN(CC+CFLAGS,FAIL-MESSAGE,CODE) +dnl CODE must include a main(). +dnl +AC_DEFUN([GMP_PROG_CC_WORKS_PART_MAIN], +[GMP_PROG_CC_WORKS_PART_TEST([$1],[$2],[$3], + [], + gmp_prog_cc_works="no[]m4_if([$2],,,[[, ]])[$2]", + gmp_prog_cc_works="no[]m4_if([$2],,,[[, ]])[$2][[, program does not run]]") +]) + +dnl Called: GMP_PROG_CC_WORKS_PART_TEST(CC+CFLAGS,TITLE,[CODE], +dnl [ACTION-GOOD],[ACTION-BAD][ACTION-NORUN]) +dnl +AC_DEFUN([GMP_PROG_CC_WORKS_PART_TEST], +[if test "$gmp_prog_cc_works" = yes; then + # remove anything that might look like compiler output to our "||" expression + rm -f conftest* a.out b.out a.exe a_out.exe + cat >conftest.c <&AC_FD_CC + gmp_compile="$1 conftest.c >&AC_FD_CC" + if AC_TRY_EVAL(gmp_compile); then + cc_works_part=yes + if test "$cross_compiling" = no; then + if AC_TRY_COMMAND([./a.out || ./b.out || ./a.exe || ./a_out.exe || ./conftest]); then :; + else + cc_works_part=norun + fi + fi + else + cc_works_part=no + fi + if test "$cc_works_part" != yes; then + echo "failed program was:" >&AC_FD_CC + cat conftest.c >&AC_FD_CC + fi + rm -f conftest* a.out b.out a.exe a_out.exe + case $cc_works_part in + yes) + $4 + ;; + no) + $5 + ;; + norun) + $6 + ;; + esac +fi +]) + + +dnl GMP_PROG_CC_WORKS_LONGLONG(cc+cflags,[ACTION-YES][,ACTION-NO]) +dnl -------------------------------------------------------------- +dnl Check that cc+cflags accepts "long long". +dnl +dnl This test is designed to be run repeatedly with different cc+cflags +dnl selections, so the result is not cached. + +AC_DEFUN([GMP_PROG_CC_WORKS_LONGLONG], +[AC_MSG_CHECKING([compiler $1 has long long]) +cat >conftest.c <&AC_FD_CC + cat conftest.c >&AC_FD_CC +fi +rm -f conftest* a.out b.out a.exe a_out.exe +AC_MSG_RESULT($gmp_prog_cc_works) +if test $gmp_prog_cc_works = yes; then + ifelse([$2],,:,[$2]) +else + ifelse([$3],,:,[$3]) +fi +]) + + +dnl GMP_C_TEST_SIZEOF(cc/cflags,test,[ACTION-GOOD][,ACTION-BAD]) +dnl ------------------------------------------------------------ +dnl The given cc/cflags compiler is run to check the size of a type +dnl specified by the "test" argument. "test" can either be a string, or a +dnl variable like $foo. The value should be for instance "sizeof-long-4", +dnl to test that sizeof(long)==4. +dnl +dnl This test is designed to be run for different compiler and/or flags +dnl combinations, so the result is not cached. +dnl +dnl The idea for making an array that has a negative size if the desired +dnl condition test is false comes from autoconf AC_CHECK_SIZEOF. The cast +dnl to "long" in the array dimension also follows autoconf, apparently it's +dnl a workaround for a HP compiler bug. + +AC_DEFUN([GMP_C_TEST_SIZEOF], +[echo "configure: testlist $2" >&AC_FD_CC +[gmp_sizeof_type=`echo "$2" | sed 's/sizeof-\([a-z]*\).*/\1/'`] +[gmp_sizeof_want=`echo "$2" | sed 's/sizeof-[a-z]*-\([0-9]*\).*/\1/'`] +AC_MSG_CHECKING([compiler $1 has sizeof($gmp_sizeof_type)==$gmp_sizeof_want]) +cat >conftest.c <conftest.c <vO&eTR&<){)Fd6okM=02wJNvf zt#jmk+%MwuOuEU>YN?R>&DPap4cwQax)&=;V&<|@+e!fH?>0L$5A}c$Y|fu9^Q|-Y zw7pnzev!`|j=(V65<%Ow*~8S50YIv)M|k%c{34^}bzaDMfkW|?Q_jABLcmWX{(cNG zC7$|uH)I+5k#2Brqe&cOaeq?IlBi`=K4aW<|J^Hi+qy zaE4F&28L?C%O@bWt5G<8e+Y%%s`Zo)*c*&xyEpq2i#ixl>HzjmSx_SX`~>p#`vND4 zz^n|UL#Vq3pW&E;MB`*Jc`vfiW#}6!`Zw8K07Fl9qVB4A0D-0aSzWLr%;}Vh+zuR$ zRsb68QpezqO@e^+0=xgo8O>XceKOq;L2rlDVD^09y90SsT4jvFd|5AzGYfs(wHLYp z-GSaA;@f)#y&pdjmi%p@OoSJIDw~2cr`o^5;jh3OznQ=u^%=b=xud8@J@ROji|F;V z;qJZY^->e9UK%uvvlMzdfL}IBjh(h!TIDnNtXk6K`!yO};7gjq52>gAI4>G&waEb7 zmV@0~6mqK!5Qd+?VNC+)0V~m#!e>;USpCpNT^_|{f1KW5@KurQssFMkaQ<&BI~KP8 zaB&T*Y1nQ4vt-}a?rEh8jNkDsP>d#kVl*6!JI51GfQrA=}7;6>FqpX))B2TFJz-_`gj$WbYX0 z>L05|YSS?`Ea5`>BZF22I5n3I#b=WAw{R59)qN|!7}!WQla%$)xwq{FM;eLg68eoW zJdc>?mG#ILvtZR4ZCGA>AklDa_c8-;%u7wy6$hrhU-pxTdFzpyL^6R*H+l+}1QasQ zWrupseft*R{J6Wdx5Q0h#X*%cn%&D2TBL4w`LG>`IirmX?TyCkjXOoHZ=46+yjS>? zX%t%8?$>lQU%E=7c31Ce2x`+l(z{3M)lEk2)NV}|!QaT9G(yOqZN#{J%Rccz*DXfx zhm7#Jc!JI5%V@({^$lh8_U<$`P|pEJ)zIi6Y@fxOEyFXVtx0ChZ(^E%Pn+J#P3}lK zv^VsYM8q7L1=%oZUAz#_#^+Hqi=hc$Wcy4XX_{q@*%K%BoLIyTO$loJN-urpZO%iD z)P-7j&AE7zWmV&ikx+bc7JWSsw{MP8rv9K|T#{OGrHpQ;E)t{245DR~KNjxHz3=;w z7xX_*K_M^O<1V%g`lVijRm8P68b8#QbWCjZCS2x9KHqltIrl~P_zBR{h!hh2>Fy}I zEi89E2Cc@~d6wBul;T^&5>oDF5B46aO^1+`wwDh1oq$X#2DKgx=S=-tqSPh#KHRopI zzrOJVh2B;9xzmYs*n!e<62G#_uv4ps&v*d$>)s7*IfVpCNJeSay>##RN^}^C+;u+pPE>3XXV<-Bk^>@Q;kCxcnpp9WMtK&R(7@Y>YeGL(zG!(F&x_ z(o6S9?{U-!KiUNryjd00IoNw>OujSW<8)zmMk5Mr(%91?n|DU7x6$e2<7;m|u#up^ zyt%SDxU6am85{Ifrp;u-lvMS!yHZ)QmpkH;q(ff;45$G;{c~_k*g|B)Z&SUdIoN2z zCPs8i*LW@AtOz9 z+Y=}6gjp5c4Mwn_X0Z|;L`>;UlkkVP!k23KKzWZ%N+BDFQt>Oun~DL98l$G zPlE@vLj(0ny?2GWKcCZARYs5lIy5)MC{VYtW@fHtxjv@RFDi|{VSTOXocC525>sAm zYq~k@SvQ%DXj+=zQ%uD&uQTg0EFOnBH}xJ|=p?u8b<)7?Tn7K?s0}M{6o$kS9-?;e zPh$om?Ew1=##{#by@D+hncSs+=i5ix`)%gw8o6gf@q1tD06V0uA8aU2TPX&2=Kip$ zv6rHYg0Y3lW$5jjwGR5KV?ha4oyMjbwo3=HN*S~KNbAh0W`IR|foY#;_FM|h>~X}v zjj-jZeIdg(#Q&M}W{v%Qa7$G1vSpu-_tqVgIVc$k8^v@fanANbD0m?5MW4Wjs|VM{ z-i}S2adx77;6F!1V#k@gz1wKyjCdpWE0M6SC518yZM}1DHWO=_*pnsTmIBAR8+5Wo()Hq_*Z7xL3J0Ggb z?<4TtRlOZOl@Yod(I?cqkABBE(krZL&5;`*+)B;mxHZ=FIs}Sz4kh1e@BS8=-Gw;k z+bYOhJkJdx@@fvHyr$aSw*ADd?-a9#dj=yHdJE!j@FA`bCX0?3;paGo}Jp(rCs3} zVurZ>0@*&E_aX2^B`NX{Q2$S({A zY_OV&tHvDc{*HGHDR>Ns5|v$z z6ED1Wbv-CKl#~ooU^l=>qx5okVz_n~o3}4!yB;H4bZ)bzV@45$hl89^_RqdY=5^^G zZdRjK-ekpqask>vf-=j&CR(p3?=brfrKR|+rE9;r*R7>FX4 z?G`$=Z2cMt(yal=Dsme9%>`b0`gk1&Jxi@^s$>-XL*PJQqOW!rWR6XC)a2r%KBMBx z#GC%5;?~2HM`X-k5LDD9?mpKGgNXLL$|ev6~RM5I~PV&wh3I?pRy-dT1PsNokj@D&V8wm@!nU z(7M)Lk@`2~0?#P+m$q!j)w`=!lT8YdpAk%0JYTWGZoytqagjl~xEyS~KTV5G8t|r$iu!6sc7Jy7sfDyUUg;LnqgrP*iLW<#PXVyjiZ}Y4f z8SqjPQEAs2_8%r`J0{lugrZKXZU3L}{{Qj! zmjzH8s-RZX_LNjB89U+5xW2|ZQJigtLK99tV(DukGDL1Pc*h%4B1asye;m>4hAAjjHer0Y45JG-tAJu+fjyy za77Q=8XyIs*k(5c&%XrDf_2T|jIV^XElXR?TuIkDq&K^$?O0bISqvO*hI(%IWk8Yo z|D|f$=vT#LDU#-!_mh2cg!hC&hU_>ort02(0v7IzTTxnB(~=q_e9UIRzE}j##Md#t ztg16#(w&KL_eZ(!D*>vY@f(;YyfhzM_k!!IYve-r{FY3hjLfgkD?=}Wsl_cA^=>T$ zbw{$@m^riLAO5h}1t?I=7w3aQ36&7Ks8Fu1zkPrI>BZ%4OSbl{4bNQzow?|ImQ0~+ zU%tY(qB*dNkbAiXEn5IsJG!^;08&}WMFcv_lr~}4a7ZM5#Fv8%bX1>J6}*vo)98U4 zF(ejqF%gn8GR!LknN`Yr5(kQ+Lbm?Mu@nUg`J*BeBB_JUy0zgT9+)D$02x=X%1wb| z2dQ*_fP8}hr^5XLh?Oyf6|FOwc_yIvlnt8Vc2q z5@1wGtHPuqx2U#iFjF=a+5Z@oE(Dh5nU4XU9$6Zpdo+A}Tk7uf#NpvuRa%(By&qQk zky1kAT5f|@S0tj=9=&IDb$dqKbPgwsB#cC{$(6P`y;=AQoaKM8c@e)(^=boh9jkm=V~Z((1>DngS>1c1BqkXp**@Phkq@ zB;rh5=S@U8Uo}C^8DI6pbof)X#e2DUQp@F<%f!NWy5uUC`5kXBVYz1u#^NWTma0m$ z8Dd9vS(s-c_WpoLQ=Qf2j;THgVa&X^vnv}6i8p_@z18qA)Z{S;4^XQyO$N}IU!-zj zjg<*_9@f5siaWcfntfkL?k1KQeTUJDT8p0kAfF^ zu5oD5x0UdLkXNt!&sgY}ljq<_G zgP1$Q>$F=+`-sZPG0F-8EAtkL4Ng2~j;bk?)A2nD~y0pTZ5$qfh!#+aKt!HfUjS~#V$IH5@=(D#N5>;~V1 zEgk9k=RxMP^S5U;;=msQq5`^}u=m<;33+o_I zU;WJOP4joSFvCi$pr>MH!)|Y&>V1Nm!{oQw$bO^9Tg5@=Y(;vKpq1V=D!1l{ioP^BztCAQqD& zc}JG-VolcHpwe%x$4AbWM2Uo->POTj9lwq2&O6Q!xQclBK_{j4kSCW(OVj04!6Z83 zXxwY1d>oIW%7S(ED>5sp&);1Xn1m(!L_S|4?of+EgvEijFUGLUkG!>9F471VfMZ`4HjaHlH-y?;S-gA679|8xGIK19e!XlG~%!^6WMYGLhc;>aLsZQyJo zY+__*Y{DRIVr%AXPRPW``5*A>X-plbO^%x{-;msz2bp3?;)=K)4?OPYm}_H{5-)a_ ze_qbm-!xKu61E%b>pwj}0^<$U*4#OKTSHiZU{HaCd?tTq?cpH5wMp*&rS>ax?xn1| za@<2N*Ah_LMZ1``=Ik@@?&rc+38v@S)>j*F)uWjf{n+a`PEQ7X^*sux)GQK_Oqrp0 z8!6q;WO-S}SE1~+%}$8)mj4|gL2~!Ka5wF2xkr>Qd`eNNP}cOp2KQs|IyLeH%T)dM zsMBz=@5OB0IgEoY*WyqJ$1Ulz)_L#$(*5+~zMX9=$rS8Qg50dMZN)UuA77ut!Ci@E{pvKE;QuGnr;*k@8omkeMR$w zC6Wf)NU$5Je`buOSnEyo>4p#6#_GN0(~WstUPooGabb#l|LfV}Fh8hwe368G2;3*~F zEn^wT)iNq*J5oMEbkkA)92vPT?wN{!wCqeT)K_#Tjelnb)lX4I0>>3H;Kop=mm7srBJCTm!h)4eb|>IfGz)84YK0> z`q}wG&x#Lsd-wZ~`lF`pg0^O-VUBH&CU+Oyx@+zgDVAI6RqjfJNc}Gb9LgTlI|rRA zKA+xsJt^-}+}#K#$lXjQ3_zqY+^Lc)KauVP>LYg|rAM9Qoltm5?)){Q5#g#K2Z}Z#^8JUo=<8OX~0IY z&W6b*q0m|6$cJO}Rk(PCA)RN&=LWz5E=mMf!I@mm6D`P2gmB}c1l+AU2Nq^a+k9}u zxNw4|)N%R9L13+O9kB#E#sQ|4GEb*aVRdf~rhfsx)_-Y~hOmAEr*DU5pvQmmtdah$ zEmAJ%3WeYSQXQAo{A^gDxT#NYG#l=;SNo7t2zH8({AiNRh6_BK{6d@1w@}_$UIvFS zx!eE+Sx^jP0Ol{Fz0N4^jQkuSsQ@@wmnpBBQ>pd&fb2@gQ7fQBIRt@}=JCVTSp-qF zi9~P`S-KO&&+80XQ#Ak;f?svM*5((^gX$wNR#&7Y_b|2M7p@f??gCSqm zSfkgGAtr^x=!ARy;sSv%W_L&zhbG2(R;%zbaaAM{%|*k6+PXzFS^IyW{q9nHM4vG9 z*lQqPO6V-cg@=^drF(8>jIZV3DXh>nYDvqE`m3Ne@;XOB>C9Rs@%AGj#xO#~%caRU ziFV4xQ&u~^dDc^VR8GRxe!1UGrKpdK(WrP199hp96miz*qPx4#=R%*-$)B!g_ankm zf9na#V5z7D+tHw<`V`xPaBh-O9S z7D+;!aLdQvZpy-(K1@<`D_bmrkX%b-BE3CFh+l?^*=dzhvJ2aPcy73;Xuu+>t|}u% z)x}(IpPrdc0}?N5zBLXZW4hO$N}SpN2=c)H!1Y;bM~s_=E?zkdk}(x7)Mi{)K%Lr7 zweU74A?pzh{*tR-VJDRq0HyJ1ald@5(UIDpH&`l-pz8m&4g7D&Ha5=x2#!yyOZ^LW zAojef-7WEF#1o0%rDPdRR%ng8l9J`brhv)_vROqcOH9OOo%Fh4z=|6eHZ4vWFVyn_ zy@U)K_6{$s5TLhezwN6Y_19XNSX~|uc=}%ayZVsX_g4%}?$-`_lKzp)kJM;Ui`=5} z=>F`>rVHms4?TJsfA-9xi>OHsw|4*QI<#FUb}*z*URw5MY3L3guM(G1M!a%H{j9QG zxlLYpRN6h*k_hY@jIsIilrx7wH|o;fVDHUJU^N~PRi|OSzDI^2e&-1GS-d_LwZ2UW zrQu1UCp~kLCbU4BhW{^ z0fC=zMvoQo{BZI3j0A}B`%Bb~H-Ki%a*fv%>?g zLZLw7q>6$>XUg`3?&M9&3^b5M>Uc}D+GeCYsG}86xlZZjB~SAt$RQv6z0mNc zbi#HNp>Ls7yej{atVyEQkf1^?ftds$mcpuw%0!JWuGv7cb@S%VlebxBHzTp@kbOMH z8K2lot?r&%_V>=)2pTHB7}2N@zb=w`8jgZ*jbMEsCSKXVlEfkJh9pr;oA@yE!bM?w zPIDmujTosm_wIR~r#EbR_JV)IKN?6S+AV06CXlGd>7a}*7C09vY%-(a{UW;!LBvh! zS2L9?n?;hKIF&H5@hFS*Ev%O#tB*(EBFQJeGtni6|5$t_$>^_3q#9mo zfBrw21YV;vYcRC`mYn3o*x&yHruAQp;f_OT)bCJ~8jPoL(>1F0|k?fdTYT$?i zl-or*5`~?g76@%U#yQ${)`=F@v8$8g{fu{^Q`}wp`-T%&)*F?jx=ER4OG~MOjYPB2 z#G~4m7owR{?8c-6^(l7&m#g7r(K0+PQXDHX^f*-s^s63VLt&d8OG&(; zIl`PXy093;MC~ztuf>?(xhrcVNa z7m^4qySF;eg15v9ajMO#I~?Lm6OE+_m7&~BTa z@*EtM?1wD0-(4b=)3*L1Xpif#=0)tY=Vk`EDoP|ZgR)Iu)3X0$3!DQ%xy7r`BL3~H z=#ezWuWfFOj-QlUla`Rn#dK(pFfpMqN`LFhUrcY{@k4hmmOa9|h9Nmtob$8fz^6w& z=vvHl$S*R`qbRwlZ}kcB6r`w6A>O<9po{K87|Zy<#E=Esrpeo`N8GxY&sMvBKxb7y z>-n9rsXfw>l6sLIG6KZQiJz-`St%vwS>p#+j?678S2oL%UkHFjPc7Hs(qJ=n-ucg3 z7_gUBKaWqZ^h|j*u2D!mS1Rzt77@YfUYOOlQuEz0-P&#vduJanZhP;?tj=s5e!tII zwO2e_cmRQKcY5XGk0lll?qSIDM_4cLlI?QHe|zZuH&7i5=kNb-xMTVss4h$V|FB8> z564Wx+rW-w9E@ul8;(=#0gA5pqKt`@By-GrMcIE}o#hb3AL`cuI;*8s%!`Y>GID-C z27gV~LUQq3vHy?dQ9z$0_o;+g*FH-tKCTl)h)W$Qz4|7rK#-Fa@gGt3c z(0`gw-E))7%kr1EC9MI9+f+8l35CRV{sZ6=QN2th!73%T^X$@h+1E6eT1CYn6WVNO zE=p*LTP5&Ceq37pSycBe|D4Y>;Ti?pjMAfx-n%LjwWuKd=)l(&{CkyLPd977tv4gR zcLk(n-1am<caHTqXUB;ra83*Jm;Rv(kIJjk2( zjHnZ{Q+Ll2QpaCGH8r2o)6NH7Za@27Nssh|$MPR*m>Z7|(~`WP9QCGm%+ zVGM~z(IjHjz_-iHP@4Z#&&)yxJz1f66V@tztz}$Et_=wmvprVSk z?SP16#^H?UWuKKyuh76AimgCe;RBLyYn=pG)cZk9CP0 zGp;1LMzZIQxkX2R-6K9VrlqtvSd;M*qaDs5W23Lc*;w&!?xIwtYgdM@)D=p8L}ydYa%A_#Nk z!BajK92yf(Os6o$*_z;Q`J-=~rY|W?H47Z~wE&lQeKWVRMY|BeT@3pXk{%guC!;?wz)KXgv zH>j9MtRjb@6Or>Sa1%J!teo;-lPxw0c!YR^^@8fyhV@}vu#cuY$e}m?$zPPxm7kJE zMyVe=iy*mnAxbUFa3@kZswgai z_^C}o1Y&Yq&>0Lp&6f>r+>^`00J*z{mM`MimuIeTm2-~B_4!@4jUH|HK7sE|_u+^&MkWvSePy%n`nBB1TSfg=T10xxkD&<7d^uckd$ zol*5v{Dr35~YO%Qbg}~2y$a+4M+Zci%%DuPd*n&!|b3XSEf!ZQqxf$4kp(Zml#E1kfI<|a0yBe>9z+g;wX`nGhtgSScFvr zQ6Eq2IAC$QcdXhOp9g`5F;pLacqFg)3n;{lQ0Tu*Zl?bUO2)+epT76u|Bo=0LQSla zTwZ%KE^{;;VpP_mX&wI9r|wKFovJM%tA+Zt>vp6Nkphs4H^sE(NA=kKr%R2$nad9b z5d0Rz_>QgL!M0O8TweQKZZs+@9ph{?H z>OnfaDOm0_8DmY6A3AKvT_~-P!{AnW94cJpq$>^~I%0a10NBx`ELAg_&0mW3*-eS0 zW4OEOgZ;JXP@ZW2;hQNtQyTGX!0MByK1u3RhUJAGbTd}hXMRDln*nY4zTr&r(0UFT ztQWDmIQ}5b#LbVrVS7fiaGa)y-1_(Nk~_<@aFAmKH{d`$;kw8CQHQ7sNB1gZIsB!_ z;=M-B);;HOQjql_B>~R8gE@@0#nZ8wtPq?J9YR=qQOJ>Qm%se{Qy6w6r%SlwMbjp@ zcq|LOl`lP6ky%q()UI?Kd3^H%|GfiXHNSVPY?7L$CJvN|nLtmZ*W7&qWFD=s-C3s6CKH-b*b~T0uP(qIHoXq(O(*W+Y;#Ks2|3WE^tLyct!P zCq*~4d;Zs*HRt=;?5O{l(~)l67x4rtzDOuyT!LAO z!UDt8)%=e*Lf{RTs&LX<*g*Ou!{Rb$$DGvtfAwrcLm0{5$V52ZBs zgiRGFuZ`EqwU-x=Owm5)p{}>2SOl|Xlg_MC1m$O=+*myA`7HGsLTJrh*7fC5J!tCl z9vQ9vYHMtFcRZCV7;y~uC@N)u0jf2Z=}lWQ`*}NbM>94q8T%9~wpaw45=TTgJ{>g~ zIe20YI94lXz1iz_YqSS%=B(nR`6cW#)D9K_g4TdkPEwTyOtK6J>Pic%<*1{R@xO0S zYSfi`>sM}_#26VHFLR{r(=uu;^bs~#k|!VGheDRF9l7DCIg&DJrfup%97_kt^^SdT zK!IEs;W=1=rzPI=9QA_ph}&PP$qNmt1=NZ?b7{cA4DdMH6aU^mg`|arz+img)cAGU z7Xo2)Ii>P`L;hdjSN4IBd*GJI^=ADTXYp<2Y~2z;ND5GBW@851FY&=hXu!cGiY%)c z<#Bh(?5&3oCk~I+?D4edkHhkFT|g)4ck|`&&lP_Gm4%hRj-cQ<_XI7Li1urN;I8Af zXB&C{EGT#NSV9COf*@V$0YtFC!JqC|%R^s%ak{BJ=C?`t*t)JqkQG){cv;VfXPM4r zM*jRc(%9{M($@>WaRG-mYyfY12t<7lf=TOu3@=3bSpfTJAZPCNkz5cyZoNgGkJ;=} z$?12q9|0Sf<&Evin4+$b8n z?1jDdQIRhkch1;TsmVV*+8%|6FT{ag$oeh=X#?8t2cvGhC2t6_iFnw;uN5wCWLla({QW_-3gy$a+V4*u#jLM~Fqj^ZsP`Dm6cC_0%Tr_rN9uo4m z>t|V(Ms`?U&nEq;>N};sIkI?Fs0xwA>=eM%l#TCzMtEAF=$7*Cjk<^E^j;BVkPRMg z&k8MwbKoXMwk0K=eCDa)?c)Bl_k5Ya(#w`>IE<*r%3hY+8gkrg;~`C|hvPnB!I6C( zh9^m7IG&t8KUT-_%ExZ^70zhys+89_Ze_R~#A=IOTv8v}FoeliLtoy~U~f)jG2t#C zU}i~hG6NP9(&+1%mdsGgYDWL^VQhW{zx~ycpWlGP{YyjF){(3LJtBPVZQzBZR4KmO zQTERK6vNI!W|azw$*OpRHKj#-%@urw-JOG$=K?KKRa|C9XLFyb`1Dm~hof_AtBk2^ zNj#beJ)7z-oFoq~uA!*W%_y2=ghLZq4=LX~F-=Pc;@9&G<=9UD$(rI|1x~=`e)Jn z<>Mo}DEFBfqHA~|zJA%1d5BM5z$K*bEJ;6DXN}YZU?oSh#~`<-_7%U6 z2Mo;3e?ViXB}8+d(g1SZE6XWP0S#U}BVWl5@tZ^KHx+`j+>ANXZ4-R#$RQH)w%93C zKG$tFLieDy*D2p-Mv@yw2|l-us{dZ9GEikTX{FA)X6EX$H2wf%G!pR0qa=2x=XG+a z*(5LAx)lK>Q%aStbCqNUOC3f4EZv`>uUAE;gum~@vwhuMW__)@zVS*T03~#+mjR0a zEE$qD!XT$^PB3DSynOhEV4^@qYoxFay*+wE z;q^IdNSJ^nYUh?z*gqw4HuD2ozLaQX-T%S; z!66%uK*#hCD4W@ZEuC4rt&jg1hDR&?V+Lzn0M+0zPm?p|mr(+^+L>YllFcXj9Et-O? zhT0^$0@U#;z>=3M)a)g8-=J47t(EqcD@`IT zq4+{RI>)=RfW@M$Ps{hu#gBvGNAnpe(!XnmHeE}nox{=-)fT_|<` ztJ-=A!i0h|rNpy~K+;89$r74ZTw#`;DRPQgG3I+e@{FM+%WcVKM%sm>Qmu>f?CbMv%g=TPfUZxhT zN=2E&k~m(60!1jWL!JS@uJY#&|9fn<;>^btq>?A&M}?jDfW8}KVyJ2LcZY3XDqqN@ zWlb-SJRe7z)CdONLes!`IK&`A&d>GNZx0`b?|n1={C_PAsfgtdWc{VDr3 z2ntiYvHxv=|4)1gcIN-YOC-xEZ89Q;-hQEVsO0vKJd_R5@t=(XmGmDc+9Spa^0-_r zxq>{cx~W|jlg?$hhAL5H+*_*AbZ_{Oz63#^49eB9`uEO0fOF5R?Q8S}-%{y8r%tEG zO9$shl1`Qy<%*xOeNG9IbqSZmN6$=dI1Dl#Y0RgLjBGPP^FX6)iF+styKdND4>7GC zOS+YYM62IVB>)p}1RN2J6;x7TM$A6v90qpUcBJBNZ^awn%k*4Cb`%=$ZbmU&w2)LX zwO3>l9^=vZGWT6KB*n32FHajLRemO~^!d7jVDrwLT6vCqN!na=%m#>+EM2Kg+MHYv)Fi3z?Sd@he8Z9533Fa!Z#>DS{cY z94a$wUx7jG7?K_loTb*f;fVB9MAa>nc8>`uJMh##Z%007IlO;9^%f{6r*{bo5mQzc zCbsNGci2Jss$)Uv3JFq_ZU0K=yIF3sazbp9jdxF?xxl;zMdz34o7jsVi9+r_JvGfM zclapu@7Q*iRUoilJ}=XggPWjw@G32|Xwgj%$t>1_&}%`pV@1oW9L`FY^1_6%knV8+ zz2U|DL#pS)Pnxu)@|Gj&Xh=@Fh>qu|m{*3*XSGY{zhK+19ER2bAe!776KWg%f7t0in;S+ zDh32=)h)xWUu??9C4h<0Aol1P-MeV=9U{95++V}pcDO78?mkkx{1tbIW-sv0Xso~Y z1LP?G)BWGRjsFd9W@r8n!B{Hhrqj;YBd>mADmZpE5&}T5vVDq7Wrji#%~B@~f51jz z1O{{sLqNsqdU-vdnIy+Q?eCVDyZpS&KJSjto=7&ruV^+;*x$plJ$t=9o8Kp{JrP5N zFw>UK&TWz^7=#!V1+vjIv-jro)NOscU#OUX*c&fMO|PbKDglqaM^!8nO)+SHzh2rDc30NAPf@f=Srkyytg)8-8mP#>tE=1Z z=;`M}896%zFe-{r`{Ms(r|N1*BaujPbz9bllR9{)prV94`>)_U>Z^5-(uZi0JooL( z_`?*JSY18!DNkKxKOMTu!g*kxDVwP?N8+N0Aq6-L0{>Epe%R)EtM=zbd#;lG z96cR>@;-zQW`a~2E9vgq{E$TV;Lq#n_jGr3bb62P#~$vxqo>b-a(j8jDc;^F{FsRS zLicXh!hKnoW8Z-ik|Mg(aj6Jjiv2|Zy%ut^Y_Saa|{o zc$?^zB#Q+EVfoG(tlnm@T{vQKH8X(3^e3>Ay9L=dAun|IJ*HTPfSoZDNlY9Po7;!+-Y}c0?yrmomI-= zDu+qMpw!_YBu)b^4jEo*{Yy~R!05w)4u{mVk_x)S`mf7LiZo-AZahY#W~gr z3mDAy=Cv@h4B2wOT@(^p(zo{2VC%XD2V)@93kXw{&F%p2e9d zPZ@KeYOr3_Y*Lmy>-Tx<4eTU$+v$b!Ywf+C@7vAhzs_93lqlz~I!XnxYUg{>N=`ub zo~kmpQc-XRe9Hp%ODxT+o=#rAEwRLoKmYrF&d;B#-F<}m5tGPP+pEk=2Mg>r^p3-U z{wEf#s<}sGYA>u{%|M#;Ab4n*5z6}OLkB{2llJL$JZq+ z2U7(Fe&PyuN1T);(eFjGgC`)n-X+Ki28rhVT?h_!=w35;RkvDNiD&?%m-}02p>07N z4rwDkRjQx^{O~FJZ0*gvVs@EaeoWpE*>#9z4tH2`@`xsy2x0H{`>M<9tvf2Xp$Ruq z;ZVlc0kv3Zi=(EEScxs?QToDN>Qt|lf(jt6;hPcaUx9F^RYyB!abQR5kK;gQvY_rZ zb6rcLlr>O@f*f4o6e>gvmu+Nw*CP<^4SE;eSmt)ZWIw^w>r}PCRq0(Yv=T9*waLFyLHG^fh2(~?`m&=+u>qqptVws6 zv6mYl)M~uP0P)i*Ksj@m>6zwVmKChS&!Y+Tmkq-hivgxXU(*u)XPoF3QC3>uZYBnH z!Wh%3P>11WJ?4$5#9Ls(u!J>iEowEQG6gH;Z*AhL13y?&v#i1J@3S?)8h-*D_*=Pu zZw76Kg^f*g*WtY-gG~E!&?TF%0SYfM%wNtW-QAQg_XR$K5QvMJ)U!~Y(koJQPOCXc zT#2rZZZWOiVOvQQPBqde9v50@pJm4Ay3hl1!z$}BK*LTtFfnAYHF%6~t~hZ3Iy)F9 z&*@x8rO&fa$U|9;l)UWqbp7lxJ|`HB9DXJn+yRe2`R(~~KGV_Z>odEVV#tXtdnk<> z)sE;tJ;(h1S)MY7Q6+?L@5{7Gf?H5)yDMM5&7M7xNib20!e!GyKw+8_@CvUge46)7 zL=h^T23xYPXXB}f*&k91jrwrRoU;-Z0yr@cj0sZ?>g}{?{z8V-gt%aElKi%LT!I1y zEe$D6cuWKxORuu+n?Pz=7c7C`7kPu^mVkAgA0dJx=B+MH= ztDTxXRU%7mkT*JQjcIIQgV>xPIi2WtC^Iuq%$7GY6BcCIof!>)apf?_Bi-BBIT?2} z+7d-Hqw%MNO227JYP{!!BU!YjZ^H9U96?ANhpHylk6mm6QgJdZP)_nCo@m6ZG1BWp zBiz^5*<&2}`CE*LM>7m_TAVJhX;ZSU<2$MbFdUjHt(KrjwkR_?S?}f41cc*YW1LlJ zRx2VgeH;~zdoMB(p~!naNE?INgX=2@!}SPgfehVIYYzk}w3eB_^g6SZN&11MZ#Ft{ zk;M6U7ZuYtrlfIl{}6y{HSI+~rQbx&$&La6%q@o}_J2(Rxs#7ao>?E-a7<`+OarVG z)>|vD&>OuxmrNx?(E=tQutEeoz7ws8@yrn&g)%O7AY7}SmVi@j$Hajk_&IUSR z6@bH9YIeVZnG10GLf)>jd+|gW3d4!jiXONaq{**3P-l&&E^yA=i$D7O0R6%Hsnl2e zf})%DMjkU5s}ai4DslW zJX6-OBF1nrXGw(!7iWl))Njnm8z33X<48biP&{6)Vrie>(W!lbEV4(2Y(ujp!O~6q zH^aLI*Le{XpuZg#(sTvq#cOraOKuHPOpIE|YjC1fa1NKG*)jpOJwqe@DQpu%V)Z}~OZBHn&I%hOvznyLC=edl3YG`yDi zJZaD4cG^TSIi2hW+doPQs0C%O$5q#C48n?6M=)&v1Rx2#^w2S7Gjj))q3eq>#57J| z2*;MAo=4@MX?;ZGe#`*Y-tvPulZ& zd)U6{X+u=&QV88VikKIl_jfiaG7JI3^5VJxA)tMIk`wj`jp6psFGFmcY;>v9um-mgp!K^F z5F#FnV%O|}-PCRW>-HqxhQ9u{tB=$Fx7eSr9bYm1 zPozE*8^?c;`nedJcE=n~zWqZR;kKL+EM4(8%3QfF<_Xrw?=!EMNkGt?BJH9W!$9_MjPjeIQ zFCnSRn6Xt}iOT#khK;E5|5Uzi^F-0UR?XYh<>N(cf-X%&YBra@V_AB?{@9dHn_@>>a)D^%jKO%z}E7sHE?3dQP{{&@Pc=jRI)}4 z8Jek9?6zHdK7rO`Xl0eVEY`bDBcs2!!>_Zam-9F~$LpNu%Xv0gV)}kA?>y^Ve~%e{ z8`WY`41hJRUb`({<%tey`ey%gw@EFCxd$J*vDsZc;jTmiMau>*GyuW*R$pN3+G^bQ zc)0Z{&>Q|NNY`AW%11x(7~~~*CgILg!s$9-3+(alx%C8Du{IaBC0cZwq+ESwv#0VF z{we-j?`8jdD*BDlg|r??-udWS0WASM zaY!Tm#pOLj_}c64@OtPEgS_vA$AN7$z5984I#2l(X|&I3s~zP%Lch_Clq)H*oAlVY zG@j@*^c{k8D!#_MK6(eASIscSlu$y0B|k*NLte&-h-Z)zvd?vy`GH5fh+6c)WNzM* zNjxHtqC*gg6VQIgM}GMns}s_`NP%(?9I{c*2ISAfzGP!CjpLBX{-$MkB{XO_Te4T$ z)yMQ2ph2a&mG&DC!?^$oI2iB>6!kow`?}4xPJCt~8o+pFrDn~5;2SzA!L8#YaVD%k zXVNUyxT28{WQ5QyNI|;P`dqw(a960R;YrqC{V~YK@+OstH?eqm$nM2wu zb;3lcsB(PLHQVK=lwg&)9qd)1Mxgu5tHcUkNFfG+yldHcT;T{;O&{=;QPac_uD*p6 zRe(OjHIUAm2*ad6suhSQ9U|x4hWd}`Rfqtc$N{zUE(0*JoZaQhTs-`n&Cr>EL*MJ0 zX*(1LC$bmvC>1BTZ+AMz!|=Vv$OJ=kA{10%9O3gRW&3L)aWu?6;vE}L0c?VTLtyJ{ zr=c;WaG)zAM*TaF4om;l^Y6H3}q^a64?C4jikasP*~+wjMNtb zCsoW%(@lcFJ+9`+WPW2b-Jr=K3thzYe)+Zc6^y|<6? zp3}LVzkP)PNO^xn=?v15!F_;G zmdS@q1<9hvdMWxi3B-Va1^ar5Kv?guaf5w`V!BI#+#e${Z}QfUCCWijT_lu0`NF5U z#SAgDSz8eHWg-SUkoM`U1Y_}bZS1wF163PZ8(s4 z`yi4Lx*(82CWS7hj@Xqe1JLel56ZHYVM>+B4!D5;QmZ(9<#}W!(lJQRCJ=p&kCcp5 zp^R=E5hZGG!_K>7i`GyiD``em(tvm<52Z@p;gfbMo-R)cF7lny zr`IFwx>lSibw+hj&rru?(XhbBzm&Xw#_fI$KVXI3#2qJ8-VPGmwp8x2w~=^mZ`e?2 zI(1DHJ&pp2B{4BM@Uezyqs2|zli`}8WzL!;;V0H^87mV>tLxBaq2WY0QhUlIxr)~@ zDG_4@T~4Tq!6B9>Y(Dp#<1=t33F4#I@+B*AZ2U33NA@kNl1 z2iC;IZXC$^hYzmlg^M7 zZ|%2h8}nv(2TsSzz!m+)2M_zRyATK@GZ&+Oo$@$vdJ?IxOzzo|kD*K18c8xn!1f9$ z8NJS$3lP1>JJi)^;u=<|HKhI+o_~)J*42ocgGEAt`0e26%=PIYtv(bni|UD%`?pO< zJ?(4v2_#hiL<$OQWCJRIes$q`a83lPC3OKa!azq~L1 ziFN`E0Ze1Q|&F2dL`+%XIbxL&)2w}V?@Tcu3C#)EPwy4zbGan zmwP)K&HrJ90!N|()%Dc|r^ECbrG(!DdQH;{iroGUGpj!y`(#Z?iCOb~7LEAj>kOBK~ryWx-x3@EPK+K1fz z5>7}Vz|4YAmEl^lvTx-I_XaZt3A2ZGQ0l;>;Eo1#WYw@PL@+QMiC}WW`)u$aMbykl zAZ0XCV~M_%IdLGEpaculyK2SOxMsL3S@#wl#OUT}X6-(7eIP*sJ+;?Q87NL`cPXA0 zqr^IsQ4R4m96ceO!+n}8h$e~v0;yPHJ*CI*x2u@M0jn-40Nhh&E~gkg4HZN#;ZQQT zsOU{aao%n9nV*{q6Yqdmq+6p|K!W9vkdrK0LAwPow%k?7X_oH-#Wd!K+%8OfDe-4? zMNR1U^7Hd4%}nQR(X8mltrpBh-XqVY`6yOs^0bfU#cng5o5{Nl3C?jJ8&7~ap00`K z*8z(h&c5xsAg!b!yvYHxSmttrs4<}dt`^irI}Pzf5}=6^5WE!yI1jT#69BmMTOceq z`dQ0Nvk|ANoVxc0N{CNrD_|ru*8jYM#j0XY)}hk+*b^fWf6a~9^9P{k06X(T3{H6S zz8KH3qeK``_Y&6yT$s>XvkItahnDI!5zhO@gJV@k-C+*{AshhRRGaR#4}d-4$_+-p z5=~d;R0#Tv@KXiX!B0~lpz`IVDw3kNe2S6=}^Q}3Lfdq1EN#uTu$C0C> zLIR(h110Sid*2{CA6dTNEx6g4@=mfw8n%mphG&pM9K_@n_`@{SxLM0gT23K`K^Krd z`&ef2rK*Z5EHi=fQ;#febs2~$OIU09xAN=Ug{PDagzIVlyEud7CsZcP;Bu{WR#k0M zysfZYEyE=OfWM4j-;lKwS^`Y)NQ$;d@Q#xtb66p!&EJuwmxY>K?PEOv_ILXT!sPK- zr7SPe07=?#H_4-}-Nxe_3l!D{#7GHKV0nas;|FD+eKK77WawDs>rW{RXs=}Ji%Ui) zw37p+DKBlbd9tFBJAFSiz@vbP5p#@C@Zon(^2wcmE4?z69|bm?0`r~YNth9C=KJgf znwfs_ZHY#(p>KR(mdP-nABxL;Hx@B~W`e5gj!Y(g!aWUX#SZ^SXoDCD z7_AVL0C>0x-KV7u#qNLL`zHvt_fj0~BtOwNh!Aijv|KO^WDLZEBqT+F65!#(j3Cu# zFB4}O2{rRF#*>i8E-z(8{>Dgf1Zz+vuFqJi$E^-3LrDg3i0vQ)4krqZl16sVMubuT5OY4q=#wd4yJK~%{zkZtiz@y9*!#Tp^HQol6!e*sS^~RHZ ziWW2ky)X1!r>>b{o#n_*tFb58RxHdLDI>GZzS?}c(2k>818YR*%o#OVuXZzfEW zHw;relmS8hF;Urjd1WBDG{7p@);PNg@%GbZb~}tGn^r{U5)t ztzwe$L64_ALId~ehYQl@?C5{0S4c_U&=X!p>_j&g;dVFTz~(c?sNq(TrFNi{GUynj zN}nW|n@(D|<#;g`xKQf%Oo&nW9>=B<19fpnkpVz)LSSk8>jGq9oSO+Z1L_u{bQ$f5 z&EhD_yuwPMbG#wBFM(5Y`m^oN+tDhVaa0$7GbVL;U+q*oaFP(AR`7* zL7&{MelOVByQBZ@pC~vh90TC_F><=I_#U9p*(^Q^pMNLNI-a=>v$V`cEyc^Lk6@zH z?;(Cnr+2zj4{2W zjdQPa28kY1bPoem`5Slr&Sm#JWtifTZPNe~kFIZ7WxDBR;-4k)5S-oxx1IBL_IG!3 z8AtXkJ)&0qf9hQv>9=V6tawt?c%IxoD?lGtU(f5keO>(}mq$o=Gw0f98~o}wK)ghA z752Ub$tk}8drU+a8?|ZoeuReSncN)<` zeIK@LZyp)BC}xpad>^rDgQx|IJ@wSKnMT9TjbS0H$vz-rM>tAd;MdLYc=i5Wz5V>e z!MgTp|KHpGIx@}u|JHT=Z>k#Vg*Kp(5#C9)B|_d&DN3)e*^M zWARlmVXj?4)A?nA^^%Y8*^_)LCaTo}+-4*JkSLBf`6p34ul7C7-t*yHTM^)IUaEbK zdF87MnnvF_nck81<+R1 zry_zToczwlxzy#X4H9#A{Zm~5#iSu4M-w&#KEhKI2=Z=-#FHz2&*8h_j-lgi0UT)Fxs zh6bX$CsE7YZ2G_vkd!D-*y^kP`sL*`VoM(W@FNGho9b~Jx6ztrw1|a0wkBG3(Nvaq zQp=AUx8s1zu1iT%4R*2iz6T$Dw3TR=yJ$PvB9zIreqdZju4)SzzgtsfQ`1hf4q5^z zG6`P9)yaUW>TSQUN=JC{Eao2hX}a%CfNIX?VE2kQPRi+RX448d{Chiq0B5H@|JGnVoDfH zg}lkI;({PdBmTxE7BzZlnM9;@cgGuhJ)v>x(9`X47bwhH+R+d z>UHxX5xg<`L-Kf34k_JxaZ;tYVGY7Y>;z{HW;jT^>Pi57k(dhAWZQKSBe@4?_Bt(-*`SWD z`!-+jOmiXy^=OzBrr|$jZZJD@UKl6M4gJYS!wmtfcIl$s zqEav#tt1mzlGg@-5!iq5b|>KKFlZRO0llYTq)+ka6S4doYLbDu3C@ZLmp%^NQf*1Z zsCrD$DQnu5xM!x?%1Rx3&ebu-PGR)$IMjm)pYR#f!ox%JYRZpk!P$nSPp$WuZOot4 zcA-0!Rzc=LD!DJr$3oA?^qxMj$>VhS5C6vB{$1KI^Tv&3HXLJP#)VzyySG5xG2(5@ z+`!)+XjOu>E#t~jt-5NlAN)b-P~oqh(2B80{3B-y zR4KKG$Vd17&{@w?#awQfk$)Vy9{G+JXBDn^Uo*b z8c^-IE5Qm2qS9&88YLE~!Y8w$a$#DnYe+5_cvmqppvm1(n!C58f#q2!1e@SIv7q-R zuZ%_J<;7^+%Vx7y!}b+GTd5TE@N~Jqo|h@`aE%4P?eY8@xSGlex_3(-Td;uI_u2V& za^k|~>zl{5GMM|B+(?NqV#o7T;Tz6OF#cQbU!*^%>0$KmH$Qkgx?Sv*>+tdpawLF@ z$$_hi)Py1YgO_O$L0T4+a#tk<{dO5w@NWpuh5kGk`$y=vJc0Yo0rsJ{tnatBg7>4bLU1K(5Y{>^{3!Q|fonJx0~G5A zUN1uhV6h^wl>lr^OwrqILF7Hitx1+#KUDj;LG)0f^i;9LFxUtjn}J)ypcp7N4PI`+ z52dVqjwRTr1O|$rwE&`<5Ww7qv^HV2gEz?R@`~5%^u95ymCS!B9nAle{fF~E4WzZI z`^wuAFn<00L(Du4Wv$lUy^Xu4fxY=Lem|yGpEl43L4C`)O z4923=mi&_WEqmznZ$ux_y)=P;C#u)>?n~dT(mWhd&=e89PnV=k5sNUU8zh|Tb$k#q zU-;ARdj!e~r^xgY&8pi7Zr&?kJ5sx&+eQAX#^ zE!cSJ{&r>P;Whru{Yc`S{j=bVN6pOtkRW$GCF}USt%_X8pS@mAo_6AsSklSa@+Yj& zU2gB!E*@j~nHJT0ub>%e{1a5aY$dd?cwula^S_Bp^VN;jF~g1-&1$V{bP#!6FfNg8>l%Al-FCosI31ulue&|0FEH9_;aN<1_$dm+NO&3;wcqPYQ} zbhYWf9vl>GDyg@%0T=ZM%Tn2Ot%V0`Lv#|%z7AI+g@bR0*T&=IRhW0uQ{C8{b}0L z-WTLp;W*h8Z@OZD^K9?n9zAK^JdG&4;e`qoQ%P$%ps$0dJI2XYwGAo8K!^h|skQ z9D2p1$v`bIR0|lX2~gHu_vtWcFC;I-ug6DDD_)EauE(xVBH9be)W4bZK-b7aYS7sQ z28IO&#svn3)Ys&xj&-8}LPaE34?!h{#j%24%Q**{!Kk8w3WMru_UsIHg;z0Qw#Nv& znz$|i@@9v(haDW~?SKxxxih9=m4U3Cw7mTJ-1a~J>-ygYa?Jme&x7edY#z!KDhw(N z07Al`&cp;v3KDaw5GOzYEao7A|LpCj}Es6-3f{l5h|A?cQCc(`^y~B?Ub7cX^q9e#LwKyqnF3@^3z% zf8FTyUi9R>{qd^vT0||vo7i*Tb;waRQsW?Y3)pjgn|yZv^88>!7_Om9S)oIM*CmBH z9fT1j)Dgmd0pC(yKlv@X+gwZg1N4ikG5%c>lLO%X=nW(eO__4==eh%rYn?jgqJ5g5 zIe95TDO{VfnbK)1{T1ye(jZ%E!URic;bDHJZJvF0}|~A?&%v`})|$6+%6F zNi=0)(9)qr08L3p3F^_AwDv-_Nl3WsB_ISX7Q1ogm`Rg_(_W>G{bzOz@+;7OcYz{~ zX)lKr0*{;r)rK-X2S4uUW9iF5z?N%VEinEeqrFE?sszHuA&aV#TB~*zG=PUrEw=e! z_W+`p6Phe2g_8&?2^=G`L0s0_!?ia-UVAp;i!kP4opcyEPABdLw;gyoY8^}--dP`EuLY3SXB+Ei7){hL zJkQB$M3^_C?HYq1#!;5m+jh-FJ#`jfe-RpO2u}r93dmJ)B&jC}j^=Tq{-BM8_Ia_g z5lujIk8JfxI_ABR2U{nG`xYEj3~~s6i*B;AmeeD~EGM1F5KU}x7ezN4#DI<5hwrjb zB9g=N`PN$t0k-cbSwj@gHiA)shLc()CnDv3ds9nQrh^>q$k+8Fd1aL0dJ}+2dA;6ivq(Qaw!Os24V)iXlaRstR02bG-%%KE{_H zSIHfDwlU{Mhh!%iNcxJ}B~2l@pw9`(qpqums|QUzSu<=Ixcwep9!$4Sy$cBO&Uv>x zxX3tiAquqpcQfoK!-{P*Ke-~I*F?xdWON;o3dU)hOW4fqDH=2QGg+C*;61z_KC3|0 zC2M0ce7Umr+ZXyRN~+}x=`xz*R8s0-GPkz+cscqyb z?a8%-kU_C7A0IC~2yL|O3U3yIn@tq4_g%5+x=R6%EM&0ifi?{bgmVGg2XN%Wz*?E5 zs+l_Cr!fLe)(aTMGU{vu+pLd3pJL^Xu$8l~xKg$a2#DE@0qb?fb&&8py!d^gt@a$F zY9#o~Ctd3$*A&6wBR6?q(jh@EI{a9Me@*k$H^- zutY@#S!0v^wt=&xZbG@pF_m<1m8Sgo4hWunJs)j=6PhULqri*ERxjnSFC4#u8~lrf z6ta4I$zH|X>ALk8X#I`@)D`;CoP2Zy(q@Qh+O;ob6MPBN+D;bxla!oi2`_CCS?ORf zY-xb1VxHEa?kuhkaJj`&h@}`^9CB%_WlC7t1OabO9K3uMBC{A4nAMgkgB!tmJhW}u zM8}yG+nMc(h{ssHVxoDX029MibQSEqgcdtxMVRn=&JPBff=oYa>>L@RqL>}bhD7m* zjbhL!7nl2AC1g3qDK*`XX=Ev=EedOO?%C3{``!vD?uZz3wy3L=)XC9?ty=x?*#Zt- za=}h^j~|HY`)UdOMVMehcI+YP{Hoz|aQl7S{=9zfek-3oP$5Z&#rX!^u75Kn$Qwf8 z{Ho}3MD=6$8>Es)o9seov3^?$>9T03uWUt@4bX~zXszvwGxOVryQdG|3Ci!G*jM7k zfVfRNu~tS6R7rIM2mmGnpJVE+a03Jw2_EpkA%b)T5Qdz06X$ zZuxzZxM{XNSfwq?i-)Lgmxz(IxDXQtBh6S=9W7x6iexM{Q_!BiS&D%IzZFGq!B`gn z-vnUs2PhD?;8a8v8FSu#KX3gH6>C}kOKD~KA3^v3Y|dxZZI!n<{x2RN-|hrXt(IN- z&KFAOpyNr+$gWQLYmfwtCw*hZtzbs>uQzFJ4#!|2N=IfkQ!LGWU5a_WuiLTjV+8t@ z|46dR-_SjeGh6b#ZQZLxgmFWeo|7fwDPov$9nZ-VgnVVe?!N2}GL1nwIo8}Hal`-)lTFnrPigG#AKVcQc zCoTUJ^TKSJ;83G^0YX!?3+E)=OYAxm19^qZjl}= z{stN!z04(0ux@tN<7$Qsh;Y><%< zJnf;blw&2X&Pr69-5;$ZYMfAVq#kxKg0mvSov( zX#>4zgG~stcyM3?@kdOSl3cofviC0Uvje+iYB{ zu2u%B0V_t* zXEnF*{b}rHdtFZ6af|z`S~= zb^_P5T$f6zJt5V(f}YO_I8ZeuK2H^ITEb7%3g@KBO=i)5D0kd+$C1NsQhLUc4Uc?3 zPPxlY8S?+zWB9+(?ra?YK}+^(XgV+dpRcKqTuqL!5HptUZIT4e1G0^styS6(4@Emt zbt6f=3G(xOdtBnFuz?VSs%~a=d3kw#o%mQ^7z6Gbk~rbPIc9UpgOyP)M_QP}?L=fK zLkF9PCB#~siiPYs{_K)S&pxThxUVvx+cq(^CMhG^RLia-UEjER#-sBj@`SpkbQ3my%_B@d zUvbMN;M%hd0!CVDTm8=6DiYO?3&*!%41cc|ORt5JT%j$BN0ytFHL`tLeiLcVEUKxo z0UmAbV0UhqfIrY|nkIYht}b%+l<#X;;NT^aZ~+T~a_c z@irR2JwL&O|1e9_X*$<7&CG(};gcrwILE;BBbF)Rfo+$jqg|6^hw?b}t`_!f5!jP zBM%eZ(x+ACMJs3aovnDm00SB&0|lE2K|X!jr&yk3e~&kQHB1DYYO5Dy*AS6-n%*Km z1a!j5#&K@gVw0=@7M02wVkdgLg+!1yFgz79d95g*5}McjAG$Lq`On6tppUtc)-%uq zjw%RXr-33l$v)T2DQ@9A(TK{?fW6GCxWmM49YR@0>mWQ12lUw=NZpUw;fmZtbz)yZ*;A^RXKh=gaNl54<`<@K!HF zOYsTW^MHbR9#*=QRI7JlK(ki$)hPVsZx26*HODr8k;A%e-iuS@)=*gwPE| zN86a;hZ04JDkFO~sc9yVL{VMJ_(Y6hit{!S^Q@hcJgx~Qy_HfGs!nUX)PW6*Fg_drSIGyJpwL}j>o;E{IY`PBwA9-8-}qUyyk@Q6Q+MJ^g- zhf<`wYXR4h8o4qB*rCz^(_$mE1(Owg5nV{dv91m+5u_-%TZh(&p4z(+mtKaX&M2AP z*h+7|>hT3lE|-uX5=WgH$9dfCZVTTT;ADU89<};R)hp|=z*8bQLmA3f?XuKM2*s1t zho1wR)$7HC+wg^YaXbCZ06M=8p5#6w`A*6Dj#W*`FVPwcBRl)_chv4eCABZ!EV4@o zjjh=N%lo6K|MvL~hf0r)W7&0&#;ukPcNCNQW6i|h1Ih`5tTL*D{5ilqS9$vIwa-6; zmnHl-Et;@UYU)+`x8Os8C2t=o!VgF+V~&I`n-kOAc$UhB>}Fa@oP4oDii0pSXs(PH z7fpcNlk2WIsVB%BH9lZTLEu5Eb{;nO`Ib|^1z!=%WiI?Jr4e{A3g8ZgyXpjBd?t}l z-g&-d;K#by&J`r0%JF8D&Gj`3{uKnLGK7&!ByDvHE<`9YB3VcRVY7bat z86FOdyDc0WJmfJ1rD6xCoI|oF5A942^7KOz6B)jx zmKO?R@L5PfCnz;8lCSU`kWEQzs>{wTgKMCxF^1~tt@>^20asCz1TYD8@o+|(1$kLf04KUiS<*v z321J2FldB>Q^OTzyX}>dHZ3xTjrU9=&nzIDV&Dffmta(KpG1uv>v9<0^W#@(E=IX+8bQmgh<% z|98((hxa!PL(?a@!qm<;^PFk>ob|50@3`xv&=x+M`Obn>uqnk&@D8+UJgD%rMK~+# z>Y8Y<{lid3^` zQaP!s5f-YKlRlXz8g8_pQuSK8!`ei+|pa!?QB=K?S0?>2T0X7c>c`|z`5HnPLIQQLJz>AYvaCfHxL zv>_9?dXBcCrGvbAo9V5_wdek6KT6RnTDr^aqZSNWbVj1#880vR z9i~Dvbr8{#Vj#~ZZ86RxBywX>f{hX9)Ghb9BF(e9Ta&5NySH+cM#|vLi$E)MQI2SB z0t1`SK)r$}ap1LMfwG-HM$Y`Gy95TGeCi_gYV8#09#YWk95LFB|8B*LO8f0Prmx9^ zGB25?U)>W;HE{mr{PGfOhLRkDFvWG6A+xfS7YH3ff1&gxe5oz14x`5u9qkD)AAHfs zA0@2~f`nn}B0$~jGU|xtaX`3SDksWL}68O}vu25~W z)LH6rMs1#<3Al+=T;}x?Ruw-uZI^$-A9kRJl1BjqJLs}Zo%KEk4|4S2z>Y5h8hl?2 z&?cZkM4=OB@rPSz6K;8976p?P(WYkxHrqSYkeWlU^g{kFI9hSSddE8k6hoj-quXL; zEY845Pa4H0qL-_Dm&nPWprp6goQ~NVI*@ll`KDIK>|_PPhcTtni`#MtYj@v8JG$+U z0YeG?`mnX|k`*ZY&O(q`Tc|GREWanAWTJ6L*@$erql64Prfw0+ow!>j;>Zk#pdbG~ z(*CK*wrGvEMRTTY+qP}n)=X#4v~AnAZQHhO+s4U#;zr!NcC3dLaUVwXA26b~)_VJD zDfQ977W*l<%8dd%_20c0PJ2|rRedj{w_-59#|&rSaYep$^Rxpwo^J#tc@K@6S_b94 zCPkF{1F({4vbAWSG?qhprywfaA}I)NrJ(Zj>mpB&>$OQ^2*c({tOKr8mpjk>jQ+a%+}snP!V{4V|2F!a@^Jaxl0#FiZrcPpBMWImb zoW{I_y=riE4jKHyRo?7mOaUxEcD6zofQOZpaA3&!kyyb33`$yr&Par zcmvc+r4ByS?xanC&krsUJLCh0R!?7U*NQLD3kM_3y%z&;9JSMxr zp1!MC<%7~kMArrSCSWC6j zUT|eUK^aMfbU&G{7nW^O@`@t2fupgU@PH%>Q~1h$Z;xb%)GM$l`6E`LC0&4~El((8HqxyjixIJZ6JZ+grC zJsm{C0r8KMn4dp&3_$;FBF+3inLij<7}@?q%&Wd(|7)Q4x>36=BVi&C)OMB1M%J1x ztutOpF1aFh^CcPI4ANa?r|!bGl4VSDd=Yi*`1?6Jf^mI*OorOdl-lDgAO4UXh#=t5Ca z8#fb;w|dX(r^Co4hr6ZCODxJ~cA+#A;QTLJFM{M!$i!>mjTZvANi$-8SSb^Qv}`id z{CSSy_fqQCvk0e|?HGN=KE`$_&tJrA%K=37ub4tZ!OBTN1{Ke?5)lxgStzVba$4s3 z+SjNq4WcFT8Z>5I)k}>CW6obgk0pA~=p8CDgJ*zal{>$f@VIMNX*DRzs1Toa_<`s- z^@xn4K2h74gSjyebT1)CGBs~yC>IPOKmY3)Kkz$OF5D=xfeSl4XM9NkebDO>7$%}} z+V>BA!bH0u=bJU~vXkpS#4UQ35_*>blKkrME6vc-=xVyVl?U570OLWQ&;bPdkwec@ zJ7_j^Gb$M#&bqs7RQDeG;AV6ag_8EO>UsE6cOD>nnEYZu2>zrs3BQF|RM@Nxnhu}M zB_4|r)y~Im3w<$uG0S&Xf&?9&(iOr}B;*ZZ4v8;-sGN#ce7#72{6+3!bIr(@-TgV7 z_XYLxEYS?||k zVrQW51BBx6$}sW`@%4mB`zie=*=Ap~X4R}XR6I3{Trl{B2EkQG{>@HtB1ofzgFwpUrZZZ{6ff$x{<}rQ2Ggq^CS0n40KLH86vACikrWOy^ zyPum@riWLDMYL85=)4eX>1VMITltP!yD+RS5z%*}WZmG|;)VkJ`MYn2N4#+(&r1l5 z6VGVKvB!lR*iaB#dRa17^T3^q>{h1C)pWTdhRF>PeIFZl8xtFM<~dSA0>YPkeA;qg zVPM22b1?zPO@_j75cB4mGR7Pmyn-(pc4SP@eVgnM9wrd4>~d^~w+$48*U)nO7-74l z?8QMKbC1|m%rY$CF+g6nFXHI+KkcxQK#1l4CjBlwwX*L)cvYtEQ%DdWbId-p%Z;V*LeUl2J&oG7fG%$9l;yvWRz2HrmA_E0G& zX{3#=xqOnn6_eMx1I0jK>tXP(dmDpu|IKirU3$R3U_t>2#-0j4wC1(E-Fsu<<(|yH z9qK9#Zlf$suAbnZ?-F)>rJhq*U#Bco*rr~D(u7i3XAD4w-k-8U93BSAEIlntCmQ@405Y_PTz+x~xDo8O3v|T+l)Mk6jJ#A2V9D2B8v^Ehi)gXXwcH0# zSAm-9C<3Sz8*-2%#EI>h^j`e$5Hf#$e|k8%dnQ`?K!eqYb*-F&6VHk7uk@J&Dhqz4 zI}R`v9#hJs;_2($JK!2Me@;b@blFpZC70zjCCGttKbtN0 z*$q2FZ?)iKqLr);2}wE?BcnwR;)7NcI8`B$w_3e}+V(9}tN1scPddjaR3W$v_-)l3 zBTc0i=J?&jGp~JVlG4fr^1f){krl++==CyBKY%YthS>LVQ1n*zq&;AVb#2!==twT(U8XdrRGr77a?jhp+YhCcH-Q z^`Jtzmrfhy=^QU(X$q@upI~Ajvxc=JDbhX|KSrIlVaen}EB5YUhph*IKwpW}l{(Ir z2BanNUs^+?lvKK2&4DoRP0Y$gC|J9S*V^SD*@N8y!<7qnZi#wvQb0M#J@Dzk$TRTa zv)CMIoeC4Fj-8|^XAjfMeqC5DV7qn>GyItR-32FXuyUFuuOoULH;)e?0kLY8jvH@$ z&$TwEEh7AYZTS2bQx)TrR$P^pGa7_Mm_1zBb%Bq3d#Pw_abd{MFlu@{ zgheeA5TKw#MSpe(Bs-&_w-+bWJYC@n*@4|ADu3-u({xn>j{N8Q017%anvj-*d^GmS^ssHDp1~s1X^{sB zofna0tRB8_1%^}Tw#RjVk>?F}>I^v|%az_uB#Jfh>My8srsU`3YBY8eB zw!rm1)G>i1-RyTunp?JuiUl}jPA+0=@WKdzv*vb@SYuu5ZlH$PGj zbx*U2ZMv022JRwbzDx#h%c*V^Czp;(HtGhq*psj#@29D$*(SCm3S}n;Jyy0@m9%f@ zl_5cQscE{_21*5&>>n@YOZ z<|Faq&7=Yg+nR_wu-6d8r{Gxuoru8lz%3-s5nmD~;3J&8#wS#Q;Qx&~~Autn<9X&1D4 z#w2HW3E3>-3nT~p^NKsDQ(}J0(^b9>y*!&*Gcao+Jh)Q4(d>> z(!N~`?2Ea8wEOTBWUQr=>ZSAz$0dpN!KaEtDG5o&0l*aF_mXZ8La8%9XP!Ir43H3T zbpcR~ufxIY>SuumL7J?05CQEy&~DDw&SU&wr!do71TV1m6AhvysfHwSXcW}+qrMEU zC}lk^WLa*Xf?uiU973X&7*En>(@iePFGg|Fw-G#Dqr9V)0i;cC`4x+h!!mP&0wFbD z)0xca(|WjSvBOYBgiyyEX%gi+siuSq+62>xg8kFgK0+BfK&Ck4f-$N@5H%eSRw}Tl?kJy?lZZ z_0br$PF9f*SI}Rz*;&u;45HR}mu+d=sDL2ohy zCn03)!q5bo>U4|nTtyK=X<)xW6nYbD(Snrgr`;Nk{?XFoR!5{$_eq&J#4MTrWmBY% zh>0d2AJ5_J3tdQLW13-_-nLlNooo3=DgXG1`Z#A*Bc`Uh)18hnOr(vh~!xka=wD+43uKJSt#XZ$by zE+cyK^AierHE4H%Iabdew{2MXJsH{$ln2Jm{}~#Ky}$h#ELQ=VTfU;X*T8jFtG$9P zWiHq)PXm{i5Vd#>DjkLY;2)cYmjBuKG^X}63@p`hIwR3Pz(kJ)Am*}DaY2p6YVZ~} z#dWJ^I%U1|VH|Vk3B5rB=W(lvFR<5thYjiW<-U9Pbz{~RD(8Uxo~rL;k-I0Gw-CIH zW3oF<*|Q{a7&EW0Nn)a5AF5DlxKu~ecY(4-`a)KC@0pt2I0+C89N$~5`e*CRbyv2IgmEEOILz5e`Quc8hUkZj1w|-OOV7i~ zM4h1M}_LJ}SQz@&HJSuT;KtJ)Y!v1iSr*M+*6O;sR2c<Je2Ju!bb0tCw*IayBhxk+O9XEFemfICDrC zSu-OQlP&KtW>mn=`L{fcO_=B1I$J`lr%_&pFyX_%_DUMqFSXF|<5j}~s)()aea&qc zqNuYS%ot4cN%U+aEljMb(DO}NjD$p3O0=r{#85N(ENa0ab7<*8T>$aWM6EIXf_F>1 z0dj)6jq84Qp8Jd8Y`SNbSkh+?ZgJ*Ryblc}mGbF2hy7#}#zh84-dGiU!sDOSv#UDc zIfIBDy8=+ntNv_b1ulrC>uA3wF2`=MZWYWVz?9a|&&^a?#GZeYTQ_^87*~qBar)RX z#K+6weTeX`T1M^H%+dKc^yQ319!hM(IW0xgF6)%Z1Mm6UtX4(I)Rz&(pi~Cq_?V9- zC(OdYyB?;`R?)|oiv9{y)hZ~mN8q`vWC>@J`lpl|Z39kZ1yjpr;R;aPD0#O~Eyavd z(K}x;0Pux>3G~8S9oU3~r1+M0;!TV7u}0kK4E{qq5+N ze!CExEJ(e;c>Kf3tWk?U$chS>_33leqQ3 zJlS4*1nv=SHTb1C;fj0%pB3h)yX2(%i+?i%yElr5{yKb3p0Y>LmZ}`RZxlPu%o0(6 z93Uft953=2lf)i8rUDKb4}Q6zH)b7+UvXZNpW5v*`u8CM(5AUTJpEGXbVMFVmU_NB zs9Wl2B&@Okj#BOhqJh}D&t%H{oJq9=1pz`GwJBWTZKjH;w^7JkCee--aq`Hm$k8_) zhErcJJn5mihADLhWxkD9ygRz!EAe*C9E$tKxzKghT)QgMkcRcsTVIqo&g zaw0!k*ikxCq;{gYfo~4-_7DB?tReG7AR#>=#B!i5yj^+tb^1v77>ARnqldu6(FUJP zRdr@E!zUIDs|x)CeULAM+~;$F{Zw3uEG|9)zTqx1WIP7eMc+=%q^pW(ow z!6_wn^d=qo3Lu7?*N2!({;Q9RU56~RPl}bOENg^7Fd-(uv(KNslMI~n3Hr*Xb;n-C zy?}l&Ve-~WB#G{T7H?wDvt8^uqz7m!o3^VhORcco#6#@xm(1g zB7weNNqxJCRH9Ixhh*Z<7XB8yu(s4QbKvyFsJ%k1DLNedJO&)<6o+rf(W~**m?r4S zJQb0^6fuj{3UYLFXoIDt)$8hL?F3&|+tF)BG4MVh{O}0v`2H?gGAPd?CYFw;SlY&_ zl}@7YOGZ%6=JNV}K0o-FTY(4@ME=VCFx1M>rZSGUpm=F8+&ItUN2Um>Z?IPqiQ3VQ zc|BpbkM9eIMeIndYYSda-W5H5pbXDl<~qOjL?PZyf@Q5F=%!UZ8ci~^c|#rk#pT%W) z?JC20az#e4c*PGzzSG+uXu0974!Ef4>G^E^wsrb434=A4+-G?7y3Z14-co{R1=UrG zTm5LLRRQ*6z^;!GGZXRKQY>VW>kL&lkgZ(XXl>zJPg@pfqMftS&j0czN&9(%-1dKJ z0S$9=s?aVy)B50=1X@k#0saV)Dxh%ndUC!4C5=rgoNI`E2tsRLZs{|;9q353eaHSx z9K74{-63adiH0#|VFm?~*~rEy!TQwI`!=EwzlMrb(5^N2g24;IdmLAL-N?kkdOZ=% za8|#&^&haWqI5hzTL0LK-~)&i+I;&jyEW_oM7S}qa{LDzU8Qd2kn#VfX#M5bV#~-8 z>HNJPNLue?3_dL9Gdh~_lrsh=*J1%>Xq2$)I@#bkw}4%c(@1a!FW1&K7gS>@FBn`NaUTC4ww;!*FrWplJO zfkRC-B0DAT?5=<2l`lj+vAk{FqBj*Wh-rZ9ut;cID~ZDFi#Ut(G(EbR1^vdy(415c z^^#UU^8U$Nh;`2#nuKEY>$d*of>og$m=lo(RU3OVDn9D^nsS(VCfvcV`b1NTc>6Hn z$#A=#K1B<0zi6DneX<%3@bXATy?BiT#s>=_+~qi@>MI*+r9ee}J;R%TleSCnZbhFe zk=*(tu>;!_V`|<-^8ood3fQ1qWDn53;jWU%o)!_6O;ZgwNQo06LMj(WYlk8CDBB%a zT-qq2U2%?>Z!#gzcqFI21>SZ5miPuL+LrcwdS;b4rRad|X6uMBS_Bxk``#_nCIA3G z>0v#Iz`Gz|&x@-)eCWw2_b!NRzwt+mGbS*@JWNZWCXvfS`fU+5E0XUIqntil%v6}z02}+pej&T%1E(;h8VNX3)i6lG!n@A;0BgD6S}}%WgH7A z21b!96DMyt*+w`~Btjj7UoHq*Q6(AVu`@FTB;@2bLkfFy%hGWzd$9(Y!?u?7X`L6um>Rt{vnV*DP z*iI*SuHnha5iz#p`bd#I1%^h9p)=gIgy|0bP#{KdVG(9k&7+}eAah<>1&On15390w z)@t?8mk9bpWq(D9_@tJIU*Cp>)4P(S9{7aT|I#Qw+S#C-qAKr9_|WTTAuH6{%cgNw zW=Ojrk{8>dj1YuzgvEl$5>5!LFS!2h!5G|Mc`qoXcywMmR*bgxU z$(u^IGiC#N4EoYorNmQ5*<6H6E5g;$$Fxl43IotaI`pRx%vg__<}KHN+L=|kfM|%N zO$}D^Cyp{UwRnL6!3?TXLBo`ds!YLU0j47xu`K|$%vac2V5wjdxy|wKU=mbVAP_sH zt=k2g_LRM+H+NTT0KB#jP4hpLc5yK9Y`^+-;@swNNKEs%eQ>^a&)O>A$}@}DQDEsG zl%gGh1r0oNaPtv?~dEb`|7zFbGki5oe9ZM_?uBTZ$^r z0sozxbg$G6RhT8!Oc>R`>Y?-|^5x@1(W>^P9D_R-e>cJvV@7TwIva5zOyHDvkqA4jH^S zvGV5<%^%m;9d-Zai$;s~=-GFwya_COWi#!aTDT&&1MND?c7R_DL_a5;dfT^x z@9*#e&yb#{j=pjB6x?xa<`g(A=vKmAu{oM!YBPgczM2Z93yf1&FvO0Gj@`k&u}?ct z8EwVory5RWN|=1jFZz_=EUw&W6&m>q^-FZ^!*oZCs03Hm z4pa>wzy?x;PrzV$$ik)RszkL{@W(^KVhB>%>U_K`#B^z|f~>#g4-+mw$@ z`~F24_0lxn?rdVeEfo!|(es33_czX3bcY4<`y>)F@m}~A?HNPOL;LsZflGVI&b%`e za@hDqd(dsFj8#G<-zwLM6ZzOo@FLdO zj1#toWb0A$UMvLP0hYs)#=1uDQI^p&{7Ueeu*4Z6>5tBU-Qkw|WX~rO$QuS(KhCTk zKdMl!y%-(cX#bYiAORy3JGKsAXD{_-F1e|yxlxa$Hd*#VLRK3hKp~PW@BXTt$mmiG zTtN+Cktd+8~E}eqi#5i9=|o=WC|8Q(+@UB5NFIHi~zNshFjREX1EeuITil4v?SNoOSdNT~rGsOefV+FD3w^E^L;QLqO6to+P z-b7P2u&krv_d*n8AXmP4G&J<4?gTg!wZGxT$h%C2$5`*7qsP$f+_~Ld)@-8zflnfV z%U%9dDTZu&sUgxpWhcv$I-IXL=Fa6vg09NmZY0)FZf*=CS!WzppO~JBfe2Ey_(#Zt z1O*HI&HomV$qYE+NT`Re_qZIds0|(d4`WsTRFp+#olJUzBJ)%pBB+{pkg|g9z z4)il^@W&yx3qj`&NPFUv#tz5|bEijyP5?sytwq~7qE1an)opbo4oeO$1pDJGccn!r z+v6%!m55iAcfU1g>Ue`{{H7>8n@-~+v%KYQ0<17aJXrptU|#Ok4d!&iIX9=NHIQ2? zEjXt>vH(TJQ&l4z*tx7J_5nGt93Ld%KQ8g@DIi!O(UcB@t+D9$QKy+2@|>TLgIjDe z{defHy>*jFRzq2!NVw3=8AfY-L}wXcKo|s!2VUSPaaSDpGRJWs1p{{ILoRUx`A>p0 zFX^tHi*+oCoLRmmOQ&wI;Q#ZW3XAvJ zBc#k+$ASc-Lx#i?bdx>PTawgXVG>yb4;LP9R!$3t#uk8$mC@BVOFbHLU$-5cz^0;Duzk*^3_g zsH29V))QJ9WfG85dJfV_);o)}b4b)`e01v0Vk~~3iTGv+ItD&Sg2DI|1q{de=vh@HPI@RQAO1wzPuV`Atxa? zfyFdz`?I=_HP~FHeNPZxb+PuU)TjW*=d* z&(3g!$brY+omL3MzT*RQoiWoB`;!j`ob~2Rh*S?X2te$YQV=fTCMk_La%8`}h=l>AIj)A)9TY zMA(n-S*9k+Dd+J$knIWQ#7Q-VP5mzc|Hx}avuxEJQr;IOqfr-65wkk+_O!hjlF-DG z3G&Fe!#eUW6v@HSzBl)?&7NPiVm$7Ect)!6t=c;PFo`l0!Ca$q@pZ$O37}b#gypYb zHscs%RlMW`u_|Uk%W`vJ=(f>YxoHQpms*m3woP$5;g@ol)$lb`AEvANMZ6|xOm@L14%26yc`!%FJ z$+ASog~2AtRI&JP{#em#T=o-7QX(3QXU|* zan0!L3n5z6Y+N4^_E`5Vb<3j!w|lt~V~XvH2Q3VR@u15W8rwKo{p(1Mp88GYJp7padJ$otGB3+9TmoRT{PBa{P6ANDMBLf~i*X$OG?}l(oyx?h? z-$B~T>RxXJWPqb@`640usK|C7Au()b>xPkqXqX>KBf`@GuTw9@TUS0|E3E#G84Oo%A$q$EPJ6Ya@$5vrak4J58$vWJCZmP9ovV)lMTbMR` zJ)=Jq;0To9ydySm|5OdC(iZTc4B%M1m9v%7O-#27&E8y;fnl?)gK4r$3v-v~F@2^^?|5UuAv11r4 zpj~^yzjYugK~f59O~~awy-1|qcpYbN&)L4{XJNcqeXQjVfO6HVIu$$7KM_r3K7+cH zC8?P8>36FmlD`%N>Vf#@Rfxo_?dy6*26Lb+F3JvIw0 zJ6v=^PQz5xZ@pA+a(dr2R(Mt(vqsl;!elo+rypMI5k(#hr=55ZTfZAzva2VMM;u)T zH-Kb8$nf)oW{!lm%7HetFNi8?n9Y|afQI)w#5b(N(`CvA^_HL{y%w#i^pxdssHzlL z-PIWu(BGWP@8aQYNeX8}j0pNe@SasjMc9DwL^RaJwq1i-LHw2dybJszM;kYjL`&r1JsdMOUNG_{LXRQUeaA7V%;<=*3&dZgX(SieZ7FPXU`c>b-j+5vaoSSGu zJqR+0PxdjTSF*zEv9<6{PB{oU^|Zvy%H=?`Kq%F5|H||kg}5O-)gE{S`{X1JbgsSr zL1l1+s`au3T{(y35{|rjBajr_$2V?T;YO_UGL`|f7d^YYY0eMkymxNPbE zq_Se?)mba)zRkvf2Sx?Y?IFsD@@lJ6fv)BxDGlj1#UrVQeSK>K^{qGjO0l-5E;g#~ zVM{hoPv_?9f~T#|ScKy}_l_lvHA{A~>^Zl@UVG|MI!0v3J&6N$%WoQezC zo?E9V2|Gq=D&!dVe*Lb74E-iL)kI8WSSy$CZWAo$(-t8o+?=tP63A8~LZrNjnplFM z`Vl5q1$YePK|9|0)2A`nyK;FJ#Lw<5pG-YLu7!r3GrR^k*f!uRh;d{Hx9$6$+^E8N zADMF>Nz%+u-mHi>F6_RYLJNp0(!@~Fg$_zZM#g`M`Wk+@YzKihO=liR(9Jq5RZ&-Y z9Qr!AyP&O5Ffhj#NU>M+vd(G;o%W$0%@?;z;VTG}`)w1iv%2LK;LsW;89mSBw@_H3%`c3uvIpvOTkC3vLBz=)L6 ze*H3jJm}co8`en$@q+e(D_Xa^!E)0Me4gA9jx&J1ALbzSSiR2cf}e{0(6_CJFcHsE%~xa|73(2HlfrE`au_b}m{ zqnr!eZ8ZegLf03wb{v|2-;IQ8kG63<^!PJ{SBZ98?@SP&FrK87*i46&vsQ! zO`DYE3zzPrHfB4d8BJ^IX~b})n7P1_WyTHyJEI-iA7FfOqH~WwVz~oeas)Wpv#SS? z=WWeMfxH@zSFz7RR9pp|cYW~yC&>fsP6X(Soo$HbT05BR4csxL0=ralMB6H(4-qaA zMH6T_jIs-$fNRoxwDI%k~qQoa34JL z%#TQYYw}rqOwI_X{_YF4|`=*n-Gc(rm*!FKkMzX_J@L zA{L0BQ=ed($H}2)sX~aPQ&n)oQc+Qs``=43Sf_{qbl5e(LV*V*hGR3dr-ivBNBBz= z+7`To((AcVz9JlDQN4$ePY+czq0<i?A?t=lpH>zsG}eV2B84XI3VegZ9}Dn>`(DUz-VhowU~Ab6 zC*huWFWW$m2WgGLc^r!!+U$9B1?WK7W~XdJCD@wPErh5{jNU}fpDKeHNXyPpF}=R` zE`?|Aqk^4;7LeN}<*_}8Zz47PbZ&8f2>yP;yBBLPM(4flQ!?+)M@Ea>j#2l z7UuU$@GnDBK8aBgh_<~1_p*3jK6*B_a3{_;n(An^zHjK+RMSp6=0qjIyn$~5_ct2m zbk-S)Pkk`K49M)a%0ON9{BvYBkEW0{RWD=fMW-0bf<%&`&v{I>9&TNi6Lw5plbxVM zAtZ0Ar^kZtQb)5@rMtli3*MZ|p8yY5B z23L-U%eRb#5Iv8YLv#s;3x(GNjw+b*_X5<*{;Szy8^`9J!- zA6^Ewbn&qmprG=@#f`9l(&Ml-a{C-QY4tNQbkrnpH-^<;Bw$8QWdOfdha>AX4ZXk8 zF5r_--@A(rE)cxQByRTTI(e)dv34RQj^yJRl}hOxp9+eQA%9}JjeAUS_pwHz%z(Ye zB$y4Dl8~w`L_qcIf>~7B&!d(i#+)qHN(Xl>*yfzIrwfawSB%nq^o7Qw_37~RJV3I9 z=W{cpQYAKL4Q5)5JIu+AF~PrtOuuV;Lx7N85K4AbZ&h^30#jFN6f(Jtm#(Ny1_V;9 zV);-WZzVPo{CSu11Hf)KkMrNwtp5o`{r^K4$M!$+J#7CmkNdUS{C^HU1eU#mAaN$) zi&`&ZSDDLMh9z~JmE!jTb!qAmG;Q&l%%kr+E+Yk&Yjz#QSiuCM!f_)V2U`v^3dc~Puq%-;(yne%Gp%PNTKdzgtWW?$@jwx&q8*nt_3PJDN{L7egvHW~DU3G8q;=QE;A?Bw zc2s81CGS{Hb5(kX-k&-RhNA$!UQnMNfVvw3j5t}5K^i7c@|Rw9KkItUdQYmA!M4NW za$Q92z|y0JIYjz1X@8E$3dB%Pn@FR&Y~vDIZ>kFZMe)L`j}f@pW*p8S33@(Qc=4S*(|ky z!}lI9=gxFi3Kmbu6QR-@eMrfk@?x~D_oY>Y z{t#;4xES!o2Q3`Tp^$&4$$|=R-^aXZEMA`#HFK}e3KmxZlPSBsY*ekK5Mg39FtH;v zd6f9H|WKW#rL`K((V5=!)&)tf80Kl;IXir;r$5PdCD{RpO6uZ`+i8=D3kq;Ets+-zZ zXErKIqO{|sEYj|HWh0a+Dt^y`1Auu){(<~7%xG9`%;%c3wcfb%1p=po!%9BSHZT)2 zvGLF&k!t|bm|L1*phIR((A*w-(67HS+Y!YCsTJ(ganY%1+0`CF>9}*oq(x0Z<&<7H zTk8N4E5@b8hawiJ^%o6?69jc&jLLsjiEuI zGgr1aag_?_Y5Znb%yrZeL-pGuJFX&O!b&7NH$quA!Md%%-&~EQku|aMQ342qw4PU% zM`r4k7k?)R_30oB=rAI65X6aMF=)*}wua20SOr73jFU_>TEmY-h{|TlM_kr6wHN1$ z{P;C7zwZRug4;LG+vJFI6RyuHu3wkB-Gk)>5Lj^DLjp83r!qBnc%E5nqA$eku-N2E z^&P;5;vqD@#CwihWvVAU+>5lNM`z8+`mDB20=5xoWOI$x8ofWAUkT4*f*(~=b%OC~ zy9fxQWF2fE*@)#HhMuNr7dpm2a(=39_(g8c5Oy;2(d6|!)&qbqv@e^%d|G&1Mfcs4 z5?mfEr*=2GfR!EIh_m&Oi|plhbemuH4)n%xnoo9{7hm>m{3Ko4GEK(=G3qzJ4g7Bw zmW%)cLn4vrMRrsZ8kzS~##YCMS9Vv@UCACM>}Q+kX`WGki#HWCB=`x!trzJX?_RMKao&>@H?<=+!8S) zo=7ZMp{*k%c2jaQMbTDk z?VD2PS}E$H(u8}0q|X8^X-|sL$oG85!iC4Bs_bdZ{XhM>v=&}8G%JZE8spJ9Djs-2 zC3XJ7xnM@USOEu)#Q$rD#l&2R2on|@7PI#tUYz^TQ7BOMWP6cB7KzP#qN zvGE6Fa!V8Bx4>ktq++ilNl(VI=lOxlzVL@5-Bhpmbhy(N*LED)EgSoj2IN^AUZ_xgD4cw0- zG_v)Sl+hd$^DAFyyFOw9r{FIcW6JLukpw`>+=EMF;d2p~?E{8d($SruK?u{uh&$NY z+hbLOw2hg_i3)$2FMa*NMS)d=V6FSP$6g8=jKG10U`0o?lq*#r=$ocsr40feIsfMJ z!m+*AtcXjU2qia9GKs3R$hS9bkj?1qUZlk1y^5x>dV)3EGJ>(B+hx_z461{K3yMS$}`ufKbW`u6BX zkPX}&1_cVaf?$Ef?+-)Rw1{Nro!&JQ$BATzYz#-fgVAtrctmspSG0g6XwpTbl+d)n z_`^%-I;s^qc|Wv->S_iblz|UuNCN{DV_>ZG<2Ow&|H?lH6&qO1l95^kq ztu7o}Nm21ldksqXenPbW5dGRo(k;8jE_B^nCP-VYJmzbk2!zW7mO|bTVrBATV1t!* z%ewiOs1rv+vO;oAbHzxkC@`t~*LR>o;tutd`K&1YVe8_L1IAM4KkJ;;I#c<@TrqAV zPx*{6j=7H~wtVRL^JT{Vrni`;+Lf)BDDqXf%&k?t26MSw!9r8XJCjqxo&$LJF)ruT z8}hCM>?!pn@o+>aBn#rNLzSWXXAIRVU%S-r{&$)D?Q^Z?Q{s5;9*e6f29r>Fcd z;fw0-ge&Xlw4KbXONeP`g~GW8xhmt=7ZyrW_S&UDH=dN4&gBS8nXhn^7b^NTMX0Iq zy$mbRF;H*;$S0^ztI{pVF5O(C5nk=(4yJP=Xk~JhhnMS43d>FD+NIk^^$t?w-Cr7w zl(EEmqq4D|x4wM254fG2J5#;ly@qfUTrjuCWc2Yzn`+#?EX|+VeaRFZ?%+B?6ppIQ z3urDAMLkFumisP|ZBB#Wu=WER)%;A*Sae>dOoBHmNv8AlhPen5+iWD@(A85v!6JWu znX5nHa7~4dr590w%G8Q=>4Q@Jbl$6*`kvaxouyqLO{A>4kljjMA3 zU68W>PgEZR6T^QP->TGp-SncrnFhVQlITHYw5>BX8-C$)P;85gVkQDOLEZpN4SQL8 z@#2M_u8tNmL$3Uw-rh*L`|a)Rmn-j%W?rq$-&BKEov+UfW%Bafq`MO(^>y8%R2z$y zx?c{XwtY^KfWg!;-en>eo@tLCL1$Fj?qAyD#=e zv8DqLXR;+iy285#hg`S~5q#ZV--uY%P+j3X2i5vBF zfku1s*FpGL3Kx?BJy!Eo^+RldkCUTVt>j^zIyI>kPfcadJoOz?sH<-EV@;J^TI?#k z@QBeQYGARiq89;i{Vg-Ubj)&t!UC@SF5EmScr^JR{N_R#|L))j1~!(5-xEYP zcYUn-IE>tyTJB_Y+y$hUuF!z(iGuRerWp&sb5)g-&1V;C{#w|8r++CgUmTej{LsrZ z(D4ZCa;N z@3R30Ui3n4qwz1y@snVGe*zVVlm!8r0*%Tjy&+)P+ZMJ!0Pi9m67sqTq#SKwWFTno zP(~r|i>@z2X=Ld~$s6Z8>$&;3W;F>Y!$G$OarKpUry0aOK%%OV%QlSSy6jWO#UXTn zTElEa&iecNAB%5du3nODi;q$pG+If_yH)=zbeRg)?pxbqWM+bT_+IDKY1V@8g)S|1kED?cl=&mPM*+m<+4LoAJ4$D?3NUP1*PYdv)|7jvG zh#w8EDa5CIiMU#+uvKUW4JY*tLI=CM3MqjyY_4zkPR2( zI<*%p;e=vo0kH`$58ai4^!UEXm}nJ# z^~ttET>arKSUCL>Q_xj}h9{ie>(Y2Xf3NYPtr4t7Vp?ZD&2!PVRZ^mWV<@%v;-$zJ ze<3NLRjyoU{>LAM<>mfCTx3T!mY zw~hwgOB!&g-{0M>_1jre8)2r?$qE+NgNKV52l6i{M}?i!)0e{c@?&WHx5l<}dWH2g z!wyflcqi=G2ti$C*EQam%FpCW#p?Q#F%#EJs3-DE1cj%w)d$xRvEi%HZynkjBeeU6 zd4OTgs9W$Mkg5`vG|8P1#O#`*f-A+BTr_%w$b~YKi!YM((7?ypw-XT7Tc2v*~QNrau}I|N7L&cc~xX!4&4te;SkjJEDo{f18Gf)fN676Cn8Z>g|`t{+Ss_ zuwL(BPe78S55eI`&9wO3^B3}Vv7TX@e%{@kphgCs35GW28V4b~maMdM>(v>48_f%a zgRxtxdCM^lL6w+6LU9{-_6SciM0!UoHgy^(i{8>22X()06t;qnB+n; z(~db}LR9H8NxEbfdJHmDDogtGJ{vnbP4TyIQ^dErr~`c~FA1b(a_JA+E2u-c6~bmo z^33?>&-!y8R;*mpSE$Jpd5=MW!;D@FY1Tcn44k-nw*Fb*p6!e#_=|964!U-+G2ka@5I`F==#`efci&}}9 z#RITI%xz27WA`DKX;Kvl7eS}++T>@OI&>Rq*SJk{@5-RbsC45J7A(EhtAK zAk4@)5IyxH&txl_z1I9z3Zs}e;nT>iqehZVsgrEmrBykF9!j->sGzw|6x<0TG)R8d zHM&i+6R*Fpa>1f|yjX;*S}=Yi&FpcNGG_qtvW`}Q1W4^vfl=MCK+2|Z{nYU*ht~Po zz}{xW404jsP?ps~NEK^=qAii4sT6g93F-i(Z7EMJp#hr%fon!Qw~k@gEWwk*BQFCG zoo{6SKbIZ4fG2kJN(w8K^d92Po7LdPRRNs>G0J*>irN~NjP*KPO980X1;c@ZCj>Q& z_+sUc$C@NG;J)u25$zJ?tKBAEpnXSrg4URN77~f*Co6*{6oRDG-&pNIw3qgd7B^bDBVY! z`ek3iOVPAnO-FnnKu$bxRDqJxpJ05kZaE*;$qF`&YC0C|(z)}_7BiyxNzp7zz~%Ky zxwDN1@7RfC_+{hhS)d{p6`Bf_>iQI_mG&^{Owsig1o$GGD}|F zF_LXE+VyVGZwFqpO0(UE-7i_V9s5JiL%LNxQtYV4%djXf13{2;xN>|3U|NgzOgOMh zNY;rn3MK3cUyKy?9UtU@ca;JY%6sy@dZTw$5gZnTM$%-gvPeCH)Y(lyrTk9*sEoZW$ zK}@(gbqNuq5$Vm}o$XCz0xjFc^S)?RH?P^A+ni{-P%Dl*rx>`f-hVL!BVqOTwtcXx z2KC6DBks0s@%x@MFT_SXpN2Vf!yO4BCSEya9bH!IJ-3;yq_poR9;WxPkT_0^$t$b( z^r5plq4Kd@_+FOtFI-c{H3pxIQQCSoKA7t9X0{C$$w%vI!!Ndbm^G6J1bbzX*P?lU zM)hM4D~R#MzIVu{&+)0RLuekjLc341(lTgyz@9K)-vMt_dc@X=mb>~H?GWk^(*6>j zdekE&>!^zUTlbP`B*<2=DL71d`xbpv3Z;T9BH)iB4i_v%$MpH@b@y=-ShlmB zW^v{l2rq5tHJ6dS1cg*$GMpF~pZ(KZluc85y65W7#n+3qF}P#WJEZtz)EKv1 zGA4O|@HB@Bsm#akze&ql4s!9dg%Uzn?JVxFT-<6GKS9g9V$alG^-tT|0k|1}oRNEE zYvmB9r%whd3&0r-=R#mfxddu$!{~0#^FWTt%b%l*u&S!@H^~tj>6kBWNGmL2VBP`- zan_&<8MpbsLu(1>1iU{VcDAtv#K8y6=@#N*mW@Kf5)TJ9VjQqKKOLKy9p<;taQm}5 zr(0nRXx1(mA*xmeX$r|We?qg1CIkb{V;dks148LjkKv0Pqh(fuJREB{&lZAHo7H_v zCL(#0G4+WJ;{X|~PQ6@OSaYth26D<}wAekhNrg7wfjzCxR-f$|dv9AVH=I!VzL>mtr5k2ub+t3Ud?R- zVFY9;-xkq>ZE+a=g3RiZ;VhJsmhv!89g=kyqP*p1U0I7{sX6~&whp@*ivn>HEmOgR zb;arl2F)0IHAYp^+;2D*3?^cs&tm|(;8({x!J4*R*`M+m3)M68yfIZNHJy;NYo_^m zFT8+iMLf@?%gBvH34^H_SNc~nANr4OHxHkA@)pPz6I-;7L6ym(s?&DMR)#%S3i4eP z&lbv6s?lRn#c@v;&3 zXA#A1l8AvL#m>JGCte8WVkynXJjOYLxo}K#6=4%BZCjy7@Xo7(B5f6AUBXs)b*SM!e z-g$*x#nJt8TtBh|u9*jgs+IDqmQV}Qn`Sct+_EWUF`jUe;ZMSDL!w)wmcP>J&YdFF z(42C3S{Kk;O`4~oqC~ofkhG<&HXB04Jy^hRbk;j79sI9y^qz%yy1KTSq(N8KzpSDD z=TTU;+O|^`8-m}hp5TLGjS)&PNciMazsyVwcg^BZQKIZNxT8HEnVbHj!RoJ% zTXP_AESc;GUgLtVc{6@*ay5697TuRU_0!&J^NQDH>YAs+iN=;mJhlV%j=HvncAW$j zwd`*Tar+zj&omOEnIK9aldWzFv^a#ps7K=@%kOYH#)dslaat*jxR|s&5U{G&RYr9>vn`oj_LL@9A1A&%J=(7kc#!TMuKQ0^ksj7 zLZ5s1y(6hpaotN;b-1hRO7e58q<#_~9m*qdG;%7;(YeqxGEo}(Ny%A~!{ofibEyXJ z#FB)!Hpt}i=;Ir=Wa%VeR>LOe>v+v|LG@$>9~CxIenmWR@lK~j%4g?i5R05~%-J9t zbq8>7xp{~&5kg^*UJpq;RS>o8-(N${k6q zz1a@!B-rEqjh}a`dZ<_?XNs&_ZhdvAvA1!Yr{5eHOJDDWhv$pGZ`1W|zV!V4`s7J8 zduyG1kHw`SwRlk>=o>N*^ntZzr_VSK6LFwK3>@8GS-gBnDwZJ25)2FH1pP7^*Y8=J zfIU$6yeD1lUKUQ-C`Q)4uJ-VuU}2MCG=YQ9^A;^Tq$&$X>Xv22Kx75xC?~6xjf?Q; z_2ui6k5TJ$o{=G%h{95lW*BR&w|;sYiXs^5;*x6csh=V64Dt>K@@e7iXX!fu5k*IR z!JRtvvihjOYp-j1Wy{vE2Fmbt(jx~(dpcTgi( zipZ`?q?a_Lo{IxAb*>n}0n}c}PvFGpisH&Oyos)2kQ>c^7SqRGKWU~7U|*8!n)By= z?4h+o;DZZqWSx5hnH519FdQ6u1vGGjn`=yr2WG%}^Rwqlop3a=4~Oy*1Cv7Osv9dC zNPI}nZ<_6`t;w9bO}rv{{G)DF+Pv zml%l9O1VJ6wfo7}x7v2^b$5gP0}yc-`ZssuhT~S20n%~qU3X9MWq;Fb=8^c5sMgM6 zGYL}OU5|dRB!^kkcssi@BLYBx&m~2`>iIO#$u?JaPrg6qCFLWZ0Ssbq8XDy}F}@!o~RpHsT2 zMO#+(?1PSFcCfyd16^#JlN8kuHm!Q5Ijq;oX#w@ows+e{7#}e7QBkn3Aie}|9YM> zLhiS>I5*eq(;T^r$Sc$5fbq;S|0p7Y$4QC8J|7Yxcn!*(ct&)|R>jZhXn6f?=U~ zDh3uOP)I078j|@o(aOK1p^~`9$Ji>gZVV2}bx4d8^A0k7BLc5qOYgTP$L#LX;?J2R z3A-q{@u|3~o?(Yqej^z302NG0kSEbv4I@mB-m@5uQ|zoo^ayChzj&9a06|Fu`vH@6dJ;bJ1=iQaS_L|G{0LXWll=XUT&4oHbH@40!TPQd6Y|;r$!Nr zGH5;(PWbS+^u&}@$-L6S@)$M3&Qxj+5%M1D9b+H$Ngv4jM~l8bkAaLO*O0K`-5#OL zHq{C5`%Ty{Kv!}S=6~u;|J{a&ne~5N?R2Yc+8+L&R$d67f&g`DMf6AyDR$S)flFs( zlX=la@Z}UEz?36N$E+`(Q=#>gYl5hqH~#rRlozlC|IA6_$64t|oE zuzJU$Q>lE>X(Nbp{Aes1Ai_$>(K!M?V77zs66FyY-t5lw!Z z$SNEP+Ko`rssuwG7Y%zOP!konQuah>-R8;Y<~ zFg)DnZq{>AYUkz)m=zb5s!b>G_k3!j=N--sthUow463#y^e}tQL&@QY{BR%AM-E3H zBLVDoHs;mB`{hBBb{rUC)JXCBdsolhX@34KGGg5>9yoVLKPL|lm)FCi6Fv_d?JOt9 zGD9^t{Cij*lg=s2@Iol>`#@oV@qze*sKk?Ij53KYz)A^aYBXB~WA>SaE!5&=? z)(@t*1!Ohk;Mj$D0Df~b%?GSc0g{}@4ytl;fBdSmIUuD_>tSGueuh6AxE%b?Up z6X}S;_zN{l#?2*Gzj{$Y5>=1I2H0i-jK7`8SBA+g+mO~seDr88E7q#CR^^XlbOjvT z;UDipu+7-(RIDwMe%*f{3c7{1b?WrW#ygWokF#mU*@r<-2WNz%XEj7U7Sq_ZpC81y zrSLeD+(C4%DIClhXEQXiji?O!!@}4Y*DD6*>=eYFMA&DFSQuH-TqJtH4`+n<8T_#eLO=piK!KamZELJx%y7 zlvDD)cnJi@L4y?~xuaVGvcU_Vny`VlUp0UWzi#73QY*&?&wlLgLQH$+dTh9LYQX{T zLvAj7hc{>=#{^uw^J(?^Qo>jX8>u|fyN_tGX$W*^2HA2_s_&PyaK>O zK6}o)*BOeRwX@lzA?GF0ZB!e5-5Q-??*N05AmdMHZ51Rt@q(}X_RvV`-~2V_YJ;c- zwuB^r>McT3{x~0r3FiLcXoz2b#n2v^f+3K-{+F54S2qZ{mc;~&w^Wy)h0q9C6Ax>C zgyF@_25>6ZKExCR+4eoyW)vEp-v7pp8aT?J98y|Y3&YXcU?jUshGdTY=6dhBMiz=$t*$}#xGJy^N>*-5reBYyv834)jMEj{N}%?pMf8$IDN{LydhaN+=~njRqsh}D2c5eXA`oOlp(EV?+Jr7B(>gzDsH)D54>LA>KH@WuCPZ{{rgYS0Y%Y%Ue zfLoxpz3{fS{5t$h8+99&2V6S*v`O8GJ74?Bb}1o)ZC@BwPa|W zOn&7o*VEXOJ@p1`Mt|}Zf=WmT!q++gnT3JWS_!e%Ezn{P7>I@)vK01!ZK4U8OJ{4W z^g6q0&Vd5tkEbsI7r-)TDZ};|gOZ5P<_hRz>D0;N{^h53*D$t+g4A#f9Ic-{>!PQg zVVO8#)f}btxAoGlX0U0h#DAE0Dnpk*ZWAKKS$Bm$74TxLW-L}DAm!CVu4|Id_)1k8 z9`zD9p2|C~DdbSRvKdT`l4nx#z3S_^(RgJRIeq9;HAHv|m%kai@K4VZ6Hf!mFfIWZ zay)eqD`sP>Z#d>r+c)C2Hs?eJZOazN8?z;5&zQ-m6`oDSiy=rom&-;|`3E!M$!$Ge z`Mq}31ojxa|F{7#*Mv9yzVk+$JZf;Jac&-Q0?udrC3w0V7%{?V*Mg{~%x4A!Yay5m z25RA2JB;q$Z?6ad#8ec5>5Y7jQxe093e3>&xy2%73mQaCNlGEwF$NwIN`PxkZ!^EO zFf=Bmqh6CqJ}%l5aZy5_A8#Vti`D7*Cy5SWL_Ylv;oXT0h`Z^B->^)49eh|NgSnQ> z4swUq&a7gnn}CzwbhUGOi{LP$a^MB2n^`#p;X+^aW!e-FLeDKT4vf{+5~Z`XLFL$l zph=Z4F5(*AF`gWwog^ieU1Vxr;rb@6bxY1^3@@b_Z*W5t++ipKcY%uu>N12JU7<1c zCmzJ6i?}^}p60(bZ}WZ;2Yl{w-x3stxQ^H83h2ACFt=u8(Q@>Barue8dOwl&%2OEs zShi&8*ts0hrn0r9yQi)%Z*M|5qrR$ZmS*MX6gf>>-yjvpI#c@)dqP~{6K|TpvWvUg z?6=FTss8g;;%ug8LkOvh%l?h}QEI-bHdAtJ-3&@yPAtnzmOQ+;$p7H7s)+2}{oosr z!YW0)kIRcnMuYbDrDP8^+vO>efP|%RuCi13O3cedP9cG!6b^(*O@^dM@OJok-1F8YCyRi(LgQwCM;YtUruf>5oB^?d1mT;J5x`Xl*v{QCAl=SUEPtm%%^8uoIitetb%bZziYezV?VM&iL&rUKNiPjv@Jk<^i5j%?mQ5V4y<8xPY& zy$s1@EkLep9PobHNDTr14H{M85A+Z74B?o13Zt9DvNBAK8rtWoG)fAw7+;CuUx;1EA3V@vrVVW`gr7u?zhrdvx`i z5oNbHU&0q**3ir7AF?ZcvP|IjE|U3d0v=P3ET@Jo#2Uy{8nq0X)>oF*{=o<8cuq5m zoOOMUuN|=bqy)Ok9=dE^X^hptU@Ef=>Qm=m?zsds9hIufhkg%Hw*>o{2NJ|PMGBV* zq#Oja(XHXB3e(ll(SqH~^uKKbWGss$O?U2rfc!x5^M=R}GP!{y#luDsbH21EH-T#% zrBlKm!7Uw3yuQuc+A_N;(}e*s1*U6#)n03mnrUihwF1ghB1HGL>7A4OHD}W@2xLV0 z?DP5^5N#rAN$Xp+)F9(itikM3fnLeLGaVCzI>fDmiMSdb$*ds zsyiGPTXj@2qJjm1;polL6)S@KsIRzgu(bYBNY3@bO2BdX6_WN*_U7JYK2xBZPfzYl zWM)32M<7)C70O&@6GVel>U)XF4Mc z8ouEKr(XMKiwGU$pSwf+)p)))@#be3?79tN8<6(z@3&0S95kkVazuJHizGVA} z;eOD-CpbgeH%A63E|n2N5FpYathZhjHnlbw?b6d=V^_Yl#R&q&+hw=DvU$;ctpdor zRryP10;mdK_4f6rW5~g6Wjh%TKO%}2nIm7V#{9Q>fk1f=nt`gm+O&%k(nIg zozBeOL`yRQz-fTHVo5#eN_fX>xQ4@bCUnk;=8(7~6!1Ro$jjVbc>9q$uYTj!MjZyw zUQr~Jty_{5Q55b`>_nX;%!LR@+Pe@GWsYPbp-SNNBK zK+qlKgD8#nqIm!x2q$=U;4k}K>(CuQs2p(&p?{W8$dgn+&YY#riL~%Dh$(B08b3_i zj5)^e>7e_TCfjcF{PE*l{b#X6dK93CX}vjWHMkH84{Wg<$Hv>RyyvbECUxR8_88J5 zepDqZWutM&T;Iuf!pxFAl>xeuu^2uWdSTB-(s^D4lSO=Eq#l5-rAtXySgMZCe2pnh`>Ut*gR zR>oDTTa-zY{7!FvBWjuOv)7!fSD7h2;g9)TbnxZbLa&_H?F+jzuoi7l=RD|-9cDK| z5rVt#-zjLvVWSZ2;i$R-*Rs;Ih6pBW-tA5Z!yagv`xz=GDZATvbEZ;v6rGca zpqoC!20t^@Q4h|o)K~I-ka3{$CTT*wH&cf{?P({sdZ_hPeyUNz@Iv#F9JVaewm1?O zyE~ydn;5WqV`m;HF68%G`pgE=Dak}t1yv2FqV3Aoy1Qxc30tGcvio$!7k|Twy1aPW zc|-MpgvaRxV-M71AU%hZiiBa7q9k^x>UGba+pvdS<(9ZIV3a2j&}C`vso|C=BFR$+ zU%BdZt7lO}$&xh}Nqsg&R;o_;*ZqJmvqGFxk{D+qu26?~a>J{38hQI2idH6dVr+jk z)`zN`kOWm^`3u~>7OuOKM;HqqZB`NJwMZL98?t7Qyy6*Y2g5LB&@JCY(>3Dxa?V5n z6H$sdTClPGzMfEvKM$1tQ?dE)xO67w|3$@wsA|X^{-0Ue`=v7227fnOPhkTnf zu`S$K(!)k>5THkA-u&-wOJiN_g%E(sCsmeRd{ma}eKi&y_T)4p;D2+HYpdy)ByNozh9lPXDp*`k%KbiEN4ov!nr`e_N0ZF5NNu{qjdZ$btNOilJIkhle|xhcup z4@}9JNLZqK?vK~4WM99P)1%-8lsz*ecVCkqm;mEP%*mRCcMVB(nBcnj?Ov2BKAR{p zm$I1EZZr13jh3w8$_??&{&@VVMd-N+p;Ethp@U3E3BtC&aqxRnbc4j117;n+0OL%whOGM zJ2`#dW`%fO+J}t;Y#?z(86=>DZ&k#{TUyrFpmdm*C22aCP$$RU3ZM+ykuojHmyu?oB{H=EO(RZ;M5fj&`UG+vM2lw#H-et(Y z?83yruR=lfO@Jf?a>99A$6oB?DpQ=?3Tfm0^c-)p#3xazfmR4J2(R)qFvdLeo7WsP@HmwAQ7$%+oxmK$ACvMpJ= zqPHX~8x0qlXgpIA0(DY0n{lg?*%dJY*lf=#0M7k9OB&%BfTDwE$fv>Rn}fE%6Q(En z63YWf#sIU8-H|Ufr^whk|7fYge;XKXeN-x$AkE#bTURcoi@OF#0jo#F@@Zha3WTNl z7xE!YaOqi-~h76v%VuuC@HXd6$ zGD*|QG*j;zoNUc(_T=wrYU`s>S(?LiudU2_E@$9fv^@_>OnT;J+ zim1Iw7f2=OIKzGZ>Uj*1M~yyMj0>OV;XCVZoG(|rBxh)#+}oz0p?;gd&L?Q#EXU#Y zuco+N24@{PaJ1f=d&YpTR%{-OjoFQ@^6ETJ!Ct5bEUyMcdw?pV-$#?|!CE^%pKggM z)6TNAm|-ykA(k<-KvR#Bf6?MM{mSk`J%ZJ9_{9dJ3kYy?KloUoTHSq`s`u7k^n*im zvBg?+={awGczJY?H{oKd*cu^Q8jM#|ngq#AoqsB8bJHvU)qJ0mB{{~E;pXYGkCir{;yR_2aX+%UN#?(S$!8s1=R z1R3e?fgwd~F^*>lZ!LVkd!BO>uj($-C+}c#dUliE(>s5b8qe*xm&+Z=`{pE8Y53&I z`EiiV?ug6nqUhGN6%Dl8O3aVd-jfYBZr=W*&=$-6WAV-^-$BgY!pja5w*a*zpQtHl zNp369w7&*LEZ4=~i=*X>6FH36QzKt_wc-$j3eCm2Ah%cLZv38)`gkya?Jw6>%-;5nc;hHP@grGM#r%{>Z+4FZVQ?i?4uBH4H{Ztaapwm2l=4L zEi>iOdPpc*MNlt{U=nb@HMg9!YDACb$ohhG?|>sFWV@U>d48bz$Sr`iZXh9Pl?j?p zk5z|hkD1wxsilAvIUc0xQf(P7wqRDTxZ;unjoV1dVr9CbNFRYL(;^Wht<~u8dpQ(yEZIw058$jKq@q2Kzr?Y&l zPs0B!QoT_l7C>npd%At-hf3F`pIna~p=u*Ys#(6=qZ(t$C=d=_9Sr;&*UVz6x$X)Z z)68t{?}&dc|6sGsvaU08Rb3HPl~f(kr6k3^-jZZ)v>QgvVk`jKLKJlR_mBkPh=@P> z8Uv-72fl&5Sos4^>CZ}f@MDe?DTI)I;hJxAmW~$sVy2of;SH(l!}uFtZ-$N>JvqDm zVqEv%puuH$16+=PwlPcjk_!BI3Xw*ugHN3np?U6%z_4}uW|pGXR;_m}72mHc33>C_ z^MJ$}h0D^JUS{7rURS&|ln2w?v$;U=52`-;YEnhUh2uf$Fzcbh0zDT&A5$K#j5pGDp5=AnRLBN>~0qE_c7=1CqFy=jx6vk1U8!za% zgsc2+GEyL6zz)RhsvN% zbX;7jC2dV~42I|jd5sRnqX)|K|=a>Y_x*t&lvbp<@kH3Y5!5r`(!6QV87(Ne*fA9^!JPFFv8ci zh-;2}@-5&&j&D1A3}X8{Z@{ihfD_AbeI+$e7rQ-!;lef7>?h^NbnWG3W~x#`-AvSu zv@UMH*Xyt1<+lhS<-h2Ek0{^oPTa$g#~m_q()LuVmQ6v&Fz{4#DO@FM>aRj|3Ea=! zk}HLhukmYh#^V6XmG{2&0kHis^YHeomL#A65q)N=wNo}_(IIBx;q9|sKh0qc5{g=Y zxKq>liboBOQZDK1f)6nwr?K)k7Xip!@$C&kRbT{mXXQg(jzJ>yWM=3POg>~OT42Il z+!*GzI5+-jIp(nJ0u`S)F9JIo@>TvQQ9*bg;Oxnkw=DSES?x_=dT1aTKPZ0h4A2wH ziYLLS^9q`%3FCNX^N5etY9t!+zf zZt~~?lD>f{IdeEo7h|sjU`5a^z#2p_NOs~IA^!t+#`wTn!$wbmKcvXyUWz8HpeXk`i`%`GXH z%N6PSsoq<{PP~flo%D#k#h46~;&~2pSxn<>+BZVTtnYDe@bYqzF!HL=`5D!;m}3Ou z&&`D_Grg$15AH{lv4btVyQmN9U)LL(A35Hogh2nn2=auLUqYs%(ARfQ`3?}Jhr(fK z0V32m5ac|#ATEf7-qgIW&wvPNff+yqnQjsyBE-CG0mKgKYdAWVP=81 z_|Nhtj9T^DY)B`^qEXL2&|m`z(M)Lhvkd0Nshy+wX3Y6<(#Q|^i=-j?pPKuB=bmBv ze>eBb|8dX!_Vfy^g^AJ;siKJTHpo@SgJCW_A;POGyao|5x3FnAl5$3TzWtAT#+XvI zF%JVtj}c zsr^!hZ~CWBWJ&`etPZ<8^>_$TXsxkoJXzOGWUn3q1Bc%f@s)Km3TUlhP4#u$6FAz_ zv2|i00)2xzOYB8xTIUA6qGTC_uii?|!nKihfs7hfI%hdXeDEQ(XL<kzR#E*+K>$ng-6ATGtu@HbioZ^OGB?|9pCkl?! z=Z`yk?vr|83MfR~%V!!Ak9~T0;OJ6#I{j1!HyC2j-@(!i#wA>o&wo*J@PqPv3YG0} zxWKEP`f&VY%KgHfKU7l=0%2&N(h`0MRNd9~d#_K7eFd8z0*4I74-PS(wq?qV)sdWm zF`M`dH}|90=mEQ2eHeqHLjx2{gcujik3N9wSC83H=JvLU-j(KW-u%z;iH`s0NVeu+ z-$KA8+Gy{Q_yn|`O`_7B$*_DS8jXZqrS0)b&2ex^;T7A-eK-1LgkGt1-A0*vr_p6a z!LxZz{w(Cu;;MY{9mTFMaqx|#3vt_Bj}sZo=lBDhzXX8&uI$6FKXp~v-s=vbA;_ac zGIXXr0NZJ-fueP_{le<$jxNLy3k(UH2o3Zo|8H$#6BYk8a%`jeKsWeR+z!%f1{K>s zh=ivbYt&@Euc|d|^iO2>EI)GFX+kkqJ4df4x5URDhpfC!$<0h6PU0G&*rOw+Z~V)D6!`@S3llVOuVbRkeJy9OL;=!9h~)R7FV z4NC>&$>po>_hSti9L#j(g({1Cri&8gX4NPf3lyM<@cVf0coG(P%43uR z?=)R&o_V9EVesXy3&|L1J@)W%sN+oWcXAFS7777-QvG^-Jw9^gkG?{CZsiC&$l}fX z>?x+m5U+SiVQ{DWnxDX%smom<>Raa+gpBW;a!k%AiKqv!~N zfcXyteJ}b~-!O&G=q4Y7Qp4+H>O{HLV60o%LI`&AyMMJ@bGox)NlU;j(BI``r#=~B z+Sc9}VDVNq{o4=79f`J1gTqH0g$643w8PT*-XHLX3R68+VZ2_L%4_PwE#sP|oZ3_w z?;NbMMw<R{fCCd^k4aFn3x&=SDtmX`oG@-V~9Sp zYI#`|AkL8LFgJ0zD0Iim|2Ph!>`1F-cwztzLO1}5rtKe<mXYVyl=b2a2-bd`j8Wiy$O42S7a=myohMy}m)jm%~G zK1VEF*JS#BN6n9~ZxnG&&(<^y_uL|fS5q+dtgps*S^EI9&uCbTd_Wxzt0l+4laC(r z))-7k<%w@kPDt!dvO}iIF}>tfrLq0O>FudY(imJM$v9R*f1x#m&l~HJF6x?15nDk&*tItnRT<=%_yFxY?*RcF0H@Oo%%TLCuC-9^efEZM7sukGwZ7WTf_2)3%F;hO7H!hZH@T?V zs!!lcakga+8v0eZnx{?8o(CXjcxOQLVG>=WCWaFR_B91R zUTozn&O3b6WrrWI;*`R}^nGF#?yPQt6?1f1uP!7?MgXh6E0P9)tBjZIuS>VM_j9~u zHEU^Z*j9!%vwQ-f^HZ{@{*$C(UShIkZh&De&%aZEYv*z-xe9-$yFJo`4_D2)as+8; zU1JFL9153J8|b%twzYf7*^CRxyoylx*Exsq$5WDcTF6C)f#j(^9-RN7A4z50!nwJ5 zgImiQF0+f$!4`s*+k4CEsIR}g9hPqvk0_T=5^5-3nJ-}}W1{jV^hV~0IDPwotqrEJ z7XCkId#4!DqIPSuY}>YtUAAr8w(Y82w(Z(w+qP}nM%T%oboz9@i!bT)<+`6)W4`kp z&lqT62Pb|ixi8R6WqM9-PF{@aii%RlZx`1=i6K>(=Q31Qq_rYK%AFs8{N7kM_{Q35 z^dO#x2KM&C-aW0|U4PKoUCl$0JHCzlF~T4mhzg*+z(!gof-uR?!@@m-&l{)r)_FFT z&Rn@S7MwJ=N$34>sJ^dg<*F;&U$3s9z4vNKGsQ!&kq#_S!1P*W>mbxhf##^@gLFGz+PQ{_~Aw!X6#6jZd0+IXObDQXIZ1pU;(t)b}! zDuShP_H%gfeXR%h?gBB5EFv0m7@Am6Q{m+8FKmGd9F|*^3-pfEE1`DK+>9AFQwEf? zbo~vagvfvJZGm$9xpnaMdfKyedAPgQCWNGAhPYHiN9uGjA`m-4X_rqYVw`#yfdCM- zhAK*_32AbPL?1ynyWQ6i^b^mINrjE5qUbQTI(LMspF!Zp89Erthyol}I)hC?#pCTuNDQj*_@ldB`G7c48Jv`2)5SL}QNN9GO-&D%r7|?>$^Bm|fD@flbKToNCLV z{zfGgwn%xoxcW1X8LaoI>MFcP2u(7;FeqO@T!T@+KOmaZ$5F%fkLM4_ff~?swmlN- z_zgBGA3H((6r)WVOWS%qS@o9BHMb8OtjAOn$O)^pf-bXn%ZiCWn{O}e4tC|tOB5+w z_H3~LY)zVzUi!GeB-1G$ih)J|1YxKc3PKYyXF!F|@V_u(rSRpnORJ|i$Uy&S*L;i$ zs&FJrF}1pIC^rw)8mz~Xi@XTl^wY$MTIDw&H12cMT|l}w{5W3o@W}+$C$Q?Uj9x@t zQZ2=JW!&LUOl1ns7Y-rKLr5Q48a4$;cueaYB`X5=)c|w`!ulu`Bp4bh6W)2rdt2Ow z%l2w0ONsZxU{7-y*&yI9B-z$lV{k3NJ7C!<<^ybQP{g@z=YQMxY0hr^lZ-gZVN0?# z7-F6eS3(uJ1eoBeU;9Giy9KrX+OwnpZ}`YcpP}g$LD(jtTPfrr{m<@~)9~b``d!ny z2zUfmKq*R|7#{AaR04zF$ACIS{umBXQ9}BbKm{l7^Qwe~Aw17D?TP}ACRu{5oyCI< z5{j7)B2wZ9z_haCM;t?qy#Y(SK$sYRNd5hepD5>wlquf3wI5xL!yC9(=0cHGf70F$ z3{Lz3k*cu7)9308;-1-C5poU=3Eza9lUKb$d3f~#CjmHg7vSh5DL9DBIahY$orh8f zTdhFqat{A|KlAIIRgCoQ|ofkP;s;68{dYb0?G)H@)k;iS)Fr|L= zXfnJVECQWNHmy2=`*n(;ni&a{qA0V9<#wi=_GUYNG8P}bs3lp?Gv&$cSof1g85BV4 z6B=1&Kilx&LD)Uphq_~5{5N_2U7R5lgw)6$xJ|!qzPq281PU;B=C&I`dIpsLHO53U zU^a3t4mJm>Nn6X3Z|>%OdQMIr4@nKb6GIqqVFE*bF86v0zkzAGBRKo<_0?2I#k4bI z7+aP`e@f2pmEEk7=ih(2P5oDRB@+V+$N$r0@mmFHx5lUrw1&JLo>dBRGKjb!BcsR<%*9=mPuBX~h{WZeApCoWgysILm z`Q~F;(=CMQ!jAs496>!fCUX#4i%gcLXsxNvu}Q^bg`57W7rN?41qvJqZM}N#C}y<% zl1&QBw#qt}jpe)gJkxHi#YWG!MFR*p=bX-ZRs}?~(`Ey`U4HQ2_$Hg5?CYS_u#F1m zns3hC74|+SIqTkO)q)DAweirR(n?V+!|BeIM&oz)2D4N?oV`PavetXaW4i9w)W*t+ zWk=%z=0Eu5xMlOd(JHxT=*I+Cu_azgKVGIf@K6?-sPV*xcAk$lp|-g+v)iIBJ_Dg; zH;*frkb|!qf5ZDAYrcl^osnXj(YX{7dbejGks4mwgLS%3G{TC}HGMYbE`2S$;!RS# zsim-+uAnpW#_l#;RT8h$h-sl9jOf8s@2QYnHl8br?+$bsn`AeZImRxrjq`W1ifM~$ z>D~Yiyl}D_(3}OUO|N=DT>LcpJ)iu4GM$Rq=a9&1nv!@AL+0(3g=k(VPSS@lZwpJ9 zInN;XS{)`Sz4`mrviiPO5hp+-lE38k1K?4o~HX@W<)=WJ@EhQU~ z^+0R-)RssFo(VOP^l~t$NmJI-3V`f3F9h8VhCtiY-+>S4Y_8WrPeTgi$z0xEo3Y^J zxOly!^c?dZM;cj513y$`AH}$tZO&%v&qI+VS7*&|YrDpG#cr3XgboM)R1(f0s&!}> zdBPd6;XlI^+liec4^6&$J<#dlaKzOJ`=a)0|3s8x2 z&|v}-esE5S$+J{P36i@GAkW~=_ep(Quu!*Ci+y13WC0DN)&e)H@LXBF6yeb2v4?XO z%c(9MZ&zv%_Xxr(g?fV3ux(LsHN+D9T{?}pLqQS+D|KkCgIemstXLSP3Ny$b-vW4% zGYUwk4)T-^G!SZy9nn8uJ#9J>80|6d6&#WWQ`6?Vylyk?{LEo#h8_J0sIIg))34IA zaZy-x0o|=>{gYHidtrqgqPN+)REfI!n(iDjH6;&P{3Oiu3U)nKnpHVZAnUTx2Ldrq zzEqo)^i8GqTo>Mk%qkbaVsb8p9=nDPnm*^-mZ)^IQ)>h@T}}x4E26b66}o~-{eq5xzWAJYnT#e-GN6?lAkJT zPAZy{2asgwJhn+W`PLeQ5l?1s_DqPlpkI1c33O|(8<59(>@?|U=|tvC;l?o2UG9V2 zC9>ro{Jp14Eu-FCh{LiBf5bDAHJFi~c%YHD2#O(?hFd4Ys9n8Br|SiNd% z0R1$GATV(j%HUu{^f-=rH_G(5MwyM6);v;Qf^`9tvUOfs7q7e_fh4MhkN!t73Q#TK zO?^#aWZ9}`#*_-O6_dys4SGoO8lfx${Fv4ZVFYLq0pUWLg!v3)v?y#O7Q4dhNQi@j z-deaTK1Tr#leA-a2-Iu;dI@K4RvfwLm>Hrh9C>RyoQB*#2kz938I}NFhUw~7z=BMF z$0QBS-coyXcQ~91(*|85e=)>%_f~X_lN1|6oOkbBDL)kCK9+tJ@tu+TMCsO-#%T!vyu*ogs6(8+u1ZSh z7V7SU5dMe*VZzp7c`kc(QKusCd>K6R1Op`U8wJ+5>GJb(*226GFYz7<^kQ6Yot+8=!XLWwxNvjR%lM{jZ~8!~Q;@X*%x`?SD% zeHV0N2cR&VS*VlmfXpK$k^)o@(Yp9+s;CQkS9g?dcXGUVBGo@(=NAMMNzxE1qWlCZ z>cWoW8TF#K^O_F)0v9sJKU!ugijjZe_-YQx*ba=te4A7=xm|&Mqh5WRQcSGv8zP%(Iz&3wqRs0K}O46!%DK; z4gPNk2%zjBF6@G0Tvr}Pp9(zA;2T(SMb2|az_YeI8F=L2gu2wDQ*-S+HM@qgMWcDz z%yAS*`BVw+Hg3wM%;FN0sLIoL`(V@mOb97JUW+@Yb{!({CWxZ(SvFbkE%p7g;vV$?c}U z{Y=`-Ca3@E1w2@cM<)hi_=z*q;h-)9x{Q$RIr@fKh?6z~EEWg)nk^-Wq}iPtu-ryn=}v@+DMo|?SL zFo&hPNimln0`R?uN`ce)C%NHilcAl$JX5S}1XQ(r#l*_8o=kOFBAuQ$vMFs{H)b5Jd#B4|rhbG65OcoUuL+4L+V3aj^7WbS z9fedw!KT2dsGcYw9pDr2 z-PCXKwv4pTwHVvwPpm*2J_a>^mxYy3%0@DN7^DPThWhy?8+JCeg;sw>B?ix1e3 zO%|NRlTusgIrh#1(TqlhR|YHC{Wth7P;$3tpMPK5%)qW_bG@DvQz&nm9k$j%7!Y*r zpcU9IyetV+lC2TF*9t0#7D4!PN3}Te2!Ok?tu`1UHt@|m+D#(G=or?t>rTNvYvM|H zwMAw@!oWM8XCo+TDqg37;Vdz_1e*Q!kNV*0fe#APtMzn0EiJQoZoLHFBsoWL^~|oM zq=^9(Cdvh>4wx?5O)`L#%*Ow+XDaR1(lDCd&6zkz>J2+Vfj*@hZzvPeO3#b?pfnAYNc z+<^kdW)h5hddw`kz1JZGGK`@_ii8siFxUEFv;lg!wG^`djS?o6v!lk`n@!21iXh)? z2;THJ9_57z*W2bSwSFtk_<>uFL^*fdYlZ-rq}Es|Yql)HmbpS7NzmJ%@myTVO48jo zL~9-Bf~?tWhIRCGtJ=?Z+RF3{m_nTpstaaaj}rV@O3t1J6|oIw4|65Ed^&7`{C*TL z(iq2Xkh29pL+>1wC7PM=oICqd?JxVe13UxD)&p0iwigXi{WPP+1;Uyao_bHU7~nnc zV34%(Kp3o9LG9p2B%&H;)YrtlHaeBey77w7ygzDmAk^COxZQ1Uk6k0=@apv*l76D~ z?PlU>$H%R+L8vh7)6R5qQQ1|q1#hO;$(!6aA+4jnsPo!bmW@25MLLbxX8NSjP+D*z z@{F&(M5Lekbmwj5uCirQp{uRDn_`B()dKT?rYjBJVowKcn&mgJ@w!6)4Qj@JJMkYR zocaH6dYbvaqNiEe|5uQci;_(20s}(V1GTqv(elL%32#3X0t6%>l>-2r#JTlki9^H| z-N#KG&-NA(YLnz;I=h|ew)CvsAVM@>C>Gui3M}}eX_)P{!yv_+GIJw#JWAkVfv7YB ztybfP-^gFKrJ1dfaN}^+U}jQeN9y$P*?)^gCP=j|O)9J-Ela8_P=4xE0uBrptFXr* z!bpTxIpXGjONx?RBFJF&^>Qm;FE2Nr8YHxl{Cv1c>Up;*TpQ?}f0Xgh(#ZZ^NWa)H zNi`j1?7y_+&IcG=^v&j8;;@}nIizK=?>;kv+bPDpN^>%;((S?~0tWd#_Tlt$Z1`TO zT5)URlW~zmQtE0&cQi57n6gxAfHj197QA?~EGPec=IJPeiw<$giDH|acYW4ll$WJ2#ah8)(Yt~AC z6{REKkWmHq22G?thaUE}YH5yRps7jpVtL1WjW-YRt`HUOGVsBhV)vT!bjGI7c-T3` zL*DBTJo5dsERi}fI(cZVrXWF$&qCL>@BPzZ>le-Hiy+7okK`6j@4C`h!S5?iW~S8M zw%X(Dqrm!dyx(0#P@6~ON0AD|cXJQccqIo2S8EHjlRi|nl|{#No%5v6TdkwL+lNvM z{_VEOOJB^K8IWtg2(llq_P`R*6B z+eJb%!4&t~fKB5}*QGjIwE`}eeH`=17>;~#wW5U9p6(6+3I!xo>Sj1xFKdJjb%2lG zoOXt9#_+v(Mgl^{R}xzSY`+ccf90|3z6zYd~MwrS#SsA+?eWvy`ig9SHm3`x`GJZ z@s16|+&_~qkMmwi7w$R_oB3H5(eniXZCP3@Eci6o!)t={ckC$)BfxfLtUao7?vF*M z%+~=s96DD$qX`A>&3kgBQ>7A#VOz%0p_%J11&{25E4<+yRALoJo0yp>u8ikmq9ETgdZ`b?uPf08< zQov7{rj++_zvav{H5`uf&PYt1D}4C{ZZ##3NKVX4(plZlOjv4A3&GE`5(tf<^QExrt@=i-18T~-zX9XVscW^AqAibo`n`^d! z(;a0t2`9F$k04F*YmTPyQMt~FEj$%6&J{UHbochcdMWt}?SKdpRw~Uj^L{zo3mMXa zS)}D)4ZKA#(n)7-6ddvHZ>Dib8UwtNWg6?!pk5M<#EQ22@L8m9(1t?D`b!S{@bQ#lxOvqhuYHlKIl$S^-Pa5?>?Ut``d;zacAX_u=1^R|rB-I~dUBcyd= zV#YHyT^eduz7JjrS8m^or!r+oIeMbPgR{(_(Au-Aw+ri&r!#PK<&ck~?eDhiJ1wnU zYb$$FIq|4e{$+%<}li8N3`w`+x&%nojnEGlW95KsS^f#4?0>N%9>Op!cWX2e|72LkQEN z@z=6ZLsL%VIM9!83SqNI2ot<%Rq=^U?qP4an{szvIPp5AAasYPV}Eigy;lt}%&bW{ z>9a}wlXUNxG4QWKgnpUC8N-C$m{}}XPa}=)zD5;$WfpHoC;PASpHq;%V?8uNI^i>$ zqNMds4BcGVI*oi&ZY=7#g@Sp+26+vq$x!`laxW(#h!MB3__3s))h{3{ZTeS@8@IB> zn+fI_6I`k%Esjqfk5C|qB>gH<~d|8X^?kJ;kN2{j#Y}b*81E!0Rqg-8c8}h zRMeoVutCmEv zd{=>4{^y6^3(x2c)e{qM{Wo#c-9;33e>EQ&iC7bxgaM*K2oGa!3Oo_P?2*#btTt{{ z_jJJeaC#zs2!pw>YD|gI_N`gYXJ9`c7lAIAH!B**v{_`{*yK(^yz7q<7@_NFJ4$N3 zIso-s=oN>sw1$o>dBfdXG19S5hxW=d_e^bbKfVm<@w1C#rephpI-j-ZB72P(+9$nJ zw&C#_A?!z_n56YC`UJFfSRYy+*C1+OYS|xIQ5J@tzuGf@?G{!l)6*{fv#i4Morf~V zI5Bn+8@j{H^h+e3=LoqycG8 z@M4BkoIOxAD$O}@^>&Te{0bkq4EVvNr{3{06bo!Cs#=@Io7?QLp||JV3zsfH*j~g- z)!@lUH{pQf@+ESB$sbtk>t`?eAc>Ipj;S9=nJFu&R1zolMelqXC|}4VZZv>XyD{YL zO5y`YGN!!ZrjAP&dKzS!qAVYWnLY+2cSiQ zFE9^G=Yd2)>E;N6GBg|#zo|#YpZL?#vDhv3J<%j3pNtuE{}!I%d^hrv*q`DLCA7p! zliyL}^oWAv8?iYB0s1z<17H`w^7oKp|NdPGOH-@=J^pMPxRHVrFI^pTb)L&fM7oIGqdGUZ2ke3oTQ$J5PYaKT9AYALeS=@kywqEB>9YCt6 z(NICdE&^_-J3?xB+8%UnAFa>^nZ0D?r!a%Y2nnp<%Hj}VVHbDS49OPH%cUCi-UqclHgA~j#DFKbQ3N-; zW?LeN*20FlzQG3{+MmQVH$RNa+QB|ADP?tEJppvbXu047D$JpHFZ_4jXczV|I%Ehf zl*x|^3p~dd8l#aElAKCpiabXObmP>~mb%zZ#h#E54S@iVO1@VhK=C2B+Yh<1DP=DI zW@IkkTE73`S$bVpbJUOVQU~*amo<=3Wsxbb|C@rLG90_KS*0+Dc8M-Uk~lPUbm{GB znXNNLK4;C?a(n>o<8VCbn(pSj6D-C%v4Cy$uc}URvUI5g-{etj~(Ad;2UqaKui{uuT^IP!s z5-$P(h0poP>51KAx#PV}nN%+Iy1pZ0{fXsXWs5p)kO6Zt$p;zE0Pxwj(yM2*d?9`MMI-w zktkAdezyg7Y?VxgkeHq9T;G6-wc0it}Ow!*e|c$S&>Mm%#s{TkTyo?;TVC*qfkN)Xck zFGwfw9=s;mfJSaequ|$X|LCw6oL@BCSWS8@t>BK#mAJVOt5P^O8aWs+m5ydq(VTzh zj%DTywC=6rT?SJ#3>PW4_^jLtRB;9DF^j>mtrXN~!L10ZBqsw_GFQWnI3Nu*$m2iJ zs$t7bgZb>tA^BuT7re5bl@0}B?HLPdmR(WXc*$+d%}d%IjDO8yG?WeyVy24HOjstf z*<+0?pO=hBR$_6*sM1ML{1XmnOfaTaSUF4PPvohF?S+u@;wffq+u9y%Y+tVu4v>`j zH#`ph2iFwCYnaKxCU7LEO|`d)lg>RGO)c>KaN55mR5KuIAWFLoE(fBgCakn4&Xg1l zBrh-C;?WXK%x+-J*}g*R#Pd{Jkr#7tq;xNMvcApCeOGYHFmyo2Vl%A8Tu0O7%!KYc z$&y~oHI|WhceDRC!JyXwOJpR9LRLR@&7&afZugYMJD==osOSj$I|q4suF5$keCM&P z5)i4T1X16>%bm?~(W-WRVUT+Oc$&~v$JS~tLA1E0_O5OQFwdK~MwwCH|PzWj?UmhDM+_RZ=+LA6DTXQ<~ra<`As(Y84}I z+CLqCTh+?F_rA*z^^(la{5cQJs3_jh@~er4Leb^28qNJ(0IuhOF7Ss5$;HKd8+pw< zqwA@9+V*6Qlx6qh3?|_MvXn=k#X1{xhaeBC3hu}XMA4;^G@}>~nhFB5CQ37RM;w`? zj0S8mHWPyR_Sqz;9i1^onh`~;i^ev(`Q%g0Nag|dE!T2iwZ-#lqcq+fmos9AjrJVu zfTi|tQtbgZfJ_rbf)B3%nECw9SBy|Jr8$`Bw~`9wg8Z?TRk}*-QF0P>wrLrw>QrXpm;ow4Fl4&f;kDt zYi7>PN9`4c?b;I!6I4T70l0?fbUpYvsg*9GCMcfufBVs0nafzGBHLD{6(+Px&7Z_r zG~-k(-~d}&xrFx;B$In3cR>(3{$)q00_fQ`TN46=0*IEVaCJ)7ECR%*@F%-lPc3k# zw%~Kc`H%`%i1Cj-+oYUa1fy$uKu}?3tk`ezfCB{VMfU0=rU2@5(Fy@{iU-`vH)%yvJR8c> zD>An@@Ad^~>|#zD?%3;VH%+Tve8#LtCFsj8gef;5y5I1{;L!RQL z7OH;JFpzerWo|^G)_78I*J;kT7ia?=UeOng*1pR_@y5p}98>1|ljHgZo8#Y%&)t>e z_KsH&;8?5|WhEYs>D@eec7xB-Zfy6S&s0;!Bed2G2JF?TWCmtYA))Y**IufVR0juVVv> zY8EDM6UDNjK;I0Kmqa$T@bT;VlS1?D1a=S=r6lL~EFuhe$`Y zU_rASr{!at-yKIyr}4aF`ORj4o%KSpK8*0!XTmog7xHr+& ztDW8AD~&p4^ztwfj?yEhJ`%)3F1z3ZaMH(|8GzgRImVw>#vh*bcxwT^?DxZ-juSf~ zP9AGO-F29)Mq}=bT_oTtFT`<$4^6FgX&t`oOxi0;shzgtokS^~BMy7#J7PJd(-1uuoU1+S9_xzVce1>`v-i1kJ3TApe%#e~Z%$WQpTx4l4KXF8_ zh3=d^-3b>5(8AGnPe z*n-fTZiQkGZn4s#(9Mn@rzCC#M2w$W!~oLhy~0I6U83#9E1-8lfl<_j zO6AZj2~wv`c3BkanHgx9!~Dck8wwECi515t&`cyG;unRVkP5Pr@l}f7DC0&8L0X3w z>~kj+IXakT52Wgy>b}0rhhE}|yPUqMl0QU@+vsN{e~OM3v$7?L{x5Dc;)Y z#=-Xqb>DWaM84jbn2v7>b5Tl9hTr8X5}qz2AGrjs|MdBvjM&#uOH?B#1UV2I=fB0w z6T0pdy97=b3}ly$?zEm+!tek!h5h6q3meieHYwu@A(@8lR2n%u&3sePH=Cft)aWjz zG?=4dqn9cfwZFRas4w)-;%MQD%HKOBxgCH{CaNgJ-eh5Roxk$IvX+X zi7-Xa_3W65m&n8j0!7bGslB#W6BG?y zEvivn`cR+53os9hz}|THA$_mCWD(a*<>6>n^vQ+y@MsF+%0LaU6Yf1FVK_pgNob6T zW5PWk$$7~ytu_Ni@!}9qig5tndbc5*pQxg-xraG}%JN8-#ge?Z7AV;zBYV<(6a2j-UMY`zLyfkz>KwwDUUPc5Lb1SG*OW-kvP@{?yVx|- z#G81RTjl+V8pO+^CwzbGQSQLemo+xG3^8Es>8n%Lp zDbB`85Sg&gdIKSyb;iUk5Oyf(DsEjkkrdYAe3my&!unmXU(ejJ(}Y%Y&wFd}^R$}^ zQG7!nwCKwEi(-&WOM?-|{i2(O1SAcSDIs1wCTTfn5Lpx1ob6c$R4%vSMnW9kggmFJ z3{{G$S>{R7Uyss8+K@yp4&Kmdbql4g=JlU{(83Z;BpG@`st?&~j-;(NH=Ma?m~^h) zoq8KIdY7G9r)rs#{g^JJH+*s;j=FywF}>r#@A+YZsY=42lJZ??LavQp7rnKIaJ zQhQkpzP>@nWEH}0iHwi}>TL+m(}u^TZ;6`_>5)%`?D=Hdpus8q_jlnB3T~&_WJ|1c z3Rr8!5C}((%*hk=98@uu4=De4((vkr?;E(`hXnLL=o;&Pg|abnu>P-==s)#e_F5F? zf7t6CGV~=CH&66c@DT^a7Kf}g$+?0n0Fe}%fAxoFb0gpH@gs>e^pa>*B0#6Y@!WX$ zeD_sf#ST-!eAOO6-!in@R%ZFn`-0}1#sQf2w43IeE3HF78!P=!;6C+Ha4w25FcbC8 z*IhW6%{CX6H!9he@#YsNV`7OL9-5^hy3xELHLRIjlTF;KkgWE$5*36%!y&UUT>88% zM=kJnV%^1JCRkf0W8`Dc`~CAAW&sBfjl;Fxshpd0X%>!@57yp@vZ=#IYlH4h>YW}X zMY7Wb-p5v8I6+(_&df+TctgZ{7rA0Fm0}x*N0w|%!56)NYzm1>sNHRzIdLm6J_)fP5JW@E1261K z@6Rr&!>wDgIWydxGMWn9M4rYLE_q9-@kTAz!jZEJ-r2(n*~eOus$Ejy$*%oN4&-lG zVlv597F!M@G8(R-1>3Eo^};#P62P=#47Q*MCW+}WLUUccr-9JMw%jPX;aH;z)qiWM z(Gndvc+@&w`O4_R*90AW7g3`Y)XbO-v?2>r`u^mx6G{WW2kQeK=FhWZjS~;Brb7T7 zeU31d!zK(^vw&ixN^B*yMJ8>;$}N-pf^q#uIYLWucH_Y`F5Jgd1CEItQi5&R2uEn%xNG~Xv^t-;Wdi%7V8g|D9Lqcuq*)~0Q@knKWIK{D5Q7fI|W~a zQh!Ka@?i-7X0~4$h1kQH*QLM#Xr?6C{T4NAz(&FH%LSz0CleU~35%iXrzzXhc-fnX zAUTu0itBPx9sGl~7op>S_Wmahir8I30-lsTFG6*lD|RMiFG|g51L&*8E#qWA#Vg36 zob6oSs;iJSW170s;n^rp4qS87zup`^QanuN^7v}KGF5(C2 znm^d2`m*8oq+?ZPo*A=sV+l&_7?Dka{DgGV@~Z8;U_eNo5n<1px6vT<9lT=1b+*CY+5E}DMxPkc_QAZ=Ma%2{d304@B2AfyEAa>IesRa)hd{2v=0@^$%k3cNVruO6n61 zbi}uqg5*lJ&=LHNG0$H9J5Rh>E<0Nhm)=O7A)S0L3m2qk45yG>VF44HY!X@@!vI5e z%4P)6Y;cg6kEc7Voqc^3?Yg&vVQ<7Q2oIY z%S1HM?O>?=l1;~-GJvykPOg_D4>sm|){+|8x+xr6}I*ED+{M1G(F*c}M`1DP7v zcTAMFyL^y$tS{x18)+f5H3SQGKDcLV_xiGK0PJ4)goUK8VB)WxOe3zI)s-VFI8>fS zG!2ayP6Cuc%>Q;Vhs z3WsCwD_TjpAvwuHXdY*66I{$u1h))Vk86N-y7>aMfLdY$|5x6TdX#H*e+XlyQ@u+E zaj<$r0qVoeqq7Mrdt)YI8n|~H@3+n^yh*KLDVh<#rvp<@Rti@T6L)=9$ zgP>2%)6jZNVMIYO>Y2sH)1Ok^P$(V_Ut&{lM~CLuuz~9}?|d2WKV(?9I?@7-nG0je zaXa#NHpFjalx?_jk%Q9>_IR}pnVGnYS>2dnCdR|KXo62>`1P>nQEeb99e0rMQuMqt zLp|pt-C`R}@t;;cZhOAL-D(VmnzUbz9MR0>c-2(pJ^hf2<2B~rwYr-Q_oO2cdqwlr zm;rHHrd$hA-o-H|Yd(f5+8uBur#B&oP1m*-caJM0@hr^M-whBkXHg1MYuh$sq^rJGB zXGcSauynQhtMht+lv(SQ1hA#6L7;rUi7HY--D`(lj|mf6?5-Q{=a0|#XqiOkY^(ch zwoWt$ckybN2h19R3sGB_5v~N*3a(p+(~PLKiNniF%Xalu@!QEF^A(jA%?0ZgX(w*T z7RZchkuJ)lYL3cAOv`|ZE&#(KIC)=u>z7G6o$YI@;v~&TN79Q5D~fO7wju#wEL2Z# zDYM<+OdVp@H>vGvi=+t6b(AIEVA}9z?VV!>egm%{1L||_O|<*ET3BoRW(B5CZokaw z=^ZWf8d*O)Xae^7LY@g;Bwhlxg7CWncM?PIUwL(FtoRHMnnBLZEI1{xscF6#kK-o< zYll@ZCuN(cXgqG1K-Y>m3b;%zvlD1BqBmAi;CEJK4X%p{)GRKtHs7uW75;rqWVVYa z(5WAv$SE$kX{U~OfX1QcD>Nudz?#!d%5Q-oYJM-nNJWUtADL{)bNC{)Bhd~Suo-zY z6&g~}g!#?nRdh%~SIk~OgU0~#Nqc33eknX$+Z7e47q=~0-v1)X?#3J_hzmO8&Fc=a z9dw{yccEl+lum-TKLY70a}YOzYY>|5!C&AwAV$RE$Ztd7(zgg#07ZeTudbf!42bA9 z(WRdNA6d*G-_egmPS&nA1XTq=yt%MciGrQGJrs1hxd^g|#c83~Hy}aV&Id;R6xW+c zWLFZN)sM;(U=fy2qgAK?S1(7uuoNm3VKSIxv@2=kTlq`^VM$;arE2%;K1T^8>=0zo zt};=e{9>M~(B@gj(3jHB+Gk@)1>ayZEEnTx4E%EbwbxJu?<6hvu0G=RqX;Vci|PTA zX!6ERUX&n%3is@9*;ooFDbQP#yh>CFX8HSHKu|OSoA~HSy>gFLOz{|F7`I*^BDCpt zDp4px?ak9-od*od<0nO@x5*G@vRUf&neS4knE>hQ)j-H3>LJRb(6?W&wu@|UZa{E$ zL!$PIOcwn)05J`Ps%B(h4Y-8gtG>FCPpkO#y8mXqeDNEZ6z>rM=%uGpXRyG_P_sh} z#v#jym7WD*8IDC(2z(oLQG&uj6Fq|0+nj-<9it`>l!Rccv$)GmPiaUk(!1;H@#_pe z#7jorfojVnDv<&zR&Ma4uG(`tyBSw#f-Kets?*>NDg1QUKYIFR6qVNeQyWWfO4FH4 zoEXA@U`pNCg9F7M=vxhQxXs$H^3-0U#M9p!s~k$N#vS3oTYYWUR@8l=D?k9akN~Af zZ*Gc2kb6=pg&f}LqYXnd{wYV<`m03~xDhf_&HrXDX5&ToVS03DjV}GNWpd)cY^Qa` zgM6a8^I#zk0^{EW|A%s%$JMSTJ&+qC77s5$sBf5~h9dP)H;`paSOYthH1Gu4(mSKM+|#O%$Au+yqH*&G_xyN#%cvUf5G1J4S6RVE zC2&+jPmaj0BvpER{R|TQ#{^h%2%ak}&XGg#$h@saM`DE^{eO`~FH znS=6EI97&kfPnfLTwd1^)PSSif-(vLkeu1;z8FuajkyU+tnVBE0uL}vh2Fjp4vf(Z_OQmkF z2Fg$jxl)R~#q&3JE@{99niThEDj*jpJkGQRRwz*UT_8w!1n%+2CJrZGww|u`*G&I7 z;gLUwxZ=o#ft@xq8k~Y8nXx^8_~Ji4KG8c95&3sr8@D#! zP%WfJ*HTN82Yq;Oz$p1zVdv(jg(NsZv=;!k;&`L6aS3C<2jJ}krbg+4!vs>E-G3DT z*(UJ+7h~rTWLcnX+q7-lwr$&XrES}`ZQHh;S!vrgel_3yaT~Y0dnb0piLut6b1Vj_a%?i#%mZIB zlEXob>w0?y?);8(jS<{tKxX%0=6H@B@+>Cxq5z)x;mF{at8fet?KY}8{CR?YAQOzZ zcfd9sA(M%V(o#*2FnvS%z>qYSIn@T+fi81K>Ud2ET{p`L$UV4g*w-sbjfR3TBRxe5 z;lmMKfrTLaj9&?73~tW_Lj@X}VHWoN{8u#BtM@VhB4jshwM?-iDbtnm%`LiXSroyQ z0``eD3Bve_F4bavkjkf=TIU89mHuwZ^Up*+X{C)x4lRf;UZ5_UCT~%VrqEOckT+FV zxvxEfO-mq9p;#9wd%{ll)>){OLmCmI1bA3Mf+yiuAP)%AbL<)m$wx$d20OO?LR{>~ zy-lwSLo(7&Y(nbmfExp2@F~ZxDaQ~`ezht=ew8iHjJ#%1*WJtDRCUZ9-9QigipNpi z+FYJbW*;s?nGncXW3=~$w$X?t_^8XJcR$Em2>=E^COikkrer@m9wftH$#n+YVza89 zqz9AG$DxFaPnW)OhWSSlE^J1V~03RqYhycZN5KL=vk0s;q|uhjKcMLDjqk&axE9 z#lg>Bq9YTj3}d9wNmJ{Me^EnT7u0c?1CwIjq*$9((DV13$sO&bW{L$@pQ^^jMg>#B zT^r5K?>2RGd~=m7tcBdL=w=aE8vrY)SxX{ZfEwo%A2z*uqW-SRt;N-^I8NH0B2HB3 zE#96tfox#`L!4*@2(X)noM#e9^ZSn&H;a084Y_UB!Dq zX@|RV*Fj5q6a^FZN+w3?8ydP)g#w{`<&{agG;aF8BmyuEj3$B-$sv?$fEya@{R6Vm zVz=y_`Mgm~9PtfR66XkRml5OP#Sl`}h?-vS6Kh{k!u1f876ALw5~pbHzV}}Q#!c($ z!9dW_k8SGo^7PlMexdX1%wknhnnd+m0?yJ$&cGgeOJ5FVtrMpSD#0_UM520m3+0Qt ztz#aJA{J?i232ajV`%9nVTFa+u=DG!#8YOn!vgq`QW)SRs{Lt5WUT}j2r||f7mA1N zt-FJPBgC`@D~k&C8-F}@Tv#imd0((N4R-aIkT&3*>K`vVUTyi-6##E}&U!ATW3*2F z)=^^pK?CEImlW#{X(EdJ*5WkpaXrXe`~PUDpQWc}W6 zM*U4oqB;_4T#M_|3v=)DFRlAa|ZvB1zj9MIq+}ljq421qN46bTx9g(kx9QR zN|^d)31KrLy5ZomxV#`KlL9f?kd)mQKb=?2-hz+ft`wpY{YEY1)#mWyra5AAc!>=s z>>ES+Y)^h?a&E0pZX`GeE7{86?pt!24kt)>i!Or%1dHEDU~2b@lr>i-ro$usC4MOk z8jGjPm$G!Vc})HSDdt237v}${d{g^q)%AKFLMsUjQ94TX;Jq4#KSgrpen&Yra3k{E zSP$^Z;Hy;Wkk9}~@1y76tUTlGlucnR)qqr#Vd-zb5f4iv#=!Oqy+vGNWRe}*$mC)L z2tsNaq_HA<1l@7+jOjyv0rLv}!ZmR1urPLL-#wdD5~1fYLoE7s&?1DA(KBt}o zJ$7KXZOgj-J0!H4b@}%+iE{9d;nNDl$}u5!Ha=OAE(mVMmsBev0P-)hF|dUZFp;3p z&>zV3Ot)}3X%7F#ldh(KT@u{Ky8-0N8i&6m3^+Ve25;j;KA#3bALE3h0ZupPU#&Du z=GNy6=I+#MqbmDGct9ou*Im&#{FT8yEBk0Gu`xcY1x7G`Q$n_t-xJ`~O<#48JKHKl z*^Im)*NkWiyqW34n_pYS2<7KJ4_DV8Pg`ueT~7sDHn|xj!ah&pAR{%JFcth8LW<<` zn!yDu(gFLc2{DmV>2WUQzpXv}c1Jb>)Z)YQ$5V^ zp&O@LD&e{pN^urKobvdF;bP+%AagQi7TQ@55ad?0FolB)_Hl2o-1*U1oy+t<@V?Ca zgM|U>ps*AUt<|k4_}p}h154x8UNO}~IItAqopya;?iuP!VH&isKc3r+B)m|fCghAz zGJ2NO>uTpt=2Irysq0K}jNk!YH<pm55lijs=H zvSEF+QlG=&u20}}QcgoCF0cGDY*;3HBJ6whd5j0KB8su(`&Ki?_==G1JN~LkfXBJB ztVso4(~m@l9lfkI{^-f(FOkU&;@MMgNBmhF0dv!S)B!8N9_K>R5XnKygxlr}oV7W%M$*1|1z`067+Aw&EObE85mIl?D8 z5w=AbR|p9DE-hx2t1E1_q=wc}ZB`Nav*=Q@Kt5wRbv6);*JOI)m<{LvaX5^ z4tUw@&Y0Kwn*p=aPnFL@=W% zNSZHNPqwXByb8?8!w)c&N!ckaeSF^l`bc9t?cNgafcXp7ELhtyb&NaY@}7iW3Au`Q z>`$xQw`0?v`!XI(C>H5b^j$B-&&6mKCOy`VJ84XuAGDuoWy+L^%l&^PddlN~YFhGA zwp;Vx1<0i|3?K?sG%yi2>%`SQpYhxe$9Hil4{tZa?6sBe-{7rP2Ar*`9#pQEmU zA9q(d9O8aad6w=(wAC&TFg_&DcGI?LrzRRCzy4YL#6&9UI#MP(OSU$2e-esYY3MoO zh7f)`)*Zo_+so#m`;nMRdz{;3d-^(#eNMNm2Vn9we8z@itC8M|+m+viDGsr^USm&N z_vEr}Z(2=VhKd>;^VDoV=kPlUbvLPK}eFKer- zcEc~jn6D)%7dh12#{*jJN536%b4|*AVP@qTlbptIWO)Zgh@_0iJ_p=r?p5?iRElxM zJ4l3~Ydj&vV+~JS1*=0Mua}SP=40QnYF_UlX4(2EbM5K*W5)ko=s>aYUgB6 zZh29uU^V#U8n^TBW(39YKg7b`4af8Cvt8bo$(0?t4o-gBwGM}EJl1xX->yU7)Liau zA>9XPz!U)hos?J(D8*FI>VI((nPf%6FB2t6Yo=|cHSCv50m{@Q@maia-rflyCuFxdEMAXS z6&FZG>D}vR8HE^g{7H>0zTMndbk)DRxpktsnG&Q1LXM|}u6-H&%-1Fhv~#-j?GZ5r zQ$_F-sE{Bbwg4#uNedI4$K#nI2Yym9Yh=xAk>I#>|EA~qCw>58u?}9ZPA9@gl+m%v z08QOsOVyZ=ZXsbK(Ik^p8-Xl-NR>?J&KjAC4RB4OV1}TJ+vt=w7NpP804M&PBc4#7AbkvaiF|wWzNY|^w&2fds zh4Y?;&$nM^^3ZO!nUf@k@8ORu6*FER=f8Fn_Q2-XdDZbTcif|d%rLr9+wQH1jFCRK zr#8RQE9eHlxqXNm3b`X45*&9h7&Sl~?=#@QhDsSvaGtkUi&Q9JA61gDGTVom`iaSk zuR|+gG4bW>)Ak+h8abX8c9SMDTGz*z)9c}$Q?r}(gQaUqTJqE9)1Lf+Qo3v_{z1jF zP9AhvKpZWY`Vy83>+l8ZPUJqqoj=*yY6xmGWeP=RWXfMovo^UrZ8k1>kL;Jhv`M+bs~ zk~dYm2Jz%Rcy3^yTqqHOI>#5XAoHB)fJ08A{0 zXK7`+r{Yz8(`cVT%z0D|d+#s6R$;_SZrl#P=fgDbZ|~7%{7DMtJc|1p9j>$O_C^P_lH&%2Vs>;H-4TMg{wjh| zf~5Y*GLIwSS{57NlG3zx*bjn^efgm}3_yYpQW}M$F1vl-;SY(5RCKl2`H7-`&^#gm zN|68qxt|3ds+RkwDEt#0UNlu0ZOe)rGCSPcA=UVh~N+(Nd0%6xs>26fV?frGv>^hnN5$PQH8zH5XfNR zE&rnBy?8&}oPa2Wzp|h&qR!D+R5_E7wBL&8f`;Qk1=d|gskXAbSpAz+*hgkXx$qyt zr6i1BjMubwbOLrC4RnF!G~8UAw$jFx%#HuN%>9j5|5v$7PVIKNZp3lLAsfzjJa5{E z1me_!lh>kibY8oJclwOHu_+;BzE@SW&*l_sj~N#?8Apgc24pc+bo^)xz<;u$`=Ccj zBvXSKPtqv*1)7IbH91q+LeT35q7jH$^}gzfHB7^Y!SOM029` z2c>*g&ny0b*>Igv&>RSv=dY=`{I*w}hY=aDwcxA}_WpQ3_)LjbDoA?Ue4rQ10lVW4 zO}nql@(km>)HkzJN2l+Q&ur2kq_}NAW@5B^o0_^Br}{mjot#R43IN8^5VoZ-927Yx zQIHYTPSGAtTjTZlz9GUsB6c)?U@giJJOc7A1y_KilMSgYOsRJ{2w!%*L>r>>E48nq zm(z-zd38?=h-80yIDQ7hR-;t*f55z{c2(#xO7|3a?@m35c{;j?&P}uI-=-lupAd}HKJ#N*#^L@10fxrAUzNbYcQp);eJ`M9)DE%#ZbW(HIKEkH! z!0*yRS;q@q=D8ROxOgYTDNlDB`Nn{waDWMe`1iyU3fu&?gK`^N=$z!~7Iap)Ve01- z1n$)e_T!=$9iEf}+@V<3&gE)R%)n7wgVSVK(J=%97OgufD5l% z0S)~dm>EVS#~<51E}DHq3^z;fs^1QudUJMOM;R9vs|=C>IWh;NeMt9LwBg;i!RP&f z#og!r)UNebK@?_+*AoGSDgqxJ35p>2qtrkT5s$GQtHrr3e`z(?o(7*(2`4xh44|H$vVn_}suT*p9*e4wg*@J*741YiBoJZRs*jB`z5=BW!U`Qsj|1Kx&&+RB|uf z>n064o!BQ~nHhE#F6pUN8n42_CwuJqkI({!#2G5*NtdNgATB+Q6$*)&ttxrSia~>X zP(^L*wp~h!mrJik&Ro#=wJ`kr%=wM~k-XnKJtAJL-+x2Z|H)*)#Lmd_e=8LwnwLqN zt%$!neM0(7rA$b|@q5Cr*B80EZU^EvE{Ss483!a%MnXtX_uO)SBE2CWrle!6qLUZ}Gwdv$>+nKf?ADKjcZb7K2mu@6_VUVJ^i6Cw)_ZB0zY6MfS|!&8?Y z=^nTYLn&@7pM^V3{_D;oX@yxs)#NAEpJr#1$)!jfXs`)rJ5(@`ClnH8hkT0l}?-E%eL51-tiuo=(jnxqK zne)Duk+nf3?ygh2IW|<9p(PuW$tBaE$R_oJVo!&>fsyrV?$nVlLLXv~db^3FlJWdDJ1+fJB`bCcAN`AB?RkcWZf*uj(i=81 zY4oo#q7!9uCi>P4JCZsR5By9{qUf1tixkwr}vQOye}5Xk`?8o)#h74;#BU*fhXwjwoX~~nDdD-W$MXYK4w6%}719TxDQ%CA3a(7`PNqwQ_ z10x%5`=_RYXa#A*4RVR$`tkF6zKK7RGh7rCll+qdK4%tJyJg%~SbMg|AAJzIS40Lm z#Qrq&E=P~#ICvW7(MEA44WC^}mH&)C$b*W4*+ZZvh=!w9jei>EhM1UY>>12Y2WKd1gZ$6&7g3xJaaU?DvIL4ASilzzeRvU4myE=m3pth1w>PKKiOmQsaj z6AJ{l<)E~-85n~18QVn-q|itd5&x|?n5x}Y+l1Qq>Wa0aBeL*rW(UN$XE|H|gQ0kw zVk0+w2~xv$HW5_u3gqcHhU!gtDocH)UW5Z5sCFuEFy43c6Uiac7eYbfT2=zwVAo-# z?~QpELMArW=>#r?h1TXn9*GBn95zi-GL$whT43sh&K)Y;aXh;p7}C-YuI$;@gi9(^ zApoS5Jpm|~ku7v3^d=}}kKjLvLMk4lw%4o$qT8P-heX^j2V{_Oey-5&g_AWVHfTVN zEU5){52%Y9yo90x6P}ACWN;^*@kU-GLUXFe4t_r&PmS!CNYUAzT2tY+Of#E|>kE(C@uUMnC-) z*fQ8X1yFCm210t*$CDXx)y~yBr`PAv_8lXe4N!J0E_k#-oHJCr9>Wy3Ede-{o=Ol9z`vguS)X5R zFc{y&5UG8O>XfjkeLq-#=sKL;t2d`V_H52@>@x1wPvh6;V!2k$7pa^d5?}qZ zCp7wA)O+WvNuZGF7+mwkOCs@&O6eCrao&k5xWD4DF1_n49`DaIGk0YN!4kutay5cm zotiy1PP~%U-=DjB13Wa6cu~TfXko79?C_;Txu__Nz6jMy z1gHKqKBUs%wE34|Sk4X=8%er6hIh2rdMMCEmjfwYf$#^I0xmsXE@^1Y#48;QgAc(1zbo1(^z<<=h-=!f&2*jB!Iy$<#Dby&Ixxyhy zIWAId=`sq3;XBH0o^D&X2YsJACVh6G0q0w9xw}wVy=6 zB&7cuxMYq2lGb06x8EcmgvAX)^3@Uu|hX|ck6T9 zF-*cq3?`fTi%vOZU#-Dy4UmnP6DZ!)-Yz9eEA+7IJp(HbE|G9(1(2utA?I9r0}1Ac zHUJ`L8sL>;*KAk4NQ%5~>P|Wi5~YEucpn`8Wr7e=sg3QZ&u2+znz^^9K8C}ws*4$7 zsB3Ha&EDgrLN&vN?-|eI&9c%sqs{GZZFT(??Tul!xWBBSHZ(7N(rPUl`0pqXqLRGM z>flnCa8zf>*)W~QZ$E>eiwV{bhe{tOlW}lda=7^`*VPRVv9fnD`3{-RdeN&}Vzvuxk~M|< zYHb{|cCqm?rs$AAZy2dI{=QzDWijRv-|q4yNY3dcV8^3q|{X?|8L^zp_g zJerxFf+(1Q1{hAXOzTi16e5VAglz50zqVG2a*|x~2rvh$#-GoN!B7p2 zWH<(h{jdp%-c0JF06hGBif|4(q}vGX>ji5^yak6$++pE2@cXqZ2Gy7rco}|Mxs+04 z{|qK9#$Q;M+S6Olr}P zOEs!BVFyt24$opXI^<42$LNSr=UCJC%W6`3Eerp1*(Mut_}$ID9c|@CdA!vozn^12 zN4YG!{|31Kn<0sX^FIn#J(yNbo1^z$exPOgKxQ%!VSfQ%$VXC@N@|ZJtaCCrn0XV# zkys(-0nFFGpSS-8_)DzYE}ly;x2WBk6N6c^EW^{ z^({3b@;Yr9c|0wp3E)}Y8FY4SwY{M1hu;RX?|A9eURI4VxS2tT%|MS1b5jPxv)ApR zPwTF4__xV&uiVrCL;EakKt*zud3MMg&ZT^9^#N0dGrINNWwcO*u4lb<2sj1}Rr4zq z2Tj7P7b1O12R&df)!JPBlS&d%w>MDm;8GrO@^{Jt&EwN@0oCOhTQNsh47ucsM^fnM zhGx>gBQ}oRj;{7k+NoPzFbf_OQHZJoMe;2Vp=4;+h%bh?(1L3Wt9I&CqdCoX0KZL7 z=5w@w%9+cF9?9#OO3J7&+Ud<&#eB4i2^v@dzF0%OIN~|>Q5+zh>CUG`qNkZn-mdPm zx6HTyxi1YLQrEt%1Cqxr5bBUDfLwRi`}N5CE<$XNC-}p7FwMQ1%g|flMga)osls#b zr9;SkUuS2}zjjw=hwms$jSC1a@eB9QjV0dZEX#JoGJa+ubtNkUZR}Y;MXccSv{F1{ zPWa(uvou*ym#ysSP%qc>j;*ze(Mn}So6NRNWU50C2q0OE*xtd3<4atHQh?jf$1Qph zG!s95WFyF;jMwWln!q@8@wa+ZA4JooSZbA?qKHrp{rI2?N1fPn0X#AiSsd+GN4XmJCJ zDl{ZC9w|=f8_aNnBQ2LwY_8f%+__zgy?C0w8mV%wv?GpZtuumDTz z@erVe)+i?4&-qbCl%7wRylR5m3L{_?oY`wgeX80NT_IV$O%ope&%^V~_Q+MR2)&?m z3ixa^Pt8Mrs{Ra}rpv9~%n7^QT>z7X#8_ZFd~gChNPbIy=`rIpy5MBySX-O=W7H5J zpPe_|Cnnxx;Wn;x4OoN!@-L|8pb-^UDgq;D?@Zxl5D4ECx;&oBB_{VmnCy0>`7Pz( z3dwZ|jrOu=3q@+HX<}I6CJ#Rvw-pGL#wgo3oH{(NEzq(d5ub<4B@hEV34M{($Z{RjBJ zuvFsI#kZx%Y?)iuEHHdcHct~mQp#aZxI2ldfB=qnfP!3`5DasGtH41sd923FfxE%L z(a=a0UKPJCVD@q0&V$Q>!iX7-*JAcJxuEj|jh8c>%u@q4W_fx*`0nztlFSP!2VLmd zH^YzWAkp=iJssVo19>fv5dz0(P65r>h@FWV#v`mjs;sj}Dgh<|>RZCxrbRkZmr@;_ zHW_P7HKD_x``kHd|3JUTAUGpP&SN+sgQAM`XGCq{lR72IYPHQ_p8HyMj^xg1P{mlo zw-Mhv!@cpe34Xt~5q~(6#2+P%O!6e!{APU6bwE|Q8#4a9$;6;(_+}%a@c{}n`}APr z^M5Bt{a1j*WJqX&o|Lk&dQegw=!PTYw-1t3N9DmRQ#t9Z+^@EXw*!Tk_=+`QEdV%* z*%3g#6ymPpU^RK!OjyT}#-gEt`DNlAxSosBG0??)k<7rClcJ#sEoM-W$#hJTTeaM< zmtQFm!wR~yBE@C0FsP2ya0*k7oZV%o_jO|70x5ldf=b~1s{5b63y^_y_XakvfG(;8xJ z3FsT+a$o`ByreAU$usf>B+?=Wj<~9?hcQR@kj$*olm2mUt_uYBG2KNl(oXy?$W&Ow zN@L2QSa=u*Z~K}F*{7eb5+)-vU9C8vhZyJR)A*`jc?I@9x~2G$Xc$2b#QPddU0Nxt zd*iQa;za!hl4iaJcX&}vdZr_*G#nSd}IFR`EA5eGnS4^RJ2P^?CFp&U= zrjnUvr3ea$*Z>TJ5t3wNssto3ZjX0T;tBhP%IQtcIkLYx;6`tL6RvGXK>nK8K7iJ&(&Y#}nG(bGN|#H;n{TC`KHLRk=#s_|o;U0xyr;L2{t151MzR?6c6YpjA4NdN>@nQDA!r8EgW zWhM6E@R5f@1BzAr$%;C9xjCE)L`?FHKV=9)Qe`0d4(n3R(z%>ZUKM8;SHi@u&I!?4g24r4g`L7V z+-XWe(ws`YX>+zq%bzXP@zjCvZbJBFxDSW&%4?~YJhiY5#`QFJ;1m@Yx+U$FS7E$I zq}1;rrhOGb9Aay?a0);XV{I`tbh%avBOs={9h z(ii7>zfbrgKfq7_g#g+ACxs;w1Ji%3I9vYt%nsWTedp@tmr$B99VLOfPiDfhDeh6V zb7faNtAHfqN79K}cvfHfqVbC|g^ibh!huw$z3pZ{)SeevCa<9$7XI{^6Y7_?$# z%YpIhg8=V3DbqiLCyn&WgY`Nqr@)Xs>W{1|)nO~c;!>8}9l{HXQ}?1!;6A1j>Ji%_+1W z)ikA?!wW(kJD&v?ywzpgza0O&)xwz7qI$h?=?)A&eH3OwnsaIn+sB;*Gh9e(W{&(( zxQbqlai_-7xE}e(EQgN1_>%K^o}j}+9-n@yx(|e+&#=$>{E)Otb1S)6mwuvp&8E_I zwK=6AYMjB53iR=RSWVw#^7p#2V~Yv8%JpH(YNv8r-m4i-zI!paggR|CArFWnW&GMojDe$ z`ckfJ$woCCyPVdhC)SY^u0HhJj3X(zs>kHk@uBX# ztpo38M&7)Rqkq%Zba-^~WJlTm@+e-rrzhG{5a+&9XpnE|>2w4@X&5i)%0}{s0-)-y z@Q`lgB6--ByH9d=k`=iAxLSi}3CHK~vcyIUCxG$5$=$xgmV)ZSN^pe{eBhhJMT_u^0aNWXCRiJ zy{zDJDJDlIb<-)P=U*BzQ>$Onuvd5BarKr@vJ%!?#+U5aQ#6v*Kb`=H9dXXDIofC2 zTx`rwFcT!OBdubgzXQjZS|VvKA8L8oNnHZF;pu^n=L`Ie^dyf$X+&r=mvodJ++ta7 z-~*$5$8es1;alIi&`u-^3G_T!nbtBJHl~)jmi&AK0uIm|kjJ2O_0oO($uZGGJBg3m z%>2?OEu7`^Hu%fa)zOKoAA6Hsh1`6&j{D;mWZ8hxbFsq3jDqtZ85K*ve3*$~+q z(b;>++lJBX82JyP3p(vM7le!!{o5U@|76wETM~zam+v;&W00&kE2a-y{AKj zWDSgJNk(TsbyNcp`W`^66QK9-R1B(U_W;ty^$mb zro}%Z+KQ@?wKkV@csDzqbCg`RPMyU4Di0AEwH*40nf7(Vet4i!CGK_X^{~Q!#M^fFV{z&)Ty;S&USz}E- z%um2-@}0^9S$2%FzZT0r2Resc2C)Q7u-oLBgG_fXvVjl2XT_(A$)tBPj)5ufA96w| z^-U};o7p7@mu^5Mrso&|0RL`lVe_@FiU}GlShP?TAQNWE~KMK zbATFv$)5>h8fqN=oD3x1ua9@&_~7Vrofa*H_4$wo>lizF!Vo83B+$zaaYXTmMWus^ zcEL1(vl4)@!wl6;CUanif(R=woi;UqSNJv+r=@qz|%&& zL4C&9PFIz`WU|9{f{9jyh{6XE0nnlN)n_B2*u|zxVr5N5hafi&_d zgDJ16_@sIzIKgc*U`4`6>pt#tN;rJCmL=~r)|=Fn6DHB3IV526$L$c{z?WS8}vkMXGg3Xvp ztOayLP`=tlmK4fYqqv_!3zXv|yBNYJ*%9NpGiz~gr&qIKbQ)2#_~i$}-dZ*kmD%=b zY8&I;_VN}~brchQnO@_q;E$n;wVVGyqm6k~J$D4`K|?zowlJ0RqWxttK{KVHwi9Ka zB(>1zCz@rO=!;aKJbsQ*(AM_?bv@*{(e>IU_jc_nKF5j)DA!kNXt8vv%`AV7#iuYn zmqgDg=z2GG7d8kedg<;MJe_UM{qyzEa7SMMkUnkQbhq zou?+sQz|&+2mk_;xgyw&f|gbgO|Wmf>U3)U*k}V2HUbJMVf?Z`xffpa>YP=}eqMSbziX1_laO${16S^UtGPiD+LqO?1> zYQ=O@L~eChLRb9lS(YDKzCYNS)2NQ%(~E5!zn&DWs(eT){di|`#CUupfxM@npWG{6 zz7O)ZNS)HYJsJ9X8QSW~nj8J|?`{NNBE7^HO-Rv;PG46j-MJm!ry&k*tL=tXwJ2L#0i`~-ThK@YxYEI z)l>rdiGYZ#dZqXU=0bj6XH{kCM5UFRt`$cn7z$h%O|toMBH3mnM|9~^ww7Yo(z5DO z`KM5BU`^m!%|=W$z6xi`r>prX%d2tjW=j-o1JWqv{#sG~7yjAvUyKa;9;XjIV=X$kZX~SvRT4@xN1!xn< z+Vc*y*56E-H8j-sf}Nq*7P~>S%j?80sT)bJnk*sFPn;*lLm-N+M(BTPueM0T(m~^x z(JN#dH8FdUqdh z;;_HwebBCdgny@bZ6fhanEMIUDj$$l%v1;xM;QUf2ZfvfnAfbDGe_4%y54!07y@{* ze@lq;8<`QU0m+|nqB`*fvUcuEdY`FrWBqaQKK_@je1Dyow;7tAi=F$5yARuls5KpOmjxrN3+66{KcP$~TEku&; zSO$dZ$Z&4ZpJljF(-rhd`lHktPW3l*_=-+y35`G;G7uM1)?Mj(To>vcQG@4o3=I_4b-n-r@}NN`O7dQF)xP!R)fz>5XqoDK`l?dBUPsR z{Ka4dd1iflMch~8)j}Ai9E^+8e3)53FZT1vjOD2!=J9hvJL|}$R_iFV6wpxJ?2xE- znBi|dbh2_wMv;?>2gfKr!|SH)b~oU};dIW~Hj-rI38aiy$hOP)8S1C4&{UWuARmWl@$PAF0sPMrJ&o zJ$!u|orR1RAcVCZvtoAMc1+JyRu%NEtv4ID-|vG;KxddYJ7JZqO9e8vxd4Vn?^o?gQB4ubHb&H|UU->ZUWMCV4=6oSflu~@q0)nZXTbAC z7a7|P6DiDMFv#?(wHa7MiT4VZrVKx8Jt;#N92y4e2?UOHO(*M# zqw>!o)QWiP{9s0smD10<*DVmO1aVCPaxnx93gI;`ATBJHh1?Pb{w36m)I+&p=_a2s zpyJ=b1BL$SF38#)Kze-&ZTHI&v2XRo##s=-Gg~U$v4EO@pxg)3BGsJhh*zS+{7yU2 zZV#B(AWL>1*ZDLz`P+^bDrqY2KndFK+DWr`OOEg{KIq7V+ zDK{l77OA)gvE+9JB@B)Y7$CJe`{44Vvq9nv z3aWAOuQxt3Jw}v@V?Kb$S5;|c?wR)sTbPTq0G!|J{elgDv@3v*kue@_#E^9n@dY@^7N%iZ^N$Dc~4JNw`0D zQ`>2?9rYib80ceBAv1zNBo^-CjGcGR*x0n>JKoPtwbW;x zkIL>*qH;_HJg=g*+EXpKZ=5Oa_%dR5&gcj1Kb=ikYmi24JzK1 z+H$LDYqQ9+#4ML@H}k4sQrm?+4GGn4vCNrbm?wDk`-nEv8%-}6sjD|$CG<1{`D7M3 z(QE8;K?*MAJJge3!GzIm()DbnUYD9LB-YdTBDK{>!eY{Whi_7H;Q&bKs)A;OVRmJn zx?~BN9f$?+Q!l_qW{36pcIZ_%cbO6Tq#Uj%@E+fniJEWy17^&0Z-ds4T#v@aiI43> zxc#Y{ca!>0Drzk|3@M%(k25GT@CZl0cgLpDRM)9gN_w|9FtvMP9zoJ*T;>Om7_VXv zU1c?RnaQYD@A5@Ch{(A(Vs-rt{}*bl1clv4_4efk=)EV;6X&@sCgD=pt{G-ogU2#h zR-pulWNYogpMauA4X;!7KA&ELQgm`#53x4Mt~4RC)sl#;&fSx(UgEfTQ#T7+H=tQB zYpe}!yY7mr&VS?S$Ygu5nSxo!gW3V(0MvArZJW%$Fq<7!X=;~lLYjs8p7r%$0TI6g z|95E45!yZTr)VY((w$fh8MuAJvB20OKpA zRaZ^aY(}<<^mf|esYTj26$}H$E~RZAriLR}v>Bfd@d1#ro{nxkisP=|UXkx15-7x+ z=@FDf(o%z9BPa@+Fei>kj@#z~Gy1)mS%M zMXL@WI<9JYqqFuK44JuX(Q$IrLp=QhATiu8A!A{sp)}BCFsl70&~ft8P1>bx>DvkZ zA6!V}$JZW$J9%^EZ+W~%Dadq!jmmC4{|3V{B%!$4)+(~G^LX-i^krGznUjuc7+nnlKNJEV>I zD|c2)Au31sydBBQx~EgC|`jJsM^wF zjY&}sQ;DSQW8N`|G81y4$Vzo8IMf#_$5KTgo6G45jnlYYU@o)41dy_}gZIy}*CgMK zo47@&o0LoCY0H6t^3#d70|?a>tT98x(pkX`UPVmKP;WjH|8KDIrp$n6R*#=WrdAubbTk0K%jI2JvpoU zzvEN3JwQ~=CFIqNh6J{;vqzfP}->E!@)`FNe%@C(u$b|K0_Y&cBKxQ|LC)ETCd z;QuHi93%!(N+@wa6;cCOZx{x>fQ%XZ7$k9QAcTfpM03nSpqa9FdXJ(g0Io>k3z;{9 z<_c)Y6~x>=jqwN{8&B0himXr2&B3z*j@0m#LzR+W-1y4Gx;2HO|KJb~`y3jftb0HZ zAesMqrV~H2c+wB7vur4`mm?(xd&p6%3?aSY_6(=Q|HpxB=6Ju70wCWV$$nCC6k29j z5=_lH7QcJYgh)4Zc9x)tMwWyMOk$N8iwS6Le`@+m z#Q*|!uM9I5nr6ga#}`&f@QSp4vqEbrtht(@R#wCmR)uO)upi+KrhzCz7sp47;LUsz zCF(O;N(JOxo|5y-Dj0q0(=&^HlgOrV=8|)U!VlCl&IE2CN&>PskQB63Np5kne!Q{#p@|s|3?g_K zBVZ)+4Xo^M0slQvH*9dEexiNx@ZYeU?5KWzgwNDUFg8C*s%Z0UV?^~7)S0T(uvbS9 z0zdbBY*C|xkk33qi$9)S?!>d^ZM@mB_Y&z64HN%nzH}kI> zG}dE11V{v$F$4e!Z-*yBXd5fA84+qznyOb)N`B}sQV>?ct%EGjF=K3QL+}># z>TpuGlbZ=Gn=``cAu60sbeOL@T-e0WZeR=NPMZ$u2_T6w4nk&h_y5P)KQ)O0CDFQQ z*|u$4t8BYg*|u%lwr$(CZQJ%;`{73Hj?)i)&M(M_`H-10=E!e&vN}By`!1+u0Sq@A zvuhZ@Teo3=*+pqfWWXLX!<>5JdDoLgGLmG&*&-A!|=3+AW;a?56t<#%Pjq* zYnGGp*FJ1wi?nHdDh%;&E7W@_E-^UN=HZ^u#9JYc@~$}6mv_6yW^4vm885mP+U6hM z3IF;S<}&!pht*=YT9kZ6Z;H8+f11M%b~_@CMp8z<0M+9f)iP|e2|r8}9(zb6j>Lvm z*FBIFNv&Ozy^A|53{ahmd*@59ZVsN11cY&Yg@bD@7rM{C&c!}c%iK$1UIyADnFfE6 zIP5TObvy^qZx~tq`$v^rkUr#M3dS!IfidffZH{+~xM19-ADi1Sfp6Q|54&$Swxkm@ zy362L{y4kmCf;CFZ#tbwbvqgR?V&OizkZD}ht?H^HV&Qf>Wq`}iPDuRIrrV`^)~l+ zINBi9gz0caMFPoyEEw@K2#99mHN9UFd;?!9HI-GoP6l!~Y$r%rE*T#F^gu{gYPvWmnyET^=u>fX^cVJf~=Zja4|?Oi(V%j4dE9bjqZzdL&|KP`LtMA5c{`+CP z)zt^_j$34nEfSBom?Y%U@cJA`)=W?_I>T~JgC`@ly%IFUU|8hTt^+>ptZjI{3AqE zq~+W7^GP)g%IprNYk0}G@k}POc+`P)vGDwR#}-MxUi7y?dU9Fxcna#cXTu@>z5fxF zlv$$|<8&a}GcfT~LUkwmqM$JKq190J#e13UN$2@Vb54%WNySlY_74VeqY*{LNbCC1 zYlCHZ>oYRm2A#N#p?(pdzf8|Y)WMdMC2c~%`gZDf!kZ*>vPt4w?rkM5l%1RudL7)j z8eU`##zc3fQ6ki|qRn4yeoeDp6ra~UbO}=oN|U6gyI)rcm}w@=r@<9$Qd%HN>lB;_ zLI{#-i4DyU+#9J2eE*SD3^N>+Ex?#>{%p`@(58AwRR3OYXO0#4pUhg#Rk_2txUAwZ z50H^li#Bp*%ghD7t%KSE%DVj$;O;ioi5yz20`{6{hN-n$Mj^qwQ=+h%poo-y*J!d8 z)$h4OY-GjG`d|yx}val0%z?K$s1^oY5 zwq>@h7Jb{4keUGlTDKY*M<7_FTZnea9(&tg@xK6LNHX}o#y~$T$|BM9<_oztqNRa7 z?-^@?Tmj&Hn$BhdZ$O^g$*ONvi5GShuc%|OE`iyt*4nKclc%g|^c)eE&$0pqZ^Kdu z314BeR%9tqQ-{(OEaISKN2PXyS@KV6^4L$U{VzR<+W9Q=1Hxud{W=U7lj&$9vkEZR z`ty=B$o_yEhX8b1OK=)#K7bldxszUlv`TE^->Ib#rxxaL{3AhtwYfR|dp9X2KrVab z_-}`cN3BKl>BTgM7no3)2MUMQ!1ljD(^G|%_#(`~uwfKsG(;J|;3bP4h0iHGwDNNo z-tU*?RxUen;mC`^Q2-q#VmyxIdFBiEk?|t-hN)Fr%ry_DneVNESBQ^#Z|9;oTM7-&YvMw@sN#TBW7*xI&fHIB`qEb0^v$O}p7&=18{0k2>g8;-EtDAVnE(GlA*{N^E{^BlbuE_zS12~ zxw|@*NSkI*&UqR1CObQ>=aKA$mubjAIm4<2r+)A3?M(wHt4j(5z#MzA&Av;n;hcQ> zSWP$s6FCto60?@1$R&-_Q5;+fxK}xX`ssx4&xA!cO?T-kdWBTc{pt4zCBcKE+UiTe zOhcvAN)n2{6i#^gCLt1)fv34_le@NE%4FLw0hTpNO>ia;}NGC;~O+z}F&WeYa$7(|~KkLGt z>=klA6aXEX(Y2qrj7v&`18ytI_+|YiDQw1DZefA68)H0)8n8#2Hc8OES$KVn*kYXU z#YC=SSKZtU2;aJnYxcH;$te5tOd(w|U0BYTlhp0^>ZN#=f;qX1 zZ&}FMNjdxch=)sLA`v~>$OQA z<^hHmk}A|Nks2Ol3=rN&8v7)Z>UKjrVb4`58$V>~;_I+f`D)lT7v<2a^{&w=F%B#T=K6D_}W;O~4i3yfVY^#Wb`AN#wj;{`#R^`DW6Q#EG zGIOg^Thc(bt(B@2=BXxi|fuVrHmZ({JxiFG0xJ_4Wd4 z2^U5mvT~|!3uI%13&BR`T`vb(JjKK#;0F2(V7{{6WQ+EcS9%tWN{_Hq%BzQ=8Wgd} z!$SvAhFiu{Ul9Ud>&$#Xra}ZIvJXuQXF2V}+d+BXYufqk5ah`p)L>U;8AXlg_P&Ou z6*<$~DXFL0JjCwLaC(k*!kbnfhS)+}H%t$SFgnSc&YSU#EWgT(h`E$Wj^8Oil0PJ| zCHbv3KtF|vG=P6dGp}@#w_3Y%ma!j>h2Ebnit7>Bx$*Ma0RRVSH-1muF8JfV<-_4y z;f9ri)@XK4%k-J&sS^u?f~!zyQPZI4TPj$EB3xF|Y61_-PH*4fAO3r^P!Nmr^W|Og zhdfApI_<@+V;Wb)9ooffb4>S2JuS1$9y9@gZ6hrEN)~G=Xige$6S4QyYw$koml8Z z6=}B$g1I6v3+HK*$MXA+yJph&Km`%G;#SNbe6R!}{JP>~uie6$7J~0-)NqW1Oxxux ztO&HPXk%`;Fi#!N`B(%>){{l}B1E~OhRIFt#-HjdH);|-p>0_CCiMpK0L3TeX-h;o3OK&ik8OuohqeBs?AMuh z7_1(dvh=GxL2KBKz$_-e9f*_`hK7LCOZ|-{+GRu z<9~zNb29%2N;g@}+V)@G*iVlxA;u>`Y4U_>x6>LF%$gtEUQn&BVp>Tt#3GzdPP#dPQgUe-h@pL@@=Yw&c)kx%t%DY%vLs>N+`a% z74Nod$?auJ{xqz#Fdn?h_EXApW$v*ugwBb%&K-qu)TU++M@4#>R&hi)1!noir!kO~ zj4G`4>f-X?PMegzXky?x>}U)A*`*q6X7Sj8_x4tNMnGf|I+J7{n3m?uw|Ta7a-8Cb zv)mz=%6eCf)zQzue3cG})JoRyuq|FXeG{D!t*K=3 zNi8n=nu80IW-V}Fxr?SG-iH!ASUVLY18L3;C}GH8I53MFGaaEDNG5x~?4xpucj*xX zF~E0v?(|1}cD2z0k-2>iuF3MZ9xQ^CEt~B>(uT$w7Ces=>Y7ibbN3PU%Y=I3Very; zX-D?gXmg*Xh0)CM?REawf#ofDN_5E4<4N|sSTtD{<|AGPzM(YG;3hvQ0EW|we^YMc z*J`y&X;uX)^Ox9UW-N?MEB9~8r~r-O?m)H3`6WgP)UhAU+mNX0u1R4a(~4;xOCZ&Sn3sC4+x zs(Y0ykD;X7HEhr(gP5lehD$BF)%m4?l4E**f50>D_*gtp;_P=GW> zY*6X%us;0CbKCD*TYEdI^prkpt?q6To7*chM>Ga^-lfgY>-r(!@s;FoI@=O`k7w?Z zW97zAbt!*V_wQ$FaXl|4Mq{LMj5jJz=^6kn{YOlMlK>(NCF0WU_H)MpUXc6Ms7#i! zF=g3u^?&Tk^PO;HW55#l;^+eG&6>EKz>8@XtK^CG_^vDm?G+WxTeOl$SiTWK5ySnKI2rx+vtx;Oarp%z?f*LIZGx2ds0 z$yk6;8-RteQf^-AZB~(!9!k~mN_+HEX{q#+wLh`An%H6GNa^WsHu!_M9FQqGZqiB1 zNCvA4=3Cv!0n0*%Hn6k?qmUcn6rsdKd{l?q+a-HN8L3v}`r(YH)BCD!BHR!^H&nJZ zbWCai*Y!Jnpr4LFWez7-qVa?R{a&slCS0urcu0wyqx%opC zI7e#Z?Rd5mJLp5g<$NQun#rQ}07ZRQ#N*{uevM%J0ccQt(ZU}4DbVy|K~jegy^G1e zBQ;X%lGA_bbk{Mg%aYUjb&awa_VzyYBFk^)Irb;!fSO3=)@Nt>5$vqA#7UN$TFIB4Uwq(lb1f!wzbMevSvh^BMxZ zM7dDFRzH)Y#o}_iT~9JllxJgB)KJWkGaPU>SKDVo;2lx@mCFAjC%}FmX)%lB?_LlZ zA<|zc#Ge+epGMh#0hykvivHV3|DWjiOdS8Ww@ZmanL(KWKu`$Ok(hueoQD2OjKjr;@x^=5t;)dmc8B;z25_W4au6i zFvUZ}+zR;pZAk>z+vt!jkEl|OW<{pvM-7x3->07ndVg0J^>ev2bQzv6q_XeTfe-#K zyj&$mL>G&ss=(3ly~(ru&k2Zr!_W8rEk9;ez!Y>KiKrwy91@Z9;npSy>TSv0%!0= zWy`%!DQ;i=BgS%)hronI$Kc~v!}lo{1kh>fzkDavLK@`x)CnBFOR~)HX8lnTa{!;} z5A+aeXXoXxS)_s*Ob>;&)mK(Cab|YILWp#gXnvK)B^S?xO!B3er42Zq*!>~T5dMB^ za3;3{@E5N{Y_AKJwJF&C5AYM9zrc(hfr(}cINgtauk+G2PVl18$ZNjWV6sXNPm6OX z6d8yWI{0afl7MV6BU^rF0Xzjsgw(+K!+$N#G`a2aFR(2RuVYExt{kzyR zU}wAUv%#gBlt2}|0?mjnf!2x540^$Txu2gZwPW2$wu1ih00`U>Myle~+Y&V0!Dh)D zp#$tF{J8W9Fc>~nd4d#3jB@j>($kvfrp3fa5~(pC(1pa`w)NRG*qZ)$S!C}M^lv7? zBzYB`uvn>U?-XNv-=Eg5!n3>T-qzX~+9}5+1XgUtu-k)l{4fKE`;@0|@u>Gg;{_ zgF%T$+1n65BJg%fIqYo)$0^GQJrKm0{|my{YoueitIt&$kj1c#C9^L!PM3EfgF)R|H3Xtt_(ekLAkg--PD-V?9UKce~70FyanF2c)p2rA2G zcB-jM4%cW2jH25eX|5Ry#do~cS}m`u6ciks>^N-)7Ac{C#3bp=Q{oh^v+=_)>x|qF zHYRPNz0c52C(6t$T(^j(j+BZepy*5efH}d!=9lUhU7d1!F&gqp>CD`NuZWty0Ch6J zehVz}+aeqBC4WoM!xEiC%3-#O3xDVnSyDtwuNVR7+{bdkfXpd_b_xz+l|6k0SprgP zm2Gnm;rvC2gNmUut3YM=2M$3pP3sY{ofttq$83O4YZRY9%sl^I6g$#C;RLgxmDUjO zS~U5Mps7J&ZYqjPSyue2Guh^(d0gql?PB;QvyezWEUBd%u0IZrUznwc`X|q;-I!_} z6zXJ-TNNk11j8*rKW>k~eUeCEA_{+D1HbZVdzv16YA8aH3}JLkX)aF^-r~5B7<7cKw6^3v&loU-ijIO zNpb|*ac}UVIqm~NYG!40BGVP`5onO9kQS*vWe740Y(g-{oTNdo26MBlv@*2Xr#f!+ zhpLeeU=>EH5sPBgXc-_|JO|7d8uqAwhnRXhu@9HIYZbl_=RSu9i3(MSk#0&&O%f@#&jWpk8pXvl8!8I++Nv?7Bv+tu6J^8eWD;ptK<94&Ft#qItEwff#H zwtU$D!j|e6MT4N6ljxOnpK9jhB--ks3;y!G%<>$j_Bs$j8=mDb1m`i?6}=HpdvmbT za7gw!EhEovx?%=V6IUK708mov)0YRXh{z_3HU*pvM6!5QagUNA*8XW9<5=QkZD6OvLj;DPH) ztR$wB7c6~yq)|mZPp-nCeCvzxfL#yKJD<>x+VMTHw?A)cQXA$iN&QxTE6XBs zE34J^Rp?4SB-hF$Os_~Ui_^?!1J(Md*+sIap)7E9_$Sr7ahNoZ1W}OV&8Za(?5=_>W@suh>8(80u|3{<2?G))K76LjG$Ggq(JYIi4dy4`0?O}%6 z+jWeHcI0)=(E^FNZ7)y#m~lFPGaQBAX2JTiI2`pZz|@xA<1(=1n&<@5YX2(3gAt-X zR#IHi#)}_PID|W#&m5)bdL@=|?b`Fr4Ix@(gN{TGBE9dh2@`U+4~>*S`6Vj73~R0Y zh1_s|5w%jBSF7PjgvNdQ*QvasnWh7)-Z_MQ|0B(QA#L7YIJ-_gNnJ#cjT^aGO@`%b zNakP&^CSE+w0wkD{VsyK(2nd&Qwp?|WZoHkkRoDDHFCT`jHWUwrt5eeH@>JBOcNk4 zp-H{<>3dE>B~(|f|?O|bz;!O40O zP^f_Mjk5SE4HXNt#0??7xKE4j9C~9aq^R~PqlC(Ne6Qwgy(yE&#mBEN1F6I3%2M-V zgV6K60wwLcX*E1T>hRw!rCA~5z}BPCcrJB!fgelTLUeLq@-Nu-w41ciccwHBubbA(ZOT-;QI zWyUh!=AuBwcr{qG6_IZ938+Ru*Vc|vm!`En!ByxQuJQ0RW_4LIG_-5)G^A$f_!2;;Xlu)o z+$sx6Q%?db6@D&pu7-d3E}eC>xmLny-v$sg)&_61CpX-49&WV1g)2US8ZjRRk@#WU z)bf3})yh)5;EEMhD#|_e?g@sPhxgvl2Yr7Lm=r(^K-QuAmgaz-261k?&z*3Qv1dWE zFCd5`ev(5jiO!shL66XXJ1hycA2woOdm!Bkw<2} z&L=r)8N-w{Xga2+Gdx^)URc9P4o`pME=RVY61|}Z z&hT<0Izct_ZvFAI93_FQK}3 zj|@!HwqI^8!$rrUKsrV+j6p%KP}XduKKs1c;F2Gxck*;|M*?$l~;N8Fa%tZtV$M*1qsImQV^I`S6U*TtPXhhZH9Qo?l zWJ%ztm&5fa^Y1q*_YJ~C1Vd;l@1i>1$T`~dWG|J|&Fb}jNu?CQ%8uiHSAsp@q_)*x zy6dJeK5cIPW2wr306}`a0I`48BE1g+t!nVGtcL^)g4jKi5%LPho^o7Db`VvC-i(1a z$a@LP9FyC4K3Um%dp+Pp+GciO2+V652f{vEdkWmCG;vsD?G_nZgFBKdm(Az<4vvg} zcKqK4$o~YvWMpRfj{y?=_x~Coff}f!8Vw)T*A3O0EmmcWAZlRJ@f4Y1G#y1rsox*l z(8X&K8~p-KUFwq}aG`(bb7=q8h(-fU_eA({h6#Ps|cijC$73hnXgm0V12+8e~`X zWPlbQUq|85#jA$CXO_x32aU<1OkeUJbl9u@sGVF_ZU92gJPqbw1hODd>xX8$Oj(Zh z;6+^rGMDnjZorr9Dnem6qD`U(YYFgEY4(P-Aq-;2`7!r48m`u@z}m(}Dk@K1M&YOF zYyOzX0pZi9h|sk&QFO`{Iat|QZP**UtjHy7iex;>2DgRmW*bd+4qK2`$m-CmA(Nbk zlYoxfXCypC8M3IAs@Y%9(F;49-erban8ZPwR%FV45)6J2A#UYnkN{QKY}Gr1H^;bB z&tN5W)zE&%I}IKAr{;t8RJO$nKc58OAkQ)_2gz`nGsQ<<)l|8mLOcC6~_=x^o0Vu zs`iAOxis7~tfg|V-=)?OsGJ86vDzj03ODuq5u71J4;~fAtcWWwcvWi=Hbpa-WdhX8gR6vTrhrSekXl-r&2vKb2pAcxj_qaWUU2TBTQv75=I-Ww zF=6mq_N9iovkZ(ByBtk{*Ixrg(93l3XWOH>`62|^1KjjTxN~Kz6gwSw(hH5Y@4&0_ z)T&at2TRTa3{etyZm}?10n`Rf$ERYC3I*7kwpX(mP&sZn{1+5O`N|@gJY^n4rEZre zeg>``3*5q4JKeJZ=8)s+Fi_=Va)tk$_bQ!B0ip_*H9hE$JrBzvs|;qmw;qpwEjbx}?Jq(}3=i(fD-tdEc(aWe+LLuXtLDP} zYSx%U;9s!L%YR^;-+%f5Nu0JGgjhrwQ+jbMwmhlZCuGdo9~eWzk+x^A+_2JdzBSOJ z{4VXa;IHev6LQUPJ$-yTsY=w#@%#8?@VnK=l(?&;hgs+_V)g1cz25i$|QLMi6CtkwpmE zPc^m?IGAHS&UIKy-h#&5^Q3hK%$Fe&PC8xB@}mR0e6B3KG(?Mwl|+a08?#dWw>29x zL{@iSfdEDx9!i}Gbiy4+$2b%B*)<))RLm__Pc;>ZeXw;j01w~||5j(|pdCoqTEE5( z@7M+FSnqv*C^L5(@%7^1@H0(4m!?sTB)=33>#Hr)c;#$Rhb71Fer#K^oaR*PWawN6 z%Nz|g_^q_s%k*Q@)_(kWGQwFrj{+0*l2abSvRQWM73B9$9+=icnV_E4^-SmWD!byZ z^kIA2uD<5tt5#%yt}eOf1151K{4MP1DsQJb=GJ3(4EwBEhrFR0pzkb74)UyGM}rx@ z(c{(7bh17p*!T%ek z?LS1*|2MiU3&a0L0byog|G%Z*?SB-I&9VPO0nxkuTg;yf2prgd%q~`dWaGqvlL0HA@Ws(b_bW~7 z`jJ@Paj~DN$E<%&bVvf-cH!POt(vPxYQm*LX3`jZazR&HNC}3cV%%cye6x*;x=DkG z#9R(Z=cp4U@_M1`w!Xy>=qDheF9y~4uMxRXIDpKUETgZ*XpX17I$Flyy}yA29<5zrIXSX6h~AI*qPxKuIa~^o}<4n zjkEiqra2AVr#oEMmisMa&BboV-A3P>l89E&-1?~ti(U0tmH`z`_xOtlYQD|3;b26X(+QuCid={CJ8@78G%IJuz{nYPnlUllB@<~8a{ zB|KkR?8M>t!m=P(Y(2w~%j3Ksa?cXYlZ)Zo-!tSwWC3#PW3#dX*0r;Bwz6rjHkYR# zE^5h@WPxq)V`IKE=?p(7i0SW>8|HS(s@rAS%QK;#d5PR<9;4;sOUev=;+Gvfn?N?k zBb;|^q8`VXznc$vKfP5p=(COBQx^$jjsjU#x6IWd=RPr;jVrLE2L+0rsx8;*JSHp_ z;}yjMB?WA`U%SWpiIGqsWZ{5v?w~qZUf@jlv!+JU8)%hH#$6i6EtV)Z1s1WlSBm^X z3}lr_sHc*vc!9L6r)M7Y7RO#-Laj?TTl{fJP%n*j|49K6hFHdoTQVUk8Bi zK6Qp%U}=H)Hh8v-`i(}%VjTm%o&?5eg*xgz4?!Cm_L`G22Nj)QZif61fn6qB)?258 zX!8{+=7eIXxZR*$zzO>V;#@$N?4sqr-vSvch*eWSJ@ss^v1Al6tfaeZ8o(c%ahO34 zYYYSg#p0lMV`EOcoOU-Iz+r%@F_!$1Zjncirv6#{s29H8b(@Ii=k@LM6WJ(dd5W45 z43(rwwKoryxf~P8p&&(zHTm@n!9=i=;xe|ppAg=acWC~ z`#z38d+D#>+09T^OVMvrQ(I?*6YNzB83VYQz-AG!%XhjH5eRgkOJr@le62*fRq=58 zqyUBrXEuBO1<3(qbvbG(f?y<#hOqS`c*%nITfWzq{ZtCWB9mX;A1)_U{ALx21I}G> z`4osD5bW1&1Wa1lw4ewkE@cK#Ty4yh@GMqgE z?ai;?aOQj3N8@+#Ii^|otD&i5!19c}H)N+XY@)jrYC+D>^&?vYdxtmHw80u+cTS%L zZux;*-%)Hdr*vko>$w#>f$@sBW+B0@!z!u;NW<~c<7m4$JGWLwnrkYUIx9Vf9aLe% zP_(MFAL8ADMFwu4^)MP1XGx_QY1-tfXLI|R{fe*dIoyQNqKY%Q_SJ-6CQ~mdnDI2h zx<({$A@&j8pFRIL7jCty$088on0n z%5J!q|@WsU5FgY2CRmPeiN(T&pOucqzz)oADcg` zt1Ztu8@i}bw+9*$UeDF)g@ybsaF7t=9ns2$hI{F=9u~YI1c4D=dY#^tw=96aNN@|$ zH}kVZfVbzupc>UrXwh^*{-EaJ*%e1HYHLMGA%ns z4C@+c<@1MMku%%5p5fYQI_+GV!~wi~ppU7ysFMd!KMb!)s#o6MeDH@Y3Bd^al6%_a z*+>~yn|$G;xt_H4)mARcnh~>j0C3-xLXKk^LAIdNjEwYR)h%S=KI!$gC^D20%LVs? zU<=`$fVL=UlK1gRfS!;LGd(KcLGe&(9>C~BC>A;2|4d2p!_87SUK_L@RgRMNWrQCn zBT_wSAZx&GC7MF8?}CxTE2C}+_4r!SGi>iNMISCvX$nCR z7jdO7Wtc1l2*92bqOVm$cCOHe_t=C$AS_u#ARii&K@tn^$-y@5j<_7uv-{6J|6M9{ z(s@CVFS6b>in7um04N}O5elK6smixz7}B<2Cf=CHeVRg2bXPgRYs;IWojA2oXNjl8 z9?M9n^0`uO6hz{LUO#1HQrh(~lunND#bphR+$GnimKUg3gP@Vr+tK*mKF|jO*0ujh zqqgcf=|dRMwNf%G?0EW{+M_;4h?7*qB5}x}1FR`nYI4++RjMp1mw_pLtb;GatXNwi zQ5oyO>cPzZ*!P^zZfr#ZSwGxUY~GLELH#ez5PEf_TKz^k(`c%XB0ECdf`#GZ;`sQ}Wqhf>NbSN69*T09&Dn1c zJ1N{BzJqRmcEg`qPC7l$&JOji-Xu;cIMI2)QZWpLM;vti4rmn))*1?iBl-3q9-68< zOg`zVP7S<#dtPr$tB<;cQGZFDik7cCl42WM1MXqtZaUobQc6-^Yy zB~g$`&jIsTKpTm656=tYtKrJ&_G zFqR=9O#O>x<>6>ZvXd&o37^5E!4*A{7lr|X!87Ul7lD=rC=ef$eKkVaSX%0dx2@~D zSohdToCWX$L7sf)yGO$|6YF>yYIz>kHyfzM@t91^Bo^d@XFTKe-jAx!;GXrn3F){` z?hdt6mc5Kj4=VOOYHuA71 zniE$}KaWC3X3*fx9$#LGhMeAxPi}uuVd`z~{`s=~baD~10@25HKdo}(w939b6e+k* z^%ZZU-h@kifoiF&-cZNnYUAz$i0m=0B-d?UaS_8R^^Fi#wlL|4F(?ob@%)eO^x9+Y z#2Ozih3DU?oXt6yXu&E4Z&Uefce9_OYFp}f>+!;H|GK|BDq`Z3aeC;vQ#swTggy$* z(-!H`NGrLmrFAAV?@rBOLSxvAVxYL8m;Z*-K^FEX)`XZajY`qRO5-T|e`s0!kiGZ2rX_W6$d9<4VLg zD|~j9MKS%w9m|-tAZK)DC0dcDQtWv9CJF zZXnS|oiOsy&q{Xh);yM~U`BH#(=BQJRQ|jGF|kee8eD+9fG*$_S7BS-!C=ajhb2^y zzaglvtjRHC0XY~}35u$PLt$^fcLZJqyMTGd`(V~eho+`#i6dE|lvCGrIIYv$eXsy| zxP~4_2$_oXOCu1n#UQ48%vLb(-P1E>IRM{xBHy#=h+_Eq5)%zJaZG3c;d}nVB9|%xNiQ`MZV$KJJV5M2Rbh%F z)w;dF>!DDVkWJ&8RZwBAY8CN2fU|G4xir#w4z(SlkglP8W7pY1pUS;NN+VxB1E7KV zRVlJc9jFr(2TI#D(H90@_Km7gnIXuN{2^5)^M$d6;cc3lYFau6UMu!8O<#d7n*P~1 zKrPz-X^u1)KdIBGQ{Qrp6+ty|NZ>bIV8X!WyxwpU+)vsGn_sG+-*Txb%_=DeGj=%i z<>Y?o__WiCF!s<`jH&@#v~NeCsr|iF9-tRgsG?*GH%1|7w}{z47AiJGg3+%^R5cew zFx66`7S@UJFE{Y)FLoh)j_)2{o2BE7foTRy4W$Z?<)9;(_z8!zAwiQ?3}f(C2gPSG z=g?p0%U|-co84_aOQ5~BU#yNE|JA%3CRf>UL5Y818*WGDX`2HxR%)v#7jh!o>{X+1 zaK6@yOhynHq7b7Asr8jYVXEHaTnAhZpe1IppK;q7$gHFTSw!(+Dqrh{$)XhnDG0`6 z%MC0e#TGf!KqIm6s}BHm^QpLrh%lIeN2&;nu%8r1I(}{>z;H{9AsS$nI~Z9_mQsJ7 zepVm~aplTS%FnRIT+IPAS6VpS4tZua88L_@1uWvN1?!&VxTTe*B&-I(fZ{~0#Dzxu zKLMd6`?u{$w%4Cd;-@L37@N=E2EQ~~MO3{q?q<%k8FJ4|E6~!5+T@-MM$rHo7?^ZJ z*f&wvDDqs&lyKHI(;V;Mp3C_yc_oGDMRS1S`EM~hdjX9U;-ek1h?ke&jtauA)8?@d zHvjZf^|y1Rp7zY@f^3Rrwt{}BezidauIX{|<;gj*vQIS5N9*}nH|lJJ_ZH!mjYSvO z(D>NnE8ltV8TA3&uzDlqiS;#h{gF&Lot7NO=&I^d6q$t6l|_+6o=P~)Ct#K|YplU(3fX}Qw8G}2S5)3gLEp|! z3zZbw5Kk7)4TJ2L6@!ncwxs@8MXR2LTK>9#p+Z|L!txcQfs=lzcfIQ>lV@r&XWsG# zy!=tJ?9l*}q~6lw2S^}fO6V0WX5}hkg+^8NDXm}8uCT`=I2m(=|{J zT7tjYerZhFBHu)y8Due@=IX>jAp=qg^FdijW{8U7hb>V45@e~9lowJ1{J+} z3AD=W%S%9V1xADU_63W-L`Hu!z=;DH1=IG08F}`h4zseP1o+QL#6D-+%q1;Of$f>IcQ)a`+3dGnne)LBHK*5-B0Ex*8YS%D1@aCJ){y2S8KyW?Cr%&vX#WDA^}`2y*3%fW4{I_OeGdz8 znXvCUU}G)3M3)@ZmZ5GQZxn;K+u~1aBsA+DGzy>1NWqw4CKNYEn);nwp1Msl?nP41 z)rUz*Cu0(X{_2vOcy(;C?r-}*|O zyw?w`t$zt(X1Rz!Bk-x@1#4MD*WF*eLuU1*w>YTZYM_4|x#4Uo_Jujzp4vaz9P|7x zjGmBhl@Gw7k}xngbkk&qbgU9~ecrI?%pa!zTL=2zJjDOsI}p?VblAkn_8%3l)ue3y zb)cSC)iVm*l;gNTRh#HXvxq#A%xTJV0iDTkzvPwpCeW|jKPV#W*z%DW&WRj4YkqAS z5tZ*f?yP3^vfI@&909&P_qvv=mMs~B#-}%a#ZuEr#C$kdm+YW zn=@vXA1IoG-w8tgsJ-+N2d)hhvy=gv<&<^Wu8SdKwNenwt>1&@?fEqy6LwDjsNAM{pjw7b9=ivEq}Yw zgcM{ao!{{fSqGY92FTp@3N}3yt#m#`GTu~U3ojW5{m7s)Io|rr=Yk& z3%q?h`)T1+vS&JbKKGR?7}>RTGnx5$j4;V0CyvSsi&4g!jsVM2 zm(^;my!KpOVb>}nHA*#7{U@hOj?-}doB~{mfgN)jN1-j#?cFfK3zrj{G;F?hN9$E+ zxd^m2&YoeHtIeAfGw@J4K?ux}R@xJ8gI;i!u{SqHpF*2IRe}8|>(Rqn@FuRu!@{&1 zFKZv?nA(*p=LcUBJ`W8EQ-wP;$-@PMpc!^ac#s5v3@BKKa9~FQ5MQ zTC4Xm=#)-#4+s%I{iIBX9dLxu%o+awkFj@-@g(ZDK-;!$+qP}n{cGErwr$(fwr$(C zyQj^0^S!^mn|EJwQ^`qHYA2OcrOw%Buf5h{?(uiJkb{xnCf<*GvPY5>nR7RVZjvUc zvYJ>CwX^T*!&!1haknMjNlZi@&Rp=uV>JkMa!ewH!SJ_ut;intfxeT7A?=CGF&&_e zi#EvX$+Q0P0y(VCY)%uxk|DeYG+v3g9=h-mlhZYW^_N7`52y`PtfTVP2sVe#zxPU~ zM?+)^aZMcHu2lu;=&LcQ#vYZOU0u)R|A0sQG$Z{l(+$i2DIeit{vRyI8!df@B_=e# zGtD<sW}E5CAbTtH%UECS)|p|C)LbgagWp17qj57q{7N$8Z!+4J-~ zdg%wHppfAfX9B}#T6j=gnMen z>1Cdp-Z7*<{+1~>D88qv3~Q0{bJ4{@$ziFDhjVKJf~YvHHwnCBx~ZcI%^(R%~_K zRLUtGru%1j6mawq__&OIAW~5C&rT9qJ28s5nzVWY>|Hx#St5Cf5F;O0v!)vGGA;@g#k!|Hv>*>}~ zsnxz3@}py_z!!R2`}4FaLvCq0)kn|^SHaXv$bIGcH-7O=hR;@myd$jm$RA~4B`{NN zPo7*77NmCHlwI!_1t;@S6S~6R0NDy}F$igaKdJ(&qSBchcg2ns`SII!lm$W3Fy4JU z)kg;P-aswhc0^yr0Ed5CGH>AhvljmgN$9_}TWVg8=8TFa)~c>{j0!|7OiYXtR?aT2 zM9f?)|2egFHFsu|ur+oy7c)0?Ff(VAGq<;N1^m0s#roek^^KnVf7a%nSIv7uI!i9R zB%ys#RWK-T=*8_If~aLGZ-B}$!u-!?FXhcNJ>x}R#Nz)iWL3w=>S{vYS0N03VJ-`LWU@YZ!1nC zcmowN=5Qni-h-ZRgjNZ-hnPm_5s|zL6%Lynnij(&pb{3%pij*6?8q>41m;22JlhInsK5)GJu!-7V9Q;1Y7CQa@f_b)E!D11!-2L<=m{!9rM& zf(wMypMtwd(mz2;3$DaafmQ*jsWy4bO*32sF;}4moN@+Y2Atvp+zd1c%cKT$!fwd{ z%?~yUQy}x7A*wzfsESHP87OpdLHUcia*$OlR~1Ji$+DadP=$_Cvc@8$0Xp{b&&huyH}Ot_gvzpzx8TWs^ChTK5Bv9RP^ zL9mL3egO;q*23+it=bnRxl74ZMXImLA)D12Z4uv{0hB@C@t9=IyC@^z@E2cXG!LUY zGar`2tGi&4iUARz6yrkDC;GT1jEil8T1?}Ki32fYMuCe8xz`JkOFW^T!ix0|4tyV2 zISL@*N`tRScp!lfv(I*;($L}DHP}=ZTJ%F4m}W(K6HQNc3@&3~9t(iM76eO5AbJA9 z6sW-uOA?I&okc=JzQ!SC# zwC80+-;zAdek*El9-Y^Xgi2GS`IHQ9yfRMzVY8iEu^Ot~wu;5cpe~vn?{G+Ii zINI5Xb`q<26bJaGFzq2c%IVp6yZ&;#Q@YuFgCjz;bJjMC+*$T%91D0C0w>)C-R$On zVZV(vxV7ebuC5L@v!C%l(Trc%1si<@dJOLO9-g4z_*n1O3O^v0UB&;h)$=W-Pm7!L z!>fNxZXJ6M>kZ|2X~bu|#oj%y->)lZQ6eRyMz1|8ul~CX@bu1VE5m8taN+0PzFRS+ zdZWe1by#=#aryExc+J03KJ)zheU}(>UaS%EeB8`qxN!Of>a7z(L;q+l^hdF)?)qi7b4uXQFaU#MbFx7V^Y?tC!%Rd8nhS9Nyzb}6- zm(u458R`b->t?$8{&sJ74}iX1J)VqR9ek>HKcGbJe_Z;Vp77gDz|M@Nw7qb~8y*BQ zdg?h`yZ(M1+Y9LN7JTAZ_TT5h)S?KKUGopI3+x&FMokA+^Czys-8>b!B6GdmN-urs z4Y=fa+kZXrE^O1k2~kL%|6Xj1|8D!%n#`+2Oo1{5J(IhtvFc&pS#(?b#!u<$zFlMH zW%p7UgNw7P^wa-Gz2Y@BB}MQ%%$^N>2?*!7*g7kHX$`n+wGkD3x}Hv#KKH-S#@Iab z6uLZ`*3EzOazFj|=)Nbtv`wG2-6NIH7p03zU2lSL^0S8{;mOv__o=N>2W33oM%g=m zZWkVtWV^8zhdbGuM-htc1!6+>;Tl43`zO1`2hYBzBG{W~yo3)ZpUCfdmtu$H*zzY? zMz>184Z&xYJPeuqzi$6;QsEWgpuq5JoyL*(?R_s(O?pjR9DmQ+^#Hi{g zS8MxnFa6NK?YR`bc)?5Lo`t1<<3sb$G^e3;{;Oh7?0uWS!`Ah*B1ayF%X)0*e4rRN z(Yw>-yZN{O(?&<#(mBUbA;Zi3KNV@SO3275_xdiVdk>TtBwNMX2K@TS4R_Qnd~n;Y z$cgDwum+i;YE1zr{vx6DX(RB5QxA)BLwsgxi)CGYqAbPUWa=&AneNL z96b_JEvurL1=ox7h%CHrkCN`?tpSc~Eh4&CtSrc5+!00N*q5h!UE+>8I?wvL1ZY8ssX5&|Cqz9j zp%gF(=yLuYiq%5nUcOlWAoHF*YfVfWeZn7S-z7Df@(1?-3#Q{gbBu&i@i+h5d;hO( zimIE5>whw*|D;dM|Im;B-$aR>mGgg;QB$>`wa_$MYg-Ge#fDo*%qk%?x0!JkunvPz zIMF=N(jkO}G=PQCHrj5N;2Y~2r#2&~*rFgJC^7&hCVCbq>=rSja%4#h=hV&v$o+ zCBxplKSQ*)Zu4yUZGL<|tyb%{HfGuk@b=LUySDh}H#hjF$7uWcWBl*ic9EL5)@bP# zH(%)U>+AP9EoWmQA~FsLka$R`hCgp6mVT4^4*C9G^9l714e{~P;ROc|)2?$uyl*6^ z_a5yR94q*>|7~nQygDnKXFwddyg6_>4L53kZ(`r#+Y?E9H2bd0BnQMAgFO&qCc#{c zo#z#aJ*35=F+DY{Wr4?mKYLn3t1KSj*J!fmg!IGUZGmSBtx-n^Mx}D(_jD>AFILuVaqR}d{ z$_=(HBWiYM&XE7(^{1|U@2)7C% z2!Y4g6@7H#xsS8g*tWamQr8zAzWeuB+RrcAh}eDXd}Pd98#n97m@PdT+%q-+EJMsh z8ZTj(S~YOkh;G!H`LaRC(EZ*YDT`1UL&dEEiV322@Z|Sw(AXNwR3WfH6ixk{dnl(d ze8PIg5HPTwn3$s;m7^LW)-ao>Ze>grbL!ENKw6!8aDKffdg74(K0<{I+E^j&k($7o zp+X8xtNJTybDLnW#wCnbY${m+wt+-7Lhv<+P9bbuS~Sno(GGg$K_r8+6Lcg35;$IF zCBXjeg)y{)>hI+eg6D8y=JVNbQig&yyIm7;RZ(x{bqr9=kNM9<`K)VcI`C_~U1Bi` z9tW>?g%nU^eM~eYyO=ZNh*#2ThAO3Uf8yBP;rS}X1|}C&?t(-dxM#W~D%M#msx4G8 zTsXRweQenEpm)WQ4u}o^HYn(h<%|8GG1uQI2On@Q%s>2@+TZfe;e-R}+wxX@R!K%MdKvdk{ysjU2%3oB*03>YGmnCXaA!xTo z5GgRD5k-SUwI#&gw3Ek&EIA{uSY;8>=;~QdNW}kI+)%~6Kh|`r?!jtEGNWo%_`}LZ z$CTtvc|yrqm?J3jQL!8!UGM^zo&}4n2vWy$28fzdj^G+19ONp(L@GjF4`gKhq|dA> z_Tz*MVhRdz4wF3aHZi(@SA%tLUk=6es~FJRu_AaY$n36x|25e;3zg4IPS66ZKeNJc z%KA>Aj>efz2(;l*J*-X^Z4bPdo8pNwJ8 zh!zDP&RA!e-HaD=#w8u0d{H72miehY8hF`^O~e<1WvS4LcB>$O3p1VR1r{}u2Yydvrm`I+X}IERA3T5Y%H_SyA10lLYe(Z#L}1Q>Y#l=VX{*P zxHQ&coLN}sVX26WM%Dx`cnY!=nb5u*U7zK z@0tJM4a>Nj6fG)_`mD?6QTEFY;m)RG~hU)br0UM9;nWy`{*Ku$IHwaYJ63EhzL|gGAe0g>)#IZLt-V!(y)>; zsd3~=6}%<=kj=|0iFMQ0U`()+GV@@C^xaTKZIjGHlm^z^S{1f)?}Cm4LM8DwdD990 z2c&pBD`xU=bPT`pidm0mE#rg(u+5f$A zCttT2e83sO<{pU)SYxE`pecB*QGN=yt^VnS6a?*r*&p=yyCU4^;ArS3mzKNi5Otj= zw-GEyS?XFkQN-YD(q`nAnm@hmz1+UwB{!HD-1b~u-OkKfiC`?jazs86kO~yZ%CQRL zMc`TJlvc$lPDqeh>z*vJ_qrAXG8ulZL*)4ueUHCDzLY$Bz6VdTd$=tRDE5_Jc^Xre zMl6^99MTABO4ECaB({fpa}!8L)~PUN2Ru3pMB^@`dG}!sO|aof=%oywq%(J~2dl38 zIIg@7r|HBe*$H_P1sAuz*}iTx_} z>9r26+K&|D#fMI6{C3f#i*m`QX*WXNq;}*v*Tg`{vrz{#$+7yYxSSKtQ6-?7l}4}T zNdN6e?8$*{yL#6Dx<|NPT(MFJqTsp{?y{IuKe+jLUHn^L7Q&TIdYxT;J)(t6A+V{? zS{fKz#!c&MdV#DRdpHpk+cOtL-w==BxQ~fSWMy@~%>w*4Ghv-bHZ)y`==^O$1mG{1 zN0d`5`0N_LVz@sP06{UTF7Nh(F>qAqrLSDg3%r-k_QLwfN01G^oo}34MdypI{5Fqc zUwPv9V!flYU?~rvJG9 zt1h_AF`IELRxWz%)`-VtqeHC$F~aeDRqutU{AH2)25j@-au)5NV2znCL!=X4?3qMG z5YHH0?$k=s>w1R{e!T{GDHW?CWlQW2twclbWGpBufcyer zCU2eq&aAbTI443uvi}NQA0%&xmwr_|Sb<)T;TUV1x=I zm%0BcC}<;!kthwSDO)OLY2gsB4*b^ptB12uXPWgH#))m?On!pphyI2iFCf+*Nfr{K zf|V=Q9m%PKiVIgJxC#i~1-YQqd`qqG+`aN^yP60Hzj7tpwR>;AxooMjZ->WJZ{bz^ zJ>?Q6ZG_9~P>qUt*rj|z)N);e<<}0Zc>YfvT?GWxRw7$j`H)%qf>!>+=AK}U_l3a; z<3k?OS<2^zx~4GSKy4M;eVH4thzlH^`Q-D`ml}<+T#x|2H&?)e?WF&k^iEjVNkpgl z4-f!_ePKfPdnow4UA{Z%J^>d!bve~Dn90?9Gv$vN6Nj=iAfIE;yx0OkTS)nzhtT|3 zUXtGvP@Q0cX<2(#8@*x=1h`&!ZcC_E7P^d@=W6!NB8@D3NCiDEp}o4sMbN(Wy_Zl)GeWz)9TDH z&zFag9$$V{jS)tJ%#y|P37bUud=q3O4Hu*@MyA8&bi!vQjiY}10~y41CrD(1AxoE^ zDBKR3d$*X$qJq=*VD2Xh*C>!L5H>fiIM)HJ*C2dQ=N=MLP%6Q0%boKpYyEgAZMbJI z{4Lt4Y!4gF|FUxb#1fX+bqo~4CICALKe2`yq?%+r@S0_oYrK>I^)+ghkH^SU!M{@> z-@=WK9^X2Um*TwBJ*COZImabjIh#)uPA+0^9By%>IB7iaXOEKn3mHGoa z>FHcK*5#>DBBeN7EMI+nLQwAya>ItubkfZZE=l#3^;8x(l{B9>lV-lY^ac5=RrH$g ziG7;M&b7XneYoDRLt!(?u6d@0Xh6i9;||^iO39PnypFTk~kyDA_0(UXJ{D zesNj_Pxo|`J%Hqqz2mu{n1FyVB~Rz!;svklcC!*Z97z7cN0h$d?>` zJ%va;Yn5cKGU-)0MbA5_imTw@_in8SRD?i@WV~cgBF}fZO$v@*O9~z~PH=G(*BX?x z7ex{^((bHmbH)dU@K2d@m$Su6ml22B$T z(4U0d>z^e376rA1^~k13cI;PA1|8}-QJ)EE{ z=O-G|4jN-w-v`W&BN7Ru>gdc?&3Blhr=Ov2CKf5nD< zS<(I$j5K>=AHk=wtG2#+xYM~DH{Jt9Dff2s<&SD@?I22CGs3;N5Pc2kUnAVL?LU{$ z{>F#%OLLNpV?2=gx$cF1+80+1_^H!Ookw0rOIFoY%QW~cD_^$EnFY(p<#??nEUj&B z7Ti?;5`TX$6)&Uc4RjV!|8Qe2b3gY0c;@#cT7>KtR&OZ3RstlsVEsPR`{!j@{V>yY zw}ZBy?bbruX=SH&5(XaeEijJ{Jj8`|GsfS!pcPa3qPxXf7I8=;wU25*FT9 zm#*345dB~sOh--&cy{}TuvaOMTPo?hY+!j~VhO0i!vfwtk3rE8&M0>ZX@QtQx$Lm7u z-9KFL;W5u$Iln@d(ZZ*?g68VI;5L#-pp%}T$vq0IgaU(IaB=lEQXXZ zkr}c4h_1QsHDeaFi1fN?`SQ(6^)?VM+NY1c-j78fr`UAi2XKS0n(ssy)Xx^ zV~~MJMfq|l95ifva%DHFy_(vM18id0jm=!&U?kOayP`qi{25NeR{WJ&K>qLF0c{)7 zwg-wiH#9uZ+haQn&0>^XowX`eLh84B3d%E}KDH9A|db^F78%^m?xA2aweuuf}2CV2vW zB!!`rw`b3pT)2?1;ijmFB4lTUf?DdOjP@7nDn}IE;JpgrJ62W4Ff4cRl^-7MTCz^7 zoeHa8)C3=Do!DCAxK@fNrNzn*)Rhg96P3c^J}gwu5DC;m1}cMEc)fiB9X#6kDG23< zilM)FUt94*U~B6;sVXQd)r$GwXpf8o%=vhz=y^0uyf)AH3rddo;>L>s@RqL^q;cMC z9~QQg+NoU}n6u7=d*Lj=CkYL5m_@O(NeY4z92Ug21?)pOj>eVOglu)9x+mxK#1!WI zM^3?ABBoasHrbOmJ@S{@*}TSU_Rae3#I79<#+qPYA9bO$=!_CDue@{vmWNpZ@MxOu z2ea%5(JEE5ux}CM3Vq`Aak;MK_Z>>moc)g3OTCr-BYp6g-a*KOWa*K7=H$>t;Q87a zd2Y~LpjR~-!IJejtFm$>oqXJh3PST_V~GP~V@dbx0B?gL+9@I~NBryJY=(yR<^Z!7 zV14J%Vb4a_jZ)V}5BTx2VLPgP?VPmtKr&t>eE400g;5vuY(Ipe*hbaE(Ij8lL6fG7 z&&7!)@F4w_`qbMCizSpevGTEU@{$o3D6CYhDB`q|7PKhMNm6vs(9TV!hs`l^KPkz^@DSwU8esM= z&YIy=h#*W@T{k=V0H;rd=D1_*tP6?=_`~-0cWxMDWXh?8nz?~wBu-Y;^X;Exn9EeB* zn^d)ik0Tj2+N;?p6@}f+8X;Iy;H{=PI3=}1-<1ZYhkKWO>sPl$@K`i@}6kd>ABf0VP6k8g|WTFxv#bqFsB zG6J~#@2cn4Yy)84wodfGn3LyKhTm%gLmxY)t3SDf4XfOZqz{=-^KA#5SUg(SCkq2H zmwRKtmMUp=^%^IsSLCk@&xPea^{UPDf4Pq(QGy*-G~l5U<9%lNDrE)OV8&G`fWtwicmHE$87JsyX`2 z-9%_S$=WUEQ13QrhWK#lXPu>(%No?${|( zeoU()5LDn|-T=Qcq}oKKdk01noDce2fIAoY_SzXBq>OR$J)Y>jtjV?OE6L?Ag{lz1<#ZIvShJG$%+z0>}=xjJR=3M{YeTm(OO|bRTSYTCzQR>jbxRae8Ue zzr{PeIK9FX`MGasdGy#g#XvFU^$oL>lInkIFdZ5k9Oe3ih<`x*lfiD%Y`5Nuq`0+W zKVUDswWDW;`SuyQ?tgH7WwBNHm@#|A7qIth9;uCJ>*S}_Uf5qu(}{7RfS~wuw#33k z0hBsAFNN{Mav}OsB2;;YT2@AG0ZsI|z+0uKLLdcwCEYvxQc_zLrAlx_&9W%7D0wHEE_cNA-2O?XGtD?d0^+s) zlDTuNmEhGU?m~Ol#<=cqx7ug#qN#n(yc(!FsyEFK^M(II!M_jq8>R+Qhf=#ucKb8> z6Z5HW%zyUh>(=tl|8=+XwW@S=@y^!uj?pjR@2>~Y7|8G!V|bp#|*3X=lePdt=M~9C%Y2+<=@JC zF$4nMr{^o(lTm#j7Q2fvDzO-Ib40JKi1yKM>|aV43l`g`%!j<6uQvxz35f5~PLmN@ zP$nWUgEUot;LV@&c(2=2_s`RQKiSmF!UI{bS*)7MgpIKJ`uC>;Ai3!deb04nh;t`g zg?8qBDl!eo!ueTTp*#9Ib}M$ut8F(S<&Qtyz2kVg48m;YT`;s45$jrfXYhYbI?^-Y z@TlNp!2T4>L#UHgm=FUWV#zIO`0AE}3v?m*mG1)Ne`~o1Okht4yXIyzaPqrX!=?ZD z=zAi^)}R)#9TTog)mF1xM*xRq*i-wvR$q{5!aqNRCDd4l3W_lsoHUG-mV&R0tu;?$ z2m9FdV{8W)UE821E)w0T%^$@a6EhNDey_xSceh=Yut9a{ zr+|H`+!QH8jyJ6in)><*3jY3@463f0oUG!aH5i$aX)SIQo~yA@zEe5^KOlNX^_$)^ zQ3Shl`V#{M1xE*0aR!%=o|;y+V%0(x<%U$866mqmZ9a8$C{V40qps+10#nz!DN;r2pbnv(%HL~Yj52&p3m+a@t%rBo3MqLMS5htXh zN@8I#!KXv#j61C4bv+MWd>xD|=JJDl_67d&p*(-i@t5@>yy_i%w$^STldleZ0PN+Z z0QSYWmVg+=h)^@7t??$5#&){-QZqAF3V%4FQ1>kq-kK<$`zS}MiSr>(P>w_iiN-wu0<-#y>QRQ>a1zr-2FOQdzU>f zcZFpRFF*61WhJ+9Y0OKvmn}GX$jT#gFanw-YlQk6q#{Xkk%a-FT$$R4P1ch(jBU5B2_{wD90 z#htox;kecoptTioftei(YN{R}VHMn3e10m9|GL|$ZJOs^cUrpF`~3ZaKNnY~lD`7~ zSx4O0!`0qa2yRoT1+Pi_RJ(DwD!(qh7Mb5+L3=tJ+figW_U)atz*LPaIBp-wTloS%cXg7$<#eJ1 z^j|C-(8M_$guO8srj+y9$DP41dEaeNs$fc0h(XaSqDlR+{m~S`t|2^IdGq4;238yN zCuvkttjIWS{atcOkT27M#TbzvT3)TK0ri@uOLGm+f zmR6~#d#gh*fp5Hbu#9V1h*|6lTb4+ZZv1Nq1sn2_Oh=tdex4xlH=BASR_*PO>+)&P7{ zEIgb7ZA843>A}CXhAU%(`tCOs0#cCzp3k4si_`e=x3B+f>VqdFr==DyNw?_8$H1k1 z1RMbBloD=huU*w=5e12|nnY;hw9Sf1kgG&!*G=02=sO$OboTt1h3w(GI=6<00U-g3 z!;Hie*;%yhZM0sdLfCatV*!6%YT39o?tz!IxBd{3%jS~<;aS_J_X>S z9?1MbpM%x)&(qk4qcyVMUuE8fO|l#;zt^68JKg9i%SYq|3P1Qv+7V=Cw^U^uLWFzi zKhxIKvWj}s_6NBga^ixwWI@0zHo#<+SAw-9i3+#e7_ilX$R7}SSE2BJvNnW7DoGaD zGuo9mq1+FGy0N*NOABNO(d~65N%%Mv#T_@WJCTzVxG9Xno%8yPxO!^)SE%P$PTake zkJmKk91pQ$D72jOXV)e44a2(w&xCqQlD&Q`2jCql;DwEGNb&u^v<{}Zj4IUgLVXN& z=A8bCa8_hcj^LNSSPRFE19ov(d$MAAb3KY-pL)Q#CQqH3STU0L6H`8t3aB+t;M(Av zU>4w^c47{3w9y=fV#WNOY{*r%q`!MW`mFukHnMdp( z%Bc_)A!^Fuqc%%$jFk2q?oP@oRg%qcf~*^9=!{j@NgM;|FJ8zaz1g|PhDA+M;0Oyy ziJ0SMA#(-D>AMOJ?$rUHOKC9?ARf82wq|6E{iqsXypUa;koJKc^&d*dPCXKJ6A)#s z^J*FxR)3-%78C<0J!B}pV#ISw zOo`hapthz94Bkk(;CvOS{*b;5pi`MJtnu~ACiydFq+@mrL9Byi8=IDd-$l_+5bGbP z4hHy597bG}f079N3YfKkDQycGkYR2GajR|2fJX5-s7a$}=p}kovsdumG#@8d>Wny1 zW~~>mSo7rThn?CN1<4)S?Ww1XwkbW3{Z7XYSC#qaFfXuyUVQE#sZ8APVKi>9*2{Zb za7>&v=wRHYM(ZI&{J644fA+6&Q7}Gur8ZmBlVud}(iH}3S8}qG@94T+f8jFfh*anT zXqbz$fnpJ7Nh+`YqSzX6w3ts8pG!DVTnjiWFz6ktA@3%mv9UsBoz4{Zv(yN?dkkf? zJ@sw%-#qrBtaEYvefl)xr~k3M*QY#*h`wEaEa2QD3nCdZ+px(9jtOn!2F#nW zgRLHVy8ks#wFkB)9^SS~cC!ZqFSa`jJ05Z2K;dX(q#BYuq!Er}`4%(q?T;rc0X%VM zDC{D8!3@#I8XX%%zwbg*1dI@*)bNtZriQnjsVj-6(p580JjQE|ZEIX+kIS8S^}Bxj zuX*B0%}>kZ;ndFGmOt*RzE7Esl$jetu}Ow|{!Pcip5YPXU{0rt+|rQ_-j5!dNUEj1 z^)GJWQsh5t)=MoLoiVN~#puMi#*P%Kk7GqIUgt2M-U7F8?=v}5e?!(9>cTJL`ueav zYCH)8RSKG3dzp0zI}HE$MqV7aK}$GEje#`!d)C%=4=Sl3(oZv|%X)&9r7`L?*07Z| zH;yayj$xZ{Jr@I6D(JMI?VMgi!XCGPYn& z#8!kO=W^tr_$PBoE^DWFU?@`{2PA_TRZ8FviboYgMXQxKaJLA|p=T5pj~Ut6elKN| zHxAYJRdtfv`02hW82L~8eDFq%G$q34#iSo5dXntMXp$hziM%v&aOL{*^zp$z*9L=7 z&_YW+kZi%2pQ5HS4-ldrwt@9Uj~0iHBftw27FC{uvf+9RMKwqtVfu*J^x6&>V2}u5 zH|;oWK!{^8J!))=kdX2CUv>Y6c#&M$Itfd5#uCm+5|X);VC`EsQeF~}97eP^9Hls` zS}Oikk0kC4=YH`fjngnd?p+i1RHt&opx@IWuTRP}5G!2fjD6mst+QkBl!q4hhV+wx z1OO+->vcyG$}sKu(OvJb`KLVfJH9|uNUpOxZ9qaGT0HHoksJYCx5a@7CWpC5qKQ38 zUvi9K)=zFzA89XE9H&zwy*FO;E`o5?uhIUZj9QDVE4^QUPQV9;fvIiGVCc>nf5&%n zINjA5QCkw5-b=!JfR153oRCU_!{hEtAEK>Xf4B(Gg8L_MqNdLpQ^&gWEl?DbyG3_(v zc(jv6X(|r2&evqcUN+>GwYW!LWG!PJDT!XNdCrLUrPp0= zf|hoI%@rFb`%aiY5|h!J?Ra$};S}TBWtDb8^{_|6DOq__cA;kkK$dY0!z3xD+mbCZ z0}X*@b}D%7dPeENcSW}FwWDfl4@ic!s>n(EDpO*xUrlNT6Cy*91WCnf@EZA9#eXS(TJHFfn3|5LbSf_Ijq>m>OCHXD%br<^U!GlCFiD9w2`Kz)cK*^)iF z>qXLzeDM6lh;$`wQh6R*_NC+x6OB>Gjg1|yQ)g{A?OHI23&N){#1Z(zVYMhi1YC4@ zgqnPhy-gv0_5(>YTRfq*4NpHxZUvp$5W@4`DS}mL?BVBRNLG5Gd75)p)#_vx_yC-UEU#hXx4(NFu2Z7=yO5Wb*JT zPRiGy7FoDKT@S&F<;baEn<|&dL4=U+EmJF95#m}>{=%$6U#y(ak&g-@+<8#S!Y*Ga z0ZoSdrvm%~q!0X=m*jZAY^&nqWw!_ow4gX3AhgPyjggm}(xyn=MpSwGrnY<=cH1-# z9Z!<#18oo?IGTK~kreu`|EU>>UbuK(?706R`%Tgv&Ht}tO1Sg9 zllkx8)l#=~lI0=ZzK}OQG$O|5bkP=3$_`@seqU4fgb$D`UtjrIvxZ`EFzAgH&D9)x z$i^dLs)sPRIcbeqq#4$iKGQ5rd2iG{=J7g#WM!gMu`=^&sBHW~S ztLB}c7%1ft9D>E@fpD-z7{P-;J4yz;fP$_$QUY$RIxD~yqlNCOPqodX6xc^97hmF)C5s2E%O1 z99jsV*KJbMREN4QIv=;cL^dlb5(`!>DzPlV!|4HQm2h%hE|{L|#UbWdo**hpeT?<2 z-ATg)hWNt`6BOZEjB_lIOO{!QawG7s% ztK&D@b>BQf$W-^ydk1$*mYy9t8d)pDg1WsmIxSBv;D*O|rbuyuG|v#bG2JY0z?Z^{ z6NT=W6it4#S)if{avoPnrxHdWh68rT9fmvA1IzmYd%5-7oJiI`A4q5u9d|w~=`KpK z)dxpQW(xGJICe)^ zaC{XeM!AAdfR=~jQCu4&AnxL4%U;>ys@MtY8$D%LQ}ZL` zJAG2_0)Y5wUVwy-*kvUNseqxX!?b`f-mEi>xOXcgN@hjQmR(Y1gv_YJ_S-e7uALg9 z9{t%?avg)U^7gEv!GsY`&&nFp>KVUC(tIM(dNM&u)O2;#)F4Ij>a`|}t=n5<@CsPM z>L$WNs}dt|FdNgL&Kn-HR#~=6uvYbho8&#ACnMszXob0o7lA(Z#1c$5(H_I&%S=Z# z$w&BTtL=fJp5VS6?=9A^Qk)+<17RlRC&!dOQY{5|OX{piXV*4OUw!DV_Ua4=4EIf; zAk>d&H5H%6&BN=nzg!Zf&+IR*z{eJXm3p@DNXLzMmZ3EPYIO2*fT=mi#9=+4+r6t! zgRA3YD5clMsg@q`6>|O67uxyturt>yNdeG3FT?c|36XAbr7hW})h z0@Hus@4YVePJ`~5u*cCGWWe*nWJ^4mH}g}(x3jHPO=LEfpbzvM-FA!ID5j#%9f(8? zkRrAp6ji!^YEsEU@=7PIQwm#}(c_IE|CVnY{*E+M=zO|;3H+Vln=p$;B^7X|MVjVu zs>;*&yEm#VNe_?lw*I1D+Ie26NZyPl#j(4o9SM7UJSW2Zfbi&~1WgVdR!nE_$;34o z{Bna#1Y2v4Bi5Js!x;5ve-5DInLol$7_vDCw_0);UbKrD5`3&^c6hV?XB-BR0nX$Q z9VS-CQ+=|6m{A;p{bDbdC-d=-w!5=Tqwl5dwu^Y?P;F;Xl=DI8YJkU)VC80X1y2Ki z;0R$m-eU{o}W-?!337S(zXl&j>QLrICZ`g8&7z zym|OS@tK{=dUMMy5u{B)#9c z18Wk;1P?(5poW9A&V-PZJArVq@c|?<)}Ze@NQ(^n0V;Z8To5(qx|jrupTTHBBTEh6 z&RzH@k&$)M2yq!Qts~W8r7o;yzt-U3tbS)~#)h8jm!!5MD5@%m_dk`S-znKjH{TG+ z&v93P?{BOFY)8c7u_Ed<9R#OLM;X<#2KCbWP%Vmjs^5*DuY`>n|hzg zx--Xynd@d<%%LtJj*~&Y?fqZ_U5kFM@TS(G?+PIj1Zva0n{%N|3&8uhXINvYE#mVo zApu)^mE2i`D^U(~{@KqBoT)0FhlB4#RrisZ=Cwf-#cvkN#?QExQi4?^<*9k07j}tV zOKg_)*6F{#Q(i$hW&HH*7WAD=!MGwv&WJP~)szCB8*odZWNK))1{sPv zFt0Z8;-&r5i;14Fd7%l?CksS$lN~0l3#Qu}6F^Es z!zBJ%s53Jm&gS)y1&39H6)b+>KUa#2h=cV=)XJra;-O~ZY9^@X80cVW9?2{&D<5>P zbgXJCQVcP}VoWCm7B9>+^K*q_#;C+;fj4^I0uLueP~^|ctB7BG~# ziJo*$s^5cy1)`E!^{BRH2ex}q2~7Dn7d$7xz1-Ta*I33yI~3kBdEI=)lA7t~8@Z1D z`?uXOI&#qq?f04(1FM!=FKH&XmU(x5W$I&oZnhJb{vXEPu}QS3TeCcA+qP|fH72rTj-CExkQR?_u`xD0q@+cJ+Ge+ObKA8j^9wI8<12zGfHu*EIkSG zg@3E4Dl0D%>ebTM$rC>_25yWj10+7Z1%Lp7qWq5~6vbgE5=QG9>vu(Y+8lLLKdfg{ zvIrb&I_nxOs^@zA@`G5Y?5Jq%%rZ{Qefp`nsFTMdApp28mJ*j%P?**=vg{ zCznX59l+-Ax`0d036zVZW{FgYPqZVcW0Y!WI*|zEz9_7^Nkp1YI; zNZ9TUqEL&VRdmtrw#Oocze4|xdfWBJuLdM>Kex&k5j?&U{kMZRy%8pAY2A(<{U~L$kae=b^$B}anj|$M0=wLs4`i*W~5Buw@XOI9vk-l z62sK8c^(_1XGyBEPY|neaqF%%32u~7)tX)H-)OhY<}sZumZdcB^qvI};q6^Bjt{2q zUZSH)bm;L!2Aowa11VScW&KzXwhVdm++kWzwDO?B|=EpzKMYN`7JX&0QRpPKukaX-fl#fDUNJ+$clZ~jhl;;1C z527&YJ%n`-zECT?*Fc^!WOeJ9IxO)Uoxjbj(2|z;q$(i4B8(`{TS7&<2umy2-?hbcZ^N#|T!B7;MpSlLi*(pSS5)2hiWJm^Kz-zoCqeQ+Qk`$R32b|JOg@ou6b)RSbM)HUMC&=wgN1^mI93C?OfS5&uOR$)C?6 z{sh0QsY292Oo=DB_7=c>Lr36+*fL;}gmTSBh|mpNmqkMC5=Nsy?gf>00Vi;Tuqame zCYXuazb+Gr-x$Z4#L5qggVK%8<|OVDzM!J!1)+%0!dv)=W2X6iS5WP73F!$W^!K#( z!UG?PzIj|$^ZbrB+4!_cVNg$wbHPwAE0$3RyI_!VWTP>I=?i;hBI$()Wm3XK=wZyf z)1c0EwYsTIpyYC11QP*tSz^utg%>?KLlo^m~TuUSw#xK)F*SUoXh|jA059Re|iTj`&;M^ z)UBKu1ZPVwV${Qf$lukEM;tK~GxiS9G;kBa;jRQRu;BwxO%%h(wMP)sBjNd zJsNIWK2#*1Ujdp^ucS90Dbt)Y5?Bg8iMJayF{&*2JZ-%U7Gd0Pk_U(j2srump;k7F zI*mk#NIS0(ErDx`DVyrsv7&D63WiJChP{RZ@82s{uLHUr&4YVtm*H<$QG^j2v+5Me z#C(8T7O4eAO;9^S@>h2OM6}ad6Y07;_1-e~Aw^%-#gUGVxKS7guDsHzK??l9(lM4A zq38Qiz|nz2Kt(?}o87UGWd|G=8jA)qph$W7779l~WD`%_d4CJCGHKeuCT4;oVDreP z9T*K@|I0yUi)%8BQ;V|Xd?yCS(<9y(Dne48a~8l>h2Kx}^R#gtilUc@4892*V}|Tf z7^0E~wY-!ISx})X;F9eLL+lPil=;RGmI=Xpa}OS)W9WZC2xXe0O-OlLSiWHnFgLPV}cob-{qNU+-YMa+;$r~OvF%#8(^LXu2@Hn@_w64rxOi7 z7c4HLvah~V!1eX7v5$N&0ky#D@L!GC_is5MMKZV$W>{>0V3tKFzH8t%P{WbaJ zjcVb+iS%m^kwjLB;_6Zfm#f+Bft#(fs;ie(>erW5te-xzyiad_d>0U>UK4<9k;dE=kQ|LqQaJ3q|EfWYQT8_`gM?^Q$uwM=#5d zjhIB!saL&#gCy}p6ZV;hmpBjG9n{@6tIVm%LEp@%tXGa2*v;!Jf=D|r%al|pROW{* z*CU6wA?t4fB%tD7xJAw``AdpBN6kI>U0jI!rJWWwI=-V;&-Bh<{lC-j>|Rvhcd+0I z?xL7UKvy?0ps?nGJx%foG-F|PMOI|#aEg#~>8Jd6g|D*jBpMb!Ofi^(OLB-O&|!tZ za)PA4M||DlFvTJAKLzX&rP$?ri{KW-ED@N}(fK0^w(_=$2W5AQz~?v?gio|A;TclW z`6a(mt$$@N<#1(Zi_jLNPXsKH?_n9z|2uf~|HiJorMv|=u?8ZzDz)p;rk zm1RpwP|YD4lGTOFidbdQi=-Az&A|@Eo8+xJNnz}DF%@XmSHmxyM#)xB?ahHtGMPTC zmR9#xF{@tE8}pi{B6pelA|~{SE1p_6r`vSzL(d$Wt-3qX-jVO$i?*7*E#DU(nO3G7 zCa|Ym_y+ha^!B^O{DNQ@pnvNp>ptklRmSVtwA8U&e)Kl_eFEv=AkgnSzeqm>pJ%a0 zxGwF=T-zQ?wlYx!!JxNz9*^t72b+E%-&bNcwQ9nBV^cX`9jBbTIK0Mhfrz%T?cIuu zj5fz^M8riQ3Xw#9=tn%I-dFt%2d(zTwFBw3=md0RtLBXJlm8y&AmH8PG^7CCNPXI5 zRF2@d6t!ChRObD8=JRk_?`is%F`4l%BN4-N7x`a~tu~SdDmpqQCb}A`hN7a1%HUeT z#%bBOcVi&|HlV@3Ey%jeZjpFg6`>cpvXdU=Lu6Yu(sA+~tG+ZYFL{rw_L(0B>IE7zJ zHRR@w&!S~-w)Ci*f2u0c;e+lRf?L$I$Rt|syu90=BEO7q@+fAzr#PL=6x}GRD_`F& z5KuS~-iBURYQ~6`Y#VmlE_<~0O>35%m5uDqrlKp)16#Hft%OfwK2bTE5BEoYRW-N^ zZ8o}ajRH~sGjTgpY2x}1=)+8nt0#5fX(+O1AlHAPbG&Pe_cF3Y9XF2t$D-@!Q z1ti`+6f@XQnAjQ<;vZ+oEBG4;jv8tmywo^sp!p~%G!^TzG28uJ%T&uYS=xWZv>_6{ zym2D-xCWb49^=?)U<4Xc`RYDXC>P4@mM?t}>@HTimb8Xk-6+v!!sXRwMwMmt#mz?` zZ>A*FZX99LW73mB)FndsiH-zu=sDPdmERghxrn6_Awr~G>=j9sepLxk+@Rh+V4j92 zZ!lOcHEC?M=EHXf(kHfdH#A0u1C?+%l+`n{bTAH%P;e1@cbI#qo|dAMCDFK4C%IR;u)60m}X3UJ;sZPRN(Qu|#)oAtGP# zn-ZXO!Ut-@;!hM~CNs*)$yYKT#5sX};IlB57#uAojRg|kkjBPbj0esHTq_==RQ~qS zoodsA^~_5_TGc0`dkTLOi%`u22qtj9_G+ z330pM4DEGPK#>{N#@~1UbfIhwzPo?uw$#`$eigx#&VZt9`d0_Ri@S8Aoq(J*l=Rix%^<(!U2J5aK#9a8O1oz1-F8 z3J7Jl&dySf1t{#hU%9}-X~n4&zhPV8IOwIu!o8*qR@qBHjVua#8pl8)`p1ikl8c4i zCqN>`n+5+ZQ5hl@A@koP00DfqH``@Vu3Luy#NO{WU7=kS-mF#jt*J1uvc;McRh_fi zZ~lxx;f$eFV;%q`a|6Z{KM^cM>kmeUjU6Hys>KJ4?jt%wzqKG{J8^7DBRgB%;|Jwx z!iXlArp+61QmMCcRFaa=vJhe%!w{A)s@YpJUz}_^U~0W$^wo{kIHQ$;QqQPjR)9lM z6`~m+rqTyx7%=Eph9X}B#3UxHgliCJ)mS6_q11&d&)u2n*bV7UetN?0&rW6RKFy-< zm$38Z@SCPw{!>03V*?W`B&@*veO){J94>F+2TWQ(t}vU-uM*$lM^H^-ge5#GeafUD z0&t2QnG!1^Xh&!D7qvG$`|jS<4g5T~DmRZUo+-53j`bs+={#^-z)-4ptIg-gnj5wE zDC)yY$ch=VWyF*?XS^taHvX8E2o4QaoMD^+_og-yMpd|cPzioaOfn&|O<}e6Z&Rvy zE{8Za3ZTz-vfNN1w4|VH!8B9}rZAapfkxsI+R5r`P?3=wqffHjRDS4VO;r|XkAxPa z@wN^;?%1B&`)9bW4eq9E{m~f7YYP9@$mUQ>+iVra%}rJK62^ox3-%!y+K?#<4u^&> zXd0KUZTiGuK{Qpi)|5S;Ia*xh{I%RhsWtgn(-yHiwOYQX)nraaqg_Tj!w(eo$QP=$ z#-(EUqARURT2f|)j;=3?gWubITPYRXH)L&|+>T!Pgkm$LFaUg?m=9T+(iBd)099@o*G1oI!5x9>e7nS1ma8=e~_QTDko^1?Yy zx{B_AA{rG>c}gri7)k|M9**!Q?1`a8#&yIlS?YexkTT7b#@IPW4^@K}HZ-wNz6MT> znO(RI3{>%XCag~>DKFdhNOqzOlP0dUmgS&D((zvT?A<;Of6ap5U~mo6aIMOqag(e; z7hSC6Fao~it^__26IW}8zAuEo%y_OV?5yjz-Cil)t$!Uc*R7O^i3{poqlyZ4$!+Wo z!`C&TQ8eh+^B;Bl1Yh3lFRJUobikFwOe^5jf8lgeo4o5r}L3=9` z#y9Z*aMB_n9p&XbNpEz3}&y&c}?iSGZhRA}&7F@i`7 zPvg$0%_F}D67$+%iDV9aWN-tDawPoi;E=WO@qFlopmLDZUSV@31`LwX`t7#!U8#cpH5-R+h` zP|b`@Ee6Dths}XW9>st6kU-620Z)O&p;-~%35%~zFau~tr^^7!?BoWBdEw;-C3Xyc zU~p3gX16~_V!hO~XdS=_L|3Wl93}SRCh!%j@G}yd3h{FvG?*+o%|IKDjRP77Jn_~; z=eB;6^&o_ir2V_A!Y~4>W~Xz1e;*}@RcX>}oVVm2K!Ff1pAZsAH@T(xIAU)2-t6rk zWMZG=k~>+NT5CZEX7eVyu7NLD?Wzi}8sPe^ILm8s7gZ$Ry~1wW;N>D`^Mx#)UaoEm zJpw(~(M8FsCi>9PPSc&_Cwb)tzYvglYBpU@WK$J%2Sg^69Q8=mtsf-I?EWqE-{=E^+mtZ*ofgy|Ga{76uc1>r^cq? z`8XA_wpXOdGRi1=xn<<`D*R`$0~wr;h3A;qoXjHH$OCk|X4>P!4IDZWG`csBH-Nl4 zbLn^L?cBb;MLgB+#`7Ud5@*D%FXViP&$)PS2&Ewe+AJ>soSA{DwhuHFI`gj%=GxQv zIQm!@HqSj3KzJ|M4IMWubXWFvbPSaXe-zAhc6k|C02>dY93JiD=mOya2D)T~05Y1- zme>24OBX2gU?P=C@>bd9p#`e-8kfUy_clM7$+V+p-J&F)H)_mDQ;FtPjUdr3GkT|T z@szwtB`XC*jMUV(a^6ACJP8W$_Tlb$>W_ZlcIl+(y4wUqoeCes zPt>w9KMowocsoP7_*s4){xLPYfI5sfMy6F=cY3*8+WZtQZ${ie(|DBL4Z<8>;OWg| z%3Iq9XY_&SyqPqO#T^zf)3DS965YFL`0? zSYU$&S1OZsmfASWjwh0Y9NPZz#rZ*-?ON>)cV~F}L+W%AN=3kp?MUQLItr39MP5Y8 z`=Zr+E!lI!YDeH~D*indjK~z6HJnQ@A2ptAKt80Hm#0Y>7ky$$H{ZeB#*0qV9op_x z%0T*Ayt%w{A9Dcz4*#u0;b{y+a#|HFc-U1#a~PeaYRE$EOdMBq$fjtF8K#FVCT1v( z8?_DZ1muM7&{zowmmcVgPB@qz)k6gNV%TPsORTh6*jb%1cy3{ULcu#fY z>EPj}K^252rT7L|zxYuNwA63$|nabM(Sid0HcV*rLI>$mN zG^(JRR7sfJ80KD&Y9haf79E-UdV@wM;tj|Nx@Eh~ora$2BrX6ia{KN1MbnE&E9s0r z8MQpR{QP(Q$d!bH20C63XFmXnIMflM4g#=(k&%fp|8;4z`SD>|cHJiTJN|;PvU(VDseo6V8K8ajk|FLX06avN zh3@1;S9%@Mb6){VNrUv7UPM9*^LH%Zh~)a%U)f0ZSm`Mc5A+58L|Q1;FrN5mwb8JC*|2O^i2t({i$g=_vG%aHM`_udRgH4JlXCJ~NT zDIQr&eh}EX<-Hg%5N2N)WN9@;E9?PJkM}|@=$PNl={aAR5X1))ozhZ@>V{HT*_Tht z>rF>zMnw~New%ZISys|H*DxGZAwKSw-aO-9hbiDcIS_Em@6`t%l#*X;yma~}bSr!& z9a2GX>Mjk*4sM2z$}8QqXxGd88>bB-`c9bkEmNPCI@Gw1-USA!lat*F(n;!4GCFLL zq@M|8d{?T7G4YQ<4X@jy*)|aMaeWmSWHXf~K8^tm$h9n##0AKI5ZqxnWdSeI>gia(V*yJSUi z5uxcmKa?mCU7Gr&Ifjz|={o%hq2_5ie5L6?KF=elqlOmH$6^okEw7#FCADCqN2B7| z+0Z*~VjnQK@FnGMW@3bo$=cr~G#X7EU7UcP=%O9BbiHS!?76g8zXxY2v}hqcwtuG$iszn?<4r*+abXirhTuqx^JX(!?+u9zS>S2x||uLcY~drwOx;kyL+0r;k{5hVJbvC*5+|uryckAnR z&E;-?frr_(LV_N!DJ&C`bE??_C^`g%-W+R;v|bbMnKEVV$Zal)fM%J(5ONZNwyXV`^qzJyGrJ?)*o9(P}g$B z)I*t%hyBnG*Wu|*y;R<5ghxcsv@K@@0aH1p39@1A33ANpa%NMfe+d#tV5e>jblhr! zTAHT;X=NfmOE+wEO2p9W@kkq{NnPrc77HkPd*HZVC_h$2iO%JG&qP+_J^R{yv@G)3PQ zpax+>hOGx%JS#3Cnb&(Qw^@oa({J_O=tbDYIaqmd1V{`=F%%E2ap z78$*rkTD=MD5~v|*y*J<_KNACfoRfi9_>uRZA@lddWmuCMkyhN>%oD2W8UDneP8(x z=_d=K?5X|rqIqZauBBNIp@3&lsg;xp;yk?x0d{Vbb@n9+1Ox^AIPvkjiXBGY(xGX$ zS+j3_7d=mO&_q6AD?ucfwwH($sv%dtr=;D0ZzB;oz3fPVO8a(9Q=h{S;;_AX+PKQ( zceA(Gb4@W|Fx@C@s1R+#1!62Gp=bALv%ME3D1w9li8c~Lomq8Pk z;re<=N;WP9X-p|QXR}bBhmuKAz4qyF)ePhGxO97n~<`duv}uHd4N^4 zNUlm51^rEsxATH60UbvKTJb&rmL7NGYrzAP4B|3ywYum{4#7oXHEhm~lMX;Gzn zu2K5O^{kuOcRob)jNTL|20SBSCaioOi#W1biQX*XiA++at-M(1MspMPz?fNO?IH2> zM=MU0ExsSM$0t)l9)O|`&Wt2-W*^JIMr=P;Rc+*KE|>G&Nc-DOwC-WoDN*gm=+sPM zZFIo}De{7d1#0+e#vif$0(_Zda@h#j9d5X^7c{N6J2e=@!u*g~{G1iHWJ)T(a{5z? z+E`#!?iWRFE6VGae`ZFZuUoz6uQPr=Yx+Mqv>!j*GadmBc&^=8I>}v?dBs0_a5(~! z8QvCKk*$b~@X@(`ByPKb_HkZzVpa|RS?|BQC#CQM@<>7nz7b`sCnGIsy};%1X14EfTV1N!25FdZ{|;9hdPLo!pt@lSmSluMnQgBzq0Oa0xip^) zNRJKw!f}&Vh<{>)C7R;28?R2w8$)5UxxMus)|G8+E?&oVtU4@et1!|+S85Tqt0QZp zs~8SdjgZZn_>aQd`%WhwEGGvqR&ML-}?GLV>Nlc!kgrCBDahSi_1ss|-z~*XxjBWdS5L}w_1F}4 zJ-&KI;yS!Dst<=|uO7(Meq|{TCA6}my52GTdVsA=f&&> zd+Hn#$A#$aJ@(EY_>{{;fdNm<&^BKg~Sd9E(VkSl**-KjP1*QccqU8stK;tKL zKMDJrH;GJP4hIMSt)mjGL+-T-LOB8UPRK`yLHZL$)9@nPc8_1}{sDLq>goLr&1iJb z+6|M-c5PaeSEtA8X`SRm94U1=dvwE~9HHCtnmN^GrcF92HRcO!_kdx!RzI9JCXTyC z8O7tX8^!XQ%l7O#b^CPHhl(tv6FkQ1WEJtOA7rURwVIIJ=5GhkurFq)$DQs#JgFc@ zpf}qydLhrHe8i(c(5f<)=~UW@*HQlgl-@<#!|LoI44RNm_Dc-BQvk}COPI75yq?*a|kxxGsx1oS5QO|Wc%pl4~ zWL(iH;4y<*Fo$*;dhC@QkH@eA^W68iCs5$$QBT@P!^k@|fx#In9l4ltetH*lZ|DNf zn2Fon?Zy32kOYBo8e&IeP{ZUzCRcpZL@k@FJ6S6s0d2FmV#GP30-JpKknMMpqp%cr zDP{h8jZWtd>8rQAo4F=WsEg^l5;;YXCV(k#VN!7R_uc9p=Y466{opUu+vaHb<15|Y z+MPD=v_I;qqx>cY8$=>sj&%iN>qdDAe!T+X$4APLO1FX zA_2}J5sDot+deX@MJEa6$N01_1T@8mt}s-{P_=^K7DHNLnWi~Tr-71oM@20WWS^G< z(6R%%-42FWZuY_|C}p9gfL4s2 zVroK#0TbQWzt!7Yltmf2Y$h{`nHAUJNG~l`9an|&c%P`aVWn$UtzMBHt~YdVcf5H3 z)^2{%dadAuD>~hVTwBAM1%WT$sdaRH+w)wBgos~L0Zq)?acZ0hB+p5Ke;wsy3lUz8 zMX<~GuKrM-MVXoVMV3nBgG!sQBGV@$kSyelh3#5*wz4_O?$S5Rj$OctH9}n7tb+QC zV?G9GEtE@ZF~DS zt;&f?sjutdGQRy`9^Gg5v>xH%_?H@xIwB^kLM8wPeoP8Akc^zWkQ)VSv4|nzP@Lc! z&4zb4|5@lFki<+2(jPwl*RFp#8koZvO zL=rSzZoMF z$A4qm$n{$c;lp=-pg3+SNJzm-q7m0kBZ6CX6kq%J&5KhqQ;uNYzeJN>=7Tw#c-`D> z8!0=QN5RHq%NXlULg#tcwSA>~&D#w}iH=O9pkX2Lf>PUFAiEIwD}>pMJh>hVUztv~z`QRL*k{NA)w zI<$cxPhjFLlHB-G8QK(=M2k5On#<+5EUd!m`&ZjG;y)c4^Z%bD`5)&Um>K??hsMxI zPhVfp$msCF-r@1-amD2s29}liPk7q<*Y$_;S7YW=DDxm3#t2@66z^f0Z&>5lukxk~ z0XTm4jsMUP0KOcC82us`T@4+BW5S{X20H2q8agWL0g5t`@gI`}GIIh83N#JPv@>!P zG&D5|wxePsVCSJ9mm;-N}vQAGEj$|%A zCp(|k3oF-Dd^EkvJ(41}C%1+hIA7YYt>km7*Sj%0S>nCz2|kX%Z>Glfx5>1h2=phO zuLEmPYd&Psrl|)847sy|9O0prp`jnZE7I3U-rU@5rFXYJzT|*^k`1%Z|I>~C7oz_E z8KKX_{NKE<+6n)U$w2t!8HO*>P#|&BMW#qbUSLcq?PYg^l<#WU9eC_v zw>n763fZ?EIpztosiBYlpT7@rN9~qq?xY-)X;M`EE$_h8P=i^f#_3FR=R2*7s@Pm_ z|9(xxP*c!?&}E8?_UP5}bU_acc`{uxVx>BzWx|KdpeZC&r3`aZmM=@z%P^Lb;#>wB zgoH9h6>bLzDn`ga!{)-~&fBY6%IT%^~>kqBj z-PKKLspADV#EKOj5DYtwKN|uNkP;qV7y*jkJRev9iGTnCqNr6oGim&B?PKfTzYU`W zCJ29cPBD1^C=b|_LIovw_JCwVb*>t(ormgl;Fy!m!k5n3?w44p9I0mw+n?^;0z3 p7&ZPc-hNi%? z?(b)Bu^_WB5bm6A@)BAm0#;5Iw-shbHEl^|ByU6CznBhA<6or((CQxM`)PD8%SIg)$`z@?p8ba)d=O z3uF|b=wHHqSCp(1tv>&hWK=Wi6X(`!6NrL#JM?T zl7>{bShvvsraVDXMrnvw7pN#&mf2a*G{;2b{eMBDC&uPqTZ4xUI0<2ZFCq?B0;LWq zYd9U8x5MetA9X&lzVkoeeUGf~_jS=xVQc-LoL)0_gWzXjgG49MpOSi)Wgnt<{CoVZ zqP3Vv+{f>^h@(Bs&ogZU_Nv!ZT{m3f*RL>0BC>L_uk!0Og=8@~Zl~WL*R?)+%RnEv zQl7Vp?m3@W!#%tE;tS&D0UTm&z&Zqdk(apgJ41BC0>Sjc0U`4#j6ItQBfAJqSkYzg z`%ed=d@4{bEsIHpa!35AigFqM<`+(%aU;rOlWl{^iy2kdko09kNB_ibXW?aqVw?$N zEZLD%g}fzg`_WjKLrg=~-N9~uV|EY<+yA_~ z(fJN7T)!q!2W<}%>mK4i-S6&9x`Is;Lx2& zl^`}!!oj8P19OV8bLic)^*Xx?4J_9V1!$@f^&2)*#(=~m)*q?@(5K~J$n#CNwm$cQ zFv4B3cr2u;Hr)ktJv%H%e9a`5wz$wK!z+$jP2@iAFt7w&Q~Wcf@B_-`;6-E;gRv() zAk_PQC3l>KMr>i#Z&h=vv<)r_qcMq`8h75v2PXx>t=C~W>Mhjx{CPRx`6(5vu=Vk| ztd#@8t&z9YV~W7XaG+wAapd%oh(J2a>xsP`0d;CYn?4sl*(~^7fYi@L8X+bLuPg>` zWP^b~VoUc%ntXu???e^4-r;^Ki%`H|mc z0#sqjIx=7dZ~_Vdx^El7t3?Ng%xZ5Fhi(NfBUtDzoUp-6M)cS?E9U3$mv-Kv$q`MB4WzgFHrQ3)l07f->Tifck%n~%|3Z#h9n~*zbr1SO+vdMXL9e{<`j^(qaXbO z!a7VI`2*?WH>uG|BIaKN+7DAXl1W(W0;?)&I%EKnH8jJ4V!7yqV|!HfYh47os}vM< zqzDHE;z4C0<8k>M-7|*)T-3|+8Fh0YtsqOO`W=hXI^?x%K!L`Tf-3+)%CtuyfjVr1 zk$F3+#^j9rxYIk7v`Jjy(Ug<(#o3DIU+rgxF#7TTaW1jkyVNz^8AFFdZ12X7(=aPV z4Ooz5v}-O~MKd&-Fr|GWlnV%c$B3x*WoF(87vWk+WYaphO=HXhERu?#!Bh1+H9v{y!?sg`Ol zQ4+LTam@Ji8T^4sK93B?lZxt4Ql+i^Lq{K<@|9+Kma3hMf3n?fA2RFDtp){C~} z?9+8K!j*j0*VI!x0ssjf-G3Z)Vqo7VdCq)0PV`#8;yFgs5nU4&T<(29oTAX%lB^*& zsSBMcIN|z-O=DM?{U2j(ua1S3Nu()Y;w4a^%>~QpRX6CCzoJ`ea|E5S!l|jG7I4B9 zaDwG0A`d_B*JGe+(8y0z%MLtLI=NDUc;owK9bxjgkikg0ekVtY-&G_tX6z{!9`>r| z`)T`wT_XQ}JDKS|80v2Qq+w_D5e|;Dr{;s@zc4fodVB4YolQ^Fv|blsYLXBV+P;@P zzJylIV$A4z^ayl)^eZ-a=|{+UoB4|YkNUhzs2)rGc2wwlM8Ibf;V=I$&Ej=LM*?I< z;sMg)cMg@>Sql0fAajPHDeq;ryq7-l)gL_0*y`hu;()iD7Ehp(c@6zGBjumlKU43- zrmgt|I|a$O%zKRvt*5oFaxh=>+FM{UO*x>)Wo*wRAcyC-b+2_%)|&fl zeVl5Iori>H^I14)Uo2ZNHqB(_G(jjc-j-)ObKYVB=*(9eEUBebtb#^9UJ1Mxm_ZM@ zN^u%Fh5mFu$F%V`YTsA59C@CVAa8B@01*cbZbQlF+O(*$1@%UZK?7qL8GmCbmmt-mP7lx zmhUDYL6FmqjY6pg3sri+qk0qM*ZCMyArZq%^C&nNXh=vpNhdd!mgfm{V|l;WNPN(g zK1F@svkPTkz$79_=`<{u&6;0!d-qFo=Uy$?ah>5TH|4GyZl&aMQ;5$eb@bac7uQ;a zsFQyA#%UKEngGZF<3&_`rXRNAjfJkp)L2!bCH_0MXU@HoE%7{?2zlC;TzU9SqY7*L z+bd38CDHtRt@{{V=_>*1Dd?c-4l<^+`%O}Mnzn_dFjgu?xgP_MffzO@<(VP-r{vKmMd0R! zh#bI!=rk)C*q&(D0zSZeO|M+sS%H*Exve!O8Z6UoztYpk&Y8Q<(f2V|hF=B~Yn^nJ zS+arLa^XlX&6va7TnlO9zfO9SlImT8w_4YD^7IJ7Z1!}_M z{ippp!qn_h&vB7B_p!@YjQ4(Y;VXMran8`9X%&!M%4oY=??6-ipu{SGLLvJh7KZr7+?-h=e6=?1N%pwlXsVO+-C?m8I{ zk63`?#^r-?vR^C~Fq&tIoI6;&N=8=n5g%3fkPi>pgrJhuj|J7KahN7P6eNdcmP(JpCS`?RzN|Ne{U3lG+e=wZ|$_KB{}cE_{s1y|s3jw&sFgd9kL|vP#6M64X>oa<^WL@2v$(U3 z#>!yXLegOuS)e?cENLMU?{HHq#f^+h&WO4AMpL1^_#h=~sWeAczbr59w%l((usA5twY zm@H@(*7Gnujijjfk)rW$(Wi|2oOrDmy$=j;7zoR|#C`S2iR&J#qu~h1ryq9ii~HLP z(g0q-i#Ygp=-+RLce0m6gXDxYY>+;y>{(93aS1`}%0R&5aM=V}Ez2H7b2biVBi7wV z6X&~GUo4>CR1cS`&|A;7D*xr47ti##U(+i!)#WX`XkG zI&?`ip+o%) zqi9DB5$(67Hp-d0b_#LzuY&g_EOp zZmMhXjS8{%bIZD7#NSz;l&=32Fmv~?EPL2dx@4} zUY~E`4s!M=Ll~HI%45}fC)Gx6=aFPWXg4IAg>*vHtKj_@^lgg^pw2>lw|^_lA;nA^ zr!au;&%NV9Po3E_>2m_jT-JD);VSYGu(g0J*%DK#u)@@V!qeN`5b5oSO{Raja?lO6 zZ$x%r&zZ)=Huk?FR~~d?pv>Z|c2x{%Z)F1l9dtVW*#cFIt!~j?u$_Ng?PjbDE>uIH zG7QFX0oM)%-eb-E!=1;<#ebeP z$Oo2APGfwWH>sv2scnlpY~EI^^=nu-NRbdVCBlTmJw7O|o$+-$ivU+vZ)xqWFPDa; zc}rIBYW;BH$WOI(vhr33!2IpvueHX?JG`0$;kLt@FwA-@+DZA~#OT;5Gf2W(V2*XY zbad_uT9Vv2T$1n^rlKoGjoaU;t9L4O`mN>ThVkGb*3gE{ zc*V_r;XVQcqxOtUmJ`I`uOi6|Tdi^PnGdBeJ4vhwNlohRky~pI6`rEAvA|*Te8c1*4DB8pUT?!5t^2r>J;$#% z(vt333nbjcnaKrvDW>F3M0wIUGm z{n_YM`Dd#-=n(hyP_u9?{UXm1DP=5w2P_1dlH4QAFGZx`di)@Q>@Kh5+~CZ1&bj0) zL!AVfk4U7cBo#7`sH*Q>+*wsTHPux>DxU(Wa&b z2eC9^@wCvDri!1Sez#_V?1m+MBP=N9nAi{P4xBwvnUNp8t1l`kX(|$1kCAp$quo*A z$75u6dM5qz#$FdU6_X?k9C z0%)Ag?os>&{h zsX(>$>{N|8*>z6viZSFMN|SEyV=Se*Is2@I+LZZjDmJ%`^;LKP6*?C9htJ@nm{&wh zVBaL#c8Jz?jtWUaxI;p?;c(8Fpcp>)ZpA3m;xc~cg-x)R=l2@kMiCgst!gWw4Bb?4 z^aUruvUirh7X)YI-{25i*c8~-(X*PJl9rj%@@2PPASQ{r$_;yjIwUPIB`UU*Gi;xDg1vE%mHW`lt7*yOC9RRY)?Hw(nLbeiz>=t0G#Qr&RQ<^zDQHQy za?VwU5`m2&YW#is7|toIU8WEf^GRm+e53T5t?aQQ`W=MwG~7#eZTXdIr45e7Y9f?g z)2)UI(x^9BFaVv<-n_Fn-%Izdo4D)CVE<$K;9KYLWgMw=Y6(&A=m5dN^uIWJ2Oizp zZryg4ZQC|x*|u%lwr$(CZQHhuS@x`|U27%h?UiokMt3ki+&a!0$ z!^fU&kvJV8)$a+(Kp^sdV3dGMLlR~yu)H0X&dCuAA}$n_PS~@rNG_bD=JSDERSOAr zk;UkC=v9&&ZX646DFH~}l(^8y>a_B>C)zT2Alg0_jB*VSO%oD4M4%t$R?I)s2i_b(yv*cW9&hQc>64Da~ch0J^9s@6C_ZicSeU(*T3uI6B!mPa*C!0Q6~Xb-<4tL~4_#Tzslykad#>8j zph$?7q?z{s|N0m51Ze#&+{E6??!K~fLF(0?jn$Xk4)Giul{~ufP%YA8b=~!?qd#X- zwp#>nfizf+EC@J9K}%ffbR8a$!dZw=vEZ{?+7}#CE;txZ;>tgZ=|TX42Aas`JinEk;V7mr2E*L04J${7|#RJvGB63SxhB) zONs0w*>lSjs6CGwY6N|dyLLLZopmIQk4>dWt6@pB2n1Ejwh+LinoM*%0VmwCZm^Gh z8h{9$@b;ChiCycCb`O$w;`C<5`wfdjjJ8Xz<;BIvF&Fj)+i?X}uf4c!IRkqVzh=~> zS#WJ9Scc3A@nhAmx4&EkCgHx9*ub6d`A3T#EY*z{U?o#* z?|GqU6D>=xAbSj{j-HgitV64pTIa&?;@*UJB@cSu&N_;Yg;a%EdEG==GDnQbL^U8m zk8qhrDgG{x*aw+rz+e+pn;_+cNfu|yBbokQ1)#g+0=HoYsB*Gl%G6&QDt$j5K}ELRSM&m#@gLrcO3fbKUAwOufsA|GVc?*g zb7~Uxz;s=|?-#2o`<1yU-w)k%^Q*Q@z)d;|d^7fC+Di%dP%js#=XJ2+Gt zSw8>1#gg?m^@*aOA#^#xoaVBQO_h1bCn?FAN_cc*8Lyk$=a9}* zXK;N30tGj<1IlKN{_&)90@;||(!*OMfN3Wr$TORE!8twj=-x{>N{W+Tj}3^N%wzM$ z@8}wW7VIc+vr$9*z#$?F{Oh>-_B0YSu5M=7iVRbn2M1!Z=6ZQvLvwF``u5K*yuabX z7sX)z?TYOmnw9_M@{|5QFF)g_ZGJTFK{q}T+$9y1(8^*&1Vz6J1gzgh7dY$DB9x+x z_u^V_HbmGT{azmS(u1AjRE3M*F#_P2A~64dZo&Xar%pXR;CiI{cDpikvCJ~X1H?}5`Y_0{n^FZ1fjBzft+4;1RZSiH*j<3D ziYF_gbS=kP*24zHQ^6A*Y?;X(wY0X@8LxO0BH1=LbM!?VNmglGlJSJxxbIENj=lM? ztf3m>uv3B~=*{D+3OU?_er*yk<%{7r_7%b0p$3Yz14u^kQP&SGe zDgy+@U5qC|V>BU^8&v(x$-}km`uT1M9jc)j^`D5XzH2Lw;8xA0!WP<}OHFC3xa@za zI1~NPaM5 z#Bo8&aeBZBTf_ou^3TH0;QT>(E5*WA)e5ur>GLydh1X?>uClBQ@+A-l`k0rUdQrsmM9gM>7 zARy=erhyR7E?273AksYCs?lu3QKpcL2#E^;$VUL%TOXr);Kt@TRM3&IgrE_!_mz!fi z)=MGdN25#pEC40t1fwuhMYY2E>1auGQw#TchDw{4 zFIA|j?DkcMMFWZqW~L2xFTy2+6|MIRNLkrTj)5J%Ua_!$R-Y857sw6v75xq>(QRg~ z1B+_IkFu6o2_jcmL|^OdaEuS=z!abVXnQWy(uUkm0i_~YfSj=`x`N6!%2B=!^%fJu z=h9f}W*P`4Np3>InOzaCaP-MTsIVR9jGJ%PK5yBqE8O{1Ky-V*5LHEdS5sM8O+x|3 zCfXWCTfl6VYLaeP#;|70ysD+C26|(=!w5!Q3ZN`P=>x6S$y%h*`IrOfY1Mzc*^l#VYK`%K~BpkAzW(qZ@GWfZ(aP#mO#S{u>@G;sc3V(;Dg{BLUBFwSz z@rY-u7SpX&wZzY0J+ta}Z+-Eb9uyGhHGnkCaa0%XZG{{+o--lcJ3x)D7)K+89~Y0M zfb&@U>JVq7$%8Lco#Fd!S0fuR+0`hbMW*6MpzJklj4m2|7biOxoc6esQFwP~~i&a{3 z$kp5cUTAr)iRg2MpO)WM(YvL;4|X3_P60zdu|~_K*L_l*l;zc9Y6Q=zm8o6~z{mkf zBco=Os9H_L2~mZBqVutgHFs#wI^P5mB3&8?XwKZ)5CA~dqvHKFLyGoRa@jv}CmMpp z<3%SLrJiM>w0Ovm8xKUZ7VrP6g6@TZhohKg4`dJAKtL~?0m`sXO*Bb9$$MudQAY~4 zYbux*)p=ZWu!F}~$Fq(D3NCH09e%hgs9h!Mu>%LSe1~!&g_Do)f+No?&2mgG$j`>7YAxcupSveQCv2CAqNnl_20Y9#X2Z5G{}O>6ex{UcKn zKVvEUbDQmE6q{@chDM|I*>Gy{;`yn5} zX)LWS+Q4|z*FeR^eFac6Sd)b`1F}McAp7-oD5i$y{d*xh%i;3DP}(3TtXO-O3_s6h zP+ccMiDEorVN4*G+=VMN=?#U4E`VlvcA+f+-jTb#0U}L59Z(7SVQdp!7Oy=bDJdC& zo+vr+JEZ6>?fbi(jgghY8P%VI`FY3DJ$SHBpt`!h z)FPM?=JVG5wIr?stXW)DoTYf^*sItsS*CZw28egHnlji{)H*YJG1B`*;;bcj*zBd| zO+KXA@@Q&vuBLzR;dZ=*ZsiF-ki4mT=q^s2+pIW zTrjJL?`&((9N%5F6EdC8jERySei5$uVKkARN^(I(Y(b*L&8h)t&9!EL{hrAU>q8xL3u^0z6)EN?d3OxKzb@o~!H zeWx2sNhWhp?~re+imT)z7{VrohF)b}k=?H77#v!#wurEu zFx;^Q96U5`K&XPAMFs&*MY4aB#;hhhTi?edQF<-=S(qo_2fo|?i`5wx?mJ9J^pB*C zo~Ayr(DA5v*?wt&nV-l^7Uoi30QH6ax^3m7vFKULpPm+kJeiEoTPJGB^&Z7GC#nEgzc~r)a|(`OBOKeeB=3I1VdbmSkKE$B6EV?&gcFc z5ek9o9>^DL4kd72F3RAC6x(mV#k=oD&hBp~_9WP3q`gWk^=t&ob9oYxe8h?5s^vBY z+DEKrq)J%}n4vUw$3CzjdYW$K$vIO+WKgeyT7sdPDvQ)^H6T#F8UEli*fTv0G|xz$ zrZMgJ8{OsrixX>^>E&Dj?l7J5m#+8eqVm(9XTzVJ)>`un=hgmLU!&@}i#~+Ufl6>> z2Kz`PTIKz`a%eyf&{FsE;o@_8LbWI@C8AlYzT&FFS5C%U&Wcrh_dII2)y^8{o~(t| zqBVdKuVJOD*u>Fhy}N`6(XiRjdNXpfhr*|6vaS~JR+U?Q%FG)${D2-Y6}nf)TghR;UBKdP>2WZ|3|C3Pz8flVBCD>| zvaUyLqN<-#=4i*DQErwqt=9X?Tz*dQF7#)^9g)VJOEsBbS1InC6ed#jSb)IHiKL^W z;e_L?(Brr|TtVE$>Xq*Z;{-D+t*TXSW`dHX3{aRwSp~u_D87je-ymcC>?|ydN0e-& z-$l8wuzO}6!+ZbUmIIMP@83SC|3N7GpIaD47RG<30=47*oBbAY^Y&jk=LiO{Z4d;F zYQ26JbyqmZ$>}pgRjx$jbni-FJ!2Cgd zC1MkN(fwy?AqIQFf`a{%L|Jfo#g)^^QOEhFT?X%V?MgO)@Xr;8ZYsL_Abw`p{nJaUiZy(RP!+weuLF!g2mcVZ^IDDKoa*{RgtXH0+LxUXlCu0 zaYjieamvavKMjoUILrLgLFi_8Vtv{%m1+*fLl!ZWVn&a<3@a@+p116~&!gAIEApQ! ztWV*a=|RkTwN49IP*B#cTlxJ#!@}rX$Qw9RL3f#dt0mL_LvzAL&-~BQ3dd<%N$R7I z?zUDxSy>1&w}dSQzN(Eai5U?JSs>yeO@Tb9U#n|sZ=S~}XYQS?#9p6o%xna%EfA_H zQEMIwL}d=c^cQ0hqoUCgYlXcmrN_3$3=MzyK6JV7d_Q=8p`SZ}8)|Jgc%SwFb*gA; zXu#DnrRuVH`r`b(Yj*NZ=|Uf;PLak;Uz~t)z6#au*ae+72%_h#t$MJS&|puc)ZiE1 ztL~X;*fc(W?`jsy1gFwp15&f18H>k4qV?dyK@HpUfH75;b>FIogRkbw^=qR#dosN=wyKhXIA6ZhT-Wol>Ee` z-9yaU0_cf+aeZ*H37w^~^Q^|rQB<{*ql=tfbXVE?)QX&)`RH~6pb_|8mVJRkoL6|p z7PHT`UCFyiXbLv`1V0bG< zh-lS?_hQc$E7psP_uw;94S19LW)Wd81>yM6bcz4rZVkXFlV zrgJco%8ZaWV-|aW2NNB(cycz->J1QvktTn+TP=7$$uU+fC{`E><_B=@a(kTH$R_Tw zfqqaZ(-gnYO9U>!_oj5w;QTI`95EMxG!k;5i^!2Qnn~f0W!N7=tj*ue@8BA)u zqD(l!@T^|oa-`IN<DgV=Fx7x58gl44*r*y82f)bY1;Dt9YXK=pn6WLsGyHyiwKHSfTs*? zQYOIDy9y>mF~o2f+g*jr5QJ+n9qnwaTrVq|)QF}M$~8fSshNwFz|=a)L;%NuEhMxD zbU?mDebbcEN-S%$`N;;AxGgX0{~l z>)f`GUUf=_Cy^cGgag+cA5s!qyYjFf2^Fkb?s~*kgx3p|)vyY{2Wv;;bfE0Eo}SxM z^>~&J%|D9t-)j92*Yp2%telCF@joXps_sgOrafN<^giU$oO4bCk25d%&eSay^@run zI2x%30$`~s#R{P6!DFaIl4AH!y3e}LLBMhFgp&C9k@%4X1vD!yGV?N`oE+6HOxcSb z-)&5;9;Yy$ZKpeEbBiuNRyrm}hx=nA&)!q-oZTCDAG*-6Fnl&_Sl`PM9L?6=`^S`| zZq60bDWCgBz?FAtw+Y zL0a%&Nx`tg(;%i25WvReg8?@!jm(qQf)w`4{Pjvu_UT(>d?u=?W0h(Q%szelOzTEg+TIgr zeA{2y&~|enw8$uYvR-4tl|D3VAM2um1b7+`Z+JT(#Q5_CLr~#Xe?eJ@+85&4JsyxF zFmIQiDVsR5QwB1bGooROr2!-wj^-A!C7QY2jyX1>Uj<8tXBGRtjJDrjw=oW?3f0TS zFO|j9q@8irDCpFvRbr{mE-wRYz*SntH!1~=1O04SLs&dbf(uQ97bh(n99wNe6~>&$ zt>0?2ToKChR?L{=|C+N0$!U;xZO^tdf5M|(3qygV)0tjCMNuY-huj#^uX>cV$XI%o zby8WR<1h&Xh60RK{XW&i2e#>4-F~D(rV&!e3H8?3KbAKxkqA$J3`oAfYl3}z&JNQ! zxechz>6a=A=r^{S%{qaQ21rzfb(phkqHG8|hKy-!MQw2B`f|b!apDLXk+Cb$y*MqX zJYx-zbywY5Ho!FUXxFh>N_*79H*GH9()+!cNk>>eXT`MHFXNG0!0o-eTv z{7p>X%$&woSZm_Tyhvmuq+x;;cmHNkzYthj6=+y0TA0$_-KJ)7hq~M~y;o7%4~nWu zRFfcioPQpK57x~d3@c+_iY7}2Nv{I7CKfqfT;imbuc170Ij{w%!=MT{&NJn3>xckT z?*Ex+5K53|y%f6&KC9XZEv=k`Da(G82oWyJ(`j$Gn@hoFb5rNhXV5a$qDNz9Ux^w0 zexbx78|Kcam(%3Z9q16Seo*n?w%K`k@$u5F>y4`_&U{dSmv4s2@mo-|gM^^iSy|44 z&f$`}Kt!DtIzHFy?+2$YNUL?hUYK|x9qTgq>4i;-qvoR3XC>hN=;sI@GhxZxWU3*L zh;Ik+ZPAnJ;{dNMfnu4ondL92l^S6aRmI>ugmfpPsWPXwTQ!1{z)4yY)q1KNEXfX; zQLim9BAUR%BakEHqDIfOfh4qN0V@v2^2m@z0_1bfWf%9WEBH7f>vDBwbZL%4RHEr2 zF;%d+d`0Z0Gi%~6zsQ{o9nW2gEe$F`3_fedv;&NMhZWMIq6%2d88v1LNN7+knLDPY zIU_k!LEQGQrIuJZ;0Phve6sHbOE0u!umVVV0`s(eDB@7fnnn79Ki5KBrc`Q}pV@&x zWT1Z7)t=RHA=C_=MMuiT#7yTfX`;cPHZcYdYIZQj+xsD{!FY(+a{?^r;_ae7U4_5t z>2ubk5tXzM$sMM*Es&%d;`P|Wd9 z&C{Y45f%=P@0B)+x`WZWEW3PJb`5hYVVTn`yH*n9hL0phQ`;Fb_Vh?l*!{EyhwH_& z**hVb*O!j;Tt`m{s&aw&fzl?BuA~Pho2Fg+`TJ665mxNmF8W4~#Bn!mt4xnC64x`D zJ(F--Mpl2PP6ZO@l_D>7k85m7H1c}JFY1506pm)`d-ly6z_oo$q3X8wdcJmBwvE$Z zpfDF<8>KECkqd=rl;OjHKFoT#16DW9D(3_K$|N8{t=$4L3NA-b)z{SStX$@02qM%= z_-kZ~AH4w!0wO$2oZ^e?du3ZVUuc`%llCMog}yB!3*OVI6#i=7g{)}!CojLdr?ltW z`>~;}2I;0gy(?|i#jH6@yF9aT+{3E91@wpZl$yxr!PUW-#ZiG6-Sq07e^7_WYjOYB zMme^%a`mA5lviq{GF{66J#a7Il#sDtu zp-rNc=-9aZ>y`6jGs6RG2kg?T^nwoxG+Tr)iA20nqIb9I@A){p3>*13eHd#U5ir=PEHr(5qg)rbfB7|L6x-0Ww1!Kc<7+$amDi?fARRa6|T@_(D$wH zcR)z%%j;q}F`Hf8E576JW_BPK{tf+kI_ATI8mY0+2}bvNX3=`A)g^EBsb{|%jR!aI zF&A?Ad3;u}r~Bxup%pg{@z?5~@($hZ zbPhvs$cfuJKQ1~x+#CLOC&|teiTS1ElTobnzk{@g3iJ-7Y{j%~qrKDRo)2_$<8rlS zhD_Zb2X{(5_r%AuU}@31_<~nwXmWO40{ua|DqLH{5UdHW8ZOKosc~Gu$zIWW35Uo1 zJPAF^VC|C^4IEsz;amw-0nct|xmqU(3QWm!YjR)_J7*r7qC=n{W9mxqwRzEqvy>Q@ zGzMG^ceT~|+ey(W>OCra=nv8g4cf!M98j}kHB_f+VEB?puq9b2c8jq_0REK$n4Ayq z=pP62R^Dybh$2;8o9SEi!zkk<*nV(g)JDXTU}mPUWIaUjXnMQhyMBNZj}6$Yd-aw z)bOixDgGuvzoFUq0(BYS(?ZrJKL;T&Ly6s}TKaltzy2zbb8YOZRIxnGcCVP~H-A?7 zS&YRW`nKWN^U)H8SfoF&wd0PqKev{vu?MH74QuUbaef^Fy4jOoO0Qe3rOleV>@2uv zec(;EgH>jq%S{4W9c}FnoR0;KIy*jnibmJ9)0TvAgNN~UM~2Z1AbAOQ9v%1$wu-f zHw*DT928-i7`2<&2%*K;FWweRypVrub^ftI`@gi6Z2z$_s~sFnj*OeKQfNu8fW-S~QY6botgn0p^7L`++stY?A zutkOxSh>X#+ixQ$6o^4MJm1W0DsIGlF((jzi3fMoFh&?o)*tja z3fL)%+i1X(A=n`WFM(tptAf}Ecn+8kgl3UMWyau4+bU#^&0hjOGO;kpncJsyFa!!P%}el!`&q;dNc{<$j0EIDO{lONBf<6n3FTEk0oc%1-%t56jgIPi z!LQKU%SQmQ<_|zd#`RqVe?+jX7lt&3jqE(SM@0@Q1>}Kp>p;Efn|F&?R?vYpZu)_P z(A@PMa-t!ue@DK6;3MFS1poTTFcK&Bq~-%_lRt?XeBe7U6kMPguk&w$>)!^`4Be)%G|0F|cI>leh^K;QLoY3M7 zO#zG^G-jd?9Q{TO9Fe#gc-sjv(fE6g2|2tB+^E#B&W(SpqrkR;TvcGBoNRS!Sd_jY z*MjDKM6`)VFi8V|77Ur5B4OrJe@BtyCyXaGdU!juyDO?sZnYPy;+j55%?+4>sM*fw zQS$_U<@cEQUegWKQn^=pty2Oy%*(R_nz~o96+<@nV@R#js>2J1N3h332yY#hozt-4 z4lD#Duu)33Nj)&3oCdBWro8AXT>pBr=Y_t_D_cHJ-d4CPOXQq%I&ybZ^2pZMt}x{6 z+JS|LrPG^4eItys1HQ&U$Q8Ye4|RWfN?om8vf0J&2m8M3+B0i`Yhzwae~SKW&EO!SMv@>&lMqp^eV;(LY{U zDzr>oYx2W-?ip^=YW!qL>A=3ar|I9?f>0YQ;c;-0^Gvr0OK>Zq5*X_S^b40QSW;8U zHI!&cc;CmmCtD=+b+cQR=ZZNr8O?CH6l~4e<+QJ;et~e)fkqI|=Y8(D%_~?t-f7AK z4+kr7`E&d-i5&uQ@f0)+t}JP3SjgQmy#t6I@Vwbd8hHDg7@~4qPVH)t-Qu851HG7C z{gq1`_Ui>ObjBuVK_l<7ZySA$D<>>X7%F2-mB`E?^Vjxa0XnK^VKe3g3ooZdN$|?2 z-zEk1Ulm@bhsWs61pR3fO8K9(4x*1$TplcC)TIxnYC}vVLf+(9Uy_o4HgAllY%H#E zXGhoS6|-bHO?#dSvH)nW%@Tv9HN(*$e`9%-({#dE@vLM;6|9{splo#MZ@KC^3v15m z@;HpLFG%c_o+PxiaAq@Jb>q1^-zI0?Im(J{cf<`&PU~!cgv+cHk1|lQB^=A!1~LvW zoEJkvEEuk51$rFzEYm}*zp%C4s|?WF{vps~0D@RJCT9By7x5h<%ZLGs+{joQj4P*z z;UY1SJMlq~r>x;4d8J5SpkV_OcK>n+F#jXe^*^7pO!Tb(yeQF*|Nj^w5$ZoNx*U5% z2!iG!G3o>ng127=a1;s*DgMG=J%*Vk^B^a$4yXN6a!MZ(&Pc#yOktR0W}GB2F@sjX z128w)2J+AiNQ(}RrDs^v0S9wuhKoeNqnB?E?_M;pr{q4JIul`mLo1xLaMAE|FBZDI zBM=`F%|J#NK;Sb;c3D$EDmM;o`;p5%Q9_I5oK-c#*GV2L?_i!vNI}%I+8tx9#Gv7Y zHozGo+wsQwX@V*#?1CiU-jd!!)hN5s1g84gc=}0=)X`ys^vzxC93^OXGY>PznuKq< zImJc>lB7H0QtOBZOHf0^YYOJ)!2vsV^Ycx$7ug ztoSB|W-Kh zYsuY8!jXMS^xf{XG6XXCtlyaZ1eAJ0_Ix1m>iOxS{AMG6cABP`oLHmzn7|p!*zyV( z>?1^?1-&c~rK2znr5?K-IYa-xmtqyt-H_E@tk&wnv_f9|P(`Y`pE)db5te&-Nf5(9 zJ3Bh7Kg`aJ$k1BPpGSPBpaY)6Rf{v$F@8IXOK`=jvX=^8EV9FT;6QRu)fZvbl#hc4lm9o(|x9 z!|?HJ%bO!zmGX4MT#?_1);z4sWaD&|x}JtW{N?5KAFQkm4Gl}(Lxp6ZqQTY7n1(r6 z$SLPGrs)>w2uEgDJ=DvXCpMNjhh{gD9+(#wDVT|=IVR`^Hb|CM=>#MkaP(x>VbrA9 z#j}QOKD*QR{Ot)NAoD{M2FrdNL=nXz3Wem76F(xNZo%ln5k;i3m$L9Am>&g^gmj@5 z1?Pl+2LE)CiF_l4=tQ`N08Md<{A4*?Im(j6#E(!&MG;TllAQIw2p|rn|3v_iP69ig zi$#?GESH!^kB>cz^zr|UiSQogeRRF>-I!Xx$};K^5``;7N^ecmIC=9E2C9M8;+A6_ z+uT~<8vYyFp9!|xx@I=dZuB0PML@UH!Rd54my*8=M}^1Z;5GnmA#@a`X$9)(a#R#= zT*xKDjd+AA0CpA(fMYhMN`pBc`7n0Vg|3Z~QjdYJNEwAE1_%nrXOfV6)9O8d(l2i; z2!BWeClkN&)DZG%wcD%nl-3BQ@kp{PqpTzIN5oSU12c{(|Ke5^1! zJDA5|&gRK#_2i7b{PIYi%WZ*AFklXu$CN*nRE`4Q2-WL0qM!BEG) z&q6q-wErs6Q|K|gOn4T~70vPcnDZ9!4KeS|e@B?1cf;zL`4g0^Y%i8{Pq7t5WrtRy z>ZRa*?smv;7RV%jkzQ<5_bX*Ew2pi@IehRl>k!bN;0}To=UosJ0rFETiUWqaGVn@` zmeDHln@z8%3ASTjiDpq#7;G#Nr%kWCNahJSBh%N9!y!&@gI{N10;{z>!pA#m>aoBu zc0R__pdW)quaM+EsL8oO`@Gx+USQ8Te(8Khr>vS^G4AOc={AbLX`5zB&*W_=9Sg1> z*V@`$(L0MHNfHEPEcs%RJCqLa;VGP?g=^|w?WzUR^8kHPjNfRW`p+ib{3|B&>wYoj z{Bfw+ArXUvNSd^q2?arN{ILLvtJ=Nu=EAt!(mfxX57X4LIIrczk}5w{VeEX6NC?^6 zy6d=q&rI&t3C)^2HlP?$!KVynZ0^0Q{9?z<5o+^0Y`c6Mvke$I3ufR47Cl4)NR8lTwUvYB%L-i%64(PRFr?h)S3Pfe+#EgDlZ@##B zuGPz-PUI21GG0OxlqxotH#ZpC1-Ea%Uvd6HKKq;ur2MOoWEB{_hjEHl&yL?eDs+lo zZFg(|QQn6rFd!Egw!9CG2?r`{o{|xs0(?kgvYf!J9DFJf33YG7hrv%T$A~Hm@sRCz z`s-_q62yxGj?a@~RT`+FoPR1_(tDH%nn08@3f47Z-u@A5Q~PCD|23kW_d{_r{DyPG z9$pDq2~VkuQ`3FeFyXWWu0I~*!)tg}?C;qhNmw733y*K|z)`Q!KeUhK!G=@Ali8^? z+G~45{*|et8QD_}Pt=%Qc`W;O^lch68g2St)IUQ4w%7Z^2Q;krgVt^DA_UT(4~scC z90U6aPTb0NF|}T@g5dGQBPxvtJzmA^GFZ6XWcWV|*WP$A!h!K9ko?PS-y~pLwh1); zTle#ixowwoD~0ScdkBr-1Nx(i%bgp0V5F0FC(Z>DR35 z{*ClP@G-WFP?F4q`bqui)0FZ@Bna0^V@$64y*p$n;+uklsubaNS<2;k?O)_em`^jD zoB~i!abOi&3xi`5h{qB#`{(WBBQXt->);4N_#Ykn8Rb}K$?$OE+0ZIb%hU$9tR`&o z2KsC8g{*5A!rZYzV;c4S8@D`~Anl9`X%fOAQ-=PMP)R-r0+ z?6Gs5Wx5PU#bZh7=U$X9eNzkKebmF2aCx*&zr3B!FuxIdT37ePD~#e&e<^}`GIs?N zU_65UptNjTgX7_b!Js46%0qfuL{Da4Ru;b;(vi*$A0vUMMGNPNj{>&tHpftB5AViy zcl5iF-=@3l{A^T?@eXt({`8yjWK(sd^a0=cH&2w?M7p}w?(k&JtX64}9MJvD_4-0S_KN8YtHW`u~`Gji|&?)&3`FeYxV@br-&>;;U&02NR%qlki zavA`|a;-gQZ9!$_z^YOQ#$_|%PkCiE#rxEevHR%?8$#eFqxSr&<%!r3H(tT+7}yR) zn`w3{r#zN6j*I#-JTI=UDJ_A|Qi&$bQf zx2+P6az0Yq1#fj7-?!Uv6NAvM;QK;*zcND|&&t5^arnjKhu=k?M z{3BRNHSnVe)qX;_Xv2%k;eJ}vNE8ny#K)P6^0;>mKV3W}Ha`8(*DM^7-_U{T^RkOq zw4A$k6e6_Zno~1k0r*BsEkvSpXnzVtQM9EpnK)MN)#V3;T~Q1gtjQwzVXHqoh37&< zUqxIPpAP#3qnet@%TC;1*a(>?*SX7YI}FIDUcne^lKDKPl3{)G8`G2$$mi@jku)75 z5r&X+D~obQ&Ws{vWlDB%&wSeKbL-M#-<-r8G$$v1OmfJ?;Q4Min#hEPq z-)BkUmUI51ycWX)T#sSiC7sT=HVm@$>)c#1gJe2DUm^tvfKt0(;WkaR#}aubZIl7lV-DsedCoaIxqY~;I{JK4*~ z3uy}2I;}NX=^6tEUu9Z=9OUyS$R@0QKNc)A;JtCCmZ||Fh<%Q*pC~KRQx^Z~Ojvv^ zed4y-#X1aH8dd46?|44DT(s%2HPJ+dGO!fGk;>gzW3BIT9LRa6Ynz4*Piw(YWRfh` ztPdAlCRO+IN7HLdkxsO&IA^j_ial|~JkAOuUX?Cm=mT)7L2RI#u-&mD~sZ-8jyk?`*O%JUG+Bj)9ENPOeDr$gm3=eCmSd z@HtbVlo8C6`fgd0JGO+^Kt?0owTP?yh%I#x$Y?H3jDj>BZX9577A-%eg`#(mjZIxX zBz`Wx7XJqCuDnwH+KM{DQodra-*I$kph^0kiJ&6zZXz$?)4Uf^H0gZ?mlTerH9oCC z?Dhj;-{jP&%($^>u3`HJwuKD5_5mQ?&!~4TA|4%rWlNvGxd)>bPz!%|6{0C)Xbk}( z{;3Q0q=NHKpFTT}h6H&Hu?_$~JUE=VmkR?iFk?!%z0gS~*&$XkK@EgdQhB#olVpii zq6RcSb5NvwWH0k`z-#JkU1j`nIH-$QDL&`?l_;c(HZPSK7PF>(}}N{+!!6nPT>-gxBhVln`4HR5&Kb=*z0OhcD@udeeueO zqIrTv@D@zuCH<`H3Y&;|uR#ga2MQB~cL)9su-%WMj2Viuo0;*|H@wGAK5%|s-v~8k zuZviTwMBV?E^>Azj}dFamGN5 zbktH{?75HA_%)I$you74=*q67WxgulNm#8N#n8=K*m>I1@0Gw zyPK5@yrI7gx~M((1QDsW)7QQ=!#iJEU&1`XqM6@O=U^yjJ0Q7gl93SwkplmOkn+{S zvXau$72KSyPDh_NS18!u%~x+o%!`_y1YS|$dUM?29gQQO3oIH1b750n(Vxv@JfiUe zl&knXSbWDt*HqfwgM8X*Yg0wfQ3S^MV{~7XhAJtHB6@M*aTE~c_GM-9C;u(b+wJru z^a3dACm@se&`GrWy_Eyqq>Lw9#IsCISJ9~Pz?_`x& ztSdGF>3fjp@U_f<_F6C3JbA!1A8|5>~9qCpstd9gTVGyRKUfFMb`adi+8Qe$|*qG#h}5&Ch+KWR#R6v(fESsAlH zVv(0)B>zqdMOcCYe5M=#g++Cji@JN_X@Q`&?{gzV;&^9AxIowg277INZBjR>J9rg! zufB#s7aak4`;tfo*mzbrDg-rM>*f6U?4OP$rrNWtx`uZ8E&gcDBVmy1!qp}0Bn`qo z(Nv|40Y4(TpfN0K+ogR)quhqZ;Wo*7dh-5Mbirwyg9 zo#wr?igHZFgvz0T@2fK(bJ4Uc>L!Y^x&1AVves;K0Vuhzi_89m1&*6DLjej1bMRgz zDd>njrN30F@cGsi8X$F@b0NB@icQ*`;aF_N0d{%+dFlzP@?8W#_OYbCO;Nrbd~kM!6W4~ z0q(>Emwi0H){JWfd|x_l^T7=fh8BLVu8_2g>5Wai8{+x=sUv~~UqgoI>q$BsID=le z1Z9WxSv(98N^!2$O5gdoA4=qdSecmLPKwa#_eMTY#1?#jSp^{zlRFn}3-NOsNuv}* zoTc)nNrMSO1PpwOAVAH?acMqzB{6z;r0?(cQpB-PuH_mk!kYaym4DVM5oO8#y1MRMEg_)VPVkpc0>h5#s!t>Mz3!)cNr0aBTarC8|6TTVesJ* zR)*L>jeHnEpj#!$WJ0pQB&DyOXsg!LPSpvP!_9P-WJuVS^1RKl^D%DquWY^#Wo^E*+D_%hoSEg;OKOqT%pM^!c> z$EJDsjm+rlkI#*dm{1W_O+j(=ys|$=@Cv`sl&qADwuRRq^zg$4VO!T%pndz+R z!-v83SjYDDm8sxBG8=JSzlx221j)zL*y9x{ZU3jcuMCPqYqrH@2tH_# zfrKDIf;+)AxVy^`++i4;3=TsE9W*!zF2Oap27-q`a3^?x1THz}-dpFZ`_+A~>iv8F zx_0gAUDa##kKMiZYG3XrHY={q%jR_N8#nz=zL+C_VFD8bhrK;<`ZUj4mQq7_1q(3y zaU?Gr)J?)xR=xCmx?oXIzeqDAt{QZPsn9t4wvS2`MR}Mfe#BMqLAl-ik8->8ALVv_ z)j!JZ?K0ePrwV>OITNC9r`Gu03Hi$3b+(E(2Xr2*sw*a}c{u;LW41TdDf)?CDekQI z@8b0j3Ge^wDlqTAeyRR%(e~KWQ*T`FDWA)W3qC%y==qIbN4NZk_N4oS;5YO)VXgA2n|?NT_n^CfqKYE{1X$bX|&CvbEAs#9jx|jVpLy2YaVyw%KFrM_B$U3 zWpmm3-}S@!{_(o{f8*}IDCV2~le-96JaJ4Z6U?**4)5O~>2WT3&lvi{gU!c==>pP2 z{m;IQw&lw~E8__yJKIw@uqf*_>Fitmq9@l&@s+e5h7J_O7^?LU8}ao(V{k)#Y=c;< zs^q4>;6nCYbWc$MFzn4nk%;rseb3f$)RM(VILdRETjhYXD5 zk3x^imsh59Oxjj1`f(8OpL<+<{+qfe z(epOwB)pZq_E9Q04WVa2q^r7dT-$ zcq!^m{jb!0-^A(3l`;4?b$8xcul!Fe`1t?v2}8%<&6Z2u%2C_PnM)1CEiA|-5BBi% z0&xop{V|=qY(2Q-oh-d=V2IZP-y5iM@ zo(3V)({V8R`>{qts=Mi4@@b*Ar+)G99SPr_JND(NYuQg_oOu(!9M$mE)KJ%O`!w4) zr`)k#6W=vrEuL(?R9{y$=GGtSSIn9#<_=wNa{W*< ze-%$!Ni5GdPMSUGM_XNm1a%S2VZ;2%tqB-2vBDsupB|n#u)-7DI1*TJ*YvDbciA+i zs6DfulCuq2(GZB@xbQ~_ClY=X!X!y}7BG0MB$X&Efsw_?aZ;4uvO$7qcP(6f7#A7w z(_x>Ql}z;uCB|szot9xT)!T+o6xhm(*pGm#JhDWhdL+8Bp=p$>QPZ+?qGmhtq9&W- zyOF}EI}U-sXog5I(5<`6IwX3rOg{9vED>cAPKYV%P6aKNQJC1H621>0%U8B2g;>-{ zz(@IwwJ$K>8VP==(9LcIbn49-<^t#M_{j&|m}8;hLX*ias>m0UQ{$iE^HtB1Y%{Tc zAme1x29I&Wb*2bf-oB;8JW3UNV!;#r+L8$0SdwXKgqTAbZ%v*X=UkFe(xmr02?+_c zT9h=c0n)&si544A(E^2!VKIcPFuX|~Ug1D+U2|T^ja3b9O5mQKu7=gv;Dy*`eWLj( z@)fofk_TJGsKLc}8Hcx^v^8mv5Ta3CONQnX;?8l+7V1)j)n8q!`yvZXUa#8?KxB;n zg}>CeSBVQ2`UJ%-;**AjHSIwqsK{H21SS3g=NabnB@|;8$~i2Sl5j8$_8#DeFscNg z-+SYj`rB?{LeOUvQ%d?b?lFE+v?XNGF+a1N%yHHDn=En-1~CeCz&iG#qK|MnRUU3mplzlWf%>4r6U8%`1V%ctL zs|^-$MzKeqDfA|Bz{(Ml`5_;kvg$mV3JJkB0ALMoHTrF!3MN3vz$dKF3v`Mst#C))wk{gk~*UsS^DNoXvw*qPZqHw4z-O3U~o9-H#?= zV(u9u4Z!kN@WUG$TpT>YA(JWU$2Qn;4Yp$Fj@br9%?S|MWox{+mZtg`Z_Kt zqH@-s{s6sMt?IRBIA6pto^2yGrrbFK(cv06s%bKxx1AN2P-{BWium599PSq40R#Cl z^|vW;+v8$%sqjT7zNPTUv{Vm#BLlg$WQK{zhT5R+sctQ#@yMXHO?04yZqERFPys@3 z$yg#Hxz+?Lbvlx0+TRyj5NdRlc*sG&9lp*U~fpwl*mXWSGX%RbkMv zGg?yTm9Ssb7_84v2M?sMAwW1Yz+b3fJgI*Bt#27s4bo zFJFrsC~JX;gq?YaWRwvgjDlsy5l~(^i_cI^6^5Vzrv%*^*?U&hHP3FodcPbWsl7|v zP#IaS|z5jL35#~VOIA1MXLlFAaB?S zr={+uS9>k8y~*R;n8pTTK+$qm zOjCVf7|}+S)fr&-ISKQrGKAf)Car~@n8NvDRhFjV$3h*srA}t* z^BNZB!;gYY%1kUZ^_-@Qfd{C7!urSb;L%#Hhoc|XQPHX#S^fN@(1wa^h9U#GdE=g^ z{LLbCprTJ)BFx2nKd{m}L-9WWEzWQ+Vyg$&KAgk)far=kFGES11`fhPAe%u{}gBe~tatDv?6oTb?XHO!wfV7^o8( z_CTS1$7P~0ogAG#g7v!TrMZ^C&L^$9_StHmmVBax)weUh7A2`2u}VJ#XNOxlUs7sD zD=Ecabj3oMvgGK6gkz4q`7m#H+yW9UQbV`rfxIuF=TIHt)_yAYch`%#(!`R`^zH2KxN_{r-kgg?1z!nPT zX@Srtp5^!049kZ!L=6MIW(A5oCws*o+45NE366(#@?1V!=@QH?0XAMCvhT$>zN7O> za6MDMv^6tU8IXCVJg~$3!Q@gG=OI@{K|j;m*))F40KXoRO^OMk1$J!hYPH&ZD&5+Z zZY_?iD7GNb1YIdelh3C~YY%eYUQd20QnORe|IwwSVyxP&^Tv)I4UQDaFqSPN#2qu? zm#fTV)E`6AyR-4GxV{OrX2o<%Qx<7f`4ZuA9gxv#zAXNDOr8JiJ^BF{(r7|cC2{v^ z%4l#WY*dH-!&0A5L&tPheHC)%;&LxQg>bHqm_i}uKE+I=eI%z!-+r#-@Me6VZY53M z{+Lrj;Jz)~Fss1$etWq!df3DJ+O5XpE6 z_H5>1Z9)F+-NH+z4dTz-sf{owA!`7w+i0ZQ#$)<2$f#Dl_MM_&LhF+Szbf}nt!_4+ zAXF#&1hn>v{RCNw%?1f&=5~OPGMgw@;*P2V?F4MFV~OBlq(f6?Wj>klR{&o;GJ6^}P!Fg{GQi zna%6yoBf_;E9}B@c10^x&rXCq)eA14KW|h_UUn8b9aaN_JD?n&ETs!|a){&4l*+A5W(sn4<98E+!u8 zghFiVz5*#9ULKp>(y!=Ap@O{&U@W~?3g^<$!nD=nY}I!q?l)$2jxsrURTa4Ruv^*DJin#U&LCxX+Tf74I9;z8she8l?lzfK1F92H{_gw0`B~ zKFQJ%OWg56Y*ynG3ER zLb9_cPN+<=eiVPR!qB-g*%k2@LLsGukYdTA~X#lMwOshnXE)!g69RY(@MiD zh1SLL_9-1wL7DGU7>tkQNt%YfU7r(RCK_{{^0(Gu>4rLzC9XX6r9PfGX^UT}M&0>z zobKMjxlb(e>hkpFFx6)#%7Xd5e%i?NjG;v{lUs%K%ZV3$I{*F zzDD|4=aFyu(1ExW<3__E8|3BHWwM<6!X^pnah>&Lh`5b;jl#j}OMJ*^PIbuv)oo6@ z1=j*Dq%X*#Y9XxMw&Wl#lm;>(QOzW3PjQf3F;8|IU$OAUd4c~n`*$qVCb&9yC4Nf6 z*rZ;@NdffDLRplr=rL03T(#_~IPmh<#dO+A$TD6xbLuO?;63&-7h9zzs;Nt-QsIRc zm7VrZI|>4U3U-0M3EjyJ^y(876bB#oXBx#JkPfx2mJYwAO2Lt<)?ll(lcTG1azJud+!sbpAG^^4j@6TqK z2+Y~1OMf2*xD#kD;x7kS#2&`Ig^qMA2`_qHCg#-r#_@&p23fhz#ZH?qIe*DRXFS>< zRm%5!MwipF6I^5N>Z3htmIEI?#B>f&Te^A|kc*F=J9bQW0M#q&m{@F|pv%n?yWLfA z6BW+zG}1h*kBS)wbAJ`Ckga_0YcyK2vdMN6*-G2=0VtD3>%Y70J^B7@e~jW{>ddEZ zsPZP~D7j&OVz1Vf`_(&wU*0vsrkv_&`_ub)K2U!w9X0*^OZ66RcL&}%@5O!hCC-V7 z#T-wuU+46nj)rLB_B<&XA>S332!=V; zo9+O8!zRlZftDuAr=}ZV@BPiF3DfrhC-m0A0(-|-VF68({!qo83kne^-i&Ajy@)I& z1^$X}l$i-_@Kx`ederhs*2^8Pk2V)YO#9;uO+=(HjldnE+ZeaH!@8NP41fCqoBR%_ z$bJ{kZ?8G@@G&jtt{VXu`InNJ! zIGeVgQr&*f_coL`@R#r6kJFZ4&rD2lM45>MU+(n{omE*4aJQqwzxCcSLf>bE>y|(W zyKiyJjno3Kk{|@RE$bSPPRsPYThJ`h$!|_E@t8Wp471XLKn*NisETkN}lvB+!hEf(y_&hGLN|bzGYTi3) zIV%;#iV8k9Id((YFcQ(4{tj7^u(C`wY-j9(f*EkhblJO#?wy@miEZDz>+$RfWSi$P zWa4-BdxVzjH;2gAj@YfH&o?VNR!=NhboE(d!luFbG*w$A3JdE8xR*dk|AqO>Ve>Fk zyv+tp**am3hF)13A92Kr0WqNuIwDwwSY3dkT(>%k0*Or~X8Z}cj6vq{su0TNuu>jv^qOJewJNAhA4WBIJrr4Rj{O=XE=HXN5K;>~)m5MEJ$hjJp>AfTxjaYFA) zxFQM!wOma1X;M3mx3J;UsEUXdyJNZ6jexy=AY9;ptkm@=3ZrgD<6}-#y=|4$G6y+$ zzzh~(QB^Ol&y`1qPwF50EUbZ^33R+`03V?s36tME%mfT_%ea}41s@zbej zExgh)SrKhV^q~8g2(3WW;M-X5{4bbj2iI*fW!Uu})ur^6(epfA;V+bB@{r=aE{J}~ z<2lCfh-Z>3yo|(%V#$}S0j=7ZsG6j50UAct+ac-lYvQaNp-uXX?JS{P5sdI}2oR`D zxsb33|An|_Ar}*+B9vh&af(0@!ZMXRMQ3no@HBY}b+G<d`wdRDp$N3e{ZzVw8mH6)rk~Hwl$AF1Fes36*j*3g>*8P}~%HX|*Ton<>)L zM?_R=yXYq7>^xyp6iv;_PgAGpo5WRZo-&a%3F>c{4oj|nCx#0t1Ao+s_i7>>RtaCi zuUNuE?Nb;FSY<-eAhK($++9d%I5*<^WX`%=zm`=#^uUoufeP1jn+tw|5OP=%g5x4I zC-Fz*NLUK;ksKsSg`Z@w=b7CZZE3uIXv39&XTK@(M2n-;i=RsRUXb|bCgUtGn~ea6 zpQg<>q{(JHqFpeuVY3BzA+q)9HInmSU&%A%GXUZ}X2&pu&CX9G#=4XwQCPSOk|rARX(2A)_RY>@)#r;$7qH|vsc9cAkCQ!K_h*4;@% znB0~IxpY;{z9T0Sx`=P-px7|u4r8nOSPAqw4MR@-ouAPPgNp~!XDZR2N5i5xIeht5M@Wz;MX zM4^@iIS*(Yz5urbwj|e5sV$+wCs^eU$kJX?n9H%gAzfogR=rLhAag=(ePcS{Vso}& zdSK^+_xjG484|ZVLT5o(qp+azko|m+1deUtblS*~_8dq(|v zPewlo)Xj}*@jf2odvP{4`kdE)^y_?oW=X%;@zyo}M1gm7^=h*6$m0 z9xC0zjF43zc}vkj%AlDLv-VdlP0m_EwUk8Ta$dR1-sYQmj*mw%G$EcPiN;6xM8Y`R zcm5y67C>5nZE%tC9UX%Q&iG4}jh{G>I1X#|+LDF31OH1#NOXk_SKZ8yA9u=S_oxh@ gm4DNn_4Kmz@bdGpwFB@7JPdvo1TZnlsmlZY1G?<(y8r+H literal 0 HcmV?d00001 diff --git a/info/gcl-si.texi b/info/gcl-si.texi new file mode 100755 index 0000000..7035dd6 --- /dev/null +++ b/info/gcl-si.texi @@ -0,0 +1,142 @@ +\input texinfo +@c -*-texinfo-*- +@c IMPORTANT.... +@c some versions of texinfo.tex cause an error message 'unmatched paren +@c for: +@c @defun foo (a &optional (b 3)) +@c ! unbalanced parens in @def arguments. +@c ignore these by using 's' to scroll error messages in tex. + + +@c @smallbook +@setfilename gcl-si.info +@synindex vr fn + +@c to update the menus do: +@c (texinfo-multiple-files-update "gcl-si.texi" t t) + + + +@setchapternewpage odd +@dircategory GNU Common Lisp +@direntry +* gcl-si: (gcl-si.info). GNU Common Lisp System Internals +@end direntry + +@ifinfo +This is a Texinfo GCL SYSTEM INTERNALS Manual + +Copyright 1994 William F. Schelter +@end ifinfo + +@titlepage +@sp 10 +@comment The title is printed in a large font. +@comment @center @titlefont{GCL SI Manual} +@title GCL SI Manual +@end titlepage + +@node Top, Numbers, (dir), (dir) +@top + +@menu +* Numbers:: +* Sequences and Arrays and Hash Tables:: +* Characters:: +* Lists:: +* Streams and Reading:: +* Special Forms and Functions:: +* Compilation:: +* Symbols:: +* Operating System:: +* Structures:: +* Iteration and Tests:: +* User Interface:: +* Doc:: +* Type:: +* GCL Specific:: +* C Interface:: +* System Definitions:: +* Debugging:: +* Miscellaneous:: +* Compiler Definitions:: +* Function and Variable Index:: + + --- The Detailed Node Listing --- + +Operating System + +* Command Line:: +* Operating System Definitions:: + +GCL Specific + +* Bignums:: + +C Interface + +* Available Symbols:: + +System Definitions + +* Regular Expressions:: + +Debugging + +* Source Level Debugging in Emacs:: +* Low Level Debug Functions:: + +Miscellaneous + +* Environment:: +* Inititialization:: +* Low Level X Interface:: +@end menu + +@include number.texi + +@include sequence.texi + +@include character.texi + +@include list.texi + +@include io.texi + +@include form.texi + +@include compile.texi + +@include symbol.texi + +@include system.texi + +@include structure.texi + +@include iteration.texi + +@include user-interface.texi + +@include doc.texi + +@include type.texi + +@include internal.texi + +@include c-interface.texi + +@include si-defs.texi + +@include debug.texi + +@include misc.texi + +@include compiler-defs.texi + +@include gcl-si-index.texi + +@summarycontents +@contents +@bye + + diff --git a/info/gcl-si/Available-Symbols.html b/info/gcl-si/Available-Symbols.html new file mode 100644 index 0000000..9096d00 --- /dev/null +++ b/info/gcl-si/Available-Symbols.html @@ -0,0 +1,70 @@ + + + + + +Available Symbols (GCL SI Manual) + + + + + + + + + + + + + + + + + + + +
+

16.1 Available Symbols

+ +

When GCL is built, those symbols in the system libraries which +are referenced by functions linked in in the list of objects +given in unixport/makefile, become available for reference +by GCL code. +

+

On some systems it is possible with faslink to load .o files +which reference other libraries, but in general this practice is not +portable. +

+ + + + + + + + + + + + + diff --git a/info/gcl-si/Bignums.html b/info/gcl-si/Bignums.html new file mode 100644 index 0000000..3aff8f5 --- /dev/null +++ b/info/gcl-si/Bignums.html @@ -0,0 +1,120 @@ + + + + + +Bignums (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: GCL Specific   [Contents][Index]

+
+
+

15.1 Bignums

+ +

A directory mp was added to hold the new multi precision arithmetic +code. The layout and a fair amount of code in the mp directory is an +enhanced version of gpari version 34. The gpari c code was rewritten +to be more efficient, and gcc assembler macros were added to allow +inlining of operations not possible to do in C. On a 68K machine, +this allows the C version to be as efficient as the very carefully +written assembler in the gpari distribution. For the main machines, +an assembler file (produced by gcc) based on this new method, is +included. This is for sites which do not have gcc, or do not +wish to compile the whole system with gcc. +

+

Bignum arithmetic is much faster now. Many changes were made to +cmpnew also, to add ’integer’ as a new type. It differs from +variables of other types, in that storage is associated to each such +variable, and assignments mean copying the storage. This allows a +function which does a good deal of bignum arithmetic, to do very +little consing in the heap. An example is the computation of PI-INV +in scratchpad, which calculates the inverse of pi to a prescribed +number of bits accuracy. That function is now about 20 times faster, +and no longer causes garbage collection. In versions of GCL where +HAVE_ALLOCA is defined, the temporary storage growth is on the C +stack, although this often not so critical (for example it makes +virtually no difference in the PI-INV example, since in spite of the +many operations, only one storage allocation takes place. +

+

Below is the actual code for PI-INV +

+

On a sun3/280 (cli.com) +

+

Here is the comparison of lucid and gcl before and after +on that pi-inv. Times are in seconds with multiples of the +gcl/akcl time in parentheses. +

+

On a sun3/280 (cli.com) +

+
+
+
+pi-inv   akcl-566  franz        lucid         old kcl/akcl
+----------------------------------------
+10000      3.3     9.2(2.8 X)  15.3 (4.6X)    92.7   (29.5 X)
+20000      12.7    31.0(2.4 X) 62.2 (4.9X)    580.0  (45.5 X)
+
+
+(defun pi-inv (bits &aux (m 0))
+  (declare (integer bits m))
+  (let* ((n (+ bits (integer-length bits) 11))
+         (tt (truncate (ash 1 n) 882))
+         (d (* 4 882 882))
+         (s 0))
+    (declare (integer s d tt n))
+    (do ((i 2 (+ i 2))
+         (j 1123 (+ j 21460)))
+        ((zerop tt) (cons s (- (+ n 2))))
+      (declare (integer i j))
+        (setq s (+ s (* j tt))
+              m (- (* (- i 1) (- (* 2 i) 1) (- (* 2 i) 3)))
+              tt (truncate (* m tt) (* d (the integer (expt i 3))))))))
+
+
+ + +
+
+

+Previous: , Up: GCL Specific   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/C-Interface.html b/info/gcl-si/C-Interface.html new file mode 100644 index 0000000..5775099 --- /dev/null +++ b/info/gcl-si/C-Interface.html @@ -0,0 +1,58 @@ + + + + + +C Interface (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

16 C Interface

+ + + +
• Available Symbols   +
+ + + + + + diff --git a/info/gcl-si/Characters.html b/info/gcl-si/Characters.html new file mode 100644 index 0000000..831ed4c --- /dev/null +++ b/info/gcl-si/Characters.html @@ -0,0 +1,476 @@ + + + + + +Characters (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

3 Characters

+ +
+
Function: NAME-CHAR (name)
+

Package:LISP +

+

Given an argument acceptable to string, +Returns a character object whose name is NAME if one exists. Returns NIL +otherwise. NAME must be an object that can be coerced to a string. +

+ +
+ +
+
Function: CHAR-NAME (char)
+

Package:LISP +

+

Returns the name for CHAR as a string; NIL if CHAR has no name. +Only #\Backspace, #\Tab, #\Newline (or #\Linefeed), #\Page, #\Return, +and #\Rubout have names. +

+ +
+ +
+
Function: BOTH-CASE-P (char)
+

Package:LISP +

+

Returns T if CHAR is an alphabetic character; NIL otherwise. Equivalent to +ALPHA-CHAR-P. +

+ +
+ +
+
Function: SCHAR (simple-string index)
+

Package:LISP +

+

Returns the character object representing the INDEX-th character in STRING. +This is faster than CHAR. +

+ +
+ +
+
Constant: CHAR-SUPER-BIT
+

Package:LISP +The bit that indicates a super character. +

+ +
+ +
+
Constant: CHAR-FONT-LIMIT
+

Package:LISP +The upper exclusive bound on values produced by CHAR-FONT. +

+ +
+ +
+
Function: CHAR-DOWNCASE (char)
+

Package:LISP +

+

Returns the lower-case equivalent of CHAR, if any. +If not, simply returns CHAR. +

+ +
+ +
+
Function: STRING-CHAR-P (char)
+

Package:LISP +

+

Returns T if CHAR can be stored in a string. In GCL, this function always +returns T since any character in GCL can be stored in a string. +

+ +
+ +
+
Function: CHAR-NOT-LESSP (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly non-increasing order; NIL +otherwise. For a lower-case character, the code of its upper-case equivalent +is used. +

+ +
+ +
+
Function: DISASSEMBLE (thing)
+

Package:LISP +

+

Compiles the form specified by THING and prints the intermediate C language +code for that form. But does NOT install the result of compilation. +If THING is a symbol that names a not-yet-compiled function, the function +definition is disassembled. +If THING is a lambda expression, it is disassembled as a function definition. +Otherwise, THING itself is disassembled as a top-level form. +

+ +
+ + +
+
Function: LOWER-CASE-P (char)
+

Package:LISP +

+

Returns T if CHAR is a lower-case character; NIL otherwise. +

+ +
+ +
+
Function: CHAR<= (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly non-decreasing order; NIL +otherwise. +

+ +
+ +
+
Constant: CHAR-HYPER-BIT
+

Package:LISP +The bit that indicates a hyper character. +

+ +
+ +
+
Function: CODE-CHAR (code &optional (bits 0) (font 0))
+

Package:LISP +

+

Returns a character object with the specified code, if any. +If not, returns NIL. +

+ +
+ +
+
Function: CHAR-CODE (char)
+

Package:LISP +

+

Returns the code attribute of CHAR. +

+ +
+ +
+
Constant: CHAR-CONTROL-BIT
+

Package:LISP +The bit that indicates a control character. +

+ +
+ +
+
Function: CHAR-LESSP (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly increasing order; NIL +otherwise. For a lower-case character, the code of its upper-case equivalent +is used. +

+ +
+ +
+
Function: CHAR-FONT (char)
+

Package:LISP +

+

Returns the font attribute of CHAR. +

+ +
+ +
+
Function: CHAR< (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly increasing order; NIL otherwise. +

+ +
+ +
+
Function: CHAR>= (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly non-increasing order; NIL +otherwise. +

+ +
+ +
+
Constant: CHAR-META-BIT
+

Package:LISP +The bit that indicates a meta character. +

+ +
+ +
+
Function: GRAPHIC-CHAR-P (char)
+

Package:LISP +

+

Returns T if CHAR is a printing character, i.e., #\Space through #\~; +NIL otherwise. +

+ +
+ +
+
Function: CHAR-NOT-EQUAL (char &rest more-chars)
+

Package:LISP +

+

Returns T if no two of CHARs are the same character; NIL otherwise. +Upper case character and its lower case equivalent are regarded the same. +

+ +
+ +
+
Constant: CHAR-BITS-LIMIT
+

Package:LISP +The upper exclusive bound on values produced by CHAR-BITS. +

+ +
+ +
+
Function: CHARACTERP (x)
+

Package:LISP +

+

Returns T if X is a character; NIL otherwise. +

+ +
+ +
+
Function: CHAR= (char &rest more-chars)
+

Package:LISP +

+

Returns T if all CHARs are the same character; NIL otherwise. +

+ +
+ +
+
Function: ALPHA-CHAR-P (char)
+

Package:LISP +

+

Returns T if CHAR is an alphabetic character, A-Z or a-z; NIL otherwise. +

+ +
+ +
+
Function: UPPER-CASE-P (char)
+

Package:LISP +

+

Returns T if CHAR is an upper-case character; NIL otherwise. +

+ +
+ +
+
Function: CHAR-BIT (char name)
+

Package:LISP +

+

Returns T if the named bit is on in the character CHAR; NIL otherwise. +In GCL, this function always returns NIL. +

+ +
+ +
+
Function: MAKE-CHAR (char &optional (bits 0) (font 0))
+

Package:LISP +

+

Returns a character object with the same code attribute as CHAR and with +the specified BITS and FONT attributes. +

+ +
+ +
+
Function: CHARACTER (x)
+

Package:LISP +

+

Coerces X into a character object if possible. +

+ +
+ +
+
Function: CHAR-EQUAL (char &rest more-chars)
+

Package:LISP +

+

Returns T if all of its arguments are the same character; NIL otherwise. +Upper case character and its lower case equivalent are regarded the same. +

+ +
+ +
+
Function: CHAR-NOT-GREATERP (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly non-decreasing order; NIL +otherwise. For a lower-case character, the code of its upper-case equivalent +is used. +

+ +
+ +
+
Function: CHAR> (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly decreasing order; NIL +otherwise. +

+ +
+ +
+
Function: STANDARD-CHAR-P (char)
+

Package:LISP +

+

Returns T if CHAR is a standard character, i.e., one of the 95 ASCII printing +characters #\Space to #\~ and #Newline; NIL otherwise. +

+ +
+ +
+
Function: CHAR-UPCASE (char)
+

Package:LISP +

+

Returns the upper-case equivalent of CHAR, if any. +If not, simply returns CHAR. +

+ +
+ +
+
Function: DIGIT-CHAR-P (char &optional (radix 10))
+

Package:LISP +

+

If CHAR represents a digit in RADIX, then returns the weight as an integer. +Otherwise, returns nil. +

+ +
+ +
+
Function: CHAR/= (char &rest more-chars)
+

Package:LISP +

+

Returns T if no two of CHARs are the same character; NIL otherwise. +

+ +
+ +
+
Function: CHAR-GREATERP (char &rest more-chars)
+

Package:LISP +

+

Returns T if the codes of CHARs are in strictly decreasing order; NIL +otherwise. For a lower-case character, the code of its upper-case equivalent +is used. +

+ +
+ +
+
Function: ALPHANUMERICP (char)
+

Package:LISP +

+

Returns T if CHAR is either numeric or alphabetic; NIL otherwise. +

+ +
+ +
+
Function: CHAR-BITS (char)
+

Package:LISP +

+

Returns the bits attribute (which is always 0 in GCL) of CHAR. +

+ +
+ +
+
Function: DIGIT-CHAR (digit &optional (radix 10) (font 0))
+

Package:LISP +

+

Returns a character object that represents the DIGIT in the specified RADIX. +Returns NIL if no such character exists. +

+ +
+ +
+
Function: SET-CHAR-BIT (char name newvalue)
+

Package:LISP +

+

Returns a character just like CHAR except that the named bit is set or +cleared, according to whether NEWVALUE is non-NIL or NIL. This function +is useless in GCL. +

+ +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Command-Line.html b/info/gcl-si/Command-Line.html new file mode 100644 index 0000000..259ce30 --- /dev/null +++ b/info/gcl-si/Command-Line.html @@ -0,0 +1,200 @@ + + + + + +Command Line (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Operating System   [Contents][Index]

+
+
+

9.1 Command Line

+ +

The variable si::*command-args* is set to the list of strings passed +in when gcl is invoked. +

+

Various flags are understood. +

+
-eval + +
+

Call read and then eval on the command argument following -eval +

+
-load + +
+

Load the file whose pathname is specified after -load. +

+
-f + +
+

Replace si::*command-args* by the the list starting after -f. +Open the file following -f for input, skip the first line, and then +read and eval the rest of the forms in the file. This can be used +as with the shells to write small shell programs: +

+
#!/usr/local/bin/gcl.exe -f
+(format t "hello world ~a~%" (nth 1 si::*command-args*))
+
+

The value si::*command-args* will have the appropriate value. +Thus if the above 2 line file is made executable and called foo +then +

+
tutorial% foo billy
+hello world billy
+
+

NOTE: On many systems (eg SunOs) the first line of an executable script file +such as: +

+
#!/usr/local/bin/gcl.exe -f
+
+

only reads the first 32 characters! So if your pathname where the executable +together with the ’-f’ amount to more than 32 characters the file will not +be recognized. Also the executable must be the actual large binary file, +[or a link to it], +and not just a /bin/sh script. In latter case the +/bin/sh interpreter would get invoked on the file. +

+

Alternately one could invoke the file foo without making it +executable: +

+
tutorial% gcl -f foo "from bill"
+hello world from bill
+
+ +

Finally perhaps the best way (why do we save the best for last.. +I guess because we only figure it out after all the others..) +The following file myhello has 4 lines: +

+
#!/bin/sh
+#| Lisp will skip the next 2 lines on reading
+exec gcl   -f "$0" $ |#
+(format t "hello world ~a~%" (nth 1 si::*command-args*))
+
+ +
+
marie% chmod a+x myhello
+marie% myhello bill
+hello world bill
+
+ +

The advantage of this method is that gcl can itself +be a shell script, which sets up environment and +so on. Also the normal path will be searched to find gcl +The disadvantage is that this would cause 2 invocations of sh +and one invocation of gcl. The plan using gcl.exe +bypasses the sh entirely. Inded invoking gcl.exe to +print hello world is faster on most systems than a similar +csh or bash script, but slightly slower than the old +sh. +

+ +
+
-batch + +
+

Do not enter the command print loop. Useful if the other command line +arguments do something. Do not print the License and acknowledgement +information. Note if your program does print any License information, +it must print the GCL header information also. +

+
-dir + +
+

Directory where the executable binary that is running is located. +Needed by save and friends. This gets set as si::*system-directory* +

+
-libdir + +
+
+
   -libdir /d/wfs/gcl-2.0/
+
+

would mean that the files like gcl-tk/tk.o would be found by +concatting the path to the libdir path, ie in +

+
/d/wfs/gcl-2.0/gcl-tk/tk.o
+
+
+
-compile + +
+

Invoke the compiler on the filename following -compile. +Other flags affect compilation. +

+
-o-file + +
+

If nil follows -o-file then do not produce an .o file. +

+
-c-file + +
+

If -c-file is specified, leave the intermediate .c file there. +

+
-h-file + +
+

If -h-file is specified, leave the intermediate .h file there. +

+
-data-file + +
+

If -data-file is specified, leave the intermediate .data file there. +

+
-system-p + +
+

If -system-p is specified then invoke compile-file with the +:system-p t keyword argument, meaning that the C init function +will bear a name based on the name of the file, so that it may be invoked +by name by C code. +

+
+ +
+
+

+Next: , Previous: , Up: Operating System   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Compilation.html b/info/gcl-si/Compilation.html new file mode 100644 index 0000000..5eaaf50 --- /dev/null +++ b/info/gcl-si/Compilation.html @@ -0,0 +1,387 @@ + + + + + +Compilation (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

7 Compilation

+ +
+
Function: COMPILE (name &optional (definition nil))
+

Package:LISP +

+

If DEFINITION is NIL, NAME must be the name of a not-yet-compiled +function. In this case, COMPILE compiles the function, installs the compiled +function as the global function definition of NAME, and returns NAME. +If DEFINITION is non-NIL, it must be a lambda expression and NAME must be +a symbol. COMPILE compiles the lambda expression, installs the compiled +function as the function definition of NAME, and returns NAME. +There is only one exception for this: If NAME is NIL, then the compiled +function is not installed but is simply returned as the value of COMPILE. + In any case, COMPILE creates temporary files whose filenames are +"gazonk***". By default, i.e. if :LEAVE-GAZONK is not supplied or is +NIL, these files are automatically deleted after compilation. +

+ +
+ +
+ +

Package:LISP +

+

On systems where dlopen is used for relocations, one cannot make custom +images containing loaded binary object files simply by loading the files +and executing save-system. This function is provided for such cases. +

+

After compiling source files into objects, LINK can be called with a +list of binary and source FILES which would otherwise normally be +loaded in sequence before saving the image to IMAGE. LINK will use +the system C linker to link the binary files thus supplied with GCL’s +objects, using EXTRA-LIBS as well if provided, and producing a +raw_IMAGE executable. This executable is then run to initialize first +GCL’s objects, followed by the supplied files, in order, if +RUN-USER-INIT is set. In such a case, source files are loaded at +their position in the sequence. Any optional code which should be run +after file initialization can be supplied in the POST variable. The +image is then saved using save-system to IMAGE. +

+

This method of creating lisp images may also have the advantage that +all new object files are kept out of the lisp core and placed instead +in the final image’s .text section. This should in principle reduce +the core size, speed up garbage collection, and forego any performance +penalty induced by data cache flushing on some machines. +

+ +

In both the RAW and SAVED image, any calls to LOAD binary object files +which have been specified in this list will bypass the normal load +procedure, and simply initialize the already linked in module. One +can rely on this feature by disabling RUN-USER-INIT, and instead +passing the normal build commands in POST. In the course of executing +this code, binary modules previously linked into the .text section of +the executable will be initialized at the same point at which they +would have normally been loaded into the lisp core, in the +executable’s .data section. In this way, the user can choose to take +advantage of the aforementioned possible benefits of this linking +method in a relatively transparent way. +

+

All binary objects specified in FILES must have been compiled with +:SYSTEM-P set to T. +

+
+ +
+
Special Form: EVAL-WHEN
+

Package:LISP +

+

Syntax: +

+
(eval-when ({situation}*) {form}*)
+
+ +

A situation must be either COMPILE, LOAD, or EVAL. The interpreter evaluates +only when EVAL is specified. If COMPILE is specified, FORMs are evaluated +at compile time. If LOAD is specified, the compiler arranges so that FORMs +be evaluated when the compiled code is loaded. +

+ +
+ +
+
Function: COMPILE-FILE (input-pathname &key output-file (load nil) (message-file nil) ;GCL specific keywords: system-p c-debug c-file h-file data-file)
+

Package:LISP +

+ +

Compiles the file specified by INPUT-PATHNAME and generates a fasl file +specified by OUTPUT-FILE. If the filetype is not specified in INPUT-PATHNAME, +then ".lsp" is used as the default file type for the source file. :LOAD +specifies whether to load the generated fasl file after compilation. +:MESSAGE-FILE specifies the log file for the compiler messages. It defaults to +the value of the variable COMPILER:*DEFAULT-MESSAGE-FILE*. A non-NIL value of +COMPILER::*COMPILE-PRINT* forces the compiler to indicate the form currently +being compiled. More keyword parameters are accepted, depending on the +version. Most versions of GCL can receive :O-FILE, :C-FILE, :H-FILE, and +:DATA-FILE keyword parameters, with which you can control the intermediate +files generated by the GCL compiler. Also :C-DEBUG will pass the -g flag to +the C compiler. +

+ +

By top level forms in a file, we mean the value of *top-level-forms* after +doing (TF form) for each form read from a file. We define TF as follows: +

+

(defun TF (x) + (when (consp x) + (setq x (macroexpand x)) + (when (consp x) + (cond ((member (car x) ’(progn eval-when)) + (mapcar ’tf (cdr x))) + (t (push x *top-level-forms*)))))) +

+

Among the common lisp special forms only DEFUN and DEFMACRO will cause actual +native machine code to be generated. The rest will be specially treated in an +init section of the .data file. This is done so that things like putprop,setq, +and many other forms would use up space which could not be usefully freed, if +we were to compile to native machine code. If you have other ‘ordinary’ top +level forms which you need to have compiled fully to machine code you may +either set compiler::*COMPILE-ORDINARIES* to t, or put them inside a +

+

(PROGN ’COMPILE ...forms-which-need-to-be-compiled) +

+

The compiler will take each of them and make a temporary function which will be +compiled and invoked once. It is permissible to wrap a (PROGN ’COMPILE ..) +around the whole file. Currently this construction binds the +compiler::*COMPILE-ORDINARIES* flag to t. Setting this flag globally to a non +nil value to cause all top level forms to generate machine code. This might be +useful in a system such as PCL, where a number of top level lambda expressions +are given. Note that most common lisps will simply ignore the top level atom +’compile, since it has no side effects. +

+

Defentry, clines, and defcfun also result in machine code being generated. +

+
+ +

subsection Evaluation at Compile time

+ +

In GCL the eval-when behaviour was changed in order to allow +more efficient init code, and also to bring it into line with the resolution +passed by the X3j13 committee. Evaluation at compile time is controlled by +placing eval-when special forms in the code, or by the value of the variable +compiler::*eval-when-defaults* [default value :defaults]. If that variable +has value :defaults, then the following hold: +

+

Eval at Compile       Type of Top Level Form
+

+
+
Partial:
+

defstructs, defvar, defparameter +

+
Full:
+

defmacro, defconstant, defsetf, define-setf-method, + deftype, package ops, proclaim +

+
None:
+

defun, others +

+
+ + +

By ‘partial’ we mean (see the X3J13 Common Lisp document +(doc/compile-file-handling-of-top-level-forms) for more detail), that functions +will not be defined, values will not be set, but other miscellaneous compiler +properties will be set: eg properties to inline expand defstruct accessors and +testers, defstruct properties allowing subsequent defstructs to include this +one, any type hierarch information, special variable information will be set up. +

+

Example: +

+
(defun foo () 3)
+(defstruct jo a b)
+
+ +

As a side effect of compiling these two forms, foo would not have its function +cell changed. Neither would jo-a, although it would gain a property which +allows it to expand inline to a structure access. Thus if it had a previous +definition (as commonly happens from previously loading the file), this previous +definition would not be touched, and could well be inconsistent with the +compiler properties. Unfortunately this is what the CL standard says to do, +and I am just trying to follow it. +

+

If you prefer a more intuitive scheme, of evaling all forms in the file, so +that there are no inconsistencies, (previous behaviour of AKCL) you may set +compiler::*eval-when-defaults* to ’(compile eval load). +

+

The variable compiler::*FASD-DATA* [default t] controls whether an ascii output +is used for the data section of the object file. The data section will be in +ascii if *fasd-data* is nil or if the system-p keyword is supplied to +compile-file and *fasd-data* is not eq to :system-p. +

+

The old GCL variable *compile-time-too* has disappeared. +

+

See OPTIMIZE on how to enable warnings of slow constructs. +

+
+
Function: PROCLAIM (decl-spec)
+

Package:LISP +

+

Puts the declaration given by DECL-SPEC into effect globally. See the doc of +DECLARE for possible DECL-SPECs. +

+ +
+ + + + + + +
+
Function: PROVIDE (module-name)
+

Package:LISP +

+

Adds the specified module to the list of modules maintained in *MODULES*. +

+ +
+ +
+
Function: COMPILED-FUNCTION-P (x)
+

Package:LISP +

+

Returns T if X is a compiled function; NIL otherwise. +

+ +
+ +
+
Function: GPROF-START ()
+

Package:SYSTEM +

+

GCL now has preliminary support for profiling with gprof, an +externally supplied profiling tool at the C level which typically +accompanies gcc. Support must be enabled at compile time with +–enable-gprof. This function starts the profiling timers and +counters. +

+
+ + +
+
Function: GPROF-QUIT ()
+

Package:SYSTEM +

+

GCL now has preliminary support for profiling with gprof, an +externally supplied profiling tool at the C level which typically +accompanies gcc. Support must be enabled at compile time with +–enable-gprof. This function reports the profiling results in the +form of a call graph to standard output, and clears the profiling +arrays. Please note that lisp functions are not (yet) displayed with +their lisp names. Please see also the PROFILE function. +

+
+ + +
+
Function: GPROF-SET (begin end)
+

Package:SYSTEM +

+

GCL now has preliminary support for profiling with gprof, an +externally supplied profiling tool at the C level which typically +accompanies gcc. Support must be enabled at compile time with +–enable-gprof. This function sets the address range used by +GPROF-START in specifying the section of the running program which is +to be profiled. All subsequent calls to GPROF-START will use this new +address range. By default, the range is set to begin at the starting +address of the .text section, and to end at the current end of the +running core. These default values can be restored by calling +GPROF-SET with both argments set to 0. +

+
+ + +
+
Variable: *DEFAULT-SYSTEM-P*
+

Pakcage:COMPILER +Specifies the default setting of :SYSTEM-P used by COMPILE. Defaults to NIL. +

+ +
+
Variable: *DEFAULT-C-FILE*
+

Pakcage:COMPILER +Specifies the default setting of :C-FILE used by COMPILE. Defaults to NIL. +

+ +
+
Variable: *DEFAULT-H-FILE*
+

Pakcage:COMPILER +Specifies the default setting of :H-FILE used by COMPILE. Defaults to NIL. +

+ +
+
Variable: *DEFAULT-DATA-FILE*
+

Pakcage:COMPILER +Specifies the default setting of :DATA-FILE used by COMPILE. Defaults to NIL. +

+ +
+
Variable: *FEATURES*
+

Package:LISP +List of symbols that name features of the current version of GCL. +These features are used to decide the read-time conditionalization facility +provided by ’#+’ and ’#-’ read macros. When the GCL reader encounters +

+
	#+ feature-description form
+
+

it reads FORM in the usual manner if FEATURE-DESCRIPTION is true. Otherwise, +the reader just skips FORM. +

+
	#- feature-description form
+
+

is equivalent to +

+
	#- (not feature-description) form
+
+

A feature-description may be a symbol, which is true only when it is an +element of *FEATURES*. Or else, it must be one of the following: +

+
(and feature-desciption-1 ... feature-desciption-n)
+(or  feature-desciption-1 ... feature-desciption-n)
+(not feature-desciption)
+
+

The AND description is true only when all of its sub-descriptions are true. +The OR description is true only when at least one of its sub-descriptions is +true. The NOT description is true only when its sub-description is false. +

+ +
+ + + +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Compiler-Definitions.html b/info/gcl-si/Compiler-Definitions.html new file mode 100644 index 0000000..b103249 --- /dev/null +++ b/info/gcl-si/Compiler-Definitions.html @@ -0,0 +1,224 @@ + + + + + +Compiler Definitions (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

20 Compiler Definitions

+ +
+
Function: EMIT-FN (turn-on)
+

Package:COMPILER +

+

If TURN-ON is t, the subsequent calls to COMPILE-FILE will +cause compilation of foo.lisp to emit a foo.fn as well as foo.o. +The .fn file contains cross referencing information as well as +information useful to the collection utilities in cmpnew/collectfn +This latter file must be manually loaded to call emit-fn. +

+ +
+
+
Variable: *CMPINCLUDE-STRING*
+

Package:COMPILER +If it is a string it holds the text of the cmpinclude.h file appropriate for +this version. Otherwise the usual #include of *cmpinclude* will be used. To +disable this feature set *cmpinclude-string* to NIL in the init-form. +

+ +
+
+
Function: EMIT-FN (turn-on)
+

Package:COMPILER +

+ +

If TURN-ON is t, then subsequent calls to compile-file on a file foo.lisp +cause output of a file foo.fn. This .fn file contains lisp structures +describing the functions in foo.lisp. Some tools for analyzing this data base +are WHO-CALLS, LIST-UNDEFINED-FUNCTIONS, LIST-UNCALLED-FUNCTIONS, and +MAKE-PROCLAIMS. +

+

Usage: +(compiler::emit-fn t) +(compile-file "foo1.lisp") +(compile-file "foo2.lisp") +

+

This would create foo1.fn and foo2.fn. These may be loaded using LOAD. Each +time compile-file is called the data base is cleared. Immediately after the +compilation, the data base consists of data from the compilation. Thus if you +wished to find functions called but not defined in the current file, you could +do (list-undefined-functions), immediately following the compilation. If you +have a large system, you would load all the .fn files before using the above +tools. +

+ +
+
+
Function: MAKE-ALL-PROCLAIMS (&rest directories)
+

Package:COMPILER +

+ +

For each D in DIRECTORIES all files in (directory D) are loaded. +

+

For example +(make-all-proclaims "lsp/*.fn" "cmpnew/*.fn") +would load any files in lsp/*.fn and cmpnew/*.fn. +

+

[See EMIT-FN for details on creation of .fn files] +

+

Then calculations on the newly loaded .fn files are made, to determine +function proclamations. If number of values of a function cannot be +determined [for example because of a final funcall, or call of a function +totally unknown at this time] then return type * is assigned. +

+

Finally a file sys-proclaim.lisp is written out. This file contains function +proclamations. +

+

(load "sys-proclaim.lisp") +(compile-file "foo1.lisp") +(compile-file "foo2.lisp") +

+ + + +
+
+
Function: MAKE-PROCLAIMS (&optional (stream *standard-output*))
+

Package:COMPILER +

+ +

Write to STREAM the function proclaims from the current data base. Usually a +number of .fn files are loaded prior to running this. See EMIT-FN for details +on how to collect this. Simply use LOAD to load in .fn files. +

+ +
+
+
Function: LIST-UNDEFINED-FUNCTIONS ()
+

Package:COMPILER +

+ +

Return a list of all functions called but not defined, in the current data +base (see EMIT-FN). +

+
+
Sample:
+(compiler::emit-fn t)
+(compile-file "foo1.lisp")
+(compiler::list-undefined-functions)
+or
+(mapcar 'load (directory "*.fn")) (compiler::list-undefined-functions)
+
+
+ +
+
+
Function: WHO-CALLS (function-name)
+

Package:COMPILER +

+ +

List all functions in the data base [see emit-fn] which call FUNCTION-NAME. +

+ +
+
+
Function: LIST-UNCALLED-FUNCTIONS ()
+

Package:COMPILER +

+ +

Examine the current data base [see emit-fn] for any functions or macros which +are called but are not: fboundp, OR defined in the data base, OR having +special compiler optimizer properties which would eliminate an actual call. +

+ + + +
+
+
Variable: *CC*
+

Package:COMPILER +Has value a string which controls which C compiler is used by GCL. +Usually this string is obtained from the machine.defs file, but +may be reset by the user, to change compilers or add an include path. +

+ +
+
+
Variable: *SPLIT-FILES*
+

Package:COMPILER +This affects the behaviour of compile-file, and is useful for cases where +the C compiler cannot handle large C files resulting from lisp compilation. +This scheme should allow arbitrarily long lisp files to be compiled. +

+

If the value [default NIL] is a positive integer, then the source file will +be compiled into several object files whose names have 0,1,2,.. prepended, +and which will be loaded by the main object file. File 0 will +contain compilation of top level forms thru position *split-files* in the +lisp source file, and file 1 the next forms, etc. Thus a 180k file +would probably result in three object files (plus the master object file +of the same name) if *split-files* was set to 60000. +The package information will be inserted in each file. +

+ +
+
+
Variable: *COMPILE-ORDINARIES*
+

Package:COMPILER +If this has a non nil value [default = nil], then all top level +forms will be compiled into machine instructions. Otherwise +only defun’s, defmacro’s, and top level forms beginning +with (progn ’compile ...) will do so. +

+ +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Debugging.html b/info/gcl-si/Debugging.html new file mode 100644 index 0000000..8a9d6ad --- /dev/null +++ b/info/gcl-si/Debugging.html @@ -0,0 +1,62 @@ + + + + + +Debugging (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

18 Debugging

+ + + + + + +
• Source Level Debugging in Emacs   +
• Low Level Debug Functions   +
+ + + + + + diff --git a/info/gcl-si/Doc.html b/info/gcl-si/Doc.html new file mode 100644 index 0000000..e26c699 --- /dev/null +++ b/info/gcl-si/Doc.html @@ -0,0 +1,158 @@ + + + + + +Doc (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

13 Doc

+ +
+
Function: APROPOS (string &optional (package nil))
+

Package:LISP +

+

Prints those symbols whose print-names contain STRING as substring. +If PACKAGE is non-NIL, then only the specified package is searched. +

+ +
+ +
+
Function: INFO (string &optional (list-of-info-files *default-info-files*))
+

PACKAGE:SI +

+

Find all documentation about STRING in LIST-OF-INFO-FILES. The search +is done for STRING as a substring of a node name, or for STRING in the +indexed entries in the first index for each info file. Typically that +should be a variable and function definition index, if the info file is +about a programming language. If the windowing system is connected, +then a choice box is offered and double clicking on an item brings up +its documentation. +

+

Otherwise a list of choices is offered and the user may select some of +these choices. +

+

list-of-info-files is of the form +

+
 ("gcl-si.info" "gcl-tk.info" "gcl.info")
+
+

The above list is the default value of *default-info-files*, +a variable in the SI package. To find these files in the file +system, the search path *info-paths* is consulted as is the master +info directory dir. +

+

see *Index *default-info-files*:: and *Index *info-paths*::. +For example +

+
(info "defun")
+
+ 0: DEFUN :(gcl-si.info)Special Forms and Functions.
+ 1: (gcl.info)defun.
+Enter n, all, none, or multiple choices eg 1 3 : 1
+
+Info from file /home/wfs/gcl-doc/gcl.info:
+defun                                                               [Macro]
+---------------------------------------------------------------------------
+`Defun'  function-name lambda-list [[{declaration}* | documentation]]
+...
+
+
+

would list the node (gcl.info)defun. +That is the node entitled defun from the info file gcl.info. That +documentation is based on the ANSI common lisp standard. The choice +

+
DEFUN :(gcl-si.info)Special Forms and Functions.
+
+ +

refers to the documentation on DEFUN from the info file gcl-si.info in +the node Special Forms And Functions. This is an index reference +and only the part of the node which refers to defun will be +printed. +

+
+
(info "factor" '("maxima.info"))
+
+

would search the maxima info files index and nodes for factor. +

+
+ + + + + +
+
Variable: *info-paths*
+

Package SI: +

+

A list of strings such as +

+
  '("" "/usr/info/" "/usr/local/lib/info/" "/usr/local/info/"
+    "/usr/local/gnu/info/" )
+
+

saying where to look for the info files. It is used implicitly +by info, see *Index info::. +

+

Looking for maxima.info would look for the file +maxima.info in all the directories listed in *info-paths*. If nto found +then it would look for dir in the *info-paths* directories, +and if it were found it would look in the dir for a menu item +such as +

+
+
* maxima: (/home/wfs/maxima-5.0/info/maxima.info).
+
+ +

If such an entry exists then the directory there would be used for the +purpose of finding maxima.info +

+
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Environment.html b/info/gcl-si/Environment.html new file mode 100644 index 0000000..1116cdf --- /dev/null +++ b/info/gcl-si/Environment.html @@ -0,0 +1,62 @@ + + + + + +Environment (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Miscellaneous   [Contents][Index]

+
+
+

19.1 Environment

+ +

The environment in GCL which is passed to macroexpand and +other functions requesting an environment, should be a +list of 3 lists. The first list looks like ((v1 val1) (v2 val2) ..) +where vi are variables and vali are their values. +The second is a list of ((fname1 . fbody1) (fname2 . fbody2) ...) +where fbody1 is either (macro lambda-list lambda-body) or +(lambda-list lambda-body) depending on whether this is a macro +or a function. The third list contains tags and blocks. +

+ + + + + diff --git a/info/gcl-si/Function-and-Variable-Index.html b/info/gcl-si/Function-and-Variable-Index.html new file mode 100644 index 0000000..a677ef0 --- /dev/null +++ b/info/gcl-si/Function-and-Variable-Index.html @@ -0,0 +1,1227 @@ + + + + + +Function and Variable Index (GCL SI Manual) + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: Top   [Contents][Index]

+
+
+

Appendix A Function and Variable Index

+
Jump to:   * +   ++ +   +- +   +/ +   +1 +   +< +   += +   +> +   +
+A +   +B +   +C +   +D +   +E +   +F +   +G +   +H +   +I +   +K +   +L +   +M +   +N +   +O +   +P +   +Q +   +R +   +S +   +T +   +U +   +V +   +W +   +X +   +Y +   +Z +   +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Index Entry  Section
*
*: Numbers
*: User Interface
**: User Interface
***: User Interface
*AFTER-GBC-HOOK*: System Definitions
*APPLYHOOK*: Special Forms and Functions
*BREAK-ENABLE*: User Interface
*BREAK-ON-WARNINGS*: User Interface
*CASE-FOLD-SEARCH*: System Definitions
*CC*: Compiler Definitions
*CMPINCLUDE-STRING*: Compiler Definitions
*COMPILE-ORDINARIES*: Compiler Definitions
*DEBUG-IO*: User Interface
*DEFAULT-C-FILE*: Compilation
*DEFAULT-DATA-FILE*: Compilation
*DEFAULT-H-FILE*: Compilation
*DEFAULT-PATHNAME-DEFAULTS*: Operating System Definitions
*DEFAULT-SYSTEM-P*: Compilation
*DEFAULT-TIME-ZONE*: System Definitions
*ERROR-OUTPUT*: User Interface
*EVALHOOK*: Special Forms and Functions
*FEATURES*: Compilation
*GBC-MESSAGE*: System Definitions
*GBC-NOTIFY*: System Definitions
*IGNORE-EOF-ON-TERMINAL-IO*: System Definitions
*IGNORE-MAXIMUM-PAGES*: GCL Specific
*INDENT-FORMATTED-OUTPUT*: System Definitions
*info-paths*: Doc
*INTERRUPT-ENABLE*: System Definitions
*LISP-MAXPAGES*: System Definitions
*LOAD-PATHNAME*: System Definitions
*LOAD-VERBOSE*: Streams and Reading
*MACROEXPAND-HOOK*: Special Forms and Functions
*MAKE-CONSTANT: System Definitions
*MAKE-SPECIAL: System Definitions
*MODULES*: Operating System Definitions
*MULTIPLY-STACKS*: System Definitions
*NOTIFY-GBC*: System Definitions
*OPTIMIZE-MAXIMUM-PAGES*: GCL Specific
*PACKAGE*: Symbols
*PRINT-ARRAY*: Streams and Reading
*PRINT-BASE*: Streams and Reading
*PRINT-CASE*: Streams and Reading
*PRINT-CIRCLE*: Streams and Reading
*PRINT-ESCAPE*: Streams and Reading
*PRINT-GENSYM*: Streams and Reading
*PRINT-LENGTH*: Streams and Reading
*PRINT-LEVEL*: Streams and Reading
*PRINT-PRETTY*: Streams and Reading
*PRINT-RADIX*: Streams and Reading
*QUERY-IO*: Streams and Reading
*RANDOM-STATE*: Numbers
*READ-BASE*: Streams and Reading
*READ-DEFAULT-FLOAT-FORMAT*: Streams and Reading
*READ-SUPPRESS*: Streams and Reading
*READLINE-PREFIX*: Streams and Reading
*READTABLE*: Streams and Reading
*SPLIT-FILES*: Compiler Definitions
*STANDARD-INPUT*: Streams and Reading
*STANDARD-OUTPUT*: Streams and Reading
*SYSTEM-DIRECTORY*: System Definitions
*TERMINAL-IO*: Streams and Reading
*TMP-DIR*: GCL Specific
*TOP-LEVEL-HOOK*: System Definitions
*TRACE-OUTPUT*: User Interface
+
+: Numbers
+: User Interface
++: User Interface
+++: User Interface
-
-: User Interface
-: User Interface
-batch: Command Line
-c-file: Command Line
-compile: Command Line
-data-file: Command Line
-dir: Command Line
-eval: Command Line
-f: Command Line
-h-file: Command Line
-libdir: Command Line
-load: Command Line
-o-file: Command Line
-system-p: Command Line
/
/: Numbers
/: User Interface
//: User Interface
///: User Interface
/=: Numbers
1
1+: Numbers
1-: Numbers
<
<: Numbers
<=: Numbers
=
=: Numbers
>
>: Numbers
>=: Numbers
A
ABS: Numbers
ACCEPT: System Definitions
ACONS: Lists
ACOS: Numbers
ACOSH: Numbers
ADDRESS: System Definitions
ADJOIN: Lists
ADJUST-ARRAY: Sequences and Arrays and Hash Tables
ADJUSTABLE-ARRAY-P: Sequences and Arrays and Hash Tables
ALLOCATE: GCL Specific
ALLOCATE-CONTIGUOUS-PAGES: System Definitions
ALLOCATE-GROWTH: System Definitions
ALLOCATE-RELOCATABLE-PAGES: System Definitions
ALLOCATE-SGC: System Definitions
ALLOCATED: System Definitions
ALLOCATED-CONTIGUOUS-PAGES: System Definitions
ALLOCATED-PAGES: System Definitions
ALLOCATED-RELOCATABLE-PAGES: System Definitions
ALPHA-CHAR-P: Characters
ALPHANUMERICP: Characters
AND: Special Forms and Functions
APPEND: Lists
APPLY: Special Forms and Functions
APPLYHOOK: Special Forms and Functions
APROPOS: Doc
APROPOS-LIST: Symbols
AREF: Sequences and Arrays and Hash Tables
ARGC: System Definitions
ARGV: System Definitions
ARRAY-DIMENSION: Sequences and Arrays and Hash Tables
ARRAY-DIMENSION-LIMIT: Sequences and Arrays and Hash Tables
ARRAY-DIMENSIONS: Sequences and Arrays and Hash Tables
ARRAY-ELEMENT-TYPE: Sequences and Arrays and Hash Tables
ARRAY-HAS-FILL-POINTER-P: Sequences and Arrays and Hash Tables
ARRAY-IN-BOUNDS-P: Sequences and Arrays and Hash Tables
ARRAY-RANK: Sequences and Arrays and Hash Tables
ARRAY-RANK-LIMIT: Sequences and Arrays and Hash Tables
ARRAY-ROW-MAJOR-INDEX: Sequences and Arrays and Hash Tables
ARRAY-TOTAL-SIZE: Sequences and Arrays and Hash Tables
ARRAY-TOTAL-SIZE-LIMIT: Sequences and Arrays and Hash Tables
ARRAYP: Sequences and Arrays and Hash Tables
ASH: Numbers
ASIN: Numbers
ASINH: Numbers
ASSERT: Type
ASSOC: Lists
ASSOC-IF: Lists
ASSOC-IF-NOT: Lists
ATAN: Numbers
ATANH: Numbers
ATOM: Lists
B
BDS-VAL: System Definitions
BDS-VAR: System Definitions
BIT: Sequences and Arrays and Hash Tables
BIT-AND: Numbers
BIT-ANDC1: Numbers
BIT-ANDC2: Numbers
BIT-EQV: Sequences and Arrays and Hash Tables
BIT-IOR: Sequences and Arrays and Hash Tables
BIT-NAND: Numbers
BIT-NOR: Numbers
BIT-NOT: Sequences and Arrays and Hash Tables
BIT-ORC1: Sequences and Arrays and Hash Tables
BIT-ORC2: Sequences and Arrays and Hash Tables
BIT-VECTOR-P: Sequences and Arrays and Hash Tables
BIT-XOR: Sequences and Arrays and Hash Tables
BLOCK: Special Forms and Functions
BOOLE: Numbers
BOOLE-1: Numbers
BOOLE-2: Numbers
BOOLE-AND: Numbers
BOOLE-ANDC1: Numbers
BOOLE-ANDC2: Numbers
BOOLE-C1: Numbers
BOOLE-C2: Numbers
BOOLE-CLR: Numbers
BOOLE-EQV: Numbers
BOOLE-IOR: Numbers
BOOLE-NAND: Numbers
BOOLE-NOR: Numbers
BOOLE-ORC1: Numbers
BOOLE-ORC2: Numbers
BOOLE-SET: Numbers
BOOLE-XOR: Numbers
BOTH-CASE-P: Characters
BOUNDP: Symbols
BREAK: User Interface
BREAK-FUNCTION: System Definitions
BREAK-ON-FLOATING-POINT-EXCEPTIONS: Operating System Definitions
BUTLAST: Lists
BY: GCL Specific
BYE: GCL Specific
BYTE: Numbers
BYTE-POSITION: Numbers
BYTE-SIZE: Numbers
C
CAAAAR: Lists
CAAADR: Lists
CAAAR: Lists
CAADAR: Lists
CAADDR: Lists
CAADR: Lists
CAAR: Lists
CADAAR: Lists
CADADR: Lists
CADAR: Lists
CADDAR: Lists
CADDDR: Lists
CADDR: Lists
CADR: Lists
CALL-ARGUMENTS-LIMIT: Special Forms and Functions
CAR: Lists
CASE: Special Forms and Functions
CATCH: Special Forms and Functions
CATCH-BAD-SIGNALS: System Definitions
CATCH-FATAL: System Definitions
CCASE: Special Forms and Functions
CDAAAR: Lists
CDAADR: Lists
CDAAR: Lists
CDADAR: Lists
CDADDR: Lists
CDADR: Lists
CDAR: Lists
CDDAAR: Lists
CDDADR: Lists
CDDAR: Lists
CDDDAR: Lists
CDDDDR: Lists
CDDDR: Lists
CDDR: Lists
CDR: Lists
CEILING: Numbers
CERROR: User Interface
CHAR: Sequences and Arrays and Hash Tables
CHAR-BIT: Characters
CHAR-BITS: Characters
CHAR-BITS-LIMIT: Characters
CHAR-CODE: Characters
CHAR-CODE-LIMIT: Numbers
CHAR-CONTROL-BIT: Characters
CHAR-DOWNCASE: Characters
CHAR-EQUAL: Characters
CHAR-FONT: Characters
CHAR-FONT-LIMIT: Characters
CHAR-GREATERP: Characters
CHAR-HYPER-BIT: Characters
CHAR-INT: Numbers
CHAR-LESSP: Characters
CHAR-META-BIT: Characters
CHAR-NAME: Characters
CHAR-NOT-EQUAL: Characters
CHAR-NOT-GREATERP: Characters
CHAR-NOT-LESSP: Characters
CHAR-SUPER-BIT: Characters
CHAR-UPCASE: Characters
CHAR/=: Characters
CHAR<: Characters
CHAR<=: Characters
CHAR=: Characters
CHAR>: Characters
CHAR>=: Characters
CHARACTER: Characters
CHARACTERP: Characters
CHDIR: System Definitions
CHECK-TYPE: Type
CIS: Numbers
CLEAR-INPUT: Streams and Reading
CLEAR-OUTPUT: Streams and Reading
CLINES: GCL Specific
CLOSE: Streams and Reading
CLOSE-FASD: System Definitions
CLRHASH: Sequences and Arrays and Hash Tables
CODE-CHAR: Characters
COERCE: Type
COMMONP: Type
COMPILE: Compilation
COMPILE-FILE: Compilation
COMPILED-FUNCTION-NAME: System Definitions
COMPILED-FUNCTION-P: Compilation
COMPILER-LET: Special Forms and Functions
COMPLEX: Numbers
COMPLEXP: Numbers
CONCATENATE: Sequences and Arrays and Hash Tables
COND: Special Forms and Functions
CONJUGATE: Numbers
CONS: Lists
CONSP: Lists
CONSTANTP: Type
COPY-ALIST: Lists
COPY-ARRAY-PORTION: GCL Specific
COPY-LIST: Lists
COPY-READTABLE: Streams and Reading
COPY-SEQ: Sequences and Arrays and Hash Tables
COPY-STREAM: System Definitions
COPY-SYMBOL: Symbols
COPY-TREE: Lists
COS: Numbers
COSH: Numbers
COUNT: Sequences and Arrays and Hash Tables
COUNT-IF: Sequences and Arrays and Hash Tables
COUNT-IF-NOT: Sequences and Arrays and Hash Tables
CTYPECASE: Special Forms and Functions
D
DBL: System Definitions
DECF: Numbers
DECLARE: Special Forms and Functions
DECODE-FLOAT: Numbers
DECODE-UNIVERSAL-TIME: Operating System Definitions
DEFCFUN: GCL Specific
DEFCONSTANT: Special Forms and Functions
DEFENTRY: GCL Specific
DEFINE-COMPILER-MACRO: System Definitions
DEFINE-INLINE-FUNCTION: System Definitions
DEFINE-MODIFY-MACRO: Special Forms and Functions
DEFINE-SETF-METHOD: Special Forms and Functions
DEFLA: GCL Specific
DEFMACRO: Special Forms and Functions
DEFPARAMETER: Special Forms and Functions
DEFSETF: Special Forms and Functions
DEFSTRUCT: Structures
DEFTYPE: Type
DEFUN: Special Forms and Functions
DEFVAR: Special Forms and Functions
DELETE: Sequences and Arrays and Hash Tables
DELETE-DUPLICATES: Sequences and Arrays and Hash Tables
DELETE-FILE: Operating System Definitions
DELETE-IF: Sequences and Arrays and Hash Tables
DELETE-IF-NOT: Sequences and Arrays and Hash Tables
DENOMINATOR: Numbers
DEPOSIT-FIELD: Numbers
DESCRIBE: User Interface
DIGIT-CHAR: Characters
DIGIT-CHAR-P: Characters
DIRECTORY: Operating System Definitions
DIRECTORY-NAMESTRING: Streams and Reading
DISASSEMBLE: Characters
DISPLACED-ARRAY-P: System Definitions
DO: Streams and Reading
DO*: Iteration and Tests
DO-ALL-SYMBOLS: Iteration and Tests
DO-EXTERNAL-SYMBOLS: Iteration and Tests
DO-SYMBOLS: Iteration and Tests
DOCUMENTATION: Symbols
DOLIST: Iteration and Tests
DOTIMES: Special Forms and Functions
DOUBLE-FLOAT-EPSILON: Numbers
DOUBLE-FLOAT-NEGATIVE-EPSILON: Numbers
DPB: Numbers
DRIBBLE: User Interface
DYNAMIC-EXTENT: Type
E
ECASE: Special Forms and Functions
ED: User Interface
EIGHTH: Lists
ELT: Sequences and Arrays and Hash Tables
EMIT-FN: Compiler Definitions
EMIT-FN: Compiler Definitions
ENCODE-UNIVERSAL-TIME: Operating System Definitions
ENDP: Lists
ENOUGH-NAMESTRING: Operating System Definitions
EQ: Iteration and Tests
EQL: Numbers
EQUAL: Iteration and Tests
EQUALP: Iteration and Tests
ERROR: Special Forms and Functions
ERROR-SET: System Definitions
ETYPECASE: Special Forms and Functions
EVAL: Special Forms and Functions
EVAL-WHEN: Compilation
EVALHOOK: Special Forms and Functions
EVENP: Numbers
EVERY: Sequences and Arrays and Hash Tables
EXP: Numbers
EXPORT: Symbols
EXPT: Numbers
F
FASLINK: System Definitions
FBOUNDP: Symbols
FCEILING: Numbers
FFLOOR: Numbers
FIFTH: Lists
FILE-AUTHOR: Operating System Definitions
FILE-LENGTH: Streams and Reading
FILE-NAMESTRING: Streams and Reading
FILE-POSITION: Operating System Definitions
FILE-WRITE-DATE: Streams and Reading
FILL: Sequences and Arrays and Hash Tables
FILL-POINTER: Sequences and Arrays and Hash Tables
FIND: Sequences and Arrays and Hash Tables
FIND-ALL-SYMBOLS: Symbols
FIND-IF: Sequences and Arrays and Hash Tables
FIND-IF-NOT: Sequences and Arrays and Hash Tables
FIND-PACKAGE: Symbols
FIND-SHARING-TOP: System Definitions
FIND-SYMBOL: Symbols
FINISH-OUTPUT: Streams and Reading
FIRST: Lists
FIXNUMP: System Definitions
FLET: Special Forms and Functions
FLOAT: Numbers
FLOAT-DIGITS: Numbers
FLOAT-PRECISION: Numbers
FLOAT-RADIX: Numbers
FLOAT-SIGN: Numbers
FLOATP: Numbers
FLOOR: Numbers
FMAKUNBOUND: Symbols
FORCE-OUTPUT: Streams and Reading
FORMAT: Streams and Reading
FOURTH: Lists
FP-INPUT-STREAM: System Definitions
FP-OUTPUT-STREAM: System Definitions
FREAD: System Definitions
FREEZE-DEFSTRUCT: System Definitions
FRESH-LINE: Streams and Reading
FROUND: Numbers
FRS-BDS: System Definitions
FRS-IHS: System Definitions
FRS-VS: System Definitions
FTRUNCATE: Numbers
FUNCALL: Special Forms and Functions
FUNCTION: Special Forms and Functions
FUNCTIONP: Special Forms and Functions
FWRITE: System Definitions
G
GBC: GCL Specific
GBC-TIME: System Definitions
GCD: Numbers
GENSYM: Symbols
GENTEMP: Symbols
GET: Symbols
GET-DECODED-TIME: Operating System Definitions
GET-DISPATCH-MACRO-CHARACTER: Streams and Reading
GET-HOLE-SIZE: System Definitions
GET-INTERNAL-REAL-TIME: Operating System Definitions
GET-INTERNAL-RUN-TIME: Operating System Definitions
GET-MACRO-CHARACTER: Streams and Reading
GET-OUTPUT-STREAM-STRING: Streams and Reading
GET-PROPERTIES: Lists
GET-SETF-METHOD-MULTIPLE-VALUE: Special Forms and Functions
GET-STRING-INPUT-STREAM-INDEX: System Definitions
GET-UNIVERSAL-TIME: Operating System Definitions
GETENV: System Definitions
GETF: Lists
GETHASH: Sequences and Arrays and Hash Tables
GO: Special Forms and Functions
GPROF-QUIT: Compilation
GPROF-SET: Compilation
GPROF-START: Compilation
GRAPHIC-CHAR-P: Characters
H
HASH-TABLE-COUNT: Sequences and Arrays and Hash Tables
HASH-TABLE-P: Sequences and Arrays and Hash Tables
HELP: Structures
HELP*: GCL Specific
HOST-NAMESTRING: Operating System Definitions
I
IDENTITY: Special Forms and Functions
IF: Special Forms and Functions
IHS-FUN: System Definitions
IHS-VS: System Definitions
IMAGPART: Numbers
IMPORT: Symbols
IN-PACKAGE: Symbols
INCF: Numbers
INFO: Doc
INIT-SYSTEM: System Definitions
INPUT-STREAM-P: Streams and Reading
INSPECT: User Interface
INT-CHAR: Numbers
INTEGER-DECODE-FLOAT: Numbers
INTEGER-LENGTH: Numbers
INTEGERP: Numbers
INTERN: Symbols
INTERNAL-TIME-UNITS-PER-SECOND: Operating System Definitions
INTERSECTION: Lists
ISQRT: Numbers
K
KEYWORDP: Symbols
L
LABELS: Special Forms and Functions
LAMBDA-LIST-KEYWORDS: Special Forms and Functions
LAMBDA-PARAMETERS-LIMIT: Special Forms and Functions
LAST: Lists
LCM: Numbers
LDB: Numbers
LDB-TEST: Numbers
LDIFF: Lists
LEAST-NEGATIVE-DOUBLE-FLOAT: Numbers
LEAST-NEGATIVE-LONG-FLOAT: Numbers
LEAST-NEGATIVE-SHORT-FLOAT: Numbers
LEAST-NEGATIVE-SINGLE-FLOAT: Numbers
LEAST-POSITIVE-DOUBLE-FLOAT: Numbers
LEAST-POSITIVE-LONG-FLOAT: Numbers
LEAST-POSITIVE-SHORT-FLOAT: Numbers
LEAST-POSITIVE-SINGLE-FLOAT: Numbers
LENGTH: Lists
LET: Special Forms and Functions
LET*: Special Forms and Functions
LINK: Compilation
LISP-IMPLEMENTATION-TYPE: Operating System Definitions
LISP-IMPLEMENTATION-VERSION: Operating System Definitions
LIST: Lists
LIST*: Lists
LIST-ALL-PACKAGES: Symbols
LIST-LENGTH: Lists
LIST-UNCALLED-FUNCTIONS: Compiler Definitions
LIST-UNDEFINED-FUNCTIONS: Compiler Definitions
LISTEN: Streams and Reading
LISTP: Lists
LOAD: Streams and Reading
LOCALLY: Special Forms and Functions
LOG: Numbers
LOGAND: Numbers
LOGANDC1: Numbers
LOGANDC2: Numbers
LOGBITP: Numbers
LOGCOUNT: Numbers
LOGEQV: Numbers
LOGIOR: Numbers
LOGNAND: Numbers
LOGNOR: Numbers
LOGNOT: Numbers
LOGORC1: Numbers
LOGORC2: Numbers
LOGTEST: Numbers
LOGXOR: Numbers
LONG-FLOAT-EPSILON: Numbers
LONG-FLOAT-NEGATIVE-EPSILON: Numbers
LONG-SITE-NAME: Operating System Definitions
LOOP: Iteration and Tests
LOWER-CASE-P: Characters
M
MACHINE-INSTANCE: Operating System Definitions
MACHINE-TYPE: Operating System Definitions
MACHINE-VERSION: GCL Specific
MACRO-FUNCTION: Symbols
MACROEXPAND: Special Forms and Functions
MACROEXPAND-1: Special Forms and Functions
MACROLET: Special Forms and Functions
MAKE-ALL-PROCLAIMS: Compiler Definitions
MAKE-ARRAY: Sequences and Arrays and Hash Tables
MAKE-BROADCAST-STREAM: Streams and Reading
MAKE-CHAR: Characters
MAKE-CONCATENATED-STREAM: Streams and Reading
MAKE-DISPATCH-MACRO-CHARACTER: Streams and Reading
MAKE-ECHO-STREAM: Streams and Reading
MAKE-HASH-TABLE: Sequences and Arrays and Hash Tables
MAKE-LIST: Lists
MAKE-PACKAGE: Symbols
MAKE-PATHNAME: Streams and Reading
MAKE-PROCLAIMS: Compiler Definitions
MAKE-RANDOM-STATE: Numbers
MAKE-SEQUENCE: Sequences and Arrays and Hash Tables
MAKE-STRING: Sequences and Arrays and Hash Tables
MAKE-STRING-INPUT-STREAM: Streams and Reading
MAKE-STRING-INPUT-STREAM: User Interface
MAKE-STRING-OUTPUT-STREAM: Streams and Reading
MAKE-STRING-OUTPUT-STREAM-FROM-STRING: System Definitions
MAKE-SYMBOL: Symbols
MAKE-SYNONYM-STREAM: Streams and Reading
MAKE-TWO-WAY-STREAM: Streams and Reading
MAKUNBOUND: Symbols
MAP: Sequences and Arrays and Hash Tables
MAPC: Lists
MAPCAN: Lists
MAPCAR: Iteration and Tests
MAPCON: Lists
MAPHASH: Iteration and Tests
MAPL: Lists
MAPLIST: Lists
MASK-FIELD: Numbers
MATCH-BEGINNING: System Definitions
MATCH-END: System Definitions
MAX: Numbers
MAXIMUM-ALLOCATABLE-PAGES: System Definitions
MAXIMUM-CONTIGUOUS-PAGES: System Definitions
MEMBER: Lists
MEMBER-IF: Lists
MEMBER-IF-NOT: Lists
MERGE: Sequences and Arrays and Hash Tables
MERGE-PATHNAMES: Streams and Reading
MIN: Numbers
MINUSP: Numbers
MISMATCH: Sequences and Arrays and Hash Tables
MOD: Numbers
MODF: Numbers
MOST-NEGATIVE-DOUBLE-FLOAT: Numbers
MOST-NEGATIVE-FIXNUM: Numbers
MOST-NEGATIVE-LONG-FLOAT: Numbers
MOST-NEGATIVE-SHORT-FLOAT: Numbers
MOST-NEGATIVE-SINGLE-FLOAT: Numbers
MOST-POSITIVE-DOUBLE-FLOAT: Numbers
MOST-POSITIVE-FIXNUM: Numbers
MOST-POSITIVE-LONG-FLOAT: Numbers
MOST-POSITIVE-SHORT-FLOAT: Numbers
MOST-POSITIVE-SINGLE-FLOAT: Numbers
MULTIPLE-VALUE-BIND: Special Forms and Functions
MULTIPLE-VALUE-CALL: Special Forms and Functions
MULTIPLE-VALUE-LIST: Special Forms and Functions
MULTIPLE-VALUE-PROG1: Special Forms and Functions
MULTIPLE-VALUE-SETQ: Special Forms and Functions
MULTIPLE-VALUES-LIMIT: Special Forms and Functions
N
NAME-CHAR: Characters
NAMESTRING: Streams and Reading
NANI: System Definitions
NBUTLAST: Lists
NCONC: Lists
NIL: Symbols
NINTERSECTION: Lists
NINTH: Lists
NLOAD: System Definitions
NOT: Special Forms and Functions
NOTANY: Sequences and Arrays and Hash Tables
NOTEVERY: Sequences and Arrays and Hash Tables
NRECONC: Lists
NREVERSE: Sequences and Arrays and Hash Tables
NSET-DIFFERENCE: Lists
NSET-EXCLUSIVE-OR: Lists
NSTRING-CAPITALIZE: Sequences and Arrays and Hash Tables
NSTRING-DOWNCASE: Sequences and Arrays and Hash Tables
NSTRING-UPCASE: Sequences and Arrays and Hash Tables
NSUBLIS: Lists
NSUBST: Lists
NSUBST-IF: Lists
NSUBST-IF-NOT: Lists
NSUBSTITUTE: Sequences and Arrays and Hash Tables
NSUBSTITUTE-IF: Sequences and Arrays and Hash Tables
NSUBSTITUTE-IF-NOT: Sequences and Arrays and Hash Tables
NTH: Lists
NTHCDR: Lists
NULL: Lists
NUMBERP: Numbers
NUMERATOR: Numbers
NUNION: Lists
O
ODDP: Numbers
OPEN: Streams and Reading
OPEN-FASD: System Definitions
OR: Special Forms and Functions
OUTPUT-STREAM-P: Streams and Reading
OUTPUT-STREAM-STRING: System Definitions
P
PACKAGE-NAME: Symbols
PACKAGE-NICKNAMES: Symbols
PACKAGE-SHADOWING-SYMBOLS: Symbols
PACKAGE-USE-LIST: Symbols
PACKAGE-USED-BY-LIST: Symbols
PACKAGEP: Symbols
PAIRLIS: Lists
PARSE-INTEGER: Numbers
PARSE-NAMESTRING: Streams and Reading
PATHNAME: Streams and Reading
PATHNAME-DEVICE: Streams and Reading
PATHNAME-DIRECTORY: Streams and Reading
PATHNAME-HOST: Operating System Definitions
PATHNAME-NAME: Streams and Reading
PATHNAME-TYPE: Streams and Reading
PATHNAME-VERSION: Streams and Reading
PATHNAMEP: Streams and Reading
PEEK-CHAR: Streams and Reading
PHASE: Numbers
PI: Numbers
PLUSP: Numbers
POP: Lists
POSITION: Sequences and Arrays and Hash Tables
POSITION-IF: Sequences and Arrays and Hash Tables
POSITION-IF-NOT: Sequences and Arrays and Hash Tables
PPRINT: Streams and Reading
PRIN1: Streams and Reading
PRIN1-TO-STRING: Streams and Reading
PRINC: Streams and Reading
PRINC-TO-STRING: Streams and Reading
PRINT: Streams and Reading
PROBE-FILE: Streams and Reading
PROCLAIM: Compilation
PROCLAMATION: GCL Specific
PROF: System Definitions
PROG: Special Forms and Functions
PROG*: Special Forms and Functions
PROG1: Special Forms and Functions
PROG2: Special Forms and Functions
PROGN: Special Forms and Functions
PROGV: Special Forms and Functions
PROVIDE: Compilation
PSETF: Special Forms and Functions
PSETQ: Symbols
PUSH: Lists
PUSHNEW: Lists
PUTPROP: System Definitions
Q
QUOTE: Special Forms and Functions
R
RANDOM: Numbers
RANDOM-STATE-P: Numbers
RASSOC: Lists
RASSOC-IF: Lists
RASSOC-IF-NOT: Lists
RATIONAL: Numbers
RATIONALIZE: Numbers
RATIONALP: Numbers
READ: Streams and Reading
READ-BYTE: Streams and Reading
READ-CHAR: Streams and Reading
READ-CHAR-NO-HANG: Streams and Reading
READ-DELIMITED-LIST: Streams and Reading
READ-FASD-TOP: System Definitions
READ-FROM-STRING: Streams and Reading
READ-LINE: Streams and Reading
READ-PRESERVING-WHITESPACE: Streams and Reading
READLINE-OFF: Streams and Reading
READLINE-ON: Streams and Reading
READTABLEP: Streams and Reading
REALPART: Numbers
REDUCE: Sequences and Arrays and Hash Tables
REM: Numbers
REMF: Symbols
REMHASH: Sequences and Arrays and Hash Tables
REMOVE: Sequences and Arrays and Hash Tables
REMOVE-DUPLICATES: Sequences and Arrays and Hash Tables
REMOVE-IF: Sequences and Arrays and Hash Tables
REMOVE-IF-NOT: Sequences and Arrays and Hash Tables
REMPROP: Symbols
RENAME-FILE: Operating System Definitions
RENAME-PACKAGE: Symbols
REPLACE: Sequences and Arrays and Hash Tables
REQUIRE: Operating System Definitions
RESET-GBC-COUNT: System Definitions
RESET-STACK-LIMITS: System Definitions
REST: Lists
RETURN: Special Forms and Functions
RETURN-FROM: Special Forms and Functions
REVAPPEND: Lists
REVERSE: Sequences and Arrays and Hash Tables
ROOM: Operating System Definitions
ROTATEF: Numbers
ROUND: Numbers
RPLACA: Lists
RPLACD: Lists
RUN-PROCESS: System Definitions
S
SAVE: GCL Specific
SAVE-SYSTEM: System Definitions
SBIT: Sequences and Arrays and Hash Tables
SCALE-FLOAT: Numbers
SCHAR: Characters
SEARCH: Sequences and Arrays and Hash Tables
SECOND: Lists
SET: Symbols
SET-CHAR-BIT: Characters
SET-DIFFERENCE: Lists
SET-DISPATCH-MACRO-CHARACTER: Streams and Reading
SET-EXCLUSIVE-OR: Lists
SET-HOLE-SIZE: System Definitions
SET-MACRO-CHARACTER: Streams and Reading
SET-SYNTAX-FROM-CHAR: Streams and Reading
SETF: Special Forms and Functions
SETQ: Symbols
SEVENTH: Lists
SGC-ON: System Definitions
SHADOW: Symbols
SHADOWING-IMPORT: Symbols
SHIFTF: Numbers
SHORT-FLOAT-EPSILON: Numbers
SHORT-FLOAT-NEGATIVE-EPSILON: Numbers
SHORT-SITE-NAME: Operating System Definitions
SIGNUM: Numbers
SIMPLE-BIT-VECTOR-P: Sequences and Arrays and Hash Tables
SIMPLE-STRING-P: Sequences and Arrays and Hash Tables
SIMPLE-VECTOR-P: Sequences and Arrays and Hash Tables
SIN: Numbers
SINGLE-FLOAT-EPSILON: Numbers
SINGLE-FLOAT-NEGATIVE-EPSILON: Numbers
SINH: Numbers
SIXTH: Lists
SLEEP: Operating System Definitions
SOCKET: System Definitions
SOFTWARE-TYPE: Operating System Definitions
SOFTWARE-VERSION: Operating System Definitions
SOME: Sequences and Arrays and Hash Tables
SORT: Sequences and Arrays and Hash Tables
SPECIAL-FORM-P: Special Forms and Functions
SPECIALP: System Definitions
SQRT: Numbers
STABLE-SORT: Sequences and Arrays and Hash Tables
STANDARD-CHAR-P: Characters
STEP: User Interface
STREAM-ELEMENT-TYPE: Streams and Reading
STREAMP: Streams and Reading
STRING: Sequences and Arrays and Hash Tables
STRING-CAPITALIZE: Sequences and Arrays and Hash Tables
STRING-CHAR-P: Characters
STRING-CONCATENATE: System Definitions
STRING-DOWNCASE: Sequences and Arrays and Hash Tables
STRING-EQUAL: Sequences and Arrays and Hash Tables
STRING-GREATERP: Sequences and Arrays and Hash Tables
STRING-LEFT-TRIM: Sequences and Arrays and Hash Tables
STRING-LESSP: Sequences and Arrays and Hash Tables
STRING-MATCH: System Definitions
STRING-NOT-EQUAL: Sequences and Arrays and Hash Tables
STRING-NOT-GREATERP: Sequences and Arrays and Hash Tables
STRING-NOT-LESSP: Sequences and Arrays and Hash Tables
STRING-RIGHT-TRIM: Sequences and Arrays and Hash Tables
STRING-TO-OBJECT: System Definitions
STRING-TRIM: Sequences and Arrays and Hash Tables
STRING-UPCASE: Sequences and Arrays and Hash Tables
STRING/=: Sequences and Arrays and Hash Tables
STRING<: Sequences and Arrays and Hash Tables
STRING<=: Sequences and Arrays and Hash Tables
STRING=: Sequences and Arrays and Hash Tables
STRING>: Sequences and Arrays and Hash Tables
STRING>=: Sequences and Arrays and Hash Tables
STRINGP: Sequences and Arrays and Hash Tables
STRUCTUREP: System Definitions
SUBLIS: Lists
SUBSEQ: Sequences and Arrays and Hash Tables
SUBSETP: Lists
SUBST: Lists
SUBST-IF: Lists
SUBST-IF-NOT: Lists
SUBSTITUTE: Sequences and Arrays and Hash Tables
SUBSTITUTE-IF: Sequences and Arrays and Hash Tables
SUBSTITUTE-IF-NOT: Sequences and Arrays and Hash Tables
SUBTYPEP: Type
SVREF: Sequences and Arrays and Hash Tables
SXHASH: Numbers
SYMBOL-FUNCTION: Symbols
SYMBOL-NAME: Symbols
SYMBOL-PACKAGE: Symbols
SYMBOL-PLIST: Symbols
SYMBOL-VALUE: Symbols
SYMBOLP: Symbols
SYSTEM: GCL Specific
T
T: Symbols
TAGBODY: Special Forms and Functions
TAILP: Lists
TAN: Numbers
TANH: Numbers
TENTH: Lists
TERPRI: Streams and Reading
THE: Special Forms and Functions
THIRD: Lists
THROW: Special Forms and Functions
TIME: Operating System Definitions
TOP-LEVEL: System Definitions
TRACE: User Interface
TREE-EQUAL: Lists
TRUENAME: Streams and Reading
TRUNCATE: Numbers
TYPE-OF: Type
TYPECASE: Special Forms and Functions
TYPEP: Type
U
UNCATCH-BAD-SIGNALS: System Definitions
UNEXPORT: Symbols
UNINTERN: Symbols
UNION: Lists
UNIVERSAL-ERROR-HANDLER: System Definitions
UNLESS: Special Forms and Functions
UNREAD-CHAR: Streams and Reading
UNTRACE: User Interface
UNUSE-PACKAGE: Symbols
UNWIND-PROTECT: Special Forms and Functions
UPPER-CASE-P: Characters
USE-FAST-LINKS: GCL Specific
USE-PACKAGE: Symbols
USER-HOMEDIR-PATHNAME: Operating System Definitions
V
VALUES: Special Forms and Functions
VALUES-LIST: Special Forms and Functions
VECTOR: Sequences and Arrays and Hash Tables
VECTOR-POP: Sequences and Arrays and Hash Tables
VECTOR-PUSH: Sequences and Arrays and Hash Tables
VECTOR-PUSH-EXTEND: Sequences and Arrays and Hash Tables
VECTORP: Sequences and Arrays and Hash Tables
VS: System Definitions
W
WARN: User Interface
WHEN: Special Forms and Functions
WHO-CALLS: Compiler Definitions
WITH-INPUT-FROM-STRING: Streams and Reading
WITH-OPEN-FILE: Streams and Reading
WITH-OPEN-STREAM: Streams and Reading
WITH-OUTPUT-TO-STRING: Streams and Reading
WRITE: Streams and Reading
WRITE-BYTE: Streams and Reading
WRITE-CHAR: Streams and Reading
WRITE-DEBUG-SYMBOLS: System Definitions
WRITE-FASD-TOP: System Definitions
WRITE-LINE: Streams and Reading
WRITE-STRING: Streams and Reading
WRITE-TO-STRING: Streams and Reading
X
XDR-OPEN: System Definitions
XDR-READ: System Definitions
XDR-WRITE: System Definitions
Y
Y-OR-N-P: Streams and Reading
YES-OR-NO-P: Iteration and Tests
Z
ZEROP: Numbers
+
Jump to:   * +   ++ +   +- +   +/ +   +1 +   +< +   += +   +> +   +
+A +   +B +   +C +   +D +   +E +   +F +   +G +   +H +   +I +   +K +   +L +   +M +   +N +   +O +   +P +   +Q +   +R +   +S +   +T +   +U +   +V +   +W +   +X +   +Y +   +Z +   +
+ + + + +

Short Table of Contents

+ +
+ +
+ + +

Table of Contents

+ +
+ + +
+ +
+
+

+Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/GCL-Specific.html b/info/gcl-si/GCL-Specific.html new file mode 100644 index 0000000..28dc340 --- /dev/null +++ b/info/gcl-si/GCL-Specific.html @@ -0,0 +1,374 @@ + + + + + +GCL Specific (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

15 GCL Specific

+ +
+
Function: SYSTEM (string)
+

Package:LISP +

+

GCL specific: Executes a Shell command as if STRING is an input to the +Shell. Not all versions of GCL support this function. At least on +POSIX systems, this call should return two integers represeting the +exit status and any possible terminating signal respectively. +

+ +
+ +
+
Variable: *TMP-DIR*
+

Package:COMPILER +GCL specific: Directory in which temporary “gazonk” files used by the +compiler are to be created. +

+ +
+ +
+
Variable: *IGNORE-MAXIMUM-PAGES*
+

Package:SI +GCL specific: Tells the GCL memory manager whether (non-NIL) or not (NIL) it +should expand memory whenever the maximum allocatable pages have been used +up. +

+ +
+ +
+
Variable: *OPTIMIZE-MAXIMUM-PAGES*
+

Package:SI +

+

GCL specific: Tells the GCL memory manager whether to attempt to +adjust the maximum allowable pages for each type to approximately +optimize the garbage collection load in the current process. Defaults +to T. Set to NIL if you care more about memory usage than runtime. +

+ +
+ +
+
Function: MACHINE-VERSION ()
+

Package:LISP +

+

Returns a string that identifies the machine version of the machine +on which GCL is currently running. +

+ +
+ +
+
Function: BY ()
+

Package:LISP +

+

GCL specific: Exits from GCL. +

+ +
+ +
+
Macro: DEFCFUN
+

Package:LISP +

+

Syntax: +

+
(defcfun header n {element}*)
+
+ + +

GCL specific: Defines a C-language function which calls Lisp functions +and/or handles Lisp objects. HEADER gives the header of the C +function as a string. Non-negative-integer is the number of the main +stack entries used by the C function, primarily for protecting Lisp +objects from being garbage-collected. Each ELEMENT may give a C code +fragment as a string, or it may be a list + ((symbol {arg}*) {place}*) +which, when executed, calls the Lisp function named by SYMBOL with the +specified arguments and saves the value(s) to the specified places. +The DEFCFUN form has the above meanings only after compiled; The GCL +interpreter simply ignores this form. +

+

An example which defines a C function list2 of two arguments, but which +calls the ’lisp’ function CONS by name, and refers to the constant ’NIL. +Note to be loaded by load the function should be static. +

+ +

(defCfun "static object list2(x,y) object x,y;" 0 + "object z;" + (’NIL z) + ((CONS y z) z) + ((CONS x z) z) + "return(z);" +) +

+

In lisp the operations in the body would be + (setq z ’nil) + (setq z (cons y z)) + (setq z (cons x z)) +

+ + +

Syntax: +

+
+
+        (defCfun header non-negative-integer
+                { string
+                  | ( function-symbol { value }* )
+                  | (( function-symbol  { value }* ) { place }* ) })
+
+
+value:
+place:
+         { C-expr | ( C-type C-expr ) }
+
+C-function-name:
+C-expr:
+         { string | symbol }
+ 
+C-type:
+         { object | int | char | float | double }
+
+
+ + + + +
+ +
+
Macro: CLINES
+

Package:LISP +

+

Syntax: +

+
(clines {string}*)
+
+ +

GCL specific: The GCL compiler embeds STRINGs into the intermediate C +language code. The interpreter ignores this form. +

+ +
+ +
+
Function: ALLOCATE (type number &optional (really-allocate nil))
+

Package:LISP +

+

GCL specific: Sets the maximum number of pages for the type class of the +GCL implementation type TYPE to NUMBER. If REALLY-ALLOCATE is given a +non-NIL value, then the specified number of pages will be allocated +immediately. +

+ +
+ +
+
Function: GBC (x)
+

Package:LISP +

+

GCL specific: Invokes the garbage collector (GC) with the collection level +specified by X. NIL as the argument causes GC to collect cells only. T as +the argument causes GC to collect everything. +

+ +
+ +
+
Function: SAVE (pathname)
+

Package:LISP +

+

GCL specific: Saves the current GCL core image into a program file specified +by PATHNAME. This function depends on the version of GCL. The function +si::save-system is to be preferred in almost all circumstances. Unlike +save, it makes the relocatable section permanent, and causes no future gc of +currently loaded .o files. +

+
+ +
+
Function: HELP* (string &optional (package 'lisp))
+

Package:LISP +

+

GCL specific: Prints the documentation associated with those symbols in the +specified package whose print names contain STRING as substring. STRING may +be a symbol, in which case the print-name of that symbol is used. If PACKAGE +is NIL, then all packages are searched. +

+ +
+ +
+
Macro: DEFLA
+

Package:LISP +

+

Syntax: +

+
(defla name lambda-list {decl | doc}* {form}*)
+
+ +

GCL specific: Used to DEFine Lisp Alternative. For the interpreter, DEFLA is +equivalent to DEFUN, but the compiler ignores this form. +

+ +
+ +
+
Function: PROCLAMATION (decl-spec)
+

Package:LISP +

+

GCL specific: Returns T if the specified declaration is globally in effect; +NIL otherwise. See the doc of DECLARE for possible DECL-SPECs. +

+ +
+ +
+
Macro: DEFENTRY
+

Package:LISP +

+

Syntax: +

+
(defentry name arg-types c-function)
+
+ + +

GCL specific: The compiler defines a Lisp function whose body consists of a +calling sequence to the C language function specified by C-FUNCTION. The +interpreter ignores this form. The ARG-TYPES specifies the C types of the +arguments which C-FUNCTION requires. The list of allowed types is (object +char int float double string). Code will be produced to coerce from a lisp +object to the appropriate type before passing the argument to the C-FUNCTION. +The c-function should be of the form (c-result-type c-fname) where +c-result-type is a member of (void object char int float double string). +c-fname may be a symbol (in which case it will be downcased) or a string. If +c-function is not a list, then (object c-function) is assumed. In order +for C code to be loaded in by load you should declare any +variables and functions to be static. If you will link them in +at build time, of course you are allowed to define new externals. +

+
+
  Sample usage:
+--File begin-----
+;; JOE takes X a lisp string and Y a fixnum and returns a character.
+(clines "#include \"foo.ch\"")
+(defentry joe (string int) (char "our_c_fun"))
+---File end------
+---File foo.ch---
+/* C function for extracting the i'th element of a string */
+static char our_c_fun(p,i)
+char *p;
+int i;
+   {
+	return p[i];
+   }
+-----File end---
+
+ +

One must be careful of storage allocation issues when passing a string. +If the C code invokes storage allocation (either by calling malloc +or make_cons etc), then there is a possibility of a garbage +collection, so that if the string passed was not constructed with +:static t when its array was constructed, then it could move. +If the C function may allocate storage, then you should pass a copy: +

+
(defun safe-c-string (x)
+  (let* ((n (length x))
+         (a (make-array (+ n 1) :element-type 'string-char
+           :static t :fill-pointer n)))
+    (si::copy-array-portion x y 0 0 n)
+    (setf (aref a n) (code-char 0)))
+    a)
+
+
+ + +
+
+
Function: COPY-ARRAY-PORTION (x,y,i1,i2,n1)
+

Package:SI +Copy elements from X to Y starting at X[i1] to Y[i2] and doing N1 +elements if N1 is supplied otherwise, doing the length of X - I1 +elements. If the types of the arrays are not the same, this has +implementation dependent results. +

+ +
+
Function: BYE ( &optional (exit-status 0))
+

Package:LISP +

+

GCL specific: Exits from GCL with exit-status. +

+ +
+ +
+ +

Package:LISP +

+

GCL specific: If TURN-ON is not nil, the fast link mechanism is enabled, +so that ordinary function calls will not appear in the invocation stack, +and calls will be much faster. This is the default. If you anticipate +needing to see a stack trace in the debugger, then you should turn this +off. +

+ +
+ + + +
• Bignums   +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Inititialization.html b/info/gcl-si/Inititialization.html new file mode 100644 index 0000000..ce58db2 --- /dev/null +++ b/info/gcl-si/Inititialization.html @@ -0,0 +1,60 @@ + + + + + +Inititialization (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Miscellaneous   [Contents][Index]

+
+
+

19.2 Initialization

+ +

If the file init.lsp exists in the current directory, it is +loaded at startup. The first argument passed to the executable image +should be the system directory. Normally this would be gcl/unixport. +This directory is stored in the si::*system-directory* variable. If +the file sys-init.lsp exists in the system directory, it is loaded +before init.lsp. See also si::*TOP-LEVEL-HOOK*. +

+ + + + + diff --git a/info/gcl-si/Iteration-and-Tests.html b/info/gcl-si/Iteration-and-Tests.html new file mode 100644 index 0000000..5df87ca --- /dev/null +++ b/info/gcl-si/Iteration-and-Tests.html @@ -0,0 +1,217 @@ + + + + + +Iteration and Tests (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

11 Iteration and Tests

+ +
+
Macro: DO-EXTERNAL-SYMBOLS
+

Package:LISP +

+

Syntax: +

+
(do-external-symbols (var [package [result-form]])
+          {decl}* {tag | statement}*)
+
+ +

Executes STATEMENTs once for each external symbol in the PACKAGE (which +defaults to the current package), with VAR bound to the current symbol. +Then evaluates RESULT-FORM (which defaults to NIL) and returns the value(s). +

+ +
+ +
+
Special Form: DO*
+

Package:LISP +

+

Syntax: +

+
(do* ({(var [init [step]])}*) (endtest {result}*)
+          {decl}* {tag | statement}*)
+
+ +

Just like DO, but performs variable bindings and assignments in serial, just +like LET* and SETQ do. +

+ +
+ +
+
Macro: DO-ALL-SYMBOLS
+

Package:LISP +

+

Syntax: +

+
(do-all-symbols (var [result-form]) {decl}* {tag | statement}*)
+
+ +

Executes STATEMENTs once for each symbol in each package, with VAR bound to +the current symbol. Then evaluates RESULT-FORM (which defaults to NIL) and +returns the value(s). +

+ +
+ +
+
Function: YES-OR-NO-P (&optional (format-string nil) &rest args)
+

Package:LISP +

+

Asks the user a question whose answer is either ’YES’ or ’NO’. If FORMAT- +STRING is non-NIL, then FRESH-LINE operation is performed, a message is +printed as if FORMAT-STRING and ARGs were given to FORMAT, and then a prompt +"(Yes or No)" is printed. Otherwise, no prompt will appear. +

+ +
+ +
+
Function: MAPHASH #'hash-table
+

Package:LISP +

+

For each entry in HASH-TABLE, calls FUNCTION on the key and value of the +entry; returns NIL. +

+ +
+ +
+
Function: MAPCAR (fun list &rest more-lists)
+

Package:LISP +

+

Applies FUN to successive cars of LISTs and returns the results as a list. +

+ +
+ +
+
Special Form: DOLIST
+

Package:LISP +

+

Syntax: +

+
(dolist (var listform [result]) {decl}* {tag | statement}*)
+
+ +

Executes STATEMENTs, with VAR bound to each member of the list value of +LISTFORM. Then returns the value(s) of RESULT (which defaults to NIL). +

+ +
+ +
+
Function: EQ (x y)
+

Package:LISP +

+

Returns T if X and Y are the same identical object; NIL otherwise. +

+ +
+ +
+
Function: EQUALP (x y)
+

Package:LISP +

+

Returns T if X and Y are EQUAL, if they are characters and satisfy CHAR-EQUAL, +if they are numbers and have the same numerical value, or if they have +components that are all EQUALP. Returns NIL otherwise. +

+ +
+ +
+
Function: EQUAL (x y)
+

Package:LISP +

+

Returns T if X and Y are EQL or if they are of the same type and corresponding +components are EQUAL. Returns NIL otherwise. Strings and bit-vectors are +EQUAL if they are the same length and have identical components. Other +arrays must be EQ to be EQUAL. +

+ +
+ +
+
Macro: DO-SYMBOLS
+

Package:LISP +

+

Syntax: +

+
(do-symbols (var [package [result-form]]) {decl}* {tag |
+statement}*)
+
+ +

Executes STATEMENTs once for each symbol in the PACKAGE (which defaults to +the current package), with VAR bound to the current symbol. Then evaluates +RESULT-FORM (which defaults to NIL) and returns the value(s). +

+ +
+ +
+
Special Form: LOOP
+

Package:LISP +

+

Syntax: +

+
(loop {form}*)
+
+ +

Executes FORMs repeatedly until exited by a THROW or RETURN. The FORMs are +surrounded by an implicit NIL block. +

+ +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Lists.html b/info/gcl-si/Lists.html new file mode 100644 index 0000000..094673e --- /dev/null +++ b/info/gcl-si/Lists.html @@ -0,0 +1,1063 @@ + + + + + +Lists (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

4 Lists

+ +
+
Function: NINTERSECTION (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns the intersection of LIST1 and LIST2. LIST1 may be destroyed. +

+ +
+ +
+
Function: RASSOC-IF (predicate alist)
+

Package:LISP +

+

Returns the first cons in ALIST whose cdr satisfies PREDICATE. +

+ +
+ +
+
Function: MAKE-LIST (size &key (initial-element nil))
+

Package:LISP +

+

Creates and returns a list containing SIZE elements, each of which is +initialized to INITIAL-ELEMENT. +

+ +
+ +
+
Function: NTH (n list)
+

Package:LISP +

+

Returns the N-th element of LIST, where the car of LIST is the zeroth +element. +

+ +
+ +
+
Function: CAAR (x)
+

Package:LISP +

+

Equivalent to (CAR (CAR X)). +

+ +
+ +
+
Function: NULL (x)
+

Package:LISP +

+

Returns T if X is NIL; NIL otherwise. +

+ +
+ +
+
Function: FIFTH (x)
+

Package:LISP +

+

Equivalent to (CAR (CDDDDR X)). +

+ +
+ +
+
Function: NCONC (&rest lists)
+

Package:LISP +

+

Concatenates LISTs by destructively modifying them. +

+ +
+ +
+
Function: TAILP (sublist list)
+

Package:LISP +

+

Returns T if SUBLIST is one of the conses in LIST; NIL otherwise. +

+ +
+ +
+
Function: CONSP (x)
+

Package:LISP +

+

Returns T if X is a cons; NIL otherwise. +

+ +
+ +
+
Function: TENTH (x)
+

Package:LISP +

+

Equivalent to (CADR (CDDDDR (CDDDDR X))). +

+ +
+ +
+
Function: LISTP (x)
+

Package:LISP +

+

Returns T if X is either a cons or NIL; NIL otherwise. +

+ +
+ +
+
Function: MAPCAN (fun list &rest more-lists)
+

Package:LISP +

+

Applies FUN to successive cars of LISTs, NCONCs the results, and returns it. +

+ +
+ +
+
Function: EIGHTH (x)
+

Package:LISP +

+

Equivalent to (CADDDR (CDDDDR X)). +

+ +
+ +
+
Function: LENGTH (sequence)
+

Package:LISP +

+

Returns the length of SEQUENCE. +

+ +
+ +
+
Function: RASSOC (item alist &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns the first cons in ALIST whose cdr is equal to ITEM. +

+ +
+ +
+
Function: NSUBST-IF-NOT (new test tree &key (key #'identity))
+

Package:LISP +

+

Substitutes NEW for subtrees of TREE that do not satisfy TEST. +

+ +
+ +
+
Function: NBUTLAST (list &optional (n 1))
+

Package:LISP +

+

Changes the cdr of the N+1 th cons from the end of the list LIST to NIL. +Returns the whole list. +

+ +
+ + + +
+
Function: CDR (list)
+

Package:LISP +

+

Returns the cdr of LIST. Returns NIL if LIST is NIL. +

+ +
+ +
+
Function: MAPC (fun list &rest more-lists)
+

Package:LISP +

+

Applies FUN to successive cars of LISTs. Returns the first LIST. +

+ +
+ +
+
Function: MAPL (fun list &rest more-lists)
+

Package:LISP +

+

Applies FUN to successive cdrs of LISTs. Returns the first LIST. +

+ +
+ +
+
Function: CONS (x y)
+

Package:LISP +

+

Returns a new cons whose car and cdr are X and Y, respectively. +

+ +
+ +
+
Function: LIST (&rest args)
+

Package:LISP +

+

Returns a list of its arguments +

+ +
+ + +
+
Function: THIRD (x)
+

Package:LISP +

+

Equivalent to (CADDR X). +

+ +
+ +
+
Function: CDDAAR (x)
+

Package:LISP +

+

Equivalent to (CDR (CDR (CAR (CAR X)))). +

+ +
+ +
+
Function: CDADAR (x)
+

Package:LISP +

+

Equivalent to (CDR (CAR (CDR (CAR X)))). +

+ +
+ +
+
Function: CDAADR (x)
+

Package:LISP +

+

Equivalent to (CDR (CAR (CAR (CDR X)))). +

+ +
+ +
+
Function: CADDAR (x)
+

Package:LISP +

+

Equivalent to (CAR (CDR (CDR (CAR X)))). +

+ +
+ +
+
Function: CADADR (x)
+

Package:LISP +

+

Equivalent to (CAR (CDR (CAR (CDR X)))). +

+ +
+ +
+
Function: CAADDR (x)
+

Package:LISP +

+

Equivalent to (CAR (CAR (CDR (CDR X)))). +

+ +
+ +
+
Function: NTHCDR (n list)
+

Package:LISP +

+

Returns the result of performing the CDR operation N times on LIST. +

+ +
+ +
+
Function: PAIRLIS (keys data &optional (alist nil))
+

Package:LISP +

+

Constructs an association list from KEYS and DATA adding to ALIST. +

+ +
+ +
+
Function: SEVENTH (x)
+

Package:LISP +

+

Equivalent to (CADDR (CDDDDR X)). +

+ +
+ +
+
Function: SUBSETP (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns T if every element of LIST1 appears in LIST2; NIL otherwise. +

+ +
+ +
+
Function: NSUBST-IF (new test tree &key (key #'identity))
+

Package:LISP +

+

Substitutes NEW for subtrees of TREE that satisfy TEST. +

+ +
+ +
+
Function: COPY-LIST (list)
+

Package:LISP +

+

Returns a new copy of LIST. +

+ +
+ +
+
Function: LAST (list)
+

Package:LISP +

+

Returns the last cons in LIST +

+ +
+ +
+
Function: CAAAR (x)
+

Package:LISP +

+

Equivalent to (CAR (CAR (CAR X))). +

+ +
+ +
+
Function: LIST-LENGTH (list)
+

Package:LISP +

+

Returns the length of LIST, or NIL if LIST is circular. +

+ +
+ +
+
Function: CDDDR (x)
+

Package:LISP +

+

Equivalent to (CDR (CDR (CDR X))). +

+ +
+ +
+
Function: INTERSECTION (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns the intersection of List1 and List2. +

+ +
+ +
+
Function: NSUBST (new old tree &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Substitutes NEW for subtrees in TREE that match OLD. +

+ +
+ +
+
Function: REVAPPEND (x y)
+

Package:LISP +

+

Equivalent to (APPEND (REVERSE X) Y) +

+ +
+ +
+
Function: CDAR (x)
+

Package:LISP +

+

Equivalent to (CDR (CAR X)). +

+ +
+ +
+
Function: CADR (x)
+

Package:LISP +

+

Equivalent to (CAR (CDR X)). +

+ +
+ +
+
Function: REST (x)
+

Package:LISP +

+

Equivalent to (CDR X). +

+ +
+ +
+
Function: NSET-EXCLUSIVE-OR (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns a list with elements which appear but once in LIST1 and LIST2. +

+ +
+ +
+
Function: ACONS (key datum alist)
+

Package:LISP +

+

Constructs a new alist by adding the pair (KEY . DATUM) to ALIST. +

+ +
+ +
+
Function: SUBST-IF-NOT (new test tree &key (key #'identity))
+

Package:LISP +

+

Substitutes NEW for subtrees of TREE that do not satisfy TEST. +

+ +
+ +
+
Function: RPLACA (x y)
+

Package:LISP +

+

Replaces the car of X with Y, and returns the modified X. +

+ +
+ +
+
Function: SECOND (x)
+

Package:LISP +

+

Equivalent to (CADR X). +

+ +
+ +
+
Function: NUNION (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns the union of LIST1 and LIST2. LIST1 and/or LIST2 may be destroyed. +

+ +
+ +
+
Function: BUTLAST (list &optional (n 1))
+

Package:LISP +

+

Creates and returns a list with the same elements as LIST but without the +last N elements. +

+ +
+ +
+
Function: COPY-ALIST (alist)
+

Package:LISP + Returns a new copy of ALIST. +

+ +
+ +
+
Function: SIXTH (x)
+

Package:LISP + Equivalent to (CADR (CDDDDR X)). +

+ +
+ +
+
Function: CAAAAR (x)
+

Package:LISP +

+

Equivalent to (CAR (CAR (CAR (CAR X)))). +

+ +
+ +
+
Function: CDDDAR (x)
+

Package:LISP +

+

Equivalent to (CDR (CDR (CDR (CAR X)))). +

+ +
+ +
+
Function: CDDADR (x)
+

Package:LISP +

+

Equivalent to (CDR (CDR (CAR (CDR X)))). +

+ +
+ +
+
Function: CDADDR (x)
+

Package:LISP +

+

Equivalent to (CDR (CAR (CDR (CDR X)))). +

+ +
+ +
+
Function: CADDDR (x)
+

Package:LISP +

+

Equivalent to (CAR (CDR (CDR (CDR X)))). +

+ +
+ +
+
Function: FOURTH (x)
+

Package:LISP +

+

Equivalent to (CADDDR X). +

+ +
+ +
+
Function: NSUBLIS (alist tree &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Substitutes from ALIST for subtrees of TREE. +

+ +
+ +
+
Function: SUBST-IF (new test tree &key (key #'identity))
+

Package:LISP +

+

Substitutes NEW for subtrees of TREE that satisfy TEST. +

+ +
+ +
+
Function: NSET-DIFFERENCE (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns a list of elements of LIST1 that do not appear in LIST2. LIST1 may +be destroyed. +

+ +
+ +
+
Special Form: POP
+

Package:LISP +

+

Syntax: +

+
(pop place)
+
+ +

Pops one item off the front of the list in PLACE and returns it. +

+ +
+ +
+
Special Form: PUSH
+

Package:LISP +

+

Syntax: +

+
(push item place)
+
+ +

Conses ITEM onto the list in PLACE, and returns the new list. +

+ +
+ +
+
Function: CDAAR (x)
+

Package:LISP +

+

Equivalent to (CDR (CAR (CAR X))). +

+ +
+ +
+
Function: CADAR (x)
+

Package:LISP +

+

Equivalent to (CAR (CDR (CAR X))). +

+ +
+ +
+
Function: CAADR (x)
+

Package:LISP +

+

Equivalent to (CAR (CAR (CDR X))). +

+ +
+ +
+
Function: FIRST (x)
+

Package:LISP +

+

Equivalent to (CAR X). +

+ +
+ +
+
Function: SUBST (new old tree &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Substitutes NEW for subtrees of TREE that match OLD. +

+ +
+ +
+
Function: ADJOIN (item list &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Adds ITEM to LIST unless ITEM is already a member of LIST. +

+ +
+ +
+
Function: MAPCON (fun list &rest more-lists)
+

Package:LISP +

+

Applies FUN to successive cdrs of LISTs, NCONCs the results, and returns it. +

+ +
+ +
+
Macro: PUSHNEW
+

Package:LISP +

+

Syntax: +

+
(pushnew item place {keyword value}*)
+
+ +

If ITEM is already in the list stored in PLACE, does nothing. Else, conses +ITEM onto the list. Returns NIL. If no KEYWORDs are supplied, each element +in the list is compared with ITEM by EQL, but the comparison can be controlled +by supplying keywords :TEST, :TEST-NOT, and/or :KEY. +

+ +
+ +
+
Function: SET-EXCLUSIVE-OR (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns a list of elements appearing exactly once in LIST1 and LIST2. +

+ +
+ +
+
Function: TREE-EQUAL (x y &key (test #'eql) test-not)
+

Package:LISP +

+

Returns T if X and Y are isomorphic trees with identical leaves. +

+ +
+ +
+
Function: CDDR (x)
+

Package:LISP +

+

Equivalent to (CDR (CDR X)). +

+ +
+ +
+
Function: GETF (place indicator &optional (default nil))
+

Package:LISP +

+

Searches the property list stored in Place for an indicator EQ to Indicator. +If one is found, the corresponding value is returned, else the Default is +returned. +

+ +
+ +
+
Function: LDIFF (list sublist)
+

Package:LISP +

+

Returns a new list, whose elements are those of LIST that appear before +SUBLIST. If SUBLIST is not a tail of LIST, a copy of LIST is returned. +

+ +
+ +
+
Function: UNION (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns the union of LIST1 and LIST2. +

+ +
+ +
+
Function: ASSOC-IF-NOT (test alist)
+

Package:LISP +

+

Returns the first pair in ALIST whose car does not satisfy TEST. +

+ +
+ +
+
Function: RPLACD (x y)
+

Package:LISP +

+

Replaces the cdr of X with Y, and returns the modified X. +

+ +
+ +
+
Function: MEMBER-IF-NOT (test list &key (key #'identity))
+

Package:LISP +

+

Returns the tail of LIST beginning with the first element not satisfying +TEST. +

+ +
+ +
+
Function: CAR (list)
+

Package:LISP +

+

Returns the car of LIST. Returns NIL if LIST is NIL. +

+ +
+ +
+
Function: ENDP (x)
+

Package:LISP +

+

Returns T if X is NIL. Returns NIL if X is a cons. Otherwise, signals an +error. +

+ +
+ +
+
Function: LIST* (arg &rest others)
+

Package:LISP +

+

Returns a list of its arguments with the last cons being a dotted pair of +the next to the last argument and the last argument. +

+ +
+ +
+
Function: NINTH (x)
+

Package:LISP +

+

Equivalent to (CAR (CDDDDR (CDDDDR X))). +

+ +
+ +
+
Function: CDAAAR (x)
+

Package:LISP +

+

Equivalent to (CDR (CAR (CAR (CAR X)))). +

+ +
+ +
+
Function: CADAAR (x)
+

Package:LISP +

+

Equivalent to (CAR (CDR (CAR (CAR X)))). +

+ +
+ +
+
Function: CAADAR (x)
+

Package:LISP +

+

Equivalent to (CAR (CAR (CDR (CAR X)))). +

+ +
+ +
+
Function: CAAADR (x)
+

Package:LISP +

+

Equivalent to (CAR (CAR (CAR (CDR X)))). +

+ +
+ +
+
Function: CDDDDR (x)
+

Package:LISP +

+

Equivalent to (CDR (CDR (CDR (CDR X)))). +

+ +
+ +
+
Function: SUBLIS (alist tree &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Substitutes from ALIST for subtrees of TREE nondestructively. +

+ +
+ +
+
Function: RASSOC-IF-NOT (predicate alist)
+

Package:LISP +

+

Returns the first cons in ALIST whose cdr does not satisfy PREDICATE. +

+ +
+ +
+
Function: NRECONC (x y)
+

Package:LISP +

+

Equivalent to (NCONC (NREVERSE X) Y). +

+ +
+ +
+
Function: MAPLIST (fun list &rest more-lists)
+

Package:LISP +

+

Applies FUN to successive cdrs of LISTs and returns the results as a list. +

+ +
+ +
+
Function: SET-DIFFERENCE (list1 list2 &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns a list of elements of LIST1 that do not appear in LIST2. +

+ +
+ +
+
Function: ASSOC-IF (test alist)
+

Package:LISP +

+

Returns the first pair in ALIST whose car satisfies TEST. +

+ +
+ +
+
Function: GET-PROPERTIES (place indicator-list)
+

Package:LISP +

+

Looks for the elements of INDICATOR-LIST in the property list stored in PLACE. +If found, returns the indicator, the value, and T as multiple-values. If not, +returns NILs as its three values. +

+ +
+ +
+
Function: MEMBER-IF (test list &key (key #'identity))
+

Package:LISP +

+

Returns the tail of LIST beginning with the first element satisfying TEST. +

+ +
+ +
+
Function: COPY-TREE (object)
+

Package:LISP +

+

Recursively copies conses in OBJECT and returns the result. +

+ +
+ +
+
Function: ATOM (x)
+

Package:LISP +

+

Returns T if X is not a cons; NIL otherwise. +

+ +
+ +
+
Function: CDDAR (x)
+

Package:LISP +

+

Equivalent to (CDR (CDR (CAR X))). +

+ +
+ +
+
Function: CDADR (x)
+

Package:LISP +

+

Equivalent to (CDR (CAR (CDR X))). +

+ +
+ +
+
Function: CADDR (x)
+

Package:LISP +

+

Equivalent to (CAR (CDR (CDR X))). +

+ +
+ +
+
Function: ASSOC (item alist &key (test #'eql) test-not)
+

Package:LISP +

+

Returns the first pair in ALIST whose car is equal (in the sense of TEST) to +ITEM. +

+ +
+ +
+
Function: APPEND (&rest lists)
+

Package:LISP +

+

Constructs a new list by concatenating its arguments. +

+ +
+ +
+
Function: MEMBER (item list &key (test #'eql) test-not (key #'identity))
+

Package:LISP +

+

Returns the tail of LIST beginning with the first ITEM. +

+ +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Low-Level-Debug-Functions.html b/info/gcl-si/Low-Level-Debug-Functions.html new file mode 100644 index 0000000..14342bf --- /dev/null +++ b/info/gcl-si/Low-Level-Debug-Functions.html @@ -0,0 +1,72 @@ + + + + + +Low Level Debug Functions (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: Debugging   [Contents][Index]

+
+
+

18.2 Low Level Debug Functions

+ +

Use the following functions to directly access GCL stacks. +

+
(SI:VS i)	Returns the i-th entity in VS.
+(SI:IHS-VS i)	Returns the VS index of the i-th entity in IHS.
+(SI:IHS-FUN i)	Returns the function of the i-th entity in IHS.
+(SI:FRS-VS i)	Returns the VS index of the i-th entity in FRS.
+(SI:FRS-BDS i)	Returns the BDS index of the i-th entity in FRS.
+(SI:FRS-IHS i)	Returns the IHS index of the i-th entity in FRS.
+(SI:BDS-VAR i)	Returns the symbol of the i-th entity in BDS.
+(SI:BDS-VAL i)	Returns the value of the i-th entity in BDS.
+
+(SI:SUPER-GO i tag)
+	Jumps to the specified tag established by the TAGBODY frame at
+	FRS[i].  Both arguments are evaluated.  If FRS[i] happens to be
+	a non-TAGBODY frame, then (THROW (SI:IHS-TAG i) (VALUES)) is
+	performed.
+
+ + + + + + + diff --git a/info/gcl-si/Low-Level-X-Interface.html b/info/gcl-si/Low-Level-X-Interface.html new file mode 100644 index 0000000..845597e --- /dev/null +++ b/info/gcl-si/Low-Level-X-Interface.html @@ -0,0 +1,67 @@ + + + + + +Low Level X Interface (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: Miscellaneous   [Contents][Index]

+
+
+

19.3 Low Level X Interface

+ +

A sample program for drawing things on X windows from lisp +is included in the file gcl/lsp/littleXlsp.lsp +

+

That routine invokes the corresponding C routines in XLIB. +So in order to use it you must ‘faslink’ in the X routines. +Directions are given at the beginning of the lisp file, +for either building them into the image or using faslink. +

+

This program is also a good tutorial on invoking C from lisp. +

+

See also defentry and faslink. +

+ + + + + + + diff --git a/info/gcl-si/Miscellaneous.html b/info/gcl-si/Miscellaneous.html new file mode 100644 index 0000000..a487b4b --- /dev/null +++ b/info/gcl-si/Miscellaneous.html @@ -0,0 +1,62 @@ + + + + + +Miscellaneous (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

19 Miscellaneous

+ + + + + +
• Environment   +
• Inititialization   +
• Low Level X Interface   +
+ + + + + + diff --git a/info/gcl-si/Numbers.html b/info/gcl-si/Numbers.html new file mode 100644 index 0000000..5304e9a --- /dev/null +++ b/info/gcl-si/Numbers.html @@ -0,0 +1,1548 @@ + + + + + +Numbers (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

1 Numbers

+ + +
+
Function: SIGNUM (number)
+

Package:LISP +

+

If NUMBER is zero, returns NUMBER; else returns (/ NUMBER (ABS NUMBER)). +

+ +
+ +
+
Function: LOGNOT (integer)
+

Package:LISP +

+

Returns the bit-wise logical NOT of INTEGER. +

+ +
+ +
+
Constant: MOST-POSITIVE-SHORT-FLOAT
+

Package:LISP +The short-float closest in value to positive infinity. +

+ +
+ +
+
Function: INTEGER-DECODE-FLOAT (float)
+

Package:LISP +

+

Returns, as three values, the integer interpretation of significand F, +the exponent E, and the sign S of the given float, so that + E + FLOAT = S * F * B where B = (FLOAT-RADIX FLOAT) +

+

F is a non-negative integer, E is an integer, and S is either 1 or -1. +

+ +
+ +
+
Function: MINUSP (number)
+

Package:LISP +

+

Returns T if NUMBER < 0; NIL otherwise. +

+ +
+ +
+
Function: LOGORC1 (integer1 integer2)
+

Package:LISP +

+

Returns the logical OR of (LOGNOT INTEGER1) and INTEGER2. +

+ +
+ +
+
Constant: MOST-NEGATIVE-SINGLE-FLOAT
+

Package:LISP +Same as MOST-NEGATIVE-LONG-FLOAT. +

+ +
+ +
+
Constant: BOOLE-C1
+

Package:LISP +Makes BOOLE return the complement of INTEGER1. +

+ +
+ +
+
Constant: LEAST-POSITIVE-SHORT-FLOAT
+

Package:LISP +The positive short-float closest in value to zero. +

+ +
+ +
+
Function: BIT-NAND (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical NAND on the elements of BIT-ARRAY1 and +BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+
+ +
+
Function: INT-CHAR (integer)
+

Package:LISP +

+

Performs the inverse of CHAR-INT. Equivalent to CODE-CHAR in GCL. +

+ +
+ +
+
Function: CHAR-INT (char)
+

Package:LISP +

+

Returns the font, bits, and code attributes as a single non-negative integer. +Equivalent to CHAR-CODE in GCL. +

+ +
+ +
+
Constant: LEAST-NEGATIVE-SINGLE-FLOAT
+

Package:LISP +Same as LEAST-NEGATIVE-LONG-FLOAT. +

+ +
+ +
+
Function: /= (number &rest more-numbers)
+

Package:LISP +

+

Returns T if no two of its arguments are numerically equal; NIL otherwise. +

+ +
+ +
+
Function: LDB-TEST (bytespec integer)
+

Package:LISP +

+

Returns T if at least one of the bits in the specified bytes of INTEGER is 1; +NIL otherwise. +

+ +
+ +
+
Constant: CHAR-CODE-LIMIT
+

Package:LISP +The upper exclusive bound on values produced by CHAR-CODE. +

+ +
+ +
+
Function: RATIONAL (number)
+

Package:LISP +

+

Converts NUMBER into rational accurately and returns it. +

+ +
+ +
+
Constant: PI
+

Package:LISP +The floating-point number that is appropriately equal to the ratio of the +circumference of the circle to the diameter. +

+ +
+ +
+
Function: SIN (radians)
+

Package:LISP +

+

Returns the sine of RADIANS. +

+ +
+ +
+
Constant: BOOLE-ORC2
+

Package:LISP +Makes BOOLE return LOGORC2 of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: NUMERATOR (rational)
+

Package:LISP +

+

Returns as an integer the numerator of the given rational number. +

+ +
+ +
+
Function: MASK-FIELD (bytespec integer)
+

Package:LISP +

+

Extracts the specified byte from INTEGER. +

+ +
+ +
+
Special Form: INCF
+

Package:LISP +

+

Syntax: +

+
(incf place [delta])
+
+ +

Adds the number produced by DELTA (which defaults to 1) to the number +in PLACE. +

+ +
+ +
+
Function: SINH (number)
+

Package:LISP +

+

Returns the hyperbolic sine of NUMBER. +

+ +
+ +
+
Function: PHASE (number)
+

Package:LISP +

+

Returns the angle part of the polar representation of a complex number. +For non-complex numbers, this is 0. +

+ +
+ +
+
Function: BOOLE (op integer1 integer2)
+

Package:LISP +

+

Returns an integer produced by performing the logical operation specified by +OP on the two integers. OP must be the value of one of the following +constants: + BOOLE-CLR BOOLE-C1 BOOLE-XOR BOOLE-ANDC1 + BOOLE-SET BOOLE-C2 BOOLE-EQV BOOLE-ANDC2 + BOOLE-1 BOOLE-AND BOOLE-NAND BOOLE-ORC1 + BOOLE-2 BOOLE-IOR BOOLE-NOR BOOLE-ORC2 +See the variable docs of these constants for their operations. +

+ +
+ +
+
Constant: SHORT-FLOAT-EPSILON
+

Package:LISP +The smallest positive short-float that satisfies + (not (= (float 1 e) (+ (float 1 e) e))). +

+ +
+ +
+
Function: LOGORC2 (integer1 integer2)
+

Package:LISP +

+

Returns the logical OR of INTEGER1 and (LOGNOT INTEGER2). +

+ +
+ +
+
Constant: BOOLE-C2
+

Package:LISP +Makes BOOLE return the complement of INTEGER2. +

+ +
+ +
+
Function: REALPART (number)
+

Package:LISP +

+

Extracts the real part of NUMBER. +

+ +
+ + +
+
Constant: BOOLE-CLR
+

Package:LISP +Makes BOOLE return 0. +

+ +
+ +
+
Constant: BOOLE-IOR
+

Package:LISP +Makes BOOLE return LOGIOR of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: FTRUNCATE (number &optional (divisor 1))
+

Package:LISP +

+

Values: (quotient remainder) +Same as TRUNCATE, but returns first value as a float. +

+ +
+ +
+
Function: EQL (x y)
+

Package:LISP +

+

Returns T if X and Y are EQ, or if they are numbers of the same type with +the same value, or if they are character objects that represent the same +character. Returns NIL otherwise. +

+ +
+ +
+
Function: LOG (number &optional base)
+

Package:LISP +

+

Returns the logarithm of NUMBER in the base BASE. BASE defaults to the base +of natural logarithms. +

+ +
+ +
+
Constant: DOUBLE-FLOAT-NEGATIVE-EPSILON
+

Package:LISP +Same as LONG-FLOAT-NEGATIVE-EPSILON. +

+ +
+ +
+
Function: LOGIOR (&rest integers)
+

Package:LISP +

+

Returns the bit-wise INCLUSIVE OR of its arguments. +

+ +
+ +
+
Constant: MOST-NEGATIVE-DOUBLE-FLOAT
+

Package:LISP +Same as MOST-NEGATIVE-LONG-FLOAT. +

+ +
+ +
+
Function: / (number &rest more-numbers)
+

Package:LISP +

+

Divides the first NUMBER by each of the subsequent NUMBERS. +With one arg, returns the reciprocal of the number. +

+ +
+ +
+
Variable: *RANDOM-STATE*
+

Package:LISP +The default random-state object used by RAMDOM. +

+ +
+ +
+
Function: 1+ (number)
+

Package:LISP +

+

Returns NUMBER + 1. +

+ +
+ +
+
Constant: LEAST-NEGATIVE-DOUBLE-FLOAT
+

Package:LISP +Same as LEAST-NEGATIVE-LONG-FLOAT. +

+ +
+ +
+
Function: FCEILING (number &optional (divisor 1))
+

Package:LISP +

+

Same as CEILING, but returns a float as the first value. +

+ +
+ +
+
Constant: MOST-POSITIVE-FIXNUM
+

Package:LISP +The fixnum closest in value to positive infinity. +

+ +
+ +
+
Function: BIT-ANDC1 (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical ANDC1 on the elements of BIT-ARRAY1 and +BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: TAN (radians)
+

Package:LISP +

+

Returns the tangent of RADIANS. +

+ +
+ +
+
Constant: BOOLE-NAND
+

Package:LISP +Makes BOOLE return LOGNAND of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: TANH (number)
+

Package:LISP +

+

Returns the hyperbolic tangent of NUMBER. +

+ +
+ +
+
Function: ASIN (number)
+

Package:LISP +

+

Returns the arc sine of NUMBER. +

+ +
+ +
+
Function: BYTE (size position)
+

Package:LISP +

+

Returns a byte specifier. In GCL, a byte specifier is represented by +a dotted pair (<size> . <position>). +

+ +
+ +
+
Function: ASINH (number)
+

Package:LISP +

+

Returns the hyperbolic arc sine of NUMBER. +

+ +
+ +
+
Constant: MOST-POSITIVE-LONG-FLOAT
+

Package:LISP +The long-float closest in value to positive infinity. +

+ +
+ +
+
Macro: SHIFTF
+

Package:LISP +

+

Syntax: +

+
(shiftf {place}+ newvalue)
+
+ +

Evaluates all PLACEs and NEWVALUE in turn, then assigns the value of each +form to the PLACE on its left. Returns the original value of the leftmost +form. +

+ +
+ +
+
Constant: LEAST-POSITIVE-LONG-FLOAT
+

Package:LISP +The positive long-float closest in value to zero. +

+ +
+ +
+
Function: DEPOSIT-FIELD (newbyte bytespec integer)
+

Package:LISP +

+

Returns an integer computed by replacing the specified byte of INTEGER with +the specified byte of NEWBYTE. +

+ +
+ +
+
Function: BIT-AND (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical AND on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: LOGNAND (integer1 integer2)
+

Package:LISP +

+

Returns the complement of the logical AND of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: BYTE-POSITION (bytespec)
+

Package:LISP +

+

Returns the position part (in GCL, the cdr part) of the byte specifier. +

+ +
+ +
+
Macro: ROTATEF
+

Package:LISP +

+

Syntax: +

+
(rotatef {place}*)
+
+ +

Evaluates PLACEs in turn, then assigns to each PLACE the value of the form to +its right. The rightmost PLACE gets the value of the leftmost PLACE. +Returns NIL always. +

+ +
+ +
+
Function: BIT-ANDC2 (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical ANDC2 on the elements of BIT-ARRAY1 and +BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: TRUNCATE (number &optional (divisor 1))
+

Package:LISP +

+

Values: (quotient remainder) +Returns NUMBER/DIVISOR as an integer, rounded toward 0. The second returned +value is the remainder. +

+ +
+ +
+
Constant: BOOLE-EQV
+

Package:LISP +Makes BOOLE return LOGEQV of INTEGER1 and INTEGER2. +

+ +
+ +
+
Constant: BOOLE-SET
+

Package:LISP +Makes BOOLE return -1. +

+ +
+ +
+
Function: LDB (bytespec integer)
+

Package:LISP +

+

Extracts and right-justifies the specified byte of INTEGER, and returns the +result. +

+ +
+ +
+
Function: BYTE-SIZE (bytespec)
+

Package:LISP +

+

Returns the size part (in GCL, the car part) of the byte specifier. +

+ +
+ +
+
Constant: SHORT-FLOAT-NEGATIVE-EPSILON
+

Package:LISP +The smallest positive short-float that satisfies + (not (= (float 1 e) (- (float 1 e) e))). +

+ +
+ +
+
Function: REM (number divisor)
+

Package:LISP +

+

Returns the second value of (TRUNCATE NUMBER DIVISOR). +

+ +
+ +
+
Function: MIN (number &rest more-numbers)
+

Package:LISP +

+

Returns the least of its arguments. +

+ +
+ +
+
Function: EXP (number)
+

Package:LISP +

+

Calculates e raised to the power NUMBER, where e is the base of natural +logarithms. +

+ +
+ +
+
Function: DECODE-FLOAT (float)
+

Package:LISP +

+

Returns, as three values, the significand F, the exponent E, and the sign S +of the given float, so that + E + FLOAT = S * F * B where B = (FLOAT-RADIX FLOAT) +

+

S and F are floating-point numbers of the same float format as FLOAT, and E +is an integer. +

+ + +
+ +
+
Constant: LONG-FLOAT-EPSILON
+

Package:LISP +The smallest positive long-float that satisfies + (not (= (float 1 e) (+ (float 1 e) e))). +

+ +
+ +
+
Function: FROUND (number &optional (divisor 1))
+

Package:LISP +

+

Same as ROUND, but returns first value as a float. +

+ +
+ +
+
Function: LOGEQV (&rest integers)
+

Package:LISP +

+

Returns the bit-wise EQUIVALENCE of its arguments. +

+ +
+ +
+
Constant: MOST-NEGATIVE-SHORT-FLOAT
+

Package:LISP +The short-float closest in value to negative infinity. +

+ +
+ +
+
Function: BIT-NOR (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical NOR on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: CEILING (number &optional (divisor 1))
+

Package:LISP +

+

Returns the smallest integer not less than or NUMBER/DIVISOR. Returns the +remainder as the second value. +

+ +
+ +
+
Constant: LEAST-NEGATIVE-SHORT-FLOAT
+

Package:LISP +The negative short-float closest in value to zero. +

+ +
+ +
+
Function: 1- (number)
+

Package:LISP +

+

Returns NUMBER - 1. +

+ +
+ +
+
Function: <= (number &rest more-numbers)
+

Package:LISP +

+

Returns T if arguments are in strictly non-decreasing order; NIL otherwise. +

+ +
+ +
+
Function: IMAGPART (number)
+

Package:LISP +

+

Extracts the imaginary part of NUMBER. +

+ +
+ +
+
Function: INTEGERP (x)
+

Package:LISP +

+

Returns T if X is an integer (fixnum or bignum); NIL otherwise. +

+ +
+ +
+
Function: ASH (integer count)
+

Package:LISP +

+

Shifts INTEGER left by COUNT places. Shifts right if COUNT is negative. +

+ +
+ +
+
Function: LCM (integer &rest more-integers)
+

Package:LISP +

+

Returns the least common multiple of the arguments. +

+ +
+ +
+
Function: COS (radians)
+

Package:LISP +

+

Returns the cosine of RADIANS. +

+ +
+ +
+
Special Form: DECF
+

Package:LISP +

+

Syntax: +

+
(decf place [delta])
+
+

Subtracts the number +produced by DELTA (which defaults to 1) from the number in +PLACE. +

+ +
+ +
+
Function: ATAN (x &optional (y 1))
+

Package:LISP + Returns the arc tangent of +X/Y. +

+ +
+ +
+
Constant: BOOLE-ANDC1
+

Package:LISP +Makes BOOLE return LOGANDC1 of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: COSH (number)
+

Package:LISP + Returns the hyperbolic cosine of +NUMBER. +

+ +
+ +
+
Function: FLOAT-RADIX (float)
+

Package:LISP +

+

Returns the representation radix (or base) of the floating-point +number. +

+ +
+ +
+
Function: ATANH (number)
+

Package:LISP +

+

Returns the hyperbolic arc tangent of NUMBER. +

+ +
+ +
+
Function: EVENP (integer)
+

Package:LISP + Returns T +if INTEGER is even. Returns NIL if INTEGER is odd. +

+ +
+ +
+
Function: ZEROP (number)
+

Package:LISP + Returns T if NUMBER = 0; NIL +otherwise. +

+ +
+ +
+
Function: FLOATP (x)
+

Package:LISP +

+

Returns T if X is a floating-point number; NIL otherwise. +

+ +
+ +
+
Function: SXHASH (object)
+

Package:LISP +

+

Computes a hash code for OBJECT and returns it as an integer. +

+ +
+ +
+
Constant: BOOLE-1
+

Package:LISP +Makes BOOLE return INTEGER1. +

+ +
+ +
+
Constant: MOST-POSITIVE-SINGLE-FLOAT
+

Package:LISP +Same as MOST-POSITIVE-LONG-FLOAT. +

+ +
+ +
+
Function: LOGANDC1 (integer1 integer2)
+

Package:LISP +

+

Returns the logical AND of (LOGNOT INTEGER1) and INTEGER2. +

+ +
+ +
+
Constant: LEAST-POSITIVE-SINGLE-FLOAT
+

Package:LISP +Same as LEAST-POSITIVE-LONG-FLOAT. +

+ +
+ +
+
Function: COMPLEXP (x)
+

Package:LISP +

+

Returns T if X is a complex number; NIL otherwise. +

+ +
+ +
+
Constant: BOOLE-AND
+

Package:LISP +Makes BOOLE return LOGAND of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: MAX (number &rest more-numbers)
+

Package:LISP +

+

Returns the greatest of its arguments. +

+ +
+ +
+
Function: FLOAT-SIGN (float1 &optional (float2 (float 1 float1)))
+

Package:LISP +

+

Returns a floating-point number with the same sign as FLOAT1 and with the +same absolute value as FLOAT2. +

+ +
+ +
+
Constant: BOOLE-ANDC2
+

Package:LISP +Makes BOOLE return LOGANDC2 of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: DENOMINATOR (rational)
+

Package:LISP +

+

Returns the denominator of RATIONAL as an integer. +

+ +
+ +
+
Function: FLOAT (number &optional other)
+

Package:LISP +

+

Converts a non-complex number to a floating-point number. If NUMBER is +already a float, FLOAT simply returns NUMBER. Otherwise, the format of +the returned float depends on OTHER; If OTHER is not provided, FLOAT returns +a SINGLE-FLOAT. If OTHER is provided, the result is in the same float format +as OTHER’s. +

+ +
+ +
+
Function: ROUND (number &optional (divisor 1))
+

Package:LISP +

+

Rounds NUMBER/DIVISOR to nearest integer. The second returned value is the +remainder. +

+ +
+ +
+
Function: LOGAND (&rest integers)
+

Package:LISP +

+

Returns the bit-wise AND of its arguments. +

+ +
+ +
+
Constant: BOOLE-2
+

Package:LISP +Makes BOOLE return INTEGER2. +

+ +
+ +
+
Function: * (&rest numbers)
+

Package:LISP +

+

Returns the product of its arguments. With no args, returns 1. +

+ +
+ +
+
Function: < (number &rest more-numbers)
+

Package:LISP +

+

Returns T if its arguments are in strictly increasing order; NIL otherwise. +

+ +
+ +
+
Function: COMPLEX (realpart &optional (imagpart 0))
+

Package:LISP +

+

Returns a complex number with the given real and imaginary parts. +

+ +
+ +
+
Constant: SINGLE-FLOAT-EPSILON
+

Package:LISP +Same as LONG-FLOAT-EPSILON. +

+ +
+ +
+
Function: LOGANDC2 (integer1 integer2)
+

Package:LISP +

+

Returns the logical AND of INTEGER1 and (LOGNOT INTEGER2). +

+ +
+ +
+
Function: INTEGER-LENGTH (integer)
+

Package:LISP +

+

Returns the number of significant bits in the absolute value of INTEGER. +

+ +
+ +
+
Constant: MOST-NEGATIVE-FIXNUM
+

Package:LISP +The fixnum closest in value to negative infinity. +

+ +
+ +
+
Constant: LONG-FLOAT-NEGATIVE-EPSILON
+

Package:LISP +The smallest positive long-float that satisfies + (not (= (float 1 e) (- (float 1 e) e))). +

+ +
+ +
+
Function: >= (number &rest more-numbers)
+

Package:LISP +

+

Returns T if arguments are in strictly non-increasing order; NIL otherwise. +

+ +
+ +
+
Constant: BOOLE-NOR
+

Package:LISP +Makes BOOLE return LOGNOR of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: ACOS (number)
+

Package:LISP +

+

Returns the arc cosine of NUMBER. +

+ +
+ +
+
Function: MAKE-RANDOM-STATE (&optional (state *random-state*))
+

Package:LISP +

+

Creates and returns a copy of the specified random state. If STATE is NIL, +then the value of *RANDOM-STATE* is used. If STATE is T, then returns a +random state object generated from the universal time. +

+ +
+ +
+
Function: EXPT (base-number power-number)
+

Package:LISP +

+

Returns BASE-NUMBER raised to the power POWER-NUMBER. +

+ +
+ +
+
Function: SQRT (number)
+

Package:LISP +

+

Returns the principal square root of NUMBER. +

+ +
+ +
+
Function: SCALE-FLOAT (float integer)
+

Package:LISP +

+

Returns (* FLOAT (expt (float-radix FLOAT) INTEGER)). +

+ +
+ +
+
Function: ACOSH (number)
+

Package:LISP +

+

Returns the hyperbolic arc cosine of NUMBER. +

+ +
+ +
+
Constant: MOST-NEGATIVE-LONG-FLOAT
+

Package:LISP +The long-float closest in value to negative infinity. +

+ +
+ +
+
Constant: LEAST-NEGATIVE-LONG-FLOAT
+

Package:LISP +The negative long-float closest in value to zero. +

+ +
+ +
+
Function: FFLOOR (number &optional (divisor 1))
+

Package:LISP +

+

Same as FLOOR, but returns a float as the first value. +

+ +
+ +
+
Function: LOGNOR (integer1 integer2)
+

Package:LISP +

+

Returns the complement of the logical OR of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: PARSE-INTEGER (string &key (start 0) (end (length string)) (radix 10) (junk-allowed nil))
+

Package:LISP +

+

Parses STRING for an integer and returns it. +

+ +
+ +
+
Function: + (&rest numbers)
+

Package:LISP +

+

Returns the sum of its arguments. With no args, returns 0. +

+ +
+ +
+
Function: = (number &rest more-numbers)
+

Package:LISP +

+

Returns T if all of its arguments are numerically equal; NIL otherwise. +

+ +
+ +
+
Function: NUMBERP (x)
+

Package:LISP +

+

Returns T if X is any kind of number; NIL otherwise. +

+ +
+ +
+
Constant: MOST-POSITIVE-DOUBLE-FLOAT
+

Package:LISP +Same as MOST-POSITIVE-LONG-FLOAT. +

+ +
+ +
+
Function: LOGTEST (integer1 integer2)
+

Package:LISP +

+

Returns T if LOGAND of INTEGER1 and INTEGER2 is not zero; NIL otherwise. +

+ +
+ +
+
Function: RANDOM-STATE-P (x)
+

Package:LISP +

+

Returns T if X is a random-state object; NIL otherwise. +

+ +
+ +
+
Constant: LEAST-POSITIVE-DOUBLE-FLOAT
+

Package:LISP +Same as LEAST-POSITIVE-LONG-FLOAT. +

+ +
+ +
+
Function: FLOAT-PRECISION (float)
+

Package:LISP +

+

Returns the number of significant radix-B digits used to represent the +significand F of the floating-point number, where B = (FLOAT-RADIX FLOAT). +

+ +
+ +
+
Constant: BOOLE-XOR
+

Package:LISP +Makes BOOLE return LOGXOR of INTEGER1 and INTEGER2. +

+ +
+ +
+
Function: DPB (newbyte bytespec integer)
+

Package:LISP +

+

Returns an integer computed by replacing the specified byte of INTEGER with +NEWBYTE. +

+ +
+ +
+
Function: ABS (number)
+

Package:LISP +

+

Returns the absolute value of NUMBER. +

+ +
+ +
+
Function: CONJUGATE (number)
+

Package:LISP +

+

Returns the complex conjugate of NUMBER. +

+ +
+ +
+
Function: CIS (radians)
+

Package:LISP +

+

Returns e raised to i*RADIANS. +

+ +
+ +
+
Function: ODDP (integer)
+

Package:LISP +

+

Returns T if INTEGER is odd; NIL otherwise. +

+ +
+ +
+
Function: RATIONALIZE (number)
+

Package:LISP +

+

Converts NUMBER into rational approximately and returns it. +

+ +
+ +
+
Function: ISQRT (integer)
+

Package:LISP +

+

Returns the greatest integer less than or equal to the square root of the +given non-negative integer. +

+ +
+ +
+
Function: LOGXOR (&rest integers)
+

Package:LISP +

+

Returns the bit-wise EXCLUSIVE OR of its arguments. +

+ +
+ +
+
Function: > (number &rest more-numbers)
+

Package:LISP +

+

Returns T if its arguments are in strictly decreasing order; NIL otherwise. +

+ +
+ +
+
Function: LOGBITP (index integer)
+

Package:LISP +

+

Returns T if the INDEX-th bit of INTEGER is 1. +

+ +
+ +
+
Constant: DOUBLE-FLOAT-EPSILON
+

Package:LISP +Same as LONG-FLOAT-EPSILON. +

+ +
+ +
+
Function: LOGCOUNT (integer)
+

Package:LISP +

+

If INTEGER is negative, returns the number of 0 bits. Otherwise, returns +the number of 1 bits. +

+ +
+ +
+
Function: GCD (&rest integers)
+

Package:LISP +

+

Returns the greatest common divisor of INTEGERs. +

+ +
+ +
+
Function: RATIONALP (x)
+

Package:LISP +

+

Returns T if X is an integer or a ratio; NIL otherwise. +

+ +
+ +
+
Function: MOD (number divisor)
+

Package:LISP +

+

Returns the second result of (FLOOR NUMBER DIVISOR). +

+ +
+ +
+
Function: MODF (number)
+

Package:SYSTEM +

+

Returns the integer and fractional part of a floating point number mod 1.0. +

+ +
+ +
+
Constant: BOOLE-ORC1
+

Package:LISP +Makes BOOLE return LOGORC1 of INTEGER1 and INTEGER2. +

+ +
+ +
+
Constant: SINGLE-FLOAT-NEGATIVE-EPSILON
+

Package:LISP +Same as LONG-FLOAT-NEGATIVE-EPSILON. +

+ +
+ +
+
Function: FLOOR (number &optional (divisor 1))
+

Package:LISP +

+

Returns the largest integer not larger than the NUMBER divided by DIVISOR. +The second returned value is (- NUMBER (* first-value DIVISOR)). +

+ +
+ +
+
Function: PLUSP (number)
+

Package:LISP +

+

Returns T if NUMBER > 0; NIL otherwise. +

+ +
+ +
+
Function: FLOAT-DIGITS (float)
+

Package:LISP +

+

Returns the number of radix-B digits used to represent the significand F of +the floating-point number, where B = (FLOAT-RADIX FLOAT). +

+ +
+ +
+
Function: RANDOM (number &optional (state *random-state*))
+

Package:LISP +

+

Generates a uniformly distributed pseudo-random number between zero +(inclusive) and NUMBER (exclusive), by using the random state object STATE. +

+ +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Operating-System-Definitions.html b/info/gcl-si/Operating-System-Definitions.html new file mode 100644 index 0000000..dd4e265 --- /dev/null +++ b/info/gcl-si/Operating-System-Definitions.html @@ -0,0 +1,407 @@ + + + + + +Operating System Definitions (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: Operating System   [Contents][Index]

+
+
+

9.2 Operating System Definitions

+ +
+
Function: GET-DECODED-TIME ()
+

Package:LISP +

+

Returns the current time in decoded time format. Returns nine values: second, +minute, hour, date, month, year, day-of-week, daylight-saving-time-p, and +time-zone. +

+ +
+ +
+
Function: HOST-NAMESTRING (pathname)
+

Package:LISP +

+

Returns the host part of PATHNAME as a string. +

+ +
+ +
+
Function: RENAME-FILE (file new-name)
+

Package:LISP +

+

Renames the file FILE to NEW-NAME. FILE may be a string, a pathname, or +a stream. +

+ +
+ +
+
Function: FILE-AUTHOR (file)
+

Package:LISP +

+

Returns the author name of the specified file, as a string. +FILE may be a string or a stream +

+ +
+ +
+
Function: PATHNAME-HOST (pathname)
+

Package:LISP +

+

Returns the host slot of PATHNAME. +

+ +
+ +
+
Function: FILE-POSITION (file-stream &optional position)
+

Package:LISP +

+

Sets the file pointer of the specified file to POSITION, if POSITION is given. +Otherwise, returns the current file position of the specified file. +

+ +
+ +
+
Function: DECODE-UNIVERSAL-TIME (universal-time &optional (timezone -9))
+

Package:LISP +

+

Converts UNIVERSAL-TIME into a decoded time at the TIMEZONE. +Returns nine values: second, minute, hour, date, month (1 - 12), year, +day-of-week (0 - 6), daylight-saving-time-p, and time-zone. +TIMEZONE in GCL defaults to 6, the time zone of Austin, Texas. +

+ +
+ +
+
Function: USER-HOMEDIR-PATHNAME (&optional host)
+

Package:LISP +

+

Returns the home directory of the logged in user as a pathname. HOST +is ignored. +

+ +
+ + +
+
Variable: *MODULES*
+

Package:LISP +A list of names of the modules that have been loaded into GCL. +

+ +
+ +
+
Function: SHORT-SITE-NAME ()
+

Package:LISP +

+

Returns a string that identifies the physical location of the current GCL. +

+ +
+ +
+
Function: DIRECTORY (name)
+

Package:LISP +

+

Returns a list of files that match NAME. NAME may be a string, a pathname, +or a file stream. +

+ +
+ +
+
Function: SOFTWARE-VERSION ()
+

Package:LISP +

+

Returns a string that identifies the software version of the software +under which GCL is currently running. +

+ +
+ +
+
Constant: INTERNAL-TIME-UNITS-PER-SECOND
+

Package:LISP +The number of internal time units that fit into a second. +

+ +
+ +
+
Function: ENOUGH-NAMESTRING (pathname &optional (defaults *default-pathname-defaults*))
+

Package:LISP +

+

Returns a string which uniquely identifies PATHNAME with respect to +DEFAULTS. +

+ +
+ +
+
Function: REQUIRE (module-name &optional (pathname))
+

Package:LISP +

+

If the specified module is not present, then loads the appropriate file(s). +PATHNAME may be a single pathname or it may be a list of pathnames. +

+ +
+ +
+
Function: ENCODE-UNIVERSAL-TIME (second minute hour date month year &optional (timezone ))
+

Package:LISP +

+

Does the inverse operation of DECODE-UNIVERSAL-TIME. +

+ +
+ +
+
Function: LISP-IMPLEMENTATION-VERSION ()
+

Package:LISP +

+

Returns a string that tells you when the current GCL implementation is +brought up. +

+ +
+ +
+
Function: MACHINE-INSTANCE ()
+

Package:LISP +

+

Returns a string that identifies the machine instance of the machine +on which GCL is currently running. +

+ +
+ +
+
Function: ROOM (&optional (x t))
+

Package:LISP +

+

Displays information about storage allocation in the following format. +

+
    +
  • for each type class +
      +
    • the number of pages so-far allocated for the type class +
    • the maximum number of pages for the type class +
    • the percentage of used cells to cells so-far allocated +
    • the number of times the garbage collector has been called to + collect cells of the type class +
    • the implementation types that belongs to the type class +
    +
  • the number of pages actually allocated for contiguous blocks +
  • the maximum number of pages for contiguous blocks +
  • the number of times the garbage collector has been called to collect + contiguous blocks +
  • the number of pages in the hole +
  • the maximum number of pages for relocatable blocks +
  • the number of times the garbage collector has been called to collect + relocatable blocks +
  • the total number of pages allocated for cells +
  • the total number of pages allocated +
  • the number of available pages +
  • the number of pages GCL can use. + +

    The number of times the garbage collector has been called is not shown, +if the number is zero. The optional X is ignored. +

+ +
+ +
+
Function: GET-UNIVERSAL-TIME ()
+

Package:LISP +

+

Returns the current time as a single integer in universal time format. +

+ +
+ +
+
Function: GET-INTERNAL-RUN-TIME ()
+

Package:LISP +

+

Returns the run time in the internal time format. This is useful for +finding CPU usage. If the operating system allows, a second value +containing CPU usage of child processes is returned. +

+ +
+ +
+
Variable: *DEFAULT-PATHNAME-DEFAULTS*
+

Package:LISP +The default pathname-defaults pathname. +

+ +
+ +
+
Function: LONG-SITE-NAME ()
+

Package:LISP +

+

Returns a string that identifies the physical location of the current GCL. +

+ +
+ +
+
Function: DELETE-FILE (file)
+

Package:LISP + Deletes FILE. +

+ +
+ +
+
Function: GET-INTERNAL-REAL-TIME ()
+

Package:LISP +

+

Returns the real time in the internal time format. This is useful for +finding elapsed time. +

+ +
+ +
+
Function: MACHINE-TYPE ()
+

Package:LISP +

+

Returns a string that identifies the machine type of the machine +on which GCL is currently running. +

+ +
+ +
+
Macro: TIME
+

Package:LISP +

+

Syntax: +

+
(time form)
+
+ +

Evaluates FORM and outputs timing statistics on *TRACE-OUTPUT*. +

+ +
+ +
+
Function: SOFTWARE-TYPE ()
+

Package:LISP +

+

Returns a string that identifies the software type of the software +under which GCL is currently running. +

+ +
+ +
+
Function: LISP-IMPLEMENTATION-TYPE ()
+

Package:LISP +

+

Returns a string that tells you that you are using a version of GCL. +

+ +
+ +
+
Function: SLEEP (n)
+

Package:LISP +

+

This function causes execution to be suspended for N seconds. N may +be any non-negative, non-complex number. +

+ +
+ +
+
Function: BREAK-ON-FLOATING-POINT-EXCEPTIONS (&key division-by-zero
+

floating-point-invalid-operation + floating-point-overflow + floating-point-underflow + floating-point-inexact) +Package:SI +

+

Break on the specified IEEE floating point error conditions. With no +arguments, report the exceptions currently trapped. Disable the break +by setting the key to nil, e.g. +

+

> (break-on-floaing-point-exceptions :division-by-zero t) + (DIVISION-BY-ZERO) +

+

> (break-on-floaing-point-exceptions) + (DIVISION-BY-ZERO) +

+

> (break-on-floaing-point-exceptions :division-by-zero nil) + NIL +

+

On some of the most common platforms, the offending instruction will be +disassembled, and the register arguments looked up in the saved context +and reported in as operands. Within the error handler, addresses may be +disassembled, and other registers inspected, using the functions defined +in gcl_fpe.lsp. +

+
+ + +
+
+

+Previous: , Up: Operating System   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Operating-System.html b/info/gcl-si/Operating-System.html new file mode 100644 index 0000000..51ffd14 --- /dev/null +++ b/info/gcl-si/Operating-System.html @@ -0,0 +1,60 @@ + + + + + +Operating System (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

9 Operating System

+ + + + +
• Command Line   +
• Operating System Definitions   +
+ + + + + + diff --git a/info/gcl-si/Regular-Expressions.html b/info/gcl-si/Regular-Expressions.html new file mode 100644 index 0000000..dc071be --- /dev/null +++ b/info/gcl-si/Regular-Expressions.html @@ -0,0 +1,198 @@ + + + + + +Regular Expressions (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: System Definitions   [Contents][Index]

+
+
+

17.1 Regular Expressions

+ +

The function string-match (*Index string-match::) is used to +match a regular expression against a string. If the variable +*case-fold-search* is not nil, case is ignored in the match. +To determine the extent of the match use *Index match-beginning:: and +*Index match-end::. +

+

Regular expressions are implemented using Henry Spencer’s package +(thank you Henry!), and much of the description of regular expressions +below is copied verbatim from his manual entry. Code for delimited +searches, case insensitive searches, and speedups to allow fast +searching of long files was contributed by W. Schelter. The speedups +use an adaptation by Schelter of the Boyer and Moore string search +algorithm to the case of branched regular expressions. These allow +such expressions as ’not_there|really_not’ to be searched for 30 times +faster than in GNU emacs (1995), and 200 times faster than in the +original Spencer method. Expressions such as [a-u]bcdex get a speedup +of 60 and 194 times respectively. This is based on searching a string +of 50000 characters (such as the file tk.lisp). +

+
    +
  • A regular expression is a string containing zero or more branches which are separated by |. A match of the regular expression against a string is simply a match of the string with one of the branches. +
  • Each branch consists of zero or more pieces, concatenated. A matching +string must contain an initial substring matching the first piece, immediately +followed by a second substring matching the second piece and so on. +
  • Each piece is an atom optionally followed by +, *, or ?. +
  • An atom followed by + matches a sequence of 1 or more matches of the atom. +
  • An atom followed by * matches a sequence of 0 or more matches of the atom. +
  • An atom followed by ? matches a match of the atom, or the null string. +
  • An atom is +
      +
    • - a regular expression in parentheses matching a match for the regular expression +
    • - a range see below +
    • - a . matching any single character +
    • - a ^ matching the null string at the beginning of the input string +
    • - a $ matching the null string at the end of the input string +
    • - a \ followed by a single character matching that character +
    • - a single character with no other significance +(matching that character). +
    +
  • A range is a sequence of characters enclosed in []. +It normally matches any single character from the sequence. +
      +
    • - If the sequence begins with ^, +it matches any single character not from the rest of the sequence. +
    • - If two characters in the sequence are separated by -, this is shorthand +for the full list of ASCII characters between them +(e.g. [0-9] matches any decimal digit). +
    • - To include a literal ] in the sequence, make it the first character +(following a possible ^). +
    • - To include a literal -, make it the first or last character. +
    +
+ +

Ordering Multiple Matches

+ +

In general there may be more than one way to match a regular expression +to an input string. For example, consider the command +

+
+
 (string-match "(a*)b*"  "aabaaabb")
+
+ +

Considering only the rules given so far, the value of (list-matches 0 1) +might be ("aabb" "aa") or ("aaab" "aaa") or ("ab" "a") +or any of several other combinations. +To resolve this potential ambiguity string-match chooses among +alternatives using the rule first then longest. +In other words, it considers the possible matches in order working +from left to right across the input string and the pattern, and it +attempts to match longer pieces of the input string before shorter +ones. More specifically, the following rules apply in decreasing +order of priority: +

    +
  • [1] +If a regular expression could match two different parts of an input string +then it will match the one that begins earliest. +
  • [2] +If a regular expression contains | operators then the leftmost +matching sub-expression is chosen. +
  • [3] +In *, +, and ? constructs, longer matches are chosen +in preference to shorter ones. +
  • [4] +In sequences of expression components the components are considered +from left to right. +
+ +

In the example from above, (a*)b* matches aab: the (a*) +portion of the pattern is matched first and it consumes the leading +aa; then the b* portion of the pattern consumes the +next b. Or, consider the following example: +

+
+
 (string-match "(ab|a)(b*)c"  "xabc") ==> 1
+ (list-matches 0 1 2 3) ==> ("abc" "ab" "" NIL)
+ (match-beginning 0) ==> 1
+ (match-end 0) ==> 4
+ (match-beginning 1) ==> 1
+ (match-end 1) ==> 3
+ (match-beginning 2) ==> 3
+ (match-end 2) ==> 3
+ (match-beginning 3) ==> -1
+ (match-end 3) ==> -1
+
+
+ +

In the above example the return value of 1 (which is > -1) +indicates that a match was found. The entire match runs from +1 to 4. +Rule 4 specifies that (ab|a) gets first shot at the input +string and Rule 2 specifies that the ab sub-expression +is checked before the a sub-expression. +Thus the b has already been claimed before the (b*) +component is checked and (b*) must match an empty string. +

+

The special characters in the string "\()[]+.*|^$?", +must be quoted, if a simple string search is desired. The function +re-quote-string is provided for this purpose. +

+
(re-quote-string "*standard*") ==> "\\*standard\\*"
+
+(string-match (re-quote-string "*standard*") "X *standard* ")
+ ==> 2
+
+(string-match "*standard*" "X *standard* ")
+Error: Regexp Error: ?+* follows nothing
+
+

Note there is actually just one \ before the * +but the printer makes two so that the string can be read, since +\ is also the lisp quote character. In the last example +an error is signalled since the special character * must +follow an atom if it is interpreted as a regular expression. +

+ + + + + + + +
+
+

+Previous: , Up: System Definitions   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Sequences-and-Arrays-and-Hash-Tables.html b/info/gcl-si/Sequences-and-Arrays-and-Hash-Tables.html new file mode 100644 index 0000000..84981ae --- /dev/null +++ b/info/gcl-si/Sequences-and-Arrays-and-Hash-Tables.html @@ -0,0 +1,1150 @@ + + + + + +Sequences and Arrays and Hash Tables (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

2 Sequences and Arrays and Hash Tables

+ +
+
Function: VECTOR (&rest objects)
+

Package:LISP +

+

Constructs a Simple-Vector from the given objects. +

+ +
+ +
+
Function: SUBSEQ (sequence start &optional (end (length sequence)))
+

Package:LISP +

+

Returns a copy of a subsequence of SEQUENCE between START (inclusive) and +END (exclusive). +

+ +
+ +
+
Function: COPY-SEQ (sequence)
+

Package:LISP +

+

Returns a copy of SEQUENCE. +

+ +
+ +
+
Function: POSITION (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the index of the first element in SEQUENCE that satisfies TEST with +ITEM; NIL if no such element exists. +

+ +
+ +
+
Function: ARRAY-RANK (array)
+

Package:LISP +

+

Returns the number of dimensions of ARRAY. +

+ +
+ +
+
Function: SBIT (simple-bit-array &rest subscripts)
+

Package:LISP +

+

Returns the bit from SIMPLE-BIT-ARRAY at SUBSCRIPTS. +

+ +
+ +
+
Function: STRING-CAPITALIZE (string &key (start 0) (end (length string)))
+

Package:LISP +

+

Returns a copy of STRING with the first character of each word converted to +upper-case, and remaining characters in the word converted to lower case. +

+ +
+ +
+
Function: NSUBSTITUTE-IF-NOT (new test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence of the same kind as SEQUENCE with the same elements +

+

except that all elements not satisfying TEST are replaced with NEWITEM. +SEQUENCE may be destroyed. +

+ +
+ +
+
Function: FIND-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the index of the first element in SEQUENCE that satisfies TEST; NIL if +no such element exists. +

+ +
+ +
+
Function: BIT-EQV (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical EQV on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: STRING< (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

If STRING1 is lexicographically less than STRING2, then returns the longest +common prefix of the strings. Otherwise, returns NIL. +

+ +
+ +
+
Function: REVERSE (sequence)
+

Package:LISP +

+

Returns a new sequence containing the same elements as SEQUENCE but in +reverse order. +

+ +
+ +
+
Function: NSTRING-UPCASE (string &key (start 0) (end (length string)))
+

Package:LISP +

+

Returns STRING with all lower case characters converted to uppercase. +

+ +
+ +
+
Function: STRING>= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

If STRING1 is lexicographically greater than or equal to STRING2, then returns +the longest common prefix of the strings. Otherwise, returns NIL. +

+ +
+ +
+
Function: ARRAY-ROW-MAJOR-INDEX (array &rest subscripts)
+

Package:LISP +

+

Returns the index into the data vector of ARRAY for the element of ARRAY +specified by SUBSCRIPTS. +

+ +
+ + +
+
Function: ARRAY-DIMENSION (array axis-number)
+

Package:LISP +

+

Returns the length of AXIS-NUMBER of ARRAY. +

+ +
+ +
+
Function: FIND (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the first element in SEQUENCE satisfying TEST with ITEM; NIL if no +such element exists. +

+ +
+ +
+
Function: STRING-NOT-EQUAL (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Similar to STRING=, but ignores cases. +

+ +
+ +
+
Function: STRING-RIGHT-TRIM (char-bag string)
+

Package:LISP +

+

Returns a copy of STRING with the characters in CHAR-BAG removed from the +right end. +

+ +
+ +
+
Function: DELETE-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence formed by destructively removing the elements not +satisfying TEST from SEQUENCE. +

+ +
+ +
+
Function: REMOVE-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a copy of SEQUENCE with elements not satisfying TEST removed. +

+ +
+ +
+
Function: STRING= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Returns T if the two strings are character-wise CHAR=; NIL otherwise. +

+ +
+ +
+
Function: NSUBSTITUTE-IF (new test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence of the same kind as SEQUENCE with the same elements +except that all elements satisfying TEST are replaced with NEWITEM. SEQUENCE +may be destroyed. +

+ +
+ +
+
Function: SOME (predicate sequence &rest more-sequences)
+

Package:LISP +

+

Returns T if at least one of the elements in SEQUENCEs satisfies PREDICATE; +NIL otherwise. +

+ +
+ +
+
Function: MAKE-STRING (size &key (initial-element #\Space))
+

Package:LISP +

+

Creates and returns a new string of SIZE length whose elements are all +INITIAL-ELEMENT. +

+ +
+ +
+
Function: NSUBSTITUTE (newitem olditem sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence of the same kind as SEQUENCE with the same elements +except that OLDITEMs are replaced with NEWITEM. SEQUENCE may be destroyed. +

+ +
+ +
+
Function: STRING-EQUAL (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Given two strings (string1 and string2), and optional integers start1, +start2, end1 and end2, compares characters in string1 to characters in +string2 (using char-equal). +

+ +
+ +
+
Function: STRING-NOT-GREATERP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Similar to STRING<=, but ignores cases. +

+ +
+ +
+
Function: STRING> (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

If STRING1 is lexicographically greater than STRING2, then returns the +longest common prefix of the strings. Otherwise, returns NIL. +

+ +
+ +
+
Function: STRINGP (x)
+

Package:LISP +

+

Returns T if X is a string; NIL otherwise. +

+ +
+ +
+
Function: DELETE-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence formed by removing the elements satisfying TEST +destructively from SEQUENCE. +

+ +
+ +
+
Function: SIMPLE-STRING-P (x)
+

Package:LISP +

+

Returns T if X is a simple string; NIL otherwise. +

+ +
+ +
+
Function: REMOVE-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a copy of SEQUENCE with elements satisfying TEST removed. +

+ +
+ +
+
Function: HASH-TABLE-COUNT (hash-table)
+

Package:LISP +

+

Returns the number of entries in the given Hash-Table. +

+ +
+ +
+
Function: ARRAY-DIMENSIONS (array)
+

Package:LISP +

+

Returns a list whose elements are the dimensions of ARRAY +

+ +
+ +
+
Function: SUBSTITUTE-IF-NOT (new test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence of the same kind as SEQUENCE with the same elements +except that all elements not satisfying TEST are replaced with NEWITEM. +

+ +
+ +
+
Function: ADJUSTABLE-ARRAY-P (array)
+

Package:LISP +

+

Returns T if ARRAY is adjustable; NIL otherwise. +

+ +
+ +
+
Function: SVREF (simple-vector index)
+

Package:LISP +

+

Returns the INDEX-th element of SIMPLE-VECTOR. +

+ +
+ +
+
Function: VECTOR-PUSH-EXTEND (new-element vector &optional (extension (length vector)))
+

Package:LISP +

+

Similar to VECTOR-PUSH except that, if the fill pointer gets too large, +extends VECTOR rather then simply returns NIL. +

+ +
+ +
+
Function: DELETE (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence formed by removing the specified ITEM destructively from +SEQUENCE. +

+ +
+ +
+
Function: REMOVE (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a copy of SEQUENCE with ITEM removed. +

+ +
+ +
+
Function: STRING (x)
+

Package:LISP +

+

Coerces X into a string. If X is a string, then returns X itself. If X is a +symbol, then returns X’s print name. If X is a character, then returns a one +element string containing that character. Signals an error if X cannot be +coerced into a string. +

+ +
+ +
+
Function: STRING-UPCASE (string &key (start 0) (end (length string)))
+

Package:LISP +

+

Returns a copy of STRING with all lower case characters converted to +uppercase. +

+ +
+ +
+
Function: GETHASH (key hash-table &optional (default nil))
+

Package:LISP +

+

Finds the entry in HASH-TABLE whose key is KEY and returns the associated +value and T, as multiple values. Returns DEFAULT and NIL if there is no +such entry. +

+ +
+ +
+
Function: MAKE-HASH-TABLE (&key (test 'eql) (size 1024) (rehash-size 1.5) (rehash-threshold 0.7))
+

Package:LISP +

+

Creates and returns a hash table. +

+ +
+ +
+
Function: STRING/= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Returns NIL if STRING1 and STRING2 are character-wise CHAR=. Otherwise, +returns the index to the longest common prefix of the strings. +

+ +
+ +
+
Function: STRING-GREATERP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Similar to STRING>, but ignores cases. +

+ +
+ +
+
Function: ELT (sequence index)
+

Package:LISP +

+

Returns the INDEX-th element of SEQUENCE. +

+ +
+ +
+
Function: MAKE-ARRAY (dimensions &key (element-type t) initial-element (initial-contents nil) (adjustable nil) (fill-pointer nil) (displaced-to nil) (displaced-index-offset 0) static)
+

Package:LISP +

+

Creates an array of the specified DIMENSIONS. The default for INITIAL- +ELEMENT depends on ELEMENT-TYPE. +MAKE-ARRAY will always try to find the ‘best’ array to +accommodate the element-type specified. For example on a SUN element-type +(mod 1) –> bit +(integer 0 10) –> unsigned-char +(integer -3 10) –> signed-char +si::best-array-element-type is the function doing this. It +is also used by the compiler, for coercing array element types. +If you are going to declare an array you should use the same +element type as was used in making it. eg +(setq my-array (make-array 4 :element-type ’(integer 0 10))) +(the (array (integer 0 10)) my-array) + When wanting to optimize references to an array you need to +declare the array eg: (the (array (integer -3 10)) my-array) if ar +were constructed using the (integer -3 10) element-type. You could of +course have used signed-char, but since the ranges may be +implementation dependent it is better to use -3 10 range. MAKE-ARRAY +needs to do some calculation with the element-type if you don’t +provide a primitive data-type. One way of doing this in a machine +independent fashion: +

+

(defvar *my-elt-type* #. + (array-element-type (make-array 1 :element-type ’(integer -3 10)))) +

+

Then calls to (make-array n :element-type *my-elt-type*) will not have to go +through a type inclusion computation. The keyword STATIC (GCL specific) if non +nil, will cause the array body to be non relocatable. +

+ + +
+ +
+
Function: NSTRING-DOWNCASE (string &key (start 0) (end (length string)))
+

Package:LISP + Returns STRING with all upper case +characters converted to lowercase. +

+ +
+ +
+
Function: ARRAY-IN-BOUNDS-P (array &rest subscripts)
+

Package:LISP + Returns T if SUBSCRIPTS are valid subscripts for +ARRAY; NIL otherwise. +

+ +
+ +
+
Function: SORT (sequence predicate &key (key #'identity))
+

Package:LISP + Destructively sorts SEQUENCE. +PREDICATE should return non-NIL if its first argument is to precede +its second argument. +

+ +
+ +
+
Function: HASH-TABLE-P (x)
+

Package:LISP +

+

Returns T if X is a hash table object; NIL +otherwise. +

+ +
+ +
+
Function: COUNT-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the number of elements in SEQUENCE not satisfying TEST. +

+ +
+ +
+
Function: FILL-POINTER (vector)
+

Package:LISP +

+

Returns the fill pointer of VECTOR. +

+ +
+ + +
+
Function: ARRAYP (x)
+

Package:LISP +

+

Returns T if X is an array; NIL otherwise. +

+ +
+ +
+
Function: REPLACE (sequence1 sequence2 &key (start1 0) (end1 (length sequence1)) (start2 0) (end2 (length sequence2)))
+

Package:LISP +

+

Destructively modifies SEQUENCE1 by copying successive elements into it from +SEQUENCE2. +

+ +
+ +
+
Function: BIT-XOR (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical XOR on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: CLRHASH (hash-table)
+

Package:LISP +

+

Removes all entries of HASH-TABLE and returns the hash table itself. +

+ +
+ +
+
Function: SUBSTITUTE-IF (newitem test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence of the same kind as SEQUENCE with the same elements +except that all elements satisfying TEST are replaced with NEWITEM. +

+ +
+ +
+
Function: MISMATCH (sequence1 sequence2 &key (from-end nil) (test #'eql) test-not (start1 0) (start2 0) (end1 (length sequence1)) (end2 (length sequence2)) (key #'identity))
+

Package:LISP +

+

The specified subsequences of SEQUENCE1 and SEQUENCE2 are compared +element-wise. If they are of equal length and match in every element, the +result is NIL. Otherwise, the result is a non-negative integer, the index +within SEQUENCE1 of the leftmost position at which they fail to match; or, if +one is shorter than and a matching prefix of the other, the index within +SEQUENCE1 beyond the last position tested is returned. +

+ +
+ +
+
Constant: ARRAY-TOTAL-SIZE-LIMIT
+

Package:LISP +The exclusive upper bound on the total number of elements of an array. +

+ +
+ +
+
Function: VECTOR-POP (vector)
+

Package:LISP +

+

Attempts to decrease the fill-pointer of VECTOR by 1 and returns the element +pointed to by the new fill pointer. Signals an error if the old value of +the fill pointer is 0. +

+ +
+ +
+
Function: SUBSTITUTE (newitem olditem sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity))
+

Package:LISP +

+

Returns a sequence of the same kind as SEQUENCE with the same elements +except that OLDITEMs are replaced with NEWITEM. +

+ +
+ +
+
Function: ARRAY-HAS-FILL-POINTER-P (array)
+

Package:LISP +

+

Returns T if ARRAY has a fill pointer; NIL otherwise. +

+ +
+ +
+
Function: CONCATENATE (result-type &rest sequences)
+

Package:LISP +

+

Returns a new sequence of the specified RESULT-TYPE, consisting of all +elements in SEQUENCEs. +

+ +
+ +
+
Function: VECTOR-PUSH (new-element vector)
+

Package:LISP +

+

Attempts to set the element of ARRAY designated by its fill pointer to +NEW-ELEMENT and increments the fill pointer by one. Returns NIL if the fill +pointer is too large. Otherwise, returns the new fill pointer value. +

+ +
+ +
+
Function: STRING-TRIM (char-bag string)
+

Package:LISP +

+

Returns a copy of STRING with the characters in CHAR-BAG removed from both +ends. +

+ +
+ +
+
Function: ARRAY-ELEMENT-TYPE (array)
+

Package:LISP +

+

Returns the type of the elements of ARRAY +

+ +
+ +
+
Function: NOTANY (predicate sequence &rest more-sequences)
+

Package:LISP +

+

Returns T if none of the elements in SEQUENCEs satisfies PREDICATE; NIL +otherwise. +

+ +
+ +
+
Function: BIT-NOT (bit-array &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical NOT in the elements of BIT-ARRAY. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: BIT-ORC1 (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical ORC1 on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: COUNT-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the number of elements in SEQUENCE satisfying TEST. +

+ +
+ +
+
Function: MAP (result-type function sequence &rest more-sequences)
+

Package:LISP +

+

FUNCTION must take as many arguments as there are sequences provided. The +result is a sequence such that the i-th element is the result of applying +FUNCTION to the i-th elements of the SEQUENCEs. +

+ +
+ +
+
Constant: ARRAY-RANK-LIMIT
+

Package:LISP +The exclusive upper bound on the rank of an array. +

+ +
+ +
+
Function: COUNT (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the number of elements in SEQUENCE satisfying TEST with ITEM. +

+ +
+ +
+
Function: BIT-VECTOR-P (x)
+

Package:LISP +

+

Returns T if X is a bit vector; NIL otherwise. +

+ +
+ +
+
Function: NSTRING-CAPITALIZE (string &key (start 0) (end (length string)))
+

Package:LISP +

+

Returns STRING with the first character of each word converted to upper-case, +and remaining characters in the word converted to lower case. +

+ +
+ +
+
Function: ADJUST-ARRAY (array dimensions &key (element-type (array-element-type array)) initial-element (initial-contents nil) (fill-pointer nil) (displaced-to nil) (displaced-index-offset 0))
+

Package:LISP +

+

Adjusts the dimensions of ARRAY to the given DIMENSIONS. The default value +of INITIAL-ELEMENT depends on ELEMENT-TYPE. +

+ +
+ +
+ +

Package:LISP +

+

A search is conducted for the first subsequence of SEQUENCE2 which +element-wise matches SEQUENCE1. If there is such a subsequence in SEQUENCE2, +the index of the its leftmost element is returned; otherwise, NIL is +returned. +

+ +
+ +
+
Function: SIMPLE-BIT-VECTOR-P (x)
+

Package:LISP +

+

Returns T if X is a simple bit-vector; NIL otherwise. +

+ +
+ +
+
Function: MAKE-SEQUENCE (type length &key initial-element)
+

Package:LISP +

+

Returns a sequence of the given TYPE and LENGTH, with elements initialized +to INITIAL-ELEMENT. The default value of INITIAL-ELEMENT depends on TYPE. +

+ +
+ +
+
Function: BIT-ORC2 (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical ORC2 on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: NREVERSE (sequence)
+

Package:LISP +

+

Returns a sequence of the same elements as SEQUENCE but in reverse order. +SEQUENCE may be destroyed. +

+ +
+ +
+
Constant: ARRAY-DIMENSION-LIMIT
+

Package:LISP +The exclusive upper bound of the array dimension. +

+ +
+ +
+
Function: NOTEVERY (predicate sequence &rest more-sequences)
+

Package:LISP +

+

Returns T if at least one of the elements in SEQUENCEs does not satisfy +PREDICATE; NIL otherwise. +

+ +
+ +
+
Function: POSITION-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the index of the first element in SEQUENCE that does not satisfy TEST; +NIL if no such element exists. +

+ +
+ +
+
Function: STRING-DOWNCASE (string &key (start 0) (end (length string)))
+

Package:LISP +

+

Returns a copy of STRING with all upper case characters converted to +lowercase. +

+ +
+ +
+
Function: BIT (bit-array &rest subscripts)
+

Package:LISP +

+

Returns the bit from BIT-ARRAY at SUBSCRIPTS. +

+ +
+ +
+
Function: STRING-NOT-LESSP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Similar to STRING>=, but ignores cases. +

+ +
+ +
+
Function: CHAR (string index)
+

Package:LISP +

+

Returns the INDEX-th character in STRING. +

+ +
+ +
+
Function: AREF (array &rest subscripts)
+

Package:LISP +

+

Returns the element of ARRAY specified by SUBSCRIPTS. +

+ +
+ +
+
Function: FILL (sequence item &key (start 0) (end (length sequence)))
+

Package:LISP +

+

Replaces the specified elements of SEQUENCE all with ITEM. +

+ +
+ +
+
Function: STABLE-SORT (sequence predicate &key (key #'identity))
+

Package:LISP +

+

Destructively sorts SEQUENCE. PREDICATE should return non-NIL if its first +argument is to precede its second argument. +

+ +
+ +
+
Function: BIT-IOR (bit-array1 bit-array2 &optional (result-bit-array nil))
+

Package:LISP +

+

Performs a bit-wise logical IOR on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. +

+ +
+ +
+
Function: REMHASH (key hash-table)
+

Package:LISP +

+

Removes any entry for KEY in HASH-TABLE. Returns T if such an entry +existed; NIL otherwise. +

+ +
+ +
+
Function: VECTORP (x)
+

Package:LISP +

+

Returns T if X is a vector; NIL otherwise. +

+ +
+ +
+
Function: STRING<= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

If STRING1 is lexicographically less than or equal to STRING2, then returns +the longest common prefix of the two strings. Otherwise, returns NIL. +

+ +
+ +
+
Function: SIMPLE-VECTOR-P (x)
+

Package:LISP +

+

Returns T if X is a simple vector; NIL otherwise. +

+ +
+ +
+
Function: STRING-LEFT-TRIM (char-bag string)
+

Package:LISP +

+

Returns a copy of STRING with the characters in CHAR-BAG removed from the +left end. +

+ +
+ +
+
Function: ARRAY-TOTAL-SIZE (array)
+

Package:LISP +

+

Returns the total number of elements of ARRAY. +

+ +
+ +
+
Function: FIND-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the index of the first element in SEQUENCE that does not satisfy +TEST; NIL if no such element exists. +

+ +
+ +
+
Function: DELETE-DUPLICATES (sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns a sequence formed by removing duplicated elements destructively from +SEQUENCE. +

+ +
+ +
+
Function: REMOVE-DUPLICATES (sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

The elements of SEQUENCE are examined, and if any two match, one is discarded. +Returns the resulting sequence. +

+ +
+ +
+
Function: POSITION-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity))
+

Package:LISP +

+

Returns the index of the first element in SEQUENCE that satisfies TEST; NIL +if no such element exists. +

+ +
+ +
+
Function: MERGE (result-type sequence1 sequence2 predicate &key (key #'identity))
+

Package:LISP +

+

SEQUENCE1 and SEQUENCE2 are destructively merged into a sequence of type +RESULT-TYPE using PREDICATE to order the elements. +

+ +
+ +
+
Function: EVERY (predicate sequence &rest more-sequences)
+

Package:LISP +

+

Returns T if every elements of SEQUENCEs satisfy PREDICATE; NIL otherwise. +

+ +
+ +
+
Function: REDUCE (function sequence &key (from-end nil) (start 0) (end (length sequence)) initial-value)
+

Package:LISP +

+

Combines all the elements of SEQUENCE using a binary operation FUNCTION. +If INITIAL-VALUE is supplied, it is logically placed before the SEQUENCE. +

+ +
+ +
+
Function: STRING-LESSP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2)))
+

Package:LISP +

+

Similar to STRING<, but ignores cases. +

+ +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Source-Level-Debugging-in-Emacs.html b/info/gcl-si/Source-Level-Debugging-in-Emacs.html new file mode 100644 index 0000000..e9f806a --- /dev/null +++ b/info/gcl-si/Source-Level-Debugging-in-Emacs.html @@ -0,0 +1,158 @@ + + + + + +Source Level Debugging in Emacs (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Debugging   [Contents][Index]

+
+
+

18.1 Source Level Debugging in Emacs

+ +

In emacs load (load "dbl.el") from the gcl/doc directory. +[ It also requires gcl.el from that directory. Your system +administrator should do make in the doc directory, so that +these files are copied to the standard location.] +

+

OVERVIEW: +

+

Lisp files loaded with si::nload will have source line information about +them recorded. Break points may be set, and functions stepped. Source code +will be automatically displayed in the other window, with a little arrow beside +the current line. The backtrace (command :bt) will show line information and +you will get automatic display of the source as you move up and down the stack. +

+

FUNCTIONS: +break points which have been set. + si::nload (file) + load a lisp file collecting source line information. +

+

si::break-function (function &optional line absolute) + set up a breakpoint for FUNCTION at LINE relative to start or ABSOLUTE +

+

EMACS COMMANDS: +M-x dbl makes a dbl buffer, suitable for running an inferior gcl. +It has special keybindings for stepping and viewing sources. You may +start your favorite gcl program in the dbl shell buffer. +

+

Inferior Dbl Mode: +Major mode for interacting with an inferior Dbl process. +The following commands are available: +

+

C-c l dbl-find-line +

+

ESC d dbl-:down +ESC u dbl-:up +ESC c dbl-:r +ESC n dbl-:next +ESC i dbl-:step +ESC s dbl-:step +

+ +

M-x dbl-display-frame displays in the other window +the last line referred to in the dbl buffer. +

+

ESC i and ESC n in the dbl window, +call dbl to step and next and then update the other window +with the current file and position. +

+

If you are in a source file, you may select a point to break +at, by doing C-x SPC. +

+

Commands: +Many commands are inherited from shell mode. +Additionally we have: +

+

M-x dbl-display-frame display frames file in other window +ESC i advance one line in program +ESC n advance one line in program (skip over calls). +M-x send-dbl-command used for special printing of an arg at the current point. +C-x SPACE sets break point at current line. +

+

—————————- +

+

When visiting a lisp buffer (if gcl.el is loaded in your emacs) the command +c-m-x evaluates the current defun into the process running in the other window. +Line information will be kept. This line information allows you to set break +points at a given line (by typing C-x \space on the line in the source file +where you want the break to occur. Once stopped within a function you may +single step with M-s. This moves one line at a time in the source code, +displaying a little arrow beside your current position. M-c is like M-s, +except that function invocations are skipped over, rather than entered into. +M-c continues execution. +

+

Keywords typed at top level, in the debug loop have +a special meaning: +

    +
  • :delete [n1] [n2] .. – delete all break points or just n1,n2 +
  • :disable [n1] [n2] .. – disable all break points or just n1,n2 +
  • :enable [n1] [n2] .. – enable all break points or just n1,n2 +
  • :info [:bkpt] –print information about +
  • :break [fun] [line] – break at the current location, or if + fun is supplied in fun. Break at the beginning unless a + line offset from the beginning of fun is supplied. +
  • :fr [n] go to frame n When in frame n, if the frame is interpreted, + typing the name of locals, will print their values. If it is compiled + you must use (si::loc j) to print ‘locj’. Autodisplay of the source + will take place if it is interpreted and the line can be determined. +
  • :up [n] go up n frames from the current frame. +
  • :down [n] go down n frames +
  • :bt [n] back trace starting at the current frame and going to top level + If n is specified show only n frames. +
  • :r If stopped in a function resume. If at top level in the dbl + loop, exit and resume an outer loop. +
  • :q quit the computation back to top level dbl loop. +
  • :step step to the next line with line information +
  • :next step to the next line with line information skipping over function + invocations. + +
+

Files: debug.lsp dbl.el gcl.el +

+
+
+

+Next: , Previous: , Up: Debugging   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Special-Forms-and-Functions.html b/info/gcl-si/Special-Forms-and-Functions.html new file mode 100644 index 0000000..b592a4b --- /dev/null +++ b/info/gcl-si/Special-Forms-and-Functions.html @@ -0,0 +1,1254 @@ + + + + + +Special Forms and Functions (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

6 Special Forms and Functions

+ +
+
Constant: LAMBDA-LIST-KEYWORDS
+

Package:LISP +List of all the lambda-list keywords used in GCL. +

+ +
+ +
+
Special Form: THE
+

Package:LISP +

+

Syntax: +

+
(the value-type form)
+
+ +

Declares that the value of FORM must be of VALUE-TYPE. Signals an error if +this is not the case. +

+ +
+ +
+
Special Form: SETF
+

Package:LISP +

+

Syntax: +

+
(setf {place newvalue}*)
+
+ +

Replaces the value in PLACE with the value of NEWVALUE, from left to right. +Returns the value of the last NEWVALUE. Each PLACE may be any one of the +following: +

    +
  • A symbol that names a variable. +
  • A function call form whose first element is the name of the following + functions: +
    +
    nth	elt	subseq	rest	first ... tenth
+c?r	c??r	c???r	c????r
+aref	svref	char	schar	bit	sbit	fill-poiter
+get	getf	documentation	symbol-value	symbol-function
+symbol-plist	macro-function	gethash
+char-bit	ldb	mask-field
+apply
+
    +

    where ’?’ stands for either ’a’ or ’d’. +

  • the form (THE type place) with PLACE being a place recognized by SETF. +
  • a macro call which expands to a place recognized by SETF. +
  • any form for which a DEFSETF or DEFINE-SETF-METHOD declaration has been + made. +
+ +
+ +
+
Special Form: WHEN
+

Package:LISP +

+

Syntax: +

+
(when test {form}*)
+
+ +

If TEST evaluates to non-NIL, then evaluates FORMs as a PROGN. If not, +simply returns NIL. +

+ +
+ +
+
Macro: CCASE
+

Package:LISP +

+

Syntax: +

+
(ccase keyplace {({key | ({key}*)} {form}*)}*)
+
+ +

Evaluates KEYPLACE and tries to find the KEY that is EQL to the value of +KEYPLACE. If one is found, then evaluates FORMs that follow the KEY and +returns the value(s) of the last FORM. If not, signals a correctable error. +

+ +
+ +
+
Function: MACROEXPAND (form &optional (env nil))
+

Package:LISP +

+

If FORM is a macro form, then expands it repeatedly until it is not a macro +any more. Returns two values: the expanded form and a T-or-NIL flag +indicating whether the original form was a macro. +

+ +
+ +
+
Special Form: MULTIPLE-VALUE-CALL
+

Package:LISP +

+

Syntax: +

+
(multiple-value-call function {form}*)
+
+ +

Calls FUNCTION with all the values of FORMs as arguments. +

+ +
+ +
+
Macro: DEFSETF
+

Package:LISP +

+

Syntax: +

+
(defsetf access-fun {update-fun [doc] |
+                             lambda-list (store-var) {decl | doc}*
+{form}*)
+
+ +

Defines how to SETF a generalized-variable reference of the form +(ACCESS-FUN ...). The doc-string DOC, if supplied, is saved as a SETF doc and +can be retrieved by (documentation ’NAME ’setf). +

+
+
(defsetf access-fun update-fun) defines an expansion from
+(setf (ACCESS-FUN arg1 ... argn) value) to (UPDATE-FUN arg1 ... argn value).
+
+(defsetf access-fun lambda-list (store-var) . body) defines a macro which
+
+

expands +

+
+
(setf (ACCESS-FUN arg1 ... argn) value) into the form
+	(let* ((temp1 ARG1) ... (tempn ARGn) (temp0 value)) rest)
+
+

where REST is the value of BODY with parameters in LAMBDA-LIST bound to the +symbols TEMP1 ... TEMPn and with STORE-VAR bound to the symbol TEMP0. +

+
+ +
+
Special Form: TAGBODY
+

Package:LISP +

+

Syntax: +

+
(tagbody {tag | statement}*)
+
+ +

Executes STATEMENTs and returns NIL if it falls off the end. +

+ +
+ + +
+
Macro: ETYPECASE
+

Package:LISP +

+

Syntax: +

+
(etypecase keyform {(type {form}*)}*)
+
+ +

Evaluates KEYFORM and tries to find the TYPE in which the value of KEYFORM +belongs. If one is found, then evaluates FORMs that follow the KEY and +returns the value(s) of the last FORM. If not, signals an error. +

+ +
+ +
+
Special Form: LET*
+

Package:LISP +

+

Syntax: +

+
(let* ({var | (var [value])}*) {decl}* {form}*)
+
+ +

Initializes VARs, binding them to the values of VALUEs (which defaults to NIL) +from left to right, then evaluates FORMs as a PROGN. +

+ +
+ +
+
Special Form: PROG1
+

Package:LISP +

+

Syntax: +

+
(prog1 first {form}*)
+
+ +

Evaluates FIRST and FORMs in order, and returns the (single) value of FIRST. +

+ +
+ +
+
Special Form: DEFUN
+

Package:LISP +

+

Syntax: +

+
(defun name lambda-list {decl | doc}* {form}*)
+
+ +

Defines a function as the global function definition of the symbol NAME. +The complete syntax of a lambda-list is: + ({var}* + [&optional {var | (var [initform [svar]])}*] + [&rest var] + [&key {var | ({var | (keyword var)} [initform [svar]])}* + [&allow-other-keys]] + [&aux {var | (var [initform])}*]) +The doc-string DOC, if supplied, is saved as a FUNCTION doc and can be +retrieved by (documentation ’NAME ’function). +

+ +
+ +
+
Special Form: MULTIPLE-VALUE-BIND
+

Package:LISP +

+

Syntax: +

+
(multiple-value-bind ({var}*) values-form {decl}* {form}*)
+
+ +

Binds the VARiables to the results of VALUES-FORM, in order (defaulting to +NIL) and evaluates FORMs in order. +

+ +
+ +
+
Special Form: DECLARE
+

Package:LISP +

+

Syntax: +

+
(declare {decl-spec}*)
+
+ +

Gives a declaration. Possible DECL-SPECs are: + (SPECIAL {var}*) + (TYPE type {var}*) + where ’TYPE’ is one of the following symbols +

+
array		fixnum		package		simple-bit-vector
+atom		float		pathname	simple-string
+bignum		function	random-state	simple-vector
+bit		hash-table	ratio		single-float
+bit-vector	integer		rational	standard-char
+character	keyword		readtable	stream
+common		list		sequence	string
+compiled-function  long-float	short-float	string-char
+complex		nil		signed-byte	symbol
+cons		null		unsigned-byte	t
+double-float	number		simple-array	vector
+
+

’TYPE’ may also be a list containing one of the above symbols as +its first element and more specific information later in the list. +For example +

+
(vector long-float 80) ; vector of 80 long-floats.
+(array long-float *)   ; array of long-floats
+(array fixnum)         ; array of fixnums
+(array * 30)           ; an array of length 30 but unspecified type
+
+ +

A list of 1 element may be replaced by the symbol alone, and a list ending + in ’*’ may drop the the final ’*’. +

+
(OBJECT {var}*)
+(FTYPE type {function-name}*)
+    eg: ;; function of two required args and optional args and one value:
+     (ftype (function (t t *) t) sort reduce)
+        ;; function with 1 arg of general type returning 1 fixnum as value.
+     (ftype (function (t) fixnum) length)
+(FUNCTION function-name ({arg-type}*) {return-type}*)
+(INLINE {function-name}*)
+(NOTINLINE {function-name}*)
+(IGNORE {var}*)
+(OPTIMIZE {({SPEED | SPACE | SAFETY | COMPILATION-SPEED} {0 | 1 | 2 | 3})}*)
+(DECLARATION {non-standard-decl-name}*)
+(:DYNAMIC-EXTENT {var}*) ;GCL-specific.
+
+ +
+ +
+
Special Form: DEFMACRO
+

Package:LISP +

+

Syntax: +

+
(defmacro name defmacro-lambda-list {decl | doc}* {form}*)
+
+ +

Defines a macro as the global macro definition of the symbol NAME. +The complete syntax of a defmacro-lambda-list is: +

+

( [&whole var] + [&environment var] + {pseudo-var}* + [&optional {var | (pseudo-var [initform [pseudo-var]])}*] + {[{&rest | &body} pseudo-var] + [&key {var | ({var | (keyword pseudo-var)} [initform [pseudo-var]])}* + [&allow-other-keys]] + [&aux {var | (pseudo-var [initform])}*] + | . var}) +

+

where pseudo-var is either a symbol or a list of the following form: +

+

( {pseudo-var}* + [&optional {var | (pseudo-var [initform [pseudo-var]])}*] + {[{&rest | &body} pseudo-var] + [&key {var | ({var | (keyword pseudo-var)} [initform [pseudo-var]])}* + [ &allow-other-keys ] ] + [&aux {var | (pseudo-var [initform])}*] + | . var}) +

+

As a special case, a non-NIL symbol is accepcted as a defmacro-lambda-list: +(DEFMACRO <name> <symbol> ...) is equivalent to +(DEFMACRO <name> (&REST <symbol>) ...). + The doc-string DOC, if supplied, is saved as a FUNCTION doc and can be +retrieved by (documentation ’NAME ’function). +See the type doc of LIST for the backquote macro useful for defining macros. +Also, see the function doc of PPRINT for the output-formatting. +

+ +
+ +
+
Variable: *EVALHOOK*
+

Package:LISP +If *EVALHOOK* is not NIL, its value must be a function that can receive +two arguments: a form to evaluate and an environment. This function does +the evaluation instead of EVAL. +

+ +
+ +
+
Function: FUNCTIONP (x)
+

Package:LISP +

+

Returns T if X is a function, suitable for use by FUNCALL or APPLY. Returns +NIL otherwise. +

+ +
+ +
+
Constant: LAMBDA-PARAMETERS-LIMIT
+

Package:LISP +The exclusive upper bound on the number of distinct parameter names that may +appear in a single lambda-list. Actually, however, there is no such upper +bound in GCL. +

+ +
+ +
+
Special Form: FLET
+

Package:LISP +

+

Syntax: +

+
(flet ({(name lambda-list {decl | doc}* {form}*)}*) . body)
+
+ +

Evaluates BODY as a PROGN, with local function definitions in effect. BODY is +the scope of each local function definition. Since the scope does not include +the function definitions themselves, the local function can reference +externally defined functions of the same name. See the doc of DEFUN for the +complete syntax of a lambda-list. Doc-strings for local functions are simply +ignored. +

+ +
+ +
+
Macro: ECASE
+

Package:LISP +

+

Syntax: +

+
(ecase keyform {({key | ({key}*)} {form}*)}*)
+
+ +

Evaluates KEYFORM and tries to find the KEY that is EQL to the value of +KEYFORM. If one is found, then evaluates FORMs that follow the KEY and +returns the value(s) of the last FORM. If not, signals an error. +

+ +
+ +
+
Special Form: PROG2
+

Package:LISP +

+

Syntax: +

+
(prog2 first second {forms}*)
+
+ +

Evaluates FIRST, SECOND, and FORMs in order, and returns the (single) value +of SECOND. +

+ +
+ +
+
Special Form: PROGV
+

Package:LISP +

+

Syntax: +

+
(progv symbols values {form}*)
+
+ +

SYMBOLS must evaluate to a list of variables. VALUES must evaluate to a list +of initial values. Evaluates FORMs as a PROGN, with each variable bound (as +special) to the corresponding value. +

+ +
+ +
+
Special Form: QUOTE
+

Package:LISP +

+

Syntax: +

+
(quote x)
+
+

or ’x +Simply returns X without evaluating it. +

+ +
+ +
+
Special Form: DOTIMES
+

Package:LISP +

+

Syntax: +

+
(dotimes (var countform [result]) {decl}* {tag | statement}*)
+
+ +

Executes STATEMENTs, with VAR bound to each number between 0 (inclusive) and +the value of COUNTFORM (exclusive). Then returns the value(s) of RESULT +(which defaults to NIL). +

+ +
+ +
+
Function: SPECIAL-FORM-P (symbol)
+

Package:LISP +

+

Returns T if SYMBOL globally names a special form; NIL otherwise. +The special forms defined in Steele’s manual are: +

+
block		if			progv
+catch		labels			quote
+compiler-let	let			return-from
+declare		let*			setq
+eval-when	macrolet		tagbody
+flet		multiple-value-call	the
+function	multiple-value-prog1	throw
+go		progn			unwind-protect
+
+ +

In addition, GCL implements the following macros as special forms, though +of course macro-expanding functions such as MACROEXPAND work correctly for +these macros. +

+
+
and		incf			prog1
+case		locally			prog2
+cond		loop			psetq
+decf		multiple-value-bind	push
+defmacro	multiple-value-list	return
+defun		multiple-value-set	setf
+do		or			unless
+do*		pop			when
+dolist		prog
+dotimes		prog* 
+
+ + +
+ +
+
Special Form: FUNCTION
+

Package:LISP +

+

Syntax: +

+
(function x)
+
+

or #’x +If X is a lambda expression, creates and returns a lexical closure of X in +the current lexical environment. If X is a symbol that names a function, +returns that function. +

+ +
+ +
+
Constant: MULTIPLE-VALUES-LIMIT
+

Package:LISP +The exclusive upper bound on the number of values that may be returned from +a function. Actually, however, there is no such upper bound in GCL. +

+ +
+ +
+
Function: APPLYHOOK (function args evalhookfn applyhookfn &optional (env nil))
+

Package:LISP +

+

Applies FUNCTION to ARGS, with *EVALHOOK* bound to EVALHOOKFN and with +*APPLYHOOK* bound to APPLYHOOKFN. Ignores the hook function once, for the +top-level application of FUNCTION to ARGS. +

+ +
+ +
+
Variable: *MACROEXPAND-HOOK*
+

Package:LISP +Holds a function that can take two arguments (a macro expansion function +and the macro form to be expanded) and returns the expanded form. This +function is whenever a macro-expansion takes place. Initially this is set to +#’FUNCALL. +

+ +
+ +
+
Special Form: PROG*
+

Package:LISP +

+

Syntax: +

+
(prog* ({var | (var [init])}*) {decl}* {tag | statement}*)
+
+ +

Creates a NIL block, binds VARs sequentially, and then executes STATEMENTs. +

+ +
+ +
+
Special Form: BLOCK
+

Package:LISP +

+

Syntax: +

+
(block name {form}*)
+
+ +

The FORMs are evaluated in order, but it is possible to exit the block +using (RETURN-FROM name value). The RETURN-FROM must be lexically contained +within the block. +

+ +
+ +
+
Special Form: PROGN
+

Package:LISP +

+

Syntax: +

+
(progn {form}*)
+
+ +

Evaluates FORMs in order, and returns whatever the last FORM returns. +

+ +
+ +
+
Function: APPLY (function arg &rest more-args)
+

Package:LISP +

+

Applies FUNCTION. The arguments to the function consist of all ARGs +except for the last, and all elements of the last ARG. +

+ +
+ +
+
Special Form: LABELS
+

Package:LISP +

+

Syntax: +

+
(labels ({(name lambda-list {decl | doc}* {form}*)}*) . body)
+
+ +

Evaluates BODY as a PROGN, with the local function definitions in effect. The +scope of the locally defined functions include the function definitions +themselves, so their definitions may include recursive references. See the doc +of DEFUN for the complete syntax of a lambda-list. Doc-strings for local +functions are simply ignored. +

+ +
+ +
+
Special Form: RETURN
+

Package:LISP +

+

Syntax: +

+
(return [result])
+
+ +

Returns from the lexically surrounding NIL block. The value of RESULT, +which defaults to NIL, is returned as the value of the block. +

+ +
+ +
+
Macro: TYPECASE
+

Package:LISP +

+

Syntax: +

+
(typecase keyform {(type {form}*)}*)
+
+ +

Evaluates KEYFORM and tries to find the TYPE in which the value of KEYFORM +belongs. If one is found, then evaluates FORMs that follow the KEY and +returns the value of the last FORM. If not, simply returns NIL. +

+ +
+ +
+
Special Form: AND
+

Package:LISP +

+

Syntax: +

+
(and {form}*)
+
+ +

Evaluates FORMs in order from left to right. If any FORM evaluates to NIL, +returns immediately with the value NIL. Else, returns the value(s) of the +last FORM. +

+ +
+ +
+
Special Form: LET
+

Package:LISP +

+

Syntax: +

+
(let ({var | (var [value])}*) {decl}* {form}*)
+
+ +

Initializes VARs, binding them to the values of VALUEs (which defaults to NIL) +all at once, then evaluates FORMs as a PROGN. +

+ +
+ +
+
Special Form: COND
+

Package:LISP +

+

Syntax: +

+
(cond {(test {form}*)}*)
+
+

Evaluates each +TEST in order until one evaluates to a non-NIL value. Then evaluates +the associated FORMs in order and returns the value(s) of the last +FORM. If no forms follow the TEST, then returns the value of the +TEST. Returns NIL, if all TESTs evaluate to NIL. +

+ +
+ +
+
Function: GET-SETF-METHOD-MULTIPLE-VALUE (form)
+

Package:LISP + Returns the five values (or five ’gangs’) +constituting the SETF method for FORM. See the doc of +DEFINE-SETF-METHOD for the meanings of the gangs. The third value +(i.e., the list of store variables) may consist of any number of +elements. See the doc of GET-SETF-METHOD for +comparison. +

+ +
+ +
+
Special Form: CATCH
+

Package:LISP +

+

Syntax: +

+
(catch tag {form}*)
+
+ +

Sets up a catcher with +that value TAG. Then evaluates FORMs as a PROGN, but may possibly +abort the evaluation by a THROW form that specifies the value EQ to +the catcher tag. +

+ +
+ +
+
Macro: DEFINE-MODIFY-MACRO
+

Package:LISP +

+

Syntax: +

+
(define-modify-macro name lambda-list fun [doc])
+
+ +

Defines a read-modify-write macro, like PUSH and INCF. The defined macro will +expand a form (NAME place val1 ... valn) into a form that in effect SETFs the +value of the call (FUN PLACE arg1 ... argm) into PLACE, where arg1 ... argm +are parameters in LAMBDA-LIST which are bound to the forms VAL1 ... VALn. +The doc-string DOC, if supplied, is saved as a FUNCTION doc and can be +retrieved by (documentation ’NAME ’function). +

+ +
+ +
+
Function: MACROEXPAND-1 (form &optional (env nil))
+

Package:LISP +

+

If FORM is a macro form, then expands it once. Returns two values: the +expanded form and a T-or-NIL flag indicating whether the original form was +a macro. +

+ +
+ +
+
Function: FUNCALL (function &rest arguments)
+

Package:LISP +

+

Applies FUNCTION to the ARGUMENTs +

+ +
+ +
+
Constant: CALL-ARGUMENTS-LIMIT
+

Package:LISP +The upper exclusive bound on the number of arguments that may be passed to +a function. Actually, however, there is no such upper bound in GCL. +

+ +
+ +
+
Special Form: CASE
+

Package:LISP +

+

Syntax: +

+
(case keyform {({key | ({key}*)} {form}*)}*)
+
+ +

Evaluates KEYFORM and tries to find the KEY that is EQL to the value of +KEYFORM. If one is found, then evaluates FORMs that follow the KEY and +returns the value(s) of the last FORM. If not, simply returns NIL. +

+ +
+ +
+
Macro: DEFINE-SETF-METHOD
+

Package:LISP +

+

Syntax: +

+
(define-setf-method access-fun defmacro-lambda-list {decl | doc}*
+          {form}*)
+
+ +

Defines how to SETF a generalized-variable reference of the form +(ACCESS-FUN ...). When a form (setf (ACCESS-FUN arg1 ... argn) value) is +being evaluated, the FORMs are first evaluated as a PROGN with the parameters +in DEFMACRO-LAMBDA-LIST bound to ARG1 ... ARGn. Assuming that the last FORM +returns five values + (temp-var-1 ... temp-var-k) + (value-from-1 ... value-form-k) + (store-var) + storing-form + access-form +in order, the whole SETF is then expanded into + (let* ((temp-var-1 value-from-1) ... (temp-k value-form-k) + (store-var VALUE)) + storing-from) +Incidentally, the five values are called the five gangs of a SETF method. +The doc-string DOC, if supplied, is saved as a SETF doc and can be retrieved +by (documentation ’NAME ’setf). +

+ +
+ +
+
Special Form: COMPILER-LET
+

Package:LISP +

+

Syntax: +

+
(compiler-let ({var | (var [value])}*) {form}*)
+
+ +

When interpreted, this form works just like a LET form with all VARs declared +special. When compiled, FORMs are processed with the VARs bound at compile +time, but no bindings occur when the compiled code is executed. +

+ +
+ +
+
Function: VALUES (&rest args)
+

Package:LISP +

+

Returns ARGs in order, as values. +

+ +
+ +
+
Special Form: MULTIPLE-VALUE-LIST
+

Package:LISP +

+

Syntax: +

+
(multiple-value-list form)
+
+ +

Evaluates FORM, and returns a list of multiple values it returned. +

+ +
+ +
+
Special Form: MULTIPLE-VALUE-PROG1
+

Package:LISP +

+

Syntax: +

+
(multiple-value-prog1 form {form}*)
+
+ +

Evaluates the first FORM, saves all the values produced, then evaluates +the other FORMs. Returns the saved values. +

+ +
+ +
+
Special Form: MACROLET
+

Package:LISP +

+

Syntax: +

+
(macrolet ({(name defmacro-lambda-list {decl | doc}* . body)}*)
+          {form}*)
+
+ +

Evaluates FORMs as a PROGN, with the local macro definitions in effect. +See the doc of DEFMACRO for the complete syntax of a defmacro-lambda-list. +Doc-strings for local macros are simply ignored. +

+ +
+ +
+
Special Form: GO
+

Package:LISP +

+

Syntax: +

+
(go tag)
+
+ +

Jumps to the specified TAG established by a lexically surrounding TAGBODY. +

+ +
+ +
+
Special Form: PROG
+

Package:LISP +

+

Syntax: +

+
(prog ({var | (var [init])}*) {decl}* {tag | statement}*)
+
+ +

Creates a NIL block, binds VARs in parallel, and then executes STATEMENTs. +

+ +
+ +
+
Variable: *APPLYHOOK*
+

Package:LISP +Used to substitute another function for the implicit APPLY normally done +within EVAL. If *APPLYHOOK* is not NIL, its value must be a function +which takes three arguments: a function to be applied, a list of arguments, +and an environment. This function does the application instead of APPLY. +

+ +
+ +
+
Special Form: RETURN-FROM
+

Package:LISP +

+

Syntax: +

+
(return-from name [result])
+
+ +

Returns from the lexically surrounding block whose name is NAME. The value +of RESULT, which defaults to NIL, is returned as the value of the block. +

+ +
+ +
+
Special Form: UNLESS
+

Package:LISP +

+

Syntax: +

+
(unless test {form}*)
+
+ +

If TEST evaluates to NIL, then evaluates FORMs as a PROGN. If not, +simply returns NIL. +

+ +
+ +
+
Special Form: MULTIPLE-VALUE-SETQ
+

Package:LISP +

+

Syntax: +

+
(multiple-value-setq variables form)
+
+ +

Sets each variable in the list VARIABLES to the corresponding value of FORM. +Returns the value assigned to the first variable. +

+ +
+ +
+
Special Form: LOCALLY
+

Package:LISP +

+

Syntax: +

+
(locally {decl}* {form}*)
+
+ +

Gives local pervasive declarations. +

+ +
+ +
+
Function: IDENTITY (x)
+

Package:LISP +

+

Simply returns X. +

+ +
+ +
+
Function: NOT (x)
+

Package:LISP +

+

Returns T if X is NIL; NIL otherwise. +

+ +
+ +
+
Macro: DEFCONSTANT
+

Package:LISP +

+

Syntax: +

+
(defconstant name initial-value [doc])
+
+ +

Declares that the variable NAME is a constant whose value is the value of +INITIAL-VALUE. The doc-string DOC, if supplied, is saved as a VARIABLE doc +and can be retrieved by (documentation ’NAME ’variable). +

+ +
+ +
+
Function: VALUES-LIST (list)
+

Package:LISP +

+

Returns all of the elements of LIST in order, as values. +

+ +
+ +
+
Function: ERROR (control-string &rest args)
+

Package:LISP +

+

Signals a fatal error. +

+ +
+ +
+
Special Form: IF
+

Package:LISP +

+

Syntax: +

+
(if test then [else])
+
+ +

If TEST evaluates to non-NIL, then evaluates THEN and returns the result. +If not, evaluates ELSE (which defaults to NIL) and returns the result. +

+ +
+ +
+
Special Form: UNWIND-PROTECT
+

Package:LISP +

+

Syntax: +

+
(unwind-protect protected-form {cleanup-form}*)
+
+ +

Evaluates PROTECTED-FORM and returns whatever it returned. Guarantees that +CLEANUP-FORMs be always evaluated before exiting from the UNWIND-PROTECT +form. +

+ +
+ +
+
Function: EVALHOOK (form evalhookfn applyhookfn &optional (env nil))
+

Package:LISP +

+

Evaluates FORM with *EVALHOOK* bound to EVALHOOKFN and *APPLYHOOK* bound +to APPLYHOOKFN. Ignores these hooks once, for the top-level evaluation +of FORM. +

+ +
+ +
+
Special Form: OR
+

Package:LISP +

+

Syntax: +

+
(or {form}*)
+
+ +

Evaluates FORMs in order from left to right. If any FORM evaluates to +non-NIL, quits and returns that (single) value. If the last FORM is reached, +returns whatever values it returns. +

+ +
+ +
+
Macro: CTYPECASE
+

Package:LISP +

+

Syntax: +

+
(ctypecase keyplace {(type {form}*)}*)
+
+ +

Evaluates KEYPLACE and tries to find the TYPE in which the value of KEYPLACE +belongs. If one is found, then evaluates FORMs that follow the KEY and +returns the value(s) of the last FORM. If not, signals a correctable error. +

+ +
+ +
+
Function: EVAL (exp)
+

Package:LISP +

+

Evaluates EXP and returns the result(s). +

+ +
+ +
+
Macro: PSETF
+

Package:LISP +

+

Syntax: +

+
(psetf {place newvalue}*)
+
+ +

Similar to SETF, but evaluates all NEWVALUEs first, and then replaces the +value in each PLACE with the value of the corresponding NEWVALUE. Returns +NIL always. +

+ +
+ +
+
Special Form: THROW
+

Package:LISP +

+

Syntax: +

+
(throw tag result)
+
+ +

Evaluates TAG and aborts the execution of the most recent CATCH form that sets +up a catcher with the same tag value. The CATCH form returns whatever RESULT +returned. +

+ +
+ +
+
Macro: DEFPARAMETER
+

Package:LISP +

+

Syntax: +

+
(defparameter name initial-value [doc])
+
+ +

Declares the variable NAME as a special variable and initializes the value. +The doc-string DOC, if supplied, is saved as a VARIABLE doc and can be +retrieved by (documentation ’NAME ’variable). +

+ +
+ +
+
Macro: DEFVAR
+

Package:LISP +

+

Syntax: +

+
(defvar name [initial-value [doc]])
+
+ +

Declares the variable NAME as a special variable and, optionally, initializes +it. The doc-string DOC, if supplied, is saved as a VARIABLE doc and can be +retrieved by (documentation ’NAME ’variable). +

+ +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Streams-and-Reading.html b/info/gcl-si/Streams-and-Reading.html new file mode 100644 index 0000000..2555d40 --- /dev/null +++ b/info/gcl-si/Streams-and-Reading.html @@ -0,0 +1,1163 @@ + + + + + +Streams and Reading (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

5 Streams and Reading

+ +
+
Function: MAKE-ECHO-STREAM (input-stream output-stream)
+

Package:LISP +

+

Returns a bidirectional stream which gets its input from INPUT-STREAM and +sends its output to OUTPUT-STREAM. In addition, all input is echoed to +OUTPUT-STREAM. +

+ +
+ +
+
Variable: *READTABLE*
+

Package:LISP +The current readtable. +

+ +
+ +
+
Function: LOAD (filename &key (verbose *load-verbose*) (print nil) (if-does-not-exist :error))
+

Package:LISP +

+

Loads the file named by FILENAME into GCL. +

+ +
+ +
+
Function: OPEN (filename &key (direction :input) (element-type 'string-char) (if-exists :error) (if-does-not-exist :error))
+

Package:LISP +

+

Opens the file specified by FILENAME, which may be a string, a pathname, +or a stream. Returns a stream for the open file. +DIRECTION is :INPUT, :OUTPUT, :IO or :PROBE. +ELEMENT-TYPE is STRING-CHAR, (UNSIGNED-BYTE n), +UNSIGNED-BYTE, (SIGNED-BYTE n), SIGNED-BYTE, CHARACTER, BIT, (MOD n), or +:DEFAULT. +IF-EXISTS is :ERROR, :NEW-VERSION, :RENAME, +:RENAME-AND-DELETE, :OVERWRITE, :APPEND, :SUPERSEDE, or NIL. +IF-DOES-NOT-EXIST is :ERROR, :CREATE, or NIL. +

+

If FILENAME begins with a vertical pipe sign: ’|’ then the resulting +stream is actually a one way pipe. It will be open for reading +or writing depending on the direction given. The rest +of FILENAME in this case is passed to the /bin/sh command. See +the posix description of popen for more details. +

+
(setq pipe (open "| wc < /tmp/jim"))
+(format t "File has ~%d lines" (read pipe))
+(close pipe)
+
+ +
+ +
+
Variable: *PRINT-BASE*
+

Package:LISP +The radix in which the GCL printer prints integers and rationals. +The value must be an integer from 2 to 36, inclusive. +

+ +
+ +
+
Function: MAKE-STRING-INPUT-STREAM (string &optional (start 0) (end (length string)))
+

Package:LISP +

+

Returns an input stream which will supply the characters of String between +Start and End in order. +

+ +
+ +
+
Function: PPRINT (object &optional (stream *standard-output*))
+

Package:LISP +

+

Pretty-prints OBJECT. Returns OBJECT. Equivalent to + (WRITE :STREAM STREAM :PRETTY T) +The SI:PRETTY-PRINT-FORMAT property N (which must be a non-negative integer) +of a symbol SYMBOL controls the pretty-printing of form + (SYMBOL f1 ... fN fN+1 ... fM) +in such a way that the subforms fN+1, ..., fM are regarded as the ’body’ of +the entire form. For instance, the property value of 2 is initially given +to the symbol DO. +

+ +
+ +
+
Variable: *READ-DEFAULT-FLOAT-FORMAT*
+

Package:LISP +The floating-point format the GCL reader uses when reading floating-point +numbers that have no exponent marker or have e or E for an exponent marker. +Must be one of SHORT-FLOAT, SINGLE-FLOAT, DOUBLE-FLOAT, and LONG-FLOAT. +

+ +
+ +
+
Function: READ-PRESERVING-WHITESPACE (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil))
+

Package:LISP +

+

Reads an object from STREAM, preserving the whitespace that followed the +object. +

+ +
+ +
+
Function: STREAMP (x)
+

Package:LISP +

+

Returns T if X is a stream object; NIL otherwise. +

+ +
+ + +
+
Function: SET-DISPATCH-MACRO-CHARACTER (disp-char sub-char function &optional (readtable *readtable*))
+

Package:LISP +

+

Causes FUNCTION to be called when the DISP-CHAR followed by SUB-CHAR is +read. +

+ +
+ +
+
Macro: WITH-OUTPUT-TO-STRING
+

Package:LISP +

+

Syntax: +

+
(with-output-to-string (var [string]) {decl}* {form}*)
+
+ +

Binds VAR to a string output stream that puts characters into STRING, which +defaults to a new string. The stream is automatically closed on exit and +the string is returned. +

+ +
+ +
+
Function: FILE-LENGTH (file-stream)
+

Package:LISP +

+

Returns the length of the specified file stream. +

+ +
+ +
+
Variable: *PRINT-CASE*
+

Package:LISP +The case in which the GCL printer should print ordinary symbols. +The value must be one of the keywords :UPCASE, :DOWNCASE, and :CAPITALIZE. +

+ +
+ +
+
Function: PRINT (object &optional (stream *standard-output*))
+

Package:LISP +

+

Outputs a newline character, and then prints OBJECT in the mostly readable +representation. Returns OBJECT. Equivalent to + (PROGN (TERPRI STREAM) (WRITE OBJECT :STREAM STREAM :ESCAPE T)). +

+ +
+ +
+
Function: SET-MACRO-CHARACTER (char function &optional (non-terminating-p nil) (readtable *readtable*))
+

Package:LISP +

+

Causes CHAR to be a macro character that, when seen by READ, causes FUNCTION +to be called. +

+ +
+ +
+
Function: FORCE-OUTPUT (&optional (stream *standard-output*))
+

Package:LISP +

+

Attempts to force any buffered output to be sent. +

+ +
+ +
+
Variable: *PRINT-ARRAY*
+

Package:LISP +Whether the GCL printer should print array elements. +

+ +
+ +
+
Function: STREAM-ELEMENT-TYPE (stream)
+

Package:LISP +

+

Returns a type specifier for the kind of object returned by STREAM. +

+ +
+ +
+
Function: WRITE-BYTE (integer stream)
+

Package:LISP +

+

Outputs INTEGER to the binary stream STREAM. Returns INTEGER. +

+ +
+ +
+
Function: MAKE-CONCATENATED-STREAM (&rest streams)
+

Package:LISP +

+

Returns a stream which takes its input from each of the STREAMs in turn, +going on to the next at end of stream. +

+ +
+ +
+
Function: PRIN1 (object &optional (stream *standard-output*))
+

Package:LISP +

+

Prints OBJECT in the mostly readable representation. Returns OBJECT. +Equivalent to (WRITE OBJECT :STREAM STREAM :ESCAPE T). +

+ +
+ +
+
Function: PRINC (object &optional (stream *standard-output*))
+

Package:LISP +

+

Prints OBJECT without escape characters. Returns OBJECT. Equivalent to + (WRITE OBJECT :STREAM STREAM :ESCAPE NIL). +

+ +
+ +
+
Function: CLEAR-OUTPUT (&optional (stream *standard-output*))
+

Package:LISP +

+

Clears the output stream STREAM. +

+ +
+ +
+
Function: TERPRI (&optional (stream *standard-output*))
+

Package:LISP +

+

Outputs a newline character. +

+ +
+ +
+
Function: FINISH-OUTPUT (&optional (stream *standard-output*))
+

Package:LISP +

+

Attempts to ensure that all output sent to STREAM has reached its destination, +and only then returns. +

+ +
+ +
+
Macro: WITH-OPEN-FILE
+

Package:LISP +

+

Syntax: +

+
(with-open-file (stream filename {options}*) {decl}* {form}*)
+
+ +

Opens the file whose name is FILENAME, using OPTIONs, and binds the variable +STREAM to a stream to/from the file. Then evaluates FORMs as a PROGN. +The file is automatically closed on exit. +

+ +
+ +
+
Special Form: DO
+

Package:LISP +

+

Syntax: +

+
(do ({(var [init [step]])}*) (endtest {result}*)
+          {decl}* {tag | statement}*)
+
+ +

Creates a NIL block, binds each VAR to the value of the corresponding INIT, +and then executes STATEMENTs repeatedly until ENDTEST is satisfied. After +each iteration, assigns to each VAR the value of the corresponding STEP. When +ENDTEST is satisfied, evaluates RESULTs as a PROGN and returns the value(s) of +the last RESULT (or NIL if no RESULTs are supplied). Performs variable +bindings and assignments all at once, just like LET and PSETQ do. +

+ +
+ +
+
Function: READ-FROM-STRING (string &optional (eof-error-p t) (eof-value nil) &key (start 0) (end (length string)) (preserve-whitespace nil))
+

Package:LISP +

+

Reads an object from STRING. +

+ +
+ +
+
Function: WRITE-STRING (string &optional (stream *standard-output*) &key (start 0) (end (length string)))
+

Package:LISP +

+

Outputs STRING and returns it. +

+ +
+ +
+
Variable: *PRINT-LEVEL*
+

Package:LISP +How many levels deep the GCL printer should print. Unlimited if NIL. +

+ +
+ +
+
Variable: *PRINT-RADIX*
+

Package:LISP +Whether the GCL printer should print the radix indicator when printing +integers and rationals. +

+ +
+ +
+
Function: Y-OR-N-P (&optional (format-string nil) &rest args)
+

Package:LISP +

+

Asks the user a question whose answer is either ’Y’ or ’N’. If FORMAT-STRING +is non-NIL, then FRESH-LINE operation is performed, a message is printed as +if FORMAT-STRING and ARGs were given to FORMAT, and then a prompt +"(Y or N)" is printed. Otherwise, no prompt will appear. +

+ +
+ +
+
Function: MAKE-BROADCAST-STREAM (&rest streams)
+

Package:LISP +

+

Returns an output stream which sends its output to all of the given streams. +

+ +
+ +
+
Function: READ-CHAR (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil))
+

Package:LISP +

+

Reads a character from STREAM. +

+ +
+ +
+
Function: PEEK-CHAR (&optional (peek-type nil) (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil))
+

Package:LISP +

+

Peeks at the next character in the input stream STREAM. +

+ +
+ +
+
Function: OUTPUT-STREAM-P (stream)
+

Package:LISP +

+

Returns non-nil if STREAM can handle output operations; NIL otherwise. +

+ +
+ +
+
Variable: *QUERY-IO*
+

Package:LISP +The query I/O stream. +

+ +
+ +
+
Variable: *READ-BASE*
+

Package:LISP +The radix that the GCL reader reads numbers in. +

+ +
+ +
+
Macro: WITH-OPEN-STREAM
+

Package:LISP +

+

Syntax: +

+
(with-open-stream (var stream) {decl}* {form}*)
+
+ +

Evaluates FORMs as a PROGN with VAR bound to the value of STREAM. The stream +is automatically closed on exit. +

+ +
+ +
+
Macro: WITH-INPUT-FROM-STRING
+

Package:LISP +

+

Syntax: +

+
(with-input-from-string (var string {keyword value}*) {decl}*
+{form}*)
+
+ +

Binds VAR to an input stream that returns characters from STRING and evaluates +the FORMs. The stream is automatically closed on exit. Allowed keywords are +:INDEX, :START, and :END. +

+ +
+ +
+
Function: CLEAR-INPUT (&optional (stream *standard-input*))
+

Package:LISP + Clears the input +stream STREAM. +

+ +
+ +
+
Variable: *TERMINAL-IO*
+

Package:LISP +The terminal I/O stream. +

+ +
+ +
+
Function: LISTEN (&optional (stream *standard-input*))
+

Package:LISP +

+

Returns T if a character is available on STREAM; NIL otherwise. This function +does not correctly work in some versions of GCL because of the lack of such +mechanism in the underlying operating system. +

+ +
+ +
+
Function: MAKE-PATHNAME (&key (defaults (parse-namestring "" (pathname-host *default-pathname-defaults*))) (host (pathname-host defaults)) (device (pathname-device defaults)) (directory (pathname-directory defaults)) (name (pathname-name defaults)) (type (pathname-type defaults)) (version (pathname-version defaults)))
+

Package:LISP +

+

Create a pathname from HOST, DEVICE, DIRECTORY, NAME, TYPE and VERSION. +

+ +
+ +
+
Function: PATHNAME-TYPE (pathname)
+

Package:LISP +

+

Returns the type slot of PATHNAME. +

+ +
+ +
+
Variable: *PRINT-GENSYM*
+

Package:LISP +Whether the GCL printer should prefix symbols with no home package +with "#:". +

+ +
+ +
+
Function: READ-LINE (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil))
+

Package:LISP +

+

Returns a line of text read from STREAM as a string, discarding the newline +character. +

+

Note that when using line at a time input under unix, +input forms will always be followed by a #\newline. Thus if you +do +

+

>(read-line) +"" +nil +

+

the empty string will be returned. After lisp reads the (read-line) +it then invokes (read-line). This happens before it does anything +else and so happens before the newline character immediately following +(read-line) has been read. Thus read-line immediately encounters a +#\newline and so returns the empty string. If there had been other +characters before the #\newline it would have been different: +

+

>(read-line) how are you +" how are you" +nil +

+

If you want to throw away "" input, you can do that with +the following: +

+

(sloop::sloop while (equal (setq input (read-line)) "")) +

+

You may also want to use character at a time input, but that +makes input editing harder. +nicolas% stty cbreak +nicolas% gcl +GCL (GNU Common Lisp) Version(1.1.2) Mon Jan 9 12:58:22 MET 1995 +Licensed under GNU Public Library License +Contains Enhancements by W. Schelter +

+

>(let ((ifilename nil)) + (format t "~%Input file name: ") + (setq ifilename (read-line))) +Input file name: /tmp/myfile +"/tmp/myfile" +

+

>(bye)Bye. +

+ + + +
+ +
+
Function: WRITE-TO-STRING (object &key (escape *print-escape*) (radix *print-radix*) (base *print-base*) (circle *print-circle*) (pretty *print-pretty*) (level *print-level*) (length *print-length*) (case *print-case*) (array *print-array*) (gensym *print-gensym*))
+

Package:LISP +

+

Returns as a string the printed representation of OBJECT in the specified +mode. See the variable docs of *PRINT-...* for the mode. +

+ +
+ +
+
Function: PATHNAMEP (x)
+

Package:LISP +

+

Returns T if X is a pathname object; NIL otherwise. +

+ +
+ +
+
Function: READTABLEP (x)
+

Package:LISP +

+

Returns T if X is a readtable object; NIL otherwise. +

+ +
+ +
+
Function: READ (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursivep nil))
+

Package:LISP +

+

Reads in the next object from STREAM. +

+ +
+ +
+
Function: NAMESTRING (pathname)
+

Package:LISP +

+

Returns the full form of PATHNAME as a string. +

+ +
+ +
+
Function: UNREAD-CHAR (character &optional (stream *standard-input*))
+

Package:LISP +

+

Puts CHARACTER back on the front of the input stream STREAM. +

+ +
+ +
+
Function: CLOSE (stream &key (abort nil))
+

Package:LISP +

+

Closes STREAM. A non-NIL value of :ABORT indicates an abnormal termination. +

+ +
+ +
+
Variable: *PRINT-LENGTH*
+

Package:LISP +How many elements the GCL printer should print at each level of nested data +object. Unlimited if NIL. +

+ +
+ +
+
Function: SET-SYNTAX-FROM-CHAR (to-char from-char &optional (to-readtable *readtable*) (from-readtable nil))
+

Package:LISP +

+

Makes the syntax of TO-CHAR in TO-READTABLE be the same as the syntax of +FROM-CHAR in FROM-READTABLE. +

+ +
+ +
+
Function: INPUT-STREAM-P (stream)
+

Package:LISP +

+

Returns non-NIL if STREAM can handle input operations; NIL otherwise. +

+ +
+ +
+
Function: PATHNAME (x)
+

Package:LISP +

+

Turns X into a pathname. X may be a string, symbol, stream, or pathname. +

+ +
+ +
+
Function: FILE-NAMESTRING (pathname)
+

Package:LISP +

+

Returns the written representation of PATHNAME as a string. +

+ +
+ +
+
Function: MAKE-DISPATCH-MACRO-CHARACTER (char &optional (non-terminating-p nil) (readtable *readtable*))
+

Package:LISP +

+

Causes the character CHAR to be a dispatching macro character in READTABLE. +

+ +
+ +
+
Variable: *STANDARD-OUTPUT*
+

Package:LISP +The default output stream used by the GCL printer. +

+ +
+ +
+
Function: MAKE-TWO-WAY-STREAM (input-stream output-stream)
+

Package:LISP +

+

Returns a bidirectional stream which gets its input from INPUT-STREAM and +sends its output to OUTPUT-STREAM. +

+ +
+ +
+
Variable: *PRINT-ESCAPE*
+

Package:LISP +Whether the GCL printer should put escape characters whenever appropriate. +

+ +
+ +
+
Function: COPY-READTABLE (&optional (from-readtable *readtable*) (to-readtable nil))
+

Package:LISP +

+

Returns a copy of the readtable FROM-READTABLE. If TO-READTABLE is non-NIL, +then copies into TO-READTABLE. Otherwise, creates a new readtable. +

+ +
+ +
+
Function: DIRECTORY-NAMESTRING (pathname)
+

Package:LISP +

+

Returns the directory part of PATHNAME as a string. +

+ +
+ +
+
Function: TRUENAME (pathname)
+

Package:LISP +

+

Returns the pathname for the actual file described by PATHNAME. +

+ +
+ +
+
Variable: *READ-SUPPRESS*
+

Package:LISP +When the value of this variable is NIL, the GCL reader operates normally. +When it is non-NIL, then the reader parses input characters but much of what +is read is not interpreted. +

+ +
+ +
+
Function: GET-DISPATCH-MACRO-CHARACTER (disp-char sub-char &optional (readtable *readtable*))
+

Package:LISP +

+

Returns the macro-character function for SUB-CHAR under DISP-CHAR. +

+ +
+ +
+
Function: PATHNAME-DEVICE (pathname)
+

Package:LISP +

+

Returns the device slot of PATHNAME. +

+ +
+ +
+
Function: READ-CHAR-NO-HANG (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil))
+

Package:LISP +

+

Returns the next character from STREAM if one is available; NIL otherwise. +

+ +
+ +
+
Function: FRESH-LINE (&optional (stream *standard-output*))
+

Package:LISP +

+

Outputs a newline if it is not positioned at the beginning of a line. Returns +T if it output a newline; NIL otherwise. +

+ +
+ +
+
Function: WRITE-CHAR (char &optional (stream *standard-output*))
+

Package:LISP +

+

Outputs CHAR and returns it. +

+ +
+ +
+
Function: PARSE-NAMESTRING (thing &optional host (defaults *default-pathname-defaults*) &key (start 0) (end (length thing)) (junk-allowed nil))
+

Package:LISP +

+

Parses a string representation of a pathname into a pathname. HOST +is ignored. +

+ +
+ +
+
Function: PATHNAME-DIRECTORY (pathname)
+

Package:LISP +

+

Returns the directory slot of PATHNAME. +

+ +
+ +
+
Function: GET-MACRO-CHARACTER (char &optional (readtable *readtable*))
+

Package:LISP +

+

Returns the function associated with CHAR and, as a second value, returns +the non-terminating-p flag. +

+ +
+ +
+
Function: FORMAT (destination control-string &rest arguments)
+

Package:LISP +

+

Provides various facilities for formatting output. +DESTINATION controls where the result will go. If DESTINATION is T, then +the output is sent to the standard output stream. If it is NIL, then the +output is returned in a string as the value of the call. Otherwise, +DESTINATION must be a stream to which the output will be sent. +

+

CONTROL-STRING is a string to be output, possibly with embedded +formatting directives, which are flagged with the escape character +"~". Directives generally expand into additional text to be output, +usually consuming one or more of ARGUMENTs in the process. +

+ + +

A few useful directives are: +

+
+
+~A, ~nA, ~n@A	Prints one argument as if by PRINC
+~S, ~nS, ~n@S	Prints one argument as if by PRIN1
+~D, ~B, ~O, ~X	Prints one integer in decimal, binary, octal, and hexa
+~%		Does TERPRI
+~&		Does FRESH-LINE
+
+ +

where n is the minimal width of the field in which the object is printed. +~nA and ~nS put padding spaces on the right; ~n@A and ~n@S put on the left. +

+
+
~R  is for printing numbers in various formats.
+
+  ~nR   prints arg in radix n.
+  ~R    prints arg as a cardinal english number: two
+  ~:R   prints arg as an ordinal english number: third
+  ~@R   prints arg as an a Roman Numeral: VII
+  ~:@R   prints arg as an old Roman Numeral: IIII
+
+~C prints a character.
+  ~:C represents non printing characters by their pretty names,eg Space
+  ~@C uses the #\ syntax to allow the reader to read it.
+
+~F prints a floating point number arg.
+  The full form is ~w,d,k,overflowchar,padcharF
+  w represents the total width of the printed representation (variable if
+    not present)
+  d the number of fractional digits to display
+    (format nil "~,2f" 10010.0314) --> "10010.03"
+  k arg is multiplied by 10^k before printing it as a decimal number.
+  overflowchar width w characters copies of the overflow character will
+    be printed.   eg(format t "X>~5,2,,'?F<X" 100.034) --> X>?????<X
+  padchar is the character to pad with
+    (format t "X>~10,2,1,'?,'bF<X" 100.03417) -->X>bbb1000.34<X
+  @ makes + sign print if the arg is positive
+
+~@[print-if-true~]
+
+

if arg is not nil, then it is retained as an arg for further printing, + otherwise it is used up +

+
+
   (format nil "~@[x = ~d~]~a" nil 'bil) --> "BIL"
+   (format nil "~@[x = ~d ~]~a" 8) --> "x = 8 BIL"
+
+ + +
+ +
+
Function: PATHNAME-NAME (pathname)
+

Package:LISP +

+

Returns the name slot of PATHNAME. +

+ +
+ +
+
Function: MAKE-STRING-OUTPUT-STREAM ()
+

Package:LISP +

+

Returns an output stream which will accumulate all output given it for +the benefit of the function GET-OUTPUT-STREAM-STRING. +

+ +
+ +
+
Function: MAKE-SYNONYM-STREAM (symbol)
+

Package:LISP +

+

Returns a stream which performs its operations on the stream which is the +value of the dynamic variable named by SYMBOL. +

+ +
+ +
+
Variable: *LOAD-VERBOSE*
+

Package:LISP +The default for the VERBOSE argument to LOAD. +

+ +
+ +
+
Variable: *PRINT-CIRCLE*
+

Package:LISP +Whether the GCL printer should take care of circular lists. +

+ +
+ +
+
Variable: *PRINT-PRETTY*
+

Package:LISP +Whether the GCL printer should pretty-print. See the function doc of PPRINT +for more information about pretty-printing. +

+ +
+ +
+
Function: FILE-WRITE-DATE (file)
+

Package:LISP +

+

Returns the time at which the specified file is written, as an integer in +universal time format. FILE may be a string or a stream. +

+ +
+ +
+
Function: PRIN1-TO-STRING (object)
+

Package:LISP +

+

Returns as a string the printed representation of OBJECT in the mostly +readable representation. +Equivalent to (WRITE-TO-STRING OBJECT :ESCAPE T). +

+ +
+ +
+
Function: MERGE-PATHNAMES (pathname &optional (defaults *default-pathname-defaults*) default-version)
+

Package:LISP +

+

Fills in unspecified slots of PATHNAME from DEFAULTS. DEFAULT-VERSION +is ignored in GCL. +

+ +
+ +
+
Function: READ-BYTE (stream &optional (eof-error-p t) (eof-value nil))
+

Package:LISP +

+

Reads the next byte from STREAM. +

+ +
+ +
+
Function: PRINC-TO-STRING (object)
+

Package:LISP +

+

Returns as a string the printed representation of OBJECT without escape +characters. Equivalent to + (WRITE-TO-STRING OBJECT :ESCAPE NIL). +

+ +
+ +
+
Variable: *STANDARD-INPUT*
+

Package:LISP +The default input stream used by the GCL reader. +

+ +
+ +
+
Function: PROBE-FILE (file)
+

Package:LISP +

+

Returns the truename of file if the file exists. +Returns NIL otherwise. +

+ +
+ +
+
Function: PATHNAME-VERSION (pathname)
+

Package:LISP +

+

Returns the version slot of PATHNAME. +

+ +
+ +
+
Function: WRITE-LINE (string &optional (stream *standard-output*) &key (start 0) (end (length string)))
+

Package:LISP +

+

Outputs STRING and then outputs a newline character. Returns STRING. +

+ +
+ +
+
Function: WRITE (object &key (stream *standard-output*) (escape *print-escape*) (radix *print-radix*) (base *print-base*) (circle *print-circle*) (pretty *print-pretty*) (level *print-level*) (length *print-length*) (case *print-case*) (array *print-array*) (gensym *print-gensym*))
+

Package:LISP +

+

Prints OBJECT in the specified mode. See the variable docs of *PRINT-...* +for the mode. +

+ +
+ +
+
Function: GET-OUTPUT-STREAM-STRING (stream)
+

Package:LISP +

+

Returns a string of all the characters sent to STREAM made by +MAKE-STRING-OUTPUT-STREAM since the last call to this function. +

+ +
+ +
+
Function: READ-DELIMITED-LIST (char &optional (stream *standard-input*) (recursive-p nil))
+

Package:LISP +

+

Reads objects from STREAM until the next character after an object’s +representation is CHAR. Returns a list of the objects read. +

+ +
+ +
+
Function: READLINE-ON ()
+

Package:SI +

+

Begins readline command editing mode when possible. In addition to +the basic readline editing features, command word completion is +implemented according to the following scheme: +

+

[[pkg]:[:]]txt +

+

pkg – an optional package specifier. Defaults to the current +package. The symbols in this package and those in the packages in +this package’s use list will be searched. +

+

:[:] – an optional internal/external specifier. Defaults to +external. The keyword package is denoted by a single colon at the +beginning of the token. Only symbols of this type will be searched +for completion. +

+

txt – a string. Symbol names beginning with this string are +completed. The comparison is case insensitive. +

+ +
+ +
+
Function: READLINE-OFF ()
+

Package:SI +

+

Disables readline command editing mode. +

+
+ +
+
Variable: *READLINE-PREFIX*
+

Package:SI +

+

A string implicitly prepended to input text for use in readline +command completion. If this string contains one or more colons, it is +used to specify the default package and internal/external setting for +searched symbols in the case that the supplied text itself contains no +explicit package specification. If this string contains characters +after the colon(s), or contains no colons at all, it is treated as a +symbol name prefix. In this case, the prefix is matched first, then +the supplied text, and the completion returned is relative to the +supplied text itself, i.e. contains no prefix. For example, the +setting “maxima::$” will complete input text “int” according to +the internal symbols in the maxima package of the form +“maxima::$int...”, and return suggestions to the user of the form +“int...”. +

+
+ + +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Structures.html b/info/gcl-si/Structures.html new file mode 100644 index 0000000..06670fd --- /dev/null +++ b/info/gcl-si/Structures.html @@ -0,0 +1,96 @@ + + + + + +Structures (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

10 Structures

+ +
+
Macro: DEFSTRUCT
+

Package:LISP +

+

Syntax: +

+
(defstruct
+         {name | (name {:conc-name | (:conc-name prefix-string) |
+                        :constructor | (:constructor symbol [lambda-list]) |
+                        :copier | (:copier symbol) |
+                        :predicate | (:predicate symbol) | 
+                        (:include symbol) |
+                        (:print-function function) |
+                        (:type {vector | (vector type) | list}) |
+                        :named | (:static { nil | t})
+                        (:initial-offset number)}*)}
+         [doc]
+         {slot-name |
+          (slot-name [default-value-form] {:type type | :read-only flag}*) }*
+         )
+
+ +

Defines a structure. The doc-string DOC, if supplied, is saved as a STRUCTURE +doc and can be retrieved by (documentation ’NAME ’structure). +STATIC is gcl specific and makes the body non relocatable. +

+

See the files misc/rusage.lsp misc/cstruct.lsp, for examples of making +a lisp structure correspond to a C structure. +

+ + +
+ +
+
Function: HELP (&optional symbol)
+

Package:LISP +

+

GCL specific: Prints the documentation associated with SYMBOL. With no +argument, this function prints the greeting message to GCL beginners. +

+ +
+ + + + + + diff --git a/info/gcl-si/Symbols.html b/info/gcl-si/Symbols.html new file mode 100644 index 0000000..5a42a18 --- /dev/null +++ b/info/gcl-si/Symbols.html @@ -0,0 +1,568 @@ + + + + + +Symbols (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

8 Symbols

+ +
+
Function: GENSYM (&optional (x nil))
+

Package:LISP +

+

Creates and returns a new uninterned symbol whose name is a prefix string +(defaults to "G"), followed by a decimal number. The number is incremented +by each call to GENSYM. X, if an integer, resets the counter. If X is a +string, it becomes the new prefix. +

+ +
+ +
+
Function: KEYWORDP (x)
+

Package:LISP +

+

Returns T if X is a symbol and it belongs to the KEYWORD package; NIL +otherwise. +

+ +
+ +
+
Function: REMPROP (symbol indicator)
+

Package:LISP +

+

Look on property list of SYMBOL for property with specified +INDICATOR. If found, splice this indicator and its value out of +the plist, and return T. If not found, returns NIL with no side effects. +

+
+ +
+
Function: SYMBOL-PACKAGE (symbol)
+

Package:LISP +

+

Returns the contents of the package cell of the symbol SYMBOL. +

+ +
+ +
+
Variable: *PACKAGE*
+

Package:LISP +The current package. +

+ +
+ + +
+
Function: SHADOWING-IMPORT (symbols &optional (package *package*))
+

Package:LISP +

+

Imports SYMBOLS into PACKAGE, disregarding any name conflict. If a symbol +of the same name is already present, then it is uninterned. SYMBOLS must +be a list of symbols or a symbol. +

+ +
+ +
+
Macro: REMF
+

Package:LISP +

+

Syntax: +

+
(remf place indicator)
+
+ +

PLACE may be any place expression acceptable to SETF, and is expected +to hold a property list or NIL. This list is destructively altered to +remove the property specified by INDICATOR. Returns T if such a +property was present; NIL otherwise. +

+ +
+ +
+
Function: MAKUNBOUND (symbol)
+

Package:LISP +

+

Makes empty the value slot of SYMBOL. Returns SYMBOL. +

+ +
+ +
+
Function: USE-PACKAGE (packages-to-use &optional (package *package*))
+

Package:LISP +

+

Adds all packages in PACKAGE-TO-USE list to the use list for PACKAGE so that +the external symbols of the used packages are available as internal symbols +in PACKAGE. +

+ +
+ +
+
Function: MAKE-SYMBOL (string)
+

Package:LISP +

+

Creates and returns a new uninterned symbol whose print name is STRING. +

+ +
+ +
+
Special Form: PSETQ
+

Package:LISP +

+

Syntax: +

+
(psetq {var form}*)
+
+ +

Similar to SETQ, but evaluates all FORMs first, and then assigns each value to +the corresponding VAR. Returns NIL always. +

+ +
+ +
+
Function: PACKAGE-USED-BY-LIST (package)
+

Package:LISP +

+

Returns the list of packages that use PACKAGE. +

+ +
+ +
+
Function: SYMBOLP (x)
+

Package:LISP +

+

Returns T if X is a symbol; NIL otherwise. +

+ +
+ +
+
Constant: NIL
+

Package:LISP +Holds NIL. +

+ +
+ +
+
Function: SET (symbol value)
+

Package:LISP +

+

Assigns the value of VALUE to the dynamic variable named by SYMBOL, and +returns the value assigned. +

+ +
+ +
+
Special Form: SETQ
+

Package:LISP +

+

Syntax: +

+
(setq {var form}*)
+
+ +

VARs are not evaluated and must be symbols. Assigns the value of the first +FORM to the first VAR, then assigns the value of the second FORM to the second +VAR, and so on. Returns the last value assigned. +

+ +
+ +
+
Function: UNUSE-PACKAGE (packages-to-unuse &optional (package *package*))
+

Package:LISP +

+

Removes PACKAGES-TO-UNUSE from the use list for PACKAGE. +

+ +
+ +
+
Constant: T
+

Package:LISP +Holds T. +

+ +
+ +
+
Function: PACKAGE-USE-LIST (package)
+

Package:LISP +

+

Returns the list of packages used by PACKAGE. +

+ +
+ +
+
Function: LIST-ALL-PACKAGES ()
+

Package:LISP +

+

Returns a list of all existing packages. +

+ +
+ +
+
Function: COPY-SYMBOL (symbol &optional (copy-props nil))
+

Package:LISP +

+

Returns a new uninterned symbol with the same print name as SYMBOL. +If COPY-PROPS is NIL, the function, the variable, and the property slots +of the new symbol have no value. Otherwise, these slots are given the +values of the corresponding slots of SYMBOL. +

+ +
+ +
+
Function: SYMBOL-PLIST (symbol)
+

Package:LISP +

+

Returns the property list of SYMBOL. +

+ +
+ +
+
Function: SYMBOL-NAME (symbol)
+

Package:LISP +

+

Returns the print name of the symbol SYMBOL. +

+ +
+ +
+
Function: FIND-SYMBOL (name &optional (package *package*))
+

Package:LISP +

+

Returns the symbol named NAME in +PACKAGE. If such a symbol is found, then the second value is :INTERN, +:EXTERNAL, or :INHERITED to indicate how the symbol is accessible. If +no symbol is found then both values are NIL. +

+ +
+ +
+
Function: SHADOW (symbols &optional (package *package*))
+

Package:LISP +

+

Creates an internal symbol in PACKAGE with the same name as each of the +specified SYMBOLS. SYMBOLS must be a list of symbols or a symbol. +

+ +
+ + +
+
Function: FBOUNDP (symbol)
+

Package:LISP +

+

Returns T if SYMBOL has a global function definition or if SYMBOL names a +special form or a macro; NIL otherwise. +

+ +
+ +
+
Function: MACRO-FUNCTION (symbol)
+

Package:LISP +

+

If SYMBOL globally names a macro, then returns the expansion function. +Returns NIL otherwise. +

+ +
+ +
+
Function: IN-PACKAGE (package-name &key (nicknames nil) (use '(lisp)))
+

Package:LISP +

+

Sets *PACKAGE* to the package with PACKAGE-NAME, creating the package if +it does not exist. If the package already exists then it is modified +to agree with USE and NICKNAMES arguments. Any new nicknames are added +without removing any old ones not specified. If any package in the USE list +is not currently used, then it is added to the use list. +

+ +
+ +
+
Function: MAKE-PACKAGE (package-name &key (nicknames nil) (use '(lisp)))
+

Package:LISP +

+

Makes a new package having the specified PACKAGE-NAME and NICKNAMES. The +package will inherit all external symbols from each package in the USE list. +

+ +
+ +
+
Function: PACKAGE-SHADOWING-SYMBOLS (package)
+

Package:LISP +

+

Returns the list of symbols that have been declared as shadowing symbols +in PACKAGE. +

+ +
+ +
+
Function: INTERN (name &optional (package *package*))
+

Package:LISP +

+

Returns a symbol having the specified name, creating it if necessary. +Returns as the second value one of the symbols :INTERNAL, :EXTERNAL, +:INHERITED, and NIL. +

+ +
+ +
+
Function: EXPORT (symbols &optional (package *package*))
+

Package:LISP +

+

Makes SYMBOLS external symbols of PACKAGE. SYMBOLS must be a list of symbols +or a symbol. +

+ +
+ +
+
Function: PACKAGEP (x)
+

Package:LISP +

+

Returns T if X is a package; NIL otherwise. +

+ +
+ +
+
Function: SYMBOL-FUNCTION (symbol)
+

Package:LISP +

+

Returns the current global function definition named by SYMBOL. +

+ +
+ +
+
Function: SYMBOL-VALUE (symbol)
+

Package:LISP +

+

Returns the current value of the dynamic (special) variable named by SYMBOL. +

+ +
+ +
+
Function: BOUNDP (symbol)
+

Package:LISP +

+

Returns T if the global variable named by SYMBOL has a value; NIL otherwise. +

+ +
+ +
+
Function: DOCUMENTATION (symbol doc-type)
+

Package:LISP +

+

Returns the doc-string of DOC-TYPE for SYMBOL; NIL if none exists. +Possible doc-types are: + FUNCTION (special forms, macros, and functions) + VARIABLE (dynamic variables, including constants) + TYPE (types defined by DEFTYPE) + STRUCTURE (structures defined by DEFSTRUCT) + SETF (SETF methods defined by DEFSETF, DEFINE-SETF-METHOD, and + DEFINE-MODIFY-MACRO) +All built-in special forms, macros, functions, and variables have their +doc-strings. +

+ +
+ +
+
Function: GENTEMP (&optional (prefix "t") (package *package*))
+

Package:LISP +

+

Creates a new symbol interned in the package PACKAGE with the given PREFIX. +

+ +
+ +
+
Function: RENAME-PACKAGE (package new-name &optional (new-nicknames nil))
+

Package:LISP +

+

Replaces the old name and nicknames of PACKAGE with NEW-NAME and +NEW-NICKNAMES. +

+ +
+ +
+
Function: UNINTERN (symbol &optional (package *package*))
+

Package:LISP +

+

Makes SYMBOL no longer present in PACKAGE. Returns T if SYMBOL was present; +NIL otherwise. If PACKAGE is the home package of SYMBOL, then makes SYMBOL +uninterned. +

+ +
+ +
+
Function: UNEXPORT (symbols &optional (package *package*))
+

Package:LISP +

+

Makes SYMBOLS no longer accessible as external symbols in PACKAGE. SYMBOLS +must be a list of symbols or a symbol. +

+ +
+ +
+
Function: PACKAGE-NICKNAMES (package)
+

Package:LISP +

+

Returns as a list the nickname strings for the specified PACKAGE. +

+ +
+ +
+
Function: IMPORT (symbols &optional (package *package*))
+

Package:LISP +

+

Makes SYMBOLS internal symbols of PACKAGE. SYMBOLS must be a list of symbols +or a symbol. +

+ +
+ +
+
Function: GET (symbol indicator &optional (default nil))
+

Package:LISP +

+

Looks on the property list of SYMBOL for the specified INDICATOR. If this +is found, returns the associated value. Otherwise, returns DEFAULT. +

+ +
+ +
+
Function: FIND-ALL-SYMBOLS (string-or-symbol)
+

Package:LISP +

+

Returns a list of all symbols that have the specified name. +

+ +
+ +
+
Function: FMAKUNBOUND (symbol)
+

Package:LISP +

+

Discards the global function definition named by SYMBOL. Returns SYMBOL. +

+ +
+ +
+
Function: PACKAGE-NAME (package)
+

Package:LISP +

+

Returns the string that names the specified PACKAGE. +

+ +
+ +
+
Function: FIND-PACKAGE (name)
+

Package:LISP +

+

Returns the specified package if it already exists; NIL otherwise. NAME may +be a string that is the name or nickname of the package. NAME may also be +a symbol, in which case the symbol’s print name is used. +

+ +
+ + +
+
Function: APROPOS-LIST (string &optional (package nil))
+

Package:LISP +

+

Returns, as a list, all symbols whose print-names contain STRING as substring. +If PACKAGE is non-NIL, then only the specified package is searched. +

+ +
+ + + +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/System-Definitions.html b/info/gcl-si/System-Definitions.html new file mode 100644 index 0000000..c554b95 --- /dev/null +++ b/info/gcl-si/System-Definitions.html @@ -0,0 +1,1147 @@ + + + + + +System Definitions (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

17 System Definitions

+ + +
+
Function: ALLOCATE-CONTIGUOUS-PAGES (number &optional (really-allocate nil))
+

Package:SI +

+

GCL specific: Sets the maximum number of pages for contiguous blocks to +NUMBER. If REALLY-ALLOCATE is non-NIL, then the specified +number of pages will be allocated immediately. +

+ +
+
+
Function: FREEZE-DEFSTRUCT (name)
+

Package:SI +

+

The inline defstruct type checker will be made more efficient, in that +it will only check for types which currently include NAME. After +calling this the defstruct should not be altered. +

+ +
+
+
Function: MAXIMUM-ALLOCATABLE-PAGES (type)
+

Package:SI +

+

GCL specific: Returns the current maximum number of pages for the type class +of the GCL implementation type TYPE. +

+ +
+
+
Function: ALLOCATED-RELOCATABLE-PAGES ()
+

Package:SI +

+

GCL specific: Returns the number of pages currently allocated for relocatable +blocks. +

+ +
+
+
Function: PUTPROP (symbol value indicator)
+

Package:SI +

+

Give SYMBOL the VALUE on INDICATOR property. +

+ +
+
+
Function: ALLOCATED-PAGES (type)
+

Package:SI +

+

GCL specific: Returns the number of pages currently allocated for the type +class of the GCL implementation type TYPE. +

+ +
+
+
Function: ALLOCATE-RELOCATABLE-PAGES (number)
+

Package:SI +

+

GCL specific: Sets the maximum number of pages for relocatable blocks to +NUMBER. +

+ +
+
+
Function: ALLOCATED-CONTIGUOUS-PAGES ()
+

Package:SI +

+

GCL specific: Returns the number of pages currently allocated for contiguous +blocks. +

+ +
+
+
Function: MAXIMUM-CONTIGUOUS-PAGES ()
+

Package:SI +

+

GCL specific: Returns the current maximum number of pages for contiguous +blocks. +

+ +
+
+
Function: GET-HOLE-SIZE ()
+

Package:SI +

+

GCL specific: Returns as a fixnum the size of the memory hole (in pages). +

+ +
+
+
Function: SPECIALP (symbol)
+

Package:SI +

+

GCL specific: Returns T if the SYMBOL is a globally special variable; NIL +otherwise. +

+ +
+
+
Function: OUTPUT-STREAM-STRING (string-output-stream)
+

Package:SI +

+

GCL specific: Returns the string corresponding to the STRING-OUTPUT-STREAM. +

+ +
+
+
Function: GET-STRING-INPUT-STREAM-INDEX (string-input-stream)
+

Package:SI +

+

GCL specific: Returns the current index of the STRING-INPUT-STREAM. +

+ +
+
+
Function: STRING-CONCATENATE (&rest strings)
+

Package:SI +

+

GCL specific: Returns the result of concatenating the given STRINGS. +

+ +
+
+
Function: BDS-VAR (i)
+

Package:SI +

+

GCL specific: Returns the symbol of the i-th entity in the bind stack. +

+ +
+
+
Function: ERROR-SET (form)
+

Package:SI +

+

GCL specific: Evaluates the FORM in the null environment. If the evaluation +of the FORM has successfully completed, SI:ERROR-SET returns NIL as the first +value and the result of the evaluation as the rest of the values. If, in the +course of the evaluation, a non-local jump from the FORM is atempted, +SI:ERROR-SET traps the jump and returns the corresponding jump tag as its +value. +

+ +
+
+
Function: COMPILED-FUNCTION-NAME (compiled-function-object)
+

Package:SI +

+

GCL specific: Returns the name of the COMPILED-FUNCTION-OBJECT. +

+ +
+
+
Function: STRUCTUREP (object)
+

Package:SI +

+

GCL specific: Returns T if the OBJECT is a structure; NIL otherwise. +

+ +
+
+
Function: IHS-VS (i)
+

Package:SI +

+

GCL specific: Returns the value stack index of the i-th entity in the +invocation history stack. +

+ +
+
+
Function: UNIVERSAL-ERROR-HANDLER (error-name correctable function-name continue-format-string error-format-string &rest args)
+

Package:SI +

+

GCL specific: Starts the error handler of GCL. When an error is detected, +GCL calls SI:UNIVERSAL-ERROR-HANDLER with the specified arguments. +ERROR-NAME is the name of the error. CORRECTABLE is T for a correctable +error and NIL for a fatal error. FUNCTION-NAME is the name of the function +that caused the error. CONTINUE-FORMAT-STRING and ERROR-FORMAT-STRING are +the format strings of the error message. ARGS are the arguments to the +format strings. + To change the error handler of GCL, redefine SI:UNIVERSAL-ERROR- +HANDLER. +

+ +
+
+
Variable: *INTERRUPT-ENABLE*
+

Package:SI +GCL specific: If the value of SI:*INTERRUPT-ENABLE* is non-NIL, GCL signals +an error on the terminal interrupt (this is the default case). If it is NIL, +GCL ignores the interrupt and assigns T to SI:*INTERRUPT-ENABLE*. +

+ +
+
+
Function: CHDIR (pathname)
+

Package:SI +

+

GCL/UNIX specific: Changes the current working directory to the specified +pathname. +

+ +
+
+
Function: COPY-STREAM (in-stream out-stream)
+

Package:SI +

+

GCL specific: Copies IN-STREAM to OUT-STREAM until the end-of-file on IN- +STREAM. +

+ +
+
+
Function: INIT-SYSTEM ()
+

Package:SI +

+

GCL specific: Initializes the library and the compiler of GCL. Since they +have already been initialized in the standard image of GCL, calling SI:INIT- +SYSTEM will cause an error. +

+ +
+
+
Variable: *INDENT-FORMATTED-OUTPUT*
+

Package:SI +GCL specific: The FORMAT directive ~% indents the next line if the value of +this variable is non-NIL. If NIL, ~% simply does Newline. +

+ +
+
+
Function: SET-HOLE-SIZE (fixnum)
+

Package:SI +

+

GCL specific: Sets the size of the memory hole (in pages). +

+ +
+
+
Function: FRS-BDS (i)
+

Package:SI +

+

GCL specific: Returns the bind stack index of the i-th entity in the frame +stack. +

+ +
+
+
Function: IHS-FUN (i)
+

Package:SI +

+

GCL specific: Returns the function value of the i-th entity in the invocation +history stack. +

+ +
+
+
Function: *MAKE-CONSTANT (symbol value)
+

Package:SI +

+

GCL specific: Makes the SYMBOL a constant with the specified VALUE. +

+ +
+
+
Function: FIXNUMP (object)
+

Package:SI +

+

GCL specific: Returns T if the OBJECT is a fixnum; NIL otherwise. +

+ +
+
+
Function: BDS-VAL (i)
+

Package:SI +

+

GCL specific: Returns the value of the i-th entity in the bind stack. +

+ +
+
+
Function: STRING-TO-OBJECT (string)
+

Package:SI +

+

GCL specific: (SI:STRING-TO-OBJECT STRING) is equivalent to +(READ-FROM-STRING STRING), but much faster. +

+ +
+
+
Variable: *SYSTEM-DIRECTORY*
+

Package:SI +GCL specific: Holds the name of the system directory of GCL. +

+ +
+
+
Function: FRS-IHS (i)
+

Package:SI +

+

GCL specific: Returns the invocation history stack index of the i-th entity +in the frame stack. +

+ +
+
+
Function: RESET-GBC-COUNT ()
+

Package:SI +

+

GCL specific: Resets the counter of the garbage collector that records how +many times the garbage collector has been called for each implementation +type. +

+ +
+
+
Function: CATCH-BAD-SIGNALS ()
+

Package:SI +

+

GCL/BSD specific: Installs a signal catcher for bad signals: + SIGILL, SIGIOT, SIGEMT, SIGBUS, SIGSEGV, SIGSYS. +The signal catcher, upon catching the signal, signals an error (and enter +the break-level). Since the internal memory of GCL may be broken, the user +should check the signal and exit from GCL if necessary. When the signal +is caught during garbage collection, GCL terminates immediately. +

+ +
+
+
Function: RESET-STACK-LIMITS ()
+

Package:SI +

+

GCL specific: Resets the stack limits to the normal state. When a stack has +overflowed, GCL extends the limit for the stack in order to execute the error +handler. After processing the error, GCL resets the stack limit by calling +SI:RESET-STACK-LIMITS. +

+ +
+
+
Variable: *GBC-MESSAGE*
+

Package:SI +GCL specific: If the value of SI:*GBC-MESSAGE* is non-NIL, the garbage +collector prints some information on the terminal. Usually SI:*GBC-MESSAGE* +should be set NIL. +

+ +
+
+
Variable: *GBC-NOTIFY*
+

Package:SI +GCL specific: If the value is non-NIL, the garbage +collector prints a very brief one line message about the area causing the collection, +and the time spent in internal time units. +

+ +
+
+
Variable: *AFTER-GBC-HOOK*
+

Package:SI +Defaults to nil, but may be set to a function of one argument TYPE which is +a lisp variable indicating the TYPE which caused the current collection. +

+ +
+
+
Funcition: ALLOCATED (type)
+

Package:SI +

+

Returns 6 values: +

+
nfree
+

number free +

+
npages
+

number of pages +

+
maxpage
+

number of pages to grow to +

+
nppage
+

number per page +

+
gbccount
+

number of gc’s due to running out of items of this size +

+
nused
+

number of items used +

+
+ +

Note that all items of the same size are stored on similar pages. +Thus for example on a 486 under linux the following basic types are +all the same size and so will share the same allocated information: +CONS BIGNUM RATIO COMPLEX STRUCTURE. +

+ + +
+ +
+
Function: *MAKE-SPECIAL (symbol)
+

Package:SI +

+

GCL specific: Makes the SYMBOL globally special. +

+ +
+
+
Function: MAKE-STRING-OUTPUT-STREAM-FROM-STRING (string)
+

Package:SI +

+

GCL specific: Creates a string-output-stream corresponding to the STRING and +returns it. The STRING should have a fill-pointer. +

+ +
+
+
Variable: *IGNORE-EOF-ON-TERMINAL-IO*
+

Package:SI +GCL specific: If the value of SI:*IGNORE-EOF-ON-TERMINAL-IO* is non-NIL, GCL +ignores the eof-character (usually ^D) on the terminal and the terminal never +becomes end-of-file. The default value of SI:*IGNORE-EOF-ON-TERMINAL-IO* is +NIL. +

+ +
+
+
Function: ADDRESS (object)
+

Package:SI +

+

GCL specific: Returns the address of the OBJECT as a fixnum. The address of +an object depends on the version of GCL. E.g. (SI:ADDRESS NIL) returns +1879062044 on GCL/AOSVS dated March 14, 1986. +

+ +
+
+
Variable: *LISP-MAXPAGES*
+

Package:SI +GCL specific: Holds the maximum number of pages (1 page = 2048 bytes) for the +GCL process. The result of changing the value of SI:*LISP-MAXPAGES* is +unpredictable. +

+ +
+
+
Function: ARGC ()
+

Package:SI +

+

GCL specific: Returns the number of arguments on the command line that invoked +the GCL process. +

+ +
+
+
Function: NANI (fixnum)
+

Package:SI +

+

GCL specific: Returns the object in the address FIXNUM. This function is +the inverse of SI:ADDRESS. Although SI:ADDRESS is a harmless operation, +SI:NANI is quite dangerous and should be used with care. +

+ +
+
+
Variable: *NOTIFY-GBC*
+

Package:SI +GCL specific: If the value of this variable is non-NIL, then the garbage +collector notifies that it begins to run whenever it is invoked. Otherwise, +garbage collection begins silently. +

+ +
+
+
Function: SAVE-SYSTEM (pathname)
+

Package:SI +

+

GCL specific: Saves the current GCL core imange into a program file specified +by PATHNAME. This function differs from SAVE in that the contiguous and +relocatable areas are made permanent in the saved image. Usually the +standard image of GCL interpreter/compiler is saved by SI:SAVE-SYSTEM. +This function causes an exit from lisp. Various changes are made +to the memory of the running system, such as closing files and +resetting io streams. It would not be possible to continue normally. +

+ +
+
+
Function: UNCATCH-BAD-SIGNALS ()
+

Package:SI +

+

GCL/BSD specific: Undoes the effect of SI:CATCH-BAD-SIGNALS. +

+ +
+
+
Function: VS (i)
+

Package:SI +

+

GCL specific: Returns the i-th entity in the value stack. +

+ +
+
+
Function: DISPLACED-ARRAY-P (array)
+

Package:SI +

+

GCL specific: Returns T if the ARRAY is a displaced array; NIL otherwise. +

+ +
+
+
Function: ARGV (fixnum)
+

Package:SI +

+

GCL specific: Returns the FIXNUM-th argument on the command line that invoked +the GCL process. +

+ +
+
+
Variable: *DEFAULT-TIME-ZONE*
+

Package:SI +GCL specific: Holds the default time zone. The initial value of SI:*DEFAULT- +TIME-ZONE* is 6 (the time zone of Austin, Texas). +

+ +
+
+
Function: GETENV (string)
+

Package:SI +

+

GCL/UNIX specific: Returns the environment with the name STRING as a string; +if the environment specified by STRING is not found, returns NIL. +

+ +
+
+ +

Package:SI +

+

GCL/BSD specific: Loads the FASL file FILE while linking the object files and +libraries specified by STRING. For example, + (faslink "foo.o" "bar.o boo.o -lpixrect") +loads foo.o while linking two object files (bar.o and boo.o) and the library +pixrect. Usually, foo.o consists of the C language interface for the +functions defined in the object files or the libraries. +

+

A more portable way of making references to C code, is to build it +in at the time of the original make. If foo.c references things +in -lpixrect, and foo.o is its compilation in the gcl/unixport directory +

+

(cd gcl/unixport ; make "EXTRAS= foo.o -lpixrect ") +

+

should add them. If EXTRAS was already joe.o in the unixport/makefile +you should of course add joe.o to the above "EXTRAS= joe.o foo.o.." +

+

Faslink does not work on most UNIX systems which are derived from SYS V or AIX. +

+ + + +
+
+
Function: TOP-LEVEL ()
+

Package:SI +

+

GCL specific: Starts the standard top-level listner of GCL. When the GCL +process is invoked, it calls SI:TOP-LEVEL by (FUNCALL ’SI:TOP-LEVEL). + To change the top-level of GCL, redefine SI:TOP-LEVEL and save the core +imange in a file. When the saved imange is invoked, it will start the +redefined top-level. +

+ +
+
+
Function: FRS-VS (i)
+

Package:SI +

+

GCL specific: Returns the value stack index of the i-th entity in the frame +stack. +

+ +
+
+
Function: WRITE-DEBUG-SYMBOLS (start file &key (main-file "/usr/local/schelter/xgcl/unixport/raw_gcl") (output-file "debug-symbols.o" ))
+

Package:SI +

+

Write out a file of debug-symbols using address START as the place +where FILE will be loaded into the running executable MAIN-FILE. The +last is a keyword argument. +

+ + + +
+
+
Function: PROF (x y)
+

Package:SI +

+

These functions in the SI package are GCL specific, and allow monitoring +the run time of functions loaded into GCL, as well as the basic functions. + Sample Usage: + (si::set-up-profile 1000000) (si::prof 0 90) + run program + (si::prof 0 0) ;; turn off profile + (si::display-prof) + (si::clear-profile) + (si::prof 0 90) ;; start profile again + run program + .. + Profile can be stopped with (si::prof 0 0) and restarted with (si::prof 0 90) +The START-ADDRESS will correspond to the beginning of the profile array, and +the SCALE will mean that 256 bytes of code correspond to SCALE bytes in the +profile array. +

+

Thus if the profile array is 1,000,000 bytes long and the code segment is +5 megabytes long you can profile the whole thing using a scale of 50 +Note that long runs may result in overflow, and so an understating of the +time in a function. +

+

You must run intensively however since, with a scale of 128 it takes +6,000,000 times through a loop to overflow the sampling in one part of +the code. +

+ +
+
+
Function: CATCH-FATAL (i)
+

Package:SI +

+ +

Sets the value of the C variable catch_fatal to I which should be an integer. +If catch_fatal is 1, then most unrecoverable fatal errors will be caught. +Upon catching such an error catch_fatal becomes -1, to avoid recursive errors. +The top level loop automatically sets catch_fatal to 1, if the value is less +than zero. Catching can be turned off by making catch_fatal = 0. +

+ + + +
+
+
Variable: *MULTIPLY-STACKS*
+

Package:SI +

+

If this variable is set to a positive fixnum, then the next time through the +TOP-LEVEL loop, the loop will be exited. The size of the stacks will be +multiplied by the value of *multiply-stacks*, and the TOP-LEVEL will be called +again. Thus to double the size of the stacks: +

+

>(setq si::*multiply-stacks* 2) +[exits top level and reinvokes it, with the new stacks in place] +> +

+

We must exit TOP-LEVEL, because it and any other lisp functions +maintain many pointers into the stacks, which would be incorrect when the +stacks have been moved. Interrupting the process of growing the stacks, +can leave you in an inconsistent state. +

+ +
+
+
Function: GBC-TIME (&optional x)
+

Package:SI +

+

Sets the internal C variable gc_time to X if X is supplied and then +returns gc_time. If gc_time is greater or equal to 0, then gc_time is +incremented by the garbage collector, according to the number of +internal time units spent there. The initial value of gc_time is -1. +

+ + +
+
+
Function: FWRITE (string start count stream)
+

Package:SI +

+

Write from STRING starting at char START (or 0 if it is nil) COUNT characters +(or to end if COUNT is nil) to STREAM. STREAM must be a stream such as +returned by FP-OUTPUT-STREAM. Returns nil if it fails. +

+ + +
+
+
Function: FREAD (string start count stream)
+

Package:SI +

+

Read characters into STRING starting at char START (or 0 if it is nil) COUNT +characters (or from start to length of STRING if COUNT is nil). Characters +are read from STREAM. STREAM must be a stream such as returned by +FP-INPUT-STREAM. Returns nil if it fails. Return number of characters read +if it succeeds. +

+ +
+
+
Function: SGC-ON (&optional ON)
+

Package:SI +

+

If ON is not nil then SGC (stratified garbage collection) is turned +on. If ON is supplied and is nil, then SGC is turned off. +If ON is not supplied, then it returns T if SGC is on, and NIL if +SGC is off. +

+

The purpose of SGC is to prevent paging activity during garbage +collection. It is efficient if the actual number of pages being +written to form a small percentage of the total image size. The image +should be built as compactly as possible. This can be accomplished by +using a settings such as (si::allocate-growth ’cons 1 10 50 20) to limit +the growth in the cons maxpage to 10 pages per time. Then +just before calling si::save-system to save your image you can +do something like: +

+

(si::set-hole-size 500)(gbc nil) (si::sgc-on t) (si::save-system ..) +

+

This makes the saved image come up with SGC on. We have set a +reasonably large hole size. This is so that allocation of pages +either because they fill up, or through specific calls to +si::allocate, will not need to move all the relocatable data. Moving +relocatable data requires turning SGC off, performing a full gc, and +then turning it back on. New relocatable data is collected by SGC, +but moving the old requires going through all pages of memory to +change pointers into it. +

+

Using si::*notify-gbc* gives information about the number of pages +used by SGC. +

+

Note that SGC is only available on operating systems which provide +the mprotect system call, to write protect pages. Otherwise we +cannot tell which pages have been written too. +

+ + +
+
+
Function: ALLOCATE-SGC (type min-pages max-pages percent-free)
+

Package:SI +

+

If MIN-PAGES is 0, then this type will not be swept by SGC. Otherwise +this is the minimum number of pages to make available to SGC. MAX-PAGES +is the upper limit of such pages. Only pages with PERCENT-FREE objects +on them, will be assigned to SGC. +A list of the previous values for min, max and percent are returned. +

+ +
+
+
Function: ALLOCATE-GROWTH (type min max percent percent-free)
+

Package:SI +

+ +

The next time after a garbage collection for TYPE, if PERCENT-FREE of +the objects of this TYPE are not actually free, and if the maximum +number of pages for this type has already been allocated, then the +maximum number will be increased by PERCENT of the old maximum, +subject to the condition that this increment be at least MIN pages and +at most MAX pages. A list of the previous values for min, max, +percent, and percent-free for the type TYPE is returned. A value +of 0 means use the system default, and if an argument is out of range +then the current values are returned with no change made. +

+

Examples: +(si::allocate-growth ’cons 1 10 50 10) +would insist that after a garbage collection for cons, there be at least +10% cons’s free. If not the number of cons pages would be grown by +50% or 10 pages which ever was smaller. This might be reasonable if you +were trying to build an image which was ‘full’, ie had few free objects +of this type. +

+

(si::allocate-growth ’fixnum 0 10000 30 40) +would grow space till there were normally 40% free fixnums, usually +growing by 30% per time. +

+

(si::allocate-growth ’cons 0 0 0 40) would require 40% free conses after +garbage collection for conses, and would use system defaults for the the rate +to grow towards this goal. +

+

(si::allocate-growth ’cons -1 0 0 0) +would return the current values, but not make any changes. +

+ +
+
+
Function: OPEN-FASD (stream direction eof-value table)
+

Package:SI +

+

Given file STREAM open for input or output in DIRECTION, +set it up to start writing or reading in fasd format. When +reading from this stream the EOF-VALUE will be returned when +the end a fasd end of dump marker is encountered. TABLE should +be an eq hashtable on output, a vector on input, or nil. In this +last case a default one will be constructed. +

+

We shall refer to the result as a ‘fasd stream’. It is +suitable as the arg to CLOSE-FASD, READ-FASD-TOP, and as the second +second arg to WRITE-FASD. As a lisp object it is actually a vector, +whose body coincides with: +

+

struct fasd { + object stream; /* lisp object of type stream */ + object table; /* hash table used in dumping or vector on input*/ + object eof; /* lisp object to be returned on coming to eof mark */ + object direction; /* holds Cnil or Kinput or Koutput */ + object package; /* the package symbols are in by default */ + object index; /* integer. The current_dump index on write */ + object filepos; /* nil or the position of the start */ + object table_length; /* On read it is set to the size dump array needed + or 0 + */ + object macro ; } +

+

We did not use a defstruct for this, because we want the compiler to use this +and it makes bootstrapping more difficult. It is in "cmpnew/fasdmacros.lsp" +

+ + +
+
+
Function: WRITE-FASD-TOP (X FASD-STREAM)
+

Package:SI +

+

Write X to FASD-STREAM. +

+ +
+
+
Function: READ-FASD-TOP (FASD-STREAM)
+

Package:SI +

+

Read the next object from FASD-STREAM. Return the eof-value of FASD-STREAM if we +encounter an eof marker put out by CLOSE-FASD. Encountering end of actual file +stream causes an error. +

+ +
+
+
Function: CLOSE-FASD (FASD-STREAM)
+

Package:SI +

+

On output write an eof marker to the associated file stream, and then +make FASD-STREAM invalid for further output. It also attempts to write +information to the stream on the size of the index table needed to read from the +stream from the last open. This is useful in growing the array. +It does not alter the file stream, other than for writing this information to it. +The file stream may be reopened for further use. It is an error +to OPEN-FASD the same file or file stream again with out first calling CLOSE-FASD. +

+ + + + +
+
+
Function: FIND-SHARING-TOP (x table)
+

Package:SI +

+

X is any lisp object and TABLE is an eq hash table. This walks through X +making entries to indicate the frequency of symbols,lists, and arrays. +Initially items get -1 when they are first met, and this is decremented by 1 +each time the object occurs. Call this function on all the objects in a fasd +file, which you wish to share structure. +

+ +
+
+
Variable: *LOAD-PATHNAME*
+

Package:SI +Load binds this to the pathname of the file being loaded. +

+ +
+
+
Macro: DEFINE-INLINE-FUNCTION (fname vars &body body)
+

Package:SI +

+

This is equivalent to defun except that VARS may not contain +&optional, &rest, &key or &aux. Also a compiler property is +added, which essentially saves the body and turns this into +a let of the VARS and then execution of the body. This +last is done using si::DEFINE-COMPILER-MACRO +Example: +(si::define-inline-function myplus (a b c) (+ a b c)) +

+ +
+
+
Macro: DEFINE-COMPILER-MACRO (fname vars &body body)
+

Package:SI +

+

FNAME may be the name of a function, but at compile time the macro +expansion given by this is used. +

+

(si::define-compiler-macro mycar (a) ‘(car ,a)) +

+ +
+
+
Function: DBL ()
+

Package:SI +

+

Invoke a top level loop, in which debug commands may be entered. +These commands may also be entered at breaks, or in the error +handler. +See SOURCE-LEVEL-DEBUG +

+ +
+
+
Function: NLOAD (file)
+

Package:SI +

+

Load a file with the readtable bound to a special readtable, which +permits tracking of source line information as the file is loaded. +see SOURCE-LEVEL-DEBUG +

+ +
+
+
Function: BREAK-FUNCTION (function &optional line absolute)
+

Package:SI +

+

Set a breakpoint for a FUNCTION at LINE if the function has source +information loaded. If ABSOLUTE is not nil, then the line is understood to be +relative to the beginning of the buffer. See also dbl-break-function, the +emacs command. +

+ +
+
+
Function: XDR-OPEN (stream)
+

Package:SI +

+

Returns an object suitable for passing to XDR-READ if the stream +is an input stream, and XDR-WRITE if it was an output stream. +Note the stream must be a unix stream, on which si::fp-input-stream +or si::fp-output-stream would act as the identity. +

+ + +
+
+
Function: FP-INPUT-STREAM (stream)
+

Package:SI +

+

Return a unix stream for input associated to STREAM if possible, +otherwise return nil. +

+ +
+
+
Function: FP-OUTPUT-STREAM (stream)
+

Package:SI +

+

Return a unix stream for output associated to STREAM if possible, +otherwise return nil. +

+ + +
+
+
Function: XDR-READ (stream element)
+

Package:SI +

+

Read one item from STREAM of type the type of ELEMENT. The representation +of the elements is machine independent. The xdr routines are what is +used by the basic unix rpc calls. +

+ +
+
+
Function: XDR-WRITE (stream element)
+

Package:SI +

+

Write to STREAM the given ELEMENT. +

+ + + +
+
+
Variable: *TOP-LEVEL-HOOK*
+

Package:SI +If this variable is has a function as its value at start up time, then +it is run immediately after the init.lsp file is loaded. This is useful +for starting up an alternate top level loop. +

+ +
+
+
Function: RUN-PROCESS (string arglist)
+

Package:SI +

+ +

Execute the command STRING in a subshell passing the strings in the +list ARGLIST as arguments to the command. Return a two way stream +associated to this. Use si::fp-output-stream to get an associated +output stream or si::fp-input-stream. +

+

Bugs: It does not properly deallocate everything, so that it will fail +if you call it too many times. +

+ +
+ +
+
Variable: *CASE-FOLD-SEARCH*
+

Package: SI +Non nil means that a string-match should ignore case +

+ +
+
Function: STRING-MATCH (pattern string &optional start end)
+

Package: SI +Match regexp PATTERN in STRING starting in string starting at START +and ending at END. Return -1 if match not found, otherwise +return the start index of the first matchs. The variable +*MATCH-DATA* will be set to a fixnum array of sufficient size to hold +the matches, to be obtained with match-beginning and match-end. +If it already contains such an array, then the contents of it will +be over written. +

+

The form of a regexp pattern is discussed in See Regular Expressions. +

+
+ +
+
Function: MATCH-BEGINNING (index)
+

Returns the beginning of the I’th match from the previous STRING-MATCH, +where the 0th is for the whole regexp and the subsequent ones match parenthetical expressions. -1 is returned if there is no match, or if the *match-data* +vector is not a fixnum array. +

+ +
+
Function: MATCH-END (index)
+

Returns the end of the I’th match from the previous STRING-MATCH +

+ +
+
Function: SOCKET (port &key host server async myaddr myport daemon)
+
+

Establishes a socket connection to the specified PORT under a variety +of circumstances. +

+

If HOST is specified, then it is a string designating the IP address +of the server to which we are the client. ASYNC specifies that the +connection should be made asynchronously, and the call return +immediately. MYADDR and MYPORT can specify the IP address and port +respectively of a client connection, for example when the running +machine has several network interfaces. +

+

If SERVER is specified, then it is a function which will handle +incoming connections to this PORT. DAEMON specifies that the running +process should be forked to handle incoming connections in the +background. If DAEMON is set to the keyword PERSISTENT, then the +backgrounded process will survive when the parent process exits, and +the SOCKET call returns NIL. Any other non-NIL setting of DAEMON +causes the socket call to return the process id of the backgrounded +process. DAEMON currently only works on BSD and Linux based systems. +

+

If DAEMON is not set or nil, or if the socket is not a SERVER socket, +then the SOCKET call returns a two way stream. In this case, the +running process is responsible for all I/O operations on the stream. +Specifically, if a SERVER socket is created as a non-DAEMON, then the +running process must LISTEN for connections, ACCEPT them when present, +and call the SERVER function on the stream returned by ACCEPT. +

+
+ +
+
Function: ACCEPT (stream)
+
+

Creates a new two-way stream to handle an individual incoming +connection to STREAM, which must have been created with the SOCKET +function with the SERVER keyword set. ACCEPT should only be invoked +when LISTEN on STREAM returns T. If the STREAM was created with the +DAEMON keyword set in the call to SOCKET, ACCEPT is unnecessary and +will be called automatically as needed. +

+
+ + + +
• Regular Expressions   +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/Type.html b/info/gcl-si/Type.html new file mode 100644 index 0000000..acb755a --- /dev/null +++ b/info/gcl-si/Type.html @@ -0,0 +1,185 @@ + + + + + +Type (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

14 Type

+ +
+
Function: COERCE (x type)
+

Package:LISP +

+

Coerces X to an object of the type TYPE. +

+ +
+ +
+
Function: TYPE-OF (x)
+

Package:LISP +

+

Returns the type of X. +

+ +
+ +
+
Function: CONSTANTP (symbol)
+

Package:LISP +

+

Returns T if the variable named by SYMBOL is a constant; NIL otherwise. +

+ +
+ +
+
Function: TYPEP (x type)
+

Package:LISP +

+

Returns T if X is of the type TYPE; NIL otherwise. +

+ +
+ +
+
Function: COMMONP (x)
+

Package:LISP +

+

Returns T if X is a Common Lisp object; NIL otherwise. +

+ +
+ +
+
Function: SUBTYPEP (type1 type2)
+

Package:LISP +

+

Returns T if TYPE1 is a subtype of TYPE2; NIL otherwise. If it could not +determine, then returns NIL as the second value. Otherwise, the second value +is T. +

+ +
+ +
+
Macro: CHECK-TYPE
+

Package:LISP +

+

Syntax: +

+
(check-type place typespec [string])
+
+ +

Signals an error, if the contents of PLACE are not of the specified type. +

+ +
+ +
+
Macro: ASSERT
+

Package:LISP +

+

Syntax: +

+
(assert test-form [({place}*) [string {arg}*]])
+
+ +

Signals an error if the value of TEST-FORM is NIL. STRING is an format string +used as the error message. ARGs are arguments to the format string. +

+ +
+ +
+
Macro: DEFTYPE
+

Package:LISP +

+

Syntax: +

+
(deftype name lambda-list {decl | doc}* {form}*)
+
+ +

Defines a new type-specifier abbreviation in terms of an ’expansion’ function + (lambda lambda-list1 {decl}* {form}*) +where lambda-list1 is identical to LAMBDA-LIST except that all optional +parameters with no default value specified in LAMBDA-LIST defaults to the +symbol ’*’, but not to NIL. When the type system of GCL encounters a +type specifier (NAME arg1 ... argn), it calls the expansion function with +the arguments arg1 ... argn, and uses the returned value instead of the +original type specifier. When the symbol NAME is used as a type specifier, +the expansion function is called with no argument. The doc-string DOC, if +supplied, is saved as the TYPE doc of NAME, and is retrieved by +(documentation ’NAME ’type). +

+ +
+ +
+
Declaration: DYNAMIC-EXTENT
+

Package:LISP +Declaration to allow locals to be cons’d on the C stack. +For example +(defun foo (&rest l) (declare (:dynamic-extent l)) ...) +will cause l to be a list formed on the C stack of the foo function +frame. +Of course passing L out as a value of foo will cause havoc. +(setq x (make-list n)) +(setq x (cons a b)) +(setq x (list a b c ..)) +also are handled on the stack, for dynamic-extent x. +

+ + +
+ +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/User-Interface.html b/info/gcl-si/User-Interface.html new file mode 100644 index 0000000..d1af482 --- /dev/null +++ b/info/gcl-si/User-Interface.html @@ -0,0 +1,473 @@ + + + + + +User Interface (GCL SI Manual) + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+
+

12 User Interface

+ +
+
Special Variable: -
+

Package:LISP +Holds the top-level form that GCL is currently evaluating. +

+ +
+ +
+
Function: - (number &rest more-numbers)
+

Package:LISP +

+

Subtracts the second and all subsequent NUMBERs from the first NUMBER. +With one arg, negates it. +

+ +
+ +
+
Macro: UNTRACE
+

Package:LISP +

+

Syntax: +

+
(untrace {function-name}*)
+
+ +

Removes tracing from the specified functions. With no FUNCTION-NAMEs, +untraces all functions. +

+ +
+ +
+
Variable: ***
+

Package:LISP +Gets the previous value of ** when GCL evaluates a top-level form. +

+ +
+ +
+
Function: MAKE-STRING-INPUT-STREAM (string &optional (start 0) (end (length string)))
+

Package:LISP +

+

Returns an input stream which will supply the characters of String between +Start and End in order. +

+ +
+ +
+
Macro: STEP
+

Package:LISP +

+

Syntax: +

+
(step form)
+
+ +

Evaluates FORM in the single-step mode and returns the value. +

+ +
+ +
+
Variable: *BREAK-ENABLE*
+

Package:LISP +GCL specific: When an error occurrs, control enters to the break loop only +if the value of this variable is non-NIL. +

+ +
+ +
+
Special Variable: /
+

Package:LISP +Holds a list of the values of the last top-level form. +

+ +
+ +
+
Function: DESCRIBE (x)
+

Package:LISP +

+

Prints a description of the object X. +

+ +
+ +
+
Function: ED (&optional x)
+

Package:LISP +

+

Invokes the editor. The action depends on the version of GCL. +

+ +
+ +
+
Variable: *DEBUG-IO*
+

Package:LISP +Holds the I/O stream used by the GCL debugger. +

+ +
+ +
+
Variable: *BREAK-ON-WARNINGS*
+

Package:LISP +When the function WARN is called, control enters to the break loop only +if the value of this varialbe is non-NIL. +

+ +
+ +
+
Function: CERROR (continue-format-string error-format-string &rest args)
+

Package:LISP +

+

Signals a correctable error. +

+ +
+ +
+
Variable: **
+

Package:LISP +Gets the previous value of * when GCL evaluates a top-level form. +

+ +
+ +
+
Special Variable: +++
+

Package:LISP +Gets the previous value of ++ when GCL evaluates a top-level form. +

+ +
+ +
+
Function: INSPECT (x)
+

Package:LISP +

+

Shows the information about the object X in an interactive manner +

+ +
+ +
+
Special Variable: //
+

Package:LISP +Gets the previous value of / when GCL evaluates a top-level form. +

+ +
+ +
+
Variable: *TRACE-OUTPUT*
+

Package:LISP +The trace output stream. +

+ +
+ +
+
Special Variable: ++
+

Package:LISP +Gets the previous value of + when GCL evaluates a top-level form. +

+ +
+ +
+
Variable: *ERROR-OUTPUT*
+

Package:LISP +Holds the output stream for error messages. +

+ +
+ +
+
Function: DRIBBLE (&optional pathname)
+

Package:LISP +

+

If PATHNAME is given, begins to record the interaction to the specified file. +If PATHNAME is not given, ends the recording. +

+ +
+ +
+
Variable: *
+

Package:LISP +Holds the value of the last top-level form. +

+ +
+ +
+
Special Variable: ///
+

Package:LISP +Gets the previous value of // when GCL evaluates a top-level form. +

+ +
+ +
+
Function: WARN (format-string &rest args)
+

Package:LISP +

+

Formats FORMAT-STRING and ARGs to *ERROR-OUTPUT* as a warning message. +

+ +
+ +
+
Function: BREAK (&optional (format-string nil) &rest args)
+

Package:LISP +

+

Enters a break loop. If FORMAT-STRING is non-NIL, formats FORMAT-STRING +and ARGS to *ERROR-OUTPUT* before entering a break loop. +Typing :HELP at the break loop will list the break-loop commands. +

+ +
+ +
+
Special Variable: +
+

Package:LISP +Holds the last top-level form. +

+ +
+ +
+
Macro: TRACE
+

Package:LISP +

+

Syntax: +

+
(trace {function-name}*)
+
+ +

Traces the specified functions. With no FUNCTION-NAMEs, returns a list of +functions currently being traced. +

+

Additional Keywords are allowed in GCL with the +syntax (trace {fn | (fn {:kw form}*)}*) +

+

For each FN naming a function, traces that function. Each :KW should +be one of the ones listed below, and FORM should have the +corresponding form. No :KW may be given more than once for the same +FN. Returns a list of all FNs now traced which weren’t already +traced. +

+ +

EXAMPLE (Try this with your favorite factorial function FACT): +

+
+
;; print entry args and exit values
+
+(trace FACT)
+
+;; Break coming out of FACT if the value is bigger than 1000.
+
+(trace (fact :exit
+	     (progn
+	       (if (> (car values) 1000)(break "big result"))
+	       (car values))))
+
+;; Hairy example:
+
+;;make arglist available without the si:: prefix
+(import 'si::arglist)
+
+(trace (fact
+        :DECLARATIONS
+        ((in-string "Here comes input: ")
+         (out-string "Here comes output: ")
+         all-values
+         (silly (+ 3 4)))
+        :COND
+        (equal (rem (car arglist) 2) 0)
+        :ENTRY
+        (progn
+          (cond
+           ((equal (car arglist) 8)
+            (princ "Entering FACT on input 8!! ")
+            (setq out-string "Here comes output from inside (FACT 8): "))
+           (t
+            (princ in-string)))
+          (car arglist))
+        :EXIT
+        (progn
+          (setq all-values (cons (car values) all-values))
+          (princ out-string)
+          (when (equal (car arglist) 8)
+                ;; reset out-string
+                (setq out-string "Here comes output: "))
+          (cons 'fact values))
+        :ENTRYCOND
+        (not (= (car arglist) 6))
+        :EXITCOND
+        (not (= (car values) (* 6 (car arglist))))
+        :DEPTH
+        5))
+
+ +

Syntax is :keyword form1 :keyword form2 ... +

+
+
:declarations
+
+
DEFAULT: NIL
+
+ +

FORM is ((var1 form1 )(var2 form2 )...), where +the var_i are symbols distinct from each other and from +all symbols which are similarly declared for currently +traced functions. Each form is evaluated immediately. +Upon any invocation of a traced function when not already +inside a traced function call, each var is bound to +that value of form . +

+
+
:COND
+
+
DEFAULT: T
+
+ +

Here, FORM is any Lisp form to be evaluated (by EVAL) +upon entering a call of FN, in the environment where si::ARGLIST +is bound to the current list of arguments of FN. Note that +even if the evaluation of FORM changes the value of SI::ARGLIST +(e.g. by evaluation of (SETQ si::ARGLIST ...)), the list of +arguments passed to FN is unchanged. Users may alter args passed +by destructively modifying the list structure of SI::ARGLIST +however. The call is traced +(thus invoking the :ENTRYCOND and :EXITCOND forms, at least) +if and only if FORM does not evaluate to NIL. +

+
+
:ENTRYCOND
+
+
DEFAULT: T
+
+ +

This is evaluated (by EVAL) if the :COND form evaluates to +non-NIL, both in an environment where SI::ARGLIST is bound to the +current list of arguments of FN. If non-NIL, the :ENTRY form +is then evaluated and printed with the trace "prompt". +

+
+
:ENTRY
+
+
DEFAULT: (CONS (QUOTE x) SI::ARGLIST),
+
+ +

where x is the symbol we call FN +If the :COND and :ENTRYCOND forms evaluate to non-NIL, +then the trace "prompt" is printed and then this FORM is +evaluated (by EVAL) in an environment where SI::ARGLIST is bound +to the current list of arguments of FN. The result is then +printed. +

+
+
:EXITCOND
+
+
DEFAULT: T
+
+ +

This is evaluated (by EVAL) in the environment described +below for the :EXIT form. The :EXIT form is then evaluated +and printed with the "prompt" if and only if the result here +is non-NIL. +

+
+
:EXIT
+
+
DEFAULT: (CONS (QUOTE x) VALUES),
+
+ +

where x is the symbol we call FN +Upon exit from tracing a given call, this FORM is +evaluated (after the appropriate trace "prompt" is printed), +using EVAL in an environment where SI::ARGLIST is bound to the +current list of arguments of FN and VALUES is bound to the +list of values returned by FN (recalling that Common Lisp +functions may return multiple values). +

+
+
:DEPTH
+
+
DEFAULT:  No depth limit
+
+ +

FORM is simply a positive integer specifying the maximum +nesting of traced calls of FN, i.e. of calls of FN in which +the :COND form evaluated to non-NIL. For calls of FN in +which this limit is exceeded, even the :COND form is not +evaluated, and the call is not traced. +

+
+
+ +
+ + + + + + +
+
+

+Next: , Previous: , Up: Top   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-si/index.html b/info/gcl-si/index.html new file mode 100644 index 0000000..59ce0c2 --- /dev/null +++ b/info/gcl-si/index.html @@ -0,0 +1,154 @@ + + + + + +Top (GCL SI Manual) + + + + + + + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: (dir)   [Contents][Index]

+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
• Numbers   +
• Sequences and Arrays and Hash Tables   +
• Characters   +
• Lists   +
• Streams and Reading   +
• Special Forms and Functions   +
• Compilation   +
• Symbols   +
• Operating System   +
• Structures   +
• Iteration and Tests   +
• User Interface   +
• Doc   +
• Type   +
• GCL Specific   +
• C Interface   +
• System Definitions   +
• Debugging   +
• Miscellaneous   +
• Compiler Definitions   +
• Function and Variable Index   +
+
+ — The Detailed Node Listing —
+
+Operating System
+
+
• Command Line   +
• Operating System Definitions   +
+
+GCL Specific
+
+
• Bignums   +
+
+C Interface
+
+
• Available Symbols   +
+
+System Definitions
+
+
• Regular Expressions   +
+
+Debugging
+
+
• Source Level Debugging in Emacs   +
• Low Level Debug Functions   +
+
+Miscellaneous
+
+
• Environment   +
• Inititialization   +
• Low Level X Interface   +
+ +
+
+

+Next: , Previous: , Up: (dir)   [Contents][Index]

+
+ + + + + diff --git a/info/gcl-tk.info b/info/gcl-tk.info new file mode 100644 index 0000000..96975be --- /dev/null +++ b/info/gcl-tk.info @@ -0,0 +1,77 @@ +This is gcl-tk.info, produced by makeinfo version 6.7 from gcl-tk.texi. + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl-tk: (gcl-tk.info). GNU TK Manual +END-INFO-DIR-ENTRY + +This is a Texinfo GCL TK Manual + + Copyright 1994 William F. Schelter + + +Indirect: +gcl-tk.info-1: 258 +gcl-tk.info-2: 300905 + +Tag Table: +(Indirect) +Node: Top258 +Node: General1087 +Node: Introduction1374 +Node: Getting Started2871 +Node: Common Features of Widgets4473 +Node: Return Values8135 +Node: Argument Lists12193 +Node: Lisp Functions Invoked from Graphics15625 +Node: Linked Variables20678 +Node: tkconnect24411 +Node: Widgets26338 +Node: button26626 +Node: listbox33347 +Node: scale41766 +Node: canvas49013 +Node: menu109714 +Node: scrollbar128873 +Node: checkbutton136162 +Node: menubutton145900 +Node: text153878 +Node: entry188019 +Node: message198361 +Node: frame204319 +Node: label208322 +Node: radiobutton211737 +Node: toplevel221174 +Node: Control225016 +Node: after225395 +Node: bind226551 +Node: destroy242234 +Node: tk-dialog242819 +Node: exit244634 +Node: focus245311 +Node: grab250026 +Node: tk-listbox-single-select254694 +Node: lower255598 +Node: tk-menu-bar256476 +Node: option262144 +Node: options265226 +Node: pack-old282810 +Node: pack290570 +Node: place300906 +Node: raise309727 +Node: selection310586 +Node: send315792 +Node: tk317613 +Node: tkerror319450 +Node: tkvars321174 +Node: tkwait323442 +Node: update324926 +Node: winfo326448 +Node: wm334891 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/info/gcl-tk.info-1 b/info/gcl-tk.info-1 new file mode 100644 index 0000000..56f6321 --- /dev/null +++ b/info/gcl-tk.info-1 @@ -0,0 +1,6649 @@ +This is gcl-tk.info, produced by makeinfo version 6.7 from gcl-tk.texi. + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl-tk: (gcl-tk.info). GNU TK Manual +END-INFO-DIR-ENTRY + +This is a Texinfo GCL TK Manual + + Copyright 1994 William F. Schelter + + +File: gcl-tk.info, Node: Top, Next: General, Prev: (dir), Up: (dir) + +* Menu: + +* General:: +* Widgets:: +* Control:: + + -- The Detailed Node Listing -- + +General + +* Introduction:: +* Getting Started:: +* Common Features of Widgets:: +* Return Values:: +* Argument Lists:: +* Lisp Functions Invoked from Graphics:: +* Linked Variables:: +* tkconnect:: + +Widgets + +* button:: +* listbox:: +* scale:: +* canvas:: +* menu:: +* scrollbar:: +* checkbutton:: +* menubutton:: +* text:: +* entry:: +* message:: +* frame:: +* label:: +* radiobutton:: +* toplevel:: + +Control + +* after:: +* bind:: +* destroy:: +* tk-dialog:: +* exit:: +* focus:: +* grab:: +* tk-listbox-single-select:: +* lower:: +* tk-menu-bar:: +* option:: +* options:: +* pack-old:: +* pack:: +* place:: +* raise:: +* selection:: +* send:: +* tk:: +* tkerror:: +* tkvars:: +* tkwait:: +* update:: +* winfo:: +* wm:: + + +File: gcl-tk.info, Node: General, Next: Widgets, Prev: Top, Up: Top + +1 General +********* + +* Menu: + +* Introduction:: +* Getting Started:: +* Common Features of Widgets:: +* Return Values:: +* Argument Lists:: +* Lisp Functions Invoked from Graphics:: +* Linked Variables:: +* tkconnect:: + + +File: gcl-tk.info, Node: Introduction, Next: Getting Started, Prev: General, Up: General + +1.1 Introduction +================ + +GCL-TK is a windowing interface for GNU Common Lisp. It provides the +functionality of the TK widget set, which in turn implements a widget +set which has the look and feel of Motif. + + The interface allows the user to draw graphics, get input from menus, +make regions mouse sensitive, and bind lisp commands to regions. It +communicates over a socket with a 'gcltksrv' process, which speaks to +the display via the TK library. The displaying process may run on a +machine which is closer to the display, and so involves less +communication. It also may remain active even though the lisp is +involved in a separate user computation. The display server can, +however, interrupt the lisp at will, to inquire about variables and run +commands. + + The user may also interface with existing 'TCL/TK' programs, binding +some buttons, or tracking some objects. + + The size of the program is moderate. In its current form it adds +only about 45K bytes to the lisp image, and the 'gcltksrv' program uses +shared libraries, and is on the order of 150Kbytes on a sparc. + + This chapter describes some of the common features of the command +structure of widgets, and of control functions. The actual functions +for construction of windows are discussed in *note Widgets::, and more +general functions for making them appear, lowering them, querying about +them in *note Control::. + + +File: gcl-tk.info, Node: Getting Started, Next: Common Features of Widgets, Prev: Introduction, Up: General + +1.2 Getting Started +=================== + +Once GCL has been properly installed you should be able to do the +following simple example: + + (in-package "TK") + (tkconnect) + (button '.hello :text "Hello World" :command '(print "hi")) + ==>.HELLO + (pack '.hello) + We first switched to the "TK" package, so that functions like button +and pack would be found. After doing the tkconnect, a window should +appear on your screen, see *Note tkconnect::. The invocation of the +function 'button' creates a new function called '.hello' which is a +widget function. It is then made visible in the window by using the +'pack' function. + + You may now click on the little window, and you should see the +command executed in your lisp. Thus "hi" should be printed in the lisp +window. This will happen whether or not you have a job running in the +lisp, that is lisp will be interrupted and your command will run, and +then return the control to your program. + + The function 'button' is called a widget constructor, and the +function '.hello' is called a widget. If you have managed to accomplish +the above, then GCL is probably installed correctly, and you can +graduate to the next section! If you dont like reading but prefer to +look at demos and code, then you should look in the demos directory, +where you will find a number of examples. A monitor for the garbage +collector (mkgcmonitor), a demonstration of canvas widgets (mkitems), a +sample listbox with scrolling (mklistbox). + + +File: gcl-tk.info, Node: Common Features of Widgets, Next: Return Values, Prev: Getting Started, Up: General + +1.3 Common Features of Widgets +============================== + +A widget is a lisp symbol which has a function binding. The first +argument is always a keyword and is called the option. The argument +pattern for the remaining arguments depends on the option. The most +common option is ':configure' in which case the remaining arguments are +alternating keyword/value pairs, with the same keywords being permitted +as at the creation of the widget. + + A widget is created by means of a widget constructor, of which there +are currently 15, each of them appearing as the title of a section in +*note Widgets::. They live in the '"TK"' package, and for the moment we +will assume we have switched to this package. Thus for example 'button' +is such a widget constructor function. Of course this is lisp, and you +can make your own widget constructors, but when you do so it is a good +idea to follow the standard argument patterns that are outlined in this +section. + + (button '.hello) + ==> .HELLO +creates a widget whose name is '.hello'. There is a parent child +hierarchy among widgets which is implicit in the name used for the +widget. This is much like the pathname structure on a Unix or Dos file +system, except that ''.'' is used as the separator rather than a '/' or +'\'. For this reason the widget instances are sometimes referred to as +pathnames. A child of the parent widget '.hello' might be called +'.hello.joe', and a child of this last might be '.hello.joe.bar'. The +parent of everyone is called '.' . Multiple top level windows are +created using the 'toplevel' command (*note toplevel::). + + The widget constructor functions take keyword and value pairs, which +allow you to specify attributes at the time of creation: + + (button '.hello :text "Hello World" :width 20) + ==>.HELLO +indicating that we want the text in the button window to be 'Hello +World' and the width of the window to be 20 characters wide. Other +types of windows allow specification in centimeters '2c', or in inches +('2i') or in millimeters '2m' or in pixels '2'. But text windows +usually have their dimensions specified as multiples of a character +width and height. This latter concept is called a grid. + + Once the window has been created, if you want to change the text you +do NOT do: + (button '.hello :text "Bye World" :width 20) + This would be in error, because the window .hello already exists. +You would either have to first call + + (destroy '.hello) + + But usually you just want to change an attribute. '.hello' is +actually a function, as we mentioned earlier, and it is this function +that you use: + + (.hello :configure :text "Bye World") + + This would simply change the text, and not change where the window +had been placed on the screen (if it had), or how it had been packed +into the window hierarchy. Here the argument ':configure' is called an +option, and it specifies which types of keywords can follow it. For +example + + (.hello :flash) +is also valid, but in this case the ':text' keyword is not permitted +after flash. If it were, then it would mean something else besides what +it means in the above. For example one might have defined + + (.hello :flash :text "PUSH ME") +so here the same keyword ':text' would mean something else, eg to flash +a subliminal message on the screen. + + We often refer to calls to the widget functions as messages. One +reason for this is that they actually turn into messages to the graphics +process 'gcltksrv'. To actually see these messages you can do + (debugging t). + + +File: gcl-tk.info, Node: Return Values, Next: Argument Lists, Prev: Common Features of Widgets, Up: General + +1.4 Return Values +================= + +1.4.1 Widget Constructor Return Values +-------------------------------------- + +On successful completion, the widget constructor functions return the +symbol passed in as the first argument. It will now have a functional +binding. It is an error to pass in a symbol which already corresponds +to a widget, without first calling the 'destroy' command. On failure, +an error is signalled. + +1.4.2 Widget Return Values +-------------------------- + +The widget functions themselves, do not normally return any value. +Indeed the lisp process does not wait for them to return, but merely +dispatches the commands, such as to change the text in themselves. +Sometimes however you either wish to wait, in order to synchronize, or +you wish to see if your command fails or succeeds. You request values +by passing the keyword :return and a value indicating the type. + + (.hello :configure :text "Bye World" :return 'string) + ==> "" + ==> T +the empty string is returned as first value, and the second value 'T' +indicates that the new text value was successfully set. LISP will not +continue until the tkclsrv process indicates back that the function call +has succeeded. While waiting of course LISP will continue to process +other graphics events which arrive, since otherwise a deadlock would +arise: the user for instance might click on a mouse, just after we had +decided to wait for a return value from the '.hello' function. More +generally a user program may be running in GCL and be interrupted to +receive and act on communications from the 'gcltksrv' process. If an +error occurred then the second return value of the lisp function will be +NIL. In this case the first value, the string is usually an informative +message about the type of error. + + A special variable 'tk::*break-on-errors*' which if not 'nil', +requests that that LISP signal an error when a message is received +indicating a function failed. Whenever a command fails, whether a +return value was requested or not, 'gcltksrv' returns a message +indicating failure. The default is to not go into the debugger. When +debugging your windows it may be convenient however to set this variable +to 'T' to track down incorrect messages. + + The 'gcltksrv' process always returns strings as values. If +':return' type is specified, then conversion to type is accomplished by +calling + + (coerce-result return-string type) + + Here type must be a symbol with a 'coercion-functions' property. The +builtin return types which may be requested are: + +'T' + in which case the string passed back from the 'gcltksrv' process, + will be read by the lisp reader. +'number' + the string is converted to a number using the current *read-base* +'list-strings' + + (coerce-result "a b {c d} e" 'list-strings) + ==> ("a" "b" "c d" "e") +'boolean' + (coerce-result "1" 'boolean) ==> T (coerce-result "0" 'boolean) ==> + NIL + + The above symbols are in the 'TK' or 'LISP' package. It would be +possible to add new types just as the ':return t' is done: + + (setf (get 't 'coercion-functions) + (cons #'(lambda (x) (our-read-from-string x 0)) + #'(lambda (x) (format nil "~s" x)))) + + The 'coercion-functions' property of a symbol, is a cons whose 'car' +is the coercion form from a string to some possibly different lisp +object, and whose 'cdr' is a function which builds a string to send to +the graphics server. Often the two functions are inverse functions one +of the other up to equal. + +1.4.3 Control Function Return Values +------------------------------------ + +The control functions (*note Control::) do not return a value or wait +unless requested to do so, using the ':return' keyword. The types and +method of specification are the same as for the Widget Functions in the +previous section. + + (winfo :width '.hello :return 'number) + ==> 120 +indicates that the '.hello' button is actually 120 pixels wide. + + +File: gcl-tk.info, Node: Argument Lists, Next: Lisp Functions Invoked from Graphics, Prev: Return Values, Up: General + +1.5 Argument Lists +================== + +1.5.1 Widget Functions +---------------------- + +The rule is that the first argument for a widget function is a keyword, +called the option. The pattern of the remaining arguments depends +completely on the option argument. Thus + + (.hello option ?arg1? ?arg2? ...) + + One option which is permitted for every widget function is +':configure'. The argument pattern following it is the same +keyword/value pair list which is used in widget creation. For a +'button' widget, the other valid options are ':deactivate', ':flash', +and ':invoke'. To find these, since '.hello' was constructed with the +'button' constructor, you should see *Note button::. The argument +pattern for other options depends completely on the option and the +widget function. For example if '.scrollbar' is a scroll bar window, +then the option ':set' must be followed by 4 numeric arguments, which +indicate how the scrollbar should be displayed, see *Note scrollbar::. + + (.scrollbar :set a1 a2 a3 a4) + + If on the other hand '.scale' is a scale (*note scale::), then we +have + + (.scale :set a1 ) +only one numeric argument should be supplied, in order to position the +scale. + +1.5.2 Widget Constructor Argument Lists +--------------------------------------- + +These are + + (widget-constructor pathname :keyword1 value1 :keyword2 value2 ...) + +to create the widget whose name is pathname. The possible keywords +allowed are specified in the corresponding section of *Note Widgets::. + +1.5.3 Concatenation Using ':' in Argument List +---------------------------------------------- + +What has been said so far about arguments is not quite true. A special +string concatenation construction is allowed in argument lists for +widgets, widget constructors and control functions. + + First we introduce the function 'tk-conc' which takes an arbitrary +number of arguments, which may be symbols, strings or numbers, and +concatenates these into a string. The print names of symbols are +converted to lower case, and package names are ignored. + + (tk-conc "a" 1 :b 'cd "e") ==> "a1bcde" + + One could use 'tk-conc' to construct arguments for widget functions. +But even though 'tk-conc' has been made quite efficient, it still would +involve the creation of a string. The ':' construct avoids this. In a +call to a widget function, a widget constructor, or a control function +you may remove the call to 'tk-conc' and place ':' in between each of +its arguments. Those functions are able to understand this and treat +the extra arguments as if they were glued together in one string, but +without the extra cost of actually forming that string. + + (tk-conc a b c .. w) <==> a : b : c : ... w + (setq i 10) + (.hello :configure :text i : " pies") + (.hello :configure :text (tk-conc i " pies")) + (.hello :configure :text (format nil "~a pies" i)) + + The last three examples would all result in the text string being +'"10 pies"', but the first method is the most efficient. That call will +be made with no string or cons creation. The GC Monitor example, is +written in such a way that there is no creation of 'cons' or 'string' +types during normal operation. This is particularly useful in that +case, since one is trying to monitor usage of conses by other programs, +not its own usage. + + +File: gcl-tk.info, Node: Lisp Functions Invoked from Graphics, Next: Linked Variables, Prev: Argument Lists, Up: General + +1.6 Lisp Functions Invoked from Graphics +======================================== + +It is possible to make certain areas of a window mouse sensitive, or to +run commands on reception of certain events such as keystrokes, while +the focus is in a certain window. This is done by having a lisp +function invoked or some lisp form evaluated. We shall refer to such a +lisp function or form as a _command_. + + For example + + (button '.button :text "Hello" :command '(print "hi")) + (button '.jim :text "Call Jim" :command 'call-jim) + + In the first case when the window '.button' is clicked on, the word +"hi" will be printed in the lisp to standard output. In the second case +'call-jim' will be funcalled with no arguments. + + A command must be one of the following three types. What happens +depends on which type it is: + +'function' + If the value satisfies 'functionp' then it will be called with a + number of arguments which is dependent on the way it was bound, to + graphics. +'string' + If the command is a string, then it is passed directly to TCL/TK + for evaluation on that side. Lisp will not be required for the + evaluation when the command is invoked. +'lisp form' + Any other lisp object is regarded as a lisp form to be eval'd, and + this will be done when the command is invoked. + + The following keywords accept as their value a command: + + :command + :yscroll :yscrollcommand + :xscroll :xscrollcommand + :scrollcommand + :bind + +and in addition 'bind' takes a command as its third argument, see *Note +bind::. + + Below we give three different examples using the 3 possibilities for +a command: functionp, string, and lisp form. They all accomplish +exactly the same thing. For given a frame '.frame' we could construct a +listbox in it as: + + (listbox '.frame.listbox :yscroll 'joe) + + Then whenever the listbox view position changes, or text is inserted, +so that something changes, the function 'joe' will be invoked with 4 +arguments giving the totalsize of the text, maximum number of units the +window can display, the index of the top unit, and finally the index of +the bottom unit. What these arguments are is specific to the widget +'listbox' and is documented *Note listbox::. + + 'joe' might be used to do anything, but a common usage is to have +'joe' alter the position of some other window, such as a scroll bar +window. Indeed if '.scrollbar' is a scrollbar then the function + + (defun joe (a b c d) + (.scrollbar :set a b c d)) + +would look after sizing the scrollbar appropriately for the percentage +of the window visible, and positioning it. + + A second method of accomplishing this identical, using a string (the +second type of command), + + (listbox '.frame.listbox :yscroll ".scrollbar set") + +and this will not involve a call back to lisp. It uses the fact that +the TK graphics side understands the window name '.scrollbar' and that +it takes the option 'set'. Note that it does not get the ':' before the +keyword in this case. + + In the case of a command which is a lisp form but is not installed +via 'bind' or ':bind', then the form will be installed as + + #'(lambda (&rest *arglist*) lisp-form) + +where the lisp-form might wish to access the elements of the special +variable '*arglist*'. Most often this list will be empty, but for +example if the command was setup for '.scale' which is a scale, then the +command will be supplied one argument which is the new numeric value +which is the scale position. A third way of accomplishing the scrollbar +setting using a lisp form is: + + (listbox '.frame.listbox :yscroll '(apply '.scrollbar :set *arglist*)) + + The 'bind' command and ':bind' keyword, have an additional wrinkle, +see *Note bind::. These are associated to an event in a particular +window, and the lisp function or form to be evaled must have access to +that information. For example the x y position, the window name, the +key pressed, etc. This is done via percent symbols which are specified, +see *Note bind::. + + (bind "Entry" "" '(emacs-move %W %A )) + +will cause the function emacs-move to be be invoked whenever a control +key is pressed (unless there are more key specific or window specific +bindings of said key). It will be invoked with two arguments, the first +%W indicating the window in which it was invoked, and the second being a +string which is the ascii keysym which was pressed at the same time as +the control key. + + These percent constructs are only permitted in commands which are +invoked via 'bind' or ':bind'. The lisp form which is passed as the +command, is searched for the percent constructs, and then a function + + #'(lambda (%W %A) (emacs-move %W %A)) + +will be invoked with two arguments, which will be supplied by the TK +graphics server, at the time the command is invoked. The '*arglist*' +construct is not available for these commands. + + +File: gcl-tk.info, Node: Linked Variables, Next: tkconnect, Prev: Lisp Functions Invoked from Graphics, Up: General + +1.7 Linked Variables +==================== + +It is possible to link lisp variables to TK variables. In general when +the TK variable is changed, by for instance clicking on a radiobutton, +the linked lisp variable will be changed. Conversely changing the lisp +variable will be noticed by the TK graphics side, if one does the +assignment in lisp using 'setk' instead of 'setq'. + + (button '.hello :textvariable '*message* :text "hi there") + (pack '.hello) + + This causes linking of the global variable '*message*' in lisp to a +corresponding variable in TK. Moreover the message that is in the button +'.hello' will be whatever the value of this global variable is (so long +as the TK side is notified of the change!). + + Thus if one does + + (setk *message* "good bye") + +then the button will change to have good bye as its text. The lisp +macro 'setk' expands into + + (prog1 (setf *message* "good bye") (notice-text-variables)) + +which does the assignment, and then goes thru the linked variables +checking for those that have changed, and updating the TK side should +there be any. Thus if you have a more complex program which might have +done the assignment of your global variable, you may include the call to +'notice-text-variables' at the end, to assure that the graphics side +knows about the changes. + + A variable which is linked using the keyword ':textvariable' is +always a variable containing a string. + + However it is possible to have other types of variables. + + (checkbutton '.checkbutton1 :text "A button" :variable '(boolean *joe*)) + (checkbutton '.checkbutton2 :text "A button" :variable '*joe*) + (checkbutton '.checkbutton3 :text "Debugging" :variable '(t *debug*) + :onvalue 100 :offvalue -1) + + The first two examples are the same in that the default variable type +for a checkbutton is 'boolean'. Notice that the specification of a +variable type is by '(type variable)'. The types which are permissible +are those which have coercion-fucntions, *Note Return Values::. In the +first example a variable '*joe*' will be linked, and its default initial +value will be set to nil, since the default initial state of the check +button is off, and the default off value is nil. Actually on the TK +side, the corresponding boolean values are '"1"' and '"0"', but the +'boolean' type makes these become 't' and 'nil'. + + In the third example the variable *debug* may have any lisp value +(here type is 't'). The initial value will be made to be '-1', since +the checkbutton is off. Clicking on '.checkbutton3' will result in the +value of '*debug*' being changed to 100, and the light in the button +will be toggled to on, *Note checkbutton::. You may set the variable to +be another value besides 100. + + You may also call + + (link-text-variable '*joe* 'boolean) + +to cause the linking of a variable named *joe*. This is done +automatically whenever the variable is specified after one of the keys + + :variable :textvariable. + + Just as one must be cautious about using global variables in lisp, +one must be cautious in making such linked variables. In particular +note that the TK side, uses variables for various purposes. If you make +a checkbutton with pathname '.a.b.c' then unless you specify a +':variable' option, the variable 'c' will become associated to the TK +value of the checkbutton. We do NOT link this variable by default, +feeling that one might inadvertently alter global variables, and that +they would not typically use the lisp convention of being of the form +'*c*'. You must specify the ':variable' option, or call +'link-variable'. + + +File: gcl-tk.info, Node: tkconnect, Prev: Linked Variables, Up: General + +1.8 tkconnect +============= + + tkconnect &key host display can-rsh gcltksrv + + This function provides a connection to a graphics server process, +which in turn connects to possibly several graphics display screens. +The graphics server process, called 'gcltksrv' may or may not run on the +same machine as the lisp to which it is attached. 'display' indicates +the name of the default display to connect to, and this in turn defaults +to the value of the environment variable 'DISPLAY'. + + When tkconnect is invoked, a socket is opened and it waits for a +graphics process to connect to it. If the host argument is not +supplied, then a process will be spawned which will connect back to the +lisp process. The name of the command for invoking the process is the +value of the 'gcltksrv' argument, which defaults to the value of the +environment variable 'GCL_TK_SERVER'. If that variable is not set, then +the lisp '*lib-directory*' is searched for an entry 'gcl-tk/gcltksrv'. + + If 'host' is supplied, then a command to run on the remote machine +will be printed on standard output. If 'can-rsh' is not nil, then the +command will not be printed, but rather an attempt will be made to rsh +to the machine, and to run the command. + + Thus + + (tkconnect) + +would start the process on the local machine, and use for 'display' the +value of the environment variable 'DISPLAY'. + + (tkconnect :host "max.ma.utexas.edu" :can-rsh t) + +would cause an attempt to rsh to 'max' and to run the command there, to +connect back to the appropriate port on the localhost. + + You may indicate that different toplevel windows be on different +displays, by using the ':display' argument when creating the window, +*Note toplevel::. + + Clearly you must have a copy of the program 'gcltksrv' and TK +libraries installed on the machine where you wish to run the server. + + +File: gcl-tk.info, Node: Widgets, Next: Control, Prev: General, Up: Top + +2 Widgets +********* + +* Menu: + +* button:: +* listbox:: +* scale:: +* canvas:: +* menu:: +* scrollbar:: +* checkbutton:: +* menubutton:: +* text:: +* entry:: +* message:: +* frame:: +* label:: +* radiobutton:: +* toplevel:: + + +File: gcl-tk.info, Node: button, Next: listbox, Prev: Widgets, Up: Widgets + +2.1 button +========== + +button \- Create and manipulate button widgets + +Synopsis +-------- + +button pathName ?options? + +Standard Options +---------------- + + activeBackground bitmap font relief + activeForeground borderWidth foreground text + anchor cursor padX textVariable + background disabledForeground padY + + *Note options::, for more information. + +Arguments for Button +-------------------- + +':command' + Name='"command" Class="Command"' + + Specifies a Tcl command to associate with the button. This command + is typically invoked when mouse button 1 is released over the + button window. + +':height' + Name='"height" Class="Height"' + + Specifies a desired height for the button. If a bitmap is being + displayed in the button then the value is in screen units (i.e. + any of the forms acceptable to Tk_GetPixels); for text it is in + lines of text. If this option isn't specified, the button's + desired height is computed from the size of the bitmap or text + being displayed in it. + +':state' + Name='"state" Class="State"' + + Specifies one of three states for the button: normal, active, or + disabled. In normal state the button is displayed using the + foreground and background options. The active state is typically + used when the pointer is over the button. In active state the + button is displayed using the activeForeground and activeBackground + options. Disabled state means that the button is insensitive: it + doesn't activate and doesn't respond to mouse button presses. In + this state the disabledForeground and background options determine + how the button is displayed. + +':width' + Name='"width" Class="Width"' + + Specifies a desired width for the button. If a bitmap is being + displayed in the button then the value is in screen units (i.e. + any of the forms acceptable to Tk_GetPixels); for text it is in + characters. If this option isn't specified, the button's desired + width is computed from the size of the bitmap or text being + displayed in it. + +Description +----------- + +The button command creates a new window (given by the pathName argument) +and makes it into a button widget. Additional options, described above, +may be specified on the command line or in the option database to +configure aspects of the button such as its colors, font, text, and +initial relief. The button command returns its pathName argument. At +the time this command is invoked, there must not exist a window named +pathName, but pathName's parent must exist. + + A button is a widget that displays a textual string or bitmap. It +can display itself in either of three different ways, according to the +state option; it can be made to appear raised, sunken, or flat; and it +can be made to flash. When a user invokes the button (by pressing mouse +button 1 with the cursor over the button), then the Tcl command +specified in the :command option is invoked. + +A Button Widget's Arguments +--------------------------- + +The button command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for button widgets: + +pathName :activate + Change the button's state to active and redisplay the button using + its active foreground and background colors instead of normal + colors. This command is ignored if the button's state is disabled. + This command is obsolete and will eventually be removed; use + "pathName :configure :state active" instead. +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the button command. +pathName :deactivate + Change the button's state to normal and redisplay the button using + its normal foreground and background colors. This command is + ignored if the button's state is disabled. This command is + obsolete and will eventually be removed; use "pathName :configure + :state normal" instead. +pathName :flash + Flash the button. This is accomplished by redisplaying the button + several times, alternating between active and normal colors. At + the end of the flash the button is left in the same normal/active + state as when the command was invoked. This command is ignored if + the button's state is disabled. +pathName :invoke + Invoke the Tcl command associated with the button, if there is one. + The return value is the return value from the Tcl command, or an + empty string if there is no command associated with the button. + This command is ignored if the button's state is disabled. + +"Default Bindings" +------------------ + +Tk automatically creates class bindings for buttons that give them the +following default behavior: + [1] The button activates whenever the mouse passes over it and + deactivates whenever the mouse leaves the button. + [2] The button's relief is changed to sunken whenever mouse button + 1 is pressed over the button, and the relief is restored to its + original value when button 1 is later released. + [3] If mouse button 1 is pressed over the button and later released + over the button, the button is invoked. However, if the mouse is + not over the button when button 1 is released, then no invocation + occurs. + + If the button's state is disabled then none of the above actions +occur: the button is completely non-responsive. + + The behavior of buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +Keywords +-------- + +button, widget + + +File: gcl-tk.info, Node: listbox, Next: scale, Prev: button, Up: Widgets + +2.2 listbox +=========== + +listbox \- Create and manipulate listbox widgets + +Synopsis +-------- + +listbox pathName ?options? + +Standard Options +---------------- + + background foreground selectBackground xScrollCommand + borderWidth font selectBorderWidth yScrollCommand + cursor geometry selectForeground + exportSelection relief setGrid + + *Note options::, for more information. + +Arguments for Listbox +--------------------- + +None. + +Description +----------- + +The listbox command creates a new window (given by the pathName +argument) and makes it into a listbox widget. Additional options, +described above, may be specified on the command line or in the option +database to configure aspects of the listbox such as its colors, font, +text, and relief. The listbox command returns its pathName argument. +At the time this command is invoked, there must not exist a window named +pathName, but pathName's parent must exist. + + A listbox is a widget that displays a list of strings, one per line. +When first created, a new listbox has no elements in its list. Elements +may be added or deleted using widget commands described below. In +addition, one or more elements may be selected as described below. If a +listbox is exporting its selection (see exportSelection option), then it +will observe the standard X11 protocols for handling the selection; +listbox selections are available as type STRING, consisting of a Tcl +list with one entry for each selected element. + + For large lists only a subset of the list elements will be displayed +in the listbox window at once; commands described below may be used to +change the view in the window. Listboxes allow scrolling in both +directions using the standard xScrollCommand and yScrollCommand options. +They also support scanning, as described below. + +A Listbox's Arguments +--------------------- + +The listbox command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for listbox widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the listbox command. +pathName :curselection + Returns a list containing the indices of all of the elements in the + listbox that are currently selected. If there are no elements + selected in the listbox then an empty string is returned. +pathName :delete first ?last? + Delete one or more elements of the listbox. First and last give + the integer indices of the first and last elements in the range to + be deleted. If last isn't specified it defaults to first, i.e. a + single element is deleted. An index of 0 corresponds to the first + element in the listbox. Either first or last may be specified as + end, in which case it refers to the last element of the listbox. + This command returns an empty string +pathName :get index + Return the contents of the listbox element indicated by index. + Index must be a non-negative integer (0 corresponds to the first + element in the listbox), or it may also be specified as end to + indicate the last element in the listbox. +pathName :insert index ?element element ...? + Insert zero or more new elements in the list just before the + element given by index. If index is specified as end then the new + elements are added to the end of the list. Returns an empty + string. +pathName :nearest y + Given a y-coordinate within the listbox window, this command + returns the index of the (visible) listbox element nearest to that + y-coordinate. +pathName :scan option args + This command is used to implement scanning on listboxes. It has + two forms, depending on option: + pathName :scan :mark x y + Records x and y and the current view in the listbox window; + used in conjunction with later scan dragto commands. + Typically this command is associated with a mouse button press + in the widget. It returns an empty string. + pathName :scan :dragto x y. + This command computes the difference between its x and y + arguments and the x and y arguments to the last scan mark + command for the widget. It then adjusts the view by 10 times + the difference in coordinates. This command is typically + associated with mouse motion events in the widget, to produce + the effect of dragging the list at high speed through the + window. The return value is an empty string. +pathName :select option arg + This command is used to adjust the selection within a listbox. It + has several forms, depending on option. In all of the forms the + index end refers to the last element in the listbox. + pathName :select :adjust index + Locate the end of the selection nearest to the element given + by index, and adjust that end of the selection to be at index + (i.e including but not going beyond index). The other end of + the selection is made the anchor point for future select to + commands. If the selection isn't currently in the listbox, + then this command is identical to the select from widget + command. Returns an empty string. + pathName :select :clear + If the selection is in this listbox then it is cleared so that + none of the listbox's elements are selected anymore. + pathName :select :from index + Set the selection to consist of element index, and make index + the anchor point for future select to widget commands. + Returns an empty string. + pathName :select :to index + Set the selection to consist of the elements from the anchor + point to element index, inclusive. The anchor point is + determined by the most recent select from or select adjust + command in this widget. If the selection isn't in this + widget, this command is identical to select from. Returns an + empty string. + +pathName :size + Returns a decimal string indicating the total number of elements in + the listbox. +pathName :xview index + Adjust the view in the listbox so that character position index is + displayed at the left edge of the widget. Returns an empty string. +pathName :yview index + Adjust the view in the listbox so that element index is displayed + at the top of the widget. If index is specified as end it + indicates the last element of the listbox. Returns an empty + string. + +"Default Bindings" +------------------ + +Tk automatically creates class bindings for listboxes that give them the +following default behavior: + [1] When button 1 is pressed over a listbox, the element underneath + the mouse cursor is selected. The mouse can be dragged to select a + range of elements. + [2] The ends of the selection can be adjusted by dragging with + mouse button 1 while the shift key is down; this will adjust the + end of the selection that was nearest to the mouse cursor when + button 1 was pressed. + [3] The view in the listbox can be adjusted by dragging with mouse + button 2. + + The behavior of listboxes can be changed by defining new bindings for +individual widgets or by redefining the class bindings. In addition, +the procedure tk_listboxSingleSelect may be invoked to change listbox +behavior so that only a single element may be selected at once. + +Keywords +-------- + +listbox, widget + + +File: gcl-tk.info, Node: scale, Next: canvas, Prev: listbox, Up: Widgets + +2.3 scale +========= + +scale \- Create and manipulate scale widgets + +Synopsis +-------- + +scale pathName ?options? + +Standard Options +---------------- + + activeForeground borderWidth font orient + background cursor foreground relief + + *Note options::, for more information. + +Arguments for Scale +------------------- + +':command' + Name='"command" Class="Command"' + + Specifies the prefix of a Tcl command to invoke whenever the value + of the scale is changed interactively. The actual command consists + of this option followed by a space and a number. The number + indicates the new value of the scale. + +':from' + Name='"from" Class="From"' + + Specifies the value corresponding to the left or top end of the + scale. Must be an integer. + +':label' + Name='"label" Class="Label"' + + Specifies a string to displayed as a label for the scale. For + vertical scales the label is displayed just to the right of the top + end of the scale. For horizontal scales the label is displayed + just above the left end of the scale. + +':length' + Name='"length" Class="Length"' + + Specifies the desired long dimension of the scale in screen units, + that is in any of the forms acceptable to Tk_GetPixels. For + vertical scales this is the scale's height; for horizontal scales + it is the scale's width. + +':showvalue' + Name='"showValue" Class="ShowValue"' + + Specifies a boolean value indicating whether or not the current + value of the scale is to be displayed. + +':sliderforeground' + Name='"sliderForeground" Class="sliderForeground"' + + Specifies the color to use for drawing the slider under normal + conditions. When the mouse is in the slider window then the + slider's color is determined by the activeForeground option. + +':sliderlength' + Name='"sliderLength" Class="SliderLength"' + + Specfies the size of the slider, measured in screen units along the + slider's long dimension. The value may be specified in any of the + forms acceptable to Tk_GetPixels. + +':state' + Name='"state" Class="State"' + + Specifies one of two states for the scale: normal or disabled. If + the scale is disabled then the value may not be changed and the + scale won't activate when the mouse enters it. + +':tickinterval' + Name='"tickInterval" Class="TickInterval"' + + Must be an integer value. Determines the spacing between numerical + tick-marks displayed below or to the left of the slider. If + specified as 0, then no tick-marks will be displayed. + +':to' + Name='"to" Class="To"' + + Specifies the value corresponding to the right or bottom end of the + scale. Must be an integer. This value may be either less than or + greater than the from option. + +':width' + Name='"width" Class="Width"' + + Specifies the desired narrow dimension of the scale in screen units + (i.e. any of the forms acceptable to Tk_GetPixels). For vertical + scales this is the scale's width; for horizontal scales this is the + scale's height. + +Description +----------- + +The scale command creates a new window (given by the pathName argument) +and makes it into a scale widget. Additional options, described above, +may be specified on the command line or in the option database to +configure aspects of the scale such as its colors, orientation, and +relief. The scale command returns its pathName argument. At the time +this command is invoked, there must not exist a window named pathName, +but pathName's parent must exist. + + A scale is a widget that displays a rectangular region and a small +slider. The rectangular region corresponds to a range of integer values +(determined by the from and to options), and the position of the slider +selects a particular integer value. The slider's position (and hence +the scale's value) may be adjusted by clicking or dragging with the +mouse as described in the BINDINGS section below. Whenever the scale's +value is changed, a Tcl command is invoked (using the command option) to +notify other interested widgets of the change. + + Three annotations may be displayed in a scale widget: a label +appearing at the top-left of the widget (top-right for vertical scales), +a number displayed just underneath the slider (just to the left of the +slider for vertical scales), and a collection of numerical tick-marks +just underneath the current value (just to the left of the current value +for vertical scales). Each of these three annotations may be +selectively enabled or disabled using the configuration options. + +A Scale's"Argumentsommand" +-------------------------- + +The scale command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for scale widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the scale command. +pathName :get + Returns a decimal string giving the current value of the scale. +pathName :set value + This command is invoked to change the current value of the scale, + and hence the position at which the slider is displayed. Value + gives the new value for the scale. + +Bindings +-------- + +When a new scale is created, it is given the following initial behavior +by default: + + + Change the slider display to use activeForeground instead of + sliderForeground. + + Reset the slider display to use sliderForeground instead of + activeForeground. + + Change the slider display so that the slider appears sunken rather + than raised. Move the slider (and adjust the scale's value) to + correspond to the current mouse position. + + Move the slider (and adjust the scale's value) to correspond to the + current mouse position. + + Reset the slider display so that the slider appears raised again. + +Keywords +-------- + +scale, widget + + +File: gcl-tk.info, Node: canvas, Next: menu, Prev: scale, Up: Widgets + +2.4 canvas +========== + +canvas \- Create and manipulate canvas widgets + +Synopsis +-------- + +canvas pathName ?options? + +Standard Options +---------------- + + background insertBorderWidth relief xScrollCommand + borderWidth insertOffTime selectBackground yScrollCommand + cursor insertOnTime selectBorderWidth + insertBackground insertWidth selectForeground + + *Note options::, for more information. + +Arguments for Canvas +-------------------- + +':closeenough' + Name='"closeEnough" Class="CloseEnough"' + + Specifies a floating-point value indicating how close the mouse + cursor must be to an item before it is considered to be "inside" + the item. Defaults to 1.0. + +':confine' + Name='"confine" Class="Confine"' + + Specifies a boolean value that indicates whether or not it should + be allowable to set the canvas's view outside the region defined by + the scrollRegion argument. Defaults to true, which means that the + view will be constrained within the scroll region. + +':height' + Name='"height" Class="Height"' + + Specifies a desired window height that the canvas widget should + request from its geometry manager. The value may be specified in + any of the forms described in the COORDINATES section below. + +':scrollincrement' + Name='"scrollIncrement" Class="ScrollIncrement"' + + Specifies a distance used as increment during scrolling: when one + of the arrow buttons on an associated scrollbar is pressed, the + picture will shift by this distance. The distance may be specified + in any of the forms described in the COORDINATES section below. + +':scrollregion' + Name='"scrollRegion" Class="ScrollRegion"' + + Specifies a list with four coordinates describing the left, top, + right, and bottom coordinates of a rectangular region. This region + is used for scrolling purposes and is considered to be the boundary + of the information in the canvas. Each of the coordinates may be + specified in any of the forms given in the COORDINATES section + below. + +':width' + Name='"width" Class="width"' + + Specifies a desired window width that the canvas widget should + request from its geometry manager. The value may be specified in + any of the forms described in the COORDINATES section below. + +Introduction +------------ + +The canvas command creates a new window (given by the pathName argument) +and makes it into a canvas widget. Additional options, described above, +may be specified on the command line or in the option database to +configure aspects of the canvas such as its colors and 3-D relief. The +canvas command returns its pathName argument. At the time this command +is invoked, there must not exist a window named pathName, but pathName's +parent must exist. + + Canvas widgets implement structured graphics. A canvas displays any +number of items, which may be things like rectangles, circles, lines, +and text. Items may be manipulated (e.g. moved or re-colored) and +commands may be associated with items in much the same way that the bind +command allows commands to be bound to widgets. For example, a +particular command may be associated with the event so that +the command is invoked whenever button 1 is pressed with the mouse +cursor over an item. This means that items in a canvas can have +behaviors defined by the Tcl scripts bound to them. + +Display List +------------ + +The items in a canvas are ordered for purposes of display, with the +first item in the display list being displayed first, followed by the +next item in the list, and so on. Items later in the display list +obscure those that are earlier in the display list and are sometimes +referred to as being "on top" of earlier items. When a new item is +created it is placed at the end of the display list, on top of +everything else. Widget commands may be used to re-arrange the order of +the display list. + +Item Ids And Tags +----------------- + +Items in a canvas widget may be named in either of two ways: by id or by +tag. Each item has a unique identifying number which is assigned to +that item when it is created. The id of an item never changes and id +numbers are never re-used within the lifetime of a canvas widget. + + Each item may also have any number of tags associated with it. A tag +is just a string of characters, and it may take any form except that of +an integer. For example, "x123" is OK but "123" isn't. The same tag +may be associated with many different items. This is commonly done to +group items in various interesting ways; for example, all selected items +might be given the tag "selected". + + The tag all is implicitly associated with every item in the canvas; +it may be used to invoke operations on all the items in the canvas. + + The tag current is managed automatically by Tk; it applies to the +current item, which is the topmost item whose drawn area covers the +position of the mouse cursor. If the mouse is not in the canvas widget +or is not over an item, then no item has the current tag. + + When specifying items in canvas widget commands, if the specifier is +an integer then it is assumed to refer to the single item with that id. +If the specifier is not an integer, then it is assumed to refer to all +of the items in the canvas that have a tag matching the specifier. The +symbol tagOrId is used below to indicate that an argument specifies +either an id that selects a single item or a tag that selects zero or +more items. Some widget commands only operate on a single item at a +time; if tagOrId is specified in a way that names multiple items, then +the normal behavior is for the command to use the first (lowest) of +these items in the display list that is suitable for the command. +Exceptions are noted in the widget command descriptions below. + +Coordinates +----------- + +All coordinates related to canvases are stored as floating-point +numbers. Coordinates and distances are specified in screen units, which +are floating-point numbers optionally followed by one of several +letters. If no letter is supplied then the distance is in pixels. If +the letter is m then the distance is in millimeters on the screen; if it +is c then the distance is in centimeters; i means inches, and p means +printers points (1/72 inch). Larger y-coordinates refer to points lower +on the screen; larger x-coordinates refer to points farther to the +right. + +Transformations +--------------- + +Normally the origin of the canvas coordinate system is at the upper-left +corner of the window containing the canvas. It is possible to adjust +the origin of the canvas coordinate system relative to the origin of the +window using the xview and yview widget commands; this is typically used +for scrolling. Canvases do not support scaling or rotation of the +canvas coordinate system relative to the window coordinate system. + + Indidividual items may be moved or scaled using widget commands +described below, but they may not be rotated. + +Indices +------- + +Text items support the notion of an index for identifying particular +positions within the item. Indices are used for commands such as +inserting text, deleting a range of characters, and setting the +insertion cursor position. An index may be specified in any of a number +of ways, and different types of items may support different forms for +specifying indices. Text items support the following forms for an +index; if you define new types of text-like items, it would be advisable +to support as many of these forms as practical. Note that it is +possible to refer to the character just after the last one in the text +item; this is necessary for such tasks as inserting new text at the end +of the item. + +number + A decimal number giving the position of the desired character + within the text item. 0 refers to the first character, 1 to the + next character, and so on. A number less than 0 is treated as if + it were zero, and a number greater than the length of the text item + is treated as if it were equal to the length of the text item. +end + Refers to the character just after the last one in the item (same + as the number of characters in the item). +insert + Refers to the character just before which the insertion cursor is + drawn in this item. +sel.first + Refers to the first selected character in the item. If the + selection isn't in this item then this form is illegal. +sel.last + Refers to the last selected character in the item. If the + selection isn't in this item then this form is illegal. +@x,y + Refers to the character at the point given by x and y, where x and + y are specified in the coordinate system of the canvas. If x and y + lie outside the coordinates covered by the text item, then they + refer to the first or last character in the line that is closest to + the given point. + +A Canvas Widget's Arguments +--------------------------- + +The canvas command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following widget commands are possible for canvas widgets: + +pathName :addtag tag searchSpec ?arg arg ...? + For each item that meets the constraints specified by searchSpec + and the args, add tag to the list of tags associated with the item + if it isn't already present on that list. It is possible that no + items will satisfy the constraints given by searchSpec and args, in + which case the command has no effect. This command returns an + empty string as result. SearchSpec and arg's may take any of the + following forms: + + above tagOrId + Selects the item just after (above) the one given by tagOrId + in the display list. If tagOrId denotes more than one item, + then the last (topmost) of these items in the display list is + used. + all + Selects all the items in the canvas. + below tagOrId + Selects the item just before (below) the one given by tagOrId + in the display list. If tagOrId denotes more than one item, + then the first (lowest) of these items in the display list is + used. + closest x y ?halo? ?start? + Selects the item closest to the point given by x and y. If + more than one item is at the same closest distance (e.g. two + items overlap the point), then the top-most of these items + (the last one in the display list) is used. If halo is + specified, then it must be a non-negative value. Any item + closer than halo to the point is considered to overlap it. + The start argument may be used to step circularly through all + the closest items. If start is specified, it names an item + using a tag or id (if by tag, it selects the first item in the + display list with the given tag). Instead of selecting the + topmost closest item, this form will select the topmost + closest item that is below start in the display list; if no + such item exists, then the selection behaves as if the start + argument had not been specified. + enclosed x1 y1 x2 y2 + Selects all the items completely enclosed within the + rectangular region given by x1, y1, x2, and y2. X1 must be no + greater then x2 and y1 must be no greater than y2. + overlapping x1 y1 x2 y2 + Selects all the items that overlap or are enclosed within the + rectangular region given by x1, y1, x2, and y2. X1 must be no + greater then x2 and y1 must be no greater than y2. + withtag tagOrId + Selects all the items given by tagOrId. + +pathName :bbox tagOrId ?tagOrId tagOrId ...? + Returns a list with four elements giving an approximate bounding + box for all the items named by the tagOrId arguments. The list has + the form "x1 y1 x2 y2" such that the drawn areas of all the named + elements are within the region bounded by x1 on the left, x2 on the + right, y1 on the top, and y2 on the bottom. The return value may + overestimate the actual bounding box by a few pixels. If no items + match any of the tagOrId arguments then an empty string is + returned. +pathName :bind tagOrId ?sequence? ?command? + This command associates command with all the items given by tagOrId + such that whenever the event sequence given by sequence occurs for + one of the items the command will be invoked. This widget command + is similar to the bind command except that it operates on items in + a canvas rather than entire widgets. See the bind manual entry for + complete details on the syntax of sequence and the substitutions + performed on command before invoking it. If all arguments are + specified then a new binding is created, replacing any existing + binding for the same sequence and tagOrId (if the first character + of command is "+" then command augments an existing binding rather + than replacing it). In this case the return value is an empty + string. If command is omitted then the command returns the command + associated with tagOrId and sequence (an error occurs if there is + no such binding). If both command and sequence are omitted then + the command returns a list of all the sequences for which bindings + have been defined for tagOrId. + + The only events for which bindings may be specified are those related +to the mouse and keyboard, such as Enter, Leave, ButtonPress, Motion, +and KeyPress. The handling of events in canvases uses the current item +defined in ITEM IDS AND TAGS above. Enter and Leave events trigger for +an item when it becomes the current item or ceases to be the current +item; note that these events are different than Enter and Leave events +for windows. Mouse-related events are directed to the current item, if +any. Keyboard-related events are directed to the focus item, if any +(see the focus widget command below for more on this). + + It is possible for multiple commands to be bound to a single event +sequence for a single object. This occurs, for example, if one command +is associated with the item's id and another is associated with one of +the item's tags. When this occurs, the first matching binding is used. +A binding for the item's id has highest priority, followed by the oldest +tag for the item and proceeding through all of the item's tags up +through the most-recently-added one. If a binding is associated with +the tag all, the binding will have lower priority than all other +bindings associated with the item. + +pathName :canvasx screenx ?gridspacing? + Given a screen x-coordinate screenx this command returns the canvas + x-coordinate that is displayed at that location. If gridspacing is + specified, then the canvas coordinate is rounded to the nearest + multiple of gridspacing units. +pathName :canvasy screeny ?gridspacing? + Given a screen y-coordinate screeny this command returns the canvas + y-coordinate that is displayed at that location. If gridspacing is + specified, then the canvas coordinate is rounded to the nearest + multiple of gridspacing units. +pathName :configure ?option? ?value? ?option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the canvas command. +pathName :coords tagOrId ?x0 y0 ...? + Query or modify the coordinates that define an item. If no + coordinates are specified, this command returns a list whose + elements are the coordinates of the item named by tagOrId. If + coordinates are specified, then they replace the current + coordinates for the named item. If tagOrId refers to multiple + items, then the first one in the display list is used. +pathName :create type x y ?x y ...? ?option value ...? + Create a new item in pathName of type type. The exact format of + the arguments after type depends on type, but usually they consist + of the coordinates for one or more points, followed by + specifications for zero or more item options. See the subsections + on individual item types below for more on the syntax of this + command. This command returns the id for the new item. +pathName :dchars tagOrId first ?last? + For each item given by tagOrId, delete the characters in the range + given by first and last, inclusive. If some of the items given by + tagOrId don't support text operations, then they are ignored. + First and last are indices of characters within the item(s) as + described in INDICES above. If last is omitted, it defaults to + first. This command returns an empty string. +pathName :delete ?tagOrId tagOrId ...? + Delete each of the items given by each tagOrId, and return an empty + string. +pathName :dtag tagOrId ?tagToDelete? + For each of the items given by tagOrId, delete the tag given by + tagToDelete from the list of those associated with the item. If an + item doesn't have the tag tagToDelete then the item is unaffected + by the command. If tagToDelete is omitted then it defaults to + tagOrId. This command returns an empty string. +pathName :find searchCommand ?arg arg ...? + This command returns a list consisting of all the items that meet + the constraints specified by searchCommand and arg's. + SearchCommand and args have any of the forms accepted by the addtag + command. +pathName :focus ?tagOrId? + Set the keyboard focus for the canvas widget to the item given by + tagOrId. If tagOrId refers to several items, then the focus is set + to the first such item in the display list that supports the + insertion cursor. If tagOrId doesn't refer to any items, or if + none of them support the insertion cursor, then the focus isn't + changed. If tagOrId is an empty string, then the focus item is + reset so that no item has the focus. If tagOrId is not specified + then the command returns the id for the item that currently has the + focus, or an empty string if no item has the focus. + + Once the focus has been set to an item, the item will display the +insertion cursor and all keyboard events will be directed to that item. +The focus item within a canvas and the focus window on the screen (set +with the focus command) are totally independent: a given item doesn't +actually have the input focus unless (a) its canvas is the focus window +and (b) the item is the focus item within the canvas. In most cases it +is advisable to follow the focus widget command with the focus command +to set the focus window to the canvas (if it wasn't there already). + +pathName :gettags tagOrId + Return a list whose elements are the tags associated with the item + given by tagOrId. If tagOrId refers to more than one item, then + the tags are returned from the first such item in the display list. + If tagOrId doesn't refer to any items, or if the item contains no + tags, then an empty string is returned. +pathName :icursor tagOrId index + Set the position of the insertion cursor for the item(s) given by + tagOrId to just before the character whose position is given by + index. If some or all of the items given by tagOrId don't support + an insertion cursor then this command has no effect on them. See + INDICES above for a description of the legal forms for index. + Note: the insertion cursor is only displayed in an item if that + item currently has the keyboard focus (see the widget command + focus, below), but the cursor position may be set even when the + item doesn't have the focus. This command returns an empty string. +pathName :index tagOrId index + This command returns a decimal string giving the numerical index + within tagOrId corresponding to index. Index gives a textual + description of the desired position as described in INDICES above. + The return value is guaranteed to lie between 0 and the number of + characters within the item, inclusive. If tagOrId refers to + multiple items, then the index is processed in the first of these + items that supports indexing operations (in display list order). +pathName :insert tagOrId beforeThis string + For each of the items given by tagOrId, if the item supports text + insertion then string is inserted into the item's text just before + the character whose index is beforeThis. See INDICES above for + information about the forms allowed for beforeThis. This command + returns an empty string. +pathName :itemconfigure tagOrId ?option? ?value? ?option value ...? + This command is similar to the configure widget command except that + it modifies item-specific options for the items given by tagOrId + instead of modifying options for the overall canvas widget. If no + option is specified, returns a list describing all of the available + options for the first item given by tagOrId (see Tk_ConfigureInfo + for information on the format of this list). If option is + specified with no value, then the command returns a list describing + the one named option (this list will be identical to the + corresponding sublist of the value returned if no option is + specified). If one or more option:value pairs are specified, then + the command modifies the given widget option(s) to have the given + value(s) in each of the items given by tagOrId; in this case the + command returns an empty string. The options and values are the + same as those permissible in the create widget command when the + item(s) were created; see the sections describing individual item + types below for details on the legal options. +pathName :lower tagOrId ?belowThis? + Move all of the items given by tagOrId to a new position in the + display list just before the item given by belowThis. If tagOrId + refers to more than one item then all are moved but the relative + order of the moved items will not be changed. BelowThis is a tag + or id; if it refers to more than one item then the first (lowest) + of these items in the display list is used as the destination + location for the moved items. This command returns an empty + string. +pathName :move tagOrId xAmount yAmount + Move each of the items given by tagOrId in the canvas coordinate + space by adding xAmount to the x-coordinate of each point + associated with the item and yAmount to the y-coordinate of each + point associated with the item. This command returns an empty + string. +pathName :postscript ?option value option value ...? + Generate a Postscript representation for part or all of the canvas. + If the :file option is specified then the Postscript is written to + a file and an empty string is returned; otherwise the Postscript is + returned as the result of the command. The Postscript is created + in Encapsulated Postscript form using version 3.0 of the Document + Structuring Conventions. The option\-value argument pairs provide + additional information to control the generation of Postscript. + The following options are supported: + + :colormap varName + VarName must be the name of a global array variable that + specifies a color mapping to use in the Postscript. Each + element of varName must consist of Postscript code to set a + particular color value (e.g. "1.0 1.0 0.0 setrgbcolor"). + When outputting color information in the Postscript, Tk checks + to see if there is an element of varName with the same name as + the color. If so, Tk uses the value of the element as the + Postscript command to set the color. If this option hasn't + been specified, or if there isn't an entry in varName for a + given color, then Tk uses the red, green, and blue intensities + from the X color. + :colormode mode + Specifies how to output color information. Mode must be + either color (for full color output), gray (convert all colors + to their gray-scale equivalents) or mono (convert all colors + to black or white). + :file fileName + Specifies the name of the file in which to write the + Postscript. If this option isn't specified then the + Postscript is returned as the result of the command instead of + being written to a file. + :fontmap varName + VarName must be the name of a global array variable that + specifies a font mapping to use in the Postscript. Each + element of varName must consist of a Tcl list with two + elements, which are the name and point size of a Postscript + font. When outputting Postscript commands for a particular + font, Tk checks to see if varName contains an element with the + same name as the font. If there is such an element, then the + font information contained in that element is used in the + Postscript. Otherwise Tk attempts to guess what Postscript + font to use. Tk's guesses generally only work for well-known + fonts such as Times and Helvetica and Courier, and only if the + X font name does not omit any dashes up through the point + size. For example, + \fB\-*\-Courier\-Bold\-R\-Normal\-\-*\-120\-* will work but + \fB*Courier\-Bold\-R\-Normal*120* will not; Tk needs the + dashes to parse the font name). + :height size + Specifies the height of the area of the canvas to print. + Defaults to the height of the canvas window. + :pageanchor anchor + Specifies which point of the printed area should be appear + over the positioning point on the page (which is given by the + :pagex and :pagey options). For example, :pageanchor n means + that the top center of the printed area should be over the + positioning point. Defaults to center. + :pageheight size + Specifies that the Postscript should be scaled in both x and y + so that the printed area is size high on the Postscript page. + Size consists of a floating-point number followed by c for + centimeters, i for inches, m for millimeters, or p or nothing + for printer's points (1/72 inch). Defaults to the height of + the printed area on the screen. If both :pageheight and + :pagewidth are specified then the scale factor from the later + option is used (non-uniform scaling is not implemented). + :pagewidth size + Specifies that the Postscript should be scaled in both x and y + so that the printed area is size wide on the Postscript page. + Size has the same form as for :pageheight. Defaults to the + width of the printed area on the screen. If both :pageheight + and :pagewidth are specified then the scale factor from the + later option is used (non-uniform scaling is not implemented). + :pagex position + Position gives the x-coordinate of the positioning point on + the Postscript page, using any of the forms allowed for + :pageheight. Used in conjunction with the :pagey and + :pageanchor options to determine where the printed area + appears on the Postscript page. Defaults to the center of the + page. + :pagey position + Position gives the y-coordinate of the positioning point on + the Postscript page, using any of the forms allowed for + :pageheight. Used in conjunction with the :pagex and + :pageanchor options to determine where the printed area + appears on the Postscript page. Defaults to the center of the + page. + :rotate boolean + Boolean specifies whether the printed area is to be rotated 90 + degrees. In non-rotated output the x-axis of the printed area + runs along the short dimension of the page ("portrait" + orientation); in rotated output the x-axis runs along the long + dimension of the page ("landscape" orientation). Defaults to + non-rotated. + :width size + Specifies the width of the area of the canvas to print. + Defaults to the width of the canvas window. + :x position + Specifies the x-coordinate of the left edge of the area of the + canvas that is to be printed, in canvas coordinates, not + window coordinates. Defaults to the coordinate of the left + edge of the window. + :y position + Specifies the y-coordinate of the top edge of the area of the + canvas that is to be printed, in canvas coordinates, not + window coordinates. Defaults to the coordinate of the top + edge of the window. + +pathName :raise tagOrId ?aboveThis? + Move all of the items given by tagOrId to a new position in the + display list just after the item given by aboveThis. If tagOrId + refers to more than one item then all are moved but the relative + order of the moved items will not be changed. AboveThis is a tag + or id; if it refers to more than one item then the last (topmost) + of these items in the display list is used as the destination + location for the moved items. This command returns an empty + string. +pathName :scale tagOrId xOrigin yOrigin xScale yScale + Rescale all of the items given by tagOrId in canvas coordinate + space. XOrigin and yOrigin identify the origin for the scaling + operation and xScale and yScale identify the scale factors for x- + and y-coordinates, respectively (a scale factor of 1.0 implies no + change to that coordinate). For each of the points defining each + item, the x-coordinate is adjusted to change the distance from + xOrigin by a factor of xScale. Similarly, each y-coordinate is + adjusted to change the distance from yOrigin by a factor of yScale. + This command returns an empty string. +pathName :scan option args + This command is used to implement scanning on canvases. It has two + forms, depending on option: + + pathName :scan :mark x y + Records x and y and the canvas's current view; used in + conjunction with later scan dragto commands. Typically this + command is associated with a mouse button press in the widget + and x and y are the coordinates of the mouse. It returns an + empty string. + pathName :scan :dragto x y. + This command computes the difference between its x and y + arguments (which are typically mouse coordinates) and the x + and y arguments to the last scan mark command for the widget. + It then adjusts the view by 10 times the difference in + coordinates. This command is typically associated with mouse + motion events in the widget, to produce the effect of dragging + the canvas at high speed through its window. The return value + is an empty string. + +pathName :select option ?tagOrId arg? + Manipulates the selection in one of several ways, depending on + option. The command may take any of the forms described below. In + all of the descriptions below, tagOrId must refer to an item that + supports indexing and selection; if it refers to multiple items + then the first of these that supports indexing and the selection is + used. Index gives a textual description of a position within + tagOrId, as described in INDICES above. + + pathName :select :adjust tagOrId index + Locate the end of the selection in tagOrId nearest to the + character given by index, and adjust that end of the selection + to be at index (i.e. including but not going beyond index). + The other end of the selection is made the anchor point for + future select to commands. If the selection isn't currently + in tagOrId then this command behaves the same as the select to + widget command. Returns an empty string. + pathName :select :clear + Clear the selection if it is in this widget. If the selection + isn't in this widget then the command has no effect. Returns + an empty string. + pathName :select :from tagOrId index + Set the selection anchor point for the widget to be just + before the character given by index in the item given by + tagOrId. This command doesn't change the selection; it just + sets the fixed end of the selection for future select to + commands. Returns an empty string. + pathName :select :item + Returns the id of the selected item, if the selection is in an + item in this canvas. If the selection is not in this canvas + then an empty string is returned. + pathName :select :to tagOrId index + Set the selection to consist of those characters of tagOrId + between the selection anchor point and index. The new + selection will include the character given by index; it will + include the character given by the anchor point only if index + is greater than or equal to the anchor point. The anchor + point is determined by the most recent select adjust or select + from command for this widget. If the selection anchor point + for the widget isn't currently in tagOrId, then it is set to + the same character given by index. Returns an empty string. + +pathName :type tagOrId + Returns the type of the item given by tagOrId, such as rectangle or + text. If tagOrId refers to more than one item, then the type of + the first item in the display list is returned. If tagOrId doesn't + refer to any items at all then an empty string is returned. +pathName :xview index + Change the view in the canvas so that the canvas position given by + index appears at the left edge of the window. This command is + typically used by scrollbars to scroll the canvas. Index counts in + units of scroll increments (the value of the scrollIncrement + option): a value of 0 corresponds to the left edge of the scroll + region (as defined by the scrollRegion option), a value of 1 means + one scroll unit to the right of this, and so on. The return value + is an empty string. +pathName :yview index + Change the view in the canvas so that the canvas position given by + index appears at the top edge of the window. This command is + typically used by scrollbars to scroll the canvas. Index counts in + units of scroll increments (the value of the scrollIncrement + option): a value of 0 corresponds to the top edge of the scroll + region (as defined by the scrollRegion option), a value of 1 means + one scroll unit below this, and so on. The return value is an + empty string. + +Overview Of Item Types +---------------------- + +The sections below describe the various types of items supported by +canvas widgets. Each item type is characterized by two things: first, +the form of the create command used to create instances of the type; and +second, a set of configuration options for items of that type, which may +be used in the create and itemconfigure widget commands. Most items +don't support indexing or selection or the commands related to them, +such as index and insert. Where items do support these facilities, it +is noted explicitly in the descriptions below (at present, only text +items provide this support). + +Arc Items +--------- + +Items of type arc appear on the display as arc-shaped regions. An arc +is a section of an oval delimited by two angles (specified by the :start +and :extent options) and displayed in one of several ways (specified by +the :style option). Arcs are created with widget commands of the +following form: + +pathName :create arc x1 y1 x2 y2 ?option value option value ...? + The arguments x1, y1, x2, and y2 give the coordinates of two + diagonally opposite corners of a rectangular region enclosing the + oval that defines the arc. After the coordinates there may be any + number of option-value pairs, each of which sets one of the + configuration options for the item. These same option\-value pairs + may be used in itemconfigure widget commands to change the item's + configuration. The following options are supported for arcs: + + :extent degrees + Specifies the size of the angular range occupied by the arc. + The arc's range extends for degrees degrees counter-clockwise + from the starting angle given by the :start option. Degrees + may be negative. + :fill color + Fill the region of the arc with color. Color may have any of + the forms accepted by Tk_GetColor. If color is an empty + string (the default), then then the arc will not be filled. + :outline color + Color specifies a color to use for drawing the arc's outline; + it may have any of the forms accepted by Tk_GetColor. This + option defaults to black. If the arc's style is arc then this + option is ignored (the section of perimeter is filled using + the :fill option). If color is specified as an empty string + then no outline is drawn for the arc. + :start degrees + Specifies the beginning of the angular range occupied by the + arc. Degrees is given in units of degrees measured + counter-clockwise from the 3-o'clock position; it may be + either positive or negative. + :stipple bitmap + Indicates that the arc should be filled in a stipple pattern; + bitmap specifies the stipple pattern to use, in any of the + forms accepted by Tk_GetBitmap. If the :fill option hasn't + been specified then this option has no effect. If bitmap is + an empty string (the default), then filling is done in a solid + fashion. + :style type + Specifies how to draw the arc. If type is pieslice (the + default) then the arc's region is defined by a section of the + oval's perimeter plus two line segments, one between the + center of the oval and each end of the perimeter section. If + type is chord then the arc's region is defined by a section of + the oval's perimeter plus a single line segment connecting the + two end points of the perimeter section. If type is arc then + the arc's region consists of a section of the perimeter alone. + In this last case there is no outline for the arc and the + :outline option is ignored. + :tags tagList + Specifies a set of tags to apply to the item. TagList + consists of a list of tag names, which replace any existing + tags for the item. TagList may be an empty list. + :width outlineWidth + Specifies the width of the outline to be drawn around the + arc's region, in any of the forms described in the COORDINATES + section above. If the :outline option has been specified as + an empty string then this option has no effect. Wide outlines + will be drawn centered on the edges of the arc's region. This + option defaults to 1.0. + +Bitmap Items +------------ + +Items of type bitmap appear on the display as images with two colors, +foreground and background. Bitmaps are created with widget commands of +the following form: + +pathName :create bitmap x y ?option value option value ...? + The arguments x and y specify the coordinates of a point used to + position the bitmap on the display (see the :anchor option below + for more information on how bitmaps are displayed). After the + coordinates there may be any number of option-value pairs, each of + which sets one of the configuration options for the item. These + same option\-value pairs may be used in itemconfigure widget + commands to change the item's configuration. The following options + are supported for bitmaps: + + :anchor anchorPos + AnchorPos tells how to position the bitmap relative to the + positioning point for the item; it may have any of the forms + accepted by Tk_GetAnchor. For example, if anchorPos is center + then the bitmap is centered on the point; if anchorPos is n + then the bitmap will be drawn so that its top center point is + at the positioning point. This option defaults to center. + :background color + Specifies a color to use for each of the bitmap pixels whose + value is 0. Color may have any of the forms accepted by + Tk_GetColor. If this option isn't specified, or if it is + specified as an empty string, then the background color for + the canvas is used. + :bitmap bitmap + Specifies the bitmap to display in the item. Bitmap may have + any of the forms accepted by Tk_GetBitmap. + :foreground color + Specifies a color to use for each of the bitmap pixels whose + value is 1. Color may have any of the forms accepted by + Tk_GetColor and defaults to black. + :tags tagList + Specifies a set of tags to apply to the item. TagList + consists of a list of tag names, which replace any existing + tags for the item. TagList may be an empty list. + +Line Items +---------- + +Items of type line appear on the display as one or more connected line +segments or curves. Lines are created with widget commands of the +following form: + +pathName :create line x1 y1... xn yn ?option value option value ...? + + The arguments x1 through yn give the coordinates for a series of + two or more points that describe a series of connected line + segments. After the coordinates there may be any number of + option-value pairs, each of which sets one of the configuration + options for the item. These same option\-value pairs may be used + in itemconfigure widget commands to change the item's + configuration. The following options are supported for lines: + + :arrow where + Indicates whether or not arrowheads are to be drawn at one or + both ends of the line. Where must have one of the values none + (for no arrowheads), first (for an arrowhead at the first + point of the line), last (for an arrowhead at the last point + of the line), or both (for arrowheads at both ends). This + option defaults to none. + :arrowshape shape + This option indicates how to draw arrowheads. The shape + argument must be a list with three elements, each specifying a + distance in any of the forms described in the COORDINATES + section above. The first element of the list gives the + distance along the line from the neck of the arrowhead to its + tip. The second element gives the distance along the line + from the trailing points of the arrowhead to the tip, and the + third element gives the distance from the outside edge of the + line to the trailing points. If this option isn't specified + then Tk picks a "reasonable" shape. + :capstyle style + Specifies the ways in which caps are to be drawn at the + endpoints of the line. Style may have any of the forms + accepted by Tk_GetCapStyle (butt, projecting, or round). If + this option isn't specified then it defaults to butt. Where + arrowheads are drawn the cap style is ignored. + :fill color + Color specifies a color to use for drawing the line; it may + have any of the forms acceptable to Tk_GetColor. It may also + be an empty string, in which case the line will be + transparent. This option defaults to black. + :joinstyle style + Specifies the ways in which joints are to be drawn at the + vertices of the line. Style may have any of the forms + accepted by Tk_GetCapStyle (bevel, miter, or round). If this + option isn't specified then it defaults to miter. If the line + only contains two points then this option is irrelevant. + :smooth boolean + Boolean must have one of the forms accepted by Tk_GetBoolean. + It indicates whether or not the line should be drawn as a + curve. If so, the line is rendered as a set of Bezier + splines: one spline is drawn for the first and second line + segments, one for the second and third, and so on. + Straight-line segments can be generated within a curve by + duplicating the end-points of the desired line segment. + :splinesteps number + Specifies the degree of smoothness desired for curves: each + spline will be approximated with number line segments. This + option is ignored unless the :smooth option is true. + :stipple bitmap + Indicates that the line should be filled in a stipple pattern; + bitmap specifies the stipple pattern to use, in any of the + forms accepted by Tk_GetBitmap. If bitmap is an empty string + (the default), then filling is done in a solid fashion. + :tags tagList + Specifies a set of tags to apply to the item. TagList + consists of a list of tag names, which replace any existing + tags for the item. TagList may be an empty list. + :width lineWidth + LineWidth specifies the width of the line, in any of the forms + described in the COORDINATES section above. Wide lines will + be drawn centered on the path specified by the points. If + this option isn't specified then it defaults to 1.0. + +Oval Items +---------- + +Items of type oval appear as circular or oval regions on the display. +Each oval may have an outline, a fill, or both. Ovals are created with +widget commands of the following form: + +pathName :create oval x1 y1 x2 y2 ?option value option value ...? + + The arguments x1, y1, x2, and y2 give the coordinates of two + diagonally opposite corners of a rectangular region enclosing the + oval. The oval will include the top and left edges of the + rectangle not the lower or right edges. If the region is square + then the resulting oval is circular; otherwise it is elongated in + shape. After the coordinates there may be any number of + option-value pairs, each of which sets one of the configuration + options for the item. These same option\-value pairs may be used + in itemconfigure widget commands to change the item's + configuration. The following options are supported for ovals: + + :fill color + Fill the area of the oval with color. Color may have any of + the forms accepted by Tk_GetColor. If color is an empty + string (the default), then then the oval will not be filled. + :outline color + Color specifies a color to use for drawing the oval's outline; + it may have any of the forms accepted by Tk_GetColor. This + option defaults to black. If color is an empty string then no + outline will be drawn for the oval. + :stipple bitmap + Indicates that the oval should be filled in a stipple pattern; + bitmap specifies the stipple pattern to use, in any of the + forms accepted by Tk_GetBitmap. If the :fill option hasn't + been specified then this option has no effect. If bitmap is + an empty string (the default), then filling is done in a solid + fashion. + :tags tagList + Specifies a set of tags to apply to the item. TagList + consists of a list of tag names, which replace any existing + tags for the item. TagList may be an empty list. + :width outlineWidth + outlineWidth specifies the width of the outline to be drawn + around the oval, in any of the forms described in the + COORDINATES section above. If the :outline option hasn't been + specified then this option has no effect. Wide outlines are + drawn centered on the oval path defined by x1, y1, x2, and y2. + This option defaults to 1.0. + +Polygon Items +------------- + +Items of type polygon appear as polygonal or curved filled regions on +the display. Polygons are created with widget commands of the following +form: + +pathName :create polygon x1 y1 ... xn yn ?option value option value ...? + + The arguments x1 through yn specify the coordinates for three or + more points that define a closed polygon. The first and last + points may be the same; whether they are or not, Tk will draw the + polygon as a closed polygon. After the coordinates there may be + any number of option-value pairs, each of which sets one of the + configuration options for the item. These same option\-value pairs + may be used in itemconfigure widget commands to change the item's + configuration. The following options are supported for polygons: + + :fill color + Color specifies a color to use for filling the area of the + polygon; it may have any of the forms acceptable to + Tk_GetColor. If color is an empty string then the polygon + will be transparent. This option defaults to black. + :smooth boolean + Boolean must have one of the forms accepted by Tk_GetBoolean + It indicates whether or not the polygon should be drawn with a + curved perimeter. If so, the outline of the polygon becomes a + set of Bezier splines, one spline for the first and second + line segments, one for the second and third, and so on. + Straight-line segments can be generated in a smoothed polygon + by duplicating the end-points of the desired line segment. + :splinesteps number + Specifies the degree of smoothness desired for curves: each + spline will be approximated with number line segments. This + option is ignored unless the :smooth option is true. + :stipple bitmap + Indicates that the polygon should be filled in a stipple + pattern; bitmap specifies the stipple pattern to use, in any + of the forms accepted by Tk_GetBitmap. If bitmap is an empty + string (the default), then filling is done in a solid fashion. + :tags tagList + Specifies a set of tags to apply to the item. TagList + consists of a list of tag names, which replace any existing + tags for the item. TagList may be an empty list. + +Rectangle Items +--------------- + +Items of type rectangle appear as rectangular regions on the display. +Each rectangle may have an outline, a fill, or both. Rectangles are +created with widget commands of the following form: + +pathName :create rectangle x1 y1 x2 y2 ?option value option value ...? + + The arguments x1, y1, x2, and y2 give the coordinates of two + diagonally opposite corners of the rectangle (the rectangle will + include its upper and left edges but not its lower or right edges). + After the coordinates there may be any number of option-value + pairs, each of which sets one of the configuration options for the + item. These same option\-value pairs may be used in itemconfigure + widget commands to change the item's configuration. The following + options are supported for rectangles: + + :fill color + Fill the area of the rectangle with color, which may be + specified in any of the forms accepted by Tk_GetColor. If + color is an empty string (the default), then then the + rectangle will not be filled. + :outline color + Draw an outline around the edge of the rectangle in color. + Color may have any of the forms accepted by Tk_GetColor. This + option defaults to black. If color is an empty string then no + outline will be drawn for the rectangle. + :stipple bitmap + Indicates that the rectangle should be filled in a stipple + pattern; bitmap specifies the stipple pattern to use, in any + of the forms accepted by Tk_GetBitmap. If the :fill option + hasn't been specified then this option has no effect. If + bitmap is an empty string (the default), then filling is done + in a solid fashion. + :tags tagList + Specifies a set of tags to apply to the item. TagList + consists of a list of tag names, which replace any existing + tags for the item. TagList may be an empty list. + :width outlineWidth + OutlineWidth specifies the width of the outline to be drawn + around the rectangle, in any of the forms described in the + COORDINATES section above. If the :outline option hasn't been + specified then this option has no effect. Wide outlines are + drawn centered on the rectangular path defined by x1, y1, x2, + and y2. This option defaults to 1.0. + +Text Items +---------- + +A text item displays a string of characters on the screen in one or more +lines. Text items support indexing and selection, along with the +following text-related canvas widget commands: dchars, focus, icursor, +index, insert, select. Text items are created with widget commands of +the following form: + +pathName :create text x y ?option value option value ...? + + The arguments x and y specify the coordinates of a point used to + position the text on the display (see the options below for more + information on how text is displayed). After the coordinates there + may be any number of option-value pairs, each of which sets one of + the configuration options for the item. These same option\-value + pairs may be used in itemconfigure widget commands to change the + item's configuration. The following options are supported for text + items: + + :anchor anchorPos + AnchorPos tells how to position the text relative to the + positioning point for the text; it may have any of the forms + accepted by Tk_GetAnchor. For example, if anchorPos is center + then the text is centered on the point; if anchorPos is n then + the text will be drawn such that the top center point of the + rectangular region occupied by the text will be at the + positioning point. This option defaults to center. + :fill color + Color specifies a color to use for filling the text + characters; it may have any of the forms accepted by + Tk_GetColor. If this option isn't specified then it defaults + to black. + :font fontName + Specifies the font to use for the text item. FontName may be + any string acceptable to Tk_GetFontStruct. If this option + isn't specified, it defaults to a system-dependent font. + :justify how + Specifies how to justify the text within its bounding region. + How must be one of the values left, right, or center. This + option will only matter if the text is displayed as multiple + lines. If the option is omitted, it defaults to left. + :stipple bitmap + Indicates that the text should be drawn in a stippled pattern + rather than solid; bitmap specifies the stipple pattern to + use, in any of the forms accepted by Tk_GetBitmap. If bitmap + is an empty string (the default) then the text is drawn in a + solid fashion. + :tags tagList + Specifies a set of tags to apply to the item. TagList + consists of a list of tag names, which replace any existing + tags for the item. TagList may be an empty list. + :text string + String specifies the characters to be displayed in the text + item. Newline characters cause line breaks. The characters + in the item may also be changed with the insert and delete + widget commands. This option defaults to an empty string. + :width lineLength + Specifies a maximum line length for the text, in any of the + forms described in the COORDINATES section abov. If this + option is zero (the default) the text is broken into lines + only at newline characters. However, if this option is + non-zero then any line that would be longer than lineLength is + broken just before a space character to make the line shorter + than lineLength; the space character is treated as if it were + a newline character. + +Window Items +------------ + +Items of type window cause a particular window to be displayed at a +given position on the canvas. Window items are created with widget +commands of the following form: + + pathName :create window x y ?option value option value ...? + + The arguments x and y specify the coordinates of a point used to +position the window on the display (see the :anchor option below for +more information on how bitmaps are displayed). After the coordinates +there may be any number of option-value pairs, each of which sets one of +the configuration options for the item. These same option\-value pairs +may be used in itemconfigure widget commands to change the item's +configuration. The following options are supported for window items: + +:anchor anchorPos + AnchorPos tells how to position the window relative to the + positioning point for the item; it may have any of the forms + accepted by Tk_GetAnchor. For example, if anchorPos is center then + the window is centered on the point; if anchorPos is n then the + window will be drawn so that its top center point is at the + positioning point. This option defaults to center. +:height pixels + Specifies the height to assign to the item's window. Pixels may + have any of the forms described in the COORDINATES section above. + If this option isn't specified, or if it is specified as an empty + string, then the window is given whatever height it requests + internally. +:tags tagList + Specifies a set of tags to apply to the item. TagList consists of + a list of tag names, which replace any existing tags for the item. + TagList may be an empty list. +:width pixels + Specifies the width to assign to the item's window. Pixels may + have any of the forms described in the COORDINATES section above. + If this option isn't specified, or if it is specified as an empty + string, then the window is given whatever width it requests + internally. +:window pathName + Specifies the window to associate with this item. The window + specified by pathName must either be a child of the canvas widget + or a child of some ancestor of the canvas widget. PathName may not + refer to a top-level window. + +Application-Defined Item Types +------------------------------ + +It is possible for individual applications to define new item types for +canvas widgets using C code. The interfaces for this mechanism are not +presently documented, and it's possible they may change, but you should +be able to see how they work by examining the code for some of the +existing item types. + +Bindings +-------- + +In the current implementation, new canvases are not given any default +behavior: you'll have to execute explicit Tcl commands to give the +canvas its behavior. + +Credits +------- + +Tk's canvas widget is a blatant ripoff of ideas from Joel Bartlett's ezd +program. Ezd provides structured graphics in a Scheme environment and +preceded canvases by a year or two. Its simple mechanisms for placing +and animating graphical objects inspired the functions of canvases. + +Keywords +-------- + +canvas, widget + + +File: gcl-tk.info, Node: menu, Next: scrollbar, Prev: canvas, Up: Widgets + +2.5 menu +======== + +menu \- Create and manipulate menu widgets + +Synopsis +-------- + +menu pathName ?options? + +Standard Options +---------------- + + activeBackground background disabledForeground + activeBorderWidth borderWidth font + activeForeground cursor foreground + + *Note options::, for more information. + +Arguments for Menu +------------------ + +':postcommand' + Name='"postCommand" Class="Command"' + + If this option is specified then it provides a Tcl command to + execute each time the menu is posted. The command is invoked by + the post widget command before posting the menu. + +':selector' + Name='"selector" Class="Foreground"' + + For menu entries that are check buttons or radio buttons, this + option specifies the color to display in the selector when the + check button or radio button is selected. + +Introduction +------------ + +The menu command creates a new top-level window (given by the pathName +argument) and makes it into a menu widget. Additional options, +described above, may be specified on the command line or in the option +database to configure aspects of the menu such as its colors and font. +The menu command returns its pathName argument. At the time this +command is invoked, there must not exist a window named pathName, but +pathName's parent must exist. + + A menu is a widget that displays a collection of one-line entries +arranged in a column. There exist several different types of entries, +each with different properties. Entries of different types may be +combined in a single menu. Menu entries are not the same as entry +widgets. In fact, menu entries are not even distinct widgets; the +entire menu is one widget. + + Menu entries are displayed with up to three separate fields. The +main field is a label in the form of text or a bitmap, which is +determined by the :label or :bitmap option for the entry. If the +:accelerator option is specified for an entry then a second textual +field is displayed to the right of the label. The accelerator typically +describes a keystroke sequence that may be typed in the application to +cause the same result as invoking the menu entry. The third field is a +selector. The selector is present only for check-button or radio-button +entries. It indicates whether the entry is selected or not, and is +displayed to the left of the entry's string. + + In normal use, an entry becomes active (displays itself differently) +whenever the mouse pointer is over the entry. If a mouse button is +released over the entry then the entry is invoked. The effect of +invocation is different for each type of entry; these effects are +described below in the sections on individual entries. + + Entries may be disabled, which causes their labels and accelerators +to be displayed with dimmer colors. A disabled entry cannot be +activated or invoked. Disabled entries may be re-enabled, at which +point it becomes possible to activate and invoke them again. + +Command Entries +--------------- + +The most common kind of menu entry is a command entry, which behaves +much like a button widget. When a command entry is invoked, a Tcl +command is executed. The Tcl command is specified with the :command +option. + +Separator Entries +----------------- + +A separator is an entry that is displayed as a horizontal dividing line. +A separator may not be activated or invoked, and it has no behavior +other than its display appearance. + +Check-Button Entries +-------------------- + +A check-button menu entry behaves much like a check-button widget. When +it is invoked it toggles back and forth between the selected and +deselected states. When the entry is selected, a particular value is +stored in a particular global variable (as determined by the :onvalue +and :variable options for the entry); when the entry is deselected +another value (determined by the :offvalue option) is stored in the +global variable. A selector box is displayed to the left of the label +in a check-button entry. If the entry is selected then the box's center +is displayed in the color given by the selector option for the menu; +otherwise the box's center is displayed in the background color for the +menu. If a :command option is specified for a check-button entry, then +its value is evaluated as a Tcl command each time the entry is invoked; +this happens after toggling the entry's selected state. + +Radio-Button Entries +-------------------- + +A radio-button menu entry behaves much like a radio-button widget. +Radio-button entries are organized in groups of which only one entry may +be selected at a time. Whenever a particular entry becomes selected it +stores a particular value into a particular global variable (as +determined by the :value and :variable options for the entry). This +action causes any previously-selected entry in the same group to +deselect itself. Once an entry has become selected, any change to the +entry's associated variable will cause the entry to deselect itself. +Grouping of radio-button entries is determined by their associated +variables: if two entries have the same associated variable then they +are in the same group. A selector diamond is displayed to the left of +the label in each radio-button entry. If the entry is selected then the +diamond's center is displayed in the color given by the selector option +for the menu; otherwise the diamond's center is displayed in the +background color for the menu. If a :command option is specified for a +radio-button entry, then its value is evaluated as a Tcl command each +time the entry is invoked; this happens after selecting the entry. + +Cascade Entries +--------------- + +A cascade entry is one with an associated menu (determined by the :menu +option). Cascade entries allow the construction of cascading menus. +When the entry is activated, the associated menu is posted just to the +right of the entry; that menu remains posted until the higher-level menu +is unposted or until some other entry is activated in the higher-level +menu. The associated menu should normally be a child of the menu +containing the cascade entry, in order for menu traversal to work +correctly. + + A cascade entry posts its associated menu by invoking a Tcl command +of the form + +menu :post x y + + where menu is the path name of the associated menu, x and y are the + root-window coordinates of the upper-right corner of the cascade + entry, and group is the name of the menu's group (as determined in + its last post widget command). The lower-level menu is unposted by + executing a Tcl command with the form + +menu:unpost + where menu is the name of the associated menu. + + If a :command option is specified for a cascade entry then it is +evaluated as a Tcl command each time the associated menu is posted (the +evaluation occurs before the menu is posted). + +A Menu Widget's Arguments +------------------------- + +The menu command creates a new Tcl command whose name is pathName. This +command may be used to invoke various operations on the widget. It has +the following general form: + +pathName option ?arg arg ...? + Option and the args determine the exact behavior of the command. + + Many of the widget commands for a menu take as one argument an +indicator of which entry of the menu to operate on. These indicators +are called indexes and may be specified in any of the following forms: + +number + Specifies the entry numerically, where 0 corresponds to the + top-most entry of the menu, 1 to the entry below it, and so on. +active + Indicates the entry that is currently active. If no entry is + active then this form is equivalent to none. This form may not be + abbreviated. +last + Indicates the bottommost entry in the menu. If there are no + entries in the menu then this form is equivalent to none. This + form may not be abbreviated. +none + Indicates "no entry at all"; this is used most commonly with the + activate option to deactivate all the entries in the menu. In most + cases the specification of none causes nothing to happen in the + widget command. This form may not be abbreviated. +@number + In this form, number is treated as a y-coordinate in the menu's + window; the entry spanning that y-coordinate is used. For example, + "@0" indicates the top-most entry in the window. If number is + outside the range of the window then this form is equivalent to + none. +pattern + If the index doesn't satisfy one of the above forms then this form + is used. Pattern is pattern-matched against the label of each + entry in the menu, in order from the top down, until a matching + entry is found. The rules of Tcl_StringMatch are used. + + The following widget commands are possible for menu widgets: +pathName :activate index + Change the state of the entry indicated by index to active and + redisplay it using its active colors. Any previously-active entry + is deactivated. If index is specified as none, or if the specified + entry is disabled, then the menu ends up with no active entry. + Returns an empty string. +pathName :add type ?option value option value ...? + Add a new entry to the bottom of the menu. The new entry's type is + given by type and must be one of cascade, checkbutton, command, + radiobutton, or separator, or a unique abbreviation of one of the + above. If additional arguments are present, they specify any of + the following options: + + :activebackground value + Specifies a background color to use for displaying this entry + when it is active. If this option is specified as an empty + string (the default), then the activeBackground option for the + overall menu is used. This option is not available for + separator entries. + :accelerator value + Specifies a string to display at the right side of the menu + entry. Normally describes an accelerator keystroke sequence + that may be typed to invoke the same function as the menu + entry. This option is not available for separator entries. + :background value + Specifies a background color to use for displaying this entry + when it is in the normal state (neither active nor disabled). + If this option is specified as an empty string (the default), + then the background option for the overall menu is used. This + option is not available for separator entries. + :bitmap value + Specifies a bitmap to display in the menu instead of a textual + label, in any of the forms accepted by Tk_GetBitmap. This + option overrides the :label option but may be reset to an + empty string to enable a textual label to be displayed. This + option is not available for separator entries. + :command value + For command, checkbutton, and radiobutton entries, specifies a + Tcl command to execute when the menu entry is invoked. For + cascade entries, specifies a Tcl command to execute when the + entry is activated (i.e. just before its submenu is posted). + Not available for separator entries. + :font value + Specifies the font to use when drawing the label or + accelerator string in this entry. If this option is specified + as an empty string (the default) then the font option for the + overall menu is used. This option is not available for + separator entries. + :label value + Specifies a string to display as an identifying label in the + menu entry. Not available for separator entries. + :menu value + Available only for cascade entries. Specifies the path name + of the menu associated with this entry. + :offvalue value + Available only for check-button entries. Specifies the value + to store in the entry's associated variable when the entry is + deselected. + :onvalue value + Available only for check-button entries. Specifies the value + to store in the entry's associated variable when the entry is + selected. + :state value + Specifies one of three states for the entry: normal, active, + or disabled. In normal state the entry is displayed using the + foreground option for the menu and the background option from + the entry or the menu. The active state is typically used + when the pointer is over the entry. In active state the entry + is displayed using the activeForeground option for the menu + along with the activebackground option from the entry. + Disabled state means that the entry is insensitive: it doesn't + activate and doesn't respond to mouse button presses or + releases. In this state the entry is displayed according to + the disabledForeground option for the menu and the background + option from the entry. This option is not available for + separator entries. + :underline value + Specifies the integer index of a character to underline in the + entry. This option is typically used to indicate keyboard + traversal characters. 0 corresponds to the first character of + the text displayed in the entry, 1 to the next character, and + so on. If a bitmap is displayed in the entry then this option + is ignored. This option is not available for separator + entries. + :value value + Available only for radio-button entries. Specifies the value + to store in the entry's associated variable when the entry is + selected. + :variable value + Available only for check-button and radio-button entries. + Specifies the name of a global value to set when the entry is + selected. For check-button entries the variable is also set + when the entry is deselected. For radio-button entries, + changing the variable causes the currently-selected entry to + deselect itself. + + The add widget command returns an empty string. + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the menu command. +pathName :delete index1 ?index2? + Delete all of the menu entries between index1 and index2 inclusive. + If index2 is omitted then it defaults to index1. Returns an empty + string. +pathName :disable index + Change the state of the entry given by index to disabled and + redisplay the entry using its disabled colors. Returns an empty + string. This command is obsolete and will eventually be removed; + use "pathName :entryconfigure index :state disabled" instead. +pathName :enable index + Change the state of the entry given by index to normal and + redisplay the entry using its normal colors. Returns an empty + string. This command is obsolete and will eventually be removed; + use "pathName :entryconfigure index :state normal" instead. +pathName :entryconfigure index ?options? + This command is similar to the configure command, except that it + applies to the options for an individual entry, whereas configure + applies to the options for the menu as a whole. Options may have + any of the values accepted by the add widget command. If options + are specified, options are modified as indicated in the command and + the command returns an empty string. If no options are specified, + returns a list describing the current options for entry index (see + Tk_ConfigureInfo for information on the format of this list). +pathName :index index + Returns the numerical index corresponding to index, or none if + index was specified as none. +pathName :invoke index + Invoke the action of the menu entry. See the sections on the + individual entries above for details on what happens. If the menu + entry is disabled then nothing happens. If the entry has a command + associated with it then the result of that command is returned as + the result of the invoke widget command. Otherwise the result is + an empty string. Note: invoking a menu entry does not + automatically unpost the menu. Normally the associated menubutton + will take care of unposting the menu. +pathName :post x y + Arrange for the menu to be displayed on the screen at the + root-window coordinates given by x and y. These coordinates are + adjusted if necessary to guarantee that the entire menu is visible + on the screen. This command normally returns an empty string. If + the :postcommand option has been specified, then its value is + executed as a Tcl script before posting the menu and the result of + that script is returned as the result of the post widget command. + If an error returns while executing the command, then the error is + returned without posting the menu. +pathName :unpost + Unmap the window so that it is no longer displayed. If a + lower-level cascaded menu is posted, unpost that menu. Returns an + empty string. +pathName :yposition index + Returns a decimal string giving the y-coordinate within the menu + window of the topmost pixel in the entry specified by index. + +Default Bindings +---------------- + +Tk automatically creates class bindings for menus that give them the +following default behavior: + [1] When the mouse cursor enters a menu, the entry underneath the + mouse cursor is activated; as the mouse moves around the menu, the + active entry changes to track the mouse. + [2] When button 1 is released over a menu, the active entry (if + any) is invoked. + [3] A menu can be repositioned on the screen by dragging it with + mouse button 2. + [4] A number of other bindings are created to support keyboard menu + traversal. See the manual entry for tk_bindForTraversal for + details on these bindings. + + Disabled menu entries are non-responsive: they don't activate and +ignore mouse button presses and releases. + + The behavior of menus can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +Bugs +---- + +At present it isn't possible to use the option database to specify +values for the options to individual entries. + +Keywords +-------- + +menu, widget + + +File: gcl-tk.info, Node: scrollbar, Next: checkbutton, Prev: menu, Up: Widgets + +2.6 scrollbar +============= + +scrollbar \- Create and manipulate scrollbar widgets + +Synopsis +-------- + +scrollbar pathName ?options? + +Standard Options +---------------- + + activeForeground cursor relief + background foreground repeatDelay + borderWidth orient repeatInterval + + *Note options::, for more information. + +Arguments for Scrollbar +----------------------- + +':command' + Name='"command" Class="Command"' + + Specifies the prefix of a Tcl command to invoke to change the view + in the widget associated with the scrollbar. When a user requests + a view change by manipulating the scrollbar, a Tcl command is + invoked. The actual command consists of this option followed by a + space and a number. The number indicates the logical unit that + should appear at the top of the associated window. + +':width' + Name='"width" Class="Width"' + + Specifies the desired narrow dimension of the scrollbar window, not + including 3-D border, if any. For vertical scrollbars this will be + the width and for horizontal scrollbars this will be the height. + The value may have any of the forms acceptable to Tk_GetPixels. + +Description +----------- + +The scrollbar command creates a new window (given by the pathName +argument) and makes it into a scrollbar widget. Additional options, +described above, may be specified on the command line or in the option +database to configure aspects of the scrollbar such as its colors, +orientation, and relief. The scrollbar command returns its pathName +argument. At the time this command is invoked, there must not exist a +window named pathName, but pathName's parent must exist. + + A scrollbar is a widget that displays two arrows, one at each end of +the scrollbar, and a slider in the middle portion of the scrollbar. A +scrollbar is used to provide information about what is visible in an +associated window that displays an object of some sort (such as a file +being edited or a drawing). The position and size of the slider +indicate which portion of the object is visible in the associated +window. For example, if the slider in a vertical scrollbar covers the +top third of the area between the two arrows, it means that the +associated window displays the top third of its object. + + Scrollbars can be used to adjust the view in the associated window by +clicking or dragging with the mouse. See the BINDINGS section below for +details. + +A Scrollbar Widget's Arguments +------------------------------ + +The scrollbar command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for scrollbar widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the scrollbar command. +pathName :get + Returns a Tcl list containing four decimal values, which are the + current totalUnits, widnowUnits, firstUnit, and lastUnit values for + the scrollbar. These are the values from the most recent set + widget command on the scrollbar. +pathName :set totalUnits windowUnits firstUnit lastUnit + This command is invoked to give the scrollbar information about the + widget associated with the scrollbar. TotalUnits is an integer + value giving the total size of the object being displayed in the + associated widget. The meaning of one unit depends on the + associated widget; for example, in a text editor widget units might + correspond to lines of text. WindowUnits indicates the total + number of units that can fit in the associated window at one time. + FirstUnit and lastUnit give the indices of the first and last units + currently visible in the associated window (zero corresponds to the + first unit of the object). This command should be invoked by the + associated widget whenever its object or window changes size and + whenever it changes the view in its window. + +Bindings +-------- + +The description below assumes a vertically-oriented scrollbar. For a +horizontally-oriented scrollbar replace the words "up", "down", "top", +and "bottom" with "left", "right", "left", and "right", respectively + + A scrollbar widget is divided into five distinct areas. From top to +bottom, they are: the top arrow, the top gap (the empty space between +the arrow and the slider), the slider, the bottom gap, and the bottom +arrow. Pressing mouse button 1 in each area has a different effect: + +top arrow + Causes the view in the associated window to shift up by one unit + (i.e. the object appears to move down one unit in its window). If + the button is held down the action will auto-repeat. +top gap + Causes the view in the associated window to shift up by one less + than the number of units in the window (i.e. the portion of the + object that used to appear at the very top of the window will now + appear at the very bottom). If the button is held down the action + will auto-repeat. +slider + Pressing button 1 in this area has no immediate effect except to + cause the slider to appear sunken rather than raised. However, if + the mouse is moved with the button down then the slider will be + dragged, adjusting the view as the mouse is moved. +bottom gap + Causes the view in the associated window to shift down by one less + than the number of units in the window (i.e. the portion of the + object that used to appear at the very bottom of the window will + now appear at the very top). If the button is held down the action + will auto-repeat. +bottom arrow + Causes the view in the associated window to shift down by one unit + (i.e. the object appears to move up one unit in its window). If + the button is held down the action will auto-repeat. + + Note: none of the actions described above has an immediate impact + on the position of the slider in the scrollbar. It simply invokes + the command specified in the command option to notify the + associated widget that a change in view is desired. If the view is + actually changed then the associated widget must invoke the + scrollbar's set widget command to change what is displayed in the + scrollbar. + +Keywords +-------- + +scrollbar, widget + + +File: gcl-tk.info, Node: checkbutton, Next: menubutton, Prev: scrollbar, Up: Widgets + +2.7 checkbutton +=============== + +checkbutton \- Create and manipulate check-button widgets + +Synopsis +-------- + +checkbutton pathName ?options? + +Standard Options +---------------- + + activeBackground bitmap font relief + activeForeground borderWidth foreground text + anchor cursor padX textVariable + background disabledForeground padY + + *Note options::, for more information. + +Arguments for Checkbutton +------------------------- + +':command' + Name='"command" Class="Command"' + + Specifies a Tcl command to associate with the button. This command + is typically invoked when mouse button 1 is released over the + button window. The button's global variable (:variable option) + will be updated before the command is invoked. + +':height' + Name='"height" Class="Height"' + + Specifies a desired height for the button. If a bitmap is being + displayed in the button then the value is in screen units (i.e. + any of the forms acceptable to Tk_GetPixels); for text it is in + lines of text. If this option isn't specified, the button's + desired height is computed from the size of the bitmap or text + being displayed in it. + +':offvalue' + Name='"offValue" Class="Value"' + + Specifies value to store in the button's associated variable + whenever this button is deselected. Defaults to "0". + +':onvalue' + Name='"onValue" Class="Value"' + + Specifies value to store in the button's associated variable + whenever this button is selected. Defaults to "1". + +':selector' + Name='"selector" Class="Foreground"' + + Specifies the color to draw in the selector when this button is + selected. If specified as an empty string then no selector is + drawn for the button. + +':state' + Name='"state" Class="State"' + + Specifies one of three states for the check button: normal, active, + or disabled. In normal state the check button is displayed using + the foreground and background options. The active state is + typically used when the pointer is over the check button. In + active state the check button is displayed using the + activeForeground and activeBackground options. Disabled state + means that the check button is insensitive: it doesn't activate and + doesn't respond to mouse button presses. In this state the + disabledForeground and background options determine how the check + button is displayed. + +':variable' + Name='"variable" Class="Variable"' + + Specifies name of global variable to set to indicate whether or not + this button is selected. Defaults to the name of the button within + its parent (i.e. the last element of the button window's path + name). + +':width' + Name='"width" Class="Width"' + + Specifies a desired width for the button. If a bitmap is being + displayed in the button then the value is in screen units (i.e. + any of the forms acceptable to Tk_GetPixels); for text it is in + characters. If this option isn't specified, the button's desired + width is computed from the size of the bitmap or text being + displayed in it. + +Description +----------- + +The checkbutton command creates a new window (given by the pathName +argument) and makes it into a check-button widget. Additional options, +described above, may be specified on the command line or in the option +database to configure aspects of the check button such as its colors, +font, text, and initial relief. The checkbutton command returns its +pathName argument. At the time this command is invoked, there must not +exist a window named pathName, but pathName's parent must exist. + + A check button is a widget that displays a textual string or bitmap +and a square called a selector. A check button has all of the behavior +of a simple button, including the following: it can display itself in +either of three different ways, according to the state option; it can be +made to appear raised, sunken, or flat; it can be made to flash; and it +invokes a Tcl command whenever mouse button 1 is clicked over the check +button. + + In addition, check buttons can be selected. If a check button is +selected then a special highlight appears in the selector, and a Tcl +variable associated with the check button is set to a particular value +(normally 1). If the check button is not selected, then the selector is +drawn in a different fashion and the associated variable is set to a +different value (typically 0). By default, the name of the variable +associated with a check button is the same as the name used to create +the check button. The variable name, and the "on" and "off" values +stored in it, may be modified with options on the command line or in the +option database. By default a check button is configured to select and +deselect itself on alternate button clicks. In addition, each check +button monitors its associated variable and automatically selects and +deselects itself when the variables value changes to and from the +button's "on" value. + +A Checkbutton Widget's Arguments +-------------------------------- + +The checkbutton command creates a new Tcl command whose name is +pathName. This command may be used to invoke various operations on the +widget. It has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for check button widgets: + +pathName :activate + Change the check button's state to active and redisplay the button + using its active foreground and background colors instead of normal + colors. This command is ignored if the check button's state is + disabled. This command is obsolete and will eventually be removed; + use "pathName :configure :state active" instead. +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the checkbutton command. +pathName :deactivate + Change the check button's state to normal and redisplay the button + using its normal foreground and background colors. This command is + ignored if the check button's state is disabled. This command is + obsolete and will eventually be removed; use "pathName :configure + :state normal" instead. +pathName :deselect + Deselect the check button: redisplay it without a highlight in the + selector and set the associated variable to its "off" value. +pathName :flash + Flash the check button. This is accomplished by redisplaying the + check button several times, alternating between active and normal + colors. At the end of the flash the check button is left in the + same normal/active state as when the command was invoked. This + command is ignored if the check button's state is disabled. +pathName :invoke + Does just what would have happened if the user invoked the check + button with the mouse: toggle the selection state of the button and + invoke the Tcl command associated with the check button, if there + is one. The return value is the return value from the Tcl command, + or an empty string if there is no command associated with the check + button. This command is ignored if the check button's state is + disabled. +pathName :select + Select the check button: display it with a highlighted selector and + set the associated variable to its "on" value. +pathName :toggle + Toggle the selection state of the button, redisplaying it and + modifying its associated variable to reflect the new state. + +Bindings +-------- + +Tk automatically creates class bindings for check buttons that give them +the following default behavior: + [1] The check button activates whenever the mouse passes over it + and deactivates whenever the mouse leaves the check button. + [2] The check button's relief is changed to sunken whenever mouse + button 1 is pressed over it, and the relief is restored to its + original value when button 1 is later released. + [3] If mouse button 1 is pressed over the check button and later + released over the check button, the check button is invoked (i.e. + its selection state toggles and the command associated with the + button is invoked, if there is one). However, if the mouse is not + over the check button when button 1 is released, then no invocation + occurs. + + If the check button's state is disabled then none of the above +actions occur: the check button is completely non-responsive. + + The behavior of check buttons can be changed by defining new bindings +for individual widgets or by redefining the class bindings. + +Keywords +-------- + +check button, widget + + +File: gcl-tk.info, Node: menubutton, Next: text, Prev: checkbutton, Up: Widgets + +2.8 menubutton +============== + +menubutton \- Create and manipulate menubutton widgets + +Synopsis +-------- + +menubutton pathName ?options? + +Standard Options +---------------- + + activeBackground bitmap font relief + activeForeground borderWidth foreground text + anchor cursor padX textVariable + background disabledForeground padY underline + + *Note options::, for more information. + +Arguments for Menubutton +------------------------ + +':height' + Name='"height" Class="Height"' + + Specifies a desired height for the menu button. If a bitmap is + being displayed in the menu button then the value is in screen + units (i.e. any of the forms acceptable to Tk_GetPixels); for text + it is in lines of text. If this option isn't specified, the menu + button's desired height is computed from the size of the bitmap or + text being displayed in it. + +':menu' + Name='"menu" Class="MenuName"' + + Specifies the path name of the menu associated with this + menubutton. The menu must be a descendant of the menubutton in + order for normal pull-down operation to work via the mouse. + +':state' + Name='"state" Class="State"' + + Specifies one of three states for the menu button: normal, active, + or disabled. In normal state the menu button is displayed using + the foreground and background options. The active state is + typically used when the pointer is over the menu button. In active + state the menu button is displayed using the activeForeground and + activeBackground options. Disabled state means that the menu + button is insensitive: it doesn't activate and doesn't respond to + mouse button presses. In this state the disabledForeground and + background options determine how the button is displayed. + +':width' + Name='"width" Class="Width"' + + Specifies a desired width for the menu button. If a bitmap is + being displayed in the menu button then the value is in screen + units (i.e. any of the forms acceptable to Tk_GetPixels); for text + it is in characters. If this option isn't specified, the menu + button's desired width is computed from the size of the bitmap or + text being displayed in it. + +Introduction +------------ + +The menubutton command creates a new window (given by the pathName +argument) and makes it into a menubutton widget. Additional options, +described above, may be specified on the command line or in the option +database to configure aspects of the menubutton such as its colors, +font, text, and initial relief. The menubutton command returns its +pathName argument. At the time this command is invoked, there must not +exist a window named pathName, but pathName's parent must exist. + + A menubutton is a widget that displays a textual string or bitmap and +is associated with a menu widget. In normal usage, pressing mouse +button 1 over the menubutton causes the associated menu to be posted +just underneath the menubutton. If the mouse is moved over the menu +before releasing the mouse button, the button release causes the +underlying menu entry to be invoked. When the button is released, the +menu is unposted. + + Menubuttons are typically organized into groups called menu bars that +allow scanning: if the mouse button is pressed over one menubutton +(causing it to post its menu) and the mouse is moved over another +menubutton in the same menu bar without releasing the mouse button, then +the menu of the first menubutton is unposted and the menu of the new +menubutton is posted instead. The tk-menu-bar procedure is used to set +up menu bars for scanning; see that procedure for more details. + +A Menubutton Widget's Arguments +------------------------------- + +The menubutton command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for menubutton widgets: + +pathName :activate + Change the menu button's state to active and redisplay the menu + button using its active foreground and background colors instead of + normal colors. The command returns an empty string. This command + is ignored if the menu button's state is disabled. This command is + obsolete and will eventually be removed; use "pathName :configure + :state active" instead. +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the menubutton command. +pathName :deactivate + Change the menu button's state to normal and redisplay the menu + button using its normal foreground and background colors. The + command returns an empty string. This command is ignored if the + menu button's state is disabled. This command is obsolete and will + eventually be removed; use "pathName :configure :state normal" + instead. + +"Default Bindings" +------------------ + +Tk automatically creates class bindings for menu buttons that give them +the following default behavior: + [1] A menu button activates whenever the mouse passes over it and + deactivates whenever the mouse leaves it. + [2] A menu button's relief is changed to raised whenever mouse + button 1 is pressed over it, and the relief is restored to its + original value when button 1 is later released or the mouse is + dragged into another menu button in the same menu bar. + [3] When mouse button 1 is pressed over a menu button, or when the + mouse is dragged into a menu button with mouse button 1 pressed, + the associated menu is posted; the mouse can be dragged across the + menu and released over an entry in the menu to invoke that entry. + The menu is unposted when button 1 is released outside either the + menu or the menu button. The menu is also unposted when the mouse + is dragged into another menu button in the same menu bar. + [4] If mouse button 1 is pressed and released within the menu + button, then the menu stays posted and keyboard traversal is + possible as described in the manual entry for tk-menu-bar. + [5] Menubuttons may also be posted by typing characters on the + keyboard. See the manual entry for tk-menu-bar for full details on + keyboard menu traversal. + [6] If mouse button 2 is pressed over a menu button then the + associated menu is posted and also torn off: it can then be dragged + around on the screen with button 2 and the menu will not + automatically unpost when entries in it are invoked. To close a + torn off menu, click mouse button 1 over the associated menu + button. + + If the menu button's state is disabled then none of the above actions +occur: the menu button is completely non-responsive. + + The behavior of menu buttons can be changed by defining new bindings +for individual widgets or by redefining the class bindings. + +Keywords +-------- + +menubutton, widget + + +File: gcl-tk.info, Node: text, Next: entry, Prev: menubutton, Up: Widgets + +2.9 text +======== + +text \- Create and manipulate text widgets + +Synopsis +-------- + +text pathName ?options? + +Standard Options +---------------- + + background foreground insertWidth selectBorderWidth + borderWidth insertBackground padX selectForeground + cursor insertBorderWidth padY setGrid + exportSelection insertOffTime relief yScrollCommand + font insertOnTime selectBackground + + *Note options::, for more information. + +Arguments for Text +------------------ + +':height' + Name='"height" Class="Height"' + + Specifies the desired height for the window, in units of + characters. Must be at least one. + +':state' + Name='"state" Class="State"' + + Specifies one of two states for the text: normal or disabled. If + the text is disabled then characters may not be inserted or deleted + and no insertion cursor will be displayed, even if the input focus + is in the widget. + +':width' + Name='"width" Class="Width"' + + Specifies the desired width for the window in units of characters. + If the font doesn't have a uniform width then the width of the + character "0" is used in translating from character units to screen + units. + +':wrap' + Name='"wrap" Class="Wrap"' + + Specifies how to handle lines in the text that are too long to be + displayed in a single line of the text's window. The value must be + none or char or word. A wrap mode of none means that each line of + text appears as exactly one line on the screen; extra characters + that don't fit on the screen are not displayed. In the other modes + each line of text will be broken up into several screen lines if + necessary to keep all the characters visible. In char mode a + screen line break may occur after any character; in word mode a + line break will only be made at word boundaries. + +Description +----------- + +The text command creates a new window (given by the pathName argument) +and makes it into a text widget. Additional options, described above, +may be specified on the command line or in the option database to +configure aspects of the text such as its default background color and +relief. The text command returns the path name of the new window. + + A text widget displays one or more lines of text and allows that text +to be edited. Text widgets support three different kinds of annotations +on the text, called tags, marks, and windows. Tags allow different +portions of the text to be displayed with different fonts and colors. +In addition, Tcl commands can be associated with tags so that commands +are invoked when particular actions such as keystrokes and mouse button +presses occur in particular ranges of the text. See TAGS below for more +details. + + The second form of annotation consists of marks, which are floating +markers in the text. Marks are used to keep track of various +interesting positions in the text as it is edited. See MARKS below for +more details. + + The third form of annotation allows arbitrary windows to be displayed +in the text widget. See WINDOWS below for more details. + +Indices +------- + +Many of the widget commands for texts take one or more indices as +arguments. An index is a string used to indicate a particular place +within a text, such as a place to insert characters or one endpoint of a +range of characters to delete. Indices have the syntax + + base modifier modifier modifier ... + + Where base gives a starting point and the modifiers adjust the index +from the starting point (e.g. move forward or backward one character). +Every index must contain a base, but the modifiers are optional. + + The base for an index must have one of the following forms: + +line.char + Indicates char'th character on line line. Lines are numbered from + 1 for consistency with other UNIX programs that use this numbering + scheme. Within a line, characters are numbered from 0. +@x,y + Indicates the character that covers the pixel whose x and y + coordinates within the text's window are x and y. +end + Indicates the last character in the text, which is always a newline + character. +mark + Indicates the character just after the mark whose name is mark. +tag.first + Indicates the first character in the text that has been tagged with + tag. This form generates an error if no characters are currently + tagged with tag. +tag.last + Indicates the character just after the last one in the text that + has been tagged with tag. This form generates an error if no + characters are currently tagged with tag. + + If modifiers follow the base index, each one of them must have one of +the forms listed below. Keywords such as chars and wordend may be +abbreviated as long as the abbreviation is unambiguous. + ++ count chars + Adjust the index forward by count characters, moving to later lines + in the text if necessary. If there are fewer than count characters + in the text after the current index, then set the index to the last + character in the text. Spaces on either side of count are + optional. +- count chars + Adjust the index backward by count characters, moving to earlier + lines in the text if necessary. If there are fewer than count + characters in the text before the current index, then set the index + to the first character in the text. Spaces on either side of count + are optional. ++ count lines + Adjust the index forward by count lines, retaining the same + character position within the line. If there are fewer than count + lines after the line containing the current index, then set the + index to refer to the same character position on the last line of + the text. Then, if the line is not long enough to contain a + character at the indicated character position, adjust the character + position to refer to the last character of the line (the newline). + Spaces on either side of count are optional. +- count lines + Adjust the index backward by count lines, retaining the same + character position within the line. If there are fewer than count + lines before the line containing the current index, then set the + index to refer to the same character position on the first line of + the text. Then, if the line is not long enough to contain a + character at the indicated character position, adjust the character + position to refer to the last character of the line (the newline). + Spaces on either side of count are optional. +linestart + Adjust the index to refer to the first character on the line. +lineend + Adjust the index to refer to the last character on the line (the + newline). +wordstart + Adjust the index to refer to the first character of the word + containing the current index. A word consists of any number of + adjacent characters that are letters, digits, or underscores, or a + single character that is not one of these. +wordend + Adjust the index to refer to the character just after the last one + of the word containing the current index. If the current index + refers to the last character of the text then it is not modified. + + If more than one modifier is present then they are applied in +left-to-right order. For example, the index "\fBend \- 1 chars" refers +to the next-to-last character in the text and "\fBinsert wordstart \- 1 +c" refers to the character just before the first one in the word +containing the insertion cursor. + +Tags +---- + +The first form of annotation in text widgets is a tag. A tag is a +textual string that is associated with some of the characters in a text. +There may be any number of tags associated with characters in a text. +Each tag may refer to a single character, a range of characters, or +several ranges of characters. An individual character may have any +number of tags associated with it. + + A priority order is defined among tags, and this order is used in +implementing some of the tag-related functions described below. When a +tag is defined (by associating it with characters or setting its display +options or binding commands to it), it is given a priority higher than +any existing tag. The priority order of tags may be redefined using the +"pathName :tag :raise" and "pathName :tag :lower" widget commands. + + Tags serve three purposes in text widgets. First, they control the +way information is displayed on the screen. By default, characters are +displayed as determined by the background, font, and foreground options +for the text widget. However, display options may be associated with +individual tags using the "pathName :tag configure" widget command. If +a character has been tagged, then the display options associated with +the tag override the default display style. The following options are +currently supported for tags: + +:background color + Color specifies the background color to use for characters + associated with the tag. It may have any of the forms accepted by + Tk_GetColor. +:bgstipple bitmap + Bitmap specifies a bitmap that is used as a stipple pattern for the + background. It may have any of the forms accepted by Tk_GetBitmap. + If bitmap hasn't been specified, or if it is specified as an empty + string, then a solid fill will be used for the background. +:borderwidth pixels + Pixels specifies the width of a 3-D border to draw around the + background. It may have any of the forms accepted by Tk_GetPixels. + This option is used in conjunction with the :relief option to give + a 3-D appearance to the background for characters; it is ignored + unless the :background option has been set for the tag. +:fgstipple bitmap + Bitmap specifies a bitmap that is used as a stipple pattern when + drawing text and other foreground information such as underlines. + It may have any of the forms accepted by Tk_GetBitmap. If bitmap + hasn't been specified, or if it is specified as an empty string, + then a solid fill will be used. +:font fontName + FontName is the name of a font to use for drawing characters. It + may have any of the forms accepted by Tk_GetFontStruct. +:foreground color + Color specifies the color to use when drawing text and other + foreground information such as underlines. It may have any of the + forms accepted by Tk_GetColor. +:relief relief + \fIRelief specifies the 3-D relief to use for drawing backgrounds, + in any of the forms accepted by Tk_GetRelief. This option is used + in conjunction with the :borderwidth option to give a 3-D + appearance to the background for characters; it is ignored unless + the :background option has been set for the tag. +:underline boolean + Boolean specifies whether or not to draw an underline underneath + characters. It may have any of the forms accepted by + Tk_GetBoolean. + + If a character has several tags associated with it, and if their + display options conflict, then the options of the highest priority + tag are used. If a particular display option hasn't been specified + for a particular tag, or if it is specified as an empty string, + then that option will never be used; the next-highest-priority + tag's option will used instead. If no tag specifies a particular + display optionl, then the default style for the widget will be + used. + + The second purpose for tags is event bindings. You can associate + bindings with a tag in much the same way you can associate bindings + with a widget class: whenever particular X events occur on + characters with the given tag, a given Tcl command will be + executed. Tag bindings can be used to give behaviors to ranges of + characters; among other things, this allows hypertext-like features + to be implemented. For details, see the description of the tag + bind widget command below. + + The third use for tags is in managing the selection. See THE + SELECTION below. + +Marks +----- + +The second form of annotation in text widgets is a mark. Marks are used +for remembering particular places in a text. They are something like +tags, in that they have names and they refer to places in the file, but +a mark isn't associated with particular characters. Instead, a mark is +associated with the gap between two characters. Only a single position +may be associated with a mark at any given time. If the characters +around a mark are deleted the mark will still remain; it will just have +new neighbor characters. In contrast, if the characters containing a +tag are deleted then the tag will no longer have an association with +characters in the file. Marks may be manipulated with the "pathName +:mark" widget command, and their current locations may be determined by +using the mark name as an index in widget commands. + + The name space for marks is different from that for tags: the same +name may be used for both a mark and a tag, but they will refer to +different things. + + Two marks have special significance. First, the mark insert is +associated with the insertion cursor, as described under THE INSERTION +CURSOR below. Second, the mark current is associated with the character +closest to the mouse and is adjusted automatically to track the mouse +position and any changes to the text in the widget (one exception: +current is not updated in response to mouse motions if a mouse button is +down; the update will be deferred until all mouse buttons have been +released). Neither of these special marks may be unset. + +Windows +------- + +The third form of annotation in text widgets is a window. Window +support isn't implemented yet, but when it is it will be described here. + +The Selection +------------- + +Text widgets support the standard X selection. Selection support is +implemented via tags. If the exportSelection option for the text widget +is true then the sel tag will be associated with the selection: + [1] Whenever characters are tagged with sel the text widget will + claim ownership of the selection. + [2] Attempts to retrieve the selection will be serviced by the text + widget, returning all the charaters with the sel tag. + [3] If the selection is claimed away by another application or by + another window within this application, then the sel tag will be + removed from all characters in the text. + + The sel tag is automatically defined when a text widget is created, +and it may not be deleted with the "pathName :tag delete" widget +command. Furthermore, the selectBackground, selectBorderWidth, and +selectForeground options for the text widget are tied to the +:background, :borderwidth, and :foreground options for the sel tag: +changes in either will automatically be reflected in the other. + +The Insertion Cursor +-------------------- + +The mark named insert has special significance in text widgets. It is +defined automatically when a text widget is created and it may not be +unset with the "pathName :mark unset" widget command. The insert mark +represents the position of the insertion cursor, and the insertion +cursor will automatically be drawn at this point whenever the text +widget has the input focus. + +A Text Widget's Arguments +------------------------- + +The text command creates a new Tcl command whose name is the same as the +path name of the text's window. This command may be used to invoke +various operations on the widget. It has the following general form: + + pathName option ?arg arg ...? + + PathName is the name of the command, which is the same as the text +widget's path name. Option and the args determine the exact behavior of +the command. The following commands are possible for text widgets: + +pathName :compare index1 op index2 + Compares the indices given by index1 and index2 according to the + relational operator given by op, and returns 1 if the relationship + is satisfied and 0 if it isn't. Op must be one of the operators <, + <=, ==, >=, >, or !=. If op is == then 1 is returned if the two + indices refer to the same character, if op is < then 1 is returned + if index1 refers to an earlier character in the text than index2, + and so on. +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the text command. +pathName :debug ?boolean? + If boolean is specified, then it must have one of the true or false + values accepted by Tcl_GetBoolean. If the value is a true one then + internal consistency checks will be turned on in the B-tree code + associated with text widgets. If boolean has a false value then + the debugging checks will be turned off. In either case the + command returns an empty string. If boolean is not specified then + the command returns on or off to indicate whether or not debugging + is turned on. There is a single debugging switch shared by all + text widgets: turning debugging on or off in any widget turns it on + or off for all widgets. For widgets with large amounts of text, + the consistency checks may cause a noticeable slow-down. +pathName :delete index1 ?index2? + Delete a range of characters from the text. If both index1 and + index2 are specified, then delete all the characters starting with + the one given by index1 and stopping just before index2 (i.e. the + character at index2 is not deleted). If index2 doesn't specify a + position later in the text than index1 then no characters are + deleted. If index2 isn't specified then the single character at + index1 is deleted. It is not allowable to delete characters in a + way that would leave the text without a newline as the last + character. The command returns an empty string. +pathName :get index1 ?index2? + Return a range of characters from the text. The return value will + be all the characters in the text starting with the one whose index + is index1 and ending just before the one whose index is index2 (the + character at index2 will not be returned). If index2 is omitted + then the single character at index1 is returned. If there are no + characters in the specified range (e.g. index1 is past the end of + the file or index2 is less than or equal to index1) then an empty + string is returned. +pathName :index index + Returns the position corresponding to index in the form line.char + where line is the line number and char is the character number. + Index may have any of the forms described under INDICES above. +pathName :insert \fIindex chars + Inserts chars into the text just before the character at index and + returns an empty string. It is not possible to insert characters + after the last newline of the text. +pathName :mark option ?arg arg ...? + This command is used to manipulate marks. The exact behavior of + the command depends on the option argument that follows the mark + argument. The following forms of the command are currently + supported: + pathName :mark :names + Returns a list whose elements are the names of all the marks + that are currently set. + pathName :mark :set markName index + Sets the mark named markName to a position just before the + character at index. If markName already exists, it is moved + from its old position; if it doesn't exist, a new mark is + created. This command returns an empty string. + pathName :mark :unset markName ?markName markName ...? + Remove the mark corresponding to each of the markName + arguments. The removed marks will not be usable in indices + and will not be returned by future calls to "pathName :mark + names". This command returns an empty string. + +pathName :scan option args + This command is used to implement scanning on texts. It has two + forms, depending on option: + pathName :scan :mark y + Records y and the current view in the text window; used in + conjunction with later scan dragto commands. Typically this + command is associated with a mouse button press in the widget. + It returns an empty string. + pathName :scan :dragto y + This command computes the difference between its y argument + and the y argument to the last scan mark command for the + widget. It then adjusts the view up or down by 10 times the + difference in y-coordinates. This command is typically + associated with mouse motion events in the widget, to produce + the effect of dragging the text at high speed through the + window. The return value is an empty string. + +pathName :tag option ?arg arg ...? + This command is used to manipulate tags. The exact behavior of the + command depends on the option argument that follows the tag + argument. The following forms of the command are currently + supported: + + pathName :tag :add tagName index1 ?index2? + Associate the tag tagName with all of the characters starting + with index1 and ending just before index2 (the character at + index2 isn't tagged). If index2 is omitted then the single + character at index1 is tagged. If there are no characters in + the specified range (e.g. index1 is past the end of the file + or index2 is less than or equal to index1) then the command + has no effect. This command returns an empty string. + pathName :tag :bind tagName ?sequence? ?command? + This command associates command with the tag given by tagName. + Whenever the event sequence given by sequence occurs for a + character that has been tagged with tagName, the command will + be invoked. This widget command is similar to the bind + command except that it operates on characters in a text rather + than entire widgets. See the bind manual entry for complete + details on the syntax of sequence and the substitutions + performed on command before invoking it. If all arguments are + specified then a new binding is created, replacing any + existing binding for the same sequence and tagName (if the + first character of command is "+" then command augments an + existing binding rather than replacing it). In this case the + return value is an empty string. If command is omitted then + the command returns the command associated with tagName and + sequence (an error occurs if there is no such binding). If + both command and sequence are omitted then the command returns + a list of all the sequences for which bindings have been + defined for tagName. + + The only events for which bindings may be specified are those + related to the mouse and keyboard, such as Enter, Leave, + ButtonPress, Motion, and KeyPress. Event bindings for a text + widget use the current mark described under MARKS above. + Enter events trigger for a character when it becomes the + current character (i.e. the current mark moves to just in + front of that character). Leave events trigger for a + character when it ceases to be the current item (i.e. the + current mark moves away from that character, or the character + is deleted). These events are different than Enter and Leave + events for windows. Mouse and keyboard events are directed to + the current character. + + It is possible for the current character to have multiple + tags, and for each of them to have a binding for a particular + event sequence. When this occurs, the binding from the + highest priority tag is used. If a particular tag doesn't + have a binding that matches an event, then the tag is ignored + and tags with lower priority will be checked. + + If bindings are created for the widget as a whole using the + bind command, then those bindings will supplement the tag + bindings. This means that a single event can trigger two Tcl + scripts, one for a widget-level binding and one for a + tag-level binding. + + pathName :tag :configure tagName ?option? ?value? ?option value ...? + This command is similar to the configure widget command except + that it modifies options associated with the tag given by + tagName instead of modifying options for the overall text + widget. If no option is specified, the command returns a list + describing all of the available options for tagName (see + Tk_ConfigureInfo for information on the format of this list). + If option is specified with no value, then the command returns + a list describing the one named option (this list will be + identical to the corresponding sublist of the value returned + if no option is specified). If one or more option:value pairs + are specified, then the command modifies the given option(s) + to have the given value(s) in tagName; in this case the + command returns an empty string. See TAGS above for details + on the options available for tags. + pathName :tag :delete tagName ?tagName ...? + Deletes all tag information for each of the tagName arguments. + The command removes the tags from all characters in the file + and also deletes any other information associated with the + tags, such as bindings and display information. The command + returns an empty string. + pathName :tag :lower tagName ?belowThis? + Changes the priority of tag tagName so that it is just lower + in priority than the tag whose name is belowThis. If + belowThis is omitted, then tagName's priority is changed to + make it lowest priority of all tags. + pathName :tag :names ?index? + Returns a list whose elements are the names of all the tags + that are active at the character position given by index. If + index is omitted, then the return value will describe all of + the tags that exist for the text (this includes all tags that + have been named in a "pathName :tag" widget command but + haven't been deleted by a "pathName :tag :delete" widget + command, even if no characters are currently marked with the + tag). The list will be sorted in order from lowest priority + to highest priority. + pathName :tag :nextrange tagName index1 ?index2? + This command searches the text for a range of characters + tagged with tagName where the first character of the range is + no earlier than the character at index1 and no later than the + character just before index2 (a range starting at index2 will + not be considered). If several matching ranges exist, the + first one is chosen. The command's return value is a list + containing two elements, which are the index of the first + character of the range and the index of the character just + after the last one in the range. If no matching range is + found then the return value is an empty string. If index2 is + not given then it defaults to the end of the text. + pathName :tag :raise tagName ?aboveThis? + Changes the priority of tag tagName so that it is just higher + in priority than the tag whose name is aboveThis. If + aboveThis is omitted, then tagName's priority is changed to + make it highest priority of all tags. + pathName :tag :ranges tagName + Returns a list describing all of the ranges of text that have + been tagged with tagName. The first two elements of the list + describe the first tagged range in the text, the next two + elements describe the second range, and so on. The first + element of each pair contains the index of the first character + of the range, and the second element of the pair contains the + index of the character just after the last one in the range. + If there are no characters tagged with tag then an empty + string is returned. + pathName :tag :remove tagName index1 ?index2? + Remove the tag tagName from all of the characters starting at + index1 and ending just before index2 (the character at index2 + isn't affected). If index2 is omitted then the single + character at index1 is untagged. If there are no characters + in the specified range (e.g. index1 is past the end of the + file or index2 is less than or equal to index1) then the + command has no effect. This command returns an empty string. + +pathName :yview ?:pickplace? what + This command changes the view in the widget's window so that the + line given by what is visible in the window. What may be either an + absolute line number, where 0 corresponds to the first line of the + file, or an index with any of the forms described under INDICES + above. The first form (absolute line number) is used in the + commands issued by scrollbars to control the widget's view. If the + :pickplace option isn't specified then what will appear at the top + of the window. If :pickplace is specified then the widget chooses + where what appears in the window: + [1] If what is already visible somewhere in the window then + the command does nothing. + [2] If what is only a few lines off-screen above the window + then it will be positioned at the top of the window. + [3] If what is only a few lines off-screen below the window + then it will be positioned at the bottom of the window. + [4] Otherwise, what will be centered in the window. + + The :pickplace option is typically used after inserting text to + make sure that the insertion cursor is still visible on the screen. + This command returns an empty string. + +Bindings +-------- + +Tk automatically creates class bindings for texts that give them the +following default behavior: + [1] Pressing mouse button 1 in an text positions the insertion + cursor just before the character underneath the mouse cursor and + sets the input focus to this widget. + [2] Dragging with mouse button 1 strokes out a selection between + the insertion cursor and the character under the mouse. + [3] If you double-press mouse button 1 then the word under the + mouse cursor will be selected, the insertion cursor will be + positioned at the beginning of the word, and dragging the mouse + will stroke out a selection whole words at a time. + [4] If you triple-press mouse button 1 then the line under the + mouse cursor will be selected, the insertion cursor will be + positioned at the beginning of the line, and dragging the mouse + will stroke out a selection whole line at a time. + [5] The ends of the selection can be adjusted by dragging with + mouse button 1 while the shift key is down; this will adjust the + end of the selection that was nearest to the mouse cursor when + button 1 was pressed. If the selection was made in word or line + mode then it will be adjusted in this same mode. + [6] The view in the text can be adjusted by dragging with mouse + button 2. + [7] If the input focus is in a text widget and characters are typed + on the keyboard, the characters are inserted just before the + insertion cursor. + [8] Control+h and the Backspace and Delete keys erase the character + just before the insertion cursor. + [9] Control+v inserts the current selection just before the + insertion cursor. + [10] Control+d deletes the selected characters; an error occurs if + the selection is not in this widget. + + If the text is disabled using the state option, then the text's view +can still be adjusted and text in the text can still be selected, but no +insertion cursor will be displayed and no text modifications will take +place. + + The behavior of texts can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +"Performance Issues" +-------------------- + +Text widgets should run efficiently under a variety of conditions. The +text widget uses about 2-3 bytes of main memory for each byte of text, +so texts containing a megabyte or more should be practical on most +workstations. Text is represented internally with a modified B-tree +structure that makes operations relatively efficient even with large +texts. Tags are included in the B-tree structure in a way that allows +tags to span large ranges or have many disjoint smaller ranges without +loss of efficiency. Marks are also implemented in a way that allows +large numbers of marks. The only known mode of operation where a text +widget may not run efficiently is if it has a very large number of +different tags. Hundreds of tags should be fine, or even a thousand, +but tens of thousands of tags will make texts consume a lot of memory +and run slowly. + +Keywords +-------- + +text, widget + + +File: gcl-tk.info, Node: entry, Next: message, Prev: text, Up: Widgets + +2.10 entry +========== + +entry \- Create and manipulate entry widgets + +Synopsis +-------- + +entry pathName ?options? + +Standard Options +---------------- + + background foreground insertWidth selectForeground + borderWidth insertBackground relief textVariable + cursor insertBorderWidth scrollCommand + exportSelection insertOffTime selectBackground + font insertOnTime selectBorderWidth + + *Note options::, for more information. + +Arguments for Entry +------------------- + +':state' + Name='"state" Class="State"' + + Specifies one of two states for the entry: normal or disabled. If + the entry is disabled then the value may not be changed using + widget commands and no insertion cursor will be displayed, even if + the input focus is in the widget. + +':width' + Name='"width" Class="Width"' + + Specifies an integer value indicating the desired width of the + entry window, in average-size characters of the widget's font. + +Description +----------- + +The entry command creates a new window (given by the pathName argument) +and makes it into an entry widget. Additional options, described above, +may be specified on the command line or in the option database to +configure aspects of the entry such as its colors, font, and relief. +The entry command returns its pathName argument. At the time this +command is invoked, there must not exist a window named pathName, but +pathName's parent must exist. + + An entry is a widget that displays a one-line text string and allows +that string to be edited using widget commands described below, which +are typically bound to keystrokes and mouse actions. When first +created, an entry's string is empty. A portion of the entry may be +selected as described below. If an entry is exporting its selection +(see the exportSelection option), then it will observe the standard X11 +protocols for handling the selection; entry selections are available as +type STRING. Entries also observe the standard Tk rules for dealing with +the input focus. When an entry has the input focus it displays an +insertion cursor to indicate where new characters will be inserted. + + Entries are capable of displaying strings that are too long to fit +entirely within the widget's window. In this case, only a portion of +the string will be displayed; commands described below may be used to +change the view in the window. Entries use the standard scrollCommand +mechanism for interacting with scrollbars (see the description of the +scrollCommand option for details). They also support scanning, as +described below. + +A Entry Widget's Arguments +-------------------------- + +The entry command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. + + Many of the widget commands for entries take one or more indices as +arguments. An index specifies a particular character in the entry's +string, in any of the following ways: + +number + Specifies the character as a numerical index, where 0 corresponds + to the first character in the string. +end + Indicates the character just after the last one in the entry's + string. This is equivalent to specifying a numerical index equal + to the length of the entry's string. +insert + Indicates the character adjacent to and immediately following the + insertion cursor. +sel.first + Indicates the first character in the selection. It is an error to + use this form if the selection isn't in the entry window. +sel.last + Indicates the last character in the selection. It is an error to + use this form if the selection isn't in the entry window. +@number + In this form, number is treated as an x-coordinate in the entry's + window; the character spanning that x-coordinate is used. For + example, "@0" indicates the left-most character in the window. + + Abbreviations may be used for any of the forms above, e.g. "e" or +"sel.f". In general, out-of-range indices are automatically rounded to +the nearest legal value. + + The following commands are possible for entry widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the entry command. +pathName :delete first ?last? + Delete one or more elements of the entry. First and last are + indices of of the first and last characters in the range to be + deleted. If last isn't specified it defaults to first, i.e. a + single character is deleted. This command returns an empty string. +pathName :get + Returns the entry's string. +pathName :icursor index + Arrange for the insertion cursor to be displayed just before the + character given by index. Returns an empty string. +pathName :index index + Returns the numerical index corresponding to index. +pathName :insert index string + Insert the characters of string just before the character indicated + by index. Returns an empty string. +pathName :scan option args + This command is used to implement scanning on entries. It has two + forms, depending on option: + pathName :scan :mark x + Records x and the current view in the entry window; used in + conjunction with later scan dragto commands. Typically this + command is associated with a mouse button press in the widget. + It returns an empty string. + pathName :scan :dragto x + This command computes the difference between its x argument + and the x argument to the last scan mark command for the + widget. It then adjusts the view left or right by 10 times + the difference in x-coordinates. This command is typically + associated with mouse motion events in the widget, to produce + the effect of dragging the entry at high speed through the + window. The return value is an empty string. +pathName :select option arg + This command is used to adjust the selection within an entry. It + has several forms, depending on option: + pathName :select :adjust index + Locate the end of the selection nearest to the character given + by index, and adjust that end of the selection to be at index + (i.e including but not going beyond index). The other end of + the selection is made the anchor point for future select to + commands. If the selection isn't currently in the entry, then + a new selection is created to include the characters between + index and the most recent selection anchor point, inclusive. + Returns an empty string. + pathName :select :clear + Clear the selection if it is currently in this widget. If the + selection isn't in this widget then the command has no effect. + Returns an empty string. + pathName :select :from index + Set the selection anchor point to just before the character + given by index. Doesn't change the selection. Returns an + empty string. + pathName :select :to index + Set the selection to consist of the elements from the anchor + point to element index, inclusive. The anchor point is + determined by the most recent select from or select adjust + command in this widget. If the selection isn't in this widget + then a new selection is created using the most recent anchor + point specified for the widget. Returns an empty string. +pathName :view index + Adjust the view in the entry so that element index is at the left + edge of the window. Returns an empty string. + +"Default Bindings" +------------------ + +Tk automatically creates class bindings for entries that give them the +following default behavior: + + [1] Clicking mouse button 1 in an entry positions the insertion + cursor just before the character underneath the mouse cursor and + sets the input focus to this widget. + [2] Dragging with mouse button 1 strokes out a selection between + the insertion cursor and the character under the mouse. + [3] The ends of the selection can be adjusted by dragging with + mouse button 1 while the shift key is down; this will adjust the + end of the selection that was nearest to the mouse cursor when + button 1 was pressed. + [4] The view in the entry can be adjusted by dragging with mouse + button 2. + [5] If the input focus is in an entry widget and characters are + typed on the keyboard, the characters are inserted just before the + insertion cursor. + [6] Control-h and the Backspace and Delete keys erase the character + just before the insertion cursor. + [7] Control-w erases the word just before the insertion cursor. + [8] Control-u clears the entry to an empty string. + [9] Control-v inserts the current selection just before the + insertion cursor. + [10] Control-d deletes the selected characters; an error occurs if + the selection is not in this widget. + + If the entry is disabled using the state option, then the entry's +view can still be adjusted and text in the entry can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. + + The behavior of entries can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +Keywords +-------- + +entry, widget + + +File: gcl-tk.info, Node: message, Next: frame, Prev: entry, Up: Widgets + +2.11 message +============ + +message \- Create and manipulate message widgets + +Synopsis +-------- + +message pathName ?options? + +Standard Options +---------------- + + anchor cursor padX text + background font padY textVariable + borderWidth foreground relief width + + *Note options::, for more information. + +Arguments for Message +--------------------- + +':aspect' + Name='"aspect" Class="Aspect"' + + Specifies a non-negative integer value indicating desired aspect + ratio for the text. The aspect ratio is specified as + 100*width/height. 100 means the text should be as wide as it is + tall, 200 means the text should be twice as wide as it is tall, 50 + means the text should be twice as tall as it is wide, and so on. + Used to choose line length for text if width option isn't + specified. Defaults to 150. + +':justify' + Name='"justify" Class="Justify"' + + Specifies how to justify lines of text. Must be one of left, + center, or right. Defaults to left. This option works together + with the anchor, aspect, padX, padY, and width options to provide a + variety of arrangements of the text within the window. The aspect + and width options determine the amount of screen space needed to + display the text. The anchor, padX, and padY options determine + where this rectangular area is displayed within the widget's + window, and the justify option determines how each line is + displayed within that rectangular region. For example, suppose + anchor is e and justify is left, and that the message window is + much larger than needed for the text. The the text will displayed + so that the left edges of all the lines line up and the right edge + of the longest line is padX from the right side of the window; the + entire text block will be centered in the vertical span of the + window. + +':width' + Name='"width" Class="Width"' + + Specifies the length of lines in the window. The value may have + any of the forms acceptable to Tk_GetPixels. If this option has a + value greater than zero then the aspect option is ignored and the + width option determines the line length. If this option has a + value less than or equal to zero, then the aspect option determines + the line length. + +Description +----------- + +The message command creates a new window (given by the pathName +argument) and makes it into a message widget. Additional options, +described above, may be specified on the command line or in the option +database to configure aspects of the message such as its colors, font, +text, and initial relief. The message command returns its pathName +argument. At the time this command is invoked, there must not exist a +window named pathName, but pathName's parent must exist. + + A message is a widget that displays a textual string. A message +widget has three special features. First, it breaks up its string into +lines in order to produce a given aspect ratio for the window. The line +breaks are chosen at word boundaries wherever possible (if not even a +single word would fit on a line, then the word will be split across +lines). Newline characters in the string will force line breaks; they +can be used, for example, to leave blank lines in the display. + + The second feature of a message widget is justification. The text +may be displayed left-justified (each line starts at the left side of +the window), centered on a line-by-line basis, or right-justified (each +line ends at the right side of the window). + + The third feature of a message widget is that it handles control +characters and non-printing characters specially. Tab characters are +replaced with enough blank space to line up on the next 8-character +boundary. Newlines cause line breaks. Other control characters (ASCII +code less than 0x20) and characters not defined in the font are +displayed as a four-character sequence \fB\exhh where hh is the +two-digit hexadecimal number corresponding to the character. In the +unusual case where the font doesn't contain all of the characters in +"0123456789abcdef\ex" then control characters and undefined characters +are not displayed at all. + +A Message Widget's Arguments +---------------------------- + +The message command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for message widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the message command. + +"Default Bindings" +------------------ + +When a new message is created, it has no default event bindings: +messages are intended for output purposes only. + +Bugs +---- + +Tabs don't work very well with text that is centered or right-justified. +The most common result is that the line is justified wrong. + +Keywords +-------- + +message, widget + + +File: gcl-tk.info, Node: frame, Next: label, Prev: message, Up: Widgets + +2.12 frame +========== + +frame \- Create and manipulate frame widgets + +Synopsis +-------- + +frame pathName ?:class className? ?options? + +Standard Options +---------------- + + background cursor relief + borderWidth geometry + + *Note options::, for more information. + +Arguments for Frame +------------------- + +':height' + Name='"height" Class="Height"' + + Specifies the desired height for the window in any of the forms + acceptable to Tk_GetPixels. This option is only used if the + :geometry option is unspecified. If this option is less than or + equal to zero (and :geometry is not specified) then the window will + not request any size at all. + +':width' + Name='"width" Class="Width"' + + Specifies the desired width for the window in any of the forms + acceptable to Tk_GetPixels. This option is only used if the + :geometry option is unspecified. If this option is less than or + equal to zero (and :geometry is not specified) then the window will + not request any size at all. + +Description +----------- + +The frame command creates a new window (given by the pathName argument) +and makes it into a frame widget. Additional options, described above, +may be specified on the command line or in the option database to +configure aspects of the frame such as its background color and relief. +The frame command returns the path name of the new window. + + A frame is a simple widget. Its primary purpose is to act as a +spacer or container for complex window layouts. The only features of a +frame are its background color and an optional 3-D border to make the +frame appear raised or sunken. + + In addition to the standard options listed above, a :class option may +be specified on the command line. If it is specified, then the new +widget's class will be set to className instead of Frame. Changing the +class of a frame widget may be useful in order to use a special class +name in database options referring to this widget and its children. +Note: :class is handled differently than other command-line options and +cannot be specified using the option database (it has to be processed +before the other options are even looked up, since the new class name +will affect the lookup of the other options). In addition, the :class +option may not be queried or changed using the config command described +below. + +A Frame Widget's Arguments +-------------------------- + +The frame command creates a new Tcl command whose name is the same as +the path name of the frame's window. This command may be used to invoke +various operations on the widget. It has the following general form: + + pathName option ?arg arg ...? + + PathName is the name of the command, which is the same as the frame +widget's path name. Option and the args determine the exact behavior of +the command. The following commands are possible for frame widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the frame command. + +Bindings +-------- + +When a new frame is created, it has no default event bindings: frames +are not intended to be interactive. + +Keywords +-------- + +frame, widget + + +File: gcl-tk.info, Node: label, Next: radiobutton, Prev: frame, Up: Widgets + +2.13 label +========== + +label \- Create and manipulate label widgets + +Synopsis +-------- + +label pathName ?options? + +Standard Options +---------------- + + anchor borderWidth foreground relief + background cursor padX text + bitmap font padY textVariable + + *Note options::, for more information. + +Arguments for Label +------------------- + +':height' + Name='"height" Class="Height"' + + Specifies a desired height for the label. If a bitmap is being + displayed in the label then the value is in screen units (i.e. any + of the forms acceptable to Tk_GetPixels); for text it is in lines + of text. If this option isn't specified, the label's desired + height is computed from the size of the bitmap or text being + displayed in it. + +':width' + Name='"width" Class="Width"' + + Specifies a desired width for the label. If a bitmap is being + displayed in the label then the value is in screen units (i.e. any + of the forms acceptable to Tk_GetPixels); for text it is in + characters. If this option isn't specified, the label's desired + width is computed from the size of the bitmap or text being + displayed in it. + +Description +----------- + +The label command creates a new window (given by the pathName argument) +and makes it into a label widget. Additional options, described above, +may be specified on the command line or in the option database to +configure aspects of the label such as its colors, font, text, and +initial relief. The label command returns its pathName argument. At +the time this command is invoked, there must not exist a window named +pathName, but pathName's parent must exist. + + A label is a widget that displays a textual string or bitmap. The +label can be manipulated in a few simple ways, such as changing its +relief or text, using the commands described below. + +A Label Widget's Arguments +-------------------------- + +The label command creates a new Tcl command whose name is pathName. +This command may be used to invoke various operations on the widget. It +has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for label widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the label command. + +Bindings +-------- + +When a new label is created, it has no default event bindings: labels +are not intended to be interactive. + +Keywords +-------- + +label, widget + + +File: gcl-tk.info, Node: radiobutton, Next: toplevel, Prev: label, Up: Widgets + +2.14 radiobutton +================ + +radiobutton \- Create and manipulate radio-button widgets + +Synopsis +-------- + +radiobutton pathName ?options? + +Standard Options +---------------- + + activeBackground bitmap font relief + activeForeground borderWidth foreground text + anchor cursor padX textVariable + background disabledForeground padX + + *Note options::, for more information. + +Arguments for Radiobutton +------------------------- + +':command' + Name='"command" Class="Command"' + + Specifies a Tcl command to associate with the button. This command + is typically invoked when mouse button 1 is released over the + button window. The button's global variable (:variable option) + will be updated before the command is invoked. + +':height' + Name='"height" Class="Height"' + + Specifies a desired height for the button. If a bitmap is being + displayed in the button then the value is in screen units (i.e. + any of the forms acceptable to Tk_GetPixels); for text it is in + lines of text. If this option isn't specified, the button's + desired height is computed from the size of the bitmap or text + being displayed in it. + +':selector' + Name='"selector" Class="Foreground"' + + Specifies the color to draw in the selector when this button is + selected. If specified as an empty string then no selector is + drawn for the button. + +':state' + Name='"state" Class="State"' + + Specifies one of three states for the radio button: normal, active, + or disabled. In normal state the radio button is displayed using + the foreground and background options. The active state is + typically used when the pointer is over the radio button. In + active state the radio button is displayed using the + activeForeground and activeBackground options. Disabled state + means that the radio button is insensitive: it doesn't activate and + doesn't respond to mouse button presses. In this state the + disabledForeground and background options determine how the radio + button is displayed. + +':value' + Name='"value" Class="Value"' + + Specifies value to store in the button's associated variable + whenever this button is selected. Defaults to the name of the + radio button. + +':variable' + Name='"variable" Class="Variable"' + + Specifies name of global variable to set whenever this button is + selected. Changes in this variable also cause the button to select + or deselect itself. Defaults to the value selectedButton. + +':width' + Name='"width" Class="Width"' + + Specifies a desired width for the button. If a bitmap is being + displayed in the button then the value is in screen units (i.e. + any of the forms acceptable to Tk_GetPixels); for text it is in + characters. If this option isn't specified, the button's desired + width is computed from the size of the bitmap or text being + displayed in it. + +Description +----------- + +The radiobutton command creates a new window (given by the pathName +argument) and makes it into a radiobutton widget. Additional options, +described above, may be specified on the command line or in the option +database to configure aspects of the radio button such as its colors, +font, text, and initial relief. The radiobutton command returns its +pathName argument. At the time this command is invoked, there must not +exist a window named pathName, but pathName's parent must exist. + + A radio button is a widget that displays a textual string or bitmap +and a diamond called a selector. A radio button has all of the behavior +of a simple button: it can display itself in either of three different +ways, according to the state option; it can be made to appear raised, +sunken, or flat; it can be made to flash; and it invokes a Tcl command +whenever mouse button 1 is clicked over the check button. + + In addition, radio buttons can be selected. If a radio button is +selected then a special highlight appears in the selector and a Tcl +variable associated with the radio button is set to a particular value. +If the radio button is not selected then the selector is drawn in a +different fashion. Typically, several radio buttons share a single +variable and the value of the variable indicates which radio button is +to be selected. When a radio button is selected it sets the value of +the variable to indicate that fact; each radio button also monitors the +value of the variable and automatically selects and deselects itself +when the variable's value changes. By default the variable +selectedButton is used; its contents give the name of the button that is +selected, or the empty string if no button associated with that variable +is selected. The name of the variable for a radio button, plus the +variable to be stored into it, may be modified with options on the +command line or in the option database. By default a radio button is +configured to select itself on button clicks. + +A Radiobutton Widget's Arguments +-------------------------------- + +The radiobutton command creates a new Tcl command whose name is +pathName. This command may be used to invoke various operations on the +widget. It has the following general form: + + pathName option ?arg arg ...? + + Option and the args determine the exact behavior of the command. The +following commands are possible for radio-button widgets: + +pathName :activate + Change the radio button's state to active and redisplay the button + using its active foreground and background colors instead of normal + colors. This command is ignored if the radio button's state is + disabled. This command is obsolete and will eventually be removed; + use "pathName :configure :state active" instead. +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the radiobutton command. +pathName :deactivate + Change the radio button's state to normal and redisplay the button + using its normal foreground and background colors. This command is + ignored if the radio button's state is disabled. This command is + obsolete and will eventually be removed; use "pathName :configure + :state normal" instead. +pathName :deselect + Deselect the radio button: redisplay it without a highlight in the + selector and set the associated variable to an empty string. If + this radio button was not currently selected, then the command has + no effect. +pathName :flash + Flash the radio button. This is accomplished by redisplaying the + radio button several times, alternating between active and normal + colors. At the end of the flash the radio button is left in the + same normal/active state as when the command was invoked. This + command is ignored if the radio button's state is disabled. +pathName :invoke + Does just what would have happened if the user invoked the radio + button with the mouse: select the button and invoke its associated + Tcl command, if there is one. The return value is the return value + from the Tcl command, or an empty string if there is no command + associated with the radio button. This command is ignored if the + radio button's state is disabled. +pathName :select + Select the radio button: display it with a highlighted selector and + set the associated variable to the value corresponding to this + widget. + +Bindings +-------- + +Tk automatically creates class bindings for radio buttons that give them +the following default behavior: + [1] The radio button activates whenever the mouse passes over it + and deactivates whenever the mouse leaves the radio button. + [2] The radio button's relief is changed to sunken whenever mouse + button 1 is pressed over it, and the relief is restored to its + original value when button 1 is later released. + [3] If mouse button 1 is pressed over the radio button and later + released over the radio button, the radio button is invoked (i.e. + it is selected and the command associated with the button is + invoked, if there is one). However, if the mouse is not over the + radio button when button 1 is released, then no invocation occurs. + + The behavior of radio buttons can be changed by defining new bindings +for individual widgets or by redefining the class bindings. + +Keywords +-------- + +radio button, widget + + +File: gcl-tk.info, Node: toplevel, Prev: radiobutton, Up: Widgets + +2.15 toplevel +============= + +toplevel \- Create and manipulate toplevel widgets + +Synopsis +-------- + +toplevel pathName ?:screen screenName? ?:class className? ?options? + +Standard Options +---------------- + + background geometry + borderWidth relief + + *Note options::, for more information. + +Arguments for Toplevel +---------------------- + +Description +----------- + +The toplevel command creates a new toplevel widget (given by the +pathName argument). Additional options, described above, may be +specified on the command line or in the option database to configure +aspects of the toplevel such as its background color and relief. The +toplevel command returns the path name of the new window. + + A toplevel is similar to a frame except that it is created as a +top-level window: its X parent is the root window of a screen rather +than the logical parent from its path name. The primary purpose of a +toplevel is to serve as a container for dialog boxes and other +collections of widgets. The only features of a toplevel are its +background color and an optional 3-D border to make the toplevel appear +raised or sunken. + + Two special command-line options may be provided to the toplevel +command: :class and :screen. If :class is specified, then the new +widget's class will be set to className instead of Toplevel. Changing +the class of a toplevel widget may be useful in order to use a special +class name in database options referring to this widget and its +children. The :screen option may be used to place the window on a +different screen than the window's logical parent. Any valid screen +name may be used, even one associated with a different display. + + Note: :class and :screen are handled differently than other +command-line options. They may not be specified using the option +database (these options must have been processed before the new window +has been created enough to use the option database; in particular, the +new class name will affect the lookup of options in the database). In +addition, :class and :screen may not be queried or changed using the +config command described below. However, the winfo :class command may +be used to query the class of a window, and winfo :screen may be used to +query its screen. + +A Toplevel Widget's Arguments +----------------------------- + +The toplevel command creates a new Tcl command whose name is the same as +the path name of the toplevel's window. This command may be used to +invoke various operations on the widget. It has the following general +form: + + pathName option ?arg arg ...? + + PathName is the name of the command, which is the same as the +toplevel widget's path name. Option and the args determine the exact +behavior of the command. The following commands are possible for +toplevel widgets: + +pathName :configure ?option? ?value option value ...? + Query or modify the configuration options of the widget. If no + option is specified, returns a list describing all of the available + options for pathName (see Tk_ConfigureInfo for information on the + format of this list). If option is specified with no value, then + the command returns a list describing the one named option (this + list will be identical to the corresponding sublist of the value + returned if no option is specified). If one or more option:value + pairs are specified, then the command modifies the given widget + option(s) to have the given value(s); in this case the command + returns an empty string. Option may have any of the values + accepted by the toplevel command. + +Bindings +-------- + +When a new toplevel is created, it has no default event bindings: +toplevels are not intended to be interactive. + +Keywords +-------- + +toplevel, widget + + +File: gcl-tk.info, Node: Control, Prev: Widgets, Up: Top + +3 Control +********* + +* Menu: + +* after:: +* bind:: +* destroy:: +* tk-dialog:: +* exit:: +* focus:: +* grab:: +* tk-listbox-single-select:: +* lower:: +* tk-menu-bar:: +* option:: +* options:: +* pack-old:: +* pack:: +* place:: +* raise:: +* selection:: +* send:: +* tk:: +* tkerror:: +* tkvars:: +* tkwait:: +* update:: +* winfo:: +* wm:: + + +File: gcl-tk.info, Node: after, Next: bind, Prev: Control, Up: Control + +3.1 after +========= + +after - Execute a command after a time delay + +Synopsis +-------- + +after ms ?arg1 arg2 arg3 ...? + +Description +----------- + +This command is used to delay execution of the program or to execute a +command in background after a delay. The ms argument gives a time in +milliseconds. If ms is the only argument to after then the command +sleeps for ms milliseconds and returns. While the command is sleeping +the application does not respond to X events and other events. + + If additional arguments are present after ms, then a Tcl command is +formed by concatenating all the additional arguments in the same fashion +as the concat command. After returns immediately but arranges for the +command to be executed ms milliseconds later in background. The command +will be executed at global level (outside the context of any Tcl +procedure). If an error occurs while executing the delayed command then +the tkerror mechanism is used to report the error. + + The after command always returns an empty string. + + *Note tkerror::. + +Keywords +-------- + +delay, sleep, time + + +File: gcl-tk.info, Node: bind, Next: destroy, Prev: after, Up: Control + +3.2 bind +======== + +bind \- Arrange for X events to invoke Tcl commands + +Synopsis +-------- + + +bind windowSpec + +bind windowSpec sequence + +bind windowSpec sequence command +bind windowSpec sequence +command + +Description +----------- + +If all three arguments are specified, bind will arrange for command (a +Tcl command) to be executed whenever the sequence of events given by +sequence occurs in the window(s) identified by windowSpec. If command +is prefixed with a "+", then it is appended to any existing binding for +sequence; otherwise command replaces the existing binding, if any. If +command is an empty string then the current binding for sequence is +destroyed, leaving sequence unbound. In all of the cases where a +command argument is provided, bind returns an empty string. + + If sequence is specified without a command, then the command +currently bound to sequence is returned, or an empty string if there is +no binding for sequence. If neither sequence nor command is specified, +then the return value is a list whose elements are all the sequences for +which there exist bindings for windowSpec. + + The windowSpec argument selects which window(s) the binding applies +to. It may have one of three forms. If windowSpec is the path name for +a window, then the binding applies to that particular window. If +windowSpec is the name of a class of widgets, then the binding applies +to all widgets in that class. Lastly, windowSpec may have the value +all, in which case the binding applies to all windows in the +application. + + The sequence argument specifies a sequence of one or more event +patterns, with optional white space between the patterns. Each event +pattern may take either of two forms. In the simplest case it is a +single printing ASCII character, such as a or [. The character may not +be a space character or the character <. This form of pattern matches a +KeyPress event for the particular character. The second form of pattern +is longer but more general. It has the following syntax: + + + + The entire event pattern is surrounded by angle brackets. Inside the +angle brackets are zero or more modifiers, an event type, and an extra +piece of information (detail) identifying a particular button or keysym. +Any of the fields may be omitted, as long as at least one of type and +detail is present. The fields must be separated by white space or +dashes. + + Modifiers may consist of any of the values in the following list: + + Control Any + Shift Double + Lock Triple + Button1, B1 Mod1, M1, Meta, M + Button2, B2 Mod2, M2, Alt + Button3, B3 Mod3, M3 + Button4, B4 Mod4, M4 + Button5, B5 Mod5, M5 + + Where more than one value is listed, separated by commas, the values +are equivalent. All of the modifiers except Any, Double, and Triple +have the obvious X meanings. For example, Button1 requires that button +1 be depressed when the event occurs. Under normal conditions the +button and modifier state at the time of the event must match exactly +those specified in the bind command. If no modifiers are specified, +then events will match only if no modifiers are present. If the Any +modifier is specified, then additional modifiers may be present besides +those specified explicitly. For example, if button 1 is pressed while +the shift and control keys are down, the specifier + will match the event, but the specifier + will not. + + The Double and Triple modifiers are a convenience for specifying +double mouse clicks and other repeated events. They cause a particular +event pattern to be repeated 2 or 3 times, and also place a time and +space requirement on the sequence: for a sequence of events to match a +Double or Triple pattern, all of the events must occur close together in +time and without substantial mouse motion in between. For example, + is equivalent to with the extra +time and space requirement. + + The type field may be any of the standard X event types, with a few +extra abbreviations. Below is a list of all the valid types; where two +name appear together, they are synonyms. + + ButtonPress, Button Expose Leave + ButtonRelease FocusIn Map + Circulate FocusOut Property + CirculateRequest Gravity Reparent + Colormap Keymap ResizeRequest + Configure KeyPress, Key Unmap + ConfigureRequest KeyRelease Visibility + Destroy MapRequest + Enter Motion + + The last part of a long event specification is detail. In the case +of a ButtonPress or ButtonRelease event, it is the number of a button +(1-5). If a button number is given, then only an event on that +particular button will match; if no button number is given, then an +event on any button will match. Note: giving a specific button number +is different than specifying a button modifier; in the first case, it +refers to a button being pressed or released, while in the second it +refers to some other button that is already depressed when the matching +event occurs. If a button number is given then type may be omitted: if +will default to ButtonPress. For example, the specifier <1> is +equivalent to . + + If the event type is KeyPress or KeyRelease, then detail may be +specified in the form of an X keysym. Keysyms are textual +specifications for particular keys on the keyboard; they include all the +alphanumeric ASCII characters (e.g. "a" is the keysym for the ASCII +character "a"), plus descriptions for non-alphanumeric characters +("comma" is the keysym for the comma character), plus descriptions for +all the non-ASCII keys on the keyboard ("Shift_L" is the keysm for the +left shift key, and "F1" is the keysym for the F1 function key, if it +exists). The complete list of keysyms is not presented here; it should +be available in other X documentation. If necessary, you can use the %K +notation described below to print out the keysym name for an arbitrary +key. If a keysym detail is given, then the type field may be omitted; +it will default to KeyPress. For example, is equivalent +to . If a keysym detail is specified then the +Shift modifier need not be specified and will be ignored if specified: +each keysym already implies a particular state for the shift key. + + The command argument to bind is a Tcl command string, which will be +executed whenever the given event sequence occurs. Command will be +executed in the same interpreter that the bind command was executed in. +If command contains any % characters, then the command string will not +be executed directly. Instead, a new command string will be generated +by replacing each %, and the character following it, with information +from the current event. The replacement depends on the character +following the %, as defined in the list below. Unless otherwise +indicated, the replacement string is the decimal value of the given +field from the current event. Some of the substitutions are only valid +for certain types of events; if they are used for other types of events +the value substituted is undefined. + +%% + Replaced with a single percent. +|%#| + The number of the last client request processed by the server (the + serial field from the event). Valid for all event types. +|%a| + The above field from the event. Valid only for ConfigureNotify + events. +|%b| + The number of the button that was pressed or released. Valid only + for ButtonPress and ButtonRelease events. +|%c| + The count field from the event. Valid only for Expose, + GraphicsExpose, and MappingNotify events. +|%d| + The detail field from the event. The |%d| is replaced by a string + identifying the detail. For EnterNotify, LeaveNotify, FocusIn, and + FocusOut events, the string will be one of the following: + + NotifyAncestor NotifyNonlinearVirtual + NotifyDetailNone NotifyPointer + NotifyInferior NotifyPointerRoot + NotifyNonlinear NotifyVirtual + + For ConfigureRequest events, the substituted string will be one of + the following: + + Above Opposite + Below TopIf + BottomIf + + For events other than these, the substituted string is undefined. + .RE +|%f| + The focus field from the event (0 or 1). Valid only for + EnterNotify and LeaveNotify events. +|%h| + The height field from the event. Valid only for Configure, + ConfigureNotify, Expose, GraphicsExpose, and ResizeRequest events. +|%k| + The keycode field from the event. Valid only for KeyPress and + KeyRelease events. +|%m| + The mode field from the event. The substituted string is one of + NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed. + Valid only for EnterWindow, FocusIn, FocusOut, and LeaveWindow + events. +|%o| + The override_redirect field from the event. Valid only for + CreateNotify, MapNotify, ReparentNotify, and ConfigureNotify + events. +|%p| + The place field from the event, substituted as one of the strings + PlaceOnTop or PlaceOnBottom. Valid only for CirculateNotify and + CirculateRequest events. +|%s| + The state field from the event. For ButtonPress, ButtonRelease, + EnterNotify, KeyPress, KeyRelease, LeaveNotify, and MotionNotify + events, a decimal string is substituted. For VisibilityNotify, one + of the strings VisibilityUnobscured, VisibilityPartiallyObscured, + and VisibilityFullyObscured is substituted. +|%t| + The time field from the event. Valid only for events that contain + a time field. +|%v| + The value_mask field from the event. Valid only for + ConfigureRequest events. +|%w| + The width field from the event. Valid only for Configure, + ConfigureRequest, Expose, GraphicsExpose, and ResizeRequest events. +|%x| + The x field from the event. Valid only for events containing an x + field. +|%y| + The y field from the event. Valid only for events containing a y + field. +%A + Substitutes the ASCII character corresponding to the event, or the + empty string if the event doesn't correspond to an ASCII character + (e.g. the shift key was pressed). XLookupString does all the work + of translating from the event to an ASCII character. Valid only + for KeyPress and KeyRelease events. +%B + The border_width field from the event. Valid only for + ConfigureNotify and CreateWindow events. +%D + The display field from the event. Valid for all event types. +%E + The send_event field from the event. Valid for all event types. +%K + The keysym corresponding to the event, substituted as a textual + string. Valid only for KeyPress and KeyRelease events. +%N + The keysym corresponding to the event, substituted as a decimal + number. Valid only for KeyPress and KeyRelease events. +%R + The root window identifier from the event. Valid only for events + containing a root field. +%S + The subwindow window identifier from the event. Valid only for + events containing a subwindow field. +%T + The type field from the event. Valid for all event types. +%W + The path name of the window to which the event was reported (the + window field from the event). Valid for all event types. +%X + The x_root field from the event. If a virtual-root window manager + is being used then the substituted value is the corresponding + x-coordinate in the virtual root. Valid only for ButtonPress, + ButtonRelease, KeyPress, KeyRelease, and MotionNotify events. +%Y + The y_root field from the event. If a virtual-root window manager + is being used then the substituted value is the corresponding + y-coordinate in the virtual root. Valid only for ButtonPress, + ButtonRelease, KeyPress, KeyRelease, and MotionNotify events. + + If the replacement string for a %-replacement contains characters +that are interpreted specially by the Tcl parser (such as backslashes or +square brackets or spaces) additional backslashes are added during +replacement so that the result after parsing is the original replacement +string. For example, if command is + + insert %A + + and the character typed is an open square bracket, then the command +actually executed will be + + insert \e[ + + This will cause the insert to receive the original replacement string +(open square bracket) as its first argument. If the extra backslash +hadn't been added, Tcl would not have been able to parse the command +correctly. + + At most one binding will trigger for any given X event. If several +bindings match the recent events, the most specific binding is chosen +and its command will be executed. The following tests are applied, in +order, to determine which of several matching sequences is more +specific: (a) a binding whose windowSpec names a particular window is +more specific than a binding for a class, which is more specific than a +binding whose windowSpec is all; (b) a longer sequence (in terms of +number of events matched) is more specific than a shorter sequence; (c) +an event pattern that specifies a specific button or key is more +specific than one that doesn't; (e) an event pattern that requires a +particular modifier is more specific than one that doesn't require the +modifier; (e) an event pattern specifying the Any modifier is less +specific than one that doesn't. If the matching sequences contain more +than one event, then tests (c)-(e) are applied in order from the most +recent event to the least recent event in the sequences. If these tests +fail to determine a winner, then the most recently registered sequence +is the winner. + + If an X event does not match any of the existing bindings, then the +event is ignored (an unbound event is not considered to be an error). + + When a sequence specified in a bind command contains more than one +event pattern, then its command is executed whenever the recent events +(leading up to and including the current event) match the given +sequence. This means, for example, that if button 1 is clicked +repeatedly the sequence will match each button +press but the first. If extraneous events that would prevent a match +occur in the middle of an event sequence then the extraneous events are +ignored unless they are KeyPress or ButtonPress events. For example, + will match a sequence of presses of button 1, +even though there will be ButtonRelease events (and possibly +MotionNotify events) between the ButtonPress events. Furthermore, a +KeyPress event may be preceded by any number of other KeyPress events +for modifier keys without the modifier keys preventing a match. For +example, the event sequence aB will match a press of the a key, a +release of the a key, a press of the Shift key, and a press of the b +key: the press of Shift is ignored because it is a modifier key. +Finally, if several MotionNotify events occur in a row, only the last +one is used for purposes of matching binding sequences. + + If an error occurs in executing the command for a binding then the +tkerror mechanism is used to report the error. The command will be +executed at global level (outside the context of any Tcl procedure). + + *Note tkerror::. + +Keywords +-------- + +form, manual + + +File: gcl-tk.info, Node: destroy, Next: tk-dialog, Prev: bind, Up: Control + +3.3 destroy +=========== + +destroy \- Destroy one or more windows + +Synopsis +-------- + +destroy ?window window ...? + +Description +----------- + +This command deletes the windows given by the window arguments, plus all +of their descendants. If a window "." is deleted then the entire +application will be destroyed. The windows are destroyed in order, and +if an error occurs in destroying a window the command aborts without +destroying the remaining windows. + +Keywords +-------- + +application, destroy, window + + +File: gcl-tk.info, Node: tk-dialog, Next: exit, Prev: destroy, Up: Control + +3.4 tk-dialog +============= + +tk-dialog \- Create modal dialog and wait for response + +Synopsis +-------- + +tk-dialog window title text bitmap default string string ... + +Description +----------- + +This procedure is part of the Tk script library. Its arguments describe +a dialog box: + +window + Name of top-level window to use for dialog. Any existing window by + this name is destroyed. +title + Text to appear in the window manager's title bar for the dialog. +text + Message to appear in the top portion of the dialog box. +bitmap + If non-empty, specifies a bitmap to display in the top portion of + the dialog, to the left of the text. If this is an empty string + then no bitmap is displayed in the dialog. +default + If this is an integer greater than or equal to zero, then it gives + the index of the button that is to be the default button for the + dialog (0 for the leftmost button, and so on). If less than zero + or an empty string then there won't be any default button. +string + There will be one button for each of these arguments. Each string + specifies text to display in a button, in order from left to right. + + After creating a dialog box, tk-dialog waits for the user to select + one of the buttons either by clicking on the button with the mouse + or by typing return to invoke the default button (if any). Then it + returns the index of the selected button: 0 for the leftmost + button, 1 for the button next to it, and so on. + + While waiting for the user to respond, tk-dialog sets a local grab. + This prevents the user from interacting with the application in any + way except to invoke the dialog box. + +Keywords +-------- + +bitmap, dialog, modal + + +File: gcl-tk.info, Node: exit, Next: focus, Prev: tk-dialog, Up: Control + +3.5 exit +======== + +exit \- Exit the process + +Synopsis +-------- + +exit ?returnCode? + +Description +----------- + +Terminate the process, returning returnCode (an integer) to the system +as the exit status. If returnCode isn't specified then it defaults to +0. This command replaces the Tcl command by the same name. It is +identical to Tcl's exit command except that before exiting it destroys +all the windows managed by the process. This allows various cleanup +operations to be performed, such as removing application names from the +global registry of applications. + +Keywords +-------- + +exit, process + + +File: gcl-tk.info, Node: focus, Next: grab, Prev: exit, Up: Control + +3.6 focus +========= + +focus \- Direct keyboard events to a particular window + +Synopsis +-------- + + +focus + +focus window +focus option ?arg arg ...? + +Description +----------- + +The focus command is used to manage the Tk input focus. At any given +time, one window in an application is designated as the focus window for +that application; any key press or key release events directed to any +window in the application will be redirected instead to the focus +window. If there is no focus window for an application then keyboard +events are discarded. Typically, windows that are prepared to deal with +the focus (e.g. entries and other widgets that display editable text) +will claim the focus when mouse button 1 is pressed in them. When an +application is created its main window is initially given the focus. + + The focus command can take any of the following forms: + +focus + If invoked with no arguments, focus returns the path name of the + current focus window, or none if there is no focus window. +focus window + If invoked with a single argument consisting of a window's path + name, focus sets the input focus to that window. The return value + is an empty string. +focus :default ?window? + If window is specified, it becomes the default focus window (the + window that receives the focus whenever the focus window is + deleted) and the command returns an empty string. If window isn't + specified, the command returns the path name of the current default + focus window, or none if there is no default. Window may be + specified as none to clear its existing value. The default window + is initially none. +focus :none + Clears the focus window, so that keyboard input to this application + will be discarded. + +"Focus Events" +-------------- + +Tk's model of the input focus is different than X's model, and the focus +window set with the focus command is not usually the same as the X focus +window. Tk never explicitly changes the official X focus window. It +waits for the window manager to direct the X input focus to and from the +application's top-level windows, and it intercepts FocusIn and FocusOut +events coming from the X server to detect these changes. All of the +focus events received from X are discarded by Tk; they never reach the +application. Instead, Tk generates a different stream of FocusIn and +FocusOut for the application. This means that FocusIn and and FocusOut +events seen by the application will not obey the conventions described +in the documentation for Xlib. + + Tk applications receive two kinds of FocusIn and FocusOut events, +which can be distinguished by their detail fields. Events with a detail +of NotifyAncestor are directed to the current focus window when it +becomes active or inactive. A window is the active focus whenever two +conditions are simultaneously true: (a) the window is the focus window +for its application, and (b) some top-level window in the application +has received the X focus. When this happens Tk generates a FocusIn +event for the focus window with detail NotifyAncestor. When a window +loses the active focus (either because the window manager removed the +focus from the application or because the focus window changed within +the application) then it receives a FocusOut event with detail +NotifyAncestor. + + The events described above are directed to the application's focus +window regardless of which top-level window within the application has +received the focus. The second kind of focus event is provided for +applications that need to know which particular top-level window has the +X focus. Tk generates FocusIn and FocusOut events with detail +NotifyVirtual for top-level windows whenever they receive or lose the X +focus. These events are generated regardless of which window in the +application has the Tk input focus. They do not imply that keystrokes +will be directed to the window that receives the event; they simply +indicate which top-level window is active as far as the window manager +is concerned. If a top-level window is also the application's focus +window, then it will receive both NotifyVirtual and NotifyAncestor +events when it receives or loses the X focus. + + Tk does not generate the hierarchical chains of FocusIn and FocusOut +events described in the Xlib documentation (e.g. a window can get a +FocusIn or FocusOut event without all of its ancestors getting events +too). Furthermore, the mode field in focus events is always +NotifyNormal and the only values ever present in the detail field are +NotifyAncestor and NotifyVirtual. + +Keywords +-------- + +events, focus, keyboard, top-level, window manager + + +File: gcl-tk.info, Node: grab, Next: tk-listbox-single-select, Prev: focus, Up: Control + +3.7 grab +======== + +grab \- Confine pointer and keyboard events to a window sub-tree + +Synopsis +-------- + + +grab ?:global? window +grab option ?arg arg ...? + +Description +----------- + +This command implements simple pointer and keyboard grabs for Tk. Tk's +grabs are different than the grabs described in the Xlib documentation. +When a grab is set for a particular window, Tk restricts all pointer +events to the grab window and its descendants in Tk's window hierarchy. +Whenever the pointer is within the grab window's subtree, the pointer +will behave exactly the same as if there had been no grab at all and all +events will be reported in the normal fashion. When the pointer is +outside window's tree, button presses and releases and mouse motion +events are reported to window, and window entry and window exit events +are ignored. The grab subtree "owns" the pointer: windows outside the +grab subtree will be visible on the screen but they will be insensitive +until the grab is released. The tree of windows underneath the grab +window can include top-level windows, in which case all of those +top-level windows and their descendants will continue to receive mouse +events during the grab. + + Two forms of grabs are possible: local and global. A local grab +affects only the grabbing application: events will be reported to other +applications as if the grab had never occurred. Grabs are local by +default. A global grab locks out all applications on the screen, so +that only the given subtree of the grabbing application will be +sensitive to pointer events (mouse button presses, mouse button +releases, pointer motions, window entries, and window exits). During +global grabs the window manager will not receive pointer events either. + + During local grabs, keyboard events (key presses and key releases) +are delivered as usual: the window manager controls which application +receives keyboard events, and if they are sent to any window in the +grabbing application then they are redirected to the focus window. +During a global grab Tk grabs the keyboard so that all keyboard events +are always sent to the grabbing application. The focus command is still +used to determine which window in the application receives the keyboard +events. The keyboard grab is released when the grab is released. + + Grabs apply to particular displays. If an application has windows on +multiple displays then it can establish a separate grab on each display. +The grab on a particular display affects only the windows on that +display. It is possible for different applications on a single display +to have simultaneous local grabs, but only one application can have a +global grab on a given display at once. + + The grab command can take any of the following forms: + +grab ?:global? window + Same as grab :set, described below. +grab :current ?window? + If window is specified, returns the name of the current grab window + in this application for window's display, or an empty string if + there is no such window. If window is omitted, the command returns + a list whose elements are all of the windows grabbed by this + application for all displays, or an empty string if the application + has no grabs. +grab :release window + Releases the grab on window if there is one, otherwise does + nothing. Returns an empty string. +grab :set ?:global? window + Sets a grab on window. If :global is specified then the grab is + global, otherwise it is local. If a grab was already in effect for + this application on window's display then it is automatically + released. If there is already a grab on window and it has the same + global/local form as the requested grab, then the command does + nothing. Returns an empty string. +grab :status window + Returns none if no grab is currently set on window, local if a + local grab is set on window, and global if a global grab is set. + +Bugs +---- + +It took an incredibly complex and gross implementation to produce the +simple grab effect described above. Given the current implementation, +it isn't safe for applications to use the Xlib grab facilities at all +except through the Tk grab procedures. If applications try to +manipulate X's grab mechanisms directly, things will probably break. + + If a single process is managing several different Tk applications, +only one of those applications can have a local grab for a given display +at any given time. If the applications are in different processes, this +restriction doesn't exist. + +Keywords +-------- + +grab, keyboard events, pointer events, window + + +File: gcl-tk.info, Node: tk-listbox-single-select, Next: lower, Prev: grab, Up: Control + +3.8 tk-listbox-single-select +============================ + +tk-listbox-single-select \- Allow only one selected element in +listbox(es) + +Synopsis +-------- + +tk-listbox-single-select arg ?arg arg ...? + +Description +----------- + +This command is a Tcl procedure provided as part of the Tk script +library. It takes as arguments the path names of one or more listbox +widgets, or the value Listbox. For each named widget, +tk-listbox-single-select modifies the bindings of the widget so that +only a single element may be selected at a time (the normal +configuration allows multiple elements to be selected). If the keyword +Listbox is among the window arguments, then the class bindings for +listboxes are changed so that all listboxes have the +one-selection-at-a-time behavior. + +Keywords +-------- + +listbox, selection + + +File: gcl-tk.info, Node: lower, Next: tk-menu-bar, Prev: tk-listbox-single-select, Up: Control + +3.9 lower +========= + +lower \- Change a window's position in the stacking order + +Synopsis +-------- + +lower window ?belowThis? + +Description +----------- + +If the belowThis argument is omitted then the command lowers window so +that it is below all of its siblings in the stacking order (it will be +obscured by any siblings that overlap it and will not obscure any +siblings). If belowThis is specified then it must be the path name of a +window that is either a sibling of window or the descendant of a sibling +of window. In this case the lower command will insert window into the +stacking order just below belowThis (or the ancestor of belowThis that +is a sibling of window); this could end up either raising or lowering +window. + +Keywords +-------- + +lower, obscure, stacking order + + +File: gcl-tk.info, Node: tk-menu-bar, Next: option, Prev: lower, Up: Control + +3.10 tk-menu-bar +================ + +tk-menu-bar, tk_bindForTraversal \- Support for menu bars + +Synopsis +-------- + +tk-menu-bar frame ?menu menu ...? + + tk_bindForTraversal arg arg ... + +Description +----------- + +These two commands are Tcl procedures in the Tk script library. They +provide support for menu bars. A menu bar is a frame that contains a +collection of menu buttons that work together, so that the user can scan +from one menu to another with the mouse: if the mouse button is pressed +over one menubutton (causing it to post its menu) and the mouse is moved +over another menubutton in the same menu bar without releasing the mouse +button, then the menu of the first menubutton is unposted and the menu +of the new menubutton is posted instead. Menus in a menu bar can also +be accessed using keyboard traversal (i.e. by typing keystrokes instead +of using the mouse). In order for an application to use these +procedures, it must do three things, which are described in the +paragraphs below. + + First, each application must call tk-menu-bar to provide information +about the menubar. The frame argument gives the path name of the frame +that contains all of the menu buttons, and the menu arguments give path +names for all of the menu buttons associated with the menu bar. +Normally frame is the parent of each of the menu's. This need not be +the case, but frame must be an ancestor of each of the menu's in order +for grabs to work correctly when the mouse is used to pull down menus. +The order of the menu arguments determines the traversal order for the +menu buttons. If tk-menu-bar is called without any menu arguments, it +returns a list containing the current menu buttons for frame, or an +empty string if frame isn't currently set up as a menu bar. If +tk-menu-bar is called with a single menu argument consisting of an empty +string, any menubar information for frame is removed; from now on the +menu buttons will function independently without keyboard traversal. +Only one menu bar may be defined at a time within each top-level window. + + The second thing an application must do is to identify the traversal +characters for menu buttons and menu entries. This is done by +underlining those characters using the :underline options for the +widgets. The menu traversal system uses this information to traverse +the menus under keyboard control (see below). + + The third thing that an application must do is to make sure that the +input focus is always in a window that has been configured to support +menu traversal. If the input focus is none then input characters will +be discarded and no menu traversal will be possible. If you have no +other place to set the focus, set it to the menubar widget: tk-menu-bar +creates bindings for its frame argument to support menu traversal. + + The Tk startup scripts configure all the Tk widget classes with +bindings to support menu traversal, so menu traversal will be possible +regardless of which widget has the focus. If your application defines +new classes of widgets that support the input focus, then you should +call tk_bindForTraversal for each of these classes. Tk_bindForTraversal +takes any number of arguments, each of which is a widget path name or +widget class name. It sets up bindings for all the named widgets and +classes so that the menu traversal system will be invoked when +appropriate keystrokes are typed in those widgets or classes. + +"Menu Traversal Bindings" +------------------------- + +Once an application has made the three arrangements described above, +menu traversal will be available. At any given time, the only menus +available for traversal are those associated with the top-level window +containing the input focus. Menu traversal is initiated by one of the +following actions: + [1] If is typed, then the first menu button in the list for + the top-level window is posted and the first entry within that menu + is selected. + [2] If is pressed, then the menu button that has key as + its underlined character is posted and the first entry within that + menu is selected. The comparison between key and the underlined + characters ignores case differences. If no menu button matches key + then the keystroke has no effect. + [3] Clicking mouse button 1 on a menu button posts that menu and + selects its first entry. + + Once a menu has been posted, the input focus is switched to that menu +and the following actions are possible: + [1] Typing or clicking mouse button 1 outside the menu button + or its menu will abort the menu traversal. + [2] If is pressed, then the entry in the posted menu + whose underlined character is key is invoked. This causes the menu + to be unposted, the entry's action to be taken, and the menu + traversal to end. The comparison between key and underlined + characters ignores case differences. If no menu entry matches key + then the keystroke is ignored. + [3] The arrow keys may be used to move among entries and menus. + The left and right arrow keys move circularly among the available + menus and the up and down arrow keys move circularly among the + entries in the current menu. + [4] If is pressed, the selected entry in the posted menu + is invoked, which causes the menu to be unposted, the entry's + action to be taken, and the menu traversal to end. + + When a menu traversal completes, the input focus reverts to the +window that contained it when the traversal started. + +Keywords +-------- + +keyboard traversal, menu, menu bar, post + + +File: gcl-tk.info, Node: option, Next: options, Prev: tk-menu-bar, Up: Control + +3.11 option +=========== + +option \- Add/retrieve window options to/from the option database + +Synopsis +-------- + +option :add pattern value ?priority? + + option :clear + + option :get window name class + + option :readfile fileName ?priority? + +Description +----------- + +The option command allows you to add entries to the Tk option database +or to retrieve options from the database. The add form of the command +adds a new option to the database. Pattern contains the option being +specified, and consists of names and/or classes separated by asterisks +or dots, in the usual X format. Value contains a text string to +associate with pattern; this is the value that will be returned in calls +to Tk_GetOption or by invocations of the option :get command. If +priority is specified, it indicates the priority level for this option +(see below for legal values); it defaults to interactive. This command +always returns an empty string. + + The option :clear command clears the option database. Default +options (in the RESOURCE_MANAGER property or the .Xdefaults file) will +be reloaded automatically the next time an option is added to the +database or removed from it. This command always returns an empty +string. + + The option :get command returns the value of the option specified for +window under name and class. If several entries in the option database +match window, name, and class, then the command returns whichever was +created with highest priority level. If there are several matching +entries at the same priority level, then it returns whichever entry was +most recently entered into the option database. If there are no +matching entries, then the empty string is returned. + + The readfile form of the command reads fileName, which should have +the standard format for an X resource database such as .Xdefaults, and +adds all the options specified in that file to the option database. If +priority is specified, it indicates the priority level at which to enter +the options; priority defaults to interactive. + + The priority arguments to the option command are normally specified +symbolically using one of the following values: + +widgetDefault + Level 20. Used for default values hard-coded into widgets. +startupFile + Level 40. Used for options specified in application-specific + startup files. +userDefault + Level 60. Used for options specified in user-specific defaults + files, such as .Xdefaults, resource databases loaded into the X + server, or user-specific startup files. +interactive + Level 80. Used for options specified interactively after the + application starts running. If priority isn't specified, it + defaults to this level. + + Any of the above keywords may be abbreviated. In addition, +priorities may be specified numerically using integers between 0 and +100, inclusive. The numeric form is probably a bad idea except for new +priority levels other than the ones given above. + +Keywords +-------- + +database, option, priority, retrieve + + +File: gcl-tk.info, Node: options, Next: pack-old, Prev: option, Up: Control + +3.12 options +============ + +options \- Standard options supported by widgets + +Description +----------- + +This manual entry describes the common configuration options supported +by widgets in the Tk toolkit. Every widget does not necessarily support +every option (see the manual entries for individual widgets for a list +of the standard options supported by that widget), but if a widget does +support an option with one of the names listed below, then the option +has exactly the effect described below. + + In the descriptions below, "Name" refers to the option's name in the +option database (e.g. in .Xdefaults files). "Class" refers to the +option's class value in the option database. "Command-Line Switch" +refers to the switch used in widget-creation and configure widget +commands to set this value. For example, if an option's command-line +switch is :foreground and there exists a widget .a.b.c, then the command + + + (.a.b.c :configure :foreground "black") + + may be used to specify the value black for the option in the the +widget .a.b.c. Command-line switches may be abbreviated, as long as the +abbreviation is unambiguous. + +':activebackground' + Name='"activeBackground" Class="Foreground"' + + Specifies background color to use when drawing active elements. An + element (a widget or portion of a widget) is active if the mouse + cursor is positioned over the element and pressing a mouse button + will cause some action to occur. + +':activeborderwidth' + Name='"activeBorderWidth" Class="BorderWidth"' + + Specifies a non-negative value indicating the width of the 3-D + border drawn around active elements. See above for definition of + active elements. The value may have any of the forms acceptable to + Tk_GetPixels. This option is typically only available in widgets + displaying more than one element at a time (e.g. menus but not + buttons). + +':activeforeground' + Name='"activeForeground" Class="Background"' + + Specifies foreground color to use when drawing active elements. + See above for definition of active elements. + +':anchor' + Name='"anchor" Class="Anchor"' + + Specifies how the information in a widget (e.g. text or a bitmap) + is to be displayed in the widget. Must be one of the values n, ne, + e, se, s, sw, w, nw, or center. For example, nw means display the + information such that its top-left corner is at the top-left corner + of the widget. + +':background or :bg' + Name='"background" Class="Background"' + + Specifies the normal background color to use when displaying the + widget. + +':bitmap' + Name='"bitmap" Class="Bitmap"' + + Specifies a bitmap to display in the widget, in any of the forms + acceptable to Tk_GetBitmap. The exact way in which the bitmap is + displayed may be affected by other options such as anchor or + justify. Typically, if this option is specified then it overrides + other options that specify a textual value to display in the + widget; the bitmap option may be reset to an empty string to + re-enable a text display. + +':borderwidth or :bd' + Name='"borderWidth" Class="BorderWidth"' + + Specifies a non-negative value indicating the width of the 3-D + border to draw around the outside of the widget (if such a border + is being drawn; the relief option typically determines this). The + value may also be used when drawing 3-D effects in the interior of + the widget. The value may have any of the forms acceptable to + Tk_GetPixels. + +':cursor' + Name='"cursor" Class="Cursor"' + + Specifies the mouse cursor to be used for the widget. The value + may have any of the forms acceptable to Tk_GetCursor. + +':cursorbackground' + Name='"cursorBackground" Class="Foreground"' + + Specifies the color to use as background in the area covered by the + insertion cursor. This color will normally override either the + normal background for the widget (or the selection background if + the insertion cursor happens to fall in the selection). \fIThis + option is obsolete and is gradually being replaced by the + insertBackground option. + +':cursorborderwidth' + Name='"cursorBorderWidth" Class="BorderWidth"' + + Specifies a non-negative value indicating the width of the 3-D + border to draw around the insertion cursor. The value may have any + of the forms acceptable to Tk_GetPixels. \fIThis option is + obsolete and is gradually being replaced by the insertBorderWidth + option. + +':cursorofftime' + Name='"cursorOffTime" Class="OffTime"' + + Specifies a non-negative integer value indicating the number of + milliseconds the cursor should remain "off" in each blink cycle. + If this option is zero then the cursor doesn't blink: it is on all + the time. \fIThis option is obsolete and is gradually being + replaced by the insertOffTime option. + +':cursorontime' + Name='"cursorOnTime" Class="OnTime"' + + Specifies a non-negative integer value indicating the number of + milliseconds the cursor should remain "on" in each blink cycle. + \fIThis option is obsolete and is gradually being replaced by the + insertOnTime option. + +':cursorwidth' + Name='"cursorWidth" Class="CursorWidth"' + + Specifies a value indicating the total width of the insertion + cursor. The value may have any of the forms acceptable to + Tk_GetPixels. If a border has been specified for the cursor (using + the cursorBorderWidth option), the border will be drawn inside the + width specified by the cursorWidth option. \fIThis option is + obsolete and is gradually being replaced by the insertWidth option. + +':disabledforeground' + Name='"disabledForeground" Class="DisabledForeground"' + + Specifies foreground color to use when drawing a disabled element. + If the option is specified as an empty string (which is typically + the case on monochrome displays), disabled elements are drawn with + the normal fooreground color but they are dimmed by drawing them + with a stippled fill pattern. + +':exportselection' + Name='"exportSelection" Class="ExportSelection"' + + Specifies whether or not a selection in the widget should also be + the X selection. The value may have any of the forms accepted by + Tcl_GetBoolean, such as true, false, 0, 1, yes, or no. If the + selection is exported, then selecting in the widget deselects the + current X selection, selecting outside the widget deselects any + widget selection, and the widget will respond to selection + retrieval requests when it has a selection. The default is usually + for widgets to export selections. + +':font' + Name='"font" Class="Font"' + + Specifies the font to use when drawing text inside the widget. + +':foreground or :fg' + Name='"foreground" Class="Foreground"' + + Specifies the normal foreground color to use when displaying the + widget. + +':geometry' + Name='"geometry" Class="Geometry"' + + Specifies the desired geometry for the widget's window, in the form + widthxheight, where width is the desired width of the window and + height is the desired height. The units for width and height + depend on the particular widget. For widgets displaying text the + units are usually the size of the characters in the font being + displayed; for other widgets the units are usually pixels. + +':insertbackground' + Name='"insertBackground" Class="Foreground"' + + Specifies the color to use as background in the area covered by the + insertion cursor. This color will normally override either the + normal background for the widget (or the selection background if + the insertion cursor happens to fall in the selection). + +':insertborderwidth' + Name='"insertBorderWidth" Class="BorderWidth"' + + Specifies a non-negative value indicating the width of the 3-D + border to draw around the insertion cursor. The value may have any + of the forms acceptable to Tk_GetPixels. + +':insertofftime' + Name='"insertOffTime" Class="OffTime"' + + Specifies a non-negative integer value indicating the number of + milliseconds the insertion cursor should remain "off" in each blink + cycle. If this option is zero then the cursor doesn't blink: it is + on all the time. + +':insertontime' + Name='"insertOnTime" Class="OnTime"' + + Specifies a non-negative integer value indicating the number of + milliseconds the insertion cursor should remain "on" in each blink + cycle. + +':insertwidth' + Name='"insertWidth" Class="InsertWidth"' + + Specifies a value indicating the total width of the insertion + cursor. The value may have any of the forms acceptable to + Tk_GetPixels. If a border has been specified for the insertion + cursor (using the insertBorderWidth option), the border will be + drawn inside the width specified by the insertWidth option. + +':orient' + Name='"orient" Class="Orient"' + + For widgets that can lay themselves out with either a horizontal or + vertical orientation, such as scrollbars, this option specifies + which orientation should be used. Must be either horizontal or + vertical or an abbreviation of one of these. + +':padx' + Name='"padX" Class="Pad"' + + Specifies a non-negative value indicating how much extra space to + request for the widget in the X-direction. The value may have any + of the forms acceptable to Tk_GetPixels. When computing how large + a window it needs, the widget will add this amount to the width it + would normally need (as determined by the width of the things + displayed in the widget); if the geometry manager can satisfy this + request, the widget will end up with extra internal space to the + left and/or right of what it displays inside. + +':pady' + Name='"padY" Class="Pad"' + + Specifies a non-negative value indicating how much extra space to + request for the widget in the Y-direction. The value may have any + of the forms acceptable to Tk_GetPixels. When computing how large + a window it needs, the widget will add this amount to the height it + would normally need (as determined by the height of the things + displayed in the widget); if the geometry manager can satisfy this + request, the widget will end up with extra internal space above + and/or below what it displays inside. + +':relief' + Name='"relief" Class="Relief"' + + Specifies the 3-D effect desired for the widget. Acceptable values + are raised, sunken, flat, ridge, and groove. The value indicates + how the interior of the widget should appear relative to its + exterior; for example, raised means the interior of the widget + should appear to protrude from the screen, relative to the exterior + of the widget. + +':repeatdelay' + Name='"repeatDelay" Class="RepeatDelay"' + + Specifies the number of milliseconds a button or key must be held + down before it begins to auto-repeat. Used, for example, on the + up- and down-arrows in scrollbars. + +':repeatinterval' + Name='"repeatInterval" Class="RepeatInterval"' + + Used in conjunction with repeatDelay: once auto-repeat begins, this + option determines the number of milliseconds between auto-repeats. + +':scrollcommand' + Name='"scrollCommand" Class="ScrollCommand"' + + Specifies the prefix for a command used to communicate with + scrollbar widgets. When the view in the widget's window changes + (or whenever anything else occurs that could change the display in + a scrollbar, such as a change in the total size of the widget's + contents), the widget will generate a Tcl command by concatenating + the scroll command and four numbers. The four numbers are, in + order: the total size of the widget's contents, in unspecified + units ("unit" is a widget-specific term; for widgets displaying + text, the unit is a line); the maximum number of units that may be + displayed at once in the widget's window, given its current size; + the index of the top-most or left-most unit currently visible in + the window (index 0 corresponds to the first unit); and the index + of the bottom-most or right-most unit currently visible in the + window. This command is then passed to the Tcl interpreter for + execution. Typically the scrollCommand option consists of the path + name of a scrollbar widget followed by "set", e.g. ".x.scrollbar + set": this will cause the scrollbar to be updated whenever the view + in the window changes. If this option is not specified, then no + command will be executed. + + The scrollCommand option is used for widgets that support scrolling + in only one direction. For widgets that support scrolling in both + directions, this option is replaced with the xScrollCommand and + yScrollCommand options. + +':selectbackground' + Name='"selectBackground" Class="Foreground"' + + Specifies the background color to use when displaying selected + items. + +':selectborderwidth' + Name='"selectBorderWidth" Class="BorderWidth"' + + Specifies a non-negative value indicating the width of the 3-D + border to draw around selected items. The value may have any of + the forms acceptable to Tk_GetPixels. + +':selectforeground' + Name='"selectForeground" Class="Background"' + + Specifies the foreground color to use when displaying selected + items. + +':setgrid' + Name='"setGrid" Class="SetGrid"' + + Specifies a boolean value that determines whether this widget + controls the resizing grid for its top-level window. This option + is typically used in text widgets, where the information in the + widget has a natural size (the size of a character) and it makes + sense for the window's dimensions to be integral numbers of these + units. These natural window sizes form a grid. If the setGrid + option is set to true then the widget will communicate with the + window manager so that when the user interactively resizes the + top-level window that contains the widget, the dimensions of the + window will be displayed to the user in grid units and the window + size will be constrained to integral numbers of grid units. See + the section GRIDDED GEOMETRY MANAGEMENT in the wm manual entry for + more details. + +':text' + Name='"text" Class="Text"' + + Specifies a string to be displayed inside the widget. The way in + which the string is displayed depends on the particular widget and + may be determined by other options, such as anchor or justify. + +':textvariable' + Name='"textVariable" Class="Variable"' + + Specifies the name of a variable. The value of the variable is a + text string to be displayed inside the widget; if the variable + value changes then the widget will automatically update itself to + reflect the new value. The way in which the string is displayed in + the widget depends on the particular widget and may be determined + by other options, such as anchor or justify. + +':underline' + Name='"underline" Class="Underline"' + + Specifies the integer index of a character to underline in the + widget. This option is typically used to indicate keyboard + traversal characters in menu buttons and menu entries. 0 + corresponds to the first character of the text displayed in the + widget, 1 to the next character, and so on. + +':xscrollcommand' + Name='"xScrollCommand" Class="ScrollCommand"' + + Specifies the prefix for a command used to communicate with + horizontal scrollbars. This option is treated in the same way as + the scrollCommand option, except that it is used for horizontal + scrollbars associated with widgets that support both horizontal and + vertical scrolling. See the description of scrollCommand for + complete details on how this option is used. + +':yscrollcommand' + Name='"yScrollCommand" Class="ScrollCommand"' + + Specifies the prefix for a command used to communicate with + vertical scrollbars. This option is treated in the same way as the + scrollCommand option, except that it is used for vertical + scrollbars associated with widgets that support both horizontal and + vertical scrolling. See the description of scrollCommand for + complete details on how this option is used. + +Keywords +-------- + +class, name, standard option, switch + + +File: gcl-tk.info, Node: pack-old, Next: pack, Prev: options, Up: Control + +3.13 pack-old +============= + +pack \- Obsolete syntax for packer geometry manager + +Synopsis +-------- + +pack after sibling window options ?window options ...? + + pack append parent window options ?window options ...? + + pack before sibling window options ?window options ...? + + pack info parent + + pack unpack window + +Description +----------- + +Note: this manual entry describes the syntax for the pack\fI command as +it before Tk version 3.3. Although this syntax continues to be +supported for backward compatibility, it is obsolete and should not be +used anymore. At some point in the future it may cease to be supported. + + The packer is a geometry manager that arranges the children of a +parent by packing them in order around the edges of the parent. The +first child is placed against one side of the window, occupying the +entire span of the window along that side. This reduces the space +remaining for other children as if the side had been moved in by the +size of the first child. Then the next child is placed against one side +of the remaining cavity, and so on until all children have been placed +or there is no space left in the cavity. + + The before, after, and append forms of the pack command are used to +insert one or more children into the packing order for their parent. +The before form inserts the children before window sibling in the order; +all of the other windows must be siblings of sibling. The after form +inserts the windows after sibling, and the append form appends one or +more windows to the end of the packing order for parent. If a window +named in any of these commands is already packed in its parent, it is +removed from its current position in the packing order and repositioned +as indicated by the command. All of these commands return an empty +string as result. + + The unpack form of the pack command removes window from the packing +order of its parent and unmaps it. After the execution of this command +the packer will no longer manage window's geometry. + + The placement of each child is actually a four-step process; the +options argument following each window consists of a list of one or more +fields that govern the placement of that window. In the discussion +below, the term cavity refers to the space left in a parent when a +particular child is placed (i.e. all the space that wasn't claimed by +earlier children in the packing order). The term parcel refers to the +space allocated to a particular child; this is not necessarily the same +as the child window's final geometry. + + The first step in placing a child is to determine which side of the +cavity it will lie against. Any one of the following options may be +used to specify a side: + +top + Position the child's parcel against the top of the cavity, + occupying the full width of the cavity. +bottom + Position the child's parcel against the bottom of the cavity, + occupying the full width of the cavity. +left + Position the child's parcel against the left side of the cavity, + occupying the full height of the cavity. +right + Position the child's parcel against the right side of the cavity, + occupying the full height of the cavity. + + At most one of these options should be specified for any given +window. If no side is specified, then the default is top. + + The second step is to decide on a parcel for the child. For top and +bottom windows, the desired parcel width is normally the cavity width +and the desired parcel height is the window's requested height, as +passed to Tk_GeometryRequest. For left and right windows, the desired +parcel height is normally the cavity height and the desired width is the +window's requested width. However, extra space may be requested for the +window using any of the following options: + +padx num + Add num pixels to the window's requested width before computing the + parcel size as described above. +pady num + Add num pixels to the window's requested height before computing + the parcel size as described above. +expand + This option requests that the window's parcel absorb any extra + space left over in the parent's cavity after packing all the + children. The amount of space left over depends on the sizes + requested by the other children, and may be zero. If several + windows have all specified expand then the extra width will be + divided equally among all the left and right windows that specified + expand and the extra height will be divided equally among all the + top and bottom windows that specified expand. + + If the desired width or height for a parcel is larger than the +corresponding dimension of the cavity, then the cavity's dimension is +used instead. + + The third step in placing the window is to decide on the window's +width and height. The default is for the window to receive either its +requested width and height or the those of the parcel, whichever is +smaller. If the parcel is larger than the window's requested size, then +the following options may be used to expand the window to partially or +completely fill the parcel: + +fill + Set the window's size to equal the parcel size. +fillx + Increase the window's width to equal the parcel's width, but retain + the window's requested height. +filly + Increase the window's height to equal the parcel's height, but + retain the window's requested width. + + The last step is to decide the window's location within its parcel. + If the window's size equals the parcel's size, then the window + simply fills the entire parcel. If the parcel is larger than the + window, then one of the following options may be used to specify + where the window should be positioned within its parcel: +frame center + Center the window in its parcel. This is the default if no framing + option is specified. +frame n + Position the window with its top edge centered on the top edge of + the parcel. +frame ne + Position the window with its upper-right corner at the upper-right + corner of the parcel. +frame e + Position the window with its right edge centered on the right edge + of the parcel. +frame se + Position the window with its lower-right corner at the lower-right + corner of the parcel. +frame s + Position the window with its bottom edge centered on the bottom + edge of the parcel. +frame sw + Position the window with its lower-left corner at the lower-left + corner of the parcel. +frame w + Position the window with its left edge centered on the left edge of + the parcel. +frame nw + Position the window with its upper-left corner at the upper-left + corner of the parcel. + + The pack info command may be used to retrieve information about the + packing order for a parent. It returns a list in the form + + window options window options ... + + Each window is a name of a window packed in parent, and the + following options describes all of the options for that window, + just as they would be typed to pack append. The order of the list + is the same as the packing order for parent. + + The packer manages the mapped/unmapped state of all the packed + children windows. It automatically maps the windows when it packs + them, and it unmaps any windows for which there was no space left + in the cavity. + + The packer makes geometry requests on behalf of the parent windows + it manages. For each parent window it requests a size large enough + to accommodate all the options specified by all the packed + children, such that zero space would be leftover for expand + options. + +Keywords +-------- + +geometry manager, location, packer, parcel, size + + +File: gcl-tk.info, Node: pack, Next: place, Prev: pack-old, Up: Control + +3.14 pack +========= + +pack \- Geometry manager that packs around edges of cavity + +Synopsis +-------- + +pack option arg ?arg ...? + +Description +----------- + +The pack command is used to communicate with the packer, a geometry +manager that arranges the children of a parent by packing them in order +around the edges of the parent. The pack command can have any of +several forms, depending on the option argument: + +pack slave ?slave ...? ?options? + If the first argument to pack is a window name (any value starting + with "."), then the command is processed in the same way as pack + configure. +pack configure slave ?slave ...? ?options? + The arguments consist of the names of one or more slave windows + followed by pairs of arguments that specify how to manage the + slaves. See "THE PACKER ALGORITHM" below for details on how the + options are used by the packer. The following options are + supported: +:after other + Other must the name of another window. Use its master as the + master for the slaves, and insert the slaves just after other in + the packing order. +:anchor anchor + Anchor must be a valid anchor position such as n or sw; it + specifies where to position each slave in its parcel. Defaults to + center. +:before other + Other must the name of another window. Use its master as the + master for the slaves, and insert the slaves just before other in + the packing order. +:expand boolean + Specifies whether the slaves should be expanded to consume extra + space in their master. Boolean may have any proper boolean value, + such as 1 or no. Defaults to 0. +:fill style + If a slave's parcel is larger than its requested dimensions, this + option may be used to stretch the slave. Style must have one of + the following values: + none + Give the slave its requested dimensions plus any internal + padding requested with :ipadx or :ipady. This is the default. + x + Stretch the slave horizontally to fill the entire width of its + parcel (except leave external padding as specified by :padx). + y + Stretch the slave vertically to fill the entire height of its + parcel (except leave external padding as specified by :pady). + both + Stretch the slave both horizontally and vertically. +:in other + Insert the slave(s) at the end of the packing order for the master + window given by other. +:ipadx amount + Amount specifies how much horizontal internal padding to leave on + each side of the slave(s). Amount must be a valid screen distance, + such as 2 or .5c. It defaults to 0. +:ipady amount + Amount specifies how much vertical internal padding to leave on + each side of the slave(s). Amount defaults to 0. +:padx amount + Amount specifies how much horizontal external padding to leave on + each side of the slave(s). Amount defaults to 0. +:pady amount + Amount specifies how much vertical external padding to leave on + each side of the slave(s). Amount defaults to 0. +:side side + Specifies which side of the master the slave(s) will be packed + against. Must be left, right, top, or bottom. Defaults to top. + + If no :in, :after or :before option is specified then each of the +slaves will be inserted at the end of the packing list for its parent +unless it is already managed by the packer (in which case it will be +left where it is). If one of these options is specified then all the +slaves will be inserted at the specified point. If any of the slaves +are already managed by the geometry manager then any unspecified options +for them retain their previous values rather than receiving default +values. .RE + +pack :forget slave ?slave ...? + Removes each of the slaves from the packing order for its master + and unmaps their windows. The slaves will no longer be managed by + the packer. +pack :newinfo slave + Returns a list whose elements are the current configuration state + of the slave given by slave in the same option-value form that + might be specified to pack configure. The first two elements of + the list are ":in master" where master is the slave's master. + Starting with Tk 4.0 this option will be renamed "pack info". +pack :propagate master ?boolean? + If boolean has a true boolean value such as 1 or on then + propagation is enabled for master, which must be a window name (see + "GEOMETRY PROPAGATION" below). If boolean has a false boolean + value then propagation is disabled for master. In either of these + cases an empty string is returned. If boolean is omitted then the + command returns 0 or 1 to indicate whether propagation is currently + enabled for master. Propagation is enabled by default. +pack :slaves master + Returns a list of all of the slaves in the packing order for + master. The order of the slaves in the list is the same as their + order in the packing order. If master has no slaves then an empty + string is returned. + +"The Packer Algorithm" +---------------------- + +For each master the packer maintains an ordered list of slaves called +the packing list. The :in, :after, and :before configuration options +are used to specify the master for each slave and the slave's position +in the packing list. If none of these options is given for a slave then +the slave is added to the end of the packing list for its parent. + + The packer arranges the slaves for a master by scanning the packing +list in order. At the time it processes each slave, a rectangular area +within the master is still unallocated. This area is called the cavity; +for the first slave it is the entire area of the master. + + For each slave the packer carries out the following steps: + [1] The packer allocates a rectangular parcel for the slave along + the side of the cavity given by the slave's :side option. If the + side is top or bottom then the width of the parcel is the width of + the cavity and its height is the requested height of the slave plus + the :ipady and :pady options. For the left or right side the + height of the parcel is the height of the cavity and the width is + the requested width of the slave plus the :ipadx and :padx options. + The parcel may be enlarged further because of the :expand option + (see "EXPANSION" below) + [2] The packer chooses the dimensions of the slave. The width will + normally be the slave's requested width plus twice its :ipadx + option and the height will normally be the slave's requested height + plus twice its :ipady option. However, if the :fill option is x or + both then the width of the slave is expanded to fill the width of + the parcel, minus twice the :padx option. If the :fill option is y + or both then the height of the slave is expanded to fill the width + of the parcel, minus twice the :pady option. + [3] The packer positions the slave over its parcel. If the slave + is smaller than the parcel then the :anchor option determines where + in the parcel the slave will be placed. If :padx or :pady is + non-zero, then the given amount of external padding will always be + left between the slave and the edges of the parcel. + + Once a given slave has been packed, the area of its parcel is +subtracted from the cavity, leaving a smaller rectangular cavity for the +next slave. If a slave doesn't use all of its parcel, the unused space +in the parcel will not be used by subsequent slaves. If the cavity +should become too small to meet the needs of a slave then the slave will +be given whatever space is left in the cavity. If the cavity shrinks to +zero size, then all remaining slaves on the packing list will be +unmapped from the screen until the master window becomes large enough to +hold them again. + +"Expansion" +----------- + +If a master window is so large that there will be extra space left over +after all of its slaves have been packed, then the extra space is +distributed uniformly among all of the slaves for which the :expand +option is set. Extra horizontal space is distributed among the +expandable slaves whose :side is left or right, and extra vertical space +is distributed among the expandable slaves whose :side is top or bottom. + +"Geometry Propagation" +---------------------- + +The packer normally computes how large a master must be to just exactly +meet the needs of its slaves, and it sets the requested width and height +of the master to these dimensions. This causes geometry information to +propagate up through a window hierarchy to a top-level window so that +the entire sub-tree sizes itself to fit the needs of the leaf windows. +However, the pack propagate command may be used to turn off propagation +for one or more masters. If propagation is disabled then the packer +will not set the requested width and height of the packer. This may be +useful if, for example, you wish for a master window to have a fixed +size that you specify. + +"Restrictions On Master Windows" +-------------------------------- + +The master for each slave must either be the slave's parent (the +default) or a descendant of the slave's parent. This restriction is +necessary to guarantee that the slave can be placed over any part of its +master that is visible without danger of the slave being clipped by its +parent. + +"Packing Order" +--------------- + +If the master for a slave is not its parent then you must make sure that +the slave is higher in the stacking order than the master. Otherwise +the master will obscure the slave and it will appear as if the slave +hasn't been packed correctly. The easiest way to make sure the slave is +higher than the master is to create the master window first: the most +recently created window will be highest in the stacking order. Or, you +can use the raise and lower commands to change the stacking order of +either the master or the slave. + +Keywords +-------- + +geometry manager, location, packer, parcel, propagation, size diff --git a/info/gcl-tk.info-2 b/info/gcl-tk.info-2 new file mode 100644 index 0000000..917b4d8 --- /dev/null +++ b/info/gcl-tk.info-2 @@ -0,0 +1,1234 @@ +This is gcl-tk.info, produced by makeinfo version 6.7 from gcl-tk.texi. + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl-tk: (gcl-tk.info). GNU TK Manual +END-INFO-DIR-ENTRY + +This is a Texinfo GCL TK Manual + + Copyright 1994 William F. Schelter + + + +File: gcl-tk.info, Node: place, Next: raise, Prev: pack, Up: Control + +3.15 place +========== + +place \- Geometry manager for fixed or rubber-sheet placement + +Synopsis +-------- + +place window option value ?option value ...? + + place configure window option value ?option value ...? + + place forget window + + place info window + + place slaves window + +Description +----------- + +The placer is a geometry manager for Tk. It provides simple fixed +placement of windows, where you specify the exact size and location of +one window, called the slave, within another window, called the master. +The placer also provides rubber-sheet placement, where you specify the +size and location of the slave in terms of the dimensions of the master, +so that the slave changes size and location in response to changes in +the size of the master. Lastly, the placer allows you to mix these +styles of placement so that, for example, the slave has a fixed width +and height but is centered inside the master. + + If the first argument to the place command is a window path name or +configure then the command arranges for the placer to manage the +geometry of a slave whose path name is window. The remaining arguments +consist of one or more option:value pairs that specify the way in which +window's geometry is managed. If the placer is already managing window, +then the option:value pairs modify the configuration for window. In +this form the place command returns an empty string as result. The +following option:value pairs are supported: + +:in master + Master specifes the path name of the window relative to which + window is to be placed. Master must either be window's parent or a + descendant of window's parent. In addition, master and window must + both be descendants of the same top-level window. These + restrictions are necessary to guarantee that window is visible + whenever master is visible. If this option isn't specified then + the master defaults to window's parent. +:x location + Location specifies the x-coordinate within the master window of the + anchor point for window. The location is specified in screen units + (i.e. any of the forms accepted by Tk_GetPixels) and need not lie + within the bounds of the master window. +:relx location + Location specifies the x-coordinate within the master window of the + anchor point for window. In this case the location is specified in + a relative fashion as a floating-point number: 0.0 corresponds to + the left edge of the master and 1.0 corresponds to the right edge + of the master. Location need not be in the range 0.0\-1.0. +:y location + Location specifies the y-coordinate within the master window of the + anchor point for window. The location is specified in screen units + (i.e. any of the forms accepted by Tk_GetPixels) and need not lie + within the bounds of the master window. +:rely location + Location specifies the y-coordinate within the master window of the + anchor point for window. In this case the value is specified in a + relative fashion as a floating-point number: 0.0 corresponds to the + top edge of the master and 1.0 corresponds to the bottom edge of + the master. Location need not be in the range 0.0\-1.0. +:anchor where + Where specifies which point of window is to be positioned at the + (x,y) location selected by the :x, :y, :relx, and :rely options. + The anchor point is in terms of the outer area of window including + its border, if any. Thus if where is se then the lower-right + corner of window's border will appear at the given (x,y) location + in the master. The anchor position defaults to nw. +:width size + Size specifies the width for window in screen units (i.e. any of + the forms accepted by Tk_GetPixels). The width will be the outer + width of window including its border, if any. If size is an empty + string, or if no :width or :relwidth option is specified, then the + width requested internally by the window will be used. +:relwidth size + Size specifies the width for window. In this case the width is + specified as a floating-point number relative to the width of the + master: 0.5 means window will be half as wide as the master, 1.0 + means window will have the same width as the master, and so on. +:height size + Size specifies the height for window in screen units (i.e. any of + the forms accepted by Tk_GetPixels). The height will be the outer + dimension of window including its border, if any. If size is an + empty string, or if no :height or :relheight option is specified, + then the height requested internally by the window will be used. +:relheight size + Size specifies the height for window. In this case the height is + specified as a floating-point number relative to the height of the + master: 0.5 means window will be half as high as the master, 1.0 + means window will have the same height as the master, and so on. +:bordermode mode + Mode determines the degree to which borders within the master are + used in determining the placement of the slave. The default and + most common value is inside. In this case the placer considers the + area of the master to be the innermost area of the master, inside + any border: an option of :x 0 corresponds to an x-coordinate just + inside the border and an option of :relwidth 1.0 means window will + fill the area inside the master's border. If mode is outside then + the placer considers the area of the master to include its border; + this mode is typically used when placing window outside its master, + as with the options :x 0 :y 0 :anchor ne. Lastly, mode may be + specified as ignore, in which case borders are ignored: the area of + the master is considered to be its official X area, which includes + any internal border but no external border. A bordermode of ignore + is probably not very useful. + + If the same value is specified separately with two different + options, such as :x and :relx, then the most recent option is used + and the older one is ignored. + + The place slaves command returns a list of all the slave windows + for which window is the master. If there are no slaves for window + then an empty string is returned. + + The place forget command causes the placer to stop managing the + geometry of window. As a side effect of this command window will + be unmapped so that it doesn't appear on the screen. If window + isn't currently managed by the placer then the command has no + effect. Place forget returns an empty string as result. + + The place info command returns a list giving the current + configuration of window. The list consists of option:value pairs + in exactly the same form as might be specified to the place + configure command. If the configuration of a window has been + retrieved with place info, that configuration can be restored later + by first using place forget to erase any existing information for + the window and then invoking place configure with the saved + information. + +"Fine Points" +------------- + +It is not necessary for the master window to be the parent of the slave +window. This feature is useful in at least two situations. First, for +complex window layouts it means you can create a hierarchy of subwindows +whose only purpose is to assist in the layout of the parent. The "real +children" of the parent (i.e. the windows that are significant for the +application's user interface) can be children of the parent yet be +placed inside the windows of the geometry-management hierarchy. This +means that the path names of the "real children" don't reflect the +geometry-management hierarchy and users can specify options for the real +children without being aware of the structure of the geometry-management +hierarchy. + + A second reason for having a master different than the slave's parent +is to tie two siblings together. For example, the placer can be used to +force a window always to be positioned centered just below one of its +siblings by specifying the configuration + + :in sibling :relx 0.5 :rely 1.0 :anchor n :bordermode outside + + Whenever the sibling is repositioned in the future, the slave will be +repositioned as well. + + Unlike many other geometry managers (such as the packer) the placer +does not make any attempt to manipulate the geometry of the master +windows or the parents of slave windows (i.e. it doesn't set their +requested sizes). To control the sizes of these windows, make them +windows like frames and canvases that provide configuration options for +this purpose. + +Keywords +-------- + +geometry manager, height, location, master, place, rubber sheet, slave, +width + + +File: gcl-tk.info, Node: raise, Next: selection, Prev: place, Up: Control + +3.16 raise +========== + +raise \- Change a window's position in the stacking order + +Synopsis +-------- + +raise window ?aboveThis? + +Description +----------- + +If the aboveThis argument is omitted then the command raises window so +that it is above all of its siblings in the stacking order (it will not +be obscured by any siblings and will obscure any siblings that overlap +it). If aboveThis is specified then it must be the path name of a +window that is either a sibling of window or the descendant of a sibling +of window. In this case the raise command will insert window into the +stacking order just above aboveThis (or the ancestor of aboveThis that +is a sibling of window); this could end up either raising or lowering +window. + +Keywords +-------- + +obscure, raise, stacking order + + +File: gcl-tk.info, Node: selection, Next: send, Prev: raise, Up: Control + +3.17 selection +============== + +selection \- Manipulate the X selection + +Synopsis +-------- + +selection option ?arg arg ...? + +Description +----------- + +This command provides a Tcl interface to the X selection mechanism and +implements the full selection functionality described in the X +Inter-Client Communication Conventions Manual (ICCCM), except that it +supports only the primary selection. + + The first argument to selection determines the format of the rest of +the arguments and the behavior of the command. The following forms are +currently supported: + +selection :clear window + If there is a selection anywhere on window's display, clear it so + that no window owns the selection anymore. Returns an empty + string. +selection :get ?type? + Retrieves the value of the primary selection and returns it as a + result. Type specifies the form in which the selection is to be + returned (the desired "target" for conversion, in ICCCM + terminology), and should be an atom name such as STRING or + FILE_NAME; see the Inter-Client Communication Conventions Manual + for complete details. Type defaults to STRING. The selection + :owner may choose to return the selection in any of several + different representation formats, such as STRING, ATOM, INTEGER, + etc. (this format is different than the selection type; see the + ICCCM for all the confusing details). If the selection is returned + in a non-string format, such as INTEGER or ATOM, the selection + command converts it to string format as a collection of fields + separated by spaces: atoms are converted to their textual names, + and anything else is converted to hexadecimal integers. +selection :handle window command ?type? ?format? + Creates a handler for selection requests, such that command will be + executed whenever the primary selection is owned by window and + someone attempts to retrieve it in the form given by type (e.g. + type is specified in the selection :get command). Type defaults to + STRING. If command is an empty string then any existing handler for + window and type is removed. + + When the selection is requested and window is the selection :owner + and type is the requested type, command will be executed as a Tcl + command with two additional numbers appended to it (with space + separators). The two additional numbers are offset and maxBytes: + offset specifies a starting character position in the selection and + maxBytes gives the maximum number of bytes to retrieve. The + command should return a value consisting of at most maxBytes of the + selection, starting at position offset. For very large selections + (larger than maxBytes) the selection will be retrieved using + several invocations of command with increasing offset values. If + command returns a string whose length is less than maxBytes, the + return value is assumed to include all of the remainder of the + selection; if the length of command's result is equal to maxBytes + then command will be invoked again, until it eventually returns a + result shorter than maxBytes. The value of maxBytes will always be + relatively large (thousands of bytes). + + If command returns an error then the selection retrieval is + rejected just as if the selection didn't exist at all. + + The format argument specifies the representation that should be + used to transmit the selection to the requester (the second column + of Table 2 of the ICCCM), and defaults to STRING. If format is + STRING, the selection is transmitted as 8-bit ASCII characters + (i.e. just in the form returned by command). If format is ATOM, + then the return value from command is divided into fields separated + by white space; each field is converted to its atom value, and the + 32-bit atom value is transmitted instead of the atom name. For any + other format, the return value from command is divided into fields + separated by white space and each field is converted to a 32-bit + integer; an array of integers is transmitted to the selection + requester. + + The format argument is needed only for compatibility with selection + requesters that don't use Tk. If the Tk toolkit is being used to + retrieve the selection then the value is converted back to a string + at the requesting end, so format is irrelevant. .RE +selection :own ?window? ?command? + If window is specified, then it becomes the new selection :owner + and the command returns an empty string as result. The existing + owner, if any, is notified that it has lost the selection. If + command is specified, it is a Tcl script to execute when some other + window claims ownership of the selection away from window. If + neither window nor command is specified then the command returns + the path name of the window in this application that owns the + selection, or an empty string if no window in this application owns + the selection. + +Keywords +-------- + +clear, format, handler, ICCCM, own, selection, target, type + + +File: gcl-tk.info, Node: send, Next: tk, Prev: selection, Up: Control + +3.18 send +========= + +send \- Execute a command in a different interpreter + +Synopsis +-------- + +send interp cmd ?arg arg ...? + +Description +----------- + +This command arranges for cmd (and args) to be executed in the +interpreter named by interp. It returns the result or error from that +command execution. Interp must be the name of an interpreter registered +on the display associated with the interpreter in which the command is +invoked; it need not be within the same process or application. If no +arg arguments are present, then the command to be executed is contained +entirely within the cmd argument. If one or more args are present, they +are concatenated to form the command to be executed, just as for the +eval Tcl command. + +Security +-------- + +The send command is potentially a serious security loophole, since any +application that can connect to your X server can send scripts to your +applications. These incoming scripts can use Tcl to read and write your +files and invoke subprocesses under your name. Host-based access +control such as that provided by xhost is particularly insecure, since +it allows anyone with an account on particular hosts to connect to your +server, and if disabled it allows anyone anywhere to connect to your +server. In order to provide at least a small amount of security, Tk +checks the access control being used by the server and rejects incoming +sends unless (a) xhost-style access control is enabled (i.e. only +certain hosts can establish connections) and (b) the list of enabled +hosts is empty. This means that applications cannot connect to your +server unless they use some other form of authorization such as that +provide by xauth. + +Keywords +-------- + +interpreter, remote execution, security, send + + +File: gcl-tk.info, Node: tk, Next: tkerror, Prev: send, Up: Control + +3.19 tk +======= + +tk \- Manipulate Tk internal state + +Synopsis +-------- + +tk option ?arg arg ...? + +Description +----------- + +The tk command provides access to miscellaneous elements of Tk's +internal state. Most of the information manipulated by this command +pertains to the application as a whole, or to a screen or display, +rather than to a particular window. The command can take any of a +number of different forms depending on the option argument. The legal +forms are: + +tk :colormodel window ?newValue? + If newValue isn't specified, this command returns the current color + model in use for window's screen, which will be either color or + monochrome. If newValue is specified, then it must be either color + or monochrome or an abbreviation of one of them; the color model + for window's screen is set to this value. + + The color model is used by Tk and its widgets to determine whether it +should display in black and white only or use colors. A single color +model is shared by all of the windows managed by one process on a given +screen. The color model for a screen is set initially by Tk to +monochrome if the display has four or fewer bit planes and to color +otherwise. The color model will automatically be changed from color to +monochrome if Tk fails to allocate a color because all entries in the +colormap were in use. An application can change its own color model at +any time (e.g. it might change the model to monochrome in order to +conserve colormap entries, or it might set the model to color to use +color on a four-bit display in special circumstances), but an +application is not allowed to change the color model to color unless the +screen has at least two bit planes. .RE + +Keywords +-------- + +color model, internal state + + +File: gcl-tk.info, Node: tkerror, Next: tkvars, Prev: tk, Up: Control + +3.20 tkerror +============ + +tkerror \- Command invoked to process background errors + +Synopsis +-------- + +tkerror message + +Description +----------- + +The tkerror command doesn't exist as built-in part of Tk. Instead, +individual applications or users can define a tkerror command (e.g. as +a Tcl procedure) if they wish to handle background errors. + + A background error is one that occurs in a command that didn't +originate with the application. For example, if an error occurs while +executing a command specified with a bind of after command, then it is a +background error. For a non-background error, the error can simply be +returned up through nested Tcl command evaluations until it reaches the +top-level code in the application; then the application can report the +error in whatever way it wishes. When a background error occurs, the +unwinding ends in the Tk library and there is no obvious way for Tk to +report the error. + + When Tk detects a background error, it invokes the tkerror command, +passing it the error message as its only argument. Tk assumes that the +application has implemented the tkerror command, and that the command +will report the error in a way that makes sense for the application. Tk +will ignore any result returned by the tkerror command. + + If another Tcl error occurs within the tkerror command then Tk +reports the error itself by writing a message to stderr. + + The Tk script library includes a default tkerror procedure that posts +a dialog box containing the error message and offers the user a chance +to see a stack trace that shows where the error occurred. + +Keywords +-------- + +background error, reporting + + +File: gcl-tk.info, Node: tkvars, Next: tkwait, Prev: tkerror, Up: Control + +3.21 tkvars +=========== + +tkvars \- Variables used or set by Tk + +Description +----------- + +The following Tcl variables are either set or used by Tk at various +times in its execution: + +tk_library + Tk sets this variable hold the name of a directory containing a + library of Tcl scripts related to Tk. These scripts include an + initialization file that is normally processed whenever a Tk + application starts up, plus other files containing procedures that + implement default behaviors for widgets. The value of this + variable is taken from the TK_LIBRARY environment variable, if one + exists, or else from a default value compiled into Tk. +tk_patchLevel + Contains a decimal integer giving the current patch level for Tk. + The patch level is incremented for each new release or patch, and + it uniquely identifies an official version of Tk. +tk_priv + This variable is an array containing several pieces of information + that are private to Tk. The elements of tk_priv are used by Tk + library procedures and default bindings. They should not be + accessed by any code outside Tk. +tk_strictMotif + This variable is set to zero by default. If an application sets it + to one, then Tk attempts to adhere as closely as possible to Motif + look-and-feel standards. For example, active elements such as + buttons and scrollbar sliders will not change color when the + pointer passes over them. +tk_version + Tk sets this variable in the interpreter for each application. The + variable holds the current version number of the Tk library in the + form major.minor. Major and minor are integers. The major version + number increases in any Tk release that includes changes that are + not backward compatible (i.e. whenever existing Tk applications + and scripts may have to change to work with the new release). The + minor version number increases with each new release of Tk, except + that it resets to zero whenever the major version number changes. +tkVersion + Has the same value as tk_version. This variable is obsolete and + will be deleted soon. + +Keywords +-------- + +variables, version + + +File: gcl-tk.info, Node: tkwait, Next: update, Prev: tkvars, Up: Control + +3.22 tkwait +=========== + +tkwait \- Wait for variable to change or window to be destroyed + +Synopsis +-------- + + +tkwait :variable name + +tkwait :visibility name +tkwait :window name + +Description +----------- + +The tkwait command waits for one of several things to happen, then it +returns without taking any other actions. The return value is always an +empty string. If the first argument is :variable (or any abbreviation +of it) then the second argument is the name of a global variable and the +command waits for that variable to be modified. If the first argument +is :visibility (or any abbreviation of it) then the second argument is +the name of a window and the tkwait command waits for a change in its +visibility state (as indicated by the arrival of a VisibilityNotify +event). This form is typically used to wait for a newly-created window +to appear on the screen before taking some action. If the first +argument is :window (or any abbreviation of it) then the second argument +is the name of a window and the tkwait command waits for that window to +be destroyed. This form is typically used to wait for a user to finish +interacting with a dialog box before using the result of that +interaction. + + While the tkwait command is waiting it processes events in the normal +fashion, so the application will continue to respond to user +interactions. + +Keywords +-------- + +variable, visibility, wait, window + + +File: gcl-tk.info, Node: update, Next: winfo, Prev: tkwait, Up: Control + +3.23 update +=========== + +update \- Process pending events and/or when-idle handlers + +Synopsis +-------- + +update ?:idletasks? + +Description +----------- + +This command is used to bring the entire application world "up to date." +It flushes all pending output to the display, waits for the server to +process that output and return errors or events, handles all pending +events of any sort (including when-idle handlers), and repeats this set +of operations until there are no pending events, no pending when-idle +handlers, no pending output to the server, and no operations still +outstanding at the server. + + If the idletasks keyword is specified as an argument to the command, +then no new events or errors are processed; only when-idle idlers are +invoked. This causes operations that are normally deferred, such as +display updates and window layout calculations, to be performed +immediately. + + The update :idletasks command is useful in scripts where changes have +been made to the application's state and you want those changes to +appear on the display immediately, rather than waiting for the script to +complete. The update command with no options is useful in scripts where +you are performing a long-running computation but you still want the +application to respond to user interactions; if you occasionally call +update then user input will be processed during the next call to update. + +Keywords +-------- + +event, flush, handler, idle, update + + +File: gcl-tk.info, Node: winfo, Next: wm, Prev: update, Up: Control + +3.24 winfo +========== + +winfo \- Return window-related information + +Synopsis +-------- + +winfo option ?arg arg ...? + +Description +----------- + +The winfo command is used to retrieve information about windows managed +by Tk. It can take any of a number of different forms, depending on the +option argument. The legal forms are: + +winfo :atom name + Returns a decimal string giving the integer identifier for the atom + whose name is name. If no atom exists with the name name then a + new one is created. +winfo :atomname id + Returns the textual name for the atom whose integer identifier is + id. This command is the inverse of the winfo :atom command. + Generates an error if no such atom exists. +winfo :cells window + Returns a decimal string giving the number of cells in the color + map for window. +winfo :children window + Returns a list containing the path names of all the children of + window. Top-level windows are returned as children of their + logical parents. +winfo :class window + Returns the class name for window. +winfo :containing rootX rootY + Returns the path name for the window containing the point given by + rootX and rootY. RootX and rootY are specified in screen units + (i.e. any form acceptable to Tk_GetPixels) in the coordinate + system of the root window (if a virtual-root window manager is in + use then the coordinate system of the virtual root window is used). + If no window in this application contains the point then an empty + string is returned. In selecting the containing window, children + are given higher priority than parents and among siblings the + highest one in the stacking order is chosen. +winfo :depth window + Returns a decimal string giving the depth of window (number of bits + per pixel). +winfo :exists window + Returns 1 if there exists a window named window, 0 if no such + window exists. +winfo :fpixels window number + Returns a floating-point value giving the number of pixels in + window corresponding to the distance given by number. Number may + be specified in any of the forms acceptable to Tk_GetScreenMM, such + as "2.0c" or "1i". The return value may be fractional; for an + integer value, use winfo :pixels. +winfo :geometry window + Returns the geometry for window, in the form widthxheight+x+y. All + dimensions are in pixels. +winfo :height window + Returns a decimal string giving window's height in pixels. When a + window is first created its height will be 1 pixel; the height will + eventually be changed by a geometry manager to fulfill the window's + needs. If you need the true height immediately after creating a + widget, invoke update to force the geometry manager to arrange it, + or use winfo :reqheight to get the window's requested height + instead of its actual height. +winfo :id window + Returns a hexadecimal string indicating the X identifier for + window. +winfo :interps + Returns a list whose members are the names of all Tcl interpreters + (e.g. all Tk-based applications) currently registered for the + display of the invoking application. +winfo :ismapped window + Returns 1 if window is currently mapped, 0 otherwise. +winfo :name window + Returns window's name (i.e. its name within its parent, as opposed + to its full path name). The command winfo :name . will return the + name of the application. +winfo :parent window + Returns the path name of window's parent, or an empty string if + window is the main window of the application. +winfo :pathname id + Returns the path name of the window whose X identifier is id. Id + must be a decimal, hexadecimal, or octal integer and must + correspond to a window in the invoking application. +winfo :pixels window number + Returns the number of pixels in window corresponding to the + distance given by number. Number may be specified in any of the + forms acceptable to Tk_GetPixels, such as "2.0c" or "1i". The + result is rounded to the nearest integer value; for a fractional + result, use winfo :fpixels. +winfo :reqheight window + Returns a decimal string giving window's requested height, in + pixels. This is the value used by window's geometry manager to + compute its geometry. +winfo :reqwidth window + Returns a decimal string giving window's requested width, in + pixels. This is the value used by window's geometry manager to + compute its geometry. +winfo :rgb window color + Returns a list containing three decimal values, which are the red, + green, and blue intensities that correspond to color in the window + given by window. Color may be specified in any of the forms + acceptable for a color option. +winfo :rootx window + Returns a decimal string giving the x-coordinate, in the root + window of the screen, of the upper-left corner of window's border + (or window if it has no border). +winfo :rooty window + Returns a decimal string giving the y-coordinate, in the root + window of the screen, of the upper-left corner of window's border + (or window if it has no border). +winfo :screen window + Returns the name of the screen associated with window, in the form + displayName.screenIndex. +winfo :screencells window + Returns a decimal string giving the number of cells in the default + color map for window's screen. +winfo :screendepth window + Returns a decimal string giving the depth of the root window of + window's screen (number of bits per pixel). +winfo :screenheight window + Returns a decimal string giving the height of window's screen, in + pixels. +winfo :screenmmheight window + Returns a decimal string giving the height of window's screen, in + millimeters. +winfo :screenmmwidth window + Returns a decimal string giving the width of window's screen, in + millimeters. +winfo :screenvisual window + Returns one of the following strings to indicate the default visual + type for window's screen: directcolor, grayscale, pseudocolor, + staticcolor, staticgray, or truecolor. +winfo :screenwidth window + Returns a decimal string giving the width of window's screen, in + pixels. +winfo :toplevel window + Returns the path name of the top-level window containing window. +winfo :visual window + Returns one of the following strings to indicate the visual type + for window: directcolor, grayscale, pseudocolor, staticcolor, + staticgray, or truecolor. +winfo :vrootheight window + Returns the height of the virtual root window associated with + window if there is one; otherwise returns the height of window's + screen. +winfo :vrootwidth window + Returns the width of the virtual root window associated with window + if there is one; otherwise returns the width of window's screen. +winfo :vrootx window + Returns the x-offset of the virtual root window associated with + window, relative to the root window of its screen. This is + normally either zero or negative. Returns 0 if there is no virtual + root window for window. +winfo :vrooty window + Returns the y-offset of the virtual root window associated with + window, relative to the root window of its screen. This is + normally either zero or negative. Returns 0 if there is no virtual + root window for window. +winfo :width window + Returns a decimal string giving window's width in pixels. When a + window is first created its width will be 1 pixel; the width will + eventually be changed by a geometry manager to fulfill the window's + needs. If you need the true width immediately after creating a + widget, invoke update to force the geometry manager to arrange it, + or use winfo :reqwidth to get the window's requested width instead + of its actual width. +winfo :x window + Returns a decimal string giving the x-coordinate, in window's + parent, of the upper-left corner of window's border (or window if + it has no border). +winfo :y window + Returns a decimal string giving the y-coordinate, in window's + parent, of the upper-left corner of window's border (or window if + it has no border). + +Keywords +-------- + +atom, children, class, geometry, height, identifier, information, +interpreters, mapped, parent, path name, screen, virtual root, width, +window + + +File: gcl-tk.info, Node: wm, Prev: winfo, Up: Control + +3.25 wm +======= + +wm \- Communicate with window manager + +Synopsis +-------- + +wm option window ?args? + +Description +----------- + +The wm command is used to interact with window managers in order to +control such things as the title for a window, its geometry, or the +increments in terms of which it may be resized. The wm command can take +any of a number of different forms, depending on the option argument. +All of the forms expect at least one additional argument, window, which +must be the path name of a top-level window. + + The legal forms for the wm command are: + +wm :aspect window ?minNumer minDenom maxNumer maxDenom? + If minNumer, minDenom, maxNumer, and maxDenom are all specified, + then they will be passed to the window manager and the window + manager should use them to enforce a range of acceptable aspect + ratios for window. The aspect ratio of window (width/length) will + be constrained to lie between minNumer/minDenom and + maxNumer/maxDenom. If minNumer etc. are all specified as empty + strings, then any existing aspect ratio restrictions are removed. + If minNumer etc. are specified, then the command returns an empty + string. Otherwise, it returns a Tcl list containing four elements, + which are the current values of minNumer, minDenom, maxNumer, and + maxDenom (if no aspect restrictions are in effect, then an empty + string is returned). +wm :client window ?name? + If name is specified, this command stores name (which should be the + name of the host on which the application is executing) in window's + WM_CLIENT_MACHINE property for use by the window manager or session + manager. The command returns an empty string in this case. If + name isn't specified, the command returns the last name set in a wm + :client command for window. If name is specified as an empty + string, the command deletes the WM_CLIENT_MACHINE property from + window. +wm :command window ?value? + If value is specified, this command stores value in window's + WM_COMMAND property for use by the window manager or session + manager and returns an empty string. Value must have proper list + structure; the elements should contain the words of the command + used to invoke the application. If value isn't specified then the + command returns the last value set in a wm :command command for + window. If value is specified as an empty string, the command + deletes the WM_COMMAND property from window. +wm :deiconify window + Arrange for window to be displayed in normal (non-iconified) form. + This is done by mapping the window. If the window has never been + mapped then this command will not map the window, but it will + ensure that when the window is first mapped it will be displayed in + de-iconified form. Returns an empty string. +wm :focusmodel window ?active|passive? + If active or passive is supplied as an optional argument to the + command, then it specifies the focus model for window. In this + case the command returns an empty string. If no additional + argument is supplied, then the command returns the current focus + model for window. An active focus model means that window will + claim the input focus for itself or its descendants, even at times + when the focus is currently in some other application. Passive + means that window will never claim the focus for itself: the window + manager should give the focus to window at appropriate times. + However, once the focus has been given to window or one of its + descendants, the application may re-assign the focus among window's + descendants. The focus model defaults to passive, and Tk's focus + command assumes a passive model of focussing. +wm :frame window + If window has been reparented by the window manager into a + decorative frame, the command returns the X window identifier for + the outermost frame that contains window (the window whose parent + is the root or virtual root). If window hasn't been reparented by + the window manager then the command returns the X window identifier + for window. +wm :geometry window ?newGeometry? + If newGeometry is specified, then the geometry of window is changed + and an empty string is returned. Otherwise the current geometry + for window is returned (this is the most recent geometry specified + either by manual resizing or in a wm :geometry command). + NewGeometry has the form =widthxheight\(+-x\(+-y, where any of =, + widthxheight, or \(+-x\(+-y may be omitted. Width and height are + positive integers specifying the desired dimensions of window. If + window is gridded (see GRIDDED GEOMETRY MANAGEMENT below) then the + dimensions are specified in grid units; otherwise they are + specified in pixel units. X and y specify the desired location of + window on the screen, in pixels. If x is preceded by +, it + specifies the number of pixels between the left edge of the screen + and the left edge of window's border; if preceded by - then x + specifies the number of pixels between the right edge of the screen + and the right edge of window's border. If y is preceded by + then + it specifies the number of pixels between the top of the screen and + the top of window's border; if y is preceded by - then it specifies + the number of pixels between the bottom of window's border and the + bottom of the screen. If newGeometry is specified as an empty + string then any existing user-specified geometry for window is + cancelled, and the window will revert to the size requested + internally by its widgets. +wm :grid window ?baseWidth baseHeight widthInc heightInc? + This command indicates that window is to be managed as a gridded + window. It also specifies the relationship between grid units and + pixel units. BaseWidth and baseHeight specify the number of grid + units corresponding to the pixel dimensions requested internally by + window using Tk_GeometryRequest. WidthInc and heightInc specify + the number of pixels in each horizontal and vertical grid unit. + These four values determine a range of acceptable sizes for window, + corresponding to grid-based widths and heights that are + non-negative integers. Tk will pass this information to the window + manager; during manual resizing, the window manager will restrict + the window's size to one of these acceptable sizes. Furthermore, + during manual resizing the window manager will display the window's + current size in terms of grid units rather than pixels. If + baseWidth etc. are all specified as empty strings, then window + will no longer be managed as a gridded window. If baseWidth etc. + are specified then the return value is an empty string. Otherwise + the return value is a Tcl list containing four elements + corresponding to the current baseWidth, baseHeight, widthInc, and + heightInc; if window is not currently gridded, then an empty string + is returned. Note: this command should not be needed very often, + since the Tk_SetGrid library procedure and the setGrid option + provide easier access to the same functionality. +wm :group window ?pathName? + If pathName is specified, it gives the path name for the leader of + a group of related windows. The window manager may use this + information, for example, to unmap all of the windows in a group + when the group's leader is iconified. PathName may be specified as + an empty string to remove window from any group association. If + pathName is specified then the command returns an empty string; + otherwise it returns the path name of window's current group + leader, or an empty string if window isn't part of any group. +wm :iconbitmap window ?bitmap? + If bitmap is specified, then it names a bitmap in the standard + forms accepted by Tk (see the Tk_GetBitmap manual entry for + details). This bitmap is passed to the window manager to be + displayed in window's icon, and the command returns an empty + string. If an empty string is specified for bitmap, then any + current icon bitmap is cancelled for window. If bitmap is + specified then the command returns an empty string. Otherwise it + returns the name of the current icon bitmap associated with window, + or an empty string if window has no icon bitmap. +wm :iconify window + Arrange for window to be iconified. It window hasn't yet been + mapped for the first time, this command will arrange for it to + appear in the iconified state when it is eventually mapped. +wm :iconmask window ?bitmap? + If bitmap is specified, then it names a bitmap in the standard + forms accepted by Tk (see the Tk_GetBitmap manual entry for + details). This bitmap is passed to the window manager to be used + as a mask in conjunction with the iconbitmap option: where the mask + has zeroes no icon will be displayed; where it has ones, the bits + from the icon bitmap will be displayed. If an empty string is + specified for bitmap then any current icon mask is cancelled for + window (this is equivalent to specifying a bitmap of all ones). If + bitmap is specified then the command returns an empty string. + Otherwise it returns the name of the current icon mask associated + with window, or an empty string if no mask is in effect. +wm :iconname window ?newName? + If newName is specified, then it is passed to the window manager; + the window manager should display newName inside the icon + associated with window. In this case an empty string is returned + as result. If newName isn't specified then the command returns the + current icon name for window, or an empty string if no icon name + has been specified (in this case the window manager will normally + display the window's title, as specified with the wm :title + command). +wm :iconposition window ?x y? + If x and y are specified, they are passed to the window manager as + a hint about where to position the icon for window. In this case + an empty string is returned. If x and y are specified as empty + strings then any existing icon position hint is cancelled. If + neither x nor y is specified, then the command returns a Tcl list + containing two values, which are the current icon position hints + (if no hints are in effect then an empty string is returned). +wm :iconwindow window ?pathName? + If pathName is specified, it is the path name for a window to use + as icon for window: when window is iconified then pathName should + be mapped to serve as icon, and when window is de-iconified then + pathName will be unmapped again. If pathName is specified as an + empty string then any existing icon window association for window + will be cancelled. If the pathName argument is specified then an + empty string is returned. Otherwise the command returns the path + name of the current icon window for window, or an empty string if + there is no icon window currently specified for window. Note: not + all window managers support the notion of an icon window. +wm :maxsize window ?width height? + If width and height are specified, then window becomes resizable + and width and height give its maximum permissible dimensions. For + gridded windows the dimensions are specified in grid units; + otherwise they are specified in pixel units. During manual sizing, + the window manager should restrict the window's dimensions to be + less than or equal to width and height. If width and height are + specified as empty strings, then the maximum size option is + cancelled for window. If width and height are specified, then the + command returns an empty string. Otherwise it returns a Tcl list + with two elements, which are the maximum width and height currently + in effect; if no maximum dimensions are in effect for window then + an empty string is returned. See the sections on geometry + management below for more information. +wm :minsize window ?width height? + If width and height are specified, then window becomes resizable + and width and height give its minimum permissible dimensions. For + gridded windows the dimensions are specified in grid units; + otherwise they are specified in pixel units. During manual sizing, + the window manager should restrict the window's dimensions to be + greater than or equal to width and height. If width and height are + specified as empty strings, then the minimum size option is + cancelled for window. If width and height are specified, then the + command returns an empty string. Otherwise it returns a Tcl list + with two elements, which are the minimum width and height currently + in effect; if no minimum dimensions are in effect for window then + an empty string is returned. See the sections on geometry + management below for more information. +wm :overrideredirect window ?boolean? + If boolean is specified, it must have a proper boolean form and the + override-redirect flag for window is set to that value. If boolean + is not specified then 1 or 0 is returned to indicate whether or not + the override-redirect flag is currently set for window. Setting + the override-redirect flag for a window causes it to be ignored by + the window manager; among other things, this means that the window + will not be reparented from the root window into a decorative frame + and the user will not be able to manipulate the window using the + normal window manager mechanisms. +wm :positionfrom window ?who? + If who is specified, it must be either program or user, or an + abbreviation of one of these two. It indicates whether window's + current position was requested by the program or by the user. Many + window managers ignore program-requested initial positions and ask + the user to manually position the window; if user is specified then + the window manager should position the window at the given place + without asking the user for assistance. If who is specified as an + empty string, then the current position source is cancelled. If + who is specified, then the command returns an empty string. + Otherwise it returns user or window to indicate the source of the + window's current position, or an empty string if no source has been + specified yet. Most window managers interpret "no source" as + equivalent to program. Tk will automatically set the position + source to user when a wm :geometry command is invoked, unless the + source has been set explicitly to program. +wm :protocol window ?name? ?command? + This command is used to manage window manager protocols such as + WM_DELETE_WINDOW. Name is the name of an atom corresponding to a + window manager protocol, such as WM_DELETE_WINDOW or + WM_SAVE_YOURSELF or WM_TAKE_FOCUS. If both name and command are + specified, then command is associated with the protocol specified + by name. Name will be added to window's WM_PROTOCOLS property to + tell the window manager that the application has a protocol handler + for name, and command will be invoked in the future whenever the + window manager sends a message to the client for that protocol. In + this case the command returns an empty string. If name is + specified but command isn't, then the current command for name is + returned, or an empty string if there is no handler defined for + name. If command is specified as an empty string then the current + handler for name is deleted and it is removed from the WM_PROTOCOLS + property on window; an empty string is returned. Lastly, if + neither name nor command is specified, the command returns a list + of all the protocols for which handlers are currently defined for + window. + + Tk always defines a protocol handler for WM_DELETE_WINDOW, even if +you haven't asked for one with wm :protocol. If a WM_DELETE_WINDOW +message arrives when you haven't defined a handler, then Tk handles the +message by destroying the window for which it was received. .RE + +wm :sizefrom window ?who? + If who is specified, it must be either program or user, or an + abbreviation of one of these two. It indicates whether window's + current size was requested by the program or by the user. Some + window managers ignore program-requested sizes and ask the user to + manually size the window; if user is specified then the window + manager should give the window its specified size without asking + the user for assistance. If who is specified as an empty string, + then the current size source is cancelled. If who is specified, + then the command returns an empty string. Otherwise it returns + user or window to indicate the source of the window's current size, + or an empty string if no source has been specified yet. Most + window managers interpret "no source" as equivalent to program. +wm :state window + Returns the current state of window: either normal, iconic, or + withdrawn. +wm :title window ?string? + If string is specified, then it will be passed to the window + manager for use as the title for window (the window manager should + display this string in window's title bar). In this case the + command returns an empty string. If string isn't specified then + the command returns the current title for the window. The title + for a window defaults to its name. +wm :transient window ?master? + If master is specified, then the window manager is informed that + window is a transient window (e.g. pull-down menu) working on + behalf of master (where master is the path name for a top-level + window). Some window managers will use this information to manage + window specially. If master is specified as an empty string then + window is marked as not being a transient window any more. If + master is specified, then the command returns an empty string. + Otherwise the command returns the path name of window's current + master, or an empty string if window isn't currently a transient + window. +wm :withdraw window + Arranges for window to be withdrawn from the screen. This causes + the window to be unmapped and forgotten about by the window + manager. If the window has never been mapped, then this command + causes the window to be mapped in the withdrawn state. Not all + window managers appear to know how to handle windows that are + mapped in the withdrawn state. Note: it sometimes seems to be + necessary to withdraw a window and then re-map it (e.g. with wm + :deiconify) to get some window managers to pay attention to changes + in window attributes such as group. + +"Sources Of Geometry Information" +--------------------------------- + +Size-related information for top-level windows can come from three +sources. First, geometry requests come from the widgets that are +descendants of a top-level window. Each widget requests a particular +size for itself by calling Tk_GeometryRequest. This information is +passed to geometry managers, which then request large enough sizes for +parent windows so that they can layout the children properly. Geometry +information passes upwards through the window hierarchy until eventually +a particular size is requested for each top-level window. These +requests are called internal requests in the discussion below. The +second source of width and height information is through the wm +:geometry command. Third, the user can request a particular size for a +window using the interactive facilities of the window manager. The +second and third types of geometry requests are called external requests +in the discussion below; Tk treats these two kinds of requests +identically. + +"Ungridded Geometry Management" +------------------------------- + +Tk allows the geometry of a top-level window to be managed in either of +two general ways: ungridded or gridded. The ungridded form occurs if no +wm :grid command has been issued for a top-level window. Ungridded +management has several variants. In the simplest variant of ungridded +windows, no wm :geometry, wm :minsize, or wm :maxsize commands have been +invoked either. In this case, the window's size is determined totally +by the internal requests emanating from the widgets inside the window: +Tk will ask the window manager not to permit the user to resize the +window interactively. + + If a wm :geometry command is invoked on an ungridded window, then the +size in that command overrides any size requested by the window's +widgets; from now on, the window's size will be determined entirely by +the most recent information from wm :geometry commands. To go back to +using the size requested by the window's widgets, issue a wm :geometry +command with an empty geometry string. + + To enable interactive resizing of an ungridded window, one or both of +the wm :maxsize and wm :minsize commands must be issued. The +information from these commands will be passed to the window manager, +and size changes within the specified range will be permitted. For +ungridded windows the limits refer to the top-level window's dimensions +in pixels. If only a wm :maxsize command is issued then the minimum +dimensions default to 1; if only a wm :minsize command is issued then +the maximum dimensions default to the size of the display. If the size +of a window is changed interactively, it has the same effect as if wm +:geometry had been invoked: from now on, internal geometry requests will +be ignored. To return to internal control over the window's size, issue +a wm :geometry command with an empty geometry argument. If a window has +been manually resized or moved, the wm :geometry command will return the +geometry that was requested interactively. + +"Gridded Geometry Management" +----------------------------- + +The second style of geometry management is called gridded. This +approach occurs when one of the widgets of an application supports a +range of useful sizes. This occurs, for example, in a text editor where +the scrollbars, menus, and other adornments are fixed in size but the +edit widget can support any number of lines of text or characters per +line. In this case, it is usually desirable to let the user specify the +number of lines or characters-per-line, either with the wm :geometry +command or by interactively resizing the window. In the case of text, +and in other interesting cases also, only discrete sizes of the window +make sense, such as integral numbers of lines and characters-per-line; +arbitrary pixel sizes are not useful. + + Gridded geometry management provides support for this kind of +application. Tk (and the window manager) assume that there is a grid of +some sort within the application and that the application should be +resized in terms of grid units rather than pixels. Gridded geometry +management is typically invoked by turning on the setGrid option for a +widget; it can also be invoked with the wm :grid command or by calling +Tk_SetGrid. In each of these approaches the particular widget (or +sometimes code in the application as a whole) specifies the relationship +between integral grid sizes for the window and pixel sizes. To return +to non-gridded geometry management, invoke wm :grid with empty argument +strings. + + When gridded geometry management is enabled then all the dimensions +specified in wm :minsize, wm :maxsize, and wm :geometry commands are +treated as grid units rather than pixel units. Interactive resizing is +automatically enabled, and it will be carried out in even numbers of +grid units rather than pixels. By default there are no limits on the +minimum or maximum dimensions of a gridded window. As with ungridded +windows, interactive resizing has exactly the same effect as invoking +the wm :geometry command. For gridded windows, internally- and +externally-requested dimensions work together: the externally-specified +width and height determine the size of the window in grid units, and the +information from the last wm :grid command maps from grid units to pixel +units. + +Bugs +---- + +The window manager interactions seem too complicated, especially for +managing geometry. Suggestions on how to simplify this would be greatly +appreciated. + + Most existing window managers appear to have bugs that affect the +operation of the wm command. For example, some changes won't take +effect if the window is already active: the window will have to be +withdrawn and de-iconified in order to make the change happen. + +Keywords +-------- + +aspect ratio, deiconify, focus model, geometry, grid, group, icon, +iconify, increments, position, size, title, top-level window, units, +window manager + diff --git a/info/gcl-tk.pdf b/info/gcl-tk.pdf new file mode 100644 index 0000000000000000000000000000000000000000..c397e142cc670a1c2aabecc2492271405e6d7cf4 GIT binary patch literal 398098 zcma&MLy#`Of^}QAZQHJ|Y}>YN+qTV9wtdRBZPzK=?{>r++=#yiJTiLprIWvme8o8Q@nwdD5nlZ|n*;}|;5;3!K z@$x{(u45sb7O zt-sY`C=zD66frs1!Z!HWb{JAPX%;85vV@^gWG!5Ec_zKFsZwDb3DP1WGvRc&M+1iHco9obGlarMFF1wGkByp2@L`@b0P%d?^qn%YG`= z#(y{Ot=62p>)Km)lA%uSdurO^+;bGg?-FNM*Z*b)^cPdyCEKJ>E>PfjCyGVkz96y| zPg!FYDD>3jhRjzUyAfN)cDV`O;|p*#iaZIj?q<~>k%SRZR>Sm@Bi~|&l)`n^uDwK) zXN(kzb~Rq#7&fl?6$`mg|cW+{*|Ga>dYGhd^0}zo;BYLicPCe zTsZqD=k^{~qkFG6Mi>Z_R5C6~jNV%?SuK3h%K1PiE;$9H9LJ?X+C z$&y3eU(hM99#;uxtyZ$*NmO?ga8bILuGTNV!(!+oYTh+DiS#%dNx?h09(6e|Fb$%o z$dE^xMZon+wA}Gjozc>HRyPEraEpowh>gi_EF~xD)RJRFcw6|wMcv)uzdn*0;bb=^ zAK!$G7vQ{wwy#rhuI-pD%4UKkq8-ZWIeMRr6BGRh&jF@j14#Ka zf@&z9rOQ1K}C|ws@=W> zn)-7k{u*4)_J@#4oo(M-l&wgp>G2Npo$y(X9LLnvWQ@hU1)9RfhijDgiPWx#bm$ho zeEs7e&?15mL|#WkUDXH#3TiNk>n}DM&GI!!jadg!GvEcojI|l67-Kp*LdKXFGs($7 zmNK_Qb^=|^eq3juPI}5*c7-Nlw0E61>&LolcM*voCdo-b*iI-I{sqmk5fd3x;W1%&AO|B# zT#-cxE8v1^(2Olu>R(HzDe0sA%Jm9Rukg}5IBsrXQgV9z<}$h~z4wdd|I|;r^k}fH zfdZ+S6SbqLsE#Y9wScHv5_rzx1Wg}m7;p*P6)|{#_*<<#T5;y0K^FD-I`QdzW=ZA< z#h@4EX~7t7rW+7*NGk0!%^sBFB!Wlt%K$}QV4ns{_yV_t(=~0#x*O9>C%v(ba{JnI z=Ob%|CI5v@Bbxvgcve+=T=%cJJL&H1Z&$WT&2~n?*#$1C7HRF1xYEQnyxEw!vbe3| zhivzd2|)DR5T116$Q$Ri;OLp+T$m*(xie1R^ZHzPyxT}9pL5_|v(1N|Kw`MN&ha2x z?1Hy(XLn@tIe*>zCI7gOxVkbpeH*cn>qw%XWs9|eNs$|VfS5u-v(lnl*w(wf2agsQ zC*+DuHaE&<3!8)8fVim=iGH(<2Sz=i5vczz%Q02Tz9@eQOfAEb)||ktClX0*q2kaL zAA6ln&c3}JB!9|FLI=S3YS*>xccZL{=A)6J=-n!bx_Z6VBq4z>U{ z{9L6gC!%R?yZ&3CI2HqRjAe^Y!!st1q+VwFqGfe*BhH3SVI4PeWb{(Yv3NNOP|B<# z=w`HypvcaCt;`;hg8f281OO3f(1GITKpl<`Q!$EA0xWX*@i&eX6MLRZX_63$d3E?&;~s!5R#f@_WH5m+^==K36vVNzN(1gk6;xIt58HWjVWta2L^RrWJf z=zYj(M&4o9`kC4Z)6jve+qW>cJjWS@f4;H(et4F?{07dR{f*?3MVIkR)DR1Q!hE2#Dra~HG+X03FWUYkPALq45 zG6-B6pm7b=vX!SJ%8;6!8&1t0@-K< zlnKu2VP%n*(1;{JLnx09otx^rijk(#DzL*RxQoy*;_}_l{X2OhXH!M_w=XEom2SG_ zmHth+Om+nqpo+yLl}ev<%K5KpzniD6cDN#Uqaa%0yzLOh{?GA&JzD!Y2orZy zL^}`ro^7Ow#VGj#-TItGXZ$~SeTW+V4DYZP!!euALML_qC@Ii!h3a(Q@fNm$^Sb4q=-C@D?;H zj;9)iZ)U52=+r_qJy{urHXrj0I2}dti0C#Y$1WYvHEx4KQ<NXkPqn z^KNH&r8G11w~%9~v`NcImbugAlYRjwoc5JpB0aa8fX;ebzso&RCTA z0^4*y@8x^I;Y*^d{|h;D{$I$Mm5G`2zsb2*dn9NuqEgYC+B@yOUoy@`C_9v}F;MAhT`aLN(y(3q4N{VyzpA{A4;_5m-BP9^egAxnz0KnvixThrS1Kih6uA{J|gV+|?76S-NfPYBoo$F|p&UE1e zZt#3B%psVdy+{&yJZNf1z1I(ZyPdMmMoX>)NPl>gmpRC76|C;2!u<=@wW~xCRzE{{ zSd|xM6(5R5LR7fJ#$SGVnq>1~vU+U=Yr~q}kHgqT=*XgU$$5{4>g?>Rd7!e`jWAs0 zWsz1BqggGUaWH#x{vAb7bfZd+Y7eh6eA_r-1eWY4;|EJ3{HPrjf#`c>1_n*QvOW#I z0x9nwK2I#fj1^ygcvvdq7DDKg98a?jQ?}ETm!E<0+v~<9{N+*I*F6DY*76V^HZC+6 zwd|jtMV_49_kYPO44H>dr00adSHv18R4_?Ev39MqXn-94V;#=NEhmW|E7SAdr6%P{ z0pRT@zIRa;mkj)R9!ZN#vF+^Qe7Cnb8ZS>vQ4pb}F{3se-M`CZZn9!`E&|hodIpAl zZ&nCFEqo}iGx@EUVPNJOPwbn!SRh|l6O`?Y3pI39@U1Y|@$7hRwKBDWp zi`p@OfCm45iU-DWs6z5|N8Sr`q(A`fGGL8Do&<}@&0Zun<@{%ixd=y=f>g4SU87ps zcnoa-`1>7g4zbNcqNItOT?V4=D<$#_$(A}-3BaTPELF%JUyx)2fgSj&5r`yz?LboP zcy&yiL67MEBUc$<-_!kloS``ljz?mCvKZo^c>eW(pUI}LC~o>Q<|l(ln}5SeI>CJhN<~_d?wLPEpx#HL*O;sp z&XH@Xm(nJh&*cZ?f@k;(p3D>g2FnskDjWWh=qBt}r}6br{(V+T`3C10VI+`%XKJBn)`FD4(+-@OYNw{=-mEa_nsn^0rXv zuV$P&aCZAz>%o_}fkZ8Nf{I7IGH41+W96a{xi%5IqLo8j=$2x;3;aa|D6;2nWQ&J_ ztLiG%`kZtV8}ov@;F_TcMA}`5{nWyDA!n`7c}iBF>C`Iw`k)DEhLEgqKQI5OD>4A# z?jSO$m-huyg(#hq7 zJ^w7JBC_ohLx}(EHu*8jy-&l3e0N6Bte_%5TXwjN1rfYOYPwvnL-C*-wjW+wQzQvn zbrWeO|K}aU5)>JV(c|H{3mHNkId*#NR7f~<0&$(So4N|5dYfbW@H|<9T zb_l)8{2ZN`p&7xfl%|A~2Xf-KJJ9Vp?S#Ker0lO+pAm~nE(VwkFli`M8ux}}EieHlVX5#Szu77l1`MM{|Z=#%KT9~7! zxFSKE@yES#_OJZ2qS6_y2#rT+Om=I<#Y>;HwDcKYr3%w>P!Zd3V=n2gYNL=b|FcQK zKWKzpEhD)GYAPU^p{6S*BilP{TV|w`2mFrR+BF#Eb+-2m`)QP2B6bIWUBS%C~y}oxRoS#3}mk;m?z$zw>ko9WQs!uT1*q!T`cME4( zmf2@9CByDl46Y@<@vpcN+@mK1O>CD{vl~0(;F4~0kU4_DnMC2=hx?&uU;Z*jbA~i% z4J2#C4I2!W9u66;@Dz^oCS)iuvMnR1(?)apd6r2hFHYetJ?thY!WJgZ^{nvan)>k3c%I*Q>EK z4qNDEs@E9$PJ(eR!KEiDilExCDw(`O4X9fXZnTbm}@O8bhdKWv*>1{%2a z>L4HPiuFdcw$)Eez=Zd!P+hu=4a!LNr3Hrw`0?GA<;uUbV4-31;`j(YEDzVwLyUrqBy4q9boMIv} z?gJdX3(pz{`vF~wpg_QdGk0>stn`cbW?zP3ft2laMTbh1Vod{ zFb|+W7@a67!?#>TiN0$lZ#{A4ht@PUhFH>qiJ&ziIqvRScN%HH;2+)>)&OJh22%R9 zkB;g)tk?h9R^FDD`i%hj8|lW&!7RX2fW^Nnhm=>g1PP2s_ntR;mgW9cEUuDKx+u># zO7?`sdIYQ9FvYM4Qx(ERJ)_V9%w5L7$5~SWl2Ff|r*! z_jRYhL!Hvd78NOG2|f=0Yk%O>sEqDg^{M=7q}3-6f^_EN zqgC$)SE6Xr!w8K!+h4`~x{+VchcZP&nu2?I# zxyd+unD3xBxuOGmtYnLI6GqvCJlH6j7pbvxbg_*-`11d2mOf-`$BS)XK|z&WbhJ9= zXIrGBVaS?ywg1EYfao^0cRw9Nhv(wxZ>yq)p2H+l1GYYM?vLHR%t9mUM$>E_V{WOG zS`YfyWGjm0u>D6lp``j4P9oafHki|-0Yn?4Y=__kj8ul$p>uZvTFA>OWAcy*B5z#} zCBI=@b10_EM#V@25)+cYj4=G>u%F^Os=H38#PBNL4et`BB-}I?HfdCuJ}QaOCMlw= zRD1x0N|V2s3ooCNJw~$8rF1^IE^YJ=f8LpEoH`{pX0vE~+oaK3yWzM&Li=0uefYH| zuj~w_!1wocLC5=$2jfowz?n(~DOlLz4xw!r2f&7giT%MQ+y-%8(kQ}>}-7ZER~AZO8(EY0janCRnD(cr(YMRufvE+ULJ%&-Kef9&8I6J zIp+xImC@&HGf|xi_Rju461qKNezdX?L=y*}A;E3Fo76~vO^NS|WDwzscoz&O!OhK? zv^`<1P1H24Gt5`)5xAHszIcCZ^*t}TC`B(JZ!bj=MCXUc`0latoA^{Dgg}9b9{iko zjP_ir7l2joH$^XrnAfmdndh3MmFIiGHV=3n0S)Z<`kMCu+dcUyBqEHMp;Aa;l1?2S zth60P6!~?cwX}tEV@`>(j3Gn3p(1TZU;=Pna73=fsT-xA(t^?FkA?Ayfh}Mi=)$(4D`zJqclF*T&43?m%4u^J$bXOp)@F4{a#W4RWishAJGs z!Hij&m}A{vP%Kp+nFh=)1)`mF&Zj0PoU#>PoOcln9odqS)pBS!Sl|aLtfs4e3x-!g zxmk*aoY;Q*VeOf3Ll7FRA2VT?o;z_*NPxBfAu%==wyzY$k(@~QITXK8SZ|M~NJ~!! z3|ibtp;~zxxceU|nH9vk246l88UEXpDSI-wm6%YRjDQGNth6w?*Kx!o&&$q|InEYS zBYzyRFM}Y$fTdKvaiUW`g`${o^TSzVMGmbJVu7}C%fVR_1%g|? ztX4^Z#f*boa`yxq?MDs!-9hE%J-?3FLb%dtkYf@NcX>@0T;01Qx~CwiD2@@de{5Lp z$@t<2EGZGfXX&835b^KuQlQnSD_OJ}`gU6yDMN$>+s!3Xd&`7W0D!NQsun})U3-?b`n+8q@>>aYOtEEPv60>vvBR>IMA#o5} zBv2r=>=x^<=G#US=C69oAOuGsXeXmf6+5VbcaWq#PLEi+vcYzL^(+WMBxWoQ-!D@d z#y`L~`&<^GjWGi@DM(!8LMY|ub&$(DyZ`Cka+AOnvb(s-PWPz1P=QFTm#>n{AwCP+OW6ps?=kH9$twrwF z7A3at+OyoVFokDpWMAYRtVxJu4{t11 zqiBw5zqO$b5<7cxwyIl^#`w9ehR~#`+4Nu87)<3k7o(5;etr^Tkiu(W5Lt@H1k#+b zi6OSvG;zGiSk-X`JC^J1E(wKS*-Q)C?xqCUbb8lddm3uModfFyG2I|?#1nDU!~V?m zR)ME16j%$^Hw)dMEPJAe1@KgOJsd|5IxWl*shGzG(eIz2D1mMvwk(BDUd|iX;9x`m z>wS3UNx6#L0Re`aecpR+<(#p^Ga%TKZ*69hpp^_^d@KSB1r&>UoXjD{wMneY3Pkw( z3{sO&1C+!yI5`mVaRwy7F?N8=1rLh?(-x{6&ClSGjwS;cDWuI6wi76Lk^W5u*vGnb zHHzHH(@S6`NqCUkcX?@5Lk3kBa{dwf#krFdjBqsAeQftj97qowp`LO~DB~;SlZi^d zi&oFaE*0#zlO@*r_t?0{JAN%cCOV*AS4%^lJNDjNE5?P7R^!eBWI;C|xzL6Y{}Vxm z({X!_Nr=p|Ge8X`bi0@bd;62$h(}Wy75!`eIdsy?@lZoWnrFRnU#W?smB^HciDA1F ztuM1*)eG#<;KODM=J-rgUJJk3zcW^lkRHbG_j2a+(Yy(et(xsc3z5Z(Xp&Y_&;$Sv ztkEYtUzsLT_CoFXOho`?CpJSRbxy%zY}qbMl*~LXEVYqgkF8fA64p%~E^vvOePCiS zaGemheg5a0mFRf@adePEa6v)C41AUnBEgzhKMu*rSnr5AAVNKq;NLeASIJf}BBz*z zPB!EgiS!>8O-<8=FOzZbgQmB+S!l@*|*C-wS#?FAw0-D@h(yr=1R zpIb*73HPHEJRbG6PLNcU0HR1YDxi2T>lH#q(&L+|eUFwe6Mmmj6n92b_ZDD!jBjeC zg&92Wo7=~5)4tcs%uGVaa}<%2Q-5=i|9&vv3c2a@W=)%z+Ez64h57`NBZt8{G5wa^ z&}dRD(y=zR*k;dhQr?f!qkbOA`zq_AsnKuh5By1X_DCmNmRf$;I+AA##@R!qH_E=p zJdl`OUyNfNq$}oho@9&%2}_Wv8)NcRRyULSwjUcUk$&vj=pAp5C;B3Xj`I`@0}nK@ zFXUsRZ$dfP7qmCNyI{EQrkF}g*Jni1F}jc&#MDAI=UDAM9QVe;j-B&>V<0F7)A4jd z0k#20_a1MJD7A|{CC-7|D7HH>omd$Azz}LcBGC@L!=zV6_&qT8(f#u3_56-!EKW2t!k}O67AwV2 znr11&xH>Esqzlmhbwjp5mTCHreYV(RpHjmc8|eB+YqzRlKO}7`D>i7mbz;Wel1;Bc z5*7R`bflxDc&^8<%J)shgYy|a+SLf_^I2Gv!P`1Ta}JM;43ad{uy?hJ@_S!sBY}@O z>8&6@czELv3}d%jb)8CCKD#9OizLkX4HjLp`KIU zZoByMs(%Pwg_O7~zN~wvYGL_DO8YcXnwb?@LffEMT|1X*)jY12-t>8WWn{8xX2C6e z#Xh=qWSCTeYZb*vHv@WW-;0!cFt@5wMq1J{s}63}e%eRSuo95o!Zy%>q;|Z;_TdP6 zq7qBTVFpz}vF@PvrikC0ASSr^GB zjVU`r(;T!ytA~w3uLb@ZgGo z)Ce+SYS-S zfrY2Sdp-9Ll$j_uZ}kPmeH6;-p3kXwR->N71+>0z0SsRrw*u>Qz{fDaG3J3$@xy9p z$6$RkBSIIQ&|(NK*)XgqBgk=9!GY07@NY4q!^Ss@Vb6O#LXu2eG|g7ujd7LpLFW;# z0$)40CdAYoWWfv)VNkHp6%&Wa`+f@B`P6>(Fv(7_JRRbl>Pv2aqzasR9cq@vgi^E% zYS&FdWtaz%5hActtT@6F4X8Fvu&x+@PFZmy50v#zQl5g>;3zL*r$(a7UL+>fs)%$Z z%%f)bRuOqXGCmFKePDI$zj)&s-cVspj5L^{xY&(12n}{2)%>^7I!V8w>9fleIcnh~ zP403_?O5JKMLhqyQelcw(C2}iVp`p1zhvs1UNtpUyz5xpKcXrVR2o?LI}I+1@>T<) z4#Iz@WNFQ;r-9D0(xc``rmoMX|wTkoaf%)Z5~^q?pzC#v8WGZfO=9nD!9QNP~z<~nd9SR*)`OFDQP!_%gg zr5+(*D_{LiG}b`^MX0K_N*+Km%JM3(f(7%o)nJH&;E)s6Q!TZhGIEcOxf9bRLBZFO z5GmQg@1UAW&F2j&d7vo;h6X~OE|+UA;C9;>du`dzW^_`5P2TA8rDRmHn`9EMw2Spv zEsB0@@n@eN7z;E0ToDte`db^5-x!2uZn)F+g0w6%Iv4x*3EphCVxhnQ*)f-h?t`iv zI%efJeukQP*h$rBVcxRKJ-9m@o^RU9Q&ZZAVTYS=yRj=84PKi}%tsJ%DJ8@}L@(8NhYRM-F#o<#eU#FR^S59@-w9Agxe>-ayq=%G} z+YnMm)4ne|T%%a&t>z#%MUO4Y`_vx5e^yu%gOXY{woHHfH*>fW?OB1-)~g4YI7?=i zLu8NhxkY=lOdD}ri!T`=$>8x#)qgQ<2V`>|)e;;CJ##Gt3)y_g$^2MJS35KX51-(lV9<2#7cA%)*$d1HEHUaU&~<3)d|N+J^TIO0JFl zg0;BkWP9~9t65&R_~75$V5`hHQ1lI4_x+&{^#?(*ab~vupP&$1@7`ujWDD$=?Qf3q zT{F=&FVRtPtk!D>;EbdhZc|nNEDV)Bn-+t7Wr9c(g=!eb%ghY+6NNjMs<8N7#+Ga3 zH8F`CSqb&m&0`hGmOi9sDRAgQtfaR#O{eMP1>5r2OcYq$u;ra6bt2||XK^>!|(lw`0MY*YE3dEgNxcak(29mVmpO z1^nE+cRMYsn-87O7E}!0qVr=VWJ-^OH~%KvP3JnBu-%yhcNv{)n+GKNVBI!iZQlaU zp~?CnEn4Ge>FC+6xd59X3ai40#1gs3aP{z43JFDMb5p^`+if^wXsOb%gjAG$8c*^M3)^|I>zog`I=-zd^QF zYb*Y^4f%gI6sIHBhT0g^mmHCx>oGM(q(MfeAOipBkm9rX=xekuSIov9lN}UxD$+-@ zd;7jz9aPaUl!`doBjP4GX%Jvj z9PD2mf;A+32z1+bMx5{}a;|5wP`}P`);7F9UtZ4Q7OXNe(UuRNLQVJjFyN@7`a^;3D-I4s zwwy}vTfXE^q@Xy#;sC19_1bOaF4qtm0s}K=6qdNY z6a#@iZFcpw?`$sop<%P4P^r#e(cVS*JB}eDF#YIh#9Xy~Av?62;}S?lhNm!dLoynt4z5Af|F)Vl=IKkBzpZ9gL1 zDm@I_4I$n|umSx&uS#B#wNHi+Q3xL%I6@W|ay+Isv{2g|h{7!8W^-x+q?FXa57eJH z1A{YY0O_GVjk(vn^0L_x@O)MYtfjxg{C0k`(_ZGuzGdjZ^VJ?PMSmmvlid_ELUo;= z1Wpa|(wYwDOmwub^-N#_lZ>5eY?0B#_#xGB5%9QWJGgVh9JLf?c{~PgkZ(3f2*Vbu zPpC|>rk8ha)m;POlPV~$79@QXAUKL!O`j)zyhVfuB61`|BG?3>TrkBq$>?rv*3#pi z5qoa%mKh06b-j~Y?({9>%Z^{ER0NZRpQl_;5Z$(5mQ7j ztby@Gg76&|8BWB8vZ1nJ2U9SE;#u$(TuCEQLy)2E?Ce5U!PkZg5NmH~2zxm3LJBub zLzWEIPzy@}fs(KYVe<>3QxHRFRfX*FGMh`?!2rC@N1cf{zy@B81@V%Av!H*Jo<;t; z3pWH#4ziur+DuAoaGZ7 zu%YjLLh2;Q+ixR6U(P4C3^Dmad&7W+YSHNi+e4*h-r3~m$wHlKZ6^H5iT&)a-cZCANHdmw9^h=*-;PqT26es5Hm zw1IQ5JU@F2Rzf3qwBM9bfE?uEHDcrM*htLAzcDEwljQrWoD5wJ(d-?_Pze2sr8GZ6y_%q_osi zVNoT8R%WxGjm1=<6#G#_wgy-GK3YZ(#uYePEUva}EiwUQJWaGH?Wa^{D$=e@#A%Yo zyCO}IMDoc_-sCCyjUchhU{!3AD<~XTj7&=6M-)$)j9c#hTr?gia7^m3(5uErzGr-f=gI0hgpefYEyWCOos;Wi;uLD?K&RB&*)MH-z@FG%JL#6S z@}Z=fXhYUju6?!7DFr5>Bo|#Wk2OFjJ}+v_M&+O!D-+O$_ah{8# z^#G5RpSkV(%o(rgVtl>1WVMMkpxTo`1z^mcC{ww9uAq@EDRO4d-T9-6cS3q`t1B}) z&C2jb@MaDe0-K=n3i@E2bPu2JM<_vTLq=bO@8J`n`T^=z?P$VtNvSakU!!^zPT+)m zvKb2TyC}OowjU~T2h{^#7MoCVs2(Gx2t6AJtGY0*sQ9vGySe}-Ix>d}pvwRL?>!qpqr@^;l`uu$>c)_u>0fi zqJhEvM<8maYu@Pd>sDS^-&er&a+r+5vqTBl%3bEO4#(4LmOzWn^MH!QBY%`68tcawThBV;u z&McT*9?fV((+&Q54drD%Wr^enS#IpZxx@W4SV)+@@s~aVSyxip7N{#l6}F;3TAy&z zU=}q!$zZ+cX@x+5kWb{xtr#jRpxN`<{QhM|l_fe|pe+7P%F=U=ry{hRgqkUX(jPNa zB0`ER;7?#2VO2zV@Kj%r}Otp!BRJXQCnP0>d7`ppc_oTI!#|?#ds*- z+7?;MU;E1BiO%ee-XsymdTN8tU;Yvgy7jkz?-7WLPbG$-SWpmFnPV;Cx!-|Fk}AQD z+YnXp*ajk1T0Y{tl@Olf%l4r1P+BY*H7U-fK_isnK5K~Ggk}WQu3sn8&4h9UGZ9xX zN9)JhIoL3*1%E?9PA%E-4~#sXH<9*Yqvt(6BrY7R$N+7^;Pe6=VR-zRr`Y{X40F2d z2>Lj{ikRloYx(iHr7Ys*&5O&c@!y!n8&@&Z&j!cJiORym7$!c(4^N;j53$N{IS`|O z`wEj{eDGj+*f-$hcfOegRZNAt@DV!foa%i`lKFzX*~l_IGO$JOn@egbqtr89wC0CD zC4Axu+mhvV1CdYAFMs2>e@&Qzp@C`+;{qQ$oSZpBOVj*D!T^!B0TQIu+>18N<*a@h z2yvH%(2BTDw_s^3gM%QI*(3#IJrXVdY;d# zJN;)rCMo3&)NNEB2HxOOk$&m(VeHpd>bdvj!> z$RIx~M5Jt69X`?|?c|3>gMuz?5;Jd#oCq+EY5wY}tGb8F_B8#GyAqAgpgm8uTXlim z8h&3kTKsAjhUd#u|35KlZB??-D{_z2ldA;|{`wor)iu)x40YeVItJP{CAb3i_}2k% z6&l=1920QC9dKuiDaz>FMLG>leX^{m--i)=K;uj2M_nxoMYR%pt)L9#3vS(QPEQ?e z+?RcIwNbi5xUYWgM>+u))!(CQA%^+Lg!K$=l`Tex^%5OQ!$}hRVevq<6D9UoU-(G! zGA3gZ?kj7p6C}DbQx)#tn(yfes=d_^{3|Tdp=h?_`2qL;Ie94)?o~0J1_% zn`6o4=bkZu+cKfHent0Aoi%Pzlg)+M8(OuiG~e#uhh;CP`Ou}9MtrTs5<#ZM z-R!Ks5GA9BW>|p(Q8{VcHj{8gf&_BwSLgm&VnoS$td4F)p`pd6HZxm_kC{Ln`( z6)ZE0$|XS&8QGqXc3p9e!Pa53kSXM)K$a-=G(!T6!{)r07Tdt7he^hg1^g^m_PV$*db5! z*vTo)7}{4$&+x1dRE9i`e9nfwO8NHqEmGKfKoTa%PVm(}=6p?#9Kf;SKZjTriLj3| zX0+xMNV@EcQ5^RsRfsDElp*oYRs}zWXEvqKUPja_MD;!QI_>hd@nK@!rj~N zkdwFpeh^}0#1cJCJ(6;`Z>b9y7&~e|L>v+iJ_1PA9z*8Kiy&yjhoC~mMfBKj_d%u0 zLp8Jhs$fYMWi{m#_`f?owu@bd34-V%tqf|$uQOFj0V<)j5ueiTR(-2h$tXSV#@*qh zUiNXznG6^y-n%;Nv08V=IpcTXHGE#Tfb-E<+@-0UnKAHWmFWl-rN_yRoon*R*yO(NiyjxH*4or9)d}Q5wi+(`lqqvJ3)Sq%Bk+e&(fjrPV-sLY4hc3r*A!bA!hM zfP)^@sieJMfexZGA*xrHDw&?{`=Bol8cmr|J>sRR8eaIa;8NA_K=0ndnX`!aHDQ%~ zW{hTsCsehVD6ixw8pH7JvgqWk+Q&(lX=Kh8JD}tDdB+1+T!3F5M3t{`@4?mL(h|sq zL6?BRye6_k{JXX4=tK4CC-p<_9<|PUymgN1^uxPu#}7u$ymI}I1|Po$AGa{yzC3_; z-%pMS9w5{(ywl@imR;&*qe-f=M-@PJV^O)n+mYgS2aTQoq$F;~q3dk*OVW%wDaQ!= z0_Z-JAPNKgNQY&Er@>bhaFm(Ge12VtzojkC?dptCW8Io93ns~kJ3|u>n7-QTw1Oez zS!M@KzEB#3$;a3}Q6G*U!>C;7=;Kn(Usi@#W~c$NPXXc&XqlS&>A@p2S1p7)94$0V zS%sdoSwkTKxzl88Lq-dC5KRWt%w&|4BvU%MD2nYP4nojF=m_$u zkdB8av1!?4V>Rc8Gc|WuR&osfvv@MVctzF2!>SqQ4*H%+lfpR5fsTmfoV*dQl5hxr zfDyv2&jwM5L>v``@UBcNU^4BrM1%OrO^A;9c6A?k$U`Y`VW`>pI61Ez9gD4mw9gMO zZyM}^b8LbzBeb0>R7#9e;b7|dWQtd2AJ42cpW@3DN3{GD?z+wt-B1s#n=<8d$yU}3 zxL*rWSFIwUB(W7^fF-;&&$pG1sI)VUFQk^SofUcrRcB=MgT85`RjOZta&*vC-lk?i z@RXp29C$hiVCG=0vfZ2$n~AZE&LW=-g(&|ZvJRDraDcWhX-zQK_n9#1p;?@*?s!dViFumA~aAD?_ zm@Lk94{DdYlm=oJlEU#G&sP)i+8B2vckh)?ylX3`LN2SM;x>Xwi zHx|AI{*$dTm9aNZggtv`z~;yWU+CWxs;b8Mc2b6&yn%a8aUj_4_~+fi&0!gQ!q82? z4N&^0aiNd8IS^#I$mYo80OnX5HyLy2voQY?WcgNWm|0DNs5W1|&+!nMdj9?hp7No- zKYJuq^Bn+o!`ca4Vgdzje#*4>f)WLN?*3zhD(uc>)sls>C8X=$1aZ)wxVnwGKQ@x6N?w&GrzE{6R8*U$3$p}SSK zPY27|tkbdp#+%*pYeWW)gP?G&B`aB*|8#@;lnzQ*4Hg>8g}0~Xf`t9uOgc4nj)NA$ z?R%biiwVy%ODU%|Vu-vCg4+O}jh-@lOY1#2B9kLjsa>Y>i9c5j_?!uBLHfb<2uMul zfr%FWqDM(|hJ+Dd5BUEWd#5c?fF)S4ZQHhX+qP}nw(aiSwr$(CZQC|y&%>-W=ic*h z>H})kQ$=KEL?jmEr(ci8_o3V`7-5tQo{QaT+9U2qFQ)rEX_^ug>&2Ntk&`!xsxShP;+cFvdHSAYx{UiF;nm=hwpPA zDCpR}vEM`NyKcN^5u2AZm)dOzd*<8u%V}|UYW`+;5?F+XXewFJO%?wL=b1}NK?Ay(y?0HOK>glJ>3S-8<-#uL zSUuhgd*U~Gi-#i`2!co-waCw^-uY>BR?it~r@RRT+m=Tc-u?j)52c&*yH&BJ#v zL%tKPEN;w3MhrUIcD%-{wvG@YG=jtuGlo!u&Z?&|ZP%j`4U#DIYYIvXIi(kX%cen{ zI%d+qgQ%rh)h(Rc!;iL-K25t%6$(+i0z4oRbLOSZ)-|1by6EkNX=>UHEQ$t(EpyPp9-UVzMsG%ym$L7D$8+|c z&uU=bFEn(Cf`+VPKe4lMA*9#YcO#bHlE4W5gku3O+Lop=#8$<634|=Px0c(P*u8Sr z6)yc@ij#W%{Immfezx$N3vPFt$LCz+g8$KUgNNv;6%(E|6_Z7l7sk`xqHAkh?}-Fl zc;nIG%&uf93`;hlQgd%x!7lDv&#DM3e7Y9oJx(MM>guJ;Ptcf zvH}^~(PyDd+&N$}$)@?sp%S=KBss@W`sg3#y*>bGca}FZR|K7*kNGGd)U{ut{OXG? zqzB9%hcb4a!|C6a`q;FB#E*`dCb1{@MA6}te zs>T13oXs99LL}M=szGU1w1tm_eVG4Fp^XQH&h>o^qmbbsY-1Fz(Do9wN{gkzG2W(O zlye@H4U))}M~-7gfXb=_sW|Wv*h&oD>S}q9*`dl*rN?x%B7Wp*jn>2|_qOu6KkeFA(taYvdXW;fINFS-LoMhlW z;Dg+F&kz^=>0}~|xUd%v&Dnr+P#>Xn5pO^kuY31o>plUjCi?x~s2U$_4}4yx$Vt9Q z@%}N7VKT`dgQ=JUmMp@*XQZa2fGJqJn?oIoeNLVz7V0)F&>5Y7@GIyUot<&Gktr3d z-a1PXA3l4&I34b{d1soLA{Hg?^|)!5NOJW%p~plYwa``0H~io)$O3uIN!}HUeWb7a z_I5nTIybATbq;A9ka2JJwwXiD`xQIA+r5O-pCh}G-L0L}NC)i-b<~TAS`GGA+3V%k z>ACJMN0kJ=9;^J#l}`NWNj`=3pC?Oa>yx5MUpLF#y-0N+&iiS<^G!CpbGPMWALU+$ zW#qXnMLmSua&Us%`pDZuW)EBIxB+ux=^ISx^0y^BT#7olrkmR~fQ*j(j9P{bQHv@^g;xVc@h2?Ap|XxBi~;RIf1xo| zKF4ksOBp0V8J^6U7E*=xi5s>xf_ha%U7Xz zv6F}ri`Rzq*mn#-QKGy{PK$vdexxpY&q*tp2>oPF6-6bG91oCNN623qk3i=7?^Q`y z)Kza|1X!^`!AL8T4zm}tbr6rw3k$4&TAw^8hCMzIsRrtyK7QM9nPG+oz%G|)yRr&? z*HR0};6ZT1zvrcAHtYgr)IP~E!s0|u)y$I+hY=+M3zFRPrx79?l+x>ndE|)$vkdd7 zx@JE3U0q*$LB&@ue}+UZGK^|fzoHv?BQ1TB_Ut&zp=ENa*`YuQ3Xce?=?@z7QwpNQ zaxXmyDG7`c62j4i!!dK4c(attI0_c9ORS-zbSY<{uA7qJx!BKuq59BqT?#7iPJ!-Q)@2+@dKo>$rXFML0GGw9p=N3RkGM4X467vf>a-~KZz?%#F zwT9lG^oeQ<*VhFYTHstUa58JCi=L&qvLf;+NG$@XEAS{n48x)q)kxTdjS3L&$rGUg zSBOy=c~&b#tRHMJiG^2>d)v1HxcS)2iLp6d*X%WM)(F7dDv-Zewc(Krb7nhr$e6Co zHg@Xp$a4-VE>wUV*;-~&!?%+Z>TV#@@+s;AK}mT~vL%Fp;Pffm_%^|y=*@f(6nNd! z2Qqt;PMx(4YH>qVMMJxE_>4Gp?;q^7BJX6>k%M2!vpQrx;C$X!=0qFHV@bu6b&@VJ zjI5{!R#i%VL3oKu)RJkuo`<%6w;&a!OZd_2BGDKGZnUP(Pf!A*Uc+n4XJT;=|5x= zFdB))8gO5Gw7YBj^W6Ch98)+U`(J1|>;FQ_ndsU6BWbK#Q^W3P) z3BFEn#4Yi#2@sGllkiJ0EQTpURNShSez_GjmT+DzVjCC&`bMRHTvgOo?^T*ve|N%V zzk+AFUFzGnf3r~3dbfV+6pF=d(g$1F zUwV2ssEQLdO)ah1exKbuyN6XZ($VUCD<_)}Hhf%Cxm7yh)wGCR9#lTmTW$Q@hV{T< ztOL9aXudL*pe}iPe5^%DGRQkE@vLlHWnS~o;g-(v&)ht#${oxz(nJaZHg&{*E4 zR}dK0WR@K5hjyoC?%&_sGCt_YB}w+5BkmVB6-Lq(M9mA-%T9|eUG>OlOb;;8OMUjf zGj;liEliKVuX2tw0fFNhF}Al6&0^Kgf+3uM#EkcqHwp9G1+p7Cbkd}#vxM(!*+(K7 znFr5Olxk8Vrh1DpIhLz((>i3%-KD&gO)pT@3AmB_^%ro@cDFT(oYfS{mVH^{>W-{v z+U&93W#BtCl@`4`S+K_(qOki;o4^)J$k;dIjCocGZecyUN{>IqzHa?FCh=&1LH0yT zB~y3njF-*h%^Ilso?#akve7;=Bgy*+IdM;E5*v4{#udpX3iuz?#7M8RImSR!Bkapm z)6Hx&Zu@;gOn-%)EBIveB{ebQ=o_b9;j4|Bu|LX$P0}UzZRR5w1vNL6>54ApuM3^45R4CPQ(LwObu z7?eBl;V|hx=HPu7eXG7}_TKNZ);EGcpjwv&Yoi_ff+X`J+-Rj46FYa+5(|TcQoBM? z%RRRfCuy2Dz+{2PV`IO!Zc?YiGBToWhh&e1KOI#lU;tYvRC54d`Dgtvb?xhNE$lfg zZsauQD~N;PZ=FCuCg~NgKMs|&{D3gAj-TwxV%FvZIQzEhIk*c{jNBO(;v1v%9r|-{ zlJ8??vnruzopum?_3l1>@yc4?+>k%ql>aDY$zHIRi*sL2z8JWz&d4q#9R5uKiUaQ; zwI2Rk4NROLyHI0&lfNxrg?=D zI#58Nn0(o+=y&Fs)W-xK8JSd?TdGv_=n&R@C$1o7-WSG6|6ylfK{sne6zlKmW4HU&qt@0V2rCb*D z$M46;oL2Znv3881>PXI8NeG$HQ9~pZu77~i+mX3YidrDz+rr+q} zBv1Q|n%lU~ZmY|(L)C|xp57k@a^~4q_PE{{V6t~=h>BUrpZuO&c<{FOsL|u(RWI%H zb2JUA$Yx2OMK^rN!vn*3lP;a#yE?4hNa+6dC5w_POwQogq7Z&~bteq+tAC!6(oml1 zm0YT)Gh!Jvq3KJ!b_P|k9dIV#jEa&*kGq@weI!p@ z7;2bBt5O=2ZNJ}Vw;(+RxaE=|?)xULFSp`;%-I?IIB>9U$L*6!tHBM~U0Vh*=>p<$ zfd>u1-RgYO+(6*-m;}d|1xfsByJ@83+^FK#kjn83GXTxEPT!nbYwsI6J@GeXHklva zsv@pcN}%h0-|e26;c=s?naf$p5H|S`s`7PWd-d1C{2zlkJc6r0*KCHh%;J8BF^8H1H-cUVpd@LNG9^E{WEj({vdD{ zgV2Zqon|a>AoT{@B&l~s4(pV21Glb7{~b)2(^$o_K4)6;)~WJ`E7DxDkH_@wED;{R;VauEtZBtc~4UQIZt{nn?@ znv_u~bQyht(uM;Uavoei-r8vaCjT{{=gRCyxEfy~E>g22=^9O=Ha;_rwGH%Fodb3h zvtyw*suNsIsmOy2Sc9hYq0TM*qF`JVb=K`*8`Kqg--l^}<-{G-_;&|p*JR#D7*1ig zww=)0wKsG>-iL)F_G%iVlz`Ly*BQ;;;nPSYbYKC%l6W;jy_v8v3cFJHt1>maFz2>u zPihD_#bf{W{T)pkQI zP>}AhqN#UpboG#V6vAB-(^BCzX(5Q%Ug z)guTudVqmB*PJ%mlwUgd0c~}ysh_EnM#kw+N_WjjHJ*ITE1dDIvua*Dl@20eiW3jngLn z0~mFvSh~ou&Lp5weY7l+w+(i2+OvO-q-{l4c`FxJP`8?WLGe>8kTcC93c;8!a^e0M zgSV$4daz4Z{xaktit~vitUlunOO>VL z3753Rl|=`$8cPA7xFm~S86Yv@s;dwU+7}{n_S#TX&9!j{p^r=Wgy7qVP=nPu_?K|h z5-IpoM?eG(5HKHK&r(W}nV%@Bx`qBrgGaY1dI>~-l(p-lz{-}n03+;FkN|<_4W8+I zK26f-Uc=HQF&22%#3!!|4#kIUb9h52FKb|shCPn{s3pr~9UK08mH_6aRs4Ob@~1rA z$F4oDzQ~T}!vUkmv7X1^2Iw|Y9+P1){W$xlH-^`x82lCZltY>jKM6E+jRgR1`le+b zFNURzo-W^Ym?wN`VJ{R7!;h)l`#=Vbc4Oqz2+)T(y=nfD_nOO7S`vr;mKmv>8 zozhNoO-;_0#${x3#au4-M~wYvWl2x>{CKLLkyJp4@d^GvJs#B)HcuD4ALLcxTX7`{ zO)K$yeC&Rca~35&a~s2h1-gp(F|Qk796{J+Bk^DBH33Pka!a^7bLcLz{v?g0X6<=S zdotcQ+JLrO%cuuUJh-e#O^ZsfyJdBb&vG!lXS2-RI#kt(uYT>rp+uEVv_F|Z-|1Yd z3#pG=oU%2DB<6|SOD<9d0#?6bXd7P2xIHlz&VQD3e%}lRR{uc!laFgPAH_Z&6!LmC z!Ds`SE)0BJ@jc3krAyW5nMdntp6MWV?2)FZ-Qr|033jI^Kp|*4!;bI z1XiBu(^Ex}-TQ81w*mjz$5@=AkJP!X=_N37e$GdR5|pnG2D=JLIV0AD(S~RbRIA0# z*Ql?<$dAexyo4Z|1?cp8yNH{tl+(n@N`y-|LQ2?>5<@-@G(G81wtBS}%#T ztjgVwhh`N0M$xc?U+MWeDtm+UM(*YTy{2EIC^<0qHcDa6D5v`wtn*&vxEHOrSGI#zYps<*4g zgFzNQf4zniT47`Edb8nUSulE`{_#!X*wk;xL|C@7z-hPZa^tOs>$!0y6-P2nZ0Fs> z68fHh^+~PWFpn%xJkFz_JmrVcX*yi@iZ#5KAV~RUDrhNDA`B^wmc4I@-Rz^cy)@fa za#F6NcN&z%;JsURl@|A5!gVC@OmG6l0%Qe?GKDo!aR*-xlAF(Y|Q*;Z6Dd6;6w z1l`h#`T6qC+)$KXLmu|w-vo6~eSMc18pUY25un;xpD(aEH{*Y?CwMD+?3`e&$3i;a z_7m6whCB~39lhIUAg%%Xb#1W;3#_M!H(UY=MF}+ymImaZlsxlc^>jT#JJnk- z8*!O>e8HREr@v>4SX288MWOzVlO!Q1B8+!}ojK(u;83h{U>0alBxNqWn9eZ|aG_Q% zt+;qDX=yzBl)(nLoaZG9M_-S2yF(1x)DNUjMSr0vmXF&cb}%01AS+$_jqOtm%T9f0 z1DJ*PiYExx>}kit$=CzPAB*sTZV>DZ_lk>*7uzus@A-A$%|teY2F-^T6a5EV38XWy zIj^8}>pnmSO%$euL_>N4YjykVBBXHO$bMwoq9b7{{M&uduoveC-^W|I&1pFRQ1GHh zq2;Z4mdAW(Xp)`qd`Xl{@f^#j@qAQ^4_W8L8p^^){C)9+C4&zsNPTE4HJ`|nu3?q3Hf zHu}H?ORxxa4Jn0cc~iEz@LGh`E|e+yGpQ!Al10iGRO-LL_&i$bswjQF18KDv z7i7GuxI@O9JbuljHK4%~(*E>A8!n4X!V3o8@6n+}h@u;5+!?C3ivUTgMG8Vhh_ zyp{Wxlb|?n19Y?N3T;X`8v&!0fq+AqalkETPXXiYg*13w&jB^XryvN5#+UY2;Bmt) z;-vwf>{(*)#f+cOg8)RQi4#iKoyqxg07tCMu-bC@5kVC_84g%1D~ThV%m~uzLTkD3 ze=07LE4&Y<$DFf+s5{H;lLywW%Yrh>xwGG^&3x%K*8p;Iw&E*6ZW-P_GIm$tyXaRD z15#_!f>z16ueNc~@T-`I&$Ug%vVnFuUNY-5AS+?xm8_mD&h2@x*(SMcBhbL)dT=l< ziFw!%(6{RbevUw2$Wf{ZC8kkg@SC8uNJ4D@wTx!X$jsa3sHXEP8crUIse(0Gd%+q> z1e(J><}T62B}4qhp3~wXtMZ>Z_RNF}BJZ8t?W*P!f8|W}jwj=VGBeYXgMe}sg+5%* z#e3P?`G&_M94LOByD4H1(VOmFmvel1F_uhd^#3~9A5otTd(Z5-&0rR`Lnvh-iOMW* zMlotcIX@snbVZcS5nql6qfm*`!ibvAE@#8l1*&!?c=er&%hOU-l+_i%76(IZg;&k} zxj@ftH-qr(!(h7uYHi0I6!A(Ql>*9h(=B1bd`s;PX(T>K(#8_cl9oZ6e(Me+|5Epn zGzR-{;J0-KR|LjqY6ZV;r^BE8_ya`Gq@;ESLZj97G+yY8bU@u)OCd3qdtsIb!^yep z=};rGGx3dV6oZlrz(^okku_ zO2nuz_LwA1H&sA?@;!Ugcb_1wR4-!WL_N?)nd$ecu0sYhKCNALjpjo*K^mkt;qpt4 z{MnA?bbZ?f3W}io@#>e%%pG%88ESw_VpaXQCKPDy7e<*P94wZMnPZ+Q6i}Jp>EuMV zsR&if82pU>J&aKOX-~&|hH)*lC>ZXc>D{_Wbc*0h)29rXa1p>FoTQVVI8)BU@!J5o z4k`a61+?NAZU_7~6IWb=J2c?`}xQ7HP`P89kn%U>;Fb~X2$;o-5LKQL`jK4nO>P5Ku`$OiI{*jf6pnz5~vAUjaOHls{8}T z_~U6AB`rP*=1oe!JE~ND>uISQH|+)hqXf6t2lFjZvf|Kph%p$31@zVu7b4ofZS9t9`jyp`yDi0FZCv>bD9x}C4sJ6ownEqxRI7RXO>jBM!~lt zlG*i{SmvsiAN{he>Ms znw8`vxPAJh3x^2S4MkU=U3EE(ae#|a5YcbkVzc4)58kVSw`l)3TtlKhdTn4ho)*n* zIyJRlt?x^=xISK9($3Ke@S7Rt9#rRFaY9Fr5fXM8!o*($am!#s^fP>NW15r^zr-i$rx9zkH*s}wsF3n}o45S#(o7e7cf+I;xQG-C) zbz){^bF-4-!3HfDq4TdPMDj}t5ep)xr4S&zi^PW*&c`#6KHx1hOs*fFJyh_dj&d&9 zTH=r&7^|NKaDO)~q~ags&&eT}U2r~p9jtOzZ97Q}|ALdyTz(VCzIel09Ap$rk6>IO zFoP&eEQvu!(_i-xo;MnMvJ0a1snLIL;&kLwk2z+OX$|y z^Ze@h)6y3zb?jK~mTi@<8}_k8!1}aQ=_U3!sPdo&^oT>95GD*L3}s=a3uiwv&PoY^ zWoMl*d6bM_N?rvWS(FV=gA1QH6Wj4Q-L;yz-VXf%b6a`ve1L85L}=8E?)zjlS*w?e|K>z|%V=bm6)Wy_K(EH|$;b7or z`aU4cw}-+j3JI~hMop`Izj@s$?y|Y0)%$Q4B4YIeM{PFsRwh=g(`-%Sq&Y&-HBDv`?dOcy$vvK=k@ov(I+0ht zoIEXfB4okV!D8I8>!{l7d);?4J6JBZvYv$rqMM&J>Z`ZDZprkSlP`W$fIn->PHC*y z@_r|4|7_c%lrMO1uw+yqK4|P$gqzULnKo*+98^vU)hZ%;@H7DLf_W@&sjY{jNV}G< zAP7vLKQ3q+r;r;elWJARrZx^K@mgK`y#G;!h@wCjt0&|%D;I-OJRij~orM4N&fNj8 zORt*wDW)E1_0hM~N#j}U@6nm&KHLq}=LNJ0IN4D!Hkuy{rTTOeSo{bRH)KH_qbeDo zmgTocKcz^;Oy7Atud{hSiMBeT7qJC5Qu;$gW5~o?A&#yJa;jvq&qXz9Bo@}q+fsLK zJfIt0jiJJ9-oVhJofSU4X${Q@LAst2c zTQ{VBqjCeCdzUZ$n_*nTO6a1=|K%Xm+pFoJHY6vl?+bUs2G`N!=bb7W9AX_<#kNr9tVk5GE(kC;$879sX z_`chDRjvBbK39SHeWGHzL$7TqU6ymJ#P?;O#-+yh>h9RAb?#YE^+>I~as7>H()c~S zSxtV{EanXwWPjIc+)=kG?5yBRX@ZND9j-Gt?3!pUwCT-V#ZDACZs~|^rsiT#dMoS8 z<=#lvSx(`~@v3nB4mf?4nRNQjKk6SWzRlFEW{Zd@Z1vhv9n)OSjbxHjaqI`)$`CVA z;hT_AapOg^+B-u2QLAxjN<@BkN9_^m+UTpi3~oEMTE#B4_~!}e4|6#vIB?Gw>%l3F zF9PQ6w9yJ>O6|BXdFQS8=g>_UW~H(`iI`#Y;$@oy=g2yeuis8N?Qv(HP~1gm<@+)$ z^@N_XI{3NaxqkoLzL-sRY=5jQRk@J}%T%Ve+q!6a5S7V^t=v_+#Xw*h*r}M}Tr*9Q zWh(fIZTMAtuIF|g7=z)bQ;ApwO8$Jd(&t>QQUlLBpN!>+kyd`@7HSwg&B$$~NEMn# z+w8ICN=jKQa^G6Qckle0;iMNIcxSHWN3Pt-bg3ub`iWPPXgzmN=0e3ZF0Ed5af`sG z!6{&x0y`E=xDV~yI(_baJ{an=ndLs@A0nXkttMKwyuRSCrfqE!46}0BZ6ptNVVG!4rDFpVH=Z`LE9q}KT%aY7w*x6gqji@JaSeqC25{&! zU$-_6M4L&GiM0-<$c4&cZ_^dk#~z7?3&e}^rIaeiF3x}ST+@$UYzEExsP02BS?zIP zV58WCjq?f|b{;K+T)6~-kh2;Q6Zvzeg_bi+ThN2>!zh4^Y2bMc9=1C)9mC5ZipSfKln2aK}Gq!dE&>7JZE*nvs!A;g&(>M*xP*4NaY4~;kA`UAP9Qe=@Cik4j_(NX;14z zO3TgBZ&@jCzcw8Ml0WS;8==0bxCG+@p!Z%(V(Bt=`yVPE~Aq)UmZp(&Z0~DUm`7n zsR>gBPmF?&R4^Oe3zYXIjD%iMF0~P`Pb3LK{)`B9gPEC+;8#4tUBnI##W0oqAA6$$ zM)4VSO6*Iq)BvMMe%`_(aJ==PJ7qr#&zx+K$QUzYE}$R5z0hx+UB^HWXq50fDkxb1 zcl+OYEy6C^3p3}C%pU4kFHEKjwhe)kvywF`YGJ@L#%1Hxw@rKkj)8o@iai)>jtR)s zTzhSTB;NdcEPLZPV3z9`buuVe{98NFGMqZZrTJ$B>y#u@Mby%Ms&%JsQMIHv^ii*~ z>-&QK_=BtRHOS8?aDqb`-l{k?o2UvQE`o9laKrIy82RmD-&q0J`814`z#tTc6^Z%Y zk#S~sGC7$2Kb3>;@r2&`q4vQru*x04o`2{I_$d5_-vj;VbSPJ0S2Dpbuh%FYXAZu? z`AN7y^qligTdq1TtwZ!~m$W%2JRa`3qgj5rRkD;rXz)u~QdJKyKvJ`96N;Hg>Y>YqP-)o5u_3XQ z4w9x}a{wHJbHO;s=JAa`vg*m^vF{(yF2ZiK8aPk4Q-#u%JQ8>&F96_-R7d%l{E22R z^!Y9O`;Q<1_U8zs&CMJV6q+$WWCAI-)!x0DfU^6%)CRVc6ZOqxHTYU*7WdAkNFo}J zdLX$IHutBJK~4Vg8YsjsRjmNhyAe_PHMFFyapURUXg#KJ=xnB|5QArVXSL0j>H9H< zgl~53H}w_%PmGn#Me2BI) zqGF(f?I-!j_P@PET<~L@jZ`kCXn4OKiE^2hG>{diTP$*Rs8BP4Wv#%o;T5B#1@=x@ zVQ!acM>WA8PeUB_Tm1jT`N}oiC}%hjviMYznS@>Pfm}R9{vg$#YY71hPuk-+2F-vh z#!?a;Z5cpLbdr2+f&l0;)xcQ?H&DT^{gi_w#5G>cB=}D_9BEX)QwuQAidXn8S zI>Yy2(F61P9)Ng1U7|JnW)$Ieu6BhaV$`L6ehv>z2`bApZZe!RtuRyu#RsVYZkP|| zhE&JoZ_w{=^oGI&&E=!

i%`lN(OGV6W>)`Wu4Ue`le~iQ_lISU@7*3+M3}A~;VT zJu$C&?}=8)G%&nNJ~(jZg5*+5j8M&-dIN|0w>&FBd$>_*NqBO|%@Pb2+fLMMOaire z<2o#4$#md^+#LehWpiI0tFtqL`GzAbosLwMX;k?b$)E1E^AgLHY9keBk)p%fH6#i&1Vn6z@w_Qiue zx9PS+11?l!g}ibaTUpB*$fE0$kh&-nk}X>dUo~;SN0Ydv7yP?ji>Svc=1qINrrvw{ zL)y0B8A`opM^g``f1m0ffeSl~ekK>$C%g;bQGu#{Fg1{B=^oA+k;&{zup3uF&#+IN zkTb;Zj^Sk+vHwRx^DerOGRKTLLlewM&N7jFqTK_D$(?|r>o(}C8l6Tv_waGyBWA};j!RzStbi$ z)`I&CJbxT!Vl8uH13M(O&}!fy1rs=+cbWcR9;@vF|-U z72L=d)n4oEJ>ZP3i@-#c5YF)HsdCLXhN z2sV=Y*ddrkuwg_`^}{OjM*}lX_dN0fC9Bnw6z9*HNp7=5iW3vC!k7Z#Q*+2l%~z-* zHC$fwchgc}XEGjMJnE23ENJwwhVv-Ua9@k^r>Y?+6XdNrZPow^n->-prHuAIW(557lgu+W zMV4~{=(H31;KE|4@!>==Cffrj$~XM7IPnimf7RJUG0KdqzXgy)Eq||ndrdq3@{OsW zm^!vzl8V3Xd>{K=LZkTo-`t($f9k9;u(SS$MY(9pLD6%eu-@qc$kC2_$ z(~fP|D%%3GL0m}s9V?eyQBHWEbn#9}+w(5&gOc6GGG`=_o^I`mB;~J?#+A%&b&s|0 zYZ3~eVknx9FxuM(S$cyuS5fmspfW|2r{?g$?B`(Emw6gR2GTH5c+p)TJqp_IhZDs? z7Z?4F^eIUk=i^FVYdGX*iJ)>E`S*{$`Tg_Os|;?{N;=BViM%U_>+b)Tgjk{0=1(bL4BAuunDZ9GAg(>R z#Kt4(p}xOBuqYqk>f;fsKls^^C$ilnhG0D2Dzn^#tDZKL{tH&`B}l|$U=U98l8NgR zmRRofhgmd9oIEH#er3h#t$M1)3?i4lil+*ythgyd90q5JOus;_YBH%kxw8fOJlxFU_5%<5Oz^ zq5QScK(`0qMshymBz%HC-P2~$x~j~j3R%@3;8ZSR#v(ZjJO>Y~Sb z-7FFamIa`TBaE5uLfzv(dl2jhjV|O8#-d_5g>0ncx&sv}?4Z7Tsi@O1i?6!{j&z2C#Yo72y@9ummPjN6FIW++E$65i{Zog7ETP!Pg z2?)}7G^mPbpV>0PiE^P1lV}1@>>o@W9_%DbWj001?XrbK>jJYzNax<&42K1y?OJ+B z!3<&l(Y`g%**> zN#jBBt>G54EQ$DcPRIoI{Rc^S7_URb&GG{4gn+igmmrMEYcYs4J)-x(pTYuuDYf5m zBx9|?G=YXIaTq;S(q|{EQSu#=H#8e#STW*ShnpC&2f{0WsATX-R0{^9`qh-c{k*F(m0Gi^)U_G=mVQla91W^xvS^`e z@!zj5PfJN%>tR_1&1I8@r3$I`ia!G9w;Ti5Vw$ZjJ>hGnHv>cGdriO0+$falCc3YP zpqjnCTJ18OWSXgiB-kU=fyXEY&8!dwozC)T>^@tGA(MdP-mVW@LNxAi`2ehQ7z)?J zA?ocmEsN=o6nC61Iqr0EJ;QfWJbziY$ z)N+hCJ-C&hFa;*`|50uawPiLc;qM;`F>D`_1}}F-+j6Y)-Pd%Uc#Wd6IZI4=>yY(3C<^i~(-BFu;C|V?1 z)(XVqs{+u=$Nve$wFYGQV0JXr&6|F+at0t{B}x|uanI0 z!IN6HOuOC6zf&UVsg6!gTjIU(nn@#ews61WMe9GWC%4!-lKT@tXoq{T+peX}GqxG` z%8OsEx1==_fRG1kB5&E0A*rFNK6>z#j|BPPb%OYA9)6?br>q6z==~J)S zcWpn=A@9R4{}CSNH+R)c7W_nND-CH%SYbPKHH##&(j;-ZYE#=EtzAFyw_$$Y!nwIn zuy(`a-@%20-BEHmAjRF@xHIi+TrdXj5EtHW{OChi1|p`1B7;x|ZWg~X+aamiCmkey zeVMkQlMx0P5ZE1C@^+~^2a_?_Be0pSt~vcT{6j~71c}0KhF@0qsR*SXlxFa+AHKfL z`Jh*jasDgB@5nuf#c@`+*IzahTFUcs)2=pe2(89YHG>%AaN%iO${^x;^;RI{R;6c{ zC|6;ZI8aJJhAb-E#x0htxr*yj^-3Bq6& z`obitmhSLvNCwG4X29PUqh;_NBRxW7ZGE7pvnwL)V6+P6y26lJB9dEwaY`j90;hxS z_{gj1r2YbXudZ6r9B$^p!w8#!zDcSacEm-*v?o~6(0?BQmm+d@kU^OTdzl%&goPCX zky_Gv@69~tA%Uec{(OCY*k!4Z1aQxE)mnJ!Rp9+LL~Tz z|4CTSA-xgMK^4O~Jm3bXxl~HLH-szMWcXyoAmB7%f#77Q5crzSkpPOu9`r0YnO<|! z*)CKo{W@s6H4d~^&e|-b>I*!roN7OCmq1=%dTn1IF%SFi+%rq-inV-5whXUpNzgyE z==)?qlGi~H`#BoW1ZzMK4n+L|5GdxSfoTy2W^W73BpW0y4MWl+xhz1AMGWj%|!Ers@|zH0G8tg zXs*JV6JrY0Q?|2d$o!7@v^KAM-im(ZmU#FpB#`hqyG80c?~arrA70 z-}nKzH}GOxNCn$J2wwWXCRP&`EK@DZ z6ki7V*~2x>DV*8I7OX>|xyHl%EvXiGuWO~FyqC1jplV(jSk>!YB-0DcAScMug{azz zVcBev)jp@B`t+`n#AV}@U!=Lqa0)WUXK#m)1eRPbD>N#}!p$Sg${2lB*%ERH{s6yqJ#d!St^1CnGXCxfK&%YhI!~@pNKH&yhYRW56Vm5TPK3EAPK{8QOAr)?Q9NvQXdWx_ni6#qf>k2rxO z+zKFghJg%lC!rMx2o1GDT9Znp35k#c={9-BNQ~GF&|@GWEhp@l!)J*X7Dio^gDz@P z7?{?NqhKDIMI{5(C;bCWn59&m5xPq1Hn6q3TC4vj%IRlVYXH-5WNe&r_0^k^@!?Db zWv_G{3N!)d$9Hd$yw+ZBh7yq|1{Nza(L|R9oug!uiAShwHszQgw3%{V#w6u$mt^Tn zL7lGwo$E-a6)CK9r=}cpq4IWd+`tT7tQj`OG2p@KPk_=(9Wcv9swJNzQ}_&z7$U66 z^Nu5Loi-8(l5O`COF0#6?Vog?L}h!};pDM2Yk7Qbzi@=G{QNqT{co89!fexa zW~FW0wr!)*wr$(CZQHhO+rAYyVj`wv`l0{AdD%GMUh5HlI-b-^-YPBKT?O>7G_e&# zHj!^BN#i)c`iGrSP~1}S!uu9P?bl@$^T1jen#`ITg#C>V+TyulStAT@QV;zw%~HV? zkeb3hS<$cwWoJAf)5u@u0pub)(v?!X6GkYqwlUPJJS#Fen4jji4WJNEeZ1(ciht;L_>QX*ul%U2Ay@1-}x+ zEJy9O9~;#I`0IKpg0TnHbq#UZc@%CiFSq+-1haeOa5XRGl z`wgr`wVYrLZNu7;fiuK28H_@h(BrAeRQ9_2d)hGP*%ek?w!sX>gg-|gTi42PQO?9Q z8~GvnmN61_%x)0lnvG!TP|9#mDX;|k z*Oxkk;ruys+eyYNc_%0D&6x@VCm+rf^@M6R6eND{U2U>R=TW4Ap<0ZofC*jHF!CZ~ z#^11_2{s}lo0Seg%$;5yk7XIWb3!(#t?ej!chJQwsRxmYCsV}6#z_dhNev0!f#AFR zm0%$ddB+dyV55dINSpcSiLh@2f^S?o5cgs*vexl}uI}~N{XlvUBqhClHk6PV<=U{- zJUjwsiDI!$OPGmtO<*P!bzMGg*oINC^x7DIBsPKkO*KSQpM%?K5gNh-2C(}s6Jqf2 z>`%x@&sQ$gnir8+k~QCi5$I*Q!W33~^!Q{!6Xha{51UtErXG)O$D62+x=qtn6NJ=t zktNH2$pk$wLh1f|1NhdPtj;c0d$a`mPzt+K>copwWTePM$Epq&Lf~Y0R>Jsj|6RwEbTIxis1>f3}hoSvBEbcgai|cC;vnV@6R`V7Swj$7ugZ~6S3aoq{ ze}i&h#A{~aRVw@aF0S7LoDsS?VD$aX8Q;ce`X>rs-$NVgc`-2Zb_Ve} z!ieF%Ha@1eE*!HZ%y z2~>49K_O$o&ZiI@a4;N+Tsr^8t}>k8th!*S;TckJibNXi{FS{sSsW$D|Fq^z)3Br& zF|fYM4n#YUtTZ&|gRG}(4N-*Fz+lYqNX3JiE&79dVfgIy*FKM)@((|MQ>Ej3$CMPj z|HuPJlV2v{TZdXw7JNUh`oD1&Yy;YVsHo%!O`MRb0ZOgM5_tYP-)G;%Ra*6xpX>XH zFsD>1euwLcqnzf`o%)Ayt#Efc2+~xRncIj zRtG<%D>3|mw*Hl$bXZRY#=$jF`4V{?CwF@%d0}Im}2DN zL7E7{e`w!=#{IcrdYA4kD^SOwpCTSPK@(ZzuwQbI`n?XDTH`|i!Cc`B`MINz ziz7o0r!Lz=3)V(#QP1wo@d2CEbOoh9&Q*?J4?z)(B1O?C9e0^~M~R37*&U-uwyj+1 z*0qX>6XhLbOP5|NLZ7+84%9)?RA$o()3q$*gJ?#qu?&c{2Ng5Q^-cg7XI4Y@VYB5@ z+m|$vg{!F&h^d)b(j|DraYp6zwIJn$_?ej|f^Pe+>&Fk+c*TWSUTNv5ktmDu0XR#} zXt~~&qVI5iKXl?t)c|@Ev-JoEqFW^wN_7U7DH!&}X`1$&)2=Rp6>lJcf%gmz2O4v9 zA`<{LD-)pQQU(B6Z9Nz=L7{%X7%Ww&1Y+EQwwDCld=%b!v6D7EP_cgN%vGq>s69%t zSK^$aD=+}@pTO8$6E;aGsy^uhY05G(-9y~Hzlzqh$G6DP%7~)Tx4ot~1s?4!X9I3p zv!cr0c8TR40L&UgTV50`=?KW;ThJXOkPe0SQ(>Q+$CbhfTM&w+=!aK)s_?C+m_-R7 z0+AS?$@ryBj^Zc{a8(U#NRO!cO98Nsr~p`5(fC9}T|< zucL#b2)UMCI<#1b$UrNt7UsO35gfZ8HVG zXmdGwl<3N*GIVuA3M^=3W-}B1Pq)C++paA@ALy(AE)gi1)#hS3(B&td4zuYJhsdb} zx(5^8SHT|ZyZY<%g zR?)?ZNDj_NktJx$@l>na&e6hI<#;iJ##Pr7?UNhy-q<;JBgz{%+d4meqTgG0-;lt(atU+K?ab*3w=cAXvY$8jIL^#bok-QOfYt0xBWT^b~$1w2a zum-6P>Y-Hp!l0D&vor_TWNSM9gOc#)dQx>&DcypEatb0@{;01EPA_E-{g#09E^Tdl z0F(w{#h=OIbwvyEWKW}lmHGi75|N2LOlIRIbay!C>y8Tm$T;>+FuhZTIYB6cJS>_< zGGB^Z|0y?4(Ch=y(+uNGgg)rkabMhprPlE7X744UhOb} ze2h)Ae)_ub>zJJoiQRD2Fd5ZXP}eGKM_m&5s*Ao z0jyvyq*F`4fUw>YX!CJCS#*Jyrq5Z^F5-qofoD4%>Xq(3hp4Z_L>>3%%^pk%9&V)uhHVq+raNJC(`Va2TRSKze{Evd*GL z4eO1qjFi0sFC^{j@kT|%Bj zjqL$5tg@tIHX|BkL1u+EX`Z`B5$m`!2|B=A1*Jbb97fC}>9K6=doa=c1S>l3(m(Lb zLtVRN)hU(Y$MeiJD{(I|ct22$VIVDKAZ=X3a4Uh8#_CDJSc?J0a9ZFshgXeh4oNMY zy`CH?AqPGUGC0W6MIP2u!?C5odn4Nm=s3<2+}h9Lo=sOi&{?2Bm?%kh$>CuwLT7}* z$`Vu?N)#HjHD4Ju9e%|=LexP{d_fFiI{)Xp~=7<<*FW!0=}$jZH!3u1q|C~?AQ(ABcl-sO+oXNyW&R3HAS z&w3KPR-9f6lf?4aomX}ooPFJO?b&w+C)!Ne|0~8ETYj=%1x14v>P;0rlhI=Zxh$uAA}HZEX$LNQ(5d6my|3>yP`bULtzmvV!XfE&k!#E)@Q z&PN8lVVVU1{s_--YI#q#5E`jBvdi3!l27-mX&m0ilVg3<>~OsQTx306L_F4^9>5q{ zudn9!vDz<~@qzp0|Jx3+GW;*$Mg|U!{|GmBtN$OX9>Ecb=H65oUO~~N(0mhY92i7g zjz90wjex27>V-yv;dp23_azrzk@WhO)vY{Ar(gNL-B|kjG8lyI^N(xmAyuvJ_oa-UIbD|;c z?K_(Kr%RiX2G zt$;T0NEG&*dS7_!g3>B?Q;av;3lI8VB-hM;uoT~>x-X4!@<6#~_q!MeJbd_lf7Wvx#T71L`QO4b7S$F~o}Cg^NgF{*=Bh zuB_6V_&#_5`VR3{Crx)}O?OAl0%zn$*6XdD4;wSApP#dMf@u=W2t~6_Fa^E@5vuf@ zjcv{`HNU!a`u27pE?Ve@Wl1eRZGvtY{y=pQfrsjfu&IvsRrd@-MFJS<^iC35J2#n7 zvvL%2DN;bF(KI_iWexk{k5~YLLPpV01;!y9AD6|u>#LBMp#l4$fnEKi3coJwaL~5h z5sa42W$@Nhbfz&VPlLH`Gb56TDNoRS!zmKqy#dVXg6Y&FD08VYhLPgPFUtjy*IU*L z?)(T!WqXba%6!y4IY9m$XPyj5zPBvykT#&t=}ETsXt2YnFVx}{Qapbk2Is%H z(r9CKGe}UB@EtBBHvk+bL}HklSC5q#&z90p@Aa0se*^L}+}|7Mun!;gLTMr0o!xD1!nVSYN;SDLCpA?UTO6;!(>Hy|3KwYOY_q3*B#aC&(o@3 z{pQ#4{?ZxXtFhBdeomF(z}XF@Q>S$d`zu7)^;tD1K1)IdeUMRpcT5(KS)Dnc;MjBI zS^?7LgoF*t~lNYjW! zYq6uUD;y{wDGp1r*;=HFn$0Ly8*!c@m0}^}hB2 z`13sXGld(hde=Qi?38DmSdhjGSMHh_QQco$%)Ka#>)vUaZ z3yl6W2Lrp*|K@?aU8M8T+`(GE1<3FeVDwvdvyIinlSrtPD>wh$DP|+k508M!759m^t;!0D2!w;60Mfl8Jc@>Czz;`3c1wq5 z*mVa7Whc4ePY3rENqZju`~#s{Cl`T<&EmVwgexXSm9j^rFYo8FQUK~q!&d1E`WVia z5PH8~!}|@Xh#UNRW0m>!$r07nL0||#Z=`3e8>udVbfb6;=_+z&5~N&j-=Al|0DV(J z`h%li(9bMA;f}`jwV^j|ywu2Drgd#4?z2HdjSPYa(SpsLh1PYr4w z=>xBW@z9AL_XAI*XO~#}TRhA-3>$^CD}8Dk$@mbbdOvq~)xGRi|D_-JpDeo!tjzx@ zCsW_H%@RfUXW8}tK$5+%UV}#!PYz|Rpi(&(J5qX#I{_Tr!GQ%w+q)|A^)_{JVOU#p zrY?<04qRVPU;pRVrS2c~14sNi6d>HAgNhKkJ0x}UAqB#%r=D=DTLwHYu$}0l5^yRQ*o_rhX6@drE&&TqD(=r9la?}fJsFnQ$!Kh0>a5{m!51*gABb$B zk^ygl^^^)9wBCeKEf_^tYNe-yr;Tmb=^cxNmt}mgLu815Lq;vFvE}NF zv!|Ef`gkef$S$X9bOz6GccT%WLZT5cA1RU@!x>@UaYKdO8%tWO*Gni#lOJI4b9q!7 zQZbw$F_3H&{|r=?8tB82I6>cOMoE0#Rd|Yhx0xRjt|ONDWkW6<$THsZ^kC;lxRVH0 z0Ui>H0oRX=L)lwr4ngOqE{dpb!|T{S*Uv~kBFNi3NDwBochfy;=IhDYK+dN|Fd*q7 z-x&P&1SEsO(iD(wVACkiyAOfx?I0c;&x5T}9)N;`_jy_7*^r71lQqXxhWsa$oVTB; zlY$(P$+L-Sui`Qqq>Wf7(*m^46HY*IDTtAT6{M$P;xWX`BEbm%h8%LJP#zE&BMrAJ zYGz)<_H87V(p(t@2eEEW9%}`LN?bGR*Bw>8yJoSwaBbAk0wQ?woHk^u+5vUc&m0BfT zE{Y%eHhKOQmF{5Nu6%(p#w#khdPs@c&6XN1Wd~z9tr-|+XP8tzLtY3cLQ-+xDd<#! zqCaLfkX5Vu=Y9*c-Uq?SvCUt8W&uF4N@Wt5%Tl zm*`M@Me0L;WsZM`TP)!tAyY==v5r>7>%u48ZIKea>d*i1v3Jj?mc!g8U5m*sGll}+7XR#21YRKO6ZEutA5JzAP=ik=UIhz#f8Y(fOGG5sZ;L@)t6;Gst!s|3| zYSkf@2H!bl%fnFxIpqDbmMY|&kB{q5;+9PLY7RK)?%EI?a+Dg|ok&at=UkjE%;%ML z78)>=dS9=Bz}iP8uNBul{gYtUc^Dzq$TVW1mh$8?p*ntpzQ5?5pM*}P&$tU3QAaKx zUff-B6-$mQKcEQ3JhTJA7oS(oh$84-tdw9UP^EEuTHM}Q1Uhz414f%AAD&0fpuc)q zROFA^s~bShfRC;(n)DL2;(R??GcQ!_i!zjRoZRJ;Y3ib!upgl{YXvZC+EIiel&yt2 zJoZ0)H9_)%Nf%Q>*8pX;ama2-0>`-7`2kU+A$b%n^}FAN)D$`Biucbk6ZL?65LUdc z!}u!aN^jHYA~8oY?ea131ef?&E+WGniwf$wIXPv=t-vxn*t1>BU>mOI#4EP-QqV`u zPAu-cRXp$<@40bdNCmWz^wY{t@*gL(U!;~4n%1Cd?}NVPYi!(_iw4cqmOs+zO3ziE zqrl58;dOuT*~8?N<%UP?drS`>I=p@fK(SBe5Jo3A(7=oR)w78&tcIPTZR5mnOvW7j zyQylAK}+AQ6sr1)8k6*mPDoptEk#JdE5@lRDS-{xP%6$7rS)tX4F4Dye+k#Z)Q0ZVuuW! zAlpqakfNHWW>c)3q;fw>v=d?xJK@=!Jr- zY3V1e%`>zc;)4T^w|u~)uF}z2zRhpN2jf1hPD8nV6#5OR>!vc1q`DKhcdlyX{zN8`v_|FRz*zBnp;Sg3snL=4 z5))c;8=d;|IUrx2kR>Kn&Yp^WXfD*9YCEkLshn}E} zyY1?)I%}>n;zk<4+pD+OU#Be^Eb*Xsnt-+?-OorwX7dln`B7Se9df&(0d3L*dBoQ{ zz=bURcp$0N&Rsp#@Q;?JidrQfvBqoL!YH@>lLLJX#(qaFH7X_+o&Q7A)De0~Q9H{v zH}34=bZmE_6Rbp9y~*Ejn+<)fq!sJ$x$boR&vd1ecL&l2j7uxwrc?QGwvm6M*|Lrb zD(Bj^5k~#p!~nLIHw_uLFdf7@Dpa&x2?Hmech^s2ze3NXw0P*iZybJ9?b3Z zZJ$@~(Ca#D_+AgGWZ3HB?G;nEok;fnNc&D=uyH}iLDqtQ2W5kP%F00+Z1m_)`p)ql zZe`m4?@CoIf_HN|i=Jd>rL&LvrTHNWze#Lj}1Z<9KAC zA?jGwM+GZmT)QqlLZY4?_wjwiF|phvvGX0Mu)J{DjAo(6Ise{IFDC{oz4#Ospr#P8 zx7B|GfUMvJU~r_44(rv%nl8bzBpS-21z@N_LrGP`*HswoOHCbeIx1pRaTz$Et)stE zemE%I8qVeYAE{`fDK{eyd^Cxnco_RLF|9fQ8?8_-&L5W5;K2OxdDTs8AO^5KiYJLdFbN`1~{Q z^QHZEp7czEz6?l)t6}$OvD}`GK2aZ_6TfX6ZXr~iRp;CZ6^6Rr-q zvk@@bV$e(^O^*d0!G^Sg(|IVq7BaW5P?`HQf)#U+O|(eA!+mksu6l9}dVW)!d6&Jvb=P=$Zd8Pu?)MNQU_!^*2F9C z%FuKICNIDkit7P-f6{P0=J6~3+EROXDzx%F(&})w_qjogsvSlA%uT0P?vJde$AZ508k;1N_L8I9%2H*= z_{l3W(}fK>sq!E9$npc~%;BhC;7d|e2*0QaSe8HN^cyMOeC?8jbisf!o^6vZ?MtNeUb!nU{?tbG+?sOJJCf@yi?h{9bCDCQg>a z{zssPafg=VS5VdY?0#3N{-r%I+m!IcWn+$25lnYntiFc+cD(|JAXL9~^$AmuNL6yY zFV94vTwCRQ%XOFWSLz?!aW6QtBZ=F=SMvP(eN3G&L;yv6@>h2f46L}FJwMfj5V|4c z$j1hmNAF*gzRx6Tkq=?9k3DdHDA!7RjliMNv)9NAS%i-pUbg@k&8=t6fdikRBoTru zHruJ<`wBQ07_r?fo?^(+raiYYVz~nWJSCpD?O+#4Z~l2#GfRA{)_>~htl`3V_!*(O zp3K9CwFBfMuOk~LQ49JBAaPl|cF+Mn-@7G^}4n%`z@@B}qIfSnO|NaXl}ok5q^3dk{zDDA=}eHKhm zwf)hq)9wXq9WkM5d&ZhS_q;_D_ZYLv1I!O{f}jP{eB=Vx%TJq0(TD2~ zAh=@Gdwd~4#qnPDONM?a>j)0{Y>qJ`5h-rZ_f%XnX||ZoV4}S;&54*HKns6GS^9Lt zRKpPRpy#3JnOJ2k%LcmFVUIs;fH(DNc7K3I$e}KRVxoE&<*(5+!#kSWy|^2D&H>;N z^1`9lRZQIyWsY+w8ds0^+xK)p9QUNJY~abtXds)|!6AhvsSSz7e^zIm-e3R}PFr@l z2lJZTms>~uiy#@fT^N}_S24HW=da5HAia_9-VjTNwaj0*6N~Opc6Wa7AC$3U-RGJT zaOl@@v<>`x+n*oO(N;jB#LsYH@&Y50!TOPWg#pJeGZzW=d{7SkQ1I0un5Z_4awLAA z9Qn8Z8*E!sRoV(r8+7swNLwi#+oC9+)VB(xG)v*`QZWMzd^HYuL{}spq=1t8soIH&qgHmbI&~=QsjMS+bf-Mn0k{zx9EkCfsxA4l+K*qvwR_6N%a?y zs|d}LSBIfyoo$h8+271t5p1`D4jvpcn8mbg(2Tq5;PE^i<{h5dDSXBqvv}EB+ST`C z`xl@}J$L;7?N`|TM`*g7lIKPm4))mb$1u_U$wCLewsVZOf8)c}kmkQL|q}t};#qst< z=IY;JM-#_MHCK2l8&z$_%Bc&R*V!w%&kN?2Zx5p4siA3)!la2Ew$6W)?v>w;&r3#fzkk%+6~>wn^(p7%*E53GypH7A;GFLhht^yN?+8mE`^ zYPO8ctM4A0OF0`b(0VTu7OP63?@oVR-s(ugO1RUEFigH~XR23~PxV_}zb}rtxzNt* zepsWH>zL7s?RhJq(+M>!d0;yErxKk&b^L(wj@X;u4MeH#}>%kl<^|aYyjiO?}0L zKlk4AcJ%2lgXV+n73h^H(alnzqZzlZKQYfAt1JvIC&HQMhUy)(I2D41wScqdQgxWJ z;F1r2AB!mR%r$4jaoy}~#=46jXfSy3C}$t{)Usutbf0y%>Dd+*@u0xA%^l0|M12WC z@m23>3Q!~J0Kl4OZ)?7k`>a<5$tPWY^U;UAP zqapw}H3V&^2@L3yqA+h%`;+6)Ye%`Yd{6_-Nwzk3plE1eA~rD>Vdq77Gkd8vHP+~5|fdv=oxVPA;vG?33f^k7d|MR=8&I$Fbujn zRBFTSw%fo=PoADK@!2fGM+1^6O#Ir^htM(w?YKV$2*}14k!f`{qYZLtxX1R8U=n#Y}gWUT%idCD&s8DD?8g5^jH!MSt6#A7Q3Mi@xR`zWl z?hJSV{i^gFJ2VF$5mm1*MyXo_+PI=yw@eWrMbAuvRPNhGS;}0Mbr;UBBr29JF`(7I zEX6T?#sAzkl!PXIx^D$szqK4^i=Ek$L!&5($#v};rb)=?guh!82UaJ^Ppzj#ZX!5AC{6GkSU*})ppus z%-L4O&CaaX+fr{(R7(mzU~>&vIf_0n2(at1I|d0Ff= z)NXBN2X!8;9#Sf%n#2-ezY%9JbmcEu(Pu5*XDLIgr~zsSz7xwCE1-UUq&J6CSuX}V zo>g8Q?59B}_$)hVvzJkUtBTw%$HDb_z*IBH>i%AVvB8@r1IZ@A$L1cfZ4NJIlEjqI zZ-3$}XZm1}A9W{mP>@CHbgQ)J#Y7*`^7r->B7o?S^Kc|Y96`+3A^@}R&NTV#+@oii zrTdc_K#W%0`CrN{Jm}y@R9mN&-UPMlf;IhWh0;}# zC#?9x!WB#?*wG>2+AQ#)O` z9ld#?fe<^>qQJie&9@9R=>${i42u>%jG6689jC62E}}nJu7yZR*;F<; zil~otE9QwVf&f`0w(S(=?tTi)rHf|w3vWgGt1W3@ctOC(o6?Ob$vOB{uCGYRdft9U z=QEpm-NkRUB7veDMcW?iJv9+GO<}|4AfMzoJ*8MnZV08vr=&_ES#aerM`?uv7$ zX-ZPde6mJ@fvIuiDbX`j!+WiygZ8oV7z9n=nJ89Vq%eF@obkb{cr@tJpd4IOyoHZs z9iAxXdZK*VOm*|;Yb4Y@Y*l-pe|?n1_0cDg8XL5CWI2Q#VVDW4D1<*XSieS%I4^gp zDskDrZ1x8#sKxud>G}c=0_0-{{VBm2>DZW0*&bYwonRaW<_U+%95ZDN_odam3b#t4 zS7&OYdhdXK*V2)(F7voo#8<|=pDI3+sKL7gWQsx$XoPR;LN;~&0ne~>Etp_O@u{vr z!Jg-Chj+i`g({nQ{&l(!z^Ke=NA5Q&|KZ|tcgG#A`Q|Fx9}J;u={>MnZk@arV*&=X zxEdx+M9d$B4?OqK$NmKYMb?+o$rF|1t6d!LI8!U>cjRfsBMSwI`k45=2-y~wzV@rA z%^-ODCC>foiPUdbFgEi@eypXp@w(;umr8bd;u4j_@;P>*OFVR?pi6Lm>LPaw%iv96 zs%2+z$0Uy3c5ge&Gf2}08%`WLqC)Iv+jUh?%%rE0QkBNn4GAL07f=5+i(Xl z;}@n5{VxsX|73z>VEs>=WVgE3zmsJ3SCLEut# z!BAqZG|^Z0d*8ALq2($hT%Xf}lIh+$)asZ!>!7HZJc?*M2~&5&2KBpiDb&!$^BBbc z!Z1e1uC2iq;e3S6HPL%fH(`V%kl0D_#3naEzGIz(geCbmluV||AWKPh#H_{&lezNa z0xDW{*JVM8X=GMLfGo@-o5WuAD3H*T1v*0tZ|?DZka)|WOd-52PkU*z(D7MkWUEMy z3BuvvW7pSN;$4IeOFTpCY1r6OASpBV)zpZUBtSxL~9TidXjRwmyQL_k)^vpZYO z9=1v8f%xi@j&~LxZN=j}Qp08=J_Kg!Po1wKM5ZzoC~zno+;0Ni3g-M7g$rnN+1 z9n|e)W)`f*kOtJ58{2_uku#jE$NS5||LzpjMg0bJpI4k^gUq1n){vCfz8uBAw zs?{Xw`~lLZ?Ce!uz6DU04$7`d-ePw^C9%_$`cR;uu#Y=Zdjgur~>hxMxuyS7C$=o3O(y4pg zohVo)928m3u_I+#ifm`1%~Kzfb$YOSA)E95BVf^ZkF)Pwk4^L`8uNynXq1!4eyaOs zBa2BE6}usj-xW=6Ys^9xMMf+sT2;YeKry~BuY|{)!S{jPOxMyVCXFG{c;(A=&`$5$ z5dD(g1=wo{rAR}~8qA{4>&kRzMOq?pqSA_kxxN9jgB8V&k{xm9K)XLvl+QhQ=c%x= zA-;ZLz;%f%N>Ts(9AugqpgUu7;+V_r*#$x5zxa8geJh+cHdYVo782G|1#PH116_h} zG?1w0qw&B1kUJf~E6bQrw6ahC0nu3>%m!;*PEB0&+^%on4@?aS%eH2ds-D~IkiMPb zAikk4b0Kh`+?-5_!{Tt;RLrwi@(5XD2o7KwjXT1UE3xHjxDIxhTvg9t2PTquGlzw0~UT>VZwlHUzID%jIX6bjP*EuN*3PPxkmm&XsJ1r zz3R`UhjJ;I{(ko{J9#0T2m3yBz&l9SbOF~v#UYP*z@U0T6>*8|&$(oB{ zB9Eg6b@)C711i*^#HJliXs=qpM5aX%3l>v!X{cdWmKIoG>+Tun%y(c<}ufiz{L zlG|R0Ryo$Xt1Ek82--%~jES4*;PQ;~#NPy^JV0|OJR28>38+5XFQt{vyaAO+Nv;CO z964Kgm)^&&7Q=^7Ak*aRhlEND;>wpDp|6LFi;w5d*IHBzXf<1#FJNpBgItCf=XsNA zVs384H*|&y8ZHhKKMwXe7=*#K#eao8!p}UzgRRi_BNL39;;=R{D3i>>uXVqE@~0$j z4;_hKd7|&JA&DL9jtsu@dc4FYlmt^%D3k`(D%Q2p8_-N9jmC^d@qA^n3B8eMU?}2- z6VDZ%q1mMuXFV!Q2-L!!dSrf0&(W_@Szge3WE$BwzsN&lI>WL;OP>IcsuQnC13$*i1ZtL8|Fs?`8ed%e^|>s7)5<;%&BMYM zL5&n?xTqYgq@!w%*psVnK>sOJan}6yYW=tu>QYot7Y^3kzE-8wqrgEW)!VlIh1kKJ zaJ1cg7PZ6~s$Io0l)hWHer>s3@!k1uV62C-Hx@psFX)e!bvDy?GK`>C3pr`2xt#21 z*!M`R;BMnm-_tBJ!0tWRQ?5Crb{mK#cT=}L;6~`UnbJ${j7_T7!gXe;rMevNFc}T( z-ZflpDwS<%)LG`-_ZkK{SNJh&_UDp^)a$qH{r7!{Mi%3NOcnrgWIz-7i=5O@UH7}R2MF=K5l74?X6<2Nd%6a?Qxo#wp z2>Gb}P+*-3Zx3YT<%UXeBg6FTLx5T|cDmZ(E81`1?c-zK`g4#l!N|Q#33y2&t@M63 zoOqFE+H016=8+;O4NYiFD%}T<`@po1NEW)Omwg%$0^6J`hNr`0GIb`A8q)bwXq^eM zn+7g^rlhQq;_Rvp$cyN;Q^=76>U71YeNC3sg{BV_w$o>v^0kFyJ*SF7C{;bxbF)CE zDE>_b{U3uqECy{dgwKN0D=Gsn2s#6E^!hT2cTG-Q_!AW!$ z!&4--G{OdiPkeq+Vg8ROJ|g$I@Vp_;MG(!YVfPB6RR0%dP`PuEWnCKXw|f<#%}y+z44I4NLC0DvnkgrrGWO z$sUhzTnMdeg^gTp;nXX$7=954^braF#KlO05Kh*BU0S~8mdZeTd-2zj;VMafBB*pK z2kcXiMgrmI;*@SecwJmN6gfSvWV?fB;Ypmdea{%(RRAMHD8KSr@D{6n8hNS#FBlF0 zsJqMPI9YZd0cJK)P!}bq%`cgU3^FT#L`uE^yDV9boo1UNfHs%Gt$!Ql$Zx?UI3a}T zz8QDrv7Qxs+|ey(UvnKCNm&h`3S=#!{`!;iRc+&qhKIUjhH zc(=~Ino8sOV4S_7@qPExP)$stdDyYfmry6M4`5>*cxz?!SK#Om_NR5^a*cZ)+Kt+ z9&drMZtijT8)b3pN$OW1{V7_iw-GGXY25L$BVPSu)D1?13{eV8IYLLsuGt4_vBw1? zNp=IxePA(<*#DUqq=ADLxY_O62;wC$opyjs2;PZqbO^tZ4bexvL>Hn!ucQgO&<9k- zNn2;ngmNmi`aq1iCBx{_ICem<*X_96;c82#gEdfqEC-=KV-yT}LW6W7G{@Z*9kNyYdxAjflhHe zh+BLoR*9dqq$q(;+fr35CDv0P*q`!*u$a1~ZOR??!!EkwOfJST!i@^&lh<}#Ian5) zVns6|!J@@5-1GM_@o2w>Q_=(m@F2Y_kQk=Dj4z&Tuwn7<2ZF>!+`{-yJ)hr`KN2qT z7dX$0UJ;y!I1Vc&!s2ceQj&km(aFdsxtW&6N>fh(5T160|4bL_U=Wv0_wIlh8jyMg z=bxRjB)Uv~@Z0+13p6Pc0ZGX{)Td&pj{<_kO1@jRuORpb+~)>6Z5oW zHKGVd@|Zf4vZyuj_%KSta*S-WsC-8YaNX8XWJg)kRsi7e zT5Q4sUZ+39*BJ*RC0HFWP~}~u7mn+K%G(d*XkK43qw9~JZn>enBeqKhIq>@yqq)`F z>n+_5OlCL%9PXc@y?Dkh%zP0%o=`k*B<0zXw9qBUr60)>5{#$#ON(gaDyWLxZr$K&IS7 zkkc{bF6o61c((zXcv88^Gfi&{!kA@HE|;fh_(6v05PuOxB2%ajBM)6=9}i)LN~{S#RkgXqw8kD&iLyWb*gWt0 ze&Id-SQh=4F7kg;VlmM({>MjJHl|MOX4`#t??7AX1b>w{@pCY@4!kS>#sQoN+L=%* ze1yntLp+IELSyIaC6`_iv6e*OK>!mAap>TC&i>6$qm(P;SLzKE=x@UIeb?vW;LSIk zMJlO%vhw-Oev{OsPQ~FwQfKH%ZoJ~BFVB~IX(jVaB@ipo-Kvl8oTeDOjRnm#o>Tm& zNQo=B(y+0G+4}6WeQm@U2I{HC5vk{h0%Eo$NbkNF?(+2-(_4C<-b+PP)s%B&Fmq3i z{m0@DfFakNurDFf&Tm3(jY4w0>=LbPLQ+}!MX3U6%}u3K)*lmB2GIhbRmKQ;w= zVwq&0M&NBZm#7RcuBNv2UjN1?B_G(<*cj1hufvXdeA1P1HsI^QuQ62k)AL zP%{Bp&lM^Jw#%o@m%nDALSVGP_$Sm=u?bJ1&2<7jzML+Sd{gfBVq z5ihQv+$@mU&*0wueD1xl%)gB13n)W6eV|Rv<$q+xA{|pLOB`1(;eLJu$=l#qryajuLNVTD&s2uv z3u3!J>hcs8xHX>i517L&ZQDubUiZ`ZYSj1gGmsYQ>F5*YnJ2phy{nPe2w+OPP#`+l zp6)r9dcSEnzrH&BcSNH&_;~aZA=*forz3KaNGlxtJ}_cgUNuX}C;NkW>l(rh@%NGP zt$@Vy?JK}#HR7?HozO)PD2IJjB*FkUU=X{+BVA>{VCoyr*EBNITN_dHwAS@fbvQ4;jCvJYh3I%&P=FQ zR~5qdnF1k3FrG&}S=`JXlQE~Z*VQ;BYx+XHx{Zp7x`$32-~X z76lhJ!+WPB$_kPM3-l3gZKx5Kd_T{))9g>1#uYW_^2kted5@CtWE)j?XyC{w(Oy^d zq|{ZQ#sfSdWMISE(R}vK8tkQEOP7$l3PaQbY19K~6jUS}LNTSjl|2bL7<5$BFegF? zj8i2-DB3`?A*Sy;#4LAFgdK9#msp=gNYA||nUON&CNcoH7m+bE0y3ySqV1L@Sfq?H zL|#+;1Bib+Sn~`?k&6}1E4r{X@oYm0flW3+hFy4-VtFsojI7?GE{DEDd!$_fT56`? zmAHXGIjl8`R3(85j%&mCY;_^vK&1U=q~e0NoMZx4zbqq?s{bbUL5A51p~_U59VW^@ z_nPZsS&W?-Nf7d8&$eUm-n>*Y{eyDee(SzbqY1*^PLy}TC)XcsI75!VYb$>Vd&6g* zzb-q#wBL=p$&lHd@sgVHas-G7Gap8jgDWE)wdTlcX9ef6Yj>MhFF_3dXw(?bdW3}w ztK&JVq6(TxzbHHsB}~!`I>ubOaX($gocbcneNX)UdUHl7jsv~k7o z?^ZP=1Og2(+`c75r6DDfJh&TBA4de)6jue2X5pu>w?om>rXzD;kTV#sD^8O96GU58 zHNgF~Z{KTfFsv*TASI;Ol-IVZI-@Gb>NO)D^Qq`0rc+cQMIm(qY%rh@CCK81TbX#< zXpe{{9w(KYuD2?va2$Dw>D(*dr^69(oZ)mZl5a?!!s(Is!B)nv+1j#l9ouI8pySz< z7zFSY*Rx1y7c!jNurM4+=Q(BRFUqW3tw(sf&%z$H12?J#-#;z`$F4lQkRen-g-hJ*!X{Jj=L9Lv zn70{1`9xTq?Gow)zq%BhOcx$I2W4;n?rJkE_d?LId3eJ9N0t2oFw7xPVc$n=GB&&Ppw?I=zp3q%{HBZCVoK$B;wU z063L|H$&J;K2el*Wtya@kOmZ9Xoo{7I`%=&EUa; zf8k=$_h}x|(%;?WNqNb=?VR8bni%8LftFz!oD?{sp|`|qUk)J_FgeAnbYbp|BaRf! zXZ+RuPeL;)>bCG6jwwZz(Uk|wlhX7zX<&}(yMeEjfR>cEk?dOA{Yr59fhJ`g^bl!L zdgi!v`{66Qy>D~+JL1Lsh>ycGsuP?Fh2H!jgR}L$@B+tIZ|H=rZ67O7TvorHacWou z*#R8AGstW+p07g+O}Ya!KHKT|?cL;D(5O%6NZ3BR>A+VVAWdRUMta03{NHSwo_{|C zZg6_Z&wbZYxf*JF5Dd^VirSP)4Ob8e54GJP;?2%+7D3&aOgFkWyC`bCL^J9iQW=|q!!!8ZYJcZu4VVo-Dtt*m3A@jZ|RCE z@;AWm++pL=+vM|Vu&)VbIo75?UV0AGM})|*$SlExw7vfVkBb9`Cw{-L-|oN^D+dXH zl~?OOnb7juBS3y-#Y(=BL8Z3QgNWgfJp%a$n-S*!LD^nyKZzd86u`X0wR3_!%0bdPmHxZG($!5{9UF@^Zyczm9 zrr||kQdsn zzAb68AT(j?Sjp`|BJ{}VG4lvu=m4nytU2rSvyE@gEo)G?JGbJSB5nB<6mSD}F0zwe z;(v?(ChK{ydVU8EMji0S52iPx#YWV*b1CIZQ`OU=2`ad|M&Hs<^!}gEx^Ustk z>9lT*hN{Jclb3O zvjs}w!r!t+@l8&g(LcKnI1c?0qa5?ummaQho$DX_D{Uu8J_pED`E=Wx1G@;bP@e`aS-X&IZp zp8Z;^b`Ka#I4wx|b(4=oHs4YSVDug*AD3DeB;Nsv7z@GJ%0 zYB>?OkNLZg6J|E@xF>_s*X!7RACJxkoR#s&Ctjd07TzzdvH3;i0FQuU)F`9zh}Cqj zmT1VTu$1=?GW2wb%VlUuL{+68W~i>J+)qcZvnwjG%sPK`uLJlKUSw`sgCdGw^e3!l zVa&K%j7b>oy=&Y9PSM)xaB$N6t$&x=SDc6wgWHAG4kk{?svu~nUM-*6rNL)bh(vO^ zQ2|e8*lNU?@qjR9faE*>&GLKZ{@lQtIwRr^m}nl&haE<{?2T*)@;gss_s)))=7$JE zTBGz;KoTobsKabU{!TF8RatpaUEa=Nw-01XQ7fuyBFe!6-%2rLm{+-%*AL*kbgWoS zjRmr@eX}jAGg`ug0cWaRpTsGx=dRWX(mCgNn)rBpy2xe&VErZ0p-`rRGi7q;heL}@ zL?E2-6?7u4wWfyR<3$EE&NJV+yCgS$bdlA>G$XLXJJLyHLl05T$-^;x42+U6=9s%k zh=~{T1R6_V3OVu^F>V}?1$4;x*(W;o-vXMV=ALBV!%zdH8wAi#f0iQ^Ly5@BL=&yj zFY*_7p%repQDBX?d9VDuSOW?0Kj?uhN8-DY9std4r6d3g+Xsq=#rVB&P)x|w;tI%T z+EtVyQgl+HWJt1@lhW}J+$`Nu0q;cd^VNUp&0cB`S7C(J7LXVf8Aifeu7_ijG!pZ3 z0AS=gvG>oD2U{JM#PB&r43Otvhr{<^FqGe0^Q3~4<M$s3@46*N$W1qx)qL>tmBE;2O<*`lQMWxpfu+Cz?2ak&J!la zbT!Vm^boeQcv5on?C6t&5@^=y+(CHKhD7QMOAnB`ZlpXkUgrF-wH3z>S z5w8E^nL<`X5oy@(s_RLf4zwGuYYE5D+eJlw^jAc-kZ7oMel|4%oJfri!OdKybeSL> z3OTHi)6}C5L6#1MasZCOALR@50A|)>ku#Cgr-p%PpQR*Z9my`RLAhB9`=|6CwL{Gl5g4fLgEhRaDD6eocQ)&r@EXb2e1HDJWCY)PLovF z)k6&r&c{Qu8v;PWVa!zm*f$*zYOAEaH}(6S*v9nS03F^`$CCx?EG}kLw2H&Qm?gY`k8$g z2UjT9NN=2|l!h=9kN5Grm09+)diG3JKV@|KhmEv7Ngpf-1qBtF_+B#p7fK1eH(giy zK1!|9pG8kYgvCXE;g~^U@bXdIQv@0LYFc6|VLoJnpxWBZbsWxZhQ{oL_SS!>SG?8~ z3xEW;ww3oEP4hV!Y=pH>%4{8HTd?4OMm{IY1!z86j<~=DMSJ!HK|tTM03iB-C*$nv zTrR0iP>_kx+!x1dVCBAw=35S2biR}UWV+vSyu4i*7fCc|=A>Bs-dW)oh4t2cKi#z3 zDOLXNAVc_LY}lWq}e|7gTK7)Y`19DONU!R9kQZTYH_ zIAa*-UT1vO&4>jE=Fa)JB_n&I-(>Edo_lsS#N{=Sq6Rk*QC z6;7fRK;3N)&>=YHzCFu%9I4r?yeC=^-5qryi6lIYZ7GOZj2wOZUGY%spmQcB*MDb-=Hr~KYwBQ zAx!p5BV=HI24IiL<~-uUG{sRo__!z6##P@QLsq#$DzIw`#k`iJy>ONdebHATWs_K; zmkZ)O&%6+c^z5{c^W=Q!xA;@@LRp2wWbi8kpuah~CTP+foqXDVDx-oO+0s)RJ6Xaw zyDy|0?lgeGucSG!JY}A`b>^lsr8rWjHhS+o2OW@Tmk9PP_39DIC41JbroohSyR((Y zh%#C9QJy&^eOp}l6xW0C3<;rlf9InE11E%|`w>I&RTRW=b~*j~{QdF=<%2Hlv7%e( zGrP$>qpLXP<3{7{z)}Uesu}?4fuk&L8|Z3D_Vn=Ce%}^<0ilisjQ^Je`Ja*M894t( zg51{pzc-~AUW&v-+h`*#U4MBNe_qQC6OxWnI(R!d zLAU)WB5BYr?^RIGm+AkD5gAuo<^Sv5%vsgbsps<^K?wPU5Q!=ZAq42t#Uswx2*yJOrq`iVOnDHFW z;+R&uQb$|EYqr_JeJy=-5?FO-t>@N<-Xf|>?6bDrUfFVGYlAw=$K#2$`=d|x_W<PS4 z4QI6osD@-x6!B&JJ8<-({OWR60<;8@xM9{!)8zO^yMHBVtdSo#2;+`e3SEn8^D48( zvYs}e`hlab zUs@62A^1hOddy^1joi}a!qsUf_4)^?Wdyeo6o1qFpYG*x5pKju;l)=TmY&1f9W>uy zFX|OaxvWXLr2^DxtGiueuxO6hO7vn!^Lj{=v~@@9{;{4%*??qC@_^iWii<2MgW`H? zd6Zn)AwVoTuIK4?uZPxUNz0SZ_?g(}J#A{~;LeT0;sF_FRprxi(JcTAGj%e4y9HXf zzy_IR@06h?Z2-`f07ph42;*1rwG19LrEf&Zo^Gq{A&Yk_pQsOm4@YqKIAw$|X+II; z`4fNszV9Ecq&vtK_5S;YH29fYF>VSk^TnSQ^eZ8~tPaKpo~%&J%AU0aAJh17^lE~E z;4eH|_bc6t$xMq#e>%%BZA-Cx6Rl8E^Av64d$N*OD0JqNVV583$mMZd_~piC2n|#p zzo+XdEK^%yx`FVV9`9fl93a~%png4fRRYRF@K2oa1$QqMpcK0iq=`70!rixj{*e08&-vlXs;i5{qH8!M^$y+Xr>CIgR~E7dUDMqD zJrCZT#Q}kcb-0&L<%Rat9ohII?fQ!Lc$#1uSEA?4c`-JW$ z$NR?a$b-Kgv`%go=-}Za%kJ2`lV&M8X`QB8@#MKd!1{f-z_;Fjx^u`DN{;hFGM6vK!Nv zIA9bAWb3*tP~E7wVqA}(7d1*!`?VTuJ&7y5&*!;4Fm*m;%oC|booADT|MRe z*s^=}nIxh2Exe7h;GxHiOfWtAl%w0|H1g2AS^ek%9!0DD>umF zgYVgG3j>ve$uza@cJFqL{e_jDEVq9;0uYI$+ICM2>m=H9ngtLQrO_KGyp(&ov0?Wc z1a%_oiv=I^5}!};=Jd~#hpO}YW;E4IRrtz-FPg7l&OzjyrX{y8CDX_njtBTrOlG{E z6R?C~3FQ-i<X`l*t z{bQE+tvpWrRtxVlqCX#kakA-P@2NJ9=*^6s3c&Qw-bFz_`M+&&^^37Q~0s=rb$>~nq#(f`^$XV#k^Tqn?$@)9f{Fp<9W3{$H`Lg0F6o@wZ$^tx-H zGLHsW{KI`b=~#wz8f5o81Mz!?`c!=R;FWrCL*^@TJ$PZXlRD1e(N9vD3TOc5KF@2j zIJWHMSp z7|{8{TPVO=R}lu{lfg<5Hjt|O8n|-b;c+!~MmIfZX_NxtIGlfQ2WZYs%3e$F6|_vr zBKpvj`tY#hL~Fko0=WvwisfR5^*PFIvHc^(U8zz#_-$ zfhzmoTw>WZWMWx&XPSuhK~cJR1YyJWp)m4+ofGXf#)PS| zZ3pV_a;!ECTe-w2%S0Wtym4fqj2f{Hz{2iJJyed#4rfpG`0J?U&bNO}2O!sLD`}vn z!<2q8bX0bAPVD**4AT#n&;MS1WFTB~-|ZvWxfJOU(9l z!7Py3DJuXSKbTw)J&myhyYADVbt)zMZ#&QL3pTtTs^Fx5}%?ACj{i z`q%I+^^6V6`4tyLA)3o}X+lMV%p;2H`uIpDPh$MhpLSVd*AK+y7OL|ZsydZ*xuDd7 zEf0fB1)5t7<_=o<1a-l!?Mst8;DuYbEP+|*$3X5wg1GW#6`d66BayD~p(?OJ&=@rZ z8k|*0)^}4C0A+@(Mn49Q|6AISvQ{Ke;$mC^dnTJs$8sP^R^L|r(XbPyBdQTEPJE;n zF7civG;h6Zm2cBC@)qDgSre(R9e^q{Yqq!jP7HGU6CHLycnJ$WMN8J5^!KqUo!%Od zFxb9zP^aQ&V4RxCLZy%Jnfds@bnt z1K9mo1GNroS~-;@ku^)pCga<=gk*+PcIgw94MFD-Z*2g+@E~5MB8Ol<2e8mp*b00t z>3X*Df%t4`0*i0|qe=8lK{OoKj~0X12ZSs(M*b#!+hD5Ay_P^Zkox!I08xiRG@tzF zhYYEn(hiP!upO&Npp$DH>m#UYuuLc2(1MjOzY=J3ajvl%p*K#Y%`Nu+d_x{(OmoNG zmAhNjf0%?iD=lkf!2@{o$lNbKHx0%_SWtibFf?BfyF?1l@@GD@9T!)oZ)`scPq)Ty z(t@WvxiBlUrl6-~1DyXP#dmP95YIm3WGjRd(vf3{OpV|5{m9K8G7Q(`((m%Pv8s%g zLXKfGTT&MH&DU}9meN@HdO#i`OF=DF5?K>~oeb++uhOxNO8aX%u`PMa?X<@(*3Yi8 zCi7WxR0gY4f@WYfPFAmU$r`Q3iBp=Bl> zmkIzFqH(huzQ$5Qqo-Hz`_Szd)R)Il?SE+({}F+nnURz6zt5kqu_pf>w%q5`&P``k zAj@cs}Sw8YudzC_U_d7{QRjAK{5S9ruw>>ETKjO$DCYq6XgeD_xfJmI6ci3 zdnnM;u0dTKxI1ZR*7zRH3GQL#@iaw?>+Cg&JS%Ioy%kI7{30P7@{ItgvL2`l*#voWjq|CD zV{Nq>U&qRu?#l4g*6M@Ln*djLS;EJKCjfsBKql`2(CN;>ROV3`V?uY(;R%#LM!-N$ zsTry$N68#O-#FC&3$_wLQFbw7NRH!>>(*nUwVJLo2cUKe3y($$Az@uw2Po4#2A&;C z&^AB01xgl9a-6=}h81G*g{iG_&ssw?6Pw`vFxo(sRmRssQj%AqQKrP2e@f3vvCvT; z*5x#j{}fndUVzLN*--!QTYZ|3F6eSzVCb4Wm3!1Q4Mi)=B;pn3GBrqMf>{6TOS%fR zT_hvZ2^EujUby@L9Fq`CRe~^0EM`5%@uuY3Ni@R&AU%eod;j9$u`VA-bu)0ZXiESl zvo0>~*HFLSUWQDc`NNdB8381V`5a>LKzAJ+j-|*U;wMQZ>7G{=wpeKmkEY4zey9d@ z2o!NPfFKJ5&iWGfmPlazAThAG9GvfV%kf~pB6>jB2;wUbe#e7|@J8W?6)tbS+nmx_ zQR>GP979IZqLr2^ckg_k7!!;lpwBPIrX};JamN}i+)PS&`Pxbyds~nn;G|&a0tNKV ztGgU%_LK#}@C(|pG_pNTgZw+9+}QS*duv|9(%E_dJ)ZVX3rsypy|N}Cawjh=H>A^} zU_s9TE9u}J7JtGL&eam$bxkDl253%~G}9GQsV_PP8A^S9F}V#k`C!Xh`mMm~Y6M&V z?Tq=NOz&tk0~uako}2YXtZuAFtDx9*066kf#0$K>x;@BSQiA<3V#gs+vqt``Gw&da zy8&lxmyj6mPL0l-Q*JAWi{4G2t=p29S4@CHMqxJMIe#J+yr>-;M~n?1-vLc zta+0?*#JFq7un^v9vQHrf_WBJNnW#e0}QX8Qm&hqW;Q0HJ9_?^c7cJ!$nfA?Yc)lh5Z9HP2@2+FP1KX4tdJAh;}Q~pTL+Mzk29b`m; zU<#KC0ob_b>5n_c>$vt!*+uR%8w)R2aCAvHr3{Q<>_WDK;6A3_%EnSiku(lkxwb42 z!mYoo{B$31u)zsCE?t;F+I#AsO(43%g#sPhED*aLe#?u7Y4L*o2fQ<_(g@9o1Q~T! z69uGM?7F9B0IYAR#!v_numXyVh@-hucIT^*Vu^1G;q}Ee9PXNS;Y%*SFaVbH2ITtu z#f_`@7!bz6x$?+a}oGBfY9-@HVg?za*()(@aN5;`^Onb0mWCse! zZR5UdffD}~TaJHa?b1ci=9&xyg9EQc=x!%E97mXirgaFyq7xZpkIm|+A)D_F3dE~; zIlr#KjC4$(mn6=EI}J%E1R|8VREXfXOEfS<$(_U$IhGe1`}_QrC3QxOl0ztBts64L z@#`CNrHv&3`OEpEU?R{ToK#$|3vPs<&_X1ue$A-9zS60_yhTF_`8GQ%1|B9=IGEO5 zP-7)So+UzD?!5D%)Rfi5*Dv8=Ko-!csz#`)&{f=Z2{Fp+vMTN#bE&>cq4ZStJA^WB zX87hcS2$sXF6L|H$6lx{Iv6Eut!kKFt{YOKlirMcIp|Hl73Gy*LG2AAbD--WSXdSb zUaV8RAt@k5j+}C`1HU0mJFN22P^k>0H{H zzZ#BBd?Am=2#YP~(o`%ImZiyKiBU_KeA07T)p=VVNN`gNA`Z`J;&3))vVEFV%$3jtq%KAKP%>^LNk+iy9j zck6W*F5DZ3(SUs`v&fq$=eu*4ZRs>ur_Ql!Kmhvb84Cs=tM`VS%ts|M1o-_0fmD;{ z;3AF*(&9gRgQGpdSdr6C@fp@NS|*&BIn^EaSbl-H)ib-Ci6A~uPJN+xp*9CC3;Nec8K_%OISSO#IontR-pom>EY#z zu{Vq45Wocfw+neGht@Vc|mALszcW zo%Ego?Vg^HWO78HNYy~C_PJV~n*rKMxHt6EBLHQ?1(j9}&koaD65x?epaJAIt{&;* zPX~9z?!3Ea8+0cWe1xo-+2xWmwpzKQZl%n!fQ2#c(axL0rRNjKX|w7tK_^Dd1gw|o zk^8*qQXZgQ0`D8^p_enWbwB-<0RXL=pCvqCNY$_Pc`h=0Yz{YtfpFGX*xnSEumcm|+j%BTSh17?sMGUV-A;|>gfv&l z2jRyE=@lt~l3OS*rpfrh!YDnoS45S;0Rh*95}vZ?M+(ln@c=N2jQ-Ep-knsoC*lVv z^-a+bN&jA_Z_U)eIR|QL3y?MiI8&=DF@x5C1m&uItPz_eKJEYkO3eBE?^!+S6Vnl9 z^r9bk1@?6n8g{njc)z9iwq<0x^qQ4!Z-K6aaoXM0m8s9@5H?1d_+X*|h@Oi{?@ySp zXM0KSd9vh;b*dE8PTqE{(%gGh@6EWZJ|@H7SV_r224QJAa=_e9sY0Ydl)U#TM7oA! z6ciCCn*yI`k{kYaL5&jW4F|uE#nmb^#jX0Ba~dC!ajUcYd09syw9t8G#xf=0r4_?` zXUt>7dS^7$E^C`RV9!2()*DsNj3%9|Z^&CRWqpnM83_WB>3q1{6ZxbH zGGIc8XLE=l@U!G6$)du~uaj)Tz8Rqs_)AJzb4rr+eqlr05&><>gwJ$+QHusd;PVCz zWTp>BYccLvW}{8#Ktq{4uU87KPH+(dA1U!7fwFyXYjBUx1Uv5aStHswW#NF-zg8Kt0ApAYoJ(e6CrQGV zy(m{yNk2VZreV8r1sz@P11fx4124;|a+WnD38t30x47X>k*sU4P#?*<`r&1OramsH z9WAfrO3WAwc`Npw3PTQZwlX}?_j;Ncx`aSqSHBS%&ZUK`s9FS=-P}W~}=^x$H5(WNW$7e0H=> z^|(hy9CwTwjZ-{xq8X6xX9$1n0eRXtV^O;ItlK99f|HvC3@R zd`paFc~A$d{DA2BrEc#)YW*J~r}zC8nm5QqzVG%4jKhojpoGD{Ld~36S|v=DZX%rg zzW>&u;;)>>JWV%SwK2F6s|iW_-Lzlc(U6M-Wy`)9cecD)!prjM zNpR3f{C#uVw9BXB(~N)VOCV>V7C8VY+h=loK$e?vUk<3+htLp+HLaeD-!eFe>y759 z1-s-^7Ur|-P2!7ZPE+mk`g7{W|NRiaN0qTi2-&;O-`uvTf!cB#TZv;Ywzg0oT)U$O z1^ikn37fc-o#{{oPoQ#5J0~lG`_KO7h_zVVjVPGnZFR7{Rt>cZp+LrWAV}pU+C(KX zzrfR#(Y*Ot8cJGsJ7bo_N_EmwJDS>aoDk_!!^a;thNjwOaFzMupt9|nXS-vO#|we) z&2#rYQ*Oh`*IhfqTFdyzDhFAJs`NUT&$n#U?FxMu40n#kUz2@9)N4MV&ik{`JE+CU z{|li-IJEJi-_k>YzImJETCjAi4d_Sq5l)Y4L92C>ppLQ3v_V=%>hw?#*iF@9JmmT5 zFf!dWUh#}Z^!9KdWz|I~qCq0-o>=6T2R80Zr`U;7?yFM7MPX3=j+PE|Tp4;4()tl+ zXI2a$`cTF{F!b38kP{@*UqHpOHZWkiGa|`b#_h-#HDQS^YO>E92^FTHyp|OKRoYOt z5_~8?I33f#m}p%kx+&dP3{>iOJGEz0)z&sI!5BY$S6$4)F<#tqj%_71JzEOd< zaVv)9Rj~#ueA`64BTA=p&>_CKp${sonO*s5O5GhSE4SC(~Vq~p}aF}Py;fh*7<7_PywGkI#7ieIEog$(vpQ-EMKpTN>tu`eRP0Fl9 zFQGNM-iI=c_3222F!9Hmy=u@J!BI>d-?n4{LT{tC)KPsn69BA{h%UP<0Tc^6Gc7uh zY!aUDFlADlC50 zTc*HReN<$tpT;rXTSr#ob~Nqk3nY*hv==SI5ncT_coWVcl6vrnpW)8^yAer4uF@#JBAqn7Czo1ByRN-G(~{{^#P208H%b7yO2Kdn*Xm<6>xrE zz)5u&U+}@e`((T?Dp260^vl+&xD28jnR|y0#2)4um5)n7z*#+ljb!qH-riaCpm-=l zLM_AGov*Ml_RJNXYSC9@tk?Kh?(Bi8G!eODF9S7vyDl?NZiTTBp8@S5s+Z~&wr);2 z%-l1h*l2$SmMr%Y?+Tdt#ZNJQ2c8D3;E`qzmVhTafl8j{vG;>O#^@M~e5|*bC6_CK zB9vW_c}m`;j1*yO%{$`PzTfJBGtuSnTZVSoAFcsyn<(q zN~%dKbls9$m<5ZL{=r9tAq;K0PswuRj)oGOj39w=!i!D|p?WCjvMC*skd=vPJ$D(P zhwgHb^~w=LuA=;mDCmz0Rqas7vl^3z==VCHYt5je(3#!?c5UX;-$P>NFrPU^px59j zYT9A%ZW--h<5B{Ie4MYV{Rk^256Ug9f-z{>3sed8L$|d#+>~6Ct4yq zebJCs3JJ`rbOWh9V?aFJ6i@>4&G>p}EMG#-S~8?SeHhBl@e*T?(6#ANaJ_mPO1v;E z*9KbqA$6UY?YBr0!-7A@-}LO$4-XXd*aj~Kq7(3&aS47Il&oAqV6tIp$`Au1Lg#2o zjSJJI^pJ7=(ssMe&O7Z&hHBEI-29(Z-^8`8}{}juiyLl=-~49ZPSvCIAT8%>T`iu8r*0>1JJ2y=tY`# z8wmtSsYUtS6Jjn(GJknXq>9)}QUXQvektc$Ef)dcjqHM&IWR0+7yB?TrN4-2!(PRH zgvySJG|gGvJ6V0iYWF{DRcq6>U#)9F>95G_i=TNc2^MqQOV)4Y1($#G? z!K9T-P-VI_e7b3mvRBL=pviN!h$>zmpd%LagaX_17G%Y=k}vO5jq_i;|ZyD<>_u-EjcN zD!r&#Wf2ZjbFmQq?klQwLk(Zc{np?|%;^}>4V+W_9`QZh$zF^iK(*-GG481iu;BpUVYKcFVB2GoaKEUyjN=An5*ELITf03iS_xom$okgm7K3N6~eMM>X z0qE!t*D$ra1!qv1K|T}uk19Aw`mv2Wij2U_PLQmDQqF|==RTcFFUf5oOI|fSbtKmt z4M5)hLZkjF=jefg%zIrd>tX^HXISi~kEawZA5oD#e6@*XXkyCvnsvG!3iW}st#`2| zWw)$+u<3Qg-7>%0+p+KCYws7l!e+tm{}Q|ZBP|Ov11HD-jNRLI|E#tDv@H9r8v@hB zqLF`J@FI71Z0kWiuML2o{!zUQnIkl{UL+kGKL1Jk%HXx+8njR#2`pJi!j8PZOwWex zpd07z%+NG|em(2g>3usizU~+`Fsh++(uSwM2acePRQ4Z+r(bd>U*nGJp{Ffvs&&Y2 zRjp399`Ki62%WDl^w|A0+J-2u$|HEk!`}wQ`SBca(^qN~+8u^GwTn$PT;qC^J_)j~ z+LSDlWT%8IY{GwaRO|**+xKk>x@OTXbDF8~e^$IV0_QARaNII!{@sq6JbKrM9%m$R z?eM5xTV|8_wsT&+nsgthk~x=_l+dp?7;msySNOCWX>PKreD~qwRghblP2Mmv)a&+d zTHt3`4*GPBiB6wZcvW4r7h5FQcGRQ~bC{E<${9GBXUyTLS*1NG*hyv$U7EP1WfHSf zxs^M2cW6mgM7s&AFZO*CkgvUFaT<7{C75Jkz6wA=mxdb{&yWu&P3@ik#m6AKX%cR zjaohISv}iM!co3feq@!xh(B|ibNM}BML1L>>;~+m#4OJlCX@7SDF0p$;VIauABZ5E z{xYo}@^faavWvklcoPAvR>OMshNZguO-k;K8ST93#JbGPE2xW(_{_Z|>wb<2P-Srp zVDVbw{#D0C8?@mpfqK+mkFbT6sZqz*6FHU*cXzx@VBB4@CY!VFfg-)0uH_L{n^8TB z);BBaU5kxz%m`V&6kM;-7iXS^3>KY95~R>6_+7X!P8QONg1W5+iWS;c6|b%2ww+oD zfnoxWy~X_X&=XfyE7waD82BtqcXhL#;l_(I)y+BQ#?teonXh$&g`cfz0osA@{Qh(x zFWI6f{4AH2^odC8svUea&MU}^Qn{3T=e+(-dD#anUrBKIDz`2J<^$~1 z3hiD&%xblexE^FyY4k};IUw6{PP6;01ZeM+x_R4%(*2u8UtAuQf`;-Bysu6MO7i*ecyL8cDkc(dVBK4eX5jk>9GTz7X!acj$xG=U@YSokR zi4!ymrZ{wW@eQW=jCP3>YWO{3u#9GK+IJj%U9+pbepBy)JRW#k=M>*ddm=oK9`cA+1j-~uC#OC%R5NLC zouvs2H%P%mBJ3stN{*EM#_E^l8tXLRY21ji5#~~ezZFA8yc9hA{paKU$X9>%m;t{q z83$5jIb0o96xFHnuQ+FHR|7{PwK4e}08t|m{(W~o%37%g8HV-QxI^F3FnqM0kwD!& z`ZNb<3MaJk?Z$&ef|iuM+083}JQKRLzHEU$RxRo{HPbeA`DNv@=8&vq0ZF(w{8Zt{ zj#OIE^@d|1${-P`+hp7fMI;iCkY_-(@WwiW>K5D+?Y`8Y$;GHu{Ox%6??E4@$lGIC zOoY%152nL>$3LR=p&q)Tj-0paB3qZXWBEuXEAdh1)oDFgl^ihbrS8ec`H}gHa2b~Q z?>!3Y-mcC={~+WcA|QDJVD~oc`-j9*W{sAQ-uF1#n@QL}1*{zXu9#~6Zz}xC7i7U! z)?1GPTMXLtrul+}OcU6WLQYq2=#`Cp+KR-606rxfCZDHBLHy5=T7&;kpXbAY3$616 z26rf{X;sL9C{15uQ`(7hRoOSF2(p*&KU#)?0ir0yRGC2hD=3h$xxCxpoAb+|u6{Y)Ni%~b@`}?tf;A+rY(K$@G^DX79t=fbD)EojKK;7=HB_0v{>y)K=9?@3F2X~MWd zjW<&Vb^f*TiqPmZ1rvbW&_?#Sb!^3QF<|BL`815$MCXIzgy)be*sScC-T1EK!iU2+ zh}%b9nii}qSEZJHnKHoDXqj{)EIO`CPaL2f3y__xf>Pi+-O`OejOMnaT)>AfyP+0Z zIdGs^k98qZk4KpbHaPJ}-7I7+bLNcTdv-QoLmqf6M#F}B%{Ie;T*F;dKwVKJFIXtF z%5m&$vJ{>6qy%SpMB*y0uEB!$$LTO&S}?^lrR@bNLxNOdWES01t>1{yYM`PHkvcx7 zY}Ocda~X9gVCdk1#?}X!MskwpSl~u9@4;~KarSs5 zt%r#LwViherw9^HmVjqo3!M%fo7&~InYx?0HG-!*y{zqrA|7t;JsHGi`XRO%444We zu=C!|Jbt+Q<|0)ofaF4I&LVF|g`uGwM5!`J;8*{Lv3Cj*Em+qr%eHOXwr$(Ct5(^z zZLhLz+qP}vt`pr6eNXg$*l+V~zGZ%y`F~?P1`wT|o4GWX^!O~gdEuv!rv4*)gZtiyPtsW18Lp*uk*M?0myVNTUm!U9P>n;f zwE>+l?7Yk;An_~2DzlFZD94+FBXqzQ>^McZWs*a&!(&RTXp=otR!4EbaV>?>mDan& zrwM9QIz0=o&3phgWsuly$kXSjL;16_8*7AMlJoDW6vOQ>6bRi~b|;G_5QIDwnB0Qu znK;pjc+!;c5T&n%XBi!VmdacDe{No1+wMRUAnZ%?6 zmxF*mV0`Rv4)w+N<)?XQmu8=p0#KGH6te?<)>M)P74A57E4(E5Kt&91zvgc1ouwa( zwD4AebU2dE&8PxxgT!|!L4M)WL%kS_b7!ejua+q!T?W$oX^~ohmT4`WP$MW2PU)f5 zO?KZL+j4a<_OUxX1CyLti>%>v@<_81`3)a?N(_DsJ)7<(zaDEp?5@Bo>n}OPyTwxn z(N@Zd;Eg&F`-u5^z;gC9n7bPvyK(Ely*+M5>7CHi+gDE(SdJ1-h_)Bpn|5=KfvVA$ z=-?hWH|^h%sS}`Xa~OR&?g?+I$rMnXn+=R#AFPWUff()l!JDZO)cXPz+09cAPB3OpDkqhDlg6B+?<%Y|?zu^SE}_ zsLyzN`b~=QgGY-_JI2-T)Q83)dmlmi@r>~%IJKw9!L}w8=da4i!a>oOr;77~W7Vrs zI7Ps0Ta ztJ>vgO;98x3@R@=NdfFuFED3~wlR4zS$xs#yfndg`vnfZZLyZY+Q6At_r3lozyDf)*z;l!Cg1w8I(26QR_G%=)-`x?XtSyx z7GL~a-u^&`EJ3jUhx5gMXVGF|`Cl_h+nDRIhi&(~|3hRv?$@B!D{S)2GC`O0m#GnJ z5a5Eh%4!KoAgv{lpFO%%9;TW|oX$N5kVF942B2)vsQ%1X=l?rI6~tfPfb`S2{Ls>*$pHg>*Znd^iORElbmZOV zZOIZ009&^-WDf6Y%iY>CDeigZFFV(&Wb@{-@piLn&@NfUrq5~~l}=$ueUT$Hw1d-C zXQ*7PxHvcXYKN~|;pXBSc<^ng^k2wk&f+hQPl2Z$pbGQ&5{?Je|NmC}U21(j)^=LAz|OL0!aPT%bv45*p$= zrWEvOWT@~WZvowx(yn^=C9~m28yncl#YKf<6BAxlf&e&D)aFWD#+)4iv_Zp3^d75d zsz?1CO0e^bQCi5|#>nvGo<)J3WdKE32=`yB4DwxdZ5=+OYU{1>gl2+A(gzI0-X?>^ zkm#{rv5qVNPUeiNc+@-C5zeKjef!75L?x|FH$7a7?>A1b+VRBxdtcGP_KQ)kKbDnz zIFAPdloo(prR^LY?~IP;gu3Z0kRSJqW;tZbWNQ%;%zcWdutpa{;Z>{zKTFdB*5sT zQqj8f?A<8%4PAEcTD-W~Z-b57nY-DE%+>6thf8;#Y6V2X^NxkYC9)ZOMm*Vdr4eSq z6)tOlvwZe&Z)*cu%aHOf^hHJuCCAiT&S=g~HSVBX8nx5QhrsLr#|xa$QOP7&X-`3Z zK4vg&BwMjzjd3gejKEJ2wMhU%oHBvn>*Rvwu~eEDC=&+(`MrW3pva`OO?FBEYg6jp zSh4h$-_4abX@Yg38`m^dEJWV^A=y;gll+ukoTC}iFwXcKecoK_2096W8S#dQ;BzaJ zv(1%vcfth&gWh^3&cf22z2QZmS;6JXmiMaLNBlGpoPLSRz1FMSRd1pvCNXv_RK4X9$ zX`+G3g36({7H--lyTE12ViYo<2gOb)Lla>~-|r49R|?U|FMBHFfR)jXtS$81UV!ip zIhYu9>)HbDWFNh?YSf{Men{90M8vQ1h<#J}bk+$y-prrr_JgkNKbpwF2XzscBFX%ZLu zv7#^~UU%Mo6oLnwFG?m$OagH+U-{Z)LzF_1M1b{?^#SqqNEkf(gdmk_FzX*WG|`kc z5(V1cZ;lg)Hzg#w@@tEuIIfOM_cRwB9Be6&WEKpjLXwGY!2bX;%$(=zD#0?}A4|;I zX#Z>pxGAyrm|RuJalF(9Pq3i)4E?~5H96h1^RGO6oMAMirhqB7CB#-J^T&RaBXoMp zC3_hQfFhd+%G@9?w?Mm2+O=2QTw;`{DQ?glRd5*X3pH+-V@%fI7nAO1QawQ}$qzZ2 zG05MNEeCvbQCy5xjj@MC3Pe{c=Ag@3(`jfhh46)7t^=+dM@@lu=3t7?h1Q*%Lf`J% zeN4!VgF(+*jdjsStr|2}31A>KbuZQkL(|nAj?o`(SQc)(O9bXIwi!Y0nG8!X4(Pew zM>NStoyNnB+`}}kC(T;~Pf(;anI&`tUr!Mn^*~jf~9w5rQ%PcP)x_8%Arr9H4Bo4#w zshipP*&`yN=X1knS~47S0?!h;zOXqaH&^xd2J2G1Ke}pEH_f}L`?>Y%XKG^`9rCb8 zIu;!pxXxQb5Bd0(@(3zq@fhwij2=yXZ3{HzyUITu5NDRbb#qmyv43~A@XAf+g*0g}?YEc8ZHF29ATg|*{_IMg9)fJ{<|?sg+1N`Fyfd1DRII z^RXE7oU33ZbEn)a?ZaMwdteNp2k-BRc4OmapGo)vb}gs+Kf>a!!T zksY6XQ)@vaw}($`!rkqvIv8vBrHF^%UyPHwnUN5d?N>wWVSk1+=aMCq0bRb#P(Ci)SjX1XQ&Agi5TfPGq%f3dv5z|J%A**ZjChu3`>zKy( zX(H4@`{J)YzjYsnvpzp zX5Dnu8cfa93lmKT&F)|;UGfTn`$^B2_mq&*t?;Qu83O}Didb4)oGb2jF`?tlmJl8D ziyU38KhLIqgTALryX#Gj)`YCGIx(tqS|}B|Lez9(c>Ck@sLIv{BkPc9S&RJQn2B|S zgunSR%nT>Bcgv@jK?*86BcZLb{BgL|tCDFs1PyGXqC$icHll}T34Xf862C>-G--aC zy7ciui9(f5Bvmq#smYH;&aUNH1%)7Wpv811u@-(3rHQTTg)gZTb5GiQyzQ^}u2tK; zRYhbm{)nNg4LnDArODb$*>>jWZXMnahT3zDBe1PI8by-t*25|B?@|u(A1CI|ak#la zn-<+2IYqKC;xkeAIi?WV3uEO+1@0jomDD|r<1W8Rehi{(la@0Fr8W02Y&5?RYI&ak z>_CEuwE-n`p~(SDA0KN|QX37gWp`odi|q&OOn=)1Y|cmU^lI5$fvbleyv-Xz-ny(D zcaOHgwVW4e325E&S8>#a;Ctvo}U(!B#~Ti}C}}D;CLKBfJe! z<;m#RO#bv9;mD9~6rF1PcC0Uz;mWaVrbKst4p)zi1RI@UKiJVR3}%l@g>e!y2ad_0 z<8ZlJ(T)ol}Z9w>+vmjbB<)U|T;oyE7+RSHZ zVVf{raKnPgT5Jo?xSUs56KcQE1VcL`^|$2#W*nh&&*HF=Dc{uXs}06T2eM|sgu%u-6LA{)tr>J)mjb!`(;E|4)*(5fRbRE3BF!jV5O+{vB*1W#mt4^_F#|0MNYKS9HLR9Yxz`aRq|c{9 zz=-ck8Z-bPpdN#-S&N$Hk=IcXTx$YR6WEvoISZ;PV4pDa!#Lvc~oFksWhmP1d3#8US_A=$aD8xwLCn)Y z8OCRt0R?8aq9U>3OjxnE)hh@irAE|j6`j4DY8z+2f{(+poDWW0SfUlz=fwpu z)Efg(;SzF3spj`zYMcR&V?>#hxWXr)Z18|{!dJdI-w$_z&-1*H7eCzf2jYSp-8@i6 z4fET8^DE%{?C-F?FLtB%wYcz1jP!z`it5KhY#`=uP*JJaV_svez^>f(o5}Ds)}}@# z9m^Uzs*Z9700VffGyI^ZW9ei#dPR-^sx<4pd_X!GhU=3+-~Wn#R1 z0$c(XwaFvyuG8{JtBQOG?vF(ej+m_zDom_6%kS_%gaOmTdtYj`1Ap;CW6SK?;Jmso zD_9!kAldeu+;H04?Fv}1G15|3vm%Vh94`6Vd)-~!apGLLeJ@IJwA18RiH?2WLG^cW zaHryu40!K6>hSPEwykquSB$f0h!o9-WgfOz83Ui}=t#!HFQ@ZGx%Xho^>x8~F6dm- z$Owm~P>h08cXoG#Rd&&t*=sMfqNrx`IwOI4GuIb~E+K%R@}B){K60oVDEuGL@fATv ztq|d@M4RI)SKn~YScq7`24fQbm&2(Z;;G_jpevwMqUT^g+u6V7Xi(iQ|8>DE|IqQEYM` z_1xCp*_sfngu^Q;IcZ!OgPje_fpMP?0&V_LpxO9~sr?}3)bY71k6J~cXt#bYhz4m8 zSuAC8Usa2Dwfw7Ql+wpvKSA;(ulCOuTKigc>z7QOFeIuJzWi-R`jDdFSn#;)^PDF^ zdilHaYg___m_-znR{v<+xkFJ>`02%=!T$3dN0wZF|H$4E?p&~~UFJ$v=;ZOGf%h#< zu$PDADJeajZwc5tsLg`>+G(6zqRh>f^<3}qx9QF!Vn{hH9^gP zsI^J|@>73|lh7RM?HQ&BJLg2P9ot4+76}Y?i>W1YJ$CVG zCDxD}qVg!l-1I;PGZ(j(y`7@4bDOBfg+}!rOtzBaevzxQQFk`W>il)hZN)j(gWTOTKkLW%FVvYV}2-6qwELery-T% z;-$TWi_Ym+Y?_Krv-UW5dBUTz3jR`-N>t^Rr{>I^EAL?W9p&)-=*F84;Cv>~Ag8!~ z#aSZ>u91f;Io#fcw+~%zv;`k;WoiE@hqLLGXR``DYnnqUCd06ThIp{B{cEP({S@SH zL$CMdi|}^xjKknz!7-keyOTB+_{YjTTuK;^98ta_Bsi&Mw*jkGSpqjDyW=KaoT>7> zuz8sC>Jv$mP5C08e9$gr_<2~3-AmNiTCt{0JlBCtCjS8?1m^9ht!LW_841qDRyI3S z+wuEp%?|hTU_fs${A^y!B};@tVb*)#EKz0;L(rMnL>mKDQ;gS0-@08&VC-3JELXB30%iho3qdI9%^#>kePDjdDD9B`7u z^-~zX*p2I(<}`oaphQ6_A0Aw*Cux4X2%)r`J5CViC{YjjJC-{w8p+-i;mm7M!rZuW{;gNCekZ6 zJ?Iq$H4G5K5+nLyJ+qc=f~dQt4!Ck%;gYkHhafuBn_!E`=^=dLZe2FBVXj}h;wuvyY&L# zo!7}9v`s58)g4c|pqx{xha4OR!8l{&Gr@~`aT57E%r(;ZeykRs^fR@o5fD+Gl60{OW1diGqc`$A2f0Q0Zf$fT@UjZIURG=_4J~e`-hd`ez zqHl0DbF3T=z(*l4BoH!82s6^d7g;n|=gb*f2O4fU`^%-BT!{Ano)tS-Vt?UmGM@-? zfMs0nQNhgl1X2{0l~S|yF}w?%{aZ!4aWy7VfM)=Fm3%rV8nVDKA_d!xs!2Kqm}7+_E41_Ac$^OS&p%`&i1zB!Eim4nymqaVN*GlMYoK ziOl=RKUT;bbT%x!IdXDtn(h-2rz)%<7L!2-o#zo@d`i!jjx%F}{!$ZQ%G7_D#^nxv zJZ4!0^jXO`*AxxQ?0=$CCRt6!%IcF+)%gU@{dhMivsfWP{LRC&#)qLK_J);+uZ65e zC2LgNKO=q6!5xq|Ve$TUkIezLd#|b^Zwlokq>)cu>y`LPgg^yQ4-z zhISke@kH^cYsch1MV1 zLcztENu4xnoiMy03xiG=dC->F!c#Dn#w?0FPM_L>pmK$w8D6Z}Nuxnq;qcIJ;z71f znk}{iS(#nxs`*g`3#c2$2zTK32PTg@Sp4nW`E3gT^E1UED#n z!df>Wo#4SIcJN_EQqvbxGQ8Rhrm0y|T1>N;0SuMUvr^wvzAMv`0T33as_%g@vD@ZN z4-MnB_Ien^91xrVblRa3^g*?0-Tv5m)ZD>Mtcg*%Ys`E|!tcx$(yLP8PFy1p{P)NE;6sl6 ziRW*{RU@~FSNlN*o-Dq@Y)B^uK?P3bS)0V^vb0~?UX6m*N69i?=!Z)kIywbe+cf5_ zdEL~~^I+8{29d_0weFl}J?d3v%K=?z`1&HX33hta6cbgpNyelsS_C<`HcqX_?VYqb zlN{@aSdYuK2(~(WFg?tRCr8oszAymkRX#T&&fYjWdhA+AY?&S%mccyBWRD)8`pELJ zEF3fp7rX*1!DAe9YD~ARRLt zAfx{KVeM_JDcX7H_9P;U6;<+}^DYi~g?8J-)~M#jx(}5rBplqVg5#h8#&ct*g9(P? zw3lI&r_e$Z3hsjGlVipigG^8L5?Ow>%>sr4{~prC@Cv!yGR$HjUtSzeE|5VCT>`3| zd-j(_o9xR3wN{|5>U81WMN@}G$$Bb9kdrGbtl+H+1fckq0t30M5^q>KxoYYkHG_~* z8;=-^+mb2aeB(?_D@335VPvp`;;5~J{W*F;^7%UO0>(R;hg_pdsgNa-y^juQmwn2+ zfo_btn4m7{7V`-DHVpvH_U+bn|AJso)dMYhvnw!D@V`T6P^UuFhk0+76rd0naEyis zRiGX9oB^YG8(8q9F55yM$nfUa|MZ~F z(4aJ)U$SIRTSn;icuB_0{BaI&EGkOog^0{W$6vlaRa{k-uP|o@BXW`qfoYzrD*plE zRA&$3LbN2_%Fvoaf1T?2=>BIO^DRn`f)Z=Je0bWeU_c0Seyy%;{j19B&*o0fp=CSM zh|0&blj+~TKkd6$2c8-~pC_v!%TjxC8L8MQVCrIAhz2gE*oeup&ZnCYn?W_9FJmg) zbLeFbyK%kg6%_rE1kXYe6$_BUJVVbJtxsJ=2s>Vg+4|KZw0Vi;O{UxUakj09lc?cp z-)OUG%A-I{xW2Neaqg!jHC2B)LYbsI(Bly%5@1djdp04>Zpx12dLtg&TeL0q)J6Xo+&L#U%=s5lLBhXrGBl@jKCfNZm#mN(NcEZ4<>T7~ zT&6<>je}j+tI8DbK+v%FOHPk*_6F6V43{$;0v~w64#WuO@(f`_YULrChrV9;FjW`ys*a`*2NuLr-7jF3E+-0YV z5|zpU@IRi^@IMM<&NZHXB=@{?@Z}%dXNVskf=ET~HiBm-svVwe9zLH{fO51l~I0sNb$dY(&c0>#Em`)TeCIZ zL2p1$OPAN?D3}Fyt1bI?)5xInPfM5*bmPK_Tz5Y2H$>=6yn_Mk%J3#s7hj0KOTQB( z^v#|kNfHwvcX^=FS5M=Gj@7Uda@UbZBupTc;Va*NRSgGyaw@VY`Q@5{CID=i9GWl{kAoM=UzP)N(>dR75ven zmC@B{?1JTpu0`dHR&6LxMUcYZ!QJN=ydeur9`#9!$9`!Dly=~M!5HB1iM$*WU4_9p z2a^iwphPAY#h#VPZrCms;a88)P@uqH$UDKHgl5FUBeA$NWvx((BGx5tvY9}c=1xrY zCpZ$fx`F{ZgJy=56(_1ulvqg+JS%0HT>`-3stY@&inX;&jN&G7YL9feVfWY3mm^>C zbXp}Nt>O$8`Rnlc9v!9w)(A|fnjP|$g z1+&@_Nh5?lbh=i-A;34}D-Vk9Aeb$TBac-Dp|);8N_ddrMKUguDQ^&27>gqY#<2Y4 z!$wEh`P5%{9D)zCU+Og*k-#j-zGo}1Iuz_i=uKK?!%)t)1&u3h8i2<93=z(etwcCH z;|__ayy|vzwz01eprX6`BkHx{G0z$J@Gf8&Rr4t$Qy3b5$s@(K(zH62lCN6LKYvYw zNVFZGqUW$chqmm2+09dThoM7R_g0DOLfiw_HO zO8U|ml(bLQw_RRY-Owi{!qKHvv9RX~ejGLC=__!g^_67teQE0ixOVry_^xfv^JUk? z5I(QPa`%wj(WY}D6OklAr)V51X?A{Q^@)ji;h-g-lz7JV&pv2ub;)7UH)7eqwJ*x< z-7Nu)^FT~OB?;D@LvP#3$6MX`Y08Ag@_u1*@4gv3cf!j^tyMadLyZVbuN4X=uvg35 zW)z(oHFn-^Bp62GR2>`MrWVQ7l-MWL0#yhHZciV8Pk%lp0Ti&kKbv*JI<0YQu9PE% zmP6~m2;q9?*PZEkz?>`|1w_+b1)fqp$cAyl*N; z%8#T#8jB~s2!MghzHiuicd*8_ieJ<4!;j3JMAtxoeMVV#U~vmE$}L+M7<%t8e9HsQ zfnJtdz1ezy;qG=(_E3Sn-N>%=KDe>Q-)b;+A88HuB)!v=z0F4xE*N_z5qFP4c8}e? z^M>6YaeAtLfp)v|2HmCK>=fv@LwoT;;-4}G-G7Sao>3R;@BtI{xA{6`1KpKZcmIjB z@9ZA(mf=tgG>u`7OR;_rIO|66h1xR&+Gz`P;!Hg!Z^1y5vw$Z2dNjYj<$nPWPnc!@ zQ%dG|95R9<$qKNVsQWO^o|g=qU_%y-S%54;aR9H)KNW)drjW^a!qNHp z*9U1-b>b4O{Hp<0kyFI8Q35`{QWihEQ_=u``#9=XN!GXL+nkGH+wng``5Wc{3Og1+Wb ziV}z7-yfD$rUxJL&3}UL+a-N{`pRVaqHkpWcK(%1Due!#KxV&Nin=bz%9#=^ZO(hV zIdY&DWorA@aKHBNoj5vlD~lXr-BvpuCziz7s=KxJ6*fAIz|Lz~Ayd_NUkwNr#|i)R z4?C3X1ov90)4su~K~FsYn8zL1ppwq5%OU@)9M)&>Nmb!_HumA@a75V588>-QZXPX> z`ziNeqb*MPv1wk7OmJ$)zEYCpol6o^|JVH1)&C92>O;i;hOjB)-~uM?tLM(WQE46B z|8`3&VQQBzIS;$X_9!8>1UdCN`(SRqTVtWpY0ljZOO>L~tuwv)qaI^-z0-u&P8p=( z&Zka$`^+_0qsrvwdnAWVJwc>z5oBIE*gB}u{O8m)-!qKMMvwma8TUyu=gtX>w!|9# zr;DmWXtymJN<@Ki)LOql^L`RK3*!d>^xkX?Cl$M5WH{slS*CLWDeSV$^1-9>)q|J3 zE@pu2H1bv!U6bh_%Z7mToG5Hic{b)Vo-M4!bJ8cBC%nK(?LH5gB~=wm55>+FJ?p8A?g9=&XL7{=WYk!^OY`cwR*o-n#hXO8Ev_`?FG z%Hcgxc7OPhBn*o+FVdcK#1?gHjwYZM92y{WO*N2oG8KW%aF~PYtaNi1 zij{7FJnqH*0tkU($bAAhslms#L*?1SJyLz6yLcC#;K_q9wrGW7SUt-t!k3lr7}eKH z=4(My!6h9Fz`$1vd`-nHtEaY_Og+kgK3rSqGd`JT#v$qoIgsqYAXiINPs{ysU#~fSLSK39JR( ze>6$*Pa4!ylbp7f0UPXaHn}((I4#yhp0vX@F@z@yl36Od1$C7 zLrQNU%n*oTSDF9x)wPV`3}~3ZJNz`Oro{WhkUUIpkYxDF*7Ys^<#Z95Q$KyH-l>Ck z;9w5&A2y*vHf_s%o=gHbpNEfSZ6_zZ$4G9yaqG_Q?`BkMVoc!RTDy~(n>^DV~E zw~XbS5tf$=UhU=P5J_KwogMLydqV(LxC6+Tkm?YovpI^iYwG8?;e=%)PqjIUCLPSG z%;~o`jbjU zPrn{!fGkDIC}P%#fJy5=knu+{J%Sm72_DXC@RPNfrszUCv#G0J28B@!$P^r#`{k|I zzDC_&1%Fb!%F2*!79v#~*OPJ6)DuX`!^ro5t* zDMmfox?M%DmtGNer&qXpgJr7b-k=<1)_M=T(nXXNDKL@pdi5O4!aR4FaCC=L&wE$b zhZ3sJ9lZP|3Sp=3$DIosWDW&IitKy|rU0%;JVV@dze@WG ziNjqDpclcCA&q|iktHpQLXwPHEv6EI5)HBNihrk^X9{4dNhBDI3r-j~x6D=CftIUA zL-ruxA3hE01ynRl_|PVEd6F)Kb^qX{ZMY`FtRNS+CO+WiOJ~rdQPU<5C@U8R zwa8tM&Pn#@yJra4`1OzbK9;=8QHnJ+>XD|C8K=9SM}6K6o1a}Boq`?S{$7bZMZG^c z0h|2{wrO%5gXonNTd%!u(ZL5(082b#5r0AcG1nmfwuiFt2+bsSM&fuF_Lu0H1b45u za|i>QMK>Ik)%p2M8e=@g8)r0c+A7LXLQ;palpR{dx3H`2$R{njl|YMb%T#iyr|{57 zQLBOXs+-PqM#`D15Zxi%rJk8{0{_s^m$kM{2>pySw>hK!5qX-U|>@3(J}g$C{Rf~lS31$`Fy_C7eEtp{9@*Uf1>~z zty1+(SdI2fU|PIB4QuqXG9_7g(CmI>2qf-1!sawXr7xRm28H;y9F zK?8)vcYT38hhKF^W`+;jAT4Fo&E;(Z3Vc*>R%lN}ACUT0RE@QkJRsZSYGi1BqX6C- z;5|<I(lU{2JWAAa?sOo)I0GZX3A(S(tH-u77%?b)Mqkc@-L zMK_$y-HY3L4FV&nzL?xIjZ1=vxz5Y12pz^|+ zI!8O*;~gy7Lxu5n3yuLs;)zf~&S6|%o}$C}%yYCI-KhM9hvIvd+lQDJ1S8+{5{=D< z%8X>Ktg?PbbDw;TEpGz|9#mdJ?BQo)RVZ~wrl05$PhP@fHs2Kz=d0Oh)$BX${PX#T zYoYr#cV_+` zIo`;JljRmH7(UFMF>h|wB({hhz(B?L)&@YnTBQYnJ@_p%A;Q4vOlwC2X73*8vLL10t zob~x>pP&O2XjdFtlMq3FVyD{sR`4O#o+CL7{#swSzkGGI6-1|oJ;R5XLlP8Htvapz z>A;Z}m}%%>a)e=|(qGMVrk_EYlEk^}d7m1TBZuA(Ps!Gt#W#!_Bc4m6VB`KsX?a~` z{5Bm`*s}EVpp@^I)?Z*!B8AWYaGGHJ@5E~C%>Rr1RHC^Zci8g(l+cp`()ZIStUeWV zYTAiJ6IghGJY>w##E%?K*z>f$>yfD8{ESp3 z-cGBwEuRP7p1;N0k+M^|P^zvMrPfjus+ZiFw|}`m9ja%HeKhTpl`_0F?3-5B?Wcbf z;s!tXH+yTFP+)eCVs$9l-@nCKcb$r&jj%?rb(yG}hr6+3Q@pt?}CDo&~n>|M1*`;+wF&u(bE8JgytdE-ssn zp4IU4maHLrj*BRECGfZLv@-u>5|WbQVDZ{|+Fcabx{cGOmN>voV7MPlEesA+6DcQDT# zY!5@;f?pZk=T1lBxg6Xu7Xs|EJ-hC>IrA}sk#PIb9R;A_m@(u-0-1qzkRwrTEi38R z*q;&iR?>uBY|TFO&4k{NclLC)&VFnF?#syD1hk0;XrG?OFY z?%J>Ky-MOh25?4|6D6UoJ#-8j^vA~eG-gkHJnfs81;CIm&k{9yn?7583y76Bkb1-axROXdClKW`xThb6jYA_R76I(|sc$^sWcp6npo-^SeO%c!=f< zBaN*7OVH6aUxQ_Z)xUzy{^Sc=+L7z~c{<;TqTzi(e-Db4?_jZKqaSZBEunG|=!hA8 zOK6kDRGoNER9?osc+4K)Rnw@9I@s*O zh=>z6>!j1QqUpmG$BczCrOo)Va5ZWiX%EV2f+uhSyWfg=?;2|I^edD}*VW}h$i%fe z-HySnAGLC2_9rtMeRMqj*|3dj?$7hA#d?(PSjqMqhLb%2NX28d;4P`-dFVj;6XE17 zNr{kc9vIfmrJ?&j8O5K>BH1O8-~BZGpXb#)U*Fyqs?DFb2sh}R2Q~@S#P|!*pFVHqDZ;!{0O=LyZDMj*HMfPa)CKU5{ zpa(GB;y^h)5Bj*GKIm9ndJciS*xqz=3WUt4GSU^AX1^%Ai*fzTmJ&q~2)-!UE{sm~OJW`S{37!`x& z5kb`%fsipw5Nk-oF{;r`_E0TEX zS(unQi5HUZbC6NcZ#u$)fX0@RgJdI64d9RHuw?yXjZwf((B<&-U)95V^Kd!J=A*z0 zN_;}O^Sh8(G;);43JixHAlF#7OodW^q9qX1AJS%3xQ8xBoVx9_N*^&kg;U3knKDe{ zabm)14Mmz6kk|4I6lwQ**kuP-PM%RHM$hf+u? ze4P;1qlM~PkK`PggslH{BW6Ed*TCwhRx!>^gC#ZknoFbSL#%88y^E`FWLIb# zh0NvRCZhtDD&u~@WMw!o_#S#e5#=6;t~P>4?*U}qdD3ka2{(worKruw1Fe~COyn`P z@hMm!K?M*^6Ds4NYyz~n(@H{mXjL28SY+OY`~h`n=Gk;dufCfCZHH+r_PgYxPtcDW zxW=%-$6@Ma#r8k%?s+_kY@+=nM_=maKqFlXKlY^bqhORDt6C0y{X2vsWSOF_3%q4ksrau9@ywdELPh_Ij2!QTo66G2U`j|W& z;t`h5nD$CghaN=jM~AuB{-E97jhE~ReaI;<<7S6?Dm1&ubYTxvK{p#K!_+j8Dmmg( zIa-B6?!&yT7=@bWSv{fSS2Vv8G9tmjQySizHaq{bI=eb0ZDNqS3B1ha8o>oiRi)`B zzglOQLl;^D7>c1)K6Th`!(JbCv9wTlP1yMeK-B1cqJ?0Cw8pxmb%56UY9{?=+#-x0 zs_D%RjSRHx!APm(%XC1BD##~TKqFSiPi*oJ)*UenQF4kifU78I&kkZt*4njP4eWaJ z>nrW^E!(N*jjCwf{D~SL8ik|9*wlDnp~cQdcdmVR?wh>MK*2c>Q4?> z_Rh3Y&r|DN08c(X0ozU>75Xb_=2tcPT06oYo}%1+rPa^%8IEdj+cBh|?EP2nv_*`a zS}<}P!vI=MD?w!M*-?R9q^M_?RINUViFHC*P?Q-_SIPo;wgFZXV?;G!hRs6|md?(+ zjDtD^6@A+CExFHD!V0T$6hRq5eqjLtOo=af?3IQ0Ukg+$=F)y&#jmvgs|u{g*|vyd^)1Z; z{Z|r%98Hthwde6NI%ykAyV6@V>S5UxFo{FCk!jyGU(&|!U!1MLOF7E6vp0pt79sWolq*%;>bJ)pE1lx#T!e3_-}`j9-H@u&3G+5}+8NQ~woi}vX7F}M zW8@pyBjB*d5Ieoj)pJ}s?z)lov{BV6KNPqY6JSlJzFW(L{$RiB3~0+gMSsZ_o;zNWZV3SYWk74kbglngrj z{ZaM{)KM+^pI-VI|0@|B6FU>j|9yx4|D|5SCsM7wsdyAorB5XiOC=pdo%q}UK9|q@ z#^x5UmLrM(iM@QxI7)?GPdk9abOaeViI4YL^i-e3$e3aL37C+-JexU<_^s=&y<;*C zYWGqmo1-#oGAPwbY@0W~N$3|hy_AvDnH?`U25oa^+ul}nN68S+8vUq2Uwj$BZxKuf(l7CUeh{bSUel8@!J%p z!?V}Dx!9f#S_}Jgb3fg>vM;zR9_cv@9$GrJmgS~1N-$D{7^;$22jke^X{gBg5_0xw zkY~6$@bhkpr?IgrxHCs=*&2dnlQkmN_!B#L|A_vq!JCtpPh4)-w9EV-#?Gl%v~b(9 z%eHM>d)c;a+qP}nwrv}G*|u%fzNu7FH#raIVg7>o(({epTbs!xt?9vuomGDy^<;Je9VbV!_Za0<9{ZoXub%s8)C!r}WDEmJQdqrj0S~1TeCi2xh$r z_G4MJxlRUEYJBRhC-Ikumz4S|Gy)~zwG*^8V{n$&=`+b%V$w9}=2kNPsl-emd z5R@<99n=>M=itv1YHCv>h(Sky8Q>YU^*}XEYJt`rb+uv1vamT7?wy+w@+5( zkOgs7q=bg2PgjS}qdH$s>3o-7UShR!f}RgMA`EY7Yzh@rfyGjkU=lp%k`hR7-o;RQ zvO_%aj&+l-d8cc;~9VE zWe+#b)p>$ikI8>T z3`%}4*%5mx-0Of8!M2rYAYi9dzWoA9zWr(al?+Hgn`SGXzY0ELVo4hY1jf#ZxTY8V z+NYG+CHi|Xl)<6^$~sL&YoL5`#Xtm@SwkHTCwYT(zV|m4Z^8Z+q6?R!g2s&^Fzidk zap=!`*G<@&p0e|E*UltPJZ+!Aotebvb7tYfzNDnysN`RZ6=JcukRiQb?Q(=MU1tT} zv)%ec)n$iV{XR_I0(8lPLl3#^CBQ_F)r-|&k05hjH2&=%EzqND+oBe^exirTtiKB- z(N^qD2!$5UyNRDcR3+qR^h%e}uwvd19f+;Ep*GynG{u&qKu8e`Rm_Br_NvLtlS8et z+fYFJ_U@Vl@q6>h)9O8E1TL14ElTl5oPx`a>||1U4E}Hz(wEZaqb3lzVXm@ERLQ~p z54CQH1^6#E;AFxC6${`L$AVnEqo(FV*}$059DP2cp3P+e^`jk;N~!YcJ*$+#+Kpig zn7H%T69G9`fHfe+vkq*{Qt5#OnRw9f3y%bzxxiBV1YAN(gfd9&r|@F>1ug+QfBA{ZEo4ozUToiK}>@ivNF zs0b#&tq|K41dwPA23bMird^Ul)g_OI?PhXx#da^2(<)RwU@^A z$Y?NOWd&sL%6sV~m*RXl2g>JCdN>8i?G1uOK{2p0aZ=oxrxM~{Dk`N*<+hdg`-JNz z48*^FB0~b+vzxN>BrDmmDjoUbl(qiLTeU*aEHGZdb`d?ML@+|Y+OvdEe_G8uI}k;W zwedoP12^d-K>Q3GPDFJwl-$6VdS4<&9Dv1qPQ#yD9DE{??JMUSsBP>_Njvlho=XV< zW98_AjNCIH2|~#71+Er@buZ25cqjsvlc7+qfb# zk))xg7`6A{FAE8IyL<~Z426hQdfcd4BqEh-vFNUmRP9H6?GaBq9*2{5JFE_fqxF{L z#?tny3O4#79+Z#`^9uAcXgCV|6sg=7`t+0}6qrZ_g`8a-?1tHG-=1ASqveMg9!SZZ zz`4k@`UeF^VaYB&ut)Hf(TNzo_Y{D<+- zPZ+ICQ`h1=-e4M`he3^XALODIJ9u>!Sj{HjaOfp@&9X^Odf&9Iz6!}3TcSovOO^s2 z)6eKtT9Wo}Wmj=vl2*&^m*o!fsNa!TMso&(uE6JiUN^v+xKa=Y9BFC#gttedA6P-8 zDws;Py@QVCPwqh29X9B?DNxs~$eSh)2;iL4*6r}GYo)58(oNDG6Lls3Z4ldsFO3C3 z{34{x2aJg_2o;T@-YzoiaPS~Z`S%CW546}*(R70@4v4mb`uAi)V+86!s432h%Bw(i z;2}Ek?Cq93_OX)>W6CULW4J)9*4WBjP*vo`8D`Z;CG;yIW&n<{xs1^-+<%vv1%J>9;QSH6~GGI*qja5#3%>$T`1jB0jqN=y&d3% z;)VTm7sZbrfCsi3J0^%8*+2Nx_D*MCwc2E(Y?ZMox1DNSk)%M?U+A9u9yR& zxnCc{npkx21{W}8a5d4>b9L+CN4Taen)i5;X2FW1V5NsK%+_&o^m7#VUTAqOV zhB$0^899cgge109N+JN?_n*08k`v*YI)@5 z!c)!S*@9G!@oPdQv)`|K15eE^PnGXGyV{uMfjzCNEG=bPRWU-_tg39guh1>*V5!Ts zM?q3#;__M43in(0=B4&_<=6LPOp;u2FO4yQT4+4aS9Ot=ZIY@0aOX_hSP}XBGOl4s z<@o$MnKvRt`dMOp&5UHEVzBrg?|N;;5B0_k?qA zce1=+49CVp3gk0XZ8pbfSW11pWrVX~zNGrqpTT1ZpIbs@SdZRRWE}5Y3q4fkelKzjpz_Pb7xrEkLsHBqYxpXdFA8-4zCHvxe(=#OXNAe;-sp z%1Ai7L>E)e4`JrBY`HAuZ^o=zT1q5x0TXQIxG)qGFVHB2)s=sRYFyRs8l9HS2b+mE~ZGv+$D&lWOXUYLMi~Ee35v5j< z?VQM!ghbEw;8ckxX9}*LYK~`}_cC|f%qd!xXOq%8DUhmv$pp2hmi6qFh z*12$r+7I*<)%E%h*cp&UN-uT4EGF9x*;H*urdYg_NPP~gamtVG00hIq=ihjC-IL?d zpjO6MI(O2ljIIsXf#yf?!khPD1eRcbaT9#&A%qjj2X9))Z+K|&vkJ-p<*rQy z2z@$8{|y(pG%9bB{R)GVTs=gi-sOuTwprPe0BVUV6sVgf&-uW5sLh&H&;~j8AjdvF4ByO z0>1WviPKo>x{QQYR-VE}>M24np)$>=c-nvL-|jplG|L$uDt3Ex@;hfEAQ9lnBDwRp zmI~p~Tp`e)x_c{t{jtPjRsjHbs%t>yPrOnRu>L~c2KdvI{V zi;vSr`7TG1o0QRD8fVqn52U_q8AgEu#IbD&JEx=9NUHPY5%ik9Zf``(2s&usKgZeK^ zK+w2#2H;n0FQlG0w082=L}v-C>v=DL**Q7j#PgSDT%3)vygLfFI%=&m(EqHJWJ_swebOH%ELWG1{-KWu zvCNVFjn^h%E@2{ZT|v#|{lm?mkcGXAuxBW)1d&EKQi3q|;K5J*>cYG>&{3;yx}%5& z18{gJZ$wvIcVzp4gbQow+*1 z5^khO?dht2OG=jM{*F+8y;Nf}Tm*cYwpIk|#o~R;LAF(KRJiC?U8-Tv|SK#ecGe1F&#Q5q1IqDKy)MU7rdC z&>i?L`jf^AxGm&Yw*b;RSuavAN+G}L-?>SwULLvt11YA<@VlE*p&&?Zs%Rm&@$B)u zVMdsIew&rSL?kCPd{~%uA?U8jM^CU%lz9r;{WM=j1K>mW?I2?la3JVRp(JBiW;%_= zP7<`I#Z|jeFa4~m_J*;md>pH$8+jvd82H&Bzl;7kf&u?6p9?wwFi%fP@<2KvZcy?r z`?-tmkFnHOi>%&CU{`$d`386hE@1K<|EJ$PwHw(kFEnT2YN_iJ;g&QHfo;_2xp zA&aiu*(Vk>GVsr0bP_&+e44_E0)Ay`5F->giZjZBPkRiEnt8xX^@BZgE} zd3k|O4h9w&^ijybiP6H9;H-hwYPd>0S~XU7g`%BZ;{rssT?~(p46u;SO{0{|=4Y1n ze9JdWNl7`%1N{~xzwqz@->>p12yr=m*GQ4a{l|@ixAd+f@Vjo?iJN#i2KN#l`txy& zVgsQ7a;_M*@sWW8-qS{UCJt*Oz1Du56mqtw#UOL@LlB~#IfCD$O`DhrQ%(lQ zJr*B?iP{isHorZrd(qvcX_I3-yMGrdBH|Zx|80Y^AS!}j`gS&jU>o0V@bnV9ywfMx zF^t|A&U+^J8a7jccjFO_9 zkd2WC_vUocW@aVfLN;s}5Z@7KG>RaCMiw9vh5rm*x(kIZ8^Am*x%y&F<_=T3Z%ZuQ z`NW7k<8*fI`#$%>tv~|&53LEN|I(QC=YPE)w_xem9kt%~^cn6Jg4$yGN_BcsB(kWr zL(oag@#A0cj(2Hlg{yXHOx(Zkx`hf!F44KTLZPtIMB>1P4ZY*l`RYZWhT%6%l72lb zztn&HxISP1ztY6!wKxC8TFilu9cZizq3vX=+YOCEdkgFqqM8bXmd{x zVU!$rV7WwIzSjC1q36ALo|^2gF+c$>X^ZH4;eH1CILxd0E>+JP44Rhx_s_UAe5- zu}{TSwVmK~DvBvIVYf!T3&;L1`!~B!EWPd8?aVc>JD9Y$aW-DUTXQn6{7Q>6LsBj; z{@;t|N6!xS+4lHF>J&K~Fn-lBGnK7=d4}+k`~xuBbc!E%5|*1w&ye*vto+8A_?%p4yu}>TP^fTOSLq>@>OI#YgA$XW{d8CMt zqc;15zUtgb#)`q)qMxNEkZy7;Ny0=EMF~#i8**jjfQX?P-Pw>3TdM`+-!-k9AHwL6 zcCW#d4t6ER+M$>2-!lPU?p+@~BhG*)XC5Je<^9aoAZ;}C&lmNHnoLTO7L__ay5Ev; zCZXDvBgu>q>CCm&n@6|L_2YOo87If%Cow5RT@qRj1Ia!~7y*=jMZtSuukKard9y?J zB==hIXN$=gdZXND{wSe$?<{{_RN&sM+={CKv}gSjmDCIPMJI`skc=B`E@-;pKz!tK zll8;{Epw%Ive;Kldxj93egC|%G|Qy1%-RR6jFVIe-)#9DIj54MA8CQGzU*|_VHYoU z*tSZI#m-Dp86 z`$}2n#TJT@M4&@s!NwBegI@iKInf-&f(_=30V|03vr#Tl6ayIvS#%?g4_f1pq)R%3 zV#NsuX)pi~sV)(C=UP0qBU71w>*V*Y3VRcF;%vEy1*0FZK4b5{#yNnxx67^Fe(pN6 z0=^@0dG*FyKf@&7(>mA@r*#Ft^o$YwfPpE zi$B7^0yU?MTP5Y|L~9xPs?7}g4xcw!0j+ljN^VaZO3s)!c5DmtA&BNolsM@mq>svy zfQ0dbGUoo8(Q{Y~m7ZMvm`*jR(@{s#-Bcb_W}IpX76M->yX;J~nlb}GblV|oN+SV) zxZuj$0JBlzJK)g6M~tj)D=;wQv5g$r_x`A~Ph+i+^B&85o#DSWFaK(VAH}j*s%Qh< z0Dt9V_-H@?RMXW5`Shxam&MDQp^%lZ*hd1(Hg^TsV}diFSYAfxKPVS?t9*Vkh|+?F z76ioYRyo$zOfm<`&g^sIDW3sW=O!MGS^;ug51;8WhZ>J>~r^Y$v zW}hK(h<5PO6#4bvJ`RSDi zExI(70n@pI4-5pya@>eaI#jqx>b`+*as2y89^l_RukpD_bueUp3PAigr!+@-ge7hO z!Rf|>%#QGyPcX-oc&4bh*;NGf_iQ&8Y@&!ZS8i$v^6iBOq}R@=VjYh|txkm4AH=Cz zg*2VfFQ}Wk4NK`g280pW-$Y1q>Wu|Ky1wZ`hDAqO(@1eFrD4$>KyW{acKO5DNV|%k z1C=S@9fqW^u)*Ui{sOU;3PCZa)^AQZSsJQ3pU!kb9K~7^{%rmy9-w7X|Cf}$(H5v&lR5a~!q>KR~ zTkBi6Je1Zv=oUVBeLCh09UQn7j}2Mp%@(h7WyTGAyP>j<$ zpV$o1UnU&ohiwU>Q5f;yR7Gq$>BN`_t9d;V>w&8@ah4OgaZ44{LZ#8oadzub@yY3) z1$PjaZnvFg+Y}9%NO%a1AdzC(0ECQp5u7Z9{nE(Frs;-m+7eQ7`oKa_4lfN`t|4 zLUynp;KXDNr5qw=pAIwD&IiS|y0GvCB#IuT>-pMQy$j=aF3chk0^JW{w3j2|zA6u5xJWx;HRQiu%01tm3E8MVa-lDF;9&me*|t%D1Z zB5Y3^%+Dg104_a8lab{xfysN0s2-@NQ(qiBKKTj?JZrUkUi&AmP9=?%1=4{XbzX}3 zAJ57pvO%A8okX}igp80r12gGVjVrjWx$4U5nu@G#a=} zB4ePGLRS~Wn}QANs&k5DTVGDDliL|7%|`$nwNvQrV9D%7<_tP8;@L+aTjv6r3L}b9 z^!N7_RL_J3Lo#1{Q=Qn`3*q5MJpG}ZC!Br>ZwY~frWxG8dMVEw{$wk~>Ev5r%iHWb5Hr}m930Gmifs*}Ls1=1VDHe{tu7r6_$G<#fznu)YHDq@%wN9W}I zk0GTg;0vWTtdX^hx-D9xeG%O!it==BYF#Uo4^;JL=cKXA?us7uYE)ye^Ffskl#K(# zd-Y#wtPmY2okkq$Bm>I^sQ^@I348sVouv{42QdP@8;G?=Z!0l=RHgOUH8@u7xDEb$ z3o$r8I*0M{Yx1#ZW;j|?gMzI4n!xv8gnsnX%1b!{lB0H?!ShA*3Pa#=rI}&MG>MQJ z^P}hAzfSjQ-cny1Kf4tiBdeyo;%>=L~@uWfYP`67eNIoV3X_M%<@a zJ4WbrujjGhm)?Xqc-1&WTQ>Kv#3^JKMTJC-q#vTShaKqQ$@efYAwZRSiD*>ZOXtUJcb z3P+}f9}Yk8*({P=T=kU}imh)LNPwjpHU<5an5@PJvS#aALIRQ?fA)Z8tQ`v99^vFn z(aI3XYg-UTRq9+}Z7laXIdyLgX7RlFc?5oSK1n%RRPp%_0ArT>bAaau8`?B=# z^<4XEMcg+(wo1yo1t?E!I5GK=@b4XlA{ZWm< z&o0cOs*cW?HY~8%5{%$W;&Q$nyn3qY@sQXGtyfbOVV*28&vNN zVUS+uO45Qpeu~5u$HlE`y^y-(e9~jIuPTcx5lN5#>n1nm~B7m!FN?j{nu;W~X?N;qlNH{nM!v@GC>nhnqM=B+{I(K?8W)#Nsw%VCFQbG3!K$98F{-`dlIpJ z=ZCUA0pr?uXEHW!HUYiY!7NS@vZ9+RwC+nRv1M(hfDt+bogAfy0QD^09hVA7=K6&g zk{g!-5u0P%aCF)XE_L1vPSuxu1&j8U3|aGt^IMcI!5C?jkkN)JfDSS-fc&n}D#Rpf@Sp>;GZ(eQq{@WLCD zQpL;Uf#C)1q2h9W(*#V|i>_|wt-S;RN6XG8CkdEVF{4I#rgWmfXx|4MZfjD6e8dAl zB%roJ$K0JROi2dtfoq_@<4hedNP*vQYSao$`nNocu{=}Qcw$4g7Y>N2$wApPyJ0Q# zj|g`SK_&#~=8apf7pSZ*0qJS?nx^`c>xe1ueY{~e1!RgPW9cb>d~qN* zZfWX~>w}-lXM=Sdh&I)#_<7YM0#bA#t0>2!F)NA<LxF_##Q8Qzfu6;x~&K{yFEPFwu?^`3Q+M5C?P;xrb>Q>h$4x-d)*Wjw-EoM#=ICsa_I{1i{xAi$eOuygDWfB^a2+ zm@g*=o7TsYV2%^e=*amI#d+NMcgb^OQ{d_IN?zi@4Q}8_4nS zfkzkM7ko_>DD?s(5A;kDt>EcZFQ;YB~@dF46c zHmY{l{4eiLMZbd^#_av*Vcu$Mde zQ9THrjF*yXuSpD+)@B+rCpCgkZbKsY6ds6;C>b#H?Alq@YVeA9a^lIQ76xJdu%8h+fC$TKCD6jMwY#5&5&5^{XD zuWmy+UIgdAk$%q8Y-ZA@!Az$EO*_N7nWh#1R`?B&{x!t4|K@1(yNvc&oiH^+pYe_d z&$P&9L~fC_+V6Mur(6$o?s0`MMEPp3V&JYjv-AF2q-_{N=sMKJG&j2!#^Gfe_h<&i znMDaXj{9lu)0oXHQ&A%at>t_SEicD;1;QRCgviYnB){J4bzdfZx%8jQ7ma#;O}ul~ z$KHMXX(0y}WFnR-{XBC7$3&vD%n3KBXT#=ub^5}jaw-7mXM8)0#iCe9=uSSlB_Far zbjSwHzKiD=2`8Qkg<9XuU)fgZvW1ES_MNhY-s`fVKkeNvI?2~xCIvaQn;XlhHM;BB znT1Wi30;H}WzZ=YptsTV(00ub=f2_<%plql*?3N{_jeVz39PZ9xjf08FscPSj% zHQib|g6@~$uuyh7viJ;WI#V#>*E6=L1btW@29AB%l zL^oi~8lpSLecP}FIc|6}SsNhs>@i3elxZ0!IY#?;`w%(=RWu_Vr|_qhhSq252L1su z(cft#BR3x4h~$~Qh>6Nc3F5P@w;WwE03VLNzA$GQTX6Z%a|zZfFxwOK%GtXf1t5QV z-U`nocOivrfhzAp@22p7;KM(UEdNt9{qGb@Yz+TP;ToeM<+RoQKg6)RR%R7EntK9( z$*^R%CRvV@#-@f!$8g7d_Tz>lBBxnrTm650iJMj~ z%Hxw(ysXKX-!BEaReyyM#r)lhY>nEj>MVn5xiX7DUD^0l6G$ng8;aY@d-ZJY?aYqs zdt>mg`)F~#md{R_QOmWPWcjRn`RD=_g`&F226KGuUk;p3r>3%(Z&&i^QTVMA?LRWd zVHc^s(0o%(H@vbV?5aMWysq)iBiqkG{Q*kYM;zJV35}v;TN)2bdHp9*Gy6k!viL?~ z#is?HZQCY;NV^P*%~}O)^lt`i+d<@R)Ii@ttN7q!E3?dvN1YT?7c7M&Akv+?KvwjO zv}PPq1JY+OZGP;DyS7Pu$febjNoB&tnGz|aTuBW}#uJGD$fz9|o|#8h4_ui0mKK0E z79B-N+0ys7%WqRE9;S(u2_Cu_7nHl+fkx2u;}D;U%q1y#jzSl48`+>}?PZs;|AbQ{ z8A6QBd@;@7nTgxVDfo_9ElHxUBv!V}oGHkyTJY{dF%EDwSg3O&&EPMCcuVW9Pg(iyX|7o*Ru;;Q81q|E`o-^*|6Z3`up?NERlO z_Yh0wQAU6AnUuObIG0ETrvUks_*a#blFNIP+5b9#1raYZUkOx(5+Z@qfvp{O!J$5D z^L2;3IE(n%zv<-vo7|{_#1=!iC0|wCrM5CS6$=dfv&!aPe7lExGT-HCFf`t92ac%y zW`u_rYu3nIPLa-xth4w(1>4s3gfQT3HV9~Ulq!8VPCp)a%|pcGj0EOYCf}H7t1ICqR}udJvj|&l0R!Ae$#yF+^$uJJVieGZgg`Sy*~7#ll>?m<(cgjh|ZYaw`awf?OGuO zLOn&^9ak=uk}3cSC=B4(=;GBy z>QB|{Q?h=>}9s|lTq=~Ws56e9)`Tw7g*Lhwon<0dvH;d zbgVs_oNP%pyxjhu4|ECLsnHVYp%ZcyB7%j-M1%ri>vW>ppWef`J_(bzOCpaxkZ?P) z8M{R8?yx_aVeQ7~I*{Ey0BoHM4a!o2;)5x=I}u6>uXJL~o=T`kfef8@w)no3PT8G= zMxyupvSPMAg-g2GfBkXLfG5VBZd=aE11SkWO_Ip6PUTr4&#}h5IF%8%;g~aZjIuKnt;I_+`pVWSH_a`REc+WLAOnj{ zA;mcUVvK`DOcO?Gy5nrY$_Lah@Sk`kbibJw`#66{1QiBv{*af6`c{}P<;n8QV*N}8 z2&@i5fxOFIJuBeu@SloWILay4*?y3OxGSf8IOm<&MyAFxg)pR{S|_bTj!6-Gs)_Le za%ZR*cASRMvOlBFlzd~5m3pzO$^?Oj>=_8sS#TIM_{5B`^7o<=s<)-r3V>)T5nYXO z{$hvsoS73cZRVUBgT|n&XR6f#eL{pOA?I(hqwNSO84U94_tfjdwlbQXEinra%DRnQ zdh}FS`ujMQV1d`FRj#h`saBpq&1M9p%@qTtTpmGmSWGf8ziL;hIKc!Gh&Tpk%nCJp z43+d$|Di$qLqwx~>HUa^jBZvFDU_{_BUhVGgbEU+u+@fC%N&Qbee4=(g1omR)O|Cs zK+`XCUX*#E*L2Ifos?m&$({Ao;Jk4CW z79~vK(AWJ^$vR(B;4}THylq4}H(pROh5mHrvj>Ne@r-gJMh{2DwJ7SJnVmiKSc(hXf;b-ikpd*7E^h`lk!QI?*G z7SHtDkmrW}{th&5?f&(toXIt#yM_2RkNsVpc7F(n)Q1v^H1`RyVIzrEp zVh;w{!uiB*WK_xJEYdHOk*RfAi~)P?=6)rm;Y2bd;Px~xBU$-!WLf2W)| z2i%=S8?CLy;2K+X#}#(jm3RLcOG%vlnw<-j_WPas1vFG7*Z&XEmifQ3O)>ow>Hhz{ z;hKM7h|SUe0YeP5$@{nL`zCgCqex)2!2y9+z>f>n!E;A&GM0*m9OZa_Uvf1uOC=zg zbn)*8b>I&jUwQwSqI_dcPz3lfNuqv{&YvKB+vEFus){fndL&Mr`JzwIBx)X!McuUh zM*3}`j}=_0TGhBz->6y{Nq>2@_)vxUKHq-k5f>HrvmwjXI`zF>Yw_?n*5sgpjanr| zNn^=*wpnGRNFE04+Ap#tqmso4CyL8K7Y}_N$TOWs>(vA=&11Qzrk3;Js9CYMZz;n^ zu$c5|ZjwZV`9N-+dT{%$&V{Dt&iP0U?3w z)}XRNT*(vA*SUM6@d52>NZ(NaN)YrBEfbvuJWrI+_#$SF0Dyw9AX(7w(Rmnvz#7L1qx( zQUJsC!+-VQ?9?*h7Bx4yzcDz^Wf@4|(1qP>u! zIrLWq1rsQe;MM%u5QjuV1~Ug`YNw;=uBI`s^rib0`CN&xCv#WTxj~!x*EW(I5w=U6 zl@O@}5>Vs0E>p0q#cPjsI#jSKO2Q}{8%#hTdCb53$5CIW&CQTo1GckAkh+Q1`(piwz`C|eKA7p64Mdo0I{md=+?I0E9Ln^QWt#!*!7~ zMrxY;{kQPmWG;oHzJ!#kj_eflmg4|5Et?IQ(2z%UsDPc$mkr&qGRbXEDa(*QPX(^F znH~%W6DbAXU1iU-&o1whwkCEqAj#&Gd9;GCGcphKnrZ6mV7{uiKtiqGtP}JP0KRzQ zX1m>`<>&T-PYoKUM4!8njR;=(M-_jGn({fRO$AsbewV2Fu}e5iOa7QE=mF zN|wfgdV;>Bm|&JEq0EoHQZ9iju!S28m__A$Un)>TDDra}YBE$7s9JfTIYT}MYFgM~ zKhP*8Fib3i?3p)Q6W-d$9ObjY$ZRJ)w&OuUU=YlQ+uV;2tMPO-FQSEv$67q)!es5) zYtq+aNir9T+&8RvMjQihxNpVBh4NsGZR9X#f;%`Ci@$-_ zZK#I#h8lKr9FHurKWID&Yx%BlP66dja^4;>2)=&QQ9zi7`E^>iM*rmXCh*5h&U@!( z9q=>BT5La7j8%00&fpsB#Fp4Ueg?WtG;>hf32AMPxHA9&@-JXkqb-~wU$$FakU7%| z(yGD|2t!y9tggPE^9a}hxoxTTe6)Bhq>!ZC9OX8Eay6D`EVyG$l8j1|X)M`-k6tdr zY0yzVRj09_5M>jkw}44M)@*Q`j)u2z_8!5-)-B&-=P5OcO(u0+$d=0r6F_0%4dVM` zMei|1(aFRihD3XsD50D7AQZ$I9sZEI9U>MqrE8@FBCxmM^?WJS8$_N>8 zJjeS-W``X-ID03$S-BY<5aWPQTrmcoZYoFURJQ(?r|nm!&9l`E{u?kP-2f4-Beo&U z#dlgtio7sS%u(9gIwn_3RmnxDBM>*-NLgh4X+R`eE6rNvIkvB~0@-50k-|F!R?uP-S0_U{uQ zI-`;`M$Zs6XwKecE4uXcg2M7;++WUICL&}QuR`X0|T{d`jz-1AqL&o|;n1`*wb+F@0{D)>}wNxax z3v>VwEQK5-CVjex<^J|p)yx(a;W3Ky{<_k{;TOCf^d~NquD%~BEy}QlU$HebbyK`V zfB;o+-=p;nbAZYoJO2HLc@`@PJoZsAaXBle9?8McO3l79K-@!Boee-zaRKL#ZA+_S zPTx%0!2TCgt^wgWUaW)M z;aM}FFC`fWmm(lM#RBG!ms^!48#VpWHFF7>FSta-K4+I^`tZz5&K%*^mB{{dQTSJO z?4X<|bftJFBHV=E3BOgYS*DjJ4}#aGLgXKpbBaq)X%NCx&2dWl zHU6Ug7!$%kv2+apfTHe?Bb;!dcWUEGQ$wPBGr&9-xjArK-)FW1%i1gV_mWgeq9xQF zNAw)lB#_KiY%>xK*N{4&B9?#jSZmG6zuT>ryMi@ zFqh9T7w5FsfZ0QlR!$yG@j^v@LvgUKGKIx+ zbkpH{LzR?pagbNfUXkAJ2FPi&E3upl19yXJ?zZIgis?k;ke@6%duM{X&QSGG>EWrv zkyKCbU%4)9IB#ey%p~mArR`?hA~?y|?X8f>l1{L0vK0ug+*5#-lr_R*a1~mja4~W) z5-k6uZ8*;FjmExv-jj^u5ZWcG(Y;0_AqL?@RX(bCLXGzlEH99zt6`Y!bv@=KmFJQ# zOzRU59omS&y7S%jvp+c^p0>aOJ(iuuwp>39*DJYCP;$`f|D0z43)Jaup60iTLM z0-jr6_0J5O+eY5+8z8y~Kz;W?XvUO}L1&U!B8`Jv^lmwgFGLua7>SR2n{+)T0dt;0 zAPVT438c08GD~flbU=*BJ?Nx9(hF!v+hEfKM6j*ErY!G1?JsB8Dwr%(MdL0O6Roa` z_&rnkO4EtrLm>uZyxmy&&t7qRB;X=ED2b=;TE6kY=^m&hy zAIzTMT99q0vYPOBd zoJG_~CeuI|VQe}efKAlPoP}zlnIwU4)yI+&-@6Va-M^GEi& zW=6~G*x3x6y`aXJOEC;~@$xaRpn{#H;xgN=9SZ**`2R3=PF6m@#rvagRuA_wZ_#EoP)h=bHmj1q`dm+xpLf^xT(7k;*)5Ys?)6oE?3#;spxFEtiEtdGVA zPL*6wd9OuhPBjF)IDb>V%!BNmnQ7iu;TyyYmZ&s)=|7oBm&hAn%g6-=ZQ9W30mWjb zP^_;CBF_<8x!oy+uiwBNCG?@Ew&Y!}<6>-P1K2w*^@!0(`se@bJ_^JFc^2VE&0D(> z4;L{w_GlS~GJH^KiTuNBZCefYy>`(IqFs`_{~f|Gw10e{3As@saJV|L@edL|sZB?s z&J}=M{mLMNO?Y6MQp3$9HD(CgYbz-b;IeS+iQ{EGzJhc<1vx(aSzD#%7$}lEZS_H$ z3yx%A^o`A0(Fx8fpW3qYXDaf`Yc<1!|0Zi5KwD-NBGYWnrAS0-CXnRkwc<=%C`Lu; zJ`;gq6tv`A<2}%F7GguM`Kln67`46wP0n)nNm~pO;2~~<7cG0v${xY(h2Hb?wA%ag zdG@d=KQj0gR>!t+HqZ|t;Jh%`#s>r$O$AyUz!M*tI|oq%Y}clu(Mtk3x)^?QtUwdQ zgjy<+m8K$_{kYk=8@r;dP&B_4bIk5{@lf&t2{FI?L_ZXv(|?y6=hq(YCp~YujIRe# zYjM0Nyi0Vz4sW6hD=>&2n&H%2^XqPCTZTyfG8I)V3-BB5h!O#D4 znhx^O5qYR?N9ev}eAf@dTXneB7+x2(tBzSZq za1#Lm-bRJR!50NM|Lg``5Qj0LjJT@D2mu++{$k`XUoF)4B1D;c3NilX1mxgQV1=%WdVYKZ+AS ztSavDIB%M@w@y6!CU?dHxmax=T;m0FFH>&oWI$=(kJy?PEnF$esgb-(*)joKQ8M^F zc9wmNA+jdG%2-^`j5fbvO6V|@kna{bR5eLw+-MfY$E()2s*L^pvaUR@BYkufjHwcR zF}R8rXi>P*_?8Tr-s5DMF?L@Q77@4C<4F^6#=_wufxnBct-7oX z3Ttg<{MS2xx?W}TSbaM*vRP>7)BZKDg2Af}!O|MTSp%j&?j_48NClK`(vgMyw&9LO zg8CTGriIpGv>!4jTL*5H3TnHQWmimJIZy|^F`lwZl&gut3=Ic+8GT^!HkR61a$~7`D_Cc7*PtT4~we#juRLKD3WvqxPr3@2|RH|vm zVbpbA;-GJq@mY49xqI?qQ$=1aJ<5NHS(WE<^P^hqTW6M{BD>N(8F|KS!iM`)alGTg zs`B+4vZ(0EDH#?*q$Fp!g>vQ-m}+Ps1|S-mC@ha#&Su!s|7POMY+HF+xt-WsER)8h z#B3`%@!M$Fk|b=Nxt-CS8nnBeKz@;t0u?LMZjnni_lI#_h9lyOlwS=Bzy z=VaQbsg&Z#Vq~?_tTxt)C|~i6{AH!4oZPM6dB*kQm$U81!~`%5sKk!DbNQbOwgKgK zMiy@E#HR`KRXm40rX$NvRgcJDf`saG?GhVa0Ave+5{Wb_idg;#*y>yn!qgA$0T$NX zw8nZz^hUt!dCf-n|6NYtIXbR^gjLxlN=o-(cD(NELs^Cv8NL8nWnP){r0tNr`D%M{LKzWE1!jnfoQ;Sb99@#BNik)MDkx~UFe0O?dFK3ZOs zt7WM@%g-{4wZ*>xN)lsq*28O4qhmB(pLW&G{Z3l+r%bm-s8I?&j^572_TlLxO0J0P z&gx^ZgMlj1cv#XbBx|80s3s5w+qy?@XrM8T4~ zp%zmVyjn-3Hibs)_%{0{e?KVbpxxpEoWPf6R)x`wm*8V3YJYNA9y}0k{qw(x>AGZc zer)M*dI9=D%}Rv2gyMdVlx-tm)eRXH94Hcw}lg4M?N1iV{tLWe|dC7FPy+ar8md zjp)QsPxVX8p8kHx*^h4|qfPUpK^a2h&SsqXG#|75UJHj06Eseeex2kza(a01e*jRn zBWI&`A!U6nN*v-AXcjz7_q@};dDfrwyKUyE&?Nl-+sL<;+T86qhk)H5lcEyCwj>{C z`p?6-ydeq8(&mIQXUquq4#W1j++U5Zow6}087#g{Nw?&Gc7u~yaH*e? zRWRhxdCKo@>qqF!GNwR=W9i=4xOus7Hd_aR6k=OzX4A}dv4#iI=e0b5*M_?Vw zWHNyCJXD&JlR$qyR&r$uqoKCq zoikor==AV;l)+|0+M~$y^=IUd0DK$9(n0Q;)t9^dY;~W`mfE4G6@ouJV+)fxeM!!j z)M|fw5+K+#VpOpjDVDjv5`6q2ak)M!xlr830j!q}X9O0Jo0dUXam%7}Zw+%vS!D3Z zM-1YyP6z4`0eM{q!ESe0$7FCsXJN5E;WR}bX(2=T!zw?0;Frv;3)EGnOQ!~%d>hax zWPnfiZ4yuRUnT#z!6r#YLDVnjr|qrd`3l0nBW^zolV(T(;rSk-UeL*Zb4zlyggP#` zvt|SR~7z_%#XX@hX`)Iqp znC@DX-Qib?eUoVQWoEN+twKfE6HC(gj(4sHm>?FqP%)uTfBg4cp#IjG7#6_j6mCfD zK2E)8efT&dM|`iisY^bY$ppx?#$$N=^e+V)*)yFklSlBKADvqkIA=Fc8jhZu^L$19 z4Gi8w%iN_OetyRSr+M+k-l?ug z6+$_D$hw?>usxD=uHyYt{W6;LZ1ocp5^5Pa-(bmd)QAsg;ESy%QB6wjk-xqp6$Ki~ zTj^df0 zF97c-iUfKpx;&SRyoyZ!S07jmU%rmD9%6=If`Rt2oRrxXQKqkv(3tt{pi*GEuvEh+ zOZ-4i4pob^b1sFR&p{t>l%|*C2j3o5n!5rp&neNt9Fuz8Z02*wL$NQy6k3 zoYJ;Q`K(QnfKM{~jJtiDQ`hM5N5GZ(ZB6sX>T-}@&SG*+QaA^fL63Jtq8FnoSawA1 z`&*OUs{^IFKNWF@DN*4XbiBtdAGx0*`dEzvTuiyCc5bo6D*UhkH&CgLX%23n<3SQi zO!6knKfmr74dU7c|AYw~WBf|Gf6AKuH@k(d>CI#0OghF}F*j#VZZ*qHI^M;$$J?=7 ztmK2}?HG0?)|;=vLECpPRog8s{g$fg(^A}bcZu8_1j)zB%T^>JEdb0CJCCF_T-e8G2XQmUo zv*Lb!)7_SvdA=vIyGOWfn>z6;m4_R#0>Tc2H9!e_D}o1bBPPqW{wrKsG1|xAV&8Fc z1IZ>v-ZL=G9tb0z!iyrwptKaAAMXx}#o0kqT@9<}guuM&IrS%QE_Wdcu^4+naHYnB zmd@wzKx9cCf%ggpl0lXl70iUe*TH6jW_D`iG@5OZuPQQQLIra^QHUwpu7%%QQjrixkcME8(NUNEi6@R99 z!g*SP_%LR(k_!n=&$*{7h}i)~gCVP$F5EV+e9iOTP}D?i*=K1yVvmj|13NpwNUt6O z)8YrT)~W@V@)Lvbu;sC--cs1q;aj^cZHOSBR<=}2(=y)3cz>0H=6ViTLFM1Xf-?I3 z@GZsk%=ZxBE&1`T-Vhu#3^xl1njod5kh#b>+peXQBOd^IjAObs@UU$d#mI#>S#t?s zxT&*2+5Jz{0=VurpM93dlUMv_U6JFC(73z(#+^ad0^qH@DFB_A9=i|VEXoKVOf0S% zw8TM!k7-W$Y4RkiYLJ&!x&q>`B!gbEQb);!HxYhQh49*y4kpq;pSb=s)A#OkY&BTe zR0?m%m|xDTK`Zbuc9X7s^^QI7<>@FYyAbpJ^=-(x~tP< zp8O$LF#ft39g)vS?kgpBnViO)7j`}*P0cwQF@FiJS=fs4yFUO28_rL}LmCo4aD-Wg zB^2`Y+R2$T0vpr%@cD;1v+z{d2#WLY$N{oGXQV}2TpUEbfBC_9u( zY737)kV`CF4zvpbq0DT~dTuUzz|`=i-!eCMW75-jq`ir zY*;wBauvj0up+F#3{Y7%`h=}|@LEVMF2_)MHr(QHVqsuu7YnQIw= z*oO;VPMJe(AM56N;5!z)#KDZXT}RHJopO1I0Bcpt*IABftB1j>GmEg7~?0j%Gy$)(NuoiT9y4*Y<56LyBNOtd8AP<=8E6lUD;2H7+&^(%QFy1iNfjt!IS}GjGS;g zfW6dMlFrtbl3??whyS+ANJzQkHN3!NVR}YGuNr314KC_V;Q&^o+JAWK^J5S2G^g3= zm0O$}otSkzehR0gRBf-5BR5ZWpC?11iHA~5^?+J50(c0vQxUmV)?lpOyfY4}c227` zVy;tp%H`5r4T805|Keybsc_N6%aLMrg3p2LwN>1h5yA-VI~@aR#{%lXEQ^@`MGooe zucFJj_Bl3<+76bdjyucl@NM2X*@RNVqEDwlQ9XMA)hZQJH2}2s*Tm)eTB{c?wmQcwq0C-@ z5Gw!u`!!|I)rz_ht7b#w(sgHnOIh{z>H-YgbtA9Kou-eA6rm^zMkWN`o37&EIwJ1t z#j0Ei`%v(ie&?BTq3U1-8jbUgp9hb!*vX#AAhJ2o&!k#{@2p*;&QeMm^3Gmh2PD|h zeIr`D$=W!uI<|8`K)kfbs2_>x#$q(Xn=F$WG65AQT^M;2x^yQ>%!&KzbMcAJbF%k= zgC~psX*Pf z#4_wAg8nDCg+$1x5~VRvX}Sovm(ErvyNK=deMP)B?%sH9)H~=)SzXeFV~wnFbS4Xq zvQ{H@!=#6r<@Wwdl(&HLh~o_tn2Tfe(+cB3+!7IM7}LK${5*AV07wLpMyBqtmAlsR zVQ_PI^VrPT0>Xl*=|lM@t*2aw6PXe>Z}m?1C&>1wxd@(_gb6eHXb zLfw*T-O-{jVV9LCR!K%;-;>G{X8tZG7uRa5m7RjMUDJrsw%fF zYF`=oW`RzpQ01QlZ_1hqKL7u==^#ZXyT5?TxFSX2s|mAq59K}&wjR#>;( zIyuAh&uNNTzu^fAR9JZp)XY)1UIiMr0!j0lQyWFRG=g9q*TR< z)iGbv2U?A%Jh9SiS9E^LmN4|L`UYX7KEjc`&tTV^nu0xs%H241k7t3PI}lk!Fa%XI z9?Ap1rh$I@7?($aU(KMVNqN(ZUXz1bNqZJ!Ixx53CLq(zE;EgW1>!h?3-@Y}K33F@ zKfvpzHd_xIS9H(>!xFkl8XP;g`hw3?N#N~+FNLgxL(N6~ocoivGJ2EnP&SRTJpPbC zCV5LzuSM)Gfp_c!-=~+h7C7F8SzZJ$814NbNHW45bAbUswslPZ;0!yiD(`4-qk)zc zl8c|Mkm)Wx6r)VuY?C5 zvR&AeKL4}N*Y!w3CNX&Zn{g_N>n?;*ObV?X9dc`mLoSMk70obY^aQ|59 zO0W%<_yzg7Xm0E@sf#0^!RJE`%%tu`_{T{^sq&PDd7!tT_bL8>``56>01GRsBQA;~ zu7Js2d^)7Mo!ehm1Ey_u8`OG7H_q~l2=I`&6I}Q?ob?`jH9d-TNR_Aua$OG%+NU-4{ zvtBU(I$Qk-WS4O~{9cI2rNfB4|p?LE>r#^VOa$d2R0An{Or&lnQ$(bFYo@&;i z#n^XSM&ihX?#vLhWyv69eH|qn5|$eynBJgJ=s`z-WxGPGI(ES3+3@^Z4>%^?Xpp%L z4}?EjTz2e`ekUN|V{9a0#gcHpI*Pvj*zRs8;wRD^?N5v50YpET*2a$Yhrj z7?Z`?|6o||)46U9>;3E%nh;=A0qI4R43|Lgro7G`a_ASLG%biW9>-Slf=$(J0LG?I zX6jCnmRk6a(wZv{*Q;T#`Ofypa-%KMAt4S5nKvjj#+`gR zR9G9Itsx;Y7NQHxrjJ+us{ERTDlvT`dz7}%E%OV4*>=r$)l-UHC&&_b3z_(0=vrYz z!;bj5uItOGYtES}w7Cn$u#Ki};U30t?U=CO2nK3`S6km}3{KMCYV9>@{%hoz0l z?beHYoe&LVQ4`mKZcQGWECRfAe>b^$Ivqi?yS$U^aE;=4fTZkXA4oCsRt-E+`F(o+ z+)adl`#NABaKt-!bo9B?eE*y^>EQPG8)lV}kK&0!EQER;p};TG2- z*7Rv!okv$tmBSh_?CR7&9n=2nw9iq_)yR+3J@CO*z#8T)$DOY*6@b9MYx@)M&jI^q zuEOU(1X{NL&f3Jz#r(gI^K!Jd|M7?ZXY1E6CcDx{Kd9)p#m{Dy09q@gjm91y)`r;8 za;ert%bob_`+dVYh^>;We$f^LFNKphxbORE9@_b4SHywxy+pBk%gFh$cqg)_ zCb2NNWMfOf_E&?lL~`re*3M7k*GGXj&c(O6MfCdl3n#D5)$_^mcLPCK*3ZtjiAf7e zo67syisyj`Av#M!AF9^%KyePecmbVLZK$7{0qDt=eSob)^j55&D&mwOMbg&gF9sHq z&j~_9`GVGuF(85SXNi-(J#fLJR_xn~zj~8^*=f)Gzm-QPOs<@~dbTg}>?P1O`B=xF5G)0)ILie&3vSDH+!=;X7Pxg(`EH}*r* zGw9%z7ALEha;XtpTuQ)l9utZ^d|cKuuzL7$_=&lc)Y5u-ywP7?ah*sdK2qrG&2hy| zM0b1S<9`JS&)xf@nw#f1%F)sT+MV2^VEiDPRV3-hGd`<7`Dk`!usKKm{IQ5!qI4*> zC&EoRdJZ@-DlTXsg&7BD^n38UO+<#}%g@6cDN6GV1pYmsMjAsF8urJ}uQJm;zaRr> z>{?DY6L4wxt=o(mG676h@v+_T9c+6+s+@#6kfxE<(04O_L6VIurAHV#pzc3Bmt&m^ z#Cw;$^n_Z=YI3V2D@s?ABb`x{oR$hh0=tyHzVlwPP#Y4LorBmDD(WF{FSYqZc{_!v z{kdLOZBMM?$v0YWG@(<(=_C3(W6Y@}w-my(jc>ZRYQTQCL^}xo;{(VQ zQTV5#-|%n~0o}D;H({Sp2Gi40NtC3Tl&6UC7ZHco1kV z#$=N!WSf7Atf-S|f={wFfK^~{=a_TtVk&0-L<_y6gE@MpqT_)-Y_P%P^;cZ5$4bEF z;2x)saY~wzCo_1eu#zDG_R9yvf*tJKj5pvcZjT07sJps#_^VtC$D%yf(A)ReIgKDP zEn{LpSZ|ZlXysV0K$3d&p>|MdJWR&;WneW)kDmV(6C<{;0*MRSJ{l@7=B^cey#0tNqL@> zvFDtk=wF#S&UEbgX$kOhL#J5Sdiy@y53nNq5xb{9C-$gky*>}S?qfWqr>DKeC6+qj z{=c19r!uPn&&qx(ZxN`uy9McEKY&PrH&%>mpJB+O7JDe z5i}yci(|G$6SWDWQu(*`%`E9)oL*m?^!{jQp&ba33w|KpQkY|i%Hi4dGU283m*Utcj^3VafxTIioiDONL)wIehJ?zl_kAv0jhz%Sr4`geTWCQ=2l-{2vc7D{Th4295_T*~z{nyyCM`UPQJASm~t? zb)wcsGE9-a=T`BEnjL=}t4AgHC@Vz0Q*`J!qrp)el?F!JFV6t)-cku}+DCKiM>QOi zp-356%3@fk*H!i%L!vU1px|o42x|YaTjG#5W9AZlv))N!@hRBM0KF6p>+mysQuSd~ zfFQv3NaVcbe$p$v)C+H_0ZY@+{|jB4YXb6;AJSS7=Um~@%xi`L8ztCjV9hxd$-i=A zFJ(_FHwYH$^j?z^3-cl*NTQrvgmummBnsi9{k z>{tu!^lgqw{U6~I(7ZD4^+={xT|kws>~ z58pm2J_-TxWDSov92UbaGF=gfPpgPzB7?-nQoqIA@9d^Ovk2Gh*vuk268F5wxy*7>iO>789cTM?Md;xwP% zcdjENiy6n$olam>&oj|OVsBjQFR_axDb3)#Rb%dLw#7;V*lM$%^SM&#dL(sB%XR1_ zwq}I5Y1&^dp=zy23*~<`IeuJH*{S<_`Wv+|Mbd`pxa!8;rW@zTw-P3r&;(o|wC_fy z@1DQ25cgq*G%|&3J=vFIq@Z_%v^s3!7{$tBvCmfhbK)O2W98<+V_0f2`+&aO=UJFFUE(?mf!@C3X<6&!LOs)6KL)(P<~L4i*}}My6Kr6Qjqdt1K=u0-ayqJ!(>##785ELDxrN^>g?A zh@$=AQwW+#Y*Arc4o${@R@^OuL9^wtD1>29QSNnQ;4p$os?=TOWAB*Yf%Mxnkes>k zH^<(iYjs0nJPMHMmqHbq3gpzAer+oO(ksQ#J!h9ku)?Pfez(vQ8Utht6)We3O+~e{ zyE+K>v&)GH=ROMifnr2spKkL3@C42+%Y!;*{75mUC6S~DLD+GR{^gFwl}XMsx6>5F zIEz6Aw=8!woG#Y>uhucg$!wOdsn#)@;nb$dl&;b{N`tSTBlhe&z}4|?z#Bf86XpDW z%9j6~8;Onm|76P=Em?=d|9>lY+RDN-jc$N)BwLSa8Voi@lyyh{PvE1nIpJF6^RImW zx?4t2oawxHF>G%LN)k0JnV@FC&-0NuUL7cyp$79EW$QDxvuh^kuarS2rnkh>xoNgw zrV_Q$c3JzSXg@X0=Ed5w~%IiiSu zy!8&I2jDRo=o zk{91HJg)CNQ)Y0@jrS)$D+md^hy;jT&p2p&^B;gPdm79#cK>vbJoG#Oh!}S3VsA8- zCD3NPOS(6&BhKnP*3;y$EY2@=N^`*7bL?cOt<4%im8^-YoC_|S6xU~MDXNAO>NxsJ zL+EHX_80kriGJW1Q~jN-LO7}>ZAN0J&kEH%J4>kO>n2e^2d~?9AG+`VSb^6(H;CHJ zQS1^RhM8MZn(L?XH!LWs{?y;3qq1d=4n&Pc$^Vs3qWIV<2N}{^e^?wno-3){l_^Mh z{2Q=od-8n|15TQq6mP`F!Ow~7bN{`E=I!Pe;AI^u89%ue`821QrpRh9D$fS~$zYNY zyN|b4wF}}gS%k>-n$1&?m{Q*2eG#q=V*;}3E4K}IDx?L8(Sx`Idd7Ba#ZV}FyL(oV~Y|oEr?M`O9)5S`^K-CBK^SP2)nD{Yft$j z_VRvQ4#R{RgJgci=Iof7r22*@)>+CPAjr{X8h66o_qPaopIZU%CvzSN%|J6x923{? z8+(B`(Y}}<=0e`=<9vufc+{XQPgtDGo1oBE`3>BB5B&6F3+;y%O6QW34;O24*j3c2 zE6>ai(nu(YhnDrcJ8dL#jK-*Ok?^Hh6&om<%H>>Kt>r>C7XR2h?dG+Cg2BPrIln=P z?t%P5k#r&!lV3qpV(I*|d-f4RRO(=8pey;fw;|-Ox1CIj4#@pmh)H=eb!S(qthT$#G6||FoTfF`$BL&laY3x4Cc(kA8!L0 zii~~_D8mfh@p`5T?Tuw0$7>THQ*pCMS|-Lm0PTTApE~uM-+TZ7Z+k(@ouC0zW1kGf zb8GTD1Ut;x{WG)CE|^n0{ESeZ{rr)|Za_!BkV^SI>6{kNJEG8;cJ%jN3ykD_@R-}= z*ERIQ3t?Vn@{{2rl9`ret`%)4!=+(`zy#1kZV|IlLi~c%8(u6JLP$)18z$rO5;%FG zxx^oG%~MJr(NqpxbIugyACV@pm(S6;PRU{g-@sR3b#uN6nK!_)&=MN$y==^qv_MCB zUyuDJ&fv#F-1b>6vNT)GetGzs?sPR4JtG2jIPik^Wbr{C?^f)-I$y@?m}-$6(0grE z!*^bhZG@?cohE1@%uMS8(&D0Z69@omqVB^FA(Ezn6c(w*kE&V}z$mcnKS6?b2*X&p z!Odejl^t*dj#Oit|3@kao>sF2!l=J`)`R1)G0=mJKawv=D+H^3t*A{Q5X}k|+`np& zpTX!6&XX1fvLrUVgFBQhV1ABMBqNMd^t*r@!yU~|gA^XYWLB?M@9}3L*rVs)YTjh)EcKfmdXAtOx$N6D9a;o;=_aHQ5s z<5q%%IFFmj0%%#sn2h2ji?_YjythGkG69jyFcv|+=;1tdt!(EhY%zEVBj@5KcGV3u zmep^hIFnx2SFl5JRCX1GN>6Sj>;p^p@FmM7h4)at`Xnt3W~bM4F5$wYp}6Fp1eg zxA3nb_bvgVeK+{sIurKS^yu|&G@Bqa6?$6r(87WDPUjhqJoVOr;vUYxC7{z`TuA^ zWB=BPA?tg=ym1q>X0L$!pSjtvGwwzdl^^erBK*ymr1srtDN{0qntpxI zB_*dt>VVC;@VSW4vUVG7fknUv?a`T@b+RN1o*jagidO$7u0~z;<$W-o z*QaGpW8oUeh45q}J%a zPTY4xcoog_<1=L+8o_}4Ay{ba@i2}8@fpXdq7AQ^njlT`EU|T_XaxQ-%*Q5!fAIJ>(10h@)5W!JqBs*1TCI=Dn z11oo7;F0>l$x8)Ps7ys4J9e|bq98~t#HEhMkfoFlp}N}`el6?f0bgHW!R2iRC58AX zy}?eUR&_v0DR;#yF5jCKB>OTDh9RD0OA}Mvx{AO^M+k@daq+EO>4z{)V+&H@T8NDomg?*coT=1E)uD#E? z$oiO$L=^gX$oq!eEQ(G4Ps#4TQUNh@Gjaa!t>Ln!Y}_UXQqPOVDF${p_8oab`x815 zKN?ks5TZPyu52gmP^zwUmg$e51y?cM_`SC(8db2KkcqR@3;@8F{+V-2_FFI)4dlDY z)I-X@O?syb6?!&(noiOF8pR%kAw!L#o%%;Ez}IoK;G9E;+Kgt$zE!5;F|MPlF4X^F zb(%2(C3}Bjs)_arav}i|{y?N}hlpiqWQZB|OIP03 zcLR(st5J!eE`<(Kx{dMISKInP?Q-pRyp!6~t?cpHtr9Xb0ZgwePxGVS<>2Eo7!I!z6GPcG8w(Q&k|#Uw!=pe_8XO$Jv15u_RLr0laLweEq2O{|sHf z-`(tc%lbjFFOUO{Od+wrF;gwMa>_U@nfN>>xh*nJgzMIW!Yy>8c1!W&l`4uJ3=uVc zXT6|L`}D`3Ru#b_jO5MRxGguSZCwQK@28@ZP|l%x!hp@kXIM{iP5Xn6b*IoK+-YYHHVG-YgbJ$cWe9sHEL zuUQG!wJ5C}6yGUq+dB<~#IfEYCUEvJ=HYxi^UsIY+x`0;sCNYchiKV5+p>!WC);mk zt$G_LXJEaIVVY|CCu!NdRgEZpZ`F1ZeaMGb)x=2GNR6qsJ~KLM2!Z%h>556hcWXxg z0aV}KG*?Gky2sdRE9ig+iIV-(I}ev`C$}{#%PV@{lEZmv$-gdGSc6_M%=L-7O=*IA zljf!NmLZyeriuV%%DzwNMdXF8EYN*i5QOA#Iew6RGWuKMbMS`|(yzwn9eAcY9uiJB z%m%n3u;w*|kBAE=jhQYm1Z8-9$)a{4*$_4rUwu}EpICpxeM~;t2Nm?@b6Bv1`1mzNMZ~c3iJ>$3P*hg0!A!c^=5}DGHJkez zacSTSfv9?PG6IZJs{|N{a`2FaV7mj|{rvYCG6iI5Wc-@QenYHOKwoW{BI6I>lKa25 z7d>u!xK?<}8S}znWu-HtuL2__E0T?W=_DnqNy;ABF9tvHS%lb_QQrNwF3^=mq)Rbl z%}C%3p4?C}2cBJ$;CKXK;sZ@1cIIdz2|)zZaTPV+_NbeE9_pownX>1=VqxjkxJsf z+Z8Dv%^3_~3}wcqcQR&MI;FR)I$=qQc&zqGpuLN3q7Q5J!8b}^UYSRJ4VTstcEdRWFr}U-~*g<%&BukskDW9Uk$! zPum=%maBD4Ih=Mv*}oBfN*)?cRJ>QhVv^&??vyIuJh(fyj)+|Tnci;`f*y$Vk!JL36Xw!G2NBYvxZw7@ z*;7Jiay%2s_(2opR7;?qhVL(O7-FbU%=mbyH%jk|QuupXo$iQD%qG3(EYND#<&oLl zVafM&jsLTkkO)e*C9DG@pUkY+Mth_EXe(-2s+~p8Gti)k9SAIi zT^XUn*$4dJoTjFgT(BisUl5)=-^Obc_6{-ev{T3JR7Q|75i^*2x^DMxO~aYNcW-bY z@st=w3yQ96>> zK{j3JWP{Qxb1u+7d>SOA%l${^Azuc%~Wc~AvRK>@#0_f;QX7WO_Vv-xXu1ZBO zMmYy?N(~1jxYb>b%Iq9M=m~W^myS-Rzq~R-2{35%TKN&=%WCl}OuTIyj3yX4wbQ06 zY_1XM;oV4M*utFha~pEXFWwriDpFQPb9xytZ#J9&&^3|pj-xG<_5977726G2F)VIx z-=!EwjsxIoUe@m0@$*wInLok&EVrwVhq^|XYVCG2q)wAx&DmHA2RwNS z`|*RT(^%o6(ox_#M6cAkK=nsu^E#aUo4NCUZYzyNa4orx!R~x;XTJ8kryO*lN<&~g zHZR?cW9g9QioD{vnXBTm_y;yVQ zgNWqK&=c=M5N+N=DFN@_baWGzlSic~)9;NiD?fnO;iK$c3t^_9v)#11qr5 zqED-?-24ElMG4=(>Lt3IPQ{vEe0LDSiAcDNIVx^hvVNs6C=mkV>TuU%`oQ^FJ_ZUlo@QyY zmZUEq0isIK+%5svX*B-jD7Hg5q*@qgQU{i#E$H{@_ z{)loV7Q?Y3|ExLTB?7eGfz^aHO)*TnI>S-(*MBkKB$o1mduOW3j&_YOdP0?{*;6EX zfyJdM9g~QhFiNWg+)Zti3q@PcOUBm9U;o_+~|IAUS_xW#chkQZec*3QkttQOs ztY1G3t9(K_-|2j(fYj8+IjLfjl-sekGK$n@5W?*yuJlQvlD5$y1##~}iGhW5&WN8p z-LY8H0XRZoM=8X)XPV;Xt5>l)NcOQfWuI)`>6q>_1N(DMpg_vVqOg?g{$8mqBq7fUTmJ*#e;q&fDjS5xTATm_vR8O_L zExmWJ9okWxl1~1F4IOcYeE66}l`uTS{1Xmmgktp?WQ5#OMQ5#Y;du3=5vv}ItazkF zPme&p&$kXAYO>0!K>SX6P)L}?N*GSP=QJ6)CRLNpeKoF`t^C=e`2~j8&CQs24Z=z4 z2HW`TSiwmpQk_6&`)l&h^Zio5_np+ooFB)&=_AQc)tTzKMlZM^Rq65)DavFo4}?=1 zV5c#v$8l7mobOaF^0;`5GAF(@Q5q~pQz9LL#wsxNXcVt%w$ZArZxnA^!&rsOO5PEG zjPB7@Lo4-u8qJbRb{t`u#>nhq9o1$AkWBrI*R!vDY4hTSB_W;r01Z2v26{91|f2}ZHfHC>+fLg$DQ8% z5?5QyF7d8MiPwk3{|qP&cZCcv*|yx-_hrjj)Jqyv{N$=o_%ahA-ku%?^q*e##aTn) z&X|ljUtg~{EV87qz0<^kizUssb;*kO=L9j%)bBCBsVT|MC7?BTlO86bsa=J@}v%-qmbRigwX6D+n5g4d}~K8Q!2Ptl6!taD_b!$el5a~P{B z6EhQuyYVF=sl?`&nirHZbwg_@)Rx*KfP4k#mogwy+!fEYSC)SMczdfUvKD_bCO^jD ziJ+Y=sUbAnQ`8M-8Yis9U}uI-<8Sj9#zdXQH~j>rQS& z?e}uXm7r{;ER;9)*!PYBF?m%3r}Y}`AjjPgTJyJwu-#qEJ5pB8XZ5Q|mbABM$s)4yWkNCm2kv^+&J{i295|Kwkn){Zi$UoicB$ zXR5n>8bzKfYr_6X&Wffz+UPmk(wUPo^OIx&tXYi(6H|crRlBrFwrx~97{z;rms9-~ zRvJ>K4CNmF{g_BPdZAz-Vy=#cN0VROO??NQM}dPelBAOf$DCNTKj zvl55zhRVv+dvte!(Lw!8n7sPTvr7f5i{3=#y4!N9syNKCF4f5Ig8k2qIS!+PftDQY z2}2E2N<01h5N>#W5wBS~+8ZvE1+$DE_aLx(QBwl~!(^BVErM>GMJeEd&!P*xIZMtl_@gagu)a3%FX!ob-78tf# z?K(0jV4?ZdCauqFiY6KXj9|qo1T5c#Lu!@lP1wz4o)z*AwIWEMxnuf-&ghR<7*)WZ zVT6LpX9&A*8k1i!N9=u z|Hjr~bqU*}5!C;~BcrkIm1sb>j+>9n07w7;$8e4x3 z;mg|k=j_WWSPOdYV_tpe;?x_-o*7Uhg*Vh|jYZVO4&`$;e2xiqj+CC|$`0K|wi_e- za;!0PKERY4(Uqm{+{SZJaj@MS7usTWF=bovL?VED$pcBA8;q?nw{yh`Rr1Wg-lk{t z50+f^qUd6ohwN(R`?Q{L9L~oE>-kmhtfx#D*IKme$Q`K{;vp7!Q)G+2a+Y(m8-6Oh zJRZ0)cvKXTJAO5O<6ViUci`x2Gq0UMHb+Iy@(HtuYGK zxD{76Y6Ab+_PVVebVeIyMO>jHha{Sc!am%*WS>}Y`m^}i<9hvP0^xLDD6|Cwod^|1 z)ok!%jo~>*!Q`(7eCkMkjNbfT@mqdUokKj|CA+K2isO3h+M9E(6uYh7B^q_atd{^P z4L2k4&YrFYJRe_Z@xW$tyR6ZV^g1hhi@kV{`9V1)XK z@dEw2C_vw5OqFr(n<57Xs%l5dZ9}om6!R4CN#*;U{$b*vfA9N*z4~BB6(q$*PHeeH zdr!gS(_Q;G8} zNn<5*gzf*bF%}Lu0p>qRIcH(mr*RZuMRl()O+4V+H7rokh-lBk^YgaseQYCnWA=$v-m z+UzTlNjl~g?vY>5hbrC#5UxxTiO!R21p)58sb(vrTEE zOZ8?e4Sb2{-!&b|kJ6}wHlcfVyC{j*_|d~ON#3+M=ZtnzwR*bGeYv7dv-*PWpCfTG zMd>sETx4L9KLU)|_=W3QaN)M)6c^-)^%flW66~+ShmNZoeW&q4Zg~1EIoOMJ=K)mS zvU4(4*$HE)#4vq=8NcF84t1zT1PmxzBM?B{>@{TyU?F>Rgpi^LN-tjdz~_Ix*ws)v z>aZ6=5+i+VhoY~rA?1l9QN&iE3HW!Qxjka9F1Qq^K7*VRF&gKyZUQ}iDekqc_fI}t zI4+bdVc3#WkVeIlb-Z5!=l8B6(n9GmzuqyaVFyHhNoNFhW@npauTnek#2Lr*e3={= zqg2-RtDMLgp2XmIVG0+V>l#m=MI6$Y?O%ymVYKA^9NJsL@CGa^fzi-_TPnsn~VwAD;?IWlamB4JyA%s6(lS@ z9sut@`SYv1USiAjLAp*`o!c)TGF+ET6Plz9Y=0QLcfs5x9(il%y5S{G9>Ion@%g*( zPU@Imd2w`3s^nj8?(J(REF_pQaF1dClBs4#IanV1lB>Ub_2J(w8lB zx#h&AxcNbEfdZ!wij6BX;t;?siUi$=m2fLqxeaUO@!54-sZ-ET&hNy@_~B~@YT#zw zq*i9Yp6=lmi!QuOMl%9VGy))U)lfOF{@qrr!{7;SkZ^JD^RNMlG{XQiytIrQ=W z47I2!nvnTI2tU=4Dq*i{Kic6)T^cZIa7(Ox%=DL4^z!)T0ZvN^(_q}}z7;m8ud0(b z8#Wd&U5?!9azls%odS{qA&-=--__no+7J1%65WAF;i{Kf-|2{;N?0%-9igt7h*rOV zQC$r^*P4iUH6nZCpeEBEvPQ;TH!b9T|{+adFpvOC4N8th-?_ndU$f= zu@jGpqlhS=y#F~D&LzSmxf2s@59pO>;u7WC65Z`likB8nPh#xw4l_cOppjG(Ze6CU zr(o^f`C(cpM$t$gG$HmeW7Dd3_PPw+2!6KRmDo!5LrAK}eQzy631&7}olY&`dG0xd z_3$x6vNooOngBNKz1-;NX~k_caa2u&N{-IRVl9ulwtLf$EhLJZEK)QhNq@h!JWwQD zjL+wR?Xmt~5x{zjxRRWEm{Bw>P&RK;Nsn`vbj7n$TCV}}JSP2F73@i$R0}5O7p7&D zS!w9(=WBPhK7G;gw5h0*u%K{Ysi^02^_F6#bj)WOewta{;Q{$jEmtH4jab<)X!Egk zjje_9R?l%Gc{{qgTUmaY%y2^5aY?@9{jgxK61U~L&Ddudzs>A-mTS@V^s8os>RRX{ zKx`ns?Xo|tEQLm=4W@;SefjNZ{1K;_naT*?7>;TcE z^Z}|M3JI{mmB0}6--yEb@cIV-uWavl%ZcTDv$+0znvjE z$qAZjp8_~3dqr(yCdbUbNUf^-fsK$WAjTN49(iO9rNOSBNK5h7pz=xyE2VFSK$NxO>3N zt-~v-!yCz2poe#j4V7JDEPX#+!>fkTLdPR(yGx{mmWASnXo;+gJ|V| z+PjHDiKnCL<^C->UEM^)v?ksz{AI6-jiveX0GNzx=0b&=TLw#61=NW0|tprc+o*+xQcbJ-iQ{*#&@zsVe-Z2C>CAwa_&N*TIPNMMNL>Ju~ObB}`|q+Q&} z@T#vOd4tn%^q}>>&3zCq=3SM%Ma-$uIZ_76m@hXGMCiPTa~gtz4(0e?>bXk!uoCi0 zL(Eb6*k|Bra<+j!@0UN*3-F`fXbX0b!8qEDnvD@)O;b$Y$*K(P^bKuJX=OX#?&`=e zmcenuj9tH#UxNJTV-LS8vD40@Ev2tK2i;>3^w6&8UkI9I3k2FiV0oc#LfsbyQ{v-i z{4LDgPqa$TP)if9r5ORa>!IZbHtxUbS3!Q{Fd)5$sAvb&&7{K4u)co^ILUD%!5Yta zo#J)n6|p|>9PVj4O>P`g@IE$#0GmF%r6Po7a}fk(NX2mbI=xhuxq0nLhR=Xe6x~O9 z&UO|8q-j!1OnyW3%#JD1{!JEe{b|S}gN%L*0&Z-O;w2lY=`l)X`*-)x&)Ow@78m@w zc9g#TheCX;8=)XMQOA{8LurA&n3xgS`#`8*hZi0*IHX9DFsH|3fU&eW;N+<*=XVOr z4|V}E((m|ty`|^@V*psmHgNYHX7FQLD4#&q7jV*EWzZga#to%G+?;V7E1;rj8`#If z-ay(y&cS@$wU$Ax_X|EdVY^J=a&RU@w?=d3JRO4Tstq{0f3w>MMj-|%NU7tIL+;mT zkS-tl9Xs3=z?2FZJhI~>jwGiY;_2B4YxX)12cB-&@4LJ=UJ68n54uFQOy*W(dHmzU zDqh?w>S5^9RPbtuWzmIk-`G17=u@kMDba%?16+5SQ#Y_Lz5VDpLD7X4rBGt=(@?o& z)c=qM5t@b%#rgnJh6e8_9^ed_z2XcZVOG!{adU1y9V)oAjcJsBj(5FR0kcIOAm@Kj z(l+UyU%zLxWp8-lK5#sLzddQVc>sMuVk6$Z_u`vGBcs&Z!wJcqe<`-_2lYXSL5Pl- zR_+Q)LN)<6&cBl2yqnY~bw815XX|04m)tUxiC+uR^M&{cLw#W01e|T&j*hs5zaEx0 z&&kbPJ6r8TX{+y_-XCAU-|}^N|L&J!HyFad5TS&UunO_`qW_4(^c{m;Ug}1{uFv|u z!~fH40{@rT#rnS~1UMM~O`Z&&6oGJa=rWkOj#Ogid@Y=nf!(Gv$g%xwb!PI-#j>_Hve-J-O$sxrnVpBd3AVG(hi9MHGZ=|Rw=Gsw+g0$pL4-|Ja+lEYI?Ra znB%W=ATw=TI+TMMh8}LNj1$7ijMFEm5be@hwDwILiys9|@H#G=ZDI++XcC2PFXs!D zTO=(?ntzb_c5!LB)v4c|Zop=rT6!kRAWO;7fY8bt%xSUtY#g(f4&QCtEMz7WHFPG7 zK+(!2+1;6>8L!MxDdmst?r_xwPcup)-8%f{S*a4pyv7nguW2ihk`z+Mt?$I}qH%v& zuUV-QW3|#2zZ+ngp!1Gc%RfsxVWrRT{1wvQdhjx9aNV3&p;{ZQ?!v9260lRf_!#fC z;UmpO9DszJ$&X4)y!96XZT(+^XHse5TrNH?x#m^d=d6q6L4y}Y>OBH2T-{9s{w6ue zOv?u9fo6UgN3(cHks@FG_+w5G$R#N@jEzJ_NOPR#)a$qbyEQ2UPpezNrS$evmXs@V zxU*@js)AD32RE}o9k?N3;$9p4EA*+vhZMq2J)9B3YiF*^a?SPqs^W{{MPO%JI;56d z#%GajpRXf@Bi{j}Vnt{YMfOXvvcK1@V5;Y%D2>{4*hyA+&IXEYbYh2`{16o>iMdaT z3dlLV^zLtGgv?cDEu?$WprEIdtWFpazIJmtUGpx#?61_0Sm#hGt+i6;CUQLnt^T7A zSCCJH!y6x|xNy46#XcX0c#Kc>VT~+H*ARv3d5p{mqJ$@sX@-A?F z>2gVekDfdYjfWdzKb{v=Xd2ZE)Cl0oesR&HH-fb-y^@VrZEy6;Sg0hcUC+Iuw#v{IoLXpIBv6xJ0R{iyxTtl3q=pZ&6F*u=ct+Q>}_&{ z_1Ma7XS@X~k-{H1#tFe%YE}XEXV+nj+bYZ7b$4+Gr$#T)Hm&(csgw);YE~|8P^z`_ z9jIy2eL)>zvkScoF>$EoJCq(`{B0euTiUxlOc%S9)incEXbZbRRbZ@a;0C!(9itNq zmVYuWz*_q&N_$8D&Lmr&KJpV)xR#5~-JuEw;Tq#LLaDaW5ezP~K5Bl)Gv7No00$=* zLl{tqnc5e0at0Y1HJxAbN&$?5Ze-^c)AL$zUc=K6M{m%!J^MBOa!)zJkOkpydFx6A z0qiW;Voz&M@3i>DG6}FFJ$>3utY)q{qzjZ~N@t))5KCQ^9~G+AkYYfpqDG+I>C?Po znJFlb3eB+7eL+Ux7!NkZU2+2y2H22I;aw~gLiRhO9BzDLNw3r2|=3Kaod zjpY_1?L02@h-iIXEN%aA%772Lu;N4Y#pOfT7Pw+xtYz@JP^bT$RV7E=J3^_C@Gwvd z_XAldG;PNVOF|KYl_{zKY-^!$Qycro=4;3?q#is~xw0MfuEa6lq}%^hvUm~zsm56! zPW(eU?B~y+BdY?Ke2IF9-nOh1V+;ttuon@(WFjq47bgz)ldsr6yGTmRWp@g#^b(v; z&8DPM_f?CkO5-F{Um-2Bnd&$E989+9^rea_?egQS{_vDSVX6R(yl*J5EFnA4mtc9B zjphUc`{&ZOhmU6vdHYI(nJNXCXoisC8jjt)25UdWV7L*;U!OqYkuNpN?q$kM6gC$_ z?{|u!qOOR)4c04MraFKx_DTlo>);#G*bCr8dYj%K=PV}jkrCx+-4j-VI0$#&^hB*H zy#QV2ClSUUcrw*UpjCYXy} z9DkjQ;JhG)Ok1(#Nz4RAok7Wh4hWS4EFq|H z%q%23Fq3FU{58r7+1)m6uoC>TC5N_KK$^J9-MX>uH1PK0V4R{rVOswlNBsca0^ExP zB{SBcorNIlQ{$&A3tRiVI!>BtBc75{^J!2(@KEKS11Af7KK^S!L5a7W>PEGa*C*rP z(J4L+DUJbDJ_p2`HDs`8jNlrjJXQlM*7n$t{ZK26lS6~I?wLwS;dVQPJ0Ti0%dTB; zs&jZ#0QDFn_WavXAi*ns+deSw7mG zbP@5q0%1#u?cCoMo4k&J>PyMw&2)?P%+=AF9Rx83VT-p;DXGZ`5Mk;~NM=X;nJ{)nSvkJ1M z0Gww@lE!*Zjc22^t?|JfL=M; zuOeZU{+LE9ypR4sQu^YW25DX07BZsmA2;KEiYB0cG=?V$VJq2Qlr&N_v1%W}2`LqQ zE8snSZ=Xf^&mZvK4}dsmHtT(l{E0xBBPyT;@*`Wd5FZX58|AfU`JDX7;K{|BOYA4p zDL*k?6yO0IgpW`f1V~oZl=P!<%#?4ujR15jT~28)ifkgNpaGY=Eh6!N09}9WveHeP zw5Hu%yxu-mpo)GU-y_FnVF_IM5m{YJ2I6W&9LAXKXJ~^-S1J09Te=_S8E(%COnC{@ z5=H~i8W26mNl6WpJ6Wd=dJK|Zeg}R$w@{PogTyJ%cEU*Jf=JBK0e0;LTtFL~Zm$80 zGSxdVO1PKu*HBYGD8og(Ai%vBkGM&mIy?yRFr1Uo zt%*OI1k1=1tFf4F`!DbNcd7vlm1L*d|BmHO)tIpPqjkc(tw! zQS$-CS0hY50MaK`<(~-#$DC|p#Rv}nfn_00-U|BzRC!;S`i>u#Ku=*yc!S4P0)KkK z{BZX&*8BQEf^KZI7eQCNB_K~0{h+*Dz*BB>q|J86T%oD#FXrFMvJH&&j$$<@t<*@& zOJT0_6(@ic=kBXL(VPd-oEH`|vdlXB<~eg!e0&8g8i4OJ`$IJ2b!35m-FZ{@ED!S zj}Liyv&SuCO{J7a+~e?OTM^%&&6Ixi=f$Z$bYP{O|Hm; zMcu4ZKdH<#m{A}BG&+R(04BShyFILKV4%4H49eOFpz`bXjnG za8UFV8MUW~l7CDzNq*N?H;@WmpmQiF@TK?yHFF<~FVrD@OF=eWgYUu-9Ya1-~JpzCj5R_EJQcT%D$NSHDK z0l`duCE%8eN<(i+3 zHo-e?w{nSA>q=|v1k;-$b||IHxAi54g-48ymIsg7DyV#=Y5J}9k;tOPZ8-r`aU5aX z`8gC&1|!3ccI&iF>q4~@aID^o53bc34?<%#IC#eE4VL{m0vW}nN$;w&$W`{})W*PE zoFFyrv`eA5yWqYC$3)OE<+Gzq9FLOAop~SA@p}gFaNoG~nFd>Tw>SUBZc&??{qf#S zcQtDXysEjJ`G$7krCq31SCBq0YLnKvSVt!}k{|TuLLCsj6S*AFMB=_C_=EvY zPTYIpPW#&6ri3#~n?mk*TbEFxksZW2&&(vfN?Z_Owutztp$M@)9wxwp4qIvk3~#%z zxC%Iw=|WI&@j&V>f>|6-ADEu@OoJDe6?vcM1lUzuJt{lZCaz0{M>e*F*}5?(s7@N5 z2k+?Z0?3pDPj2a+O@ID%DK*`>;j`MKU2hzY%|%6~BWM8eUZzZ3r@+r^{wVt@m=481 z{`greU`cS^4Uu|`S~q}N{=PLVxA51_Yo}P!KxW>Qyw@H=8!u0iEYe{5K|ZUEjfpKy zN@QFLNxL1W9*DPDZcU!O=t?sWj_csaP{8q9O$mfksWjB==U^5y=rRH6wlNwq(!Ujs^c?0=k`YI$ z(y1pzoz1pR?ntl9ksKohl&T*D1_SXoHpp!@*Q0jruI)Z%b9FkU{{;QDUQ2*&5r>TFRrmXxCu)v8ciYOP zwNP#-x4#*xvDy1*3pBR82qms!MP)A?j{u49#mYtUuiioyU!_tTEvlec|KReHPIBIW z?}$g^Q5 z$IX5~5ZaB2Oc^y&cIDfI^Ttt?@7Ux^j?t1+j*rn3LW91zY>B8D^Xv(wdW_J+b=HAB zRgOhAgd}PddSF&@!2G2J`08(?d%l-4ry72|W}RXR@}o~j%+K2iADmkA+<$vB|0n)F z0~_mq%((uUh5r9e9Ynh@7?G$~SVGGfiTOfFXn{b~%iOhq<)S5F!;$&}=XvcdOlT5G zZI@-yx|RX(fn!M4`^oU0V_zVK54Skz*P(trr0#5B>aB2}Vag~6{7I#sDPStKng+ez z4{DDF`sU1)NqiC`idv&M1?rCmt*y-J%umiQ7I{DBP1N;6&}P55#W+foD5WW;n#;|h z3tBicbL0c($wU*sQe<6UEX-+S#7Cq_BgF-YbH@mcg_c=3wRVz-so9mhi)E|Db%@Q2 z&gzmC8c9Ovqw~6K+*9DT^x54dYr|=DAjHiSvgeG0g7UJOdU8cwm8soPCuW@uufZZg zx^hTpb9sGoP^QT)mZr>C`Ly{;L*UJfa*3I_D-tV@3YBJBDOc7Ud(v}5za!qAtma_$ z)LGXSURnz`xGa&{zV-4J3TpGMi3Ac_XG2>#Otf}rO5ddGKU`l96PyJRiEebu`~#wJ zl95J6$MSRwRpy6>=o7s0vD>bCFh|R0^)-!v=j8lT#dj)ZHjpqXl z!lEi$+|Gt=RnVO~OWW|ivZ`3GoAriP(qTt!J1YfXznX!9jZGU9jzjtcWg@uE;h8s{ z&yK6DCuem=;8$@&Of(kUu^U^}rrJ_?!L>G-;lBngxR?bzLQKW;^#-$i>nygX{ilBA z(#QRTV*o_%5h3x7+>?Paae=`wU=@3Ycm7`=VNSFfl&F6>O$3nwb7fvV--ng2i;^u< zo?^Z|UjBq}$Ytv)#kIaKC{#A-m9k&0K2=X_v=Jsn?FRKwJ45v4H}8t&3@ujVay`(z z!^QR=Lu1Uue8e;XeM-)_2|GQDWeJ+<`^}y16Np>AX6rR?uw*9gEu{RmrF2h`-?%*; z9L>lixY@mg9e(zBf?P!L(}0G{3x1u`KAXWph$S3~a?821WCMjIl-^mSyyG*~T>?Hb z@Z8ZbezVTL5E$eW_K)=h8X}vsK7j+}ug}?SDkKGvQiAoOROc~3^Z;zy7c}4~UKi3M zj9m3^<+l#K(Rom@BW3wTzg3__grWOL`|pbuRl9~UH!dl6VEsU zpHDPdPs}Uzf#I~P{mp-rnZqPJ72LWTwJ(HZ6GqV9LD5GsJunAw9C%4mtT<}TKgKNp zeRA%!e4z#8$6y%ig#y2#kQ9&MdQt##;Y0n?)OSKp zzhcTuuh}xFqx$PU#Q?M$D9Ocpo=~U24uHzyJ#8ZOj4V>wvZ;^)rj%s7U($hDP-D+x zbiQ{&r;Z$+oLiblsgg^p8#V+7JxGCJ5{E}D2RsNkTW=UIeW!qxs~y!JYZ^`|{n!)O z7@*x=KA*||5LF&kH_l|#!E9uEyrNMJkvnvF1(e*v`tk@F+EwuH44bs>Dy*AjB@R}| znA6^gB0a|2`QfkTjh}jJp1RXc zYw(OB<=i3T$gmVB{~1YrPp_nT0w52u`EM%ei(NS<@nJzBTi_>$Wu?XML8%KoU8G(H z9)-zvHMB~f;0y4p$a&DZ+vn;aHcbDZXZhU-{O9U1!h;41@4>p&)_JE8?7=l!O0C6wJiMk36?zQbnuK0}}Y(m`!&pu`-B6!@1}HucQ<37HKpY#MB|gmd9TJ*I&AzPcC>~Z~J<#Mnua0?VbGJ z5bSIW|AAo7#?*;DY`O356>Li#>&rkCxwwqTTO*dScNfPV;>Yjs-rIQ4RM&WrczCbr z?RgZ@XlR};ZsQ62M_}Lgnq_~(I3oz~rc@n83_aT=PuQynRO&6)1pjDGqhX<(Mo+&@OWdPWmmS+IV)!$7o()WU!4@VPGh z-2(vv71yyp+Y2ehh{sgjQVAQwR>TvR@pu$)@(&0D~J!E z_v1Fj-XeKTxaIeerifJ09B+4y)$@F#h@)%1k3i8Kr?>n<MzsRy$^Yyl|#yM^jI-BG9`TBvqX!$@$IUcd?O8D%#5%^y;X=QO0wy_m;$8w4NN*ij24m4I$ct=c)EQt)yQ1EoF#=wh#RPtC=fX(?DC zy}qs14;n`2uGQg9?76+_lSHSkToS5wT&|K2c)Q)CU6Xm_;nA-UBPxe*h&PLkdzZ)( zuEufCp#u-ogas0ht$uO9`r5oqT-2?}wg<85JN%eVv(*!T-h%@1k+WG}Y&=Sj+S&nF zgL8h08k+?yJd9I{SN!zP1O-16*bJq1s@|3II|AcGb%cl264#Tg^J^C_hteX z^x|BzN}#J6mXHd_LRv>9iqUk#XFbSsRhldGLgbnbW{fKK{zkN{->cN$TVr+YW3+OQ zY~cj#p>kFC{cMQ4yE81WfM}sQv@rEC9m}!0{lz47Jnd~}TOTOB3ORN$V4=Q745XOQ z_$?>d8Ws18Ti$9U+<;0kwJu@uw;`g(SjX+jb@1d;)ZKs}N3T$};d5z8u~*5Ve#-+Q zGE_E&AjJp{#SzeU{x5CJ)ZkjnTZcOgvu!CzAQB$mt!v68G-F`D$mbs4K1_3}FePSF zvNv~0D?{D+6Ob}wll>agf55t@6$>kR`*RSB2=+;{FY2=HdhzmSJz{^8!SRR zz52WlP9PPVLhbB5_JbTpx>Wg@h`k5LV}lq%C2#?)ed|sV)v4z9S9Jp>(0q+I(gbiq znvPWEV)K_|>X!D1=v}XA?oN#Z58>s)(Zi^nsU7d?LTSu9SxX&1%6c(h;l=1%7{GuV zGYAebjW5ofY1$Bh!G2hnX8}^!-lwR6akRN#rVCElkNmWTfI z!}WNPLAT3`4xCiP`X!VE64@T7@@{2*X^t6sar#{uYDs*0|FF%UBht%8b{4gu&a zC&Fg{?*a@%y*>na>*&)wTe9cixXR`RZ!M|^jp0qD^9!arGky9bo$BdjYdcP$ilJX z;HnCT#}Rhz2@qX;N-=MX2EPSlBPTlx{uxDia$UQ6)>mEuEe@_=Qyyf-`@4|I=5s!S zJ5;5(&)m(m)D93yB@CrHq!9#IQ^p$0hAevkgn+~jyE<~=-R!|~1Rs*XVyPuxQxWwjKy5Np0%&@el~5ywPml>?+_u`0ubPuG?LB>`^w=P2Tfqls~7ASncHi~#zu70lgXtL&iV9Fe$nvuSmBPHC*X zf!Il(N-d;ddQw${w?=^8Jdb+&N1$15@!UvV_*k!_n6IT>bUMuW1{S`NWp0*XQZemL zB^$yE6MUwha(syUWm0_D5-oSenxu=QFB*aDk~_^i851j%^m`iJO8w7^zCi@n-=bS- z)|1BgOGU)^#+eN9j9E{wrz1+q4<1wO&N`@o^gYkgUKim?A4}+k2IG65!E?j!)p6srmd7N!M z%HlENMgG_eZp7wd3#>`R4I1A7uABF_9il>wks?l>>fpoxLJU7Z$c{`wjz(c*dI+tv z6k$N5n*@*Be=j zxLnEuAWK2K=7zqUg|K-8J^D#gKP*?_xi3CCNmChk8H`#qwW{!R>e9=2BTE-Yu6DgS zGjg+Y?vPhEQfx?&!I@aGxOy<@Hm%)96m1%NTN^QA|M*FRW9in$@BHn>mL#zGB-t-a zY8N;E{dFCQiiqUX+#i+ayV!)nZ#KP(iY_m38u6ML>nstY4Q-*TO{NE~^l7(|QOP0J z(`u82{(Auo014g?)9wl4T%EHyCa#8)XjzZ}O127u_l44Ff)jr|;5wDUluPr-aO*^P zZ_H0su6#P=y>HHVtS(7|6Sdt0qkeCoPoUzHXkA}BrdTm{(|iN^a69AbStszT+m{_Nf8#8&s zP4szpw`lQ*QflOeT!Kw*7iwvRd~ZdZ$zp91Nin;O`N8%Q^SA~?&Z|iO&^AxteLWsH zG+($4ScHdm+Iog&U>#9Gc+L+<@-7;DR?^PA)~rq>k*2)9$)YS?fCu}g{>7WbJU)K6 z=0^>2c(N+)+w+%dy7u1!MJwZB=D&now*L*w&cw|6|MuOQHFp0`#^`gaN4OGw={w4oGjUpf!KPKLoYk{y z)x2`wd+}Y56*}#U_k(w?43(A6elOiVf9c!_7uA>zS&Y zzFe$B{*!U(IzHohY$Lg|defAu8nHaS5?C&y@1Jza$=ms=Gjg+Ku8WU3N76J%Zn9rz z)#;o6x&wEl;>iDof4Ajw*0>P`%`b#G5?}UtuXEOP3*=c!HG%_DY3La-rTpdVkYA72 z)4ygswT9t+f@SzB14s>~eZ)+mED07)l{PoS0^cbLFsd<&E9@CuK;(_UhwSw_C#0tQ z>*ptHlUao*)UV*M<5~BjBtNWt44)>)tSd?8k?NT*zkg0n(%f&bU8sJRT;=*#m?$;B zVC2w{yu=9Xh7KinFS%cM;MP^=GfmvP>#1wlla;!qH_9}z1MfH;U%oFBSH=j@1ben5KXH-MsfE`8Kw8XJBV#3Q#aseui$O7yt$ z`!!EGUQjQG`da_wBr0`(A2`)GHrMB%N^K*T zXsQ6zkwTEJSTc)XfgCA7gEpvJKiYCM^OM3?Pi;D($hJGVb=JCJr^LNj$XRklMf`nC zEh+BWl`~D7CIGG;XBc9Y?ipmIk9wrKQMkJD-F``5I)Te@D^Z|lJUa3*i02xo!2pN4>oskF_Gt9sj?v9Ah-bv@rxiB$E2am?R*ep<~)qsdsi#jEv$$H}!{GGON>^pO+x)Ry~S`-#Tf2GwuiR z-`XoYmr4iAk(*ls=r^F5=Kx-a#_c)sCOm>uNX99&;J~SYnJjT2ksEL7o{|S26z@uz zGeG8-_JfzM%ytJL6Ge6iBG3MLqyenxSAMXFGi-`UTzpLG;L)Z9|+o;Gl)NnAcNS5e+cnuLy>LH6si zOo~t-1fos^d2WdmU~&yEs7orIvtXy?>?G=rWg_X#6$Wj8A^hbc2Hp}IWd@09Sjy+r zdA@BDT55fKy-OT?GmqFr0Ai*^0HEAzpr*N=H2_zSh7{XuAU(ZeWCF0QSkX<}AIBBh z^s)@d&`sBL9BH~_44$P?D}_EfBu-6K;`eV8uwF`t7R?~^i~zCsHb6v5*ZM%q7N?w1 zCEKVoG9e`^ojg^3fD%$qRFvK$r@2_rnvna(Tqvh|RZRi&vyI{*__6XH_edS97GrL> zRy8HZ-LPJQRgfsF!uT!MX3LVndo-{giM*Q!?!d z*+T8-TU2bnb?kjtrs|>*ynyM^i@puC783RPeD)3G;h9q+HQo&HNq%Hq9G3h0#^la9 zI0aI-5c8C=HrT%b{g>p3WI#;mDIw}VK8&&EgTo`lWmmRt3BLD9 zZ}41W!aPc6YXfzeoY;S2sb$}Xhm{1PTgl0}3>JerMJ!+YGd0eEBCw!j(U#ru$aL3{ z*a#gZ&4wbaOCmnuuh{*!Gf#~?%2P5OQY)Xg7JOkomuLDukhuM?Zt&~T#c9JH5{OE`s3Le*U)#GN3DNu`FqFMTFaev z#o!pv^)eLjK!3CNwd2uL3QKGR@~w zRZ8PKz}vH0^rwB^EsDzOPH1+@YGh6=y7#Gv2KM)}oLl}_qdepVThNXX@nQ7S#FqFi z)7VQ>{k<>U%`^~YUMe!$#M&vqmJXJ1R(r|X(&JRIKUJ(fyO`F&$1-H1Ck49S&jw>>$YQ5!lNcHbyM#~ z{o}-vQOMFvBc6*40l8@y7N+>Q3FRv+Ri3m5a>ZgJm#TV-f(-IjHLOgi&p$pRQILcQ zz4ZgaG8r@XHi+v^U-Qug2DT4T3wm-x3M22+_PZq3EPONt<$W}aRCG>=l&+Zq#=ab7 zRN3{Okkm_8*=jiSjorDDoM za!|0HkO9MK3$+(jVaMv->*Si(yq;;{}#CZCssKFJNti3 z6}vGuV=_gby7l}&kf?`)()|GyMO2VkWVBeUn^fs0PW+okU&t|V`qr&_drqe~0{cxW zc~v@*964S;+22sY2txP}jgWp0^}Qi8!i!pKA<*AQ#!y zBd8Z7ImVVphZ)Bk>bRe$^RKQusw%*_CkCA@Cw82=$|qt{U31!mwpeL|sEyEWqCeRS zIJ>x>y_J|Wd+9tiudhr&7=`n8GXq2Eb4*lNpvwn6_YR%-^Hqoy_k(uQtlcX-8m6}Y zQasLGNfo`XvtB!f682LTQEVP{zX2>oQfqUt4yzw*Noc!;pLb}#5}0L#Sb_3)?`Ceq z-O*&nP1Uh8m&Tmq^(*5Q+AC%=IGK5p>e)gV8J1+#JZCqkNFr%1<*ZXC2PIRaW2O}r zUIN|-s+qEvS~A})D&&|mCW9zZq{o#fN!QNp$IRtAfy`x0WYBD{*+eO?a5d&f_T<~T zR`3;g%0zoQm*exhHTy-lLgGPlKET9O14`MNP_JbDe~i7;mLLEUWt+Bb+qP}nuC#62 zcBRcq+qP}n*5u67?YsJ+zaq|xh_g3sA6mngGE-8+#~@qKWu&RwAKjhC;UG5ejR%*7 z^_=R7NY`ENJnbBqdLfr#GBO=O@mxXBZrd}k*DR#R^mZa*bqf2C;JP=5s2#%TLkf*M zjafvck?NLcZs&3q3}H0N@>qLx->#x_>yR)S+FTC{@b$viZ}fFze9ozGcrMb1yQ+l= zs)EPS@J!yg9nakjZ|BVX(%*VxC>zt9QAR~z7w9Z*I1J@+gfp+X@UBn8hH7XZ1(P#Z zVhJbC?ITw&!4M&t|JOPYido`)Tlq9j{0!I^JYF1jPK6|27j~+~VS~ zD`2EWN~m4-(hV-vhl`Ma*SBzM^xBH-&tIm{2jaFGTt}o;r@b1A&5<_|#Run6-r<_I zz8GGp(51b0lQ=+xEKeUxZmGoLSZAmw+=|YE``EX9=RT!BcPWeZ>{Oa{4~77B%WhJv z7BdmiCRA<6cGl|Ksya4wo>Ty68Q>;c{=%?w#9&j!&ZJG%2}_W9&JN>9Y;a&pzHo@N z|3;FX&=MSQAanFfR~xSdB=D&hurKdh!7^Sl1%2s%1H&zb)Iy& z$Yg7|L*=Fq0Bn~@{}3-=8o#CPwf6P_SF<0pp-ILt2W+ey=SspLLtZ!Qq40cJvy)RS zObZ3E6;4~Sb34(U`xY4F(%F*hkkh7!5k3$U=~3+9foC~>|W{`r00PykA|!NZ;* zC__H;$DiW4HYNGaumD=iBTZ5yLSmHlU>Ya%Z-jwI$fSak$H9!d4a*?`M8FeC?%Jp>%s3E-Ne81x=CxM>DJ7 z={VmucFWt-_=~!Ce(fOhJfegtQn~ibApr_w<=Ji`C}Rl|Dv2IqXIfF35R6yAsi^30 zejxze3VLvfWt56&hC&iW$5~&6X;kP`;_V9LSHy=2-q9xkK~$UOVkgZCzMGAc&`LN* zz`VtWu*cz8W}ak;jj}SpInL%K=}|%?lyVJmap~3qqX#VTaxx@Ih{aDGwt1mbHeIjR zL-8Lp7>+%~+L!pbn&=^enoa|*RnbpS6PZjHK3aA^y~;oxUwZARAwMxfs>VM~x(^RA z#uc_$#63L_eCi1}@8AIG&HtXPb!btOJrvT6*h^Ns81dM09&3q|LRz+co9)_yIU8J3 zY|R~zjUr-=Xfc+j5ho1HpSXHX;=g;pzBR7RL?=y>kKTUB_R}$>o1avFW*d2KR(kR^$n;!ktq?dnQ$NU38yNd3$niVz#d8v7VfyMrB&p z8GXqNFg+R5b}X%vYELxcDj!e}EUGCCP7{HvO`+)jsjq_QPa>lgZhAh{CZ|LP&!a2p z4f2u{Pot0tpg2u+bGEn5R?&)q#@s2S+#wG%&T4x0_L&u}Diw$PMGVG&I>`TC=<>r3 zilvN81vaD$v6a0^ScPZg$sA077^x`Y1R~A$64Ln0A>3O5qnjq$wSA=w6rc+bx0@!( z=j4`r6lm0L89vCid_n3j_QNyfEK`2S4tnKiCj1t_S2nnA33u#b8`(w`_H1Ky>JC%O z7LtzqvXgGL5_GG7MrWK%JKEO&+oj@?triL2Npa~JQ)lpS%z;4~?K zWT2$@n!v!< zyGF;ylnuj+r^+v1>DzB3C6Fzh62mRd4r};=fU`-n#6ebs!E1198-6P?E*X5V4GQAz zu+9Gj0=iUV1Lw?Ve|otS8mj{%k!fFx%OCt@u4Fbr=?QDX2WY@A3E-Pc%~tk7NP5qB zcU|cRP>LPO_}|9#{{)_9V&!1{&%MZR|Nj5!>Iff)w0bAP@e?V)J?!V(CHzrfz5Ve$ zeRivzTh6bfuqCq^K33d9nHNWDmR%!J*y>O?aS|Wivf55pB*Y*;lN4)q{gAF==U&|A z*l$!wkQGTnqOb9YEr`oS4XvHkznOnGqH@AZHqBZW8eMDFF^qR%?cNo?^y%7;zeI&a zy*Ux&^2+>gQ{23N+F(Vrl_98O$bFouGGoRMm~S+6go>3+xZ;|bkfo@5_HM2|!h z+M|xx{W$9Hpa z9|7HXyA0UsuZG6r{H9Ac6(!E!dNN@v!>oQbI5acl1?~Aw&D33@C8D3Jt}H8!TXVSP z-dy-_8~=vB=%@Dkzq@Iro1BENG_8=~X*FM=Z7nt|jF_=A-(%%7MO^!BG8tL=7X z7fY&vz(Qhw0s1b093*T26$T9I6OYb`i-Y97QP7Pp;&F3jYGKe?b{C9E5{(9gMV;5> zs!h{J)iQX>I{r+e;V=!tB5)Ib6R!5rJL^a-NG6I$+mqkZ2i{TI>411$?PN_S;yVj8 zL^wHc+6h9H!e6<|DQtjTE6_k;{?t^TRR&EX*Zb1Sie7g-pO~G&ExQ=`OA3qacmk#= zy2+S>Z9eaJQLwas{fe6mBm9iWDh)h7DmhlSpJM%3k!Z+Ck&#hNS?sUDh;{9p;f8Is zKU3k2-8}u*UHVDsR7fB9o);_ND;rUR0T6Z5biSKX<}+>AWS4!c%n<{RdL=Jc1~ASQ zSk}>2%Ix3b@UU{IltSt@ENOPFDPK!R`&ng4?LZfzq-0$vpfKU#U@DU7PUk+Rr%~o` zk#x4jxb~p#QbQAHW?$)BAQGBvj8xbir0Zi!8gS>~h}qC01oWv)Y~Yw}ra)?x4jOts z^kXf5?GI2h>KeKZ9*szOt?L`gybN91dWm{6>g#U3?JKEQKX@ZrZit6y`e4l~&XFHI zlFuGZ-t@f{W1qAx(5luHGGE#^K0)87gi}Iha?=m?{+E4JxtxgE(oHYOI~dt)+jBT# z0Sm!!d!a<-8>g?t?*{Z028?-SatVcY0jA*SAi6Xb|9tOMj-@2snnx>y`_(_};a4Yz zfmFK%B3RCd(=`PYla3e@O_DaayGQ04<|G=DBEAD)1GL}^ju1X_QiA7+wLQ{QhLEI< z*%4Ybd-HP2FF;%b0*U)!1##)xan6#LW(06MXEaqwo406Aofw?!`EptQ?TP+{1!*jc z*d@Z$)Sr%%0KTe&hD)3w$g)5l+5y*Zwe-|oBiU*3di5b7mq1+C z%OUN68=pTmrIY+MZ!hidP6my&?5gN@WDQsAsfB&DeoC~;I=#}_Z53DgfB=El@htH` z{LuX^FB+xtvc{OG+Z$?dxgI26VbNJt_o|uB>s?C#2uo@>)uhB5Y(QSG9PjUI)(0mQ z2(pin3uOUnH4bN0NkTWnO}~ITwQp+JP;$R}4K}F|4{<4qICI_9k6bm2MhF)`5Xa|Z z>Cd>UtRibJJO|*Lc^(2r@1h)=0T_OBKt8<+E6Y>YaRy2-p2{vtfj!M+~91<=g6QHhN!1OUKNEmv+le-;L2{>hntf6H ziUP9p-6?#sUE7*{v1SDp3e)jC>q;Ussk8XyE-P{x)hT3lz6F~sSTPH53+M7gK~c8j z94}Hv^23XlsO@t^Xz#2Jds4IKwIbYOcE|+ihXeSQ7VQn))FZ*TIU~x#?CP#%_V8N$ zlXo9lfP>N^>;pp#HCxBAjb3WOWZLi&y2__~+HYUQTN~>k150(d&$Vs3^9 z#Y5Ryt%E$&@7Y5FnFLLIwFobO7!<2^AVK!8-u;_MAG(zhp~q+|M`z@obO_If>ilhj zU(?=9+7V!SF>yX}|3!Ne`hNY^a2h?vzYfPo2_v79D&5`{>@Sap(4ooopPj_fdabLn zU-H3rF=DGj_r17+Br|uCXS(a9;XEuxtS#xTd4t3p#?NAbbyCzQxesY|N_Km=fbaEI z68sGlLt~NfRlA1h;$pAh&sLwo=n=h zr2JhiY?sIBXmjD2a5SSua!C9Vh$-+;_Ml>z(lEFWnOK3=VqWP`BYtYzyT?zF#p7-7 zJDlOCPrd*|XeAlf41(8bZZW97%GCizXdsEqbX1d$(g^zNsny3DVCgEH=V_0-U{4GR zIJL(hNFxBky~0B9!rt=PB4(Whx|$Uu3!9C7L7o0=K>$4!lSuYwwW!c^$9%ZY)L@{^ z%MN!N>UJRwu@@BoN)w#%AwsyvBqSZS2iQ!T(IZ*Fp1`(eZqZpW^-z?AQRA{HeawA? zG?y4PW^@tW^CvBzlM^ve4`>(n`6`2z`JsukyX(~po?A~*Cbl#wdO|ztHC-cAqTXvmjL~T9;X%(hbNG!3Bs;Bw6{LzJdt)|8B6W2B4(fjYHn`Xl4 z4APZX{2RQkjaAX0Lc55$d7}+Q>Z2MGf6&U;*^WBN8_IOQ>e`uK1*VSgiI@q}^Lf@Y zo^>wtU-Bi#|B6Td53$KFXdv!ahx`i~U~!B9TP+z1d)2@XbTI;kLjaG0*$w&wpK0q7 zSGP53A}cEhQBrxoUiji?n|CP52^ivdRrYI1Q9^sUa<=^ZWaqcnQ3XOi ztdDurK1x3tuYCuIil+Krb9VbjLl>83an6nP(YA%3bw*G8T(Li3-OB97o*4FVrWc|l>{sJpTeRffkh`J0x;v!L7;Y_q$}h+AsuBmyq=@srP%ciW zzkYoxuSyr|WX-jDD)P$xIPm79kfcem!~{LTaxkBuS18w#qCmhX)n1|>TpgWux5B!N z8cqZx$cqzUXs!ZkOhcojzUw%xTd&&-06?3e7Fa|U^tK|)SZrDn$&k0vv`+oY7f6Ij zP7x6c#$8Fjk33_-vmr_SFtZGG+F*Tv>z@16yCJjWo4?{;!lSd{-?dkL467ss4EG06 zm$Ga0<Vmj(9o1%Q}+ZvwQ8k%}&Em>n8E+k=tnhRqBgj(S0>sUJlGy0Mmo(4)h4M zN@f)LJ%}(J&re|9u`fT$E@iR%x?piq#Wul9D-{H&grlGSA zhIWM*Yzg%6ED%(rfH8WF<#|@)1ULqFwv9@E@><{Oc9zaEXSoMtRTumP`**KsLMRL} ze}H-Bx0W;J_c2n>&)UdOKmRE0#idwD80~_AS0e4hWoS;R`v@t*!g9hFl4$lr8!)6n z_Qs^5J8Uoj4_}#}#HcyG5pWOtvH7$mJhpU)ggf$KE`KV!-T3=$PbTu%dE_Dm(h`(ILwLj(F{4J=G#z^)c+>LkEI1Va3bH)g z{7^R)xSK*It+rmgnO8Uteue{%Pe0`kR%#Fy(CtqkqxO8&CodwbWbUP??t&mD+BZDQ zIm=EfSq?E=jt@Urcd;TzCp~1{{>83RzB^9Lwo!NYDucNkivv$E!f2S5Zm0Na_5&Bp zX!I=T{`;6Mcg3M-wG-Wu?<3*|?E}HK4P)3pqV=j&HH7)EMGD=;tHQ_n(OHppwNIeU z(@5eV=5yS;5y%Lecubg)t@0F1MLTvA$If?)!8B!~)4Hm#Ku~~2dFi;* zA)bBeYvFh&D^8`JW|ey^T1BKJCl7!-Yc_5xUmtdSms5FP)&jV;w~?_jT4TRGTt5(g z1#~KGOgQ^74UV?6CX5>dz10g~C6o9dlJlY)OeLFM0Q5eFaAUg(QZ-Z6Hi8NWRf`zB zQC@ygE3EYxCfeR`llq_k1FGt;PII(YD8~H&U68$Q2nUinS5$?d+#-55x*BH+8qWtE zOM^?1Vq-m$vgr|N?2Q9%6dHY3WV7!Mp|mb#9}%h1E3!+u;~^xN+Gi?AnIvey2}T%M zWy{SA2?=6&;$U(|-?tlz25vI-GjE``#Rqp*k@VX#`#}?M(Yl3Btd44^gIz(XUg;Ev zwAVunQm~I$iTZ2{*H%&rOzLm#KyMqqS|xamRN3y6Q1lDCVW6rr=I@2HML2%s&t>bB z)vJ(-y?@opt!T1E%Kv5OTgNhq=l2Pj-&TqhKotE-P#8t;4i4YTW&Z${KG~zczOW!l zVM;-I=l#+fxKfIM08kDzeWMtA)#q-H5dY4uFY!$&n!-r5EtN4fU=2~ihuGzY0m)7Z zuVh0f*G&(FKZ!wFV6ZcabCee8bNPA4jIIqF`kwZ;eS>q*7aP#l_yfaDXKrxTqT50j_d*ke`)GAY`o&Q+T-(~Idu zaMLMSkSSRactbQ)?8f(0Tj?sr*j|-d1KvvN`kFQ6ZCcVsNrF^k)|%D)kA_Vfp%q>= zyT@4ASSXnFO=^9HLpelbNT#USPpF$}9KuIfayt|&(PnJCz2E8^R2hu#YJebkqYSW` z7G^RYkZ#zoyW%QR3M-ZD9qw(%fgj1P)Fe*XVJ_5mn^=j{6t_EB!akg`kLh2!7s#Ow zF}!L?a#QzJ5}ik{2qzQ4moXpAXb=ET6N|=I8#x<;p!H7f9CXj#=12~$egmv=p&@*{C7)eYbVW?Lk(EZA>G^uoa8y2Ls+FLr) zS;B-Xiw~)S;jTszOH~kekg(E)M1%bYy9Q{4FkJo08#v}Au*Td)&-rHZ$jbQP7p~F9 z(jj{i2&(CmTf$lN8T`U}IO*xdaQfv%Iom@kjbBR->L^~m3uQfs7$Xf>quXYxVH!I-_88O>DiL&n&LajF7pY9|o zRbTUi4@0<0F9N3G1vP2~S5HEerUWp*YLTg<&JAISkO+ZThiATb;~$GJoE|=C;GEuH zFM`V7-s}7|(*fjG0#>412d{Bm%k+Bt(i$0yVWc6=xpPsTu&^8E8=r^r^@7!^|F~En zM``3JLoyP*Fo zLSe~IVhGIfWPd!6xQaKTy~NVDY!~1*M)vy3j)qT&HxokT_RimH_Dbq{0c6PZU2gdP z)Af4Z#)BgYWN6b2Y2M#c-f>%E`=AlX>vw{7KM=d!)d^=o;SZ_>nYo-r4mZb@^%q<0 zV}eDfST3i8G)sty>#vJ?#|t%F__aPwjh2YPo}tPs;dv(6E6nRMxd>eIsRkP!bXedD zBHIRKFLQleMgs!b2(Kgjv=OKtd(h6$HD`Cvj`!z+AHX@h8vlRGuKyDwospB}KiH&A z8k%t%Vo1LKw{$N}(R*13uLl-5v>x6d8P6JsNdS52u`9t_7)q%mt)zCmW2dU#w76&w z1TOLGHWhc#{aTvS`LZKb$NWsHRO-`jUcXegvsKscQKrs_;Ho@2e>NnoOj#^oTRM0B zAoS?4f=j|(E??$StX(N*BzqgO!M|duxv}-rz$69Do#gS*dmmC+X=13$%+ykuf9--l zhFd)}z5fFKy8bvYw{Z8%F6l0;AN)(@Kr9O%ge%@rEV*!JP*-i^-Xdf-z@@4>ABPOZoCJ_JqH7FCBNdgw&FK-fow@{bPAviFtmk8kaq&;{_x&BrhZPA~xa$ zmO_t2d_RlSWQ2uh?pc`MJ*nHb^gtU9P0DWnkrMW~^hK6~AxKmYn%1h@Ot59rs(ey3 zfwKMZ6YeN=Og?pysK+Y^Y8G`R*L=RwIIfV&5Zc1=NWWLi+3fxx=mO88yYHz?p`a`g+loH{m(^%TEYMIKF25bO2wz`qxJn`!h)R#87>>>Ls zft-=QnKq``)lw&_J}-tH79Bl4bOLeT@EOL<+iD)AV07toJ(Am*dx-4Y(Ym67YlMuB z`d#pHf0>ibp+2r?PHLcY+H#M^Ox$6V*k~;}9LnII!xW0f3}^hKV`%cpig>xuQZVzq zH=@_Jd4eRWZ3Vu!7y!QCWRYGwr7ondn#>JzzSL%L_jID{!kj-dbU1GiR$7bj!>f6a zkg(t5c%PUbr+5~^-SRzA2`g64193E}6C@3g=YkZJ?hGLh@ZcC?naunXGHm9-;!W0= zO=h!CL9wyhGc|4YC<#UgguN?CY%IHu0lS9Y>9oNqWEF<<@Zs21yAlAZpZCHuF~0d} zSgqj53WM};Ux7MGQr5DK{dWYgKQ$B#J>Eih0l@^Oz#WGN?vQ@rHCHwY^C3n*1eHLo zlnJLQyZ&Nire><9cRPgO>IV#c)1Ak8g!oQW{XGPHg5DK_EX*-O~6T=UT- zE4~FH|DW6wzyjO9+_rN65Vl_JaFJ;bBylv_&7;?hIl<%Qka(W1y9HmgeDMCi4 z7;0Y88SP!i*1ogJUufaYF^HVo%LuJzqo2yDq!D(a^?l8z-o(DbRG4m>)8Xc@3t|4N z%Z|aEXEj4b=8zkEAJksT9~KH?IC!vx7FfaFL0w9v{T9iuQNFY(mB5;tju4`}n86ZF zKg|^~Po7Jk1T$YYzkdyht8*S7i~>jlDxCV`<1vvUoiY(sF(VzynO>D5AD^Gjl~@2# z$w6w`gIfcN3d6~EQDb0hZ}mQuFd-X;p7%240|2*QKsGkV{bBJb%z;ybQBbg>a@?xY z>`2TaKhj{yFh@9x{px$;@~Xfmeq7bO;-_hl?j@Wk@LM3EL#5HbhN=c*syZcH$;I>< zgs!N&fMx6h^XE-h6)30&C8UJMeaD)QS1CaFUaMbjaeLKV-mDDtrp>l-0E8Zz!sFY3 zk^soVDcIJJxeE|vV^1itLMx)GU5XD;u>#68{UIw#uYA(+^dRf1Hdl5RDaw<55jA68 zt6s=9e3f3e1!b_zJG9H(`7#u41o28oZ7kF2f`7A63B@*%m?d;g8IFL(=eDS&5Wa%$ zn;zN0_`2#AWG7_6$^?77H*S27%mTpMOhqmdLRp5+zS`3f;qg&2nqH~S#I|pm@ag;r z+a2*im}gURBFpY;x%Us!rdY#KKT{YooprFbd`ve`#I%x^v*C7g0vj*hEr!pbfFs26igZcY zq)5Q5VWzph`}Tes*EL1xk$OZ~(_5f8#0y#5Q6(F!=C64=YHPB0dw~~k%P)p zLuEIgcYOrjHx?~N;4SK$hv zOCw6o&UTIO_s9?6BS59_e;e-q8+e?R@&7m6x9kpD5&drT4L2vo1geom&nt&`i@G|D zv@cQJunq7t`54f0%IZngliA1ocHRnT)}+`eYE}(oVZ(lVkDq3vOFinADZTtnR7$VX zY8wOR@-3A&zEbK`5tT(sl^a`9Db&RWDIZ>nE*=qFSh%$N*+K2sHP20b$LPE)60lhPdY z%rQvpV*@$(aaXb$!#A7Tq>~+dyBH&4L&d{_SSoVtJk^;~;6)yFSM=@q*lo6|1s9q9 z*lB-q*UfHuE?qm#qO9YZTQ>Th`1I`VWkm5^CrN-=h#1jHqK1-aBRh>8t~mDXE! z;Cic+;zK+2Z~1jXB#qc{;E?WpH@FwItOgeDj6VN}X4kS&jsS!E*~LZG z>z6px2;ZXjSls??$sXw*-eY;5`Y`s>JwK&w^QfYJzz*(VLy#qmZ&I}OAz5z*8zfxs zwg9Fd=KNMFL+J6s1R5J3eZHolp(RFayP-gdZ#sDM%5;^f!uH!#Ht4BI&|;QfoueB} z58EXojfze_L=0vA{uj#ufZOxLlR7w6_-AyGrnX?C_sKNJG-2!S>4FHj3D;XdPhbhO zoHR3X<(!qxO8e06!~qd>0)YKL0th%ZAuWjnQAM)phnFZ%F-2W{`pEe_RR|*%i3Ab$ z!PYs==@g(TAGrG%xrNi-a24)vkRbX~fID@Q_X{({d^Q{$0x;=hjlhHkYp749zOhbn zC&$meQM|ZIl8q=7>Yi)Rc(WfW=%C;Tn&Dbm&?dzT&PWI6!$2{=;5evecR*)hPltf( zN$T~1vTKNj1Vm=JGTn(H=slUkLqMaAvGK}50`ZK~0iw&qNti@9Fyznlfs^y`o72q=Y#q*CGqLVZCtQx1i$1F9wM1V%hm4d9yH zimgi;9A?{#&K6#-8Wa<%g>W|)@e(bi8klg9Wa>D8E9u|8ZI|$XswBgvDPE~+cILhh zqz1@sPKi(ig(&|4BSvlo)YB^xvZFallLtH%Nv&wMrc)r|wht}N1#LUsw2_E;PI*>JJk(;cig98|sl zenJZM=kb~QRMq3FCTEkXuu;8}GRRzqAc^I`KK8&SIRQex$}6z%LGb`&-1o6RyuO$q zx>Ac(sqfW-a?I4&WaI4hKa&NDr$enlYX zhJl4p!||xDbuY`mcX008jw`Lruf4^IVBDpCvb5k!GbLz7ti(@Bl}?m)Bx-0Zy@-g` zhSILvZ6_CR&r?Q0wDG>?4Yzrt20z2u4xaColx6c z893U{xqTO4Nm?Usn-KoPw6ShH<>r3O8MwcY-(2#F$Zcz&>DJT3xaY(;S#45#&?Y zCX;;`ZFXX9uRt?=?kJQ}jo*F05xVfzB~#~Nsz(4h=rQ=c*?W(8Oy0#1?u!|*i$w(YC5+SwA!tKP+-V%Hl1S(f)M4#)! zA+B^QKP+$neRLeJvr~Y_@^INUj516BYib7zq zw!8t~9?V+toyA!_EX~Myxd)F+#X1wz1f)CLuyVcJA~4myMO@R>JynobMSiBBmlN|#=7b?PXTHBd zlKNIHi*yqT!!-hUgGrtcyB>V$fJh$g6C z6l$|t^gHg}@`-C7q|_&NrXQ3adco2HoA&5W#u)We@x%lb-NQXDpSo&x`E7DEq@L-j zaD4`hPJpw=7hl`qGSa5X_l@4tyqf|P{@e1j;LpL;dD_kwc(S6W!heZ{oc|jborU>7 zK#NV9+IE-Czdga))t0I`nt=~e`K~-bIc*e*^8!G}cLJ}b=FFx;sf*Xw9k){3be+Z z&1=8a@9%m~zNN1zIm)J#o$brU}MLPL}m3- z#6T!Lx~Hey5;&h1k#!5KfLbgJ3No3`?Q+|j9RXJN zaGOo4Xf6nE`GKCFqlFh1&+Cq`ZcnV!vqy~_^GBvd&BY?gx z$BzVjeJC>)J~u3hz>kADqz^I1K*T(9!->R!$vc8Adt~XTw!Lk;7sV61_*{h(eI;Y9 zUs&8HGJy4hbxvPov#R46B?+`n46)kwRs1-8SZ6U#jpREMB+7gIktee6pjV~^`!Vr( zgGy=;OAVApUp}qUVQl-@9%SMHG;cm>FwgIt9)=h!)P#!3^l_+-w0-bc+HBS{nqzaN zGrr$fXR#v&7y6g(P>WGRUuY*zORM#X`%Lmy@2n~twMx9hz1%C_@qZ?4a&6>nep1e1 zR^2c{4&)A6=Eaop`r#@{S+=SiTbu(dk^tSubjmXjj=LiNDJ$d!XNA0~@K&Xg4+PJI zoBnN^<+Zjts>HHvwm-3*4_v5mh~J5WhyH7UXC!1!Sc1+#c#oxu#j9qq)&VioZkr_b zbnEXO1}#FSUxWv& z!l3wfBk?#saI1RPNbW3No!&=(#K@7WdroJYtbQWIMo6@&&(A!o(qmuPc_j>)wEr7e zQ|VFbotNPZQpU{FkSJrZ_e_M=Q;znRQEV|H(=V7HshFnYEq9mpNela+<4seE(~_*p zP3tjEaGE^<(=R?rpdx`8Of*UGIRw*Rj=3Ug4KhxkGLCsj5v0(wikAmhAw}_#ALX?; zd2zd!yzbGLtCu}G%ln*vh5K)zOwDYxcUr+t|?0V3(6{tsVUGrz^JV#jDM zPz*>dVRjRae$DLnBUV*F(mcn<)oggMZu~VC^JqpZXw9)Tb6k}$%PGIcYN!gvI79G= zoki6wZx>kL?z*Pd&yva+0&@O27WcV5iKNf|S#CiQz9~rvKz*t+J?aY@Mdb5U_u+QF z3nrt`*@F77>2mD~6FYy}#gup?Gig679=I=Ty}z8;kE=Whsf)x0E6-nE zMKDQ`YUv*GKHN8#YHXEEOO;;V1tpN#F|b%^1|;Y+4Ow8!mwnl4FAz8WQ1X4o|pO z^D=oB0`z_Ya=`J~w*Yx3m3Dg;V~1c(D6uvqEZi;XWZClryCbh741{K{X_gfHZ)~5;_wb16zaD zFlD5?vygYtIwVjbRvUAj%i<-*lK(Xrq;Y_uhm||oV>XOC^wYp8jp0XdkGDI*En~YN!}Cj|crL8(yK`UF3c}Z!)1Dz9^dH zHsT7RjUm~%<_6k4CC-P67jh2qfiLO=p!6YlCk|rKC*LLb15jE6ChFruu<%NOwWRDV z;0395jeZyL{>F~o)0$E&TzY%3yf7wsNE`*B+z0pC63a%0fV;a-Q=URSxQtF><32B-YDIMUOOQ+@hNi4||b#vz6!46!(4BjWk z!l032TWvQ0|62`E?WPpW8P;ZSaA?b_n-XE$){)Ga-;aV($UJv)R>AHlaW5stE2b_^rI}w`%?~{ zRMu8524_PDBlkt2>tjbf-`sJr0S9c=VEKE zOI{=$zm{02#1t9^(PAwuA+<}s5$0cF>cK_YIyuKf1a%VSC@HlU|4novD@)QWKmjOw zY4;dI;UVUEqk@yAm|%%nH4|$gi&De%5db(Praco8t_bE?*>Z7tm7HMzTq3W)1&>4& zv#horN?)G&?C{h8#Xphqv=1isdgk2rRLcdZgdAP7KkWY+s8`pDySLuvHz@2Y{kF8{ zGmsNPn4Z*9a@_dm;}LpS zcyYBx%3~ZPK&$~@pC6$5TZ6O`#i-e0x zrq6r%-Ozlu<%jR9c}5grozQ2N{n^yEVP3rgud2_j^>Y@4_ps{z9z$8c!`N6^BUf`V z(VT{xR9m8HqOOQTF7j^sayI|;nee@Km&bLriH?)$LJ!nvd!t2YWipn;KOAAfn{<^k zzC2^9ZR^#O&pGv4=sj1!MzTpZR?xqm7s-8PONI2a(^xivuNr{K1D8bp68I43wo|?d z?OSHyR{LRDQ81s%U*>$QI!JgPWL2=wkOF(yrzioTwVseFReE8@zp)FNjB5buelu~d zk^{%A*qqkv(kYiYm{%T~m~1E(DCU;6czoezP(>rUo$7HRLwr+n{vNxcfZ&}vcuU=# z&Kg56{`mvhZLxBg&G>Y!-1fvYn;JpRoqO?jLhn?2BxwDq_1jhOR@bG>Q^ODi0*fwB zcEcuX`7RQYnv|cbPM-F)RVeA6h(L^+jEl7kJkuZ|*~r`V8vO1N7*P2TXr}-I5Lh@8 zPU8U(xg;{cy9Og3US`4vpY0tM$&kT_HXynYX8~j|MpuwXKfm@?0F=-8aV`=(8&KJI zlX;H4%p->7+C-RnV-yP^s{DQw#JO!)eiXLrgNdXJ`J*{APrwT${Rxpj8}OCEXe)NB zhmq>v+2TQ2rXmy@L28W9H3AC@5%Gb4>rt-uMAECQcP`*yAKGZ-kg?h|^-M~xmj~ZU z$_6BKe&ts8&f`=`HQWrb7{nl&PCTjS*B;#n zuQ!TB7GqHq(Yyjb=3;kd;Z@7X=F<<;qgfb0=9Lu*{-J~OtkpBikj-w4>44P$7J>oQMQdKI)CB2pTZvsp zk@l5sX z3kHQHSZepAnBb98WCDc@YvP<()Ty&$i&@}b??v#@Q}e3@^rCD)l|UtDX4Sy6q5jIiCiiUo@PiFCVM}5Jwv5`fsq>XGfI10Vn*<6HWKzMlA6c~fy6uaO9xa_% zj_i&lR-+#O{kht(dRvK=C9hE7D;VnZ){+`fY$Fxn2;Va)Q1+m$I=B$wbc zU|`OY{N1Rq$ajpQSY~Zgc93}4oXHPPz$1UU$0$O!i%9!2aFwk+gW z{(H15p_PKQp0OPiF6i1brWRS`IY+`YtoT4Zd2BvwpcA5cE=Ph$j4mxISazo45N#ll zPLafk4=#Nu!N5&aP)3OhvHIR%F?RRIB^nA8=+3q!$F!RU_xp+d#KHcTXr_o3)gh6QA`UF9MCMmG&sdWHgeMpLNxFGzdp3s>)nBM# zRCPL35c&BDYExoXX$E*VPIgcPU`~QIQ-M3HpG__-w2Oyg-lUz(SSEWtdrSXPl@Frl zCA?lG63egrz-2)HtcuN+Cjr@N*rKB5@-Oj2hOnfds`J!SDdI_(KSu@OVv+c!x(npq~uE;a&P zIv#wQDx}w|VyG#<>c1en| zN{&`swUWWVyG`({ywIpdD4n7^9gYApk-)<`t4QukjE!bC+E<%a==eyp_e=@EcH^zK zOK^aHyj6o-&2|@$@8O#6R*i6CpCXm&TXrwDv6ErEWmnr-^g z-;iZhk@kadJ47X!>pKqVqrLMGcYd%|%&X=A+WURWIh+j5-s-{}FK~5hJj8uC*>T~F z3#^~PsR?H@Ca_4$!p^A`LsrsYhBUM3C!;rm_Era|c^IIk#8C;MR7y%@;$tIaD5M4H$%0ril zVB^d)QpnE(T>Gi ze@^N++;Rf>==_RBUUe+*sEkK2H%DpX_CD|%ma}^9b|o!|@sX-Od7x%=weKmxw+T?g zh?tG|*--$vhQdur>a&dt;ng+Pc)}gb9)b1AdJf+3i~b=Dif}B3Ts9HNK>?pJdXR>z z+7hJ%B(urw(v%ZMtHRX-0)>@p8&=)(%xgd=AnXr^-Px>QhJVZw=d}r>fwx}^^0pT4 z)&E6K-;c&=+GRixEXmlB@=L_V=E?i$P{G;a*dQTr#QTVL+-Yxj{19y%LM&tFWP>;e z{p-BYx8*f?8Yn4-4kLBeh2xA}TAgKUx-#r~W(|5yNm1yEgN#((fREkL(@T=gM6rWW zt|Xv>D`$_lem8NX(otg^s7*HJk{tH1_SG`uHG4-|o|7epKA(1BG@mwLbs{pDCt+TR zB0$V`-d>9|`2Ae^1L%f(UpoS+g+OcAI8q9 zOR%s_vT574ZQHhO+qN?+ZQHhO+qP{~PW4>Onx5&4?@yc+?{gydR?6DhY^h9C$p#ib zjA<{Gpp`Ve_RsSR1R|a6C^oBvV8Ie7dU%1>`sr1w0{Od4wRE3X?KZa3b#wUz?^Tl6 zE&9ZZE7sx5D5~T$2h&#q$mgUE_~o~G%~N^e zhb_Z4?-NdZn2DU(Vj)g_mTY4AKME|sRIayt_b?C+6s$Y7dgG4_&Rtv8o_fQKZG#sm zNM-wY;|iIxV`9e&A_d*59T7`aT$MgXry1N1i(E1xUlB&Xf9>ekxdT~iJzX>ql~heM zUS8Tg1i&m(Tv6GV!<13UcTl*KMIUw#8-!;BL{_;q$t`|Bbz}LJXS?62X3KQ##wwfE z6^Co6PCrs9BK{~7K)=ycYTwEOORcMvx)lJeF}#M)enWy|R8u;Gi)_ysS?vZ3&!?92 z)Vv`E^}OIz1bWS`DI*cKEFXH(9fZbFVVJHB^8(KOAN~~a(X0i=UCV$D_$!(}LaAHU zD;4gN76YC6#!f{en#)2aM{UD#f5_vW*6q`?)uME0uWgKt z7fzcS8)m0NUFI&EfvQ+AnLB-$y5O&HRJIQ_$Ks6rcmGJcr=SrGjew*%6fd#3Y3U1F zK1M(rIB|L)Xu7ny?GIzM^DZ)$6G6kChg+UYG3gG6PThvV)zlbBWm$+vDVZ z904Sr_AelTTSR2@IYlpxnVml;h-d#5^8t)THwqmJbW0r)j5-kDhSS{a@Z_kcGLIST z2Q6Z7hXThmTuwkY+zZ5I!b%@94-W%C%0d?~y5l2|O&sf(?FE!jK6W@mi%lbMkVTB& z$2h7Urz`djXpW4<%|K)@lRO3Vd@HT_W2@wY9IS?1XohfIRa%Qy6k1S9vrhb1NR3-q z6RT`w`B-ON~&>wk-d-))?Ea@`T%& z@|gN*9pqax8(^NDN_0WPx*TxU6qcllIZHSZO<`zVp<&?7bjTT?D|i|&ES8|JN?Pq7 z;MqCoz-w5Dl(JY%bdvcg;P5I}^2>{Zb!o>iQ#O^A1|@DE9MGqB_rtXWjgq8gFf0!i zckB%(7Vk1mm^Egb^Tl;782v$8n+KD9Qjg4`qfs*OOc4z^C1=vF+WoBb8l5Buf6^4) z{UEAho|!Js69z+zVlH6v7Pwvd7F-({bJ!0;27yCjjzNeI=?nO+&Zw_ie>R174$1~j z2P*1hy&lCykdlI)fGom75c0fm)i?q?C@Nm{+f8f!$sd#5Ni%DMcjppI?iV+7mI$IO zbPq?1FFy!t)392qTOrN5cb*5(f27FgOS2)F5U}NVPUd6&O?_s?DK#2lW+<^793P8p zuBk3}%9+{gW|0v4L37Ozm^Dh?QbvcS-d4eYoH=^$GsvyHKlXK-FUOnD+FiM|F~vAq z+9&{Mk1)-G=UJuAyB`?6f$H-NYk4!LWLgyB0-Juo`Xh2$knTuLmoybO><$z=9bVJ4 zhO50YWzD&hV;?LbWoin-+?1AWC)T-=QLD!Q11=055^`h3`K_I*xs{-5O z*f5&gCY>WT1IUklg0yBJOEMHv&VZ6aAra6j(B~;s2G#x}!_wKeASv)=(pbC&3g&}c z*=Lk9zZrg-$teg9$8^c1eVqCQcOMp3rQ0PA^rN(bKYE(u0Fx=*S$`*K*^F!+(B&VI zuOb#TWx9G2XR;XHMB=?W&C&tUSd*P1OS(T)ohgYiuK*g;&6lPdQlk6%ofE%l5pWG*DLpSA#q@FVMs#Qi}s0z|>1?<|~wiZMYf z7lQISvR)OQMDvtIo}D21F}iP5t>Gpdplgbd=bAu;eqf0y}c?2W(o*YNB8Nxlt@ zppAI#HpwNl&xu5%L_e3RT}!ME;L9 zZ_g1!j=q2VBNcx+LPo-*W#lMJ`)|zdIu&9xxc7#Z5uyFGF>ikyPh~a^@Hdc`@EfS4 zC5WKCIJ`FKUibjH?`>f*3L;GI2Q{)LhyhlovFPgPbM(jja^fF`gUd9DZ0-JON3HA2 z1xOuizNIJ@7=bx|@5ElO(?rrVs1qj)n~z&L)4kDA$J4h$**|b@6cYzs&W0vrQyf0p6Tu2GC@dmWnLH7 z**PI|B1M)FeL!F2>bmN!HYAu)>)E~8;Q3Sju7gS2mq}q;(2U2Cpb2}Y=PZ5AQo;*c zQw6`C^Qpi}%B-h339g=x6S>@xp^*SYMnda;z;#Gwg!>^yQ2Yo9Re^^}A}aF1)!;;l zl4^qRvT%@67KHi*qXf4SFi-h>`v|{~Z6T%6*8ImU87K>r_et#D$1wR_mW=KSDjE@K9<2X8bf;+Q{}<-i|E`ST(}}6R3RyC;crl#F zU1I*3Fr19eNx%s{YDTx}U#m5-X`-zUb2dJ)<lv2t!hawApII(2K=@Re!S`EB@klS(04DG7{AcyHC+qbf<1 z<;BU)>w|^1dtz!KdYfv!dC*|(!q(8q1QBDX7iGHE-C1z(zU5l0E|CKxIi3J?OC{S- z6W(FtrR7p<-{+=%zdpmAx!&IIG~VIZ{dh7t=%~y38jrUatNaowF6DZ}Lv^meqL*mx z1icVF04>kT`4TH!h2_P+-08u#n0|bz_*FUv(1OdmT9!KL+w&L=g}shqx{zN<4R^N{ z2j)?ehrY^{==xM9OMcqNfQOUWb-hU_4fkc8X2Y!f`a6QP5C2HiG|q<8FE>vUBfdn| zeYy=CtCyje90Ae*m~j#9w!UO73J<1sQhnkG7V9d^oHqx9jdSM>@Z^v`F}uTg%24mf z8`kd+t>p`J53Uo9oh%xHYGbcY_;ZyR8anY;q|pBAQo#E2vsWhs41*bxlswin$_O3Hy#!7}$ROT2u0x$tF7!g-MAb!C1O;z0%oStmj7T)&mGZ4MC2|kv#9q8%) z6sCFH<*m;dzeDw`fLEw`Q!RYRT@4!7wK8QKAU44K!)bsX{{t0L({yXCdh`O3Dh|Fg zR)HcJtRT~S4LL9!<)}9Ji|u|RDP zFXf$5S1Luz+wez>TsC@)k&F`=hlk_H~Hhvv$;VWJcw?vp_DKmadMHArJ%n)M!;8L z^}kFzOFA5>9QRD4*1`{1 z7Wsy6z*za0L&ped@OD>*-g=1E5l1K-Dr|$1^e}Ox9w-*6JRoIY5K5|T#E*B+=fLXC zGdi+zf=f*|OkyGk%W3Uq6KkD?fUBGr#=PBv#_F4SmXxe%6$^xc?e>au@(P+ra4|Z z8VadE0xEW9j5I2)G^tpw5}1NQfBY5geNp`PS3MsAkDc^;ZrnvW#yfczDrXk}W_{u^ zQ(6gHp(P@eN-D?m1PdjgF;$M^Zra{9^JgTnB}jeZJ9$-J5+YC#u{aKUUti08+7q_f z6uReVKzuk^+aevom6t8;Ajjj76aYh#(so0@-FZC8fuK;^Fhy<)sxTRHBWGD2kn_Q7 z%#>>mD{rlPUUmVajgE+K+7}p}jNe^F zCYupHJ+W7dAj`HrB^1gR(j2JlO*X&Uo5{{MWC{k?I?Kw`=`+wz{qPS;@HIgo+dii+ zV8>8RQg}0HX}EIWURtr(Z9NY!(czO=f|4NQcW8{TjQ)m9$Ue89TFMaCS6zc22BD=n z8cx$(G9|d*p8v_agqG9aHaf%<=E~$|qN^egFL?^C0YyC}n<4RnmEe0FkZzC@0w&Kx zt%ykBkNh|6(qOFW zRH_PM?=eVsI_(CrPAE|WxBm3z(CROOP{&?h7o_~g!X9uAXY;q=b{Eb$XO(Ut15LtM zfuj3_X6Gw#4V|tulU?*(6TbiLN*?8dDnH`8E|m z#hi-{qoFJLqi^gBf}q1+L#u=gjExGr+e)Gi%T}yjRY*Gt`5M(&oL4(x<>M@#K@q;K zjTR^LV)PkuNXjuAJy#uYbw+2CIcDPxYFc2s9ZyXW@Ns}OtyQWeR{&Pl0mkYw<9OFa z4oH{p#CV9HwY?kcfsk>(&QI+`jcRZP~`Kc?qN z;e`W7c$=z!SSSVG4#zm=h4ZX#`NuxId~Q$sZ9F{vWtI5IeWdEPcw8F$(ZlQd=Pr+MffV z4v;<$*V;3DNS_Zxscjx_7hNzC|Eq#YM_Jy7ARjO4OlUP-J~5bby?lxc-CG&A_;^@L za4cte#o3$bq{7h$(>2v)t9|O_4B&(ciebblrSK~|otJ*wl+sqJZQw8XiZRNY^`rjv zuT+{T3I(>LV-!1*+jdHxH~BCWs(n2rfsJbEi8kQ-*MX;>in8;^#x8#2rPwzhevhN3 zWN?uCm>k+htxmz@3WkDy18fjOs3E^d1Qax0Ov^vs`EN6?{Z*s#06o6ZZN`2jzX>9b za|{xM&4Kez$q(ok5(kt?*;LQ^nEoe%SQvyK@X2&$1r3wsa4+koMvFr4>7@WUnPrEX z52i3Qnrt0pL72Z=fABxxkaJDMd)w{%9P%Q=9$a+|i1pgea$hYuq1+$X*-6;Cw{}B` z3menu^wx7JD&?P6biFwgyk}-gWo`$uyDkw{^>moCg|fS7P4MiD(5|@Z z>kyv)b~L*Jj=|xIuk0*^@lYhP!1l(^U8XnE(6{=wX#Skp`vZv!*IE7lL6V8#Kk{WT zGyQkrc#D>F($W9s_E3;pSJGhIjge)k)EIZMg_FpYQia>V;Y4N{(j*us9yR>>b}j&b zT9spRYFFfF1$eMw{k(S;ti(|_9Nx=U|1+8O{_9WR|C>JhQmY3w^#^P0+^P@Og%}Bb zt=!z|U)AAPjy2rcvq@F7__#MMXx060T;EJqe8!_*adF_o<9=$)+zDz#Pq1W1JDi+Jdd8f4#gbD3^>xDnMV^@n1n**}C(n z-P}sQC))jd&)eAN`{XN{Lx;Y^qdi_-c3W5b<5gU6=DtM-ZsG^tOFWM{j*4p72IvnW zlt^G`9|kVUIAyIruZ=ZaY?dTZk0qyBV&DK{*b5a~8p_UOJY>A6`Wp{_`dKO(rk{8& z1g37UIMj@lh7M6pT`X%<_}8`)tKQkME!JIyLt(xvFTJoJbMj>+a?IMXiDkan+U>fB z3x_M`Wu=a9LR_Rf8;v%wcoQI2eP&X{IX>B8WOfN#ZHhxB%drQ`x-buQk={D2k22F* zWQiZo>Krf29D^t`{cB7kyhIe!Fzzri?kFtXUgm*5j?{FC)9|)Tlz0O?1a@ZP{#tKB z#@)FdRIH0Aim^MUx37r5=d+^76gh2;c{~S-(DKR0rkEGVrj(Ew2<~0yo3wwa>rAhRH!c zeQ3?3HwOZ<_IE4cWET7w>97zmF<^h22%yQIWvmdwauVg`hLumzT`~CufF-Sd6;BdY zHIl!64gV#)DKPi80ChQ*_3N|f$w;z0d>F){;|iu$_kdq3&erbp?`uzmnwB;HJA@id zn*(`Wl(<%#a2`1dq4B!)X7LWA@4rp2i)~TtElmOY#FmAZOs4bt^ACsu$~Bmi1qrEx zo(VLeDAf>=R4joM^N6nfrm}b=^oCLM0K2JbflyG-pz3>o5l}%u_E5UHMW_d+14|c7y8! z0vt|i_h`OW)*sVj<4qvUNYfQ1P4%CGe|I79`bD{F5}So$M-#hxAp(*96JC{@Lf!aO z$+NxI0Z7(IJB?GVoX7C77#-7bq*wo%3}O}ti7ZO`9jdSZduz_m#BX& zOaD;WB40C;koWA6Faia zMy%_RtDtxjA@wlsYi9|g1{&g|bp+u@Afdxo_s5hoy30y9Dm7|klnE)MP z9hs;3dHSD-cA8++1PaGrLphZv?cug;oTyv$72q+Z%UGA96dDtunV}HE>8I}ifXfTFwa2$Y~%O%2@!>V?XHEgpq#mWY^+q08=K z+!(^j@Br2><_P5@3mhdxZAlO?u0c89zyj%x*Nf*4+QGI@Up0&kTtWo}Y)pH{H`yiF zA5avncN=tN$lm~5$tN^!sxk6^JSI#+xX0iX!KUoALe>Ze99r73{PB1@p_%7Y&}j?? z_rP=4CV*vDJ&B58oirq#r>qnZA^qWC8$(SC-HuINKlK z9M%N>BOyFQL&d@=Dd@@ty{vvXBK9O?nO`QgbaiwjfvAha9K#!N910*&uOK2&SF8{+HNLNLGNKw$ z*5={0jL}IHQ5gbj4q=f=B#8_Fx)7Pn_drBW)4KKPSdDDaNnM(o$i|#RS51XvhPX$I zSyGLw>|_cVJb@7tITv8q^?7^oH|Vy)ffb-@NVe-8pTiWn&VA$hi&8^c0MaJ~!ORVK zsu#2}0MPFw439e$ zSVvPF?aNv}MvUQ6BdTIC88nA8S(0=-X>8(fmE7D~4ox{#heCazNlaO4&;^o@fK* zFCzV!QmLqnW@7SQ2{il~-`32fTk+i7^gc{VrKny}j_IsxchwFk;eoBz(B@-*C z7+ry`4{fIKzo#jW$kMqv5>y^Ag^piu0wB;FxPUhI<&+xY6{AsdlGbFBR&S9xL9vt8 zi%n9ktZCk4WGHjTpV8nhAUp?mAl-L|8mH^r@nSgWaUUVZ{#^PwfSK)Ep}CBmKenJTLZJRwi^ox& zf)bgwy0Y}F!d~wi*X7^8#qn-01$gKQyzP(|KUr?n~In1oO|UUin%T*ub;QGzF(EHJWzcb`rcOQH^xFr4Uf-SV8$#$)a~k)+U^v zagNfcJ%Cb|dtTT;q&1(|wEwxPF`cpi$eeD6=Kj!5TBIKm$K^(Alyyr$9XY#PjzFhU z#_1JZjym{+;|vjI#K;vAHLMr>O=972F2U-8mv&0M-93 z0LLmPb?@p!sXE+>?G{3TWge7`tO{FM$UPS4Shq;+A0wMTbi}lWKCSIIb(*rcHAHv9 zRw&5YD(Oz>*zZR~XQn-qH%xN}=~2z7#|2!$!k^72lO>c*R~bPAkq%IM%yJU`K(*mg zNr2X{)xwg=)jc&o)#yt0MlbMK@!y%30U?J0oNC2QX`+^tK)*&`va=JQSlMsn+K=vP zI|P!>3Aa{Uqo52KUAhq^J4B;@h$9nOQ{u-Y!b#t5%SAZ35CwL;Y@g;B>26xnC`#-! z5v(@e?o{fLgJBdH7<)g@V2F~2GX0D_o3q+D`52z4zXnXfL*K8eKL9Sdpyb8 zt3Fr#u}8eMNbUcrEAV*C+C0|s^9^2@YO5tn)lH{9dS)s6-C%`!5T8?R}#IRhCoy zPw%1sNN2;u#QFdD1100O#!>(E$ssyIfU2=pr4~6sB$$9*;J^|uw6lR}Rogg-6R_y) zzV_y{D=8XvFJFflYy?^wE?2aB-+C@*?6Es04)V59p#Gj^{dhjTea*o0SNxe4O;LAp z{;f|q5wlXvaB}v4w?CbJ^?&=_JePt}N4;l+>%D5_u5oqSiy@bPnr9^n2jy0dRKn6) z<+X7qYuoU6UU%5|(#ce|aOd@XACkB8Y;O{pG9rG|SwxfdzRy$9=s;5DJ}BO~u9XJo zyEzUIjKhd?<;EB5``cE*7dk=b+M6tgBKjf&kbxoqsfh*+xNCoQ6=r<&@Ye^kt#X|2 zDai0T>ouWFz-lqCv4f(@sR?*zsKudgH%@u)Ggtz$vnkY}z7s|D#Nxx$+EguW%>88} zoc{R{nmSaCN#mY&hq{GPXR5>E{G@W_#C;M{w|4jkJ`%c8J;gA|_y~yKbQN}H-Gvrz z!)EWL2j8J^yz^C{vi|`ajq(BHCsUvjX;$s2(p-th<%hGS!7bS(T1bSRwmnjcy zul{EJrB1klAYttCM+EqX$HE8;5lmD>qZ0-y0$Qz31>zrm1_Rvh`nxRnf&Y z&QG^H{C9sJj^@@GHD}nb?kj2fs{$>4>jZFo_`_VyN>BxsiT-K5zLF37DOI0~!@1$$ zIw$<3C$Ea!Eg9-HEl*-+aTE2fLl#B`&BL(8no>H&a5`ne^VPum(>&Qe<%!``H|Uob z9yJ^=>ZNpsFABVFE!vfNOF>jR5IYs>41pvx1gQ>HF$i3w@ExJJ_hqZ|bp#bQNpooh zv{mT>S_9^qCvU}YXeiX~+iooKr-3SAg`WgP4V<`L*INEV?6&;A#TH*BgIznzpw%~OsLq6C;hTKO3zha$M?+;pr*>B3KZi0Ew zk<6Crq>)G?L?b<^W(`Xs5q%YL5fp}@GstnN67D5`&yt1C>3rkq$qVqf&nTPgo?y@g z621`k_sCkb`U|@+S4lv)+j=jEB%Y%nz>$`glab685b*76g#cOq;&Kf(C+q)MEW!X& zLpP}V@9A!F|4)meA=`d(@oaYD`W>xV#^G8_LaLPF~*Bl3E9mH*XQpM*E4A(NM$>MmU?Q zp+zc%gCQCnd7N%Pn^v@9X3{8IM76-4L{T@eaZ25j)!-3kGyNxd;ubIQl7e7svrajj zm3cbPOCO)FDgQ6B$H#pb>T*63)DR~c+1ySF6rRUysguMap-Cqz?452A%!v{Xi&i))eI)B_b}}{tVsxrAZPd}QiD5|{=b}e49*YB8jz22t>Y?>Ah>j?|vtfj> zs-!}*&Zy&bq6DW-F8Czi!@?5m4l9w1r5OQugohQxDdIqU&Se0(j>Nz@%kr?IBM`LN zzhjQYE1yk2B+Kn{$=+k@{^OeMz}!)lXm%8zO;b3e*^Zb(KV1U>LqrN`}&&g zBI>|^REt@VG#PI(zH5DrdYdT#b4uqfHn(H^1yd`9k;ADEWOWEcNrg$6P%DmBJpd_V zN+}a)PG=B97q;iEM!2uIQO@}W?wz2`o$MfV1}XY@A}}k9X4-NjbqH;55bjwtcs&X6 zwrYujn19sbLVPS>en4H^U#|v8ri0US9JfhQManJJRm41H=yY z^JyiBgKN};dBQD`;cq~XPcf?oho=<4T>g)<(Vpvb(&9IwKzQ!vRRWCKdO zpH;d*Wmzf>zPnePZh$IT=!fWag=01{F$ul3;c^o+@G({w0&5r!g;|b(D-7_6WF!C* zypYcHp1@eYZKX2i0=eG<^8k!_WTYHCAsY5}WO^d#krLIU-aw`i^EsO9 za>eT!t+_uh4YotsTjsZyvEjfM6_(z8AL&R`=OEMD6^FdJ#NurQo_uOqvQZr~B8usX z4#TN1-MjYRNm7uF$v_Z;>~-yk$O!m3EWorXnzQfKDqxu|%$)vvuEzjVuCk@}3VtLO z3JV$S3TA^RN#T<29V|5;gz7|Pqb9}=2NwGn|QRL z6cN%?FjSkhIkq?5F|uIP|Gsa=z??*~A%DN}jM?2?>i;dcsWhQrTfa)VN|kqq-vzv9 z!+D+2-_51Y+XdfxJumHk!};FRr$U(&1r%N1{G6Rb@u2ixKIklM)XD`T>*TT~jMCAX zNpBiAR(#_e(ew?*z6wHN=V>FnuR5Gdy>F$a0Gna>IFLg+O+-mRiF4{b8JUsMfT09a zC_o^@kAX1M378xM21a`i8kCt=G{LS6uvV!NTyZ?UJ9`r*l^O#NS~vH=?bxO1Z$+7I zQaOuVeoo=k6CBK*DZEM3!l7W-DNu)DVdV*tN5>yZiQ9*5EriLWC2(u8z9)|jBkwmh{@>&N-^jf!O!0dX?{iv#sYj#^D-yvxR`SY?n` z%%Tof5`{w6WEco}RB(W%W&?E{8wsG7IHK2T@ zbW1QvQDo`n(`%Ie5kg)72gpKKMt=vQ+xN7h;@5Eih31N;26BAnS@m4BAV{yq1h;4O zEm_k^jpv+vOAkY}6W{|(1}MMsIOLAP*bhMEH#*b_{RTsgplQnJ6{c%w78L1OC;Dw| zc7d92M=s1~>A!Ji5I*6E^eV&S16blQ#w30lc()U!>N>8krJ(9fX$4Wv( zljXy50(dK-Fns{-xA_&knO1$+Xjsq?%_}pWUE4_%tFUpLbiaU_;*Llb_5Gu)AHLV0 z;ObNpNV6RNGT`JCG2KAFA;UsZcXal3rh;X}1v0dt84JKpuT zQ{Y-Gg#vz?DpqSUG(UZtaGkV zrDkUZYm+jAPgI%&bYVc1e_~AI8c0|aTj_LGdVLjOPruQqlpvP8tSK1sr2R%aC^^U7 zECH*t1U(cwsOvaMvqFrCy4%TTnQ#QTbNhFv27{=mGUvK!%sG>+UI4 z-!eND*=Sn2wd<0R2&Z^e@?~Nx0E>$VV>U+8t?2?@+HwRvw6i%Al(3+44q{)gOeY55 zE7$v^GM;cAD4^}eo``yF!gzjhdwLkiOuSwU7ivJZTSzQPPM8KR0JaQbdUUEZWfjyg zik_fzx8t+3I6;u|@T3t@16oO`v0*x9^0uUhLgD1M%Jy7kxWu8jvFdZVMeh? z;6zYdx1b@s)Or-%Sqg0Z`zCSkEA8SwTdIs)2MG3Y`g*5+*C)c}KrgcB6xw}KB2%>7 z?1H2sn^b5(^Xsf*bopfgWsN85n}f_p8KqW;#2QJm+acp!Bx-4L$HJg5k<4NCa{$Wh zI9I+BjMQWS*LA&Eld;9K_hI?VX^me8>u)oBTowoYqNfYzceJ?}C8rZ272DQN0Q-1K z-*Yq6?j#+#%jTI*D`b?*I?2MzUlaU!y4d?ijE14bpO*C!o&FglmXBu<2U4T)_xnI# z+6__AZK{B`SxEWA6OL++v!jq_VG$g=F(l}8?tM! z(qPW&s!3w_yUbu_bs;2Sfz5gc`_WJ*?z^qC48a8?#`-<+q8%(|UPCxJPT=#i8cKbc znF0g|DPYs&C_@h^Z$vz)z-&b?;P&KAVTlDj86+l!iQqk2j@TvyG7fk`x$%XJYo!g; z-u%)OwCBl1bll}a(d5~mL#b#&siHEV8m6~pzr&R1a{s}N}v$gDMGnBL1Tbg;~q811brQ0inQZ7fj!ZhauIkI@MA}r+Spie z(US`vlNew_#TPRQey|N!tO)~2Y@*QbXK;QD1Yr_w{Eo0R@bpEeeZ?VkN@~V^PX)j* z!I(PW;M5}Oo7^i@`U-nab21Zz#Id_xt;IkDCi^EUz_GEnO?JFs@wNpre#a+q^t%cj359}!uq$X@I{dhy@ z1+hu%!wSfTZ~4oD%XZCMc^ng7rt#`Hx6iv(2S1n^V1vPX=z%;S3@$+^e#{M2(K5auPccX#`ko8Bb=<6!n?deL)PU)STU2Z_X zb0d%4f7iD6N6^-U>X9WaYiCL9^UpHT+_#zgySUNK5Wl_y1y0vKYyr+ zI;<<^u6;@q5pa-gDl~nQ!0XY{5ZjXGqXuhuCFd&(b!Q^jS1nE0qd-zwYtewi;TrwQ zfd<^S>^B-dnI~rpt1|Cfzvm~C>BlQLFMr(RABJ6fk<3W~w5Xww=wN%|6SP@+Sj4-n zrw$9aJA-JMLp0bJ6S$&QaYPj^e!OYD%1*MxzaLH&Q_MaEHbLMCx$@v9!j3wAv_TRV zMo&8xmx@btoN1!SVdI4u7Ao_=tO1w(jvtWhL$tn3^JQO!2k>2&9yHv!JQQi&1e($& zUA{Bduez?7pY9w}Nv(#n9)fL1XeJOY>RVWC?vj`s6&@_v{VRcsz_iZGE+?6GsAu_! zq~N%m5WRF=?Q};WpoZP!B#_RY3`~?^OY$S0D@ZXYT9T~?ZwFuwNpD}RAL*0V@7pQX z*qo$`(~su&D=|NVeoWLVw;8u_*4Z-i*oe((1y)(Cd|arjoeA(5dabi^MEoNmc~PI9 zsx+n|myLC%V~4gaj?-9Se27BTHwVSzDY`hg2!QXNW2cSv=J-2NWR4AWv#Poxz_vvl zb-N`jS{}$PF5baYS&l;9L(PclcEc3>cT-dSgJnwPGPE{1xb#huBXi8-5UXD04o{6` zqKi24QN7|=>lH-RLnCQc919fvf*2siAp;FW-~ub=WS+wlX)RkybjTeKby+8DO0#oH ztUn591aUyW)_M1q=Nx#kPtT<7w6%ZA1|;t_a6meStdsAM2PHO8A$-Q|Dfr=^GhJvA zzEmK<+t-_`&K}fa08e|JZ8Gf4R0n*R81keM`nH!`3CygE3S*x(Oo1KM;pT96l<)u` zRxc~@Ee;fjp!kqH2C^JjaPlkT12TxffOq}87#vnqdvt}z#fQyKUSv}A;vBsGu&P8vmQz7Qh3@TbFMBAW8J@+4}87Oq+k4f*Ki9;b?VC3~aNTYXr>a$y2|a z4xO4yA=L(1fdOe0PIW_Z`>=Z+#LXyok+sbTV~|CTXA5AWD!88oA&{3>8nT1Xu#D<< z5MC~US@RT$A9AGEi-rqX_oH@C$H7~8QKj!mX4Y}byiQ8*-p=hEOK28mc}-b&ML!!Xo?bFM3SupCL^Q6tn?kY1E1xyaGzG&tfkiMxJl>ZkSN8| zbeqxR_=UnjScHgD+I*at8j7+|Wk|lpgRnGgYSRRHpW7yC#Ev#NN(%87KtRC;!`&F~ z(3R&XP9;j2lKB2x+oC~P96Ov=c&U*aZ%z-g)wm-N1*fGWa2}Danb}Zt!D9+~=47T( z&ovs!cs(O|hB$pj!zZvj2JVGli^Io(s(hWUvAw$1hdVR?y!!y0DU&~RExXb?9& zpNR0lt2)gp@1M2g@h|&qAH1n9Tve`t8Rr1?f`iLeS4LZ>5sK3mH)IW9tR5Y*79{v8 z@$O>6FOtZZwmYXOWJcUbj(l1mEPDBLsG#Qc1Crb`DG(N4nTb23G}0naUY{VMft}~{ zQ1tD)kJ<1EwFnQwWL6aw^D&cME&*r#*%M9275Yadw3=X1SuO8UL=wq8swu~&hP%rc`F)281Pb1_If#qCBreW8MOyFDkhsYLBTyw&uM3m~>=zfY6}m1dm=u7-Q@*@NX#@~P+gbG&slFE}Pb z;+Q2T5wPZA-dbKa9tgAxRYFPPqk|yavIk6t_d+>TJ{t(v6ADgsZUBq(!`@f68h{m) z%HY&9Rm z^D{}?Bpmy8hzl6jsQgu%@_!o+;psAV-6gMQdq(Ne)#$DC5k5Cj0l@%B?R6Yu#W}&b zu;!*%MJTAyRk5NM=T)gKBO9S4ITwc$w9b8XpmI1dQt~P!LI_RkFI%e#AcfOfIuDKo5T?%hQ!yW7@zo6{g)~pcglT26F8UC31*P3% zqxy?({C!pCOFO9WmsL}Ze!jO?WzNE|v;4LfLdui=gazXc z6r6)u)euG1T#|$L&3v!jjJ%_4RsqA3y6q&;bAqAy8C-{cZ>K=zb@~LqFZ1aWk=ni&KleAu5QVym;%L zo$vo-$6Rmz54>L{#{bIk#KgkRM_zcT19-5* zjPQ-FB0@;_*;NE{#_cNGXUBPC)meXe&vEy(KhS&QPBEOxBU&3nJm)_8`Vu_J`>?9= z4>rm!>0|JIn&grx`1F2J@BxWY{n5*v+SM$7qw=||y1_gI*lfdWh`{%J^5bZQNXgKI zKFG;(srv1VIJp3u8x1qhx~sU^AWxVw=E#P6Q}h*}N#fK585&xUTB~JSs9!%$)?0Zt z|NPKL!Y+eWf{0Dfj4|szXrt3ZHcQ&%0I`#$5fPKkU5SW!y1x_hqxyy8-AS0#s50D- z)A=7%<7M~QM3+({A!-+YgK6+{c@)tn4|I*xe?A>bmQd;?@Du01q#s@=v_+3^tXr{i z+7ZWs-Kij#21^H5ww_Pv8A{}2H`z@YV2)9|V(0)N(chD~f{B;8M_3*am}rM@LGUjpd^a@dlK;jIk4=1h(@1V)3P0%a$ z@|6R1k)Yk$-IO;j555oP;?VRT$dR=P?Rnc38L_)j;p;W8m$=~!T`F(5j@}yfN~Rdf zYjtc@X;?asXIFB_2GjZuv^!qtEYlsR2V>&%57xNx1m;B{mw%xK$5OBM(`_*hPG=;rZ*Gu)@Z&wifvpgVuZ1~WowJ5S=dEFX z-G?#FauLAvmnJM)Z{Vh(BuuS$cn{@(K&u6tmyC(Z&-CG(d1ER*dy1l2%dL(!asc`p zfay+4bHq*)^uur=Q=P+<2n8E&Az|gQWk!in4rLx#eL(;b;}U=-q^#s(vK3n4BPgyL z))2Wa(==g$EXd7+3?v3hqtg-~a;XT)SVh~$Zopa^oddR0fN@SiMU`@Bs%P}1n&lo! z&|}bHI|ekz6ga3R+AHpWi$g~K92(I0rYErjMyIM42^@B*YZ>PW~QW6>iCqUel*PaFhbvW%SYiNh{9GzAtM z{OM+raT(H935c`{h=c@@2#Sn@v;K0yg9wVV1B=r3*RbzBEbFGq9;0du?x*{xnlY*c zK0HsJ5Hpp`>97Qt=2bD~*#Ng1OU5adj^Dz_MeBY$Z2g+Q*Kn*#M8rQzBSJe~vdQ~q z<7%`4bdn^N8|hlxlud90=TK{OaSNNPi7a%%*qV%2CM@t%+HFbD5Hpe+uM3Z~2Q@;6 z#s%2wtCaVlI!lWYd_L#%HMQc{aPwSt)C)rOY=19N5}t8))0)^;VO)W&@>js$YoJ(P zWS!!=bCmcP_*b(XMNbI#T<&tJuWcku!i5IRKt8`pghMS`7fTnWjL$nVpe8ukSy0?ozm<)w#O-oC5N z1s+#Ajzi1G!lNrS8Fr(iuy2ZZTOgpn&pZ;}DekJO!cCI$HT@C#ltH9x_MXYsc{fVH* z5|;kg<&hT~)PDVuqL&5+WfvELkqTAO*QK}ifgx*}sL#Vh*Pg8M#D#?P{ThE>T)#hM z^r}d0U!dG9Qe>~{6@Q*I^OgS0xR2HjC5O$?o|KI8>-wtjZL5->>v~SM8(44N06I9Y z6<5_`x1eW7s7%N+lBzmV5*VqB?;xDbN3}Z(kSTXzwO7!sId;71abxeKqZJe+*X$* z6jYJ|o=SI`cx9M+p(x0RLiHf{UL49`*hd#}k*6^d6cdNUzY}Zk8dws-KMWVyP*SpU z-D2+vAM$<0oRses>`|5`;+;@s{6F_=@q2!6@_XMV`wT;BeJ39yv@0ema6^n9(fD|l zxc$ABK!2=vl2!@h*buJkW>U5%JI|Mxgxvc;911}k2A98vnr!KNSfJV9SWFsimGR@} zJ&)ED*;CxqBeb|OPC~ysiGPFXT~uJoite8D)ZL&JA*F(7y7_4YS!9|J(k`9VS5xl} z5dRjg=CQXb^1aqhSaIG+7VNp2LnDwByux z4dIW{^{b#nk)Sd8@~d>=<>&Ke2yq|RR2K#?dl^0bDZ#B5xAHELl`@(Ie_;AkvzC8i zu5)4cA_F+RdF{()n9sUWmH4JymnoN3{Av7nzoqc+WcKo#Zsyy@HJ8G^Se0w7`aR!r*=)3C$ZYUV zI7{Pso8&fYuJ_^&LS1jF%|nA$qiORQv=4hH+w6ig01n5?tiAUET)xAYWM1zZymyzU z_WQov4|r&DJ^!CZlK-vE>z~pR%Gt%q)X)~nV>9;uX&W?-OPR7%Nfe7pj&E3Cvw&!o z2J9>G&rxqw5%QAUr{hh*{3H)o^80x4 z_`E5*NhEj3T|VExJ4sXvR~>TI!^O|mC)VNR;r%))xME#(h5VDu*FPLoq(tFul{T}$ z@9@Y4>}RYwrk;wtdYn$)`6(TMVKz`z3FnYdCi?nY%EN17`u4e;9;;o80OfI2!-@Bs z^w8XJ@Zd1l7P+0?1@Z6&q+fKw<4hH~w!zA0rH{%9@z1zvZ62tmZT!+MVSQ|6&reJ_ z+3S&8(wZMpoEVHV#WqXf#}zcR5KM+}LzO>ran&yK42@MuNGN>GNpHDs`&gg7VyZ~s zY60sX%SE3po7^Dq2go@qlxh28eeS}*x|4O+EE6z`ajgFgZ4yu-C&sI?(5A#q+@`H)irGgoYixGm zVwQf|U@YH-u7t$$AY>ZD8eg^kBy$hS4hZuSH{5xw!%jTTwL`1K`ZQXV!{8a7RZZmG zU7Xn1?`n6;=_}V9AxA)Q%xy&Tlg;0UL&E)L+VCX%S-%n=KxfZiGabAdcALsi>muEO ze8n_h?@FLJ+9r}Q%jDH=pE&~WhU1^OXm>?}^T1F5tC)FA0Y3gQFi|yU&O{E>r)-EQ zY+MF-b2NiC`>x!^1smrvE1cyB{@7S5wUJ&(pt~AsrYFw5XyM9QTtu=6JnXgAyFv1% zRP1K8X7?6KV*2aIRA2AoT@?gMW8504=E-Z!eFDGlY2uxmIXfYwnt1SI!|ja}ErJFE z(iHEmWo{|f9jwZYt(LkhUZIbqL)4&-c=11DnNaCeun;j2?E2h>_C8L zGluFj`Vd5LY#A_UXi#w$9oWDJj9G~Klru#Z4XgU-8k zs(r53**xP@E_?3fk{Z>yRIv@^PB)?k1H#Jz*F+BSK7}MOLqJwv^l%atVTS=HBgB|v ze^UY(;O;96*GobHW9MKTjFk(CkqN&DM$QwTdqh|?)3b2BMr-SjkMx0Dj7%7~2XEAD zR30&quFod1--50MKBm;vXb~s^;D+mZLqH4v$6&RY8o0fnm(Rt)aUrw*i#m6pn5Y`W zTvIc=VxZ1A&eklBHlF_adYi2Gia~Ec6;y<$L8L{va!Ia9HK%aC|16c42Ry+br4 zoX%_PGeW_q`2!uXu;&tV+isGVVM17i0K-Kx5ta2?z+(wjSic(`5p2lU@JnPcunwp= zG|uu~l@NRRT|#L=;AVir<)Wu?w}&x_JHYaFOv2rc`%@GZ%>e)G6%=0k7?JuWc$~9C zasPNhv=^SAfd4lDMem>?&h)hH%$k#6N)!G-rUD#`y(tZ53Bub0c`yR)cHxPX$8P>` z@0-UXFA%p|+roBHU~o~OK|QY`V&)GU!nz>NOdsE*E<^(`jMF;pjV!T>EypY!?rAOq zNG-PVwRqR3n8H~PpoM>@*h?5vYB)uq`|n@JeAzqNkn8%+yXoiTW7xTZU9HbK8n!Z~ z(SOrDMkhmxd)7;-GINnxaP0lv+-?pd^h29EMbQmiX==q47W4LOE{@X9crT?$FR4f` zhbdq1A1uu&a!FkTl4KAKiyQ?PbQT0~j%|`|Nu}X*Lg=vrDH2AKzNW={>vT1JWYn&4 zi$_M>E>mj3{Pm48uQ(3(z#}>hr@^D0t$Kx0SHy2r3qcTv?A&8i&kS`GN}5TM<*(`9 znc|4)nbIQj)5*=6ooP_wd>Hc7C(z`ngo+415NK^0dW4f%9%FK5=vId%c17HoNTY&Q z^%w|&PC_ze&+pRh``_v+G~o|pRnyMDTB^OF>OQzL!3@YAzyXIt2_0T-I4F<4kA!w4 z$3Aa9<3i&axa+2>lgRcj;^ixibyM}cro?gqbsGCOq%Mq9@OQKa;EbVx{cc%0NF-)) zXNkdm*YCR&)v3PWiYbtIfh`5i9P&@q>5aL$<(o<+#5tVcqKz+?EBV}};?cxCo*bmuW?NyF_kIH8 zGU_a*X*_%}ac^K|21mvE8D9PKh%NpXFyRUuRBHrI#8|hWVvjSn^5&oUB(w5jQNRb) zFsD{+63B-THR+6cOFVT?KIZyg6KcDnwx)1+Wde|Wb-PNIidv{*F9HN+Og&4H5rrX< z3wAV7)R-7GIOk)D7S*={_t9IZ;(MEBthn+F=jNSm?oqP*b70?j2C~UJH&|T+>Uu+{ zL;=*Us)m)+8>yXro$9d5j+HF|Kk4A9LE-_*&t@Ewb{|hX^=^IRyr8?OZfH-lyxBp_ zWQ}qweG#t!oK$PXPqM5lne#`RhE+-Fi!E?G5n2o7t4*IJRpz%(95z^b_pb^ASM04C zFBL?D#WfIp<%rKB7Q<4;RhS$c#HEWp&w?XbUMz3x7m7q4L*BCGX^I|Y%J5wwDnNe!yJPU12^whbsAG` zynR;gQDsHGs^O(j8t#MRz|pxp;=4fb>`p!j-BHu#E_Fr5u-L=0=03|+X>UMjvS`Y{ zopRKltxLIJl$Av4a8}lFjF!U#p6jP<&%Z7@WYPn)492?h(0^Jxv!+^6Z>aZ}mt%9B zgk_F%6eF437JP?|HS6wA3E?>X1{lc_tKuPGyj{$^T(OT#1OFX#8;4@hft{hm@9qk5 z=XA9mtmH%2WKshf591plp@6^d7>hOQWMWJ2{SG76*u%@9FU0*o`&2i zLUhI{c6B`h7n2fy!|78^4<9{jQK-XmN$i(i3!*`BB+opJvt1@d!$@Me9?=Y&px(cv zJN^}L4-$jjz0U_@m;k}KHZCS^2Bfp~zp%jvqEB2yo$Qd7U^^6W2uN|$MukPmAWv0B zVuQr9j;A@k$q%t8!RY`44NS2hGM%!603Qc*46B_7ZpQOSm1hf;%ZN#$W3=&vNqUl; zfbrMi?Q@&Ekt@0*C>ro}qEU}{8y%~CQw>cM5}RZsdNtkHm}~F_XF2Hia`Gl>5%Ea zl6o<6va9AKr+J2i2q3=zd#t9NsB6ab?|sP5{iATL_Dq^Gv*XdH6y;L~O?$_EckOdeP3j)NJuHl8Zl>r?%{LX4 zQvFoB-8!raKu)Sjd>);0nZ*;Lv+4yqXQal`QqliSWXL6!dC=)gu?8GXR}Vdm%_v^j ze$91fvCT}lKhCKQCgfwa4rjWmXp!&NEUpRrC4M)lCc6v!b<+Z+&Zhw?K8B1lv)IZD z3*+{_d+oE#cc{_GfsM9JST?xMiU+aT_~p1X3N-9y3m&HyH|SyU)gdZDFh|09M*Q35 znFKr;CAT!s6ROg)AcRn?b8kUV{3s9EA2q-*bSn|eQ3MVV5T2Jm3N%YItOk689tW6N z@C<+w<4UBetYm-(2wRbchlj>7I!J^hZHU~{UOV?KYi!j9sz)h3yby~&XD+m|fy+%= z3}g=!sD_F4WJh@ir)z0(n)%xU%uELDCEENiU~Y=q-(Ymdw72d(XKdoLtVaQ;bPRs_ z#%O|q5K;>`U&x2H5eXn&tbE3->KWO-+>7mC#wWC!Oo~^_vEOZL$_9xb4J8Af(<}R} zHp~HZi9E;m!=5fnE#8kY;glgi>MOZ+-U8u%@1MryRJ}L+(=FdbQUHX;Svt9K;eo5P z^>-q)L{lGUr0Fw5lqNOx(p?O(IC&1T;e1c+)A-arpE)lJ?tpB?QIE2*S(PXWiq+b! zvMRgmZ$9@W?P-|;!Cwv*TYqyGQ14|qqj$^ZPI^KW2~wu<+3lqRnLb(Nw|QKH%s*jk zpw#lF`VbTo<`OF@*yY?Feam!F#hRQGK$(=&zKPhT*oXl{S^GU2MrDTtF}hMI(lY{i zBNvaOrz7go*5N+g6h=frB(lHkh~+aiCfQ?Z5(ECS@2aZ}9rKETq7~rhVM`d3np1l1 z+7ukDL4A}$3GE|Xk?Wt#F=_LRTu_s#>bmhAodn$ystF<)Hw9${48mVt?IF-kR#EEG z<8p&OUZ*&ECIlTA8vwPocp_7vpF5&uR1-HiqM=R^7O8onfsP)~z zCip3TT_X_-21laAYbslDZO+@rksO{2ge@He6YbJAIYtz2uG<<-bZ9S#g(~`se^|jp zTO%GV2Tn9#H%ZkLCPj~(8Y#F#{`EKOWx80Pc=+X*U$4x_+L(;SRTLeqqKPx8fm$TX z3fS;Ysu={qUO0*d-RXnk%CTlx!Zu^UJc}e_b&-%_dGX~|JznYR+ecWB~o3*RyAS+wGDWu@P?lPPtNvziVjX@5gV(OUqSauCbb#ibW$laSs227l$^ zamu%nAQ1QT6-B)+eSP~xR>A~xp#BO0Nv8^EEbJ7PM67B%8wNrTk8+fiM7uj*3otdeh8p z8Xxf3BcsnEHML&c$F_6qoN!dXB!aC*7|5zH8pGRY=RLx^@oTXRI`U6(*v}N=jc9&7 z&hbR&h;`O>R;&h#mun1uc(AvuQxvMI`M_~Os8mXN94{=u5F`1MKLja*1Nmi%UUyMQ zxxl0VKP|d(+cOMa4ZDTqIEu5k#gmL5m*l~4gAC+(~%#g_###coaHlN~% z%hw$dR!h~yaWH92aSCF?+lCAQLCQso?w-Yanzt8lCIHzjd3?E9+=Tn2Oh0o@_zIV# zS#wCUX1EPwopHD4`$@O^?x@H@w|S@e(isjYK@|_FAS7;d19uPw)?Er6KQX{5CH9g$ z1I~+JLZ%y(1p-j0f*~kL*~knVu7Dt1~NT& zYgUSf=sNW&4XH3cX>TP+YdqQ3q)@SaEtW&=Dc(OV91LdcmR%3)eHWLoMrOuSldqI` z!g`@iuid~Ldl#yz099t@{dGb$KMl0_z=EIrR_e1PC^`D+l_ zZCkk(r0T>9R~6-B|d7=GPBjSB}+LyF-8lz$WR15R!-L&hh_fc+ghyu^wIx!)+bH|#{d7L zAH~xBhrfL2?H}q$pAeWq7F9xWhVOk&K=Bq(E@5;4?ebmNY^jZ=;Y`Yr{rUIP3;S|x zPVXuw5}b}ZaOB)!n!Z?)sxy8iR?`IbKUlfzecN{beXwmxYHVmst-diNeM(gsy7Xz? z`6Zt^eDQDZuS-cKYQ@AE8+HG;*h`6OGu7wp?}r4ywiTso1^3plPoif*j1%!2Fkf)()nOf54N-@2V1J+j*D ztBLPfb5};1Dl5C-rQra&kbjQB->agePMHjuo0S@Ae5NOQ#w_|}ASe!I#SH6L znyB!o#y?@!jePlr;70 zcx!Pr@YdiaSO@O*B=!MRS3sB)jZ&o(l-Y&L#ati@rx9`YM%J#UZzNXD)EfmZMjcJVkuJo%|8{Nuc4;A^lzhf7q1_VwfI*QZ}2Q_ z!&&m8+5qSmh$^WdvEU7^fql+odk{W?9Z*qPA*Oyr}BEP;LLIc4-1TxGC}x=;LXU!fxhzC z8xP8!jp1w}RM-iXfq+m);Ph3nUc{mGLg*(JGoO5 zDbZR=OmFx?rdX;XLzhm*ANyL~l+0@fuiji7VQ1+{QJg7}N~lx!ltu@O+H8@hY}Y{A zDbW-#X%-sKoY0~L&c{+bImoYvcy!QB{eU1J-;;;6VjHiC~-vD~GIx}a66M3YUqa_}4#&h}c=o;l3fJ%N!qzoJ# zPZzeMx?wL*pV7Pt`{Sg!!UfW1J3|EgNyC8hbc%{2v7fGxZJ<8{FzQtT!qb3=Flh7Y zqL2kJxQ*RnxpUE+fH0TgPi6SmS+Yx&%zngV#RhtsAPQjAe0q%;d6wBYYOtSCyf}}P;@|NSpI>V=)jmE z?zoDOM2qvSX)~Dt#dolkmg8KnDRBx&0JVU5_4#QSh#6d#^^)u}y17LE-d2tav{5=K7S2KO zoL9m-u4L~&V|KZOoOD9>C31F#;yp2=%FIsdw9L$QJ2txyNQ}u78%}(z4#dR3y+@lp zn%DbY&NInBKUK@3xQq~3!L3kWv*Cn-I?3mDxzcUZcoMj5yX$B3FFg-IRFGfQ(%Cn| zp&kxtJl0Ep5o|ukl>+!aoIkP@`Cdp1-bPUJ@V)K9>8R95rk|PhR7IpjC1qC%2u1Qx zw7Hz$=b~`mMjc-*!Mk<0m(EFApFtK6G8)QlPg7(Dok}%)_1p8Pi(8;7kuuhS6Mol2 zkiHmkS2g@B(n}@kRESQHjINPtXdjP7@^M=l%s15qze28W$>^-``m<3uB2-LPJ(c*2 z*5z+u^u&$xiqur5mLxOf2w1OFXrps4QLB)5N?|N)u_>uMDZ}i{jCZAam8elr1!IAt z@M(*#Q`J z_+97neq6ryTTX=Ik)cFkxP9|u+ZuyU&rKaXu^;`{1!V&#ZX-EJP3;y9$<6>0J(e{i z<=#1mpA+)b}onU-gGxH?iYAkqsSx=*pq?wA9AZawcszf8QyO5}7uJ-_Dga z3NQd?P@zp4@%B|2+5hw+V#EE8l%?F~+iyOdy2oeV@lVF?*POPl^W3r*Z9DuDC z|4#V%+t4-Rws$H~CF8euu5x{Pw{x$1ZvH$y$Yaxj4ySH6rVk-Ho1!cW%(~7}74B>= zw^1~my0qpuUp&38HI%Apt{v4+oEoz)R@jn76T`7wNe+K(KXVtwx%I{Mn%jLjdH2m| zYnsiEFwYvV;b$bDe9D{o@@hh>t^Emeq|4Fp@15CM@LrWbt}-bK;ijoMBg-kgyoSIB zqa&@J`71r01*vTBw2)7+4V6G&ld#c1&bri_(r0N>6j^3VYvC=fudgQU2q{@Xq#c-L zKh=KQ;OQf$J2t82C0D;t666%gMorZrHY;Vh9W>nrU^+kE&vI5m5NaR=#>sbkJvqnL z+DVmBLpA@F3C%0#tfU1g9{%l@yjcl=3Ld7Myepa_qt3NSO3$iXcF#uC{1Z4bt7_R) z=pM|3E%uiezPKD<4O7*o$@6i>JBu)wXxb=H%G~npC`>i=k;(V+cBkK{sg4)D%g>5> zaHeS5n+l+;h|REgaj)shUH7U7&b}+&Ke+y+sV0MsY)Q2Nb3ec-s56jzM^HE#ii6E~ z8OTb8C7Lm=Urv?-Bm2i7(jPD4*)+Rbz)9p0-(kLo#`U#9eisjh@?9Gbz|ZAr+U~Od zDM=oktN!L*XjQ*B`+L-SxFzLEV0XjUnYZwO6`jI$iWFLnuFG$mP=QGD#>G2cEn8?wa%9Z>@QGehhLyfj^$rc1Q>#+%?@i6 z&;?IW(WfGlQ(OqZ3*u7DVG~VpqVI-+Z&;2$v~zt=%>4xwy56|t0>LO*e`Zzyl?ltP zp^*d^xHm^3~bhmOMM7p~Sxnqi723P@GQJ`(h0)_3Wh{N z*p^Z^DCJRdQctO3y8k*vsE{7lvXwv#9Th=nK^EzYAxs@CSsy`h9(#~lSWU=R{5=_I zhv{Ts(sxcXhzX#6>I;D zqKM8G#sCT(Gu6q_B<;k*m!pM5!8A7Ec2;=9*YD}kFJfv zdL*i&`ca`6R0M`(!z>#d+|l+l04m~7m{XSjhcjz3a91@HJeS7tKb!tK(Nn1$nr8>#7fT?0qe}RudGVg%3%7fi@tEKp=8n6I zA#>j^|JH_FtKSBb8%(K7#qvja7mn@#V8M+Sq;cA?2jWAi?y2-SkzQ9U+CXFlk|BX7 z05Apuv@dm^C!_?f^4XFay~8!$l~vG+uxBYc02cqgn1CJN(6q$*x~|rD&_0)FGc(TN z4iz-;EKsS&{0Gcft)ZT?gHsED#aSe{L(v1?A^ij+^~j-AGT$=6OB%gyuTHSlFH9h2 zOkO*tWckn1{}|Q^?@oWM$7u_OlkNbyyoLUhM!B?lrAVuoy-m5yU4iUYdWE{bBS!GG zukNl06e1KcVq%g>$|V7wpS$Jav;VA_f8NieVK3|l?~SWkab)yB$1Pa-R(t5TaqgE( z)oQ6)UCNb`ap=2#-BJAs0lLEY_6t_JeXNo>smq#tydhf^sMo%7UHHm8M8L*;-Uo2n zri`M%2&&F>vgP@@wgoO7yv_vE>SgG^&LLRY-U=Ru9e3<^j;i(Sw`P*LdVF0W1GJ_@ zq;BrWSMdlQi>HxYK1qmWYKfvdOM_wQ=NTnv%v_dl^+_eUlZH;!YFIJ%K`H_6>f_aQ z@5@OZW0=UIuZ!1%t_muG0asmxXI6v@&aVl|nXgzT{4Sv>F;lu=KM|>=gU{7|iz9}F zc_;v6VOx5T%ZzI)*N1Y(q(r{hL8(%O$gObYVCQZZ32S{1k*qsv;wWMIHCv)p1zn&R z1%CR0TJSlmC&!7(0q~LLIFOvw(xHyf_^@S+^F0{mOHy2P8#KeYjOd7bVGp+(?Uyp< zM&iQk7`fP(_oCCU$au-eK=Eo>N~M=ds3k1R!y-Vo+{itF$D$>5Ta#Ec{eAEF*sA{l zuGgpg`A@0lzZ32-{O{G`D8_W$cE>|ry~VXDYk)R2pNQnHvW)O|#I@z9 zl_gOX?^VA%YIOw~Yty(O5Xerzgi)i$9o6G~eK3c~J#x6v5I;9d`f&H>uzdeS@Wc{T z^~k}G3&M$DMa$C3LEkqmn%k!QRY04#jQzV&Q+zI88>H0<}o0jsgb#kSKn|UF3(QBA0wiDmyC2R zyk#0BUr}p6vl&TfjgoR&_)(B1{7qQm^tl<9Y+K;d{&nWMV_W;|cI?QoB8q7iH6(Cq zR8D0g#!*OC!elbK!F9wGHjvkc?%T&dXMCBvc&+LqJGXxMVB*guU_V!5IywDc^v$!= zN^HDkUQnDTBGv(k%&8?0xx8Da#FeLywZBH5;aYbSqE#gZ!@Z=F=g;l3_E(njo@A+_ zqlZbayWT6sOEvtZ)2V4+E!+?8r}f45&bef(cE6z#Ew&2Wr=s@W=Eer?j?8p z^>Ktahvkk<*pG@r1WEBYEWon(61Chyc0LEy8wB#9OEs|gkz5}PNaEN01yW`v9xW{7 zaE1*O0qu1`8qNsS>tC1Ir}U;;0NlUC-~hUJI6$838HcLi3skBZ`Qa#0WiI3~42FqiqdSc!D+9E4&A@izK zgofsO2dGhv4Cc{Jsm;(+8&wjwyxm5_bqn;o_y&A00Cv`c+4MUG+FAS{dk7_(`kDm| z6v^U9N~%F#-E~sjaE47PXM?5a{sFetJ_wS~oaG3D_{GbYcj{F*94_DSlff$1(xi^zQje+IPQGvGgAmqq`ddnN{B$xTp5UWim^~aFgC=)*B zS?%7pW0$q#NkZ+{og@lNw)aNFm$p9po&~g zLdQ}sy@Sn4w^T!ib}QGq#l>ns*h^0|}im$(XBI$1BI6v}U}JX>0bj*`)gk!=MiC_4gvDmpL=~8msld1y#w}zACbp`QYGPvi3&K%C zzO<3st`j&Pv!w2Jmt`*q-wZKD_zuCMm7z!M2|Q`w3wGZ+6U+cM3*2h*;!s;@k@F>7 zA0j_HNH#cZF^y}AC^0W9eIHfbcEqcRhvz(~NsT8I=H)$@0Z;WyS2-P0xP$&~sMdT+ zdvAUwwK3lhF|wkfQwu~Z>;hiu%79MtuEy*V_ygbOW5yf*3~DOedKwhAOejGe%)yEz z>g#P!cuzY*XxBH^g!z(_d7SNv`S8V#Ua|+5)KF`Cho##GCsIA{>P@ut+2_!tw02uF zdRuLfA694k^9LUYoqKsbUUFMJaz6EX&;AC)iG==K@$c4ow$!&Vs+u9YoM`(q{qzZPXSUrPIeiv!yn#wiC$*+vgqkFrn$B z^qt)z`ZZA6#Nvzt$J0F~ouBqSXfS^t1JKWgk+06zh26ttt%gIIdd*>U_f1ebG~JU_ zYIOH3{YG{#FKnH5T}eu&N3RZLX;c2?>>TX(<68F}y3{>Rzlq+q1b>H8%|s{Dy}}8p zy5Ftcoj`0w6Z~{41#^45v|*FH>(-(}w zp#flC`)%(rRb_T=B)e^21x0pjjGGHvY}=#raxdpL@T`vf8i!HT5aGf4na)>fOJM=A zWF?c_Y;4tyeRLS3tKgf@d(nn`??3gsPB3i2>&E9BMx-uvQcRD*-W~cyf3aP>FUx)s&xb9b-(#V}@s`pQWoZ&}m*I zOEF7Txzn9SHtUUBZ{_c!FlB1PQ@)8RB0k>(H8kDt5eWFCQt@!cj^Qh}l}miAKk8sk zdm4(FQq!uug2Ct2FJ*bwrNSNV@f2fSMxd(u%{l7{*`k0Q!rCziZy)HYXc>#`Th_JA z(fm}@SZ1ppxiy65-|stdP#NlfQ=Ym>a4K9cBk^R3~~Bym9rw zzd8&Q0TBc74s`AZ=I@5z^@97IhbbnE#&*@O{iyQY3?H?w1j31i?<+Pd91r5>?1VeP z{|qdg$D8XDQG_n(8{fLyo%^Rz%ZbBqNscXU?L@_B#1wew$?w6!d zwIF~fuIB8pb^I|(IQQlBL-vf)fS3puRyOQ92~r`DnuB*@y6PsmwttSr-u|Qjsg=xC z_!`v_h7f1J6XlT~Vy2v}S&YW4lY;e+w+Ne}7Z-9Qswmiu@Y3yzi!$CceCF-ad&Bpa zvWDth@zo2b+@Z=JF*D*ITFhX{UDIyKhi z*UP=-j8ER`;4*8Lza9hwE1)nlm!NHfL^;yC>kY@s={#*l^{h3itHdc}PkC+WCWL>k zMR1eI74=<0U055I^Il-6PwZgL4R==@M_BXunRHg|fMwY<#Lr_Wq#~OEO9_a8ntsaj z%?Z9IT!2_y;wZ1QWXRfywGDaRwlfG!BEHg%IV;sqkOfp)1i9W206WeFL61nm^cA8P z4Ykuhp73%l*ICwsZ^JbL0{k55q{i1KXA5Dkh*ue>=Fj(q!EkC!K7p93=sio!P81IP zKRLm#(t%($=|{ghwFsyEH4s4M;d~0LN<+e<7qY^YDRKoj9c<3HQ=UG6Vh1a#6PGS-ku`oP}Dzjt(;sTO@GTK-DB8O!C}P+Oqb(9f1n?fu-GOYLg@&^9&nz!aa|Z z9|4}?@is}KJ8Pnhh14FM^g%ruXvpBVU3_`4d6|sK_lF1x+=VHXFCiuM&(PN&0UG17 z68e#S#dwSSo^2}f<7c(arpeL4Wo)vs>g znH_5^M`&>qei;@1%W69^!25tRgVvB!60*}a>v#{4uw(#yGCwHerrrFzp#?;i zA|O^&C7g}+oUCvS;nmcZXOCRY_dL%G7{ko(}i!FlbIvo(lm zm^-O1!o6+b>)RUyB8hn}v&yRhXnoz&?Zqj^A#3 z@b(`i(k}w-fuU5QM;F{LaXkQ%#d;6$JAVn5Te_`Wl`@ySa{hb8O@G-~EuAv}9*qMR zp7RFd{^n@zhV_%Fi!_wKi+Z;6=H6|;8^&F%TE^Vm&3!A=#jIvZx3iP_3y0MHJHNB% z&c;kNhqN9ufZzQ+sD-`#$5?ssFT4Fs(*I%XoSFoSwq;$mZQHhO+qPZRW!tuG+qP|^ z%l7T_a3ju%*bnPEi?yq>P8@ttA6Jufj*xLOHO0hx#P^O5 zHHRIfwNa@tF}jD9)q?~nA-|=Q1UsK%s3jL7=kP&_w}OeVgDu-kF;P0CC%+z%Wh>OO zgO#1Z7K1~Tk%%4KK^f9jgwxNmZ$g>C%JSP5#}$Ak3b@fRC~(Djm21dZVgq*+jUBJ< zPSg1Pv3_T5w?71L)i2=YiTks4-kZRByE?&loZ{8`4u^r_=>%fwV5q_mZd$RWL1oIZ zy8j+EL}4SFCPk)Y^iWoo()s-j0h%-!+_WE}kxvRWNL*h76n?zgKHHV)TsLk!%?tl+ zlV>+dTr6MDawA)x40;5zbiH=vZTPAe%i1JQK+FWJ|(b zE~J3j1#Dwm=(pu%z}{KXaHkc<7JnRB@=qVQt+@WEJeJ&@+%HKQ(#Y_bDp(D} zI+1C2w9pJ-n6;_yb?ETR0F!Ko`2 zQ?K(NPzvIvEqR&I4pP(}(nK-q|057spe#B1^rHkTsy`Q|w*%{g(W()R;rMHkXXJSOhEGSqTusJTYh~~X{nE~#+ZFKy(ui`hDFCqodA2dvi zGY1u+uHGCWh3xmT#K$Da$7jT}(P?3#TFoo$>DQS}9qD=Wohv^O)f8D6UEHLy!1?Px zUQ8H0MC^+kJtk3TOc4rEPeM;S2!PL}N*s!X3~oQ!C{~k?c}RpkdIu#O0?I7V!t1Xo zs6mHGd`1}&dBjQ>hB9Z2f`IqcUphVpe+8q=q#`4zAC?yc`&`YAjb-n`AT%~WZ-)CN z_m(sTTt7_+cpPLysMz0juEq21a$y?qO)Bb#89eSNx9&iAKsi=~B)2N$7}S2KNR?n-Ax(s4lCE%lK#Wj?|pNvJ?h|y6+lRtYlXA z4=_Hn-iKQ}bo5ZFAhs<*j86rxFidV`atW`rMN5S$qzbRJU=JZkcThMlh&s-d^NHYd zfBneHP(Sd-I{$&+4tV3p18S{8;#J5dW*U7E&Y~M}P}STs!B95;6of!|zj+5KDl{h_ z^9}UKVg5Qp?<(=g)&2pK9U>n`_&FL#uS3KhNnYi=*Mq)vx9{Yi1m0OmFvckW^WjeQ z$Pk-ril58*E0FcIru!lqjl)n;Q<6{*+!H3MtAmPzN;?Crz*sUr!^hPDh8NdAM2~FV zshYVZ>cf;B50pNn?ipWbyrIyT6#F^aQr8d(csxG-#ztj9ZLa+JOPt7##nX%XfQ`}*ClP(DAwU|((oha?6`GgU`Z!7`K*6>275kHokXMjZwCyIIlvH{Xo`wl3HmNj0 z2u07FAdNBMPQ~+SQjpO>ss*?MtK51KKHVVM5#ktUJpj<%{l@I`xJu>C;)D{u%V{tv z41ShV-E|Sh`Crj?qCa9Vz*zcy*rA!$cKOcu%i?$iO*@T5AQC``Q>0K}2<(XChbN*; zel^m>$}oq-M~eM(98;##Y!~Yi7r_E(YqSfUmKc2IRO$ZTt3o{VA9fgKlSAKlF_7D5 zW0x5u-bpc+nbv{6-;FgZdcS$3sd< z%yMmDk|=9Q%j7`>0bDbNINN|+IG z3I_;bur8GhNCGh_wLM9@GU6F9iIcEjn6u)V&H-4x=;6q( z1|;2&?Pv2Qyc`Z|z{j?`N)qcJi1g2=CQB1f3XLgWab3+Kf~PjB5Jzc24cc_OOzCOX z%k-4Mxp|UD*b#xCE<3npv%qvHVT#%Q8K9|?w!@t}n9?F)BfUVzbl!&FI!AwC2di4U zvQ4Jx=$<|F#^vl#68FjS8ULL?LYMdg%sg*{`Np^b3f}74QMXnZyj;@ctl-&zHnewB z1TVhx_hivG%{$~($H4Ao=v+tAge(hh{BF{0G1!M%|@zI~#@7$ryarHVegH{|&z&mws2`c5*% zL|57tmF#TN4(F_;WB&96!xcl|lrl&tZVFF31=aG&&xYTKN@kF?9;KlecM_gy%tTTp z^N&Ic&kFid?@OuYhdAJiDw;jMa)k6ty%-DXyE3hKptqaU#n5@Y3MbLjpzJO6!%mt- z^f0jfq+4FB&H8aprPXI9g;;y#Sb7J?N!<=T0S#9%Zr^w^|2}qP63dh(kEkXtyKH=D z-;j52<|SE$+bSSH{%hp|1&ZWiEGD;+_JSwrNtR$2B7jg;df zqD&oL|L(qW5%dpZ3Y%mw{Cj+MxoOY_wq-i)9naUjc%uTT;~VH45CUR!hc8-vLl*vo zL*io?-h>SfsJke!#uV+`x(ox*%QQ?iJ3h)Fhsp=M>ufp-?N6ox{1Ph3bD)W;)y&Ex zhPF_*N7~?DrnG6ulxd#BMUD)76s6z%eipv#d-RCj8#-WMF3HX1+7{s3Q<{tKahlvs zhO{1R%<1NU)n_}wL)3dPMYl8ZWDM!kk*@#G4-#S z>5t>P9kde&IQTPnTr!Fv3I!=!P96%bsYdF?t2MYJ4b(0N&x<_0?owG*Bv0f059%0w zuW(nj4a%1@-p!4R5FAA7TQK0H?A_ioWD9@{z$_P>NK{@YeAOjq-$|cot0)gh41v-b zmBx$W+u-LJ%^`o`&9_U$1h-G7uC&7U&ZB?7Gj9dMxf*2EH4C4iD_TH9m&JG?{fD8e zJp2L-M9LmLzG6F3$C`d_KiOMEM~_G0;g;S4m2}_NcQ|dHHrZL4na89r1U6n%=MnCJ zrI3zVT0!d%U3<^lpb7uhnN-T#GwBs$8b?Tev7y&(MH-5$A{zgcbpPxv(kS;cotvXl zbGHl})2uzFFjxkv55{@JvIb3XO9&t3)h|>_E`^s$45z5sp)tj*3I^RVMN9B|T~f$1 zcH?ES*}TwQMMn~TbOi)wIVcz%f-wgrp9QEe&A*11p?)=_JoISUI3=1r2N+I&Z{K4? z%al)`MV(Ik{(is9|AI4r*k%1ELH=LWXE1WI{U2lSMC1Qc$`JlQf@;{lM48ANVC>4W zZGeOuSNrpNc;^?Viqwf%y=!=WT`8}u$R-e5u?Zd~F#?xQ)Ye{l`KXSZD-Rce{CFfo zzR4HPP=E~rBmhMc|?M*UHmB^4P*XvOYIo0A^Tow_3Pf>lKFs4u=>lSX;FPjL| zX;PWEL`EAFof$vzeFW6<9N3dg6+4-DW-j(zT{0e6?Xkb;wp4xBkVTe;O4bmkl5FE{ ztdx_jIYNSGDleqChR`o^e7S*3LvOxjb=7OOHgl!gzP1|}P-l$Yy6L%brP8(=k+Cm0 z#p~tebZ7jL8sSJ=`;&-)+jcghblk9$EbR`Xlgt#O2KMVHJ8S{c6#|?&me$BUUs-uZ zm*O-U^OF0egY$>m9k(ETep1;d+z|8$JFX4Qn5h@#EGHep1! zgL2y!>0h#c0TW&SyBy5D%#K6u@alx9l922eAmS( zCalX5$XyQkC}K`@>x@pwUTgBCOqC7#}w@58pBR!XY4`V0bp9U&|pN^ zd(cX`d0d7xw+hQVMoLT*m^*~uPW}uIlpj%cixnZ!2F)18eDru1cyBK*Gy0we;H?5; zy2SCatenpbrb7Z_bjk7qb;UtMflQ!+Af~u;v#=z_sHs6gvGu7L4|jx^c_c{qx*aV& z$#%<#AKO8SAt8k1J`^U@k(CxuN<9{2xKxsG9t0&endmyD?AUk`cs$U2aU;4GNXZVc82pbN zmbObWHe}pXY%CsBpYF<27wp<7_$MZAWIlL=Ao!{tGR?IRm|||klqz}iU{Fp?>p3S+ z*vbRj!&NW$EAIQtHai~M*8W!~7ay$?ViTt^IkI2(4fvIuOqz^MtJX1sl6BgZWp_;# zzgu&+fx*g*xL2WyZEm@iZZ@KhXg|3=s$!3RXZ%UX*^v|Ku8ns|J*=wo^*oY$rjwt8 z_Eg?y>mva)LRCk!dN3NLfbtclk-@5SKA>voAoO3AR>G)l-eRbCl7ezoH<{wY1dYvh zmSHWK0j$%t2eYMc&-aaknlC&;X(Ma+9lec@PDL z%`{kSZ7jw!mjDZKR(2sF-~GAI*nX5g3xw9^Jmy;&$CZ?<`cUTIE=a|G zCbAw!+ZwuKJ43kkU*915a_D-sjV_SoeLR`&w&WyRFQXn?=suV12_Rh=t>=o)-dPt?P6fUGp+9iWsudugJW9`+Bl#L z!jvw0R9u#-M4mOv#DScuVs&sW!Ri4=ho7XMA63y% ztsg$fx+UOnEqg#JYgwd>L8`~lQZn*!-q!hnSE^6_BCXHB!a)xXg2iVTjIRF?T2O#1 z&lDNmw|S#~LjS@6T^t$e)5z^>&h6B#eM&(_gLe| z0r7lHsuL7G(ViJwj(p+s?2TlKr^kFjHqv0Z*AYiGR6i^ZHNe%)EhHaEosA3CCywuE zAosD{m4TPBEb>%kYvuKLo*97Y6QV$aDYi{dN#n$f*UIUuabe-e?Ft_9H4I^8O@_={ zOC_9iHpJkHTe1qqM{hSF?{u7w@#!!O=)Qde+vKV$63)3|Z#w7-Kw2k3&#J4OM2IeQa@zd*d^KO1kv5a zm=EG$B+`#ph*ORkE0Qi8D;e9eso(c(CFeZc01JY~^Ih(%vZ7vR_QWYg4EnoRKE5w6 zx+VPd=<~GnNh76tm@HlN>64tQScz;tdG7nV*FJ9lM3mD~iC+yd>pf&b7 zv%JazubV_cu#S3cZp z(Y;|}s$-u8o|5VH>TvX4$$iR4ZBv*M!$#1tyhz6|A>?J*sq2@7dJp}=eBL&m$mRqP z57TeXD+O*6e{xTa95;jCD9d_ZSZRxFNGvK!x&P0cSSOk|Amds9)!kq7+J=LL_71TH zO$$NIRCWE;sgq)owW$!j`YhmDw$`>xF$qDgwDsf2*JI0=Il5L*SLSspJIt%~JrJY7 z_{%>mKZE`^NX4*!G;ZDVp~{H>fpk~zi2-i zk~Oky8l7Jy@0^S{jy)-#M_KZ+QDF}DcAmI^81GR{Ug6VrJBY%C~KcwHyJ2 zRj!dYntzud@DSJXZ^A$*`h=>EW7_fXAfXX3`_m#ImF7^6bo-D-c-g5=GWudbekz zpi_^{LQEdxI{y|Y_`auxO`^}d+|VBpF5p7jy+NP7Mqw#aX6r1kxJrgotV8IeWaiX5 zVm{eLnjR6JJjR?*yW`k50Azf?WS(WjuyvsuM>{tZ6AbCNfz)2Wvnm=4cdH~Ocb9W+ z0$TI@3nt?>&_2|;=$V7{$>nIlD;00{7#T;LOkvh;riptN2AhwDQ_DVlPQ7h+Zb{)) z^=;g^l~%lVSzqi@f%o#B3Luh&_{i77ELkgp_VoE+0e^>;y#U;}JZ@43DdnZ|4jlX$QINbEENCQV9%Lr@m67*v-AQiWuo zm5Z6WZGaY9weofS&o&ahl7YI$KfzujR;5`WE4)I>`YALf|<#S|9>R56OcC zX=Ri`d{5?Kq~d@>STNy(e29~?ax&;*>x;heu<5oL`Q`9IaorU-ic=Z+sVR40Y$@e~ z;0BvFS~goAo1!*A->MWuqCaM$iU>$Gk6vDW%0!#BVxBgPq!M&(WIv!xt!1Tu29bx8 z4ipF3V-s)(6-IRJ!=$3hJ>IJAO6GtDGnO=NEC=2)0g$1mS(uwj6iV}n5vf4OHDRM>VdeA(4 zY&UlS#-wd8h51(6uPqy^Boyx%iet-TIBi3`2uOCN;y@7Cg&C|q6J)@9$%itX>g&x0;L?qz zH&@{we-woDExHV@KZG)foWC=3cT?tXCsJP^roP4GFrDjJORevBO9|ialpsMgGp8&u$cxnP*&%_Bq0I^?+X4QW2^XhZM7jtLlLUSKvk_mQbo=W{QX%4a0J3@%jv!y6tSsM_#{qgu zNd*s_D1U`8W42#w%DC0T6cV>180)Q}rGtF-pf*7sHNRAZt#l`(f!>;f;_yd+AWW6$ z5(kUu;{;pDSXQBJ_W#7S2FCQ&*xCj}(wM&86(Q9Mif#tH6WL0?sz7I(~Dn1)qV3n=@6>!*becOfbQxhEF4dP4wXF9cE35 zgj0zo&{d17NxRN0U}E(;;AV}vv0+psopw%=XCGZ>ddyQv$18YV<6baX{;L=B!|rvd zK2R0}V9*chCI#CIo@?9Xnv1HtPNL%fEU}VL?nDu!QyqPDz+695`i6SSqleolo+V?` zM?u3U6f%Zj2OTqi<9$ljyUy&9sh^d7LsFSgl|ek#T;HHiMG4TRp-nTdmv7S}qD)HG ze7C*N7@n4tA_kv(zZmT^5*}5c6LhEhkx9tebDuX<{|Yi?Y9rC!j~v(Vu0DZ`)EZ5b z;22^A%@fUPCE7;X(ecG*=FjLp&;S=bVBg~jXn%_R0)(1X6#*u5+Hco!@coUD`1Qs2 ziA7SzLhlhNIf|b3C#P3I#3cf!|5LX-H7Rk642+;rYmD z@uvoB&~_NUSc+CaUEs=UcL@E7oS9h0BLw8$romG`>s2f!ZibMA?%N9Z*!K}+YX<6_ z*3-lc7v;;n{M@W?Qk(=0hC@2ushK1+!mi@M`KFcC@^Xj0LM0s2VVH z3QZmS*hE^Z0JGeiP;=&M9iKNy37elC zM6cv@K!#bIcz-ubS>z*E^!OXM0j~)zg&B4Wo@pbk@f?*o+tVjItR$U&4(-{4G-4`jlQbam5LPlx;Kbq;#z^rpA8{9_b5Q_vmg`b z3Av!UZdgC$imn{=MxGBkMlWCd)lom)U@3cU*6Lf;jf#-@AI-kreP|*6zqOEb(#Yiv zW+UGirQ>{;eqU30DjjO$|4C;5cldus#{a{OJ^3eNk0eli&(t+OnPQtOTy_68g4fJ5 z)H6T;R#`UWU;C8HZAY+1pYJ?GpmSDc?oh(mr| zjAOr%E}UX~f6#rLawA`eph^}Lb&W}!CA3yLc)GNGGx~PHm-X7HTU*=O=+&*xcD#jI zby0uXJumIx6PY&;CO}5~k&oH)E+f89cFhn>xe~OvhDxy(FBG%v(kjb{fIk3yx@zYc z-{0^`w6M)LV~HWsJfd&3qq1f)WhS@o=+jq9qq6UosP@#h-(q?qO%v`p8Dv~ux$usM zBS${tV0`A6wGr5AsUIrNzt$S+Vihy>lv3{b)nPBI#X7!Tfpaaup|N%h+gO3?!L0Vt zD&d0r{*gb>pu16}=7##UlGLqqu@cGWd{$Lub{yn6Ozj&BP|uv%yXqfrc0BqH!p^WH*Jjzjiwymf?7Byp-D2%6ZfvD2&y1 zQb2`od9F2DYna1j`o$AG1D?>g(97Aj!%!940)x#La=lm1DsMQ^(fo2!mRrWSEBJ@( z@s35+52kF35-+P$KYRan3i*q*S=EDsCYLUsQ9btsTp5GSlQX=OIgc)x7OZcbp3-@; z-7vu*`+;wvmaa{DQl~W0MnJWtc)DsEo#?Kp|FW!Z!(Ps?tzE=EdG7Id14%Ih6;KmX zKvD;vVWgxobkw*Xwp?@>yWS?Z6Z7w0bJt@-wR*orKYXx{+V#>~+?tBHeFdFiaqn*0 zid`QN*?Ah9K{wf+?v+Z35bike9vx?T&gM~7Nkv(+2lM^5CUiChsVK|@Oh_w z8me_lr^>M3FFmU^4CKZN)meO-W-XIF;^*B7!t>9tcSi*RB5C?IsX)}5iit>RrnzC$0q=HcLjRm-dnR^OjvI7M<_*^|m7Hax`@?u^Duxv+XB%`eXoT0C|&)$LDnygi;+W=FsTx}ZTboJKaftWZrcIYg z&H_)<(Q)D6)ZX-YUk|woSpvNDU;n8uXPr{ogg7>21A&k>;T;*{`BC!f8Pu4QP)ist zk)?0|4B7C(R?3(In>LoyX0zUej?%aJUvQpN1C>k}4;za&cb-ruzHcNv=Z@6JkgISG zN-v!`S`*%Tfol7CrqB6MSQ1;@^(pR|F#DK!^hnqzQQ?f<`gQ?*y63t1HKaeB+<=rM zk-!o;)hNBlhk=<0Y1nswvO+ovg+;C}i>!la#}j0B&5$p80N&8k=*(+hzGKs@9oyff zApUALy(cEFiKE-sQ>6WZOgiTWxz0&9GZzR*KA9xm2j%O}Y0 ze5%i_f@>vSP`gc4d`7su(AaqEbrsujRoUj54lT5!CLg2~W^6Pp2rvf45tQNI@8ImQL8Kj8VPQgMtBg}N8-b&Me1YsY}!zBWjX5WN$@ek4l>(H zhLR4nQxP7MTKJGyBscIru^wanY+PF?KEPJD< zVBDe;G{XuQ79`;{gZZ+{#x&i|*0==Qh2ti><|mF(*C@M*IIu5$Ao+e?awNYz91E*!=51s&&`G=h3!x#- z`wjcefS*zwA4K1{)i4|&cFo~3=EYu>o;945RU)&&{6kppCqUNg4e_-_-RKF#Khifx zK2FAv6|W5R+;7ugsjl`s4NRU)t_$8$H)J!*nP%j9%~Liz!N?q;I~%OZsTuICIb^xm zx#f5R_cxl!5vR_?>6>KSd&Xsb_?&mRB8f`qz#pE&oe@-a_LgX)q%I68`U|HSX3 z($E+oTOpc1IiEbBOpv$Xxw95YK`7%u3LFrN0!abKl6U`L1Ohnd2uS#d)v?j#F#y2c zymbi<_>{YM!zMA3=ks~$6)|1Uz~~5k%;vx($P7DF22!AdqQkvR52VM3BVv?CC2(Z$ zH{3Nr^_60rGUrWpJype8Kf0&W!>x*CJegJ}3*r^jX--)AMXYE*%H*R|HTbr1hA*2+ z;PGE$n|aIAO~tGbjQ@!FH>c8RUE|#E@VC-q0kZ>Z!hFX z9kRAYi=-kac&5sb0$Nm^ZZ{YZ-#5d42~Eea`f+*?(v5P!v%J)v?fRV84&!A7?T5#Q zBi~G7x!{NXyu4|_9HHYC(2F=?RZGb0%rv?4c}>dJ;f;Me*ZoBh)+j(()Szrh7Bq`D zLK%^vB_ZAWJ_UXZqZ*(VgkO2 zTJX@A{0qX-EGVMK!^uA)vn?6Z4pv;wsK;ohZC30D50*)&RIFoG%E=dJrTBlX6J9>E zh`WAVfMO=dmN?%?x_4h~x3-GrWWzE|lhH&Pk-3b*!SkI}dqpE{}kBs>-jO%+u zguxb6`K}ia)x~ehKFKZ@`tGIXJcxIdSoIhjB;UE zGOhR8Qc!tYVmk`1+Klch@N6s(HBV5pjl!m5-bZI1x@n)@fXGmT^>1a(rE4GI(@+to zH6x)9qD0)TEr1x7@;DrGVNrAerXta(?mmh2_?%Gm?UVJDg;3WapNm+mT{UH)hb%F5 zl5!DDrQbX@egKp{lkzt!Ho>__pO@?JvPSxzzy3^rQ37_I$7{-tYzDkMK$#aY#qvcI zSXRU6x@CVgTnfQeV>5`uhNds2=_Zn+qafG1s0%51)&2TL^zo?-bUwGu)t+&b9(x29Y7gAzHwV5 z65ky!oeXeBErkFDmypP;epfBw!lcmo14S?QjbQtce8wO(o`MBmHwfaA>M8KjVFgwf zXI-y0&Ffu2Z!ti8*FurxEtUZXp(vefX#)q98N|&>6hgjoQSfeKZ0nsjco=8h3_7`b zH2Qe!I24C>gVWjx(Pe6&XdT|`u;5PfYtjV}oxpY%XoS)1CZ<HO?!C*?bC;n!MEE-s8d}Q35qXS#3h{#~ z1bNgHah8$@6s*F(KHwh7thmzdqil+0MA0^GKsn&yCgQzPV?YG!^6JRgrJwMG=f@Oc z*PX5uZ#74pMWB{bU#o9G(czSo8_G{Jd{7C>9bUWh`AB*#Z_F(EBs8V~EG@NeoxI#nC7*_IvNx%zQEgxh!4kPX3OgJ zg5e1r8#U7zHi9{)vgt^{W0DNYCqpN8XG2yXPZN? zwV|fxv1uQcnNE@pm@Er}dAQrE|)c2lB^Ypq=d#|sX0Y`er z%AwVRlppXM6}L3)$CiHR&VJ!ybT3vI1 zKpg8jTBf~`#5CHTd)X&v2!IZq*GCLuy71nI36X&%cU#ujJ)g%(_EhV|?oS|fQI;k4 z%bJ2&f)$&Y$-f#Zg&p`qw!d7VQr%AysdnzPeEQ(L9u7yPq*&rOhVHOz2p(tjwoE#7 z1_6#lZeaNrXk!!FsRt(}X7)iw9F{LZYvH${l-Jh_I|7d3@*s}z(w?A=|TNV#vs5L7Jk@V37u z^tNs>!liYNH#5dqIi!Tt`DUSW)>Xz0IwlJAld4Hg=pa-0^vQ0l`V`kgptmfpCuG|r zFS{kRJ_k4k=+ZpG|C$1;_Pmj>gd6upLPh#&ASExB--BVh(}3~_#_JZ@2q*-llSGISHI5M6uH#&66y~4$9-8AdaVytP#;X9(RN+Y4 zQre1@okj8%t%c8UQOYmlgoC>@u`J=ICnB$>Kyez`2Nv^%5jG>uVUffsnof$}*u3jV zWBaWYEeOQNv8tA2CSTlBIJ-g`c^A9F7Bk6NQ;24N5hVx3l?{QqSNv!;+=~d?w`lSOQ>nv?*56!vdn0dpwgB@Cf`>2&YOuwtyGGN?zbpZlJL?Nbz5iM zH0jNh;e!c2^D(d^^9VK|FiWF{zcOq|c+w0C{(-z)^9xuXwAyER*k6gs=%bik&Hh<_ z!jNRp^?dx#M}3tOTXW(eh%WBm?|r!uhUkmlZzg0AK; zy?j+FMxEcj$Bv+{qPC6(I!b~J+5;rP(v!0+4v(y|GQH@sNl5k$#E<|(~>y#S# zp;P7S^tPJeB4wLVygG{@aFRimk+S+e4(xY@MY4(JR`Z}`ZkCRMPXH%PLG*aBi@=JaErvm$rC$obg+O3C!OVN&dwHScT{Sz3OA7-O~tpt zDnKyjFv$|xOW*CiBFI(LdqnUlc}4NO;jzV2<6v0DLh*L0&JD)(D2No59qJa%cd~@N zFak}sA$8Q4eyW?+3@@L&&$8hXr?<6^DLeT;vp)-HWK7dJK6D4F&j?#}CXlmXhk|G? z=~S3Q=p(#!hXVg?9l%5+qNYSygGEu(mN`^i&aUdBvc;2&rrlhRlNh z%li_Q(9J=%t)>Oa#t(33X7TW`0LT)-;)UHKnz^9G5CBf`8BYtIR?StYzH$CqCt;-K z6<3W&nVzQMl%9M*C&0z+g~*xXogiCPjq!Kq%$H(GmNBYj=sj1@GeUGSKL z=?{(YzjA6%~7r1+0EV* zu>riv<(6(+z`wxwLpc-~o&?BM*bDpumjURl>WT|CS3tcsW45%S_6RF7k~vGa30|c+ zDKbKqZ3QU1E@dvNHm)0c*tLy3_r8{2WNA`T9%5xn)4YafHi7~8+73wmvnREHFm+n^ zQB0aj&NioC5C1ZEKK=>J3JKWl|B2yl5RX6!2v@^ ze~gR+z6p`FHSg6*eM#NMJb^QOzgCs><-*=i{SxksV+-Yun4b=ewitSnaDHOpS!ie) z)4V8Gp$f0RRdOv$NGC@~XHS~zIgkbA(2(1cYy0j3(};|Ym1;2?I_XYH(7qqBV1|dx zuDWrXYVG{$@ebI)psSS21781mCu?8NewGYW=sJ1}_$_o&3k*3|-XIUc!WCPz6s7TA zN(dLasB)i-rAeUXp=SX`c}d2#*&J8Vs7-nfHGgKle57 zyFLxVX?Wb`!u-!)Ye5=XYq=tM+4U;qxO&&a@$JgAQEygg+(fgMBGx?`g?zVz4-X+L z&5~;Q7w*qYSIX#OW1MMTf)Rr;R>?|;P{XJ%ymKU~8Stf|=J*8d>@9UH;!mx?BMIruQF z$^qHH!DYkj3zLD%N%PWHce17~bMN-a_fRM@Up^BJ%nEsto_PWKHc!Y`t4zssUApaL?U~uP>R;fDVHBQ1%+H_!;X{Xne8%k!gnJ9!R@_|~?hB_q! z;A>_aoBvY~BKjMKUjOc-LEK%f0C9eAkN5lWMNE>Bi7~=a+_queYqRgr#WY!>t4u+>(v}@jNsXR zmmEgZ8X8WTuJi_)X-=bO{7wTPK3FrajKdR{p=_;F7Bs^+rAs_hDFv`;JtwxRMV`bx zbi4K1J;Wx`SE39u2X+>6#)Ler-sV5k>g=7l_3W%R0^S4s>?%5j2L`Vj2lITI4INCt zHtS|wrJ+Mg8C#pIIlYuBu~c-Xzja@OFjjcUp-BweHd7+hUW9~=@L)^*;6)Xa6XQJFXJ^<0CBhGF>n3A> zKnek?y#*WBo4c`RUf}I2Bm)Ez=%UiQX!NPVzPwR3N;D;^S%NQo{m;)dgeVp4wc6dF@_ulpBAAzsT2zWi+mZ}&zzelX~A$pBI`0pl;Pln2}S-`@8;dW9pOg*XjvDIh_%HxF(%yh zADjsmfocJ_stnC4wfs zoN*mGYQsesV2~3#KW}VTCYwyi`?GJQXmV?TT;{xG{|gIJmy!*CSFDUk6&ny4c|$w4 z)_F*8MH@sv(-42ixjg!t4w}7vaLjim;SS=<3;~cP2~^?uBdVsgM`%J&_jE`Q2^ z%6>0N;W&cKGh#Q>{_!~@M~6R_mm%qaMNUR7NGY4N$2ZK#STN_hXHh) zeRD~8nke3o?ibO-LwlaK_2DLi?&-{rVuEbC*F36Yz-L>ILMeI|*FKZZ8|H~nwffOt zRwUDXO)~`mVvi$~{wOaju$9tz-qaRe8KwOlHQOo$U5?yVwK_5a%Vd;D-Wxwxa;*Os zQ*_8L6dB+`!Ld-lA!sh1B+P;K!_>48iD*b#1Rj9>veh37TLf+uz5tB47BP3wa5<%Q z=KYCVN^q@T+jhj8L3WS8ZsKqPlT~1xB^6b2t=x2A}d)Kak*JwkoYB z#~V5cB6;awP$5&U0)A4mYuT=ou#dO`qWHWiFv>EO)hYi#**GiY$;;- zWGE~H^~My+v+XKdbtQm78x_MQ)Yaeih_VWm3~)|^7qyWZD5m3avsqulY%%uM7Rqd$ z;sZNkdrfv_=IjZz5ajZOubTxf1LvY2gR1Q4U#kcSqHup{*e+-swAeK0u~#kg{!l0B z*b$6V&0^!LXQf{pJapR2v zp8>#O*F1>2aux7$9dWw4j$~m{oX4;phS?NF#$e@ee@N8!0QQ-sd3|9(-`Zh*r}8hx z++!s7@~JrGqpSApSjAa~(#}1Y=o`f4c$q?&ruQugD6v@mtuknE@MX=hrIkUXHY3TF z`eLoWADN^nsu^%JfQLrWN_z@s=G#WgH4}rd2CpXrKn@T=-$(22vH}LaOA}0mf4pbX zT9K_cg44(qFsjqs@Y;ylQc zNm+jj39e9LX97{bnnc)WD6E#ov7&#P{{GHCVeHhLwW(wb`cBNB4QI3?bxF zb8n3an#KpxXo^E5owJ@gm3RV+$ODnGWH2P%=jt4OqRQ(03tikic}gbtR*kYIP#t){ zG%EPiCbvj3Iz|K2^m-Q`QhoPz@sHLY zT7d(x?RiE}8Ufb1)92QACl8kdljz15|AwCmI+?fcOeX!l1q2awijy}uD!xhdk01bMG1!7P>(%mauS(K@W<)so8sA-zyeQK~47VcaU%*oV@V6pV zG#9kS`4;i2^+^)lMKF&E@x)+D)xK~_)3ZHmN1cA_d)w6XiTbD)}F2>rAZwzm!<4u2~CcL-yI$)xVH3-cdsqIZOFLceAa*&J~pT^Bx=s zjFwolHXKMgM18!^M57p=TQ$HZ@E^F1Vb2_95;wkGOIDM-6#i9*^DSJy>Uy*9^th+f zDW{|@5Ug$qO`cGd3=JMv1$@5mlq$JnTeWVPRR_LYdKgAQe`#OFx}2;Mw)9p@R|#ri zBYW0_wau3!z{|6jKsg$pw91{6K~KC{JIS-YsPx-aco1ApZ0%8kWS}d0 z@}^GblxO4DXp>GA)3zQ@*2OgLFyB82sj`m7Il14{J;q{UQqx9wp^L_oG=JG+SF|9n zr2lflsDPVcXvmSG5W?(-Ca1!qo&lu^jfs>m9<~5|`jJI|J~tyc%n+?ac~jXEMLfRp zH!o?`JZBp*ZK>$=;UA||^^V40wA*VpQqLJ^2`Qol@v(Q&6X`O{P>&g?P&lCQC@0MN zjkEpQLl?Iv?+d8IVVo~m+&fzjZOUG}0=1XOqnJ&p4+X3L6c{&XNrQoMq9VQ;`3h(n zgSTO^n;f~!v#H}%a3e=&v~Z<9(&)@IVX(z8C0RbJ_?C->nx-$7BZ;J4ZwTex)+I!( z4JjaF#EE|G3V)3hx!aj>d0uSLObob>gRZr0=6A&|#$t0+*mUx0**YkJX-=RR;VXf# z>ydc<(7Pr~mi@!&oC?x;XKLcOaLbem|h=$PnY`Xmpf;F(fsGeM)EbjK#F zN?CFpGRXQdnGT9=Ezb{P`L-)MQny~c-Hm*YGe^J?gU!<{fQjwAB?G#YikNXD~h9K6a~rQfR~=RRqPUaSRg$e$)Zi#a_RUJ-(hWb2QQ1#=ot4c8gI9vA$C@f z`H7GWDyixN!TL_>($b9WCZm&eHZ+U_ef#ooU?=(X{r<~e5C}!KZ5Nv0MsoARcE7pW za88jNmWSQD|8x0eUWE-mTA_@1X^bQ-Ydp)x{u`BcC^rN@WsrP)-~o3B|4DY@>%qD0 zt48#1MS8(I8p8%S+^*2Y4e;0%ENeZF?pXz&y*6!EhuV~WM!edwFOi9fXLzz)+nP(% z%#Qz=m1ms?$`73+|Ji)P-$nF8P#zd4KaZ$a!wHsd-(xh48Pu8Zm4ZR8V5c?>JrJsx zAKd1g0Y4*nlw&urn9~lyFFXBI%6zQguopQtpD z9xJ8cU$l@Sni|v@^zLI4*uujfS{ptllEQCh<`qb0-ODgTf6_hw@CEX-@{)9Qnam{i zABQJfWLPb|xm3DJkvvNea15dKy>s8xjc9h!LcebfPlpEZTh@fX`9Z*wM&WBx!B;X^ zeQdZxyPX%ik)fIl+h00)wB)H630PU9l=#(GA@|)d9N@cN41hf{_%TM19&otKP6fQv zWsE+Es!<7&07*sS%%v#YS~7BAlAjkXu=wVcg-N2FP*XGsXG_?Ha2eQ))^STcv2J(^ z+@E?aIjq3^KCH8Adur{OrSEgkEu(|zK%vzf(@nT;Cux}_ z-?aarWxbBM_C4I4==bT0^J@%Pb;iQB{Ex8w4W!p{0HI%(Vals0W!E9pV& z#@LnEcRWaaaQHRz9X}<3GeoMa{O$k~4JGr}PAXLTz{aB*+U%t^##94Y$c>*)nJJM) zW;dF1>r7iJNZ#fN_CUMXZleeo`2$WCmRAyH(NZk>noMoEEP-75agd$;&=-@xrfV(BBfu@t8;-3n~%5Z^r%%+o9oN-CnI#ReN#z zFeJpS>2Zr-!jh*A6I9Sv;HlzrYav2Sp)oat+C;NUmC!G-#xSkC;PHqktjZuNJ(rE;v;ZIRR_muA64mE73!Ct15Q0D*4}jNBQ72XQK&u zlGn)1;&@Xp@bE`6M-SG4+-vGLp_2BqE5)vxzI@6e?J)|O#(Lx;wuwiq;Uz=q$UH|6 z9VN@WKwXUsRhuSdS}9zz27iiefv8s0t+H^tQ0A`&zNe|ANL@G`OjtQXxrH`%{AV?0 zY*2mLwd98`=?ep!w##R{yG$18#8;6lWD2Rx_hfEnRpr>-5aHOdoBJ1r4C!WY3a&HI z#wE}1fN{Kdz06w__u*ypNc0{_rVQH(CLJ9>?iVX zA%=7L(nu~G2l8dHU*(lx{snyo(Xl3vpRVt(Eg`&(mru3JZe@YwIo&=nGd_1*FdAR2 zmuI=#pNM^@4W<8WQu@EK(%IPlvxfQSPV$2{{joRQXd3HH%ab_+c)@+C2I(D;7! z^C**Wi9ER=L8W6om(9FgqPa}EeVx!(LbCbO`8zhcMloI$oOYz2u=7&ZGW+7Z-rnac zlW;-CB8aVBkf4*lmpPeIXj~6mDXTDm!TB&H2YM6}log zK=(CAj#&p~q)H;?*t_1_+w{-5479t4%UA;%G=PW0m>`=8y<^TRd{L97q9*&L_sS6*W+wpRvhEvxJVa!hV_}h~3N;|BIvZUK}B+VIFF-ZU%8zCA$ zgcVttN;-uxz0{+v5iNLp)pdsOYEyf(!!ndL1m|SpLpJ(0+j36c{AK1xXF$Ffe=<`H zmhg#K%j`@{)&mV5V|5=B^L%l->cmYWO(<d$U^3(+T4{kU>ek?pu{#rCe~`M8b;92 zc=x&ik7#w`i2{QF-Io#{Z=o6Y=3^CP*k2Jp6w&ZDqmhK{jvSoS8do&+GYklN3`C;8 z@Dlzele94e*KhZiATi~OV1hC16b9Nx<35_FLHlMn1`rUkq%ac1hn|oGnx4fxVGXbV z0AD*R1-N;{c+g*iq>f01ksvJR6FN+os&)wk-VKDM`UmrW%xn$sl$n+>4Z=^ve^wdN zg~sy7W5r*CH}=V#@t7TMU{t!_jIyLwQDiOe8e&ZoinIeoNVUx^l0SX}~g7 zGQrz}N%Qwl<8@#02|~&`3&SL$~tx|3X%_A`jvXY(4J_bLI&3(mI{5`Cx+G#JIehL0mTny1m-8HB*3nY zqB}$Xn<@LE-=bl+y%pWsgO3HvT~DLipJY}h5_tF9*C)-8WO}4}J_%6Rdu!VAD>-rr z@(M0XB%TV`TxIKBK!xm)pIOMe92Wq|^rrEa<&jWOf%5#iQ$wo6qi(ajJ2^Fm89QYZ zmgW!DdD!g_cMrT3umC%)3NiG(t84`HJ45_X70?LlpKa9C9Pmy88YH?MPZPD2{Y>Pc zOcA5`#=x7Ooaem?>C)0|xaoBKwxf;0`D~E&b|uLC1t%Pk8veUWnt`V9!02y1zV`c@ zf#-uF6!)s89PeCy>rPlIb`K?UQ1uHFdY(=#7@ts3;JJCuDtzQ4PBwzAe$&o0593We z;c-m!PxB%>3?}}9j|(WWA|-#inktrmX9=)xcAfaa^Ojd7k}IUV5Q6mcRvHcHZON-( zHEJ3{kiY+^+(Yw2d#f&o)GXeb$&?g(?Zd&*Sola?zowQ@)Nsz0cdr9u6$lvLMeql2 z`tbnFd)Ohcza+p8owt*YDtXb3EYfnjV~{ zF>-!90T=XZx(L5DYfr8HCgwce!iE!){ZMhZVPtA>WX88jYIk1^o(?nzj|MN15fnce z`8dRA_cxM%BsrwNJTH)~peV7sf*^NuA09Aa})R0ST3VsLbMn z%3T0yp1ELU^Dt?ZPjFr9c=}MqKAOM!XhN`r7u0Bk*I?-3krvY>UK4@jo?{rq%Q~(g zums@bof?99{Z1U}Ni|_!30xlswKMpOJGBYn+QGUc%CWEBIO^Ggs@|l15U9fr^t8Y- z^H)G4JtT?_nt68&1Vw`NoyNt()xle?G!-tDY(sn+Y;oQQh+)j_Ks`Xn+3|w0z>o8h zlpB;tz0dq_?)lkOd(9+^$J#=9e|I@SBga$Kh2(4*>flARf$nfTTF>eTftv%Ix_)|7 zyvVBP`c4>c(Z4MJcyc2L10z7#Ay~@Y!8#XOl=LeeSJv!q$M7WHQw{v6zu(t8+awBL z3GSf8nshD%W^6EGeM1idz0dX!doK?Q$+bKa4nzQho;p|w_X??zIOm*)2&9i4kaI%a zjx)`;uw$~dQ>B8MP#fLEs&HEqbuU3k{ZvZ#Or3PRtQ^@jyb1`Wo7KmzlDqHUSS+JH zGx0t>uuOZBhr|Q5EkuWhK>6dj^0*Q;od=^<(TO4vDD$EWcq}gZT$vppyUH!q=mU-z z!wWJWI~V7yS3hA;=By6_Q@XZqYpn8TqvL11=sK$QlnzyhPDpk*EhDu-`YYjK5Y&b! z=vt^k16}5}Q-0LQ?m8|*&y%*6&g|SYV=+7`{uxhcTY+r^oEKOZ*a&|HI3MYFPMh9I&1A=O&x9FpNe<-{|Bf z4|tT+eDZqLnY~D1<5SLhIp^t+=-_VR>8bJ~AJBW0!y4eiUD-^=N{psNXZpuZs9!IS z-ZlUXQ$$$90+IxAUY}raVEZevjQO;|RHkWSv2QBS$z!mN-z1_dj_QTd12dbJ1*&vK z-1-YFOi8_s;H0dtQn3PTtg&PxO_&oBvuXl`ad$5*4T2|_4*LmzmL@IY&xvmAY63Cz zp-vw^gF~U_rZA%8&xCcQa@UzZ)gOe;DS^2#Z_PPaj|BzBe19Y9{5?2E>q+U~89W^WLNs(<2=tr1pHakaYd)KzO5 zlhJy7KVFqw&`7!m%^yvEflkJ^9cv?d%`- zifKsSL(b=37f8yITAmyWkS(a2zaDOKh=k6l*b|*imkTv|<4I^t%_5q=mWv=VW{veY zktPdqwS9?^GC~K12EAJdat@TJO_EgK4UnoHB6R8WhhZC%ys=`Uvxt7Dh(&O)-dVUH zgRH%vVy0q+z8UTpY^O}^ZJ23*V=BFbkq2d+2<94w8FH0B4-3y63O;P|uUaySvEJ)Ap$)~trbsZNL-$!P zW}&-iyMdk9M8!Tn(&cck&3MFIu-zye6OMI!sMR1TizM>Sx7my1LLNDrHLK#J^tNrQ zWX1K>5+8@fwpYt%8ifEQ`f-rXl-*Ip+=%uGYl97HAy!rY$F6aAlhXa`r-OpHEZD;= z$$n_#D9Eq(ifaOFRk>8+Tl$X~?Brk)KxLntWz9j-F>~>!yTzN0%+G;LIT74}^j`7z zYB?fv!xW%{cR)*@2;O!MnB^=?s!>0TQYhILtv`g276-+IE&(~*-3w8jE9o2aJ1*b0 z5=md4CPs2%!^c;&8E>2?O!mUv9|fMR9Fr}-1&S0uXk&j=Gd)vF=SP(hOtT* zed>8!I=-5#ebvFDzCU;;CW<~*2i+W`(htW}=S1eU6YwA-Kw(6~x9QP}#YLnm=V|+^ zNZVE*nt2V3ehe$`?+dJq!@sPhpfb04;|@w(;>G6x^zJkS;2eOJ%?B?;zSu`s4Jsf} zjX$3`pY#?Ke2+}SVNiH1O}s2Pq)Fq69NtEn`eK8;7ZlqbmV!*HWE9O-DxL!2UA;Br z0HQzI4m0Y18T0mi0T3vKz{$Yd2zg4&7=vaTE5(vM^uKU~^bbq_IN)VL2Hn=TA3`@~ zi}QB#EbUPOR{HgW*9L5J6XkIY8%Cag8(yo3&Si~%i$OnxP##eNPqQZxVStdp{u*q% zCuf}OJGH;|<#=4ZY}^Ej=r^Iku-WX5M7?R(gI+fUz|9kKaj@KD^weR&@t?zc@l3!t zi=<0H%{wMxZ^GfQ3B}>WlQv{rl)FDQyV%R^{+Jj-K$y?%Q6HbhIYv%T5ABw#%RDvJ z%6tea2$jE1RQ-a?_vCVJpj#(m^x^B9Vvn>7*QzZ23<}%0vMFp|(A`JOfy5V<*9|yW z$$wYzZHdW9xTh1aQ)DJdp$^b{z4RE?2@lBY&;n*%RFVC&fo3VA#49xEM9J1F9Bwu$ zZY}vxA4zC%12G+*UNYVs&l&D7H5gz_uxLmfr%Wago@03-vhW|GE%Yh{YplU$V7XvbL|NeAIo4F}V|}g?ohh*{*d^UjGp|`#Ac0nf z8{NZw9qH(@p+M}(`-)*4_iPhG8EB3i_YER`13d_UvHiC_>whG7|NldOB}!!mWdt zFx6z0X^nEC&(F$qr${Wd%COR@NLMKDEEu5=Qn?$L!S6R!v|U@DADX7|>-0%OQOFt8 zCox5w-o7>d%khv(1RV z8vAI?MORT*AJm9MafTjQy%ROLB6$N`k;2*BZ}UjDnI_Cvdvnz3wj-T9v(*eSPlo)Z zk?908dJ|>|=8?4p`*b~~eazA6C?v;mY`KRijNUaHK+0$jm@0jzl|jrjDAw=4=DZyu z>0}P{yY6RIzKiS+c-eb@)sOYKCuA}`=|A<%?W{7rHSx?Ani9K1hIJb9M)4rb{o?#1 zH;8*^THL-uy?^>XMGTDMVQ6vmO_&VoG8OYGwePT1Lk>?Hb7tMyI9z-=*Kk^|Pd~h0 z&3`Y9xe&}`jl(?JMe!!7sJOTQmO5wrB@5Y~Bh&7p>~GQ2CSqjmLPkk5I||yu{e@^# z2LN&OWqEE9yy{`uXbv*ufm^E$etvD@NvR-U;t)36(0UASXyn?)m&m8XjVC?ksXPVh z6*+%-4MA(lRZgRJ>sFphTSPTW-Elr&<^QJ0Uh!ZW{%G>bUS*QzTgt z{jP{j+$B>SsQ#Q`<71s@Oy5v3p&JMv!b)!^th$(9LYd(;uecwlR4Ft_mcFH3m?Jtv zXBjn~8}FW;1qyp^CKzUWSa!{6L?Gcm%zvQnxT!9Mn}Q$WJLY**eh_9-DG3qb3KQ%8 zzb{LE;o6j`t_Cpvm6$-wMcxPn#-g8Ba0kjv(JMNO*V)YWz(KRtT=G0WP{ho-VjX6L z6D9mb^~+vM#;G)X_N4RIgg9_=@ZM~&bH?$cJv=~FM4mH+dJvCsdEr&s6q6lns3*j4 zn?r1%*3fS7K#S91ryvhP7J_xNst;<#y{R^%b0AWc7lx*z-?s2*$@Ori_Ih;C0`6?f z=Sl*JUcA+m=Pz61`7}6~WZ(2Dk@e-((guL_3|Rl>D5noiM;*{|Lg96I*jn0Bh-o_E z%JJ~r6d8`J$JYk|#)~Kzt7Jd1*bM!XtcO#hlzg z1`n)GXKkWpBFNE`+4l4aZ*EWf6v+Vpy-l=d;_qcuFOCtXlE9LUKHdu$z1MKio3H6y zS+mm%LCyI=A$FuEf%;s)bRXJC8cAnPxhe&8ly^34@oY=W6fH$XL>N=c-#)pRlTJ^` zbG?aPpclJjv`z6U6QrUCua1Xmo}w&Me3TP^CmvJD`TNC&*vvmL0Y5I*nlI}Gk3STH zA2mZdsdG2!n<81v*v76|s(;vaHrZdS4k3*(?S5N$rjl?)!f%cyR<}MZHikx|;!U6+ zUJV~B4vf^#O3DGJA8dXLzGKU|2XqJCa(TCI{*LATR1BV!Rn;HXkhMWFbj63B5v zsA2ip8JWN_?j-@&>+A$rvkq6ExUxxsn~K(_Mm)S}et}pl5rr>-=Z`?j;Ame!PRFAj zdZ;Krnny$~5)$ol4ra5G4t8OBcx|<`4H;QgLTQhm{j>LmzReiTiaawTkN(m$ujAyI z?L2fdxrqs^qBFPk+#h7+eEaq*P zkUO%$6Qtmw$1SrHdE_5>n3T<~H5!AL8!%^U6{~-ypmV_y8_KiFO9CQI<^CkEIa?6S z^QCmZr_o1-Kn6(0j|9HBM`&}I#GrS70;!5J=YTu;#RU$hw}H@fKgr#tmc&|EFDI-B zZF{UDo|MyCcyDiDH&bBEeO&y!AK8-^`tJ(5OD+<)&7()-+kR#*Fj>Ky@_#v|+5abe zATuMwe;m`<>gutZKl1-j4^m*vCob9yeD0Qr3x4YZsiB)0s zgm#Pj+Bb&r__QyC)`VmwYw7g&%W$F2?1=?j|b_Jh)3KQT;RqSZTLag+6xj z=%Sye+lVUawfqb`0*?p3!!&B=pP9fZt7=&r?knK!vEU9c$ z<=XIag6El6WiX!y@uPu`5WeFe;L2NyP3LrIVhxa44T<5W$ReG)1d7X*4@6J5k=-df zq{?TQN*p~YzHemES#dOCfv(x9_u+asn&ve_m>VIipwL1G>U`aX3mz_qVH6PH#EUF& zS9%to3u?*f3_V|RNKvuO@r7(wi#KXiKH(!gQSU%r2CimO!b6QztNFJr)A=}#^YG)l zpS89NLCaEyL#S$R$Sb$zMeUU=T>`jkB{`*lWlz~@EWjcTVOKl_)77Wv_9S}djtYt9 z#Zvnbv^598TGyemYI28V;6#=;Uz4Jx;?bM44v}Vt8yiZiy(iQHS6+pQqkSy}kXi(8Oz4G7zR1 zrApe!wf5qX_G70fHaoSWByDPW9+YvPxwi6=X}~+#&L+o-R=8Ti$7pR;;rh!pwC&If z98XRB9|?Rh^N!z?sSWe=2_6G`4oe)I=!5>6GWJ<5{m}u0sEs!DLXe4h)00`)lY8;T zRpa4G>RnClb`^QJ9Nk!L&eR?G8`7Vb9_b4mqf%f+-vT|8#5?7;7V zK(z?=r0twjiIizF+o++MS7C3}@LqCMB46jrUrer)+;lhJbmR zK0%(&xe9e8M{ZwLI2Aw@QF$#FM>SLKhj<+LX6a*vC$qX2b`6xP;%2`X6!OOi)_UD_ zeoRd6XiH+w9dm*X?N5muC9qk6hftJY8@Z9J+m|4T3IyE`r4fCm7fZN1WxRZP5P zo3@rLRS}0wWL_W^7!&38t& zo~$A4*D0?$6${9uU-qmVWljgkRDu5Y3UOo5JcP!VVp}I={%h{E5L<#&`;jUH@6zDx zH>-EA*V^mPl}Cs(3y{xT=@eAGz@}JvxNf5SjWfDJBG#Dt=-ZgI1^2}ye9?a9s|Fi^ z*1Xg$V|ovpYfWVw+~+N?YA~0GX_LF+PtPHe2Nq1pN3SH=@B=csC|C9WRAW`vtw%?0yr^5>9Vjb2RNNDUht`{C~c$~3=!a|zq3(_*}vqBN8k6rY4>ZFRveV2M8bpQ;wb-(82{MyZo=^WU9?52 zs1@d}ZY^O-fWQn|1cisz`uW1W_a{>$S$9PTq#`FBAIO9uI^VkOpCsYrX}d3Pg8RXI zrD(zj71tcF-VZcK%6TxMYW_~C?nRLx$0BL&4(h!o4 zn*Pp$WWR=vFdc+lIs(;bQh@FNF>{Q&Iv$3=3AcMamhhy`fdKIsIBugOT|WSMH0#fO zGc%h40z4BnL<7|uhSfyO4Y(Mzmp?hhI^6~)&x`B0EiegSesleHQ^|rk9cVV=0DKFs z%Sty`J3bFtovjf$-w~{yv??W08%PN^%Y?}>L(Nm|=La61dLORYZknEJZsymBbHI@A zt33MS26CZu($^{U$T4*^mc-Y3jOhHjSEUR1S9&gisO_wgEv&1X2y9M!4ou)tU3r*iMX*^QgTZ-EUrz6jnHrX>ukSxGJ2$!o)^UX15Otoo7JWt~!q&(j z_QIAyI+q_{O~0?Uoql43#83f+>o-)I5Q}2ABuQpC(={+Ot1cUtg?_iz24}RX>9d|( zs*leB+JZ$BQ9G2fx&Y8B=EYqEpev?FJT?<+cZihk8KscD8y%Tm27|KhKTZ$Im=uoB z(S?(|Au6Z-;bk&6l708DW!rF^)%}`|HB@I&(*P^Y0%>rITn+L*@sX>CfG1fH@KUH|Yc?^gBqw@fa zoBD!VIVr5)%H;~y?1b})%Ahg2k1I?@EFha4g9*(vZ~=1*Lv4%KpQUAU>R61gPc*G00I+77^} z+t42ut-y&h-~$%8R4>L{+_uNzF_}yN_TVUFPEm9fUi>Ela^r4Yzcy(jP^#+Lg@2yf zFf9TcWMW8LJb~1d_FGG1mB0)4R(KH{4%5Rixy?8}(e=p9R7x1AyMfs^+=M|cA?h4_ z2H4wA_6pE5k{9V}*weTMUMoLt^0$V!YDV;`&*r(RPK1X`$;G_{`tStWrv4t>9^i$% zWpZqyod}&)^N`Ol+-Zp7KP!T^eM2Io*RO7r=no{ zdG~RuP>VQ!r+(VT$lIE8uC(}*>qF3NzR#yu=E^;m*SFVF>gFs$7eEv0hTQ~KCy+Ga z`4gN8=j|O0F<;=X#>%1zos~4^ckli!ew3R4$CLIl`qqRTdS)IPmp(9=;YZ_4u6Blr zPic)T3Z>(mSm8@jJ&5$C%J#Hxs!ddNVW_W-5VM_^gS9 z*$;Qsxq>y?7slDyTBw@{Ln?^geHmchQIbPgT*eQx;41Al=)YEB(_kixTC&H6eih!6 z)k-qZ6wY^nfq$HXb`z2fl#pf>ETq!lj}-u8OMy`^t-ySsrVCNSteOTLw0-OnU#Tspr(WbWsHMC)8!r$%KWUs!rT0uVqQ}DP@VbPgj}LS5`OiByvu?;qf$tv%y;D z#bHs=G{NTXt-fwUzkvw=so4MRsqsG{ z6q%XW|3fBe);PD_A3^@!>J@}S@`I3tdmjFkNW$+pjh^}te~?AO{|}L+xglJ!D5hwp z^y@KuJ-t{wydfJg7(Q%s^y1=z+lP5_c{Ew=*A2zrzXQGv)UK7+HmbVai8S#;?g^30 zmoC2=lI87d8kaARbmsx127GN-Ce=w1ORMab)y@ws);2}aAvM*uU*7M7l2XX~7ejL6 zRkm88E6p?e(q`N2%3P35Q85uFfr#WD6(OTf40BSxZP%dzWvU`FLavwju1md^p)eTF zv*_Pj+f~LG?Z6Z~|8@#3_cEI$8czPnkQcU)GF>^=16Hr1kFP3SJvz*b9lUggB}ljn zeGe2YI46ewnp8e=oXlSC_PCs1BMi>5S=I}4NbM;XQ*>;UhMq0LUo@6!2Lf=*yvm!P)x3k`|A2s#1);=#)D#AavDBIBT3XsX99loc#E28ts3Dp}+x1PvUs5sY6bV*iw`@xwoGIWEEZ2zGu5v{-0yuZ(QSHQ3o z`zPXm0 zaN5#jq!eY^b!;v&YT1N{uyVQ;h2vmE$CWtKg}b1%wiiF3i)et92Q{;3@g2tx53qJPoqm zi~jzrVCV@@L4)Ybs8#racvF!|=6kl$eIBw;bMgf;a`3jB@S)qWr!-7={m+GKYbEL=_KKq=cmAUCdnQfYq|>@(c`)BGvZ%Bawib5sW8)$x*@ehgg__^R zWr+FgyXx(%r=rrhUx@>_Lff;83{Haqz~d_0{@&A1>HQ~h?@)0Hd1M4Sh@2^C{#Q*i zih_1tv}K(zhm4P)<>+>R&smFmUjIq{LSpDZiI1F4ZPgrO3OKm+1+Zzufm3lrG!(GG zen>$Drgu%aBQ_Zf<5mT?$2O7>C?kC#3gS-GVen4!V1fiEtd5RY%8HD0m6clSWy+WU zTq-8x$HLVtl#mvaJ4aP|rPw!wK{dpe2n8*Cr<&Of!ByR0{qq4a*V&B@wkXDfhg{AS z-?oT>^_7i*usw-KZ}Cc`Klz>hnJ_ngI4Z9BgFIvH6nUM9M#~YtOz|AsBQhe%=*zLM z99MG@)6Q$Vr5kOX2!+lgwUaRZBN)W(YxzK0V4=&fJW0A36b&aNIA9^Hr1sH}5OXF(+`pgUU({wClkTq6-z@d{1=u;R=kXHi>K^3&xT z@?=(HBSdeNe2?#J%J;!4ixn zO(lp&i;9Kf@P9AoQnkV=vDyr`o?S=?K~^Q_GiSHnFgh*?lyQPGc0ci$@+=}-3^@h= zjJhZuNACp=$F6fFz`G2Kj(-Y^w*Tj%3Lgm2i%2is zii+2^rQfQjOdn#(d|!M-p`ic%{)NT5~15Z(_#e4FE>9h_wG8mJm-3PEN@7fq)VG)S2FNGe&o8cw5t=v8y^MyyvmTd zJ@eZ_G5)Ts?LY{DIf6Rh9!M*F2deBW@(T&Xw#w5#`Tz;%IB>+25+yoiQ+?33PsG^e z6r#oF*2>sQwbHl_o@$~{R5NN$fzGDNe-maWsHG_$kNS`Ig30K30Z9;}`Pfnw#Ccx7 zCs!fBTMGl8xz0)ro9UF5mg1_%S@6Y8#77@mWIlx*}Xv|55}B7$6ofQUMez|FA0P`m!ff2cC^*v z(>DUGU_nmM-m-GV-G?Br>yP5O(PJh~=yMDTMAHyIp#4J@fQX=w>+>(fAqZ0o-@*`k zJ7edCGaOf(ZZyEBU>o|P_tgT^m%tzS-UBIDqz&}oWhOAT@lRDK)Bu`U>2E%`73}?t*X$oj8Am_l z^~ruTg6i}F3g%e|l`)9X=-*W->uTkzBnF;;Imus052TYy+iFVf@$0AtjeqPtK};BC z#Se<+%>E-9y8a_1%YG~ktA51H{k3JIE3$p{e`mL<)%+w#<=v4#WUo?I&?r+Rj_$x& zsv5CzAgE~b^q;g)u+ozIQh}MCC|)gr@0=(E+E!c1iXK89EZVwOCK4E-CQ^bu`mq#I zduPxd(xBYuq1%HDtl5aL`Tnq;~Pb%rATW$ZKc-epT8EGiOdG zYmJc!I7VFQM_FPu*SM!D4@rV~_td6PN%=`x6j+KQTvs@t{!3xyNt#OYJ%tS8Lp+H? z?GmgQK;9ANRKjzHIlS59?Y!eB0@|wEX+UTVU`mPGmjRz`FAn7%hrWx-_hXnBfuJrR zfPIh|-oPY?N`!5@9vjp+=}$bZZ^o+9UuSVcC(tf(UPlA`7yP0Ak-9dIFl8Uh0n+m%0ZWqSsjm46fMIo2gtI9|kMAu_BzjUXT z)TN6uxXtBtn?~3ceo17DG96S!PzErZK8)pCDmmBSSv-Mkv3J|P0dLOYj{KE|wGGm3 zx0$PxT7B5TSw(N+$ZL29lHX}}eD9!a=e3kYaHw}l7~X-)O?2RWEg8a$`rUa=s}w)t#P}zZm7Adp@=}&% zhXXnj0=9Q_<*?6@!-D(dMi6=2MPrp#JluqEO?{|6{$Vkv0^{xbC7G6QdX3+0>y-qxi(!JxE|*@{c)cy0Ihgm=1v>8OfeJDWl`43uO)*5q z5q@lm8|#H^R+RALH}KP26swYcPl;Ss#cm%f{Kb7T6W`i)(r(!}CR$Ex%l@)WHwBzpjDdoI9Hg^`0+8{ z2V#>F3BiAR5B+ZtS624_NM0^$SjYY(FTb{QiSs!4VTU+-!s$O<%o9nh?;QZ$o1rCy zMw*%E1<82oGcJ+ux7o-d>Kcg+$>jWzTx2jZ@Z;&GCOO#DZ+P=zeZDM;a98Z~aQz2wSl80&m~^JRZM7P9eOx~(ba z`jhF^JKO4F6`e?Ut4?rud4B{O0{~a~$bTQd(w2RiaU)rJ3A?d~Pu_AIAY~qP^dV9{ zIBd!6*ee$Y`=|rKU09NBvp(~*Wawmc8`Ia!3x)Z%;?w%2N<-}S@g>>FK?BQ;VtQ-+ zZ*5&&eJ>EJyM${vPaMyEQ@#7@CoZIzEWQ>W65l9a2lY;TzsFCu8Rio~2nw@g_J+;w zqs^QGmGb1+@TelW|0YE+$MVaDr}XG*2{>7@6t`FKyuzy~LU`FjnIB!E&57o#zQ%4o zHk8~~sdf0W&^9)MO!DR{I@}v%WG8_dlkCGf83yrO2(XguUD-XU!S&{6YvRe(WtoLp;5UN6=ALfK5aF_8VE|c>jj!j^ zhk*BFU3T&O*##J?aIO0)tq<%T{QVL$D^0QhY_Yu3iUH~<&!&F1akWLEAP~1`<=l_Ih+sPN5OXd^a#5h*_oh*2r$HkhDH)86M1v=hyjz*#P7T|rr zu>qhF69@#sB_DP`S`etwaO?qL$V0o}n1P^Ic=nbHnm?@M%8Q=Xe=L*XfauwA;P_LR z^4Q6Dk~!%GTqb@NM&=g}#S$>S?BIS*J^oW|1^)?-t>dpS7zis+*#q>?ryY2so$`eu zo!WC%hbp^a;BBulx)dnRMnPduN?O!??JY3$b>Afw8*`CVzR{wC7P?6s{~I8tuN_d* zMQ8|Q=&?DTcCqSjW#D#ePbhi+EnlN=j$Qbm#e#{(Bk%d9(46v`&8hjX%LhK^8;?LP zcnL36OmzNnim;fH?g|@!oY{-2R7dUA%RlOa!~p{%rJe>W=ql6-*;-3EIKTtBIuB3~ zq&BYqQZaZPN>O*Bi4Pc5JL-~#-v>RmF)s6mq52hhcOY_q+t_XR;o@D{1r~(3#J3H+;dVN1CNI@J)Y0ltcH$R>x$ofMwHH@{CHTW z6G5Po*B2c*d<^lS+e}#77I=Nx>}eQP*uI!t7U=W_i-ek|=SPx@^96^-A0r(f6+H9} z+8<3R%B+sCagY@4Yj}TxPaX1ZnxrCuYe&Vc)cU1x(e|mv=_lpfyxisZ_A8-luCj%q z*dcEJNU)Jm>{!DJ243MGP2!LlTOa8!p-8WxNo{6PL^nPC7y`a6YcLN4L5l-PaPm(<1|Y=}ZU&foTz{H236{8QvOBw8+*TpRI21mpkb>oT zkZ#LC3y|J|uBd*G76%|Tv~tTLB*Vz7z+>SLJJ`OB8lL@W2#8Ojr+Vv`Od9(W-v?qo zP`Z1U5Mh#{JT5%(T~lz{ApyJ-$PAx!$+?aBoiiCF52-|l36!aS35um2av|r>mP8O> zR)$0_M3f`&#DB+k7~6s|!q?)1B_QD#VdoxUcPP*XMXWVVlGUd4#p(;k_D3;{Q6oFt zA};-BJ57fejR^E-VMIO9G1#d!W7?W!$sAu7y>I7ChF6*Xj8cy;fh#{#D__W0G_JuP z8EdizJhnJ(s{|637J)(HQTZRoB=v2#DC=ogPMek{Q4F@=i`iU#f~iSTHl#oh)1VcM zZbbfy$I6}=C7LP0{V0CJii5xf6NxE6gjQ)@B9qPtU(>ygU>fy)a)r>`hDnN>58;ZO ztFL4n#E)h$j}tADu*hi$(~ZpEU;76yZ82aS-AK^I#RScWDRx^+8I36cr!vIf8>XIv zLGA^`667)G!$S#zFoy99D#5H8GbD~Pj!2PsmJEs)3OW>t6^W9vDx>5?Xe=`G#4!n~ zOV2Zma%@3En1KH zHf!k39FMAHqvRjR`9c4Ov2zLzE!v`Nk{dfWwr$(CZQHh;8{4*R+qP|+o&M;mepT<| z{hzAyb@rLH)}CW<1PO@Lf(Pe?)3iI~WfLivUd4sL!QiCaV2UT#B^_J ze}$~=X9UO7k$Pl9AX(JTb1k_-`wLLylxxqTK#iF&Eg{~n1a|6U14}i6+H+R0N0pT2 z^kwab1Xi)^E7*TVBvJs`+~62# z9wA)*nglO8UU@}q;nPJ<}fZTs_N_e=!!^B1N>e2}=p@Q84zZUD%$8{DVi zQka+lPpYzz&vSW{Rn~MsoO$%){{ZFSdfhUMRaT^Jmf?w~+MTHHRUx`Ww7eDfzW1`^ zSr6&kX5i7>>dColQG8KB;_nGq9$Y^eU2->FK;_rJu(E0(f zB5Zn}1IcErhjdk*-Vid}sQc03upeLQ&!6dk4*vy)Y`iXZ3$N?;8ZlX0Rnx7%-=z%7 zl_8NMkpx;Mg}lH6cehJCkgJ97xAflXi9Bq*SU38R^^g8HfA70jQOj;)BocnXU;~^c zL`Ch3+ew1^RJsPY6d+7eyQ~=@STck8%&Z;5*I9p9qn5Ic zWTAAI2hpA}q7>Ksd8sYVq_&E)@=m;kx~z?mql%dKvP^VKKgkz~y%b>rI;+&g$)*VY z?fD%x*_6 zE;G8x{u?CW50cN}IuQ~N7;oWhmaD!Xo31nY%eeQB?jb-6-tZW)|#5?f=_OV3A#>;@mAG%HUWxG5E8mYv;uGk6T19rm;fUU(Ergrs4Fq3%zM z{e8};SI5v#G?IV3aZm6ks8A2|$0fe0{*l zzp=Ro1~(kx(FdKMpc5D*I2>&NU|`a&t>){G;+o_HJPY82nW0{(<5)KXtTtOs)#vMz z@{qy+;vHEM+}-Nt90UX{NRy_bFaY1z*w+OpK?5})ROJ@+q!`livfbxO2{#m7h$mSP zH+HHZeLlF;3;cTR0jS8Qx-X1W_}=|_ zAR*08cWqT)6eofo6-B;zKuh|;1WeJjjw?q8M|XF!^z8uZwY@KJ?7<{(mzB%0DH4~} zw(IOi0f}~1S`2Za{!(<@VkT}0_E4)n@&y4{8(so1L_-KvV%;P8lujZZFj9uT)h7*j zfy(e@>9>Iu0?K&#Mppp0m4{WoTeYiT%{IkV$dy6|)fJ8eXQ)~_A@eMj_GlM;!vyEk z-glx6KK?}Q2!wpS8i++Qekkm``W6F%=}|=v7sTEH`#4ddLQML7H#_p2~RHc zW8urgit`8&%tA&3>Gu~3QcLX%;Nk}4+TO!6{pp|3Kl&5!d8w1h2 zhh8a_PCxnM1v_a7Z6%R=v_0kA=CasNi2WU+7B9*lmKxLZ;<|+O%e`|N;fI@c*I~jk z`4YSkz&7{h?U3p!8N$6`9NjaK^NXtyz}u|{Z?E`U{qPV zqa7HzPRD->5$PFt|yzU8{M|&37KGG67oW8D~bhs$Z_Z}&%h^h=o3oz*LJe; zbzXdp)97d9B*_h4FV=u?2*F(5=_9sK0x|o?HPX7wPiK|^{m^K~>ZI=SeEX*eB%fbL zsl7|5B(LCzg&!___6eWa1DUqQt_hc`{-z{=vI7i#oRtw@%(>q5x*(v^@rIriL0>gSfjkn z8~Bu{M28zGPHehPux?qr4sU^k6e?v=Ki!!#l+ZKF+h-X&rEc~cjd4XR2Y@K%9j}U= zQ^6XYIt5h;J%dU^AGm6XecNkeeIE5i?6KMNrE88Ut?^T!mi>jxLn`)bZwiCve8p7#-Uv*v%Vpu zYW6_}?`0o=q0y=f0`yuq=E-a%#-@r|LSLo( zWZZIa4V(3|2rD8KK+rZ+h9mdi_bv93Fx_JHVFu#nYzAi7mN1fJn(dbnD3y^{KnzTh zM{4VK=;kz|mk;%5+;)UY@Glrx>ImEo6r*GH4GR+nI-u_{NpU~@!~3Haz5TKhK<9CB zTurb#5UqCT&=7Ng=L+AxiVg_7v2sWz7~P*TCqK($hh)U2t|?GdTOe?A6UMx#7;KfXnFQ_d&kHbW_7De(n zFztzzyY|jVQMw{M+eK-Qkn`!&Z`3gtjo8zv9^4~v%X)HqA^)`7*b%AlPWWe+>;b1A z3Ep40|8)TO8-!dQu<^eIum1_}%)mzXAHk~%eJ%Q+^^RM2uVu71l@N!c6_aSS&%}>t zlwgc07Nq%w-+E!Ie>7e-eqq5kheAa@bSnD~gvl&Hr0P}*YmfCINwBZOFRvuW=DB35 zqho60#ez^#Uy+j4b>trvs{)ke_|(>3%3$$^?#*}moJzzdiXECiuk%LMGDlm*$ne`! z7L9|vkw*igO5*&hHLsO&TvTn-WP&2=t9+VMRY9NN7S8!|9LbFH!Y(-MvCoRMt6NWT3v3?kawr3pG&3*!B4mxBg5Nv02M@tU&NhzieQkvO?(KaMh$(h zHeTMw0qzA(qm;4P98a@(Gh5Jak$x`UM#oJUpgaiP#5A+GwjVlvS6&xiMP(j77_?7b zBknT!p=Zd#P|kPjrAqinT&;2=cV!mh2$b(sN)*NyX{ayK%(2lZRG12Hll9LK%L$-s`2pxM|;bVmv{~^mvio|$DRg-@ve5rRdN34 z$HM?X4`G8tIe@uE0q@7PqJRU5;~}ndpl7$^%towA;_Z9Fqj1^fTz0t|ZMS(4tL2GE zo>&BJxMAZM-eREET-WLhp}aIc+o6wC7s2TKPT}WxUj+DS{BMn6f{sSHi4i)9rWc0! ziJ{2)!Ko&5aMpKX`0C@t>K}*(%1P0?D{}qu8t~lhbz!rAS|qnT74EpaRgz&I5V<|@ zn(1a0j}7%^)P^TLsVnhRB@6fbfL0-z>R1EJcPx*4K$!daE8 zf#bYP!9Kt4S8;P8(o1L;5>N*Wef8RN8l*{tGfcVXh&H97i;4#aQwM9)gQl4?rIuj2 zITetADj@FT(s+K;n-R^%`@-Wvfup37?Z%&AU+atz6&x{;?1gxXUY4IHFN=4!#O#n= zj8D#DQ|2(_4wtb5{h7@;r7@$floty@h8<%ndn=3?1?G6(3a|0pC(MlO4RcK0r0k@y znZ)7U3PRCdXgxn?vly@1*4YYHIe8;wZcv%tcIqXnGTN4$`RKdTF#r;XQQo@s5RHta z`qPKZk6+%H7#oYWai*X_`i{VaINK>CcDiNA-3yi7g*UbKb})(AU}Dk8@>zY08tf%s zls`%C|BPPBbZEEx!RTG>9&H3tRfuiPIW0by6-N7X<+AxxZ* z5MTAYvoFsG^kle!fVf-y5wvy9K}r&>%_V_$eP7t|I;pgy)1`+qCnCbM7}{$o=mB=i zp0bp#2By36qV3z`owW2ra!*w*LIk4I*og?&5kY;)DfVrZ(x@u!i%o;ey=sh`xO%M<8hi^g1U!|!hZH*Hb3|OtE$Nzeu+r# zhf>z`zXv_^0LD!PTyt(BF1F;(!Ivw{@h)D1!2|Qo;#mQ-8O0(m*9TS2FE;n4&KYo`ct7E54<}^|$Q719yxN{j_8D=hUb8ArV9FhSC=!?u#Y4~_gi#} za8nbMw3_B`^*yeJTTQ%uJBE$@qmqE%bngtxd?fJf3ap^4uV!-TE901>LK6Cq>mOd~ zS&HPk@+aEWl8f54Q#eO{{NFG|mCBuGfF35@^JEQ`Vcd}%3V!>+Qu8uXkeO;q4PBga z@qv>1ntKg1TvGX6uv~!YW7!xM{AH?19P?<-EO?dmpBVLc^JGsEJZDPw8PH|n#&$tREvR&x1zc75#tFhy#C6WJ#J zN9Ob`ZL~bu+ZIbzJZ___4eHa5^TugsrmB!A+~$PQU1vsMl4i`v=p4Z7;`i2Bvr+DU z3+UxNuysXvg)Ok9z$~wG{1*xT=lxUxrRE)<&oznA+sG-fAC#V>w?73}27Tm1-2Qf7k0wP{>)!!_#^G_?;EC3Z?2(c){@1%1{tF z#4{|U+!13s=!3*%_{(7+n8+C(3K1h|P0N|!5v{uHlyNVZlN=p3)bL6aJjR9ML3AEA zMnfp59i9T}+{0low!A77k$HhMX|gJorQcdvK@+k^sZrn6^AJQ+>m|t!#Zih5&mKjOmcHkjlHP^ZgSZ$<1#je$$|4YMs*}24juF z^T-NRYI?7gcss$ zZ?J5EGz&u^G0zGv1RBgW!>i9rJd$ka?x0W0QuO|C~v5w?3w(C|GCHjBXYEc#iWHhTs zP|eLF@45X43rtVEkvvFPJaPP{kZxOgw6K?2Wbhf~ZM zV4Lbw6d7;hQ~*A%4)#@ZXGIhj@|Rg!Gu5OPknHDKjH4uZ)l$mam3HsRu`+cI^ttBS zBW7j4mp~y0o0F_jP~PgxNa{(>N3BJC+wqt?%+vz83R9e(GghcBG9z61EVi6yVOvsq zQ{S^8K}x0QXAY{I*Dgq_*Dl(%$pnLUt054O9Xrj`vzBFXHg9a)ivE@4Nxoc;2hBBM zRB)nNPX#SLU)vL2Sz4;D&1=krLq@0UThUX@&DsRK59y3)AkJvWg6ro9f#&1(cGY5) zD9(%0A_yQRNPzz<9mL7uEPBACwz*pax!%3_1?emel%dV0ex(l1c-C#}nQl>~-m%qo z5}1iMGg!`k>+|j|A&H^sO0cJ}ZUUgmPok)i2gfKkr{`7(#DBb+4YPD~I9gDQ>E6ib#={G1r~XV071grA-$yeQlG$KhtjnbUld(3zT=5vy;(`Nr4K$ z4i;yzeE-;guQaHrr8WVKSH!@)o_y#(7ZXz2F`gL_eX4L1>1Z8>Ngy!>48?;Tvd4A3 zQ0Jr4h47pN_p!TBeGKo^9lt@sFS7Cnk!ezEDxCRDn9tk?Z^t#$g3Gen~$czR_eEUWgT;YmSl4l2? z8aST!9T%fSgU86m3wE=tMzyUZ*QdzPeVI%h0AWl4+I|%4q@>Zl>jHAOIswew1ho$t zritbB6HULg1ZdUf$S^#Py)edpXT6-8OpE!Dfde|bFWu~B!AD?sjF|oC_0SKk+{>7> z#$X^y%hhcGyhkqBH(|2sBE+xKIHi%3JMA^A3V>`iTiyQ8!1#mt_rU;Z!qw75EdWVl zW+&%823g`mAT_)ODpOI$tPZR(5W0nWmdT7ds7e}4uKpQK3yLsi*+7jO75nt|&4MbGU_b=5K>JZVWEs}BO z$BXorKJxrFu*v5hFTYn5P&vDd0N>hJgW!%)MaphbBg% zy7wX3CT7M5CxuB9?BPuAS-|ES41dfwQk&gP!$PasbSN=o<8#ClKKv>@3AO5ZYI1oi zz;KFKK@}2an_v(b=YXCfu_=585ti7%On0>tV0+s&L2~RAAv2C~BHF+c+`OE%ngBP} zoeoyP8@ad|HCjJ_JoM0u-x`NCRrh%qB{jX+_N=6c&@FbDR+1D{Wmt{8Ttb4=Zkn{-d-jxsvZ9!KMK@c4C-3lC_`em zLG@fzf^mh?nsLplp#GhGsf{;7nufkj-a^l}wjsMl+~T>oW1ATeD?{JxEg(2$qo{<= z*On|KK)Bpp3LLYS{q{qjWIrUxB48)Uk2pPZsq?b1ZU`x4CRIrIQ)?jpyg9QC zgd)WnHL`QNY<82f*%Yw}crtu(s=u2k_`clj7Po&-(kuV$Kh1@FL&yw@5tT10wM|Fj zX^8}`ts`vq-HW7c*_|ExKrp8aFZ=AKy<>(W#e%9$$aM>YI{xZ}={A(N+z9&3q0&Th zYL_+|^ZAHAZ<-m|D&i`2+ygN2)(*fFK0G5syCVEocv9Z%9}dNhph+3od{G zWkal^rvfEdeS6QqfP$|XDO)!h9vmFpY{p!DU69iT`HnXrdh&8g6FnUaC+vi^1PAiM>QOO+8I4^p5IwX|49?e~iOS*8~J zf@qs7?QvzJ`)&iFC%8bZzNi*B#RFy`5;6)L6}rU)Az2>0nki{#cU|JELA_0a`D>kg zTL9u^+2r>jLl)2OflP^S##(o;?Q4F4i;0zNqpTxWr2v)fs6J0e$AO|wK=66mo?kWn zYu=<)GbEU{NwC;yDk-1#oYh6rR3U;@iz6q$2UW&+qt>rJA4vD3Xa=Bq<3LE@tFWqV z&sp(uQnu|4=;CaBb|I`y2kE>nyV!ylDa&zf7)qQPH1gioZP#mHrg-pOs{z~*$yN9> z-4d+JG_SfB^N8oLv~+W;l<>BdrgRc<&Z0D&6h#FPgS!53m`ctAd_(ucwNYGDz1ZD9wZLT$O7~55XY%PvVP)caH4A5^e8| z?CIF-{C8SOb4s{P$FD2>{hozUqw&IuoH=POlgzMSb zG5tvW3O9NR+Z~Xq&oawnnz2#5Wp>9G~4^*aSTAy z&1|)ERHt|v1yrh7v04D+Tn;^3#c|NL>Hgl(uEXd^Dk<2Mr(`e%&*M;UC|w1?za&KZ z@z8aX9n;h##27#YClDVJR@6rFWPh-M8pwxu&LEK2==sIT1C8nwJoaA7b@32BA@*95 znT^5xuN0I~h=<=p3CYX3%(otyO3RoVHQ%02%cxdV`q7vb%joBXigvMB@@S$^^h7V* z)F7<4I)@F_Y~2C5{d`IcARN)Fh*XX0#Hwek6A;-zq&1e1Yp0U@cmdB`3vU=%_(w>s za{B_M6RFohkt1f%ia>QBv4Ip=n*P!iL{!(d4N625jFk7JGp2Cuh=yI$c<+pwHUV}14K2Av|McD;Cxzz?+0z}wB7b-Xc`;D|D0Pkp zrK9k8^BAw7hbHm2y=tu~&#NO6TyRS7p^E&X`dhpPkBa|bIt(BT-2(k2!N3~lZpkq- z*SS?dcYz{#-OyAT$S_#w9<|q z>sk!$Lq2&7<_0jZ=2wBdfK4t*3=j+K=npFx_B$+QBI?gr;tT&=H{9P! z0{*Ns5GmM%+wq_xr6GQy!x|V)nq;#~4q73if^lwRGC2NIGnVmZCKpV3!7ncWp5zc| zY@XbXzuv&C?rJFKH-0!EQbm8q<&r~hc0#t=^?Ci4*&FW1j^?Nq9mO*4pGCU`olo?>aXV}XXc5Z18jhSqwk&!Jju z93zM3uEa6sf?LsbrA7HG)y7q2;&4Gw?Q$iCg`;3xk!_X)Ss=u@NA)T1ZMqPFQ=@RX z7hhz)ykh6EbHTl1B4Y5SVn)Ei*A41YJmFC`8@Ab2rlg){cH;7sCKi~)IJ=~Jc2=&8 zNk7nWjTbPfPFy?NjyQpI>d({c{A^uMV^xV}VO*du8Lg;~yIFtVb4v8~AI}YF3_BrX z5Gu0z3JQwxq`APNT9Glmi zmf*Oeb+zqxrTSS$y(cJfpl=F$VpJk~@wKYEOQZ5(V%vHvg)~Z%b4(3e-$!FfOcig@ zUkF+G1^-9b{>JiYA(svpSpf=7o8Z}AFWIkzynig=rt)twKoZ?tQV=HyRQY*%&G^Bc z`#)sD1uL#2X_flLb$*Ytb%xp+DVXv?$*Kt;eYw(1WQnuGt*RsG?BV`Tzm~>#_=^0={20N-13=}Z1WLzWLnManGp-!XXIU& z8%Hh$%UM(-ejzX(r7fJ~m(V?j-!!O4rv*!&dZu(@RNX_DmYI-;4I}Ynf1wo6jQ9HO zkns6!9l5SxtDO9}wJs7YlZ1BoII*sL!{;2V5{6%<92DcKyOT?@&c!~5jQfeO6X}Py zifiPD?d7~i_+Ait@widoL+k`Y{-vgFn6L)%)>&fU9z^EP9ij9n`W1`dEAEHNj4^o zniWig$(@)Vk4f&smfs(NE)y`5Z>rK`{V!T?ghcJj%jwT17&UX+31#Lz`FfZ`3dP+ zt?kSAW{n3>Qr}!5R#h{&ie$-;QcXKyng%@?+I8!(qOr!Ii}PGhA9dAQ6GiWU!7k$& zdjk{~5`;L7=s(zO&m?Ioqbp-jsB6^-s?x5cTyQ zYKvh(UX{|iL`HCVo;R!HfH*OiXORTWoV@?~_>d9{OBT(lhk!Zn%$81)|!2Pi_D$EKNM* zAr!Vj9gx`cf+$lD;sL;U?jznEJI-yS8z-41U}Z-^1ms}Trg?kaej;r7K*HX$x( ztQ#!&l5mY(>Je_#4?JKkU&}9;3A0s!@q`$LmmC=^ad{#UTSoIkPfN|?4 zK!M|EzWSVyC5f1PR%zf+3F}mzOVzB0PWx|=-eQXh^Qy7|P=y)JdD4S&`>_^?EIl_r% z-1;Ki|8jo-0zG<~B@uw6E=^|~yACf?SGqxFPEB<-NVuzDd@;@ez}b}og9C1gD204= zvtps^C+eT4iUzIiYg=1S<4Ur4`3T3%SLyS({DBNGreXz~$+0L?Y6sZzK ztmOC!PNCIpheDo!JL2{iHxYLig!}%uq_oV+b+Rlo89LwsqS_Fm?XPL{562AxAx&P} zg2FH~f4pYK8d{`GO{UY!Msgv$N4fJhyCndQm{4(DI^0@1)oBEL?+*;Q0JC{owd*Cu z6Nmg8O*G03+EG^C;jy$tmSNNmhjX`4S@BOkp+nqSh=JOBMcQ=<*S zoVk}l?-x~zSl5dLGB6{cKWa57zWy{()%Jcm=oTmtD=FOvJXveBvVG!_71W_E5%LG(9;5}5fTZD?%c6`>~En>O=XQDji}j! zl)9vyM#?+Z@=dn(04sC)l_%L-hoxrISi?t>pO&4vZ46BVZuG+Xe-hNjazdR6_dHy@{~;dN(>H&j0+=#{+f z^IjzeqFR$N8HHF)L(V~&uFvSjv1=p`4<+>U9EdBLPfR?%1aJvPc3)h?s&vyN+tt_J z#$BQ?sMbGc^CK6H>%@NwEIuULFrqcW_LH)UYBFh1z@ZpRH7UI5!M>t7_w_2sS}SuQ zTSh(g$k^1;_B)AKT2&P_>Bu>x}idi(npN_l;ipjcG z`7UPEmrClb2xS-&XPJbhWJ|WMT~Q*OoUNVTBZ0VPt>OKOkbbFp!3 z2{0A?PVTFcz&e;>6`dEL2t*IeP7p~?<<_a66AXr_#VnJ42$1}PY2qYE4I#?8kKd^8 z+*yN6%Mq%2L?YdQRnxA9af?GBN?q_OY>r?t@#@8=1pzE2cCr*XDm_J6Psc_D)!P1I z{cnfb1%n|-7OoS67A37;Vw!$O&=DxNFAe)n6T118Z76AHp5|F|0SxL%`*}S@`Nwi?;0t|fqGn$Va zejdGi$yypxS2EHU2x<=O9};EwMNN zcJIY@R_rd_nXNXAVGoN}dXHm@xvL7)XcP=1(#`;G0vD$H1TJ=KbDyj&rC!JQMTr_l zLAR%=2MG>pL>x@wR5d8!+Nqd_BF6(2OjTXMp$y#`93VI(A3#EW3N=cHcfh)!2X#-e zZv}_;N8sl|Ke6Q}d0&5)czt&$q_*KIbhG+u4B)f2$ml~IK6B-4A)8SoE5u0A z!#@^8H?*~{fOTmf{~)=?(L5ny=@iN5|7HJjwe$kOR}Q#+Ty~;WZWtCLjhmhfkVk2i zpsH{>e`)G^W@ifk74>r@JGo+wHsc!O_i@=BK)qdBwVVHjWCkHL@0>q=5KoTJ<92emM z;Ea>e5wq|#Q0p4}Y2$|$xB-7~d!Q(l%fKTuO1-paGQlXWu(SUJ4WN)RhpEApzX*?S3BzMc{CxsGxY1u4Be z2#G@AC2Gn5D5D7xrO;&Ch;3o{U<`na6v{}i402K{wN9Epw;EYN)8PL&Hf4O&Xx z-Jb2(ZWli?$_JIl3&}d3dZgq?+*Ww)%MT#{Z~hl9+(Kv8@vQ)HXL&S@g+xM0LV9_b( zh3{8FwM3*3?~E71#{YwlG3%~mpFVTtq}Vs!o#!~cL5KJENgA<#Y?m(dqc%V0XiG{ zaLpQH6?wJ-TzeEHh>dIznaq-Q{enoplQ~D2Taodckuykw8kjy*=y* zC}&SA8`2(C*Dcolqp2;E9Gq=1j}M<};-iH}HTlm%k!m`$*hg}moh)5Vn^3P~8$W<& zxBLd@nSmo_;zXYkLsAqx(Qb8}l1Ky1)g+*V1^EkqWcT{rkg{qPkS6cs@62Tr=vD;BC8;f_FmR(dlQU`W-{)xi$=|o z;LxGTGt)g}P}#R&xt}=0;2IX$M((9k^P&326y4D2uQ&#c7|~0Oty`h8?PohHPZyxi z1`JoKDFcDp1yt#hYflyZCXNX;Z4;0yRJ=F|`URq<_t8@*nJYTrDwn5GcJvY2euKd; zZq5yp=f-XN4WU-1InMAUQJA5+)&A_*M)~29%(bpKGPt-;m{c0|%+32z`@qfJr>&1E z48rIH2C$wpq_Rm504qJfqJ473DWo3Lr|1$uJ~_tVnVgj;G-;ZBl8Hh-9tr3VTrj)N zLfD{ub)0x;H+6Eq#%Kc;`t z1kSnc!a6|NgHQ_pNlO0{0cbclIeb;e36U1j8H!6Duq0gZSALrnuM0~qR1=YmmuPPDwXDeIg6OlofS^nx2`Dt)qycSw4fTXXpT!~r8J${yLA8lSp4{Bn9P%7^vMYPE)Q*McMc;*wy>g8 z9Y~w)5AGX~H;$IvdXVb{mBSa^V?Cnl`oM}!Kx4VpgTwOkIp7PpAB?s2-%{lN4$hZ(<%e}kFRqiA!5>oQ$f7YLix#Y>qWNlQ9xUxk~=I>NzoKQ_>=fH_2j(d{ z_P-crIMuDa-5Ad6$0xVznEJkl66=sS&6$`jypHo`o<%AHwXKOnTTS*`{~kA_@C;&# zKjen3Tv^(Kd=xWcL+55YA0Hpq(1gtOM$%3_%rqW*Yj<%${_?&YP0~jrpx0@jIPE$n zr*3AK>3fSFMBfa#vn>CLnd{4VGDS3c4@2v0qdl`Na9%M}WrM7{7mn_7UqpHB4p#S8 z;(rZ6AVrQKL+aI=B%pk&T%;DQ$*#U6~Vzq5{K zYuB3%WyB>$>F-*fr<)6Q5H6#&eH@?aH4N;HYA6AIOYI@{(VKhM83}ANHa6PXNa@JP z9Ep@_dE@6lta@WR#Ef7^`Fn#QF_6Ee5h2Zc!1P|HObyAgdvng55b%W~X#FVkk|Y+B zYYz-Ni(!s+8!Mb9=>G8*GQ8P8fad)Vp>TuCi~^Hzom(y5SFW^N3s`TOe;&-W|7{Yk z1i`rI3OQc$+UaR?7dMW3_X455zY%4E{Df{N6i7pI-aGiCwXJQ=dC$7;*6_w`0kQ=_ zna^e4bNxMO6r7k;Y{%0=m-1fE)U^pFyAx$f?g<`Z8dEZO65aeKok?{tI&|3(YgWXf z3(n4NDgx(r(uZ3(RQl#M#{(BQ4ci&|vOclh{e7hcN2sre^)=Oa=+^Z5SKEJaXl9BK zvd-FactoQI|fjy*zve$YV!e^QbmyEFV-Xi zK`(~zK_a6K0v|M(LW+z$MG{-Q$Wq%4@e7_&zro`w(~AgEgNXSHASV!*4NwcK<^3TA z!~<|zCSC)HVzGpx*4Sa%7|5!MFf;-tCPE{Z&Svu485VfmTok}{nbAyG zAT)z;_x?3RNBnJ{onz&@$I2$6jULwI!{YMJKt49>vo|YrJ>ZF8G3GsYUW}wHH*O=R zYSU!w*}x*7=O5vC?BbHyTaL2LCBY@uhD+1{%pt7UKQlkH-xb84-&K3p3^d0H_Py{k zoymLxMuh6#j99$?I^A#K1VR?fyTX+I#KfM~-f)esKOw!Ppa|EMq3qQ??N$_94}&st zUw+7Ur#5KXSv{ezhv^^P4!G9ek=sg8&3u^B@@$`@H(bY0;GjpFJ$tk0;P*7p@a!(we6eAM? znA~s=zzyHvOYqb|m_dOM7heU}3!_u?u}QP}^qT^B1d*EQ8j<9Z#DnxfgYUj*4ee&9 z%g-kukfb8Pe+T>w_C;MInNQwC{2#{NsYw)Q+14!Ewr$&X)hgSzZQHhO+qP}n*19WB z_rtl}`(giu88IVAW{w=6K;gg|LLH>ZolGHet5^lt&?rao8PPZ>6#Bb>byfTO3f2qULTk&@yXcLlWrJ|&qB#;)VD(hYWke*92q?d%a_IH!7 z$1YHBm+xC@(Qvdtnvxj7G!LSP?)rmsZ<=)p99(Fmx8O^}&Yz*8?@NQ#G+oOt=qrUr zb+h2CWdQbRZe{0qC81!PJVS50{AIju-As`^BQRecfme+fJ4rBJV#*s4pbcBQX5`mtLUma2_4CN|$^!&D2AD;`bRGn+^(xjbv?wu^mHY1 zNZgWT%hfz;6mQAjOT$PJRQo|5t9R&;W#o*tu8AR9jS|)kQkyY2_(c5CTbmU}KTLOb zq_O!b)-Fv~FG7#UpYgBxfJ2Be7L5FKFyLvbHbT$W-ZK9{#2J$0&3U%JBEM1Rn#FyO zd@FZzPj8&)Qb^#|Uk`{{8qUE~5_low6+;L|XxO~+IGws;wS<#Jb2GMjO*3Z~&C+mF z{XJ&=hF-O6`;ff?s7i-_>!_`J6M8m_yLm*6*&=!maUTX0NIc+X6=BfCGFY@wGzpk3 z#jp*0cxUEJclS4Kx5d2^OI;}d;Iyf)-&KHF%Sy0B#cl_b92@<41IN5GKaOALLnP^m zubt{oNCD90E`;ds5gfsl&OerD;Yi|{B%FsgzV5+-a-yD??8khM|IFdTWN&vG={9%- zcVZr~)&5&FMRxJO9TXJhE8BVAmkc#H*^Zqy5AI<#GyaG$r(=jhLq+e}1U1mu&_D~u z?%EOv)%NO`fWBk=fbW|xu%k7Z(J;LWhh3;~_|(kLs#NTV<8euGe@tZv?(I_x(#^p_ zQ&z3QKgvLPWJo;&eKG$Ffj5keu^J-tF034{Kvl3mVmR*dYQz~99YYQr6w=+K>n9u5;D zC)@vCo#$Xo*j|l4!{7l+Em6!zs+)>=j` z7mc~<4_vprwj}8xWfqs3;;?Nx(#_d?vw8*i~*q0CezUh(dP69v-s*gQcDMbop+F$9tyfiK{-F)Vp zNiz>?G^#583maMr8-hdHWgtdJo?%?(tzDE%&9TUpDS2937SCvWHS>6*_tu#lB~GW zmmTL46^M%vCW|fK-f6@P^I|Kqy({4_m}}d0)L`l1SBljqQPfySGZjZsR{xNGN3>{} z{|C8G=0vG}j_Xj|U*AYhf>tn)i-PIigQH&(+?w}@9b6z6&HKq2VCbcLdy%~!vo*+p zo6Yuw2HTC}1><~Rp(Fw#ok;UG_xp9b2*m;#KnGH4MUKn~D}2iyx8pOV*t1*?Bt)ST zB_!_KlvykSL0Mr7R0A~uLbE2YwvHvj9be6`g-xuefc9K&Q^@$1`4zMvQ!XhN02wsV zbBo7xF<#@ONCUNcjfj`X#f*QtSz4>;B&X6qUfRaxc;+@^gBV#sgD|pMe_~rEwi?7x z8O;W&&@Ugc*9Dlu6HD#c0C1sL3oSNDDD{&#RA&-{oJ(woQMr^G0^FsmN=zOE3Rpg` zXoTxP=9iBa;b7DmL1j-YQN1RfF@++s1K)-k9wkdg&TxUo7@M{^s==Jnu&QfZC7BT| z1`%{13HPYn!e<9Q>e^H)`EJZB2{LUgelb3nJ2)rd8*zds>;S5Z6YeiI43aqX!6~*A zz|<7~CAF1~zNsoRCV!$wdb%O3Sd`68SbKN1_k8NYDYC9+Y}p1nfb%`5h(uo2Oizre zVZ&4J1ZP2$IeJ_bKcGZbLIddj)~)wC;$r8?z=w!ekqR{Zi!&$e;Ts?%gl)SRI!tbg2r zl&8;%Pl1gIbOyX5&{9ixSoXiYlD?9`1A(83$;zwMElvs=702nx9rflb4kz*6vc8(- z*Hc2}gNvLJ?#7+@;q+BPz(LsG&!~|hP5E_j(x~9BF4GW-umXzz}U5kt6hzPa((tNi=e{h3!l1?UHU2zff3@&`*gZ!=hVjk)QW!jlPeh1q z#U;IfQsm#MJRBu_-86_rMe;2|XRLiMModYtcfABnC5Z)g#W6R5KXzPxI4L+9I=M-`K{vCGc7I@1e@MYUs?3##Ne6ti z0D~wikVbD&pI=b24yh@z_vS@};x4=w-s=H#&t1*1$(}a?@+G!l>y7ItNcS+Wu2Ejr zIe@*SLO@!&6Nu?)q0S|9=s%a_XN4U0u{Se1Wt>FMQ2U=cOjXfgPwQynTda& z4`rvv!*8bhD(il~zVr|uX77Xkh{G<>#hwc!ucFuUykc=@!FQJ?0Uj?TZRGD;-piTf zXVHI;A0I+fQ!xwr4285JLk2Z?5QCX*^Ppo^Kr|3I937`U<&xT2)zsLK0>e0~I4bG| z)qz-Hp{cOxAS5daqqtsA6E0x-yjO|7T_q4;s?E5xbsF==b51r5ZpD|hHB!bCk|Ha7 zu)CBTvGnav=U z_6MYCL(49Ee%LBazG}_HV||cjoR}r!gaRS+fg5RGgwY+VQH{x{T}UohbZ)kEVLG|Z zl34pOm$#vULUGVT?*8@Fv@x``p!q2+MG_X+EpVs$sZqjDB#IlSb_$-LgTYAc=c}|Z znA!D_%B)ayAK=@y8E1$Gd;VYs)2`}~7FCisB=PP-f-|A3yy%X{2{V@x=)P5~BjgYJ zyuLSBHc{B> zMneK<5J7~V4d49GWRY-TISDzCpP$tgW2ewYT!H|QhPcby%F9lzE`C?fvVHM8N8mn7 zH;&tXBORZ=1J})w&?@IUH$QS+Ijs%}?K?IvjGlkhb4xwjH?*vXziv(QNF<+o?`&o8 zWQF&3y?cN5=oq<1S0YnUIAL#p&iN<}%aAjuP&(Wy%; z27c_5F3WjVfx3iNGS?})w&v!=MXq?{?1fTA+}OR23bD8~lwE(l%Ev13>(j)3c;i-2 z0Mqzt#mmM#p+$3m1?hC+c~*Bkp!t(VJW@g4doVxz#o{l*D)HJq?*4dUOm_X5z5Doz zZhsje1*RG+DI*b;JSwP1_j3w~7z*?&l)|{Vx$q0T@Fej1C zYr~MTyciHvT6Nn!rHM<<^tFy7>M}jET(E>ulx2Cz<6P`E`P(Avk12fNhshG_4saae zlldcz;`kHCK9H@Ud^;p=RrrgRpTe*&}s;MYOi+`<_?kn6K$`FdL0wUIcGq0en2Vk0(Yv? z(v)hQlpz$)%AVuhmq?2ln+r5|w+?DZP{hOMi$MFViGnN91+qbUhE z1Fsc=951_d^+0q^SI|80k*wMZ`K$Ll)Nt&o`w~zNd3L4Vyma6PU09^KQbD73h5}1S zM2zo^xp)@9DC-zlz_4bbIwswZiFy-{2j zPX+(Y)~7sC(Ft;Hz$YH(D-JR%SAYcA3x2ey97)5SVtF8eF>2dGFt}}E@WGq2WmZrc zGKRV#^tB4F-$kYa_}&|h-ED%o$uS+`v1wfqY#s=Mj0$Hm_`L~nT!WKh04+gCHl?PB z4H|S(L8!8O0aZH!4qA0+DVduo4MSl9>2nAwst#G}?eU`hD~uvbv*Dcsl88AM>#$GzB^$+d=Yn!$#pL|6WrOK(ot9oGra{x7VX249s+RKuqCu{ z`VV3;{~9Wprv;8D30pKQ!w5?a2pBP=XMlB89-%j=y$5fuh5#JnxPFqO-7GZ4qM}nD ziEo+Hh!HZxtMGNJ1B6L>-tJgJ0@Rp`&)b%8im5XR=UKq-350CD4NMs{Ec|EsQ%q)m zQyzbSPn3XZs8}~%KVX;1R->D>H?-JTBd4|1WF-##4gbyI$ztl%ZiUaF&}xBeblxMx z;c)?>4d4l2wy5*v)UZr(@{E#j=(BS%d*co;7#!tJe-@>7Huc6xvU}@R);qSE?2s!3 zKT<~jZL&AO8-wzxidPHyKf{|fOugLk4hp*oH(=O;<}6F^QZUf1_t-}2S!i1hm>779 z&>Z5+gAtnRD#MZXR!-rTg2^cH4H!N)X-ud)d=GBflLmwJ>0Dt2oU+7jK(r?TNF~tN zODAOB^o`ZD;!GzzjJ%Fk2Lw0sQvn6NeW&)onk%8yf)0yZSd=8{7Ll8)D6Cdc&1kZJ z&@%^xg?|7%H&&0veV}3-!p2PDVwL%v00h^sDes6=ps#JZ4T8qq1Gb|MVYjuoK}t>` zY>z)`eNP`U4mhM*P)_WOk7L!1({-Vd=2m!4c7hbGRAik`Yp{>f3mn=bb;QG+x1<<^ zBsb<4SfW%~%P9iBox8q_(8=j2UFW#dhUo(OcL#}NTH?6DF-fKB@h#l??tG7!HZ84a z7Tc2#`cbB(z79qWay_H+0=m@+ps=AX6scarFBJo!K|o)qN=)&9)fgTjZV7gs$-t%o z%kl3#x&&K63*=MaE?T+bo_IdE4ph51T0ZtfI@-dLf>DW73^YK9X~#L#kfyQRhJQ!} zga~I#WKz1SkRV1K1zj11J$okIIgb4C+2b|pOc|W1%EWD5NKNS5r}~Kradu$ki3zv_ zFn&A^3mS4;4}s`VND2{x?*kfbvMbY@z zQGx^RNA^bqo^@uzA9BiRauhso_kXM4oQ3o%z-kAO6cPYol0`fP(;spJE)YtfovnVY z>G=ayMd*1T?d+nE+%i0p|32^pRp9@q*k)HSU9av zEWnUAZkP~ddD;OaSZhF5zk@bc3E!;23vci)Bi$nPp_tyBCyt1#08Q-pCO|*>Tb_I@ z+RUZ-s%Wx+ezntu6lJy^r!zLteGZ6|aY0w|&3l+*#Km^0%LpV#ztPp3&5^?7)Gab@ zOTbNi8}LkLmbT$?&|w=J(OZPSaYP;oQP#3GXAU7UWZ*HnsjSS~=FIo^rm3v2c;eq) zF$~6V;(nQQAmrFpGQlK;6vbplJcQaZu7RX`u)@E-VT&+Qp`^Cb9?^#ID5zE{$KWtx z2NoYq#(grENjT*&YmjnSXq(@){Wg^#TV!Ly-wRgN$oBJ6UR`X6x}=*ME;GupmZyEfXvyyw}&-@N4evFPydG_D%>Fh1*s%lG)6?u}>=I$Rx}OQ8nD>$hA~OzDA@>Pc^(Q6$QnK=f2r*HoG z5QXQ0>3k(1*oJ5MLr4aXGNB2X%7FERt3f7L|^2JO?V^c{8>$+#T?DP}e`bTGXUgWj%)uk?ThW_$zx0;JyFWI=2s_sgtE~}(jon?<&3$=Vuqz`A` ztM+Ip6x99Pqc$kA6}&|okFo9H;O0%_cP1g!`X{QJ&TxkAPg&UJwD*J>$s<7+Lzv=j zZgLt-3swE>U5unUt&D$f%gO+bwJv|tLky2b>hA)E{Kn?&ns()m3J-(z9#3nd`g(Z#*hF&%^*e zUGjAI)x8czHhrs7iDY5@^zPvoa(+e;rT9KoDAezVbpyAMcUQROMl`utEHg#Z=@rd{ zY{EpD5^?*=KT@*c-T7rjGDWjs0+{x2@6)y+MS0ZaX-&hsH%TO`2(Vts#F#-;U%6w~ zT8QxQZtXyL6lB9*7%qR?UdJXh*7pxvZo{t}!+ndf-uh+Sq#`up_WN7QjZ@W&*O~eT z|Bk$cxX_J&Md1Iv-Mi$J5zHo;k@hFC6tm%VBNumD@s$Zt6wd}&8{uI2)@EU%(iBP2(^v8sAr!H@^whg$-N)0wu?dy|orufFDs|gsY;_2UOSdP|s<3EWjZMQuXF%C7cmFqO%TLBBBdBC)~#0h4m`iQyHOKEwH@ z*kGYwgr*BDvI1bkg^0D_ThbRu!j4Z{*=MhzLZ2IPKP(KY&1{!r=#VT<9@r8$Zh`gw zc%G1kJ671|e3M+aad)(rtOppEi73II$|R*Mw}Hp@`snxl?qY^8}=t6{QH|KNrblPIV3{lc!PM<%C{y@Mk}w+hU4KkzueKn8X@dFg)lVBXnq>hHv6K7JIhX;AzdJzZ z0LFhT$cCmEV7_;9$s?J{L;@RPc>exd!gdGtU@#d0a(AI}D;}Nkxt~M^9p*#ZY1?TT zmFy2!*4Jrmpt+zMBi{`cqkI?H(Kl2XhLN$&cJ?Nwoq$ZTV<-Ob=S@Ea!PQD~P>i}b zyXv(SZNX%=pKm}}Z{}dA)PNN_F87@?-^IDe8J7NJF@tvP?~DaaNd8$~M6}EZ6eibb z)@7)7f(#LHwoiF9{BFtssSc=81{zrit|T_?Hk`G#D0fkyDKhrbD^hD zp)r(Ht>(B^9L?R-)pEBYCu3`9!=-p$qTQZ}`nb})rL*OHi9&=i{YMsWpS3ZX+mEk$ z6adI95^1}){i?v%WqZ{pulQ@R^w`i$wQaztUFyRuJbvYF0Ip=tzAbW7f9~So5`7Yn z8JGa+hG~`+qMP_*7d6h1T>T}QecFPaRG#SVU0-2Tj&u?p6`k8NrijbLpt=Xc} z+2lW*0N?A*z{Mo?EaRxG0IMqeI#RW|6}2?gzBM!2fPrJSoQCs$ay((PuRDq<2acel^Z%S-#FuLSHV z6+HuO@TRFpCI$uEIZVj3?o_Ll^~#sBpg^5L?sfa5DctW3D4}$3{ke^cfYAxUl`Lzu zrPmdm9`VMOB|L1dVF37A(Li<)z>znuBe@83<`PVLYYkjZfxd2gdI9X&tF z^YN?poiSTWQ4Jw7AqnvhPXOr@lz|2ULi}>$a^*3VC3`GfcfV0tw?kM{9iUBQXGBZX z77`~2xrY*Lj?@$_Q>ZsmBx;efZX0FP)fF=HqwlxW121BiCChTMP5|}(goixmV`EJj&;a22=d!N$J$SGVm_)#^ zy6S4K4(WQ(zw_qPI?f};q;nnpQQ|i12hNRGaNg{Ug;J$=S-PicE^u!sqx3Ho7g>9} zgJX&u+pa04!N^ldXC=@hnBMC8R~7zZT8s8QV~qXhHzCj@>B%ZST9Gkyl> z)zj2VCk+iJF%mQniX3Zk`}(o6pU&f$4wfmBh^1ywBM#pRHqUPXVrdt`9jp^GW>6rbVB%Fc@5r zgnK!j!VU60@jjPq^1XA>(hM!|rSh^5tA*)yRq|>T;HsJeB^j_=2XW$X``Vp(+Gxp7 zpo~4rje@spqf=l8>{07gI3K(F`vLg!oYq$71T6yAV!+vaE(9S#JCAH$uglSqs=+cJ zmJzX^d|G>bXSdrYD7Dx7Q(wt(J*yl(6uSr1uN);8txD65n|NC?7P+pFEpqvXgdYrF z*Gbr1+ql)-=Z-zR`yLZ#T;}dqe@U1}#cOgOKsjd=F48y#^Sj#^s#A5GVq?)xtI}z) zpF>qi&5oq2G9$*YzEq&!%!|xqyGrcH%$6B@?cH^*uP3MPzNl-^#V^=>Sf4rto{gCN zjwFzh94b-DCT>RhJ|BQUCeV7Z&^ZEwa~|X8UxKgG^~YAkHq2 zfqo-sl)#zg3G%TqD6Jy0FQkh|#a{)^~COg;=44{h0e z3^31ZAZk&k5&pnI?6;(J6<7vW34TG2BPEWolxt7?;;eOG~F?@{YuZ<>Al`9$eNU zy@*s)&b=O$e{sEeQqLw}wiGB)%i*^atZ==ryK1HbEzY-Y{BnOA78FI=xmu+o2a$xu zVO5#>&l4|>N+y>xMSSWLY|@M5mG`;cL$FL-QBu(WHW9>_rcS*I(R z1{J%|F-kEn+!&Tj&Sh{lTnh%Gu~v`&(1hqbgJ2&m$K@?=pDK#adInKm>CiY|VW6iK z9Z`TPAzc;V%jpO3zUa1D=Sgb~|$q}e?E`uOtTvE&pZ`YTrasoCXaFhye z9Mr+^EuHC){xT_t_Tu1$n{>NZAV3~f4uk}AJ5-A2SvgVA->}qH=89*eSJa|jTiQT} zrLd-_l2~gIC6o#fjz2!T?}nPkR0;}X*ZJa@P?^0z62k^EAlAcc0*Xh27rxr2Lhdpm zb=XG}iI1swy=Vi4E2^IJu>8!+tg+9hl7cd8Mw3@dxGI6!RXCO5FbQ zW|8N9cMs42?hinnFXdcp2%bDT($biTBO%0F%L4{DE|*)>0Dhk? zC+MF#@?;x3ht)O!^1gj0!|4`PB+%eu58j4&d!y!3F^NC}x>#sA?Gpx_*}Tjbl&3zFg}pz+;ylX7d3J%#qg2-cPsZynFoJ+s3b5grb9rj&L8J%U@#*-v3ez1um)~Jej>HB_yTh64fN=2A(@C?aEj)#1_SK#gmzGN>nl|@?^z6 zt-lrz;m6p&C!%{`Ch{J@of&{Jo$J5I05##y)?@>je_I`X-0Zm3{=hlT-F@{mymG(Q z4m@-2dTB!Ry3s1C`4#_jq}LK)SG+0ikE&%a3VPH_LUpurNu0s;cNId8u7#Z1UvNQa zBChOSaq>!5{wHw0@enY1ttEf{z;OGBCxEy19JJMwq#}PJs5If;7a81=KSzpB z0CJ0IA5dQvGA&sOUue|?36ue?322J(QuKI^xI!nQW2;82gCYsjDY$t2uJ)u;esTXT zjd|eT`=%AX{gU}uG?=>H*Org3za9hfXEk7DvR?@+BOBH)YA+Fyn8e=7w9{%uSB2Qk z)IDo#>1?RELzduR=x0PACXeEFosr}YTl2XzqSAv$eEBO_Y#%(39he{2iV zWeLNT-4dqF5SUd#ZoLhL!|mDNQ-a;nduuwW{~4G}-mT6tfwmet%aIK*6h{2^G#Y#_ z$%vI{*%3)?bj?_zgYJAhW)sDZN6UadtASOgSG}C>p_)mXi{nnErrh%m!Yb_99gzgy zS1o;{^f*P`b+XYJ%$d!qQ(z-S(~jED@BO%uNLH)d#~!r}n-hi~W=sb@X$ZtlAnLM_ z!20c9GN;30ok}t*6`nIiS4R63A)=EYsDD@&wLRg z{~k_nCm$urf`&bYN?QPFHr{MC{$5^q0Bg2CjS}eQ9q8^_J#RJn&-qG5#w%Gr0eg>6IFe{zNF zr1{;YgYJ7Du5Sr#DVvcA>0-UgQBD=JxLiB|hp<2OIH%v$g~kq!^+I&*-0Zs8$9cg9 z0hOyK^*Eh2b|ZqQs0QrFqAv1Lu6ebZxOTZ%$m^gfZT553pu`gb6csb@Dnog7$mp%PtxVTqe(C_{9lo{ zGaAzWuXKUnoahgy?k$0Rt#6tDfruAHGa?9chHIR$rLGEFOB`eV>szIsOw(~<@s^Jc z(Fv$%+@MagdPL3jNqhJQ%8#cJ=y%CnOZ;wa!3|$zSShuPGj25wagK;iqqfn!=SzNi z$@yjPg`X(H$ z44;V4#a6thcSLn`2T&8c%jV-fMC{Xt;J0~^i>?y+=6MI46IqR#%n7rB<-~VMR>j(3 zOAq+v+J2C!=7|Ec0)NXW-e|ps_t|7iq0hQj1e5#B@$L9iG(Z4QswzsLS|7VrCs~X+ zV={upI)x%(l)uGAho#GSo~9g+6?$#3rL1albOF}+tnqDZrwdLzSgljAd#rX8|;g#_+9xKQVl?w4vWZM zts^VKkjYz4+aK(|>pWS70b%X;;F4zS=-;3*oMI96B}&a>`kEX~QtsapKY>`9@AZZB zc3vEuhzgr5bVEc;TIb6({N%1}Wk&4QoYnm9edb+AZ=(t#UBJSJp4qqqc?9mmC&Os+ z(Q>N!tqW>!;%hD^=TgfsiT&TF%WpyGIa8H|yR8_IovnD@E?y4py(Joc|61JHrgN)^ z*6HnMb{MVvs~qk?v9F)PF+qqkgrmDRj^D(ojWfD4llM1~P)sd*PmAT{z2}|ZS0F3k zh{4{FCd!K%a6nbM1WCE)e+qWWXanUPH69`)66qY9uiQ z!;0q_o9p_Rn6LcM;W(IX#+2T?4_Ob5;Po`w=<7~J@#+tBqEm$2S-Wdo>g zGfL^NYo_(P%>Kc>)df35rGK<0ClIR)K!#)pz$pTcWrku6u&c2Gs!xm`Aq>k=9b+)X zRxzR3_7dRVotM8<{9Tn=OuQ!Pv)~Rw;W~FyblGnGB$y?7espzl!0M_hK7_>t3_ujj zF`70?1+)E7L1GU;lT_v4beqCB>7^W73uCp{aHt0mlaK=H!em7ozIyva&6{K}GlqqG zHs(W#jd02E4My_r0=c6G6BSwv;NdAKKbdUK6rQf|RcqpXV^=iasKpOq0I>c*msbh^ z)wEM9ZGbUvPt$!MEHp=feMGMl*bVZQ_$Z-4{cjLV_LF5)7=_WL;PC;%%<%!hP5lKU zF5Zh3Fb|S@;qv{!M@vmIKB!gw&fe9DYFd+5>Mms}tif$Vvup9Y0^$1#2KKP%B)g00 zwQo61NHjAaZ5eZMdS}&`%M^C;tb}{lKcKk}!ePqbIgJDNxKuDC)YzF6=T7~x94x_c zFaxq9(2B<6eBUJfMi8(`oP1Tcn7 zQGY!yJu~;_6E23r#P&S0YjTsDb{1zKKp)Eq5m=<5@`&o(q^7tgBrjp|J2N%z*hHAxaMB%3JK6zYk{oFiKvj(5bGFY4`IK${_)@@toYCV0pcI5& zmFq0%4~{=i*L?$g2$`PN#xd_$L}BX7GXXB10~_r9DYJu@Ji)uTAUzObvN8=f+rq;R zo?I$}niH**hGlmwfU?#u993pagq!u%b8V*^Y~ZsFV%f9HMY99zFYfM~VyEh2qX!0_ zNuK}9UVo(en69H6M1~w`<|o9w_U126R^n7%f8sBm&(1j6VElJg`t8FM6E0tVORYcP z>&~_FB0J7_gT$ooR?f~T1i2d&hGDhLA_U{(5`@Md1dkR2yY>_pNQ7@T zc7>4cp@rohKP~uj9$B|?==cY@Bu|UXpikUCOqOV_ z>2Clc#DLnnI%RL4g`#HQSfw;Un?l$JkQSlw2Mj`*F79l30+7QrdgfDS;A=NMH9$a2^d8Ru)PiFwx+ov$xS`9A&OlzR>K+wR0r`|3)VZ)5dU93i5%L>!&N z3YBgmfVY zd>hj0SnrY}4cjR$ti)mR+LxGznL^*<|XSgmg&Mv zp;}gVG_TYqa+E(g>=J(YE}`m)UsdYV#78DirKyIEV3B87GE5vl;>^;^J=(Y{E9OEQ z#V;<~OMUm$rVZ9hD1q(QwhL*^8?JPz+MijUDqY+4reR}n7BdEl)X2k&=Xu5TeSKul z0Y%2+K1^coLv670|$rOR9(wA$0i0{FRq5cC~HxN3ipk}WZb?FK@GVp+H zNA&D!@-A`vIx|X;;Wioc;q^jcU0>pB`nrltJ4;DlXl1Wv zymFqP6V414x$F%z>2=_`xS;xrZMG-Q7lA*vXK!?3E{?B;{~8@$-;;b{(Y-+N81Gx+ zeFjh#XstSPJeD0F^SrXRYLgBQ^vpkjglN%bfUS7J0=qxQR#>i$(Bl^Z|2*AYFhPlJ zTyn^adfa=>^~-mli4FU&GsT@1{t>jd!+}@}nP!%A!IhifG5*!{TeJkV&TBSfNyI!8 zbv0@Bl{GvLIG}}?T+UD84~~&fX{Ln~iHV@xCC0+9xbPu zusCkWA%L07#@ik(wXuj~%J81{8U?`lEDU!P8*G_@h^oDKc?Vbs6Jaz0-Ci34YJ!Xw zq;o%YJogB^ckz3`!43ucIj2V(+C*0X^llB<-ROwe9U7Z^+k`j-nB2zj!4wBfEnTQP zFi|I0{3G#BmV@v%?c3>eFaSlmYA_Yx?+oX38u={i-_vYF;Uoe#Py2gzwH-u(1xlBt zfsRBG>bB$kHxq$(H+V)9nsYO{c_ozgo7-#QUt81PU(boa3{@+Lqi++$dsh=cer`V< z?rd1wyCz|SR5^B=9al=gwggl|;0Q;Fw5J$w0~xTUY8}^J9Az?maF9Fi#6EdJhAbu4 zo;xAU?&n|kQw*(0L2H$PhZlYN#5olm;*$LKi&x4NAiqv;bSTK=2UMCY)6(!o3qur$ zuH`Zv!}OcYiD+r;G0kAAa?wG~#bR8Io;pIW(CWDFC?k*rg+2w=>4hX>$UI=40+{3| z`38H7PnN0}#V#ayBDp@95J7ggZ)12gG-x=%QXo(31) z;ADp{<-y1T)VP~<1me08)92hR1kW&J5*V^_2e2(+s+@c%NY0(xR_ zD=$G7(+yg+@|T4lUm77yG8kq^K$w(5tQhjUmB0EnXzU|-3wd*zf1=m+^40K(!;2H_ z^;SD}R;cG6_T~HSuM*KXT%qYlXfd-5!H1KKr;B*u@E@R1MQLD$Gu*Z7;bMh2G07JIb zX1YmKdO!Ipc?~o9kKnuhc}D<-DQE0gP&xd$=yHvRwu2MXS?6Ka5Q1*9IlBEi%@RHa z!Pc#Tim`)@K+m<`XGf6$(&N397>0s^ybl(IIhY5>KIMZTeuWV$=2&4@98ZEIjs_7H zl0>J4G53c}Om^Z(7lO96SA5!k1JN8bmx8bVWyKlrjmX4|&kh6Tr+$#r_(Y4gp8}kI zRxC);rLfx%XT60!lyCwTDc7e5NjL=yod4?vz&Ql(0Ll+?DE{QoP6)QG9w`E7TYf_> zPGs3LoMk~m)F#8~JFw7`o$ChT15+y>F2d=G-$sNONyM6}Oo^0*Z6G0jkY#Y5uc#D7 z@2i#tBS*{8`fGScu%-n7#r8Po0nlBm8N7S@)CD~*V&a^1!HoMpUmYj$K~-A+ijWK8 zkE01CbftB@tm+t==9{f+~hUln<8HU+QL^@{L zkcsC7ffyA4vcCIAqO>7wJV`iymhtteR4>M}_2^{Y3eyK;(4a!AihOw=m)j*LI=Gi7 z$q4?-vw@eyo^^cH#)O!S+Kn(_nitN47>UXy&(`&~G;nI=FWX;9Wx{k?CiR%*ysQ;X z$`sqmUe{l48P=oz`c=@WkXP#+kCs%8%hnZK^vxUlKMA*4sbD_?2L$qMX{}MiUC)au zWnl@xC4N7uGs?}Gl1e1eP6zBnfOeU#XPbIeI(`sUrlF{uM;TJ9LzSo7YBLwMFR0d~ zALX;W<~e1$7!?odE36unHO5jC#;|lqqtYGZ*a1oC7qzr%3|>43EYej0clq9@1hHR1;c+Afq2MHIGLqP_LDPK}9PUw8$nF#7Xz$O-@&Q3mi0`+zsUn!E z6Br<0d2C^o#3_=N;UI(=<5By>jxA?F{uZ}grLH|i8Xk{?1z~gWHXU8bECKGUu8Z*{G^P0h~*LFyE$XE+;-W zt_VA~1vYg0n}c{l(h@ZpR=#v`w_PJg_0eOh8?ru z9ahA$pFTRSJ8n~15T>E~A8%7`4f^@ri@LKr=1!)Jgrx0C3Cz1Q)L_9OENnUND5n~o zHkLH#?-h3EZ;PB*Jb2p?VtnWU`$OVbNvQ#N(fJuwJBX_NrMy}-E#pghuY%8n;n^VU zen=}^N6;>EW<<0@YmXv*x9+#X*I(wco@h@=8wXN?D0{BJ7n)bD=$tbzOmIwM; zt_I7&xUn-850t`%o2Tcdnqv|HG>?wll|HVQ$R;Dp6tc0!c6vG5fK@9`hMi}dfP#vxDwU;jJ|xN*`E_%E22Al1B!6z8Fe<~nO? zXUv$8B0QCyr4Jp~UTeD&Zb^*Xb1rWIaNQPPaNaGrgGZ9osPR@KdlGIB+P!0+EPoDm z{yktthN)Qk+|(<+ZfBSYSyNrY6~ae+pM7xp4jOP+cv&gAkmS?CRjy`ExC|yVhW2aR(mL_yUm`k5dgcJ}P=@=6ky9}J~<5=XYfRsn3 zx9#gYHp(cVa=Q^aMw^z~tqstgSsKRmJkKMb>bW35{64$#3BaMzOxAd zl(HiT)O()-afRG2X&(Yqwxk-s5mOSPk!khbvG`h_1qF$v8eM32gN%u&!X-70w8o}R z=wj%r%ap8&gK2WkTEOdJDq8|hd^Rqd20|L+jLI;j{pFP5Fv(Fa>QLH4JliKHWP+e~ zYjF9H_;b-!YC;G-Yta$s*s}%{&Oma+Zcu0giHuAoShMIVf#hMhx_c!D+V>z_UYeDi(%x$FHpr{1!TG zh)e@PCsIZxAa{EOe}LuXX1}XlJ?*w~azP?eQOyDsMInz%bA`pZ;(ftbs7i--gR|F@ zlG~xn`twE6XgK7~nE`(pD4KHiU%9{o%d*>&8P`1oB#r5PAy1fYG=<{Fwd*>yu1gOs zvyb@1-m**dH)Ww&a%-5VMnX#Vvaijyk{|LrIhuX%niBVa1Kt-pHFv*Zao?Hif>MzRDI zxmBO5EM@W}PwxkrCX1)}X&{;KIFW`2RpG<2TeBmD@DJa|M-ZHXTgmrsk;o(0U93(VHk z^?ZC6kYx=ILA_Oi31A!+$(nTKQ2%Pt#>7XEqSl(OqRfB9%3mJBT9<~T%;vMJHOh?O zY;__Wmg81l;8TXgrD1irwEMR9E}LTSsvQUc`}snB54a6NV_H*_)YFM|1SVf?n(pTb z=1yna8wJ@6T5>$Y|BI{+&crlV|G*H(AQX?6pL?b)jF#C<+umu_OlFeFWQXn#50-qI zdHqymZdBg>bai~9orl5>KqVCwelk49VOXcw7imfqzao`@Hs@9O)bVwEjGjmD%G^oY zpWo$stka+{FBN;2X32f_Yi|0Jv939Iqx@#%`9h}#>Kg;W+!<&&?4>6je=@;M4fvdR z&gTo!vwb+jKNjm;&7wpnGS_ zwc7*hupnF$hN#A9VZ=m?CZxKxASF)rW!88+Mq$z`WMx0kp@YsE_ntL>A}!{7AZk?c zeuuHT9U}6_`lkrx346l%S8}=7r|UC83cy0`)N1%tyq`q(15|KfVE-32 z!Sp}12{3Z}=M}}QhHd;d3&PJ_eZ-rP8j;;s(mLQnsE}e}foKj$#E~%F!;aYOG~47~ zukV)_-oIoUvwEFNs0+C*a~?cx<4-d@Zue{jf-wFp2{1oL1r|Z}^g-tI8Un^iqnNOC zb--0XQ<7vV4vIgRe0!(eim%xb&UlaYY>5a&KD({hWW$Yjm$Ull{9r+3Bqx*^Y{C{Z zwa**SeC^ntwGt*GiiWQJRhxpZM=NAN-n#miKW$Xwwb=bS=`xWiJP`)2ERDtfbJ*Xp zOQ_Dec}X0lcD(uZwPb`zlH~!`Z>w^@TQ(n|lQBq@%Y!B<4J1B#XT$fiUA|ICi5xHS z8FHWpOx#*GMt6wvsFJg%nqnYlYENsqFIjX|(-}~_1DK^uGY{oAn-weU?;5?#;-#@H zuzR*hh^H^RzG}9bs0E9=`vs2Gje+3?**h;q^st`KxKcBPlsqiuiwE`_XJ&KS-N_z) z2A+F2TZQ8P_LPxow4$3 zw(bCAaL9V@zRU*9^iaLnPt{uVXwo-UhWymz&`>$h?po;fHB+zXgIfU*q)q#1E}W5^ zpvsK|k~KkKB9sS=`690O*7wjs_Le+p2%Si%q+B=PynS`MS6&*?Fo{VdPlxDjX-Ec(V@v6mZGR$d6sZpWQc_@zcGuP-#*U}0Ao1pnevR}qMJJuQI4t`&N z7RKfaV<}7)##GvZ*vd$5mdz!7i~x*5nh3_fApFKNU=^0@j-O*7EM{UX1vV7fdu3Hu zRtutQX~QgkS%S_MfR+hb5KxEPw$|XHdhH&oM*ltTuu-xksgB)4Icm~L{YFHywEO64NL^RwkV+($aMI&{C zsHIjTh;C5lS2>kEb?9uO7C?TuRFNbXRC4zu^FX3Vg#3hZo8AIMBgBl0yTAz<{DQ0> z`bS3~c+nb1$UFpkaQ6V51I6Flpjy#8%o+}E0iliI4IUB&8(p4pfQ$qRM3Q{E1-Yga zkwlJS_~;h&{6<)dj%0ZRxXzgxkHn#o#Usg}lj$trEjWk)A`7vev9j|X1(806Wo-l$ zMq&y9R~$h}Gp9VV!?L#*5k=!Rpd`rJf$-ejMs{u%9&JFgnA(E5szF0WQj5SrYZy?# zOwhN-KoL@Dfc%D-3rL*ExkuzQ(gj{pD#t;583iJeXvVP&pM$jYkt7rCom&ilEh?bK zoJI)t9Lv!9aMJ<-5>O=`8Vq+RY!JC|iZ~i%Z1lrE2f@Pe8%|XQsH8{5?O>vF%_%1< z_`zs`(zEFYff@N{kQ}p+s7`pOXX%794D6`&hjRGuhnKEb%Zm%CUKHP-4Pn*fa80Qz z;Cbif?08Mn=JTdeqGiin(o`Lmt}qec^6rh*HeXW5iW;(hNyshDd{U9h)|F5DlOxgF zGKgqAk9Y1?deb;rR3G<^K8=b!EQZ-5XEFEA9U1UXVV?f9SZEy6vRUQ(#xUhLGM|6s zcJf^Sn(pkvcGk)?WTb_q-8SYHpU}RY2NMgCS#KuFfmU-3R8L$jF>!OUvp)bJ1avEK zT>EaAVCratf8j>;RbN&2;MZh1@GQD`;!QHS;>-X`*|)ElF!ScE$?ijSTY7Wknq7Yv zNdF^8m47qT70i2D+yp_q@0od%x~j9h8|NF> z4Aa%?5QqQd0PgSg>t16k(#_QId~H}EmeVz3w2ibu|JSMz)-P_las|ZfL*jARp+JNF z1sx{y49*vK4lhCW0gTV~b-Lv7VT^+Rpg{~_dLfQyjS`G3jRYpCw>gdli9?Yo^2)nf zK_WaF-oGMZIW@F*ovJ=?8&$V)^N=umc90;NBLH=0&obrw)frllVV$v6pV+RIPUZ?l zhVz;^_Xi2C(qQ)K`g&ayY@?8+guwXc)=osW-Cnj9LsvfBi6_s72xFlI-GP{C+Nqr! zV{r&@2=@z)d-kKj)zZ1oGSzF@SGl!s+%d^Hkh1JmGEkk5*va>_44e-~K|^i0&P_g) zY<~uXXjB8u3M&|{Yug7lAE5Wr>ks`f_71Dp^_{}@v8~-*P1$tH#!@OAz}ms)x$^Cf zWGHw(rR_3(W)!6Pv%p`2j5hjGg3UXh^qrOqCxr4thsfKl?bxRRc4qeqmyF8QwWFzK z8*RR)(xQ61HVJha^5>KN)kmml=AFBlcHm1Q;O}yDy@_4-U%$b(qkdY91aH6hYkRQf z0FM7Qj{i5jH_LyH<62G4`0WlvzxjHEFCuCS3!1~*t*5A=Y%Y9Kx82zL3`kNg&sf*j`!bKK%-II5M2Ib0h zkf;$py<0aTH&;EpFM$g@z9?Y!Vf;PYO|!LgWww-fcM6bV#Y?{3(5cy~KQ7Z{6wU~i za$kQsMK`G3t!(1ob0xN!qp!*fr!}PgC!J=Ugs1y+e|Rqa_U9UJCLH!Q2Hk=aVDRSN zBJn%dnm8;|o{bv<$7f8ge~i^ra_7REYjRKod?9)S>ArgJGsP8K#5q+T7N}|{5QGtapg&=T0uowF@SO&fGWyh{nUi_r^t6*#?n$tR8BxI z4XgvvMH3zTeAf)tL$Rf|znC5qkKMYAOu_F^UCCvQGyik~k)$D=3>?L-iu%Lb7Osa{ z@reOhK?=}iA=lBRYNz;= zHZ_Qtpnk&!dU?clTRFG|_E+1j^IWv84ZqFwc3m|g-*F@d$LS9-g*V*77t|A7d_&bH zgLo)eT*y%&DGxYe%Y$xnQ8p0nJQ|gQHD?|zjGIlGmvomE+k?dZ;>hF$04KHUj_6Hq zGn0MjW9>Hd)RmP1-tEe39(*%3s0`KizWUQg)6$L_-OccqNCCrJaO&Vux4c>jzdcBl zq%U0p^so?pM5d(Qto3IXqPnyphKIi?@x@Ns{d{z2@vqc{6>cF<;YiCI9ZKP+aO%tV z>sBLx~5iZN-2PD3;SJF*}Ql^uFOOY8SW~ zT}SYB-%k`^*m3g5Exs9F>11S^BsxifoV~3!)j_GCNpEH<@A(#wkbJ1y-aq{rfO0bF zfy-e06v<@R+*+2BM<4v#YIX?fX9Y6AY{+I)3tSO3qF%pLxW?9A!E-Tfi3!n)P;9Ye z-B)e|ou<6Dcp&5=I_=T3LkmC?cN&8z4oI#^s?Hje6j_USer@13hrig+s`N91NJ-BYVeloX&tgfyr(9Ja&X zcJrf{@S1=Ba}k~9Pp`}EVrE$NvYevDpild+$7=-Bn-~ zeexXJp|zzZIu`7eWfkKLo@V_41Q+jXHQ@?y#d8bgRJ&#`FbIFl&;py-hVMh<;bjI$ z=UbUG{xC*7joZ4akAac_lZBcPqL4_Nf6cF&^def_k2hk8wnQdCNWY1TSdX1Mmo=ADv1e8q&`A`b$X8v z2PMK>lrJ!ce9IqRHW%JwKq{^FI*SGwqN25leN;XorUo}Z@D~^zvdyrmoqJL-&*c$3 zAuPg3k!euQj2*oRCAmP!V^S;E+ohY5{!Rph7_lfJ9lpZ_Fs!y7ALLDEOJ0W{v1pg! z(WlxCeOMbf&<>$h=NHGP9KwM0!}{>Y^n@G?z}2r|sV6K21?BO_U*ns2eH|Q`RC};1 zF;iM1X=y?edz#7>WO!_*qipsWE%K%HiH2}PGx4r5W>R*Q*az9|?KK0hLz-Kmy4_w9 zHiV&x-W(0MfC0ws+uu3nl{J@Xkfvhv*wWooBb`gt{)1N!)W!z@FYv|9O=Dv(2n0{tS zsQ?Ck&TG6+N*#C)O5$bukQ1ZutJb!wibCA`vX~&>cl_?$qbY&TdrCNA4CZjQjNGsv z2lx4T752wAT})8&dwX$@j2YBhzWSPCm@7}!axs|KmTV7ZNup52UF5x3IK-gMCT{@7KI&w+k%$B8S z3}|B~57$mrWXC1uHeSQ&WI52>bM9~!c-zB(-FIy>H?ojTD!tnDnavPp0q`E<*%E_O z*u2m*PuzHD+zPeHqgK24n?urRr_#l}K_J5R@)gF|Ev|o6R!?Qz9FYA>+f=|N3syOR z!euOm_Px@D&KC4RK5+K{TN(lKGlnX-=#IlhU1Rp@a7Locpl& z=SCDS?;s!2C!}5AVwu`T>?{+o(|2HtPE?IW6yhki88Eq$oKP9m^<7iG6^v(+wq_EA z%EFo3u_{E>hMs?%(NBZopp=LITS1lmObI8*IBlK&caJ{8d5`^W)(^&pA0OHG^g+Tx1*=hlX-!?;;dH9NJ zc^TQu;0KKHrB%cnn3A?EiTrI^;S`LX{Gqe$jtuj@@`^ zn4rY&#^!(hUnmk2mnSBM7fjz(ZP-k0HFYCJ6kw*T(Y;|$XVe9 zKtu+lk)Gea0vVO<$tj^JCt$F!c2CvhB$Y&g@sz3z7_CW-$}!cvo&9>hX2ZTnp-l98 z1fE^K&w-@lnSI&Oppuu%Uu)#-gRXQU3k{p6)1YH&KTtHMURdeWB=q6eX`A)?!O){1 zYsovmj@{TC&(nyFG#yKd@y_(iK_&x*4BC_kDR(B4>9Cq~A_cFDRteZsExW>-#~;+J z3aSINGx%EFo#9no=S|X-LCpw^ChQX(RMO>`YR(H(Q z`v}u=klyrYZDf_LorX(@$gaoTEk)5&29Xo+w{K_9-~!c{+swo%)!jn#fotG3zu+;a z)UZDueYLi5|H3c+w-bQoYjf~2hu#}vQHQJ?#hh=qDrnmC8{CGs(gp|!NeJD>> z87*cKXPKw|&7Nb0wj*l~Y!SsQ_SgMMsE81nCnHX${ql;%-EY$EIf|@I8Pw6Z_%p3w! z84=fXBfa&j=GUgm4*svo(`8_<$J~*SAfn89&eah|zYj^^Zm-rZ-T`Y{^wB;#zg^rM zf>YDrqqe{|xRJBH`Pyj8j%ffXrw7}rteYhciP*NuW>wp6C+nX~!2Y1!`;K%_vJq6)t zinC02*f>v6;M#}sE=ZdvV9^DnzwBkjs=`N`&!4L*EC95cTE714xMa*zay-Sgp4UKw zV=Z9YmA?K==|2Cgg6}Q#d+q!F@_F?A+-h!VDs&eRNU`Af6~^MGylw}VjUn)AYhDYd z$~PVPdo@52KoO`Ps-3f>RsU#@sA;?{FYp(EznQuD@!lE$P=f=Mm?jsNKp)Np4Yn}g z_)ukaF=-3*3k+)n)BJ7f^fS92xyV>1UeGNIn2e4hngjkUnJRy-suv-b`MXS54)iNQ zM-FOoQ=PqTV$y!@^ynN($gT+9LUMs@Rg{^!1EQl>ZDR$dgf5}5&rqC!s8+yMbf?P; zG)xy+&Iw(1Wc-dkR**m;YnQBaZ_@1s+JU-~Vo)Eci`?xkLz(Nk7EU)KQe5b8V?2KY zH3+gYSHr~@0no(}AQ3tK3_Gejj7q8lRct}&BE)UsQSilOtk-BN;Ist)l)l_Gt0M6& z`LzT!M`&L>Gs?Wfm|;fO9Byhi*jDB`Q(MaN;GHRA4P37v7fwK2S05;>A_=t*86DVC z0yGhQ`3$`df~BrZAREZOkpma#oQv7FW*-6tz+82wfLw>VBwD}E>*f2?(wU#b$JN!+ z33pAz&qyYV-}mt>GRo=6#nlqKbQbmZYPJvKnM@fWp`NYz6TdkjqJ1URZgy0M_Ah~p ztT2qr96V@B9cKfs|5%%)FCsAHLdr_6G;%u6=`j^S9LXj3GHEgLN=uI^f^FZ;Wt)ib z&Vc$t@*=Maspnx;63oDI`*TQ2vhu+;Vdj9r7@%laV>$I&UdW*kUfw)HhtOguRC+yv z4OpN*?q9D*SxLy0GH^D%GHkrEj+|skC%}M0awhG1TtbufEUo-W(;jA9{kp%YmX-$! z=oC?~5+Uk+FrlJl;QruAg=9}DXT(Ees^GFZzeS(vh3gyI8YaZb7f_) zyXJAudvA}-2{Ijl6bYuhll-4`^z?P+nxr(7&GmY3ARP%$CB*H;SZ%aBH*RyFqyHt$p$7D7jt;*qljC*$l6v?9W0n4$ZSLCB8tw{Ac2rTFPOklL!O}Ax$hU6FYum z(7?wN(UVq8?>&ZQ9?^k?^zB#DDwuK#wWr=k#6#VaTlhb~wzn26|7Gwq|4#&JMz;UN zH125Z*l)2R`0wcxUQ2>mseK_x!csuhXyCIM3?tlG?gSe#MyhE(igZT4uHD6nZzL6y zSO*#nBn*(myC3`hNKm~~A4r1v^DqMaG@Eow_wA9???s20*Gxd=+1Mf3A=7CV+B8-A z$$OTm``h@*m<(pp!AKCloY}ReDV1e=S?FYh7aCzQ)Tj>9s0ZHk*15Hb(CZwkX|)ln-4zpJHPsiX1i>8Q(0@(Z!eX? za~NNpkh9dpAX_B~ET-OW7r_J<+fr#=-66Gxq;9fy(RV#a8(wy8>4OIT@{c9o-C>WR z1KvN|dMbD`1zWebLVH0L=$wLN3CXe3D77!CL zNUx1_{xQKNji1R(JjTP>IHR5{bLrU15ARoD9~UicO2f?c*jSpnnq+OpG{I$;$#NWe z2WNZo0k+-HQlWsEoCyM{pprZ?e=^q_Ib&58XqI`Z7;K-;lA-0@d1phJDx5K5S?Nlr z@=-_G>)+f%XWltQ{AoW=XOq$N9vWwKOKO|RX3*SFvv2Z*nwr10s$e)J=oQ6d);IxM z#ySIci=3LdNSc^TDv82#o~{Tm&7*7gofp^x$I3&-7Z@!bhmkv6~KC3&wVl zESqN`=#8+^xt|TJSPwr8Fe;*~(GcIt2Q5LXj1vI;vFXXc6V5d6KqTL;yT>hW2#D+< zRZxgpNa%oI0RSkx`bju7`yKy;QJ6Wfk4N+hGe$Fr!2p60jTBE?z#%%YzYJ0eAWM`a zIdI$n{%nRNS{Y#)!2WQ3zIl=~2fOs-<#)f;XPsr+z7-4C$I}d>l8&GZ;on!LPi2XX ziB~tYdS|9RpVpj%Y29B_r?0aeQ1{3zrOl(b$%M=(x3Cc|tjfD^UUpTfY&5*|XF5X-to|El=x_;ja)ugY$*3sfh~gwaYI5G-(LM6`q zvav@X07EMR3Z!^xk`G$S%eh%r*5-pukJI4e5@-+-?w`u78*Fxw4~T;aLa1ORoo5bK zQTiNyA^H+A;}H4#=t<+XE1)KXCor1vM-LF&Gaw}tAX&_nW`B7iwV4jnw8m&T2WeX)v~luHFez9%10c6G!eafM z#y?SW{^;tzlR^*N1Tl+(c8m5zxc8wodHI;a8TfU$=A(LvVtGb*`vm1JD;o5m9UZ1Q zO6sEsP(pT;9H1%NsWVCQ*L9b9Nl{`zE<$x0hQ~_}knGD$ier4<8$J+Z_B^hd4AHOk zaf=V*8|U#Zyt%CBu)*Cy7wvS}orV2K5KlxS>1#?CCgeC$n+^U;|L^RsMbEp;_(SOZ zqa|M@z@E%HY>Ma?c{p;}UR{Ot`5eEI7T0pglx@fD!Jxs@%w?_=1Mkt@A|`P}+ebR8 zK5bWxF%XJr7{~PL@)(ECWVD+7ZR&0C_WuBBF3C)r$wEYUt&vGVLDrd<{?EdF7wVomga|9=$#3KpvH=XjvY;E&Wk{99MSD+`ey7mm<9k zFYjIDdNw3}o@tLQB%@RslEp;^$GS7mHfX2pAlX=P?1b&C}An zk2sQVsBfGsG)RQ*KdhI?!WJ7r zilde`kdOlZTbL{N{qhoW6ErxCMDRc&d-!Jn6P#}yj8D|bmB;4tBKjC5@~CrddUWm6 z(22FxlO;82k{s+3cC9jui^jiCMfs`HGEi{+^+~xf**pu1c0#kwXmZI?bkQH{b5*vZ zIW;mII$PYJs1C4+|*BD?9F^ z2gLBeBeyP?m+v?AuT}W+oJFQ%qqi3$jG625|dQm^|GF9yGKpi}Fr)!4#aVr zIa(3~MGvd)4l#l~#eAof7rl7+@XO&S5TNF~K~r|%)lunXg-de>MD*4%>}8isRa^PV zkmJX@0HxmRA^_OWp}^7p<<+46k&l|AwVJ^m@NKa(hA$XQgo^DOn{Z)xrjCv@xSUXK zDDP}ypGd3OxzAE%RpkIwNLkkLb>_zkw3BRd7G2EobjedgQ6TE?wDs%NtPIbM_Ycu1 zMBI#`02fK{Lu#80*Xx#uEHr0g+r3lJte~8OLke<@2j?K-NR2($ZcU%Siv7XMNPPt$ z^l|_cYXQjQixn(+3~#ImZ`=ztQswvN{r!{G^ znJB}=3Sw_YENO|1EZq?ko(E5)tUkf4ErwR(qMPG&7E?BwC&SCPgP0&wSjh0Y_^y~< znNXIkxv^|3m=Xc7h!LD@eBF}WXQCk`v zidtJd?~26gbnDM6Z_QTYd^Ix7z_}U35&EU}^kbpIv8Gk@s}$&h?K9Aq08JqTs-<3v%;36@RWNT)sY*GSGSA!|DdsH_3Xfa=c+*KV z9jj&E3WeI-0y{FR(jF$Yx{8|AROly|uFMLC`i_CHmVwTt`#s^}Oqk>D8A`mIl4*e9 zd#iTmnr3EDrM97*cx6adyiy<|IZ1)*EFTL^x;`UWi)?Y6C%wMKdZ_7L^6QR)LhvTz z-3pRu6%hurH>&q4Lp0~Z8Y=rs6c*N(>kF-Poup2zRIBce{@p+}04hq3`A`D~t+yJx z1}3TO$M$#6L`Mbybdp93>TH!RW-a`lk2z zWO;*La5Znv=Ldhz{XKBRlXI zI3sGfcmGNb`y2*5&H!VV1Z)DI4km-|_Q$NbeVdO6mx^GFJa76;{Qh*M8~NJPKAFu5 zU+I-_CEqpPdRop+Hr)Qi2JWwzQ9qu5L?u7f1mHEYJmdPEm zboa#r$NE?+d^Mo=YT67!SUo{0H1vSh%=JN4F;z|t4f>8RVgx@3H8J%IPqwzVz@>g`$5Bueus}17`-_0V0gb{OL zXtpJ6V6SMGn6jky&M(Kp%WTy6R3E%_nH{XR(`r`o3KlpeC>y2`4Hu=&`q5;;H_lYrU^?oV)6hxiaI`5tDzpAmZ?VeR#%wd|PxFp3M@^ z(Y&oPX561*19i-2m(!p#uI$IzVPuy1iE1;JqfQ~vS+&XB*H#!;5~qMAF|v?{0^zwB zu55CEdUMOn9&D=ZUeKnm4Pf^tW*NIcpTtWhe{4sn4JO8|HpZk(G38LC>^iJiUH4^M zJQvnxIcv~wa*K3hZI10M3MszD()Km$viGS8a{WC@mRFEcg49dF%gITw2!HN9I)VSw z8ZXB{Zzqqyev$5EZKeZ5mZLRi-uOp9=FGc=3#~Z-=tbI4Xc5y3iwz3_Y&%pnWfZh@ zgL7GSWubsb+Z1E$awc-g;P&iTIO2q2k5Rv%AnM`AP4!cPzTOA4S7BOh{z3$@ErGSN z)Cbj1ahu{iR7zAC?O1?B6bj4BcL8Q^^PrQB47?tcM_?+DiJLI^ zcnhm6h6cASK!u4lr9p}vsR`sG{2U$FqU0NedqQgde2$8TOJ@-8Z7K&qeOd!KZJ&k* zPgRCY@wbrk@m(zk2E5IG-6`+>FvWo;3^;506gXNo*y)2C33kj*-#p*D$)a~ja5JGFhb{ct#$5wm|E$@s8)IHq7H z!ahX)?nI9tDxa6fGuU;uL$X<1-)e^>^HCTX*&*2tPbe)}!la~&CFeskMoXr|U*h%x zZ6z0Q+>5|uYd!fv9O`#}5Qhk8f9NPKl7DZfSt!w85R|)JyTcSub^gGDZ4Xf|f>5oK zY=ukFTXR@~9g7efY^m>;>YlZXcs6R&S3?CC&Eh)b|Wx}GrvV!!+-X5eY z(+#Lhs+PukRmH<>^;tq*-3w=>yw8 z`Nd=G^ii$cYY2+Y*ux#A&p}QXjp$wieGxD;sxv%^x&~HIr0jZH%?!?QLEu@_d;g3l z!3!`q9lzBEhGv<249>>*(}Y^3C{Z9cX(n{j==aKEHo)>1(IX|>TwQ~NtPf?;Kan@9 zjG&AatHS^S=4zTQ;$wjY{JXZcPqgqk#i*lDO3ut)(|rWDW@igN3je5hsENSB%Ab4p z?7s?U4z2ka{2HM@W4|1u@6N#W2SXs|*>-ltwMAp!?HjZ1S4;!?I@YhVd#Q2owCe^`|Z~P1}6q800^Ddz!vY*R6uqz1?*~dQuR({tFhg&NJ_BZUOX1 z#mmmh{dfCYrhlhX(hw5@f(EulVL{~P|7k?BA1zpelB$VYAeUm>lT>`DX~ z9*E@LwTjLLj*_IQog^F%qE@3!B9r9J+}m0?_6`9cTr2lgly$q6KtXrl?auc0n+=%u(s(OYTwCeG1{?l7Jky^1 zo9*9Oi6>otovJq9(t6FgMxjml*=K_2Z|cSdh$B%I-QL3}x8LpMrOYtD=FEHNr4`=W z`}giYmZ`UJ2GEI|wqT!EvvJ5!N|?}6cyO5%fBi}6cv8PZgt>WuQWd>FnP5>FW7aM$ z95t@#<>J+|{KIAgrw(QD7$mTW<8W1^EWkcG+q{Kkz7^(-X(AMI9PQS1v#wxsJ zo?#Bdy#shChY4V2@6qhUTb1+&3>+;qJZG()FX6^AB->>EB%DNQX8*p#y*n5G!k?;3 zDw^oC_9u;Qeig(q_dk22o@{q9GB6l%^UagIDPOr37iEMTioBA zib&9dCWOS7-|JPV?1cf_f=Bgmjyu>RZ4tgf+A=);Z`mYh3hQ`0d|~T_>3dqSU}g{s z3hLuHw^BrwnBaTh-Loh+e#&3D(6&3&z~InW8h+~gRfQAw^Ao&?do%Y+mv2ZG&FRu5 zB4iHvgz2+9TV8hhgkwULq!T&eYTzmLtVJyXAT$oEm~)!ZT^frJ$<{}Z>DU;jY?)+< zUykNWEU84M^_IagGiV{Ll~__4-;n6tlID~6aDDd}Hi1;RdjK0@<5>`}HLwNZV45U! z(kME~k5#0Nq0JhQoD)LboP0mbJ?TpWrx-1q;vS*&ibKRq0g%dnxvYQpCY=7R{#}@H zxUqBKm-R7?yOr_J>;&5ayN=jki!qOGzIIL=2MX!mC&&p9B`f~rfT%?#KI-`f9L`kv zA*w8;Q&pl@m%P!P1y^=7Q_+DLDkys4q#Q_@W@cDZ8y4q&i>-!4)??ZTL)dOO+ zmUi|%ZQYCH6eQ;Egh#tb2l_ndJFVrUe5rta=2mH6Em*FjV0z<_k;$XsZDn?l2Myxc z3PXlK*d9Hpw%J##{^J2^Q|X)f{4g<|8w9UFIxNI%(}qs3E~djPG4SAH?w*A;mFX_B zARyZiq8qoHgQw#u_fZBsa)AfrVY7E zxA2|$9A^axeZNd>Tf2TG!_Q|cji`;|K(bF6aEv+Gqb9WPPnM$w6c@lQVv0*KW zM12ir>Js!&t2|wxM%?B_d@uwS8xAKW>*EHn%QXEw+Y%uO&ZUCkM%??Rp8>|mSuJ=()P*n(Pml}c5#%HtB2O;ikgX{0~ zXj3Ii7}!uF{t)^Q32?s64fj_5`dg^`!KXUq0}GAO(%U^b9>v8@6eP2RSPosqA!#%eN4}B3=7l*0t00`>QOYVbiSZ7QO?*~A z=DOLb$uhZbyiy#p;cwZeySL$x+$D1C6gP3QDm`%2GsNOM&XOVmRQ4i_x=PFUeE6|w zHy8!qYfqO+Pnl-Xvg}{3K898z-5n*LD4BS*y{DCi^6Z8%QBj12&9fP#CKOF=M*(_8 zA9~oH{>h?(t}oQs+~K;{by-;a(~}_lXYP+gH3n(NeiccEJNPmcfMA}b-+;qa4-a$} zG+K_W9LvVbb1Zmy7Bt!SR(RResqNWxZCCwhvOSyJYwGNS%zARn%ZTtJ(*7FL`b89vf`sDW27#1-+r`$OPpitvjhY&`< z;LQ{rCfx927o08=8$#|dibAKG`nf1mBPujDYo3s(O<$)(lu>uHN4ctu1#0GJbU#~^ z zi9~i8e()SAVKyG)Z0}#uqf>0t_7G%nNVnv`AEN^ewgv-t6StK^viGfPo(Nsv@^CGI z_Ej!;ye=J(^R^R2GSaVN7LIEq{+^rPPx8OOF!q|E|3#Ou{BMw1CQhdRd#F>Yx${q# z!1~|mA513mG_OYDe{`kGc=i4>>g1M9zL$Rk&8Mwd+m0n3?b!W&0fAB^X>)a!Ix*~ZQI|9rLKbMX-SWk;gTI>pmG|0PUc5}hn8$|N;;Ze0FuaV{}m>ut1cn79@izTK02d&?^6i417~SF3!~>^_tBX< zdl~DO&vAK;+#8!)Q7`Q89?HY_tH&$2%En6oB$a=vYD@9fYidYBxz~L3oHvUW|G-S0 zNN(GDWrV)qp{1UcZu`D4>B6n$!0cH@$MOlvXR>rqAW3iB__MaWbhjWQyv0+C3xC6& z1A~dJIYVw8`@{6G2rTXF)wV;NSr|~QHzLG;jZ+Yy@xgG+YfutaKq^|II5{2(QSgtn zD;BRwI__p-h3!?5>TLv^8Yo-c0%c>L3yMRU&UG>GF@Ol(DLx@AlvT#KWM5Y#`RLs= z5||k+5K9ya`<~}f9wDPzE(L97E#A`#1y4W7%#F>E#0zf@1N+^Oj)2~Lw(ojt0e6l1 zN9veMwN&}4XHL`z?5q8vEW@iwt~FuCFZ>l=N+aAkG5F*9lbE>TDRQ*UHSKbHw3XR) zW=P7s(xJ|z(|xuBSIf=4Zwx-HbUTGfgwGX6(nXT3+KI@5AA3Jh)5@a+JWVW09*!(Q5K@Qa_#lA&@ut)>|B7+RqRBCL&ZLrJPsDzS_{pL z=3s3<3%UJ)DkYRyzN^wLk>}%DL`~YazK)ta_9bF1^EF?VQ|6qkBR3Yy3gH zgF3q%S}U6mlY=2o#}GK_npIHg0NKAevN&FbxCH*zMb|b< zoOKX;h;^*YRkWaZZOo0RgdBFLO_PZY|7pj5PkkW3zS}jxc7^J*+rr zkK&v21RsW&X{hxPI?k#kZYKopoMZUOva9HFm(|HbMtvYuUlxH@LX~QS7|iIiwhKv6 zs3+&6XkT2938kQCh00^$!-foAya`i-ZsW`Bd)BJ*Qr!b&YAuHm#H; zjjDd=EC|6T(AKbTza+TkxV!0|5uOdv!0(90D|^(ASZT?(4IJ@_`R zB@_&+5_cUZzXkX~7LH4ay!aJ&*#;eupZxa#vq7MBt~AmxoSgYB<5+LtT|_MN{FUCm z%_d-eE|u3onks6@^*P?}jL3+!bAx}ODLA?VM*;X)lr#1GpJ_wXDtm0Qx3@~e%i-Z~ z_B+c__;nHAP@B6x-(O>qtNOmrk57F5UH_+c`UdE_ovj(iINyw7wYE8eSeY{3I2P+C za2Y%wwJx}f-oJtj46D}yWkw+7ry#fVP}FfOMYrECe-`~IwcGTv+DCfM^@=|Yt=#PS z?;^izH;#UfMjjP&sScd}H5>Pw1Su&R5&FCw-(a%f;>7<3ztklIqtz;~i-V?p+uD+v_lm7&^1F4Yvr` zcb7OwTY&Z=YGL%5>RXW8_%^WIU!Bosa`t$?a3QIMXj~b5i~l_T`2AZLe4}q&;%@yn z>GZ!rZkZVw|F3kK)!eZ^ZbSShof_>|fXu`6i%4E81+xyJT0|Xgm2<&8OJAr`OJhr7 z=fAI*j}uTzOMBb}fI!^urH&JD=DtpqyYt;`#1HVdOmTjeb`DHmZ-#HP@807Sl@@|- z@Zz}B?lK5MXWZde{E^4bf5yZ8uSEtUsF*Zr#eY}s?m`eIg_&DhGk;IL5$&AL&hJbF zoycaZKAX6&J=1bN2I~|Luo9DLX5B-S%q9Xi6`OL7lkRQ<7}E}~^_TbM%LYY9XR4I;cN|P^qFIsM%>F#be-Q~;FdND7a z_gM?{B8R}EQXFz|y$!}LUye-DQNIlH*a6z$eN!`6AfplZin*q0g+y8Ql|d6$^O*qf zW|0ok_5<>6$|)`5O(fq<3RH$h1LO~ z@AsNpjQ!cJgmT}Bq@6FoaBzOptsFo$=s-UqXsDWa>bhF^)EfOM-gYBtZKf21zvVv* zY7%F->11Mg*4&_OCSvfu?0R}uI5qt8!jbXBV`Fqn2hF2w6gF0zVg*=Z2^9=|>Wb#6 zyE|xMCLlCBm;oJ|*c1^bV86ss3s3qKxUPr7USCdbr~ z`D`;VJ*-Zs!fM6kR>eiC2#Iahk@M+M%buu?4)=Wg7WfHeWR!jLeVCsbS#I|k9LOw0 z|4k+#bD)suEY+-re^P zdy>5Tqdm6sgW9*ltW~9g&mQ=ofCixqsdNr==g34lSbYTX{`NfLnXX(PhWkB^5UAkr zg$GQC6mYw<*Ta0Nxr?f12mE1|bvBMiI%=ssJE_f(@BoJ0Y>Sj`$1qF;d7Iu_>e-RxkfRK@)U445BtL34;&_MA> zDYZ9B@QS#kZGU!)=O$Zy2Ni9hK32IPn%8cPn5#xg0vf)pl>?8aQ^YEMSPAB^HG+E= zwuy(*g?(Ec@p7ET((!`s4jBxBSd99*Q`CYEnYcDs4k7zdoOf`P(xy0XKWPaZKqW(+ zt>QmxYZyp1dzL0QSITW?`ELj))#OFENEfKkk@FH29y*b+^v0$ieac! zdw}-|-GIS5mi9j>DR_GIAzdOrO_#VOVkvM^R;#Gj*Tq=q=%y`VMrc#!p5*mW>>J zqmFnu+mIoI+QlR|C(Qa1&LRx@5)^EFaBQ;luacnBz>unTl|Q<)3SfwR|8AImaBq-> zZJh@<8IG|X!i@>3Ll$4LG(sfG)-qYF-UD@su)!k27K3e?=IC1^-txw$sjr(1a1X5Y zNC4kKKqT*xd{zB0afpyf_Z<69YYQ53sgo6oH6xKm&*&VtRYci@QWY&wNVN{F>eK8W zW4at_B&b#>y--ohz0k_7R4o^BrE2SHk;8ahiNvAr#P|1j z{B!ZNr&EorgmKZrfLuGNLYd3__XZxSuq@;iuYZp?)tIg^P&AaRm}9_#GKAw z<>+xrsS~qs>(sK&8baN+ra4-rej;Tfj7}Q_yQb#4Tes&8F35PrYi}GAFwcUDiHC5J zG+hxqxJuUKVdJkPT?0(Aj*;kWXm;WxlZ;c|pV(F&UehWD*_h*ALOh#E0CGBA?f7D1 zp{$Xf^lODn3==T@i8`M;>KxCeSa;tIRDAEvkkyd*$lnxid6Vxjjmb$y2{no zXnVmrO2?dr(mg&=Fl(&C``BrpKe&sk(92^}xS;?VE~i5uUFOH?>$e%D#?*MOBNE!6 z^+dy4@oe=}C4oh!E3xKsySMi6UHCsw)Dp-rtN-nq`kw}SnVA^a{{L$#Rckx`-w(2X*OcK? zDU*YmL{w49wXh>Boh1}Yhu%w}C>uPNwjOjNsd}1w^RKTthj3KW`8F(44y6+d$>||G z{>JbxniJt3e+LE17d_hL;KA){w0(~ExrYc8ziG~NXiRi_&{@f^7<*H3~HJ2sIe{L$81xu=F}ax!o%*lCTn z+2Jq{LmTmO^SytEFvi|-E3c{5?yl3?B*jT!+srnXT$cLy@+;6hFIYvoPeg~PJ- zmD6ttc;q$|&{Wd%bosPZ_FdD$h(y;!t7OfcQLot5Z&=TYBe=SUwV1CgNPT7^)hYwZ z{Fi6tK^5k2%49S#=H*=@AE)-zoJLJk&%_c-ti$xoKRJ%ts7%v;jP5169!fc%JR-|U zsV+ibL>K0U-QGx&{iJ&d_SOnZ5*XC%cj%;L&*9~9+JyZxJT?Q9DbFF@@!3|Q61z_Y zxtW56eX+K!wrw2>`flK!??u?tsN^4+vUM|Up`L%X+_1gB&6T?4ZmtClAnBOWqe*vf zEtj63x^BC~otSccM5Sf0ya>S85th|opm5^tfbDtP`x8c{Y*W!IJ*SU4!R#8Yi`mr6 zOcno@rlzJ)w#%O}>Sx{a6nLANCN4cS+shNj=DB}E(kl!UzD^es@-!}yRf6jkNdvuq z@W99jlU())(|GU%4+23Uyj#|Y`}JdCe=&tS)rDvJC$r&ilIz%Kphj#2R1gErbJ50n zF3LpznaIg(P5bBAsuXdmg6APZ&<1okLgR=)pn2NUs}wKd`4i7gA26XMnaS|YDsX^p zjL!_FfQ&O;7{Lx=ePZxpnRuRQKqe_pU)7IKJqjDc|2kqX6GRWEb_@m|2N(2kYxyj6 z&tTjF)=NTh2s^@&9Z(q_zE*1jT2PkTcPntf7{OTS0x(F2KiEYx4Hcg6U$&i3NFkyq z4UCfIen%5velis(2x^xMr93q#6a1DqJN-;go<;IQa8#5sK5NVygSO*v-hu1R!8HDD z&r+-`hr8(H-SETFAc=4}pQ$5)_X?x?8M9c^SrI0}BxmXrjjYeiC8c*L>q9uraiRC6!= zPGNC2#bVCc92hbVFG=|@41U-D<6J-grk6%K^($S&|0l@)`^gis%TGk%{pT?1CKLJv z1zzZt|Lci(FK9ermC5>ZjmZ(Ci>^egn@=`w%{)-z#1c2=1JK z`Ec-@!0y0XNAL)pYa}vF(|$v_z$EhA#BQhb2q@|HA)W%Wm@s4?-{whOa&co}AdZq( z(ZfJ0Sf!~>o{c}m@Op;>M|?tfPf^H=S%C{$nl>4ZZPJR(uD-%ZMG+|HTX7oTNaE3I zjL7pj+zrQeM)723QVM<0w#tn|K}q+-XNQ9dg=;yLyEGyfQeho@GrK~;w4O+M%=qeD zWl!}w%UK-zDz|J3RD*yvS}2l;)(MqME}`^BpJIwbqOtOWb`nXmO7#bCF-esb6MY3U z-+VNfx5iLlpJ9`O2B+O1He6QI)ZqA|rQK6;ZpcUv6v&gCTx*U@u&` zF9updr{F^JE~NUy;GlC2DaFTp08uwBtm>iEkj&mvBGB?9>Emxt{PXW$Zp{YqUQ>Of z1o`vHBqR$0?ygRVsrBeHBO;^mK9xz5Zk2W*;4&MI@-~|mDCHZPHzW7^109Yy4147Z z?6V}n0+oYn6U$==;P^rtVv3ORX!IJvV+K&QO7LP#jP;UbkeG(0Je}+jKw{iswib{a zQi=%F9Pw<;EJ|S};Nb*efdvylyfzVJ9eTm!-hFu+w68J2oc+%IOs6km6VdYc`66L&~t%fdyW*$r6badvq? zKxSW}U&0X>D(3vI?d47Ek?Mzn>nFfV>kE`&C>w~JiT)>CcV_^NEbRAq8XYx6ODhmt zIiJ0mhya>IqPjf{vLL*^mr!*#nJe2;m+5+^l^p7-j$KDP62W+y zQMv_qtYX-1h7lkfTQ<4@E!w{EZ)@36YLt>E*TFc#NpHNlIY-Cv`=bb3F+d1e0Web8 zQbvoT6&rGssv}YI1TTSShNbP|=bZ^a(b78It^>5r7VD3DHQ*<{z`m2^&KoYSub~H~ zngI}fXfd_d)ThRwF{Ee&8_2}c4r$#ed>CgNc$?vC3Fd@E%||VE@`(&Xy1tR39PCGM zG!R6%X)ln#oY&_)-l+73&;_@`%f6!{uArs39wwz z27-8U>jFjVhMPS5Uv+xD z;)9!U<=tN#!Y+HyO?t=l8GBN%G&E!u?#V_6kXV;KBTplE{xn*&36z`aO&uHt{Az8p zeOhEB>=DW}eti$Lj5>?`+xM8tt1p+wR~1;X^GFr)Y4}41R^VlDKY$t+0-|bSm;$?p zYSeI5MOjuqK!q_r3}EKc4F4rT$0rz&d9X0mt-X~D zvV|`)^`;A%2I*xGfa#_37=P2q;>X=iPQ_dNtiJWH3rzv%&1^aLJpG2LeCP}Bi}7F2 zj(LIfo_r5#$s`4RFX;Ah$&v+iG@RSUMMCBw_~A;&o2hn*m+2L<#<27#69^Nalo?PR zOwbe>wnK?Ab|9d7GYoCqJEC<^lv`0Y>x0=RgLWBKIu$I;s@^{r>_N-;N}Rw-HE|RYI zoDwF^QwK)9C<-t$*ydYJErjp;i~fAYqW)j^<`+Fi8J$->UgEGpsUN6;RYd0&lyyO< zbV_Br%D}s1vJ#w~>TC(duH;f>_nCe5SrBITpn~mVWw5wb8-?E$AjNg~a0o>DXO>o` z%&XPC_3c!|Dy72I>Z&(v1B99k3u|EK&RuqAi2ckP+B6F~7woWH%9a1hxIZ-dmwEr% z4Ulj`^x{yR+;uYUqvZbXuWat{)D$nL{t6D?)AA7tU~e42)m27<7KHDQRj43HJ4hmy z3tO-J`oj*y^}+RQF4__A&U6GuJ%d%c=a z`&#wrJ}r{W;Hr)(18#xy&W5`-_~<>@efZsdCkOtf#NXsJHwu{Pu30`oCU6w{8>l4C zn^0*GS`e$Os;LZTS)j$6m^8A$}$INq;yC9#9vr<)Qk?msf3xn9r_v$904+T2qU!(nh&woqIWdECegynymFlXodj|uZq%=NfKwg=zdfidYN0qsPI zi-|*^alN(NtD->Pv7>(r=Cs#iNyHQPPd?u(qPlACNFdA>$-_pC8a3MgQsH~LApd(h zhR>_Z7h{C+^WEa&u6t+1;GZ!AcA?*8 z-m8|Ceq~;kw3Sz`=m7|XmokXQHH3}$5Awcffchq$_LOk&RM7mp_-n*}>*s@d$AYI9 zg*RHG9>KeNSxAolg|IQZkOb&ZTovG_*Loc@L3(wVc=v$#jtP*sQplw|R z92qb3aIO5SwXQzR+NR!<(yo&P2Pl98=Sb~IMe|hc%drN$$zR_uWjt%d5)90cQVxew zpFEI@QxOSk-7~M-g=V|OIr#Bl!278|FMl7G0BwJ~)vjO48+dT|W&`|xR&fW@^3PnHNP~a3i zDU|C1U~a|ePL@}e2Fi$(@E&imED0V#=>~fHgexDAT@x>3z=8{bygdb21bmGA`i~d# zQzZn;E^X?H85Re}!rlTrrh8yd%;~Y6{CEPY=N<%G-b>>#fF2^}!8#eRB)i(2fgCE4 z7!e<^ZZ9#9!Jt6U_7askva+YfU0Tx zwyJ6}WO2zmcwtSx9c-llYUBVk@N&5{Nca$zg7P67TSasG6iny?RO|{Fsm7yDF4wC< zrx!HvQcFx*+qoD5OoM=vSC0EWMz_BI)=bI+R}xR*@Fdc#=D+5NM#weJ+%{p8g&sf2 zL(3s9|NY{p7IOAsF!%4-=pdv`84VObDqRDfoz;`hbW_`I;oRv`YpfA=7lTA~WN5g% zvq!vlo~)8AobR=j*nB9tOKC>SJcgk+o*dG+8Qo8M_O;NFENUMQgu#F)ZC-UqR1KYDFs?lKU z?puiggVeP+U1d$y>w~8L4HN`L>Y@mTDtI+82dbS4>72Z)Vr3 zJGj>?NG&Uj{Lb*UtX42Yfs!mgHK5{5B$g-Hd@~rI9$mx}a1c zM7+~VKhRQ3sFjngt{2V{TqM7L%k;>9h#390 zwRj~}wz)e|+|(d}lrOHiRCJgYgfUjKV3TTAMRL4Js=0R+@Iy)`fT{@v zd0g|H9tR8iNV2s@3Owm|tHcCwS0pjy=GfPrIvb11HK|@YmUm=Wvvjc2R^^<{zDhOa zx^I7TQM}#R7No*MRR-fE9inhVVIN*nqwP{K7rF4Ntc5H#VgBF?TNgrfjK~o^ zY!At=%JBs|5Rd%ab7z?0B_!;=PK1nJ80lY|HCIXBzV_B-7;x99svMv`^A(w0=M5i^ zT-Nd7i}x=QDw>!x{+gD#6W-M&;DE9Bcv>?tG+XMT{ehRgYTb$`!TLC=vm3`<73euOf_m z6?dWwg9tuNc5d``A2F3769s}vyV*+&RDwJXAk%Pjs7CghlESs_9ZB%Vq3Y14ZkR}7 zEeqTl$ERa?7=Hf7HJl$u9R0AN@L?G>SuoKAK_j%UmJ^r{6RxF>oy~c zD`?DcS+Dd|Prmp;`wk7kZ5U*#zLdHRr&pRHbYUY`N-eV6)=0--!Tq692 zRL?Pfa*e95upe;@(7W1mtO!mt&(l4n0|rPzFR-9Xoig-!J?~p#v+l~_&Woxe_9yd# zaZTnJNC5o^Q9vu33`2l{0SEJ9lQNQiZ|ZM7U}Bbl6KKLe~cMJIo{N0Lh9iwfHjf67I%?GeoM83RCl&kGO6SSj-RbqPc?MVCEU`(rw&O6bq3zX=(NI!@tG%1n1WiSxCUwil0X4H6M zH*T6}O70_YQ_N&glFpGY(-cecMsv_~w6}Mut_%v0oZVyQh6;n=7~MaOoT|3rOO82- z(LOQG4i6{GYe!$=LDM~YF@bxO#Xp^2Z~yl$K=cOi*UzYKZsw!-x-9~oE2QXL*O@A+ zp1Y(hTqf=$5>`8P#%HF@Dr~=J<6Xu{qtrZ^W&~MFFVnN!#V($MnqLugklFp( z7mKovHXGxwb+G)D3IeK#MD%H4JwcCQOsxjHgb%^}fs*(^spwD7AaTF>{+>B}g%^Lp zC4jp)&Y$q}rsw_!;Z6ZO5whhy*^dc8!+_ZiK0pWxS}}kL z13p8j=qZaPhCxGd7@)7n-BIfYF=R>AggfkKliMb%7Zl^VvFvm)C?%>e;7#(eS(=r- z-~3iK1*~iyjfvAMqQl9nVGfzbp@ioAhw`>Q@LB8Ml>^uAY5yTXve zq%l2nx&PWKHkS>@maQ&oqaa&Uf;lSw{d^j|O6XqA{wxN#R4@K_c-Oo6y|~=%mplGQ zhSH1pyH>jX(2F-s8W-|E&MhOg|GV^MCmIS}@n`jz;cz_50bC`{1Ve z)<%0kB9O7MZ2~Y>v{S%u60!(+gySS+Hz5g??(gmX!3F+j z8{Bn^jkj{{zdgU+M4E||g#fI60~rooyT4;dWXy!9;@w>UEy--mGF%#ojR$t>6nT1b z$2~8*wP)kWxZ&(GTj0_R9UzBX%o|=vcz8w`Q8Lcgglj5t^BN zZh4pCIpe3DMd>s7FRS$WH*N$Wox8B3op_d;iSBihJk2N~X~2kbP(mhD;Dina+fd?@ z^z^pwm|6XU(Xg*F!D~m5YJ<{Tn6vlZ&iWhH1q<->d#{ zh4cclfCgffyi(!3lT8?Q(*P|ydwP!T#%ZRU^a3Pg%|?}GIOM2kW7IVbhc4Y$|};yhL~Unf6jtj86XmauTAd8E8> z&J+P{oG5+Jp+N&>uf1jnwHdPfv3UBsoM_oqcw;nSCqA6-nf=rcDt263!wd}~pX`Uq8B2hcjMf#eZxyF5K}_Z}_|Y_<85-xA)!kNCfi z>uN4u7dmGf=_b?dp(O+|t6qDVW$+L%ej0gluB^MrisgNKBSFkTAH8C^an23ndrEkp z%FKA#Y;)`VpnpG6j*6KoOVP({C<0k1%@;_}+a#Jr)nv~1b>NCedkJOlXofiF{+Pwc zh&%CR!qrVK&ds}811IE!P8pzO8h-Fp>@HrTMvv0B!$-ODFhiVTRp?>`D!0N-gq285 zjDT8VsLKtuJ7BRThdEASX49bM7kX3O=DDnRXe7*d7SMj!IBG8gpaU1+rg@+PkZi-h z87ZeA=cXAC{W&KtTWthtQ|T1Hh%@zes2e8Z1I&608BUX5v-)bT|LYG>`qPXUX$Z!6 ziF$H3Efd!}f#5w!Yy@8;43+H{mcBTdyMMmnh(6`WDUPcba1Jotx3(x?o-BSCO^gsQ zGtEp35K4@fHW-mWU%ugg1`+)2I=&wlM(3kjR0+vZhydn|fXN`xab3VN#5b;Ao_Ar) z>5)VnrHv{oFUyK&DVY^G+-L_kif{=c->V~@?+iwj`jThj5EvzZ#ZX;Urc5-oY(ip3 z0$3$U&4?mEY90|MkI@!$mpH4?vI0;1H|2YuD>^JVYs4-r-h^d@Q9n%T#Y`6J2U6~` z@MZg5rf?a-{l?5|sxYdqH-&KXb&MDRHmAiJ&wb#b zCLqYqFdKP(Km$P;KL>DUOvUEL6@WYW`@l@xJB5HfAR5PtqI}O$vVPOUm|z^ItN)N- zoB&4>>@~|`zCki>vdR#5vd}4eg8oT;Z1a^+@a4I~W}}RE?s7o^Y(j{@xng|O)awr+ zuhuH~-s9Hrq!OKq8bxyzHvbNdFse!)mx^PqkyC`yhi{HO&z>?ion3cgKj~>^h6DwZf-m+@T*g?*+K>p7 zg0jGto>+blUj1Kc0-cEhbKf3?sK@QWHSSjz0z4F_k7pJla)rz-{BpYSW0lyX2yLj9 z(iiNU`Ha{b97NwU>pFCO%_n1B-xzi`4F@cf4HJV8xYg0JSSw_%wIYr5GH&4ePki=C z6gY&Qo;@k z)*W&w9TRNj9EOFJab)5 z?v0cR4~=No1KGxrg{~p6fw>@E4b*}d>y1{{blu9cwhll#$D{W+_b}uvkc5+}&7D^L z1OPVUdlV;91<`Y}_$0MgZJp17g=?7k=B79P4}= z#JPM2CChDtf#?}PTe-m?wVGM;Rev;wz#I^NVBq?pK0J%u>%zfdq}!q7x=JPAcWab~ zo>qhlFQf|kBrHS=Oq06Ok{Gsp>4U0bA?s@E} zwc2oc+BD>84ub870yrTFx;@jT-fJpd+NaLS4RHbt?`aN3G}J{VGg+hGrU)SMD*t%- z0KZcPH#l;0VPLmsGP1k*^IZPf14p~kVk`DLFT7zg)4(a$;6oV9)6QUgv{hu(f9#8h z#Cd9DT6FBEuPNEg#T)#tA_V3+v`zHR{hc`)t`hABe`LaXE-PfAc8~3`pOw z=tgXto0a7jWV&B=OY919yxNL&Hq??tCSw?*$;}o1!Ngv_DP$h+C{E*2wxS1ND!+sX z$Z7tSMtlH1=MN|;t^5-Mz&KaCreo-{$e3Ec;DG2XvzCYB9JbtS%oPx7OqF$7i_q&d zCE7Ss6i2yaJ4(Yue8kRe23Uv;4OeI)0R}bNNta2LU+CDF`%1|#A7oAea^5Vg0OTCz&kNr|S|>#CzofKPR({h12!?924vQ=6Oea+{rU(>DPYy zF>KNFfGmL}OE(fz{^3}ns*C$2@-#w|1XrF(VRE|KJoc`JYj^CIF*pbSj`nS2F)GuJ z1!u9*9-uRG+=>UhI$^o?W2f)HkNO$!GZf&LN(83EvF!YIu+&L}1FliRb7sQKT#B}! zcVpW0KEL)o_x-aQBiN)F(aisQ-Wx^_;s4(b#{W$u!Or?0^li&O`u1?_|B6e6Z4&}K z)$e%M#({Q@!!2j~Ku?9|!7FM=Ev-2%In#E(A4$S-JW0nS-WHD0lNm)EIB@)aB~kRD zG*oZ$XnOsAAqQ@s@k&z7AE(#((7Mw5R`B-3 z&-LNUTGqNdZsoez`TlPu&V-jky=*NI3qx&ue&%ZI>+;a{CWKW|Vs+bwrluYJzpUjq zbM-4dE620c+NpOU$MO;zBA-}k{V11;|E8U^sP$X3Z|aiDaMi4hWj(!YEbo2)1~ykH z;Kgm$*~`iJoy*1R@*i%q4_5M$h531F1n!}K__pUWvVVi&^W()SPPg0(QEAugw=alI zOEd!86zg~jk*avkUNK{15?5_B-XE^eONXzby-2u|2*4-!M?+N_%+-0!z+$U{>be2* zMzKK^$F_d`IW5mN-h9BG^>sf;znPHxemgQMwN0 zA~vwLq3uH%0$E0<2W3f(7(}zur%A1R6=-CD z&8y@#Tt7^I^ng4+rY`NERvzNQcXL<%^3-;t-G!Y7W1G{^VxoJaR^qid${f;Uzi9a} z7%9 zVdEaX4>6Fc;`1k3Bc@USQo*w6dv>gGh`SBjBCpPYkRkW*EpS-L0LT+&in*R2+{|PQ zXi*btO6N}0KrHuRaSB*D8J-@j4B3ij{u6j{rRR&%3ouL)-F{oh0?xMR{@@ZydHkk> zls3Yd(jZaF&vY`(Zvb{s)Mt3`;qrC*4kMV~sj(((3ZaBS>f{|#WD{8841Wb3?SAi= z;?1)ch?j3s7LR{m{0}v?V&PfU7Eat~nk#RD^Jgay?wdW22?-CPf0wU;5==lMI9@5W z7!fEI4T(+2gnIHN_w9wJdU17owIU57I*v>EqMDa9V`j=+vmA|gb8uI*JSb71(S;05=g$?W)nXYGyq$FHeSG;=qHLuGV1fv|O7iceH zE;fYwaa;CnV@zMXWo}svem8^zV@GV5+p3+>I?IB=x{HQ?>{4;|RNb_9p^wxRelKk< zbUm}~!gLYLzONC+{8lK$uN`7S(LcmnY3&}*jse3q<^$9d>h4%%uSjdcRM5*qXb~zo|3I_o}e*aV$>sq&h&of1`2-W|0jNtk$+Mq~zjOH%D*TlO&`RNq=l_vrln5S*;U7o0Tpu- z2pyD^Q7xyW2Iv1}q-)4(xL?Np#qH z!J;|%S^19-sE!XVh|sAeJK86l8Y4T_E*{EFWmAzxmL4fGygQNDf+;G57Z=5@f6h|? zfD^(O5tm{n1dMo)k=BbC#0{C z$?49nh>(Ka9CmQG4cZKpJ0$)RIF%uUA2)tKY{9XF2juHKZyN7jx$T~}%u?dzPK)Mz z%Hn>`W<2HM>pnCId*W?eXZv>Qvy63rK8a0#17HlGgm)*w)OO~<#>&|;_tCSVF4UO` z(^l=y!FX#An`N{{_f#n}`^bh4xvoQqSBy=tQ_@m3EdJ5;s_lSv#avxHNxOKesjS0% zJuUUA!A@#+dx?o+dKqsGpdR1K@ zy7vtU041xxT<7RoMBStS@N3L~=?LfmvV-8+KSqZvz<^0wmDoWMMmZpeOP(SIT}AB$ zP?W(zu^tee_>Zsp<0&;aFx>@=j)tbE8VO+fzcErTMop55UwWVMg|9rYsZF}_n*2ffT) zyx!mAq>)?y2D>qn@_kkWW?nax7*UGo0_Yx z&R|v1faaaTDbiA+!NaZ#g&u{S9zj8Tr|=XmDM*+l7ig__meX zSjGgemD}3(NqN)86%AHb+y3|QEj?D1PEHo8;vTgWr}pQLG52sAGkp{?XJegcCbhJ= zUe(z`|M)EkCVQxZHJd{+C8x%^UAJ^zxyU9UJlVY9$|q6*O;uJO_iOs4<0>%v)|>C4 zdmHfG*8NVmd%H9=){n0)u_iXEnP&4!jB4h3r4nMUUZEzic0dkA{cjEv^nDe_>=ulv zH*UlpY7AL?b5RBZ5I1Ztux6IV@w*v#m6F{SC~GNQ=hAVW3fNr_siO-oU)dsN8oJQ+ zy;-#B@ZH>l+49xpr68P&@GQUtqdDgfqM8$|1l2mQPEA-fbiMZ?#8ZM<8XOu)K^bW7SaYdQXv@`G>L)Q3 z%(}E{B}$tsC{l{*^s?(6=lrSAY)M$q3|wMAUR4?lGE@B*q0uRz_nTa~#kBwr&8ZL= z8(ewoj;{bk8FZt&068B(xCD9*ZMfCma4*0FOmkd&M1rjuuX zS#_lN_n0>G*+?j!In?6Esa{fTv^40(oul`??+|co#yvc6LLZ=kz9OaQTovW^jOkn3QfiMW&du z0D7zj;FS=Gh+^OiHgKEOc^gIl>Knj$M!D3?ppmMhqd6TXQ)i9Aa@88uhzR)HdUeJD z%JfoZd*-l3=>Uzd(^h-7lUZA@% z%u=?=Zus(ksjA54mI*kfymvO~V!pD0m&jC;uhv)PRIQcC?624FG9cOvDKqe^b^Sv9 zri$Zl7f_`E2w)Ijw3Pskg#+z>lNA-Yh^o&$_ahu};hSg64<6e>m2Qk`(>uPSU6a&| zT|@&rbxPm>M(JJba~tCC=tM=-B`iW%p%Cw+ZAyyI3}}g)R-Nn%1tTu1JKO~e*D$tJ zChGb1!MYz}=`X|Sj=aX$6IvghJ^H<%#FBlIJI*v{V?l)(9bON@SqF3hL(1F41|T71 z{+^<+oJ2KV4GgP29L?zoky%clAKCmQ#p?NZzX+3aw({0theW|5JlKL6>eRTfRm0Up z`H5(?2z!s<*ZCnlpbWeK^DBM?>sKE9!S2vg<|on0F5gx1I%dO;FFYhTsmuuow|1tZ zM~a6RGRC%`4DGZ+sBSpxhPK4f8d+iAo!m#%U5B)n?IU-8`JDL-11Z_9{7rRMutfdE zk6soT`q>D*5_lKUW()2+bRIk1kaLN|M69lIXp~&=WE_M8$supfq+th!G5(3YRnOAc573yV~cn=@!W|VwV@-fBKv@w^{MIj*)C;;A;bGF=2K0klrE~yY1 zwX@0Oh~@Vw`mmr?yxE_~O=<54l~3$Pu~x;ZQSxBTIbGp`qXV#UeHolsVtF0j_I#C z$GdBDsyfQ2{DrPYU{wAaqeG4+eP+UAE*|}|u9{b^Z?Yjt*~z8YC*X658gQsvFL6kc z?XFb^VTiWVc?yHhsXaT$wk(yf+y0NuaUHKkViXRPZ5Q*_e);PmD9(z?;<@T)b%P$m zNdYqYg+0OTvH!gWVw$T=$X1xR=eVob6|uJ_sAy$FlI;gl_u(39zd$Stl9SD{?Nt8@bC*U=%$ zQG6F=eU|d3^O>{-nnuwQ#2o&5m=MCF z&U7wVqCR*|c|6oypUrx)i`}RE??XTWFo*;|6;%W<#3>56;kim6wA%ut^l)++lSfF@ z?}rQxqb#SZbo;NDmE}}$kv+w5fl?i=d5B{?cwA--)&4@ysZT}|hO7dn9UUg>(P+y& z$zQ)b`Ur5JhnKC9{SjE*Y4zWrN|$hBrKSY&>FQPnF*OGaEI$`TsT?2tZ~ zh<5d0X5OdC6u8%89Q;bGzywruGH_5w-Rp5V2benAmP=gWLxyvR!c)u1=n^FmvDboS z%<}G_m;?INVgQI@i>kYtb%k!8sRT_p*KmPg7*lc;w{@Yz%Ufz`;aJ4ZO5F7IQ^lPP zQff1Z9;C-tKqqC6(%}tA?C3ngjyY-u56_`WWkOq1;n15K^voRlr*F+Qk16&2iF4^o(x^FUZjIlx9|b0ulzzN;Y4 zi0_FQv%yf7nUImb;WQhQ9j<&N!Fq>nXNwZa`Rkw0A^@9W3Wo-u)qo(`Ax$_W7sKnK z!8gP)=|bVx1QU1|;B4M9{}4$Ch#ZbFXK3JA(%+Eopu24n1oVEdECA0A>pX@rXhTOl zG#4w1ym{@~FSVyuZ8(B^6Mf!Qfi##NaWr$kd7)gFgLn9&p!he>02gR@g?3}10zuO` zm$ZLMoPc$`CL6Z(FmTKVQzS>`Eck2F=A(R1KSs>BNxl2XVEb9?FSkw+JR|SWlQVc~ zwo~B>DAZ~H`tOCki~AGH6%3j2F#|jstCYNM>KG|;Ai?p5mwmVH{Cf}l)}A{` zCvekjO|Ciq!l6_+Q9gCaZU_Ef@!AE? zSt6$h*PrLm#y#rnvcr>)UC+BA%%z-E-t~ScJrMJMxYr`ikf@g^|Gn7NYkUp9Yx>v+ zg|A+-;^KKEG7dr?AElVfpNcdoJkb~?y#jydVfAZfXYxmH@8Xk|IV0J~?}pDnD->DL zs}7b?|M_Zv|HS_RhiPEG_%B};Z2yzUhv{GR^#AuUbN?Cq4#)ma)J*Vz1cl+aes#k7 z*s#Wt7nL+^3F7HYBMM)pK z$N%IeemjeO8y=rnK0pBPd~6GsH^EaHyk)Xu_A9SnY4Th@t;pHL>7Ba2KJ-9x`ge1kRMPK-JWlP1&jm|d6W@gtpS4A4<#D?o@vxYk zC)d_U#UDPCFF;wQtKL6MyfacDP8AfYaCxX%2EcszEbXL&!^MRB@m&y@3Le?Ux6I$T z)Sm>Zxhr=2wy792Cr+7(rgO)f)MLa}-g(l{9bUtIq|=n{Z2wgW7s-Ev1*P15>}( z7?;AQ9W@4OmtAF~Es$Pxko-`-5>!ii8*9EIE*Suphg>T~cQN0&h-3;~J=7Ow3-R>`se@=0w>G=`&&bugAqNSbrD zM5InTd1JyYLDJ~NuqHK%b;nzBzNz5foZz?T*h(mr#u7!95 zHU@0tVm?~6y7()tWLwcu{Sp2giCm`16A6|4Tjjl6O|~vpyJ*AT`- zzpZ1)MY`?)6dKmRT*CR+=LmE)QHA+kG8XIv%HSlB-=V?r^F-kM+dohW9rOR|evMW*G)Wg7Vn))4mJs@#0lEFP+E@JHnU;cRsFzFwnf zkvrl8sq_+hgXM6x1S33>3|D?;ll(PQmHH2aM}oRBNA1LEpt68U2#P05fQQ}1y>pGV zo;J{^-cbO$+B7Qc9P)QB;4ab0@h;ukUD^pXMPy8D_@q%@Y9MciDaj>y?RN7Cw@<}9<+rjEttWAoF5#d z_hzR2M&;fky?Icw& ze+2^r<1nwpcNAm{-|NkdWj2+Feq*qZfP08!Ve?`-H`lI*(((}|z+>IY-7(L~O`{I7 z@5Rp6=H{lI8uHwbpW9HmTc5s(usGC4#e+mgZE77Agtrcl-r#gOZCr~_PdI@q<0w=+ zBLRqhAPFiuz)AEiyk9d=gCV08xDDi=REY`|B-1VBsB;V~h{_GxMbF*bu&R8%GIS1;@oFjfT(LCwo(GvgVSr+0;Uvl#6c_!MQ2ocLtzd zxws>Q929JM)VO3NW-4fsA$Z8?kvL$6y)q@ls$1ef28nvxl&iX)E5aGnFMM>WF<@qN ze;#q=KTEcvt+<@Lwkhed!?3mx#eIP+-Ob!)0fdU>=B`r7!>Mg>m3}A zf0933PA3<=cN~Ge><>NGyc^!HNh8Ttsz<)C&itfv z26A#f{fQ@pMAXH8EqDY?HTlzhFeXiT=PJ4Xt6$6hrus?>t zD%%fzBxI0a>W7H^?xfJRl5q7*U1>6wo>CV)aGUd-3Q0)Q5W8`AVhLJiJV7A%rNRtt z)C@LNFoeVI0wPHDc7*r?n#)=$^WWmn|K@mN{PQ38s5zQib_c_#{{+UfS`+|Nb~ncd zc@j}Y>wqS6!+b;+d~*wHM(PLziE6hWpBWQVVau`Rmb!p;dpfh}>8%-tk$sr+m}?qmJ+G2kKJ9ybnPuDdmIb z>a3Z4@Zz&tb{4U1D0nt`EGe}1cHU;c9RB87*{MC5#?)~f;Gm(I)a_vvK z&{=}IedWL2jp%gcZd-oeFLLK$6T9(@`mbeXvs^mbUp)gQ4h^C*(A z)xb`8Yfp){KAD#!IckKByo(elG+kC=YAt#a*A=#KDj{pNU-5`1M}j*NM@s=+M#=3+U)D(p%b2IF9~VXs+Qnl|bo~*jsgiPQ*m+ow z%m23}k`DPfWGgF1Y-nhoQ(-5V*?24Z2``=t@GmD=QfFL~g6v=NIUas>p0)O*)5?DH zB-smY7w9~eh0v1pAQW&yD;b5g>Ss{I({8mx?BRjvI5)TrOADZ=`-|w!3W^QDI+(cN z#z?d0#GxI1r;r&3DTxjKlP znL=c=Q6}_p$BG1<0&Eq~2+Z%XiuMk}Ep<*sV78mx74#c8@miaj=k>#D6m0E-$W}CC z?6TC&iahEqy>+b{xC{CN3)(ZbdhOdCmX>n)&n?fPt8hF(R+&6NESCZRnOQGcJZi}P z1H)F#m!gk7`(Kb&)ci$K8nV*--CL}qW?&=@O_&ygXa0?NZ^gKls?h2eq&Qz~B7t>L zEZCBPVe-7eTlKQ+w91&f%{pIaNr?+bEyzw{>~{wtBI(TvvcKfsP~v%X!1!i1mRDnOS1)`9=(D>|IObPVHa==Vnx-jr)Cc^tuz!c zXK)}8%wq=)%MxZkvB>Cj^a&gUO*+1N5!R$Qk%tmpx7#t0uxIOUg%Uv|uvp4X{fqTo z$7?-|lg9ac79j)XEk*}_1!8jNTUZG<@SB$t1}7wWk0Cm;j=SlL+rElmQDFt@pC3Tk zL0_A<5Oh$j9YO*>k6H(pUn71bA^cR5(Ih21A&Pz%c~?b4hq!uIA@VeYe}X!GP;a?p z63OyH(%2gnN~XTKw$p58kVMhTmhW~XR?EM`jItAT`dC(m=5@*Qtqy`P0#8on3!XKI zBXoTYCkd2WNQtF&H$s-@0=N1X0SCC-ZFNLF0XAEf&AGj_ih9>DM+Sw-HH=dZEbtZt zT=C}NaS*6{+YbZ?A(8zwTt=7l+}?_>V>&fO(9!&G z^kr}kRya_8UD=HsWT0FqJZh@F)W-sAbd|z&U0MpaA=4=kzZz)jJsg)^&SW!7(m{ei zRiV7vGtDAj{sK6g4+lYgohGuF!MHX_(Z4#dCd{$>r5lgk@*AEY@ODrQv?M^Km{?qj z>p~GAhUFDwKy$AsW+n;nomQrRViwVel^H^8>IWm&7LHTQZo1-nxI|f}$rKatUT?2$gQZZN zV$uu6NF3RKP*@ddDIkrL9)7_B<*YMKd5Q{NC5Kc;rndbcYc>I^?Cgu!l9UnJ)i2Q( zvU>u#E8=y&$K-VlWh|H-G=}mgNd^qWXj3cLJzS|#D#5~5$Ky{!Yf5{Qd58S(9K+B3 z&YCO5QKxJ$K1;06(?ge0?%Qw-dY5lRj4|Mh>2LNYq42nVUm5+Nly=ASehkmp-}Ltp z8>U{Lw)%~dcl2&6^_w>*>8`yGuz%aBt~M-qoJA=87I}gajHiHp{p}G?%y(7J#wn0I z(c>5CkLEPaq8@wW#QL?DUF8gx@VU46F)LF5SF^q}@}1fqx;GyJ%VAH(y((W7y-FUW zlII;KU_7#eKgvl*Ryegz9QK|hQMwVIsP3+m`T&p1Xk!mcjT8T^=7+HRi)lT}1>J+Xm;EZ^WcVI#Nn$DR5mEryF#^-fgL11D^N-lJO}EwBqK zkXD!v`!N8Db~E2UXv=#FluUlr%F{~#h$tJb4&-(arUFhwwLBXgUlYM(=By3wT%S8P zG<4J7YYgW=-&xW8WYFCD_e_tX%`vdtk6q%G2e4;b;9UBl$6K86O**V8jN0 zun_Qmc&>9qS0o~=)H2#aOGsn`4gyiL=?COOy+^jg=Kxv6_KwVXx<+jEf}hEdA&;F5 zyynOnioTV5qR-(2DugwEzfktIkGzneM_bsN)9#yO+|m6CrP|T4&3L^?g_yA{+h9(g$t?v# zeT+NNJ|H-)xcd_~*_=)gYsd$6n+p1nDLxxvHOT~$a6$tli}PQax3$ZgQ$h{14o?T4Sxpp9l{Ju8L?-NGFM&62_hK-KxZ8|NZI0ih z8K@F-_Gx)HYCrE2KR~*dxR3wsbMn8*q!^g~V>Vljp=0+CFVWrGAIDUuDiT>p@>l@4 zYHqWc0||RC;9r0oHZ}b7ew%P_x}fLBoLxY}F>dR{PEsd6ZO^{Le0a=Qqz*h6kZSCff zOa5VMZR0>BMORXL1z|Wi(ov*7}miCdb@!V;ywAcfcbTE|&5s;KI5QR72!fTl1EOFcm#T zmh|Uo=6AxOb^MApDbGZ=KI$HiPlgHxtwu;SGeiJ8Bh&;+kcIx~#SOS6AE;42t*c1J z`IPLra++}*{?)_-E2PKP+(T^06F(89A}Q#7LGy4oaVQ?dN=5=X`2xNcwgCQiuiwu? zCwSJ4I;7JRurtf`oG4Lo)q^V}zSog%N&9@F$Cv<`Da50;ja!Il#n&C}wgDNmUuem( zy5e3u?%lO*jC?{WQ^$F1`qy<5kGANc4_Refxy4ZO)a#c*5e`>|jS@ z<87y9J-3ugPtzJb{g?f-Op}@~aU&4+$+@a&cYHe#c?ylf0x={&L4hpHRwYR!!SdIi z+bgUg4uOM~5OKT+BH0FZi3R7FE-EEpfku*Ey>wqqPa!>vzdl}jNC zO3GT({s@QZ$GB91-9@YZh%U(s?)On_PLLeQKW_?#+p}Gv`ig9kngwM12O0X@eyyb6 z!vQ@nNF=CW66xxWB4|)wbosd;?0!eab>bEe7#1No&HdEEak3?&9OV)1tyPryl1IsN z3s6?`L%5;PIx%5w0{0pXT6K8? zZHBJAU1NWeF)`~om4}AHiXt--_b3iC&J{DtIM{b-=9J(SHSjFs$A6~=-TG8}@jE`( z-!Z^K02K!$Xwarpf42Y8=ClvH^M$gwn@wl5^|GylpkuAUTVZ%RQF7wHwNNM@tg1UV zOzqc4wnX#|sFLNi6~G=q`CdO@11iriHY8f$JgYw9`C^#YpU0DpUx`O*?#VqWcOE#s z4E6V^%Z-C`L5(*vLFBHG*SOy!#A`Bj0{@kF(Tk+l8P1^ws$3*Bg2~AM60)U%MeIv5m~;Hhkn`I||1{GiMjJ|V6?IGeAfx1p2i z3RRsv7D8kQz;_c(#Bg0jNPM)W-uxPoHo>H3<%6xjiXzBx4FPBXf#_F9TUxIoq*{9@ zS#1T;g54kGSt^|k|FIR5l0f2v7aV1dXzS78rqk{Q7@znmg41fNP*@|c<7_5e!{%hD z&<6{1+71DDbs4|9rj1ADO%bW+!@rUQ+W{YUxT}SuXrhpa=LL{QzW6*qmbY)(%#?WL~moyzjld)#dw z*YtjS)dw~h#$J~5Am$3RNAnuNc*A)rENS`$$sQSvKbXKl`?Z(B>4d`JzUaIg$-^tG zsGX}L2L0uHTiG4i>b`q!BZ}gX?@wz^XUfOc)VxKnQ8h5dh>_8rkY|qHIL2TC2B5`E zGLcj=sU#ivasn$=Uc=Xu8eW;d4mLU%IkhzngUi*-nfBSu@jTFEZKBv?AH#R$Uh@Qq zqHU@cC04{M2boC%=MaeAOA~6(qp~4Y@T0<~xts9wo1^V|nM5HekjdrGl2q)UpRpGV zwU;E1uMPFhy1OWqkm&JqcNOgOo{CKRV0$8@|Ct1b{;L2`TiM1aqM>=j)6n+f)fk}; z$djH-&!*MQK~<}jHdKO^eJUVlX=_wWA}-BguH8)%0|87eJy3?KdP6GC&N?S0>Umk5 zo<(|QR1tjT4+C00$U%}?*Ka)prGBHbnaXz*l|c@+mmPql<;8>B``!s`0V8jkN?cSR zfW(gh?Ox*NOYoXV($s?YKOU8LcRbRzYGc*X*iWfPBf>H<7B&IFE-yI($qhmsB!$XFk(aG}xNHD;UN7LtpFKH}% zxQmXOjP_NDBEf<6%f2_?mAWTv8tlJd(JMxU1nqKTX(;Zz3Kq$W+wX?Oih=Uu!nbGj zi=b_24=?Oy@)>mx<)jz7h|gszIkOW*{y`jGN%SVunZZZl-RrAFfaLJ$NUC*{k}MUW zMYDtOyXd|+<{gStpLQK+J4LHS)TEXO-0m(7wR{qxj-%K7(`_Cjm*+LJ&$Y3zZiN;e zHzT6wIaQHbtHGDi!y&{NVQ8RuAV$*_tiF=P+G9vGZ)v5u;B)Th`8P9ouC-q}mZ9ry z7LM$w*SrW#LD^~VBKoWG24UDeZ#{O8fgANj%e0~wXl)%D&-AoHzIb)*LldbZt`R=qo z>;e(*Xv`wpxH=%DA%pbrX#z_g^Gk+sN*o;wJYeAw5KkZjueFvXSx^~EK%UfysOoB) zc$v;$zO>23J#V%wucY?ES&R|4fGF~}MnL%MI1ia@s^*tju~P_6^vZN4dj_C&JbC8Voq zquWnCb#XapiS~JPf(BZ%VXQoMiO_&-z7jg|uGrr2fgy=9VESsu+1T9phd`-chu@k@ zFd0h!=^Ft3ZEZ7f(Q;sR^zLLM&tAJh1buDa3dIR33^i!a;&=kz(Rc>Y3fTjGd!8Ao z><(UEsvxQ=NRD#y%2dca10}*a(*L@r!W~o<4b}&>!qc9lA zPUTfn>p%h%l7Jasb^DTRi3NrUBTXU0M7P^qj@(BJ1YABQlDNsmpL-`%G-8e7k_)OQ z6LqrOF}^B7$*~5E{Q4C?+Xotkr=c2y1&j1b#{e62v0YUv-PKdOux9!p#?5Ko*K!t^ zgZ_o1_v12PpF${4g-1ME!3`K4@MZzL@}dkeB4@KOsg=i1LEiAFuaYd92v+&+E|T&S z5*NXfRSH)PxZ)#NI{I!Ab;TE~UVRSB=!!7vx2y=vC9%ld|vFtbnMH-Shg0>v-y7AuV93~^n++3TSpLxV0?7Ai>u z90YRL`3n?26a4pe!IMvnplhTRa4zM?d%=YbvTNdzAqgazfegc7IpDVX02GKPSW*}s z6!JiCp==GjQlrB*+G%d(bFO`9{~&x+@?iKJS@Q@)V(*NRk?9`xJYD?}az1&1^uH$0 zR@hvKjlZendQZ%Up<$l~+3Y!@#Ca#HD;U9f&g0g6xEsC3cX@OA)+Ow3t_TjBbEW+r z8)TFk;^o`GibXPJf~ZDLxbZN75j7b=Zh{eVcjr(+bisb=l7hrlNC<2$Cj!Gb=;(_g%C(5F?zilB?Lld!y<7Rg3(%bg@m&RI)%%MTlXMjn~`Rs&<_@MBWRRt%xn$Y)V9z5#Qkk!c*Pt?^R%xC~12COu28I^GPStb$R;$YGv z@*%qRE<8&o@~7{vpq4`B>I5*;M<-9H-Sxs0ksKd;5BDz!zF)jB-vpP|X*2pO7gP11vMglHgQhuKu4v4lXlNFtno%IrEaq)Gj;}DFOgsSEvM#p(bqJd zIl_luhyJ4V2>>e#brn*~RkbD670$aGAiUZ_cvqA!$y3f=%ci#CgJAO#S~$q|rOCII z5xbRQ=(d+4eGiT75#Npq zV<|3ju2G&?2|C1eg zN2ivLds{TR``_UsW-bdAf)=J2Rz@0t%SmXIsI_A#QtlVeM7@Db_Lsh1M;aIWf>z4$ zk!#{YY(16C)P$fJQy!d}ppu1`=f-&c0T1)3Pee)OpQPj9yafk zVh+i10jaOKSO&*b=u@XU+OWqGkOsWVY*ma@J>S-?cL^3<5ckJsymH43af=-;Up2Ck z8c(XV*;U}h{}lc9mDBOMQ^8MIt(5~sZJMzxi1X`Wy=r&+%Iu>h54ZuZyR_;n8gcdj zfhh>qA{7M62*3Z~NRTe|IK-A*!j^pC_GL>~c95_4rbR?U2Jino_tZ!X0zBO9pBspA zAZ**S3{zJ)pqg6Vhq1p_pFvvvol?fgqL0U2<$U;?o>@%Zia*tWCMm2TbG;rwhs zJ@(`;M0cqJyTuX62l5AYL{!S(qWSjbRYJ+|9Y-=5T&yaeJ(1DQ?>1MnjlS9_e zOQRHd@LF60f`mkcIXW zx7XIj)jKkhV373yH(TK-#tq)U_S)kw7MfCyp}pnT0mPn3gF3dXa3UQn>PV3jrkObc zE-IASCr@9tPj@SMb-08}{zDIKS)vip_JyXY>o1jA*a)N zfwbDL)Hl}NTld7`T(rKU$xhJZn6xtDUjF%`JOV`rfqw3(ZQwNgK=I&!DYy!t@eEly zd9*S_CNr^(+OH=5qriUOgRV;2v>fEYXI^S%Fvua}4yH!4Yy!&K94-E?J|d7aS0;cR z$ME@CEc)qXk(#|wL5&xmQrmt&UsWU#`T>9(f`rmQ`If#Q_Izq^W1J?KME3;l&qHHp z0w1rT#zA(Fj*J1k?$f=)+c=cW6)w)=bv^S|`}rLaQ`c0np>=n%VMap5L{E8k;dgU`@W9r0aF5NEQk5lsM$ z9>^0M_on!}1>?un-Ul=t_5KSZXpbMOkDO({UAxA?z?KSJvq*&+59iphVVG`P^mMVG z%)P^XYWGJ5#gisLiw9>+WtzOJA=>ziNaA?HYpk-v*V%S zzXjI+&8x-A%>4gf9#;Qfvw!&iOb`WP(Cl|@c_bgpO*||ziUj4q@=u=(WU4P?C>6yN zmpS}=%v?<==Tm2Vp{{{w!v?n2-ae5L#^2?29i(S zYecF-W`n)h5wb;FIGrq;7R{`uDbQ|%2m{pX^_sX(EV}5jg5Q$;Dxpfu$VxXON;~hk z^;^?zw^h``@hM|u3*9EcMAXz%T~#a5c9i2)iS|-SDc%z|FZOkl0?P=~!`M>wJ>}S% zB($KQudsicYUIB7Z>9~p;wr+@YQt$IGcpvrw66PCOEwp-XJK6r)cI?AM_j7zF?Yo)0qxX1aRr>J~vm7CqM zlQn5K5`{U?MQGmyT6J&{ZHX?px$mnLAL{42PIxY{QdemUPoD~6r%+PMgaZG_gbJ(| zYZQwy9~6FM!ye6bqwVBC%;a$pEmDkjTUpIy<9;FVUWxM!oDyAt@&K=MSh;q8xDx6BgD`U^2JPg{sJ`e`J;Y4dVV&H z;z~L30f<0p6hh|SI&^HEP+3%F#c>*V#%jHh?RvvNaE>iJhu{iHfc~zmm2+?9)00AR z=a>zb&;Zf+_HBG`7Zu#G1mdwd-*Kv@Yo33T{}W&s^T6z z80?wLgyg$-dXnf9Kz|j8mK(-J%HW7U39Twr^~YA2TGEPQ1?cV=_?Lh3DQ^(@`XzPJ zJXbd`0YLaKQw?;l7@WWj!P(jH!*z0+KbAW-5DMf9i=0|;SMd`eC#JFCq+YdO@x1@< z@r+v#cmm+MNdmZTe-cb9iXLuUzTI+5A8T1@LwWyf5{iYq3rq_Vq(kA}ZX&wn+|xc* zRDAW2f%-d0IWNL7X;Oxsvhjl(Tqf>NIzvQ#L+jA`j!w`#K_iS5!?gyvKjd0%iDM^3^#B_T*kie`#N;SuwuAdVlx znM140r?v(*5ejL^-F~0noqFH*6A<37e9lyqmyC}(*ePm-_qRizn)*^Y{NJk!l{HT! zoj+Llt0S$P$K`ECN%3_^L`oEWI4~noaq)tThq`^mvE);@oS2{vam~TZz4PU(gT&mlg|`@!2Y-;F8LO1es4EsPfI#+f5DbUNh|tcgXyI5S z3)OAP-T*32haf<>>q2P$_i(F1$DGt9UGcii;gj%>S)mvyRJ|6zfTA1f(hR_XIe83N zM8qgG0HG*H;+J<7W*Y|Z0cwxOsASab-@}~ z4fFgg#~%2eV&RS=ph%n{5|@Z1AcYTdkjRJk^Lz0T!S*F#?0f;%V?oh*13bs02xcjlOZpU+b+oFF)pB%VHX@9m-x|H2y z&c|koUnVAH%kD%gMtFus=L9a{$`izBQW%&K_YnN}%`r3t-u{{vBv9CegerKDQCXUv zh}`Jdq|T0s4K12RpxdPGPAe9ZNlB|uy^L%pRUn@NT7Ugg7X+g>Er_fieM+h;z}CgB zOh!RySOiO+q2_T1L6(ISwrrg%G_H&!(er!lifH(9-)Xw)2O zIZ|e$m-N9ei6}^41E;f+A*K)jb#bxd&{z8rn|avs>$lnR2NyvJ;ffIBChiibF%l%| zrJ=k>gD>%un^YX_CJ@M!n=PnlWNN&JgZ*K|8s;r2&<@HgUBmvuE!deuUtRKVMUe)5 zp1FvBV+WQNBEod100toBahjWO8U{VMMCQTCE6)sFoB|=doj|GL|sk z@0STZ@`w{@3Jm#+l)te)647D8)wAf3{yp8FVUM+Y0S3~h`FawOC-!qX9lFKQ(l)~x zcUB|PRe41FxVf~wasC~N`uYTi&zCR%2`K=S^}TMe0y;HhTz}fX7lK_wblWvKKCb&6 zep~1sF%Co%ie(Hec!9G)sIV8_+!n7(tyfsVL<+{JX|to$o19z1KCBPDxpq3)_6dDGl~|gk*MX+m?pzj+PS<{W9_^ybhi73HMRl3AS6|Z1cee=N`RgUu{Oavy z#X^^KvdfB=9kx9;r`tTvHe^SlZo-08;>w_edDze#Vzhmh}19G>wZV zH?C%&)Jq*rbluTlBJ%yL*{~v>$n~P;V)OH>P@8-ffWNJ+H*bAL=RgpSqU3?(+x5Xz zhWikwcus0}pk?Ei(Lls4BCu@nZ{xQ3t)VWX=XvaRkIRvdQnOwx1E3h8UQv4KlmMq| zRi#F2C7u1>dO@KFimDB9VjyF_|O!TF^L< zKlgu&x}f6vu+s#nT#YFkxbKa0(a`xiL=MG@^Goj1KGV~-PK7V)IRQxCqHOG|KEm_@jH}MukG8Vy^9h z)OB=0sO$U!J7)%*kAqe{0}3l)0q5A-eMQfaIl#{}Io^LO+n^Wm_})$fWt_{>;@rK&8 zc`f%2;+cRnWYa{=Us{BGMe;mxfDb9m)0n zh6?%Z@ztzT)MbIC(C`q_o}Pghgw1S&Q#SYJv7x!ac2R!u>~oC-$^3s^B=T@W3+iH$AYx4Y_29Aq;S81TX&=_ZH?);j5c3sXXj~$q` z(^4B@s<3`F1LtLH*ROB#FbuzrfE4>o<;AYZ#{3QS-rXO;&7vtGDr7i{Ck!i3wA#jf zxAc}tADRuLjoXB%Jv*>!kZkL1gW1+Xg8@8}=rjd#$50IR@@Bic$)bIoZ~3^eb^dbm z4SL(#mHpq|<^N5x!~Ewz7n>UYtf`}@{~D^hv`vdOC3L?TJi>pIcCHIYKJSNBwLI`| z9N8{nboq}k|L~qbgxYR)M-*cI5%~vnb$XkI7wZ+_l-$jWWdi+4GIxvqZiwl5TNdV2 z5K%le_X>B$v#5kg6WjQzt!F*H-r49CYndHK$GjX~^J{U#wzBD}4&|JEA2!uBDUV^T zk#Bbue*W6CHDW?XoRNNxjyrTgU4fmD!WQC!n#~PsJDK8 zanByHSc5^tg>^uo=ZgtpL)bn@)fwPvE`;07N6H~VDjpIww)xEV_t?ZP^^l#6lCfrUr;T>&5 z)p0qJZ;p{hm^rfNK_`_EhFJDpa2;t7ZHb;a@L~6730N}T|LzhJ`Bzr9*h0VSIhS*Z zfNi*#M8BCJgn~BDgiNbgYZdo2n0LVcw3socMx>&;*lIT|Ju+m%xArrRcs2Qb14ILg zygjanYtREi$Dh4994X!eif_-KRT-r}+Dd{UZ$CQo}3z|fBpcUtGz zktcf-R)JQd{u3DADoRYuUVUMYw&);YgY$;nTEZ&Z; ziXB}_5JsQP<~WAU-OA@?jY8Nd5tU+5REBU3!HQXTbUl3r9bD!qZ@5EPi?1i?S#gQnYOTJ(;|Gy>usa_ovuKYc=H4 z4<6^)mVu`N(35o$Gw;i?BIE3z*)+8id{?|%RfFRE!V^c41!#m7QiJXfaWyr}q*yyB z2kNI)vwoBYdP$Z$=!-M53=X-1C80F)`RumdN~sExsYsETH|e6)3x+-5aFQB=0KNyz zBvvwMa^lb7<5P0#*A0av*v1{ThCDJYt>!jdB*3)z^-`;(90o!6o zImgfRxtA=Er0UdR+MLhzc? zToz|t(enP4{BVgM*L@1yC>Ls_=g{%d1!uS1I@;1PMEM+Exlm z{S9kZ6hyjTUQjnGKTNaqY=bT<@W%0*_kYQ#%^S&nz9rcdw8jeA>_wQ^YhAEQa6CIh z&v%hR2T+C&cZrCKWeCyxcyg(X^^NsC)-y^CBj+?$9}C{S2amiRyc2#VUB2W`_MeGF zq=k2*VD@_(B2ROH8<^=a2KPbt=@*@O()%RD$p9!ivJQ*=8y4ZZzt+*lp_LyBU#PeH z)^SlkxLwcIB!t;Ct=$An%aZvBd@oGT-h@l9$a>0~g_&#i`KXIv&>SiUIq6g#QDqL;UmjA674p|Blwe%>KXmh8jC@TmPR#CwN?fVrlb| zCH-0fn@9wzND$)>cJ>@Vew_m$T`Z%>_t`f$J)216LOtc`0Dk4je`;ms%RISjMs##X z-Y7K4Ki4{Tb(?kdnP*JKLG3}=IHN?SO@>0l;9fJ9mkvm5}Gv z=cV4Tve{1b`yK(7mAa{xg@uLxa`bZH%(c8_S-!>55<{Zuvb0ocaBFeVtSOz=#!8z` zb~IWEIs9l1tB62`a2;0$i0&7d6EgW(P?cqNbt%B#nu9;9bL7?^kV^L3QE;$}|K*yl z3XWBeJl+)0%~4^h-75$s+dC5HC0$6=puXM7~04pNcR)-HSU?8t2!tXqY`z?TPgDie|VyVHe z91!6)erzSRWy_waszA~_?6mb68UnlbTYNIw!3GK(ghYzG7z6gaytv!O?T7W^kdhK;H)ZSSNiS;-ttnMA8Fk8xb>lqTNr583LxcCV^K)yyj6x`gY+q6 zYBk!?E}T!5LDOV$AdF}I=B*td$bU%cp}@0)x;f?+;l9oZn$A zw%#>N2`q!|uz}qfHAks|un^n<4FDk(%VV<}!pd*k_=>qCm$m`T^A8^bb34FD zsq7j|c$V_Q~C}hrg?OjNsG_R^gKjlf)k^f2T?(~=@j+wpd(a#rBe*mbccam;0vrnsvZt-5xrQ0S99*m@b%4{7}TsV?a9iOL}vn;_Vs_wN6JFqDHp%0A934YP?ML%F1mrAUnyy!23Vy zR=|m$@FuM2ROspxV9U75L{bnWC0h0o1%>}oitjM(iDzt+=ni;| z-3_iM1kJSl(CjLAg&ZO309$2`fEw_|{aA%4qx6l!xcd@E-*BSW1TgxOkw$s(XD>2o zhk@=KIf0yy8)c5I85qR@G8Yg8tzZenYl}jfA1ICXS715{g#pOx_RfrRzWu`u^^8K^ z0uwE_s)Cvm?)<Myk$a&dovGb{s>CF;;(+-6=WvgQXr!-qDK(naF3+z%su{YQk6G7etQc(khP3^n>`c#Ya8;DJkp=LD#Zwmm3NLQz_ zXBNTV&7mfk?Bf?c#GbLC9eA{C2!D!7tGF{6e6SSftB9eLVD=T4sCnEw`kFr#RCC<~Sr`9}J9siT=4>+&kpkf=g9i5E`K>I-byI z*l4RfimjVl8!KLP8@o{Kj}RB}sV%6$Sb!8&8PrrrK`anRaH2b4f_YOMX_}1}k6{5@ zi7B;Si179UTO*KJqcKzT{7)i$O!9E>KUEDmj>?cVtds%`D3_vL!`$}7vG>45&p5l8 zT;gc*u$MQ*zcGr%KkaY0wiG65obWJ7Y>9NMkfnS2p1!O5+n~MBdv{S+IUPM(A6x&a zvO(w%tbE}PIxmoWD{^p^+4fi@rn!6ub+PJL=8#K5OHZ;XvB(=gD({tD2W(lobCHTX z#p$FMwrNgRLU9LTv_P11H1A@AqcW8qjpnjL4o(r5+_xNT046s$bA7FxCxrqn2=u)M z7!GyGo3II&x+mqA<~1 zd($V+j)zhLN_xGHPF|a%38W8f?d*5mG z-V^uh)8>Zj(nxc$sGO8!4{vuYVh%_+>SEN&H$(cpKL3W>R;kxZWPl3Dj69TWmP2Ld z=4);ie0jY?q%lpI$l{@Oo;<}JWu>_!)MO9P+VvRdf|SP}Bpn$f)p~%yswhZ740!B4 zHMu^S$&KUng^HF?DcK#K6Xo<8Y|yMNvlZHt0w?=ktb z(vs+7&76#z1Af(~v9Mzwp5MDnneoCsvR|p)jv}Yl-V*=;gAopw z(^EUsk5ithfsey_8*9W;XzJm zertW#6}*|(+P+J0w{mLlaA$Vq=jA7zl}>}Q1@>AeoTB?cOTqHPvLhDo$Q^?fZv;w5 zU%<5}3K38dd>F_`l&_{1@W-DKmN|OYAjWQLDGX{myoYE9MSpFU2LY1i)PONG{oXdy zfLRV$HUNEWIgZvM@>-JQ$}Fn8z&jp+bE{vC^*uzMsNAs|i@I=D09ZU`?*kba3951+ z5>{W&qw3s0{Vn+))?R45<{|jy*mrDtKvd z>*0N!d-$sc&Y+L7~twoB6D&gGrK<+>tDKMmntfh(yzZAfj>zl<8p*k+}pw2fm@>ztlpxd4^dD(F_A~>`4w9 zrO#p~7JDxXUyzg{sa6sbxQgbRK!5COI^7&PExF*)kCB5IYdic=cs-0o=$Dv$d@N3? zgQDQcX!N(E2drz#rSc3WX636oYgBmoPl;AnV5%_`#o5`EjKpw?>rGh=qUg`!g}9DS zrZYYRZ3T4?Mfd+maIeCQNevnk;6dnhT|}u(Y~r_gx_l$IHBJJOM4{q^EEmkb8YJov z{}C8>_8)?`>KboXAW1XJa5w#v?vjUN=Q#hFEvjMc26w|8HRv&3Xm8J#n=85j(yRZ6 zEh*2$)mi;g%s&W+VPq^0GPrOs5Aoxj@I0rlEbh;Pd_-=J8)-Zg2d-HwCoWuBEdZ{3 zx;SzO0~EbCMvD!&1HxPSif#*Fx(6#JNXKd6+b%TF5EQrlk+g`x-s(Sh*Btzq`sX9D z(<$_y;6V_qu^_kO_!iSJdI9Pci0>5ra?lQ>l2vkYXrtowP@Jf>R&T_lyRyWP7M*f>lbzeNRF4CYZ=kjWFCz`1!n_fW|qL zH7u4US*s6s*?Svjx|?UQJIsnuR>QyyOHi9%Q@{*#9T4jJT#)-{Q%A2DVX&_iqpDWD z3P=_b__o`sp>}ZvYxMdoAeD*a8-H!=m!l%*6U85&1BY^N^!3RfabZ&Zb|ZL-4N%n0 z(bt`(nd=3`-nTARI5p@gy(rp_(lnzLsA{uZ`uc3uBi+7U8EiCY%GthyvRw9>ZGc64 zF@3Xat~GSJU<#9wT*X~yNP@{re9e})S_UU#G*Jt8aB(hms~)(kGp!0)`vgn-OYt-B zA-H409DT*Frs6k_t@;2hzBWeQM#+lKXIpStTeVAVyt;whU6ysiIPA=*-Q3_D@4icG z$&SQ_o;bY@%lD!_{cA+w4#MEQeTWl$8=TC~a~^f3K?_O#21dh{=3cC1krS+S{ zw*a+ULEz2>b){fjR>m-K3=~+$x1~aN;)*$KcV4yE>Nn`uv7_RYSz2DKj0A%{52w+h zy>vfh!6|NKFgvB@N##Tt5fU0jM0q_Qn6JA06`5TtB>A#_zM=mG)j`dF{!erLzk)k3 zaxilKUvvGR@dTmwRqad_Q=RcJYkL=qMPN%Q3e@xLC4aq{Ryh?%a<=yKlG|G%)wROC zNpv9}q7ecgFLB6@Zx*KFSU4~V=jT8K>1`_MnehFG&f_tbghQNbjiY0WOr12HXhzww z?VZ=Bi$1o;LJhNorKGJYnlZK4<^narVvlX*BCabBDU=gQxqsOef^7S_*F(JQ(KJYT zltnR}b0e&Am(BNK%XSCrh|HIQ{hM!^u++&s(w+_}`P3bw*8(r_*cu)4Z+MV7nAgCz z^snWIl9roq#~?a(6CJ#$2{z63M{Bj)PngcTL-niI5ootzZQaHw3W<8Yc9Q>aqo*=K z<`Kb*jlu-5{Smgw^_0=Oc_o}EVo8UXrqX(`m^L49v)#XK+#HZqMMgssu}n>6rr+8& z29yApBj4hn!N5WXXF7ZlM{u69ivm<8&%;tWPfbLRu~o=-Cb}^pptMF$%+My)4`M{RU=o0s}B5I%@Zh|EHXy^w zMKE`bo0l7P@oz3MBEJEPLKyA7^hC?U$l-kx5iSkbO`i6GKLUgI=ATJ!pG3GRPct3- zhZYMiy81eUoLewL_Yk6w-iOY74uSnnao{!G`~N;YRoJL~7Z@B2>fm+RhE=PyDFwDL~>MK!N^C2G9+WN&b-JMg*sX zBC>v6_Q1Y5jzRnpDmdcpfJUk9g3V%z4^>?NOGcw*+jkc++x5qUOGH#C_259Vl`wX05BjWnp;W+0 zOq;0AkNNx1Tke*>;KbMW3P)oUxaGr4xR_%BS8AtICIc_3bG7Xekhd)v;^t$)ghGsBg{&BSWno}b-GeK_&I(Y1hc237K2P`cBpt#V?gEKwaN!MjS z(R*(-#Howj*ZaDtfZ5<8LzGCAF_)ADz3b7BJy~c|1L#xKjBOC?l?RGjM%M{E zjWTHIh`k=VVXO6M;5llh_2>Oqk-NID$zY7K8D0uRI!gaMJE-p0o=FE^Jr%JqUf;d7 zZDL7FBgniVqn80R>;~^;72WO}Y~&jw&3qw3G)XRWAVe451Oq2sbDR^?wYqWSYye}m z2)v0O<~Fu`yV+j=WaDX zn!n83vsX@h&SA+kW#eU+=(4mXEbZv+SqS*~of=6)- zlYusP!{?raOkTB5k5=1(g@y*5)AeVO!}Z6JGqf+!ngp{|&&)C1UXE#ypo`FUH*e{-Hnz2B z8>B0hZ8(b!rlmQIrIS9(^U7gJ#>*P^YcJ$JY;Xf(@PZ5iNTrc67g|7`qlNydK@TC6 z9)8)!qa708sZ>wtkn?GVL~0vG&wX^*W*9r)BoJnPz~bcR2vsy#xRO-j!(JT-OLLf* zce0+mt|2XL?(_4ki#gFqF4rSwk1Z@nf2#Qk545^6jheSN~OUE25k#O`{E zv+qAlSkC{h3f8moxGJ0^)v@!-eI&H^b^3CPea^8oD_~dcv$t(slDuKFg70na_f9-! z%NZRQWS#V-%4ymG)#LlE&0bb}VF=Ed!@6hPVW2rl@a`VX$5(dpDk z*01TW2C~*Awn5`=+uz!<%&|(pd^`iShW7+b{pp9@ww-xq3D)b~Hs!0M{H{oVYi?Wo-#D_6Vv2lvrHr%E?FTTY2~LjJj9*@&>0xBlY9y zgMNby?CA~-7g!8E23yll)z;TjXTvK~tur1k7XacUvBX)i`FBIYGfA7Dr3g8&8XW4$ zTw}Q2D?=5fG2ef%;sV9LguZ2xE~|a&+6l@sRl!V``Xqo>B7yVh?UII;DvSPcA;^F! zfo>Al>5NLZ7%(s=(bS+Ad?{y5>XlPQ)-YRutfb#hGZtQVejq~}3M*&4#)aB|7t{ju z42=F8#$|#p`?pi;v^LbJ;<9L089|4Y6m*1Z5En&)MJF}Cz81^0Vd;sdpyrhthz@9A z@HxHoUFHd0zKA!lN{c#tR03WWburjumA>#~i;66Pb!)x03I&5eeBM}_gXk@^*C5v2 z@gvrX>V>A-RT=2rJz9$4PGl?SShUkh5UE)UFzBI7GRLMk7Ai+T&PZPu35#+xaV&Ja zonTmlNYMWKTsL3LpBn1x2;9Lh$2*YpVBCVyO1}7}Ddv+d+n&JOmOIPe`G^V2oD8@) z;DmR?u)_FdjnEEgQy6f6SlTI7Wq_&JhW({t2CjtLq7L5{cv((|dbXJCc7uoWUIyE@dpUEjR z@K)~~G5f@feOJe5mFNy0Go_)}>=Ubcyj7@OV(f(VG5g_Q#vmJjq6+oJ?yd9@iH7{C zd-q2E0NYcL1KZDY-T`q%WN^Ap;1Q<_phxTDet#TQ#L>t|CIsXV0EHr&IJRyNoX8;7dx46(g_SR=1<}efV@f+2}J#!q2|Cgd~EUp z7nGW9t)+oW4@wtk~HKXrA>A1r_>R`{Dd32+PCN9Ie7E3n%^%IS9(f#FJDZaI0H z&u5yU)jd}99ssPl+Q(*!zPVuyMjgRmy%>F_L(#vl-rpgZA> zsv7^@c}di>0Bo-2*6iVe{H+pTJ3EUUVVj8n5R}86AR`wHIt}?}I857otuH(}vpVf7 z6-10ZEhtM#2^E~Q>G2bu-8x|t2*N@i56WM6#^W09P=Y0eR6Ind50a>JTfl5+Lq61hW{X0s``2*FuY?Ae_-1PEsErj$nt~zBCGJJ=>wGPb>sp zsc%)4^aIrt3xdFxgdhBnE*@kneG+6q~8>LXgt_7{W79U+sCCzBKqDV10%@ zbXFzTUnG^QW@>KyQuQL3dH~ZaQV2k7=MWs6?jO1xcYt`zirl}d7%a|GRm;vHQZlL- zLADe)gS7veL!k|IPK{L5jr9Sg)f~kbu8-YA5Jmb#jyh~mWZ*&gD$tcMWu(e}8WRN^ zW^mZ`as*I2G>3G?n%UCgK&@>9yX^7w_UTqq3snBxQJdnhJ42~H1={kCFABOByAd>k ze=L7;Oi#itrZVW`sjm`<8RXCHpcpEyh=vOaqL2NnI8BN`8rIIH5S(@{oI)VpaY6`E zv$tt_Q#ITt$@$Ry)ZhX~#Wsx#$&j4=YTNG@dvw z22DaR|5gy-;TJ+h7`VGZuUf?s(u7_H%z=!J;O?~hIXHE@)$Q@?dBY)aFjzP6gl2Jq zf-<;6KBU|2nKw~)-^I|PqzcZ;X1p;Ra>ox_lelLe*PUm1eUis6W@eQN00SV+$SE}kX7Cl}IDK0|c9T>Bj;8{HN%wI4(hdCmorf5H z^i0eqlcY77gM2=sDiPgA2@K9Uk0xwkl3dL(bo_<(Gy`W}&)f6-aQNfzc7SVux}cIhz*@3EM0szftR&W@mj zXh`Mgi7t>AP@6BZu2HUDKphVyKMn=O2Y6m~d*msk9GWFIdmOz|_IkVmt)~Lu?c>r7 zdD9d)0RS)j^NfQRJI8Qd@j3N~kO~o1@0<|ahg=3@w;WLqfnLE0C7ZiABA`Bg1=?dX zJ?;A!6K2*}Vm8e_8F))L!lr<I*pcuP=$r}@e_qw# zbhNDu+}d`OB*|!)E9VR?k{oY#=IWe%`sF1St8kcy&2UI~|5Ks-h}bdfWOFnv+JLKa z172y>;;j7p3(DDlSbMY#m1ad&9uy-Us#t^1c#7+5A#B>_gSxH_h$A0i+&8I zNanhDX)wQeTiaM(xde9<*b*@}r0FrmQ1mS*{=fu5`baORT{H`#=VJZppFhiH0pyP8 z7oSo+-&%mdJdX&&Th0Qse~RAk1HYyv7VAH4-~V05J`3mn`rjJSw6QyGMf};-YuFhr>&`m?Gg znJEch&n88216{|9REF(k=inl5&2NK3mw}cwepIcUq4u???l}8~ZF;jZQKNQydyM$c z&s%HPCREn7+z_G`+147kyy#rTdiJ@toqDbl(R}mg&BB~^ws2~7vTIX}62I(qrGEE5 za)%{5Ti@Y^CBMcDIrNZ}*0jVAwd^7UcY=3$sDY$YhwKED3eUz#>Qvx_kRfpEnV9Zg zY3fn-U!J?4iJvqphc?#C&1Xr=M9QJ>CmO2p@NFnC*}9u%96bs z1MALKuD9Kv8|P|B>2>19h9SL_m{(TW4VN*al^eZ%rGOpUhBA=WzX9CC?O^5PIGMujL`e{gG?1E{MTOk;NeK4@m)#q>D#B zM{Z43p`H!&$Z}FWKD@afu6GLlLsa>E{4`9;s8m&P@Wc^G-DINScY_4U!c_2CH z(3Ioel%U?aNr7}32M=!2f)hla)v|!P{+SjY6(16aEZ3=Q-JbqNI{%_Bqss=ZLQbmT zj)d#a%oW)g?sveG4B+1!$}B-rLG*FzS?CqP#>9j{KK1$+d2jwv%A;4Z9GM`dHIA5~>j_%^OEVQt&I}3f= zfEl@&s6ftYgxMO3)uqOwh|x=W3H9uzuA=Sx$<7Sky6(-7s0Wg|Oe0gAFMHJ7EGJIq zl0!|akIiM`^fK0oCjv$V6k_op4*&2`cpV5$=eE!ij|sVgl2u&-e(kq%VY~|+S-?J* zuk7e}3C(|z&P`(3xCY?;8(U5^MuJ12P)I&@W3~GUZ|H9>rj{$R%oZS>Z?Y8))@+PJ}u}=KR^SO zBn~)yvy_zq73Q;}bQK^$)%W^*D}eU-Gm^>@UO}V(Sz&RoeYGdpn;h^a#h~#>G zuDz@}yWNR5T7b4glActZl_eULRH_DpXFMEer;vM(@ICo-L|om?3k_6ih6!Q6h+6AH zHr5%ly$itnr|{jwSs=PzdrPUZUdK0UMN0Yxc$~mn=J*OiKryYy*?5Bqr+5j-Xu{GpPf+u(94JeLVm%TGBC$knFHoCJ77*1D#q} zgRi%u20Dj!Ne6LZc#49XOSDa55H|Z3IU?B^k?u_<+ z+S&CKyB!c2Wmxr?bA`b8s^WFZug;f9gH&o)aou0NXJF#dV>ecsK{4Wyf)b+_?=WR)V#%FS2{a4>(o1>JXgEgVzAjUwl#-|)~GL18bpRtQ= zdppiZps&IT$ABZ0=0Y%(0;%T83C=j>>d?iT5VIHbmm3;3Lw z(e#-ULC+v6Obv%zJ|JRI zih%D0LrYZ~TK0J4_X;JIo~ws5+o0y6I<>^=nit*t9Rm$0!d+3XtV7?lNYIv*1$#6YJUnNOXS$Lupu12({ga zYG$(G6G=4Q9=)vt4qIB;Af=q(nvCg@Zfjnu4cg_Ss3iQwsW5jOWxJQ4L}`RbIM&^L zuHzg9Kht0vR%-QKb>2UOx^Q(%4a{)sJ+LqiJw&UdtE|v~h&j9Bl(O?Y<9izm0(U}& zeUX`2=j;CcH;umU37)?1^W^U{yqc=9-xywo&*Mg0o&mz|#b0*%zMfJ(_*h`jZFV*1 zNFfGVw1NcqgGhv0VWWX5AmEcQ=9oCWTL`F9VVTBRcP;7j2k?g}(_};Sv zD?N^0Bw}h9wKr0ZL^9ogmS!n!ul4766vKq^%KpU~3e>5&T0I=IhSm}RkHvn~%yaYb z-CBE*VcIST6rgJGX!chURm8xtV9JnVODK0fna}Ns)WZa*>)LVqgfcbb_H^;)aS91u z-HtOCY^Y_7@0~>uF5mS+Vpcg7&Bb_yM|S^`4(%xP|@q*1XqiU`OPFWPuhsls#fi<|kqDknE z!UugR6B<_X7y^+H)0>g_k6?UFE7>C#PH268nXrDYP_^UocthsJTcwgQ-O79+Vp7jW zKPko(dT2E{?@2j(g%=#S(ILSQOK=&?E^zDQdmny9xx+9yq+jplKC`t$6olIS7x-

d>PKoqziumeNxn#*?0;!{k{*d4}2NysT6VNhJ_3 z9r2nd2UyW4SWlJ`g>Ww0we8OFs121HlV`zP`bkGB4Yq#=sljE__|es;zlIH5sF96a z@(2tdW5Fop^Oh;bH%U%TXy;z82VmTAMPtaas-@GQIvGn}aitanC%cP)lUhsHhkbt_ z#Y8r?=~dw*BK?#hr?&=p+QG+m%E#C9`oa|sr~Qf#4#b4go+|j) zF2JW@f!s%yh9=C{Bnl@z^-+kyL2V5Ob(E2P9vl>X<>XSE)m-v$5W+42KvhAhGAatB zOT&1>rPU;>PF|Hqx2@Zou@72goFwc}WRq^{d(9e^A&~6>v^GOOZ2@lLh{`4az=03&CPoYD!(4>egl=z&= z_&+{)fbrETZyjmNR3OX=JAj&cb*nT`)zIh0nq`A-H0u(c*f{q1!u|9PA{pa|SKBT= zdR|5wfYsZq!4CNUkR=H`4$~8h$uw=y*|W^fMrfn`>4y=F{ghD*SCUK)6X*o)6?j*B zkabr|WFk^%mqKg&U6}NB?0we#QvS_&>Hj)lNgX!CRN_+@1qmJiZ zvdG8pB}^9G752}SrtU@kBFMY?p+i}RjGY5~uN9b2E2ukZ3rjw0?0q3#F5Ts-?@xar zOr5l8I}o}N)%$=kvFc7bo%2WS44@+R2HQVkM{iT)cw2mX2I-mL%QmxWd}8ncSZear z7v$sEJ<@$o__RV3c4~bws@TE#k$rXrlvK6deK**xqU3dkEea)8tqVc|c|yROr%|T(4VeZYxJ#)3y3anm!xU!AwZl6-XG|xj>)_ z?eRAh^x7YSC^|-{D-_fR3+QAjhCZA6fy>{ve&o+uZT&93XL54)EXJ!{vonYgyBTmJGG6bm}X zj*gx^iM|A`nV7xpo8Kgfzji-fpK~#@CKnGdyQ3RuBWZE5lOk^>Ua{`D_>U!a3VI6L>$las$O_GmzB5f z>uByfce6%+9;wSN;vN7DJB;6scx8Qm2WDg>N;)0~RBvpnWg=_8+*)q&fuE=Mt7Su) z0y?kU2z)7vB_h%23{s?^P@v#Cmu6Joi?>zsf?59Z(YSrl#FgBTI6uVM=$1})H}9yLF|BMY$L7U%#68=N zP&Z?;Z)Z*i`MyeX2j!VqhC{{;A8eMArD%dqzUt=?Nmu^m0Ind5JQdwjS>PX+lYz_K zdem3ISbqbwS$G?OJ{KZ%MzBE4weEzIN#hYR#SB-Oy^5N_94ad#zMojtx>4E|6-K(A z!ncP|eHv%!mv!PP1UV16Y2d^kOn(!N#W>O zftK?Zn|fGu0*U8hrr3XRBYOY5K6xZ#-964C&ws91<-7tNAenoZaUdq$2d)^c7&>X2 zse_?E$r5&)&kz>611UL+-<$j)ml3C)j9RrXzu645rFcAEW+REzf#l3MCQKyYYVc$= zQObfhU9Z8fdR#UZRWhZ-36Ra9-d|7+ z$HF-A)2U}jI8qq3u#jD{(>bJOMiC`XJ_e@zV7%-5Zl3LQDY3}EoP5G+Mt*;`18@AN zvmJihczz_JQ1>fY}OygqNOQ zSx;fwBp(iQl$4w!Oq}%`O#D^$Gx|aS?UP9cX)rk!8Q#=>d7xgXEi~TFhp)>;3okMk z2c5=z`VoQ`aekK%%qy43gd|1+6Fm+Qe{iw``h{Z{32+~tgCEUY6$Jui4Ak?|8H2Wx+q+7D?&Ikc4(Gex5SGFqn;6NOOGP;UE zO)wSiLi(Ta0dMB#IWb~g8J2)Pa>k#4h=~~jlm3o$mPmvdMeFSqrM>?N;oKo27<{gk zCsDnBltG#PP>v;X%?HW8WDZ=s-7d@MID`YD1igKQ85lZIZ4}^F2O=4D186h7nL0M@ z6h*bxnFr@1;^@F3O-Ok(lqB-9*f%?}0?yCg_UcU>Q9@kODL3S?f3R$Ia?md>)h^Lg zBt{d%(ZzeT<{msu*C43q2!)#~HdEzaY<<#$(7RJPO3-;PV?M|*9+b_)Sr(vL z7JCs)dl8#kiEPCHVV^v;tObh^>^RQE|5z|F^my3kU;rK$^Qqv^r#lgDENlm-Js+ zM9q_jvc_KrmHE{Yxps`JF*Mj+N`h}T?F1wuU28odO7}Cq9R;w^E+w>)6v0`J6Hdt3 z1(zV05{HWPAU`Q!MHqL%S#AME87y6tFrAO=g>x?O_09mWOM=NY`yd zE(T2|_t7EZJ>hUTe>Q1m%DjVg!qyXF(fN8B=jkX>xWZV2e;RAGpt~EsL(%bu)M~0RKyM=aSe8RmK(e#q^W1%DF%BK z)<`6;#==ISpRo<*Iw8G^Py#c6BUx<8h*PJlOwLR^>u&n!N{#YNcl#zER7)4=6B~f z@)1Nvb|~HVb7_fIZHrDRr=y)>2-j@F@QwhS)x^K73%Vgx2<2jXC238oukDp#fW)xm zq8Oxm!>;$p6mo4}2$F#K2DRyCHk=5Z@PT%- z!;fon5RWg^o%`rp6$Unwy|E>JM)jG~DsoBFQHvw$*ZX_}LB(@lxFuoJB$P%@$dHr= z%z+k_zy1K35dlShv|08G=T3+Xtgzo4OYf0RLN^$qrn^ za0mk)#6OkF?14!}@z+4lAGwcV=u{OW2LEjM?HU!4Kot9ezWjVZ*p4uFb=lG78btDFu7yZIfVcQ@O}JD3(c9lHFBFH9 zv-ZoocF=86fqLgKd1Q4fI(+IM(U;A~!+RoF=-3G|PIy({dTbRMu` z+Zuo;C-@WdC{aGTC%}^syp6_V^_h}_>?yS<{wknoIe4kgA7U|qJVB~--`SByiZ9VI z>%6y9+=5%a->n!0@tH|FVzDQ#whaW>dOg-_AI12f2^9`{0C|gdSB^N?MmDx_vKlV8 zjmjm6(~0+sJ67{!SNkc;br6=4DV@GWqp1SCHecMkWuq-uICtgB;tw%@GXymqz8YUh z$D~fS)-{}r2iEklPinY;X&XaUvS|8Y<0_LkO?L0iwMTxf!z+o1 z=Wi~|f3?K+WzWpOxQdRZqjlXGIW0bDS}_`xhDJ{&7RUEh7AkIEElk*oaM>t|aM5%= zAY^Jj!;{Nazb9lNE`0Cm@aETReP8&(s;6E5?{&b!@ZXV2I2is{q0jX{H`c!#(?2)X zL7RC1^U!VF@jsXuUOZnhgr{8(ABFC&HD@8zv5?(WRZ=8*mh?u0iIrgrj6M1~Lz1}qJ0gZh@Yd#*E;5~?uz?UrexL*q2^)z}P z7teL75~$~$Ayq4#uX#53Mbz&KUY@VVAw70Y4AYd5ihE>2;j100Bh0Xy8n|g_T<}ky zodM%*w64agauv3x>R5W-*-ubC*@fq_PLI)6>d-hj6+b@K6{8RPtLxdYTtKHu6n?&u zl|CQ4M;%F%bQsSe4)lbCQqS)S9@Pj}GQgpXJI^Lui_6;g(z24yv@qIw_3Mi`ZF55q zl7>30&8DYNi&J*3_yPutsdjmUty*5ZDKP#8vg_iaG!etdopkISoaQ@C_PFcI#TNl2p-zz(xH4x^ufmF{X7yUAeM4nXm=$@8vQzH0j%;)eoCc9^fy+M~@ zAiJ+GdTp~vr5`diC~dKktOegiUdBoy`WK^RK=J~BgA{esA-}?sP1%-Kxl89gWWX){ z4{7fZBucccTbFIywq3Q$wr$(CZQHhO+qP|Mzx}uVdtaQ!iFn=2MrLGY#9TAi{Koh& z7E+pEplf9C()T3ke`<4f<@mRCzeGQkM8SxY`51h9_L1^9z-Ek4{zNa#pxB$NgKmSp z$(xHrpNRUk5UJB_n5M-jyHG;T`}(qvXLv@R5b(O4G~d6(b!!Ut+gV41EU+*rfbIkw zt}`r!fdkj7x*a{ASdrg5J0rYD6Nx{za+ndS%C$64wWNOP8GknLBD}jOCWJ!pwFh;E zk*?8up`zrF!Aobkf$cJ+401HuZ9^qHwXK|d4{a+O!LJLF+tDX-*nYu+76h%pjw$of zaqIaw$&h>q(oB~erIR$XA4V`j!A6{Z%JfISt8qgm3>XSclvNUOwmL)|^0r#D6>Jvs z?Uyz~P-#;@ebZ|;bOp_7k^eI34<-c4r$+WEdd^wW;7VexU5p=&uCSsp*m-@Su3P~{V-4@ z97!S!xFanI=Ge6-Pvjvn`gzpah(F0d$kiSvK@SgxLh_FKyS*ry-4!HvmeyuziSw1)?|qw*Sv=krm%17Z{jOyHj9-sC56g zA);Bv{DJNZ{}L>Y%h#*7d+`ZUVo6EtiPYkHy{nY6j>~5-lNcAS4&Q;<2|($_M*_(2 zp290~P6~{#iYy#|Ci~m?1V+vjke&d>lD7*FL#YUz-k6=i{`xDR?_?R8!hE@@ha3`DbMfZIslXW)sSIkWT@rZNgWaD>i%VPw zhaWPpErjQpQ&3^&BAah>(M9zU7JAeyJXio}EMo)=KFhcXAo1R~@Zcgjt2E0cvz0aL z>Xg1%N?)yPlUj8|cIJQsxBeA%v{Q1dQ*^95oA5!KZ`i&UF6JeLZKx_D*N0vNuiUNp z_9lZy_e`D8Z=PiHeHYY$4wJ1W$KF4Qe$dOYR=11F+w2WgH{t|XZ!I&CWciI&;AY5F ztQ}x~LddbI-M!7uR`t4s{E1EhO3$s&knEhBS6Y0o&b@CTxKQ`Kz1%~CCki&e-o6Wt zCL8;~XaLDS@KO15_cbB}3uZAx$`i=58SbUX7*3TT=P6BonP@X`9Agbru!JzamZ9RW z+CAgMWV1~){Aj?76iEBHb*l=zWPl*;*toAk;8i^^ z=Vs5u#gTxg81@FQD{2?K$CGzCHs=0)VDgA92G;uM;~1-i!%sxDqdj-IX6jS%M=dPG9APco1YYI)gGafMlq-{>18GSHPN41= zc64{uME2p-3kvmpyhXU$yvA=Vjg~_EynH` z1GJBV+q}}xKeTFXug>flU?zssled$p=v|Ah9i)+Cvuzs^auW{_0EtEi6vFh=UlJ>G zGyj4WoO6+TOS7EpRAmh^E497}pBls&-k&6d~7`7(}$g zDG2C?kjqrMC6o}sagUF1El2_369b!>2OK{tGm09wj~0YuMA8=p3n;7x7F4YZUqJKI z5pwYJTY1=fuGGBljFh~6BPL#UZEgYJYSS)d!b}>2@kp*uF2A00sH^LdG&9{%FKso+W| z>51etW2AXL7)2q871zK7&+EBJ!Zlgs-M~X4c7<|o0en}cs6Lb8e7ecIAo)ui=tyWU-2hk9^%T3!Iz|fg zboCVP!;n#f*2ri%JEO4b%OmX1vkJ=FM+?D6Yg=-G0PCHLrTja-?RnYN>(QH7N>DlZuKZ3Gf_(zA2YvGO3$jr=;x z*fMEH+TG}LyZ6&s-V>|F5Ipc1SArQ=?h2Orebj$^!2bn`z4HS6PmAaO%9_H=%E0kI z!-6%MTK|wtsJ?e~2%ku_2#iiA_K9IcGS>Yy$m|cL0t?Rp)DAttqz<%-u0MBQIh;a{ zUU^_TUVZT+f|t`- zh7MgHZ;F-Jr>uHoUv#%6vE{9p}jAT4cxCT#7qxi@PDRt zK-!Si;FNWBH8^er|KWi0o&34pCZmq_V|tUUTU8B7~_CgI+#HBSq%L!@>eD z;m>_Ls5Io)hRTN0d6zX5t99Z#6mwf}I9h?BHjP9b)Spf~T`ka`{%?fJPOJBb?KJNw zwMoN3hUcRRiG7m;jJK=7vGMCqn=k4Q`X-n4>6@)1CIHfNuy&L{n42E zi;Qkt)bvg8ie2^Qta^;wetxXuc-vCMG-?+E94=Q~-?nl4A_8Z4Tbr+m?xesK4(KX2 zjQ2*Vi-;l7lQ7Iv#})O>*R$N-9~hn${1%2B?v6*b%qcE4Bl;c zb#6HpyJWUKvuMS+AhpX;ueSH%a~YuASQ*7OS^ zyB0rg%bc)Bd{8+;e2_?>kBkN3s&<>Nz;E(`LhiMs%TmS}UcFH_LKRV;E}21Nx~N z)e_N5`D7OPzO*TUbGe-DBNOT@I2UTR{wAP34 zkcs;MkR2aR6&pWnjL7jZGxV@23I~~)X%mVe0xlkj7pL>?!owfrD{r}pae?W1(+{PN zxN&I|%I_s7mi<&cBmOg2ZEIHBS4jC4uk3jH!TD3gFVZj~>lxO z5#BDQ_6?(sokZ+`Q!=I8?mvTzZr-z>zOs5P3iqp@iGx__R!D9j3g_D}c>$+mHXU%?g)`3T z4Nr|#-vp9ue8+0pi|H?5oV zA0^ywzTo9+X>)ZpSgVVPatXd10Qf6c)2NPMQ1Q|=Svz#<=)Cs9+mFDEvA!7&fLJV! zw5N*w!G<59_V-G-2q+WC9%;_GnB0mY37BVe8;Hl*Q)jpka7kyB^RW#h(xR;GHGE_x z%7YOW@|mYVopFZK6w1zEeF41&_S#(i96&iFi)XPBx$)T4($lmoPMAy4mzbRyQ#{Ih zPJ6u`k=aA5$pYQWj>Mf$`TdjA>)NEZ@n{3SLLuv!Wj~Y5l;ZUXO2p^fs4tvBlA7t7Kk(l5xF;Sa5`M&D9(t#83Xl476Xg0HnzZBZd~&dEh7e6ATe?@Z7ekY%#Gq z4abCw-sBrBhi_=Db1x|CRO3iwozzbX3swE)v%PZJ0o99s|Bfyv93%|wA-QC1$(e#F zroGpnB>@i$rKZ@QafJ&la0+?%BM0-ETsqaKo0I071(ITUN|MN|fe&6QupLUwF;a*n z(2-q&jW`#{@!zo-563+m6_Ck3@C0=cj4^^|jP}HUY^N8AaJcS=M>%^MhicxBXWaGYSMx%0PwTpJ@P~EgOcakdRi5)?6Q4AE49x%6bLMr3t9u zgGB}+KaQf-=xz0Qbc6x}lv5>E8;Fn}GhO)4w! zwgf3FrRU``AyFh_EBS+vRRE?5{^cm_i=l-1>YyY80zB{~<|+b19}qx4;-)=dIW1sS zFTAh0$jOPGg+(nNy4lPDEM-%ZXpZXH-Da3(&ANvia?V-;^zH3Q^yGng&8S7OiZ{4g zQhKinYcPOvh~S_4ettzIJHF4dJItkFROHqKDeP<-1(H z#mpwPqoEPE{uFT}o8M>t_@=l*Ak^*0EP|5Fm3{T}P(DBY147n|p2YV}l1mL_L*3P> zPg(#3<}X@Z}j(_ZZ0&7UX&AJWECZ>>( zLzN$}0t+P$Pp$#^$v(vY9z&U_w~OC(MA%B{Q^}`zKVVX3NRlPa|1Jy!!m#3tT;=58 z6oDJEb!^xnM2B*yL(IE|X3_^8UEB5&e}uh})&(SjK&OeE0GN=2Fs1gD8(G);SCQXH=B7X@wtX3)`$G)5-Qs8CQUx#6@B7AEE4)b_W(#%yi{0( zJ3Lt7lpE$4t3os$?2DX%;G#EMz?R|^9xQ2w%Kjx$5idB`W8wrtmn*!V6`4M#w((hg zqtrq8rgv%qRG+Po2{fOncVp6%i9*#dQ^smn1G{H(t`0F|rwOrSNfT_bvu5m~=OeU+ zEE5kRX9+b*EU)R1s^MNkL8ldr7rsse65LS3#TNWqI5+F8Wq%K>J&75I z2{kf0L}F^hDty1WP9H_w8>GT9=YCe^ezucO$b!-yv$xAtFt6Kna@AP!sZ=oDp`inU zP15;u+~|Z=E)aHtAfLAsz7Ln9QsHuY#wtBXcAfHSq@-PWv{CX z@=auX`P@_^lz?6%KT;ZS&&ppgDj{pdzPy$-9l5W#nFM6IWAS}W?c!9c0;J)H3#U~aT2whFUAOc?uK&vXV8tV ziLnpoA$as|uDD>m9qZQ8bVyrh?=J!BG$^SoA$RlrRI#+r+6KoO5qB~taw0FU+Mqn% zSz1zvzScdZ8cp$mcVJH$w2s1p<3tH>y7J3f)B&ZoxqsXNR3RtR+eK9`9^S$C5ot_m zyWi#71r&#J%>}P24$FJz9~Qwwwl~mBewM`L#Ryjlh^}G+9$L+eu?pOfryhKKeHt%GOLe;gxRcR0phrp$R7R zVq2y^BpE{IIO)zD!&@h*q@!+lEX&jYQ&>%uS4t$fz0c8H0u`!IIO1=EZwl`bY#%O< zh=%9nLHJ`@zWekI^B8QB@IPT@-4NT7;`n^vXM#RMT1j^J3<$~$FfjV>ESm6cMg7AM zz;H4YJ++pzdTf~FjvIAB6n-B|e*xZOIs>-S#?ikKN#nEtQU&+e%G|7-miPEAnt zr%~yNDlUW;=v*Ty=jmL@?PTy#v>HOz6U7qQ$A3R_p(~<@$ukPq2QrJ@xx>!9&yEaK z_f#EI2K^jQP`;(qvW_n8+N$vXRHaCZ_Q%$i$eex|M+yEX!n4^AtmL^FsUzBvm+55>I($>y+|2`$p%CXwA0;uk+W$qE~v{nro+5BU9>>=;b4- zV^tQ~ssJ~cg!%LS#J~cTGNg^}{CE-z>hzK8xq@rHHc`T@QzOWAO2#EkQpxsD;i8M; z%ew}tnDS3Yk!I$$kX~LgPh<5bZ}v*yV~NAyMEhcejjN4=_GZFF@TAH4ns$biIcisS zm%%`XaYejjh^zomdTgu4^1<70FRfo)WUr;5)KI22b(L^#SH7{TpHfgVSCQ;9bffEX zaU!0}qcd=(ImmSK*Rj-GPQP-c%t9KjoA+iKGV09Slop}R_9Hc$X^3pmKiOaR^yzjh zDK{v4KCjaSq*l~?9c^FER4sj*cF&mIoPcRbu!AQV^EE2hq%{X)x%wh8Tj+u^p66je zKAdx|w@qxpKdzwy8XK@n5>8a-dWy~1lS)^o#Tj(XSj^$+Vns)h`M+NbvW`(9F#qg? zXq(`z@doxvL$vi28MY1_JWuGVi`MGvl>gFz1p}uNFZISjlM?c(uc?Sw2aO$Gn6C7H zI@jt0xUz+8Llk`vaJ2cFOeDdh9zqg{+CA8bpXx0O4u-z7M;;tFzH&cH) zYKCw`>Uk|%|C06f`n8unPfiSOJ*V#KqLZ$-_-RKHn2`mM98NaEQiAAftLZ`VI3EeDXsC z)CtV|$r?rN%vK?UG&;U3Jojr|kWC@EhwQu>E%Qe1rA(uI(7HK-CIA^Gb-RNX{n#+Z z5&&lW1*#|ot$-(q9422u#HMg>Z_SPF6WCt^&I)1%==<3TG^nEIcB6Y_#WQAN|F)fra{MU*LpdeO zM>HK@u3y)F@FVBX*hBvT#_g5u0#NRbz6>PrqJfJ_0)my^;ZH>)YwYI)-``+yY0+@j zB2Qi-z94cyX9s(xSqZBD@!di*_I_Dxw&&nuufyw<=owGe<$LM9gpVqNlh3{Sw#i|x zlG8JLUhoWpr>_`;4##WqSmkG7W@oRU1_Xkv@p6KtJ?PCRBNWu=Kp{$QA`}K#GuaP~ zm0LOJrv{c`?81f^Tpd4_nz3=P;*^iAjkdw~TKYGSvP$@B zR01(nRscb?f^c@DQVG_^P|)nVMK&-B{!v-`ODIp71GoY_orU*va)PXpjvt;8H#{u^ z61b|6uaV|Im@1Fq7YJ0KlwaaoKQz_!)KQ<|_jTPEp#^5>)de3F-5;clWPY=~-~o@p zl4e*h+j=78!1v79&hkB#jC*LSgEM8qGM!zomS0bMS(}Np3EiRd=@&TUzB^WUl_r5F zjC(VU1Lx%LS+$q4jbZy%SG`Y`0pu8K!m!L1M~0RF3*GeOpFk{0U>tf;i52@G9x7=R zCDK9#ov^;~2Cyowa)cz}jLxCT&0g@~LG;$q&jwzv2K8ukleF|c{uE|Fk26 z5!+Jg1G5fxk_kvC9PH!Z4x#OeiK0l{7%<-L$!5EM=a!CPfsX4?6W|P-I6Lg?vbj8M z8@ef~drA=h;zd{RWKZc{U_=kX%2xJLaJ=;tFcwEeI?u{)C1fk4caF^^m(g?-J~=kV zot4fuB775?e`sA_8lO-o2kW=5fv!WyJoxpdj+XB|d%J+* z^-Q}KHLuIgOYb?yh0UgL|F!^1IlHe~Mkb)N5`BX7(MjGcUcmuwjgg z+Xhs#pfs~zvC)#HRJ%_{_&2P(qPM%s3fcLKk!IbISOWe<;WM7`#okQG=@&_ZQ1mj) zU^N;DK!7RVrHz=S|W5)P8Py(zK`;ncSDG@Q^>?j`UYF_My@I1IX0;dKQ3PE zqh9#odR;$uZHIV>(H*0$k&Sw{c?Wk7QU9G0FK%<5s-Ue^?*ec6;eDVyn5md^0w1c) zIWuZj#Ho}f7qi7-v%sRXRC4n-$VhVC3r8Vv%3@te_(`FO{GcNrkK#%Nvs6%uA%a$s)~1 zGc6_I%Y8Qpf_ua(B0>D&Ap#PRuUq=mu%MVRoD_4Bcp1FP5kK?*ktsO@-SaMt}lc~pv(HIBOWJ!7kt9;?=*c_x&Y6U^?{Z7PRq;(%0mv`tP+BcBc!tC zaV*+9g6D(Epr4(`&-#w|CcPE7Ir?>A6Ko<3DmwX2?0E zQV*9PbUmf?!D#8w<<+IyFL1)gvBvCf5H6wjJl2A&pAli2^qkf~m^G?ljI>ZSIb|7| z7%U@VS@!rD3H_;1i?Q(V-p)CNqj;bz{?ON3FIFrCZXww-v{@i(MnB=Tq%Hl`Y4?^B zXSbUXd~cN?HqMs#>moFIe`u|TMdttr>qz1mKV`<&C5b5~_-4V%F)wh|+ls-~;^@Ir zg$+=OMHn>6Z_Ee?eLUb?ZPPq|CiFkcLr7mHf7-gM!$c}c-)pNi9o;rR%B#u-8m%3o zUS@8`2M+%~!|*fV`=36MkUqfv*Ff@|Pr%ioDfZ;_)%J}%+4OWae?g7ll8htmcj~4b z7ia%}plCgGm|Uy>)F}K{#x!PTPL}`KD75_ldqj`_!m${$AwvZ}s`+r*`JjQ;d6#_l zB@2-Zq*Np+Enin&wnI^=U9t)&jD-i&8CxB`XVbR6Tjerfe=B4P4)j_#^4R@+*T0_? z?37beH7eNP$6_9_O%@kFXNC^)BA7hC>caYLr7ING&=|12{_fhkjiw(L;AQe3b&1zE znOvrjHVSpEh&*Q7x~YC0AE12J?^xU=(S5r@|I9zBtw_A}T4vhkzxaNhqlGn!TrxLF zG)XTkzL-GllvwWLOp@-f%_Y{)xDZ`EB1L(5aOBOfcWoebU)d+#!2g4izWD4+_7ne- z6m;}~#=RQs>B6nkCH3~Wco_t*npg&SaqkyST9my)j5(V;YU76@vr}hB#weBN$!gss z0`~D{U#`2JS>`Jd2*7GHiGYn=Z*Ct&V0vi8dtC@NY0s&`Tj-Obi(Mgv$Cdi z*0dyLe!cmCArGoL?Vk!$+QHpDxE&m0U`^azHE4T9TS8+{f7yw- z|E>hnyI)p+8vVOvVm>7D)-WE|cz@aWb+9}2q7PusD_78(5n8lg%?E;J9*gtA=1L}U z(q^2{#2&XBR$MB`OOd7qKUjE1LR%Aq{OxD#q@oHw%-@j8`tgY*l1T1Xw2^OU6ztl{ zhP~!VnVUN5r+!qIBNmJgt%5nUJe-wEY9DL5F}E*cU_SjKNO2nOy(YM_=Qi`6TNVb^ zZKftb;$017Xi38ko+q#tmRkrm%k{~JX?5A`8=o#I#XcJvLt#jnMZRFa_vKD)`iSj8 zDXm_3tZy-b4`~SKL;PG<-izg_X}YNB?yar%tl)DTIL&pXjuXKnckUZ&v3G1_P1x|M z83R_-8%vH;g_k|p?SN?O?MJ2>-XpP-yH6BO@(iye_>Y_7;>WfbA-XcB8gI5EUJ7hW z_SwCIBMezL+617O@7^g|wh-(u$}Hz|bEzDkj!@6L?oxLvfc>PClt z^`seIgI^d?bKSUrfHieY4yZyhDBZhhw1WxMy*||L-RdgcVj;zv>c1}}5``N2%pRvt z9Rn_}NVS$SL6(_ep#`_HuI^@E+cL^~4hz@m&fkwsA``l6$y?$aNAnk3m^uh{v|Yc~YA%BI*UE|4&cK9L7HP#7J>8t)W~2@^IByGZNU1=rI_sbQ6ayF?oNS0)8uKm!nh|q! zqhmw6Asi-4D{eW69dZ?-GXu{QO`z zO=I4DqQQ^Jj($rl=y?~eS!BSsHMfv#wF(I1uL5Ax(nKTEaEF<}0-pRX!aUH1Q$=33 zfGz4;NN^l(HnjMMz{#F%Bfy<{uM5!lU!tovT(|nkw&^%S?Yk6d)FWeysSeA*;x-~i zvVjWv89_^maMr&Siha*{`2===kY-EO_fr3cNpc=m*_lQbXJN2IF<28dj1#E>XX$E? z$4N*Ub>EoWdLxYH1PWjJ(c2>N`Hy-6NjmQ)K0IVW&fiFaqPjaUgowgv)IiT_#OZfY z$gUIKm34B*uh2*-Sw8J?l1&114^Mi3vnjFN?(DJHHy#eM-B;0Nl@yI&I)KTc_EY~P z&K3e)l#E_@q{i|rE`;=pD-97XN2C-R#eW>TH0Pb)DpBfee<7RWSo$BQUr)A?j7tGH z)bxdhGH?(vORL~u+=A}3jgt7H&UGqdbIWPy&t}OZzb^fXtR8X%Khc{|Hj|4PT%TwI zbn^FEt*UO)YHh`Yl!y3b6@_>65k zb2XYimQk7218ogw8RqT7qOt;X`bRCvG#C+z$LN~iDjTr%QG*}#{MY8- zt(6+)$%fme34JZ`W`MAjjiOS~JiHF>tpSHT~$EHN01&KR%z$rWFb4_BUd8wWC zXMxuLyJtL#<1W2^l|l(?BCyLlPbp@LVRT(g!C{3!>^UeS%yBbJ6_}e30&F zwyEKuP}3Hq_e>K!O_6q1T>e(S&Sug5WSCC}PZ zl(PVMyF*m1(vCGhoLUZactsbvHuWq1sDOD1v?JP#kUpt`{j8SFEs;)`JTqAk+r*~N z^aNb@^ujQ)W**a(fXG!K;-B8KKjL>!h$K z+)IP7fuLr#1(%nnOQIf~U_4>8RizDp$8!ms#I@a8{tBlpDC*O}%x=-iR)Xv{a}Tu| zQ?d2o*u~0#AQKJ`#rHh)T_W9OB>BVC>n8E8X;AU71I1HV{Ksf&cAx6tsvq}29-al? zGXVE_HDRP{(7g{lZj(o~8(XzOqmcb`_K+D<+M*;LcII;4HI3p^*Y(y|1f*OqNczy} zgppUah_8zF{(1BCTl+fO>=WH-s<37`?GAbFLfw~WZU_o2Q6$i`F;~wC$w0C}K ze%*w)%28mT9lHpK<#}ErgfO)#9Vks84XW+kIf6B)GcK%zs9=J3Fa%X0!ms0Hp#W<* z#AjzDT0!bWiX7IV|GYfQvpV)dL(=}+RZN&ifbac$(gd!m0Pn+JhpD;yg^moGo5W{~ z;OYNrzH2MsU5!HMzwt{TsD0-spOM6g;PlcKQWap@r=wJ}8cTR@0HO}+y z=|oFFHNzMtfn(cOP9QB+uGn^%GJeon77yJ=Cn|5N~ObFW;{SrgHCMQ#9Y z?sK?K@rsJH`GL`4nKCQd;hnbRlRzcwwgIm*GN|E%Cr<3pCPI9&&j>dI_hM?ZwkN6t zVDl`lZzQTc#0NnfqSO9jiNo#AJR6<=W-}84s-p>WKMDb zjzHJn%aM(m9*!sIj=Xee9|{=b+s$6d60Rsp^mY2h?-PTkEwYx~)U30Zh43vxIfqVh z8&meP7)Fgu6Vppewmw_mgT5P0Q$GIif_R7=m*$B&I|!I`{TUeGAo^btxl;qdK2k9d z1G7JTA*L3+(`BdSm^nFgB=kV~-S1BX-?11ljav5lHP40cn3v3Rp$MyqYJbMDp4oLm zqM}Zv{QQYiq^sS(KbF}5d2wobs-0dFKKi~d{*d?Td;Nz-jPbwnCo-~d{x5%Gj+)f} zAp27$Qb;M=?&Je*7KRmqd769eYc|UW!-pj{UVVSgN;P(0p@=jQ_Id$g9r5P8moZlLauDuIQ;sz#_ z87z}YzL<}t`1A;p+G4CbI=f!T3Z)dgv+QMUuXEKuEO?VX64QUU?(8)47&hq4L^pdg z%u4ZhM@BWlyJgc1`KjLL_>cv8HC8|p-p_QFN_F-@FTiT4+29u2YIA)?-)$*n7TeNP z{RxP$9!F=X{VPnCxb23&!Ud#JXq2ONID3|Q*Grz2@k6HXfq3T0?bP)!{N2i%L@kj= z!}80Kz$U`MWP;Ii6|2t$NLmW=i;)})P{ezR6)xfyR8 z6bmXAnIUf+vixN@5SVnBZv5G7D6coQ#M34a`(0c!5evA9%sOHrysf}7%{2q(J5C#| z5vXh9GTv=uZU1#cT;N1=-CoiL@gr$HQlP$4?=EzGT6uP2yTid8L9_8DiO=_$5yGF{={3O92AT9 zB$Q(IuLYk0Ruxw9)_uHjs%_M42>TUjqdmcvJHlslzQk>SKPMTPSB}`732}Kk#B)$o z3?6pfZmRBI|L_!&t2+g!RIs#Fq}+>cmJP@91UT-?u$B3L7{UmkB#f1s~v0fT0#yYWL2&U@cMe2jFAQgCwEruI^jNG03E>R%Y{N6&zoCM6*m z0Les^Gt%GO`a%2xc^#?Z;8IulT+@{AW~}ztIsFH*F(v!Hy`Fw5qAib{+a7dif~%Ya zbL9CK`488tSd<1Bu7{Q{ae!(gq{0+yAyp5kiPa@qCqjt7YvZju5`!97ST`79d}L}I zrG7gBMlq`C)@6D7MJEN26cQ##RI~mB@D{6)@gr2=^)^#MO&bdp!@<7SMfhM+SPbT< zmq+|51;dwKjIyJ??djRU%atK4&mUsy%H=0DdneAAlO7baDiFNm)e>rqcu4?*5X{gy zKH0H@T-);;r1TEfyZJ{LD!&`cZ71%~;pzNXJF28d2n{eRE!~1fb-8I+usm%4^8|U$ zpz(DpeA9hVHmt_fvT~$^?&Z|k!FO36zr0v6aa#$q`+1z%r9?{VH&{3qPVG~Ut^l72 zRt8p9IR+`aeRuvZE4pd(S+h9HAjaw$CenU)U?aH7XDfIOU?3z46!6Lf%1>AG>B*5Y z;JiR%-xYVVdURv}j*Odf%)=4#Xws+bXdV+ZXQR#&5qiNM60QX}wNmbh9CC^5^T*6> zx5iM>d*PkHwLsf>&noI<6Rd@C|0CLwKA5mx(ii7;v8w#PxHtXLIN`Tn32j9mEL$;( zs%$`x`0v!Mmuj3^i^=|aOZ*^L(9AmE(BCr&C3XmODGqL+tnr9E?DD!9B?jtzSxHtY zteh@An@Z=o+!@Jdm3219uRd-e(xmF47gtvwYKT)agmR|j6c!i4y`Qo0vQl6!ZVH4N zLj&}$kKF?T18aW)(WZf(Aa+4vJ!{3XX_4zgqdDaxplhtP*?K97OY_JW*)l6zm zxx>AlD(=dfsukMpyM4x7y!yVyF@nc+&%x1mhWy43Az*qnHDYb8Q(gRGv9cfa)2&a> z=QapKU zjlr%?Wvw$lUZh+g(xV3X5@iz(h?bL~36YPdCHSMFU&5Ewd#t;a4N3l%-{o#JjvDi_ z)7g=j*fA&?I<8%|?(R8BlR*>ikt2vngh+eEe-M45^$2MNzfE5D*x&T+X~u0TO-6_o z_~Hd5^FusddvQ7>&t1DbZhI4c2}t?^pSTKvV_s%_tQFY?LNjJy!q(fRp*ea7GqC1F zSmAyop(Tu*cmO`H@Dic4YE4e$Sj!h1+S4@H|cM;u|>1clRym zch2=a9p@1|N+|K+Z1K%KCG51N+0+QxBCaU>yV5XFXrxBc-)wmdm}(=IOf6#{o~kBj z_peFkuN;~{CT;=i4uMX7{%`Zffxwolz}rOD{77L8;8f;O3|0ufNvbNTdYWub(Q;MA z<%=EY`jXex2%Z>+{tG!p6RZS>bmos>Gig;Pi%892PcOnx95R(I38}YGcEVeDesia3 z7cHu92B}ye%zER;MghaXKq_>Y4{QX};DS+rY#85(oAGTJ-=_@XXjjYl*2Mk3-ucTx zL6ZnJja$OGZTU-?D z@+i)26peC4@1O!jt%1p*VTtwt5L%4bl%w(I{^yD#rL9^VAn8-+G`eRp5o&rLNZ!pr zLvg~B-hih_C|fA19I25a$a`laC!QH>jJAUxbkt#qbcAS>SV#jytE#2YoUs;Z_a^?G zot7I+08}kaz(NDvMB_53le$jrkT1MkXeYrW(rQt-gj(#-QE>B^J(EWDwwz(V@z|rN{29K7V%|!@; z+iBgFK=WsQJ{LB)v3}&zV^wdrJ6so^_~;{+8`(XSiB)|~8~52sVORA%F9oO@v;C8Z zcg39mXLmX%S@R98*Az@^9ypUZK*@#zruc&KoZvl_gDV&Y&QWG6MVwkE9$ZgTL58YF zjLvXxjpB(=!MhZR4=w3s+5`~EufwL&HJfx1R}WEHF{Qq7__Q`E49?sYmVH(9G)J9i zxVYw5%)qz5r8Ra~>e_@_OOM_HWVT>5i9^n7uh_a(_;% zs+gY0W!uQclmR{g7HbvxQ*cJQB)ZE~66cZ%Yq%}^1 zMi!GEMfZe8g?hA?{WJL#g^qOiNwsR8*goa-jQX@+{2zwdGg-fI`*cgtCp;HkA9amC zc&6y3_U<$Nle5Zl-)$(&Q3BfDifUm7#%py?f-XOeJ|BXn0;&x8g;vGpvA!UPzc{Rnjs?P`FZyN|t z^vuNfZVES(F%Seplzpz6CAZmtI)F_FvhaG@M+8WHZprr~re^sJe!djiahE{8?OO0h zFs_YIv#*a_8XeW6gHm|$sHuHaTU{EvbrfjLCWv0jbPS=jFwr{U!F^^17&?I`g0gr; z*{O#&^t=x}9|LS`>L}>r$nt*LwwE!Ho@<#VzLJZrd_?U$iRtGi2N=Fhd_h9eNbt2!ms& zzIwxhg5wTxs&5=Lv_wZ$EgD{0n~Hx-qT(GC;Ybhat={#gXJ1YaY=J=BzBsmRpx@uj z7UuST;194U=Kn*vVE(UaFe5V?^Z(q7yUCWY+Y-eHz57A!PT?|V`dZ9N0};le&&xESgi0ma&l<*G!V~-7Q1MesXPat zK_YI13{&AlOSodNCXzg&fVT#&M;qy!OItOx*WDCm{Vh|2SmN#Tng=FCWbz~A@&gv7 zg?`2Ufv7flZDg`)$24MPJ4_I%!O%P%QJ%{+MP8+m2wM&nWik;P%Kp?H>W;YKg1HM9 z3{zyA3Sw0ZaEgrH<-alJ4PCEkerKiLkx~+ZTsK;>$aSEeVo2>vp7r+~9`GNPR?%D- z!vX@C{b0(uBVCmA@uz~(PLbSV;|lzA6Fz2u$B0Z-f#4OOD8>Z{>=C_vTF0vYj)sdxo; zEh+)@6NT0$hdElukh)3yBGCJ-eEu|nY;)QHmvH1#gHWn8!NfXpn>0bQ*kxt`+vo%2 zn>DeOg3YR8jgRD!gyQ%5bxWLM?rd|Y6-hJK!h8oXkOGFpVkq0R%)w==w_egWo6POy z`OBp#?p1XWo-J)_v<>~Z^z&FfN0|I21u~7{Zw#^ z=*3d(M0d`$Odh!?jpp@HO-l%Mx7PK4kewKW6c3(Pp-fV(6sc-R42oZzQpc2??aWHb zBiXRltO^7JmKt_Nc%5yj{7|4YqwYoT5OX z13Noyn?QYcqdMu%0$=G-kz|=tEm$qg;dXy{tF{*q+DuO%B`r(AeOFysHy)a1v=G?-0Lq?e~6-+nx4DZokGl}nZyaCS@;$UIz z$)tv}+RngY@rKgc{s#KJ=|dK$=lb>-6#>q$Z7PLTdd4Tm+AVz#q_S8jswT$)`Cjf) zrY@DXi=tb-#IG)aonL2)ZS_0`gb6&$g?Oo7Uei&;gG)ry$YFi+Xviwn2pF|mrleFD zXJ2Kmvd$iWZ6T_)w+-(GXN`6NLqg z3sv{QTs5KDCTPEw2`IF|se08ty@~eXR~z?Us>src))%T% zssD$ucM1|M*p@}xz1p^I+cs8vwQbwBZQHhO+qP}qzJKSuyW_=<`l*lkR~0$4#>mX^ zf|*hjisiO`XLhn!DGW(P7xYA-aU^C8ScOcFqDN9GsIe-#V!5(%DJgI!xH zjNV*w&;<}_^jV8TSrYMV73K>5$Y1zj6Vd3YzM7SVpync)eBjBO2G@Kk8Ok|%y;1+UEReh6DpYAOTXiAs_U z);Zu@E=w^|#HZp#h2#C9-Xh2u@R!OC*ull46S&WE(~pckaxO~&h=QItb|jVmz158m zqQTzq%*n8ycwUmfZw6t_JRE%~MxYZ1)aUb-E^9S<DTr`x=e-O9AflOUV@IYpJNPz<92|sQ(FScnOKNxu*^k_r}f~h$S zvNO@}vkSAaN6=668M)|KXjg{20a##>1rLku_N<*HNp2K9pc>QqLT)8Vf*CV6FBeBa zmOFOMN#gAe$8FdbzWg+Qa||<3xZA#LX?4FV&;oZFsct}n*j9Cb{)N6ZPoF6n>ZI}X zwuaQ;dmjcc0Gjhz7D?{dX^PrkMlJU^GEvN-RS|*O-xvW+vxmJLG+!_ww~7L(cpp7> ziV&{DjM~b|sWB1oDJ6$L5$&mZo>L{^LE0$<96v+V!w`MVAE4Be6G=Ut((;i6vptxrRo#@ z$BV)_>|h(Yeu92B%(%YHsIsP$gl7VpC_dBxK zQA!S5;~JQ-X%F8C`7wDx*4d2{X0UW}j5eQF^;m=K(mf)Fa4%%{s__*WpBI#Zg%v%- zB#)WAPT5N&p!~->ZRVeoz%$EkKCx*4Pt`$o(Jua}^R|eHu`wxLL-VS4iq|w@nSaFr ztdKj%)lTK!Jb}y19&fAmiIEC(Yjc9hMZV+rI2IN>?BpM%XQ8-Q$=XHHzH?DNnJwjw zE#nHT_gmgPxSAszu}vj%^QsBdwEzxw5m!#d!12dFpk_Tvw<+nKYIUk8EeoE>O_I;*;5mF~?l2rgym%Qh^WkdM4hW`9U1_JmbR*0+7l*&U|r92cY>S=y~ z0`_bxjRUx3(lZAAi*W3uK4RIQL#~)o-`m2<9jxV}`$8&z&*jVYHeCqqbc7}7uE$ES z?s=@<7pv-qvt7`}R(xk6*|#tiWnfLD?KGW256aW`TF)_Bm8OX3*cIBn2I{Cw*wS+1 zKnnZgh6*&5i{@Sy!ng|O60$?cqJW}{A5CSE*+owU z{tg6~&mHiLCR^4~Yl7009_F5|fj053loeJe9DaL=t+;hpD}p&a+2dfoIr&Rs^fT?I z>9l8v&LVEWp3FMO&e>)*d4-5DbUm#!gagQnzY*a%5{mLwU#xnt4{ZkwZV%vlz}=g5 zg;cyNujZ;N65jUE;J9br?y0{U$A7+W?bs^J+W#kv`>!k`4D<~DJ8COa>X&^Y2fciu zG*C6|PEBUHxX2>W%@Yc!1FC^&jS^VFCy9jU<9@$j#K#knd6I`^gdhH5T)sHwZkof) zm$9g^O`0yZCxkJBr^EAcI*)d}*vTje_)M4XgcK<@5@M&lWm;$Swn>Cf@=WR@P-M&A z{`u~MCxR43fssn}!uyvhCSbG&szIwt=zAmC*|SXCR-#&W*$(sda#nFCHI_ z!T!|a5GxN6aJ+Bbf^nX=IdS;qOQkwvvYK08&3bldn7oUY>2wC$Zd*o5l@+sxd*x)! zqNAFP<0Un_r)$nF>RHjFW+&)BM*K6*@QvI)dI*!f4>p%i>>I>u$K_vbl%Ua>PW_w( z%DMje1Dro`+uo(viD(ib%ea+~Tjm;=Kzt{<793Bxk?#t|W&GqGs+)YYzi67sC`#@H;ZJhZR^Apgl6l7 zXihPk)!h!hrQ%;d%n?SfTkqOi>De#Zd{~VGr;K!%2tSu}8~zV+dn6EVy~$97b{>HT ze?&*%3V80by^Q*A2IWD5^tT6clO$nOLk3Xda~%cc&i_cB02EcjNDgI7Dhm}2QI6e5 zxEQVdUfqC0@$2um?5gte`L1jpOh$uU&DcN#z$vb#cS)AIV~7Uh7;CTEw-tUC*g^>J zYp=^&^@s)EoDOxdM|M4TM^96Vhgl`BM^nx-2029gmnfMVINVP>OQdwr8>btGB9ig4 zxm+aS0H)kNt~8Alawp&bBku;;oqtKS2F+ZX^KR*vyiMFnzVEW8g-@euRbtPOvXQR! zk*n1k_=L1*umxIK*V;*y&F=1u4{)xL;K7F@u94{WpU`0eRIwB0e3#SC&MmNEJF@Y5 z^tp;~0`Ub}_RM~aLkJ?V_zr@x6cCIj0BQDg_(+h2jH+2k6S=xh-q`PW*Op%8&}=BB z`8z`9lDJ7C-Ya9b0})l=W{;MT#{r8Q9)Izoz^b36z+_v>(4{I32Y01_DP5~n{s=Qs z)wWYFI;VlCF)g%I8Ap7eh0oyH|2NsHx8Zc_GY} zX&uYKL6bbcnvP@K%3|+1N?QM}YYJjE(3eL4jfd;6RYYezMA>;OwZkRod#ewi&e9qJ zww(J(lcuO~&oWMLH^=s6j1r(VSnI-7c9hS=-ma=@tMjg|@KPC~5yh{|f13&FYW+@+& z`5g$KXYpO1M@WXPA@lzUKK?5qDFXxB|8ksNY0CV<2YlDdKX?v#@M;(5ln$=8p;E0} zkyuugS)n;#8U{#&G$o0(=pV0?eCe_0@OZ?M#Qgf&@_d9Zb?lW(RnRfEdY zo-g`sp=9)Cm@cZ!DI?}!1Mgeu!5{v*i`9uzgOy#+gyPbyf^dNSC%~ZYAC0;ev^4C+ zD-J5erNp1gYeZE`5NGv8oSBaHy|m;EQeDYW9zZr^%o=t;q{&bd`CBVQS#EF3Ed-hM zEt9L|!Y#6jEvYlG>+1oInu>!9cU80gj8n?H2{wCFm!$r{H#lsub7hh$Gf4qXY0gb1 zoa=4jH7kUpulW886l4TgaFswK1vJAJ8D$lc1!Jxw?uijK-n;7}Uk?M4eVPc0WLAt0 z39L%(9AR`ujS}5v%YOwRxo3&U8E@*qOaLHH1RV@Sspe>H8iQpN_L#<#@fa5k7!8FB zCAkZ$OUMWpj8`G*7Npcg_kMz1D%p+VNIEa^HFqDc>T^hL;2|~o^;^9l-?N{H$!5rZ zQ`K3ed89<2F5je-q({EJgAD6>Q&PE+ymtmB?I!srOjbFiqv|~z>n)a=4I5#XOwY97 zx68Zl)~^Bg-qy8ZRymmp)peubR=W&SR5;<3-8FQ53;ud-co(}<_k1&}(DI-9g%4bt zN(S3ytc#a#Iw*@O9C?>BTBDQjA)Qqf9PXVoVxatJTe!*GE+ce)FwkV2-FKW7k~h4a zSlmFTS)jIvwEF~CrtOLQHHskubJ8Ti{Q=|$UvJ$JQ`Pj$B5`YybblJGHQRvTSu4e`rH=iIWvjVKFyFTAg!~!5zuT7|&Q~mc{w+9=^fn#LNYcJLe0EMfKso)gAYEHrUkG0$ zDrtK3AIO>o<|uDCUeHY-d6kZVlZu{W`AH5qa5J|w>SnyG&?goBYF~8ofYi2O093KA zs^?A@UI}Im7LR!2vHHCmgay4{#|)Dm$5WO7WPWKmtY*`tY-4i-fuLa1NC!DsQ8JX5 z&E0C!%(|+}KlfNhf>7oB_hZ0A{gTv<3(1ZPN@uCq2&@tYdJE&!iWHjFh-6cLR zStn|W&ysCXK{mgCQsNON9%>#%n@GyjZuK`l3^^(1D;TGkeAs8AXz4RG5ZmVA#|LTS zA{eg&B9#jwpA?1{4jD15qI6R(qxMJNW+B#4M1$9G6c{;MdZs}WX(j*Zy*8`250h;r zIYe26Dx4Q)M722i2Gyf?R$T)?^`q|qMC0sskFVxNeoz=RbVbUFHW1RBaCSe5(UCxI z5(Fynw^rd+f#5DCVg_J9)o!EeK9z=4QP$qa{Facy2GqBp9165jnJUM$U1Wku)J~)r zBiyfBvaJ%bF}fBSh_aAHv|Z(?B**85iC68CCv15^@Ii@BrZVAD#P0*F{$4T`V-6&s68H=HbFk z7;c1;sCG83b`wbH&Gpx8_LJ{XQz^+p()w zpHZ_z};fNsFjHBLI- zQrj=dn>k*50++u)z!^I#1w!Xz#JAxDDs6#`Anh+?NSrxlm zANCCGCkljv<1OGlt?Z+{_O6q_ILEffl>=YH{)Zm?r|ScpGNkR#|BD6xqu;9JW@|+E zSKnOG(TYwMpOK!PPSnia!4aQ-zZQ^M9`yu=P zZpQvHpiS2Q%Ybh2QiY~(f&X}#LIMlW38ZVx3dLcHz{!NK0Q%OlSFjt~t#J*>L#~|JFGO{f8{ADWfCm)N zlML`@vwg41M+-F~f5pXHZT|bHoOiVS%NJu6Sj|z31D;K=h z%K%_~NJFp3QCm8srZ--iuN+9BtaT3!y)3Vk3x2D>kJ={&4|oUGn}f^(ZJQbC0N^R< z_s9?006xr5Y@{j@CpQp&4#0v8V63FusA^f(fPMPaw3T%2ZFyr z;X>*1X9a|5e|Y?tbYX~43D^ix{wNS~n!{rU>6F8p_0u_p=JH!pB5(_NF6P&Q#Z@Ny zb0A>wBR5830GanPGE)ecV)zFrn6}AL#w9~>`2tOdx97X2hV)iFR8I9}l`nXp+3d zp;lASp#9aFx7Q08n1P%m*MuufawP|{J1MEmOUn#gNy!nd)O|5nrU^wl z1VAXF5?0+2$tVDsn{!~%4L0I-TQfq{?u1+`pwI^>4Xl?0(W;<-<=*NV8; z6^~J#g-IkO6l9 zGx#}Js##g#<5rL6Zu{(;UV`!9=hHX*3gtW#JAAMIen!>!?p~kJwYPOhJfqZZox^_B zpsvWn4mbg)3pgN19b(L?T<^_9IcGz+(c{LiPsEjd>cnmgxI(Q7md;UM4C>DWGi6W( zJAk>y5qetsjuvrn3eb`gZP3XESP0Z$Sg7jLfURFvX;M|G!nq5Lw1D^WwN@rW%Ay%rY&l!{L|Mk;1Wbm#@488(ef$l;7kW)Z=Ap5Q!}hd zN9Fj&Qql8N=QXu)71n((&3Qo@R^zUlvyMpnnr#l$5fweZkvR>1`yCUW;hF4K$Hq)% z@7C(IY5e;?w1#g{o-2Q$vB*4|e))6VaTmdL#mqUVk8|evH?O4)g?*)A4T^S>wIoS} zal@0l)(MTbF1{lBPYbWLCveVDrp){X{GK$PyDVAv7>B-qX9?tcWYph+p3i?Uzd5)1 zSQtK1C6Q7d#LnOCmGga=C-o?JRn;FHy+&!8M*;&bzxLur7c)3`u!O1_9P7Kd&GDJp zXqC4G}!2LWdSKbtR{=&+b6+UiA%V|%k5)%D}T=3_Qs)@%2f=L~3z z%ZQE5r0f#{Whcrb-|x>Nx-t__Sym8VhU(zP#(BI*T2u3+S5%4#Rsp{DAveZO8|xch z@9)R&=jo@puCJGyjf$02-yhyB@75ddh&Y?hK$p&L4--$fMs>?$`#G@-yy6|beiLc9 zfp*^PoS)CHYpoS%O*1Z9gXjsrgH265!{hhezi^uEbr%wjm+r_7?z`$67ZaOLZ;!J= zFN=#$m7MlCBXUeXMHiWnClk{n@`T}r<7c;8`T%77Cg3FvRnI;PpH}O z?lZXv{j22W&b#efCRNi~JF+}MX%`97MYtJdFSmCt!*4_~zjKn8bz)w#g+IbC2e@QS zDudShniJNgC5^7%(`XiPpYj$@V%O(q3TPg655}xWjj}p;c?ll7ua24@A52%cR$cA6 zp7u|wYf3`0KdMtUKIshR|AJ%v2GncMZ$4S|Cv&=ZrIq!Fm8EoBBx^H~@QL_ze9bt2 zPuaI+SRU6ndBJirMuYsE2-2BfHpo8+Wcrh{R`JuZF#;KFrhk z0zWF8WBz|>2+Myb6<}hf|DXLRt$2AGe|qGgoe!$_(|T%T;n~1g@^MjAHYVmfl!>9Z z$a!SX+nt;3f58R}LHpzI_&ES^G|l-M&V;<|8lkJSwGy2V%WU z4;@uI^r@_wWhWm$GR_ZXmQ)q3x68z&=fY02-&m2-IH=^}=FA($vF>1je~8jW)xC%W z3fYHliv2x^2WAqxxB|MFKyse-F2tu*r<^kxzfE*HcOGQndxQ?r>uGlc7l z$WxOi0}8k!zze&Z7*F{=Qfl#|iy(tZ`3wK5FC)LUg`;>2R){fWnA>634!2uobl<k8KzFGL)yZGeXasKLPYp|s<#ErF%s@67S@UBf;ryGcyI;Q5t z*aS9RE!!G)CV?+%{<+;auaOo?RJTAtPezb!`%jZnUqQk9GZE z3;7GW{JurhxI$drLO>NQrl!*BCW+Is)-;Fojm>gU>XnPjy8(;!s0Tn8unqd4b-@?{ z(g-Hyf=z-M1~8&^?Sv znNre5*cl(vKqHYFV$}wzjg#po&`pdv8vO0_R2Zu#&5dCilGR3987|UbCNFs-BN_A% zQ{hsjCSMrY)XZ}HywcxuJ7*1BC4$X#7MK@ghnPhmJ~*+)vkyS7|GZS%Xzsu^fEtH< z*nOQ({mZyH<7@TN{lSe;Llpy$#LdMSg?_|yb)UT!*x%&{sDVCXDzyEB(e8Z8u^r6E zHtCtVQd_-uJ(fh0VLyG%p=Ga6??|BNs$zP|h}!OFNIl_YyduTJTS%crI5B)=zv!6ViE{T;&)CES-|T`S zp6h9BcbQBr{0#Bw5ShCgc)9_0`os`o=QtmbG*K8ag!uU@1V17@0#XzDhj1>Q^F1KE zHnuW~3YsEVDnQDf;C5I%**}MhJdEj~?L3@hKX5u ziUM=#qu0WWBdjHO{7Egz!&>0hta8X9z|(OK&B-Svq@r-Em9IY|(OtgIm{^SdNyNDr z+WZx=0hh??c~G!P5uDJwJjiKrWwdn?6lJjRP}phtrdHo4J5o^c-$y1{x1mBz7gU4s zsnI%|c2xw;#brh3r2toc%6@AhG0sN+0AFekc*IE9E1e#d;_wlT(h{M~Lyw)qm`JK1 zLg4az1K>9M@~&v=XX@ZM3!<>4Zee3c>F2$eR^df4AR-zzU$E|_GIa4)P&ZG{5U?*9 zj?OT#eH*%8PZR;S;Xab3%YMqg4;*emT?X#BjbTaAuP*G6a(S`}5fD1`57M z{Pkk0E=2L_Z@^Xm!yGpl8cBGM35urJ@mNi{XV)ugU>qwnh+MY&=4V3L0WL)hF8p@ z5!WZ{5h-7n!qO{32!msSE~plc>3;vw7U`Y?d)8@x5-F8u8Pzz3xmg0m3WkY-x!RNz z?P;HgH>VxUJ^Gbg!7p+nD;H`)1+5&49WICuaKSmK8UM!KP0xEeMGg#`Rs}wKb#Mfv zy%nC;jnZ-#)k!d04xD7Dt!>Ci4g|+HL2~x+GfF#T=;Jq&(e=4l^O7$87VnbB37+>P zTjmU(QJ=+U+7)nlv8MG}M0(}M(ccMMFQ+}9WPQ6MEE9nIV}qduESlPVSPUh2QI5%` zdvR%#r`xR#AbYM{`5XJ}gAF&x<&g_!Z`YW`!#TB}%3=i#NR!L{(bcO4w8_+2A?7Du zkQcO9(rM7iwOo7z@FdQ8=fW17$jQ+>KIUHdK?X_8)PGo#{^D_mhLt_uviN zNDot=gh}{O%zKI$mey1+m7`j3zZ9ag3gUy&6mDvEWP(WOy<#rhc9wk;e1SawxnHf8L9u0{VuxV)e)0Tz3o~gsa+XQ{ z0k^B0_c1~4#gwHK*oMA>J=H(4(V5h>Vp^5Ge4|T{?gQ-S6Vvj+oeYhzXLo_8e8E;* zJXWp(1cJ}AIcMF7?#M)Zmdv-!;z$&%SohW+#A`}rie#xruploIjkQ|A8sdUFa#`{f zxGL>(h^<9`a3kN4xJkon)PYYoww@}DTa8kC$eRm^r zXF;-FIPZE~zhuiZpUVM)cU%vA%=^~$4<}p}bkaPyJ55ThF$$#ljh>tlqmVacib_aeXrZd)sT&UtDz<@m zVxcY8&j-dFVsexcJ1j(fpaz4zqbAQj=wfiw@e7{%K=m1k?Y_!GLC#-~mxxU0aYy zSvTPOvY}=+gZYB7VS!+P(hm3%UdgiI`ZvJoC93X5aE&Flj;kyXHQ?(;`s_H;DE1s# zs5nlfS8YMPo{^ljw4`s{O872A@Q&GOf3U(PnunA(<<<=kc2A<*6~B!#&A31Ob*=#o zrBAB~Zc$Pa<*EIo*5}9JfV>F-uZJFRY-rR zE1s;T<+P?hWOIS-2HqrZ*P+*C2|M%@#L~vgn|!C1un#xam+b5I zvJ&u%&|Ei{dKn+i3vmzJJ4dm&cFubCZU&G| zcI88^LE%(b;Wj$Z5z}XW6=d7ESPX%?sQZjX1p>6jb^p)){?GmP_Js`Vk({E2?dt_J zy2RV42VlaA0*Lawp|>Rn3~$<`CbTRmz8GcUIATeJd--G+G%-MziW4eEfuhzj53mou zZ?4V6bO-;}C7ER2$%Yv+FXGp;Z-zen@UAa{Znwm7#16O8W%C!~n>l6k7dZe1a>7Me zc*K1GghoE|Rd-2wb0#dNM$FZ|Cuse#Q3k3o47HSkz zYu1WaHJ{75xOcV+)S9NZpn&?OsfT`(YR|ipSl73llQf6d2*FDKv}OJp?94-9>Ak>Ru^P*U_lrS>kwH7%5Sawu77)%x&)S7xc_9lrlc(p zLRv=E&*od@1T}OnC(uX)NcyWV!7{BL?hTuQ8lBrwT+1mJN-E zM+DJN>U{obDO=ptZ3IrK31y#WNqx#_lVIIXu1#u{Ll~ zHZya|i`Yb`$ySbylG)@X-4kP1uos>z*PSLBnCoUK?!_t~pVcos_`axKquvP3z=2@j zmmx;?fiG3bluREk@?$v)U$n@rK+dbrHX-aRO{AAjABNcfzVIJdIOIwKy~@~FaUM)v zXtXKn;#))$`Uc#a-MD8^Lt=iY%Gun#|yoo0ORG zN?CiQM#+xXpBmS3C0d}tpjRelAK$zV57CLEkIy8<-gy+ce;TFfko{#73Zi8sw?X4J zmyb`omS~D_taz^;u0l66Z2M1luFj@;k6)zQ%ksRRm3Jr33{G)U2G_XqmF&_g!i04NtbaNKllU=B9A{A-Rc& z3V1BKPGx5h^qxAP65&;M*RESEOd9E4eanqCl%-wM9Y8AgHF?znCvLB}@V4Q1E0Uu0 zM6R2p^f-^UHSo16#$`;4hO$d&XsC~Cbzu2`X>oWUQ?9pwOJp*7&4TZd?M`a6qIFI# zI^wU-lX*+j=`uqUitcDdnVFUWt|&3Ali$k$XKr`gyZ^rbG0+|OY{i!i*rD*&IV*`` zXp=PgX!`d;>rKtb)-$g{Ggt(9#M+Dz-0emTD!&n8w8@{#}h)NEHQv#ziV%M{)6nM zTT1AA_5vg;$Uyg?Kh-z214=5TA4K&8`%HFVM@#_QJL#R0*$1-cayje)yuyY3GvxLM zFJ?`re3viTmx%r2z3b(tVXr6I*EKkQ-J;7&hgd6U$>7fsr($+&*`W8ZIAbKV4?9Fj z{#O^7BP}A1+E{{~ua^y$UtxaH`)wQ#*y|s4!3iNsFI}8g2PVIKOgaJ#HH+RkcL?Sj zMKpV2S6+V7+uuA+`IZ7AX+jtxZSODxxm3@bPT9Ft8gmN(mwh;txEHaEtU=cA-Mi{~ zpym%^;WF8H(uuF!^eHrXTDSy;Nt5}hLF{eu%6U_cVNw%A(&A#1 z;6$s5JbEnQVPK5nKsLMGUpei&qnA1>wk$6;8180=Gdx9WUwwV-h*=WmRkaQ~$_G@* zynxZ#Hsl0RHy%(C3z?l9LXb0iw-#R0h(nLgbh>|05EbMe`^%VDDWV)K2b81U`YX3t z7~?$;lpVtqsYNeGQazsO;75y8OBu2@MGa<9H7;aSRY#Q->4{GSa~*37QML9ByOY-G zz3K=pEF`QZAex2t6yCKfq=ggPSEv;M7A9%^;K z9%_k~hM$8^hA=6jc;UaWP65*5P*hKAGv{r$u;*8~^#csavY0@ar=_zp#H+bNvbgTT z-uTfxGWPp@0s1ttoBFDFvX*@dnyW;)AJ;mGCd#O7H+DSMq(~i z95~+WyJ4Q#DIdK3sCuUOZQ`Niz#)}|m_pEHP{FOm+U#tO0pp^}=o#5*Nvb~~j&df& z=8Pw?Ny&kIkY|>G?gW8gtwOPP)UxLoiC9@Q@@0bQzMbP}ts(KF^`AKN8ext{hu3@F zeWDn={JU{N75)34opdCsjz!fUpcVMSj5Ya^_F7rl+Fo>U5k(*f+AT*{9583%;B;#Wj#kiCrRo8^fmlurL zYWO66mWvTN=!Q#(nT4UiubJ_eolpvmpNkkhMuHyF;VQ<)>7)t9`Yj|F;U9(4fr=4= z{#ub~t-bjUGpCP%t-FsP6{AytvQYTIi1-X*C0qYMsxo;yDaq-%=WPr^M%4CLJzcZn zxgr7y=Sc8clu(f=MvFCSs9psUu{Ky;7Vf!y z?^hQdFW;FqFPUA~a3nf%5LN%Mt1(SoJN}7y;gFqDEx|I&Kos?DlVX!O6g4zq%iacV zhQ#S|Iu$nlrqI8)v^bVdU!>zUKlLWrJf*} zTpr_hf3$hHglX6LMO_W3{G~U)x*`_WeIH$csvE}k2>lnGYCr@=3mkS;xfBgoWO_I6$pN`~z1Sb5~Wq5Wb7LNbfFsX6}cSTy6 ze}>e%3fAw{M@oxLI%8Rc2lDgvoAsa@{>Ayg4jQzzc+vQd%?Qgje5{SuS)f!*#6J)O z{HGv-9S{(H{L`ExV_!4tiJw15$2~J&yt`{BdM}r0X)eawX=_9XOI=(fh+*y~&Y;iDHc^iDu+}iv1oYCV-ESm z%aZi&n=UF-Vl1~&8bj`34$G2~F6JdYRe~x9RVK2iZw}Fvs4hxVq9R9Cro3ow4%3vZ zE>=~-Du-1jvuJD%)l`i|lHabF6W$#5y>?aRTKxKOJ$&s_X{>=FaV#}Yd=x(r&v$D2 zPRxJmGLzjc^nrWRQkJtOYS}Pw z{MStM=liScJ;#V?Tl0Py%SNR8N&MJwW9GR6&;kqu?)Bly&*lUAl4F+rcE-i=27g+< zTj9HC3%(;!02sUqYtyFIjvhB3V;p*m*YdJ9R_`Qu1I~v#-}CS=j#JxeN(U6m#z^3d zbgqGE^kFjKcQhsqU!q7O=nH@3;WXLDi#-^*um9oe;wbwcy?)4n3Uf$FD$Guo>OB?z z1Tjf-{)6;KeBEJvW8mULRmOoE$ZlaSNYJa^kHownnyvB%cKIS(TAl6 z(k*WiT>SlD9XNhm%cMQ*m+_how>=g7mwxNGb|Cy3M<@b(Igh))P_c{cm6co$^oxsiZ7O z_pCVH!y@6X9*?-6gl7dciJBsRm6Y)k~pC*W0UZC{0!+ z0VjQZb4MT$Aww1ExbQmbo?FD$52u-@^Zx7D_@5^}kQuEm4i<>!!gWa-g&z*rO+(cy zR174Q8-;d=RF^v}kntaK>&|aJ6*_n8$AS%+9D5YG90ioqY6<8dTe(9~v=aJdQ*iDM zmEn=Z^-cF?-H=4F8$!6|FqhhLC`wpZ*zm`_bk62eeMgBl-3;JhM=gYfK(bnvJQP5{ zygWcalspy|6cmp;ozEL>;%rR=!Br4aL;5Y& zuxPJnm5e#ZJxc2q8y8)s`X{ha-N>*tNm@XKc;&GSRBGsSV7vjwhxO*r{43Dz-pO<} zlpa41AEvMUw*wbB7mmY$?<*@ES6pc`Uz@#H5+a$BB&W&`1ATq$Lf>JPw1m`wBVS&c ziP6+IJImL6Ze|>>R}t;CJ)!3Sh9Cd{i2I?1ua2&L1&qG44miRgJ9F z`_ZSK;l=b6J)yN53rP{a9Qc9^_B2r7(}HkYKEs0u6+m~i*-R}{*z0>%p!4I`raxX`*W{WR0vrFKe1b^Ix?vO0 zQ`)@<5PkWgQWExJE=Aa<*`XabMlJZRTDB|hb%fP^d!lktkuf~>jrS8pJg(rDeH^+q zBXQ>}o6*Kw+pG12#Qlq4*%VqQ%C;))7uonp)TKa8gvI>QnRx&wRH~qXKsI({nVP(s z>nsLFd=AB!>_njE2Dgy_bBc5!$Zzl&vl`(0XgNMD8Lc`7-iUx8?(rk!=1Vp8aw#AR z{oHseI|unfe0cn9t_UNw4su*-I`m!h;TI?D+81H~Uw!zP)F>76@v&VjQV4sL#3*@Z z^@5JkppK2>`-H?uHmsGM$62-D=+x-g{Dl!`7OM)Z6i^BmN2yYvog$Z3lE)Ebe%Qgk zOn40WI`pMnluHQB&hYC=mANVt{l@283&mTG?~&J*!B2g}(=#`Jj}9OnR0X6(h*vzH z>A0dn2wvU9wJ=dyym@_>rgk7-&$h@#lJ2(%P+g%=2@jLM_=`U z=Sj(AAe^4_`e3qJM@bGGAAs2IMm-N7eUr%o-2e)h$KFFFS0%I9cPTf-%bp@Tj7fcT zVs18C!;~Dj389qeaiyPHEwb?d&=Df3@uj(s7LKK^>B#K;(1FiwPA!-Y|^@ zBZfHb`&^M>O|xWif$y`z$lpWHFXE@*joD34taFH+w|S(cVbQkQDU!#>Gdk3afWL7I zUGPkRI__a!&mc1Vn`1<`qo@+3+C$5$|2N1f~ zSJ}KWuz1$#bUIZwjj6pdIsMm7JkUek9Syzc852283_j|{>~>k`w=VLADsO*m{x zYXDP|3&O+fLsu#xo$q(*WpMIk=7Y`S2_!NqgFr;r^OTGQ5n9CTyX^YNxoy3D6E-o7 z(cFC0bMzVdXp0F-nei9dmd*MDM8pFtZ?-%p5%z4o&W;F-v|jT8QMZEtI)4xW(Pa#F z3c8pjJ*+!&3WsLFs;WZrj+7_tKH`i(dV+eh5vEAuO(nud$hexvK1~ftNknJ_%)enO zWC!G1a%L5f+%JNs`f^%S0lBKr;)vIx!mkXqA^pR)7NDJ-z7Y zgtD@!R}hsH7x%(42GIPmETej^yL0}#%V!*lPQD7 zee6*pGo@JIZIMXyz)??x^XL&-2Gi71j8FIsEhpAi-%=d(v=Va~fA4jt!tLkOtpPnH zGq5ZBR|zDfsP_kod)8JYsp*qX@+PHZq}gHI|4Fn)GjwE58GfF_#dxZVKw zaA*}`#%95u;*3|x_OX~b(P9Yi=8g^zT>>9?&K>8`122M`Q}U+ja1uM0CD-Tu$bZ^= zTfjQDuU+?=fV3G#9`Igp&4rn!e<8!kq1SK!VuvMsimrkkejSE)Kqm64r_>$CL?458 z@4Tg`f8QIn!Dc3Zac>k&6gi5B>VC-CXv54mMLf_Vx}4Kx!)K+1M%i zJMfip^eNW|6LCZI(m`xHc#3@?bEiL^|rYzdZ$oFzZ#PWMUEHNiD6AiAJ<} z%2c!ARQ01{|GDjyQbP`?s0aa`>gH7*5esl{k3pfV#UR2!-oni^W# zs?7_ay3C{7Fn<+9TSC=c+K{BVxVX58W6I$H`{6jlGD#sUJ&#qvbe%jLTOYWo6>NlqHQcl#}CuYe*MMXJZT48h4H zd-_v*$9Jz&8VsN@y-!-RALUr{iykn4@tqCbS4`)t?Gh`J3!*a=_>8hjgW9ke0wknv z%ODiQi{~g|KPJ*e!#aU`tkb~(ju>&hKYJZ@;!-PTOfL?lHHW{UJr^mK+2KR?9$}XQ z@eL(=Kn@) zkCFo_Z3Gc<4cTCz0yh5hUWCJqi?cQ7!*cQ-Lj1UrBpvL3sL7osih#oyJ0$U;@s}h> z1}hCLWL_EPz+%G30E&D7)b=Uf8C^*omHHQJ8zJD|pwfC1)!60^e<;tkADBw8FEq|xH{uMi#@PsDPv`{dK$kVr$MS=)el%Yy3JiE4?-q3 z&*JgrHsy6>6ENMuZCHsIPJuQ4h3%T^`QyO95D`@r5VB{l?|5g$fV0jMTJ=QpJ$Lrm zvlSH~NTitLQ`jC(roM2DqawhuSkWA;Hj_r|FQ&h2{}3!&wRs&j_l??AD|x2Dh+%;G zsJdZVhyAI;QF9fXTx8n@BTfC9=RXt)&yD(UaV+K;`9psid{z$0W7tMccG!NVgUEz2 zWeG(uDx}$(iIOs;fNZcI>fG`8&AIcu@b~A2oJDs2N<>1I#Rz3=9;<_#`Wt#iz|&&Y z;%j>cyjDl>+v2t&!DRv2b-X0Tgf%y6ZS@$YMAh6rMaj1GA4>B zj(YU=P<#!vGw=1zs7Zq+njK!1($#0e>3HK5wP|qyQe+dGes_k~1oLS`QY%>apt=Pd zK6ZUiddVFJfDNuSpY6j|r3(rHXa{ty`O?625kUG|6Y3+21+wx8mbrHkBVyR)@rvc_O5l%Ke?l+)gIB6c+jS=#=E7T={fWUHJ(A^1}yz zD?9Y?ixMv5ZZ8}zAUXD}K!j8=5iYd6rkr!ki0k~_HG6}~$mj_gQ5|_iq4gVNB<=^; zI1Vxd>9jKrhxK2jwl_fxR;Z_%n=6aZP2e_*XZnLj7z zu+E6U-Mp7e!LD620ZN2VCwBM&&<6d?jkCL3u~~V0vs!@$n3wIt7u%taBmvAXv&z*V zCn&#p656`)ziAvpkHw$r{!80;d+=IEIX+0rfE+W^U{(V1EU?rp${YQK(@Quy`=j9W zL*lSh7AAbGz2zkuKr)y&4d+MBr4C`z^)s%{cwu;8ImI%HlV4B5RB$|A_$Try7r8@i ztcG%UdloptKn|y&)8!W*gALTwo{kX*9)n5Ie(H5kLXYKxy>kMej8>pjf9?&-MKj2j zBHf*Z9%T`+zW^t+SMVD!TK@+WUz922ZpmN<=oy`PJ?cr;xPR^I z9^TJgE5Hi=*iW8Z7KGuBsBESEjWZB9=n95g`hZJHpFj#M6 zWhBLo{L6gahpR+lVk|a z0hJJKl(lfq7@f!X_X19{CHtjAu%m;u<|n9Qy!do~zTi?(67nX;2qRY|M9PWiDc!-F-oiPU@ znAJTjeTG+CAikBfE{7NLlgJi2ioUT+-hX{#v(6v^Ua)q}@|%!xhlYTd@le(OwkHeJ zqFo$ipt`LaRdgdp_h;@T;WGLXaU{osK^)Rmy?(?OGs7=FrA=_Trr0s zSC2E1RA@45^{Z_4fOC7JUUW}jl{hPuOVC0LOEHLq@%2+Q82oO91J_)byVQ7gjuz!i zOxUT2tRRq2u@;+TD(D|m3?bPk@~*%~S!(%H8|Hv265=uFzP7x<3?wv%spt9OGD&$o zKdou-!}>$A`L6@aPZ;H$3ca}e&M_C>w&J)wYXCDR?gUg>lV%ryGs+M zhbVzpuuuL4YqrFL(ZIKDGEoSnv^?sOWkna~{SQx~^kp&i>-9oS{;Mq#6RfcBr zq>tVN&txwNFKR=G4oZQ-N70S+X&kV0So?V8e7CvcKI+2hl&jj2E`~BWOohXkbopjQ zWd*Mukq(dDmUqHdV#*Cqm;86VNBQrSH9lrvc=`|B5wd7emcREj@n^cx6Ch^*4ySA8 zp~>n;AQqN&w||K-#8)*F`Q#fu$V4|GW}Lms3o>;gh`U>c)%O6fL!Qz|PC7p6*} z7Xd-LVA0}Aede}+QWIgnLl<87T<1Lq9hCfNDJ%59d1+-03g#ltub9&;oVIzeuZF?4 z8Mb)Ab5t$~)eyL-i zO#3?~=Cu2%FAnE`qCXOuJtwI;FJkz(n?}^I&<&CQ{Z+Lu{}`LajF)_XNpLN`lecn8 zm@>|lWu9dBagF!ec23$KxS%deNP&@kx^D|Ed@>w{9{4yIJo%LtB1Bic64;B&B=88+ zX%ve;;BX)y>LImVLs&ljg3Ry%8%E1GWsCHQj0jgw^JFM-SWO0&0flS zVsc-u_pr>up5kx)dXzZrN6}{E*u?8?4&In*6p(V3`wv5l*mw^sitzE0iW-VOy~Z_ zV`WLi*1tMO+MBI)rLJdgRz?2%v#1XU)*2jPhu^N;%umO_jsUCh5oS% zG0L{xaDo2w3O8)JzW)f1oif;?9qkD-Rhpn##wn%FYP(40zDjRv$`vlx+BkMt_1F0` z#T!nk`zEfZqCvXxaoPS@;bYZtR3?|9Mss>!?Zf$!<FHjIYgzg6Wo<{{Mgq?&;8 zy(WT*Kz`XDjP!w2u7eeorO))~VN=}Pcpg67$4PZ7(yBKCO<{x8CjpV_o3NgOo*v1O zf~6;t_NP=PA2dx&1=O=r2q-uPP|b>ItA=}?Lih6W}&ItDJc!TP>KG+tisSR<3qwpB05Bg&2e z`ZndKtEjhi$-WCQqvb2J6_#F*D@gB;vts^gOS}aZ0t)7Us`3@@3fju@`4tFDE`C6q z(0XL*IP+(6^dRYlne3@?4(BpuT@s~30B0-^59-BHDCIh#%)%fxh}dY-#Vb53>chbw z&}kP0`=Ym~zusFtY2TF4sNbKAXQ!nX)liAjsxWcB3&2JT-eU(0AHImtznJt$o|`*o z5RQHQ>~`pc-7iT@2?5Frz}h0N-!l8jHw)drm=V1?`DhYa9_2$jrxIn!CO!e;LS}ZO zu=KZ)UTRCeLyTLPub9!oK@V%Xqj3RqpQ*WVNrU}s{?1^f4SC-9o_maDek5!P^`#cO zKMf{pz?~?`Gs!b`P+Wb`E96;!g9{b=NcJHLU~60BaDrN`Vd;5k-QdOhFNbs7allR) zlw};wo8fNJSgx0v&nYY6oTb;bTW0eb&!5g#oOgRF0t$UcwvQJ=8T*IHwfHOa03!v? zGX%jc-~b(e8pqe5UVq#wy0>7tBmyo86r-#pSr2QNeSoJ`%ywgkICdhzWPzAn^VlmD1nlg=27yxZpHY$0G! zu~E2zVgM1ff&;xe*5652C($o3D_&w}t#ccLTOlVc{^*1*c+CVqKjqt4g@&`db!CPx> z9g;cIlk#Xi8a_s>+p_&s>F#EO-pta{w>8$s&3ocxUJlV{;dwe8VDxbj!l<6CbF|%= zGJi%JpwZBw;qaH|8EU4sPSa-;pO1b9fVJA0igyy9Pqc>NU-WiF=JN6heKyIE&O!}k zozo!Ib&z2rkh|5I`5@5t^RM9JQatJ8e`Gaog7MIW;sYN1Lc^j%PsCh0M0X>Lo|%Y+zjF%(F1d8>_lU6~6eKbZ&gk zFSJD*_eiw4#D0o3&R>paZygJv_AZ&I40*0j!_^vKl;o6>DHBum<(kH?O z>g(@p4*`;(4g&f|xgu+YJ(uvVy zB{9S|=*0;7o3Xo*f^m_H)<#SamFHl^5j6Bs2*iiDTR8Pa%!-LuppbZ5Awd5!N+Dil zNNRdyU7JtbEMHog*Y0S=-Y80XcKh2r|MKF7|4IMf;D`T{%8!x$zf@e>@w5NoQATdL zf@8Bw!T}0=iGq{@2RewdkYDf* z+!!IwzqgjIt#$0IoOt==g#hkZ(PtvN`z>lq7<<^R7b%(od-^VhG;5nw4Sno|x&b05 z7B-3ViP_1sq)F#pJ_6+X)gXia7zb&5cWwqnInw%aV4|3d#7E7GWP#6M+XCB$H|Ckj z%)a=)#$5I>+v~WOOfPqJp2lj#ws^%&BBC^lDYMz9geYvOLmgy+>h61O8}~q;kV9Su zxgmAn!7T^$eyX!3pUNFAYk1J`a_~aDngouVI!zmCrTqQ?h{`2%|8J+yhDV2IYhVGz z#YOvnMo(B6S^tX;s#bSZQaWwnJ?vv24S7EMGYyj>WGEbM5RD*Y*uRDeAx5iE#CmRR zG7HlkCI$}ZFVDAB@5)4yqSb9q;z7+yGU9pYP5ZegdgHl^PG$bu?Yipmo7H@hwEb%P z`@+gFG8Of&0{VT8N~_bbx(@O3MVW(QZy-CVt&!eC&e`Pzuj*q)y7Vg!g}npbUX&{ZoHT z{xSy0GpJ0FnJ_VipiB1pW}=H4cMVGEkuW5tjZYz)P#8{28Jf`DGBBpAN5L{?rVAd= znp&ZAn$R20Qt78K;L=T|9Zx}-5Fhqc8SogXFj}THPjQ%VH~O!SSsAb}YNl035jGZ~ z5f+9lO^!^$y#l>+xHo=rzR#N2W>_7HBfcDB9leyqK` zchy?&mi1(Rv%E}R+b;Jm4@?kP_00jMg2ADuvD{Vi=LFi-9qyI&Zwq>bYGHObnLW?h z?BCHH)6MFuhT3A}=ZVFtFjK%i8;CJ)wv~#zr6d7{&i;sa7osq8gbeD7X&y$?W_SF}3LX3VUYe-g_GZ zREaynyVyE}knKTAg0&;aFxx~gf<9P*^zcV=wg%{R58|D@6PkFJWWT2d8| z1*QEXT_vCQjLUmCZr4Sc2Ghg>S;SM#xW}4npft%Gc(vtwz(+V!oZmt>(YbT0L4JfL z2xoMETp!$-bRUCfNup#6^!zn85@!+j0^(w>pv~RkR#>2=k$I+N@`yK6_HQ4 zKj&X|NPoJ=_BUeUvD5T>OEx|uEgo*%YwAY3c!E1FJ6E$0Eut})`tG{4b+48*1FjPh znqh5yTbI~JC;>F5umCWAkxCFHiiTb^;z>j7Dk# z?=`QMJwqPaUI0gvAUafgdmcEqZd#G7yvSfnwFNV}R1%;OeH?;bu4ITdDd7g17keYv zTNjXb{sa(aQ5CI#r8?;OKJq z%wtgl*aXzWgBx^{Hv#2Pw?mbv=04;)r+?u?AJL>n3}7xaHV<`84G&LE4K)uoHZ?W2 z1T=l(8D&mw;WIH@YUE_+zXHc_6PFGVK9GVT1LAn@54&(Yjx01|VC+_6o2ELPduQY8 z-P55^;M*9U<#0Y5c<6+%>X*_R99^^@@tb(6 z)>B(AtQ(;RFrR@rmLSoVQ zg26vF@J$WH{FDH{M?xJ!{o`tDfIB+02G|$WsZ}&D@Y(=Wdf-=nyFzN(f@$cp#xG)B^9`V_XJA$Za1fH{GXtxoXK^)OE za_5sD+UlD7AYW#B?KW^9V%Mpx22c$Q;-3F7Du z`~$}|&x$!fNE8aT@2Mm0-q%wux zAgh&e2fM>0Us_E9P}m+G8BD4+A+bA?gQO7&0)Pp<{atr_aKI1u1W#kjF7nx1HaHnk z81Q3S&nEH~EraB@^Ez+)g zbL7s<)`&F2IVVs}8reL(D92DR2GK@A?^dKMdB4z2%{wg9cj{Q|lr<X3f z7e){9e#K_P*WF-7a|L<)>?-G54Y~hrl-*U%F`*4@|=vs-cL!scDoq{mK{xr2h zg>PG8k-;llM>XaG=trWIiTu?v;@XY!_0`sn#|#*Y(?%5N5(HvoGDS#cm>XOp`@G4e z7KTdqN(Ce&$z&u|S&)(aJ@b`|rv@9!ZXme*uOpSDHNGlafV%yxa41LCI%t`arp&sP z%gYs19S-Cm+;r_6h_d@_x*ZdaZ1B56aDsF(YV!_h)dYpUI0RwvKO@^gl>X9{721z0 z0P%xoNzVB+KbKfQ*F?4>a{w)W>-U<7oS9xq6ypXtA|w!u)Q&(H(BA6T6vlZb9O{+P z>(|4Zr|s%hLJa#AQA-8xvk(nNFxRouOm?=#q~9|#9MVpL3k@ox)ZPWEvQ(bOYu*K1 z&1X5S{)NCz*x!H~#BNuC%EeoOR;|I@7^o$k(yAkR$AYM&{PEK^3y~IeXBCo62VjM3 zqsSgzB8=P2poPJgA}f@Oa9h}<{*t}*GHhqoHa`t-e8q%QG|pYu_QKz=T7isrf}6*S zt~baoeW!M|&cyDgss6&gH>=`Xc2?In(oEqpMu_Mlm=r+f4EB*1w01{w;=$nj289#%&_&Z-mGs|CIg z*4FU(!C;0AEe0Is-`CnuhlM&szF{Cc$x4HYgqPXupj%rdeyqvQO`rX4q%(QHs2iKT z%*>N+AIkOx`N+EntC+@qiMa=2?PYnnJ4pd1@HaC^ebP`Hem6ok8KJ)}#u#trz>-jn z8k75Mz9Y>Ovyw>U=g7O+I8@)gl8O8IC;~lA#Hl4fA~Zp9|5yt`vCWr!%D&&PC#7nv@cW=-`(sUqv}ov- z*8*sC9XA0m$ynIZie@Wu9&3Rrl{qpqrzZslJ#GUP|BQ!+cC4`|HhL54Z!>&V`iVQ$ zJ&{J9)yc=>6Qv9ts4bvb+p`bn^#3g(VihmF!)I%`?W#KrIe~5y=D&XFsg!P=S;g4r z%DUfaZE`7g0bLvLnqJ`J^f{e~zPTjA(hy@zUyT{nZHk9p4pVkh;RB5X{_z3+ESNgM zaTgU9lZ9H>Z57RU<7<;G{afYXO2QWRQ-O|5k2n9vU`Pa*1p_>jjuC(qJ{*a#j8N8M zMkhG)s}WK+@ipmahcex1q3Qcrn3%;uFlN_qG9R#ld-59}8B34Y=qO}$R@i+(c+Ypt zQ%kKGIzeeZF1{js+AbUhvVe)~*=r(ss-npdgPWI#rhaj-u0DcvLP8&hWk=s0gi5;$ zxTPe9VCcD&dvl@m#68Vyjiw zzW-Rng0k3ikmnuevusacX+G}c`jq>@R2k&>$lJH-jCeVR_Vp9<} zwR#8Gi`ht3z9})ogl!v^W{j-2RE)K5QsnH15gXO~M1%#`^Vla)(4Tkbo85gdoV(-~ zJd5Z1-~NLC7v{m~DBA~}s|!zjCP24e$8Rgzdyl=w4ztpi_?v5l6P_rEj9s>1lHUMA zaod^e9z!r8p)ZzTrQ<|)t{od_ZB$YO%?jD2LfE!|O*ze}%Z8q~6*fvIZG6;CPAT5u5b?>bn1QK(XC|=Q+-YmOpwZr6hvV4X z{MFg+2E)e0%035H}_ZoAY$<|PtN z1*C)~42C|2rEu$IoOx`kZWwT)5meZnKXPJ?t&0AIVp;9h@T!)!o#q}qk)Fl~Iwgsv zmT7OY__nSpH`}WEv063H$x`J(6lF35jbZ%!C;Re`n+e2=WyH6=O+$s6CNc!livkz( zpCvfiLGezVRstq=TI z)RC+!d7P^D$?X&3vJ(D6>wihA^6DsY=8~CcAW<^>jB|Z#jEOK&Zb|1$p@XAmLrhey4%392~GP}_XSMQD4E zP7@xE7vZ87WYy4A4^Mxd83a)}Ohso2QZ!Wz{q8|*ehWc7zCbyY=zy#Y;YwMBM9u+O z+jW!`7gd*+U}N8fV~@yDs|y}VovFW!xQuW>;I)Eqc(vc^KE*a$ zC`yYRqL6&frjV5R@I_6njalwpaMxhR`D92?$~ZdDZN^yJ|9M4g`3?fx&vQ*2frPgF zDP?I5mg!;zFE0}%E0+6X_V@sjPdb3yq-h4o^y z^W&h)V`RotMMN2nOps&xStaNWu=sc2+_}ksa~z zZ7vW?7M_<)@~gTzX_SGuQT%Bvz#YIUyq#P63eLH9h5CkH`_3u3<4e4V{OU{E z`fGWitF(rjy!smps_-i>hV=kMUxXy!3xjC46lFV(DU`;M-6cH2lOx%waDPXm@vr@G zfam6KYJ9MtL~>TdW)x)j{s|3-Q^o;+J%^ljn|mu7?}}OMk(uE2P6S^|XM65-hrDh! zBoAh^M{BovMnrdtZPzk(U)WZPUFLMK0t;c>W@uo-aBxy2og55f7j;E*vH2=iuI|=DhEYt|I6GR zyxTNk%G9?roG)~O1c$uH)xTQ5P-vz@7cI>h{vZ=Z_GjO)N-HRK0AfZs zAh_+8O8+o+bZ5kOMwjFELlzVZvfRz4yP#%C7yLS<6GGD@!-Ot_?maArJ6Muo9Rga) z9Hg zEA*^}RkH}wA?4bV6R?>X)8&ZdjEO~wFMmQx9dN1~%vbR_BxC9<|G-tZYX#J6U0FGi zfTAcUdpu(w$>E-)fD1*d>#*gU22L#$j!SKCeuq&Aje{%4%M#fVpCYvSNJ4elkiy8JdmA?qX?z z*NICv+e?0*YjLr>dl^}fX)445h>jn88R_za*>9Q?#SYQppimmwusRrrCz)`6A~{RO zCSvwv;<+i-V3kiWP!V@FY$u+|FUG94o>ek?E;FQQvb^x60EB~00Ud-h{LtDp(0Pdm z`b@s7GnSOcvbVnseYqy%H8v!~@*lTz3|)UGlHN>RXgM-D>&cN4Q{w^qYE7vTp@)~> z&$Q&_#uBXCv+Cg)yf+;_p9M?Wb$yL-88aVzx|_eL?sn#W!It6+5&yU70?&fG~UJ*u>ckU7-E~Wn;No zSVHmn4YUK0!S%m(dyuCipQ(H`Pb9NYZ8OQDo;C5Konsx{Cq}% zsALq#amx)7uM&&dPPIoxp0h=s{N$PwNl-<8h{*E1{rE#wjGGS57DRM zi>EuEJC8ZfpV^K(Vt+L?MF`^8dhb6Xj4xBAG!9N~c&sblXQrGA7_PnBCT5sI=(&mM zxw(gk*3xq7yfgHPj0w+K1L00?ZE;zBc?ElOP_WQ7!-FE_2A0YhOQfOUbEaG>s$dN#>!OnO)AFb2O#US~ z?osuoSZSl_@lk|?h9dM_j2Y;IT+Go5NQ*I_ejPdR23d$Xhm^0#;DI)>FwyVFl44pPobJn9`?I2SccFcnm{zlFlZ@o3h^AJMQ2ZAU?yG@ zY!YpHY`$9mF3v31L>aF$oc}RTXbQxf=cmA8fl?3yM?c()TweL(w61~QHFgu#U z>oWc${s|X)iru&0Im#$HgQ?E+;9uBznA`Aoy|pk0r&(VKnKudkv{PgjQ=1MWx9z5B zqP*X|$ua%Wmn;2=2%XV(>Zf#sEBUVJ&gp4!7g{oSRtWwcJatvOrj5&uS^!;VbvBy(lzYXtvdrr`HV#zl`@c105SN5A znOUBP8!wg}a4)ZoJhiX5XcD9=7IhmeJ;QL|qQHbT`3b*-2enO^P-Kv9uH z*Du>{fgIy&Q`h}9nyIq^d+mglnVK2iv)pL&@xgd67kv}BBm3lu2r+yZg@T0x@$cRg z_F~eCMZDlhir8vI3;bG!&alB+-&5XoZ=b`FZCh%MrJt4Y#OqUD1Rb4;QBh_rZjEI* zEiIITb959$+63p4+4osjXPcd)=a+$1xGHWRgWvW`Z%WKqoC+%%@^YB1eRLEo+6~gb zcNu`9m_*SdTQjvB^WhfH5#h(0YYiM`Hjsg8_rxmXp?!WDWq$-yKBi&RaZ7jY=^wg1 z;rF_Wn1Q*E?P>E->b-7TLh6B2iI%2$Mfhd=sMZ1_hLWP=y&%9@RR-IwBBX8>RM z7n2V?1^BTm;G~fjxeE^r^jY1oB`H=~&tp(l?2S-*`Y2^BXZUzrYkGP-Y)>%7fk1>k zZM7za5jA;eTPA9i~O--FooE3l(y_M8b=#HAg(gpRuR18bgkpk z@4yu)e%Ehauzlw9_3=4`8{@#)H>CC&@X3{f%A$xLTS!WYOZchKwDT#dzX!u&0=}`n z2kEjw(9o@=YA)T#B*$ZDNMe1PQL+K8_iucV@5gT^A|D#^qb6k+gTdmhhr*E|_(E_q zS6c3;4lXS%{VQkZk0XH_UeK-Y0CP?OLv6dS9UZ=#gR}Mf#uW(@h2>C-kBs)L2*?Q; z^+Bb!q=gtvDj4Y5VUx5RY>c##Yy?TE{#@B!5=u#qWk;Ub-4kXXq9h`PfAPKKzR{dK zfbDK~RBmD#FyiB~X^R`DL!jJ)T2yx(Jagw4k7c=1%utR8Qdqbz%J_5j5H;$20y43q z_2KaH-Z6HnUuK|7q(#b905KNb`AYsv(58IU>GYuLFCQy-R1nFFj{{!*chypqwgJ64q|)iB}!lSAoVFQNfrG=&I8Ffhk>z1JSg zkk@1Q8PRl5iI6G@>Zsd5islY zYkMK8LJWl-J=RwD>Azvg(EWUjH&@Okh99+~7_C_yMtC6bT>g&czfefsNsoUy({u+^E%uaoYqU;frb*2 zXpz1ct#z?Cy0DTcomo;~fRf2jice5-uFN~2wq@p8XX6hvNZWRHWPbalqsBCAHatvMX9y8x9et0tddqSHPaDR79SIm0o+W8+rlFN zCG+6#|KvL~w|Yo-AmW83ev7b|Yq5>|cw9ucs@7^VD{nzQMhb8`I6OG;k1mUxA4S*| z|32mJihz3^T;AS7H016VQlDyPnj_HT8PdTni)YjnbS;|jn%s%o=asx4sm3i3=)vi4 zsYO2S)UnONrq5EV*6stl$V&9o{+SBl&mf^mAgq0{;;X zWi1#X`$Wo=p6P;jE4hMTUF}3Z&tp=U{wOATk1UeFfQ?YeM{IC>fX38-S5~-4`gVTY z9;VdM{y3pDpsSjK=gCY=%oV-1Qb-ad15R|A{;@#cI2hBlEsVzdeBAlc9i!{d+B&lk zw@bX{Wz5QI{We{3y^zl7;5q6tjyR5dka!?>ToOVVg%Xd;mnV+TG%8h8u+U-U*OIAf$4U-eTJ&g}MyD*Bytl8wGwNx|=DBASe4=I9iRCd5RhZYvWLBF+JIZMG|ED$_;(CDfknfq8BLPIi zM5)d5622|n<3G3%I#U&hP!~28R`zO_15n>s0K)j{)IGm<4K!4Jt?yjyc^kw^2uzz0 z6n+16m0?b9W$ibw(e{aKi#KIyuX(Ojz5r+FqN8rDsVBSzuzQ7n0}uOyfrFbYHqr~V zs88AoeE`RTc5;Jab0_|( zya50apeFV}5c_s`l84J!4=wvhFUr&{Y*I zanGYE4?j(iRD?2eT4WL&h{)D3ggj%pJ~?D2nl;5Y3K59zwTmuqzGYPe^U+WqI2wPo zx@_aa`K7J8s^dg=gr+B+{l1hgSF#Z;Z%I=FO((03N?o!HgVuF&8hZ6}X+E>5o6{-ec>}87ghx zdUdg5qXC0qroSa{cTFm;GT68@p$djIO=0U5 zqgW9)c9-~bBJwpyIOG1iD356hiDsy<15ENSPb zI|G4&nv9czI(*0>(gOCM%@(wZ${^0~SVLEcq#JJe?wsg=yKa;2V9SM+B>~-hQ?g1X z&rPc4c2*;wlh~skgxmtn%{?HiqkHm~c!pd7-YJiusd!ZB*Qc_tsw}!;0bNWrM$TEf zJ^4VRUW7~Ye2q{YFKgH)rqBQdqCs$vUWa=+Oj#>dYjyaoEzq$&A+P($T^_W}y@G-O zx^(*X`{(a@KKTvID+n=3xsMN~TdGZ&L9PRJhLE-dgsdZk;)YJR)d6$;!>#479lwxVuC&+$g=6F(J9}%-nzzfe@f>z>&~alnQCR{B3R}fEe>g6=Qa;_GMWISQ;512 zpB`{9@jZ#Mi<&a^wX%qebjDh1D*8}2+uyE^Nw^wFQPUSVIAOE|V^)awOYd2fKSULc zi;m3cTYk1gB2vXS>N3?AMv|CdRXN7@Zl19gt;Z8g1^`4HbBj^YQF(ac$r*#(Ghx$U z-YCN;{4_OSs~I_Y5v0(TSFS`b3Z=Tx?N9m6fb2(KM3CmwlBdnKwrX& zWhxp?&xrQ3F_WrEZpTGOBxt3`f{;lkr>Q2#KGE&Nrfk--WS?WH$_pxutj9|+&BzAl z6-9G^j<-$*Aj&q;=Y~8!u?&Emuqiz|!crj+Jg~1@SAmtzmy0g0NOX^Dt{FZ2AU)*7-Mw(D7DB zbE9}cTlc7(`jZO`iBB~nYzLgpBqvQX| z$lbJ~H={WUsZdK7u-?BS>3z1m9+*6I(dKjJ(B_9?02c!#5<81u71Hac~x8< z99y6=@|oK>fCltAu@itQzbJt)4PSv=>t6!Dt4{*r#h^n-;v`jWV<1BeO+nfq-o=^k zrJ=ej%6hR~xxCRQX+5=5w)>IR`dCYR&>?9ZFmSh&`Yy@O7wTm-Di3JFS1r6OrB~cqm zW?&j)j?F6-ceVB(9T+LgpFH1N5F&?Zyd2_a$H-D617{~Y%au(|c)}kxz&mKLY#wqW zRx6*5U*gB|)COm@_>Wz)y07iYf5GEi%jv6H^Ut;MER^|U*psKz;gYVMTYS8mW(`*} zQ^nxzHxZZDLARzod*-Im$%XA6e&~*Sa0hl@stQ)Kr4W_L zOb@Szdz@}qL_z_Z7n_Dcr{*8++8-^)Ue88t5GKM>iIU|-ZiTKA7}3vBTCeD>o#`Vwr%gWZQJhNZQHhO z+qP}nwyoRu{ zSIbT}R=816RYw#m#kb;3wJ_0(&{^1H#FdZH)|&Gf7k+P$^@@!rgNdq8lsQ-1hBwV3 zk;1NeENleD3th+3yn5$q%$SJ4-&wewgWq|7_L)e$D$$yl_a~ImG4*?bDPO7$gDc+) zn5};9IsNgojR}pHz2)^td_slVW9nq%0B8$}mr1M|gQ0R`xDkuQ(-6K8vM#n%CQK?S zV!a-`Rb8^$+ocnsh)u)?AYQ0SHmMx7Rl`eop~-HSAGKRNJDp$TlO7jGe)B_8xJR(& z@w}%-_oqkZemj?gTnh^yF6mT%-1tWyE^T^T=9T4&d`F~AhS8icE^fr8=N62m011|r z`LErnO@~tZvf=Y*k&XA_*TT|-DqWV^#kR$;BARU?zx{G(6LZJ$o`#Mt$kk}|XHX>R z0GV`QRQp#KgqV8WfpgZH7z1WJlR|#~j(Q5Rl;m!ILfww-I+W*G(}QUZ5RUaB$jmcp zKP_-{;qTD+>jMqeBugFFx+Y197ud&J$Sids+U386r9@U8R}=%?tez)h{VyT&8g-M# zEh25CN{(I)s8`b3XX1AtTKAtzkWKf#x-+drgsmvB>8`K3%b8y>TETnkIhyGPkK6sd zYd~|k=I(J5U*=)2Vetcn%=hDaeWbCRnT%zK`8>j+L9(%pfQ2HcS9uYcbxEkH5(!B! z!KA{*GER0$WmiY5Jr*_E3dP%4J~NUYqE37d9-OD>-v3n?_m+d$mI<$NSf1^ie`N)z zQ8dT1gn-t@$+VG7#sC zFh<>pc7(NH`}jlBS#lIq&qhcMhF(hBwAf0Y}K0blz_n4>B0(U9&*cqRyV zw>AaSAwDfltU?86kpr6AJBICpf%>VE&SALpLf3)I7z@Usup!{lyXkAn6ZETD1 zZ0oVU;Y%T*PC%b7rIpuA6P-lws^ppllp&uJ=KSU}E z!0(0u)-7eA$SKOt~H>a!*f(b}|o9=47q@Vq?DhZZTUq0qvf zg{*s1CdC}^N-?q{gz#>2hQ-G_pnzKWN~3_ zyY(`KVbBo}TZn#VNgT2od8vPequYhQgT%I2S+O1TNl;F>Emx+jpFntH$vB==Z`?n> zx~akJY5l(TRMn@af6Yfo*@^Fpu-6duVf#ViAvGJIB)ssgSWaR+-G`e&-SJDByRKkc zGxhku=L=S={{}rvw+Ql6pn_hj_2RevT=l&R1_-#s&CXX-G!iu#bMUX%r3(hu^0JtS z=}(cvOhqY=8jCbPyIF_=wsLQm$l5P^2_*mbR1wa;P1yN}f9!!`wIECEg8+8Xw$<@f z45_JS75DkjIR2PF`<=EI)E$=xFy1tDMbIt+~Vz~mADnK15xubb0!@}6};n! z*Z@_mh(A7+WY&x_ZL(to7L$D3X-UDe6A$e?k8)#?v&lBE4dIT*D=ie6Yp0n|3SiBX zS$$Enq77`07v$4)ui?Y31Z1jRO;P%zUhQQ*ESrIK!wdJ^2&wiUOGyTDNo=^v!jI|% z4vW&vYX5vza@WqUU;$ajKvVpeSu>4(5iwIFS!~pauE85~OWh_FZ_gV?w<#NXm7lec4j0_c2ULgRt~cg-`(yFVSjO`V0>vnRWeeK=v= zN%H%=EN^7uSs5QPgn1(Kk{&?WwX9Q4S!KS(-3xa!RJzz}OX1{ud^WtmN`DE#t(Nuq z%75#7CzfVpf(;1~hLq+$JFx0UYfE31gy!^b>1UeLL{^Dcuo^fa&^V`cScAeysGAKH zc&BV*auaS-{HP&uC!+^O#al8H+SnYn%n1120kB(xeYCE*LnSkyFRNqED>P$qnm-{M zDeyb3TV-<;fX8+fl;SxGEFg-NAvhQ4jkRpaT$3_?Sj;l{X>yRr;Ot*is918R#zGLQ zY16zF`n6rrvg#v1vF-aqL)>NI@$TJmXd+NHw{1faN3*&ioGOe3sz#(J z+N5NJg#Iz&53jXgmj6ir*36PTsbIX$JQ7-pP?9{0^dpkjuIUaB__Gom{`Wc*m$v7Th_}rCE z{n5a0`ZRjG8P7h+L)hM$ZEW*aZicgEKo-qYK4YHsPd`5yL1>?tX8a)vZ~8u`iJgu+ zQdn1WO}IPPNdi9473c)vJs-C=bJ!zhwr?p?>ZtcR`WTP4u=uF7fn6XC*VkYqR@@p} z%hDLMHohiff%qX2oQy4QI2`Hxsb0R`){Jxf1vyRHvnhm|EWI8_5BN^hyRUn zK5i{aEDgD$70WdPF?Z=;?g)8CO_&4yhiJg{`m#js@vG`j9(Ij*2u8G5M#1vYZA(N0 zYFH(X^hN6sGOwBo&O;|A>t`4wb=d}@lI>0Bi{_r(w7f{Zsb#*ZrgLpoE4PCMT|u_V zz!Gd6w;wLR*Vaf|5X?XTd}X49?2@f^k#Fn{)PLMUcKyY~|EqC)STuMIkaFPtk|*=ePbi@iab3deXWx1q%_UAl+2{!tu*zR*pxIipuIh^|3dvn8X1 z1Z3so)5OHY6QV=J(|yGJ6|)oaIFlqJvcE!vV#K(DBJ$?_g9P#?qJts|zRp5`-1J); zND)byFl6@|MVYW0pDL5d@12^NoayPA80&?qzvlX01ovHb{B`>tFnXB0=nTHSPfR0E z1I@R(wvgD0S)|QlEzYgYEy_NxKFM_Q8=4B5I+{8PIvfPPba0Pu`0BocA)J^xNJ^yB z7^S;AYC2l1)@@esC=kH~;Q}VL-n&#B`yF%By!2QW{L+0mf5gnP7C7qiH0$%q%J^|D z{|&gT@KPZ5X#Ws5u{gRow}}6hGEXOEE$Hz1_oD>cy+6czg;xKSoIOlCGGxG$6XJjf zrwRx6Vp2V|nPK{H3&3#m5<&=|0p7gu-xkMzBys<*-zp~h|FIgh%wf6ph6g4u>#S&}AXm0ktbGcs`VzV^QTB?5qkd5D9$@sD9OXP(F`PCeM@@V$|>%ViAvI z2#XziG*#Ig1bP{-1J+9c2<0TQ$y|fNS#W3G#kH}P%sCwc!Ik7cOL;XtgLyC`iN&4p z(86+;@gJCB1ywVkA*Us>8yTlTF~9G$Ftbfpy<1~buvTuy`q?7bO1ajNQj>InrvQd@ zuC={Sq)C!m$~fzYr)q5u7$8()=L`ofsLB><5gAV?fcn!+1cv3}Q`e(t>IhH;3ckt3 z{zSUi>iV^Fh&J3s+$){{I)UDFGzJ)__;>?Scg2hSx4QoatN#CZ43(Af@Bcu?{=W(6 z2}kQb0`#5G6>|P%?%OT+jL7hEY5Dks-~ww!zC|8IOk2_o=~(f+ z0vL?Q!hj&`qA{+Y)3)3YHa#~#KJm!W_KzR894F&ThyQALZX9ZMZoao>kVp+5%|H{z z9yeOeUz%wwvUR)cJ~W|@J-+WHu&r7z?9sUP-NX0X)6d=q$kE2^xf#+w4Zco)SoIh2 z(4kF^g+8ZWb4IvscDSzHa>92^f~5^2O&G%}JyUsqhTI-b=(Mup(^3KkzMe*I_Nvzm8XFbTdh7*V zUS7KGiJv_vyw=rBXCtNJ8sYYcM?Yeqgr!bG-UU}0pS^G8la(nMB8T18$(;zVXe>J8J1fE%(J!W|^ZLz6}$ zq=bpk;3aX4v;9j=Vs}3~rNd487Q^!(`oJ?}9PyOY!r7pwwfhXd`$F3GO#C>F-LdT1 z9tp=gk=5e5TQ8LRF;39U{zNKqAJ3;Smc8`aXJ)1L#j!mf^OE)cSPUxJc^?3cmkw5t zmGkne`P0qm^tRX|bHLqjh~e(O(m+Amlrte6!bw@vVV`MsO$G~=;Df~dd$}M@wT{_) z?WRw+_0hHn8pk33S**Cc&yWxwlHSn&s0+~Zbtj*gk~=;G$QiASO30tpsz33J1{$gs$LhFmj$+I zzJ0np+iY2NQy4|i%!}k0@b+@eG|M7aBY~DHgbFy|13tqqH~ahB9!J?5ZGw3Hylm|X zaabSIoQ=pf6QP67gKHBT)sgfe(@JXLkH^hT9JXEuS&P+9)m1R8tPJG1>0gYL+OFp3 zCv$@Um1S=~f0qQa1P;u(NMt4bMKJ)7xgWbHuu|&g;I@tlNV5@|(Rr|V$yF#o@S)c_ z_(<`t0WLWeO@~kC^Uosv#TXT5Fl!2z+H1~iIq(w;2u6gQlrypJ4BtLDmvSfi=Iy|~ z7t_l`IvKaiN!AXFB)RK)qs@lIb89Ry>Ps&qBR}CDhE6U0~YLeJupF2g;9!m+auGubiWByEanV^ED71Bg?k#d%B*}=;yC&ar&k2!1xk; z2??5M2*svNAv0KM&@Qlr9X*}fvRkNz90aN0mq0e{9V{5)0VkVkLW}Dc5lQ3El_i#9E_a&yN6NjTdbYvt z*th{0g?$$A@@(FOxz8{A%{S=SbCCUgD2dh-B;Dnsg2|Wd4`##uAf)@U0*9klGezZz z25b7Py8JAy0(lZ7qNr-YLh4`;Aw1F;gCc8K(eUsCUcuC8O$D731jJ(l9ZhxhJTlOkeMDoUzq zFQ=1@=J&|MJ9FAsqt|b!Wqj zhM}`E@z=Xx;5(b#r)crekW{MmxYn&7GRHZV?17neG&mb12o#1bGlRg}0)nb(~nQ8?b2vhf;m2`RDY6V>D8w@Q1c-Y{oQ?Thl%lFgX< zS?5P^vdboVtywGB93W2ps8GC)>f&?s%$A4)GVuIfy@}KTQz_n8#`_8F?sZD{Rlw8|#C@H9V3H z6zLNpoj|bn7O$sJuYs?&5A5mU^Czo7aLLqiXO_NPkc+wU5N9R9aQ0t6v=OSK%RmIJ zqMoM?f7649a~XCNZ{OOtmsI>=3v297N7lmh=oR%CR~?HdN~0oF>U;inWj=4-o1V%i z=6L89FL1An3C(Pow8gZk+BybtARSY8EfbQk39y$&UqVS<>R&-!1OEe`Siw7nqVdvE@HN+K6h zxaB_YO~Zm}>$C5jsQ4{RIWlft@R;T$sj~g-ubcl}_ixT~O$^Ice}+pJoICNMVH|9t zSaxoJ9eLJ#jVxFyrv+u9=!>NrT@^^MyEsFud+_Gf^@d=vw`rhD2Ps1yZF;LWnl(dSWvGLZ!X0@G zLb=ITx&{wH4dWLM2UrZR%w)A^OaZKmG$X`fIFH}X#aAX$D6vRd2bxKs z4~i$rrCL;7%w^FM>;kIyMUQ?u_0@{QCg)MT^Vm#{ET5G9q4X1}R^HlJNI*3#T6q`9LWt}(3+1a&IX>HUHkc;QOib9Fe^YuVGY(VYo2UnbmSwS6co zyjzlnzqhwEb2?U46fIm&t*V6_m8NVW|mHkaUD3mErXPCjHSnK78K<iDqqm6`|zi4IL=^YBJvL-wsK2IH^08>&jYT+Ot zpfc#EYh6}EG?UgOVaBOQ^Kx$vC6OSHE(69X1GFJF3}2Q-R96dvi9QBG*R%SsU9Zg? z(u6Z~e@(Z_)M+Vd?Ko6kk#4}?TkrACMQ?N zECWsfiq6-CdE%nz;f_Z(hz_2&igilu2@W$ zJJ42`<|^s5=UUXRNmoo@HSRB49*H?JqYH~1dA>fg_#TGvZ>S{xMu?fe0o%;Ur01(?Xdfrro(XFM!lN^}m=JauX>~1ZM&BUK%NvK^G z8+X+EZ3UjTCY+56Pd3wWlcOJ}X3)4Zc{lNqz@L0W9V_I@O>NW>QLqyOYtjcq`3GV% zTm1}e*ao#euameFil^{)ZmFT+yux(M6fn{n)ON%`sVL$rp@FxEKmVSE1uHT4v%1zk z3x+Bg!nnMI%TQ0OB=`00QVXrk@^ZK3EJ|4y(cuJHG9xdxmG{zk>!i|lMuj|R^S#j2 zukGN-QHn}bB?VgS3TQj?CWZ;zB2D&l7?A&PI>Q#HFTx6!orlJHaP8#N&NM+?rNK*1 z>M}U&jVFEdkmU`p>eUA5l)OOaf#mkSE}JR6^*J)5xrne7dk4uI6HetWXj(q!zoTl} zjYK=Vjnsu_1gf2iGl%(;x~XbF?NI!kG@oQ3)ku1Oo$o|FCFJ=ylx?|YuGSV7NLQ&I zUxaMyLFWCqT@-eq--?G#z5p*4m+hzKi0B3!_j~OYX^jJ_6e!AIL7edw4CRW5;J2Yy zVlHTE1=|yMFdD>e-a}A?3E!N0)Sw;CJJ}(@ebNX;GN3fD%hLg6c6v4({Uu99N zH+agYm?gKxvpzr_L=mf-MR+A`C8Spv0fiok&S5*g8dP?sI8=PI1SCFRiZzf!-G`Xo zrIC|@W8;?HwZ?wGt630K@aKq2xz&8EjdiwjV>UhiY~%Z5WAhOX6jC>I`kG+@`trg& zcoI^wOM%SDFENW`UEL)}=+nEFHt#FqCSB<)J47ndVOqbLRvnQUfVO^x0~#?6D<^)+ zq5_eYU4BePLVOT%5UPk@=PRsPT$SV@15dn0$-c#%Ikk0E?p^4{XG(SFgu;S>R2Cf_ zBYFE4{G9k%gmrx7CS&m47{Lu$9zGYr8(ZnEZsc?ii#} zi@;GEHWtb3#6cH*;s7r?E|p}lfgB5NVC*L#kP&RynnoL@0_IK*?Q5@ip#QuJ4ZJAgB$y|VQ=^FS*C0B{PlTW-Xn^XDC~*Cs)fR|$FE=Z$+J#*K z*sWvYHrwZpmUgm^^7)=tK@l=byYB_M%DFwCJS-rah+f63X$adft#KPMtq-h5q<^?& z(-V%iY80Sz7EG>x?Kli1BZ+txHeSMR1mp88Us{tirWicl5Kbj4`k_ zKxzdgCv@OkHPy=zuL8~yO!K}@tt?;OV*DG702faX>w`WvlY)}NKTZH*4fci%&rpl5sn5~A zxaAK#$KT+sz)H?;N4(midDkgw*XWtc-7g#!A5c}eB~)JKPl+mobZ6ZQq?yZzAlaA? zj0!COID)G8r}=?bjk%rMk7KJ>uQ?5r;&fsRy|3-?Ru7LO@y<51x)f@91ynHjdrBt} ztX9fZ%^~*aTH891ur3oM*~7}@Wc-RscQ%z4ZLFG{uqOCznq6V(h+$V0l`*-dnP~G@ zf;#aZz0lOP zQ2#Lh;be*SbNro+S-^J3744~-*^YQ3I9oN(HIY3mL`wR^}agV}>S>`w{XNxD{0q^WC5CX(E2 z^yGy9NoRptG^0|m1kz+Y^wp?nPvJ~F=bNxgT}_FtPY5y+`$ghH1%HoQ(AeTm3fWBh z!7QAbn#@|DKGMA(vkElo-1h-Oa#(R6gZ3ZpVhc!iGp+ivsU=|YCh0&zB%W}+d?S39 zENu^*GqI|duCZi2V03K$&F@#OmE>VmO4Mm~Tm^eJOsHTP@+U5$$EoiMxpi_x9HTT(K5&~Pfh*}^qWjy2M>=mE*A(kYLbHwqa$6ya~k56KQHeg;f7l^0UaF?y2+ zHI(||Vc-ix^?n#VaCFjZi`AOuKKBFmxCB6EQO70}mxPE1-^Pk~&mRcEyQE`GQ66lc z-onh>S zU<3JTYYZ-3B=S%N6n@0&3i`&66IQy_qe>pQZOBYYQStP)Kbe3PMRh-iW>-=3zg(!O zVE+AvtLUvmj?f56se9~`k4v~#1_)`MwHNDG({EZwB<_K?w}N=ZoROG#2qzddJJc3b zmrTJLJ1gnc5sCe+)ArQ1yGP5S#gb-6wIemniyquR{nn}`a3T{y9VTNT?_*sjUgUpU=B*8NaNfx*!c@ZGW`= z(6JH1b8LH;?%PSTsc6{Hpz;EcBo#VOStOE-5LAuv}|ua*F1d4;eWO zo?s34O1tKCIbZI{IWwVWJ+B&><*^RA*Fv=fWG`J5fYxMBHm>-1#W~csZCt0q$s!Td zdu1OAbv~-x0uw4PE)Ms{bSRiMs~mnXWzf=ExNUAKE^Ke_bNgKM+b(d8XOMJUw{2sD zHF~iLI(OI*7|Vi3#l>rTqVdD0gd)X3VpY+bV2FV;)^ z!zjg{N{|5DnQX9!h!=4O8?-Jqi$H8V4B2WptSba4Yfj#-?LHJK)Lkq&GI3wReOEQ| zInwecvUgaw-3Qw7NSdUH8&CI3mcWPN5(4q)b402oGBvuxZO%A(A}}-4=C7{%na)SH zxAVctsa@cR33EcBv?B@`@bZ|ar8VQh#Km6lmye#tdW_exkGg6UkY#+zcCTNF)dxSX1uB0 z^oMgoE(bECDA9&l%NXlCXF)Yf`%YK-#?T+zZNohZSppejTWTxQ>aLH9e3OXBjqWM^C~b?nJPi!ZA^yF!wIDwur3+YTj(8fjtx5iQ%XAmC8s&F^D&pAEw!u>o1*R0<%bqmT z!8V;!s#(DqHO$KBNzJ5ID1VUXU`TWD!E&qGn%fLU2!xMrQdO^Ik))V?N)L%OYy*$t z+evNLho%pqy+uGF2pcwuYowWO=_!gXi=fUJIEh6y#nCO>wr=z4CY9c2mq}^IVg0)X zKOM$OW~sVPdoILzUozvS(4h0&1Vckye6YLv<4VjL_{78zQ!cfD@lXfjrMN*#@;WNsfb-w>0h!@ILv@|d2;CO$ z2^j<25N-ev2v5(8d&?`D@UBH_Y^7m0_^CO&#HB&q%0+^SFevO2wM5NVB(W#`GEPsW zld0C8u*no48HjW@Z+)*uYiFU`P1M#VkJXT zV6|?XT8mZ1u@k=CsoY8*3x8rpwP(VLQ>xd|fCh2(OXB(~bD1tOhx0+niONBqwd@iN zG;LKsJJgPRp0u}ge{!73BL2v;3fmMV>029JxG$lG($*KWl_saSX4N#MqP|AU<%&6+v z(oQ&XASjF>jVwE`MX@=m_z2*qB##Ey%~u{O`sZ;PT`w7{JPzVcg0f_6y@X}EDaI+s zddZ*9f6^5!kOJ0`+?pg3vFgcqpzHbdrkhDoBA^=hAsFTUO(mbVi$M2Eg;+G<6kSYU zTXJmj46|SFyM{RR|FPdZ9a2UbCVV;kfg`}rboph(Ht3AOkQs5BUjm28uJCz2)t+y^ToznKD?1g$75lR^#^&;1YBuNth(s zd-))_-Fy?DVg;=Fq#KZ3HW_r%r_0MJjx?3`zkz*nB9aqFcpf)T!p}nnoWCQ*-EJ+W z&jex5Gcw|-p+tMYFN1NRf<_QE_?HfDEi_ZncYlTJ&;_U3)H~|dU_F9bZe|ObXIQF8jLLeGbB1m1xilQ6tz1gc0$=tmWl3m5cQ=kL7Qd z6BpCx;9k-#eV6sIN#3@X?~~6R_8ph$H*rGxSbT9t%c%`c#DkWpC`qx%opvYw%9E`L zx7N^)72boOO(}m5|HEwP-9e!1I=;IvS~s)agg^Yl!4Fh^B_7Lo16&sgpZB3Apa^2| zj@`|qf1TwWEie1o+V*o9iL~>>(-ZEs7X6DPQzj!c(6Kt0&r!_N8Hq^LQIldT;|s+T zls^Skl=8WLnYK>!|EBH3B#P8ffAbDf(6Xqx;b~NhYdo!Wlyrh65SvJ@_|h3!X;{vc z+oVvM7}V2ISs-}a?`1Q!%17mkC<+h{%giM(V$|4jHpPe+(gcj*`9nj`grMuvLy4B* zEy7g8oCe+ZSqy*?WQpOi!lVbW22Fkk+$B22Es2_uY!Em@Tf))+|A_yApSdM188bdy z^Bn<72lhrO1e=EWlzVNo6&sZ&3)uIkJd@*~QbX4IOJk|wE~XaBo`{e)U2#~WRp~n+ zkQHeR4+=(-tAEELK?E3P1W#QFF2@%3Tz~=Ocmlalah_~sB(_ipI~3>Vx9u`SXzL(s z9dB_W!^Ev5$%^efmY3=kPN~3GJPD!FoTc$CN4lukz^?tK-y{wgXZMYl!cC1hUfOTz zDthg2@(j4NpLrW6>oq(U2zovel4Me({y;0VEDvi2=)g-;Zd*Wdjkk3eB@aj@I1s5A zCHASnh}sJo)HSNZtMuTvs*mgIp8F&J5S$L8?Ub$4(hSL(2;iOV{iU_rd}54tLzMu~#ohG)4uwZFhY!gbmGcvZ1@YGF z5(6p6#5$R3srLtID*;A$e<@Le0bvIIXQ9 zj~tyl2uL+*s9qDFf|E0cC*p?jEOw`uyU;n&MUWM}ig!sp3r`1~1MactVB>(kPH!)w z5^SKv`o52x(T8UD9$`#PvP!}Z_LNcrO4;1Q!5O&A@?`XMDS{k3OdaY`z%Ys5rt~j> zHbDGAb9b?!YQ8?1_Z0}&%^CX&>a85%%vMW;S6|fqn$^>=iElcEf#U8^kkyCBUw&fP zBOiWORM^hCcU%upnYEbbGpb(-m4rtqYK(j{?dglFo+3qOf&W_P$E387_rudwU9(dg z7jM#heU`A~O0_23!J3!BAMSI~o5*|~+yR}$(Z}Xq)6+0FU<=zn*}=k}l%M~8jmEs% z-3O0m zTGhP&ndRMlJLiGQLW!PNQH>Z_w4|rHGDgk4dKTOYVFuPzLm^hZjyKt0!esRG{*@pY zs0%mhBilWd=Q#0$AlYW~H8Km;Vb~wnHERk++(78BbLJdBJ*DH-g8fsq=lc{>f<-rP zo_Z1zYuy$^RDydu-d)0Llf~X2z-ZiA(*f^nIRdbq@1~re$ zx;)h&*@SSneH7Ub??s(h!Lf#HM(c#;9 z@7UPod|q_bX?8aB*RS5GHs@)C{8zs*{aN#Q z5X1u{xB4pnYS$BM^Txphn-Lm*7(WdqSC%1R8e#i4EboDDfZ52xCTKZeS#0ki<$B@V{K9 zu3nDbA@_6A6;)OjZ!my$sv$cZdq3;r7<16bVGep(0u8u$URn+Je2AT{@b_wPHl%-g za=YUf4|Z%jFaz`vXEQ540mVcJko*mUY5@tq<2##%J=@>+%ep%|?Iz#j>QHJ3D(&)- ztfVva>R!QbJ`2Bq>aw1o?$f-8kn4mio7@6*@(UMfq#DxKvhmK-5}pcKFIo9xo{bmM zh=c2s7Cc{qBGDD_#)heDY@I$`jN|_I*L=c)reZ_JF1Fs3>5N68{MY7)@GT%~?ia#@ zE&;FP5)fTb0Y!z*l_NsQZ2g<|+ z5LD@kRurkGtB@VpuF)Aq%&)gomlAbX)*8+A?6cSmRW)a3OLJfE_5mkI`TY&OQO44z zq@psiJh;f@bs`q+r;<1GEw$}(#EM)2ZDk&rBa|09PdfFX2HQm@%;b-#VBy3kC_^G$ z`{B{x@@6T9n9^DaZFD4ri-UbAN)(F<$XETEFfC_w@3$0-oJb8yOGZ1|M5WV2;fm$c zaKGq~0UByuGLeP6FhOylJA-B0y`PSS*-G_5Vg_@pPpfJ=cU$3 z+KDG{p2C-6=B*HzgVe^jnXf;zcL14{+;fKU?7g6mHpBH|rlN4JDF5D8!8&mSkK15C zJwhMdFLG}YJq@Ya2`*pM-C14JoD~LMb*c(sIPmLn*87%4Wm|<2@F3VSMw~{Bs33m> z;LZR2<(b$)bW1p%ubaPk2Zb>5ttPe@fTfPy-C@N{&x7ELF#-A{aYV%qf?5(ieejN= z8H~t>x~!Bh+Od?wIMBx#TPUO=$m~h&FCK3G1ng>h< zbg!o?zQvc7Z~k#~Ti1k_F*7vG@j4*Ww;4h9!^``QKG|(^t+Q>R(++*!SLDO}0FcHT zS_q2Y9OHm_Hky5?N|i3j7LEua%#1OyRkyBxitfz`w1e;KmOsd~1*c6QRdVvL>qmJb z1=62cNGHn(B-cnenr5c?jy}F3QL)-C}^l|VK zifEM9(gJ>WNLUux3vlAU{>^XRH}?ZO%InKKnDYTn*wml$us?7^A-CptuK z!g>%Ny7K{r$68q#9+o>#Oj$*q$ms*}1Mp8Kav7k|D1pyTuZYJfAW@8|WsLbk7N;rF z?98cC41~yq)ZkE!JP|aTx+o>=@VTQA$+XW zzB`dPO}<^x?W_+gaW)t0NBlp4xjP;sBttMVbi;73v2`(K^ct*vXX}q3XDjgDb|NXh zaqYBMjm6zj5uQ?uTh%!D8moDX`Hd1o+}ABVa`Lq=m-$L0)iNQI|M^5J)?c% zk|P#6`UM6$I{OKl5~^{rX(G89u>~c%hDQ1YIXVWq8YSCtF{&{s*)hc{X|hq_F=;XY zJ3D0G+gMr|NfIRHUknlw5S91$qoX7Du(l!hH{mnqbPmX)Uvdp3f7wu(uyGj$r1hH{ z38Z&eTNxz0=mkId$>*m3eEcFI$j)ctVm?=H1A3A#tdWVHfsqm9$%nT^-%Hp7#t+k? z?n(R4Bf-N{2WnI0=;igP%=LLh`ZK3`eo0=5t@_LTb#@Uq6I=I(r!4%{M%LWQ zX4c$R=JE#5l}oXZtd;EE{k1VZ$^zT#dC8A$_WhPO$HvXL_@!vuv@PDz9{a!m)yR-S z+RVV4VLCX#a)L+Ie|u#A;Z^@%FK{LX=KnOOYsdY6c4Xm~?{M|va!MTtVnl)ROnd?s zufRj#Q11WFj!gafv5uQAjAjyj#d$Cx)m!0J)DGb<%M^-9X2wYZ6Fsm69!Ry#F_e#P zL{@Bk(vxq)4E0(!cOxAG@4002Y3q4BqKMq1HEo>eKbVYsqE0k8(Y?O%z^1QT=IqO5 z3eY!(icQ8eaIOri>S=F^_j|@%gi%4$`AB%Leu8^0B?VWPf3-(YM+_L0X9bcjupYgq zr^ct7@Xw3?xy}z%sIGdohMq`>N(#<{Np2a`oVXZlfJtWBpS%xtJz$IC+R$^8?sS%7 zQB-9j@j8Fv+|M$UnZ&^hg^QLnVC-p){NbYeNofs1vQKSYX;`%vL8Vrt4AX|%ti&xq zbTPC<`r`X?)gt2zib=cR@1XAS24tsCQ~Gc9{|`3N|FJEZk(u>>*u$+M%u!Tu;v(wm2rzO+b z8>lR4O(KkpO=>lzq})K#(dF>f3DHW+NX0`W4|;%ietj-eqrJMiz5UKkK@^SM*%9)q zWm1c$qLLlxD1gN6zZ&I9(W>p|5GRQ1+&xZCPwOD0B-aU0OKaWKX~kwyOCkz^GX>65 z>-+09s1YLtjub(FFlDMvj`G>16DyJ?LiP_r2$Y2$oS$FSLTW~U81S#sQo~C2BGnmD zqaf`mfI(+OObr|x${Iq|4y_`}PyuWNS`9br5vZX*b2P(53_9y^*1f@^N3$Df)**Oe zS-Zq?dj5u=X&tfcAD$@PRN8h+O_Gj>-i%ru*2s1amu{wd)-wLR@I?^akKkIgIeE~` zwtC#=YdQWI4yyc3pR%9Pv-M|6UHV>nIUV|Y z=>Adg*Yp1Gx>rbu0K&w~QlfcosFE4KEDZb3)7b!VK_%@VxRX$vYM3p-mzeYpk ze&nNP-i#_>Xo$&9`5+{*QeohY0tdL`-lvkUh7qfF; zAsJO`W~H(wlE(A_O3H}I)e4Cay;al6ITY1$e&9kx3D|{8a)OX}cL}JYqo$|i@0JY_ zedtN~_RZtKdvbVtG6C$Yv{d}4J?jwYabD7<^M5d+6>VM5(vmU>O4&MzweI#5Cz%Uh zHgjCe9$Q~0XW*f6#SwT&O}uNtFK~Hz-ni~yU*mXIKd#{4;@)k?z%wK@psw<jQr{h7|e#n6% zLRPW_tUZ0A)!)aPc}n2AwfbMxP8Gn@Te-UrFVnJ)vDVMp>M9*2D0n>sMyYPjeqYMn zxQ&psy_im6gyTEh?~Zb^_^R}p>Uh_K^>=0@7eW4W>zt<`hjL&`L6Fks4BCV5^@qhp zeAWg;vibauh*nsw0=$7Xo{^XH;Xrarz-s_WBI{E+3C6;rm6P!p1sBy1m(1b&FUsb0 zaw>${T^REUD*l7Ub)^Zd%IdLVHY94M<w-ydUrM=Lfzma9a7@fjNRxm&M`zyuNY% zuRh25NP8v84wC`w|F$i$M>bOoaRqdPFRFZca%InW3V{{CmZTdu3i7EFzTBv`Kgok% zPAQI|yccSh*feA`!ql2D4dz`0Kt)5@D&|V~{w9_uo*Ov7C5~okPx%%rR0WKK;26#h zv&ZIbgA>ZL70O=3@CTI3ct4KLEgFVhLMb9#UrH1=HUd%>KkWcAmCz~L0NmNUAN)Gx z3BuFgV>$w)20fhp5U}CM)_bY= zTj}>y_`^Eiuoyyb#ssZ;bs^;mCAN?j>@!=!L=+YZZQKn%j9C_o&@I}Vw^|BJ7EHl+ zZRYhA1{obJt#8B?MgF_gw1nRuxR_0LdeIOP+V{!RrOE0m>$vx{a7RZMb8B zy-+|!u%Hi3fN08{>JjYzU3ck$6V=lXBAH9Qhi-MjcTrgl%SRi?)~Ntu7m# zqWjrT!>YNpaweRrGMR7-&G-?4A({7aRO9ZkW70zIUujVETx%a_FUC1OXiZLPuX$x! zb}sn?)5;|)B+N)kC6|iMESg96eIq@_{Qu5_=5O|{5Zq|GLwy1*UFP2(o`E;mkv2Xo z_DGfX2j+Bz0?|E3+47O6{y3Mzv@+a3i6-RC%~oGZpPe^!O-UD&pNUqHQz`Qir0HtT z7A{z5KE5Rr|3f1#JUl6CBE>-hI_n}abygw(_dR0+W;t2| zDYj*o1Y>IGj<1?nG_iOT=(peVX$(koGnZR&dco4dyx2>EZ-Y;!)@C)pBfAdMWH%Ag znCJFl8|Xj*tylbdT&ZH`Zjww~MN?9xXk(qH77lZQ=#f_(D0yi|*bXm1j-X$L4r;N5 z;hLZ+AS9O79AknVhQZg7aK*50@eI!+iN^6&LtZT9vx(yu9W7rgwX>xG5U}}OZzqLn zFA1N)cZbAf!by2BfKxl#F68x5o}fs-*7aj2CB7`i% z)#>`a*%rLDhpc&9;_mVLlaEe|{-^J0B2jig8571I@)~+`htz_molIwNQvcwi7MwX( z>9JGLhU^gTeeo!NC(*e)7@7F#nr7{65MGVf)fah zOE>NsEO;PDaCd1eNPu*LOG5{Oy9b9ra19dN34!3+cyOD3@16SUy>st3Ggb3%{_Q&5 z)m_he);{Oi&)I8jSYSeUC1{^M-kWv9nu4;BUb8}DRcum_-w%u6L&9|WG;463U&)T% zD*w!hbI@{)Iv}ZLvaMZ@4{+nda&Jin=6(3#ubJ!m}}J>2NS?k9oSzF5yL@$SnS6`-lNYXU@nVQW5O$d&7#*FiRnFm> z#J8tNl`R^A=T&-wkI&)9XK5&KxXsg)-)@Qes~b=S-r*3awh?OieqxUHf6aR+#}ieW%&sD#@XttNDx(f&E0x zW;h|r-i%#9rryr(fdOs(DHn6|FLvhU8yRL=hVaxZ?Ytb=mr`?k2Zzdhb8B<+(v{EY zM)1^(&&4b0uM=Tu>90{YHh}2cY<5M-dK~ui)^Ir4>)rj7l$3qeEsFh3%ECp5Js{jJ z*&2vmNKs7jsjvvxw7LBWc*VL^#3A#m5-T_3%nMIdO(&Wx@Jv@H`ZQ$JvL00|Av-h@ z220=b>^>J8WxmiV??2>1=x=Y){&(d4Uo_$`-H=DC zwrv|+%{!!#e6A;zE3=2`#0JT}lTpTx)=LCJ(H?_Y6eSVnYQe!{7odu(NE*73V1Fcc z`Rwy0Mtx35a{IMu5;u|D4fs@>0ex2Q2)zZ6qP7Lj9nrn3O#5hu*!(%OKm(*bgu8lU zUz?ukwv0YubH&6{lttMY6Y?Mo{?MbnK%dQgu}l8eMM=b@T!`sl?H2(X_z4yJ4=_*5 zZuq@c&%%q^1NGrs%4*0=9rC6Js=>iZ&}<0fD}Df)78`44mh z$TNq@@Xm8q@l}*`>9vc_e}e08lKTI5>f%Dqa89QGNnNBe-1_nGwqfi48|r>qGNWb) zwt1lUltEH=t+f@&+}6H6PJJ%ZR=Kz;$STpc!<22{*qeb1agV3}O5O4%9xvY1fqzmL z1!i^j@3{aA{p~iQ=kIRAt7++|3vuDqU=-lv<5hC-^nx(*BQ3m&mwhF9Ij)ed6M2o@0fm&RY4iBrmy63Km*S*{zN9nsX0friHDDzTg&cNGA2^?fSw zdtuOe%Cvj2y6Z)W>UXEByB{2;* zRNgc+2yT@M20CV__Oz(h3zK9MSqwowrVMR+0CTmz>gS3!nP)OYTioO?IR=y*BS*V( zh|PJnxCs!`qr#I)fQcLj<+#<+MBF81qF*e|`C`{5r^v<`B|G(T&}8@t zSPOGha%JD5o8*DT)UFipJ|pO!R?AqO4%zR7J&7t};#b>LW-8#ss@g*#r>9b79moER zs-@f2EozOEV$I66x&su%Opphw&lV)m=Cg(>gmCO677%5QW2Ino6QI@e_cF%R=6qsN z<9b8XOKc8|Wt$%FpG3*i&!JROE~n{v5`rFyA3g=PbwJ<2P@s7x`kZK+8mIQj&+ou$ zEj0Ihi&8==4Xy+#hc$3WT21GeJANaS2}PK&NI71cp7y;QxRW0Tpw1Y`*zf5c<7X=> z@|>T5<{7Fdm#A4+S27phv{toVcnGGt_UFPv2f+IZ?SgK`>Ej|9S*JlonGrEXj`4*q zR8~OTver0L4r(hF%6Ml1d^&c$Gkluy`?#S8SR!|mhRvch^j-spnP#-t0XQQPC5Dki zi-MYv=TVJihx#3xp(jy<}dc_`}asIf-9qX`NOIPZb+GuB>07-kp^G5k}(}SUxs>E#v_NU z$o!pqCsu9<=9XnbQy5!Zm;Zoi2<45O49O&lu6vx8fIE>g@e04SdHRY1 zhWub?l1&6#JutJ+q&w2?qbFZH4gnR8>q#Z~d0kGrECBBiXh{}(oRCAFd3G!u2B<)3 z1hk_@vA+hE>maS(dlm3p1_n{7DO8?hD=^2%=Y90jbGAV4V#!81q*i<-o5YoXg(#NE zMSRIC7A&;IVF4a6s-O{(?#l!Ck!F19_}z4Za(yx}+`}nS{L3K}sG=BB-NhfItahK; zaLST1_wm{Us)C?RCk5fP^`YW4s=MxVBIc#IjDa*|FZuJZ)k3G==M<*_yl|cjY6dB+t0nAy%`<@$xD5dj*M*r^__I4BT+{=orf9FmT$9!qP2J_+Dbp zJDjV+r=wwSUxmo*I^sCSJz=8Gv6gM)EKRXG$G`?xB?E9t^eWJ~dEd*tl+RKB*jcO@ z#Gce+8nJ{ocrrdwcBUcRhm-C+_+0YqAQ=nP5vM(lO5LM(r^XeM39*4?&XIU)>Q zms@s>uaiY{95uiwh#xdxbAyVmKdo9F823boMhhFyco^UHOFK%a_Y4Vc*MVOHREshV z4f~5aV4gN_b_{!jjEJs6>>vJTe*?5e_o|zJpM<-A!9bbDZ82B0`D0NzG#Io?l|InSRt%53ah{$ zd4lf03h<1;1hIjW64c8_#h1vWYgJBlnori#DCK04@>j-hU!HwDVnZt9pFpOpjDpxf zejt4}ToSnk^v7$=@wQa!PKYNw?=!WMpk@>*dbgh1I0zpQsR}`J_$%h7zhc&zRs}jc z6->{N=)JKgWU8hPBYUGWM4h|qHS_125=b)$sOx2>|f)RZ6XE3Ag9 zrlIk~X&PNRCyqF|iMF}n9zRpRFGfx6srf&T!A;;ov=-FPkPPFaO^$+>?=tkwhCs4$ zGn9iPCwJPnO$REPu0}IBt%^$tUTF#KZ5w}H>ILXht_SW(q#%zPZJ8ckLhHY5sv;S zKO--*b8gsAOIxZGBI7VdJ+)&HeziZb1)jxfRH_BUK)V?geN;~kh~9WMLt=sqoN?eX z)SAa{azQjV)yZw3L3o4XDK7OK&1TocOl!{A69$THWV#^^>b>}qX zl#MJKr05ZpNK^ zxLl}$!(^4=Q*`1Vp>mGQRBs7NY4@m_!y9hd5q?I083#ixWKu0nq##dFd&*g%)R+aC z4uM~-kvtrWn2=Pp!39tmbLS>-sFx(K?4t&u$o{12x3ixtF2{xR1bmR_mw)k3Qhyyx zPE4Vq%t8LRA#z$8ko5e~s_|FUxoX!~KxXhCABbvmcAbb~ZYV;z^|TCz@z+mRaRDL* z++Cx5otuhKPUr_-+mC!mbUMq8a6Y_DJVj=p^dEDGIr6g4}Y>4TCV^)VGv89szkcps8 zW!g2dkgi{tMzl^d%*S~OGC7T$bP1mnUtEwRQ~2AMBIEqQ%)9iujYIjL|5?ihu~;m6 zMcko1GW8)GyJ2#MWSSPu)1IPzXtInd&EiWtAT7;64G1mLZy1vnM8D*ow-9TbN`3rldbI;;caai&)1tK@?X ze|7>B4EIL7Tjncg4btomqHVovBs)-io5-+CXn_wE)!n8x@w4Um(LFvvn>`b^o7WSI zQ$!y7B7Y>+*D8~qo(XjD?J`~@7@Wr$50>;@k&c3&XjEB zRwnOk@&~gYi=h%b@dY*(zN4>iGA^Z(f6!E+jWz)Y1J~DI#b=dy3^9z4(fWD@iFpCClYFt5qb9KaCf(qBl9UyGQTlS5 z&cuc0qsq22$yn2t$1WE|d^J~FG5vKQqJhEiR`uDWxSPqtv<5xk>*z|Kq`&qgwH^5? zZpXs+r;+W1^xicLJ{efdYqYhrazO0#s%YlQ(DahnGk#e}Jx3a$T8umDKS7O_HD7!Ic+M`ttpV zA%4-H-ON|)G^Ia-O(0r(0%)~$w?md0dk;UFM8P00vxs1VTNflmKVve`Nni=6`!&tk z9xgNgXAIv(y>2SGf9?UeP%WKOGoSgXR0Ai)sem?zcvD67<9sX3O%IXVJTa?-zWbU9 zQV+hMQ5Z_On^C>0wO=9s1xAeq1UfPd3@sy@RTswV9rYALF8k8oH~<-%I6pc0UV|;K z=|A|`O_6de*&%B7tJb>Jm>PzrKl1NT{-&ezF5g?6*RC$6bo&aCu|p5|dUNgU-z4U^ zdQ+c&ZR1}b)ELmjY{_y7d+?Cg$EC}aOUMO&wYHoYE-iI)If5l@nnRS? zJmX3@_rr^;Y26KnskreggHLDK)tyF*L~x_xry9h~R>B1VkSFFw>o%>kOY^lDFHu!C zU3NWzoo3^~uGftNYfDhANKt=y0iT3wyX^j>lak=vj-jxu^r{?20A1CRX;%H8^r668 z+>a72jRy0Jtheiy4K8zFyoHrpN+;}&E4ji#4Q11aSP&Ktvl*SeTGKoqcZCR7pu8j%#Rkb5oovjj`drsYxQ)N z(x}%Y2IaZs=kqgpM~>fo&(Fo<&7@lKyfx7u=ck&Nr}pY3T*O~2X2sW_bv$3+OVqrY zj|sd>{)OCR9*ZaUX4fBD2i}ALlzgvoXPsKi*1=7IM>c2mG&>|dhrpp3;G-*C5guKsmDq_Be zzf)H<%UN6K+fDarGo;Tx7-+OJVQpb9d@foyADk$Z0^9n5J>jb@$#bCeKy>F74HQ>cSfjV?TMVU1 zws{)3-NyZH{w`F{i|?8iUU=7bbnc{wi9QmARDX~9_fCkQ@ZY*p|Jn%=`k#Fe@Lz-f zt_uPZ{g=%M4T)-+J$wM@(Or~en3kbtUNdNl)+A~KZ zblMdmE8{xxY%V{1eCyuOa3<_58Q`<+Obx0Cnb0Ws8LDM+=Y>#Q);2ViotyB;&DkoA zH13&~{$5QgK$+cSgWYr|GIM5B)eZD!MksUhliK&-haypf`4OknNVcBfX6bo#tYV2{ z&_xNo!CTjtn+6bmadD?;wLqy(a5h6?)+kqrNbk~H^}?jc&aIdE;=fX}M(`w;xr;HL z^yC({cxjQ;F=x-_1ll$_WmSshhG;N~vUuRbtmhs$rZ7HK!cJq;P~~g)?N#M&?Z-zs zm|JIvpuwc-Cn&sp{Wv5V+E$^gPrp-#D&f@@<;8v`mHcQfQxH3Zjkv@-?=|tT!AhowTi$sd}|DcSYv3s(Y7m z6{k`AP;x02Td_v^7{!a*-b>lKPFimE3PXCuiQF^21BJgs^zJ{U`fu)o|48*~9UEI- z9XB^*uM4?%ONUp*)z*#iFFqiL3dRzmAQ3*K7onxF6~Cacg{`Q72nZwywzd%kfvtpv zz&29<=Wo2>)pdAlgDWU3#A{&8&j?}^c=Nv@6F*o~izq3Lv&sW8QTKnIC`lrE{@r?- zn&49O==wA}^Ebw!jqjNMB}d_OIFZq6yV!U78C7!KeZRmbs-JYC@>UdWew@5*PwU^R zOIavKoag<13zWw3d8Q{*9bqdhi!n#+G0%Osgjy2ua*d~joWrvzqTe;#(ObDUe(A}K z=!*iXbj+FJ7G)0~;pv2PX4d&Ot^DFhxb-FZARX~LA89?g5M`8rknA%Gy|uZuPy|!S z#%mbk1>f|L98AXiOQaDCmBSQEXpednI2K;HQu83g4{g|29b~0L zTWI8!5qeg^H7Z^p7#Wsv~19c>+!ur`9;R*KTD^865( zq@tq^m~XdLnL7%Ng#b|c@+3qN#_SCYmKidJ#RL07UrI+#7s62{5#(Q9u;W+iZBKQF(Bg}t!MS?q5A}8p?1d!9 zL(8cnz^=|kYuFZ?V|>{jMgcDym%UUl(kYWS$l#oeBEhA*s8e=Q6@lDyGrItZ$46|V z>I3-K7@dx>w zB(=Yc4Tjr`FkK8^7XJw$JyEbmDP+qS7-8mzFT1DxbRt&U)n!R#Mq>|Jtv_HBh?peO z5WYS1fIqlfwv$q;M}8n>;1Pfd07jvi%<}9W?zYR6)JoL&cBU}{?n7E4YL1aHIr#6B zjO1Ce1W-pW&|xsRpU7^$f|9mU_n;%2K$-yN=r>boV+80& z+ffuyTsKQ%?N5>d8KxL`Q&L3dMoSR|a?-E;vbQ6?34d&vr>0;hIwSW;xuwe2RT zy`3jhW&Wi~qgbSqxbpFyQ6N@;#K@64Ht2}Z~30pBMRSiZ_FZ3RWro# z)ntJA!(X|B5Qr>ImC$sMGD~VLg{!MPjF-LCz3OLaV@NIi;iW7y9y`qn#m_fE#5SbA zif0rlbcK5Eojwnc4Cyy9AX<0}o!@VFXl-x~`S^W`j^@fogi$)$4SA}j={L7&MwLaI zzG14WTqzG&`Ebusn^>D7z1xj<#MmB{MOYQrfwT{mZpFNabQ0WTY<=!SWF{|)UiCq; z+=)GWwV^?iu@ufl|J%~HhGu>QA>_lBK6q#`weTK6d?67KGh(Y*vpt{gOdk;0Hbij@ z`aDS9iMmWvIh1FW!u|cGj>(z*E0=L-#cj6j0JWPB~n3rQoU))%kpG}D5{5Jt8QX_@^97F#>MeX%6L%WA`T z+o05Q%R?Wpmm_pehcaH2spTC>g1?D{YPWWSumYe + + + + +Argument Lists (GCL TK Manual) + + + + + + + + + + + + + + + + + +

+

+Next: , Previous: , Up: General   [Contents]

+
+
+

1.5 Argument Lists

+ +

1.5.1 Widget Functions

+ +

The rule is that the first argument for a widget function is a keyword, +called the option. The pattern of the remaining arguments depends +completely +on the option argument. Thus +

+
+
(.hello option ?arg1? ?arg2? ...)
+
+ +

One option which is permitted for every widget function is +:configure. The argument pattern following it is the same +keyword/value pair list which is used in widget creation. For a +button widget, the other valid options are :deactivate, +:flash, and :invoke. To find these, since +.hello was constructed with the button constructor, you +should see See button. +The argument pattern for other options depends completely on the option +and the widget function. +For example if .scrollbar is a scroll bar window, then the option +:set must be followed by 4 numeric arguments, which indicate how +the scrollbar should be displayed, see See scrollbar. +

+
+
(.scrollbar :set a1 a2 a3 a4)
+
+ +

If on the other hand .scale is a scale (see scale), then we have +

+
+
(.scale :set a1 )
+
+

only one numeric argument should be supplied, in order to position the +scale. +

+

1.5.2 Widget Constructor Argument Lists

+ +

These are +

+
+
(widget-constructor pathname :keyword1 value1 :keyword2 value2 ...)
+
+ +

to create the widget whose name is pathname. The possible keywords +allowed are specified in the corresponding section of See Widgets. +

+

1.5.3 Concatenation Using ‘:’ in Argument List

+ +

What has been said so far about arguments is not quite true. A +special string concatenation construction is allowed in argument lists +for widgets, widget constructors and control functions. +

+

First we introduce the function tk-conc which takes an arbitrary +number of arguments, which may be symbols, strings or numbers, and +concatenates these into a string. The print names of symbols are +converted to lower case, and package names are ignored. +

+
+
(tk-conc "a" 1 :b 'cd "e") ==> "a1bcde"
+
+ +

One could use tk-conc to construct arguments for widget +functions. But even though tk-conc has been made quite +efficient, it still would involve the creation of a string. The +: construct avoids this. In a call to a widget function, +a widget constructor, or a control function you may remove the call to +tk-conc and place : in between each of its arguments. +Those functions are able to understand this and treat the extra +arguments as if they were glued together in one string, but without +the extra cost of actually forming that string. +

+
+
(tk-conc a b c .. w) <==> a : b : c : ... w
+(setq i 10)
+(.hello :configure :text i : " pies")
+(.hello :configure :text (tk-conc i  " pies"))
+(.hello :configure :text (format nil "~a pies" i))
+
+ +

The last three examples would all result in the text string being +"10 pies", but the first method is the most efficient. +That call will be made with no string or cons creation. The +GC Monitor example, is written in such a way that there is no +creation of cons or string types during normal operation. +This is particularly useful in that case, since one is trying to +monitor usage of conses by other programs, not its own usage. +

+
+
+

+Next: , Previous: , Up: General   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/Common-Features-of-Widgets.html b/info/gcl-tk/Common-Features-of-Widgets.html new file mode 100644 index 0000000..78119c0 --- /dev/null +++ b/info/gcl-tk/Common-Features-of-Widgets.html @@ -0,0 +1,151 @@ + + + + + +Common Features of Widgets (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: General   [Contents]

+
+
+

1.3 Common Features of Widgets

+ +

A widget is a lisp symbol which has a function binding. The +first argument is always a keyword and is called the option. +The argument pattern for the remaining arguments depends on the +option. The most common option is :configure in +which case the remaining arguments are alternating keyword/value +pairs, with the same keywords being permitted as at the creation +of the widget. +

+

A widget is created by means of a widget constructor, of +which there are currently 15, each of them appearing as the title of a +section in Widgets. They live in the "TK" package, and for +the moment we will assume we have switched to this package. Thus for +example button is such a widget constructor function. Of course +this is lisp, and you can make your own widget constructors, but when +you do so it is a good idea to follow the standard argument patterns +that are outlined in this section. +

+
+
(button '.hello)
+==> .HELLO
+
+

creates a widget whose name is .hello. There is a parent child +hierarchy among widgets which is implicit in the name used for the +widget. This is much like the pathname structure on a Unix or Dos +file system, except that '.' is used as the separator rather +than a / or \. For this reason the widget instances +are sometimes referred to as pathnames. A child of the +parent widget .hello might be called .hello.joe, and +a child of this last might be .hello.joe.bar. The parent of +everyone is called . . Multiple top level windows are created +using the toplevel command (see toplevel). +

+

The widget constructor functions take keyword and value pairs, which +allow you to specify attributes at the time of creation: +

+
+
(button '.hello :text "Hello World" :width 20)
+==>.HELLO
+
+

indicating that we want the text in the button window to be +Hello World and the width of the window to be 20 characters +wide. Other types of windows allow specification in centimeters +2c, or in inches (2i) or in millimeters 2m +or in pixels 2. But text windows usually have their +dimensions specified as multiples of a character width and height. +This latter concept is called a grid. +

+

Once the window has been created, if you want to change the +text you do NOT do: +

+
(button '.hello :text "Bye World" :width 20)
+
+

This would be in error, because the window .hello already exists. +You would either have to first call +

+
+
(destroy '.hello)
+
+ +

But usually you just want to change an attribute. .hello is +actually a function, as we mentioned earlier, and it is this function +that you use: +

+
+
(.hello :configure :text "Bye World")
+
+ +

This would simply change the text, and not change where the window had +been placed on the screen (if it had), or how it had been packed +into the window hierarchy. Here the argument :configure is +called an option, and it specifies which types of keywords can +follow it. For example +

+
+
(.hello :flash)
+
+

is also valid, but in this case the :text keyword is not permitted +after flash. If it were, then it would mean something else besides +what it means in the above. For example one might have defined +

+
+
(.hello :flash :text "PUSH ME")
+
+

so here the same keyword :text would mean something else, eg +to flash a subliminal message on the screen. +

+

We often refer to calls to the widget functions +as messages. One reason for this is that they actually turn into +messages to the graphics process gcltksrv. To actually see these +messages you can do +

+
(debugging t).
+
+ +
+
+

+Next: , Previous: , Up: General   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/Control.html b/info/gcl-tk/Control.html new file mode 100644 index 0000000..fbc853c --- /dev/null +++ b/info/gcl-tk/Control.html @@ -0,0 +1,105 @@ + + + + + +Control (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: Top   [Contents]

+
+
+

3 Control

+ + + + + + + + + + + + + + + + + + + + + + + + + + + +
• after   +
• bind   +
• destroy   +
• tk-dialog   +
• exit   +
• focus   +
• grab   +
• tk-listbox-single-select   +
• lower   +
• tk-menu-bar   +
• option   +
• options   +
• pack-old   +
• pack   +
• place   +
• raise   +
• selection   +
• send   +
• tk   +
• tkerror   +
• tkvars   +
• tkwait   +
• update   +
• winfo   +
• wm   +
+ + + + + + diff --git a/info/gcl-tk/General.html b/info/gcl-tk/General.html new file mode 100644 index 0000000..f33e98d --- /dev/null +++ b/info/gcl-tk/General.html @@ -0,0 +1,71 @@ + + + + + +General (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents]

+
+
+

1 General

+ + + + + + + + + + +
• Introduction   +
• Getting Started   +
• Common Features of Widgets   +
• Return Values   +
• Argument Lists   +
• Lisp Functions Invoked from Graphics   +
• Linked Variables   +
• tkconnect   +
+ + + + + + diff --git a/info/gcl-tk/Getting-Started.html b/info/gcl-tk/Getting-Started.html new file mode 100644 index 0000000..67a0ba3 --- /dev/null +++ b/info/gcl-tk/Getting-Started.html @@ -0,0 +1,84 @@ + + + + + +Getting Started (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: General   [Contents]

+
+
+

1.2 Getting Started

+ +

Once GCL has been properly installed you should be able to do the +following simple example: +

+
+
(in-package "TK")
+(tkconnect)
+(button '.hello :text "Hello World" :command '(print "hi"))
+==>.HELLO
+(pack '.hello)
+
+

We first switched to the "TK" package, so that functions like button +and pack would be found. +After doing the tkconnect, a window should appear on your screen, see See tkconnect. +The invocation of the function button creates a new function +called .hello which is a widget function. It is then +made visible in the window by using the pack function. +

+

You may now click on the little window, and you should see the command +executed in your lisp. Thus "hi" should be printed in the lisp +window. This will happen whether or not you have a job running in +the lisp, that is lisp will be interrupted and your command will run, +and then return the control to your program. +

+

The function button is called a widget constructor, and the +function .hello is called a widget. If you have managed to +accomplish the above, then GCL is probably installed correctly, and you +can graduate to the next section! If you dont like reading but prefer +to look at demos and code, then you should look in the demos directory, +where you will find a number of examples. A monitor for the garbage +collector (mkgcmonitor), a demonstration of canvas widgets (mkitems), +a sample listbox with scrolling (mklistbox). +

+ + + + + diff --git a/info/gcl-tk/Introduction.html b/info/gcl-tk/Introduction.html new file mode 100644 index 0000000..93ad017 --- /dev/null +++ b/info/gcl-tk/Introduction.html @@ -0,0 +1,79 @@ + + + + + +Introduction (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: General   [Contents]

+
+
+

1.1 Introduction

+ +

GCL-TK is a windowing interface for GNU Common Lisp. It provides the +functionality of the TK widget set, which in turn implements a widget +set which has the look and feel of Motif. +

+

The interface allows the user to draw graphics, get input from menus, +make regions mouse sensitive, and bind lisp commands to regions. It +communicates over a socket with a gcltksrv process, which speaks to the +display via the TK library. The displaying process may run on +a machine which is closer to the display, and so involves less +communication. It also may remain active even though the lisp is +involved in a separate user computation. The display server can, however, +interrupt the lisp at will, to inquire about variables and run +commands. +

+

The user may also interface with existing TCL/TK programs, +binding some buttons, or tracking some objects. +

+

The size of the program is moderate. In its current form it adds only +about 45K bytes to the lisp image, and the gcltksrv program uses shared +libraries, and is on the order of 150Kbytes on a sparc. +

+

This chapter describes some of the common features of the command +structure of widgets, and of control functions. The actual functions +for construction of windows +are discussed in Widgets, and more general functions +for making them appear, lowering them, querying about them in Control. +

+ + + + + diff --git a/info/gcl-tk/Linked-Variables.html b/info/gcl-tk/Linked-Variables.html new file mode 100644 index 0000000..7ce3dfd --- /dev/null +++ b/info/gcl-tk/Linked-Variables.html @@ -0,0 +1,149 @@ + + + + + +Linked Variables (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: General   [Contents]

+
+
+

1.7 Linked Variables

+ +

It is possible to link lisp variables to TK variables. In general +when the TK variable is changed, by for instance clicking on a +radiobutton, the linked lisp variable will be changed. Conversely +changing the lisp variable will be noticed by the TK graphics side, if +one does the assignment in lisp using setk instead of +setq. +

+
+
(button '.hello :textvariable '*message* :text "hi there")
+(pack '.hello)
+
+ +

This causes linking of the global variable *message* in lisp +to a corresponding variable in TK. Moreover the message that is in +the button .hello will be whatever the value of this global +variable is (so long as the TK side is notified of the change!). +

+

Thus if one does +

+
+
(setk *message* "good bye")
+
+ +

then the button will change to have good bye as its text. +The lisp macro setk expands into +

+
+
(prog1 (setf *message* "good bye") (notice-text-variables))
+
+ +

which does the assignment, and then goes thru the linked variables +checking for those that have changed, and updating the TK side should +there be any. Thus if you have a more complex program which might +have done the assignment of your global variable, you may include +the call to notice-text-variables at the end, to assure that +the graphics side knows about the changes. +

+

A variable which is linked using the keyword :textvariable is +always a variable containing a string. +

+

However it is possible to have other types of variables. +

+
+
(checkbutton '.checkbutton1 :text "A button" :variable '(boolean *joe*))
+(checkbutton '.checkbutton2 :text "A button" :variable '*joe*)
+(checkbutton '.checkbutton3 :text "Debugging" :variable '(t *debug*)
+              :onvalue 100 :offvalue -1)
+
+ +

The first two examples are the same in that the default variable type +for a checkbutton is boolean. Notice that the specification of a +variable type is by (type variable). The types which are +permissible are those which have coercion-fucntions, See Return Values. In the first example a variable *joe* will be linked, and +its default initial value will be set to nil, since the default initial +state of the check button is off, and the default off value is nil. +Actually on the TK side, the corresponding boolean values are "1" +and "0", but the boolean type makes these become t +and nil. +

+

In the third example the variable *debug* may have any lisp value (here +type is t). The initial value will be made to be -1, +since the checkbutton is off. Clicking on .checkbutton3 will +result in the value of *debug* being changed to 100, and the light +in the button will be toggled to on, See checkbutton. You may +set the variable to be another value besides 100. +

+

You may also call +

+
+
(link-text-variable '*joe* 'boolean)
+
+ +

to cause the linking of a variable named *joe*. This is done +automatically +whenever the variable is specified after one of the keys +

+
+
:variable   :textvariable.
+
+ +

Just as one must be cautious about using global variables in lisp, one +must be cautious in making such linked variables. In particular note +that the TK side, uses variables for various purposes. If you make a +checkbutton with pathname .a.b.c then unless you specify a +:variable option, the variable c will become associated to +the TK value of the checkbutton. We do NOT link this variable by +default, feeling that one might inadvertently alter global variables, +and that they would not typically use the lisp convention of being of +the form *c*. You must specify the :variable option, or +call link-variable. +

+ +
+
+

+Next: , Previous: , Up: General   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/Lisp-Functions-Invoked-from-Graphics.html b/info/gcl-tk/Lisp-Functions-Invoked-from-Graphics.html new file mode 100644 index 0000000..5647c6d --- /dev/null +++ b/info/gcl-tk/Lisp-Functions-Invoked-from-Graphics.html @@ -0,0 +1,200 @@ + + + + + +Lisp Functions Invoked from Graphics (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: General   [Contents]

+
+
+

1.6 Lisp Functions Invoked from Graphics

+ + +

It is possible to make certain areas of a window mouse sensitive, +or to run commands on reception of certain events such as keystrokes, +while the focus is in a certain window. This is done by having +a lisp function invoked or some lisp form evaluated. We shall +refer to such a lisp function or form as a command. +

+

For example +

+
+
(button '.button :text "Hello" :command '(print "hi"))
+(button '.jim :text "Call Jim" :command 'call-jim)
+
+ +

In the first case when the window .button is clicked on, the +word "hi" will be printed in the lisp to standard output. In the +second case call-jim will be funcalled with no arguments. +

+

A command must be one of the following three types. What happens +depends on which type it is: +

+
+
‘function’
+

If the value satisfies functionp then it will be called with +a number of arguments which is dependent on the way it was bound, +to graphics. +

+
‘string’
+

If the command is a string, then it is passed directly to TCL/TK +for evaluation on that side. Lisp will not be required for the +evaluation when the command is invoked. +

+
‘lisp form’
+

Any other lisp object is regarded as a lisp form to be eval’d, and +this will be done when the command is invoked. +

+
+ +

The following keywords accept as their value a command: +

+
+
   :command
+   :yscroll    :yscrollcommand
+   :xscroll    :xscrollcommand
+   :scrollcommand
+   :bind
+
+ +

and in addition bind takes a command as its third argument, +see See bind. +

+

Below we give three different examples using the 3 possibilities for +a command: functionp, string, and lisp form. They all accomplish +exactly the same thing. +For given a frame .frame we could construct a listbox +in it as: +

+
+
(listbox '.frame.listbox :yscroll 'joe)
+
+ +

Then whenever the listbox view position changes, or text is inserted, +so that something changes, the function joe will be invoked with 4 +arguments giving the totalsize of the text, maximum number of units +the window can display, the index of the top unit, and finally the +index of the bottom unit. What these arguments are is specific +to the widget listbox and is documented See listbox. +

+

joe might be used to do anything, but a common usage is to have +joe alter the position of some other window, such as a scroll +bar window. Indeed if .scrollbar is a scrollbar then +the function +

+
+
(defun joe (a b c d)
+  (.scrollbar :set a b c d))
+
+ +

would look after sizing the scrollbar appropriately for the percentage +of the window visible, and positioning it. +

+

A second method of accomplishing this identical, using a string (the +second type of command), +

+ +
+
(listbox '.frame.listbox :yscroll ".scrollbar set")
+
+ +

and this will not involve a call back to lisp. It uses the fact that +the TK graphics side understands the window name .scrollbar and +that it takes the option set. Note that it does not get +the : before the keyword in this case. +

+

In the case of a command which is a lisp form but is not installed +via bind or :bind, then the form will be installed as +

+
+
#'(lambda (&rest *arglist*) lisp-form)
+
+ +

where the lisp-form might wish to access the elements of the special +variable *arglist*. Most often this list will be empty, but for +example if the command was setup for .scale which is a scale, +then the command will be supplied one argument which is the new numeric +value which is the scale position. A third way of accomplishing the +scrollbar setting using a lisp form is: +

+
+
(listbox '.frame.listbox :yscroll '(apply '.scrollbar :set *arglist*))
+
+ +

The bind command and :bind keyword, have an additional +wrinkle, see See bind. These are associated to an event in a +particular window, and the lisp function or form to be evaled must have +access to that information. For example the x y position, the window +name, the key pressed, etc. This is done via percent symbols which +are specified, see See bind. +

+
+
(bind "Entry" "<Control-KeyPress>" '(emacs-move  %W %A ))
+
+ +

will cause the function emacs-move to be be invoked whenever a control +key is pressed (unless there are more key specific or window specific +bindings of said key). It will be invoked with two arguments, the +first %W indicating the window in which it was invoked, and the second +being a string which is the ascii keysym which was pressed at the same +time as the control key. +

+

These percent constructs are only permitted in commands which are +invoked via bind or :bind. The lisp form which is passed +as the command, is searched for the percent constructs, and then a +function +

+
+
#'(lambda (%W %A) (emacs-move %W %A))
+
+ +

will be invoked with two arguments, which will be supplied by the +TK graphics server, at the time the command is invoked. The +*arglist* construct is not available for these commands. +

+
+
+

+Next: , Previous: , Up: General   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/Return-Values.html b/info/gcl-tk/Return-Values.html new file mode 100644 index 0000000..2a120f2 --- /dev/null +++ b/info/gcl-tk/Return-Values.html @@ -0,0 +1,166 @@ + + + + + +Return Values (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: General   [Contents]

+
+
+

1.4 Return Values

+ +

1.4.1 Widget Constructor Return Values

+ +

On successful completion, the widget constructor functions return the +symbol passed in as the first argument. It will now have a functional +binding. It is an error to pass in a symbol which already corresponds +to a widget, without first calling the destroy command. On failure, +an error is signalled. +

+

1.4.2 Widget Return Values

+ +

The widget functions themselves, do not normally return any value. +Indeed the lisp process does not wait for them to return, but merely +dispatches the commands, such as to change the text in themselves. +Sometimes however you either wish to wait, in order to synchronize, or +you wish to see if your command fails or succeeds. You request values +by passing the keyword :return and a value indicating the type. +

+
+
(.hello :configure :text "Bye World" :return 'string)
+==> "" 
+==> T
+
+

the empty string is returned as first value, and the second value +T indicates that the new text value was successfully set. LISP +will not continue until the tkclsrv process indicates back that the +function call has succeeded. While waiting of course LISP will continue +to process other graphics events which arrive, since otherwise a +deadlock would arise: the user for instance might click on a mouse, just after +we had decided to wait for a return value from the .hello function. +More generally a user program may be running in GCL and be interrupted +to receive and act on communications from the gcltksrv +process. If an error occurred then the second return value of the +lisp function will be NIL. In this case the first value, the string +is usually an informative message about the type of error. +

+

A special variable tk::*break-on-errors* which if not +nil, requests that that LISP signal an error when a message +is received indicating a function failed. Whenever a command fails, +whether a return value was requested or not, gcltksrv returns a +message indicating failure. The default is to not go into the +debugger. When debugging your windows it may be convenient however to +set this variable to T to track down incorrect messages. +

+

The gcltksrv process always returns strings as values. +If :return type is specified, then conversion to type +is accomplished by calling +

+
+
(coerce-result return-string type)
+
+ +

Here type must be a symbol with a coercion-functions +property. +The builtin return types which may be requested are: +

+
+
T
+

in which case +the string passed back from the gcltksrv process, will be read by the +lisp reader. +

+
number
+

the string is converted to a number using the current *read-base* +

+
list-strings
+
+
+
(coerce-result "a b {c d} e" 'list-strings)
+==> ("a" "b" "c d" "e")
+
+
+
boolean
+

(coerce-result "1" ’boolean) +==> T +(coerce-result "0" ’boolean) +==> NIL +

+
+ +

The above symbols are in the TK or LISP package. +It would be possible to add new types just as the :return t +is done: +

+
+
(setf (get 't 'coercion-functions)
+      (cons #'(lambda (x) (our-read-from-string x 0))
+	    #'(lambda (x) (format nil "~s" x))))
+
+ +

The coercion-functions property of a symbol, is a cons whose +car is the coercion form from a string to some possibly different +lisp object, and whose cdr is a function which builds a string +to send to the graphics server. Often the two functions are inverse +functions one of the other up to equal. +

+

1.4.3 Control Function Return Values

+ +

The control functions (see Control) do not return a value +or wait unless requested to do so, using the :return keyword. +The types and method of specification are the same as for the +Widget Functions in the previous section. +

+
+
(winfo :width '.hello :return 'number)
+==> 120
+
+

indicates that the .hello button is actually 120 pixels +wide. +

+
+
+

+Next: , Previous: , Up: General   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/Widgets.html b/info/gcl-tk/Widgets.html new file mode 100644 index 0000000..27d512e --- /dev/null +++ b/info/gcl-tk/Widgets.html @@ -0,0 +1,85 @@ + + + + + +Widgets (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Top   [Contents]

+
+
+

2 Widgets

+ + + + + + + + + + + + + + + + + +
• button   +
• listbox   +
• scale   +
• canvas   +
• menu   +
• scrollbar   +
• checkbutton   +
• menubutton   +
• text   +
• entry   +
• message   +
• frame   +
• label   +
• radiobutton   +
• toplevel   +
+ + + + + + diff --git a/info/gcl-tk/after.html b/info/gcl-tk/after.html new file mode 100644 index 0000000..b73f646 --- /dev/null +++ b/info/gcl-tk/after.html @@ -0,0 +1,82 @@ + + + + + +after (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.1 after

+ +

after - Execute a command after a time delay +

Synopsis

+

after ms ?arg1 arg2 arg3 ...? +

+

Description

+ +

This command is used to delay execution of the program or to execute +a command in background after a delay. The ms argument gives +a time in milliseconds. +If ms is the only argument to after +then the command sleeps for ms milliseconds and returns. +While the command is sleeping the application does not respond to +X events and other events. +

+

If additional arguments are +present after ms, then a Tcl command is formed by concatenating +all the additional arguments in the same fashion as the concat +command. After returns immediately but arranges for the command +to be executed ms milliseconds later in background. +The command will be executed at global level (outside the context +of any Tcl procedure). +If an error occurs while executing the delayed command then the +tkerror mechanism is used to report the error. +

+

The after command always returns an empty string. +

+

See tkerror. +

+

Keywords

+

delay, sleep, time +

+ + + + diff --git a/info/gcl-tk/bind.html b/info/gcl-tk/bind.html new file mode 100644 index 0000000..e6c2218 --- /dev/null +++ b/info/gcl-tk/bind.html @@ -0,0 +1,475 @@ + + + + + +bind (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.2 bind

+ +

bind \- Arrange for X events to invoke Tcl commands +

Synopsis

+

bind windowSpec
+
bind windowSpec sequence
+
bind windowSpec sequence command
+bind windowSpec sequence +command +

+

Description

+ +

If all three arguments are specified, bind will +arrange for command (a Tcl +command) to be executed whenever the sequence of events given +by sequence occurs in the window(s) identified by windowSpec. +If command is prefixed with a “+”, then it is appended to +any existing binding for sequence; otherwise command replaces +the existing binding, if any. If command +is an empty string then the current binding for sequence +is destroyed, leaving sequence unbound. In all of the cases +where a command argument is provided, bind returns +an empty string. +

+

If sequence is specified without a command, then the +command currently bound to sequence is returned, or +an empty string if there is no binding for sequence. If +neither sequence nor command is specified, then the +return value is a list whose elements are all the sequences +for which there exist bindings for windowSpec. +

+

The windowSpec argument selects which window(s) the binding +applies to. +It may have one of three forms. +If windowSpec is the path name for a window, then the binding +applies to that particular window. +If windowSpec is the name of a class of widgets, then the +binding applies to all widgets in that class. +Lastly, windowSpec may have the value all, in which case +the binding applies to all windows in the application. +

+

The sequence argument specifies a sequence of one or more +event patterns, with optional white space between the patterns. Each +event pattern may +take either of two forms. In the simplest case it is a single +printing ASCII character, such as a or [. The character +may not be a space character or the character <. This form of +pattern matches a KeyPress event for the particular +character. The second form of pattern is longer but more general. +It has the following syntax: +

+
+
<modifier-modifier-type-detail>
+
+ +

The entire event pattern is surrounded by angle brackets. +Inside the angle brackets are zero or more modifiers, an event +type, and an extra piece of information (detail) identifying +a particular button or keysym. Any of the fields may be omitted, +as long as at least one of type and detail is present. +The fields must be separated by white space or dashes. +

+ +

Modifiers may consist of any of the values in the following list: +

+
+
Control                  Any                            
+Shift                    Double                         
+Lock                     Triple                         
+Button1, B1              Mod1, M1, Meta, M              
+Button2, B2              Mod2, M2, Alt                  
+Button3, B3              Mod3, M3                       
+Button4, B4              Mod4, M4                       
+Button5, B5              Mod5, M5                       
+
+ +

Where more than one value is listed, separated by commas, the values +are equivalent. All of the modifiers except Any, +Double, and Triple have +the obvious X meanings. For example, Button1 requires that +button 1 be depressed when the event occurs. Under normal conditions +the button and modifier state at the time of the event must +match exactly those specified in the bind command. If +no modifiers are specified, then events will match only if no modifiers +are present. If the Any modifier is specified, then additional +modifiers may be present besides those specified explicitly. For +example, if button 1 is pressed while the shift and control keys +are down, the specifier <Any-Control-Button-1> will match +the event, but the specifier <Control-Button-1> will not. +

+ +

The Double and Triple modifiers are a convenience +for specifying double mouse clicks and other repeated +events. They cause a particular event pattern to be +repeated 2 or 3 times, and also place a time and space requirement +on the sequence: for a sequence of events to match a Double +or Triple pattern, all of the events must occur close together +in time and without substantial mouse motion in between. +For example, <Double-Button-1> +is equivalent to <Button-1><Button-1> with the extra +time and space requirement. +

+ +

The type field may be any of the standard X event types, with a +few extra abbreviations. Below is a list of all the valid types; +where two name appear together, they are synonyms. +

+
+
ButtonPress, Button      Expose             Leave              
+ButtonRelease            FocusIn            Map                
+Circulate                FocusOut           Property           
+CirculateRequest         Gravity            Reparent           
+Colormap                 Keymap             ResizeRequest      
+Configure                KeyPress, Key      Unmap              
+ConfigureRequest         KeyRelease         Visibility         
+Destroy                  MapRequest         
+Enter                    Motion             
+
+ + + +

The last part of a long event specification is detail. In the +case of a ButtonPress or ButtonRelease event, it is the +number of a button (1-5). If a button number is given, then only an +event on that particular button will match; if no button number is +given, then an event on any button will match. Note: giving a +specific button number is different than specifying a button modifier; +in the first case, it refers to a button being pressed or released, +while in the second it refers to some other button that is already +depressed when the matching event occurs. If a button +number is given then type may be omitted: if will default +to ButtonPress. For example, the specifier <1> +is equivalent to <ButtonPress-1>. +

+ +

If the event type is KeyPress or KeyRelease, then +detail may be specified in the form of an X keysym. Keysyms +are textual specifications for particular keys on the keyboard; +they include all the alphanumeric ASCII characters (e.g. “a” is +the keysym for the ASCII character “a”), plus descriptions for +non-alphanumeric characters (“comma” is the keysym for the comma +character), plus descriptions for all the non-ASCII keys on the +keyboard (“Shift_L” is the keysm for the left shift key, and +“F1” is the keysym for the F1 function key, if it exists). The +complete list of keysyms is not presented here; it should be +available in other X documentation. If necessary, you can use the +%K notation described below to print out the keysym name for +an arbitrary key. If a keysym detail is given, then the +type field may be omitted; it will default to KeyPress. +For example, <Control-comma> is equivalent to +<Control-KeyPress-comma>. If a keysym detail is specified +then the Shift modifier need not be specified and will be +ignored if specified: each keysym already implies a particular +state for the shift key. +

+ +

The command argument to bind is a Tcl command string, +which will be executed whenever the given event sequence occurs. +Command will be executed in the same interpreter that the +bind command was executed in. If command contains +any % characters, then the command string will not be +executed directly. Instead, a new command string will be +generated by replacing each %, and the character following +it, with information from the current event. The replacement +depends on the character following the %, as defined in the +list below. Unless otherwise indicated, the +replacement string is the decimal value of the given field from +the current event. +Some of the substitutions are only valid for +certain types of events; if they are used for other types of events +the value substituted is undefined. +

+
+
%%
+

Replaced with a single percent. +

+
|%#|
+

The number of the last client request processed by the server +(the serial field from the event). Valid for all event +types. +

+
|%a|
+

The above field from the event. +Valid only for ConfigureNotify events. +

+
|%b|
+

The number of the button that was pressed or released. Valid only +for ButtonPress and ButtonRelease events. +

+
|%c|
+

The count field from the event. Valid only for Expose, +GraphicsExpose, and MappingNotify events. +

+
|%d|
+

The detail field from the event. The |%d| is replaced by +a string identifying the detail. For EnterNotify, +LeaveNotify, FocusIn, and FocusOut events, +the string will be one of the following: +

+
+
NotifyAncestor            NotifyNonlinearVirtual          
+NotifyDetailNone          NotifyPointer                   
+NotifyInferior            NotifyPointerRoot               
+NotifyNonlinear           NotifyVirtual                   
+
+ +

For ConfigureRequest events, the substituted string will be +one of the following: +

+
+
Above                     Opposite                  
+Below                     TopIf                     
+BottomIf                  
+
+ +

For events other than these, the substituted string is undefined. +.RE +

+
|%f|
+

The focus field from the event (0 or 1). Valid only +for EnterNotify and LeaveNotify events. +

+
|%h|
+

The height field from the event. Valid only for Configure, +ConfigureNotify, Expose, GraphicsExpose, and +ResizeRequest events. +

+
|%k|
+

The keycode field from the event. Valid only for KeyPress +and KeyRelease events. +

+
|%m|
+

The mode field from the event. The substituted string is one of +NotifyNormal, NotifyGrab, NotifyUngrab, or +NotifyWhileGrabbed. Valid only for EnterWindow, +FocusIn, FocusOut, and LeaveWindow events. +

+
|%o|
+

The override_redirect field from the event. Valid only for +CreateNotify, MapNotify, ReparentNotify, +and ConfigureNotify events. +

+
|%p|
+

The place field from the event, substituted as one of the +strings PlaceOnTop or PlaceOnBottom. Valid only +for CirculateNotify and CirculateRequest events. +

+
|%s|
+

The state field from the event. For ButtonPress, +ButtonRelease, EnterNotify, KeyPress, KeyRelease, +LeaveNotify, and MotionNotify events, +a decimal string +is substituted. For VisibilityNotify, one of the strings +VisibilityUnobscured, VisibilityPartiallyObscured, +and VisibilityFullyObscured is substituted. +

+
|%t|
+

The time field from the event. Valid only for events that +contain a time field. +

+
|%v|
+

The value_mask field from the event. Valid only for +ConfigureRequest events. +

+
|%w|
+

The width field from the event. Valid only for +Configure, ConfigureRequest, Expose, +GraphicsExpose, and ResizeRequest events. +

+
|%x|
+

The x field from the event. Valid only for events containing +an x field. +

+
|%y|
+

The y field from the event. Valid only for events containing +a y field. +

+
%A
+

Substitutes the ASCII character corresponding to the event, or +the empty string if the event doesn’t correspond to an ASCII character +(e.g. the shift key was pressed). XLookupString does all the +work of translating from the event to an ASCII character. +Valid only for KeyPress and KeyRelease events. +

+
%B
+

The border_width field from the event. Valid only for +ConfigureNotify and CreateWindow events. +

+
%D
+

The display field from the event. Valid for all event types. +

+
%E
+

The send_event field from the event. Valid for all event types. +

+
%K
+

The keysym corresponding to the event, substituted as a textual +string. Valid only for KeyPress and KeyRelease events. +

+
%N
+

The keysym corresponding to the event, substituted as +a decimal +number. Valid only for KeyPress and KeyRelease events. +

+
%R
+

The root window identifier from the event. Valid only for +events containing a root field. +

+
%S
+

The subwindow window identifier from the event. Valid only for +events containing a subwindow field. +

+
%T
+

The type field from the event. Valid for all event types. +

+
%W
+

The path name of the window to which the event was reported (the +window field from the event). Valid for all event types. +

+
%X
+

The x_root field from the event. +If a virtual-root window manager is being used then the substituted +value is the corresponding x-coordinate in the virtual root. +Valid only for +ButtonPress, ButtonRelease, KeyPress, KeyRelease, +and MotionNotify events. +

+
%Y
+

The y_root field from the event. +If a virtual-root window manager is being used then the substituted +value is the corresponding y-coordinate in the virtual root. +Valid only for +ButtonPress, ButtonRelease, KeyPress, KeyRelease, +and MotionNotify events. +

+
+ + +

If the replacement string +for a %-replacement contains characters that are interpreted +specially by the Tcl parser (such as backslashes or square +brackets or spaces) additional backslashes are added +during replacement so that the result after parsing is the original +replacement string. +For example, if command is +

+
+
insert %A
+
+ +

and the character typed is an open square bracket, then the command +actually executed will be +

+
+
insert \e[
+
+ +

This will cause the insert to receive the original replacement +string (open square bracket) as its first argument. +If the extra backslash hadn’t been added, Tcl would not have been +able to parse the command correctly. +

+ +

At most one binding will trigger for any given X event. +If several bindings match the recent events, the most specific binding +is chosen and its command will be executed. +The following tests are applied, in order, to determine which of +several matching sequences is more specific: +(a) a binding whose windowSpec names a particular window is +more specific than a binding for a class, +which is more specific than a binding whose windowSpec is +all; +(b) a longer sequence (in terms of number +of events matched) is more specific than a shorter sequence; +(c) an event pattern that specifies a specific button or key is more specific +than one that doesn’t; (e) an event pattern that requires a particular +modifier is more specific than one that doesn’t require the modifier; +(e) an event pattern specifying the Any modifier is less specific +than one that doesn’t. If the matching sequences contain more than +one event, then tests (c)-(e) are applied in order from the most +recent event to the least recent event in the sequences. If these +tests fail to determine a winner, then the most recently registered +sequence is the winner. +

+ +

If an X event does not match any of the existing bindings, then the +event is ignored (an unbound event is not considered to be an error). +

+ +

When a sequence specified in a bind command contains +more than one event pattern, then its command is executed whenever +the recent events (leading up to and including the current event) +match the given sequence. This means, for example, that if button 1 is +clicked repeatedly the sequence <Double-ButtonPress-1> will match +each button press but the first. +If extraneous events that would prevent a match occur in the middle +of an event sequence then the extraneous events are +ignored unless they are KeyPress or ButtonPress events. +For example, <Double-ButtonPress-1> will match a sequence of +presses of button 1, even though there will be ButtonRelease +events (and possibly MotionNotify events) between the +ButtonPress events. +Furthermore, a KeyPress event may be preceded by any number +of other KeyPress events for modifier keys without the +modifier keys preventing a match. +For example, the event sequence aB will match a press of the +a key, a release of the a key, a press of the Shift +key, and a press of the b key: the press of Shift is +ignored because it is a modifier key. +Finally, if several MotionNotify events occur in a row, only +the last one is used for purposes of matching binding sequences. +

+ +

If an error occurs in executing the command for a binding then the +tkerror mechanism is used to report the error. +The command will be executed at global level (outside the context +of any Tcl procedure). +

+

See tkerror. +

+

Keywords

+

form, manual +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/button.html b/info/gcl-tk/button.html new file mode 100644 index 0000000..a80f4e0 --- /dev/null +++ b/info/gcl-tk/button.html @@ -0,0 +1,244 @@ + + + + + +button (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.1 button

+ +

button \- Create and manipulate button widgets +

Synopsis

+

button pathName ?options? +

Standard Options

+ + +
+
activeBackground  bitmap              font        relief        
+activeForeground  borderWidth         foreground  text          
+anchor            cursor              padX        textVariable  
+background        disabledForeground  padY        
+
+ + +

See options, for more information. +

Arguments for Button

+ + +
+
:command
+

Name="command" Class="Command" +


+ +

Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is released over the button +window. +

+
+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies a desired height for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in lines of text. +If this option isn’t specified, the button’s desired height is computed +from the size of the bitmap or text being displayed in it. +

+
+ + +
+
:state
+

Name="state" Class="State" +


+ +

Specifies one of three states for the button: normal, active, +or disabled. In normal state the button is displayed using the +foreground and background options. The active state is +typically used when the pointer is over the button. In active state +the button is displayed using the activeForeground and +activeBackground options. Disabled state means that the button +is insensitive: it doesn’t activate and doesn’t respond to mouse +button presses. In this state the disabledForeground and +background options determine how the button is displayed. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies a desired width for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in characters. +If this option isn’t specified, the button’s desired width is computed +from the size of the bitmap or text being displayed in it. +

+
+ +

Description

+ +

The button command creates a new window (given by the +pathName argument) and makes it into a button widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the button such as its colors, font, +text, and initial relief. The button command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A button is a widget +that displays a textual string or bitmap. +It can display itself in either of three different ways, according +to +the state option; +it can be made to appear raised, sunken, or flat; +and it can be made to flash. When a user invokes the +button (by pressing mouse button 1 with the cursor over the +button), then the Tcl command specified in the :command +option is invoked. +

+

A Button Widget’s Arguments

+ +

The button command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for button widgets: +

+
+
pathName :activate
+

Change the button’s state to active and redisplay the button +using its active foreground and background colors instead of normal +colors. +This command is ignored if the button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state active” instead. +

+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the button +command. +

+
pathName :deactivate
+

Change the button’s state to normal and redisplay the button +using its normal foreground and background colors. +This command is ignored if the button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state normal” instead. +

+
pathName :flash
+

Flash the button. This is accomplished by redisplaying the button +several times, alternating between active and normal colors. At +the end of the flash the button is left in the same normal/active +state as when the command was invoked. +This command is ignored if the button’s state is disabled. +

+
pathName :invoke
+

Invoke the Tcl command associated with the button, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the button. +This command is ignored if the button’s state is disabled. +

+
+
+

"Default Bindings"

+ +

Tk automatically creates class bindings for buttons that give them +the following default behavior: +

    +
  • [1] +The button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves the button. +
  • [2] +The button’s relief is changed to sunken whenever mouse button 1 is +pressed over the button, and the relief is restored to its original +value when button 1 is later released. +
  • [3] +If mouse button 1 is pressed over the button and later released over +the button, the button is invoked. However, if the mouse is not +over the button when button 1 is released, then no invocation occurs. +
+ +

If the button’s state is disabled then none of the above +actions occur: the button is completely non-responsive. +

+

The behavior of buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +

+

Keywords

+

button, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/canvas.html b/info/gcl-tk/canvas.html new file mode 100644 index 0000000..55f24d9 --- /dev/null +++ b/info/gcl-tk/canvas.html @@ -0,0 +1,1535 @@ + + + + + +canvas (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.4 canvas

+ +

canvas \- Create and manipulate canvas widgets +

Synopsis

+

canvas pathName ?options? +

Standard Options

+ + +
+
background       insertBorderWidth relief            xScrollCommand 
+borderWidth      insertOffTime     selectBackground  yScrollCommand 
+cursor           insertOnTime      selectBorderWidth 
+insertBackground insertWidth       selectForeground  
+
+ + +

See options, for more information. +

Arguments for Canvas

+ + +
+
:closeenough
+

Name="closeEnough" Class="CloseEnough" +


+ +

Specifies a floating-point value indicating how close the mouse cursor +must be to an item before it is considered to be “inside” the item. +Defaults to 1.0. +

+
+ + +
+
:confine
+

Name="confine" Class="Confine" +


+ +

Specifies a boolean value that indicates whether or not it should be +allowable to set the canvas’s view outside the region defined by the +scrollRegion argument. +Defaults to true, which means that the view will +be constrained within the scroll region. +

+
+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies a desired window height that the canvas widget should request from +its geometry manager. The value may be specified in any +of the forms described in the COORDINATES section below. +

+
+ + +
+
:scrollincrement
+

Name="scrollIncrement" Class="ScrollIncrement" +


+ +

Specifies a distance used as increment during scrolling: when one of +the arrow buttons on an associated scrollbar is pressed, the picture +will shift by this distance. The distance may be specified in any +of the forms described in the COORDINATES section below. +

+
+ + +
+
:scrollregion
+

Name="scrollRegion" Class="ScrollRegion" +


+ +

Specifies a list with four coordinates describing the left, top, right, and +bottom coordinates of a rectangular region. +This region is used for scrolling purposes and is considered to be +the boundary of the information in the canvas. +Each of the coordinates may be specified +in any of the forms given in the COORDINATES section below. +

+
+ + +
+
:width
+

Name="width" Class="width" +


+ +

Specifies a desired window width that the canvas widget should request from +its geometry manager. The value may be specified in any +of the forms described in the COORDINATES section below. +

+
+ +

Introduction

+ +

The canvas command creates a new window (given +by the pathName argument) and makes it into a canvas widget. +Additional options, described above, may be specified on the +command line or in the option database +to configure aspects of the canvas such as its colors and 3-D relief. +The canvas command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

Canvas widgets implement structured graphics. +A canvas displays any number of items, which may be things like +rectangles, circles, lines, and text. +Items may be manipulated (e.g. moved or re-colored) and commands may +be associated with items in much the same way that the bind +command allows commands to be bound to widgets. For example, +a particular command may be associated with the <Button-1> event +so that the command is invoked whenever button 1 is pressed with +the mouse cursor over an item. +This means that items in a canvas can have behaviors defined by +the Tcl scripts bound to them. +

+

Display List

+ +

The items in a canvas are ordered for purposes of display, +with the first item in the display list being displayed +first, followed by the next item in the list, and so on. +Items later in the display list obscure those that are +earlier in the display list and are sometimes referred to +as being “on top” of earlier items. +When a new item is created it is placed at the end of the +display list, on top of everything else. +Widget commands may be used to re-arrange the order of the +display list. +

+

Item Ids And Tags

+ +

Items in a canvas widget may be named in either of two ways: +by id or by tag. +Each item has a unique identifying number which is assigned to +that item when it is created. The id of an item never changes +and id numbers are never re-used within the lifetime of a +canvas widget. +

+

Each item may also have any number of tags associated +with it. A tag is just a string of characters, and it may +take any form except that of an integer. +For example, “x123” is OK but “123” isn’t. +The same tag may be associated with many different items. +This is commonly done to group items in various interesting +ways; for example, all selected items might be given the +tag “selected”. +

+

The tag all is implicitly associated with every item +in the canvas; it may be used to invoke operations on +all the items in the canvas. +

+

The tag current is managed automatically by Tk; +it applies to the current item, which is the +topmost item whose drawn area covers the position of +the mouse cursor. +If the mouse is not in the canvas widget or is not over +an item, then no item has the current tag. +

+

When specifying items in canvas widget commands, if the +specifier is an integer then it is assumed to refer to +the single item with that id. +If the specifier is not an integer, then it is assumed to +refer to all of the items in the canvas that have a tag +matching the specifier. +The symbol tagOrId is used below to indicate that +an argument specifies either an id that selects a single +item or a tag that selects zero or more items. +Some widget commands only operate on a single item at a +time; if tagOrId is specified in a way that +names multiple items, then the normal behavior is for +the command to use the first (lowest) of these items in +the display list that is suitable for the command. +Exceptions are noted in the widget command descriptions +below. +

+

Coordinates

+ +

All coordinates related to canvases are stored as floating-point +numbers. +Coordinates and distances are specified in screen units, +which are floating-point numbers optionally followed +by one of several letters. +If no letter is supplied then the distance is in pixels. +If the letter is m then the distance is in millimeters on +the screen; if it is c then the distance is in centimeters; +i means inches, and p means printers points (1/72 inch). +Larger y-coordinates refer to points lower on the screen; larger +x-coordinates refer to points farther to the right. +

+

Transformations

+ +

Normally the origin of the canvas coordinate system is at the +upper-left corner of the window containing the canvas. +It is possible to adjust the origin of the canvas +coordinate system relative to the origin of the window using the +xview and yview widget commands; this is typically used +for scrolling. +Canvases do not support scaling or rotation of the canvas coordinate +system relative to the window coordinate system. +

+

Indidividual items may be moved or scaled using widget commands +described below, but they may not be rotated. +

+

Indices

+ +

Text items support the notion of an index for identifying +particular positions within the item. +Indices are used for commands such as inserting text, deleting +a range of characters, and setting the insertion cursor position. +An index may be specified in any of a number of ways, and +different types of items may support different forms for +specifying indices. +Text items support the following forms for an index; if you +define new types of text-like items, it would be advisable to +support as many of these forms as practical. +Note that it is possible to refer to the character just after +the last one in the text item; this is necessary for such +tasks as inserting new text at the end of the item. +

+
+
number
+

A decimal number giving the position of the desired character +within the text item. +0 refers to the first character, 1 to the next character, and +so on. +A number less than 0 is treated as if it were zero, and a +number greater than the length of the text item is treated +as if it were equal to the length of the text item. +

+
end
+

Refers to the character just after the last one in the item +(same as the number of characters in the item). +

+
insert
+

Refers to the character just before which the insertion cursor +is drawn in this item. +

+
sel.first
+

Refers to the first selected character in the item. +If the selection isn’t in this item then this form is illegal. +

+
sel.last
+

Refers to the last selected character in the item. +If the selection isn’t in this item then this form is illegal. +

+
@x,y
+

Refers to the character at the point given by x and +y, where x and y are specified in the coordinate +system of the canvas. +If x and y lie outside the coordinates covered by the +text item, then they refer to the first or last character in the +line that is closest to the given point. +

+
+
+

A Canvas Widget’s Arguments

+ +

The canvas command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. +The following widget commands are possible for canvas widgets: +

+
+
pathName :addtag tag searchSpec ?arg arg ...?
+

For each item that meets the constraints specified by +searchSpec and the args, add +tag to the list of tags associated with the item if it +isn’t already present on that list. +It is possible that no items will satisfy the constraints +given by searchSpec and args, in which case the +command has no effect. +This command returns an empty string as result. +SearchSpec and arg’s may take any of the following +forms: +

+
+
above tagOrId
+

Selects the item just after (above) the one given by tagOrId +in the display list. +If tagOrId denotes more than one item, then the last (topmost) +of these items in the display list is used. +

+
all
+

Selects all the items in the canvas. +

+
below tagOrId
+

Selects the item just before (below) the one given by tagOrId +in the display list. +If tagOrId denotes more than one item, then the first (lowest) +of these items in the display list is used. +

+
closest x y ?halo? ?start?
+

Selects the item closest to the point given by x and y. +If more than one item is at the same closest distance (e.g. two +items overlap the point), then the top-most of these items (the +last one in the display list) is used. +If halo is specified, then it must be a non-negative +value. +Any item closer than halo to the point is considered to +overlap it. +The start argument may be used to step circularly through +all the closest items. +If start is specified, it names an item using a tag or id +(if by tag, it selects the first item in the display list with +the given tag). +Instead of selecting the topmost closest item, this form will +select the topmost closest item that is below start in +the display list; if no such item exists, then the selection +behaves as if the start argument had not been specified. +

+
enclosed x1 y1 x2 y2
+

Selects all the items completely enclosed within the rectangular +region given by x1, y1, x2, and y2. +X1 must be no greater then x2 and y1 must be +no greater than y2. +

+
overlapping x1 y1 x2 y2
+

Selects all the items that overlap or are enclosed within the +rectangular region given by x1, y1, x2, +and y2. +X1 must be no greater then x2 and y1 must be +no greater than y2. +

+
withtag tagOrId
+

Selects all the items given by tagOrId. +

+
+ +
+
pathName :bbox tagOrId ?tagOrId tagOrId ...?
+

Returns a list with four elements giving an approximate bounding box +for all the items named by the tagOrId arguments. +The list has the form “x1 y1 x2 y2” such that the drawn +areas of all the named elements are within the region bounded by +x1 on the left, x2 on the right, y1 on the top, +and y2 on the bottom. +The return value may overestimate the actual bounding box by +a few pixels. +If no items match any of the tagOrId arguments then an +empty string is returned. +

+
pathName :bind tagOrId ?sequence? ?command?
+

This command associates command with all the items given by +tagOrId such that whenever the event sequence given by +sequence occurs for one of the items the command will +be invoked. +This widget command is similar to the bind command except that +it operates on items in a canvas rather than entire widgets. +See the bind manual entry for complete details +on the syntax of sequence and the substitutions performed +on command before invoking it. +If all arguments are specified then a new binding is created, replacing +any existing binding for the same sequence and tagOrId +(if the first character of command is “+” then command +augments an existing binding rather than replacing it). +In this case the return value is an empty string. +If command is omitted then the command returns the command +associated with tagOrId and sequence (an error occurs +if there is no such binding). +If both command and sequence are omitted then the command +returns a list of all the sequences for which bindings have been +defined for tagOrId. +

+
+ + +

The only events for which bindings may be specified are those related +to the mouse and keyboard, such as Enter, Leave, +ButtonPress, Motion, and KeyPress. +The handling of events in canvases uses the current item defined +in ITEM IDS AND TAGS above. +Enter and Leave events trigger for an item when it +becomes the current item or ceases to be the current item; note +that these events are different than Enter and Leave +events for windows. +Mouse-related events are directed to the current item, if any. +Keyboard-related events are directed to the focus item, if any +(see the focus widget command below for more on this). +

+ +

It is possible for multiple commands to be bound to a single +event sequence for a single object. +This occurs, for example, if one command is associated with the +item’s id and another is associated with one of the item’s tags. +When this occurs, the first matching binding is used. +A binding for the item’s id has highest priority, followed by +the oldest tag for the item and proceeding through all of the +item’s tags up through the most-recently-added one. +If a binding is associated with the tag all, the binding +will have lower priority than all other bindings associated +with the item. +

+
+
pathName :canvasx screenx ?gridspacing?
+

Given a screen x-coordinate screenx this command returns +the canvas x-coordinate that is displayed at that location. +If gridspacing is specified, then the canvas coordinate is +rounded to the nearest multiple of gridspacing units. +

+
pathName :canvasy screeny ?gridspacing?
+

Given a screen y-coordinate screeny this command returns +the canvas y-coordinate that is displayed at that location. +If gridspacing is specified, then the canvas coordinate is +rounded to the nearest multiple of gridspacing units. +

+
pathName :configure ?option? ?value? ?option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the canvas +command. +

+
pathName :coords tagOrId ?x0 y0 ...?
+

Query or modify the coordinates that define an item. +If no coordinates are specified, this command returns a list +whose elements are the coordinates of the item named by +tagOrId. +If coordinates are specified, then they replace the current +coordinates for the named item. +If tagOrId refers to multiple items, then +the first one in the display list is used. +

+
pathName :create type x y ?x y ...? ?option value ...?
+

Create a new item in pathName of type type. +The exact format of the arguments after type depends +on type, but usually they consist of the coordinates for +one or more points, followed by specifications for zero or +more item options. +See the subsections on individual item types below for more +on the syntax of this command. +This command returns the id for the new item. +

+
pathName :dchars tagOrId first ?last?
+

For each item given by tagOrId, delete the characters +in the range given by first and last, +inclusive. +If some of the items given by tagOrId don’t support +text operations, then they are ignored. +First and last are indices of characters +within the item(s) as described in INDICES above. +If last is omitted, it defaults to first. +This command returns an empty string. +

+
pathName :delete ?tagOrId tagOrId ...?
+

Delete each of the items given by each tagOrId, and return +an empty string. +

+
pathName :dtag tagOrId ?tagToDelete?
+

For each of the items given by tagOrId, delete the +tag given by tagToDelete from the list of those +associated with the item. +If an item doesn’t have the tag tagToDelete then +the item is unaffected by the command. +If tagToDelete is omitted then it defaults to tagOrId. +This command returns an empty string. +

+
pathName :find searchCommand ?arg arg ...?
+

This command returns a list consisting of all the items that +meet the constraints specified by searchCommand and +arg’s. +SearchCommand and args have any of the forms +accepted by the addtag command. +

+
pathName :focus ?tagOrId?
+

Set the keyboard focus for the canvas widget to the item given by +tagOrId. +If tagOrId refers to several items, then the focus is set +to the first such item in the display list that supports the +insertion cursor. +If tagOrId doesn’t refer to any items, or if none of them +support the insertion cursor, then the focus isn’t changed. +If tagOrId is an empty +string, then the focus item is reset so that no item has the focus. +If tagOrId is not specified then the command returns the +id for the item that currently has the focus, or an empty string +if no item has the focus. +

+
+ + +

Once the focus has been set to an item, the item will display +the insertion cursor and all keyboard events will be directed +to that item. +The focus item within a canvas and the focus window on the +screen (set with the focus command) are totally independent: +a given item doesn’t actually have the input focus unless (a) +its canvas is the focus window and (b) the item is the focus item +within the canvas. +In most cases it is advisable to follow the focus widget +command with the focus command to set the focus window to +the canvas (if it wasn’t there already). +

+
+
pathName :gettags tagOrId
+

Return a list whose elements are the tags associated with the +item given by tagOrId. +If tagOrId refers to more than one item, then the tags +are returned from the first such item in the display list. +If tagOrId doesn’t refer to any items, or if the item +contains no tags, then an empty string is returned. +

+
pathName :icursor tagOrId index
+

Set the position of the insertion cursor for the item(s) +given by tagOrId +to just before the character whose position is given by index. +If some or all of the items given by tagOrId don’t support +an insertion cursor then this command has no effect on them. +See INDICES above for a description of the +legal forms for index. +Note: the insertion cursor is only displayed in an item if +that item currently has the keyboard focus (see the widget +command focus, below), but the cursor position may +be set even when the item doesn’t have the focus. +This command returns an empty string. +

+
pathName :index tagOrId index
+

This command returns a decimal string giving the numerical index +within tagOrId corresponding to index. +Index gives a textual description of the desired position +as described in INDICES above. +The return value is guaranteed to lie between 0 and the number +of characters within the item, inclusive. +If tagOrId refers to multiple items, then the index +is processed in the first of these items that supports indexing +operations (in display list order). +

+
pathName :insert tagOrId beforeThis string
+

For each of the items given by tagOrId, if the item supports +text insertion then string is inserted into the item’s +text just before the character whose index is beforeThis. +See INDICES above for information about the forms allowed +for beforeThis. +This command returns an empty string. +

+
pathName :itemconfigure tagOrId ?option? ?value? ?option value ...?
+

This command is similar to the configure widget command except +that it modifies item-specific options for the items given by +tagOrId instead of modifying options for the overall +canvas widget. +If no option is specified, returns a list describing all of +the available options for the first item given by tagOrId +(see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s) in +each of the items given by tagOrId; in +this case the command returns an empty string. +The options and values are the same as those permissible +in the create widget command when the item(s) were created; +see the sections describing individual item types below for details +on the legal options. +

+
pathName :lower tagOrId ?belowThis?
+

Move all of the items given by tagOrId to a new position +in the display list just before the item given by belowThis. +If tagOrId refers to more than one item then all are moved +but the relative order of the moved items will not be changed. +BelowThis is a tag or id; if it refers to more than one +item then the first (lowest) of these items in the display list is used +as the destination location for the moved items. +This command returns an empty string. +

+
pathName :move tagOrId xAmount yAmount
+

Move each of the items given by tagOrId in the canvas coordinate +space by adding xAmount to the x-coordinate of each point +associated with the item and yAmount to the y-coordinate of +each point associated with the item. +This command returns an empty string. +

+
pathName :postscript ?option value option value ...?
+

Generate a Postscript representation for part or all of the canvas. +If the :file option is specified then the Postscript is written +to a file and an empty string is returned; otherwise the Postscript +is returned as the result of the command. +The Postscript is created in Encapsulated Postscript form using +version 3.0 of the Document Structuring Conventions. +The option\-value argument pairs provide additional +information to control the generation of Postscript. The following +options are supported: +

+
+
:colormap varName
+

VarName must be the name of a global array variable +that specifies a color mapping to use in the Postscript. +Each element of varName must consist of Postscript +code to set a particular color value (e.g. “1.0 1.0 0.0 setrgbcolor”). +When outputting color information in the Postscript, Tk checks +to see if there is an element of varName with the same +name as the color. +If so, Tk uses the value of the element as the Postscript command +to set the color. +If this option hasn’t been specified, or if there isn’t an entry +in varName for a given color, then Tk uses the red, green, +and blue intensities from the X color. +

+
:colormode mode
+

Specifies how to output color information. Mode must be either +color (for full color output), gray (convert all colors +to their gray-scale equivalents) or mono (convert all colors +to black or white). +

+
:file fileName
+

Specifies the name of the file in which to write the Postscript. +If this option isn’t specified then the Postscript is returned as the +result of the command instead of being written to a file. +

+
:fontmap varName
+

VarName must be the name of a global array variable +that specifies a font mapping to use in the Postscript. +Each element of varName must consist of a Tcl list with +two elements, which are the name and point size of a Postscript font. +When outputting Postscript commands for a particular font, Tk +checks to see if varName contains an element with the same +name as the font. +If there is such an element, then the font information contained in +that element is used in the Postscript. +Otherwise Tk attempts to guess what Postscript font to use. +Tk’s guesses generally only work for well-known fonts such as +Times and Helvetica and Courier, and only if the X font name does not +omit any dashes up through the point size. +For example, \fB\-*\-Courier\-Bold\-R\-Normal\-\-*\-120\-* will work but +\fB*Courier\-Bold\-R\-Normal*120* will not; Tk needs the dashes to +parse the font name). +

+
:height size
+

Specifies the height of the area of the canvas to print. +Defaults to the height of the canvas window. +

+
:pageanchor anchor
+

Specifies which point of the printed area should be appear over +the positioning point on the page (which is given by the :pagex +and :pagey options). +For example, :pageanchor n means that the top center of the +printed area should be over the positioning point. +Defaults to center. +

+
:pageheight size
+

Specifies that the Postscript should be scaled in both x and y so +that the printed area is size high on the Postscript page. +Size consists of a floating-point number followed by +c for centimeters, i for inches, m for millimeters, +or p or nothing for printer’s points (1/72 inch). +Defaults to the height of the printed area on the screen. +If both :pageheight and :pagewidth are specified then +the scale factor from the later option is used (non-uniform scaling +is not implemented). +

+
:pagewidth size
+

Specifies that the Postscript should be scaled in both x and y so +that the printed area is size wide on the Postscript page. +Size has the same form as for :pageheight. +Defaults to the width of the printed area on the screen. +If both :pageheight and :pagewidth are specified then +the scale factor from the later option is used (non-uniform scaling +is not implemented). +

+
:pagex position
+

Position gives the x-coordinate of the positioning point on +the Postscript page, using any of the forms allowed for :pageheight. +Used in conjunction with the :pagey and :pageanchor options +to determine where the printed area appears on the Postscript page. +Defaults to the center of the page. +

+
:pagey position
+

Position gives the y-coordinate of the positioning point on +the Postscript page, using any of the forms allowed for :pageheight. +Used in conjunction with the :pagex and :pageanchor options +to determine where the printed area appears on the Postscript page. +Defaults to the center of the page. +

+
:rotate boolean
+

Boolean specifies whether the printed area is to be rotated 90 +degrees. +In non-rotated output the x-axis of the printed area runs along +the short dimension of the page (“portrait” orientation); +in rotated output the x-axis runs along the long dimension of the +page (“landscape” orientation). +Defaults to non-rotated. +

+
:width size
+

Specifies the width of the area of the canvas to print. +Defaults to the width of the canvas window. +

+
:x position
+

Specifies the x-coordinate of the left edge of the area of the +canvas that is to be printed, in canvas coordinates, not window +coordinates. +Defaults to the coordinate of the left edge of the window. +

+
:y position
+

Specifies the y-coordinate of the top edge of the area of the +canvas that is to be printed, in canvas coordinates, not window +coordinates. +Defaults to the coordinate of the top edge of the window. +

+
+ +
+
pathName :raise tagOrId ?aboveThis?
+

Move all of the items given by tagOrId to a new position +in the display list just after the item given by aboveThis. +If tagOrId refers to more than one item then all are moved +but the relative order of the moved items will not be changed. +AboveThis is a tag or id; if it refers to more than one +item then the last (topmost) of these items in the display list is used +as the destination location for the moved items. +This command returns an empty string. +

+
pathName :scale tagOrId xOrigin yOrigin xScale yScale
+

Rescale all of the items given by tagOrId in canvas coordinate +space. +XOrigin and yOrigin identify the origin for the scaling +operation and xScale and yScale identify the scale +factors for x- and y-coordinates, respectively (a scale factor of +1.0 implies no change to that coordinate). +For each of the points defining each item, the x-coordinate is +adjusted to change the distance from xOrigin by a factor +of xScale. +Similarly, each y-coordinate is adjusted to change the distance +from yOrigin by a factor of yScale. +This command returns an empty string. +

+
pathName :scan option args
+

This command is used to implement scanning on canvases. It has +two forms, depending on option: +

+
+
pathName :scan :mark x y
+

Records x and y and the canvas’s current view; used +in conjunction with later scan dragto commands. +Typically this command is associated with a mouse button press in +the widget and x and y are the coordinates of the +mouse. It returns an empty string. +

+
pathName :scan :dragto x y.
+

This command computes the difference between its x and y +arguments (which are typically mouse coordinates) and the x and +y arguments to the last scan mark command for the widget. +It then adjusts the view by 10 times the +difference in coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the canvas at high speed through its window. The return +value is an empty string. +

+
+ +
+
pathName :select option ?tagOrId arg?
+

Manipulates the selection in one of several ways, depending on +option. +The command may take any of the forms described below. +In all of the descriptions below, tagOrId must refer to +an item that supports indexing and selection; if it refers to +multiple items then the first of +these that supports indexing and the selection is used. +Index gives a textual description of a position +within tagOrId, as described in INDICES above. +

+
+
pathName :select :adjust tagOrId index
+

Locate the end of the selection in tagOrId nearest +to the character given by index, and adjust that +end of the selection to be at index (i.e. including +but not going beyond index). +The other end of the selection is made the anchor point +for future select to commands. +If the selection isn’t currently in tagOrId then +this command behaves the same as the select to widget +command. +Returns an empty string. +

+
pathName :select :clear
+

Clear the selection if it is in this widget. +If the selection isn’t in this widget then the command +has no effect. +Returns an empty string. +

+
pathName :select :from tagOrId index
+

Set the selection anchor point for the widget to be just +before the character +given by index in the item given by tagOrId. +This command doesn’t change the selection; it just sets +the fixed end of the selection for future select to +commands. +Returns an empty string. +

+
pathName :select :item
+

Returns the id of the selected item, if the selection is in an +item in this canvas. +If the selection is not in this canvas then an empty string +is returned. +

+
pathName :select :to tagOrId index
+

Set the selection to consist of those characters of tagOrId +between the selection anchor point and +index. +The new selection will include the character given by index; +it will include the character given by the anchor point only if +index is greater than or equal to the anchor point. +The anchor point is determined by the most recent select adjust +or select from command for this widget. +If the selection anchor point for the widget isn’t currently in +tagOrId, then it is set to the same character given +by index. +Returns an empty string. +

+
+ +
+
pathName :type tagOrId
+

Returns the type of the item given by tagOrId, such as +rectangle or text. +If tagOrId refers to more than one item, then the type +of the first item in the display list is returned. +If tagOrId doesn’t refer to any items at all then +an empty string is returned. +

+
pathName :xview index
+

Change the view in the canvas so that the canvas position given by +index appears at the left edge of the window. +This command is typically used by scrollbars to scroll the +canvas. +Index counts in units of scroll increments (the value of the +scrollIncrement option): a value of 0 corresponds to the left +edge of the scroll region (as defined by the scrollRegion +option), a value of 1 means one scroll unit to the right of this, +and so on. The return value is an empty string. +

+
pathName :yview index
+

Change the view in the canvas so that the canvas position given by +index appears at the top edge of the window. +This command is typically used by scrollbars to scroll the +canvas. +Index counts in units of scroll increments (the value of the +scrollIncrement option): a value of 0 corresponds to the top +edge of the scroll region (as defined by the scrollRegion +option), a value of 1 means one scroll unit below this, +and so on. The return value is an empty string. +

+
+
+

Overview Of Item Types

+ +

The sections below describe the various types of items supported +by canvas widgets. Each item type is characterized by two things: +first, the form of the create command used to create +instances of the type; and second, a set of configuration options +for items of that type, which may be used in the +create and itemconfigure widget commands. +Most items don’t support indexing or selection or the commands +related to them, such as index and insert. +Where items do support these facilities, it is noted explicitly +in the descriptions below (at present, only text items provide +this support). +

+

Arc Items

+ +

Items of type arc appear on the display as arc-shaped regions. +An arc is a section of an oval delimited by two angles (specified +by the :start and :extent options) and displayed in +one of several ways (specified by the :style option). +Arcs are created with widget commands of the following form: +

+
+
pathName :create arc x1 y1 x2 y2 ?option value option value ...?
+

The arguments x1, y1, x2, and y2 give +the coordinates of two diagonally opposite corners of a +rectangular region enclosing the oval that defines the arc. +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for arcs: +

+
+
:extent degrees
+

Specifies the size of the angular range occupied by the arc. +The arc’s range extends for degrees degrees counter-clockwise +from the starting angle given by the :start option. +Degrees may be negative. +

+
:fill color
+

Fill the region of the arc with color. +Color may have any of the forms accepted by Tk_GetColor. +If color is an empty string (the default), then +then the arc will not be filled. +

+
:outline color
+

Color specifies a color to use for drawing the arc’s +outline; it may have any of the forms accepted by Tk_GetColor. +This option defaults to black. If the arc’s style is +arc then this option is ignored (the section of perimeter is +filled using the :fill option). If color is specified +as an empty string then no outline is drawn for the arc. +

+
:start degrees
+

Specifies the beginning of the angular range occupied by the +arc. +Degrees is given in units of degrees measured counter-clockwise +from the 3-o’clock position; it may be either positive or negative. +

+
:stipple bitmap
+

Indicates that the arc should be filled in a stipple pattern; +bitmap specifies the stipple pattern to use, in any of the +forms accepted by Tk_GetBitmap. +If the :fill option hasn’t been specified then this option +has no effect. +If bitmap is an empty string (the default), then filling is done +in a solid fashion. +

+
:style type
+

Specifies how to draw the arc. If type is pieslice +(the default) then the arc’s region is defined by a section +of the oval’s perimeter plus two line segments, one between the center +of the oval and each end of the perimeter section. +If type is chord then the arc’s region is defined +by a section of the oval’s perimeter plus a single line segment +connecting the two end points of the perimeter section. +If type is arc then the arc’s region consists of +a section of the perimeter alone. In this last case there is +no outline for the arc and the :outline option is ignored. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
:width outlineWidth
+

Specifies the width of the outline to be drawn around +the arc’s region, in any of the forms described in the COORDINATES +section above. +If the :outline option has been specified as an empty string +then this option has no effect. +Wide outlines will be drawn centered on the edges of the arc’s region. +This option defaults to 1.0. +

+
+
+
+ +

Bitmap Items

+ +

Items of type bitmap appear on the display as images with +two colors, foreground and background. +Bitmaps are created with widget commands of the following form: +

+
+
pathName :create bitmap x y ?option value option value ...?
+

The arguments x and y specify the coordinates of a +point used to position the bitmap on the display (see the :anchor +option below for more information on how bitmaps are displayed). +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for bitmaps: +

+
+
:anchor anchorPos
+

AnchorPos tells how to position the bitmap relative to the +positioning point for the item; it may have any of the forms +accepted by Tk_GetAnchor. For example, if anchorPos +is center then the bitmap is centered on the point; if +anchorPos is n then the bitmap will be drawn so that +its top center point is at the positioning point. +This option defaults to center. +

+
:background color
+

Specifies a color to use for each of the bitmap pixels +whose value is 0. +Color may have any of the forms accepted by Tk_GetColor. +If this option isn’t specified, or if it is specified as an empty +string, then the background color for the canvas is used. +

+
:bitmap bitmap
+

Specifies the bitmap to display in the item. +Bitmap may have any of the forms accepted by Tk_GetBitmap. +

+
:foreground color
+

Specifies a color to use for each of the bitmap pixels +whose value is 1. +Color may have any of the forms accepted by Tk_GetColor and +defaults to black. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
+
+
+

Line Items

+ +

Items of type line appear on the display as one or more connected +line segments or curves. +Lines are created with widget commands of the following form: +

+
+
pathName :create line x1 y1... xn yn ?option value option value ...?
+
+

The arguments x1 through yn give +the coordinates for a series of two or more points that describe +a series of connected line segments. +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for lines: +

+
+
:arrow where
+

Indicates whether or not arrowheads are to be drawn at one or both +ends of the line. +Where must have one of the values none (for no arrowheads), +first (for an arrowhead at the first point of the line), +last (for an arrowhead at the last point of the line), or +both (for arrowheads at both ends). +This option defaults to none. +

+
:arrowshape shape
+

This option indicates how to draw arrowheads. +The shape argument must be a list with three elements, each +specifying a distance in any of the forms described in +the COORDINATES section above. +The first element of the list gives the distance along the line +from the neck of the arrowhead to its tip. +The second element gives the distance along the line from the +trailing points of the arrowhead to the tip, and the third +element gives the distance from the outside edge of the line to the +trailing points. +If this option isn’t specified then Tk picks a “reasonable” shape. +

+
:capstyle style
+

Specifies the ways in which caps are to be drawn at the endpoints +of the line. +Style may have any of the forms accepted by Tk_GetCapStyle +(butt, projecting, or round). +If this option isn’t specified then it defaults to butt. +Where arrowheads are drawn the cap style is ignored. +

+
:fill color
+

Color specifies a color to use for drawing the line; it may have +any of the forms acceptable to Tk_GetColor. It may also be an +empty string, in which case the line will be transparent. +This option defaults to black. +

+
:joinstyle style
+

Specifies the ways in which joints are to be drawn at the vertices +of the line. +Style may have any of the forms accepted by Tk_GetCapStyle +(bevel, miter, or round). +If this option isn’t specified then it defaults to miter. +If the line only contains two points then this option is +irrelevant. +

+
:smooth boolean
+

Boolean must have one of the forms accepted by Tk_GetBoolean. +It indicates whether or not the line should be drawn as a curve. +If so, the line is rendered as a set of Bezier splines: one spline +is drawn for the first and second line segments, one for the second +and third, and so on. Straight-line segments can be generated within +a curve by duplicating the end-points of the desired line segment. +

+
:splinesteps number
+

Specifies the degree of smoothness desired for curves: each spline +will be approximated with number line segments. This +option is ignored unless the :smooth option is true. +

+
:stipple bitmap
+

Indicates that the line should be filled in a stipple pattern; +bitmap specifies the stipple pattern to use, in any of the +forms accepted by Tk_GetBitmap. +If bitmap is an empty string (the default), then filling is +done in a solid fashion. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
:width lineWidth
+

LineWidth specifies the width of the line, in any of the forms +described in the COORDINATES section above. +Wide lines will be drawn centered on the path specified by the +points. +If this option isn’t specified then it defaults to 1.0. +

+
+
+
+

Oval Items

+ +

Items of type oval appear as circular or oval regions on +the display. Each oval may have an outline, a fill, or +both. Ovals are created with widget commands of the +following form: +

+
+
pathName :create oval x1 y1 x2 y2 ?option value option value ...?
+
+

The arguments x1, y1, x2, and y2 give +the coordinates of two diagonally opposite corners of a +rectangular region enclosing the oval. +The oval will include the top and left edges of the rectangle +not the lower or right edges. +If the region is square then the resulting oval is circular; +otherwise it is elongated in shape. +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for ovals: +

+
+
:fill color
+

Fill the area of the oval with color. +Color may have any of the forms accepted by Tk_GetColor. +If color is an empty string (the default), then +then the oval will not be filled. +

+
:outline color
+

Color specifies a color to use for drawing the oval’s +outline; it may have any of the forms accepted by Tk_GetColor. +This option defaults to black. +If color is an empty string then no outline will be +drawn for the oval. +

+
:stipple bitmap
+

Indicates that the oval should be filled in a stipple pattern; +bitmap specifies the stipple pattern to use, in any of the +forms accepted by Tk_GetBitmap. +If the :fill option hasn’t been specified then this option +has no effect. +If bitmap is an empty string (the default), then filling is done +in a solid fashion. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
:width outlineWidth
+

outlineWidth specifies the width of the outline to be drawn around +the oval, in any of the forms described in the COORDINATES section above. +If the :outline option hasn’t been specified then this option +has no effect. +Wide outlines are drawn centered on the oval path defined by +x1, y1, x2, and y2. +This option defaults to 1.0. +

+
+
+
+

Polygon Items

+ +

Items of type polygon appear as polygonal or curved filled regions +on the display. +Polygons are created with widget commands of the following form: +

+
+
pathName :create polygon x1 y1 ... xn yn ?option value option value ...?
+
+ +

The arguments x1 through yn specify the coordinates for +three or more points that define a closed polygon. +The first and last points may be the same; whether they are or not, +Tk will draw the polygon as a closed polygon. +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for polygons: +

+
+
:fill color
+

Color specifies a color to use for filling the area of the +polygon; it may have any of the forms acceptable to Tk_GetColor. +If color is an empty string then the polygon will be +transparent. +This option defaults to black. +

+
:smooth boolean
+

Boolean must have one of the forms accepted by Tk_GetBoolean +It indicates whether or not the polygon should be drawn with a +curved perimeter. +If so, the outline of the polygon becomes a set of Bezier splines, +one spline for the first and second line segments, one for the second +and third, and so on. Straight-line segments can be generated in a +smoothed polygon by duplicating the end-points of the desired line segment. +

+
:splinesteps number
+

Specifies the degree of smoothness desired for curves: each spline +will be approximated with number line segments. This +option is ignored unless the :smooth option is true. +

+
:stipple bitmap
+

Indicates that the polygon should be filled in a stipple pattern; +bitmap specifies the stipple pattern to use, in any of the +forms accepted by Tk_GetBitmap. +If bitmap is an empty string (the default), then filling is +done in a solid fashion. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
+
+
+ +

Rectangle Items

+ +

Items of type rectangle appear as rectangular regions on +the display. Each rectangle may have an outline, a fill, or +both. Rectangles are created with widget commands of the +following form: +

+
+
pathName :create rectangle x1 y1 x2 y2 ?option value option value ...?
+
+

The arguments x1, y1, x2, and y2 give +the coordinates of two diagonally opposite corners of the rectangle +(the rectangle will include its upper and left edges but not +its lower or right edges). +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for rectangles: +

+
+
:fill color
+

Fill the area of the rectangle with color, which may be +specified in any of the forms accepted by Tk_GetColor. +If color is an empty string (the default), then +then the rectangle will not be filled. +

+
:outline color
+

Draw an outline around the edge of the rectangle in color. +Color may have any of the forms accepted by Tk_GetColor. +This option defaults to black. +If color is an empty string then no outline will be +drawn for the rectangle. +

+
:stipple bitmap
+

Indicates that the rectangle should be filled in a stipple pattern; +bitmap specifies the stipple pattern to use, in any of the +forms accepted by Tk_GetBitmap. +If the :fill option hasn’t been specified then this option +has no effect. +If bitmap is an empty string (the default), then filling +is done in a solid fashion. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
:width outlineWidth
+

OutlineWidth specifies the width of the outline to be drawn around +the rectangle, in any of the forms described in the COORDINATES section above. +If the :outline option hasn’t been specified then this option +has no effect. +Wide outlines are drawn centered on the rectangular path +defined by x1, y1, x2, and y2. +This option defaults to 1.0. +

+
+
+
+

Text Items

+ +

A text item displays a string of characters on the screen in one +or more lines. +Text items support indexing and selection, along with the +following text-related canvas widget commands: dchars, +focus, icursor, index, insert, +select. +Text items are created with widget commands of the following +form: +

+
+
pathName :create text x y ?option value option value ...?
+
+

The arguments x and y specify the coordinates of a +point used to position the text on the display (see the options +below for more information on how text is displayed). +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for text items: +

+
+
:anchor anchorPos
+

AnchorPos tells how to position the text relative to the +positioning point for the text; it may have any of the forms +accepted by Tk_GetAnchor. For example, if anchorPos +is center then the text is centered on the point; if +anchorPos is n then the text will be drawn such that +the top center point of the rectangular region occupied by the +text will be at the positioning point. +This option defaults to center. +

+
:fill color
+

Color specifies a color to use for filling the text characters; +it may have any of the forms accepted by Tk_GetColor. +If this option isn’t specified then it defaults to black. +

+
:font fontName
+

Specifies the font to use for the text item. +FontName may be any string acceptable to Tk_GetFontStruct. +If this option isn’t specified, it defaults to a system-dependent +font. +

+
:justify how
+

Specifies how to justify the text within its bounding region. +How must be one of the values left, right, +or center. +This option will only matter if the text is displayed as multiple +lines. +If the option is omitted, it defaults to left. +

+
:stipple bitmap
+

Indicates that the text should be drawn in a stippled pattern +rather than solid; +bitmap specifies the stipple pattern to use, in any of the +forms accepted by Tk_GetBitmap. +If bitmap is an empty string (the default) then the text +is drawn in a solid fashion. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
:text string
+

String specifies the characters to be displayed in the text item. +Newline characters cause line breaks. +The characters in the item may also be changed with the +insert and delete widget commands. +This option defaults to an empty string. +

+
:width lineLength
+

Specifies a maximum line length for the text, in any of the forms +described in the COORDINATES section abov. +If this option is zero (the default) the text is broken into +lines only at newline characters. +However, if this option is non-zero then any line that would +be longer than lineLength is broken just before a space +character to make the line shorter than lineLength; the +space character is treated as if it were a newline +character. +

+
+
+
+
+

Window Items

+ +

Items of type window cause a particular window to be displayed +at a given position on the canvas. +Window items are created with widget commands of the following form: +

+
+
pathName :create window x y ?option value option value ...?
+
+ +

The arguments x and y specify the coordinates of a +point used to position the window on the display (see the :anchor +option below for more information on how bitmaps are displayed). +After the coordinates there may be any number of option-value +pairs, each of which sets one of the configuration options +for the item. These same option\-value pairs may be +used in itemconfigure widget commands to change the item’s +configuration. +The following options are supported for window items: +

+
+
:anchor anchorPos
+

AnchorPos tells how to position the window relative to the +positioning point for the item; it may have any of the forms +accepted by Tk_GetAnchor. For example, if anchorPos +is center then the window is centered on the point; if +anchorPos is n then the window will be drawn so that +its top center point is at the positioning point. +This option defaults to center. +

+
:height pixels
+

Specifies the height to assign to the item’s window. +Pixels may have any of the +forms described in the COORDINATES section above. +If this option isn’t specified, or if it is specified as an empty +string, then the window is given whatever height it requests internally. +

+
:tags tagList
+

Specifies a set of tags to apply to the item. +TagList consists of a list of tag names, which replace any +existing tags for the item. +TagList may be an empty list. +

+
:width pixels
+

Specifies the width to assign to the item’s window. +Pixels may have any of the +forms described in the COORDINATES section above. +If this option isn’t specified, or if it is specified as an empty +string, then the window is given whatever width it requests internally. +

+
:window pathName
+

Specifies the window to associate with this item. +The window specified by pathName must either be a child of +the canvas widget or a child of some ancestor of the canvas widget. +PathName may not refer to a top-level window. +

+
+
+

Application-Defined Item Types

+ +

It is possible for individual applications to define new item +types for canvas widgets using C code. +The interfaces for this mechanism are not presently documented, +and it’s possible they may change, but you should be able to +see how they work by examining the code for some of the existing +item types. +

+

Bindings

+ +

In the current implementation, new canvases are not given any +default behavior: you’ll have to execute explicit Tcl commands +to give the canvas its behavior. +

+

Credits

+ +

Tk’s canvas widget is a blatant ripoff of ideas from Joel Bartlett’s +ezd program. Ezd provides structured graphics in a Scheme +environment and preceded canvases by a year or two. Its simple +mechanisms for placing and animating graphical objects inspired the +functions of canvases. +

+

Keywords

+

canvas, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/checkbutton.html b/info/gcl-tk/checkbutton.html new file mode 100644 index 0000000..b0327c7 --- /dev/null +++ b/info/gcl-tk/checkbutton.html @@ -0,0 +1,328 @@ + + + + + +checkbutton (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.7 checkbutton

+ +

checkbutton \- Create and manipulate check-button widgets +

Synopsis

+

checkbutton pathName ?options? +

Standard Options

+ + +
+
activeBackground  bitmap              font        relief        
+activeForeground  borderWidth         foreground  text          
+anchor            cursor              padX        textVariable  
+background        disabledForeground  padY        
+
+ + +

See options, for more information. +

Arguments for Checkbutton

+ + +
+
:command
+

Name="command" Class="Command" +


+ +

Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is released over the button +window. The button’s global variable (:variable option) will +be updated before the command is invoked. +

+
+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies a desired height for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in lines of text. +If this option isn’t specified, the button’s desired height is computed +from the size of the bitmap or text being displayed in it. +

+
+ + +
+
:offvalue
+

Name="offValue" Class="Value" +


+ +

Specifies value to store in the button’s associated variable whenever +this button is deselected. Defaults to “0”. +

+
+ + +
+
:onvalue
+

Name="onValue" Class="Value" +


+ +

Specifies value to store in the button’s associated variable whenever +this button is selected. Defaults to “1”. +

+
+ + +
+
:selector
+

Name="selector" Class="Foreground" +


+ +

Specifies the color to draw in the selector when this button is +selected. +If specified as an empty string then no selector is +drawn for the button. +

+
+ + +
+
:state
+

Name="state" Class="State" +


+ +

Specifies one of three states for the check button: normal, active, +or disabled. In normal state the check button is displayed using the +foreground and background options. The active state is +typically used when the pointer is over the check button. In active state +the check button is displayed using the activeForeground and +activeBackground options. Disabled state means that the check button +is insensitive: it doesn’t activate and doesn’t respond to mouse +button presses. In this state the disabledForeground and +background options determine how the check button is displayed. +

+
+ + +
+
:variable
+

Name="variable" Class="Variable" +


+ +

Specifies name of global variable to set to indicate whether +or not this button is selected. Defaults to the name of the +button within its parent (i.e. the last element of the button +window’s path name). +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies a desired width for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in characters. +If this option isn’t specified, the button’s desired width is computed +from the size of the bitmap or text being displayed in it. +

+
+ +

Description

+ +

The checkbutton command creates a new window (given by the +pathName argument) and makes it into a check-button widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the check button such as its colors, font, +text, and initial relief. The checkbutton command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A check button is a widget +that displays a textual string or bitmap +and a square called a selector. +A check button has +all of the behavior of a simple button, including the +following: it can display itself in either of three different +ways, according to the state option; +it can be made to appear +raised, sunken, or flat; it can be made to flash; and it invokes +a Tcl command whenever mouse button 1 is clicked over the +check button. +

+

In addition, check buttons can be selected. If a check button is +selected then a special highlight appears in the selector, and +a Tcl variable associated with the check button is set to a particular +value (normally 1). If the check button is not selected, then +the selector is drawn in a different fashion and the associated +variable is set to a different value (typically 0). By default, +the name of the variable associated with a check button is the +same as the name used to create the check button. The +variable name, and the “on” and “off” values stored in it, +may be modified with options on the command line or in the option +database. By default a check button is configured to select and deselect +itself on alternate button clicks. +In addition, each check button monitors its associated variable and +automatically selects and deselects itself when the variables value +changes to and from the button’s “on” value. +

+

A Checkbutton Widget’s Arguments

+ +

The checkbutton command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for check button widgets: +

+
+
pathName :activate
+

Change the check button’s state to active and redisplay the button +using its active foreground and background colors instead of normal +colors. +This command is ignored if the check button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state active” instead. +

+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the checkbutton +command. +

+
pathName :deactivate
+

Change the check button’s state to normal and redisplay the button +using its normal foreground and background colors. +This command is ignored if the check button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state normal” instead. +

+
pathName :deselect
+

Deselect the check button: redisplay it without a highlight in +the selector and set the associated variable to its “off” +value. +

+
pathName :flash
+

Flash the check button. This is accomplished by redisplaying the check button +several times, alternating between active and normal colors. At +the end of the flash the check button is left in the same normal/active +state as when the command was invoked. +This command is ignored if the check button’s state is disabled. +

+
pathName :invoke
+

Does just what would have happened if the user invoked the check button +with the mouse: toggle the selection state of the button and invoke +the Tcl command associated with the check button, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the check button. +This command is ignored if the check button’s state is disabled. +

+
pathName :select
+

Select the check button: display it with a highlighted +selector and set the associated variable to its “on” +value. +

+
pathName :toggle
+

Toggle the selection state of the button, redisplaying it and +modifying its associated variable to reflect the new state. +

+
+
+

Bindings

+ +

Tk automatically creates class bindings for check buttons that give them +the following default behavior: +

    +
  • [1] +The check button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves the check button. +
  • [2] +The check button’s relief is changed to sunken whenever mouse button 1 is +pressed over it, and the relief is restored to its original +value when button 1 is later released. +
  • [3] +If mouse button 1 is pressed over the check button and later released over +the check button, the check button is invoked (i.e. its selection +state toggles and the command associated with the button is invoked, +if there is one). However, if the mouse is not +over the check button when button 1 is released, then no invocation occurs. +
+ +

If the check button’s state is disabled then none of the above +actions occur: the check button is completely non-responsive. +

+

The behavior of check buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +

+

Keywords

+

check button, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/destroy.html b/info/gcl-tk/destroy.html new file mode 100644 index 0000000..c23fe72 --- /dev/null +++ b/info/gcl-tk/destroy.html @@ -0,0 +1,68 @@ + + + + + +destroy (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.3 destroy

+ +

destroy \- Destroy one or more windows +

Synopsis

+

destroy ?window window ...? +

+

Description

+ +

This command deletes the windows given by the +window arguments, plus all of their descendants. +If a window “.” is deleted then the entire application +will be destroyed. +The windows are destroyed in order, and if an error occurs +in destroying a window the command aborts without destroying the +remaining windows. +

+

Keywords

+

application, destroy, window +

+ + + + diff --git a/info/gcl-tk/entry.html b/info/gcl-tk/entry.html new file mode 100644 index 0000000..3af2d59 --- /dev/null +++ b/info/gcl-tk/entry.html @@ -0,0 +1,332 @@ + + + + + +entry (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.10 entry

+ +

entry \- Create and manipulate entry widgets +

Synopsis

+

entry pathName ?options? +

Standard Options

+ + +
+
background      foreground        insertWidth       selectForeground 
+borderWidth     insertBackground  relief            textVariable     
+cursor          insertBorderWidth scrollCommand     
+exportSelection insertOffTime     selectBackground  
+font            insertOnTime      selectBorderWidth 
+
+ + +

See options, for more information. +

Arguments for Entry

+ + +
+
:state
+

Name="state" Class="State" +


+ +

Specifies one of two states for the entry: normal or disabled. +If the entry is disabled then the value may not be changed using widget +commands and no insertion cursor will be displayed, even if the input focus is +in the widget. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies an integer value indicating the desired width of the entry window, +in average-size characters of the widget’s font. +

+
+ +

Description

+ +

The entry command creates a new window (given by the +pathName argument) and makes it into an entry widget. +Additional options, described above, may be specified on the +command line or in the option database +to configure aspects of the entry such as its colors, font, +and relief. The entry command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

An entry is a widget that displays a one-line text string and +allows that string to be edited using widget commands described below, which +are typically bound to keystrokes and mouse actions. +When first created, an entry’s string is empty. +A portion of the entry may be selected as described below. +If an entry is exporting its selection (see the exportSelection +option), then it will observe the standard X11 protocols for handling the +selection; entry selections are available as type STRING. +Entries also observe the standard Tk rules for dealing with the +input focus. When an entry has the input focus it displays an +insertion cursor to indicate where new characters will be +inserted. +

+

Entries are capable of displaying strings that are too long to +fit entirely within the widget’s window. In this case, only a +portion of the string will be displayed; commands described below +may be used to change the view in the window. Entries use +the standard scrollCommand mechanism for interacting with +scrollbars (see the description of the scrollCommand option +for details). They also support scanning, as described below. +

+

A Entry Widget’s Arguments

+ +

The entry command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. +

+

Many of the widget commands for entries take one or more indices as +arguments. An index specifies a particular character in the entry’s +string, in any of the following ways: +

+
+
number
+

Specifies the character as a numerical index, where 0 corresponds +to the first character in the string. +

+
end
+

Indicates the character just after the last one in the entry’s string. +This is equivalent to specifying a numerical index equal to the length +of the entry’s string. +

+
insert
+

Indicates the character adjacent to and immediately following the +insertion cursor. +

+
sel.first
+

Indicates the first character in the selection. It is an error to +use this form if the selection isn’t in the entry window. +

+
sel.last
+

Indicates the last character in the selection. It is an error to +use this form if the selection isn’t in the entry window. +

+
@number
+

In this form, number is treated as an x-coordinate in the +entry’s window; the character spanning that x-coordinate is used. +For example, “@0” indicates the left-most character in the +window. +

+
+ + +

Abbreviations may be used for any of the forms above, e.g. “e” +or “sel.f”. In general, out-of-range indices are automatically +rounded to the nearest legal value. +

+

The following commands are possible for entry widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the entry +command. +

+
pathName :delete first ?last?
+

Delete one or more elements of the entry. First and last +are indices of of the first and last characters in the range to +be deleted. If last isn’t specified it defaults to +first, i.e. a single character is deleted. This command +returns an empty string. +

+
pathName :get
+

Returns the entry’s string. +

+
pathName :icursor index
+

Arrange for the insertion cursor to be displayed just before the character +given by index. Returns an empty string. +

+
pathName :index index
+

Returns the numerical index corresponding to index. +

+
pathName :insert index string
+

Insert the characters of string just before the character +indicated by index. Returns an empty string. +

+
pathName :scan option args
+

This command is used to implement scanning on entries. It has +two forms, depending on option: +

+
pathName :scan :mark x
+

Records x and the current view in the entry window; used in +conjunction with later scan dragto commands. Typically this +command is associated with a mouse button press in the widget. It +returns an empty string. +

+
pathName :scan :dragto x
+

This command computes the difference between its x argument +and the x argument to the last scan mark command for +the widget. It then adjusts the view left or right by 10 times the +difference in x-coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the entry at high speed through the window. The return +value is an empty string. +

+
+
+
pathName :select option arg
+

This command is used to adjust the selection within an entry. It +has several forms, depending on option: +

+
pathName :select :adjust index
+

Locate the end of the selection nearest to the character given by +index, and adjust that end of the selection to be at index +(i.e including but not going beyond index). The other +end of the selection is made the anchor point for future +select to commands. If the selection +isn’t currently in the entry, then a new selection is created to +include the characters between index and the most recent +selection anchor point, inclusive. +Returns an empty string. +

+
pathName :select :clear
+

Clear the selection if it is currently in this widget. If the +selection isn’t in this widget then the command has no effect. +Returns an empty string. +

+
pathName :select :from index
+

Set the selection anchor point to just before the character +given by index. Doesn’t change the selection. +Returns an empty string. +

+
pathName :select :to index
+

Set the selection to consist of the elements from the anchor +point to element index, inclusive. The anchor point is +determined by the most recent select from or select adjust +command in this widget. If the selection isn’t in this widget +then a new selection is created using the most recent anchor point +specified for the widget. Returns an empty string. +

+
+
+
pathName :view index
+

Adjust the view in the entry so that element index is +at the left edge of the window. Returns an empty string. +

+
+
+

"Default Bindings"

+ +

Tk automatically creates class bindings for entries that give them +the following default behavior: +

+
    +
  • [1] +Clicking mouse button 1 in an entry positions the insertion cursor +just before the character underneath the mouse cursor and sets the +input focus to this widget. +
  • [2] +Dragging with mouse button 1 strokes out a selection between +the insertion cursor and the character under the mouse. +
  • [3] +The ends of the selection can be adjusted by dragging with mouse +button 1 while the shift key is down; this will adjust the end +of the selection that was nearest to the mouse cursor when button +1 was pressed. +
  • [4] +The view in the entry can be adjusted by dragging with mouse button 2. +
  • [5] +If the input focus is in an entry widget and characters are typed on the +keyboard, the characters are inserted just before the insertion cursor. +
  • [6] +Control-h and the Backspace and Delete keys erase the character just +before the insertion cursor. +
  • [7] +Control-w erases the word just before the insertion cursor. +
  • [8] +Control-u clears the entry to an empty string. +
  • [9] +Control-v inserts the current selection just before the insertion cursor. +
  • [10] +Control-d deletes the selected characters; an error occurs if the selection +is not in this widget. +
+ +

If the entry is disabled using the state option, then the entry’s +view can still be adjusted and text in the entry can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. +

+

The behavior of entries can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +

+

Keywords

+

entry, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/exit.html b/info/gcl-tk/exit.html new file mode 100644 index 0000000..37cbe76 --- /dev/null +++ b/info/gcl-tk/exit.html @@ -0,0 +1,71 @@ + + + + + +exit (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.5 exit

+ +

exit \- Exit the process +

Synopsis

+

exit ?returnCode? +

+

Description

+ +

Terminate the process, returning returnCode (an integer) to the +system as the exit status. +If returnCode isn’t specified then it defaults +to 0. +This command replaces the Tcl command by the same name. +It is identical to Tcl’s exit command except that +before exiting it destroys all the windows managed by +the process. +This allows various cleanup operations to be performed, such +as removing application names from the global registry of applications. +

+

Keywords

+

exit, process +

+ + + + diff --git a/info/gcl-tk/focus.html b/info/gcl-tk/focus.html new file mode 100644 index 0000000..84ca0ec --- /dev/null +++ b/info/gcl-tk/focus.html @@ -0,0 +1,166 @@ + + + + + +focus (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.6 focus

+ +

focus \- Direct keyboard events to a particular window +

Synopsis

+

focus
+
focus window
+focus option ?arg arg ...? +

+

Description

+ +

The focus command is used to manage the Tk input focus. +At any given time, one window in an application is designated as +the focus window for that application; any key press or key release +events directed to any window in the application will be redirected +instead to the focus window. If there is no focus window for an +application then keyboard events are discarded. +Typically, windows that are prepared to deal with the focus +(e.g. entries and other widgets that display editable text) will +claim the focus when mouse button 1 is pressed in them. +When an application is created its main window is initially given +the focus. +

+

The focus command can take any of the following forms: +

+
+
focus
+

If invoked with no arguments, focus returns the path name of +the current focus window, or none if there is no focus window. +

+
focus window
+

If invoked with a single argument consisting of a window’s path +name, focus sets the input focus to that window. +The return value is an empty string. +

+
focus :default ?window?
+

If window is specified, it becomes the default focus window +(the window that receives the focus whenever the focus window is +deleted) and the command returns an empty string. +If window isn’t specified, the command returns the path name +of the current default focus window, or none if there is no +default. +Window may be specified as none to clear its existing +value. +The default window is initially none. +

+
focus :none
+

Clears the focus window, so that keyboard input to this application +will be discarded. +

+
+
+

"Focus Events"

+ +

Tk’s model of the input focus is different than X’s model, and the +focus window set with the focus command is not usually the +same as the X focus window. +Tk never explicitly changes the official X focus window. +It waits for the window manager to direct the X input focus to +and from the application’s top-level windows, and it intercepts +FocusIn and FocusOut events coming from the X +server to detect these changes. +All of the focus events received from X are discarded by Tk; they +never reach the application. +Instead, Tk generates a different stream of FocusIn and +FocusOut for the application. +This means that FocusIn and +and FocusOut events seen by the application will not obey the +conventions described in the documentation for Xlib. +

+

Tk applications receive two kinds of FocusIn and FocusOut +events, which can be distinguished by their detail fields. +Events with a detail of NotifyAncestor are directed +to the current focus window when it becomes active or inactive. +A window is the active focus whenever two conditions are +simultaneously true: (a) the window is the focus window for its +application, and (b) some top-level window in the application has +received the X focus. +When this happens Tk generates a FocusIn event for the focus +window with detail NotifyAncestor. +When a window loses the active focus (either because the window manager +removed the focus from the application or because the focus window changed +within the application) then it receives a FocusOut event +with detail NotifyAncestor. +

+

The events described above are directed to the application’s focus +window regardless of which top-level window within the application +has received the focus. +The second kind of focus event is provided for applications that +need to know which particular top-level window has the X focus. +Tk generates FocusIn and FocusOut events with detail +NotifyVirtual for top-level windows whenever they receive or +lose the X focus. +These events are generated regardless of which window in the +application has the Tk input focus. +They do not imply that keystrokes will be directed to the window +that receives the event; they simply indicate which top-level +window is active as far as the window manager is concerned. +If a top-level window is also the application’s focus window, +then it will receive both NotifyVirtual and NotifyAncestor +events when it receives or loses the X focus. +

+

Tk does not generate the hierarchical chains of FocusIn and +FocusOut events described in the Xlib documentation (e.g. +a window can get a FocusIn or FocusOut event without +all of its ancestors getting events too). +Furthermore, the mode field in focus events is always +NotifyNormal and the only values ever present in the +detail field are NotifyAncestor and NotifyVirtual. +

+

Keywords

+

events, focus, keyboard, top-level, window manager +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/frame.html b/info/gcl-tk/frame.html new file mode 100644 index 0000000..c7ac3eb --- /dev/null +++ b/info/gcl-tk/frame.html @@ -0,0 +1,173 @@ + + + + + +frame (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.12 frame

+ +

frame \- Create and manipulate frame widgets +

Synopsis

+

frame pathName ?:class className? ?options? +

Standard Options

+ + +
+
background             cursor             relief           
+borderWidth            geometry           
+
+ + +

See options, for more information. +

Arguments for Frame

+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies the desired height for the window in any of the forms +acceptable to Tk_GetPixels. +This option is only used if the :geometry option is +unspecified. +If this option is less than or equal to zero (and :geometry +is not specified) then the window will not request any size at +all. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies the desired width for the window in any of the forms +acceptable to Tk_GetPixels. +This option is only used if the :geometry option is +unspecified. +If this option is less than or equal to zero (and :geometry +is not specified) then the window will not request any size at +all. +

+
+ +

Description

+ +

The frame command creates a new window (given by the +pathName argument) and makes it into a frame widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the frame such as its background color +and relief. The frame command returns the +path name of the new window. +

+

A frame is a simple widget. Its primary purpose is to act as a +spacer or container for complex window layouts. The only features +of a frame are its background color and an optional 3-D border to make the +frame appear raised or sunken. +

+

In addition to the standard options listed above, a :class +option may be specified on the command line. If it is specified, then +the new widget’s class will be set to className instead of +Frame. Changing the class of a frame widget may be useful +in order to use a special class name in database options referring +to this widget and its children. Note: :class is handled +differently than other command-line options and cannot be specified +using the option database (it has to be processed +before the other options are even looked up, since the new class +name will affect the lookup of the other options). In addition, +the :class option may not be queried or changed using the +config command described below. +

+

A Frame Widget’s Arguments

+ +

The frame command creates a new Tcl command whose +name is the same as the path name of the frame’s window. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

PathName is the name of the command, which is the same as +the frame widget’s path name. Option and the args +determine the exact behavior of the command. The following +commands are possible for frame widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the frame +command. +

+
+
+

Bindings

+ +

When a new frame is created, it has no default event bindings: +frames are not intended to be interactive. +

+

Keywords

+

frame, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/grab.html b/info/gcl-tk/grab.html new file mode 100644 index 0000000..ed7dc94 --- /dev/null +++ b/info/gcl-tk/grab.html @@ -0,0 +1,166 @@ + + + + + +grab (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.7 grab

+ +

grab \- Confine pointer and keyboard events to a window sub-tree +

Synopsis

+

grab ?:global? window
+grab option ?arg arg ...? +

+

Description

+ +

This command implements simple pointer and keyboard grabs for Tk. +Tk’s grabs are different than the grabs +described in the Xlib documentation. +When a grab is set for a particular window, Tk restricts all pointer +events to the grab window and its descendants in Tk’s window hierarchy. +Whenever the pointer is within the grab window’s subtree, the pointer +will behave exactly the same as if there had been no grab at all +and all events will be reported in the normal fashion. +When the pointer is outside window’s tree, button presses and +releases and +mouse motion events are reported to window, and window entry +and window exit events are ignored. +The grab subtree “owns” the pointer: +windows outside the grab subtree will be visible on the screen +but they will be insensitive until the grab is released. +The tree of windows underneath the grab window can include top-level +windows, in which case all of those top-level windows +and their descendants will continue to receive mouse events +during the grab. +

+

Two forms of grabs are possible: local and global. +A local grab affects only the grabbing application: events will +be reported to other applications as if the grab had never occurred. +Grabs are local by default. +A global grab locks out all applications on the screen, +so that only the given subtree of the grabbing application will be +sensitive to pointer events (mouse button presses, mouse button releases, +pointer motions, window entries, and window exits). +During global grabs the window manager will not receive pointer +events either. +

+

During local grabs, keyboard events (key presses and key releases) +are delivered as usual: the window +manager controls which application receives keyboard events, and +if they are sent to any window in the grabbing application then they are +redirected to the focus window. +During a global grab Tk grabs the keyboard so that all keyboard events +are always sent to the grabbing application. +The focus command is still used to determine which window in the +application receives the keyboard events. +The keyboard grab is released when the grab is released. +

+

Grabs apply to particular displays. If an application has windows +on multiple displays then it can establish a separate grab on each +display. +The grab on a particular display affects only the windows on +that display. +It is possible for different applications on a single display to have +simultaneous local grabs, but only one application can have a global +grab on a given display at once. +

+

The grab command can take any of the following forms: +

+
+
grab ?:global? window
+

Same as grab :set, described below. +

+
grab :current ?window?
+

If window is specified, returns the name of the current grab +window in this application for window’s display, or an empty +string if there is no such window. +If window is omitted, the command returns a list whose elements +are all of the windows grabbed by this application for all displays, +or an empty string if the application has no grabs. +

+
grab :release window
+

Releases the grab on window if there is one, otherwise does +nothing. Returns an empty string. +

+
grab :set ?:global? window
+

Sets a grab on window. If :global is specified then the +grab is global, otherwise it is local. +If a grab was already in effect for this application on +window’s display then it is automatically released. +If there is already a grab on window and it has the same +global/local form as the requested grab, then the command +does nothing. Returns an empty string. +

+
grab :status window
+

Returns none if no grab is currently set on window, +local if a local grab is set on window, and +global if a global grab is set. +

+
+
+

Bugs

+ +

It took an incredibly complex and gross implementation to produce +the simple grab effect described above. +Given the current implementation, it isn’t safe for applications +to use the Xlib grab facilities at all except through the Tk grab +procedures. +If applications try to manipulate X’s grab mechanisms directly, +things will probably break. +

+

If a single process is managing several different Tk applications, +only one of those applications can have a local grab for a given +display at any given time. If the applications are in different +processes, this restriction doesn’t exist. +

+

Keywords

+

grab, keyboard events, pointer events, window +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/index.html b/info/gcl-tk/index.html new file mode 100644 index 0000000..b341073 --- /dev/null +++ b/info/gcl-tk/index.html @@ -0,0 +1,182 @@ + + + + + +Top (GCL TK Manual) + + + + + + + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: (dir)   [Contents]

+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
• General   +
• Widgets   +
• Control   +
+
+ — The Detailed Node Listing —
+
+General
+
+
• Introduction   +
• Getting Started   +
• Common Features of Widgets   +
• Return Values   +
• Argument Lists   +
• Lisp Functions Invoked from Graphics   +
• Linked Variables   +
• tkconnect   +
+
+Widgets
+
+
• button   +
• listbox   +
• scale   +
• canvas   +
• menu   +
• scrollbar   +
• checkbutton   +
• menubutton   +
• text   +
• entry   +
• message   +
• frame   +
• label   +
• radiobutton   +
• toplevel   +
+
+Control
+
+
• after   +
• bind   +
• destroy   +
• tk-dialog   +
• exit   +
• focus   +
• grab   +
• tk-listbox-single-select   +
• lower   +
• tk-menu-bar   +
• option   +
• options   +
• pack-old   +
• pack   +
• place   +
• raise   +
• selection   +
• send   +
• tk   +
• tkerror   +
• tkvars   +
• tkwait   +
• update   +
• winfo   +
• wm   +
+ + +
+
+

+Next: , Previous: , Up: (dir)   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/label.html b/info/gcl-tk/label.html new file mode 100644 index 0000000..1251625 --- /dev/null +++ b/info/gcl-tk/label.html @@ -0,0 +1,160 @@ + + + + + +label (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.13 label

+ +

label \- Create and manipulate label widgets +

Synopsis

+

label pathName ?options? +

Standard Options

+ + +
+
anchor           borderWidth     foreground     relief           
+background       cursor          padX           text             
+bitmap           font            padY           textVariable     
+
+ + +

See options, for more information. +

Arguments for Label

+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies a desired height for the label. +If a bitmap is being displayed in the label then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in lines of text. +If this option isn’t specified, the label’s desired height is computed +from the size of the bitmap or text being displayed in it. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies a desired width for the label. +If a bitmap is being displayed in the label then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in characters. +If this option isn’t specified, the label’s desired width is computed +from the size of the bitmap or text being displayed in it. +

+
+ +

Description

+ +

The label command creates a new window (given by the +pathName argument) and makes it into a label widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the label such as its colors, font, +text, and initial relief. The label command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A label is a widget +that displays a textual string or bitmap. +The label can be manipulated in a few simple ways, such as +changing its relief or text, using the commands described below. +

+

A Label Widget’s Arguments

+ +

The label command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for label widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the label +command. +

+
+
+

Bindings

+ +

When a new label is created, it has no default event bindings: +labels are not intended to be interactive. +

+

Keywords

+

label, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/listbox.html b/info/gcl-tk/listbox.html new file mode 100644 index 0000000..c21e652 --- /dev/null +++ b/info/gcl-tk/listbox.html @@ -0,0 +1,270 @@ + + + + + +listbox (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.2 listbox

+ +

listbox \- Create and manipulate listbox widgets +

Synopsis

+

listbox pathName ?options? +

Standard Options

+ + +
+
background       foreground  selectBackground   xScrollCommand  
+borderWidth      font        selectBorderWidth  yScrollCommand  
+cursor           geometry    selectForeground   
+exportSelection  relief      setGrid            
+
+ + +

See options, for more information. +

Arguments for Listbox

+ + +

None. +

+

Description

+ +

The listbox command creates a new window (given by the +pathName argument) and makes it into a listbox widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the listbox such as its colors, font, +text, and relief. The listbox command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A listbox is a widget that displays a list of strings, one per line. +When first created, a new listbox has no elements in its list. +Elements may be added or deleted using widget commands described +below. In addition, one or more elements may be selected as described +below. +If a listbox is exporting its selection (see exportSelection +option), then it will observe the standard X11 protocols +for handling the selection; listbox selections are available +as type STRING, consisting of a Tcl list with one entry +for each selected element. +

+

For large lists only a subset of the list elements will be +displayed in the listbox window at once; commands described below +may be used to change the view in the window. Listboxes allow +scrolling in both directions using the standard xScrollCommand +and yScrollCommand options. +They also support scanning, as described below. +

+

A Listbox’s Arguments

+ +

The listbox command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for listbox widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the listbox +command. +

+
pathName :curselection
+

Returns a list containing the indices of +all of the elements in the listbox that are currently selected. +If there are no elements selected in the listbox then an empty +string is returned. +

+
pathName :delete first ?last?
+

Delete one or more elements of the listbox. First and last +give the integer indices of the first and last elements in the range +to be deleted. If last isn’t specified it defaults to +first, i.e. a single element is deleted. An index of +0 corresponds to the first element in the listbox. Either +first or last may be specified as end, in which +case it refers to the last element of the listbox. This command +returns an empty string +

+
pathName :get index
+

Return the contents of the listbox element indicated by index. +Index must be a non-negative integer (0 corresponds to +the first element in the listbox), or it may also be specified as +end to indicate the last element in the listbox. +

+
pathName :insert index ?element element ...?
+

Insert zero or more new elements in the list just before the +element given by index. If index is specified as +end then the new elements are added to the end of the +list. Returns an empty string. +

+
pathName :nearest y
+

Given a y-coordinate within the listbox window, this command returns +the index of the (visible) listbox element nearest to that y-coordinate. +

+
pathName :scan option args
+

This command is used to implement scanning on listboxes. It has +two forms, depending on option: +

+
pathName :scan :mark x y
+

Records x and y and the current view in the listbox +window; used in conjunction with later scan dragto commands. +Typically this command is associated with a mouse button press in +the widget. It returns an empty string. +

+
pathName :scan :dragto x y.
+

This command computes the difference between its x and y +arguments and the x and y arguments to the last +scan mark command for the widget. +It then adjusts the view by 10 times the +difference in coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the list at high speed through the window. The return +value is an empty string. +

+
+
+
pathName :select option arg
+

This command is used to adjust the selection within a listbox. It +has several forms, depending on option. In all of the forms +the index end refers to the last element in the listbox. +

+
pathName :select :adjust index
+

Locate the end of the selection nearest to the element given by +index, and adjust that end of the selection to be at index +(i.e including but not going beyond index). The other +end of the selection is made the anchor point for future +select to commands. If the selection +isn’t currently in the listbox, then this command is identical to +the select from widget command. +Returns an empty string. +

+
pathName :select :clear
+

If the selection is in this listbox then it is cleared so that +none of the listbox’s elements are selected anymore. +

+
pathName :select :from index
+

Set the selection to consist of element index, and make +index the anchor point for future select to widget +commands. Returns an empty string. +

+
pathName :select :to index
+

Set the selection to consist of the elements from the anchor +point to element index, inclusive. The anchor point is +determined by the most recent select from or select adjust +command in this widget. If the selection isn’t in this widget, +this command is identical to select from. +Returns an empty string. +

+
+ +
+
pathName :size
+

Returns a decimal string indicating the total number of elements +in the listbox. +

+
pathName :xview index
+

Adjust the view in the listbox so that character position index +is displayed at the left edge of the widget. +Returns an empty string. +

+
pathName :yview index
+

Adjust the view in the listbox so that element index is +displayed at the top of the widget. +If index is specified as end it indicates the last +element of the listbox. Returns an empty string. +

+
+
+

"Default Bindings"

+ +

Tk automatically creates class bindings for listboxes that give them +the following default behavior: +

    +
  • [1] +When button 1 is pressed over a listbox, the element underneath the +mouse cursor is selected. The mouse can be dragged to select a +range of elements. +
  • [2] +The ends of the selection can be adjusted by dragging with mouse +button 1 while the shift key is down; this will adjust the end +of the selection that was nearest to the mouse cursor when button +1 was pressed. +
  • [3] +The view in the listbox can be adjusted by dragging with mouse button 2. +
+ +

The behavior of listboxes can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +In addition, the procedure tk_listboxSingleSelect may be +invoked to change listbox behavior so that only a single element +may be selected at once. +

+

Keywords

+

listbox, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/lower.html b/info/gcl-tk/lower.html new file mode 100644 index 0000000..3774fa2 --- /dev/null +++ b/info/gcl-tk/lower.html @@ -0,0 +1,72 @@ + + + + + +lower (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.9 lower

+ +

lower \- Change a window’s position in the stacking order +

Synopsis

+

lower window ?belowThis? +

+

Description

+ +

If the belowThis argument is omitted then the command lowers +window so that it is below all of its siblings in the stacking +order (it will be obscured by any siblings that overlap it and +will not obscure any siblings). +If belowThis is specified then it must be the path name of +a window that is either a sibling of window or the descendant +of a sibling of window. +In this case the lower command will insert +window into the stacking order just below belowThis +(or the ancestor of belowThis that is a sibling of window); +this could end up either raising or lowering window. +

+

Keywords

+

lower, obscure, stacking order +

+ + + + diff --git a/info/gcl-tk/menu.html b/info/gcl-tk/menu.html new file mode 100644 index 0000000..a1a61af --- /dev/null +++ b/info/gcl-tk/menu.html @@ -0,0 +1,529 @@ + + + + + +menu (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.5 menu

+ +

menu \- Create and manipulate menu widgets +

Synopsis

+

menu pathName ?options? +

Standard Options

+ + +
+
activeBackground       background       disabledForeground      
+activeBorderWidth      borderWidth      font                    
+activeForeground       cursor           foreground              
+
+ + +

See options, for more information. +

Arguments for Menu

+ + +
+
:postcommand
+

Name="postCommand" Class="Command" +


+ +

If this option is specified then it provides a Tcl command to execute +each time the menu is posted. The command is invoked by the post +widget command before posting the menu. +

+
+ + +
+
:selector
+

Name="selector" Class="Foreground" +


+ +

For menu entries that are check buttons or radio buttons, this option +specifies the color to display in the selector when the check button +or radio button is selected. +

+
+ +

Introduction

+ +

The menu command creates a new top-level window (given +by the pathName argument) and makes it into a menu widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the menu such as its colors and font. +The menu command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A menu is a widget that displays a collection of one-line entries arranged +in a column. There exist several different types of entries, +each with different properties. Entries of different types may be +combined in a single menu. Menu entries are not the same as +entry widgets. In fact, menu entries are not even distinct widgets; +the entire menu is one widget. +

+

Menu entries are displayed with up to three +separate fields. The main field is a label in the form of text or +a bitmap, which is determined by the :label or :bitmap +option for the entry. +If the :accelerator option is specified for an entry then a second +textual field is displayed to the right of the label. The accelerator +typically describes a keystroke sequence that may be typed in the +application to cause the same result as invoking the menu entry. +The third field is a selector. The selector is present only for +check-button or radio-button entries. It indicates whether the entry +is selected or not, and is displayed to the left of the entry’s +string. +

+

In normal use, an entry becomes active (displays itself differently) +whenever the mouse pointer is over the entry. If a mouse +button is released over the entry then the entry is invoked. +The effect of invocation is different for each type of entry; +these effects are described below in the sections on individual +entries. +

+

Entries may be disabled, which causes their labels +and accelerators to be displayed +with dimmer colors. A disabled entry cannot be activated or invoked. +Disabled entries may be re-enabled, at which point it becomes +possible to activate and invoke them again. +

+

Command Entries

+ +

The most common kind of menu entry is a command entry, which +behaves much like a button widget. When a command entry is +invoked, a Tcl command is executed. The Tcl +command is specified with the :command option. +

+

Separator Entries

+ +

A separator is an entry that is displayed as a horizontal dividing +line. A separator may not be activated or invoked, and it has +no behavior other than its display appearance. +

+

Check-Button Entries

+ +

A check-button menu entry behaves much like a check-button widget. +When it is invoked it toggles back and forth between the selected +and deselected states. When the entry is selected, a particular +value is stored in a particular global variable (as determined by +the :onvalue and :variable options for the entry); when +the entry is deselected another value (determined by the +:offvalue option) is stored in the global variable. +A selector box is displayed to the left of the label in a check-button +entry. If the entry is selected then the box’s center is displayed +in the color given by the selector option for the menu; +otherwise the box’s center is displayed in the background color for +the menu. If a :command option is specified for a check-button +entry, then its value is evaluated as a Tcl command each time the entry +is invoked; this happens after toggling the entry’s +selected state. +

+

Radio-Button Entries

+ +

A radio-button menu entry behaves much like a radio-button widget. +Radio-button entries are organized in groups of which only one +entry may be selected at a time. Whenever a particular entry +becomes selected it stores a particular value into a particular +global variable (as determined by the :value and +:variable options for the entry). This action +causes any previously-selected entry in the same group +to deselect itself. +Once an entry has become selected, any change to the entry’s +associated variable will cause the entry to deselect itself. +Grouping of radio-button entries is determined by their +associated variables: if two entries have the same associated +variable then they are in the same group. +A selector diamond is displayed to the left of the label in each +radio-button entry. If the entry is selected then the diamond’s +center is displayed in the color given by the selector option +for the menu; +otherwise the diamond’s center is displayed in the background color for +the menu. If a :command option is specified for a radio-button +entry, then its value is evaluated as a Tcl command each time the entry +is invoked; this happens after selecting the entry. +

+

Cascade Entries

+ +

A cascade entry is one with an associated menu (determined +by the :menu option). Cascade entries allow the construction +of cascading menus. When the entry is activated, the +associated menu is posted just to the right of the entry; +that menu remains posted until the higher-level menu is unposted or +until some other entry is activated in the higher-level menu. +The associated menu should normally be a child of the menu containing +the cascade entry, in order for menu traversal to work correctly. +

+

A cascade entry posts its associated menu by invoking a +Tcl command of the form +

+
+
menu :post x y
+
+ + +

where menu is the path name of the associated menu, x +and y are the root-window coordinates of the upper-right +corner of the cascade entry, and group is the name of the +menu’s group (as determined in its last post widget command). +The lower-level menu is unposted by executing a Tcl command with +the form +

+
+
menu:unpost
+

where menu is the name of the associated menu. +

+
+ +

If a :command option is specified for a cascade entry then it is +evaluated as a Tcl command each time the associated menu is posted (the +evaluation occurs before the menu is posted). +

+

A Menu Widget’s Arguments

+ +

The menu command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+

Option and the args +determine the exact behavior of the command. +

+
+ +

Many of the widget commands for a menu take as one argument an +indicator of which entry of the menu to operate on. These +indicators are called indexes and may be specified in +any of the following forms: +

+
+
number
+

Specifies the entry numerically, where 0 corresponds +to the top-most entry of the menu, 1 to the entry below it, and +so on. +

+
active
+

Indicates the entry that is currently active. If no entry is +active then this form is equivalent to none. This form may +not be abbreviated. +

+
last
+

Indicates the bottommost entry in the menu. If there are no +entries in the menu then this form is equivalent to none. +This form may not be abbreviated. +

+
none
+

Indicates “no entry at all”; this is used most commonly with +the activate option to deactivate all the entries in the +menu. In most cases the specification of none causes +nothing to happen in the widget command. +This form may not be abbreviated. +

+
@number
+

In this form, number is treated as a y-coordinate in the +menu’s window; the entry spanning that y-coordinate is used. +For example, “@0” indicates the top-most entry in the +window. If number is outside the range of the window +then this form is equivalent to none. +

+
pattern
+

If the index doesn’t satisfy one of the above forms then this +form is used. Pattern is pattern-matched against the label of +each entry in the menu, in order from the top down, until a +matching entry is found. The rules of Tcl_StringMatch +are used. +

+

The following widget commands are possible for menu widgets: +

+
pathName :activate index
+

Change the state of the entry indicated by index to active +and redisplay it using its active colors. +Any previously-active entry is deactivated. If index +is specified as none, or if the specified entry is +disabled, then the menu ends up with no active entry. +Returns an empty string. +

+
pathName :add type ?option value option value ...?
+

Add a new entry to the bottom of the menu. The new entry’s type +is given by type and must be one of cascade, +checkbutton, command, radiobutton, or separator, +or a unique abbreviation of one of the above. If additional arguments +are present, they specify any of the following options: +

+
+
:activebackground value
+

Specifies a background color to use for displaying this entry when it +is active. +If this option is specified as an empty string (the default), then the +activeBackground option for the overall menu is used. +This option is not available for separator entries. +

+
:accelerator value
+

Specifies a string to display at the right side of the menu entry. +Normally describes an accelerator keystroke sequence that may be +typed to invoke the same function as the menu entry. This option +is not available for separator entries. +

+
:background value
+

Specifies a background color to use for displaying this entry when it +is in the normal state (neither active nor disabled). +If this option is specified as an empty string (the default), then the +background option for the overall menu is used. +This option is not available for separator entries. +

+
:bitmap value
+

Specifies a bitmap to display in the menu instead of a textual +label, in any of the forms accepted by Tk_GetBitmap. +This option overrides the :label option but may be reset +to an empty string to enable a textual label to be displayed. +This option is not available for separator entries. +

+
:command value
+

For command, checkbutton, and radiobutton entries, specifies a +Tcl command to execute when the menu entry is invoked. +For cascade entries, specifies a Tcl command to execute +when the entry is activated (i.e. just before its submenu is +posted). +Not available for separator entries. +

+
:font value
+

Specifies the font to use when drawing the label or accelerator +string in this entry. +If this option is specified as an empty string (the default) then +the font option for the overall menu is used. +This option is not available for separator entries. +

+
:label value
+

Specifies a string to display as an identifying label in the menu +entry. Not available for separator entries. +

+
:menu value
+

Available only for cascade entries. Specifies the path name of +the menu associated with this entry. +

+
:offvalue value
+

Available only for check-button entries. Specifies the value to +store in the entry’s associated variable when the entry is +deselected. +

+
:onvalue value
+

Available only for check-button entries. Specifies the value to +store in the entry’s associated variable when the entry is selected. +

+
:state value
+

Specifies one of three states for the entry: normal, active, +or disabled. In normal state the entry is displayed using the +foreground option for the menu and the background +option from the entry or the menu. +The active state is typically used when the pointer is over the entry. +In active state the entry is displayed using the activeForeground +option for the menu along with the activebackground option from +the entry. +Disabled state means that the entry is insensitive: it doesn’t activate +and doesn’t respond to mouse button presses or releases. +In this state the entry is displayed according to the +disabledForeground option for the menu and the +background option from the entry. +This option is not available for separator entries. +

+
:underline value
+

Specifies the integer index of a character to underline in the entry. +This option is typically used to indicate keyboard traversal characters. +0 corresponds to the first character of the text displayed in the entry, +1 to the next character, and so on. +If a bitmap is displayed in the entry then this option is ignored. +This option is not available for separator entries. +

+
:value value
+

Available only for radio-button entries. Specifies the value to +store in the entry’s associated variable when the entry is selected. +

+
:variable value
+

Available only for check-button and radio-button entries. Specifies +the name of a global value to set when the entry is selected. +For check-button entries the variable is also set when the entry +is deselected. For radio-button entries, changing the variable +causes the currently-selected entry to deselect itself. +

+
+
+
+ +

The add widget command returns an empty string. +

+ +
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the menu +command. +

+
pathName :delete index1 ?index2?
+

Delete all of the menu entries between index1 and +index2 inclusive. +If index2 is omitted then it defaults to index1. +Returns an empty string. +

+
pathName :disable index
+

Change the state of the entry given by index to disabled +and redisplay the entry using its disabled colors. +Returns an empty string. +This command is obsolete and will eventually be removed; +use “pathName :entryconfigure index :state disabled” instead. +

+
pathName :enable index
+

Change the state of the entry given by index to normal +and redisplay the entry using its normal colors. +Returns an empty string. +This command is obsolete and will eventually be removed; +use “pathName :entryconfigure index :state normal” instead. +

+
pathName :entryconfigure index ?options?
+

This command is similar to the configure command, except that +it applies to the options for an individual entry, whereas configure +applies to the options for the menu as a whole. +Options may have any of the values accepted by the add +widget command. If options are specified, options are modified +as indicated +in the command and the command returns an empty string. +If no options are specified, returns a list describing +the current options for entry index (see Tk_ConfigureInfo for +information on the format of this list). +

+
pathName :index index
+

Returns the numerical index corresponding to index, or +none if index was specified as none. +

+
pathName :invoke index
+

Invoke the action of the menu entry. See the sections on the +individual entries above for details on what happens. If the +menu entry is disabled then nothing happens. If the +entry has a command associated with it then the result of that +command is returned as the result of the invoke widget +command. Otherwise the result is an empty string. Note: invoking +a menu entry does not automatically unpost the menu. Normally +the associated menubutton will take care of unposting the menu. +

+
pathName :post x y
+

Arrange for the menu to be displayed on the screen at the root-window +coordinates given by x and y. These coordinates are +adjusted if necessary to guarantee that the entire menu is visible on +the screen. This command normally returns an empty string. +If the :postcommand option has been specified, then its value is +executed as a Tcl script before posting the menu and the result of +that script is returned as the result of the post widget +command. +If an error returns while executing the command, then the error is +returned without posting the menu. +

+
pathName :unpost
+

Unmap the window so that it is no longer displayed. If a +lower-level cascaded menu is posted, unpost that menu. Returns an +empty string. +

+
pathName :yposition index
+

Returns a decimal string giving the y-coordinate within the menu +window of the topmost pixel in the entry specified by index. +

+ +
+
+

Default Bindings

+ + +

Tk automatically creates class bindings for menus that give them +the following default behavior: +

    +
  • [1] +When the mouse cursor enters a menu, the entry underneath the mouse +cursor is activated; as the mouse moves around the menu, the active +entry changes to track the mouse. +
  • [2] +When button 1 is released over a menu, the active entry (if any) is invoked. +
  • [3] +A menu can be repositioned on the screen by dragging it with mouse +button 2. +
  • [4] +A number of other bindings are created to support keyboard menu traversal. +See the manual entry for tk_bindForTraversal for details on these +bindings. +
+ +

Disabled menu entries are non-responsive: they don’t activate and +ignore mouse button presses and releases. +

+

The behavior of menus can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +

+

Bugs

+ +

At present it isn’t possible to use the +option database to specify values for the options to individual +entries. +

+

Keywords

+

menu, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/menubutton.html b/info/gcl-tk/menubutton.html new file mode 100644 index 0000000..315e6e4 --- /dev/null +++ b/info/gcl-tk/menubutton.html @@ -0,0 +1,262 @@ + + + + + +menubutton (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.8 menubutton

+ +

menubutton \- Create and manipulate menubutton widgets +

Synopsis

+

menubutton pathName ?options? +

Standard Options

+ + +
+
activeBackground  bitmap              font        relief        
+activeForeground  borderWidth         foreground  text          
+anchor            cursor              padX        textVariable  
+background        disabledForeground  padY        underline     
+
+ + +

See options, for more information. +

Arguments for Menubutton

+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies a desired height for the menu button. +If a bitmap is being displayed in the menu button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in lines of text. +If this option isn’t specified, the menu button’s desired height is computed +from the size of the bitmap or text being displayed in it. +

+
+ + +
+
:menu
+

Name="menu" Class="MenuName" +


+ +

Specifies the path name of the menu associated with this menubutton. +The menu must be a descendant of the menubutton in order for normal pull-down +operation to work via the mouse. +

+
+ + +
+
:state
+

Name="state" Class="State" +


+ +

Specifies one of three states for the menu button: normal, active, +or disabled. In normal state the menu button is displayed using the +foreground and background options. The active state is +typically used when the pointer is over the menu button. In active state +the menu button is displayed using the activeForeground and +activeBackground options. Disabled state means that the menu button +is insensitive: it doesn’t activate and doesn’t respond to mouse +button presses. In this state the disabledForeground and +background options determine how the button is displayed. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies a desired width for the menu button. +If a bitmap is being displayed in the menu button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in characters. +If this option isn’t specified, the menu button’s desired width is computed +from the size of the bitmap or text being displayed in it. +

+
+ +

Introduction

+ +

The menubutton command creates a new window (given by the +pathName argument) and makes it into a menubutton widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the menubutton such as its colors, font, +text, and initial relief. The menubutton command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A menubutton is a widget that displays a +textual string or bitmap +and is associated with a menu widget. In normal usage, pressing +mouse button 1 over the menubutton causes the associated menu to +be posted just underneath the menubutton. If the mouse is moved over +the menu before releasing the mouse button, the button release +causes the underlying menu entry to be invoked. When the button +is released, the menu is unposted. +

+

Menubuttons are typically organized into groups called menu bars +that allow scanning: +if the mouse button is pressed over one menubutton (causing it +to post its menu) and the mouse is moved over another menubutton +in the same menu bar without releasing the mouse button, then the +menu of the first menubutton is unposted and the menu of the +new menubutton is posted instead. +The tk-menu-bar procedure is used to set up menu bars for +scanning; see that procedure for more details. +

+

A Menubutton Widget’s Arguments

+ +

The menubutton command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for menubutton widgets: +

+
+
pathName :activate
+

Change the menu button’s state to active and redisplay the menu +button using its active foreground and background colors instead of normal +colors. +The command returns an empty string. +This command is ignored if the menu button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state active” instead. +

+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the menubutton +command. +

+
pathName :deactivate
+

Change the menu button’s state to normal and redisplay the menu +button using its normal foreground and background colors. +The command returns an empty string. +This command is ignored if the menu button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state normal” instead. +

+
+
+

"Default Bindings"

+ + +

Tk automatically creates class bindings for menu buttons that give them +the following default behavior: +

    +
  • [1] +A menu button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves it. +
  • [2] +A menu button’s relief is changed to raised whenever mouse button 1 is +pressed over it, and the relief is restored to its original value +when button 1 is later released or the mouse is dragged into another +menu button in the same menu bar. +
  • [3] +When mouse button 1 is pressed over a menu button, or when the mouse +is dragged into a menu button with mouse button 1 pressed, the associated +menu is posted; the mouse can be dragged across the menu and released +over an entry in the menu to invoke that entry. The menu is unposted +when button 1 is released outside either the menu or the menu button. +The menu is also unposted when the mouse is dragged into another +menu button in the same menu bar. +
  • [4] +If mouse button 1 is pressed and released within the menu button, +then the menu stays posted and keyboard traversal is possible as +described in the manual entry for tk-menu-bar. +
  • [5] +Menubuttons may also be posted by typing characters on the keyboard. +See the manual entry for tk-menu-bar for full details on keyboard +menu traversal. +
  • [6] +If mouse button 2 is pressed over a menu button then the associated +menu is posted and also torn off: it can then be dragged around on +the screen with button 2 and the menu will not automatically unpost when +entries in it are invoked. +To close a torn off menu, click mouse button 1 over the associated +menu button. +
+ +

If the menu button’s state is disabled then none of the above +actions occur: the menu button is completely non-responsive. +

+

The behavior of menu buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +

+

Keywords

+

menubutton, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/message.html b/info/gcl-tk/message.html new file mode 100644 index 0000000..f76bee0 --- /dev/null +++ b/info/gcl-tk/message.html @@ -0,0 +1,217 @@ + + + + + +message (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.11 message

+ +

message \- Create and manipulate message widgets +

Synopsis

+

message pathName ?options? +

Standard Options

+ + +
+
anchor            cursor          padX        text              
+background        font            padY        textVariable      
+borderWidth       foreground      relief      width             
+
+ + +

See options, for more information. +

Arguments for Message

+ + +
+
:aspect
+

Name="aspect" Class="Aspect" +


+ +

Specifies a non-negative integer value indicating desired +aspect ratio for the text. The aspect ratio is specified as +100*width/height. 100 means the text should +be as wide as it is tall, 200 means the text should +be twice as wide as it is tall, 50 means the text should +be twice as tall as it is wide, and so on. +Used to choose line length for text if width option +isn’t specified. +Defaults to 150. +

+
+ + +
+
:justify
+

Name="justify" Class="Justify" +


+ +

Specifies how to justify lines of text. +Must be one of left, center, or right. Defaults +to left. +This option works together with the anchor, aspect, +padX, padY, and width options to provide a variety +of arrangements of the text within the window. +The aspect and width options determine the amount of +screen space needed to display the text. +The anchor, padX, and padY options determine where this +rectangular area is displayed within the widget’s window, and the +justify option determines how each line is displayed within that +rectangular region. +For example, suppose anchor is e and justify is +left, and that the message window is much larger than needed +for the text. +The the text will displayed so that the left edges of all the lines +line up and the right edge of the longest line is padX from +the right side of the window; the entire text block will be centered +in the vertical span of the window. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies the length of lines in the window. +The value may have any of the forms acceptable to Tk_GetPixels. +If this option has a value greater than zero then the aspect +option is ignored and the width option determines the line +length. +If this option has a value less than or equal to zero, then +the aspect option determines the line length. +

+
+ +

Description

+ +

The message command creates a new window (given by the +pathName argument) and makes it into a message widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the message such as its colors, font, +text, and initial relief. The message command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A message is a widget that displays a textual string. A message +widget has three special features. First, it breaks up +its string into lines in order to produce a given aspect ratio +for the window. The line breaks are chosen at word boundaries +wherever possible (if not even a single word would fit on a +line, then the word will be split across lines). Newline characters +in the string will force line breaks; they can be used, for example, +to leave blank lines in the display. +

+

The second feature of a message widget is justification. The text +may be displayed left-justified (each line starts at the left side of +the window), centered on a line-by-line basis, or right-justified +(each line ends at the right side of the window). +

+

The third feature of a message widget is that it handles control +characters and non-printing characters specially. Tab characters +are replaced with enough blank space to line up on the next +8-character boundary. Newlines cause line breaks. Other control +characters (ASCII code less than 0x20) and characters not defined +in the font are displayed as a four-character sequence \fB\exhh where +hh is the two-digit hexadecimal number corresponding to +the character. In the unusual case where the font doesn’t contain +all of the characters in “0123456789abcdef\ex” then control +characters and undefined characters are not displayed at all. +

+

A Message Widget’s Arguments

+ +

The message command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for message widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the message +command. +

+
+
+

"Default Bindings"

+ +

When a new message is created, it has no default event bindings: +messages are intended for output purposes only. +

+

Bugs

+ +

Tabs don’t work very well with text that is centered or right-justified. +The most common result is that the line is justified wrong. +

+

Keywords

+

message, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/option.html b/info/gcl-tk/option.html new file mode 100644 index 0000000..6531ef2 --- /dev/null +++ b/info/gcl-tk/option.html @@ -0,0 +1,137 @@ + + + + + +option (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.11 option

+ +

option \- Add/retrieve window options to/from the option database +

Synopsis

+

option :add pattern value ?priority? +


+

option :clear +


+

option :get window name class +


+

option :readfile fileName ?priority? +

+

Description

+ +

The option command allows you to add entries to the Tk option +database or to retrieve options from the database. The add +form of the command adds a new option to the database. +Pattern contains +the option being specified, and consists of names and/or classes +separated by asterisks or dots, in the usual X format. Value +contains a text string to associate with pattern; this is the +value that will be returned in calls to Tk_GetOption or by +invocations of the option :get command. If priority +is specified, it indicates the priority level for this option (see +below for legal values); it defaults to interactive. +This command always returns an empty string. +

+

The option :clear command clears the option database. Default +options (in the +RESOURCE_MANAGER property or the .Xdefaults +file) will be reloaded automatically the next time an +option is added to the database or removed from it. This command +always returns an empty string. +

+

The option :get command returns the value of the option +specified for window +under name and class. If several entries in the option +database match window, name, and class, then +the command returns whichever was created with highest +priority level. If there are several matching +entries at the same priority level, then it returns whichever entry +was most recently entered into the option database. If there are +no matching entries, then the empty string is returned. +

+

The readfile form of the command reads fileName, +which should have the standard format for an +X resource database such as .Xdefaults, and adds all the +options specified in that file to the option database. If priority +is specified, it indicates the priority level at which to enter the +options; priority defaults to interactive. +

+

The priority arguments to the option command are +normally specified symbolically using one of the following values: +

+
+
widgetDefault
+

Level 20. Used for default values hard-coded into widgets. +

+
startupFile
+

Level 40. Used for options specified in application-specific +startup files. +

+
userDefault
+

Level 60. Used for options specified in user-specific defaults +files, such as .Xdefaults, resource databases loaded into +the X server, or user-specific startup files. +

+
interactive
+

Level 80. Used for options specified interactively after the application +starts running. If priority isn’t specified, it defaults to +this level. +

+
+ + +

Any of the above keywords may be abbreviated. In addition, priorities +may be specified numerically using integers between 0 and 100, +inclusive. The numeric form is probably a bad idea except for new priority +levels other than the ones given above. +

+

Keywords

+

database, option, priority, retrieve +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/options.html b/info/gcl-tk/options.html new file mode 100644 index 0000000..16665cf --- /dev/null +++ b/info/gcl-tk/options.html @@ -0,0 +1,653 @@ + + + + + +options (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.12 options

+ +

options \- Standard options supported by widgets +

+

Description

+

This manual entry describes the common configuration options supported +by widgets in the Tk toolkit. Every widget does not necessarily support +every option (see the manual entries for individual widgets for a list +of the standard options supported by that widget), but if a widget does +support an option with one of the names listed below, then the option +has exactly the effect described below. +

+

In the descriptions below, +“Name” refers to the option’s name in the option database (e.g. +in .Xdefaults files). “Class” refers to the option’s class value +in the option database. “Command-Line Switch” refers to the +switch used in widget-creation and configure widget commands to +set this value. For example, if an option’s command-line switch is +:foreground and there exists a widget .a.b.c, then the +command +

+
+
+
+(.a.b.c  :configure  :foreground "black")
+
+ +

may be used to specify the value black for the option in the +the widget .a.b.c. Command-line switches may be abbreviated, +as long as the abbreviation is unambiguous. +

+ +
+
:activebackground
+

Name="activeBackground" Class="Foreground" +


+ +

Specifies background color to use when drawing active elements. +An element (a widget or portion of a widget) is active if the +mouse cursor is positioned over the element and pressing a mouse button +will cause some action to occur. +

+
+ + +
+
:activeborderwidth
+

Name="activeBorderWidth" Class="BorderWidth" +


+ +

Specifies a non-negative value indicating +the width of the 3-D border drawn around active elements. See above for +definition of active elements. +The value may have any of the forms acceptable to Tk_GetPixels. +This option is typically only available in widgets displaying more +than one element at a time (e.g. menus but not buttons). +

+
+ + +
+
:activeforeground
+

Name="activeForeground" Class="Background" +


+ +

Specifies foreground color to use when drawing active elements. +See above for definition of active elements. +

+
+ + +
+
:anchor
+

Name="anchor" Class="Anchor" +


+ +

Specifies how the information in a widget (e.g. text or a bitmap) +is to be displayed in the widget. +Must be one of the values n, ne, e, se, +s, sw, w, nw, or center. +For example, nw means display the information such that its +top-left corner is at the top-left corner of the widget. +

+
+ + +
+
:background or :bg
+

Name="background" Class="Background" +


+ +

Specifies the normal background color to use when displaying the +widget. +

+
+ + +
+
:bitmap
+

Name="bitmap" Class="Bitmap" +


+ +

Specifies a bitmap to display in the widget, in any of the forms +acceptable to Tk_GetBitmap. +The exact way in which the bitmap is displayed may be affected by +other options such as anchor or justify. +Typically, if this option is specified then it overrides other +options that specify a textual value to display in the widget; +the bitmap option may be reset to an empty string to re-enable +a text display. +

+
+ + +
+
:borderwidth or :bd
+

Name="borderWidth" Class="BorderWidth" +


+ +

Specifies a non-negative value indicating the width +of the 3-D border to draw around the outside of the widget (if such a +border is being drawn; the relief option typically determines +this). The value may also be used when drawing 3-D effects in the +interior of the widget. +The value may have any of the forms acceptable to Tk_GetPixels. +

+
+ + +
+
:cursor
+

Name="cursor" Class="Cursor" +


+ +

Specifies the mouse cursor to be used for the widget. +The value may have any of the forms acceptable to Tk_GetCursor. +

+
+ + +
+
:cursorbackground
+

Name="cursorBackground" Class="Foreground" +


+ +

Specifies the color to use as background in the area covered by the +insertion cursor. This color will normally override either the normal +background for the widget (or the selection background if the insertion +cursor happens to fall in the selection). +\fIThis option is obsolete and is gradually being replaced by +the insertBackground option. +

+
+ + +
+
:cursorborderwidth
+

Name="cursorBorderWidth" Class="BorderWidth" +


+ +

Specifies a non-negative value indicating the width +of the 3-D border to draw around the insertion cursor. +The value may have any of the forms acceptable to Tk_GetPixels. +\fIThis option is obsolete and is gradually being replaced by +the insertBorderWidth option. +

+
+ + +
+
:cursorofftime
+

Name="cursorOffTime" Class="OffTime" +


+ +

Specifies a non-negative integer value indicating the number of +milliseconds the cursor should remain “off” in each blink cycle. +If this option is zero then the cursor doesn’t blink: it is on +all the time. +\fIThis option is obsolete and is gradually being replaced by +the insertOffTime option. +

+
+ + +
+
:cursorontime
+

Name="cursorOnTime" Class="OnTime" +


+ +

Specifies a non-negative integer value indicating the number of +milliseconds the cursor should remain “on” in each blink cycle. +\fIThis option is obsolete and is gradually being replaced by +the insertOnTime option. +

+
+ + +
+
:cursorwidth
+

Name="cursorWidth" Class="CursorWidth" +


+ +

Specifies a value indicating the total width of the insertion cursor. +The value may have any of the forms acceptable to Tk_GetPixels. +If a border has been specified for +the cursor (using the cursorBorderWidth option), the border +will be drawn inside the width specified by the cursorWidth +option. +\fIThis option is obsolete and is gradually being replaced by +the insertWidth option. +

+
+ + +
+
:disabledforeground
+

Name="disabledForeground" Class="DisabledForeground" +


+ +

Specifies foreground color to use when drawing a disabled element. +If the option is specified as an empty string (which is typically the +case on monochrome displays), disabled elements are drawn with the +normal fooreground color but they are dimmed by drawing them +with a stippled fill pattern. +

+
+ + +
+
:exportselection
+

Name="exportSelection" Class="ExportSelection" +


+ +

Specifies whether or not a selection in the widget should also be +the X selection. +The value may have any of the forms accepted by Tcl_GetBoolean, +such as true, false, 0, 1, yes, or no. +If the selection is exported, then selecting in the widget deselects +the current X selection, selecting outside the widget deselects any +widget selection, and the widget will respond to selection retrieval +requests when it has a selection. The default is usually for widgets +to export selections. +

+
+ + +
+
:font
+

Name="font" Class="Font" +


+ +

Specifies the font to use when drawing text inside the widget. +

+
+ + +
+
:foreground or :fg
+

Name="foreground" Class="Foreground" +


+ +

Specifies the normal foreground color to use when displaying the widget. +

+
+ + +
+
:geometry
+

Name="geometry" Class="Geometry" +


+ +

Specifies the desired geometry for the widget’s window, in the +form widthxheight, where width is the desired +width of the window and height is the desired height. The +units for width and height depend on the particular +widget. For widgets displaying text the units are usually the +size of the characters in the font being displayed; for other +widgets the units are usually pixels. +

+
+ + +
+
:insertbackground
+

Name="insertBackground" Class="Foreground" +


+ +

Specifies the color to use as background in the area covered by the +insertion cursor. This color will normally override either the normal +background for the widget (or the selection background if the insertion +cursor happens to fall in the selection). +

+
+ + +
+
:insertborderwidth
+

Name="insertBorderWidth" Class="BorderWidth" +


+ +

Specifies a non-negative value indicating the width +of the 3-D border to draw around the insertion cursor. +The value may have any of the forms acceptable to Tk_GetPixels. +

+
+ + +
+
:insertofftime
+

Name="insertOffTime" Class="OffTime" +


+ +

Specifies a non-negative integer value indicating the number of +milliseconds the insertion cursor should remain “off” in each blink cycle. +If this option is zero then the cursor doesn’t blink: it is on +all the time. +

+
+ + +
+
:insertontime
+

Name="insertOnTime" Class="OnTime" +


+ +

Specifies a non-negative integer value indicating the number of +milliseconds the insertion cursor should remain “on” in each blink cycle. +

+
+ + +
+
:insertwidth
+

Name="insertWidth" Class="InsertWidth" +


+ +

Specifies a value indicating the total width of the insertion cursor. +The value may have any of the forms acceptable to Tk_GetPixels. +If a border has been specified for the insertion +cursor (using the insertBorderWidth option), the border +will be drawn inside the width specified by the insertWidth +option. +

+
+ + +
+
:orient
+

Name="orient" Class="Orient" +


+ +

For widgets that can lay themselves out with either a horizontal +or vertical orientation, such as scrollbars, this option specifies +which orientation should be used. Must be either horizontal +or vertical or an abbreviation of one of these. +

+
+ + +
+
:padx
+

Name="padX" Class="Pad" +


+ +

Specifies a non-negative value indicating how much extra space +to request for the widget in the X-direction. +The value may have any of the forms acceptable to Tk_GetPixels. +When computing how large a window it needs, the widget will +add this amount to the width it would normally need (as determined +by the width of the things displayed in the widget); if the geometry +manager can satisfy this request, the widget will end up with extra +internal space to the left and/or right of what it displays inside. +

+
+ + +
+
:pady
+

Name="padY" Class="Pad" +


+ +

Specifies a non-negative value indicating how much extra space +to request for the widget in the Y-direction. +The value may have any of the forms acceptable to Tk_GetPixels. +When computing how large a window it needs, the widget will add +this amount to the height it would normally need (as determined by +the height of the things displayed in the widget); if the geometry +manager can satisfy this request, the widget will end up with extra +internal space above and/or below what it displays inside. +

+
+ + +
+
:relief
+

Name="relief" Class="Relief" +


+ +

Specifies the 3-D effect desired for the widget. Acceptable +values are raised, sunken, flat, ridge, +and groove. +The value +indicates how the interior of the widget should appear relative +to its exterior; for example, raised means the interior of +the widget should appear to protrude from the screen, relative to +the exterior of the widget. +

+
+ + +
+
:repeatdelay
+

Name="repeatDelay" Class="RepeatDelay" +


+ +

Specifies the number of milliseconds a button or key must be held +down before it begins to auto-repeat. Used, for example, on the +up- and down-arrows in scrollbars. +

+
+ + +
+
:repeatinterval
+

Name="repeatInterval" Class="RepeatInterval" +


+ +

Used in conjunction with repeatDelay: once auto-repeat +begins, this option determines the number of milliseconds between +auto-repeats. +

+
+ + +
+
:scrollcommand
+

Name="scrollCommand" Class="ScrollCommand" +


+ +

Specifies the prefix for a command used to communicate with scrollbar +widgets. When the view in the widget’s window changes (or +whenever anything else occurs that could change the display in a +scrollbar, such as a change in the total size of the widget’s +contents), the widget will +generate a Tcl command by concatenating the scroll command and four +numbers. The four numbers are, in order: the total size of the +widget’s contents, in unspecified units +(“unit” is a widget-specific term; for widgets +displaying text, the unit is a line); the maximum number of units that +may be displayed at once in the widget’s window, given its current size; the +index of the top-most or left-most unit currently visible in the window +(index 0 corresponds to the first unit); and the index of the bottom-most +or right-most unit currently visible in the window. This command is +then passed to the Tcl interpreter for execution. Typically the +scrollCommand option consists of the path name of a scrollbar +widget followed by “set”, e.g. “.x.scrollbar set”: this will cause +the scrollbar to be updated whenever the view in the window changes. +If this option is not specified, then no command will be executed. +

+

The scrollCommand option is used for widgets that support scrolling +in only one direction. +For widgets that support scrolling in both directions, this +option is replaced with the xScrollCommand and yScrollCommand +options. +

+
+ + +
+
:selectbackground
+

Name="selectBackground" Class="Foreground" +


+ +

Specifies the background color to use when displaying selected +items. +

+
+ + +
+
:selectborderwidth
+

Name="selectBorderWidth" Class="BorderWidth" +


+ +

Specifies a non-negative value indicating the width +of the 3-D border to draw around selected items. +The value may have any of the forms acceptable to Tk_GetPixels. +

+
+ + +
+
:selectforeground
+

Name="selectForeground" Class="Background" +


+ +

Specifies the foreground color to use when displaying selected +items. +

+
+ + +
+
:setgrid
+

Name="setGrid" Class="SetGrid" +


+ +

Specifies a boolean value that determines whether this widget controls the +resizing grid for its top-level window. +This option is typically used in text widgets, where the information +in the widget has a natural size (the size of a character) and it makes +sense for the window’s dimensions to be integral numbers of these units. +These natural window sizes form a grid. +If the setGrid option is set to true then the widget will +communicate with the window manager so that when the user interactively +resizes the top-level window that contains the widget, the dimensions of +the window will be displayed to the user in grid units and the window +size will be constrained to integral numbers of grid units. +See the section GRIDDED GEOMETRY MANAGEMENT in the wm manual +entry for more details. +

+
+ + +
+
:text
+

Name="text" Class="Text" +


+ +

Specifies a string to be displayed inside the widget. The way in which +the string is displayed depends on the particular widget and may be +determined by other options, such as anchor or justify. +

+
+ + +
+
:textvariable
+

Name="textVariable" Class="Variable" +


+ +

Specifies the name of a variable. The value of the variable is a text +string to be displayed inside the widget; if the variable value changes +then the widget will automatically update itself to reflect the new value. +The way in which the string is displayed in the widget depends on the +particular widget and may be determined by other options, such as +anchor or justify. +

+
+ + +
+
:underline
+

Name="underline" Class="Underline" +


+ +

Specifies the integer index of a character to underline in the widget. +This option is typically used to indicate keyboard traversal characters +in menu buttons and menu entries. 0 corresponds to the first character +of the text displayed in the widget, 1 to the next character, and so +on. +

+
+ + +
+
:xscrollcommand
+

Name="xScrollCommand" Class="ScrollCommand" +


+ +

Specifies the prefix for a command used to communicate with horizontal +scrollbars. This option is treated in the same way as the +scrollCommand option, except that it is used for horizontal +scrollbars associated with widgets that support both horizontal +and vertical scrolling. +See the description of scrollCommand for complete details +on how this option is used. +

+
+ + +
+
:yscrollcommand
+

Name="yScrollCommand" Class="ScrollCommand" +


+ +

Specifies the prefix for a command used to communicate with vertical +scrollbars. This option is treated in the same way as the +scrollCommand option, except that it is used for vertical +scrollbars associated with widgets that support both horizontal +and vertical scrolling. +See the description of scrollCommand for complete details +on how this option is used. +

+
+
+

Keywords

+

class, name, standard option, switch +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/pack.html b/info/gcl-tk/pack.html new file mode 100644 index 0000000..0e5f925 --- /dev/null +++ b/info/gcl-tk/pack.html @@ -0,0 +1,318 @@ + + + + + +pack (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.14 pack

+ +

pack \- Geometry manager that packs around edges of cavity +

Synopsis

+

pack option arg ?arg ...? +

+

Description

+ +

The pack command is used to communicate with the packer, +a geometry manager that arranges the children of a parent by +packing them in order around the edges of the parent. +The pack command can have any of several forms, depending +on the option argument: +

+
+
pack slave ?slave ...? ?options?
+

If the first argument to pack is a window name (any value +starting with “.”), then the command is processed in the same +way as pack configure. +

+
pack configure slave ?slave ...? ?options?
+

The arguments consist of the names of one or more slave windows +followed by pairs of arguments that specify how +to manage the slaves. +See “THE PACKER ALGORITHM” below for details on how the options +are used by the packer. +The following options are supported: +

+
:after other
+

Other must the name of another window. +Use its master as the master for the slaves, and insert +the slaves just after other in the packing order. +

+
:anchor anchor
+

Anchor must be a valid anchor position such as n +or sw; it specifies where to position each slave in its +parcel. +Defaults to center. +

+
:before other
+

Other must the name of another window. +Use its master as the master for the slaves, and insert +the slaves just before other in the packing order. +

+
:expand boolean
+

Specifies whether the slaves should be expanded to consume +extra space in their master. +Boolean may have any proper boolean value, such as 1 +or no. +Defaults to 0. +

+
:fill style
+

If a slave’s parcel is larger than its requested dimensions, this +option may be used to stretch the slave. +Style must have one of the following values: +

+
none
+

Give the slave its requested dimensions plus any internal padding +requested with :ipadx or :ipady. This is the default. +

+
x
+

Stretch the slave horizontally to fill the entire width of its +parcel (except leave external padding as specified by :padx). +

+
y
+

Stretch the slave vertically to fill the entire height of its +parcel (except leave external padding as specified by :pady). +

+
both
+

Stretch the slave both horizontally and vertically. +

+
+
+
:in other
+

Insert the slave(s) at the end of the packing order for the master +window given by other. +

+
:ipadx amount
+

Amount specifies how much horizontal internal padding to +leave on each side of the slave(s). +Amount must be a valid screen distance, such as 2 or .5c. +It defaults to 0. +

+
:ipady amount
+

Amount specifies how much vertical internal padding to +leave on each side of the slave(s). +Amount defaults to 0. +

+
:padx amount
+

Amount specifies how much horizontal external padding to +leave on each side of the slave(s). +Amount defaults to 0. +

+
:pady amount
+

Amount specifies how much vertical external padding to +leave on each side of the slave(s). +Amount defaults to 0. +

+
:side side
+

Specifies which side of the master the slave(s) will be packed against. +Must be left, right, top, or bottom. +Defaults to top. +

+
+ + +

If no :in, :after or :before option is specified +then each of the slaves will be inserted at the end of the packing list +for its parent unless it is already managed by the packer (in which +case it will be left where it is). +If one of these options is specified then all the slaves will be +inserted at the specified point. +If any of the slaves are already managed by the geometry manager +then any unspecified options for them retain their previous values rather +than receiving default values. +.RE +

+
+
pack :forget slave ?slave ...?
+

Removes each of the slaves from the packing order for its +master and unmaps their windows. +The slaves will no longer be managed by the packer. +

+
pack :newinfo slave
+

Returns a list whose elements are the current configuration state of +the slave given by slave in the same option-value form that +might be specified to pack configure. +The first two elements of the list are “:in master” where +master is the slave’s master. +Starting with Tk 4.0 this option will be renamed "pack info". +

+
pack :propagate master ?boolean?
+

If boolean has a true boolean value such as 1 or on +then propagation is enabled for master, which must be a window +name (see “GEOMETRY PROPAGATION” below). +If boolean has a false boolean value then propagation is +disabled for master. +In either of these cases an empty string is returned. +If boolean is omitted then the command returns 0 or +1 to indicate whether propagation is currently enabled +for master. +Propagation is enabled by default. +

+
pack :slaves master
+

Returns a list of all of the slaves in the packing order for master. +The order of the slaves in the list is the same as their order in +the packing order. +If master has no slaves then an empty string is returned. +

+
+
+

"The Packer Algorithm"

+ +

For each master the packer maintains an ordered list of slaves +called the packing list. +The :in, :after, and :before configuration +options are used to specify the master for each slave and the slave’s +position in the packing list. +If none of these options is given for a slave then the slave +is added to the end of the packing list for its parent. +

+

The packer arranges the slaves for a master by scanning the +packing list in order. +At the time it processes each slave, a rectangular area within +the master is still unallocated. +This area is called the cavity; for the first slave it +is the entire area of the master. +

+

For each slave the packer carries out the following steps: +

    +
  • [1] +The packer allocates a rectangular parcel for the slave +along the side of the cavity given by the slave’s :side option. +If the side is top or bottom then the width of the parcel is +the width of the cavity and its height is the requested height +of the slave plus the :ipady and :pady options. +For the left or right side the height of the parcel is +the height of the cavity and the width is the requested width +of the slave plus the :ipadx and :padx options. +The parcel may be enlarged further because of the :expand +option (see “EXPANSION” below) +
  • [2] +The packer chooses the dimensions of the slave. +The width will normally be the slave’s requested width plus +twice its :ipadx option and the height will normally be +the slave’s requested height plus twice its :ipady +option. +However, if the :fill option is x or both +then the width of the slave is expanded to fill the width of the parcel, +minus twice the :padx option. +If the :fill option is y or both +then the height of the slave is expanded to fill the width of the parcel, +minus twice the :pady option. +
  • [3] +The packer positions the slave over its parcel. +If the slave is smaller than the parcel then the :anchor +option determines where in the parcel the slave will be placed. +If :padx or :pady is non-zero, then the given +amount of external padding will always be left between the +slave and the edges of the parcel. +
+ + +

Once a given slave has been packed, the area of its parcel +is subtracted from the cavity, leaving a smaller rectangular +cavity for the next slave. +If a slave doesn’t use all of its parcel, the unused space +in the parcel will not be used by subsequent slaves. +If the cavity should become too small to meet the needs of +a slave then the slave will be given whatever space is +left in the cavity. +If the cavity shrinks to zero size, then all remaining slaves +on the packing list will be unmapped from the screen until +the master window becomes large enough to hold them again. +

+

"Expansion"

+ +

If a master window is so large that there will be extra space +left over after all of its slaves have been packed, then the +extra space is distributed uniformly among all of the slaves +for which the :expand option is set. +Extra horizontal space is distributed among the expandable +slaves whose :side is left or right, +and extra vertical space is distributed among the expandable +slaves whose :side is top or bottom. +

+

"Geometry Propagation"

+ +

The packer normally computes how large a master must be to +just exactly meet the needs of its slaves, and it sets the +requested width and height of the master to these dimensions. +This causes geometry information to propagate up through a +window hierarchy to a top-level window so that the entire +sub-tree sizes itself to fit the needs of the leaf windows. +However, the pack propagate command may be used to +turn off propagation for one or more masters. +If propagation is disabled then the packer will not set +the requested width and height of the packer. +This may be useful if, for example, you wish for a master +window to have a fixed size that you specify. +

+

"Restrictions On Master Windows"

+ +

The master for each slave must either be the slave’s parent +(the default) or a descendant of the slave’s parent. +This restriction is necessary to guarantee that the +slave can be placed over any part of its master that is +visible without danger of the slave being clipped by its parent. +

+

"Packing Order"

+ +

If the master for a slave is not its parent then you must make sure +that the slave is higher in the stacking order than the master. +Otherwise the master will obscure the slave and it will appear as +if the slave hasn’t been packed correctly. +The easiest way to make sure the slave is higher than the master is +to create the master window first: the most recently created window +will be highest in the stacking order. +Or, you can use the raise and lower commands to change +the stacking order of either the master or the slave. +

+

Keywords

+

geometry manager, location, packer, parcel, propagation, size +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/pack_002dold.html b/info/gcl-tk/pack_002dold.html new file mode 100644 index 0000000..0ae36fd --- /dev/null +++ b/info/gcl-tk/pack_002dold.html @@ -0,0 +1,264 @@ + + + + + +pack-old (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.13 pack-old

+ +

pack \- Obsolete syntax for packer geometry manager +

Synopsis

+

pack after sibling window options ?window options ...? +


+

pack append parent window options ?window options ...? +


+

pack before sibling window options ?window options ...? +


+

pack info parent +


+

pack unpack window +

+

Description

+ +

Note: this manual entry describes the syntax for the pack\fI +command as it before Tk version 3.3. +Although this syntax continues to be supported for backward +compatibility, it is obsolete and should not be used anymore. +At some point in the future it may cease to be supported. +

+

The packer is a geometry manager that arranges the +children of a parent by packing them in order around the edges of +the parent. The first child is placed against one side of +the window, occupying the entire span of the window along that +side. This reduces the space remaining for other children as +if the side had been moved in by the size of the first child. +Then the next child is placed against one side of the remaining +cavity, and so on until all children have been placed or there +is no space left in the cavity. +

+

The before, after, and append forms of the pack +command are used to insert one or more children into the packing order +for their parent. The before form inserts the children before +window sibling in the order; all of the other windows must be +siblings of sibling. The after form inserts the windows +after sibling, and the append form appends one or more +windows to the end of the packing order for parent. If a +window named in any of these commands is already packed in +its parent, it is removed from its current position in the packing +order and repositioned as indicated by the command. All of these +commands return an empty string as result. +

+

The unpack form of the pack command removes window +from the packing order of its parent and unmaps it. After the +execution of this command the packer will no longer manage +window’s geometry. +

+

The placement of each child is actually a four-step process; +the options argument following each window consists of +a list of one or more fields that govern the placement of that +window. In the discussion below, the term cavity refers +to the space left in a parent when a particular child is placed +(i.e. all the space that wasn’t claimed by earlier children in +the packing order). The term parcel refers to the space +allocated to a particular child; this is not necessarily the +same as the child window’s final geometry. +

+

The first step in placing a child is to determine which side of +the cavity it will lie against. Any one of the following options +may be used to specify a side: +

+
+
top
+

Position the child’s parcel against the top of the cavity, +occupying the full width of the cavity. +

+
bottom
+

Position the child’s parcel against the bottom of the cavity, +occupying the full width of the cavity. +

+
left
+

Position the child’s parcel against the left side of the cavity, +occupying the full height of the cavity. +

+
right
+

Position the child’s parcel against the right side of the cavity, +occupying the full height of the cavity. +

+
+ + +

At most one of these options should be specified for any given window. +If no side is specified, then the default is top. +

+

The second step is to decide on a parcel for the child. For top +and bottom windows, the desired parcel width is normally the cavity +width and the desired parcel height is the window’s requested height, +as passed to Tk_GeometryRequest. For left and right +windows, the desired parcel height is normally the cavity height and the +desired width is the window’s requested width. However, extra +space may be requested for the window using any of the following +options: +

+
+
padx num
+

Add num pixels to the window’s requested width before computing +the parcel size as described above. +

+
pady num
+

Add num pixels to the window’s requested height before computing +the parcel size as described above. +

+
expand
+

This option requests that the window’s parcel absorb any extra space left over +in the parent’s cavity after packing all the children. +The amount of space left over depends on the sizes requested by the +other children, and may be zero. If several windows have all specified +expand then the extra width will be divided equally among all the +left and right windows that specified expand and +the extra height will be divided equally among all the top and +bottom windows that specified expand. +

+
+ + +

If the desired width or height for a parcel is larger than the corresponding +dimension of the cavity, then the cavity’s dimension is used instead. +

+

The third step in placing the window is to decide on the window’s +width and height. The default is for the window to receive either +its requested width and height or the those of the parcel, whichever +is smaller. If the parcel is larger than the window’s requested +size, then the following options may be used to expand the +window to partially or completely fill the parcel: +

+
+
fill
+

Set the window’s size to equal the parcel size. +

+
fillx
+

Increase the window’s width to equal the parcel’s width, but retain +the window’s requested height. +

+
filly
+

Increase the window’s height to equal the parcel’s height, but retain +the window’s requested width. +

+

The last step is to decide the window’s location within its parcel. +If the window’s size equals the parcel’s size, then the window simply +fills the entire parcel. If the parcel is larger than the window, +then one of +the following options may be used to specify where the window should +be positioned within its parcel: +

+
frame center
+

Center the window in its parcel. This is the default if no framing +option is specified. +

+
frame n
+

Position the window with its top edge centered on the top edge of +the parcel. +

+
frame ne
+

Position the window with its upper-right corner at the upper-right corner +of the parcel. +

+
frame e
+

Position the window with its right edge centered on the right edge of +the parcel. +

+
frame se
+

Position the window with its lower-right corner at the lower-right corner +of the parcel. +

+
frame s
+

Position the window with its bottom edge centered on the bottom edge of +the parcel. +

+
frame sw
+

Position the window with its lower-left corner at the lower-left corner +of the parcel. +

+
frame w
+

Position the window with its left edge centered on the left edge of +the parcel. +

+
frame nw
+

Position the window with its upper-left corner at the upper-left corner +of the parcel. +

+

The pack info command may be used to retrieve information about +the packing order for a parent. It returns a list in the form +

+
+
window options window options ...
+
+ +

Each window is a name of a window packed in parent, +and the following options describes all of the options for that +window, just as they would be typed to pack append. +The order of the list is the same as the packing order for +parent. +

+

The packer manages the mapped/unmapped state of all the packed +children windows. It automatically maps the windows when it packs +them, and it unmaps any windows for which there was no space left +in the cavity. +

+

The packer makes geometry requests on behalf of the parent windows +it manages. For each parent window it requests a size large enough +to accommodate all the options specified by all the packed children, +such that zero space would be leftover for expand options. +

+
+
+

Keywords

+

geometry manager, location, packer, parcel, size +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/place.html b/info/gcl-tk/place.html new file mode 100644 index 0000000..89adb24 --- /dev/null +++ b/info/gcl-tk/place.html @@ -0,0 +1,270 @@ + + + + + +place (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.15 place

+ +

place \- Geometry manager for fixed or rubber-sheet placement +

Synopsis

+

place window option value ?option value ...? +


+

place configure window option value ?option value ...? +


+

place forget window +


+

place info window +


+

place slaves window +

+

Description

+ +

The placer is a geometry manager for Tk. +It provides simple fixed placement of windows, where you specify +the exact size and location of one window, called the slave, +within another window, called the master. +The placer also provides rubber-sheet placement, where you specify the +size and location of the slave in terms of the dimensions of +the master, so that the slave changes size and location +in response to changes in the size of the master. +Lastly, the placer allows you to mix these styles of placement so +that, for example, the slave has a fixed width and height but is +centered inside the master. +

+

If the first argument to the place command is a window path +name or configure then the command arranges for the placer +to manage the geometry of a slave whose path name is window. +The remaining arguments consist of one or more option:value +pairs that specify the way in which window’s +geometry is managed. +If the placer is already managing window, then the +option:value pairs modify the configuration for window. +In this form the place command returns an empty string as result. +The following option:value pairs are supported: +

+
+
:in master
+

Master specifes the path name of the window relative +to which window is to be placed. +Master must either be window’s parent or a descendant +of window’s parent. +In addition, master and window must both be descendants +of the same top-level window. +These restrictions are necessary to guarantee +that window is visible whenever master is visible. +If this option isn’t specified then the master defaults to +window’s parent. +

+
:x location
+

Location specifies the x-coordinate within the master window +of the anchor point for window. +The location is specified in screen units (i.e. any of the forms +accepted by Tk_GetPixels) and need not lie within the bounds +of the master window. +

+
:relx location
+

Location specifies the x-coordinate within the master window +of the anchor point for window. +In this case the location is specified in a relative fashion +as a floating-point number: 0.0 corresponds to the left edge +of the master and 1.0 corresponds to the right edge of the master. +Location need not be in the range 0.0\-1.0. +

+
:y location
+

Location specifies the y-coordinate within the master window +of the anchor point for window. +The location is specified in screen units (i.e. any of the forms +accepted by Tk_GetPixels) and need not lie within the bounds +of the master window. +

+
:rely location
+

Location specifies the y-coordinate within the master window +of the anchor point for window. +In this case the value is specified in a relative fashion +as a floating-point number: 0.0 corresponds to the top edge +of the master and 1.0 corresponds to the bottom edge of the master. +Location need not be in the range 0.0\-1.0. +

+
:anchor where
+

Where specifies which point of window is to be positioned +at the (x,y) location selected by the :x, :y, +:relx, and :rely options. +The anchor point is in terms of the outer area of window +including its border, if any. +Thus if where is se then the lower-right corner of +window’s border will appear at the given (x,y) location +in the master. +The anchor position defaults to nw. +

+
:width size
+

Size specifies the width for window in screen units +(i.e. any of the forms accepted by Tk_GetPixels). +The width will be the outer width of window including its +border, if any. +If size is an empty string, or if no :width +or :relwidth option is specified, then the width requested +internally by the window will be used. +

+
:relwidth size
+

Size specifies the width for window. +In this case the width is specified as a floating-point number +relative to the width of the master: 0.5 means window will +be half as wide as the master, 1.0 means window will have +the same width as the master, and so on. +

+
:height size
+

Size specifies the height for window in screen units +(i.e. any of the forms accepted by Tk_GetPixels). +The height will be the outer dimension of window including its +border, if any. +If size is an empty string, or if no :height or +:relheight option is specified, then the height requested +internally by the window will be used. +

+
:relheight size
+

Size specifies the height for window. +In this case the height is specified as a floating-point number +relative to the height of the master: 0.5 means window will +be half as high as the master, 1.0 means window will have +the same height as the master, and so on. +

+
:bordermode mode
+

Mode determines the degree to which borders within the +master are used in determining the placement of the slave. +The default and most common value is inside. +In this case the placer considers the area of the master to +be the innermost area of the master, inside any border: +an option of :x 0 corresponds to an x-coordinate just +inside the border and an option of :relwidth 1.0 +means window will fill the area inside the master’s +border. +If mode is outside then the placer considers +the area of the master to include its border; +this mode is typically used when placing window +outside its master, as with the options :x 0 :y 0 :anchor ne. +Lastly, mode may be specified as ignore, in which +case borders are ignored: the area of the master is considered +to be its official X area, which includes any internal border but +no external border. A bordermode of ignore is probably +not very useful. +

+

If the same value is specified separately with +two different options, such as :x and :relx, then +the most recent option is used and the older one is ignored. +

+

The place slaves command returns a list of all the slave +windows for which window is the master. +If there are no slaves for window then an empty string is +returned. +

+

The place forget command causes the placer to stop managing +the geometry of window. As a side effect of this command +window will be unmapped so that it doesn’t appear on the +screen. +If window isn’t currently managed by the placer then the +command has no effect. +Place forget returns an empty string as result. +

+

The place info command returns a list giving the current +configuration of window. +The list consists of option:value pairs in exactly the +same form as might be specified to the place configure +command. +If the configuration of a window has been retrieved with +place info, that configuration can be restored later by +first using place forget to erase any existing information +for the window and then invoking place configure with +the saved information. +

+
+
+

"Fine Points"

+ +

It is not necessary for the master window to be the parent +of the slave window. +This feature is useful in at least two situations. +First, for complex window layouts it means you can create a +hierarchy of subwindows whose only purpose +is to assist in the layout of the parent. +The “real children” of the parent (i.e. the windows that +are significant for the application’s user interface) can be +children of the parent yet be placed inside the windows +of the geometry-management hierarchy. +This means that the path names of the “real children” +don’t reflect the geometry-management hierarchy and users +can specify options for the real children +without being aware of the structure of the geometry-management +hierarchy. +

+

A second reason for having a master different than the slave’s +parent is to tie two siblings together. +For example, the placer can be used to force a window always to +be positioned centered just below one of its +siblings by specifying the configuration +

+
+
:in sibling :relx 0.5 :rely 1.0 :anchor n :bordermode outside
+
+ +

Whenever the sibling is repositioned in the future, the slave +will be repositioned as well. +

+

Unlike many other geometry managers (such as the packer) +the placer does not make any attempt to manipulate the geometry of +the master windows or the parents of slave windows (i.e. it doesn’t +set their requested sizes). +To control the sizes of these windows, make them windows like +frames and canvases that provide configuration options for this purpose. +

+

Keywords

+

geometry manager, height, location, master, place, rubber sheet, slave, width +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/radiobutton.html b/info/gcl-tk/radiobutton.html new file mode 100644 index 0000000..db20106 --- /dev/null +++ b/info/gcl-tk/radiobutton.html @@ -0,0 +1,314 @@ + + + + + +radiobutton (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.14 radiobutton

+ +

radiobutton \- Create and manipulate radio-button widgets +

Synopsis

+

radiobutton pathName ?options? +

Standard Options

+ + +
+
activeBackground  bitmap              font        relief        
+activeForeground  borderWidth         foreground  text          
+anchor            cursor              padX        textVariable  
+background        disabledForeground  padX        
+
+ + +

See options, for more information. +

Arguments for Radiobutton

+ + +
+
:command
+

Name="command" Class="Command" +


+ +

Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is released over the button +window. The button’s global variable (:variable option) will +be updated before the command is invoked. +

+
+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies a desired height for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in lines of text. +If this option isn’t specified, the button’s desired height is computed +from the size of the bitmap or text being displayed in it. +

+
+ + +
+
:selector
+

Name="selector" Class="Foreground" +


+ +

Specifies the color to draw in the selector when this button is +selected. +If specified as an empty string then no selector is drawn for the button. +

+
+ + +
+
:state
+

Name="state" Class="State" +


+ +

Specifies one of three states for the radio button: normal, active, +or disabled. In normal state the radio button is displayed using the +foreground and background options. The active state is +typically used when the pointer is over the radio button. In active state +the radio button is displayed using the activeForeground and +activeBackground options. Disabled state means that the radio button +is insensitive: it doesn’t activate and doesn’t respond to mouse +button presses. In this state the disabledForeground and +background options determine how the radio button is displayed. +

+
+ + +
+
:value
+

Name="value" Class="Value" +


+ +

Specifies value to store in the button’s associated variable whenever +this button is selected. Defaults to the name of the radio button. +

+
+ + +
+
:variable
+

Name="variable" Class="Variable" +


+ +

Specifies name of global variable to set whenever this button is +selected. Changes in this variable also cause the button to select +or deselect itself. +Defaults to the value selectedButton. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies a desired width for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to Tk_GetPixels); +for text it is in characters. +If this option isn’t specified, the button’s desired width is computed +from the size of the bitmap or text being displayed in it. +

+
+ +

Description

+ +

The radiobutton command creates a new window (given by the +pathName argument) and makes it into a radiobutton widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the radio button such as its colors, font, +text, and initial relief. The radiobutton command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A radio button is a widget +that displays a textual string or bitmap +and a diamond called a selector. +A radio button has +all of the behavior of a simple button: it can display itself in either +of three different ways, according to the state option; +it can be made to appear +raised, sunken, or flat; it can be made to flash; and it invokes +a Tcl command whenever mouse button 1 is clicked over the +check button. +

+

In addition, radio buttons can be selected. +If a radio button is selected then a special highlight appears +in the selector and a Tcl variable associated with the radio button +is set to a particular value. +If the radio button is not selected then the selector is drawn +in a different fashion. +Typically, several radio buttons share a single variable and the +value of the variable indicates which radio button is to be selected. +When a radio button is selected it sets the value of the variable to +indicate that fact; each radio button also monitors the value of +the variable and automatically selects and deselects itself when the +variable’s value changes. +By default the variable selectedButton +is used; its contents give the name of the button that is +selected, or the empty string if no button associated with that +variable is selected. +The name of the variable for a radio button, +plus the variable to be stored into it, may be modified with options +on the command line or in the option database. By default a radio +button is configured to select itself on button clicks. +

+

A Radiobutton Widget’s Arguments

+ +

The radiobutton command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for radio-button widgets: +

+
+
pathName :activate
+

Change the radio button’s state to active and redisplay the button +using its active foreground and background colors instead of normal +colors. +This command is ignored if the radio button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state active” instead. +

+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the radiobutton +command. +

+
pathName :deactivate
+

Change the radio button’s state to normal and redisplay the button +using its normal foreground and background colors. +This command is ignored if the radio button’s state is disabled. +This command is obsolete and will eventually be removed; +use “pathName :configure :state normal” instead. +

+
pathName :deselect
+

Deselect the radio button: redisplay it without a highlight in +the selector and set the associated variable to an empty string. If +this radio button was not currently selected, then the command has +no effect. +

+
pathName :flash
+

Flash the radio button. This is accomplished by redisplaying the radio button +several times, alternating between active and normal colors. At +the end of the flash the radio button is left in the same normal/active +state as when the command was invoked. +This command is ignored if the radio button’s state is disabled. +

+
pathName :invoke
+

Does just what would have happened if the user invoked the radio button +with the mouse: select the button and invoke +its associated Tcl command, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the radio button. +This command is ignored if the radio button’s state is disabled. +

+
pathName :select
+

Select the radio button: display it with a highlighted +selector and set the associated variable to the value corresponding +to this widget. +

+
+
+

Bindings

+ +

Tk automatically creates class bindings for radio buttons that give them +the following default behavior: +

    +
  • [1] +The radio button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves the radio button. +
  • [2] +The radio button’s relief is changed to sunken whenever mouse button 1 is +pressed over it, and the relief is restored to its original +value when button 1 is later released. +
  • [3] +If mouse button 1 is pressed over the radio button and later released over +the radio button, the radio button is invoked (i.e. it is selected +and the command associated with the button is invoked, +if there is one). However, if the mouse is not +over the radio button when button 1 is released, then no invocation occurs. +
+ +

The behavior of radio buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +

+

Keywords

+

radio button, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/raise.html b/info/gcl-tk/raise.html new file mode 100644 index 0000000..b94291d --- /dev/null +++ b/info/gcl-tk/raise.html @@ -0,0 +1,72 @@ + + + + + +raise (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.16 raise

+ +

raise \- Change a window’s position in the stacking order +

Synopsis

+

raise window ?aboveThis? +

+

Description

+ +

If the aboveThis argument is omitted then the command raises +window so that it is above all of its siblings in the stacking +order (it will not be obscured by any siblings and will obscure +any siblings that overlap it). +If aboveThis is specified then it must be the path name of +a window that is either a sibling of window or the descendant +of a sibling of window. +In this case the raise command will insert +window into the stacking order just above aboveThis +(or the ancestor of aboveThis that is a sibling of window); +this could end up either raising or lowering window. +

+

Keywords

+

obscure, raise, stacking order +

+ + + + diff --git a/info/gcl-tk/scale.html b/info/gcl-tk/scale.html new file mode 100644 index 0000000..28cc432 --- /dev/null +++ b/info/gcl-tk/scale.html @@ -0,0 +1,309 @@ + + + + + +scale (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.3 scale

+ +

scale \- Create and manipulate scale widgets +

Synopsis

+

scale pathName ?options? +

Standard Options

+ + +
+
activeForeground     borderWidth     font           orient     
+background           cursor          foreground     relief     
+
+ + +

See options, for more information. +

Arguments for Scale

+ + +
+
:command
+

Name="command" Class="Command" +


+ +

Specifies the prefix of a Tcl command to invoke whenever the value of +the scale is changed interactively. The actual command consists +of this option followed by +a space and a number. The number indicates the new value of the +scale. +

+
+ + +
+
:from
+

Name="from" Class="From" +


+ +

Specifies the value corresponding to the left or top end of the +scale. Must be an integer. +

+
+ + +
+
:label
+

Name="label" Class="Label" +


+ +

Specifies a string to displayed as a label for the scale. For +vertical scales the label is displayed just to the right of the +top end of the scale. For horizontal scales the label is displayed +just above the left end of the scale. +

+
+ + +
+
:length
+

Name="length" Class="Length" +


+ +

Specifies the desired long dimension of the scale in screen units, +that is in any of the forms acceptable to Tk_GetPixels. +For vertical scales this is the scale’s height; for horizontal scales +it is the scale’s width. +

+
+ + +
+
:showvalue
+

Name="showValue" Class="ShowValue" +


+ +

Specifies a boolean value indicating whether or not the current +value of the scale is to be displayed. +

+
+ + +
+
:sliderforeground
+

Name="sliderForeground" Class="sliderForeground" +


+ +

Specifies the color to use for drawing the slider under normal conditions. +When the mouse is in the slider window then the slider’s color is +determined by the activeForeground option. +

+
+ + +
+
:sliderlength
+

Name="sliderLength" Class="SliderLength" +


+ +

Specfies the size of the slider, measured in screen units along the slider’s +long dimension. The value may be specified in any of the forms acceptable +to Tk_GetPixels. +

+
+ + +
+
:state
+

Name="state" Class="State" +


+ +

Specifies one of two states for the scale: normal or disabled. +If the scale is disabled then the value may not be changed and the scale +won’t activate when the mouse enters it. +

+
+ + +
+
:tickinterval
+

Name="tickInterval" Class="TickInterval" +


+ +

Must be an integer value. Determines the spacing between numerical +tick-marks displayed below or to the left of the slider. If specified +as 0, then no tick-marks will be displayed. +

+
+ + +
+
:to
+

Name="to" Class="To" +


+ +

Specifies the value corresponding to the right or bottom end of the +scale. Must be an integer. This value may be either less than or +greater than the from option. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies the desired narrow dimension of the scale in screen units +(i.e. any of the forms acceptable to Tk_GetPixels). +For vertical scales this is the scale’s width; for horizontal scales +this is the scale’s height. +

+
+ +

Description

+ +

The scale command creates a new window (given by the +pathName argument) and makes it into a scale widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the scale such as its colors, orientation, +and relief. The scale command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A scale is a widget that displays a rectangular region and a +small slider. The rectangular region corresponds to a range +of integer values (determined by the from and to options), +and the position of the slider selects a particular integer value. +The slider’s position (and hence the scale’s value) may be adjusted +by clicking or dragging with the mouse as described in the BINDINGS +section below. Whenever the scale’s value is changed, a Tcl +command is invoked (using the command option) to notify +other interested widgets of the change. +

+

Three annotations may be displayed in a scale widget: a label +appearing at the top-left of the widget (top-right for vertical +scales), a number displayed just underneath the slider +(just to the left of the slider for vertical scales), and a collection +of numerical tick-marks just underneath the current value (just to the left of +the current value for vertical scales). Each of these three +annotations may be selectively enabled or disabled using the +configuration options. +

+

A Scale’s"Argumentsommand"

+ +

The scale command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for scale widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the scale +command. +

+
pathName :get
+

Returns a decimal string giving the current value of the scale. +

+
pathName :set value
+

This command is invoked to change the current value of the scale, +and hence the position at which the slider is displayed. Value +gives the new value for the scale. +

+
+
+

Bindings

+ +

When a new scale is created, it is given the following initial +behavior by default: +

+
+
<Enter>
+

Change the slider display to use activeForeground instead of +sliderForeground. +

+
<Leave>
+

Reset the slider display to use sliderForeground instead of +activeForeground. +

+
<ButtonPress-1>
+

Change the slider display so that the slider appears sunken rather +than raised. Move the slider (and adjust the scale’s value) +to correspond to the current mouse position. +

+
<Button1-Motion>
+

Move the slider (and adjust the scale’s value) to correspond to +the current mouse position. +

+
<ButtonRelease-1>
+

Reset the slider display so that the slider appears raised again. +

+
+
+

Keywords

+

scale, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/scrollbar.html b/info/gcl-tk/scrollbar.html new file mode 100644 index 0000000..a8b3da6 --- /dev/null +++ b/info/gcl-tk/scrollbar.html @@ -0,0 +1,239 @@ + + + + + +scrollbar (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.6 scrollbar

+ +

scrollbar \- Create and manipulate scrollbar widgets +

Synopsis

+

scrollbar pathName ?options? +

Standard Options

+ + +
+
activeForeground       cursor           relief               
+background             foreground       repeatDelay          
+borderWidth            orient           repeatInterval       
+
+ + +

See options, for more information. +

Arguments for Scrollbar

+ + +
+
:command
+

Name="command" Class="Command" +


+ +

Specifies the prefix of a Tcl command to invoke to change the view +in the widget associated with the scrollbar. When a user requests +a view change by manipulating the scrollbar, a Tcl command is +invoked. The actual command consists of this option followed by +a space and a number. The number indicates the logical unit that +should appear at the top of the associated window. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies the desired narrow dimension of the scrollbar window, +not including 3-D border, if any. For vertical +scrollbars this will be the width and for horizontal scrollbars +this will be the height. +The value may have any of the forms acceptable to Tk_GetPixels. +

+
+ +

Description

+ +

The scrollbar command creates a new window (given by the +pathName argument) and makes it into a scrollbar widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the scrollbar such as its colors, orientation, +and relief. The scrollbar command returns its +pathName argument. At the time this command is invoked, +there must not exist a window named pathName, but +pathName’s parent must exist. +

+

A scrollbar is a widget that displays two arrows, one at each end of +the scrollbar, and a slider in the middle portion of the +scrollbar. A scrollbar is used to provide information about what +is visible in an associated window that displays an object +of some sort (such as a file being edited or a drawing). +The position and size of the slider indicate which portion of the +object is visible in the associated window. For example, if the +slider in a vertical scrollbar covers the top third of the area +between the two arrows, it means that the associated window displays +the top third of its object. +

+

Scrollbars can be used to adjust the view in the associated window +by clicking or dragging with the mouse. See the BINDINGS section +below for details. +

+

A Scrollbar Widget’s Arguments

+ +

The scrollbar command creates a new Tcl command whose +name is pathName. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

Option and the args +determine the exact behavior of the command. The following +commands are possible for scrollbar widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the scrollbar +command. +

+
pathName :get
+

Returns a Tcl list containing four decimal values, which are +the current totalUnits, widnowUnits, firstUnit, +and lastUnit values for the scrollbar. These are the values +from the most recent set widget command on the scrollbar. +

+
pathName :set totalUnits windowUnits firstUnit lastUnit
+

This command is invoked to give the scrollbar information about the +widget associated with the scrollbar. TotalUnits is an integer +value giving the total size of the object being displayed in the +associated widget. The meaning of one unit depends on the associated +widget; for example, in a text editor widget units might +correspond to lines of +text. WindowUnits indicates the total number of units that +can fit in the associated window at one time. FirstUnit +and lastUnit give the indices of the first and last units +currently visible in the associated window (zero corresponds to the +first unit of the object). This command should +be invoked by the associated widget whenever its object or window +changes size and whenever it changes the view in its window. +

+
+
+

Bindings

+ +

The description below assumes a vertically-oriented scrollbar. +For a horizontally-oriented scrollbar replace the words “up”, “down”, +“top”, and “bottom” with “left”, “right”, “left”, +and “right”, respectively +

+

A scrollbar widget is divided into five distinct areas. From top +to bottom, they are: the top arrow, the top gap (the empty space +between the arrow and the slider), the slider, the bottom gap, +and the bottom arrow. Pressing mouse button 1 in each area has +a different effect: +

+
+
top arrow
+

Causes the view in the associated window to shift up by one unit +(i.e. the object appears to move down one unit in its window). +If the button is held down the action will auto-repeat. +

+
top gap
+

Causes the view in the associated window to shift up by one +less than the number of units in the window +(i.e. the portion of the object that used to appear at the very +top of the window will now appear at the very bottom). +If the button is held down the action will auto-repeat. +

+
slider
+

Pressing button 1 in this area has no immediate effect except to +cause the slider to appear sunken rather than raised. However, +if the mouse is moved with the button down then the slider will +be dragged, adjusting the view as the mouse is moved. +

+
bottom gap
+

Causes the view in the associated window to shift down by one +less than the number of units in the window +(i.e. the portion of the object that used to appear at the very +bottom of the window will now appear at the very top). +If the button is held down the action will auto-repeat. +

+
bottom arrow
+

Causes the view in the associated window to shift down by one unit +(i.e. the object appears to move up one unit in its window). +If the button is held down the action will auto-repeat. +

+

Note: none of the actions described above has an immediate impact +on the position of the slider in the scrollbar. It simply invokes +the command specified in the command option to notify the +associated widget that a change in view is desired. If the view is +actually changed then the associated widget must invoke the +scrollbar’s set widget command to change what is displayed in +the scrollbar. +

+
+
+

Keywords

+

scrollbar, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/selection.html b/info/gcl-tk/selection.html new file mode 100644 index 0000000..0a98c08 --- /dev/null +++ b/info/gcl-tk/selection.html @@ -0,0 +1,162 @@ + + + + + +selection (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.17 selection

+ +

selection \- Manipulate the X selection +

Synopsis

+

selection option ?arg arg ...? +

+

Description

+ +

This command provides a Tcl interface to the X selection mechanism and +implements the full selection functionality described in the +X Inter-Client Communication Conventions Manual (ICCCM), except that it +supports only the primary selection. +

+

The first argument to selection determines the format of the +rest of the arguments and the behavior of the command. The following +forms are currently supported: +

+
+
selection :clear window
+

If there is a selection anywhere on window’s display, clear it +so that no window owns the selection anymore. Returns an empty string. +

+
selection :get ?type?
+

Retrieves the value +of the primary selection and returns it as a result. +Type specifies the form in which the selection is to be +returned (the desired “target” for conversion, in ICCCM +terminology), and should be an +atom name such as STRING or FILE_NAME; see the Inter-Client +Communication Conventions Manual for complete details. +Type defaults to STRING. The selection :owner may choose to +return the selection in any of several different representation +formats, such as STRING, ATOM, INTEGER, etc. (this format is +different than the selection type; see the ICCCM for all the +confusing details). If the selection is returned in +a non-string format, such as INTEGER or ATOM, the selection +command converts it to string format as a collection of fields +separated by spaces: atoms are converted to their +textual names, and anything else is converted to hexadecimal +integers. +

+
selection :handle window command ?type? ?format?
+

Creates a handler for selection requests, such that command will +be executed whenever the primary selection is +owned by window and someone attempts to retrieve it in the form +given by type (e.g. type is specified in the selection :get +command). Type defaults to STRING. +If command is an empty string then any existing handler for +window and type is removed. +

+

When the selection is requested and window is the selection :owner +and type is the requested type, command will be executed +as a Tcl command with two additional numbers appended to it +(with space separators). The two additional numbers +are offset and maxBytes: offset specifies a starting +character position in the selection and maxBytes gives the maximum +number of bytes to retrieve. The command should return a value consisting +of at most maxBytes of the selection, starting at position +offset. For very large selections (larger than maxBytes) +the selection will be retrieved using several invocations of command +with increasing offset values. If command returns a string +whose length is less than maxBytes, the return value is assumed to +include all of the remainder of the selection; if the length of +command’s result is equal to maxBytes then +command will be invoked again, until it eventually +returns a result shorter than maxBytes. The value of maxBytes +will always be relatively large (thousands of bytes). +

+

If command returns an error then the selection retrieval is rejected +just as if the selection didn’t exist at all. +

+

The format argument specifies the representation that should be +used to transmit the selection to the requester (the second column of +Table 2 of the ICCCM), and defaults to STRING. If format is +STRING, the selection is transmitted as 8-bit ASCII characters (i.e. +just in the form returned by command). If format is +ATOM, then the return value from command is divided into fields +separated by white space; each field is converted to its atom value, +and the 32-bit atom value is transmitted instead of the atom name. +For any other format, the return value from command is +divided into fields separated by white space and each field is +converted to a 32-bit integer; an array of integers is transmitted +to the selection requester. +

+

The format argument is needed only for compatibility with +selection requesters that don’t use Tk. If the Tk toolkit is being +used to retrieve the selection then the value is converted back to +a string at the requesting end, so format is +irrelevant. +.RE +

+
selection :own ?window? ?command?
+

If window is specified, then it becomes the new selection :owner +and the command returns an empty string as result. +The existing owner, if any, is notified that it has lost the selection. +If command is specified, it is a Tcl script to execute when +some other window claims ownership of the selection away from +window. +If neither window nor command is specified then +the command returns the path name of the window in this application +that owns the selection, or an empty string if no window in this +application owns the selection. +

+
+
+

Keywords

+

clear, format, handler, ICCCM, own, selection, target, type +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/send.html b/info/gcl-tk/send.html new file mode 100644 index 0000000..541966d --- /dev/null +++ b/info/gcl-tk/send.html @@ -0,0 +1,96 @@ + + + + + +send (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.18 send

+ +

send \- Execute a command in a different interpreter +

Synopsis

+

send interp cmd ?arg arg ...? +

+

Description

+ +

This command arranges for cmd (and args) to be executed in the +interpreter named by interp. It returns the result or +error from that command execution. Interp must be the +name of an interpreter registered on the display associated with +the interpreter in which the command is invoked; it need not +be within the same process or application. If no arg +arguments are present, then the command to be executed is +contained entirely within the cmd argument. If one or +more args are present, they are concatenated to form the +command to be executed, just as for the eval Tcl command. +

+

Security

+ +

The send command is potentially a serious security loophole, +since any application that can connect to your X server can send +scripts to your applications. +These incoming scripts can use Tcl to read and +write your files and invoke subprocesses under your name. +Host-based access control such as that provided by xhost +is particularly insecure, since it allows anyone with an account +on particular hosts to connect to your server, and if disabled it +allows anyone anywhere to connect to your server. +In order to provide at least a small amount of +security, Tk checks the access control being used by the server +and rejects incoming sends unless (a) xhost-style access control +is enabled (i.e. only certain hosts can establish connections) and (b) the +list of enabled hosts is empty. +This means that applications cannot connect to your server unless +they use some other form of authorization +such as that provide by xauth. +

+

Keywords

+

interpreter, remote execution, security, send +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/text.html b/info/gcl-tk/text.html new file mode 100644 index 0000000..6f21b0b --- /dev/null +++ b/info/gcl-tk/text.html @@ -0,0 +1,884 @@ + + + + + +text (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+
+

2.9 text

+ +

text \- Create and manipulate text widgets +

Synopsis

+

text pathName ?options? +

Standard Options

+ + +
+
background      foreground        insertWidth      selectBorderWidth 
+borderWidth     insertBackground  padX             selectForeground  
+cursor          insertBorderWidth padY             setGrid           
+exportSelection insertOffTime     relief           yScrollCommand    
+font            insertOnTime      selectBackground 
+
+ + +

See options, for more information. +

Arguments for Text

+ + +
+
:height
+

Name="height" Class="Height" +


+ +

Specifies the desired height for the window, in units of characters. +Must be at least one. +

+
+ + +
+
:state
+

Name="state" Class="State" +


+ +

Specifies one of two states for the text: normal or disabled. +If the text is disabled then characters may not be inserted or deleted +and no insertion cursor will be displayed, even if the input focus is +in the widget. +

+
+ + +
+
:width
+

Name="width" Class="Width" +


+ +

Specifies the desired width for the window in units of characters. +If the font doesn’t have a uniform width then the width of the +character “0” is used in translating from character units to +screen units. +

+
+ + +
+
:wrap
+

Name="wrap" Class="Wrap" +


+ +

Specifies how to handle lines in the text that are too long to be +displayed in a single line of the text’s window. +The value must be none or char or word. +A wrap mode of none means that each line of text appears as +exactly one line on the screen; extra characters that don’t fit +on the screen are not displayed. +In the other modes each line of text will be broken up into several +screen lines if necessary to keep all the characters visible. +In char mode a screen line break may occur after any character; +in word mode a line break will only be made at word boundaries. +

+
+ +

Description

+ +

The text command creates a new window (given by the +pathName argument) and makes it into a text widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the text such as its default background color +and relief. The text command returns the +path name of the new window. +

+

A text widget displays one or more lines of text and allows that +text to be edited. +Text widgets support three different kinds of annotations on the +text, called tags, marks, and windows. +Tags allow different portions of the text +to be displayed with different fonts and colors. +In addition, Tcl commands can be associated with tags so +that commands are invoked when particular actions such as keystrokes +and mouse button presses occur in particular ranges of the text. +See TAGS below for more details. +

+

The second form of annotation consists of marks, which are floating +markers in the text. +Marks are used to keep track of various interesting positions in the +text as it is edited. +See MARKS below for more details. +

+

The third form of annotation allows arbitrary windows to be displayed +in the text widget. +See WINDOWS below for more details. +

+

Indices

+ +

Many of the widget commands for texts take one or more indices +as arguments. +An index is a string used to indicate a particular place within +a text, such as a place to insert characters or one endpoint of a +range of characters to delete. +Indices have the syntax +

+

base modifier modifier modifier ... +

+ +

Where base gives a starting point and the modifiers +adjust the index from the starting point (e.g. move forward or +backward one character). Every index must contain a base, +but the modifiers are optional. +

+ +

The base for an index must have one of the following forms: +

+
+
line.char
+

Indicates char’th character on line line. +Lines are numbered from 1 for consistency with other UNIX programs +that use this numbering scheme. +Within a line, characters are numbered from 0. +

+
@x,y
+

Indicates the character that covers the pixel whose x and y coordinates +within the text’s window are x and y. +

+
end
+

Indicates the last character in the text, which is always a newline +character. +

+
mark
+

Indicates the character just after the mark whose name is mark. +

+
tag.first
+

Indicates the first character in the text that has been tagged with +tag. +This form generates an error if no characters are currently tagged +with tag. +

+
tag.last
+

Indicates the character just after the last one in the text that has +been tagged with tag. +This form generates an error if no characters are currently tagged +with tag. +

+
+ + +

If modifiers follow the base index, each one of them must have one +of the forms listed below. Keywords such as chars and wordend +may be abbreviated as long as the abbreviation is unambiguous. +

+
+
+ count chars
+

Adjust the index forward by count characters, moving to later +lines in the text if necessary. If there are fewer than count +characters in the text after the current index, then set the index +to the last character in the text. +Spaces on either side of count are optional. +

+
- count chars
+

Adjust the index backward by count characters, moving to earlier +lines in the text if necessary. If there are fewer than count +characters in the text before the current index, then set the index +to the first character in the text. +Spaces on either side of count are optional. +

+
+ count lines
+

Adjust the index forward by count lines, retaining the same +character position within the line. If there are fewer than count +lines after the line containing the current index, then set the index +to refer to the same character position on the last line of the text. +Then, if the line is not long enough to contain a character at the indicated +character position, adjust the character position to refer to the last +character of the line (the newline). +Spaces on either side of count are optional. +

+
- count lines
+

Adjust the index backward by count lines, retaining the same +character position within the line. If there are fewer than count +lines before the line containing the current index, then set the index +to refer to the same character position on the first line of the text. +Then, if the line is not long enough to contain a character at the indicated +character position, adjust the character position to refer to the last +character of the line (the newline). +Spaces on either side of count are optional. +

+
linestart
+

Adjust the index to refer to the first character on the line. +

+
lineend
+

Adjust the index to refer to the last character on the line (the newline). +

+
wordstart
+

Adjust the index to refer to the first character of the word containing +the current index. A word consists of any number of adjacent characters +that are letters, digits, or underscores, or a single character that +is not one of these. +

+
wordend
+

Adjust the index to refer to the character just after the last one of the +word containing the current index. If the current index refers to the last +character of the text then it is not modified. +

+
+ + +

If more than one modifier is present then they are applied in +left-to-right order. For example, the index “\fBend \- 1 chars” +refers to the next-to-last character in the text and +“\fBinsert wordstart \- 1 c” refers to the character just before +the first one in the word containing the insertion cursor. +

+

Tags

+ +

The first form of annotation in text widgets is a tag. +A tag is a textual string that is associated with some of the characters +in a text. +There may be any number of tags associated with characters in a +text. +Each tag may refer to a single character, a range of characters, or +several ranges of characters. +An individual character may have any number of tags associated with it. +

+

A priority order is defined among tags, and this order is used in +implementing some of the tag-related functions described below. +When a tag is defined (by associating it with characters or setting +its display options or binding commands to it), it is given +a priority higher than any existing tag. +The priority order of tags may be redefined using the +“pathName :tag :raise” and “pathName :tag :lower” +widget commands. +

+

Tags serve three purposes in text widgets. +First, they control the way information is displayed on the screen. +By default, characters are displayed as determined by the +background, font, and foreground options for the +text widget. +However, display options may be associated with individual tags +using the “pathName :tag configure” widget command. +If a character has been tagged, then the display options associated +with the tag override the default display style. +The following options are currently supported for tags: +

+
+
:background color
+

Color specifies the background color to use for characters +associated with the tag. +It may have any of the forms accepted by Tk_GetColor. +

+
:bgstipple bitmap
+

Bitmap specifies a bitmap that is used as a stipple pattern +for the background. +It may have any of the forms accepted by Tk_GetBitmap. +If bitmap hasn’t been specified, or if it is specified +as an empty string, then a solid fill will be used for the +background. +

+
:borderwidth pixels
+

Pixels specifies the width of a 3-D border to draw around +the background. +It may have any of the forms accepted by Tk_GetPixels. +This option is used in conjunction with the :relief +option to give a 3-D appearance to the background for characters; +it is ignored unless the :background option +has been set for the tag. +

+
:fgstipple bitmap
+

Bitmap specifies a bitmap that is used as a stipple pattern +when drawing text and other foreground information such as +underlines. +It may have any of the forms accepted by Tk_GetBitmap. +If bitmap hasn’t been specified, or if it is specified +as an empty string, then a solid fill will be used. +

+
:font fontName
+

FontName is the name of a font to use for drawing characters. +It may have any of the forms accepted by Tk_GetFontStruct. +

+
:foreground color
+

Color specifies the color to use when drawing text and other +foreground information such as underlines. +It may have any of the forms accepted by Tk_GetColor. +

+
:relief relief
+

\fIRelief specifies the 3-D relief to use for drawing backgrounds, +in any of the forms accepted by Tk_GetRelief. +This option is used in conjunction with the :borderwidth +option to give a 3-D appearance to the background for characters; +it is ignored unless the :background option +has been set for the tag. +

+
:underline boolean
+

Boolean specifies whether or not to draw an underline underneath +characters. +It may have any of the forms accepted by Tk_GetBoolean. +

+

If a character has several tags associated with it, and if their +display options conflict, then the options of the highest priority +tag are used. +If a particular display option hasn’t been specified for a +particular tag, or if it is specified as an empty string, then +that option will never be used; the next-highest-priority +tag’s option will used instead. +If no tag specifies a particular display optionl, then the default +style for the widget will be used. +

+

The second purpose for tags is event bindings. +You can associate bindings with a tag in much the same way you can +associate bindings with a widget class: whenever particular X +events occur on characters with the given tag, a given +Tcl command will be executed. +Tag bindings can be used to give behaviors to ranges of characters; +among other things, this allows hypertext-like +features to be implemented. +For details, see the description of the tag bind widget +command below. +

+

The third use for tags is in managing the selection. +See THE SELECTION below. +

+
+
+

Marks

+ +

The second form of annotation in text widgets is a mark. +Marks are used for remembering particular places in a text. +They are something like tags, in that they have names and +they refer to places in the file, but a mark isn’t associated +with particular characters. +Instead, a mark is associated with the gap between two characters. +Only a single position may be associated with a mark at any given +time. +If the characters around a mark are deleted the mark will still +remain; it will just have new neighbor characters. +In contrast, if the characters containing a tag are deleted then +the tag will no longer have an association with characters in +the file. +Marks may be manipulated with the “pathName :mark” widget +command, and their current locations may be determined by using the +mark name as an index in widget commands. +

+

The name space for marks is different from that for tags: the +same name may be used for both a mark and a tag, but they will refer +to different things. +

+

Two marks have special significance. +First, the mark insert is associated with the insertion cursor, +as described under THE INSERTION CURSOR below. +Second, the mark current is associated with the character +closest to the mouse and is adjusted automatically to track the +mouse position and any changes to the text in the widget (one +exception: current is not updated in response to mouse +motions if a mouse button is down; the update will be deferred +until all mouse buttons have been released). +Neither of these special marks may be unset. +

+

Windows

+ +

The third form of annotation in text widgets is a window. +Window support isn’t implemented yet, but when it is it will be +described here. +

+

The Selection

+ +

Text widgets support the standard X selection. +Selection support is implemented via tags. +If the exportSelection option for the text widget is true +then the sel tag will be associated with the selection: +

    +
  • [1] +Whenever characters are tagged with sel the text widget +will claim ownership of the selection. +
  • [2] +Attempts to retrieve the +selection will be serviced by the text widget, returning all the +charaters with the sel tag. +
  • [3] +If the selection is claimed away by another application or by another +window within this application, then the sel tag will be removed +from all characters in the text. +
+ +

The sel tag is automatically defined when a text widget is +created, and it may not be deleted with the “pathName :tag delete” +widget command. Furthermore, the selectBackground, +selectBorderWidth, and selectForeground options for +the text widget are tied to the :background, +:borderwidth, and :foreground options for the sel +tag: changes in either will automatically be reflected in the +other. +

+

The Insertion Cursor

+ +

The mark named insert has special significance in text widgets. +It is defined automatically when a text widget is created and it +may not be unset with the “pathName :mark unset” widget +command. +The insert mark represents the position of the insertion +cursor, and the insertion cursor will automatically be drawn at +this point whenever the text widget has the input focus. +

+

A Text Widget’s Arguments

+ +

The text command creates a new Tcl command whose +name is the same as the path name of the text’s window. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

PathName is the name of the command, which is the same as +the text widget’s path name. Option and the args +determine the exact behavior of the command. The following +commands are possible for text widgets: +

+
+
pathName :compare index1 op index2
+

Compares the indices given by index1 and index2 according +to the relational operator given by op, and returns 1 if +the relationship is satisfied and 0 if it isn’t. +Op must be one of the operators <, <=, ==, >=, >, or !=. +If op is == then 1 is returned if the two indices refer to +the same character, if op is < then 1 is returned if index1 +refers to an earlier character in the text than index2, and +so on. +

+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the text +command. +

+
pathName :debug ?boolean?
+

If boolean is specified, then it must have one of the true or +false values accepted by Tcl_GetBoolean. +If the value is a true one then internal consistency checks will be +turned on in the B-tree code associated with text widgets. +If boolean has a false value then the debugging checks will +be turned off. +In either case the command returns an empty string. +If boolean is not specified then the command returns on +or off to indicate whether or not debugging is turned on. +There is a single debugging switch shared by all text widgets: turning +debugging on or off in any widget turns it on or off for all widgets. +For widgets with large amounts of text, the consistency checks may +cause a noticeable slow-down. +

+
pathName :delete index1 ?index2?
+

Delete a range of characters from the text. +If both index1 and index2 are specified, then delete +all the characters starting with the one given by index1 +and stopping just before index2 (i.e. the character at +index2 is not deleted). +If index2 doesn’t specify a position later in the text +than index1 then no characters are deleted. +If index2 isn’t specified then the single character at +index1 is deleted. +It is not allowable to delete characters in a way that would leave +the text without a newline as the last character. +The command returns an empty string. +

+
pathName :get index1 ?index2?
+

Return a range of characters from the text. +The return value will be all the characters in the text starting +with the one whose index is index1 and ending just before +the one whose index is index2 (the character at index2 +will not be returned). +If index2 is omitted then the single character at index1 +is returned. +If there are no characters in the specified range (e.g. index1 +is past the end of the file or index2 is less than or equal +to index1) then an empty string is returned. +

+
pathName :index index
+

Returns the position corresponding to index in the form +line.char where line is the line number and char +is the character number. +Index may have any of the forms described under INDICES above. +

+
pathName :insert \fIindex chars
+

Inserts chars into the text just before the character at +index and returns an empty string. +It is not possible to insert characters after the last newline +of the text. +

+
pathName :mark option ?arg arg ...?
+

This command is used to manipulate marks. The exact behavior of +the command depends on the option argument that follows +the mark argument. The following forms of the command +are currently supported: +

+
pathName :mark :names
+

Returns a list whose elements are the names of all the marks that +are currently set. +

+
pathName :mark :set markName index
+

Sets the mark named markName to a position just before the +character at index. +If markName already exists, it is moved from its old position; +if it doesn’t exist, a new mark is created. +This command returns an empty string. +

+
pathName :mark :unset markName ?markName markName ...?
+

Remove the mark corresponding to each of the markName arguments. +The removed marks will not be usable in indices and will not be +returned by future calls to “pathName :mark names”. +This command returns an empty string. +

+
+ +
+
pathName :scan option args
+

This command is used to implement scanning on texts. It has +two forms, depending on option: +

+
pathName :scan :mark y
+

Records y and the current view in the text window; used in +conjunction with later scan dragto commands. Typically this +command is associated with a mouse button press in the widget. It +returns an empty string. +

+
pathName :scan :dragto y
+

This command computes the difference between its y argument +and the y argument to the last scan mark command for +the widget. It then adjusts the view up or down by 10 times the +difference in y-coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the text at high speed through the window. The return +value is an empty string. +

+
+ +
+
pathName :tag option ?arg arg ...?
+

This command is used to manipulate tags. The exact behavior of the +command depends on the option argument that follows the +tag argument. The following forms of the command are currently +supported: +

+
+
pathName :tag :add tagName index1 ?index2?
+

Associate the tag tagName with all of the characters starting +with index1 and ending just before +index2 (the character at index2 isn’t tagged). +If index2 is omitted then the single character at +index1 is tagged. +If there are no characters in the specified range (e.g. index1 +is past the end of the file or index2 is less than or equal +to index1) then the command has no effect. +This command returns an empty string. +

+
pathName :tag :bind tagName ?sequence? ?command?
+

This command associates command with the tag given by +tagName. +Whenever the event sequence given by sequence occurs for a +character that has been tagged with tagName, +the command will be invoked. +This widget command is similar to the bind command except that +it operates on characters in a text rather than entire widgets. +See the bind manual entry for complete details +on the syntax of sequence and the substitutions performed +on command before invoking it. +If all arguments are specified then a new binding is created, replacing +any existing binding for the same sequence and tagName +(if the first character of command is “+” then command +augments an existing binding rather than replacing it). +In this case the return value is an empty string. +If command is omitted then the command returns the command +associated with tagName and sequence (an error occurs +if there is no such binding). +If both command and sequence are omitted then the command +returns a list of all the sequences for which bindings have been +defined for tagName. +

+ +

The only events for which bindings may be specified are those related +to the mouse and keyboard, such as Enter, Leave, +ButtonPress, Motion, and KeyPress. +Event bindings for a text widget use the current mark +described under MARKS above. +Enter events trigger for a character when it +becomes the current character (i.e. the current mark moves +to just in front of that character). +Leave events trigger for a character when it ceases to be +the current item (i.e. the current mark moves away from +that character, or the character is deleted). +These events are different than Enter and Leave +events for windows. +Mouse and keyboard events are directed to the current character. +

+ +

It is possible for the current character to have multiple tags, +and for each of them to have a binding for a particular event +sequence. +When this occurs, the binding from the highest priority tag is +used. +If a particular tag doesn’t have a binding that matches an +event, then the tag is ignored and tags with lower priority +will be checked. +

+ +

If bindings are created for the widget as a whole using the +bind command, then those bindings will supplement the +tag bindings. +This means that a single event can trigger two Tcl scripts, +one for a widget-level binding and one for a tag-level +binding. +

+ +
+
pathName :tag :configure tagName ?option? ?value? ?option value ...?
+

This command is similar to the configure widget command except +that it modifies options associated with the tag given by tagName +instead of modifying options for the overall text widget. +If no option is specified, the command returns a list describing +all of the available options for tagName (see Tk_ConfigureInfo +for information on the format of this list). +If option is specified with no value, then the command returns +a list describing the one named option (this list will be identical to +the corresponding sublist of the value returned if no option +is specified). +If one or more option:value pairs are specified, then the command +modifies the given option(s) to have the given value(s) in tagName; +in this case the command returns an empty string. +See TAGS above for details on the options available for tags. +

+
pathName :tag :delete tagName ?tagName ...?
+

Deletes all tag information for each of the tagName +arguments. +The command removes the tags from all characters in the file +and also deletes any other information associated with the tags, +such as bindings and display information. +The command returns an empty string. +

+
pathName :tag :lower tagName ?belowThis?
+

Changes the priority of tag tagName so that it is just lower +in priority than the tag whose name is belowThis. +If belowThis is omitted, then tagName’s priority +is changed to make it lowest priority of all tags. +

+
pathName :tag :names ?index?
+

Returns a list whose elements are the names of all the tags that +are active at the character position given by index. +If index is omitted, then the return value will describe +all of the tags that exist for the text (this includes all tags +that have been named in a “pathName :tag” widget +command but haven’t been deleted by a “pathName :tag :delete” +widget command, even if no characters are currently marked with +the tag). +The list will be sorted in order from lowest priority to highest +priority. +

+
pathName :tag :nextrange tagName index1 ?index2?
+

This command searches the text for a range of characters tagged +with tagName where the first character of the range is +no earlier than the character at index1 and no later than +the character just before index2 (a range starting at +index2 will not be considered). +If several matching ranges exist, the first one is chosen. +The command’s return value is a list containing +two elements, which are the index of the first character of the +range and the index of the character just after the last one in +the range. +If no matching range is found then the return value is an +empty string. +If index2 is not given then it defaults to the end of the text. +

+
pathName :tag :raise tagName ?aboveThis?
+

Changes the priority of tag tagName so that it is just higher +in priority than the tag whose name is aboveThis. +If aboveThis is omitted, then tagName’s priority +is changed to make it highest priority of all tags. +

+
pathName :tag :ranges tagName
+

Returns a list describing all of the ranges of text that have been +tagged with tagName. +The first two elements of the list describe the first tagged range +in the text, the next two elements describe the second range, and +so on. +The first element of each pair contains the index of the first +character of the range, and the second element of the pair contains +the index of the character just after the last one in the +range. +If there are no characters tagged with tag then an +empty string is returned. +

+
pathName :tag :remove tagName index1 ?index2?
+

Remove the tag tagName from all of the characters starting +at index1 and ending just before +index2 (the character at index2 isn’t affected). +If index2 is omitted then the single character at +index1 is untagged. +If there are no characters in the specified range (e.g. index1 +is past the end of the file or index2 is less than or equal +to index1) then the command has no effect. +This command returns an empty string. +

+
+
+
+
pathName :yview ?:pickplace? what
+

This command changes the view in the widget’s window so that the line +given by what is visible in the window. +What may be either an absolute line number, where 0 corresponds +to the first line of the file, or an index with any of the forms +described under INDICES above. +The first form (absolute line number) is used in the commands issued +by scrollbars to control the widget’s view. +If the :pickplace option isn’t specified then what will +appear at the top of the window. +If :pickplace is specified then the widget chooses where +what appears in the window: +

    +
  • [1] +If what is already visible somewhere in the window then the +command does nothing. +
  • [2] +If what is only a few lines off-screen above the window then +it will be positioned at the top of the window. +
  • [3] +If what is only a few lines off-screen below the window then +it will be positioned at the bottom of the window. +
  • [4] +Otherwise, what will be centered in the window. +
+ +

The :pickplace option is typically used after inserting text +to make sure that the insertion cursor is still visible on the screen. +This command returns an empty string. +

+
+ + +

Bindings

+ +

Tk automatically creates class bindings for texts that give them +the following default behavior: +

    +
  • [1] +Pressing mouse button 1 in an text positions the insertion cursor +just before the character underneath the mouse cursor and sets the +input focus to this widget. +
  • [2] +Dragging with mouse button 1 strokes out a selection between +the insertion cursor and the character under the mouse. +
  • [3] +If you double-press mouse button 1 then the word under the mouse cursor +will be selected, the insertion cursor will be positioned at the +beginning of the word, and dragging the mouse will stroke out a selection +whole words at a time. +
  • [4] +If you triple-press mouse button 1 then the line under the mouse cursor +will be selected, the insertion cursor will be positioned at the +beginning of the line, and dragging the mouse will stroke out a selection +whole line at a time. +
  • [5] +The ends of the selection can be adjusted by dragging with mouse +button 1 while the shift key is down; this will adjust the end +of the selection that was nearest to the mouse cursor when button +1 was pressed. If the selection was made in word or line mode then +it will be adjusted in this same mode. +
  • [6] +The view in the text can be adjusted by dragging with mouse button 2. +
  • [7] +If the input focus is in a text widget and characters are typed on the +keyboard, the characters are inserted just before the insertion cursor. +
  • [8] +Control+h and the Backspace and Delete keys erase the character just +before the insertion cursor. +
  • [9] +Control+v inserts the current selection just before the insertion cursor. +
  • [10] +Control+d deletes the selected characters; an error occurs if the selection +is not in this widget. +
+ +

If the text is disabled using the state option, then the text’s +view can still be adjusted and text in the text can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. +

+

The behavior of texts can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +

+

"Performance Issues"

+ +

Text widgets should run efficiently under a variety +of conditions. The text widget uses about 2-3 bytes of +main memory for each byte of text, so texts containing a megabyte +or more should be practical on most workstations. +Text is represented internally with a modified B-tree structure +that makes operations relatively efficient even with large texts. +Tags are included in the B-tree structure in a way that allows +tags to span large ranges or have many disjoint smaller ranges +without loss of efficiency. +Marks are also implemented in a way that allows large numbers of +marks. +The only known mode of operation where a text widget may not run +efficiently is if it has a very large number of different tags. +Hundreds of tags should be fine, or even a thousand, +but tens of thousands of tags will make texts consume a lot of +memory and run slowly. +

+

Keywords

+

text, widget +

+
+

+Next: , Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/tk.html b/info/gcl-tk/tk.html new file mode 100644 index 0000000..3007db4 --- /dev/null +++ b/info/gcl-tk/tk.html @@ -0,0 +1,102 @@ + + + + + +tk (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.19 tk

+ +

tk \- Manipulate Tk internal state +

Synopsis

+

tk option ?arg arg ...? +

+

Description

+ +

The tk command provides access to miscellaneous +elements of Tk’s internal state. +Most of the information manipulated by this command pertains to the +application as a whole, or to a screen or display, rather than to a +particular window. +The command can take any of a number of different forms +depending on the option argument. The legal forms are: +

+
+
tk :colormodel window ?newValue?
+

If newValue isn’t specified, this command returns the current +color model in use for window’s screen, which will be either +color or monochrome. +If newValue is specified, then it must be either color +or monochrome or an abbreviation of one of them; +the color model for window’s screen is set to this value. +

+
+ + +

The color model is used by Tk and its widgets to determine whether +it should display in black and white only or use colors. +A single color model is shared by all of the windows managed by one +process on a given screen. +The color model for a screen is set initially by Tk to monochrome +if the display has four or fewer bit planes and to color otherwise. +The color model will automatically be changed from color to +monochrome if Tk fails to allocate a color because all entries +in the colormap were in use. +An application can change its own color model at any time (e.g. it +might change the model to monochrome in order to conserve +colormap entries, or it might set the model to color +to use color on a four-bit display in special circumstances), but +an application is not allowed to change the color model to color +unless the screen has at least two bit planes. +.RE +

+

Keywords

+

color model, internal state +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/tk_002ddialog.html b/info/gcl-tk/tk_002ddialog.html new file mode 100644 index 0000000..316e6b1 --- /dev/null +++ b/info/gcl-tk/tk_002ddialog.html @@ -0,0 +1,108 @@ + + + + + +tk-dialog (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.4 tk-dialog

+ +

tk-dialog \- Create modal dialog and wait for response +

Synopsis

+

tk-dialog window title text bitmap default string string ... +

+

Description

+ +

This procedure is part of the Tk script library. +Its arguments describe a dialog box: +

+
+
window
+

Name of top-level window to use for dialog. Any existing window +by this name is destroyed. +

+
title
+

Text to appear in the window manager’s title bar for the dialog. +

+
text
+

Message to appear in the top portion of the dialog box. +

+
bitmap
+

If non-empty, specifies a bitmap to display in the top portion of +the dialog, to the left of the text. +If this is an empty string then no bitmap is displayed in the dialog. +

+
default
+

If this is an integer greater than or equal to zero, then it gives +the index of the button that is to be the default button for the dialog +(0 for the leftmost button, and so on). +If less than zero or an empty string then there won’t be any default +button. +

+
string
+

There will be one button for each of these arguments. +Each string specifies text to display in a button, +in order from left to right. +

+

After creating a dialog box, tk-dialog waits for the user to +select one of the buttons either by clicking on the button with the +mouse or by typing return to invoke the default button (if any). +Then it returns the index of the selected button: 0 for the leftmost +button, 1 for the button next to it, and so on. +

+

While waiting for the user to respond, tk-dialog sets a local +grab. This prevents the user from interacting with the application +in any way except to invoke the dialog box. +

+
+
+

Keywords

+

bitmap, dialog, modal +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/tk_002dlistbox_002dsingle_002dselect.html b/info/gcl-tk/tk_002dlistbox_002dsingle_002dselect.html new file mode 100644 index 0000000..d11eb57 --- /dev/null +++ b/info/gcl-tk/tk_002dlistbox_002dsingle_002dselect.html @@ -0,0 +1,71 @@ + + + + + +tk-listbox-single-select (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.8 tk-listbox-single-select

+ +

tk-listbox-single-select \- Allow only one selected element in listbox(es) +

Synopsis

+

tk-listbox-single-select arg ?arg arg ...? +

+

Description

+ +

This command is a Tcl procedure provided as part of the Tk script library. +It takes as arguments the path names of one or more listbox widgets, +or the value Listbox. +For each named widget, tk-listbox-single-select modifies the +bindings of the widget so that only a single element may be selected +at a time (the normal configuration allows multiple elements to be +selected). +If the keyword Listbox is among the window arguments, +then the class bindings for listboxes are changed so that all +listboxes have the one-selection-at-a-time behavior. +

+

Keywords

+

listbox, selection +

+ + + + diff --git a/info/gcl-tk/tk_002dmenu_002dbar.html b/info/gcl-tk/tk_002dmenu_002dbar.html new file mode 100644 index 0000000..c6ac65c --- /dev/null +++ b/info/gcl-tk/tk_002dmenu_002dbar.html @@ -0,0 +1,184 @@ + + + + + +tk-menu-bar (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.10 tk-menu-bar

+ +

tk-menu-bar, tk_bindForTraversal \- Support for menu bars +

Synopsis

+

tk-menu-bar frame ?menu menu ...? +


+

tk_bindForTraversal arg arg ... +

+

Description

+ +

These two commands are Tcl procedures in the Tk script library. +They provide support for menu bars. +A menu bar is a frame that contains a collection of menu buttons that +work together, so that the user can scan from one menu to another with +the mouse: if the mouse button is pressed over one menubutton (causing it +to post its menu) and the mouse is moved over another menubutton +in the same menu bar without releasing the mouse button, then the +menu of the first menubutton is unposted and the menu of the +new menubutton is posted instead. +Menus in a menu bar can also be accessed using keyboard traversal (i.e. +by typing keystrokes instead of using the mouse). +In order for an application to use these procedures, it must do three +things, which are described in the paragraphs below. +

+

First, each application must call tk-menu-bar to provide information +about the menubar. +The frame argument gives the path name of the frame that contains +all of the menu buttons, and the menu arguments give path names +for all of the menu buttons associated with the menu bar. +Normally frame is the parent of each of the menu’s. +This need not be the case, but frame must be an ancestor of +each of the menu’s in order for grabs to work correctly when +the mouse is used to pull down menus. +The order of the menu arguments determines the traversal order +for the menu buttons. +If tk-menu-bar is called without any menu arguments, it +returns a list containing the current menu buttons for frame, +or an empty string if frame isn’t currently set up as a menu bar. +If tk-menu-bar is called with a single menu argument +consisting of an empty string, any menubar information for frame +is removed; from now on the menu buttons will function independently +without keyboard traversal. +Only one menu bar may be defined at a time within each top-level window. +

+

The second thing an application must do is to identify the traversal +characters for menu buttons and menu entries. +This is done by underlining those characters using the +:underline options for the widgets. +The menu traversal system uses this information to traverse the +menus under keyboard control (see below). +

+

The third thing that an application must do +is to make sure that the input focus is always in a window that +has been configured to support menu traversal. +If the input focus is none then input characters will +be discarded and no menu traversal will be possible. +If you have no other place to set the focus, set it to the menubar +widget: tk-menu-bar creates bindings for its frame argument to +support menu traversal. +

+

The Tk startup scripts configure all the Tk widget classes with +bindings to support menu traversal, so menu traversal will be possible +regardless of which widget has the focus. +If your application defines new classes of widgets that support the +input focus, then you should call tk_bindForTraversal for +each of these classes. +Tk_bindForTraversal takes any number of arguments, each of +which is a widget path name or widget class name. +It sets up bindings for all the named widgets and +classes so that the menu traversal system will be invoked when +appropriate keystrokes are typed in those widgets or classes. +

+

"Menu Traversal Bindings"

+ +

Once an application has made the three arrangements described +above, menu traversal will be available. +At any given time, the only menus available for traversal +are those associated with the top-level window containing the +input focus. +Menu traversal is initiated by one of the following actions: +

    +
  • [1] +If <F10> is typed, then the first menu button in the list for the +top-level window is posted and the first entry within that +menu is selected. +
  • [2] +If <Alt-key> is pressed, then the menu button that has key +as its underlined character is posted +and the first entry within that menu is selected. +The comparison between key and the underlined characters +ignores case differences. +If no menu button matches key then the keystroke has no +effect. +
  • [3] +Clicking mouse button 1 on a menu button posts that menu and selects +its first entry. +
+ + +

Once a menu has been posted, the input focus is switched to that +menu and the following actions are possible: +

    +
  • [1] +Typing <ESC> or clicking mouse button 1 outside the menu button or +its menu will abort the menu traversal. +
  • [2] +If <Alt-key> is pressed, then the entry in the posted menu +whose underlined character is key is invoked. +This causes the menu to be unposted, the entry’s action to be +taken, and the menu traversal to end. +The comparison between key and underlined characters ignores +case differences. +If no menu entry matches key then the keystroke is ignored. +
  • [3] +The arrow keys may be used to move among entries and menus. +The left and right arrow keys move circularly among the available +menus and the up and down arrow keys move circularly among the +entries in the current menu. +
  • [4] +If <Return> is pressed, the selected entry in the posted menu is +invoked, which causes the menu to be unposted, the entry’s action +to be taken, and the menu traversal to end. +
+ +

When a menu traversal completes, the input focus reverts to the +window that contained it when the traversal started. +

+

Keywords

+

keyboard traversal, menu, menu bar, post +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/tkconnect.html b/info/gcl-tk/tkconnect.html new file mode 100644 index 0000000..88fd098 --- /dev/null +++ b/info/gcl-tk/tkconnect.html @@ -0,0 +1,109 @@ + + + + + +tkconnect (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: General   [Contents]

+
+
+

1.8 tkconnect

+ +
+
tkconnect &key host display can-rsh gcltksrv
+
+ +

This function provides a connection to a graphics server process, which +in turn connects to possibly several graphics display screens. The +graphics server process, called gcltksrv may or may not run +on the same machine as the lisp to which it is attached. +display +indicates the name of the default display to connect to, and this +in turn defaults to the value of the environment variable DISPLAY. +

+

When tkconnect is invoked, a socket is opened and it waits for +a graphics process to connect to it. If the host argument is not +supplied, then a process will be spawned which will connect back to +the lisp process. The name of the command for invoking the process +is the value of the gcltksrv argument, which defaults to +the value of the environment variable GCL_TK_SERVER. If that variable +is not set, then the lisp *lib-directory* is searched for +an entry gcl-tk/gcltksrv. +

+

If host is supplied, then a command to run on the remote machine +will be printed on standard output. If can-rsh is not nil, +then the command will not be printed, but rather an attempt will be +made to rsh to the machine, and to run the command. +

+

Thus +

+
+
(tkconnect)
+
+ +

would start the process on the local machine, and use for display +the value of the environment variable DISPLAY. +

+
+
(tkconnect :host "max.ma.utexas.edu" :can-rsh t)
+
+ +

would cause an attempt to rsh to max and to run the command +there, to connect back to the appropriate port on the localhost. +

+

You may indicate that different toplevel windows be on different +displays, by using the :display argument when creating the +window, See toplevel. +

+

Clearly you must have a copy of the program gcltksrv and TK +libraries installed on the machine where you wish to run the server. +

+ + + +
+
+

+Previous: , Up: General   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/tkerror.html b/info/gcl-tk/tkerror.html new file mode 100644 index 0000000..8b07d32 --- /dev/null +++ b/info/gcl-tk/tkerror.html @@ -0,0 +1,97 @@ + + + + + +tkerror (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.20 tkerror

+ +

tkerror \- Command invoked to process background errors +

Synopsis

+

tkerror message +

+

Description

+ +

The tkerror command doesn’t exist as built-in part of Tk. Instead, +individual applications or users can define a tkerror +command (e.g. as a Tcl procedure) if they wish to handle background +errors. +

+

A background error is one that occurs in a command that didn’t +originate with the application. For example, if an error occurs +while executing a command specified with a bind of after +command, then it is a background error. For a non-background error, +the error can simply be returned up through nested Tcl command +evaluations until it reaches the top-level code in the application; +then the application can report the error in whatever way it +wishes. When a background error occurs, the unwinding ends in +the Tk library and there is no obvious way for Tk to report +the error. +

+

When Tk detects a background error, it invokes the tkerror +command, passing it the error message as its only argument. +Tk assumes that the application has implemented the tkerror +command, and that the command will report the error in a way that +makes sense for the application. Tk will ignore any result returned +by the tkerror command. +

+

If another Tcl error occurs within the tkerror command +then Tk reports the error itself by writing a message +to stderr. +

+

The Tk script library includes a default tkerror procedure +that posts a dialog box containing the error message and offers +the user a chance to see a stack trace that shows where the +error occurred. +

+

Keywords

+

background error, reporting +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/tkvars.html b/info/gcl-tk/tkvars.html new file mode 100644 index 0000000..d0f7d6f --- /dev/null +++ b/info/gcl-tk/tkvars.html @@ -0,0 +1,112 @@ + + + + + +tkvars (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.21 tkvars

+ +

tkvars \- Variables used or set by Tk +

+

Description

+ +

The following Tcl variables are either set or used by Tk at various times +in its execution: +

+
+
tk_library
+

Tk sets this variable hold the name of a directory containing a library +of Tcl scripts related to Tk. These scripts include an initialization +file that is normally processed whenever a Tk application starts up, +plus other files containing procedures that implement default behaviors +for widgets. +The value of this variable is taken from the TK_LIBRARY environment +variable, if one exists, or else from a default value compiled into +Tk. +

+
tk_patchLevel
+

Contains a decimal integer giving the current patch level for Tk. +The patch level is incremented for each new release or patch, and +it uniquely identifies an official version of Tk. +

+
tk_priv
+

This variable is an array containing several pieces of information +that are private to Tk. The elements of tk_priv are used by +Tk library procedures and default bindings. +They should not be accessed by any code outside Tk. +

+
tk_strictMotif
+

This variable is set to zero by default. +If an application sets it to one, then Tk attempts to adhere as +closely as possible to Motif look-and-feel standards. +For example, active elements such as buttons and scrollbar +sliders will not change color when the pointer passes over them. +

+
tk_version
+

Tk sets this variable in the interpreter for each application. +The variable holds the current version number of the Tk +library in the form major.minor. Major and +minor are integers. The major version number increases in +any Tk release that includes changes that are not backward compatible +(i.e. whenever existing Tk applications and scripts may have to change to +work with the new release). The minor version number increases with +each new release of Tk, except that it resets to zero whenever the +major version number changes. +

+
tkVersion
+

Has the same value as tk_version. This variable is obsolete and +will be deleted soon. +

+
+
+

Keywords

+

variables, version +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/tkwait.html b/info/gcl-tk/tkwait.html new file mode 100644 index 0000000..34edfce --- /dev/null +++ b/info/gcl-tk/tkwait.html @@ -0,0 +1,84 @@ + + + + + +tkwait (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.22 tkwait

+ +

tkwait \- Wait for variable to change or window to be destroyed +

Synopsis

+

tkwait :variable name
+
tkwait :visibility name
+tkwait :window name +

+

Description

+ +

The tkwait command waits for one of several things to happen, +then it returns without taking any other actions. +The return value is always an empty string. +If the first argument is :variable (or any abbreviation of +it) then the second argument is the name of a global variable and the +command waits for that variable to be modified. +If the first argument is :visibility (or any abbreviation +of it) then the second argument is the name of a window and the +tkwait command waits for a change in its +visibility state (as indicated by the arrival of a VisibilityNotify +event). This form is typically used to wait for a newly-created +window to appear on the screen before taking some action. +If the first argument is :window (or any abbreviation +of it) then the second argument is the name of a window and the +tkwait command waits for that window to be destroyed. +This form is typically used to wait for a user to finish interacting +with a dialog box before using the result of that interaction. +

+

While the tkwait command is waiting it processes events in +the normal fashion, so the application will continue to respond +to user interactions. +

+

Keywords

+

variable, visibility, wait, window +

+ + + + diff --git a/info/gcl-tk/toplevel.html b/info/gcl-tk/toplevel.html new file mode 100644 index 0000000..cbebe12 --- /dev/null +++ b/info/gcl-tk/toplevel.html @@ -0,0 +1,156 @@ + + + + + +toplevel (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Previous: , Up: Widgets   [Contents]

+
+
+

2.15 toplevel

+ +

toplevel \- Create and manipulate toplevel widgets +

Synopsis

+

toplevel pathName ?:screen screenName? ?:class className? ?options? +

Standard Options

+ + +
+
background                  geometry                
+borderWidth                 relief                  
+
+ + +

See options, for more information. +

Arguments for Toplevel

+ +

Description

+ +

The toplevel command creates a new toplevel widget (given +by the pathName argument). Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the toplevel such as its background color +and relief. The toplevel command returns the +path name of the new window. +

+

A toplevel is similar to a frame except that it is created as a +top-level window: its X parent is the root window of a screen +rather than the logical parent from its path name. The primary +purpose of a toplevel is to serve as a container for dialog boxes +and other collections of widgets. The only features +of a toplevel are its background color and an optional 3-D border +to make the toplevel appear raised or sunken. +

+

Two special command-line options may be provided to the toplevel +command: :class and :screen. If :class +is specified, then the new widget’s class will be set to +className instead of Toplevel. Changing the class of +a toplevel widget may be useful +in order to use a special class name in database options referring +to this widget and its children. The :screen option +may be used to place the window on a different screen than the +window’s logical parent. Any valid screen name may be used, even +one associated with a different display. +

+

Note: :class and :screen are handled +differently than other command-line options. They may not be specified +using the option database (these options must have been processed +before the new window has been created enough to use the option database; +in particular, the new class name will affect the lookup of options +in the database). In addition, :class and :screen +may not be queried or changed using the config command described +below. However, the winfo :class command may be used to query +the class of a window, and winfo :screen may be used to query +its screen. +

+

A Toplevel Widget’s Arguments

+ +

The toplevel command creates a new Tcl command whose +name is the same as the path name of the toplevel’s window. This +command may be used to invoke various +operations on the widget. It has the following general form: +

+
+
pathName option ?arg arg ...?
+
+ +

PathName is the name of the command, which is the same as +the toplevel widget’s path name. Option and the args +determine the exact behavior of the command. The following +commands are possible for toplevel widgets: +

+
+
pathName :configure ?option? ?value option value ...?
+

Query or modify the configuration options of the widget. +If no option is specified, returns a list describing all of +the available options for pathName (see Tk_ConfigureInfo for +information on the format of this list). If option is specified +with no value, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If +one or more option:value pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +Option may have any of the values accepted by the toplevel +command. +

+
+
+

Bindings

+ +

When a new toplevel is created, it has no default event bindings: +toplevels are not intended to be interactive. +

+

Keywords

+

toplevel, widget +

+ + + +
+
+

+Previous: , Up: Widgets   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/update.html b/info/gcl-tk/update.html new file mode 100644 index 0000000..bfae68c --- /dev/null +++ b/info/gcl-tk/update.html @@ -0,0 +1,85 @@ + + + + + +update (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.23 update

+ +

update \- Process pending events and/or when-idle handlers +

Synopsis

+

update ?:idletasks? +

+

Description

+ +

This command is used to bring the entire application world +“up to date.” +It flushes all pending output to the display, waits for the +server to process that output and return errors or events, +handles all pending events of any sort (including when-idle handlers), +and repeats this set of operations until there are no pending +events, no pending when-idle handlers, no pending output to the server, +and no operations still outstanding at the server. +

+

If the idletasks keyword is specified as an argument to the +command, then no new events or errors are processed; only when-idle +idlers are invoked. +This causes operations that are normally deferred, such as display +updates and window layout calculations, to be performed immediately. +

+

The update :idletasks command is useful in scripts where +changes have been made to the application’s state and you want those +changes to appear on the display immediately, rather than waiting +for the script to complete. +The update command with no options is useful in scripts where +you are performing a long-running computation but you still want +the application to respond to user interactions; if you occasionally +call update then user input will be processed during the +next call to update. +

+

Keywords

+

event, flush, handler, idle, update +

+ + + + diff --git a/info/gcl-tk/winfo.html b/info/gcl-tk/winfo.html new file mode 100644 index 0000000..865dbc1 --- /dev/null +++ b/info/gcl-tk/winfo.html @@ -0,0 +1,287 @@ + + + + + +winfo (GCL TK Manual) + + + + + + + + + + + + + + + + + +
+

+Next: , Previous: , Up: Control   [Contents]

+
+
+

3.24 winfo

+ +

winfo \- Return window-related information +

Synopsis

+

winfo option ?arg arg ...? +

+

Description

+ +

The winfo command is used to retrieve information about windows +managed by Tk. It can take any of a number of different forms, +depending on the option argument. The legal forms are: +

+
+
winfo :atom name
+

Returns a decimal string giving the integer identifier for the +atom whose name is name. If no atom exists with the name +name then a new one is created. +

+
winfo :atomname id
+

Returns the textual name for the atom whose integer identifier is +id. +This command is the inverse of the winfo :atom command. +Generates an error if no such atom exists. +

+
winfo :cells window
+

Returns a decimal string giving the number of cells in the +color map for window. +

+
winfo :children window
+

Returns a list containing the path names of all the children +of window. Top-level windows are returned as children +of their logical parents. +

+
winfo :class window
+

Returns the class name for window. +

+
winfo :containing rootX rootY
+

Returns the path name for the window containing the point given +by rootX and rootY. +RootX and rootY are specified in screen units (i.e. +any form acceptable to Tk_GetPixels) in the coordinate +system of the root window (if a virtual-root window manager is in +use then the coordinate system of the virtual root window is used). +If no window in this application contains the point then an empty +string is returned. +In selecting the containing window, children are given higher priority +than parents and among siblings the highest one in the stacking order is +chosen. +

+
winfo :depth window
+

Returns a decimal string giving the depth of window (number +of bits per pixel). +

+
winfo :exists window
+

Returns 1 if there exists a window named window, 0 if no such +window exists. +

+
winfo :fpixels window number
+

Returns a floating-point value giving the number of pixels +in window corresponding to the distance given by number. +Number may be specified in any of the forms acceptable +to Tk_GetScreenMM, such as “2.0c” or “1i”. +The return value may be fractional; for an integer value, use +winfo :pixels. +

+
winfo :geometry window
+

Returns the geometry for window, in the form +widthxheight+x+y. All dimensions are +in pixels. +

+
winfo :height window
+

Returns a decimal string giving window’s height in pixels. +When a window is first created its height will be 1 pixel; the +height will eventually be changed by a geometry manager to fulfill +the window’s needs. +If you need the true height immediately after creating a widget, +invoke update to force the geometry manager to arrange it, +or use winfo :reqheight to get the window’s requested height +instead of its actual height. +

+
winfo :id window
+

Returns a hexadecimal string indicating the X identifier for window. +

+
winfo :interps
+

Returns a list whose members are the names of all Tcl interpreters +(e.g. all Tk-based applications) currently registered for the +display of the invoking application. +

+
winfo :ismapped window
+

Returns 1 if window is currently mapped, 0 otherwise. +

+
winfo :name window
+

Returns window’s name (i.e. its name within its parent, as opposed +to its full path name). +The command winfo :name . will return the name of the application. +

+
winfo :parent window
+

Returns the path name of window’s parent, or an empty string +if window is the main window of the application. +

+
winfo :pathname id
+

Returns the path name of the window whose X identifier is id. +Id must be a decimal, hexadecimal, or octal integer and must +correspond to a window in the invoking application. +

+
winfo :pixels window number
+

Returns the number of pixels in window corresponding +to the distance given by number. +Number may be specified in any of the forms acceptable +to Tk_GetPixels, such as “2.0c” or “1i”. +The result is rounded to the nearest integer value; for a +fractional result, use winfo :fpixels. +

+
winfo :reqheight window
+

Returns a decimal string giving window’s requested height, +in pixels. This is the value used by window’s geometry +manager to compute its geometry. +

+
winfo :reqwidth window
+

Returns a decimal string giving window’s requested width, +in pixels. This is the value used by window’s geometry +manager to compute its geometry. +

+
winfo :rgb window color
+

Returns a list containing three decimal values, which are the +red, green, and blue intensities that correspond to color in +the window given by window. Color +may be specified in any of the forms acceptable for a color +option. +

+
winfo :rootx window
+

Returns a decimal string giving the x-coordinate, in the root +window of the screen, of the +upper-left corner of window’s border (or window if it +has no border). +

+
winfo :rooty window
+

Returns a decimal string giving the y-coordinate, in the root +window of the screen, of the +upper-left corner of window’s border (or window if it +has no border). +

+
winfo :screen window
+

Returns the name of the screen associated with window, in +the form displayName.screenIndex. +

+
winfo :screencells window
+

Returns a decimal string giving the number of cells in the default +color map for window’s screen. +

+
winfo :screendepth window
+

Returns a decimal string giving the depth of the root window +of window’s screen (number of bits per pixel). +

+
winfo :screenheight window
+

Returns a decimal string giving the height of window’s screen, +in pixels. +

+
winfo :screenmmheight window
+

Returns a decimal string giving the height of window’s screen, +in millimeters. +

+
winfo :screenmmwidth window
+

Returns a decimal string giving the width of window’s screen, +in millimeters. +

+
winfo :screenvisual window
+

Returns one of the following strings to indicate the default visual +type for window’s screen: directcolor, grayscale, +pseudocolor, staticcolor, staticgray, or +truecolor. +

+
winfo :screenwidth window
+

Returns a decimal string giving the width of window’s screen, +in pixels. +

+
winfo :toplevel window
+

Returns the path name of the top-level window containing window. +

+
winfo :visual window
+

Returns one of the following strings to indicate the visual +type for window: directcolor, grayscale, +pseudocolor, staticcolor, staticgray, or +truecolor. +

+
winfo :vrootheight window
+

Returns the height of the virtual root window associated with window +if there is one; otherwise returns the height of window’s screen. +

+
winfo :vrootwidth window
+

Returns the width of the virtual root window associated with window +if there is one; otherwise returns the width of window’s screen. +

+
winfo :vrootx window
+

Returns the x-offset of the virtual root window associated with window, +relative to the root window of its screen. +This is normally either zero or negative. +Returns 0 if there is no virtual root window for window. +

+
winfo :vrooty window
+

Returns the y-offset of the virtual root window associated with window, +relative to the root window of its screen. +This is normally either zero or negative. +Returns 0 if there is no virtual root window for window. +

+
winfo :width window
+

Returns a decimal string giving window’s width in pixels. +When a window is first created its width will be 1 pixel; the +width will eventually be changed by a geometry manager to fulfill +the window’s needs. +If you need the true width immediately after creating a widget, +invoke update to force the geometry manager to arrange it, +or use winfo :reqwidth to get the window’s requested width +instead of its actual width. +

+
winfo :x window
+

Returns a decimal string giving the x-coordinate, in window’s +parent, of the +upper-left corner of window’s border (or window if it +has no border). +

+
winfo :y window
+

Returns a decimal string giving the y-coordinate, in window’s +parent, of the +upper-left corner of window’s border (or window if it +has no border). +

+
+
+

Keywords

+

atom, children, class, geometry, height, identifier, information, interpreters, +mapped, parent, path name, screen, virtual root, width, window +

+
+

+Next: , Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl-tk/wm.html b/info/gcl-tk/wm.html new file mode 100644 index 0000000..f038fb1 --- /dev/null +++ b/info/gcl-tk/wm.html @@ -0,0 +1,945 @@ + + + + + +wm (GCL TK Manual) + + + + + + + + + + + + + + + + +
+

+Previous: , Up: Control   [Contents]

+
+
+

3.25 wm

+ +

wm \- Communicate with window manager +

Synopsis

+

wm option window ?args? +

+

Description

+ +

The wm command is used to interact with window managers in +order to control such things as the title for a window, its geometry, +or the increments in terms of which it may be resized. The wm +command can take any of a number of different forms, depending on +the option argument. All of the forms expect at least one +additional argument, window, which must be the path name of a +top-level window. +

+

The legal forms for the wm command are: +

+
+
wm :aspect window ?minNumer minDenom maxNumer maxDenom?
+

If minNumer, minDenom, maxNumer, and maxDenom +are all specified, then they will be passed to the window manager +and the window manager should use them to enforce a range of +acceptable aspect ratios for window. The aspect ratio of +window (width/length) will be constrained to lie +between minNumer/minDenom and maxNumer/maxDenom. +If minNumer etc. are all specified as empty strings, then +any existing aspect ratio restrictions are removed. +If minNumer etc. are specified, then the command returns an +empty string. Otherwise, it returns +a Tcl list containing four elements, which are the current values +of minNumer, minDenom, maxNumer, and maxDenom +(if no aspect restrictions are in effect, then an empty string is +returned). +

+
wm :client window ?name?
+

If name is specified, this command stores name (which +should be the name of +the host on which the application is executing) in window’s +WM_CLIENT_MACHINE property for use by the window manager or +session manager. +The command returns an empty string in this case. +If name isn’t specified, the command returns the last name +set in a wm :client command for window. +If name is specified as an empty string, the command deletes the +WM_CLIENT_MACHINE property from window. +

+
wm :command window ?value?
+

If value is specified, this command stores value in window’s +WM_COMMAND property for use by the window manager or +session manager and returns an empty string. +Value must have proper list structure; the elements should +contain the words of the command used to invoke the application. +If value isn’t specified then the command returns the last value +set in a wm :command command for window. +If value is specified as an empty string, the command +deletes the WM_COMMAND property from window. +

+
wm :deiconify window
+

Arrange for window to be displayed in normal (non-iconified) form. +This is done by mapping the window. If the window has never been +mapped then this command will not map the window, but it will ensure +that when the window is first mapped it will be displayed +in de-iconified form. Returns an empty string. +

+
wm :focusmodel window ?active|passive?
+

If active or passive is supplied as an optional argument +to the command, then it specifies the focus model for window. +In this case the command returns an empty string. If no additional +argument is supplied, then the command returns the current focus +model for window. +An active focus model means that window will claim the +input focus for itself or its descendants, even at times when +the focus is currently in some other application. Passive means that +window will never claim the focus for itself: the window manager +should give the focus to window at appropriate times. However, +once the focus has been given to window or one of its descendants, +the application may re-assign the focus among window’s descendants. +The focus model defaults to passive, and Tk’s focus command +assumes a passive model of focussing. +

+
wm :frame window
+

If window has been reparented by the window manager into a +decorative frame, the command returns the X window identifier for +the outermost frame that contains window (the window whose +parent is the root or virtual root). If window hasn’t been +reparented by the window manager then the command returns the +X window identifier for window. +

+
wm :geometry window ?newGeometry?
+

If newGeometry is specified, then the geometry of window +is changed and an empty string is returned. Otherwise the current +geometry for window is returned (this is the most recent +geometry specified either by manual resizing or +in a wm :geometry command). NewGeometry has +the form =widthxheight\(+-x\(+-y, where +any of =, widthxheight, or \(+-x\(+-y +may be omitted. Width and height are positive integers +specifying the desired dimensions of window. If window +is gridded (see GRIDDED GEOMETRY MANAGEMENT below) then the dimensions +are specified in grid units; otherwise they are specified in pixel +units. X and y specify the desired location of +window on the screen, in pixels. +If x is preceded by +, it specifies +the number of pixels between the left edge of the screen and the left +edge of window’s border; if preceded by - then +x specifies the number of pixels +between the right edge of the screen and the right edge of window’s +border. If y is preceded by + then it specifies the +number of pixels between the top of the screen and the top +of window’s border; if y is preceded by - then +it specifies the number of pixels between the bottom of window’s +border and the bottom of the screen. +If newGeometry is specified as an empty string then any +existing user-specified geometry for window is cancelled, and +the window will revert to the size requested internally by its +widgets. +

+
wm :grid window ?baseWidth baseHeight widthInc heightInc?
+

This command indicates that window is to be managed as a +gridded window. +It also specifies the relationship between grid units and pixel units. +BaseWidth and baseHeight specify the number of grid +units corresponding to the pixel dimensions requested internally +by window using Tk_GeometryRequest. WidthInc +and heightInc specify the number of pixels in each horizontal +and vertical grid unit. +These four values determine a range of acceptable sizes for +window, corresponding to grid-based widths and heights +that are non-negative integers. +Tk will pass this information to the window manager; during +manual resizing, the window manager will restrict the window’s size +to one of these acceptable sizes. +Furthermore, during manual resizing the window manager will display +the window’s current size in terms of grid units rather than pixels. +If baseWidth etc. are all specified as empty strings, then +window will no longer be managed as a gridded window. If +baseWidth etc. are specified then the return value is an +empty string. +Otherwise the return value is a Tcl list containing +four elements corresponding to the current baseWidth, +baseHeight, widthInc, and heightInc; if +window is not currently gridded, then an empty string +is returned. +Note: this command should not be needed very often, since the +Tk_SetGrid library procedure and the setGrid option +provide easier access to the same functionality. +

+
wm :group window ?pathName?
+

If pathName is specified, it gives the path name for the leader of +a group of related windows. The window manager may use this information, +for example, to unmap all of the windows in a group when the group’s +leader is iconified. PathName may be specified as an empty string to +remove window from any group association. If pathName is +specified then the command returns an empty string; otherwise it +returns the path name of window’s current group leader, or an empty +string if window isn’t part of any group. +

+
wm :iconbitmap window ?bitmap?
+

If bitmap is specified, then it names a bitmap in the standard +forms accepted by Tk (see the Tk_GetBitmap manual entry for details). +This bitmap is passed to the window manager to be displayed in +window’s icon, and the command returns an empty string. If +an empty string is specified for bitmap, then any current icon +bitmap is cancelled for window. +If bitmap is specified then the command returns an empty string. +Otherwise it returns the name of +the current icon bitmap associated with window, or an empty +string if window has no icon bitmap. +

+
wm :iconify window
+

Arrange for window to be iconified. It window hasn’t +yet been mapped for the first time, this command will arrange for +it to appear in the iconified state when it is eventually mapped. +

+
wm :iconmask window ?bitmap?
+

If bitmap is specified, then it names a bitmap in the standard +forms accepted by Tk (see the Tk_GetBitmap manual entry for details). +This bitmap is passed to the window manager to be used as a mask +in conjunction with the iconbitmap option: where the mask +has zeroes no icon will be displayed; where it has ones, the bits +from the icon bitmap will be displayed. If +an empty string is specified for bitmap then any current icon +mask is cancelled for window (this is equivalent to specifying +a bitmap of all ones). If bitmap is specified +then the command returns an empty string. Otherwise it +returns the name of the current icon mask associated with +window, or an empty string if no mask is in effect. +

+
wm :iconname window ?newName?
+

If newName is specified, then it is passed to the window +manager; the window manager should display newName inside +the icon associated with window. In this case an empty +string is returned as result. If newName isn’t specified +then the command returns the current icon name for window, +or an empty string if no icon name has been specified (in this +case the window manager will normally display the window’s title, +as specified with the wm :title command). +

+
wm :iconposition window ?x y?
+

If x and y are specified, they are passed to the window +manager as a hint about where to position the icon for window. +In this case an empty string is returned. If x and y are +specified as empty strings then any existing icon position hint is cancelled. +If neither x nor y is specified, then the command returns +a Tcl list containing two values, which are the current icon position +hints (if no hints are in effect then an empty string is returned). +

+
wm :iconwindow window ?pathName?
+

If pathName is specified, it is the path name for a window to +use as icon for window: when window is iconified then +pathName should be mapped to serve as icon, and when window +is de-iconified then pathName will be unmapped again. If +pathName is specified as an empty string then any existing +icon window association for window will be cancelled. If +the pathName argument is specified then an empty string is +returned. Otherwise the command returns the path name of the +current icon window for window, or an empty string if there +is no icon window currently specified for window. Note: +not all window managers support the notion of an icon window. +

+
wm :maxsize window ?width height?
+

If width and height are specified, then window +becomes resizable and width and height give its +maximum permissible dimensions. +For gridded windows the dimensions are specified in +grid units; otherwise they are specified in pixel units. +During manual sizing, the window manager +should restrict the window’s dimensions to be less than or +equal to width and height. +If width and height are specified as empty strings, +then the maximum size option is cancelled for window. +If width and height are +specified, then the command returns an empty string. Otherwise +it returns a Tcl list with two elements, which are the +maximum width and height currently in effect; if no maximum +dimensions are in effect for window then an empty +string is returned. See the sections on geometry management +below for more information. +

+
wm :minsize window ?width height?
+

If width and height are specified, then window +becomes resizable and width and height give its +minimum permissible dimensions. +For gridded windows the dimensions are specified in +grid units; otherwise they are specified in pixel units. +During manual sizing, the window manager +should restrict the window’s dimensions to be greater than or +equal to width and height. +If width and height are specified as empty strings, +then the minimum size option is cancelled for window. +If width and height are +specified, then the command returns an empty string. Otherwise +it returns a Tcl list with two elements, which are the +minimum width and height currently in effect; if no minimum +dimensions are in effect for window then an empty +string is returned. See the sections on geometry management +below for more information. +

+
wm :overrideredirect window ?boolean?
+

If boolean is specified, it must have a proper boolean form and +the override-redirect flag for window is set to that value. +If boolean is not specified then 1 or 0 is +returned to indicate whether or not the override-redirect flag +is currently set for window. +Setting the override-redirect flag for a window causes +it to be ignored by the window manager; among other things, this means +that the window will not be reparented from the root window into a +decorative frame and the user will not be able to manipulate the +window using the normal window manager mechanisms. +

+
wm :positionfrom window ?who?
+

If who is specified, it must be either program or +user, or an abbreviation of one of these two. It indicates +whether window’s current position was requested by the +program or by the user. Many window managers ignore program-requested +initial positions and ask the user to manually position the window; if +user is specified then the window manager should position the +window at the given place without asking the user for assistance. +If who is specified as an empty string, then the current position +source is cancelled. +If who is specified, then the command returns an empty string. +Otherwise it returns user or window to indicate the +source of the window’s current position, or an empty string if +no source has been specified yet. Most window managers interpret +“no source” as equivalent to program. +Tk will automatically set the position source to user +when a wm :geometry command is invoked, unless the source has +been set explicitly to program. +

+
wm :protocol window ?name? ?command?
+

This command is used to manage window manager protocols such as +WM_DELETE_WINDOW. +Name is the name of an atom corresponding to a window manager +protocol, such as WM_DELETE_WINDOW or WM_SAVE_YOURSELF +or WM_TAKE_FOCUS. +If both name and command are specified, then command +is associated with the protocol specified by name. +Name will be added to window’s WM_PROTOCOLS +property to tell the window manager that the application has a +protocol handler for name, and command will +be invoked in the future whenever the window manager sends a +message to the client for that protocol. +In this case the command returns an empty string. +If name is specified but command isn’t, then the current +command for name is returned, or an empty string if there +is no handler defined for name. +If command is specified as an empty string then the current +handler for name is deleted and it is removed from the +WM_PROTOCOLS property on window; an empty string is +returned. +Lastly, if neither name nor command is specified, the +command returns a list of all the protocols for which handlers +are currently defined for window. +

+
+ + +

Tk always defines a protocol handler for WM_DELETE_WINDOW, even if +you haven’t asked for one with wm :protocol. +If a WM_DELETE_WINDOW message arrives when you haven’t defined +a handler, then Tk handles the message by destroying the window for +which it was received. +.RE +

+
+
wm :sizefrom window ?who?
+

If who is specified, it must be either program or +user, or an abbreviation of one of these two. It indicates +whether window’s current size was requested by the +program or by the user. Some window managers ignore program-requested +sizes and ask the user to manually size the window; if +user is specified then the window manager should give the +window its specified size without asking the user for assistance. +If who is specified as an empty string, then the current size +source is cancelled. +If who is specified, then the command returns an empty string. +Otherwise it returns user or window to indicate the +source of the window’s current size, or an empty string if +no source has been specified yet. Most window managers interpret +“no source” as equivalent to program. +

+
wm :state window
+

Returns the current state of window: either normal, +iconic, or withdrawn. +

+
wm :title window ?string?
+

If string is specified, then it will be passed to the window +manager for use as the title for window (the window manager +should display this string in window’s title bar). In this +case the command returns an empty string. If string isn’t +specified then the command returns the current title for the +window. The title for a window defaults to its name. +

+
wm :transient window ?master?
+

If master is specified, then the window manager is informed +that window is a transient window (e.g. pull-down menu) working +on behalf of master (where master is the +path name for a top-level window). Some window managers will use +this information to manage window specially. If master +is specified as an empty string then window is marked as not +being a transient window any more. If master is specified, +then the command returns an empty string. Otherwise the command +returns the path name of window’s current master, or an +empty string if window isn’t currently a transient window. +

+
wm :withdraw window
+

Arranges for window to be withdrawn from the screen. This +causes the window to be unmapped and forgotten about by the window +manager. If the window +has never been mapped, then this command +causes the window to be mapped in the withdrawn state. Not all +window managers appear to know how to handle windows that are +mapped in the withdrawn state. +Note: it sometimes seems to be necessary to withdraw a +window and then re-map it (e.g. with wm :deiconify) to get some +window managers to pay attention to changes in window attributes +such as group. +

+
+
+

"Sources Of Geometry Information"

+ +

Size-related information for top-level windows +can come from three sources. +First, geometry requests come from the widgets that are descendants +of a top-level window. +Each widget requests a particular size for itself +by calling Tk_GeometryRequest. This information is passed to +geometry managers, which then request large enough sizes for parent +windows so that they can layout the children properly. +Geometry information passes upwards through the window hierarchy +until eventually a particular size is requested for each top-level +window. +These requests are called internal requests in the discussion +below. +The second source of width and height information is through the +wm :geometry command. Third, the user can +request a particular size for a window using the +interactive facilities of the window manager. +The second and third types of geometry requests are called +external requests in the discussion below; Tk treats +these two kinds of requests identically. +

+

"Ungridded Geometry Management"

+ +

Tk allows the geometry of a top-level window to be managed in +either of two general ways: ungridded or gridded. +The ungridded form occurs if no wm :grid command +has been issued for a top-level window. +Ungridded management has several variants. +In the simplest variant of ungridded windows, +no wm :geometry, wm :minsize, or wm :maxsize +commands have been invoked either. +In this case, the window’s size is +determined totally by the internal requests emanating from the +widgets inside the window: Tk will ask the window manager not to +permit the user to resize the window interactively. +

+

If a wm :geometry command is invoked on an ungridded window, +then the size in that command overrides any size requested by the +window’s widgets; from now on, the window’s size will be determined +entirely by the most recent information from wm :geometry +commands. To go back to using the size requested by the window’s +widgets, issue a wm :geometry command with an empty geometry +string. +

+

To enable interactive resizing of an ungridded window, one or both +of the wm :maxsize +and wm :minsize commands must be issued. +The information from these commands will be passed to the window +manager, and size changes within the specified range will be permitted. +For ungridded windows the limits refer to the top-level window’s +dimensions in pixels. +If only a wm :maxsize command is issued then the minimum +dimensions default to 1; if only a wm :minsize command is +issued then the maximum dimensions default to the size of the display. +If the size of a window is changed interactively, it has the same +effect as if wm :geometry had been invoked: from now on, internal +geometry requests will be ignored. +To return to internal control over the window’s size, issue a +wm :geometry command with an empty geometry argument. +If a window has been manually resized or moved, the wm :geometry +command will return the geometry that was requested interactively. +

+

"Gridded Geometry Management"

+ +

The second style of geometry management is called gridded. +This approach occurs when one of the widgets of an application +supports a range of useful sizes. +This occurs, for example, in a text editor where the scrollbars, +menus, and other adornments are fixed in size but the edit widget +can support any number of lines of text or characters per line. +In this case, it is usually desirable to let the user specify the +number of lines or characters-per-line, either with the +wm :geometry command or by interactively resizing the window. +In the case of text, and in other interesting cases also, only +discrete sizes of the window make sense, such as integral numbers +of lines and characters-per-line; arbitrary pixel sizes are not useful. +

+

Gridded geometry management provides support for this kind of +application. +Tk (and the window manager) assume that there is a grid of some +sort within the application and that the application should be +resized in terms of grid units rather than pixels. +Gridded geometry management is typically invoked by turning on +the setGrid option for a widget; it can also be invoked +with the wm :grid command or by calling Tk_SetGrid. +In each of these approaches the particular widget (or sometimes +code in the application as a whole) specifies the relationship between +integral grid sizes for the window and pixel sizes. +To return to non-gridded geometry management, invoke +wm :grid with empty argument strings. +

+

When gridded geometry management is enabled then all the dimensions specified +in wm :minsize, wm :maxsize, and wm :geometry commands +are treated as grid units rather than pixel units. +Interactive resizing is automatically enabled, and it will be +carried out in even numbers of grid units rather than pixels. +By default there are no limits on the minimum or maximum dimensions +of a gridded window. +As with ungridded windows, interactive resizing has exactly the +same effect as invoking the wm :geometry command. +For gridded windows, internally- and externally-requested dimensions +work together: the externally-specified width and height determine +the size of the window in grid units, and the information from the +last wm :grid command maps from grid units to pixel units. +

+

Bugs

+ +

The window manager interactions seem too complicated, especially +for managing geometry. Suggestions on how to simplify this would +be greatly appreciated. +

+

Most existing window managers appear to have bugs that affect the +operation of the wm command. For example, some changes won’t +take effect if the window is already active: the window will have +to be withdrawn and de-iconified in order to make the change happen. +

+

Keywords

+

aspect ratio, deiconify, focus model, geometry, grid, group, icon, iconify, increments, position, size, title, top-level window, units, window manager +

+ +

Short Table of Contents

+ +
+ +
+ + +

Table of Contents

+ +
+ + +
+ +
+
+

+Previous: , Up: Control   [Contents]

+
+ + + + + diff --git a/info/gcl.info b/info/gcl.info new file mode 100644 index 0000000..5d1dee2 --- /dev/null +++ b/info/gcl.info @@ -0,0 +1,1472 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +Indirect: +gcl.info-1: 314 +gcl.info-2: 301351 +gcl.info-3: 608702 +gcl.info-4: 900342 +gcl.info-5: 1205418 +gcl.info-6: 1502760 +gcl.info-7: 1802947 +gcl.info-8: 2100572 +gcl.info-9: 2402082 + +Tag Table: +(Indirect) +Node: Top314 +Node: Introduction (Introduction)41180 +Node: Scope41532 +Node: Scope and Purpose41780 +Node: History42223 +Node: Organization of the Document51793 +Node: Referenced Publications54048 +Node: Definitions57705 +Node: Notational Conventions58097 +Node: Font Key58726 +Node: Modified BNF Syntax60567 +Node: Splicing in Modified BNF Syntax60942 +Node: Indirection in Modified BNF Syntax63438 +Node: Additional Uses for Indirect Definitions in Modified BNF Syntax64086 +Node: Special Symbols65255 +Node: Objects with Multiple Notations70029 +Node: Case in Symbols70473 +Node: Numbers (Objects with Multiple Notations)71643 +Node: Use of the Dot Character72043 +Node: NIL72985 +Node: Designators75105 +Node: Nonsense Words77513 +Node: Error Terminology78192 +Node: Sections Not Formally Part Of This Standard85515 +Node: Interpreting Dictionary Entries87025 +Node: The "Affected By" Section of a Dictionary Entry89424 +Node: The "Arguments" Section of a Dictionary Entry89957 +Node: The "Arguments and Values" Section of a Dictionary Entry90479 +Node: The "Binding Types Affected" Section of a Dictionary Entry91242 +Node: The "Class Precedence List" Section of a Dictionary Entry91930 +Node: Dictionary Entries for Type Specifiers93106 +Node: The "Compound Type Specifier Kind" Section of a Dictionary Entry94248 +Node: The "Compound Type Specifier Syntax" Section of a Dictionary Entry95299 +Node: The "Compound Type Specifier Arguments" Section of a Dictionary Entry95975 +Node: The "Compound Type Specifier Description" Section of a Dictionary Entry96542 +Node: The "Constant Value" Section of a Dictionary Entry97093 +Node: The "Description" Section of a Dictionary Entry97547 +Node: The "Examples" Section of a Dictionary Entry98072 +Node: The "Exceptional Situations" Section of a Dictionary Entry98561 +Node: The "Initial Value" Section of a Dictionary Entry99402 +Node: The "Argument Precedence Order" Section of a Dictionary Entry99926 +Node: The "Method Signature" Section of a Dictionary Entry100454 +Node: The "Name" Section of a Dictionary Entry101986 +Node: The "Notes" Section of a Dictionary Entry104046 +Node: The "Pronunciation" Section of a Dictionary Entry104756 +Node: The "See Also" Section of a Dictionary Entry105571 +Node: The "Side Effects" Section of a Dictionary Entry106046 +Node: The "Supertypes" Section of a Dictionary Entry106478 +Node: The "Syntax" Section of a Dictionary Entry107115 +Node: Special "Syntax" Notations for Overloaded Operators108300 +Node: Naming Conventions for Rest Parameters109438 +Node: Requiring Non-Null Rest Parameters in The "Syntax" Section110293 +Node: Return values in The "Syntax" Section111185 +Node: No Arguments or Values in The "Syntax" Section111864 +Node: Unconditional Transfer of Control in The "Syntax" Section112460 +Node: The "Valid Context" Section of a Dictionary Entry113025 +Node: The "Value Type" Section of a Dictionary Entry113666 +Node: Conformance114021 +Node: Conforming Implementations114437 +Node: Required Language Features115042 +Node: Documentation of Implementation-Dependent Features115671 +Node: Documentation of Extensions116398 +Node: Treatment of Exceptional Situations117041 +Node: Resolution of Apparent Conflicts in Exceptional Situations117440 +Node: Examples of Resolution of Apparent Conflict in Exceptional Situations118110 +Node: Conformance Statement119114 +Node: Conforming Programs120097 +Node: Use of Implementation-Defined Language Features121058 +Node: Use of Read-Time Conditionals122270 +Node: Language Extensions123421 +Node: Language Subsets125834 +Node: Deprecated Language Features126551 +Node: Deprecated Functions127392 +Node: Deprecated Argument Conventions128051 +Node: Deprecated Variables129164 +Node: Deprecated Reader Syntax129413 +Node: Symbols in the COMMON-LISP Package129884 +Node: Syntax160374 +Node: Character Syntax160618 +Node: Readtables161371 +Node: The Current Readtable162277 +Node: The Standard Readtable162862 +Node: The Initial Readtable163399 +Node: Variables that affect the Lisp Reader163854 +Node: Standard Characters164438 +Node: Character Syntax Types169760 +Node: Constituent Characters173982 +Node: Constituent Traits174597 +Node: Invalid Characters179000 +Node: Macro Characters179548 +Node: Multiple Escape Characters182322 +Node: Examples of Multiple Escape Characters182977 +Node: Single Escape Character183478 +Node: Examples of Single Escape Characters183973 +Node: Whitespace Characters184463 +Node: Examples of Whitespace Characters184812 +Node: Reader Algorithm185173 +Node: Interpretation of Tokens191679 +Node: Numbers as Tokens192039 +Node: Potential Numbers as Tokens193289 +Node: Escape Characters and Potential Numbers195879 +Node: Examples of Potential Numbers196644 +Node: Constructing Numbers from Tokens197804 +Node: Syntax of a Rational198605 +Node: Syntax of an Integer198820 +Node: Syntax of a Ratio199411 +Node: Syntax of a Float200691 +Node: Syntax of a Complex203539 +Node: The Consing Dot204595 +Node: Symbols as Tokens205119 +Node: Valid Patterns for Tokens209047 +Node: Package System Consistency Rules212748 +Node: Standard Macro Characters214409 +Node: Left-Parenthesis215181 +Node: Right-Parenthesis216709 +Node: Single-Quote217036 +Node: Examples of Single-Quote217494 +Node: Semicolon217728 +Node: Examples of Semicolon218292 +Node: Notes about Style for Semicolon218518 +Node: Use of Single Semicolon218935 +Node: Use of Double Semicolon219526 +Node: Use of Triple Semicolon220024 +Node: Use of Quadruple Semicolon220404 +Node: Examples of Style for Semicolon220914 +Node: Double-Quote221887 +Node: Backquote223390 +Node: Notes about Backquote227313 +Node: Comma228384 +Node: Sharpsign228675 +Node: Sharpsign Backslash233650 +Node: Sharpsign Single-Quote234813 +Node: Sharpsign Left-Parenthesis235285 +Node: Sharpsign Asterisk236805 +Node: Examples of Sharpsign Asterisk238069 +Node: Sharpsign Colon238487 +Node: Sharpsign Dot239003 +Node: Sharpsign B239681 +Node: Sharpsign O240070 +Node: Sharpsign X240474 +Node: Sharpsign R240978 +Node: Sharpsign C242440 +Node: Sharpsign A243600 +Node: Sharpsign S244797 +Node: Sharpsign P245904 +Node: Sharpsign Equal-Sign246321 +Node: Sharpsign Sharpsign246842 +Node: Sharpsign Plus247911 +Node: Sharpsign Minus248953 +Node: Sharpsign Vertical-Bar249312 +Node: Examples of Sharpsign Vertical-Bar249679 +Node: Notes about Style for Sharpsign Vertical-Bar252661 +Node: Sharpsign Less-Than-Sign253631 +Node: Sharpsign Whitespace254069 +Node: Sharpsign Right-Parenthesis254456 +Node: Re-Reading Abbreviated Expressions254756 +Node: Evaluation and Compilation255249 +Node: Evaluation255630 +Node: Introduction to Environments256918 +Node: The Global Environment257776 +Node: Dynamic Environments258427 +Node: Lexical Environments259586 +Node: The Null Lexical Environment260811 +Node: Environment Objects261325 +Node: The Evaluation Model262292 +Node: Form Evaluation262987 +Node: Symbols as Forms263290 +Node: Lexical Variables265379 +Node: Dynamic Variables266410 +Node: Constant Variables268155 +Node: Symbols Naming Both Lexical and Dynamic Variables268871 +Node: Conses as Forms269722 +Node: Special Forms270669 +Node: Macro Forms272315 +Node: Function Forms274152 +Node: Lambda Forms276705 +Node: Self-Evaluating Objects277363 +Node: Examples of Self-Evaluating Objects278085 +Node: Lambda Expressions278541 +Node: Closures and Lexical Binding279180 +Node: Shadowing282933 +Node: Extent286104 +Node: Return Values288370 +Node: Compilation289751 +Node: Compiler Terminology290058 +Node: Compilation Semantics294351 +Node: Compiler Macros295034 +Node: Purpose of Compiler Macros296703 +Node: Naming of Compiler Macros298418 +Node: When Compiler Macros Are Used299396 +Node: Notes about the Implementation of Compiler Macros301351 +Node: Minimal Compilation302468 +Node: Semantic Constraints303644 +Node: File Compilation307298 +Node: Processing of Top Level Forms309271 +Node: Processing of Defining Macros313498 +Node: Constraints on Macros and Compiler Macros316041 +Node: Literal Objects in Compiled Files316841 +Node: Externalizable Objects318251 +Node: Similarity of Literal Objects319879 +Node: Similarity of Aggregate Objects320123 +Node: Definition of Similarity320707 +Node: Extensions to Similarity Rules325575 +Node: Additional Constraints on Externalizable Objects326451 +Node: Exceptional Situations in the Compiler331188 +Node: Declarations333287 +Node: Minimal Declaration Processing Requirements334074 +Node: Declaration Specifiers335240 +Node: Declaration Identifiers335742 +Node: Shorthand notation for Type Declarations336588 +Node: Declaration Scope336955 +Node: Examples of Declaration Scope338928 +Node: Lambda Lists342126 +Node: Ordinary Lambda Lists345136 +Node: Specifiers for the required parameters347779 +Node: Specifiers for optional parameters348629 +Node: A specifier for a rest parameter349810 +Node: Specifiers for keyword parameters350815 +Node: Suppressing Keyword Argument Checking354838 +Node: Examples of Suppressing Keyword Argument Checking355529 +Node: Specifiers for &aux variables356767 +Node: Examples of Ordinary Lambda Lists357617 +Node: Generic Function Lambda Lists361535 +Node: Specialized Lambda Lists362950 +Node: Macro Lambda Lists364388 +Node: Destructuring by Lambda Lists369811 +Node: Data-directed Destructuring by Lambda Lists371002 +Node: Examples of Data-directed Destructuring by Lambda Lists371549 +Node: Lambda-list-directed Destructuring by Lambda Lists372262 +Node: Destructuring Lambda Lists375323 +Node: Boa Lambda Lists376623 +Node: Defsetf Lambda Lists380499 +Node: Deftype Lambda Lists381527 +Node: Define-modify-macro Lambda Lists382145 +Node: Define-method-combination Arguments Lambda Lists383015 +Node: Syntactic Interaction of Documentation Strings and Declarations383866 +Node: Error Checking in Function Calls384617 +Node: Argument Mismatch Detection384888 +Node: Safe and Unsafe Calls385377 +Node: Error Detection Time in Safe Calls388140 +Node: Too Few Arguments388723 +Node: Too Many Arguments389248 +Node: Unrecognized Keyword Arguments389896 +Node: Invalid Keyword Arguments390516 +Node: Odd Number of Keyword Arguments391120 +Node: Destructuring Mismatch391706 +Node: Errors When Calling a Next Method392243 +Node: Traversal Rules and Side Effects393218 +Node: Destructive Operations394464 +Node: Modification of Literal Objects394789 +Node: Transfer of Control during a Destructive Operation397187 +Node: Examples of Transfer of Control during a Destructive Operation397684 +Node: Evaluation and Compilation Dictionary398560 +Node: lambda (Symbol)399243 +Node: lambda400441 +Node: compile401555 +Node: eval404765 +Node: eval-when406697 +Node: load-time-value413134 +Node: quote418947 +Node: compiler-macro-function420509 +Node: define-compiler-macro421471 +Node: defmacro428947 +Node: macro-function435110 +Node: macroexpand437354 +Node: define-symbol-macro442384 +Node: symbol-macrolet444934 +Node: *macroexpand-hook*448057 +Node: proclaim450319 +Node: declaim452448 +Node: declare453256 +Node: ignore457465 +Node: dynamic-extent459502 +Node: type465888 +Node: inline472661 +Node: ftype476487 +Node: declaration478021 +Node: optimize478949 +Node: special481191 +Node: locally485670 +Node: the487835 +Node: special-operator-p490228 +Node: constantp491141 +Node: Types and Classes494160 +Node: Introduction (Types and Classes)494422 +Node: Types496580 +Node: Data Type Definition496792 +Node: Type Relationships498074 +Node: Type Specifiers499999 +Node: Classes509366 +Node: Introduction to Classes510281 +Node: Standard Metaclasses515009 +Node: Defining Classes515968 +Node: Creating Instances of Classes517640 +Node: Inheritance518431 +Node: Examples of Inheritance518895 +Node: Inheritance of Class Options519872 +Node: Determining the Class Precedence List520692 +Node: Topological Sorting522752 +Node: Examples of Class Precedence List Determination525185 +Node: Redefining Classes528739 +Node: Modifying the Structure of Instances531843 +Node: Initializing Newly Added Local Slots (Redefining Classes)533028 +Node: Customizing Class Redefinition534929 +Node: Integrating Types and Classes536008 +Node: Types and Classes Dictionary542615 +Node: nil (Type)543384 +Node: boolean543840 +Node: function (System Class)544640 +Node: compiled-function549403 +Node: generic-function550242 +Node: standard-generic-function551279 +Node: class551802 +Node: built-in-class552338 +Node: structure-class553264 +Node: standard-class553679 +Node: method554077 +Node: standard-method555216 +Node: structure-object555647 +Node: standard-object556246 +Node: method-combination556684 +Node: t (System Class)557343 +Node: satisfies557709 +Node: member (Type Specifier)558878 +Node: not (Type Specifier)559889 +Node: and (Type Specifier)560601 +Node: or (Type Specifier)561435 +Node: values (Type Specifier)562462 +Node: eql (Type Specifier)563725 +Node: coerce564496 +Node: deftype569142 +Node: subtypep572288 +Node: type-of579324 +Node: typep582215 +Node: type-error585608 +Node: type-error-datum586311 +Node: simple-type-error587646 +Node: Data and Control Flow588390 +Node: Generalized Reference588655 +Node: Overview of Places and Generalized Reference588982 +Node: Evaluation of Subforms to Places591408 +Node: Examples of Evaluation of Subforms to Places593913 +Node: Setf Expansions594635 +Node: Examples of Setf Expansions596705 +Node: Kinds of Places598807 +Node: Variable Names as Places599445 +Node: Function Call Forms as Places599723 +Node: VALUES Forms as Places608702 +Node: THE Forms as Places609840 +Node: APPLY Forms as Places610299 +Node: Setf Expansions and Places611667 +Node: Macro Forms as Places612087 +Node: Symbol Macros as Places612621 +Node: Other Compound Forms as Places613000 +Node: Treatment of Other Macros Based on SETF614031 +Node: Transfer of Control to an Exit Point615455 +Node: Data and Control Flow Dictionary617276 +Node: apply618510 +Node: defun620529 +Node: fdefinition624262 +Node: fboundp626100 +Node: fmakunbound627895 +Node: flet628871 +Node: funcall636716 +Node: function (Special Operator)638413 +Node: function-lambda-expression640490 +Node: functionp643711 +Node: compiled-function-p644654 +Node: call-arguments-limit645784 +Node: lambda-list-keywords646417 +Node: lambda-parameters-limit647160 +Node: defconstant647811 +Node: defparameter650648 +Node: destructuring-bind657202 +Node: let658519 +Node: progv661823 +Node: setq663323 +Node: psetq664997 +Node: block666963 +Node: catch668763 +Node: go671446 +Node: return-from672881 +Node: return675149 +Node: tagbody676129 +Node: throw678542 +Node: unwind-protect681203 +Node: nil686428 +Node: not686822 +Node: t687661 +Node: eq688642 +Node: eql691050 +Node: equal694007 +Node: equalp697789 +Node: identity701900 +Node: complement702652 +Node: constantly704343 +Node: every705309 +Node: and708278 +Node: cond710024 +Node: if711655 +Node: or712902 +Node: when714301 +Node: case716873 +Node: typecase721961 +Node: multiple-value-bind727520 +Node: multiple-value-call729380 +Node: multiple-value-list730626 +Node: multiple-value-prog1731440 +Node: multiple-value-setq732390 +Node: values733989 +Node: values-list735907 +Node: multiple-values-limit736879 +Node: nth-value737705 +Node: prog738988 +Node: prog1742723 +Node: progn744858 +Node: define-modify-macro746234 +Node: defsetf748708 +Node: define-setf-expander754820 +Node: get-setf-expansion759642 +Node: setf761389 +Node: shiftf763835 +Node: rotatef766420 +Node: control-error768135 +Node: program-error768756 +Node: undefined-function769302 +Node: Iteration769907 +Node: The LOOP Facility770081 +Node: Overview of the Loop Facility770547 +Node: Simple vs Extended Loop771328 +Node: Simple Loop771629 +Node: Extended Loop772322 +Node: Loop Keywords772953 +Node: Parsing Loop Clauses773887 +Node: Expanding Loop Forms775510 +Node: Summary of Loop Clauses778207 +Node: Summary of Variable Initialization and Stepping Clauses778508 +Node: Summary of Value Accumulation Clauses779341 +Node: Summary of Termination Test Clauses781131 +Node: Summary of Unconditional Execution Clauses782838 +Node: Summary of Conditional Execution Clauses783558 +Node: Summary of Miscellaneous Clauses784650 +Node: Order of Execution785343 +Node: Destructuring787215 +Node: Restrictions on Side-Effects791628 +Node: Variable Initialization and Stepping Clauses791865 +Node: Iteration Control792717 +Node: The for-as-arithmetic subclause795631 +Node: Examples of for-as-arithmetic subclause799477 +Node: The for-as-in-list subclause800227 +Node: Examples of for-as-in-list subclause801021 +Node: The for-as-on-list subclause801807 +Node: Examples of for-as-on-list subclause802560 +Node: The for-as-equals-then subclause803179 +Node: Examples of for-as-equals-then subclause803937 +Node: The for-as-across subclause804393 +Node: Examples of for-as-across subclause805095 +Node: The for-as-hash subclause805482 +Node: The for-as-package subclause807704 +Node: Examples of for-as-package subclause810268 +Node: Local Variable Initializations810888 +Node: Examples of WITH clause813729 +Node: Value Accumulation Clauses814766 +Node: Examples of COLLECT clause820602 +Node: Examples of APPEND and NCONC clauses821352 +Node: Examples of COUNT clause821971 +Node: Examples of MAXIMIZE and MINIMIZE clauses822292 +Node: Examples of SUM clause823158 +Node: Termination Test Clauses823561 +Node: Examples of REPEAT clause827731 +Node: Examples of ALWAYS828256 +Node: Examples of WHILE and UNTIL clauses830272 +Node: Unconditional Execution Clauses831065 +Node: Examples of unconditional execution831958 +Node: Conditional Execution Clauses832454 +Node: Examples of WHEN clause834159 +Node: Miscellaneous Clauses835835 +Node: Control Transfer Clauses836150 +Node: Examples of NAMED clause836978 +Node: Initial and Final Execution837368 +Node: Examples of Miscellaneous Loop Features838997 +Node: Examples of clause grouping840063 +Node: Notes about Loop842504 +Node: Iteration Dictionary843526 +Node: do843731 +Node: dotimes852155 +Node: dolist855595 +Node: loop857806 +Node: loop-finish863496 +Node: Objects866312 +Node: Object Creation and Initialization866616 +Node: Initialization Arguments870528 +Node: Declaring the Validity of Initialization Arguments873135 +Node: Defaulting of Initialization Arguments876634 +Node: Rules for Initialization Arguments879905 +Node: Shared-Initialize883867 +Node: Initialize-Instance886549 +Node: Definitions of Make-Instance and Initialize-Instance889284 +Node: Changing the Class of an Instance891382 +Node: Modifying the Structure of the Instance892634 +Node: Initializing Newly Added Local Slots (Changing the Class of an Instance)893572 +Node: Customizing the Change of Class of an Instance895309 +Node: Reinitializing an Instance896112 +Node: Customizing Reinitialization897575 +Node: Meta-Objects898239 +Node: Standard Meta-objects898765 +Node: Slots899804 +Node: Introduction to Slots900342 +Node: Accessing Slots902980 +Node: Inheritance of Slots and Slot Options905557 +Node: Generic Functions and Methods910299 +Node: Introduction to Generic Functions910794 +Node: Introduction to Methods914311 +Node: Agreement on Parameter Specializers and Qualifiers920459 +Node: Congruent Lambda-lists for all Methods of a Generic Function921456 +Node: Keyword Arguments in Generic Functions and Methods923598 +Node: Examples of Keyword Arguments in Generic Functions and Methods925290 +Node: Method Selection and Combination926629 +Node: Determining the Effective Method928095 +Node: Selecting the Applicable Methods928689 +Node: Sorting the Applicable Methods by Precedence Order929030 +Node: Applying method combination to the sorted list of applicable methods931095 +Node: Standard Method Combination933262 +Node: Declarative Method Combination938209 +Node: Built-in Method Combination Types939120 +Node: Inheritance of Methods943201 +Node: Objects Dictionary943772 +Node: function-keywords944780 +Node: ensure-generic-function946392 +Node: allocate-instance949695 +Node: reinitialize-instance951209 +Node: shared-initialize953435 +Node: update-instance-for-different-class957934 +Node: update-instance-for-redefined-class962063 +Node: change-class967328 +Node: slot-boundp971337 +Node: slot-exists-p973114 +Node: slot-makunbound973911 +Node: slot-missing975444 +Node: slot-unbound977774 +Node: slot-value979437 +Node: method-qualifiers982234 +Node: no-applicable-method983020 +Node: no-next-method984136 +Node: remove-method985330 +Node: make-instance986143 +Node: make-instances-obsolete987545 +Node: make-load-form988847 +Node: make-load-form-saving-slots1000335 +Node: with-accessors1002278 +Node: with-slots1005210 +Node: defclass1008569 +Node: defgeneric1020992 +Node: defmethod1031724 +Node: find-class1038765 +Node: next-method-p1040735 +Node: call-method1041835 +Node: call-next-method1044841 +Node: compute-applicable-methods1047897 +Node: define-method-combination1048950 +Node: find-method1072775 +Node: add-method1075420 +Node: initialize-instance1076645 +Node: class-name1078428 +Node: setf class-name1079176 +Node: class-of1079796 +Node: unbound-slot1080787 +Node: unbound-slot-instance1081455 +Node: Structures1082018 +Node: Structures Dictionary1082163 +Node: defstruct1082343 +Node: copy-structure1123250 +Node: Conditions1123841 +Node: Condition System Concepts1124016 +Node: Condition Types1127625 +Node: Serious Conditions1130192 +Node: Creating Conditions1130573 +Node: Condition Designators1131126 +Node: Printing Conditions1132964 +Node: Recommended Style in Condition Reporting1134307 +Node: Capitalization and Punctuation in Condition Reports1135436 +Node: Leading and Trailing Newlines in Condition Reports1136159 +Node: Embedded Newlines in Condition Reports1137121 +Node: Note about Tabs in Condition Reports1138294 +Node: Mentioning Containing Function in Condition Reports1138919 +Node: Signaling and Handling Conditions1139404 +Node: Signaling1141672 +Node: Resignaling a Condition1142872 +Node: Restarts1143932 +Node: Interactive Use of Restarts1146109 +Node: Interfaces to Restarts1147305 +Node: Restart Tests1148314 +Node: Associating a Restart with a Condition1148794 +Node: Assertions1149692 +Node: Notes about the Condition System`s Background1150197 +Node: Conditions Dictionary1150688 +Node: condition1151703 +Node: warning1153497 +Node: style-warning1153854 +Node: serious-condition1155058 +Node: error (Condition Type)1156291 +Node: cell-error1156656 +Node: cell-error-name1157262 +Node: parse-error1158252 +Node: storage-condition1158722 +Node: assert1160308 +Node: error1164258 +Node: cerror1167945 +Node: check-type1173062 +Node: simple-error1177338 +Node: invalid-method-error1177837 +Node: method-combination-error1179389 +Node: signal1180514 +Node: simple-condition1183070 +Node: simple-condition-format-control1183999 +Node: warn1185367 +Node: simple-warning1187791 +Node: invoke-debugger1188264 +Node: break1189761 +Node: *debugger-hook*1192196 +Node: *break-on-signals*1194690 +Node: handler-bind1197327 +Node: handler-case1199912 +Node: ignore-errors1205418 +Node: define-condition1207307 +Node: make-condition1218846 +Node: restart1220148 +Node: compute-restarts1220780 +Node: find-restart1223539 +Node: invoke-restart1225537 +Node: invoke-restart-interactively1227272 +Node: restart-bind1229585 +Node: restart-case1233660 +Node: restart-name1243486 +Node: with-condition-restarts1244446 +Node: with-simple-restart1245778 +Node: abort (Restart)1249259 +Node: continue1250253 +Node: muffle-warning1251413 +Node: store-value1253030 +Node: use-value1254265 +Node: abort (Function)1254902 +Node: Symbols1261190 +Node: Symbol Concepts1261346 +Node: Symbols Dictionary1261959 +Node: symbol1262389 +Node: keyword1267402 +Node: symbolp1268002 +Node: keywordp1268744 +Node: make-symbol1269613 +Node: copy-symbol1271217 +Node: gensym1273635 +Node: *gensym-counter*1275934 +Node: gentemp1276704 +Node: symbol-function1279543 +Node: symbol-name1282489 +Node: symbol-package1283184 +Node: symbol-plist1285017 +Node: symbol-value1286216 +Node: get1288207 +Node: remprop1291439 +Node: boundp1294044 +Node: makunbound1295027 +Node: set1295785 +Node: unbound-variable1297509 +Node: Packages1298080 +Node: Package Concepts1298247 +Node: Introduction to Packages1298460 +Node: Package Names and Nicknames1300364 +Node: Symbols in a Package1301135 +Node: Internal and External Symbols1301348 +Node: Package Inheritance1302263 +Node: Accessibility of Symbols in a Package1303213 +Node: Locating a Symbol in a Package1304826 +Node: Prevention of Name Conflicts in Packages1305445 +Node: Standardized Packages1308809 +Node: The COMMON-LISP Package1309771 +Node: Constraints on the COMMON-LISP Package for Conforming Implementations1311106 +Node: Constraints on the COMMON-LISP Package for Conforming Programs1312652 +Node: Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs1314763 +Node: The COMMON-LISP-USER Package1316610 +Node: The KEYWORD Package1317209 +Node: Interning a Symbol in the KEYWORD Package1318072 +Node: Notes about The KEYWORD Package1318662 +Node: Implementation-Defined Packages1319585 +Node: Packages Dictionary1320154 +Node: package1320826 +Node: export1321279 +Node: find-symbol1324350 +Node: find-package1326759 +Node: find-all-symbols1327777 +Node: import1328760 +Node: list-all-packages1331258 +Node: rename-package1331926 +Node: shadow1333203 +Node: shadowing-import1335565 +Node: delete-package1337486 +Node: make-package1342466 +Node: with-package-iterator1344509 +Node: unexport1350151 +Node: unintern1351699 +Node: in-package1353784 +Node: unuse-package1354752 +Node: use-package1356156 +Node: defpackage1358234 +Node: do-symbols1366658 +Node: intern1370217 +Node: package-name1372552 +Node: package-nicknames1373598 +Node: package-shadowing-symbols1374371 +Node: package-use-list1375592 +Node: package-used-by-list1376482 +Node: packagep1377348 +Node: *package*1377992 +Node: package-error1379358 +Node: package-error-package1380017 +Node: Numbers (Numbers)1380709 +Node: Number Concepts1380875 +Node: Numeric Operations1381253 +Node: Associativity and Commutativity in Numeric Operations1383468 +Node: Examples of Associativity and Commutativity in Numeric Operations1384591 +Node: Contagion in Numeric Operations1386251 +Node: Viewing Integers as Bits and Bytes1386768 +Node: Logical Operations on Integers1387022 +Node: Byte Operations on Integers1388140 +Node: Implementation-Dependent Numeric Constants1388967 +Node: Rational Computations1390246 +Node: Rule of Unbounded Rational Precision1390658 +Node: Rule of Canonical Representation for Rationals1391113 +Node: Rule of Float Substitutability1392224 +Node: Floating-point Computations1395202 +Node: Rule of Float and Rational Contagion1395682 +Node: Examples of Rule of Float and Rational Contagion1396579 +Node: Rule of Float Approximation1397637 +Node: Rule of Float Underflow and Overflow1398819 +Node: Rule of Float Precision Contagion1399261 +Node: Complex Computations1399612 +Node: Rule of Complex Substitutability1400099 +Node: Rule of Complex Contagion1400500 +Node: Rule of Canonical Representation for Complex Rationals1400907 +Node: Examples of Rule of Canonical Representation for Complex Rationals1401771 +Node: Principal Values and Branch Cuts1402428 +Node: Interval Designators1404479 +Node: Random-State Operations1405994 +Node: Numbers Dictionary1406361 +Node: number1407732 +Node: complex (System Class)1408894 +Node: real1411134 +Node: float (System Class)1412289 +Node: short-float1414947 +Node: rational (System Class)1418992 +Node: ratio1420024 +Node: integer1420623 +Node: signed-byte1421991 +Node: unsigned-byte1423024 +Node: mod (System Class)1424150 +Node: bit (System Class)1424892 +Node: fixnum1425253 +Node: bignum1425744 +Node: =1426050 +Node: max1429657 +Node: minusp1431700 +Node: zerop1432619 +Node: floor1433595 +Node: sin1438404 +Node: asin1439217 +Node: pi1446395 +Node: sinh1447503 +Node: *1452173 +Node: +1453003 +Node: -1453795 +Node: /1454940 +Node: 1+1456552 +Node: abs1457502 +Node: evenp1458937 +Node: exp1459840 +Node: gcd1463019 +Node: incf1464041 +Node: lcm1465218 +Node: log1466321 +Node: mod (Function)1468475 +Node: signum1469773 +Node: sqrt1471430 +Node: random-state1473492 +Node: make-random-state1474337 +Node: random1476274 +Node: random-state-p1477768 +Node: *random-state*1478532 +Node: numberp1479960 +Node: cis1480624 +Node: complex1481194 +Node: complexp1482836 +Node: conjugate1483483 +Node: phase1484250 +Node: realpart1485801 +Node: upgraded-complex-part-type1486786 +Node: realp1487765 +Node: numerator1488388 +Node: rational (Function)1489436 +Node: rationalp1490984 +Node: ash1491644 +Node: integer-length1493141 +Node: integerp1494787 +Node: parse-integer1495428 +Node: boole1497537 +Node: boole-11502760 +Node: logand1503868 +Node: logbitp1507989 +Node: logcount1509172 +Node: logtest1510574 +Node: byte1511637 +Node: deposit-field1512870 +Node: dpb1513891 +Node: ldb1515329 +Node: ldb-test1516924 +Node: mask-field1517755 +Node: most-positive-fixnum1519081 +Node: decode-float1519755 +Node: float1525479 +Node: floatp1526406 +Node: most-positive-short-float1527031 +Node: short-float-epsilon1531332 +Node: arithmetic-error1532717 +Node: arithmetic-error-operands1533471 +Node: division-by-zero1534382 +Node: floating-point-invalid-operation1534860 +Node: floating-point-inexact1535648 +Node: floating-point-overflow1536403 +Node: floating-point-underflow1536912 +Node: Characters1537395 +Node: Character Concepts1537571 +Node: Introduction to Characters1538065 +Node: Introduction to Scripts and Repertoires1539529 +Node: Character Scripts1539837 +Node: Character Repertoires1540850 +Node: Character Attributes1541761 +Node: Character Categories1542769 +Node: Graphic Characters1543992 +Node: Alphabetic Characters1544919 +Node: Characters With Case1545582 +Node: Uppercase Characters1546036 +Node: Lowercase Characters1546491 +Node: Corresponding Characters in the Other Case1546965 +Node: Case of Implementation-Defined Characters1547496 +Node: Numeric Characters1547997 +Node: Alphanumeric Characters1548505 +Node: Digits in a Radix1548824 +Node: Identity of Characters1549552 +Node: Ordering of Characters1549822 +Node: Character Names1551612 +Node: Treatment of Newline during Input and Output1552755 +Node: Character Encodings1553306 +Node: Documentation of Implementation-Defined Scripts1554104 +Node: Characters Dictionary1555575 +Node: character (System Class)1556078 +Node: base-char1556689 +Node: standard-char1558673 +Node: extended-char1559213 +Node: char=1559674 +Node: character1565738 +Node: characterp1566607 +Node: alpha-char-p1567533 +Node: alphanumericp1568695 +Node: digit-char1570080 +Node: digit-char-p1571187 +Node: graphic-char-p1572675 +Node: standard-char-p1573552 +Node: char-upcase1574392 +Node: upper-case-p1576811 +Node: char-code1578338 +Node: char-int1579058 +Node: code-char1580045 +Node: char-code-limit1580800 +Node: char-name1581460 +Node: name-char1583367 +Node: Conses1584236 +Node: Cons Concepts1584384 +Node: Conses as Trees1584933 +Node: General Restrictions on Parameters that must be Trees1585981 +Node: Conses as Lists1586415 +Node: Lists as Association Lists1587871 +Node: Lists as Sets1588406 +Node: General Restrictions on Parameters that must be Lists1588991 +Node: Conses Dictionary1589648 +Node: list (System Class)1590410 +Node: null (System Class)1591644 +Node: cons (System Class)1592136 +Node: atom (Type)1593362 +Node: cons1593602 +Node: consp1594506 +Node: atom1595216 +Node: rplaca1595909 +Node: car1597033 +Node: copy-tree1603439 +Node: sublis1605051 +Node: subst1608774 +Node: tree-equal1613121 +Node: copy-list1614893 +Node: list (Function)1616197 +Node: list-length1617800 +Node: listp1619699 +Node: make-list1620493 +Node: push1621445 +Node: pop1622678 +Node: first1623966 +Node: nth1626733 +Node: endp1627775 +Node: null1629168 +Node: nconc1629967 +Node: append1632083 +Node: revappend1633205 +Node: butlast1635378 +Node: last1637185 +Node: ldiff1638932 +Node: nthcdr1642556 +Node: rest1643680 +Node: member (Function)1644647 +Node: mapc1646928 +Node: acons1651120 +Node: assoc1652126 +Node: copy-alist1655345 +Node: pairlis1656609 +Node: rassoc1658125 +Node: get-properties1660236 +Node: getf1661608 +Node: remf1664450 +Node: intersection1665796 +Node: adjoin1669716 +Node: pushnew1671648 +Node: set-difference1674378 +Node: set-exclusive-or1677734 +Node: subsetp1680812 +Node: union1682826 +Node: Arrays1685909 +Node: Array Concepts1686055 +Node: Array Elements1686243 +Node: Array Indices1686800 +Node: Array Dimensions1687215 +Node: Implementation Limits on Individual Array Dimensions1687805 +Node: Array Rank1688230 +Node: Vectors1688715 +Node: Fill Pointers1688921 +Node: Multidimensional Arrays1689653 +Node: Storage Layout for Multidimensional Arrays1689864 +Node: Implementation Limits on Array Rank1690378 +Node: Specialized Arrays1690752 +Node: Array Upgrading1692213 +Node: Required Kinds of Specialized Arrays1693595 +Node: Arrays Dictionary1695222 +Node: array1696037 +Node: simple-array1699085 +Node: vector (System Class)1701034 +Node: simple-vector1703130 +Node: bit-vector1704139 +Node: simple-bit-vector1705180 +Node: make-array1706162 +Node: adjust-array1714817 +Node: adjustable-array-p1722816 +Node: aref1723785 +Node: array-dimension1725459 +Node: array-dimensions1726318 +Node: array-element-type1727164 +Node: array-has-fill-pointer-p1728548 +Node: array-displacement1729698 +Node: array-in-bounds-p1731369 +Node: array-rank1732539 +Node: array-row-major-index1733308 +Node: array-total-size1734825 +Node: arrayp1736094 +Node: fill-pointer1736845 +Node: row-major-aref1737986 +Node: upgraded-array-element-type1739073 +Node: array-dimension-limit1740675 +Node: array-rank-limit1741204 +Node: array-total-size-limit1741698 +Node: simple-vector-p1742466 +Node: svref1743218 +Node: vector1744277 +Node: vector-pop1745173 +Node: vector-push1746434 +Node: vectorp1749247 +Node: bit (Array)1749944 +Node: bit-and1751266 +Node: bit-vector-p1755663 +Node: simple-bit-vector-p1756459 +Node: Strings1757161 +Node: String Concepts1757314 +Node: Implications of Strings Being Arrays1757530 +Node: Subtypes of STRING1758019 +Node: Strings Dictionary1758426 +Node: string (System Class)1758765 +Node: base-string1759833 +Node: simple-string1760779 +Node: simple-base-string1761818 +Node: simple-string-p1762728 +Node: char1763481 +Node: string1764998 +Node: string-upcase1766257 +Node: string-trim1770275 +Node: string=1771901 +Node: stringp1777370 +Node: make-string1777983 +Node: Sequences1778920 +Node: Sequence Concepts1779117 +Node: General Restrictions on Parameters that must be Sequences1780930 +Node: Rules about Test Functions1781315 +Node: Satisfying a Two-Argument Test1781584 +Node: Examples of Satisfying a Two-Argument Test1784144 +Node: Satisfying a One-Argument Test1785436 +Node: Examples of Satisfying a One-Argument Test1787366 +Node: Sequences Dictionary1787959 +Node: sequence1788398 +Node: copy-seq1789105 +Node: elt1790257 +Node: fill1791330 +Node: make-sequence1792716 +Node: subseq1794821 +Node: map1796902 +Node: map-into1799758 +Node: reduce1802947 +Node: count1806240 +Node: length1808318 +Node: reverse1809299 +Node: sort1811428 +Node: find1816863 +Node: position1819099 +Node: search1821241 +Node: mismatch1823167 +Node: replace1825470 +Node: substitute1827776 +Node: concatenate1833684 +Node: merge1835854 +Node: remove1839996 +Node: remove-duplicates1846346 +Node: Hash Tables1849840 +Node: Hash Table Concepts1850016 +Node: Hash-Table Operations1850248 +Node: Modifying Hash Table Keys1852287 +Node: Visible Modification of Objects with respect to EQ and EQL1854196 +Node: Visible Modification of Objects with respect to EQUAL1854657 +Node: Visible Modification of Conses with respect to EQUAL1855252 +Node: Visible Modification of Bit Vectors and Strings with respect to EQUAL1855739 +Node: Visible Modification of Objects with respect to EQUALP1856400 +Node: Visible Modification of Structures with respect to EQUALP1857010 +Node: Visible Modification of Arrays with respect to EQUALP1857491 +Node: Visible Modification of Hash Tables with respect to EQUALP1858095 +Node: Visible Modifications by Language Extensions1858804 +Node: Hash Tables Dictionary1859564 +Node: hash-table1859986 +Node: make-hash-table1860763 +Node: hash-table-p1863671 +Node: hash-table-count1864408 +Node: hash-table-rehash-size1865794 +Node: hash-table-rehash-threshold1867305 +Node: hash-table-size1868350 +Node: hash-table-test1869123 +Node: gethash1869981 +Node: remhash1872121 +Node: maphash1872958 +Node: with-hash-table-iterator1874789 +Node: clrhash1878221 +Node: sxhash1879063 +Node: Filenames1882037 +Node: Overview of Filenames1882241 +Node: Namestrings as Filenames1883040 +Node: Pathnames as Filenames1884133 +Node: Parsing Namestrings Into Pathnames1887573 +Node: Pathnames1888315 +Node: Pathname Components1888553 +Node: The Pathname Host Component1889041 +Node: The Pathname Device Component1889349 +Node: The Pathname Directory Component1889730 +Node: The Pathname Name Component1890079 +Node: The Pathname Type Component1890396 +Node: The Pathname Version Component1890809 +Node: Interpreting Pathname Component Values1891458 +Node: Strings in Component Values1892662 +Node: Special Characters in Pathname Components1892933 +Node: Case in Pathname Components1893835 +Node: Local Case in Pathname Components1894626 +Node: Common Case in Pathname Components1895425 +Node: Special Pathname Component Values1896218 +Node: NIL as a Component Value1896486 +Node: ->WILD as a Component Value1897030 +Node: ->UNSPECIFIC as a Component Value1898061 +Node: Relation between component values NIL and ->UNSPECIFIC1899452 +Node: Restrictions on Wildcard Pathnames1900299 +Node: Restrictions on Examining Pathname Components1901162 +Node: Restrictions on Examining a Pathname Host Component1902210 +Node: Restrictions on Examining a Pathname Device Component1902649 +Node: Restrictions on Examining a Pathname Directory Component1903353 +Node: Directory Components in Non-Hierarchical File Systems1906956 +Node: Restrictions on Examining a Pathname Name Component1907604 +Node: Restrictions on Examining a Pathname Type Component1908031 +Node: Restrictions on Examining a Pathname Version Component1908459 +Node: Notes about the Pathname Version Component1909438 +Node: Restrictions on Constructing Pathnames1910050 +Node: Merging Pathnames1911592 +Node: Examples of Merging Pathnames1912370 +Node: Logical Pathnames1913247 +Node: Syntax of Logical Pathname Namestrings1913486 +Node: Additional Information about Parsing Logical Pathname Namestrings1915466 +Node: The Host part of a Logical Pathname Namestring1915856 +Node: The Device part of a Logical Pathname Namestring1916501 +Node: The Directory part of a Logical Pathname Namestring1917032 +Node: The Type part of a Logical Pathname Namestring1917630 +Node: The Version part of a Logical Pathname Namestring1918125 +Node: Wildcard Words in a Logical Pathname Namestring1918777 +Node: Lowercase Letters in a Logical Pathname Namestring1919292 +Node: Other Syntax in a Logical Pathname Namestring1919732 +Node: Logical Pathname Components1920247 +Node: Unspecific Components of a Logical Pathname1920554 +Node: Null Strings as Components of a Logical Pathname1920986 +Node: Filenames Dictionary1921348 +Node: pathname (System Class)1921904 +Node: logical-pathname (System Class)1922348 +Node: pathname1922971 +Node: make-pathname1925689 +Node: pathnamep1930205 +Node: pathname-host1931073 +Node: load-logical-pathname-translations1935777 +Node: logical-pathname-translations1937628 +Node: logical-pathname1945662 +Node: *default-pathname-defaults*1947029 +Node: namestring1948249 +Node: parse-namestring1952181 +Node: wild-pathname-p1956931 +Node: pathname-match-p1959054 +Node: translate-logical-pathname1960272 +Node: translate-pathname1962950 +Node: merge-pathnames1969567 +Node: Files1974203 +Node: File System Concepts1974354 +Node: Coercion of Streams to Pathnames1975365 +Node: File Operations on Open and Closed Streams1976302 +Node: Truenames1977550 +Node: Examples of Truenames1978465 +Node: Files Dictionary1980035 +Node: directory1980352 +Node: probe-file1981901 +Node: ensure-directories-exist1983162 +Node: truename1984788 +Node: file-author1987420 +Node: file-write-date1988445 +Node: rename-file1989708 +Node: delete-file1992235 +Node: file-error1994031 +Node: file-error-pathname1994790 +Node: Streams1995334 +Node: Stream Concepts1995484 +Node: Introduction to Streams1995770 +Node: Abstract Classifications of Streams (Introduction to Streams)1997026 +Node: Input1997281 +Node: Open and Closed Streams1999009 +Node: Interactive Streams1999965 +Node: Abstract Classifications of Streams2001361 +Node: File Streams2001593 +Node: Other Subclasses of Stream2002297 +Node: Stream Variables2003645 +Node: Stream Arguments to Standardized Functions2004974 +Node: Restrictions on Composite Streams2008023 +Node: Streams Dictionary2008530 +Node: stream2009807 +Node: broadcast-stream2010400 +Node: concatenated-stream2013185 +Node: echo-stream2014430 +Node: file-stream2015186 +Node: string-stream2015754 +Node: synonym-stream2016377 +Node: two-way-stream2017201 +Node: input-stream-p2017757 +Node: interactive-stream-p2018860 +Node: open-stream-p2019944 +Node: stream-element-type2020838 +Node: streamp2022189 +Node: read-byte2022844 +Node: write-byte2024279 +Node: peek-char2025398 +Node: read-char2028204 +Node: read-char-no-hang2030033 +Node: terpri2032230 +Node: unread-char2033786 +Node: write-char2035753 +Node: read-line2036631 +Node: write-string2038643 +Node: read-sequence2040229 +Node: write-sequence2042524 +Node: file-length2044145 +Node: file-position2045180 +Node: file-string-length2049033 +Node: open2049809 +Node: stream-external-format2059560 +Node: with-open-file2060490 +Node: close2063775 +Node: with-open-stream2065934 +Node: listen2067178 +Node: clear-input2068292 +Node: finish-output2070138 +Node: y-or-n-p2071814 +Node: make-synonym-stream2074450 +Node: synonym-stream-symbol2075547 +Node: broadcast-stream-streams2076067 +Node: make-broadcast-stream2076608 +Node: make-two-way-stream2077665 +Node: two-way-stream-input-stream2078733 +Node: echo-stream-input-stream2079574 +Node: make-echo-stream2080330 +Node: concatenated-stream-streams2081397 +Node: make-concatenated-stream2082176 +Node: get-output-stream-string2083073 +Node: make-string-input-stream2084652 +Node: make-string-output-stream2085812 +Node: with-input-from-string2086933 +Node: with-output-to-string2089485 +Node: *debug-io*2092171 +Node: *terminal-io*2096865 +Node: stream-error2098379 +Node: stream-error-stream2099028 +Node: end-of-file2099768 +Node: Printer2100572 +Node: The Lisp Printer2100773 +Node: Overview of The Lisp Printer2101056 +Node: Multiple Possible Textual Representations2101758 +Node: Printer Escaping2103947 +Node: Printer Dispatching2104871 +Node: Default Print-Object Methods2105437 +Node: Printing Numbers2106348 +Node: Printing Integers2106542 +Node: Printing Ratios2107275 +Node: Printing Floats2108025 +Node: Printing Complexes2109660 +Node: Note about Printing Numbers2110160 +Node: Printing Characters2110508 +Node: Printing Symbols2111447 +Node: Package Prefixes for Symbols2112970 +Node: Effect of Readtable Case on the Lisp Printer2114863 +Node: Examples of Effect of Readtable Case on the Lisp Printer2116716 +Node: Printing Strings2120133 +Node: Printing Lists and Conses2120764 +Node: Printing Bit Vectors2123210 +Node: Printing Other Vectors2123859 +Node: Printing Other Arrays2125357 +Node: Examples of Printing Arrays2127618 +Node: Printing Random States2128341 +Node: Printing Pathnames2129226 +Node: Printing Structures2129813 +Node: Printing Other Objects2130755 +Node: Examples of Printer Behavior2131631 +Node: The Lisp Pretty Printer2133132 +Node: Pretty Printer Concepts2133432 +Node: Dynamic Control of the Arrangement of Output2135046 +Node: Format Directive Interface2138088 +Node: Compiling Format Strings2139476 +Node: Pretty Print Dispatch Tables2140109 +Node: Pretty Printer Margins2141713 +Node: Examples of using the Pretty Printer2142210 +Node: Notes about the Pretty Printer`s Background2153911 +Node: Formatted Output2154432 +Node: FORMAT Basic Output2159127 +Node: Tilde C-> Character2159454 +Node: Tilde Percent-> Newline2161259 +Node: Tilde Ampersand-> Fresh-Line2161613 +Node: Tilde Vertical-Bar-> Page2162023 +Node: Tilde Tilde-> Tilde2162314 +Node: FORMAT Radix Control2162523 +Node: Tilde R-> Radix2162836 +Node: Tilde D-> Decimal2164101 +Node: Tilde B-> Binary2165416 +Node: Tilde O-> Octal2165853 +Node: Tilde X-> Hexadecimal2166291 +Node: FORMAT Floating-Point Printers2166724 +Node: Tilde F-> Fixed-Format Floating-Point2167121 +Node: Tilde E-> Exponential Floating-Point2171212 +Node: Tilde G-> General Floating-Point2176329 +Node: Tilde Dollarsign-> Monetary Floating-Point2177696 +Node: FORMAT Printer Operations2179962 +Node: Tilde A-> Aesthetic2180261 +Node: Tilde S-> Standard2181500 +Node: Tilde W-> Write2181927 +Node: FORMAT Pretty Printer Operations2182735 +Node: Tilde Underscore-> Conditional Newline2183173 +Node: Tilde Less-Than-Sign-> Logical Block2183665 +Node: Tilde I-> Indent2187183 +Node: Tilde Slash-> Call Function2187549 +Node: FORMAT Layout Control2189409 +Node: Tilde T-> Tabulate2189744 +Node: Tilde Less-Than-Sign-> Justification2191969 +Node: Tilde Greater-Than-Sign-> End of Justification2195385 +Node: FORMAT Control-Flow Operations2195718 +Node: Tilde Asterisk-> Go-To2196207 +Node: Tilde Left-Bracket-> Conditional Expression2197100 +Node: Tilde Right-Bracket-> End of Conditional Expression2199603 +Node: Tilde Left-Brace-> Iteration2200004 +Node: Tilde Right-Brace-> End of Iteration2203282 +Node: Tilde Question-Mark-> Recursive Processing2203637 +Node: FORMAT Miscellaneous Operations2204990 +Node: Tilde Left-Paren-> Case Conversion2205353 +Node: Tilde Right-Paren-> End of Case Conversion2206635 +Node: Tilde P-> Plural2206989 +Node: FORMAT Miscellaneous Pseudo-Operations2207768 +Node: Tilde Semicolon-> Clause Separator2208166 +Node: Tilde Circumflex-> Escape Upward2208551 +Node: Tilde Newline-> Ignored Newline2211983 +Node: Additional Information about FORMAT Operations2213395 +Node: Nesting of FORMAT Operations2213839 +Node: Missing and Additional FORMAT Arguments2215230 +Node: Additional FORMAT Parameters2215723 +Node: Undefined FORMAT Modifier Combinations2216124 +Node: Examples of FORMAT2216535 +Node: Notes about FORMAT2220515 +Node: Printer Dictionary2221157 +Node: copy-pprint-dispatch2221926 +Node: formatter2222666 +Node: pprint-dispatch2223856 +Node: pprint-exit-if-list-exhausted2225386 +Node: pprint-fill2226979 +Node: pprint-indent2230407 +Node: pprint-logical-block2232263 +Node: pprint-newline2237752 +Node: pprint-pop2242091 +Node: pprint-tab2245302 +Node: print-object2246687 +Node: print-unreadable-object2251444 +Node: set-pprint-dispatch2253262 +Node: write2255448 +Node: write-to-string2259749 +Node: *print-array*2261941 +Node: *print-base*2262789 +Node: *print-case*2265097 +Node: *print-circle*2267453 +Node: *print-escape*2269073 +Node: *print-gensym*2270212 +Node: *print-level*2270862 +Node: *print-lines*2273942 +Node: *print-miser-width*2275328 +Node: *print-pprint-dispatch*2275874 +Node: *print-pretty*2277184 +Node: *print-readably*2279094 +Node: *print-right-margin*2282865 +Node: print-not-readable2283743 +Node: print-not-readable-object2284589 +Node: format2285160 +Node: Reader2286919 +Node: Reader Concepts2287079 +Node: Dynamic Control of the Lisp Reader2287365 +Node: Effect of Readtable Case on the Lisp Reader2287751 +Node: Examples of Effect of Readtable Case on the Lisp Reader2288796 +Node: Argument Conventions of Some Reader Functions2290317 +Node: The EOF-ERROR-P argument2290638 +Node: The RECURSIVE-P argument2292267 +Node: Reader Dictionary2295038 +Node: readtable2295558 +Node: copy-readtable2296367 +Node: make-dispatch-macro-character2298260 +Node: read2299513 +Node: read-delimited-list2304716 +Node: read-from-string2308419 +Node: readtable-case2310892 +Node: readtablep2312085 +Node: set-dispatch-macro-character2312749 +Node: set-macro-character2315815 +Node: set-syntax-from-char2318369 +Node: with-standard-io-syntax2320481 +Node: *read-base*2323161 +Node: *read-default-float-format*2324515 +Node: *read-eval*2326054 +Node: *read-suppress*2326764 +Node: *readtable*2330412 +Node: reader-error2331464 +Node: System Construction2331998 +Node: System Construction Concepts2332214 +Node: Loading2332466 +Node: Features2333423 +Node: Feature Expressions2333932 +Node: Examples of Feature Expressions2334955 +Node: System Construction Dictionary2336740 +Node: compile-file2337147 +Node: compile-file-pathname2341905 +Node: load2343950 +Node: with-compilation-unit2349533 +Node: *features*2351754 +Node: *compile-file-pathname*2357191 +Node: *load-pathname*2358503 +Node: *compile-print*2359725 +Node: *load-print*2360327 +Node: *modules*2360965 +Node: provide2361523 +Node: Environment2364364 +Node: The External Environment2364565 +Node: Top level loop2364832 +Node: Debugging Utilities2365701 +Node: Environment Inquiry2366224 +Node: Time2366959 +Node: Decoded Time2368260 +Node: Universal Time2369831 +Node: Internal Time2370911 +Node: Seconds2371529 +Node: Environment Dictionary2372078 +Node: decode-universal-time2372784 +Node: encode-universal-time2374722 +Node: get-universal-time2375884 +Node: sleep2378019 +Node: apropos2379099 +Node: describe2380635 +Node: describe-object2382478 +Node: trace2385370 +Node: step2388238 +Node: time2389565 +Node: internal-time-units-per-second2391440 +Node: get-internal-real-time2392052 +Node: get-internal-run-time2392902 +Node: disassemble2394235 +Node: documentation2395612 +Node: room2402082 +Node: ed2403175 +Node: inspect2404633 +Node: dribble2405524 +Node: - (Variable)2407399 +Node: + (Variable)2408041 +Node: * (Variable)2409103 +Node: / (Variable)2410639 +Node: lisp-implementation-type2411783 +Node: short-site-name2413000 +Node: machine-instance2413949 +Node: machine-type2414747 +Node: machine-version2415402 +Node: software-type2416108 +Node: user-homedir-pathname2417114 +Node: Glossary (Glossary)2418420 +Node: Glossary2418561 +Node: Appendix2579627 +Node: Removed Language Features2579765 +Node: Requirements for removed and deprecated features2580128 +Node: Removed Types2581331 +Node: Removed Operators2581564 +Node: Removed Argument Conventions2581943 +Node: Removed Variables2582261 +Node: Removed Reader Syntax2582625 +Node: Packages No Longer Required2582881 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/info/gcl.info-1 b/info/gcl.info-1 new file mode 100644 index 0000000..8e1023d --- /dev/null +++ b/info/gcl.info-1 @@ -0,0 +1,8012 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: Top, Next: Introduction (Introduction), Prev: (dir), Up: (dir) + +* Menu: + +* Introduction (Introduction):: +* Syntax:: +* Evaluation and Compilation:: +* Types and Classes:: +* Data and Control Flow:: +* Iteration:: +* Objects:: +* Structures:: +* Conditions:: +* Symbols:: +* Packages:: +* Numbers (Numbers):: +* Characters:: +* Conses:: +* Arrays:: +* Strings:: +* Sequences:: +* Hash Tables:: +* Filenames:: +* Files:: +* Streams:: +* Printer:: +* Reader:: +* System Construction:: +* Environment:: +* Glossary (Glossary):: +* Appendix:: + + -- The Detailed Node Listing -- + +Introduction + +* Scope:: +* Organization of the Document:: +* Referenced Publications:: +* Definitions:: +* Conformance:: +* Language Extensions:: +* Language Subsets:: +* Deprecated Language Features:: +* Symbols in the COMMON-LISP Package:: + +Scope, Purpose, and History + +* Scope and Purpose:: +* History:: + +Definitions + +* Notational Conventions:: +* Error Terminology:: +* Sections Not Formally Part Of This Standard:: +* Interpreting Dictionary Entries:: + +Notational Conventions + +* Font Key:: +* Modified BNF Syntax:: +* Splicing in Modified BNF Syntax:: +* Indirection in Modified BNF Syntax:: +* Additional Uses for Indirect Definitions in Modified BNF Syntax:: +* Special Symbols:: +* Objects with Multiple Notations:: +* Case in Symbols:: +* Numbers (Objects with Multiple Notations):: +* Use of the Dot Character:: +* NIL:: +* Designators:: +* Nonsense Words:: + +Interpreting Dictionary Entries + +* The "Affected By" Section of a Dictionary Entry:: +* The "Arguments" Section of a Dictionary Entry:: +* The "Arguments and Values" Section of a Dictionary Entry:: +* The "Binding Types Affected" Section of a Dictionary Entry:: +* The "Class Precedence List" Section of a Dictionary Entry:: +* Dictionary Entries for Type Specifiers:: +* The "Compound Type Specifier Kind" Section of a Dictionary Entry:: +* The "Compound Type Specifier Syntax" Section of a Dictionary Entry:: +* The "Compound Type Specifier Arguments" Section of a Dictionary Entry:: +* The "Compound Type Specifier Description" Section of a Dictionary Entry:: +* The "Constant Value" Section of a Dictionary Entry:: +* The "Description" Section of a Dictionary Entry:: +* The "Examples" Section of a Dictionary Entry:: +* The "Exceptional Situations" Section of a Dictionary Entry:: +* The "Initial Value" Section of a Dictionary Entry:: +* The "Argument Precedence Order" Section of a Dictionary Entry:: +* The "Method Signature" Section of a Dictionary Entry:: +* The "Name" Section of a Dictionary Entry:: +* The "Notes" Section of a Dictionary Entry:: +* The "Pronunciation" Section of a Dictionary Entry:: +* The "See Also" Section of a Dictionary Entry:: +* The "Side Effects" Section of a Dictionary Entry:: +* The "Supertypes" Section of a Dictionary Entry:: +* The "Syntax" Section of a Dictionary Entry:: +* Special "Syntax" Notations for Overloaded Operators:: +* Naming Conventions for Rest Parameters:: +* Requiring Non-Null Rest Parameters in The "Syntax" Section:: +* Return values in The "Syntax" Section:: +* No Arguments or Values in The "Syntax" Section:: +* Unconditional Transfer of Control in The "Syntax" Section:: +* The "Valid Context" Section of a Dictionary Entry:: +* The "Value Type" Section of a Dictionary Entry:: + +Conformance + +* Conforming Implementations:: +* Conforming Programs:: + +Conforming Implementations + +* Required Language Features:: +* Documentation of Implementation-Dependent Features:: +* Documentation of Extensions:: +* Treatment of Exceptional Situations:: +* Resolution of Apparent Conflicts in Exceptional Situations:: +* Examples of Resolution of Apparent Conflict in Exceptional Situations:: +* Conformance Statement:: + +Conforming Programs + +* Use of Implementation-Defined Language Features:: +* Use of Read-Time Conditionals:: + +Deprecated Language Features + +* Deprecated Functions:: +* Deprecated Argument Conventions:: +* Deprecated Variables:: +* Deprecated Reader Syntax:: + +Syntax + +* Character Syntax:: +* Reader Algorithm:: +* Interpretation of Tokens:: +* Standard Macro Characters:: + +Character Syntax + +* Readtables:: +* Variables that affect the Lisp Reader:: +* Standard Characters:: +* Character Syntax Types:: + +Readtables + +* The Current Readtable:: +* The Standard Readtable:: +* The Initial Readtable:: + +Character Syntax Types + +* Constituent Characters:: +* Constituent Traits:: +* Invalid Characters:: +* Macro Characters:: +* Multiple Escape Characters:: +* Examples of Multiple Escape Characters:: +* Single Escape Character:: +* Examples of Single Escape Characters:: +* Whitespace Characters:: +* Examples of Whitespace Characters:: + +Interpretation of Tokens + +* Numbers as Tokens:: +* Constructing Numbers from Tokens:: +* The Consing Dot:: +* Symbols as Tokens:: +* Valid Patterns for Tokens:: +* Package System Consistency Rules:: + +Numbers as Tokens + +* Potential Numbers as Tokens:: +* Escape Characters and Potential Numbers:: +* Examples of Potential Numbers:: + +Constructing Numbers from Tokens + +* Syntax of a Rational:: +* Syntax of an Integer:: +* Syntax of a Ratio:: +* Syntax of a Float:: +* Syntax of a Complex:: + +Standard Macro Characters + +* Left-Parenthesis:: +* Right-Parenthesis:: +* Single-Quote:: +* Semicolon:: +* Double-Quote:: +* Backquote:: +* Comma:: +* Sharpsign:: +* Re-Reading Abbreviated Expressions:: + +Single-Quote + +* Examples of Single-Quote:: + +Semicolon + +* Examples of Semicolon:: +* Notes about Style for Semicolon:: +* Use of Single Semicolon:: +* Use of Double Semicolon:: +* Use of Triple Semicolon:: +* Use of Quadruple Semicolon:: +* Examples of Style for Semicolon:: + +Backquote + +* Notes about Backquote:: + +Sharpsign + +* Sharpsign Backslash:: +* Sharpsign Single-Quote:: +* Sharpsign Left-Parenthesis:: +* Sharpsign Asterisk:: +* Examples of Sharpsign Asterisk:: +* Sharpsign Colon:: +* Sharpsign Dot:: +* Sharpsign B:: +* Sharpsign O:: +* Sharpsign X:: +* Sharpsign R:: +* Sharpsign C:: +* Sharpsign A:: +* Sharpsign S:: +* Sharpsign P:: +* Sharpsign Equal-Sign:: +* Sharpsign Sharpsign:: +* Sharpsign Plus:: +* Sharpsign Minus:: +* Sharpsign Vertical-Bar:: +* Examples of Sharpsign Vertical-Bar:: +* Notes about Style for Sharpsign Vertical-Bar:: +* Sharpsign Less-Than-Sign:: +* Sharpsign Whitespace:: +* Sharpsign Right-Parenthesis:: + +Evaluation and Compilation + +* Evaluation:: +* Compilation:: +* Declarations:: +* Lambda Lists:: +* Error Checking in Function Calls:: +* Traversal Rules and Side Effects:: +* Destructive Operations:: +* Evaluation and Compilation Dictionary:: + +Evaluation + +* Introduction to Environments:: +* The Evaluation Model:: +* Lambda Expressions:: +* Closures and Lexical Binding:: +* Shadowing:: +* Extent:: +* Return Values:: + +Introduction to Environments + +* The Global Environment:: +* Dynamic Environments:: +* Lexical Environments:: +* The Null Lexical Environment:: +* Environment Objects:: + +The Evaluation Model + +* Form Evaluation:: +* Symbols as Forms:: +* Lexical Variables:: +* Dynamic Variables:: +* Constant Variables:: +* Symbols Naming Both Lexical and Dynamic Variables:: +* Conses as Forms:: +* Special Forms:: +* Macro Forms:: +* Function Forms:: +* Lambda Forms:: +* Self-Evaluating Objects:: +* Examples of Self-Evaluating Objects:: + +Compilation + +* Compiler Terminology:: +* Compilation Semantics:: +* File Compilation:: +* Literal Objects in Compiled Files:: +* Exceptional Situations in the Compiler:: + +Compilation Semantics + +* Compiler Macros:: +* Purpose of Compiler Macros:: +* Naming of Compiler Macros:: +* When Compiler Macros Are Used:: +* Notes about the Implementation of Compiler Macros:: +* Minimal Compilation:: +* Semantic Constraints:: + +File Compilation + +* Processing of Top Level Forms:: +* Processing of Defining Macros:: +* Constraints on Macros and Compiler Macros:: + +Literal Objects in Compiled Files + +* Externalizable Objects:: +* Similarity of Literal Objects:: +* Similarity of Aggregate Objects:: +* Definition of Similarity:: +* Extensions to Similarity Rules:: +* Additional Constraints on Externalizable Objects:: + +Declarations + +* Minimal Declaration Processing Requirements:: +* Declaration Specifiers:: +* Declaration Identifiers:: +* Declaration Scope:: + +Declaration Identifiers + +* Shorthand notation for Type Declarations:: + +Declaration Scope + +* Examples of Declaration Scope:: + +Lambda Lists + +* Ordinary Lambda Lists:: +* Generic Function Lambda Lists:: +* Specialized Lambda Lists:: +* Macro Lambda Lists:: +* Destructuring Lambda Lists:: +* Boa Lambda Lists:: +* Defsetf Lambda Lists:: +* Deftype Lambda Lists:: +* Define-modify-macro Lambda Lists:: +* Define-method-combination Arguments Lambda Lists:: +* Syntactic Interaction of Documentation Strings and Declarations:: + +Ordinary Lambda Lists + +* Specifiers for the required parameters:: +* Specifiers for optional parameters:: +* A specifier for a rest parameter:: +* Specifiers for keyword parameters:: +* Suppressing Keyword Argument Checking:: +* Examples of Suppressing Keyword Argument Checking:: +* Specifiers for &aux variables:: +* Examples of Ordinary Lambda Lists:: + +Macro Lambda Lists + +* Destructuring by Lambda Lists:: +* Data-directed Destructuring by Lambda Lists:: +* Examples of Data-directed Destructuring by Lambda Lists:: +* Lambda-list-directed Destructuring by Lambda Lists:: + +Error Checking in Function Calls + +* Argument Mismatch Detection:: + +Argument Mismatch Detection + +* Safe and Unsafe Calls:: +* Error Detection Time in Safe Calls:: +* Too Few Arguments:: +* Too Many Arguments:: +* Unrecognized Keyword Arguments:: +* Invalid Keyword Arguments:: +* Odd Number of Keyword Arguments:: +* Destructuring Mismatch:: +* Errors When Calling a Next Method:: + +Destructive Operations + +* Modification of Literal Objects:: +* Transfer of Control during a Destructive Operation:: + +Transfer of Control during a Destructive Operation + +* Examples of Transfer of Control during a Destructive Operation:: + +Evaluation and Compilation Dictionary + +* lambda (Symbol):: +* lambda:: +* compile:: +* eval:: +* eval-when:: +* load-time-value:: +* quote:: +* compiler-macro-function:: +* define-compiler-macro:: +* defmacro:: +* macro-function:: +* macroexpand:: +* define-symbol-macro:: +* symbol-macrolet:: +* *macroexpand-hook*:: +* proclaim:: +* declaim:: +* declare:: +* ignore:: +* dynamic-extent:: +* type:: +* inline:: +* ftype:: +* declaration:: +* optimize:: +* special:: +* locally:: +* the:: +* special-operator-p:: +* constantp:: + +Types and Classes + +* Introduction (Types and Classes):: +* Types:: +* Classes:: +* Types and Classes Dictionary:: + +Types + +* Data Type Definition:: +* Type Relationships:: +* Type Specifiers:: + +Classes + +* Introduction to Classes:: +* Defining Classes:: +* Creating Instances of Classes:: +* Inheritance:: +* Determining the Class Precedence List:: +* Redefining Classes:: +* Integrating Types and Classes:: + +Introduction to Classes + +* Standard Metaclasses:: + +Inheritance + +* Examples of Inheritance:: +* Inheritance of Class Options:: + +Determining the Class Precedence List + +* Topological Sorting:: +* Examples of Class Precedence List Determination:: + +Redefining Classes + +* Modifying the Structure of Instances:: +* Initializing Newly Added Local Slots (Redefining Classes):: +* Customizing Class Redefinition:: + +Types and Classes Dictionary + +* nil (Type):: +* boolean:: +* function (System Class):: +* compiled-function:: +* generic-function:: +* standard-generic-function:: +* class:: +* built-in-class:: +* structure-class:: +* standard-class:: +* method:: +* standard-method:: +* structure-object:: +* standard-object:: +* method-combination:: +* t (System Class):: +* satisfies:: +* member (Type Specifier):: +* not (Type Specifier):: +* and (Type Specifier):: +* or (Type Specifier):: +* values (Type Specifier):: +* eql (Type Specifier):: +* coerce:: +* deftype:: +* subtypep:: +* type-of:: +* typep:: +* type-error:: +* type-error-datum:: +* simple-type-error:: + +Data and Control Flow + +* Generalized Reference:: +* Transfer of Control to an Exit Point:: +* Data and Control Flow Dictionary:: + +Generalized Reference + +* Overview of Places and Generalized Reference:: +* Kinds of Places:: +* Treatment of Other Macros Based on SETF:: + +Overview of Places and Generalized Reference + +* Evaluation of Subforms to Places:: +* Examples of Evaluation of Subforms to Places:: +* Setf Expansions:: +* Examples of Setf Expansions:: + +Kinds of Places + +* Variable Names as Places:: +* Function Call Forms as Places:: +* VALUES Forms as Places:: +* THE Forms as Places:: +* APPLY Forms as Places:: +* Setf Expansions and Places:: +* Macro Forms as Places:: +* Symbol Macros as Places:: +* Other Compound Forms as Places:: + +Data and Control Flow Dictionary + +* apply:: +* defun:: +* fdefinition:: +* fboundp:: +* fmakunbound:: +* flet:: +* funcall:: +* function (Special Operator):: +* function-lambda-expression:: +* functionp:: +* compiled-function-p:: +* call-arguments-limit:: +* lambda-list-keywords:: +* lambda-parameters-limit:: +* defconstant:: +* defparameter:: +* destructuring-bind:: +* let:: +* progv:: +* setq:: +* psetq:: +* block:: +* catch:: +* go:: +* return-from:: +* return:: +* tagbody:: +* throw:: +* unwind-protect:: +* nil:: +* not:: +* t:: +* eq:: +* eql:: +* equal:: +* equalp:: +* identity:: +* complement:: +* constantly:: +* every:: +* and:: +* cond:: +* if:: +* or:: +* when:: +* case:: +* typecase:: +* multiple-value-bind:: +* multiple-value-call:: +* multiple-value-list:: +* multiple-value-prog1:: +* multiple-value-setq:: +* values:: +* values-list:: +* multiple-values-limit:: +* nth-value:: +* prog:: +* prog1:: +* progn:: +* define-modify-macro:: +* defsetf:: +* define-setf-expander:: +* get-setf-expansion:: +* setf:: +* shiftf:: +* rotatef:: +* control-error:: +* program-error:: +* undefined-function:: + +Iteration + +* The LOOP Facility:: +* Iteration Dictionary:: + +The LOOP Facility + +* Overview of the Loop Facility:: +* Variable Initialization and Stepping Clauses:: +* Value Accumulation Clauses:: +* Termination Test Clauses:: +* Unconditional Execution Clauses:: +* Conditional Execution Clauses:: +* Miscellaneous Clauses:: +* Examples of Miscellaneous Loop Features:: +* Notes about Loop:: + +Overview of the Loop Facility + +* Simple vs Extended Loop:: +* Simple Loop:: +* Extended Loop:: +* Loop Keywords:: +* Parsing Loop Clauses:: +* Expanding Loop Forms:: +* Summary of Loop Clauses:: +* Summary of Variable Initialization and Stepping Clauses:: +* Summary of Value Accumulation Clauses:: +* Summary of Termination Test Clauses:: +* Summary of Unconditional Execution Clauses:: +* Summary of Conditional Execution Clauses:: +* Summary of Miscellaneous Clauses:: +* Order of Execution:: +* Destructuring:: +* Restrictions on Side-Effects:: + +Variable Initialization and Stepping Clauses + +* Iteration Control:: +* The for-as-arithmetic subclause:: +* Examples of for-as-arithmetic subclause:: +* The for-as-in-list subclause:: +* Examples of for-as-in-list subclause:: +* The for-as-on-list subclause:: +* Examples of for-as-on-list subclause:: +* The for-as-equals-then subclause:: +* Examples of for-as-equals-then subclause:: +* The for-as-across subclause:: +* Examples of for-as-across subclause:: +* The for-as-hash subclause:: +* The for-as-package subclause:: +* Examples of for-as-package subclause:: +* Local Variable Initializations:: +* Examples of WITH clause:: + +Value Accumulation Clauses + +* Examples of COLLECT clause:: +* Examples of APPEND and NCONC clauses:: +* Examples of COUNT clause:: +* Examples of MAXIMIZE and MINIMIZE clauses:: +* Examples of SUM clause:: + +Termination Test Clauses + +* Examples of REPEAT clause:: +* Examples of ALWAYS:: +* Examples of WHILE and UNTIL clauses:: + +Unconditional Execution Clauses + +* Examples of unconditional execution:: + +Conditional Execution Clauses + +* Examples of WHEN clause:: + +Miscellaneous Clauses + +* Control Transfer Clauses:: +* Examples of NAMED clause:: +* Initial and Final Execution:: + +Examples of Miscellaneous Loop Features + +* Examples of clause grouping:: + +Iteration Dictionary + +* do:: +* dotimes:: +* dolist:: +* loop:: +* loop-finish:: + +Objects + +* Object Creation and Initialization:: +* Changing the Class of an Instance:: +* Reinitializing an Instance:: +* Meta-Objects:: +* Slots:: +* Generic Functions and Methods:: +* Objects Dictionary:: + +Object Creation and Initialization + +* Initialization Arguments:: +* Declaring the Validity of Initialization Arguments:: +* Defaulting of Initialization Arguments:: +* Rules for Initialization Arguments:: +* Shared-Initialize:: +* Initialize-Instance:: +* Definitions of Make-Instance and Initialize-Instance:: + +Changing the Class of an Instance + +* Modifying the Structure of the Instance:: +* Initializing Newly Added Local Slots (Changing the Class of an Instance):: +* Customizing the Change of Class of an Instance:: + +Reinitializing an Instance + +* Customizing Reinitialization:: + +Meta-Objects + +* Standard Meta-objects:: + +Slots + +* Introduction to Slots:: +* Accessing Slots:: +* Inheritance of Slots and Slot Options:: + +Generic Functions and Methods + +* Introduction to Generic Functions:: +* Introduction to Methods:: +* Agreement on Parameter Specializers and Qualifiers:: +* Congruent Lambda-lists for all Methods of a Generic Function:: +* Keyword Arguments in Generic Functions and Methods:: +* Method Selection and Combination:: +* Inheritance of Methods:: + +Keyword Arguments in Generic Functions and Methods + +* Examples of Keyword Arguments in Generic Functions and Methods:: + +Method Selection and Combination + +* Determining the Effective Method:: +* Selecting the Applicable Methods:: +* Sorting the Applicable Methods by Precedence Order:: +* Applying method combination to the sorted list of applicable methods:: +* Standard Method Combination:: +* Declarative Method Combination:: +* Built-in Method Combination Types:: + +Objects Dictionary + +* function-keywords:: +* ensure-generic-function:: +* allocate-instance:: +* reinitialize-instance:: +* shared-initialize:: +* update-instance-for-different-class:: +* update-instance-for-redefined-class:: +* change-class:: +* slot-boundp:: +* slot-exists-p:: +* slot-makunbound:: +* slot-missing:: +* slot-unbound:: +* slot-value:: +* method-qualifiers:: +* no-applicable-method:: +* no-next-method:: +* remove-method:: +* make-instance:: +* make-instances-obsolete:: +* make-load-form:: +* make-load-form-saving-slots:: +* with-accessors:: +* with-slots:: +* defclass:: +* defgeneric:: +* defmethod:: +* find-class:: +* next-method-p:: +* call-method:: +* call-next-method:: +* compute-applicable-methods:: +* define-method-combination:: +* find-method:: +* add-method:: +* initialize-instance:: +* class-name:: +* (setf class-name):: +* class-of:: +* unbound-slot:: +* unbound-slot-instance:: + +Structures + +* Structures Dictionary:: + +Structures Dictionary + +* defstruct:: +* copy-structure:: + +Conditions + +* Condition System Concepts:: +* Conditions Dictionary:: + +Condition System Concepts + +* Condition Types:: +* Creating Conditions:: +* Printing Conditions:: +* Signaling and Handling Conditions:: +* Assertions:: +* Notes about the Condition System`s Background:: + +Condition Types + +* Serious Conditions:: + +Creating Conditions + +* Condition Designators:: + +Printing Conditions + +* Recommended Style in Condition Reporting:: +* Capitalization and Punctuation in Condition Reports:: +* Leading and Trailing Newlines in Condition Reports:: +* Embedded Newlines in Condition Reports:: +* Note about Tabs in Condition Reports:: +* Mentioning Containing Function in Condition Reports:: + +Signaling and Handling Conditions + +* Signaling:: +* Resignaling a Condition:: +* Restarts:: +* Interactive Use of Restarts:: +* Interfaces to Restarts:: +* Restart Tests:: +* Associating a Restart with a Condition:: + +Conditions Dictionary + +* condition:: +* warning:: +* style-warning:: +* serious-condition:: +* error (Condition Type):: +* cell-error:: +* cell-error-name:: +* parse-error:: +* storage-condition:: +* assert:: +* error:: +* cerror:: +* check-type:: +* simple-error:: +* invalid-method-error:: +* method-combination-error:: +* signal:: +* simple-condition:: +* simple-condition-format-control:: +* warn:: +* simple-warning:: +* invoke-debugger:: +* break:: +* *debugger-hook*:: +* *break-on-signals*:: +* handler-bind:: +* handler-case:: +* ignore-errors:: +* define-condition:: +* make-condition:: +* restart:: +* compute-restarts:: +* find-restart:: +* invoke-restart:: +* invoke-restart-interactively:: +* restart-bind:: +* restart-case:: +* restart-name:: +* with-condition-restarts:: +* with-simple-restart:: +* abort (Restart):: +* continue:: +* muffle-warning:: +* store-value:: +* use-value:: +* abort (Function):: + +Symbols + +* Symbol Concepts:: +* Symbols Dictionary:: + +Symbols Dictionary + +* symbol:: +* keyword:: +* symbolp:: +* keywordp:: +* make-symbol:: +* copy-symbol:: +* gensym:: +* *gensym-counter*:: +* gentemp:: +* symbol-function:: +* symbol-name:: +* symbol-package:: +* symbol-plist:: +* symbol-value:: +* get:: +* remprop:: +* boundp:: +* makunbound:: +* set:: +* unbound-variable:: + +Packages + +* Package Concepts:: +* Packages Dictionary:: + +Package Concepts + +* Introduction to Packages:: +* Standardized Packages:: + +Introduction to Packages + +* Package Names and Nicknames:: +* Symbols in a Package:: +* Internal and External Symbols:: +* Package Inheritance:: +* Accessibility of Symbols in a Package:: +* Locating a Symbol in a Package:: +* Prevention of Name Conflicts in Packages:: + +Standardized Packages + +* The COMMON-LISP Package:: +* Constraints on the COMMON-LISP Package for Conforming Implementations:: +* Constraints on the COMMON-LISP Package for Conforming Programs:: +* Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs:: +* The COMMON-LISP-USER Package:: +* The KEYWORD Package:: +* Interning a Symbol in the KEYWORD Package:: +* Notes about The KEYWORD Package:: +* Implementation-Defined Packages:: + +Packages Dictionary + +* package:: +* export:: +* find-symbol:: +* find-package:: +* find-all-symbols:: +* import:: +* list-all-packages:: +* rename-package:: +* shadow:: +* shadowing-import:: +* delete-package:: +* make-package:: +* with-package-iterator:: +* unexport:: +* unintern:: +* in-package:: +* unuse-package:: +* use-package:: +* defpackage:: +* do-symbols:: +* intern:: +* package-name:: +* package-nicknames:: +* package-shadowing-symbols:: +* package-use-list:: +* package-used-by-list:: +* packagep:: +* *package*:: +* package-error:: +* package-error-package:: + +Numbers + +* Number Concepts:: +* Numbers Dictionary:: + +Number Concepts + +* Numeric Operations:: +* Implementation-Dependent Numeric Constants:: +* Rational Computations:: +* Floating-point Computations:: +* Complex Computations:: +* Interval Designators:: +* Random-State Operations:: + +Numeric Operations + +* Associativity and Commutativity in Numeric Operations:: +* Examples of Associativity and Commutativity in Numeric Operations:: +* Contagion in Numeric Operations:: +* Viewing Integers as Bits and Bytes:: +* Logical Operations on Integers:: +* Byte Operations on Integers:: + +Rational Computations + +* Rule of Unbounded Rational Precision:: +* Rule of Canonical Representation for Rationals:: +* Rule of Float Substitutability:: + +Floating-point Computations + +* Rule of Float and Rational Contagion:: +* Examples of Rule of Float and Rational Contagion:: +* Rule of Float Approximation:: +* Rule of Float Underflow and Overflow:: +* Rule of Float Precision Contagion:: + +Complex Computations + +* Rule of Complex Substitutability:: +* Rule of Complex Contagion:: +* Rule of Canonical Representation for Complex Rationals:: +* Examples of Rule of Canonical Representation for Complex Rationals:: +* Principal Values and Branch Cuts:: + +Numbers Dictionary + +* number:: +* complex (System Class):: +* real:: +* float (System Class):: +* short-float:: +* rational (System Class):: +* ratio:: +* integer:: +* signed-byte:: +* unsigned-byte:: +* mod (System Class):: +* bit (System Class):: +* fixnum:: +* bignum:: +* =:: +* max:: +* minusp:: +* zerop:: +* floor:: +* sin:: +* asin:: +* pi:: +* sinh:: +* *:: +* +:: +* -:: +* /:: +* 1+:: +* abs:: +* evenp:: +* exp:: +* gcd:: +* incf:: +* lcm:: +* log:: +* mod (Function):: +* signum:: +* sqrt:: +* random-state:: +* make-random-state:: +* random:: +* random-state-p:: +* *random-state*:: +* numberp:: +* cis:: +* complex:: +* complexp:: +* conjugate:: +* phase:: +* realpart:: +* upgraded-complex-part-type:: +* realp:: +* numerator:: +* rational (Function):: +* rationalp:: +* ash:: +* integer-length:: +* integerp:: +* parse-integer:: +* boole:: +* boole-1:: +* logand:: +* logbitp:: +* logcount:: +* logtest:: +* byte:: +* deposit-field:: +* dpb:: +* ldb:: +* ldb-test:: +* mask-field:: +* most-positive-fixnum:: +* decode-float:: +* float:: +* floatp:: +* most-positive-short-float:: +* short-float-epsilon:: +* arithmetic-error:: +* arithmetic-error-operands:: +* division-by-zero:: +* floating-point-invalid-operation:: +* floating-point-inexact:: +* floating-point-overflow:: +* floating-point-underflow:: + +Characters + +* Character Concepts:: +* Characters Dictionary:: + +Character Concepts + +* Introduction to Characters:: +* Introduction to Scripts and Repertoires:: +* Character Attributes:: +* Character Categories:: +* Identity of Characters:: +* Ordering of Characters:: +* Character Names:: +* Treatment of Newline during Input and Output:: +* Character Encodings:: +* Documentation of Implementation-Defined Scripts:: + +Introduction to Scripts and Repertoires + +* Character Scripts:: +* Character Repertoires:: + +Character Categories + +* Graphic Characters:: +* Alphabetic Characters:: +* Characters With Case:: +* Uppercase Characters:: +* Lowercase Characters:: +* Corresponding Characters in the Other Case:: +* Case of Implementation-Defined Characters:: +* Numeric Characters:: +* Alphanumeric Characters:: +* Digits in a Radix:: + +Characters Dictionary + +* character (System Class):: +* base-char:: +* standard-char:: +* extended-char:: +* char=:: +* character:: +* characterp:: +* alpha-char-p:: +* alphanumericp:: +* digit-char:: +* digit-char-p:: +* graphic-char-p:: +* standard-char-p:: +* char-upcase:: +* upper-case-p:: +* char-code:: +* char-int:: +* code-char:: +* char-code-limit:: +* char-name:: +* name-char:: + +Conses + +* Cons Concepts:: +* Conses Dictionary:: + +Cons Concepts + +* Conses as Trees:: +* Conses as Lists:: + +Conses as Trees + +* General Restrictions on Parameters that must be Trees:: + +Conses as Lists + +* Lists as Association Lists:: +* Lists as Sets:: +* General Restrictions on Parameters that must be Lists:: + +Conses Dictionary + +* list (System Class):: +* null (System Class):: +* cons (System Class):: +* atom (Type):: +* cons:: +* consp:: +* atom:: +* rplaca:: +* car:: +* copy-tree:: +* sublis:: +* subst:: +* tree-equal:: +* copy-list:: +* list (Function):: +* list-length:: +* listp:: +* make-list:: +* push:: +* pop:: +* first:: +* nth:: +* endp:: +* null:: +* nconc:: +* append:: +* revappend:: +* butlast:: +* last:: +* ldiff:: +* nthcdr:: +* rest:: +* member (Function):: +* mapc:: +* acons:: +* assoc:: +* copy-alist:: +* pairlis:: +* rassoc:: +* get-properties:: +* getf:: +* remf:: +* intersection:: +* adjoin:: +* pushnew:: +* set-difference:: +* set-exclusive-or:: +* subsetp:: +* union:: + +Arrays + +* Array Concepts:: +* Arrays Dictionary:: + +Array Concepts + +* Array Elements:: +* Specialized Arrays:: + +Array Elements + +* Array Indices:: +* Array Dimensions:: +* Implementation Limits on Individual Array Dimensions:: +* Array Rank:: +* Vectors:: +* Fill Pointers:: +* Multidimensional Arrays:: +* Storage Layout for Multidimensional Arrays:: +* Implementation Limits on Array Rank:: + +Specialized Arrays + +* Array Upgrading:: +* Required Kinds of Specialized Arrays:: + +Arrays Dictionary + +* array:: +* simple-array:: +* vector (System Class):: +* simple-vector:: +* bit-vector:: +* simple-bit-vector:: +* make-array:: +* adjust-array:: +* adjustable-array-p:: +* aref:: +* array-dimension:: +* array-dimensions:: +* array-element-type:: +* array-has-fill-pointer-p:: +* array-displacement:: +* array-in-bounds-p:: +* array-rank:: +* array-row-major-index:: +* array-total-size:: +* arrayp:: +* fill-pointer:: +* row-major-aref:: +* upgraded-array-element-type:: +* array-dimension-limit:: +* array-rank-limit:: +* array-total-size-limit:: +* simple-vector-p:: +* svref:: +* vector:: +* vector-pop:: +* vector-push:: +* vectorp:: +* bit (Array):: +* bit-and:: +* bit-vector-p:: +* simple-bit-vector-p:: + +Strings + +* String Concepts:: +* Strings Dictionary:: + +String Concepts + +* Implications of Strings Being Arrays:: +* Subtypes of STRING:: + +Strings Dictionary + +* string (System Class):: +* base-string:: +* simple-string:: +* simple-base-string:: +* simple-string-p:: +* char:: +* string:: +* string-upcase:: +* string-trim:: +* string=:: +* stringp:: +* make-string:: + +Sequences + +* Sequence Concepts:: +* Rules about Test Functions:: +* Sequences Dictionary:: + +Sequence Concepts + +* General Restrictions on Parameters that must be Sequences:: + +Rules about Test Functions + +* Satisfying a Two-Argument Test:: +* Satisfying a One-Argument Test:: + +Satisfying a Two-Argument Test + +* Examples of Satisfying a Two-Argument Test:: + +Satisfying a One-Argument Test + +* Examples of Satisfying a One-Argument Test:: + +Sequences Dictionary + +* sequence:: +* copy-seq:: +* elt:: +* fill:: +* make-sequence:: +* subseq:: +* map:: +* map-into:: +* reduce:: +* count:: +* length:: +* reverse:: +* sort:: +* find:: +* position:: +* search:: +* mismatch:: +* replace:: +* substitute:: +* concatenate:: +* merge:: +* remove:: +* remove-duplicates:: + +Hash Tables + +* Hash Table Concepts:: +* Hash Tables Dictionary:: + +Hash Table Concepts + +* Hash-Table Operations:: +* Modifying Hash Table Keys:: + +Modifying Hash Table Keys + +* Visible Modification of Objects with respect to EQ and EQL:: +* Visible Modification of Objects with respect to EQUAL:: +* Visible Modification of Conses with respect to EQUAL:: +* Visible Modification of Bit Vectors and Strings with respect to EQUAL:: +* Visible Modification of Objects with respect to EQUALP:: +* Visible Modification of Structures with respect to EQUALP:: +* Visible Modification of Arrays with respect to EQUALP:: +* Visible Modification of Hash Tables with respect to EQUALP:: +* Visible Modifications by Language Extensions:: + +Hash Tables Dictionary + +* hash-table:: +* make-hash-table:: +* hash-table-p:: +* hash-table-count:: +* hash-table-rehash-size:: +* hash-table-rehash-threshold:: +* hash-table-size:: +* hash-table-test:: +* gethash:: +* remhash:: +* maphash:: +* with-hash-table-iterator:: +* clrhash:: +* sxhash:: + +Filenames + +* Overview of Filenames:: +* Pathnames:: +* Logical Pathnames:: +* Filenames Dictionary:: + +Overview of Filenames + +* Namestrings as Filenames:: +* Pathnames as Filenames:: +* Parsing Namestrings Into Pathnames:: + +Pathnames + +* Pathname Components:: +* Interpreting Pathname Component Values:: +* Merging Pathnames:: + +Pathname Components + +* The Pathname Host Component:: +* The Pathname Device Component:: +* The Pathname Directory Component:: +* The Pathname Name Component:: +* The Pathname Type Component:: +* The Pathname Version Component:: + +Interpreting Pathname Component Values + +* Strings in Component Values:: +* Special Characters in Pathname Components:: +* Case in Pathname Components:: +* Local Case in Pathname Components:: +* Common Case in Pathname Components:: +* Special Pathname Component Values:: +* NIL as a Component Value:: +* ->WILD as a Component Value:: +* ->UNSPECIFIC as a Component Value:: +* Relation between component values NIL and ->UNSPECIFIC:: +* Restrictions on Wildcard Pathnames:: +* Restrictions on Examining Pathname Components:: +* Restrictions on Examining a Pathname Host Component:: +* Restrictions on Examining a Pathname Device Component:: +* Restrictions on Examining a Pathname Directory Component:: +* Directory Components in Non-Hierarchical File Systems:: +* Restrictions on Examining a Pathname Name Component:: +* Restrictions on Examining a Pathname Type Component:: +* Restrictions on Examining a Pathname Version Component:: +* Notes about the Pathname Version Component:: +* Restrictions on Constructing Pathnames:: + +Merging Pathnames + +* Examples of Merging Pathnames:: + +Logical Pathnames + +* Syntax of Logical Pathname Namestrings:: +* Logical Pathname Components:: + +Syntax of Logical Pathname Namestrings + +* Additional Information about Parsing Logical Pathname Namestrings:: +* The Host part of a Logical Pathname Namestring:: +* The Device part of a Logical Pathname Namestring:: +* The Directory part of a Logical Pathname Namestring:: +* The Type part of a Logical Pathname Namestring:: +* The Version part of a Logical Pathname Namestring:: +* Wildcard Words in a Logical Pathname Namestring:: +* Lowercase Letters in a Logical Pathname Namestring:: +* Other Syntax in a Logical Pathname Namestring:: + +Logical Pathname Components + +* Unspecific Components of a Logical Pathname:: +* Null Strings as Components of a Logical Pathname:: + +Filenames Dictionary + +* pathname (System Class):: +* logical-pathname (System Class):: +* pathname:: +* make-pathname:: +* pathnamep:: +* pathname-host:: +* load-logical-pathname-translations:: +* logical-pathname-translations:: +* logical-pathname:: +* *default-pathname-defaults*:: +* namestring:: +* parse-namestring:: +* wild-pathname-p:: +* pathname-match-p:: +* translate-logical-pathname:: +* translate-pathname:: +* merge-pathnames:: + +Files + +* File System Concepts:: +* Files Dictionary:: + +File System Concepts + +* Coercion of Streams to Pathnames:: +* File Operations on Open and Closed Streams:: +* Truenames:: + +Truenames + +* Examples of Truenames:: + +Files Dictionary + +* directory:: +* probe-file:: +* ensure-directories-exist:: +* truename:: +* file-author:: +* file-write-date:: +* rename-file:: +* delete-file:: +* file-error:: +* file-error-pathname:: + +Streams + +* Stream Concepts:: +* Streams Dictionary:: + +Stream Concepts + +* Introduction to Streams:: +* Stream Variables:: +* Stream Arguments to Standardized Functions:: +* Restrictions on Composite Streams:: + +Introduction to Streams + +* Abstract Classifications of Streams (Introduction to Streams):: +* Input:: +* Open and Closed Streams:: +* Interactive Streams:: +* Abstract Classifications of Streams:: +* File Streams:: +* Other Subclasses of Stream:: + +Streams Dictionary + +* stream:: +* broadcast-stream:: +* concatenated-stream:: +* echo-stream:: +* file-stream:: +* string-stream:: +* synonym-stream:: +* two-way-stream:: +* input-stream-p:: +* interactive-stream-p:: +* open-stream-p:: +* stream-element-type:: +* streamp:: +* read-byte:: +* write-byte:: +* peek-char:: +* read-char:: +* read-char-no-hang:: +* terpri:: +* unread-char:: +* write-char:: +* read-line:: +* write-string:: +* read-sequence:: +* write-sequence:: +* file-length:: +* file-position:: +* file-string-length:: +* open:: +* stream-external-format:: +* with-open-file:: +* close:: +* with-open-stream:: +* listen:: +* clear-input:: +* finish-output:: +* y-or-n-p:: +* make-synonym-stream:: +* synonym-stream-symbol:: +* broadcast-stream-streams:: +* make-broadcast-stream:: +* make-two-way-stream:: +* two-way-stream-input-stream:: +* echo-stream-input-stream:: +* make-echo-stream:: +* concatenated-stream-streams:: +* make-concatenated-stream:: +* get-output-stream-string:: +* make-string-input-stream:: +* make-string-output-stream:: +* with-input-from-string:: +* with-output-to-string:: +* *debug-io*:: +* *terminal-io*:: +* stream-error:: +* stream-error-stream:: +* end-of-file:: + +Printer + +* The Lisp Printer:: +* The Lisp Pretty Printer:: +* Formatted Output:: +* Printer Dictionary:: + +The Lisp Printer + +* Overview of The Lisp Printer:: +* Printer Dispatching:: +* Default Print-Object Methods:: +* Examples of Printer Behavior:: + +Overview of The Lisp Printer + +* Multiple Possible Textual Representations:: +* Printer Escaping:: + +Default Print-Object Methods + +* Printing Numbers:: +* Printing Integers:: +* Printing Ratios:: +* Printing Floats:: +* Printing Complexes:: +* Note about Printing Numbers:: +* Printing Characters:: +* Printing Symbols:: +* Package Prefixes for Symbols:: +* Effect of Readtable Case on the Lisp Printer:: +* Examples of Effect of Readtable Case on the Lisp Printer:: +* Printing Strings:: +* Printing Lists and Conses:: +* Printing Bit Vectors:: +* Printing Other Vectors:: +* Printing Other Arrays:: +* Examples of Printing Arrays:: +* Printing Random States:: +* Printing Pathnames:: +* Printing Structures:: +* Printing Other Objects:: + +The Lisp Pretty Printer + +* Pretty Printer Concepts:: +* Examples of using the Pretty Printer:: +* Notes about the Pretty Printer`s Background:: + +Pretty Printer Concepts + +* Dynamic Control of the Arrangement of Output:: +* Format Directive Interface:: +* Compiling Format Strings:: +* Pretty Print Dispatch Tables:: +* Pretty Printer Margins:: + +Formatted Output + +* FORMAT Basic Output:: +* FORMAT Radix Control:: +* FORMAT Floating-Point Printers:: +* FORMAT Printer Operations:: +* FORMAT Pretty Printer Operations:: +* FORMAT Layout Control:: +* FORMAT Control-Flow Operations:: +* FORMAT Miscellaneous Operations:: +* FORMAT Miscellaneous Pseudo-Operations:: +* Additional Information about FORMAT Operations:: +* Examples of FORMAT:: +* Notes about FORMAT:: + +FORMAT Basic Output + +* Tilde C-> Character:: +* Tilde Percent-> Newline:: +* Tilde Ampersand-> Fresh-Line:: +* Tilde Vertical-Bar-> Page:: +* Tilde Tilde-> Tilde:: + +FORMAT Radix Control + +* Tilde R-> Radix:: +* Tilde D-> Decimal:: +* Tilde B-> Binary:: +* Tilde O-> Octal:: +* Tilde X-> Hexadecimal:: + +FORMAT Floating-Point Printers + +* Tilde F-> Fixed-Format Floating-Point:: +* Tilde E-> Exponential Floating-Point:: +* Tilde G-> General Floating-Point:: +* Tilde Dollarsign-> Monetary Floating-Point:: + +FORMAT Printer Operations + +* Tilde A-> Aesthetic:: +* Tilde S-> Standard:: +* Tilde W-> Write:: + +FORMAT Pretty Printer Operations + +* Tilde Underscore-> Conditional Newline:: +* Tilde Less-Than-Sign-> Logical Block:: +* Tilde I-> Indent:: +* Tilde Slash-> Call Function:: + +FORMAT Layout Control + +* Tilde T-> Tabulate:: +* Tilde Less-Than-Sign-> Justification:: +* Tilde Greater-Than-Sign-> End of Justification:: + +FORMAT Control-Flow Operations + +* Tilde Asterisk-> Go-To:: +* Tilde Left-Bracket-> Conditional Expression:: +* Tilde Right-Bracket-> End of Conditional Expression:: +* Tilde Left-Brace-> Iteration:: +* Tilde Right-Brace-> End of Iteration:: +* Tilde Question-Mark-> Recursive Processing:: + +FORMAT Miscellaneous Operations + +* Tilde Left-Paren-> Case Conversion:: +* Tilde Right-Paren-> End of Case Conversion:: +* Tilde P-> Plural:: + +FORMAT Miscellaneous Pseudo-Operations + +* Tilde Semicolon-> Clause Separator:: +* Tilde Circumflex-> Escape Upward:: +* Tilde Newline-> Ignored Newline:: + +Additional Information about FORMAT Operations + +* Nesting of FORMAT Operations:: +* Missing and Additional FORMAT Arguments:: +* Additional FORMAT Parameters:: +* Undefined FORMAT Modifier Combinations:: + +Printer Dictionary + +* copy-pprint-dispatch:: +* formatter:: +* pprint-dispatch:: +* pprint-exit-if-list-exhausted:: +* pprint-fill:: +* pprint-indent:: +* pprint-logical-block:: +* pprint-newline:: +* pprint-pop:: +* pprint-tab:: +* print-object:: +* print-unreadable-object:: +* set-pprint-dispatch:: +* write:: +* write-to-string:: +* *print-array*:: +* *print-base*:: +* *print-case*:: +* *print-circle*:: +* *print-escape*:: +* *print-gensym*:: +* *print-level*:: +* *print-lines*:: +* *print-miser-width*:: +* *print-pprint-dispatch*:: +* *print-pretty*:: +* *print-readably*:: +* *print-right-margin*:: +* print-not-readable:: +* print-not-readable-object:: +* format:: + +Reader + +* Reader Concepts:: +* Reader Dictionary:: + +Reader Concepts + +* Dynamic Control of the Lisp Reader:: +* Effect of Readtable Case on the Lisp Reader:: +* Argument Conventions of Some Reader Functions:: + +Effect of Readtable Case on the Lisp Reader + +* Examples of Effect of Readtable Case on the Lisp Reader:: + +Argument Conventions of Some Reader Functions + +* The EOF-ERROR-P argument:: +* The RECURSIVE-P argument:: + +Reader Dictionary + +* readtable:: +* copy-readtable:: +* make-dispatch-macro-character:: +* read:: +* read-delimited-list:: +* read-from-string:: +* readtable-case:: +* readtablep:: +* set-dispatch-macro-character:: +* set-macro-character:: +* set-syntax-from-char:: +* with-standard-io-syntax:: +* *read-base*:: +* *read-default-float-format*:: +* *read-eval*:: +* *read-suppress*:: +* *readtable*:: +* reader-error:: + +System Construction + +* System Construction Concepts:: +* System Construction Dictionary:: + +System Construction Concepts + +* Loading:: +* Features:: + +Features + +* Feature Expressions:: +* Examples of Feature Expressions:: + +System Construction Dictionary + +* compile-file:: +* compile-file-pathname:: +* load:: +* with-compilation-unit:: +* *features*:: +* *compile-file-pathname*:: +* *load-pathname*:: +* *compile-print*:: +* *load-print*:: +* *modules*:: +* provide:: + +Environment + +* The External Environment:: +* Environment Dictionary:: + +The External Environment + +* Top level loop:: +* Debugging Utilities:: +* Environment Inquiry:: +* Time:: + +Time + +* Decoded Time:: +* Universal Time:: +* Internal Time:: +* Seconds:: + +Environment Dictionary + +* decode-universal-time:: +* encode-universal-time:: +* get-universal-time:: +* sleep:: +* apropos:: +* describe:: +* describe-object:: +* trace:: +* step:: +* time:: +* internal-time-units-per-second:: +* get-internal-real-time:: +* get-internal-run-time:: +* disassemble:: +* documentation:: +* room:: +* ed:: +* inspect:: +* dribble:: +* -:: +* +:: +* *:: +* /:: +* lisp-implementation-type:: +* short-site-name:: +* machine-instance:: +* machine-type:: +* machine-version:: +* software-type:: +* user-homedir-pathname:: + +Glossary + +* Glossary:: + +Appendix + +* Removed Language Features:: + +Removed Language Features + +* Requirements for removed and deprecated features:: +* Removed Types:: +* Removed Operators:: +* Removed Argument Conventions:: +* Removed Variables:: +* Removed Reader Syntax:: +* Packages No Longer Required:: + + +File: gcl.info, Node: Introduction (Introduction), Next: Syntax, Prev: Top, Up: Top + +1 Introduction +************** + +* Menu: + +* Scope:: +* Organization of the Document:: +* Referenced Publications:: +* Definitions:: +* Conformance:: +* Language Extensions:: +* Language Subsets:: +* Deprecated Language Features:: +* Symbols in the COMMON-LISP Package:: + + +File: gcl.info, Node: Scope, Next: Organization of the Document, Prev: Introduction (Introduction), Up: Introduction (Introduction) + +1.1 Scope, Purpose, and History +=============================== + +* Menu: + +* Scope and Purpose:: +* History:: + + +File: gcl.info, Node: Scope and Purpose, Next: History, Prev: Scope, Up: Scope + +1.1.1 Scope and Purpose +----------------------- + +The specification set forth in this document is designed to promote the +portability of Common Lisp programs among a variety of data processing +systems. It is a language specification aimed at an audience of +implementors and knowledgeable programmers. It is neither a tutorial +nor an implementation guide. + + +File: gcl.info, Node: History, Prev: Scope and Purpose, Up: Scope + +1.1.2 History +------------- + +Lisp is a family of languages with a long history. Early key ideas in +Lisp were developed by John McCarthy during the 1956 Dartmouth Summer +Research Project on Artificial Intelligence. McCarthy's motivation was +to develop an algebraic list processing language for artificial +intelligence work. Implementation efforts for early dialects of Lisp +were undertaken on the IBM~704, the IBM~7090, the Digital Equipment +Corporation (DEC) PDP-1, the DEC~PDP-6, and the PDP-10. The primary +dialect of Lisp between 1960 and 1965 was Lisp~1.5. By the early 1970's +there were two predominant dialects of Lisp, both arising from these +early efforts: MacLisp and Interlisp. For further information about +very early Lisp dialects, see The Anatomy of Lisp or Lisp 1.5 +Programmer's Manual. + + MacLisp improved on the Lisp~1.5 notion of special variables and +error handling. MacLisp also introduced the concept of functions that +could take a variable number of arguments, macros, arrays, non-local +dynamic exits, fast arithmetic, the first good Lisp compiler, and an +emphasis on execution speed. By the end of the 1970's, MacLisp was in +use at over 50 sites. For further information about Maclisp, see +Maclisp Reference Manual, Revision~0 or The Revised Maclisp Manual. + + Interlisp introduced many ideas into Lisp programming environments +and methodology. One of the Interlisp ideas that influenced Common Lisp +was an iteration construct implemented by Warren Teitelman that inspired +the loop macro used both on the Lisp Machines and in MacLisp, and now in +Common Lisp. For further information about Interlisp, see Interlisp +Reference Manual. + + Although the first implementations of Lisp were on the IBM~704 and +the IBM~7090, later work focussed on the DEC PDP-6 and, later, PDP-10 +computers, the latter being the mainstay of Lisp and artificial +intelligence work at such places as Massachusetts Institute of +Technology (MIT), Stanford University, and Carnegie Mellon University +(CMU) from the mid-1960's through much of the 1970's. The PDP-10 +computer and its predecessor the PDP-6 computer were, by design, +especially well-suited to Lisp because they had 36-bit words and 18-bit +addresses. This architecture allowed a cons cell to be stored in one +word; single instructions could extract the car and cdr parts. The +PDP-6 and PDP-10 had fast, powerful stack instructions that enabled fast +function calling. But the limitations of the PDP-10 were evident by +1973: it supported a small number of researchers using Lisp, and the +small, 18-bit address space (2^18 = 262,144 words) limited the size of a +single program. One response to the address space problem was the Lisp +Machine, a special-purpose computer designed to run Lisp programs. The +other response was to use general-purpose computers with address spaces +larger than 18~bits, such as the DEC VAX and the S-1~Mark~IIA. For +further information about S-1 Common Lisp, see S-1 Common Lisp +Implementation. + + The Lisp machine concept was developed in the late 1960's. In the +early 1970's, Peter Deutsch, working with Daniel Bobrow, implemented a +Lisp on the Alto, a single-user minicomputer, using microcode to +interpret a byte-code implementation language. Shortly thereafter, +Richard Greenblatt began work on a different hardware and instruction +set design at MIT. Although the Alto was not a total success as a Lisp +machine, a dialect of Interlisp known as Interlisp-D became available on +the D-series machines manufactured by Xerox--the Dorado, Dandelion, +Dandetiger, and Dove (or Daybreak). An upward-compatible extension of +MacLisp called Lisp Machine Lisp became available on the early MIT Lisp +Machines. Commercial Lisp machines from Xerox, Lisp Machines (LMI), and +Symbolics were on the market by 1981. For further information about +Lisp Machine Lisp, see Lisp Machine Manual. + + During the late 1970's, Lisp Machine Lisp began to expand towards a +much fuller language. Sophisticated lambda lists, setf, multiple +values, and structures like those in Common Lisp are the results of +early experimentation with programming styles by the Lisp Machine group. +Jonl White and others migrated these features to MacLisp. Around 1980, +Scott Fahlman and others at CMU began work on a Lisp to run on the +Scientific Personal Integrated Computing Environment (SPICE) +workstation. One of the goals of the project was to design a simpler +dialect than Lisp Machine Lisp. + + The Macsyma group at MIT began a project during the late 1970's +called the New Implementation of Lisp (NIL) for the VAX, which was +headed by White. One of the stated goals of the NIL project was to fix +many of the historic, but annoying, problems with Lisp while retaining +significant compatibility with MacLisp. At about the same time, a +research group at Stanford University and Lawrence Livermore National +Laboratory headed by Richard P. Gabriel began the design of a Lisp to +run on the S-1~Mark~IIA supercomputer. S-1~Lisp, never completely +functional, was the test bed for adapting advanced compiler techniques +to Lisp implementation. Eventually the S-1 and NIL groups collaborated. +For further information about the NIL project, see NIL--A Perspective. + + The first effort towards Lisp standardization was made in 1969, when +Anthony Hearn and Martin Griss at the University of Utah defined +Standard Lisp--a subset of Lisp~1.5 and other dialects--to transport +REDUCE, a symbolic algebra system. During the 1970's, the Utah group +implemented first a retargetable optimizing compiler for Standard Lisp, +and then an extended implementation known as Portable Standard Lisp +(PSL). By the mid 1980's, PSL ran on about a dozen kinds of computers. +For further information about Standard Lisp, see Standard LISP Report. + + PSL and Franz Lisp--a MacLisp-like dialect for Unix machines--were +the first examples of widely available Lisp dialects on multiple +hardware platforms. + + One of the most important developments in Lisp occurred during the +second half of the 1970's: Scheme. Scheme, designed by Gerald J. +Sussman and Guy L. Steele Jr., is a simple dialect of Lisp whose design +brought to Lisp some of the ideas from programming language semantics +developed in the 1960's. Sussman was one of the prime innovators behind +many other advances in Lisp technology from the late 1960's through the +1970's. The major contributions of Scheme were lexical scoping, lexical +closures, first-class continuations, and simplified syntax (no +separation of value cells and function cells). Some of these +contributions made a large impact on the design of Common Lisp. For +further information about Scheme, see IEEE Standard for the Scheme +Programming Language or Revised^3 Report on the Algorithmic Language +Scheme. + + In the late 1970's object-oriented programming concepts started to +make a strong impact on Lisp. At MIT, certain ideas from Smalltalk made +their way into several widely used programming systems. Flavors, an +object-oriented programming system with multiple inheritance, was +developed at MIT for the Lisp machine community by Howard Cannon and +others. At Xerox, the experience with Smalltalk and Knowledge +Representation Language (KRL) led to the development of Lisp Object +Oriented Programming System (LOOPS) and later Common LOOPS. For further +information on Smalltalk, see Smalltalk-80: The Language and its +Implementation. For further information on Flavors, see Flavors: A +Non-Hierarchical Approach to Object-Oriented Programming. + + These systems influenced the design of the Common Lisp Object System +(CLOS). CLOS was developed specifically for this standardization effort, +and was separately written up in Common Lisp Object System +Specification. However, minor details of its design have changed +slightly since that publication, and that paper should not be taken as +an authoritative reference to the semantics of the object system as +described in this document. + + In 1980 Symbolics and LMI were developing Lisp Machine Lisp; +stock-hardware implementation groups were developing NIL, Franz Lisp, +and PSL; Xerox was developing Interlisp; and the SPICE project at CMU +was developing a MacLisp-like dialect of Lisp called SpiceLisp. + + In April 1981, after a DARPA-sponsored meeting concerning the +splintered Lisp community, Symbolics, the SPICE project, the NIL +project, and the S-1~Lisp project joined together to define Common Lisp. +Initially spearheaded by White and Gabriel, the driving force behind +this grassroots effort was provided by Fahlman, Daniel Weinreb, David +Moon, Steele, and Gabriel. Common Lisp was designed as a description of +a family of languages. The primary influences on Common Lisp were Lisp +Machine Lisp, MacLisp, NIL, S-1~Lisp, Spice Lisp, and Scheme. Common +Lisp: The Language is a description of that design. Its semantics were +intentionally underspecified in places where it was felt that a tight +specification would overly constrain Common Lisp research and use. + + In 1986 X3J13 was formed as a technical working group to produce a +draft for an ANSI Common Lisp standard. Because of the acceptance of +Common Lisp, the goals of this group differed from those of the original +designers. These new goals included stricter standardization for +portability, an object-oriented programming system, a condition system, +iteration facilities, and a way to handle large character sets. To +accommodate those goals, a new language specification, this document, +was developed. + + +File: gcl.info, Node: Organization of the Document, Next: Referenced Publications, Prev: Scope, Up: Introduction (Introduction) + +1.2 Organization of the Document +================================ + +This is a reference document, not a tutorial document. Where possible +and convenient, the order of presentation has been chosen so that the +more primitive topics precede those that build upon them; however, +linear readability has not been a priority. + + This document is divided into chapters by topic. Any given chapter +might contain conceptual material, dictionary entries, or both. + + Defined names within the dictionary portion of a chapter are grouped +in a way that brings related topics into physical proximity. Many such +groupings were possible, and no deep significance should be inferred +from the particular grouping that was chosen. To see defined names +grouped alphabetically, consult the index. For a complete list of +defined names, see *note Symbols in the COMMON-LISP Package::. + + In order to compensate for the sometimes-unordered portions of this +document, a glossary has been provided; see *note Glossary::. The +glossary provides connectivity by providing easy access to definitions +of terms, and in some cases by providing examples or cross references to +additional conceptual material. + + For information about notational conventions used in this document, +see *note Definitions::. + + For information about conformance, see *note Conformance::. + + For information about extensions and subsets, see *note Language +Extensions:: and *note Language Subsets::. + + For information about how programs in the language are parsed by the +Lisp reader, see *note Syntax::. + + For information about how programs in the language are compiled and +executed, see *note Evaluation and Compilation::. + + For information about data types, see *note Types and Classes::. Not +all types and classes are defined in this chapter; many are defined in +chapter corresponding to their topic-for example, the numeric types are +defined in *note Numbers (Numbers)::. For a complete list of +standardized types, see Figure~4-2. + + For information about general purpose control and data flow, see +*note Data and Control Flow:: or *note Iteration::. + + +File: gcl.info, Node: Referenced Publications, Next: Definitions, Prev: Organization of the Document, Up: Introduction (Introduction) + +1.3 Referenced Publications +=========================== + +* + The Anatomy of Lisp, John Allen, McGraw-Hill, Inc., 1978. + +* + The Art of Computer Programming, Volume 3, Donald E. Knuth, + Addison-Wesley Company (Reading, MA), 1973. + +* + The Art of the Metaobject Protocol, Kiczales et al., MIT Press + (Cambridge, MA), 1991. + +* + Common Lisp Object System Specification, D. Bobrow, L. DiMichiel, + R.P. Gabriel, S. Keene, G. Kiczales, D. Moon, SIGPLAN Notices V23, + September, 1988. + +* + Common Lisp: The Language, Guy L. Steele Jr., Digital Press + (Burlington, MA), 1984. + +* + Common Lisp: The Language, Second Edition, Guy L. Steele Jr., + Digital Press (Bedford, MA), 1990. + +* + Exceptional Situations in Lisp, Kent M. Pitman, Proceedings of the + First European Conference on the Practical Application of LISP\/ + (EUROPAL '90), Churchill College, Cambridge, England, March 27-29, + 1990. + +* + Flavors: A Non-Hierarchical Approach to Object-Oriented + Programming, Howard I. Cannon, 1982. + +* + IEEE Standard for Binary Floating-Point Arithmetic, ANSI/IEEE Std + 754-1985, Institute of Electrical and Electronics Engineers, Inc. + (New York), 1985. + +* + IEEE Standard for the Scheme Programming Language, IEEE Std + 1178-1990, Institute of Electrical and Electronic Engineers, Inc. + (New York), 1991. + +* + Interlisp Reference Manual, Third Revision, Teitelman, Warren, et + al, Xerox Palo Alto Research Center (Palo Alto, CA), 1978. + +* + ISO 6937/2, Information processing--Coded character sets for text + communication--Part 2: Latin alphabetic and non-alphabetic graphic + characters, ISO, 1983. + +* + Lisp 1.5 Programmer's Manual, John McCarthy, MIT Press (Cambridge, + MA), August, 1962. + +* + Lisp Machine Manual, D.L. Weinreb and D.A. Moon, Artificial + Intelligence Laboratory, MIT (Cambridge, MA), July, 1981. + +* + Maclisp Reference Manual, Revision~0, David A. Moon, Project MAC + (Laboratory for Computer Science), MIT (Cambridge, MA), March, + 1974. + +* + NIL--A Perspective, JonL White, Macsyma User's Conference, 1979. + +* + Performance and Evaluation of Lisp Programs, Richard P. Gabriel, + MIT Press (Cambridge, MA), 1985. + +* + Principal Values and Branch Cuts in Complex APL, Paul Penfield Jr., + APL 81 Conference Proceedings, ACM SIGAPL (San Francisco, September + 1981), 248-256. Proceedings published as APL Quote Quad 12, 1 + (September 1981). + +* + The Revised Maclisp Manual, Kent M. Pitman, Technical Report 295, + Laboratory for Computer Science, MIT (Cambridge, MA), May 1983. + +* + Revised^3 Report on the Algorithmic Language Scheme, Jonathan Rees + and William Clinger (editors), SIGPLAN Notices V21, #12, December, + 1986. + +* + S-1 Common Lisp Implementation, R.A. Brooks, R.P. Gabriel, and G.L. + Steele, Conference Record of the 1982 ACM Symposium on Lisp and + Functional Programming, 108-113, 1982. + +* + Smalltalk-80: The Language and its Implementation, A. Goldberg and + D. Robson, Addison-Wesley, 1983. + +* + Standard LISP Report, J.B. Marti, A.C. Hearn, M.L. Griss, and C. + Griss, SIGPLAN Notices V14, #10, October, 1979. + +* + Webster's Third New International Dictionary the English Language, + Unabridged, Merriam Webster (Springfield, MA), 1986. + +* + XP: A Common Lisp Pretty Printing System, R.C. Waters, Memo 1102a, + Artificial Intelligence Laboratory, MIT (Cambridge, MA), September + 1989. + + +File: gcl.info, Node: Definitions, Next: Conformance, Prev: Referenced Publications, Up: Introduction (Introduction) + +1.4 Definitions +=============== + +This section contains notational conventions and definitions of terms +used in this manual. + +* Menu: + +* Notational Conventions:: +* Error Terminology:: +* Sections Not Formally Part Of This Standard:: +* Interpreting Dictionary Entries:: + + +File: gcl.info, Node: Notational Conventions, Next: Error Terminology, Prev: Definitions, Up: Definitions + +1.4.1 Notational Conventions +---------------------------- + +The following notational conventions are used throughout this document. + +* Menu: + +* Font Key:: +* Modified BNF Syntax:: +* Splicing in Modified BNF Syntax:: +* Indirection in Modified BNF Syntax:: +* Additional Uses for Indirect Definitions in Modified BNF Syntax:: +* Special Symbols:: +* Objects with Multiple Notations:: +* Case in Symbols:: +* Numbers (Objects with Multiple Notations):: +* Use of the Dot Character:: +* NIL:: +* Designators:: +* Nonsense Words:: + + +File: gcl.info, Node: Font Key, Next: Modified BNF Syntax, Prev: Notational Conventions, Up: Notational Conventions + +1.4.1.1 Font Key +................ + +Fonts are used in this document to convey information. + +name + Denotes a formal term whose meaning is defined in the Glossary. + When this font is used, the Glossary definition takes precedence + over normal English usage. + + Sometimes a glossary term appears subscripted, as in + "whitespace_2." Such a notation selects one particular Glossary + definition out of several, in this case the second. The subscript + notation for Glossary terms is generally used where the context + might be insufficient to disambiguate among the available + definitions. + +name + + Denotes the introduction of a formal term locally to the current + text. There is still a corresponding glossary entry, and is + formally equivalent to a use of "name," but the hope is that making + such uses conspicuous will save the reader a trip to the glossary + in some cases. + +name + Denotes a symbol in the COMMON-LISP package. For information about + case conventions, see *note Case in Symbols::. + +name + Denotes a sample name or piece of code that a programmer might + write in Common Lisp. + + This font is also used for certain standardized names that are not + names of external symbols of the COMMON-LISP package, such as + keywords_1, package names, and loop keywords. + +name + Denotes the name of a parameter or value. + + In some situations the notation "<>" (i.e., the same font, + but with surrounding "angle brackets") is used instead in order to + provide better visual separation from surrounding characters. + These "angle brackets" are metasyntactic, and never actually appear + in program input or output. + + +File: gcl.info, Node: Modified BNF Syntax, Next: Splicing in Modified BNF Syntax, Prev: Font Key, Up: Notational Conventions + +1.4.1.2 Modified BNF Syntax +........................... + +This specification uses an extended Backus Normal Form (BNF) to describe +the syntax of Common Lisp macro forms and special forms. This section +discusses the syntax of BNF expressions. + + +File: gcl.info, Node: Splicing in Modified BNF Syntax, Next: Indirection in Modified BNF Syntax, Prev: Modified BNF Syntax, Up: Notational Conventions + +1.4.1.3 Splicing in Modified BNF Syntax +....................................... + +The primary extension used is the following: + + [[O]] + + An expression of this form appears whenever a list of elements is to +be spliced into a larger structure and the elements can appear in any +order. The symbol O represents a description of the syntax of some +number of syntactic elements to be spliced; that description must be of +the form + + O_1 | ... | O_l + +where each O_i can be of the form S or of the form S* or of the form +S^1. + + The expression [[O]] means that a list of the form + + (O_{i_1}... O_{i_j}) 1<= j + +is spliced into the enclosing expression, such that if n != m and 1<= +n,m<= j, then either O_{i_n}!= O_{i_m} or O_{i_n} = O_{i_m} = Q_k, where +for some 1<= k <= n, O_k is of the form Q_k*. + + Furthermore, for each O_{i_n} that is of the form Q_k^1, that element +is required to appear somewhere in the list to be spliced. + + For example, the expression + + (x [[A | B* | C]] y) + +means that at most one A, any number of B's, and at most one C can occur +in any order. It is a description of any of these: + + (x y) + (x B A C y) + (x A B B B B B C y) + (x C B A B B B y) + +but not any of these: + + (x B B A A C C y) + (x C B C y) + +In the first case, both A and C appear too often, and in the second case +C appears too often. + + The notation [[O_1 | O_2 | ...]]^+ adds the additional restriction +that at least one item from among the possible choices must be used. +For example: + + (x [[A | B* | C]]^+ y) + +means that at most one A, any number of B's, and at most one C can occur +in any order, but that in any case at least one of these options must be +selected. It is a description of any of these: + + (x B y) + (x B A C y) + (x A B B B B B C y) + (x C B A B B B y) + +but not any of these: + + (x y) + (x B B A A C C y) + (x C B C y) + +In the first case, no item was used; in the second case, both A and C +appear too often; and in the third case C appears too often. + + Also, the expression: + + (x [[A^1 | B^1 | C]] y) + +can generate exactly these and no others: + + (x A B C y) + (x A C B y) + (x A B y) + (x B A C y) + (x B C A y) + (x B A y) + (x C A B y) + (x C B A y) + + +File: gcl.info, Node: Indirection in Modified BNF Syntax, Next: Additional Uses for Indirect Definitions in Modified BNF Syntax, Prev: Splicing in Modified BNF Syntax, Up: Notational Conventions + +1.4.1.4 Indirection in Modified BNF Syntax +.......................................... + +An indirection extension is introduced in order to make this new syntax +more readable: + + !O + +If O is a non-terminal symbol, the right-hand side of its definition is +substituted for the entire expression !O. For example, the following BNF +is equivalent to the BNF in the previous example: + + (x [[!O]] y) + + O ::=A | B* | C + + +File: gcl.info, Node: Additional Uses for Indirect Definitions in Modified BNF Syntax, Next: Special Symbols, Prev: Indirection in Modified BNF Syntax, Up: Notational Conventions + +1.4.1.5 Additional Uses for Indirect Definitions in Modified BNF Syntax +....................................................................... + +In some cases, an auxiliary definition in the BNF might appear to be +unused within the BNF, but might still be useful elsewhere. For +example, consider the following definitions: + + 'case' keyform {!normal-clause}* [!otherwise-clause] => {result}* + + 'ccase' keyplace {!normal-clause}* => {result}* + + 'ecase' keyform {!normal-clause}* => {result}* + + normal-clause ::=(keys {form}*) + + otherwise-clause ::=({otherwise | t} {form}*) + + clause ::=normal-clause | otherwise-clause + + Here the term "clause" might appear to be "dead" in that it is not +used in the BNF. However, the purpose of the BNF is not just to guide +parsing, but also to define useful terms for reference in the +descriptive text which follows. As such, the term "clause" might appear +in text that follows, as shorthand for "normal-clause or +otherwise-clause." + + +File: gcl.info, Node: Special Symbols, Next: Objects with Multiple Notations, Prev: Additional Uses for Indirect Definitions in Modified BNF Syntax, Up: Notational Conventions + +1.4.1.6 Special Symbols +....................... + +The special symbols described here are used as a notational convenience +within this document, and are part of neither the Common Lisp language +nor its environment. + +=> + This indicates evaluation. For example: + + (+ 4 5) => 9 + + This means that the result of evaluating the form (+ 4 5) is 9. + + If a form returns multiple values, those values might be shown + separated by spaces, line breaks, or commas. For example: + + (truncate 7 5) + => 1 2 + (truncate 7 5) + => 1 + 2 + (truncate 7 5) + => 1, 2 + + Each of the above three examples is equivalent, and specifies that + (truncate 7 5) returns two values, which are 1 and 2. + + Some conforming implementations actually type an arrow (or some + other indicator) before showing return values, while others do not. + +OR=> + The notation "OR=>" is used to denote one of several possible + alternate results. The example + + (char-name #\a) + => NIL + OR=> "LOWERCASE-a" + OR=> "Small-A" + OR=> "LA01" + + indicates that nil, "LOWERCASE-a", "Small-A", "LA01" are among the + possible results of (char-name #\a)--each with equal preference. + Unless explicitly specified otherwise, it should not be assumed + that the set of possible results shown is exhaustive. Formally, + the above example is equivalent to + + (char-name #\a) => implementation-dependent + + but it is intended to provide additional information to illustrate + some of the ways in which it is permitted for implementations to + diverge. + +NOT=> + The notation "NOT=>" is used to denote a result which is not + possible. This might be used, for example, in order to emphasize a + situation where some anticipated misconception might lead the + reader to falsely believe that the result might be possible. For + example, + + (function-lambda-expression + (funcall #'(lambda (x) #'(lambda () x)) nil)) + => NIL, true, NIL + OR=> (LAMBDA () X), true, NIL + NOT=> NIL, false, NIL + NOT=> (LAMBDA () X), false, NIL + +== + This indicates code equivalence. For example: + + (gcd x (gcd y z)) == (gcd (gcd x y) z) + + This means that the results and observable side-effects of + evaluating the form (gcd x (gcd y z)) are always the same as the + results and observable side-effects of (gcd (gcd x y) z) for any x, + y, and z. + +|> + Common Lisp specifies input and output with respect to a + non-interactive stream model. The specific details of how + interactive input and output are mapped onto that non-interactive + model are implementation-defined. + + For example, conforming implementations are permitted to differ in + issues of how interactive input is terminated. For example, the + function read terminates when the final delimiter is typed on a + non-interactive stream. In some implementations, an interactive + call to read returns as soon as the final delimiter is typed, even + if that delimiter is not a newline. In other implementations, a + final newline is always required. In still other implementations, + there might be a command which "activates" a buffer full of input + without the command itself being visible on the program's input + stream. + + In the examples in this document, the notation " |> " precedes + lines where interactive input and output occurs. Within such a + scenario, "|>>this notation<<|" notates user input. + + For example, the notation + + (+ 1 (print (+ (sqrt (read)) (sqrt (read))))) + |> |>>9 16 <<| + |> 7 + => 8 + + shows an interaction in which "(+ 1 (print (+ (sqrt (read)) (sqrt + (read)))))" is a form to be evaluated, "9 16 " is interactive + input, "7" is interactive output, and "8" is the value yielded from + the evaluation. + + The use of this notation is intended to disguise small differences + in interactive input and output behavior between implementations. + + Sometimes, the non-interactive stream model calls for a newline. + How that newline character is interactively entered is an + implementation-defined detail of the user interface, but in that + case, either the notation "" or "[<-~]" might be used. + + (progn (format t "~&Who? ") (read-line)) + |> Who? |>>Fred, Mary, and Sally [<-~]<<| + => "Fred, Mary, and Sally", false + + +File: gcl.info, Node: Objects with Multiple Notations, Next: Case in Symbols, Prev: Special Symbols, Up: Notational Conventions + +1.4.1.7 Objects with Multiple Notations +....................................... + +Some objects in Common Lisp can be notated in more than one way. In +such situations, the choice of which notation to use is technically +arbitrary, but conventions may exist which convey a "point of view" or +"sense of intent." + + +File: gcl.info, Node: Case in Symbols, Next: Numbers (Objects with Multiple Notations), Prev: Objects with Multiple Notations, Up: Notational Conventions + +1.4.1.8 Case in Symbols +....................... + +While case is significant in the process of interning a symbol, the Lisp +reader, by default, attempts to canonicalize the case of a symbol prior +to interning; see *note Effect of Readtable Case on the Lisp Reader::. +As such, case in symbols is not, by default, significant. Throughout +this document, except as explicitly noted otherwise, the case in which a +symbol appears is not significant; that is, HELLO, Hello, hElLo, and +hello are all equivalent ways to denote a symbol whose name is "HELLO". + + The characters backslash and vertical-bar are used to explicitly +quote the case and other parsing-related aspects of characters. As +such, the notations |hello| and \h\e\l\l\o are equivalent ways to refer +to a symbol whose name is "hello", and which is distinct from any symbol +whose name is "HELLO". + + The symbols that correspond to Common Lisp defined names have +uppercase names even though their names generally appear in lowercase in +this document. + + +File: gcl.info, Node: Numbers (Objects with Multiple Notations), Next: Use of the Dot Character, Prev: Case in Symbols, Up: Notational Conventions + +1.4.1.9 Numbers +............... + +Although Common Lisp provides a variety of ways for programs to +manipulate the input and output radix for rational numbers, all numbers +in this document are in decimal notation unless explicitly noted +otherwise. + + +File: gcl.info, Node: Use of the Dot Character, Next: NIL, Prev: Numbers (Objects with Multiple Notations), Up: Notational Conventions + +1.4.1.10 Use of the Dot Character +................................. + +The dot appearing by itself in an expression such as + + (item1 item2 . tail) + + means that tail represents a list of objects at the end of a list. +For example, + + (A B C . (D E F)) + + is notationally equivalent to: + + (A B C D E F) + + Although dot is a valid constituent character in a symbol, no +standardized symbols contain the character dot, so a period that follows +a reference to a symbol at the end of a sentence in this document should +always be interpreted as a period and never as part of the symbol's +name. For example, within this document, a sentence such as "This +sample sentence refers to the symbol car." refers to a symbol whose +name is "CAR" (with three letters), and never to a four-letter symbol +"CAR." + + +File: gcl.info, Node: NIL, Next: Designators, Prev: Use of the Dot Character, Up: Notational Conventions + +1.4.1.11 NIL +............ + +nil has a variety of meanings. It is a symbol in the COMMON-LISP +package with the name "NIL", it is boolean (and generalized boolean) +false, it is the empty list, and it is the name of the empty type (a +subtype of all types). + + Within Common Lisp, nil can be notated interchangeably as either NIL +or (). By convention, the choice of notation offers a hint as to which +of its many roles it is playing. + + For Evaluation? Notation Typically Implied Role + ________________________________________________________ + Yes nil use as a boolean. + Yes 'nil use as a symbol. + Yes '() use as an empty list + No nil use as a symbol or boolean. + No () use as an empty list. + + Figure 1-1: Notations for NIL + + + Within this document only, nil is also sometimes notated as false to +emphasize its role as a boolean. + + For example: + + (print ()) ;avoided + (defun three nil 3) ;avoided + '(nil nil) ;list of two symbols + '(() ()) ;list of empty lists + (defun three () 3) ;Emphasize empty parameter list. + (append '() '()) => () ;Emphasize use of empty lists + (not nil) => true ;Emphasize use as Boolean false + (get 'nil 'color) ;Emphasize use as a symbol + + A function is sometimes said to "be false" or "be true" in some +circumstance. Since no function object can be the same as nil and all +function objects represent true when viewed as booleans, it would be +meaningless to say that the function was literally false and +uninteresting to say that it was literally true. Instead, these phrases +are just traditional alternative ways of saying that the function +"returns false" or "returns true," respectively. + + +File: gcl.info, Node: Designators, Next: Nonsense Words, Prev: NIL, Up: Notational Conventions + +1.4.1.12 Designators +.................... + +A designator is an object that denotes another object. + + Where a parameter of an operator is described as a designator, the +description of the operator is written in a way that assumes that the +value of the parameter is the denoted object; that is, that the +parameter is already of the denoted type. (The specific nature of the +object denoted by a "<> designator" or a "designator for a +<>" can be found in the Glossary entry for "<> designator.") + + For example, "nil" and "the value of *standard-output*" are +operationally indistinguishable as stream designators. Similarly, the +symbol foo and the string "FOO" are operationally indistinguishable as +string designators. + + Except as otherwise noted, in a situation where the denoted object +might be used multiple times, it is implementation-dependent whether the +object is coerced only once or whether the coercion occurs each time the +object must be used. + + For example, mapcar receives a function designator as an argument, +and its description is written as if this were simply a function. In +fact, it is implementation-dependent whether the function designator is +coerced right away or whether it is carried around internally in the +form that it was given as an argument and re-coerced each time it is +needed. In most cases, conforming programs cannot detect the +distinction, but there are some pathological situations (particularly +those involving self-redefining or mutually-redefining functions) which +do conform and which can detect this difference. The following program +is a conforming program, but might or might not have portably correct +results, depending on whether its correctness depends on one or the +other of the results: + + (defun add-some (x) + (defun add-some (x) (+ x 2)) + (+ x 1)) => ADD-SOME + (mapcar 'add-some '(1 2 3 4)) + => (2 3 4 5) + OR=> (2 4 5 6) + + In a few rare situations, there may be a need in a dictionary entry +to refer to the object that was the original designator for a parameter. +Since naming the parameter would refer to the denoted object, the phrase +"the <> designator" can be used to refer to the +designator which was the argument from which the value of +<> was computed. + + +File: gcl.info, Node: Nonsense Words, Prev: Designators, Up: Notational Conventions + +1.4.1.13 Nonsense Words +....................... + +When a word having no pre-attached semantics is required (e.g., in an +example), it is common in the Lisp community to use one of the words +"foo," "bar," "baz," and "quux." For example, in + + (defun foo (x) (+ x 1)) + + the use of the name foo is just a shorthand way of saying "please +substitute your favorite name here." + + These nonsense words have gained such prevalance of usage, that it is +commonplace for newcomers to the community to begin to wonder if there +is an attached semantics which they are overlooking--there is not. + + +File: gcl.info, Node: Error Terminology, Next: Sections Not Formally Part Of This Standard, Prev: Notational Conventions, Up: Definitions + +1.4.2 Error Terminology +----------------------- + +Situations in which errors might, should, or must be signaled are +described in the standard. The wording used to describe such situations +is intended to have precise meaning. The following list is a glossary +of those meanings. + +Safe code + + This is code processed with the safety optimization at its highest + setting (3). safety is a lexical property of code. The phrase + "the function F should signal an error" means that if F is invoked + from code processed with the highest safety optimization, an error + is signaled. It is implementation-dependent whether F or the + calling code signals the error. + +Unsafe code + + This is code processed with lower safety levels. + + Unsafe code might do error checking. Implementations are permitted + to treat all code as safe code all the time. + +An error is signaled + + This means that an error is signaled in both safe and unsafe code. + Conforming code may rely on the fact that the error is signaled in + both safe and unsafe code. Every implementation is required to + detect the error in both safe and unsafe code. For example, "an + error is signaled if unexport is given a symbol not accessible in + the current package." + + If an explicit error type is not specified, the default is error. + +An error should be signaled + + This means that an error is signaled in safe code, and an error + might be signaled in unsafe code. Conforming code may rely on the + fact that the error is signaled in safe code. Every implementation + is required to detect the error at least in safe code. When the + error is not signaled, the "consequences are undefined" (see + below). For example, "+ should signal an error of type type-error + if any argument is not of type number." + +Should be prepared to signal an error + + This is similar to "should be signaled" except that it does not + imply that 'extra effort' has to be taken on the part of an + operator to discover an erroneous situation if the normal action of + that operator can be performed successfully with only 'lazy' + checking. An implementation is always permitted to signal an + error, but even in safe code, it is only required to signal the + error when failing to signal it might lead to incorrect results. + In unsafe code, the consequences are undefined. + + For example, defining that "find should be prepared to signal an + error of type type-error if its second argument is not a proper + list" does not imply that an error is always signaled. The form + + (find 'a '(a b . c)) + + must either signal an error of type type-error in safe code, else + return A. In unsafe code, the consequences are undefined. By + contrast, + + (find 'd '(a b . c)) + + must signal an error of type type-error in safe code. In unsafe + code, the consequences are undefined. Also, + + (find 'd '#1=(a b . #1#)) + + in safe code might return nil (as an implementation-defined + extension), might never return, or might signal an error of type + type-error. In unsafe code, the consequences are undefined. + + Typically, the "should be prepared to signal" terminology is used + in type checking situations where there are efficiency + considerations that make it impractical to detect errors that are + not relevant to the correct operation of the operator. + +The consequences are unspecified + + This means that the consequences are unpredictable but harmless. + Implementations are permitted to specify the consequences of this + situation. No conforming code may depend on the results or effects + of this situation, and all conforming code is required to treat the + results and effects of this situation as unpredictable but + harmless. For example, "if the second argument to + shared-initialize specifies a name that does not correspond to any + slots accessible in the object, the results are unspecified." + +The consequences are undefined + + This means that the consequences are unpredictable. The + consequences may range from harmless to fatal. No conforming code + may depend on the results or effects. Conforming code must treat + the consequences as unpredictable. In places where the words + "must," "must not," or "may not" are used, then "the consequences + are undefined" if the stated requirement is not met and no specific + consequence is explicitly stated. An implementation is permitted + to signal an error in this case. + + For example: "Once a name has been declared by defconstant to be + constant, any further assignment or binding of that variable has + undefined consequences." + +An error might be signaled + + This means that the situation has undefined consequences; however, + if an error is signaled, it is of the specified type. For example, + "open might signal an error of type file-error." + +The return values are unspecified + + This means that only the number and nature of the return values of + a form are not specified. However, the issue of whether or not any + side-effects or transfer of control occurs is still well-specified. + + A program can be well-specified even if it uses a function whose + returns values are unspecified. For example, even if the return + values of some function F are unspecified, an expression such as + (length (list (F))) is still well-specified because it does not + rely on any particular aspect of the value or values returned by F. + +Implementations may be extended to cover this situation + + This means that the situation has undefined consequences; however, + a conforming implementation is free to treat the situation in a + more specific way. For example, an implementation might define + that an error is signaled, or that an error should be signaled, or + even that a certain well-defined non-error behavior occurs. + + No conforming code may depend on the consequences of such a + situation; all conforming code must treat the consequences of the + situation as undefined. Implementations are required to document + how the situation is treated. + + For example, "implementations may be extended to define other type + specifiers to have a corresponding class." + +Implementations are free to extend the syntax + + This means that in this situation implementations are permitted to + define unambiguous extensions to the syntax of the form being + described. No conforming code may depend on this extension. + Implementations are required to document each such extension. All + conforming code is required to treat the syntax as meaningless. + The standard might disallow certain extensions while allowing + others. For example, "no implementation is free to extend the + syntax of defclass." + +A warning might be issued + + This means that implementations are encouraged to issue a warning + if the context is appropriate (e.g., when compiling). However, a + conforming implementation is not required to issue a warning. + + +File: gcl.info, Node: Sections Not Formally Part Of This Standard, Next: Interpreting Dictionary Entries, Prev: Error Terminology, Up: Definitions + +1.4.3 Sections Not Formally Part Of This Standard +------------------------------------------------- + +Front matter and back matter, such as the "Table of Contents," "Index," +"Figures," "Credits," and "Appendix" are not considered formally part of +this standard, so that we retain the flexibility needed to update these +sections even at the last minute without fear of needing a formal vote +to change those parts of the document. These items are quite short and +very useful, however, and it is not recommended that they be removed +even in an abridged version of this document. + + Within the concept sections, subsections whose names begin with the +words "Note" or "Notes" or "Example" or "Examples" are provided for +illustration purposes only, and are not considered part of the standard. + + An attempt has been made to place these sections last in their parent +section, so that they could be removed without disturbing the contiguous +numbering of the surrounding sections in order to produce a document of +smaller size. + + Likewise, the "Examples" and "Notes" sections in a dictionary entry +are not considered part of the standard and could be removed if +necessary. + + Nevertheless, the examples provide important clarifications and +consistency checks for the rest of the material, and such abridging is +not recommended unless absolutely unavoidable. + + +File: gcl.info, Node: Interpreting Dictionary Entries, Prev: Sections Not Formally Part Of This Standard, Up: Definitions + +1.4.4 Interpreting Dictionary Entries +------------------------------------- + +The dictionary entry for each defined name is partitioned into sections. +Except as explicitly indicated otherwise below, each section is +introduced by a label identifying that section. The omission of a +section implies that the section is either not applicable, or would +provide no interesting information. + + This section defines the significance of each potential section in a +dictionary entry. + +* Menu: + +* The "Affected By" Section of a Dictionary Entry:: +* The "Arguments" Section of a Dictionary Entry:: +* The "Arguments and Values" Section of a Dictionary Entry:: +* The "Binding Types Affected" Section of a Dictionary Entry:: +* The "Class Precedence List" Section of a Dictionary Entry:: +* Dictionary Entries for Type Specifiers:: +* The "Compound Type Specifier Kind" Section of a Dictionary Entry:: +* The "Compound Type Specifier Syntax" Section of a Dictionary Entry:: +* The "Compound Type Specifier Arguments" Section of a Dictionary Entry:: +* The "Compound Type Specifier Description" Section of a Dictionary Entry:: +* The "Constant Value" Section of a Dictionary Entry:: +* The "Description" Section of a Dictionary Entry:: +* The "Examples" Section of a Dictionary Entry:: +* The "Exceptional Situations" Section of a Dictionary Entry:: +* The "Initial Value" Section of a Dictionary Entry:: +* The "Argument Precedence Order" Section of a Dictionary Entry:: +* The "Method Signature" Section of a Dictionary Entry:: +* The "Name" Section of a Dictionary Entry:: +* The "Notes" Section of a Dictionary Entry:: +* The "Pronunciation" Section of a Dictionary Entry:: +* The "See Also" Section of a Dictionary Entry:: +* The "Side Effects" Section of a Dictionary Entry:: +* The "Supertypes" Section of a Dictionary Entry:: +* The "Syntax" Section of a Dictionary Entry:: +* Special "Syntax" Notations for Overloaded Operators:: +* Naming Conventions for Rest Parameters:: +* Requiring Non-Null Rest Parameters in The "Syntax" Section:: +* Return values in The "Syntax" Section:: +* No Arguments or Values in The "Syntax" Section:: +* Unconditional Transfer of Control in The "Syntax" Section:: +* The "Valid Context" Section of a Dictionary Entry:: +* The "Value Type" Section of a Dictionary Entry:: + + +File: gcl.info, Node: The "Affected By" Section of a Dictionary Entry, Next: The "Arguments" Section of a Dictionary Entry, Prev: Interpreting Dictionary Entries, Up: Interpreting Dictionary Entries + +1.4.4.1 The "Affected By" Section of a Dictionary Entry +....................................................... + +For an operator, anything that can affect the side effects of or values +returned by the operator. + + For a variable, anything that can affect the value of the variable +including functions that bind or assign it. + + +File: gcl.info, Node: The "Arguments" Section of a Dictionary Entry, Next: The "Arguments and Values" Section of a Dictionary Entry, Prev: The "Affected By" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.2 The "Arguments" Section of a Dictionary Entry +..................................................... + +This information describes the syntax information of entries such as +those for declarations and special expressions which are never evaluated +as forms, and so do not return values. + + +File: gcl.info, Node: The "Arguments and Values" Section of a Dictionary Entry, Next: The "Binding Types Affected" Section of a Dictionary Entry, Prev: The "Arguments" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.3 The "Arguments and Values" Section of a Dictionary Entry +................................................................ + +An English language description of what arguments the operator accepts +and what values it returns, including information about defaults for +parameters corresponding to omittable arguments (such as optional +parameters and keyword parameters). For special operators and macros, +their arguments are not evaluated unless it is explicitly stated in +their descriptions that they are evaluated. + + +File: gcl.info, Node: The "Binding Types Affected" Section of a Dictionary Entry, Next: The "Class Precedence List" Section of a Dictionary Entry, Prev: The "Arguments and Values" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.4 The "Binding Types Affected" Section of a Dictionary Entry +.................................................................. + +This information alerts the reader to the kinds of bindings that might +potentially be affected by a declaration. Whether in fact any +particular such binding is actually affected is dependent on additional +factors as well. See The "Description" Section of the declaration in +question for details. + + +File: gcl.info, Node: The "Class Precedence List" Section of a Dictionary Entry, Next: Dictionary Entries for Type Specifiers, Prev: The "Binding Types Affected" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.5 The "Class Precedence List" Section of a Dictionary Entry +................................................................. + +This appears in the dictionary entry for a class, and contains an +ordered list of the classes defined by Common Lisp that must be in the +class precedence list of this class. + + It is permissible for other (implementation-defined) classes to +appear in the implementation's class precedence list for the class. + + It is permissible for either standard-object or structure-object to +appear in the implementation's class precedence list; for details, see +*note Type Relationships::. + + Except as explicitly indicated otherwise somewhere in this +specification, no additional standardized classes may appear in the +implementation's class precedence list. + + By definition of the relationship between classes and types, the +classes listed in this section are also supertypes of the type denoted +by the class. + + +File: gcl.info, Node: Dictionary Entries for Type Specifiers, Next: The "Compound Type Specifier Kind" Section of a Dictionary Entry, Prev: The "Class Precedence List" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.6 Dictionary Entries for Type Specifiers +.............................................. + +The atomic type specifiers are those defined names listed in Figure~4-2. +Such dictionary entries are of kind "Class," "Condition Type," "System +Class," or "Type." A description of how to interpret a symbol naming +one of these types or classes as an atomic type specifier is found in +The "Description" Section of such dictionary entries. + + The compound type specifiers are those defined names listed in +Figure~4-3. Such dictionary entries are of kind "Class," "System +Class," "Type," or "Type Specifier." A description of how to interpret +as a compound type specifier a list whose car is such a symbol is found +in the "Compound Type Specifier Kind," "Compound Type Specifier Syntax," +"Compound Type Specifier Arguments," and "Compound Type Specifier +Description" sections of such dictionary entries. + + +File: gcl.info, Node: The "Compound Type Specifier Kind" Section of a Dictionary Entry, Next: The "Compound Type Specifier Syntax" Section of a Dictionary Entry, Prev: Dictionary Entries for Type Specifiers, Up: Interpreting Dictionary Entries + +1.4.4.7 The "Compound Type Specifier Kind" Section of a Dictionary Entry +........................................................................ + +An "abbreviating" type specifier is one that describes a subtype for +which it is in principle possible to enumerate the elements, but for +which in practice it is impractical to do so. + + A "specializing" type specifier is one that describes a subtype by +restricting the type of one or more components of the type, such as +element type or complex part type. + + A "predicating" type specifier is one that describes a subtype +containing only those objects that satisfy a given predicate. + + A "combining" type specifier is one that describes a subtype in a +compositional way, using combining operations (such as "and," "or," and +"not") on other types. + + +File: gcl.info, Node: The "Compound Type Specifier Syntax" Section of a Dictionary Entry, Next: The "Compound Type Specifier Arguments" Section of a Dictionary Entry, Prev: The "Compound Type Specifier Kind" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.8 The "Compound Type Specifier Syntax" Section of a Dictionary Entry +.......................................................................... + +This information about a type describes the syntax of a compound type +specifier for that type. + + Whether or not the type is acceptable as an atomic type specifier is +not represented here; see *note Dictionary Entries for Type +Specifiers::. + + +File: gcl.info, Node: The "Compound Type Specifier Arguments" Section of a Dictionary Entry, Next: The "Compound Type Specifier Description" Section of a Dictionary Entry, Prev: The "Compound Type Specifier Syntax" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.9 The "Compound Type Specifier Arguments" Section of a Dictionary Entry +............................................................................. + +This information describes type information for the structures defined +in The "Compound Type Specifier Syntax" Section. + + +File: gcl.info, Node: The "Compound Type Specifier Description" Section of a Dictionary Entry, Next: The "Constant Value" Section of a Dictionary Entry, Prev: The "Compound Type Specifier Arguments" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.10 The "Compound Type Specifier Description" Section of a Dictionary Entry +................................................................................ + +This information describes the meaning of the structures defined in The +"Compound Type Specifier Syntax" Section. + + +File: gcl.info, Node: The "Constant Value" Section of a Dictionary Entry, Next: The "Description" Section of a Dictionary Entry, Prev: The "Compound Type Specifier Description" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.11 The "Constant Value" Section of a Dictionary Entry +........................................................... + +This information describes the unchanging type and value of a constant +variable. + + +File: gcl.info, Node: The "Description" Section of a Dictionary Entry, Next: The "Examples" Section of a Dictionary Entry, Prev: The "Constant Value" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.12 The "Description" Section of a Dictionary Entry +........................................................ + +A summary of the operator and all intended aspects of the operator, but +does not necessarily include all the fields referenced below it ("Side +Effects," "Exceptional Situations," etc.) + + +File: gcl.info, Node: The "Examples" Section of a Dictionary Entry, Next: The "Exceptional Situations" Section of a Dictionary Entry, Prev: The "Description" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.13 The "Examples" Section of a Dictionary Entry +..................................................... + +Examples of use of the operator. These examples are not considered part +of the standard; see *note Sections Not Formally Part Of This +Standard::. + + +File: gcl.info, Node: The "Exceptional Situations" Section of a Dictionary Entry, Next: The "Initial Value" Section of a Dictionary Entry, Prev: The "Examples" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.14 The "Exceptional Situations" Section of a Dictionary Entry +................................................................... + +Three kinds of information may appear here: + +* + Situations that are detected by the function and formally signaled. +* + Situations that are handled by the function. +* + Situations that may be detected by the function. + + This field does not include conditions that could be signaled by +functions passed to and called by this operator as arguments or through +dynamic variables, nor by executing subforms of this operator if it is a +macro or special operator. + + +File: gcl.info, Node: The "Initial Value" Section of a Dictionary Entry, Next: The "Argument Precedence Order" Section of a Dictionary Entry, Prev: The "Exceptional Situations" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.15 The "Initial Value" Section of a Dictionary Entry +.......................................................... + +This information describes the initial value of a dynamic variable. +Since this variable might change, see type restrictions in The "Value +Type" Section. + + +File: gcl.info, Node: The "Argument Precedence Order" Section of a Dictionary Entry, Next: The "Method Signature" Section of a Dictionary Entry, Prev: The "Initial Value" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.16 The "Argument Precedence Order" Section of a Dictionary Entry +...................................................................... + +This information describes the argument precedence order. If it is +omitted, the argument precedence order is the default (left to right). + + +File: gcl.info, Node: The "Method Signature" Section of a Dictionary Entry, Next: The "Name" Section of a Dictionary Entry, Prev: The "Argument Precedence Order" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.17 The "Method Signature" Section of a Dictionary Entry +............................................................. + +The description of a generic function includes descriptions of the +methods that are defined on that generic function by the standard. A +method signature is used to describe the parameters and parameter +specializers for each method. Methods defined for the generic function +must be of the form described by the method signature. + + 'F' (x class) (y t) &optional z &key k + +This signature indicates that this method on the generic function F has +two required parameters: x, which must be a generalized instance of the +class class; and y, which can be any object (i.e., a generalized +instance of the class t). In addition, there is an optional parameter z +and a keyword parameter k. This signature also indicates that this +method on F is a primary method and has no qualifiers. + + For each parameter, the argument supplied must be in the intersection +of the type specified in the description of the corresponding generic +function and the type given in the signature of some method (including +not only those methods defined in this specification, but also +implementation-defined or user-defined methods in situations where the +definition of such methods is permitted). + + +File: gcl.info, Node: The "Name" Section of a Dictionary Entry, Next: The "Notes" Section of a Dictionary Entry, Prev: The "Method Signature" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.18 The "Name" Section of a Dictionary Entry +................................................. + +This section introduces the dictionary entry. It is not explicitly +labeled. It appears preceded and followed by a horizontal bar. + + In large print at left, the defined name appears; if more than one +defined name is to be described by the entry, all such names are shown +separated by commas. + + In somewhat smaller italic print at right is an indication of what +kind of dictionary entry this is. Possible values are: + +Accessor + This is an accessor function. + +Class + This is a class. + +Condition Type + This is a subtype of type condition. + +Constant Variable + This is a constant variable. + +Declaration + This is a declaration identifier. + +Function + This is a function. + +Local Function + This is a function that is defined only lexically within the scope + of some other macro form. + +Local Macro + This is a macro that is defined only lexically within the scope of + some other macro form. + +Macro + This is a macro. + +Restart + This is a restart. + +Special Operator + This is a special operator. + +Standard Generic Function + This is a standard generic function. + +Symbol + This is a symbol that is specially recognized in some particular + situation, such as the syntax of a macro. + +System Class + This is like class, but it identifies a class that is potentially a + built-in class. (No class is actually required to be a built-in + class.) + +Type + This is an atomic type specifier, and depending on information for + each particular entry, may subject to form other type specifiers. + +Type Specifier + This is a defined name that is not an atomic type specifier, but + that can be used in constructing valid type specifiers. + +Variable + This is a dynamic variable. + + +File: gcl.info, Node: The "Notes" Section of a Dictionary Entry, Next: The "Pronunciation" Section of a Dictionary Entry, Prev: The "Name" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.19 The "Notes" Section of a Dictionary Entry +.................................................. + +Information not found elsewhere in this description which pertains to +this operator. Among other things, this might include cross reference +information, code equivalences, stylistic hints, implementation hints, +typical uses. This information is not considered part of the standard; +any conforming implementation or conforming program is permitted to +ignore the presence of this information. + + +File: gcl.info, Node: The "Pronunciation" Section of a Dictionary Entry, Next: The "See Also" Section of a Dictionary Entry, Prev: The "Notes" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.20 The "Pronunciation" Section of a Dictionary Entry +.......................................................... + +This offers a suggested pronunciation for defined names so that people +not in verbal communication with the original designers can figure out +how to pronounce words that are not in normal English usage. This +information is advisory only, and is not considered part of the +standard. For brevity, it is only provided for entries with names that +are specific to Common Lisp and would not be found in Webster's Third +New International Dictionary the English Language, Unabridged. + + +File: gcl.info, Node: The "See Also" Section of a Dictionary Entry, Next: The "Side Effects" Section of a Dictionary Entry, Prev: The "Pronunciation" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.21 The "See Also" Section of a Dictionary Entry +..................................................... + +List of references to other parts of this standard that offer +information relevant to this operator. This list is not part of the +standard. + + +File: gcl.info, Node: The "Side Effects" Section of a Dictionary Entry, Next: The "Supertypes" Section of a Dictionary Entry, Prev: The "See Also" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.22 The "Side Effects" Section of a Dictionary Entry +......................................................... + +Anything that is changed as a result of the evaluation of the form +containing this operator. + + +File: gcl.info, Node: The "Supertypes" Section of a Dictionary Entry, Next: The "Syntax" Section of a Dictionary Entry, Prev: The "Side Effects" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.23 The "Supertypes" Section of a Dictionary Entry +....................................................... + +This appears in the dictionary entry for a type, and contains a list of +the standardized types that must be supertypes of this type. + + In implementations where there is a corresponding class, the order of +the classes in the class precedence list is consistent with the order +presented in this section. + + +File: gcl.info, Node: The "Syntax" Section of a Dictionary Entry, Next: Special "Syntax" Notations for Overloaded Operators, Prev: The "Supertypes" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.24 The "Syntax" Section of a Dictionary Entry +................................................... + +This section describes how to use the defined name in code. The +"Syntax" description for a generic function describes the lambda list of +the generic function itself, while The "Method Signatures" describe the +lambda lists of the defined methods. The "Syntax" description for an +ordinary function, a macro, or a special operator describes its +parameters. + + For example, an operator description might say: + + 'F' x y &optional z &key k + +This description indicates that the function F has two required +parameters, x and y. In addition, there is an optional parameter z and +a keyword parameter k. + + For macros and special operators, syntax is given in modified BNF +notation; see *note Modified BNF Syntax::. For functions a lambda list +is given. In both cases, however, the outermost parentheses are +omitted, and default value information is omitted. + + +File: gcl.info, Node: Special "Syntax" Notations for Overloaded Operators, Next: Naming Conventions for Rest Parameters, Prev: The "Syntax" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.25 Special "Syntax" Notations for Overloaded Operators +............................................................ + +If two descriptions exist for the same operation but with different +numbers of arguments, then the extra arguments are to be treated as +optional. For example, this pair of lines: + + 'file-position' stream => position + + 'file-position' stream position-spec => success-p + +is operationally equivalent to this line: + + 'file-position' stream &optional position-spec => result + +and differs only in that it provides on opportunity to introduce +different names for parameter and values for each case. The separated +(multi-line) notation is used when an operator is overloaded in such a +way that the parameters are used in different ways depending on how many +arguments are supplied (e.g., for the function /) or the return values +are different in the two cases (e.g., for the function file-position). + + +File: gcl.info, Node: Naming Conventions for Rest Parameters, Next: Requiring Non-Null Rest Parameters in The "Syntax" Section, Prev: Special "Syntax" Notations for Overloaded Operators, Up: Interpreting Dictionary Entries + +1.4.4.26 Naming Conventions for Rest Parameters +............................................... + +Within this specification, if the name of a rest parameter is chosen to +be a plural noun, use of that name in parameter font refers to the list +to which the rest parameter is bound. Use of the singular form of that +name in parameter font refers to an element of that list. + + For example, given a syntax description such as: + + 'F' &rest arguments + +it is appropriate to refer either to the rest parameter named arguments +by name, or to one of its elements by speaking of "an argument," "some +argument," "each argument" etc. + + +File: gcl.info, Node: Requiring Non-Null Rest Parameters in The "Syntax" Section, Next: Return values in The "Syntax" Section, Prev: Naming Conventions for Rest Parameters, Up: Interpreting Dictionary Entries + +1.4.4.27 Requiring Non-Null Rest Parameters in The "Syntax" Section +................................................................... + +In some cases it is useful to refer to all arguments equally as a single +aggregation using a rest parameter while at the same time requiring at +least one argument. A variety of imperative and declarative means are +available in code for expressing such a restriction, however they +generally do not manifest themselves in a lambda list. For descriptive +purposes within this specification, + + 'F' &rest arguments^+ + +means the same as + + 'F' &rest arguments + +but introduces the additional requirement that there be at least one +argument. + + +File: gcl.info, Node: Return values in The "Syntax" Section, Next: No Arguments or Values in The "Syntax" Section, Prev: Requiring Non-Null Rest Parameters in The "Syntax" Section, Up: Interpreting Dictionary Entries + +1.4.4.28 Return values in The "Syntax" Section +.............................................. + +An evaluation arrow "=>" precedes a list of values to be returned. For +example: + + 'F' a b c => x + +indicates that F is an operator that has three required parameters +(i.e., a, b, and c) and that returns one value (i.e., x). If more than +one value is returned by an operator, the names of the values are +separated by commas, as in: + + 'F' a b c => x, y, z + + +File: gcl.info, Node: No Arguments or Values in The "Syntax" Section, Next: Unconditional Transfer of Control in The "Syntax" Section, Prev: Return values in The "Syntax" Section, Up: Interpreting Dictionary Entries + +1.4.4.29 No Arguments or Values in The "Syntax" Section +....................................................... + +If no arguments are permitted, or no values are returned, a special +notation is used to make this more visually apparent. For example, + + 'F' => + + indicates that F is an operator that accepts no arguments and returns +no values. + + +File: gcl.info, Node: Unconditional Transfer of Control in The "Syntax" Section, Next: The "Valid Context" Section of a Dictionary Entry, Prev: No Arguments or Values in The "Syntax" Section, Up: Interpreting Dictionary Entries + +1.4.4.30 Unconditional Transfer of Control in The "Syntax" Section +.................................................................. + +Some operators perform an unconditional transfer of control, and so +never have any return values. Such operators are notated using a +notation such as the following: + + 'F' a b c => # + + +File: gcl.info, Node: The "Valid Context" Section of a Dictionary Entry, Next: The "Value Type" Section of a Dictionary Entry, Prev: Unconditional Transfer of Control in The "Syntax" Section, Up: Interpreting Dictionary Entries + +1.4.4.31 The "Valid Context" Section of a Dictionary Entry +.......................................................... + +This information is used by dictionary entries such as "Declarations" in +order to restrict the context in which the declaration may appear. + + A given "Declaration" might appear in a declaration (i.e., a declare +expression), a proclamation (i.e., a declaim or proclaim form), or both. + + +File: gcl.info, Node: The "Value Type" Section of a Dictionary Entry, Prev: The "Valid Context" Section of a Dictionary Entry, Up: Interpreting Dictionary Entries + +1.4.4.32 The "Value Type" Section of a Dictionary Entry +....................................................... + +This information describes any type restrictions on a dynamic variable. + + +File: gcl.info, Node: Conformance, Next: Language Extensions, Prev: Definitions, Up: Introduction (Introduction) + +1.5 Conformance +=============== + +This standard presents the syntax and semantics to be implemented by a +conforming implementation (and its accompanying documentation). In +addition, it imposes requirements on conforming programs. + +* Menu: + +* Conforming Implementations:: +* Conforming Programs:: + + +File: gcl.info, Node: Conforming Implementations, Next: Conforming Programs, Prev: Conformance, Up: Conformance + +1.5.1 Conforming Implementations +-------------------------------- + +A conforming implementation shall adhere to the requirements outlined in +this section. + +* Menu: + +* Required Language Features:: +* Documentation of Implementation-Dependent Features:: +* Documentation of Extensions:: +* Treatment of Exceptional Situations:: +* Resolution of Apparent Conflicts in Exceptional Situations:: +* Examples of Resolution of Apparent Conflict in Exceptional Situations:: +* Conformance Statement:: + + +File: gcl.info, Node: Required Language Features, Next: Documentation of Implementation-Dependent Features, Prev: Conforming Implementations, Up: Conforming Implementations + +1.5.1.1 Required Language Features +.................................. + +A conforming implementation shall accept all features (including +deprecated features) of the language specified in this standard, with +the meanings defined in this standard. + + A conforming implementation shall not require the inclusion of +substitute or additional language elements in code in order to +accomplish a feature of the language that is specified in this standard. + + +File: gcl.info, Node: Documentation of Implementation-Dependent Features, Next: Documentation of Extensions, Prev: Required Language Features, Up: Conforming Implementations + +1.5.1.2 Documentation of Implementation-Dependent Features +.......................................................... + +A conforming implementation shall be accompanied by a document that +provides a definition of all implementation-defined aspects of the +language defined by this specification. + + In addition, a conforming implementation is encouraged (but not +required) to document items in this standard that are identified as +implementation-dependent, although in some cases such documentation +might simply identify the item as "undefined." + + +File: gcl.info, Node: Documentation of Extensions, Next: Treatment of Exceptional Situations, Prev: Documentation of Implementation-Dependent Features, Up: Conforming Implementations + +1.5.1.3 Documentation of Extensions +................................... + +A conforming implementation shall be accompanied by a document that +separately describes any features accepted by the implementation that +are not specified in this standard, but that do not cause any ambiguity +or contradiction when added to the language standard. Such extensions +shall be described as being "extensions to Common Lisp as specified by +ANSI <>." + + +File: gcl.info, Node: Treatment of Exceptional Situations, Next: Resolution of Apparent Conflicts in Exceptional Situations, Prev: Documentation of Extensions, Up: Conforming Implementations + +1.5.1.4 Treatment of Exceptional Situations +........................................... + +A conforming implementation shall treat exceptional situations in a +manner consistent with this specification. + + +File: gcl.info, Node: Resolution of Apparent Conflicts in Exceptional Situations, Next: Examples of Resolution of Apparent Conflict in Exceptional Situations, Prev: Treatment of Exceptional Situations, Up: Conforming Implementations + +1.5.1.5 Resolution of Apparent Conflicts in Exceptional Situations +.................................................................. + +If more than one passage in this specification appears to apply to the +same situation but in conflicting ways, the passage that appears to +describe the situation in the most specific way (not necessarily the +passage that provides the most constrained kind of error detection) +takes precedence. + + +File: gcl.info, Node: Examples of Resolution of Apparent Conflict in Exceptional Situations, Next: Conformance Statement, Prev: Resolution of Apparent Conflicts in Exceptional Situations, Up: Conforming Implementations + +1.5.1.6 Examples of Resolution of Apparent Conflict in Exceptional Situations +............................................................................. + +Suppose that function foo is a member of a set S of functions that +operate on numbers. Suppose that one passage states that an error must +be signaled if any function in S is ever given an argument of 17. +Suppose that an apparently conflicting passage states that the +consequences are undefined if foo receives an argument of 17. Then the +second passage (the one specifically about foo) would dominate because +the description of the situational context is the most specific, and it +would not be required that foo signal an error on an argument of 17 even +though other functions in the set S would be required to do so. + + +File: gcl.info, Node: Conformance Statement, Prev: Examples of Resolution of Apparent Conflict in Exceptional Situations, Up: Conforming Implementations + +1.5.1.7 Conformance Statement +............................. + +A conforming implementation shall produce a conformance statement as a +consequence of using the implementation, or that statement shall be +included in the accompanying documentation. If the implementation +conforms in all respects with this standard, the conformance statement +shall be + + "<> conforms with the requirements of ANSI + <>" + + If the implementation conforms with some but not all of the +requirements of this standard, then the conformance statement shall be + + "<> conforms with the requirements of ANSI + <> with the following exceptions: <>." + + +File: gcl.info, Node: Conforming Programs, Prev: Conforming Implementations, Up: Conformance + +1.5.2 Conforming Programs +------------------------- + +Code conforming with the requirements of this standard shall adhere to +the following: + +1. + Conforming code shall use only those features of the language + syntax and semantics that are either specified in this standard or + defined using the extension mechanisms specified in the standard. + +2. + Conforming code shall not rely on any particular interpretation of + implementation-dependent features. + +3. + Conforming code shall not depend on the consequences of undefined + or unspecified situations. + +4. + Conforming code does not use any constructions that are prohibited + by the standard. + +5. + Conforming code does not depend on extensions included in an + implementation. + +* Menu: + +* Use of Implementation-Defined Language Features:: +* Use of Read-Time Conditionals:: + + +File: gcl.info, Node: Use of Implementation-Defined Language Features, Next: Use of Read-Time Conditionals, Prev: Conforming Programs, Up: Conforming Programs + +1.5.2.1 Use of Implementation-Defined Language Features +....................................................... + +Note that conforming code may rely on particular implementation-defined +values or features. Also note that the requirements for conforming code +and conforming implementations do not require that the results produced +by conforming code always be the same when processed by a conforming +implementation. The results may be the same, or they may differ. + + Portable code is written using only standard characters. + + Conforming code may run in all conforming implementations, but might +have allowable implementation-defined behavior that makes it +non-portable code. For example, the following are examples of forms +that are conforming, but that might return different values in different +implementations: + + (evenp most-positive-fixnum) => implementation-dependent + (random) => implementation-dependent + (> lambda-parameters-limit 93) => implementation-dependent + (char-name #\A) => implementation-dependent + + +File: gcl.info, Node: Use of Read-Time Conditionals, Prev: Use of Implementation-Defined Language Features, Up: Conforming Programs + +1.5.2.2 Use of Read-Time Conditionals +..................................... + +Use of #+ and #- does not automatically disqualify a program from being +conforming. A program which uses #+ and #- is considered conforming if +there is no set of features in which the program would not be +conforming. Of course, conforming programs are not necessarily working +programs. The following program is conforming: + + (defun foo () + #+ACME (acme:initialize-something) + (print 'hello-there)) + + However, this program might or might not work, depending on whether +the presence of the feature ACME really implies that a function named +acme:initialize-something is present in the environment. In effect, +using #+ or #- in a conforming program means that the variable +*features* + + becomes just one more piece of input data to that program. Like any +other data coming into a program, the programmer is responsible for +assuring that the program does not make unwarranted assumptions on the +basis of input data. + + +File: gcl.info, Node: Language Extensions, Next: Language Subsets, Prev: Conformance, Up: Introduction (Introduction) + +1.6 Language Extensions +======================= + +A language extension is any documented implementation-defined behavior +of a defined name in this standard that varies from the behavior +described in this standard, or a documented consequence of a situation +that the standard specifies as undefined, unspecified, or extendable by +the implementation. For example, if this standard says that "the +results are unspecified," an extension would be to specify the results. + + [Reviewer Note by Barmar: This contradicts previous definitions of +conforming code.] If the correct behavior of a program depends on the +results provided by an extension, only implementations with the same +extension will execute the program correctly. Note that such a program +might be non-conforming. Also, if this standard says that "an +implementation may be extended," a conforming, but possibly +non-portable, program can be written using an extension. + + An implementation can have extensions, provided they do not alter the +behavior of conforming code and provided they are not explicitly +prohibited by this standard. + + The term "extension" refers only to extensions available upon +startup. An implementation is free to allow or prohibit redefinition of +an extension. + + The following list contains specific guidance to implementations +concerning certain types of extensions. + +Extra return values + + An implementation must return exactly the number of return values + specified by this standard unless the standard specifically + indicates otherwise. + +Unsolicited messages + + No output can be produced by a function other than that specified + in the standard or due to the signaling of conditions detected by + the function. + + Unsolicited output, such as garbage collection notifications and + autoload heralds, should not go directly to the stream that is the + value of a stream variable defined in this standard, but can go + indirectly to terminal I/O by using a synonym stream to + *terminal-io*. + + Progress reports from such functions as load and compile are + considered solicited, and are not covered by this prohibition. + +Implementation of macros and special forms + + Macros and special operators defined in this standard must not be + functions. + + +File: gcl.info, Node: Language Subsets, Next: Deprecated Language Features, Prev: Language Extensions, Up: Introduction (Introduction) + +1.7 Language Subsets +==================== + +The language described in this standard contains no subsets, though +subsets are not forbidden. + + For a language to be considered a subset, it must have the property +that any valid program in that language has equivalent semantics and +will run directly (with no extralingual pre-processing, and no special +compatibility packages) in any conforming implementation of the full +language. + + A language that conforms to this requirement shall be described as +being a "subset of Common Lisp as specified by ANSI <>." + + +File: gcl.info, Node: Deprecated Language Features, Next: Symbols in the COMMON-LISP Package, Prev: Language Subsets, Up: Introduction (Introduction) + +1.8 Deprecated Language Features +================================ + +Deprecated language features are not expected to appear in future Common +Lisp standards, but are required to be implemented for conformance with +this standard; see *note Required Language Features::. + + Conforming programs can use deprecated features; however, it is +considered good programming style to avoid them. It is permissible for +the compiler to produce style warnings about the use of such features at +compile time, but there should be no such warnings at program execution +time. + +* Menu: + +* Deprecated Functions:: +* Deprecated Argument Conventions:: +* Deprecated Variables:: +* Deprecated Reader Syntax:: + + +File: gcl.info, Node: Deprecated Functions, Next: Deprecated Argument Conventions, Prev: Deprecated Language Features, Up: Deprecated Language Features + +1.8.1 Deprecated Functions +-------------------------- + +The functions in Figure 1-2 are deprecated. + assoc-if-not nsubst-if-not require + count-if-not nsubstitute-if-not set + delete-if-not position-if-not subst-if-not + find-if-not provide substitute-if-not + gentemp rassoc-if-not + member-if-not remove-if-not + + Figure 1-2: Deprecated Functions + + + +File: gcl.info, Node: Deprecated Argument Conventions, Next: Deprecated Variables, Prev: Deprecated Functions, Up: Deprecated Language Features + +1.8.2 Deprecated Argument Conventions +------------------------------------- + +The ability to pass a numeric argument to gensym has been deprecated. + + The :test-not argument to the functions in Figure 1-3 are deprecated. + + adjoin nset-difference search + assoc nset-exclusive-or set-difference + count nsublis set-exclusive-or + delete nsubst sublis + delete-duplicates nsubstitute subsetp + find nunion subst + intersection position substitute + member rassoc tree-equal + mismatch remove union + nintersection remove-duplicates + + Figure 1-3: Functions with Deprecated :TEST-NOT Arguments + + + The use of the situation names compile, load, and eval in eval-when +is deprecated. + + +File: gcl.info, Node: Deprecated Variables, Next: Deprecated Reader Syntax, Prev: Deprecated Argument Conventions, Up: Deprecated Language Features + +1.8.3 Deprecated Variables +-------------------------- + +The variable *modules* is deprecated. + + +File: gcl.info, Node: Deprecated Reader Syntax, Prev: Deprecated Variables, Up: Deprecated Language Features + +1.8.4 Deprecated Reader Syntax +------------------------------ + +The #S reader macro forces keyword names into the KEYWORD package; see +*note Sharpsign S::. This feature is deprecated; in the future, keyword +names will be taken in the package they are read in, so symbols that are +actually in the KEYWORD package should be used if that is what is +desired. + + +File: gcl.info, Node: Symbols in the COMMON-LISP Package, Prev: Deprecated Language Features, Up: Introduction (Introduction) + +1.9 Symbols in the COMMON-LISP Package +====================================== + +The figures on the next twelve pages contain a complete enumeration of +the 978 external symbols in the COMMON-LISP package. + + &allow-other-keys *print-miser-width* + &aux *print-pprint-dispatch* + &body *print-pretty* + &environment *print-radix* + &key *print-readably* + &optional *print-right-margin* + &rest *query-io* + &whole *random-state* + * *read-base* + ** *read-default-float-format* + *** *read-eval* + *break-on-signals* *read-suppress* + *compile-file-pathname* *readtable* + *compile-file-truename* *standard-input* + *compile-print* *standard-output* + *compile-verbose* *terminal-io* + *debug-io* *trace-output* + *debugger-hook* + + *default-pathname-defaults* ++ + *error-output* +++ + *features* - + *gensym-counter* / + *load-pathname* // + *load-print* /// + *load-truename* /= + *load-verbose* 1+ + *macroexpand-hook* 1- + *modules* < + *package* <= + *print-array* = + *print-base* > + *print-case* >= + *print-circle* abort + *print-escape* abs + *print-gensym* acons + *print-length* acos + *print-level* acosh + *print-lines* add-method + + Figure 1-4: Symbols in the COMMON-LISP package (part one of twelve). + + + adjoin atom boundp + adjust-array base-char break + adjustable-array-p base-string broadcast-stream + allocate-instance bignum broadcast-stream-streams + alpha-char-p bit built-in-class + alphanumericp bit-and butlast + and bit-andc1 byte + append bit-andc2 byte-position + apply bit-eqv byte-size + apropos bit-ior caaaar + apropos-list bit-nand caaadr + aref bit-nor caaar + arithmetic-error bit-not caadar + arithmetic-error-operands bit-orc1 caaddr + arithmetic-error-operation bit-orc2 caadr + array bit-vector caar + array-dimension bit-vector-p cadaar + array-dimension-limit bit-xor cadadr + array-dimensions block cadar + array-displacement boole caddar + array-element-type boole-1 cadddr + array-has-fill-pointer-p boole-2 caddr + array-in-bounds-p boole-and cadr + array-rank boole-andc1 call-arguments-limit + array-rank-limit boole-andc2 call-method + array-row-major-index boole-c1 call-next-method + array-total-size boole-c2 car + array-total-size-limit boole-clr case + arrayp boole-eqv catch + ash boole-ior ccase + asin boole-nand cdaaar + asinh boole-nor cdaadr + assert boole-orc1 cdaar + assoc boole-orc2 cdadar + assoc-if boole-set cdaddr + assoc-if-not boole-xor cdadr + atan boolean cdar + atanh both-case-p cddaar + + Figure 1-5: Symbols in the COMMON-LISP package (part two of twelve). + + + cddadr clear-input copy-tree + cddar clear-output cos + cdddar close cosh + cddddr clrhash count + cdddr code-char count-if + cddr coerce count-if-not + cdr compilation-speed ctypecase + ceiling compile debug + cell-error compile-file decf + cell-error-name compile-file-pathname declaim + cerror compiled-function declaration + change-class compiled-function-p declare + char compiler-macro decode-float + char-code compiler-macro-function decode-universal-time + char-code-limit complement defclass + char-downcase complex defconstant + char-equal complexp defgeneric + char-greaterp compute-applicable-methods define-compiler-macro + char-int compute-restarts define-condition + char-lessp concatenate define-method-combination + char-name concatenated-stream define-modify-macro + char-not-equal concatenated-stream-streams define-setf-expander + char-not-greaterp cond define-symbol-macro + char-not-lessp condition defmacro + char-upcase conjugate defmethod + char/= cons defpackage + char< consp defparameter + char<= constantly defsetf + char= constantp defstruct + char> continue deftype + char>= control-error defun + character copy-alist defvar + characterp copy-list delete + check-type copy-pprint-dispatch delete-duplicates + cis copy-readtable delete-file + class copy-seq delete-if + class-name copy-structure delete-if-not + class-of copy-symbol delete-package + + Figure 1-6: Symbols in the COMMON-LISP package (part three of twelve). + + + denominator eq + deposit-field eql + describe equal + describe-object equalp + destructuring-bind error + digit-char etypecase + digit-char-p eval + directory eval-when + directory-namestring evenp + disassemble every + division-by-zero exp + do export + do* expt + do-all-symbols extended-char + do-external-symbols fboundp + do-symbols fceiling + documentation fdefinition + dolist ffloor + dotimes fifth + double-float file-author + double-float-epsilon file-error + double-float-negative-epsilon file-error-pathname + dpb file-length + dribble file-namestring + dynamic-extent file-position + ecase file-stream + echo-stream file-string-length + echo-stream-input-stream file-write-date + echo-stream-output-stream fill + ed fill-pointer + eighth find + elt find-all-symbols + encode-universal-time find-class + end-of-file find-if + endp find-if-not + enough-namestring find-method + ensure-directories-exist find-package + ensure-generic-function find-restart + + Figure 1-7: Symbols in the COMMON-LISP package (part four of twelve). + + + find-symbol get-internal-run-time + finish-output get-macro-character + first get-output-stream-string + fixnum get-properties + flet get-setf-expansion + float get-universal-time + float-digits getf + float-precision gethash + float-radix go + float-sign graphic-char-p + floating-point-inexact handler-bind + floating-point-invalid-operation handler-case + floating-point-overflow hash-table + floating-point-underflow hash-table-count + floatp hash-table-p + floor hash-table-rehash-size + fmakunbound hash-table-rehash-threshold + force-output hash-table-size + format hash-table-test + formatter host-namestring + fourth identity + fresh-line if + fround ignorable + ftruncate ignore + ftype ignore-errors + funcall imagpart + function import + function-keywords in-package + function-lambda-expression incf + functionp initialize-instance + gcd inline + generic-function input-stream-p + gensym inspect + gentemp integer + get integer-decode-float + get-decoded-time integer-length + get-dispatch-macro-character integerp + get-internal-real-time interactive-stream-p + + Figure 1-8: Symbols in the COMMON-LISP package (part five of twelve). + + + intern lisp-implementation-type + internal-time-units-per-second lisp-implementation-version + intersection list + invalid-method-error list* + invoke-debugger list-all-packages + invoke-restart list-length + invoke-restart-interactively listen + isqrt listp + keyword load + keywordp load-logical-pathname-translations + labels load-time-value + lambda locally + lambda-list-keywords log + lambda-parameters-limit logand + last logandc1 + lcm logandc2 + ldb logbitp + ldb-test logcount + ldiff logeqv + least-negative-double-float logical-pathname + least-negative-long-float logical-pathname-translations + least-negative-normalized-double-float logior + least-negative-normalized-long-float lognand + least-negative-normalized-short-float lognor + least-negative-normalized-single-float lognot + least-negative-short-float logorc1 + least-negative-single-float logorc2 + least-positive-double-float logtest + least-positive-long-float logxor + least-positive-normalized-double-float long-float + least-positive-normalized-long-float long-float-epsilon + least-positive-normalized-short-float long-float-negative-epsilon + least-positive-normalized-single-float long-site-name + least-positive-short-float loop + least-positive-single-float loop-finish + length lower-case-p + let machine-instance + let* machine-type + + Figure 1-9: Symbols in the COMMON-LISP package (part six of twelve). + + + machine-version mask-field + macro-function max + macroexpand member + macroexpand-1 member-if + macrolet member-if-not + make-array merge + make-broadcast-stream merge-pathnames + make-concatenated-stream method + make-condition method-combination + make-dispatch-macro-character method-combination-error + make-echo-stream method-qualifiers + make-hash-table min + make-instance minusp + make-instances-obsolete mismatch + make-list mod + make-load-form most-negative-double-float + make-load-form-saving-slots most-negative-fixnum + make-method most-negative-long-float + make-package most-negative-short-float + make-pathname most-negative-single-float + make-random-state most-positive-double-float + make-sequence most-positive-fixnum + make-string most-positive-long-float + make-string-input-stream most-positive-short-float + make-string-output-stream most-positive-single-float + make-symbol muffle-warning + make-synonym-stream multiple-value-bind + make-two-way-stream multiple-value-call + makunbound multiple-value-list + map multiple-value-prog1 + map-into multiple-value-setq + mapc multiple-values-limit + mapcan name-char + mapcar namestring + mapcon nbutlast + maphash nconc + mapl next-method-p + maplist nil + + Figure 1-10: Symbols in the COMMON-LISP package (part seven of twelve). + + + nintersection package-error + ninth package-error-package + no-applicable-method package-name + no-next-method package-nicknames + not package-shadowing-symbols + notany package-use-list + notevery package-used-by-list + notinline packagep + nreconc pairlis + nreverse parse-error + nset-difference parse-integer + nset-exclusive-or parse-namestring + nstring-capitalize pathname + nstring-downcase pathname-device + nstring-upcase pathname-directory + nsublis pathname-host + nsubst pathname-match-p + nsubst-if pathname-name + nsubst-if-not pathname-type + nsubstitute pathname-version + nsubstitute-if pathnamep + nsubstitute-if-not peek-char + nth phase + nth-value pi + nthcdr plusp + null pop + number position + numberp position-if + numerator position-if-not + nunion pprint + oddp pprint-dispatch + open pprint-exit-if-list-exhausted + open-stream-p pprint-fill + optimize pprint-indent + or pprint-linear + otherwise pprint-logical-block + output-stream-p pprint-newline + package pprint-pop + + Figure 1-11: Symbols in the COMMON-LISP package (part eight of twelve). + + + pprint-tab read-char + pprint-tabular read-char-no-hang + prin1 read-delimited-list + prin1-to-string read-from-string + princ read-line + princ-to-string read-preserving-whitespace + print read-sequence + print-not-readable reader-error + print-not-readable-object readtable + print-object readtable-case + print-unreadable-object readtablep + probe-file real + proclaim realp + prog realpart + prog* reduce + prog1 reinitialize-instance + prog2 rem + progn remf + program-error remhash + progv remove + provide remove-duplicates + psetf remove-if + psetq remove-if-not + push remove-method + pushnew remprop + quote rename-file + random rename-package + random-state replace + random-state-p require + rassoc rest + rassoc-if restart + rassoc-if-not restart-bind + ratio restart-case + rational restart-name + rationalize return + rationalp return-from + read revappend + read-byte reverse + + Figure 1-12: Symbols in the COMMON-LISP package (part nine of twelve). + + + room simple-bit-vector + rotatef simple-bit-vector-p + round simple-condition + row-major-aref simple-condition-format-arguments + rplaca simple-condition-format-control + rplacd simple-error + safety simple-string + satisfies simple-string-p + sbit simple-type-error + scale-float simple-vector + schar simple-vector-p + search simple-warning + second sin + sequence single-float + serious-condition single-float-epsilon + set single-float-negative-epsilon + set-difference sinh + set-dispatch-macro-character sixth + set-exclusive-or sleep + set-macro-character slot-boundp + set-pprint-dispatch slot-exists-p + set-syntax-from-char slot-makunbound + setf slot-missing + setq slot-unbound + seventh slot-value + shadow software-type + shadowing-import software-version + shared-initialize some + shiftf sort + short-float space + short-float-epsilon special + short-float-negative-epsilon special-operator-p + short-site-name speed + signal sqrt + signed-byte stable-sort + signum standard + simple-array standard-char + simple-base-string standard-char-p + + Figure 1-13: Symbols in the COMMON-LISP package (part ten of twelve). + + + standard-class sublis + standard-generic-function subseq + standard-method subsetp + standard-object subst + step subst-if + storage-condition subst-if-not + store-value substitute + stream substitute-if + stream-element-type substitute-if-not + stream-error subtypep + stream-error-stream svref + stream-external-format sxhash + streamp symbol + string symbol-function + string-capitalize symbol-macrolet + string-downcase symbol-name + string-equal symbol-package + string-greaterp symbol-plist + string-left-trim symbol-value + string-lessp symbolp + string-not-equal synonym-stream + string-not-greaterp synonym-stream-symbol + string-not-lessp t + string-right-trim tagbody + string-stream tailp + string-trim tan + string-upcase tanh + string/= tenth + string< terpri + string<= the + string= third + string> throw + string>= time + stringp trace + structure translate-logical-pathname + structure-class translate-pathname + structure-object tree-equal + style-warning truename + + Figure 1-14: Symbols in the COMMON-LISP package (part eleven of twelve). + + + truncate values-list + two-way-stream variable + two-way-stream-input-stream vector + two-way-stream-output-stream vector-pop + type vector-push + type-error vector-push-extend + type-error-datum vectorp + type-error-expected-type warn + type-of warning + typecase when + typep wild-pathname-p + unbound-slot with-accessors + unbound-slot-instance with-compilation-unit + unbound-variable with-condition-restarts + undefined-function with-hash-table-iterator + unexport with-input-from-string + unintern with-open-file + union with-open-stream + unless with-output-to-string + unread-char with-package-iterator + unsigned-byte with-simple-restart + untrace with-slots + unuse-package with-standard-io-syntax + unwind-protect write + update-instance-for-different-class write-byte + update-instance-for-redefined-class write-char + upgraded-array-element-type write-line + upgraded-complex-part-type write-sequence + upper-case-p write-string + use-package write-to-string + use-value y-or-n-p + user-homedir-pathname yes-or-no-p + values zerop + + Figure 1-15: Symbols in the COMMON-LISP package (part twelve of twelve). + + + +File: gcl.info, Node: Syntax, Next: Evaluation and Compilation, Prev: Introduction (Introduction), Up: Top + +2 Syntax +******** + +* Menu: + +* Character Syntax:: +* Reader Algorithm:: +* Interpretation of Tokens:: +* Standard Macro Characters:: + + +File: gcl.info, Node: Character Syntax, Next: Reader Algorithm, Prev: Syntax, Up: Syntax + +2.1 Character Syntax +==================== + +The Lisp reader takes characters from a stream, interprets them as a +printed representation of an object, constructs that object, and returns +it. + + The syntax described by this chapter is called the standard syntax . +Operations are provided by Common Lisp so that various aspects of the +syntax information represented by a readtable can be modified under +program control; see *note Reader::. Except as explicitly stated +otherwise, the syntax used throughout this document is standard syntax. + +* Menu: + +* Readtables:: +* Variables that affect the Lisp Reader:: +* Standard Characters:: +* Character Syntax Types:: + + +File: gcl.info, Node: Readtables, Next: Variables that affect the Lisp Reader, Prev: Character Syntax, Up: Character Syntax + +2.1.1 Readtables +---------------- + +Syntax information for use by the Lisp reader is embodied in an object +called a readtable . Among other things, the readtable contains the +association between characters and syntax types. + + Figure 2-1 lists some defined names that are applicable to +readtables. + + *readtable* readtable-case + copy-readtable readtablep + get-dispatch-macro-character set-dispatch-macro-character + get-macro-character set-macro-character + make-dispatch-macro-character set-syntax-from-char + + Figure 2-1: Readtable defined names + + +* Menu: + +* The Current Readtable:: +* The Standard Readtable:: +* The Initial Readtable:: + + +File: gcl.info, Node: The Current Readtable, Next: The Standard Readtable, Prev: Readtables, Up: Readtables + +2.1.1.1 The Current Readtable +............................. + +Several readtables describing different syntaxes can exist, but at any +given time only one, called the current readtable , affects the way in +which expressions_2 are parsed into objects by the Lisp reader. The +current readtable in a given dynamic environment is the value of +*readtable* in that environment. To make a different readtable become +the current readtable, *readtable* can be assigned or bound. + + +File: gcl.info, Node: The Standard Readtable, Next: The Initial Readtable, Prev: The Current Readtable, Up: Readtables + +2.1.1.2 The Standard Readtable +.............................. + +The standard readtable conforms to standard syntax. The consequences +are undefined if an attempt is made to modify the standard readtable. +To achieve the effect of altering or extending standard syntax, a copy +of the standard readtable can be created; see the function +copy-readtable. + + The readtable case of the standard readtable is :upcase. + + +File: gcl.info, Node: The Initial Readtable, Prev: The Standard Readtable, Up: Readtables + +2.1.1.3 The Initial Readtable +............................. + +The initial readtable is the readtable that is the current readtable at +the time when the Lisp image starts. At that time, it conforms to +standard syntax. The initial readtable is distinct from the standard +readtable. It is permissible for a conforming program to modify the +initial readtable. + + +File: gcl.info, Node: Variables that affect the Lisp Reader, Next: Standard Characters, Prev: Readtables, Up: Character Syntax + +2.1.2 Variables that affect the Lisp Reader +------------------------------------------- + +The Lisp reader is influenced not only by the current readtable, but +also by various dynamic variables. Figure 2-2 lists the variables that +influence the behavior of the Lisp reader. + + *package* *read-default-float-format* *readtable* + *read-base* *read-suppress* + + Figure 2-2: Variables that influence the Lisp reader. + + + +File: gcl.info, Node: Standard Characters, Next: Character Syntax Types, Prev: Variables that affect the Lisp Reader, Up: Character Syntax + +2.1.3 Standard Characters +------------------------- + +All implementations must support a character repertoire called +standard-char; characters that are members of that repertoire are called +standard characters . + + The standard-char repertoire consists of the non-graphic character +newline, the graphic character space, and the following additional +ninety-four graphic characters or their equivalents: + + Graphic ID Glyph Description Graphic ID Glyph Description + LA01 a small a LN01 n small n + LA02 A capital A LN02 N capital N + LB01 b small b LO01 o small o + LB02 B capital B LO02 O capital O + LC01 c small c LP01 p small p + LC02 C capital C LP02 P capital P + LD01 d small d LQ01 q small q + LD02 D capital D LQ02 Q capital Q + LE01 e small e LR01 r small r + LE02 E capital E LR02 R capital R + LF01 f small f LS01 s small s + LF02 F capital F LS02 S capital S + LG01 g small g LT01 t small t + LG02 G capital G LT02 T capital T + LH01 h small h LU01 u small u + LH02 H capital H LU02 U capital U + LI01 i small i LV01 v small v + LI02 I capital I LV02 V capital V + LJ01 j small j LW01 w small w + LJ02 J capital J LW02 W capital W + LK01 k small k LX01 x small x + LK02 K capital K LX02 X capital X + LL01 l small l LY01 y small y + LL02 L capital L LY02 Y capital Y + LM01 m small m LZ01 z small z + LM02 M capital M LZ02 Z capital Z + + Figure 2-3: Standard Character Subrepertoire (Part 1 of 3: Latin Characters) + + + Graphic ID Glyph Description Graphic ID Glyph Description + ND01 1 digit 1 ND06 6 digit 6 + ND02 2 digit 2 ND07 7 digit 7 + ND03 3 digit 3 ND08 8 digit 8 + ND04 4 digit 4 ND09 9 digit 9 + ND05 5 digit 5 ND10 0 digit 0 + + Figure 2-4: Standard Character Subrepertoire (Part 2 of 3: Numeric Characters) + + + Graphic ID Glyph Description + SP02 ! exclamation mark + SC03 $ dollar sign + SP04 " quotation mark, or double quote + SP05 ' apostrophe, or [single] quote + SP06 ( left parenthesis, or open parenthesis + SP07 ) right parenthesis, or close parenthesis + SP08 , comma + SP09 _ low line, or underscore + SP10 - hyphen, or minus [sign] + SP11 . full stop, period, or dot + SP12 / solidus, or slash + SP13 : colon + SP14 ; semicolon + SP15 ? question mark + SA01 + plus [sign] + SA03 < less-than [sign] + SA04 = equals [sign] + SA05 > greater-than [sign] + SM01 # number sign, or sharp[sign] + SM02 % percent [sign] + SM03 & ampersand + SM04 * asterisk, or star + SM05 @ commercial at, or at-sign + SM06 [ left [square] bracket + SM07 \ reverse solidus, or backslash + SM08 ] right [square] bracket + SM11 { left curly bracket, or left brace + SM13 | vertical bar + SM14 } right curly bracket, or right brace + SD13 ` grave accent, or backquote + SD15 ^ circumflex accent + SD19 ~ tilde + + Figure 2-5: Standard Character Subrepertoire (Part 3 of 3: Special Characters) + + + The graphic IDs are not used within Common Lisp, but are provided for +cross reference purposes with ISO 6937/2. Note that the first letter of +the graphic ID categorizes the character as follows: L--Latin, +N--Numeric, S--Special. + + +File: gcl.info, Node: Character Syntax Types, Prev: Standard Characters, Up: Character Syntax + +2.1.4 Character Syntax Types +---------------------------- + +The Lisp reader constructs an object from the input text by interpreting +each character according to its syntax type. The Lisp reader cannot +accept as input everything that the Lisp printer produces, and the Lisp +reader has features that are not used by the Lisp printer. The Lisp +reader can be used as a lexical analyzer for a more general user-written +parser. + + When the Lisp reader is invoked, it reads a single character from the +input stream and dispatches according to the syntax type of that +character. Every character that can appear in the input stream is of +one of the syntax types shown in Figure~2-6. + + constituent macro character single escape + invalid multiple escape whitespace_2 + + Figure 2-6: Possible Character Syntax Types + + + The syntax type of a character in a readtable determines how that +character is interpreted by the Lisp reader while that readtable is the +current readtable. At any given time, every character has exactly one +syntax type. + + Figure~2-7 lists the syntax type of each character in standard +syntax. + + character syntax type character syntax type + Backspace constituent 0-9 constituent + Tab whitespace_2 : constituent + Newline whitespace_2 ; terminating macro char + Linefeed whitespace_2 < constituent + Page whitespace_2 = constituent + Return whitespace_2 > constituent + Space whitespace_2 ? constituent* + ! constituent* @ constituent + " terminating macro char A-Z constituent + # non-terminating macro char [ constituent* + $ constituent \ single escape + % constituent ] constituent* + & constituent ^ constituent + ' terminating macro char _ constituent + ( terminating macro char ' terminating macro char + ) terminating macro char a-z constituent + * constituent { constituent* + + constituent | multiple escape + , terminating macro char } constituent* + - constituent ~ constituent + . constituent Rubout constituent + / constituent + + Figure 2-7: Character Syntax Types in Standard Syntax + + + The characters marked with an asterisk (*) are initially +constituents, but they are not used in any standard Common Lisp +notations. These characters are explicitly reserved to the programmer. +~ is not used in Common Lisp, and reserved to implementors. $ and % are +alphabetic_2 characters, but are not used in the names of any standard +Common Lisp defined names. + + Whitespace_2 characters serve as separators but are otherwise +ignored. Constituent and escape characters are accumulated to make a +token, which is then interpreted as a number or symbol. Macro +characters trigger the invocation of functions (possibly user-supplied) +that can perform arbitrary parsing actions. Macro characters are +divided into two kinds, terminating and non-terminating, depending on +whether or not they terminate a token. The following are descriptions +of each kind of syntax type. + +* Menu: + +* Constituent Characters:: +* Constituent Traits:: +* Invalid Characters:: +* Macro Characters:: +* Multiple Escape Characters:: +* Examples of Multiple Escape Characters:: +* Single Escape Character:: +* Examples of Single Escape Characters:: +* Whitespace Characters:: +* Examples of Whitespace Characters:: + + +File: gcl.info, Node: Constituent Characters, Next: Constituent Traits, Prev: Character Syntax Types, Up: Character Syntax Types + +2.1.4.1 Constituent Characters +.............................. + +Constituent characters are used in tokens. A token is a representation +of a number or a symbol. Examples of constituent characters are letters +and digits. + + Letters in symbol names are sometimes converted to letters in the +opposite case when the name is read; see *note Effect of Readtable Case +on the Lisp Reader::. Case conversion can be suppressed by the use of +single escape or multiple escape characters. + + +File: gcl.info, Node: Constituent Traits, Next: Invalid Characters, Prev: Constituent Characters, Up: Character Syntax Types + +2.1.4.2 Constituent Traits +.......................... + +Every character has one or more constituent traits that define how the +character is to be interpreted by the Lisp reader when the character is +a constituent character. These constituent traits are alphabetic_2, +digit, package marker, plus sign, minus sign, dot, decimal point, ratio +marker, exponent marker, and invalid. Figure~2-8 shows the constituent +traits of the standard characters and of certain semi-standard +characters; no mechanism is provided for changing the constituent trait +of a character. Any character with the alphadigit constituent trait in +that figure is a digit if the current input base is greater than that +character's digit value, otherwise the character is alphabetic_2. Any +character quoted by a single escape is treated as an alphabetic_2 +constituent, regardless of its normal syntax. + + constituent traits constituent traits + character character + ________________________________________________________________________________ + Backspace invalid { alphabetic_2 + Tab invalid* } alphabetic_2 + Newline invalid* + alphabetic_2, plus sign + Linefeed invalid* - alphabetic_2, minus sign + Page invalid* . alphabetic_2, dot, decimal point + Return invalid* / alphabetic_2, ratio marker + Space invalid* A, a alphadigit + ! alphabetic_2 B, b alphadigit + " alphabetic_2* C, c alphadigit + # alphabetic_2* D, d alphadigit, double-float exponent marker + $ alphabetic_2 E, e alphadigit, float exponent marker + % alphabetic_2 F, f alphadigit, single-float exponent marker + & alphabetic_2 G, g alphadigit + ' alphabetic_2* H, h alphadigit + ( alphabetic_2* I, i alphadigit + ) alphabetic_2* J, j alphadigit + * alphabetic_2 K, k alphadigit + , alphabetic_2* L, l alphadigit, long-float exponent marker + 0-9 alphadigit M, m alphadigit + : package marker N, n alphadigit + ; alphabetic_2* O, o alphadigit + < alphabetic_2 P, p alphadigit + = alphabetic_2 Q, q alphadigit + > alphabetic_2 R, r alphadigit + ? alphabetic_2 S, s alphadigit, short-float exponent marker + @ alphabetic_2 T, t alphadigit + [ alphabetic_2 U, u alphadigit + \ alphabetic_2* V, v alphadigit + ] alphabetic_2 W, w alphadigit + ^ alphabetic_2 X, x alphadigit + _ alphabetic_2 Y, y alphadigit + ' alphabetic_2* Z, z alphadigit + | alphabetic_2* Rubout invalid + ~ alphabetic_2 + + Figure 2-8: Constituent Traits of Standard Characters and Semi-Standard Characters + + The interpretations in this table apply only to characters whose +syntax type is constituent. Entries marked with an asterisk (*) are +normally shadowed_2 because the indicated characters are of syntax type +whitespace_2, macro character, single escape, or multiple escape; these +constituent traits apply to them only if their syntax types are changed +to constituent. + + +File: gcl.info, Node: Invalid Characters, Next: Macro Characters, Prev: Constituent Traits, Up: Character Syntax Types + +2.1.4.3 Invalid Characters +.......................... + +Characters with the constituent trait invalid cannot ever appear in a +token except under the control of a single escape character. If an +invalid character is encountered while an object is being read, an error +of type reader-error is signaled. If an invalid character is preceded +by a single escape character, it is treated as an alphabetic_2 +constituent instead. + + +File: gcl.info, Node: Macro Characters, Next: Multiple Escape Characters, Prev: Invalid Characters, Up: Character Syntax Types + +2.1.4.4 Macro Characters +........................ + +When the Lisp reader encounters a macro character on an input stream, +special parsing of subsequent characters on the input stream is +performed. + + A macro character has an associated function called a reader macro +function that implements its specialized parsing behavior. An +association of this kind can be established or modified under control of +a conforming program by using the functions set-macro-character and +set-dispatch-macro-character. + + Upon encountering a macro character, the Lisp reader calls its reader +macro function, which parses one specially formatted object from the +input stream. The function either returns the parsed object, or else it +returns no values to indicate that the characters scanned by the +function are being ignored (e.g., in the case of a comment). Examples +of macro characters are backquote, single-quote, left-parenthesis, and +right-parenthesis. + + A macro character is either terminating or non-terminating. The +difference between terminating and non-terminating macro characters lies +in what happens when such characters occur in the middle of a token. If +a non-terminating macro character occurs in the middle of a token, the +function associated with the non-terminating macro character is not +called, and the non-terminating macro character does not terminate the +token's name; it becomes part of the name as if the macro character were +really a constituent character. A terminating macro character +terminates any token, and its associated reader macro function is called +no matter where the character appears. The only non-terminating macro +character in standard syntax is sharpsign. + + If a character is a dispatching macro character C_1, its reader macro +function is a function supplied by the implementation. This function +reads decimal digit characters until a non-digit C_2 is read. If any +digits were read, they are converted into a corresponding integer infix +parameter P; otherwise, the infix parameter P is nil. The terminating +non-digit C_2 is a character (sometimes called a "sub-character" to +emphasize its subordinate role in the dispatching) that is looked up in +the dispatch table associated with the dispatching macro character C_1. +The reader macro function associated with the sub-character C_2 is +invoked with three arguments: the stream, the sub-character C_2, and the +infix parameter P. For more information about dispatch characters, see +the function set-dispatch-macro-character. + + For information about the macro characters that are available in +standard syntax, see *note Standard Macro Characters::. + + +File: gcl.info, Node: Multiple Escape Characters, Next: Examples of Multiple Escape Characters, Prev: Macro Characters, Up: Character Syntax Types + +2.1.4.5 Multiple Escape Characters +.................................. + +A pair of multiple escape characters is used to indicate that an +enclosed sequence of characters, including possible macro characters and +whitespace_2 characters, are to be treated as alphabetic_2 characters +with case preserved. Any single escape and multiple escape characters +that are to appear in the sequence must be preceded by a single escape +character. + + Vertical-bar is a multiple escape character in standard syntax. + + +File: gcl.info, Node: Examples of Multiple Escape Characters, Next: Single Escape Character, Prev: Multiple Escape Characters, Up: Character Syntax Types + +2.1.4.6 Examples of Multiple Escape Characters +.............................................. + + ;; The following examples assume the readtable case of *readtable* + ;; and *print-case* are both :upcase. + (eq 'abc 'ABC) => true + (eq 'abc '|ABC|) => true + (eq 'abc 'a|B|c) => true + (eq 'abc '|abc|) => false + + +File: gcl.info, Node: Single Escape Character, Next: Examples of Single Escape Characters, Prev: Examples of Multiple Escape Characters, Up: Character Syntax Types + +2.1.4.7 Single Escape Character +............................... + +A single escape is used to indicate that the next character is to be +treated as an alphabetic_2 character with its case preserved, no matter +what the character is or which constituent traits it has. + + Slash is a single escape character in standard syntax. + + +File: gcl.info, Node: Examples of Single Escape Characters, Next: Whitespace Characters, Prev: Single Escape Character, Up: Character Syntax Types + +2.1.4.8 Examples of Single Escape Characters +............................................ + + ;; The following examples assume the readtable case of *readtable* + ;; and *print-case* are both :upcase. + (eq 'abc '\A\B\C) => true + (eq 'abc 'a\Bc) => true + (eq 'abc '\ABC) => true + (eq 'abc '\abc) => false + + +File: gcl.info, Node: Whitespace Characters, Next: Examples of Whitespace Characters, Prev: Examples of Single Escape Characters, Up: Character Syntax Types + +2.1.4.9 Whitespace Characters +............................. + +Whitespace_2 characters are used to separate tokens. + + Space and newline are whitespace_2 characters in standard syntax. + + +File: gcl.info, Node: Examples of Whitespace Characters, Prev: Whitespace Characters, Up: Character Syntax Types + +2.1.4.10 Examples of Whitespace Characters +.......................................... + + (length '(this-that)) => 1 + (length '(this - that)) => 3 + (length '(a + b)) => 2 + (+ 34) => 34 + (+ 3 4) => 7 + + +File: gcl.info, Node: Reader Algorithm, Next: Interpretation of Tokens, Prev: Character Syntax, Up: Syntax + +2.2 Reader Algorithm +==================== + +This section describes the algorithm used by the Lisp reader to parse +objects from an input character stream, including how the Lisp reader +processes macro characters. + + When dealing with tokens, the reader's basic function is to +distinguish representations of symbols from those of numbers. When a +token is accumulated, it is assumed to represent a number if it +satisfies the syntax for numbers listed in Figure~2-9. If it does not +represent a number, it is then assumed to be a potential number if it +satisfies the rules governing the syntax for a potential number. If a +valid token is neither a representation of a number nor a potential +number, it represents a symbol. + + The algorithm performed by the Lisp reader is as follows: + +1. + If at end of file, end-of-file processing is performed as specified + in read. Otherwise, one character, x, is read from the input + stream, and dispatched according to the syntax type of x to one of + steps 2 to 7. + +2. + If x is an invalid character, an error of type reader-error is + signaled. + +3. + If x is a whitespace_2 character, then it is discarded and step 1 + is re-entered. + +4. + If x is a terminating or non-terminating macro character then its + associated reader macro function is called with two arguments, the + input stream and x. + + The reader macro function may read characters from the input + stream; if it does, it will see those characters following the + macro character. The Lisp reader may be invoked recursively from + the reader macro function. + + The reader macro function must not have any side effects other than + on the input stream; because of backtracking and restarting of the + read operation, front ends to the Lisp reader (e.g., "editors" and + "rubout handlers") may cause the reader macro function to be called + repeatedly during the reading of a single expression in which x + only appears once. + + The reader macro function may return zero values or one value. If + one value is returned, then that value is returned as the result of + the read operation; the algorithm is done. If zero values are + returned, then step 1 is re-entered. + +5. + If x is a single escape character then the next character, y, is + read, or an error of type end-of-file is signaled if at the end of + file. y is treated as if it is a constituent whose only + constituent trait is alphabetic_2. y is used to begin a token, and + step 8 is entered. + +6. + If x is a multiple escape character then a token (initially + containing no characters) is begun and step 9 is entered. + +7. + If x is a constituent character, then it begins a token. After the + token is read in, it will be interpreted either as a Lisp object or + as being of invalid syntax. If the token represents an object, + that object is returned as the result of the read operation. If + the token is of invalid syntax, an error is signaled. If x is a + character with case, it might be replaced with the corresponding + character of the opposite case, depending on the readtable case of + the current readtable, as outlined in *note Effect of Readtable + Case on the Lisp Reader::. X is used to begin a token, and step 8 + is entered. + +8. + At this point a token is being accumulated, and an even number of + multiple escape characters have been encountered. If at end of + file, step 10 is entered. Otherwise, a character, y, is read, and + one of the following actions is performed according to its syntax + type: + + * + If y is a constituent or non-terminating macro character: + + - + If y is a character with case, it might be replaced with + the corresponding character of the opposite case, + depending on the readtable case of the current readtable, + as outlined in *note Effect of Readtable Case on the Lisp + Reader::. + - + Y is appended to the token being built. + - + Step 8 is repeated. + + * + If y is a single escape character, then the next character, z, + is read, or an error of type end-of-file is signaled if at end + of file. Z is treated as if it is a constituent whose only + constituent trait is alphabetic_2. Z is appended to the token + being built, and step 8 is repeated. + + * + If y is a multiple escape character, then step 9 is entered. + + * + If y is an invalid character, an error of type reader-error is + signaled. + + * + If y is a terminating macro character, then it terminates the + token. First the character y is unread (see unread-char), and + then step 10 is entered. + + * + If y is a whitespace_2 character, then it terminates the + token. First the character y is unread if appropriate (see + read-preserving-whitespace), and then step 10 is entered. + +9. + At this point a token is being accumulated, and an odd number of + multiple escape characters have been encountered. If at end of + file, an error of type end-of-file is signaled. Otherwise, a + character, y, is read, and one of the following actions is + performed according to its syntax type: + + * + If y is a constituent, macro, or whitespace_2 character, y is + treated as a constituent whose only constituent trait is + alphabetic_2. Y is appended to the token being built, and + step 9 is repeated. + + * + If y is a single escape character, then the next character, z, + is read, or an error of type end-of-file is signaled if at end + of file. Z is treated as a constituent whose only constituent + trait is alphabetic_2. Z is appended to the token being + built, and step 9 is repeated. + + * + If y is a multiple escape character, then step 8 is entered. + + * + If y is an invalid character, an error of type reader-error is + signaled. + +10. + An entire token has been accumulated. The object represented by + the token is returned as the result of the read operation, or an + error of type reader-error is signaled if the token is not of valid + syntax. + + +File: gcl.info, Node: Interpretation of Tokens, Next: Standard Macro Characters, Prev: Reader Algorithm, Up: Syntax + +2.3 Interpretation of Tokens +============================ + +* Menu: + +* Numbers as Tokens:: +* Constructing Numbers from Tokens:: +* The Consing Dot:: +* Symbols as Tokens:: +* Valid Patterns for Tokens:: +* Package System Consistency Rules:: + + +File: gcl.info, Node: Numbers as Tokens, Next: Constructing Numbers from Tokens, Prev: Interpretation of Tokens, Up: Interpretation of Tokens + +2.3.1 Numbers as Tokens +----------------------- + +When a token is read, it is interpreted as a number or symbol. The +token is interpreted as a number if it satisfies the syntax for numbers +specified in Figure 2-9. + + numeric-token ::= !integer | !ratio | !float + integer ::= [sign] {decimal-digit}^+ decimal-point | [sign] {digit}^+ + ratio ::= [sign] {digit}^+ slash {digit}^+ + float ::= [sign] {decimal-digit}* decimal-point {decimal-digit}^+ [!exponent] + | [sign] {decimal-digit}^+ [decimal-point {decimal-digit}*] !exponent + exponent ::= exponent-marker [sign] {digit}^+ + sign--a sign. + slash--a slash + decimal-point--a dot. + exponent-marker--an exponent marker. + decimal-digit--a digit in radix 10. + digit--a digit in the current input radix. + + Figure 2-9: Syntax for Numeric Tokens + +* Menu: + +* Potential Numbers as Tokens:: +* Escape Characters and Potential Numbers:: +* Examples of Potential Numbers:: + + +File: gcl.info, Node: Potential Numbers as Tokens, Next: Escape Characters and Potential Numbers, Prev: Numbers as Tokens, Up: Numbers as Tokens + +2.3.1.1 Potential Numbers as Tokens +................................... + +To allow implementors and future Common Lisp standards to extend the +syntax of numbers, a syntax for potential numbers is defined that is +more general than the syntax for numbers. A token is a potential number +if it satisfies all of the following requirements: + +1. + The token consists entirely of digits, signs, ratio markers, + decimal points (.), extension characters (^ or _), and number + markers. A number marker is a letter. Whether a letter may be + treated as a number marker depends on context, but no letter that + is adjacent to another letter may ever be treated as a number + marker. Exponent markers are number markers. + +2. + The token contains at least one digit. Letters may be considered + to be digits, depending on the current input base, but only in + tokens containing no decimal points. + +3. + The token begins with a digit, sign, decimal point, or extension + character, + + [Reviewer Note by Barmar: This section is unnecessary because the + first bullet already omits discussion of a colon (package marker).] + but not a package marker. The syntax involving a leading package + marker followed by a potential number is not well-defined. The + consequences of the use of notation such as :1, :1/2, and :2^3 in a + position where an expression appropriate for read is expected are + unspecified. + +4. + The token does not end with a sign. + + If a potential number has number syntax, a number of the appropriate +type is constructed and returned, if the number is representable in an +implementation. A number will not be representable in an implementation +if it is outside the boundaries set by the implementation-dependent +constants for numbers. For example, specifying too large or too small +an exponent for a float may make the number impossible to represent in +the implementation. A ratio with denominator zero (such as -35/000) is +not represented in any implementation. When a token with the syntax of +a number cannot be converted to an internal number, an error of type +reader-error is signaled. An error must not be signaled for specifying +too many significant digits for a float; a truncated or rounded value +should be produced. + + If there is an ambiguity as to whether a letter should be treated as +a digit or as a number marker, the letter is treated as a digit. + + +File: gcl.info, Node: Escape Characters and Potential Numbers, Next: Examples of Potential Numbers, Prev: Potential Numbers as Tokens, Up: Numbers as Tokens + +2.3.1.2 Escape Characters and Potential Numbers +............................................... + +A potential number cannot contain any escape characters. An escape +character robs the following character of all syntactic qualities, +forcing it to be strictly alphabetic_2 and therefore unsuitable for use +in a potential number. For example, all of the following +representations are interpreted as symbols, not numbers: + + \256 25\64 1.0\E6 |100| 3\.14159 |3/4| 3\/4 5|| + + In each case, removing the escape character (or characters) would +cause the token to be a potential number. + + +File: gcl.info, Node: Examples of Potential Numbers, Prev: Escape Characters and Potential Numbers, Up: Numbers as Tokens + +2.3.1.3 Examples of Potential Numbers +..................................... + +As examples, the tokens in Figure 2-10 are potential numbers, but they +are not actually numbers, and so are reserved tokens; a conforming +implementation is permitted, but not required, to define their meaning. + + 1b5000 777777q 1.7J -3/4+6.7J 12/25/83 + 27^19 3^4/5 6//7 3.1.2.6 ^-43^ + 3.141_592_653_589_793_238_4 -3.7+2.6i-6.17j+19.6k + + Figure 2-10: Examples of reserved tokens + + + The tokens in Figure 2-11 are not potential numbers; they are always +treated as symbols: + + / /5 + 1+ 1- + foo+ ab.cd _ ^ ^/- + + Figure 2-11: Examples of symbols + + + The tokens in Figure 2-12 are potential numbers if the current input +base is 16, but they are always treated as symbols if the current input +base is 10. + + bad-face 25-dec-83 a/b fad_cafe f^ + + Figure 2-12: Examples of symbols or potential numbers + + + +File: gcl.info, Node: Constructing Numbers from Tokens, Next: The Consing Dot, Prev: Numbers as Tokens, Up: Interpretation of Tokens + +2.3.2 Constructing Numbers from Tokens +-------------------------------------- + +A real is constructed directly from a corresponding numeric token; see +Figure~2-9. + + A complex is notated as a #C (or #c) followed by a list of two reals; +see *note Sharpsign C::. + + The reader macros #B, #O, #X, and #R may also be useful in +controlling the input radix in which rationals are parsed; see *note +Sharpsign B::, *note Sharpsign O::, *note Sharpsign X::, and *note +Sharpsign R::. + + This section summarizes the full syntax for numbers. + +* Menu: + +* Syntax of a Rational:: +* Syntax of an Integer:: +* Syntax of a Ratio:: +* Syntax of a Float:: +* Syntax of a Complex:: + + +File: gcl.info, Node: Syntax of a Rational, Next: Syntax of an Integer, Prev: Constructing Numbers from Tokens, Up: Constructing Numbers from Tokens + +2.3.2.1 Syntax of a Rational +............................ + + +File: gcl.info, Node: Syntax of an Integer, Next: Syntax of a Ratio, Prev: Syntax of a Rational, Up: Constructing Numbers from Tokens + +2.3.2.2 Syntax of an Integer +............................ + +Integers can be written as a sequence of digits, optionally preceded by +a sign and optionally followed by a decimal point; see Figure~2-9. When +a decimal point is used, the digits are taken to be in radix 10; when no +decimal point is used, the digits are taken to be in radix given by the +current input base. + + For information on how integers are printed, see *note Printing +Integers::. + + +File: gcl.info, Node: Syntax of a Ratio, Next: Syntax of a Float, Prev: Syntax of an Integer, Up: Constructing Numbers from Tokens + +2.3.2.3 Syntax of a Ratio +......................... + +Ratios can be written as an optional sign followed by two non-empty +sequences of digits separated by a slash; see Figure~2-9. The second +sequence may not consist entirely of zeros. Examples of ratios are in +Figure 2-13. + + 2/3 ;This is in canonical form + 4/6 ;A non-canonical form for 2/3 + -17/23 ;A ratio preceded by a sign + -30517578125/32768 ;This is (-5/2)^15 + 10/5 ;The canonical form for this is 2 + #o-101/75 ;Octal notation for -65/61 + #3r120/21 ;Ternary notation for 15/7 + #Xbc/ad ;Hexadecimal notation for 188/173 + #xFADED/FACADE ;Hexadecimal notation for 1027565/16435934 + + Figure 2-13: Examples of Ratios + + + [Reviewer Note by Barmar: #o, #3r, #X, and #x mentioned above are not +in the syntax rules defined just above that.] + + For information on how ratios are printed, see *note Printing +Ratios::. + + +File: gcl.info, Node: Syntax of a Float, Next: Syntax of a Complex, Prev: Syntax of a Ratio, Up: Constructing Numbers from Tokens + +2.3.2.4 Syntax of a Float +......................... + +Floats can be written in either decimal fraction or computerized +scientific notation: an optional sign, then a non-empty sequence of +digits with an embedded decimal point, then an optional decimal exponent +specification. If there is no exponent specifier, then the decimal +point is required, and there must be digits after it. The exponent +specifier consists of an exponent marker, an optional sign, and a +non-empty sequence of digits. If no exponent specifier is present, or +if the exponent marker e (or E) is used, then the format specified by +*read-default-float-format* is used. See Figure~2-9. + + An implementation may provide one or more kinds of float that +collectively make up the type float. The letters s, f, d, and l (or +their respective uppercase equivalents) explicitly specify the use of +the types short-float, single-float, double-float, and long-float, +respectively. + + The internal format used for an external representation depends only +on the exponent marker, and not on the number of decimal digits in the +external representation. + + Figure 2-14 contains examples of notations for floats: + + 0.0 ;Floating-point zero in default format + 0E0 ;As input, this is also floating-point zero in default format. + ;As output, this would appear as 0.0. + 0e0 ;As input, this is also floating-point zero in default format. + ;As output, this would appear as 0.0. + -.0 ;As input, this might be a zero or a minus zero, + ; depending on whether the implementation supports + ; a distinct minus zero. + ;As output, 0.0 is zero and -0.0 is minus zero. + 0. ;On input, the integer zero--not a floating-point number! + ;Whether this appears as 0 or 0. on output depends + ;on the value of *print-radix*. + 0.0s0 ;A floating-point zero in short format + 0s0 ;As input, this is a floating-point zero in short format. + ;As output, such a zero would appear as 0.0s0 + ; (or as 0.0 if short-float was the default format). + 6.02E+23 ;Avogadro's number, in default format + 602E+21 ;Also Avogadro's number, in default format + + Figure 2-14: Examples of Floating-point numbers + + + For information on how floats are printed, see *note Printing +Floats::. + + +File: gcl.info, Node: Syntax of a Complex, Prev: Syntax of a Float, Up: Constructing Numbers from Tokens + +2.3.2.5 Syntax of a Complex +........................... + +A complex has a Cartesian structure, with a real part and an imaginary +part each of which is a + + real. + + The parts of a complex are not necessarily floats but both parts must +be of the same type: + + [Editorial Note by KMP: This is not the same as saying they must be +the same type. Maybe we mean they are of the same 'precision' or +'format'? GLS had suggestions which are not yet merged.] either both +are rationals, or both are of the same float subtype. When constructing +a complex, if the specified parts are not the same type, the parts are +converted to be the same type internally (i.e., the rational part is +converted to a float). An object of type (complex rational) is +converted internally and represented thereafter as a rational if its +imaginary part is an integer whose value is 0. + + For further information, see *note Sharpsign C:: and *note Printing +Complexes::. + + +File: gcl.info, Node: The Consing Dot, Next: Symbols as Tokens, Prev: Constructing Numbers from Tokens, Up: Interpretation of Tokens + +2.3.3 The Consing Dot +--------------------- + +If a token consists solely of dots (with no escape characters), then an +error of type reader-error is signaled, except in one circumstance: if +the token is a single dot and appears in a situation where dotted pair +notation permits a dot, then it is accepted as part of such syntax and +no error is signaled. See *note Left-Parenthesis::. + + +File: gcl.info, Node: Symbols as Tokens, Next: Valid Patterns for Tokens, Prev: The Consing Dot, Up: Interpretation of Tokens + +2.3.4 Symbols as Tokens +----------------------- + +Any token that is not a potential number, does not contain a package +marker, and does not consist entirely of dots will always be interpreted +as a symbol. Any token that is a potential number but does not fit the +number syntax is a reserved token and has an implementation-dependent +interpretation. In all other cases, the token is construed to be the +name of a symbol. + + Examples of the printed representation of symbols are in Figure 2-15. +For presentational simplicity, these examples assume that the readtable +case of the current readtable is :upcase. + + FROBBOZ The symbol whose name is FROBBOZ. + frobboz Another way to notate the same symbol. + fRObBoz Yet another way to notate it. + unwind-protect A symbol with a hyphen in its name. + +$ The symbol named +$. + 1+ The symbol named 1+. + +1 This is the integer 1, not a symbol. + pascal_style This symbol has an underscore in its name. + file.rel.43 This symbol has periods in its name. + \( The symbol whose name is (. + \+1 The symbol whose name is +1. + +\1 Also the symbol whose name is +1. + \frobboz The symbol whose name is fROBBOZ. + 3.14159265\s0 The symbol whose name is 3.14159265s0. + 3.14159265\S0 A different symbol, whose name is 3.14159265S0. + 3.14159265s0 A possible short float approximation to \pi. + + Figure 2-15: Examples of the printed representation of symbols (Part 1 of 2) + + + APL\\360 The symbol whose name is APL\360. + apl\\360 Also the symbol whose name is APL\360. + \(b^2\)\ -\ 4*a*c The name is (B^2) - 4*A*C. + Parentheses and two spaces in it. + \(\b^2\)\ -\4*\a*\c The name is (b^2) - 4*a*c. + Letters explicitly lowercase. + |"| The same as writing \". + |(b^2) - 4*a*c| The name is (b^2) - 4*a*c. + |frobboz| The name is frobboz, not FROBBOZ. + |APL\360| The name is APL360. + |APL\\360| The name is APL\360. + |apl\\360| The name is apl\360. + |\|\|| Same as \|\| --the name is ||. + |(B^2) - 4*A*C| The name is (B^2) - 4*A*C. + Parentheses and two spaces in it. + |(b^2) - 4*a*c| The name is (b^2) - 4*a*c. + + Figure 2-16: Examples of the printed representation of symbols (Part 2 of 2) + + + In the process of parsing a symbol, it is implementation-dependent +which implementation-defined attributes are removed from the characters +forming a token that represents a symbol. + + When parsing the syntax for a symbol, the Lisp reader looks up the +name of that symbol in the current package. This lookup may involve +looking in other packages whose external symbols are inherited by the +current package. If the name is found, the corresponding symbol is +returned. If the name is not found (that is, there is no symbol of that +name accessible in the current package), a new symbol is created and is +placed in the current package as an internal symbol. The current +package becomes the owner (home package) of the symbol, and the symbol +becomes interned in the current package. If the name is later read +again while this same package is current, the same symbol will be found +and returned. + + +File: gcl.info, Node: Valid Patterns for Tokens, Next: Package System Consistency Rules, Prev: Symbols as Tokens, Up: Interpretation of Tokens + +2.3.5 Valid Patterns for Tokens +------------------------------- + +The valid patterns for tokens are summarized in Figure 2-17. + + nnnnn a number + xxxxx a symbol in the current package + :xxxxx a symbol in the the KEYWORD package + ppppp:xxxxx an external symbol in the ppppp package + ppppp::xxxxx a (possibly internal) symbol in the ppppp package + :nnnnn undefined + ppppp:nnnnn undefined + ppppp::nnnnn undefined + ::aaaaa undefined + aaaaa: undefined + aaaaa:aaaaa:aaaaa undefined + + Figure 2-17: Valid patterns for tokens + + + Note that nnnnn has number syntax, neither xxxxx nor ppppp has number +syntax, and aaaaa has any syntax. + + A summary of rules concerning package markers follows. In each case, +examples are offered to illustrate the case; for presentational +simplicity, the examples assume that the readtable case of the current +readtable is :upcase. + +1. + If there is a single package marker, and it occurs at the beginning + of the token, then the token is interpreted as a symbol in the + KEYWORD package. It also sets the symbol-value of the + newly-created symbol to that same symbol so that the symbol will + self-evaluate. + + For example, :bar, when read, interns BAR as an external symbol in + the KEYWORD package. + +2. + If there is a single package marker not at the beginning or end of + the token, then it divides the token into two parts. The first + part specifies a package; the second part is the name of an + external symbol available in that package. + + For example, foo:bar, when read, looks up BAR among the external + symbols of the package named FOO. + +3. + If there are two adjacent package markers not at the beginning or + end of the token, then they divide the token into two parts. The + first part specifies a package; the second part is the name of a + symbol within that package (possibly an internal symbol). + + For example, foo::bar, when read, interns BAR in the package named + FOO. + +4. + If the token contains no package markers, and does not have + potential number syntax, then the entire token is the name of the + symbol. The symbol is looked up in the current package. + + For example, bar, when read, interns BAR in the current package. + +5. + The consequences are unspecified if any other pattern of package + markers in a token is used. All other uses of package markers + within names of symbols are not defined by this standard but are + reserved for implementation-dependent use. + + For example, assuming the readtable case of the current readtable is +:upcase, editor:buffer refers to the external symbol named BUFFER +present in the package named editor, regardless of whether there is a +symbol named BUFFER in the current package. If there is no package +named editor, or if no symbol named BUFFER is present in editor, or if +BUFFER is not exported by editor, the reader signals a correctable +error. If editor::buffer is seen, the effect is exactly the same as +reading buffer with the EDITOR package being the current package. + + +File: gcl.info, Node: Package System Consistency Rules, Prev: Valid Patterns for Tokens, Up: Interpretation of Tokens + +2.3.6 Package System Consistency Rules +-------------------------------------- + +The following rules apply to the package system as long as the value of +*package* is not changed: + +Read-read consistency + Reading the same symbol name always results in the same symbol. + +Print-read consistency + An interned symbol always prints as a sequence of characters that, + when read back in, yields the same symbol. + + For information about how the Lisp printer treats symbols, see + *note Printing Symbols::. + +Print-print consistency + If two interned symbols are not the same, then their printed + representations will be different sequences of characters. + + These rules are true regardless of any implicit interning. As long +as the current package is not changed, results are reproducible +regardless of the order of loading files or the exact history of what +symbols were typed in when. If the value of *package* is changed and +then changed back to the previous value, consistency is maintained. The +rules can be violated by changing the value of *package*, forcing a +change to symbols or to packages or to both by continuing from an error, +or calling one of the following functions: unintern, unexport, shadow, +shadowing-import, or unuse-package. + + An inconsistency only applies if one of the restrictions is violated +between two of the named symbols. shadow, unexport, unintern, and +shadowing-import can only affect the consistency of symbols with the +same names (under string=) as the ones supplied as arguments. + + +File: gcl.info, Node: Standard Macro Characters, Prev: Interpretation of Tokens, Up: Syntax + +2.4 Standard Macro Characters +============================= + +If the reader encounters a macro character, then its associated reader +macro function is invoked and may produce an object to be returned. +This function may read the characters following the macro character in +the stream in any syntax and return the object represented by that +syntax. + + Any character can be made to be a macro character. The macro +characters defined initially in a conforming implementation include the +following: + +* Menu: + +* Left-Parenthesis:: +* Right-Parenthesis:: +* Single-Quote:: +* Semicolon:: +* Double-Quote:: +* Backquote:: +* Comma:: +* Sharpsign:: +* Re-Reading Abbreviated Expressions:: + + +File: gcl.info, Node: Left-Parenthesis, Next: Right-Parenthesis, Prev: Standard Macro Characters, Up: Standard Macro Characters + +2.4.1 Left-Parenthesis +---------------------- + +The left-parenthesis initiates reading of a list. read is called +recursively to read successive objects until a right parenthesis is +found in the input stream. A list of the objects read is returned. +Thus + + (a b c) + + is read as a list of three objects (the symbols a, b, and c). The +right parenthesis need not immediately follow the printed representation +of the last object; whitespace_2 characters and comments may precede it. + + If no objects precede the right parenthesis, it reads as a list of +zero objects (the empty list). + + If a token that is just a dot not immediately preceded by an escape +character is read after some object then exactly one more object must +follow the dot, possibly preceded or followed by whitespace_2 or a +comment, followed by the right parenthesis: + + (a b c . d) + + This means that the cdr of the last cons in the list is not nil, but +rather the object whose representation followed the dot. The above +example might have been the result of evaluating + + (cons 'a (cons 'b (cons 'c 'd))) + + Similarly, + + (cons 'this-one 'that-one) => (this-one . that-one) + + It is permissible for the object following the dot to be a list: + + (a b c d . (e f . (g))) == (a b c d e f g) + + For information on how the Lisp printer prints lists and conses, see +*note Printing Lists and Conses::. + + +File: gcl.info, Node: Right-Parenthesis, Next: Single-Quote, Prev: Left-Parenthesis, Up: Standard Macro Characters + +2.4.2 Right-Parenthesis +----------------------- + +The right-parenthesis is invalid except when used in conjunction with +the left parenthesis character. For more information, see *note Reader +Algorithm::. + + +File: gcl.info, Node: Single-Quote, Next: Semicolon, Prev: Right-Parenthesis, Up: Standard Macro Characters + +2.4.3 Single-Quote +------------------ + +Syntax: '<> + + A single-quote introduces an expression to be "quoted." Single-quote +followed by an expression exp is treated by the Lisp reader as an +abbreviation for and is parsed identically to the expression (quote +exp). See the special operator quote. + +* Menu: + +* Examples of Single-Quote:: + + +File: gcl.info, Node: Examples of Single-Quote, Prev: Single-Quote, Up: Single-Quote + +2.4.3.1 Examples of Single-Quote +................................ + + 'foo => FOO + ''foo => (QUOTE FOO) + (car ''foo) => QUOTE + + +File: gcl.info, Node: Semicolon, Next: Double-Quote, Prev: Single-Quote, Up: Standard Macro Characters + +2.4.4 Semicolon +--------------- + +Syntax: ;<> + + A semicolon introduces characters that are to be ignored, such as +comments. The semicolon and all characters up to and including the next +newline or end of file are ignored. + +* Menu: + +* Examples of Semicolon:: +* Notes about Style for Semicolon:: +* Use of Single Semicolon:: +* Use of Double Semicolon:: +* Use of Triple Semicolon:: +* Use of Quadruple Semicolon:: +* Examples of Style for Semicolon:: + + +File: gcl.info, Node: Examples of Semicolon, Next: Notes about Style for Semicolon, Prev: Semicolon, Up: Semicolon + +2.4.4.1 Examples of Semicolon +............................. + + (+ 3 ; three + 4) + => 7 + + +File: gcl.info, Node: Notes about Style for Semicolon, Next: Use of Single Semicolon, Prev: Examples of Semicolon, Up: Semicolon + +2.4.4.2 Notes about Style for Semicolon +....................................... + +Some text editors make assumptions about desired indentation based on +the number of semicolons that begin a comment. The following style +conventions are common, although not by any means universal. + + +File: gcl.info, Node: Use of Single Semicolon, Next: Use of Double Semicolon, Prev: Notes about Style for Semicolon, Up: Semicolon + +2.4.4.3 Use of Single Semicolon +............................... + +Comments that begin with a single semicolon are all aligned to the same +column at the right (sometimes called the "comment column"). The text +of such a comment generally applies only to the line on which it +appears. Occasionally two or three contain a single sentence together; +this is sometimes indicated by indenting all but the first with an +additional space (after the semicolon). + + +File: gcl.info, Node: Use of Double Semicolon, Next: Use of Triple Semicolon, Prev: Use of Single Semicolon, Up: Semicolon + +2.4.4.4 Use of Double Semicolon +............................... + +Comments that begin with a double semicolon are all aligned to the same +level of indentation as a form would be at that same position in the +code. The text of such a comment usually describes the state of the +program at the point where the comment occurs, the code which follows +the comment, or both. + + +File: gcl.info, Node: Use of Triple Semicolon, Next: Use of Quadruple Semicolon, Prev: Use of Double Semicolon, Up: Semicolon + +2.4.4.5 Use of Triple Semicolon +............................... + +Comments that begin with a triple semicolon are all aligned to the left +margin. Usually they are used prior to a definition or set of +definitions, rather than within a definition. + + +File: gcl.info, Node: Use of Quadruple Semicolon, Next: Examples of Style for Semicolon, Prev: Use of Triple Semicolon, Up: Semicolon + +2.4.4.6 Use of Quadruple Semicolon +.................................. + +Comments that begin with a quadruple semicolon are all aligned to the +left margin, and generally contain only a short piece of text that serve +as a title for the code which follows, and might be used in the header +or footer of a program that prepares code for presentation as a hardcopy +document. + + +File: gcl.info, Node: Examples of Style for Semicolon, Prev: Use of Quadruple Semicolon, Up: Semicolon + +2.4.4.7 Examples of Style for Semicolon +....................................... + + ;;;; Math Utilities + + ;;; FIB computes the the Fibonacci function in the traditional + ;;; recursive way. + + (defun fib (n) + (check-type n integer) + ;; At this point we're sure we have an integer argument. + ;; Now we can get down to some serious computation. + (cond ((< n 0) + ;; Hey, this is just supposed to be a simple example. + ;; Did you really expect me to handle the general case? + (error "FIB got ~D as an argument." n)) + ((< n 2) n) ;fib[0]=0 and fib[1]=1 + ;; The cheap cases didn't work. + ;; Nothing more to do but recurse. + (t (+ (fib (- n 1)) ;The traditional formula + (fib (- n 2)))))) ; is fib[n-1]+fib[n-2]. + + +File: gcl.info, Node: Double-Quote, Next: Backquote, Prev: Semicolon, Up: Standard Macro Characters + +2.4.5 Double-Quote +------------------ + +Syntax: "<>" + + The double-quote is used to begin and end a string. When a +double-quote is encountered, characters are read from the input stream +and accumulated until another double-quote is encountered. If a single +escape character is seen, the single escape character is discarded, the +next character is accumulated, and accumulation continues. The +accumulated characters up to but not including the matching double-quote +are made into a simple string and returned. + + It is implementation-dependent which attributes of the accumulated +characters are removed in this process. + + Examples of the use of the double-quote character are in Figure 2-18. + + "Foo" ;A string with three characters in it + "" ;An empty string + "\"APL\\360?\" he cried." ;A string with twenty characters + "|x| = |-x|" ;A ten-character string + + Figure 2-18: Examples of the use of double-quote + + + Note that to place a single escape character or a double-quote into a +string, such a character must be preceded by a single escape character. +Note, too, that a multiple escape character need not be quoted by a +single escape character within a string. + + For information on how the Lisp printer prints strings, see *note +Printing Strings::. + + +File: gcl.info, Node: Backquote, Next: Comma, Prev: Double-Quote, Up: Standard Macro Characters + +2.4.6 Backquote +--------------- + +The backquote introduces a template of a data structure to be built. +For example, writing + + `(cond ((numberp ,x) ,@y) (t (print ,x) ,@y)) + + is roughly equivalent to writing + + (list 'cond + (cons (list 'numberp x) y) + (list* 't (list 'print x) y)) + + Where a comma occurs in the template, the expression following the +comma is to be evaluated to produce an object to be inserted at that +point. Assume b has the value 3, for example, then evaluating the form +denoted by `(a b ,b ,(+ b 1) b) produces the result (a b 3 4 b). + + If a comma is immediately followed by an at-sign, then the form +following the at-sign is evaluated to produce a list of objects. These +objects are then "spliced" into place in the template. For example, if +x has the value (a b c), then + + `(x ,x ,@x foo ,(cadr x) bar ,(cdr x) baz ,@(cdr x)) + => (x (a b c) a b c foo b bar (b c) baz b c) + + The backquote syntax can be summarized formally as follows. + +* + `basic is the same as 'basic, that is, (quote basic), for any + expression basic that is not a list or a general vector. + +* + `,form is the same as form, for any form, provided that the + representation of form does not begin with at-sign or dot. (A + similar caveat holds for all occurrences of a form after a comma.) + +* + `,@form has undefined consequences. + +* + `(x1 x2 x3 ... xn . atom) may be interpreted to mean + + (append [ x1 ] [ x2 ] [ x3 ] ... [ xn ] (quote atom)) + + where the brackets are used to indicate a transformation of an xj + as follows: + + - + [form] is interpreted as (list `form), which contains a + backquoted form that must then be further interpreted. + + - + [,form] is interpreted as (list form). + + - + [,@form] is interpreted as form. + +* + `(x1 x2 x3 ... xn) may be interpreted to mean the same as the + backquoted form `(x1 x2 x3 ... xn . nil), thereby reducing it to + the previous case. + +* + `(x1 x2 x3 ... xn . ,form) may be interpreted to mean + + (append [ x1 ] [ x2 ] [ x3 ] ... [ xn ] form) + + where the brackets indicate a transformation of an xj as described + above. + +* + `(x1 x2 x3 ... xn . ,@form) has undefined consequences. + +* + `#(x1 x2 x3 ... xn) may be interpreted to mean (apply #'vector `(x1 + x2 x3 ... xn)). + + Anywhere ",@" may be used, the syntax ",." may be used instead to +indicate that it is permissible to operate destructively on the list +structure produced by the form following the ",." (in effect, to use +nconc instead of append). + + If the backquote syntax is nested, the innermost backquoted form +should be expanded first. This means that if several commas occur in a +row, the leftmost one belongs to the innermost backquote. + + An implementation is free to interpret a backquoted form F_1 as any +form F_2 that, when evaluated, will produce a result that is the same +under equal as the result implied by the above definition, provided that +the side-effect behavior of the substitute form F_2 is also consistent +with the description given above. The constructed copy of the template +might or might not share list structure with the template itself. As an +example, the above definition implies that + + `((,a b) ,c ,@d) + + will be interpreted as if it were + + (append (list (append (list a) (list 'b) 'nil)) (list c) d 'nil) + + but it could also be legitimately interpreted to mean any of the +following: + + (append (list (append (list a) (list 'b))) (list c) d) + (append (list (append (list a) '(b))) (list c) d) + (list* (cons a '(b)) c d) + (list* (cons a (list 'b)) c d) + (append (list (cons a '(b))) (list c) d) + (list* (cons a '(b)) c (copy-list d)) + +* Menu: + +* Notes about Backquote:: + + +File: gcl.info, Node: Notes about Backquote, Prev: Backquote, Up: Backquote + +2.4.6.1 Notes about Backquote +............................. + +Since the exact manner in which the Lisp reader will parse an expression +involving the backquote reader macro is not specified, an implementation +is free to choose any representation that preserves the semantics +described. + + Often an implementation will choose a representation that facilitates +pretty printing of the expression, so that (pprint `(a ,b)) will display +`(a ,b) and not, for example, (list 'a b). However, this is not a +requirement. + + Implementors who have no particular reason to make one choice or +another might wish to refer to IEEE Standard for the Scheme Programming +Language, which identifies a popular choice of representation for such +expressions that might provide useful to be useful compatibility for +some user communities. There is no requirement, however, that any +conforming implementation use this particular representation. This +information is provided merely for cross-reference purposes. + + +File: gcl.info, Node: Comma, Next: Sharpsign, Prev: Backquote, Up: Standard Macro Characters + +2.4.7 Comma +----------- + +The comma is part of the backquote syntax; see *note Backquote::. Comma +is invalid if used other than inside the body of a backquote expression +as described above. + + +File: gcl.info, Node: Sharpsign, Next: Re-Reading Abbreviated Expressions, Prev: Comma, Up: Standard Macro Characters + +2.4.8 Sharpsign +--------------- + +Sharpsign is a non-terminating dispatching macro character. It reads an +optional sequence of digits and then one more character, and uses that +character to select a function to run as a reader macro function. + + The standard syntax includes constructs introduced by the # +character. The syntax of these constructs is as follows: a character +that identifies the type of construct is followed by arguments in some +form. If the character is a letter, its case is not important; #O and +#o are considered to be equivalent, for example. + + Certain # constructs allow an unsigned decimal number to appear +between the # and the character. + + The reader macros associated with the dispatching macro character # +are described later in this section and summarized in Figure 2-19. + + dispatch char purpose dispatch char purpose + Backspace signals error { undefined* + Tab signals error } undefined* + Newline signals error + read-time conditional + Linefeed signals error - read-time conditional + Page signals error . read-time evaluation + Return signals error / undefined + Space signals error A, a array + ! undefined* B, b binary rational + " undefined C, c complex number + # reference to = label D, d undefined + $ undefined E, e undefined + % undefined F, f undefined + & undefined G, g undefined + ' function abbreviation H, h undefined + ( simple vector I, i undefined + ) signals error J, j undefined + * bit vector K, k undefined + , undefined L, l undefined + : uninterned symbol M, m undefined + ; undefined N, n undefined + < signals error O, o octal rational + = labels following object P, p pathname + > undefined Q, q undefined + ? undefined* R, r radix-n rational + @ undefined S, s structure + [ undefined* T, t undefined + \ character object U, u undefined + ] undefined* V, v undefined + ^ undefined W, w undefined + _ undefined X, x hexadecimal rational + ' undefined Y, y undefined + | balanced comment Z, z undefined + ~ undefined Rubout undefined + + Figure 2-19: Standard # Dispatching Macro Character Syntax + + + The combinations marked by an asterisk (*) are explicitly reserved to +the user. No conforming implementation defines them. + + Note also that digits do not appear in the preceding table. This is +because the notations #0, #1, ..., #9 are reserved for another purpose +which occupies the same syntactic space. When a digit follows a +sharpsign, it is not treated as a dispatch character. Instead, an +unsigned integer argument is accumulated and passed as an argument to +the reader macro for the character that follows the digits. For +example, #2A((1 2) (3 4)) is a use of #A with an argument of 2. + +* Menu: + +* Sharpsign Backslash:: +* Sharpsign Single-Quote:: +* Sharpsign Left-Parenthesis:: +* Sharpsign Asterisk:: +* Examples of Sharpsign Asterisk:: +* Sharpsign Colon:: +* Sharpsign Dot:: +* Sharpsign B:: +* Sharpsign O:: +* Sharpsign X:: +* Sharpsign R:: +* Sharpsign C:: +* Sharpsign A:: +* Sharpsign S:: +* Sharpsign P:: +* Sharpsign Equal-Sign:: +* Sharpsign Sharpsign:: +* Sharpsign Plus:: +* Sharpsign Minus:: +* Sharpsign Vertical-Bar:: +* Examples of Sharpsign Vertical-Bar:: +* Notes about Style for Sharpsign Vertical-Bar:: +* Sharpsign Less-Than-Sign:: +* Sharpsign Whitespace:: +* Sharpsign Right-Parenthesis:: + + +File: gcl.info, Node: Sharpsign Backslash, Next: Sharpsign Single-Quote, Prev: Sharpsign, Up: Sharpsign + +2.4.8.1 Sharpsign Backslash +........................... + +Syntax: #\<> + + When the token x is a single character long, this parses as the +literal character char. Uppercase and lowercase letters are +distinguished after #\; #\A and #\a denote different character objects. +Any single character works after #\, even those that are normally +special to read, such as left-parenthesis and right-parenthesis. + + In the single character case, the x must be followed by a +non-constituent character. After #\ is read, the reader backs up over +the slash and then reads a token, treating the initial slash as a single +escape character (whether it really is or not in the current readtable). + + When the token x is more than one character long, the x must have the +syntax of a symbol with no embedded package markers. In this case, the +sharpsign backslash notation parses as the character whose name is +(string-upcase x); see *note Character Names::. + + For information about how the Lisp printer prints character objects, +see *note Printing Characters::. + + +File: gcl.info, Node: Sharpsign Single-Quote, Next: Sharpsign Left-Parenthesis, Prev: Sharpsign Backslash, Up: Sharpsign + +2.4.8.2 Sharpsign Single-Quote +.............................. + +Any expression preceded by #' (sharpsign followed by single-quote), as +in #'expression, is treated by the Lisp reader as an abbreviation for +and parsed identically to the expression (function expression). See +function. For example, + + (apply #'+ l) == (apply (function +) l) + + +File: gcl.info, Node: Sharpsign Left-Parenthesis, Next: Sharpsign Asterisk, Prev: Sharpsign Single-Quote, Up: Sharpsign + +2.4.8.3 Sharpsign Left-Parenthesis +.................................. + +#( and ) are used to notate a simple vector. + + If an unsigned decimal integer appears between the # and (, it +specifies explicitly the length of the vector. The consequences are +undefined if the number of objects specified before the closing ) +exceeds the unsigned decimal integer. If the number of objects supplied +before the closing ) is less than the unsigned decimal integer but +greater than zero, the last object is used to fill all remaining +elements of the vector. + + [Editorial Note by Barmar: This should say "signals...".] The +consequences are undefined if the unsigned decimal integer is non-zero +and number of objects supplied before the closing ) is zero. For +example, + + #(a b c c c c) + #6(a b c c c c) + #6(a b c) + #6(a b c c) + + all mean the same thing: a vector of length 6 with elements a, b, and +four occurrences of c. Other examples follow: + + #(a b c) ;A vector of length 3 + #(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47) + ;A vector containing the primes below 50 + #() ;An empty vector + + The notation #() denotes an empty vector, as does #0(). + + For information on how the Lisp printer prints vectors, see *note +Printing Strings::, *note Printing Bit Vectors::, or *note Printing +Other Vectors::. + + +File: gcl.info, Node: Sharpsign Asterisk, Next: Examples of Sharpsign Asterisk, Prev: Sharpsign Left-Parenthesis, Up: Sharpsign + +2.4.8.4 Sharpsign Asterisk +.......................... + +Syntax: #*<> + + A simple bit vector is constructed containing the indicated bits (0's +and 1's), where the leftmost bit has index zero and the subsequent bits +have increasing indices. + + Syntax: #<>*<> + + With an argument n, the vector to be created is of length n. If the +number of bits is less than n but greater than zero, the last bit is +used to fill all remaining bits of the bit vector. + + The notations #* and #0* each denote an empty bit vector. + + Regardless of whether the optional numeric argument n is provided, +the token that follows the asterisk is delimited by a normal token +delimiter. However, (unless the value of *read-suppress* is true) an +error of type reader-error is signaled if that token is not composed +entirely of 0's and 1's, or if n was supplied and the token is composed +of more than n bits, or if n is greater than one, but no bits were +specified. Neither a single escape nor a multiple escape is permitted +in this token. + + For information on how the Lisp printer prints bit vectors, see *note +Printing Bit Vectors::. + + +File: gcl.info, Node: Examples of Sharpsign Asterisk, Next: Sharpsign Colon, Prev: Sharpsign Asterisk, Up: Sharpsign + +2.4.8.5 Examples of Sharpsign Asterisk +...................................... + +For example, + #*101111 + #6*101111 + #6*101 + #6*1011 + + all mean the same thing: a vector of length 6 with elements 1, 0, 1, +1, 1, and 1. + + For example: + + #* ;An empty bit-vector + + +File: gcl.info, Node: Sharpsign Colon, Next: Sharpsign Dot, Prev: Examples of Sharpsign Asterisk, Up: Sharpsign + +2.4.8.6 Sharpsign Colon +....................... + +Syntax: #:<> + + #: introduces an uninterned symbol whose name is symbol-name. Every +time this syntax is encountered, a distinct uninterned symbol is +created. The symbol-name must have the syntax of a symbol with no +package prefix. + + For information on how the Lisp reader prints uninterned symbols, see +*note Printing Symbols::. + + +File: gcl.info, Node: Sharpsign Dot, Next: Sharpsign B, Prev: Sharpsign Colon, Up: Sharpsign + +2.4.8.7 Sharpsign Dot +..................... + +#.foo is read as the object resulting from the evaluation of the object +represented by foo. The evaluation is done during the read process, +when the #. notation is encountered. The #. syntax therefore performs a +read-time evaluation of foo. + + The normal effect of #. is inhibited when the value of *read-eval* is +false. + + In that situation, an error of type reader-error is signaled. + + For an object that does not have a convenient printed representation, +a form that computes the object can be given using the #. notation. + + +File: gcl.info, Node: Sharpsign B, Next: Sharpsign O, Prev: Sharpsign Dot, Up: Sharpsign + +2.4.8.8 Sharpsign B +................... + +#Brational reads rational in binary (radix 2). For example, + + #B1101 == 13 ;1101_2 + #b101/11 == 5/3 + + The consequences are undefined if the token immediately following the +#B does not have the syntax of a binary (i.e., radix 2) rational. + + +File: gcl.info, Node: Sharpsign O, Next: Sharpsign X, Prev: Sharpsign B, Up: Sharpsign + +2.4.8.9 Sharpsign O +................... + +#Orational reads rational in octal (radix 8). For example, + + #o37/15 == 31/13 + #o777 == 511 + #o105 == 69 ;105_8 + + The consequences are undefined if the token immediately following the +#O does not have the syntax of an octal (i.e., radix 8) rational. + + +File: gcl.info, Node: Sharpsign X, Next: Sharpsign R, Prev: Sharpsign O, Up: Sharpsign + +2.4.8.10 Sharpsign X +.................... + +#Xrational reads rational in hexadecimal (radix 16). The digits above 9 +are the letters A through F (the lowercase letters a through f are also +acceptable). For example, + + #xF00 == 3840 + #x105 == 261 ;105_16 + + The consequences are undefined if the token immediately following the +#X does not have the syntax of a hexadecimal (i.e., radix 16) rational. + + +File: gcl.info, Node: Sharpsign R, Next: Sharpsign C, Prev: Sharpsign X, Up: Sharpsign + +2.4.8.11 Sharpsign R +.................... + +#nR + + #radixRrational reads rational in radix radix. radix must consist of +only digits that are interpreted as an integer in decimal radix; its +value must be between 2 and 36 (inclusive). Only valid digits for the +specified radix may be used. + + For example, #3r102 is another way of writing 11 (decimal), and +#11R32 is another way of writing 35 (decimal). For radices larger than +10, letters of the alphabet are used in order for the digits after 9. +No alternate # notation exists for the decimal radix since a decimal +point suffices. + + Figure 2-20 contains examples of the use of #B, #O, #X, and #R. + + #2r11010101 ;Another way of writing 213 decimal + #b11010101 ;Ditto + #b+11010101 ;Ditto + #o325 ;Ditto, in octal radix + #xD5 ;Ditto, in hexadecimal radix + #16r+D5 ;Ditto + #o-300 ;Decimal -192, written in base 8 + #3r-21010 ;Same thing in base 3 + #25R-7H ;Same thing in base 25 + #xACCEDED ;181202413, in hexadecimal radix + + Figure 2-20: Radix Indicator Example + + + The consequences are undefined if the token immediately following the +#nR does not have the syntax of a rational in radix n. + + +File: gcl.info, Node: Sharpsign C, Next: Sharpsign A, Prev: Sharpsign R, Up: Sharpsign + +2.4.8.12 Sharpsign C +.................... + +#C reads a following object, which must be a list of length two whose +elements are both reals. These reals denote, respectively, the real and +imaginary parts of a complex number. + + If the two parts as notated are not of the same data type, then they +are converted according to the rules of floating-point contagion +described in *note Contagion in Numeric Operations::. + + #C(real imag) is equivalent to #.(complex (quote real) (quote imag)), +except that #C is not affected by *read-eval*. See the function +complex. + + Figure 2-21 contains examples of the use of #C. + + #C(3.0s1 2.0s-1) ;A complex with small float parts. + #C(5 -3) ;A "Gaussian integer" + #C(5/3 7.0) ;Will be converted internally to #C(1.66666 7.0) + #C(0 1) ;The imaginary unit; that is, i. + + Figure 2-21: Complex Number Example + + + For further information, see *note Printing Complexes:: and *note +Syntax of a Complex::. + + +File: gcl.info, Node: Sharpsign A, Next: Sharpsign S, Prev: Sharpsign C, Up: Sharpsign + +2.4.8.13 Sharpsign A +.................... + +#nA + + #nAobject constructs an n-dimensional array, using object as the +value of the :initial-contents argument to make-array. + + For example, #2A((0 1 5) (foo 2 (hot dog))) represents a 2-by-3 +matrix: + + 0 1 5 + foo 2 (hot dog) + + In contrast, #1A((0 1 5) (foo 2 (hot dog))) represents a vector of +length 2 whose elements are lists: + + (0 1 5) (foo 2 (hot dog)) + + #0A((0 1 5) (foo 2 (hot dog))) represents a zero-dimensional array +whose sole element is a list: + + ((0 1 5) (foo 2 (hot dog))) + + #0A foo represents a zero-dimensional array whose sole element is the +symbol foo. The notation #1A foo is not valid because foo is not a +sequence. + + If some dimension of the array whose representation is being parsed +is found to be 0, all dimensions to the right (i.e., the higher numbered +dimensions) are also considered to be 0. + + For information on how the Lisp printer prints arrays, see *note +Printing Strings::, *note Printing Bit Vectors::, *note Printing Other +Vectors::, or *note Printing Other Arrays::. + + +File: gcl.info, Node: Sharpsign S, Next: Sharpsign P, Prev: Sharpsign A, Up: Sharpsign + +2.4.8.14 Sharpsign S +.................... + +#s(name slot1 value1 slot2 value2 ...) denotes a structure. This is +valid only if name is the name of a structure type already defined by +defstruct and if the structure type has a standard constructor function. +Let cm stand for the name of this constructor function; then this syntax +is equivalent to + + #.(cm keyword1 'value1 keyword2 'value2 ...) + + where each keywordj is the result of computing + + (intern (string slotj) (find-package 'keyword)) + + The net effect is that the constructor function is called with the +specified slots having the specified values. + + (This coercion feature is deprecated; in the future, keyword names +will be taken in the package they are read in, so symbols that are +actually in the KEYWORD package should be used if that is what is +desired.) + + Whatever object the constructor function returns is returned by the +#S syntax. + + For information on how the Lisp printer prints structures, see *note +Printing Structures::. + + +File: gcl.info, Node: Sharpsign P, Next: Sharpsign Equal-Sign, Prev: Sharpsign S, Up: Sharpsign + +2.4.8.15 Sharpsign P +.................... + +#P reads a following object, which must be a string. + + #P<> is equivalent to #.(parse-namestring +'<>), except that #P is not affected by *read-eval*. + + For information on how the Lisp printer prints pathnames, see *note +Printing Pathnames::. + + +File: gcl.info, Node: Sharpsign Equal-Sign, Next: Sharpsign Sharpsign, Prev: Sharpsign P, Up: Sharpsign + +2.4.8.16 Sharpsign Equal-Sign +............................. + +#n= + + #n=object reads as whatever object has object as its printed +representation. However, that object is labeled by n, a required +unsigned decimal integer, for possible reference by the syntax #n#. The +scope of the label is the expression being read by the outermost call to +read; within this expression, the same label may not appear twice. + + +File: gcl.info, Node: Sharpsign Sharpsign, Next: Sharpsign Plus, Prev: Sharpsign Equal-Sign, Up: Sharpsign + +2.4.8.17 Sharpsign Sharpsign +............................ + +#n# + + #n#, where n is a required unsigned decimal integer, provides a +reference to some object labeled by #n=; that is, #n# represents a +pointer to the same (eq) object labeled by #n=. For example, a +structure created in the variable y by this code: + + (setq x (list 'p 'q)) + (setq y (list (list 'a 'b) x 'foo x)) + (rplacd (last y) (cdr y)) + + could be represented in this way: + + ((a b) . #1=(#2=(p q) foo #2# . #1#)) + + Without this notation, but with *print-length* set to 10 and +*print-circle* set to nil, the structure would print in this way: + + ((a b) (p q) foo (p q) (p q) foo (p q) (p q) foo (p q) ...) + + A reference #n# may only occur after a label #n=; forward references +are not permitted. The reference may not appear as the labeled object +itself (that is, #n=#n#) may not be written because the object labeled +by #n= is not well defined in this case. + + +File: gcl.info, Node: Sharpsign Plus, Next: Sharpsign Minus, Prev: Sharpsign Sharpsign, Up: Sharpsign + +2.4.8.18 Sharpsign Plus +....................... + +#+ provides a read-time conditionalization facility; the syntax is +#+test expression. If the feature expression test succeeds, then this +textual notation represents an object whose printed representation is +expression. If the feature expression test fails, then this textual +notation is treated as whitespace_2; that is, it is as if the "#+ test +expression" did not appear and only a space appeared in its place. + + For a detailed description of success and failure in feature +expressions, see *note Feature Expressions::. + + #+ operates by first reading the feature expression and then skipping +over the form if the feature expression fails. + + While reading the test, the current package is the KEYWORD package. + + Skipping over the form is accomplished by binding *read-suppress* to +true and then calling read. + + For examples, see *note Examples of Feature Expressions::. + + +File: gcl.info, Node: Sharpsign Minus, Next: Sharpsign Vertical-Bar, Prev: Sharpsign Plus, Up: Sharpsign + +2.4.8.19 Sharpsign Minus +........................ + +#- is like #+ except that it skips the expression if the test succeeds; +that is, + + #-test expression == #+(not test) expression + + For examples, see *note Examples of Feature Expressions::. + + +File: gcl.info, Node: Sharpsign Vertical-Bar, Next: Examples of Sharpsign Vertical-Bar, Prev: Sharpsign Minus, Up: Sharpsign + +2.4.8.20 Sharpsign Vertical-Bar +............................... + +#|...|# is treated as a comment by the reader. It must be balanced with +respect to other occurrences of #| and |#, but otherwise may contain any +characters whatsoever. + + +File: gcl.info, Node: Examples of Sharpsign Vertical-Bar, Next: Notes about Style for Sharpsign Vertical-Bar, Prev: Sharpsign Vertical-Bar, Up: Sharpsign + +2.4.8.21 Examples of Sharpsign Vertical-Bar +........................................... + +The following are some examples that exploit the #|...|# notation: + + ;;; In this example, some debugging code is commented out with #|...|# + ;;; Note that this kind of comment can occur in the middle of a line + ;;; (because a delimiter marks where the end of the comment occurs) + ;;; where a semicolon comment can only occur at the end of a line + ;;; (because it comments out the rest of the line). + (defun add3 (n) #|(format t "~&Adding 3 to ~D." n)|# (+ n 3)) + + ;;; The examples that follow show issues related to #| ... |# nesting. + + ;;; In this first example, #| and |# always occur properly paired, + ;;; so nesting works naturally. + (defun mention-fun-fact-1a () + (format t "CL uses ; and #|...|# in comments.")) + => MENTION-FUN-FACT-1A + (mention-fun-fact-1a) + |> CL uses ; and #|...|# in comments. + => NIL + #| (defun mention-fun-fact-1b () + (format t "CL uses ; and #|...|# in comments.")) |# + (fboundp 'mention-fun-fact-1b) => NIL + + ;;; In this example, vertical-bar followed by sharpsign needed to appear + ;;; in a string without any matching sharpsign followed by vertical-bar + ;;; having preceded this. To compensate, the programmer has included a + ;;; slash separating the two characters. In case 2a, the slash is + ;;; unnecessary but harmless, but in case 2b, the slash is critical to + ;;; allowing the outer #| ... |# pair match. If the slash were not present, + ;;; the outer comment would terminate prematurely. + (defun mention-fun-fact-2a () + (format t "Don't use |\# unmatched or you'll get in trouble!")) + => MENTION-FUN-FACT-2A + (mention-fun-fact-2a) + |> Don't use |# unmatched or you'll get in trouble! + => NIL + #| (defun mention-fun-fact-2b () + (format t "Don't use |\# unmatched or you'll get in trouble!") |# + (fboundp 'mention-fun-fact-2b) => NIL + + ;;; In this example, the programmer attacks the mismatch problem in a + ;;; different way. The sharpsign vertical bar in the comment is not needed + ;;; for the correct parsing of the program normally (as in case 3a), but + ;;; becomes important to avoid premature termination of a comment when such + ;;; a program is commented out (as in case 3b). + (defun mention-fun-fact-3a () ; #| + (format t "Don't use |# unmatched or you'll get in trouble!")) + => MENTION-FUN-FACT-3A + (mention-fun-fact-3a) + |> Don't use |# unmatched or you'll get in trouble! + => NIL + #| + (defun mention-fun-fact-3b () ; #| + (format t "Don't use |# unmatched or you'll get in trouble!")) + |# + (fboundp 'mention-fun-fact-3b) => NIL + + +File: gcl.info, Node: Notes about Style for Sharpsign Vertical-Bar, Next: Sharpsign Less-Than-Sign, Prev: Examples of Sharpsign Vertical-Bar, Up: Sharpsign + +2.4.8.22 Notes about Style for Sharpsign Vertical-Bar +..................................................... + +Some text editors that purport to understand Lisp syntax treat any |...| +as balanced pairs that cannot nest (as if they were just balanced pairs +of the multiple escapes used in notating certain symbols). To +compensate for this deficiency, some programmers use the notation +#||...#||...||#...||# instead of #|...#|...|#...|#. Note that this +alternate usage is not a different reader macro; it merely exploits the +fact that the additional vertical-bars occur within the comment in a way +that tricks certain text editor into better supporting nested comments. +As such, one might sometimes see code like: + + #|| (+ #|| 3 ||# 4 5) ||# + + Such code is equivalent to: + + #| (+ #| 3 |# 4 5) |# + + +File: gcl.info, Node: Sharpsign Less-Than-Sign, Next: Sharpsign Whitespace, Prev: Notes about Style for Sharpsign Vertical-Bar, Up: Sharpsign + +2.4.8.23 Sharpsign Less-Than-Sign +................................. + +#< is not valid reader syntax. The Lisp reader will signal an error + + of type reader-error + + on encountering #<. This syntax is typically used in the printed +representation of objects that cannot be read back in. + + +File: gcl.info, Node: Sharpsign Whitespace, Next: Sharpsign Right-Parenthesis, Prev: Sharpsign Less-Than-Sign, Up: Sharpsign + +2.4.8.24 Sharpsign Whitespace +............................. + +# followed immediately by whitespace_1 is not valid reader syntax. The +Lisp reader will signal an error of type reader-error if it encounters +the reader macro notation # or #. + + +File: gcl.info, Node: Sharpsign Right-Parenthesis, Prev: Sharpsign Whitespace, Up: Sharpsign + +2.4.8.25 Sharpsign Right-Parenthesis +.................................... + +This is not valid reader syntax. + + The Lisp reader will signal an error + + of type reader-error + + upon encountering #). + + +File: gcl.info, Node: Re-Reading Abbreviated Expressions, Prev: Sharpsign, Up: Standard Macro Characters + +2.4.9 Re-Reading Abbreviated Expressions +---------------------------------------- + +Note that the Lisp reader will generally signal an error of type +reader-error when reading an expression_2 that has been abbreviated +because of length or level limits (see *print-level*, *print-length*, +and *print-lines*) due to restrictions on "..", "...", "#" followed by +whitespace_1, and "#)". + + +File: gcl.info, Node: Evaluation and Compilation, Next: Types and Classes, Prev: Syntax, Up: Top + +3 Evaluation and Compilation +**************************** + +* Menu: + +* Evaluation:: +* Compilation:: +* Declarations:: +* Lambda Lists:: +* Error Checking in Function Calls:: +* Traversal Rules and Side Effects:: +* Destructive Operations:: +* Evaluation and Compilation Dictionary:: + + +File: gcl.info, Node: Evaluation, Next: Compilation, Prev: Evaluation and Compilation, Up: Evaluation and Compilation + +3.1 Evaluation +============== + +Execution of code can be accomplished by a variety of means ranging from +direct interpretation of a form representing a program to invocation of +compiled code produced by a compiler. + + Evaluation is the process by which a program is executed in Common +Lisp. The mechanism of evaluation is manifested both implicitly through +the effect of the Lisp read-eval-print loop, and explicitly through the +presence of the functions eval, compile, compile-file, and load. Any of +these facilities might share the same execution strategy, or each might +use a different one. + + The behavior of a conforming program processed by eval and by +compile-file might differ; see *note Semantic Constraints::. + + Evaluation can be understood in terms of a model in which an +interpreter recursively traverses a form performing each step of the +computation as it goes. This model, which describes the semantics of +Common Lisp programs, is described in *note The Evaluation Model::. + +* Menu: + +* Introduction to Environments:: +* The Evaluation Model:: +* Lambda Expressions:: +* Closures and Lexical Binding:: +* Shadowing:: +* Extent:: +* Return Values:: + + +File: gcl.info, Node: Introduction to Environments, Next: The Evaluation Model, Prev: Evaluation, Up: Evaluation + +3.1.1 Introduction to Environments +---------------------------------- + +A binding is an association between a name and that which the name +denotes. Bindings are established in a lexical environment or a dynamic +environment by particular special operators. + + An environment is a set of bindings and other information used during +evaluation (e.g., to associate meanings with names). + + Bindings in an environment are partitioned into namespaces . A +single name can simultaneously have more than one associated binding per +environment, but can have only one associated binding per namespace. + +* Menu: + +* The Global Environment:: +* Dynamic Environments:: +* Lexical Environments:: +* The Null Lexical Environment:: +* Environment Objects:: + + +File: gcl.info, Node: The Global Environment, Next: Dynamic Environments, Prev: Introduction to Environments, Up: Introduction to Environments + +3.1.1.1 The Global Environment +.............................. + +The global environment is that part of an environment that contains +bindings with both indefinite scope and indefinite extent. The global +environment contains, among other things, the following: + +* + bindings of dynamic variables and constant variables. +* + bindings of functions, macros, and special operators. +* + + bindings of compiler macros. + +* + bindings of type and class names +* + information about proclamations. + + +File: gcl.info, Node: Dynamic Environments, Next: Lexical Environments, Prev: The Global Environment, Up: Introduction to Environments + +3.1.1.2 Dynamic Environments +............................ + +A dynamic environment for evaluation is that part of an environment that +contains bindings whose duration is bounded by points of establishment +and disestablishment within the execution of the form that established +the binding. A dynamic environment contains, among other things, the +following: + +* + bindings for dynamic variables. +* + information about active catch tags. +* + information about exit points established by unwind-protect. +* + information about active handlers and restarts. + + The dynamic environment that is active at any given point in the +execution of a program is referred to by definite reference as "the +current dynamic environment," or sometimes as just "the dynamic +environment." + + Within a given namespace, a name is said to be bound in a dynamic +environment if there is a binding associated with its name in the +dynamic environment or, if not, there is a binding associated with its +name in the global environment. + + +File: gcl.info, Node: Lexical Environments, Next: The Null Lexical Environment, Prev: Dynamic Environments, Up: Introduction to Environments + +3.1.1.3 Lexical Environments +............................ + +A lexical environment for evaluation at some position in a program is +that part of the environment that contains information having lexical +scope within the forms containing that position. A lexical environment +contains, among other things, the following: + +* + bindings of lexical variables and symbol macros. +* + bindings of functions and macros. (Implicit in this is information + about those compiler macros that are locally disabled.) +* + bindings of block tags. +* + bindings of go tags. +* + information about declarations. + + The lexical environment that is active at any given position in a +program being semantically processed is referred to by definite +reference as "the current lexical environment," or sometimes as just +"the lexical environment." + + Within a given namespace, a name is said to be bound in a lexical +environment if there is a binding associated with its name in the +lexical environment or, if not, there is a binding associated with its +name in the global environment. + + +File: gcl.info, Node: The Null Lexical Environment, Next: Environment Objects, Prev: Lexical Environments, Up: Introduction to Environments + +3.1.1.4 The Null Lexical Environment +.................................... + +The null lexical environment is equivalent to the global environment. + + Although in general the representation of an environment object is +implementation-dependent, nil can be used in any situation where an +environment object is called for in order to denote the null lexical +environment. + + +File: gcl.info, Node: Environment Objects, Prev: The Null Lexical Environment, Up: Introduction to Environments + +3.1.1.5 Environment Objects +........................... + +Some operators make use of an object, called an environment object , +that represents the set of lexical bindings needed to perform semantic +analysis on a form in a given lexical environment. The set of bindings +in an environment object may be a subset of the bindings that would be +needed to actually perform an evaluation; for example, values associated +with variable names and function names in the corresponding lexical +environment might not be available in an environment object. + + The type and nature of an environment object is +implementation-dependent. The values of environment parameters to macro +functions are examples of environment objects. + + The object nil when used as an environment object denotes the null +lexical environment; see *note The Null Lexical Environment::. + + +File: gcl.info, Node: The Evaluation Model, Next: Lambda Expressions, Prev: Introduction to Environments, Up: Evaluation + +3.1.2 The Evaluation Model +-------------------------- + +A Common Lisp system evaluates forms with respect to lexical, dynamic, +and global environments. The following sections describe the components +of the Common Lisp evaluation model. + +* Menu: + +* Form Evaluation:: +* Symbols as Forms:: +* Lexical Variables:: +* Dynamic Variables:: +* Constant Variables:: +* Symbols Naming Both Lexical and Dynamic Variables:: +* Conses as Forms:: +* Special Forms:: +* Macro Forms:: +* Function Forms:: +* Lambda Forms:: +* Self-Evaluating Objects:: +* Examples of Self-Evaluating Objects:: + + +File: gcl.info, Node: Form Evaluation, Next: Symbols as Forms, Prev: The Evaluation Model, Up: The Evaluation Model + +3.1.2.1 Form Evaluation +....................... + +Forms fall into three categories: symbols, conses, and self-evaluating +objects. The following sections explain these categories. + + +File: gcl.info, Node: Symbols as Forms, Next: Lexical Variables, Prev: Form Evaluation, Up: The Evaluation Model + +3.1.2.2 Symbols as Forms +........................ + +If a form is a symbol, then it is either a symbol macro or a variable. + + The symbol names a symbol macro if there is a binding of the symbol +as a symbol macro in the current lexical environment + + (see define-symbol-macro and symbol-macrolet). + + If the symbol is a symbol macro, its expansion function is obtained. +The expansion function is a function of two arguments, and is invoked by +calling the macroexpand hook with the expansion function as its first +argument, the symbol as its second argument, and an environment object +(corresponding to the current lexical environment) as its third +argument. The macroexpand hook, in turn, calls the expansion function +with the form as its first argument and the environment as its second +argument. The value of the expansion function, which is passed through +by the macroexpand hook, is a form. This resulting form is processed in +place of the original symbol. + + If a form is a symbol that is not a symbol macro, then it is the name +of a variable, and the value of that variable is returned. There are +three kinds of variables: lexical variables, dynamic variables, and +constant variables. A variable can store one object. The main +operations on a variable are to read_1 and to write_1 its value. + + An error of type unbound-variable should be signaled if an unbound +variable is referenced. + + Non-constant variables can be assigned by using setq or bound_3 by +using let. Figure 3-1 lists some defined names that are applicable to +assigning, binding, and defining variables. + + boundp let progv + defconstant let* psetq + defparameter makunbound set + defvar multiple-value-bind setq + lambda multiple-value-setq symbol-value + + Figure 3-1: Some Defined Names Applicable to Variables + + + The following is a description of each kind of variable. + + +File: gcl.info, Node: Lexical Variables, Next: Dynamic Variables, Prev: Symbols as Forms, Up: The Evaluation Model + +3.1.2.3 Lexical Variables +......................... + +A lexical variable is a variable that can be referenced only within the +lexical scope of the form that establishes that variable; lexical +variables have lexical scope. Each time a form creates a lexical +binding of a variable, a fresh binding is established. + + Within the scope of a binding for a lexical variable name, uses of +that name as a variable are considered to be references to that binding +except where the variable is shadowed_2 by a form that establishes a +fresh binding for that variable name, or by a form that locally declares +the name special. + + A lexical variable always has a value. There is no operator that +introduces a binding for a lexical variable without giving it an initial +value, nor is there any operator that can make a lexical variable be +unbound. + + Bindings of lexical variables are found in the lexical environment. + + +File: gcl.info, Node: Dynamic Variables, Next: Constant Variables, Prev: Lexical Variables, Up: The Evaluation Model + +3.1.2.4 Dynamic Variables +......................... + +A variable is a dynamic variable if one of the following conditions +hold: + +* + It is locally declared or globally proclaimed special. + +* + It occurs textually within a form that creates a dynamic binding + for a variable of the same name, and the binding is not shadowed_2 + by a form that creates a lexical binding of the same variable name. + + A dynamic variable can be referenced at any time in any program; +there is no textual limitation on references to dynamic variables. At +any given time, all dynamic variables with a given name refer to exactly +one binding, either in the dynamic environment or in the global +environment. + + The value part of the binding for a dynamic variable might be empty; +in this case, the dynamic variable is said to have no value, or to be +unbound. A dynamic variable can be made unbound by using makunbound. + + The effect of binding a dynamic variable is to create a new binding +to which all references to that dynamic variable in any program refer +for the duration of the evaluation of the form that creates the dynamic +binding. + + A dynamic variable can be referenced outside the dynamic extent of a +form that binds it. Such a variable is sometimes called a "global +variable" but is still in all respects just a dynamic variable whose +binding happens to exist in the global environment rather than in some +dynamic environment. + + A dynamic variable is unbound unless and until explicitly assigned a +value, except for those variables whose initial value is defined in this +specification or by an implementation. + + +File: gcl.info, Node: Constant Variables, Next: Symbols Naming Both Lexical and Dynamic Variables, Prev: Dynamic Variables, Up: The Evaluation Model + +3.1.2.5 Constant Variables +.......................... + +Certain variables, called constant variables, are reserved as "named +constants." The consequences are undefined if an attempt is made to +assign a value to, or create a binding for a constant variable, except +that a 'compatible' redefinition of a constant variable using +defconstant is permitted; see the macro defconstant. + + Keywords, symbols defined by Common Lisp or the implementation as +constant (such as nil, t, and pi), and symbols declared as constant +using defconstant are constant variables. + + +File: gcl.info, Node: Symbols Naming Both Lexical and Dynamic Variables, Next: Conses as Forms, Prev: Constant Variables, Up: The Evaluation Model + +3.1.2.6 Symbols Naming Both Lexical and Dynamic Variables +......................................................... + +The same symbol can name both a lexical variable and a dynamic variable, +but never in the same lexical environment. + + In the following example, the symbol x is used, at different times, +as the name of a lexical variable and as the name of a dynamic variable. + + (let ((x 1)) ;Binds a special variable X + (declare (special x)) + (let ((x 2)) ;Binds a lexical variable X + (+ x ;Reads a lexical variable X + (locally (declare (special x)) + x)))) ;Reads a special variable X + => 3 + + +File: gcl.info, Node: Conses as Forms, Next: Special Forms, Prev: Symbols Naming Both Lexical and Dynamic Variables, Up: The Evaluation Model + +3.1.2.7 Conses as Forms +....................... + +A cons that is used as a form is called a compound form. + + If the car of that compound form is a symbol, that symbol is the name +of an operator, and the form is either a special form, a macro form, or +a function form, depending on the function binding of the operator in +the current lexical environment. If the operator is neither a special +operator nor a macro name, it is assumed to be a function name (even if +there is no definition for such a function). + + If the car of the compound form is not a symbol, then that car must +be a lambda expression, in which case the compound form is a lambda +form. + + How a compound form is processed depends on whether it is classified +as a special form, a macro form, a function form, or a lambda form. + + +File: gcl.info, Node: Special Forms, Next: Macro Forms, Prev: Conses as Forms, Up: The Evaluation Model + +3.1.2.8 Special Forms +..................... + +A special form is a form with special syntax, special evaluation rules, +or both, possibly manipulating the evaluation environment, control flow, +or both. A special operator has access to the current lexical +environment and the current dynamic environment. Each special operator +defines the manner in which its subexpressions are treated--which are +forms, which are special syntax, etc. + + Some special operators create new lexical or dynamic environments for +use during the evaluation of subforms of the special form. For example, +block creates a new lexical environment that is the same as the one in +force at the point of evaluation of the block form with the addition of +a binding of the block name to an exit point from the block. + + The set of special operator names is fixed in Common Lisp; no way is +provided for the user to define a special operator. Figure 3-2 lists +all of the Common Lisp symbols that have definitions as special +operators. + + block let* return-from + catch load-time-value setq + eval-when locally symbol-macrolet + flet macrolet tagbody + function multiple-value-call the + go multiple-value-prog1 throw + if progn unwind-protect + labels progv + let quote + + Figure 3-2: Common Lisp Special Operators + + + +File: gcl.info, Node: Macro Forms, Next: Function Forms, Prev: Special Forms, Up: The Evaluation Model + +3.1.2.9 Macro Forms +................... + +If the operator names a macro, its associated macro function is applied +to the entire form and the result of that application is used in place +of the original form. + + Specifically, a symbol names a macro in a given lexical environment +if macro-function is true of the symbol and that environment. The +function returned by macro-function is a function of two arguments, +called the expansion function. The expansion function is invoked by +calling the macroexpand hook with the expansion function as its first +argument, the entire macro form as its second argument, and an +environment object (corresponding to the current lexical environment) as +its third argument. The macroexpand hook, in turn, calls the expansion +function with the form as its first argument and the environment as its +second argument. The value of the expansion function, which is passed +through by the macroexpand hook, is a form. The returned form is +evaluated in place of the original form. + + The consequences are undefined if a macro function destructively +modifies any part of its form argument. + + A macro name is not a function designator, and cannot be used as the +function argument to functions such as apply, funcall, or map. + + An implementation is free to implement a Common Lisp special operator +as a macro. An implementation is free to implement any macro operator +as a special operator, but only if an equivalent definition of the macro +is also provided. + + Figure 3-3 lists some defined names that are applicable to macros. + + *macroexpand-hook* macro-function macroexpand-1 + defmacro macroexpand macrolet + + Figure 3-3: Defined names applicable to macros + + + +File: gcl.info, Node: Function Forms, Next: Lambda Forms, Prev: Macro Forms, Up: The Evaluation Model + +3.1.2.10 Function Forms +....................... + +If the operator is a symbol naming a function, the form represents a +function form, and the cdr of the list contains the forms which when +evaluated will supply the arguments passed to the function. + + When a function name is not defined, an error of type +undefined-function should be signaled at run time; see *note Semantic +Constraints::. + + A function form is evaluated as follows: + + The subforms in the cdr of the original form are evaluated in +left-to-right order in the current lexical and dynamic environments. +The primary value of each such evaluation becomes an argument to the +named function; any additional values returned by the subforms are +discarded. + + The functional value of the operator is retrieved from the lexical +environment, and that function is invoked with the indicated arguments. + + Although the order of evaluation of the argument subforms themselves +is strictly left-to-right, it is not specified whether the definition of +the operator in a function form is looked up before the evaluation of +the argument subforms, after the evaluation of the argument subforms, or +between the evaluation of any two argument subforms if there is more +than one such argument subform. For example, the following might return +23 or~24. + + (defun foo (x) (+ x 3)) + (defun bar () (setf (symbol-function 'foo) #'(lambda (x) (+ x 4)))) + (foo (progn (bar) 20)) + + A binding for a function name can be established in one of several +ways. A binding for a function name in the global environment can be +established by defun, setf of fdefinition, setf of symbol-function, +ensure-generic-function, defmethod (implicitly, due to +ensure-generic-function), or defgeneric. A binding for a function name +in the lexical environment can be established by flet or labels. + + Figure 3-4 lists some defined names that are applicable to functions. + + apply fdefinition mapcan + call-arguments-limit flet mapcar + complement fmakunbound mapcon + constantly funcall mapl + defgeneric function maplist + defmethod functionp multiple-value-call + defun labels reduce + fboundp map symbol-function + + Figure 3-4: Some function-related defined names + + + +File: gcl.info, Node: Lambda Forms, Next: Self-Evaluating Objects, Prev: Function Forms, Up: The Evaluation Model + +3.1.2.11 Lambda Forms +..................... + +A lambda form is similar to a function form, except that the function +name is replaced by a lambda expression. + + A lambda form is equivalent to using funcall of a lexical closure of +the lambda expression on the given arguments. (In practice, some +compilers are more likely to produce inline code for a lambda form than +for an arbitrary named function that has been declared inline; however, +such a difference is not semantic.) + + For further information, see *note Lambda Expressions::. + + +File: gcl.info, Node: Self-Evaluating Objects, Next: Examples of Self-Evaluating Objects, Prev: Lambda Forms, Up: The Evaluation Model + +3.1.2.12 Self-Evaluating Objects +................................ + +A form that is neither a symbol nor a cons is defined to be a +self-evaluating object. Evaluating such an object yields the same +object as a result. + + Certain specific symbols and conses might also happen to be +"self-evaluating" but only as a special case of a more general set of +rules for the evaluation of symbols and conses; such objects are not +considered to be self-evaluating objects. + + The consequences are undefined if literal objects (including +self-evaluating objects) are destructively modified. + + +File: gcl.info, Node: Examples of Self-Evaluating Objects, Prev: Self-Evaluating Objects, Up: The Evaluation Model + +3.1.2.13 Examples of Self-Evaluating Objects +............................................ + +Numbers, pathnames, and arrays are examples of self-evaluating objects. + + 3 => 3 + #c(2/3 5/8) => #C(2/3 5/8) + #p"S:[BILL]OTHELLO.TXT" => #P"S:[BILL]OTHELLO.TXT" + #(a b c) => #(A B C) + "fred smith" => "fred smith" + + +File: gcl.info, Node: Lambda Expressions, Next: Closures and Lexical Binding, Prev: The Evaluation Model, Up: Evaluation + +3.1.3 Lambda Expressions +------------------------ + +In a lambda expression, the body is evaluated in a lexical environment +that is formed by adding the binding of each parameter in the lambda +list with the corresponding value from the arguments to the current +lexical environment. + + For further discussion of how bindings are established based on the +lambda list, see *note Lambda Lists::. + + The body of a lambda expression is an implicit progn; the values it +returns are returned by the lambda expression. + + +File: gcl.info, Node: Closures and Lexical Binding, Next: Shadowing, Prev: Lambda Expressions, Up: Evaluation + +3.1.4 Closures and Lexical Binding +---------------------------------- + +A lexical closure is a function that can refer to and alter the values +of lexical bindings established by binding forms that textually include +the function definition. + + Consider this code, where x is not declared special: + + (defun two-funs (x) + (list (function (lambda () x)) + (function (lambda (y) (setq x y))))) + (setq funs (two-funs 6)) + (funcall (car funs)) => 6 + (funcall (cadr funs) 43) => 43 + (funcall (car funs)) => 43 + + The function special form coerces a lambda expression into a closure +in which the lexical environment in effect when the special form is +evaluated is captured along with the lambda expression. + + The function two-funs returns a list of two functions, each of which +refers to the binding of the variable x created on entry to the function +two-funs when it was called. This variable has the value 6 initially, +but setq can alter this binding. The lexical closure created for the +first lambda expression does not "snapshot" the value 6 for x when the +closure is created; rather it captures the binding of x. The second +function can be used to alter the value in the same (captured) binding +(to 43, in the example), and this altered variable binding then affects +the value returned by the first function. + + In situations where a closure of a lambda expression over the same +set of bindings may be produced more than once, the various resulting +closures may or may not be identical, at the discretion of the +implementation. That is, two functions that are behaviorally +indistinguishable might or might not be identical. Two functions that +are behaviorally distinguishable are distinct. For example: + + (let ((x 5) (funs '())) + (dotimes (j 10) + (push #'(lambda (z) + (if (null z) (setq x 0) (+ x z))) + funs)) + funs) + + The result of the above form is a list of ten closures. Each +requires only the binding of x. It is the same binding in each case, +but the ten closure objects might or might not be identical. On the +other hand, the result of the form + + (let ((funs '())) + (dotimes (j 10) + (let ((x 5)) + (push (function (lambda (z) + (if (null z) (setq x 0) (+ x z)))) + funs))) + funs) + + is also a list of ten closures. However, in this case no two of the +closure objects can be identical because each closure is closed over a +distinct binding of x, and these bindings can be behaviorally +distinguished because of the use of setq. + + The result of the form + + (let ((funs '())) + (dotimes (j 10) + (let ((x 5)) + (push (function (lambda (z) (+ x z))) + funs))) + funs) + + is a list of ten closure objects that might or might not be +identical. A different binding of x is involved for each closure, but +the bindings cannot be distinguished because their values are the same +and immutable (there being no occurrence of setq on x). A compiler +could internally transform the form to + + (let ((funs '())) + (dotimes (j 10) + (push (function (lambda (z) (+ 5 z))) + funs)) + funs) + + where the closures may be identical. + + It is possible that a closure does not close over any variable +bindings. In the code fragment + + (mapcar (function (lambda (x) (+ x 2))) y) + + the function (lambda (x) (+ x 2)) contains no references to any +outside object. In this case, the same closure might be returned for +all evaluations of the function form. + + +File: gcl.info, Node: Shadowing, Next: Extent, Prev: Closures and Lexical Binding, Up: Evaluation + +3.1.5 Shadowing +--------------- + +If two forms that establish lexical bindings with the same name N are +textually nested, then references to N within the inner form refer to +the binding established by the inner form; the inner binding for N +shadows the outer binding for N. Outside the inner form but inside the +outer one, references to N refer to the binding established by the outer +form. For example: + + (defun test (x z) + (let ((z (* x 2))) + (print z)) + z) + + The binding of the variable z by let shadows the parameter binding +for the function test. The reference to the variable z in the print +form refers to the let binding. The reference to z at the end of the +function test refers to the parameter named z. + + Constructs that are lexically scoped act as if new names were +generated for each object on each execution. Therefore, dynamic +shadowing cannot occur. For example: + + (defun contorted-example (f g x) + (if (= x 0) + (funcall f) + (block here + (+ 5 (contorted-example g + #'(lambda () (return-from here 4)) + (- x 1)))))) + + Consider the call (contorted-example nil nil 2). This produces 4. +During the course of execution, there are three calls to +contorted-example, interleaved with two blocks: + + (contorted-example nil nil 2) + (block here_1 ...) + (contorted-example nil #'(lambda () (return-from here_1 4)) 1) + (block here_2 ...) + (contorted-example #'(lambda () (return-from here_1 4)) + #'(lambda () (return-from here_2 4)) + 0) + (funcall f) + where f => #'(lambda () (return-from here_1 4)) + (return-from here_1 4) + + At the time the funcall is executed there are two block exit points +outstanding, each apparently named here. The return-from form executed +as a result of the funcall operation refers to the outer outstanding +exit point (here_1), not the inner one (here_2). It refers to that exit +point textually visible at the point of execution of function (here +abbreviated by the #' syntax) that resulted in creation of the function +object actually invoked by funcall. + + If, in this example, one were to change the (funcall f) to (funcall +g), then the value of the call (contorted-example nil nil 2) would be 9. +The value would change because funcall would cause the execution of +(return-from here_2 4), thereby causing a return from the inner exit +point (here_2). When that occurs, the value 4 is returned from the +middle invocation of contorted-example, 5 is added to that to get 9, and +that value is returned from the outer block and the outermost call to +contorted-example. The point is that the choice of exit point returned +from has nothing to do with its being innermost or outermost; rather, it +depends on the lexical environment that is packaged up with a lambda +expression when function is executed. + + +File: gcl.info, Node: Extent, Next: Return Values, Prev: Shadowing, Up: Evaluation + +3.1.6 Extent +------------ + +Contorted-example works only because the function named by f is invoked +during the extent of the exit point. Once the flow of execution has +left the block, the exit point is disestablished. For example: + + (defun invalid-example () + (let ((y (block here #'(lambda (z) (return-from here z))))) + (if (numberp y) y (funcall y 5)))) + + One might expect the call (invalid-example) to produce 5 by the +following incorrect reasoning: let binds y to the value of block; this +value is a function resulting from the lambda expression. Because y is +not a number, it is invoked on the value 5. The return-from should then +return this value from the exit point named here, thereby exiting from +the block again and giving y the value 5 which, being a number, is then +returned as the value of the call to invalid-example. + + The argument fails only because exit points have dynamic extent. The +argument is correct up to the execution of return-from. The execution +of return-from should signal an error of type control-error, however, +not because it cannot refer to the exit point, but because it does +correctly refer to an exit point and that exit point has been +disestablished. + + A reference by name to a dynamic exit point binding such as a catch +tag refers to the most recently established binding of that name that +has not been disestablished. For example: + + (defun fun1 (x) + (catch 'trap (+ 3 (fun2 x)))) + (defun fun2 (y) + (catch 'trap (* 5 (fun3 y)))) + (defun fun3 (z) + (throw 'trap z)) + + Consider the call (fun1 7). The result is 10. At the time the throw +is executed, there are two outstanding catchers with the name trap: one +established within procedure fun1, and the other within procedure fun2. +The latter is the more recent, and so the value 7 is returned from catch +in fun2. Viewed from within fun3, the catch in fun2 shadows the one in +fun1. Had fun2 been defined as + + (defun fun2 (y) + (catch 'snare (* 5 (fun3 y)))) + + then the two exit points would have different names, and therefore +the one in fun1 would not be shadowed. The result would then have been +7. + + +File: gcl.info, Node: Return Values, Prev: Extent, Up: Evaluation + +3.1.7 Return Values +------------------- + +Ordinarily the result of calling a function is a single object. +Sometimes, however, it is convenient for a function to compute several +objects and return them. + + In order to receive other than exactly one value from a form, one of +several special forms or macros must be used to request those values. +If a form produces multiple values which were not requested in this way, +then the first value is given to the caller and all others are +discarded; if the form produces zero values, then the caller receives +nil as a value. + + Figure 3-5 lists some operators for receiving multiple values_2. +These operators can be used to specify one or more forms to evaluate and +where to put the values returned by those forms. + + multiple-value-bind multiple-value-prog1 return-from + multiple-value-call multiple-value-setq throw + multiple-value-list return + + Figure 3-5: Some operators applicable to receiving multiple values + + + The function values can produce multiple values_2. (values) returns +zero values; (values form) returns the primary value returned by form; +(values form1 form2) returns two values, the primary value of form1 and +the primary value of form2; and so on. + + See multiple-values-limit and values-list. + + +File: gcl.info, Node: Compilation, Next: Declarations, Prev: Evaluation, Up: Evaluation and Compilation + +3.2 Compilation +=============== + +* Menu: + +* Compiler Terminology:: +* Compilation Semantics:: +* File Compilation:: +* Literal Objects in Compiled Files:: +* Exceptional Situations in the Compiler:: + + +File: gcl.info, Node: Compiler Terminology, Next: Compilation Semantics, Prev: Compilation, Up: Compilation + +3.2.1 Compiler Terminology +-------------------------- + +The following terminology is used in this section. + + The compiler is a utility that translates code into an +implementation-dependent form that might be represented or executed +efficiently. The term compiler refers to both of the functions compile +and compile-file. + + The term compiled code refers to objects representing compiled +programs, such as objects constructed by compile or by load when loading +a compiled file. + + The term implicit compilation refers to compilation performed during +evaluation. + + The term literal object refers to a quoted object or a +self-evaluating object or an object that is a substructure of such an +object. A constant variable is not itself a literal object. + + The term coalesce is defined as follows. Suppose A and B are two +literal constants in the source code, and that A' and B' are the +corresponding objects in the compiled code. If A' and B' are eql but A +and B are not eql, then it is said that A and B have been coalesced by +the compiler. + + The term minimal compilation refers to actions the compiler must take +at compile time. These actions are specified in *note Compilation +Semantics::. + + The verb process refers to performing minimal compilation, +determining the time of evaluation for a form, and possibly evaluating +that form (if required). + + The term further compilation refers to implementation-dependent +compilation beyond minimal compilation. That is, processing does not +imply complete compilation. Block compilation and generation of +machine-specific instructions are examples of further compilation. +Further compilation is permitted to take place at run time. + + Four different environments relevant to compilation are +distinguished: the startup environment, the compilation environment, the +evaluation environment, and the run-time environment. + + The startup environment is the environment of the Lisp image from +which the compiler was invoked. + + The compilation environment is maintained by the compiler and is used +to hold definitions and declarations to be used internally by the +compiler. Only those parts of a definition needed for correct +compilation are saved. The compilation environment is used as the +environment argument to macro expanders called by the compiler. It is +unspecified whether a definition available in the compilation +environment can be used in an evaluation initiated in the startup +environment or evaluation environment. + + The evaluation environment is a run-time environment in which macro +expanders and code specified by eval-when to be evaluated are evaluated. +All evaluations initiated by the compiler take place in the evaluation +environment. + + The run-time environment is the environment in which the program +being compiled will be executed. + + The compilation environment inherits from the evaluation environment, +and the compilation environment and evaluation environment might be +identical. The evaluation environment inherits from the startup +environment, and the startup environment and evaluation environment +might be identical. + + The term compile time refers to the duration of time that the +compiler is processing source code. At compile time, only the +compilation environment and the evaluation environment are available. + + The term compile-time definition refers to a definition in the +compilation environment. For example, when compiling a file, the +definition of a function might be retained in the compilation +environment if it is declared inline. This definition might not be +available in the evaluation environment. + + The term run time refers to the duration of time that the loader is +loading compiled code or compiled code is being executed. At run time, +only the run-time environment is available. + + The term run-time definition refers to a definition in the run-time +environment. + + The term run-time compiler refers to the function compile or implicit +compilation, for which the compilation and run-time environments are +maintained in the same Lisp image. Note that when the run-time compiler +is used, the run-time environment and startup environment are the same. + + +File: gcl.info, Node: Compilation Semantics, Next: File Compilation, Prev: Compiler Terminology, Up: Compilation + +3.2.2 Compilation Semantics +--------------------------- + +Conceptually, compilation is a process that traverses code, performs +certain kinds of syntactic and semantic analyses using information (such +as proclamations and macro definitions) present in the compilation +environment, and produces equivalent, possibly more efficient code. + +* Menu: + +* Compiler Macros:: +* Purpose of Compiler Macros:: +* Naming of Compiler Macros:: +* When Compiler Macros Are Used:: +* Notes about the Implementation of Compiler Macros:: +* Minimal Compilation:: +* Semantic Constraints:: + + +File: gcl.info, Node: Compiler Macros, Next: Purpose of Compiler Macros, Prev: Compilation Semantics, Up: Compilation Semantics + +3.2.2.1 Compiler Macros +....................... + +A compiler macro can be defined for a name that also names a function or +macro. That is, it is possible for a function name to name both a +function and a compiler macro. + + A function name names a compiler macro if compiler-macro-function is +true of the function name in the lexical environment in which it +appears. Creating a lexical binding for the function name not only +creates a new local function or macro definition, but also shadows_2 the +compiler macro. + + The function returned by compiler-macro-function is a function of two +arguments, called the expansion function. To expand a compiler macro, +the expansion function is invoked by calling the macroexpand hook with +the expansion function as its first argument, the entire compiler macro +form as its second argument, and the current compilation environment (or +with the current lexical environment, if the form is being processed by +something other than compile-file) as its third argument. The +macroexpand hook, in turn, calls the expansion function with the form as +its first argument and the environment as its second argument. The +return value from the expansion function, which is passed through by the +macroexpand hook, might either be the same form, or else a form that +can, at the discretion of the code doing the expansion, be used in place +of the original form. + + *macroexpand-hook* compiler-macro-function define-compiler-macro + + Figure 3-6: Defined names applicable to compiler macros + + + +File: gcl.info, Node: Purpose of Compiler Macros, Next: Naming of Compiler Macros, Prev: Compiler Macros, Up: Compilation Semantics + +3.2.2.2 Purpose of Compiler Macros +.................................. + +The purpose of the compiler macro facility is to permit selective source +code transformations as optimization advice to the compiler. When a +compound form is being processed (as by the compiler), if the operator +names a compiler macro then the compiler macro function may be invoked +on the form, and the resulting expansion recursively processed in +preference to performing the usual processing on the original form +according to its normal interpretation as a function form or macro form. + + A compiler macro function, like a macro function, is a function of +two arguments: the entire call form and the environment. Unlike an +ordinary macro function, a compiler macro function can decline to +provide an expansion merely by returning a value that is the same as the +original form. The consequences are undefined if a compiler macro +function destructively modifies any part of its form argument. + + The form passed to the compiler macro function can either be a list +whose car is the function name, or a list whose car is funcall and whose +cadr is a list (function name); note that this affects destructuring of +the form argument by the compiler macro function. define-compiler-macro +arranges for destructuring of arguments to be performed correctly for +both possible formats. + + When compile-file chooses to expand a top level form that is a +compiler macro form, the expansion is also treated as a top level form +for the purposes of eval-when processing; see *note Processing of Top +Level Forms::. + + +File: gcl.info, Node: Naming of Compiler Macros, Next: When Compiler Macros Are Used, Prev: Purpose of Compiler Macros, Up: Compilation Semantics + +3.2.2.3 Naming of Compiler Macros +................................. + +Compiler macros may be defined for function names that name macros as +well as functions. + + Compiler macro definitions are strictly global. There is no +provision for defining local compiler macros in the way that macrolet +defines local macros. Lexical bindings of a function name shadow any +compiler macro definition associated with the name as well as its global +function or macro definition. + + Note that the presence of a compiler macro definition does not affect +the values returned by + + functions that access function definitions (e.g., fboundp) or macro +definitions (e.g., macroexpand). Compiler macros are global, and the +function compiler-macro-function is sufficient to resolve their +interaction with other lexical and global definitions. + + +File: gcl.info, Node: When Compiler Macros Are Used, Next: Notes about the Implementation of Compiler Macros, Prev: Naming of Compiler Macros, Up: Compilation Semantics + +3.2.2.4 When Compiler Macros Are Used +..................................... + +The presence of a compiler macro definition for a function or macro +indicates that it is desirable for the compiler to use the expansion of +the compiler macro instead of the original function form or macro form. +However, no language processor (compiler, evaluator, or other code +walker) is ever required to actually invoke compiler macro functions, or +to make use of the resulting expansion if it does invoke a compiler +macro function. + + When the compiler encounters a form during processing that represents +a call to a compiler macro name (that is not declared notinline), the +compiler might expand the compiler macro, and might use the expansion in +place of the original form. + + When eval encounters a form during processing that represents a call +to a compiler macro name (that is not declared notinline), eval might +expand the compiler macro, and might use the expansion in place of the +original form. + + There are two situations in which a compiler macro definition must +not be applied by any language processor: + +* + The global function name binding associated with the compiler macro + is shadowed by a lexical binding of the function name. + +* + The function name has been declared or proclaimed notinline and the + call form appears within the scope of the declaration. + + It is unspecified whether compiler macros are expanded or used in any +other situations. + diff --git a/info/gcl.info-2 b/info/gcl.info-2 new file mode 100644 index 0000000..d863e05 --- /dev/null +++ b/info/gcl.info-2 @@ -0,0 +1,8302 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: Notes about the Implementation of Compiler Macros, Next: Minimal Compilation, Prev: When Compiler Macros Are Used, Up: Compilation Semantics + +3.2.2.5 Notes about the Implementation of Compiler Macros +......................................................... + +Although it is technically permissible, as described above, for eval to +treat compiler macros in the same situations as compiler might, this is +not necessarily a good idea in interpreted implementations. + + Compiler macros exist for the purpose of trading compile-time speed +for run-time speed. Programmers who write compiler macros tend to +assume that the compiler macros can take more time than normal functions +and macros in order to produce code which is especially optimal for use +at run time. Since eval in an interpreted implementation might perform +semantic analysis of the same form multiple times, it might be +inefficient in general for the implementation to choose to call compiler +macros on every such evaluation. + + Nevertheless, the decision about what to do in these situations is +left to each implementation. + + +File: gcl.info, Node: Minimal Compilation, Next: Semantic Constraints, Prev: Notes about the Implementation of Compiler Macros, Up: Compilation Semantics + +3.2.2.6 Minimal Compilation +........................... + +Minimal compilation is defined as follows: + +* + All compiler macro calls appearing in the source code being + compiled are expanded, if at all, at compile time; they will not be + expanded at run time. + +* + All macro and symbol macro calls appearing in the source code being + compiled are expanded at compile time in such a way that they will + not be expanded again at run time. macrolet + + and symbol-macrolet + + are effectively replaced by forms corresponding to their bodies in + which calls to macros are replaced by their expansions. + +* + The first argument in a load-time-value + + form in source code processed by compile + + is evaluated at compile time; in source code processed by + compile-file , the compiler arranges for it to be evaluated at load + time. In either case, the result of the evaluation is remembered + and used later as the value of the load-time-value form at + execution time. + + +File: gcl.info, Node: Semantic Constraints, Prev: Minimal Compilation, Up: Compilation Semantics + +3.2.2.7 Semantic Constraints +............................ + +All conforming programs must obey the following constraints, which are +designed to minimize the observable differences between compiled and +interpreted programs: + +* + Definitions of any referenced macros must be present in the + compilation environment. Any form that is a list beginning with a + symbol that does not name a special operator or a macro defined in + the compilation environment is treated by the compiler as a + function call. + +* + Special proclamations for dynamic variables must be made in the + compilation environment. Any binding for which there is no special + declaration or proclamation in the compilation environment is + treated by the compiler as a lexical binding. + +* + The definition of a function that is defined and declared inline in + the compilation environment must be the same at run time. + +* + Within a function named F, the compiler may (but is not required + to) assume that an apparent recursive call to a function named F + refers to the same definition of F, unless that function has been + declared notinline. The consequences of redefining such a + recursively defined function F while it is executing are undefined. + +* + A call within a file to a named function that is defined in the + same file refers to that function, unless that function has been + declared notinline. The consequences are unspecified if functions + are redefined individually at run time or multiply defined in the + same file. + +* + The argument syntax and number of return values for all functions + whose ftype is declared at compile time must remain the same at run + time. + +* + Constant variables defined in the compilation environment must have + a similar value at run time. A reference to a constant variable in + source code is equivalent to a reference to a literal object that + is the value of the constant variable. + +* + Type definitions made with deftype or defstruct in the compilation + environment must retain the same definition at run time. Classes + defined by defclass in the compilation environment must be defined + at run time to have the same superclasses and same metaclass. + + This implies that subtype/supertype relationships of type + specifiers must not change between compile time and run time. + +* + Type declarations present in the compilation environment must + accurately describe the corresponding values at run time; + otherwise, the consequences are undefined. It is permissible for + an unknown type to appear in a declaration at compile time, though + a warning might be signaled in such a case. + +* + Except in the situations explicitly listed above, a function + defined in the evaluation environment is permitted to have a + different definition or a different signature at run time, and the + run-time definition prevails. + + Conforming programs should not be written using any additional +assumptions about consistency between the run-time environment and the +startup, evaluation, and compilation environments. + + Except where noted, when a compile-time and a run-time definition are +different, one of the following occurs at run time: + +* + an error of type error is signaled +* + the compile-time definition prevails +* + the run-time definition prevails + + If the compiler processes a function form whose operator is not +defined at compile time, no error is signaled at compile time. + + +File: gcl.info, Node: File Compilation, Next: Literal Objects in Compiled Files, Prev: Compilation Semantics, Up: Compilation + +3.2.3 File Compilation +---------------------- + +The function compile-file performs compilation of forms in a file +following the rules specified in *note Compilation Semantics::, and +produces an output file that can be loaded by using load. + + Normally, the top level forms appearing in a file compiled with +compile-file are evaluated only when the resulting compiled file is +loaded, and not when the file is compiled. However, it is typically the +case that some forms in the file need to be evaluated at compile time so +the remainder of the file can be read and compiled correctly. + + The eval-when special form can be used to control whether a top level +form is evaluated at compile time, load time, or both. It is possible +to specify any of three situations with eval-when, denoted by the +symbols :compile-toplevel, :load-toplevel, and :execute. For top level +eval-when forms, :compile-toplevel specifies that the compiler must +evaluate the body at compile time, and :load-toplevel specifies that the +compiler must arrange to evaluate the body at load time. For non-top +level eval-when forms, :execute specifies that the body must be executed +in the run-time environment. + + The behavior of this form can be more precisely understood in terms +of a model of how compile-file processes forms in a file to be compiled. +There are two processing modes, called "not-compile-time" and +"compile-time-too". + + Successive forms are read from the file by compile-file and processed +in not-compile-time mode; in this mode, compile-file arranges for forms +to be evaluated only at load time and not at compile time. When +compile-file is in compile-time-too mode, forms are evaluated both at +compile time and load time. + +* Menu: + +* Processing of Top Level Forms:: +* Processing of Defining Macros:: +* Constraints on Macros and Compiler Macros:: + + +File: gcl.info, Node: Processing of Top Level Forms, Next: Processing of Defining Macros, Prev: File Compilation, Up: File Compilation + +3.2.3.1 Processing of Top Level Forms +..................................... + +Processing of top level forms in the file compiler is defined as +follows: + +1. + If the form is a compiler macro form (not disabled by a notinline + declaration), the implementation might or might not choose to + compute the compiler macro expansion of the form and, having + performed the expansion, might or might not choose to process the + result as a top level form in the same processing mode + (compile-time-too or not-compile-time). If it declines to obtain + or use the expansion, it must process the original form. + +2. + If the form is a macro form, its macro expansion is computed and + processed as a top level form in the same processing mode + (compile-time-too or not-compile-time). + +3. + If the form is a progn form, each of its body forms is sequentially + processed as a top level form in the same processing mode. + +4. + If the form is a locally, macrolet, or symbol-macrolet, + compile-file establishes the appropriate bindings and processes the + body forms as top level forms with those bindings in effect in the + same processing mode. (Note that this implies that the lexical + environment in which top level forms are processed is not + necessarily the null lexical environment.) + +5. + If the form is an eval-when form, it is handled according to Figure + 3-7. + + plus .5 fil \offinterlineskip + CT LT E Mode Action New Mode + _________________________________________________ + Yes Yes -- -- Process compile-time-too + No Yes Yes CTT Process compile-time-too + No Yes Yes NCT Process not-compile-time + No Yes No -- Process not-compile-time + Yes No -- -- Evaluate -- + No No Yes CTT Evaluate -- + No No Yes NCT Discard -- + No No No -- Discard -- + + Figure 3-7: EVAL-WHEN processing + + Column CT indicates whether :compile-toplevel is specified. Column + LT indicates whether :load-toplevel is specified. Column E + indicates whether :execute is specified. Column Mode indicates the + processing mode; a dash (--) indicates that the processing mode is + not relevant. + + The Action column specifies one of three actions: + + + Process: process the body as top level forms in the specified + mode. + + + Evaluate: evaluate the body in the dynamic execution context + of the compiler, using the evaluation environment as the + global environment and the lexical environment in which the + eval-when appears. + + + Discard: ignore the form. + + The New Mode column indicates the new processing mode. A dash (--) + indicates the compiler remains in its current mode. + +6. + Otherwise, the form is a top level form that is not one of the + special cases. In compile-time-too mode, the compiler first + evaluates the form in the evaluation environment and then minimally + compiles it. In not-compile-time mode, the form is simply + minimally compiled. All subforms are treated as non-top-level + forms. + + Note that top level forms are processed in the order in which they + textually appear in the file and that each top level form read by + the compiler is processed before the next is read. However, the + order of processing (including macro expansion) of subforms that + are not top level forms and the order of further compilation is + unspecified as long as Common Lisp semantics are preserved. + + eval-when forms cause compile-time evaluation only at top level. +Both :compile-toplevel and :load-toplevel situation specifications are +ignored for non-top-level forms. For non-top-level forms, an eval-when +specifying the :execute situation is treated as an implicit progn +including the forms in the body of the eval-when form; otherwise, the +forms in the body are ignored. + + +File: gcl.info, Node: Processing of Defining Macros, Next: Constraints on Macros and Compiler Macros, Prev: Processing of Top Level Forms, Up: File Compilation + +3.2.3.2 Processing of Defining Macros +..................................... + +Defining macros (such as defmacro or defvar) appearing within a file +being processed by compile-file normally have compile-time side effects +which affect how subsequent forms in the same file are compiled. A +convenient model for explaining how these side effects happen is that +the defining macro expands into one or more eval-when forms, and that +the calls which cause the compile-time side effects to happen appear in +the body of an (eval-when (:compile-toplevel) ...) form. + + The compile-time side effects may cause information about the +definition to be stored differently than if the defining macro had been +processed in the 'normal' way (either interpretively or by loading the +compiled file). + + In particular, the information stored by the defining macros at +compile time might or might not be available to the interpreter (either +during or after compilation), or during subsequent calls to the +compiler. For example, the following code is nonportable because it +assumes that the compiler stores the macro definition of foo where it is +available to the interpreter: + + (defmacro foo (x) `(car ,x)) + (eval-when (:execute :compile-toplevel :load-toplevel) + (print (foo '(a b c)))) + + A portable way to do the same thing would be to include the macro +definition inside the eval-when form, as in: + + (eval-when (:execute :compile-toplevel :load-toplevel) + (defmacro foo (x) `(car ,x)) + (print (foo '(a b c)))) + + Figure 3-8 lists macros that make definitions available both in the +compilation and run-time environments. It is not specified whether +definitions made available in the compilation environment are available +in the evaluation environment, nor is it specified whether they are +available in subsequent compilation units or subsequent invocations of +the compiler. As with eval-when, these compile-time side effects happen +only when the defining macros appear at top level. + + declaim define-modify-macro defsetf + defclass define-setf-expander defstruct + defconstant defmacro deftype + define-compiler-macro defpackage defvar + define-condition defparameter + + Figure 3-8: Defining Macros That Affect the Compile-Time Environment + + + +File: gcl.info, Node: Constraints on Macros and Compiler Macros, Prev: Processing of Defining Macros, Up: File Compilation + +3.2.3.3 Constraints on Macros and Compiler Macros +................................................. + +Except where explicitly stated otherwise, no macro defined in the Common +Lisp standard produces an expansion that could cause any of the subforms +of the macro form to be treated as top level forms. If an +implementation also provides a special operator definition of a Common +Lisp macro, the special operator definition must be semantically +equivalent in this respect. + + Compiler macro expansions must also have the same top level +evaluation semantics as the form which they replace. This is of concern +both to conforming implementations and to conforming programs. + + +File: gcl.info, Node: Literal Objects in Compiled Files, Next: Exceptional Situations in the Compiler, Prev: File Compilation, Up: Compilation + +3.2.4 Literal Objects in Compiled Files +--------------------------------------- + +The functions eval and compile are required to ensure that literal +objects referenced within the resulting interpreted or compiled code +objects are the same as the corresponding objects in the source code. +compile-file, on the other hand, must produce a compiled file that, when +loaded with load, constructs the objects defined by the source code and +produces references to them. + + In the case of compile-file, objects constructed by load of the +compiled file cannot be spoken of as being the same as the objects +constructed at compile time, because the compiled file may be loaded +into a different Lisp image than the one in which it was compiled. This +section defines the concept of similarity which relates objects in the +evaluation environment to the corresponding objects in the run-time +environment. + + The constraints on literal objects described in this section apply +only to compile-file; eval and compile do not copy or coalesce +constants. + +* Menu: + +* Externalizable Objects:: +* Similarity of Literal Objects:: +* Similarity of Aggregate Objects:: +* Definition of Similarity:: +* Extensions to Similarity Rules:: +* Additional Constraints on Externalizable Objects:: + + +File: gcl.info, Node: Externalizable Objects, Next: Similarity of Literal Objects, Prev: Literal Objects in Compiled Files, Up: Literal Objects in Compiled Files + +3.2.4.1 Externalizable Objects +.............................. + +The fact that the file compiler represents literal objects externally in +a compiled file and must later reconstruct suitable equivalents of those +objects when that file is loaded imposes a need for constraints on the +nature of the objects that can be used as literal objects in code to be +processed by the file compiler. + + An object that can be used as a literal object in code to be +processed by the file compiler is called an externalizable object . + + We define that two objects are similar if they satisfy a two-place +conceptual equivalence predicate (defined below), which is independent +of the Lisp image so that the two objects in different Lisp images can +be understood to be equivalent under this predicate. Further, by +inspecting the definition of this conceptual predicate, the programmer +can anticipate what aspects of an object are reliably preserved by file +compilation. + + The file compiler must cooperate with the loader in order to assure +that in each case where an externalizable object is processed as a +literal object, the loader will construct a similar object. + + The set of objects that are externalizable objects are those for +which the new conceptual term "similar" is defined, such that when a +compiled file is loaded, an object can be constructed which can be shown +to be similar to the original object which existed at the time the file +compiler was operating. + + +File: gcl.info, Node: Similarity of Literal Objects, Next: Similarity of Aggregate Objects, Prev: Externalizable Objects, Up: Literal Objects in Compiled Files + +3.2.4.2 Similarity of Literal Objects +..................................... + + +File: gcl.info, Node: Similarity of Aggregate Objects, Next: Definition of Similarity, Prev: Similarity of Literal Objects, Up: Literal Objects in Compiled Files + +3.2.4.3 Similarity of Aggregate Objects +....................................... + +Of the types over which similarity is defined, some are treated as +aggregate objects. For these types, similarity is defined recursively. +We say that an object of these types has certain "basic qualities" and +to satisfy the similarity relationship, the values of the corresponding +qualities of the two objects must also be similar. + + +File: gcl.info, Node: Definition of Similarity, Next: Extensions to Similarity Rules, Prev: Similarity of Aggregate Objects, Up: Literal Objects in Compiled Files + +3.2.4.4 Definition of Similarity +................................ + +Two objects S (in source code) and C (in compiled code) are defined to +be similar if and only if they are both of one of the types listed here +(or defined by the implementation) and they both satisfy all additional +requirements of similarity indicated for that type. + +number + Two numbers S and C are similar if they are of the same type and + represent the same mathematical value. + +character + Two simple characters S and C are similar if they have similar code + attributes. + + Implementations providing additional, implementation-defined + attributes must define whether and how non-simple characters can be + regarded as similar. + +symbol + Two apparently uninterned symbols S and C are similar if their + names are similar. + + Two interned symbols S and C are similar if their names are + similar, and if either S is accessible in the current package at + compile time and C is accessible in the current package at load + time, or C is accessible in the package that is similar to the home + package of S. + + (Note that similarity of symbols is dependent on neither the + current readtable nor how the function read would parse the + characters in the name of the symbol.) + +package + Two packages S and C are similar if their names are similar. + + Note that although a package object is an externalizable object, + the programmer is responsible for ensuring that the corresponding + package is already in existence when code referencing it as a + literal object is loaded. The loader finds the corresponding + package object as if by calling find-package with that name as an + argument. An error is signaled by the loader if no package exists + at load time. + +random-state + Two random states S and C are similar if S would always produce the + same sequence of pseudo-random numbers as a copy_5 of C when given + as the random-state argument to the function random, assuming + equivalent limit arguments in each case. + + (Note that since C has been processed by the file compiler, it + cannot be used directly as an argument to random because random + would perform a side effect.) + +cons + Two conses, S and C, are similar if the car_2 of S is similar to + the car_2 of C, and the cdr_2 of S is similar to the cdr_2 of C. + +array + Two one-dimensional arrays, S and C, are similar if the length of S + is similar to the length of C, the actual array element type of S + is similar to the actual array element type of C, and each active + element of S is similar to the corresponding element of C. + + Two arrays of rank other than one, S and C, are similar if the rank + of S is similar to the rank of C, each dimension_1 of S is similar + to the corresponding dimension_1 of C, the actual array element + type of S is similar to the actual array element type of C, and + each element of S is similar to the corresponding element of C. + + In addition, if S is a simple array, then C must also be a simple + array. If S is a displaced array, has a fill pointer, or is + actually adjustable, C is permitted to lack any or all of these + qualities. + +hash-table + Two hash tables S and C are similar if they meet the following + three requirements: + + 1. + They both have the same test (e.g., they are both eql hash + tables). + + 2. + There is a unique one-to-one correspondence between the keys + of the two hash tables, such that the corresponding keys are + similar. + + 3. + For all keys, the values associated with two corresponding + keys are similar. + + If there is more than one possible one-to-one correspondence + between the keys of S and C, the consequences are unspecified. A + conforming program cannot use a table such as S as an + externalizable constant. + +pathname + Two pathnames S and C are similar if all corresponding pathname + components are similar. + +function + + Functions are not externalizable objects. + +structure-object and standard-object + + A general-purpose concept of similarity does not exist for + structures and standard objects. However, a conforming program is + permitted to define a make-load-form method for any class K defined + by that program that is a subclass of either structure-object or + standard-object. The effect of such a method is to define that an + object S of type K in source code is similar to an object C of type + K in compiled code if C was constructed from code produced by + calling make-load-form on S. + + +File: gcl.info, Node: Extensions to Similarity Rules, Next: Additional Constraints on Externalizable Objects, Prev: Definition of Similarity, Up: Literal Objects in Compiled Files + +3.2.4.5 Extensions to Similarity Rules +...................................... + +Some objects, such as streams, readtables, and methods are not +externalizable objects under the definition of similarity given above. +That is, such objects may not portably appear as literal objects in code +to be processed by the file compiler. + + An implementation is permitted to extend the rules of similarity, so +that other kinds of objects are externalizable objects for that +implementation. + + If for some kind of object, similarity is neither defined by this +specification nor by the implementation, then the file compiler must +signal an error upon encountering such an object as a literal constant. + + +File: gcl.info, Node: Additional Constraints on Externalizable Objects, Prev: Extensions to Similarity Rules, Up: Literal Objects in Compiled Files + +3.2.4.6 Additional Constraints on Externalizable Objects +........................................................ + +If two literal objects appearing in the source code for a single file +processed with the file compiler are the identical, the corresponding +objects in the compiled code must also be the identical. + + With the exception of symbols and packages, any two literal objects +in code being processed by the file compiler may be coalesced if and +only if they are similar; if they are either both symbols or both +packages, they may only be coalesced if and only if they are identical. + + Objects containing circular references can be externalizable objects. +The file compiler is required to preserve eqlness of substructures +within a file. Preserving eqlness means that subobjects that are the +same in the source code must be the same in the corresponding compiled +code. + + In addition, the following are constraints on the handling of literal +objects by the file compiler: + + array: If an array in the source code is a simple array, then the + corresponding array in the compiled code will also be a simple + array. If an array in the source code is displaced, has a fill + pointer, or is actually adjustable, the corresponding array in the + compiled code might lack any or all of these qualities. If an + array in the source code has a fill pointer, then the corresponding + array in the compiled code might be only the size implied by the + fill pointer. + + packages: The loader is required to find the corresponding package + object as if by calling find-package with the package name as an + argument. An error of type package-error is signaled if no package + of that name exists at load time. + + random-state: A constant random state object cannot be used as the + state argument to the function random because random modifies this + data structure. + + structure, standard-object: Objects of type structure-object and + standard-object may appear in compiled constants if there is an + appropriate make-load-form method defined for that type. + + The file compiler calls make-load-form on any object that is + referenced as a literal object if the object is a generalized + instance of standard-object, structure-object, condition, or any of + a (possibly empty) implementation-dependent set of other classes. + The file compiler only calls make-load-form once for any given + object within a single file. + + symbol: In order to guarantee that compiled files can be loaded + correctly, users must ensure that the packages referenced in those + files are defined consistently at compile time and load time. + Conforming programs must satisfy the following requirements: + + 1. + The current package when a top level form in the file is + processed by compile-file must be the same as the current + package when the code corresponding to that top level form in + the compiled file is executed by load. In particular: + + a. + Any top level form in a file that alters the current + package must change it to a package of the same name both + at compile time and at load time. + + b. + If the first non-atomic top level form in the file is not + an in-package form, then the current package at the time + load is called must be a package with the same name as + the package that was the current package at the time + compile-file was called. + + 2. + For all symbols appearing lexically within a top level form + that were accessible in the package that was the current + package during processing of that top level form at compile + time, but whose home package was another package, at load time + there must be a symbol with the same name that is accessible + in both the load-time current package and in the package with + the same name as the compile-time home package. + + 3. + For all symbols represented in the compiled file that were + external symbols in their home package at compile time, there + must be a symbol with the same name that is an external symbol + in the package with the same name at load time. + + If any of these conditions do not hold, the package in which the + loader looks for the affected symbols is unspecified. + Implementations are permitted to signal an error or to define this + behavior. + + +File: gcl.info, Node: Exceptional Situations in the Compiler, Prev: Literal Objects in Compiled Files, Up: Compilation + +3.2.5 Exceptional Situations in the Compiler +-------------------------------------------- + +compile and compile-file are permitted to signal errors and warnings, +including errors due to compile-time processing of (eval-when +(:compile-toplevel) ...) forms, macro expansion, and conditions signaled +by the compiler itself. + + Conditions of type error might be signaled by the compiler in +situations where the compilation cannot proceed without intervention. + + In addition to situations for which the standard specifies that +conditions of type warning must or might be signaled, warnings might be +signaled in situations where the compiler can determine that the +consequences are undefined or that a run-time error will be signaled. +Examples of this situation are as follows: violating type declarations, +altering or assigning the value of a constant defined with defconstant, +calling built-in Lisp functions with a wrong number of arguments or +malformed keyword argument lists, and using unrecognized declaration +specifiers. + + The compiler is permitted to issue warnings about matters of +programming style as conditions of type style-warning. Examples of this +situation are as follows: redefining a function using a different +argument list, calling a function with a wrong number of arguments, not +declaring ignore of a local variable that is not referenced, and +referencing a variable declared ignore. + + Both compile and compile-file are permitted (but not required) to +establish a handler for conditions of type error. For example, they +might signal a warning, and restart compilation from some +implementation-dependent point in order to let the compilation proceed +without manual intervention. + + Both compile and compile-file return three values, the second two +indicating whether the source code being compiled contained errors and +whether style warnings were issued. + + Some warnings might be deferred until the end of compilation. See +with-compilation-unit. + + +File: gcl.info, Node: Declarations, Next: Lambda Lists, Prev: Compilation, Up: Evaluation and Compilation + +3.3 Declarations +================ + +Declarations provide a way of specifying information for use by program +processors, such as the evaluator or the compiler. + + Local declarations + + can be embedded in executable code using declare. Global +declarations , or proclamations , are established by proclaim or +declaim. + + The the special form provides a shorthand notation for making a local +declaration about the type of the value of a given form. + + The consequences are undefined if a program violates a declaration or +a proclamation. + +* Menu: + +* Minimal Declaration Processing Requirements:: +* Declaration Specifiers:: +* Declaration Identifiers:: +* Declaration Scope:: + + +File: gcl.info, Node: Minimal Declaration Processing Requirements, Next: Declaration Specifiers, Prev: Declarations, Up: Declarations + +3.3.1 Minimal Declaration Processing Requirements +------------------------------------------------- + +In general, an implementation is free to ignore declaration specifiers +except for the declaration , notinline , safety , and special +declaration specifiers. + + A declaration declaration must suppress warnings about unrecognized +declarations of the kind that it declares. If an implementation does +not produce warnings about unrecognized declarations, it may safely +ignore this declaration. + + A notinline declaration must be recognized by any implementation that +supports inline functions or compiler macros in order to disable those +facilities. An implementation that does not use inline functions or +compiler macros may safely ignore this declaration. + + A safety declaration that increases the current safety level must +always be recognized. An implementation that always processes code as +if safety were high may safely ignore this declaration. + + A special declaration must be processed by all implementations. + + +File: gcl.info, Node: Declaration Specifiers, Next: Declaration Identifiers, Prev: Minimal Declaration Processing Requirements, Up: Declarations + +3.3.2 Declaration Specifiers +---------------------------- + +A declaration specifier is an expression that can appear at top level of +a declare expression or a declaim form, or as the argument to proclaim. +It is a list whose car is a declaration identifier, and whose cdr is +data interpreted according to rules specific to the declaration +identifier. + + +File: gcl.info, Node: Declaration Identifiers, Next: Declaration Scope, Prev: Declaration Specifiers, Up: Declarations + +3.3.3 Declaration Identifiers +----------------------------- + +Figure 3-9 shows a list of all declaration identifiers + + defined by this standard. + + declaration ignore special + dynamic-extent inline type + ftype notinline + ignorable optimize + + Figure 3-9: Common Lisp Declaration Identifiers + + + An implementation is free to support other (implementation-defined) +declaration identifiers as well. A warning might be issued if a +declaration identifier is not among those defined above, is not defined +by the implementation, is not a type name, and has not been declared in +a declaration proclamation. + +* Menu: + +* Shorthand notation for Type Declarations:: + + +File: gcl.info, Node: Shorthand notation for Type Declarations, Prev: Declaration Identifiers, Up: Declaration Identifiers + +3.3.3.1 Shorthand notation for Type Declarations +................................................ + +A type specifier can be used as a declaration identifier. +(type-specifier {var}*) is taken as shorthand for (type type-specifier +{var}*). + + +File: gcl.info, Node: Declaration Scope, Prev: Declaration Identifiers, Up: Declarations + +3.3.4 Declaration Scope +----------------------- + +Declarations can be divided into two kinds: those that apply to the +bindings of variables or functions; and those that do not apply to +bindings. + + A declaration that appears at the head of a binding form and applies +to a variable or function binding made by that form is called a bound +declaration ; such a declaration affects both the binding and any +references within the scope of the declaration. + + Declarations that are not bound declarations are called free +declarations . + + A free declaration in a form F1 that applies to a binding for a name +N established by some form F2 of which F1 is a subform affects only +references to N within F1; it does not to apply to other references to N +outside of F1, nor does it affect the manner in which the binding of N +by F2 is established. + + Declarations that do not apply to bindings can only appear as free +declarations. + + The scope of a bound declaration is the same as the lexical scope of +the binding to which it applies; for special variables, this means the +scope that the binding would have had had it been a lexical binding. + + Unless explicitly stated otherwise, the scope of a free declaration +includes only the body subforms of the form at whose head it appears, +and no other subforms. The scope of free declarations specifically does +not include initialization forms for bindings established by the form +containing the declarations. + + Some iteration forms include step, end-test, or result subforms that +are also included in the scope of declarations that appear in the +iteration form. Specifically, the iteration forms and subforms involved +are: + +* + do, do*: step-forms, end-test-form, and result-forms. +* + dolist, dotimes: result-form +* + do-all-symbols, do-external-symbols, do-symbols: result-form + +* Menu: + +* Examples of Declaration Scope:: + + +File: gcl.info, Node: Examples of Declaration Scope, Prev: Declaration Scope, Up: Declaration Scope + +3.3.4.1 Examples of Declaration Scope +..................................... + +Here is an example illustrating the scope of bound declarations. + + (let ((x 1)) ;[1] 1st occurrence of x + (declare (special x)) ;[2] 2nd occurrence of x + (let ((x 2)) ;[3] 3rd occurrence of x + (let ((old-x x) ;[4] 4th occurrence of x + (x 3)) ;[5] 5th occurrence of x + (declare (special x)) ;[6] 6th occurrence of x + (list old-x x)))) ;[7] 7th occurrence of x + => (2 3) + + The first occurrence of x establishes a dynamic binding of x because +of the special declaration for x in the second line. The third +occurrence of x establishes a lexical binding of x (because there is no +special declaration in the corresponding let form). The fourth +occurrence of x x is a reference to the lexical binding of x established +in the third line. The fifth occurrence of x establishes a dynamic +binding of x for the body of the let form that begins on that line +because of the special declaration for x in the sixth line. The +reference to x in the fourth line is not affected by the special +declaration in the sixth line because that reference is not within the +"would-be lexical scope" of the variable x in the fifth line. The +reference to x in the seventh line is a reference to the dynamic binding +of x established in the fifth line. + + Here is another example, to illustrate the scope of a free +declaration. In the following: + + (lambda (&optional (x (foo 1))) ;[1] + (declare (notinline foo)) ;[2] + (foo x)) ;[3] + + the call to foo in the first line might be compiled inline even +though the call to foo in the third line must not be. This is because +the notinline declaration for foo in the second line applies only to the +body on the third line. In order to suppress inlining for both calls, +one might write: + + (locally (declare (notinline foo)) ;[1] + (lambda (&optional (x (foo 1))) ;[2] + (foo x))) ;[3] + + or, alternatively: + + (lambda (&optional ;[1] + (x (locally (declare (notinline foo)) ;[2] + (foo 1)))) ;[3] + (declare (notinline foo)) ;[4] + (foo x)) ;[5] + + Finally, here is an example that shows the scope of declarations in +an iteration form. + + (let ((x 1)) ;[1] + (declare (special x)) ;[2] + (let ((x 2)) ;[3] + (dotimes (i x x) ;[4] + (declare (special x))))) ;[5] + => 1 + + In this example, the first reference to x on the fourth line is to +the lexical binding of x established on the third line. However, the +second occurrence of x on the fourth line lies within the scope of the +free declaration on the fifth line (because this is the result-form of +the dotimes) and therefore refers to the dynamic binding of x. + + +File: gcl.info, Node: Lambda Lists, Next: Error Checking in Function Calls, Prev: Declarations, Up: Evaluation and Compilation + +3.4 Lambda Lists +================ + +A lambda list is a list that specifies a set of parameters (sometimes +called lambda variables) and a protocol for receiving values for those +parameters. + + There are several kinds of lambda lists. + + Context Kind of Lambda List + defun form ordinary lambda list + defmacro form macro lambda list + lambda expression ordinary lambda list + flet local function definition ordinary lambda list + labels local function definition ordinary lambda list + handler-case clause specification ordinary lambda list + restart-case clause specification ordinary lambda list + macrolet local macro definition macro lambda list + define-method-combination ordinary lambda list + define-method-combination :arguments option define-method-combination arguments lambda list + defstruct :constructor option boa lambda list + defgeneric form generic function lambda list + defgeneric method clause specialized lambda list + defmethod form specialized lambda list + defsetf form defsetf lambda list + define-setf-expander form macro lambda list + deftype form deftype lambda list + destructuring-bind form destructuring lambda list + define-compiler-macro form macro lambda list + define-modify-macro form define-modify-macro lambda list + + Figure 3-10: What Kind of Lambda Lists to Use + + + Figure 3-11 lists some defined names that are applicable to lambda +lists. + + lambda-list-keywords lambda-parameters-limit + + Figure 3-11: Defined names applicable to lambda lists + + +* Menu: + +* Ordinary Lambda Lists:: +* Generic Function Lambda Lists:: +* Specialized Lambda Lists:: +* Macro Lambda Lists:: +* Destructuring Lambda Lists:: +* Boa Lambda Lists:: +* Defsetf Lambda Lists:: +* Deftype Lambda Lists:: +* Define-modify-macro Lambda Lists:: +* Define-method-combination Arguments Lambda Lists:: +* Syntactic Interaction of Documentation Strings and Declarations:: + + +File: gcl.info, Node: Ordinary Lambda Lists, Next: Generic Function Lambda Lists, Prev: Lambda Lists, Up: Lambda Lists + +3.4.1 Ordinary Lambda Lists +--------------------------- + +An ordinary lambda list is used to describe how a set of arguments is +received by an ordinary function. The defined names in Figure 3-12 are +those which use ordinary lambda lists: + + define-method-combination handler-case restart-case + defun labels + flet lambda + + Figure 3-12: Standardized Operators that use Ordinary Lambda Lists + + + An ordinary lambda list can contain the lambda list keywords shown in +Figure 3-13. + + &allow-other-keys &key &rest + &aux &optional + + Figure 3-13: Lambda List Keywords used by Ordinary Lambda Lists + + + Each element of a lambda list is either a parameter specifier or a +lambda list keyword. Implementations are free to provide additional +lambda list keywords. For a list of all lambda list keywords used by +the implementation, see lambda-list-keywords. + + The syntax for ordinary lambda lists is as follows: + + lambda-list ::=({var}* + [&optional {var | (var [init-form [supplied-p-parameter ]])}*] + [&rest var] + [&key {var | ({var | (keyword-name var)} [init-form [supplied-p-parameter]])}* pt [&allow-other-keys]] + [&aux {var | (var [init-form])}*]) + + A var or supplied-p-parameter must be a symbol that is not the name +of a constant variable. + + An init-form can be any form. Whenever any init-form is evaluated +for any parameter specifier, that form may refer to any parameter +variable to the left of the specifier in which the init-form appears, +including any supplied-p-parameter variables, and may rely on the fact +that no other parameter variable has yet been bound (including its own +parameter variable). + + A keyword-name can be any symbol, but by convention is normally a +keyword_1; all standardized functions follow that convention. + + An ordinary lambda list has five parts, any or all of which may be +empty. For information about the treatment of argument mismatches, see +*note Error Checking in Function Calls::. + +* Menu: + +* Specifiers for the required parameters:: +* Specifiers for optional parameters:: +* A specifier for a rest parameter:: +* Specifiers for keyword parameters:: +* Suppressing Keyword Argument Checking:: +* Examples of Suppressing Keyword Argument Checking:: +* Specifiers for &aux variables:: +* Examples of Ordinary Lambda Lists:: + + +File: gcl.info, Node: Specifiers for the required parameters, Next: Specifiers for optional parameters, Prev: Ordinary Lambda Lists, Up: Ordinary Lambda Lists + +3.4.1.1 Specifiers for the required parameters +.............................................. + +These are all the parameter specifiers up to the first lambda list +keyword; if there are no lambda list keywords, then all the specifiers +are for required parameters. Each required parameter is specified by a +parameter variable var. var is bound as a lexical variable unless it is +declared special. + + If there are n required parameters (n may be zero), there must be at +least n passed arguments, and the required parameters are bound to the +first n passed arguments; see *note Error Checking in Function Calls::. +The other parameters are then processed using any remaining arguments. + + +File: gcl.info, Node: Specifiers for optional parameters, Next: A specifier for a rest parameter, Prev: Specifiers for the required parameters, Up: Ordinary Lambda Lists + +3.4.1.2 Specifiers for optional parameters +.......................................... + +If &optional is present, the optional parameter specifiers are those +following &optional up to the next lambda list keyword or the end of the +list. If optional parameters are specified, then each one is processed +as follows. If any unprocessed arguments remain, then the parameter +variable var is bound to the next remaining argument, just as for a +required parameter. If no arguments remain, however, then init-form is +evaluated, and the parameter variable is bound to the resulting value +(or to nil if no init-form appears in the parameter specifier). If +another variable name supplied-p-parameter appears in the specifier, it +is bound to true if an argument had been available, and to false if no +argument remained (and therefore init-form had to be evaluated). +Supplied-p-parameter is bound not to an argument but to a value +indicating whether or not an argument had been supplied for the +corresponding var. + + +File: gcl.info, Node: A specifier for a rest parameter, Next: Specifiers for keyword parameters, Prev: Specifiers for optional parameters, Up: Ordinary Lambda Lists + +3.4.1.3 A specifier for a rest parameter +........................................ + +&rest, if present, must be followed by a single rest parameter +specifier, which in turn must be followed by another lambda list keyword +or the end of the lambda list. After all optional parameter specifiers +have been processed, then there may or may not be a rest parameter. If +there is a rest parameter, it is bound to a list of all +as-yet-unprocessed arguments. If no unprocessed arguments remain, the +rest parameter is bound to the empty list. If there is no rest +parameter and there are no keyword parameters, then an error should be +signaled if any unprocessed arguments remain; see *note Error Checking +in Function Calls::. The value of a rest parameter is permitted, but +not required, to share structure with the last argument to apply. + + +File: gcl.info, Node: Specifiers for keyword parameters, Next: Suppressing Keyword Argument Checking, Prev: A specifier for a rest parameter, Up: Ordinary Lambda Lists + +3.4.1.4 Specifiers for keyword parameters +......................................... + +If &key is present, all specifiers up to the next lambda list keyword or +the end of the list are keyword parameter specifiers. When keyword +parameters are processed, the same arguments are processed that would be +made into a list for a rest parameter. It is permitted to specify both +&rest and &key. In this case the remaining arguments are used for both +purposes; that is, all remaining arguments are made into a list for the +rest parameter, and are also processed for the &key parameters. + + If &key is specified, there must remain an even number of arguments; +see *note Odd Number of Keyword Arguments::. + + These arguments are considered as pairs, the first argument in each +pair being interpreted as a name and the second as the corresponding +value. The first object of each pair must be a symbol; see *note +Invalid Keyword Arguments::. The keyword parameter specifiers may +optionally be followed by the lambda list keyword &allow-other-keys. + + In each keyword parameter specifier must be a name var for the +parameter variable. + + If the var appears alone or in a (var init-form) combination, the +keyword name used when matching arguments to parameters is a symbol in +the KEYWORD package whose name is the same (under string=) as var's. If +the notation ((keyword-name var) init-form) is used, then the keyword +name used to match arguments to parameters is keyword-name, which may be +a symbol in any package. (Of course, if it is not a symbol in the +KEYWORD package, it does not necessarily self-evaluate, so care must be +taken when calling the function to make sure that normal evaluation +still yields the keyword name.) + + Thus + + (defun foo (&key radix (type 'integer)) ...) + + means exactly the same as + + (defun foo (&key ((:radix radix)) ((:type type) 'integer)) ...) + + The keyword parameter specifiers are, like all parameter specifiers, +effectively processed from left to right. For each keyword parameter +specifier, if there is an argument pair whose name matches that +specifier's name (that is, the names are eq), then the parameter +variable for that specifier is bound to the second item (the value) of +that argument pair. If more than one such argument pair matches, the +leftmost argument pair is used. If no such argument pair exists, then +the init-form for that specifier is evaluated and the parameter variable +is bound to that value (or to nil if no init-form was specified). +supplied-p-parameter is treated as for &optional parameters: it is bound +to true if there was a matching argument pair, and to false otherwise. + + Unless keyword argument checking is suppressed, an argument pair must +a name matched by a parameter specifier; see *note Unrecognized Keyword +Arguments::. + + If keyword argument checking is suppressed, then it is permitted for +an argument pair to match no parameter specifier, and the argument pair +is ignored, but such an argument pair is accessible through the rest +parameter if one was supplied. The purpose of these mechanisms is to +allow sharing of argument lists among several lambda expressions and to +allow either the caller or the called lambda expression to specify that +such sharing may be taking place. + + Note that if &key is present, a keyword argument of :allow-other-keys +is always permitted--regardless of whether the associated value is true +or false. However, if the value is false, other non-matching keywords +are not tolerated (unless &allow-other-keys was used). + + Furthermore, if the receiving argument list specifies a regular +argument which would be flagged by :allow-other-keys, then +:allow-other-keys has both its special-cased meaning (identifying +whether additional keywords are permitted) and its normal meaning (data +flow into the function in question). + + +File: gcl.info, Node: Suppressing Keyword Argument Checking, Next: Examples of Suppressing Keyword Argument Checking, Prev: Specifiers for keyword parameters, Up: Ordinary Lambda Lists + +3.4.1.5 Suppressing Keyword Argument Checking +............................................. + +If &allow-other-keys was specified in the lambda list of a function, +keyword_2 argument checking is suppressed in calls to that function. + + If the :allow-other-keys argument is true in a call to a function, +keyword_2 argument checking is suppressed in that call. + + The :allow-other-keys argument is permissible in all situations +involving keyword_2 arguments, even when its associated value is false. + + +File: gcl.info, Node: Examples of Suppressing Keyword Argument Checking, Next: Specifiers for &aux variables, Prev: Suppressing Keyword Argument Checking, Up: Ordinary Lambda Lists + +3.4.1.6 Examples of Suppressing Keyword Argument Checking +......................................................... + + ;;; The caller can supply :ALLOW-OTHER-KEYS T to suppress checking. + ((lambda (&key x) x) :x 1 :y 2 :allow-other-keys t) => 1 + ;;; The callee can use &ALLOW-OTHER-KEYS to suppress checking. + ((lambda (&key x &allow-other-keys) x) :x 1 :y 2) => 1 + ;;; :ALLOW-OTHER-KEYS NIL is always permitted. + ((lambda (&key) t) :allow-other-keys nil) => T + ;;; As with other keyword arguments, only the left-most pair + ;;; named :ALLOW-OTHER-KEYS has any effect. + ((lambda (&key x) x) + :x 1 :y 2 :allow-other-keys t :allow-other-keys nil) + => 1 + ;;; Only the left-most pair named :ALLOW-OTHER-KEYS has any effect, + ;;; so in safe code this signals a PROGRAM-ERROR (and might enter the + ;;; debugger). In unsafe code, the consequences are undefined. + ((lambda (&key x) x) ;This call is not valid + :x 1 :y 2 :allow-other-keys nil :allow-other-keys t) + + +File: gcl.info, Node: Specifiers for &aux variables, Next: Examples of Ordinary Lambda Lists, Prev: Examples of Suppressing Keyword Argument Checking, Up: Ordinary Lambda Lists + +3.4.1.7 Specifiers for &aux variables +..................................... + +These are not really parameters. If the lambda list keyword &aux is +present, all specifiers after it are auxiliary variable specifiers. +After all parameter specifiers have been processed, the auxiliary +variable specifiers (those following &aux) are processed from left to +right. For each one, init-form is evaluated and var is bound to that +value (or to nil if no init-form was specified). &aux variable +processing is analogous to let* processing. + + (lambda (x y &aux (a (car x)) (b 2) c) (list x y a b c)) + == (lambda (x y) (let* ((a (car x)) (b 2) c) (list x y a b c))) + + +File: gcl.info, Node: Examples of Ordinary Lambda Lists, Prev: Specifiers for &aux variables, Up: Ordinary Lambda Lists + +3.4.1.8 Examples of Ordinary Lambda Lists +......................................... + +Here are some examples involving optional parameters and rest +parameters: + + ((lambda (a b) (+ a (* b 3))) 4 5) => 19 + ((lambda (a &optional (b 2)) (+ a (* b 3))) 4 5) => 19 + ((lambda (a &optional (b 2)) (+ a (* b 3))) 4) => 10 + ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x))) + => (2 NIL 3 NIL NIL) + ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6) + => (6 T 3 NIL NIL) + ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3) + => (6 T 3 T NIL) + ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3 8) + => (6 T 3 T (8)) + ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) + 6 3 8 9 10 11) + => (6 t 3 t (8 9 10 11)) + + Here are some examples involving keyword parameters: + + ((lambda (a b &key c d) (list a b c d)) 1 2) => (1 2 NIL NIL) + ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6) => (1 2 6 NIL) + ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8) => (1 2 NIL 8) + ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6 :d 8) => (1 2 6 8) + ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8 :c 6) => (1 2 6 8) + ((lambda (a b &key c d) (list a b c d)) :a 1 :d 8 :c 6) => (:a 1 6 8) + ((lambda (a b &key c d) (list a b c d)) :a :b :c :d) => (:a :b :d NIL) + ((lambda (a b &key ((:sea c)) d) (list a b c d)) 1 2 :sea 6) => (1 2 6 NIL) + ((lambda (a b &key ((c c)) d) (list a b c d)) 1 2 'c 6) => (1 2 6 NIL) + + Here are some examples involving optional parameters, rest +parameters, and keyword parameters together: + + ((lambda (a &optional (b 3) &rest x &key c (d a)) + (list a b c d x)) 1) + => (1 3 NIL 1 ()) + ((lambda (a &optional (b 3) &rest x &key c (d a)) + (list a b c d x)) 1 2) + => (1 2 NIL 1 ()) + ((lambda (a &optional (b 3) &rest x &key c (d a)) + (list a b c d x)) :c 7) + => (:c 7 NIL :c ()) + ((lambda (a &optional (b 3) &rest x &key c (d a)) + (list a b c d x)) 1 6 :c 7) + => (1 6 7 1 (:c 7)) + ((lambda (a &optional (b 3) &rest x &key c (d a)) + (list a b c d x)) 1 6 :d 8) + => (1 6 NIL 8 (:d 8)) + ((lambda (a &optional (b 3) &rest x &key c (d a)) + (list a b c d x)) 1 6 :d 8 :c 9 :d 10) + => (1 6 9 8 (:d 8 :c 9 :d 10)) + + As an example of the use of &allow-other-keys and :allow-other-keys, +consider a function that takes two named arguments of its own and also +accepts additional named arguments to be passed to make-array: + + (defun array-of-strings (str dims &rest named-pairs + &key (start 0) end &allow-other-keys) + (apply #'make-array dims + :initial-element (subseq str start end) + :allow-other-keys t + named-pairs)) + + This function takes a string and dimensioning information and returns +an array of the specified dimensions, each of whose elements is the +specified string. However, :start and :end named arguments may be used +to specify that a substring of the given string should be used. In +addition, the presence of &allow-other-keys in the lambda list indicates +that the caller may supply additional named arguments; the rest +parameter provides access to them. These additional named arguments are +passed to make-array. The function make-array normally does not allow +the named arguments :start and :end to be used, and an error should be +signaled if such named arguments are supplied to make-array. However, +the presence in the call to make-array of the named argument +:allow-other-keys with a true value causes any extraneous named +arguments, including :start and :end, to be acceptable and ignored. + + +File: gcl.info, Node: Generic Function Lambda Lists, Next: Specialized Lambda Lists, Prev: Ordinary Lambda Lists, Up: Lambda Lists + +3.4.2 Generic Function Lambda Lists +----------------------------------- + +A generic function lambda list is used to describe the overall shape of +the argument list to be accepted by a generic function. Individual +method signatures might contribute additional keyword parameters to the +lambda list of the effective method. + + A generic function lambda list is used by defgeneric. + + A generic function lambda list has the following syntax: + + lambda-list ::=({var}* [&optional {var | (var)}*] + [&rest var] + [&key {var | ({var | (keyword-name var)})}* pt [&allow-other-keys]]) + + + A generic function lambda list can contain the lambda list keywords +shown in Figure 3-14. + + &allow-other-keys &optional + &key &rest + + Figure 3-14: Lambda List Keywords used by Generic Function Lambda Lists + + + A generic function lambda list differs from an ordinary lambda list +in the following ways: + +Required arguments + Zero or more required parameters must be specified. + +Optional and keyword arguments + Optional parameters and keyword parameters may not have default + initial value forms nor use supplied-p parameters. + +Use of &aux + The use of &aux is not allowed. + + +File: gcl.info, Node: Specialized Lambda Lists, Next: Macro Lambda Lists, Prev: Generic Function Lambda Lists, Up: Lambda Lists + +3.4.3 Specialized Lambda Lists +------------------------------ + +A specialized lambda list is used to specialize a method for a +particular signature and to describe how arguments matching that +signature are received by the method. The defined names in Figure 3-15 +use specialized lambda lists in some way; see the dictionary entry for +each for information about how. + + defmethod defgeneric + + Figure 3-15: Standardized Operators that use Specialized Lambda Lists + + + A specialized lambda list can contain the lambda list keywords shown +in Figure 3-16. + + &allow-other-keys &key &rest + &aux &optional + + Figure 3-16: Lambda List Keywords used by Specialized Lambda Lists + + + A specialized lambda list is syntactically the same as an ordinary +lambda list except that each required parameter may optionally be +associated with a class or object for which that parameter is +specialized. + + lambda-list ::=({var | (var [specializer])}* + [&optional {var | (var [init-form [supplied-p-parameter]])}*] + [&rest var] + [&key {var | ({var | (keyword-name var)} [init-form [supplied-p-parameter]])}* [&allow-other-keys]] + [&aux {var | (var [init-form])}*]) + + +File: gcl.info, Node: Macro Lambda Lists, Next: Destructuring Lambda Lists, Prev: Specialized Lambda Lists, Up: Lambda Lists + +3.4.4 Macro Lambda Lists +------------------------ + +A macro lambda list is used in describing macros defined by the +operators in Figure 3-17. + + define-compiler-macro defmacro macrolet + define-setf-expander + + Figure 3-17: Operators that use Macro Lambda Lists + + + With the additional restriction that an environment parameter may +appear only once (at any of the positions indicated), a macro lambda +list has the following syntax: + + reqvars ::={var | !pattern}* + + optvars ::=[&optional {var | ({var | !pattern} [init-form [supplied-p-parameter]])}*] + + restvar ::=[{&rest | &body} {var | !pattern}] + + keyvars ::=[&key {var | ({var | (keyword-name {var | !pattern})} [init-form [supplied-p-parameter]])}* + [&allow-other-keys]] + + auxvars ::=[&aux {var | (var [init-form])}*] + + envvar ::=[&environment var] + + wholevar ::=[&whole var] + + lambda-list ::=(!wholevar !envvar !reqvars !envvar !optvars !envvar + !restvar !envvar !keyvars !envvar !auxvars !envvar) | + (!wholevar !envvar !reqvars !envvar !optvars !envvar . var) + + pattern ::=(!wholevar !reqvars !optvars !restvar !keyvars !auxvars) | + (!wholevar !reqvars !optvars . var) + + A macro lambda list can contain the lambda list keywords shown in +Figure 3-18. + + &allow-other-keys &environment &rest + &aux &key &whole + &body &optional + + Figure 3-18: Lambda List Keywords used by Macro Lambda Lists + + + Optional parameters (introduced by &optional) and keyword parameters +(introduced by &key) can be supplied in a macro lambda list, just as in +an ordinary lambda list. Both may contain default initialization forms +and supplied-p parameters. + + &body + + is identical in function to &rest, but it can be used to inform +certain output-formatting and editing functions that the remainder of +the form is treated as a body, and should be indented accordingly. Only +one of &body or &rest can be used at any particular level; see *note +Destructuring by Lambda Lists::. + + &body can appear at any level of a macro lambda list; for details, +see *note Destructuring by Lambda Lists::. + + &whole + + is followed by a single variable that is bound to the entire +macro-call form; this is the value that the macro function receives as +its first argument. + + If &whole and a following variable appear, they must appear first in +lambda-list, + + before any other parameter or lambda list keyword. + + &whole can appear at any level of a macro lambda list. At inner +levels, the &whole variable is bound to the corresponding part of the +argument, as with &rest, but unlike &rest, other arguments are also +allowed. The use of &whole does not affect the pattern of arguments +specified. + + &environment + + is followed by a single variable that is bound to an environment +representing the lexical environment in which the macro call is to be +interpreted. This environment should be used with + + macro-function, + + get-setf-expansion, + + compiler-macro-function, + + and macroexpand (for example) in computing the expansion of the +macro, to ensure that any lexical bindings or definitions established in +the compilation environment are taken into account. + + &environment can only appear at the top level of a macro lambda list, +and can only appear once, but can appear anywhere in that list; + + the &environment parameter is bound along with &whole before any +other variables in the lambda list, regardless of where &environment +appears in the lambda list. + + The object that is bound to the environment parameter has dynamic +extent. + + Destructuring allows a macro lambda list to express the structure of +a macro call syntax. If no lambda list keywords appear, then the macro +lambda list is a tree containing parameter names at the leaves. The +pattern and the macro form must have compatible tree structure; that is, +their tree structure must be equivalent, or it must differ only in that +some leaves of the pattern match non-atomic objects of the macro form. + + For information about error detection in this situation, see *note +Destructuring Mismatch::. + + A destructuring lambda list (whether at top level or embedded) can be +dotted, ending in a parameter name. This situation is treated exactly +as if the parameter name that ends the list had appeared preceded by +&rest. + + It is permissible for a macro form (or a subexpression of a macro +form) to be a dotted list only when (... &rest var) or (... . var) is +used to match it. It is the responsibility of the macro to recognize +and deal with such situations. + + [Editorial Note by KMP: Apparently the dotted-macro-forms cleanup +doesn't allow for the macro to 'manually' notice dotted forms and fix +them as well. It shouldn't be required that this be done only by &REST +or a dotted pattern; it should only matter that ultimately the non-macro +result of a full-macro expansion not contain dots. Anyway, I plan to +address this editorially unless someone raises an objection.] + +* Menu: + +* Destructuring by Lambda Lists:: +* Data-directed Destructuring by Lambda Lists:: +* Examples of Data-directed Destructuring by Lambda Lists:: +* Lambda-list-directed Destructuring by Lambda Lists:: + + +File: gcl.info, Node: Destructuring by Lambda Lists, Next: Data-directed Destructuring by Lambda Lists, Prev: Macro Lambda Lists, Up: Macro Lambda Lists + +3.4.4.1 Destructuring by Lambda Lists +..................................... + +Anywhere in a macro lambda list where a parameter name can appear, and +where ordinary lambda list syntax (as described in *note Ordinary Lambda +Lists::) does not otherwise allow a list, a destructuring lambda list +can appear in place of the parameter name. When this is done, then the +argument that would match the parameter is treated as a (possibly +dotted) list, to be used as an argument list for satisfying the +parameters in the embedded lambda list. This is known as destructuring. + + Destructuring is the process of decomposing a compound object into +its component parts, using an abbreviated, declarative syntax, rather +than writing it out by hand using the primitive component-accessing +functions. Each component part is bound to a variable. + + A destructuring operation requires an object to be decomposed, a +pattern that specifies what components are to be extracted, and the +names of the variables whose values are to be the components. + + +File: gcl.info, Node: Data-directed Destructuring by Lambda Lists, Next: Examples of Data-directed Destructuring by Lambda Lists, Prev: Destructuring by Lambda Lists, Up: Macro Lambda Lists + +3.4.4.2 Data-directed Destructuring by Lambda Lists +................................................... + +In data-directed destructuring, the pattern is a sample object of the +type to be decomposed. Wherever a component is to be extracted, a +symbol appears in the pattern; this symbol is the name of the variable +whose value will be that component. + + +File: gcl.info, Node: Examples of Data-directed Destructuring by Lambda Lists, Next: Lambda-list-directed Destructuring by Lambda Lists, Prev: Data-directed Destructuring by Lambda Lists, Up: Macro Lambda Lists + +3.4.4.3 Examples of Data-directed Destructuring by Lambda Lists +............................................................... + +An example pattern is + + (a b c) + + which destructures a list of three elements. The variable a is +assigned to the first element, b to the second, etc. A more complex +example is + + ((first . rest) . more) + + The important features of data-directed destructuring are its +syntactic simplicity and the ability to extend it to +lambda-list-directed destructuring. + + +File: gcl.info, Node: Lambda-list-directed Destructuring by Lambda Lists, Prev: Examples of Data-directed Destructuring by Lambda Lists, Up: Macro Lambda Lists + +3.4.4.4 Lambda-list-directed Destructuring by Lambda Lists +.......................................................... + +An extension of data-directed destructuring of trees is +lambda-list-directed destructuring. This derives from the analogy +between the three-element destructuring pattern + + (first second third) + + and the three-argument lambda list + + (first second third) + + Lambda-list-directed destructuring is identical to data-directed +destructuring if no lambda list keywords appear in the pattern. Any +list in the pattern (whether a sub-list or the whole pattern itself) +that contains a lambda list keyword is interpreted specially. Elements +of the list to the left of the first lambda list keyword are treated as +destructuring patterns, as usual, but the remaining elements of the list +are treated like a function's lambda list except that where a variable +would normally be required, an arbitrary destructuring pattern is +allowed. Note that in case of ambiguity, lambda list syntax is +preferred over destructuring syntax. Thus, after &optional a list of +elements is a list of a destructuring pattern and a default value form. + + The detailed behavior of each lambda list keyword in a +lambda-list-directed destructuring pattern is as follows: + +&optional + Each following element is a variable or a list of a destructuring + pattern, a default value form, and a supplied-p variable. The + default value and the supplied-p variable can be omitted. If the + list being destructured ends early, so that it does not have an + element to match against this destructuring (sub)-pattern, the + default form is evaluated and destructured instead. The supplied-p + variable receives the value nil if the default form is used, t + otherwise. + +&rest, &body + The next element is a destructuring pattern that matches the rest + of the list. &body is identical to &rest but declares that what is + being matched is a list of forms that constitutes the body of form. + This next element must be the last unless a lambda list keyword + follows it. + +&aux + The remaining elements are not destructuring patterns at all, but + are auxiliary variable bindings. + +&whole + The next element is a destructuring pattern that matches the entire + form in a macro, or the entire subexpression at inner levels. + +&key + Each following element is one of + + + a variable, + + or + a list of a variable, an optional initialization form, and an + optional supplied-p variable. + + or + a list of a list of a keyword and a destructuring pattern, an + optional initialization form, and an optional supplied-p + variable. + + The rest of the list being destructured is taken to be alternating + keywords and values and is taken apart appropriately. + +&allow-other-keys + Stands by itself. + + +File: gcl.info, Node: Destructuring Lambda Lists, Next: Boa Lambda Lists, Prev: Macro Lambda Lists, Up: Lambda Lists + +3.4.5 Destructuring Lambda Lists +-------------------------------- + +A destructuring lambda list is used by destructuring-bind. + + Destructuring lambda lists are closely related to macro lambda lists; +see *note Macro Lambda Lists::. A destructuring lambda list can contain +all of the lambda list keywords listed for macro lambda lists except for +&environment, and supports destructuring in the same way. Inner lambda +lists nested within a macro lambda list have the syntax of destructuring +lambda lists. + + A destructuring lambda list has the following syntax: + + reqvars ::={var | !lambda-list}* + + optvars ::=[&optional {var | ({var | !lambda-list} [init-form [supplied-p-parameter]])}*] + + restvar ::=[{&rest | &body} {var | !lambda-list}] + + keyvars ::=[&key {var | ({var | (keyword-name {var | !lambda-list})} [init-form [supplied-p-parameter]])}* + [&allow-other-keys]] + + auxvars ::=[&aux {var | (var [init-form])}*] + + envvar ::=[&environment var] + + wholevar ::=[&whole var] + + lambda-list ::=(!wholevar !reqvars !optvars !restvar !keyvars !auxvars) | + (!wholevar !reqvars !optvars . var) + + +File: gcl.info, Node: Boa Lambda Lists, Next: Defsetf Lambda Lists, Prev: Destructuring Lambda Lists, Up: Lambda Lists + +3.4.6 Boa Lambda Lists +---------------------- + +A boa lambda list is a lambda list that is syntactically like an +ordinary lambda list, but that is processed in "by order of argument" +style. + + A boa lambda list is used only in a defstruct form, when explicitly +specifying the lambda list of a constructor function (sometimes called a +"boa constructor"). + + The &optional, &rest, &aux, + + &key, and &allow-other-keys + + lambda list keywords are recognized in a boa lambda list. The way +these lambda list keywords differ from their use in an ordinary lambda +list follows. + + Consider this example, which describes how destruct processes its +:constructor option. + + (:constructor create-foo + (a &optional b (c 'sea) &rest d &aux e (f 'eff))) + + This defines create-foo to be a constructor of one or more arguments. +The first argument is used to initialize the a slot. The second +argument is used to initialize the b slot. If there isn't any second +argument, then the default value given in the body of the defstruct (if +given) is used instead. The third argument is used to initialize the c +slot. If there isn't any third argument, then the symbol sea is used +instead. Any arguments following the third argument are collected into +a list and used to initialize the d slot. If there are three or fewer +arguments, then nil is placed in the d slot. The e slot is not +initialized; its initial value is implementation-defined. Finally, the +f slot is initialized to contain the symbol eff. + + &key and &allow-other-keys arguments default in a manner similar to +that of &optional arguments: if no default is supplied in the lambda +list then the default value given in the body of the defstruct (if +given) is used instead. For example: + + (defstruct (foo (:constructor CREATE-FOO (a &optional b (c 'sea) + &key (d 2) + &aux e (f 'eff)))) + (a 1) (b 2) (c 3) (d 4) (e 5) (f 6)) + + (create-foo 10) => #S(FOO A 10 B 2 C SEA D 2 E implemention-dependent F EFF) + (create-foo 10 'bee 'see :d 'dee) + => #S(FOO A 10 B BEE C SEE D DEE E implemention-dependent F EFF) + + If keyword arguments of the form ((key var) [default [svar]]) are +specified, the slot name is matched with var (not key). + + The actions taken in the b and e cases were carefully chosen to allow +the user to specify all possible behaviors. The &aux variables can be +used to completely override the default initializations given in the +body. + + If no default value is supplied for an aux variable variable, the +consequences are undefined if an attempt is later made to read the +corresponding slot's value before a value is explicitly assigned. If +such a slot has a :type option specified, this suppressed initialization +does not imply a type mismatch situation; the declared type is only +required to apply when the slot is finally assigned. + + With this definition, the following can be written: + + (create-foo 1 2) + + instead of + + (make-foo :a 1 :b 2) + + and create-foo provides defaulting different from that of make-foo. + + Additional arguments that do not correspond to slot names but are +merely present to supply values used in subsequent initialization +computations are allowed. For example, in the definition + + (defstruct (frob (:constructor create-frob + (a &key (b 3 have-b) (c-token 'c) + (c (list c-token (if have-b 7 2)))))) + a b c) + + the c-token argument is used merely to supply a value used in the +initialization of the c slot. The supplied-p parameters associated with +optional parameters and keyword parameters might also be used this way. + + +File: gcl.info, Node: Defsetf Lambda Lists, Next: Deftype Lambda Lists, Prev: Boa Lambda Lists, Up: Lambda Lists + +3.4.7 Defsetf Lambda Lists +-------------------------- + +A defsetf lambda list is used by defsetf. + + A defsetf lambda list has the following syntax: + + lambda-list ::=({var}* + [&optional {var | (var [init-form [supplied-p-parameter]])}*] + [&rest var] + [&key {var | ({var | (keyword-name var)} [init-form [supplied-p-parameter]])}* pt [&allow-other-keys]] + [&environment var] + + A defsetf lambda list can contain the lambda list keywords shown in +Figure 3-19. + + &allow-other-keys &key &rest + &environment &optional + + Figure 3-19: Lambda List Keywords used by Defsetf Lambda Lists + + + A defsetf lambda list differs from an ordinary lambda list only in +that it does not permit the use of &aux, and that it permits use of +&environment, which introduces an environment parameter. + + +File: gcl.info, Node: Deftype Lambda Lists, Next: Define-modify-macro Lambda Lists, Prev: Defsetf Lambda Lists, Up: Lambda Lists + +3.4.8 Deftype Lambda Lists +-------------------------- + +A deftype lambda list is used by deftype. + + A deftype lambda list has the same syntax as a macro lambda list, and +can therefore contain the lambda list keywords as a macro lambda list. + + A deftype lambda list differs from a macro lambda list only in that +if no init-form is supplied for an optional parameter or keyword +parameter in the lambda-list, the default value for that parameter is +the symbol * (rather than nil). + + +File: gcl.info, Node: Define-modify-macro Lambda Lists, Next: Define-method-combination Arguments Lambda Lists, Prev: Deftype Lambda Lists, Up: Lambda Lists + +3.4.9 Define-modify-macro Lambda Lists +-------------------------------------- + +A define-modify-macro lambda list is used by define-modify-macro. + + A define-modify-macro lambda list can contain the lambda list +keywords shown in Figure 3-20. + + &optional &rest + + Figure 3-20: Lambda List Keywords used by Define-modify-macro Lambda Lists + + + Define-modify-macro lambda lists are similar to ordinary lambda +lists, but do not support keyword arguments. define-modify-macro has no +need match keyword arguments, and a rest parameter is sufficient. Aux +variables are also not supported, since define-modify-macro has no body +forms which could refer to such bindings. See the macro +define-modify-macro. + + +File: gcl.info, Node: Define-method-combination Arguments Lambda Lists, Next: Syntactic Interaction of Documentation Strings and Declarations, Prev: Define-modify-macro Lambda Lists, Up: Lambda Lists + +3.4.10 Define-method-combination Arguments Lambda Lists +------------------------------------------------------- + +A define-method-combination arguments lambda list is used by the +:arguments option to define-method-combination. + + A define-method-combination arguments lambda list can contain the +lambda list keywords shown in Figure 3-21. + + &allow-other-keys &key &rest + &aux &optional &whole + + Figure 3-21: Lambda List Keywords used by Define-method-combination arguments Lambda Lists + + + Define-method-combination arguments lambda lists are similar to +ordinary lambda lists, but also permit the use of &whole. + + +File: gcl.info, Node: Syntactic Interaction of Documentation Strings and Declarations, Prev: Define-method-combination Arguments Lambda Lists, Up: Lambda Lists + +3.4.11 Syntactic Interaction of Documentation Strings and Declarations +---------------------------------------------------------------------- + +In a number of situations, a documentation string can appear amidst a +series of declare expressions prior to a series of forms. + + In that case, if a string S appears where a documentation string is +permissible and is not followed by either a declare expression or a form +then S is taken to be a form; otherwise, S is taken as a documentation +string. The consequences are unspecified if more than one such +documentation string is present. + + +File: gcl.info, Node: Error Checking in Function Calls, Next: Traversal Rules and Side Effects, Prev: Lambda Lists, Up: Evaluation and Compilation + +3.5 Error Checking in Function Calls +==================================== + +* Menu: + +* Argument Mismatch Detection:: + + +File: gcl.info, Node: Argument Mismatch Detection, Prev: Error Checking in Function Calls, Up: Error Checking in Function Calls + +3.5.1 Argument Mismatch Detection +--------------------------------- + +* Menu: + +* Safe and Unsafe Calls:: +* Error Detection Time in Safe Calls:: +* Too Few Arguments:: +* Too Many Arguments:: +* Unrecognized Keyword Arguments:: +* Invalid Keyword Arguments:: +* Odd Number of Keyword Arguments:: +* Destructuring Mismatch:: +* Errors When Calling a Next Method:: + + +File: gcl.info, Node: Safe and Unsafe Calls, Next: Error Detection Time in Safe Calls, Prev: Argument Mismatch Detection, Up: Argument Mismatch Detection + +3.5.1.1 Safe and Unsafe Calls +............................. + +A call is a safe call if each of the following is either safe code or +system code (other than system code that results from macro expansion of +programmer code): + +* + the call. +* + the definition of the function being called. +* + the point of functional evaluation + + The following special cases require some elaboration: + +* + If the function being called is a generic function, it is + considered safe if all of the following are + + safe code or system code: + + - + its definition (if it was defined explicitly). + - + the method definitions for all applicable methods. + - + the definition of its method combination. + +* + For the form (coerce x 'function), where x is a lambda expression, + the value of the optimize quality safety in the global environment + at the time the coerce is executed applies to the resulting + function. + +* + For a call to the function ensure-generic-function, the value of + the optimize quality safety in the environment object passed as the + :environment argument applies to the resulting generic function. + +* + For a call to compile with a lambda expression as the argument, the + value of the optimize quality safety in the global environment at + the time compile is called applies to the resulting compiled + function. + +* + For a call to compile with only one argument, if the original + definition of the function was safe, then the resulting compiled + function must also be safe. + +* + A call to a method by call-next-method must be considered safe if + each of the following is + + safe code or system code: + + - + the definition of the generic function (if it was defined + explicitly). + - + the method definitions for all applicable methods. + - + the definition of the method combination. + - + the point of entry into the body of the method defining form, + where the binding of call-next-method is established. + - + the point of functional evaluation of the name + call-next-method. + + An unsafe call is a call that is not a safe call. + + The informal intent is that the programmer can rely on a call to be +safe, even when system code is involved, if all reasonable steps have +been taken to ensure that the call is safe. For example, if a +programmer calls mapcar from safe code and supplies a function that was +compiled as safe, the implementation is required to ensure that mapcar +makes a safe call as well. + + +File: gcl.info, Node: Error Detection Time in Safe Calls, Next: Too Few Arguments, Prev: Safe and Unsafe Calls, Up: Argument Mismatch Detection + +3.5.1.2 Error Detection Time in Safe Calls +.......................................... + +If an error is signaled in a safe call, the exact point of the signal is +implementation-dependent. In particular, it might be signaled at +compile time or at run time, and if signaled at run time, it might be +prior to, during, or after executing the call. However, it is always +prior to the execution of the body of the function being called. + + +File: gcl.info, Node: Too Few Arguments, Next: Too Many Arguments, Prev: Error Detection Time in Safe Calls, Up: Argument Mismatch Detection + +3.5.1.3 Too Few Arguments +......................... + +It is not permitted to supply too few arguments to a function. Too few +arguments means fewer arguments than the number of required parameters +for the function. + + If this situation occurs in a safe call, + + an error of type program-error must be signaled; and in an unsafe +call the situation has undefined consequences. + + +File: gcl.info, Node: Too Many Arguments, Next: Unrecognized Keyword Arguments, Prev: Too Few Arguments, Up: Argument Mismatch Detection + +3.5.1.4 Too Many Arguments +.......................... + +It is not permitted to supply too many arguments to a function. Too +many arguments means more arguments than the number of required +parameters plus the number of optional parameters; however, if the +function uses &rest or &key, it is not possible for it to receive too +many arguments. + + If this situation occurs in a safe call, + + an error of type program-error must be signaled; and in an unsafe +call the situation has undefined consequences. + + +File: gcl.info, Node: Unrecognized Keyword Arguments, Next: Invalid Keyword Arguments, Prev: Too Many Arguments, Up: Argument Mismatch Detection + +3.5.1.5 Unrecognized Keyword Arguments +...................................... + +It is not permitted to supply a keyword argument to a function using a +name that is not recognized by that function unless keyword argument +checking is suppressed as described in *note Suppressing Keyword +Argument Checking::. + + If this situation occurs in a safe call, + + an error of type program-error must be signaled; and in an unsafe +call the situation has undefined consequences. + + +File: gcl.info, Node: Invalid Keyword Arguments, Next: Odd Number of Keyword Arguments, Prev: Unrecognized Keyword Arguments, Up: Argument Mismatch Detection + +3.5.1.6 Invalid Keyword Arguments +................................. + +It is not permitted to supply a keyword argument to a function using a +name that is not a symbol. + + If this situation occurs in a safe call, + + an error of type program-error must be signaled unless keyword +argument checking is suppressed as described in *note Suppressing +Keyword Argument Checking::; and in an unsafe call the situation has +undefined consequences. + + +File: gcl.info, Node: Odd Number of Keyword Arguments, Next: Destructuring Mismatch, Prev: Invalid Keyword Arguments, Up: Argument Mismatch Detection + +3.5.1.7 Odd Number of Keyword Arguments +....................................... + +An odd number of arguments must not be supplied for the keyword +parameters. + + If this situation occurs in a safe call, + + an error of type program-error must be signaled unless keyword +argument checking is suppressed as described in *note Suppressing +Keyword Argument Checking::; and in an unsafe call the situation has +undefined consequences. + + +File: gcl.info, Node: Destructuring Mismatch, Next: Errors When Calling a Next Method, Prev: Odd Number of Keyword Arguments, Up: Argument Mismatch Detection + +3.5.1.8 Destructuring Mismatch +.............................. + +When matching a destructuring lambda list against a form, the pattern +and the form must have compatible tree structure, as described in *note +Macro Lambda Lists::. + + Otherwise, in a safe call, an error of type program-error must be +signaled; and in an unsafe call the situation has undefined +consequences. + + +File: gcl.info, Node: Errors When Calling a Next Method, Prev: Destructuring Mismatch, Up: Argument Mismatch Detection + +3.5.1.9 Errors When Calling a Next Method +......................................... + +If call-next-method is called with arguments, the ordered set of +applicable methods for the changed set of arguments for call-next-method +must be the same as the ordered set of applicable methods for the +original arguments to the generic function, or else an error should be +signaled. + + The comparison between the set of methods applicable to the new +arguments and the set applicable to the original arguments is +insensitive to order differences among methods with the same +specializers. + + If call-next-method is called with arguments that specify a different +ordered set of applicable methods and there is no next method available, +the test for different methods and the associated error signaling (when +present) takes precedence over calling no-next-method. + + +File: gcl.info, Node: Traversal Rules and Side Effects, Next: Destructive Operations, Prev: Error Checking in Function Calls, Up: Evaluation and Compilation + +3.6 Traversal Rules and Side Effects +==================================== + +The consequences are undefined when code executed during an +object-traversing operation destructively modifies the object in a way +that might affect the ongoing traversal operation. In particular, the +following rules apply. + +List traversal + For list traversal operations, the cdr chain of the list is not + allowed to be destructively modified. + +Array traversal + For array traversal operations, the array is not allowed to be + adjusted and its fill pointer, if any, is not allowed to be + changed. + +Hash-table traversal + For hash table traversal operations, new elements may not be added + or deleted except that the element corresponding to the current + hash key may be changed or removed. + +Package traversal + For package traversal operations (e.g., do-symbols), new symbols + may not be interned in or uninterned from the package being + traversed or any package that it uses except that the current + symbol may be uninterned from the package being traversed. + + +File: gcl.info, Node: Destructive Operations, Next: Evaluation and Compilation Dictionary, Prev: Traversal Rules and Side Effects, Up: Evaluation and Compilation + +3.7 Destructive Operations +========================== + +* Menu: + +* Modification of Literal Objects:: +* Transfer of Control during a Destructive Operation:: + + +File: gcl.info, Node: Modification of Literal Objects, Next: Transfer of Control during a Destructive Operation, Prev: Destructive Operations, Up: Destructive Operations + +3.7.1 Modification of Literal Objects +------------------------------------- + +The consequences are undefined if literal objects are destructively +modified. For this purpose, the following operations are considered +destructive: + +random-state + Using it as an argument to the function random. + +cons + Changing the car_1 or cdr_1 of the cons, or performing a + destructive operation on an object which is either the car_2 or the + cdr_2 of the cons. + +array + Storing a new value into some element of the array, or performing a + destructive operation on an object that is already such an element. + + Changing the fill pointer, dimensions, or displacement of the array + (regardless of whether the array is actually adjustable). + + Performing a destructive operation on another array that is + displaced to the array or that otherwise shares its contents with + the array. + +hash-table + Performing a destructive operation on any key. + + Storing a new value_4 for any key, or performing a destructive + operation on any object that is such a value. + + Adding or removing entries from the hash table. + +structure-object + Storing a new value into any slot, or performing a destructive + operation on an object that is the value of some slot. + +standard-object + Storing a new value into any slot, or performing a destructive + operation on an object that is the value of some slot. + + Changing the class of the object (e.g., using the function + change-class). + +readtable + Altering the readtable case. + + Altering the syntax type of any character in this readtable. + + Altering the reader macro function associated with any character in + the readtable, or altering the reader macro functions associated + with characters defined as dispatching macro characters in the + readtable. + +stream + Performing I/O operations on the stream, or closing the stream. + +All other standardized types + [This category includes, for example, character, condition, + function, method-combination, method, number, package, pathname, + restart, and symbol.] + + There are no standardized destructive operations defined on objects + of these types. + + +File: gcl.info, Node: Transfer of Control during a Destructive Operation, Prev: Modification of Literal Objects, Up: Destructive Operations + +3.7.2 Transfer of Control during a Destructive Operation +-------------------------------------------------------- + +Should a transfer of control out of a destructive operation occur (e.g., +due to an error) the state of the object being modified is +implementation-dependent. + +* Menu: + +* Examples of Transfer of Control during a Destructive Operation:: + + +File: gcl.info, Node: Examples of Transfer of Control during a Destructive Operation, Prev: Transfer of Control during a Destructive Operation, Up: Transfer of Control during a Destructive Operation + +3.7.2.1 Examples of Transfer of Control during a Destructive Operation +...................................................................... + +The following examples illustrate some of the many ways in which the +implementation-dependent nature of the modification can manifest itself. + + (let ((a (list 2 1 4 3 7 6 'five))) + (ignore-errors (sort a #'<)) + a) + => (1 2 3 4 6 7 FIVE) + OR=> (2 1 4 3 7 6 FIVE) + OR=> (2) + + (prog foo ((a (list 1 2 3 4 5 6 7 8 9 10))) + (sort a #'(lambda (x y) (if (zerop (random 5)) (return-from foo a) (> x y))))) + => (1 2 3 4 5 6 7 8 9 10) + OR=> (3 4 5 6 2 7 8 9 10 1) + OR=> (1 2 4 3) + + +File: gcl.info, Node: Evaluation and Compilation Dictionary, Prev: Destructive Operations, Up: Evaluation and Compilation + +3.8 Evaluation and Compilation Dictionary +========================================= + +* Menu: + +* lambda (Symbol):: +* lambda:: +* compile:: +* eval:: +* eval-when:: +* load-time-value:: +* quote:: +* compiler-macro-function:: +* define-compiler-macro:: +* defmacro:: +* macro-function:: +* macroexpand:: +* define-symbol-macro:: +* symbol-macrolet:: +* *macroexpand-hook*:: +* proclaim:: +* declaim:: +* declare:: +* ignore:: +* dynamic-extent:: +* type:: +* inline:: +* ftype:: +* declaration:: +* optimize:: +* special:: +* locally:: +* the:: +* special-operator-p:: +* constantp:: + + +File: gcl.info, Node: lambda (Symbol), Next: lambda, Prev: Evaluation and Compilation Dictionary, Up: Evaluation and Compilation Dictionary + +3.8.1 lambda [Symbol] +--------------------- + +Syntax:: +........ + +'lambda' lambda-list [[{declaration}* | documentation]] {form}* + +Arguments:: +........... + +lambda-list--an ordinary lambda list. + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + form--a form. + +Description:: +............. + +A lambda expression is a list that can be used in place of a function +name in certain contexts to denote a function by directly describing its +behavior rather than indirectly by referring to the name of an +established function. + + Documentation is attached to the denoted function (if any is actually +created) as a documentation string. + +See Also:: +.......... + +function, *note documentation:: , *note Lambda Expressions::, *note +Lambda Forms::, *note Syntactic Interaction of Documentation Strings and +Declarations:: + +Notes:: +....... + +The lambda form + + ((lambda lambda-list . body) . arguments) + + is semantically equivalent to the function form + + (funcall #'(lambda lambda-list . body) . arguments) + + +File: gcl.info, Node: lambda, Next: compile, Prev: lambda (Symbol), Up: Evaluation and Compilation Dictionary + +3.8.2 lambda [Macro] +-------------------- + +'lambda' lambda-list [[{declaration}* | documentation]] {form}* => +function + +Arguments and Values:: +...................... + +lambda-list--an ordinary lambda list. + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + form--a form. + + function--a function. + +Description:: +............. + +Provides a shorthand notation for a function special form involving a +lambda expression such that: + + (lambda lambda-list [[{declaration}* | documentation]] {form}*) + == (function (lambda lambda-list [[{declaration}* | documentation]] {form}*)) + == #'(lambda lambda-list [[{declaration}* | documentation]] {form}*) + +Examples:: +.......... + + (funcall (lambda (x) (+ x 3)) 4) => 7 + +See Also:: +.......... + +lambda (symbol) + +Notes:: +....... + +This macro could be implemented by: + + (defmacro lambda (&whole form &rest bvl-decls-and-body) + (declare (ignore bvl-decls-and-body)) + `#',form) + + +File: gcl.info, Node: compile, Next: eval, Prev: lambda, Up: Evaluation and Compilation Dictionary + +3.8.3 compile [Function] +------------------------ + +'compile' name &optional definition => function, warnings-p, failure-p + +Arguments and Values:: +...................... + +name--a function name, or nil. + + definition--a lambda expression or a function. The default is the +function definition of name if it names a function, or the macro +function of name if it names a macro. The consequences are undefined if +no definition is supplied when the name is nil. + + function--the function-name, + + or a compiled function. + + warnings-p--a generalized boolean. + + failure-p--a generalized boolean. + +Description:: +............. + +Compiles an interpreted function. + + compile produces a compiled function from definition. If the +definition is a lambda expression, it is coerced to a function. + + If the definition is already a compiled function, compile either +produces that function itself (i.e., is an identity operation) or an +equivalent function. + + [Editorial Note by KMP: There are a number of ambiguities here that +still need resolution.] If the name is nil, the resulting compiled +function is returned directly as the primary value. If a non-nil name +is given, then the resulting compiled function replaces the existing +function definition of name and the name is returned as the primary +value; if name is a symbol that names a macro, its macro function is +updated and the name is returned as the primary value. + + Literal objects appearing in code processed by the compile function +are neither copied nor coalesced. The code resulting from the execution +of compile references objects that are eql to the corresponding objects +in the source code. + + compile is permitted, but not required, to establish a handler for +conditions of type error. For example, the handler might issue a +warning and restart compilation from some implementation-dependent point +in order to let the compilation proceed without manual intervention. + + The secondary value, warnings-p, is false if no conditions of type +error or warning were detected by the compiler, and true otherwise. + + The tertiary value, failure-p, is false if no conditions of type +error or warning (other than style-warning) were detected by the +compiler, and true otherwise. + +Examples:: +.......... + + (defun foo () "bar") => FOO + (compiled-function-p #'foo) => implementation-dependent + (compile 'foo) => FOO + (compiled-function-p #'foo) => true + (setf (symbol-function 'foo) + (compile nil '(lambda () "replaced"))) => # + (foo) => "replaced" + +Affected By:: +............. + +*error-output*, + + *macroexpand-hook*. + + The presence of macro definitions and proclamations. + +Exceptional Situations:: +........................ + +The consequences are undefined if the lexical environment surrounding +the function to be compiled contains any bindings other than those for +macros, symbol macros, or declarations. + + For information about errors detected during the compilation process, +see *note Exceptional Situations in the Compiler::. + +See Also:: +.......... + +*note compile-file:: + + +File: gcl.info, Node: eval, Next: eval-when, Prev: compile, Up: Evaluation and Compilation Dictionary + +3.8.4 eval [Function] +--------------------- + +'eval' form => {result}* + +Arguments and Values:: +...................... + +form--a form. + + results--the values yielded by the evaluation of form. + +Description:: +............. + +Evaluates form in the current dynamic environment and the null lexical +environment. + + eval is a user interface to the evaluator. + + The evaluator expands macro calls as if through the use of +macroexpand-1. + + Constants appearing in code processed by eval are not copied nor +coalesced. The code resulting from the execution of eval references +objects that are eql to the corresponding objects in the source code. + +Examples:: +.......... + + (setq form '(1+ a) a 999) => 999 + (eval form) => 1000 + (eval 'form) => (1+ A) + (let ((a '(this would break if eval used local value))) (eval form)) + => 1000 + +See Also:: +.......... + +macroexpand-1, *note The Evaluation Model:: + +Notes:: +....... + +To obtain the current dynamic value of a symbol, use of symbol-value is +equivalent (and usually preferable) to use of eval. + + Note that an eval form involves two levels of evaluation for its +argument. First, form is evaluated by the normal argument evaluation +mechanism as would occur with any call. The object that results from +this normal argument evaluation becomes the value of the form parameter, +and is then evaluated as part of the eval form. For example: + + (eval (list 'cdr (car '((quote (a . b)) c)))) => b + + The argument form (list 'cdr (car '((quote (a . b)) c))) is evaluated +in the usual way to produce the argument (cdr (quote (a . b))); eval +then evaluates its argument, (cdr (quote (a . b))), to produce b. Since +a single evaluation already occurs for any argument form in any function +form, eval is sometimes said to perform "an extra level of evaluation." + + +File: gcl.info, Node: eval-when, Next: load-time-value, Prev: eval, Up: Evaluation and Compilation Dictionary + +3.8.5 eval-when [Special Operator] +---------------------------------- + +'eval-when' ({situation}*) {form}* => {result}* + +Arguments and Values:: +...................... + +situation--One of the symbols :compile-toplevel , :load-toplevel , +:execute , compile , load , or eval . + + The use of eval, compile, and load is deprecated. + + forms--an implicit progn. + + results--the values of the forms if they are executed, or nil if they +are not. + +Description:: +............. + +The body of an eval-when form is processed as an implicit progn, but +only in the situations listed. + + The use of the situations :compile-toplevel (or compile) and +:load-toplevel (or load) controls whether and when evaluation occurs +when eval-when appears as a top level form in code processed by +compile-file. See *note File Compilation::. + + The use of the situation :execute (or eval) controls whether +evaluation occurs for other eval-when forms; that is, those that are not +top level forms, or those in code processed by eval or compile. If the +:execute situation is specified in such a form, then the body forms are +processed as an implicit progn; otherwise, the eval-when form returns +nil. + + eval-when normally appears as a top level form, but it is meaningful +for it to appear as a non-top-level form. However, the compile-time +side effects described in *note Compilation:: only take place when +eval-when appears as a top level form. + +Examples:: +.......... + +One example of the use of eval-when is that for the compiler to be able +to read a file properly when it uses user-defined reader macros, it is +necessary to write + + (eval-when (:compile-toplevel :load-toplevel :execute) + (set-macro-character #\$ #'(lambda (stream char) + (declare (ignore char)) + (list 'dollar (read stream))))) => T + + This causes the call to set-macro-character to be executed in the +compiler's execution environment, thereby modifying its reader syntax +table. + + ;;; The EVAL-WHEN in this case is not at toplevel, so only the :EXECUTE + ;;; keyword is considered. At compile time, this has no effect. + ;;; At load time (if the LET is at toplevel), or at execution time + ;;; (if the LET is embedded in some other form which does not execute + ;;; until later) this sets (SYMBOL-FUNCTION 'FOO1) to a function which + ;;; returns 1. + (let ((x 1)) + (eval-when (:execute :load-toplevel :compile-toplevel) + (setf (symbol-function 'foo1) #'(lambda () x)))) + + ;;; If this expression occurs at the toplevel of a file to be compiled, + ;;; it has BOTH a compile time AND a load-time effect of setting + ;;; (SYMBOL-FUNCTION 'FOO2) to a function which returns 2. + (eval-when (:execute :load-toplevel :compile-toplevel) + (let ((x 2)) + (eval-when (:execute :load-toplevel :compile-toplevel) + (setf (symbol-function 'foo2) #'(lambda () x))))) + + ;;; If this expression occurs at the toplevel of a file to be compiled, + ;;; it has BOTH a compile time AND a load-time effect of setting the + ;;; function cell of FOO3 to a function which returns 3. + (eval-when (:execute :load-toplevel :compile-toplevel) + (setf (symbol-function 'foo3) #'(lambda () 3))) + + ;;; #4: This always does nothing. It simply returns NIL. + (eval-when (:compile-toplevel) + (eval-when (:compile-toplevel) + (print 'foo4))) + + ;;; If this form occurs at toplevel of a file to be compiled, FOO5 is + ;;; printed at compile time. If this form occurs in a non-top-level + ;;; position, nothing is printed at compile time. Regardless of context, + ;;; nothing is ever printed at load time or execution time. + (eval-when (:compile-toplevel) + (eval-when (:execute) + (print 'foo5))) + + ;;; If this form occurs at toplevel of a file to be compiled, FOO6 is + ;;; printed at compile time. If this form occurs in a non-top-level + ;;; position, nothing is printed at compile time. Regardless of context, + ;;; nothing is ever printed at load time or execution time. + (eval-when (:execute :load-toplevel) + (eval-when (:compile-toplevel) + (print 'foo6))) + +See Also:: +.......... + +*note compile-file:: , *note Compilation:: + +Notes:: +....... + +The following effects are logical consequences of the definition of +eval-when: + +* + Execution of a single eval-when expression executes the body code + at most once. + +* + Macros intended for use in top level forms should be written so + that side-effects are done by the forms in the macro expansion. + The macro-expander itself should not do the side-effects. + + For example: + + Wrong: + + (defmacro foo () + (really-foo) + `(really-foo)) + + Right: + + (defmacro foo () + `(eval-when (:compile-toplevel :execute :load-toplevel) (really-foo))) + + Adherence to this convention means that such macros behave + intuitively when appearing as non-top-level forms. + +* + Placing a variable binding around an eval-when reliably captures + the binding because the compile-time-too mode cannot occur (i.e., + introducing a variable binding means that the eval-when is not a + top level form). For example, + + (let ((x 3)) + (eval-when (:execute :load-toplevel :compile-toplevel) (print x))) + + prints 3 at execution (i.e., load) time, and does not print + anything at compile time. This is important so that expansions of + defun and defmacro can be done in terms of eval-when and can + correctly capture the lexical environment. + + (defun bar (x) (defun foo () (+ x 3))) + + might expand into + + (defun bar (x) + (progn (eval-when (:compile-toplevel) + (compiler::notice-function-definition 'foo '(x))) + (eval-when (:execute :load-toplevel) + (setf (symbol-function 'foo) #'(lambda () (+ x 3)))))) + + which would be treated by the above rules the same as + + (defun bar (x) + (setf (symbol-function 'foo) #'(lambda () (+ x 3)))) + + when the definition of bar is not a top level form. + + +File: gcl.info, Node: load-time-value, Next: quote, Prev: eval-when, Up: Evaluation and Compilation Dictionary + +3.8.6 load-time-value [Special Operator] +---------------------------------------- + +'load-time-value' form &optional read-only-p => object + +Arguments and Values:: +...................... + +form--a form; evaluated as described below. + + read-only-p--a boolean; not evaluated. + + object--the primary value resulting from evaluating form. + +Description:: +............. + +load-time-value provides a mechanism for delaying evaluation of form +until the expression is in the run-time environment; see *note +Compilation::. + + Read-only-p designates whether the result can be considered a +constant object. If t, the result is a read-only quantity that can, if +appropriate to the implementation, be copied into read-only space and/or +coalesced with similar constant objects from other programs. If nil +(the default), the result must be neither copied nor coalesced; it must +be considered to be potentially modifiable data. + + If a load-time-value expression is processed by compile-file, the +compiler performs its normal semantic processing (such as macro +expansion and translation into machine code) on form, but arranges for +the execution of form to occur at load time in a null lexical +environment, with the result of this evaluation then being treated as a +literal object at run time. It is guaranteed that the evaluation of +form will take place only once when the file is loaded, but the order of +evaluation with respect to the evaluation of top level forms in the file +is implementation-dependent. + + If a load-time-value expression appears within a function compiled +with compile, the form is evaluated at compile time in a null lexical +environment. The result of this compile-time evaluation is treated as a +literal object in the compiled code. + + If a load-time-value expression is processed by eval, form is +evaluated in a null lexical environment, and one value is returned. +Implementations that implicitly compile (or partially compile) +expressions processed by eval might evaluate form only once, at the time +this compilation is performed. + + If the same list (load-time-value form) is evaluated or compiled more +than once, it is implementation-dependent whether form is evaluated only +once or is evaluated more than once. This can happen both when an +expression being evaluated or compiled shares substructure, and when the +same form is processed by eval or compile multiple times. Since a +load-time-value expression can be referenced in more than one place and +can be evaluated multiple times by eval, it is implementation-dependent +whether each execution returns a fresh object or returns the same object +as some other execution. Users must use caution when destructively +modifying the resulting object. + + If two lists (load-time-value form) that are the same under equal but +are not identical are evaluated or compiled, their values always come +from distinct evaluations of form. Their values may not be coalesced +unless read-only-p is t. + +Examples:: +.......... + + ;;; The function INCR1 always returns the same value, even in different images. + ;;; The function INCR2 always returns the same value in a given image, + ;;; but the value it returns might vary from image to image. + (defun incr1 (x) (+ x #.(random 17))) + (defun incr2 (x) (+ x (load-time-value (random 17)))) + + ;;; The function FOO1-REF references the nth element of the first of + ;;; the *FOO-ARRAYS* that is available at load time. It is permissible for + ;;; that array to be modified (e.g., by SET-FOO1-REF); FOO1-REF will see the + ;;; updated values. + (defvar *foo-arrays* (list (make-array 7) (make-array 8))) + (defun foo1-ref (n) (aref (load-time-value (first *my-arrays*) nil) n)) + (defun set-foo1-ref (n val) + (setf (aref (load-time-value (first *my-arrays*) nil) n) val)) + + ;;; The function BAR1-REF references the nth element of the first of + ;;; the *BAR-ARRAYS* that is available at load time. The programmer has + ;;; promised that the array will be treated as read-only, so the system + ;;; can copy or coalesce the array. + (defvar *bar-arrays* (list (make-array 7) (make-array 8))) + (defun bar1-ref (n) (aref (load-time-value (first *my-arrays*) t) n)) + + ;;; This use of LOAD-TIME-VALUE permits the indicated vector to be coalesced + ;;; even though NIL was specified, because the object was already read-only + ;;; when it was written as a literal vector rather than created by a constructor. + ;;; User programs must treat the vector v as read-only. + (defun baz-ref (n) + (let ((v (load-time-value #(A B C) nil))) + (values (svref v n) v))) + + ;;; This use of LOAD-TIME-VALUE permits the indicated vector to be coalesced + ;;; even though NIL was specified in the outer situation because T was specified + ;;; in the inner situation. User programs must treat the vector v as read-only. + (defun baz-ref (n) + (let ((v (load-time-value (load-time-value (vector 1 2 3) t) nil))) + (values (svref v n) v))) + +See Also:: +.......... + +*note compile-file:: , *note compile:: , *note eval:: , *note Minimal +Compilation::, *note Compilation:: + +Notes:: +....... + +load-time-value must appear outside of quoted structure in a "for +evaluation" position. In situations which would appear to call for use +of load-time-value within a quoted structure, the backquote reader macro +is probably called for; see *note Backquote::. + + Specifying nil for read-only-p is not a way to force an object to +become modifiable if it has already been made read-only. It is only a +way to say that, for an object that is modifiable, this operation is not +intended to make that object read-only. + + +File: gcl.info, Node: quote, Next: compiler-macro-function, Prev: load-time-value, Up: Evaluation and Compilation Dictionary + +3.8.7 quote [Special Operator] +------------------------------ + +'quote' object => object + +Arguments and Values:: +...................... + +object--an object; not evaluated. + +Description:: +............. + +The quote special operator just returns object. + + The consequences are undefined if literal objects (including quoted +objects) are destructively modified. + +Examples:: +.......... + + (setq a 1) => 1 + (quote (setq a 3)) => (SETQ A 3) + a => 1 + 'a => A + ''a => (QUOTE A) + '''a => (QUOTE (QUOTE A)) + (setq a 43) => 43 + (list a (cons a 3)) => (43 (43 . 3)) + (list (quote a) (quote (cons a 3))) => (A (CONS A 3)) + 1 => 1 + '1 => 1 + "foo" => "foo" + '"foo" => "foo" + (car '(a b)) => A + '(car '(a b)) => (CAR (QUOTE (A B))) + #(car '(a b)) => #(CAR (QUOTE (A B))) + '#(car '(a b)) => #(CAR (QUOTE (A B))) + +See Also:: +.......... + +*note Evaluation::, *note Single-Quote::, + + *note Compiler Terminology:: + +Notes:: +....... + +The textual notation 'object is equivalent to (quote object); see *note +Compiler Terminology::. + + Some objects, called self-evaluating objects, do not require +quotation by quote. However, symbols and lists are used to represent +parts of programs, and so would not be useable as constant data in a +program without quote. Since quote suppresses the evaluation of these +objects, they become data rather than program. + + +File: gcl.info, Node: compiler-macro-function, Next: define-compiler-macro, Prev: quote, Up: Evaluation and Compilation Dictionary + +3.8.8 compiler-macro-function [Accessor] +---------------------------------------- + +'compiler-macro-function' name &optional environment => function + + (setf (' compiler-macro-function' name &optional environment) +new-function) + +Arguments and Values:: +...................... + +name--a function name. + + environment--an environment object. + + function, new-function--a compiler macro function, or nil. + +Description:: +............. + +Accesses the compiler macro function named name, if any, in the +environment. + + A value of nil denotes the absence of a compiler macro function named +name. + +Exceptional Situations:: +........................ + +The consequences are undefined if environment is non-nil in a use of +setf of compiler-macro-function. + +See Also:: +.......... + +*note define-compiler-macro:: , *note Compiler Macros:: + + +File: gcl.info, Node: define-compiler-macro, Next: defmacro, Prev: compiler-macro-function, Up: Evaluation and Compilation Dictionary + +3.8.9 define-compiler-macro [Macro] +----------------------------------- + +'define-compiler-macro' name lambda-list [[{declaration}* | +documentation]] {form}* +=> name + +Arguments and Values:: +...................... + +name--a function name. + + lambda-list--a macro lambda list. + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + form--a form. + +Description:: +............. + +[Editorial Note by KMP: This definition probably needs to be fully +expanded to not refer through the definition of defmacro, but should +suffice for now.] + + This is the normal mechanism for defining a compiler macro function. +Its manner of definition is the same as for defmacro; the only +differences are: + +* + The name can be a function name naming any function or macro. + +* + The expander function is installed as a compiler macro function for + the name, rather than as a macro function. + +* + The &whole argument is bound to the form argument that is passed to + the compiler macro function. The remaining lambda-list parameters + are specified as if this form contained the function name in the + car and the actual arguments in the cdr, but if the car of the + actual form is the symbol funcall, then the destructuring of the + arguments is actually performed using its cddr instead. + +* + + Documentation is attached as a documentation string to name (as + kind compiler-macro) and to the compiler macro function. + +* + Unlike an ordinary macro, a compiler macro can decline to provide + an expansion merely by returning a form that is the same as the + original (which can be obtained by using &whole). + +Examples:: +.......... + + (defun square (x) (expt x 2)) => SQUARE + (define-compiler-macro square (&whole form arg) + (if (atom arg) + `(expt ,arg 2) + (case (car arg) + (square (if (= (length arg) 2) + `(expt ,(nth 1 arg) 4) + form)) + (expt (if (= (length arg) 3) + (if (numberp (nth 2 arg)) + `(expt ,(nth 1 arg) ,(* 2 (nth 2 arg))) + `(expt ,(nth 1 arg) (* 2 ,(nth 2 arg)))) + form)) + (otherwise `(expt ,arg 2))))) => SQUARE + (square (square 3)) => 81 + (macroexpand '(square x)) => (SQUARE X), false + (funcall (compiler-macro-function 'square) '(square x) nil) + => (EXPT X 2) + (funcall (compiler-macro-function 'square) '(square (square x)) nil) + => (EXPT X 4) + (funcall (compiler-macro-function 'square) '(funcall #'square x) nil) + => (EXPT X 2) + + (defun distance-positional (x1 y1 x2 y2) + (sqrt (+ (expt (- x2 x1) 2) (expt (- y2 y1) 2)))) + => DISTANCE-POSITIONAL + (defun distance (&key (x1 0) (y1 0) (x2 x1) (y2 y1)) + (distance-positional x1 y1 x2 y2)) + => DISTANCE + (define-compiler-macro distance (&whole form + &rest key-value-pairs + &key (x1 0 x1-p) + (y1 0 y1-p) + (x2 x1 x2-p) + (y2 y1 y2-p) + &allow-other-keys + &environment env) + (flet ((key (n) (nth (* n 2) key-value-pairs)) + (arg (n) (nth (1+ (* n 2)) key-value-pairs)) + (simplep (x) + (let ((expanded-x (macroexpand x env))) + (or (constantp expanded-x env) + (symbolp expanded-x))))) + (let ((n (/ (length key-value-pairs) 2))) + (multiple-value-bind (x1s y1s x2s y2s others) + (loop for (key) on key-value-pairs by #'cddr + count (eq key ':x1) into x1s + count (eq key ':y1) into y1s + count (eq key ':x2) into x2s + count (eq key ':y1) into y2s + count (not (member key '(:x1 :x2 :y1 :y2))) + into others + finally (return (values x1s y1s x2s y2s others))) + (cond ((and (= n 4) + (eq (key 0) :x1) + (eq (key 1) :y1) + (eq (key 2) :x2) + (eq (key 3) :y2)) + `(distance-positional ,x1 ,y1 ,x2 ,y2)) + ((and (if x1-p (and (= x1s 1) (simplep x1)) t) + (if y1-p (and (= y1s 1) (simplep y1)) t) + (if x2-p (and (= x2s 1) (simplep x2)) t) + (if y2-p (and (= y2s 1) (simplep y2)) t) + (zerop others)) + `(distance-positional ,x1 ,y1 ,x2 ,y2)) + ((and (< x1s 2) (< y1s 2) (< x2s 2) (< y2s 2) + (zerop others)) + (let ((temps (loop repeat n collect (gensym)))) + `(let ,(loop for i below n + collect (list (nth i temps) (arg i))) + (distance + ,@(loop for i below n + append (list (key i) (nth i temps))))))) + (t form)))))) + => DISTANCE + (dolist (form + '((distance :x1 (setq x 7) :x2 (decf x) :y1 (decf x) :y2 (decf x)) + (distance :x1 (setq x 7) :y1 (decf x) :x2 (decf x) :y2 (decf x)) + (distance :x1 (setq x 7) :y1 (incf x)) + (distance :x1 (setq x 7) :y1 (incf x) :x1 (incf x)) + (distance :x1 a1 :y1 b1 :x2 a2 :y2 b2) + (distance :x1 a1 :x2 a2 :y1 b1 :y2 b2) + (distance :x1 a1 :y1 b1 :z1 c1 :x2 a2 :y2 b2 :z2 c2))) + (print (funcall (compiler-macro-function 'distance) form nil))) + |> (LET ((#:G6558 (SETQ X 7)) + |> (#:G6559 (DECF X)) + |> (#:G6560 (DECF X)) + |> (#:G6561 (DECF X))) + |> (DISTANCE :X1 #:G6558 :X2 #:G6559 :Y1 #:G6560 :Y2 #:G6561)) + |> (DISTANCE-POSITIONAL (SETQ X 7) (DECF X) (DECF X) (DECF X)) + |> (LET ((#:G6567 (SETQ X 7)) + |> (#:G6568 (INCF X))) + |> (DISTANCE :X1 #:G6567 :Y1 #:G6568)) + |> (DISTANCE :X1 (SETQ X 7) :Y1 (INCF X) :X1 (INCF X)) + |> (DISTANCE-POSITIONAL A1 B1 A2 B2) + |> (DISTANCE-POSITIONAL A1 B1 A2 B2) + |> (DISTANCE :X1 A1 :Y1 B1 :Z1 C1 :X2 A2 :Y2 B2 :Z2 C2) + => NIL + +See Also:: +.......... + +*note compiler-macro-function:: , *note defmacro:: , *note +documentation:: , *note Syntactic Interaction of Documentation Strings +and Declarations:: + +Notes:: +....... + +The consequences of writing a compiler macro definition for a function +in the COMMON-LISP package are undefined; it is quite possible that in +some implementations such an attempt would override an equivalent or +equally important definition. In general, it is recommended that a +programmer only write compiler macro definitions for functions he or she +personally maintains-writing a compiler macro definition for a function +maintained elsewhere is normally considered a violation of traditional +rules of modularity and data abstraction. + + +File: gcl.info, Node: defmacro, Next: macro-function, Prev: define-compiler-macro, Up: Evaluation and Compilation Dictionary + +3.8.10 defmacro [Macro] +----------------------- + +'defmacro' name lambda-list [[{declaration}* | documentation]] {form}* +=> name + +Arguments and Values:: +...................... + +name--a symbol. + + lambda-list--a macro lambda list. + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + form--a form. + +Description:: +............. + +Defines name as a macro by associating a macro function with that name +in the global environment. + + The macro function is defined in the same lexical environment in +which the defmacro form appears. + + The parameter variables in lambda-list are bound to destructured +portions of the macro call. + + The expansion function accepts two arguments, a form and an +environment. The expansion function returns a form. The body of the +expansion function is specified by forms. Forms are executed in order. +The value of the last form executed is returned as the expansion of the +macro. + + The body forms of the expansion function (but not the lambda-list) + + are implicitly enclosed in a block whose name is name. + + The lambda-list conforms to the requirements described in *note Macro +Lambda Lists::. + + Documentation is attached as a documentation string to name (as kind +function) and to the macro function. + + defmacro can be used to redefine a macro or to replace a function +definition with a macro definition. + + Recursive expansion of the form returned must terminate, including +the expansion of other macros which are subforms of other forms +returned. + + The consequences are undefined if the result of fully macroexpanding +a form contains any circular list structure except in literal objects. + + If a defmacro form appears as a top level form, the compiler must +store the macro definition at compile time, so that occurrences of the +macro later on in the file can be expanded correctly. Users must ensure +that the body of the macro can be evaluated at compile time if it is +referenced within the file being compiled. + +Examples:: +.......... + + (defmacro mac1 (a b) "Mac1 multiplies and adds" + `(+ ,a (* ,b 3))) => MAC1 + (mac1 4 5) => 19 + (documentation 'mac1 'function) => "Mac1 multiplies and adds" + (defmacro mac2 (&optional (a 2 b) (c 3 d) &rest x) `'(,a ,b ,c ,d ,x)) => MAC2 + (mac2 6) => (6 T 3 NIL NIL) + (mac2 6 3 8) => (6 T 3 T (8)) + (defmacro mac3 (&whole r a &optional (b 3) &rest x &key c (d a)) + `'(,r ,a ,b ,c ,d ,x)) => MAC3 + (mac3 1 6 :d 8 :c 9 :d 10) => ((MAC3 1 6 :D 8 :C 9 :D 10) 1 6 9 8 (:D 8 :C 9 :D 10)) + + The stipulation that an embedded destructuring lambda list is +permitted only where ordinary lambda list syntax would permit a +parameter name but not a list is made to prevent ambiguity. For +example, the following is not valid: + + (defmacro loser (x &optional (a b &rest c) &rest z) + ...) + + because ordinary lambda list syntax does permit a list following +&optional; the list (a b &rest c) would be interpreted as describing an +optional parameter named a whose default value is that of the form b, +with a supplied-p parameter named &rest (not valid), and an extraneous +symbol c in the list (also not valid). An almost correct way to express +this is + + (defmacro loser (x &optional ((a b &rest c)) &rest z) + ...) + + The extra set of parentheses removes the ambiguity. However, the +definition is now incorrect because a macro call such as (loser (car +pool)) would not provide any argument form for the lambda list (a b +&rest c), and so the default value against which to match the lambda +list would be nil because no explicit default value was specified. The +consequences of this are unspecified since the empty list, nil, does not +have forms to satisfy the parameters a and b. The fully correct +definition would be either + + (defmacro loser (x &optional ((a b &rest c) '(nil nil)) &rest z) + ...) + + or + + (defmacro loser (x &optional ((&optional a b &rest c)) &rest z) + ...) + + These differ slightly: the first requires that if the macro call +specifies a explicitly then it must also specify b explicitly, whereas +the second does not have this requirement. For example, + + (loser (car pool) ((+ x 1))) + + would be a valid call for the second definition but not for the +first. + + (defmacro dm1a (&whole x) `',x) + (macroexpand '(dm1a)) => (QUOTE (DM1A)) + (macroexpand '(dm1a a)) is an error. + + (defmacro dm1b (&whole x a &optional b) `'(,x ,a ,b)) + (macroexpand '(dm1b)) is an error. + (macroexpand '(dm1b q)) => (QUOTE ((DM1B Q) Q NIL)) + (macroexpand '(dm1b q r)) => (QUOTE ((DM1B Q R) Q R)) + (macroexpand '(dm1b q r s)) is an error. + + (defmacro dm2a (&whole form a b) `'(form ,form a ,a b ,b)) + (macroexpand '(dm2a x y)) => (QUOTE (FORM (DM2A X Y) A X B Y)) + (dm2a x y) => (FORM (DM2A X Y) A X B Y) + + (defmacro dm2b (&whole form a (&whole b (c . d) &optional (e 5)) + &body f &environment env) + ``(,',form ,,a ,',b ,',(macroexpand c env) ,',d ,',e ,',f)) + ;Note that because backquote is involved, implementations may differ + ;slightly in the nature (though not the functionality) of the expansion. + (macroexpand '(dm2b x1 (((incf x2) x3 x4)) x5 x6)) + => (LIST* '(DM2B X1 (((INCF X2) X3 X4)) + X5 X6) + X1 + '((((INCF X2) X3 X4)) (SETQ X2 (+ X2 1)) (X3 X4) 5 (X5 X6))), + T + (let ((x1 5)) + (macrolet ((segundo (x) `(cadr ,x))) + (dm2b x1 (((segundo x2) x3 x4)) x5 x6))) + => ((DM2B X1 (((SEGUNDO X2) X3 X4)) X5 X6) + 5 (((SEGUNDO X2) X3 X4)) (CADR X2) (X3 X4) 5 (X5 X6)) + +See Also:: +.......... + +*note define-compiler-macro:: , + + *note destructuring-bind:: , *note documentation:: , *note +macroexpand:: , *macroexpand-hook*, macrolet, *note macro-function:: , +*note Evaluation::, *note Compilation::, *note Syntactic Interaction of +Documentation Strings and Declarations:: + + +File: gcl.info, Node: macro-function, Next: macroexpand, Prev: defmacro, Up: Evaluation and Compilation Dictionary + +3.8.11 macro-function [Accessor] +-------------------------------- + +'macro-function' symbol &optional environment => function + + (setf (' macro-function' symbol &optional environment) new-function) + +Arguments and Values:: +...................... + +symbol--a symbol. + + environment--an environment object. + + function--a macro function or nil. + + new-function--a macro function. + +Description:: +............. + +Determines whether symbol has a function definition as a macro in the +specified environment. + + If so, the macro expansion function, a function of two arguments, is +returned. If symbol has no function definition in the lexical +environment environment, or its definition is not a macro, +macro-function returns nil. + + It is possible for both macro-function and + + special-operator-p + + to return true of symbol. The macro definition must be available for +use by programs that understand only the standard Common Lisp special +forms. + +Examples:: +.......... + + (defmacro macfun (x) '(macro-function 'macfun)) => MACFUN + (not (macro-function 'macfun)) => false + + (macrolet ((foo (&environment env) + (if (macro-function 'bar env) + ''yes + ''no))) + (list (foo) + (macrolet ((bar () :beep)) + (foo)))) + + => (NO YES) + +Affected By:: +............. + +(setf macro-function), defmacro, and macrolet. + +Exceptional Situations:: +........................ + +The consequences are undefined if environment is non-nil in a use of +setf of macro-function. + +See Also:: +.......... + +*note defmacro:: , *note Evaluation:: + +Notes:: +....... + +setf can be used with macro-function to install a macro as a symbol's +global function definition: + + (setf (macro-function symbol) fn) + + The value installed must be a function that accepts two arguments, +the entire macro call and an environment, and computes the expansion for +that call. Performing this operation causes symbol to have only that +macro definition as its global function definition; any previous +definition, whether as a macro or as a function, is lost. + + +File: gcl.info, Node: macroexpand, Next: define-symbol-macro, Prev: macro-function, Up: Evaluation and Compilation Dictionary + +3.8.12 macroexpand, macroexpand-1 [Function] +-------------------------------------------- + +'macroexpand' form &optional env => expansion, expanded-p + + 'macroexpand-' 1 => form &optional env expansion, expanded-p + +Arguments and Values:: +...................... + +form--a form. + + env--an environment object. The default is nil. + + expansion--a form. + + expanded-p--a generalized boolean. + +Description:: +............. + +macroexpand and macroexpand-1 expand macros. + + If form is a macro form, then macroexpand-1 expands the macro form +call once. + + macroexpand repeatedly expands form until it is no longer a macro +form. In effect, macroexpand calls macroexpand-1 repeatedly until the +secondary value it returns is nil. + + If form is a macro form, then the expansion is a macro expansion and +expanded-p is true. Otherwise, the expansion is the given form and +expanded-p is false. + + Macro expansion is carried out as follows. Once macroexpand-1 has +determined that the form is a macro form, it obtains an appropriate +expansion function for the macro or symbol macro. The value of +*macroexpand-hook* is + + coerced to a function and + + then called as a function of three arguments: the expansion function, +the form, and the env. The value returned from this call is taken to be +the expansion of the form. + + In addition to macro definitions in the global environment, any local +macro definitions established within env by macrolet or symbol-macrolet +are considered. If only form is supplied as an argument, then the +environment is effectively null, and only global macro definitions as +established by defmacro are considered. Macro definitions are shadowed +by local function definitions. + +Examples:: +.......... + + (defmacro alpha (x y) `(beta ,x ,y)) => ALPHA + (defmacro beta (x y) `(gamma ,x ,y)) => BETA + (defmacro delta (x y) `(gamma ,x ,y)) => EPSILON + (defmacro expand (form &environment env) + (multiple-value-bind (expansion expanded-p) + (macroexpand form env) + `(values ',expansion ',expanded-p))) => EXPAND + (defmacro expand-1 (form &environment env) + (multiple-value-bind (expansion expanded-p) + (macroexpand-1 form env) + `(values ',expansion ',expanded-p))) => EXPAND-1 + + ;; Simple examples involving just the global environment + (macroexpand-1 '(alpha a b)) => (BETA A B), true + (expand-1 (alpha a b)) => (BETA A B), true + (macroexpand '(alpha a b)) => (GAMMA A B), true + (expand (alpha a b)) => (GAMMA A B), true + (macroexpand-1 'not-a-macro) => NOT-A-MACRO, false + (expand-1 not-a-macro) => NOT-A-MACRO, false + (macroexpand '(not-a-macro a b)) => (NOT-A-MACRO A B), false + (expand (not-a-macro a b)) => (NOT-A-MACRO A B), false + + ;; Examples involving lexical environments + (macrolet ((alpha (x y) `(delta ,x ,y))) + (macroexpand-1 '(alpha a b))) => (BETA A B), true + (macrolet ((alpha (x y) `(delta ,x ,y))) + (expand-1 (alpha a b))) => (DELTA A B), true + (macrolet ((alpha (x y) `(delta ,x ,y))) + (macroexpand '(alpha a b))) => (GAMMA A B), true + (macrolet ((alpha (x y) `(delta ,x ,y))) + (expand (alpha a b))) => (GAMMA A B), true + (macrolet ((beta (x y) `(epsilon ,x ,y))) + (expand (alpha a b))) => (EPSILON A B), true + (let ((x (list 1 2 3))) + (symbol-macrolet ((a (first x))) + (expand a))) => (FIRST X), true + (let ((x (list 1 2 3))) + (symbol-macrolet ((a (first x))) + (macroexpand 'a))) => A, false + (symbol-macrolet ((b (alpha x y))) + (expand-1 b)) => (ALPHA X Y), true + (symbol-macrolet ((b (alpha x y))) + (expand b)) => (GAMMA X Y), true + (symbol-macrolet ((b (alpha x y)) + (a b)) + (expand-1 a)) => B, true + (symbol-macrolet ((b (alpha x y)) + (a b)) + (expand a)) => (GAMMA X Y), true + + ;; Examples of shadowing behavior + (flet ((beta (x y) (+ x y))) + (expand (alpha a b))) => (BETA A B), true + (macrolet ((alpha (x y) `(delta ,x ,y))) + (flet ((alpha (x y) (+ x y))) + (expand (alpha a b)))) => (ALPHA A B), false + (let ((x (list 1 2 3))) + (symbol-macrolet ((a (first x))) + (let ((a x)) + (expand a)))) => A, false + +Affected By:: +............. + +defmacro, setf of macro-function, macrolet, symbol-macrolet + +See Also:: +.......... + +*macroexpand-hook*, *note defmacro:: , *note setf:: of *note +macro-function:: , macrolet, *note symbol-macrolet:: , *note +Evaluation:: + +Notes:: +....... + +Neither macroexpand nor macroexpand-1 makes any explicit attempt to +expand macro forms that are either subforms of the form or subforms of +the expansion. Such expansion might occur implicitly, however, due to +the semantics or implementation of the macro function. + + +File: gcl.info, Node: define-symbol-macro, Next: symbol-macrolet, Prev: macroexpand, Up: Evaluation and Compilation Dictionary + +3.8.13 define-symbol-macro [Macro] +---------------------------------- + +'define-symbol-macro' symbol expansion +=> symbol + +Arguments and Values:: +...................... + +symbol--a symbol. + + expansion--a form. + +Description:: +............. + +Provides a mechanism for globally affecting the macro expansion of the +indicated symbol. + + Globally establishes an expansion function for the symbol macro named +by symbol. The only guaranteed property of an expansion function for a +symbol macro is that when it is applied to the form and the environment +it returns the correct expansion. (In particular, it is +implementation-dependent whether the expansion is conceptually stored in +the expansion function, the environment, or both.) + + Each global reference to symbol (i.e., not shadowed_2 by a binding +for a variable or symbol macro named by the same symbol) is expanded by +the normal macro expansion process; see *note Symbols as Forms::. The +expansion of a symbol macro is subject to further macro expansion in the +same lexical environment as the symbol macro reference, exactly +analogous to normal macros. + + The consequences are unspecified if a special declaration is made for +symbol while in the scope of this definition (i.e., when it is not +shadowed_2 by a binding for a variable or symbol macro named by the same +symbol). + + Any use of setq to set the value of the symbol while in the scope of +this definition is treated as if it were a setf. psetq of symbol is +treated as if it were a psetf, and multiple-value-setq is treated as if +it were a setf of values. + + A binding for a symbol macro can be shadowed_2 by let or +symbol-macrolet. + +Examples:: +.......... + + (defvar *things* (list 'alpha 'beta 'gamma)) => *THINGS* + + (define-symbol-macro thing1 (first *things*)) => THING1 + (define-symbol-macro thing2 (second *things*)) => THING2 + (define-symbol-macro thing3 (third *things*)) => THING3 + + thing1 => ALPHA + (setq thing1 'ONE) => ONE + *things* => (ONE BETA GAMMA) + (multiple-value-setq (thing2 thing3) (values 'two 'three)) => TWO + thing3 => THREE + *things* => (ONE TWO THREE) + + (list thing2 (let ((thing2 2)) thing2)) => (TWO 2) + +Exceptional Situations:: +........................ + +If symbol is already defined as a global variable, an error of type +program-error is signaled. + +See Also:: +.......... + +*note symbol-macrolet:: , *note macroexpand:: + + +File: gcl.info, Node: symbol-macrolet, Next: *macroexpand-hook*, Prev: define-symbol-macro, Up: Evaluation and Compilation Dictionary + +3.8.14 symbol-macrolet [Special Operator] +----------------------------------------- + +'symbol-macrolet' ({(symbol expansion )}*) {declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +symbol--a symbol. + + expansion--a form. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +symbol-macrolet provides a mechanism for affecting the macro expansion +environment for symbols. + + symbol-macrolet lexically establishes expansion functions for each of +the symbol macros named by symbols. + + The only guaranteed property of an expansion function for a symbol +macro is that when it is applied to the form and the environment it +returns the correct expansion. (In particular, it is +implementation-dependent whether the expansion is conceptually stored in +the expansion function, the environment, or both.) + + Each reference to symbol as a variable within the lexical scope of +symbol-macrolet is expanded by the normal macro expansion process; see +*note Symbols as Forms::. The expansion of a symbol macro is subject to +further macro expansion in the same lexical environment as the symbol +macro invocation, exactly analogous to normal macros. + + Exactly the same declarations are allowed as for let with one +exception: symbol-macrolet signals an error if a special declaration +names one of the symbols being defined by symbol-macrolet. + + When the forms of the symbol-macrolet form are expanded, any use of +setq to set the value of one of the specified variables is treated as if +it were a setf. psetq of a symbol defined as a symbol macro is treated +as if it were a psetf, and multiple-value-setq is treated as if it were +a setf of values. + + The use of symbol-macrolet can be shadowed by let. In other words, +symbol-macrolet only substitutes for occurrences of symbol that would be +in the scope of a lexical binding of symbol surrounding the forms. + +Examples:: +.......... + + ;;; The following is equivalent to + ;;; (list 'foo (let ((x 'bar)) x)), + ;;; not + ;;; (list 'foo (let (('foo 'bar)) 'foo)) + (symbol-macrolet ((x 'foo)) + (list x (let ((x 'bar)) x))) + => (foo bar) + NOT=> (foo foo) + + (symbol-macrolet ((x '(foo x))) + (list x)) + => ((FOO X)) + +Exceptional Situations:: +........................ + +If an attempt is made to bind a symbol that is defined as a global +variable, an error of type program-error is signaled. + + If declaration contains a special declaration that names one of the +symbols being bound by symbol-macrolet, an error of type program-error +is signaled. + +See Also:: +.......... + +*note with-slots:: , *note macroexpand:: + +Notes:: +....... + +The special form symbol-macrolet is the basic mechanism that is used to +implement with-slots. + + If a symbol-macrolet form is a top level form, the forms are also +processed as top level forms. See *note File Compilation::. + + +File: gcl.info, Node: *macroexpand-hook*, Next: proclaim, Prev: symbol-macrolet, Up: Evaluation and Compilation Dictionary + +3.8.15 *macroexpand-hook* [Variable] +------------------------------------ + +Value Type:: +............ + +a designator for a function of three arguments: a macro function, a +macro form, and an environment object. + +Initial Value:: +............... + +a designator for a function that is equivalent to the function funcall, +but that might have additional implementation-dependent side-effects. + +Description:: +............. + +Used as the expansion interface hook by macroexpand-1 to control the +macro expansion process. When a macro form is to be expanded, this +function is called with three arguments: the macro function, the macro +form, and the environment in which the macro form is to be expanded. + + The environment object has dynamic extent; the consequences are +undefined if the environment object is referred to outside the dynamic +extent of the macro expansion function. + +Examples:: +.......... + + (defun hook (expander form env) + (format t "Now expanding: ~S~ + (funcall expander form env)) => HOOK + (defmacro machook (x y) `(/ (+ ,x ,y) 2)) => MACHOOK + (macroexpand '(machook 1 2)) => (/ (+ 1 2) 2), true + (let ((*macroexpand-hook* #'hook)) (macroexpand '(machook 1 2))) + |> Now expanding (MACHOOK 1 2) + => (/ (+ 1 2) 2), true + +See Also:: +.......... + +*note macroexpand:: , macroexpand-1, *note funcall:: , *note +Evaluation:: + +Notes:: +....... + +The net effect of the chosen initial value is to just invoke the macro +function, giving it the macro form and environment as its two arguments. + + Users or user programs can assign this variable to customize or trace +the macro expansion mechanism. Note, however, that this variable is a +global resource, potentially shared by multiple programs; as such, if +any two programs depend for their correctness on the setting of this +variable, those programs may not be able to run in the same Lisp image. +For this reason, it is frequently best to confine its uses to debugging +situations. + + Users who put their own function into *macroexpand-hook* should +consider saving the previous value of the hook, and calling that value +from their own. + + +File: gcl.info, Node: proclaim, Next: declaim, Prev: *macroexpand-hook*, Up: Evaluation and Compilation Dictionary + +3.8.16 proclaim [Function] +-------------------------- + +'proclaim' declaration-specifier => implementation-dependent + +Arguments and Values:: +...................... + +declaration-specifier--a declaration specifier. + +Description:: +............. + +Establishes the declaration specified by declaration-specifier in the +global environment. + + Such a declaration, sometimes called a global declaration or a +proclamation, is always in force unless locally shadowed. + + Names of variables and functions within declaration-specifier refer +to dynamic variables and global function definitions, respectively. + + Figure 3-22 shows a list of declaration identifiers that can be used +with proclaim. + + declaration inline optimize type + ftype notinline special + + Figure 3-22: Global Declaration Specifiers + + + An implementation is free to support other (implementation-defined) +declaration identifiers as well. + +Examples:: +.......... + + (defun declare-variable-types-globally (type vars) + (proclaim `(type ,type ,@vars)) + type) + + ;; Once this form is executed, the dynamic variable *TOLERANCE* + ;; must always contain a float. + (declare-variable-types-globally 'float '(*tolerance*)) + => FLOAT + +See Also:: +.......... + +*note declaim:: , declare, *note Compilation:: + +Notes:: +....... + +Although the execution of a proclaim form has effects that might affect +compilation, the compiler does not make any attempt to recognize and +specially process proclaim forms. A proclamation such as the following, +even if a top level form, does not have any effect until it is executed: + + (proclaim '(special *x*)) + + If compile time side effects are desired, eval-when may be useful. +For example: + + (eval-when (:execute :compile-toplevel :load-toplevel) + (proclaim '(special *x*))) + + In most such cases, however, it is preferrable to use declaim for +this purpose. + + Since proclaim forms are ordinary function forms, macro forms can +expand into them. + + +File: gcl.info, Node: declaim, Next: declare, Prev: proclaim, Up: Evaluation and Compilation Dictionary + +3.8.17 declaim [Macro] +---------------------- + +'declaim' {declaration-specifier}* => implementation-dependent + +Arguments and Values:: +...................... + +declaration-specifier--a declaration specifier; not evaluated. + +Description:: +............. + +Establishes the declarations specified by the declaration-specifiers. + + If a use of this macro appears as a top level form in a file being +processed by the file compiler, the proclamations are also made at +compile-time. As with other defining macros, it is unspecified whether +or not the compile-time side-effects of a declaim persist after the file +has been compiled. + +Examples:: +.......... + +See Also:: +.......... + +declare, *note proclaim:: + + +File: gcl.info, Node: declare, Next: ignore, Prev: declaim, Up: Evaluation and Compilation Dictionary + +3.8.18 declare [Symbol] +----------------------- + +Syntax:: +........ + +'declare' {declaration-specifier}* + +Arguments:: +........... + +declaration-specifier--a declaration specifier; not evaluated. + +Description:: +............. + +A declare expression, sometimes called a declaration, can occur only at +the beginning of the bodies of certain forms; that is, it may be +preceded only by other declare expressions, or by a documentation string +if the context permits. + + A declare expression can occur in a lambda expression or in any of +the forms listed in Figure 3-23. + + defgeneric do-external-symbols prog + define-compiler-macro do-symbols prog* + define-method-combination dolist restart-case + define-setf-expander dotimes symbol-macrolet + defmacro flet with-accessors + defmethod handler-case with-hash-table-iterator + defsetf labels with-input-from-string + deftype let with-open-file + defun let* with-open-stream + destructuring-bind locally with-output-to-string + do macrolet with-package-iterator + do* multiple-value-bind with-slots + do-all-symbols pprint-logical-block + + Figure 3-23: Standardized Forms In Which Declarations Can Occur + + + A declare expression can only occur where specified by the syntax of +these forms. The consequences of attempting to evaluate a declare +expression are undefined. In situations where such expressions can +appear, explicit checks are made for their presence and they are never +actually evaluated; it is for this reason that they are called "declare +expressions" rather than "declare forms." + + Macro forms cannot expand into declarations; declare expressions must +appear as actual subexpressions of the form to which they refer. + + Figure 3-24 shows a list of declaration identifiers that can be used +with declare. + + dynamic-extent ignore optimize + ftype inline special + ignorable notinline type + + Figure 3-24: Local Declaration Specifiers + + + An implementation is free to support other (implementation-defined) +declaration identifiers as well. + +Examples:: +.......... + + (defun nonsense (k x z) + (foo z x) ;First call to foo + (let ((j (foo k x)) ;Second call to foo + (x (* k k))) + (declare (inline foo) (special x z)) + (foo x j z))) ;Third call to foo + + In this example, the inline declaration applies only to the third +call to foo, but not to the first or second ones. The special +declaration of x causes let to make a dynamic binding for x, and causes +the reference to x in the body of let to be a dynamic reference. The +reference to x in the second call to foo is a local reference to the +second parameter of nonsense. The reference to x in the first call to +foo is a local reference, not a special one. The special declaration of +z causes the reference to z in the third call to foo to be a dynamic +reference; it does not refer to the parameter to nonsense named z, +because that parameter binding has not been declared to be special. +(The special declaration of z does not appear in the body of defun, but +in an inner form, and therefore does not affect the binding of the +parameter.) + +Exceptional Situations:: +........................ + +The consequences of trying to use a declare expression as a form to be +evaluated are undefined. + + [Editorial Note by KMP: Probably we need to say something here about +ill-formed declare expressions.] + +See Also:: +.......... + +*note proclaim:: , *note Type Specifiers::, declaration, dynamic-extent, +ftype, ignorable, ignore, inline, notinline, optimize, type + + +File: gcl.info, Node: ignore, Next: dynamic-extent, Prev: declare, Up: Evaluation and Compilation Dictionary + +3.8.19 ignore, ignorable [Declaration] +-------------------------------------- + +Syntax:: +........ + +(ignore {var | (function fn)}*) + + (ignorable {var | (function fn)}*) + +Arguments:: +........... + +var--a variable name. + + fn--a function name. + +Valid Context:: +............... + +declaration + +Binding Types Affected:: +........................ + +variable, function + +Description:: +............. + +The ignore and ignorable declarations refer to for-value references to +variable bindings for the vars and to function bindings for the fns. + + An ignore declaration specifies that for-value references to the +indicated bindings will not occur within the scope of the declaration. +Within the scope of such a declaration, it is desirable for a compiler +to issue a warning about the presence of either a for-value reference to +any var or fn, or a special declaration for any var. + + An ignorable declaration specifies that for-value references to the +indicated bindings might or might not occur within the scope of the +declaration. Within the scope of such a declaration, it is not +desirable for a compiler to issue a warning about the presence or +absence of either a for-value reference to any var or fn, or a special +declaration for any var. + + When not within the scope of a ignore or ignorable declaration, it is +desirable for a compiler to issue a warning about any var for which +there is neither a for-value reference nor a special declaration, or +about any fn for which there is no for-value reference. + + Any warning about a "used" or "unused" binding must be of type +style-warning, and may not affect program semantics. + + The stream variables established by with-open-file, with-open-stream, +with-input-from-string, and with-output-to-string, and all iteration +variables are, by definition, always "used". Using (declare (ignore +v)), for such a variable v has unspecified consequences. + +See Also:: +.......... + +declare + + +File: gcl.info, Node: dynamic-extent, Next: type, Prev: ignore, Up: Evaluation and Compilation Dictionary + +3.8.20 dynamic-extent [Declaration] +----------------------------------- + +Syntax:: +........ + +(dynamic-extent [[{var}* | (function fn)*]]) + +Arguments:: +........... + +var--a variable name. + + fn--a function name. + +Valid Context:: +............... + +declaration + +Binding Types Affected:: +........................ + +variable, function + +Description:: +............. + +In some containing form, F, this declaration asserts for each var_i +(which need not be bound by F), and for each value v_{ij} that var_i +takes on, and for each object x_{ijk} that is an otherwise inaccessible +part of v_{ij} at any time when v_{ij} becomes the value of var_i, that +just after the execution of F terminates, x_{ijk} is either inaccessible +(if F established a binding for var_i) or still an otherwise +inaccessible part of the current value of var_i (if F did not establish +a binding for var_i). + + The same relation holds for each fn_i, except that the bindings are +in the function namespace. + + The compiler is permitted to use this information in any way that is +appropriate to the implementation and that does not conflict with the +semantics of Common Lisp. + + dynamic-extent declarations can be free declarations or bound +declarations. + + The vars and fns named in a dynamic-extent declaration must not refer +to symbol macro or macro bindings. + +Examples:: +.......... + +Since stack allocation of the initial value entails knowing at the +object's creation time that the object can be stack-allocated, it is not +generally useful to make a dynamic-extent declaration for variables +which have no lexically apparent initial value. For example, it is +probably useful to write: + + (defun f () + (let ((x (list 1 2 3))) + (declare (dynamic-extent x)) + ...)) + + This would permit those compilers that wish to do so to stack +allocate the list held by the local variable x. It is permissible, but +in practice probably not as useful, to write: + + (defun g (x) (declare (dynamic-extent x)) ...) + (defun f () (g (list 1 2 3))) + + Most compilers would probably not stack allocate the argument to g in +f because it would be a modularity violation for the compiler to assume +facts about g from within f. Only an implementation that was willing to +be responsible for recompiling f if the definition of g changed +incompatibly could legitimately stack allocate the list argument to g in +f. + + Here is another example: + + (declaim (inline g)) + (defun g (x) (declare (dynamic-extent x)) ...) + (defun f () (g (list 1 2 3))) + + (defun f () + (flet ((g (x) (declare (dynamic-extent x)) ...)) + (g (list 1 2 3)))) + + + In the previous example, some compilers might determine that +optimization was possible and others might not. + + A variant of this is the so-called "stack allocated rest list" that +can be achieved (in implementations supporting the optimization) by: + + (defun f (&rest x) + (declare (dynamic-extent x)) + ...) + + Note that although the initial value of x is not explicit, the f +function is responsible for assembling the list x from the passed +arguments, so the f function can be optimized by the compiler to +construct a stack-allocated list instead of a heap-allocated list in +implementations that support such. + + In the following example, + + (let ((x (list 'a1 'b1 'c1)) + (y (cons 'a2 (cons 'b2 (cons 'c2 nil))))) + (declare (dynamic-extent x y)) + ...) + + The otherwise inaccessible parts of x are three conses, and the +otherwise inaccessible parts of y are three other conses. None of the +symbols a1, b1, c1, a2, b2, c2, or nil is an otherwise inaccessible part +of x or y because each is interned and hence accessible by the package +(or packages) in which it is interned. However, if a freshly allocated +uninterned symbol had been used, it would have been an otherwise +inaccessible part of the list which contained it. + + ;; In this example, the implementation is permitted to stack allocate + ;; the list that is bound to X. + (let ((x (list 1 2 3))) + (declare (dynamic-extent x)) + (print x) + :done) + |> (1 2 3) + => :DONE + + ;; In this example, the list to be bound to L can be stack-allocated. + (defun zap (x y z) + (do ((l (list x y z) (cdr l))) + ((null l)) + (declare (dynamic-extent l)) + (prin1 (car l)))) => ZAP + (zap 1 2 3) + |> 123 + => NIL + + ;; Some implementations might open-code LIST-ALL-PACKAGES in a way + ;; that permits using stack allocation of the list to be bound to L. + (do ((l (list-all-packages) (cdr l))) + ((null l)) + (declare (dynamic-extent l)) + (let ((name (package-name (car l)))) + (when (string-search "COMMON-LISP" name) (print name)))) + |> "COMMON-LISP" + |> "COMMON-LISP-USER" + => NIL + + ;; Some implementations might have the ability to stack allocate + ;; rest lists. A declaration such as the following should be a cue + ;; to such implementations that stack-allocation of the rest list + ;; would be desirable. + (defun add (&rest x) + (declare (dynamic-extent x)) + (apply #'+ x)) => ADD + (add 1 2 3) => 6 + + (defun zap (n m) + ;; Computes (RANDOM (+ M 1)) at relative speed of roughly O(N). + ;; It may be slow, but with a good compiler at least it + ;; doesn't waste much heap storage. :-} + (let ((a (make-array n))) + (declare (dynamic-extent a)) + (dotimes (i n) + (declare (dynamic-extent i)) + (setf (aref a i) (random (+ i 1)))) + (aref a m))) => ZAP + (< (zap 5 3) 3) => true + + The following are in error, since the value of x is used outside of +its extent: + + (length (list (let ((x (list 1 2 3))) ; Invalid + (declare (dynamic-extent x)) + x))) + + (progn (let ((x (list 1 2 3))) ; Invalid + (declare (dynamic-extent x)) + x) + nil) + +See Also:: +.......... + +declare + +Notes:: +....... + +The most common optimization is to stack allocate the initial value of +the objects named by the vars. + + It is permissible for an implementation to simply ignore this +declaration. + + +File: gcl.info, Node: type, Next: inline, Prev: dynamic-extent, Up: Evaluation and Compilation Dictionary + +3.8.21 type [Declaration] +------------------------- + +Syntax:: +........ + +(type typespec {var}*) + + (typespec {var}*) + +Arguments:: +........... + +typespec--a type specifier. + + var--a variable name. + +Valid Context:: +............... + +declaration or proclamation + +Binding Types Affected:: +........................ + +variable + +Description:: +............. + +Affects only variable bindings and specifies that the vars take on +values only of the specified typespec. In particular, values assigned +to the variables by setq, as well as the initial values of the vars must +be of the specified typespec. type declarations never apply to function +bindings (see ftype). + + A type declaration of a symbol defined by symbol-macrolet is +equivalent to wrapping a the expression around the expansion of that +symbol, + + although the symbol's macro expansion is not actually affected. + + The meaning of a type declaration is equivalent to changing each +reference to a variable (var) within the scope of the declaration to +(the typespec var), changing each expression assigned to the variable +(new-value) within the scope of the declaration to (the typespec +new-value), and executing (the typespec var) at the moment the scope of +the declaration is entered. + + A type declaration is valid in all declarations. The interpretation +of a type declaration is as follows: + +1. + During the execution of any reference to the declared variable + within the scope of the declaration, the consequences are undefined + if the value of the declared variable is not of the declared type. + +2. + During the execution of any setq of the declared variable within + the scope of the declaration, the consequences are undefined if the + newly assigned value of the declared variable is not of the + declared type. + +3. + At the moment the scope of the declaration is entered, the + consequences are undefined if the value of the declared variable is + not of the declared type. + + A type declaration affects only variable references within its scope. + + If nested type declarations refer to the same variable, then the +value of the variable must be a member of the intersection of the +declared types. + + If there is a local type declaration for a dynamic variable, and +there is also a global type proclamation for that same variable, then +the value of the variable within the scope of the local declaration must +be a member of the intersection of the two declared types. + + type declarations can be free declarations or bound declarations. + + A symbol cannot be both the name of a type and the name of a +declaration. Defining a symbol as the name of a class, structure, +condition, or type, when the symbol has been declared as a declaration +name, or vice versa, signals an error. + + Within the lexical scope of an array type declaration, all references +to array elements are assumed to satisfy the expressed array element +type (as opposed to the upgraded array element type). A compiler can +treat the code within the scope of the array type declaration as if each +access of an array element were surrounded by an appropriate the form. + +Examples:: +.......... + + (defun f (x y) + (declare (type fixnum x y)) + (let ((z (+ x y))) + (declare (type fixnum z)) + z)) => F + (f 1 2) => 3 + ;; The previous definition of F is equivalent to + (defun f (x y) + ;; This declaration is a shorthand form of the TYPE declaration + (declare (fixnum x y)) + ;; To declare the type of a return value, it's not necessary to + ;; create a named variable. A THE special form can be used instead. + (the fixnum (+ x y))) => F + (f 1 2) => 3 + + (defvar *one-array* (make-array 10 :element-type '(signed-byte 5))) + (defvar *another-array* (make-array 10 :element-type '(signed-byte 8))) + + (defun frob (an-array) + (declare (type (array (signed-byte 5) 1) an-array)) + (setf (aref an-array 1) 31) + (setf (aref an-array 2) 127) + (setf (aref an-array 3) (* 2 (aref an-array 3))) + (let ((foo 0)) + (declare (type (signed-byte 5) foo)) + (setf foo (aref an-array 0)))) + + (frob *one-array*) + (frob *another-array*) + + The above definition of frob is equivalent to: + + (defun frob (an-array) + (setf (the (signed-byte 5) (aref an-array 1)) 31) + (setf (the (signed-byte 5) (aref an-array 2)) 127) + (setf (the (signed-byte 5) (aref an-array 3)) + (* 2 (the (signed-byte 5) (aref an-array 3)))) + (let ((foo 0)) + (declare (type (signed-byte 5) foo)) + (setf foo (the (signed-byte 5) (aref an-array 0))))) + + Given an implementation in which fixnums are 29 bits but fixnum +arrays are upgraded to signed 32-bit arrays, the following could be +compiled with all fixnum arithmetic: + + (defun bump-counters (counters) + (declare (type (array fixnum *) bump-counters)) + (dotimes (i (length counters)) + (incf (aref counters i)))) + +See Also:: +.......... + +declare, *note declaim:: , *note proclaim:: + +Notes:: +....... + +(typespec {var}*) is an abbreviation for (type typespec {var}*). + + A type declaration for the arguments to a function does not +necessarily imply anything about the type of the result. The following +function is not permitted to be compiled using implementation-dependent +fixnum-only arithmetic: + + (defun f (x y) (declare (fixnum x y)) (+ x y)) + + To see why, consider (f most-positive-fixnum 1). Common Lisp defines +that F must return a bignum here, rather than signal an error or produce +a mathematically incorrect result. If you have special knowledge such +"fixnum overflow" cases will not come up, you can declare the result +value to be in the fixnum range, enabling some compilers to use more +efficient arithmetic: + + (defun f (x y) + (declare (fixnum x y)) + (the fixnum (+ x y))) + + Note, however, that in the three-argument case, because of the +possibility of an implicit intermediate value growing too large, the +following will not cause implementation-dependent fixnum-only arithmetic +to be used: + + (defun f (x y) + (declare (fixnum x y z)) + (the fixnum (+ x y z))) + + To see why, consider (f most-positive-fixnum 1 -1). Although the +arguments and the result are all fixnums, an intermediate value is not a +fixnum. If it is important that implementation-dependent fixnum-only +arithmetic be selected in implementations that provide it, consider +writing something like this instead: + + (defun f (x y) + (declare (fixnum x y z)) + (the fixnum (+ (the fixnum (+ x y)) z))) + + +File: gcl.info, Node: inline, Next: ftype, Prev: type, Up: Evaluation and Compilation Dictionary + +3.8.22 inline, notinline [Declaration] +-------------------------------------- + +Syntax:: +........ + +(inline {function-name}*) + + (notinline {function-name}*) + +Arguments:: +........... + +function-name--a function name. + +Valid Context:: +............... + +declaration or proclamation + +Binding Types Affected:: +........................ + +function + +Description:: +............. + +inline specifies that it is desirable for the compiler to produce inline +calls to the functions named by function-names; that is, the code for a +specified function-name + + should be integrated into the calling routine, appearing "in line" in +place of a procedure call. A compiler is free to ignore this +declaration. inline declarations never apply to variable bindings. + + If one of the functions mentioned has a lexically apparent local +definition (as made by flet or labels), then the declaration applies to +that local definition and not to the global function definition. + + While no conforming implementation is required to perform inline +expansion of user-defined functions, those implementations that do +attempt to recognize the following paradigm: + + To define a function f that is not inline by default but for which +(declare (inline f)) will make f be locally inlined, the proper +definition sequence is: + + (declaim (inline f)) + (defun f ...) + (declaim (notinline f)) + + The inline proclamation preceding the defun form ensures that the +compiler has the opportunity save the information necessary for inline +expansion, and the notinline proclamation following the defun form +prevents f from being expanded inline everywhere. + + notinline specifies that it is + + undesirable to compile the functions named by function-names in-line. +A compiler is not free to ignore this declaration; calls to the +specified functions must be implemented as out-of-line subroutine calls. + + If one of the functions mentioned has a lexically apparent local +definition (as made by flet or labels), then the declaration applies to +that local definition and not to the global function definition. + + In the presence of a compiler macro definition for function-name, a +notinline declaration prevents that + + compiler macro from being used. + + An inline declaration may be used to encourage use of compiler macro +definitions. inline and notinline declarations otherwise have no effect +when the lexically visible definition of function-name is a macro +definition. + + inline and notinline declarations can be free declarations or bound +declarations. inline and notinline declarations of functions that +appear before the body of a flet or labels + + form that defines that function are bound declarations. Such +declarations in other contexts are free declarations. + +Examples:: +.......... + + ;; The globally defined function DISPATCH should be open-coded, + ;; if the implementation supports inlining, unless a NOTINLINE + ;; declaration overrides this effect. + (declaim (inline dispatch)) + (defun dispatch (x) (funcall (get (car x) 'dispatch) x)) + ;; Here is an example where inlining would be encouraged. + (defun top-level-1 () (dispatch (read-command))) + ;; Here is an example where inlining would be prohibited. + (defun top-level-2 () + (declare (notinline dispatch)) + (dispatch (read-command))) + ;; Here is an example where inlining would be prohibited. + (declaim (notinline dispatch)) + (defun top-level-3 () (dispatch (read-command))) + ;; Here is an example where inlining would be encouraged. + (defun top-level-4 () + (declare (inline dispatch)) + (dispatch (read-command))) + +See Also:: +.......... + +declare, *note declaim:: , *note proclaim:: + + +File: gcl.info, Node: ftype, Next: declaration, Prev: inline, Up: Evaluation and Compilation Dictionary + +3.8.23 ftype [Declaration] +-------------------------- + +Syntax:: +........ + +(ftype type {function-name}*) + +Arguments:: +........... + +function-name--a function name. + + type--a type specifier. + +Valid Context:: +............... + +declaration or proclamation + +Binding Types Affected:: +........................ + +function + +Description:: +............. + +Specifies that the functions named by function-names are of the +functional type type. For example: + + (declare (ftype (function (integer list) t) ith) + (ftype (function (number) float) sine cosine)) + + If one of the functions mentioned has a lexically apparent local +definition (as made by flet or labels), then the declaration applies to +that local definition and not to the global function definition. ftype +declarations never apply to variable bindings (see type). + + The lexically apparent bindings of function-names must not be macro +definitions. (This is because ftype declares the functional definition +of each function name to be of a particular subtype of function, and +macros do not denote functions.) + + ftype + + declarations can be free declarations or bound declarations. ftype +declarations of functions that appear before the body of a flet or +labels + + form that defines that function are bound declarations. Such +declarations in other contexts are free declarations. + +See Also:: +.......... + +declare, *note declaim:: , *note proclaim:: + + +File: gcl.info, Node: declaration, Next: optimize, Prev: ftype, Up: Evaluation and Compilation Dictionary + +3.8.24 declaration [Declaration] +-------------------------------- + +Syntax:: +........ + +(declaration {name}*) + +Arguments:: +........... + +name--a symbol. + +Valid Context:: +............... + +proclamation only + +Description:: +............. + +Advises the compiler that each name is a valid but potentially +non-standard declaration name. The purpose of this is to tell one +compiler not to issue warnings for declarations meant for another +compiler or other program processor. + +Examples:: +.......... + + (declaim (declaration author target-language target-machine)) + (declaim (target-language ada)) + (declaim (target-machine IBM-650)) + (defun strangep (x) + (declare (author "Harry Tweeker")) + (member x '(strange weird odd peculiar))) + +See Also:: +.......... + +*note declaim:: , *note proclaim:: + + +File: gcl.info, Node: optimize, Next: special, Prev: declaration, Up: Evaluation and Compilation Dictionary + +3.8.25 optimize [Declaration] +----------------------------- + +Syntax:: +........ + +(optimize {quality | (quality value)}*) + +Arguments:: +........... + +quality--an optimize quality. + + value--one of the integers 0, 1, 2, or 3. + +Valid Context:: +............... + +declaration or proclamation + +Description:: +............. + +Advises the compiler that each quality should be given attention +according to the specified corresponding value. Each quality must be a +symbol naming an optimize quality; the names and meanings of the +standard optimize qualities are shown in Figure 3-25. + + Name Meaning + compilation-speed speed of the compilation process + debug ease of debugging + safety run-time error checking + space both code size and run-time space + speed speed of the object code + + Figure 3-25: Optimize qualities + + + There may be other, implementation-defined optimize qualities. + + A value 0 means that the corresponding quality is totally +unimportant, and 3 that the quality is extremely important; 1 and 2 are +intermediate values, with 1 the neutral value. (quality 3) can be +abbreviated to quality. + + Note that code which has the optimization (safety 3), or just safety, +is called safe code. + + The consequences are unspecified if a quality appears more than once +with different values. + +Examples:: +.......... + + (defun often-used-subroutine (x y) + (declare (optimize (safety 2))) + (error-check x y) + (hairy-setup x) + (do ((i 0 (+ i 1)) + (z x (cdr z))) + ((null z)) + ;; This inner loop really needs to burn. + (declare (optimize speed)) + (declare (fixnum i)) + )) + +See Also:: +.......... + +declare, *note declaim:: , *note proclaim:: , *note Declaration Scope:: + +Notes:: +....... + +An optimize declaration never applies to either a variable or a function +binding. An optimize declaration can only be a free declaration. For +more information, see *note Declaration Scope::. + + +File: gcl.info, Node: special, Next: locally, Prev: optimize, Up: Evaluation and Compilation Dictionary + +3.8.26 special [Declaration] +---------------------------- + +Syntax:: +........ + +(special {var}*) + +Arguments:: +........... + +var--a symbol. + +Valid Context:: +............... + +declaration or proclamation + +Binding Types Affected:: +........................ + +variable + +Description:: +............. + +Specifies that all of the vars named are dynamic. This specifier +affects variable bindings and affects references. All variable bindings +affected are made to be dynamic bindings, and affected variable +references refer to the current dynamic binding. For example: + + (defun hack (thing *mod*) ;The binding of the parameter + (declare (special *mod*)) ; *mod* is visible to hack1, + (hack1 (car thing))) ; but not that of thing. + (defun hack1 (arg) + (declare (special *mod*)) ;Declare references to *mod* + ;within hack1 to be special. + (if (atom arg) *mod* + (cons (hack1 (car arg)) (hack1 (cdr arg))))) + + A special declaration does not affect inner bindings of a var; the +inner bindings implicitly shadow a special declaration and must be +explicitly re-declared to be special. special declarations never apply +to function bindings. + + special declarations can be either bound declarations, affecting both +a binding and references, or free declarations, affecting only +references, depending on whether the declaration is attached to a +variable binding. + + When used in a proclamation, a special declaration specifier applies +to all bindings as well as to all references of the mentioned variables. +For example, after + + (declaim (special x)) + + then in a function definition such as + + (defun example (x) ...) + + the parameter x is bound as a dynamic variable rather than as a +lexical variable. + +Examples:: +.......... + + (defun declare-eg (y) ;this y is special + (declare (special y)) + (let ((y t)) ;this y is lexical + (list y + (locally (declare (special y)) y)))) ;this y refers to the + ;special binding of y + => DECLARE-EG + (declare-eg nil) => (T NIL) + + (setf (symbol-value 'x) 6) + (defun foo (x) ;a lexical binding of x + (print x) + (let ((x (1+ x))) ;a special binding of x + (declare (special x)) ;and a lexical reference + (bar)) + (1+ x)) + (defun bar () + (print (locally (declare (special x)) + x))) + (foo 10) + |> 10 + |> 11 + => 11 + + (setf (symbol-value 'x) 6) + (defun bar (x y) ;[1] 1st occurrence of x + (let ((old-x x) ;[2] 2nd occurrence of x -- same as 1st occurrence + (x y)) ;[3] 3rd occurrence of x + (declare (special x)) + (list old-x x))) + (bar 'first 'second) => (FIRST SECOND) + + (defun few (x &optional (y *foo*)) + (declare (special *foo*)) + ...) + + The reference to *foo* in the first line of this example is not +special even though there is a special declaration in the second line. + + (declaim (special prosp)) => implementation-dependent + (setq prosp 1 reg 1) => 1 + (let ((prosp 2) (reg 2)) ;the binding of prosp is special + (set 'prosp 3) (set 'reg 3) ;due to the preceding proclamation, + (list prosp reg)) ;whereas the variable reg is lexical + => (3 2) + (list prosp reg) => (1 3) + + (declaim (special x)) ;x is always special. + (defun example (x y) + (declare (special y)) + (let ((y 3) (x (* x 2))) + (print (+ y (locally (declare (special y)) y))) + (let ((y 4)) (declare (special y)) (foo x)))) => EXAMPLE + + In the contorted code above, the outermost and innermost bindings of +y are dynamic, but the middle binding is lexical. The two arguments to ++ are different, one being the value, which is 3, of the lexical +variable y, and the other being the value of the dynamic variable named +y (a binding of which happens, coincidentally, to lexically surround it +at an outer level). All the bindings of x and references to x are +dynamic, however, because of the proclamation that x is always special. + +See Also:: +.......... + +*note defparameter:: , defvar + + +File: gcl.info, Node: locally, Next: the, Prev: special, Up: Evaluation and Compilation Dictionary + +3.8.27 locally [Special Operator] +--------------------------------- + +'locally' {declaration}* {form}* => {result}* + +Arguments and Values:: +...................... + +Declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values of the forms. + +Description:: +............. + +Sequentially evaluates a body of forms in a lexical environment where +the given declarations have effect. + +Examples:: +.......... + + (defun sample-function (y) ;this y is regarded as special + (declare (special y)) + (let ((y t)) ;this y is regarded as lexical + (list y + (locally (declare (special y)) + ;; this next y is regarded as special + y)))) + => SAMPLE-FUNCTION + (sample-function nil) => (T NIL) + (setq x '(1 2 3) y '(4 . 5)) => (4 . 5) + + ;;; The following declarations are not notably useful in specific. + ;;; They just offer a sample of valid declaration syntax using LOCALLY. + (locally (declare (inline floor) (notinline car cdr)) + (declare (optimize space)) + (floor (car x) (cdr y))) => 0, 1 + + ;;; This example shows a definition of a function that has a particular set + ;;; of OPTIMIZE settings made locally to that definition. + (locally (declare (optimize (safety 3) (space 3) (speed 0))) + (defun frob (w x y &optional (z (foo x y))) + (mumble x y z w))) + => FROB + + ;;; This is like the previous example, except that the optimize settings + ;;; remain in effect for subsequent definitions in the same compilation unit. + (declaim (optimize (safety 3) (space 3) (speed 0))) + (defun frob (w x y &optional (z (foo x y))) + (mumble x y z w)) + => FROB + +See Also:: +.......... + +declare + +Notes:: +....... + +The special declaration may be used with locally to affect references +to, rather than bindings of, variables. + + If a locally form is a top level form, the body forms are also +processed as top level forms. See *note File Compilation::. + + +File: gcl.info, Node: the, Next: special-operator-p, Prev: locally, Up: Evaluation and Compilation Dictionary + +3.8.28 the [Special Operator] +----------------------------- + +'the' value-type form => {result}* + +Arguments and Values:: +...................... + +value-type--a type specifier; not evaluated. + + form--a form; evaluated. + + results--the values resulting from the evaluation of form. These +values must conform to the type supplied by value-type; see below. + +Description:: +............. + +the specifies that the values_{1a} returned by form are of the types +specified by value-type. The consequences are undefined if any result +is not of the declared type. + + It is permissible for form to yield a different number of values than +are specified by value-type, provided that the values for which types +are declared are indeed of those types. Missing values are treated as +nil for the purposes of checking their types. + + Regardless of number of values declared by value-type, the number of +values returned by the the special form is the same as the number of +values returned by form. + +Examples:: +.......... + + (the symbol (car (list (gensym)))) => #:G9876 + (the fixnum (+ 5 7)) => 12 + (the (values) (truncate 3.2 2)) => 1, 1.2 + (the integer (truncate 3.2 2)) => 1, 1.2 + (the (values integer) (truncate 3.2 2)) => 1, 1.2 + (the (values integer float) (truncate 3.2 2)) => 1, 1.2 + (the (values integer float symbol) (truncate 3.2 2)) => 1, 1.2 + (the (values integer float symbol t null list) + (truncate 3.2 2)) => 1, 1.2 + (let ((i 100)) + (declare (fixnum i)) + (the fixnum (1+ i))) => 101 + (let* ((x (list 'a 'b 'c)) + (y 5)) + (setf (the fixnum (car x)) y) + x) => (5 B C) + +Exceptional Situations:: +........................ + +The consequences are undefined if the values yielded by the form are not +of the type specified by value-type. + +See Also:: +.......... + +values + +Notes:: +....... + +The values type specifier can be used to indicate the types of multiple +values: + + (the (values integer integer) (floor x y)) + (the (values string t) + (gethash the-key the-string-table)) + + setf can be used with the type declarations. In this case the +declaration is transferred to the form that specifies the new value. +The resulting setf form is then analyzed. + + +File: gcl.info, Node: special-operator-p, Next: constantp, Prev: the, Up: Evaluation and Compilation Dictionary + +3.8.29 special-operator-p [Function] +------------------------------------ + +'special-operator-p' symbol => generalized-boolean + +Arguments and Values:: +...................... + +symbol--a symbol. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if symbol is a special operator; otherwise, returns false. + +Examples:: +.......... + + (special-operator-p 'if) => true + (special-operator-p 'car) => false + (special-operator-p 'one) => false + +Exceptional Situations:: +........................ + +Should signal type-error if its argument is not a symbol. + +Notes:: +....... + +Historically, this function was called special-form-p. The name was +finally declared a misnomer and changed, since it returned true for +special operators, not special forms. + + +File: gcl.info, Node: constantp, Prev: special-operator-p, Up: Evaluation and Compilation Dictionary + +3.8.30 constantp [Function] +--------------------------- + +'constantp' form &optional environment => generalized-boolean + +Arguments and Values:: +...................... + +form--a form. + + environment--an environment object. The default is nil. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if form can be determined by the implementation to be a +constant form in the indicated environment; otherwise, it returns false +indicating either that the form is not a constant form or that it cannot +be determined whether or not form is a constant form. + + The following kinds of forms are considered constant forms: + +* + Self-evaluating objects (such as numbers, characters, and the + various kinds of arrays) are always considered constant forms and + must be recognized as such by constantp. + +* + Constant variables, such as keywords, symbols defined by Common + Lisp as constant (such as nil, t, and pi), and symbols declared as + constant by the user in the indicated environment using defconstant + are always considered constant forms and must be recognized as such + by constantp. + +* + quote forms are always considered constant forms and must be + recognized as such by constantp. + +* + An implementation is permitted, but not required, to detect + additional constant forms. If it does, it is also permitted, but + not required, to make use of information in the environment. + Examples of constant forms for which constantp might or might not + return true are: (sqrt pi), (+ 3 2), (length '(a b c)), and (let + ((x 7)) (zerop x)). + + If an implementation chooses to make use of the environment +information, such actions as expanding macros or performing function +inlining are permitted to be used, but not required; however, expanding +compiler macros is not permitted. + +Examples:: +.......... + + (constantp 1) => true + (constantp 'temp) => false + (constantp ''temp)) => true + (defconstant this-is-a-constant 'never-changing) => THIS-IS-A-CONSTANT + (constantp 'this-is-a-constant) => true + (constantp "temp") => true + (setq a 6) => 6 + (constantp a) => true + (constantp '(sin pi)) => implementation-dependent + (constantp '(car '(x))) => implementation-dependent + (constantp '(eql x x)) => implementation-dependent + (constantp '(typep x 'nil)) => implementation-dependent + (constantp '(typep x 't)) => implementation-dependent + (constantp '(values this-is-a-constant)) => implementation-dependent + (constantp '(values 'x 'y)) => implementation-dependent + (constantp '(let ((a '(a b c))) (+ (length a) 6))) => implementation-dependent + +Affected By:: +............. + +The state of the global environment (e.g., which symbols have been +declared to be the names of constant variables). + +See Also:: +.......... + +*note defconstant:: + + +File: gcl.info, Node: Types and Classes, Next: Data and Control Flow, Prev: Evaluation and Compilation, Up: Top + +4 Types and Classes +******************* + +* Menu: + +* Introduction (Types and Classes):: +* Types:: +* Classes:: +* Types and Classes Dictionary:: + + +File: gcl.info, Node: Introduction (Types and Classes), Next: Types, Prev: Types and Classes, Up: Types and Classes + +4.1 Introduction +================ + +A type is a (possibly infinite) set of objects. An object can belong to +more than one type. Types are never explicitly represented as objects +by Common Lisp. Instead, they are referred to indirectly by the use of +type specifiers, which are objects that denote types. + + New types can be defined using deftype, defstruct, defclass, and +define-condition. + + The function typep, a set membership test, is used to determine +whether a given object is of a given type. The function subtypep, a +subset test, is used to determine whether a given type is a subtype of +another given type. The function type-of returns a particular type to +which a given object belongs, even though that object must belong to one +or more other types as well. (For example, every object is of type t, +but type-of always returns a type specifier for a type more specific +than t.) + + Objects, not variables, have types. Normally, any variable can have +any object as its value. It is possible to declare that a variable +takes on only values of a given type by making an explicit type +declaration. Types are arranged in a directed acyclic graph, except for +the presence of equivalences. + + Declarations can be made about types using declare, proclaim, +declaim, or the. For more information about declarations, see *note +Declarations::. + + Among the fundamental objects of the object system are classes. A +class determines the structure and behavior of a set of other objects, +which are called its instances. Every object is a direct instance of a +class. The class of an object determines the set of operations that can +be performed on the object. For more information, see *note Classes::. + + It is possible to write functions that have behavior specialized to +the class of the objects which are their arguments. For more +information, see *note Generic Functions and Methods::. + + The class of the class of an object is called its metaclass . For +more information about metaclasses, see *note Meta-Objects::. + + +File: gcl.info, Node: Types, Next: Classes, Prev: Introduction (Types and Classes), Up: Types and Classes + +4.2 Types +========= + +* Menu: + +* Data Type Definition:: +* Type Relationships:: +* Type Specifiers:: + + +File: gcl.info, Node: Data Type Definition, Next: Type Relationships, Prev: Types, Up: Types + +4.2.1 Data Type Definition +-------------------------- + +Information about type usage is located in the sections specified in +Figure~4-1. Figure~4-7 lists some classes that are particularly +relevant to the object system. Figure~9-1 lists the defined condition +types. + + Section Data Type + _________________________________________________________________________ + *note Classes:: Object System types + *note Slots:: Object System types + *note Objects:: Object System types + *note Generic Functions and Methods:: Object System types + *note Condition System Concepts:: Condition System types + *note Types and Classes:: Miscellaneous types + *note Syntax:: All types--read and print syntax + *note The Lisp Printer:: All types--print syntax + *note Compilation:: All types--compilation issues + + Figure 4-1: Cross-References to Data Type Information + + + +File: gcl.info, Node: Type Relationships, Next: Type Specifiers, Prev: Data Type Definition, Up: Types + +4.2.2 Type Relationships +------------------------ + +* + The types cons, symbol, array, number, character, hash-table, + + function, + + readtable, package, pathname, stream, random-state, condition, + restart, and any single other type created by defstruct, + + define-condition, + + or defclass are pairwise disjoint, except for type relations + explicitly established by specifying superclasses in defclass + + or define-condition + + or the :include option of destruct. + +* + Any two types created by defstruct are disjoint unless one is a + supertype of the other by virtue of the defstruct :include option. + + [Editorial Note by KMP: The comments in the source say gray + suggested some change from "common superclass" to "common subclass" + in the following, but the result looks suspicious to me.] + +* + Any two distinct classes created by defclass or define-condition + are disjoint unless they have a common subclass or one class is a + subclass of the other. + +* + An implementation may be extended to add other subtype + relationships between the specified types, as long as they do not + violate the type relationships and disjointness requirements + specified here. An implementation may define additional types that + are subtypes or supertypes of any specified types, as long as each + additional type is a subtype of type t and a supertype of type nil + and the disjointness requirements are not violated. + + At the discretion of the implementation, either standard-object or + structure-object might appear in any class precedence list for a + system class that does not already specify either standard-object + or structure-object. If it does, it must precede the class t and + follow all other standardized classes. + + +File: gcl.info, Node: Type Specifiers, Prev: Type Relationships, Up: Types + +4.2.3 Type Specifiers +--------------------- + +Type specifiers can be symbols, classes, or lists. Figure~4-2 lists +symbols that are standardized atomic type specifiers, and Figure~4-3 +lists standardized compound type specifier names. For syntax +information, see the dictionary entry for the corresponding type +specifier. It is possible to define new type specifiers using defclass, +define-condition, defstruct, or deftype. + + arithmetic-error function simple-condition + array generic-function simple-error + atom hash-table simple-string + base-char integer simple-type-error + base-string keyword simple-vector + bignum list simple-warning + bit logical-pathname single-float + bit-vector long-float standard-char + broadcast-stream method standard-class + built-in-class method-combination standard-generic-function + cell-error nil standard-method + character null standard-object + class number storage-condition + compiled-function package stream + complex package-error stream-error + concatenated-stream parse-error string + condition pathname string-stream + cons print-not-readable structure-class + control-error program-error structure-object + division-by-zero random-state style-warning + double-float ratio symbol + echo-stream rational synonym-stream + end-of-file reader-error t + error readtable two-way-stream + extended-char real type-error + file-error restart unbound-slot + file-stream sequence unbound-variable + fixnum serious-condition undefined-function + float short-float unsigned-byte + floating-point-inexact signed-byte vector + floating-point-invalid-operation simple-array warning + floating-point-overflow simple-base-string + floating-point-underflow simple-bit-vector + + Figure 4-2: Standardized Atomic Type Specifiers + + + \indent If a type specifier is a list, the car of the list is a +symbol, and the rest of the list is subsidiary type information. Such a +type specifier is called a compound type specifier . Except as +explicitly stated otherwise, the subsidiary items can be unspecified. +The unspecified subsidiary items are indicated by writing *. For +example, to completely specify a vector, the type of the elements and +the length of the vector must be present. + + (vector double-float 100) + + The following leaves the length unspecified: + + (vector double-float *) + + The following leaves the element type unspecified: + + (vector * 100) + + Suppose that two type specifiers are the same except that the first +has a * where the second has a more explicit specification. Then the +second denotes a subtype of the type denoted by the first. + + If a list has one or more unspecified items at the end, those items +can be dropped. If dropping all occurrences of * results in a singleton +list, then the parentheses can be dropped as well (the list can be +replaced by the symbol in its car). For example, (vector double-float +*) can be abbreviated to (vector double-float), and (vector * *) can be +abbreviated to (vector) and then to vector. + + and long-float simple-base-string + array member simple-bit-vector + base-string mod simple-string + bit-vector not simple-vector + complex or single-float + cons rational string + double-float real unsigned-byte + eql satisfies values + float short-float vector + function signed-byte + integer simple-array + + Figure 4-3: Standardized Compound Type Specifier Names + + + Figure 4-4 show the defined names that can be used as compound type +specifier names but that cannot be used as atomic type specifiers. + + and mod satisfies + eql not values + member or + + Figure 4-4: Standardized Compound-Only Type Specifier Names + + + New type specifiers can come into existence in two ways. + +* + Defining a structure by using defstruct without using the :type + specifier or defining a class by using defclass or define-condition + automatically causes the name of the structure or class to be a new + type specifier symbol. +* + deftype can be used to define derived type specifiers , which act + as 'abbreviations' for other type specifiers. + + A class object can be used as a type specifier. When used this way, +it denotes the set of all members of that class. + + Figure 4-5 shows some defined names relating to types and +declarations. + + coerce defstruct subtypep + declaim deftype the + declare ftype type + defclass locally type-of + define-condition proclaim typep + + Figure 4-5: Defined names relating to types and declarations. + + + Figure 4-6 shows all defined names that are type specifier names, +whether for atomic type specifiers or compound type specifiers; this +list is the union of the lists in Figure~4-2 and Figure~4-3. + + and function simple-array + arithmetic-error generic-function simple-base-string + array hash-table simple-bit-vector + atom integer simple-condition + base-char keyword simple-error + base-string list simple-string + bignum logical-pathname simple-type-error + bit long-float simple-vector + bit-vector member simple-warning + broadcast-stream method single-float + built-in-class method-combination standard-char + cell-error mod standard-class + character nil standard-generic-function + class not standard-method + compiled-function null standard-object + complex number storage-condition + concatenated-stream or stream + condition package stream-error + cons package-error string + control-error parse-error string-stream + division-by-zero pathname structure-class + double-float print-not-readable structure-object + echo-stream program-error style-warning + end-of-file random-state symbol + eql ratio synonym-stream + error rational t + extended-char reader-error two-way-stream + file-error readtable type-error + file-stream real unbound-slot + fixnum restart unbound-variable + float satisfies undefined-function + floating-point-inexact sequence unsigned-byte + floating-point-invalid-operation serious-condition values + floating-point-overflow short-float vector + floating-point-underflow signed-byte warning + + Figure 4-6: Standardized Type Specifier Names + + + +File: gcl.info, Node: Classes, Next: Types and Classes Dictionary, Prev: Types, Up: Types and Classes + +4.3 Classes +=========== + +While the object system is general enough to describe all standardized +classes (including, for example, number, hash-table, and symbol), Figure +4-7 contains a list of classes that are especially relevant to +understanding the object system. + + built-in-class method-combination standard-object + class standard-class structure-class + generic-function standard-generic-function structure-object + method standard-method + + Figure 4-7: Object System Classes + + +* Menu: + +* Introduction to Classes:: +* Defining Classes:: +* Creating Instances of Classes:: +* Inheritance:: +* Determining the Class Precedence List:: +* Redefining Classes:: +* Integrating Types and Classes:: + + +File: gcl.info, Node: Introduction to Classes, Next: Defining Classes, Prev: Classes, Up: Classes + +4.3.1 Introduction to Classes +----------------------------- + +A class is an object that determines the structure and behavior of a set +of other objects, which are called its instances . + + A class can inherit structure and behavior from other classes. A +class whose definition refers to other classes for the purpose of +inheriting from them is said to be a subclass of each of those classes. +The classes that are designated for purposes of inheritance are said to +be superclasses of the inheriting class. + + A class can have a name. The function class-name takes a class +object and returns its name. The name of an anonymous class is nil. A +symbol can name a class. The function find-class takes a symbol and +returns the class that the symbol names. A class has a proper name if +the name is a symbol and if the name of the class names that class. +That is, a class~C has the proper name~S if S= (class-name C) and C= +(find-class S). Notice that it is possible for (find-class S_1) = +(find-class S_2) and S_1!= S_2. If C= (find-class S), we say that C is +the class named S. + + A class C_1 is a direct superclass of a class C_2 if C_2 explicitly +designates C_1 as a superclass in its definition. In this case C_2 is a +direct subclass of C_1. A class C_n is a superclass of a class C_1 if +there exists a series of classes C_2,...,C_{n-1} such that C_{i+1} is a +direct superclass of C_i for 1 <= i= 2, be the classes from +S_C with no predecessors. Let (C_1... C_n), n>= 1, be the class +precedence list constructed so far. C_1 is the most specific class, and +C_n is the least specific. Let 1<= j<= n be the largest number such +that there exists an i where 1<= i<= m and N_i is a direct superclass of +C_j; N_i is placed next. + + The effect of this rule for selecting from a set of classes with no +predecessors is that the classes in a simple superclass chain are +adjacent in the class precedence list and that classes in each +relatively separated subgraph are adjacent in the class precedence list. +For example, let T_1 and T_2 be subgraphs whose only element in common +is the class J. Suppose that no superclass of J appears in either T_1 or +T_2, and that J is in the superclass chain of every class in both T_1 +and T_2. Let C_1 be the bottom of T_1; and let C_2 be the bottom of +T_2. Suppose C is a class whose direct superclasses are C_1 and C_2 in +that order, then the class precedence list for C starts with C and is +followed by all classes in T_1 except J. All the classes of T_2 are +next. The class J and its superclasses appear last. + + +File: gcl.info, Node: Examples of Class Precedence List Determination, Prev: Topological Sorting, Up: Determining the Class Precedence List + +4.3.5.2 Examples of Class Precedence List Determination +....................................................... + +This example determines a class precedence list for the class pie. The +following classes are defined: + + (defclass pie (apple cinnamon) ()) + + (defclass apple (fruit) ()) + + (defclass cinnamon (spice) ()) + + (defclass fruit (food) ()) + + (defclass spice (food) ()) + + (defclass food () ()) + + The set S_{pie}~= {pie, apple, cinnamon, fruit, spice, food, +standard-object, t }. The set R~= { (pie, apple), (apple, cinnamon), +(apple, fruit), (cinnamon, spice), \break (fruit, food), (spice, food), +(food, standard-object), (standard-object, t) }. + + The class pie is not preceded by anything, so it comes first; the +result so far is (pie). Remove pie from S and pairs mentioning pie from +R to get S~= {apple, cinnamon, fruit, spice, food, standard-object, t } +and R~=~{(apple, cinnamon), (apple, fruit), (cinnamon, spice),\break +(fruit, food), (spice, food), (food, standard-object), (standard-object, +t) }. + + The class apple is not preceded by anything, so it is next; the +result is (pie apple). Removing apple and the relevant pairs results in +S~= { cinnamon, fruit, spice, food, standard-object, t } and R~= { +(cinnamon, spice), (fruit, food), (spice, food), (food, +standard-object),\break (standard-object, t) }. + + The classes cinnamon and fruit are not preceded by anything, so the +one with a direct subclass rightmost in the class precedence list +computed so far goes next. The class apple is a direct subclass of +fruit, and the class pie is a direct subclass of cinnamon. Because +apple appears to the right of pie in the class precedence list, fruit +goes next, and the result so far is (pie apple fruit). S~= { cinnamon, +spice, food, standard-object, t }; R~= {(cinnamon, spice), (spice, +food),\break (food, standard-object), (standard-object, t) }. + + The class cinnamon is next, giving the result so far as (pie apple +fruit cinnamon). At this point S~= { spice, food, standard-object, t }; +R~= { (spice, food), (food, standard-object), (standard-object, t) }. + + The classes spice, food, standard-object, and t are added in that +order, and the class precedence list is (pie apple fruit cinnamon spice +food standard-object t). + + It is possible to write a set of class definitions that cannot be +ordered. For example: + + (defclass new-class (fruit apple) ()) + + (defclass apple (fruit) ()) + + The class fruit must precede apple because the local ordering of +superclasses must be preserved. The class apple must precede fruit +because a class always precedes its own superclasses. When this +situation occurs, an error is signaled, as happens here when the system +tries to compute the class precedence list of new-class. + + The following might appear to be a conflicting set of definitions: + + (defclass pie (apple cinnamon) ()) + + (defclass pastry (cinnamon apple) ()) + + (defclass apple () ()) + + (defclass cinnamon () ()) + + The class precedence list for pie is (pie apple cinnamon +standard-object t). + + The class precedence list for pastry is (pastry cinnamon apple +standard-object t). + + It is not a problem for apple to precede cinnamon in the ordering of +the superclasses of pie but not in the ordering for pastry. However, it +is not possible to build a new class that has both pie and pastry as +superclasses. + + +File: gcl.info, Node: Redefining Classes, Next: Integrating Types and Classes, Prev: Determining the Class Precedence List, Up: Classes + +4.3.6 Redefining Classes +------------------------ + +A class that is a direct instance of standard-class can be redefined if +the new class is also a direct instance of standard-class. Redefining a +class modifies the existing class object to reflect the new class +definition; it does not create a new class object for the class. Any +method object created by a :reader, :writer, or :accessor option +specified by the old defclass form is removed from the corresponding +generic function. Methods specified by the new defclass form are added. + + When the class C is redefined, changes are propagated to its +instances and to instances of any of its subclasses. Updating such an +instance occurs at an implementation-dependent time, but no later than +the next time a slot of that instance is read or written. Updating an +instance does not change its identity as defined by the function eq. +The updating process may change the slots of that particular instance, +but it does not create a new instance. Whether updating an instance +consumes storage is implementation-dependent. + + Note that redefining a class may cause slots to be added or deleted. +If a class is redefined in a way that changes the set of local slots +accessible in instances, the instances are updated. It is +implementation-dependent whether instances are updated if a class is +redefined in a way that does not change the set of local slots +accessible in instances. + + The value of a slot that is specified as shared both in the old class +and in the new class is retained. If such a shared slot was unbound in +the old class, it is unbound in the new class. Slots that were local in +the old class and that are shared in the new class are initialized. +Newly added shared slots are initialized. + + Each newly added shared slot is set to the result of evaluating the +captured initialization form for the slot that was specified in the +defclass form for the new class. If there was no initialization form, +the slot is unbound. + + If a class is redefined in such a way that the set of local slots +accessible in an instance of the class is changed, a two-step process of +updating the instances of the class takes place. The process may be +explicitly started by invoking the generic function +make-instances-obsolete. This two-step process can happen in other +circumstances in some implementations. For example, in some +implementations this two-step process is triggered if the order of slots +in storage is changed. + + The first step modifies the structure of the instance by adding new +local slots and discarding local slots that are not defined in the new +version of the class. The second step initializes the newly-added local +slots and performs any other user-defined actions. These two steps are +further specified in the next two sections. + +* Menu: + +* Modifying the Structure of Instances:: +* Initializing Newly Added Local Slots (Redefining Classes):: +* Customizing Class Redefinition:: + + +File: gcl.info, Node: Modifying the Structure of Instances, Next: Initializing Newly Added Local Slots (Redefining Classes), Prev: Redefining Classes, Up: Redefining Classes + +4.3.6.1 Modifying the Structure of Instances +............................................ + +[Reviewer Note by Barmar: What about shared slots that are deleted?] + + The first step modifies the structure of instances of the redefined +class to conform to its new class definition. Local slots specified by +the new class definition that are not specified as either local or +shared by the old class are added, and slots not specified as either +local or shared by the new class definition that are specified as local +by the old class are discarded. The names of these added and discarded +slots are passed as arguments to update-instance-for-redefined-class as +described in the next section. + + The values of local slots specified by both the new and old classes +are retained. If such a local slot was unbound, it remains unbound. + + The value of a slot that is specified as shared in the old class and +as local in the new class is retained. If such a shared slot was +unbound, the local slot is unbound. + + +File: gcl.info, Node: Initializing Newly Added Local Slots (Redefining Classes), Next: Customizing Class Redefinition, Prev: Modifying the Structure of Instances, Up: Redefining Classes + +4.3.6.2 Initializing Newly Added Local Slots +............................................ + +The second step initializes the newly added local slots and performs any +other user-defined actions. This step is implemented by the generic +function update-instance-for-redefined-class, which is called after +completion of the first step of modifying the structure of the instance. + + The generic function update-instance-for-redefined-class takes four +required arguments: the instance being updated after it has undergone +the first step, a list of the names of local slots that were added, a +list of the names of local slots that were discarded, and a property +list containing the slot names and values of slots that were discarded +and had values. Included among the discarded slots are slots that were +local in the old class and that are shared in the new class. + + The generic function update-instance-for-redefined-class also takes +any number of initialization arguments. When it is called by the system +to update an instance whose class has been redefined, no initialization +arguments are provided. + + There is a system-supplied primary method for +update-instance-for-redefined-class whose parameter specializer for its +instance argument is the class standard-object. First this method +checks the validity of initialization arguments and signals an error if +an initialization argument is supplied that is not declared as valid. +(For more information, see *note Declaring the Validity of +Initialization Arguments::.) Then it calls the generic function +shared-initialize with the following arguments: the instance, the list +of names of the newly added slots, and the initialization arguments it +received. + + +File: gcl.info, Node: Customizing Class Redefinition, Prev: Initializing Newly Added Local Slots (Redefining Classes), Up: Redefining Classes + +4.3.6.3 Customizing Class Redefinition +...................................... + +[Reviewer Note by Barmar: This description is hard to follow.] + + Methods for update-instance-for-redefined-class may be defined to +specify actions to be taken when an instance is updated. If only after +methods for update-instance-for-redefined-class are defined, they will +be run after the system-supplied primary method for initialization and +therefore will not interfere with the default behavior of +update-instance-for-redefined-class. Because no initialization +arguments are passed to update-instance-for-redefined-class when it is +called by the system, the initialization forms for slots that are filled +by before methods for update-instance-for-redefined-class will not be +evaluated by shared-initialize. + + Methods for shared-initialize may be defined to customize class +redefinition. For more information, see *note Shared-Initialize::. + + +File: gcl.info, Node: Integrating Types and Classes, Prev: Redefining Classes, Up: Classes + +4.3.7 Integrating Types and Classes +----------------------------------- + +The object system maps the space of classes into the space of types. +Every class that has a proper name has a corresponding type with the +same name. + + The proper name of every class is a valid type specifier. In +addition, every class object is a valid type specifier. Thus the +expression (typep object class) evaluates to true if the class of object +is class itself or a subclass of class. The evaluation of the +expression (subtypep class1 class2) returns the values true and true if +class1 is a subclass of class2 or if they are the same class; otherwise +it returns the values false and true. If I is an instance of some class +C named S and C is an instance of standard-class, the evaluation of the +expression (type-of I\/) returns S if S is the proper name of C; +otherwise, it returns C. + + Because the names of classes and class objects are type specifiers, +they may be used in the special form the and in type declarations. + + Many but not all of the predefined type specifiers have a +corresponding class with the same proper name as the type. These type +specifiers are listed in Figure~4-8. For example, the type array has a +corresponding class named array. No type specifier that is a list, such +as (vector double-float 100), has a corresponding class. The operator +deftype does not create any classes. + + Each class that corresponds to a predefined type specifier can be +implemented in one of three ways, at the discretion of each +implementation. It can be a standard class, a structure class, + + or a system class. + + A built-in class is one whose generalized instances have restricted +capabilities or special representations. Attempting to use defclass to +define subclasses of a built-in-class signals an error. Calling +make-instance to create a generalized instance of a built-in class +signals an error. Calling slot-value on a generalized instance of a +built-in class signals an error. Redefining a built-in class or using +change-class to change the class of an object to or from a built-in +class signals an error. However, built-in classes can be used as +parameter specializers in methods. + + It is possible to determine whether a class is a built-in class by +checking the metaclass. A standard class is an instance of the class +standard-class, a built-in class is an instance of the class +built-in-class, and a structure class is an instance of the class +structure-class. + + Each structure type created by defstruct without using the :type +option has a corresponding class. This class is a generalized instance +of the class structure-class. The :include option of defstruct creates +a direct subclass of the class that corresponds to the included +structure type. + + It is implementation-dependent whether slots are involved in the +operation of functions defined in this specification on instances of +classes defined in this specification, except when slots are explicitly +defined by this specification. + + If in a particular implementation a class defined in this +specification has slots that are not defined by this specfication, the +names of these slots must not be external symbols of packages defined in +this specification nor otherwise accessible in the CL-USER package. + + The purpose of specifying that many of the standard type specifiers +have a corresponding class is to enable users to write methods that +discriminate on these types. Method selection requires that a class +precedence list can be determined for each class. + + The hierarchical relationships among the type specifiers are mirrored +by relationships among the classes corresponding to those types. + + Figure~4-8 lists the set of classes that correspond to predefined +type specifiers. + + arithmetic-error generic-function simple-error + array hash-table simple-type-error + bit-vector integer simple-warning + broadcast-stream list standard-class + built-in-class logical-pathname standard-generic-function + cell-error method standard-method + character method-combination standard-object + class null storage-condition + complex number stream + concatenated-stream package stream-error + condition package-error string + cons parse-error string-stream + control-error pathname structure-class + division-by-zero print-not-readable structure-object + echo-stream program-error style-warning + end-of-file random-state symbol + error ratio synonym-stream + file-error rational t + file-stream reader-error two-way-stream + float readtable type-error + floating-point-inexact real unbound-slot + floating-point-invalid-operation restart unbound-variable + floating-point-overflow sequence undefined-function + floating-point-underflow serious-condition vector + function simple-condition warning + + Figure 4-8: Classes that correspond to pre-defined type specifiers + + + The class precedence list information specified in the entries for +each of these classes are those that are required by the object system. + + Individual implementations may be extended to define other type +specifiers to have a corresponding class. Individual implementations +may be extended to add other subclass relationships and to add other +elements to the class precedence lists as long as they do not violate +the type relationships and disjointness requirements specified by this +standard. A standard class defined with no direct superclasses is +guaranteed to be disjoint from all of the classes in the table, except +for the class named t. + + +File: gcl.info, Node: Types and Classes Dictionary, Prev: Classes, Up: Types and Classes + +4.4 Types and Classes Dictionary +================================ + +* Menu: + +* nil (Type):: +* boolean:: +* function (System Class):: +* compiled-function:: +* generic-function:: +* standard-generic-function:: +* class:: +* built-in-class:: +* structure-class:: +* standard-class:: +* method:: +* standard-method:: +* structure-object:: +* standard-object:: +* method-combination:: +* t (System Class):: +* satisfies:: +* member (Type Specifier):: +* not (Type Specifier):: +* and (Type Specifier):: +* or (Type Specifier):: +* values (Type Specifier):: +* eql (Type Specifier):: +* coerce:: +* deftype:: +* subtypep:: +* type-of:: +* typep:: +* type-error:: +* type-error-datum:: +* simple-type-error:: + + +File: gcl.info, Node: nil (Type), Next: boolean, Prev: Types and Classes Dictionary, Up: Types and Classes Dictionary + +4.4.1 nil [Type] +---------------- + +Supertypes:: +............ + +all types + +Description:: +............. + +The type nil contains no objects and so is also called the empty type. +The type nil is a subtype of every type. No object is of type nil. + +Notes:: +....... + +The type containing the object nil is the type null, not the type nil. + + +File: gcl.info, Node: boolean, Next: function (System Class), Prev: nil (Type), Up: Types and Classes Dictionary + +4.4.2 boolean [Type] +-------------------- + +Supertypes:: +............ + +boolean, symbol, t + +Description:: +............. + +The type boolean contains the symbols t and nil, which represent true +and false, respectively. + +See Also:: +.......... + +t (constant variable), nil (constant variable), *note if:: , *note not:: +, *note complement:: + +Notes:: +....... + +Conditional operations, such as if, permit the use of generalized +booleans, not just booleans; any non-nil value, not just t, counts as +true for a generalized boolean. However, as a matter of convention, the +symbol t is considered the canonical value to use even for a generalized +boolean when no better choice presents itself. + + +File: gcl.info, Node: function (System Class), Next: compiled-function, Prev: boolean, Up: Types and Classes Dictionary + +4.4.3 function [System Class] +----------------------------- + +Class Precedence List:: +....................... + +function, t + +Description:: +............. + +A function is an object that represents code to be executed when an +appropriate number of arguments is supplied. A function is produced by +the function special form, the function coerce, + + or the function compile. A function can be directly invoked by using +it as the first argument to funcall, apply, or multiple-value-call. + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('function'{[arg-typespec [value-typespec]]}) + + arg-typespec ::=({typespec}* + [&optional {typespec}*] + [&rest typespec] + [&key {(keyword typespec )}*]) + +Compound Type Specifier Arguments:: +................................... + +typespec--a type specifier. + + value-typespec--a type specifier. + +Compound Type Specifier Description:: +..................................... + +[Editorial Note by KMP: Isn't there some context info about ftype +declarations to be merged here?] + + [Editorial Note by KMP: This could still use some cleaning up.] + + [Editorial Note by Sandra: Still need clarification about what +happens if the number of arguments doesn't match the FUNCTION type +declaration.] + + The list form of the function type-specifier can be used only for +declaration and not for discrimination. Every element of this type is a +function that accepts arguments of the types specified by the argj-types +and returns values that are members of the types specified by +value-type. The &optional, &rest, &key, + + and &allow-other-keys + + markers can appear in the list of argument types. + + The type specifier provided with &rest is the type of each actual +argument, not the type of the corresponding variable. + + The &key parameters should be supplied as lists of the form (keyword +type). The keyword must be a valid keyword-name symbol as must be +supplied in the actual arguments of a call. + + This is usually a symbol in the KEYWORD package but can be any +symbol. + + When &key is given in a function type specifier lambda list, the +keyword parameters given are exhaustive unless &allow-other-keys is also +present. &allow-other-keys is an indication that other keyword +arguments might actually be supplied and, if supplied, can be used. For +example, the type of the function make-list could be declared as +follows: + + (function ((integer 0) &key (:initial-element t)) list) + + The value-type can be a values type specifier in order to indicate +the types of multiple values. + + Consider a declaration of the following form: + + (ftype (function (arg0-type arg1-type ...) val-type) f)) + + Any form (f arg0 arg1 ...) within the scope of that declaration is +equivalent to the following: + + (the val-type (f (the arg0-type arg0) (the arg1-type arg1) ...)) + + That is, the consequences are undefined if any of the arguments are +not of the specified types or the result is not of the specified type. +In particular, if any argument is not of the correct type, the result is +not guaranteed to be of the specified type. + + Thus, an ftype declaration for a function describes calls to the +function, not the actual definition of the function. + + Consider a declaration of the following form: + + (type (function (arg0-type arg1-type ...) val-type) fn-valued-variable) + + This declaration has the interpretation that, within the scope of the +declaration, the consequences are unspecified if the value of +fn-valued-variable is called with arguments not of the specified types; +the value resulting from a valid call will be of type val-type. + + As with variable type declarations, nested declarations imply +intersections of types, as follows: + +* + Consider the following two declarations of ftype: + + (ftype (function (arg0-type1 arg1-type1 ...) val-type1) f)) + + and + + (ftype (function (arg0-type2 arg1-type2 ...) val-type2) f)) + + If both these declarations are in effect, then within the shared + scope of the declarations, calls to f can be treated as if f were + declared as follows: + + (ftype (function ((and arg0-type1 arg0-type2) (and arg1-type1 arg1-type2 ...) ...) + (and val-type1 val-type2)) + f)) + + It is permitted to ignore one or all of the ftype declarations in + force. + +* + If two (or more) type declarations are in effect for a variable, + and they are both function declarations, the declarations combine + similarly. + + +File: gcl.info, Node: compiled-function, Next: generic-function, Prev: function (System Class), Up: Types and Classes Dictionary + +4.4.4 compiled-function [Type] +------------------------------ + +Supertypes:: +............ + +compiled-function, function, t + +Description:: +............. + +Any function may be considered by an implementation to be a a compiled +function if it contains no references to macros that must be expanded at +run time, and it contains no unresolved references to load time values. +See *note Compilation Semantics::. + + Functions whose definitions appear lexically within a file that has +been compiled with compile-file and then loaded with load are of type +compiled-function. + + Functions produced by the compile function are of type +compiled-function. + + Other functions might also be of type compiled-function. + + +File: gcl.info, Node: generic-function, Next: standard-generic-function, Prev: compiled-function, Up: Types and Classes Dictionary + +4.4.5 generic-function [System Class] +------------------------------------- + +Class Precedence List:: +....................... + +generic-function, function, t + +Description:: +............. + +A generic function is a function whose behavior depends on the classes +or identities of the arguments supplied to it. A generic function +object contains a set of methods, a lambda list, a method combination +type, and other information. The methods define the class-specific +behavior and operations of the generic function; a method is said to +specialize a generic function. When invoked, a generic function +executes a subset of its methods based on the classes or identities of +its arguments. + + A generic function can be used in the same ways that an ordinary +function can be used; specifically, a generic function can be used as an +argument to funcall and apply, and can be given a global or a local +name. + + +File: gcl.info, Node: standard-generic-function, Next: class, Prev: generic-function, Up: Types and Classes Dictionary + +4.4.6 standard-generic-function [System Class] +---------------------------------------------- + +Class Precedence List:: +....................... + +standard-generic-function, generic-function, function, t + +Description:: +............. + +The class standard-generic-function is the default class of generic +functions established by defmethod, ensure-generic-function, defgeneric, + + and defclass forms. + + +File: gcl.info, Node: class, Next: built-in-class, Prev: standard-generic-function, Up: Types and Classes Dictionary + +4.4.7 class [System Class] +-------------------------- + +Class Precedence List:: +....................... + +class, + + standard-object, + + t + +Description:: +............. + +The type class represents objects that determine the structure and +behavior of their instances. Associated with an object of type class is +information describing its place in the directed acyclic graph of +classes, its slots, and its options. + + +File: gcl.info, Node: built-in-class, Next: structure-class, Prev: class, Up: Types and Classes Dictionary + +4.4.8 built-in-class [System Class] +----------------------------------- + +Class Precedence List:: +....................... + +built-in-class, class, + + standard-object, + + t + +Description:: +............. + +A built-in class is a class whose instances have restricted capabilities +or special representations. Attempting to use defclass to define +subclasses of a built-in class signals an error of type error. Calling +make-instance to create an instance of a built-in class signals an error +of type error. Calling slot-value on an instance of a built-in class +signals an error of type error. Redefining a built-in class or using +change-class to change the class of an instance to or from a built-in +class signals an error of type error. However, built-in classes can be +used as parameter specializers in methods. + + +File: gcl.info, Node: structure-class, Next: standard-class, Prev: built-in-class, Up: Types and Classes Dictionary + +4.4.9 structure-class [System Class] +------------------------------------ + +Class Precedence List:: +....................... + +structure-class, class, + + standard-object, + + t + +Description:: +............. + +All classes defined by means of defstruct are instances of the class +structure-class. + + +File: gcl.info, Node: standard-class, Next: method, Prev: structure-class, Up: Types and Classes Dictionary + +4.4.10 standard-class [System Class] +------------------------------------ + +Class Precedence List:: +....................... + +standard-class, class, + + standard-object, + + t + +Description:: +............. + +The class standard-class is the default class of classes defined by +defclass. + + +File: gcl.info, Node: method, Next: standard-method, Prev: standard-class, Up: Types and Classes Dictionary + +4.4.11 method [System Class] +---------------------------- + +Class Precedence List:: +....................... + +method, t + +Description:: +............. + +A method is an object that represents a modular part of the behavior of +a generic function. + + A method contains code to implement the method's behavior, a sequence +of parameter specializers that specify when the given method is +applicable, and a sequence of qualifiers that is used by the method +combination facility to distinguish among methods. Each required +parameter of each method has an associated parameter specializer, and +the method will be invoked only on arguments that satisfy its parameter +specializers. + + The method combination facility controls the selection of methods, +the order in which they are run, and the values that are returned by the +generic function. The object system offers a default method combination +type and provides a facility for declaring new types of method +combination. + +See Also:: +.......... + +*note Generic Functions and Methods:: + + +File: gcl.info, Node: standard-method, Next: structure-object, Prev: method, Up: Types and Classes Dictionary + +4.4.12 standard-method [System Class] +------------------------------------- + +Class Precedence List:: +....................... + +standard-method, method, + + standard-object, + + t + +Description:: +............. + +The class standard-method is the default class of methods defined by the +defmethod and defgeneric forms. + + +File: gcl.info, Node: structure-object, Next: standard-object, Prev: standard-method, Up: Types and Classes Dictionary + +4.4.13 structure-object [Class] +------------------------------- + +Class Precedence List:: +....................... + +structure-object, t + +Description:: +............. + +The class structure-object is an instance of structure-class and is a +superclass of every class that is an instance of structure-class except +itself, and is a superclass of every class that is defined by defstruct. + +See Also:: +.......... + +*note defstruct:: , *note Sharpsign S::, *note Printing Structures:: + + +File: gcl.info, Node: standard-object, Next: method-combination, Prev: structure-object, Up: Types and Classes Dictionary + +4.4.14 standard-object [Class] +------------------------------ + +Class Precedence List:: +....................... + +standard-object, t + +Description:: +............. + +The class standard-object is an instance of standard-class and is a +superclass of every class that is an instance of standard-class except +itself. + + +File: gcl.info, Node: method-combination, Next: t (System Class), Prev: standard-object, Up: Types and Classes Dictionary + +4.4.15 method-combination [System Class] +---------------------------------------- + +Class Precedence List:: +....................... + +method-combination, t + +Description:: +............. + +Every method combination object is an indirect instance of the class +method-combination. A method combination object represents the +information about the method combination being used by a generic +function. A method combination object contains information about both +the type of method combination and the arguments being used with that +type. + + +File: gcl.info, Node: t (System Class), Next: satisfies, Prev: method-combination, Up: Types and Classes Dictionary + +4.4.16 t [System Class] +----------------------- + +Class Precedence List:: +....................... + +t + +Description:: +............. + +The set of all objects. The type t is a supertype of every type, +including itself. Every object is of type t. + + +File: gcl.info, Node: satisfies, Next: member (Type Specifier), Prev: t (System Class), Up: Types and Classes Dictionary + +4.4.17 satisfies [Type Specifier] +--------------------------------- + +Compound Type Specifier Kind:: +.............................. + +Predicating. + +Compound Type Specifier Syntax:: +................................ + +('satisfies'{predicate-name}) + +Compound Type Specifier Arguments:: +................................... + +predicate-name--a symbol. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of all objects that satisfy the predicate +predicate-name, which must be a symbol whose global function definition +is a one-argument predicate. A name is required for predicate-name; +lambda expressions are not allowed. For example, the type specifier +(and integer (satisfies evenp)) denotes the set of all even integers. +The form (typep x '(satisfies p)) is equivalent to (if (p x) t nil). + + The argument is required. The symbol * can be the argument, but it +denotes itself (the symbol *), and does not represent an unspecified +value. + + The symbol satisfies is not valid as a type specifier. + + +File: gcl.info, Node: member (Type Specifier), Next: not (Type Specifier), Prev: satisfies, Up: Types and Classes Dictionary + +4.4.18 member [Type Specifier] +------------------------------ + +Compound Type Specifier Kind:: +.............................. + +Combining. + +Compound Type Specifier Syntax:: +................................ + +('member'{{object}*}) + +Compound Type Specifier Arguments:: +................................... + +object--an object. + +Compound Type Specifier Description:: +..................................... + +This denotes the set containing the named objects. An object is of this +type if and only if it is eql to one of the specified objects. + + The type specifiers (member) and nil are equivalent. * can be among +the objects, but if so it denotes itself (the symbol *) and does not +represent an unspecified value. The symbol member is not valid as a +type specifier; and, specifically, it is not an abbreviation for either +(member) or (member *). + +See Also:: +.......... + +the type eql + + +File: gcl.info, Node: not (Type Specifier), Next: and (Type Specifier), Prev: member (Type Specifier), Up: Types and Classes Dictionary + +4.4.19 not [Type Specifier] +--------------------------- + +Compound Type Specifier Kind:: +.............................. + +Combining. + +Compound Type Specifier Syntax:: +................................ + +('not'{typespec}) + +Compound Type Specifier Arguments:: +................................... + +typespec--a type specifier. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of all objects that are not of the type typespec. + + The argument is required, and cannot be *. + + The symbol not is not valid as a type specifier. + + +File: gcl.info, Node: and (Type Specifier), Next: or (Type Specifier), Prev: not (Type Specifier), Up: Types and Classes Dictionary + +4.4.20 and [Type Specifier] +--------------------------- + +Compound Type Specifier Kind:: +.............................. + +Combining. + +Compound Type Specifier Syntax:: +................................ + +('and'{{typespec}*}) + +Compound Type Specifier Arguments:: +................................... + +typespec--a type specifier. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of all objects of the type determined by the +intersection of the typespecs. + + * is not permitted as an argument. + + The type specifiers (and) and t are equivalent. The symbol and is +not valid as a type specifier, and, specifically, it is not an +abbreviation for (and). + + +File: gcl.info, Node: or (Type Specifier), Next: values (Type Specifier), Prev: and (Type Specifier), Up: Types and Classes Dictionary + +4.4.21 or [Type Specifier] +-------------------------- + +Compound Type Specifier Kind:: +.............................. + +Combining. + +Compound Type Specifier Syntax:: +................................ + +('or'{{typespec}*}) + +Compound Type Specifier Arguments:: +................................... + +typespec--a type specifier. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of all objects of the type determined by the union +of the typespecs. For example, the type list by definition is the same +as (or null cons). Also, the value returned by position is an object of +type (or null (integer 0 *)); i.e., either nil or a non-negative +integer. + + * is not permitted as an argument. + + The type specifiers (or) and nil are equivalent. The symbol or is +not valid as a type specifier; and, specifically, it is not an +abbreviation for (or). + + +File: gcl.info, Node: values (Type Specifier), Next: eql (Type Specifier), Prev: or (Type Specifier), Up: Types and Classes Dictionary + +4.4.22 values [Type Specifier] +------------------------------ + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('values'{!value-typespec}) + + [Reviewer Note by Barmar: Missing &key] + + value-typespec ::={typespec}* [&optional {typespec}*] [&rest typespec ] [&allow-other-keys] + +Compound Type Specifier Arguments:: +................................... + +typespec--a type specifier. + +Compound Type Specifier Description:: +..................................... + +This type specifier can be used only as the value-type in a function +type specifier or a the special form. It is used to specify individual +types when multiple values are involved. The &optional and &rest +markers can appear in the value-type list; they indicate the parameter +list of a function that, when given to multiple-value-call along with +the values, would correctly receive those values. + + The symbol * may not be among the value-types. + + The symbol values is not valid as a type specifier; and, +specifically, it is not an abbreviation for (values). + + +File: gcl.info, Node: eql (Type Specifier), Next: coerce, Prev: values (Type Specifier), Up: Types and Classes Dictionary + +4.4.23 eql [Type Specifier] +--------------------------- + +Compound Type Specifier Kind:: +.............................. + +Combining. + +Compound Type Specifier Syntax:: +................................ + +('eql'{object}) + +Compound Type Specifier Arguments:: +................................... + +object--an object. + +Compound Type Specifier Description:: +..................................... + +Represents the type whose only element is object. + + The argument object is required. The object can be *, but if so it +denotes itself (the symbol *) and does not represent an unspecified +value. The symbol eql is not valid as an atomic type specifier. + + +File: gcl.info, Node: coerce, Next: deftype, Prev: eql (Type Specifier), Up: Types and Classes Dictionary + +4.4.24 coerce [Function] +------------------------ + +'coerce' object result-type => result + +Arguments and Values:: +...................... + +object--an object. + + result-type--a type specifier. + + result--an object, of type result-type except in situations described +in *note Rule of Canonical Representation for Complex Rationals::. + +Description:: +............. + +Coerces the object to type result-type. + + If object is already of type result-type, the object itself is +returned, regardless of whether it would have been possible in general +to coerce an object of some other type to result-type. + + Otherwise, the object is coerced to type result-type according to the +following rules: + +sequence + + If the result-type is a recognizable subtype of list, and the + object is a sequence, then the result is a list that has the same + elements as object. + + If the result-type is a recognizable subtype of vector, and the + object is a sequence, then the result is a vector that has the same + elements as object. If result-type is a specialized type, the + result has an actual array element type that is the result of + upgrading the element type part of that specialized type. If no + element type is specified, the element type defaults to t. If the + implementation cannot determine the element type, an error is + signaled. + +character + If the result-type is character and the object is a character + designator, the result is the character it denotes. + +complex + If the result-type is complex and the object is a number, then the + result is obtained by constructing a complex whose real part is the + object and whose imaginary part is the result of coercing an + integer zero to the type of the object (using coerce). (If the + real part is a rational, however, then the result must be + represented as a rational rather than a complex; see *note Rule of + Canonical Representation for Complex Rationals::. So, for example, + (coerce 3 'complex) is permissible, but will return 3, which is not + a complex.) + +float + If the result-type is any of float, short-float, single-float, + double-float, long-float, and the object is a + + real, + + then the result is a float of type result-type which is equal in + sign and magnitude to the object to whatever degree of + representational precision is permitted by that float + representation. (If the result-type is float and object is not + already a float, then the result is a single float.) + +function + If the result-type is function, and object is any + + function name + + that is fbound but that is globally defined neither as a macro name + nor as a special operator, then the result is the functional value + of object. + + If the result-type is function, and object is a lambda expression, + then the result is a closure of object in the null lexical + environment. + +t + Any object can be coerced to an object of type t. In this case, + the object is simply returned. + +Examples:: +.......... + + (coerce '(a b c) 'vector) => #(A B C) + (coerce 'a 'character) => #\A + (coerce 4.56 'complex) => #C(4.56 0.0) + (coerce 4.5s0 'complex) => #C(4.5s0 0.0s0) + (coerce 7/2 'complex) => 7/2 + (coerce 0 'short-float) => 0.0s0 + (coerce 3.5L0 'float) => 3.5L0 + (coerce 7/2 'float) => 3.5 + (coerce (cons 1 2) t) => (1 . 2) + + All the following forms should signal an error: + + (coerce '(a b c) '(vector * 4)) + (coerce #(a b c) '(vector * 4)) + (coerce '(a b c) '(vector * 2)) + (coerce #(a b c) '(vector * 2)) + (coerce "foo" '(string 2)) + (coerce #(#\a #\b #\c) '(string 2)) + (coerce '(0 1) '(simple-bit-vector 3)) + +Exceptional Situations:: +........................ + +If a coercion is not possible, an error of type type-error is signaled. + + (coerce x 'nil) always signals an error of type type-error. + + An error of type error is signaled if the result-type is function but +object is a symbol that is not fbound or if the symbol names a macro or +a special operator. + + An error of type type-error should be signaled if result-type +specifies the number of elements and object is of a different length. + +See Also:: +.......... + +*note rational (Function):: , *note floor:: , *note char-code:: , *note +char-int:: + +Notes:: +....... + +Coercions from floats to rationals and from ratios to integers are not +provided because of rounding problems. + + (coerce x 't) == (identity x) == x + + +File: gcl.info, Node: deftype, Next: subtypep, Prev: coerce, Up: Types and Classes Dictionary + +4.4.25 deftype [Macro] +---------------------- + +'deftype' name lambda-list [[{declaration}* | documentation]] {form}* => +name + +Arguments and Values:: +...................... + +name--a symbol. + + lambda-list--a deftype lambda list. + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + form--a form. + +Description:: +............. + +deftype defines a derived type specifier named name. + + The meaning of the new type specifier is given in terms of a function +which expands the type specifier into another type specifier, which +itself will be expanded if it contains references to another derived +type specifier. + + The newly defined type specifier may be referenced as a list of the +form (name arg_1 arg_2 ...)\/. The number of arguments must be +appropriate to the lambda-list. If the new type specifier takes no +arguments, or if all of its arguments are optional, the type specifier +may be used as an atomic type specifier. + + The argument expressions to the type specifier, arg_1 ... arg_n, are +not evaluated. Instead, these literal objects become the objects to +which corresponding parameters become bound. + + The body of the deftype form + + (but not the lambda-list) + + is + + implicitly enclosed in a block named name, + + and is evaluated as an implicit progn, returning a new type +specifier. + + The lexical environment of the body is the one which was current at +the time the deftype form was evaluated, augmented by the variables in +the lambda-list. + + Recursive expansion of the type specifier returned as the expansion +must terminate, including the expansion of type specifiers which are +nested within the expansion. + + The consequences are undefined if the result of fully expanding a +type specifier contains any circular structure, except within the +objects referred to by member and eql type specifiers. + + Documentation is attached to name as a documentation string of kind +type. + + If a deftype form appears as a top level form, the compiler must +ensure that the name is recognized in subsequent type declarations. The +programmer must ensure that the body of a deftype form can be evaluated +at compile time if the name is referenced in subsequent type +declarations. If the expansion of a type specifier is not defined fully +at compile time (perhaps because it expands into an unknown type +specifier or a satisfies of a named function that isn't defined in the +compile-time environment), an implementation may ignore any references +to this type in declarations and/or signal a warning. + +Examples:: +.......... + + (defun equidimensional (a) + (or (< (array-rank a) 2) + (apply #'= (array-dimensions a)))) => EQUIDIMENSIONAL + (deftype square-matrix (&optional type size) + `(and (array ,type (,size ,size)) + (satisfies equidimensional))) => SQUARE-MATRIX + +See Also:: +.......... + +declare, *note defmacro:: , *note documentation:: , *note Type +Specifiers::, *note Syntactic Interaction of Documentation Strings and +Declarations:: + + +File: gcl.info, Node: subtypep, Next: type-of, Prev: deftype, Up: Types and Classes Dictionary + +4.4.26 subtypep [Function] +-------------------------- + +'subtypep' type-1 type-2 &optional environment => subtype-p, valid-p + +Arguments and Values:: +...................... + +type-1--a type specifier. + + type-2--a type specifier. + + environment--an environment object. The default is nil, denoting the +null lexical environment and the current global environment. + + subtype-p--a generalized boolean. + + valid-p--a generalized boolean. + +Description:: +............. + +If type-1 is a recognizable subtype of type-2, the first value is true. +Otherwise, the first value is false, indicating that either type-1 is +not a subtype of type-2, or else type-1 is a subtype of type-2 but is +not a recognizable subtype. + + A second value is also returned indicating the 'certainty' of the +first value. If this value is true, then the first value is an accurate +indication of the subtype relationship. (The second value is always +true when the first value is true.) + + Figure 4-9 summarizes the possible combinations of values that might +result. + + Value 1 Value 2 Meaning + true true type-1 is definitely a subtype of type-2. + false true type-1 is definitely not a subtype of type-2. + false false subtypep could not determine the relationship, + so type-1 might or might not be a subtype of type-2. + + Figure 4-9: Result possibilities for subtypep + + + subtypep is permitted to return the values false and false only when +at least one argument involves one of these type specifiers: and, eql, +the list form of function, member, not, or, satisfies, or values. (A +type specifier 'involves' such a symbol if, after being type expanded, +it contains that symbol in a position that would call for its meaning as +a type specifier to be used.) One consequence of this is that if +neither type-1 nor type-2 involves any of these type specifiers, then +subtypep is obliged to determine the relationship accurately. In +particular, subtypep returns the values true and true if the arguments +are equal and do not involve any of these type specifiers. + + subtypep never returns a second value of nil when both type-1 and +type-2 involve only the names in Figure~4-2, or names of types defined +by defstruct, define-condition, or defclass, or derived types that +expand into only those names. While type specifiers listed in +Figure~4-2 and names of defclass and defstruct can in some cases be +implemented as derived types, subtypep regards them as primitive. + + The relationships between types reflected by subtypep are those +specific to the particular implementation. For example, if an +implementation supports only a single type of floating-point numbers, in +that implementation (subtypep 'float 'long-float) returns the values +true and true (since the two types are identical). + + For all T1 and T2 other than *, (array T1) and (array T2) are two +different type specifiers that always refer to the same sets of things +if and only if they refer to arrays of exactly the same specialized +representation, i.e., if (upgraded-array-element-type 'T1) and +(upgraded-array-element-type 'T2) return two different type specifiers +that always refer to the same sets of objects. This is another way of +saying that `(array type-specifier) and `(array +,(upgraded-array-element-type 'type-specifier)) refer to the same set of +specialized array representations. For all T1 and T2 other than *, the +intersection of (array T1) and (array T2) is the empty set if and only +if they refer to arrays of different, distinct specialized +representations. + + Therefore, + + (subtypep '(array T1) '(array T2)) => true + + if and only if + + (upgraded-array-element-type 'T1) and + (upgraded-array-element-type 'T2) + + return two different type specifiers that always refer to the same +sets of objects. + + For all type-specifiers T1 and T2 other than *, + + (subtypep '(complex T1) '(complex T2)) => true, true + + if: + +1. + T1 is a subtype of T2, or +2. + (upgraded-complex-part-type 'T1) and (upgraded-complex-part-type + 'T2) return two different type specifiers that always refer to the + same sets of objects; in this case, (complex T1) and (complex T2) + both refer to the same specialized representation. + + The values are false and true otherwise. + + The form + + (subtypep '(complex single-float) '(complex float)) + + must return true in all implementations, but + + (subtypep '(array single-float) '(array float)) + + returns true only in implementations that do not have a specialized +array representation for single floats distinct from that for other +floats. + +Examples:: +.......... + + (subtypep 'compiled-function 'function) => true, true + (subtypep 'null 'list) => true, true + (subtypep 'null 'symbol) => true, true + (subtypep 'integer 'string) => false, true + (subtypep '(satisfies dummy) nil) => false, implementation-dependent + (subtypep '(integer 1 3) '(integer 1 4)) => true, true + (subtypep '(integer (0) (0)) 'nil) => true, true + (subtypep 'nil '(integer (0) (0))) => true, true + (subtypep '(integer (0) (0)) '(member)) => true, true ;or false, false + (subtypep '(member) 'nil) => true, true ;or false, false + (subtypep 'nil '(member)) => true, true ;or false, false + + Let and be two distinct type specifiers that do not +always refer to the same sets of objects in a given implementation, but +for which make-array, will return an object of the same array type. + + Thus, in each case, + + (subtypep (array-element-type (make-array 0 :element-type ')) + (array-element-type (make-array 0 :element-type '))) + => true, true + + (subtypep (array-element-type (make-array 0 :element-type ')) + (array-element-type (make-array 0 :element-type '))) + => true, true + + If (array ) and (array ) are different names for +exactly the same set of objects, these names should always refer to the +same sets of objects. That implies that the following set of tests are +also true: + + (subtypep '(array ) '(array )) => true, true + (subtypep '(array ) '(array )) => true, true + +See Also:: +.......... + +*note Types:: + +Notes:: +....... + +The small differences between the subtypep specification for the array +and complex types are necessary because there is no creation function +for complexes which allows the specification of the resultant part type +independently of the actual types of the parts. Thus in the case of the +type complex, the actual type of the parts is referred to, although a +number can be a member of more than one type. For example, 17 is of +type (mod 18) as well as type (mod 256) and type integer; and 2.3f5 is +of type single-float as well as type float. + + +File: gcl.info, Node: type-of, Next: typep, Prev: subtypep, Up: Types and Classes Dictionary + +4.4.27 type-of [Function] +------------------------- + +'type-of' object => typespec + +Arguments and Values:: +...................... + +object--an object. + + typespec--a type specifier. + +Description:: +............. + +Returns a type specifier, typespec, for a type that has the object as an +element. The typespec satisfies the following: + +1. + For any object that is an element of some built-in type: + + a. + the type returned is a recognizable subtype of that built-in + type. + + b. + the type returned does not involve and, eql, member, not, or, + satisfies, or values. + +2. + For all objects, (typep object (type-of object)) returns true. + Implicit in this is that type specifiers which are not valid for + use with typep, such as the list form of the function type + specifier, are never returned by type-of. + +3. + The type returned by type-of is always a recognizable subtype of + the class returned by class-of. That is, + + (subtypep (type-of object) (class-of object)) => true, true + +4. + For objects of metaclass structure-class or standard-class, + + and for conditions, + + type-of returns the proper name of the class returned by class-of + if it has a proper name, and otherwise returns the class itself. + In particular, for objects created by the constructor function of a + structure defined with defstruct without a :type option, type-of + returns the structure name; and for objects created by + make-condition, the typespec is the name of the condition type. + +5. + For each of the types short-float, single-float, double-float, or + long-float of which the object is an element, the typespec is a + recognizable subtype of that type. + +Examples:: +.......... + + + (type-of 'a) => SYMBOL + (type-of '(1 . 2)) + => CONS + OR=> (CONS FIXNUM FIXNUM) + (type-of #c(0 1)) + => COMPLEX + OR=> (COMPLEX INTEGER) + (defstruct temp-struct x y z) => TEMP-STRUCT + (type-of (make-temp-struct)) => TEMP-STRUCT + (type-of "abc") + => STRING + OR=> (STRING 3) + (subtypep (type-of "abc") 'string) => true, true + (type-of (expt 2 40)) + => BIGNUM + OR=> INTEGER + OR=> (INTEGER 1099511627776 1099511627776) + OR=> SYSTEM::TWO-WORD-BIGNUM + OR=> FIXNUM + (subtypep (type-of 112312) 'integer) => true, true + (defvar *foo* (make-array 5 :element-type t)) => *FOO* + (class-name (class-of *foo*)) => VECTOR + (type-of *foo*) + => VECTOR + OR=> (VECTOR T 5) + +See Also:: +.......... + +*note array-element-type:: , *note class-of:: , *note defstruct:: , +*note typecase:: , *note typep:: , *note Types:: + +Notes:: +....... + +Implementors are encouraged to arrange for type-of to return + + a portable value. + + +File: gcl.info, Node: typep, Next: type-error, Prev: type-of, Up: Types and Classes Dictionary + +4.4.28 typep [Function] +----------------------- + +'typep' object type-specifier &optional environment => +generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + type-specifier--any type specifier except + + values, or a type specifier list whose first element is either +function or values. + + environment--an environment object. The default is nil, denoting the +null lexical environment and the and current global environment. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of the type specified by type-specifier; +otherwise, returns false. + + A type-specifier of the form (satisfies fn) is handled by applying +the function fn to object. + + (typep object '(array type-specifier)), where type-specifier is not +*, returns true if and only if object is an array that could be the +result of supplying type-specifier as the :element-type argument to +make-array. (array *) refers to all arrays regardless of element type, +while (array type-specifier) refers only to those arrays that can result +from giving type-specifier as the :element-type argument to make-array. +A similar interpretation applies to (simple-array type-specifier) and +(vector type-specifier). See *note Array Upgrading::. + + (typep object '(complex type-specifier)) returns true for all complex +numbers that can result from giving numbers of type type-specifier to +the function complex, plus all other complex numbers of the same +specialized representation. Both the real and the imaginary parts of +any such complex number must satisfy: + + (typep realpart 'type-specifier) + (typep imagpart 'type-specifier) + + See the function upgraded-complex-part-type. + +Examples:: +.......... + + (typep 12 'integer) => true + (typep (1+ most-positive-fixnum) 'fixnum) => false + (typep nil t) => true + (typep nil nil) => false + (typep 1 '(mod 2)) => true + (typep #c(1 1) '(complex (eql 1))) => true + ;; To understand this next example, you might need to refer to + ;; *note Rule of Canonical Representation for Complex Rationals::. + (typep #c(0 0) '(complex (eql 0))) => false + + Let A_x and A_y be two type specifiers that denote different types, +but for which + + (upgraded-array-element-type 'A_x) + + and + + (upgraded-array-element-type 'A_y) + + denote the same type. Notice that + + (typep (make-array 0 :element-type 'A_x) '(array A_x)) => true + (typep (make-array 0 :element-type 'A_y) '(array A_y)) => true + (typep (make-array 0 :element-type 'A_x) '(array A_y)) => true + (typep (make-array 0 :element-type 'A_y) '(array A_x)) => true + +Exceptional Situations:: +........................ + +An error of type error is signaled if type-specifier is values, or a +type specifier list whose first element is either function or values. + + The consequences are undefined if the type-specifier is not a type +specifier. + +See Also:: +.......... + +*note type-of:: , *note upgraded-array-element-type:: , *note +upgraded-complex-part-type:: , *note Type Specifiers:: + +Notes:: +....... + +Implementations are encouraged to recognize and optimize the case of +(typep x (the class y)), since it does not involve any need for +expansion of deftype information at runtime. + + + + +File: gcl.info, Node: type-error, Next: type-error-datum, Prev: typep, Up: Types and Classes Dictionary + +4.4.29 type-error [Condition Type] +---------------------------------- + +Class Precedence List:: +....................... + +type-error, error, serious-condition, condition, t + +Description:: +............. + +The type type-error represents a situation in which an object is not of +the expected type. The "offending datum" and "expected type" are +initialized by the initialization arguments named :datum and +:expected-type to make-condition, and are accessed by the functions +type-error-datum and type-error-expected-type. + +See Also:: +.......... + +*note type-error-datum:: , type-error-expected-type + + +File: gcl.info, Node: type-error-datum, Next: simple-type-error, Prev: type-error, Up: Types and Classes Dictionary + +4.4.30 type-error-datum, type-error-expected-type [Function] +------------------------------------------------------------ + +'type-error-datum' condition => datum + + 'type-error-expected-type' condition => expected-type + +Arguments and Values:: +...................... + +condition--a condition of type type-error. + + datum--an object. + + expected-type--a type specifier. + +Description:: +............. + +type-error-datum returns the offending datum in the situation +represented by the condition. + + type-error-expected-type returns the expected type of the offending +datum in the situation represented by the condition. + +Examples:: +.......... + + (defun fix-digits (condition) + (check-type condition type-error) + (let* ((digits '(zero one two three four + five six seven eight nine)) + (val (position (type-error-datum condition) digits))) + (if (and val (subtypep 'fixnum (type-error-expected-type condition))) + (store-value 7)))) + + (defun foo (x) + (handler-bind ((type-error #'fix-digits)) + (check-type x number) + (+ x 3))) + + (foo 'seven) + => 10 + +See Also:: +.......... + +type-error, *note Conditions:: + + +File: gcl.info, Node: simple-type-error, Prev: type-error-datum, Up: Types and Classes Dictionary + +4.4.31 simple-type-error [Condition Type] +----------------------------------------- + +Class Precedence List:: +....................... + +simple-type-error, simple-condition, type-error, error, +serious-condition, condition, t + +Description:: +............. + +Conditions of type simple-type-error are like conditions of type +type-error, except that they provide an alternate mechanism for +specifying how the condition is to be reported; see the type +simple-condition. + +See Also:: +.......... + +simple-condition, + + *note simple-condition-format-control:: , + + simple-condition-format-arguments, *note type-error-datum:: , +type-error-expected-type + + +File: gcl.info, Node: Data and Control Flow, Next: Iteration, Prev: Types and Classes, Up: Top + +5 Data and Control Flow +*********************** + +* Menu: + +* Generalized Reference:: +* Transfer of Control to an Exit Point:: +* Data and Control Flow Dictionary:: + + +File: gcl.info, Node: Generalized Reference, Next: Transfer of Control to an Exit Point, Prev: Data and Control Flow, Up: Data and Control Flow + +5.1 Generalized Reference +========================= + +* Menu: + +* Overview of Places and Generalized Reference:: +* Kinds of Places:: +* Treatment of Other Macros Based on SETF:: + + +File: gcl.info, Node: Overview of Places and Generalized Reference, Next: Kinds of Places, Prev: Generalized Reference, Up: Generalized Reference + +5.1.1 Overview of Places and Generalized Reference +-------------------------------------------------- + +A generalized reference is the use of a form, sometimes called a place , +as if it were a variable that could be read and written. The value of a +place is the object to which the place form evaluates. The value of a +place can be changed by using setf. The concept of binding a place is +not defined in Common Lisp, but an implementation is permitted to extend +the language by defining this concept. + + Figure 5-1 contains examples of the use of setf. Note that the +values returned by evaluating the forms in column two are not +necessarily the same as those obtained by evaluating the forms in column +three. In general, the exact macro expansion of a setf form is not +guaranteed and can even be implementation-dependent; all that is +guaranteed is that the expansion is an update form that works for that +particular implementation, that the left-to-right evaluation of subforms +is preserved, and that the ultimate result of evaluating setf is the +value or values being stored. + + Access function Update Function Update using setf + x (setq x datum) (setf x datum) + (car x) (rplaca x datum) (setf (car x) datum) + (symbol-value x) (set x datum) (setf (symbol-value x) datum) + + Figure 5-1: Examples of setf + + + Figure 5-2 shows operators relating to places and generalized +reference. + + assert defsetf push + ccase get-setf-expansion remf + ctypecase getf rotatef + decf incf setf + define-modify-macro pop shiftf + define-setf-expander psetf + + Figure 5-2: Operators relating to places and generalized reference. + + + Some of the operators above manipulate places and some manipulate +setf expanders. A setf expansion can be derived from any place. + + New setf expanders can be defined by using defsetf and +define-setf-expander. + +* Menu: + +* Evaluation of Subforms to Places:: +* Examples of Evaluation of Subforms to Places:: +* Setf Expansions:: +* Examples of Setf Expansions:: + + +File: gcl.info, Node: Evaluation of Subforms to Places, Next: Examples of Evaluation of Subforms to Places, Prev: Overview of Places and Generalized Reference, Up: Overview of Places and Generalized Reference + +5.1.1.1 Evaluation of Subforms to Places +........................................ + +The following rules apply to the evaluation of subforms in a place: + +1. + The evaluation ordering of subforms within a place is determined by + the order specified by the second value returned by + + get-setf-expansion. + + For all places defined by this specification (e.g., getf, ldb, + ...), this order of evaluation is left-to-right. + + When a place is derived from a macro expansion, this rule is + applied after the macro is expanded to find the appropriate place. + + Places defined by using defmacro or + + define-setf-expander + + use the evaluation order defined by those definitions. For + example, consider the following: + + (defmacro wrong-order (x y) `(getf ,y ,x)) + + This following form evaluates place2 first and then place1 because + that is the order they are evaluated in the macro expansion: + + (push value (wrong-order place1 place2)) + +2. + + For the macros that manipulate places (push, pushnew, remf, incf, + decf, shiftf, rotatef, psetf, setf, pop, and those defined by + define-modify-macro) the subforms of the macro call are evaluated + exactly once in left-to-right order, with the subforms of the + places evaluated in the order specified in (1). + + push, pushnew, remf, incf, decf, shiftf, rotatef, psetf, pop + evaluate all subforms before modifying any of the place locations. + setf (in the case when setf has more than two arguments) performs + its operation on each pair in sequence. For example, in + + (setf place1 value1 place2 value2 ...) + + the subforms of place1 and value1 are evaluated, the location + specified by place1 is modified to contain the value returned by + value1, and then the rest of the setf form is processed in a like + manner. + +3. + For check-type, ctypecase, and ccase, subforms of the place are + evaluated once as in (1), but might be evaluated again if the type + check fails in the case of check-type or none of the cases hold in + ctypecase and ccase. + +4. + For assert, the order of evaluation of the generalized references + is not specified. + + Rules 2, 3 and 4 cover all standardized macros that manipulate +places. + + +File: gcl.info, Node: Examples of Evaluation of Subforms to Places, Next: Setf Expansions, Prev: Evaluation of Subforms to Places, Up: Overview of Places and Generalized Reference + +5.1.1.2 Examples of Evaluation of Subforms to Places +.................................................... + + (let ((ref2 (list '()))) + (push (progn (princ "1") 'ref-1) + (car (progn (princ "2") ref2)))) + |> 12 + => (REF1) + + (let (x) + (push (setq x (list 'a)) + (car (setq x (list 'b)))) + x) + => (((A) . B)) + + push first evaluates (setq x (list 'a)) => (a), then evaluates (setq +x (list 'b)) => (b), then modifies the car of this latest value to be +((a) . b). + + +File: gcl.info, Node: Setf Expansions, Next: Examples of Setf Expansions, Prev: Examples of Evaluation of Subforms to Places, Up: Overview of Places and Generalized Reference + +5.1.1.3 Setf Expansions +....................... + +Sometimes it is possible to avoid evaluating subforms of a place +multiple times or in the wrong order. A + + setf expansion + + for a given access form can be expressed as an ordered collection of +five objects: + +List of temporary variables + a list of symbols naming temporary variables to be bound + sequentially, as if by let*, to values resulting from value forms. + +List of value forms + a list of forms (typically, subforms of the place) which when + evaluated yield the values to which the corresponding temporary + variables should be bound. + +List of store variables + a list of symbols naming temporary store variables which are to + hold the new values that will be assigned to the place. + +Storing form + a form which can reference both the temporary and the store + variables, and which changes the value of the place and guarantees + to return as its values the values of the store variables, which + are the correct values for setf to return. + +Accessing form + a form which can reference the temporary variables, and which + returns the value of the place. + + The value returned by the accessing form is affected by execution of +the storing form, but either of these forms might be evaluated any +number of times. + + It is possible to do more than one setf in parallel via psetf, +shiftf, and rotatef. Because of this, the + + setf expander + + must produce new temporary and store variable names every time. For +examples of how to do this, see gensym. + + For each standardized accessor function F, unless it is explicitly +documented otherwise, it is implementation-dependent whether the ability +to use an F form as a setf place is implemented by a setf expander or a +setf function. Also, it follows from this that it is +implementation-dependent whether the name (setf F) is fbound. + + +File: gcl.info, Node: Examples of Setf Expansions, Prev: Setf Expansions, Up: Overview of Places and Generalized Reference + +5.1.1.4 Examples of Setf Expansions +................................... + +Examples of the contents of the constituents of setf expansions follow. + + For a variable x: + + () ;list of temporary variables + () ;list of value forms + (g0001) ;list of store variables + (setq x g0001) ;storing form + x ;accessing form + + Figure 5-3: Sample Setf Expansion of a Variable + + + For (car exp): + + (g0002) ;list of temporary variables + (exp) ;list of value forms + (g0003) ;list of store variables + (progn (rplaca g0002 g0003) g0003) ;storing form + (car g0002) ;accessing form + + Figure 5-4: Sample Setf Expansion of a CAR Form + + + For (subseq seq s e): + + (g0004 g0005 g0006) ;list of temporary variables + (seq s e) ;list of value forms + (g0007) ;list of store variables + (progn (replace g0004 g0007 :start1 g0005 :end1 g0006) g0007) + ;storing form + (subseq g0004 g0005 g0006) ; accessing form + + Figure 5-5: Sample Setf Expansion of a SUBSEQ Form + + + In some cases, if a subform of a place is itself a place, it is +necessary to expand the subform in order to compute some of the values +in the expansion of the outer place. For (ldb bs (car exp)): + + (g0001 g0002) ;list of temporary variables + (bs exp) ;list of value forms + (g0003) ;list of store variables + (progn (rplaca g0002 (dpb g0003 g0001 (car g0002))) g0003) + ;storing form + (ldb g0001 (car g0002)) ; accessing form + + Figure 5-6: Sample Setf Expansion of a LDB Form + + + +File: gcl.info, Node: Kinds of Places, Next: Treatment of Other Macros Based on SETF, Prev: Overview of Places and Generalized Reference, Up: Generalized Reference + +5.1.2 Kinds of Places +--------------------- + +Several kinds of places are defined by Common Lisp; this section +enumerates them. This set can be extended by implementations and by +programmer code. + +* Menu: + +* Variable Names as Places:: +* Function Call Forms as Places:: +* VALUES Forms as Places:: +* THE Forms as Places:: +* APPLY Forms as Places:: +* Setf Expansions and Places:: +* Macro Forms as Places:: +* Symbol Macros as Places:: +* Other Compound Forms as Places:: + + +File: gcl.info, Node: Variable Names as Places, Next: Function Call Forms as Places, Prev: Kinds of Places, Up: Kinds of Places + +5.1.2.1 Variable Names as Places +................................ + +The name of a lexical variable or dynamic variable can be used as a +place. + + +File: gcl.info, Node: Function Call Forms as Places, Next: VALUES Forms as Places, Prev: Variable Names as Places, Up: Kinds of Places + +5.1.2.2 Function Call Forms as Places +..................................... + +A function form can be used as a place if it falls into one of the +following categories: + +* + A function call form whose first element is the name of any one of + the functions in Figure 5-7. + + [Editorial Note by KMP: Note that what are in some places still + called 'condition accessors' are deliberately omitted from this + table, and are not labeled as accessors in their entries. I have + not yet had time to do a full search for these items and eliminate + stray references to them as 'accessors', which they are not, but I + will do that at some point.] + + aref cdadr get + bit cdar gethash + caaaar cddaar logical-pathname-translations + caaadr cddadr macro-function + caaar cddar ninth + caadar cdddar nth + caaddr cddddr readtable-case + caadr cdddr rest + caar cddr row-major-aref + cadaar cdr sbit + cadadr char schar + cadar class-name second + caddar compiler-macro-function seventh + cadddr documentation sixth + caddr eighth slot-value + cadr elt subseq + car fdefinition svref + cdaaar fifth symbol-function + cdaadr fill-pointer symbol-plist + cdaar find-class symbol-value + cdadar first tenth + cdaddr fourth third + + Figure 5-7: Functions that setf can be used with--1 + + + In the case of subseq, the replacement value must be a sequence + whose elements might be contained by the sequence argument to + subseq, but does not have to be a sequence of the same type as the + sequence of which the subsequence is specified. If the length of + the replacement value does not equal the length of the subsequence + to be replaced, then the shorter length determines the number of + elements to be stored, as for replace. + +* + A function call form whose first element is the name of a selector + function constructed by defstruct. + + The function name must refer to the global function definition, + rather than a locally defined function. + +* + A function call form whose first element is the name of any one of + the functions in Figure 5-8, provided that the supplied argument to + that function is in turn a place form; in this case the new place + has stored back into it the result of applying the supplied + "update" function. + + Function name Argument that is a place Update function used + ldb second dpb + mask-field second deposit-field + getf first implementation-dependent + + Figure 5-8: Functions that setf can be used with--2 + + + During the setf expansion of these forms, it is necessary to call + + get-setf-expansion + + in order to figure out how the inner, nested generalized variable + must be treated. + + The information from + + get-setf-expansion + + is used as follows. + + ldb + In a form such as: + + (setf (ldb byte-spec place-form) value-form) + + the place referred to by the place-form must always be both + read and written; note that the update is to the generalized + variable specified by place-form, not to any object of type + integer. + + Thus this setf should generate code to do the following: + + 1. + Evaluate byte-spec (and bind it into a temporary + variable). + 2. + Bind the temporary variables for place-form. + 3. + Evaluate value-form (and bind + + its value or values into the store variable). + + 4. + Do the read from place-form. + 5. + Do the write into place-form with the given bits of the + integer fetched in step 4 replaced with the value from + step 3. + + If the evaluation of value-form in step 3 alters what is found + in place-form, such as setting different bits of integer, then + the change of the bits denoted by byte-spec is to that altered + integer, because step 4 is done after the value-form + evaluation. Nevertheless, the evaluations required for + binding the temporary variables are done in steps 1 and 2, and + thus the expected left-to-right evaluation order is seen. For + example: + + (setq integer #x69) => #x69 + (rotatef (ldb (byte 4 4) integer) + (ldb (byte 4 0) integer)) + integer => #x96 + ;;; This example is trying to swap two independent bit fields + ;;; in an integer. Note that the generalized variable of + ;;; interest here is just the (possibly local) program variable + ;;; integer. + + mask-field + This case is the same as ldb in all essential aspects. + + getf + In a form such as: + + (setf (getf place-form ind-form) value-form) + + the place referred to by place-form must always be both read + and written; note that the update is to the generalized + variable specified by place-form, not necessarily to the + particular list that is the property list in question. + + Thus this setf should generate code to do the following: + + 1. + Bind the temporary variables for place-form. + 2. + Evaluate ind-form (and bind it into a temporary + variable). + 3. + Evaluate value-form (and bind + + its value or values into the store variable). + + 4. + Do the read from place-form. + 5. + Do the write into place-form with a possibly-new property + list obtained by combining the values from steps 2, 3, + and 4. (Note that the phrase "possibly-new property + list" can mean that the former property list is somehow + destructively re-used, or it can mean partial or full + copying of it. Since either copying or destructive + re-use can occur, the treatment of the resultant value + for the possibly-new property list must proceed as if it + were a different copy needing to be stored back into the + generalized variable.) + + If the evaluation of value-form in step 3 alters what is found + in place-form, such as setting a different named property in + the list, then the change of the property denoted by ind-form + is to that altered list, because step 4 is done after the + value-form evaluation. Nevertheless, the evaluations required + for binding the temporary variables are done in steps 1 and 2, + and thus the expected left-to-right evaluation order is seen. + + For example: + + (setq s (setq r (list (list 'a 1 'b 2 'c 3)))) => ((a 1 b 2 c 3)) + (setf (getf (car r) 'b) + (progn (setq r nil) 6)) => 6 + r => NIL + s => ((A 1 B 6 C 3)) + ;;; Note that the (setq r nil) does not affect the actions of + ;;; the SETF because the value of R had already been saved in + ;;; a temporary variable as part of the step 1. Only the CAR + ;;; of this value will be retrieved, and subsequently modified + ;;; after the value computation. + diff --git a/info/gcl.info-3 b/info/gcl.info-3 new file mode 100644 index 0000000..a4dacdb --- /dev/null +++ b/info/gcl.info-3 @@ -0,0 +1,8719 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: VALUES Forms as Places, Next: THE Forms as Places, Prev: Function Call Forms as Places, Up: Kinds of Places + +5.1.2.3 VALUES Forms as Places +.............................. + +A values form can be used as a place, provided that each of its subforms +is also a place form. + + A form such as + + (setf (values place-1 \dots place-n) values-form) + + does the following: + +1. + The subforms of each nested place are evaluated in left-to-right + order. +2. + The values-form is evaluated, and the first store variable from + each place is bound to its return values as if by + multiple-value-bind. +3. + If the setf expansion for any place involves more than one store + variable, then the additional store variables are bound to nil. +4. + The storing forms for each place are evaluated in left-to-right + order. + + The storing form in the setf expansion of values returns as multiple +values_2 the values of the store variables in step 2. That is, the +number of values returned is the same as the number of place forms. +This may be more or fewer values than are produced by the values-form. + + +File: gcl.info, Node: THE Forms as Places, Next: APPLY Forms as Places, Prev: VALUES Forms as Places, Up: Kinds of Places + +5.1.2.4 THE Forms as Places +........................... + +A the form can be used as a place, in which case the declaration is +transferred to the newvalue form, and the resulting setf is analyzed. +For example, + + (setf (the integer (cadr x)) (+ y 3)) + + is processed as if it were + + (setf (cadr x) (the integer (+ y 3))) + + +File: gcl.info, Node: APPLY Forms as Places, Next: Setf Expansions and Places, Prev: THE Forms as Places, Up: Kinds of Places + +5.1.2.5 APPLY Forms as Places +............................. + +The following situations involving setf of apply must be supported: + +* + (setf (apply #'aref array {subscript}* more-subscripts) + new-element) +* + (setf (apply #'bit array {subscript}* more-subscripts) new-element) +* + (setf (apply #'sbit array {subscript}* more-subscripts) + new-element) + + In all three cases, the element of array designated by the +concatenation of subscripts and more-subscripts (i.e., the same element +which would be read by the call to apply if it were not part of a setf +form) is changed to have the value given by new-element. + + For these usages, the function name (aref, bit, or sbit) must refer +to the global function definition, rather than a locally defined +function. + + No other standardized function is required to be supported, but an +implementation may define such support. An implementation may also +define support for implementation-defined operators. + + If a user-defined function is used in this context, the following +equivalence is true, except that care is taken to preserve proper +left-to-right evaluation of argument subforms: + + (setf (apply #'name {arg}*) val) + == (apply #'(setf name) val {arg}*) + + +File: gcl.info, Node: Setf Expansions and Places, Next: Macro Forms as Places, Prev: APPLY Forms as Places, Up: Kinds of Places + +5.1.2.6 Setf Expansions and Places +.................................. + +Any compound form for which the operator has a + + setf expander + + defined can be used as a place. + + The operator must refer to the global function definition, rather +than a locally defined function or macro. + + +File: gcl.info, Node: Macro Forms as Places, Next: Symbol Macros as Places, Prev: Setf Expansions and Places, Up: Kinds of Places + +5.1.2.7 Macro Forms as Places +............................. + +A macro form can be used as a place, in which case Common Lisp expands +the macro form + + as if by macroexpand-1 + + and then uses the macro expansion in place of the original place. + + Such macro expansion is attempted only after exhausting all other +possibilities other than expanding into a call to a function named (setf +reader). + + +File: gcl.info, Node: Symbol Macros as Places, Next: Other Compound Forms as Places, Prev: Macro Forms as Places, Up: Kinds of Places + +5.1.2.8 Symbol Macros as Places +............................... + +A reference to a symbol that has been established as a symbol macro can +be used as a place. In this case, setf expands the reference and then +analyzes the resulting form. + + +File: gcl.info, Node: Other Compound Forms as Places, Prev: Symbol Macros as Places, Up: Kinds of Places + +5.1.2.9 Other Compound Forms as Places +...................................... + +For any other compound form for which the operator is a symbol f, the +setf form expands into a call to the function named (setf f). The first +argument in the newly constructed function form is newvalue and the +remaining arguments are the remaining elements of place. This expansion +occurs regardless of whether f or (setf f) is defined as a function +locally, globally, or not at all. For example, + + (setf (f arg1 arg2 ...) new-value) + + expands into a form with the same effect and value as + + (let ((#:temp-1 arg1) ;force correct order of evaluation + (#:temp-2 arg2) + ... + (#:temp-0 new-value)) + (funcall (function (setf f)) #:temp-0 #:temp-1 #:temp-2...)) + + A function named (setf f) must return its first argument as its only +value in order to preserve the semantics of setf. + + +File: gcl.info, Node: Treatment of Other Macros Based on SETF, Prev: Kinds of Places, Up: Generalized Reference + +5.1.3 Treatment of Other Macros Based on SETF +--------------------------------------------- + +For each of the "read-modify-write" operators in Figure 5-9, and for any +additional macros defined by the programmer using define-modify-macro, +an exception is made to the normal rule of left-to-right evaluation of +arguments. Evaluation of argument forms occurs in left-to-right order, +with the exception that for the place argument, the actual read of the +"old value" from that place happens after all of the argument form +evaluations, and just before a "new value" is computed and written back +into the place. + + Specifically, each of these operators can be viewed as involving a +form with the following general syntax: + + (operator {preceding-form}* place {following-form}*) + + The evaluation of each such form proceeds like this: + +1. + Evaluate each of the preceding-forms, in left-to-right order. +2. + Evaluate the subforms of the place, in the order specified by the + second value of the setf expansion for that place. +3. + Evaluate each of the following-forms, in left-to-right order. +4. + Read the old value from place. +5. + Compute the new value. +6. + Store the new value into place. + + decf pop pushnew + incf push remf + + Figure 5-9: Read-Modify-Write Macros + + + +File: gcl.info, Node: Transfer of Control to an Exit Point, Next: Data and Control Flow Dictionary, Prev: Generalized Reference, Up: Data and Control Flow + +5.2 Transfer of Control to an Exit Point +======================================== + +When a transfer of control is initiated by go, return-from, or throw the +following events occur in order to accomplish the transfer of control. +Note that for go, the exit point is the form within the tagbody that is +being executed at the time the go is performed; for return-from, the +exit point is the corresponding block form; and for throw, the exit +point is the corresponding catch form. + +1. + Intervening exit points are "abandoned" (i.e., their extent ends + and it is no longer valid to attempt to transfer control through + them). + +2. + The cleanup clauses of any intervening unwind-protect clauses are + evaluated. + +3. + Intervening dynamic bindings of special variables, catch tags, + condition handlers, and restarts are undone. + +4. + The extent of the exit point being invoked ends, and control is + passed to the target. + + The extent of an exit being "abandoned" because it is being passed +over ends as soon as the transfer of control is initiated. That is, +event 1 occurs at the beginning of the initiation of the transfer of +control. The consequences are undefined if an attempt is made to +transfer control to an exit point whose dynamic extent has ended. + + Events 2 and 3 are actually performed interleaved, in the order +corresponding to the reverse order in which they were established. The +effect of this is that the cleanup clauses of an unwind-protect see the +same dynamic bindings of variables and catch tags as were visible when +the unwind-protect was entered. + + Event 4 occurs at the end of the transfer of control. + + +File: gcl.info, Node: Data and Control Flow Dictionary, Prev: Transfer of Control to an Exit Point, Up: Data and Control Flow + +5.3 Data and Control Flow Dictionary +==================================== + +* Menu: + +* apply:: +* defun:: +* fdefinition:: +* fboundp:: +* fmakunbound:: +* flet:: +* funcall:: +* function (Special Operator):: +* function-lambda-expression:: +* functionp:: +* compiled-function-p:: +* call-arguments-limit:: +* lambda-list-keywords:: +* lambda-parameters-limit:: +* defconstant:: +* defparameter:: +* destructuring-bind:: +* let:: +* progv:: +* setq:: +* psetq:: +* block:: +* catch:: +* go:: +* return-from:: +* return:: +* tagbody:: +* throw:: +* unwind-protect:: +* nil:: +* not:: +* t:: +* eq:: +* eql:: +* equal:: +* equalp:: +* identity:: +* complement:: +* constantly:: +* every:: +* and:: +* cond:: +* if:: +* or:: +* when:: +* case:: +* typecase:: +* multiple-value-bind:: +* multiple-value-call:: +* multiple-value-list:: +* multiple-value-prog1:: +* multiple-value-setq:: +* values:: +* values-list:: +* multiple-values-limit:: +* nth-value:: +* prog:: +* prog1:: +* progn:: +* define-modify-macro:: +* defsetf:: +* define-setf-expander:: +* get-setf-expansion:: +* setf:: +* shiftf:: +* rotatef:: +* control-error:: +* program-error:: +* undefined-function:: + + +File: gcl.info, Node: apply, Next: defun, Prev: Data and Control Flow Dictionary, Up: Data and Control Flow Dictionary + +5.3.1 apply [Function] +---------------------- + +'apply' function &rest args^+ => {result}* + +Arguments and Values:: +...................... + +function--a function designator. + + args--a spreadable argument list designator. + + results--the values returned by function. + +Description:: +............. + +Applies the function to the args. + + When the function receives its arguments via &rest, it is permissible +(but not required) for the implementation to bind the rest parameter to +an object that shares structure with the last argument to apply. +Because a function can neither detect whether it was called via apply +nor whether (if so) the last argument to apply was a constant, +conforming programs must neither rely on the list structure of a rest +list to be freshly consed, nor modify that list structure. + + setf can be used with apply in certain circumstances; see *note APPLY +Forms as Places::. + +Examples:: +.......... + + (setq f '+) => + + (apply f '(1 2)) => 3 + (setq f #'-) => # + (apply f '(1 2)) => -1 + (apply #'max 3 5 '(2 7 3)) => 7 + (apply 'cons '((+ 2 3) 4)) => ((+ 2 3) . 4) + (apply #'+ '()) => 0 + + (defparameter *some-list* '(a b c)) + (defun strange-test (&rest x) (eq x *some-list*)) + (apply #'strange-test *some-list*) => implementation-dependent + + (defun bad-boy (&rest x) (rplacd x 'y)) + (bad-boy 'a 'b 'c) has undefined consequences. + (apply #'bad-boy *some-list*) has undefined consequences. + + (defun foo (size &rest keys &key double &allow-other-keys) + (let ((v (apply #'make-array size :allow-other-keys t keys))) + (if double (concatenate (type-of v) v v) v))) + (foo 4 :initial-contents '(a b c d) :double t) + => #(A B C D A B C D) + +See Also:: +.......... + +*note funcall:: , *note fdefinition:: , function, *note Evaluation::, +*note APPLY Forms as Places:: + + +File: gcl.info, Node: defun, Next: fdefinition, Prev: apply, Up: Data and Control Flow Dictionary + +5.3.2 defun [Macro] +------------------- + +'defun' function-name lambda-list [[{declaration}* | documentation]] +{form}* +=> function-name + +Arguments and Values:: +...................... + +function-name--a function name. + + lambda-list--an ordinary lambda list. + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + forms--an implicit progn. + + block-name--the function block name of the function-name. + +Description:: +............. + +Defines a new function named function-name in the global environment. +The body of the function defined by defun consists of forms; they are +executed as an implicit progn when the function is called. defun can be +used to define a new function, to install a corrected version of an +incorrect definition, to redefine an already-defined function, or to +redefine a macro as a function. + + defun implicitly puts a block named block-name around the body forms + + (but not the forms in the lambda-list) + + of the function defined. + + Documentation is attached as a documentation string to name (as kind +function) and to the function object. + + Evaluating defun causes function-name to be a global name for the +function specified by the lambda expression + + (lambda lambda-list + [[{declaration}* | documentation]] + (block block-name {form}*)) + + processed in the lexical environment in which defun was executed. + + (None of the arguments are evaluated at macro expansion time.) + + defun is not required to perform any compile-time side effects. In +particular, defun does not make the function definition available at +compile time. An implementation may choose to store information about +the function for the purposes of compile-time error-checking (such as +checking the number of arguments on calls), or to enable the function to +be expanded inline. + +Examples:: +.......... + + (defun recur (x) + (when (> x 0) + (recur (1- x)))) => RECUR + (defun ex (a b &optional c (d 66) &rest keys &key test (start 0)) + (list a b c d keys test start)) => EX + (ex 1 2) => (1 2 NIL 66 NIL NIL 0) + (ex 1 2 3 4 :test 'equal :start 50) + => (1 2 3 4 (:TEST EQUAL :START 50) EQUAL 50) + (ex :test 1 :start 2) => (:TEST 1 :START 2 NIL NIL 0) + + ;; This function assumes its callers have checked the types of the + ;; arguments, and authorizes the compiler to build in that assumption. + (defun discriminant (a b c) + (declare (number a b c)) + "Compute the discriminant for a quadratic equation." + (- (* b b) (* 4 a c))) => DISCRIMINANT + (discriminant 1 2/3 -2) => 76/9 + + ;; This function assumes its callers have not checked the types of the + ;; arguments, and performs explicit type checks before making any assumptions. + (defun careful-discriminant (a b c) + "Compute the discriminant for a quadratic equation." + (check-type a number) + (check-type b number) + (check-type c number) + (locally (declare (number a b c)) + (- (* b b) (* 4 a c)))) => CAREFUL-DISCRIMINANT + (careful-discriminant 1 2/3 -2) => 76/9 + +See Also:: +.......... + +*note flet:: , labels, *note block:: , *note return-from:: , declare, +*note documentation:: , *note Evaluation::, *note Ordinary Lambda +Lists::, *note Syntactic Interaction of Documentation Strings and +Declarations:: + +Notes:: +....... + +return-from can be used to return prematurely from a function defined by +defun. + + Additional side effects might take place when additional information +(typically debugging information) about the function definition is +recorded. + + +File: gcl.info, Node: fdefinition, Next: fboundp, Prev: defun, Up: Data and Control Flow Dictionary + +5.3.3 fdefinition [Accessor] +---------------------------- + +'fdefinition' function-name => definition + + (setf (' fdefinition' function-name) new-definition) + +Arguments and Values:: +...................... + +function-name--a function name. + + In the non-setf case, the name must be fbound in the global +environment. + + definition--Current global function definition named by +function-name. + + new-definition--a function. + +Description:: +............. + +fdefinition accesses the current global function definition named by +function-name. The definition may be a function or may be an object +representing a special form or macro. + + The value returned by fdefinition when fboundp returns true but the +function-name denotes a macro or special form is not well-defined, but +fdefinition does not signal an error. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if function-name is not a +function name. + + An error of type undefined-function is signaled in the non-setf case +if function-name is not fbound. + +See Also:: +.......... + +*note fboundp:: , *note fmakunbound:: , *note macro-function:: , + + *note special-operator-p:: , + + *note symbol-function:: + +Notes:: +....... + +fdefinition cannot access the value of a lexical function name produced +by flet or labels; it can access only the global function value. + + setf can be used with fdefinition to replace a global function +definition when the function-name's function definition does not +represent a special form. + + setf of fdefinition requires a function as the new value. It is an +error to set the fdefinition of a function-name to a symbol, a list, or +the value returned by fdefinition on the name of a macro or special +form. + + +File: gcl.info, Node: fboundp, Next: fmakunbound, Prev: fdefinition, Up: Data and Control Flow Dictionary + +5.3.4 fboundp [Function] +------------------------ + +'fboundp' name => generalized-boolean + +Pronunciation:: +............... + +pronounced ,ef 'baund p\=e + +Arguments and Values:: +...................... + +name--a function name. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if name is fbound; otherwise, returns false. + +Examples:: +.......... + + (fboundp 'car) => true + (fboundp 'nth-value) => false + (fboundp 'with-open-file) => true + (fboundp 'unwind-protect) => true + (defun my-function (x) x) => MY-FUNCTION + (fboundp 'my-function) => true + (let ((saved-definition (symbol-function 'my-function))) + (unwind-protect (progn (fmakunbound 'my-function) + (fboundp 'my-function)) + (setf (symbol-function 'my-function) saved-definition))) + => false + (fboundp 'my-function) => true + (defmacro my-macro (x) `',x) => MY-MACRO + (fboundp 'my-macro) => true + (fmakunbound 'my-function) => MY-FUNCTION + (fboundp 'my-function) => false + (flet ((my-function (x) x)) + (fboundp 'my-function)) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if name is not a function +name. + +See Also:: +.......... + +*note symbol-function:: , *note fmakunbound:: , *note fdefinition:: + +Notes:: +....... + +It is permissible to call symbol-function on any symbol that is fbound. + + fboundp is sometimes used to "guard" an access to the function cell, +as in: + (if (fboundp x) (symbol-function x)) + + Defining a setf expander F does not cause the setf function (setf F) +to become defined. + + +File: gcl.info, Node: fmakunbound, Next: flet, Prev: fboundp, Up: Data and Control Flow Dictionary + +5.3.5 fmakunbound [Function] +---------------------------- + +'fmakunbound' name => name + +Pronunciation:: +............... + +pronounced ,ef 'mak e n,baund or pronounced ,ef 'm\=a k e n,baund + +Arguments and Values:: +...................... + +name--a function name. + +Description:: +............. + +Removes the function or macro definition, if any, of name in the global +environment. + +Examples:: +.......... + + (defun add-some (x) (+ x 19)) => ADD-SOME + (fboundp 'add-some) => true + (flet ((add-some (x) (+ x 37))) + (fmakunbound 'add-some) + (add-some 1)) => 38 + (fboundp 'add-some) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if name is not a function +name. + + The consequences are undefined if name is a special operator. + +See Also:: +.......... + +*note fboundp:: , *note makunbound:: + + +File: gcl.info, Node: flet, Next: funcall, Prev: fmakunbound, Up: Data and Control Flow Dictionary + +5.3.6 flet, labels, macrolet [Special Operator] +----------------------------------------------- + +'flet' ({(function-name lambda-list [[{local-declaration}* | +local-documentation]] {local-form}*)}*) {declaration}* {form}* +=> {result}* + + 'labels' ({(function-name lambda-list [[{local-declaration}* | +local-documentation]] {local-form}*)}*) {declaration}* {form}* +=> {result}* + + 'macrolet' ({(name lambda-list [[{local-declaration}* | +local-documentation]] {local-form}*)}*) {declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +function-name--a function name. + + name--a symbol. + + lambda-list--a lambda list; for flet and labels, it is an ordinary +lambda list; for macrolet, it is a macro lambda list. + + local-declaration--a declare expression; not evaluated. + + declaration--a declare expression; not evaluated. + + local-documentation--a string; not evaluated. + + local-forms, forms--an implicit progn. + + results--the values of the forms. + +Description:: +............. + +flet, labels, and macrolet define local functions and macros, and +execute forms using the local definitions. Forms are executed in order +of occurrence. + + The body forms (but not the lambda list) + + of each function created by flet and labels and each macro created by +macrolet are enclosed in an implicit block whose name is the function +block name of the function-name or name, as appropriate. + + The scope of the declarations between the list of local +function/macro definitions and the body forms in flet and labels does +not include the bodies of the locally defined functions, except that for +labels, any inline, notinline, or ftype declarations that refer to the +locally defined functions do apply to the local function bodies. That +is, their scope is the same as the function name that they affect. + + The scope of these declarations does not include the bodies of the +macro expander functions defined by macrolet. + +flet + flet defines locally named functions and executes a series of forms + with these definition bindings. Any number of such local functions + can be defined. + + The scope of the name binding encompasses only the body. Within + the body of flet, function-names matching those defined by flet + refer to the locally defined functions rather than to the global + function definitions of the same name. + + Also, within the scope of flet, global setf expander definitions of + the function-name defined by flet do not apply. Note that this + applies to (defsetf f ...), not (defmethod (setf f) ...). + + The names of functions defined by flet are in the lexical + environment; they retain their local definitions only within the + body of flet. The function definition bindings are visible only in + the body of flet, not the definitions themselves. Within the + function definitions, local function names that match those being + defined refer to functions or macros defined outside the flet. + flet can locally shadow a global function name, and the new + definition can refer to the global definition. + + Any local-documentation is attached to the corresponding local + function (if one is actually created) as a documentation string. + +labels + labels is equivalent to flet except that the scope of the defined + function names for labels encompasses the function definitions + themselves as well as the body. + +macrolet + macrolet establishes local macro definitions, using the same format + used by defmacro. + + Within the body of macrolet, global setf expander definitions of + the names defined by the macrolet do not apply; rather, setf + expands the macro form and recursively process the resulting form. + + The macro-expansion functions defined by macrolet are defined in + the + + lexical environment in which the macrolet form appears. + Declarations and macrolet and symbol-macrolet definitions affect + the local macro definitions in a macrolet, but the consequences are + undefined if the local macro definitions reference any local + variable or function bindings that are visible in that lexical + environment. + + Any local-documentation is attached to the corresponding local + macro function as a documentation string. + +Examples:: +.......... + + (defun foo (x flag) + (macrolet ((fudge (z) + ;The parameters x and flag are not accessible + ; at this point; a reference to flag would be to + ; the global variable of that name. + ` (if flag (* ,z ,z) ,z))) + ;The parameters x and flag are accessible here. + (+ x + (fudge x) + (fudge (+ x 1))))) + == + (defun foo (x flag) + (+ x + (if flag (* x x) x) + (if flag (* (+ x 1) (+ x 1)) (+ x 1)))) + + after macro expansion. The occurrences of x and flag legitimately +refer to the parameters of the function foo because those parameters are +visible at the site of the macro call which produced the expansion. + + (flet ((flet1 (n) (+ n n))) + (flet ((flet1 (n) (+ 2 (flet1 n)))) + (flet1 2))) => 6 + + (defun dummy-function () 'top-level) => DUMMY-FUNCTION + (funcall #'dummy-function) => TOP-LEVEL + (flet ((dummy-function () 'shadow)) + (funcall #'dummy-function)) => SHADOW + (eq (funcall #'dummy-function) (funcall 'dummy-function)) + => true + (flet ((dummy-function () 'shadow)) + (eq (funcall #'dummy-function) + (funcall 'dummy-function))) + => false + + (defun recursive-times (k n) + (labels ((temp (n) + (if (zerop n) 0 (+ k (temp (1- n)))))) + (temp n))) => RECURSIVE-TIMES + (recursive-times 2 3) => 6 + + (defmacro mlets (x &environment env) + (let ((form `(babbit ,x))) + (macroexpand form env))) => MLETS + (macrolet ((babbit (z) `(+ ,z ,z))) (mlets 5)) => 10 + + (flet ((safesqrt (x) (sqrt (abs x)))) + ;; The safesqrt function is used in two places. + (safesqrt (apply #'+ (map 'list #'safesqrt '(1 2 3 4 5 6))))) + => 3.291173 + + (defun integer-power (n k) + (declare (integer n)) + (declare (type (integer 0 *) k)) + (labels ((expt0 (x k a) + (declare (integer x a) (type (integer 0 *) k)) + (cond ((zerop k) a) + ((evenp k) (expt1 (* x x) (floor k 2) a)) + (t (expt0 (* x x) (floor k 2) (* x a))))) + (expt1 (x k a) + (declare (integer x a) (type (integer 0 *) k)) + (cond ((evenp k) (expt1 (* x x) (floor k 2) a)) + (t (expt0 (* x x) (floor k 2) (* x a)))))) + (expt0 n k 1))) => INTEGER-POWER + + (defun example (y l) + (flet ((attach (x) + (setq l (append l (list x))))) + (declare (inline attach)) + (dolist (x y) + (unless (null (cdr x)) + (attach x))) + l)) + + (example '((a apple apricot) (b banana) (c cherry) (d) (e)) + '((1) (2) (3) (4 2) (5) (6 3 2))) + => ((1) (2) (3) (4 2) (5) (6 3 2) (A APPLE APRICOT) (B BANANA) (C CHERRY)) + +See Also:: +.......... + +declare, *note defmacro:: , *note defun:: , *note documentation:: , +*note let:: , *note Evaluation::, *note Syntactic Interaction of +Documentation Strings and Declarations:: + +Notes:: +....... + +It is not possible to define recursive functions with flet. labels can +be used to define mutually recursive functions. + + If a macrolet form is a top level form, the body forms are also +processed as top level forms. See *note File Compilation::. + + +File: gcl.info, Node: funcall, Next: function (Special Operator), Prev: flet, Up: Data and Control Flow Dictionary + +5.3.7 funcall [Function] +------------------------ + +'funcall' function &rest args => {result}* + +Arguments and Values:: +...................... + +function--a function designator. + + args--arguments to the function. + + results--the values returned by the function. + +Description:: +............. + +funcall applies function to args. + + If function is a symbol, it is coerced to a function as if by finding +its functional value in the global environment. + +Examples:: +.......... + + (funcall #'+ 1 2 3) => 6 + (funcall 'car '(1 2 3)) => 1 + (funcall 'position 1 '(1 2 3 2 1) :start 1) => 4 + (cons 1 2) => (1 . 2) + (flet ((cons (x y) `(kons ,x ,y))) + (let ((cons (symbol-function '+))) + (funcall #'cons + (funcall 'cons 1 2) + (funcall cons 1 2)))) + => (KONS (1 . 2) 3) + +Exceptional Situations:: +........................ + +An error of type undefined-function should be signaled if function is a +symbol that does not have a global definition as a function or that has +a global definition as a macro or a special operator. + +See Also:: +.......... + +*note apply:: , function, *note Evaluation:: + +Notes:: +....... + + (funcall function arg1 arg2 ...) + == (apply function arg1 arg2 ... nil) + == (apply function (list arg1 arg2 ...)) + + The difference between funcall and an ordinary function call is that +in the former case the function is obtained by ordinary evaluation of a +form, and in the latter case it is obtained by the special +interpretation of the function position that normally occurs. + + +File: gcl.info, Node: function (Special Operator), Next: function-lambda-expression, Prev: funcall, Up: Data and Control Flow Dictionary + +5.3.8 function [Special Operator] +--------------------------------- + +'function' name => function + +Arguments and Values:: +...................... + +name--a function name or lambda expression. + + function--a function object. + +Description:: +............. + +The value of function is the functional value of name in the current +lexical environment. + + If name is a function name, the functional definition of that name is +that established by the innermost lexically enclosing flet, labels, or +macrolet form, if there is one. Otherwise the global functional +definition of the function name is returned. + + If name is a lambda expression, then a lexical closure is returned. +In situations where a closure over the same set of bindings might be +produced more than once, the various resulting closures might or might +not be eq. + + It is an error to use function on a function name that does not +denote a function in the lexical environment in which the function form +appears. Specifically, it is an error to use function on a symbol that +denotes a macro or special form. An implementation may choose not to +signal this error for performance reasons, but implementations are +forbidden from defining the failure to signal an error as a useful +behavior. + +Examples:: +.......... + + (defun adder (x) (function (lambda (y) (+ x y)))) + + The result of (adder 3) is a function that adds 3 to its argument: + + (setq add3 (adder 3)) + (funcall add3 5) => 8 + + This works because function creates a closure of the lambda +expression that is able to refer to the value 3 of the variable x even +after control has returned from the function adder. + +See Also:: +.......... + +*note defun:: , *note fdefinition:: , *note flet:: , labels, *note +symbol-function:: , *note Symbols as Forms::, *note Sharpsign +Single-Quote::, *note Printing Other Objects:: + +Notes:: +....... + +The notation #'name may be used as an abbreviation for (function name). + + +File: gcl.info, Node: function-lambda-expression, Next: functionp, Prev: function (Special Operator), Up: Data and Control Flow Dictionary + +5.3.9 function-lambda-expression [Function] +------------------------------------------- + +'function-lambda-expression' function +=> lambda-expression, closure-p, name + +Arguments and Values:: +...................... + +function--a function. + + lambda-expression--a lambda expression or nil. + + closure-p--a generalized boolean. + + name--an object. + +Description:: +............. + +Returns information about function as follows: + + The primary value, lambda-expression, is function's defining lambda +expression, or nil if the information is not available. The lambda +expression may have been pre-processed in some ways, but it should +remain a suitable argument to compile or function. Any implementation +may legitimately return nil as the lambda-expression of any function. + + The secondary value, closure-p, is nil if function's definition was +enclosed in the null lexical environment or something non-nil if +function's definition might have been enclosed in some non-null lexical +environment. Any implementation may legitimately return true as the +closure-p of any function. + + The tertiary value, name, is the "name" of function. The name is +intended for debugging only and is not necessarily one that would be +valid for use as a name in defun or function, for example. By +convention, nil is used to mean that function has no name. Any +implementation may legitimately return nil as the name of any function. + +Examples:: +.......... + +The following examples illustrate some possible return values, but are +not intended to be exhaustive: + + (function-lambda-expression #'(lambda (x) x)) + => NIL, false, NIL + OR=> NIL, true, NIL + OR=> (LAMBDA (X) X), true, NIL + OR=> (LAMBDA (X) X), false, NIL + + (function-lambda-expression + (funcall #'(lambda () #'(lambda (x) x)))) + => NIL, false, NIL + OR=> NIL, true, NIL + OR=> (LAMBDA (X) X), true, NIL + OR=> (LAMBDA (X) X), false, NIL + + (function-lambda-expression + (funcall #'(lambda (x) #'(lambda () x)) nil)) + => NIL, true, NIL + OR=> (LAMBDA () X), true, NIL + NOT=> NIL, false, NIL + NOT=> (LAMBDA () X), false, NIL + + (flet ((foo (x) x)) + (setf (symbol-function 'bar) #'foo) + (function-lambda-expression #'bar)) + => NIL, false, NIL + OR=> NIL, true, NIL + OR=> (LAMBDA (X) (BLOCK FOO X)), true, NIL + OR=> (LAMBDA (X) (BLOCK FOO X)), false, FOO + OR=> (SI::BLOCK-LAMBDA FOO (X) X), false, FOO + + (defun foo () + (flet ((bar (x) x)) + #'bar)) + (function-lambda-expression (foo)) + => NIL, false, NIL + OR=> NIL, true, NIL + OR=> (LAMBDA (X) (BLOCK BAR X)), true, NIL + OR=> (LAMBDA (X) (BLOCK BAR X)), true, (:INTERNAL FOO 0 BAR) + OR=> (LAMBDA (X) (BLOCK BAR X)), false, "BAR in FOO" + +Notes:: +....... + +Although implementations are free to return "nil, true, nil" in all +cases, they are encouraged to return a lambda expression as the primary +value in the case where the argument was created by a call to compile or +eval (as opposed to being created by loading a compiled file). + + +File: gcl.info, Node: functionp, Next: compiled-function-p, Prev: function-lambda-expression, Up: Data and Control Flow Dictionary + +5.3.10 functionp [Function] +--------------------------- + +'functionp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type function; otherwise, returns false. + +Examples:: +.......... + + (functionp 'append) => false + (functionp #'append) => true + (functionp (symbol-function 'append)) => true + (flet ((f () 1)) (functionp #'f)) => true + (functionp (compile nil '(lambda () 259))) => true + (functionp nil) => false + (functionp 12) => false + (functionp '(lambda (x) (* x x))) => false + (functionp #'(lambda (x) (* x x))) => true + +Notes:: +....... + + (functionp object) == (typep object 'function) + + +File: gcl.info, Node: compiled-function-p, Next: call-arguments-limit, Prev: functionp, Up: Data and Control Flow Dictionary + +5.3.11 compiled-function-p [Function] +------------------------------------- + +'compiled-function-p' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type compiled-function; otherwise, returns +false. + +Examples:: +.......... + + (defun f (x) x) => F + (compiled-function-p #'f) + => false + OR=> true + (compiled-function-p 'f) => false + (compile 'f) => F + (compiled-function-p #'f) => true + (compiled-function-p 'f) => false + (compiled-function-p (compile nil '(lambda (x) x))) + => true + (compiled-function-p #'(lambda (x) x)) + => false + OR=> true + (compiled-function-p '(lambda (x) x)) => false + +See Also:: +.......... + +*note compile:: , *note compile-file:: , *note compiled-function:: + +Notes:: +....... + + (compiled-function-p object) == (typep object 'compiled-function) + + +File: gcl.info, Node: call-arguments-limit, Next: lambda-list-keywords, Prev: compiled-function-p, Up: Data and Control Flow Dictionary + +5.3.12 call-arguments-limit [Constant Variable] +----------------------------------------------- + +Constant Value:: +................ + +An integer not smaller than 50 and at least as great as the value of +lambda-parameters-limit, the exact magnitude of which is +implementation-dependent. + +Description:: +............. + +The upper exclusive bound on the number of arguments that may be passed +to a function. + +See Also:: +.......... + +*note lambda-parameters-limit:: , *note multiple-values-limit:: + + +File: gcl.info, Node: lambda-list-keywords, Next: lambda-parameters-limit, Prev: call-arguments-limit, Up: Data and Control Flow Dictionary + +5.3.13 lambda-list-keywords [Constant Variable] +----------------------------------------------- + +Constant Value:: +................ + +a list, the elements of which are implementation-dependent, but which +must contain at least the symbols &allow-other-keys, &aux, &body, +&environment, &key, &optional, &rest, and &whole. + +Description:: +............. + +A list of all the lambda list keywords used in the implementation, +including the additional ones used only by macro definition forms. + +See Also:: +.......... + +*note defun:: , *note flet:: , *note defmacro:: , macrolet, *note The +Evaluation Model:: + + +File: gcl.info, Node: lambda-parameters-limit, Next: defconstant, Prev: lambda-list-keywords, Up: Data and Control Flow Dictionary + +5.3.14 lambda-parameters-limit [Constant Variable] +-------------------------------------------------- + +Constant Value:: +................ + +implementation-dependent, but not smaller than 50. + +Description:: +............. + +A positive integer that is the upper exclusive bound on the number of +parameter names that can appear in a single lambda list. + +See Also:: +.......... + +*note call-arguments-limit:: + +Notes:: +....... + +Implementors are encouraged to make the value of lambda-parameters-limit +as large as possible. + + +File: gcl.info, Node: defconstant, Next: defparameter, Prev: lambda-parameters-limit, Up: Data and Control Flow Dictionary + +5.3.15 defconstant [Macro] +-------------------------- + +'defconstant' name initial-value [documentation] => name + +Arguments and Values:: +...................... + +name--a symbol; not evaluated. + + initial-value--a form; evaluated. + + documentation--a string; not evaluated. + +Description:: +............. + +defconstant causes the global variable named by name to be given a value +that is the result of evaluating initial-value. + + A constant defined by defconstant can be redefined with defconstant. +However, the consequences are undefined if an attempt is made to assign +a value to the symbol using another operator, or to assign it to a +different value using a subsequent defconstant. + + If documentation is supplied, it is attached to name as a +documentation string of kind variable. + + defconstant normally appears as a top level form, but it is +meaningful for it to appear as a non-top-level form. However, the +compile-time side effects described below only take place when +defconstant appears as a top level form. + + The consequences are undefined if there are any bindings of the +variable named by name at the time defconstant is executed or if the +value is not eql to the value of initial-value. + + The consequences are undefined when constant symbols are rebound as +either lexical or dynamic variables. In other words, a reference to a +symbol declared with defconstant always refers to its global value. + + The side effects of the execution of defconstant must be equivalent +to at least the side effects of the execution of the following code: + + (setf (symbol-value 'name) initial-value) + (setf (documentation 'name 'variable) 'documentation) + + If a defconstant form appears as a top level form, the compiler must +recognize that name names a constant variable. An implementation may +choose to evaluate the value-form at compile time, load time, or both. +Therefore, users must ensure that the initial-value can be evaluated at +compile time (regardless of whether or not references to name appear in +the file) and that it always evaluates to the same value. + + [Editorial Note by KMP: Does "same value" here mean eql or similar?] + + [Reviewer Note by Moon: Probably depends on whether load time is +compared to compile time, or two compiles.] + +Examples:: +.......... + + (defconstant this-is-a-constant 'never-changing "for a test") => THIS-IS-A-CONSTANT + this-is-a-constant => NEVER-CHANGING + (documentation 'this-is-a-constant 'variable) => "for a test" + (constantp 'this-is-a-constant) => true + +See Also:: +.......... + +*note declaim:: , *note defparameter:: , defvar, *note documentation:: , +*note proclaim:: , *note Constant Variables::, *note Compilation:: + + +File: gcl.info, Node: defparameter, Next: destructuring-bind, Prev: defconstant, Up: Data and Control Flow Dictionary + +5.3.16 defparameter, defvar [Macro] +----------------------------------- + +'defparameter' name initial-value [documentation] => name + + 'defvar' name [initial-value [documentation]] => name + +Arguments and Values:: +...................... + +name--a symbol; not evaluated. + + initial-value--a form; for defparameter, it is always evaluated, but +for defvar it is evaluated only if name is not already bound. + + documentation--a string; not evaluated. + +Description:: +............. + +defparameter and defvar establish name as a dynamic variable. + + defparameter unconditionally assigns the initial-value to the dynamic +variable named name. defvar, by contrast, assigns initial-value (if +supplied) to the dynamic variable named name only if name is not already +bound. + + If no initial-value is supplied, defvar leaves the value cell of the +dynamic variable named name undisturbed; if name was previously bound, +its old value persists, and if it was previously unbound, it remains +unbound. + + If documentation is supplied, it is attached to name as a +documentation string of kind variable. + + defparameter and defvar normally appear as a top level form, but it +is meaningful for them to appear as non-top-level forms. However, the +compile-time side effects described below only take place when they +appear as top level forms. + +Examples:: +.......... + + (defparameter *p* 1) => *P* + *p* => 1 + (constantp '*p*) => false + (setq *p* 2) => 2 + (defparameter *p* 3) => *P* + *p* => 3 + + (defvar *v* 1) => *V* + *v* => 1 + (constantp '*v*) => false + (setq *v* 2) => 2 + (defvar *v* 3) => *V* + *v* => 2 + + (defun foo () + (let ((*p* 'p) (*v* 'v)) + (bar))) => FOO + (defun bar () (list *p* *v*)) => BAR + (foo) => (P V) + + The principal operational distinction between defparameter and defvar +is that defparameter makes an unconditional assignment to name, while +defvar makes a conditional one. In practice, this means that +defparameter is useful in situations where loading or reloading the +definition would want to pick up a new value of the variable, while +defvar is used in situations where the old value would want to be +retained if the file were loaded or reloaded. For example, one might +create a file which contained: + + (defvar *the-interesting-numbers* '()) + (defmacro define-interesting-number (name n) + `(progn (defvar ,name ,n) + (pushnew ,name *the-interesting-numbers*) + ',name)) + (define-interesting-number *my-height* 168) ;cm + (define-interesting-number *my-weight* 13) ;stones + + Here the initial value, (), for the variable +*the-interesting-numbers* is just a seed that we are never likely to +want to reset to something else once something has been grown from it. +As such, we have used defvar to avoid having the *interesting-numbers* +information reset if the file is loaded a second time. It is true that +the two calls to define-interesting-number here would be reprocessed, +but if there were additional calls in another file, they would not be +and that information would be lost. On the other hand, consider the +following code: + + (defparameter *default-beep-count* 3) + (defun beep (&optional (n *default-beep-count*)) + (dotimes (i n) (si: + + Here we could easily imagine editing the code to change the initial +value of *default-beep-count*, and then reloading the file to pick up +the new value. In order to make value updating easy, we have used +defparameter. + + On the other hand, there is potential value to using defvar in this +situation. For example, suppose that someone had predefined an +alternate value for *default-beep-count*, or had loaded the file and +then manually changed the value. In both cases, if we had used defvar +instead of defparameter, those user preferences would not be overridden +by (re)loading the file. + + The choice of whether to use defparameter or defvar has visible +consequences to programs, but is nevertheless often made for subjective +reasons. + +Side Effects:: +.............. + +If a defvar or defparameter form appears as a top level form, the +compiler must recognize that the name has been proclaimed special. +However, it must neither evaluate the initial-value form nor assign the +dynamic variable named name at compile time. + + There may be additional (implementation-defined) compile-time or +run-time side effects, as long as such effects do not interfere with the +correct operation of conforming programs. + +Affected By:: +............. + +defvar is affected by whether name is already bound. + +See Also:: +.......... + +*note declaim:: , *note defconstant:: , *note documentation:: , *note +Compilation:: + +Notes:: +....... + +It is customary to name dynamic variables with an asterisk at the +beginning and end of the name. e.g., *foo* is a good name for a dynamic +variable, but not for a lexical variable; foo is a good name for a +lexical variable, but not for a dynamic variable. This naming +convention is observed for all defined names in Common Lisp; however, +neither conforming programs nor conforming implementations are obliged +to adhere to this convention. + + The intent of the permission for additional side effects is to allow +implementations to do normal "bookkeeping" that accompanies definitions. +For example, the macro expansion of a defvar or defparameter form might +include code that arranges to record the name of the source file in +which the definition occurs. + + defparameter and defvar might be defined as follows: + + (defmacro defparameter (name initial-value + &optional (documentation nil documentation-p)) + `(progn (declaim (special ,name)) + (setf (symbol-value ',name) ,initial-value) + ,(when documentation-p + `(setf (documentation ',name 'variable) ',documentation)) + ',name)) + (defmacro defvar (name &optional + (initial-value nil initial-value-p) + (documentation nil documentation-p)) + `(progn (declaim (special ,name)) + ,(when initial-value-p + `(unless (boundp ',name) + (setf (symbol-value ',name) ,initial-value))) + ,(when documentation-p + `(setf (documentation ',name 'variable) ',documentation)) + ',name)) + + +File: gcl.info, Node: destructuring-bind, Next: let, Prev: defparameter, Up: Data and Control Flow Dictionary + +5.3.17 destructuring-bind [Macro] +--------------------------------- + +'destructuring-bind' lambda-list expression {declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +lambda-list--a destructuring lambda list. + + expression--a form. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +destructuring-bind binds the variables specified in lambda-list to the +corresponding values in the tree structure resulting from the evaluation +of expression; then destructuring-bind evaluates forms. + + The lambda-list supports destructuring as described in *note +Destructuring Lambda Lists::. + +Examples:: +.......... + + (defun iota (n) (loop for i from 1 to n collect i)) ;helper + (destructuring-bind ((a &optional (b 'bee)) one two three) + `((alpha) ,@(iota 3)) + (list a b three two one)) => (ALPHA BEE 3 2 1) + +Exceptional Situations:: +........................ + +If the result of evaluating the expression does not match the +destructuring pattern, an error of type error should be signaled. + +See Also:: +.......... + +macrolet, *note defmacro:: + + +File: gcl.info, Node: let, Next: progv, Prev: destructuring-bind, Up: Data and Control Flow Dictionary + +5.3.18 let, let* [Special Operator] +----------------------------------- + +'let' ({var | (var [init-form])}*) {declaration}* {form}* => {result}* + + 'let*' ({var | (var [init-form])}*) {declaration}* {form}* => +{result}* + +Arguments and Values:: +...................... + +var--a symbol. + + init-form--a form. + + declaration--a declare expression; not evaluated. + + form--a form. + + results--the values returned by the forms. + +Description:: +............. + +let and let* create new variable bindings and execute a series of forms +that use these bindings. let performs the bindings in parallel and let* +does them sequentially. + + The form + + (let ((var1 init-form-1) + (var2 init-form-2) + ... + (varm init-form-m)) + declaration1 + declaration2 + ... + declarationp + form1 + form2 + ... + formn) + + first evaluates the expressions init-form-1, init-form-2, and so on, + + in that order, saving the resulting values. Then all of the +variables varj are bound to the corresponding values; each binding is +lexical unless there is a special declaration to the contrary. The +expressions formk are then evaluated in order; the values of all but the +last are discarded (that is, the body of a let is an implicit progn). + + let* is similar to let, but the bindings of variables are performed +sequentially rather than in parallel. The expression for the init-form +of a var can refer to vars previously bound in the let*. + + The form + + (let* ((var1 init-form-1) + (var2 init-form-2) + ... + (varm init-form-m)) + declaration1 + declaration2 + ... + declarationp + form1 + form2 + ... + formn) + + first evaluates the expression init-form-1, then binds the variable +var1 to that value; then it evaluates init-form-2 and binds + + var2, and so on. The expressions formj are then evaluated in order; +the values of all but the last are discarded (that is, the body of let* +is an implicit progn). + + For both let and let*, if there is not an init-form associated with a +var, var is initialized to nil. + + The special form let has the property that the scope of the name +binding does not include any initial value form. For let*, a variable's +scope also includes the remaining initial value forms for subsequent +variable bindings. + +Examples:: +.......... + + (setq a 'top) => TOP + (defun dummy-function () a) => DUMMY-FUNCTION + (let ((a 'inside) (b a)) + (format nil "~S ~S ~S" a b (dummy-function))) => "INSIDE TOP TOP" + (let* ((a 'inside) (b a)) + (format nil "~S ~S ~S" a b (dummy-function))) => "INSIDE INSIDE TOP" + (let ((a 'inside) (b a)) + (declare (special a)) + (format nil "~S ~S ~S" a b (dummy-function))) => "INSIDE TOP INSIDE" + + The code + + (let (x) + (declare (integer x)) + (setq x (gcd y z)) + ...) + + is incorrect; although x is indeed set before it is used, and is set +to a value of the declared type integer, nevertheless x initially takes +on the value nil in violation of the type declaration. + +See Also:: +.......... + +*note progv:: + + +File: gcl.info, Node: progv, Next: setq, Prev: let, Up: Data and Control Flow Dictionary + +5.3.19 progv [Special Operator] +------------------------------- + +'progv' symbols values {form}* => {result}* + +Arguments and Values:: +...................... + +symbols--a list of symbols; evaluated. + + values--a list of objects; evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +progv creates new dynamic variable bindings and executes each form using +those bindings. Each form is evaluated in order. + + progv allows binding one or more dynamic variables whose names may be +determined at run time. Each form is evaluated in order with the +dynamic variables whose names are in symbols bound to corresponding +values. If too few values are supplied, the remaining symbols are bound +and then made to have no value. If too many values are supplied, the +excess values are ignored. The bindings of the dynamic variables are +undone on exit from progv. + +Examples:: +.......... + + (setq *x* 1) => 1 + (progv '(*x*) '(2) *x*) => 2 + *x* => 1 + + Assuming *x* is not globally special, + + (let ((*x* 3)) + (progv '(*x*) '(4) + (list *x* (symbol-value '*x*)))) => (3 4) + +See Also:: +.......... + +*note let:: , *note Evaluation:: + +Notes:: +....... + +Among other things, progv is useful when writing interpreters for +languages embedded in Lisp; it provides a handle on the mechanism for +binding dynamic variables. + + +File: gcl.info, Node: setq, Next: psetq, Prev: progv, Up: Data and Control Flow Dictionary + +5.3.20 setq [Special Form] +-------------------------- + +'setq' {!pair}* => result + + pair ::=var form + +Pronunciation:: +............... + +pronounced 'set ,ky\"u + +Arguments and Values:: +...................... + +var--a symbol naming a variable other than a constant variable. + + form--a form. + + result--the primary value of the last form, or nil if no pairs were +supplied. + +Description:: +............. + +Assigns values to variables. + + (setq var1 form1 var2 form2 ...) is the simple variable assignment +statement of Lisp. First form1 is evaluated and the result is stored in +the variable var1, then form2 is evaluated and the result stored in +var2, and so forth. setq may be used for assignment of both lexical and +dynamic variables. + + If any var refers to a binding made by symbol-macrolet, then that var +is treated as if setf (not setq) had been used. + +Examples:: +.......... + + ;; A simple use of SETQ to establish values for variables. + (setq a 1 b 2 c 3) => 3 + a => 1 + b => 2 + c => 3 + + ;; Use of SETQ to update values by sequential assignment. + (setq a (1+ b) b (1+ a) c (+ a b)) => 7 + a => 3 + b => 4 + c => 7 + + ;; This illustrates the use of SETQ on a symbol macro. + (let ((x (list 10 20 30))) + (symbol-macrolet ((y (car x)) (z (cadr x))) + (setq y (1+ z) z (1+ y)) + (list x y z))) + => ((21 22 30) 21 22) + +Side Effects:: +.............. + +The primary value of each form is assigned to the corresponding var. + +See Also:: +.......... + +*note psetq:: , *note set:: , *note setf:: + + +File: gcl.info, Node: psetq, Next: block, Prev: setq, Up: Data and Control Flow Dictionary + +5.3.21 psetq [Macro] +-------------------- + +'psetq' {!pair}* => nil + + pair ::=var form + +Pronunciation:: +............... + +psetq: pronounced + +Arguments and Values:: +...................... + +var--a symbol naming a variable other than a constant variable. + + form--a form. + +Description:: +............. + +Assigns values to variables. + + This is just like setq, except that the assignments happen "in +parallel." That is, first all of the forms are evaluated, and only then +are the variables set to the resulting values. In this way, the +assignment to one variable does not affect the value computation of +another in the way that would occur with setq's sequential assignment. + + If any var refers to a binding made by symbol-macrolet, then that var +is treated as if psetf (not psetq) had been used. + +Examples:: +.......... + + ;; A simple use of PSETQ to establish values for variables. + ;; As a matter of style, many programmers would prefer SETQ + ;; in a simple situation like this where parallel assignment + ;; is not needed, but the two have equivalent effect. + (psetq a 1 b 2 c 3) => NIL + a => 1 + b => 2 + c => 3 + + ;; Use of PSETQ to update values by parallel assignment. + ;; The effect here is very different than if SETQ had been used. + (psetq a (1+ b) b (1+ a) c (+ a b)) => NIL + a => 3 + b => 2 + c => 3 + + ;; Use of PSETQ on a symbol macro. + (let ((x (list 10 20 30))) + (symbol-macrolet ((y (car x)) (z (cadr x))) + (psetq y (1+ z) z (1+ y)) + (list x y z))) + => ((21 11 30) 21 11) + + ;; Use of parallel assignment to swap values of A and B. + (let ((a 1) (b 2)) + (psetq a b b a) + (values a b)) + => 2, 1 + +Side Effects:: +.............. + +The values of forms are assigned to vars. + +See Also:: +.......... + +psetf, *note setq:: + + +File: gcl.info, Node: block, Next: catch, Prev: psetq, Up: Data and Control Flow Dictionary + +5.3.22 block [Special Operator] +------------------------------- + +'block' name form* => {result}* + +Arguments and Values:: +...................... + +name--a symbol. + + form--a form. + + results--the values of the forms if a normal return occurs, or else, +if an explicit return occurs, the values that were transferred. + +Description:: +............. + +block establishes a block named name and then evaluates forms as an +implicit progn. + + The special operators block and return-from work together to provide +a structured, lexical, non-local exit facility. At any point lexically +contained within forms, return-from can be used with the given name to +return control and values from the block form, except when an +intervening block with the same name has been established, in which case +the outer block is shadowed by the inner one. + + The block named name has lexical scope and dynamic extent. + + Once established, a block may only be exited once, whether by normal +return or explicit return. + +Examples:: +.......... + + (block empty) => NIL + (block whocares (values 1 2) (values 3 4)) => 3, 4 + (let ((x 1)) + (block stop (setq x 2) (return-from stop) (setq x 3)) + x) => 2 + (block early (return-from early (values 1 2)) (values 3 4)) => 1, 2 + (block outer (block inner (return-from outer 1)) 2) => 1 + (block twin (block twin (return-from twin 1)) 2) => 2 + ;; Contrast behavior of this example with corresponding example of CATCH. + (block b + (flet ((b1 () (return-from b 1))) + (block b (b1) (print 'unreachable)) + 2)) => 1 + +See Also:: +.......... + +*note return:: , *note return-from:: , *note Evaluation:: + +Notes:: +....... + + +File: gcl.info, Node: catch, Next: go, Prev: block, Up: Data and Control Flow Dictionary + +5.3.23 catch [Special Operator] +------------------------------- + +'catch' tag {form}* => {result}* + +Arguments and Values:: +...................... + +tag--a catch tag; evaluated. + + forms--an implicit progn. + + results--if the forms exit normally, the values returned by the +forms; if a throw occurs to the tag, the values that are thrown. + +Description:: +............. + +catch is used as the destination of a non-local control transfer by +throw. Tags are used to find the catch to which a throw is transferring +control. (catch 'foo form) catches a (throw 'foo form) but not a (throw +'bar form). + + The order of execution of catch follows: + +1. + Tag is evaluated. It serves as the name of the catch. + +2. + Forms are then evaluated as an implicit progn, and the results of + the last form are returned unless a throw occurs. + +3. + If a throw occurs during the execution of one of the forms, control + is transferred to the catch form whose tag is eq to the tag + argument of the throw and which is the most recently established + catch with that tag. No further evaluation of forms occurs. + +4. + The tag established by catch is disestablished just before the + results are returned. + + If during the execution of one of the forms, a throw is executed +whose tag is eq to the catch tag, then the values specified by the throw +are returned as the result of the dynamically most recently established +catch form with that tag. + + The mechanism for catch and throw works even if throw is not within +the lexical scope of catch. throw must occur within the dynamic extent +of the evaluation of the body of a catch with a corresponding tag. + +Examples:: +.......... + + (catch 'dummy-tag 1 2 (throw 'dummy-tag 3) 4) => 3 + (catch 'dummy-tag 1 2 3 4) => 4 + (defun throw-back (tag) (throw tag t)) => THROW-BACK + (catch 'dummy-tag (throw-back 'dummy-tag) 2) => T + + ;; Contrast behavior of this example with corresponding example of BLOCK. + (catch 'c + (flet ((c1 () (throw 'c 1))) + (catch 'c (c1) (print 'unreachable)) + 2)) => 2 + +Exceptional Situations:: +........................ + +An error of type control-error is signaled if throw is done when there +is no suitable catch tag. + +See Also:: +.......... + +*note throw:: , *note Evaluation:: + +Notes:: +....... + +It is customary for symbols to be used as tags, but any object is +permitted. However, numbers should not be used because the comparison +is done using eq. + + catch differs from block in that catch tags have dynamic scope while +block names have lexical scope. + + +File: gcl.info, Node: go, Next: return-from, Prev: catch, Up: Data and Control Flow Dictionary + +5.3.24 go [Special Operator] +---------------------------- + +'go' tag => # + +Arguments and Values:: +...................... + +tag--a go tag. + +Description:: +............. + +go transfers control to the point in the body of an enclosing tagbody +form labeled by a tag eql to tag. If there is no such tag in the body, +the bodies of lexically containing tagbody forms (if any) are examined +as well. If several tags are eql to tag, control is transferred to +whichever matching tag is contained in the innermost tagbody form that +contains the go. The consequences are undefined if there is no matching +tag lexically visible to the point of the go. + + The transfer of control initiated by go is performed as described in +*note Transfer of Control to an Exit Point::. + +Examples:: +.......... + + (tagbody + (setq val 2) + (go lp) + (incf val 3) + lp (incf val 4)) => NIL + val => 6 + + The following is in error because there is a normal exit of the +tagbody before the go is executed. + + (let ((a nil)) + (tagbody t (setq a #'(lambda () (go t)))) + (funcall a)) + + The following is in error because the tagbody is passed over before +the go form is executed. + + (funcall (block nil + (tagbody a (return #'(lambda () (go a)))))) + +See Also:: +.......... + +*note tagbody:: + + +File: gcl.info, Node: return-from, Next: return, Prev: go, Up: Data and Control Flow Dictionary + +5.3.25 return-from [Special Operator] +------------------------------------- + +'return-from' name [result] => # + +Arguments and Values:: +...................... + +name--a block tag; not evaluated. + + result--a form; evaluated. The default is nil. + +Description:: +............. + +Returns control and multiple values_2 from a lexically enclosing block. + + A block form named name must lexically enclose the occurrence of +return-from; any values yielded by the evaluation of result are +immediately returned from the innermost such lexically enclosing block. + + The transfer of control initiated by return-from is performed as +described in *note Transfer of Control to an Exit Point::. + +Examples:: +.......... + + (block alpha (return-from alpha) 1) => NIL + (block alpha (return-from alpha 1) 2) => 1 + (block alpha (return-from alpha (values 1 2)) 3) => 1, 2 + (let ((a 0)) + (dotimes (i 10) (incf a) (when (oddp i) (return))) + a) => 2 + (defun temp (x) + (if x (return-from temp 'dummy)) + 44) => TEMP + (temp nil) => 44 + (temp t) => DUMMY + (block out + (flet ((exit (n) (return-from out n))) + (block out (exit 1))) + 2) => 1 + (block nil + (unwind-protect (return-from nil 1) + (return-from nil 2))) + => 2 + (dolist (flag '(nil t)) + (block nil + (let ((x 5)) + (declare (special x)) + (unwind-protect (return-from nil) + (print x)))) + (print 'here)) + |> 5 + |> HERE + |> 5 + |> HERE + => NIL + (dolist (flag '(nil t)) + (block nil + (let ((x 5)) + (declare (special x)) + (unwind-protect + (if flag (return-from nil)) + (print x)))) + (print 'here)) + |> 5 + |> HERE + |> 5 + |> HERE + => NIL + + The following has undefined consequences because the block form exits +normally before the return-from form is attempted. + + (funcall (block nil #'(lambda () (return-from nil)))) is an error. + +See Also:: +.......... + +*note block:: , *note return:: , *note Evaluation:: + + +File: gcl.info, Node: return, Next: tagbody, Prev: return-from, Up: Data and Control Flow Dictionary + +5.3.26 return [Macro] +--------------------- + +'return' [result] => # + +Arguments and Values:: +...................... + +result--a form; evaluated. The default is nil. + +Description:: +............. + +Returns, as if by return-from, from the block named nil. + +Examples:: +.......... + + (block nil (return) 1) => NIL + (block nil (return 1) 2) => 1 + (block nil (return (values 1 2)) 3) => 1, 2 + (block nil (block alpha (return 1) 2)) => 1 + (block alpha (block nil (return 1)) 2) => 2 + (block nil (block nil (return 1) 2)) => 1 + +See Also:: +.......... + +*note block:: , *note return-from:: , *note Evaluation:: + +Notes:: +....... + + (return) == (return-from nil) + (return form) == (return-from nil form) + + The implicit blocks established by macros such as do are often named +nil, so that return can be used to exit from such forms. + + +File: gcl.info, Node: tagbody, Next: throw, Prev: return, Up: Data and Control Flow Dictionary + +5.3.27 tagbody [Special Operator] +--------------------------------- + +'tagbody' {tag | statement}* => nil + +Arguments and Values:: +...................... + +tag--a go tag; not evaluated. + + statement--a compound form; evaluated as described below. + +Description:: +............. + +Executes zero or more statements in a lexical environment that provides +for control transfers to labels indicated by the tags. + + The statements in a tagbody are evaluated in order from left to +right, and their values are discarded. If at any time there are no +remaining statements, tagbody returns nil. However, if (go tag) is +evaluated, control jumps to the part of the body labeled with the tag. +(Tags are compared with eql.) + + A tag established by tagbody has lexical scope and has dynamic +extent. Once tagbody has been exited, it is no longer valid to go to a +tag in its body. It is permissible for go to jump to a tagbody that is +not the innermost tagbody containing that go; the tags established by a +tagbody only shadow other tags of like name. + + The determination of which elements of the body are tags and which +are statements is made prior to any macro expansion of that element. If +a statement is a macro form and its macro expansion is an atom, that +atom is treated as a statement, not a tag. + +Examples:: +.......... + + (let (val) + (tagbody + (setq val 1) + (go point-a) + (incf val 16) + point-c + (incf val 04) + (go point-b) + (incf val 32) + point-a + (incf val 02) + (go point-c) + (incf val 64) + point-b + (incf val 08)) + val) + => 15 + (defun f1 (flag) + (let ((n 1)) + (tagbody + (setq n (f2 flag #'(lambda () (go out)))) + out + (prin1 n)))) + => F1 + (defun f2 (flag escape) + (if flag (funcall escape) 2)) + => F2 + (f1 nil) + |> 2 + => NIL + (f1 t) + |> 1 + => NIL + +See Also:: +.......... + +*note go:: + +Notes:: +....... + +The macros in Figure 5-10 have implicit tagbodies. + + do do-external-symbols dotimes + do* do-symbols prog + do-all-symbols dolist prog* + + Figure 5-10: Macros that have implicit tagbodies. + + + +File: gcl.info, Node: throw, Next: unwind-protect, Prev: tagbody, Up: Data and Control Flow Dictionary + +5.3.28 throw [Special Operator] +------------------------------- + +'throw' tag result-form => # + +Arguments and Values:: +...................... + +tag--a catch tag; evaluated. + + result-form--a form; evaluated as described below. + +Description:: +............. + +throw causes a non-local control transfer to a catch whose tag is eq to +tag. + + Tag is evaluated first to produce an object called the throw tag; +then result-form is evaluated, and its results are saved. If the +result-form produces multiple values, then all the values are saved. +The most recent outstanding catch whose tag is eq to the throw tag is +exited; the saved results are returned as the value or values of catch. + + The transfer of control initiated by throw is performed as described +in *note Transfer of Control to an Exit Point::. + +Examples:: +.......... + + (catch 'result + (setq i 0 j 0) + (loop (incf j 3) (incf i) + (if (= i 3) (throw 'result (values i j))))) => 3, 9 + + + (catch nil + (unwind-protect (throw nil 1) + (throw nil 2))) => 2 + + The consequences of the following are undefined because the catch of +b is passed over by the first throw, hence portable programs must assume +that its dynamic extent is terminated. The binding of the catch tag is +not yet disestablished and therefore it is the target of the second +throw. + + (catch 'a + (catch 'b + (unwind-protect (throw 'a 1) + (throw 'b 2)))) + + The following prints "The inner catch returns :SECOND-THROW" and then +returns :outer-catch. + + (catch 'foo + (format t "The inner catch returns ~s.~ + (catch 'foo + (unwind-protect (throw 'foo :first-throw) + (throw 'foo :second-throw)))) + :outer-catch) + |> The inner catch returns :SECOND-THROW + => :OUTER-CATCH + +Exceptional Situations:: +........................ + +If there is no outstanding catch tag that matches the throw tag, no +unwinding of the stack is performed, and an error of type control-error +is signaled. When the error is signaled, the dynamic environment is +that which was in force at the point of the throw. + +See Also:: +.......... + +*note block:: , *note catch:: , *note return-from:: , *note +unwind-protect:: , *note Evaluation:: + +Notes:: +....... + +catch and throw are normally used when the exit point must have dynamic +scope (e.g., the throw is not lexically enclosed by the catch), while +block and return are used when lexical scope is sufficient. + + +File: gcl.info, Node: unwind-protect, Next: nil, Prev: throw, Up: Data and Control Flow Dictionary + +5.3.29 unwind-protect [Special Operator] +---------------------------------------- + +'unwind-protect' protected-form {cleanup-form}* => {result}* + +Arguments and Values:: +...................... + +protected-form--a form. + + cleanup-form--a form. + + results--the values of the protected-form. + +Description:: +............. + +unwind-protect evaluates protected-form and guarantees that +cleanup-forms are executed before unwind-protect exits, whether it +terminates normally or is aborted by a control transfer of some kind. +unwind-protect is intended to be used to make sure that certain side +effects take place after the evaluation of protected-form. + + If a non-local exit occurs during execution of cleanup-forms, no +special action is taken. The cleanup-forms of unwind-protect are not +protected by that unwind-protect. + + unwind-protect protects against all attempts to exit from +protected-form, including go, handler-case, ignore-errors, restart-case, +return-from, throw, and with-simple-restart. + + Undoing of handler and restart bindings during an exit happens in +parallel with the undoing of the bindings of dynamic variables and catch +tags, in the reverse order in which they were established. The effect +of this is that cleanup-form sees the same handler and restart bindings, +as well as dynamic variable bindings and catch tags, as were visible +when the unwind-protect was entered. + +Examples:: +.......... + + (tagbody + (let ((x 3)) + (unwind-protect + (if (numberp x) (go out)) + (print x))) + out + ...) + + When go is executed, the call to print is executed first, and then +the transfer of control to the tag out is completed. + + (defun dummy-function (x) + (setq state 'running) + (unless (numberp x) (throw 'abort 'not-a-number)) + (setq state (1+ x))) => DUMMY-FUNCTION + (catch 'abort (dummy-function 1)) => 2 + state => 2 + (catch 'abort (dummy-function 'trash)) => NOT-A-NUMBER + state => RUNNING + (catch 'abort (unwind-protect (dummy-function 'trash) + (setq state 'aborted))) => NOT-A-NUMBER + state => ABORTED + + The following code is not correct: + + (unwind-protect + (progn (incf *access-count*) + (perform-access)) + (decf *access-count*)) + + If an exit occurs before completion of incf, the decf form is +executed anyway, resulting in an incorrect value for *access-count*. +The correct way to code this is as follows: + + (let ((old-count *access-count*)) + (unwind-protect + (progn (incf *access-count*) + (perform-access)) + (setq *access-count* old-count))) + + ;;; The following returns 2. + (block nil + (unwind-protect (return 1) + (return 2))) + + ;;; The following has undefined consequences. + (block a + (block b + (unwind-protect (return-from a 1) + (return-from b 2)))) + + ;;; The following returns 2. + (catch nil + (unwind-protect (throw nil 1) + (throw nil 2))) + + ;;; The following has undefined consequences because the catch of B is + ;;; passed over by the first THROW, hence portable programs must assume + ;;; its dynamic extent is terminated. The binding of the catch tag is not + ;;; yet disestablished and therefore it is the target of the second throw. + (catch 'a + (catch 'b + (unwind-protect (throw 'a 1) + (throw 'b 2)))) + + ;;; The following prints "The inner catch returns :SECOND-THROW" + ;;; and then returns :OUTER-CATCH. + (catch 'foo + (format t "The inner catch returns ~s.~ + (catch 'foo + (unwind-protect (throw 'foo :first-throw) + (throw 'foo :second-throw)))) + :outer-catch) + + ;;; The following returns 10. The inner CATCH of A is passed over, but + ;;; because that CATCH is disestablished before the THROW to A is executed, + ;;; it isn't seen. + (catch 'a + (catch 'b + (unwind-protect (1+ (catch 'a (throw 'b 1))) + (throw 'a 10)))) + + ;;; The following has undefined consequences because the extent of + ;;; the (CATCH 'BAR ...) exit ends when the (THROW 'FOO ...) + ;;; commences. + (catch 'foo + (catch 'bar + (unwind-protect (throw 'foo 3) + (throw 'bar 4) + (print 'xxx)))) + + ;;; The following returns 4; XXX is not printed. + ;;; The (THROW 'FOO ...) has no effect on the scope of the BAR + ;;; catch tag or the extent of the (CATCH 'BAR ...) exit. + (catch 'bar + (catch 'foo + (unwind-protect (throw 'foo 3) + (throw 'bar 4) + (print 'xxx)))) + + ;;; The following prints 5. + (block nil + (let ((x 5)) + (declare (special x)) + (unwind-protect (return) + (print x)))) + +See Also:: +.......... + +*note catch:: , *note go:: , *note handler-case:: , *note restart-case:: +, *note return:: , *note return-from:: , *note throw:: , *note +Evaluation:: + + +File: gcl.info, Node: nil, Next: not, Prev: unwind-protect, Up: Data and Control Flow Dictionary + +5.3.30 nil [Constant Variable] +------------------------------ + +Constant Value:: +................ + +nil. + +Description:: +............. + +nil represents both boolean (and generalized boolean) false and the +empty list. + +Examples:: +.......... + + nil => NIL + +See Also:: +.......... + +*note t:: + + +File: gcl.info, Node: not, Next: t, Prev: nil, Up: Data and Control Flow Dictionary + +5.3.31 not [Function] +--------------------- + +'not' x => boolean + +Arguments and Values:: +...................... + +x--a generalized boolean (i.e., any object). + + boolean--a boolean. + +Description:: +............. + +Returns t if x is false; otherwise, returns nil. + +Examples:: +.......... + + (not nil) => T + (not '()) => T + (not (integerp 'sss)) => T + (not (integerp 1)) => NIL + (not 3.7) => NIL + (not 'apple) => NIL + +See Also:: +.......... + +*note null:: + +Notes:: +....... + +not is intended to be used to invert the 'truth value' of a boolean (or +generalized boolean) whereas null is intended to be used to test for the +empty list. Operationally, not and null compute the same result; which +to use is a matter of style. + + +File: gcl.info, Node: t, Next: eq, Prev: not, Up: Data and Control Flow Dictionary + +5.3.32 t [Constant Variable] +---------------------------- + +Constant Value:: +................ + +t. + +Description:: +............. + +The boolean representing true, and the canonical generalized boolean +representing true. Although any object other than nil is considered +true, t is generally used when there is no special reason to prefer one +such object over another. + + The symbol t is also sometimes used for other purposes as well. For +example, as the name of a class, as a designator (e.g., a stream +designator) or as a special symbol for some syntactic reason (e.g., in +case and typecase to label the otherwise-clause). + +Examples:: +.......... + + t => T + (eq t 't) => true + (find-class 't) => # + (case 'a (a 1) (t 2)) => 1 + (case 'b (a 1) (t 2)) => 2 + (prin1 'hello t) + |> HELLO + => HELLO + +See Also:: +.......... + +*note NIL:: + + +File: gcl.info, Node: eq, Next: eql, Prev: t, Up: Data and Control Flow Dictionary + +5.3.33 eq [Function] +-------------------- + +'eq' x y => generalized-boolean + +Arguments and Values:: +...................... + +x--an object. + + y--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if its arguments are the same, identical object; otherwise, +returns false. + +Examples:: +.......... + + (eq 'a 'b) => false + (eq 'a 'a) => true + (eq 3 3) + => true + OR=> false + (eq 3 3.0) => false + (eq 3.0 3.0) + => true + OR=> false + (eq #c(3 -4) #c(3 -4)) + => true + OR=> false + (eq #c(3 -4.0) #c(3 -4)) => false + (eq (cons 'a 'b) (cons 'a 'c)) => false + (eq (cons 'a 'b) (cons 'a 'b)) => false + (eq '(a . b) '(a . b)) + => true + OR=> false + (progn (setq x (cons 'a 'b)) (eq x x)) => true + (progn (setq x '(a . b)) (eq x x)) => true + (eq #\A #\A) + => true + OR=> false + (let ((x "Foo")) (eq x x)) => true + (eq "Foo" "Foo") + => true + OR=> false + (eq "Foo" (copy-seq "Foo")) => false + (eq "FOO" "foo") => false + (eq "string-seq" (copy-seq "string-seq")) => false + (let ((x 5)) (eq x x)) + => true + OR=> false + +See Also:: +.......... + +*note eql:: , *note equal:: , *note equalp:: , *note =:: , *note +Compilation:: + +Notes:: +....... + +Objects that appear the same when printed are not necessarily eq to each +other. Symbols that print the same usually are eq to each other because +of the use of the intern function. However, numbers with the same value +need not be eq, and two similar lists are usually not identical. + + An implementation is permitted to make "copies" of characters and +numbers at any time. The effect is that Common Lisp makes no guarantee +that eq is true even when both its arguments are "the same thing" if +that thing is a character or number. + + Most Common Lisp operators use eql rather than eq to compare objects, +or else they default to eql and only use eq if specifically requested to +do so. However, the following operators are defined to use eq rather +than eql in a way that cannot be overridden by the code which employs +them: + + catch getf throw + get remf + get-properties remprop + + Figure 5-11: Operators that always prefer EQ over EQL + + + +File: gcl.info, Node: eql, Next: equal, Prev: eq, Up: Data and Control Flow Dictionary + +5.3.34 eql [Function] +--------------------- + +'eql' x y => generalized-boolean + +Arguments and Values:: +...................... + +x--an object. + + y--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +The value of eql is true of two objects, x and y, in the folowing cases: + +1. + If x and y are eq. +2. + If x and y are both numbers of the same type and the same value. +3. + If they are both characters that represent the same character. + + Otherwise the value of eql is false. + + If an implementation supports positive and negative zeros as distinct +values, then (eql 0.0 -0.0) returns false. Otherwise, when the syntax +-0.0 is read it is interpreted as the value 0.0, and so (eql 0.0 -0.0) +returns true. + +Examples:: +.......... + + (eql 'a 'b) => false + (eql 'a 'a) => true + (eql 3 3) => true + (eql 3 3.0) => false + (eql 3.0 3.0) => true + (eql #c(3 -4) #c(3 -4)) => true + (eql #c(3 -4.0) #c(3 -4)) => false + (eql (cons 'a 'b) (cons 'a 'c)) => false + (eql (cons 'a 'b) (cons 'a 'b)) => false + (eql '(a . b) '(a . b)) + => true + OR=> false + (progn (setq x (cons 'a 'b)) (eql x x)) => true + (progn (setq x '(a . b)) (eql x x)) => true + (eql #\A #\A) => true + (eql "Foo" "Foo") + => true + OR=> false + (eql "Foo" (copy-seq "Foo")) => false + (eql "FOO" "foo") => false + + Normally (eql 1.0s0 1.0d0) is false, under the assumption that 1.0s0 +and 1.0d0 are of distinct data types. However, implementations that do +not provide four distinct floating-point formats are permitted to +"collapse" the four formats into some smaller number of them; in such an +implementation (eql 1.0s0 1.0d0) might be true. + +See Also:: +.......... + +*note eq:: , *note equal:: , *note equalp:: , *note =:: , *note char=:: + +Notes:: +....... + +eql is the same as eq, except that if the arguments are characters or +numbers of the same type then their values are compared. Thus eql tells +whether two objects are conceptually the same, whereas eq tells whether +two objects are implementationally identical. It is for this reason +that eql, not eq, is the default comparison predicate for operators that +take sequences as arguments. + + eql may not be true of two floats even when they represent the same +value. = is used to compare mathematical values. + + Two complex numbers are considered to be eql if their real parts are +eql and their imaginary parts are eql. For example, (eql #C(4 5) #C(4 +5)) is true and (eql #C(4 5) #C(4.0 5.0)) is false. Note that while +(eql #C(5.0 0.0) 5.0) is false, (eql #C(5 0) 5) is true. In the case of +(eql #C(5.0 0.0) 5.0) the two arguments are of different types, and so +cannot satisfy eql. In the case of (eql #C(5 0) 5), #C(5 0) is not a +complex number, but is automatically reduced to the integer 5. + + +File: gcl.info, Node: equal, Next: equalp, Prev: eql, Up: Data and Control Flow Dictionary + +5.3.35 equal [Function] +----------------------- + +'equal' x y => generalized-boolean + +Arguments and Values:: +...................... + +x--an object. + + y--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if x and y are structurally similar (isomorphic) objects. +Objects are treated as follows by equal. + +Symbols, Numbers, and Characters + equal is true of two objects if they are symbols that are eq, if + they are numbers that are eql, or if they are characters that are + eql. + +Conses + For conses, equal is defined recursively as the two cars being + equal and the two cdrs being equal. + +Arrays + Two arrays are equal only if they are eq, with one exception: + strings and bit vectors are compared element-by-element (using + eql). If either x or y has a fill pointer, the fill pointer limits + the number of elements examined by equal. Uppercase and lowercase + letters in strings are considered by equal to be different. + +Pathnames + Two pathnames are equal if and only if all the corresponding + components (host, device, and so on) are equivalent. Whether or + not uppercase and lowercase letters are considered equivalent in + strings appearing in components is implementation-dependent. + pathnames that are equal should be functionally equivalent. + +Other (Structures, hash-tables, instances, ...) + Two other objects are equal only if they are eq. + + equal does not descend any objects other than the ones explicitly +specified above. Figure 5-12 summarizes the information given in the +previous list. In addition, the figure specifies the priority of the +behavior of equal, with upper entries taking priority over lower ones. + + Type Behavior + number uses eql + character uses eql + cons descends + bit vector descends + string descends + pathname "functionally equivalent" + structure uses eq + Other array uses eq + hash table uses eq + Other object uses eq + + Figure 5-12: Summary and priorities of behavior of equal + + + Any two objects that are eql are also equal. + + equal may fail to terminate if x or y is circular. + +Examples:: +.......... + + (equal 'a 'b) => false + (equal 'a 'a) => true + (equal 3 3) => true + (equal 3 3.0) => false + (equal 3.0 3.0) => true + (equal #c(3 -4) #c(3 -4)) => true + (equal #c(3 -4.0) #c(3 -4)) => false + (equal (cons 'a 'b) (cons 'a 'c)) => false + (equal (cons 'a 'b) (cons 'a 'b)) => true + (equal #\A #\A) => true + (equal #\A #\a) => false + (equal "Foo" "Foo") => true + (equal "Foo" (copy-seq "Foo")) => true + (equal "FOO" "foo") => false + (equal "This-string" "This-string") => true + (equal "This-string" "this-string") => false + +See Also:: +.......... + +*note eq:: , *note eql:: , *note equalp:: , *note =:: , *note string=:: +, string-equal, *note char=:: , char-equal, *note tree-equal:: + +Notes:: +....... + +Object equality is not a concept for which there is a uniquely +determined correct algorithm. The appropriateness of an equality +predicate can be judged only in the context of the needs of some +particular program. Although these functions take any type of argument +and their names sound very generic, equal and equalp are not appropriate +for every application. + + A rough rule of thumb is that two objects are equal if and only if +their printed representations are the same. + + +File: gcl.info, Node: equalp, Next: identity, Prev: equal, Up: Data and Control Flow Dictionary + +5.3.36 equalp [Function] +------------------------ + +'equalp' x y => generalized-boolean + +Arguments and Values:: +...................... + +x--an object. + + y--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if x and y are equal, or if they have components that are +of the same type as each other and if those components are equalp; +specifically, equalp returns true in the following cases: + +Characters + If two characters are char-equal. + +Numbers + If two numbers are the same under =. + +Conses + If the two cars in the conses are equalp and the two cdrs in the + conses are equalp. + +Arrays + If two arrays have the same number of dimensions, the dimensions + match, and the corresponding active elements are equalp. The types + for which the arrays are specialized need not match; for example, a + string and a general array that happens to contain the same + characters are equalp. Because equalp performs element-by-element + comparisons of strings and ignores the case of characters, case + distinctions are ignored when equalp compares strings. + +Structures + If two structures S_1 and S_2 have the same class and the value of + each slot in S_1 is the same under equalp as the value of the + corresponding slot in S_2. + +Hash Tables + equalp descends hash-tables by first comparing the count of entries + and the :test function; if those are the same, it compares the keys + of the tables using the :test function and then the values of the + matching keys using equalp recursively. + + equalp does not descend any objects other than the ones explicitly +specified above. Figure 5-13 summarizes the information given in the +previous list. In addition, the figure specifies the priority of the +behavior of equalp, with upper entries taking priority over lower ones. + + Type Behavior + number uses = + character uses char-equal + cons descends + bit vector descends + string descends + pathname same as equal + structure descends, as described above + Other array descends + hash table descends, as described above + Other object uses eq + + Figure 5-13: Summary and priorities of behavior of equalp + + +Examples:: +.......... + + (equalp 'a 'b) => false + (equalp 'a 'a) => true + (equalp 3 3) => true + (equalp 3 3.0) => true + (equalp 3.0 3.0) => true + (equalp #c(3 -4) #c(3 -4)) => true + (equalp #c(3 -4.0) #c(3 -4)) => true + (equalp (cons 'a 'b) (cons 'a 'c)) => false + (equalp (cons 'a 'b) (cons 'a 'b)) => true + (equalp #\A #\A) => true + (equalp #\A #\a) => true + (equalp "Foo" "Foo") => true + (equalp "Foo" (copy-seq "Foo")) => true + (equalp "FOO" "foo") => true + + (setq array1 (make-array 6 :element-type 'integer + :initial-contents '(1 1 1 3 5 7))) + => #(1 1 1 3 5 7) + (setq array2 (make-array 8 :element-type 'integer + :initial-contents '(1 1 1 3 5 7 2 6) + :fill-pointer 6)) + => #(1 1 1 3 5 7) + (equalp array1 array2) => true + (setq vector1 (vector 1 1 1 3 5 7)) => #(1 1 1 3 5 7) + (equalp array1 vector1) => true + +See Also:: +.......... + +*note eq:: , *note eql:: , *note equal:: , *note =:: , *note string=:: , +string-equal, *note char=:: , char-equal + +Notes:: +....... + +Object equality is not a concept for which there is a uniquely +determined correct algorithm. The appropriateness of an equality +predicate can be judged only in the context of the needs of some +particular program. Although these functions take any type of argument +and their names sound very generic, equal and equalp are not appropriate +for every application. + + +File: gcl.info, Node: identity, Next: complement, Prev: equalp, Up: Data and Control Flow Dictionary + +5.3.37 identity [Function] +-------------------------- + +'identity' object => object + +Arguments and Values:: +...................... + +object--an object. + +Description:: +............. + +Returns its argument object. + +Examples:: +.......... + + (identity 101) => 101 + (mapcan #'identity (list (list 1 2 3) '(4 5 6))) => (1 2 3 4 5 6) + +Notes:: +....... + +identity is intended for use with functions that require a function as +an argument. + + (eql x (identity x)) returns true for all possible values of x, but +(eq x (identity x)) might return false when x is a number or character. + + identity could be defined by + + (defun identity (x) x) + + +File: gcl.info, Node: complement, Next: constantly, Prev: identity, Up: Data and Control Flow Dictionary + +5.3.38 complement [Function] +---------------------------- + +'complement' function => complement-function + +Arguments and Values:: +...................... + +function--a function. + + complement-function--a function. + +Description:: +............. + +Returns a function that takes the same arguments as function, and has +the same side-effect behavior as function, but returns only a single +value: a generalized boolean with the opposite truth value of that which +would be returned as the primary value of function. That is, when the +function would have returned true as its primary value the +complement-function returns false, and when the function would have +returned false as its primary value the complement-function returns +true. + +Examples:: +.......... + + (funcall (complement #'zerop) 1) => true + (funcall (complement #'characterp) #\A) => false + (funcall (complement #'member) 'a '(a b c)) => false + (funcall (complement #'member) 'd '(a b c)) => true + +See Also:: +.......... + +*note not:: + +Notes:: +....... + + (complement x) == #'(lambda (&rest arguments) (not (apply x arguments))) + + In Common Lisp, functions with names like "xxx-if-not" are related to +functions with names like "xxx-if" in that + + (xxx-if-not f . arguments) == (xxx-if (complement f) . arguments) + + For example, + + (find-if-not #'zerop '(0 0 3)) == + (find-if (complement #'zerop) '(0 0 3)) => 3 + + Note that since the "xxx-if-not" functions and the :test-not +arguments have been deprecated, uses of "xxx-if" functions or :test +arguments with complement are preferred. + + +File: gcl.info, Node: constantly, Next: every, Prev: complement, Up: Data and Control Flow Dictionary + +5.3.39 constantly [Function] +---------------------------- + +'constantly' value => function + +Arguments and Values:: +...................... + +value--an object. + + function--a function. + +Description:: +............. + +constantly returns a function that accepts any number of arguments, that +has no side-effects, and that always returns value. + +Examples:: +.......... + + (mapcar (constantly 3) '(a b c d)) => (3 3 3 3) + (defmacro with-vars (vars &body forms) + `((lambda ,vars ,@forms) ,@(mapcar (constantly nil) vars))) + => WITH-VARS + (macroexpand '(with-vars (a b) (setq a 3 b (* a a)) (list a b))) + => ((LAMBDA (A B) (SETQ A 3 B (* A A)) (LIST A B)) NIL NIL), true + +See Also:: +.......... + +*note not:: + +Notes:: +....... + +constantly could be defined by: + + (defun constantly (object) + #'(lambda (&rest arguments) object)) + + +File: gcl.info, Node: every, Next: and, Prev: constantly, Up: Data and Control Flow Dictionary + +5.3.40 every, some, notevery, notany [Function] +----------------------------------------------- + +'every' predicate &rest sequences^+ => generalized-boolean + + 'some' predicate &rest sequences^+ => result + + 'notevery' predicate &rest sequences^+ => generalized-boolean + + 'notany' predicate &rest sequences^+ => generalized-boolean + +Arguments and Values:: +...................... + +predicate--a designator for a function of as many arguments as there are +sequences. + + sequence--a sequence. + + result--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +every, some, notevery, and notany test elements of sequences for +satisfaction of a given predicate. The first argument to predicate is +an element of the first sequence; each succeeding argument is an element +of a succeeding sequence. + + Predicate is first applied to the elements with index 0 in each of +the sequences, and possibly then to the elements with index 1, and so +on, until a termination criterion is met or the end of the shortest of +the sequences is reached. + + every returns false as soon as any invocation of predicate returns +false. If the end of a sequence is reached, every returns true. Thus, +every returns true if and only if every invocation of predicate returns +true. + + some returns the first non-nil value which is returned by an +invocation of predicate. If the end of a sequence is reached without +any invocation of the predicate returning true, some returns false. +Thus, some returns true if and only if some invocation of predicate +returns true. + + notany returns false as soon as any invocation of predicate returns +true. If the end of a sequence is reached, notany returns true. Thus, +notany returns true if and only if it is not the case that any +invocation of predicate returns true. + + notevery returns true as soon as any invocation of predicate returns +false. If the end of a sequence is reached, notevery returns false. +Thus, notevery returns true if and only if it is not the case that every +invocation of predicate returns true. + +Examples:: +.......... + + (every #'characterp "abc") => true + (some #'= '(1 2 3 4 5) '(5 4 3 2 1)) => true + (notevery #'< '(1 2 3 4) '(5 6 7 8) '(9 10 11 12)) => false + (notany #'> '(1 2 3 4) '(5 6 7 8) '(9 10 11 12)) => true + +Exceptional Situations:: +........................ + +Should signal type-error if its first argument is neither a symbol nor a +function or if any subsequent argument is not a proper sequence. + + Other exceptional situations are possible, depending on the nature of +the predicate. + +See Also:: +.......... + +*note and:: , *note or:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + + (notany predicate {sequence}*) == (not (some predicate {sequence}*)) + (notevery predicate {sequence}*) == (not (every predicate {sequence}*)) + + +File: gcl.info, Node: and, Next: cond, Prev: every, Up: Data and Control Flow Dictionary + +5.3.41 and [Macro] +------------------ + +'and' {form}* => {result}* + +Arguments and Values:: +...................... + +form--a form. + + results--the values resulting from the evaluation of the last form, +or the symbols nil or t. + +Description:: +............. + +The macro and evaluates each form one at a time from left to right. As +soon as any form evaluates to nil, and returns nil without evaluating +the remaining forms. If all forms but the last evaluate to true values, +and returns the results produced by evaluating the last form. + + If no forms are supplied, (and) returns t. + + and passes back multiple values from the last subform but not from +subforms other than the last. + +Examples:: +.......... + + (if (and (>= n 0) + (< n (length a-simple-vector)) + (eq (elt a-simple-vector n) 'foo)) + (princ "Foo!")) + + The above expression prints Foo! if element n of a-simple-vector is +the symbol foo, provided also that n is indeed a valid index for +a-simple-vector. Because and guarantees left-to-right testing of its +parts, elt is not called if n is out of range. + + (setq temp1 1 temp2 1 temp3 1) => 1 + (and (incf temp1) (incf temp2) (incf temp3)) => 2 + (and (eql 2 temp1) (eql 2 temp2) (eql 2 temp3)) => true + (decf temp3) => 1 + (and (decf temp1) (decf temp2) (eq temp3 'nil) (decf temp3)) => NIL + (and (eql temp1 temp2) (eql temp2 temp3)) => true + (and) => T + +See Also:: +.......... + +*note cond:: , *note every:: , *note if:: , *note or:: , *note when:: + +Notes:: +....... + + (and form) == (let () form) + (and form1 form2 ...) == (when form1 (and form2 ...)) + + +File: gcl.info, Node: cond, Next: if, Prev: and, Up: Data and Control Flow Dictionary + +5.3.42 cond [Macro] +------------------- + +'cond' {!clause}* => {result}* + + clause ::=(test-form {form}*) + +Arguments and Values:: +...................... + +test-form--a form. + + forms--an implicit progn. + + results--the values of the forms in the first clause whose test-form +yields true, or the primary value of the test-form if there are no forms +in that clause, or else nil if no test-form yields true. + +Description:: +............. + +cond allows the execution of forms to be dependent on test-form. + + Test-forms are evaluated one at a time in the order in which they are +given in the argument list until a test-form is found that evaluates to +true. + + If there are no forms in that clause, the primary value of the +test-form is returned by the cond form. Otherwise, the forms associated +with this test-form are evaluated in order, left to right, as an +implicit progn, and the values returned by the last form are returned by +the cond form. + + Once one test-form has yielded true, no additional test-forms are +evaluated. If no test-form yields true, nil is returned. + +Examples:: +.......... + + (defun select-options () + (cond ((= a 1) (setq a 2)) + ((= a 2) (setq a 3)) + ((and (= a 3) (floor a 2))) + (t (floor a 3)))) => SELECT-OPTIONS + (setq a 1) => 1 + (select-options) => 2 + a => 2 + (select-options) => 3 + a => 3 + (select-options) => 1 + (setq a 5) => 5 + (select-options) => 1, 2 + +See Also:: +.......... + +*note if:: , *note case:: . + + +File: gcl.info, Node: if, Next: or, Prev: cond, Up: Data and Control Flow Dictionary + +5.3.43 if [Special Operator] +---------------------------- + +'if' test-form then-form [else-form] => {result}* + +Arguments and Values:: +...................... + +Test-form--a form. + + Then-form--a form. + + Else-form--a form. The default is nil. + + results--if the test-form yielded true, the values returned by the +then-form; otherwise, the values returned by the else-form. + +Description:: +............. + +if allows the execution of a form to be dependent on a single test-form. + + First test-form is evaluated. If the result is true, then then-form +is selected; otherwise else-form is selected. Whichever form is +selected is then evaluated. + +Examples:: +.......... + + (if t 1) => 1 + (if nil 1 2) => 2 + (defun test () + (dolist (truth-value '(t nil 1 (a b c))) + (if truth-value (print 'true) (print 'false)) + (prin1 truth-value))) => TEST + (test) + |> TRUE T + |> FALSE NIL + |> TRUE 1 + |> TRUE (A B C) + => NIL + +See Also:: +.......... + +*note cond:: , unless, *note when:: + +Notes:: +....... + + (if test-form then-form else-form) + == (cond (test-form then-form) (t else-form)) + + +File: gcl.info, Node: or, Next: when, Prev: if, Up: Data and Control Flow Dictionary + +5.3.44 or [Macro] +----------------- + +'or' {form}* => {results}* + +Arguments and Values:: +...................... + +form--a form. + + results--the values or primary value (see below) resulting from the +evaluation of the last form executed or nil. + +Description:: +............. + +or evaluates each form, one at a time, from left to right. The +evaluation of all forms terminates when a form evaluates to true (i.e., +something other than nil). + + If the evaluation of any form other than the last returns a primary +value that is true, or immediately returns that value (but no additional +values) without evaluating the remaining forms. If every form but the +last returns false as its primary value, or returns all values returned +by the last form. If no forms are supplied, or returns nil. + +Examples:: +.......... + + (or) => NIL + (setq temp0 nil temp1 10 temp2 20 temp3 30) => 30 + (or temp0 temp1 (setq temp2 37)) => 10 + temp2 => 20 + (or (incf temp1) (incf temp2) (incf temp3)) => 11 + temp1 => 11 + temp2 => 20 + temp3 => 30 + (or (values) temp1) => 11 + (or (values temp1 temp2) temp3) => 11 + (or temp0 (values temp1 temp2)) => 11, 20 + (or (values temp0 temp1) (values temp2 temp3)) => 20, 30 + +See Also:: +.......... + +*note and:: , some, unless + + +File: gcl.info, Node: when, Next: case, Prev: or, Up: Data and Control Flow Dictionary + +5.3.45 when, unless [Macro] +--------------------------- + +'when' test-form {form}* => {result}* + + 'unless' test-form {form}* => {result}* + +Arguments and Values:: +...................... + +test-form--a form. + + forms--an implicit progn. + + results--the values of the forms in a when form if the test-form +yields true or in an unless form if the test-form yields false; +otherwise nil. + +Description:: +............. + +when and unless allow the execution of forms to be dependent on a single +test-form. + + In a when form, if the test-form yields true, the forms are evaluated +in order from left to right and the values returned by the forms are +returned from the when form. Otherwise, if the test-form yields false, +the forms are not evaluated, and the when form returns nil. + + In an unless form, if the test-form yields false, the forms are +evaluated in order from left to right and the values returned by the +forms are returned from the unless form. Otherwise, if the test-form +yields false, the forms are not evaluated, and the unless form returns +nil. + +Examples:: +.......... + + (when t 'hello) => HELLO + (unless t 'hello) => NIL + (when nil 'hello) => NIL + (unless nil 'hello) => HELLO + (when t) => NIL + (unless nil) => NIL + (when t (prin1 1) (prin1 2) (prin1 3)) + |> 123 + => 3 + (unless t (prin1 1) (prin1 2) (prin1 3)) => NIL + (when nil (prin1 1) (prin1 2) (prin1 3)) => NIL + (unless nil (prin1 1) (prin1 2) (prin1 3)) + |> 123 + => 3 + (let ((x 3)) + (list (when (oddp x) (incf x) (list x)) + (when (oddp x) (incf x) (list x)) + (unless (oddp x) (incf x) (list x)) + (unless (oddp x) (incf x) (list x)) + (if (oddp x) (incf x) (list x)) + (if (oddp x) (incf x) (list x)) + (if (not (oddp x)) (incf x) (list x)) + (if (not (oddp x)) (incf x) (list x)))) + => ((4) NIL (5) NIL 6 (6) 7 (7)) + +See Also:: +.......... + +*note and:: , *note cond:: , *note if:: , *note or:: + +Notes:: +....... + + (when test {form}^+) == (and test (progn {form}^+)) + (when test {form}^+) == (cond (test {form}^+)) + (when test {form}^+) == (if test (progn {form}^+) nil) + (when test {form}^+) == (unless (not test) {form}^+) + (unless test {form}^+) == (cond ((not test) {form}^+)) + (unless test {form}^+) == (if test nil (progn {form}^+)) + (unless test {form}^+) == (when (not test) {form}^+) + + +File: gcl.info, Node: case, Next: typecase, Prev: when, Up: Data and Control Flow Dictionary + +5.3.46 case, ccase, ecase [Macro] +--------------------------------- + +'case' keyform {!normal-clause}* [!otherwise-clause] => {result}* + + 'ccase' keyplace {!normal-clause}* => {result}* + + 'ecase' keyform {!normal-clause}* => {result}* + + normal-clause ::=(keys {form}*) + + otherwise-clause ::=({otherwise | t} {form}*) + + clause ::=normal-clause | otherwise-clause + +Arguments and Values:: +...................... + +keyform--a form; evaluated to produce a test-key. + + keyplace--a form; evaluated initially to produce a test-key. +Possibly also used later as a place if no keys match. + + test-key--an object produced by evaluating keyform or keyplace. + + keys--a designator for a list of objects. In the case of case, the +symbols t and otherwise may not be used as the keys designator. To +refer to these symbols by themselves as keys, the designators (t) and +(otherwise), respectively, must be used instead. + + forms--an implicit progn. + + results--the values returned by the forms in the matching clause. + +Description:: +............. + +These macros allow the conditional execution of a body of forms in a +clause that is selected by matching the test-key on the basis of its +identity. + + The keyform or keyplace is evaluated to produce the test-key. + + Each of the normal-clauses is then considered in turn. If the +test-key is the same as any key for that clause, the forms in that +clause are evaluated as an implicit progn, and the values it returns are +returned as the value of the case, ccase, or ecase form. + + These macros differ only in their behavior when no normal-clause +matches; specifically: + +case + If no normal-clause matches, and there is an otherwise-clause, then + that otherwise-clause automatically matches; the forms in that + clause are evaluated as an implicit progn, and the values it + returns are returned as the value of the case. + + If there is no otherwise-clause, case returns nil. + +ccase + If no normal-clause matches, a correctable error of type type-error + is signaled. The offending datum is the test-key and the expected + type is type equivalent to (member key1 key2 ...). The store-value + restart can be used to correct the error. + + If the store-value restart is invoked, its argument becomes the new + test-key, and is stored in keyplace as if by (setf keyplace + test-key). Then ccase starts over, considering each clause anew. + + [Reviewer Note by Barmar: Will it prompt for multiple values if + keyplace is a VALUES general ref?] + + The subforms of keyplace might be evaluated again if none of the + cases holds. + +ecase + If no normal-clause matches, a non-correctable error of type + type-error is signaled. The offending datum is the test-key and + the expected type is type equivalent to (member key1 key2 ...). + + Note that in contrast with ccase, the caller of ecase may rely on + the fact that ecase does not return if a normal-clause does not + match. + +Examples:: +.......... + + (dolist (k '(1 2 3 :four #\v () t 'other)) + (format t "~S " + (case k ((1 2) 'clause1) + (3 'clause2) + (nil 'no-keys-so-never-seen) + ((nil) 'nilslot) + ((:four #\v) 'clause4) + ((t) 'tslot) + (otherwise 'others)))) + |> CLAUSE1 CLAUSE1 CLAUSE2 CLAUSE4 CLAUSE4 NILSLOT TSLOT OTHERS + => NIL + (defun add-em (x) (apply #'+ (mapcar #'decode x))) + => ADD-EM + (defun decode (x) + (ccase x + ((i uno) 1) + ((ii dos) 2) + ((iii tres) 3) + ((iv cuatro) 4))) + => DECODE + (add-em '(uno iii)) => 4 + (add-em '(uno iiii)) + |> Error: The value of X, IIII, is not I, UNO, II, DOS, III, + |> TRES, IV, or CUATRO. + |> 1: Supply a value to use instead. + |> 2: Return to Lisp Toplevel. + |> Debug> |>>:CONTINUE 1<<| + |> Value to evaluate and use for X: |>>'IV<<| + => 5 + +Side Effects:: +.............. + +The debugger might be entered. If the store-value restart is invoked, +the value of keyplace might be changed. + +Affected By:: +............. + +ccase and ecase, since they might signal an error, are potentially +affected by existing handlers and *debug-io*. + +Exceptional Situations:: +........................ + +ccase and ecase signal an error of type type-error if no normal-clause +matches. + +See Also:: +.......... + +*note cond:: , *note typecase:: , *note setf:: , *note Generalized +Reference:: + +Notes:: +....... + + (case test-key + {(({key}*) {form}*)}*) + == + (let ((#1=#:g0001 test-key)) + (cond {((member #1# '({key}*)) {form}*)}*)) + + The specific error message used by ecase and ccase can vary between +implementations. In situations where control of the specific wording of +the error message is important, it is better to use case with an +otherwise-clause that explicitly signals an error with an appropriate +message. + + +File: gcl.info, Node: typecase, Next: multiple-value-bind, Prev: case, Up: Data and Control Flow Dictionary + +5.3.47 typecase, ctypecase, etypecase [Macro] +--------------------------------------------- + +'typecase' keyform {!normal-clause}* [!otherwise-clause] => {result}* + + 'ctypecase' keyplace {!normal-clause}* => {result}* + + 'etypecase' keyform {!normal-clause}* => {result}* + + normal-clause ::=(type {form}*) + + otherwise-clause ::=({otherwise | t} {form}*) + + clause ::=normal-clause | otherwise-clause + +Arguments and Values:: +...................... + +keyform--a form; evaluated to produce a test-key. + + keyplace--a form; evaluated initially to produce a test-key. +Possibly also used later as a place if no types match. + + test-key--an object produced by evaluating keyform or keyplace. + + type--a type specifier. + + forms--an implicit progn. + + results--the values returned by the forms in the matching clause. + +Description:: +............. + +These macros allow the conditional execution of a body of forms in a +clause that is selected by matching the test-key on the basis of its +type. + + The keyform or keyplace is evaluated to produce the test-key. + + Each of the normal-clauses is then considered in turn. If the +test-key is of the type given by the clauses's type, the forms in that +clause are evaluated as an implicit progn, and the values it returns are +returned as the value of the typecase, ctypecase, or etypecase form. + + These macros differ only in their behavior when no normal-clause +matches; specifically: + +typecase + If no normal-clause matches, and there is an otherwise-clause, then + that otherwise-clause automatically matches; the forms in that + clause are evaluated as an implicit progn, and the values it + returns are returned as the value of the typecase. + + If there is no otherwise-clause, typecase returns nil. + +ctypecase + If no normal-clause matches, a correctable error of type type-error + is signaled. The offending datum is the test-key and the expected + type is type equivalent to (or type1 type2 ...). The store-value + restart can be used to correct the error. + + If the store-value restart is invoked, its argument becomes the new + test-key, and is stored in keyplace as if by (setf keyplace + test-key). Then ctypecase starts over, considering each clause + anew. + + If the store-value restart is invoked interactively, the user is + prompted for a new test-key to use. + + The subforms of keyplace might be evaluated again if none of the + cases holds. + +etypecase + If no normal-clause matches, a non-correctable error of type + type-error is signaled. The offending datum is the test-key and + the expected type is type equivalent to (or type1 type2 ...). + + Note that in contrast with ctypecase, the caller of etypecase may + rely on the fact that etypecase does not return if a normal-clause + does not match. + + In all three cases, is permissible for more than one clause to +specify a matching type, particularly if one is a subtype of another; +the earliest applicable clause is chosen. + +Examples:: +.......... + + ;;; (Note that the parts of this example which use TYPE-OF + ;;; are implementation-dependent.) + (defun what-is-it (x) + (format t "~&~S is ~A.~ + x (typecase x + (float "a float") + (null "a symbol, boolean false, or the empty list") + (list "a list") + (t (format nil "a(n) ~(~A~)" (type-of x)))))) + => WHAT-IS-IT + (map 'nil #'what-is-it '(nil (a b) 7.0 7 box)) + |> NIL is a symbol, boolean false, or the empty list. + |> (A B) is a list. + |> 7.0 is a float. + |> 7 is a(n) integer. + |> BOX is a(n) symbol. + => NIL + (setq x 1/3) + => 1/3 + (ctypecase x + (integer (* x 4)) + (symbol (symbol-value x))) + |> Error: The value of X, 1/3, is neither an integer nor a symbol. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a value to use instead. + |> 2: Return to Lisp Toplevel. + |> Debug> |>>:CONTINUE 1<<| + |> Use value: |>>3.7<<| + |> Error: The value of X, 3.7, is neither an integer nor a symbol. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a value to use instead. + |> 2: Return to Lisp Toplevel. + |> Debug> |>>:CONTINUE 1<<| + |> Use value: |>>12<<| + => 48 + x => 12 + +Affected By:: +............. + +ctypecase and etypecase, since they might signal an error, are +potentially affected by existing handlers and *debug-io*. + +Exceptional Situations:: +........................ + +ctypecase and etypecase signal an error of type type-error if no +normal-clause matches. + + The compiler may choose to issue a warning of type style-warning if a +clause will never be selected because it is completely shadowed by +earlier clauses. + +See Also:: +.......... + +*note case:: , *note cond:: , *note setf:: , *note Generalized +Reference:: + +Notes:: +....... + + (typecase test-key + {(type {form}*)}*) + == + (let ((#1=#:g0001 test-key)) + (cond {((typep #1# 'type) {form}*)}*)) + + The specific error message used by etypecase and ctypecase can vary +between implementations. In situations where control of the specific +wording of the error message is important, it is better to use typecase +with an otherwise-clause that explicitly signals an error with an +appropriate message. + + +File: gcl.info, Node: multiple-value-bind, Next: multiple-value-call, Prev: typecase, Up: Data and Control Flow Dictionary + +5.3.48 multiple-value-bind [Macro] +---------------------------------- + +'multiple-value-bind' ({var}*) values-form {declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +var--a symbol naming a variable; not evaluated. + + values-form--a form; evaluated. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +Creates new variable bindings for the vars and executes a series of +forms that use these bindings. + + The variable bindings created are lexical unless special declarations +are specified. + + Values-form is evaluated, and each of the vars is bound to the +respective value returned by that form. If there are more vars than +values returned, extra values of nil are given to the remaining vars. +If there are more values than vars, the excess values are discarded. +The vars are bound to the values over the execution of the forms, which +make up an implicit progn. The consequences are unspecified if a type +declaration is specified for a var, but the value to which that var is +bound is not consistent with the type declaration. + + The scopes of the name binding and declarations do not include the +values-form. + +Examples:: +.......... + + (multiple-value-bind (f r) + (floor 130 11) + (list f r)) => (11 9) + +See Also:: +.......... + +*note let:: , *note multiple-value-call:: + +Notes:: +....... + + (multiple-value-bind ({var}*) values-form {form}*) + == (multiple-value-call #'(lambda (&optional {var}* &rest #1=#:ignore) + (declare (ignore #1#)) + {form}*) + values-form) + + +File: gcl.info, Node: multiple-value-call, Next: multiple-value-list, Prev: multiple-value-bind, Up: Data and Control Flow Dictionary + +5.3.49 multiple-value-call [Special Operator] +--------------------------------------------- + +'multiple-value-call' function-form form* => {result}* + +Arguments and Values:: +...................... + +function-form--a form; evaluated to produce function. + + function--a function designator resulting from the evaluation of +function-form. + + form--a form. + + results--the values returned by the function. + +Description:: +............. + +Applies function to a list of the objects collected from groups of +multiple values_2. + + multiple-value-call first evaluates the function-form to obtain +function, and then evaluates each form. All the values of each form are +gathered together (not just one value from each) and given as arguments +to the function. + +Examples:: +.......... + + (multiple-value-call #'list 1 '/ (values 2 3) '/ (values) '/ (floor 2.5)) + => (1 / 2 3 / / 2 0.5) + (+ (floor 5 3) (floor 19 4)) == (+ 1 4) + => 5 + (multiple-value-call #'+ (floor 5 3) (floor 19 4)) == (+ 1 2 4 3) + => 10 + +See Also:: +.......... + +*note multiple-value-list:: , *note multiple-value-bind:: + + +File: gcl.info, Node: multiple-value-list, Next: multiple-value-prog1, Prev: multiple-value-call, Up: Data and Control Flow Dictionary + +5.3.50 multiple-value-list [Macro] +---------------------------------- + +'multiple-value-list' form => list + +Arguments and Values:: +...................... + +form--a form; evaluated as described below. + + list--a list of the values returned by form. + +Description:: +............. + +multiple-value-list evaluates form and creates a list of the multiple +values_2 it returns. + +Examples:: +.......... + + (multiple-value-list (floor -3 4)) => (-1 1) + +See Also:: +.......... + +*note values-list:: , *note multiple-value-call:: + +Notes:: +....... + +multiple-value-list and values-list are inverses of each other. + + (multiple-value-list form) == (multiple-value-call #'list form) + + +File: gcl.info, Node: multiple-value-prog1, Next: multiple-value-setq, Prev: multiple-value-list, Up: Data and Control Flow Dictionary + +5.3.51 multiple-value-prog1 [Special Operator] +---------------------------------------------- + +'multiple-value-prog' 1 => first-form {form}* + + first-form-results + +Arguments and Values:: +...................... + +first-form--a form; evaluated as described below. + + form--a form; evaluated as described below. + + first-form-results--the values resulting from the evaluation of +first-form. + +Description:: +............. + +multiple-value-prog1 evaluates first-form and saves all the values +produced by that form. It then evaluates each form from left to right, +discarding their values. + +Examples:: +.......... + + (setq temp '(1 2 3)) => (1 2 3) + (multiple-value-prog1 + (values-list temp) + (setq temp nil) + (values-list temp)) => 1, 2, 3 + +See Also:: +.......... + +*note prog1:: + + +File: gcl.info, Node: multiple-value-setq, Next: values, Prev: multiple-value-prog1, Up: Data and Control Flow Dictionary + +5.3.52 multiple-value-setq [Macro] +---------------------------------- + +'multiple-value-setq' vars form => result + +Arguments and Values:: +...................... + +vars--a list of symbols that are either variable names or names of +symbol macros. + + form--a form. + + result--The primary value returned by the form. + +Description:: +............. + +multiple-value-setq assigns values to vars. + + The form is evaluated, and each var is assigned to the corresponding +value returned by that form. If there are more vars than values +returned, nil is assigned to the extra vars. If there are more values +than vars, the extra values are discarded. + + If any var is the name of a symbol macro, then it is assigned as if +by setf. Specifically, + + (multiple-value-setq (symbol_1 ... symbol_n) value-producing-form) + + is defined to always behave in the same way as + + (values (setf (values symbol_1 ... symbol_n) value-producing-form)) + + in order that the rules for order of evaluation and side-effects be +consistent with those used by setf. + + See *note VALUES Forms as Places::. + +Examples:: +.......... + + (multiple-value-setq (quotient remainder) (truncate 3.2 2)) => 1 + quotient => 1 + remainder => 1.2 + (multiple-value-setq (a b c) (values 1 2)) => 1 + a => 1 + b => 2 + c => NIL + (multiple-value-setq (a b) (values 4 5 6)) => 4 + a => 4 + b => 5 + +See Also:: +.......... + +*note setq:: , *note symbol-macrolet:: + + +File: gcl.info, Node: values, Next: values-list, Prev: multiple-value-setq, Up: Data and Control Flow Dictionary + +5.3.53 values [Accessor] +------------------------ + +'values' &rest object => {object}* + + (setf (' values' &rest place) new-values) + +Arguments and Values:: +...................... + +object--an object. + + place--a place. + + new-value--an object. + +Description:: +............. + +values returns the objects as multiple values_2. + + setf of values is used to store the multiple values_2 new-values into +the places. See *note VALUES Forms as Places::. + +Examples:: +.......... + + (values) => + (values 1) => 1 + (values 1 2) => 1, 2 + (values 1 2 3) => 1, 2, 3 + (values (values 1 2 3) 4 5) => 1, 4, 5 + (defun polar (x y) + (values (sqrt (+ (* x x) (* y y))) (atan y x))) => POLAR + (multiple-value-bind (r theta) (polar 3.0 4.0) + (vector r theta)) + => #(5.0 0.927295) + + Sometimes it is desirable to indicate explicitly that a function +returns exactly one value. For example, the function + + (defun foo (x y) + (floor (+ x y) y)) => FOO + + returns two values because floor returns two values. It may be that +the second value makes no sense, or that for efficiency reasons it is +desired not to compute the second value. values is the standard idiom +for indicating that only one value is to be returned: + + (defun foo (x y) + (values (floor (+ x y) y))) => FOO + + This works because values returns exactly one value for each of args; +as for any function call, if any of args produces more than one value, +all but the first are discarded. + +See Also:: +.......... + +*note values-list:: , *note multiple-value-bind:: , *note +multiple-values-limit:: , *note Evaluation:: + +Notes:: +....... + +Since values is a function, not a macro or special form, it receives as +arguments only the primary values of its argument forms. + + +File: gcl.info, Node: values-list, Next: multiple-values-limit, Prev: values, Up: Data and Control Flow Dictionary + +5.3.54 values-list [Function] +----------------------------- + +'values-list' list => {element}* + +Arguments and Values:: +...................... + +list--a list. + + elements--the elements of the list. + +Description:: +............. + +Returns the elements of the list as multiple values_2. + +Examples:: +.......... + + (values-list nil) => + (values-list '(1)) => 1 + (values-list '(1 2)) => 1, 2 + (values-list '(1 2 3)) => 1, 2, 3 + +Exceptional Situations:: +........................ + +Should signal type-error if its argument is not a proper list. + +See Also:: +.......... + +*note multiple-value-bind:: , *note multiple-value-list:: , *note +multiple-values-limit:: , *note values:: + +Notes:: +....... + + (values-list list) == (apply #'values list) + + (equal x (multiple-value-list (values-list x))) returns true for all +lists x. + + +File: gcl.info, Node: multiple-values-limit, Next: nth-value, Prev: values-list, Up: Data and Control Flow Dictionary + +5.3.55 multiple-values-limit [Constant Variable] +------------------------------------------------ + +Constant Value:: +................ + +An integer not smaller than 20, the exact magnitude of which is +implementation-dependent. + +Description:: +............. + +The upper exclusive bound on the number of values that may be returned +from a function, + + bound or assigned by multiple-value-bind or multiple-value-setq, or +passed as a first argument to nth-value. (If these individual limits +might differ, the minimum value is used.) + +See Also:: +.......... + +*note lambda-parameters-limit:: , *note call-arguments-limit:: + +Notes:: +....... + +Implementors are encouraged to make this limit as large as possible. + + +File: gcl.info, Node: nth-value, Next: prog, Prev: multiple-values-limit, Up: Data and Control Flow Dictionary + +5.3.56 nth-value [Macro] +------------------------ + +'nth-value' n form => object + +Arguments and Values:: +...................... + +n--a non-negative integer; evaluated. + + form--a form; evaluated as described below. + + object--an object. + +Description:: +............. + +Evaluates n and then form, returning as its only value the nth value +yielded by form, or nil if n is greater than or equal to the number of +values returned by form. (The first returned value is numbered 0.) + +Examples:: +.......... + + (nth-value 0 (values 'a 'b)) => A + (nth-value 1 (values 'a 'b)) => B + (nth-value 2 (values 'a 'b)) => NIL + (let* ((x 83927472397238947423879243432432432) + (y 32423489732) + (a (nth-value 1 (floor x y))) + (b (mod x y))) + (values a b (= a b))) + => 3332987528, 3332987528, true + +See Also:: +.......... + +*note multiple-value-list:: , *note nth:: + +Notes:: +....... + +Operationally, the following relationship is true, although nth-value +might be more efficient in some implementations because, for example, +some consing might be avoided. + + (nth-value n form) == (nth n (multiple-value-list form)) + + +File: gcl.info, Node: prog, Next: prog1, Prev: nth-value, Up: Data and Control Flow Dictionary + +5.3.57 prog, prog* [Macro] +-------------------------- + +'prog' ({var | (var [init-form])}*) {declaration}* {tag | statement}* +=> {result}* + + 'prog*' ({var | (var [init-form])}*) {declaration}* {tag | +statement}* +=> {result}* + +Arguments and Values:: +...................... + +var--variable name. + + init-form--a form. + + declaration--a declare expression; not evaluated. + + tag--a go tag; not evaluated. + + statement--a compound form; evaluated as described below. + + results--nil if a normal return occurs, or else, if an explicit +return occurs, the values that were transferred. + +Description:: +............. + +Three distinct operations are performed by prog and prog*: they bind +local variables, they permit use of the return statement, and they +permit use of the go statement. A typical prog looks like this: + + (prog (var1 var2 (var3 init-form-3) var4 (var5 init-form-5)) + {declaration}* + statement1 + tag1 + statement2 + statement3 + statement4 + tag2 + statement5 + ... + ) + + For prog, init-forms are evaluated first, in the order in which they +are supplied. The vars are then bound to the corresponding values in +parallel. If no init-form is supplied for a given var, that var is +bound to nil. + + The body of prog is executed as if it were a tagbody form; the go +statement can be used to transfer control to a tag. Tags label +statements. + + prog implicitly establishes a block named nil around the entire prog +form, so that return can be used at any time to exit from the prog form. + + The difference between prog* and prog is that in prog* the binding +and initialization of the vars is done sequentially, so that the +init-form for each one can use the values of previous ones. + +Examples:: +.......... + + (prog* ((y z) (x (car y))) + (return x)) + + returns the car of the value of z. + + (setq a 1) => 1 + (prog ((a 2) (b a)) (return (if (= a b) '= '/=))) => /= + (prog* ((a 2) (b a)) (return (if (= a b) '= '/=))) => = + (prog () 'no-return-value) => NIL + + (defun king-of-confusion (w) + "Take a cons of two lists and make a list of conses. + Think of this function as being like a zipper." + (prog (x y z) ;Initialize x, y, z to NIL + (setq y (car w) z (cdr w)) + loop + (cond ((null y) (return x)) + ((null z) (go err))) + rejoin + (setq x (cons (cons (car y) (car z)) x)) + (setq y (cdr y) z (cdr z)) + (go loop) + err + (cerror "Will self-pair extraneous items" + "Mismatch - gleep! ~S" y) + (setq z y) + (go rejoin))) => KING-OF-CONFUSION + + This can be accomplished more perspicuously as follows: + + (defun prince-of-clarity (w) + "Take a cons of two lists and make a list of conses. + Think of this function as being like a zipper." + (do ((y (car w) (cdr y)) + (z (cdr w) (cdr z)) + (x '() (cons (cons (car y) (car z)) x))) + ((null y) x) + (when (null z) + (cerror "Will self-pair extraneous items" + "Mismatch - gleep! ~S" y) + (setq z y)))) => PRINCE-OF-CLARITY + +See Also:: +.......... + +*note block:: , *note let:: , *note tagbody:: , *note go:: , *note +return:: , *note Evaluation:: + +Notes:: +....... + +prog can be explained in terms of block, let, and tagbody as follows: + + (prog variable-list declaration . body) + == (block nil (let variable-list declaration (tagbody . body))) + + +File: gcl.info, Node: prog1, Next: progn, Prev: prog, Up: Data and Control Flow Dictionary + +5.3.58 prog1, prog2 [Macro] +--------------------------- + +'prog' 1 => first-form {form}* result-1 'prog' 2 => first-form +second-form {form}* result-2 + +Arguments and Values:: +...................... + +first-form--a form; evaluated as described below. + + second-form--a form; evaluated as described below. + + forms--an implicit progn; evaluated as described below. + + result-1--the primary value resulting from the evaluation of +first-form. + + result-2--the primary value resulting from the evaluation of +second-form. + +Description:: +............. + +prog1 evaluates first-form and then forms, yielding as its only value +the primary value yielded by first-form. + + prog2 evaluates first-form, then second-form, and then forms, +yielding as its only value the primary value yielded by first-form. + +Examples:: +.......... + + (setq temp 1) => 1 + (prog1 temp (print temp) (incf temp) (print temp)) + |> 1 + |> 2 + => 1 + (prog1 temp (setq temp nil)) => 2 + temp => NIL + (prog1 (values 1 2 3) 4) => 1 + (setq temp (list 'a 'b 'c)) + (prog1 (car temp) (setf (car temp) 'alpha)) => A + temp => (ALPHA B C) + (flet ((swap-symbol-values (x y) + (setf (symbol-value x) + (prog1 (symbol-value y) + (setf (symbol-value y) (symbol-value x)))))) + (let ((*foo* 1) (*bar* 2)) + (declare (special *foo* *bar*)) + (swap-symbol-values '*foo* '*bar*) + (values *foo* *bar*))) + => 2, 1 + (setq temp 1) => 1 + (prog2 (incf temp) (incf temp) (incf temp)) => 3 + temp => 4 + (prog2 1 (values 2 3 4) 5) => 2 + +See Also:: +.......... + +*note multiple-value-prog1:: , *note progn:: + +Notes:: +....... + +prog1 and prog2 are typically used to evaluate one or more forms with +side effects and return a value that must be computed before some or all +of the side effects happen. + + (prog1 {form}*) == (values (multiple-value-prog1 {form}*)) + (prog2 form1 {form}*) == (let () form1 (prog1 {form}*)) + + +File: gcl.info, Node: progn, Next: define-modify-macro, Prev: prog1, Up: Data and Control Flow Dictionary + +5.3.59 progn [Special Operator] +------------------------------- + +'progn' {form}* => {result}* + +Arguments and Values:: +...................... + +forms--an implicit progn. + + results--the values of the forms. + +Description:: +............. + +progn evaluates forms, in the order in which they are given. + + The values of each form but the last are discarded. + + If progn appears as a top level form, then all forms within that +progn are considered by the compiler to be top level forms. + +Examples:: +.......... + + (progn) => NIL + (progn 1 2 3) => 3 + (progn (values 1 2 3)) => 1, 2, 3 + (setq a 1) => 1 + (if a + (progn (setq a nil) 'here) + (progn (setq a t) 'there)) => HERE + a => NIL + +See Also:: +.......... + +*note prog1:: , prog2, *note Evaluation:: + +Notes:: +....... + +Many places in Common Lisp involve syntax that uses implicit progns. +That is, part of their syntax allows many forms to be written that are +to be evaluated sequentially, discarding the results of all forms but +the last and returning the results of the last form. Such places +include, but are not limited to, the following: the body of a lambda +expression; the bodies of various control and conditional forms (e.g., +case, catch, progn, and when). + + +File: gcl.info, Node: define-modify-macro, Next: defsetf, Prev: progn, Up: Data and Control Flow Dictionary + +5.3.60 define-modify-macro [Macro] +---------------------------------- + +'define-modify-macro' name lambda-list function [documentation] => name + +Arguments and Values:: +...................... + +name--a symbol. + + lambda-list--a define-modify-macro lambda list + + function--a symbol. + + documentation--a string; not evaluated. + +Description:: +............. + +define-modify-macro defines a macro named name to read and write a +place. + + The arguments to the new macro are a place, followed by the arguments +that are supplied in lambda-list. + + Macros defined with define-modify-macro correctly pass the +environment parameter to + + get-setf-expansion. + + When the macro is invoked, function is applied to the old contents of +the place and the lambda-list arguments to obtain the new value, and the +place is updated to contain the result. + + Except for the issue of avoiding multiple evaluation (see below), the +expansion of a define-modify-macro is equivalent to the following: + + (defmacro name (reference . lambda-list) + documentation + `(setf ,reference + (function ,reference ,arg1 ,arg2 ...))) + + where arg1, arg2, ..., are the parameters appearing in lambda-list; +appropriate provision is made for a rest parameter. + + The subforms of the macro calls defined by define-modify-macro are +evaluated as specified in *note Evaluation of Subforms to Places::. + + Documentation is attached as a documentation string to name (as kind +function) and to the macro function. + + If a define-modify-macro form appears as a top level form, the +compiler must store the macro definition at compile time, so that +occurrences of the macro later on in the file can be expanded correctly. + +Examples:: +.......... + + (define-modify-macro appendf (&rest args) + append "Append onto list") => APPENDF + (setq x '(a b c) y x) => (A B C) + (appendf x '(d e f) '(1 2 3)) => (A B C D E F 1 2 3) + x => (A B C D E F 1 2 3) + y => (A B C) + (define-modify-macro new-incf (&optional (delta 1)) +) + (define-modify-macro unionf (other-set &rest keywords) union) + +Side Effects:: +.............. + +A macro definition is assigned to name. + +See Also:: +.......... + +*note defsetf:: , + + *note define-setf-expander:: , + + *note documentation:: , *note Syntactic Interaction of Documentation +Strings and Declarations:: + + +File: gcl.info, Node: defsetf, Next: define-setf-expander, Prev: define-modify-macro, Up: Data and Control Flow Dictionary + +5.3.61 defsetf [Macro] +---------------------- + +The "short form": + + 'defsetf' access-fn update-fn [documentation] +=> access-fn + + The "long form": + + 'defsetf' access-fn lambda-list ({store-variable}*) [[{declaration}* +| documentation]] {form}* +=> access-fn + +Arguments and Values:: +...................... + +access-fn--a symbol which names a function or a macro. + + update-fn--a symbol naming a function or macro. + + lambda-list--a defsetf lambda list. + + store-variable--a symbol (a variable name). + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + form--a form. + +Description:: +............. + +defsetf defines how to setf a place of the form (access-fn ...) for +relatively simple cases. (See define-setf-expander for more general +access to this facility.) + + It must be the case that the function or macro named by access-fn +evaluates all of its arguments. + + defsetf may take one of two forms, called the "short form" and the +"long form," which are distinguished by the type of the second argument. + + When the short form is used, update-fn must name a function (or +macro) that takes one more argument than access-fn takes. When setf is +given a place that is a call on access-fn, it expands into a call on +update-fn that is given all the arguments to access-fn and also, as its +last argument, the new value (which must be returned by update-fn as its +value). + + The long form defsetf resembles defmacro. The lambda-list describes +the arguments of access-fn. The store-variables describe the value + + or values + + to be stored into the place. The body must compute the expansion of +a setf of a call on access-fn. + + The expansion function is defined in the same lexical environment in +which the defsetf form appears. + + During the evaluation of the forms, the variables in the lambda-list +and the store-variables are bound to names of temporary variables, +generated as if by gensym or gentemp, that will be bound by the +expansion of setf to the values of those subforms. This binding permits +the forms to be written without regard for order-of-evaluation issues. +defsetf arranges for the temporary variables to be optimized out of the +final result in cases where that is possible. + + The body code in defsetf is implicitly enclosed in a block whose name +is access-fn + + defsetf ensures that subforms of the place are evaluated exactly +once. + + Documentation is attached to access-fn as a documentation string of +kind setf. + + If a defsetf form appears as a top level form, the compiler must make +the setf expander available so that it may be used to expand calls to +setf later on in the file. Users must ensure that the forms, if any, +can be evaluated at compile time if the access-fn is used in a place +later in the same file. The compiler must make these setf expanders +available to compile-time calls to get-setf-expansion when its +environment argument is a value received as the environment parameter of +a macro. + +Examples:: +.......... + +The effect of + + (defsetf symbol-value set) + + is built into the Common Lisp system. This causes the form (setf +(symbol-value foo) fu) to expand into (set foo fu). + + Note that + + (defsetf car rplaca) + + would be incorrect because rplaca does not return its last argument. + + (defun middleguy (x) (nth (truncate (1- (list-length x)) 2) x)) => MIDDLEGUY + (defun set-middleguy (x v) + (unless (null x) + (rplaca (nthcdr (truncate (1- (list-length x)) 2) x) v)) + v) => SET-MIDDLEGUY + (defsetf middleguy set-middleguy) => MIDDLEGUY + (setq a (list 'a 'b 'c 'd) + b (list 'x) + c (list 1 2 3 (list 4 5 6) 7 8 9)) => (1 2 3 (4 5 6) 7 8 9) + (setf (middleguy a) 3) => 3 + (setf (middleguy b) 7) => 7 + (setf (middleguy (middleguy c)) 'middleguy-symbol) => MIDDLEGUY-SYMBOL + a => (A 3 C D) + b => (7) + c => (1 2 3 (4 MIDDLEGUY-SYMBOL 6) 7 8 9) + + An example of the use of the long form of defsetf: + + (defsetf subseq (sequence start &optional end) (new-sequence) + `(progn (replace ,sequence ,new-sequence + :start1 ,start :end1 ,end) + ,new-sequence)) => SUBSEQ + + (defvar *xy* (make-array '(10 10))) + (defun xy (&key ((x x) 0) ((y y) 0)) (aref *xy* x y)) => XY + (defun set-xy (new-value &key ((x x) 0) ((y y) 0)) + (setf (aref *xy* x y) new-value)) => SET-XY + (defsetf xy (&key ((x x) 0) ((y y) 0)) (store) + `(set-xy ,store 'x ,x 'y ,y)) => XY + (get-setf-expansion '(xy a b)) + => (#:t0 #:t1), + (a b), + (#:store), + ((lambda (&key ((x #:x)) ((y #:y))) + (set-xy #:store 'x #:x 'y #:y)) + #:t0 #:t1), + (xy #:t0 #:t1) + (xy 'x 1) => NIL + (setf (xy 'x 1) 1) => 1 + (xy 'x 1) => 1 + (let ((a 'x) (b 'y)) + (setf (xy a 1 b 2) 3) + (setf (xy b 5 a 9) 14)) + => 14 + (xy 'y 0 'x 1) => 1 + (xy 'x 1 'y 2) => 3 + +See Also:: +.......... + +*note documentation:: , *note setf:: , + + *note define-setf-expander:: , *note get-setf-expansion:: , + + *note Generalized Reference::, *note Syntactic Interaction of +Documentation Strings and Declarations:: + +Notes:: +....... + +forms must include provision for returning the correct value (the value + + or values + + of store-variable). This is handled by forms rather than by defsetf +because in many cases this value can be returned at no extra cost, by +calling a function that simultaneously stores into the place and returns +the correct value. + + A setf of a call on access-fn also evaluates all of access-fn's +arguments; it cannot treat any of them specially. This means that +defsetf cannot be used to describe how to store into a generalized +reference to a byte, such as (ldb field reference). + + define-setf-expander + + is used to handle situations that do not fit the restrictions imposed +by defsetf and gives the user additional control. + + +File: gcl.info, Node: define-setf-expander, Next: get-setf-expansion, Prev: defsetf, Up: Data and Control Flow Dictionary + +5.3.62 define-setf-expander [Macro] +----------------------------------- + +'define-setf-expander' access-fn lambda-list [[{declaration}* | +documentation]] {form}* +=> access-fn + +Arguments and Values:: +...................... + +access-fn--a symbol that names a function or macro. + + lambda-list - macro lambda list. + + declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + forms--an implicit progn. + +Description:: +............. + +define-setf-expander specifies the means by which setf updates a place +that is referenced by access-fn. + + When setf is given a place that is specified in terms of access-fn +and a new value for the place, it is expanded into a form that performs +the appropriate update. + + The lambda-list supports destructuring. See *note Macro Lambda +Lists::. + + Documentation is attached to access-fn as a documentation string of +kind setf. + + Forms constitute the body of the + + setf expander + + definition and must compute the setf expansion for a call on setf +that references the place by means of the given access-fn. + + The setf expander function is defined in the same lexical environment +in which the define-setf-expander form appears. + + While forms are being executed, the variables in lambda-list are +bound to parts of the place form. + + The body forms (but not the lambda-list) + + in a define-setf-expander form are implicitly enclosed in a block +whose name is access-fn. + + The evaluation of forms must result in the five values described in +*note Setf Expansions::. + + If a define-setf-expander form appears as a top level form, the +compiler must make the setf expander available so that it may be used to +expand calls to setf later on in the file. Programmers must ensure that +the forms can be evaluated at compile time if the access-fn is used in a +place later in the same file. The compiler must make these setf +expanders available to compile-time calls to get-setf-expansion when its +environment argument is a value received as the environment parameter of +a macro. + +Examples:: +.......... + + (defun lastguy (x) (car (last x))) => LASTGUY + (define-setf-expander lastguy (x &environment env) + "Set the last element in a list to the given value." + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-expansion x env) + (let ((store (gensym))) + (values dummies + vals + `(,store) + `(progn (rplaca (last ,getter) ,store) ,store) + `(lastguy ,getter))))) => LASTGUY + (setq a (list 'a 'b 'c 'd) + b (list 'x) + c (list 1 2 3 (list 4 5 6))) => (1 2 3 (4 5 6)) + (setf (lastguy a) 3) => 3 + (setf (lastguy b) 7) => 7 + (setf (lastguy (lastguy c)) 'lastguy-symbol) => LASTGUY-SYMBOL + a => (A B C 3) + b => (7) + c => (1 2 3 (4 5 LASTGUY-SYMBOL)) + + ;;; Setf expander for the form (LDB bytespec int). + ;;; Recall that the int form must itself be suitable for SETF. + (define-setf-expander ldb (bytespec int &environment env) + (multiple-value-bind (temps vals stores + store-form access-form) + (get-setf-expansion int env);Get setf expansion for int. + (let ((btemp (gensym)) ;Temp var for byte specifier. + (store (gensym)) ;Temp var for byte to store. + (stemp (first stores))) ;Temp var for int to store. + (if (cdr stores) (error "Can't expand this.")) + ;;; Return the setf expansion for LDB as five values. + (values (cons btemp temps) ;Temporary variables. + (cons bytespec vals) ;Value forms. + (list store) ;Store variables. + `(let ((,stemp (dpb ,store ,btemp ,access-form))) + ,store-form + ,store) ;Storing form. + `(ldb ,btemp ,access-form) ;Accessing form. + )))) + +See Also:: +.......... + +*note setf:: , *note defsetf:: , *note documentation:: , *note +get-setf-expansion:: , *note Syntactic Interaction of Documentation +Strings and Declarations:: + +Notes:: +....... + +define-setf-expander differs from the long form of defsetf in that while +the body is being executed the variables in lambda-list are bound to +parts of the place form, not to temporary variables that will be bound +to the values of such parts. In addition, define-setf-expander does not +have defsetf's restriction that access-fn must be a function or a +function-like macro; an arbitrary defmacro destructuring pattern is +permitted in lambda-list. + + +File: gcl.info, Node: get-setf-expansion, Next: setf, Prev: define-setf-expander, Up: Data and Control Flow Dictionary + +5.3.63 get-setf-expansion [Function] +------------------------------------ + +'get-setf-expansion' place &optional environment +=> vars, vals, store-vars, writer-form, reader-form + +Arguments and Values:: +...................... + +place--a place. + + environment--an environment object. + + vars, vals, store-vars, writer-form, reader-form--a setf expansion. + +Description:: +............. + +Determines five values constituting the setf expansion for place in +environment; see *note Setf Expansions::. + + If environment is not supplied or nil, the environment is the null +lexical environment. + +Examples:: +.......... + + (get-setf-expansion 'x) + => NIL, NIL, (#:G0001), (SETQ X #:G0001), X + + ;;; This macro is like POP + + (defmacro xpop (place &environment env) + (multiple-value-bind (dummies vals new setter getter) + (get-setf-expansion place env) + `(let* (,@(mapcar #'list dummies vals) (,(car new) ,getter)) + (if (cdr new) (error "Can't expand this.")) + (prog1 (car ,(car new)) + (setq ,(car new) (cdr ,(car new))) + ,setter)))) + + (defsetf frob (x) (value) + `(setf (car ,x) ,value)) => FROB + ;;; The following is an error; an error might be signaled at macro expansion time + (flet ((frob (x) (cdr x))) ;Invalid + (xpop (frob z))) + + +See Also:: +.......... + +*note defsetf:: , *note define-setf-expander:: , *note setf:: + +Notes:: +....... + +Any compound form is a valid place, since any compound form whose +operator f has no setf expander are expanded into a call to (setf f). + + +File: gcl.info, Node: setf, Next: shiftf, Prev: get-setf-expansion, Up: Data and Control Flow Dictionary + +5.3.64 setf, psetf [Macro] +-------------------------- + +'setf' {!pair}* => {result}* + + 'psetf' {!pair}* => nil + + pair ::=place newvalue + +Arguments and Values:: +...................... + +place--a place. + + newvalue--a form. + + results--the multiple values_2 returned by the storing form for the +last place, or nil if there are no pairs. + +Description:: +............. + +setf changes the value of place to be newvalue. + + (setf place newvalue) expands into an update form that stores the +result of evaluating newvalue into the location referred to by place. +Some place forms involve uses of accessors that take optional arguments. +Whether those optional arguments are permitted by setf, or what their +use is, is up to the setf expander function and is not under the control +of setf. The documentation for any function that accepts &optional, +&rest, or &key arguments and that claims to be usable with setf must +specify how those arguments are treated. + + If more than one pair is supplied, the pairs are processed +sequentially; that is, + + (setf place-1 newvalue-1 + place-2 newvalue-2 + ... + place-N newvalue-N) + + is precisely equivalent to + + (progn (setf place-1 newvalue-1) + (setf place-2 newvalue-2) + ... + (setf place-N newvalue-N)) + + For psetf, if more than one pair is supplied then the assignments of +new values to places are done in parallel. More precisely, all subforms +(in both the place and newvalue forms) that are to be evaluated are +evaluated from left to right; after all evaluations have been performed, +all of the assignments are performed in an unpredictable order. + + For detailed treatment of the expansion of setf and psetf, see *note +Kinds of Places::. + +Examples:: +.......... + + (setq x (cons 'a 'b) y (list 1 2 3)) => (1 2 3) + (setf (car x) 'x (cadr y) (car x) (cdr x) y) => (1 X 3) + x => (X 1 X 3) + y => (1 X 3) + (setq x (cons 'a 'b) y (list 1 2 3)) => (1 2 3) + (psetf (car x) 'x (cadr y) (car x) (cdr x) y) => NIL + x => (X 1 A 3) + y => (1 A 3) + +Affected By:: +............. + +define-setf-expander, defsetf, *macroexpand-hook* + +See Also:: +.......... + +*note define-setf-expander:: , *note defsetf:: , macroexpand-1, *note +rotatef:: , *note shiftf:: , *note Generalized Reference:: + + +File: gcl.info, Node: shiftf, Next: rotatef, Prev: setf, Up: Data and Control Flow Dictionary + +5.3.65 shiftf [Macro] +--------------------- + +'shiftf' {place}^+ newvalue => old-value-1 + +Arguments and Values:: +...................... + +place--a place. + + newvalue--a form; evaluated. + + old-value-1--an object (the old value of the first place). + +Description:: +............. + +shiftf modifies the values of each place by storing newvalue into the +last place, and shifting the values of the second through the last place +into the remaining places. + + If newvalue produces more values than there are store variables, the +extra values are ignored. If newvalue produces fewer values than there +are store variables, the missing values are set to nil. + + In the form (shiftf place1 place2 ... placen newvalue), the values in +place1 through placen are read and saved, and newvalue is evaluated, for +a total of n+1 values in all. Values 2 through n+1 are then stored into +place1 through placen, respectively. It is as if all the places form a +shift register; the newvalue is shifted in from the right, all values +shift over to the left one place, and the value shifted out of place1 is +returned. + + For information about the evaluation of subforms of places, see *note +Evaluation of Subforms to Places::. + +Examples:: +.......... + + (setq x (list 1 2 3) y 'trash) => TRASH + (shiftf y x (cdr x) '(hi there)) => TRASH + x => (2 3) + y => (1 HI THERE) + + (setq x (list 'a 'b 'c)) => (A B C) + (shiftf (cadr x) 'z) => B + x => (A Z C) + (shiftf (cadr x) (cddr x) 'q) => Z + x => (A (C) . Q) + (setq n 0) => 0 + (setq x (list 'a 'b 'c 'd)) => (A B C D) + (shiftf (nth (setq n (+ n 1)) x) 'z) => B + x => (A Z C D) + +Affected By:: +............. + +define-setf-expander, defsetf, *macroexpand-hook* + +See Also:: +.......... + +*note setf:: , *note rotatef:: , *note Generalized Reference:: + +Notes:: +....... + +The effect of (shiftf place1 place2 ... placen newvalue) is roughly +equivalent to + + (let ((var1 place1) + (var2 place2) + ... + (varn placen) + (var0 newvalue)) + (setf place1 var2) + (setf place2 var3) + ... + (setf placen var0) + var1) + + except that the latter would evaluate any subforms of each place +twice, whereas shiftf evaluates them once. For example, + + (setq n 0) => 0 + (setq x (list 'a 'b 'c 'd)) => (A B C D) + (prog1 (nth (setq n (+ n 1)) x) + (setf (nth (setq n (+ n 1)) x) 'z)) => B + x => (A B Z D) + + +File: gcl.info, Node: rotatef, Next: control-error, Prev: shiftf, Up: Data and Control Flow Dictionary + +5.3.66 rotatef [Macro] +---------------------- + +'rotatef' {place}* => nil + +Arguments and Values:: +...................... + +place--a place. + +Description:: +............. + +rotatef modifies the values of each place by rotating values from one +place into another. + + If a place produces more values than there are store variables, the +extra values are ignored. If a place produces fewer values than there +are store variables, the missing values are set to nil. + + In the form (rotatef place1 place2 ... placen), the values in place1 +through placen are read and written. Values 2 through n and value 1 are +then stored into place1 through placen. It is as if all the places form +an end-around shift register that is rotated one place to the left, with +the value of place1 being shifted around the end to placen. + + For information about the evaluation of subforms of places, see *note +Evaluation of Subforms to Places::. + +Examples:: +.......... + + (let ((n 0) + (x (list 'a 'b 'c 'd 'e 'f 'g))) + (rotatef (nth (incf n) x) + (nth (incf n) x) + (nth (incf n) x)) + x) => (A C D B E F G) + +See Also:: +.......... + +*note define-setf-expander:: , *note defsetf:: , *note setf:: , *note +shiftf:: , *macroexpand-hook*, *note Generalized Reference:: + +Notes:: +....... + +The effect of (rotatef place1 place2 ... placen) is roughly equivalent +to + + (psetf place1 place2 + place2 place3 + ... + placen place1) + + except that the latter would evaluate any subforms of each place +twice, whereas rotatef evaluates them once. + + +File: gcl.info, Node: control-error, Next: program-error, Prev: rotatef, Up: Data and Control Flow Dictionary + +5.3.67 control-error [Condition Type] +------------------------------------- + +Class Precedence List:: +....................... + +control-error, error, serious-condition, condition, t + +Description:: +............. + +The type control-error consists of error conditions that result from +invalid dynamic transfers of control in a program. The errors that +result from giving throw a tag that is not active or from giving go or +return-from a tag that is no longer dynamically available are of type +control-error. + + +File: gcl.info, Node: program-error, Next: undefined-function, Prev: control-error, Up: Data and Control Flow Dictionary + +5.3.68 program-error [Condition Type] +------------------------------------- + +Class Precedence List:: +....................... + +program-error, error, serious-condition, condition, t + +Description:: +............. + +The type program-error consists of error conditions related to incorrect +program syntax. The errors that result from naming a go tag or a block +tag that is not lexically apparent are of type program-error. + + +File: gcl.info, Node: undefined-function, Prev: program-error, Up: Data and Control Flow Dictionary + +5.3.69 undefined-function [Condition Type] +------------------------------------------ + +Class Precedence List:: +....................... + +undefined-function, cell-error, error, serious-condition, condition, t + +Description:: +............. + +The type undefined-function consists of error conditions that represent +attempts to read the definition of an undefined function. + + The name of the cell (see cell-error) is the function name which was +funbound. + +See Also:: +.......... + +*note cell-error-name:: + + +File: gcl.info, Node: Iteration, Next: Objects, Prev: Data and Control Flow, Up: Top + +6 Iteration +*********** + +* Menu: + +* The LOOP Facility:: +* Iteration Dictionary:: + + +File: gcl.info, Node: The LOOP Facility, Next: Iteration Dictionary, Prev: Iteration, Up: Iteration + +6.1 The LOOP Facility +===================== + +* Menu: + +* Overview of the Loop Facility:: +* Variable Initialization and Stepping Clauses:: +* Value Accumulation Clauses:: +* Termination Test Clauses:: +* Unconditional Execution Clauses:: +* Conditional Execution Clauses:: +* Miscellaneous Clauses:: +* Examples of Miscellaneous Loop Features:: +* Notes about Loop:: + + +File: gcl.info, Node: Overview of the Loop Facility, Next: Variable Initialization and Stepping Clauses, Prev: The LOOP Facility, Up: The LOOP Facility + +6.1.1 Overview of the Loop Facility +----------------------------------- + +The loop macro performs iteration. + +* Menu: + +* Simple vs Extended Loop:: +* Simple Loop:: +* Extended Loop:: +* Loop Keywords:: +* Parsing Loop Clauses:: +* Expanding Loop Forms:: +* Summary of Loop Clauses:: +* Summary of Variable Initialization and Stepping Clauses:: +* Summary of Value Accumulation Clauses:: +* Summary of Termination Test Clauses:: +* Summary of Unconditional Execution Clauses:: +* Summary of Conditional Execution Clauses:: +* Summary of Miscellaneous Clauses:: +* Order of Execution:: +* Destructuring:: +* Restrictions on Side-Effects:: + + +File: gcl.info, Node: Simple vs Extended Loop, Next: Simple Loop, Prev: Overview of the Loop Facility, Up: Overview of the Loop Facility + +6.1.1.1 Simple vs Extended Loop +............................... + +loop forms are partitioned into two categories: simple loop forms and +extended loop forms. + + +File: gcl.info, Node: Simple Loop, Next: Extended Loop, Prev: Simple vs Extended Loop, Up: Overview of the Loop Facility + +6.1.1.2 Simple Loop +................... + +A simple loop form is one that has a body containing only compound +forms. Each form is evaluated in turn from left to right. When the +last form has been evaluated, then the first form is evaluated again, +and so on, in a never-ending cycle. A simple loop form establishes an +implicit block named nil. The execution of a simple loop can be +terminated by explicitly transfering control to the implicit block +(using return or return-from) or to some exit point outside of the block +(e.g., using throw, go, or return-from). + + +File: gcl.info, Node: Extended Loop, Next: Loop Keywords, Prev: Simple Loop, Up: Overview of the Loop Facility + +6.1.1.3 Extended Loop +..................... + +An extended loop form is one that has a body containing atomic +expressions. When the loop macro processes such a form, it invokes a +facility that is commonly called "the Loop Facility." + + The Loop Facility provides standardized access to mechanisms commonly +used in iterations through Loop schemas, which are introduced by loop +keywords. + + The body of an extended loop form is divided into loop clauses, each +which is in turn made up of loop keywords and forms. + + +File: gcl.info, Node: Loop Keywords, Next: Parsing Loop Clauses, Prev: Extended Loop, Up: Overview of the Loop Facility + +6.1.1.4 Loop Keywords +..................... + +Loop keywords are not true keywords_1; they are special symbols, +recognized by name rather than object identity, that are meaningful only +to the loop facility. A loop keyword is a symbol but is recognized by +its name (not its identity), regardless of the packages in which it is +accessible. + + In general, loop keywords are not external symbols of the COMMON-LISP +package, except in the coincidental situation that a symbol with the +same name as a loop keyword was needed for some other purpose in Common +Lisp. For example, there is a symbol in the COMMON-LISP package whose +name is "UNLESS" but not one whose name is "UNTIL". + + If no loop keywords are supplied in a loop form, the Loop Facility +executes the loop body repeatedly; see *note Simple Loop::. + + +File: gcl.info, Node: Parsing Loop Clauses, Next: Expanding Loop Forms, Prev: Loop Keywords, Up: Overview of the Loop Facility + +6.1.1.5 Parsing Loop Clauses +............................ + +The syntactic parts of an extended loop form are called clauses; the +rules for parsing are determined by that clause's keyword. The +following example shows a loop form with six clauses: + + (loop for i from 1 to (compute-top-value) ; first clause + while (not (unacceptable i)) ; second clause + collect (square i) ; third clause + do (format t "Working on ~D now" i) ; fourth clause + when (evenp i) ; fifth clause + do (format t "~D is a non-odd number" i) + finally (format t "About to exit!")) ; sixth clause + + Each loop keyword introduces either a compound loop clause or a +simple loop clause that can consist of a loop keyword followed by a +single form. The number of forms in a clause is determined by the loop +keyword that begins the clause and by the auxiliary keywords in the +clause. The keywords do, + + doing, + + initially, and finally are the only loop keywords that can take any +number of forms and group them as an implicit progn. + + Loop clauses can contain auxiliary keywords, which are sometimes +called prepositions. For example, the first clause in the code above +includes the prepositions from and to, which mark the value from which +stepping begins and the value at which stepping ends. + + For detailed information about loop syntax, see the macro loop. + + +File: gcl.info, Node: Expanding Loop Forms, Next: Summary of Loop Clauses, Prev: Parsing Loop Clauses, Up: Overview of the Loop Facility + +6.1.1.6 Expanding Loop Forms +............................ + +A loop macro form expands into a form containing one or more binding +forms (that establish bindings of loop variables) and a block and a +tagbody (that express a looping control structure). The variables +established in loop are bound as if by let or lambda. + + Implementations can interleave the setting of initial values with the +bindings. However, the assignment of the initial values is always +calculated in the order specified by the user. A variable is thus +sometimes bound to a meaningless value of the correct type, and then +later in the prologue it is set to the true initial value by using setq. + + One implication of this interleaving is that it is +implementation-dependent whether the lexical environment in which the +initial value forms (variously called the form1, form2, form3, step-fun, +vector, hash-table, and package) in any for-as-subclause, except +for-as-equals-then, are evaluated includes only the loop variables +preceding that form or includes more or all of the loop variables; the +form1 and form2 in a for-as-equals-then form includes the lexical +environment of all the loop variables. + + After the form is expanded, it consists of three basic parts in the +tagbody: the loop prologue, the loop body, and the loop epilogue. + +Loop prologue + The loop prologue contains forms that are executed before iteration + begins, such as any automatic variable initializations prescribed + by the variable clauses, along with any initially clauses in the + order they appear in the source. + +Loop body + The loop body contains those forms that are executed during + iteration, including application-specific calculations, termination + tests, and variable stepping_1. + +Loop epilogue + The loop epilogue contains forms that are executed after iteration + terminates, such as finally clauses, if any, along with any + implicit return value from an accumulation clause or an + termination-test clause. + + Some clauses from the source form contribute code only to the loop +prologue; these clauses must come before other clauses that are in the +main body of the loop form. Others contribute code only to the loop +epilogue. All other clauses contribute to the final translated form in +the same order given in the original source form of the loop. + + Expansion of the loop macro produces an implicit block named nil + + unless named is supplied. + + Thus, return-from (and sometimes return) can be used to return values +from loop or to exit loop. + + +File: gcl.info, Node: Summary of Loop Clauses, Next: Summary of Variable Initialization and Stepping Clauses, Prev: Expanding Loop Forms, Up: Overview of the Loop Facility + +6.1.1.7 Summary of Loop Clauses +............................... + +Loop clauses fall into one of the following categories: + + +File: gcl.info, Node: Summary of Variable Initialization and Stepping Clauses, Next: Summary of Value Accumulation Clauses, Prev: Summary of Loop Clauses, Up: Overview of the Loop Facility + +6.1.1.8 Summary of Variable Initialization and Stepping Clauses +............................................................... + +The for and as constructs provide iteration control clauses that +establish a variable to be initialized. for and as clauses can be +combined with the loop keyword and to get parallel initialization and +stepping_1. Otherwise, the initialization and stepping_1 are +sequential. + + The with construct is similar to a single let clause. with clauses +can be combined using the loop keyword and to get parallel +initialization. + + For more information, see *note Variable Initialization and Stepping +Clauses::. + + +File: gcl.info, Node: Summary of Value Accumulation Clauses, Next: Summary of Termination Test Clauses, Prev: Summary of Variable Initialization and Stepping Clauses, Up: Overview of the Loop Facility + +6.1.1.9 Summary of Value Accumulation Clauses +............................................. + +The collect (or collecting) construct takes one form in its clause and +adds the value of that form to the end of a list of values. By default, +the list of values is returned when the loop finishes. + + The append (or appending) construct takes one form in its clause and +appends the value of that form to the end of a list of values. By +default, the list of values is returned when the loop finishes. + + The nconc (or nconcing) construct is similar to the append construct, +but its list values are concatenated as if by the function nconc. By +default, the list of values is returned when the loop finishes. + + The sum (or summing) construct takes one form in its clause that must +evaluate to a number and accumulates the sum of all these numbers. By +default, the cumulative sum is returned when the loop finishes. + + The count (or counting) construct takes one form in its clause and +counts the number of times that the form evaluates to true. By default, +the count is returned when the loop finishes. + + The minimize (or minimizing) construct takes one form in its clause +and determines the minimum value obtained by evaluating that form. By +default, the minimum value is returned when the loop finishes. + + The maximize (or maximizing) construct takes one form in its clause +and determines the maximum value obtained by evaluating that form. By +default, the maximum value is returned when the loop finishes. + + For more information, see *note Value Accumulation Clauses::. + + +File: gcl.info, Node: Summary of Termination Test Clauses, Next: Summary of Unconditional Execution Clauses, Prev: Summary of Value Accumulation Clauses, Up: Overview of the Loop Facility + +6.1.1.10 Summary of Termination Test Clauses +............................................ + +The for and as constructs provide a termination test that is determined +by the iteration control clause. + + The repeat construct causes termination after a specified number of +iterations. (It uses an internal variable to keep track of the number +of iterations.) + + The while construct takes one form, a test, and terminates the +iteration if the test evaluates to false. A while clause is equivalent +to the expression (if (not test) (loop-finish)). + + The until construct is the inverse of while; it terminates the +iteration if the test evaluates to any non-nil value. An until clause +is equivalent to the expression (if test (loop-finish)). + + The always construct takes one form and terminates the loop if the +form ever evaluates to false; in this case, the loop form returns nil. +Otherwise, it provides a default return value of t. + + The never construct takes one form and terminates the loop if the +form ever evaluates to true; in this case, the loop form returns nil. +Otherwise, it provides a default return value of t. + + The thereis construct takes one form and terminates the loop if the +form ever evaluates to a non-nil object; in this case, the loop form +returns that object. + + Otherwise, it provides a default return value of nil. + + If multiple termination test clauses are specified, the loop form +terminates if any are satisfied. + + For more information, see *note Termination Test Clauses::. + + +File: gcl.info, Node: Summary of Unconditional Execution Clauses, Next: Summary of Conditional Execution Clauses, Prev: Summary of Termination Test Clauses, Up: Overview of the Loop Facility + +6.1.1.11 Summary of Unconditional Execution Clauses +................................................... + +The do (or doing) construct evaluates all forms in its clause. + + The return construct takes one + + form. Any values returned by the form are immediately returned by +the loop form. It is equivalent to the clause do (return-from +block-name value), where block-name is the name specified in a named +clause, or nil if there is no named clause. + + For more information, see *note Unconditional Execution Clauses::. + + +File: gcl.info, Node: Summary of Conditional Execution Clauses, Next: Summary of Miscellaneous Clauses, Prev: Summary of Unconditional Execution Clauses, Up: Overview of the Loop Facility + +6.1.1.12 Summary of Conditional Execution Clauses +................................................. + +The if and when constructs take one form as a test and a clause that is +executed when the test yields true. The clause can be a value +accumulation, unconditional, or another conditional clause; it can also +be any combination of such clauses connected by the loop and keyword. + + The loop unless construct is similar to the loop when construct +except that it complements the test result. + + The loop else construct provides an optional component of if, when, +and unless clauses that is executed when an if or when test yields false +or when an unless test yields true. The component is one of the clauses +described under if. + + The loop end construct provides an optional component to mark the end +of a conditional clause. + + For more information, see *note Conditional Execution Clauses::. + + +File: gcl.info, Node: Summary of Miscellaneous Clauses, Next: Order of Execution, Prev: Summary of Conditional Execution Clauses, Up: Overview of the Loop Facility + +6.1.1.13 Summary of Miscellaneous Clauses +......................................... + +The loop named construct gives a name for the block of the loop. + + The loop initially construct causes its forms to be evaluated in the +loop prologue, which precedes all loop code except for initial settings +supplied by the constructs with, for, or as. + + The loop finally construct causes its forms to be evaluated in the +loop epilogue after normal iteration terminates. + + For more information, see *note Miscellaneous Clauses::. + + +File: gcl.info, Node: Order of Execution, Next: Destructuring, Prev: Summary of Miscellaneous Clauses, Up: Overview of the Loop Facility + +6.1.1.14 Order of Execution +........................... + +With the exceptions listed below, clauses are executed in the loop body +in the order in which they appear in the source. Execution is repeated +until a clause terminates the loop or until a return, go, or throw form +is encountered which transfers control to a point outside of the loop. +The following actions are exceptions to the linear order of execution: + +* + All variables are initialized first, regardless of where the + establishing clauses appear in the source. The order of + initialization follows the order of these clauses. + +* + The code for any initially clauses is collected into one progn in + the order in which the clauses appear in the source. The collected + code is executed once in the loop prologue after any implicit + variable initializations. + +* + The code for any finally clauses is collected into one progn in the + order in which the clauses appear in the source. The collected + code is executed once in the loop epilogue before any implicit + values from the accumulation clauses are returned. Explicit + returns anywhere in the source, however, will exit the loop without + executing the epilogue code. + +* + A with clause introduces a variable binding and an optional initial + value. The initial values are calculated in the order in which the + with clauses occur. + +* + Iteration control clauses implicitly perform the following actions: + + - + initialize variables; + + - + step variables, generally between each execution of the loop + body; + + - + perform termination tests, generally just before the execution + of the loop body. + + +File: gcl.info, Node: Destructuring, Next: Restrictions on Side-Effects, Prev: Order of Execution, Up: Overview of the Loop Facility + +6.1.1.15 Destructuring +...................... + +The d-type-spec argument is used for destructuring. If the d-type-spec +argument consists solely of the type fixnum, float, t, or nil, the +of-type keyword is optional. The of-type construct is optional in these +cases to provide backwards compatibility; thus, the following two +expressions are the same: + + ;;; This expression uses the old syntax for type specifiers. + (loop for i fixnum upfrom 3 ...) + + ;;; This expression uses the new syntax for type specifiers. + (loop for i of-type fixnum upfrom 3 ...) + + ;; Declare X and Y to be of type VECTOR and FIXNUM respectively. + (loop for (x y) of-type (vector fixnum) + in l do ...) + + A type specifier for a destructuring pattern is a tree of type +specifiers with the same shape as the tree of variable names, with the +following exceptions: + +* + When aligning the trees, an atom in the tree of type specifiers + that matches a cons in the variable tree declares the same type for + each variable in the subtree rooted at the cons. + +* + A cons in the tree of type specifiers that matches an atom in the + tree of variable names is a compound type specifer. + + Destructuring allows binding of a set of variables to a corresponding +set of values anywhere that a value can normally be bound to a single +variable. During loop expansion, each variable in the variable list is +matched with the values in the values list. If there are more variables +in the variable list than there are values in the values list, the +remaining variables are given a value of nil. If there are more values +than variables listed, the extra values are discarded. + + To assign values from a list to the variables a, b, and c, the for +clause could be used to bind the variable numlist to the car of the +supplied form, and then another for clause could be used to bind the +variables a, b, and c sequentially. + + ;; Collect values by using FOR constructs. + (loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4)) + for a of-type integer = (first numlist) + and b of-type integer = (second numlist) + and c of-type float = (third numlist) + collect (list c b a)) + => ((4.0 2 1) (8.3 6 5) (10.4 9 8)) + + Destructuring makes this process easier by allowing the variables to +be bound in each loop iteration. Types can be declared by using a list +of type-spec arguments. If all the types are the same, a shorthand +destructuring syntax can be used, as the second example illustrates. + + ;; Destructuring simplifies the process. + (loop for (a b c) of-type (integer integer float) in + '((1 2 4.0) (5 6 8.3) (8 9 10.4)) + collect (list c b a)) + => ((4.0 2 1) (8.3 6 5) (10.4 9 8)) + + ;; If all the types are the same, this way is even simpler. + (loop for (a b c) of-type float in + '((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4)) + collect (list c b a)) + => ((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0)) + + If destructuring is used to declare or initialize a number of groups +of variables into types, the loop keyword and can be used to simplify +the process further. + + ;; Initialize and declare variables in parallel by using the AND construct.\kern-7pt + (loop with (a b) of-type float = '(1.0 2.0) + and (c d) of-type integer = '(3 4) + and (e f) + return (list a b c d e f)) + => (1.0 2.0 3 4 NIL NIL) + + If nil is used in a destructuring list, no variable is provided for +its place. + + (loop for (a nil b) = '(1 2 3) + do (return (list a b))) + => (1 3) + + Note that dotted lists can specify destructuring. + + (loop for (x . y) = '(1 . 2) + do (return y)) + => 2 + (loop for ((a . b) (c . d)) of-type ((float . float) (integer . integer)) in + '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6))) + collect (list a b c d)) + => ((1.2 2.4 3 4) (3.4 4.6 5 6)) + + An error of type program-error is signaled (at macro expansion time) +if the same variable is bound twice in any variable-binding clause of a +single loop expression. Such variables include local variables, +iteration control variables, and variables found by destructuring. + + +File: gcl.info, Node: Restrictions on Side-Effects, Prev: Destructuring, Up: Overview of the Loop Facility + +6.1.1.16 Restrictions on Side-Effects +..................................... + +See *note Traversal Rules and Side Effects::. + + +File: gcl.info, Node: Variable Initialization and Stepping Clauses, Next: Value Accumulation Clauses, Prev: Overview of the Loop Facility, Up: The LOOP Facility + +6.1.2 Variable Initialization and Stepping Clauses +-------------------------------------------------- + +* Menu: + +* Iteration Control:: +* The for-as-arithmetic subclause:: +* Examples of for-as-arithmetic subclause:: +* The for-as-in-list subclause:: +* Examples of for-as-in-list subclause:: +* The for-as-on-list subclause:: +* Examples of for-as-on-list subclause:: +* The for-as-equals-then subclause:: +* Examples of for-as-equals-then subclause:: +* The for-as-across subclause:: +* Examples of for-as-across subclause:: +* The for-as-hash subclause:: +* The for-as-package subclause:: +* Examples of for-as-package subclause:: +* Local Variable Initializations:: +* Examples of WITH clause:: + + +File: gcl.info, Node: Iteration Control, Next: The for-as-arithmetic subclause, Prev: Variable Initialization and Stepping Clauses, Up: Variable Initialization and Stepping Clauses + +6.1.2.1 Iteration Control +......................... + +Iteration control clauses allow direction of loop iteration. The loop +keywords for and as designate iteration control clauses. Iteration +control clauses differ with respect to the specification of termination +tests and to the initialization and stepping_1 of loop variables. +Iteration clauses by themselves do not cause the Loop Facility to return +values, but they can be used in conjunction with value-accumulation +clauses to return values. + + All variables are initialized in the loop prologue. A variable +binding has lexical scope unless it is proclaimed special; thus, by +default, the variable can be accessed only by forms that lie textually +within the loop. Stepping assignments are made in the loop body before +any other forms are evaluated in the body. + + The variable argument in iteration control clauses can be a +destructuring list. A destructuring list is a tree whose non-nil atoms +are variable names. See *note Destructuring::. + + The iteration control clauses for, as, and repeat must precede any +other loop clauses, except initially, with, and named, since they +establish variable bindings. When iteration control clauses are used in +a loop, the corresponding termination tests in the loop body are +evaluated before any other loop body code is executed. + + If multiple iteration clauses are used to control iteration, variable +initialization and stepping_1 occur sequentially by default. The and +construct can be used to connect two or more iteration clauses when +sequential binding and stepping_1 are not necessary. The iteration +behavior of clauses joined by and is analogous to the behavior of the +macro do with respect to do*. + + The for and as clauses iterate by using one or more local loop +variables that are initialized to some value and that can be modified or +stepped_1 after each iteration. For these clauses, iteration terminates +when a local variable reaches some supplied value or when some other +loop clause terminates iteration. At each iteration, variables can be +stepped_1 by an increment or a decrement or can be assigned a new value +by the evaluation of a form). Destructuring can be used to assign +values to variables during iteration. + + The for and as keywords are synonyms; they can be used +interchangeably. There are seven syntactic formats for these +constructs. In each syntactic format, the type of var can be supplied +by the optional type-spec argument. If var is a destructuring list, the +type supplied by the type-spec argument must appropriately match the +elements of the list. By convention, for introduces new iterations and +as introduces iterations that depend on a previous iteration +specification. + + +File: gcl.info, Node: The for-as-arithmetic subclause, Next: Examples of for-as-arithmetic subclause, Prev: Iteration Control, Up: Variable Initialization and Stepping Clauses + +6.1.2.2 The for-as-arithmetic subclause +....................................... + +In the for-as-arithmetic subclause, the for or as construct iterates +from the value supplied by form1 to the value supplied by form2 in +increments or decrements denoted by form3. Each expression is evaluated +only once and must evaluate to a number. The variable var is bound to +the value of form1 in the first iteration and is stepped_1 by the value +of form3 in each succeeding iteration, or by 1 if form3 is not provided. +The following loop keywords serve as valid prepositions within this +syntax. At least one of the prepositions must be used; and at most one +from each line may be used in a single subclause. + +from | downfrom | upfrom +to | downto | upto | below | above +by + + The prepositional phrases in each subclause may appear in any order. +For example, either "from x by y" or "by y from x" is permitted. +However, because left-to-right order of evaluation is preserved, the +effects will be different in the case of side effects. + + Consider: + + (let ((x 1)) (loop for i from x by (incf x) to 10 collect i)) + => (1 3 5 7 9) + (let ((x 1)) (loop for i by (incf x) from x to 10 collect i)) + => (2 4 6 8 10) + + The descriptions of the prepositions follow: + +from + The loop keyword from specifies the value from which stepping_1 + begins, as supplied by form1. Stepping_1 is incremental by + default. If decremental stepping_1 is desired, the preposition + downto or above must be used with form2. For incremental + stepping_1, the default from value is 0. + +downfrom, upfrom + The loop keyword downfrom indicates that the variable var is + decreased in decrements supplied by form3; the loop keyword upfrom + indicates that var is increased in increments supplied by form3. + +to + The loop keyword to marks the end value for stepping_1 supplied in + form2. Stepping_1 is incremental by default. If decremental + stepping_1 is desired, the preposition downfrom must be used with + form1, or else the preposition downto or above should be used + instead of to with form2. + +downto, upto + The loop keyword downto specifies decremental stepping; the loop + keyword upto specifies incremental stepping. In both cases, the + amount of change on each step is specified by form3, and the loop + terminates when the variable var passes the value of form2. Since + there is no default for form1 in decremental stepping_1, a form1 + value must be supplied (using from or downfrom) when downto is + supplied. + +below, above + The loop keywords below and above are analogous to upto and downto + respectively. These keywords stop iteration just before the value + of the variable var reaches the value supplied by form2; the end + value of form2 is not included. Since there is no default for + form1 in decremental stepping_1, a form1 value must be supplied + (using from or downfrom) when above is supplied. + +by + The loop keyword by marks the increment or decrement supplied by + form3. The value of form3 can be any positive number. The default + value is 1. + + In an iteration control clause, the for or as construct causes +termination when the supplied limit is reached. That is, iteration +continues until the value var is stepped to the exclusive or inclusive +limit supplied by form2. The range is exclusive if form3 increases or +decreases var to the value of form2 without reaching that value; the +loop keywords below and above provide exclusive limits. An inclusive +limit allows var to attain the value of form2; to, downto, and upto +provide inclusive limits. + + +File: gcl.info, Node: Examples of for-as-arithmetic subclause, Next: The for-as-in-list subclause, Prev: The for-as-arithmetic subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.3 Examples of for-as-arithmetic subclause +............................................... + + ;; Print some numbers. + (loop for i from 1 to 3 + do (print i)) + |> 1 + |> 2 + |> 3 + => NIL + + ;; Print every third number. + (loop for i from 10 downto 1 by 3 + do (print i)) + |> 10 + |> 7 + |> 4 + |> 1 + => NIL + + ;; Step incrementally from the default starting value. + (loop for i below 3 + do (print i)) + |> 0 + |> 1 + |> 2 + => NIL + + +File: gcl.info, Node: The for-as-in-list subclause, Next: Examples of for-as-in-list subclause, Prev: Examples of for-as-arithmetic subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.4 The for-as-in-list subclause +.................................... + +In the for-as-in-list subclause, the for or as construct iterates over +the contents of a list. It checks for the end of the list as if by +using endp. The variable var is bound to the successive elements of the +list in form1 before each iteration. At the end of each iteration, the +function step-fun is applied to the list; the default value for step-fun +is cdr. The loop keywords in and by serve as valid prepositions in this +syntax. The for or as construct causes termination when the end of the +list is reached. + + +File: gcl.info, Node: Examples of for-as-in-list subclause, Next: The for-as-on-list subclause, Prev: The for-as-in-list subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.5 Examples of for-as-in-list subclause +............................................ + + ;; Print every item in a list. + (loop for item in '(1 2 3) do (print item)) + |> 1 + |> 2 + |> 3 + => NIL + + ;; Print every other item in a list. + (loop for item in '(1 2 3 4 5) by #'cddr + do (print item)) + |> 1 + |> 3 + |> 5 + => NIL + + ;; Destructure a list, and sum the x values using fixnum arithmetic. + (loop for (item . x) of-type (t . fixnum) in '((A . 1) (B . 2) (C . 3)) + unless (eq item 'B) sum x) + => 4 + + +File: gcl.info, Node: The for-as-on-list subclause, Next: Examples of for-as-on-list subclause, Prev: Examples of for-as-in-list subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.6 The for-as-on-list subclause +.................................... + +In the for-as-on-list subclause, the for or as construct iterates over a +list. It checks for the end of the list as if by using atom. + + The variable var is bound to the successive tails of the list in +form1. At the end of each iteration, the function step-fun is applied +to the list; the default value for step-fun is cdr. The loop keywords +on and by serve as valid prepositions in this syntax. The for or as +construct causes termination when the end of the list is reached. + + +File: gcl.info, Node: Examples of for-as-on-list subclause, Next: The for-as-equals-then subclause, Prev: The for-as-on-list subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.7 Examples of for-as-on-list subclause +............................................ + + ;; Collect successive tails of a list. + (loop for sublist on '(a b c d) + collect sublist) + => ((A B C D) (B C D) (C D) (D)) + + ;; Print a list by using destructuring with the loop keyword ON. + (loop for (item) on '(1 2 3) + do (print item)) + |> 1 + |> 2 + |> 3 + => NIL + + + +File: gcl.info, Node: The for-as-equals-then subclause, Next: Examples of for-as-equals-then subclause, Prev: Examples of for-as-on-list subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.8 The for-as-equals-then subclause +........................................ + +In the for-as-equals-then subclause the for or as construct initializes +the variable var by setting it to the result of evaluating form1 on the +first iteration, then setting it to the result of evaluating form2 on +the second and subsequent iterations. If form2 is omitted, the +construct uses form1 on the second and subsequent iterations. The loop +keywords = and then serve as valid prepositions in this syntax. This +construct does not provide any termination tests. + + +File: gcl.info, Node: Examples of for-as-equals-then subclause, Next: The for-as-across subclause, Prev: The for-as-equals-then subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.9 Examples of for-as-equals-then subclause +................................................ + + ;; Collect some numbers. + (loop for item = 1 then (+ item 10) + for iteration from 1 to 5 + collect item) + => (1 11 21 31 41) + + +File: gcl.info, Node: The for-as-across subclause, Next: Examples of for-as-across subclause, Prev: Examples of for-as-equals-then subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.10 The for-as-across subclause +.................................... + +In the for-as-across subclause the for or as construct binds the +variable var to the value of each element in the array vector. The loop +keyword across marks the array vector; across is used as a preposition +in this syntax. Iteration stops when there are no more elements in the +supplied array that can be referenced. Some implementations might +recognize a the special form in the vector form to produce more +efficient code. + + +File: gcl.info, Node: Examples of for-as-across subclause, Next: The for-as-hash subclause, Prev: The for-as-across subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.11 Examples of for-as-across subclause +............................................ + + (loop for char across (the simple-string (find-message channel)) + do (write-char char stream)) + + +File: gcl.info, Node: The for-as-hash subclause, Next: The for-as-package subclause, Prev: Examples of for-as-across subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.12 The for-as-hash subclause +.................................. + +In the for-as-hash subclause the for or as construct iterates over the +elements, keys, and values of a hash-table. In this syntax, a compound +preposition is used to designate access to a hash table. The variable +var takes on the value of each hash key or hash value in the supplied +hash-table. The following loop keywords serve as valid prepositions +within this syntax: + +being + The keyword being introduces either the Loop schema hash-key or + hash-value. + +each, the + The loop keyword each follows the loop keyword being when hash-key + or hash-value is used. The loop keyword the is used with hash-keys + and hash-values only for ease of reading. This agreement isn't + required. + +hash-key, hash-keys + These loop keywords access each key entry of the hash table. If + the name hash-value is supplied in a using construct with one of + these Loop schemas, the iteration can optionally access the keyed + value. The order in which the keys are accessed is undefined; + empty slots in the hash table are ignored. + +hash-value, hash-values + These loop keywords access each value entry of a hash table. If + the name hash-key is supplied in a using construct with one of + these Loop schemas, the iteration can optionally access the key + that corresponds to the value. The order in which the keys are + accessed is undefined; empty slots in the hash table are ignored. + +using + The loop keyword using introduces the optional key or the keyed + value to be accessed. It allows access to the hash key if + iteration is over the hash values, and the hash value if iteration + is over the hash keys. + +in, of + These loop prepositions introduce hash-table. + + In effect + + being {each | the} {hash-value | hash-values | hash-key | hash-keys} +{in | of} + + is a compound preposition. + + Iteration stops when there are no more hash keys or hash values to be +referenced in the supplied hash-table. + + +File: gcl.info, Node: The for-as-package subclause, Next: Examples of for-as-package subclause, Prev: The for-as-hash subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.13 The for-as-package subclause +..................................... + +In the for-as-package subclause the for or as construct iterates over +the symbols in a package. In this syntax, a compound preposition is +used to designate access to a package. The variable var takes on the +value of each symbol in the supplied package. The following loop +keywords serve as valid prepositions within this syntax: + +being + The keyword being introduces either the Loop schema symbol, + present-symbol, or external-symbol. + +each, the + The loop keyword each follows the loop keyword being when symbol, + present-symbol, or external-symbol is used. The loop keyword the + is used with symbols, present-symbols, and external-symbols only + for ease of reading. This agreement isn't required. + +present-symbol, present-symbols + These Loop schemas iterate over the symbols + + that are present in a package. + + The package to be iterated over is supplied in the same way that + package arguments to find-package are supplied. If the package for + the iteration is not supplied, the current package is used. If a + package that does not exist is supplied, an error of type + package-error is signaled. + +symbol, symbols + These Loop schemas iterate over symbols that are accessible in a + given package. The package to be iterated over is supplied in the + same way that package arguments to find-package are supplied. If + the package for the iteration is not supplied, the current package + is used. If a package that does not exist is supplied, an error of + type package-error is signaled. + +external-symbol, external-symbols + These Loop schemas iterate over the external symbols of a package. + The package to be iterated over is supplied in the same way that + package arguments to find-package are supplied. If the package for + the iteration is not supplied, the current package is used. If a + package that does not exist is supplied, an error of type + package-error is signaled. + +in, of + These loop prepositions introduce package. + + In effect + + being {each | the} {symbol | symbols | present-symbol | +present-symbols | external-symbol | external-symbols} {in | of} + + is a compound preposition. + + Iteration stops when there are no more symbols to be referenced in +the supplied package. + + +File: gcl.info, Node: Examples of for-as-package subclause, Next: Local Variable Initializations, Prev: The for-as-package subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.14 Examples of for-as-package subclause +............................................. + + (let ((*package* (make-package "TEST-PACKAGE-1"))) + ;; For effect, intern some symbols + (read-from-string "(THIS IS A TEST)") + (export (intern "THIS")) + (loop for x being each present-symbol of *package* + do (print x))) + |> A + |> TEST + |> THIS + |> IS + => NIL + + +File: gcl.info, Node: Local Variable Initializations, Next: Examples of WITH clause, Prev: Examples of for-as-package subclause, Up: Variable Initialization and Stepping Clauses + +6.1.2.15 Local Variable Initializations +....................................... + +When a loop form is executed, the local variables are bound and are +initialized to some value. These local variables exist until loop +iteration terminates, at which point they cease to exist. Implicit +variables are also established by iteration control clauses and the into +preposition of accumulation clauses. + + The with construct initializes variables that are local to a loop. +The variables are initialized one time only. If the optional type-spec +argument is supplied for the variable var, but there is no related +expression to be evaluated, var is initialized to an appropriate default +value for its type. For example, for the types t, number, and float, +the default values are nil, 0, and 0.0 respectively. The consequences +are undefined if a type-spec argument is supplied for var if the related +expression returns a value that is not of the supplied type. By +default, the with construct initializes variables sequentially; that is, +one variable is assigned a value before the next expression is +evaluated. However, by using the loop keyword and to join several with +clauses, initializations can be forced to occur in parallel; that is, +all of the supplied forms are evaluated, and the results are bound to +the respective variables simultaneously. + + Sequential binding is used when it is desireable for the +initialization of some variables to depend on the values of previously +bound variables. For example, suppose the variables a, b, and c are to +be bound in sequence: + + (loop with a = 1 + with b = (+ a 2) + with c = (+ b 3) + return (list a b c)) + => (1 3 6) + + The execution of the above loop is equivalent to the execution of the +following code: + + (block nil + (let* ((a 1) + (b (+ a 2)) + (c (+ b 3))) + (tagbody + (next-loop (return (list a b c)) + (go next-loop) + end-loop)))) + + If the values of previously bound variables are not needed for the +initialization of other local variables, an and clause can be used to +specify that the bindings are to occur in parallel: + + (loop with a = 1 + and b = 2 + and c = 3 + return (list a b c)) + => (1 2 3) + + The execution of the above loop is equivalent to the execution of the +following code: + + (block nil + (let ((a 1) + (b 2) + (c 3)) + (tagbody + (next-loop (return (list a b c)) + (go next-loop) + end-loop)))) + + +File: gcl.info, Node: Examples of WITH clause, Prev: Local Variable Initializations, Up: Variable Initialization and Stepping Clauses + +6.1.2.16 Examples of WITH clause +................................ + + ;; These bindings occur in sequence. + (loop with a = 1 + with b = (+ a 2) + with c = (+ b 3) + return (list a b c)) + => (1 3 6) + + ;; These bindings occur in parallel. + (setq a 5 b 10) + => 10 + (loop with a = 1 + and b = (+ a 2) + and c = (+ b 3) + return (list a b c)) + => (1 7 13) + + ;; This example shows a shorthand way to declare local variables + ;; that are of different types. + (loop with (a b c) of-type (float integer float) + return (format nil "~A ~A ~A" a b c)) + => "0.0 0 0.0" + + ;; This example shows a shorthand way to declare local variables + ;; that are the same type. + (loop with (a b c) of-type float + return (format nil "~A ~A ~A" a b c)) + => "0.0 0.0 0.0" + + +File: gcl.info, Node: Value Accumulation Clauses, Next: Termination Test Clauses, Prev: Variable Initialization and Stepping Clauses, Up: The LOOP Facility + +6.1.3 Value Accumulation Clauses +-------------------------------- + +The constructs collect, collecting, append, appending, nconc, nconcing, +count, counting, maximize, maximizing, minimize, minimizing, sum, and +summing, allow values to be accumulated in a loop. + + The constructs collect, collecting, append, appending, nconc, and +nconcing, designate clauses that accumulate values in lists and return +them. The constructs count, counting, maximize, maximizing, minimize, +minimizing, sum, and summing designate clauses that accumulate and +return numerical values. + + During each iteration, the constructs collect and collecting collect +the value of the supplied form into a list. When iteration terminates, +the list is returned. The argument var is set to the list of collected +values; if var is supplied, the loop does not return the final list +automatically. If var is not supplied, it is equivalent to supplying an +internal name for var and returning its value in a finally clause. The +var argument is bound as if by the construct with. No mechanism is +provided for declaring the type of var; it must be of type list. + + The constructs append, appending, nconc, and nconcing are similar to +collect except that the values of the supplied form must be lists. + +* + The append keyword causes its list values to be concatenated into a + single list, as if they were arguments to the function append. + +* + The nconc keyword causes its list values to be concatenated into a + single list, as if they were arguments to the function nconc. + + The argument var is set to the list of concatenated values; if var is +supplied, loop does not return the final list automatically. The var +argument is bound as if by the construct with. A type cannot be +supplied for var; it must be of type list. The construct nconc +destructively modifies its argument lists. + + The count construct counts the number of times that the supplied form +returns true. The argument var accumulates the number of occurrences; +if var is supplied, loop does not return the final count automatically. +The var argument is bound as if by the construct with to a zero of the +appropriate type. Subsequent values (including any necessary coercions) +are computed as if by the function 1+. If into var is used, a type can +be supplied for var with the type-spec argument; the consequences are +unspecified if a nonnumeric type is supplied. If there is no into +variable, the optional type-spec argument applies to the internal +variable that is keeping the count. The default type is +implementation-dependent; but it must be a supertype of type fixnum. + + The maximize and minimize constructs compare the value of the +supplied form obtained during the first iteration with values obtained +in successive iterations. The maximum (for maximize) or minimum (for +minimize) value encountered is determined (as if by the function max for +maximize and as if by the function min for minimize) and returned. If +the maximize or minimize clause is never executed, the accumulated value +is unspecified. The argument var accumulates the maximum or minimum +value; if var is supplied, loop does not return the maximum or minimum +automatically. The var argument is bound as if by the construct with. +If into var is used, a type can be supplied for var with the type-spec +argument; the consequences are unspecified if a nonnumeric type is +supplied. If there is no into variable, the optional type-spec argument +applies to the internal variable that is keeping the maximum or minimum +value. The default type is implementation-dependent; but it must be a +supertype of type real. + + The sum construct forms a cumulative sum of the successive primary +values of the supplied form at each iteration. The argument var is used +to accumulate the sum; if var is supplied, loop does not return the +final sum automatically. The var argument is bound as if by the +construct with to a zero of the appropriate type. Subsequent values +(including any necessary coercions) are computed as if by the function ++. If into var is used, a type can be supplied for var with the +type-spec argument; the consequences are unspecified if a nonnumeric +type is supplied. If there is no into variable, the optional type-spec +argument applies to the internal variable that is keeping the sum. The +default type is implementation-dependent; but it must be a supertype of +type number. + + If into is used, the construct does not provide a default return +value; however, the variable is available for use in any finally clause. + + Certain kinds of accumulation clauses can be combined in a loop if +their destination is the same (the result of loop or an into var) +because they are considered to accumulate conceptually compatible +quantities. In particular, any elements of following sets of +accumulation clauses can be mixed with other elements of the same set +for the same destination in a loop form: + +* + collect, append, nconc + +* + sum, count + +* + maximize, minimize + + ;; Collect every name and the kids in one list by using + ;; COLLECT and APPEND. + (loop for name in '(fred sue alice joe june) + for kids in '((bob ken) () () (kris sunshine) ()) + collect name + append kids) + => (FRED BOB KEN SUE ALICE JOE KRIS SUNSHINE JUNE) + + Any two clauses that do not accumulate the same type of object can +coexist in a loop only if each clause accumulates its values into a +different variable. + +* Menu: + +* Examples of COLLECT clause:: +* Examples of APPEND and NCONC clauses:: +* Examples of COUNT clause:: +* Examples of MAXIMIZE and MINIMIZE clauses:: +* Examples of SUM clause:: + + +File: gcl.info, Node: Examples of COLLECT clause, Next: Examples of APPEND and NCONC clauses, Prev: Value Accumulation Clauses, Up: Value Accumulation Clauses + +6.1.3.1 Examples of COLLECT clause +.................................. + + ;; Collect all the symbols in a list. + (loop for i in '(bird 3 4 turtle (1 . 4) horse cat) + when (symbolp i) collect i) + => (BIRD TURTLE HORSE CAT) + + ;; Collect and return odd numbers. + (loop for i from 1 to 10 + if (oddp i) collect i) + => (1 3 5 7 9) + + ;; Collect items into local variable, but don't return them. + (loop for i in '(a b c d) by #'cddr + collect i into my-list + finally (print my-list)) + |> (A C) + => NIL + + +File: gcl.info, Node: Examples of APPEND and NCONC clauses, Next: Examples of COUNT clause, Prev: Examples of COLLECT clause, Up: Value Accumulation Clauses + +6.1.3.2 Examples of APPEND and NCONC clauses +............................................ + + ;; Use APPEND to concatenate some sublists. + (loop for x in '((a) (b) ((c))) + append x) + => (A B (C)) + + ;; NCONC some sublists together. Note that only lists made by the + ;; call to LIST are modified. + (loop for i upfrom 0 + as x in '(a b (c)) + nconc (if (evenp i) (list x) nil)) + => (A (C)) + + +File: gcl.info, Node: Examples of COUNT clause, Next: Examples of MAXIMIZE and MINIMIZE clauses, Prev: Examples of APPEND and NCONC clauses, Up: Value Accumulation Clauses + +6.1.3.3 Examples of COUNT clause +................................ + + (loop for i in '(a b nil c nil d e) + count i) + => 5 + + +File: gcl.info, Node: Examples of MAXIMIZE and MINIMIZE clauses, Next: Examples of SUM clause, Prev: Examples of COUNT clause, Up: Value Accumulation Clauses + +6.1.3.4 Examples of MAXIMIZE and MINIMIZE clauses +................................................. + + (loop for i in '(2 1 5 3 4) + maximize i) + => 5 + (loop for i in '(2 1 5 3 4) + minimize i) + => 1 + + ;; In this example, FIXNUM applies to the internal variable that holds + ;; the maximum value. + (setq series '(1.2 4.3 5.7)) + => (1.2 4.3 5.7) + (loop for v in series + maximize (round v) of-type fixnum) + => 6 + + ;; In this example, FIXNUM applies to the variable RESULT. + (loop for v of-type float in series + minimize (round v) into result of-type fixnum + finally (return result)) + => 1 + + +File: gcl.info, Node: Examples of SUM clause, Prev: Examples of MAXIMIZE and MINIMIZE clauses, Up: Value Accumulation Clauses + +6.1.3.5 Examples of SUM clause +.............................. + + (loop for i of-type fixnum in '(1 2 3 4 5) + sum i) + => 15 + (setq series '(1.2 4.3 5.7)) + => (1.2 4.3 5.7) + (loop for v in series + sum (* 2.0 v)) + => 22.4 + + +File: gcl.info, Node: Termination Test Clauses, Next: Unconditional Execution Clauses, Prev: Value Accumulation Clauses, Up: The LOOP Facility + +6.1.4 Termination Test Clauses +------------------------------ + +The repeat construct causes iteration to terminate after a specified +number of times. The loop body executes n times, where n is the value +of the expression form. The form argument is evaluated one time in the +loop prologue. If the expression evaluates to 0 or to a negative +number, the loop body is not evaluated. + + The constructs always, never, thereis, while, until, and the macro +loop-finish allow conditional termination of iteration within a loop. + + The constructs always, never, and thereis provide specific values to +be returned when a loop terminates. Using always, never, or thereis in +a loop with value accumulation clauses that are not into causes an error +of type program-error to be signaled (at macro expansion time). Since +always, never, and thereis use + + the return-from special operator + + to terminate iteration, any finally clause that is supplied is not +evaluated when exit occurs due to any of these constructs. In all other +respects these constructs behave like the while and until constructs. + + The always construct takes one form and terminates the loop if the +form ever evaluates to nil; in this case, it returns nil. Otherwise, it +provides a default return value of t. If the value of the supplied form +is never nil, some other construct can terminate the iteration. + + The never construct terminates iteration the first time that the +value of the supplied form is non-nil; the loop returns nil. If the +value of the supplied form is always nil, some other construct can +terminate the iteration. Unless some other clause contributes a return +value, the default value returned is t. + + The thereis construct terminates iteration the first time that the +value of the supplied form is non-nil; the loop returns the value of the +supplied form. If the value of the supplied form is always nil, some +other construct can terminate the iteration. Unless some other clause +contributes a return value, the default value returned is nil. + + There are two differences between the thereis and until constructs: + +* + The until construct does not return a value or nil based on the + value of the supplied form. + +* + The until construct executes any finally clause. Since thereis + uses + + the return-from special operator + + to terminate iteration, any finally clause that is supplied is not + evaluated when exit occurs due to thereis. + + The while construct allows iteration to continue until the supplied +form evaluates to false. The supplied form is reevaluated at the +location of the while clause. + + The until construct is equivalent to while (not form)\dots. If the +value of the supplied form is non-nil, iteration terminates. + + Termination-test control constructs can be used anywhere within the +loop body. The termination tests are used in the order in which they +appear. If an until or while clause causes termination, any clauses +that precede it in the source are still evaluated. If the until and +while constructs cause termination, control is passed to the loop +epilogue, where any finally clauses will be executed. + + There are two differences between the never and until constructs: + +* + The until construct does not return t or nil based on the value of + the supplied form. + +* + The until construct does not bypass any finally clauses. Since + never uses + + the return-from special operator + + to terminate iteration, any finally clause that is supplied is not + evaluated when exit occurs due to never. + + In most cases it is not necessary to use loop-finish because other +loop control clauses terminate the loop. The macro loop-finish is used +to provide a normal exit from a nested conditional inside a loop. Since +loop-finish transfers control to the loop epilogue, using loop-finish +within a finally expression can cause infinite looping. + +* Menu: + +* Examples of REPEAT clause:: +* Examples of ALWAYS:: +* Examples of WHILE and UNTIL clauses:: + + +File: gcl.info, Node: Examples of REPEAT clause, Next: Examples of ALWAYS, Prev: Termination Test Clauses, Up: Termination Test Clauses + +6.1.4.1 Examples of REPEAT clause +................................. + + (loop repeat 3 + do (format t "~&What I say three times is true.~ + |> What I say three times is true. + |> What I say three times is true. + |> What I say three times is true. + => NIL + (loop repeat -15 + do (format t "What you see is what you expect~ + => NIL + + +File: gcl.info, Node: Examples of ALWAYS, Next: Examples of WHILE and UNTIL clauses, Prev: Examples of REPEAT clause, Up: Termination Test Clauses + +6.1.4.2 Examples of ALWAYS, NEVER, and THEREIS clauses +...................................................... + + ;; Make sure I is always less than 11 (two ways). + ;; The FOR construct terminates these loops. + (loop for i from 0 to 10 + always (< i 11)) + => T + (loop for i from 0 to 10 + never (> i 11)) + => T + + ;; If I exceeds 10 return I; otherwise, return NIL. + ;; The THEREIS construct terminates this loop. + (loop for i from 0 + thereis (when (> i 10) i) ) + => 11 + + ;;; The FINALLY clause is not evaluated in these examples. + (loop for i from 0 to 10 + always (< i 9) + finally (print "you won't see this")) + => NIL + (loop never t + finally (print "you won't see this")) + => NIL + (loop thereis "Here is my value" + finally (print "you won't see this")) + => "Here is my value" + + ;; The FOR construct terminates this loop, so the FINALLY clause + ;; is evaluated. + (loop for i from 1 to 10 + thereis (> i 11) + finally (prin1 'got-here)) + |> GOT-HERE + => NIL + + ;; If this code could be used to find a counterexample to Fermat's + ;; last theorem, it would still not return the value of the + ;; counterexample because all of the THEREIS clauses in this example + ;; only return T. But if Fermat is right, that won't matter + ;; because this won't terminate. + + (loop for z upfrom 2 + thereis + (loop for n upfrom 3 below (log z 2) + thereis + (loop for x below z + thereis + (loop for y below z + thereis (= (+ (expt x n) (expt y n)) + (expt z n)))))) + + +File: gcl.info, Node: Examples of WHILE and UNTIL clauses, Prev: Examples of ALWAYS, Up: Termination Test Clauses + +6.1.4.3 Examples of WHILE and UNTIL clauses +........................................... + + (loop while (hungry-p) do (eat)) + + ;; UNTIL NOT is equivalent to WHILE. + (loop until (not (hungry-p)) do (eat)) + + ;; Collect the length and the items of STACK. + (let ((stack '(a b c d e f))) + (loop for item = (length stack) then (pop stack) + collect item + while stack)) + => (6 A B C D E F) + + ;; Use WHILE to terminate a loop that otherwise wouldn't terminate. + ;; Note that WHILE occurs after the WHEN. + (loop for i fixnum from 3 + when (oddp i) collect i + while (< i 5)) + => (3 5) + + +File: gcl.info, Node: Unconditional Execution Clauses, Next: Conditional Execution Clauses, Prev: Termination Test Clauses, Up: The LOOP Facility + +6.1.5 Unconditional Execution Clauses +------------------------------------- + +The do and doing constructs evaluate the supplied forms wherever they +occur in the expanded form of loop. The form argument can be any +compound form. Each form is evaluated in every iteration. Because +every loop clause must begin with a loop keyword, the keyword do is used +when no control action other than execution is required. + + The return construct takes one form. Any values returned by the form +are immediately returned by the loop form. It is equivalent to the +clause do (return-from block-name value), where block-name is the name +specified in a named clause, or nil if there is no named clause. + +* Menu: + +* Examples of unconditional execution:: + + +File: gcl.info, Node: Examples of unconditional execution, Prev: Unconditional Execution Clauses, Up: Unconditional Execution Clauses + +6.1.5.1 Examples of unconditional execution +........................................... + + ;; Print numbers and their squares. + ;; The DO construct applies to multiple forms. + (loop for i from 1 to 3 + do (print i) + (print (* i i))) + |> 1 + |> 1 + |> 2 + |> 4 + |> 3 + |> 9 + => NIL + + + +File: gcl.info, Node: Conditional Execution Clauses, Next: Miscellaneous Clauses, Prev: Unconditional Execution Clauses, Up: The LOOP Facility + +6.1.6 Conditional Execution Clauses +----------------------------------- + +The if, when, and unless constructs establish conditional control in a +loop. If the test passes, the succeeding loop clause is executed. If +the test does not pass, the succeeding clause is skipped, and program +control moves to the clause that follows the loop keyword else. If the +test does not pass and no else clause is supplied, control is +transferred to the clause or construct following the entire conditional +clause. + + If conditional clauses are nested, each else is paired with the +closest preceding conditional clause that has no associated else or end. + + In the if and when clauses, which are synonymous, the test passes if +the value of form is true. + + In the unless clause, the test passes if the value of form is false. + + Clauses that follow the test expression can be grouped by using the +loop keyword and to produce a conditional block consisting of a compound +clause. + + The loop keyword it can be used to refer to the result of the test +expression in a clause. Use the loop keyword it in place of the form in +a return clause or an accumulation clause that is inside a conditional +execution clause. If multiple clauses are connected with and, the it +construct must be in the first clause in the block. + + The optional loop keyword end marks the end of the clause. If this +keyword is not supplied, the next loop keyword marks the end. The +construct end can be used to distinguish the scoping of compound +clauses. + +* Menu: + +* Examples of WHEN clause:: + + +File: gcl.info, Node: Examples of WHEN clause, Prev: Conditional Execution Clauses, Up: Conditional Execution Clauses + +6.1.6.1 Examples of WHEN clause +............................... + + ;; Signal an exceptional condition. + (loop for item in '(1 2 3 a 4 5) + when (not (numberp item)) + return (cerror "enter new value" "non-numeric value: ~s" item)) + Error: non-numeric value: A + + ;; The previous example is equivalent to the following one. + (loop for item in '(1 2 3 a 4 5) + when (not (numberp item)) + do (return + (cerror "Enter new value" "non-numeric value: ~s" item))) + Error: non-numeric value: A + + ;; This example parses a simple printed string representation from + ;; BUFFER (which is itself a string) and returns the index of the + ;; closing double-quote character. + (let ((buffer "\"a\" \"b\"")) + (loop initially (unless (char= (char buffer 0) #\") + (loop-finish)) + for i of-type fixnum from 1 below (length (the string buffer)) + when (char= (char buffer i) #\") + return i)) + => 2 + + ;; The collected value is returned. + (loop for i from 1 to 10 + when (> i 5) + collect i + finally (prin1 'got-here)) + |> GOT-HERE + => (6 7 8 9 10) + + ;; Return both the count of collected numbers and the numbers. + (loop for i from 1 to 10 + when (> i 5) + collect i into number-list + and count i into number-count + finally (return (values number-count number-list))) + => 5, (6 7 8 9 10) + + +File: gcl.info, Node: Miscellaneous Clauses, Next: Examples of Miscellaneous Loop Features, Prev: Conditional Execution Clauses, Up: The LOOP Facility + +6.1.7 Miscellaneous Clauses +--------------------------- + +* Menu: + +* Control Transfer Clauses:: +* Examples of NAMED clause:: +* Initial and Final Execution:: + + +File: gcl.info, Node: Control Transfer Clauses, Next: Examples of NAMED clause, Prev: Miscellaneous Clauses, Up: Miscellaneous Clauses + +6.1.7.1 Control Transfer Clauses +................................ + +The named construct establishes a name for an implicit block surrounding +the + + entire + + loop so that the return-from special operator can be used to return +values from or to exit loop. Only one name per loop form can be +assigned. If used, the named construct must be the first clause in the +loop expression. + + The return construct takes one form. Any values returned by the form +are immediately returned by the loop form. + + This construct is similar to the return-from special operator and the +return macro. The return construct + + does not execute any finally clause that + + the loop form + + is given. + + +File: gcl.info, Node: Examples of NAMED clause, Next: Initial and Final Execution, Prev: Control Transfer Clauses, Up: Miscellaneous Clauses + +6.1.7.2 Examples of NAMED clause +................................ + + ;; Just name and return. + (loop named max + for i from 1 to 10 + do (print i) + do (return-from max 'done)) + |> 1 + => DONE + + +File: gcl.info, Node: Initial and Final Execution, Prev: Examples of NAMED clause, Up: Miscellaneous Clauses + +6.1.7.3 Initial and Final Execution +................................... + +The initially and finally constructs evaluate forms that occur before +and after the loop body. + + The initially construct causes the supplied compound-forms to be +evaluated in the loop prologue, which precedes all loop code except for +initial settings supplied by constructs with, for, or as. The code for +any initially clauses is executed in the order in which the clauses +appeared in the loop. + + The finally construct causes the supplied compound-forms to be +evaluated in the loop epilogue after normal iteration terminates. The +code for any finally clauses is executed in the order in which the +clauses appeared in the loop. The collected code is executed once in +the loop epilogue before any implicit values are returned from the +accumulation clauses. An explicit transfer of control (e.g., by return, +go, or throw) from the loop body, however, will exit the loop without +executing the epilogue code. + + Clauses such as return, always, never, and thereis can bypass the +finally clause. + + return (or return-from, if the named option was supplied) + + can be used after finally to return values from a loop. + + Such an explicit return + + inside the finally clause takes precedence over returning the +accumulation from clauses supplied by such keywords as collect, nconc, +append, sum, count, maximize, and minimize; the accumulation values for +these preempted clauses are not returned by loop if return or +return-from is used. + + +File: gcl.info, Node: Examples of Miscellaneous Loop Features, Next: Notes about Loop, Prev: Miscellaneous Clauses, Up: The LOOP Facility + +6.1.8 Examples of Miscellaneous Loop Features +--------------------------------------------- + + (let ((i 0)) ; no loop keywords are used + (loop (incf i) (if (= i 3) (return i)))) => 3 + (let ((i 0)(j 0)) + (tagbody + (loop (incf j 3) (incf i) (if (= i 3) (go exit))) + exit) + j) => 9 + + In the following example, the variable x is stepped before y is +stepped; thus, the value of y reflects the updated value of x: + + (loop for x from 1 to 10 + for y = nil then x + collect (list x y)) + => ((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10)) + + In this example, x and y are stepped in parallel: + + (loop for x from 1 to 10 + and y = nil then x + collect (list x y)) + => ((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8) (10 9)) + +* Menu: + +* Examples of clause grouping:: + + +File: gcl.info, Node: Examples of clause grouping, Prev: Examples of Miscellaneous Loop Features, Up: Examples of Miscellaneous Loop Features + +6.1.8.1 Examples of clause grouping +................................... + + ;; Group conditional clauses. + (loop for i in '(1 324 2345 323 2 4 235 252) + when (oddp i) + do (print i) + and collect i into odd-numbers + and do (terpri) + else ; I is even. + collect i into even-numbers + finally + (return (values odd-numbers even-numbers))) + |> 1 + |> + |> 2345 + |> + |> 323 + |> + |> 235 + => (1 2345 323 235), (324 2 4 252) + + ;; Collect numbers larger than 3. + (loop for i in '(1 2 3 4 5 6) + when (and (> i 3) i) + collect it) ; IT refers to (and (> i 3) i). + => (4 5 6) + + ;; Find a number in a list. + (loop for i in '(1 2 3 4 5 6) + when (and (> i 3) i) + return it) + => 4 + + ;; The above example is similar to the following one. + (loop for i in '(1 2 3 4 5 6) + thereis (and (> i 3) i)) + => 4 + + ;; Nest conditional clauses. + (let ((list '(0 3.0 apple 4 5 9.8 orange banana))) + (loop for i in list + when (numberp i) + when (floatp i) + collect i into float-numbers + else ; Not (floatp i) + collect i into other-numbers + else ; Not (numberp i) + when (symbolp i) + collect i into symbol-list + else ; Not (symbolp i) + do (error "found a funny value in list ~S, value ~S~ + finally (return (values float-numbers other-numbers symbol-list)))) + => (3.0 9.8), (0 4 5), (APPLE ORANGE BANANA) + + ;; Without the END preposition, the last AND would apply to the + ;; inner IF rather than the outer one. + (loop for x from 0 to 3 + do (print x) + if (zerop (mod x 2)) + do (princ " a") + and if (zerop (floor x 2)) + do (princ " b") + end + and do (princ " c")) + |> 0 a b c + |> 1 + |> 2 a c + |> 3 + => NIL + + +File: gcl.info, Node: Notes about Loop, Prev: Examples of Miscellaneous Loop Features, Up: The LOOP Facility + +6.1.9 Notes about Loop +---------------------- + +Types can be supplied for loop variables. It is not necessary to supply +a type for any variable, but supplying the type can ensure that the +variable has a correctly typed initial value, and it can also enable +compiler optimizations (depending on the implementation). + + The clause repeat n ... is roughly equivalent to a clause such as + + (loop for internal-variable downfrom (- n 1) to 0 ...) + + but in some implementations, the repeat construct might be more +efficient. + + Within the executable parts of the loop clauses and around the entire +loop form, variables can be bound by using let. + + Use caution when using a variable named IT (in any package) in +connection with loop, since it is a loop keyword that can be used in +place of a form in certain contexts. + + There is + + no + + standardized mechanism for users to add extensions to loop. + + +File: gcl.info, Node: Iteration Dictionary, Prev: The LOOP Facility, Up: Iteration + +6.2 Iteration Dictionary +======================== + +* Menu: + +* do:: +* dotimes:: +* dolist:: +* loop:: +* loop-finish:: + + +File: gcl.info, Node: do, Next: dotimes, Prev: Iteration Dictionary, Up: Iteration Dictionary + +6.2.1 do, do* [Macro] +--------------------- + +'do' ({var | (var [init-form [step-form]])}*) (end-test-form +{result-form}*) {declaration}* {tag | statement}* +=> {result}* + + 'do*' ({var | (var [init-form [step-form]])}*) (end-test-form +{result-form}*) {declaration}* {tag | statement}* +=> {result}* + +Arguments and Values:: +...................... + +var--a symbol. + + init-form--a form. + + step-form--a form. + + end-test-form--a form. + + result-forms--an implicit progn. + + declaration--a declare expression; not evaluated. + + tag--a go tag; not evaluated. + + statement--a compound form; evaluated as described below. + + results--if a return or return-from form is executed, the values +passed from that form; otherwise, the values returned by the +result-forms. + +Description:: +............. + +do iterates over a group of statements while a test condition holds. do +accepts an arbitrary number of iteration vars which are bound within the +iteration and stepped in parallel. An initial value may be supplied for +each iteration variable by use of an init-form. Step-forms may be used +to specify how the vars should be updated on succeeding iterations +through the loop. Step-forms may be used both to generate successive +values or to accumulate results. If the end-test-form condition is met +prior to an execution of the body, the iteration terminates. Tags label +statements. + + do* is exactly like do except that the bindings and steppings of the +vars are performed sequentially rather than in parallel. + + Before the first iteration, all the init-forms are evaluated, and +each var is bound to the value of its respective init-form, if supplied. +This is a binding, not an assignment; when the loop terminates, the old +values of those variables will be restored. For do, all of the +init-forms are evaluated before any var is bound. The init-forms can +refer to the bindings of the vars visible before beginning execution of +do. For do*, the first init-form is evaluated, then the first var is +bound to that value, then the second init-form is evaluated, then the +second var is bound, and so on; in general, the kth init-form can refer +to the new binding of the jth var if j < k, and otherwise to the old +binding of the jth var. + + At the beginning of each iteration, after processing the variables, +the end-test-form is evaluated. If the result is false, execution +proceeds with the body of the do (or do*) form. If the result is true, +the result-forms are evaluated in order as an implicit progn, and then +do or do* returns. + + At the beginning of each iteration other than the first, vars are +updated as follows. All the step-forms, if supplied, are evaluated, +from left to right, and the resulting values are assigned to the +respective vars. Any var that has no associated step-form is not +assigned to. For do, all the step-forms are evaluated before any var is +updated; the assignment of values to vars is done in parallel, as if by +psetq. Because all of the step-forms are evaluated before any of the +vars are altered, a step-form when evaluated always has access to the +old values of all the vars, even if other step-forms precede it. For +do*, the first step-form is evaluated, then the value is assigned to the +first var, then the second step-form is evaluated, then the value is +assigned to the second var, and so on; the assignment of values to +variables is done sequentially, as if by setq. For either do or do*, +after the vars have been updated, the end-test-form is evaluated as +described above, and the iteration continues. + + The remainder of the do (or do*) form constitutes an implicit +tagbody. Tags may appear within the body of a do loop for use by go +statements appearing in the body (but such go statements may not appear +in the variable specifiers, the end-test-form, or the result-forms). +When the end of a do body is reached, the next iteration cycle +(beginning with the evaluation of step-forms) occurs. + + An implicit block named nil surrounds the entire do (or do*) form. A +return statement may be used at any point to exit the loop immediately. + + Init-form is an initial value for the var with which it is +associated. If init-form is omitted, the initial value of var is nil. +If a declaration is supplied for a var, init-form must be consistent +with the declaration. + + Declarations can appear at the beginning of a do (or do*) body. They +apply to code in the do (or do*) body, to the bindings of the do (or +do*) vars, to the step-forms, to the end-test-form, and to the +result-forms. + +Examples:: +.......... + + (do ((temp-one 1 (1+ temp-one)) + (temp-two 0 (1- temp-two))) + ((> (- temp-one temp-two) 5) temp-one)) => 4 + + (do ((temp-one 1 (1+ temp-one)) + (temp-two 0 (1+ temp-one))) + ((= 3 temp-two) temp-one)) => 3 + + (do* ((temp-one 1 (1+ temp-one)) + (temp-two 0 (1+ temp-one))) + ((= 3 temp-two) temp-one)) => 2 + + (do ((j 0 (+ j 1))) + (nil) ;Do forever. + (format t "~ + (let ((item (read))) + (if (null item) (return) ;Process items until NIL seen. + (format t "~&Output ~D: ~S" j item)))) + |> Input 0: |>>banana<<| + |> Output 0: BANANA + |> Input 1: |>>(57 boxes)<<| + |> Output 1: (57 BOXES) + |> Input 2: |>>NIL<<| + => NIL + + (setq a-vector (vector 1 nil 3 nil)) + (do ((i 0 (+ i 1)) ;Sets every null element of a-vector to zero. + (n (array-dimension a-vector 0))) + ((= i n)) + (when (null (aref a-vector i)) + (setf (aref a-vector i) 0))) => NIL + a-vector => #(1 0 3 0) + + (do ((x e (cdr x)) + (oldx x x)) + ((null x)) + body) + + is an example of parallel assignment to index variables. On the +first iteration, the value of oldx is whatever value x had before the do +was entered. On succeeding iterations, oldx contains the value that x +had on the previous iteration. + + (do ((x foo (cdr x)) + (y bar (cdr y)) + (z '() (cons (f (car x) (car y)) z))) + ((or (null x) (null y)) + (nreverse z))) + + does the same thing as (mapcar #'f foo bar). The step computation +for z is an example of the fact that variables are stepped in parallel. +Also, the body of the loop is empty. + + (defun list-reverse (list) + (do ((x list (cdr x)) + (y '() (cons (car x) y))) + ((endp x) y))) + + As an example of nested iterations, consider a data structure that is +a list of conses. The car of each cons is a list of symbols, and the +cdr of each cons is a list of equal length containing corresponding +values. Such a data structure is similar to an association list, but is +divided into "frames"; the overall structure resembles a rib-cage. A +lookup function on such a data structure might be: + + (defun ribcage-lookup (sym ribcage) + (do ((r ribcage (cdr r))) + ((null r) nil) + (do ((s (caar r) (cdr s)) + (v (cdar r) (cdr v))) + ((null s)) + (when (eq (car s) sym) + (return-from ribcage-lookup (car v)))))) => RIBCAGE-LOOKUP + +See Also:: +.......... + +other iteration functions ( *note dolist:: , *note dotimes:: , and *note +loop:: ) and more primitive functionality ( *note tagbody:: , *note go:: +, *note block:: , *note return:: , + + *note let:: , and *note setq:: ) + +Notes:: +....... + +If end-test-form is nil, the test will never succeed. This provides an +idiom for "do forever": the body of the do or do* is executed +repeatedly. The infinite loop can be terminated by the use of return, +return-from, go to an outer level, or throw. + + A do form may be explained in terms of the more primitive forms +block, return, let, loop, tagbody, and psetq as follows: + + (block nil + (let ((var1 init1) + (var2 init2) + ... + (varn initn)) + declarations + (loop (when end-test (return (progn . result))) + (tagbody . tagbody) + (psetq var1 step1 + var2 step2 + ... + varn stepn)))) + + do* is similar, except that let* and setq replace the let and psetq, +respectively. + + +File: gcl.info, Node: dotimes, Next: dolist, Prev: do, Up: Iteration Dictionary + +6.2.2 dotimes [Macro] +--------------------- + +'dotimes' (var count-form [result-form]) {declaration}* {tag | +statement}* +=> {result}* + +Arguments and Values:: +...................... + +var--a symbol. + + count-form--a form. + + result-form--a form. + + declaration--a declare expression; not evaluated. + + tag--a go tag; not evaluated. + + statement--a compound form; evaluated as described below. + + results--if a return or return-from form is executed, the values +passed from that form; otherwise, the values returned by the result-form +or nil if there is no result-form. + +Description:: +............. + +dotimes iterates over a series of integers. + + dotimes evaluates count-form, which should produce an integer. If +count-form is zero or negative, the body is not executed. dotimes then +executes the body once for each integer from 0 up to but not including +the value of count-form, in the order in which the tags and statements +occur, with var bound to each integer. Then result-form is evaluated. +At the time result-form is processed, var is bound to the number of +times the body was executed. Tags label statements. + + An implicit block named nil surrounds dotimes. return may be used to +terminate the loop immediately without performing any further +iterations, returning zero or more values. + + The body of the loop is an implicit tagbody; it may contain tags to +serve as the targets of go statements. Declarations may appear before +the body of the loop. + + The scope of the binding of var does not include the count-form, but +the result-form is included. + + It is implementation-dependent whether dotimes establishes a new +binding of var on each iteration or whether it establishes a binding for +var once at the beginning and then assigns it on any subsequent +iterations. + +Examples:: +.......... + + (dotimes (temp-one 10 temp-one)) => 10 + (setq temp-two 0) => 0 + (dotimes (temp-one 10 t) (incf temp-two)) => T + temp-two => 10 + + Here is an example of the use of dotimes in processing strings: + + ;;; True if the specified subsequence of the string is a + ;;; palindrome (reads the same forwards and backwards). + (defun palindromep (string &optional + (start 0) + (end (length string))) + (dotimes (k (floor (- end start) 2) t) + (unless (char-equal (char string (+ start k)) + (char string (- end k 1))) + (return nil)))) + (palindromep "Able was I ere I saw Elba") => T + (palindromep "A man, a plan, a canal--Panama!") => NIL + (remove-if-not #'alpha-char-p ;Remove punctuation. + "A man, a plan, a canal--Panama!") + => "AmanaplanacanalPanama" + (palindromep + (remove-if-not #'alpha-char-p + "A man, a plan, a canal--Panama!")) => T + (palindromep + (remove-if-not + #'alpha-char-p + "Unremarkable was I ere I saw Elba Kramer, nu?")) => T + (palindromep + (remove-if-not + #'alpha-char-p + "A man, a plan, a cat, a ham, a yak, + a yam, a hat, a canal--Panama!")) => T + +See Also:: +.......... + +*note do:: , *note dolist:: , *note tagbody:: + +Notes:: +....... + +go may be used within the body of dotimes to transfer control to a +statement labeled by a tag. + + +File: gcl.info, Node: dolist, Next: loop, Prev: dotimes, Up: Iteration Dictionary + +6.2.3 dolist [Macro] +-------------------- + +'dolist' (var list-form [result-form]) {declaration}* {tag | statement}* +=> {result}* + +Arguments and Values:: +...................... + +var--a symbol. + + list-form--a form. + + result-form--a form. + + declaration--a declare expression; not evaluated. + + tag--a go tag; not evaluated. + + statement--a compound form; evaluated as described below. + + results--if a return or return-from form is executed, the values +passed from that form; otherwise, the values returned by the result-form +or nil if there is no result-form. + +Description:: +............. + +dolist iterates over the elements of a list. The body of dolist is like +a tagbody. It consists of a series of tags and statements. + + dolist evaluates list-form, which should produce a list. It then +executes the body once for each element in the list, in the order in +which the tags and statements occur, with var bound to the element. +Then result-form is evaluated. tags label statements. + + At the time result-form is processed, var is bound to nil. + + An implicit block named nil surrounds dolist. return may be used to +terminate the loop immediately without performing any further +iterations, returning zero or more values. + + The scope of the binding of var does not include the list-form, but +the result-form is included. + + It is implementation-dependent whether dolist establishes a new +binding of var on each iteration or whether it establishes a binding for +var once at the beginning and then assigns it on any subsequent +iterations. + +Examples:: +.......... + + (setq temp-two '()) => NIL + (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two)) => (4 3 2 1) + + (setq temp-two 0) => 0 + (dolist (temp-one '(1 2 3 4)) (incf temp-two)) => NIL + temp-two => 4 + + (dolist (x '(a b c d)) (prin1 x) (princ " ")) + |> A B C D + => NIL + +See Also:: +.......... + +*note do:: , *note dotimes:: , *note tagbody:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +go may be used within the body of dolist to transfer control to a +statement labeled by a tag. + + +File: gcl.info, Node: loop, Next: loop-finish, Prev: dolist, Up: Iteration Dictionary + +6.2.4 loop [Macro] +------------------ + +The "simple" loop form: + + 'loop' {compound-form}* => {result}* + + The "extended" loop form: + + 'loop' [!name-clause] {!variable-clause}* {!main-clause}* => +{result}* + + name-clause ::=named name + + variable-clause ::=!with-clause | !initial-final | !for-as-clause + + with-clause ::=with var1 [type-spec] [= form1] {and var2 [type-spec] [= form2]}* + + main-clause ::=!unconditional | !accumulation | !conditional | !termination-test | !initial-final + + initial-final ::=initially {compound-form}^+ | finally {compound-form}^+ + + unconditional ::={do | doing} {compound-form}^+ | return {form | it} + + accumulation ::=!list-accumulation | !numeric-accumulation + + list-accumulation ::={collect | collecting | append | appending | nconc | nconcing} {form | it} + [into simple-var] + + numeric-accumulation ::={count | counting | sum | summing | } maximize | maximizing | minimize | minimizing {form | it} + [into simple-var] [type-spec] + + conditional ::={if | when | unless} form !selectable-clause {and !selectable-clause}* + [else !selectable-clause {and !selectable-clause}*] + [end] + + selectable-clause ::=!unconditional | !accumulation | !conditional + + termination-test ::=while form | until form | repeat form | always form | never form | thereis form + + for-as-clause ::={for | as} !for-as-subclause {and !for-as-subclause}* + + for-as-subclause ::=!for-as-arithmetic | !for-as-in-list | !for-as-on-list | !for-as-equals-then | + !for-as-across | !for-as-hash | !for-as-package + + for-as-arithmetic ::=var [type-spec] !for-as-arithmetic-subclause + + for-as-arithmetic-subclause ::=!arithmetic-up | !arithmetic-downto | !arithmetic-downfrom + + arithmetic-up ::=[[{from | upfrom} form1 | {to | upto | below} form2 | by form3]]^+ + + arithmetic-downto ::=[[{from form1}^1 | {{downto | above} form2}^1 | by form3]] + + arithmetic-downfrom ::=[[{downfrom form1}^1 | {to | downto | above} form2 | by form3]] + + for-as-in-list ::=var [type-spec] in form1 [by step-fun] + + for-as-on-list ::=var [type-spec] on form1 [by step-fun] + + for-as-equals-then ::=var [type-spec] = form1 [then form2] + + for-as-across ::=var [type-spec] across vector + + for-as-hash ::=var [type-spec] being {each | the} + {{hash-key | hash-keys} {in | of} hash-table + [using (hash-value other-var)] | + {hash-value | hash-values} {in | of} hash-table + [using (hash-key other-var)]} + + for-as-package ::=var [type-spec] being {each | the} + {symbol | symbols | + present-symbol | present-symbols | + external-symbol | external-symbols} + [{in | of} package] + + type-spec ::=!simple-type-spec | !destructured-type-spec + + simple-type-spec ::=fixnum | float | t | nil + + destructured-type-spec ::=of-type d-type-spec + + d-type-spec ::=type-specifier | (d-type-spec . d-type-spec) + + var ::=!d-var-spec + + var1 ::=!d-var-spec + + var2 ::=!d-var-spec + + other-var ::=!d-var-spec + + d-var-spec ::=simple-var | nil | (!d-var-spec . !d-var-spec) + +Arguments and Values:: +...................... + +compound-form--a compound form. + + name--a symbol. + + simple-var--a symbol (a variable name). + + form, form1, form2, form3--a form. + + step-fun--a form that evaluates to a function of one argument. + + vector--a form that evaluates to a vector. + + hash-table--a form that evaluates to a hash table. + + package--a form that evaluates to a package designator. + + type-specifier--a type specifier. This might be either an atomic +type specifier or a compound type specifier, which introduces some +additional complications to proper parsing in the face of destructuring; +for further information, see *note Destructuring::. + + result--an object. + +Description:: +............. + +For details, see *note The LOOP Facility::. + +Examples:: +.......... + + ;; An example of the simple form of LOOP. + (defun sqrt-advisor () + (loop (format t "~&Number: ") + (let ((n (parse-integer (read-line) :junk-allowed t))) + (when (not n) (return)) + (format t "~&The square root of ~D is ~D.~%" n (sqrt n))))) + => SQRT-ADVISOR + (sqrt-advisor) + |> Number: |>>5 [<-~]<<| + |> The square root of 5 is 2.236068. + |> Number: |>>4 [<-~]<<| + |> The square root of 4 is 2. + |> Number: |>>done [<-~]<<| + => NIL + + ;; An example of the extended form of LOOP. + (defun square-advisor () + (loop as n = (progn (format t "~&Number: ") + (parse-integer (read-line) :junk-allowed t)) + while n + do (format t "~&The square of ~D is ~D.~ + => SQUARE-ADVISOR + (square-advisor) + |> Number: |>>4 [<-~]<<| + |> The square of 4 is 16. + |> Number: |>>23 [<-~]<<| + |> The square of 23 is 529. + |> Number: |>>done [<-~]<<| + => NIL + + ;; Another example of the extended form of LOOP. + (loop for n from 1 to 10 + when (oddp n) + collect n) + => (1 3 5 7 9) + +See Also:: +.......... + +*note do:: , *note dolist:: , *note dotimes:: , *note return:: , *note +go:: , *note throw:: , *note Destructuring:: + +Notes:: +....... + +Except that loop-finish cannot be used within a simple loop form, a +simple loop form is related to an extended loop form in the following +way: + + (loop {compound-form}*) == (loop do {compound-form}*) + + +File: gcl.info, Node: loop-finish, Prev: loop, Up: Iteration Dictionary + +6.2.5 loop-finish [Local Macro] +------------------------------- + +Syntax:: +........ + +'loop-finish' => # + +Description:: +............. + +The loop-finish macro can be used lexically within an extended loop form +to terminate that form "normally." That is, it transfers control to the +loop epilogue of the lexically innermost extended loop form. This +permits execution of any finally clause (for effect) and the return of +any accumulated result. + +Examples:: +.......... + + ;; Terminate the loop, but return the accumulated count. + (loop for i in '(1 2 3 stop-here 4 5 6) + when (symbolp i) do (loop-finish) + count i) + => 3 + + ;; The preceding loop is equivalent to: + (loop for i in '(1 2 3 stop-here 4 5 6) + until (symbolp i) + count i) + => 3 + + ;; While LOOP-FINISH can be used can be used in a variety of + ;; situations it is really most needed in a situation where a need + ;; to exit is detected at other than the loop's `top level' + ;; (where UNTIL or WHEN often work just as well), or where some + ;; computation must occur between the point where a need to exit is + ;; detected and the point where the exit actually occurs. For example: + (defun tokenize-sentence (string) + (macrolet ((add-word (wvar svar) + `(when ,wvar + (push (coerce (nreverse ,wvar) 'string) ,svar) + (setq ,wvar nil)))) + (loop with word = '() and sentence = '() and endpos = nil + for i below (length string) + do (let ((char (aref string i))) + (case char + (#\Space (add-word word sentence)) + (#\. (setq endpos (1+ i)) (loop-finish)) + (otherwise (push char word)))) + finally (add-word word sentence) + (return (values (nreverse sentence) endpos))))) + => TOKENIZE-SENTENCE + + (tokenize-sentence "this is a sentence. this is another sentence.") + => ("this" "is" "a" "sentence"), 19 + + (tokenize-sentence "this is a sentence") + => ("this" "is" "a" "sentence"), NIL + + +Side Effects:: +.............. + +Transfers control. + +Exceptional Situations:: +........................ + +Whether or not loop-finish is fbound in the global environment is +implementation-dependent; however, the restrictions on redefinition and +shadowing of loop-finish are the same as for symbols in the COMMON-LISP +package which are fbound in the global environment. The consequences of +attempting to use loop-finish outside of loop are undefined. + +See Also:: +.......... + +*note loop:: , *note The LOOP Facility:: + +Notes:: +....... + + +File: gcl.info, Node: Objects, Next: Structures, Prev: Iteration, Up: Top + +7 Objects +********* + +* Menu: + +* Object Creation and Initialization:: +* Changing the Class of an Instance:: +* Reinitializing an Instance:: +* Meta-Objects:: +* Slots:: +* Generic Functions and Methods:: +* Objects Dictionary:: + + +File: gcl.info, Node: Object Creation and Initialization, Next: Changing the Class of an Instance, Prev: Objects, Up: Objects + +7.1 Object Creation and Initialization +====================================== + +The generic function make-instance creates and returns a new instance of +a class. The first argument is a class or the name of a class, and the +remaining arguments form an initialization argument list . + + The initialization of a new instance consists of several distinct +steps, including the following: combining the explicitly supplied +initialization arguments with default values for the unsupplied +initialization arguments, checking the validity of the initialization +arguments, allocating storage for the instance, filling slots with +values, and executing user-supplied methods that perform additional +initialization. Each step of make-instance is implemented by a generic +function to provide a mechanism for customizing that step. In addition, +make-instance is itself a generic function and thus also can be +customized. + + The object system specifies system-supplied primary methods for each +step and thus specifies a well-defined standard behavior for the entire +initialization process. The standard behavior provides four simple +mechanisms for controlling initialization: + +* + Declaring a symbol to be an initialization argument for a slot. An + initialization argument is declared by using the :initarg slot + option to defclass. This provides a mechanism for supplying a + value for a slot in a call to make-instance. + +* + Supplying a default value form for an initialization argument. + Default value forms for initialization arguments are defined by + using the :default-initargs class option to defclass. If an + initialization argument is not explicitly provided as an argument + to make-instance, the default value form is evaluated in the + lexical environment of the defclass form that defined it, and the + resulting value is used as the value of the initialization + argument. + +* + Supplying a default initial value form for a slot. A default + initial value form for a slot is defined by using the :initform + slot option to defclass. If no initialization argument associated + with that slot is given as an argument to make-instance or is + defaulted by :default-initargs, this default initial value form is + evaluated in the lexical environment of the defclass form that + defined it, and the resulting value is stored in the slot. The + :initform form for a local slot may be used when creating an + instance, when updating an instance to conform to a redefined + class, or when updating an instance to conform to the definition of + a different class. The :initform form for a shared slot may be + used when defining or re-defining the class. + +* + Defining methods for initialize-instance and shared-initialize. + The slot-filling behavior described above is implemented by a + system-supplied primary method for initialize-instance which + invokes shared-initialize. The generic function shared-initialize + implements the parts of initialization shared by these four + situations: when making an instance, when re-initializing an + instance, when updating an instance to conform to a redefined + class, and when updating an instance to conform to the definition + of a different class. The system-supplied primary method for + shared-initialize directly implements the slot-filling behavior + described above, and initialize-instance simply invokes + shared-initialize. + +* Menu: + +* Initialization Arguments:: +* Declaring the Validity of Initialization Arguments:: +* Defaulting of Initialization Arguments:: +* Rules for Initialization Arguments:: +* Shared-Initialize:: +* Initialize-Instance:: +* Definitions of Make-Instance and Initialize-Instance:: + + +File: gcl.info, Node: Initialization Arguments, Next: Declaring the Validity of Initialization Arguments, Prev: Object Creation and Initialization, Up: Object Creation and Initialization + +7.1.1 Initialization Arguments +------------------------------ + +An initialization argument controls object creation and initialization. +It is often convenient to use keyword symbols to name initialization +arguments, but the name of an initialization argument can be any symbol, +including nil. An initialization argument can be used in two ways: to +fill a slot with a value or to provide an argument for an initialization +method. A single initialization argument can be used for both purposes. + + An initialization argument list is a property list of initialization +argument names and values. Its structure is identical to a property +list and also to the portion of an argument list processed for &key +parameters. As in those lists, if an initialization argument name +appears more than once in an initialization argument list, the leftmost +occurrence supplies the value and the remaining occurrences are ignored. +The arguments to make-instance (after the first argument) form an +initialization argument list. + + An initialization argument can be associated with a slot. If the +initialization argument has a value in the initialization argument list, +the value is stored into the slot of the newly created object, +overriding any :initform form associated with the slot. A single +initialization argument can initialize more than one slot. An +initialization argument that initializes a shared slot stores its value +into the shared slot, replacing any previous value. + + An initialization argument can be associated with a method. When an +object is created and a particular initialization argument is supplied, +the generic functions initialize-instance, shared-initialize, and +allocate-instance are called with that initialization argument's name +and value as a keyword argument pair. If a value for the initialization +argument is not supplied in the initialization argument list, the +method's lambda list supplies a default value. + + Initialization arguments are used in four situations: when making an +instance, when re-initializing an instance, when updating an instance to +conform to a redefined class, and when updating an instance to conform +to the definition of a different class. + + Because initialization arguments are used to control the creation and +initialization of an instance of some particular class, we say that an +initialization argument is "an initialization argument for" that class. + + +File: gcl.info, Node: Declaring the Validity of Initialization Arguments, Next: Defaulting of Initialization Arguments, Prev: Initialization Arguments, Up: Object Creation and Initialization + +7.1.2 Declaring the Validity of Initialization Arguments +-------------------------------------------------------- + +Initialization arguments are checked for validity in each of the four +situations that use them. An initialization argument may be valid in +one situation and not another. For example, the system-supplied primary +method for make-instance defined for the class standard-class checks the +validity of its initialization arguments and signals an error if an +initialization argument is supplied that is not declared as valid in +that situation. + + There are two means for declaring initialization arguments valid. + +* + Initialization arguments that fill slots are declared as valid by + the :initarg slot option to defclass. The :initarg slot option is + inherited from superclasses. Thus the set of valid initialization + arguments that fill slots for a class is the union of the + initialization arguments that fill slots declared as valid by that + class and its superclasses. Initialization arguments that fill + slots are valid in all four contexts. + +* + Initialization arguments that supply arguments to methods are + declared as valid by defining those methods. The keyword name of + each keyword parameter specified in the method's lambda list + becomes an initialization argument for all classes for which the + method is applicable. + + The presence of &allow-other-keys in the lambda list of an + applicable method disables validity checking of initialization + arguments. + + Thus method inheritance controls the set of valid initialization + arguments that supply arguments to methods. The generic functions + for which method definitions serve to declare initialization + arguments valid are as follows: + + - + Making an instance of a class: allocate-instance, + initialize-instance, and shared-initialize. Initialization + arguments declared as valid by these methods are valid when + making an instance of a class. + + - + Re-initializing an instance: reinitialize-instance and + shared-initialize. Initialization arguments declared as valid + by these methods are valid when re-initializing an instance. + + - + Updating an instance to conform to a redefined class: + update-instance-for-redefined-class and shared-initialize. + Initialization arguments declared as valid by these methods + are valid when updating an instance to conform to a redefined + class. + + - + Updating an instance to conform to the definition of a + different class: update-instance-for-different-class and + shared-initialize. Initialization arguments declared as valid + by these methods are valid when updating an instance to + conform to the definition of a different class. + + The set of valid initialization arguments for a class is the set of +valid initialization arguments that either fill slots or supply +arguments to methods, along with the predefined initialization argument +:allow-other-keys. The default value for :allow-other-keys is nil. + + Validity checking of initialization arguments is disabled if the +value of the initialization argument :allow-other-keys is true. + + +File: gcl.info, Node: Defaulting of Initialization Arguments, Next: Rules for Initialization Arguments, Prev: Declaring the Validity of Initialization Arguments, Up: Object Creation and Initialization + +7.1.3 Defaulting of Initialization Arguments +-------------------------------------------- + +A default value form can be supplied for an initialization argument by +using the :default-initargs class option. If an initialization argument +is declared valid by some particular class, its default value form might +be specified by a different class. In this case :default-initargs is +used to supply a default value for an inherited initialization argument. + + The :default-initargs option is used only to provide default values +for initialization arguments; it does not declare a symbol as a valid +initialization argument name. Furthermore, the :default-initargs option +is used only to provide default values for initialization arguments when +making an instance. + + The argument to the :default-initargs class option is a list of +alternating initialization argument names and forms. Each form is the +default value form for the corresponding initialization argument. The +default value form of an initialization argument is used and evaluated +only if that initialization argument does not appear in the arguments to +make-instance and is not defaulted by a more specific class. The +default value form is evaluated in the lexical environment of the +defclass form that supplied it; the resulting value is used as the +initialization argument's value. + + The initialization arguments supplied to make-instance are combined +with defaulted initialization arguments to produce a defaulted +initialization argument list. A defaulted initialization argument list +is a list of alternating initialization argument names and values in +which unsupplied initialization arguments are defaulted and in which the +explicitly supplied initialization arguments appear earlier in the list +than the defaulted initialization arguments. Defaulted initialization +arguments are ordered according to the order in the class precedence +list of the classes that supplied the default values. + + There is a distinction between the purposes of the :default-initargs +and the :initform options with respect to the initialization of slots. +The :default-initargs class option provides a mechanism for the user to +give a default value form for an initialization argument without knowing +whether the initialization argument initializes a slot or is passed to a +method. If that initialization argument is not explicitly supplied in a +call to make-instance, the default value form is used, just as if it had +been supplied in the call. In contrast, the :initform slot option +provides a mechanism for the user to give a default initial value form +for a slot. An :initform form is used to initialize a slot only if no +initialization argument associated with that slot is given as an +argument to make-instance or is defaulted by :default-initargs. + + The order of evaluation of default value forms for initialization +arguments and the order of evaluation of :initform forms are undefined. +If the order of evaluation is important, initialize-instance or +shared-initialize methods should be used instead. + + +File: gcl.info, Node: Rules for Initialization Arguments, Next: Shared-Initialize, Prev: Defaulting of Initialization Arguments, Up: Object Creation and Initialization + +7.1.4 Rules for Initialization Arguments +---------------------------------------- + +The :initarg slot option may be specified more than once for a given +slot. + + The following rules specify when initialization arguments may be +multiply defined: + +* + A given initialization argument can be used to initialize more than + one slot if the same initialization argument name appears in more + than one :initarg slot option. + +* + A given initialization argument name can appear in the lambda list + of more than one initialization method. + +* + A given initialization argument name can appear both in an :initarg + slot option and in the lambda list of an initialization method. + + [Reviewer Note by The next three paragraphs could be replaced by "If +two or more initialization arguments that initialize the same slot +appear in the defaulted initialization argument list, the leftmost of +these supplies the value, even if they have different names." And the +rest would follow from the rules above.] + + If two or more initialization arguments that initialize the same slot +are given in the arguments to make-instance, the leftmost of these +initialization arguments in the initialization argument list supplies +the value, even if the initialization arguments have different names. + + If two or more different initialization arguments that initialize the +same slot have default values and none is given explicitly in the +arguments to make-instance, the initialization argument that appears in +a :default-initargs class option in the most specific of the classes +supplies the value. If a single :default-initargs class option +specifies two or more initialization arguments that initialize the same +slot and none is given explicitly in the arguments to make-instance, the +leftmost in the :default-initargs class option supplies the value, and +the values of the remaining default value forms are ignored. + + Initialization arguments given explicitly in the arguments to +make-instance appear to the left of defaulted initialization arguments. +Suppose that the classes C_1 and C_2 supply the values of defaulted +initialization arguments for different slots, and suppose that C_1 is +more specific than C_2; then the defaulted initialization argument whose +value is supplied by C_1 is to the left of the defaulted initialization +argument whose value is supplied by C_2 in the defaulted initialization +argument list. If a single :default-initargs class option supplies the +values of initialization arguments for two different slots, the +initialization argument whose value is specified farther to the left in +the :default-initargs class option appears farther to the left in the +defaulted initialization argument list. + + [Reviewer Note by Barmar: End of claim made three paragraphs back.] + + If a slot has both an :initform form and an :initarg slot option, and +the initialization argument is defaulted using :default-initargs or is +supplied to make-instance, the captured :initform form is neither used +nor evaluated. + + The following is an example of the above rules: + + (defclass q () ((x :initarg a))) + (defclass r (q) ((x :initarg b)) + (:default-initargs a 1 b 2)) + + Defaulted + Form Initialization Argument List Contents of Slot X + _____________________________________________________________________________ + (make-instance 'r) (a 1 b 2) 1 + (make-instance 'r 'a 3) (a 3 b 2) 3 + (make-instance 'r 'b 4) (b 4 a 1) 4 + (make-instance 'r 'a 1 'a 2) (a 1 a 2 b 2) 1 + + + +File: gcl.info, Node: Shared-Initialize, Next: Initialize-Instance, Prev: Rules for Initialization Arguments, Up: Object Creation and Initialization + +7.1.5 Shared-Initialize +----------------------- + +The generic function shared-initialize is used to fill the slots of an +instance using initialization arguments and :initform forms when an +instance is created, when an instance is re-initialized, when an +instance is updated to conform to a redefined class, and when an +instance is updated to conform to a different class. It uses standard +method combination. It takes the following arguments: the instance to +be initialized, a specification of a set of names of slots accessible in +that instance, and any number of initialization arguments. The +arguments after the first two must form an initialization argument list. + + The second argument to shared-initialize may be one of the following: + +* + It can be a (possibly empty) list of slot names, which specifies + the set of those slot names. + +* + It can be the symbol t, which specifies the set of all of the + slots. + + There is a system-supplied primary method for shared-initialize whose +first parameter specializer is the class standard-object. This method +behaves as follows on each slot, whether shared or local: + +* + If an initialization argument in the initialization argument list + specifies a value for that slot, that value is stored into the + slot, even if a value has already been stored in the slot before + the method is run. The affected slots are independent of which + slots are indicated by the second argument to shared-initialize. + +* + Any slots indicated by the second argument that are still unbound + at this point are initialized according to their :initform forms. + For any such slot that has an :initform form, that form is + evaluated in the lexical environment of its defining defclass form + and the result is stored into the slot. For example, if a before + method stores a value in the slot, the :initform form will not be + used to supply a value for the slot. If the second argument + specifies a name that does not correspond to any slots accessible + in the instance, the results are unspecified. + +* + The rules mentioned in *note Rules for Initialization Arguments:: + are obeyed. + + The generic function shared-initialize is called by the +system-supplied primary methods for reinitialize-instance, +update-instance-for-different-class, +update-instance-for-redefined-class, and initialize-instance. Thus, +methods can be written for shared-initialize to specify actions that +should be taken in all of these contexts. + + +File: gcl.info, Node: Initialize-Instance, Next: Definitions of Make-Instance and Initialize-Instance, Prev: Shared-Initialize, Up: Object Creation and Initialization + +7.1.6 Initialize-Instance +------------------------- + +The generic function initialize-instance is called by make-instance to +initialize a newly created instance. It uses standard method +combination. Methods for initialize-instance can be defined in order to +perform any initialization that cannot be achieved simply by supplying +initial values for slots. + + During initialization, initialize-instance is invoked after the +following actions have been taken: + +* + The defaulted initialization argument list has been computed by + combining the supplied initialization argument list with any + default initialization arguments for the class. + +* + The validity of the defaulted initialization argument list has been + checked. If any of the initialization arguments has not been + declared as valid, an error is signaled. + +* + A new instance whose slots are unbound has been created. + + The generic function initialize-instance is called with the new +instance and the defaulted initialization arguments. There is a +system-supplied primary method for initialize-instance whose parameter +specializer is the class standard-object. This method calls the generic +function shared-initialize to fill in the slots according to the +initialization arguments and the :initform forms for the slots; the +generic function shared-initialize is called with the following +arguments: the instance, t, and the defaulted initialization arguments. + + Note that initialize-instance provides the defaulted initialization +argument list in its call to shared-initialize, so the first step +performed by the system-supplied primary method for shared-initialize +takes into account both the initialization arguments provided in the +call to make-instance and the defaulted initialization argument list. + + Methods for initialize-instance can be defined to specify actions to +be taken when an instance is initialized. If only after methods for +initialize-instance are defined, they will be run after the +system-supplied primary method for initialization and therefore will not +interfere with the default behavior of initialize-instance. + + The object system provides two functions that are useful in the +bodies of initialize-instance methods. The function slot-boundp returns +a generic boolean value that indicates whether a specified slot has a +value; this provides a mechanism for writing after methods for +initialize-instance that initialize slots only if they have not already +been initialized. The function slot-makunbound causes the slot to have +no value. + + +File: gcl.info, Node: Definitions of Make-Instance and Initialize-Instance, Prev: Initialize-Instance, Up: Object Creation and Initialization + +7.1.7 Definitions of Make-Instance and Initialize-Instance +---------------------------------------------------------- + +The generic function make-instance behaves as if it were defined as +follows, except that certain optimizations are permitted: + + (defmethod make-instance ((class standard-class) &rest initargs) + ... + (let ((instance (apply #'allocate-instance class initargs))) + (apply #'initialize-instance instance initargs) + instance)) + + (defmethod make-instance ((class-name symbol) &rest initargs) + (apply #'make-instance (find-class class-name) initargs)) + + The elided code in the definition of make-instance augments the +initargs with any defaulted initialization arguments and checks the +resulting initialization arguments to determine whether an +initialization argument was supplied that neither filled a slot nor +supplied an argument to an applicable method. + + The generic function initialize-instance behaves as if it were +defined as follows, except that certain optimizations are permitted: + + (defmethod initialize-instance ((instance standard-object) &rest initargs) + (apply #'shared-initialize instance t initargs))) + + These procedures can be customized. + + Customizing at the Programmer Interface level includes using the +:initform, :initarg, and :default-initargs options to defclass, as well +as defining methods for make-instance, allocate-instance, and +initialize-instance. It is also possible to define methods for +shared-initialize, which would be invoked by the generic functions +reinitialize-instance, update-instance-for-redefined-class, +update-instance-for-different-class, and initialize-instance. The +meta-object level supports additional customization. + + Implementations are permitted to make certain optimizations to +initialize-instance and shared-initialize. The description of +shared-initialize in Chapter~7 mentions the possible optimizations. + + +File: gcl.info, Node: Changing the Class of an Instance, Next: Reinitializing an Instance, Prev: Object Creation and Initialization, Up: Objects + +7.2 Changing the Class of an Instance +===================================== + +The function change-class can be used to change the class of an instance +from its current class, C_{from}, to a different class, C_{to}; it +changes the structure of the instance to conform to the definition of +the class C_{to}. + + Note that changing the class of an instance may cause slots to be +added or deleted. Changing the class of an instance does not change its +identity as defined by the eq function. + + When change-class is invoked on an instance, a two-step updating +process takes place. The first step modifies the structure of the +instance by adding new local slots and discarding local slots that are +not specified in the new version of the instance. The second step +initializes the newly added local slots and performs any other +user-defined actions. These two steps are further described in the two +following sections. + +* Menu: + +* Modifying the Structure of the Instance:: +* Initializing Newly Added Local Slots (Changing the Class of an Instance):: +* Customizing the Change of Class of an Instance:: + + +File: gcl.info, Node: Modifying the Structure of the Instance, Next: Initializing Newly Added Local Slots (Changing the Class of an Instance), Prev: Changing the Class of an Instance, Up: Changing the Class of an Instance + +7.2.1 Modifying the Structure of the Instance +--------------------------------------------- + +In order to make the instance conform to the class C_{to}, local slots +specified by the class C_{to} that are not specified by the class +C_{from} are added, and local slots not specified by the class C_{to} +that are specified by the class C_{from} are discarded. + + The values of local slots specified by both the class C_{to} and the +class C_{from} are retained. If such a local slot was unbound, it +remains unbound. + + The values of slots specified as shared in the class C_{from} and as +local in the class C_{to} are retained. + + This first step of the update does not affect the values of any +shared slots. + + +File: gcl.info, Node: Initializing Newly Added Local Slots (Changing the Class of an Instance), Next: Customizing the Change of Class of an Instance, Prev: Modifying the Structure of the Instance, Up: Changing the Class of an Instance + +7.2.2 Initializing Newly Added Local Slots +------------------------------------------ + +The second step of the update initializes the newly added slots and +performs any other user-defined actions. This step is implemented by +the generic function update-instance-for-different-class. The generic +function update-instance-for-different-class is invoked by change-class +after the first step of the update has been completed. + + The generic function update-instance-for-different-class is invoked +on arguments computed by change-class. The first argument passed is a +copy of the instance being updated and is an instance of the class +C_{from}; this copy has dynamic extent within the generic function +change-class. The second argument is the instance as updated so far by +change-class and is an instance of the class C_{to}. The remaining +arguments are an initialization argument list. + + There is a system-supplied primary method for +update-instance-for-different-class that has two parameter specializers, +each of which is the class standard-object. First this method checks +the validity of initialization arguments and signals an error if an +initialization argument is supplied that is not declared as valid. (For +more information, see *note Declaring the Validity of Initialization +Arguments::.) Then it calls the generic function shared-initialize with +the following arguments: the new instance, a list of names of the newly +added slots, and the initialization arguments it received. + + +File: gcl.info, Node: Customizing the Change of Class of an Instance, Prev: Initializing Newly Added Local Slots (Changing the Class of an Instance), Up: Changing the Class of an Instance + +7.2.3 Customizing the Change of Class of an Instance +---------------------------------------------------- + +Methods for update-instance-for-different-class may be defined to +specify actions to be taken when an instance is updated. If only after +methods for update-instance-for-different-class are defined, they will +be run after the system-supplied primary method for initialization and +will not interfere with the default behavior of +update-instance-for-different-class. + + Methods for shared-initialize may be defined to customize class +redefinition. For more information, see *note Shared-Initialize::. + + +File: gcl.info, Node: Reinitializing an Instance, Next: Meta-Objects, Prev: Changing the Class of an Instance, Up: Objects + +7.3 Reinitializing an Instance +============================== + +The generic function reinitialize-instance may be used to change the +values of slots according to initialization arguments. + + The process of reinitialization changes the values of some slots and +performs any user-defined actions. It does not modify the structure of +an instance to add or delete slots, and it does not use any :initform +forms to initialize slots. + + The generic function reinitialize-instance may be called directly. +It takes one required argument, the instance. It also takes any number +of initialization arguments to be used by methods for +reinitialize-instance or for shared-initialize. The arguments after the +required instance must form an initialization argument list. + + There is a system-supplied primary method for reinitialize-instance +whose parameter specializer is the class standard-object. First this +method checks the validity of initialization arguments and signals an +error if an initialization argument is supplied that is not declared as +valid. (For more information, see *note Declaring the Validity of +Initialization Arguments::.) Then it calls the generic function +shared-initialize with the following arguments: the instance, nil, and +the initialization arguments it received. + +* Menu: + +* Customizing Reinitialization:: + + +File: gcl.info, Node: Customizing Reinitialization, Prev: Reinitializing an Instance, Up: Reinitializing an Instance + +7.3.1 Customizing Reinitialization +---------------------------------- + +Methods for reinitialize-instance may be defined to specify actions to +be taken when an instance is updated. If only after methods for +reinitialize-instance are defined, they will be run after the +system-supplied primary method for initialization and therefore will not +interfere with the default behavior of reinitialize-instance. + + Methods for shared-initialize may be defined to customize class +redefinition. For more information, see *note Shared-Initialize::. + + +File: gcl.info, Node: Meta-Objects, Next: Slots, Prev: Reinitializing an Instance, Up: Objects + +7.4 Meta-Objects +================ + +The implementation of the object system manipulates classes, methods, +and generic functions. The object system contains a set of generic +functions defined by methods on classes; the behavior of those generic +functions defines the behavior of the object system. The instances of +the classes on which those methods are defined are called meta-objects. + +* Menu: + +* Standard Meta-objects:: + + +File: gcl.info, Node: Standard Meta-objects, Prev: Meta-Objects, Up: Meta-Objects + +7.4.1 Standard Meta-objects +--------------------------- + +The object system supplies a set of meta-objects, called standard +meta-objects. These include the class standard-object and instances of +the classes standard-method, standard-generic-function, and +method-combination. + + [Editorial Note by KMP: This is said redundantly in the definition + of STANDARD-METHOD.] +* + The class standard-method is the default class of methods defined + by the defmethod and defgeneric forms. + +* + The class standard-generic-function is the default class of generic + functions defined by the forms defmethod, defgeneric, + + and defclass. + +* + The class named standard-object is an instance of the class + standard-class and is a superclass of every class that is an + instance of standard-class except itself and structure-class. + +* + Every method combination object is an instance of a subclass of + class method-combination. + + +File: gcl.info, Node: Slots, Next: Generic Functions and Methods, Prev: Meta-Objects, Up: Objects + +7.5 Slots +========= + +* Menu: + +* Introduction to Slots:: +* Accessing Slots:: +* Inheritance of Slots and Slot Options:: + diff --git a/info/gcl.info-4 b/info/gcl.info-4 new file mode 100644 index 0000000..8501a55 --- /dev/null +++ b/info/gcl.info-4 @@ -0,0 +1,8292 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: Introduction to Slots, Next: Accessing Slots, Prev: Slots, Up: Slots + +7.5.1 Introduction to Slots +--------------------------- + +An object of metaclass standard-class has zero or more named slots. The +slots of an object are determined by the class of the object. Each slot +can hold one value. + + [Reviewer Note by Barmar: All symbols are valid variable names. +Perhaps this means to preclude the use of named constants? We have a +terminology problem to solve.] The name of a slot is a symbol that is +syntactically valid for use as a variable name. + + When a slot does not have a value, the slot is said to be unbound. +When an unbound slot is read, + + [Reviewer Note by Barmar: from an object whose metaclass is +standard-class?] the generic function slot-unbound is invoked. The +system-supplied primary method for slot-unbound on class t signals an +error. + + If slot-unbound returns, its primary value is used that time as the +value of the slot. + + The default initial value form for a slot is defined by the :initform +slot option. When the :initform form is used to supply a value, it is +evaluated in the lexical environment in which the defclass form was +evaluated. The :initform along with the lexical environment in which +the defclass form was evaluated is called a captured initialization +form. For more details, see *note Object Creation and Initialization::. + + A local slot is defined to be a slot that is accessible to exactly +one instance, namely the one in which the slot is allocated. A shared +slot is defined to be a slot that is visible to more than one instance +of a given class and its subclasses. + + A class is said to define a slot with a given name when the defclass +form for that class contains a slot specifier with that name. Defining +a local slot does not immediately create a slot; it causes a slot to be +created each time an instance of the class is created. Defining a +shared slot immediately creates a slot. + + The :allocation slot option to defclass controls the kind of slot +that is defined. If the value of the :allocation slot option is +:instance, a local slot is created. If the value of :allocation is +:class, a shared slot is created. + + A slot is said to be accessible in an instance of a class if the slot +is defined by the class of the instance or is inherited from a +superclass of that class. At most one slot of a given name can be +accessible in an instance. A shared slot defined by a class is +accessible in all instances of that class. A detailed explanation of +the inheritance of slots is given in *note Inheritance of Slots and Slot +Options::. + + +File: gcl.info, Node: Accessing Slots, Next: Inheritance of Slots and Slot Options, Prev: Introduction to Slots, Up: Slots + +7.5.2 Accessing Slots +--------------------- + +Slots can be accessed in two ways: by use of the primitive function +slot-value and by use of generic functions generated by the defclass +form. + + The function slot-value can be used with any of the slot names +specified in the defclass form to access a specific slot accessible in +an instance of the given class. + + The macro defclass provides syntax for generating methods to read and +write slots. If a reader method is requested, a method is automatically +generated for reading the value of the slot, but no method for storing a +value into it is generated. If a writer method is requested, a method +is automatically generated for storing a value into the slot, but no +method for reading its value is generated. If an accessor method is +requested, a method for reading the value of the slot and a method for +storing a value into the slot are automatically generated. Reader and +writer methods are implemented using slot-value. + + When a reader or writer method is specified for a slot, the name of +the generic function to which the generated method belongs is directly +specified. If the name specified for the writer method is the symbol +name, the name of the generic function for writing the slot is the +symbol name, and the generic function takes two arguments: the new value +and the instance, in that order. If the name specified for the accessor +method is the symbol name, the name of the generic function for reading +the slot is the symbol name, and the name of the generic function for +writing the slot is the list (setf name). + + A generic function created or modified by supplying :reader, :writer, +or :accessor slot options can be treated exactly as an ordinary generic +function. + + Note that slot-value can be used to read or write the value of a slot +whether or not reader or writer methods exist for that slot. When +slot-value is used, no reader or writer methods are invoked. + + The macro with-slots can be used to establish a lexical environment +in which specified slots are lexically available as if they were +variables. The macro with-slots invokes the function slot-value to +access the specified slots. + + The macro with-accessors can be used to establish a lexical +environment in which specified slots are lexically available through +their accessors as if they were variables. The macro with-accessors +invokes the appropriate accessors to access the specified slots. + + +File: gcl.info, Node: Inheritance of Slots and Slot Options, Prev: Accessing Slots, Up: Slots + +7.5.3 Inheritance of Slots and Slot Options +------------------------------------------- + +The set of the names of all slots accessible in an instance of a class C +is the union of the sets of names of slots defined by C and its +superclasses. The structure of an instance is the set of names of local +slots in that instance. + + In the simplest case, only one class among C and its superclasses +defines a slot with a given slot name. If a slot is defined by a +superclass of C, the slot is said to be inherited. The characteristics +of the slot are determined by the slot specifier of the defining class. +Consider the defining class for a slot S. If the value of the +:allocation slot option is :instance, then S is a local slot and each +instance of C has its own slot named S that stores its own value. If +the value of the :allocation slot option is :class, then S is a shared +slot, the class that defined S stores the value, and all instances of C +can access that single slot. If the :allocation slot option is omitted, +:instance is used. + + In general, more than one class among C and its superclasses can +define a slot with a given name. In such cases, only one slot with the +given name is accessible in an instance of C, and the characteristics of +that slot are a combination of the several slot specifiers, computed as +follows: + +* + All the slot specifiers for a given slot name are ordered from most + specific to least specific, according to the order in C's class + precedence list of the classes that define them. All references to + the specificity of slot specifiers immediately below refers to this + ordering. + +* + The allocation of a slot is controlled by the most specific slot + specifier. If the most specific slot specifier does not contain an + :allocation slot option, :instance is used. Less specific slot + specifiers do not affect the allocation. + +* + The default initial value form for a slot is the value of the + :initform slot option in the most specific slot specifier that + contains one. If no slot specifier contains an :initform slot + option, the slot has no default initial value form. + +* + The contents of a slot will always be of type (and T_1 ... T_n) + where T_1 ... T_n are the values of the :type slot options + contained in all of the slot specifiers. If no slot specifier + contains the :type slot option, the contents of the slot will + always be of type t. The consequences of attempting to store in a + slot a value that does not satisfy the type of the slot are + undefined. + +* + The set of initialization arguments that initialize a given slot is + the union of the initialization arguments declared in the :initarg + slot options in all the slot specifiers. + +* + The documentation string for a slot is the value of the + :documentation slot option in the most specific slot specifier that + contains one. If no slot specifier contains a :documentation slot + option, the slot has no documentation string. + + A consequence of the allocation rule is that a shared slot can be +shadowed. For example, if a class C_1 defines a slot named S whose +value for the :allocation slot option is :class, that slot is accessible +in instances of C_1 and all of its subclasses. However, if C_2 is a +subclass of C_1 and also defines a slot named S, C_1's slot is not +shared by instances of C_2 and its subclasses. When a class C_1 defines +a shared slot, any subclass C_2 of C_1 will share this single slot +unless the defclass form for C_2 specifies a slot of the same name or +there is a superclass of C_2 that precedes C_1 in the class precedence +list of C_2 that defines a slot of the same name. + + A consequence of the type rule is that the value of a slot satisfies +the type constraint of each slot specifier that contributes to that +slot. Because the result of attempting to store in a slot a value that +does not satisfy the type constraint for the slot is undefined, the +value in a slot might fail to satisfy its type constraint. + + The :reader, :writer, and :accessor slot options create methods +rather than define the characteristics of a slot. Reader and writer +methods are inherited in the sense described in *note Inheritance of +Methods::. + + Methods that access slots use only the name of the slot and the type +of the slot's value. Suppose a superclass provides a method that +expects to access a shared slot of a given name, and a subclass defines +a local slot with the same name. If the method provided by the +superclass is used on an instance of the subclass, the method accesses +the local slot. + + +File: gcl.info, Node: Generic Functions and Methods, Next: Objects Dictionary, Prev: Slots, Up: Objects + +7.6 Generic Functions and Methods +================================= + +* Menu: + +* Introduction to Generic Functions:: +* Introduction to Methods:: +* Agreement on Parameter Specializers and Qualifiers:: +* Congruent Lambda-lists for all Methods of a Generic Function:: +* Keyword Arguments in Generic Functions and Methods:: +* Method Selection and Combination:: +* Inheritance of Methods:: + + +File: gcl.info, Node: Introduction to Generic Functions, Next: Introduction to Methods, Prev: Generic Functions and Methods, Up: Generic Functions and Methods + +7.6.1 Introduction to Generic Functions +--------------------------------------- + +A generic function is a function whose behavior depends on the classes +or identities of the arguments supplied to it. A generic function +object is associated with a set of methods, a lambda list, a method +combination_2, and other information. + + Like an ordinary function, a generic function takes arguments, +performs a series of operations, and perhaps returns useful values. An +ordinary function has a single body of code that is always executed when +the function is called. A generic function has a set of bodies of code +of which a subset is selected for execution. The selected bodies of +code and the manner of their combination are determined by the classes +or identities of one or more of the arguments to the generic function +and by its method combination. + + Ordinary functions and generic functions are called with identical +syntax. + + Generic functions are true functions that can be passed as arguments +and used as the first argument to funcall and apply. + + A binding of a function name to a generic function can be established +in one of several ways. It can be established in the global environment +by ensure-generic-function, defmethod (implicitly, due to +ensure-generic-function) or defgeneric (also implicitly, due to +ensure-generic-function). + + No standardized mechanism is provided for establishing a binding of a +function name to a generic function in the lexical environment. + + When a defgeneric form is evaluated, one of three actions is taken +(due to ensure-generic-function): + +* + If a generic function of the given name already exists, the + existing generic function object is modified. Methods specified by + the current defgeneric form are added, and any methods in the + existing generic function that were defined by a previous + defgeneric form are removed. Methods added by the current + defgeneric form might replace methods defined by defmethod, + defclass, define-condition, or defstruct. No other methods in the + generic function are affected or replaced. + +* + If the given name names an ordinary function, a macro, or a special + operator, an error is signaled. + +* + Otherwise a generic function is created with the methods specified + by the method definitions in the defgeneric form. + + Some operators permit specification of the options of a generic +function, such as the type of method combination it uses or its argument +precedence order. These operators will be referred to as "operators +that specify generic function options." + + The only standardized operator in this category is defgeneric. + + Some operators define methods for a generic function. These +operators will be referred to as method-defining operators ; their +associated forms are called method-defining forms. The standardized +method-defining operators are listed in Figure 7-2. + + defgeneric defmethod defclass + define-condition defstruct + + Figure 7-2: Standardized Method-Defining Operators + + + Note that of the standardized method-defining operators only +defgeneric can specify generic function options. defgeneric and any +implementation-defined operators that can specify generic function +options are also referred to as "operators that specify generic function +options." + + +File: gcl.info, Node: Introduction to Methods, Next: Agreement on Parameter Specializers and Qualifiers, Prev: Introduction to Generic Functions, Up: Generic Functions and Methods + +7.6.2 Introduction to Methods +----------------------------- + +Methods define the class-specific or identity-specific behavior and +operations of a generic function. + + A method object is associated with code that implements the method's +behavior, a sequence of parameter specializers that specify when the +given method is applicable, a lambda list, and a sequence of qualifiers +that are used by the method combination facility to distinguish among +methods. + + A method object is not a function and cannot be invoked as a +function. Various mechanisms in the object system take a method object +and invoke its method function, as is the case when a generic function +is invoked. When this occurs it is said that the method is invoked or +called. + + A method-defining form contains the code that is to be run when the +arguments to the generic function cause the method that it defines to be +invoked. When a method-defining form is evaluated, a method object is +created and one of four actions is taken: + +* + If a generic function of the given name already exists and if a + method object already exists that agrees with the new one on + parameter specializers and qualifiers, the new method object + replaces the old one. For a definition of one method agreeing with + another on parameter specializers and qualifiers, see *note + Agreement on Parameter Specializers and Qualifiers::. + +* + If a generic function of the given name already exists and if there + is no method object that agrees with the new one on parameter + specializers and qualifiers, the existing generic function object + is modified to contain the new method object. + +* + If the given name names an ordinary function, a macro, or a special + operator, an error is signaled. + +* + Otherwise a generic function is created with the method specified + by the method-defining form. + + If the lambda list of a new method is not congruent with the lambda +list of the generic function, an error is signaled. If a +method-defining operator that cannot specify generic function options +creates a new generic function, a lambda list for that generic function +is derived from the lambda list of the method in the method-defining +form in such a way as to be congruent with it. For a discussion of +congruence , see *note Congruent Lambda-lists for all Methods of a +Generic Function::. + + Each method has a specialized lambda list, which determines when that +method can be applied. A specialized lambda list is like an ordinary +lambda list except that a specialized parameter may occur instead of the +name of a required parameter. A specialized parameter is a list +(variable-name parameter-specializer-name), where +parameter-specializer-name is one of the following: + +a symbol + denotes a parameter specializer which is the class named by that + symbol. + +a class + denotes a parameter specializer which is the class itself. + +(eql form) + denotes a parameter specializer which satisfies the type specifier + (eql object), where object is the result of evaluating form. The + form form is evaluated in the lexical environment in which the + method-defining form is evaluated. Note that form is evaluated + only once, at the time the method is defined, not each time the + generic function is called. + + Parameter specializer names are used in macros intended as the +user-level interface (defmethod), while parameter specializers are used +in the functional interface. + + Only required parameters may be specialized, and there must be a +parameter specializer for each required parameter. For notational +simplicity, if some required parameter in a specialized lambda list in a +method-defining form is simply a variable name, its parameter +specializer defaults to the class t. + + Given a generic function and a set of arguments, an applicable method +is a method for that generic function whose parameter specializers are +satisfied by their corresponding arguments. The following definition +specifies what it means for a method to be applicable and for an +argument to satisfy a parameter specializer. + + Let < A_1, ..., A_n> be the required arguments to a generic function +in order. Let < P_1, ..., P_n> be the parameter specializers +corresponding to the required parameters of the method M in order. The +method M is applicable when each A_i is of the type specified by the +type specifier P_i. Because every valid parameter specializer is also a +valid type specifier, the function typep can be used during method +selection to determine whether an argument satisfies a parameter +specializer. + + A method all of whose parameter specializers are the class t is +called a default method ; it is always applicable but may be shadowed by +a more specific method. + + Methods can have qualifiers, which give the method combination +procedure a way to distinguish among methods. A method that has one or +more qualifiers is called a qualified method. A method with no +qualifiers is called an unqualified method. A qualifier is any +non-list. The qualifiers defined by the standardized method combination +types are symbols. + + In this specification, the terms "primary method" and "auxiliary +method" are used to partition methods within a method combination type +according to their intended use. In standard method combination, +primary methods are unqualified methods and auxiliary methods are +methods with a single qualifier that is one of :around, :before, or +:after. Methods with these qualifiers are called around methods, before +methods, and after methods, respectively. When a method combination +type is defined using the short form of define-method-combination, +primary methods are methods qualified with the name of the type of +method combination, and auxiliary methods have the qualifier :around. +Thus the terms "primary method" and "auxiliary method" have only a +relative definition within a given method combination type. + + +File: gcl.info, Node: Agreement on Parameter Specializers and Qualifiers, Next: Congruent Lambda-lists for all Methods of a Generic Function, Prev: Introduction to Methods, Up: Generic Functions and Methods + +7.6.3 Agreement on Parameter Specializers and Qualifiers +-------------------------------------------------------- + +Two methods are said to agree with each other on parameter specializers +and qualifiers if the following conditions hold: + +1. + Both methods have the same number of required parameters. Suppose + the parameter specializers of the two methods are P_{1,1}... + P_{1,n} and P_{2,1}... P_{2,n}. + +2. + For each 1<= i<= n, P_{1,i} agrees with P_{2,i}. The parameter + specializer P_{1,i} agrees with P_{2,i} if P_{1,i} and P_{2,i} are + the same class or if P_{1,i}=(eql object_1), P_{2,i}=(eql + object_2), and (eql object_1 object_2). Otherwise P_{1,i} and + P_{2,i} do not agree. + +3. + The two lists of qualifiers are the same under equal. + + +File: gcl.info, Node: Congruent Lambda-lists for all Methods of a Generic Function, Next: Keyword Arguments in Generic Functions and Methods, Prev: Agreement on Parameter Specializers and Qualifiers, Up: Generic Functions and Methods + +7.6.4 Congruent Lambda-lists for all Methods of a Generic Function +------------------------------------------------------------------ + +These rules define the congruence of a set of lambda lists, including +the lambda list of each method for a given generic function and the +lambda list specified for the generic function itself, if given. + +1. + Each lambda list must have the same number of required parameters. + +2. + Each lambda list must have the same number of optional parameters. + Each method can supply its own default for an optional parameter. + +3. + If any lambda list mentions &rest or &key, each lambda list must + mention one or both of them. + +4. + If the generic function lambda list mentions &key, each method must + accept all of the keyword names mentioned after &key, either by + accepting them explicitly, by specifying &allow-other-keys, or by + specifying &rest but not &key. Each method can accept additional + keyword arguments of its own. The checking of the validity of + keyword names is done in the generic function, not in each method. + A method is invoked as if the keyword argument pair whose name is + :allow-other-keys and whose value is true were supplied, though no + such argument pair will be passed. + +5. + The use of &allow-other-keys need not be consistent across lambda + lists. If &allow-other-keys is mentioned in the lambda list of any + applicable method or of the generic function, any keyword arguments + may be mentioned in the call to the generic function. + +6. + The use of &aux need not be consistent across methods. + + If a method-defining operator that cannot specify generic function + options creates a generic function, and if the lambda list for the + method mentions keyword arguments, the lambda list of the generic + function will mention &key (but no keyword arguments). + + +File: gcl.info, Node: Keyword Arguments in Generic Functions and Methods, Next: Method Selection and Combination, Prev: Congruent Lambda-lists for all Methods of a Generic Function, Up: Generic Functions and Methods + +7.6.5 Keyword Arguments in Generic Functions and Methods +-------------------------------------------------------- + +When a generic function or any of its methods mentions &key in a lambda +list, the specific set of keyword arguments accepted by the generic +function varies according to the applicable methods. The set of keyword +arguments accepted by the generic function for a particular call is the +union of the keyword arguments accepted by all applicable methods and +the keyword arguments mentioned after &key in the generic function +definition, if any. A method that has &rest but not &key does not +affect the set of acceptable keyword arguments. If the lambda list of +any applicable method or of the generic function definition contains +&allow-other-keys, all keyword arguments are accepted by the generic +function. + + The lambda list congruence rules require that each method accept all +of the keyword arguments mentioned after &key in the generic function +definition, by accepting them explicitly, by specifying +&allow-other-keys, or by specifying &rest but not &key. Each method can +accept additional keyword arguments of its own, in addition to the +keyword arguments mentioned in the generic function definition. + + If a generic function is passed a keyword argument that no applicable +method accepts, an error should be signaled; see *note Error Checking in +Function Calls::. + +* Menu: + +* Examples of Keyword Arguments in Generic Functions and Methods:: + + +File: gcl.info, Node: Examples of Keyword Arguments in Generic Functions and Methods, Prev: Keyword Arguments in Generic Functions and Methods, Up: Keyword Arguments in Generic Functions and Methods + +7.6.5.1 Examples of Keyword Arguments in Generic Functions and Methods +...................................................................... + +For example, suppose there are two methods defined for width as follows: + + (defmethod width ((c character-class) &key font) ...) + + (defmethod width ((p picture-class) &key pixel-size) ...) + +Assume that there are no other methods and no generic function +definition for width. The evaluation of the following form should +signal an error because the keyword argument :pixel-size is not accepted +by the applicable method. + + (width (make-instance `character-class :char #\Q) + :font 'baskerville :pixel-size 10) + + The evaluation of the following form should signal an error. + + (width (make-instance `picture-class :glyph (glyph #\Q)) + :font 'baskerville :pixel-size 10) + + The evaluation of the following form will not signal an error if the +class named character-picture-class is a subclass of both picture-class +and character-class. + + (width (make-instance `character-picture-class :char #\Q) + :font 'baskerville :pixel-size 10) + + +File: gcl.info, Node: Method Selection and Combination, Next: Inheritance of Methods, Prev: Keyword Arguments in Generic Functions and Methods, Up: Generic Functions and Methods + +7.6.6 Method Selection and Combination +-------------------------------------- + +When a generic function is called with particular arguments, it must +determine the code to execute. This code is called the effective method +for those arguments. The effective method is a combination of the +applicable methods in the generic function that calls some or all of the +methods. + + If a generic function is called and no methods are applicable, the +generic function no-applicable-method is invoked, with the results from +that call being used as the results of the call to the original generic +function. Calling no-applicable-method takes precedence over checking +for acceptable keyword arguments; see *note Keyword Arguments in Generic +Functions and Methods::. + + When the effective method has been determined, it is invoked with the +same arguments as were passed to the generic function. Whatever values +it returns are returned as the values of the generic function. + +* Menu: + +* Determining the Effective Method:: +* Selecting the Applicable Methods:: +* Sorting the Applicable Methods by Precedence Order:: +* Applying method combination to the sorted list of applicable methods:: +* Standard Method Combination:: +* Declarative Method Combination:: +* Built-in Method Combination Types:: + + +File: gcl.info, Node: Determining the Effective Method, Next: Selecting the Applicable Methods, Prev: Method Selection and Combination, Up: Method Selection and Combination + +7.6.6.1 Determining the Effective Method +........................................ + +The effective method is determined by the following three-step +procedure: + +1. + Select the applicable methods. + +2. + Sort the applicable methods by precedence order, putting the most + specific method first. + +3. + Apply method combination to the sorted list of applicable methods, + producing the effective method. + + +File: gcl.info, Node: Selecting the Applicable Methods, Next: Sorting the Applicable Methods by Precedence Order, Prev: Determining the Effective Method, Up: Method Selection and Combination + +7.6.6.2 Selecting the Applicable Methods +........................................ + +This step is described in *note Introduction to Methods::. + + +File: gcl.info, Node: Sorting the Applicable Methods by Precedence Order, Next: Applying method combination to the sorted list of applicable methods, Prev: Selecting the Applicable Methods, Up: Method Selection and Combination + +7.6.6.3 Sorting the Applicable Methods by Precedence Order +.......................................................... + +To compare the precedence of two methods, their parameter specializers +are examined in order. The default examination order is from left to +right, but an alternative order may be specified by the +:argument-precedence-order option to defgeneric or to any of the other +operators that specify generic function options. + + The corresponding parameter specializers from each method are +compared. When a pair of parameter specializers agree, the next pair +are compared for agreement. If all corresponding parameter specializers +agree, the two methods must have different qualifiers; in this case, +either method can be selected to precede the other. For information +about agreement, see *note Agreement on Parameter Specializers and +Qualifiers::. + + If some corresponding parameter specializers do not agree, the first +pair of parameter specializers that do not agree determines the +precedence. If both parameter specializers are classes, the more +specific of the two methods is the method whose parameter specializer +appears earlier in the class precedence list of the corresponding +argument. Because of the way in which the set of applicable methods is +chosen, the parameter specializers are guaranteed to be present in the +class precedence list of the class of the argument. + + If just one of a pair of corresponding parameter specializers is (eql +object), the method with that parameter specializer precedes the other +method. If both parameter specializers are eql expressions, the +specializers must agree (otherwise the two methods would not both have +been applicable to this argument). + + The resulting list of applicable methods has the most specific method +first and the least specific method last. + + +File: gcl.info, Node: Applying method combination to the sorted list of applicable methods, Next: Standard Method Combination, Prev: Sorting the Applicable Methods by Precedence Order, Up: Method Selection and Combination + +7.6.6.4 Applying method combination to the sorted list of applicable methods +............................................................................ + +In the simple case--if standard method combination is used and all +applicable methods are primary methods--the effective method is the most +specific method. That method can call the next most specific method by +using the function call-next-method. The method that call-next-method +will call is referred to as the next method . The predicate +next-method-p tests whether a next method exists. If call-next-method +is called and there is no next most specific method, the generic +function no-next-method is invoked. + + In general, the effective method is some combination of the +applicable methods. It is described by a form that contains calls to +some or all of the applicable methods, returns the value or values that +will be returned as the value or values of the generic function, and +optionally makes some of the methods accessible by means of +call-next-method. + + The role of each method in the effective method is determined by its +qualifiers and the specificity of the method. A qualifier serves to +mark a method, and the meaning of a qualifier is determined by the way +that these marks are used by this step of the procedure. If an +applicable method has an unrecognized qualifier, this step signals an +error and does not include that method in the effective method. + + When standard method combination is used together with qualified +methods, the effective method is produced as described in *note Standard +Method Combination::. + + Another type of method combination can be specified by using the +:method-combination option of defgeneric or of any of the other +operators that specify generic function options. In this way this step +of the procedure can be customized. + + New types of method combination can be defined by using the +define-method-combination macro. + + +File: gcl.info, Node: Standard Method Combination, Next: Declarative Method Combination, Prev: Applying method combination to the sorted list of applicable methods, Up: Method Selection and Combination + +7.6.6.5 Standard Method Combination +................................... + +Standard method combination is supported by the class +standard-generic-function. It is used if no other type of method +combination is specified or if the built-in method combination type +standard is specified. + + Primary methods define the main action of the effective method, while +auxiliary methods modify that action in one of three ways. A primary +method has no method qualifiers. + + An auxiliary method is a method whose qualifier is :before, :after, +or :around. Standard method combination allows no more than one +qualifier per method; if a method definition specifies more than one +qualifier per method, an error is signaled. + +* + A before method has the keyword :before as its only qualifier. A + before method specifies code that is to be run before any primary + methods. + +* + An after method has the keyword :after as its only qualifier. An + after method specifies code that is to be run after primary + methods. + +* + An around method has the keyword :around as its only qualifier. An + around method specifies code that is to be run instead of other + applicable methods, but which might contain explicit code which + calls some of those shadowed methods (via call-next-method). + + The semantics of standard method combination is as follows: + +* + If there are any around methods, the most specific around method is + called. It supplies the value or values of the generic function. + +* + Inside the body of an around method, call-next-method can be used + to call the next method. When the next method returns, the around + method can execute more code, perhaps based on the returned value + or values. The generic function no-next-method is invoked if + call-next-method is used and there is no applicable method to call. + The function next-method-p may be used to determine whether a next + method exists. + +* + If an around method invokes call-next-method, the next most + specific around method is called, if one is applicable. If there + are no around methods or if call-next-method is called by the least + specific around method, the other methods are called as follows: + + - + All the before methods are called, in most-specific-first + order. Their values are ignored. An error is signaled if + call-next-method is used in a before method. + + - + The most specific primary method is called. Inside the body + of a primary method, call-next-method may be used to call the + next most specific primary method. When that method returns, + the previous primary method can execute more code, perhaps + based on the returned value or values. The generic function + no-next-method is invoked if call-next-method is used and + there are no more applicable primary methods. The function + next-method-p may be used to determine whether a next method + exists. If call-next-method is not used, only the most + specific primary method is called. + + - + All the after methods are called in most-specific-last order. + Their values are ignored. An error is signaled if + call-next-method is used in an after method. + +* + If no around methods were invoked, the most specific primary method + supplies the value or values returned by the generic function. The + value or values returned by the invocation of call-next-method in + the least specific around method are those returned by the most + specific primary method. + + In standard method combination, if there is an applicable method but +no applicable primary method, an error is signaled. + + The before methods are run in most-specific-first order while the +after methods are run in least-specific-first order. The design +rationale for this difference can be illustrated with an example. +Suppose class C_1 modifies the behavior of its superclass, C_2, by +adding before methods and after methods. Whether the behavior of the +class C_2 is defined directly by methods on C_2 or is inherited from its +superclasses does not affect the relative order of invocation of methods +on instances of the class C_1. Class C_1's before method runs before +all of class C_2's methods. Class C_1's after method runs after all of +class C_2's methods. + + By contrast, all around methods run before any other methods run. +Thus a less specific around method runs before a more specific primary +method. + + If only primary methods are used and if call-next-method is not used, +only the most specific method is invoked; that is, more specific methods +shadow more general ones. + + +File: gcl.info, Node: Declarative Method Combination, Next: Built-in Method Combination Types, Prev: Standard Method Combination, Up: Method Selection and Combination + +7.6.6.6 Declarative Method Combination +...................................... + +The macro define-method-combination defines new forms of method +combination. It provides a mechanism for customizing the production of +the effective method. The default procedure for producing an effective +method is described in *note Determining the Effective Method::. There +are two forms of define-method-combination. The short form is a simple +facility while the long form is more powerful and more verbose. The +long form resembles defmacro in that the body is an expression that +computes a Lisp form; it provides mechanisms for implementing arbitrary +control structures within method combination and for arbitrary +processing of method qualifiers. + + +File: gcl.info, Node: Built-in Method Combination Types, Prev: Declarative Method Combination, Up: Method Selection and Combination + +7.6.6.7 Built-in Method Combination Types +......................................... + +The object system provides a set of built-in method combination types. +To specify that a generic function is to use one of these method +combination types, the name of the method combination type is given as +the argument to the :method-combination option to defgeneric or to the +:method-combination option to any of the other operators that specify +generic function options. + + The names of the built-in method combination types are listed in +Figure 7-3. + + + append max nconc progn + and list min or standard + + Figure 7-3: Built-in Method Combination Types + + + The semantics of the standard built-in method combination type is +described in *note Standard Method Combination::. The other built-in +method combination types are called simple built-in method combination +types. + + The simple built-in method combination types act as though they were +defined by the short form of define-method-combination. They recognize +two roles for methods: + +* + An around method has the keyword symbol :around as its sole + qualifier. The meaning of :around methods is the same as in + standard method combination. Use of the functions call-next-method + and next-method-p is supported in around methods. + +* + A primary method has the name of the method combination type as its + sole qualifier. For example, the built-in method combination type + and recognizes methods whose sole qualifier is and; these are + primary methods. Use of the functions call-next-method and + next-method-p is not supported in primary methods. + + The semantics of the simple built-in method combination types is as +follows: + +* + If there are any around methods, the most specific around method is + called. It supplies the value or values of the generic function. + +* + Inside the body of an around method, the function call-next-method + can be used to call the next method. The generic function + no-next-method is invoked if call-next-method is used and there is + no applicable method to call. The function next-method-p may be + used to determine whether a next method exists. When the next + method returns, the around method can execute more code, perhaps + based on the returned value or values. + +* + If an around method invokes call-next-method, the next most + specific around method is called, if one is applicable. If there + are no around methods or if call-next-method is called by the least + specific around method, a Lisp form derived from the name of the + built-in method combination type and from the list of applicable + primary methods is evaluated to produce the value of the generic + function. Suppose the name of the method combination type is + operator and the call to the generic function is of the form + + (generic-function a_1... a_n) + + Let M_1,...,M_k be the applicable primary methods in order; then + the derived Lisp form is + + (operator < M_1 + a_1... a_n>...< M_k a_1... a_n>) + + If the expression < M_i a_1... a_n> is evaluated, the method M_i + will be applied to the arguments a_1... a_n. For example, if + operator is or, the expression < M_i a_1... a_n> is evaluated only + if < M_j a_1... a_n>, 1<= j keys, allow-other-keys-p + +Method Signatures:: +................... + +'function-keywords' (method standard-method) + +Arguments and Values:: +...................... + +method--a method. + + keys--a list. + + allow-other-keys-p--a generalized boolean. + +Description:: +............. + +Returns the keyword parameter specifiers for a method. + + Two values are returned: a list of the explicitly named keywords and +a generalized boolean that states whether &allow-other-keys had been +specified in the method definition. + +Examples:: +.......... + + (defmethod gf1 ((a integer) &optional (b 2) + &key (c 3) ((:dee d) 4) e ((eff f))) + (list a b c d e f)) + => # + (find-method #'gf1 '() (list (find-class 'integer))) + => # + (function-keywords *) + => (:C :DEE :E EFF), false + (defmethod gf2 ((a integer)) + (list a b c d e f)) + => # + (function-keywords (find-method #'gf1 '() (list (find-class 'integer)))) + => (), false + (defmethod gf3 ((a integer) &key b c d &allow-other-keys) + (list a b c d e f)) + (function-keywords *) + => (:B :C :D), true + +Affected By:: +............. + +defmethod + +See Also:: +.......... + +*note defmethod:: + + +File: gcl.info, Node: ensure-generic-function, Next: allocate-instance, Prev: function-keywords, Up: Objects Dictionary + +7.7.2 ensure-generic-function [Function] +---------------------------------------- + +'ensure-generic-function' function-name &key argument-precedence-order +declare documentation environment generic-function-class lambda-list +method-class method-combination +=> generic-function + +Arguments and Values:: +...................... + +function-name--a function name. + + The keyword arguments correspond to the option arguments of +defgeneric, except that the :method-class and :generic-function-class +arguments can be class objects as well as names. + + Method-combination - method combination object. + + Environment - the same as the &environment argument to macro +expansion functions and is used to distinguish between compile-time and +run-time environments. + + [Editorial Note by KMP: What about documentation. Missing from this +arguments enumeration, and confusing in description below.] + + generic-function--a generic function object. + +Description:: +............. + +The function ensure-generic-function is used to define a globally named +generic function with no methods or to specify or modify options and +declarations that pertain to a globally named generic function as a +whole. + + If function-name is not fbound in the global environment, a new +generic function is created. If + + (fdefinition function-name) + + is an ordinary function, a macro, or a special operator, an error is +signaled. + + If function-name is a list, it must be of the form (setf symbol). If +function-name specifies a generic function that has a different value +for any of the following arguments, the generic function is modified to +have the new value: :argument-precedence-order, :declare, +:documentation, :method-combination. + + If function-name specifies a generic function that has a different +value for the :lambda-list argument, and the new value is congruent with +the lambda lists of all existing methods or there are no methods, the +value is changed; otherwise an error is signaled. + + If function-name specifies a generic function that has a different +value for the :generic-function-class argument and if the new generic +function class is compatible with the old, change-class is called to +change the class of the generic function; otherwise an error is +signaled. + + If function-name specifies a generic function that has a different +value for the :method-class argument, the value is changed, but any +existing methods are not changed. + +Affected By:: +............. + +Existing function binding of function-name. + +Exceptional Situations:: +........................ + +If + + (fdefinition function-name) + + is an ordinary function, a macro, or a special operator, an error of +type error is signaled. + + If function-name specifies a generic function that has a different +value for the :lambda-list argument, and the new value is not congruent +with the lambda list of any existing method, an error of type error is +signaled. + + If function-name specifies a generic function that has a different +value for the :generic-function-class argument and if the new generic +function class not is compatible with the old, an error of type error is +signaled. + +See Also:: +.......... + +*note defgeneric:: + + +File: gcl.info, Node: allocate-instance, Next: reinitialize-instance, Prev: ensure-generic-function, Up: Objects Dictionary + +7.7.3 allocate-instance [Standard Generic Function] +--------------------------------------------------- + +Syntax:: +........ + +'allocate-instance' class &rest initargs &key &allow-other-keys => +new-instance + +Method Signatures:: +................... + +'allocate-instance' (class standard-class) &rest initargs + + 'allocate-instance' (class structure-class) &rest initargs + +Arguments and Values:: +...................... + +class--a class. + + initargs--a list of keyword/value pairs (initialization argument +names and values). + + new-instance--an object whose class is class. + +Description:: +............. + +The generic function allocate-instance creates and returns a new +instance of the class, without initializing it. When the class is a +standard class, this means that the slots are unbound; when the class is +a structure class, this means the slots' values are unspecified. + + The caller of allocate-instance is expected to have already checked +the initialization arguments. + + The generic function allocate-instance is called by make-instance, as +described in *note Object Creation and Initialization::. + +See Also:: +.......... + +*note defclass:: , *note make-instance:: , *note class-of:: , *note +Object Creation and Initialization:: + +Notes:: +....... + +The consequences of adding methods to allocate-instance is unspecified. +This capability might be added by the Metaobject Protocol. + + +File: gcl.info, Node: reinitialize-instance, Next: shared-initialize, Prev: allocate-instance, Up: Objects Dictionary + +7.7.4 reinitialize-instance [Standard Generic Function] +------------------------------------------------------- + +Syntax:: +........ + +'reinitialize-instance' instance &rest initargs &key &allow-other-keys +=> instance + +Method Signatures:: +................... + +'reinitialize-instance' (instance standard-object) &rest initargs + +Arguments and Values:: +...................... + +instance--an object. + + initargs--an initialization argument list. + +Description:: +............. + +The generic function reinitialize-instance can be used to change the +values of local slots of an instance according to initargs. This +generic function can be called by users. + + The system-supplied primary method for reinitialize-instance checks +the validity of initargs and signals an error if an initarg is supplied +that is not declared as valid. The method then calls the generic +function shared-initialize with the following arguments: the instance, +nil (which means no slots should be initialized according to their +initforms), and the initargs it received. + +Side Effects:: +.............. + +The generic function reinitialize-instance changes the values of local +slots. + +Exceptional Situations:: +........................ + +The system-supplied primary method for reinitialize-instance signals an +error if an initarg is supplied that is not declared as valid. + +See Also:: +.......... + +*note Initialize-Instance:: , *note Shared-Initialize:: , *note +update-instance-for-redefined-class:: , *note +update-instance-for-different-class:: , *note slot-boundp:: , *note +slot-makunbound:: , *note Reinitializing an Instance::, *note Rules for +Initialization Arguments::, *note Declaring the Validity of +Initialization Arguments:: + +Notes:: +....... + +Initargs are declared as valid by using the :initarg option to defclass, +or by defining methods for reinitialize-instance or shared-initialize. +The keyword name of each keyword parameter specifier in the lambda list +of any method defined on reinitialize-instance or shared-initialize is +declared as a valid initialization argument name for all classes for +which that method is applicable. + + +File: gcl.info, Node: shared-initialize, Next: update-instance-for-different-class, Prev: reinitialize-instance, Up: Objects Dictionary + +7.7.5 shared-initialize [Standard Generic Function] +--------------------------------------------------- + +Syntax:: +........ + +'shared-initialize' instance slot-names &rest initargs &key +&allow-other-keys => instance + +Method Signatures:: +................... + +'shared-initialize' (instance standard-object) slot-names &rest initargs + +Arguments and Values:: +...................... + +instance--an object. + + slot-names--a list or t. + + initargs--a list of keyword/value pairs (of initialization argument +names and values). + +Description:: +............. + +The generic function shared-initialize is used to fill the slots of an +instance using initargs and :initform forms. It is called when an +instance is created, when an instance is re-initialized, when an +instance is updated to conform to a redefined class, and when an +instance is updated to conform to a different class. The generic +function shared-initialize is called by the system-supplied primary +method for initialize-instance, reinitialize-instance, +update-instance-for-redefined-class, and +update-instance-for-different-class. + + The generic function shared-initialize takes the following arguments: +the instance to be initialized, a specification of a set of slot-names +accessible in that instance, and any number of initargs. The arguments +after the first two must form an initialization argument list. The +system-supplied primary method on shared-initialize initializes the +slots with values according to the initargs and supplied :initform +forms. Slot-names indicates which slots should be initialized according +to their :initform forms if no initargs are provided for those slots. + + The system-supplied primary method behaves as follows, regardless of +whether the slots are local or shared: + +* + If an initarg in the initialization argument list specifies a value + for that slot, that value is stored into the slot, even if a value + has already been stored in the slot before the method is run. + +* + Any slots indicated by slot-names that are still unbound at this + point are initialized according to their :initform forms. For any + such slot that has an :initform form, that form is evaluated in the + lexical environment of its defining defclass form and the result is + stored into the slot. For example, if a before method stores a + value in the slot, the :initform form will not be used to supply a + value for the slot. + +* + The rules mentioned in *note Rules for Initialization Arguments:: + are obeyed. + + The slots-names argument specifies the slots that are to be +initialized according to their :initform forms if no initialization +arguments apply. It can be a list of slot names, which specifies the +set of those slot names; or it can be the symbol t, which specifies the +set of all of the slots. + +See Also:: +.......... + +*note Initialize-Instance:: , *note reinitialize-instance:: , *note +update-instance-for-redefined-class:: , *note +update-instance-for-different-class:: , *note slot-boundp:: , *note +slot-makunbound:: , *note Object Creation and Initialization::, *note +Rules for Initialization Arguments::, *note Declaring the Validity of +Initialization Arguments:: + +Notes:: +....... + +Initargs are declared as valid by using the :initarg option to defclass, +or by defining methods for shared-initialize. The keyword name of each +keyword parameter specifier in the lambda list of any method defined on +shared-initialize is declared as a valid initarg name for all classes +for which that method is applicable. + + Implementations are permitted to optimize :initform forms that +neither produce nor depend on side effects, by evaluating these forms +and storing them into slots before running any initialize-instance +methods, rather than by handling them in the primary initialize-instance +method. (This optimization might be implemented by having the +allocate-instance method copy a prototype instance.) + + Implementations are permitted to optimize default initial value forms +for initargs associated with slots by not actually creating the complete +initialization argument list when the only method that would receive the +complete list is the method on standard-object. In this case default +initial value forms can be treated like :initform forms. This +optimization has no visible effects other than a performance +improvement. + + +File: gcl.info, Node: update-instance-for-different-class, Next: update-instance-for-redefined-class, Prev: shared-initialize, Up: Objects Dictionary + +7.7.6 update-instance-for-different-class [Standard Generic Function] +--------------------------------------------------------------------- + +Syntax:: +........ + +'update-instance-for-different-class' previous current &rest initargs +&key &allow-other-keys => implementation-dependent + +Method Signatures:: +................... + +'update-instance-for-different-class' (previous standard-object) +(current standard-object) &rest initargs + +Arguments and Values:: +...................... + +previous--a copy of the original instance. + + current--the original instance (altered). + + initargs--an initialization argument list. + +Description:: +............. + +The generic function update-instance-for-different-class is not intended +to be called by programmers. Programmers may write methods for it. The +function update-instance-for-different-class is called only by the +function change-class. + + The system-supplied primary method on +update-instance-for-different-class checks the validity of initargs and +signals an error if an initarg is supplied that is not declared as +valid. This method then initializes slots with values according to the +initargs, and initializes the newly added slots with values according to +their :initform forms. It does this by calling the generic function +shared-initialize with the following arguments: the instance (current), +a list of names of the newly added slots, and the initargs it received. +Newly added slots are those local slots for which no slot of the same +name exists in the previous class. + + Methods for update-instance-for-different-class can be defined to +specify actions to be taken when an instance is updated. If only after +methods for update-instance-for-different-class are defined, they will +be run after the system-supplied primary method for initialization and +therefore will not interfere with the default behavior of +update-instance-for-different-class. + + Methods on update-instance-for-different-class can be defined to +initialize slots differently from change-class. The default behavior of +change-class is described in *note Changing the Class of an Instance::. + + The arguments to update-instance-for-different-class are computed by +change-class. When change-class is invoked on an instance, a copy of +that instance is made; change-class then destructively alters the +original instance. The first argument to +update-instance-for-different-class, previous, is that copy; it holds +the old slot values temporarily. This argument has dynamic extent +within change-class; if it is referenced in any way once +update-instance-for-different-class returns, the results are undefined. +The second argument to update-instance-for-different-class, current, is +the altered original instance. The intended use of previous is to +extract old slot values by using slot-value or with-slots or by invoking +a reader generic function, or to run other methods that were applicable +to instances of the original class. + +Examples:: +.......... + +See the example for the function change-class. + +Exceptional Situations:: +........................ + +The system-supplied primary method on +update-instance-for-different-class signals an error if an +initialization argument is supplied that is not declared as valid. + +See Also:: +.......... + +*note change-class:: , *note Shared-Initialize:: , *note Changing the +Class of an Instance::, *note Rules for Initialization Arguments::, +*note Declaring the Validity of Initialization Arguments:: + +Notes:: +....... + +Initargs are declared as valid by using the :initarg option to defclass, +or by defining methods for update-instance-for-different-class or +shared-initialize. The keyword name of each keyword parameter specifier +in the lambda list of any method defined on +update-instance-for-different-class or shared-initialize is declared as +a valid initarg name for all classes for which that method is +applicable. + + The value returned by update-instance-for-different-class is ignored +by change-class. + + +File: gcl.info, Node: update-instance-for-redefined-class, Next: change-class, Prev: update-instance-for-different-class, Up: Objects Dictionary + +7.7.7 update-instance-for-redefined-class [Standard Generic Function] +--------------------------------------------------------------------- + +Syntax:: +........ + +'update-instance-for-redefined-class' instance added-slots +discarded-slots property-list &rest initargs &key &allow-other-keys +=> {result}* + +Method Signatures:: +................... + +'update-instance-for-redefined-class' (instance standard-object) +added-slots discarded-slots property-list &rest initargs + +Arguments and Values:: +...................... + +instance--an object. + + added-slots--a list. + + discarded-slots--a list. + + property-list--a list. + + initargs--an initialization argument list. + + result--an object. + +Description:: +............. + +The generic function update-instance-for-redefined-class is not intended +to be called by programmers. Programmers may write methods for it. The +generic function update-instance-for-redefined-class is called by the +mechanism activated by make-instances-obsolete. + + The system-supplied primary method on +update-instance-for-redefined-class checks the validity of initargs and +signals an error if an initarg is supplied that is not declared as +valid. This method then initializes slots with values according to the +initargs, and initializes the newly added-slots with values according to +their :initform forms. It does this by calling the generic function +shared-initialize with the following arguments: the instance, a list of +names of the newly added-slots to instance, and the initargs it +received. Newly added-slots are those local slots for which no slot of +the same name exists in the old version of the class. + + When make-instances-obsolete is invoked or when a class has been +redefined and an instance is being updated, a property-list is created +that captures the slot names and values of all the discarded-slots with +values in the original instance. The structure of the instance is +transformed so that it conforms to the current class definition. The +arguments to update-instance-for-redefined-class are this transformed +instance, a list of added-slots to the instance, a list discarded-slots +from the instance, and the property-list containing the slot names and +values for slots that were discarded and had values. Included in this +list of discarded slots are slots that were local in the old class and +are shared in the new class. + + The value returned by update-instance-for-redefined-class is ignored. + +Examples:: +.......... + + + (defclass position () ()) + + (defclass x-y-position (position) + ((x :initform 0 :accessor position-x) + (y :initform 0 :accessor position-y))) + + ;;; It turns out polar coordinates are used more than Cartesian + ;;; coordinates, so the representation is altered and some new + ;;; accessor methods are added. + + (defmethod update-instance-for-redefined-class :before + ((pos x-y-position) added deleted plist &key) + ;; Transform the x-y coordinates to polar coordinates + ;; and store into the new slots. + (let ((x (getf plist 'x)) + (y (getf plist 'y))) + (setf (position-rho pos) (sqrt (+ (* x x) (* y y))) + (position-theta pos) (atan y x)))) + + (defclass x-y-position (position) + ((rho :initform 0 :accessor position-rho) + (theta :initform 0 :accessor position-theta))) + + ;;; All instances of the old x-y-position class will be updated + ;;; automatically. + + ;;; The new representation is given the look and feel of the old one. + + (defmethod position-x ((pos x-y-position)) + (with-slots (rho theta) pos (* rho (cos theta)))) + + (defmethod (setf position-x) (new-x (pos x-y-position)) + (with-slots (rho theta) pos + (let ((y (position-y pos))) + (setq rho (sqrt (+ (* new-x new-x) (* y y))) + theta (atan y new-x)) + new-x))) + + (defmethod position-y ((pos x-y-position)) + (with-slots (rho theta) pos (* rho (sin theta)))) + + (defmethod (setf position-y) (new-y (pos x-y-position)) + (with-slots (rho theta) pos + (let ((x (position-x pos))) + (setq rho (sqrt (+ (* x x) (* new-y new-y))) + theta (atan new-y x)) + new-y))) + + +Exceptional Situations:: +........................ + +The system-supplied primary method on +update-instance-for-redefined-class signals an error if an initarg is +supplied that is not declared as valid. + +See Also:: +.......... + +*note make-instances-obsolete:: , *note Shared-Initialize:: , *note +Redefining Classes::, *note Rules for Initialization Arguments::, *note +Declaring the Validity of Initialization Arguments:: + +Notes:: +....... + +Initargs are declared as valid by using the :initarg option to defclass, +or by defining methods for update-instance-for-redefined-class or +shared-initialize. The keyword name of each keyword parameter specifier +in the lambda list of any method defined on +update-instance-for-redefined-class or shared-initialize is declared as +a valid initarg name for all classes for which that method is +applicable. + + +File: gcl.info, Node: change-class, Next: slot-boundp, Prev: update-instance-for-redefined-class, Up: Objects Dictionary + +7.7.8 change-class [Standard Generic Function] +---------------------------------------------- + +Syntax:: +........ + +'change-class' instance new-class &key &allow-other-keys => instance + +Method Signatures:: +................... + +'change-class' (instance standard-object) (new-class standard-class) +&rest initargs + + 'change-class' (instance t) (new-class symbol) &rest initargs + +Arguments and Values:: +...................... + +instance--an object. + + new-class--a class designator. + + initargs--an initialization argument list. + +Description:: +............. + +The generic function change-class changes the class of an instance to +new-class. It destructively modifies and returns the instance. + + If in the old class there is any slot of the same name as a local +slot in the new-class, the value of that slot is retained. This means +that if the slot has a value, the value returned by slot-value after +change-class is invoked is eql to the value returned by slot-value +before change-class is invoked. Similarly, if the slot was unbound, it +remains unbound. The other slots are initialized as described in *note +Changing the Class of an Instance::. + + After completing all other actions, change-class invokes +update-instance-for-different-class. The generic function +update-instance-for-different-class can be used to assign values to +slots in the transformed instance. + + See *note Initializing Newly Added Local Slots (Changing the Class of +an Instance)::. + + If the second of the above methods is selected, that method invokes +change-class on instance, (find-class new-class), and the initargs. + +Examples:: +.......... + + + (defclass position () ()) + + (defclass x-y-position (position) + ((x :initform 0 :initarg :x) + (y :initform 0 :initarg :y))) + + (defclass rho-theta-position (position) + ((rho :initform 0) + (theta :initform 0))) + + (defmethod update-instance-for-different-class :before ((old x-y-position) + (new rho-theta-position) + &key) + ;; Copy the position information from old to new to make new + ;; be a rho-theta-position at the same position as old. + (let ((x (slot-value old 'x)) + (y (slot-value old 'y))) + (setf (slot-value new 'rho) (sqrt (+ (* x x) (* y y))) + (slot-value new 'theta) (atan y x)))) + + ;;; At this point an instance of the class x-y-position can be + ;;; changed to be an instance of the class rho-theta-position using + ;;; change-class: + + (setq p1 (make-instance 'x-y-position :x 2 :y 0)) + + (change-class p1 'rho-theta-position) + + ;;; The result is that the instance bound to p1 is now an instance of + ;;; the class rho-theta-position. The update-instance-for-different-class + ;;; method performed the initialization of the rho and theta slots based + ;;; on the value of the x and y slots, which were maintained by + ;;; the old instance. + + +See Also:: +.......... + +*note update-instance-for-different-class:: , *note Changing the Class +of an Instance:: + +Notes:: +....... + +The generic function change-class has several semantic difficulties. +First, it performs a destructive operation that can be invoked within a +method on an instance that was used to select that method. When +multiple methods are involved because methods are being combined, the +methods currently executing or about to be executed may no longer be +applicable. Second, some implementations might use compiler +optimizations of slot access, and when the class of an instance is +changed the assumptions the compiler made might be violated. This +implies that a programmer must not use change-class inside a method if +any methods for that generic function access any slots, or the results +are undefined. + + +File: gcl.info, Node: slot-boundp, Next: slot-exists-p, Prev: change-class, Up: Objects Dictionary + +7.7.9 slot-boundp [Function] +---------------------------- + +'slot-boundp' instance slot-name => generalized-boolean + +Arguments and Values:: +...................... + +instance--an object. + + slot-name--a symbol naming a slot of instance. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if the slot named slot-name in instance is bound; +otherwise, returns false. + +Exceptional Situations:: +........................ + +If no slot of the name slot-name exists in the instance, slot-missing is +called as follows: + + (slot-missing (class-of instance) + instance + slot-name + 'slot-boundp) + + (If slot-missing is invoked and returns a value, a boolean equivalent +to its primary value is returned by slot-boundp.) + + The specific behavior depends on instance's metaclass. An error is +never signaled if instance has metaclass standard-class. An error is +always signaled if instance has metaclass built-in-class. The +consequences are undefined if instance has any other metaclass-an error +might or might not be signaled in this situation. Note in particular +that the behavior for conditions and structures is not specified. + +See Also:: +.......... + +*note slot-makunbound:: , *note slot-missing:: + +Notes:: +....... + +The function slot-boundp allows for writing after methods on +initialize-instance in order to initialize only those slots that have +not already been bound. + + Although no implementation is required to do so, implementors are +strongly encouraged to implement the function slot-boundp using the +function slot-boundp-using-class described in the Metaobject Protocol. + + +File: gcl.info, Node: slot-exists-p, Next: slot-makunbound, Prev: slot-boundp, Up: Objects Dictionary + +7.7.10 slot-exists-p [Function] +------------------------------- + +'slot-exists-p' object slot-name => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + slot-name--a symbol. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if the object has a slot named slot-name. + +Affected By:: +............. + +defclass, defstruct + +See Also:: +.......... + +*note defclass:: , *note slot-missing:: + +Notes:: +....... + +Although no implementation is required to do so, implementors are +strongly encouraged to implement the function slot-exists-p using the +function slot-exists-p-using-class described in the Metaobject Protocol. + + +File: gcl.info, Node: slot-makunbound, Next: slot-missing, Prev: slot-exists-p, Up: Objects Dictionary + +7.7.11 slot-makunbound [Function] +--------------------------------- + +'slot-makunbound' instance slot-name => instance + +Arguments and Values:: +...................... + +instance - instance. + + Slot-name--a symbol. + +Description:: +............. + +The function slot-makunbound restores a slot of the name slot-name in an +instance to the unbound state. + +Exceptional Situations:: +........................ + +If no slot of the name slot-name exists in the instance, slot-missing is +called as follows: + + (slot-missing (class-of instance) + instance + slot-name + 'slot-makunbound) + + (Any values returned by slot-missing in this case are ignored by +slot-makunbound.) + + The specific behavior depends on instance's metaclass. An error is +never signaled if instance has metaclass standard-class. An error is +always signaled if instance has metaclass built-in-class. The +consequences are undefined if instance has any other metaclass-an error +might or might not be signaled in this situation. Note in particular +that the behavior for conditions and structures is not specified. + +See Also:: +.......... + +*note slot-boundp:: , *note slot-missing:: + +Notes:: +....... + +Although no implementation is required to do so, implementors are +strongly encouraged to implement the function slot-makunbound using the +function slot-makunbound-using-class described in the Metaobject +Protocol. + + +File: gcl.info, Node: slot-missing, Next: slot-unbound, Prev: slot-makunbound, Up: Objects Dictionary + +7.7.12 slot-missing [Standard Generic Function] +----------------------------------------------- + +Syntax:: +........ + +'slot-missing' class object slot-name operation &optional new-value => +{result}* + +Method Signatures:: +................... + +'slot-missing' (class t) object slot-name operation &optional new-value + +Arguments and Values:: +...................... + +class--the class of object. + + object--an object. + + slot-name--a symbol (the name of a would-be slot). + + operation--one of the symbols setf, slot-boundp, slot-makunbound, or +slot-value. + + new-value--an object. + + result--an object. + +Description:: +............. + +The generic function slot-missing is invoked when an attempt is made to +access a slot in an object whose metaclass is standard-class and the +slot of the name slot-name is not a name of a slot in that class. The +default method signals an error. + + The generic function slot-missing is not intended to be called by +programmers. Programmers may write methods for it. + + The generic function slot-missing may be called during evaluation of +slot-value, (setf slot-value), slot-boundp, and slot-makunbound. For +each of these operations the corresponding symbol for the operation +argument is slot-value, setf, slot-boundp, and slot-makunbound +respectively. + + The optional new-value argument to slot-missing is used when the +operation is attempting to set the value of the slot. + + If slot-missing returns, its values will be treated as follows: + +* + If the operation is setf or slot-makunbound, any values will be + ignored by the caller. + +* + If the operation is slot-value, only the primary value will be used + by the caller, and all other values will be ignored. + +* + If the operation is slot-boundp, any boolean equivalent of the + primary value of the method might be is used, and all other values + will be ignored. + +Exceptional Situations:: +........................ + +The default method on slot-missing signals an error of type error. + +See Also:: +.......... + +*note defclass:: , *note slot-exists-p:: , *note slot-value:: + +Notes:: +....... + +The set of arguments (including the class of the instance) facilitates +defining methods on the metaclass for slot-missing. + + +File: gcl.info, Node: slot-unbound, Next: slot-value, Prev: slot-missing, Up: Objects Dictionary + +7.7.13 slot-unbound [Standard Generic Function] +----------------------------------------------- + +Syntax:: +........ + +'slot-unbound' class instance slot-name => {result}* + +Method Signatures:: +................... + +'slot-unbound' (class t) instance slot-name + +Arguments and Values:: +...................... + +class--the class of the instance. + + instance--the instance in which an attempt was made to read the +unbound slot. + + slot-name--the name of the unbound slot. + + result--an object. + +Description:: +............. + +The generic function slot-unbound is called when an unbound slot is read +in an instance whose metaclass is standard-class. The default method +signals an error + + of type unbound-slot. The name slot of the unbound-slot condition is +initialized to the name of the offending variable, and the instance slot +of the unbound-slot condition is initialized to the offending instance. + + The generic function slot-unbound is not intended to be called by +programmers. Programmers may write methods for it. The function +slot-unbound is called only indirectly by slot-value. + + If slot-unbound returns, only the primary value will be used by the +caller, and all other values will be ignored. + +Exceptional Situations:: +........................ + +The default method on slot-unbound signals an error of type +unbound-slot. + +See Also:: +.......... + +*note slot-makunbound:: + +Notes:: +....... + +An unbound slot may occur if no :initform form was specified for the +slot and the slot value has not been set, or if slot-makunbound has been +called on the slot. + + +File: gcl.info, Node: slot-value, Next: method-qualifiers, Prev: slot-unbound, Up: Objects Dictionary + +7.7.14 slot-value [Function] +---------------------------- + +'slot-value' object slot-name => value + +Arguments and Values:: +...................... + +object--an object. + + name--a symbol. + + value--an object. + +Description:: +............. + +The function slot-value returns the value of the slot named slot-name in +the object. If there is no slot named slot-name, slot-missing is +called. If the slot is unbound, slot-unbound is called. + + The macro setf can be used with slot-value to change the value of a +slot. + +Examples:: +.......... + + (defclass foo () + ((a :accessor foo-a :initarg :a :initform 1) + (b :accessor foo-b :initarg :b) + (c :accessor foo-c :initform 3))) + => # + (setq foo1 (make-instance 'foo :a 'one :b 'two)) + => # + (slot-value foo1 'a) => ONE + (slot-value foo1 'b) => TWO + (slot-value foo1 'c) => 3 + (setf (slot-value foo1 'a) 'uno) => UNO + (slot-value foo1 'a) => UNO + (defmethod foo-method ((x foo)) + (slot-value x 'a)) + => # + (foo-method foo1) => UNO + +Exceptional Situations:: +........................ + +If an attempt is made to read a slot and no slot of the name slot-name +exists in the object, slot-missing is called as follows: + + (slot-missing (class-of instance) + instance + slot-name + 'slot-value) + + (If slot-missing is invoked, its primary value is returned by +slot-value.) + + If an attempt is made to write a slot and no slot of the name +slot-name exists in the object, slot-missing is called as follows: + + (slot-missing (class-of instance) + instance + slot-name + 'setf + new-value) + + (If slot-missing returns in this case, any values are ignored.) + + The specific behavior depends on object's metaclass. An error is +never signaled if object has metaclass standard-class. An error is +always signaled if object has metaclass built-in-class. The +consequences are unspecified if object has any other metaclass-an error +might or might not be signaled in this situation. Note in particular +that the behavior for conditions and structures is not specified. + +See Also:: +.......... + +*note slot-missing:: , *note slot-unbound:: , *note with-slots:: + +Notes:: +....... + +Although no implementation is required to do so, implementors are +strongly encouraged to implement the function slot-value using the +function slot-value-using-class described in the Metaobject Protocol. + + Implementations may optimize slot-value by compiling it inline. + + +File: gcl.info, Node: method-qualifiers, Next: no-applicable-method, Prev: slot-value, Up: Objects Dictionary + +7.7.15 method-qualifiers [Standard Generic Function] +---------------------------------------------------- + +Syntax:: +........ + +'method-qualifiers' method => qualifiers + +Method Signatures:: +................... + +'method-qualifiers' (method standard-method) + +Arguments and Values:: +...................... + +method--a method. + + qualifiers--a proper list. + +Description:: +............. + +Returns a list of the qualifiers of the method. + +Examples:: +.......... + + (defmethod some-gf :before ((a integer)) a) + => # + (method-qualifiers *) => (:BEFORE) + +See Also:: +.......... + +*note define-method-combination:: + + +File: gcl.info, Node: no-applicable-method, Next: no-next-method, Prev: method-qualifiers, Up: Objects Dictionary + +7.7.16 no-applicable-method [Standard Generic Function] +------------------------------------------------------- + +Syntax:: +........ + +'no-applicable-method' generic-function &rest function-arguments => +{result}* + +Method Signatures:: +................... + +'no-applicable-method' (generic-function t) &rest function-arguments + +Arguments and Values:: +...................... + +generic-function--a generic function on which no applicable method was +found. + + function-arguments--arguments to the generic-function. + + result--an object. + +Description:: +............. + +The generic function no-applicable-method is called when a generic +function is invoked and no method on that generic function is +applicable. The default method signals an error. + + The generic function no-applicable-method is not intended to be +called by programmers. Programmers may write methods for it. + +Exceptional Situations:: +........................ + +The default method signals an error of type error. + +See Also:: +.......... + + +File: gcl.info, Node: no-next-method, Next: remove-method, Prev: no-applicable-method, Up: Objects Dictionary + +7.7.17 no-next-method [Standard Generic Function] +------------------------------------------------- + +Syntax:: +........ + +'no-next-method' generic-function method &rest args => {result}* + +Method Signatures:: +................... + +'no-next-method' (generic-function standard-generic-function) (method +standard-method) &rest args + +Arguments and Values:: +...................... + +generic-function - generic function to which method belongs. + + method - method that contained the call to call-next-method for which +there is no next method. + + args - arguments to call-next-method. + + result--an object. + +Description:: +............. + +The generic function no-next-method is called by call-next-method when +there is no next method. + + The generic function no-next-method is not intended to be called by +programmers. Programmers may write methods for it. + +Exceptional Situations:: +........................ + +The system-supplied method on no-next-method signals an error of type +error. [Editorial Note by KMP: perhaps control-error??] + +See Also:: +.......... + +*note call-next-method:: + + +File: gcl.info, Node: remove-method, Next: make-instance, Prev: no-next-method, Up: Objects Dictionary + +7.7.18 remove-method [Standard Generic Function] +------------------------------------------------ + +Syntax:: +........ + +'remove-method' generic-function method => generic-function + +Method Signatures:: +................... + +'remove-method' (generic-function standard-generic-function) method + +Arguments and Values:: +...................... + +generic-function--a generic function. + + method--a method. + +Description:: +............. + +The generic function remove-method removes a method from +generic-function by modifying the generic-function (if necessary). + + remove-method must not signal an error if the method is not one of +the methods on the generic-function. + +See Also:: +.......... + +*note find-method:: + + +File: gcl.info, Node: make-instance, Next: make-instances-obsolete, Prev: remove-method, Up: Objects Dictionary + +7.7.19 make-instance [Standard Generic Function] +------------------------------------------------ + +Syntax:: +........ + +'make-instance' class &rest initargs &key &allow-other-keys => instance + +Method Signatures:: +................... + +'make-instance' (class standard-class) &rest initargs + + 'make-instance' (class symbol) &rest initargs + +Arguments and Values:: +...................... + +class--a class, or a symbol that names a class. + + initargs--an initialization argument list. + + instance--a fresh instance of class class. + +Description:: +............. + +The generic function make-instance creates and returns a new instance of +the given class. + + If the second of the above methods is selected, that method invokes +make-instance on the arguments (find-class class) and initargs. + + The initialization arguments are checked within make-instance. + + The generic function make-instance may be used as described in *note +Object Creation and Initialization::. + +Exceptional Situations:: +........................ + +If any of the initialization arguments has not been declared as valid, +an error of type error is signaled. + +See Also:: +.......... + +*note defclass:: , *note class-of:: , *note allocate-instance:: , *note +Initialize-Instance:: , *note Object Creation and Initialization:: + + +File: gcl.info, Node: make-instances-obsolete, Next: make-load-form, Prev: make-instance, Up: Objects Dictionary + +7.7.20 make-instances-obsolete [Standard Generic Function] +---------------------------------------------------------- + +Syntax:: +........ + +'make-instances-obsolete' class => class + +Method Signatures:: +................... + +'make-instances-obsolete' (class standard-class) + + 'make-instances-obsolete' (class symbol) + +Arguments and Values:: +...................... + +class--a class designator. + +Description:: +............. + +The function make-instances-obsolete has the effect of initiating the +process of updating the instances of the class. During updating, the +generic function update-instance-for-redefined-class will be invoked. + + The generic function make-instances-obsolete is invoked automatically +by the system when defclass has been used to redefine an existing +standard class and the set of local slots accessible in an instance is +changed or the order of slots in storage is changed. It can also be +explicitly invoked by the user. + + If the second of the above methods is selected, that method invokes +make-instances-obsolete on (find-class class). + +Examples:: +.......... + +See Also:: +.......... + +*note update-instance-for-redefined-class:: , *note Redefining Classes:: + + +File: gcl.info, Node: make-load-form, Next: make-load-form-saving-slots, Prev: make-instances-obsolete, Up: Objects Dictionary + +7.7.21 make-load-form [Standard Generic Function] +------------------------------------------------- + +Syntax:: +........ + +'make-load-form' object &optional environment => creation-form [, +initialization-form ] + +Method Signatures:: +................... + +'make-load-form' (object standard-object) &optional environment + + 'make-load-form' (object structure-object) &optional environment + + 'make-load-form' (object condition) &optional environment + + 'make-load-form' (object class) &optional environment + +Arguments and Values:: +...................... + +object--an object. + + environment--an environment object. + + creation-form--a form. + + initialization-form--a form. + +Description:: +............. + +The generic function make-load-form creates and returns one or two +forms, a creation-form and an initialization-form, that enable load to +construct an object equivalent to object. Environment is an environment +object corresponding to the lexical environment in which the forms will +be processed. + + The file compiler calls make-load-form to process certain classes of +literal objects; see *note Additional Constraints on Externalizable +Objects::. + + Conforming programs may call make-load-form directly, providing +object is a generalized instance of standard-object, structure-object, +or condition. + + The creation form is a form that, when evaluated at load time, should +return an object that is equivalent to object. The exact meaning of +equivalent depends on the type of object and is up to the programmer who +defines a method for make-load-form; see *note Literal Objects in +Compiled Files::. + + The initialization form is a form that, when evaluated at load time, +should perform further initialization of the object. The value returned +by the initialization form is ignored. If make-load-form returns only +one value, the initialization form is nil, which has no effect. If +object appears as a constant in the initialization form, at load time it +will be replaced by the equivalent object constructed by the creation +form; this is how the further initialization gains access to the object. + + Both the creation-form and the initialization-form may contain +references to any externalizable object. However, there must not be any +circular dependencies in creation forms. An example of a circular +dependency is when the creation form for the object X contains a +reference to the object Y, and the creation form for the object Y +contains a reference to the object X. Initialization forms are not +subject to any restriction against circular dependencies, which is the +reason that initialization forms exist; see the example of circular data +structures below. + + The creation form for an object is always evaluated before the +initialization form for that object. When either the creation form or +the initialization form references other objects that have not been +referenced earlier in the file being compiled, the compiler ensures that +all of the referenced objects have been created before evaluating the +referencing form. When the referenced object is of a type which the +file compiler processes using make-load-form, this involves evaluating +the creation form returned for it. (This is the reason for the +prohibition against circular references among creation forms). + + Each initialization form is evaluated as soon as possible after its +associated creation form, as determined by data flow. If the +initialization form for an object does not reference any other objects +not referenced earlier in the file and processed by the file compiler +using make-load-form, the initialization form is evaluated immediately +after the creation form. If a creation or initialization form F does +contain references to such objects, the creation forms for those other +objects are evaluated before F, and the initialization forms for those +other objects are also evaluated before F whenever they do not depend on +the object created or initialized by F. Where these rules do not +uniquely determine an order of evaluation between two +creation/initialization forms, the order of evaluation is unspecified. + + While these creation and initialization forms are being evaluated, +the objects are possibly in an uninitialized state, analogous to the +state of an object between the time it has been created by +allocate-instance and it has been processed fully by +initialize-instance. Programmers writing methods for make-load-form +must take care in manipulating objects not to depend on slots that have +not yet been initialized. + + It is implementation-dependent whether load calls eval on the forms +or does some other operation that has an equivalent effect. For +example, the forms might be translated into different but equivalent +forms and then evaluated, they might be compiled and the resulting +functions called by load, or they might be interpreted by a +special-purpose function different from eval. All that is required is +that the effect be equivalent to evaluating the forms. + + The method specialized on class returns a creation form using the +name of the class if the class has a proper name in environment, +signaling an error of type error if it does not have a proper name. +Evaluation of the creation form uses the name to find the class with +that name, as if by calling find-class. If a class with that name has +not been defined, then a class may be computed in an +implementation-defined manner. If a class cannot be returned as the +result of evaluating the creation form, then an error of type error is +signaled. + + Both conforming implementations and conforming programs may further +specialize make-load-form. + +Examples:: +.......... + + (defclass obj () + ((x :initarg :x :reader obj-x) + (y :initarg :y :reader obj-y) + (dist :accessor obj-dist))) + => # + (defmethod shared-initialize :after ((self obj) slot-names &rest keys) + (declare (ignore slot-names keys)) + (unless (slot-boundp self 'dist) + (setf (obj-dist self) + (sqrt (+ (expt (obj-x self) 2) (expt (obj-y self) 2)))))) + => # + (defmethod make-load-form ((self obj) &optional environment) + (declare (ignore environment)) + ;; Note that this definition only works because X and Y do not + ;; contain information which refers back to the object itself. + ;; For a more general solution to this problem, see revised example below. + `(make-instance ',(class-of self) + :x ',(obj-x self) :y ',(obj-y self))) + => # + (setq obj1 (make-instance 'obj :x 3.0 :y 4.0)) => # + (obj-dist obj1) => 5.0 + (make-load-form obj1) => (MAKE-INSTANCE 'OBJ :X '3.0 :Y '4.0) + + In the above example, an equivalent instance of obj is reconstructed +by using the values of two of its slots. The value of the third slot is +derived from those two values. + + Another way to write the make-load-form method in that example is to +use make-load-form-saving-slots. The code it generates might yield a +slightly different result from the make-load-form method shown above, +but the operational effect will be the same. For example: + + ;; Redefine method defined above. + (defmethod make-load-form ((self obj) &optional environment) + (make-load-form-saving-slots self + :slot-names '(x y) + :environment environment)) + => # + ;; Try MAKE-LOAD-FORM on object created above. + (make-load-form obj1) + => (ALLOCATE-INSTANCE '#), + (PROGN + (SETF (SLOT-VALUE '# 'X) '3.0) + (SETF (SLOT-VALUE '# 'Y) '4.0) + (INITIALIZE-INSTANCE '#)) + + In the following example, instances of my-frob are "interned" in some +way. An equivalent instance is reconstructed by using the value of the +name slot as a key for searching existing objects. In this case the +programmer has chosen to create a new object if no existing object is +found; alternatively an error could have been signaled in that case. + + (defclass my-frob () + ((name :initarg :name :reader my-name))) + (defmethod make-load-form ((self my-frob) &optional environment) + (declare (ignore environment)) + `(find-my-frob ',(my-name self) :if-does-not-exist :create)) + + In the following example, the data structure to be dumped is +circular, because each parent has a list of its children and each child +has a reference back to its parent. If make-load-form is called on one +object in such a structure, the creation form creates an equivalent +object and fills in the children slot, which forces creation of +equivalent objects for all of its children, grandchildren, etc. At this +point none of the parent slots have been filled in. The initialization +form fills in the parent slot, which forces creation of an equivalent +object for the parent if it was not already created. Thus the entire +tree is recreated at load time. At compile time, make-load-form is +called once for each object in the tree. All of the creation forms are +evaluated, in implementation-dependent order, and then all of the +initialization forms are evaluated, also in implementation-dependent +order. + + (defclass tree-with-parent () ((parent :accessor tree-parent) + (children :initarg :children))) + (defmethod make-load-form ((x tree-with-parent) &optional environment) + (declare (ignore environment)) + (values + ;; creation form + `(make-instance ',(class-of x) :children ',(slot-value x 'children)) + ;; initialization form + `(setf (tree-parent ',x) ',(slot-value x 'parent)))) + + In the following example, the data structure to be dumped has no +special properties and an equivalent structure can be reconstructed +simply by reconstructing the slots' contents. + + (defstruct my-struct a b c) + (defmethod make-load-form ((s my-struct) &optional environment) + (make-load-form-saving-slots s :environment environment)) + +Exceptional Situations:: +........................ + +The methods specialized on standard-object, structure-object, and +condition all signal an error of type error. + + It is implementation-dependent whether calling make-load-form on a +generalized instance of a system class signals an error or returns +creation and initialization forms. + +See Also:: +.......... + +*note compile-file:: , *note make-load-form-saving-slots:: , *note +Additional Constraints on Externalizable Objects:: *note Evaluation::, +*note Compilation:: + +Notes:: +....... + +The file compiler calls make-load-form in specific circumstances +detailed in *note Additional Constraints on Externalizable Objects::. + + Some implementations may provide facilities for defining new +subclasses of classes which are specified as system classes. (Some +likely candidates include generic-function, method, and stream). Such +implementations should document how the file compiler processes +instances of such classes when encountered as literal objects, and +should document any relevant methods for make-load-form. + + +File: gcl.info, Node: make-load-form-saving-slots, Next: with-accessors, Prev: make-load-form, Up: Objects Dictionary + +7.7.22 make-load-form-saving-slots [Function] +--------------------------------------------- + +'make-load-form-saving-slots' object &key slot-names environment +=> creation-form, initialization-form + +Arguments and Values:: +...................... + +object--an object. + + slot-names--a list. + + environment--an environment object. + + creation-form--a form. + + initialization-form--a form. + +Description:: +............. + +Returns forms that, when evaluated, will construct an object equivalent +to object, without executing initialization forms. The slots in the new +object that correspond to initialized slots in object are initialized +using the values from object. Uninitialized slots in object are not +initialized in the new object. make-load-form-saving-slots works for +any instance of standard-object or structure-object. + + Slot-names is a list of the names of the slots to preserve. If +slot-names is not supplied, its value is all of the local slots. + + make-load-form-saving-slots returns two values, thus it can deal with +circular structures. Whether the result is useful in an application +depends on whether the object's type and slot contents fully capture the +application's idea of the object's state. + + Environment is the environment in which the forms will be processed. + +See Also:: +.......... + +*note make-load-form:: , *note make-instance:: , *note setf:: , *note +slot-value:: , *note slot-makunbound:: + +Notes:: +....... + +make-load-form-saving-slots can be useful in user-written make-load-form +methods. + + When the object is an instance of standard-object, +make-load-form-saving-slots could return a creation form that calls +allocate-instance and an initialization form that contains calls to setf +of slot-value and slot-makunbound, though other functions of similar +effect might actually be used. + + +File: gcl.info, Node: with-accessors, Next: with-slots, Prev: make-load-form-saving-slots, Up: Objects Dictionary + +7.7.23 with-accessors [Macro] +----------------------------- + +'with-accessors' ({slot-entry}*) instance-form {declaration}* {form}* +=> {result}* + + slot-entry ::=(variable-name accessor-name ) + +Arguments and Values:: +...................... + +variable-name--a variable name; not evaluated. + + accessor-name--a function name; not evaluated. + + instance-form--a form; evaluated. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +Creates a lexical environment in which the slots specified by slot-entry +are lexically available through their accessors as if they were +variables. The macro with-accessors invokes the appropriate accessors +to access the slots specified by slot-entry. Both setf and setq can be +used to set the value of the slot. + +Examples:: +.......... + + (defclass thing () + ((x :initarg :x :accessor thing-x) + (y :initarg :y :accessor thing-y))) + => # + (defmethod (setf thing-x) :before (new-x (thing thing)) + (format t "~&Changing X from ~D to ~D in ~S.~ + (thing-x thing) new-x thing)) + (setq thing1 (make-instance 'thing :x 1 :y 2)) => # + (setq thing2 (make-instance 'thing :x 7 :y 8)) => # + (with-accessors ((x1 thing-x) (y1 thing-y)) + thing1 + (with-accessors ((x2 thing-x) (y2 thing-y)) + thing2 + (list (list x1 (thing-x thing1) y1 (thing-y thing1) + x2 (thing-x thing2) y2 (thing-y thing2)) + (setq x1 (+ y1 x2)) + (list x1 (thing-x thing1) y1 (thing-y thing1) + x2 (thing-x thing2) y2 (thing-y thing2)) + (setf (thing-x thing2) (list x1)) + (list x1 (thing-x thing1) y1 (thing-y thing1) + x2 (thing-x thing2) y2 (thing-y thing2))))) + |> Changing X from 1 to 9 in #. + |> Changing X from 7 to (9) in #. + => ((1 1 2 2 7 7 8 8) + 9 + (9 9 2 2 7 7 8 8) + (9) + (9 9 2 2 (9) (9) 8 8)) + +Affected By:: +............. + +defclass + +Exceptional Situations:: +........................ + +The consequences are undefined if any accessor-name is not the name of +an accessor for the instance. + +See Also:: +.......... + +*note with-slots:: , *note symbol-macrolet:: + +Notes:: +....... + +A with-accessors expression of the form: + + + (with-accessors (slot-entry_1 ...slot-entry_n) instance-form form_1 ...form_k) + + +expands into the equivalent of + + + (let ((in instance-form)) + + (symbol-macrolet (Q_1... Q_n) form_1 ...form_k)) + + +where Q_i is + + (variable-name_i () + (accessor-name_i in)) + + +File: gcl.info, Node: with-slots, Next: defclass, Prev: with-accessors, Up: Objects Dictionary + +7.7.24 with-slots [Macro] +------------------------- + +'with-slots' ({slot-entry}*) instance-form {declaration}* {form}* +=> {result}* + + slot-entry ::=slot-name | (variable-name slot-name) + +Arguments and Values:: +...................... + +slot-name--a slot name; not evaluated. + + variable-name--a variable name; not evaluated. + + instance-form--a form; evaluted to produce instance. + + instance--an object. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +The macro with-slots establishes a lexical environment for referring to +the slots in the instance named by the given slot-names as though they +were variables. Within such a context the value of the slot can be +specified by using its slot name, as if it were a lexically bound +variable. Both setf and setq can be used to set the value of the slot. + + The macro with-slots translates an appearance of the slot name as a +variable into a call to slot-value. + +Examples:: +.......... + + (defclass thing () + ((x :initarg :x :accessor thing-x) + (y :initarg :y :accessor thing-y))) + => # + (defmethod (setf thing-x) :before (new-x (thing thing)) + (format t "~&Changing X from ~D to ~D in ~S.~ + (thing-x thing) new-x thing)) + (setq thing (make-instance 'thing :x 0 :y 1)) => # + (with-slots (x y) thing (incf x) (incf y)) => 2 + (values (thing-x thing) (thing-y thing)) => 1, 2 + (setq thing1 (make-instance 'thing :x 1 :y 2)) => # + (setq thing2 (make-instance 'thing :x 7 :y 8)) => # + (with-slots ((x1 x) (y1 y)) + thing1 + (with-slots ((x2 x) (y2 y)) + thing2 + (list (list x1 (thing-x thing1) y1 (thing-y thing1) + x2 (thing-x thing2) y2 (thing-y thing2)) + (setq x1 (+ y1 x2)) + (list x1 (thing-x thing1) y1 (thing-y thing1) + x2 (thing-x thing2) y2 (thing-y thing2)) + (setf (thing-x thing2) (list x1)) + (list x1 (thing-x thing1) y1 (thing-y thing1) + x2 (thing-x thing2) y2 (thing-y thing2))))) + |> Changing X from 7 to (9) in #. + => ((1 1 2 2 7 7 8 8) + 9 + (9 9 2 2 7 7 8 8) + (9) + (9 9 2 2 (9) (9) 8 8)) + +Affected By:: +............. + +defclass + +Exceptional Situations:: +........................ + +The consequences are undefined if any slot-name is not the name of a +slot in the instance. + +See Also:: +.......... + +*note with-accessors:: , *note slot-value:: , *note symbol-macrolet:: + +Notes:: +....... + +A with-slots expression of the form: + + + (with-slots (slot-entry_1 ...slot-entry_n) instance-form form_1 ...form_k) + + +expands into the equivalent of + + + (let ((in instance-form)) + + (symbol-macrolet (Q_1... Q_n) form_1 ...form_k)) + + +where Q_i is + + (slot-entry_i () + (slot-value in 'slot-entry_i)) + +if slot-entry_i is a symbol and is + + (variable-name_i () + (slot-value in 'slot-name_i)) + +if slot-entry_i is of the form + + (variable-name_i + slot-name_i) + + +File: gcl.info, Node: defclass, Next: defgeneric, Prev: with-slots, Up: Objects Dictionary + +7.7.25 defclass [Macro] +----------------------- + +'defclass' class-name ({superclass-name}*) ({slot-specifier}*) +[[!class-option]] +=> new-class + + slot-specifier::=slot-name | (slot-name [[!slot-option]]) + + slot-name::= symbol + + slot-option::={:reader reader-function-name}* | + {:writer writer-function-name}* | + {:accessor reader-function-name}* | + {:allocation allocation-type} | + {:initarg initarg-name}* | + {:initform form} | + {:type type-specifier} | + {:documentation string} + + function-name::= {symbol | (setf symbol)} + + class-option::=(:default-initargs . initarg-list) | + (:documentation string) | + (:metaclass class-name) + +Arguments and Values:: +...................... + +Class-name--a non-nil symbol. + + Superclass-name-a non-nil symbol. + + Slot-name-a symbol. The slot-name argument is a symbol that is +syntactically valid for use as a variable name. + + Reader-function-name--a non-nil symbol. :reader can be supplied more +than once for a given slot. + + Writer-function-name--a generic function name. :writer can be +supplied more than once for a given slot. + + Reader-function-name--a non-nil symbol. :accessor can be supplied +more than once for a given slot. + + Allocation-type--(member :instance :class). :allocation can be +supplied once at most for a given slot. + + Initarg-name--a symbol. :initarg can be supplied more than once for +a given slot. + + Form--a form. :init-form can be supplied once at most for a given +slot. + + Type-specifier--a type specifier. :type can be supplied once at most +for a given slot. + + Class-option-- refers to the class as a whole or to all class slots. + + Initarg-list--a list of alternating initialization argument names and +default initial value forms. :default-initargs can be supplied at most +once. + + Class-name--a non-nil symbol. :metaclass can be supplied once at +most. + + new-class--the new class object. + +Description:: +............. + +The macro defclass defines a new named class. It returns the new class +object as its result. + + The syntax of defclass provides options for specifying initialization +arguments for slots, for specifying default initialization values for +slots, and for requesting that methods on specified generic functions be +automatically generated for reading and writing the values of slots. No +reader or writer functions are defined by default; their generation must +be explicitly requested. However, slots can always be accessed using +slot-value. + + Defining a new class also causes a type of the same name to be +defined. The predicate (typep object class-name) returns true if the +class of the given object is the class named by class-name itself or a +subclass of the class class-name. A class object can be used as a type +specifier. Thus (typep object class) returns true if the class of the +object is class itself or a subclass of class. + + The class-name argument specifies the proper name of the new class. +If a class with the same proper name already exists and that class is an +instance of standard-class, and if the defclass form for the definition +of the new class specifies a class of class standard-class, the existing +class is redefined, and instances of it (and its subclasses) are updated +to the new definition at the time that they are next accessed. For +details, see *note Redefining Classes::. + + Each superclass-name argument specifies a direct superclass of the +new class. If the superclass list is empty, then the superclass +defaults depending on the metaclass, with standard-object being the +default for standard-class. + + The new class will inherit slots and methods from each of its direct +superclasses, from their direct superclasses, and so on. For a +discussion of how slots and methods are inherited, see *note +Inheritance::. + + The following slot options are available: + +* + The :reader slot option specifies that an unqualified method is to + be defined on the generic function named reader-function-name to + read the value of the given slot. + +* + The :writer slot option specifies that an unqualified method is to + be defined on the generic function named writer-function-name to + write the value of the slot. + +* + The :accessor slot option specifies that an unqualified method is + to be defined on the generic function named reader-function-name to + read the value of the given slot and that an unqualified method is + to be defined on the generic function named (setf + reader-function-name) to be used with setf to modify the value of + the slot. + +* + The :allocation slot option is used to specify where storage is to + be allocated for the given slot. Storage for a slot can be located + in each instance or in the class object itself. The value of the + allocation-type argument can be either the keyword :instance or the + keyword :class. If the :allocation slot option is not specified, + the effect is the same as specifying :allocation :instance. + + - + If allocation-type is :instance, a local slot of the name + slot-name is allocated in each instance of the class. + + - + If allocation-type is :class, a shared slot of the given name + is allocated in the class object created by this defclass + form. The value of the slot is shared by all instances of the + class. If a class C_1 defines such a shared slot, any + subclass C_2 of C_1 will share this single slot unless the + defclass form for C_2 specifies a slot of the same name or + there is a superclass of C_2 that precedes C_1 in the class + precedence list of C_2 and that defines a slot of the same + name. + +* + The :initform slot option is used to provide a default initial + value form to be used in the initialization of the slot. This form + is evaluated every time it is used to initialize the slot. The + lexical environment in which this form is evaluated is the lexical + environment in which the defclass form was evaluated. Note that + the lexical environment refers both to variables and to functions. + For local slots, the dynamic environment is the dynamic environment + in which make-instance is called; for shared slots, the dynamic + environment is the dynamic environment in which the defclass form + was evaluated. See *note Object Creation and Initialization::. + + No implementation is permitted to extend the syntax of defclass to + allow (slot-name form) as an abbreviation for (slot-name :initform + form). + + [Reviewer Note by Barmar: Can you extend this to mean something + else?] + +* + The :initarg slot option declares an initialization argument named + initarg-name and specifies that this initialization argument + initializes the given slot. If the initialization argument has a + value in the call to initialize-instance, the value will be stored + into the given slot, and the slot's :initform slot option, if any, + is not evaluated. If none of the initialization arguments + specified for a given slot has a value, the slot is initialized + according to the :initform slot option, if specified. + +* + The :type slot option specifies that the contents of the slot will + always be of the specified data type. It effectively declares the + result type of the reader generic function when applied to an + object of this class. The consequences of attempting to store in a + slot a value that does not satisfy the type of the slot are + undefined. The :type slot option is further discussed in *note + Inheritance of Slots and Slot Options::. + +* + The :documentation slot option provides a documentation string for + the slot. :documentation can be supplied once at most for a given + slot. [Reviewer Note by Barmar: How is this retrieved?] + + Each class option is an option that refers to the class as a whole. +The following class options are available: + +* + The :default-initargs class option is followed by a list of + alternating initialization argument names and default initial value + forms. If any of these initialization arguments does not appear in + the initialization argument list supplied to make-instance, the + corresponding default initial value form is evaluated, and the + initialization argument name and the form's value are added to the + end of the initialization argument list before the instance is + created; see *note Object Creation and Initialization::. The + default initial value form is evaluated each time it is used. The + lexical environment in which this form is evaluated is the lexical + environment in which the defclass form was evaluated. The dynamic + environment is the dynamic environment in which make-instance was + called. If an initialization argument name appears more than once + in a :default-initargs class option, an error is signaled. + +* + + The :documentation class option causes a documentation string to be + attached with the class object, and attached with kind type to the + class-name. :documentation can be supplied once at most. + +* + The :metaclass class option is used to specify that instances of + the class being defined are to have a different metaclass than the + default provided by the system (the class standard-class). + + Note the following rules of defclass for standard classes: + +* + It is not required that the superclasses of a class be defined + before the defclass form for that class is evaluated. + +* + All the superclasses of a class must be defined before an instance + of the class can be made. + +* + A class must be defined before it can be used as a parameter + specializer in a defmethod form. + + The object system can be extended to cover situations where these +rules are not obeyed. + + Some slot options are inherited by a class from its superclasses, and +some can be shadowed or altered by providing a local slot description. +No class options except :default-initargs are inherited. For a detailed +description of how slots and slot options are inherited, see *note +Inheritance of Slots and Slot Options::. + + The options to defclass can be extended. It is required that all +implementations signal an error if they observe a class option or a slot +option that is not implemented locally. + + It is valid to specify more than one reader, writer, accessor, or +initialization argument for a slot. No other slot option can appear +more than once in a single slot description, or an error is signaled. + + If no reader, writer, or accessor is specified for a slot, the slot +can only be accessed by the function slot-value. + + If a defclass form appears as a top level form, the compiler must +make the class name be recognized as a valid type name in subsequent +declarations (as for deftype) and be recognized as a valid class name +for defmethod parameter specializers and for use as the :metaclass +option of a subsequent defclass. The compiler must make the class +definition available to be returned by find-class when its environment +argument is a value received as the environment parameter of a macro. + +Exceptional Situations:: +........................ + +If there are any duplicate slot names, an error of type program-error is +signaled. + + If an initialization argument name appears more than once in +:default-initargs class option, an error of type program-error is +signaled. + + If any of the following slot options appears more than once in a +single slot description, an error of type program-error is signaled: +:allocation, :initform, :type, :documentation. + + It is required that all implementations signal an error of type +program-error if they observe a class option or a slot option that is +not implemented locally. + +See Also:: +.......... + +*note documentation:: , *note Initialize-Instance:: , *note +make-instance:: , *note slot-value:: , *note Classes::, *note +Inheritance::, *note Redefining Classes::, *note Determining the Class +Precedence List::, *note Object Creation and Initialization:: + + +File: gcl.info, Node: defgeneric, Next: defmethod, Prev: defclass, Up: Objects Dictionary + +7.7.26 defgeneric [Macro] +------------------------- + +'defgeneric' function-name gf-lambda-list [[!option | +{!method-description}*]] +=> new-generic + + option ::=(:argument-precedence-order {parameter-name}^+) | + (declare {gf-declaration}^+) | + (:documentation gf-documentation) | + (:method-combination method-combination {method-combination-argument}*) | + (:generic-function-class generic-function-class) | + (:method-class method-class) + + method-description ::=(:method {method-qualifier}* specialized-lambda-list [[{declaration}* | documentation]] {form}*) + +Arguments and Values:: +...................... + +function-name--a function name. + + generic-function-class--a non-nil symbol naming a class. + + gf-declaration--an optimize declaration specifier; other declaration +specifiers are not permitted. + + gf-documentation--a string; not evaluated. + + gf-lambda-list--a generic function lambda list. + + method-class--a non-nil symbol naming a class. + + method-combination-argument--an object. + + method-combination-name--a symbol naming a method combination type. + + method-qualifiers, specialized-lambda-list, declarations, +documentation, forms--as per defmethod. + + new-generic--the generic function object. + + parameter-name--a symbol that names a required parameter in the +lambda-list. (If the :argument-precedence-order option is specified, +each required parameter in the lambda-list must be used exactly once as +a parameter-name.) + +Description:: +............. + +The macro defgeneric is used to define a generic function or to specify +options and declarations that pertain to a generic function as a whole. + + If function-name is a list it must be of the form (setf symbol). If +(fboundp function-name) is false, a new generic function is created. + + If (fdefinition function-name) is a generic function, that + + generic function is modified. If function-name names an ordinary +function, a macro, or a special operator, an error is signaled. + + The effect of the defgeneric macro is as if the following three steps +were performed: first, methods defined by previous defgeneric forms are +removed; + + [Reviewer Note by Barmar: Shouldn't this (second) be first?] second, +ensure-generic-function is called; and finally, methods specified by the +current defgeneric form are added to the generic function. + + Each method-description defines a method on the generic function. +The lambda list of each method must be congruent with the lambda list +specified by the gf-lambda-list option. If no method descriptions are +specified and a generic function of the same name does not already +exist, a generic function with no methods is created. + + The gf-lambda-list argument of defgeneric specifies the shape of +lambda lists for the methods on this generic function. All methods on +the resulting generic function must have lambda lists that are congruent +with this shape. If a defgeneric form is evaluated and some methods for +that generic function have lambda lists that are not congruent with that +given in the defgeneric form, an error is signaled. For further details +on method congruence, see *note Congruent Lambda-lists for all Methods +of a Generic Function::. + + The generic function passes to the method all the argument values +passed to it, and only those; default values are not supported. Note +that optional and keyword arguments in method definitions, however, can +have default initial value forms and can use supplied-p parameters. + + The following options are provided. + + Except as otherwise noted, + + a given option may occur only once. + +* + The :argument-precedence-order option is used to specify the order + in which the required arguments in a call to the generic function + are tested for specificity when selecting a particular method. + Each required argument, as specified in the gf-lambda-list + argument, must be included exactly once as a parameter-name so that + the full and unambiguous precedence order is supplied. If this + condition is not met, an error is signaled. + + [Reviewer Note by Barmar: What is the default order?] + +* + The declare option is used to specify declarations that pertain to + the generic function. + + An optimize declaration specifier is allowed. It specifies whether + method selection should be optimized for speed or space, but it has + no effect on methods. To control how a method is optimized, an + optimize declaration must be placed directly in the defmethod form + or method description. The optimization qualities speed and space + are the only qualities this standard requires, but an + implementation can extend the object system to recognize other + qualities. A simple implementation that has only one method + selection technique and ignores optimize declaration specifiers is + valid. + + The special, ftype, function, inline, notinline, and declaration + declarations are not permitted. Individual implementations can + extend the declare option to support additional declarations. + + [Editorial Note by KMP: Does "additional" mean including special, + ftype, etc.? Or only other things that are not mentioned here?] + If an implementation notices a declaration specifier that it does + not support and that has not been proclaimed as a non-standard + declaration identifier name in a declaration proclamation, it + should issue a warning. [Editorial Note by KMP: The wording of + this previous sentence, particularly the word "and" suggests to me + that you can 'proclaim declaration' of an unsupported declaration + (e.g., ftype) in order to suppress the warning. That seems wrong. + Perhaps it instead means to say "does not support or is both + undefined and not proclaimed declaration."] + + The declare option may be specified more than once. The effect is + the same as if the lists of declaration specifiers had been + appended together into a single list and specified as a single + declare option. + +* + The :documentation argument is a documentation string to be + attached to the generic function object, and to be attached with + kind function to the function-name. + +* + The :generic-function-class option may be used to specify that the + generic function is to have a different class than the default + provided by the system (the class standard-generic-function). The + class-name argument is the name of a class that can be the class of + a generic function. If function-name specifies an existing generic + function that has a different value for the :generic-function-class + argument and the new generic function class is compatible with the + old, change-class is called to change the class of the generic + function; otherwise an error is signaled. + +* + The :method-class option is used to specify that all methods on + this generic function are to have a different class from the + default provided by the system (the class standard-method). The + class-name argument is the name of a class that is capable of being + the class of a method. + + [Reviewer Note by Barmar: Is change-class called on existing + methods?] + +* + The :method-combination option is followed by a symbol that names a + type of method combination. The arguments (if any) that follow + that symbol depend on the type of method combination. Note that + the standard method combination type does not support any + arguments. However, all types of method combination defined by the + short form of define-method-combination accept an optional argument + named order, defaulting to :most-specific-first, where a value of + :most-specific-last reverses the order of the primary methods + without affecting the order of the auxiliary methods. + + The method-description arguments define methods that will be +associated with the generic function. The method-qualifier and +specialized-lambda-list arguments in a method description are the same +as for defmethod. + + The form arguments specify the method body. The body of the method +is enclosed in an implicit block. If function-name is a symbol, this +block bears the same name as the generic function. If function-name is +a list of the form (setf symbol), the name of the block is symbol. + + Implementations can extend defgeneric to include other options. It +is required that an implementation signal an error if it observes an +option that is not implemented locally. + + defgeneric is not required to perform any compile-time side effects. +In particular, the methods are not installed for invocation during +compilation. An implementation may choose to store information about +the generic function for the purposes of compile-time error-checking +(such as checking the number of arguments on calls, or noting that a +definition for the function name has been seen). + +Examples:: +.......... + +Exceptional Situations:: +........................ + +If function-name names an ordinary function, a macro, or a special +operator, an error of type program-error is signaled. + + Each required argument, as specified in the gf-lambda-list argument, +must be included exactly once as a parameter-name, or an error of type +program-error is signaled. + + The lambda list of each method specified by a method-description must +be congruent with the lambda list specified by the gf-lambda-list +option, or an error of type error is signaled. + + If a defgeneric form is evaluated and some methods for that generic +function have lambda lists that are not congruent with that given in the +defgeneric form, an error of type error is signaled. + + A given option may occur only once, or an error of type program-error +is signaled. + + [Reviewer Note by Barmar: This says that an error is signaled if you +specify the same generic function class as it already has!] If +function-name specifies an existing generic function that has a +different value for the :generic-function-class argument and the new +generic function class is compatible with the old, change-class is +called to change the class of the generic function; otherwise an error +of type error is signaled. + + Implementations can extend defgeneric to include other options. It +is required that an implementation signal an error of type program-error +if it observes an option that is not implemented locally. + +See Also:: +.......... + +*note defmethod:: , *note documentation:: , *note +ensure-generic-function:: , + + generic-function, + + *note Congruent Lambda-lists for all Methods of a Generic Function:: + + +File: gcl.info, Node: defmethod, Next: find-class, Prev: defgeneric, Up: Objects Dictionary + +7.7.27 defmethod [Macro] +------------------------ + +'defmethod' function-name {method-qualifier}* specialized-lambda-list +[[{declaration}* | documentation]] {form}* +=> new-method + + function-name::= {symbol | (setf symbol)} + + method-qualifier::= non-list + + specialized-lambda-list::= ({var | (var parameter-specializer-name)}* + [&optional {var | (var [initform [supplied-p-parameter] ])}*] + [&rest var] + [&key{var | ({var | (keywordvar)} [initform [supplied-p-parameter] ])}* + [&allow-other-keys] ] + [&aux {var | (var [initform] )}*] ) + + parameter-specializer-name::= symbol | (eql eql-specializer-form) + +Arguments and Values:: +...................... + +declaration--a declare expression; not evaluated. + + documentation--a string; not evaluated. + + var--a variable name. + + eql-specializer-form--a form. + + Form--a form. + + Initform--a form. + + Supplied-p-parameter--variable name. + + new-method--the new method object. + +Description:: +............. + +The macro defmethod defines a method on a generic function. + + If (fboundp function-name) is nil, a generic function is created with +default values for the argument precedence order (each argument is more +specific than the arguments to its right in the argument list), for the +generic function class (the class standard-generic-function), for the +method class (the class standard-method), and for the method combination +type (the standard method combination type). The lambda list of the +generic function is congruent with the lambda list of the method being +defined; if the defmethod form mentions keyword arguments, the lambda +list of the generic function will mention &key (but no keyword +arguments). If function-name names an ordinary function, a macro, or a +special operator, an error is signaled. + + If a generic function is currently named by function-name, the lambda +list of the method must be congruent with the lambda list of the generic +function. If this condition does not hold, an error is signaled. For a +definition of congruence in this context, see *note Congruent +Lambda-lists for all Methods of a Generic Function::. + + Each method-qualifier argument is an object that is used by method +combination to identify the given method. The method combination type +might further restrict what a method qualifier can be. The standard +method combination type allows for unqualified methods and methods whose +sole qualifier is one of the keywords :before, :after, or :around. + + The specialized-lambda-list argument is like an ordinary lambda list +except that the names of required parameters can be replaced by +specialized parameters. A specialized parameter is a list of the form +(var parameter-specializer-name). Only required parameters can be +specialized. If parameter-specializer-name is a symbol it names a +class; if it is a list, it is of the form (eql eql-specializer-form). +The parameter specializer name (eql eql-specializer-form) indicates that +the corresponding argument must be eql to the object that is the value +of eql-specializer-form for the method to be applicable. The +eql-specializer-form is evaluated at the time that the expansion of the +defmethod macro is evaluated. If no parameter specializer name is +specified for a given required parameter, the parameter specializer +defaults to the class t. For further discussion, see *note Introduction +to Methods::. + + The form arguments specify the method body. The body of the method +is enclosed in an implicit block. If function-name is a symbol, this +block bears the same name as the generic function. If function-name is +a list of the form (setf symbol), the name of the block is symbol. + + The class of the method object that is created is that given by the +method class option of the generic function on which the method is +defined. + + If the generic function already has a method that agrees with the +method being defined on parameter specializers and qualifiers, defmethod +replaces the existing method with the one now being defined. For a +definition of agreement in this context. see *note Agreement on +Parameter Specializers and Qualifiers::. + + The parameter specializers are derived from the parameter specializer +names as described in *note Introduction to Methods::. + + The expansion of the defmethod macro "refers to" each specialized +parameter (see the description of ignore within the description of +declare). This includes parameters that have an explicit parameter +specializer name of t. This means that a compiler warning does not +occur if the body of the method does not refer to a specialized +parameter, while a warning might occur if the body of the method does +not refer to an unspecialized parameter. For this reason, a parameter +that specializes on t is not quite synonymous with an unspecialized +parameter in this context. + + Declarations at the head of the method body that apply to the +method's lambda variables are treated as bound declarations whose scope +is the same as the corresponding bindings. + + Declarations at the head of the method body that apply to the +functional bindings of call-next-method or next-method-p apply to +references to those functions within the method body forms. Any outer +bindings of the function names call-next-method and next-method-p, and +declarations associated with such bindings are shadowed_2 within the +method body forms. + + The scope of free declarations at the head of the method body is the +entire method body, which includes any implicit local function +definitions but excludes initialization forms for the lambda variables. + + defmethod is not required to perform any compile-time side effects. +In particular, the methods are not installed for invocation during +compilation. An implementation may choose to store information about +the generic function for the purposes of compile-time error-checking +(such as checking the number of arguments on calls, or noting that a +definition for the function name has been seen). + + Documentation is attached as a documentation string to the method +object. + +Affected By:: +............. + +The definition of the referenced generic function. + +Exceptional Situations:: +........................ + +If function-name names an ordinary function, a macro, or a special +operator, an error of type error is signaled. + + If a generic function is currently named by function-name, the lambda +list of the method must be congruent with the lambda list of the generic +function, or an error of type error is signaled. + +See Also:: +.......... + +*note defgeneric:: , *note documentation:: , *note Introduction to +Methods::, *note Congruent Lambda-lists for all Methods of a Generic +Function::, *note Agreement on Parameter Specializers and Qualifiers::, +*note Syntactic Interaction of Documentation Strings and Declarations:: + + +File: gcl.info, Node: find-class, Next: next-method-p, Prev: defmethod, Up: Objects Dictionary + +7.7.28 find-class [Accessor] +---------------------------- + +'find-class' symbol &optional errorp environment => class + + (setf (' find-class' symbol &optional errorp environment) new-class) + +Arguments and Values:: +...................... + +symbol--a symbol. + + errorp--a generalized boolean. The default is true. + + environment - same as the &environment argument to macro expansion +functions and is used to distinguish between compile-time and run-time +environments. + + The &environment argument has dynamic extent; the consequences are +undefined if the &environment argument is referred to outside the +dynamic extent of the macro expansion function. + + class--a class object, or nil. + +Description:: +............. + +Returns the class object named by the symbol in the environment. If +there is no such class, nil is returned if errorp is false; otherwise, +if errorp is true, an error is signaled. + + The class associated with a particular symbol can be changed by using +setf with find-class; + + or, if the new class given to setf is nil, the class association is +removed (but the class object itself is not affected). + + The results are undefined if the user attempts to change + + or remove + + the class associated with a symbol that is defined as a type +specifier in this standard. See *note Integrating Types and Classes::. + + When using setf of find-class, any errorp argument is evaluated for +effect, but any values it returns are ignored; the errorp parameter is +permitted primarily so that the environment parameter can be used. + + The environment might be used to distinguish between a compile-time +and a run-time environment. + +Exceptional Situations:: +........................ + +If there is no such class and errorp is true, find-class signals an +error of type error. + +See Also:: +.......... + +*note defmacro:: , *note Integrating Types and Classes:: + + +File: gcl.info, Node: next-method-p, Next: call-method, Prev: find-class, Up: Objects Dictionary + +7.7.29 next-method-p [Local Function] +------------------------------------- + +Syntax:: +........ + +'next-method-p' => generalized-boolean + +Arguments and Values:: +...................... + +generalized-boolean--a generalized boolean. + +Description:: +............. + +The locally defined function next-method-p can be used + + within the body forms (but not the lambda list) + + defined by a method-defining form to determine whether a next method +exists. + + The function next-method-p has lexical scope and indefinite extent. + + Whether or not next-method-p is fbound in the global environment is +implementation-dependent; however, the restrictions on redefinition and +shadowing of next-method-p are the same as for symbols in the +COMMON-LISP package which are fbound in the global environment. The +consequences of attempting to use next-method-p outside of a +method-defining form are undefined. + +See Also:: +.......... + +*note call-next-method:: , *note defmethod:: , *note call-method:: + + +File: gcl.info, Node: call-method, Next: call-next-method, Prev: next-method-p, Up: Objects Dictionary + +7.7.30 call-method, make-method [Local Macro] +--------------------------------------------- + +Syntax:: +........ + +'call-method' method &optional next-method-list => {result}* + + 'make-method' form => method-object + +Arguments and Values:: +...................... + +method--a method object, or a list (see below); not evaluated. + + method-object--a method object. + + next-method-list--a list of method objects; not evaluated. + + results--the values returned by the method invocation. + +Description:: +............. + +The macro call-method is used in method combination. It hides the +implementation-dependent details of how methods are called. The macro +call-method has lexical scope and can only be used within an effective +method form. + + [Editorial Note by KMP: This next paragraph still needs some work.] + + Whether or not call-method is fbound in the global environment is +implementation-dependent; however, the restrictions on redefinition and +shadowing of call-method are the same as for symbols in the COMMON-LISP +package which are fbound in the global environment. The consequences of +attempting to use call-method outside of an effective method form are +undefined. + + The macro call-method invokes the specified method, supplying it with +arguments and with definitions for call-next-method and for +next-method-p. If the invocation of call-method is lexically inside of +a make-method, the arguments are those that were supplied to that +method. Otherwise the arguments are those that were supplied to the +generic function. The definitions of call-next-method and next-method-p +rely on the specified next-method-list. + + If method is a list, the first element of the list must be the symbol +make-method and the second element must be a form. Such a list +specifies a method object whose method function has a body that is the +given form. + + Next-method-list can contain method objects or lists, the first +element of which must be the symbol make-method and the second element +of which must be a form. + + Those are the only two places where make-method can be used. The +form used with make-method is evaluated in the null lexical environment +augmented with a local macro definition for call-method and with +bindings named by symbols not accessible from the COMMON-LISP-USER +package. + + The call-next-method function available to method will call the first +method in next-method-list. The call-next-method function available in +that method, in turn, will call the second method in next-method-list, +and so on, until the list of next methods is exhausted. + + If next-method-list is not supplied, the call-next-method function +available to method signals an error of type control-error and the +next-method-p function available to method returns nil. + +Examples:: +.......... + +See Also:: +.......... + +*note call-next-method:: , *note define-method-combination:: , *note +next-method-p:: + + +File: gcl.info, Node: call-next-method, Next: compute-applicable-methods, Prev: call-method, Up: Objects Dictionary + +7.7.31 call-next-method [Local Function] +---------------------------------------- + +Syntax:: +........ + +'call-next-method' &rest args => {result}* + +Arguments and Values:: +...................... + +arg--an object. + + results--the values returned by the method it calls. + +Description:: +............. + +The function call-next-method can be used + + within the body forms (but not the lambda list) + + of a method defined by a method-defining form to call the next +method. + + If there is no next method, the generic function no-next-method is +called. + + The type of method combination used determines which methods can +invoke call-next-method. The standard method combination type allows +call-next-method to be used within primary methods and around methods. +For generic functions using a type of method combination defined by the +short form of define-method-combination, call-next-method can be used in +around methods only. + + When call-next-method is called with no arguments, it passes the +current method's original arguments to the next method. Neither +argument defaulting, nor using setq, nor rebinding variables with the +same names as parameters of the method affects the values +call-next-method passes to the method it calls. + + When call-next-method is called with arguments, the next method is +called with those arguments. + + If call-next-method is called with arguments but omits optional +arguments, the next method called defaults those arguments. + + The function call-next-method returns any values that are returned by +the next method. + + The function call-next-method has lexical scope and indefinite extent +and can only be used within the body of a method defined by a +method-defining form. + + Whether or not call-next-method is fbound in the global environment +is implementation-dependent; however, the restrictions on redefinition +and shadowing of call-next-method are the same as for symbols in the +COMMON-LISP package which are fbound in the global environment. The +consequences of attempting to use call-next-method outside of a +method-defining form are undefined. + +Affected By:: +............. + +defmethod, call-method, define-method-combination. + +Exceptional Situations:: +........................ + +When providing arguments to call-next-method, the following rule must be +satisfied or an error of type error should be signaled: the ordered set +of applicable methods for a changed set of arguments for +call-next-method must be the same as the ordered set of applicable +methods for the original arguments to the generic function. +Optimizations of the error checking are possible, but they must not +change the semantics of call-next-method. + +See Also:: +.......... + +*note define-method-combination:: , *note defmethod:: , *note +next-method-p:: , *note no-next-method:: , *note call-method:: , *note +Method Selection and Combination::, *note Standard Method Combination::, +*note Built-in Method Combination Types:: + + +File: gcl.info, Node: compute-applicable-methods, Next: define-method-combination, Prev: call-next-method, Up: Objects Dictionary + +7.7.32 compute-applicable-methods [Standard Generic Function] +------------------------------------------------------------- + +Syntax:: +........ + +'compute-applicable-methods' generic-function function-arguments => +methods + +Method Signatures:: +................... + +'compute-applicable-methods' (generic-function +standard-generic-function) + +Arguments and Values:: +...................... + +generic-function--a generic function. + + function-arguments--a list of arguments for the generic-function. + + methods--a list of method objects. + +Description:: +............. + +Given a generic-function and a set of function-arguments, the function +compute-applicable-methods returns the set of methods that are +applicable for those arguments sorted according to precedence order. +See *note Method Selection and Combination::. + +Affected By:: +............. + +defmethod + +See Also:: +.......... + +*note Method Selection and Combination:: + + +File: gcl.info, Node: define-method-combination, Next: find-method, Prev: compute-applicable-methods, Up: Objects Dictionary + +7.7.33 define-method-combination [Macro] +---------------------------------------- + +'define-method-combination' name [[!short-form-option]] +=> name + + 'define-method-combination' name lambda-list +({method-group-specifier}*) [(:arguments . args-lambda-list)] +[(:generic-function generic-function-symbol)] [[{declaration}* | +documentation]] {form}* +=> name + + short-form-option ::=:documentation documentation | + :identity-with-one-argument identity-with-one-argument | + :operator operator + + method-group-specifier ::=(name {{qualifier-pattern}^+ | predicate} [[!long-form-option]]) + + long-form-option ::=:description description | + :order order | + :required required-p + +Arguments and Values:: +...................... + +args-lambda-list-- a define-method-combination arguments lambda list. + + declaration--a declare expression; not evaluated. + + description--a format control. + + documentation--a string; not evaluated. + + forms--an implicit progn that must compute and return the form that +specifies how the methods are combined, that is, the effective method. + + generic-function-symbol--a symbol. + + identity-with-one-argument--a generalized boolean. + + lambda-list--ordinary lambda list. + + name--a symbol. Non-keyword, non-nil symbols are usually used. + + operator--an operator. Name and operator are often the same symbol. +This is the default, but it is not required. + + order--:most-specific-first or :most-specific-last; evaluated. + + predicate--a symbol that names a function of one argument that +returns a generalized boolean. + + qualifier-pattern--a list, or the symbol *. + + required-p--a generalized boolean. + +Description:: +............. + +The macro define-method-combination is used to define new types of +method combination. + + There are two forms of define-method-combination. The short form is +a simple facility for the cases that are expected to be most commonly +needed. The long form is more powerful but more verbose. It resembles +defmacro in that the body is an expression, usually using backquote, +that computes a form. Thus arbitrary control structures can be +implemented. The long form also allows arbitrary processing of method +qualifiers. + +Short Form + The short form syntax of define-method-combination is recognized + when the second subform is a non-nil symbol or is not present. + When the short form is used, name is defined as a type of method + combination that produces a Lisp form (operator method-call + method-call ...). The operator is a symbol that can be the name of + a function, macro, or special operator. The operator can be + supplied by a keyword option; it defaults to name. + + Keyword options for the short form are the following: + + * + The :documentation option is used to document the + method-combination type; see description of long form below. + + * + The :identity-with-one-argument option enables an optimization + when its value is true (the default is false). If there is + exactly one applicable method and it is a primary method, that + method serves as the effective method and operator is not + called. This optimization avoids the need to create a new + effective method and avoids the overhead of a function call. + This option is designed to be used with operators such as + progn, and, +, and max. + + * + The :operator option specifies the name of the operator. The + operator argument is a symbol that can be the name of a + function, macro, or special form. + + These types of method combination require exactly one qualifier per + method. An error is signaled if there are applicable methods with + no qualifiers or with qualifiers that are not supported by the + method combination type. + + A method combination procedure defined in this way recognizes two + roles for methods. A method whose one qualifier is the symbol + naming this type of method combination is defined to be a primary + method. At least one primary method must be applicable or an error + is signaled. A method with :around as its one qualifier is an + auxiliary method that behaves the same as an around method in + standard method combination. The function call-next-method can + only be used in around methods; it cannot be used in primary + methods defined by the short form of the define-method-combination + macro. + + A method combination procedure defined in this way accepts an + optional argument named order, which defaults to + :most-specific-first. A value of :most-specific-last reverses the + order of the primary methods without affecting the order of the + auxiliary methods. + + The short form automatically includes error checking and support + for around methods. + + For a discussion of built-in method combination types, see *note + Built-in Method Combination Types::. + +Long Form + The long form syntax of define-method-combination is recognized + when the second subform is a list. + + The lambda-list receives any arguments provided after the name of + the method combination type in the :method-combination option to + defgeneric. + + A list of method group specifiers follows. Each specifier selects + a subset of the applicable methods to play a particular role, + either by matching their qualifiers against some patterns or by + testing their qualifiers with a predicate. These method group + specifiers define all method qualifiers that can be used with this + type of method combination. + + The car of each method-group-specifier is a symbol which names a + variable. During the execution of the forms in the body of + define-method-combination, this variable is bound to a list of the + methods in the method group. The methods in this list occur in the + order specified by the :order option. + + If qualifier-pattern is a symbol it must be *. A method matches a + qualifier-pattern if the method's list of qualifiers is equal to + the qualifier-pattern (except that the symbol * in a + qualifier-pattern matches anything). Thus a qualifier-pattern can + be one of the following: the empty list, which matches unqualified + methods; the symbol *, which matches all methods; a true list, + which matches methods with the same number of qualifiers as the + length of the list when each qualifier matches the corresponding + list element; or a dotted list that ends in the symbol * (the * + matches any number of additional qualifiers). + + Each applicable method is tested against the qualifier-patterns and + predicates in left-to-right order. As soon as a qualifier-pattern + matches or a predicate returns true, the method becomes a member of + the corresponding method group and no further tests are made. Thus + if a method could be a member of more than one method group, it + joins only the first such group. If a method group has more than + one qualifier-pattern, a method need only satisfy one of the + qualifier-patterns to be a member of the group. + + The name of a predicate function can appear instead of + qualifier-patterns in a method group specifier. The predicate is + called for each method that has not been assigned to an earlier + method group; it is called with one argument, the method's + qualifier list. The predicate should return true if the method is + to be a member of the method group. A predicate can be + distinguished from a qualifier-pattern because it is a symbol other + than nil or *. + + If there is an applicable method that does not fall into any method + group, the function invalid-method-error is called. + + Method group specifiers can have keyword options following the + qualifier patterns or predicate. Keyword options can be + distinguished from additional qualifier patterns because they are + neither lists nor the symbol *. The keyword options are as + follows: + + * + The :description option is used to provide a description of + the role of methods in the method group. Programming + environment tools use (apply #'format stream format-control + (method-qualifiers method)) to print this description, which + is expected to be concise. This keyword option allows the + description of a method qualifier to be defined in the same + module that defines the meaning of the method qualifier. In + most cases, format-control will not contain any format + directives, but they are available for generality. If + :description is not supplied, a default description is + generated based on the variable name and the qualifier + patterns and on whether this method group includes the + unqualified methods. + + * + The :order option specifies the order of methods. The order + argument is a form that evaluates to :most-specific-first or + :most-specific-last. If it evaluates to any other value, an + error is signaled. If :order is not supplied, it defaults to + :most-specific-first. + + * + The :required option specifies whether at least one method in + this method group is required. If its value is true and the + method group is empty (that is, no applicable methods match + the qualifier patterns or satisfy the predicate), an error is + signaled. If :required is not supplied, it defaults to nil. + + The use of method group specifiers provides a convenient syntax to + select methods, to divide them among the possible roles, and to + perform the necessary error checking. It is possible to perform + further filtering of methods in the body forms by using normal + list-processing operations and the functions method-qualifiers and + invalid-method-error. It is permissible to use setq on the + variables named in the method group specifiers and to bind + additional variables. It is also possible to bypass the method + group specifier mechanism and do everything in the body forms. + This is accomplished by writing a single method group with * as its + only qualifier-pattern; the variable is then bound to a list of all + of the applicable methods, in most-specific-first order. + + The body forms compute and return the form that specifies how the + methods are combined, that is, the effective method. The effective + method is evaluated in the null lexical environment augmented with + a local macro definition for call-method and with bindings named by + symbols not accessible from the COMMON-LISP-USER package. Given a + method object in one of the lists produced by the method group + specifiers and a list of next methods, call-method will invoke the + method such that call-next-method has available the next methods. + + When an effective method has no effect other than to call a single + method, some implementations employ an optimization that uses the + single method directly as the effective method, thus avoiding the + need to create a new effective method. This optimization is active + when the effective method form consists entirely of an invocation + of the call-method macro whose first subform is a method object and + whose second subform is nil or unsupplied. Each + define-method-combination body is responsible for stripping off + redundant invocations of progn, and, multiple-value-prog1, and the + like, if this optimization is desired. + + The list (:arguments . lambda-list) can appear before any + declarations or documentation string. This form is useful when the + method combination type performs some specific behavior as part of + the combined method and that behavior needs access to the arguments + to the generic function. Each parameter variable defined by + lambda-list is bound to a form that can be inserted into the + effective method. When this form is evaluated during execution of + the effective method, its value is the corresponding argument to + the generic function; the consequences of using such a form as the + place in a setf form are undefined. + + Argument correspondence is computed by dividing the :arguments + lambda-list and the generic function lambda-list into three + sections: the required parameters, the optional parameters, and the + keyword and rest parameters. The arguments supplied to the generic + function for a particular call are also divided into three + sections; the required arguments section contains as many arguments + as the generic function has required parameters, the optional + arguments section contains as many arguments as the generic + function has optional parameters, and the keyword/rest arguments + section contains the remaining arguments. Each parameter in the + required and optional sections of the :arguments lambda-list + accesses the argument at the same position in the corresponding + section of the arguments. If the section of the :arguments + lambda-list is shorter, extra arguments are ignored. If the + section of the :arguments lambda-list is longer, excess required + parameters are bound to forms that evaluate to nil and excess + optional parameters are bound to their initforms. The keyword + parameters and rest parameters in the :arguments lambda-list access + the keyword/rest section of the arguments. If the :arguments + lambda-list contains &key, it behaves as if it also contained + &allow-other-keys. + + In addition, &whole var can be placed first in the :arguments + lambda-list. It causes var to be bound to a form that evaluates to + a list of all of the arguments supplied to the generic function. + This is different from &rest because it accesses all of the + arguments, not just the keyword/rest arguments. + + Erroneous conditions detected by the body should be reported with + method-combination-error or invalid-method-error; these functions + add any necessary contextual information to the error message and + will signal the appropriate error. + + The body forms are evaluated inside of the bindings created by the + lambda list and method group specifiers. + + [Reviewer Note by Barmar: Are they inside or outside the :ARGUMENTS + bindings?] Declarations at the head of the body are positioned + directly inside of bindings created by the lambda list and outside + of the bindings of the method group variables. Thus method group + variables cannot be declared in this way. locally may be used + around the body, however. + + Within the body forms, generic-function-symbol is bound to the + generic function object. + + Documentation is attached as a documentation string to name (as + kind method-combination) and to the method combination object. + + Note that two methods with identical specializers, but with + different qualifiers, are not ordered by the algorithm described in + Step 2 of the method selection and combination process described in + *note Method Selection and Combination::. Normally the two methods + play different roles in the effective method because they have + different qualifiers, and no matter how they are ordered in the + result of Step 2, the effective method is the same. If the two + methods play the same role and their order matters, + + [Reviewer Note by Barmar: How does the system know when the order + matters?] an error is signaled. This happens as part of the + qualifier pattern matching in define-method-combination. + + If a define-method-combination form appears as a top level form, the +compiler must make the method combination name be recognized as a valid +method combination name in subsequent defgeneric forms. However, the +method combination is executed no earlier than when the +define-method-combination form is executed, and possibly as late as the +time that generic functions that use the method combination are +executed. + +Examples:: +.......... + +Most examples of the long form of define-method-combination also +illustrate the use of the related functions that are provided as part of +the declarative method combination facility. + + ;;; Examples of the short form of define-method-combination + + (define-method-combination and :identity-with-one-argument t) + + (defmethod func and ((x class1) y) ...) + + ;;; The equivalent of this example in the long form is: + + (define-method-combination and + (&optional (order :most-specific-first)) + ((around (:around)) + (primary (and) :order order :required t)) + (let ((form (if (rest primary) + `(and ,@(mapcar #'(lambda (method) + `(call-method ,method)) + primary)) + `(call-method ,(first primary))))) + (if around + `(call-method ,(first around) + (,@(rest around) + (make-method ,form))) + form))) + + ;;; Examples of the long form of define-method-combination + + ;The default method-combination technique + (define-method-combination standard () + ((around (:around)) + (before (:before)) + (primary () :required t) + (after (:after))) + (flet ((call-methods (methods) + (mapcar #'(lambda (method) + `(call-method ,method)) + methods))) + (let ((form (if (or before after (rest primary)) + `(multiple-value-prog1 + (progn ,@(call-methods before) + (call-method ,(first primary) + ,(rest primary))) + ,@(call-methods (reverse after))) + `(call-method ,(first primary))))) + (if around + `(call-method ,(first around) + (,@(rest around) + (make-method ,form))) + form)))) + + ;A simple way to try several methods until one returns non-nil + (define-method-combination or () + ((methods (or))) + `(or ,@(mapcar #'(lambda (method) + `(call-method ,method)) + methods))) + + ;A more complete version of the preceding + (define-method-combination or + (&optional (order ':most-specific-first)) + ((around (:around)) + (primary (or))) + ;; Process the order argument + (case order + (:most-specific-first) + (:most-specific-last (setq primary (reverse primary))) + (otherwise (method-combination-error "~S is an invalid order.~@ + :most-specific-first and :most-specific-last are the possible values." + order))) + ;; Must have a primary method + (unless primary + (method-combination-error "A primary method is required.")) + ;; Construct the form that calls the primary methods + (let ((form (if (rest primary) + `(or ,@(mapcar #'(lambda (method) + `(call-method ,method)) + primary)) + `(call-method ,(first primary))))) + ;; Wrap the around methods around that form + (if around + `(call-method ,(first around) + (,@(rest around) + (make-method ,form))) + form))) + + ;The same thing, using the :order and :required keyword options + (define-method-combination or + (&optional (order ':most-specific-first)) + ((around (:around)) + (primary (or) :order order :required t)) + (let ((form (if (rest primary) + `(or ,@(mapcar #'(lambda (method) + `(call-method ,method)) + primary)) + `(call-method ,(first primary))))) + (if around + `(call-method ,(first around) + (,@(rest around) + (make-method ,form))) + form))) + + ;This short-form call is behaviorally identical to the preceding + (define-method-combination or :identity-with-one-argument t) + + ;Order methods by positive integer qualifiers + ;:around methods are disallowed to keep the example small + (define-method-combination example-method-combination () + ((methods positive-integer-qualifier-p)) + `(progn ,@(mapcar #'(lambda (method) + `(call-method ,method)) + (stable-sort methods #'< + :key #'(lambda (method) + (first (method-qualifiers method))))))) + + (defun positive-integer-qualifier-p (method-qualifiers) + (and (= (length method-qualifiers) 1) + (typep (first method-qualifiers) '(integer 0 *)))) + + ;;; Example of the use of :arguments + (define-method-combination progn-with-lock () + ((methods ())) + (:arguments object) + `(unwind-protect + (progn (lock (object-lock ,object)) + ,@(mapcar #'(lambda (method) + `(call-method ,method)) + methods)) + (unlock (object-lock ,object)))) + + +Side Effects:: +.............. + +The compiler is not required to perform any compile-time side-effects. + +Exceptional Situations:: +........................ + +Method combination types defined with the short form require exactly one +qualifier per method. An error of type error is signaled if there are +applicable methods with no qualifiers or with qualifiers that are not +supported by the method combination type. At least one primary method +must be applicable or an error of type error is signaled. + + If an applicable method does not fall into any method group, the +system signals an error of type error indicating that the method is +invalid for the kind of method combination in use. + + If the value of the :required option is true and the method group is +empty (that is, no applicable methods match the qualifier patterns or +satisfy the predicate), an error of type error is signaled. + + If the :order option evaluates to a value other than +:most-specific-first or :most-specific-last, an error of type error is +signaled. + +See Also:: +.......... + +*note call-method:: , *note call-next-method:: , *note documentation:: , +*note method-qualifiers:: , *note method-combination-error:: , *note +invalid-method-error:: , *note defgeneric:: , *note Method Selection and +Combination::, *note Built-in Method Combination Types::, *note +Syntactic Interaction of Documentation Strings and Declarations:: + +Notes:: +....... + +The :method-combination option of defgeneric is used to specify that a +generic function should use a particular method combination type. The +first argument to the :method-combination option is the name of a method +combination type and the remaining arguments are options for that type. + + +File: gcl.info, Node: find-method, Next: add-method, Prev: define-method-combination, Up: Objects Dictionary + +7.7.34 find-method [Standard Generic Function] +---------------------------------------------- + +Syntax:: +........ + +'find-method' generic-function method-qualifiers specializers &optional +errorp +=> method + +Method Signatures:: +................... + +'find-method' (generic-function standard-generic-function) +method-qualifiers specializers &optional errorp + +Arguments and Values:: +...................... + +generic-function--a generic function. + + method-qualifiers--a list. + + specializers--a list. + + errorp--a generalized boolean. The default is true. + + method--a method object, or nil. + +Description:: +............. + +The generic function find-method takes a generic function and returns +the method object that agrees on qualifiers and parameter specializers +with the method-qualifiers and specializers arguments of find-method. +Method-qualifiers contains the method qualifiers for the method. The +order of the method qualifiers is significant. For a definition of +agreement in this context, see *note Agreement on Parameter Specializers +and Qualifiers::. + + The specializers argument contains the parameter specializers for the +method. It must correspond in length to the number of required +arguments of the generic function, or an error is signaled. This means +that to obtain the default method on a given generic-function, a list +whose elements are the class t must be given. + + If there is no such method and errorp is true, find-method signals an +error. If there is no such method and errorp is false, find-method +returns nil. + +Examples:: +.......... + + (defmethod some-operation ((a integer) (b float)) (list a b)) + => # + (find-method #'some-operation '() (mapcar #'find-class '(integer float))) + => # + (find-method #'some-operation '() (mapcar #'find-class '(integer integer))) + |> Error: No matching method + (find-method #'some-operation '() (mapcar #'find-class '(integer integer)) nil) + => NIL + +Affected By:: +............. + +add-method, defclass, defgeneric, defmethod + +Exceptional Situations:: +........................ + +If the specializers argument does not correspond in length to the number +of required arguments of the generic-function, an an error of type error +is signaled. + + If there is no such method and errorp is true, find-method signals an +error of type error. + +See Also:: +.......... + +*note Agreement on Parameter Specializers and Qualifiers:: + + +File: gcl.info, Node: add-method, Next: initialize-instance, Prev: find-method, Up: Objects Dictionary + +7.7.35 add-method [Standard Generic Function] +--------------------------------------------- + +Syntax:: +........ + +'add-method' generic-function method => generic-function + +Method Signatures:: +................... + +'add-method' (generic-function standard-generic-function) (method +method) + +Arguments and Values:: +...................... + +generic-function--a generic function object. + + method--a method object. + +Description:: +............. + +The generic function add-method adds a method to a generic function. + + If method agrees with an existing method of generic-function on +parameter specializers and qualifiers, the existing method is replaced. + +Exceptional Situations:: +........................ + +The lambda list of the method function of method must be congruent with +the lambda list of generic-function, or an error of type error is +signaled. + + If method is a method object of another generic function, an error of +type error is signaled. + +See Also:: +.......... + +*note defmethod:: , *note defgeneric:: , *note find-method:: , *note +remove-method:: , *note Agreement on Parameter Specializers and +Qualifiers:: + + +File: gcl.info, Node: initialize-instance, Next: class-name, Prev: add-method, Up: Objects Dictionary + +7.7.36 initialize-instance [Standard Generic Function] +------------------------------------------------------ + +Syntax:: +........ + +'initialize-instance' instance &rest initargs &key &allow-other-keys => +instance + +Method Signatures:: +................... + +'initialize-instance' (instance standard-object) &rest initargs + +Arguments and Values:: +...................... + +instance--an object. + + initargs--a defaulted initialization argument list. + +Description:: +............. + +Called by make-instance to initialize a newly created instance. The +generic function is called with the new instance and the defaulted +initialization argument list. + + The system-supplied primary method on initialize-instance initializes +the slots of the instance with values according to the initargs and the +:initform forms of the slots. It does this by calling the generic +function shared-initialize with the following arguments: the instance, t +(this indicates that all slots for which no initialization arguments are +provided should be initialized according to their :initform forms), and +the initargs. + + Programmers can define methods for initialize-instance to specify +actions to be taken when an instance is initialized. If only after +methods are defined, they will be run after the system-supplied primary +method for initialization and therefore will not interfere with the +default behavior of initialize-instance. + +See Also:: +.......... + +*note Shared-Initialize:: , *note make-instance:: , *note slot-boundp:: +, *note slot-makunbound:: , *note Object Creation and Initialization::, +*note Rules for Initialization Arguments::, *note Declaring the Validity +of Initialization Arguments:: + + +File: gcl.info, Node: class-name, Next: setf class-name, Prev: initialize-instance, Up: Objects Dictionary + +7.7.37 class-name [Standard Generic Function] +--------------------------------------------- + +Syntax:: +........ + +'class-name' class => name + +Method Signatures:: +................... + +'class-name' (class class) + +Arguments and Values:: +...................... + +class--a class object. + + name--a symbol. + +Description:: +............. + +Returns the name of the given class. + +See Also:: +.......... + +*note find-class:: , *note Classes:: + +Notes:: +....... + +If S is a symbol such that S =(class-name C) and C =(find-class S), then +S is the proper name of C. For further discussion, see *note Classes::. + + The name of an anonymous class is nil. + + +File: gcl.info, Node: setf class-name, Next: class-of, Prev: class-name, Up: Objects Dictionary + +7.7.38 setf class-name [Standard Generic Function] +-------------------------------------------------- + +Syntax:: +........ + +'setf class-name' new-value class => new-value + +Method Signatures:: +................... + +'setf class-name' new-value (class class) + +Arguments and Values:: +...................... + +new-value--a symbol. + + class--a class. + +Description:: +............. + +The generic function setf class-name sets the name of a class object. + +See Also:: +.......... + +*note find-class:: , proper name, *note Classes:: + + +File: gcl.info, Node: class-of, Next: unbound-slot, Prev: setf class-name, Up: Objects Dictionary + +7.7.39 class-of [Function] +-------------------------- + +'class-of' object => class + +Arguments and Values:: +...................... + +object--an object. + + class--a class object. + +Description:: +............. + +Returns the class of which the object is a direct instance. + +Examples:: +.......... + + (class-of 'fred) => # + (class-of 2/3) => # + + (defclass book () ()) => # + (class-of (make-instance 'book)) => # + + (defclass novel (book) ()) => # + (class-of (make-instance 'novel)) => # + + (defstruct kons kar kdr) => KONS + (class-of (make-kons :kar 3 :kdr 4)) => # + +See Also:: +.......... + +*note make-instance:: , *note type-of:: + + +File: gcl.info, Node: unbound-slot, Next: unbound-slot-instance, Prev: class-of, Up: Objects Dictionary + +7.7.40 unbound-slot [Condition Type] +------------------------------------ + +Class Precedence List:: +....................... + +unbound-slot, cell-error, error, serious-condition, condition, t + +Description:: +............. + +The object having the unbound slot is initialized by the :instance +initialization argument to make-condition, and is accessed by the +function unbound-slot-instance. + + The name of the cell (see cell-error) is the name of the slot. + +See Also:: +.......... + +*note cell-error-name:: , unbound-slot-object, *note Condition System +Concepts:: + + +File: gcl.info, Node: unbound-slot-instance, Prev: unbound-slot, Up: Objects Dictionary + +7.7.41 unbound-slot-instance [Function] +--------------------------------------- + +'unbound-slot-instance' condition => instance + +Arguments and Values:: +...................... + +condition--a condition of type unbound-slot. + + instance--an object. + +Description:: +............. + +Returns the instance which had the unbound slot in the situation +represented by the condition. + +See Also:: +.......... + +*note cell-error-name:: , unbound-slot, *note Condition System +Concepts:: + + +File: gcl.info, Node: Structures, Next: Conditions, Prev: Objects, Up: Top + +8 Structures +************ + +* Menu: + +* Structures Dictionary:: + + +File: gcl.info, Node: Structures Dictionary, Prev: Structures, Up: Structures + +8.1 Structures Dictionary +========================= + +* Menu: + +* defstruct:: +* copy-structure:: + + +File: gcl.info, Node: defstruct, Next: copy-structure, Prev: Structures Dictionary, Up: Structures Dictionary + +8.1.1 defstruct [Macro] +----------------------- + +'defstruct' name-and-options [documentation] {!slot-description}* +=> structure-name + + name-and-options ::=structure-name | (structure-name [[!options]]) + + options ::=!conc-name-option | {!constructor-option}* | + !copier-option | !include-option | + !initial-offset-option | !named-option | + !predicate-option | !printer-option | + !type-option + + conc-name-option ::=:conc-name | (:conc-name) | (:conc-name conc-name) + + constructor-option ::=:constructor | + (:constructor) | + (:constructor constructor-name) | + (:constructor constructor-name constructor-arglist) + + copier-option ::=:copier | (:copier) | (:copier copier-name) + + predicate-option ::=:predicate | (:predicate) | (:predicate predicate-name) + + include-option ::=(:include included-structure-name {!slot-description}*) + + printer-option ::=!print-object-option | !print-function-option + + print-object-option ::=(:print-object printer-name) | (:print-object) + + print-function-option ::=(:print-function printer-name) | (:print-function) + + type-option ::=(:type type) + + named-option ::=:named + + initial-offset-option ::=(:initial-offset initial-offset) + + slot-description ::=slot-name | + (slot-name [slot-initform [[!slot-option]]]) + + slot-option ::=:type slot-type | + :read-only slot-read-only-p + +Arguments and Values:: +...................... + +conc-name--a string designator. + + constructor-arglist--a boa lambda list. + + constructor-name--a symbol. + + copier-name--a symbol. + + included-structure-name--an already-defined structure name. + + Note that a derived type is not permissible, even if it would expand +into a structure name. + + initial-offset--a non-negative integer. + + predicate-name--a symbol. + + printer-name--a function name or a lambda expression. + + slot-name--a symbol. + + slot-initform--a form. + + slot-read-only-p--a generalized boolean. + + structure-name--a symbol. + + type--one of the type specifiers list, vector, or (vector size), or +some other type specifier defined by the implementation to be +appropriate. + + documentation--a string; not evaluated. + +Description:: +............. + +defstruct defines a structured type, named structure-type, with named +slots as specified by the slot-options. + + defstruct defines readers for the slots and arranges for setf to work +properly on such reader functions. Also, unless overridden, it defines +a predicate named name-p, defines a constructor function named +make-constructor-name, and defines a copier function named +copy-constructor-name. All names of automatically created functions +might automatically be declared inline (at the discretion of the +implementation). + + If documentation is supplied, it is attached to structure-name as a +documentation string of kind structure, + + and unless :type is used, the documentation is also attached to +structure-name as a documentation string of kind type and as a +documentation string to the class object for the class named +structure-name. + + defstruct defines a constructor function that is used to create +instances of the structure created by defstruct. The default name is +make-structure-name. A different name can be supplied by giving the +name as the argument to the constructor option. nil indicates that no +constructor function will be created. + + After a new structure type has been defined, instances of that type +normally can be created by using the constructor function for the type. +A call to a constructor function is of the following form: + + (constructor-function-name + slot-keyword-1 form-1 + slot-keyword-2 form-2 + ...) + + The arguments to the constructor function are all keyword arguments. +Each slot keyword argument must be a keyword whose name corresponds to +the name of a structure slot. All the keywords and forms are evaluated. +If a slot is not initialized in this way, it is initialized by +evaluating slot-initform in the slot description + + at the time the constructor function is called. + + If no slot-initform is supplied, the consequences are undefined if an +attempt is later made to read the slot's value before a value is +explicitly assigned. + + Each slot-initform supplied for a defstruct component, when used by +the constructor function for an otherwise unsupplied component, is +re-evaluated on every call to the constructor function. + + The slot-initform is not evaluated unless it is needed in the +creation of a particular structure instance. If it is never needed, +there can be no type-mismatch error, even if the type of the slot is +specified; no warning should be issued in this case. + + For example, in the following sequence, only the last call is an +error. + + (defstruct person (name 007 :type string)) + (make-person :name "James") + (make-person) + + It is as if the slot-initforms were used as initialization forms for +the keyword parameters of the constructor function. + + The symbols which name the slots must not be used by the +implementation as the names for the lambda variables in the constructor +function, since one or more of those symbols might have been proclaimed +special or might be defined as the name of a constant variable. The +slot default init forms are evaluated in the lexical environment in +which the defstruct form itself appears and in the dynamic environment +in which the call to the constructor function appears. + + For example, if the form (gensym) were used as an initialization +form, either in the constructor-function call or as the default +initialization form in defstruct, then every call to the constructor +function would call gensym once to generate a new symbol. + + Each slot-description in defstruct can specify zero or more +slot-options. + + A slot-option consists of a pair of a keyword and a value (which is +not a form to be evaluated, but the value itself). For example: + + (defstruct ship + (x-position 0.0 :type short-float) + (y-position 0.0 :type short-float) + (x-velocity 0.0 :type short-float) + (y-velocity 0.0 :type short-float) + (mass *default-ship-mass* :type short-float :read-only t)) + + This specifies that each slot always contains a short float, and that +the last slot cannot be altered once a ship is constructed. + + The available slot-options are: + +:type type + This specifies that the contents of the slot is always of type + type. This is entirely analogous to the declaration of a variable + or function; it effectively declares the result type of the reader + function. It is implementation-dependent whether the type is + checked when initializing a slot or when assigning to it. Type is + not evaluated; it must be a valid type specifier. + +:read-only x + When x is true, this specifies that this slot cannot be altered; it + will always contain the value supplied at construction time. setf + will not accept the reader function for this slot. If x is false, + this slot-option has no effect. X is not evaluated. + + When this option is false or unsupplied, it is + implementation-dependent whether the ability to write the slot is + implemented by a setf function or a setf expander. + + The following keyword options are available for use with defstruct. +A defstruct option can be either a keyword or a list of a keyword and +arguments for that keyword; specifying the keyword by itself is +equivalent to specifying a list consisting of the keyword and no +arguments. The syntax for defstruct options differs from the pair +syntax used for slot-options. No part of any of these options is +evaluated. + +:conc-name + This provides for automatic prefixing of names of reader (or + access) functions. The default behavior is to begin the names of + all the reader functions of a structure with the name of the + structure followed by a hyphen. + + :conc-name supplies an alternate prefix to be used. If a hyphen is + to be used as a separator, it must be supplied as part of the + prefix. If :conc-name is nil or no argument is supplied, then no + prefix is used; then the names of the reader functions are the same + as the slot names. If a non-nil prefix is given, the name of the + reader function for each slot is constructed by concatenating that + prefix and the name of the slot, and interning the resulting symbol + in the package that is current at the time the defstruct form is + expanded. + + Note that no matter what is supplied for :conc-name, slot keywords + that match the slot names with no prefix attached are used with a + constructor function. The reader function name is used in + conjunction with setf. Here is an example: + + (defstruct (door (:conc-name dr-)) knob-color width material) => DOOR + (setq my-door (make-door :knob-color 'red :width 5.0)) + => #S(DOOR :KNOB-COLOR RED :WIDTH 5.0 :MATERIAL NIL) + (dr-width my-door) => 5.0 + (setf (dr-width my-door) 43.7) => 43.7 + (dr-width my-door) => 43.7 + + Whether or not the :conc-name option is explicitly supplied, the + following rule governs name conflicts of generated reader (or + accessor) names: For any structure type S_1 having a reader + function named R for a slot named X_1 that is inherited by another + structure type S_2 that would have a reader function with the same + name R for a slot named X_2, no definition for R is generated by + the definition of S_2; instead, the definition of R is inherited + from the definition of S_1. (In such a case, if X_1 and X_2 are + different slots, the implementation might signal a style warning.) + +:constructor + This option takes zero, one, or two arguments. If at least one + argument is supplied and the first argument is not nil, then that + argument is a symbol which specifies the name of the constructor + function. If the argument is not supplied (or if the option itself + is not supplied), the name of the constructor is produced by + concatenating the string "MAKE-" and the name of the structure, + interning the name in whatever package is current at the time + defstruct is expanded. If the argument is provided and is nil, no + constructor function is defined. + + If :constructor is given as (:constructor name arglist), then + instead of making a keyword driven constructor function, defstruct + defines a "positional" constructor function, taking arguments whose + meaning is determined by the argument's position and possibly by + keywords. Arglist is used to describe what the arguments to the + constructor will be. In the simplest case something like + (:constructor make-foo (a b c)) defines make-foo to be a + three-argument constructor function whose arguments are used to + initialize the slots named a, b, and c. + + Because a constructor of this type operates "By Order of + Arguments," it is sometimes known as a "boa constructor." + + For information on how the arglist for a "boa constructor" is + processed, see *note Boa Lambda Lists::. + + It is permissible to use the :constructor option more than once, so + that you can define several different constructor functions, each + taking different parameters. + + [Reviewer Note by Barmar: What about (:constructor) and + (:constructor nil). Should we worry about it?] + + defstruct creates the default-named keyword constructor function + only if no explicit :constructor options are specified, or if the + :constructor option is specified without a name argument. + + (:constructor nil) is meaningful only when there are no other + :constructor options specified. It prevents defstruct from + generating any constructors at all. + + Otherwise, defstruct creates a constructor function corresponding + to each supplied :constructor option. It is permissible to specify + multiple keyword constructor functions as well as multiple "boa + constructors". + +:copier + This option takes one argument, a symbol, which specifies the name + of the copier function. If the argument is not provided or if the + option itself is not provided, the name of the copier is produced + by concatenating the string "COPY-" and the name of the structure, + interning the name in whatever package is current at the time + defstruct is expanded. If the argument is provided and is nil, no + copier function is defined. + + The automatically defined copier function is a function of one + argument, + + which must be of the structure type being defined. + + The copier function creates a fresh structure that has the same + type as its argument, and that has the same component values as the + original structure; that is, the component values are not copied + recursively. + + If the defstruct :type option was not used, the following + equivalence applies: + + (copier-name x) = (copy-structure (the structure-name x)) + +:include + This option is used for building a new structure definition as an + extension of another structure definition. For example: + + (defstruct person name age sex) + + To make a new structure to represent an astronaut that has the + attributes of name, age, and sex, and functions that operate on + person structures, astronaut is defined with :include as follows: + + (defstruct (astronaut (:include person) + (:conc-name astro-)) + helmet-size + (favorite-beverage 'tang)) + + :include causes the structure being defined to have the same slots + as the included structure. This is done in such a way that the + reader functions for the included structure also work on the + structure being defined. In this example, an astronaut therefore + has five slots: the three defined in person and the two defined in + astronaut itself. The reader functions defined by the person + structure can be applied to instances of the astronaut structure, + and they work correctly. Moreover, astronaut has its own reader + functions for components defined by the person structure. The + following examples illustrate the use of astronaut structures: + + (setq x (make-astronaut :name 'buzz + :age 45. + :sex t + :helmet-size 17.5)) + (person-name x) => BUZZ + (astro-name x) => BUZZ + (astro-favorite-beverage x) => TANG + + (reduce #'+ astros :key #'person-age) ; obtains the total of the ages + ; of the possibly empty + ; sequence of astros + + The difference between the reader functions person-name and + astro-name is that person-name can be correctly applied to any + person, including an astronaut, while astro-name can be correctly + applied only to an astronaut. An implementation might check for + incorrect use of reader functions. + + At most one :include can be supplied in a single defstruct. The + argument to :include is required and must be the name of some + previously defined structure. If the structure being defined has + no :type option, then the included structure must also have had no + :type option supplied for it. If the structure being defined has a + :type option, then the included structure must have been declared + with a :type option specifying the same representation type. + + If no :type option is involved, then the structure name of the + including structure definition becomes the name of a data type, and + therefore a valid type specifier recognizable by typep; it becomes + a subtype of the included structure. In the above example, + astronaut is a subtype of person; hence + + (typep (make-astronaut) 'person) => true + + indicating that all operations on persons also work on astronauts. + + The structure using :include can specify default values or + slot-options for the included slots different from those the + included structure specifies, by giving the :include option as: + + (:include included-structure-name {slot-description}*) + + Each slot-description must have a slot-name that is the same as + that of some slot in the included structure. If a slot-description + has no slot-initform, then in the new structure the slot has no + initial value. Otherwise its initial value form is replaced by the + slot-initform in the slot-description. A normally writable slot + can be made read-only. If a slot is read-only in the included + structure, then it must also be so in the including structure. If + a type is supplied for a slot, it must be a subtype of the type + specified in the included structure. + + For example, if the default age for an astronaut is 45, then + + (defstruct (astronaut (:include person (age 45))) + helmet-size + (favorite-beverage 'tang)) + + If :include is used with the :type option, then the effect is first + to skip over as many representation elements as needed to represent + the included structure, then to skip over any additional elements + supplied by the :initial-offset option, and then to begin + allocation of elements from that point. For example: + + (defstruct (binop (:type list) :named (:initial-offset 2)) + (operator '? :type symbol) + operand-1 + operand-2) => BINOP + (defstruct (annotated-binop (:type list) + (:initial-offset 3) + (:include binop)) + commutative associative identity) => ANNOTATED-BINOP + (make-annotated-binop :operator '* + :operand-1 'x + :operand-2 5 + :commutative t + :associative t + :identity 1) + => (NIL NIL BINOP * X 5 NIL NIL NIL T T 1) + + The first two nil elements stem from the :initial-offset of 2 in + the definition of binop. The next four elements contain the + structure name and three slots for binop. The next three nil + elements stem from the :initial-offset of 3 in the definition of + annotated-binop. The last three list elements contain the + additional slots for an annotated-binop. + +:initial-offset + :initial-offset instructs defstruct to skip over a certain number + of slots before it starts allocating the slots described in the + body. This option's argument is the number of slots defstruct + should skip. :initial-offset can be used only if :type is also + supplied. + + [Reviewer Note by Barmar: What are initial values of the skipped + slots?] + + :initial-offset allows slots to be allocated beginning at a + representational element other than the first. For example, the + form + + (defstruct (binop (:type list) (:initial-offset 2)) + (operator '? :type symbol) + operand-1 + operand-2) => BINOP + + would result in the following behavior for make-binop: + + (make-binop :operator '+ :operand-1 'x :operand-2 5) + => (NIL NIL + X 5) + (make-binop :operand-2 4 :operator '*) + => (NIL NIL * NIL 4) + + The selector functions binop-operator, binop-operand-1, and + binop-operand-2 would be essentially equivalent to third, fourth, + and fifth, respectively. Similarly, the form + + (defstruct (binop (:type list) :named (:initial-offset 2)) + (operator '? :type symbol) + operand-1 + operand-2) => BINOP + + would result in the following behavior for make-binop: + + (make-binop :operator '+ :operand-1 'x :operand-2 5) => (NIL NIL BINOP + X 5) + (make-binop :operand-2 4 :operator '*) => (NIL NIL BINOP * NIL 4) + + The first two nil elements stem from the :initial-offset of 2 in + the definition of binop. The next four elements contain the + structure name and three slots for binop. + +:named + :named specifies that the structure is named. If no :type is + supplied, then the structure is always named. + + For example: + + (defstruct (binop (:type list)) + (operator '? :type symbol) + operand-1 + operand-2) => BINOP + + This defines a constructor function make-binop and three selector + functions, namely binop-operator, binop-operand-1, and + binop-operand-2. (It does not, however, define a predicate + binop-p, for reasons explained below.) + + The effect of make-binop is simply to construct a list of length + three: + + (make-binop :operator '+ :operand-1 'x :operand-2 5) => (+ X 5) + (make-binop :operand-2 4 :operator '*) => (* NIL 4) + + It is just like the function list except that it takes keyword + arguments and performs slot defaulting appropriate to the binop + conceptual data type. Similarly, the selector functions + binop-operator, binop-operand-1, and binop-operand-2 are + essentially equivalent to car, cadr, and caddr, respectively. They + might not be completely equivalent because, for example, an + implementation would be justified in adding error-checking code to + ensure that the argument to each selector function is a length-3 + list. + + binop is a conceptual data type in that it is not made a part of + the Common Lisp type system. typep does not recognize binop as a + type specifier, and type-of returns list when given a binop + structure. There is no way to distinguish a data structure + constructed by make-binop from any other list that happens to have + the correct structure. + + There is not any way to recover the structure name binop from a + structure created by make-binop. This can only be done if the + structure is named. A named structure has the property that, given + an instance of the structure, the structure name (that names the + type) can be reliably recovered. For structures defined with no + :type option, the structure name actually becomes part of the + Common Lisp data-type system. type-of, when applied to such a + structure, returns the structure name as the type of the object; + typep recognizes the structure name as a valid type specifier. + + For structures defined with a :type option, type-of returns a type + specifier such as list or (vector t), depending on the type + supplied to the :type option. The structure name does not become a + valid type specifier. However, if the :named option is also + supplied, then the first component of the structure (as created by + a defstruct constructor function) always contains the structure + name. This allows the structure name to be recovered from an + instance of the structure and allows a reasonable predicate for the + conceptual type to be defined: the automatically defined name-p + predicate for the structure operates by first checking that its + argument is of the proper type (list, (vector t), or whatever) and + then checking whether the first component contains the appropriate + type name. + + Consider the binop example shown above, modified only to include + the :named option: + + (defstruct (binop (:type list) :named) + (operator '? :type symbol) + operand-1 + operand-2) => BINOP + + As before, this defines a constructor function make-binop and three + selector functions binop-operator, binop-operand-1, and + binop-operand-2. It also defines a predicate binop-p. The effect + of make-binop is now to construct a list of length four: + + (make-binop :operator '+ :operand-1 'x :operand-2 5) => (BINOP + X 5) + (make-binop :operand-2 4 :operator '*) => (BINOP * NIL 4) + + The structure has the same layout as before except that the + structure name binop is included as the first list element. The + selector functions binop-operator, binop-operand-1, and + binop-operand-2 are essentially equivalent to cadr, caddr, and + cadddr, respectively. The predicate binop-p is more or less + equivalent to this definition: + + (defun binop-p (x) + (and (consp x) (eq (car x) 'binop))) => BINOP-P + + The name binop is still not a valid type specifier recognizable to + typep, but at least there is a way of distinguishing binop + structures from other similarly defined structures. + +:predicate + This option takes one argument, which specifies the name of the + type predicate. If the argument is not supplied or if the option + itself is not supplied, the name of the predicate is made by + concatenating the name of the structure to the string "-P", + interning the name in whatever package is current at the time + defstruct is expanded. If the argument is provided and is nil, no + predicate is defined. A predicate can be defined only if the + structure is named; if :type is supplied and :named is not + supplied, then :predicate must either be unsupplied or have the + value nil. + +:print-function, :print-object + The :print-function and :print-object options specify that a + print-object method for structures of type structure-name should be + generated. These options are not synonyms, but do perform a + similar service; the choice of which option (:print-function or + :print-object) is used affects how the function named printer-name + is called. Only one of these options may be used, and these + options may be used only if :type is not supplied. + + If the :print-function option is used, then when a structure of + type structure-name is to be printed, the designated printer + function is called on three arguments: + + - + the structure to be printed (a generalized instance of + structure-name). + + - + a stream to print to. + + - + an integer indicating the current depth. The magnitude of + this integer may vary between implementations; however, it can + reliably be compared against *print-level* to determine + whether depth abbreviation is appropriate. + + Specifying (:print-function printer-name) is approximately + equivalent to specifying: + + (defmethod print-object ((object structure-name) stream) + (funcall (function printer-name) object stream <>)) + + where the <> represents the printer's belief + of how deep it is currently printing. It is + implementation-dependent whether <> is always + 0 and *print-level*, if non-nil, is re-bound to successively + smaller values as printing descends recursively, or whether + current-print-depth varies in value as printing descends + recursively and *print-level* remains constant during the same + traversal. + + If the :print-object option is used, then when a structure of type + structure-name is to be printed, the designated printer function is + called on two arguments: + + - + the structure to be printed. + + - + the stream to print to. + + Specifying (:print-object printer-name) is equivalent to + specifying: + + (defmethod print-object ((object structure-name) stream) + (funcall (function printer-name) object stream)) + + If no :type option is supplied, and if either a :print-function or + a :print-object option is supplied, and if no printer-name is + supplied, then a print-object method specialized for structure-name + is generated that calls a function that implements the default + printing behavior for structures using #S notation; see *note + Printing Structures::. + + If neither a :print-function nor a :print-object option is + supplied, then defstruct does not generate a print-object method + specialized for structure-name and some default behavior is + inherited either from a structure named in an :include option or + from the default behavior for printing structures; see the function + print-object and *note Printing Structures::. + + When *print-circle* is true, a user-defined print function can + print objects to the supplied stream using write, prin1, princ, or + format and expect circularities to be detected and printed using + the #n# syntax. This applies to methods on print-object in + addition to :print-function options. If a user-defined print + function prints to a stream other than the one that was supplied, + then circularity detection starts over for that stream. See the + variable *print-circle*. + +:type + :type explicitly specifies the representation to be used for the + structure. Its argument must be one of these types: + + vector + This produces the same result as specifying (vector t). The + structure is represented as a general vector, storing + components as vector elements. The first component is vector + element 1 if the structure is :named, and element 0 otherwise. + + [Reviewer Note by Barmar: Do any implementations create + non-simple vectors?] + + (vector element-type) + The structure is represented as a (possibly specialized) + vector, storing components as vector elements. Every + component must be of a type that can be stored in a vector of + the type specified. The first component is vector element 1 + if the structure is :named, and element 0 otherwise. The + structure can be :named only if the type symbol is a subtype + of the supplied element-type. + + list + The structure is represented as a list. The first component + is the cadr if the structure is :named, and the car if it is + not :named. + + Specifying this option has the effect of forcing a specific + representation and of forcing the components to be stored in the + order specified in defstruct in corresponding successive elements + of the specified representation. It also prevents the structure + name from becoming a valid type specifier recognizable by typep. + + For example: + + (defstruct (quux (:type list) :named) x y) + + should make a constructor that builds a list exactly like the one + that list produces, with quux as its car. + + If this type is defined: + + (deftype quux () '(satisfies quux-p)) + + then this form + + (typep (make-quux) 'quux) + + should return precisely what this one does + + (typep (list 'quux nil nil) 'quux) + + If :type is not supplied, the structure is represented as an object + of type structure-object. + + defstruct without a :type option defines a class with the structure + name as its name. The metaclass of structure instances is + structure-class. + + The consequences of redefining a defstruct structure are undefined. + + In the case where no defstruct options have been supplied, the +following functions are automatically defined to operate on instances of +the new structure: + +Predicate + A predicate with the name structure-name-p is defined to test + membership in the structure type. The predicate (structure-name-p + object) is true if an object is of this type; otherwise it is + false. typep can also be used with the name of the new type to + test whether an object belongs to the type. Such a function call + has the form (typep object 'structure-name). + +Component reader functions + Reader functions are defined to read the components of the + structure. For each slot name, there is a corresponding reader + function with the name structure-name-slot-name. This function + reads the contents of that slot. Each reader function takes one + argument, which is an instance of the structure type. setf can be + used with any of these reader functions to alter the slot contents. + +Constructor function + A constructor function with the name make-structure-name is + defined. This function creates and returns new instances of the + structure type. + +Copier function + A copier function with the name copy-structure-name is defined. + The copier function takes an object of the structure type and + creates a new object of the same type that is a copy of the first. + The copier function creates a new structure with the same component + entries as the original. Corresponding components of the two + structure instances are eql. + + If a defstruct form appears as a top level form, the compiler must +make the structure type name recognized as a valid type name in +subsequent declarations (as for deftype) and make the structure slot +readers known to setf. In addition, the compiler must save enough +information about the structure type so that further defstruct +definitions can use :include in a subsequent deftype in the same file to +refer to the structure type name. The functions which defstruct +generates are not defined in the compile time environment, although the +compiler may save enough information about the functions to code +subsequent calls inline. The #S reader macro might or might not +recognize the newly defined structure type name at compile time. + +Examples:: +.......... + +An example of a structure definition follows: + + (defstruct ship + x-position + y-position + x-velocity + y-velocity + mass) + + This declares that every ship is an object with five named +components. The evaluation of this form does the following: + +1. + It defines ship-x-position to be a function of one argument, a + ship, that returns the x-position of the ship; ship-y-position and + the other components are given similar function definitions. These + functions are called the access functions, as they are used to + access elements of the structure. + +2. + ship becomes the name of a type of which instances of ships are + elements. ship becomes acceptable to typep, for example; (typep x + 'ship) is true if x is a ship and false if x is any object other + than a ship. + +3. + A function named ship-p of one argument is defined; it is a + predicate that is true if its argument is a ship and is false + otherwise. + +4. + A function called make-ship is defined that, when invoked, creates + a data structure with five components, suitable for use with the + access functions. Thus executing + + (setq ship2 (make-ship)) + + sets ship2 to a newly created ship object. One can supply the + initial values of any desired component in the call to make-ship by + using keyword arguments in this way: + + (setq ship2 (make-ship :mass *default-ship-mass* + :x-position 0 + :y-position 0)) + + This constructs a new ship and initializes three of its components. + This function is called the "constructor function" because it + constructs a new structure. + +5. + A function called copy-ship of one argument is defined that, when + given a ship object, creates a new ship object that is a copy of + the given one. This function is called the "copier function." + + setf can be used to alter the components of a ship: + + (setf (ship-x-position ship2) 100) + + This alters the x-position of ship2 to be 100. This works because +defstruct behaves as if it generates an appropriate defsetf for each +access function. + + ;;; + ;;; Example 1 + ;;; define town structure type + ;;; area, watertowers, firetrucks, population, elevation are its components + ;;; + (defstruct town + area + watertowers + (firetrucks 1 :type fixnum) ;an initialized slot + population + (elevation 5128 :read-only t)) ;a slot that can't be changed + => TOWN + ;create a town instance + (setq town1 (make-town :area 0 :watertowers 0)) => #S(TOWN...) + ;town's predicate recognizes the new instance + (town-p town1) => true + ;new town's area is as specified by make-town + (town-area town1) => 0 + ;new town's elevation has initial value + (town-elevation town1) => 5128 + ;setf recognizes reader function + (setf (town-population town1) 99) => 99 + (town-population town1) => 99 + ;copier function makes a copy of town1 + (setq town2 (copy-town town1)) => #S(TOWN...) + (= (town-population town1) (town-population town2)) => true + ;since elevation is a read-only slot, its value can be set only + ;when the structure is created + (setq town3 (make-town :area 0 :watertowers 3 :elevation 1200)) + => #S(TOWN...) + ;;; + ;;; Example 2 + ;;; define clown structure type + ;;; this structure uses a nonstandard prefix + ;;; + (defstruct (clown (:conc-name bozo-)) + (nose-color 'red) + frizzy-hair-p polkadots) => CLOWN + (setq funny-clown (make-clown)) => #S(CLOWN) + ;use non-default reader name + (bozo-nose-color funny-clown) => RED + (defstruct (klown (:constructor make-up-klown) ;similar def using other + (:copier clone-klown) ;customizing keywords + (:predicate is-a-bozo-p)) + nose-color frizzy-hair-p polkadots) => klown + ;custom constructor now exists + (fboundp 'make-up-klown) => true + ;;; + ;;; Example 3 + ;;; define a vehicle structure type + ;;; then define a truck structure type that includes + ;;; the vehicle structure + ;;; + (defstruct vehicle name year (diesel t :read-only t)) => VEHICLE + (defstruct (truck (:include vehicle (year 79))) + load-limit + (axles 6)) => TRUCK + (setq x (make-truck :name 'mac :diesel t :load-limit 17)) + => #S(TRUCK...) + ;vehicle readers work on trucks + (vehicle-name x) + => MAC + ;default taken from :include clause + (vehicle-year x) + => 79 + (defstruct (pickup (:include truck)) ;pickup type includes truck + camper long-bed four-wheel-drive) => PICKUP + (setq x (make-pickup :name 'king :long-bed t)) => #S(PICKUP...) + ;:include default inherited + (pickup-year x) => 79 + ;;; + ;;; Example 4 + ;;; use of BOA constructors + ;;; + (defstruct (dfs-boa ;BOA constructors + (:constructor make-dfs-boa (a b c)) + (:constructor create-dfs-boa + (a &optional b (c 'cc) &rest d &aux e (f 'ff)))) + a b c d e f) => DFS-BOA + ;a, b, and c set by position, and the rest are uninitialized + (setq x (make-dfs-boa 1 2 3)) => #(DFS-BOA...) + (dfs-boa-a x) => 1 + ;a and b set, c and f defaulted + (setq x (create-dfs-boa 1 2)) => #(DFS-BOA...) + (dfs-boa-b x) => 2 + (eq (dfs-boa-c x) 'cc) => true + ;a, b, and c set, and the rest are collected into d + (setq x (create-dfs-boa 1 2 3 4 5 6)) => #(DFS-BOA...) + (dfs-boa-d x) => (4 5 6) + +Exceptional Situations:: +........................ + +If any two slot names (whether present directly or inherited by the +:include option) are the same under string=, defstruct should signal an +error of type program-error. + + The consequences are undefined if the included-structure-name does +not name a structure type. + +See Also:: +.......... + +*note documentation:: , *note print-object:: , *note setf:: , *note +subtypep:: , *note type-of:: , *note typep:: , *note Compilation:: + +Notes:: +....... + +The printer-name should observe the values of such printer-control +variables as *print-escape*. + + The restriction against issuing a warning for type mismatches between +a slot-initform and the corresponding slot's :type option is necessary +because a slot-initform must be specified in order to specify slot +options; in some cases, no suitable default may exist. + + The mechanism by which defstruct arranges for slot accessors to be +usable with setf is implementation-dependent; for example, it may use +setf functions, setf expanders, or some other implementation-dependent +mechanism known to that implementation's code for setf. + + +File: gcl.info, Node: copy-structure, Prev: defstruct, Up: Structures Dictionary + +8.1.2 copy-structure [Function] +------------------------------- + +'copy-structure' structure => copy + +Arguments and Values:: +...................... + +structure--a structure. + + copy--a copy of the structure. + +Description:: +............. + +Returns a copy_6 of the structure. + + Only the structure itself is copied; not the values of the slots. + +See Also:: +.......... + +the :copier option to *note defstruct:: + +Notes:: +....... + +The copy is the same as the given structure under equalp, but not under +equal. + + +File: gcl.info, Node: Conditions, Next: Symbols, Prev: Structures, Up: Top + +9 Conditions +************ + +* Menu: + +* Condition System Concepts:: +* Conditions Dictionary:: + + +File: gcl.info, Node: Condition System Concepts, Next: Conditions Dictionary, Prev: Conditions, Up: Conditions + +9.1 Condition System Concepts +============================= + +Common Lisp constructs are described not only in terms of their behavior +in situations during which they are intended to be used (see the +"Description" part of each operator specification), but in all other +situations (see the "Exceptional Situations" part of each operator +specification). + + A situation is the evaluation of an expression in a specific context. +A condition is an object that represents a specific situation that has +been detected. Conditions are generalized instances of the class +condition. A hierarchy of condition classes is defined in Common Lisp. +A condition has slots that contain data relevant to the situation that +the condition represents. + + An error is a situation in which normal program execution cannot +continue correctly without some form of intervention (either +interactively by the user or under program control). Not all errors are +detected. When an error goes undetected, the effects can be +implementation-dependent, implementation-defined, unspecified, or +undefined. See *note Definitions::. All detected errors can be +represented by conditions, but not all conditions represent errors. + + Signaling is the process by which a condition can alter the flow of +control in a program by raising the condition which can then be handled. +The functions error, cerror, signal, and warn are used to signal +conditions. + + The process of signaling involves the selection and invocation of a +handler from a set of active handlers. A handler is a function of one +argument (the condition) that is invoked to handle a condition. Each +handler is associated with a condition type, and a handler will be +invoked only on a condition of the handler's associated type. + + Active handlers are established dynamically (see handler-bind or +handler-case). Handlers are invoked in a dynamic environment equivalent +to that of the signaler, except that the set of active handlers is bound +in such a way as to include only those that were active at the time the +handler being invoked was established. Signaling a condition has no +side-effect on the condition, and there is no dynamic state contained in +a condition. + + If a handler is invoked, it can address the situation in one of three +ways: + +Decline + It can decline to handle the condition. It does this by simply + returning rather than transferring control. When this happens, any + values returned by the handler are ignored and the next most + recently established handler is invoked. If there is no such + handler and the signaling function is error or cerror, the debugger + is entered in the dynamic environment of the signaler. If there is + no such handler and the signaling function is either signal or + warn, the signaling function simply returns~nil. + +Handle + It can handle the condition by performing a non-local transfer of + control. This can be done either primitively by using go, return, + throw or more abstractly by using a function such as abort or + invoke-restart. + +Defer + It can put off a decision about whether to handle or decline, by + any of a number of actions, but most commonly by signaling another + condition, resignaling the same condition, or forcing entry into + the debugger. + +* Menu: + +* Condition Types:: +* Creating Conditions:: +* Printing Conditions:: +* Signaling and Handling Conditions:: +* Assertions:: +* Notes about the Condition System`s Background:: + + +File: gcl.info, Node: Condition Types, Next: Creating Conditions, Prev: Condition System Concepts, Up: Condition System Concepts + +9.1.1 Condition Types +--------------------- + +Figure 9-1 lists the standardized condition types. Additional condition +types can be defined by using define-condition. + + arithmetic-error floating-point-overflow simple-type-error + cell-error floating-point-underflow simple-warning + condition package-error storage-condition + control-error parse-error stream-error + division-by-zero print-not-readable style-warning + end-of-file program-error type-error + error reader-error unbound-slot + file-error serious-condition unbound-variable + floating-point-inexact simple-condition undefined-function + floating-point-invalid-operation simple-error warning + + Figure 9-1: Standardized Condition Types + + + All condition types are subtypes of type condition. That is, + + (typep c 'condition) => true + + if and only if c is a condition. + + Implementations must define all specified subtype relationships. +Except where noted, all subtype relationships indicated in this document +are not mutually exclusive. A condition inherits the structure of its +supertypes. + + The metaclass of the class condition is not specified. Names of +condition types may be used to specify supertype relationships in +define-condition, but the consequences are not specified if an attempt +is made to use a condition type as a superclass in a defclass form. + + Figure 9-2 shows operators that define condition types and creating +conditions. + + define-condition make-condition + + Figure 9-2: Operators that define and create conditions. + + + Figure 9-3 shows operators that read the value of condition slots. + + arithmetic-error-operands simple-condition-format-arguments + arithmetic-error-operation simple-condition-format-control + cell-error-name stream-error-stream + file-error-pathname type-error-datum + package-error-package type-error-expected-type + print-not-readable-object unbound-slot-instance + + Figure 9-3: Operators that read condition slots. + + +* Menu: + +* Serious Conditions:: + + +File: gcl.info, Node: Serious Conditions, Prev: Condition Types, Up: Condition Types + +9.1.1.1 Serious Conditions +.......................... + +A serious condition is a condition serious enough to require interactive +intervention if not handled. Serious conditions are typically signaled +with error or cerror; non-serious conditions are typically signaled with +signal or warn. + + +File: gcl.info, Node: Creating Conditions, Next: Printing Conditions, Prev: Condition Types, Up: Condition System Concepts + +9.1.2 Creating Conditions +------------------------- + +The function make-condition can be used to construct a condition object +explicitly. Functions such as error, cerror, signal, and warn operate +on conditions and might create condition objects implicitly. Macros +such as ccase, ctypecase, ecase, etypecase, check-type, and assert might +also implicitly create (and signal) conditions. + +* Menu: + +* Condition Designators:: + + +File: gcl.info, Node: Condition Designators, Prev: Creating Conditions, Up: Creating Conditions + +9.1.2.1 Condition Designators +............................. + +A number of the functions in the condition system take arguments which +are identified as condition designators . By convention, those +arguments are notated as + + datum &rest arguments + + Taken together, the datum and the arguments are "designators for a +condition of default type default-type." How the denoted condition is +computed depends on the type of the datum: + +* If the datum is a symbol + naming a condition type ... The denoted condition is the result of + + (apply #'make-condition datum arguments) + +* If the datum is a format control ... + + The denoted condition is the result of + + (make-condition defaulted-type + :format-control datum + :format-arguments arguments) + + where the defaulted-type is a subtype of default-type. + +* If the datum is a condition ... + The denoted condition is the datum itself. In this case, unless + otherwise specified by the description of the operator in question, + the arguments must be null; that is, the consequences are undefined + if any arguments were supplied. + + Note that the default-type gets used only in the case where the datum +string is supplied. In the other situations, the resulting condition is +not necessarily of type default-type. + + Here are some illustrations of how different condition designators +can denote equivalent condition objects: + + (let ((c (make-condition 'arithmetic-error :operator '/ :operands '(7 0)))) + (error c)) + == (error 'arithmetic-error :operator '/ :operands '(7 0)) + + (error "Bad luck.") + == (error 'simple-error :format-control "Bad luck." :format-arguments '()) + + +File: gcl.info, Node: Printing Conditions, Next: Signaling and Handling Conditions, Prev: Creating Conditions, Up: Condition System Concepts + +9.1.3 Printing Conditions +------------------------- + +If the :report argument to define-condition is used, a print function is +defined that is called whenever the defined condition is printed while +the value of *print-escape* is false. This function is called the +condition reporter ; the text which it outputs is called a report +message . + + When a condition is printed and *print-escape* is false, the +condition reporter for the condition is invoked. Conditions are printed +automatically by functions such as invoke-debugger, break, and warn. + + When *print-escape* is true, the object should print in an +abbreviated fashion according to the style of the implementation (e.g., +by print-unreadable-object). It is not required that a condition can be +recreated by reading its printed representation. + + No function is provided for directly accessing or invoking condition +reporters. + +* Menu: + +* Recommended Style in Condition Reporting:: +* Capitalization and Punctuation in Condition Reports:: +* Leading and Trailing Newlines in Condition Reports:: +* Embedded Newlines in Condition Reports:: +* Note about Tabs in Condition Reports:: +* Mentioning Containing Function in Condition Reports:: + + +File: gcl.info, Node: Recommended Style in Condition Reporting, Next: Capitalization and Punctuation in Condition Reports, Prev: Printing Conditions, Up: Printing Conditions + +9.1.3.1 Recommended Style in Condition Reporting +................................................ + +In order to ensure a properly aesthetic result when presenting report +messages to the user, certain stylistic conventions are recommended. + + There are stylistic recommendations for the content of the messages +output by condition reporters, but there are no formal requirements on +those programs. If a program violates the recommendations for some +message, the display of that message might be less aesthetic than if the +guideline had been observed, but the program is still considered a +conforming program. + + The requirements on a program or implementation which invokes a +condition reporter are somewhat stronger. A conforming program must be +permitted to assume that if these style guidelines are followed, proper +aesthetics will be maintained. Where appropriate, any specific +requirements on such routines are explicitly mentioned below. + + +File: gcl.info, Node: Capitalization and Punctuation in Condition Reports, Next: Leading and Trailing Newlines in Condition Reports, Prev: Recommended Style in Condition Reporting, Up: Printing Conditions + +9.1.3.2 Capitalization and Punctuation in Condition Reports +........................................................... + +It is recommended that a report message be a complete sentences, in the +proper case and correctly punctuated. In English, for example, this +means the first letter should be uppercase, and there should be a +trailing period. + + (error "This is a message") ; Not recommended + (error "this is a message.") ; Not recommended + + (error "This is a message.") ; Recommended instead + + +File: gcl.info, Node: Leading and Trailing Newlines in Condition Reports, Next: Embedded Newlines in Condition Reports, Prev: Capitalization and Punctuation in Condition Reports, Up: Printing Conditions + +9.1.3.3 Leading and Trailing Newlines in Condition Reports +.......................................................... + +It is recommended that a report message not begin with any introductory +text, such as "Error: " or "Warning: " or even just freshline or +newline. Such text is added, if appropriate to the context, by the +routine invoking the condition reporter. + + It is recommended that a report message not be followed by a trailing +freshline or newline. Such text is added, if appropriate to the +context, by the routine invoking the condition reporter. + + (error "This is a message.~ + (error "~&This is a message.") ; Not recommended + (error "~&This is a message.~ + + (error "This is a message.") ; Recommended instead + + +File: gcl.info, Node: Embedded Newlines in Condition Reports, Next: Note about Tabs in Condition Reports, Prev: Leading and Trailing Newlines in Condition Reports, Up: Printing Conditions + +9.1.3.4 Embedded Newlines in Condition Reports +.............................................. + +Especially if it is long, it is permissible and appropriate for a report +message to contain one or more embedded newlines. + + If the calling routine conventionally inserts some additional prefix +(such as "Error: " or ";; Error: ") on the first line of the message, it +must also assure that an appropriate prefix will be added to each +subsequent line of the output, so that the left edge of the message +output by the condition reporter will still be properly aligned. + + (defun test () + (error "This is an error message.~%It has two lines.")) + + ;; Implementation A + (test) + This is an error message. + It has two lines. + + ;; Implementation B + (test) + ;; Error: This is an error message. + ;; It has two lines. + + ;; Implementation C + (test) + >> Error: This is an error message. + It has two lines. + + +File: gcl.info, Node: Note about Tabs in Condition Reports, Next: Mentioning Containing Function in Condition Reports, Prev: Embedded Newlines in Condition Reports, Up: Printing Conditions + +9.1.3.5 Note about Tabs in Condition Reports +............................................ + +Because the indentation of a report message might be shifted to the +right or left by an arbitrary amount, special care should be taken with +the semi-standard character (in those implementations that support +such a character). Unless the implementation specifically defines its +behavior in this context, its use should be avoided. + + +File: gcl.info, Node: Mentioning Containing Function in Condition Reports, Prev: Note about Tabs in Condition Reports, Up: Printing Conditions + +9.1.3.6 Mentioning Containing Function in Condition Reports +........................................................... + +The name of the containing function should generally not be mentioned in +report messages. It is assumed that the debugger will make this +information accessible in situations where it is necessary and +appropriate. + + +File: gcl.info, Node: Signaling and Handling Conditions, Next: Assertions, Prev: Printing Conditions, Up: Condition System Concepts + +9.1.4 Signaling and Handling Conditions +--------------------------------------- + +The operation of the condition system depends on the ordering of active +applicable handlers from most recent to least recent. + + Each handler is associated with a type specifier that must designate +a subtype of type condition. A handler is said to be applicable to a +condition if that condition is of the type designated by the associated +type specifier. + + Active handlers are established by using handler-bind (or an +abstraction based on handler-bind, such as handler-case or +ignore-errors). + + Active handlers can be established within the dynamic scope of other +active handlers. At any point during program execution, there is a set +of active handlers. When a condition is signaled, the most recent +active applicable handler for that condition is selected from this set. +Given a condition, the order of recentness of active applicable handlers +is defined by the following two rules: + +1. + Each handler in a set of active handlers H_1 is more recent than + every handler in a set H_2 if the handlers in H_2 were active when + the handlers in H_1 were established. + +2. + Let h_1 and h_2 be two applicable active handlers established by + the same form. Then h_1 is more recent than h_2 if h_1 was defined + to the left of h_2 in the form that established them. + + Once a handler in a handler binding form (such as handler-bind or +handler-case) has been selected, all handlers in that form become +inactive for the remainder of the signaling process. While the selected +handler runs, no other handler established by that form is active. That +is, if the handler declines, no other handler established by that form +will be considered for possible invocation. + + Figure 9-4 shows operators relating to the handling of conditions. + + handler-bind handler-case ignore-errors + + Figure 9-4: Operators relating to handling conditions. + + +* Menu: + +* Signaling:: +* Resignaling a Condition:: +* Restarts:: +* Interactive Use of Restarts:: +* Interfaces to Restarts:: +* Restart Tests:: +* Associating a Restart with a Condition:: + + +File: gcl.info, Node: Signaling, Next: Resignaling a Condition, Prev: Signaling and Handling Conditions, Up: Signaling and Handling Conditions + +9.1.4.1 Signaling +................. + +When a condition is signaled, the most recent applicable active handler +is invoked. Sometimes a handler will decline by simply returning +without a transfer of control. In such cases, the next most recent +applicable active handler is invoked. + + If there are no applicable handlers for a condition that has been +signaled, or if all applicable handlers decline, the condition is +unhandled. + + The functions cerror and error invoke the interactive condition +handler (the debugger) rather than return if the condition being +signaled, regardless of its type, is unhandled. In contrast, signal +returns nil if the condition being signaled, regardless of its type, is +unhandled. + + The variable *break-on-signals* can be used to cause the debugger to +be entered before the signaling process begins. + + Figure 9-5 shows defined names relating to the signaling of +conditions. + + *break-on-signals* error warn + cerror signal + + Figure 9-5: Defined names relating to signaling conditions. + + + +File: gcl.info, Node: Resignaling a Condition, Next: Restarts, Prev: Signaling, Up: Signaling and Handling Conditions + +9.1.4.2 Resignaling a Condition +............................... + +During the dynamic extent of the signaling process for a particular +condition object, signaling the same condition object again is permitted +if and only if the situation represented in both cases are the same. + + For example, a handler might legitimately signal the condition object +that is its argument in order to allow outer handlers first opportunity +to handle the condition. (Such a handlers is sometimes called a +"default handler.") This action is permitted because the situation +which the second signaling process is addressing is really the same +situation. + + On the other hand, in an implementation that implemented asynchronous +keyboard events by interrupting the user process with a call to signal, +it would not be permissible for two distinct asynchronous keyboard +events to signal identical condition objects at the same time for +different situations. + + +File: gcl.info, Node: Restarts, Next: Interactive Use of Restarts, Prev: Resignaling a Condition, Up: Signaling and Handling Conditions + +9.1.4.3 Restarts +................ + +The interactive condition handler returns only through non-local +transfer of control to specially defined restarts that can be set up +either by the system or by user code. Transferring control to a restart +is called "invoking" the restart. Like handlers, active restarts are +established dynamically, and only active restarts can be invoked. An +active restart can be invoked by the user from the debugger or by a +program by using invoke-restart. + + A restart contains a function to be called when the restart is +invoked, an optional name that can be used to find or invoke the +restart, and an optional set of interaction information for the debugger +to use to enable the user to manually invoke a restart. + + The name of a restart is used by invoke-restart. Restarts that can +be invoked only within the debugger do not need names. + + Restarts can be established by using restart-bind, restart-case, and +with-simple-restart. A restart function can itself invoke any other +restart that was active at the time of establishment of the restart of +which the function is part. + + The restarts established by a restart-bind form, a restart-case form, +or a with-simple-restart form have dynamic extent which extends for the +duration of that form's execution. + + Restarts of the same name can be ordered from least recent to most +recent according to the following two rules: + +1. + Each restart in a set of active restarts R_1 is more recent than + every restart in a set R_2 if the restarts in R_2 were active when + the restarts in R_1 were established. + +2. + Let r_1 and r_2 be two active restarts with the same name + established by the same form. Then r_1 is more recent than r_2 if + r_1 was defined to the left of r_2 in the form that established + them. + + If a restart is invoked but does not transfer control, the values +resulting from the restart function are returned by the function that +invoked the restart, either invoke-restart or +invoke-restart-interactively. + + +File: gcl.info, Node: Interactive Use of Restarts, Next: Interfaces to Restarts, Prev: Restarts, Up: Signaling and Handling Conditions + +9.1.4.4 Interactive Use of Restarts +................................... + +For interactive handling, two pieces of information are needed from a +restart: a report function and an interactive function. + + The report function is used by a program such as the debugger to +present a description of the action the restart will take. The report +function is specified and established by the :report-function keyword to +restart-bind or the :report keyword to restart-case. + + The interactive function, which can be specified using the +:interactive-function keyword to restart-bind or :interactive keyword to +restart-case, is used when the restart is invoked interactively, such as +from the debugger, to produce a suitable list of arguments. + + invoke-restart invokes the most recently established restart whose +name is the same as the first argument to invoke-restart. If a restart +is invoked interactively by the debugger and does not transfer control +but rather returns values, the precise action of the debugger on those +values is implementation-defined. + + +File: gcl.info, Node: Interfaces to Restarts, Next: Restart Tests, Prev: Interactive Use of Restarts, Up: Signaling and Handling Conditions + +9.1.4.5 Interfaces to Restarts +.............................. + +Some restarts have functional interfaces, such as abort, continue, +muffle-warning, store-value, and use-value. They are ordinary functions +that use find-restart and invoke-restart internally, that have the same +name as the restarts they manipulate, and that are provided simply for +notational convenience. + + Figure 9-6 shows defined names relating to restarts. + + abort invoke-restart-interactively store-value + compute-restarts muffle-warning use-value + continue restart-bind with-simple-restart + find-restart restart-case + invoke-restart restart-name + + Figure 9-6: Defined names relating to restarts. + + + +File: gcl.info, Node: Restart Tests, Next: Associating a Restart with a Condition, Prev: Interfaces to Restarts, Up: Signaling and Handling Conditions + +9.1.4.6 Restart Tests +..................... + +Each restart has an associated test, which is a function of one argument +(a condition or nil) which returns true if the restart should be visible +in the current situation. This test is created by the :test-function +option to restart-bind or the :test option to restart-case. + + +File: gcl.info, Node: Associating a Restart with a Condition, Prev: Restart Tests, Up: Signaling and Handling Conditions + +9.1.4.7 Associating a Restart with a Condition +.............................................. + +A restart can be "associated with" a condition explicitly by +with-condition-restarts, or implicitly by restart-case. Such an +assocation has dynamic extent. + + A single restart may be associated with several conditions at the +same time. A single condition may have several associated restarts at +the same time. + + Active restarts associated with a particular condition can be +detected by calling a function such as find-restart, supplying that +condition as the condition argument. Active restarts can also be +detected without regard to any associated condition by calling such a +function without a condition argument, or by supplying a value of nil +for such an argument. + + +File: gcl.info, Node: Assertions, Next: Notes about the Condition System`s Background, Prev: Signaling and Handling Conditions, Up: Condition System Concepts + +9.1.5 Assertions +---------------- + +Conditional signaling of conditions based on such things as key match, +form evaluation, and type are handled by assertion operators. Figure +9-7 shows operators relating to assertions. + + assert check-type ecase + ccase ctypecase etypecase + + Figure 9-7: Operators relating to assertions. + + + +File: gcl.info, Node: Notes about the Condition System`s Background, Prev: Assertions, Up: Condition System Concepts + +9.1.6 Notes about the Condition System's Background +--------------------------------------------------- + +For a background reference to the abstract concepts detailed in this +section, see Exceptional Situations in Lisp. The details of that paper +are not binding on this document, but may be helpful in establishing a +conceptual basis for understanding this material. + + +File: gcl.info, Node: Conditions Dictionary, Prev: Condition System Concepts, Up: Conditions + +9.2 Conditions Dictionary +========================= + +* Menu: + +* condition:: +* warning:: +* style-warning:: +* serious-condition:: +* error (Condition Type):: +* cell-error:: +* cell-error-name:: +* parse-error:: +* storage-condition:: +* assert:: +* error:: +* cerror:: +* check-type:: +* simple-error:: +* invalid-method-error:: +* method-combination-error:: +* signal:: +* simple-condition:: +* simple-condition-format-control:: +* warn:: +* simple-warning:: +* invoke-debugger:: +* break:: +* *debugger-hook*:: +* *break-on-signals*:: +* handler-bind:: +* handler-case:: +* ignore-errors:: +* define-condition:: +* make-condition:: +* restart:: +* compute-restarts:: +* find-restart:: +* invoke-restart:: +* invoke-restart-interactively:: +* restart-bind:: +* restart-case:: +* restart-name:: +* with-condition-restarts:: +* with-simple-restart:: +* abort (Restart):: +* continue:: +* muffle-warning:: +* store-value:: +* use-value:: +* abort (Function):: + + +File: gcl.info, Node: condition, Next: warning, Prev: Conditions Dictionary, Up: Conditions Dictionary + +9.2.1 condition [Condition Type] +-------------------------------- + +[Reviewer Note by Barrett: I think CONDITION-RESTARTS is not fully +integrated.] + +Class Precedence List:: +....................... + +condition, t + +Description:: +............. + +All types of conditions, whether error or non-error, must inherit from +this type. + + No additional subtype relationships among the specified subtypes of +type condition are allowed, except when explicitly mentioned in the +text; however implementations are permitted to introduce additional +types and one of these types can be a subtype of any number of the +subtypes of type condition. + + Whether a user-defined condition type has slots that are accessible +by with-slots is implementation-dependent. Furthermore, even in an +implementation in which user-defined condition types would have slots, +it is implementation-dependent whether any condition types defined in +this document have such slots or, if they do, what their names might be; +only the reader functions documented by this specification may be relied +upon by portable code. + + Conforming code must observe the following restrictions related to +conditions: + +* + define-condition, not defclass, must be used to define new + condition types. + +* + make-condition, not make-instance, must be used to create condition + objects explicitly. + +* + The :report option of define-condition, not defmethod for + print-object, must be used to define a condition reporter. + +* + slot-value, slot-boundp, slot-makunbound, and with-slots must not + be used on condition objects. Instead, the appropriate accessor + functions (defined by define-condition) should be used. + + +File: gcl.info, Node: warning, Next: style-warning, Prev: condition, Up: Conditions Dictionary + +9.2.2 warning [Condition Type] +------------------------------ + +Class Precedence List:: +....................... + +warning, condition, t + +Description:: +............. + +The type warning consists of all types of warnings. + +See Also:: +.......... + +style-warning + + +File: gcl.info, Node: style-warning, Next: serious-condition, Prev: warning, Up: Conditions Dictionary + +9.2.3 style-warning [Condition Type] +------------------------------------ + +Class Precedence List:: +....................... + +style-warning, warning, condition, t + +Description:: +............. + +The type style-warning includes those conditions that represent +situations involving code that is conforming code but that is +nevertheless considered to be faulty or substandard. + +See Also:: +.......... + +*note muffle-warning:: + +Notes:: +....... + +An implementation might signal such a condition if it encounters code +that uses deprecated features or that appears unaesthetic or +inefficient. + + An 'unused variable' warning must be of type style-warning. + + In general, the question of whether code is faulty or substandard is +a subjective decision to be made by the facility processing that code. +The intent is that whenever such a facility wishes to complain about +code on such subjective grounds, it should use this condition type so +that any clients who wish to redirect or muffle superfluous warnings can +do so without risking that they will be redirecting or muffling other, +more serious warnings. + + +File: gcl.info, Node: serious-condition, Next: error (Condition Type), Prev: style-warning, Up: Conditions Dictionary + +9.2.4 serious-condition [Condition Type] +---------------------------------------- + +Class Precedence List:: +....................... + +serious-condition, condition, t + +Description:: +............. + +All conditions serious enough to require interactive intervention if not +handled should inherit from the type serious-condition. This condition +type is provided primarily so that it may be included as a superclass of +other condition types; it is not intended to be signaled directly. + +Notes:: +....... + +Signaling a serious condition does not itself force entry into the +debugger. However, except in the unusual situation where the programmer +can assure that no harm will come from failing to handle a serious +condition, such a condition is usually signaled with error rather than +signal in order to assure that the program does not continue without +handling the condition. (And conversely, it is conventional to use +signal rather than error to signal conditions which are not serious +conditions, since normally the failure to handle a non-serious condition +is not reason enough for the debugger to be entered.) + + +File: gcl.info, Node: error (Condition Type), Next: cell-error, Prev: serious-condition, Up: Conditions Dictionary + +9.2.5 error [Condition Type] +---------------------------- + +Class Precedence List:: +....................... + +error, serious-condition, condition, t + +Description:: +............. + +The type error consists of all conditions that represent errors. + + +File: gcl.info, Node: cell-error, Next: cell-error-name, Prev: error (Condition Type), Up: Conditions Dictionary + +9.2.6 cell-error [Condition Type] +--------------------------------- + +Class Precedence List:: +....................... + +cell-error, error, serious-condition, condition, t + +Description:: +............. + +The type cell-error consists of error conditions that occur during a +location access. The name of the offending cell is initialized by the +:name initialization argument to make-condition, and is accessed by the +function cell-error-name. + +See Also:: +.......... + +*note cell-error-name:: + + +File: gcl.info, Node: cell-error-name, Next: parse-error, Prev: cell-error, Up: Conditions Dictionary + +9.2.7 cell-error-name [Function] +-------------------------------- + +'cell-error-name' condition => name + +Arguments and Values:: +...................... + +condition--a condition of type cell-error. + + name--an object. + +Description:: +............. + +Returns the name of the offending cell involved in the situation +represented by condition. + + The nature of the result depends on the specific type of condition. +For example, if the condition is of type unbound-variable, the result is +the name of the unbound variable which was being accessed, if the +condition is of type undefined-function, this is the name of the +undefined function which was being accessed, and if the condition is of +type unbound-slot, this is the name of the slot which was being +accessed. + +See Also:: +.......... + +cell-error, unbound-slot, unbound-variable, undefined-function, *note +Condition System Concepts:: + + +File: gcl.info, Node: parse-error, Next: storage-condition, Prev: cell-error-name, Up: Conditions Dictionary + +9.2.8 parse-error [Condition Type] +---------------------------------- + +Class Precedence List:: +....................... + +parse-error, error, serious-condition, condition, t + +Description:: +............. + +The type parse-error consists of error conditions that are related to +parsing. + +See Also:: +.......... + +*note parse-namestring:: , *note reader-error:: + + +File: gcl.info, Node: storage-condition, Next: assert, Prev: parse-error, Up: Conditions Dictionary + +9.2.9 storage-condition [Condition Type] +---------------------------------------- + +Class Precedence List:: +....................... + +storage-condition, serious-condition, condition, t + +Description:: +............. + +The type storage-condition consists of serious conditions that relate to +problems with memory management that are potentially due to +implementation-dependent limits rather than semantic errors in +conforming programs, and that typically warrant entry to the debugger if +not handled. Depending on the details of the implementation, these +might include such problems as stack overflow, memory region overflow, +and storage exhausted. + +Notes:: +....... + +While some Common Lisp operations might signal storage-condition because +they are defined to create objects, it is unspecified whether operations +that are not defined to create objects create them anyway and so might +also signal storage-condition. Likewise, the evaluator itself might +create objects and so might signal storage-condition. (The natural +assumption might be that such object creation is naturally inefficient, +but even that is implementation-dependent.) In general, the entire +question of how storage allocation is done is implementation-dependent, +and so any operation might signal storage-condition at any time. +Because such a condition is indicative of a limitation of the +implementation or of the image rather than an error in a program, +objects of type storage-condition are not of type error. + + +File: gcl.info, Node: assert, Next: error, Prev: storage-condition, Up: Conditions Dictionary + +9.2.10 assert [Macro] +--------------------- + +'assert' test-form [({place}*) [datum-form {argument-form}*]] +=> nil + +Arguments and Values:: +...................... + +test-form--a form; always evaluated. + + place--a place; evaluated if an error is signaled. + + datum-form--a form that evaluates to a datum. Evaluated each time an +error is to be signaled, or not at all if no error is to be signaled. + + argument-form--a form that evaluates to an argument. Evaluated each +time an error is to be signaled, or not at all if no error is to be +signaled. + + datum, arguments--designators for a condition of default type error. +(These designators are the result of evaluating datum-form and each of +the argument-forms.) + +Description:: +............. + +assert assures that test-form evaluates to true. If test-form evaluates +to false, assert signals a correctable error (denoted by datum and +arguments). Continuing from this error using the continue restart makes +it possible for the user to alter the values of the places before assert +evaluates test-form again. If the value of test-form is non-nil, assert +returns nil. + + The places are generalized references to data upon which test-form +depends, whose values can be changed by the user in attempting to +correct the error. Subforms of each place are only evaluated if an +error is signaled, and might be re-evaluated if the error is re-signaled +(after continuing without actually fixing the problem). + + The order of evaluation of the places is not specified; see *note +Evaluation of Subforms to Places::. + + If a place form is supplied that produces more values than there are +store variables, the extra values are ignored. If the supplied form +produces fewer values than there are store variables, the missing values +are set to nil. + +Examples:: +.......... + + (setq x (make-array '(3 5) :initial-element 3)) + => #2A((3 3 3 3 3) (3 3 3 3 3) (3 3 3 3 3)) + (setq y (make-array '(3 5) :initial-element 7)) + => #2A((7 7 7 7 7) (7 7 7 7 7) (7 7 7 7 7)) + (defun matrix-multiply (a b) + (let ((*print-array* nil)) + (assert (and (= (array-rank a) (array-rank b) 2) + (= (array-dimension a 1) (array-dimension b 0))) + (a b) + "Cannot multiply ~S by ~S." a b) + (really-matrix-multiply a b))) => MATRIX-MULTIPLY + (matrix-multiply x y) + |> Correctable error in MATRIX-MULTIPLY: + |> Cannot multiply # by #. + |> Restart options: + |> 1: You will be prompted for one or more new values. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + |> Value for A: |>>x<<| + |> Value for B: |>>(make-array '(5 3) :initial-element 6)<<| + => #2A((54 54 54 54 54) + (54 54 54 54 54) + (54 54 54 54 54) + (54 54 54 54 54) + (54 54 54 54 54)) + + (defun double-safely (x) (assert (numberp x) (x)) (+ x x)) + (double-safely 4) + => 8 + + (double-safely t) + |> Correctable error in DOUBLE-SAFELY: The value of (NUMBERP X) must be non-NIL. + |> Restart options: + |> 1: You will be prompted for one or more new values. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + |> Value for X: |>>7<<| + => 14 + +Affected By:: +............. + +*break-on-signals* + + The set of active condition handlers. + +See Also:: +.......... + +*note check-type:: , *note error:: , *note Generalized Reference:: + +Notes:: +....... + +The debugger need not include the test-form in the error message, and +the places should not be included in the message, but they should be +made available for the user's perusal. If the user gives the "continue" +command, the values of any of the references can be altered. The +details of this depend on the implementation's style of user interface. + + +File: gcl.info, Node: error, Next: cerror, Prev: assert, Up: Conditions Dictionary + +9.2.11 error [Function] +----------------------- + +'error' datum &rest arguments => # + +Arguments and Values:: +...................... + +datum, arguments--designators for a condition of default type +simple-error. + +Description:: +............. + +error effectively invokes signal on the denoted condition. + + If the condition is not handled, (invoke-debugger condition) is done. +As a consequence of calling invoke-debugger, error cannot directly +return; the only exit from error can come by non-local transfer of +control in a handler or by use of an interactive debugging command. + +Examples:: +.......... + + (defun factorial (x) + (cond ((or (not (typep x 'integer)) (minusp x)) + (error "~S is not a valid argument to FACTORIAL." x)) + ((zerop x) 1) + (t (* x (factorial (- x 1)))))) + => FACTORIAL + (factorial 20) + => 2432902008176640000 + (factorial -1) + |> Error: -1 is not a valid argument to FACTORIAL. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Return to Lisp Toplevel. + |> Debug> + + (setq a 'fred) + => FRED + (if (numberp a) (1+ a) (error "~S is not a number." A)) + |> Error: FRED is not a number. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Return to Lisp Toplevel. + |> Debug> |>>:Continue 1<<| + |> Return to Lisp Toplevel. + + (define-condition not-a-number (error) + ((argument :reader not-a-number-argument :initarg :argument)) + (:report (lambda (condition stream) + (format stream "~S is not a number." + (not-a-number-argument condition))))) + => NOT-A-NUMBER + + (if (numberp a) (1+ a) (error 'not-a-number :argument a)) + |> Error: FRED is not a number. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Return to Lisp Toplevel. + |> Debug> |>>:Continue 1<<| + |> Return to Lisp Toplevel. + +Side Effects:: +.............. + +Handlers for the specified condition, if any, are invoked and might have +side effects. Program execution might stop, and the debugger might be +entered. + +Affected By:: +............. + +Existing handler bindings. + + *break-on-signals* + + Signals an error of type type-error if datum and arguments are not +designators for a condition. + +See Also:: +.......... + +*note cerror:: , *note signal:: , *note format:: , *note ignore-errors:: +, *break-on-signals*, *note handler-bind:: , *note Condition System +Concepts:: + +Notes:: +....... + +Some implementations may provide debugger commands for interactively +returning from individual stack frames. However, it should be possible +for the programmer to feel confident about writing code like: + + (defun wargames:no-win-scenario () + (if (error "pushing the button would be stupid.")) + (push-the-button)) + + In this scenario, there should be no chance that error will return +and the button will get pushed. + + While the meaning of this program is clear and it might be proven +'safe' by a formal theorem prover, such a proof is no guarantee that the +program is safe to execute. Compilers have been known to have bugs, +computers to have signal glitches, and human beings to manually +intervene in ways that are not always possible to predict. Those kinds +of errors, while beyond the scope of the condition system to formally +model, are not beyond the scope of things that should seriously be +considered when writing code that could have the kinds of sweeping +effects hinted at by this example. + + +File: gcl.info, Node: cerror, Next: check-type, Prev: error, Up: Conditions Dictionary + +9.2.12 cerror [Function] +------------------------ + +'cerror' continue-format-control datum &rest arguments => nil + +Arguments and Values:: +...................... + +Continue-format-control--a format control. + + [Reviewer Note by Barmar: What is continue-format-control used for??] + + datum, arguments--designators for a condition of default type +simple-error. + +Description:: +............. + +cerror effectively invokes error on the condition named by datum. As +with any function that implicitly calls error, if the condition is not +handled, (invoke-debugger condition) is executed. While signaling is +going on, and while in the debugger if it is reached, it is possible to +continue code execution (i.e., to return from cerror) using the continue +restart. + + If datum is a condition, arguments can be supplied, but are used only +in conjunction with the continue-format-control. + +Examples:: +.......... + + (defun real-sqrt (n) + (when (minusp n) + (setq n (- n)) + (cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n)) + (sqrt n)) + + (real-sqrt 4) + => 2.0 + + (real-sqrt -9) + |> Correctable error in REAL-SQRT: Tried to take sqrt(-9). + |> Restart options: + |> 1: Return sqrt(9) instead. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + => 3.0 + + (define-condition not-a-number (error) + ((argument :reader not-a-number-argument :initarg :argument)) + (:report (lambda (condition stream) + (format stream "~S is not a number." + (not-a-number-argument condition))))) + + (defun assure-number (n) + (loop (when (numberp n) (return n)) + (cerror "Enter a number." + 'not-a-number :argument n) + (format t "~&Type a number: ") + (setq n (read)) + (fresh-line))) + + (assure-number 'a) + |> Correctable error in ASSURE-NUMBER: A is not a number. + |> Restart options: + |> 1: Enter a number. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + |> Type a number: |>>1/2<<| + => 1/2 + + (defun assure-large-number (n) + (loop (when (and (numberp n) (> n 73)) (return n)) + (cerror "Enter a number~:[~; a bit larger than ~D~]." + "~*~A is not a large number." + (numberp n) n) + (format t "~&Type a large number: ") + (setq n (read)) + (fresh-line))) + + (assure-large-number 10000) + => 10000 + + (assure-large-number 'a) + |> Correctable error in ASSURE-LARGE-NUMBER: A is not a large number. + |> Restart options: + |> 1: Enter a number. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + |> Type a large number: |>>88<<| + => 88 + + (assure-large-number 37) + |> Correctable error in ASSURE-LARGE-NUMBER: 37 is not a large number. + |> Restart options: + |> 1: Enter a number a bit larger than 37. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + |> Type a large number: |>>259<<| + => 259 + + (define-condition not-a-large-number (error) + ((argument :reader not-a-large-number-argument :initarg :argument)) + (:report (lambda (condition stream) + (format stream "~S is not a large number." + (not-a-large-number-argument condition))))) + + (defun assure-large-number (n) + (loop (when (and (numberp n) (> n 73)) (return n)) + (cerror "Enter a number~3*~:[~; a bit larger than ~*~D~]." + 'not-a-large-number + :argument n + :ignore (numberp n) + :ignore n + :allow-other-keys t) + (format t "~&Type a large number: ") + (setq n (read)) + (fresh-line))) + + (assure-large-number 'a) + |> Correctable error in ASSURE-LARGE-NUMBER: A is not a large number. + |> Restart options: + |> 1: Enter a number. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + |> Type a large number: |>>88<<| + => 88 + + (assure-large-number 37) + |> Correctable error in ASSURE-LARGE-NUMBER: A is not a large number. + |> Restart options: + |> 1: Enter a number a bit larger than 37. + |> 2: Top level. + |> Debug> |>>:continue 1<<| + |> Type a large number: |>>259<<| + => 259 + +Affected By:: +............. + +*break-on-signals*. + + Existing handler bindings. + +See Also:: +.......... + +*note error:: , *note format:: , *note handler-bind:: , +*break-on-signals*, simple-type-error + +Notes:: +....... + +If datum is a condition type rather than a string, the format directive +~* may be especially useful in the continue-format-control in order to +ignore the keywords in the initialization argument list. For example: + + (cerror "enter a new value to replace ~*~s" + 'not-a-number + :argument a) + + +File: gcl.info, Node: check-type, Next: simple-error, Prev: cerror, Up: Conditions Dictionary + +9.2.13 check-type [Macro] +------------------------- + +'check-type' place typespec [string] => nil + +Arguments and Values:: +...................... + +place--a place. + + typespec--a type specifier. + + string--a string; evaluated. + +Description:: +............. + +check-type signals a correctable error of type type-error if the +contents of place are not of the type typespec. + + check-type can return only if the store-value restart is invoked, +either explicitly from a handler or implicitly as one of the options +offered by the debugger. If the store-value restart is invoked, +check-type stores the new value that is the argument to the restart +invocation (or that is prompted for interactively by the debugger) in +place and starts over, checking the type of the new value and signaling +another error if it is still not of the desired type. + + The first time place is evaluated, it is evaluated by normal +evaluation rules. It is later evaluated as a place if the type check +fails and the store-value restart is used; see *note Evaluation of +Subforms to Places::. + + string should be an English description of the type, starting with an +indefinite article ("a" or "an"). If string is not supplied, it is +computed automatically from typespec. The automatically generated +message mentions place, its contents, and the desired type. An +implementation may choose to generate a somewhat differently worded +error message if it recognizes that place is of a particular form, such +as one of the arguments to the function that called check-type. string +is allowed because some applications of check-type may require a more +specific description of what is wanted than can be generated +automatically from typespec. + +Examples:: +.......... + + (setq aardvarks '(sam harry fred)) + => (SAM HARRY FRED) + (check-type aardvarks (array * (3))) + |> Error: The value of AARDVARKS, (SAM HARRY FRED), + |> is not a 3-long array. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a value to use instead. + |> 2: Return to Lisp Toplevel. + |> Debug> |>>:CONTINUE 1<<| + |> Use Value: |>>#(SAM FRED HARRY)<<| + => NIL + aardvarks + => # + (map 'list #'identity aardvarks) + => (SAM FRED HARRY) + (setq aardvark-count 'foo) + => FOO + (check-type aardvark-count (integer 0 *) "A positive integer") + |> Error: The value of AARDVARK-COUNT, FOO, is not a positive integer. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a value to use instead. + |> 2: Top level. + |> Debug> |>>:CONTINUE 2<<| + + (defmacro define-adder (name amount) + (check-type name (and symbol (not null)) "a name for an adder function") + (check-type amount integer) + `(defun ,name (x) (+ x ,amount))) + + (macroexpand '(define-adder add3 3)) + => (defun add3 (x) (+ x 3)) + + (macroexpand '(define-adder 7 7)) + |> Error: The value of NAME, 7, is not a name for an adder function. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a value to use instead. + |> 2: Top level. + |> Debug> |>>:Continue 1<<| + |> Specify a value to use instead. + |> Type a form to be evaluated and used instead: |>>'ADD7<<| + => (defun add7 (x) (+ x 7)) + + (macroexpand '(define-adder add5 something)) + |> Error: The value of AMOUNT, SOMETHING, is not an integer. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a value to use instead. + |> 2: Top level. + |> Debug> |>>:Continue 1<<| + |> Type a form to be evaluated and used instead: |>>5<<| + => (defun add5 (x) (+ x 5)) + + + Control is transferred to a handler. + +Side Effects:: +.............. + +The debugger might be entered. + +Affected By:: +............. + +*break-on-signals* + + The implementation. + +See Also:: +.......... + +*note Condition System Concepts:: + +Notes:: +....... + + (check-type place typespec) + == (assert (typep place 'typespec) (place) + 'type-error :datum place :expected-type 'typespec) + + +File: gcl.info, Node: simple-error, Next: invalid-method-error, Prev: check-type, Up: Conditions Dictionary + +9.2.14 simple-error [Condition Type] +------------------------------------ + +Class Precedence List:: +....................... + +simple-error, simple-condition, error, serious-condition, condition, t + +Description:: +............. + +The type simple-error consists of conditions that are signaled by error +or cerror when a + + format control + + is supplied as the function's first argument. + + +File: gcl.info, Node: invalid-method-error, Next: method-combination-error, Prev: simple-error, Up: Conditions Dictionary + +9.2.15 invalid-method-error [Function] +-------------------------------------- + +'invalid-method-error' method format-control &rest args => +implementation-dependent + +Arguments and Values:: +...................... + +method--a method. + + format-control--a format control. + + args--format arguments for the format-control. + +Description:: +............. + +The function invalid-method-error is used to signal an error of type +error when there is an applicable method whose qualifiers are not valid +for the method combination type. The error message is constructed by +using the format-control suitable for format and any args to it. +Because an implementation may need to add additional contextual +information to the error message, invalid-method-error should be called +only within the dynamic extent of a method combination function. + + The function invalid-method-error is called automatically when a +method fails to satisfy every qualifier pattern and predicate in a +define-method-combination form. A method combination function that +imposes additional restrictions should call invalid-method-error +explicitly if it encounters a method it cannot accept. + + Whether invalid-method-error returns to its caller or exits via throw +is implementation-dependent. + +Side Effects:: +.............. + +The debugger might be entered. + +Affected By:: +............. + +*break-on-signals* + +See Also:: +.......... + +*note define-method-combination:: + + +File: gcl.info, Node: method-combination-error, Next: signal, Prev: invalid-method-error, Up: Conditions Dictionary + +9.2.16 method-combination-error [Function] +------------------------------------------ + +'method-combination-error' format-control &rest args => +implementation-dependent + +Arguments and Values:: +...................... + +format-control--a format control. + + args--format arguments for format-control. + +Description:: +............. + +The function method-combination-error is used to signal an error in +method combination. + + The error message is constructed by using a format-control suitable +for format and any args to it. Because an implementation may need to +add additional contextual information to the error message, +method-combination-error should be called only within the dynamic extent +of a method combination function. + + Whether method-combination-error returns to its caller or exits via +throw is implementation-dependent. + +Side Effects:: +.............. + +The debugger might be entered. + +Affected By:: +............. + +*break-on-signals* + +See Also:: +.......... + +*note define-method-combination:: + + +File: gcl.info, Node: signal, Next: simple-condition, Prev: method-combination-error, Up: Conditions Dictionary + +9.2.17 signal [Function] +------------------------ + +'signal' datum &rest arguments => nil + +Arguments and Values:: +...................... + +datum, arguments--designators for a condition of default type +simple-condition. + +Description:: +............. + +Signals the condition denoted by the given datum and arguments. If the +condition is not handled, signal returns nil. + +Examples:: +.......... + + (defun handle-division-conditions (condition) + (format t "Considering condition for division condition handling~ + (when (and (typep condition 'arithmetic-error) + (eq '/ (arithmetic-error-operation condition))) + (invoke-debugger condition))) + HANDLE-DIVISION-CONDITIONS + (defun handle-other-arithmetic-errors (condition) + (format t "Considering condition for arithmetic condition handling~ + (when (typep condition 'arithmetic-error) + (abort))) + HANDLE-OTHER-ARITHMETIC-ERRORS + (define-condition a-condition-with-no-handler (condition) ()) + A-CONDITION-WITH-NO-HANDLER + (signal 'a-condition-with-no-handler) + NIL + (handler-bind ((condition #'handle-division-conditions) + (condition #'handle-other-arithmetic-errors)) + (signal 'a-condition-with-no-handler)) + Considering condition for division condition handling + Considering condition for arithmetic condition handling + NIL + (handler-bind ((arithmetic-error #'handle-division-conditions) + (arithmetic-error #'handle-other-arithmetic-errors)) + (signal 'arithmetic-error :operation '* :operands '(1.2 b))) + Considering condition for division condition handling + Considering condition for arithmetic condition handling + Back to Lisp Toplevel + +Side Effects:: +.............. + +The debugger might be entered due to *break-on-signals*. + + Handlers for the condition being signaled might transfer control. + +Affected By:: +............. + +Existing handler bindings. + + *break-on-signals* + +See Also:: +.......... + +*break-on-signals*, *note error:: , simple-condition, *note Signaling +and Handling Conditions:: + +Notes:: +....... + +If (typep datum *break-on-signals*) yields true, the debugger is entered +prior to beginning the signaling process. The continue restart can be +used to continue with the signaling process. This is also true for all +other functions and macros that should, might, or must signal +conditions. + + +File: gcl.info, Node: simple-condition, Next: simple-condition-format-control, Prev: signal, Up: Conditions Dictionary + +9.2.18 simple-condition [Condition Type] +---------------------------------------- + +Class Precedence List:: +....................... + +simple-condition, condition, t + +Description:: +............. + +The type simple-condition represents conditions that are signaled by +signal whenever a format-control is supplied as the function's first +argument. + + The format control and format arguments are initialized with the +initialization arguments named :format-control + + and :format-arguments to make-condition, and are accessed by the +functions + + simple-condition-format-control + + and simple-condition-format-arguments. If format arguments are not +supplied to make-condition, nil is used as a default. + +See Also:: +.......... + +*note simple-condition-format-control:: , + + simple-condition-format-arguments + + +File: gcl.info, Node: simple-condition-format-control, Next: warn, Prev: simple-condition, Up: Conditions Dictionary + +9.2.19 simple-condition-format-control, simple-condition-format-arguments +------------------------------------------------------------------------- + + [Function] + + 'simple-condition-format-control' condition => format-control + + 'simple-condition-format-arguments' condition => format-arguments + +Arguments and Values:: +...................... + +condition--a condition of type simple-condition. + + format-control--a format control. + + format-arguments--a list. + +Description:: +............. + +simple-condition-format-control returns the format control needed to +process the condition's format arguments. + + simple-condition-format-arguments returns a list of format arguments +needed to process the condition's format control. + +Examples:: +.......... + + (setq foo (make-condition 'simple-condition + :format-control "Hi ~S" + :format-arguments '(ho))) + => # + (apply #'format nil (simple-condition-format-control foo) + (simple-condition-format-arguments foo)) + => "Hi HO" + +See Also:: +.......... + +*note simple-condition:: , *note Condition System Concepts:: + + +File: gcl.info, Node: warn, Next: simple-warning, Prev: simple-condition-format-control, Up: Conditions Dictionary + +9.2.20 warn [Function] +---------------------- + +'warn' datum &rest arguments => nil + +Arguments and Values:: +...................... + +datum, arguments--designators for a condition of default type +simple-warning. + +Description:: +............. + +Signals a condition of type warning. If the condition is not handled, +reports the condition to error output. + + The precise mechanism for warning is as follows: + +The warning condition is signaled + While the warning condition is being signaled, the muffle-warning + restart is established for use by a handler. If invoked, this + restart bypasses further action by warn, which in turn causes warn + to immediately return nil. + +If no handler for the warning condition is found + If no handlers for the warning condition are found, or if all such + handlers decline, then the condition is reported to error output by + warn in an implementation-dependent format. + +nil is returned + The value returned by warn if it returns is nil. + +Examples:: +.......... + + (defun foo (x) + (let ((result (* x 2))) + (if (not (typep result 'fixnum)) + (warn "You're using very big numbers.")) + result)) + => FOO + + (foo 3) + => 6 + + (foo most-positive-fixnum) + |> Warning: You're using very big numbers. + => 4294967294 + + (setq *break-on-signals* t) + => T + + (foo most-positive-fixnum) + |> Break: Caveat emptor. + |> To continue, type :CONTINUE followed by an option number. + |> 1: Return from Break. + |> 2: Abort to Lisp Toplevel. + |> Debug> :continue 1 + |> Warning: You're using very big numbers. + => 4294967294 + +Side Effects:: +.............. + +A warning is issued. The debugger might be entered. + +Affected By:: +............. + +Existing handler bindings. + + *break-on-signals*, *error-output*. + +Exceptional Situations:: +........................ + +If datum is a condition and if the condition is not of type warning, or +arguments is non-nil, an error of type type-error is signaled. + + If datum is a condition type, the result of (apply #'make-condition +datum arguments) must be of type warning or an error of type type-error +is signaled. + +See Also:: +.......... + +*break-on-signals*, *note muffle-warning:: , *note signal:: + + +File: gcl.info, Node: simple-warning, Next: invoke-debugger, Prev: warn, Up: Conditions Dictionary + +9.2.21 simple-warning [Condition Type] +-------------------------------------- + +Class Precedence List:: +....................... + +simple-warning, simple-condition, warning, condition, t + +Description:: +............. + +The type simple-warning represents conditions that are signaled by warn +whenever a + + format control + + is supplied as the function's first argument. + + +File: gcl.info, Node: invoke-debugger, Next: break, Prev: simple-warning, Up: Conditions Dictionary + +9.2.22 invoke-debugger [Function] +--------------------------------- + +'invoke-debugger' condition => # + +Arguments and Values:: +...................... + +condition--a condition object. + +Description:: +............. + +invoke-debugger attempts to enter the debugger with condition. + + If *debugger-hook* is not nil, it should be a function (or the name +of a function) to be called prior to entry to the standard debugger. +The function is called with *debugger-hook* bound to nil, and the +function must accept two arguments: the condition and the value of +*debugger-hook* prior to binding it to nil. If the function returns +normally, the standard debugger is entered. + + The standard debugger never directly returns. Return can occur only +by a non-local transfer of control, such as the use of a restart +function. + +Examples:: +.......... + + (ignore-errors ;Normally, this would suppress debugger entry + (handler-bind ((error #'invoke-debugger)) ;But this forces debugger entry + (error "Foo."))) + Debug: Foo. + To continue, type :CONTINUE followed by an option number: + 1: Return to Lisp Toplevel. + Debug> + +Side Effects:: +.............. + +*debugger-hook* is bound to nil, program execution is discontinued, and +the debugger is entered. + +Affected By:: +............. + +*debug-io* and *debugger-hook*. + +See Also:: +.......... + +*note error:: , *note break:: + + +File: gcl.info, Node: break, Next: *debugger-hook*, Prev: invoke-debugger, Up: Conditions Dictionary + +9.2.23 break [Function] +----------------------- + +'break' &optional format-control &rest format-arguments => nil + +Arguments and Values:: +...................... + +format-control--a format control. + + The default is implementation-dependent. + + format-arguments--format arguments for the format-control. + +Description:: +............. + +break formats format-control and format-arguments and then goes directly +into the debugger without allowing any possibility of interception by +programmed error-handling facilities. + + If the continue restart is used while in the debugger, break +immediately returns nil without taking any unusual recovery action. + + break binds *debugger-hook* to nil before attempting to enter the +debugger. + +Examples:: +.......... + + (break "You got here with arguments: ~:S." '(FOO 37 A)) + |> BREAK: You got here with these arguments: FOO, 37, A. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Return from BREAK. + |> 2: Top level. + |> Debug> :CONTINUE 1 + |> Return from BREAK. + => NIL + + +Side Effects:: +.............. + +The debugger is entered. + +Affected By:: +............. + +*debug-io*. + +See Also:: +.......... + +*note error:: , *note invoke-debugger:: . + +Notes:: +....... + +break is used as a way of inserting temporary debugging "breakpoints" in +a program, not as a way of signaling errors. For this reason, break +does not take the continue-format-control argument that cerror takes. +This and the lack of any possibility of interception by condition +handling are the only program-visible differences between break and +cerror. + + The user interface aspects of break and cerror are permitted to vary +more widely, in order to accomodate the interface needs of the +implementation. For example, it is permissible for a Lisp +read-eval-print loop to be entered by break rather than the conventional +debugger. + + break could be defined by: + + (defun break (&optional (format-control "Break") &rest format-arguments) + (with-simple-restart (continue "Return from BREAK.") + (let ((*debugger-hook* nil)) + (invoke-debugger + (make-condition 'simple-condition + :format-control format-control + :format-arguments format-arguments)))) + nil) + + +File: gcl.info, Node: *debugger-hook*, Next: *break-on-signals*, Prev: break, Up: Conditions Dictionary + +9.2.24 *debugger-hook* [Variable] +--------------------------------- + +Value Type:: +............ + +a designator for a function of two arguments (a condition and the value +of *debugger-hook* at the time the debugger was entered), or nil. + +Initial Value:: +............... + +nil. + +Description:: +............. + +When the value of *debugger-hook* is non-nil, it is called prior to +normal entry into the debugger, either due to a call to invoke-debugger +or due to automatic entry into the debugger from a call to error or +cerror with a condition that is not handled. The function may either +handle the condition (transfer control) or return normally (allowing the +standard debugger to run). To minimize recursive errors while +debugging, *debugger-hook* is bound to nil by invoke-debugger prior to +calling the function. + +Examples:: +.......... + + (defun one-of (choices &optional (prompt "Choice")) + (let ((n (length choices)) (i)) + (do ((c choices (cdr c)) (i 1 (+ i 1))) + ((null c)) + (format t "~&[~D] ~A~ + (do () ((typep i `(integer 1 ,n))) + (format t "~&~A: " prompt) + (setq i (read)) + (fresh-line)) + (nth (- i 1) choices))) + + (defun my-debugger (condition me-or-my-encapsulation) + (format t "~&Fooey: ~A" condition) + (let ((restart (one-of (compute-restarts)))) + (if (not restart) (error "My debugger got an error.")) + (let ((*debugger-hook* me-or-my-encapsulation)) + (invoke-restart-interactively restart)))) + + (let ((*debugger-hook* #'my-debugger)) + (+ 3 'a)) + |> Fooey: The argument to +, A, is not a number. + |> [1] Supply a replacement for A. + |> [2] Return to Cloe Toplevel. + |> Choice: 1 + |> Form to evaluate and use: (+ 5 'b) + |> Fooey: The argument to +, B, is not a number. + |> [1] Supply a replacement for B. + |> [2] Supply a replacement for A. + |> [3] Return to Cloe Toplevel. + |> Choice: 1 + |> Form to evaluate and use: 1 + => 9 + +Affected By:: +............. + +invoke-debugger + +Notes:: +....... + +When evaluating code typed in by the user interactively, it is sometimes +useful to have the hook function bind *debugger-hook* to the function +that was its second argument so that recursive errors can be handled +using the same interactive facility. + + +File: gcl.info, Node: *break-on-signals*, Next: handler-bind, Prev: *debugger-hook*, Up: Conditions Dictionary + +9.2.25 *break-on-signals* [Variable] +------------------------------------ + +Value Type:: +............ + +a type specifier. + +Initial Value:: +............... + +nil. + +Description:: +............. + +When (typep condition *break-on-signals*) returns true, calls to signal, +and to other operators such as error that implicitly call signal, enter +the debugger prior to signaling the condition. + + The continue restart can be used to continue with the normal +signaling process when a break occurs process due to *break-on-signals*. + +Examples:: +.......... + + *break-on-signals* => NIL + (ignore-errors (error 'simple-error :format-control "Fooey!")) + => NIL, # + + (let ((*break-on-signals* 'error)) + (ignore-errors (error 'simple-error :format-control "Fooey!"))) + |> Break: Fooey! + |> BREAK entered because of *BREAK-ON-SIGNALS*. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Continue to signal. + |> 2: Top level. + |> Debug> |>>:CONTINUE 1<<| + |> Continue to signal. + => NIL, # + + (let ((*break-on-signals* 'error)) + (error 'simple-error :format-control "Fooey!")) + |> Break: Fooey! + |> BREAK entered because of *BREAK-ON-SIGNALS*. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Continue to signal. + |> 2: Top level. + |> Debug> |>>:CONTINUE 1<<| + |> Continue to signal. + |> Error: Fooey! + |> To continue, type :CONTINUE followed by an option number: + |> 1: Top level. + |> Debug> |>>:CONTINUE 1<<| + |> Top level. + +See Also:: +.......... + +*note break:: , *note signal:: , *note warn:: , *note error:: , *note +typep:: , *note Condition System Concepts:: + +Notes:: +....... + +*break-on-signals* is intended primarily for use in debugging code that +does signaling. When setting *break-on-signals*, the user is encouraged +to choose the most restrictive specification that suffices. Setting +*break-on-signals* effectively violates the modular handling of +condition signaling. In practice, the complete effect of setting +*break-on-signals* might be unpredictable in some cases since the user +might not be aware of the variety or number of calls to signal that are +used in code called only incidentally. + + *break-on-signals* enables an early entry to the debugger but such an +entry does not preclude an additional entry to the debugger in the case +of operations such as error and cerror. + + +File: gcl.info, Node: handler-bind, Next: handler-case, Prev: *break-on-signals*, Up: Conditions Dictionary + +9.2.26 handler-bind [Macro] +--------------------------- + +'handler-bind' ({!binding}*) {form}* => {result}* + + binding ::=(type handler) + +Arguments and Values:: +...................... + +type--a type specifier. + + handler--a form; evaluated to produce a handler-function. + + handler-function--a designator for a function of one argument. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +Executes forms in a dynamic environment where the indicated handler +bindings are in effect. + + Each handler should evaluate to a handler-function, which is used to +handle conditions of the given type during execution of the forms. This +function should take a single argument, the condition being signaled. + + If more than one handler binding is supplied, the handler bindings +are searched sequentially from top to bottom in search of a match (by +visual analogy with typecase). If an appropriate type is found, the +associated handler is run in a dynamic environment where none of these +handler bindings are visible (to avoid recursive errors). If the +handler declines, the search continues for another handler. + + If no appropriate handler is found, other handlers are sought from +dynamically enclosing contours. If no handler is found outside, then +signal returns or error enters the debugger. + +Examples:: +.......... + +In the following code, if an unbound variable error is signaled in the +body (and not handled by an intervening handler), the first function is +called. + + (handler-bind ((unbound-variable #'(lambda ...)) + (error #'(lambda ...))) + ...) + + If any other kind of error is signaled, the second function is +called. In either case, neither handler is active while executing the +code in the associated function. + + (defun trap-error-handler (condition) + (format *error-output* "~&~A~&" condition) + (throw 'trap-errors nil)) + + (defmacro trap-errors (&rest forms) + `(catch 'trap-errors + (handler-bind ((error #'trap-error-handler)) + ,@forms))) + + (list (trap-errors (signal "Foo.") 1) + (trap-errors (error "Bar.") 2) + (+ 1 2)) + |> Bar. + => (1 NIL 3) + + Note that "Foo." is not printed because the condition made by signal +is a simple condition, which is not of type error, so it doesn't trigger +the handler for error set up by trap-errors. + +See Also:: +.......... + +*note handler-case:: + + +File: gcl.info, Node: handler-case, Next: ignore-errors, Prev: handler-bind, Up: Conditions Dictionary + +9.2.27 handler-case [Macro] +--------------------------- + +'handler-case' expression [[{!error-clause}* | !no-error-clause]] => +{result}* + + clause ::=!error-clause | !no-error-clause + + error-clause ::=(typespec ([var]) {declaration}* {form}*) + + no-error-clause ::=(:no-error lambda-list {declaration}* {form}*) + +Arguments and Values:: +...................... + +expression--a form. + + typespec--a type specifier. + + var--a variable name. + + lambda-list--an ordinary lambda list. + + declaration--a declare expression; not evaluated. + + form--a form. + + results--In the normal situation, the values returned are those that +result from the evaluation of expression; in the exceptional situation +when control is transferred to a clause, the value of the last form in +that clause is returned. + +Description:: +............. + +handler-case executes expression in a dynamic environment where various +handlers are active. Each error-clause specifies how to handle a +condition matching the indicated typespec. A no-error-clause allows the +specification of a particular action if control returns normally. + + If a condition is signaled for which there is an appropriate +error-clause during the execution of expression (i.e., one for which +(typep condition 'typespec) returns true) and if there is no intervening +handler for a condition of that type, then control is transferred to the +body of the relevant error-clause. In this case, the dynamic state is +unwound appropriately (so that the handlers established around the +expression are no longer active), and var is bound to the condition that +had been signaled. If more than one case is provided, those cases are +made accessible in parallel. That is, in + + (handler-case form + (typespec1 (var1) form1) + (typespec2 (var2) form2)) + + if the first clause (containing form1) has been selected, the handler +for the second is no longer visible (or vice versa). + + The clauses are searched sequentially from top to bottom. If there +is type overlap between typespecs, the earlier of the clauses is +selected. + + If var is not needed, it can be omitted. That is, a clause such as: + + (typespec (var) (declare (ignore var)) form) + + can be written (typespec () form). + + If there are no forms in a selected clause, the case, and therefore +handler-case, returns nil. If execution of expression returns normally +and no no-error-clause exists, the values returned by expression are +returned by handler-case. If execution of expression returns normally +and a no-error-clause does exist, the values returned are used as +arguments to the function described by constructing (lambda lambda-list +{form}*) from the no-error-clause, and the values of that function call +are returned by handler-case. The handlers which were established +around the expression are no longer active at the time of this call. + +Examples:: +.......... + + (defun assess-condition (condition) + (handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (serious-condition (condition) + (format nil "~S looks serious." condition)) + (condition () "Hardly worth mentioning."))) + => ASSESS-CONDITION + (assess-condition (make-condition 'stream-error :stream *terminal-io*)) + => "# looks especially bad." + (define-condition random-condition (condition) () + (:report (lambda (condition stream) + (declare (ignore condition)) + (princ "Yow" stream)))) + => RANDOM-CONDITION + (assess-condition (make-condition 'random-condition)) + => "Hardly worth mentioning." + +See Also:: +.......... + +*note handler-bind:: , *note ignore-errors:: , *note Condition System +Concepts:: + +Notes:: +....... + + (handler-case form + (type1 (var1) . body1) + (type2 (var2) . body2) ...) + + is approximately equivalent to: + + (block #1=#:g0001 + (let ((#2=#:g0002 nil)) + (tagbody + (handler-bind ((type1 #'(lambda (temp) + (setq #1# temp) + (go #3=#:g0003))) + (type2 #'(lambda (temp) + (setq #2# temp) + (go #4=#:g0004))) ...) + (return-from #1# form)) + #3# (return-from #1# (let ((var1 #2#)) . body1)) + #4# (return-from #1# (let ((var2 #2#)) . body2)) ...))) + + (handler-case form + (type1 (var1) . body1) + ... + (:no-error (varN-1 varN-2 ...) . bodyN)) + + is approximately equivalent to: + + + (block #1=#:error-return + (multiple-value-call #'(lambda (varN-1 varN-2 ...) . bodyN) + (block #2=#:normal-return + (return-from #1# + (handler-case (return-from #2# form) + (type1 (var1) . body1) ...))))) + diff --git a/info/gcl.info-5 b/info/gcl.info-5 new file mode 100644 index 0000000..8031a76 --- /dev/null +++ b/info/gcl.info-5 @@ -0,0 +1,9892 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: ignore-errors, Next: define-condition, Prev: handler-case, Up: Conditions Dictionary + +9.2.28 ignore-errors [Macro] +---------------------------- + +'ignore-errors' {form}* => {result}* + +Arguments and Values:: +...................... + +forms--an implicit progn. + + results--In the normal situation, the values of the forms are +returned; in the exceptional situation, two values are returned: nil and +the condition. + +Description:: +............. + +ignore-errors is used to prevent conditions of type error from causing +entry into the debugger. + + Specifically, ignore-errors executes forms in a dynamic environment +where a handler for conditions of type error has been established; if +invoked, it handles such conditions by returning two values, nil and the +condition that was signaled, from the ignore-errors form. + + If a normal return from the forms occurs, any values returned are +returned by ignore-errors. + +Examples:: +.......... + + (defun load-init-file (program) + (let ((win nil)) + (ignore-errors ;if this fails, don't enter debugger + (load (merge-pathnames (make-pathname :name program :type :lisp) + (user-homedir-pathname))) + (setq win t)) + (unless win (format t "~&Init file failed to load.~ + win)) + + (load-init-file "no-such-program") + |> Init file failed to load. + NIL + +See Also:: +.......... + +*note handler-case:: , *note Condition System Concepts:: + +Notes:: +....... + + (ignore-errors . forms) + + is equivalent to: + + (handler-case (progn . forms) + (error (condition) (values nil condition))) + + Because the second return value is a condition in the exceptional +case, it is common (but not required) to arrange for the second return +value in the normal case to be missing or nil so that the two situations +can be distinguished. + + +File: gcl.info, Node: define-condition, Next: make-condition, Prev: ignore-errors, Up: Conditions Dictionary + +9.2.29 define-condition [Macro] +------------------------------- + +[Editorial Note by KMP: This syntax stuff is still very confused and +needs lots of work.] + + 'define-condition' name ({parent-type}*) ({!slot-spec}*) {option}* +=> name + + slot-spec ::=slot-name | (slot-name !slot-option) + + slot-option ::=[[ {:reader symbol}* | + {:writer !function-name}* | + {:accessor symbol}* | + {:allocation !allocation-type} | + {:initarg symbol}* | + {:initform form} | + {:type type-specifier} ]] + + option ::=[[ (:default-initargs . initarg-list) | + (:documentation string) | + (:report report-name) ]] + + function-name ::={symbol | (setf symbol)} + + allocation-type ::=:instance | :class + + report-name ::=string | symbol | lambda expression + +Arguments and Values:: +...................... + +name--a symbol. + + parent-type--a symbol naming a condition type. If no parent-types +are supplied, the parent-types default to (condition). + + default-initargs--a list of keyword/value pairs. + + [Editorial Note by KMP: This is all mixed up as to which is a slot +option and which is a main option. I'll sort that out. Also, some of +this is implied by the bnf and needn't be stated explicitly.] + + Slot-spec - the name of a slot or a list consisting of the slot-name +followed by zero or more slot-options. + + Slot-name - a slot name (a symbol), the list of a slot name, or the +list of slot name/slot form pairs. + + Option - Any of the following: + +:reader + :reader can be supplied more than once for a given slot and cannot + be nil. + +:writer + :writer can be supplied more than once for a given slot and must + name a generic function. + +:accessor + :accessor can be supplied more than once for a given slot and + cannot be nil. + +:allocation + :allocation can be supplied once at most for a given slot. The + default if :allocation is not supplied is :instance. + +:initarg + :initarg can be supplied more than once for a given slot. + +:initform + :initform can be supplied once at most for a given slot. + +:type + :type can be supplied once at most for a given slot. + +:documentation + :documentation can be supplied once at most for a given slot. + +:report + :report can be supplied once at most. + +Description:: +............. + +define-condition defines a new condition type called name, which is a +subtype of + + the type or types named by parent-type. Each parent-type argument +specifies a direct supertype of the new condition. The new condition +inherits slots and methods from each of its direct supertypes, and so +on. + + If a slot name/slot form pair is supplied, the slot form is a form +that can be evaluated by make-condition to produce a default value when +an explicit value is not provided. If no slot form is supplied, the +contents of the slot is initialized in an implementation-dependent way. + + If the type being defined and some other type from which it inherits +have a slot by the same name, only one slot is allocated in the +condition, but the supplied slot form overrides any slot form that might +otherwise have been inherited from a parent-type. If no slot form is +supplied, the inherited slot form (if any) is still visible. + + Accessors are created according to the same rules as used by +defclass. + + A description of slot-options follows: + +:reader + The :reader slot option specifies that an unqualified method is to + be defined on the generic function named by the argument to :reader + to read the value of the given slot. + +* + The :initform slot option is used to provide a default initial + value form to be used in the initialization of the slot. This form + is evaluated every time it is used to initialize the slot. The + lexical environment in which this form is evaluated is the lexical + environment in which the define-condition form was evaluated. Note + that the lexical environment refers both to variables and to + functions. For local slots, the dynamic environment is the dynamic + environment in which make-condition was called; for shared slots, + the dynamic environment is the dynamic environment in which the + define-condition form was evaluated. + + [Reviewer Note by Barmar: Issue CLOS-CONDITIONS doesn't say this.] + No implementation is permitted to extend the syntax of + define-condition to allow (slot-name form) as an abbreviation for + (slot-name :initform form). + +:initarg + The :initarg slot option declares an initialization argument named + by its symbol argument and specifies that this initialization + argument initializes the given slot. If the initialization + argument has a value in the call to initialize-instance, the value + is stored into the given slot, and the slot's :initform slot + option, if any, is not evaluated. If none of the initialization + arguments specified for a given slot has a value, the slot is + initialized according to the :initform slot option, if specified. + +:type + The :type slot option specifies that the contents of the slot is + always of the specified type. It effectively declares the result + type of the reader generic function when applied to an object of + this condition type. The consequences of attempting to store in a + slot a value that does not satisfy the type of the slot is + undefined. + +:default-initargs + + [Editorial Note by KMP: This is an option, not a slot option.] + + This option is treated the same as it would be defclass. + +:documentation + + [Editorial Note by KMP: This is both an option and a slot option.] + + The :documentation slot option provides a documentation string for + the slot. + +:report + + [Editorial Note by KMP: This is an option, not a slot option.] + + Condition reporting is mediated through the print-object method for + the condition type in question, with *print-escape* always being + nil. Specifying (:report report-name) in the definition of a + condition type C is equivalent to: + + (defmethod print-object ((x c) stream) + (if *print-escape* (call-next-method) (report-name x stream))) + + If the value supplied by the argument to :report (report-name) is a + symbol or a lambda expression, it must be acceptable to function. + (function report-name) is evaluated in the current lexical + environment. It should return a function of two arguments, a + condition and a stream, that prints on the stream a description of + the condition. This function is called whenever the condition is + printed while *print-escape* is nil. + + If report-name is a string, it is a shorthand for + + (lambda (condition stream) + (declare (ignore condition)) + (write-string report-name stream)) + + This option is processed after the new condition type has been + defined, so use of the slot accessors within the :report function + is permitted. If this option is not supplied, information about + how to report this type of condition is inherited from the + parent-type. + + The consequences are unspecifed if an attempt is made to read a slot +that has not been explicitly initialized and that has not been given a +default value. + + The consequences are unspecified if an attempt is made to assign the +slots by using setf. + + If a define-condition form appears as a top level form, the compiler +must make name recognizable as a valid type name, and it must be +possible to reference the condition type as the parent-type of another +condition type in a subsequent define-condition form in the file being +compiled. + +Examples:: +.......... + +The following form defines a condition of type peg/hole-mismatch which +inherits from a condition type called blocks-world-error: + + (define-condition peg/hole-mismatch + (blocks-world-error) + ((peg-shape :initarg :peg-shape + :reader peg/hole-mismatch-peg-shape) + (hole-shape :initarg :hole-shape + :reader peg/hole-mismatch-hole-shape)) + (:report (lambda (condition stream) + (format stream "A ~A peg cannot go in a ~A hole." + (peg/hole-mismatch-peg-shape condition) + (peg/hole-mismatch-hole-shape condition))))) + + The new type has slots peg-shape and hole-shape, so make-condition +accepts :peg-shape and :hole-shape keywords. The readers +peg/hole-mismatch-peg-shape and peg/hole-mismatch-hole-shape apply to +objects of this type, as illustrated in the :report information. + + The following form defines a condition type named machine-error which +inherits from error: + + (define-condition machine-error + (error) + ((machine-name :initarg :machine-name + :reader machine-error-machine-name)) + (:report (lambda (condition stream) + (format stream "There is a problem with ~A." + (machine-error-machine-name condition))))) + + Building on this definition, a new error condition can be defined +which is a subtype of machine-error for use when machines are not +available: + + (define-condition machine-not-available-error (machine-error) () + (:report (lambda (condition stream) + (format stream "The machine ~A is not available." + (machine-error-machine-name condition))))) + + This defines a still more specific condition, built upon +machine-not-available-error, which provides a slot initialization form +for machine-name but which does not provide any new slots or report +information. It just gives the machine-name slot a default +initialization: + + (define-condition my-favorite-machine-not-available-error + (machine-not-available-error) + ((machine-name :initform "mc.lcs.mit.edu"))) + + Note that since no :report clause was given, the information +inherited from machine-not-available-error is used to report this type +of condition. + + (define-condition ate-too-much (error) + ((person :initarg :person :reader ate-too-much-person) + (weight :initarg :weight :reader ate-too-much-weight) + (kind-of-food :initarg :kind-of-food + :reader :ate-too-much-kind-of-food))) + => ATE-TOO-MUCH + (define-condition ate-too-much-ice-cream (ate-too-much) + ((kind-of-food :initform 'ice-cream) + (flavor :initarg :flavor + :reader ate-too-much-ice-cream-flavor + :initform 'vanilla )) + (:report (lambda (condition stream) + (format stream "~A ate too much ~A ice-cream" + (ate-too-much-person condition) + (ate-too-much-ice-cream-flavor condition))))) + => ATE-TOO-MUCH-ICE-CREAM + (make-condition 'ate-too-much-ice-cream + :person 'fred + :weight 300 + :flavor 'chocolate) + => # + (format t "~A" *) + |> FRED ate too much CHOCOLATE ice-cream + => NIL + +See Also:: +.......... + +*note make-condition:: , *note defclass:: , *note Condition System +Concepts:: + + +File: gcl.info, Node: make-condition, Next: restart, Prev: define-condition, Up: Conditions Dictionary + +9.2.30 make-condition [Function] +-------------------------------- + +'make-condition' type &rest slot-initializations => condition + +Arguments and Values:: +...................... + +type--a type specifier (for a subtype of condition). + + slot-initializations--an initialization argument list. + + condition--a condition. + +Description:: +............. + +Constructs and returns a condition of type type using +slot-initializations for the initial values of the slots. The newly +created condition is returned. + +Examples:: +.......... + + (defvar *oops-count* 0) + + (setq a (make-condition 'simple-error + :format-control "This is your ~:R error." + :format-arguments (list (incf *oops-count*)))) + => # + + (format t "~&~A~ + |> This is your first error. + => NIL + + (error a) + |> Error: This is your first error. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Return to Lisp Toplevel. + |> Debug> + +Affected By:: +............. + +The set of defined condition types. + +See Also:: +.......... + +*note define-condition:: , *note Condition System Concepts:: + + +File: gcl.info, Node: restart, Next: compute-restarts, Prev: make-condition, Up: Conditions Dictionary + +9.2.31 restart [System Class] +----------------------------- + +Class Precedence List:: +....................... + +restart, t + +Description:: +............. + +An object of type restart represents a function that can be called to +perform some form of recovery action, usually a transfer of control to +an outer point in the running program. + + An implementation is free to implement a restart in whatever manner +is most convenient; a restart has only dynamic extent relative to the +scope of the binding form which establishes it. + + +File: gcl.info, Node: compute-restarts, Next: find-restart, Prev: restart, Up: Conditions Dictionary + +9.2.32 compute-restarts [Function] +---------------------------------- + +'compute-restarts' &optional condition => restarts + +Arguments and Values:: +...................... + +condition--a condition object, or nil. + + restarts--a list of restarts. + +Description:: +............. + +compute-restarts uses the dynamic state of the program to compute a list +of the restarts which are currently active. + + The resulting list is ordered so that the innermost (more-recently +established) restarts are nearer the head of the list. + + When condition is non-nil, only those restarts are considered that +are either explicitly associated with that condition, or not associated +with any condition; that is, the excluded restarts are those that are +associated with a non-empty set of conditions of which the given +condition is not an element. If condition is nil, all restarts are +considered. + + compute-restarts returns all applicable restarts, including anonymous +ones, even if some of them have the same name as others and would +therefore not be found by find-restart when given a symbol argument. + + Implementations are permitted, but not required, to return distinct +lists from repeated calls to compute-restarts while in the same dynamic +environment. The consequences are undefined if the list returned by +compute-restarts is every modified. + +Examples:: +.......... + + ;; One possible way in which an interactive debugger might present + ;; restarts to the user. + (defun invoke-a-restart () + (let ((restarts (compute-restarts))) + (do ((i 0 (+ i 1)) (r restarts (cdr r))) ((null r)) + (format t "~&~D: ~A~ + (let ((n nil) (k (length restarts))) + (loop (when (and (typep n 'integer) (>= n 0) (< n k)) + (return t)) + (format t "~&Option: ") + (setq n (read)) + (fresh-line)) + (invoke-restart-interactively (nth n restarts))))) + + (restart-case (invoke-a-restart) + (one () 1) + (two () 2) + (nil () :report "Who knows?" 'anonymous) + (one () 'I) + (two () 'II)) + |> 0: ONE + |> 1: TWO + |> 2: Who knows? + |> 3: ONE + |> 4: TWO + |> 5: Return to Lisp Toplevel. + |> Option: |>>4<<| + => II + + ;; Note that in addition to user-defined restart points, COMPUTE-RESTARTS + ;; also returns information about any system-supplied restarts, such as + ;; the "Return to Lisp Toplevel" restart offered above. + + +Affected By:: +............. + +Existing restarts. + +See Also:: +.......... + +*note find-restart:: , *note invoke-restart:: , *note restart-bind:: + + +File: gcl.info, Node: find-restart, Next: invoke-restart, Prev: compute-restarts, Up: Conditions Dictionary + +9.2.33 find-restart [Function] +------------------------------ + +'find-restart' identifier &optional condition restart + +Arguments and Values:: +...................... + +identifier--a non-nil symbol, or a restart. + + condition--a condition object, or nil. + + restart--a restart or nil. + +Description:: +............. + +find-restart searches for a particular restart in the current dynamic +environment. + + When condition is non-nil, only those restarts are considered that +are either explicitly associated with that condition, or not associated +with any condition; that is, the excluded restarts are those that are +associated with a non-empty set of conditions of which the given +condition is not an element. If condition is nil, all restarts are +considered. + + If identifier is a symbol, then the innermost (most recently +established) applicable restart with that name is returned. nil is +returned if no such restart is found. + + If identifier is a currently active restart, then it is returned. +Otherwise, nil is returned. + +Examples:: +.......... + + (restart-case + (let ((r (find-restart 'my-restart))) + (format t "~S is named ~S" r (restart-name r))) + (my-restart () nil)) + |> # is named MY-RESTART + => NIL + (find-restart 'my-restart) + => NIL + +Affected By:: +............. + +Existing restarts. + + restart-case, restart-bind, with-condition-restarts. + +See Also:: +.......... + +*note compute-restarts:: + +Notes:: +....... + + (find-restart identifier) + == (find identifier (compute-restarts) :key :restart-name) + + Although anonymous restarts have a name of nil, the consequences are +unspecified if nil is given as an identifier. Occasionally, programmers +lament that nil is not permissible as an identifier argument. In most +such cases, compute-restarts can probably be used to simulate the +desired effect. + + +File: gcl.info, Node: invoke-restart, Next: invoke-restart-interactively, Prev: find-restart, Up: Conditions Dictionary + +9.2.34 invoke-restart [Function] +-------------------------------- + +'invoke-restart' restart &rest arguments => {result}* + +Arguments and Values:: +...................... + +restart--a restart designator. + + argument--an object. + + results--the values returned by the function associated with restart, +if that function returns. + +Description:: +............. + +Calls the function associated with restart, passing arguments to it. +Restart must be valid in the current dynamic environment. + +Examples:: +.......... + + (defun add3 (x) (check-type x number) (+ x 3)) + + (foo 'seven) + |> Error: The value SEVEN was not of type NUMBER. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a different value to use. + |> 2: Return to Lisp Toplevel. + |> Debug> |>>(invoke-restart 'store-value 7)<<| + => 10 + +Side Effects:: +.............. + +A non-local transfer of control might be done by the restart. + +Affected By:: +............. + +Existing restarts. + +Exceptional Situations:: +........................ + +If restart is not valid, an error of type control-error is signaled. + +See Also:: +.......... + +*note find-restart:: , *note restart-bind:: , *note restart-case:: , +*note invoke-restart-interactively:: + +Notes:: +....... + +The most common use for invoke-restart is in a handler. It might be +used explicitly, or implicitly through invoke-restart-interactively or a +restart function. + + Restart functions call invoke-restart, not vice versa. That is, +invoke-restart provides primitive functionality, and restart functions +are non-essential "syntactic sugar." + + +File: gcl.info, Node: invoke-restart-interactively, Next: restart-bind, Prev: invoke-restart, Up: Conditions Dictionary + +9.2.35 invoke-restart-interactively [Function] +---------------------------------------------- + +'invoke-restart-interactively' restart => {result}* + +Arguments and Values:: +...................... + +restart--a restart designator. + + results--the values returned by the function associated with restart, +if that function returns. + +Description:: +............. + +invoke-restart-interactively calls the function associated with restart, +prompting for any necessary arguments. If restart is a name, it must be +valid in the current dynamic environment. + + invoke-restart-interactively prompts for arguments by executing the +code provided in the :interactive keyword to restart-case or +:interactive-function keyword to restart-bind. + + If no such options have been supplied in the corresponding +restart-bind or restart-case, then the consequences are undefined if the +restart takes required arguments. If the arguments are optional, an +argument list of nil is used. + + Once the arguments have been determined, invoke-restart-interactively +executes the following: + + (apply #'invoke-restart restart arguments) + +Examples:: +.......... + + (defun add3 (x) (check-type x number) (+ x 3)) + + (add3 'seven) + |> Error: The value SEVEN was not of type NUMBER. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a different value to use. + |> 2: Return to Lisp Toplevel. + |> Debug> |>>(invoke-restart-interactively 'store-value)<<| + |> Type a form to evaluate and use: |>>7<<| + => 10 + +Side Effects:: +.............. + +If prompting for arguments is necesary, some typeout may occur (on query +I/O). + + A non-local transfer of control might be done by the restart. + +Affected By:: +............. + +*query-io*, active restarts + +Exceptional Situations:: +........................ + +If restart is not valid, an error of type control-error is signaled. + +See Also:: +.......... + +*note find-restart:: , *note invoke-restart:: , *note restart-case:: , +*note restart-bind:: + +Notes:: +....... + +invoke-restart-interactively is used internally by the debugger and may +also be useful in implementing other portable, interactive debugging +tools. + + +File: gcl.info, Node: restart-bind, Next: restart-case, Prev: invoke-restart-interactively, Up: Conditions Dictionary + +9.2.36 restart-bind [Macro] +--------------------------- + +'restart-bind' ({(name function {!key-val-pair}*)}) {form}* +=> {result}* + + key-val-pair ::=:interactive-function interactive-function | + :report-function report-function | + :test-function test-function + +Arguments and Values:: +...................... + +name--a symbol; not evaluated. + + function--a form; evaluated. + + forms--an implicit progn. + + interactive-function--a form; evaluated. + + report-function--a form; evaluated. + + test-function--a form; evaluated. + + results--the values returned by the forms. + +Description:: +............. + +restart-bind executes the body of forms in a dynamic environment where +restarts with the given names are in effect. + + If a name is nil, it indicates an anonymous restart; if a name is a +non-nil symbol, it indicates a named restart. + + The function, interactive-function, and report-function are +unconditionally evaluated in the current lexical and dynamic environment +prior to evaluation of the body. Each of these forms must evaluate to a +function. + + If invoke-restart is done on that restart, the function which +resulted from evaluating function is called, in the dynamic environment +of the invoke-restart, with the arguments given to invoke-restart. The +function may either perform a non-local transfer of control or may +return normally. + + If the restart is invoked interactively from the debugger (using +invoke-restart-interactively), the arguments are defaulted by calling +the function which resulted from evaluating interactive-function. That +function may optionally prompt interactively on query I/O, and should +return a list of arguments to be used by invoke-restart-interactively +when invoking the restart. + + If a restart is invoked interactively but no interactive-function is +used, then an argument list of nil is used. In that case, the function +must be compatible with an empty argument list. + + If the restart is presented interactively (e.g., by the debugger), +the presentation is done by calling the function which resulted from +evaluating report-function. This function must be a function of one +argument, a stream. It is expected to print a description of the action +that the restart takes to that stream. This function is called any time +the restart is printed while *print-escape* is nil. + + In the case of interactive invocation, the result is dependent on the +value of :interactive-function as follows. + +:interactive-function + Value is evaluated in the current lexical environment and should + return a function of no arguments which constructs a list of + arguments to be used by invoke-restart-interactively when invoking + this restart. The function may prompt interactively using query + I/O if necessary. + +:report-function + Value is evaluated in the current lexical environment and should + return a function of one argument, a stream, which prints on the + stream a summary of the action that this restart takes. This + function is called whenever the restart is reported (printed while + *print-escape* is nil). If no :report-function option is provided, + the manner in which the restart is reported is + implementation-dependent. + +:test-function + Value is evaluated in the current lexical environment and should + return a function of one argument, a condition, which returns true + if the restart is to be considered visible. + +Affected By:: +............. + +*query-io*. + +See Also:: +.......... + +*note restart-case:: , *note with-simple-restart:: + +Notes:: +....... + +restart-bind is primarily intended to be used to implement restart-case +and might be useful in implementing other macros. Programmers who are +uncertain about whether to use restart-case or restart-bind should +prefer restart-case for the cases where it is powerful enough, using +restart-bind only in cases where its full generality is really needed. + + +File: gcl.info, Node: restart-case, Next: restart-name, Prev: restart-bind, Up: Conditions Dictionary + +9.2.37 restart-case [Macro] +--------------------------- + +'restart-case' restartable-form {!clause} => {result}* + + clause ::=( case-name lambda-list + [[:interactive interactive-expression | :report report-expression | :test test-expression]] + {declaration}* {form}*) + +Arguments and Values:: +...................... + +restartable-form--a form. + + case-name--a symbol or nil. + + lambda-list--an ordinary lambda list. + + interactive-expression--a symbol or a lambda expression. + + report-expression--a string, a symbol, or a lambda expression. + + test-expression--a symbol or a lambda expression. + + declaration--a declare expression; not evaluated. + + form--a form. + + results--the values resulting from the evaluation of +restartable-form, or the values returned by the last form executed in a +chosen clause, or nil. + +Description:: +............. + +restart-case evaluates restartable-form in a dynamic environment where +the clauses have special meanings as points to which control may be +transferred. If restartable-form finishes executing and returns any +values, all values returned are returned by restart-case and processing +has completed. While restartable-form is executing, any code may +transfer control to one of the clauses (see invoke-restart). If a +transfer occurs, the forms in the body of that clause is evaluated and +any values returned by the last such form are returned by restart-case. +In this case, the dynamic state is unwound appropriately (so that the +restarts established around the restartable-form are no longer active) +prior to execution of the clause. + + If there are no forms in a selected clause, restart-case returns nil. + + If case-name is a symbol, it names this restart. + + It is possible to have more than one clause use the same case-name. +In this case, the first clause with that name is found by find-restart. +The other clauses are accessible using compute-restarts. + + Each arglist is an ordinary lambda list to be bound during the +execution of its corresponding forms. These parameters are used by the +restart-case clause to receive any necessary data from a call to +invoke-restart. + + By default, invoke-restart-interactively passes no arguments and all +arguments must be optional in order to accomodate interactive +restarting. However, the arguments need not be optional if the +:interactive keyword has been used to inform +invoke-restart-interactively about how to compute a proper argument +list. + + Keyword options have the following meaning. + +:interactive + The value supplied by :interactive value must be a suitable + argument to function. (function value) is evaluated in the current + lexical environment. It should return a function of no arguments + which returns arguments to be used by invoke-restart-interactively + when it is invoked. invoke-restart-interactively is called in the + dynamic environment available prior to any restart attempt, and + uses query I/O for user interaction. + + If a restart is invoked interactively but no :interactive option + was supplied, the argument list used in the invocation is the empty + list. + +:report + If the value supplied by :report value is a lambda expression or a + symbol, it must be acceptable to function. (function value) is + evaluated in the current lexical environment. It should return a + function of one argument, a stream, which prints on the stream a + description of the restart. This function is called whenever the + restart is printed while *print-escape* is nil. + + If value is a string, it is a shorthand for + + (lambda (stream) (write-string value stream)) + + If a named restart is asked to report but no report information has + been supplied, the name of the restart is used in generating + default report text. + + When *print-escape* is nil, the printer uses the report information + for a restart. For example, a debugger might announce the action + of typing a "continue" command by: + + (format t "~&~S -- ~A~ + + which might then display as something like: + + :CONTINUE -- Return to command level + + The consequences are unspecified if an unnamed restart is specified + but no :report option is provided. + +:test + The value supplied by :test value must be a suitable argument to + function. (function value) is evaluated in the current lexical + environment. It should return a function of one argument, the + condition, that returns true if the restart is to be considered + visible. + + The default for this option is equivalent to (lambda (c) (declare + (ignore c)) t). + + If the restartable-form is a list whose car is any of the symbols +signal, error, cerror, or warn (or is a macro form which macroexpands +into such a list), then with-condition-restarts is used implicitly to +associate the indicated restarts with the condition to be signaled. + +Examples:: +.......... + + (restart-case + (handler-bind ((error #'(lambda (c) + (declare (ignore condition)) + (invoke-restart 'my-restart 7)))) + (error "Foo.")) + (my-restart (&optional v) v)) + => 7 + + (define-condition food-error (error) ()) + => FOOD-ERROR + (define-condition bad-tasting-sundae (food-error) + ((ice-cream :initarg :ice-cream :reader bad-tasting-sundae-ice-cream) + (sauce :initarg :sauce :reader bad-tasting-sundae-sauce) + (topping :initarg :topping :reader bad-tasting-sundae-topping)) + (:report (lambda (condition stream) + (format stream "Bad tasting sundae with ~S, ~S, and ~S" + (bad-tasting-sundae-ice-cream condition) + (bad-tasting-sundae-sauce condition) + (bad-tasting-sundae-topping condition))))) + => BAD-TASTING-SUNDAE + (defun all-start-with-same-letter (symbol1 symbol2 symbol3) + (let ((first-letter (char (symbol-name symbol1) 0))) + (and (eql first-letter (char (symbol-name symbol2) 0)) + (eql first-letter (char (symbol-name symbol3) 0))))) + => ALL-START-WITH-SAME-LETTER + (defun read-new-value () + (format t "Enter a new value: ") + (multiple-value-list (eval (read)))) + => READ-NEW-VALUE + (defun verify-or-fix-perfect-sundae (ice-cream sauce topping) + (do () + ((all-start-with-same-letter ice-cream sauce topping)) + (restart-case + (error 'bad-tasting-sundae + :ice-cream ice-cream + :sauce sauce + :topping topping) + (use-new-ice-cream (new-ice-cream) + :report "Use a new ice cream." + :interactive read-new-value + (setq ice-cream new-ice-cream)) + (use-new-sauce (new-sauce) + :report "Use a new sauce." + :interactive read-new-value + (setq sauce new-sauce)) + (use-new-topping (new-topping) + :report "Use a new topping." + :interactive read-new-value + (setq topping new-topping)))) + (values ice-cream sauce topping)) + => VERIFY-OR-FIX-PERFECT-SUNDAE + (verify-or-fix-perfect-sundae 'vanilla 'caramel 'cherry) + |> Error: Bad tasting sundae with VANILLA, CARAMEL, and CHERRY. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Use a new ice cream. + |> 2: Use a new sauce. + |> 3: Use a new topping. + |> 4: Return to Lisp Toplevel. + |> Debug> |>>:continue 1<<| + |> Use a new ice cream. + |> Enter a new ice cream: |>>'chocolate<<| + => CHOCOLATE, CARAMEL, CHERRY + +See Also:: +.......... + +*note restart-bind:: , *note with-simple-restart:: . + +Notes:: +....... + + (restart-case expression + (name1 arglist1 ...options1... . body1) + (name2 arglist2 ...options2... . body2)) + + is essentially equivalent to + + (block #1=#:g0001 + (let ((#2=#:g0002 nil)) + (tagbody + (restart-bind ((name1 #'(lambda (&rest temp) + (setq #2# temp) + (go #3=#:g0003)) + ...slightly-transformed-options1...) + (name2 #'(lambda (&rest temp) + (setq #2# temp) + (go #4=#:g0004)) + ...slightly-transformed-options2...)) + (return-from #1# expression)) + #3# (return-from #1# + (apply #'(lambda arglist1 . body1) #2#)) + #4# (return-from #1# + (apply #'(lambda arglist2 . body2) #2#))))) + + Unnamed restarts are generally only useful interactively and an +interactive option which has no description is of little value. +Implementations are encouraged to warn if an unnamed restart is used and +no report information is provided at compilation time. At runtime, this +error might be noticed when entering the debugger. Since signaling an +error would probably cause recursive entry into the debugger (causing +yet another recursive error, etc.) it is suggested that the debugger +print some indication of such problems when they occur but not actually +signal errors. + + (restart-case (signal fred) + (a ...) + (b ...)) + == + (restart-case + (with-condition-restarts fred + (list (find-restart 'a) + (find-restart 'b)) + (signal fred)) + (a ...) + (b ...)) + + +File: gcl.info, Node: restart-name, Next: with-condition-restarts, Prev: restart-case, Up: Conditions Dictionary + +9.2.38 restart-name [Function] +------------------------------ + +'restart-name' restart => name + +Arguments and Values:: +...................... + +restart--a restart. + + name--a symbol. + +Description:: +............. + +Returns the name of the restart, or nil if the restart is not named. + +Examples:: +.......... + + (restart-case + (loop for restart in (compute-restarts) + collect (restart-name restart)) + (case1 () :report "Return 1." 1) + (nil () :report "Return 2." 2) + (case3 () :report "Return 3." 3) + (case1 () :report "Return 4." 4)) + => (CASE1 NIL CASE3 CASE1 ABORT) + ;; In the example above the restart named ABORT was not created + ;; explicitly, but was implicitly supplied by the system. + +See Also:: +.......... + +*note compute-restarts:: + + *note find-restart:: + + +File: gcl.info, Node: with-condition-restarts, Next: with-simple-restart, Prev: restart-name, Up: Conditions Dictionary + +9.2.39 with-condition-restarts [Macro] +-------------------------------------- + +'with-condition-restarts' condition-form restarts-form {form}* +=> {result}* + +Arguments and Values:: +...................... + +condition-form--a form; evaluated to produce a condition. + + condition--a condition object resulting from the evaluation of +condition-form. + + restart-form--a form; evaluated to produce a restart-list. + + restart-list--a list of restart objects resulting from the evaluation +of restart-form. + + forms--an implicit progn; evaluated. + + results--the values returned by forms. + +Description:: +............. + +First, the condition-form and restarts-form are evaluated in normal +left-to-right order; the primary values yielded by these evaluations are +respectively called the condition and the restart-list. + + Next, the forms are evaluated in a dynamic environment in which each +restart in restart-list is associated with the condition. See *note +Associating a Restart with a Condition::. + +See Also:: +.......... + +*note restart-case:: + +Notes:: +....... + +Usually this macro is not used explicitly in code, since restart-case +handles most of the common cases in a way that is syntactically more +concise. + + +File: gcl.info, Node: with-simple-restart, Next: abort (Restart), Prev: with-condition-restarts, Up: Conditions Dictionary + +9.2.40 with-simple-restart [Macro] +---------------------------------- + +'with-simple-restart' (name format-control {format-argument}*) {form}* +=> {result}* + +Arguments and Values:: +...................... + +name--a symbol. + + format-control--a format control. + + format-argument--an object (i.e., a format argument). + + forms--an implicit progn. + + results--in the normal situation, the values returned by the forms; +in the exceptional situation where the restart named name is invoked, +two values--nil and t. + +Description:: +............. + +with-simple-restart establishes a restart. + + If the restart designated by name is not invoked while executing +forms, all values returned by the last of forms are returned. If the +restart designated by name is invoked, control is transferred to +with-simple-restart, which returns two values, nil and t. + + If name is nil, an anonymous restart is established. + + The format-control and format-arguments are used report the restart. + +Examples:: +.......... + + (defun read-eval-print-loop (level) + (with-simple-restart (abort "Exit command level ~D." level) + (loop + (with-simple-restart (abort "Return to command level ~D." level) + (let ((form (prog2 (fresh-line) (read) (fresh-line)))) + (prin1 (eval form))))))) + => READ-EVAL-PRINT-LOOP + (read-eval-print-loop 1) + (+ 'a 3) + |> Error: The argument, A, to the function + was of the wrong type. + |> The function expected a number. + |> To continue, type :CONTINUE followed by an option number: + |> 1: Specify a value to use this time. + |> 2: Return to command level 1. + |> 3: Exit command level 1. + |> 4: Return to Lisp Toplevel. + + (defun compute-fixnum-power-of-2 (x) + (with-simple-restart (nil "Give up on computing 2^~D." x) + (let ((result 1)) + (dotimes (i x result) + (setq result (* 2 result)) + (unless (fixnump result) + (error "Power of 2 is too large.")))))) + COMPUTE-FIXNUM-POWER-OF-2 + (defun compute-power-of-2 (x) + (or (compute-fixnum-power-of-2 x) 'something big)) + COMPUTE-POWER-OF-2 + (compute-power-of-2 10) + 1024 + (compute-power-of-2 10000) + |> Error: Power of 2 is too large. + |> To continue, type :CONTINUE followed by an option number. + |> 1: Give up on computing 2^10000. + |> 2: Return to Lisp Toplevel + |> Debug> |>>:continue 1<<| + => SOMETHING-BIG + +See Also:: +.......... + +*note restart-case:: + +Notes:: +....... + +with-simple-restart is shorthand for one of the most common uses of +restart-case. + + with-simple-restart could be defined by: + + (defmacro with-simple-restart ((restart-name format-control + &rest format-arguments) + &body forms) + `(restart-case (progn ,@forms) + (,restart-name () + :report (lambda (stream) + (format stream ,format-control ,@format-arguments)) + (values nil t)))) + + Because the second return value is t in the exceptional case, it is +common (but not required) to arrange for the second return value in the +normal case to be missing or nil so that the two situations can be +distinguished. + + +File: gcl.info, Node: abort (Restart), Next: continue, Prev: with-simple-restart, Up: Conditions Dictionary + +9.2.41 abort [Restart] +---------------------- + +Data Arguments Required:: +......................... + +None. + +Description:: +............. + +The intent of the abort restart is to allow return to the innermost +"command level." Implementors are encouraged to make sure that there is +always a restart named abort around any user code so that user code can +call abort at any time and expect something reasonable to happen; +exactly what the reasonable thing is may vary somewhat. Typically, in +an interactive listener, the invocation of abort returns to the Lisp +reader phase of the Lisp read-eval-print loop, though in some batch or +multi-processing situations there may be situations in which having it +kill the running process is more appropriate. + +See Also:: +.......... + +*note Restarts::, *note Interfaces to Restarts::, *note invoke-restart:: +, *note abort (Function):: (function) + + +File: gcl.info, Node: continue, Next: muffle-warning, Prev: abort (Restart), Up: Conditions Dictionary + +9.2.42 continue [Restart] +------------------------- + +Data Arguments Required:: +......................... + +None. + +Description:: +............. + +The continue restart is generally part of protocols where there is a +single "obvious" way to continue, such as in break and cerror. Some +user-defined protocols may also wish to incorporate it for similar +reasons. In general, however, it is more reliable to design a special +purpose restart with a name that more directly suits the particular +application. + +Examples:: +.......... + + (let ((x 3)) + (handler-bind ((error #'(lambda (c) + (let ((r (find-restart 'continue c))) + (when r (invoke-restart r)))))) + (cond ((not (floatp x)) + (cerror "Try floating it." "~D is not a float." x) + (float x)) + (t x)))) => 3.0 + +See Also:: +.......... + +*note Restarts::, *note Interfaces to Restarts::, *note invoke-restart:: +, *note continue:: (function), *note assert:: , *note cerror:: + + +File: gcl.info, Node: muffle-warning, Next: store-value, Prev: continue, Up: Conditions Dictionary + +9.2.43 muffle-warning [Restart] +------------------------------- + +Data Arguments Required:: +......................... + +None. + +Description:: +............. + +This restart is established by warn so that handlers of warning +conditions have a way to tell warn that a warning has already been dealt +with and that no further action is warranted. + +Examples:: +.......... + + (defvar *all-quiet* nil) => *ALL-QUIET* + (defvar *saved-warnings* '()) => *SAVED-WARNINGS* + (defun quiet-warning-handler (c) + (when *all-quiet* + (let ((r (find-restart 'muffle-warning c))) + (when r + (push c *saved-warnings*) + (invoke-restart r))))) + => CUSTOM-WARNING-HANDLER + (defmacro with-quiet-warnings (&body forms) + `(let ((*all-quiet* t) + (*saved-warnings* '())) + (handler-bind ((warning #'quiet-warning-handler)) + ,@forms + *saved-warnings*))) + => WITH-QUIET-WARNINGS + (setq saved + (with-quiet-warnings + (warn "Situation #1.") + (let ((*all-quiet* nil)) + (warn "Situation #2.")) + (warn "Situation #3."))) + |> Warning: Situation #2. + => (# #) + (dolist (s saved) (format t "~&~A~ + |> Situation #3. + |> Situation #1. + => NIL + +See Also:: +.......... + +*note Restarts::, *note Interfaces to Restarts::, *note invoke-restart:: +, *note muffle-warning:: (function), *note warn:: + + +File: gcl.info, Node: store-value, Next: use-value, Prev: muffle-warning, Up: Conditions Dictionary + +9.2.44 store-value [Restart] +---------------------------- + +Data Arguments Required:: +......................... + +a value to use instead (on an ongoing basis). + +Description:: +............. + +The store-value restart is generally used by handlers trying to recover +from errors of types such as cell-error or type-error, which may wish to +supply a replacement datum to be stored permanently. + +Examples:: +.......... + + (defun type-error-auto-coerce (c) + (when (typep c 'type-error) + (let ((r (find-restart 'store-value c))) + (handler-case (let ((v (coerce (type-error-datum c) + (type-error-expected-type c)))) + (invoke-restart r v)) + (error ()))))) => TYPE-ERROR-AUTO-COERCE + (let ((x 3)) + (handler-bind ((type-error #'type-error-auto-coerce)) + (check-type x float) + x)) => 3.0 + +See Also:: +.......... + +*note Restarts::, *note Interfaces to Restarts::, *note invoke-restart:: +, *note store-value:: (function), ccase, *note check-type:: , ctypecase, +*note use-value:: (function and restart) + + +File: gcl.info, Node: use-value, Next: abort (Function), Prev: store-value, Up: Conditions Dictionary + +9.2.45 use-value [Restart] +-------------------------- + +Data Arguments Required:: +......................... + +a value to use instead (once). + +Description:: +............. + +The use-value restart is generally used by handlers trying to recover +from errors of types such as cell-error, where the handler may wish to +supply a replacement datum for one-time use. + +See Also:: +.......... + +*note Restarts::, *note Interfaces to Restarts::, *note invoke-restart:: +, *note use-value:: (function), *note store-value:: (function and +restart) + + +File: gcl.info, Node: abort (Function), Prev: use-value, Up: Conditions Dictionary + +9.2.46 abort, continue, muffle-warning, store-value, use-value [Function] +------------------------------------------------------------------------- + +'abort' &optional condition => # + + 'continue' &optional condition => nil + + 'muffle-warning' &optional condition => # + + 'store-value' value &optional condition => nil + + 'use-value' value &optional condition => nil + +Arguments and Values:: +...................... + +value--an object. + + condition--a condition object, or nil. + +Description:: +............. + +Transfers control to the most recently established applicable restart +having the same name as the function. That is, the function abort +searches for an applicable abort restart, the function continue searches +for an applicable continue restart, and so on. + + If no such restart exists, the functions continue, store-value, and +use-value return nil, and the functions abort and muffle-warning signal +an error of type control-error. + + When condition is non-nil, only those restarts are considered that +are either explicitly associated with that condition, or not associated +with any condition; that is, the excluded restarts are those that are +associated with a non-empty set of conditions of which the given +condition is not an element. If condition is nil, all restarts are +considered. + +Examples:: +.......... + + ;;; Example of the ABORT retart + + (defmacro abort-on-error (&body forms) + `(handler-bind ((error #'abort)) + ,@forms)) => ABORT-ON-ERROR + (abort-on-error (+ 3 5)) => 8 + (abort-on-error (error "You lose.")) + |> Returned to Lisp Top Level. + + ;;; Example of the CONTINUE restart + + (defun real-sqrt (n) + (when (minusp n) + (setq n (- n)) + (cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n)) + (sqrt n)) + + (real-sqrt 4) => 2 + (real-sqrt -9) + |> Error: Tried to take sqrt(-9). + |> To continue, type :CONTINUE followed by an option number: + |> 1: Return sqrt(9) instead. + |> 2: Return to Lisp Toplevel. + |> Debug> |>>(continue)<<| + |> Return sqrt(9) instead. + => 3 + + (handler-bind ((error #'(lambda (c) (continue)))) + (real-sqrt -9)) => 3 + + ;;; Example of the MUFFLE-WARNING restart + + (defun count-down (x) + (do ((counter x (1- counter))) + ((= counter 0) 'done) + (when (= counter 1) + (warn "Almost done")) + (format t "~&~D~ + => COUNT-DOWN + (count-down 3) + |> 3 + |> 2 + |> Warning: Almost done + |> 1 + => DONE + (defun ignore-warnings-while-counting (x) + (handler-bind ((warning #'ignore-warning)) + (count-down x))) + => IGNORE-WARNINGS-WHILE-COUNTING + (defun ignore-warning (condition) + (declare (ignore condition)) + (muffle-warning)) + => IGNORE-WARNING + (ignore-warnings-while-counting 3) + |> 3 + |> 2 + |> 1 + => DONE + + ;;; Example of the STORE-VALUE and USE-VALUE restarts + + (defun careful-symbol-value (symbol) + (check-type symbol symbol) + (restart-case (if (boundp symbol) + (return-from careful-symbol-value + (symbol-value symbol)) + (error 'unbound-variable + :name symbol)) + (use-value (value) + :report "Specify a value to use this time." + value) + (store-value (value) + :report "Specify a value to store and use in the future." + (setf (symbol-value symbol) value)))) + (setq a 1234) => 1234 + (careful-symbol-value 'a) => 1234 + (makunbound 'a) => A + (careful-symbol-value 'a) + |> Error: A is not bound. + |> To continue, type :CONTINUE followed by an option number. + |> 1: Specify a value to use this time. + |> 2: Specify a value to store and use in the future. + |> 3: Return to Lisp Toplevel. + |> Debug> |>>(use-value 12)<<| + => 12 + (careful-symbol-value 'a) + |> Error: A is not bound. + |> To continue, type :CONTINUE followed by an option number. + |> 1: Specify a value to use this time. + |> 2: Specify a value to store and use in the future. + |> 3: Return to Lisp Toplevel. + |> Debug> |>>(store-value 24)<<| + => 24 + (careful-symbol-value 'a) + => 24 + + ;;; Example of the USE-VALUE restart + + (defun add-symbols-with-default (default &rest symbols) + (handler-bind ((sys:unbound-symbol + #'(lambda (c) + (declare (ignore c)) + (use-value default)))) + (apply #'+ (mapcar #'careful-symbol-value symbols)))) + => ADD-SYMBOLS-WITH-DEFAULT + (setq x 1 y 2) => 2 + (add-symbols-with-default 3 'x 'y 'z) => 6 + + +Side Effects:: +.............. + +A transfer of control may occur if an appropriate restart is available, +or (in the case of the function abort or the function muffle-warning) +execution may be stopped. + +Affected By:: +............. + +Each of these functions can be affected by the presence of a restart +having the same name. + +Exceptional Situations:: +........................ + +If an appropriate abort restart is not available for the function abort, +or an appropriate muffle-warning restart is not available for the +function muffle-warning, an error of type control-error is signaled. + +See Also:: +.......... + +*note invoke-restart:: , *note Restarts::, *note Interfaces to +Restarts::, *note assert:: , ccase, *note cerror:: , *note check-type:: +, ctypecase, *note use-value:: , *note warn:: + +Notes:: +....... + + (abort condition) == (invoke-restart 'abort) + (muffle-warning) == (invoke-restart 'muffle-warning) + (continue) == (let ((r (find-restart 'continue))) (if r (invoke-restart r))) + (use-value x) == (let ((r (find-restart 'use-value))) (if r (invoke-restart r x))) + (store-value x) == (let ((r (find-restart 'store-value))) (if r (invoke-restart r x))) + + No functions defined in this specification are required to provide a +use-value restart. + + +File: gcl.info, Node: Symbols, Next: Packages, Prev: Conditions, Up: Top + +10 Symbols +********** + +* Menu: + +* Symbol Concepts:: +* Symbols Dictionary:: + + +File: gcl.info, Node: Symbol Concepts, Next: Symbols Dictionary, Prev: Symbols, Up: Symbols + +10.1 Symbol Concepts +==================== + +Figure 10-1 lists some defined names that are applicable to the property +lists of symbols. + + get remprop symbol-plist + + Figure 10-1: Property list defined names + + + Figure 10-2 lists some defined names that are applicable to the +creation of and inquiry about symbols. + + copy-symbol keywordp symbol-package + gensym make-symbol symbol-value + gentemp symbol-name + + Figure 10-2: Symbol creation and inquiry defined names + + + +File: gcl.info, Node: Symbols Dictionary, Prev: Symbol Concepts, Up: Symbols + +10.2 Symbols Dictionary +======================= + +* Menu: + +* symbol:: +* keyword:: +* symbolp:: +* keywordp:: +* make-symbol:: +* copy-symbol:: +* gensym:: +* *gensym-counter*:: +* gentemp:: +* symbol-function:: +* symbol-name:: +* symbol-package:: +* symbol-plist:: +* symbol-value:: +* get:: +* remprop:: +* boundp:: +* makunbound:: +* set:: +* unbound-variable:: + + +File: gcl.info, Node: symbol, Next: keyword, Prev: Symbols Dictionary, Up: Symbols Dictionary + +10.2.1 symbol [System Class] +---------------------------- + +Class Precedence List:: +....................... + +symbol, t + +Description:: +............. + +Symbols are used for their object identity to name various entities in +Common Lisp, including (but not limited to) linguistic entities such as +variables and functions. + + Symbols can be collected together into packages. A symbol is said to +be interned in a package if it is accessible in that package; the same +symbol can be interned in more than one package. If a symbol is not +interned in any package, it is called uninterned. + + An interned symbol is uniquely identifiable by its name from any +package in which it is accessible. + + Symbols have the following attributes. For historically reasons, +these are sometimes referred to as cells, although the actual internal +representation of symbols and their attributes is +implementation-dependent. + +Name + The name of a symbol is a string used to identify the symbol. + Every symbol has a name, + + and the consequences are undefined if that name is altered. + + The name is used as part of the external, printed representation of + the symbol; see *note Character Syntax::. The function symbol-name + returns the name of a given symbol. + + A symbol may have any character in its name. + +Package + The object in this cell is called the home package of the symbol. + If the home package is nil, the symbol is sometimes said to have no + home package. + + When a symbol is first created, it has no home package. When it is + first interned, the package in which it is initially interned + becomes its home package. The home package of a symbol can be + accessed by using the function symbol-package. + + If a symbol is uninterned from the package which is its home + package, its home package is set to nil. Depending on whether + there is another package in which the symbol is interned, the + symbol might or might not really be an uninterned symbol. A symbol + with no home package is therefore called apparently uninterned. + + The consequences are undefined if an attempt is made to alter the + home package of a symbol external in the COMMON-LISP package or the + KEYWORD package. + +Property list + The property list of a symbol provides a mechanism for associating + named attributes with that symbol. The operations for adding and + removing entries are destructive to the property list. Common Lisp + provides operators both for direct manipulation of property list + objects (e.g., see getf, remf, and symbol-plist) and for implicit + manipulation of a symbol's property list by reference to the symbol + (e.g., see get and remprop). The property list associated with a + fresh symbol is initially null. + +Value + If a symbol has a value attribute, it is said to be bound, and that + fact can be detected by the function boundp. The object contained + in the value cell of a bound symbol is the value of the global + variable named by that symbol, and can be accessed by the function + symbol-value. A symbol can be made to be unbound by the function + makunbound. + + The consequences are undefined if an attempt is made to change the + value of a symbol that names a constant variable, or to make such a + symbol be unbound. + +Function + If a symbol has a function attribute, it is said to be fbound, and + that fact can be detected by the function fboundp. If the symbol + is the name of a function in the global environment, the function + cell contains the function, and can be accessed by the function + symbol-function. If the symbol is the name of either a macro in + the global environment (see macro-function) or a special operator + (see special-operator-p), the symbol is fbound, and can be accessed + by the function symbol-function, but the object which the function + cell contains is of implementation-dependent type and purpose. A + symbol can be made to be funbound by the function fmakunbound. + + The consequences are undefined if an attempt is made to change the + functional value of a symbol that names a special form. + + Operations on a symbol's value cell and function cell are sometimes +described in terms of their effect on the symbol itself, but the user +should keep in mind that there is an intimate relationship between the +contents of those cells and the global variable or global function +definition, respectively. + + Symbols are used as identifiers for lexical variables and lexical +function definitions, but in that role, only their object identity is +significant. Common Lisp provides no operation on a symbol that can +have any effect on a lexical variable or on a lexical function +definition. + +See Also:: +.......... + +*note Symbols as Tokens::, *note Potential Numbers as Tokens::, *note +Printing Symbols:: + + +File: gcl.info, Node: keyword, Next: symbolp, Prev: symbol, Up: Symbols Dictionary + +10.2.2 keyword [Type] +--------------------- + +Supertypes:: +............ + +keyword, symbol, t + +Description:: +............. + +The type keyword includes all symbols interned the KEYWORD package. + + Interning a symbol in the KEYWORD package has three automatic +effects: + +1. + It causes the symbol to become bound to itself. +2. + It causes the symbol to become an external symbol of the KEYWORD + package. +3. + It causes the symbol to become a constant variable. + +See Also:: +.......... + +*note keywordp:: + + +File: gcl.info, Node: symbolp, Next: keywordp, Prev: keyword, Up: Symbols Dictionary + +10.2.3 symbolp [Function] +------------------------- + +'symbolp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type symbol; otherwise, returns false. + +Examples:: +.......... + + (symbolp 'elephant) => true + (symbolp 12) => false + (symbolp nil) => true + (symbolp '()) => true + (symbolp :test) => true + (symbolp "hello") => false + +See Also:: +.......... + +*note keywordp:: , symbol, *note typep:: + +Notes:: +....... + + (symbolp object) == (typep object 'symbol) + + +File: gcl.info, Node: keywordp, Next: make-symbol, Prev: symbolp, Up: Symbols Dictionary + +10.2.4 keywordp [Function] +-------------------------- + +'keywordp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is a keyword_1; otherwise, returns false. + +Examples:: +.......... + + (keywordp 'elephant) => false + (keywordp 12) => false + (keywordp :test) => true + (keywordp ':test) => true + (keywordp nil) => false + (keywordp :nil) => true + (keywordp '(:test)) => false + (keywordp "hello") => false + (keywordp ":hello") => false + (keywordp '&optional) => false + +See Also:: +.......... + +*note constantp:: , *note keyword:: , *note symbolp:: , *note +symbol-package:: + + +File: gcl.info, Node: make-symbol, Next: copy-symbol, Prev: keywordp, Up: Symbols Dictionary + +10.2.5 make-symbol [Function] +----------------------------- + +'make-symbol' name => new-symbol + +Arguments and Values:: +...................... + +name--a string. + + new-symbol--a fresh, uninterned symbol. + +Description:: +............. + +make-symbol creates and returns a fresh, uninterned symbol whose name is +the given name. The new-symbol is neither bound nor fbound and has a +null property list. + + It is implementation-dependent whether the string that becomes the +new-symbol's name is the given name or a copy of it. Once a string has +been given as the name argument to make-symbol, the consequences are +undefined if a subsequent attempt is made to alter that string. + +Examples:: +.......... + + (setq temp-string "temp") => "temp" + (setq temp-symbol (make-symbol temp-string)) => #:|temp| + (symbol-name temp-symbol) => "temp" + (eq (symbol-name temp-symbol) temp-string) => implementation-dependent + (find-symbol "temp") => NIL, NIL + (eq (make-symbol temp-string) (make-symbol temp-string)) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if name is not a string. + +See Also:: +.......... + +*note copy-symbol:: + +Notes:: +....... + +No attempt is made by make-symbol to convert the case of the name to +uppercase. The only case conversion which ever occurs for symbols is +done by the Lisp reader. The program interface to symbol creation +retains case, and the program interface to interning symbols is +case-sensitive. + + +File: gcl.info, Node: copy-symbol, Next: gensym, Prev: make-symbol, Up: Symbols Dictionary + +10.2.6 copy-symbol [Function] +----------------------------- + +'copy-symbol' symbol &optional copy-properties => new-symbol + +Arguments and Values:: +...................... + +symbol--a symbol. + + copy-properties--a generalized boolean. The default is false. + + new-symbol--a fresh, uninterned symbol. + +Description:: +............. + +copy-symbol returns a fresh, uninterned symbol, the name of which is +string= to and possibly the same as the name of the given symbol. + + If copy-properties is false, the new-symbol is neither bound nor +fbound and has a null property list. If copy-properties is true, then +the initial value of new-symbol is the value of symbol, the initial +function definition of new-symbol is the functional value of symbol, and +the property list of new-symbol is + + a copy_2 of the property list of symbol. + +Examples:: +.......... + + (setq fred 'fred-smith) => FRED-SMITH + (setf (symbol-value fred) 3) => 3 + (setq fred-clone-1a (copy-symbol fred nil)) => #:FRED-SMITH + (setq fred-clone-1b (copy-symbol fred nil)) => #:FRED-SMITH + (setq fred-clone-2a (copy-symbol fred t)) => #:FRED-SMITH + (setq fred-clone-2b (copy-symbol fred t)) => #:FRED-SMITH + (eq fred fred-clone-1a) => false + (eq fred-clone-1a fred-clone-1b) => false + (eq fred-clone-2a fred-clone-2b) => false + (eq fred-clone-1a fred-clone-2a) => false + (symbol-value fred) => 3 + (boundp fred-clone-1a) => false + (symbol-value fred-clone-2a) => 3 + (setf (symbol-value fred-clone-2a) 4) => 4 + (symbol-value fred) => 3 + (symbol-value fred-clone-2a) => 4 + (symbol-value fred-clone-2b) => 3 + (boundp fred-clone-1a) => false + (setf (symbol-function fred) #'(lambda (x) x)) => # + (fboundp fred) => true + (fboundp fred-clone-1a) => false + (fboundp fred-clone-2a) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + +See Also:: +.......... + +*note make-symbol:: + +Notes:: +....... + +Implementors are encouraged not to copy the string which is the symbol's +name unnecessarily. Unless there is a good reason to do so, the normal +implementation strategy is for the new-symbol's name to be identical to +the given symbol's name. + + +File: gcl.info, Node: gensym, Next: *gensym-counter*, Prev: copy-symbol, Up: Symbols Dictionary + +10.2.7 gensym [Function] +------------------------ + +'gensym' &optional x => new-symbol + +Arguments and Values:: +...................... + +x--a string or a non-negative integer. Complicated defaulting behavior; +see below. + + new-symbol--a fresh, uninterned symbol. + +Description:: +............. + +Creates and returns a fresh, uninterned symbol, as if by calling +make-symbol. (The only difference between gensym and make-symbol is in +how the new-symbol's name is determined.) + + The name of the new-symbol is the concatenation of a prefix, which +defaults to "G", and + + a suffix, which is the decimal representation of a number that +defaults to the value of *gensym-counter*. + + If x is supplied, and is a string, then that string is used as a +prefix instead of "G" for this call to gensym only. + + If x is supplied, and is an integer, then that integer, instead of +the value of *gensym-counter*, is used as the suffix for this call to +gensym only. + + If and only if no explicit suffix is supplied, *gensym-counter* is +incremented after it is used. + +Examples:: +.......... + + (setq sym1 (gensym)) => #:G3142 + (symbol-package sym1) => NIL + (setq sym2 (gensym 100)) => #:G100 + (setq sym3 (gensym 100)) => #:G100 + (eq sym2 sym3) => false + (find-symbol "G100") => NIL, NIL + (gensym "T") => #:T3143 + (gensym) => #:G3144 + +Side Effects:: +.............. + +Might increment *gensym-counter*. + +Affected By:: +............. + +*gensym-counter* + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if x is not a string or a +non-negative integer. + +See Also:: +.......... + +*note gentemp:: , *gensym-counter* + +Notes:: +....... + +The ability to pass a numeric argument to gensym has been deprecated; +explicitly binding *gensym-counter* is now stylistically preferred. +(The somewhat baroque conventions for the optional argument are +historical in nature, and supported primarily for compatibility with +older dialects of Lisp. In modern code, it is recommended that the only +kind of argument used be a string prefix. In general, though, to obtain +more flexible control of the new-symbol's name, consider using +make-symbol instead.) + + +File: gcl.info, Node: *gensym-counter*, Next: gentemp, Prev: gensym, Up: Symbols Dictionary + +10.2.8 *gensym-counter* [Variable] +---------------------------------- + +Value Type:: +............ + +a non-negative integer. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +A number which will be used in constructing the name of the next symbol +generated by the function gensym. + + *gensym-counter* can be either assigned or bound at any time, but its +value must always be a non-negative integer. + +Affected By:: +............. + +gensym. + +See Also:: +.......... + +*note gensym:: + +Notes:: +....... + +The ability to pass a numeric argument to gensym has been deprecated; +explicitly binding *gensym-counter* is now stylistically preferred. + + +File: gcl.info, Node: gentemp, Next: symbol-function, Prev: *gensym-counter*, Up: Symbols Dictionary + +10.2.9 gentemp [Function] +------------------------- + +'gentemp' &optional prefix package => new-symbol + +Arguments and Values:: +...................... + +prefix--a string. The default is "T". + + package--a package designator. The default is the current package. + + new-symbol--a fresh, interned symbol. + +Description:: +............. + +gentemp creates and returns a fresh symbol, interned in the indicated +package. The symbol is guaranteed to be one that was not previously +accessible in package. It is neither bound nor fbound, and has a null +property list. + + The name of the new-symbol is the concatenation of the prefix and a +suffix, which is taken from an internal counter used only by gentemp. +(If a symbol by that name is already accessible in package, the counter +is incremented as many times as is necessary to produce a name that is +not already the name of a symbol accessible in package.) + +Examples:: +.......... + + (gentemp) => T1298 + (gentemp "FOO") => FOO1299 + (find-symbol "FOO1300") => NIL, NIL + (gentemp "FOO") => FOO1300 + (find-symbol "FOO1300") => FOO1300, :INTERNAL + (intern "FOO1301") => FOO1301, :INTERNAL + (gentemp "FOO") => FOO1302 + (gentemp) => T1303 + +Side Effects:: +.............. + +Its internal counter is incremented one or more times. + + Interns the new-symbol in package. + +Affected By:: +............. + +The current state of its internal counter, and the current state of the +package. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if prefix is not a string. +Should signal an error of type type-error if package is not a package +designator. + +See Also:: +.......... + +*note gensym:: + +Notes:: +....... + +The function gentemp is deprecated. + + If package is the KEYWORD package, the result is an external symbol +of package. Otherwise, the result is an internal symbol of package. + + The gentemp internal counter is independent of *gensym-counter*, the +counter used by gensym. There is no provision for accessing the gentemp +internal counter. + + Just because gentemp creates a symbol which did not previously exist +does not mean that such a symbol might not be seen in the future (e.g., +in a data file--perhaps even created by the same program in another +session). As such, this symbol is not truly unique in the same sense as +a gensym would be. In particular, programs which do automatic code +generation should be careful not to attach global attributes to such +generated symbols (e.g., special declarations) and then write them into +a file because such global attributes might, in a different session, end +up applying to other symbols that were automatically generated on +another day for some other purpose. + + +File: gcl.info, Node: symbol-function, Next: symbol-name, Prev: gentemp, Up: Symbols Dictionary + +10.2.10 symbol-function [Accessor] +---------------------------------- + +'symbol-function' symbol => contents + + (setf (' symbol-function' symbol) new-contents) + +Arguments and Values:: +...................... + +symbol--a symbol. + + contents-- + + If the symbol is globally defined as a macro or a special operator, +an object of implementation-dependent nature and identity is returned. +If the symbol is not globally defined as either a macro or a special +operator, and if the symbol is fbound, a function object is returned. + + new-contents--a function. + +Description:: +............. + +Accesses the symbol's function cell. + +Examples:: +.......... + + (symbol-function 'car) => # + (symbol-function 'twice) is an error ;because TWICE isn't defined. + (defun twice (n) (* n 2)) => TWICE + (symbol-function 'twice) => # + (list (twice 3) + (funcall (function twice) 3) + (funcall (symbol-function 'twice) 3)) + => (6 6 6) + (flet ((twice (x) (list x x))) + (list (twice 3) + (funcall (function twice) 3) + (funcall (symbol-function 'twice) 3))) + => ((3 3) (3 3) 6) + (setf (symbol-function 'twice) #'(lambda (x) (list x x))) + => # + (list (twice 3) + (funcall (function twice) 3) + (funcall (symbol-function 'twice) 3)) + => ((3 3) (3 3) (3 3)) + (fboundp 'defun) => true + (symbol-function 'defun) + => implementation-dependent + (functionp (symbol-function 'defun)) + => implementation-dependent + (defun symbol-function-or-nil (symbol) + (if (and (fboundp symbol) + (not (macro-function symbol)) + (not (special-operator-p symbol))) + (symbol-function symbol) + nil)) => SYMBOL-FUNCTION-OR-NIL + (symbol-function-or-nil 'car) => # + (symbol-function-or-nil 'defun) => NIL + +Affected By:: +............. + +defun + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + + Should signal undefined-function if symbol is not fbound and an +attempt is made to read its definition. (No such error is signaled on +an attempt to write its definition.) + +See Also:: +.......... + +*note fboundp:: , *note fmakunbound:: , *note macro-function:: , + + *note special-operator-p:: + +Notes:: +....... + +symbol-function cannot access the value of a lexical function name +produced by flet or labels; it can access only the global function +value. + + setf may be used with symbol-function to replace a global function +definition when the symbol's function definition does not represent a +special operator. + + (symbol-function symbol) == (fdefinition symbol) + + However, fdefinition accepts arguments other than just symbols. + + +File: gcl.info, Node: symbol-name, Next: symbol-package, Prev: symbol-function, Up: Symbols Dictionary + +10.2.11 symbol-name [Function] +------------------------------ + +'symbol-name' symbol => name + +Arguments and Values:: +...................... + +symbol--a symbol. + + name--a string. + +Description:: +............. + +symbol-name returns the name of symbol. + + The consequences are undefined if name is ever modified. + +Examples:: +.......... + + (symbol-name 'temp) => "TEMP" + (symbol-name :start) => "START" + (symbol-name (gensym)) => "G1234" ;for example + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + + +File: gcl.info, Node: symbol-package, Next: symbol-plist, Prev: symbol-name, Up: Symbols Dictionary + +10.2.12 symbol-package [Function] +--------------------------------- + +'symbol-package' symbol => contents + +Arguments and Values:: +...................... + +symbol--a symbol. + + contents--a package object or nil. + +Description:: +............. + +Returns the home package of symbol. + +Examples:: +.......... + + (in-package "CL-USER") => # + (symbol-package 'car) => # + (symbol-package 'bus) => # + (symbol-package :optional) => # + ;; Gensyms are uninterned, so have no home package. + (symbol-package (gensym)) => NIL + (make-package 'pk1) => # + (intern "SAMPLE1" "PK1") => PK1::SAMPLE1, NIL + (export (find-symbol "SAMPLE1" "PK1") "PK1") => T + (make-package 'pk2 :use '(pk1)) => # + (find-symbol "SAMPLE1" "PK2") => PK1:SAMPLE1, :INHERITED + (symbol-package 'pk1::sample1) => # + (symbol-package 'pk2::sample1) => # + (symbol-package 'pk1::sample2) => # + (symbol-package 'pk2::sample2) => # + ;; The next several forms create a scenario in which a symbol + ;; is not really uninterned, but is "apparently uninterned", + ;; and so SYMBOL-PACKAGE still returns NIL. + (setq s3 'pk1::sample3) => PK1::SAMPLE3 + (import s3 'pk2) => T + (unintern s3 'pk1) => T + (symbol-package s3) => NIL + (eq s3 'pk2::sample3) => T + +Affected By:: +............. + +import, intern, unintern + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + +See Also:: +.......... + +*note intern:: + + +File: gcl.info, Node: symbol-plist, Next: symbol-value, Prev: symbol-package, Up: Symbols Dictionary + +10.2.13 symbol-plist [Accessor] +------------------------------- + +'symbol-plist' symbol => plist + + (setf (' symbol-plist' symbol) new-plist) + +Arguments and Values:: +...................... + +symbol--a symbol. + + plist, new-plist--a property list. + +Description:: +............. + +Accesses the property list of symbol. + +Examples:: +.......... + + (setq sym (gensym)) => #:G9723 + (symbol-plist sym) => () + (setf (get sym 'prop1) 'val1) => VAL1 + (symbol-plist sym) => (PROP1 VAL1) + (setf (get sym 'prop2) 'val2) => VAL2 + (symbol-plist sym) => (PROP2 VAL2 PROP1 VAL1) + (setf (symbol-plist sym) (list 'prop3 'val3)) => (PROP3 VAL3) + (symbol-plist sym) => (PROP3 VAL3) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + +See Also:: +.......... + +*note get:: , *note remprop:: + +Notes:: +....... + +The use of setf should be avoided, since a symbol's property list is a +global resource that can contain information established and depended +upon by unrelated programs in the same Lisp image. + + +File: gcl.info, Node: symbol-value, Next: get, Prev: symbol-plist, Up: Symbols Dictionary + +10.2.14 symbol-value [Accessor] +------------------------------- + +'symbol-value' symbol => value + + (setf (' symbol-value' symbol) new-value) + +Arguments and Values:: +...................... + +symbol--a symbol that must have a value. + + value, new-value--an object. + +Description:: +............. + +Accesses the symbol's value cell. + +Examples:: +.......... + + (setf (symbol-value 'a) 1) => 1 + (symbol-value 'a) => 1 + ;; SYMBOL-VALUE cannot see lexical variables. + (let ((a 2)) (symbol-value 'a)) => 1 + (let ((a 2)) (setq a 3) (symbol-value 'a)) => 1 + ;; SYMBOL-VALUE can see dynamic variables. + (let ((a 2)) + (declare (special a)) + (symbol-value 'a)) => 2 + (let ((a 2)) + (declare (special a)) + (setq a 3) + (symbol-value 'a)) => 3 + (let ((a 2)) + (setf (symbol-value 'a) 3) + a) => 2 + a => 3 + (symbol-value 'a) => 3 + (let ((a 4)) + (declare (special a)) + (let ((b (symbol-value 'a))) + (setf (symbol-value 'a) 5) + (values a b))) => 5, 4 + a => 3 + (symbol-value :any-keyword) => :ANY-KEYWORD + (symbol-value 'nil) => NIL + (symbol-value '()) => NIL + ;; The precision of this next one is implementation-dependent. + (symbol-value 'pi) => 3.141592653589793d0 + +Affected By:: +............. + +makunbound, set, setq + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + + Should signal unbound-variable if symbol is unbound and an attempt is +made to read its value. (No such error is signaled on an attempt to +write its value.) + +See Also:: +.......... + +*note boundp:: , *note makunbound:: , *note set:: , *note setq:: + +Notes:: +....... + +symbol-value can be used to get the value of a constant variable. +symbol-value cannot access the value of a lexical variable. + + +File: gcl.info, Node: get, Next: remprop, Prev: symbol-value, Up: Symbols Dictionary + +10.2.15 get [Accessor] +---------------------- + +'get' symbol indicator &optional default => value + + (setf (' get' symbol indicator &optional default) new-value) + +Arguments and Values:: +...................... + +symbol--a symbol. + + indicator--an object. + + default--an object. The default is nil. + + value--if the indicated property exists, the object that is its +value; otherwise, the specified default. + + new-value--an object. + +Description:: +............. + +get finds a property on the property list_2 of symbol whose property +indicator is identical to indicator, and returns its corresponding +property value. + + If there are multiple properties_1 with that property indicator, get +uses the first such property. + + If there is no property with that property indicator, default is +returned. + + setf of get may be used to associate a new object with an existing +indicator already on the symbol's property list, or to create a new +assocation if none exists. + + If there are multiple properties_1 with that property indicator, setf +of get associates the new-value with the first such property. + + When a get form is used as a setf place, any default which is +supplied is evaluated according to normal left-to-right evaluation +rules, but its value is ignored. + +Examples:: +.......... + + (defun make-person (first-name last-name) + (let ((person (gensym "PERSON"))) + (setf (get person 'first-name) first-name) + (setf (get person 'last-name) last-name) + person)) => MAKE-PERSON + (defvar *john* (make-person "John" "Dow")) => *JOHN* + *john* => #:PERSON4603 + (defvar *sally* (make-person "Sally" "Jones")) => *SALLY* + (get *john* 'first-name) => "John" + (get *sally* 'last-name) => "Jones" + (defun marry (man woman married-name) + (setf (get man 'wife) woman) + (setf (get woman 'husband) man) + (setf (get man 'last-name) married-name) + (setf (get woman 'last-name) married-name) + married-name) => MARRY + (marry *john* *sally* "Dow-Jones") => "Dow-Jones" + (get *john* 'last-name) => "Dow-Jones" + (get (get *john* 'wife) 'first-name) => "Sally" + (symbol-plist *john*) + => (WIFE #:PERSON4604 LAST-NAME "Dow-Jones" FIRST-NAME "John") + (defmacro age (person &optional (default ''thirty-something)) + `(get ,person 'age ,default)) => AGE + (age *john*) => THIRTY-SOMETHING + (age *john* 20) => 20 + (setf (age *john*) 25) => 25 + (age *john*) => 25 + (age *john* 20) => 25 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + +See Also:: +.......... + +*note getf:: , *note symbol-plist:: , *note remprop:: + +Notes:: +....... + + (get x y) == (getf (symbol-plist x) y) + + Numbers and characters are not recommended for use as indicators in +portable code since get tests with eq rather than eql, and consequently +the effect of using such indicators is implementation-dependent. + + There is no way using get to distinguish an absent property from one +whose value is default. However, see get-properties. + + +File: gcl.info, Node: remprop, Next: boundp, Prev: get, Up: Symbols Dictionary + +10.2.16 remprop [Function] +-------------------------- + +'remprop' symbol indicator => generalized-boolean + +Arguments and Values:: +...................... + +symbol--a symbol. + + indicator--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +remprop removes from the property list_2 of symbol a property_1 with a +property indicator identical to indicator. + + If there are multiple properties_1 with the identical key, remprop +only removes the first such property. + + remprop returns false if no such property was found, or true if a +property was found. + + The property indicator and the corresponding property value are +removed in an undefined order by destructively splicing the property +list. + + The permissible side-effects correspond to those permitted for remf, +such that: + + (remprop x y) == (remf (symbol-plist x) y) + +Examples:: +.......... + + (setq test (make-symbol "PSEUDO-PI")) => #:PSEUDO-PI + (symbol-plist test) => () + (setf (get test 'constant) t) => T + (setf (get test 'approximation) 3.14) => 3.14 + (setf (get test 'error-range) 'noticeable) => NOTICEABLE + (symbol-plist test) + => (ERROR-RANGE NOTICEABLE APPROXIMATION 3.14 CONSTANT T) + (setf (get test 'approximation) nil) => NIL + (symbol-plist test) + => (ERROR-RANGE NOTICEABLE APPROXIMATION NIL CONSTANT T) + (get test 'approximation) => NIL + (remprop test 'approximation) => true + (get test 'approximation) => NIL + (symbol-plist test) + => (ERROR-RANGE NOTICEABLE CONSTANT T) + (remprop test 'approximation) => NIL + (symbol-plist test) + => (ERROR-RANGE NOTICEABLE CONSTANT T) + (remprop test 'error-range) => true + (setf (get test 'approximation) 3) => 3 + (symbol-plist test) + => (APPROXIMATION 3 CONSTANT T) + +Side Effects:: +.............. + +The property list of symbol is modified. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + +See Also:: +.......... + +*note remf:: , *note symbol-plist:: + +Notes:: +....... + +Numbers and characters are not recommended for use as indicators in +portable code since remprop tests with eq rather than eql, and +consequently the effect of using such indicators is +implementation-dependent. Of course, if you've gotten as far as needing +to remove such a property, you don't have much choice--the time to have +been thinking about this was when you used setf of get to establish the +property. + + +File: gcl.info, Node: boundp, Next: makunbound, Prev: remprop, Up: Symbols Dictionary + +10.2.17 boundp [Function] +------------------------- + +'boundp' symbol => generalized-boolean + +Arguments and Values:: +...................... + +symbol--a symbol. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if symbol is bound; otherwise, returns false. + +Examples:: +.......... + + (setq x 1) => 1 + (boundp 'x) => true + (makunbound 'x) => X + (boundp 'x) => false + (let ((x 2)) (boundp 'x)) => false + (let ((x 2)) (declare (special x)) (boundp 'x)) => true + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + +See Also:: +.......... + +*note set:: , *note setq:: , *note symbol-value:: , *note makunbound:: + +Notes:: +....... + +The function bound determines only whether a symbol has a value in the +global environment; any lexical bindings are ignored. + + +File: gcl.info, Node: makunbound, Next: set, Prev: boundp, Up: Symbols Dictionary + +10.2.18 makunbound [Function] +----------------------------- + +'makunbound' symbol => symbol + +Arguments and Values:: +...................... + +symbol--a symbol + +Description:: +............. + +Makes the symbol be unbound, regardless of whether it was previously +bound. + +Examples:: +.......... + + (setf (symbol-value 'a) 1) + (boundp 'a) => true + a => 1 + (makunbound 'a) => A + (boundp 'a) => false + +Side Effects:: +.............. + +The value cell of symbol is modified. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if symbol is not a symbol. + +See Also:: +.......... + +*note boundp:: , *note fmakunbound:: + + +File: gcl.info, Node: set, Next: unbound-variable, Prev: makunbound, Up: Symbols Dictionary + +10.2.19 set [Function] +---------------------- + +'set' symbol value => value + +Arguments and Values:: +...................... + +symbol--a symbol. + + value--an object. + +Description:: +............. + +set changes the contents of the value cell of symbol to the given value. + + (set symbol value) == (setf (symbol-value symbol) value) + +Examples:: +.......... + + (setf (symbol-value 'n) 1) => 1 + (set 'n 2) => 2 + (symbol-value 'n) => 2 + (let ((n 3)) + (declare (special n)) + (setq n (+ n 1)) + (setf (symbol-value 'n) (* n 10)) + (set 'n (+ (symbol-value 'n) n)) + n) => 80 + n => 2 + (let ((n 3)) + (setq n (+ n 1)) + (setf (symbol-value 'n) (* n 10)) + (set 'n (+ (symbol-value 'n) n)) + n) => 4 + n => 44 + (defvar *n* 2) + (let ((*n* 3)) + (setq *n* (+ *n* 1)) + (setf (symbol-value '*n*) (* *n* 10)) + (set '*n* (+ (symbol-value '*n*) *n*)) + *n*) => 80 + *n* => 2 + (defvar *even-count* 0) => *EVEN-COUNT* + (defvar *odd-count* 0) => *ODD-COUNT* + (defun tally-list (list) + (dolist (element list) + (set (if (evenp element) '*even-count* '*odd-count*) + (+ element (if (evenp element) *even-count* *odd-count*))))) + (tally-list '(1 9 4 3 2 7)) => NIL + *even-count* => 6 + *odd-count* => 20 + +Side Effects:: +.............. + +The value of symbol is changed. + +See Also:: +.......... + +*note setq:: , *note progv:: , *note symbol-value:: + +Notes:: +....... + +The function set is deprecated. + + set cannot change the value of a lexical variable. + + +File: gcl.info, Node: unbound-variable, Prev: set, Up: Symbols Dictionary + +10.2.20 unbound-variable [Condition Type] +----------------------------------------- + +Class Precedence List:: +....................... + +unbound-variable, cell-error, error, serious-condition, condition, t + +Description:: +............. + +The type unbound-variable consists of error conditions that represent +attempts to read the value of an unbound variable. + + The name of the cell (see cell-error) is the name of the variable +that was unbound. + +See Also:: +.......... + +*note cell-error-name:: + + +File: gcl.info, Node: Packages, Next: Numbers (Numbers), Prev: Symbols, Up: Top + +11 Packages +*********** + +* Menu: + +* Package Concepts:: +* Packages Dictionary:: + + +File: gcl.info, Node: Package Concepts, Next: Packages Dictionary, Prev: Packages, Up: Packages + +11.1 Package Concepts +===================== + +* Menu: + +* Introduction to Packages:: +* Standardized Packages:: + + +File: gcl.info, Node: Introduction to Packages, Next: Standardized Packages, Prev: Package Concepts, Up: Package Concepts + +11.1.1 Introduction to Packages +------------------------------- + +A package establishes a mapping from names to symbols. At any given +time, one package is current. The current package is the one that is +the value of *package*. When using the Lisp reader, it is possible to +refer to symbols in packages other than the current one through the use +of package prefixes in the printed representation of the symbol. + + Figure 11-1 lists some defined names that are applicable to packages. +Where an operator takes an argument that is either a symbol or a list of +symbols, an argument of nil is treated as an empty list of symbols. Any +package argument may be either a string, a symbol, or a package. If a +symbol is supplied, its name will be used as the package name. + + *modules* import provide + *package* in-package rename-package + defpackage intern require + do-all-symbols list-all-packages shadow + do-external-symbols make-package shadowing-import + do-symbols package-name unexport + export package-nicknames unintern + find-all-symbols package-shadowing-symbols unuse-package + find-package package-use-list use-package + find-symbol package-used-by-list + + Figure 11-1: Some Defined Names related to Packages + + +* Menu: + +* Package Names and Nicknames:: +* Symbols in a Package:: +* Internal and External Symbols:: +* Package Inheritance:: +* Accessibility of Symbols in a Package:: +* Locating a Symbol in a Package:: +* Prevention of Name Conflicts in Packages:: + + +File: gcl.info, Node: Package Names and Nicknames, Next: Symbols in a Package, Prev: Introduction to Packages, Up: Introduction to Packages + +11.1.1.1 Package Names and Nicknames +.................................... + +Each package has a name (a string) and perhaps some nicknames (also +strings). These are assigned when the package is created and can be +changed later. + + There is a single namespace for packages. The function find-package +translates a package name or nickname into the associated package. The +function package-name returns the name of a package. The function +package-nicknames returns a list of all nicknames for a package. +rename-package removes a package's current name and nicknames and +replaces them with new ones specified by the caller. + + +File: gcl.info, Node: Symbols in a Package, Next: Internal and External Symbols, Prev: Package Names and Nicknames, Up: Introduction to Packages + +11.1.1.2 Symbols in a Package +............................. + + +File: gcl.info, Node: Internal and External Symbols, Next: Package Inheritance, Prev: Symbols in a Package, Up: Introduction to Packages + +11.1.1.3 Internal and External Symbols +...................................... + +The mappings in a package are divided into two classes, external and +internal. The symbols targeted by these different mappings are called +external symbols and internal symbols of the package. Within a package, +a name refers to one symbol or to none; if it does refer to a symbol, +then it is either external or internal in that package, but not both. +External symbols + + are part of the package's public interface to other packages. +Symbols become external symbols of a given package if they have been +exported from that package. + + A symbol has the same name no matter what package it is present in, +but it might be an external symbol of some packages and an internal +symbol of others. + + +File: gcl.info, Node: Package Inheritance, Next: Accessibility of Symbols in a Package, Prev: Internal and External Symbols, Up: Introduction to Packages + +11.1.1.4 Package Inheritance +............................ + +Packages can be built up in layers. From one point of view, a package +is a single collection of mappings from strings into internal symbols +and external symbols. However, some of these mappings might be +established within the package itself, while other mappings are +inherited from other packages via use-package. A symbol is said to be +present in a package if the mapping is in the package itself and is not +inherited from somewhere else. + + There is no way to inherit the internal symbols of another package; +to refer to an internal symbol using the Lisp reader, a package +containing the symbol must be made to be the current package, a package +prefix must be used, or the symbol must be imported into the current +package. + + +File: gcl.info, Node: Accessibility of Symbols in a Package, Next: Locating a Symbol in a Package, Prev: Package Inheritance, Up: Introduction to Packages + +11.1.1.5 Accessibility of Symbols in a Package +.............................................. + +A symbol becomes accessible in a package if that is its home package +when it is created, or if it is imported into that package, or by +inheritance via use-package. + + If a symbol is accessible in a package, it can be referred to when +using the Lisp reader without a package prefix when that package is the +current package, regardless of whether it is present or inherited. + + Symbols from one package can be made accessible in another package in +two ways. + +- + Any individual symbol can be added to a package by use of import. + After the call to import the symbol is present in the importing + package. The status of the symbol in the package it came from (if + any) is unchanged, and the home package for this symbol is + unchanged. Once imported, a symbol is present in the importing + package and can be removed only by calling unintern. + + A symbol is shadowed_3 by another symbol in some package if the + first symbol would be accessible by inheritance if not for the + presence of the second symbol. See shadowing-import. + +- + The second mechanism for making symbols from one package accessible + in another is provided by use-package. All of the external symbols + of the used package are inherited by the using package. The + function unuse-package undoes the effects of a previous + use-package. + + +File: gcl.info, Node: Locating a Symbol in a Package, Next: Prevention of Name Conflicts in Packages, Prev: Accessibility of Symbols in a Package, Up: Introduction to Packages + +11.1.1.6 Locating a Symbol in a Package +....................................... + +When a symbol is to be located in a given package the following occurs: + +- + The external symbols and internal symbols of the package are + searched for the symbol. +- + The external symbols of the used packages are searched in some + unspecified order. The order does not matter; see the rules for + handling name conflicts listed below. + + +File: gcl.info, Node: Prevention of Name Conflicts in Packages, Prev: Locating a Symbol in a Package, Up: Introduction to Packages + +11.1.1.7 Prevention of Name Conflicts in Packages +................................................. + +Within one package, any particular name can refer to at most one symbol. +A name conflict is said to occur when there would be more than one +candidate symbol. Any time a name conflict is about to occur, a +correctable error is signaled. + + The following rules apply to name conflicts: + +- + Name conflicts are detected when they become possible, that is, + when the package structure is altered. Name conflicts are not + checked during every name lookup. + +- + If the same symbol is accessible to a package through more than one + path, there is no name conflict. A symbol cannot conflict with + itself. Name conflicts occur only between distinct symbols with + the same name (under string=). + +- + Every package has a list of shadowing symbols. A shadowing symbol + takes precedence over any other symbol of the same name that would + otherwise be accessible in the package. A name conflict involving + a shadowing symbol is always resolved in favor of the shadowing + symbol, without signaling an error (except for one exception + involving import). See shadow and shadowing-import. + +- + The functions use-package, import, and export check for name + conflicts. + +- + shadow and shadowing-import never signal a name-conflict error. + +- + unuse-package and unexport do not need to do any name-conflict + checking. unintern does name-conflict checking only when a symbol + being uninterned is a shadowing symbol . + +- + Giving a shadowing symbol to unintern can uncover a name conflict + that had previously been resolved by the shadowing. + +- + Package functions signal name-conflict errors of type package-error + before making any change to the package structure. When multiple + changes are to be made, it is permissible for the implementation to + process each change separately. For example, when export is given + a list of symbols, aborting from a name conflict caused by the + second symbol in the list might still export the first symbol in + the list. However, a name-conflict error caused by export of a + single symbol will be signaled before that symbol's accessibility + in any package is changed. + +- + Continuing from a name-conflict error must offer the user a chance + to resolve the name conflict in favor of either of the candidates. + The package structure should be altered to reflect the resolution + of the name conflict, via shadowing-import, unintern, or unexport. + +- + A name conflict in use-package between a symbol present in the + using package and an external symbol of the used package is + resolved in favor of the first symbol by making it a shadowing + symbol, or in favor of the second symbol by uninterning the first + symbol from the using package. + +- + A name conflict in export or unintern due to a package's inheriting + two distinct symbols with the same name (under string=) from two + other packages can be resolved in favor of either symbol by + importing it into the using package and making it a shadowing + symbol , just as with use-package. + + +File: gcl.info, Node: Standardized Packages, Prev: Introduction to Packages, Up: Package Concepts + +11.1.2 Standardized Packages +---------------------------- + +This section describes the packages that are available in every +conforming implementation. A summary of the names and nicknames of +those standardized packages is given in Figure 11-2. + + Name Nicknames + COMMON-LISP CL + COMMON-LISP-USER CL-USER + KEYWORD none + + Figure 11-2: Standardized Package Names + + +* Menu: + +* The COMMON-LISP Package:: +* Constraints on the COMMON-LISP Package for Conforming Implementations:: +* Constraints on the COMMON-LISP Package for Conforming Programs:: +* Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs:: +* The COMMON-LISP-USER Package:: +* The KEYWORD Package:: +* Interning a Symbol in the KEYWORD Package:: +* Notes about The KEYWORD Package:: +* Implementation-Defined Packages:: + + +File: gcl.info, Node: The COMMON-LISP Package, Next: Constraints on the COMMON-LISP Package for Conforming Implementations, Prev: Standardized Packages, Up: Standardized Packages + +11.1.2.1 The COMMON-LISP Package +................................ + +The COMMON-LISP package contains the primitives of the Common Lisp +system as defined by this specification. Its external symbols include +all of the defined names (except for defined names in the KEYWORD +package) that are present in the Common Lisp system, such as car, cdr, +*package*, etc. The COMMON-LISP package has the nickname CL. + + The COMMON-LISP package has as external symbols those symbols +enumerated in the figures in *note Symbols in the COMMON-LISP Package::, +and no others. These external symbols are present in the COMMON-LISP +package but their home package need not be the COMMON-LISP package. + + For example, the symbol HELP cannot be an external symbol of the +COMMON-LISP package because it is not mentioned in *note Symbols in the +COMMON-LISP Package::. In contrast, the symbol variable must be an +external symbol of the COMMON-LISP package even though it has no +definition because it is listed in that section (to support its use as a +valid second argument to the function documentation). + + The COMMON-LISP package can have additional internal symbols. + + +File: gcl.info, Node: Constraints on the COMMON-LISP Package for Conforming Implementations, Next: Constraints on the COMMON-LISP Package for Conforming Programs, Prev: The COMMON-LISP Package, Up: Standardized Packages + +11.1.2.2 Constraints on the COMMON-LISP Package for Conforming Implementations +.............................................................................. + +In a conforming implementation, an external symbol of the COMMON-LISP +package can have a function, macro, or special operator definition, a +global variable definition (or other status as a dynamic variable due to +a special proclamation), or a type definition only if explicitly +permitted in this standard. For example, fboundp yields false for any +external symbol of the COMMON-LISP package that is not the name of a +standardized function, macro or special operator, and boundp returns +false for any external symbol of the COMMON-LISP package that is not the +name of a standardized global variable. It also follows that conforming +programs can use external symbols of the COMMON-LISP package as the +names of local lexical variables with confidence that those names have +not been proclaimed special by the implementation unless those symbols +are names of standardized global variables. + + A conforming implementation must not place any property on an +external symbol of the COMMON-LISP package using a property indicator +that is either an external symbol of any standardized package or a +symbol that is otherwise accessible in the COMMON-LISP-USER package. + + +File: gcl.info, Node: Constraints on the COMMON-LISP Package for Conforming Programs, Next: Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs, Prev: Constraints on the COMMON-LISP Package for Conforming Implementations, Up: Standardized Packages + +11.1.2.3 Constraints on the COMMON-LISP Package for Conforming Programs +....................................................................... + +Except where explicitly allowed, the consequences are undefined if any +of the following actions are performed on an external symbol of the +COMMON-LISP package: + +1. + Binding or altering its value (lexically or dynamically). (Some + exceptions are noted below.) + +2. + Defining, + + undefining, + + or binding it as a function. (Some exceptions are noted below.) + +3. + Defining, + + undefining, + + or binding it as a macro + + or compiler macro. + + (Some exceptions are noted below.) + +4. + Defining it as a type specifier (via defstruct, defclass, deftype, + define-condition). + +5. + Defining it as a structure (via defstruct). + +6. + Defining it as a declaration with a declaration proclamation. + +7. + Defining it as a symbol macro. + +8. + Altering its home package. + +9. + Tracing it (via trace). + +10. + Declaring or proclaiming it special (via declare, + + declaim, + + or proclaim). + +11. + Declaring or proclaiming its type or ftype (via declare, + + declaim, + + or proclaim). (Some exceptions are noted below.) + +12. + Removing it from the COMMON-LISP package. + +13. + Defining a setf expander for it (via defsetf or + define-setf-method). + +14. + Defining, undefining, or binding its setf function name. + +15. + Defining it as a method combination type (via + define-method-combination). + +16. + Using it as the class-name argument to setf of find-class. + +17. + Binding it as a catch tag. + +18. + Binding it as a restart name. + +19. + Defining a method for a standardized generic function which is + applicable when all of the arguments are direct instances of + standardized classes. + + +File: gcl.info, Node: Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs, Next: The COMMON-LISP-USER Package, Prev: Constraints on the COMMON-LISP Package for Conforming Programs, Up: Standardized Packages + +11.1.2.4 Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs +.......................................................................................... + +If an external symbol of the COMMON-LISP package is not globally defined +as a standardized dynamic variable or constant variable, it is allowed +to lexically bind it and to declare the type of that binding, and it is +allowed to locally establish it as a symbol macro (e.g., with +symbol-macrolet). + + Unless explicitly specified otherwise, if an external symbol of the +COMMON-LISP package is globally defined as a standardized dynamic +variable, it is permitted to bind or assign that dynamic variable +provided that the "Value Type" constraints on the dynamic variable are +maintained, and that the new value of the variable is consistent with +the stated purpose of the variable. + + If an external symbol of the COMMON-LISP package is not defined as a +standardized function, macro, or special operator, it is allowed to +lexically bind it as a function (e.g., with flet), to declare the ftype +of that binding, and (in implementations which provide the ability to do +so) to trace that binding. + + If an external symbol of the COMMON-LISP package is not defined as a +standardized function, macro, or special operator, it is allowed to +lexically bind it as a macro (e.g., with macrolet). + + If an external symbol of the COMMON-LISP package is not defined as a +standardized function, macro, or special operator, it is allowed to +lexically bind its setf function name as a function, and to declare the +ftype of that binding. + + +File: gcl.info, Node: The COMMON-LISP-USER Package, Next: The KEYWORD Package, Prev: Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs, Up: Standardized Packages + +11.1.2.5 The COMMON-LISP-USER Package +..................................... + +The COMMON-LISP-USER package is the current package when a Common Lisp +system starts up. This package uses the COMMON-LISP package. The +COMMON-LISP-USER package has the nickname CL-USER. + + The COMMON-LISP-USER package can have additional symbols interned +within it; it can use other implementation-defined packages. + + +File: gcl.info, Node: The KEYWORD Package, Next: Interning a Symbol in the KEYWORD Package, Prev: The COMMON-LISP-USER Package, Up: Standardized Packages + +11.1.2.6 The KEYWORD Package +............................ + +The KEYWORD package contains symbols, called keywords_1, that are +typically used as special markers in programs and their associated data +expressions_1. + + Symbol tokens that start with a package marker are parsed by the Lisp +reader as symbols in the KEYWORD package; see *note Symbols as Tokens::. +This makes it notationally convenient to use keywords when communicating +between programs in different packages. For example, the mechanism for +passing keyword parameters in a call uses keywords_1 to name the +corresponding arguments; see *note Ordinary Lambda Lists::. + + Symbols in the KEYWORD package are, by definition, of type keyword. + + +File: gcl.info, Node: Interning a Symbol in the KEYWORD Package, Next: Notes about The KEYWORD Package, Prev: The KEYWORD Package, Up: Standardized Packages + +11.1.2.7 Interning a Symbol in the KEYWORD Package +.................................................. + +The KEYWORD package is treated differently than other packages in that +special actions are taken when a symbol is interned in it. In +particular, when a symbol is interned in the KEYWORD package, it is +automatically made to be an external symbol and is automatically made to +be a constant variable with itself as a value. + + +File: gcl.info, Node: Notes about The KEYWORD Package, Next: Implementation-Defined Packages, Prev: Interning a Symbol in the KEYWORD Package, Up: Standardized Packages + +11.1.2.8 Notes about The KEYWORD Package +........................................ + +It is generally best to confine the use of keywords to situations in +which there are a finitely enumerable set of names to be selected +between. For example, if there were two states of a light switch, they +might be called :on and :off. + + In situations where the set of names is not finitely enumerable +(i.e., where name conflicts might arise) it is frequently best to use +symbols in some package other than KEYWORD so that conflicts will be +naturally avoided. For example, it is generally not wise for a program +to use a keyword_1 as a property indicator, since if there were ever +another program that did the same thing, each would clobber the other's +data. + + +File: gcl.info, Node: Implementation-Defined Packages, Prev: Notes about The KEYWORD Package, Up: Standardized Packages + +11.1.2.9 Implementation-Defined Packages +........................................ + +Other, implementation-defined packages might be present in the initial +Common Lisp environment. + + It is recommended, but not required, that the documentation for a +conforming implementation contain a full list of all package names +initially present in that implementation but not specified in this +specification. (See also the function list-all-packages.) + + +File: gcl.info, Node: Packages Dictionary, Prev: Package Concepts, Up: Packages + +11.2 Packages Dictionary +======================== + +* Menu: + +* package:: +* export:: +* find-symbol:: +* find-package:: +* find-all-symbols:: +* import:: +* list-all-packages:: +* rename-package:: +* shadow:: +* shadowing-import:: +* delete-package:: +* make-package:: +* with-package-iterator:: +* unexport:: +* unintern:: +* in-package:: +* unuse-package:: +* use-package:: +* defpackage:: +* do-symbols:: +* intern:: +* package-name:: +* package-nicknames:: +* package-shadowing-symbols:: +* package-use-list:: +* package-used-by-list:: +* packagep:: +* *package*:: +* package-error:: +* package-error-package:: + + +File: gcl.info, Node: package, Next: export, Prev: Packages Dictionary, Up: Packages Dictionary + +11.2.1 package [System Class] +----------------------------- + +Class Precedence List:: +....................... + +package, t + +Description:: +............. + +A package is a namespace that maps symbol names to symbols; see *note +Package Concepts::. + +See Also:: +.......... + +*note Package Concepts::, *note Printing Other Objects::, *note Symbols +as Tokens:: + + +File: gcl.info, Node: export, Next: find-symbol, Prev: package, Up: Packages Dictionary + +11.2.2 export [Function] +------------------------ + +'export' symbols &optional package => t + +Arguments and Values:: +...................... + +symbols--a designator for a list of symbols. + + package--a package designator. + + The default is the current package. + +Description:: +............. + +export makes one or more symbols that are accessible in package (whether +directly or by inheritance) be external symbols of that package. + + If any of the symbols is already accessible as an external symbol of +package, export has no effect on that symbol. If the symbol is present +in package as an internal symbol, it is simply changed to external +status. If it is accessible as an internal symbol via use-package, it +is first imported into package, then exported. (The symbol is then +present in the package whether or not package continues to use the +package through which the symbol was originally inherited.) + + export makes each symbol accessible to all the packages that use +package. All of these packages are checked for name conflicts: (export +s p) does (find-symbol (symbol-name s) q) for each package q in +(package-used-by-list p). Note that in the usual case of an export +during the initial definition of a package, the result of +package-used-by-list is nil and the name-conflict checking takes +negligible time. When multiple changes are to be made, for example when +export is given a list of symbols, it is permissible for the +implementation to process each change separately, so that aborting from +a name conflict caused by any but the first symbol in the list does not +unexport the first symbol in the list. However, aborting from a +name-conflict error caused by export of one of symbols does not leave +that symbol accessible to some packages and inaccessible to others; with +respect to each of symbols processed, export behaves as if it were as an +atomic operation. + + A name conflict in export between one of symbols being exported and a +symbol already present in a package that would inherit the +newly-exported symbol may be resolved in favor of the exported symbol by +uninterning the other one, or in favor of the already-present symbol by +making it a shadowing symbol. + +Examples:: +.......... + + (make-package 'temp :use nil) => # + (use-package 'temp) => T + (intern "TEMP-SYM" 'temp) => TEMP::TEMP-SYM, NIL + (find-symbol "TEMP-SYM") => NIL, NIL + (export (find-symbol "TEMP-SYM" 'temp) 'temp) => T + (find-symbol "TEMP-SYM") => TEMP-SYM, :INHERITED + +Side Effects:: +.............. + +The package system is modified. + +Affected By:: +............. + +Accessible symbols. + +Exceptional Situations:: +........................ + +If any of the symbols is not accessible at all in package, an error of +type package-error is signaled that is correctable by permitting the +user to interactively specify whether that symbol should be imported. + +See Also:: +.......... + +*note import:: , *note unexport:: , *note Package Concepts:: + + +File: gcl.info, Node: find-symbol, Next: find-package, Prev: export, Up: Packages Dictionary + +11.2.3 find-symbol [Function] +----------------------------- + +'find-symbol' string &optional package => symbol, status + +Arguments and Values:: +...................... + +string--a string. + + package--a package designator. + + The default is the current package. + + symbol--a symbol accessible in the package, or nil. + + status--one of :inherited, :external, :internal, or nil. + +Description:: +............. + +find-symbol locates a symbol whose name is string in a package. If a +symbol named string is found in package, directly or by inheritance, the +symbol found is returned as the first value; the second value is as +follows: + +:internal + If the symbol is present in package as an internal symbol. + +:external + If the symbol is present in package as an external symbol. + +:inherited + If the symbol is inherited by package through use-package, but is + not present in package. + + If no such symbol is accessible in package, both values are nil. + +Examples:: +.......... + + (find-symbol "NEVER-BEFORE-USED") => NIL, NIL + (find-symbol "NEVER-BEFORE-USED") => NIL, NIL + (intern "NEVER-BEFORE-USED") => NEVER-BEFORE-USED, NIL + (intern "NEVER-BEFORE-USED") => NEVER-BEFORE-USED, :INTERNAL + (find-symbol "NEVER-BEFORE-USED") => NEVER-BEFORE-USED, :INTERNAL + (find-symbol "never-before-used") => NIL, NIL + (find-symbol "CAR" 'common-lisp-user) => CAR, :INHERITED + (find-symbol "CAR" 'common-lisp) => CAR, :EXTERNAL + (find-symbol "NIL" 'common-lisp-user) => NIL, :INHERITED + (find-symbol "NIL" 'common-lisp) => NIL, :EXTERNAL + (find-symbol "NIL" (prog1 (make-package "JUST-TESTING" :use '()) + (intern "NIL" "JUST-TESTING"))) + => JUST-TESTING::NIL, :INTERNAL + (export 'just-testing::nil 'just-testing) + (find-symbol "NIL" 'just-testing) => JUST-TESTING:NIL, :EXTERNAL + (find-symbol "NIL" "KEYWORD") + => NIL, NIL + OR=> :NIL, :EXTERNAL + (find-symbol (symbol-name :nil) "KEYWORD") => :NIL, :EXTERNAL + +Affected By:: +............. + +intern, import, export, use-package, unintern, unexport, unuse-package + +See Also:: +.......... + +*note intern:: , *note find-all-symbols:: + +Notes:: +....... + +find-symbol is operationally equivalent to intern, except that it never +creates a new symbol. + + +File: gcl.info, Node: find-package, Next: find-all-symbols, Prev: find-symbol, Up: Packages Dictionary + +11.2.4 find-package [Function] +------------------------------ + +'find-package' name => package + +Arguments and Values:: +...................... + +name--a string designator or a package object. + + package--a package object or nil. + +Description:: +............. + +If name is a string designator, find-package locates and returns the +package whose name or nickname is name. This search is case sensitive. +If there is no such package, find-package returns nil. + + If name is a package object, that package object is returned. + +Examples:: +.......... + + (find-package 'common-lisp) => # + (find-package "COMMON-LISP-USER") => # + (find-package 'not-there) => NIL + +Affected By:: +............. + +The set of packages created by the implementation. + + defpackage, delete-package, make-package, rename-package + +See Also:: +.......... + +*note make-package:: + + +File: gcl.info, Node: find-all-symbols, Next: import, Prev: find-package, Up: Packages Dictionary + +11.2.5 find-all-symbols [Function] +---------------------------------- + +'find-all-symbols' string => symbols + +Arguments and Values:: +...................... + +string--a string designator. + + symbols--a list of symbols. + +Description:: +............. + +find-all-symbols searches every registered package for symbols that have +a name that is the same (under string=) as string. A list of all such +symbols is returned. Whether or how the list is ordered is +implementation-dependent. + +Examples:: +.......... + + (find-all-symbols 'car) + => (CAR) + OR=> (CAR VEHICLES:CAR) + OR=> (VEHICLES:CAR CAR) + (intern "CAR" (make-package 'temp :use nil)) => TEMP::CAR, NIL + (find-all-symbols 'car) + => (TEMP::CAR CAR) + OR=> (CAR TEMP::CAR) + OR=> (TEMP::CAR CAR VEHICLES:CAR) + OR=> (CAR TEMP::CAR VEHICLES:CAR) + +See Also:: +.......... + +*note find-symbol:: + + +File: gcl.info, Node: import, Next: list-all-packages, Prev: find-all-symbols, Up: Packages Dictionary + +11.2.6 import [Function] +------------------------ + +'import' symbols &optional package => t + +Arguments and Values:: +...................... + +symbols--a designator for a list of symbols. + + package--a package designator. + + The default is the current package. + +Description:: +............. + +import adds symbol or symbols to the internals of package, checking for +name conflicts with existing symbols either present in package or +accessible to it. Once the symbols have been imported, they may be +referenced in the importing package without the use of a package prefix +when using the Lisp reader. + + A name conflict in import between the symbol being imported and a +symbol inherited from some other package can be resolved in favor of the +symbol being imported by making it a shadowing symbol, or in favor of +the symbol already accessible by not doing the import. A name conflict +in import with a symbol already present in the package may be resolved +by uninterning that symbol, or by not doing the import. + + The imported symbol is not automatically exported from the current +package, but if it is already present and external, then the fact that +it is external is not changed. + + If any symbol to be imported has no home package (i.e., +(symbol-package symbol) => nil), import sets the home package of the +symbol to package. + + If the symbol is already present in the importing package, import has +no effect. + +Examples:: +.......... + + (import 'common-lisp::car (make-package 'temp :use nil)) => T + (find-symbol "CAR" 'temp) => CAR, :INTERNAL + (find-symbol "CDR" 'temp) => NIL, NIL + + The form (import 'editor:buffer) takes the external symbol named +buffer in the EDITOR package (this symbol was located when the form was +read by the Lisp reader) and adds it to the current package as an +internal symbol. The symbol buffer is then present in the current +package. + +Side Effects:: +.............. + +The package system is modified. + +Affected By:: +............. + +Current state of the package system. + +Exceptional Situations:: +........................ + +import signals a correctable error of type package-error if any of the +symbols to be imported has the same name (under string=) as some +distinct symbol (under eql) already accessible in the package, even if +the conflict is with a shadowing symbol of the package. + +See Also:: +.......... + +*note shadow:: , *note export:: + + +File: gcl.info, Node: list-all-packages, Next: rename-package, Prev: import, Up: Packages Dictionary + +11.2.7 list-all-packages [Function] +----------------------------------- + +'list-all-packages' => packages + +Arguments and Values:: +...................... + +packages--a list of package objects. + +Description:: +............. + +list-all-packages returns a + + fresh + + list of + + all registered packages. + +Examples:: +.......... + + (let ((before (list-all-packages))) + (make-package 'temp) + (set-difference (list-all-packages) before)) => (#) + +Affected By:: +............. + +defpackage, delete-package, make-package + + +File: gcl.info, Node: rename-package, Next: shadow, Prev: list-all-packages, Up: Packages Dictionary + +11.2.8 rename-package [Function] +-------------------------------- + +'rename-package' package new-name &optional new-nicknames => +package-object + +Arguments and Values:: +...................... + +package--a package designator. + + new-name--a package designator. + + new-nicknames--a list of string designators. The default is the +empty list. + + package-object--the renamed package object. + +Description:: +............. + +Replaces the name and nicknames of package. The old name and all of the +old nicknames of package are eliminated and are replaced by new-name and +new-nicknames. + + The consequences are undefined if new-name or any new-nickname +conflicts with any existing package names. + +Examples:: +.......... + + (make-package 'temporary :nicknames '("TEMP")) => # + (rename-package 'temp 'ephemeral) => # + (package-nicknames (find-package 'ephemeral)) => () + (find-package 'temporary) => NIL + (rename-package 'ephemeral 'temporary '(temp fleeting)) + => # + (package-nicknames (find-package 'temp)) => ("TEMP" "FLEETING") + +See Also:: +.......... + +*note make-package:: + + +File: gcl.info, Node: shadow, Next: shadowing-import, Prev: rename-package, Up: Packages Dictionary + +11.2.9 shadow [Function] +------------------------ + +'shadow' symbol-names &optional package => t + +Arguments and Values:: +...................... + +symbol-names--a designator for a list of string designators. + + package--a package designator. + + The default is the current package. + +Description:: +............. + +shadow assures that symbols with names given by symbol-names are present +in the package. + + Specifically, package is searched for symbols with the names supplied +by symbol-names. + + For each such name, if a corresponding symbol is not present in +package (directly, not by inheritance), then a corresponding symbol is +created with that name, and inserted into package as an internal symbol. +The corresponding symbol, whether pre-existing or newly created, is then +added, if not already present, to the shadowing symbols list of package. + +Examples:: +.......... + + (package-shadowing-symbols (make-package 'temp)) => NIL + (find-symbol 'car 'temp) => CAR, :INHERITED + (shadow 'car 'temp) => T + (find-symbol 'car 'temp) => TEMP::CAR, :INTERNAL + (package-shadowing-symbols 'temp) => (TEMP::CAR) + + (make-package 'test-1) => # + (intern "TEST" (find-package 'test-1)) => TEST-1::TEST, NIL + (shadow 'test-1::test (find-package 'test-1)) => T + (shadow 'TEST (find-package 'test-1)) => T + (assert (not (null (member 'test-1::test (package-shadowing-symbols + (find-package 'test-1)))))) + + (make-package 'test-2) => # + (intern "TEST" (find-package 'test-2)) => TEST-2::TEST, NIL + (export 'test-2::test (find-package 'test-2)) => T + (use-package 'test-2 (find-package 'test-1)) ;should not error + + +Side Effects:: +.............. + +shadow changes the state of the package system in such a way that the +package consistency rules do not hold across the change. + +Affected By:: +............. + +Current state of the package system. + +See Also:: +.......... + +*note package-shadowing-symbols:: , *note Package Concepts:: + +Notes:: +....... + +If a symbol with a name in symbol-names already exists in package, but +by inheritance, the inherited symbol becomes shadowed_3 by a newly +created internal symbol. + + +File: gcl.info, Node: shadowing-import, Next: delete-package, Prev: shadow, Up: Packages Dictionary + +11.2.10 shadowing-import [Function] +----------------------------------- + +'shadowing-import' symbols &optional package => t + +Arguments and Values:: +...................... + +symbols--a designator for a list of symbols. + + package --a package designator. + + The default is the current package. + +Description:: +............. + +shadowing-import is like import, but it does not signal an error even if +the importation of a symbol would shadow some symbol already accessible +in package. + + shadowing-import inserts each of symbols into package as an internal +symbol, regardless of whether another symbol of the same name is +shadowed by this action. If a different symbol of the same name is +already present in package, that symbol is first uninterned from +package. The new symbol is added to package's shadowing-symbols list. + + shadowing-import does name-conflict checking to the extent that it +checks whether a distinct existing symbol with the same name is +accessible; if so, it is shadowed by the new symbol, which implies that +it must be uninterned if it was present in package. + +Examples:: +.......... + + (in-package "COMMON-LISP-USER") => # + (setq sym (intern "CONFLICT")) => CONFLICT + (intern "CONFLICT" (make-package 'temp)) => TEMP::CONFLICT, NIL + (package-shadowing-symbols 'temp) => NIL + (shadowing-import sym 'temp) => T + (package-shadowing-symbols 'temp) => (CONFLICT) + +Side Effects:: +.............. + +shadowing-import changes the state of the package system in such a way +that the consistency rules do not hold across the change. + + package's shadowing-symbols list is modified. + +Affected By:: +............. + +Current state of the package system. + +See Also:: +.......... + +*note import:: , *note unintern:: , *note package-shadowing-symbols:: + + +File: gcl.info, Node: delete-package, Next: make-package, Prev: shadowing-import, Up: Packages Dictionary + +11.2.11 delete-package [Function] +--------------------------------- + +'delete-package' package => generalized-boolean + +Arguments and Values:: +...................... + +package--a package designator. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +delete-package deletes package from all package system data structures. +If the operation is successful, delete-package returns true, otherwise +nil. The effect of delete-package is that the name and nicknames of +package cease to be recognized package names. The package object is +still a package (i.e., packagep is true of it) but package-name returns +nil. The consequences of deleting the COMMON-LISP package or the +KEYWORD package are undefined. The consequences of invoking any other +package operation on package once it has been deleted are unspecified. +In particular, the consequences of invoking find-symbol, intern and +other functions that look for a symbol name in a package are unspecified +if they are called with *package* bound to the deleted package or with +the deleted package as an argument. + + If package is a package object that has already been deleted, +delete-package immediately returns nil. + + After this operation completes, the home package of any symbol whose +home package had previously been package is implementation-dependent. +Except for this, symbols accessible in package are not modified in any +other way; symbols whose home package is not package remain unchanged. + +Examples:: +.......... + + (setq *foo-package* (make-package "FOO" :use nil)) + (setq *foo-symbol* (intern "FOO" *foo-package*)) + (export *foo-symbol* *foo-package*) + + (setq *bar-package* (make-package "BAR" :use '("FOO"))) + (setq *bar-symbol* (intern "BAR" *bar-package*)) + (export *foo-symbol* *bar-package*) + (export *bar-symbol* *bar-package*) + + (setq *baz-package* (make-package "BAZ" :use '("BAR"))) + + (symbol-package *foo-symbol*) => # + (symbol-package *bar-symbol*) => # + + (prin1-to-string *foo-symbol*) => "FOO:FOO" + (prin1-to-string *bar-symbol*) => "BAR:BAR" + + (find-symbol "FOO" *bar-package*) => FOO:FOO, :EXTERNAL + + (find-symbol "FOO" *baz-package*) => FOO:FOO, :INHERITED + (find-symbol "BAR" *baz-package*) => BAR:BAR, :INHERITED + + (packagep *foo-package*) => true + (packagep *bar-package*) => true + (packagep *baz-package*) => true + + (package-name *foo-package*) => "FOO" + (package-name *bar-package*) => "BAR" + (package-name *baz-package*) => "BAZ" + + (package-use-list *foo-package*) => () + (package-use-list *bar-package*) => (#) + (package-use-list *baz-package*) => (#) + + (package-used-by-list *foo-package*) => (#) + (package-used-by-list *bar-package*) => (#) + (package-used-by-list *baz-package*) => () + + (delete-package *bar-package*) + |> Error: Package BAZ uses package BAR. + |> If continued, BAZ will be made to unuse-package BAR, + |> and then BAR will be deleted. + |> Type :CONTINUE to continue. + |> Debug> |>>:CONTINUE<<| + => T + + (symbol-package *foo-symbol*) => # + (symbol-package *bar-symbol*) is unspecified + + (prin1-to-string *foo-symbol*) => "FOO:FOO" + (prin1-to-string *bar-symbol*) is unspecified + + (find-symbol "FOO" *bar-package*) is unspecified + + (find-symbol "FOO" *baz-package*) => NIL, NIL + (find-symbol "BAR" *baz-package*) => NIL, NIL + + (packagep *foo-package*) => T + (packagep *bar-package*) => T + (packagep *baz-package*) => T + + (package-name *foo-package*) => "FOO" + (package-name *bar-package*) => NIL + (package-name *baz-package*) => "BAZ" + + (package-use-list *foo-package*) => () + (package-use-list *bar-package*) is unspecified + (package-use-list *baz-package*) => () + + (package-used-by-list *foo-package*) => () + (package-used-by-list *bar-package*) is unspecified + (package-used-by-list *baz-package*) => () + +Exceptional Situations:: +........................ + +If the package designator is a name that does not currently name a +package, a correctable error of type package-error is signaled. If +correction is attempted, no deletion action is attempted; instead, +delete-package immediately returns nil. + + If package is used by other packages, a correctable error of type +package-error is signaled. If correction is attempted, unuse-package is +effectively called to remove any dependencies, causing package's +external symbols to cease being accessible to those packages that use +package. delete-package then deletes package just as it would have had +there been no packages that used it. + +See Also:: +.......... + +*note unuse-package:: + + +File: gcl.info, Node: make-package, Next: with-package-iterator, Prev: delete-package, Up: Packages Dictionary + +11.2.12 make-package [Function] +------------------------------- + +'make-package' package-name &key nicknames use => package + +Arguments and Values:: +...................... + +package-name--a string designator. + + nicknames--a list of string designators. The default is the empty +list. + + use-- a list of package designators. + + The default is implementation-defined. + + package--a package. + +Description:: +............. + +Creates a new package with the name package-name. + + Nicknames are additional names which may be used to refer to the new +package. + + use specifies zero or more packages the external symbols of which are +to be inherited by the new package. See the function use-package. + +Examples:: +.......... + + (make-package 'temporary :nicknames '("TEMP" "temp")) => # + (make-package "OWNER" :use '("temp")) => # + (package-used-by-list 'temp) => (#) + (package-use-list 'owner) => (#) + +Affected By:: +............. + +The existence of other packages in the system. + +Exceptional Situations:: +........................ + +The consequences are unspecified if packages denoted by use do not +exist. + + A correctable error is signaled if the package-name or any of the +nicknames is already the name or nickname of an existing package. + +See Also:: +.......... + +*note defpackage:: , *note use-package:: + +Notes:: +....... + +In situations where the packages to be used contain symbols which would +conflict, it is necessary to first create the package with :use '(), +then to use shadow or shadowing-import to address the conflicts, and +then after that to use use-package once the conflicts have been +addressed. + + When packages are being created as part of the static definition of a +program rather than dynamically by the program, it is generally +considered more stylistically appropriate to use defpackage rather than +make-package. + + +File: gcl.info, Node: with-package-iterator, Next: unexport, Prev: make-package, Up: Packages Dictionary + +11.2.13 with-package-iterator [Macro] +------------------------------------- + +'with-package-iterator' (name package-list-form &rest symbol-types) +{declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +name--a symbol. + + package-list-form--a form; evaluated once to produce a package-list. + + package-list--a designator for a list of package designators. + + symbol-type--one of the symbols :internal, :external, or :inherited. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values of the forms. + +Description:: +............. + +Within the lexical scope of the body forms, the name is defined via +macrolet such that successive invocations of (name) will return the +symbols, one by one, from the packages in package-list. + + It is unspecified whether symbols inherited from multiple packages +are returned more than once. The order of symbols returned does not +necessarily reflect the order of packages in package-list. When +package-list has more than one element, it is unspecified whether +duplicate symbols are returned once or more than once. + + Symbol-types controls which symbols that are accessible in a package +are returned as follows: + +:internal + The symbols that are present in the package, but that are not + exported. + +:external + The symbols that are present in the package and are exported. + +:inherited + The symbols that are exported by used packages and that are not + shadowed. + + When more than one argument is supplied for symbol-types, a symbol is +returned if its accessibility matches any one of the symbol-types +supplied. Implementations may extend this syntax by recognizing +additional symbol accessibility types. + + An invocation of (name) returns four values as follows: + +1. + A flag that indicates whether a symbol is returned (true means that + a symbol is returned). +2. + A symbol that is accessible in one the indicated packages. +3. + The accessibility type for that symbol; i.e., one of the symbols + :internal, :external, or :inherited. +4. + The package from which the symbol was obtained. The package is one + of the packages present or named in package-list. + + After all symbols have been returned by successive invocations of +(name), then only one value is returned, namely nil. + + The meaning of the second, third, and fourth values is that the +returned symbol is accessible in the returned package in the way +indicated by the second return value as follows: + +:internal + Means present and not exported. + +:external + Means present and exported. + +:inherited + Means not present (thus not shadowed) but inherited from some used + package. + + It is unspecified what happens if any of the implicit interior state +of an iteration is returned outside the dynamic extent of the +with-package-iterator form such as by returning some closure over the +invocation form. + + Any number of invocations of with-package-iterator can be nested, and +the body of the innermost one can invoke all of the locally established +macros, provided all those macros have distinct names. + +Examples:: +.......... + +The following function should return t on any package, and signal an +error if the usage of with-package-iterator does not agree with the +corresponding usage of do-symbols. + + (defun test-package-iterator (package) + (unless (packagep package) + (setq package (find-package package))) + (let ((all-entries '()) + (generated-entries '())) + (do-symbols (x package) + (multiple-value-bind (symbol accessibility) + (find-symbol (symbol-name x) package) + (push (list symbol accessibility) all-entries))) + (with-package-iterator (generator-fn package + :internal :external :inherited) + (loop + (multiple-value-bind (more? symbol accessibility pkg) + (generator-fn) + (unless more? (return)) + (let ((l (multiple-value-list (find-symbol (symbol-name symbol) + package)))) + (unless (equal l (list symbol accessibility)) + (error "Symbol ~S not found as ~S in package ~A [~S]" + symbol accessibility (package-name package) l)) + (push l generated-entries))))) + (unless (and (subsetp all-entries generated-entries :test #'equal) + (subsetp generated-entries all-entries :test #'equal)) + (error "Generated entries and Do-Symbols entries don't correspond")) + t)) + + The following function prints out every present symbol (possibly more +than once): + + (defun print-all-symbols () + (with-package-iterator (next-symbol (list-all-packages) + :internal :external) + (loop + (multiple-value-bind (more? symbol) (next-symbol) + (if more? + (print symbol) + (return)))))) + +Exceptional Situations:: +........................ + +with-package-iterator signals an error of type program-error if no +symbol-types are supplied or if a symbol-type is not recognized by the +implementation is supplied. + + The consequences are undefined if the local function named name +established by with-package-iterator is called after it has returned +false as its primary value. + +See Also:: +.......... + +*note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: unexport, Next: unintern, Prev: with-package-iterator, Up: Packages Dictionary + +11.2.14 unexport [Function] +--------------------------- + +'unexport' symbols &optional package => t + +Arguments and Values:: +...................... + +symbols--a designator for a list of symbols. + + package--a package designator. + + The default is the current package. + +Description:: +............. + +unexport reverts external symbols in package to internal status; it +undoes the effect of export. + + unexport works only on symbols present in package, switching them +back to internal status. If unexport is given a symbol that is already +accessible as an internal symbol in package, it does nothing. + +Examples:: +.......... + + (in-package "COMMON-LISP-USER") => # + (export (intern "CONTRABAND" (make-package 'temp)) 'temp) => T + (find-symbol "CONTRABAND") => NIL, NIL + (use-package 'temp) => T + (find-symbol "CONTRABAND") => CONTRABAND, :INHERITED + (unexport 'contraband 'temp) => T + (find-symbol "CONTRABAND") => NIL, NIL + +Side Effects:: +.............. + +Package system is modified. + +Affected By:: +............. + +Current state of the package system. + +Exceptional Situations:: +........................ + +If unexport is given a symbol not accessible in package at all, an error +of type package-error is signaled. + + The consequences are undefined if package is the KEYWORD package or +the COMMON-LISP package. + +See Also:: +.......... + +*note export:: , *note Package Concepts:: + + +File: gcl.info, Node: unintern, Next: in-package, Prev: unexport, Up: Packages Dictionary + +11.2.15 unintern [Function] +--------------------------- + +'unintern' symbol &optional package => generalized-boolean + +Arguments and Values:: +...................... + +symbol--a symbol. + + package--a package designator. + + The default is the current package. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +unintern removes symbol from package. If symbol is present in package, +it is removed from package and also from package's shadowing symbols +list if it is present there. If package is the home package for symbol, +symbol is made to have no home package. Symbol may continue to be +accessible in package by inheritance. + + Use of unintern can result in a symbol that has no recorded home +package, but that in fact is accessible in some package. Common Lisp +does not check for this pathological case, and such symbols are always +printed preceded by #:. + + unintern returns true if it removes symbol, and nil otherwise. + +Examples:: +.......... + + (in-package "COMMON-LISP-USER") => # + (setq temps-unpack (intern "UNPACK" (make-package 'temp))) => TEMP::UNPACK + (unintern temps-unpack 'temp) => T + (find-symbol "UNPACK" 'temp) => NIL, NIL + temps-unpack => #:UNPACK + +Side Effects:: +.............. + +unintern changes the state of the package system in such a way that the +consistency rules do not hold across the change. + +Affected By:: +............. + +Current state of the package system. + +Exceptional Situations:: +........................ + +Giving a shadowing symbol to unintern can uncover a name conflict that +had previously been resolved by the shadowing. If package A uses +packages B and C, A contains a shadowing symbol x, and B and C each +contain external symbols named x, then removing the shadowing symbol x +from A will reveal a name conflict between b:x and c:x if those two +symbols are distinct. In this case unintern will signal an error. + +See Also:: +.......... + +*note Package Concepts:: + + +File: gcl.info, Node: in-package, Next: unuse-package, Prev: unintern, Up: Packages Dictionary + +11.2.16 in-package [Macro] +-------------------------- + +'in-package' name => package + +Arguments and Values:: +...................... + +name--a string designator; not evaluated. + + package--the package named by name. + +Description:: +............. + +Causes the the package named by name to become the current package--that +is, the value of *package*. If no such package already exists, an error +of type package-error is signaled. + + Everything in-package does is also performed at compile time if the +call appears as a top level form. + +Side Effects:: +.............. + +The variable *package* is assigned. If the in-package form is a top +level form, this assignment also occurs at compile time. + +Exceptional Situations:: +........................ + +An error of type package-error is signaled if the specified package does +not exist. + +See Also:: +.......... + +*note package:: + + +File: gcl.info, Node: unuse-package, Next: use-package, Prev: in-package, Up: Packages Dictionary + +11.2.17 unuse-package [Function] +-------------------------------- + +'unuse-package' packages-to-unuse &optional package => t + +Arguments and Values:: +...................... + +packages-to-unuse--a designator for a list of package designators. + + package--a package designator. The default is the current package. + +Description:: +............. + +unuse-package causes package to cease inheriting all the external +symbols of packages-to-unuse; unuse-package undoes the effects of +use-package. The packages-to-unuse are removed from the use list of +package. + + Any symbols that have been imported into package continue to be +present in package. + +Examples:: +.......... + + (in-package "COMMON-LISP-USER") => # + (export (intern "SHOES" (make-package 'temp)) 'temp) => T + (find-symbol "SHOES") => NIL, NIL + (use-package 'temp) => T + (find-symbol "SHOES") => SHOES, :INHERITED + (find (find-package 'temp) (package-use-list 'common-lisp-user)) => # + (unuse-package 'temp) => T + (find-symbol "SHOES") => NIL, NIL + +Side Effects:: +.............. + +The use list of package is modified. + +Affected By:: +............. + +Current state of the package system. + +See Also:: +.......... + +*note use-package:: , *note package-use-list:: + + +File: gcl.info, Node: use-package, Next: defpackage, Prev: unuse-package, Up: Packages Dictionary + +11.2.18 use-package [Function] +------------------------------ + +'use-package' packages-to-use &optional package => t + +Arguments and Values:: +...................... + +packages-to-use--a designator for a list of package designators. The +KEYWORD package may not be supplied. + + package--a package designator. The KEYWORD package cannot be +supplied. The default is the current package. + +Description:: +............. + +use-package causes package to inherit all the external symbols of +packages-to-use. The inherited symbols become accessible as internal +symbols of package. + + Packages-to-use are added to the use list of package if they are not +there already. All external symbols in packages-to-use become +accessible in package as internal symbols. use-package does not cause +any new symbols to be present in package but only makes them accessible +by inheritance. + + use-package checks for name conflicts between the newly imported +symbols and those already accessible in package. A name conflict in +use-package between two external symbols inherited by package from +packages-to-use may be resolved in favor of either symbol by importing +one of them into package and making it a shadowing symbol. + +Examples:: +.......... + + (export (intern "LAND-FILL" (make-package 'trash)) 'trash) => T + (find-symbol "LAND-FILL" (make-package 'temp)) => NIL, NIL + (package-use-list 'temp) => (#) + (use-package 'trash 'temp) => T + (package-use-list 'temp) => (# #) + (find-symbol "LAND-FILL" 'temp) => TRASH:LAND-FILL, :INHERITED + +Side Effects:: +.............. + +The use list of package may be modified. + +See Also:: +.......... + +*note unuse-package:: , *note package-use-list:: , *note Package +Concepts:: + +Notes:: +....... + +It is permissible for a package P_1 to use a package P_2 even if P_2 +already uses P_1. The using of packages is not transitive, so no +problem results from the apparent circularity. + + +File: gcl.info, Node: defpackage, Next: do-symbols, Prev: use-package, Up: Packages Dictionary + +11.2.19 defpackage [Macro] +-------------------------- + +'defpackage' defined-package-name [[!option]] => package + + option ::={(:nicknames {nickname}*)}* | + (:documentation string) | + {(:use {package-name}*)}* | + {(:shadow {!symbol-name}*)}* | + {(:shadowing-import-from package-name {!symbol-name}*)}* | + {(:import-from package-name {!symbol-name}*)}* | + {(:export {!symbol-name}*)}* | + {(:intern {!symbol-name}*)}* | (:size integer) + + symbol-name ::=(symbol | string) + +Arguments and Values:: +...................... + +defined-package-name--a string designator. + + package-name--a package designator. + + nickname--a string designator. + + symbol-name--a string designator. + + package--the package named package-name. + +Description:: +............. + +defpackage creates a package as specified and returns the package. + + If defined-package-name already refers to an existing package, the +name-to-package mapping for that name is not changed. If the new +definition is at variance with the current state of that package, the +consequences are undefined; an implementation might choose to modify the +existing package to reflect the new definition. If defined-package-name +is a symbol, its name is used. + + The standard options are described below. + +:nicknames + The arguments to :nicknames set the package's nicknames to the + supplied names. + +:documentation + The argument to :documentation specifies a documentation string; it + is attached as a documentation string to the package. At most one + :documentation option can appear in a single defpackage form. + +:use + The arguments to :use set the packages that the package named by + package-name will inherit from. If :use is not supplied, + + it defaults to the same implementation-dependent value as the :use + argument to make-package. + +:shadow + The arguments to :shadow, symbol-names, name symbols that are to be + created in the package being defined. These symbols are added to + the list of shadowing symbols effectively as if by shadow. + +:shadowing-import-from + The symbols named by the argument symbol-names are found (involving + a lookup as if by find-symbol) in the specified package-name. The + resulting symbols are imported into the package being defined, and + placed on the shadowing symbols list as if by shadowing-import. In + no case are symbols created in any package other than the one being + defined. + +:import-from + The symbols named by the argument symbol-names are found in the + package named by package-name and they are imported into the + package being defined. In no case are symbols created in any + package other than the one being defined. + +:export + The symbols named by the argument symbol-names are found or created + in the package being defined and exported. The :export option + interacts with the :use option, since inherited symbols can be used + rather than new ones created. The :export option interacts with + the :import-from and :shadowing-import-from options, since imported + symbols can be used rather than new ones created. If an argument + to the :export option is accessible as an (inherited) internal + symbol via use-package, that the symbol named by symbol-name is + first imported into the package being defined, and is then exported + from that package. + +:intern + The symbols named by the argument symbol-names are found or created + in the package being defined. The :intern option interacts with + the :use option, since inherited symbols can be used rather than + new ones created. + +:size + The argument to the :size option declares the approximate number of + symbols expected in the package. This is an efficiency hint only + and might be ignored by an implementation. + + The order in which the options appear in a defpackage form is +irrelevant. The order in which they are executed is as follows: + +1. + :shadow and :shadowing-import-from. +2. + :use. +3. + :import-from and :intern. +4. + :export. + + Shadows are established first, since they might be necessary to block +spurious name conflicts when the :use option is processed. The :use +option is executed next so that :intern and :export options can refer to +normally inherited symbols. The :export option is executed last so that +it can refer to symbols created by any of the other options; in +particular, shadowing symbols and imported symbols can be made external. + + If a defpackage form appears as a top level form, all of the actions +normally performed by this macro at load time must also be performed at +compile time. + +Examples:: +.......... + + (defpackage "MY-PACKAGE" + (:nicknames "MYPKG" "MY-PKG") + (:use "COMMON-LISP") + (:shadow "CAR" "CDR") + (:shadowing-import-from "VENDOR-COMMON-LISP" "CONS") + (:import-from "VENDOR-COMMON-LISP" "GC") + (:export "EQ" "CONS" "FROBOLA") + ) + + (defpackage my-package + (:nicknames mypkg :MY-PKG) ; remember Common Lisp conventions for case + (:use common-lisp) ; conversion on symbols + (:shadow CAR :cdr #:cons) + (:export "CONS") ; this is the shadowed one. + ) + +Affected By:: +............. + +Existing packages. + +Exceptional Situations:: +........................ + +If one of the supplied :nicknames already refers to an existing package, +an error of type package-error is signaled. + + An error of type program-error should be signaled if :size or +:documentation appears more than once. + + Since implementations might allow extended options an error of type +program-error should be signaled if an option is present that is not +actually supported in the host implementation. + + The collection of symbol-name arguments given to the options :shadow, +:intern, :import-from, and :shadowing-import-from must all be disjoint; +additionally, the symbol-name arguments given to :export and :intern +must be disjoint. Disjoint in this context is defined as no two of the +symbol-names being string= with each other. If either condition is +violated, an error of type program-error should be signaled. + + For the :shadowing-import-from and :import-from options, a +correctable error of type package-error is signaled if no symbol is +accessible in the package named by package-name for one of the argument +symbol-names. + + Name conflict errors are handled by the underlying calls to +make-package, use-package, import, and export. See *note Package +Concepts::. + +See Also:: +.......... + +*note documentation:: , *note Package Concepts::, *note Compilation:: + +Notes:: +....... + +The :intern option is useful if an :import-from or a +:shadowing-import-from option in a subsequent call to defpackage (for +some other package) expects to find these symbols accessible but not +necessarily external. + + It is recommended that the entire package definition is put in a +single place, and that all the package definitions of a program are in a +single file. This file can be loaded before loading or compiling +anything else that depends on those packages. Such a file can be read +in the COMMON-LISP-USER package, avoiding any initial state issues. + + defpackage cannot be used to create two "mutually recursive" +packages, such as: + + (defpackage my-package + (:use common-lisp your-package) ;requires your-package to exist first + (:export "MY-FUN")) + (defpackage your-package + (:use common-lisp) + (:import-from my-package "MY-FUN") ;requires my-package to exist first + (:export "MY-FUN")) + + However, nothing prevents the user from using the package-affecting +functions such as use-package, import, and export to establish such +links after a more standard use of defpackage. + + The macroexpansion of defpackage could usefully canonicalize the +names into strings, so that even if a source file has random symbols in +the defpackage form, the compiled file would only contain strings. + + Frequently additional implementation-dependent options take the form +of a keyword standing by itself as an abbreviation for a list (keyword +T); this syntax should be properly reported as an unrecognized option in +implementations that do not support it. + + +File: gcl.info, Node: do-symbols, Next: intern, Prev: defpackage, Up: Packages Dictionary + +11.2.20 do-symbols, do-external-symbols, do-all-symbols [Macro] +--------------------------------------------------------------- + +'do-symbols' (var [package [result-form]]) {declaration}* {tag | +statement}* +=> {result}* + + 'do-external-symbols' (var [package [result-form]]) {declaration}* +{tag | statement}* +=> {result}* + + 'do-all-symbols' (var [result-form]) {declaration}* {tag | +statement}* +=> {result}* + +Arguments and Values:: +...................... + +var--a variable name; not evaluated. + + package--a package designator; evaluated. + + The default in do-symbols and do-external-symbols is the current +package. + + result-form--a form; evaluated as described below. The default is +nil. + + declaration--a declare expression; not evaluated. + + tag--a go tag; not evaluated. + + statement--a compound form; evaluated as described below. + + results--the values returned by the result-form if a normal return +occurs, or else, if an explicit return occurs, the values that were +transferred. + +Description:: +............. + +do-symbols, do-external-symbols, and do-all-symbols iterate over the +symbols of packages. For each symbol in the set of packages chosen, the +var is bound to the symbol, and the statements in the body are executed. +When all the symbols have been processed, result-form is evaluated and +returned as the value of the macro. + + do-symbols iterates over the symbols accessible in package. + + Statements may execute more than once for symbols that are inherited +from multiple packages. + + do-all-symbols iterates on every registered package. do-all-symbols +will not process every symbol whatsoever, because a symbol not +accessible in any registered package will not be processed. +do-all-symbols may cause a symbol that is present in several packages to +be processed more than once. + + do-external-symbols iterates on the external symbols of package. + + When result-form is evaluated, var is bound and has the value nil. + + An implicit block named nil surrounds the entire do-symbols, +do-external-symbols, or do-all-symbols form. + + return or return-from may be used to terminate the iteration +prematurely. + + If execution of the body affects which symbols are contained in the +set of packages over which iteration is occurring, other than to remove +the symbol currently the value of var by using unintern, the +consequences are undefined. + + For each of these macros, the scope of the name binding does not +include any initial value form, but the optional result forms are +included. + + Any tag in the body is treated as with tagbody. + +Examples:: +.......... + + (make-package 'temp :use nil) => # + (intern "SHY" 'temp) => TEMP::SHY, NIL ;SHY will be an internal symbol + ;in the package TEMP + (export (intern "BOLD" 'temp) 'temp) => T ;BOLD will be external + (let ((lst ())) + (do-symbols (s (find-package 'temp)) (push s lst)) + lst) + => (TEMP::SHY TEMP:BOLD) + OR=> (TEMP:BOLD TEMP::SHY) + (let ((lst ())) + (do-external-symbols (s (find-package 'temp) lst) (push s lst)) + lst) + => (TEMP:BOLD) + (let ((lst ())) + (do-all-symbols (s lst) + (when (eq (find-package 'temp) (symbol-package s)) (push s lst))) + lst) + => (TEMP::SHY TEMP:BOLD) + OR=> (TEMP:BOLD TEMP::SHY) + +See Also:: +.......... + +*note intern:: , *note export:: , + + *note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: intern, Next: package-name, Prev: do-symbols, Up: Packages Dictionary + +11.2.21 intern [Function] +------------------------- + +'intern' string &optional package => symbol, status + +Arguments and Values:: +...................... + +string--a string. + + package--a package designator. + + The default is the current package. + + symbol--a symbol. + + status--one of :inherited, :external, :internal, or nil. + +Description:: +............. + +intern enters a symbol named string into package. If a symbol whose +name is the same as string is already accessible in package, it is +returned. If no such symbol is accessible in package, a new symbol with +the given name is created and entered into package as an internal +symbol, or as an external symbol if the package is the KEYWORD package; +package becomes the home package of the created symbol. + + The first value returned by intern, symbol, is the symbol that was +found or created. The meaning of the secondary value, status, is as +follows: + +:internal + The symbol was found and is present in package as an internal + symbol. + +:external + The symbol was found and is present as an external symbol. + +:inherited + The symbol was found and is inherited via use-package (which + implies that the symbol is internal). + +nil + No pre-existing symbol was found, so one was created. + + It is implementation-dependent whether the string that becomes the + new symbol's name is the given string or a copy of it. Once a + string has been given as the string argument to intern in this + situation where a new symbol is created, the consequences are + undefined if a subsequent attempt is made to alter that string. + +Examples:: +.......... + + (in-package "COMMON-LISP-USER") => # + (intern "Never-Before") => |Never-Before|, NIL + (intern "Never-Before") => |Never-Before|, :INTERNAL + (intern "NEVER-BEFORE" "KEYWORD") => :NEVER-BEFORE, NIL + (intern "NEVER-BEFORE" "KEYWORD") => :NEVER-BEFORE, :EXTERNAL + +See Also:: +.......... + +*note find-symbol:: , *note read:: , symbol, *note unintern:: , *note +Symbols as Tokens:: + +Notes:: +....... + +intern does not need to do any name conflict checking because it never +creates a new symbol if there is already an accessible symbol with the +name given. + + +File: gcl.info, Node: package-name, Next: package-nicknames, Prev: intern, Up: Packages Dictionary + +11.2.22 package-name [Function] +------------------------------- + +'package-name' package => name + +Arguments and Values:: +...................... + +package--a package designator. + + name--a string + + or nil. + +Description:: +............. + +package-name returns the string that names package, + + or nil if the package designator is a package object that has no name +(see the function delete-package). + +Examples:: +.......... + + (in-package "COMMON-LISP-USER") => # + (package-name *package*) => "COMMON-LISP-USER" + (package-name (symbol-package :test)) => "KEYWORD" + (package-name (find-package 'common-lisp)) => "COMMON-LISP" + + (defvar *foo-package* (make-package "FOO")) + (rename-package "FOO" "FOO0") + (package-name *foo-package*) => "FOO0" + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if package is not a package +designator. + + +File: gcl.info, Node: package-nicknames, Next: package-shadowing-symbols, Prev: package-name, Up: Packages Dictionary + +11.2.23 package-nicknames [Function] +------------------------------------ + +'package-nicknames' package => nicknames + +Arguments and Values:: +...................... + +package--a package designator. + + nicknames--a list of strings. + +Description:: +............. + +Returns the list of nickname strings for package, not including the name +of package. + +Examples:: +.......... + + (package-nicknames (make-package 'temporary + :nicknames '("TEMP" "temp"))) + => ("temp" "TEMP") + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if package is not a package +designator. + + +File: gcl.info, Node: package-shadowing-symbols, Next: package-use-list, Prev: package-nicknames, Up: Packages Dictionary + +11.2.24 package-shadowing-symbols [Function] +-------------------------------------------- + +'package-shadowing-symbols' package => symbols + +Arguments and Values:: +...................... + +package--a package designator. + + symbols--a list of symbols. + +Description:: +............. + +Returns a list of symbols that have been declared as shadowing symbols +in package by shadow or shadowing-import (or the equivalent defpackage +options). All symbols on this list are present in package. + +Examples:: +.......... + + (package-shadowing-symbols (make-package 'temp)) => () + (shadow 'cdr 'temp) => T + (package-shadowing-symbols 'temp) => (TEMP::CDR) + (intern "PILL" 'temp) => TEMP::PILL, NIL + (shadowing-import 'pill 'temp) => T + (package-shadowing-symbols 'temp) => (PILL TEMP::CDR) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if package is not a package +designator. + +See Also:: +.......... + +*note shadow:: , *note shadowing-import:: + +Notes:: +....... + +Whether the list of symbols is fresh is implementation-dependent. + + +File: gcl.info, Node: package-use-list, Next: package-used-by-list, Prev: package-shadowing-symbols, Up: Packages Dictionary + +11.2.25 package-use-list [Function] +----------------------------------- + +'package-use-list' package => use-list + +Arguments and Values:: +...................... + +package--a package designator. + + use-list--a list of package objects. + +Description:: +............. + +Returns a list of other packages used by package. + +Examples:: +.......... + + (package-use-list (make-package 'temp)) => (#) + (use-package 'common-lisp-user 'temp) => T + (package-use-list 'temp) => (# #) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if package is not a package +designator. + +See Also:: +.......... + +*note use-package:: , *note unuse-package:: + + +File: gcl.info, Node: package-used-by-list, Next: packagep, Prev: package-use-list, Up: Packages Dictionary + +11.2.26 package-used-by-list [Function] +--------------------------------------- + +'package-used-by-list' package => used-by-list + +Arguments and Values:: +...................... + +package--a package designator. + + used-by-list--a list of package objects. + +Description:: +............. + +package-used-by-list returns a list of other packages that use package. + +Examples:: +.......... + + (package-used-by-list (make-package 'temp)) => () + (make-package 'trash :use '(temp)) => # + (package-used-by-list 'temp) => (#) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if package is not a package. + +See Also:: +.......... + +*note use-package:: , *note unuse-package:: + + +File: gcl.info, Node: packagep, Next: *package*, Prev: package-used-by-list, Up: Packages Dictionary + +11.2.27 packagep [Function] +--------------------------- + +'packagep' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type package; otherwise, returns false. + +Examples:: +.......... + + (packagep *package*) => true + (packagep 'common-lisp) => false + (packagep (find-package 'common-lisp)) => true + +Notes:: +....... + + (packagep object) == (typep object 'package) + + +File: gcl.info, Node: *package*, Next: package-error, Prev: packagep, Up: Packages Dictionary + +11.2.28 *package* [Variable] +---------------------------- + +Value Type:: +............ + +a package object. + +Initial Value:: +............... + +the COMMON-LISP-USER package. + +Description:: +............. + +Whatever package object is currently the value of *package* is referred +to as the current package. + +Examples:: +.......... + + (in-package "COMMON-LISP-USER") => # + *package* => # + (make-package "SAMPLE-PACKAGE" :use '("COMMON-LISP")) + => # + (list + (symbol-package + (let ((*package* (find-package 'sample-package))) + (setq *some-symbol* (read-from-string "just-testing")))) + *package*) + => (# #) + (list (symbol-package (read-from-string "just-testing")) + *package*) + => (# #) + (eq 'foo (intern "FOO")) => true + (eq 'foo (let ((*package* (find-package 'sample-package))) + (intern "FOO"))) + => false + +Affected By:: +............. + +load, compile-file, in-package + +See Also:: +.......... + +*note compile-file:: , *note in-package:: , *note load:: , *note +package:: + + +File: gcl.info, Node: package-error, Next: package-error-package, Prev: *package*, Up: Packages Dictionary + +11.2.29 package-error [Condition Type] +-------------------------------------- + +Class Precedence List:: +....................... + +package-error, error, serious-condition, condition, t + +Description:: +............. + +The type package-error consists of error conditions related to +operations on packages. The offending package (or package name) is +initialized by the :package initialization argument to make-condition, +and is accessed by the function package-error-package. + +See Also:: +.......... + +*note package-error-package:: , *note Conditions:: + + +File: gcl.info, Node: package-error-package, Prev: package-error, Up: Packages Dictionary + +11.2.30 package-error-package [Function] +---------------------------------------- + +'package-error-package' condition => package + +Arguments and Values:: +...................... + +condition--a condition of type package-error. + + package--a package designator. + +Description:: +............. + +Returns a designator for the offending package in the situation +represented by the condition. + +Examples:: +.......... + + (package-error-package + (make-condition 'package-error + :package (find-package "COMMON-LISP"))) + => # + +See Also:: +.......... + +package-error + + +File: gcl.info, Node: Numbers (Numbers), Next: Characters, Prev: Packages, Up: Top + +12 Numbers +********** + +* Menu: + +* Number Concepts:: +* Numbers Dictionary:: + + +File: gcl.info, Node: Number Concepts, Next: Numbers Dictionary, Prev: Numbers (Numbers), Up: Numbers (Numbers) + +12.1 Number Concepts +==================== + +* Menu: + +* Numeric Operations:: +* Implementation-Dependent Numeric Constants:: +* Rational Computations:: +* Floating-point Computations:: +* Complex Computations:: +* Interval Designators:: +* Random-State Operations:: + + +File: gcl.info, Node: Numeric Operations, Next: Implementation-Dependent Numeric Constants, Prev: Number Concepts, Up: Number Concepts + +12.1.1 Numeric Operations +------------------------- + +Common Lisp provides a large variety of operations related to numbers. +This section provides an overview of those operations by grouping them +into categories that emphasize some of the relationships among them. + + Figure 12-1 shows operators relating to arithmetic operations. + + * 1+ gcd + + 1- incf + - conjugate lcm + / decf + + Figure 12-1: Operators relating to Arithmetic. + + + Figure 12-2 shows defined names relating to exponential, logarithmic, +and trigonometric operations. + + abs cos signum + acos cosh sin + acosh exp sinh + asin expt sqrt + asinh isqrt tan + atan log tanh + atanh phase + cis pi + + Figure 12-2: Defined names relating to Exponentials, Logarithms, and Trigonometry. + + + Figure 12-3 shows operators relating to numeric comparison and +predication. + + /= >= oddp + < evenp plusp + <= max zerop + = min + > minusp + + Figure 12-3: Operators for numeric comparison and predication. + + + Figure 12-4 shows defined names relating to numeric type manipulation +and coercion. + + ceiling float-radix rational + complex float-sign rationalize + decode-float floor realpart + denominator fround rem + fceiling ftruncate round + ffloor imagpart scale-float + float integer-decode-float truncate + float-digits mod + float-precision numerator + + Figure 12-4: Defined names relating to numeric type manipulation and coercion. + + +* Menu: + +* Associativity and Commutativity in Numeric Operations:: +* Examples of Associativity and Commutativity in Numeric Operations:: +* Contagion in Numeric Operations:: +* Viewing Integers as Bits and Bytes:: +* Logical Operations on Integers:: +* Byte Operations on Integers:: + + +File: gcl.info, Node: Associativity and Commutativity in Numeric Operations, Next: Examples of Associativity and Commutativity in Numeric Operations, Prev: Numeric Operations, Up: Numeric Operations + +12.1.1.1 Associativity and Commutativity in Numeric Operations +.............................................................. + +For functions that are mathematically associative (and possibly +commutative), a conforming implementation may process the arguments in +any manner consistent with associative (and possibly commutative) +rearrangement. This does not affect the order in which the argument +forms are evaluated; for a discussion of evaluation order, see *note +Function Forms::. What is unspecified is only the order in which the +parameter values are processed. This implies that implementations may +differ in which automatic coercions are applied; see *note Contagion in +Numeric Operations::. + + A conforming program can control the order of processing explicitly +by separating the operations into separate (possibly nested) function +forms, or by writing explicit calls to functions that perform coercions. + + +File: gcl.info, Node: Examples of Associativity and Commutativity in Numeric Operations, Next: Contagion in Numeric Operations, Prev: Associativity and Commutativity in Numeric Operations, Up: Numeric Operations + +12.1.1.2 Examples of Associativity and Commutativity in Numeric Operations +.......................................................................... + +Consider the following expression, in which we assume that 1.0 and +1.0e-15 both denote single floats: + + (+ 1/3 2/3 1.0d0 1.0 1.0e-15) + + One conforming implementation might process the arguments from left +to right, first adding 1/3 and 2/3 to get 1, then converting that to a +double float for combination with 1.0d0, then successively converting +and adding 1.0 and 1.0e-15. + + Another conforming implementation might process the arguments from +right to left, first performing a single float addition of 1.0 and +1.0e-15 (perhaps losing accuracy in the process), then converting the +sum to a double float and adding 1.0d0, then converting 2/3 to a double +float and adding it, and then converting 1/3 and adding that. + + A third conforming implementation might first scan all the arguments, +process all the rationals first to keep that part of the computation +exact, then find an argument of the largest floating-point format among +all the arguments and add that, and then add in all other arguments, +converting each in turn (all in a perhaps misguided attempt to make the +computation as accurate as possible). + + In any case, all three strategies are legitimate. + + A conforming program could control the order by writing, for example, + + (+ (+ 1/3 2/3) (+ 1.0d0 1.0e-15) 1.0) + + +File: gcl.info, Node: Contagion in Numeric Operations, Next: Viewing Integers as Bits and Bytes, Prev: Examples of Associativity and Commutativity in Numeric Operations, Up: Numeric Operations + +12.1.1.3 Contagion in Numeric Operations +........................................ + +For information about the contagion rules for implicit coercions of +arguments in numeric operations, see *note Rule of Float Precision +Contagion::, *note Rule of Float and Rational Contagion::, and *note +Rule of Complex Contagion::. + + +File: gcl.info, Node: Viewing Integers as Bits and Bytes, Next: Logical Operations on Integers, Prev: Contagion in Numeric Operations, Up: Numeric Operations + +12.1.1.4 Viewing Integers as Bits and Bytes +........................................... + + +File: gcl.info, Node: Logical Operations on Integers, Next: Byte Operations on Integers, Prev: Viewing Integers as Bits and Bytes, Up: Numeric Operations + +12.1.1.5 Logical Operations on Integers +....................................... + +Logical operations require integers as arguments; an error of type +type-error should be signaled if an argument is supplied that is not an +integer. Integer arguments to logical operations are treated as if they +were represented in two's-complement notation. + + Figure 12-5 shows defined names relating to logical operations on +numbers. + + ash boole-ior logbitp + boole boole-nand logcount + boole-1 boole-nor logeqv + boole-2 boole-orc1 logior + boole-and boole-orc2 lognand + boole-andc1 boole-set lognor + boole-andc2 boole-xor lognot + boole-c1 integer-length logorc1 + boole-c2 logand logorc2 + boole-clr logandc1 logtest + boole-eqv logandc2 logxor + + Figure 12-5: Defined names relating to logical operations on numbers. + + + +File: gcl.info, Node: Byte Operations on Integers, Prev: Logical Operations on Integers, Up: Numeric Operations + +12.1.1.6 Byte Operations on Integers +.................................... + +The byte-manipulation functions use objects called byte specifiers to +designate the size and position of a specific byte within an integer. +The representation of a byte specifier is implementation-dependent; it +might or might not be a number. The function byte will construct a byte +specifier, which various other byte-manipulation functions will accept. + + Figure 12-6 shows defined names relating to manipulating bytes of +numbers. + + byte deposit-field ldb-test + byte-position dpb mask-field + byte-size ldb + + Figure 12-6: Defined names relating to byte manipulation. + + + +File: gcl.info, Node: Implementation-Dependent Numeric Constants, Next: Rational Computations, Prev: Numeric Operations, Up: Number Concepts + +12.1.2 Implementation-Dependent Numeric Constants +------------------------------------------------- + +Figure 12-7 shows defined names relating to implementation-dependent +details about numbers. + + double-float-epsilon most-negative-fixnum + double-float-negative-epsilon most-negative-long-float + least-negative-double-float most-negative-short-float + least-negative-long-float most-negative-single-float + least-negative-short-float most-positive-double-float + least-negative-single-float most-positive-fixnum + least-positive-double-float most-positive-long-float + least-positive-long-float most-positive-short-float + least-positive-short-float most-positive-single-float + least-positive-single-float short-float-epsilon + long-float-epsilon short-float-negative-epsilon + long-float-negative-epsilon single-float-epsilon + most-negative-double-float single-float-negative-epsilon + + Figure 12-7: Defined names relating to implementation-dependent details about numbers. + + + +File: gcl.info, Node: Rational Computations, Next: Floating-point Computations, Prev: Implementation-Dependent Numeric Constants, Up: Number Concepts + +12.1.3 Rational Computations +---------------------------- + +The rules in this section apply to rational computations. + +* Menu: + +* Rule of Unbounded Rational Precision:: +* Rule of Canonical Representation for Rationals:: +* Rule of Float Substitutability:: + + +File: gcl.info, Node: Rule of Unbounded Rational Precision, Next: Rule of Canonical Representation for Rationals, Prev: Rational Computations, Up: Rational Computations + +12.1.3.1 Rule of Unbounded Rational Precision +............................................. + +Rational computations cannot overflow in the usual sense (though there +may not be enough storage to represent a result), since integers and +ratios may in principle be of any magnitude. + + +File: gcl.info, Node: Rule of Canonical Representation for Rationals, Next: Rule of Float Substitutability, Prev: Rule of Unbounded Rational Precision, Up: Rational Computations + +12.1.3.2 Rule of Canonical Representation for Rationals +....................................................... + +If any computation produces a result that is a mathematical ratio of two +integers such that the denominator evenly divides the numerator, then +the result is converted to the equivalent integer. + + If the denominator does not evenly divide the numerator, the +canonical representation of a rational number is as the ratio that +numerator and that denominator, where the greatest common divisor of the +numerator and denominator is one, and where the denominator is positive +and greater than one. + + When used as input (in the default syntax), the notation -0 always +denotes the integer 0. A conforming implementation must not have a +representation of "minus zero" for integers that is distinct from its +representation of zero for integers. However, such a distinction is +possible for floats; see the type float. + + +File: gcl.info, Node: Rule of Float Substitutability, Prev: Rule of Canonical Representation for Rationals, Up: Rational Computations + +12.1.3.3 Rule of Float Substitutability +....................................... + +When the arguments to an irrational mathematical function + + [Reviewer Note by Barmar: There should be a table of these +functions.] are all rational and the true mathematical result is also +(mathematically) rational, then unless otherwise noted an implementation +is free to return either an accurate rational result or a single float +approximation. If the arguments are all rational but the result cannot +be expressed as a rational number, then a single float approximation is +always returned. + + If the arguments to a mathematical function are all of type (or +rational (complex rational)) and the true mathematical result is +(mathematically) a complex number with rational real and imaginary +parts, then unless otherwise noted an implementation is free to return +either an accurate result of type (or rational (complex rational)) or a +single float (permissible only if the imaginary part of the true +mathematical result is zero) or (complex single-float). If the +arguments are all of type (or rational (complex rational)) but the +result cannot be expressed as a rational or complex rational, then the +returned value will be of type single-float (permissible only if the +imaginary part of the true mathematical result is zero) or (complex +single-float). + + Function Sample Results + abs (abs #c(3 4)) => 5 or 5.0 + acos (acos 1) => 0 or 0.0 + acosh (acosh 1) => 0 or 0.0 + asin (asin 0) => 0 or 0.0 + asinh (asinh 0) => 0 or 0.0 + atan (atan 0) => 0 or 0.0 + atanh (atanh 0) => 0 or 0.0 + cis (cis 0) => #c(1 0) or #c(1.0 0.0) + cos (cos 0) => 1 or 1.0 + cosh (cosh 0) => 1 or 1.0 + exp (exp 0) => 1 or 1.0 + expt (expt 8 1/3) => 2 or 2.0 + log (log 1) => 0 or 0.0 + (log 8 2) => 3 or 3.0 + phase (phase 7) => 0 or 0.0 + signum (signum #c(3 4)) => #c(3/5 4/5) or #c(0.6 0.8) + sin (sin 0) => 0 or 0.0 + sinh (sinh 0) => 0 or 0.0 + sqrt (sqrt 4) => 2 or 2.0 + (sqrt 9/16) => 3/4 or 0.75 + tan (tan 0) => 0 or 0.0 + tanh (tanh 0) => 0 or 0.0 + + Figure 12-8: Functions Affected by Rule of Float Substitutability + + + +File: gcl.info, Node: Floating-point Computations, Next: Complex Computations, Prev: Rational Computations, Up: Number Concepts + +12.1.4 Floating-point Computations +---------------------------------- + +The following rules apply to floating point computations. + +* Menu: + +* Rule of Float and Rational Contagion:: +* Examples of Rule of Float and Rational Contagion:: +* Rule of Float Approximation:: +* Rule of Float Underflow and Overflow:: +* Rule of Float Precision Contagion:: + + +File: gcl.info, Node: Rule of Float and Rational Contagion, Next: Examples of Rule of Float and Rational Contagion, Prev: Floating-point Computations, Up: Floating-point Computations + +12.1.4.1 Rule of Float and Rational Contagion +............................................. + +When rationals and floats are combined by a numerical function, the +rational is first converted to a float of the same format. For +functions such as + that take more than two arguments, it is permitted +that part of the operation be carried out exactly using rationals and +the rest be done using floating-point arithmetic. + + When rationals and floats are compared by a numerical function, the +function rational is effectively called to convert the float to a +rational and then an exact comparison is performed. In the case of +complex numbers, the real and imaginary parts are effectively handled +individually. + + +File: gcl.info, Node: Examples of Rule of Float and Rational Contagion, Next: Rule of Float Approximation, Prev: Rule of Float and Rational Contagion, Up: Floating-point Computations + +12.1.4.2 Examples of Rule of Float and Rational Contagion +......................................................... + + ;;;; Combining rationals with floats. + ;;; This example assumes an implementation in which + ;;; (float-radix 0.5) is 2 (as in IEEE) or 16 (as in IBM/360), + ;;; or else some other implementation in which 1/2 has an exact + ;;; representation in floating point. + (+ 1/2 0.5) => 1.0 + (- 1/2 0.5d0) => 0.0d0 + (+ 0.5 -0.5 1/2) => 0.5 + + ;;;; Comparing rationals with floats. + ;;; This example assumes an implementation in which the default float + ;;; format is IEEE single-float, IEEE double-float, or some other format + ;;; in which 5/7 is rounded upwards by FLOAT. + (< 5/7 (float 5/7)) => true + (< 5/7 (rational (float 5/7))) => true + (< (float 5/7) (float 5/7)) => false + + +File: gcl.info, Node: Rule of Float Approximation, Next: Rule of Float Underflow and Overflow, Prev: Examples of Rule of Float and Rational Contagion, Up: Floating-point Computations + +12.1.4.3 Rule of Float Approximation +.................................... + +Computations with floats are only approximate, although they are +described as if the results were mathematically accurate. Two +mathematically identical expressions may be computationally different +because of errors inherent in the floating-point approximation process. +The precision of a float is not necessarily correlated with the accuracy +of that number. For instance, 3.142857142857142857 is a more precise +approximation to \pi than 3.14159, but the latter is more accurate. The +precision refers to the number of bits retained in the representation. +When an operation combines a short float with a long float, the result +will be a long float. Common Lisp functions assume that the accuracy of +arguments to them does not exceed their precision. Therefore when two +small floats are combined, the result is a small float. Common Lisp +functions never convert automatically from a larger size to a smaller +one. + + +File: gcl.info, Node: Rule of Float Underflow and Overflow, Next: Rule of Float Precision Contagion, Prev: Rule of Float Approximation, Up: Floating-point Computations + +12.1.4.4 Rule of Float Underflow and Overflow +............................................. + +An error of type floating-point-overflow or floating-point-underflow +should be signaled if a floating-point computation causes exponent +overflow or underflow, respectively. + + +File: gcl.info, Node: Rule of Float Precision Contagion, Prev: Rule of Float Underflow and Overflow, Up: Floating-point Computations + +12.1.4.5 Rule of Float Precision Contagion +.......................................... + +The result of a numerical function is a float of the largest format +among all the floating-point arguments to the function. + + +File: gcl.info, Node: Complex Computations, Next: Interval Designators, Prev: Floating-point Computations, Up: Number Concepts + +12.1.5 Complex Computations +--------------------------- + +The following rules apply to complex computations: + +* Menu: + +* Rule of Complex Substitutability:: +* Rule of Complex Contagion:: +* Rule of Canonical Representation for Complex Rationals:: +* Examples of Rule of Canonical Representation for Complex Rationals:: +* Principal Values and Branch Cuts:: + + +File: gcl.info, Node: Rule of Complex Substitutability, Next: Rule of Complex Contagion, Prev: Complex Computations, Up: Complex Computations + +12.1.5.1 Rule of Complex Substitutability +......................................... + +Except during the execution of irrational and transcendental functions, +no numerical function ever yields a complex unless one or more of its +arguments is a complex. + + +File: gcl.info, Node: Rule of Complex Contagion, Next: Rule of Canonical Representation for Complex Rationals, Prev: Rule of Complex Substitutability, Up: Complex Computations + +12.1.5.2 Rule of Complex Contagion +.................................. + +When a + + real + + and a complex are both part of a computation, the + + real + + is first converted to a complex by providing an imaginary part of 0. + + +File: gcl.info, Node: Rule of Canonical Representation for Complex Rationals, Next: Examples of Rule of Canonical Representation for Complex Rationals, Prev: Rule of Complex Contagion, Up: Complex Computations + +12.1.5.3 Rule of Canonical Representation for Complex Rationals +............................................................... + +If the result of any computation would be a complex number whose real +part is of type rational and whose imaginary part is zero, the result is +converted to the rational which is the real part. This rule does not +apply to complex numbers whose parts are floats. For example, #C(5 0) +and 5 are not different objects in Common Lisp (they are always the same +under eql); #C(5.0 0.0) and 5.0 are always different objects in Common +Lisp (they are never the same under eql, although they are the same +under equalp and =). + + +File: gcl.info, Node: Examples of Rule of Canonical Representation for Complex Rationals, Next: Principal Values and Branch Cuts, Prev: Rule of Canonical Representation for Complex Rationals, Up: Complex Computations + +12.1.5.4 Examples of Rule of Canonical Representation for Complex Rationals +........................................................................... + + #c(1.0 1.0) => #C(1.0 1.0) + #c(0.0 0.0) => #C(0.0 0.0) + #c(1.0 1) => #C(1.0 1.0) + #c(0.0 0) => #C(0.0 0.0) + #c(1 1) => #C(1 1) + #c(0 0) => 0 + (typep #c(1 1) '(complex (eql 1))) => true + (typep #c(0 0) '(complex (eql 0))) => false + + +File: gcl.info, Node: Principal Values and Branch Cuts, Prev: Examples of Rule of Canonical Representation for Complex Rationals, Up: Complex Computations + +12.1.5.5 Principal Values and Branch Cuts +......................................... + +Many of the irrational and transcendental functions are multiply defined +in the complex domain; for example, there are in general an infinite +number of complex values for the logarithm function. In each such case, +a principal value must be chosen for the function to return. In +general, such values cannot be chosen so as to make the range +continuous; lines in the domain called branch cuts must be defined, +which in turn define the discontinuities in the range. Common Lisp +defines the branch cuts, principal values, and boundary conditions for +the complex functions following "Principal Values and Branch Cuts in +Complex APL." The branch cut rules that apply to each function are +located with the description of that function. + + Figure 12-9 lists the identities that are obeyed throughout the +applicable portion of the complex domain, even on the branch cuts: + + sin i z = i sinh z sinh i z = i sin z arctan i z = i arctanh z + cos i z = cosh z cosh i z = cos z arcsinh i z = i arcsin z + tan i z = i tanh z arcsin i z = i arcsinh z arctanh i z = i arctan z + + Figure 12-9: Trigonometric Identities for Complex Domain + + + The quadrant numbers referred to in the discussions of branch cuts +are as illustrated in Figure 12-10. + + Imaginary Axis + | + | + II | I + | + | + | + ______________________________________ Real Axis + | + | + | + III | IV + | + | + | + | + + + Figure 12-9: Quadrant Numbering for Branch Cuts + + +File: gcl.info, Node: Interval Designators, Next: Random-State Operations, Prev: Complex Computations, Up: Number Concepts + +12.1.6 Interval Designators +--------------------------- + +The compound type specifier form of the numeric type specifiers in +Figure 12-10 permit the user to specify an interval on the real number +line which describe a subtype of the type which would be described by +the corresponding atomic type specifier. A subtype of some type T is +specified using an ordered pair of objects called interval designators +for type T. + + The first of the two interval designators for type T can be any of +the following: + +a number N of type T + This denotes a lower inclusive bound of N. That is, elements of the + subtype of T will be greater than or equal to N. + +a singleton list whose element is + a number M of type T This denotes a lower exclusive bound of M. + That is, elements of the subtype of T will be greater than M. + +the symbol * + This denotes the absence of a lower bound on the interval. + + The second of the two interval designators for type T can be any of +the following: + +a number N of type T + This denotes an upper inclusive bound of N. That is, elements of + the subtype of T will be less than or equal to N. + +a singleton list whose element is + a number M of type T This denotes an upper exclusive bound of M. + That is, elements of the subtype of T will be less than M. + +the symbol * + This denotes the absence of an upper bound on the interval. + + +File: gcl.info, Node: Random-State Operations, Prev: Interval Designators, Up: Number Concepts + +12.1.7 Random-State Operations +------------------------------ + +Figure 12-10 lists some defined names that are applicable to random +states. + + *random-state* random + make-random-state random-state-p + + Figure 12-10: Random-state defined names + + + +File: gcl.info, Node: Numbers Dictionary, Prev: Number Concepts, Up: Numbers (Numbers) + +12.2 Numbers Dictionary +======================= + +* Menu: + +* number:: +* complex (System Class):: +* real:: +* float (System Class):: +* short-float:: +* rational (System Class):: +* ratio:: +* integer:: +* signed-byte:: +* unsigned-byte:: +* mod (System Class):: +* bit (System Class):: +* fixnum:: +* bignum:: +* =:: +* max:: +* minusp:: +* zerop:: +* floor:: +* sin:: +* asin:: +* pi:: +* sinh:: +* *:: +* +:: +* -:: +* /:: +* 1+:: +* abs:: +* evenp:: +* exp:: +* gcd:: +* incf:: +* lcm:: +* log:: +* mod (Function):: +* signum:: +* sqrt:: +* random-state:: +* make-random-state:: +* random:: +* random-state-p:: +* *random-state*:: +* numberp:: +* cis:: +* complex:: +* complexp:: +* conjugate:: +* phase:: +* realpart:: +* upgraded-complex-part-type:: +* realp:: +* numerator:: +* rational (Function):: +* rationalp:: +* ash:: +* integer-length:: +* integerp:: +* parse-integer:: +* boole:: +* boole-1:: +* logand:: +* logbitp:: +* logcount:: +* logtest:: +* byte:: +* deposit-field:: +* dpb:: +* ldb:: +* ldb-test:: +* mask-field:: +* most-positive-fixnum:: +* decode-float:: +* float:: +* floatp:: +* most-positive-short-float:: +* short-float-epsilon:: +* arithmetic-error:: +* arithmetic-error-operands:: +* division-by-zero:: +* floating-point-invalid-operation:: +* floating-point-inexact:: +* floating-point-overflow:: +* floating-point-underflow:: + + +File: gcl.info, Node: number, Next: complex (System Class), Prev: Numbers Dictionary, Up: Numbers Dictionary + +12.2.1 number [System Class] +---------------------------- + +Class Precedence List:: +....................... + +number, t + +Description:: +............. + +The type number contains objects which represent mathematical numbers. + + The types real and complex are disjoint subtypes of number. + + The function = tests for numerical equality. The function eql, when +its arguments are both numbers, tests that they have both the same type +and numerical value. Two numbers that are the same under eql or = are +not necessarily the same under eq. + +Notes:: +....... + +Common Lisp differs from mathematics on some naming issues. In +mathematics, the set of real numbers is traditionally described as a +subset of the complex numbers, but in Common Lisp, the type real and the +type complex are disjoint. The Common Lisp type which includes all +mathematical complex numbers is called number. The reasons for these +differences include historical precedent, compatibility with most other +popular computer languages, and various issues of time and space +efficiency. + + +File: gcl.info, Node: complex (System Class), Next: real, Prev: number, Up: Numbers Dictionary + +12.2.2 complex [System Class] +----------------------------- + +Class Precedence List:: +....................... + +complex, number, t + +Description:: +............. + +The type complex includes all mathematical complex numbers other than +those included in the type rational. Complexes are expressed in +Cartesian form with a real part and an imaginary part, each of which is +a real. The real part and imaginary part are either both rational or +both of the same float type. The imaginary part can be a float zero, +but can never be a rational zero, for such a number is always +represented by Common Lisp as a rational rather than a complex. + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('complex'{[typespec | *]}) + +Compound Type Specifier Arguments:: +................................... + +typespec--a type specifier that denotes a subtype of type real. + +Compound Type Specifier Description:: +..................................... + +[Editorial Note by KMP: If you ask me, this definition is a complete +mess. Looking at issue +ARRAY-TYPE-ELEMENT-TYPE-SEMANTICS:UNIFY-UPGRADING does not help me +figure it out, either. Anyone got any suggestions?] + + Every element of this type is a complex whose real part and imaginary +part are each of type + + (upgraded-complex-part-type typespec). + + This type encompasses those complexes that can result by giving +numbers of type typespec to complex. + + (complex type-specifier) refers to all complexes that can result from +giving numbers of type type-specifier to the function complex, plus all +other complexes of the same specialized representation. + +See Also:: +.......... + +*note Rule of Canonical Representation for Complex Rationals::, *note +Constructing Numbers from Tokens::, *note Printing Complexes:: + +Notes:: +....... + +The input syntax for a complex with real part r and imaginary part i is +#C(r i). For further details, see *note Standard Macro Characters::. + + For every float, n, there is a complex which represents the same +mathematical number and which can be obtained by (COERCE n 'COMPLEX). + + +File: gcl.info, Node: real, Next: float (System Class), Prev: complex (System Class), Up: Numbers Dictionary + +12.2.3 real [System Class] +-------------------------- + +Class Precedence List:: +....................... + +real, number, t + +Description:: +............. + +The type real includes all numbers that represent mathematical real +numbers, though there are mathematical real numbers (e.g., irrational +numbers) that do not have an exact representation in Common Lisp. Only +reals can be ordered using the <, >, <=, and >= functions. + + The types rational and float are disjoint subtypes of type real. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('real'{[lower-limit [upper-limit]]}) + +Compound Type Specifier Arguments:: +................................... + +lower-limit, upper-limit--interval designators for type real. The +defaults for each of lower-limit and upper-limit is the symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the reals on the interval described by lower-limit and +upper-limit. + + +File: gcl.info, Node: float (System Class), Next: short-float, Prev: real, Up: Numbers Dictionary + +12.2.4 float [System Class] +--------------------------- + +Class Precedence List:: +....................... + +float, + + real, + + number, t + +Description:: +............. + +A float is a mathematical rational (but not a Common Lisp rational) of +the form s\cdot f\cdot b^e-p, where s is +1 or -1, the sign; b is an +integer greater than~1, the base or radix of the representation; p is a +positive integer, the precision (in base-b digits) of the float; f is a +positive integer between b^p-1 and b^p-1 (inclusive), the significand; +and e is an integer, the exponent. The value of p and the range of~e +depends on the implementation and on the type of float within that +implementation. In addition, there is a floating-point zero; depending +on the implementation, there can also be a "minus zero". If there is no +minus zero, then 0.0 and~-0.0 are both interpreted as simply a +floating-point zero. (= 0.0 -0.0) is always true. If there is a minus +zero, (eql -0.0 0.0) is false, otherwise it is true. + + [Reviewer Note by Barmar: What about IEEE NaNs and infinities?] + + [Reviewer Note by RWK: In the following, what is the "ordering"? +precision? range? Can there be additional subtypes of float or does +"others" in the list of four?] + + The types short-float, single-float, double-float, and long-float are +subtypes of type float. Any two of them must be either disjoint types +or the same type; if the same type, then any other types between them in +the above ordering must also be the same type. For example, if the type +single-float and the type long-float are the same type, then the type +double-float must be the same type also. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('float'{[lower-limit [upper-limit]]}) + +Compound Type Specifier Arguments:: +................................... + +lower-limit, upper-limit--interval designators for type float. The +defaults for each of lower-limit and upper-limit is the symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the floats on the interval described by lower-limit and +upper-limit. + +See Also:: +.......... + +Figure~2-9, *note Constructing Numbers from Tokens::, *note Printing +Floats:: + +Notes:: +....... + +Note that all mathematical integers are representable not only as Common +Lisp reals, but also as complex floats. For example, possible +representations of the mathematical number 1 include the integer 1, the +float 1.0, or the complex #C(1.0 0.0). + + +File: gcl.info, Node: short-float, Next: rational (System Class), Prev: float (System Class), Up: Numbers Dictionary + +12.2.5 short-float, single-float, double-float, long-float [Type] +----------------------------------------------------------------- + +Supertypes:: +............ + +short-float: short-float, float, + + real, + + number, t + + single-float: single-float, float, + + real, + + number, t + + double-float: double-float, float, + + real, + + number, t + + long-float: long-float, float, + + real, + + number, t + +Description:: +............. + +For the four defined subtypes of type float, it is true that +intermediate between the type short-float and the type long-float are +the type single-float and the type double-float. The precise definition +of these categories is implementation-defined. The precision (measured +in "bits", computed as p\log_2b) and the exponent size (also measured in +"bits," computed as \log_2(n+1), where n is the maximum exponent value) +is recommended to be at least as great as the values in Figure 12-11. +Each of the defined subtypes of type float might or might not have a +minus zero. + + Format Minimum Precision Minimum Exponent Size + __________________________________________________ + Short 13 bits 5 bits + Single 24 bits 8 bits + Double 50 bits 8 bits + Long 50 bits 8 bits + + Figure 12-11: Recommended Minimum Floating-Point Precision and Exponent Size + + + There can be fewer than four internal representations for floats. If +there are fewer distinct representations, the following rules apply: + +- + If there is only one, it is the type single-float. In this + representation, an object is simultaneously of types single-float, + double-float, short-float, and long-float. +- + Two internal representations can be arranged in either of the + following ways: + + * + Two types are provided: single-float and short-float. An + object is simultaneously of types single-float, double-float, + and long-float. + * + Two types are provided: single-float and double-float. An + object is simultaneously of types single-float and + short-float, or double-float and long-float. + +- + Three internal representations can be arranged in either of the + following ways: + + * + Three types are provided: short-float, single-float, and + double-float. An object can simultaneously be of type + double-float and long-float. + * + Three types are provided: single-float, double-float, and + long-float. An object can simultaneously be of types + single-float and short-float. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('short-float'{[short-lower-limit [short-upper-limit]]}) +('single-float'{[single-lower-limit [single-upper-limit]]}) +('double-float'{[double-lower-limit [double-upper-limit]]}) +('long-float'{[long-lower-limit [long-upper-limit]]}) + +Compound Type Specifier Arguments:: +................................... + +short-lower-limit, short-upper-limit--interval designators for type +short-float. The defaults for each of lower-limit and upper-limit is +the symbol *. + + single-lower-limit, single-upper-limit--interval designators for type +single-float. The defaults for each of lower-limit and upper-limit is +the symbol *. + + double-lower-limit, double-upper-limit--interval designators for type +double-float. The defaults for each of lower-limit and upper-limit is +the symbol *. + + long-lower-limit, long-upper-limit--interval designators for type +long-float. The defaults for each of lower-limit and upper-limit is the +symbol *. + +Compound Type Specifier Description:: +..................................... + +Each of these denotes the set of floats of the indicated type that are +on the interval specified by the interval designators. + + +File: gcl.info, Node: rational (System Class), Next: ratio, Prev: short-float, Up: Numbers Dictionary + +12.2.6 rational [System Class] +------------------------------ + +Class Precedence List:: +....................... + +rational, + + real, + + number, t + +Description:: +............. + +The canonical representation of a rational is as an integer if its value +is integral, and otherwise as a ratio. + + The types integer and ratio are disjoint subtypes of type rational. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('rational'{[lower-limit [upper-limit]]}) + +Compound Type Specifier Arguments:: +................................... + +lower-limit, upper-limit--interval designators for type rational. The +defaults for each of lower-limit and upper-limit is the symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the rationals on the interval described by lower-limit and +upper-limit. + + +File: gcl.info, Node: ratio, Next: integer, Prev: rational (System Class), Up: Numbers Dictionary + +12.2.7 ratio [System Class] +--------------------------- + +Class Precedence List:: +....................... + +ratio, rational, + + real, + + number, t + +Description:: +............. + +A ratio is a number representing the mathematical ratio of two non-zero +integers, the numerator and denominator, whose greatest common divisor +is one, and of which the denominator is positive and greater than one. + +See Also:: +.......... + +Figure~2-9, *note Constructing Numbers from Tokens::, *note Printing +Ratios:: + + +File: gcl.info, Node: integer, Next: signed-byte, Prev: ratio, Up: Numbers Dictionary + +12.2.8 integer [System Class] +----------------------------- + +Class Precedence List:: +....................... + +integer, rational, + + real, + + number, t + +Description:: +............. + +An integer is a mathematical integer. There is no limit on the +magnitude of an integer. + + The types fixnum and bignum form an exhaustive partition of type +integer. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('integer'{[lower-limit [upper-limit]]}) + +Compound Type Specifier Arguments:: +................................... + +lower-limit, upper-limit--interval designators for type integer. The +defaults for each of lower-limit and upper-limit is the symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the integers on the interval described by lower-limit and +upper-limit. + +See Also:: +.......... + +Figure~2-9, *note Constructing Numbers from Tokens::, *note Printing +Integers:: + +Notes:: +....... + +The type (integer lower upper), where lower and upper are +most-negative-fixnum and most-positive-fixnum, respectively, is also +called fixnum. + + The type (integer 0 1) is also called bit. The type (integer 0 *) is +also called unsigned-byte. + + +File: gcl.info, Node: signed-byte, Next: unsigned-byte, Prev: integer, Up: Numbers Dictionary + +12.2.9 signed-byte [Type] +------------------------- + +Supertypes:: +............ + +signed-byte, integer, rational, + + real, + + number, t + +Description:: +............. + +The atomic type specifier signed-byte denotes the same type as is +denoted by the type specifier integer; however, the list forms of these +two type specifiers have different semantics. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('signed-byte'{[s | *]}) + +Compound Type Specifier Arguments:: +................................... + +s--a positive integer. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of integers that can be represented in +two's-complement form in a byte of s bits. This is equivalent to +(integer -2^s-1 2^s-1-1). The type signed-byte or the type (signed-byte +*) is the same as the type integer. + + +File: gcl.info, Node: unsigned-byte, Next: mod (System Class), Prev: signed-byte, Up: Numbers Dictionary + +12.2.10 unsigned-byte [Type] +---------------------------- + +Supertypes:: +............ + +unsigned-byte, signed-byte, integer, rational, + + real, + + number, t + +Description:: +............. + +The atomic type specifier unsigned-byte denotes the same type as is +denoted by the type specifier (integer 0 *). + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('unsigned-byte'{[s | *]}) + +Compound Type Specifier Arguments:: +................................... + +s--a positive integer. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of non-negative integers that can be represented in +a byte of size s (bits). This is equivalent to (mod m) for m=2^s, or to +(integer 0 n) for n=2^s-1. The type unsigned-byte or the type +(unsigned-byte *) is the same as the type (integer 0 *), the set of +non-negative integers. + +Notes:: +....... + +The type (unsigned-byte 1) is also called bit. + + +File: gcl.info, Node: mod (System Class), Next: bit (System Class), Prev: unsigned-byte, Up: Numbers Dictionary + +12.2.11 mod [Type Specifier] +---------------------------- + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('mod'{n}) + +Compound Type Specifier Arguments:: +................................... + +n--a positive integer. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of non-negative integers less than n. This is +equivalent to (integer 0 (n)) or to (integer 0 m), where m=n-1. + + The argument is required, and cannot be *. + + The symbol mod is not valid as a type specifier. + + +File: gcl.info, Node: bit (System Class), Next: fixnum, Prev: mod (System Class), Up: Numbers Dictionary + +12.2.12 bit [Type] +------------------ + +Supertypes:: +............ + +bit, unsigned-byte, signed-byte, integer, rational, + + real, + + number, t + +Description:: +............. + +The type bit is equivalent to the type (integer 0 1) and (unsigned-byte +1). + + +File: gcl.info, Node: fixnum, Next: bignum, Prev: bit (System Class), Up: Numbers Dictionary + +12.2.13 fixnum [Type] +--------------------- + +Supertypes:: +............ + +fixnum, integer, rational, + + real, + + number, t + +Description:: +............. + +A fixnum is an integer whose value is between most-negative-fixnum and +most-positive-fixnum inclusive. Exactly which integers are fixnums is +implementation-defined. + + The type fixnum is required to be a supertype of (signed-byte 16). + + +File: gcl.info, Node: bignum, Next: =, Prev: fixnum, Up: Numbers Dictionary + +12.2.14 bignum [Type] +--------------------- + +Supertypes:: +............ + +bignum, integer, rational, + + real, + + number, t + +Description:: +............. + +The type bignum is defined to be exactly (and integer (not fixnum)). + + +File: gcl.info, Node: =, Next: max, Prev: bignum, Up: Numbers Dictionary + +12.2.15 =, /=, <, >, <=, >= [Function] +-------------------------------------- + +'=' &rest numbers^+ => generalized-boolean + + '/=' &rest numbers^+ => generalized-boolean + + '<' &rest numbers^+ => generalized-boolean + + '>' &rest numbers^+ => generalized-boolean + + '<=' &rest numbers^+ => generalized-boolean + + '>=' &rest numbers^+ => generalized-boolean + +Arguments and Values:: +...................... + +number--for <, >, <=, >=: a real; for =, /=: a number. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +=, /=, <, >, <=, and >= perform arithmetic comparisons on their +arguments as follows: + += + The value of = is true if all numbers are the same in value; + otherwise it is false. Two complexes are considered equal by = if + their real and imaginary parts are equal according to =. + +/= + The value of /= is true if no two numbers are the same in value; + otherwise it is false. + +< + The value of < is true if the numbers are in monotonically + increasing order; otherwise it is false. + +> + The value of > is true if the numbers are in monotonically + decreasing order; otherwise it is false. + +<= + The value of <= is true if the numbers are in monotonically + nondecreasing order; otherwise it is false. + +>= + The value of >= is true if the numbers are in monotonically + nonincreasing order; otherwise it is false. + + =, /=, <, >, <=, and >= perform necessary type conversions. + +Examples:: +.......... + +The uses of these functions are illustrated in Figure 12-12. + + (= 3 3) is true. (/= 3 3) is false. + (= 3 5) is false. (/= 3 5) is true. + (= 3 3 3 3) is true. (/= 3 3 3 3) is false. + (= 3 3 5 3) is false. (/= 3 3 5 3) is false. + (= 3 6 5 2) is false. (/= 3 6 5 2) is true. + (= 3 2 3) is false. (/= 3 2 3) is false. + (< 3 5) is true. (<= 3 5) is true. + (< 3 -5) is false. (<= 3 -5) is false. + (< 3 3) is false. (<= 3 3) is true. + (< 0 3 4 6 7) is true. (<= 0 3 4 6 7) is true. + (< 0 3 4 4 6) is false. (<= 0 3 4 4 6) is true. + (> 4 3) is true. (>= 4 3) is true. + (> 4 3 2 1 0) is true. (>= 4 3 2 1 0) is true. + (> 4 3 3 2 0) is false. (>= 4 3 3 2 0) is true. + (> 4 3 1 2 0) is false. (>= 4 3 1 2 0) is false. + (= 3) is true. (/= 3) is true. + (< 3) is true. (<= 3) is true. + (= 3.0 #c(3.0 0.0)) is true. (/= 3.0 #c(3.0 1.0)) is true. + (= 3 3.0) is true. (= 3.0s0 3.0d0) is true. + (= 0.0 -0.0) is true. (= 5/2 2.5) is true. + (> 0.0 -0.0) is false. (= 0 -0.0) is true. + (<= 0 x 9) is true if x is between 0 and 9, inclusive + (< 0.0 x 1.0) is true if x is between 0.0 and 1.0, exclusive + (< -1 j (length v)) is true if j is a valid array index for a vector v + + Figure 12-12: Uses of /=, =, <, >, <=, and >= + + +Exceptional Situations:: +........................ + +Might signal type-error if some argument is not a real. Might signal +arithmetic-error if otherwise unable to fulfill its contract. + +Notes:: +....... + += differs from eql in that (= 0.0 -0.0) is always true, because = +compares the mathematical values of its operands, whereas eql compares +the representational values, so to speak. + + +File: gcl.info, Node: max, Next: minusp, Prev: =, Up: Numbers Dictionary + +12.2.16 max, min [Function] +--------------------------- + +'max' &rest reals^+ => max-real + + 'min' &rest reals^+ => min-real + +Arguments and Values:: +...................... + +real--a real. + + max-real, min-real--a real. + +Description:: +............. + +max returns the real that is greatest (closest to positive infinity). +min returns the real that is least (closest to negative infinity). + + For max, the implementation has the choice of returning the largest +argument as is or applying the rules of floating-point contagion, taking +all the arguments into consideration for contagion purposes. Also, if +one or more of the arguments are =, then any one of them may be chosen +as the value to return. For example, if the reals are a mixture of +rationals and floats, and the largest argument is a rational, then the +implementation is free to produce either that rational or its float +approximation; if the largest argument is a float of a smaller format +than the largest format of any float argument, then the implementation +is free to return the argument in its given format or expanded to the +larger format. Similar remarks apply to min (replacing "largest +argument" by "smallest argument"). + +Examples:: +.......... + + (max 3) => 3 + (min 3) => 3 + (max 6 12) => 12 + (min 6 12) => 6 + (max -6 -12) => -6 + (min -6 -12) => -12 + (max 1 3 2 -7) => 3 + (min 1 3 2 -7) => -7 + (max -2 3 0 7) => 7 + (min -2 3 0 7) => -2 + (max 5.0 2) => 5.0 + (min 5.0 2) + => 2 + OR=> 2.0 + (max 3.0 7 1) + => 7 + OR=> 7.0 + (min 3.0 7 1) + => 1 + OR=> 1.0 + (max 1.0s0 7.0d0) => 7.0d0 + (min 1.0s0 7.0d0) + => 1.0s0 + OR=> 1.0d0 + (max 3 1 1.0s0 1.0d0) + => 3 + OR=> 3.0d0 + (min 3 1 1.0s0 1.0d0) + => 1 + OR=> 1.0s0 + OR=> 1.0d0 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if any number is not a real. + + +File: gcl.info, Node: minusp, Next: zerop, Prev: max, Up: Numbers Dictionary + +12.2.17 minusp, plusp [Function] +-------------------------------- + +'minusp' real => generalized-boolean + + 'plusp' real => generalized-boolean + +Arguments and Values:: +...................... + +real--a real. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +minusp returns true if real is less than zero; otherwise, returns false. + + plusp returns true if real is greater than zero; otherwise, returns +false. + + Regardless of whether an implementation provides distinct +representations for positive and negative float zeros, (minusp -0.0) +always returns false. + +Examples:: +.......... + + (minusp -1) => true + (plusp 0) => false + (plusp least-positive-single-float) => true + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if real is not a real. + + +File: gcl.info, Node: zerop, Next: floor, Prev: minusp, Up: Numbers Dictionary + +12.2.18 zerop [Function] +------------------------ + +'zerop' number => generalized-boolean + +Pronunciation:: +............... + +pronounced 'z\=e (, )r\=o(, )p\=e + +Arguments and Values:: +...................... + +number--a number. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if number is zero (integer, float, or complex); otherwise, +returns false. + + Regardless of whether an implementation provides distinct +representations for positive and negative floating-point zeros, (zerop +-0.0) always returns true. + +Examples:: +.......... + + (zerop 0) => true + (zerop 1) => false + (zerop -0.0) => true + (zerop 0/100) => true + (zerop #c(0 0.0)) => true + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if number is not a number. + +Notes:: +....... + + (zerop number) == (= number 0) + + +File: gcl.info, Node: floor, Next: sin, Prev: zerop, Up: Numbers Dictionary + +12.2.19 floor, ffloor, ceiling, fceiling, +----------------------------------------- + +truncate, ftruncate, round, fround +---------------------------------- + + [Function] + + 'floor' number &optional divisor => quotient, remainder + + 'ffloor' number &optional divisor => quotient, remainder + + 'ceiling' number &optional divisor => quotient, remainder + + 'fceiling' number &optional divisor => quotient, remainder + + 'truncate' number &optional divisor => quotient, remainder + + 'ftruncate' number &optional divisor => quotient, remainder + + 'round' number &optional divisor => quotient, remainder + + 'fround' number &optional divisor => quotient, remainder + +Arguments and Values:: +...................... + +number--a real. + + divisor--a non-zero real. The default is the integer 1. + + quotient--for floor, ceiling, truncate, and round: an integer; for +ffloor, fceiling, ftruncate, and fround: a float. + + remainder--a real. + +Description:: +............. + +These functions divide number by divisor, returning a quotient and +remainder, such that + + quotient\cdot divisor+remainder=number + + The quotient always represents a mathematical integer. When more +than one mathematical integer might be possible (i.e., when the +remainder is not zero), the kind of rounding or truncation depends on +the operator: + +floor, ffloor + floor and ffloor produce a quotient that has been truncated toward + negative infinity; that is, the quotient represents the largest + mathematical integer that is not larger than the mathematical + quotient. + +ceiling, fceiling + ceiling and fceiling produce a quotient that has been truncated + toward positive infinity; that is, the quotient represents the + smallest mathematical integer that is not smaller than the + mathematical result. + +truncate, ftruncate + truncate and ftruncate produce a quotient that has been truncated + towards zero; that is, the quotient represents the mathematical + integer of the same sign as the mathematical quotient, and that has + the greatest integral magnitude not greater than that of the + mathematical quotient. + +round, fround + round and fround produce a quotient that has been rounded to the + nearest mathematical integer; if the mathematical quotient is + exactly halfway between two integers, (that is, it has the form + integer+1\over2), then the quotient has been rounded to the even + (divisible by two) integer. + + All of these functions perform type conversion operations on numbers. + + The remainder is an integer if both x and y are integers, is a +rational if both x and y are rationals, and is a float if either x or y +is a float. + + ffloor, fceiling, ftruncate, and fround handle arguments of different +types in the following way: If number is a float, and divisor is not a +float of longer format, then the first result is a float of the same +type as number. Otherwise, the first result is of the type determined +by contagion rules; see *note Contagion in Numeric Operations::. + +Examples:: +.......... + + (floor 3/2) => 1, 1/2 + (ceiling 3 2) => 2, -1 + (ffloor 3 2) => 1.0, 1 + (ffloor -4.7) => -5.0, 0.3 + (ffloor 3.5d0) => 3.0d0, 0.5d0 + (fceiling 3/2) => 2.0, -1/2 + (truncate 1) => 1, 0 + (truncate .5) => 0, 0.5 + (round .5) => 0, 0.5 + (ftruncate -7 2) => -3.0, -1 + (fround -7 2) => -4.0, 1 + (dolist (n '(2.6 2.5 2.4 0.7 0.3 -0.3 -0.7 -2.4 -2.5 -2.6)) + (format t "~&~4,1@F ~2,' D ~2,' D ~2,' D ~2,' D" + n (floor n) (ceiling n) (truncate n) (round n))) + |> +2.6 2 3 2 3 + |> +2.5 2 3 2 2 + |> +2.4 2 3 2 2 + |> +0.7 0 1 0 1 + |> +0.3 0 1 0 0 + |> -0.3 -1 0 0 0 + |> -0.7 -1 0 0 -1 + |> -2.4 -3 -2 -2 -2 + |> -2.5 -3 -2 -2 -2 + |> -2.6 -3 -2 -2 -3 + => NIL + +Notes:: +....... + +When only number is given, the two results are exact; the mathematical +sum of the two results is always equal to the mathematical value of +number. + + (function number divisor) and (function (/ number divisor)) (where +function is any of one of floor, ceiling, ffloor, fceiling, truncate, +round, ftruncate, and fround) return the same first value, but they +return different remainders as the second value. For example: + + (floor 5 2) => 2, 1 + (floor (/ 5 2)) => 2, 1/2 + + If an effect is desired that is similar to round, but that always +rounds up or down (rather than toward the nearest even integer) if the +mathematical quotient is exactly halfway between two integers, the +programmer should consider a construction such as (floor (+ x 1/2)) or +(ceiling (- x 1/2)). + + +File: gcl.info, Node: sin, Next: asin, Prev: floor, Up: Numbers Dictionary + +12.2.20 sin, cos, tan [Function] +-------------------------------- + +'sin' radians => number + + 'cos' radians => number + + 'tan' radians => number + +Arguments and Values:: +...................... + +radians--a number given in radians. + + number--a number. + +Description:: +............. + +sin, cos, and tan return the sine, cosine, and tangent, respectively, of +radians. + +Examples:: +.......... + + (sin 0) => 0.0 + (cos 0.7853982) => 0.707107 + (tan #c(0 1)) => #C(0.0 0.761594) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if radians is not a number. +Might signal arithmetic-error. + +See Also:: +.......... + +*note asin:: , acos, atan, *note Rule of Float Substitutability:: + + +File: gcl.info, Node: asin, Next: pi, Prev: sin, Up: Numbers Dictionary + +12.2.21 asin, acos, atan [Function] +----------------------------------- + +'asin' number => radians + + 'acos' number => radians + + 'atan' number1 &optional number2 => radians + +Arguments and Values:: +...................... + +number--a number. + + number1--a number if number2 is not supplied, or a real if number2 is +supplied. + + number2--a real. + + radians--a number (of radians). + +Description:: +............. + +asin, acos, and atan compute the arc sine, arc cosine, and arc tangent +respectively. + + The arc sine, arc cosine, and arc tangent (with only number1 +supplied) functions can be defined mathematically for number or number1 +specified as x as in Figure 12-13. + + Function Definition + Arc sine -i log (ix+ \sqrt1-x^2 ) + Arc cosine (\pi/2) - arcsin x + Arc tangent -i log ((1+ix) \sqrt1/(1+x^2) ) + + Figure 12-13: Mathematical definition of arc sine, arc cosine, and arc tangent + + + These formulae are mathematically correct, assuming completely +accurate computation. They are not necessarily the simplest ones for +real-valued computations. + + If both number1 and number2 are supplied for atan, the result is the +arc tangent of number1/number2. The value of atan is always between +-\pi (exclusive) and~\pi (inclusive) + + when minus zero is not supported. The range of the two-argument arc +tangent when minus zero is supported includes -\pi. + + For a + + real + + number1, the result is + + a real + + and lies between -\pi/2 and~\pi/2 (both exclusive). number1 can be a +complex if number2 is not supplied. If both are supplied, number2 can +be zero provided number1 is not zero. + + [Reviewer Note by Barmar: Should add "However, if the implementation +distinguishes positive and negative zero, both may be signed zeros, and +limits are used to define the result."] + + The following definition for arc sine determines the range and branch +cuts: + + arcsin z = -i log (iz+\sqrt1-z^2\Bigr) + + The branch cut for the arc sine function is in two pieces: one along +the negative real axis to the left of~-1 (inclusive), continuous with +quadrant II, and one along the positive real axis to the right of~1 +(inclusive), continuous with quadrant IV. The range is that strip of the +complex plane containing numbers whose real part is between -\pi/2 +and~\pi/2. A number with real part equal to -\pi/2 is in the range if +and only if its imaginary part is non-negative; a number with real part +equal to \pi/2 is in the range if and only if its imaginary part is +non-positive. + + The following definition for arc cosine determines the range and +branch cuts: + + arccos z = \pi\over2 - arcsin z + + or, which are equivalent, + + arccos z = -i log (z+i \sqrt1-z^2\Bigr) + + arccos z = 2 log (\sqrt(1+z)/2 + i \sqrt(1-z)/2)\overi + + The branch cut for the arc cosine function is in two pieces: one +along the negative real axis to the left of~-1 (inclusive), continuous +with quadrant II, and one along the positive real axis to the right of~1 +(inclusive), continuous with quadrant IV. This is the same branch cut as +for arc sine. The range is that strip of the complex plane containing +numbers whose real part is between 0 and~\pi. A number with real part +equal to 0 is in the range if and only if its imaginary part is +non-negative; a number with real part equal to \pi is in the range if +and only if its imaginary part is non-positive. + + The following definition for (one-argument) arc tangent determines +the range and branch cuts: + + arctan z = log (1+iz) - log (1-iz)\over2i + + Beware of simplifying this formula; "obvious" simplifications are +likely to alter the branch cuts or the values on the branch cuts +incorrectly. The branch cut for the arc tangent function is in two +pieces: one along the positive imaginary axis above i (exclusive), +continuous with quadrant II, and one along the negative imaginary axis +below -i (exclusive), continuous with quadrant IV. The points i and~-i +are excluded from the domain. The range is that strip of the complex +plane containing numbers whose real part is between -\pi/2 and~\pi/2. A +number with real part equal to -\pi/2 is in the range if and only if its +imaginary part is strictly positive; a number with real part equal to +\pi/2 is in the range if and only if its imaginary part is strictly +negative. Thus the range of arc tangent is identical to that of arc +sine with the points -\pi/2 and~\pi/2 excluded. + + For atan, the signs of number1 (indicated as x) and number2 +(indicated as y) are used to derive quadrant information. Figure 12-14 +details various special cases. + + The asterisk (*) indicates that the entry in the figure applies to +implementations that support minus zero. + + to 1pcy Condition x Condition Cartesian locus Range of result + to 1pc y = 0 x > 0 Positive x-axis 0 + to 1pc* y = +0 x > 0 Positive x-axis +0 + to 1pc* y = -0 x > 0 Positive x-axis -0 + to 1pc y > 0 x > 0 Quadrant I 0 < result < \pi/2 + to 1pc y > 0 x = 0 Positive y-axis \pi/2 + to 1pc y > 0 x < 0 Quadrant II \pi/2 < result < \pi + to 1pc y = 0 x < 0 Negative x-axis \pi + to 1pc* y = +0 x < 0 Negative x-axis +\pi + to 1pc* y = -0 x < 0 Negative x-axis -\pi + to 1pc y < 0 x < 0 Quadrant III -\pi < result < -\pi/2 + to 1pc y < 0 x = 0 Negative y-axis -\pi/2 + to 1pc y < 0 x > 0 Quadrant IV -\pi/2 < result < 0 + to 1pc y = 0 x = 0 Origin undefined consequences + to 1pc* y = +0 x = +0 Origin +0 + to 1pc* y = -0 x = +0 Origin -0 + to 1pc* y = +0 x = -0 Origin +\pi + to 1pc* y = -0 x = -0 Origin -\pi + + Figure 12-14: Quadrant information for arc tangent + + +Examples:: +.......... + + (asin 0) => 0.0 + (acos #c(0 1)) => #C(1.5707963267948966 -0.8813735870195432) + (/ (atan 1 (sqrt 3)) 6) => 0.087266 + (atan #c(0 2)) => #C(-1.5707964 0.54930615) + +Exceptional Situations:: +........................ + +acos and asin should signal an error of type type-error if number is not +a number. atan should signal type-error if one argument is supplied and +that argument is not a number, or if two arguments are supplied and both +of those arguments are not reals. + + acos, asin, and atan might signal arithmetic-error. + +See Also:: +.......... + +*note log:: , *note sqrt:: , *note Rule of Float Substitutability:: + +Notes:: +....... + +The result of either asin or acos can be a complex even if number is not +a complex; this occurs when the absolute value of number is greater than +one. + + +File: gcl.info, Node: pi, Next: sinh, Prev: asin, Up: Numbers Dictionary + +12.2.22 pi [Constant Variable] +------------------------------ + +Value:: +....... + +an implementation-dependent long float. + +Description:: +............. + +The best long float approximation to the mathematical constant \pi. + +Examples:: +.......... + + ;; In each of the following computations, the precision depends + ;; on the implementation. Also, if `long float' is treated by + ;; the implementation as equivalent to some other float format + ;; (e.g., `double float') the exponent marker might be the marker + ;; for that equivalent (e.g., `D' instead of `L'). + pi => 3.141592653589793L0 + (cos pi) => -1.0L0 + + (defun sin-of-degrees (degrees) + (let ((x (if (floatp degrees) degrees (float degrees pi)))) + (sin (* x (/ (float pi x) 180))))) + +Notes:: +....... + +An approximation to \pi in some other precision can be obtained by +writing (float pi x), where x is a float of the desired precision, or by +writing (coerce pi type), where type is the desired type, such as +short-float. + + +File: gcl.info, Node: sinh, Next: *, Prev: pi, Up: Numbers Dictionary + +12.2.23 sinh, cosh, tanh, asinh, acosh, atanh [Function] +-------------------------------------------------------- + +'sinh' number => result + + 'cosh' number => result + + 'tanh' number => result + + 'asinh' number => result + + 'acosh' number => result + + 'atanh' number => result + +Arguments and Values:: +...................... + +number--a number. + + result--a number. + +Description:: +............. + +These functions compute the hyperbolic sine, cosine, tangent, arc sine, +arc cosine, and arc tangent functions, which are mathematically defined +for an argument x as given in Figure 12-15. + + Function Definition + Hyperbolic sine (e^x-e^-x)/2 + Hyperbolic cosine (e^x+e^-x)/2 + Hyperbolic tangent (e^x-e^-x)/(e^x+e^-x) + Hyperbolic arc sine log (x+\sqrt1+x^2) + Hyperbolic arc cosine 2 log (\sqrt(x+1)/2 + \sqrt(x-1)/2) + Hyperbolic arc tangent (log (1+x) - log (1-x))/2 + + Figure 12-15: Mathematical definitions for hyperbolic functions + + + The following definition for the inverse hyperbolic cosine determines +the range and branch cuts: + + arccosh z = 2 log (\sqrt(z+1)/2 + \sqrt(z-1)/2\Bigr). + + The branch cut for the inverse hyperbolic cosine function lies along +the real axis to the left of~1 (inclusive), extending indefinitely along +the negative real axis, continuous with quadrant II and (between 0 +and~1) with quadrant I. The range is that half-strip of the complex +plane containing numbers whose real part is non-negative and whose +imaginary part is between -\pi (exclusive) and~\pi (inclusive). A +number with real part zero is in the range if its imaginary part is +between zero (inclusive) and~\pi (inclusive). + + The following definition for the inverse hyperbolic sine determines +the range and branch cuts: + + arcsinh z = log (z+\sqrt1+z^2\Bigr). + + The branch cut for the inverse hyperbolic sine function is in two +pieces: one along the positive imaginary axis above i (inclusive), +continuous with quadrant I, and one along the negative imaginary axis +below -i (inclusive), continuous with quadrant III. The range is that +strip of the complex plane containing numbers whose imaginary part is +between -\pi/2 and~\pi/2. A number with imaginary part equal to -\pi/2 +is in the range if and only if its real part is non-positive; a number +with imaginary part equal to \pi/2 is in the range if and only if its +imaginary part is non-negative. + + The following definition for the inverse hyperbolic tangent +determines the range and branch cuts: + + arctanh z = log (1+z) - log (1-z)\over2. + + Note that: + + i arctan z = arctanh iz. + + The branch cut for the inverse hyperbolic tangent function is in two +pieces: one along the negative real axis to the left of -1 (inclusive), +continuous with quadrant III, and one along the positive real axis to +the right of~1 (inclusive), continuous with quadrant I. The points -1 +and~1 are excluded from the domain. The range is that strip of the +complex plane containing numbers whose imaginary part is between -\pi/2 +and \pi/2. A number with imaginary part equal to -\pi/2 is in the range +if and only if its real part is strictly negative; a number with +imaginary part equal to \pi/2 is in the range if and only if its +imaginary part is strictly positive. Thus the range of the inverse +hyperbolic tangent function is identical to that of the inverse +hyperbolic sine function with the points -\pi i/2 and~\pi i/2 excluded. + +Examples:: +.......... + + (sinh 0) => 0.0 + (cosh (complex 0 -1)) => #C(0.540302 -0.0) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if number is not a number. +Might signal arithmetic-error. + +See Also:: +.......... + +*note log:: , *note sqrt:: , *note Rule of Float Substitutability:: + +Notes:: +....... + +The result of acosh may be a complex even if number is not a complex; +this occurs when number is less than one. Also, the result of atanh may +be a complex even if number is not a complex; this occurs when the +absolute value of number is greater than one. + + The branch cut formulae are mathematically correct, assuming +completely accurate computation. Implementors should consult a good +text on numerical analysis. The formulae given above are not +necessarily the simplest ones for real-valued computations; they are +chosen to define the branch cuts in desirable ways for the complex case. + + +File: gcl.info, Node: *, Next: +, Prev: sinh, Up: Numbers Dictionary + +12.2.24 * [Function] +-------------------- + +'*' &rest numbers => product + +Arguments and Values:: +...................... + +number--a number. + + product--a number. + +Description:: +............. + +Returns the product of numbers, performing any necessary type +conversions in the process. If no numbers are supplied, 1 is returned. + +Examples:: +.......... + + (*) => 1 + (* 3 5) => 15 + (* 1.0 #c(22 33) 55/98) => #C(12.346938775510203 18.520408163265305) + +Exceptional Situations:: +........................ + +Might signal type-error if some argument is not a number. Might signal +arithmetic-error. + +See Also:: +.......... + +*note Numeric Operations::, *note Rational Computations::, *note +Floating-point Computations::, *note Complex Computations:: + + +File: gcl.info, Node: +, Next: -, Prev: *, Up: Numbers Dictionary + +12.2.25 + [Function] +-------------------- + +'+' &rest numbers => sum + +Arguments and Values:: +...................... + +number--a number. + + sum--a number. + +Description:: +............. + +Returns the sum of numbers, performing any necessary type conversions in +the process. If no numbers are supplied, 0 is returned. + +Examples:: +.......... + + (+) => 0 + (+ 1) => 1 + (+ 31/100 69/100) => 1 + (+ 1/5 0.8) => 1.0 + +Exceptional Situations:: +........................ + +Might signal type-error if some argument is not a number. Might signal +arithmetic-error. + +See Also:: +.......... + +*note Numeric Operations::, *note Rational Computations::, *note +Floating-point Computations::, *note Complex Computations:: + + +File: gcl.info, Node: -, Next: /, Prev: +, Up: Numbers Dictionary + +12.2.26 - [Function] +-------------------- + +'-' number => negation + + '-' minuend &rest subtrahends^+ => difference + +Arguments and Values:: +...................... + +number, minuend, subtrahend--a number. + + negation, difference--a number. + +Description:: +............. + +The function - performs arithmetic subtraction and negation. + + If only one number is supplied, the negation of that number is +returned. + + If more than one argument is given, it subtracts all of the +subtrahends from the minuend and returns the result. + + The function - performs necessary type conversions. + +Examples:: +.......... + + (- 55.55) => -55.55 + (- #c(3 -5)) => #C(-3 5) + (- 0) => 0 + (eql (- 0.0) -0.0) => true + (- #c(100 45) #c(0 45)) => 100 + (- 10 1 2 3 4) => 0 + +Exceptional Situations:: +........................ + +Might signal type-error if some argument is not a number. Might signal +arithmetic-error. + +See Also:: +.......... + +*note Numeric Operations::, *note Rational Computations::, *note +Floating-point Computations::, *note Complex Computations:: + + +File: gcl.info, Node: /, Next: 1+, Prev: -, Up: Numbers Dictionary + +12.2.27 / [Function] +-------------------- + +'/' number => reciprocal + + '/' numerator &rest denominators^+ => quotient + +Arguments and Values:: +...................... + +number, denominator--a non-zero number. + + numerator, quotient, reciprocal--a number. + +Description:: +............. + +The function / performs division or reciprocation. + + If no denominators are supplied, the function / returns the +reciprocal of number. + + If at least one denominator is supplied, the function / divides the +numerator by all of the denominators and returns the resulting quotient. + + If each argument is either an integer or a ratio, and the result is +not an integer, then it is a ratio. + + The function / performs necessary type conversions. + + If any argument is a float then the rules of floating-point contagion +apply; see *note Floating-point Computations::. + +Examples:: +.......... + + (/ 12 4) => 3 + (/ 13 4) => 13/4 + (/ -8) => -1/8 + (/ 3 4 5) => 3/20 + (/ 0.5) => 2.0 + (/ 20 5) => 4 + (/ 5 20) => 1/4 + (/ 60 -2 3 5.0) => -2.0 + (/ 2 #c(2 2)) => #C(1/2 -1/2) + +Exceptional Situations:: +........................ + +The consequences are unspecified if any argument other than the first is +zero. If there is only one argument, the consequences are unspecified +if it is zero. + + Might signal type-error if some argument is not a number. Might +signal division-by-zero if division by zero is attempted. Might signal +arithmetic-error. + +See Also:: +.......... + +*note floor:: , ceiling, truncate, round + + +File: gcl.info, Node: 1+, Next: abs, Prev: /, Up: Numbers Dictionary + +12.2.28 1+, 1- [Function] +------------------------- + +'1' + => number successor '1' - => number predecessor + +Arguments and Values:: +...................... + +number--a number. + + successor, predecessor--a number. + +Description:: +............. + +1+ returns a number that is one more than its argument number. 1- +returns a number that is one less than its argument number. + +Examples:: +.......... + + (1+ 99) => 100 + (1- 100) => 99 + (1+ (complex 0.0)) => #C(1.0 0.0) + (1- 5/3) => 2/3 + +Exceptional Situations:: +........................ + +Might signal type-error if its argument is not a number. Might signal +arithmetic-error. + +See Also:: +.......... + +*note incf:: , decf + +Notes:: +....... + + (1+ number) == (+ number 1) + (1- number) == (- number 1) + + Implementors are encouraged to make the performance of both the +previous expressions be the same. + + +File: gcl.info, Node: abs, Next: evenp, Prev: 1+, Up: Numbers Dictionary + +12.2.29 abs [Function] +---------------------- + +'abs' number => absolute-value + +Arguments and Values:: +...................... + +number--a number. + + absolute-value--a non-negative real. + +Description:: +............. + +abs returns the absolute value of number. + + If number is + + a real, + + the result is of the same type as number. + + If number is a complex, the result is a positive + + real + + with the same magnitude as number. The result can be a float + + [Reviewer Note by Barmar: Single-float.] even if number's components +are rationals and an exact rational result would have been possible. +Thus the result of (abs #c(3 4)) can be either 5 or 5.0, depending on +the implementation. + +Examples:: +.......... + + (abs 0) => 0 + (abs 12/13) => 12/13 + (abs -1.09) => 1.09 + (abs #c(5.0 -5.0)) => 7.071068 + (abs #c(5 5)) => 7.071068 + (abs #c(3/5 4/5)) => 1 or approximately 1.0 + (eql (abs -0.0) -0.0) => true + +See Also:: +.......... + +*note Rule of Float Substitutability:: + +Notes:: +....... + +If number is a complex, the result is equivalent to the following: + + (sqrt (+ (expt (realpart number) 2) (expt (imagpart number) 2))) + + An implementation should not use this formula directly for all +complexes but should handle very large or very small components +specially to avoid intermediate overflow or underflow. + + +File: gcl.info, Node: evenp, Next: exp, Prev: abs, Up: Numbers Dictionary + +12.2.30 evenp, oddp [Function] +------------------------------ + +'evenp' integer => generalized-boolean + + 'oddp' integer => generalized-boolean + +Arguments and Values:: +...................... + +integer--an integer. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +evenp returns true if integer is even (divisible by two); otherwise, +returns false. + + oddp returns true if integer is odd (not divisible by two); +otherwise, returns false. + +Examples:: +.......... + + (evenp 0) => true + (oddp 10000000000000000000000) => false + (oddp -1) => true + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if integer is not an integer. + +Notes:: +....... + + (evenp integer) == (not (oddp integer)) + (oddp integer) == (not (evenp integer)) + + +File: gcl.info, Node: exp, Next: gcd, Prev: evenp, Up: Numbers Dictionary + +12.2.31 exp, expt [Function] +---------------------------- + +'exp' number => result + + 'expt' base-number power-number => result + +Arguments and Values:: +...................... + +number--a number. + + base-number--a number. + + power-number--a number. + + result--a number. + +Description:: +............. + +exp and expt perform exponentiation. + + exp returns e raised to the power number, where e is the base of the +natural logarithms. exp has no branch cut. + + expt returns base-number raised to the power power-number. If the +base-number is a rational and power-number is an integer, the +calculation is exact and the result will be of type rational; otherwise +a floating-point approximation might result. + + For expt of a complex rational to an integer power, the calculation +must be exact and the result is of type (or rational (complex +rational)). + + The result of expt can be a complex, even when neither argument is a +complex, if base-number is negative and power-number is not an integer. +The result is always the principal complex value. For example, (expt -8 +1/3) is not permitted to return -2, even though -2 is one of the cube +roots of -8. The principal cube root is a complex approximately equal +to #C(1.0 1.73205), not -2. + + expt is defined as b^x = e^x log b\/. This defines the principal +values precisely. The range of expt is the entire complex plane. +Regarded as a function of x, with b fixed, there is no branch cut. +Regarded as a function of b, with x fixed, there is in general a branch +cut along the negative real axis, continuous with quadrant II. The +domain excludes the origin. By definition, 0^0=1. If b=0 and the real +part of x is strictly positive, then b^x=0. For all other values of x, +0^x is an error. + + When power-number is an integer 0, then the result is always the +value one in the type of base-number, even if the base-number is zero +(of any type). That is: + + (expt x 0) == (coerce 1 (type-of x)) + + If power-number is a zero of any other type, then the result is also +the value one, in the type of the arguments after the application of the +contagion rules in *note Contagion in Numeric Operations::, with one +exception: the consequences are undefined if base-number is zero when +power-number is zero and not of type integer. + +Examples:: +.......... + + (exp 0) => 1.0 + (exp 1) => 2.718282 + (exp (log 5)) => 5.0 + (expt 2 8) => 256 + (expt 4 .5) => 2.0 + (expt #c(0 1) 2) => -1 + (expt #c(2 2) 3) => #C(-16 16) + (expt #c(2 2) 4) => -64 + +See Also:: +.......... + +*note log:: , *note Rule of Float Substitutability:: + +Notes:: +....... + +Implementations of expt are permitted to use different algorithms for +the cases of a power-number of type rational and a power-number of type +float. + + Note that by the following logic, (sqrt (expt x 3)) is not equivalent +to (expt x 3/2). + + (setq x (exp (/ (* 2 pi #c(0 1)) 3))) ;exp(2.pi.i/3) + (expt x 3) => 1 ;except for round-off error + (sqrt (expt x 3)) => 1 ;except for round-off error + (expt x 3/2) => -1 ;except for round-off error + + +File: gcl.info, Node: gcd, Next: incf, Prev: exp, Up: Numbers Dictionary + +12.2.32 gcd [Function] +---------------------- + +'gcd' &rest integers => greatest-common-denominator + +Arguments and Values:: +...................... + +integer--an integer. + + greatest-common-denominator--a non-negative integer. + +Description:: +............. + +Returns the greatest common divisor of integers. If only one integer is +supplied, its absolute value is returned. If no integers are given, gcd +returns 0, which is an identity for this operation. + +Examples:: +.......... + + (gcd) => 0 + (gcd 60 42) => 6 + (gcd 3333 -33 101) => 1 + (gcd 3333 -33 1002001) => 11 + (gcd 91 -49) => 7 + (gcd 63 -42 35) => 7 + (gcd 5) => 5 + (gcd -4) => 4 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if any integer is not an +integer. + +See Also:: +.......... + +*note lcm:: + +Notes:: +....... + +For three or more arguments, + + (gcd b c ... z) == (gcd (gcd a b) c ... z) + + +File: gcl.info, Node: incf, Next: lcm, Prev: gcd, Up: Numbers Dictionary + +12.2.33 incf, decf [Macro] +-------------------------- + +'incf' place [delta-form] => new-value + + 'decf' place [delta-form] => new-value + +Arguments and Values:: +...................... + +place--a place. + + delta-form--a form; evaluated to produce a delta. The default is 1. + + delta--a number. + + new-value--a number. + +Description:: +............. + +incf and decf are used for incrementing and decrementing the value of +place, respectively. + + The delta is added to (in the case of incf) or subtracted from (in +the case of decf) the number in place and the result is stored in place. + + Any necessary type conversions are performed automatically. + + For information about the evaluation of subforms of places, see *note +Evaluation of Subforms to Places::. + +Examples:: +.......... + + (setq n 0) + (incf n) => 1 + n => 1 + (decf n 3) => -2 + n => -2 + (decf n -5) => 3 + (decf n) => 2 + (incf n 0.5) => 2.5 + (decf n) => 1.5 + n => 1.5 + +Side Effects:: +.............. + +Place is modified. + +See Also:: +.......... + ++, *note -:: , 1+, 1-, *note setf:: + + +File: gcl.info, Node: lcm, Next: log, Prev: incf, Up: Numbers Dictionary + +12.2.34 lcm [Function] +---------------------- + +'lcm' &rest integers => least-common-multiple + +Arguments and Values:: +...................... + +integer--an integer. + + least-common-multiple--a non-negative integer. + +Description:: +............. + +lcm returns the least common multiple of the integers. + + If no integer is supplied, the integer 1 is returned. + + If only one integer is supplied, the absolute value of that integer +is returned. + + For two arguments that are not both zero, + + (lcm a b) == (/ (abs (* a b)) (gcd a b)) + + If one or both arguments are zero, + + (lcm a 0) == (lcm 0 a) == 0 + + For three or more arguments, + + (lcm a b c ... z) == (lcm (lcm a b) c ... z) + +Examples:: +.......... + + (lcm 10) => 10 + (lcm 25 30) => 150 + (lcm -24 18 10) => 360 + (lcm 14 35) => 70 + (lcm 0 5) => 0 + (lcm 1 2 3 4 5 6) => 60 + +Exceptional Situations:: +........................ + +Should signal type-error if any argument is not an integer. + +See Also:: +.......... + +*note gcd:: + + +File: gcl.info, Node: log, Next: mod (Function), Prev: lcm, Up: Numbers Dictionary + +12.2.35 log [Function] +---------------------- + +'log' number &optional base => logarithm + +Arguments and Values:: +...................... + +number--a non-zero number. + + base--a number. + + logarithm--a number. + +Description:: +............. + +log returns the logarithm of number in base base. If base is not +supplied its value is e, the base of the natural logarithms. + + log may return a complex when given a + + real + + negative number. + + (log -1.0) == (complex 0.0 (float pi 0.0)) + + If base is zero, log returns zero. + + The result of (log 8 2) may be either 3 or 3.0, depending on the +implementation. An implementation can use floating-point calculations +even if an exact integer result is possible. + + The branch cut for the logarithm function of one argument (natural +logarithm) lies along the negative real axis, continuous with quadrant +II. The domain excludes the origin. + + The mathematical definition of a complex logarithm is as follows, +whether or not minus zero is supported by the implementation: + + (log x) == (complex (log (abs x)) (phase x)) + + Therefore the range of the one-argument logarithm function is that +strip of the complex plane containing numbers with imaginary parts +between + + -\pi (exclusive) and~\pi (inclusive) if minus zero is not supported, +or -\pi (inclusive) and~\pi (inclusive) if minus zero is supported. + + The two-argument logarithm function is defined as + + (log base number) + == (/ (log number) (log base)) + + This defines the principal values precisely. The range of the +two-argument logarithm function is the entire complex plane. + +Examples:: +.......... + + (log 100 10) + => 2.0 + => 2 + (log 100.0 10) => 2.0 + (log #c(0 1) #c(0 -1)) + => #C(-1.0 0.0) + OR=> #C(-1 0) + (log 8.0 2) => 3.0 + + (log #c(-16 16) #c(2 2)) => 3 or approximately #c(3.0 0.0) + or approximately 3.0 (unlikely) + +Affected By:: +............. + +The implementation. + +See Also:: +.......... + +*note exp:: , expt, *note Rule of Float Substitutability:: + + +File: gcl.info, Node: mod (Function), Next: signum, Prev: log, Up: Numbers Dictionary + +12.2.36 mod, rem [Function] +--------------------------- + +'mod' number divisor => modulus + + 'rem' number divisor => remainder + +Arguments and Values:: +...................... + +number--a real. + + divisor--a real. + + modulus, remainder--a real. + +Description:: +............. + +mod and rem are generalizations of the modulus and remainder functions +respectively. + + mod performs the operation floor on number and divisor and returns +the remainder of the floor operation. + + rem performs the operation truncate on number and divisor and returns +the remainder of the truncate operation. + + mod and rem are the modulus and remainder functions when number and +divisor are integers. + +Examples:: +.......... + + (rem -1 5) => -1 + (mod -1 5) => 4 + (mod 13 4) => 1 + (rem 13 4) => 1 + (mod -13 4) => 3 + (rem -13 4) => -1 + (mod 13 -4) => -3 + (rem 13 -4) => 1 + (mod -13 -4) => -1 + (rem -13 -4) => -1 + (mod 13.4 1) => 0.4 + (rem 13.4 1) => 0.4 + (mod -13.4 1) => 0.6 + (rem -13.4 1) => -0.4 + +See Also:: +.......... + +*note floor:: , truncate + +Notes:: +....... + +The result of mod is either zero or a + + real + + with the same sign as divisor. + + +File: gcl.info, Node: signum, Next: sqrt, Prev: mod (Function), Up: Numbers Dictionary + +12.2.37 signum [Function] +------------------------- + +'signum' number => signed-prototype + +Arguments and Values:: +...................... + +number--a number. + + signed-prototype--a number. + +Description:: +............. + +signum determines a numerical value that indicates whether number is +negative, zero, or positive. + + For a rational, signum returns one of -1, 0, or 1 according to +whether number is negative, zero, or positive. For a float, the result +is a float of the same format whose value is minus one, zero, or one. +For a complex number z, (signum z) is a complex number of the same phase +but with unit magnitude, unless z is a complex zero, in which case the +result is z. + + For rational arguments, signum is a rational function, but it may be +irrational for complex arguments. + + If number is a float, the result is a float. If number is a +rational, the result is a rational. If number is a complex float, the +result is a complex float. If number is a complex rational, the result +is a complex, but it is implementation-dependent whether that result is +a complex rational or a complex float. + +Examples:: +.......... + + (signum 0) => 0 + (signum 99) => 1 + (signum 4/5) => 1 + (signum -99/100) => -1 + (signum 0.0) => 0.0 + (signum #c(0 33)) => #C(0.0 1.0) + (signum #c(7.5 10.0)) => #C(0.6 0.8) + (signum #c(0.0 -14.7)) => #C(0.0 -1.0) + (eql (signum -0.0) -0.0) => true + +See Also:: +.......... + +*note Rule of Float Substitutability:: + +Notes:: +....... + + (signum x) == (if (zerop x) x (/ x (abs x))) + + +File: gcl.info, Node: sqrt, Next: random-state, Prev: signum, Up: Numbers Dictionary + +12.2.38 sqrt, isqrt [Function] +------------------------------ + +'sqrt' number => root + + 'isqrt' natural => natural-root + +Arguments and Values:: +...................... + +number, root--a number. + + natural, natural-root--a non-negative integer. + +Description:: +............. + +sqrt and isqrt compute square roots. + + sqrt returns the principal square root of number. If the number is +not a complex but is negative, then the result is a complex. + + isqrt returns the greatest integer less than or equal to the exact +positive square root of natural. + + If number is a positive rational, it is implementation-dependent +whether root is a rational or a float. If number is a negative +rational, it is implementation-dependent whether root is a complex +rational or a complex float. + + The mathematical definition of complex square root (whether or not +minus zero is supported) follows: + + (sqrt x) = (exp (/ (log x) 2)) + + The branch cut for square root lies along the negative real axis, +continuous with quadrant II. The range consists of the right half-plane, +including the non-negative imaginary axis and excluding the negative +imaginary axis. + +Examples:: +.......... + + (sqrt 9.0) => 3.0 + (sqrt -9.0) => #C(0.0 3.0) + (isqrt 9) => 3 + (sqrt 12) => 3.4641016 + (isqrt 12) => 3 + (isqrt 300) => 17 + (isqrt 325) => 18 + (sqrt 25) + => 5 + OR=> 5.0 + (isqrt 25) => 5 + (sqrt -1) => #C(0.0 1.0) + (sqrt #c(0 2)) => #C(1.0 1.0) + +Exceptional Situations:: +........................ + +The function sqrt should signal type-error if its argument is not a +number. + + The function isqrt should signal type-error if its argument is not a +non-negative integer. + + The functions sqrt and isqrt might signal arithmetic-error. + +See Also:: +.......... + +*note exp:: , *note log:: , *note Rule of Float Substitutability:: + +Notes:: +....... + + (isqrt x) == (values (floor (sqrt x))) + + but it is potentially more efficient. + + +File: gcl.info, Node: random-state, Next: make-random-state, Prev: sqrt, Up: Numbers Dictionary + +12.2.39 random-state [System Class] +----------------------------------- + +Class Precedence List:: +....................... + +random-state, t + +Description:: +............. + +A random state object contains state information used by the +pseudo-random number generator. The nature of a random state object is +implementation-dependent. It can be printed out and successfully read +back in by the same implementation, but might not function correctly as +a random state in another implementation. + + Implementations are required to provide a read syntax for objects of +type random-state, but the specific nature of that syntax is +implementation-dependent. + +See Also:: +.......... + +*note random-state:: , *note random:: , *note Printing Random States:: + + +File: gcl.info, Node: make-random-state, Next: random, Prev: random-state, Up: Numbers Dictionary + +12.2.40 make-random-state [Function] +------------------------------------ + +'make-random-state' &optional state => new-state + +Arguments and Values:: +...................... + +state--a random state, or nil, or t. The default is nil. + + new-state--a random state object. + +Description:: +............. + +Creates a fresh object of type random-state suitable for use as the +value of *random-state*. + + If state is a random state object, the new-state is a copy_5 of that +object. If state is nil, the new-state is a copy_5 of the current +random state. If state is t, the new-state is a fresh random state +object that has been randomly initialized by some means. + +Examples:: +.......... + + (let* ((rs1 (make-random-state nil)) + (rs2 (make-random-state t)) + (rs3 (make-random-state rs2)) + (rs4 nil)) + (list (loop for i from 1 to 10 + collect (random 100) + when (= i 5) + do (setq rs4 (make-random-state))) + (loop for i from 1 to 10 collect (random 100 rs1)) + (loop for i from 1 to 10 collect (random 100 rs2)) + (loop for i from 1 to 10 collect (random 100 rs3)) + (loop for i from 1 to 10 collect (random 100 rs4)))) + => ((29 25 72 57 55 68 24 35 54 65) + (29 25 72 57 55 68 24 35 54 65) + (93 85 53 99 58 62 2 23 23 59) + (93 85 53 99 58 62 2 23 23 59) + (68 24 35 54 65 54 55 50 59 49)) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if state is not a random +state, or nil, or t. + +See Also:: +.......... + +*note random:: , *note random-state:: + +Notes:: +....... + +One important use of make-random-state is to allow the same series of +pseudo-random numbers to be generated many times within a single +program. + + +File: gcl.info, Node: random, Next: random-state-p, Prev: make-random-state, Up: Numbers Dictionary + +12.2.41 random [Function] +------------------------- + +'random' limit &optional random-state => random-number + +Arguments and Values:: +...................... + +limit--a positive integer, or a positive float. + + random-state--a random state. The default is the current random +state. + + random-number--a non-negative number less than limit and of the same +type as limit. + +Description:: +............. + +Returns a pseudo-random number that is a non-negative number less than +limit and of the same type as limit. + + The random-state, which is modified by this function, encodes the +internal state maintained by the random number generator. + + An approximately uniform choice distribution is used. If limit is an +integer, each of the possible results occurs with (approximate) +probability 1/limit. + +Examples:: +.......... + + (<= 0 (random 1000) 1000) => true + (let ((state1 (make-random-state)) + (state2 (make-random-state))) + (= (random 1000 state1) (random 1000 state2))) => true + +Side Effects:: +.............. + +The random-state is modified. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if limit is not a positive +integer or a positive real. + +See Also:: +.......... + +*note make-random-state:: , *note random-state:: + +Notes:: +....... + +See Common Lisp: The Language for information about generating random +numbers. + + +File: gcl.info, Node: random-state-p, Next: *random-state*, Prev: random, Up: Numbers Dictionary + +12.2.42 random-state-p [Function] +--------------------------------- + +'random-state-p' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type random-state; otherwise, returns +false. + +Examples:: +.......... + + (random-state-p *random-state*) => true + (random-state-p (make-random-state)) => true + (random-state-p 'test-function) => false + +See Also:: +.......... + +*note make-random-state:: , *note random-state:: + +Notes:: +....... + + (random-state-p object) == (typep object 'random-state) + + +File: gcl.info, Node: *random-state*, Next: numberp, Prev: random-state-p, Up: Numbers Dictionary + +12.2.43 *random-state* [Variable] +--------------------------------- + +Value Type:: +............ + +a random state. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The current random state, which is used, for example, by the function +random when a random state is not explicitly supplied. + +Examples:: +.......... + + (random-state-p *random-state*) => true + (setq snap-shot (make-random-state)) + ;; The series from any given point is random, + ;; but if you backtrack to that point, you get the same series. + (list (loop for i from 1 to 10 collect (random)) + (let ((*random-state* snap-shot)) + (loop for i from 1 to 10 collect (random))) + (loop for i from 1 to 10 collect (random)) + (let ((*random-state* snap-shot)) + (loop for i from 1 to 10 collect (random)))) + => ((19 16 44 19 96 15 76 96 13 61) + (19 16 44 19 96 15 76 96 13 61) + (16 67 0 43 70 79 58 5 63 50) + (16 67 0 43 70 79 58 5 63 50)) + +Affected By:: +............. + +The implementation. + + random. + +See Also:: +.......... + +*note make-random-state:: , *note random:: , random-state + +Notes:: +....... + +Binding *random-state* to a different random state object correctly +saves and restores the old random state object. + + +File: gcl.info, Node: numberp, Next: cis, Prev: *random-state*, Up: Numbers Dictionary + +12.2.44 numberp [Function] +-------------------------- + +'numberp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type number; otherwise, returns false. + +Examples:: +.......... + + (numberp 12) => true + (numberp (expt 2 130)) => true + (numberp #c(5/3 7.2)) => true + (numberp nil) => false + (numberp (cons 1 2)) => false + +Notes:: +....... + + (numberp object) == (typep object 'number) + + +File: gcl.info, Node: cis, Next: complex, Prev: numberp, Up: Numbers Dictionary + +12.2.45 cis [Function] +---------------------- + +'cis' radians => number + +Arguments and Values:: +...................... + +radians--a real. + + number--a complex. + +Description:: +............. + +cis returns the value of~e^i\cdot radians, which is a complex in which +the real part is equal to the cosine of radians, and the imaginary part +is equal to the sine of radians. + +Examples:: +.......... + + (cis 0) => #C(1.0 0.0) + +See Also:: +.......... + +*note Rule of Float Substitutability:: + + +File: gcl.info, Node: complex, Next: complexp, Prev: cis, Up: Numbers Dictionary + +12.2.46 complex [Function] +-------------------------- + +'complex' realpart &optional imagpart => complex + +Arguments and Values:: +...................... + +realpart--a real. + + imagpart--a real. + + complex--a rational or a complex. + +Description:: +............. + +complex returns a number whose real part is realpart and whose imaginary +part is imagpart. + + If realpart is a rational and imagpart is the rational number zero, +the result of complex is realpart, a rational. Otherwise, the result is +a complex. + + If either realpart or imagpart is a float, the non-float is converted +to a float before the complex is created. If imagpart is not supplied, +the imaginary part is a zero of the same type as realpart; i.e., (coerce +0 (type-of realpart)) is effectively used. + + Type upgrading implies a movement upwards in the type hierarchy +lattice. In the case of complexes, the type-specifier + + [Reviewer Note by Barmar: What type specifier?] must be a subtype of +(upgraded-complex-part-type type-specifier). If type-specifier1 is a +subtype of type-specifier2, then (upgraded-complex-element-type +'type-specifier1) must also be a subtype of +(upgraded-complex-element-type 'type-specifier2). Two disjoint types +can be upgraded into the same thing. + +Examples:: +.......... + + (complex 0) => 0 + (complex 0.0) => #C(0.0 0.0) + (complex 1 1/2) => #C(1 1/2) + (complex 1 .99) => #C(1.0 0.99) + (complex 3/2 0.0) => #C(1.5 0.0) + +See Also:: +.......... + +*note realpart:: , imagpart + +Notes:: +....... + + #c(a b) == #.(complex a b) + + +File: gcl.info, Node: complexp, Next: conjugate, Prev: complex, Up: Numbers Dictionary + +12.2.47 complexp [Function] +--------------------------- + +'complexp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type complex; otherwise, returns false. + +Examples:: +.......... + + (complexp 1.2d2) => false + (complexp #c(5/3 7.2)) => true + + +See Also:: +.......... + +*note complex:: (function and type), *note typep:: + +Notes:: +....... + + (complexp object) == (typep object 'complex) + + +File: gcl.info, Node: conjugate, Next: phase, Prev: complexp, Up: Numbers Dictionary + +12.2.48 conjugate [Function] +---------------------------- + +'conjugate' number => conjugate + +Arguments and Values:: +...................... + +number--a number. + + conjugate--a number. + +Description:: +............. + +Returns the complex conjugate of number. The conjugate of a + + real + + number is itself. + +Examples:: +.......... + + (conjugate #c(0 -1)) => #C(0 1) + (conjugate #c(1 1)) => #C(1 -1) + (conjugate 1.5) => 1.5 + (conjugate #C(3/5 4/5)) => #C(3/5 -4/5) + (conjugate #C(0.0D0 -1.0D0)) => #C(0.0D0 1.0D0) + (conjugate 3.7) => 3.7 + +Notes:: +....... + +For a complex number z, + + (conjugate z) == (complex (realpart z) (- (imagpart z))) + + +File: gcl.info, Node: phase, Next: realpart, Prev: conjugate, Up: Numbers Dictionary + +12.2.49 phase [Function] +------------------------ + +'phase' number => phase + +Arguments and Values:: +...................... + +number--a number. + + phase--a number. + +Description:: +............. + +phase returns the phase of number (the angle part of its polar +representation) in radians, in the range + + -\pi (exclusive) if minus zero is not supported, or -\pi (inclusive) +if minus zero is supported, + + to \pi (inclusive). The phase of a positive + + real + + number is zero; that of a negative + + real + + number is \pi. The phase of zero is defined to be zero. + + If number is a complex float, the result is a float of the same type +as the components of number. If number is a float, the result is a +float of the same type. If number is a rational or a complex rational, +the result is a single float. + + The branch cut for phase lies along the negative real axis, +continuous with quadrant II. The range consists of that portion of the +real axis between -\pi (exclusive) and~\pi (inclusive). + + The mathematical definition of phase is as follows: + + (phase x) = (atan (imagpart x) (realpart x)) + +Examples:: +.......... + + (phase 1) => 0.0s0 + (phase 0) => 0.0s0 + (phase (cis 30)) => -1.4159266 + (phase #c(0 1)) => 1.5707964 + +Exceptional Situations:: +........................ + +Should signal type-error if its argument is not a number. Might signal +arithmetic-error. + +See Also:: +.......... + +*note Rule of Float Substitutability:: + + +File: gcl.info, Node: realpart, Next: upgraded-complex-part-type, Prev: phase, Up: Numbers Dictionary + +12.2.50 realpart, imagpart [Function] +------------------------------------- + +'realpart' number => real + + 'imagpart' number => real + +Arguments and Values:: +...................... + +number--a number. + + real--a real. + +Description:: +............. + +realpart and imagpart return the real and imaginary parts of number +respectively. If number is + + real, + + then realpart returns number and imagpart returns (* 0 number), which +has the effect that the imaginary part of a rational is 0 and that of a +float is a floating-point zero of the same format. + +Examples:: +.......... + + (realpart #c(23 41)) => 23 + (imagpart #c(23 41.0)) => 41.0 + (realpart #c(23 41.0)) => 23.0 + (imagpart 23.0) => 0.0 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if number is not a number. + +See Also:: +.......... + +*note complex:: + + +File: gcl.info, Node: upgraded-complex-part-type, Next: realp, Prev: realpart, Up: Numbers Dictionary + +12.2.51 upgraded-complex-part-type [Function] +--------------------------------------------- + +'upgraded-complex-part-type' typespec &optional environment => +upgraded-typespec + +Arguments and Values:: +...................... + +typespec--a type specifier. + + environment--an environment object. The default is nil, denoting the +null lexical environment and the and current global environment. + + upgraded-typespec--a type specifier. + +Description:: +............. + +upgraded-complex-part-type returns the part type of the most specialized +complex number representation that can hold parts of type typespec. + + The typespec is a subtype of (and possibly type equivalent to) the +upgraded-typespec. + + The purpose of upgraded-complex-part-type is to reveal how an +implementation does its upgrading. + +See Also:: +.......... + +*note complex:: (function and type) + +Notes:: +....... + + +File: gcl.info, Node: realp, Next: numerator, Prev: upgraded-complex-part-type, Up: Numbers Dictionary + +12.2.52 realp [Function] +------------------------ + +'realp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type real; otherwise, returns false. + +Examples:: +.......... + + (realp 12) => true + (realp #c(5/3 7.2)) => false + (realp nil) => false + (realp (cons 1 2)) => false + +Notes:: +....... + + (realp object) == (typep object 'real) + + +File: gcl.info, Node: numerator, Next: rational (Function), Prev: realp, Up: Numbers Dictionary + +12.2.53 numerator, denominator [Function] +----------------------------------------- + +'numerator' rational => numerator + + 'denominator' rational => denominator + +Arguments and Values:: +...................... + +rational--a rational. + + numerator--an integer. + + denominator--a positive integer. + +Description:: +............. + +numerator and denominator reduce rational to canonical form and compute +the numerator or denominator of that number. + + numerator and denominator return the numerator or denominator of the +canonical form of rational. + + If rational is an integer, numerator returns rational and denominator +returns 1. + +Examples:: +.......... + + (numerator 1/2) => 1 + (denominator 12/36) => 3 + (numerator -1) => -1 + (denominator (/ -33)) => 33 + (numerator (/ 8 -6)) => -4 + (denominator (/ 8 -6)) => 3 + +See Also:: +.......... + +*note /:: + +Notes:: +....... + + (gcd (numerator x) (denominator x)) => 1 + + +File: gcl.info, Node: rational (Function), Next: rationalp, Prev: numerator, Up: Numbers Dictionary + +12.2.54 rational, rationalize [Function] +---------------------------------------- + +'rational' number => rational + + 'rationalize' number => rational + +Arguments and Values:: +...................... + +number--a real. + + rational--a rational. + +Description:: +............. + +rational and rationalize convert + + reals + + to rationals. + + If number is already rational, it is returned. + + If number is a float, rational returns a rational that is +mathematically equal in value to the float. rationalize returns a +rational that approximates the float to the accuracy of the underlying +floating-point representation. + + rational assumes that the float is completely accurate. + + rationalize assumes that the float is accurate only to the precision +of the floating-point representation. + +Examples:: +.......... + + (rational 0) => 0 + (rationalize -11/100) => -11/100 + (rational .1) => 13421773/134217728 ;implementation-dependent + (rationalize .1) => 1/10 + +Affected By:: +............. + +The implementation. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if number is not a real. +Might signal arithmetic-error. + +Notes:: +....... + +It is always the case that + + (float (rational x) x) == x + + and + + (float (rationalize x) x) == x + + That is, rationalizing a float by either method and then converting +it back to a float of the same format produces the original number. + + +File: gcl.info, Node: rationalp, Next: ash, Prev: rational (Function), Up: Numbers Dictionary + +12.2.55 rationalp [Function] +---------------------------- + +'rationalp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type rational; otherwise, returns false. + +Examples:: +.......... + + (rationalp 12) => true + (rationalp 6/5) => true + (rationalp 1.212) => false + +See Also:: +.......... + +*note rational (Function):: + +Notes:: +....... + + (rationalp object) == (typep object 'rational) + + +File: gcl.info, Node: ash, Next: integer-length, Prev: rationalp, Up: Numbers Dictionary + +12.2.56 ash [Function] +---------------------- + +'ash' integer count => shifted-integer + +Arguments and Values:: +...................... + +integer--an integer. + + count--an integer. + + shifted-integer--an integer. + +Description:: +............. + +ash performs the arithmetic shift operation on the binary representation +of integer, which is treated as if it were binary. + + ash shifts integer arithmetically left by count bit positions if +count is positive, or right count bit positions if count is negative. +The shifted value of the same sign as integer is returned. + + Mathematically speaking, ash performs the computation +floor(integer\cdot 2^count). Logically, ash moves all of the bits in +integer to the left, adding zero-bits at the right, or moves them to the +right, discarding bits. + + ash is defined to behave as if integer were represented in two's +complement form, regardless of how integers are represented internally. + +Examples:: +.......... + + (ash 16 1) => 32 + (ash 16 0) => 16 + (ash 16 -1) => 8 + (ash -100000000000000000000000000000000 -100) => -79 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if integer is not an integer. +Should signal an error of type type-error if count is not an integer. +Might signal arithmetic-error. + +Notes:: +....... + + (logbitp j (ash n k)) + == (and (>= j k) (logbitp (- j k) n)) + + +File: gcl.info, Node: integer-length, Next: integerp, Prev: ash, Up: Numbers Dictionary + +12.2.57 integer-length [Function] +--------------------------------- + +'integer-length' integer => number-of-bits + +Arguments and Values:: +...................... + +integer--an integer. + + number-of-bits--a non-negative integer. + +Description:: +............. + +Returns the number of bits needed to represent integer in binary +two's-complement format. + +Examples:: +.......... + + (integer-length 0) => 0 + (integer-length 1) => 1 + (integer-length 3) => 2 + (integer-length 4) => 3 + (integer-length 7) => 3 + (integer-length -1) => 0 + (integer-length -4) => 2 + (integer-length -7) => 3 + (integer-length -8) => 3 + (integer-length (expt 2 9)) => 10 + (integer-length (1- (expt 2 9))) => 9 + (integer-length (- (expt 2 9))) => 9 + (integer-length (- (1+ (expt 2 9)))) => 10 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if integer is not an integer. + +Notes:: +....... + +This function could have been defined by: + + (defun integer-length (integer) + (ceiling (log (if (minusp integer) + (- integer) + (1+ integer)) + 2))) + + If integer is non-negative, then its value can be represented in +unsigned binary form in a field whose width in bits is no smaller than +(integer-length integer). Regardless of the sign of integer, its value +can be represented in signed binary two's-complement form in a field +whose width in bits is no smaller than (+ (integer-length integer) 1). + + +File: gcl.info, Node: integerp, Next: parse-integer, Prev: integer-length, Up: Numbers Dictionary + +12.2.58 integerp [Function] +--------------------------- + +'integerp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type integer; otherwise, returns false. + +Examples:: +.......... + + (integerp 1) => true + (integerp (expt 2 130)) => true + (integerp 6/5) => false + (integerp nil) => false + + +Notes:: +....... + + (integerp object) == (typep object 'integer) + + +File: gcl.info, Node: parse-integer, Next: boole, Prev: integerp, Up: Numbers Dictionary + +12.2.59 parse-integer [Function] +-------------------------------- + +'parse-integer' string &key start end radix junk-allowed => integer, pos + +Arguments and Values:: +...................... + +string--a string. + + start, end--bounding index designators of string. The defaults for +start and end are 0 and nil, respectively. + + radix--a radix. The default is 10. + + junk-allowed--a generalized boolean. The default is false. + + integer--an integer or false. + + pos--a bounding index of string. + +Description:: +............. + +parse-integer parses an integer in the specified radix from the +substring of string delimited by start and end. + + parse-integer expects an optional sign (+ or -) followed by a a +non-empty sequence of digits to be interpreted in the specified radix. +Optional leading and trailing whitespace_1 is ignored. + + parse-integer does not recognize the syntactic radix-specifier +prefixes #O, #B, #X, and #nR, nor does it recognize a trailing decimal +point. + + If junk-allowed is false, an error of type parse-error is signaled if +substring does not consist entirely of the representation of a signed +integer, possibly surrounded on either side by whitespace_1 characters. + + The first value returned is either the integer that was parsed, or +else nil if no syntactically correct integer was seen but junk-allowed +was true. + + The second value is either the index into the string of the delimiter +that terminated the parse, or the upper bounding index of the substring +if the parse terminated at the end of the substring (as is always the +case if junk-allowed is false). + +Examples:: +.......... + + (parse-integer "123") => 123, 3 + (parse-integer "123" :start 1 :radix 5) => 13, 3 + (parse-integer "no-integer" :junk-allowed t) => NIL, 0 + +Exceptional Situations:: +........................ + +If junk-allowed is false, an error is signaled if substring does not +consist entirely of the representation of an integer, possibly +surrounded on either side by whitespace_1 characters. + + +File: gcl.info, Node: boole, Next: boole-1, Prev: parse-integer, Up: Numbers Dictionary + +12.2.60 boole [Function] +------------------------ + +'boole' op integer-1 integer-2 => result-integer + +Arguments and Values:: +...................... + +Op--a bit-wise logical operation specifier. + + integer-1--an integer. + + integer-2--an integer. + + result-integer--an integer. + +Description:: +............. + +boole performs bit-wise logical operations on integer-1 and integer-2, +which are treated as if they were binary and in two's complement +representation. + + The operation to be performed and the return value are determined by +op. + + boole returns the values specified for any op in Figure 12-16. + + Op Result + boole-1 integer-1 + boole-2 integer-2 + boole-andc1 and complement of integer-1 with integer-2 + boole-andc2 and integer-1 with complement of integer-2 + boole-and and + boole-c1 complement of integer-1 + boole-c2 complement of integer-2 + boole-clr always 0 (all zero bits) + boole-eqv equivalence (exclusive nor) + boole-ior inclusive or + boole-nand not-and + boole-nor not-or + boole-orc1 or complement of integer-1 with integer-2 + boole-orc2 or integer-1 with complement of integer-2 + boole-set always -1 (all one bits) + boole-xor exclusive or + + Figure 12-16: Bit-Wise Logical Operations + + +Examples:: +.......... + + (boole boole-ior 1 16) => 17 + (boole boole-and -2 5) => 4 + (boole boole-eqv 17 15) => -31 + + ;;; These examples illustrate the result of applying BOOLE and each + ;;; of the possible values of OP to each possible combination of bits. + (progn + (format t "~&Results of (BOOLE #b0011 #b0101) ...~ + ~ + (dolist (symbol '(boole-1 boole-2 boole-and boole-andc1 + boole-andc2 boole-c1 boole-c2 boole-clr + boole-eqv boole-ior boole-nand boole-nor + boole-orc1 boole-orc2 boole-set boole-xor)) + (let ((result (boole (symbol-value symbol) #b0011 #b0101))) + (format t "~& ~A~13T~3,' D~23T~:*~5,' B~31T ...~4,'0B~ + symbol result (logand result #b1111))))) + |> Results of (BOOLE #b0011 #b0101) ... + |> ---Op-------Decimal-----Binary----Bits--- + |> BOOLE-1 3 11 ...0011 + |> BOOLE-2 5 101 ...0101 + |> BOOLE-AND 1 1 ...0001 + |> BOOLE-ANDC1 4 100 ...0100 + |> BOOLE-ANDC2 2 10 ...0010 + |> BOOLE-C1 -4 -100 ...1100 + |> BOOLE-C2 -6 -110 ...1010 + |> BOOLE-CLR 0 0 ...0000 + |> BOOLE-EQV -7 -111 ...1001 + |> BOOLE-IOR 7 111 ...0111 + |> BOOLE-NAND -2 -10 ...1110 + |> BOOLE-NOR -8 -1000 ...1000 + |> BOOLE-ORC1 -3 -11 ...1101 + |> BOOLE-ORC2 -5 -101 ...1011 + |> BOOLE-SET -1 -1 ...1111 + |> BOOLE-XOR 6 110 ...0110 + => NIL + +Exceptional Situations:: +........................ + +Should signal type-error if its first argument is not a bit-wise logical +operation specifier or if any subsequent argument is not an integer. + +See Also:: +.......... + +*note logand:: + +Notes:: +....... + +In general, + + (boole boole-and x y) == (logand x y) + + Programmers who would prefer to use numeric indices rather than +bit-wise logical operation specifiers can get an equivalent effect by a +technique such as the following: + + ;; The order of the values in this `table' are such that + ;; (logand (boole (elt boole-n-vector n) #b0101 #b0011) #b1111) => n + (defconstant boole-n-vector + (vector boole-clr boole-and boole-andc1 boole-2 + boole-andc2 boole-1 boole-xor boole-ior + boole-nor boole-eqv boole-c1 boole-orc1 + boole-c2 boole-orc2 boole-nand boole-set)) + => BOOLE-N-VECTOR + (proclaim '(inline boole-n)) + => implementation-dependent + (defun boole-n (n integer &rest more-integers) + (apply #'boole (elt boole-n-vector n) integer more-integers)) + => BOOLE-N + (boole-n #b0111 5 3) => 7 + (boole-n #b0001 5 3) => 1 + (boole-n #b1101 5 3) => -3 + (loop for n from #b0000 to #b1111 collect (boole-n n 5 3)) + => (0 1 2 3 4 5 6 7 -8 -7 -6 -5 -4 -3 -2 -1) + diff --git a/info/gcl.info-6 b/info/gcl.info-6 new file mode 100644 index 0000000..ff06984 --- /dev/null +++ b/info/gcl.info-6 @@ -0,0 +1,10582 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: boole-1, Next: logand, Prev: boole, Up: Numbers Dictionary + +12.2.61 boole-1, boole-2, boole-and, boole-andc1, boole-andc2, +-------------------------------------------------------------- + +boole-c1, boole-c2, boole-clr, boole-eqv, boole-ior, +---------------------------------------------------- + +boole-nand, boole-nor, boole-orc1, boole-orc2, boole-set, +--------------------------------------------------------- + +boole-xor +--------- + + [Constant Variable] + +Constant Value:: +................ + +The identity and nature of the values of each of these variables is +implementation-dependent, except that it must be distinct from each of +the values of the others, and it must be a valid first argument to the +function boole. + +Description:: +............. + +Each of these constants has a value which is one of the sixteen possible +bit-wise logical operation specifiers. + +Examples:: +.......... + + (boole boole-ior 1 16) => 17 + (boole boole-and -2 5) => 4 + (boole boole-eqv 17 15) => -31 + +See Also:: +.......... + +*note boole:: + + +File: gcl.info, Node: logand, Next: logbitp, Prev: boole-1, Up: Numbers Dictionary + +12.2.62 logand, logandc1, logandc2, logeqv, logior, +--------------------------------------------------- + +lognand, lognor, lognot, logorc1, logorc2, +------------------------------------------ + +logxor +------ + + [Function] + + 'logand' &rest integers => result-integer + + 'logandc' 1 => integer-1 integer-2 result-integer 'logandc' 2 => +integer-1 integer-2 result-integer 'logeqv' &rest integers => +result-integer + + 'logior' &rest integers => result-integer + + 'lognand' integer-1 integer-2 => result-integer + + 'lognor' integer-1 integer-2 => result-integer + + 'lognot' integer => result-integer + + 'logorc' 1 => integer-1 integer-2 result-integer 'logorc' 2 => +integer-1 integer-2 result-integer 'logxor' &rest integers => +result-integer + +Arguments and Values:: +...................... + +integers--integers. + + integer--an integer. + + integer-1--an integer. + + integer-2--an integer. + + result-integer--an integer. + +Description:: +............. + +The functions logandc1, logandc2, logand, logeqv, logior, lognand, +lognor, lognot, logorc1, logorc2, and logxor perform bit-wise logical +operations on their arguments, that are treated as if they were binary. + + Figure 12-17 lists the meaning of each of the functions. Where an +'identity' is shown, it indicates the value yielded by the function when +no arguments are supplied. + + Function Identity Operation performed + logandc1 -- and complement of integer-1 with integer-2 + logandc2 -- and integer-1 with complement of integer-2 + logand -1 and + logeqv -1 equivalence (exclusive nor) + logior 0 inclusive or + lognand -- complement of integer-1 and integer-2 + lognor -- complement of integer-1 or integer-2 + lognot -- complement + logorc1 -- or complement of integer-1 with integer-2 + logorc2 -- or integer-1 with complement of integer-2 + logxor 0 exclusive or + + Figure 12-17: Bit-wise Logical Operations on Integers + + + Negative integers are treated as if they were in two's-complement +notation. + +Examples:: +.......... + + (logior 1 2 4 8) => 15 + (logxor 1 3 7 15) => 10 + (logeqv) => -1 + (logand 16 31) => 16 + (lognot 0) => -1 + (lognot 1) => -2 + (lognot -1) => 0 + (lognot (1+ (lognot 1000))) => 999 + + ;;; In the following example, m is a mask. For each bit in + ;;; the mask that is a 1, the corresponding bits in x and y are + ;;; exchanged. For each bit in the mask that is a 0, the + ;;; corresponding bits of x and y are left unchanged. + (flet ((show (m x y) + (format t "~ + m x y))) + (let ((m #o007750) + (x #o452576) + (y #o317407)) + (show m x y) + (let ((z (logand (logxor x y) m))) + (setq x (logxor z x)) + (setq y (logxor z y)) + (show m x y)))) + |> m = #o007750 + |> x = #o452576 + |> y = #o317407 + |> + |> m = #o007750 + |> x = #o457426 + |> y = #o312557 + => NIL + +Exceptional Situations:: +........................ + +Should signal type-error if any argument is not an integer. + +See Also:: +.......... + +*note boole:: + +Notes:: +....... + +(logbitp k -1) returns true for all values of k. + + Because the following functions are not associative, they take +exactly two arguments rather than any number of arguments. + + (lognand n1 n2) == (lognot (logand n1 n2)) + (lognor n1 n2) == (lognot (logior n1 n2)) + (logandc1 n1 n2) == (logand (lognot n1) n2) + (logandc2 n1 n2) == (logand n1 (lognot n2)) + (logiorc1 n1 n2) == (logior (lognot n1) n2) + (logiorc2 n1 n2) == (logior n1 (lognot n2)) + (logbitp j (lognot x)) == (not (logbitp j x)) + + +File: gcl.info, Node: logbitp, Next: logcount, Prev: logand, Up: Numbers Dictionary + +12.2.63 logbitp [Function] +-------------------------- + +'logbitp' index integer => generalized-boolean + +Arguments and Values:: +...................... + +index--a non-negative integer. + + integer--an integer. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +logbitp is used to test the value of a particular bit in integer, that +is treated as if it were binary. The value of logbitp is true if the +bit in integer whose index is index (that is, its weight is 2^index) is +a one-bit; otherwise it is false. + + Negative integers are treated as if they were in two's-complement +notation. + +Examples:: +.......... + + (logbitp 1 1) => false + (logbitp 0 1) => true + (logbitp 3 10) => true + (logbitp 1000000 -1) => true + (logbitp 2 6) => true + (logbitp 0 6) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if index is not a non-negative +integer. Should signal an error of type type-error if integer is not an +integer. + +Notes:: +....... + + (logbitp k n) == (ldb-test (byte 1 k) n) + + +File: gcl.info, Node: logcount, Next: logtest, Prev: logbitp, Up: Numbers Dictionary + +12.2.64 logcount [Function] +--------------------------- + +'logcount' integer => number-of-on-bits + +Arguments and Values:: +...................... + +integer--an integer. + + number-of-on-bits--a non-negative integer. + +Description:: +............. + +Computes and returns the number of bits in the two's-complement binary +representation of integer that are 'on' or 'set'. If integer is +negative, the 0 bits are counted; otherwise, the 1 bits are counted. + +Examples:: +.......... + + (logcount 0) => 0 + (logcount -1) => 0 + (logcount 7) => 3 + (logcount 13) => 3 ;Two's-complement binary: ...0001101 + (logcount -13) => 2 ;Two's-complement binary: ...1110011 + (logcount 30) => 4 ;Two's-complement binary: ...0011110 + (logcount -30) => 4 ;Two's-complement binary: ...1100010 + (logcount (expt 2 100)) => 1 + (logcount (- (expt 2 100))) => 100 + (logcount (- (1+ (expt 2 100)))) => 1 + +Exceptional Situations:: +........................ + +Should signal type-error if its argument is not an integer. + +Notes:: +....... + +Even if the implementation does not represent integers internally in +two's complement binary, logcount behaves as if it did. + + The following identity always holds: + + (logcount x) + == (logcount (- (+ x 1))) + == (logcount (lognot x)) + + +File: gcl.info, Node: logtest, Next: byte, Prev: logcount, Up: Numbers Dictionary + +12.2.65 logtest [Function] +-------------------------- + +'logtest' integer-1 integer-2 => generalized-boolean + +Arguments and Values:: +...................... + +integer-1--an integer. + + integer-2--an integer. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if any of the bits designated by the 1's in integer-1 is 1 +in integer-2; otherwise it is false. integer-1 and integer-2 are +treated as if they were binary. + + Negative integer-1 and integer-2 are treated as if they were +represented in two's-complement binary. + +Examples:: +.......... + + (logtest 1 7) => true + (logtest 1 2) => false + (logtest -2 -1) => true + (logtest 0 -1) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if integer-1 is not an +integer. Should signal an error of type type-error if integer-2 is not +an integer. + +Notes:: +....... + + (logtest x y) == (not (zerop (logand x y))) + + +File: gcl.info, Node: byte, Next: deposit-field, Prev: logtest, Up: Numbers Dictionary + +12.2.66 byte, byte-size, byte-position [Function] +------------------------------------------------- + +'byte' size position => bytespec + + 'byte-size' bytespec => size + + 'byte-position' bytespec => position + +Arguments and Values:: +...................... + +size, position--a non-negative integer. + + bytespec--a byte specifier. + +Description:: +............. + +byte returns a byte specifier that indicates a byte of width size and +whose bits have weights 2^position + size - 1\/ through 2^position, and +whose representation is implementation-dependent. + + byte-size returns the number of bits specified by bytespec. + + byte-position returns the position specified by bytespec. + +Examples:: +.......... + + (setq b (byte 100 200)) => # + (byte-size b) => 100 + (byte-position b) => 200 + +See Also:: +.......... + +*note ldb:: , *note dpb:: + +Notes:: +....... + + (byte-size (byte j k)) == j + (byte-position (byte j k)) == k + + A byte of size of 0 is permissible; it refers to a byte of width +zero. For example, + + (ldb (byte 0 3) #o7777) => 0 + (dpb #o7777 (byte 0 3) 0) => 0 + + +File: gcl.info, Node: deposit-field, Next: dpb, Prev: byte, Up: Numbers Dictionary + +12.2.67 deposit-field [Function] +-------------------------------- + +'deposit-field' newbyte bytespec integer => result-integer + +Arguments and Values:: +...................... + +newbyte--an integer. + + bytespec--a byte specifier. + + integer--an integer. + + result-integer--an integer. + +Description:: +............. + +Replaces a field of bits within integer; specifically, returns an +integer that contains the bits of newbyte within the byte specified by +bytespec, and elsewhere contains the bits of integer. + +Examples:: +.......... + + (deposit-field 7 (byte 2 1) 0) => 6 + (deposit-field -1 (byte 4 0) 0) => 15 + (deposit-field 0 (byte 2 1) -3) => -7 + +See Also:: +.......... + +*note byte:: , *note dpb:: + +Notes:: +....... + + (logbitp j (deposit-field m (byte s p) n)) + == (if (and (>= j p) (< j (+ p s))) + (logbitp j m) + (logbitp j n)) + + deposit-field is to mask-field as dpb is to ldb. + + +File: gcl.info, Node: dpb, Next: ldb, Prev: deposit-field, Up: Numbers Dictionary + +12.2.68 dpb [Function] +---------------------- + +'dpb' newbyte bytespec integer => result-integer + +Pronunciation:: +............... + +pronounced ,de 'pib or pronounced ,de 'pe b or pronounced 'd\=e 'p\=e +'b\=e + +Arguments and Values:: +...................... + +newbyte--an integer. + + bytespec--a byte specifier. + + integer--an integer. + + result-integer--an integer. + +Description:: +............. + +dpb (deposit byte) is used to replace a field of bits within integer. +dpb returns an integer that is the same as integer except in the bits +specified by bytespec. + + Let s be the size specified by bytespec; then the low s bits of +newbyte appear in the result in the byte specified by bytespec. Newbyte +is interpreted as being right-justified, as if it were the result of +ldb. + +Examples:: +.......... + + (dpb 1 (byte 1 10) 0) => 1024 + (dpb -2 (byte 2 10) 0) => 2048 + (dpb 1 (byte 2 10) 2048) => 1024 + +See Also:: +.......... + +*note byte:: , *note deposit-field:: , *note ldb:: + +Notes:: +....... + + (logbitp j (dpb m (byte s p) n)) + == (if (and (>= j p) (< j (+ p s))) + (logbitp (- j p) m) + (logbitp j n)) + + In general, + + (dpb x (byte 0 y) z) => z + + for all valid values of x, y, and z. + + Historically, the name "dpb" comes from a DEC PDP-10 assembly +language instruction meaning "deposit byte." + + +File: gcl.info, Node: ldb, Next: ldb-test, Prev: dpb, Up: Numbers Dictionary + +12.2.69 ldb [Accessor] +---------------------- + +'ldb' bytespec integer => byte + + (setf (' ldb' bytespec place) new-byte) + +Pronunciation:: +............... + +pronounced 'lid ib or pronounced 'lid e b or pronounced 'el 'd\=e 'b\=e + +Arguments and Values:: +...................... + +bytespec--a byte specifier. + + integer--an integer. + + byte, new-byte--a non-negative integer. + +Description:: +............. + +ldb extracts and returns the byte of integer specified by bytespec. + + ldb returns an integer in which the bits with weights 2^(s-1) through +2^0 are the same as those in integer with weights 2^(p+s-1) through 2^p, +and all other bits zero; s is (byte-size bytespec) and p is +(byte-position bytespec). + + setf may be used with ldb to modify a byte within the integer that is +stored in a given place. + + The order of evaluation, when an ldb form is supplied to setf, is +exactly left-to-right. + + The effect is to perform a dpb operation and then store the result +back into the place. + +Examples:: +.......... + + (ldb (byte 2 1) 10) => 1 + (setq a (list 8)) => (8) + (setf (ldb (byte 2 1) (car a)) 1) => 1 + a => (10) + +See Also:: +.......... + +*note byte:: , byte-position, byte-size, *note dpb:: + +Notes:: +....... + + (logbitp j (ldb (byte s p) n)) + == (and (< j s) (logbitp (+ j p) n)) + + In general, + + (ldb (byte 0 x) y) => 0 + + for all valid values of x and y. + + Historically, the name "ldb" comes from a DEC PDP-10 assembly +language instruction meaning "load byte." + + +File: gcl.info, Node: ldb-test, Next: mask-field, Prev: ldb, Up: Numbers Dictionary + +12.2.70 ldb-test [Function] +--------------------------- + +'ldb-test' bytespec integer => generalized-boolean + +Arguments and Values:: +...................... + +bytespec--a byte specifier. + + integer--an integer. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if any of the bits of the byte in integer specified by +bytespec is non-zero; otherwise returns false. + +Examples:: +.......... + + (ldb-test (byte 4 1) 16) => true + (ldb-test (byte 3 1) 16) => false + (ldb-test (byte 3 2) 16) => true + +See Also:: +.......... + +*note byte:: , *note ldb:: , *note zerop:: + +Notes:: +....... + + (ldb-test bytespec n) == + (not (zerop (ldb bytespec n))) == + (logtest (ldb bytespec -1) n) + + +File: gcl.info, Node: mask-field, Next: most-positive-fixnum, Prev: ldb-test, Up: Numbers Dictionary + +12.2.71 mask-field [Accessor] +----------------------------- + +'mask-field' bytespec integer => masked-integer + + (setf (' mask-field' bytespec place) new-masked-integer) + +Arguments and Values:: +...................... + +bytespec--a byte specifier. + + integer--an integer. + + masked-integer, new-masked-integer--a non-negative integer. + +Description:: +............. + +mask-field performs a "mask" operation on integer. It returns an +integer that has the same bits as integer in the byte specified by +bytespec, but that has zero-bits everywhere else. + + setf may be used with mask-field to modify a byte within the integer +that is stored in a given place. The effect is to perform a +deposit-field operation and then store the result back into the place. + +Examples:: +.......... + + (mask-field (byte 1 5) -1) => 32 + (setq a 15) => 15 + (mask-field (byte 2 0) a) => 3 + a => 15 + (setf (mask-field (byte 2 0) a) 1) => 1 + a => 13 + +See Also:: +.......... + +*note byte:: , *note ldb:: + +Notes:: +....... + + (ldb bs (mask-field bs n)) == (ldb bs n) + (logbitp j (mask-field (byte s p) n)) + == (and (>= j p) (< j s) (logbitp j n)) + (mask-field bs n) == (logand n (dpb -1 bs 0)) + + +File: gcl.info, Node: most-positive-fixnum, Next: decode-float, Prev: mask-field, Up: Numbers Dictionary + +12.2.72 most-positive-fixnum, most-negative-fixnum [Constant Variable] +---------------------------------------------------------------------- + +Constant Value:: +................ + +implementation-dependent. + +Description:: +............. + +most-positive-fixnum is that fixnum closest in value to positive +infinity provided by the implementation, + + and greater than or equal to both 2^15 - 1 and array-dimension-limit. + + most-negative-fixnum is that fixnum closest in value to negative +infinity provided by the implementation, + + and less than or equal to -2^15. + + +File: gcl.info, Node: decode-float, Next: float, Prev: most-positive-fixnum, Up: Numbers Dictionary + +12.2.73 decode-float, scale-float, float-radix, float-sign, +----------------------------------------------------------- + +float-digits, float-precision, integer-decode-float +--------------------------------------------------- + + [Function] + + 'decode-float' float => significand, exponent, sign + + 'scale-float' float integer => scaled-float + + 'float-radix' float => float-radix + + 'float-sign' float-1 &optional float-2 => signed-float + + 'float-digits' float => digits1 + + 'float-precision' float => digits2 + + 'integer-decode-float' float => significand, exponent, integer-sign + +Arguments and Values:: +...................... + +digits1--a non-negative integer. + + digits2--a non-negative integer. + + exponent--an integer. + + float--a float. + + float-1--a float. + + float-2--a float. + + float-radix--an integer. + + integer--a non-negative integer. + + integer-sign--the integer -1, or the integer 1. + + scaled-float--a float. + + sign--A float of the same type as float but numerically equal to 1.0 +or -1.0. + + signed-float--a float. + + significand--a float. + +Description:: +............. + +decode-float computes three values that characterize float. The first +value is of the same type as float and represents the significand. The +second value represents the exponent to which the radix (notated in this +description by b) must be raised to obtain the value that, when +multiplied with the first result, produces the absolute value of float. +If float is zero, any integer value may be returned, provided that the +identity shown for scale-float holds. The third value is of the same +type as float and is 1.0 if float is greater than or equal to zero or +-1.0 otherwise. + + decode-float divides float by an integral power of b so as to bring +its value between 1/b (inclusive) and~1 (exclusive), and returns the +quotient as the first value. If float is zero, however, the result +equals the absolute value of float (that is, if there is a negative +zero, its significand is considered to be a positive zero). + + scale-float returns (* float (expt (float b float) integer))\/, where +b is the radix of the floating-point representation. float is not +necessarily between 1/b and~1. + + float-radix returns the radix of float. + + float-sign returns a number z such that z and float-1 have the same +sign and also such that z and float-2 have the same absolute value. If +float-2 is not supplied, its value is (float 1 float-1). If an +implementation has distinct representations for negative zero and +positive zero, then (float-sign -0.0) => -1.0. + + float-digits returns the number of radix b digits used in the +representation of float (including any implicit digits, such as a +"hidden bit"). + + float-precision returns the number of significant radix b digits +present in float; if float is a float zero, then the result is an +integer zero. + + For normalized floats, the results of float-digits and +float-precision are the same, but the precision is less than the number +of representation digits for a denormalized or zero number. + + integer-decode-float computes three values that characterize float - +the significand scaled so as to be an integer, and the same last two +values that are returned by decode-float. If float is zero, +integer-decode-float returns zero as the first value. The second value +bears the same relationship to the first value as for decode-float: + + (multiple-value-bind (signif expon sign) + (integer-decode-float f) + (scale-float (float signif f) expon)) == (abs f) + +Examples:: +.......... + + ;; Note that since the purpose of this functionality is to expose + ;; details of the implementation, all of these examples are necessarily + ;; very implementation-dependent. Results may vary widely. + ;; Values shown here are chosen consistently from one particular implementation. + (decode-float .5) => 0.5, 0, 1.0 + (decode-float 1.0) => 0.5, 1, 1.0 + (scale-float 1.0 1) => 2.0 + (scale-float 10.01 -2) => 2.5025 + (scale-float 23.0 0) => 23.0 + (float-radix 1.0) => 2 + (float-sign 5.0) => 1.0 + (float-sign -5.0) => -1.0 + (float-sign 0.0) => 1.0 + (float-sign 1.0 0.0) => 0.0 + (float-sign 1.0 -10.0) => 10.0 + (float-sign -1.0 10.0) => -10.0 + (float-digits 1.0) => 24 + (float-precision 1.0) => 24 + (float-precision least-positive-single-float) => 1 + (integer-decode-float 1.0) => 8388608, -23, 1 + +Affected By:: +............. + +The implementation's representation for floats. + +Exceptional Situations:: +........................ + +The functions decode-float, float-radix, float-digits, float-precision, +and integer-decode-float should signal an error if their only argument +is not a float. + + The function scale-float should signal an error if its first argument +is not a float or if its second argument is not an integer. + + The function float-sign should signal an error if its first argument +is not a float or if its second argument is supplied but is not a float. + +Notes:: +....... + +The product of the first result of decode-float or integer-decode-float, +of the radix raised to the power of the second result, and of the third +result is exactly equal to the value of float. + + (multiple-value-bind (signif expon sign) + (decode-float f) + (scale-float signif expon)) + == (abs f) + + and + + (multiple-value-bind (signif expon sign) + (decode-float f) + (* (scale-float signif expon) sign)) + == f + + +File: gcl.info, Node: float, Next: floatp, Prev: decode-float, Up: Numbers Dictionary + +12.2.74 float [Function] +------------------------ + +'float' number &optional prototype => float + +Arguments and Values:: +...................... + +number--a real. + + prototype--a float. + + float--a float. + +Description:: +............. + +float converts a + + real + + number to a float. + + If a prototype is supplied, a float is returned that is +mathematically equal to number but has the same format as prototype. + + If prototype is not supplied, then if the number is already a float, +it is returned; otherwise, a float is returned that is mathematically +equal to number but is a single float. + +Examples:: +.......... + + (float 0) => 0.0 + (float 1 .5) => 1.0 + (float 1.0) => 1.0 + (float 1/2) => 0.5 + => 1.0d0 + OR=> 1.0 + (eql (float 1.0 1.0d0) 1.0d0) => true + +See Also:: +.......... + +*note coerce:: + + +File: gcl.info, Node: floatp, Next: most-positive-short-float, Prev: float, Up: Numbers Dictionary + +12.2.75 floatp [Function] +------------------------- + +'floatp' object generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type float; otherwise, returns false. + +Examples:: +.......... + + (floatp 1.2d2) => true + (floatp 1.212) => true + (floatp 1.2s2) => true + (floatp (expt 2 130)) => false + +Notes:: +....... + + (floatp object) == (typep object 'float) + + +File: gcl.info, Node: most-positive-short-float, Next: short-float-epsilon, Prev: floatp, Up: Numbers Dictionary + +12.2.76 most-positive-short-float, least-positive-short-float, +-------------------------------------------------------------- + +least-positive-normalized-short-float, +-------------------------------------- + +most-positive-double-float, least-positive-double-float, +-------------------------------------------------------- + +least-positive-normalized-double-float, +--------------------------------------- + +most-positive-long-float, least-positive-long-float, +---------------------------------------------------- + +least-positive-normalized-long-float, +------------------------------------- + +most-positive-single-float, least-positive-single-float, +-------------------------------------------------------- + +least-positive-normalized-single-float, +--------------------------------------- + +most-negative-short-float, least-negative-short-float, +------------------------------------------------------ + +least-negative-normalized-short-float, +-------------------------------------- + +most-negative-single-float, least-negative-single-float, +-------------------------------------------------------- + +least-negative-normalized-single-float, +--------------------------------------- + +most-negative-double-float, least-negative-double-float, +-------------------------------------------------------- + +least-negative-normalized-double-float, +--------------------------------------- + +most-negative-long-float, least-negative-long-float, +---------------------------------------------------- + +least-negative-normalized-long-float +------------------------------------ + + [Constant Variable] + +Constant Value:: +................ + +implementation-dependent. + +Description:: +............. + +These constant variables provide a way for programs to examine the +implementation-defined limits for the various float formats. + + Of these variables, each which has "-normalized" in its name must +have a value which is a normalized float, and each which does not have +"-normalized" in its name may have a value which is either a normalized +float or a denormalized float, as appropriate. + + Of these variables, each which has "short-float" in its name must +have a value which is a short float, each which has "single-float" in +its name must have a value which is a single float, each which has +"double-float" in its name must have a value which is a double float, +and each which has "long-float" in its name must have a value which is a +long float. + +* + most-positive-short-float, most-positive-single-float, + most-positive-double-float, most-positive-long-float + + Each of these constant variables has as its value the positive + float of the largest magnitude (closest in value to, but not equal + to, positive infinity) for the float format implied by its name. + +* + least-positive-short-float, least-positive-normalized-short-float, + least-positive-single-float, + least-positive-normalized-single-float, + least-positive-double-float, + least-positive-normalized-double-float, least-positive-long-float, + least-positive-normalized-long-float + + Each of these constant variables has as its value the smallest + positive (nonzero) float for the float format implied by its name. + +* + least-negative-short-float, least-negative-normalized-short-float, + least-negative-single-float, + least-negative-normalized-single-float, + least-negative-double-float, + least-negative-normalized-double-float, least-negative-long-float, + least-negative-normalized-long-float + + Each of these constant variables has as its value the negative + (nonzero) float of the smallest magnitude for the float format + implied by its name. (If an implementation supports minus zero as + a different object from positive zero, this value must not be minus + zero.) + +* + most-negative-short-float, most-negative-single-float, + most-negative-double-float, most-negative-long-float + + Each of these constant variables has as its value the negative + float of the largest magnitude (closest in value to, but not equal + to, negative infinity) for the float format implied by its name. + +Notes:: +....... + + +File: gcl.info, Node: short-float-epsilon, Next: arithmetic-error, Prev: most-positive-short-float, Up: Numbers Dictionary + +12.2.77 short-float-epsilon, short-float-negative-epsilon, +---------------------------------------------------------- + +single-float-epsilon, single-float-negative-epsilon, +---------------------------------------------------- + +double-float-epsilon, double-float-negative-epsilon, +---------------------------------------------------- + +long-float-epsilon, long-float-negative-epsilon +----------------------------------------------- + + [Constant Variable] + +Constant Value:: +................ + +implementation-dependent. + +Description:: +............. + +The value of each of the constants short-float-epsilon, +single-float-epsilon, double-float-epsilon, and long-float-epsilon is +the smallest positive float \epsilon of the given format, such that the +following expression is true when evaluated: + + (not (= (float 1 \epsilon) (+ (float 1 \epsilon) \epsilon)))\/ + + The value of each of the constants short-float-negative-epsilon, +single-float-negative-epsilon, double-float-negative-epsilon, and +long-float-negative-epsilon is the smallest positive float \epsilon of +the given format, such that the following expression is true when +evaluated: + + (not (= (float 1 \epsilon) (- (float 1 \epsilon) \epsilon)))\/ + + +File: gcl.info, Node: arithmetic-error, Next: arithmetic-error-operands, Prev: short-float-epsilon, Up: Numbers Dictionary + +12.2.78 arithmetic-error [Condition Type] +----------------------------------------- + +Class Precedence List:: +....................... + +arithmetic-error, error, serious-condition, condition, t + +Description:: +............. + +The type arithmetic-error consists of error conditions that occur during +arithmetic operations. The operation and operands are initialized with +the initialization arguments named :operation and :operands to +make-condition, and are accessed by the functions +arithmetic-error-operation and arithmetic-error-operands. + +See Also:: +.......... + +arithmetic-error-operation, *note arithmetic-error-operands:: + + +File: gcl.info, Node: arithmetic-error-operands, Next: division-by-zero, Prev: arithmetic-error, Up: Numbers Dictionary + +12.2.79 arithmetic-error-operands, arithmetic-error-operation [Function] +------------------------------------------------------------------------ + +'arithmetic-error-operands' condition => operands + + 'arithmetic-error-operation' condition => operation + +Arguments and Values:: +...................... + +condition--a condition of type arithmetic-error. + + operands--a list. + + operation--a function designator. + +Description:: +............. + +arithmetic-error-operands returns a list of the operands which were used +in the offending call to the operation that signaled the condition. + + arithmetic-error-operation returns a list of the offending operation +in the offending call that signaled the condition. + +See Also:: +.......... + +arithmetic-error, *note Conditions:: + +Notes:: +....... + + +File: gcl.info, Node: division-by-zero, Next: floating-point-invalid-operation, Prev: arithmetic-error-operands, Up: Numbers Dictionary + +12.2.80 division-by-zero [Condition Type] +----------------------------------------- + +Class Precedence List:: +....................... + +division-by-zero, arithmetic-error, error, serious-condition, condition, +t + +Description:: +............. + +The type division-by-zero consists of error conditions that occur +because of division by zero. + + +File: gcl.info, Node: floating-point-invalid-operation, Next: floating-point-inexact, Prev: division-by-zero, Up: Numbers Dictionary + +12.2.81 floating-point-invalid-operation [Condition Type] +--------------------------------------------------------- + +Class Precedence List:: +....................... + +floating-point-invalid-operation, arithmetic-error, error, +serious-condition, condition, t + +Description:: +............. + +The type floating-point-invalid-operation consists of error conditions +that occur because of certain floating point traps. + + It is implementation-dependent whether floating point traps occur, +and whether or how they may be enabled or disabled. Therefore, +conforming code may establish handlers for this condition, but must not +depend on its being signaled. + + +File: gcl.info, Node: floating-point-inexact, Next: floating-point-overflow, Prev: floating-point-invalid-operation, Up: Numbers Dictionary + +12.2.82 floating-point-inexact [Condition Type] +----------------------------------------------- + +Class Precedence List:: +....................... + +floating-point-inexact, arithmetic-error, error, serious-condition, +condition, t + +Description:: +............. + +The type floating-point-inexact consists of error conditions that occur +because of certain floating point traps. + + It is implementation-dependent whether floating point traps occur, +and whether or how they may be enabled or disabled. Therefore, +conforming code may establish handlers for this condition, but must not +depend on its being signaled. + + +File: gcl.info, Node: floating-point-overflow, Next: floating-point-underflow, Prev: floating-point-inexact, Up: Numbers Dictionary + +12.2.83 floating-point-overflow [Condition Type] +------------------------------------------------ + +Class Precedence List:: +....................... + +floating-point-overflow, arithmetic-error, error, serious-condition, +condition, t + +Description:: +............. + +The type floating-point-overflow consists of error conditions that occur +because of floating-point overflow. + + +File: gcl.info, Node: floating-point-underflow, Prev: floating-point-overflow, Up: Numbers Dictionary + +12.2.84 floating-point-underflow [Condition Type] +------------------------------------------------- + +Class Precedence List:: +....................... + +floating-point-underflow, arithmetic-error, error, serious-condition, +condition, t + +Description:: +............. + +The type floating-point-underflow consists of error conditions that +occur because of floating-point underflow. + + +File: gcl.info, Node: Characters, Next: Conses, Prev: Numbers (Numbers), Up: Top + +13 Characters +************* + +* Menu: + +* Character Concepts:: +* Characters Dictionary:: + + +File: gcl.info, Node: Character Concepts, Next: Characters Dictionary, Prev: Characters, Up: Characters + +13.1 Character Concepts +======================= + +* Menu: + +* Introduction to Characters:: +* Introduction to Scripts and Repertoires:: +* Character Attributes:: +* Character Categories:: +* Identity of Characters:: +* Ordering of Characters:: +* Character Names:: +* Treatment of Newline during Input and Output:: +* Character Encodings:: +* Documentation of Implementation-Defined Scripts:: + + +File: gcl.info, Node: Introduction to Characters, Next: Introduction to Scripts and Repertoires, Prev: Character Concepts, Up: Character Concepts + +13.1.1 Introduction to Characters +--------------------------------- + +A character is an object that represents a unitary token (e.g., a +letter, a special symbol, or a "control character") in an aggregate +quantity of text (e.g., a string or a text stream). + + Common Lisp allows an implementation to provide support for +international language characters as well as characters used in +specialized arenas (e.g., mathematics). + + The following figures contain lists of defined names applicable to +characters. + + Figure 13-1 lists some defined names relating to character attributes +and character predicates. + + alpha-char-p char-not-equal char> + alphanumericp char-not-greaterp char>= + both-case-p char-not-lessp digit-char-p + char-code-limit char/= graphic-char-p + char-equal char< lower-case-p + char-greaterp char<= standard-char-p + char-lessp char= upper-case-p + + Figure 13-1: Character defined names - 1 + + + Figure 13-2 lists some character construction and conversion defined +names. + + char-code char-name code-char + char-downcase char-upcase digit-char + char-int character name-char + + Figure 13-2: Character defined names - 2 + + + +File: gcl.info, Node: Introduction to Scripts and Repertoires, Next: Character Attributes, Prev: Introduction to Characters, Up: Character Concepts + +13.1.2 Introduction to Scripts and Repertoires +---------------------------------------------- + +* Menu: + +* Character Scripts:: +* Character Repertoires:: + + +File: gcl.info, Node: Character Scripts, Next: Character Repertoires, Prev: Introduction to Scripts and Repertoires, Up: Introduction to Scripts and Repertoires + +13.1.2.1 Character Scripts +.......................... + +A script is one of possibly several sets that form an exhaustive +partition of the type character. + + The number of such sets and boundaries between them is +implementation-defined. Common Lisp does not require these sets to be +types, but an implementation is permitted to define such types as an +extension. Since no character from one script can ever be a member of +another script, it is generally more useful to speak about character +repertoires. + + Although the term "script" is chosen for definitional compatibility +with ISO terminology, no conforming implementation is required to use +any particular scripts standardized by ISO or by any other standards +organization. + + Whether and how the script or scripts used by any given +implementation are named is implementation-dependent. + + +File: gcl.info, Node: Character Repertoires, Prev: Character Scripts, Up: Introduction to Scripts and Repertoires + +13.1.2.2 Character Repertoires +.............................. + +A repertoire is a type specifier for a subtype of type character. + + This term is generally used when describing a collection of +characters independent of their coding. Characters in repertoires are +only identified by name, by glyph, or by character description. + + A repertoire can contain characters from several scripts, and a +character can appear in more than one repertoire. + + For some examples of repertoires, see the coded character standards +ISO 8859/1, ISO 8859/2, and ISO 6937/2. Note, however, that although +the term "repertoire" is chosen for definitional compatibility with ISO +terminology, no conforming implementation is required to use repertoires +standardized by ISO or any other standards organization. + + +File: gcl.info, Node: Character Attributes, Next: Character Categories, Prev: Introduction to Scripts and Repertoires, Up: Character Concepts + +13.1.3 Character Attributes +--------------------------- + +Characters have only one standardized attribute: a code. A character's +code is a non-negative integer. This code is composed from a character +script and a character label in an implementation-dependent way. See +the functions char-code and code-char. + + Additional, implementation-defined attributes of characters are also +permitted so that, for example, two characters with the same code may +differ in some other, implementation-defined way. + + For any implementation-defined attribute there is a distinguished +value called the null value for that attribute. A character for which +each implementation-defined attribute has the null value for that +attribute is called a simple character. If the implementation has no +implementation-defined attributes, then all characters are simple +characters. + + +File: gcl.info, Node: Character Categories, Next: Identity of Characters, Prev: Character Attributes, Up: Character Concepts + +13.1.4 Character Categories +--------------------------- + +There are several (overlapping) categories of characters that have no +formally associated type but that are nevertheless useful to name. They +include graphic characters, alphabetic_1 characters, characters with +case (uppercase and lowercase characters), numeric characters, +alphanumeric characters, and digits (in a given radix). + + For each implementation-defined attribute of a character, the +documentation for that implementation must specify whether characters +that differ only in that attribute are permitted to differ in whether +are not they are members of one of the aforementioned categories. + + Note that these terms are defined independently of any special syntax +which might have been enabled in the current readtable. + +* Menu: + +* Graphic Characters:: +* Alphabetic Characters:: +* Characters With Case:: +* Uppercase Characters:: +* Lowercase Characters:: +* Corresponding Characters in the Other Case:: +* Case of Implementation-Defined Characters:: +* Numeric Characters:: +* Alphanumeric Characters:: +* Digits in a Radix:: + + +File: gcl.info, Node: Graphic Characters, Next: Alphabetic Characters, Prev: Character Categories, Up: Character Categories + +13.1.4.1 Graphic Characters +........................... + +Characters that are classified as graphic , or displayable, are each +associated with a glyph, a visual representation of the character. + + A graphic character is one that has a standard textual representation +as a single glyph, such as A or * or =. Space, which effectively has a +blank glyph, is defined to be a graphic. + + Of the standard characters, newline is non-graphic and all others are +graphic; see *note Standard Characters::. + + Characters that are not graphic are called non-graphic . + + Non-graphic characters are sometimes informally called "formatting +characters" or "control characters." + + #\Backspace, #\Tab, #\Rubout, #\Linefeed, #\Return, and #\Page, if +they are supported by the implementation, are non-graphic. + + +File: gcl.info, Node: Alphabetic Characters, Next: Characters With Case, Prev: Graphic Characters, Up: Character Categories + +13.1.4.2 Alphabetic Characters +.............................. + +The alphabetic_1 characters are a subset of the graphic characters. Of +the standard characters, only these are the alphabetic_1 characters: + + 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 + + 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 + + Any implementation-defined character that has case must be +alphabetic_1. For each implementation-defined graphic character that +has no case, it is implementation-defined whether that character is +alphabetic_1. + + +File: gcl.info, Node: Characters With Case, Next: Uppercase Characters, Prev: Alphabetic Characters, Up: Character Categories + +13.1.4.3 Characters With Case +............................. + +The characters with case are a subset of the alphabetic_1 characters. A +character with case has the property of being either uppercase or +lowercase. Every character with case is in one-to-one correspondence +with some other character with the opposite case. + + +File: gcl.info, Node: Uppercase Characters, Next: Lowercase Characters, Prev: Characters With Case, Up: Character Categories + +13.1.4.4 Uppercase Characters +............................. + +An uppercase character is one that has a corresponding lowercase +character that is different (and can be obtained using char-downcase). + + Of the standard characters, only these are uppercase characters: + + 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 + + +File: gcl.info, Node: Lowercase Characters, Next: Corresponding Characters in the Other Case, Prev: Uppercase Characters, Up: Character Categories + +13.1.4.5 Lowercase Characters +............................. + +A lowercase character is one that has a corresponding uppercase +character that is different (and can be obtained using char-upcase). + + Of the standard characters, only these are lowercase characters: + + 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 + + +File: gcl.info, Node: Corresponding Characters in the Other Case, Next: Case of Implementation-Defined Characters, Prev: Lowercase Characters, Up: Character Categories + +13.1.4.6 Corresponding Characters in the Other Case +................................................... + +The uppercase standard characters A through Z mentioned above +respectively correspond to the lowercase standard characters a through z +mentioned above. For example, the uppercase character E corresponds to +the lowercase character e, and vice versa. + + +File: gcl.info, Node: Case of Implementation-Defined Characters, Next: Numeric Characters, Prev: Corresponding Characters in the Other Case, Up: Character Categories + +13.1.4.7 Case of Implementation-Defined Characters +.................................................. + +An implementation may define that other implementation-defined graphic +characters have case. Such definitions must always be done in +pairs--one uppercase character in one-to-one correspondence with one +lowercase character. + + +File: gcl.info, Node: Numeric Characters, Next: Alphanumeric Characters, Prev: Case of Implementation-Defined Characters, Up: Character Categories + +13.1.4.8 Numeric Characters +........................... + +The numeric characters are a subset of the graphic characters. Of the +standard characters, only these are numeric characters: + + 0 1 2 3 4 5 6 7 8 9 + + For each implementation-defined graphic character that has no case, +the implementation must define whether or not it is a numeric character. + + +File: gcl.info, Node: Alphanumeric Characters, Next: Digits in a Radix, Prev: Numeric Characters, Up: Character Categories + +13.1.4.9 Alphanumeric Characters +................................ + +The set of alphanumeric characters is the union of the set of +alphabetic_1 characters and the set of numeric characters. + + +File: gcl.info, Node: Digits in a Radix, Prev: Alphanumeric Characters, Up: Character Categories + +13.1.4.10 Digits in a Radix +........................... + +What qualifies as a digit depends on the radix (an integer between 2 and +36, inclusive). The potential digits are: + + 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 + + Their respective weights are 0, 1, 2, ... 35. In any given radix n, +only the first n potential digits are considered to be digits. For +example, the digits in radix 2 are 0 and 1, the digits in radix 10 are 0 +through 9, and the digits in radix 16 are 0 through F. + + Case is not significant in digits; for example, in radix 16, both F +and f are digits with weight 15. + + +File: gcl.info, Node: Identity of Characters, Next: Ordering of Characters, Prev: Character Categories, Up: Character Concepts + +13.1.5 Identity of Characters +----------------------------- + +Two characters that are eql, char=, or char-equal are not necessarily +eq. + + +File: gcl.info, Node: Ordering of Characters, Next: Character Names, Prev: Identity of Characters, Up: Character Concepts + +13.1.6 Ordering of Characters +----------------------------- + +The total ordering on characters is guaranteed to have the following +properties: + +* + If two characters have the same implementation-defined attributes, + then their ordering by char< is consistent with the numerical + ordering by the predicate < on their code attributes. + +* + If two characters differ in any attribute, then they are not char=. + + [Reviewer Note by Barmar: I wonder if we should say that the + ordering may be dependent on the implementation-defined + attributes.] + +* + The total ordering is not necessarily the same as the total + ordering on the integers produced by applying char-int to the + characters. + +* + While alphabetic_1 standard characters of a given case must obey a + partial ordering, they need not be contiguous; it is permissible + for uppercase and lowercase characters to be interleaved. Thus + (char<= #\a x #\z) is not a valid way of determining whether or not + x is a lowercase character. + + Of the standard characters, those which are alphanumeric obey the +following partial ordering: + + A, char<=, char>=, +--------------------------------------------------- + +char-equal, char-not-equal, char-lessp, char-greaterp, char-not-greaterp, +------------------------------------------------------------------------- + +char-not-lessp +-------------- + + [Function] + + 'char=' &rest characters^+ => generalized-boolean + + 'char/=' &rest characters^+ => generalized-boolean + + 'char<' &rest characters^+ => generalized-boolean + + 'char>' &rest characters^+ => generalized-boolean + + 'char<=' &rest characters^+ => generalized-boolean + + 'char>=' &rest characters^+ => generalized-boolean + + 'char-equal' &rest characters^+ => generalized-boolean + + 'char-not-equal' &rest characters^+ => generalized-boolean + + 'char-lessp' &rest characters^+ => generalized-boolean + + 'char-greaterp' &rest characters^+ => generalized-boolean + + 'char-not-greaterp' &rest characters^+ => generalized-boolean + + 'char-not-lessp' &rest characters^+ => generalized-boolean + +Arguments and Values:: +...................... + +character--a character. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +These predicates compare characters. + + char= returns true if all characters are the same; otherwise, it +returns false. + + If two characters differ in any implementation-defined attributes, +then they are not char=. + + char/= returns true if all characters are different; otherwise, it +returns false. + + char< returns true if the characters are monotonically increasing; +otherwise, it returns false. + + If two characters have identical implementation-defined attributes, +then their ordering by char< is consistent with the numerical ordering +by the predicate < on their codes. + + char> returns true if the characters are monotonically decreasing; +otherwise, it returns false. + + If two characters have identical implementation-defined attributes, +then their ordering by char> is consistent with the numerical ordering +by the predicate > on their codes. + + char<= returns true if the characters are monotonically +nondecreasing; otherwise, it returns false. + + If two characters have identical implementation-defined attributes, +then their ordering by char<= is consistent with the numerical ordering +by the predicate <= on their codes. + + char>= returns true if the characters are monotonically +nonincreasing; otherwise, it returns false. + + If two characters have identical implementation-defined attributes, +then their ordering by char>= is consistent with the numerical ordering +by the predicate >= on their codes. + + char-equal, char-not-equal, char-lessp, char-greaterp, +char-not-greaterp, and char-not-lessp are similar to char=, char/=, +char<, char>, char<=, char>=, respectively, except that they ignore +differences in case and + + might have an implementation-defined behavior for non-simple +characters. For example, an implementation might define that +char-equal, etc. ignore certain implementation-defined attributes. The +effect, if any, of each implementation-defined attribute upon these +functions must be specified as part of the definition of that attribute. + +Examples:: +.......... + + (char= #\d #\d) => true + (char= #\A #\a) => false + (char= #\d #\x) => false + (char= #\d #\D) => false + (char/= #\d #\d) => false + (char/= #\d #\x) => true + (char/= #\d #\D) => true + (char= #\d #\d #\d #\d) => true + (char/= #\d #\d #\d #\d) => false + (char= #\d #\d #\x #\d) => false + (char/= #\d #\d #\x #\d) => false + (char= #\d #\y #\x #\c) => false + (char/= #\d #\y #\x #\c) => true + (char= #\d #\c #\d) => false + (char/= #\d #\c #\d) => false + (char< #\d #\x) => true + (char<= #\d #\x) => true + (char< #\d #\d) => false + (char<= #\d #\d) => true + (char< #\a #\e #\y #\z) => true + (char<= #\a #\e #\y #\z) => true + (char< #\a #\e #\e #\y) => false + (char<= #\a #\e #\e #\y) => true + (char> #\e #\d) => true + (char>= #\e #\d) => true + (char> #\d #\c #\b #\a) => true + (char>= #\d #\c #\b #\a) => true + (char> #\d #\d #\c #\a) => false + (char>= #\d #\d #\c #\a) => true + (char> #\e #\d #\b #\c #\a) => false + (char>= #\e #\d #\b #\c #\a) => false + (char> #\z #\A) => implementation-dependent + (char> #\Z #\a) => implementation-dependent + (char-equal #\A #\a) => true + (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char-lessp) + => (#\A #\a #\b #\B #\c #\C) + (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char<) + => (#\A #\B #\C #\a #\b #\c) ;Implementation A + => (#\a #\b #\c #\A #\B #\C) ;Implementation B + => (#\a #\A #\b #\B #\c #\C) ;Implementation C + => (#\A #\a #\B #\b #\C #\c) ;Implementation D + => (#\A #\B #\a #\b #\C #\c) ;Implementation E + +Exceptional Situations:: +........................ + +Should signal an error of type program-error if at least one character +is not supplied. + +See Also:: +.......... + +*note Character Syntax::, *note Documentation of Implementation-Defined +Scripts:: + +Notes:: +....... + +If characters differ in their code attribute or any +implementation-defined attribute, they are considered to be different by +char=. + + There is no requirement that (eq c1 c2) be true merely because (char= +c1 c2) is true. While eq can distinguish two characters that char= does +not, it is distinguishing them not as characters, but in some sense on +the basis of a lower level implementation characteristic. If (eq c1 c2) +is true, then (char= c1 c2) is also true. eql and equal compare +characters in the same way that char= does. + + The manner in which case is used by char-equal, char-not-equal, +char-lessp, char-greaterp, char-not-greaterp, and char-not-lessp implies +an ordering for standard characters such that A=a, B=b, and so on, up to +Z=z, and furthermore either 9 denoted-character + +Arguments and Values:: +...................... + +character--a character designator. + + denoted-character--a character. + +Description:: +............. + +Returns the character denoted by the character designator. + +Examples:: +.......... + + (character #\a) => #\a + (character "a") => #\a + (character 'a) => #\A + (character '\a) => #\a + (character 65.) is an error. + (character 'apple) is an error. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if object is not a character +designator. + +See Also:: +.......... + +*note coerce:: + +Notes:: +....... + + (character object) == (coerce object 'character) + + +File: gcl.info, Node: characterp, Next: alpha-char-p, Prev: character, Up: Characters Dictionary + +13.2.7 characterp [Function] +---------------------------- + +'characterp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type character; otherwise, returns false. + +Examples:: +.......... + + (characterp #\a) => true + (characterp 'a) => false + (characterp "a") => false + (characterp 65.) => false + (characterp #\Newline) => true + ;; This next example presupposes an implementation + ;; in which #\Rubout is an implementation-defined character. + (characterp #\Rubout) => true + +See Also:: +.......... + +*note character:: (type and function), *note typep:: + +Notes:: +....... + + (characterp object) == (typep object 'character) + + +File: gcl.info, Node: alpha-char-p, Next: alphanumericp, Prev: characterp, Up: Characters Dictionary + +13.2.8 alpha-char-p [Function] +------------------------------ + +'alpha-char-p' character => generalized-boolean + +Arguments and Values:: +...................... + +character--a character. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if character is an alphabetic_1 character; otherwise, +returns false. + +Examples:: +.......... + + (alpha-char-p #\a) => true + (alpha-char-p #\5) => false + (alpha-char-p #\Newline) => false + ;; This next example presupposes an implementation + ;; in which #\\alpha is a defined character. + (alpha-char-p #\\alpha) => implementation-dependent + +Affected By:: +............. + +None. (In particular, the results of this predicate are independent of +any special syntax which might have been enabled in the current +readtable.) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + +See Also:: +.......... + +*note alphanumericp:: , *note Documentation of Implementation-Defined +Scripts:: + + +File: gcl.info, Node: alphanumericp, Next: digit-char, Prev: alpha-char-p, Up: Characters Dictionary + +13.2.9 alphanumericp [Function] +------------------------------- + +'alphanumericp' character => generalized-boolean + +Arguments and Values:: +...................... + +character--a character. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if character is an alphabetic_1 character or a numeric +character; otherwise, returns false. + +Examples:: +.......... + + (alphanumericp #\Z) => true + (alphanumericp #\9) => true + (alphanumericp #\Newline) => false + (alphanumericp #\#) => false + +Affected By:: +............. + +None. (In particular, the results of this predicate are independent of +any special syntax which might have been enabled in the current +readtable.) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + +See Also:: +.......... + +*note alpha-char-p:: , *note graphic-char-p:: , *note digit-char-p:: + +Notes:: +....... + +Alphanumeric characters are graphic as defined by graphic-char-p. The +alphanumeric characters are a subset of the graphic characters. The +standard characters A through Z, a through z, and 0 through 9 are +alphanumeric characters. + + (alphanumericp x) + == (or (alpha-char-p x) (not (null (digit-char-p x)))) + + +File: gcl.info, Node: digit-char, Next: digit-char-p, Prev: alphanumericp, Up: Characters Dictionary + +13.2.10 digit-char [Function] +----------------------------- + +'digit-char' weight &optional radix => char + +Arguments and Values:: +...................... + +weight--a non-negative integer. + + radix--a radix. The default is 10. + + char--a character or false. + +Description:: +............. + +If weight is less than radix, digit-char returns a character which has +that weight when considered as a digit in the specified radix. If the +resulting character is to be an alphabetic_1 character, it will be an +uppercase character. + + If weight is greater than or equal to radix, digit-char returns +false. + +Examples:: +.......... + + (digit-char 0) => #\0 + (digit-char 10 11) => #\A + (digit-char 10 10) => false + (digit-char 7) => #\7 + (digit-char 12) => false + (digit-char 12 16) => #\C ;not #\c + (digit-char 6 2) => false + (digit-char 1 2) => #\1 + +See Also:: +.......... + +*note digit-char-p:: , *note graphic-char-p:: , *note Character Syntax:: + +Notes:: +....... + + +File: gcl.info, Node: digit-char-p, Next: graphic-char-p, Prev: digit-char, Up: Characters Dictionary + +13.2.11 digit-char-p [Function] +------------------------------- + +'digit-char-p' char &optional radix => weight + +Arguments and Values:: +...................... + +char--a character. + + radix--a radix. The default is 10. + + weight--either a non-negative integer less than radix, or false. + +Description:: +............. + +Tests whether char is a digit in the specified radix (i.e., with a +weight less than radix). If it is a digit in that radix, its weight is +returned as an integer; otherwise nil is returned. + +Examples:: +.......... + + (digit-char-p #\5) => 5 + (digit-char-p #\5 2) => false + (digit-char-p #\A) => false + (digit-char-p #\a) => false + (digit-char-p #\A 11) => 10 + (digit-char-p #\a 11) => 10 + (mapcar #'(lambda (radix) + (map 'list #'(lambda (x) (digit-char-p x radix)) + "059AaFGZ")) + '(2 8 10 16 36)) + => ((0 NIL NIL NIL NIL NIL NIL NIL) + (0 5 NIL NIL NIL NIL NIL NIL) + (0 5 9 NIL NIL NIL NIL NIL) + (0 5 9 10 10 15 NIL NIL) + (0 5 9 10 10 15 16 35)) + +Affected By:: +............. + +None. (In particular, the results of this predicate are independent of +any special syntax which might have been enabled in the current +readtable.) + +See Also:: +.......... + +*note alphanumericp:: + +Notes:: +....... + +Digits are graphic characters. + + +File: gcl.info, Node: graphic-char-p, Next: standard-char-p, Prev: digit-char-p, Up: Characters Dictionary + +13.2.12 graphic-char-p [Function] +--------------------------------- + +'graphic-char-p' char => generalized-boolean + +Arguments and Values:: +...................... + +char--a character. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if character is a graphic character; otherwise, returns +false. + +Examples:: +.......... + + (graphic-char-p #\G) => true + (graphic-char-p #\#) => true + (graphic-char-p #\Space) => true + (graphic-char-p #\Newline) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + +See Also:: +.......... + +*note read:: , *note Character Syntax::, *note Documentation of +Implementation-Defined Scripts:: + + +File: gcl.info, Node: standard-char-p, Next: char-upcase, Prev: graphic-char-p, Up: Characters Dictionary + +13.2.13 standard-char-p [Function] +---------------------------------- + +'standard-char-p' character => generalized-boolean + +Arguments and Values:: +...................... + +character--a character. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if character is of type standard-char; otherwise, returns +false. + +Examples:: +.......... + + (standard-char-p #\Space) => true + (standard-char-p #\~) => true + ;; This next example presupposes an implementation + ;; in which #\Bell is a defined character. + (standard-char-p #\Bell) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + + +File: gcl.info, Node: char-upcase, Next: upper-case-p, Prev: standard-char-p, Up: Characters Dictionary + +13.2.14 char-upcase, char-downcase [Function] +--------------------------------------------- + +'char-upcase' character => corresponding-character + + 'char-downcase' character => corresponding-character + +Arguments and Values:: +...................... + +character, corresponding-character--a character. + +Description:: +............. + +If character is a lowercase character, char-upcase returns the +corresponding uppercase character. Otherwise, char-upcase just returns +the given character. + + If character is an uppercase character, char-downcase returns the +corresponding lowercase character. Otherwise, char-downcase just +returns the given character. + + The result only ever differs from character in its code attribute; +all implementation-defined attributes are preserved. + +Examples:: +.......... + + (char-upcase #\a) => #\A + (char-upcase #\A) => #\A + (char-downcase #\a) => #\a + (char-downcase #\A) => #\a + (char-upcase #\9) => #\9 + (char-downcase #\9) => #\9 + (char-upcase #\@) => #\@ + (char-downcase #\@) => #\@ + ;; Note that this next example might run for a very long time in + ;; some implementations if CHAR-CODE-LIMIT happens to be very large + ;; for that implementation. + (dotimes (code char-code-limit) + (let ((char (code-char code))) + (when char + (unless (cond ((upper-case-p char) (char= (char-upcase (char-downcase char)) char)) + ((lower-case-p char) (char= (char-downcase (char-upcase char)) char)) + (t (and (char= (char-upcase (char-downcase char)) char) + (char= (char-downcase (char-upcase char)) char)))) + (return char))))) + => NIL + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + +See Also:: +.......... + +*note upper-case-p:: , *note alpha-char-p:: , *note Characters With +Case::, *note Documentation of Implementation-Defined Scripts:: + +Notes:: +....... + +If the corresponding-char is different than character, then both the +character and the corresponding-char have case. + + Since char-equal ignores the case of the characters it compares, the +corresponding-character is always the same as character under +char-equal. + + +File: gcl.info, Node: upper-case-p, Next: char-code, Prev: char-upcase, Up: Characters Dictionary + +13.2.15 upper-case-p, lower-case-p, both-case-p [Function] +---------------------------------------------------------- + +'upper-case-p' character => generalized-boolean + + 'lower-case-p' character => generalized-boolean + + 'both-case-p' character => generalized-boolean + +Arguments and Values:: +...................... + +character--a character. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +These functions test the case of a given character. + + upper-case-p returns true if character is an uppercase character; +otherwise, returns false. + + lower-case-p returns true if character is a lowercase character; +otherwise, returns false. + + both-case-p returns true if character is a character with case; +otherwise, returns false. + +Examples:: +.......... + + (upper-case-p #\A) => true + (upper-case-p #\a) => false + (both-case-p #\a) => true + (both-case-p #\5) => false + (lower-case-p #\5) => false + (upper-case-p #\5) => false + ;; This next example presupposes an implementation + ;; in which #\Bell is an implementation-defined character. + (lower-case-p #\Bell) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + +See Also:: +.......... + +*note char-upcase:: , char-downcase, *note Characters With Case::, *note +Documentation of Implementation-Defined Scripts:: + + +File: gcl.info, Node: char-code, Next: char-int, Prev: upper-case-p, Up: Characters Dictionary + +13.2.16 char-code [Function] +---------------------------- + +'char-code' character => code + +Arguments and Values:: +...................... + +character--a character. + + code--a character code. + +Description:: +............. + +char-code returns the code attribute of character. + +Examples:: +.......... + + ;; An implementation using ASCII character encoding + ;; might return these values: + (char-code #\$) => 36 + (char-code #\a) => 97 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + +See Also:: +.......... + +*note char-code-limit:: + + +File: gcl.info, Node: char-int, Next: code-char, Prev: char-code, Up: Characters Dictionary + +13.2.17 char-int [Function] +--------------------------- + +'char-int' character => integer + +Arguments and Values:: +...................... + +character--a character. + + integer--a non-negative integer. + +Description:: +............. + +Returns a non-negative integer encoding the character object. The +manner in which the integer is computed is implementation-dependent. In +contrast to sxhash, the result is not guaranteed to be independent of +the particular Lisp image. + + If character has no implementation-defined attributes, the results of +char-int and char-code are the same. + + (char= c1 c2) == (= (char-int c1) (char-int c2)) + + for characters c1 and c2. + +Examples:: +.......... + + (char-int #\A) => 65 ; implementation A + (char-int #\A) => 577 ; implementation B + (char-int #\A) => 262145 ; implementation C + +See Also:: +.......... + +*note char-code:: + + +File: gcl.info, Node: code-char, Next: char-code-limit, Prev: char-int, Up: Characters Dictionary + +13.2.18 code-char [Function] +---------------------------- + +'code-char' code => char-p + +Arguments and Values:: +...................... + +code--a character code. + + char-p--a character or nil. + +Description:: +............. + +Returns a character with the code attribute given by code. If no such +character exists and one cannot be created, nil is returned. + +Examples:: +.......... + + (code-char 65.) => #\A ;in an implementation using ASCII codes + (code-char (char-code #\Space)) => #\Space ;in any implementation + +Affected By:: +............. + +The implementation's character encoding. + +See Also:: +.......... + +*note char-code:: + +Notes:: +....... + + +File: gcl.info, Node: char-code-limit, Next: char-name, Prev: code-char, Up: Characters Dictionary + +13.2.19 char-code-limit [Constant Variable] +------------------------------------------- + +Constant Value:: +................ + +A non-negative integer, the exact magnitude of which is +implementation-dependent, but which is not less than 96 (the number of +standard characters). + +Description:: +............. + +The upper exclusive bound on the value returned by the function +char-code. + +See Also:: +.......... + +*note char-code:: + +Notes:: +....... + +The value of char-code-limit might be larger than the actual number of +characters supported by the implementation. + + +File: gcl.info, Node: char-name, Next: name-char, Prev: char-code-limit, Up: Characters Dictionary + +13.2.20 char-name [Function] +---------------------------- + +'char-name' character => name + +Arguments and Values:: +...................... + +character--a character. + + name--a string or nil. + +Description:: +............. + +Returns a string that is the name of the character, or nil if the +character has no name. + + All non-graphic characters are required to have names unless they +have some implementation-defined attribute which is not null. Whether +or not other characters have names is implementation-dependent. + + The standard characters and have the respective +names "Newline" and "Space". The semi-standard characters , +, , , , and (if they are +supported by the implementation) have the respective names "Tab", +"Page", "Rubout", "Linefeed", "Return", and "Backspace" (in the +indicated case, even though name lookup by "#\" and by the function +name-char is not case sensitive). + +Examples:: +.......... + + (char-name #\ ) => "Space" + (char-name #\Space) => "Space" + (char-name #\Page) => "Page" + + (char-name #\a) + => NIL + OR=> "LOWERCASE-a" + OR=> "Small-A" + OR=> "LA01" + + (char-name #\A) + => NIL + OR=> "UPPERCASE-A" + OR=> "Capital-A" + OR=> "LA02" + + ;; Even though its CHAR-NAME can vary, #\A prints as #\A + (prin1-to-string (read-from-string (format nil "#\\~A" (or (char-name #\A) "A")))) + => "#\\A" + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if character is not a +character. + +See Also:: +.......... + +*note name-char:: , *note Printing Characters:: + +Notes:: +....... + +Non-graphic characters having names are written by the Lisp printer as +"#\" followed by the their name; see *note Printing Characters::. + + +File: gcl.info, Node: name-char, Prev: char-name, Up: Characters Dictionary + +13.2.21 name-char [Function] +---------------------------- + +'name-char' name => char-p + +Arguments and Values:: +...................... + +name--a string designator. + + char-p--a character or nil. + +Description:: +............. + +Returns the character object whose name is name (as determined by +string-equal--i.e., lookup is not case sensitive). If such a character +does not exist, nil is returned. + +Examples:: +.......... + + (name-char 'space) => #\Space + (name-char "space") => #\Space + (name-char "Space") => #\Space + (let ((x (char-name #\a))) + (or (not x) (eql (name-char x) #\a))) => true + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if name is not a string +designator. + +See Also:: +.......... + +*note char-name:: + + +File: gcl.info, Node: Conses, Next: Arrays, Prev: Characters, Up: Top + +14 Conses +********* + +* Menu: + +* Cons Concepts:: +* Conses Dictionary:: + + +File: gcl.info, Node: Cons Concepts, Next: Conses Dictionary, Prev: Conses, Up: Conses + +14.1 Cons Concepts +================== + +A cons is a compound data object having two components called the car +and the cdr. + + car cons rplacd + cdr rplaca + + Figure 14-1: Some defined names relating to conses. + + + Depending on context, a group of connected conses can be viewed in a +variety of different ways. A variety of operations is provided to +support each of these various views. + +* Menu: + +* Conses as Trees:: +* Conses as Lists:: + + +File: gcl.info, Node: Conses as Trees, Next: Conses as Lists, Prev: Cons Concepts, Up: Cons Concepts + +14.1.1 Conses as Trees +---------------------- + +A tree is a binary recursive data structure made up of conses and atoms: +the conses are themselves also trees (sometimes called "subtrees" or +"branches"), and the atoms are terminal nodes (sometimes called leaves +). Typically, the leaves represent data while the branches establish +some relationship among that data. + + caaaar caddar cdar nsubst + caaadr cadddr cddaar nsubst-if + caaar caddr cddadr nsubst-if-not + caadar cadr cddar nthcdr + caaddr cdaaar cdddar sublis + caadr cdaadr cddddr subst + caar cdaar cdddr subst-if + cadaar cdadar cddr subst-if-not + cadadr cdaddr copy-tree tree-equal + cadar cdadr nsublis + + Figure 14-2: Some defined names relating to trees. + + +* Menu: + +* General Restrictions on Parameters that must be Trees:: + + +File: gcl.info, Node: General Restrictions on Parameters that must be Trees, Prev: Conses as Trees, Up: Conses as Trees + +14.1.1.1 General Restrictions on Parameters that must be Trees +.............................................................. + +Except as explicitly stated otherwise, for any standardized function +that takes a parameter that is required to be a tree, the consequences +are undefined if that tree is circular. + + +File: gcl.info, Node: Conses as Lists, Prev: Conses as Trees, Up: Cons Concepts + +14.1.2 Conses as Lists +---------------------- + +A list is a chain of conses in which the car of each cons is an element +of the list, and the cdr of each cons is either the next link in the +chain or a terminating atom. + + A proper list is a list terminated by the empty list. The empty list +is a proper list, but is not a cons. + + An improper list is a list that is not a proper list; that is, it is +a circular list or a dotted list. + + A dotted list is a list that has a terminating atom that is not the +empty list. A non-nil atom by itself is not considered to be a list of +any kind--not even a dotted list. + + A circular list is a chain of conses that has no termination because +some cons in the chain is the cdr of a later cons. + + append last nbutlast rest + butlast ldiff nconc revappend + copy-alist list ninth second + copy-list list* nreconc seventh + eighth list-length nth sixth + endp make-list nthcdr tailp + fifth member pop tenth + first member-if push third + fourth member-if-not pushnew + + Figure 14-3: Some defined names relating to lists. + + +* Menu: + +* Lists as Association Lists:: +* Lists as Sets:: +* General Restrictions on Parameters that must be Lists:: + + +File: gcl.info, Node: Lists as Association Lists, Next: Lists as Sets, Prev: Conses as Lists, Up: Conses as Lists + +14.1.2.1 Lists as Association Lists +................................... + +An association list is a list of conses representing an association of +keys with values, where the car of each cons is the key and the cdr is +the value associated with that key. + + acons assoc-if pairlis rassoc-if + assoc assoc-if-not rassoc rassoc-if-not + + Figure 14-4: Some defined names related to assocation lists. + + + +File: gcl.info, Node: Lists as Sets, Next: General Restrictions on Parameters that must be Lists, Prev: Lists as Association Lists, Up: Conses as Lists + +14.1.2.2 Lists as Sets +...................... + +Lists are sometimes viewed as sets by considering their elements +unordered and by assuming there is no duplication of elements. + + adjoin nset-difference set-difference union + intersection nset-exclusive-or set-exclusive-or + nintersection nunion subsetp + + Figure 14-5: Some defined names related to sets. + + + +File: gcl.info, Node: General Restrictions on Parameters that must be Lists, Prev: Lists as Sets, Up: Conses as Lists + +14.1.2.3 General Restrictions on Parameters that must be Lists +.............................................................. + +Except as explicitly specified otherwise, any standardized function that +takes a parameter that is required to be a list should be prepared to +signal an error of type type-error if the value received is a dotted +list. + + Except as explicitly specified otherwise, for any standardized +function that takes a parameter that is required to be a list, the +consequences are undefined if that list is circular. + + +File: gcl.info, Node: Conses Dictionary, Prev: Cons Concepts, Up: Conses + +14.2 Conses Dictionary +====================== + +* Menu: + +* list (System Class):: +* null (System Class):: +* cons (System Class):: +* atom (Type):: +* cons:: +* consp:: +* atom:: +* rplaca:: +* car:: +* copy-tree:: +* sublis:: +* subst:: +* tree-equal:: +* copy-list:: +* list (Function):: +* list-length:: +* listp:: +* make-list:: +* push:: +* pop:: +* first:: +* nth:: +* endp:: +* null:: +* nconc:: +* append:: +* revappend:: +* butlast:: +* last:: +* ldiff:: +* nthcdr:: +* rest:: +* member (Function):: +* mapc:: +* acons:: +* assoc:: +* copy-alist:: +* pairlis:: +* rassoc:: +* get-properties:: +* getf:: +* remf:: +* intersection:: +* adjoin:: +* pushnew:: +* set-difference:: +* set-exclusive-or:: +* subsetp:: +* union:: + + +File: gcl.info, Node: list (System Class), Next: null (System Class), Prev: Conses Dictionary, Up: Conses Dictionary + +14.2.1 list [System Class] +-------------------------- + +Class Precedence List:: +....................... + +list, sequence, t + +Description:: +............. + +A list is a chain of conses in which the car of each cons is an element +of the list, and the cdr of each cons is either the next link in the +chain or a terminating atom. + + A proper list is a chain of conses terminated by the empty list , (), +which is itself a proper list. A dotted list is a list which has a +terminating atom that is not the empty list. A circular list is a chain +of conses that has no termination because some cons in the chain is the +cdr of a later cons. + + Dotted lists and circular lists are also lists, but usually the +unqualified term "list" within this specification means proper list. +Nevertheless, the type list unambiguously includes dotted lists and +circular lists. + + For each element of a list there is a cons. The empty list has no +elements and is not a cons. + + The types cons and null form an exhaustive partition of the type +list. + +See Also:: +.......... + +*note Left-Parenthesis::, *note Printing Lists and Conses:: + + +File: gcl.info, Node: null (System Class), Next: cons (System Class), Prev: list (System Class), Up: Conses Dictionary + +14.2.2 null [System Class] +-------------------------- + +Class Precedence List:: +....................... + +null, symbol, list, sequence, t + +Description:: +............. + +The only object of type null is nil, which represents the empty list and +can also be notated (). + +See Also:: +.......... + +*note Symbols as Tokens::, *note Left-Parenthesis::, *note Printing +Symbols:: + + +File: gcl.info, Node: cons (System Class), Next: atom (Type), Prev: null (System Class), Up: Conses Dictionary + +14.2.3 cons [System Class] +-------------------------- + +Class Precedence List:: +....................... + +cons, list, sequence, t + +Description:: +............. + +A cons is a compound object having two components, called the car and +cdr. These form a dotted pair. Each component can be any object. + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('cons'{[car-typespec [cdr-typespec]]}) + +Compound Type Specifier Arguments:: +................................... + +car-typespec--a type specifier, or the symbol *. The default is the +symbol *. + + cdr-typespec--a type specifier, or the symbol *. The default is the +symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of conses whose car is constrained to be of type +car-typespec and whose cdr is constrained to be of type cdr-typespec. +(If either car-typespec or cdr-typespec is *, it is as if the type t had +been denoted.) + +See Also:: +.......... + +*note Left-Parenthesis::, *note Printing Lists and Conses:: + + +File: gcl.info, Node: atom (Type), Next: cons, Prev: cons (System Class), Up: Conses Dictionary + +14.2.4 atom [Type] +------------------ + +Supertypes:: +............ + +atom, t + +Description:: +............. + +It is equivalent to (not cons). + + +File: gcl.info, Node: cons, Next: consp, Prev: atom (Type), Up: Conses Dictionary + +14.2.5 cons [Function] +---------------------- + +'cons' object-1 object-2 => cons + +Arguments and Values:: +...................... + +object-1--an object. + + object-2--an object. + + cons--a cons. + +Description:: +............. + +Creates a fresh cons, the car of which is object-1 and the cdr of which +is object-2. + +Examples:: +.......... + + (cons 1 2) => (1 . 2) + (cons 1 nil) => (1) + (cons nil 2) => (NIL . 2) + (cons nil nil) => (NIL) + (cons 1 (cons 2 (cons 3 (cons 4 nil)))) => (1 2 3 4) + (cons 'a 'b) => (A . B) + (cons 'a (cons 'b (cons 'c '()))) => (A B C) + (cons 'a '(b c d)) => (A B C D) + +See Also:: +.......... + +*note list (Function):: + +Notes:: +....... + +If object-2 is a list, cons can be thought of as producing a new list +which is like it but has object-1 prepended. + + +File: gcl.info, Node: consp, Next: atom, Prev: cons, Up: Conses Dictionary + +14.2.6 consp [Function] +----------------------- + +'consp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type cons; otherwise, returns false. + +Examples:: +.......... + + (consp nil) => false + (consp (cons 1 2)) => true + + The empty list is not a cons, so + + (consp '()) == (consp 'nil) => false + +See Also:: +.......... + +*note listp:: + +Notes:: +....... + + (consp object) == (typep object 'cons) == (not (typep object 'atom)) == (typep object '(not atom)) + + +File: gcl.info, Node: atom, Next: rplaca, Prev: consp, Up: Conses Dictionary + +14.2.7 atom [Function] +---------------------- + +'atom' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type atom; otherwise, returns false. + +Examples:: +.......... + + (atom 'sss) => true + (atom (cons 1 2)) => false + (atom nil) => true + (atom '()) => true + (atom 3) => true + +Notes:: +....... + + (atom object) == (typep object 'atom) == (not (consp object)) + == (not (typep object 'cons)) == (typep object '(not cons)) + + +File: gcl.info, Node: rplaca, Next: car, Prev: atom, Up: Conses Dictionary + +14.2.8 rplaca, rplacd [Function] +-------------------------------- + +'rplaca' cons object => cons + + 'rplacd' cons object => cons + +Pronunciation:: +............... + +rplaca: pronounced ,r\=e 'plak e or pronounced ,re 'plak e + + rplacd: pronounced ,r\=e 'plak de or pronounced ,re 'plak de or +pronounced ,r\=e 'plak d\=e or pronounced ,re 'plak d\=e + +Arguments and Values:: +...................... + +cons--a cons. + + object--an object. + +Description:: +............. + +rplaca replaces the car of the cons with object. + + rplacd replaces the cdr of the cons with object. + +Examples:: +.......... + + (defparameter *some-list* (list* 'one 'two 'three 'four)) => *some-list* + *some-list* => (ONE TWO THREE . FOUR) + (rplaca *some-list* 'uno) => (UNO TWO THREE . FOUR) + *some-list* => (UNO TWO THREE . FOUR) + (rplacd (last *some-list*) (list 'IV)) => (THREE IV) + *some-list* => (UNO TWO THREE IV) + +Side Effects:: +.............. + +The cons is modified. + + Should signal an error of type type-error if cons is not a cons. + + +File: gcl.info, Node: car, Next: copy-tree, Prev: rplaca, Up: Conses Dictionary + +14.2.9 car, cdr, +---------------- + +caar, cadr, cdar, cddr, +----------------------- + +caaar, caadr, cadar, caddr, cdaar, cdadr, cddar, cdddr, +------------------------------------------------------- + +caaaar, caaadr, caadar, caaddr, cadaar, cadadr, caddar, cadddr, +--------------------------------------------------------------- + +cdaaar, cdaadr, cdadar, cdaddr, cddaar, cddadr, cdddar, cddddr +-------------------------------------------------------------- + + [Accessor] + + 'car' x => object (setf ('car' x) new-object) + + 'cdr' x => object (setf ('cdr' x) new-object) + + '\vksip 5pt' x => object (setf ('\vksip 5pt' x) new-object) + + 'caar' x => object (setf ('caar' x) new-object) + + 'cadr' x => object (setf ('cadr' x) new-object) + + 'cdar' x => object (setf ('cdar' x) new-object) + + 'cddr' x => object (setf ('cddr' x) new-object) + + '\vksip 5pt' x => object (setf ('\vksip 5pt' x) new-object) + + 'caaar' x => object (setf ('caaar' x) new-object) + + 'caadr' x => object (setf ('caadr' x) new-object) + + 'cadar' x => object (setf ('cadar' x) new-object) + + 'caddr' x => object (setf ('caddr' x) new-object) + + 'cdaar' x => object (setf ('cdaar' x) new-object) + + 'cdadr' x => object (setf ('cdadr' x) new-object) + + 'cddar' x => object (setf ('cddar' x) new-object) + + 'cdddr' x => object (setf ('cdddr' x) new-object) + + '\vksip 5pt' x => object (setf ('\vksip 5pt' x) new-object) + + 'caaaar' x => object (setf ('caaaar' x) new-object) + + 'caaadr' x => object (setf ('caaadr' x) new-object) + + 'caadar' x => object (setf ('caadar' x) new-object) + + 'caaddr' x => object (setf ('caaddr' x) new-object) + + 'cadaar' x => object (setf ('cadaar' x) new-object) + + 'cadadr' x => object (setf ('cadadr' x) new-object) + + 'caddar' x => object (setf ('caddar' x) new-object) + + 'cadddr' x => object (setf ('cadddr' x) new-object) + + 'cdaaar' x => object (setf ('cdaaar' x) new-object) + + 'cdaadr' x => object (setf ('cdaadr' x) new-object) + + 'cdadar' x => object (setf ('cdadar' x) new-object) + + 'cdaddr' x => object (setf ('cdaddr' x) new-object) + + 'cddaar' x => object (setf ('cddaar' x) new-object) + + 'cddadr' x => object (setf ('cddadr' x) new-object) + + 'cdddar' x => object (setf ('cdddar' x) new-object) + + 'cddddr' x => object (setf ('cddddr' x) new-object) + +Pronunciation:: +............... + +cadr: pronounced 'ka ,de r + + caddr: pronounced 'kad e ,de r or pronounced 'ka ,dude r + + cdr: pronounced 'ku ,de r + + cddr: pronounced 'kud e ,de r or pronounced 'ke ,dude r + +Arguments and Values:: +...................... + +x--a list. + + object--an object. + + new-object--an object. + +Description:: +............. + +If x is a cons, car returns the car of that cons. If x is nil, car +returns nil. + + If x is a cons, cdr returns the cdr of that cons. If x is nil, cdr +returns nil. + + Functions are provided which perform compositions of up to four car +and cdr operations. Their names consist of a C, followed by two, three, +or four occurrences of A or D, and finally an R. The series of A's and +D's in each function's name is chosen to identify the series of car and +cdr operations that is performed by the function. The order in which +the A's and D's appear is the inverse of the order in which the +corresponding operations are performed. Figure 14-6 defines the +relationships precisely. + + This place ... Is equivalent to this place ... + (caar x) (car (car x)) + (cadr x) (car (cdr x)) + (cdar x) (cdr (car x)) + (cddr x) (cdr (cdr x)) + (caaar x) (car (car (car x))) + (caadr x) (car (car (cdr x))) + (cadar x) (car (cdr (car x))) + (caddr x) (car (cdr (cdr x))) + (cdaar x) (cdr (car (car x))) + (cdadr x) (cdr (car (cdr x))) + (cddar x) (cdr (cdr (car x))) + (cdddr x) (cdr (cdr (cdr x))) + (caaaar x) (car (car (car (car x)))) + (caaadr x) (car (car (car (cdr x)))) + (caadar x) (car (car (cdr (car x)))) + (caaddr x) (car (car (cdr (cdr x)))) + (cadaar x) (car (cdr (car (car x)))) + (cadadr x) (car (cdr (car (cdr x)))) + (caddar x) (car (cdr (cdr (car x)))) + (cadddr x) (car (cdr (cdr (cdr x)))) + (cdaaar x) (cdr (car (car (car x)))) + (cdaadr x) (cdr (car (car (cdr x)))) + (cdadar x) (cdr (car (cdr (car x)))) + (cdaddr x) (cdr (car (cdr (cdr x)))) + (cddaar x) (cdr (cdr (car (car x)))) + (cddadr x) (cdr (cdr (car (cdr x)))) + (cdddar x) (cdr (cdr (cdr (car x)))) + (cddddr x) (cdr (cdr (cdr (cdr x)))) + + Figure 14-6: CAR and CDR variants + + + setf can also be used with any of these functions to change an +existing component of x, but setf will not make new components. So, for +example, the car of a cons can be assigned with setf of car, but the car +of nil cannot be assigned with setf of car. Similarly, the car of the +car of a cons whose car is a cons can be assigned with setf of caar, but +neither nil nor a cons whose car is nil can be assigned with setf of +caar. + + The argument x is permitted to be a dotted list or a circular list. + +Examples:: +.......... + + (car nil) => NIL + (cdr '(1 . 2)) => 2 + (cdr '(1 2)) => (2) + (cadr '(1 2)) => 2 + (car '(a b c)) => A + (cdr '(a b c)) => (B C) + +Exceptional Situations:: +........................ + +The functions car and cdr should signal type-error if they receive an +argument which is not a list. The other functions (caar, cadr, ... +cddddr) should behave for the purpose of error checking as if defined by +appropriate calls to car and cdr. + +See Also:: +.......... + +*note rplaca:: , *note first:: , *note rest:: + +Notes:: +....... + +The car of a cons can also be altered by using rplaca, and the cdr of a +cons can be altered by using rplacd. + + (car x) == (first x) + (cadr x) == (second x) == (car (cdr x)) + (caddr x) == (third x) == (car (cdr (cdr x))) + (cadddr x) == (fourth x) == (car (cdr (cdr (cdr x)))) + + +File: gcl.info, Node: copy-tree, Next: sublis, Prev: car, Up: Conses Dictionary + +14.2.10 copy-tree [Function] +---------------------------- + +'copy-tree' tree => new-tree + +Arguments and Values:: +...................... + +tree--a tree. + + new-tree--a tree. + +Description:: +............. + +Creates a copy of a tree of conses. + + If tree is not a cons, it is returned; otherwise, the result is a new +cons of the results of calling copy-tree on the car and cdr of tree. In +other words, all conses in the tree represented by tree are copied +recursively, stopping only when non-conses are encountered. + + copy-tree does not preserve circularities and the sharing of +substructure. + +Examples:: +.......... + + (setq object (list (cons 1 "one") + (cons 2 (list 'a 'b 'c)))) + => ((1 . "one") (2 A B C)) + (setq object-too object) => ((1 . "one") (2 A B C)) + (setq copy-as-list (copy-list object)) + (setq copy-as-alist (copy-alist object)) + (setq copy-as-tree (copy-tree object)) + (eq object object-too) => true + (eq copy-as-tree object) => false + (eql copy-as-tree object) => false + (equal copy-as-tree object) => true + (setf (first (cdr (second object))) "a" + (car (second object)) "two" + (car object) '(one . 1)) => (ONE . 1) + object => ((ONE . 1) ("two" "a" B C)) + object-too => ((ONE . 1) ("two" "a" B C)) + copy-as-list => ((1 . "one") ("two" "a" B C)) + copy-as-alist => ((1 . "one") (2 "a" B C)) + copy-as-tree => ((1 . "one") (2 A B C)) + +See Also:: +.......... + +*note tree-equal:: + + +File: gcl.info, Node: sublis, Next: subst, Prev: copy-tree, Up: Conses Dictionary + +14.2.11 sublis, nsublis [Function] +---------------------------------- + +'sublis' alist tree &key key test test-not => new-tree + + 'nsublis' alist tree &key key test test-not => new-tree + +Arguments and Values:: +...................... + +alist--an association list. + + tree--a tree. + + 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. + + new-tree--a tree. + +Description:: +............. + +sublis makes substitutions for objects in tree (a structure of conses). +nsublis is like sublis but destructively modifies the relevant parts of +the tree. + + sublis looks at all subtrees and leaves of tree; if a subtree or leaf +appears as a key in alist (that is, the key and the subtree or leaf +satisfy the test), it is replaced by the object with which that key is +associated. This operation is non-destructive. In effect, sublis can +perform several subst operations simultaneously. + + If sublis succeeds, a new copy of tree is returned in which each +occurrence of such a subtree or leaf is replaced by the object with +which it is associated. If no changes are made, the original tree is +returned. The original tree is left unchanged, but the result tree may +share cells with it. + + nsublis is permitted to modify tree but otherwise returns the same +values as sublis. + +Examples:: +.......... + + (sublis '((x . 100) (z . zprime)) + '(plus x (minus g z x p) 4 . x)) + => (PLUS 100 (MINUS G ZPRIME 100 P) 4 . 100) + (sublis '(((+ x y) . (- x y)) ((- x y) . (+ x y))) + '(* (/ (+ x y) (+ x p)) (- x y)) + :test #'equal) + => (* (/ (- X Y) (+ X P)) (+ X Y)) + (setq tree1 '(1 (1 2) ((1 2 3)) (((1 2 3 4))))) + => (1 (1 2) ((1 2 3)) (((1 2 3 4)))) + (sublis '((3 . "three")) tree1) + => (1 (1 2) ((1 2 "three")) (((1 2 "three" 4)))) + (sublis '((t . "string")) + (sublis '((1 . "") (4 . 44)) tree1) + :key #'stringp) + => ("string" ("string" 2) (("string" 2 3)) ((("string" 2 3 44)))) + tree1 => (1 (1 2) ((1 2 3)) (((1 2 3 4)))) + (setq tree2 '("one" ("one" "two") (("one" "Two" "three")))) + => ("one" ("one" "two") (("one" "Two" "three"))) + (sublis '(("two" . 2)) tree2) + => ("one" ("one" "two") (("one" "Two" "three"))) + tree2 => ("one" ("one" "two") (("one" "Two" "three"))) + (sublis '(("two" . 2)) tree2 :test 'equal) + => ("one" ("one" 2) (("one" "Two" "three"))) + + (nsublis '((t . 'temp)) + tree1 + :key #'(lambda (x) (or (atom x) (< (list-length x) 3)))) + => ((QUOTE TEMP) (QUOTE TEMP) QUOTE TEMP) + +Side Effects:: +.............. + +nsublis modifies tree. + +See Also:: +.......... + +*note subst:: , + + *note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + Because the side-effecting variants (e.g., nsublis) potentially +change the path that is being traversed, their effects in the presence +of shared or circular structure structure may vary in surprising ways +when compared to their non-side-effecting alternatives. To see this, +consider the following side-effect behavior, which might be exhibited by +some implementations: + + (defun test-it (fn) + (let* ((shared-piece (list 'a 'b)) + (data (list shared-piece shared-piece))) + (funcall fn '((a . b) (b . a)) data))) + (test-it #'sublis) => ((B A) (B A)) + (test-it #'nsublis) => ((A B) (A B)) + + +File: gcl.info, Node: subst, Next: tree-equal, Prev: sublis, Up: Conses Dictionary + +14.2.12 subst, subst-if, subst-if-not, nsubst, nsubst-if, nsubst-if-not +----------------------------------------------------------------------- + + [Function] + + 'subst' new old tree &key key test test-not => new-tree + + 'subst-if' new predicate tree &key key => new-tree + + 'subst-if-not' new predicate tree &key key => new-tree + + 'nsubst' new old tree &key key test test-not => new-tree + + 'nsubst-if' new predicate tree &key key => new-tree + + 'nsubst-if-not' new predicate tree &key key => new-tree + +Arguments and Values:: +...................... + +new--an object. + + old--an object. + + predicate--a symbol that names a function, or a function of one +argument that returns a generalized boolean value. + + tree--a tree. + + 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. + + new-tree--a tree. + +Description:: +............. + +subst, subst-if, and subst-if-not perform substitution operations on +tree. Each function searches tree for occurrences of a particular old +item of an element or subexpression that satisfies the test. + + nsubst, nsubst-if, and nsubst-if-not are like subst, subst-if, and +subst-if-not respectively, except that the original tree is modified. + + subst makes a copy of tree, substituting new for every subtree or +leaf of tree (whether the subtree or leaf is a car or a cdr of its +parent) such that old and the subtree or leaf satisfy the test. + + nsubst is a destructive version of subst. The list structure of tree +is altered by destructively replacing with new each leaf of the tree +such that old and the leaf satisfy the test. + + For subst, subst-if, and subst-if-not, if the functions succeed, a +new copy of the tree is returned in which each occurrence of such an +element is replaced by the new element or subexpression. If no changes +are made, the original tree may be returned. The original tree is left +unchanged, but the result tree may share storage with it. + + For nsubst, nsubst-if, and nsubst-if-not the original tree is +modified and returned as the function result, but the result may not be +eq to tree. + +Examples:: +.......... + + (setq tree1 '(1 (1 2) (1 2 3) (1 2 3 4))) => (1 (1 2) (1 2 3) (1 2 3 4)) + (subst "two" 2 tree1) => (1 (1 "two") (1 "two" 3) (1 "two" 3 4)) + (subst "five" 5 tree1) => (1 (1 2) (1 2 3) (1 2 3 4)) + (eq tree1 (subst "five" 5 tree1)) => implementation-dependent + (subst 'tempest 'hurricane + '(shakespeare wrote (the hurricane))) + => (SHAKESPEARE WROTE (THE TEMPEST)) + (subst 'foo 'nil '(shakespeare wrote (twelfth night))) + => (SHAKESPEARE WROTE (TWELFTH NIGHT . FOO) . FOO) + (subst '(a . cons) '(old . pair) + '((old . spice) ((old . shoes) old . pair) (old . pair)) + :test #'equal) + => ((OLD . SPICE) ((OLD . SHOES) A . CONS) (A . CONS)) + + (subst-if 5 #'listp tree1) => 5 + (subst-if-not '(x) #'consp tree1) + => (1 X) + + tree1 => (1 (1 2) (1 2 3) (1 2 3 4)) + (nsubst 'x 3 tree1 :key #'(lambda (y) (and (listp y) (third y)))) + => (1 (1 2) X X) + tree1 => (1 (1 2) X X) + +Side Effects:: +.............. + +nsubst, nsubst-if, and nsubst-if-not might alter the tree structure of +tree. + +See Also:: +.......... + +*note substitute:: , nsubstitute, + + *note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + The functions subst-if-not and nsubst-if-not are deprecated. + + One possible definition of subst: + + (defun subst (old new tree &rest x &key test test-not key) + (cond ((satisfies-the-test old tree :test test + :test-not test-not :key key) + new) + ((atom tree) tree) + (t (let ((a (apply #'subst old new (car tree) x)) + (d (apply #'subst old new (cdr tree) x))) + (if (and (eql a (car tree)) + (eql d (cdr tree))) + tree + (cons a d)))))) + + +File: gcl.info, Node: tree-equal, Next: copy-list, Prev: subst, Up: Conses Dictionary + +14.2.13 tree-equal [Function] +----------------------------- + +'tree-equal' tree-1 tree-2 &key test test-not => generalized-boolean + +Arguments and Values:: +...................... + +tree-1--a tree. + + tree-2--a tree. + + 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. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +tree-equal tests whether two trees are of the same shape and have the +same leaves. tree-equal returns true if tree-1 and tree-2 are both +atoms and satisfy the test, or if they are both conses and the car of +tree-1 is tree-equal to the car of tree-2 and the cdr of tree-1 is +tree-equal to the cdr of tree-2. Otherwise, tree-equal returns false. + + tree-equal recursively compares conses but not any other objects that +have components. + + The first argument to the :test or :test-not function is tree-1 or a +car or cdr of tree-1; the second argument is tree-2 or a car or cdr of +tree-2. + +Examples:: +.......... + + (setq tree1 '(1 (1 2)) + tree2 '(1 (1 2))) => (1 (1 2)) + (tree-equal tree1 tree2) => true + (eql tree1 tree2) => false + (setq tree1 '('a ('b 'c)) + tree2 '('a ('b 'c))) => ('a ('b 'c)) + => ((QUOTE A) ((QUOTE B) (QUOTE C))) + (tree-equal tree1 tree2 :test 'eq) => true + +Exceptional Situations:: +........................ + +The consequences are undefined if both tree-1 and tree-2 are circular. + +See Also:: +.......... + +*note equal:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + +File: gcl.info, Node: copy-list, Next: list (Function), Prev: tree-equal, Up: Conses Dictionary + +14.2.14 copy-list [Function] +---------------------------- + +'copy-list' list => copy + +Arguments and Values:: +...................... + +list--a proper list or a dotted list. + + copy--a list. + +Description:: +............. + +Returns a copy of list. If list is a dotted list, the resulting list +will also be a dotted list. + + Only the list structure of list is copied; the elements of the +resulting list are the same as the corresponding elements of the given +list. + +Examples:: +.......... + + (setq lst (list 1 (list 2 3))) => (1 (2 3)) + (setq slst lst) => (1 (2 3)) + (setq clst (copy-list lst)) => (1 (2 3)) + (eq slst lst) => true + (eq clst lst) => false + (equal clst lst) => true + (rplaca lst "one") => ("one" (2 3)) + slst => ("one" (2 3)) + clst => (1 (2 3)) + (setf (caadr lst) "two") => "two" + lst => ("one" ("two" 3)) + slst => ("one" ("two" 3)) + clst => (1 ("two" 3)) + +Exceptional Situations:: +........................ + +The consequences are undefined if list is a circular list. + +See Also:: +.......... + +*note copy-alist:: , *note copy-seq:: , *note copy-tree:: + +Notes:: +....... + +The copy created is equal to list, but not eq. + + +File: gcl.info, Node: list (Function), Next: list-length, Prev: copy-list, Up: Conses Dictionary + +14.2.15 list, list* [Function] +------------------------------ + +'list' &rest objects => list + + 'list*' &rest objects^+ => result + +Arguments and Values:: +...................... + +object--an object. + + list--a list. + + result--an object. + +Description:: +............. + +list returns a list containing the supplied objects. + + list* is like list except that the last argument to list becomes the +car of the last cons constructed, while the last argument to list* +becomes the cdr of the last cons constructed. Hence, any given call to +list* always produces one fewer conses than a call to list with the same +number of arguments. + + If the last argument to list* is a list, the effect is to construct a +new list which is similar, but which has additional elements added to +the front corresponding to the preceding arguments of list*. + + If list* receives only one object, that object is returned, +regardless of whether or not it is a list. + +Examples:: +.......... + + (list 1) => (1) + (list* 1) => 1 + (setq a 1) => 1 + (list a 2) => (1 2) + '(a 2) => (A 2) + (list 'a 2) => (A 2) + (list* a 2) => (1 . 2) + (list) => NIL ;i.e., () + (setq a '(1 2)) => (1 2) + (eq a (list* a)) => true + (list 3 4 'a (car '(b . c)) (+ 6 -2)) => (3 4 A B 4) + (list* 'a 'b 'c 'd) == (cons 'a (cons 'b (cons 'c 'd))) => (A B C . D) + (list* 'a 'b 'c '(d e f)) => (A B C D E F) + +See Also:: +.......... + +*note cons:: + +Notes:: +....... + + (list* x) == x + + +File: gcl.info, Node: list-length, Next: listp, Prev: list (Function), Up: Conses Dictionary + +14.2.16 list-length [Function] +------------------------------ + +'list-length' list => length + +Arguments and Values:: +...................... + +list--a proper list or a circular list. + + length--a non-negative integer, or nil. + +Description:: +............. + +Returns the length of list if list is a proper list. Returns nil if +list is a circular list. + +Examples:: +.......... + + (list-length '(a b c d)) => 4 + (list-length '(a (b c) d)) => 3 + (list-length '()) => 0 + (list-length nil) => 0 + (defun circular-list (&rest elements) + (let ((cycle (copy-list elements))) + (nconc cycle cycle))) + (list-length (circular-list 'a 'b)) => NIL + (list-length (circular-list 'a)) => NIL + (list-length (circular-list)) => 0 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if list is not a proper list +or a circular list. + +See Also:: +.......... + +*note length:: + +Notes:: +....... + +list-length could be implemented as follows: + + (defun list-length (x) + (do ((n 0 (+ n 2)) ;Counter. + (fast x (cddr fast)) ;Fast pointer: leaps by 2. + (slow x (cdr slow))) ;Slow pointer: leaps by 1. + (nil) + ;; If fast pointer hits the end, return the count. + (when (endp fast) (return n)) + (when (endp (cdr fast)) (return (+ n 1))) + ;; If fast pointer eventually equals slow pointer, + ;; then we must be stuck in a circular list. + ;; (A deeper property is the converse: if we are + ;; stuck in a circular list, then eventually the + ;; fast pointer will equal the slow pointer. + ;; That fact justifies this implementation.) + (when (and (eq fast slow) (> n 0)) (return nil)))) + + + +File: gcl.info, Node: listp, Next: make-list, Prev: list-length, Up: Conses Dictionary + +14.2.17 listp [Function] +------------------------ + +'listp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type list; otherwise, returns false. + +Examples:: +.......... + + (listp nil) => true + (listp (cons 1 2)) => true + (listp (make-array 6)) => false + (listp t) => false + +See Also:: +.......... + +*note consp:: + +Notes:: +....... + +If object is a cons, listp does not check whether object is a proper +list; it returns true for any kind of list. + + (listp object) == (typep object 'list) == (typep object '(or cons null)) + + +File: gcl.info, Node: make-list, Next: push, Prev: listp, Up: Conses Dictionary + +14.2.18 make-list [Function] +---------------------------- + +'make-list' size &key initial-element => list + +Arguments and Values:: +...................... + +size--a non-negative integer. + + initial-element--an object. The default is nil. + + list--a list. + +Description:: +............. + +Returns a list of length given by size, each of the elements of which is +initial-element. + +Examples:: +.......... + + (make-list 5) => (NIL NIL NIL NIL NIL) + (make-list 3 :initial-element 'rah) => (RAH RAH RAH) + (make-list 2 :initial-element '(1 2 3)) => ((1 2 3) (1 2 3)) + (make-list 0) => NIL ;i.e., () + (make-list 0 :initial-element 'new-element) => NIL + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if size is not a non-negative +integer. + +See Also:: +.......... + +*note cons:: , *note list (Function):: + + +File: gcl.info, Node: push, Next: pop, Prev: make-list, Up: Conses Dictionary + +14.2.19 push [Macro] +-------------------- + +'push' item place => new-place-value + +Arguments and Values:: +...................... + +item--an object. + + place--a place, the value of which may be any object. + + new-place-value--a list (the new value of place). + +Description:: +............. + +push prepends item to the list that is stored in place, stores the +resulting list in place, and returns the list. + + For information about the evaluation of subforms of place, see *note +Evaluation of Subforms to Places::. + +Examples:: +.......... + + (setq llst '(nil)) => (NIL) + (push 1 (car llst)) => (1) + llst => ((1)) + (push 1 (car llst)) => (1 1) + llst => ((1 1)) + (setq x '(a (b c) d)) => (A (B C) D) + (push 5 (cadr x)) => (5 B C) + x => (A (5 B C) D) + +Side Effects:: +.............. + +The contents of place are modified. + +See Also:: +.......... + +*note pop:: , *note pushnew:: , *note Generalized Reference:: + +Notes:: +....... + +The effect of (push item place) is equivalent to + + (setf place (cons item place)) + + except that the subforms of place are evaluated only once, and item +is evaluated before place. + + +File: gcl.info, Node: pop, Next: first, Prev: push, Up: Conses Dictionary + +14.2.20 pop [Macro] +------------------- + +'pop' place => element + +Arguments and Values:: +...................... + +place--a place, the value of which is a list (possibly, but necessarily, +a dotted list or circular list). + + element--an object (the car of the contents of place). + +Description:: +............. + +pop reads the value of place, remembers the car of the list which was +retrieved, writes the cdr of the list back into the place, and finally +yields the car of the originally retrieved list. + + For information about the evaluation of subforms of place, see *note +Evaluation of Subforms to Places::. + +Examples:: +.......... + + (setq stack '(a b c)) => (A B C) + (pop stack) => A + stack => (B C) + (setq llst '((1 2 3 4))) => ((1 2 3 4)) + (pop (car llst)) => 1 + llst => ((2 3 4)) + +Side Effects:: +.............. + +The contents of place are modified. + +See Also:: +.......... + +*note push:: , *note pushnew:: , *note Generalized Reference:: + +Notes:: +....... + +The effect of (pop place) is roughly equivalent to + + (prog1 (car place) (setf place (cdr place))) + + except that the latter would evaluate any subforms of place three +times, while pop evaluates them only once. + + +File: gcl.info, Node: first, Next: nth, Prev: pop, Up: Conses Dictionary + +14.2.21 first, second, third, fourth, fifth, +-------------------------------------------- + +sixth, seventh, eighth, ninth, tenth +------------------------------------ + + [Accessor] + + 'first' list => object (setf ('first' list) new-object) + + 'second' list => object (setf ('second' list) new-object) + + 'third' list => object (setf ('third' list) new-object) + + 'fourth' list => object (setf ('fourth' list) new-object) + + 'fifth' list => object (setf ('fifth' list) new-object) + + 'sixth' list => object (setf ('sixth' list) new-object) + + 'seventh' list => object (setf ('seventh' list) new-object) + + 'eighth' list => object (setf ('eighth' list) new-object) + + 'ninth' list => object (setf ('ninth' list) new-object) + + 'tenth' list => object (setf ('tenth' list) new-object) + +Arguments and Values:: +...................... + +list--a list, + + which might be a dotted list or a circular list. + + object, new-object--an object. + +Description:: +............. + +The functions first, second, third, fourth, fifth, sixth, seventh, +eighth, ninth, and tenth access the first, second, third, fourth, fifth, +sixth, seventh, eighth, ninth, and tenth elements of list, respectively. +Specifically, + + (first list) == (car list) + (second list) == (car (cdr list)) + (third list) == (car (cddr list)) + (fourth list) == (car (cdddr list)) + (fifth list) == (car (cddddr list)) + (sixth list) == (car (cdr (cddddr list))) + (seventh list) == (car (cddr (cddddr list))) + (eighth list) == (car (cdddr (cddddr list))) + (ninth list) == (car (cddddr (cddddr list))) + (tenth list) == (car (cdr (cddddr (cddddr list)))) + + setf can also be used with any of these functions to change an +existing component. The same equivalences apply. For example: + + (setf (fifth list) new-object) == (setf (car (cddddr list)) new-object) + +Examples:: +.......... + + (setq lst '(1 2 3 (4 5 6) ((V)) vi 7 8 9 10)) + => (1 2 3 (4 5 6) ((V)) VI 7 8 9 10) + (first lst) => 1 + (tenth lst) => 10 + (fifth lst) => ((V)) + (second (fourth lst)) => 5 + (sixth '(1 2 3)) => NIL + (setf (fourth lst) "four") => "four" + lst => (1 2 3 "four" ((V)) VI 7 8 9 10) + +See Also:: +.......... + +*note car:: , *note nth:: + +Notes:: +....... + +first is functionally equivalent to car, second is functionally +equivalent to cadr, third is functionally equivalent to caddr, and +fourth is functionally equivalent to cadddr. + + The ordinal numbering used here is one-origin, as opposed to the +zero-origin numbering used by nth: + + (fifth x) == (nth 4 x) + + +File: gcl.info, Node: nth, Next: endp, Prev: first, Up: Conses Dictionary + +14.2.22 nth [Accessor] +---------------------- + +'nth' n list => object + + (setf (' nth' n list) new-object) + +Arguments and Values:: +...................... + +n--a non-negative integer. + + list--a list, + + which might be a dotted list or a circular list. + + object--an object. + + new-object--an object. + +Description:: +............. + +nth locates the nth element of list, where the car of the list is the +"zeroth" element. + + Specifically, + + (nth n list) == (car (nthcdr n list)) + + nth may be used to specify a place to setf. + + Specifically, + + (setf (nth n list) new-object) == (setf (car (nthcdr n list)) new-object) + +Examples:: +.......... + + (nth 0 '(foo bar baz)) => FOO + (nth 1 '(foo bar baz)) => BAR + (nth 3 '(foo bar baz)) => NIL + (setq 0-to-3 (list 0 1 2 3)) => (0 1 2 3) + (setf (nth 2 0-to-3) "two") => "two" + 0-to-3 => (0 1 "two" 3) + +See Also:: +.......... + +*note elt:: , *note first:: , *note nthcdr:: + + +File: gcl.info, Node: endp, Next: null, Prev: nth, Up: Conses Dictionary + +14.2.23 endp [Function] +----------------------- + +'endp' list => generalized-boolean + +Arguments and Values:: +...................... + +list--a list, + + which might be a dotted list or a circular list. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if list is the empty list. Returns false if list is a +cons. + +Examples:: +.......... + + (endp nil) => true + (endp '(1 2)) => false + (endp (cddr '(1 2))) => true + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if list is not a list. + +Notes:: +....... + +The purpose of endp is to test for the end of proper list. Since endp +does not descend into a cons, it is well-defined to pass it a dotted +list. However, if shorter "lists" are iteratively produced by calling +cdr on such a dotted list and those "lists" are tested with endp, a +situation that has undefined consequences will eventually result when +the non-nil atom (which is not in fact a list) finally becomes the +argument to endp. Since this is the usual way in which endp is used, it +is conservative programming style and consistent with the intent of endp +to treat endp as simply a function on proper lists which happens not to +enforce an argument type of proper list except when the argument is +atomic. + + +File: gcl.info, Node: null, Next: nconc, Prev: endp, Up: Conses Dictionary + +14.2.24 null [Function] +----------------------- + +'null' object => boolean + +Arguments and Values:: +...................... + +object--an object. + + boolean--a boolean. + +Description:: +............. + +Returns t if object is the empty list; otherwise, returns nil. + +Examples:: +.......... + + (null '()) => T + (null nil) => T + (null t) => NIL + (null 1) => NIL + +See Also:: +.......... + +*note not:: + +Notes:: +....... + +null is intended to be used to test for the empty list whereas not is +intended to be used to invert a boolean (or generalized boolean). +Operationally, null and not compute the same result; which to use is a +matter of style. + + (null object) == (typep object 'null) == (eq object '()) + + +File: gcl.info, Node: nconc, Next: append, Prev: null, Up: Conses Dictionary + +14.2.25 nconc [Function] +------------------------ + +'nconc' &rest lists => concatenated-list + +Arguments and Values:: +...................... + +list--each but the last must be a list (which might be a dotted list but +must not be a circular list); the last list may be any object. + + concatenated-list--a list. + +Description:: +............. + +Returns a list that is the concatenation of lists. If no lists are +supplied, (nconc) returns nil. + + nconc is defined using the following recursive relationship: + + (nconc) => () + (nconc nil . lists) == (nconc . lists) + (nconc list) => list + (nconc list-1 list-2) == (progn (rplacd (last list-1) list-2) list-1) + (nconc list-1 list-2 . lists) == (nconc (nconc list-1 list-2) . lists) + +Examples:: +.......... + + (nconc) => NIL + (setq x '(a b c)) => (A B C) + (setq y '(d e f)) => (D E F) + (nconc x y) => (A B C D E F) + x => (A B C D E F) + + Note, in the example, that the value of x is now different, since its +last cons has been rplacd'd to the value of y. If (nconc x y) were +evaluated again, it would yield a piece of a circular list, whose +printed representation would be (A B C D E F D E F D E F ...), repeating +forever; if the *print-circle* switch were non-nil, it would be printed +as (A B C . #1=(D E F . #1#)). + + (setq foo (list 'a 'b 'c 'd 'e) + bar (list 'f 'g 'h 'i 'j) + baz (list 'k 'l 'm)) => (K L M) + (setq foo (nconc foo bar baz)) => (A B C D E F G H I J K L M) + foo => (A B C D E F G H I J K L M) + bar => (F G H I J K L M) + baz => (K L M) + + (setq foo (list 'a 'b 'c 'd 'e) + bar (list 'f 'g 'h 'i 'j) + baz (list 'k 'l 'm)) => (K L M) + (setq foo (nconc nil foo bar nil baz)) => (A B C D E F G H I J K L M) + foo => (A B C D E F G H I J K L M) + bar => (F G H I J K L M) + baz => (K L M) + +Side Effects:: +.............. + +The lists are modified rather than copied. + +See Also:: +.......... + +*note append:: , *note concatenate:: + + +File: gcl.info, Node: append, Next: revappend, Prev: nconc, Up: Conses Dictionary + +14.2.26 append [Function] +------------------------- + +'append' &rest lists => result + +Arguments and Values:: +...................... + +list--each must be a proper list except the last, which may be any +object. + + result--an object. This will be a list unless the last list was not +a list and all preceding lists were null. + +Description:: +............. + +append returns a new list that is the concatenation of the copies. +lists are left unchanged; the list structure of each of lists except the +last is copied. The last argument is not copied; it becomes the cdr of +the final dotted pair of the concatenation of the preceding lists, or is +returned directly if there are no preceding non-empty lists. + +Examples:: +.......... + + (append '(a b c) '(d e f) '() '(g)) => (A B C D E F G) + (append '(a b c) 'd) => (A B C . D) + (setq lst '(a b c)) => (A B C) + (append lst '(d)) => (A B C D) + lst => (A B C) + (append) => NIL + (append 'a) => A + +See Also:: +.......... + +*note nconc:: , *note concatenate:: + + +File: gcl.info, Node: revappend, Next: butlast, Prev: append, Up: Conses Dictionary + +14.2.27 revappend, nreconc [Function] +------------------------------------- + +'revappend' list tail => result-list + + 'nreconc' list tail => result-list + +Arguments and Values:: +...................... + +list--a proper list. + + tail--an object. + + result-list--an object. + +Description:: +............. + +revappend constructs a copy_2 of list, but with the elements in reverse +order. It then appends (as if by nconc) the tail to that reversed list +and returns the result. + + nreconc reverses the order of elements in list (as if by nreverse). +It then appends (as if by nconc) the tail to that reversed list and +returns the result. + + The resulting list shares list structure with tail. + +Examples:: +.......... + + (let ((list-1 (list 1 2 3)) + (list-2 (list 'a 'b 'c))) + (print (revappend list-1 list-2)) + (print (equal list-1 '(1 2 3))) + (print (equal list-2 '(a b c)))) + |> (3 2 1 A B C) + |> T + |> T + => T + + (revappend '(1 2 3) '()) => (3 2 1) + (revappend '(1 2 3) '(a . b)) => (3 2 1 A . B) + (revappend '() '(a b c)) => (A B C) + (revappend '(1 2 3) 'a) => (3 2 1 . A) + (revappend '() 'a) => A ;degenerate case + + (let ((list-1 '(1 2 3)) + (list-2 '(a b c))) + (print (nreconc list-1 list-2)) + (print (equal list-1 '(1 2 3))) + (print (equal list-2 '(a b c)))) + |> (3 2 1 A B C) + |> NIL + |> T + => T + + +Side Effects:: +.............. + +revappend does not modify either of its arguments. nreconc is permitted +to modify list but not tail. + + Although it might be implemented differently, nreconc is constrained +to have side-effect behavior equivalent to: + + (nconc (nreverse list) tail) + +See Also:: +.......... + +*note reverse:: , nreverse, *note nconc:: + +Notes:: +....... + +The following functional equivalences are true, although good +implementations will typically use a faster algorithm for achieving the +same effect: + + (revappend list tail) == (nconc (reverse list) tail) + (nreconc list tail) == (nconc (nreverse list) tail) + + +File: gcl.info, Node: butlast, Next: last, Prev: revappend, Up: Conses Dictionary + +14.2.28 butlast, nbutlast [Function] +------------------------------------ + +'butlast' list &optional n => result-list + + 'nbutlast' list &optional n => result-list + +Arguments and Values:: +...................... + +list--a list, + + which might be a dotted list but must not be a circular list. + + n--a non-negative integer. + + result-list--a list. + +Description:: +............. + +butlast returns a copy of list from which the last n + + conses + + have been omitted. If n is not supplied, its value is 1. If there +are fewer than n + + conses + + in list, nil is returned and, in the case of nbutlast, list is not +modified. + + nbutlast is like butlast, but nbutlast may modify list. It changes +the cdr of the cons n+1 from the end of the list to nil. + +Examples:: +.......... + + (setq lst '(1 2 3 4 5 6 7 8 9)) => (1 2 3 4 5 6 7 8 9) + (butlast lst) => (1 2 3 4 5 6 7 8) + (butlast lst 5) => (1 2 3 4) + (butlast lst (+ 5 5)) => NIL + lst => (1 2 3 4 5 6 7 8 9) + (nbutlast lst 3) => (1 2 3 4 5 6) + lst => (1 2 3 4 5 6) + (nbutlast lst 99) => NIL + lst => (1 2 3 4 5 6) + (butlast '(a b c d)) => (A B C) + (butlast '((a b) (c d))) => ((A B)) + (butlast '(a)) => NIL + (butlast nil) => NIL + (setq foo (list 'a 'b 'c 'd)) => (A B C D) + (nbutlast foo) => (A B C) + foo => (A B C) + (nbutlast (list 'a)) => NIL + (nbutlast '()) => NIL + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if list is not a proper list +or a dotted list. + + Should signal an error of type type-error if n is not a non-negative +integer. + +Notes:: +....... + + (butlast list n) == (ldiff list (last list n)) + + +File: gcl.info, Node: last, Next: ldiff, Prev: butlast, Up: Conses Dictionary + +14.2.29 last [Function] +----------------------- + +'last' list &optional n => tail + +Arguments and Values:: +...................... + +list--a list, + + which might be a dotted list but must not be a circular list. + + n--a non-negative integer. The default is 1. + + tail--an object. + +Description:: +............. + +last returns the last n conses (not the last n elements) of list). If +list is (), last returns (). + + If n is zero, the atom that terminates list is returned. If n is +greater than or equal to the number of cons cells in list, the result is +list. + +Examples:: +.......... + + (last nil) => NIL + (last '(1 2 3)) => (3) + (last '(1 2 . 3)) => (2 . 3) + (setq x (list 'a 'b 'c 'd)) => (A B C D) + (last x) => (D) + (rplacd (last x) (list 'e 'f)) x => (A B C D E F) + (last x) => (F) + + (last '(a b c)) => (C) + + (last '(a b c) 0) => () + (last '(a b c) 1) => (C) + (last '(a b c) 2) => (B C) + (last '(a b c) 3) => (A B C) + (last '(a b c) 4) => (A B C) + + (last '(a . b) 0) => B + (last '(a . b) 1) => (A . B) + (last '(a . b) 2) => (A . B) + +Exceptional Situations:: +........................ + +The consequences are undefined if list is a circular list. + + Should signal an error of type type-error if n is not a non-negative +integer. + +See Also:: +.......... + +*note butlast:: , *note nth:: + +Notes:: +....... + +The following code could be used to define last. + + (defun last (list &optional (n 1)) + (check-type n (integer 0)) + (do ((l list (cdr l)) + (r list) + (i 0 (+ i 1))) + ((atom l) r) + (if (>= i n) (pop r)))) + + +File: gcl.info, Node: ldiff, Next: nthcdr, Prev: last, Up: Conses Dictionary + +14.2.30 ldiff, tailp [Function] +------------------------------- + +'ldiff' list object => result-list + + 'tailp' object list => generalized-boolean + +Arguments and Values:: +...................... + +list--a list, + + which might be a dotted list. + + object--an object. + + result-list--a list. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +If object is the same as some tail of list, tailp returns true; +otherwise, it returns false. + + If object is the same as some tail of list, ldiff returns a fresh +list of the elements of list that precede object in the list structure +of list; otherwise, it returns a copy_2 of list. + +Examples:: +.......... + + (let ((lists '#((a b c) (a b c . d)))) + (dotimes (i (length lists)) () + (let ((list (aref lists i))) + (format t "~2&list=~S ~21T(tailp object list)~ + ~44T(ldiff list object)~ + (let ((objects (vector list (cddr list) (copy-list (cddr list)) + '(f g h) '() 'd 'x))) + (dotimes (j (length objects)) () + (let ((object (aref objects j))) + (format t "~& object=~S ~21T~S ~44T~S" + object (tailp object list) (ldiff list object)))))))) + |> + |> list=(A B C) (tailp object list) (ldiff list object) + |> object=(A B C) T NIL + |> object=(C) T (A B) + |> object=(C) NIL (A B C) + |> object=(F G H) NIL (A B C) + |> object=NIL T (A B C) + |> object=D NIL (A B C) + |> object=X NIL (A B C) + |> + |> list=(A B C . D) (tailp object list) (ldiff list object) + |> object=(A B C . D) T NIL + |> object=(C . D) T (A B) + |> object=(C . D) NIL (A B C . D) + |> object=(F G H) NIL (A B C . D) + |> object=NIL NIL (A B C . D) + |> object=D T (A B C) + |> object=X NIL (A B C . D) + => NIL + +Side Effects:: +.............. + +Neither ldiff nor tailp modifies either of its arguments. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list is not +a proper list or a dotted list. + +See Also:: +.......... + +*note set-difference:: + +Notes:: +....... + +If the list is a circular list, tailp will reliably yield a value only +if the given object is in fact a tail of list. Otherwise, the +consequences are unspecified: a given implementation which detects the +circularity must return false, but since an implementation is not +obliged to detect such a situation, tailp might just loop indefinitely +without returning in that case. + + tailp could be defined as follows: + + (defun tailp (object list) + (do ((list list (cdr list))) + ((atom list) (eql list object)) + (if (eql object list) + (return t)))) + + and ldiff could be defined by: + + (defun ldiff (list object) + (do ((list list (cdr list)) + (r '() (cons (car list) r))) + ((atom list) + (if (eql list object) (nreverse r) (nreconc r list))) + (when (eql object list) + (return (nreverse r))))) + + +File: gcl.info, Node: nthcdr, Next: rest, Prev: ldiff, Up: Conses Dictionary + +14.2.31 nthcdr [Function] +------------------------- + +'nthcdr' n list => tail + +Arguments and Values:: +...................... + +n--a non-negative integer. + + list--a list, + + which might be a dotted list or a circular list. + + tail--an object. + +Description:: +............. + +Returns the tail of list that would be obtained by calling cdr n times +in succession. + +Examples:: +.......... + + (nthcdr 0 '()) => NIL + (nthcdr 3 '()) => NIL + (nthcdr 0 '(a b c)) => (A B C) + (nthcdr 2 '(a b c)) => (C) + (nthcdr 4 '(a b c)) => () + (nthcdr 1 '(0 . 1)) => 1 + + (locally (declare (optimize (safety 3))) + (nthcdr 3 '(0 . 1))) + Error: Attempted to take CDR of 1. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if n is not a non-negative +integer. + + For n being an integer greater than 1, the error checking done by +(nthcdr n list) is the same as for (nthcdr (- n 1) (cdr list)); see the +function cdr. + +See Also:: +.......... + +cdr, *note nth:: , *note rest:: + + +File: gcl.info, Node: rest, Next: member (Function), Prev: nthcdr, Up: Conses Dictionary + +14.2.32 rest [Accessor] +----------------------- + +'rest' list => tail + + (setf (' rest' list) new-tail) + +Arguments and Values:: +...................... + +list--a list, + + which might be a dotted list or a circular list. + + tail--an object. + +Description:: +............. + +rest performs the same operation as cdr, but mnemonically complements +first. Specifically, + + (rest list) == (cdr list) + (setf (rest list) new-tail) == (setf (cdr list) new-tail) + +Examples:: +.......... + + (rest '(1 2)) => (2) + (rest '(1 . 2)) => 2 + (rest '(1)) => NIL + (setq *cons* '(1 . 2)) => (1 . 2) + (setf (rest *cons*) "two") => "two" + *cons* => (1 . "two") + +See Also:: +.......... + +cdr, *note nthcdr:: + +Notes:: +....... + +rest is often preferred stylistically over cdr when the argument is to +being subjectively viewed as a list rather than as a cons. + + +File: gcl.info, Node: member (Function), Next: mapc, Prev: rest, Up: Conses Dictionary + +14.2.33 member, member-if, member-if-not [Function] +--------------------------------------------------- + +'member' item list &key key test test-not => tail + + 'member-if' predicate list &key key => tail + + 'member-if-not' predicate list &key key => tail + +Arguments and Values:: +...................... + +item--an object. + + list--a proper list. + + predicate--a designator for a function of one argument that returns a +generalized boolean. + + 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. + + tail--a list. + +Description:: +............. + +member, member-if, and member-if-not each search list for item or for a +top-level element that satisfies the test. The argument to the +predicate function is an element of list. + + If some element satisfies the test, the tail of list beginning with +this element is returned; otherwise nil is returned. + + list is searched on the top level only. + +Examples:: +.......... + + (member 2 '(1 2 3)) => (2 3) + (member 2 '((1 . 2) (3 . 4)) :test-not #'= :key #'cdr) => ((3 . 4)) + (member 'e '(a b c d)) => NIL + + (member-if #'listp '(a b nil c d)) => (NIL C D) + (member-if #'numberp '(a #\Space 5/3 foo)) => (5/3 FOO) + (member-if-not #'zerop + '(3 6 9 11 . 12) + :key #'(lambda (x) (mod x 3))) => (11 . 12) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list is not +a proper list. + +See Also:: +.......... + +*note find:: , *note position:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + The function member-if-not is deprecated. + + In the following + + (member 'a '(g (a y) c a d e a f)) => (A D E A F) + + the value returned by member is identical to the portion of the list +beginning with a. Thus rplaca on the result of member can be used to +alter the part of the list where a was found (assuming a check has been +made that member did not return nil). + + +File: gcl.info, Node: mapc, Next: acons, Prev: member (Function), Up: Conses Dictionary + +14.2.34 mapc, mapcar, mapcan, mapl, maplist, mapcon [Function] +-------------------------------------------------------------- + +'mapc' function &rest lists^+ => list-1 + + 'mapcar' function &rest lists^+ => result-list + + 'mapcan' function &rest lists^+ => concatenated-results + + 'mapl' function &rest lists^+ => list-1 + + 'maplist' function &rest lists^+ => result-list + + 'mapcon' function &rest lists^+ => concatenated-results + +Arguments and Values:: +...................... + +function--a designator for a function that must take as many arguments +as there are lists. + + list--a proper list. + + list-1--the first list (which must be a proper list). + + result-list--a list. + + concatenated-results--a list. + +Description:: +............. + +The mapping operation involves applying function to successive sets of +arguments in which one argument is obtained from each sequence. Except +for mapc and mapl, the result contains the results returned by function. +In the cases of mapc and mapl, the resulting sequence is list. + + function is called first on all the elements with index 0, then on +all those with index 1, and so on. result-type specifies the type of +the resulting sequence. + + If function is a symbol, it is coerced to a function as if by +symbol-function. + + mapcar operates on successive elements of the lists. function is +applied to the first element of each list, then to the second element of +each list, and so on. The iteration terminates when the shortest list +runs out, and excess elements in other lists are ignored. The value +returned by mapcar is a list of the results of successive calls to +function. + + mapc is like mapcar except that the results of applying function are +not accumulated. The list argument is returned. + + maplist is like mapcar except that function is applied to successive +sublists of the lists. function is first applied to the lists +themselves, and then to the cdr of each list, and then to the cdr of the +cdr of each list, and so on. + + mapl is like maplist except that the results of applying function are +not accumulated; list-1 is returned. + + mapcan and mapcon are like mapcar and maplist respectively, except +that the results of applying function are combined into a list by the +use of nconc rather than list. That is, + + (mapcon f x1 ... xn) + == (apply #'nconc (maplist f x1 ... xn)) + + and similarly for the relationship between mapcan and mapcar. + +Examples:: +.......... + + (mapcar #'car '((1 a) (2 b) (3 c))) => (1 2 3) + (mapcar #'abs '(3 -4 2 -5 -6)) => (3 4 2 5 6) + (mapcar #'cons '(a b c) '(1 2 3)) => ((A . 1) (B . 2) (C . 3)) + + (maplist #'append '(1 2 3 4) '(1 2) '(1 2 3)) + => ((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3)) + (maplist #'(lambda (x) (cons 'foo x)) '(a b c d)) + => ((FOO A B C D) (FOO B C D) (FOO C D) (FOO D)) + (maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1)) '(a b a c d b c)) + => (0 0 1 0 1 1 1) + ;An entry is 1 if the corresponding element of the input + ; list was the last instance of that element in the input list. + + (setq dummy nil) => NIL + (mapc #'(lambda (&rest x) (setq dummy (append dummy x))) + '(1 2 3 4) + '(a b c d e) + '(x y z)) => (1 2 3 4) + dummy => (1 A X 2 B Y 3 C Z) + + (setq dummy nil) => NIL + (mapl #'(lambda (x) (push x dummy)) '(1 2 3 4)) => (1 2 3 4) + dummy => ((4) (3 4) (2 3 4) (1 2 3 4)) + + (mapcan #'(lambda (x y) (if (null x) nil (list x y))) + '(nil nil nil d e) + '(1 2 3 4 5 6)) => (D 4 E 5) + (mapcan #'(lambda (x) (and (numberp x) (list x))) + '(a 1 b c 3 4 d 5)) + => (1 3 4 5) + + In this case the function serves as a filter; this is a standard Lisp +idiom using mapcan. + + (mapcon #'list '(1 2 3 4)) => ((1 2 3 4) (2 3 4) (3 4) (4)) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if any list is +not a proper list. + +See Also:: +.......... + +*note dolist:: , *note map:: , + + *note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: acons, Next: assoc, Prev: mapc, Up: Conses Dictionary + +14.2.35 acons [Function] +------------------------ + +'acons' key datum alist => new-alist + +Arguments and Values:: +...................... + +key--an object. + + datum--an object. + + alist--an association list. + + new-alist--an association list. + +Description:: +............. + +Creates a fresh cons, the cdr of which is alist and the car of which is +another fresh cons, the car of which is key and the cdr of which is +datum. + +Examples:: +.......... + + (setq alist '()) => NIL + (acons 1 "one" alist) => ((1 . "one")) + alist => NIL + (setq alist (acons 1 "one" (acons 2 "two" alist))) => ((1 . "one") (2 . "two")) + (assoc 1 alist) => (1 . "one") + (setq alist (acons 1 "uno" alist)) => ((1 . "uno") (1 . "one") (2 . "two")) + (assoc 1 alist) => (1 . "uno") + +See Also:: +.......... + +*note assoc:: , *note pairlis:: + +Notes:: +....... + + (acons key datum alist) == (cons (cons key datum) alist) + + +File: gcl.info, Node: assoc, Next: copy-alist, Prev: acons, Up: Conses Dictionary + +14.2.36 assoc, assoc-if, assoc-if-not [Function] +------------------------------------------------ + +'assoc' item alist &key key test test-not => entry + + 'assoc-if' predicate alist &key key => entry + + 'assoc-if-not' predicate alist &key key => entry + +Arguments and Values:: +...................... + +item--an object. + + alist--an association list. + + predicate--a designator for a function of one argument that returns a +generalized boolean. + + 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. + + entry--a cons that is an element of alist, or nil. + +Description:: +............. + +assoc, assoc-if, and assoc-if-not return the first cons in alist whose +car satisfies the test, or nil if no such cons is found. + + For assoc, assoc-if, and assoc-if-not, if nil appears in alist in +place of a pair, it is ignored. + +Examples:: +.......... + + (setq values '((x . 100) (y . 200) (z . 50))) => ((X . 100) (Y . 200) (Z . 50)) + (assoc 'y values) => (Y . 200) + (rplacd (assoc 'y values) 201) => (Y . 201) + (assoc 'y values) => (Y . 201) + (setq alist '((1 . "one")(2 . "two")(3 . "three"))) + => ((1 . "one") (2 . "two") (3 . "three")) + (assoc 2 alist) => (2 . "two") + (assoc-if #'evenp alist) => (2 . "two") + (assoc-if-not #'(lambda(x) (< x 3)) alist) => (3 . "three") + (setq alist '(("one" . 1)("two" . 2))) => (("one" . 1) ("two" . 2)) + (assoc "one" alist) => NIL + (assoc "one" alist :test #'equalp) => ("one" . 1) + (assoc "two" alist :key #'(lambda(x) (char x 2))) => NIL + (assoc #\o alist :key #'(lambda(x) (char x 2))) => ("two" . 2) + (assoc 'r '((a . b) (c . d) (r . x) (s . y) (r . z))) => (R . X) + (assoc 'goo '((foo . bar) (zoo . goo))) => NIL + (assoc '2 '((1 a b c) (2 b c d) (-7 x y z))) => (2 B C D) + (setq alist '(("one" . 1) ("2" . 2) ("three" . 3))) + => (("one" . 1) ("2" . 2) ("three" . 3)) + (assoc-if-not #'alpha-char-p alist + :key #'(lambda (x) (char x 0))) => ("2" . 2) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if alist is not +an association list. + +See Also:: +.......... + +*note rassoc:: , *note find:: , *note member (Function):: , *note +position:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + The function assoc-if-not is deprecated. + + It is possible to rplacd the result of assoc, provided that it is not +nil, in order to "update" alist. + + The two expressions + + (assoc item list :test fn) + + and + + (find item list :test fn :key #'car) + + are equivalent in meaning with one exception: if nil appears in alist +in place of a pair, and item is nil, find will compute the car of the +nil in alist, find that it is equal to item, and return nil, whereas +assoc will ignore the nil in alist and continue to search for an actual +cons whose car is nil. + + +File: gcl.info, Node: copy-alist, Next: pairlis, Prev: assoc, Up: Conses Dictionary + +14.2.37 copy-alist [Function] +----------------------------- + +'copy-alist' alist => new-alist + +Arguments and Values:: +...................... + +alist--an association list. + + new-alist--an association list. + +Description:: +............. + +copy-alist returns a copy of alist. + + The list structure of alist is copied, and the elements of alist +which are conses are also copied (as conses only). Any other objects +which are referred to, whether directly or indirectly, by the alist +continue to be shared. + +Examples:: +.......... + + (defparameter *alist* (acons 1 "one" (acons 2 "two" '()))) + *alist* => ((1 . "one") (2 . "two")) + (defparameter *list-copy* (copy-list *alist*)) + *list-copy* => ((1 . "one") (2 . "two")) + (defparameter *alist-copy* (copy-alist *alist*)) + *alist-copy* => ((1 . "one") (2 . "two")) + (setf (cdr (assoc 2 *alist-copy*)) "deux") => "deux" + *alist-copy* => ((1 . "one") (2 . "deux")) + *alist* => ((1 . "one") (2 . "two")) + (setf (cdr (assoc 1 *list-copy*)) "uno") => "uno" + *list-copy* => ((1 . "uno") (2 . "two")) + *alist* => ((1 . "uno") (2 . "two")) + +See Also:: +.......... + +*note copy-list:: + + +File: gcl.info, Node: pairlis, Next: rassoc, Prev: copy-alist, Up: Conses Dictionary + +14.2.38 pairlis [Function] +-------------------------- + +'pairlis' keys data &optional alist => new-alist + +Arguments and Values:: +...................... + +keys--a proper list. + + data--a proper list. + + alist--an association list. The default is the empty list. + + new-alist--an association list. + +Description:: +............. + +Returns an association list that associates elements of keys to +corresponding elements of data. The consequences are undefined if keys +and data are not of the same length. + + If alist is supplied, pairlis returns a modified alist with the new +pairs prepended to it. The new pairs may appear in the resulting +association list in either forward or backward order. The result of + + (pairlis '(one two) '(1 2) '((three . 3) (four . 19))) + + might be + + ((one . 1) (two . 2) (three . 3) (four . 19)) + + or + + ((two . 2) (one . 1) (three . 3) (four . 19)) + +Examples:: +.......... + + (setq keys '(1 2 3) + data '("one" "two" "three") + alist '((4 . "four"))) => ((4 . "four")) + (pairlis keys data) => ((3 . "three") (2 . "two") (1 . "one")) + (pairlis keys data alist) + => ((3 . "three") (2 . "two") (1 . "one") (4 . "four")) + alist => ((4 . "four")) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if keys and +data are not proper lists. + +See Also:: +.......... + +*note acons:: + + +File: gcl.info, Node: rassoc, Next: get-properties, Prev: pairlis, Up: Conses Dictionary + +14.2.39 rassoc, rassoc-if, rassoc-if-not [Function] +--------------------------------------------------- + +'rassoc' item alist &key key test test-not => entry + + 'rassoc-if' predicate alist &key key => entry + + 'rassoc-if-not' predicate alist &key key => entry + +Arguments and Values:: +...................... + +item--an object. + + alist--an association list. + + predicate--a designator for a function of one argument that returns a +generalized boolean. + + 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. + + entry--a cons that is an element of the alist, or nil. + +Description:: +............. + +rassoc, rassoc-if, and rassoc-if-not return the first cons whose cdr +satisfies the test. If no such cons is found, nil is returned. + + If nil appears in alist in place of a pair, it is ignored. + +Examples:: +.......... + + (setq alist '((1 . "one") (2 . "two") (3 . 3))) + => ((1 . "one") (2 . "two") (3 . 3)) + (rassoc 3 alist) => (3 . 3) + (rassoc "two" alist) => NIL + (rassoc "two" alist :test 'equal) => (2 . "two") + (rassoc 1 alist :key #'(lambda (x) (if (numberp x) (/ x 3)))) => (3 . 3) + (rassoc 'a '((a . b) (b . c) (c . a) (z . a))) => (C . A) + (rassoc-if #'stringp alist) => (1 . "one") + (rassoc-if-not #'vectorp alist) => (3 . 3) + +See Also:: +.......... + +*note assoc:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + The function rassoc-if-not is deprecated. + + It is possible to rplaca the result of rassoc, provided that it is +not nil, in order to "update" alist. + + The expressions + + (rassoc item list :test fn) + + and + + (find item list :test fn :key #'cdr) + + are equivalent in meaning, except when the item is nil and nil +appears in place of a pair in the alist. See the function assoc. + + +File: gcl.info, Node: get-properties, Next: getf, Prev: rassoc, Up: Conses Dictionary + +14.2.40 get-properties [Function] +--------------------------------- + +'get-properties' plist indicator-list => indicator, value, tail + +Arguments and Values:: +...................... + +plist--a property list. + + indicator-list--a proper list (of indicators). + + indicator--an object that is an element of indicator-list. + + value--an object. + + tail--a list. + +Description:: +............. + +get-properties is used to look up any of several property list entries +all at once. + + It searches the plist for the first entry whose indicator is +identical to one of the objects in indicator-list. If such an entry is +found, the indicator and value returned are the property indicator and +its associated property value, and the tail returned is the tail of the +plist that begins with the found entry (i.e., whose car is the +indicator). If no such entry is found, the indicator, value, and tail +are all nil. + +Examples:: +.......... + + (setq x '()) => NIL + (setq *indicator-list* '(prop1 prop2)) => (PROP1 PROP2) + (getf x 'prop1) => NIL + (setf (getf x 'prop1) 'val1) => VAL1 + (eq (getf x 'prop1) 'val1) => true + (get-properties x *indicator-list*) => PROP1, VAL1, (PROP1 VAL1) + x => (PROP1 VAL1) + +See Also:: +.......... + +*note get:: , *note getf:: + + +File: gcl.info, Node: getf, Next: remf, Prev: get-properties, Up: Conses Dictionary + +14.2.41 getf [Accessor] +----------------------- + +'getf' plist indicator &optional default => value + + (setf (' getf' place indicator &optional default) new-value) + +Arguments and Values:: +...................... + +plist--a property list. + + place--a place, the value of which is a property list. + + indicator--an object. + + default--an object. The default is nil. + + value--an object. + + new-value--an object. + +Description:: +............. + +getf finds a property on the plist whose property indicator is identical +to indicator, and returns its corresponding property value. + + If there are multiple properties_1 with that property indicator, getf +uses the first such property. + + If there is no property with that property indicator, default is +returned. + + setf of getf may be used to associate a new object with an existing +indicator in the property list held by place, or to create a new +assocation if none exists. + + If there are multiple properties_1 with that property indicator, setf +of getf associates the new-value with the first such property. + + When a getf form is used as a setf place, any default which is +supplied is evaluated according to normal left-to-right evaluation +rules, but its value is ignored. + + setf of getf is permitted to either write the value of place itself, +or modify of any part, car or cdr, of the list structure held by place. + +Examples:: +.......... + + (setq x '()) => NIL + (getf x 'prop1) => NIL + (getf x 'prop1 7) => 7 + (getf x 'prop1) => NIL + (setf (getf x 'prop1) 'val1) => VAL1 + (eq (getf x 'prop1) 'val1) => true + (getf x 'prop1) => VAL1 + (getf x 'prop1 7) => VAL1 + x => (PROP1 VAL1) + + ;; Examples of implementation variation permitted. + (setq foo (list 'a 'b 'c 'd 'e 'f)) => (A B C D E F) + (setq bar (cddr foo)) => (C D E F) + (remf foo 'c) => true + foo => (A B E F) + bar + => (C D E F) + OR=> (C) + OR=> (NIL) + OR=> (C NIL) + OR=> (C D) + +See Also:: +.......... + +*note get:: , *note get-properties:: , *note setf:: , *note Function +Call Forms as Places:: + +Notes:: +....... + +There is no way (using getf) to distinguish an absent property from one +whose value is default; but see get-properties. + + Note that while supplying a default argument to getf in a setf +situation is sometimes not very interesting, it is still important +because some macros, such as push and incf, require a place argument +which data is both read from and written to. In such a context, if a +default argument is to be supplied for the read situation, it must be +syntactically valid for the write situation as well. For example, + + (let ((plist '())) + (incf (getf plist 'count 0)) + plist) => (COUNT 1) + + +File: gcl.info, Node: remf, Next: intersection, Prev: getf, Up: Conses Dictionary + +14.2.42 remf [Macro] +-------------------- + +'remf' place indicator => generalized-boolean + +Arguments and Values:: +...................... + +place--a place. + + indicator--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +remf removes from the property list stored in place a property_1 with a +property indicator identical to indicator. + + If there are multiple properties_1 with the identical key, remf only +removes the first such property. + + remf returns false if no such property was found, or true if a +property was found. + + The property indicator and the corresponding property value are +removed in an undefined order by destructively splicing the property +list. + + remf is permitted to either setf place or to setf any part, car or +cdr, of the list structure held by that place. + + For information about the evaluation of subforms of place, see *note +Evaluation of Subforms to Places::. + +Examples:: +.......... + + (setq x (cons () ())) => (NIL) + (setf (getf (car x) 'prop1) 'val1) => VAL1 + (remf (car x) 'prop1) => true + (remf (car x) 'prop1) => false + +Side Effects:: +.............. + +The property list stored in place is modified. + +See Also:: +.......... + +*note remprop:: , *note getf:: + + +File: gcl.info, Node: intersection, Next: adjoin, Prev: remf, Up: Conses Dictionary + +14.2.43 intersection, nintersection [Function] +---------------------------------------------- + +'intersection' list-1 list-2 &key key test test-not => result-list + + 'nintersection' list-1 list-2 &key key test test-not => result-list + +Arguments and Values:: +...................... + +list-1--a proper list. + + list-2--a proper list. + + 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. + + result-list--a list. + +Description:: +............. + +intersection and nintersection return a list that contains every element +that occurs in both list-1 and list-2. + + nintersection is the destructive version of intersection. It +performs the same operation, but may destroy list-1 using its cells to +construct the result. + + list-2 is not destroyed. + + The intersection operation is described as follows. For all possible +ordered pairs consisting of one element from list-1 and one element from +list-2, :test or :test-not are used to determine whether they satisfy +the test. The first argument to the :test or :test-not function is an +element of list-1; the second argument is an element of list-2. If +:test or :test-not is not supplied, eql is used. It is an error if +:test and :test-not are supplied in the same function call. + + If :key is supplied (and not nil), it is used to extract the part to +be tested from the list element. The argument to the :key function is +an element of either list-1 or list-2; the :key function typically +returns part of the supplied element. If :key is not supplied or nil, +the list-1 and list-2 elements are used. + + For every pair that satifies the test, exactly one of the two +elements of the pair will be put in the result. No element from either +list appears in the result that does not satisfy the test for an element +from the other list. If one of the lists contains duplicate elements, +there may be duplication in the result. + + There is no guarantee that the order of elements in the result will +reflect the ordering of the arguments in any particular way. The result +list may share cells with, or be eq to, either list-1 or list-2 if +appropriate. + +Examples:: +.......... + + (setq list1 (list 1 1 2 3 4 a b c "A" "B" "C" "d") + list2 (list 1 4 5 b c d "a" "B" "c" "D")) + => (1 4 5 B C D "a" "B" "c" "D") + (intersection list1 list2) => (C B 4 1 1) + (intersection list1 list2 :test 'equal) => ("B" C B 4 1 1) + (intersection list1 list2 :test #'equalp) => ("d" "C" "B" "A" C B 4 1 1) + (nintersection list1 list2) => (1 1 4 B C) + list1 => implementation-dependent ;e.g., (1 1 4 B C) + list2 => implementation-dependent ;e.g., (1 4 5 B C D "a" "B" "c" "D") + (setq list1 (copy-list '((1 . 2) (2 . 3) (3 . 4) (4 . 5)))) + => ((1 . 2) (2 . 3) (3 . 4) (4 . 5)) + (setq list2 (copy-list '((1 . 3) (2 . 4) (3 . 6) (4 . 8)))) + => ((1 . 3) (2 . 4) (3 . 6) (4 . 8)) + (nintersection list1 list2 :key #'cdr) => ((2 . 3) (3 . 4)) + list1 => implementation-dependent ;e.g., ((1 . 2) (2 . 3) (3 . 4)) + list2 => implementation-dependent ;e.g., ((1 . 3) (2 . 4) (3 . 6) (4 . 8)) + +Side Effects:: +.............. + +nintersection can modify list-1, + + but not list-2. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list-1 and +list-2 are not proper lists. + +See Also:: +.......... + +*note union:: , + + *note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + Since the nintersection side effect is not required, it should not be +used in for-effect-only positions in portable code. + + +File: gcl.info, Node: adjoin, Next: pushnew, Prev: intersection, Up: Conses Dictionary + +14.2.44 adjoin [Function] +------------------------- + +'adjoin' item list &key key test test-not => new-list + +Arguments and Values:: +...................... + +item--an object. + + list--a proper list. + + 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. + + new-list--a list. + +Description:: +............. + +Tests whether item is the same as an existing element of list. If the +item is not an existing element, adjoin adds it to list (as if by cons) +and returns the resulting list; otherwise, nothing is added and the +original list is returned. + + The test, test-not, and key affect how it is determined whether item +is the same as an element of list. For details, see *note Satisfying a +Two-Argument Test::.\ifvmode\else\endgraf \ifdim \prevdepth>-1000pt +\NIS\parskip \normalparskip\relax\fi + +Examples:: +.......... + + (setq slist '()) => NIL + (adjoin 'a slist) => (A) + slist => NIL + (setq slist (adjoin '(test-item 1) slist)) => ((TEST-ITEM 1)) + (adjoin '(test-item 1) slist) => ((TEST-ITEM 1) (TEST-ITEM 1)) + (adjoin '(test-item 1) slist :test 'equal) => ((TEST-ITEM 1)) + (adjoin '(new-test-item 1) slist :key #'cadr) => ((TEST-ITEM 1)) + (adjoin '(new-test-item 1) slist) => ((NEW-TEST-ITEM 1) (TEST-ITEM 1)) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list is not +a proper list. + +See Also:: +.......... + +*note pushnew:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + (adjoin item list :key fn) + == (if (member (fn item) list :key fn) list (cons item list)) + + +File: gcl.info, Node: pushnew, Next: set-difference, Prev: adjoin, Up: Conses Dictionary + +14.2.45 pushnew [Macro] +----------------------- + +'pushnew' item place &key key test test-not +=> new-place-value + +Arguments and Values:: +...................... + +item--an object. + + place--a place, the value of which is a proper list. + + 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. + + new-place-value--a list (the new value of place). + +Description:: +............. + +pushnew tests whether item is the same as any existing element of the +list stored in place. If item is not, it is prepended to the list, and +the new list is stored in place. + + pushnew returns the new list that is stored in place. + + Whether or not item is already a member of the list that is in place +is determined by comparisons using :test or :test-not. The first +argument to the :test or :test-not function is item; the second argument +is an element of the list in place as returned by the :key function (if +supplied). + + If :key is supplied, it is used to extract the part to be tested from +both item and the list element, as for adjoin. + + The argument to the :key function is an element of the list stored in +place. The :key function typically returns part part of the element of +the list. If :key is not supplied or nil, the list element is used. + + For information about the evaluation of subforms of place, see *note +Evaluation of Subforms to Places::. + + It is implementation-dependent whether or not pushnew actually +executes the storing form for its place in the situation where the item +is already a member of the list held by place. + +Examples:: +.......... + + (setq x '(a (b c) d)) => (A (B C) D) + (pushnew 5 (cadr x)) => (5 B C) + x => (A (5 B C) D) + (pushnew 'b (cadr x)) => (5 B C) + x => (A (5 B C) D) + (setq lst '((1) (1 2) (1 2 3))) => ((1) (1 2) (1 2 3)) + (pushnew '(2) lst) => ((2) (1) (1 2) (1 2 3)) + (pushnew '(1) lst) => ((1) (2) (1) (1 2) (1 2 3)) + (pushnew '(1) lst :test 'equal) => ((1) (2) (1) (1 2) (1 2 3)) + (pushnew '(1) lst :key #'car) => ((1) (2) (1) (1 2) (1 2 3)) + +Side Effects:: +.............. + +The contents of place may be modified. + +See Also:: +.......... + +*note push:: , *note adjoin:: , *note Generalized Reference:: + +Notes:: +....... + +The effect of + (pushnew item place :test p) + + is roughly equivalent to + (setf place (adjoin item place :test p)) + + except that the subforms of place are evaluated only once, and item +is evaluated before place. + + +File: gcl.info, Node: set-difference, Next: set-exclusive-or, Prev: pushnew, Up: Conses Dictionary + +14.2.46 set-difference, nset-difference [Function] +-------------------------------------------------- + +'set-difference' list-1 list-2 &key key test test-not => result-list + + 'nset-difference' list-1 list-2 &key key test test-not => result-list + +Arguments and Values:: +...................... + +list-1--a proper list. + + list-2--a proper list. + + 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. + + result-list--a list. + +Description:: +............. + +set-difference returns a list of elements of list-1 that do not appear +in list-2. + + nset-difference is the destructive version of set-difference. It may +destroy list-1. + + For all possible ordered pairs consisting of one element from list-1 +and one element from list-2, the :test or :test-not function is used to +determine whether they satisfy the test. The first argument to the +:test or :test-not function is the part of an element of list-1 that is +returned by the :key function (if supplied); the second argument is the +part of an element of list-2 that is returned by the :key function (if +supplied). + + If :key is supplied, its argument is a list-1 or list-2 element. The +:key function typically returns part of the supplied element. If :key +is not supplied, the list-1 or list-2 element is used. + + An element of list-1 appears in the result if and only if it does not +match any element of list-2. + + There is no guarantee that the order of elements in the result will +reflect the ordering of the arguments in any particular way. The result +list may share cells with, or be eq to, either of list-1 or list-2, if +appropriate. + +Examples:: +.......... + + (setq lst1 (list "A" "b" "C" "d") + lst2 (list "a" "B" "C" "d")) => ("a" "B" "C" "d") + (set-difference lst1 lst2) => ("d" "C" "b" "A") + (set-difference lst1 lst2 :test 'equal) => ("b" "A") + (set-difference lst1 lst2 :test #'equalp) => NIL + (nset-difference lst1 lst2 :test #'string=) => ("A" "b") + (setq lst1 '(("a" . "b") ("c" . "d") ("e" . "f"))) + => (("a" . "b") ("c" . "d") ("e" . "f")) + (setq lst2 '(("c" . "a") ("e" . "b") ("d" . "a"))) + => (("c" . "a") ("e" . "b") ("d" . "a")) + (nset-difference lst1 lst2 :test #'string= :key #'cdr) + => (("c" . "d") ("e" . "f")) + lst1 => (("a" . "b") ("c" . "d") ("e" . "f")) + lst2 => (("c" . "a") ("e" . "b") ("d" . "a")) + + ;; Remove all flavor names that contain "c" or "w". + (set-difference '("strawberry" "chocolate" "banana" + "lemon" "pistachio" "rhubarb") + '(#\c #\w) + :test #'(lambda (s c) (find c s))) + => ("banana" "rhubarb" "lemon") ;One possible ordering. + +Side Effects:: +.............. + +nset-difference may destroy list-1. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list-1 and +list-2 are not proper lists. + +See Also:: +.......... + +*note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + +File: gcl.info, Node: set-exclusive-or, Next: subsetp, Prev: set-difference, Up: Conses Dictionary + +14.2.47 set-exclusive-or, nset-exclusive-or [Function] +------------------------------------------------------ + +'set-exclusive-or' list-1 list-2 &key key test test-not => result-list + + 'nset-exclusive-or' list-1 list-2 &key key test test-not => +result-list + +Arguments and Values:: +...................... + +list-1--a proper list. + + list-2--a proper list. + + 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. + + result-list--a list. + +Description:: +............. + +set-exclusive-or returns a list of elements that appear in exactly one +of list-1 and list-2. + + nset-exclusive-or is the destructive version of set-exclusive-or. + + For all possible ordered pairs consisting of one element from list-1 +and one element from list-2, the :test or :test-not function is used to +determine whether they satisfy the test. + + If :key is supplied, it is used to extract the part to be tested from +the list-1 or list-2 element. The first argument to the :test or +:test-not function is the part of an element of list-1 extracted by the +:key function (if supplied); the second argument is the part of an +element of list-2 extracted by the :key function (if supplied). If :key +is not supplied or nil, the list-1 or list-2 element is used. + + The result contains precisely those elements of list-1 and list-2 +that appear in no matching pair. + + The result list of set-exclusive-or might share storage with one of +list-1 or list-2. + +Examples:: +.......... + + (setq lst1 (list 1 "a" "b") + lst2 (list 1 "A" "b")) => (1 "A" "b") + (set-exclusive-or lst1 lst2) => ("b" "A" "b" "a") + (set-exclusive-or lst1 lst2 :test #'equal) => ("A" "a") + (set-exclusive-or lst1 lst2 :test 'equalp) => NIL + (nset-exclusive-or lst1 lst2) => ("a" "b" "A" "b") + (setq lst1 (list (("a" . "b") ("c" . "d") ("e" . "f")))) + => (("a" . "b") ("c" . "d") ("e" . "f")) + (setq lst2 (list (("c" . "a") ("e" . "b") ("d" . "a")))) + => (("c" . "a") ("e" . "b") ("d" . "a")) + (nset-exclusive-or lst1 lst2 :test #'string= :key #'cdr) + => (("c" . "d") ("e" . "f") ("c" . "a") ("d" . "a")) + lst1 => (("a" . "b") ("c" . "d") ("e" . "f")) + lst2 => (("c" . "a") ("d" . "a")) + +Side Effects:: +.............. + +nset-exclusive-or is permitted to modify any part, car or cdr, of the +list structure of list-1 or list-2. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list-1 and +list-2 are not proper lists. + +See Also:: +.......... + +*note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + Since the nset-exclusive-or side effect is not required, it should +not be used in for-effect-only positions in portable code. + + +File: gcl.info, Node: subsetp, Next: union, Prev: set-exclusive-or, Up: Conses Dictionary + +14.2.48 subsetp [Function] +-------------------------- + +'subsetp' list-1 list-2 &key key test test-not => generalized-boolean + +Arguments and Values:: +...................... + +list-1--a proper list. + + list-2--a proper list. + + 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. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +subsetp returns true if every element of list-1 matches some element of +list-2, and false otherwise. + + Whether a list element is the same as another list element is +determined by the functions specified by the keyword arguments. The +first argument to the :test or :test-not function is typically part of +an element of list-1 extracted by the :key function; the second argument +is typically part of an element of list-2 extracted by the :key +function. + + The argument to the :key function is an element of either list-1 or +list-2; the return value is part of the element of the supplied list +element. If :key is not supplied or nil, the list-1 or list-2 element +itself is supplied to the :test or :test-not function. + +Examples:: +.......... + + (setq cosmos '(1 "a" (1 2))) => (1 "a" (1 2)) + (subsetp '(1) cosmos) => true + (subsetp '((1 2)) cosmos) => false + (subsetp '((1 2)) cosmos :test 'equal) => true + (subsetp '(1 "A") cosmos :test #'equalp) => true + (subsetp '((1) (2)) '((1) (2))) => false + (subsetp '((1) (2)) '((1) (2)) :key #'car) => true + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list-1 and +list-2 are not proper lists. + +See Also:: +.......... + +*note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + +File: gcl.info, Node: union, Prev: subsetp, Up: Conses Dictionary + +14.2.49 union, nunion [Function] +-------------------------------- + +'union' list-1 list-2 &key key test test-not => result-list + + 'nunion' list-1 list-2 &key key test test-not => result-list + +Arguments and Values:: +...................... + +list-1--a proper list. + + list-2--a proper list. + + 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. + + result-list--a list. + +Description:: +............. + +union and nunion return a list that contains every element that occurs +in either list-1 or list-2. + + For all possible ordered pairs consisting of one element from list-1 +and one element from list-2, :test or :test-not is used to determine +whether they satisfy the test. The first argument to the :test or +:test-not function is the part of the element of list-1 extracted by the +:key function (if supplied); the second argument is the part of the +element of list-2 extracted by the :key function (if supplied). + + The argument to the :key function is an element of list-1 or list-2; +the return value is part of the supplied element. If :key is not +supplied or nil, the element of list-1 or list-2 itself is supplied to +the :test or :test-not function. + + For every matching pair, one of the two elements of the pair will be +in the result. Any element from either list-1 or list-2 that matches no +element of the other will appear in the result. + + If there is a duplication between list-1 and list-2, only one of the +duplicate instances will be in the result. If either list-1 or list-2 +has duplicate entries within it, the redundant entries might or might +not appear in the result. + + The order of elements in the result do not have to reflect the +ordering of list-1 or list-2 in any way. The result list may be eq to +either list-1 or list-2 if appropriate. + +Examples:: +.......... + + (union '(a b c) '(f a d)) + => (A B C F D) + OR=> (B C F A D) + OR=> (D F A B C) + (union '((x 5) (y 6)) '((z 2) (x 4)) :key #'car) + => ((X 5) (Y 6) (Z 2)) + OR=> ((X 4) (Y 6) (Z 2)) + + (setq lst1 (list 1 2 '(1 2) "a" "b") + lst2 (list 2 3 '(2 3) "B" "C")) + => (2 3 (2 3) "B" "C") + (nunion lst1 lst2) + => (1 (1 2) "a" "b" 2 3 (2 3) "B" "C") + OR=> (1 2 (1 2) "a" "b" "C" "B" (2 3) 3) + +Side Effects:: +.............. + +nunion is permitted to modify any part, car or cdr, of the list +structure of list-1 or list-2. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if list-1 and +list-2 are not proper lists. + +See Also:: +.......... + +*note intersection:: , + + *note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not parameter is deprecated. + + Since the nunion side effect is not required, it should not be used +in for-effect-only positions in portable code. + + +File: gcl.info, Node: Arrays, Next: Strings, Prev: Conses, Up: Top + +15 Arrays +********* + +* Menu: + +* Array Concepts:: +* Arrays Dictionary:: + + +File: gcl.info, Node: Array Concepts, Next: Arrays Dictionary, Prev: Arrays, Up: Arrays + +15.1 Array Concepts +=================== + +* Menu: + +* Array Elements:: +* Specialized Arrays:: + + +File: gcl.info, Node: Array Elements, Next: Specialized Arrays, Prev: Array Concepts, Up: Array Concepts + +15.1.1 Array Elements +--------------------- + +An array contains a set of objects called elements that can be +referenced individually according to a rectilinear coordinate system. + +* Menu: + +* Array Indices:: +* Array Dimensions:: +* Implementation Limits on Individual Array Dimensions:: +* Array Rank:: +* Vectors:: +* Fill Pointers:: +* Multidimensional Arrays:: +* Storage Layout for Multidimensional Arrays:: +* Implementation Limits on Array Rank:: + + +File: gcl.info, Node: Array Indices, Next: Array Dimensions, Prev: Array Elements, Up: Array Elements + +15.1.1.1 Array Indices +...................... + +An array element is referred to by a (possibly empty) series of indices. +The length of the series must equal the rank of the array. + + Each index must be a non-negative fixnum + + less than the corresponding array dimension. Array indexing is +zero-origin. + + +File: gcl.info, Node: Array Dimensions, Next: Implementation Limits on Individual Array Dimensions, Prev: Array Indices, Up: Array Elements + +15.1.1.2 Array Dimensions +......................... + +An axis of an array is called a dimension . + + Each dimension is a non-negative + + fixnum; + + if any dimension of an array is zero, the array has no elements. It +is permissible for a dimension to be zero, in which case the array has +no elements, and any attempt to access an element is an error. However, +other properties of the array, such as the dimensions themselves, may be +used. + + +File: gcl.info, Node: Implementation Limits on Individual Array Dimensions, Next: Array Rank, Prev: Array Dimensions, Up: Array Elements + +15.1.1.3 Implementation Limits on Individual Array Dimensions +............................................................. + +An implementation may impose a limit on dimensions of an array, but +there is a minimum requirement on that limit. See the variable +array-dimension-limit. + + +File: gcl.info, Node: Array Rank, Next: Vectors, Prev: Implementation Limits on Individual Array Dimensions, Up: Array Elements + +15.1.1.4 Array Rank +................... + +An array can have any number of dimensions (including zero). The number +of dimensions is called the rank . + + If the rank of an array is zero then the array is said to have no +dimensions, and the product of the dimensions (see array-total-size) is +then 1; a zero-rank array therefore has a single element. + + +File: gcl.info, Node: Vectors, Next: Fill Pointers, Prev: Array Rank, Up: Array Elements + +15.1.1.5 Vectors +................ + +An array of rank one (i.e., a one-dimensional array) is called a vector +. + + +File: gcl.info, Node: Fill Pointers, Next: Multidimensional Arrays, Prev: Vectors, Up: Array Elements + +15.1.1.6 Fill Pointers +...................... + +A fill pointer is a non-negative integer no larger than the total number +of elements in a vector. Not all vectors have fill pointers. See the +functions make-array and adjust-array. + + An element of a vector is said to be active if it has an index that +is greater than or equal to zero, but less than the fill pointer (if +any). For an array that has no fill pointer, all elements are +considered active. + + Only vectors may have fill pointers; multidimensional arrays may not. +A multidimensional array that is displaced to a vector that has a fill +pointer can be created. + + +File: gcl.info, Node: Multidimensional Arrays, Next: Storage Layout for Multidimensional Arrays, Prev: Fill Pointers, Up: Array Elements + +15.1.1.7 Multidimensional Arrays +................................ + + +File: gcl.info, Node: Storage Layout for Multidimensional Arrays, Next: Implementation Limits on Array Rank, Prev: Multidimensional Arrays, Up: Array Elements + +15.1.1.8 Storage Layout for Multidimensional Arrays +................................................... + +Multidimensional arrays store their components in row-major order; that +is, internally a multidimensional array is stored as a one-dimensional +array, with the multidimensional index sets ordered lexicographically, +last index varying fastest. + + +File: gcl.info, Node: Implementation Limits on Array Rank, Prev: Storage Layout for Multidimensional Arrays, Up: Array Elements + +15.1.1.9 Implementation Limits on Array Rank +............................................ + +An implementation may impose a limit on the rank of an array, but there +is a minimum requirement on that limit. See the variable +array-rank-limit. + + +File: gcl.info, Node: Specialized Arrays, Prev: Array Elements, Up: Array Concepts + +15.1.2 Specialized Arrays +------------------------- + +An array can be a general array, meaning each element may be any object, +or it may be a specialized array, meaning that each element must be of a +restricted type. + + The phrasing "an array specialized to type <>" is sometimes +used to emphasize the element type of an array. This phrasing is +tolerated even when the <> is t, even though an array specialized +to type t is a general array, not a specialized array. + + Figure 15-1 lists some defined names that are applicable to array +creation, access, and information operations. + + adjust-array array-in-bounds-p svref + adjustable-array-p array-rank upgraded-array-element-type + aref array-rank-limit upgraded-complex-part-type + array-dimension array-row-major-index vector + array-dimension-limit array-total-size vector-pop + array-dimensions array-total-size-limit vector-push + array-element-type fill-pointer vector-push-extend + array-has-fill-pointer-p make-array + + Figure 15-1: General Purpose Array-Related Defined Names + + +* Menu: + +* Array Upgrading:: +* Required Kinds of Specialized Arrays:: + + +File: gcl.info, Node: Array Upgrading, Next: Required Kinds of Specialized Arrays, Prev: Specialized Arrays, Up: Specialized Arrays + +15.1.2.1 Array Upgrading +........................ + +The upgraded array element type of a type T_1 is a type T_2 that is a +supertype of T_1 and that is used instead of T_1 whenever T_1 is used as +an array element type for object creation or type discrimination. + + During creation of an array, the element type that was requested is +called the expressed array element type . The upgraded array element +type of the expressed array element type becomes the actual array +element type of the array that is created. + + Type upgrading implies a movement upwards in the type hierarchy +lattice. A type is always a subtype of its upgraded array element type. +Also, if a type T_x is a subtype of another type T_y, then the upgraded +array element type of T_x must be a subtype of the upgraded array +element type of T_y. Two disjoint types can be upgraded to the same +type. + + The upgraded array element type T_2 of a type T_1 is a function only +of T_1 itself; that is, it is independent of any other property of the +array for which T_2 will be used, such as rank, adjustability, fill +pointers, or displacement. The function upgraded-array-element-type can +be used by conforming programs to predict how the implementation will +upgrade a given type. + + +File: gcl.info, Node: Required Kinds of Specialized Arrays, Prev: Array Upgrading, Up: Specialized Arrays + +15.1.2.2 Required Kinds of Specialized Arrays +............................................. + +Vectors whose elements are restricted to type + + character or a subtype of character + + are called strings . Strings are of type string. Figure 15-2 lists +some defined names related to strings. + + Strings are specialized arrays and might logically have been included +in this chapter. However, for purposes of readability most information +about strings does not appear in this chapter; see instead *note +Strings::. + + char string-equal string-upcase + make-string string-greaterp string/= + nstring-capitalize string-left-trim string< + nstring-downcase string-lessp string<= + nstring-upcase string-not-equal string= + schar string-not-greaterp string> + string string-not-lessp string>= + string-capitalize string-right-trim + string-downcase string-trim + + Figure 15-2: Operators that Manipulate Strings + + + Vectors whose elements are restricted to type bit are called bit +vectors . Bit vectors are of type bit-vector. Figure 15-3 lists some +defined names for operations on bit arrays. + + bit bit-ior bit-orc2 + bit-and bit-nand bit-xor + bit-andc1 bit-nor sbit + bit-andc2 bit-not + bit-eqv bit-orc1 + + Figure 15-3: Operators that Manipulate Bit Arrays + + + +File: gcl.info, Node: Arrays Dictionary, Prev: Array Concepts, Up: Arrays + +15.2 Arrays Dictionary +====================== + +* Menu: + +* array:: +* simple-array:: +* vector (System Class):: +* simple-vector:: +* bit-vector:: +* simple-bit-vector:: +* make-array:: +* adjust-array:: +* adjustable-array-p:: +* aref:: +* array-dimension:: +* array-dimensions:: +* array-element-type:: +* array-has-fill-pointer-p:: +* array-displacement:: +* array-in-bounds-p:: +* array-rank:: +* array-row-major-index:: +* array-total-size:: +* arrayp:: +* fill-pointer:: +* row-major-aref:: +* upgraded-array-element-type:: +* array-dimension-limit:: +* array-rank-limit:: +* array-total-size-limit:: +* simple-vector-p:: +* svref:: +* vector:: +* vector-pop:: +* vector-push:: +* vectorp:: +* bit (Array):: +* bit-and:: +* bit-vector-p:: +* simple-bit-vector-p:: + + +File: gcl.info, Node: array, Next: simple-array, Prev: Arrays Dictionary, Up: Arrays Dictionary + +15.2.1 array [System Class] +--------------------------- + +Class Precedence List:: +....................... + +array, t + +Description:: +............. + +An array contains objects arranged according to a Cartesian coordinate +system. An array provides mappings from a set of + + fixnums + + \left{i_0,i_1,\dots,i_{r-1}\right} to corresponding elements of the +array, where 0 \le i_j < d_j, r is the rank of the array, and d_j is the +size of dimension j of the array. + + When an array is created, the program requesting its creation may +declare that all elements are of a particular type, called the expressed +array element type. The implementation is permitted to upgrade this +type in order to produce the actual array element type, which is the +element type for the array is actually specialized. See the function +upgraded-array-element-type. + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('array'{[{element-type | *} [dimension-spec]]}) + + dimension-spec ::=rank | * | ({dimension | *}*) + +Compound Type Specifier Arguments:: +................................... + +dimension--a valid array dimension. + + element-type--a type specifier. + + rank--a non-negative fixnum. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of arrays whose element type, rank, and dimensions +match any given element-type, rank, and dimensions. Specifically: + + If element-type is the symbol *, arrays are not excluded on the basis +of their element type. Otherwise, only those arrays are included whose +actual array element type + + is the result of upgrading element-type; see *note Array Upgrading::. + + If the dimension-spec is a rank, the set includes only those arrays +having that rank. If the dimension-spec is a list of dimensions, the +set includes only those arrays having a rank given by the length of the +dimensions, and having the indicated dimensions; in this case, * matches +any value for the corresponding dimension. If the dimension-spec is the +symbol *, the set is not restricted on the basis of rank or dimension. + +See Also:: +.......... + +*print-array*, *note aref:: , *note make-array:: , vector, *note +Sharpsign A::, *note Printing Other Arrays:: + +Notes:: +....... + +Note that the type (array t) is a proper subtype of the type (array *). +The reason is that the type (array t) is the set of arrays that can hold +any object (the elements are of type t, which includes all objects). On +the other hand, the type (array *) is the set of all arrays whatsoever, +including for example arrays that can hold only characters. The type +(array character) is not a subtype of the type (array t); the two sets +are disjoint because the type (array character) is not the set of all +arrays that can hold characters, but rather the set of arrays that are +specialized to hold precisely characters and no other objects. + + +File: gcl.info, Node: simple-array, Next: vector (System Class), Prev: array, Up: Arrays Dictionary + +15.2.2 simple-array [Type] +-------------------------- + +Supertypes:: +............ + +simple-array, array, t + +Description:: +............. + +The type of an array that is not displaced to another array, has no fill +pointer, and is not expressly adjustable is a subtype of type +simple-array. The concept of a simple array exists to allow the +implementation to use a specialized representation and to allow the user +to declare that certain values will always be simple arrays. + + The types simple-vector, simple-string, and simple-bit-vector are +disjoint subtypes of type simple-array, for they respectively mean +(simple-array t (*)), the union of all (simple-array c (*)) for any c +being a subtype of type character, and (simple-array bit (*)). + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('simple-array'{[{element-type | *} [dimension-spec]]}) + + dimension-spec ::=rank | * | ({dimension | *}*) + +Compound Type Specifier Arguments:: +................................... + +dimension--a valid array dimension. + + element-type--a type specifier. + + rank--a non-negative fixnum. + +Compound Type Specifier Description:: +..................................... + +This compound type specifier is treated exactly as the corresponding +compound type specifier for type array would be treated, except that the +set is further constrained to include only simple arrays. + +Notes:: +....... + +It is implementation-dependent whether displaced arrays, vectors with +fill pointers, or arrays that are actually adjustable are simple arrays. + + (simple-array *) refers to all simple arrays regardless of element +type, (simple-array type-specifier) refers only to those simple arrays +that can result from giving type-specifier as the :element-type argument +to make-array. + + +File: gcl.info, Node: vector (System Class), Next: simple-vector, Prev: simple-array, Up: Arrays Dictionary + +15.2.3 vector [System Class] +---------------------------- + +Class Precedence List:: +....................... + +vector, array, sequence, t + +Description:: +............. + +Any one-dimensional array is a vector. + + The type vector is a subtype of type array; for all types x, (vector +x) is the same as (array x (*)). + + The type (vector t), the type string, and the type bit-vector are +disjoint subtypes of type vector. + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('vector'{[{element-type | *} [{size | *}]]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum. + + element-type--a type specifier. + +Compound Type Specifier Description:: +..................................... + +This denotes the set of specialized vectors whose element type and +dimension match the specified values. Specifically: + + If element-type is the symbol *, vectors are not excluded on the +basis of their element type. Otherwise, only those vectors are included +whose actual array element type + + is the result of upgrading element-type; see *note Array Upgrading::. + + If a size is specified, the set includes only those vectors whose +only dimension is size. If the symbol * is specified instead of a size, +the set is not restricted on the basis of dimension. + +See Also:: +.......... + +*note Required Kinds of Specialized Arrays::, *note Sharpsign +Left-Parenthesis::, *note Printing Other Vectors::, *note Sharpsign A:: + +Notes:: +....... + +The type (vector e s) is equivalent to the type (array e (s)). + + The type (vector bit) has the name bit-vector. + + The union of all types (vector C), where C is any subtype of +character, has the name string. + + (vector *) refers to all vectors regardless of element type, (vector +type-specifier) refers only to those vectors that can result from giving +type-specifier as the :element-type argument to make-array. + + +File: gcl.info, Node: simple-vector, Next: bit-vector, Prev: vector (System Class), Up: Arrays Dictionary + +15.2.4 simple-vector [Type] +--------------------------- + +Supertypes:: +............ + +simple-vector, vector, simple-array, array, sequence, t + +Description:: +............. + +The type of a vector that is not displaced to another array, has no fill +pointer, is not expressly adjustable and is able to hold elements of any +type is a subtype of type simple-vector. + + The type simple-vector is a subtype of type vector, and is a subtype +of type (vector t). + +Compound Type Specifier Kind:: +.............................. + +Specializing. + +Compound Type Specifier Syntax:: +................................ + +('simple-vector'{[size]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum, or the symbol *. The default is the symbol +*. + +Compound Type Specifier Description:: +..................................... + +This is the same as (simple-array t (size)). + + +File: gcl.info, Node: bit-vector, Next: simple-bit-vector, Prev: simple-vector, Up: Arrays Dictionary + +15.2.5 bit-vector [System Class] +-------------------------------- + +Class Precedence List:: +....................... + +bit-vector, vector, array, sequence, t + +Description:: +............. + +A bit vector is a vector the element type of which is bit. + + The type bit-vector is a subtype of type vector, for bit-vector means +(vector bit). + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('bit-vector'{[size]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum, or the symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the same type as the type (array bit (size)); that is, the +set of bit vectors of size size. + +See Also:: +.......... + +*note Sharpsign Asterisk::, *note Printing Bit Vectors::, *note Required +Kinds of Specialized Arrays:: + + +File: gcl.info, Node: simple-bit-vector, Next: make-array, Prev: bit-vector, Up: Arrays Dictionary + +15.2.6 simple-bit-vector [Type] +------------------------------- + +Supertypes:: +............ + +simple-bit-vector, bit-vector, vector, simple-array, array, sequence, t + +Description:: +............. + +The type of a bit vector that is not displaced to another array, has no +fill pointer, and is not expressly adjustable is a subtype of type +simple-bit-vector. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('simple-bit-vector'{[size]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum, or the symbol *. The default is the symbol +*. + +Compound Type Specifier Description:: +..................................... + +This denotes the same type as the type (simple-array bit (size)); that +is, the set of simple bit vectors of size size. + + +File: gcl.info, Node: make-array, Next: adjust-array, Prev: simple-bit-vector, Up: Arrays Dictionary + +15.2.7 make-array [Function] +---------------------------- + +'make-array' dimensions &key element-type initial-element +initial-contents adjustable fill-pointer displaced-to +displaced-index-offset +=> new-array + +Arguments and Values:: +...................... + +dimensions--a designator for a list of valid array dimensions. + + element-type--a type specifier. The default is t. + + initial-element--an object. + + initial-contents--an object. + + adjustable--a generalized boolean. The default is nil. + + fill-pointer--a valid fill pointer for the array to be created, or t +or nil. The default is nil. + + displaced-to--an array or nil. The default is nil. This option must +not be supplied if either initial-element or initial-contents is +supplied. + + displaced-index-offset--a valid array row-major index for +displaced-to. The default is 0. This option must not be supplied +unless a non-nil displaced-to is supplied. + + new-array--an array. + +Description:: +............. + +Creates and returns an array constructed of the most specialized type +that can accommodate elements of type given by element-type. If +dimensions is nil then a zero-dimensional array is created. + + Dimensions represents the dimensionality of the new array. + + element-type indicates the type of the elements intended to be stored +in the new-array. The new-array can actually store any objects of the +type which results from upgrading element-type; see *note Array +Upgrading::. + + If initial-element is supplied, it is used to initialize each element +of new-array. If initial-element is supplied, it must be of the type +given by element-type. initial-element cannot be supplied if either the +:initial-contents option is supplied or displaced-to is non-nil. If +initial-element is not supplied, + + the consequences of later reading an uninitialized element of +new-array are undefined + + unless either initial-contents is supplied or displaced-to is +non-nil. + + initial-contents is used to initialize the contents of array. For +example: + + (make-array '(4 2 3) :initial-contents + '(((a b c) (1 2 3)) + ((d e f) (3 1 2)) + ((g h i) (2 3 1)) + ((j k l) (0 0 0)))) + + initial-contents is composed of a nested structure of sequences. The +numbers of levels in the structure must equal the rank of array. Each +leaf of the nested structure must be of the type given by element-type. +If array is zero-dimensional, then initial-contents specifies the single +element. Otherwise, initial-contents must be a sequence whose length is +equal to the first dimension; each element must be a nested structure +for an array whose dimensions are the remaining dimensions, and so on. +Initial-contents cannot be supplied if either initial-element is +supplied or displaced-to is non-nil. If initial-contents is not +supplied, + + the consequences of later reading an uninitialized element of +new-array are undefined + + unless either initial-element is supplied or displaced-to is non-nil. + + If adjustable is non-nil, the array is expressly adjustable (and so +actually adjustable); otherwise, the array is not expressly adjustable +(and it is implementation-dependent whether the array is actually +adjustable). + + If fill-pointer is non-nil, the array must be one-dimensional; that +is, the array must be a vector. If fill-pointer is t, the length of the +vector is used to initialize the fill pointer. If fill-pointer is an +integer, it becomes the initial fill pointer for the vector. + + If displaced-to is non-nil, make-array will create a displaced array +and displaced-to is the target of that displaced array. In that case, +the consequences are undefined if the actual array element type of +displaced-to is not type equivalent to the actual array element type of +the array being created. If displaced-to is nil, the array is not a +displaced array. + + The displaced-index-offset is made to be the index offset of the +array. When an array A is given as the :displaced-to argument to +make-array when creating array B, then array B is said to be displaced +to array A. The total number of elements in an array, called the total +size of the array, is calculated as the product of all the dimensions. +It is required that the total size of A be no smaller than the sum of +the total size of B plus the offset n supplied by the +displaced-index-offset. The effect of displacing is that array B does +not have any elements of its own, but instead maps accesses to itself +into accesses to array A. The mapping treats both arrays as if they were +one-dimensional by taking the elements in row-major order, and then maps +an access to element k of array B to an access to element k+n of array +A. + + If make-array is called with adjustable, fill-pointer, and +displaced-to each nil, then the result is a simple array. + + If make-array is called with one or more of adjustable, fill-pointer, +or displaced-to being true, whether the resulting array is a simple +array is implementation-dependent. + + When an array A is given as the :displaced-to argument to make-array +when creating array B, then array B is said to be displaced to array A. +The total number of elements in an array, called the total size of the +array, is calculated as the product of all the dimensions. The +consequences are unspecified if the total size of A is smaller than the +sum of the total size of B plus the offset n supplied by the +displaced-index-offset. The effect of displacing is that array B does +not have any elements of its own, but instead maps accesses to itself +into accesses to array A. The mapping treats both arrays as if they were +one-dimensional by taking the elements in row-major order, and then maps +an access to element k of array B to an access to element k+n of array +A. + +Examples:: +.......... + + + (make-array 5) ;; Creates a one-dimensional array of five elements. + (make-array '(3 4) :element-type '(mod 16)) ;; Creates a + ;;two-dimensional array, 3 by 4, with four-bit elements. + (make-array 5 :element-type 'single-float) ;; Creates an array of single-floats. + + (make-array nil :initial-element nil) => #0ANIL + (make-array 4 :initial-element nil) => #(NIL NIL NIL NIL) + (make-array '(2 4) + :element-type '(unsigned-byte 2) + :initial-contents '((0 1 2 3) (3 2 1 0))) + => #2A((0 1 2 3) (3 2 1 0)) + (make-array 6 + :element-type 'character + :initial-element #\a + :fill-pointer 3) => "aaa" + + The following is an example of making a displaced array. + + (setq a (make-array '(4 3))) + => # + (dotimes (i 4) + (dotimes (j 3) + (setf (aref a i j) (list i 'x j '= (* i j))))) + => NIL + (setq b (make-array 8 :displaced-to a + :displaced-index-offset 2)) + => # + (dotimes (i 8) + (print (list i (aref b i)))) + |> (0 (0 X 2 = 0)) + |> (1 (1 X 0 = 0)) + |> (2 (1 X 1 = 1)) + |> (3 (1 X 2 = 2)) + |> (4 (2 X 0 = 0)) + |> (5 (2 X 1 = 2)) + |> (6 (2 X 2 = 4)) + |> (7 (3 X 0 = 0)) + => NIL + + The last example depends on the fact that arrays are, in effect, +stored in row-major order. + + (setq a1 (make-array 50)) + => # + (setq b1 (make-array 20 :displaced-to a1 :displaced-index-offset 10)) + => # + (length b1) => 20 + + (setq a2 (make-array 50 :fill-pointer 10)) + => # + (setq b2 (make-array 20 :displaced-to a2 :displaced-index-offset 10)) + => # + (length a2) => 10 + (length b2) => 20 + + (setq a3 (make-array 50 :fill-pointer 10)) + => # + (setq b3 (make-array 20 :displaced-to a3 :displaced-index-offset 10 + :fill-pointer 5)) + => # + (length a3) => 10 + (length b3) => 5 + +See Also:: +.......... + +*note adjustable-array-p:: , *note aref:: , *note arrayp:: , *note +array-element-type:: , *note array-rank-limit:: , *note +array-dimension-limit:: , *note fill-pointer:: , *note +upgraded-array-element-type:: + +Notes:: +....... + +There is no specified way to create an array for which +adjustable-array-p definitely returns false. There is no specified way +to create an array that is not a simple array. + + +File: gcl.info, Node: adjust-array, Next: adjustable-array-p, Prev: make-array, Up: Arrays Dictionary + +15.2.8 adjust-array [Function] +------------------------------ + +'adjust-array' array new-dimensions &key element-type initial-element +initial-contents fill-pointer displaced-to displaced-index-offset +=> adjusted-array + +Arguments and Values:: +...................... + +array--an array. + + new-dimensions--a valid array dimension or a list of valid array +dimensions. + + element-type--a type specifier. + + initial-element--an object. Initial-element must not be supplied if +either initial-contents or displaced-to is supplied. + + initial-contents--an object. If array has rank greater than zero, +then initial-contents is composed of nested sequences, the depth of +which must equal the rank of array. Otherwise, array is +zero-dimensional and initial-contents supplies the single element. +initial-contents must not be supplied if either initial-element or +displaced-to is given. + + fill-pointer--a valid fill pointer for the array to be created, or t, +or nil. The default is nil. + + displaced-to--an array or nil. initial-elements and initial-contents +must not be supplied if displaced-to is supplied. + + displaced-index-offset--an object of type (fixnum 0 n) where n is +(array-total-size displaced-to). displaced-index-offset may be supplied +only if displaced-to is supplied. + + adjusted-array--an array. + +Description:: +............. + +adjust-array changes the dimensions or elements of array. The result is +an array of the same type and rank as array, that is either the modified +array, or a newly created array to which array can be displaced, and +that has the given new-dimensions. + + New-dimensions specify the size of each dimension of array. + + Element-type specifies the type of the elements of the resulting +array. If element-type is supplied, the consequences are unspecified if +the upgraded array element type of element-type is not the same as the +actual array element type of array. + + If initial-contents is supplied, it is treated as for make-array. In +this case none of the original contents of array appears in the +resulting array. + + If fill-pointer is an integer, it becomes the fill pointer for the +resulting array. If fill-pointer is the symbol t, it indicates that the +size of the resulting array should be used as the fill pointer. If +fill-pointer is nil, it indicates that the fill pointer should be left +as it is. + + If displaced-to non-nil, a displaced array is created. The resulting +array shares its contents with the array given by displaced-to. The +resulting array cannot contain more elements than the array it is +displaced to. If displaced-to is not supplied or nil, the resulting +array is not a displaced array. If array A is created displaced to +array B and subsequently array B is given to adjust-array, array A will +still be displaced to array B. Although array might be a displaced +array, the resulting array is not a displaced array unless displaced-to +is supplied and not nil. + + The interaction between adjust-array and displaced arrays is as +follows given three arrays, A, B, and~C: + +A is not displaced before or after the call + (adjust-array A ...) + + The dimensions of A are altered, and the contents rearranged as + appropriate. Additional elements of A are taken from + initial-element. The use of initial-contents causes all old + contents to be discarded. + +A is not displaced before, but is displaced to + C after the call + (adjust-array A ... :displaced-to C) + + None of the original contents of A appears in A afterwards; A now + contains the contents of C, without any rearrangement of C. + +A is displaced to B + before the call, and is displaced to C after the call + (adjust-array A ... :displaced-to B) + (adjust-array A ... :displaced-to C) + + B and C might be the same. The contents of B do not appear in A + afterward unless such contents also happen to be in C If + displaced-index-offset is not supplied in the adjust-array call, it + defaults to zero; the old offset into B is not retained. + +A is displaced to B before the call, but not displaced + afterward. + (adjust-array A ... :displaced-to B) + (adjust-array A ... :displaced-to nil) + + A gets a new "data region," and contents of B are copied into it as + appropriate to maintain the existing old contents; additional + elements of A are taken from initial-element if supplied. However, + the use of initial-contents causes all old contents to be + discarded. + + If displaced-index-offset is supplied, it specifies the offset of the +resulting array from the beginning of the array that it is displaced to. +If displaced-index-offset is not supplied, the offset is~0. The size of +the resulting array plus the offset value cannot exceed the size of the +array that it is displaced to. + + If only new-dimensions and an initial-element argument are supplied, +those elements of array that are still in bounds appear in the resulting +array. The elements of the resulting array that are not in the bounds +of array are initialized to initial-element; if initial-element is not +provided, + + the consequences of later reading any such new element of new-array +before it has been initialized are undefined. + + If initial-contents or displaced-to is supplied, then none of the +original contents of array appears in the new array. + + The consequences are unspecified if array is adjusted to a size +smaller than its fill pointer without supplying the fill-pointer +argument so that its fill-pointer is properly adjusted in the process. + + If A is displaced to B, the consequences are unspecified if B is +adjusted in such a way that it no longer has enough elements to satisfy +A. + + If adjust-array is applied to an array that is actually adjustable, +the array returned is identical to array. If the array returned by +adjust-array is distinct from array, then the argument array is +unchanged. + + Note that if an array A is displaced to another array B, and B is +displaced to another array C, and B is altered by adjust-array, A must +now refer to the adjust contents of B. This means that an implementation +cannot collapse the chain to make A refer to C directly and forget that +the chain of reference passes through B. However, caching techniques are +permitted as long as they preserve the semantics specified here. + +Examples:: +.......... + + (adjustable-array-p + (setq ada (adjust-array + (make-array '(2 3) + :adjustable t + :initial-contents '((a b c) (1 2 3))) + '(4 6)))) => T + (array-dimensions ada) => (4 6) + (aref ada 1 1) => 2 + (setq beta (make-array '(2 3) :adjustable t)) + => #2A((NIL NIL NIL) (NIL NIL NIL)) + (adjust-array beta '(4 6) :displaced-to ada) + => #2A((A B C NIL NIL NIL) + (1 2 3 NIL NIL NIL) + (NIL NIL NIL NIL NIL NIL) + (NIL NIL NIL NIL NIL NIL)) + (array-dimensions beta) => (4 6) + (aref beta 1 1) => 2 + + Suppose that the 4-by-4 array in m looks like this: + + #2A(( alpha beta gamma delta ) + ( epsilon zeta eta theta ) + ( iota kappa lambda mu ) + ( nu xi omicron pi )) + + Then the result of + + (adjust-array m '(3 5) :initial-element 'baz) + + is a 3-by-5 array with contents + + #2A(( alpha beta gamma delta baz ) + ( epsilon zeta eta theta baz ) + ( iota kappa lambda mu baz )) + +Exceptional Situations:: +........................ + +An error of type error is signaled if fill-pointer is supplied and +non-nil but array has no fill pointer. + +See Also:: +.......... + +*note adjustable-array-p:: , *note make-array:: , *note +array-dimension-limit:: , *note array-total-size-limit:: , array + + +File: gcl.info, Node: adjustable-array-p, Next: aref, Prev: adjust-array, Up: Arrays Dictionary + +15.2.9 adjustable-array-p [Function] +------------------------------------ + +'adjustable-array-p' array => generalized-boolean + +Arguments and Values:: +...................... + +array--an array. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if and only if adjust-array could return a value which is +identical to array when given that array as its first argument. + +Examples:: +.......... + + (adjustable-array-p + (make-array 5 + :element-type 'character + :adjustable t + :fill-pointer 3)) => true + (adjustable-array-p (make-array 4)) => implementation-dependent + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if its argument is not an +array. + +See Also:: +.......... + +*note adjust-array:: , *note make-array:: + + +File: gcl.info, Node: aref, Next: array-dimension, Prev: adjustable-array-p, Up: Arrays Dictionary + +15.2.10 aref [Accessor] +----------------------- + +'aref' array &rest subscripts => element + + (setf (' aref' array &rest subscripts) new-element) + +Arguments and Values:: +...................... + +array--an array. + + subscripts--a list of valid array indices for the array. + + element, new-element--an object. + +Description:: +............. + +Accesses the array element specified by the subscripts. If no +subscripts are supplied and array is zero rank, aref accesses the sole +element of array. + + aref ignores fill pointers. It is permissible to use aref to access +any array element, whether active or not. + +Examples:: +.......... + +If the variable foo names a 3-by-5 array, then the first index could be +0, 1, or 2, and then second index could be 0, 1, 2, 3, or 4. The array +elements can be referred to by using the function aref; for example, +(aref foo 2 1) refers to element (2, 1) of the array. + + (aref (setq alpha (make-array 4)) 3) => implementation-dependent + (setf (aref alpha 3) 'sirens) => SIRENS + (aref alpha 3) => SIRENS + (aref (setq beta (make-array '(2 4) + :element-type '(unsigned-byte 2) + :initial-contents '((0 1 2 3) (3 2 1 0)))) + 1 2) => 1 + (setq gamma '(0 2)) + (apply #'aref beta gamma) => 2 + (setf (apply #'aref beta gamma) 3) => 3 + (apply #'aref beta gamma) => 3 + (aref beta 0 2) => 3 + +See Also:: +.......... + +*note bit (Array):: , *note char:: , *note elt:: , *note +row-major-aref:: , *note svref:: , + + *note Compiler Terminology:: + + +File: gcl.info, Node: array-dimension, Next: array-dimensions, Prev: aref, Up: Arrays Dictionary + +15.2.11 array-dimension [Function] +---------------------------------- + +'array-dimension' array axis-number => dimension + +Arguments and Values:: +...................... + +array--an array. + + axis-number--an integer greater than or equal to zero and less than +the rank of the array. + + dimension--a non-negative integer. + +Description:: +............. + +array-dimension returns the axis-number dimension_1 of array. (Any fill +pointer is ignored.) + +Examples:: +.......... + + (array-dimension (make-array 4) 0) => 4 + (array-dimension (make-array '(2 3)) 1) => 3 + +Affected By:: +............. + +None. + +See Also:: +.......... + +*note array-dimensions:: , *note length:: + +Notes:: +....... + + (array-dimension array n) == (nth n (array-dimensions array)) + + +File: gcl.info, Node: array-dimensions, Next: array-element-type, Prev: array-dimension, Up: Arrays Dictionary + +15.2.12 array-dimensions [Function] +----------------------------------- + +'array-dimensions' array => dimensions + +Arguments and Values:: +...................... + +array--an array. + + dimensions--a list of integers. + +Description:: +............. + +Returns a list of the dimensions of array. (If array is a vector with a +fill pointer, that fill pointer is ignored.) + +Examples:: +.......... + + (array-dimensions (make-array 4)) => (4) + (array-dimensions (make-array '(2 3))) => (2 3) + (array-dimensions (make-array 4 :fill-pointer 2)) => (4) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if its argument is not an +array. + +See Also:: +.......... + +*note array-dimension:: + + +File: gcl.info, Node: array-element-type, Next: array-has-fill-pointer-p, Prev: array-dimensions, Up: Arrays Dictionary + +15.2.13 array-element-type [Function] +------------------------------------- + +'array-element-type' array => typespec + +Arguments and Values:: +...................... + +array--an array. + + typespec--a type specifier. + +Description:: +............. + +Returns a type specifier which represents the actual array element type +of the array, which is the set of objects that such an array can hold. +(Because of array upgrading, this type specifier can in some cases +denote a supertype of the expressed array element type of the array.) + +Examples:: +.......... + + (array-element-type (make-array 4)) => T + (array-element-type (make-array 12 :element-type '(unsigned-byte 8))) + => implementation-dependent + (array-element-type (make-array 12 :element-type '(unsigned-byte 5))) + => implementation-dependent + + (array-element-type (make-array 5 :element-type '(mod 5))) + + could be (mod 5), (mod 8), fixnum, t, or any other type of which (mod +5) is a subtype. + +Affected By:: +............. + +The implementation. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if its argument is not an +array. + +See Also:: +.......... + +array, *note make-array:: , *note subtypep:: , *note +upgraded-array-element-type:: + + +File: gcl.info, Node: array-has-fill-pointer-p, Next: array-displacement, Prev: array-element-type, Up: Arrays Dictionary + +15.2.14 array-has-fill-pointer-p [Function] +------------------------------------------- + +'array-has-fill-pointer-p' array => generalized-boolean + +Arguments and Values:: +...................... + +array--an array. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if array has a fill pointer; otherwise returns false. + +Examples:: +.......... + + (array-has-fill-pointer-p (make-array 4)) => implementation-dependent + (array-has-fill-pointer-p (make-array '(2 3))) => false + (array-has-fill-pointer-p + (make-array 8 + :fill-pointer 2 + :initial-element 'filler)) => true + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if its argument is not an +array. + +See Also:: +.......... + +*note make-array:: , *note fill-pointer:: + +Notes:: +....... + +Since arrays of rank other than one cannot have a fill pointer, +array-has-fill-pointer-p always returns nil when its argument is such an +array. + + +File: gcl.info, Node: array-displacement, Next: array-in-bounds-p, Prev: array-has-fill-pointer-p, Up: Arrays Dictionary + +15.2.15 array-displacement [Function] +------------------------------------- + +'array-displacement' array => displaced-to, displaced-index-offset + +Arguments and Values:: +...................... + +array--an array. + + displaced-to--an array or nil. + + displaced-index-offset--a non-negative fixnum. + +Description:: +............. + +If the array is a displaced array, returns the values of the +:displaced-to and :displaced-index-offset options for the array (see the +functions make-array and adjust-array). If the array is not a displaced +array, nil and 0 are returned. + + If array-displacement is called on an array for which a non-nil +object was provided as the :displaced-to argument to make-array or +adjust-array, it must return that object as its first value. It is +implementation-dependent whether array-displacement returns a non-nil +primary value for any other array. + +Examples:: +.......... + + (setq a1 (make-array 5)) => # + (setq a2 (make-array 4 :displaced-to a1 + :displaced-index-offset 1)) + => # + (array-displacement a2) + => #, 1 + (setq a3 (make-array 2 :displaced-to a2 + :displaced-index-offset 2)) + => # + (array-displacement a3) + => #, 2 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if array is not an array. + +See Also:: +.......... + +*note make-array:: + + +File: gcl.info, Node: array-in-bounds-p, Next: array-rank, Prev: array-displacement, Up: Arrays Dictionary + +15.2.16 array-in-bounds-p [Function] +------------------------------------ + +'array-in-bounds-p' array &rest subscripts => generalized-boolean + +Arguments and Values:: +...................... + +array--an array. + + subscripts--a list of integers of length equal to the rank of the +array. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if the subscripts are all in bounds for array; otherwise +returns false. (If array is a vector with a fill pointer, that fill +pointer is ignored.) + +Examples:: +.......... + + (setq a (make-array '(7 11) :element-type 'string-char)) + (array-in-bounds-p a 0 0) => true + (array-in-bounds-p a 6 10) => true + (array-in-bounds-p a 0 -1) => false + (array-in-bounds-p a 0 11) => false + (array-in-bounds-p a 7 0) => false + +See Also:: +.......... + +*note array-dimensions:: + +Notes:: +....... + + (array-in-bounds-p array subscripts) + == (and (not (some #'minusp (list subscripts))) + (every #'< (list subscripts) (array-dimensions array))) + + +File: gcl.info, Node: array-rank, Next: array-row-major-index, Prev: array-in-bounds-p, Up: Arrays Dictionary + +15.2.17 array-rank [Function] +----------------------------- + +'array-rank' array => rank + +Arguments and Values:: +...................... + +array--an array. + + rank--a non-negative integer. + +Description:: +............. + +Returns the number of dimensions of array. + +Examples:: +.......... + + (array-rank (make-array '())) => 0 + (array-rank (make-array 4)) => 1 + (array-rank (make-array '(4))) => 1 + (array-rank (make-array '(2 3))) => 2 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if its argument is not an +array. + +See Also:: +.......... + +*note array-rank-limit:: , *note make-array:: + + +File: gcl.info, Node: array-row-major-index, Next: array-total-size, Prev: array-rank, Up: Arrays Dictionary + +15.2.18 array-row-major-index [Function] +---------------------------------------- + +'array-row-major-index' array &rest subscripts => index + +Arguments and Values:: +...................... + +array--an array. + + subscripts--a list of valid array indices for the array. + + index--a valid array row-major index for the array. + +Description:: +............. + +Computes the position according to the row-major ordering of array for +the element that is specified by subscripts, and returns the offset of +the element in the computed position from the beginning of array. + + For a one-dimensional array, the result of array-row-major-index +equals subscript. + + array-row-major-index ignores fill pointers. + +Examples:: +.......... + + (setq a (make-array '(4 7) :element-type '(unsigned-byte 8))) + (array-row-major-index a 1 2) => 9 + (array-row-major-index + (make-array '(2 3 4) + :element-type '(unsigned-byte 8) + :displaced-to a + :displaced-index-offset 4) + 0 2 1) => 9 + +Notes:: +....... + +A possible definition of array-row-major-index, with no error-checking, +is + + (defun array-row-major-index (a &rest subscripts) + (apply #'+ (maplist #'(lambda (x y) + (* (car x) (apply #'* (cdr y)))) + subscripts + (array-dimensions a)))) + + +File: gcl.info, Node: array-total-size, Next: arrayp, Prev: array-row-major-index, Up: Arrays Dictionary + +15.2.19 array-total-size [Function] +----------------------------------- + +'array-total-size' array => size + +Arguments and Values:: +...................... + +array--an array. + + size--a non-negative integer. + +Description:: +............. + +Returns the array total size of the array. + +Examples:: +.......... + + (array-total-size (make-array 4)) => 4 + (array-total-size (make-array 4 :fill-pointer 2)) => 4 + (array-total-size (make-array 0)) => 0 + (array-total-size (make-array '(4 2))) => 8 + (array-total-size (make-array '(4 0))) => 0 + (array-total-size (make-array '())) => 1 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if its argument is not an +array. + +See Also:: +.......... + +*note make-array:: , *note array-dimensions:: + +Notes:: +....... + +If the array is a vector with a fill pointer, the fill pointer is +ignored when calculating the array total size. + + Since the product of no arguments is one, the array total size of a +zero-dimensional array is one. + + (array-total-size x) + == (apply #'* (array-dimensions x)) + == (reduce #'* (array-dimensions x)) + + +File: gcl.info, Node: arrayp, Next: fill-pointer, Prev: array-total-size, Up: Arrays Dictionary + +15.2.20 arrayp [Function] +------------------------- + +'arrayp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type array; otherwise, returns false. + +Examples:: +.......... + + (arrayp (make-array '(2 3 4) :adjustable t)) => true + (arrayp (make-array 6)) => true + (arrayp #*1011) => true + (arrayp "hi") => true + (arrayp 'hi) => false + (arrayp 12) => false + +See Also:: +.......... + +*note typep:: + +Notes:: +....... + + (arrayp object) == (typep object 'array) + + +File: gcl.info, Node: fill-pointer, Next: row-major-aref, Prev: arrayp, Up: Arrays Dictionary + +15.2.21 fill-pointer [Accessor] +------------------------------- + +'fill-pointer' vector => fill-pointer + + (setf (' fill-pointer' vector) new-fill-pointer) + +Arguments and Values:: +...................... + +vector--a vector with a fill pointer. + + fill-pointer, new-fill-pointer--a valid fill pointer for the vector. + +Description:: +............. + +Accesses the fill pointer of vector. + +Examples:: +.......... + + (setq a (make-array 8 :fill-pointer 4)) => #(NIL NIL NIL NIL) + (fill-pointer a) => 4 + (dotimes (i (length a)) (setf (aref a i) (* i i))) => NIL + a => #(0 1 4 9) + (setf (fill-pointer a) 3) => 3 + (fill-pointer a) => 3 + a => #(0 1 4) + (setf (fill-pointer a) 8) => 8 + a => #(0 1 4 9 NIL NIL NIL NIL) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if vector is not a vector with +a fill pointer. + +See Also:: +.......... + +*note make-array:: , *note length:: + +Notes:: +....... + +There is no operator that will remove a vector's fill pointer. + + +File: gcl.info, Node: row-major-aref, Next: upgraded-array-element-type, Prev: fill-pointer, Up: Arrays Dictionary + +15.2.22 row-major-aref [Accessor] +--------------------------------- + +'row-major-aref' array index => element + + (setf (' row-major-aref' array index) new-element) + +Arguments and Values:: +...................... + +array--an array. + + index--a valid array row-major index for the array. + + element, new-element--an object. + +Description:: +............. + +Considers array as a vector by viewing its elements in row-major order, +and returns the element of that vector which is referred to by the given +index. + + row-major-aref is valid for use with setf. + +See Also:: +.......... + +*note aref:: , *note array-row-major-index:: + +Notes:: +....... + + (row-major-aref array index) == + (aref (make-array (array-total-size array) + :displaced-to array + :element-type (array-element-type array)) + index) + + (aref array i1 i2 ...) == + (row-major-aref array (array-row-major-index array i1 i2)) + + +File: gcl.info, Node: upgraded-array-element-type, Next: array-dimension-limit, Prev: row-major-aref, Up: Arrays Dictionary + +15.2.23 upgraded-array-element-type [Function] +---------------------------------------------- + +'upgraded-array-element-type' typespec &optional environment => +upgraded-typespec + +Arguments and Values:: +...................... + +typespec--a type specifier. + + environment--an environment object. The default is nil, denoting the +null lexical environment and the current global environment. + + upgraded-typespec--a type specifier. + +Description:: +............. + +Returns the element type of the most specialized array representation +capable of holding items of the type denoted by typespec. + + The typespec is a subtype of (and possibly type equivalent to) the +upgraded-typespec. + + If typespec is bit, the result is type equivalent to bit. + + If typespec is base-char, the result is type equivalent to base-char. + + If typespec is character, the result is type equivalent to character. + + The purpose of upgraded-array-element-type is to reveal how an +implementation does its upgrading. + + The environment is used to expand any derived type specifiers that +are mentioned in the typespec. + +See Also:: +.......... + +*note array-element-type:: , *note make-array:: + +Notes:: +....... + +Except for storage allocation consequences and dealing correctly with +the optional environment argument, upgraded-array-element-type could be +defined as: + + (defun upgraded-array-element-type (type &optional environment) + (array-element-type (make-array 0 :element-type type))) + + +File: gcl.info, Node: array-dimension-limit, Next: array-rank-limit, Prev: upgraded-array-element-type, Up: Arrays Dictionary + +15.2.24 array-dimension-limit [Constant Variable] +------------------------------------------------- + +Constant Value:: +................ + +A positive + + fixnum, + + the exact magnitude of which is implementation-dependent, but which +is not less than 1024. + +Description:: +............. + +The upper exclusive bound on each individual dimension of an array. + +See Also:: +.......... + +*note make-array:: + + +File: gcl.info, Node: array-rank-limit, Next: array-total-size-limit, Prev: array-dimension-limit, Up: Arrays Dictionary + +15.2.25 array-rank-limit [Constant Variable] +-------------------------------------------- + +Constant Value:: +................ + +A positive + + fixnum, + + the exact magnitude of which is implementation-dependent, but which +is not less than 8. + +Description:: +............. + +The upper exclusive bound on the rank of an array. + +See Also:: +.......... + +*note make-array:: + + +File: gcl.info, Node: array-total-size-limit, Next: simple-vector-p, Prev: array-rank-limit, Up: Arrays Dictionary + +15.2.26 array-total-size-limit [Constant Variable] +-------------------------------------------------- + +Constant Value:: +................ + +A positive + + fixnum, + + the exact magnitude of which is implementation-dependent, but which +is not less than 1024. + +Description:: +............. + +The upper exclusive bound on the array total size of an array. + + The actual limit on the array total size imposed by the +implementation might vary according the element type of the array; in +this case, the value of array-total-size-limit will be the smallest of +these possible limits. + +See Also:: +.......... + +*note make-array:: , *note array-element-type:: + + +File: gcl.info, Node: simple-vector-p, Next: svref, Prev: array-total-size-limit, Up: Arrays Dictionary + +15.2.27 simple-vector-p [Function] +---------------------------------- + +'simple-vector-p' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type simple-vector; otherwise, returns +false.. + +Examples:: +.......... + + (simple-vector-p (make-array 6)) => true + (simple-vector-p "aaaaaa") => false + (simple-vector-p (make-array 6 :fill-pointer t)) => false + +See Also:: +.......... + +simple-vector + +Notes:: +....... + + (simple-vector-p object) == (typep object 'simple-vector) + + +File: gcl.info, Node: svref, Next: vector, Prev: simple-vector-p, Up: Arrays Dictionary + +15.2.28 svref [Accessor] +------------------------ + +'svref' simple-vector index => element + + (setf (' svref' simple-vector index) new-element) + +Arguments and Values:: +...................... + +simple-vector--a simple vector. + + index--a valid array index for the simple-vector. + + element, new-element--an object (whose type is a subtype of the array +element type of the simple-vector). + +Description:: +............. + +Accesses the element of simple-vector specified by index. + +Examples:: +.......... + + (simple-vector-p (setq v (vector 1 2 'sirens))) => true + (svref v 0) => 1 + (svref v 2) => SIRENS + (setf (svref v 1) 'newcomer) => NEWCOMER + v => #(1 NEWCOMER SIRENS) + +See Also:: +.......... + +*note aref:: , sbit, schar, *note vector:: , + + *note Compiler Terminology:: + +Notes:: +....... + +svref is identical to aref except that it requires its first argument to +be a simple vector. + + (svref v i) == (aref (the simple-vector v) i) + + +File: gcl.info, Node: vector, Next: vector-pop, Prev: svref, Up: Arrays Dictionary + +15.2.29 vector [Function] +------------------------- + +'vector' &rest objects => vector + +Arguments and Values:: +...................... + +object--an object. + + vector--a vector of type (vector t *). + +Description:: +............. + +Creates a fresh simple general vector whose size corresponds to the +number of objects. + + The vector is initialized to contain the objects. + +Examples:: +.......... + + (arrayp (setq v (vector 1 2 'sirens))) => true + (vectorp v) => true + (simple-vector-p v) => true + (length v) => 3 + +See Also:: +.......... + +*note make-array:: + +Notes:: +....... + +vector is analogous to list. + + (vector a_1 a_2 ... a_n) + == (make-array (list n) :element-type t + :initial-contents + (list a_1 a_2 ... a_n)) + + +File: gcl.info, Node: vector-pop, Next: vector-push, Prev: vector, Up: Arrays Dictionary + +15.2.30 vector-pop [Function] +----------------------------- + +'vector-pop' vector => element + +Arguments and Values:: +...................... + +vector--a vector with a fill pointer. + + element--an object. + +Description:: +............. + +Decreases the fill pointer of vector by one, and retrieves the element +of vector that is designated by the new fill pointer. + +Examples:: +.......... + + (vector-push (setq fable (list 'fable)) + (setq fa (make-array 8 + :fill-pointer 2 + :initial-element 'sisyphus))) => 2 + (fill-pointer fa) => 3 + (eq (vector-pop fa) fable) => true + (vector-pop fa) => SISYPHUS + (fill-pointer fa) => 1 + +Side Effects:: +.............. + +The fill pointer is decreased by one. + +Affected By:: +............. + +The value of the fill pointer. + +Exceptional Situations:: +........................ + +An error of type type-error is signaled if vector does not have a fill +pointer. + + If the fill pointer is zero, vector-pop signals an error of type +error. + +See Also:: +.......... + +*note vector-push:: , vector-push-extend, *note fill-pointer:: + + +File: gcl.info, Node: vector-push, Next: vectorp, Prev: vector-pop, Up: Arrays Dictionary + +15.2.31 vector-push, vector-push-extend [Function] +-------------------------------------------------- + +'vector-push' new-element vector => new-index-p + + 'vector-push-extend' new-element vector &optional extension => +new-index + +Arguments and Values:: +...................... + +new-element--an object. + + vector--a vector with a fill pointer. + + extension--a positive integer. The default is +implementation-dependent. + + new-index-p--a valid array index for vector, or nil. + + new-index--a valid array index for vector. + +Description:: +............. + +vector-push and vector-push-extend store new-element in vector. +vector-push attempts to store new-element in the element of vector +designated by the fill pointer, and to increase the fill pointer by one. +If the (>= (fill-pointer vector) (array-dimension vector 0)), neither +vector nor its fill pointer are affected. Otherwise, the store and +increment take place and vector-push returns the former value of the +fill pointer which is one less than the one it leaves in vector. + + vector-push-extend is just like vector-push except that if the fill +pointer gets too large, vector is extended using adjust-array so that it +can contain more elements. Extension is the minimum number of elements +to be added to vector if it must be extended. + + vector-push and vector-push-extend return the index of new-element in +vector. If (>= (fill-pointer vector) (array-dimension vector 0)), +vector-push returns nil. + +Examples:: +.......... + + (vector-push (setq fable (list 'fable)) + (setq fa (make-array 8 + :fill-pointer 2 + :initial-element 'first-one))) => 2 + (fill-pointer fa) => 3 + (eq (aref fa 2) fable) => true + (vector-push-extend #\X + (setq aa + (make-array 5 + :element-type 'character + :adjustable t + :fill-pointer 3))) => 3 + (fill-pointer aa) => 4 + (vector-push-extend #\Y aa 4) => 4 + (array-total-size aa) => at least 5 + (vector-push-extend #\Z aa 4) => 5 + (array-total-size aa) => 9 ;(or more) + +Affected By:: +............. + +The value of the fill pointer. + + How vector was created. + +Exceptional Situations:: +........................ + +An error of type error is signaled by vector-push-extend if it tries to +extend vector and vector is not actually adjustable. + + An error of type error is signaled if vector does not have a fill +pointer. + +See Also:: +.......... + +*note adjustable-array-p:: , *note fill-pointer:: , *note vector-pop:: + + +File: gcl.info, Node: vectorp, Next: bit (Array), Prev: vector-push, Up: Arrays Dictionary + +15.2.32 vectorp [Function] +-------------------------- + +'vectorp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type vector; otherwise, returns false. + +Examples:: +.......... + + (vectorp "aaaaaa") => true + (vectorp (make-array 6 :fill-pointer t)) => true + (vectorp (make-array '(2 3 4))) => false + (vectorp #*11) => true + (vectorp #b11) => false + +Notes:: +....... + + (vectorp object) == (typep object 'vector) + + +File: gcl.info, Node: bit (Array), Next: bit-and, Prev: vectorp, Up: Arrays Dictionary + +15.2.33 bit, sbit [Accessor] +---------------------------- + +'bit' bit-array &rest subscripts => bit + + 'sbit' bit-array &rest subscripts => bit + + (setf ('bit' bit-array &rest subscripts) new-bit) +(setf ('sbit' bit-array &rest subscripts) new-bit) + +Arguments and Values:: +...................... + +bit-array--for bit, a bit array; for sbit, a simple bit array. + + subscripts--a list of valid array indices for the bit-array. + + bit--a bit. + +Description:: +............. + +bit and sbit access the bit-array element specified by subscripts. + + These functions ignore the fill pointer when accessing elements. + +Examples:: +.......... + + (bit (setq ba (make-array 8 + :element-type 'bit + :initial-element 1)) + 3) => 1 + (setf (bit ba 3) 0) => 0 + (bit ba 3) => 0 + (sbit ba 5) => 1 + (setf (sbit ba 5) 1) => 1 + (sbit ba 5) => 1 + +See Also:: +.......... + +*note aref:: , + + *note Compiler Terminology:: + +Notes:: +....... + +bit and sbit are like aref except that they require arrays to be a bit +array and a simple bit array, respectively. + + bit and sbit, unlike char and schar, allow the first argument to be +an array of any rank. + + +File: gcl.info, Node: bit-and, Next: bit-vector-p, Prev: bit (Array), Up: Arrays Dictionary + +15.2.34 bit-and, bit-andc1, bit-andc2, bit-eqv, +----------------------------------------------- + +bit-ior, bit-nand, bit-nor, bit-not, bit-orc1, bit-orc2, bit-xor +---------------------------------------------------------------- + + [Function] + + 'bit-and' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-andc1' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-andc2' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-eqv' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-ior' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-nand' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-nor' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-orc1' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-orc2' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-xor' bit-array1 bit-array2 &optional opt-arg => +resulting-bit-array + + 'bit-not' bit-array &optional opt-arg => resulting-bit-array + +Arguments and Values:: +...................... + +bit-array, bit-array1, bit-array2--a bit array. + + Opt-arg--a bit array, or t, or nil. The default is nil. + + Bit-array, bit-array1, bit-array2, and opt-arg (if an array) must all +be of the same rank and dimensions. + + resulting-bit-array--a bit array. + +Description:: +............. + +These functions perform bit-wise logical operations on bit-array1 and +bit-array2 and return an array of matching rank and dimensions, such +that any given bit of the result is produced by operating on +corresponding bits from each of the arguments. + + In the case of bit-not, an array of rank and dimensions matching +bit-array is returned that contains a copy of bit-array with all the +bits inverted. + + If opt-arg is of type (array bit) the contents of the result are +destructively placed into opt-arg. If opt-arg is the symbol t, +bit-array or bit-array1 is replaced with the result; if opt-arg is nil +or omitted, a new array is created to contain the result. + + Figure 15-4 indicates the logical operation performed by each of the +functions. + + 2 +Function Operation +_______________________________________________________________________________________________________ + +bit-and and +bit-eqv equivalence (exclusive nor) +bit-not complement +bit-ior inclusive or +bit-xor exclusive or +bit-nand complement of bit-array1 and bit-array2 +bit-nor complement of bit-array1 or bit-array2 +bit-andc1 and complement of bit-array1 with bit-array2 +bit-andc2 and bit-array1 with complement of bit-array2 +bit-orc1 or complement of bit-array1 with bit-array2 +bit-orc2 or bit-array1 with complement of bit-array2 + Figure 15-3: Bit-wise Logical Operations on Bit Arrays + +Examples:: +.......... + + (bit-and (setq ba #*11101010) #*01101011) => #*01101010 + (bit-and #*1100 #*1010) => #*1000 + (bit-andc1 #*1100 #*1010) => #*0010 + (setq rba (bit-andc2 ba #*00110011 t)) => #*11001000 + (eq rba ba) => true + (bit-not (setq ba #*11101010)) => #*00010101 + (setq rba (bit-not ba + (setq tba (make-array 8 + :element-type 'bit)))) + => #*00010101 + (equal rba tba) => true + (bit-xor #*1100 #*1010) => #*0110 + +See Also:: +.......... + +lognot, *note logand:: + + +File: gcl.info, Node: bit-vector-p, Next: simple-bit-vector-p, Prev: bit-and, Up: Arrays Dictionary + +15.2.35 bit-vector-p [Function] +------------------------------- + +'bit-vector-p' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type bit-vector; otherwise, returns false. + +Examples:: +.......... + + (bit-vector-p (make-array 6 + :element-type 'bit + :fill-pointer t)) => true + (bit-vector-p #*) => true + (bit-vector-p (make-array 6)) => false + +See Also:: +.......... + +*note typep:: + +Notes:: +....... + + (bit-vector-p object) == (typep object 'bit-vector) + + +File: gcl.info, Node: simple-bit-vector-p, Prev: bit-vector-p, Up: Arrays Dictionary + +15.2.36 simple-bit-vector-p [Function] +-------------------------------------- + +'simple-bit-vector-p' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type simple-bit-vector; otherwise, returns +false. + +Examples:: +.......... + + (simple-bit-vector-p (make-array 6)) => false + (simple-bit-vector-p #*) => true + +See Also:: +.......... + +*note simple-vector-p:: + +Notes:: +....... + + (simple-bit-vector-p object) == (typep object 'simple-bit-vector) + + +File: gcl.info, Node: Strings, Next: Sequences, Prev: Arrays, Up: Top + +16 Strings +********** + +* Menu: + +* String Concepts:: +* Strings Dictionary:: + + +File: gcl.info, Node: String Concepts, Next: Strings Dictionary, Prev: Strings, Up: Strings + +16.1 String Concepts +==================== + +* Menu: + +* Implications of Strings Being Arrays:: +* Subtypes of STRING:: + + +File: gcl.info, Node: Implications of Strings Being Arrays, Next: Subtypes of STRING, Prev: String Concepts, Up: String Concepts + +16.1.1 Implications of Strings Being Arrays +------------------------------------------- + +Since all strings are arrays, all rules which apply generally to arrays +also apply to strings. See *note Array Concepts::. + + For example, strings can have fill pointers, and strings are also +subject to the rules of element type upgrading that apply to arrays. + + +File: gcl.info, Node: Subtypes of STRING, Prev: Implications of Strings Being Arrays, Up: String Concepts + +16.1.2 Subtypes of STRING +------------------------- + +All functions that operate on strings will operate on subtypes of string +as well. + + However, the consequences are undefined if a character is inserted +into a string for which the element type of the string does not include +that character. + + +File: gcl.info, Node: Strings Dictionary, Prev: String Concepts, Up: Strings + +16.2 Strings Dictionary +======================= + +* Menu: + +* string (System Class):: +* base-string:: +* simple-string:: +* simple-base-string:: +* simple-string-p:: +* char:: +* string:: +* string-upcase:: +* string-trim:: +* string=:: +* stringp:: +* make-string:: + + +File: gcl.info, Node: string (System Class), Next: base-string, Prev: Strings Dictionary, Up: Strings Dictionary + +16.2.1 string [System Class] +---------------------------- + +Class Precedence List:: +....................... + +string, vector, array, sequence, t + +Description:: +............. + +A string is a specialized vector whose elements are of type character or +a subtype of type character. When used as a type specifier for object +creation, string means (vector character). + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('string'{[size]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum, or the symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the union of all types (array c (size)) for all subtypes c +of character; that is, the set of strings of size size. + +See Also:: +.......... + +*note String Concepts::, *note Double-Quote::, *note Printing Strings:: + + +File: gcl.info, Node: base-string, Next: simple-string, Prev: string (System Class), Up: Strings Dictionary + +16.2.2 base-string [Type] +------------------------- + +Supertypes:: +............ + +base-string, string, vector, array, sequence, t + +Description:: +............. + +The type base-string is equivalent to + + (vector base-char). + + The base string representation is the most efficient string +representation that can hold an arbitrary sequence of standard +characters. + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('base-string'{[size]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum, or the symbol *. + +Compound Type Specifier Description:: +..................................... + +This is equivalent to the type (vector base-char size); that is, the set +of base strings of size size. + + +File: gcl.info, Node: simple-string, Next: simple-base-string, Prev: base-string, Up: Strings Dictionary + +16.2.3 simple-string [Type] +--------------------------- + +Supertypes:: +............ + +simple-string, string, vector, simple-array, array, sequence, t + +Description:: +............. + +A simple string is a specialized one-dimensional simple array whose +elements are of type character or a subtype of type character. When +used as a type specifier for object creation, simple-string means +(simple-array character (size)). + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('simple-string'{[size]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum, or the symbol *. + +Compound Type Specifier Description:: +..................................... + +This denotes the union of all types (simple-array c (size)) for all +subtypes c of character; that is, the set of simple strings of size +size. + + +File: gcl.info, Node: simple-base-string, Next: simple-string-p, Prev: simple-string, Up: Strings Dictionary + +16.2.4 simple-base-string [Type] +-------------------------------- + +Supertypes:: +............ + +simple-base-string, base-string, simple-string, string, vector, +simple-array, array, sequence, t + +Description:: +............. + +The type simple-base-string is equivalent to + + (simple-array base-char (*)). + +Compound Type Specifier Kind:: +.............................. + +Abbreviating. + +Compound Type Specifier Syntax:: +................................ + +('simple-base-string'{[size]}) + +Compound Type Specifier Arguments:: +................................... + +size--a non-negative fixnum, or the symbol *. + +Compound Type Specifier Description:: +..................................... + +This is equivalent to the type (simple-array base-char (size)); that is, +the set of simple base strings of size size. + + +File: gcl.info, Node: simple-string-p, Next: char, Prev: simple-base-string, Up: Strings Dictionary + +16.2.5 simple-string-p [Function] +--------------------------------- + +'simple-string-p' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type simple-string; otherwise, returns +false. + +Examples:: +.......... + + (simple-string-p "aaaaaa") => true + (simple-string-p (make-array 6 + :element-type 'character + :fill-pointer t)) => false + +Notes:: +....... + + (simple-string-p object) == (typep object 'simple-string) + + +File: gcl.info, Node: char, Next: string, Prev: simple-string-p, Up: Strings Dictionary + +16.2.6 char, schar [Accessor] +----------------------------- + +'char' string index => character + + 'schar' string index => character + + (setf ('char' string index) new-character) +(setf ('schar' string index) new-character) + +Arguments and Values:: +...................... + +string--for char, a string; for schar, a simple string. + + index--a valid array index for the string. + + character, new-character--a character. + +Description:: +............. + +char and schar access the element of string specified by index. + + char ignores fill pointers when accessing elements. + +Examples:: +.......... + + (setq my-simple-string (make-string 6 :initial-element #\A)) => "AAAAAA" + (schar my-simple-string 4) => #\A + (setf (schar my-simple-string 4) #\B) => #\B + my-simple-string => "AAAABA" + (setq my-filled-string + (make-array 6 :element-type 'character + :fill-pointer 5 + :initial-contents my-simple-string)) + => "AAAAB" + (char my-filled-string 4) => #\B + (char my-filled-string 5) => #\A + (setf (char my-filled-string 3) #\C) => #\C + (setf (char my-filled-string 5) #\D) => #\D + (setf (fill-pointer my-filled-string) 6) => 6 + my-filled-string => "AAACBD" + +See Also:: +.......... + +*note aref:: , *note elt:: , + + *note Compiler Terminology:: + +Notes:: +....... + + (char s j) == (aref (the string s) j) + + +File: gcl.info, Node: string, Next: string-upcase, Prev: char, Up: Strings Dictionary + +16.2.7 string [Function] +------------------------ + +'string' x => string + +Arguments and Values:: +...................... + +x--a string, a symbol, or a character. + + string--a string. + +Description:: +............. + +Returns a string described by x; specifically: + +* + If x is a string, it is returned. +* + If x is a symbol, its name is returned. +* + + If x is a character, + + then a string containing that one character is returned. +* + + string might perform additional, implementation-defined + conversions. + +Examples:: +.......... + + (string "already a string") => "already a string" + (string 'elm) => "ELM" + (string #\c) => "c" + +Exceptional Situations:: +........................ + +In the case where a conversion is defined neither by this specification +nor by the implementation, an error of type type-error is signaled. + +See Also:: +.......... + +*note coerce:: , string (type). + +Notes:: +....... + +coerce can be used to convert a sequence of characters to a string. + + prin1-to-string, princ-to-string, write-to-string, or format (with a +first argument of nil) can be used to get a string representation of a +number or any other object. + + +File: gcl.info, Node: string-upcase, Next: string-trim, Prev: string, Up: Strings Dictionary + +16.2.8 string-upcase, string-downcase, string-capitalize, +--------------------------------------------------------- + +nstring-upcase, nstring-downcase, nstring-capitalize +---------------------------------------------------- + + [Function] + + 'string-upcase' string &key start end => cased-string + + 'string-downcase' string &key start end => cased-string + + 'string-capitalize' string &key start end => cased-string + + 'nstring-upcase' string &key start end => string + + 'nstring-downcase' string &key start end => string + + 'nstring-capitalize' string &key start end => string + +Arguments and Values:: +...................... + +string--a string designator. For nstring-upcase, nstring-downcase, and +nstring-capitalize, the string designator must be a string. + + start, end--bounding index designators of string. The defaults for +start and end are 0 and nil, respectively. + + cased-string--a string. + +Description:: +............. + +string-upcase, string-downcase, string-capitalize, nstring-upcase, +nstring-downcase, nstring-capitalize change the case of the subsequence +of string bounded by start and end as follows: + +string-upcase + string-upcase returns a string just like string with all lowercase + characters replaced by the corresponding uppercase characters. + More precisely, each character of the result string is produced by + applying the function char-upcase to the corresponding character of + string. + +string-downcase + string-downcase is like string-upcase except that all uppercase + characters are replaced by the corresponding lowercase characters + (using char-downcase). + +string-capitalize + string-capitalize produces a copy of string such that, for every + word in the copy, the first character of the "word," if it has + case, is uppercase and any other characters with case in the word + are lowercase. For the purposes of string-capitalize, a "word" is + defined to be a consecutive subsequence consisting of alphanumeric + characters, delimited at each end either by a non-alphanumeric + character or by an end of the string. + +nstring-upcase, nstring-downcase, nstring-capitalize + nstring-upcase, nstring-downcase, and nstring-capitalize are + identical to string-upcase, string-downcase, and string-capitalize + respectively except that they modify string. + + For string-upcase, string-downcase, and string-capitalize, string is +not modified. However, if no characters in string require conversion, +the result may be either string or a copy of it, at the implementation's +discretion. + +Examples:: +.......... + + (string-upcase "abcde") => "ABCDE" + (string-upcase "Dr. Livingston, I presume?") + => "DR. LIVINGSTON, I PRESUME?" + (string-upcase "Dr. Livingston, I presume?" :start 6 :end 10) + => "Dr. LiVINGston, I presume?" + (string-downcase "Dr. Livingston, I presume?") + => "dr. livingston, i presume?" + + (string-capitalize "elm 13c arthur;fig don't") => "Elm 13c Arthur;Fig Don'T" + (string-capitalize " hello ") => " Hello " + (string-capitalize "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") + => "Occluded Casements Forestall Inadvertent Defenestration" + (string-capitalize 'kludgy-hash-search) => "Kludgy-Hash-Search" + (string-capitalize "DON'T!") => "Don'T!" ;not "Don't!" + (string-capitalize "pipe 13a, foo16c") => "Pipe 13a, Foo16c" + + (setq str (copy-seq "0123ABCD890a")) => "0123ABCD890a" + (nstring-downcase str :start 5 :end 7) => "0123AbcD890a" + str => "0123AbcD890a" + +Side Effects:: +.............. + +nstring-upcase, nstring-downcase, and nstring-capitalize modify string +as appropriate rather than constructing a new string. + +See Also:: +.......... + +*note char-upcase:: , char-downcase + +Notes:: +....... + +The result is always of the same length as string. + + +File: gcl.info, Node: string-trim, Next: string=, Prev: string-upcase, Up: Strings Dictionary + +16.2.9 string-trim, string-left-trim, string-right-trim [Function] +------------------------------------------------------------------ + +'string-trim' character-bag string => trimmed-string + + 'string-left-trim' character-bag string => trimmed-string + + 'string-right-trim' character-bag string => trimmed-string + +Arguments and Values:: +...................... + +character-bag--a sequence containing characters. + + string--a string designator. + + trimmed-string--a string. + +Description:: +............. + +string-trim returns a substring of string, with all characters in +character-bag stripped off the beginning and end. string-left-trim is +similar but strips characters off only the beginning; string-right-trim +strips off only the end. + + If no characters need to be trimmed from the string, then either +string itself or a copy of it may be returned, at the discretion of the +implementation. + + All of these functions observe the fill pointer. + +Examples:: +.......... + + (string-trim "abc" "abcaakaaakabcaaa") => "kaaak" + (string-trim '(#\Space #\Tab #\Newline) " garbanzo beans + ") => "garbanzo beans" + (string-trim " (*)" " ( *three (silly) words* ) ") + => "three (silly) words" + + (string-left-trim "abc" "labcabcabc") => "labcabcabc" + (string-left-trim " (*)" " ( *three (silly) words* ) ") + => "three (silly) words* ) " + + (string-right-trim " (*)" " ( *three (silly) words* ) ") + => " ( *three (silly) words" + +Affected By:: +............. + +The implementation. + + +File: gcl.info, Node: string=, Next: stringp, Prev: string-trim, Up: Strings Dictionary + +16.2.10 string=, string/=, string<, string>, string<=, string>=, +---------------------------------------------------------------- + +string-equal, string-not-equal, string-lessp, +--------------------------------------------- + +string-greaterp, string-not-greaterp, string-not-lessp +------------------------------------------------------ + + [Function] + + 'string=' string1 string2 &key start1 end1 start2 end2 => +generalized-boolean + + 'string/=' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string<' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string>' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string<=' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string>=' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string-equal' string1 string2 &key start1 end1 start2 end2 => +generalized-boolean + + 'string-not-equal' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string-lessp' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string-greaterp' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string-not-greaterp' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + + 'string-not-lessp' string1 string2 &key start1 end1 start2 end2 => +mismatch-index + +Arguments and Values:: +...................... + +string1--a string designator. + + string2--a string designator. + + start1, end1--bounding index designators of string1. The defaults +for start and end are 0 and nil, respectively. + + start2, end2--bounding index designators of string2. The defaults +for start and end are 0 and nil, respectively. + + generalized-boolean--a generalized boolean. + + mismatch-index--a bounding index of string1, or nil. + +Description:: +............. + +These functions perform lexicographic comparisons on string1 and +string2. string= and string-equal are called equality functions; the +others are called inequality functions. The comparison operations these +functions perform are restricted to the subsequence of string1 bounded +by start1 and end1 and to the subsequence of string2 bounded by start2 +and end2. + + A string a is equal to a string b if it contains the same number of +characters, and the corresponding characters are the same under char= or +char-equal, as appropriate. + + A string a is less than a string b if in the first position in which +they differ the character of a is less than the corresponding character +of b according to char< or char-lessp as appropriate, or if string a is +a proper prefix of string b (of shorter length and matching in all the +characters of a). + + The equality functions return a generalized boolean that is true if +the strings are equal, or false otherwise. + + The inequality functions return a mismatch-index that is true if the +strings are not equal, or false otherwise. When the mismatch-index is +true, it is an integer representing the first character position at +which the two substrings differ, as an offset from the beginning of +string1. + + The comparison has one of the following results: + +string= + string= is true if the supplied substrings are of the same length + and contain the same characters in corresponding positions; + otherwise it is false. + +string/= + string/= is true if the supplied substrings are different; + otherwise it is false. + +string-equal + string-equal is just like string= except that differences in case + are ignored; two characters are considered to be the same if + char-equal is true of them. + +string< + string< is true if substring1 is less than substring2; otherwise it + is false. + +string> + string> is true if substring1 is greater than substring2; otherwise + it is false. + +string-lessp, string-greaterp + string-lessp and string-greaterp are exactly like string< and + string>, respectively, except that distinctions between uppercase + and lowercase letters are ignored. It is as if char-lessp were + used instead of char< for comparing characters. + +string<= + string<= is true if substring1 is less than or equal to substring2; + otherwise it is false. + +string>= + string>= is true if substring1 is greater than or equal to + substring2; otherwise it is false. + +string-not-greaterp, string-not-lessp + string-not-greaterp and string-not-lessp are exactly like string<= + and string>=, respectively, except that distinctions between + uppercase and lowercase letters are ignored. It is as if + char-lessp were used instead of char< for comparing characters. + +Examples:: +.......... + + (string= "foo" "foo") => true + (string= "foo" "Foo") => false + (string= "foo" "bar") => false + (string= "together" "frog" :start1 1 :end1 3 :start2 2) => true + (string-equal "foo" "Foo") => true + (string= "abcd" "01234abcd9012" :start2 5 :end2 9) => true + (string< "aaaa" "aaab") => 3 + (string>= "aaaaa" "aaaa") => 4 + (string-not-greaterp "Abcde" "abcdE") => 5 + (string-lessp "012AAAA789" "01aaab6" :start1 3 :end1 7 + :start2 2 :end2 6) => 6 + (string-not-equal "AAAA" "aaaA") => false + +See Also:: +.......... + +*note char=:: + +Notes:: +....... + +equal calls string= if applied to two strings. + + +File: gcl.info, Node: stringp, Next: make-string, Prev: string=, Up: Strings Dictionary + +16.2.11 stringp [Function] +-------------------------- + +'stringp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type string; otherwise, returns false. + +Examples:: +.......... + + (stringp "aaaaaa") => true + (stringp #\a) => false + +See Also:: +.......... + +*note typep:: , string (type) + +Notes:: +....... + + (stringp object) == (typep object 'string) + + +File: gcl.info, Node: make-string, Prev: stringp, Up: Strings Dictionary + +16.2.12 make-string [Function] +------------------------------ + +'make-string' size &key initial-element element-type => string + +Arguments and Values:: +...................... + +size--a valid array dimension. + + initial-element--a character. + + The default is implementation-dependent. + + element-type--a type specifier. The default is character. + + string--a simple string. + +Description:: +............. + +make-string returns a simple string of length size whose elements have +been initialized to initial-element. + + The element-type names the type of the elements of the string; a +string is constructed of the most specialized type that can accommodate +elements of the given type. + +Examples:: +.......... + + (make-string 10 :initial-element #\5) => "5555555555" + (length (make-string 10)) => 10 + +Affected By:: +............. + +The implementation. + + +File: gcl.info, Node: Sequences, Next: Hash Tables, Prev: Strings, Up: Top + +17 Sequences +************ + +* Menu: + +* Sequence Concepts:: +* Rules about Test Functions:: +* Sequences Dictionary:: + + +File: gcl.info, Node: Sequence Concepts, Next: Rules about Test Functions, Prev: Sequences, Up: Sequences + +17.1 Sequence Concepts +====================== + +A sequence is an ordered collection of elements, implemented as either a +vector or a list. + + Sequences can be created by the function make-sequence, as well as +other functions that create objects of types that are subtypes of +sequence (e.g., list, make-list, mapcar, and vector). + + A sequence function is a function defined by this specification or +added as an extension by the implementation that operates on one or more +sequences. Whenever a sequence function must construct and return a new +vector, it always returns a simple vector. Similarly, any strings +constructed will be simple strings. + + concatenate length remove + copy-seq map remove-duplicates + count map-into remove-if + count-if merge remove-if-not + count-if-not mismatch replace + delete notany reverse + delete-duplicates notevery search + delete-if nreverse some + delete-if-not nsubstitute sort + elt nsubstitute-if stable-sort + every nsubstitute-if-not subseq + fill position substitute + find position-if substitute-if + find-if position-if-not substitute-if-not + find-if-not reduce + + Figure 17-1: Standardized Sequence Functions + + +* Menu: + +* General Restrictions on Parameters that must be Sequences:: + + +File: gcl.info, Node: General Restrictions on Parameters that must be Sequences, Prev: Sequence Concepts, Up: Sequence Concepts + +17.1.1 General Restrictions on Parameters that must be Sequences +---------------------------------------------------------------- + +In general, lists (including association lists and property lists) that +are treated as sequences must be proper lists. + + +File: gcl.info, Node: Rules about Test Functions, Next: Sequences Dictionary, Prev: Sequence Concepts, Up: Sequences + +17.2 Rules about Test Functions +=============================== + +* Menu: + +* Satisfying a Two-Argument Test:: +* Satisfying a One-Argument Test:: + + +File: gcl.info, Node: Satisfying a Two-Argument Test, Next: Satisfying a One-Argument Test, Prev: Rules about Test Functions, Up: Rules about Test Functions + +17.2.1 Satisfying a Two-Argument Test +------------------------------------- + +When an object O is being considered iteratively against each element +E_i of a sequence S by an operator F listed in Figure 17-2, it is +sometimes useful to control the way in which the presence of O is tested +in S is tested by F. This control is offered on the basis of a function +designated with either a :test or :test-not argument. + + adjoin nset-exclusive-or search + assoc nsublis set-difference + count nsubst set-exclusive-or + delete nsubstitute sublis + find nunion subsetp + intersection position subst + member pushnew substitute + mismatch rassoc tree-equal + nintersection remove union + nset-difference remove-duplicates + + Figure 17-2: Operators that have Two-Argument Tests to be Satisfied + + + The object O might not be compared directly to E_i. If a :key +argument is provided, it is a designator for a function of one argument +to be called with each E_i as an argument, and yielding an object Z_i to +be used for comparison. (If there is no :key argument, Z_i is E_i.) + + The function designated by the :key argument is never called on O +itself. However, if the function operates on multiple sequences (e.g., +as happens in set-difference), O will be the result of calling the :key +function on an element of the other sequence. + + A :test argument, if supplied to F, is a designator for a function of +two arguments, O and Z_i. An E_i is said (or, sometimes, an O and an +E_i are said) to satisfy the test + + if this :test function returns a generalized boolean representing +true. + + A :test-not argument, if supplied to F, is designator for a function +of two arguments, O and Z_i. An E_i is said (or, sometimes, an O and an +E_i are said) to satisfy the test + + if this :test-not function returns a generalized boolean representing +false. + + If neither a :test nor a :test-not argument is supplied, it is as if +a :test argument of #'eql was supplied. + + The consequences are unspecified if both a :test and a :test-not +argument are supplied in the same call to F. + +* Menu: + +* Examples of Satisfying a Two-Argument Test:: + + +File: gcl.info, Node: Examples of Satisfying a Two-Argument Test, Prev: Satisfying a Two-Argument Test, Up: Satisfying a Two-Argument Test + +17.2.1.1 Examples of Satisfying a Two-Argument Test +................................................... + + (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equal) + => (foo bar "BAR" "foo" "bar") + (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equalp) + => (foo bar "BAR" "bar") + (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string-equal) + => (bar "BAR" "bar") + (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string=) + => (BAR "BAR" "foo" "bar") + + (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'eql) + => (1) + (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'=) + => (1 1.0 #C(1.0 0.0)) + (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test (complement #'=)) + => (1 1.0 #C(1.0 0.0)) + + (count 1 '((one 1) (uno 1) (two 2) (dos 2)) :key #'cadr) => 2 + + (count 2.0 '(1 2 3) :test #'eql :key #'float) => 1 + + (count "FOO" (list (make-pathname :name "FOO" :type "X") + (make-pathname :name "FOO" :type "Y")) + :key #'pathname-name + :test #'equal) + => 2 + + +File: gcl.info, Node: Satisfying a One-Argument Test, Prev: Satisfying a Two-Argument Test, Up: Rules about Test Functions + +17.2.2 Satisfying a One-Argument Test +------------------------------------- + +When using one of the functions in Figure 17-3, the elements E of a +sequence S are filtered not on the basis of the presence or absence of +an object O under a two argument predicate, as with the functions +described in *note Satisfying a Two-Argument Test::, but rather on the +basis of a one argument predicate. + + assoc-if member-if rassoc-if + assoc-if-not member-if-not rassoc-if-not + count-if nsubst-if remove-if + count-if-not nsubst-if-not remove-if-not + delete-if nsubstitute-if subst-if + delete-if-not nsubstitute-if-not subst-if-not + find-if position-if substitute-if + find-if-not position-if-not substitute-if-not + + Figure 17-3: Operators that have One-Argument Tests to be Satisfied + + + The element E_i might not be considered directly. If a :key argument +is provided, it is a designator for a function of one argument to be +called with each E_i as an argument, and yielding an object Z_i to be +used for comparison. (If there is no :key argument, Z_i is E_i.) + + Functions defined in this specification and having a name that ends +in "-if" accept a first argument that is a designator for a function of +one argument, Z_i. An E_i is said to satisfy the test if this :test +function returns a generalized boolean representing true. + + Functions defined in this specification and having a name that ends +in "-if-not" accept a first argument that is a designator for a function +of one argument, Z_i. An E_i is said to satisfy the test if this :test +function returns a generalized boolean representing false. + +* Menu: + +* Examples of Satisfying a One-Argument Test:: + + +File: gcl.info, Node: Examples of Satisfying a One-Argument Test, Prev: Satisfying a One-Argument Test, Up: Satisfying a One-Argument Test + +17.2.2.1 Examples of Satisfying a One-Argument Test +................................................... + + (count-if #'zerop '(1 #C(0.0 0.0) 0 0.0d0 0.0s0 3)) => 4 + + (remove-if-not #'symbolp '(0 1 2 3 4 5 6 7 8 9 A B C D E F)) + => (A B C D E F) + (remove-if (complement #'symbolp) '(0 1 2 3 4 5 6 7 8 9 A B C D E F)) + => (A B C D E F) + + (count-if #'zerop '("foo" "" "bar" "" "" "baz" "quux") :key #'length) + => 3 + + +File: gcl.info, Node: Sequences Dictionary, Prev: Rules about Test Functions, Up: Sequences + +17.3 Sequences Dictionary +========================= + +* Menu: + +* sequence:: +* copy-seq:: +* elt:: +* fill:: +* make-sequence:: +* subseq:: +* map:: +* map-into:: +* reduce:: +* count:: +* length:: +* reverse:: +* sort:: +* find:: +* position:: +* search:: +* mismatch:: +* replace:: +* substitute:: +* concatenate:: +* merge:: +* remove:: +* remove-duplicates:: + + +File: gcl.info, Node: sequence, Next: copy-seq, Prev: Sequences Dictionary, Up: Sequences Dictionary + +17.3.1 sequence [System Class] +------------------------------ + +Class Precedence List:: +....................... + +sequence, t + +Description:: +............. + +Sequences are ordered collections of objects, called the elements of the +sequence. + + The types vector and the type list are disjoint subtypes of type +sequence, but are not necessarily an exhaustive partition of sequence. + + When viewing a vector as a sequence, only the active elements of that +vector are considered elements of the sequence; that is, sequence +operations respect the fill pointer when given sequences represented as +vectors. + + +File: gcl.info, Node: copy-seq, Next: elt, Prev: sequence, Up: Sequences Dictionary + +17.3.2 copy-seq [Function] +-------------------------- + +'copy-seq' sequence => copied-sequence + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + copied-sequence--a proper sequence. + +Description:: +............. + +Creates a copy of sequence. The elements of the new sequence are the +same as the corresponding elements of the given sequence. + + If sequence is a vector, the result is a fresh simple array of rank +one that has the same actual array element type as sequence. If +sequence is a list, the result is a fresh list. + +Examples:: +.......... + + (setq str "a string") => "a string" + (equalp str (copy-seq str)) => true + (eql str (copy-seq str)) => false + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note copy-list:: + +Notes:: +....... + +From a functional standpoint, + (copy-seq x) == (subseq x 0) + + However, the programmer intent is typically very different in these +two cases. + + +File: gcl.info, Node: elt, Next: fill, Prev: copy-seq, Up: Sequences Dictionary + +17.3.3 elt [Accessor] +--------------------- + +'elt' sequence index => object + + (setf (' elt' sequence index) new-object) + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + index--a valid sequence index for sequence. + + object--an object. + + new-object--an object. + +Description:: +............. + +Accesses the element of sequence specified by index. + +Examples:: +.......... + + (setq str (copy-seq "0123456789")) => "0123456789" + (elt str 6) => #\6 + (setf (elt str 0) #\#) => #\# + str => "#123456789" + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. Should signal an error of type type-error if +index is not a valid sequence index for sequence. + +See Also:: +.......... + +*note aref:: , *note nth:: , + + *note Compiler Terminology:: + +Notes:: +....... + +aref may be used to access vector elements that are beyond the vector's +fill pointer. + + +File: gcl.info, Node: fill, Next: make-sequence, Prev: elt, Up: Sequences Dictionary + +17.3.4 fill [Function] +---------------------- + +'fill' sequence item &key start end => sequence + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + item--a sequence. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + +Description:: +............. + +Replaces the elements of sequence bounded by start and end with item. + +Examples:: +.......... + + (fill (list 0 1 2 3 4 5) '(444)) => ((444) (444) (444) (444) (444) (444)) + (fill (copy-seq "01234") #\e :start 3) => "012ee" + (setq x (vector 'a 'b 'c 'd 'e)) => #(A B C D E) + (fill x 'z :start 1 :end 3) => #(A Z Z D E) + x => #(A Z Z D E) + (fill x 'p) => #(P P P P P) + x => #(P P P P P) + +Side Effects:: +.............. + +Sequence is destructively modified. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. Should signal an error of type type-error if +start is not a non-negative integer. Should signal an error of type +type-error if end is not a non-negative integer or nil. + +See Also:: +.......... + +*note replace:: , nsubstitute + +Notes:: +....... + +(fill sequence item) == (nsubstitute-if item (constantly t) sequence) + + +File: gcl.info, Node: make-sequence, Next: subseq, Prev: fill, Up: Sequences Dictionary + +17.3.5 make-sequence [Function] +------------------------------- + +'make-sequence' result-type size &key initial-element => sequence + +Arguments and Values:: +...................... + +result-type--a sequence type specifier. + + size--a non-negative integer. + + initial-element--an object. The default is implementation-dependent. + + sequence--a proper sequence. + +Description:: +............. + +Returns a sequence of the type result-type and of length size, each of +the elements of which has been initialized to initial-element. + + If the result-type is a subtype of list, the result will be a list. + + If the result-type is a subtype of vector, then if the implementation +can determine the element type specified for the result-type, the +element type of the resulting array is the result of upgrading that +element type; or, if the implementation can determine that the element +type is unspecified (or *), the element type of the resulting array is +t; otherwise, an error is signaled. + +Examples:: +.......... + + (make-sequence 'list 0) => () + (make-sequence 'string 26 :initial-element #\.) + => ".........................." + (make-sequence '(vector double-float) 2 + :initial-element 1d0) + => #(1.0d0 1.0d0) + + (make-sequence '(vector * 2) 3) should signal an error + (make-sequence '(vector * 4) 3) should signal an error + +Affected By:: +............. + +The implementation. + +Exceptional Situations:: +........................ + +The consequences are unspecified if initial-element is not an object +which can be stored in the resulting sequence. + + An error of type type-error must be signaled if the result-type is +neither a recognizable subtype of list, nor a recognizable subtype of +vector. + + An error of type type-error should be signaled if result-type +specifies the number of elements and size is different from that number. + +See Also:: +.......... + +*note make-array:: , *note make-list:: + +Notes:: +....... + + (make-sequence 'string 5) == (make-string 5) + + +File: gcl.info, Node: subseq, Next: map, Prev: make-sequence, Up: Sequences Dictionary + +17.3.6 subseq [Accessor] +------------------------ + +'subseq' sequence start &optional end => subsequence + + (setf (' subseq' sequence start &optional end) new-subsequence) + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + start, end--bounding index designators of sequence. The default for +end is nil. + + subsequence--a proper sequence. + + new-subsequence--a proper sequence. + +Description:: +............. + +subseq creates a sequence that is a copy of the subsequence of sequence +bounded by start and end. + + Start specifies an offset into the original sequence and marks the +beginning position of the subsequence. end marks the position following +the last element of the subsequence. + + subseq always allocates a new sequence for a result; it never shares +storage with an old sequence. The result subsequence is always of the +same type as sequence. + + If sequence is a vector, the result is a fresh simple array of rank +one that has the same actual array element type as sequence. If +sequence is a list, the result is a fresh list. + + setf may be used with subseq to destructively replace elements of a +subsequence with elements taken from a sequence of new values. If the +subsequence and the new sequence are not of equal length, the shorter +length determines the number of elements that are replaced. The +remaining elements at the end of the longer sequence are not modified in +the operation. + +Examples:: +.......... + + (setq str "012345") => "012345" + (subseq str 2) => "2345" + (subseq str 3 5) => "34" + (setf (subseq str 4) "abc") => "abc" + str => "0123ab" + (setf (subseq str 0 2) "A") => "A" + str => "A123ab" + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. Should be prepared to signal an error of type +type-error if new-subsequence is not a proper sequence. + +See Also:: +.......... + +*note replace:: + + +File: gcl.info, Node: map, Next: map-into, Prev: subseq, Up: Sequences Dictionary + +17.3.7 map [Function] +--------------------- + +'map' result-type function &rest sequences^+ => result + +Arguments and Values:: +...................... + +result-type - a sequence type specifier, or nil. + + function--a function designator. function must take as many +arguments as there are sequences. + + sequence--a proper sequence. + + result--if result-type is a type specifier other than nil, then a +sequence of the type it denotes; otherwise (if the result-type is nil), +nil. + +Description:: +............. + +Applies function to successive sets of arguments in which one argument +is obtained from each sequence. The function is called first on all the +elements with index 0, then on all those with index 1, and so on. The +result-type specifies the type of the resulting sequence. + + map returns nil if result-type is nil. Otherwise, map returns a +sequence such that element j is the result of applying function to +element j of each of the sequences. The result sequence is as long as +the shortest of the sequences. The consequences are undefined if the +result of applying function to the successive elements of the sequences +cannot be contained in a sequence of the type given by result-type. + + If the result-type is a subtype of list, the result will be a list. + + If the result-type is a subtype of vector, then if the implementation +can determine the element type specified for the result-type, the +element type of the resulting array is the result of upgrading that +element type; or, if the implementation can determine that the element +type is unspecified (or *), the element type of the resulting array is +t; otherwise, an error is signaled. + +Examples:: +.......... + + (map 'string #'(lambda (x y) + (char "01234567890ABCDEF" (mod (+ x y) 16))) + '(1 2 3 4) + '(10 9 8 7)) => "AAAA" + (setq seq '("lower" "UPPER" "" "123")) => ("lower" "UPPER" "" "123") + (map nil #'nstring-upcase seq) => NIL + seq => ("LOWER" "UPPER" "" "123") + (map 'list #'- '(1 2 3 4)) => (-1 -2 -3 -4) + (map 'string + #'(lambda (x) (if (oddp x) #\1 #\0)) + '(1 2 3 4)) => "1010" + + (map '(vector * 4) #'cons "abc" "de") should signal an error + +Exceptional Situations:: +........................ + +An error of type type-error must be signaled if the result-type is not a +recognizable subtype of list, not a recognizable subtype of vector, and +not nil. + + Should be prepared to signal an error of type type-error if any +sequence is not a proper sequence. + + An error of type type-error should be signaled if result-type +specifies the number of elements and the minimum length of the sequences +is different from that number. + +See Also:: +.......... + +*note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: map-into, Next: reduce, Prev: map, Up: Sequences Dictionary + +17.3.8 map-into [Function] +-------------------------- + +'map-into' result-sequence function &rest sequences => result-sequence + +Arguments and Values:: +...................... + +result-sequence--a proper sequence. + + function--a designator for a function of as many arguments as there +are sequences. + + sequence--a proper sequence. + +Description:: +............. + +Destructively modifies result-sequence to contain the results of +applying function to each element in the argument sequences in turn. + + result-sequence and each element of sequences can each be either a +list or a vector. If result-sequence and each element of sequences are +not all the same length, the iteration terminates when the shortest +sequence (of any of the sequences or the result-sequence) is exhausted. +If result-sequence is a vector with a fill pointer, the fill pointer is +ignored when deciding how many iterations to perform, and afterwards the +fill pointer is set to the number of times function was applied. If +result-sequence is longer than the shortest element of sequences, extra +elements at the end of result-sequence are left unchanged. If +result-sequence is nil, map-into immediately returns nil, since nil is a +sequence of length zero. + + If function has side effects, it can count on being called first on +all of the elements with index 0, then on all of those numbered 1, and +so on. + +Examples:: +.......... + + (setq a (list 1 2 3 4) b (list 10 10 10 10)) => (10 10 10 10) + (map-into a #'+ a b) => (11 12 13 14) + a => (11 12 13 14) + b => (10 10 10 10) + (setq k '(one two three)) => (ONE TWO THREE) + (map-into a #'cons k a) => ((ONE . 11) (TWO . 12) (THREE . 13) 14) + (map-into a #'gensym) => (#:G9090 #:G9091 #:G9092 #:G9093) + a => (#:G9090 #:G9091 #:G9092 #:G9093) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if +result-sequence is not a proper sequence. Should be prepared to signal +an error of type type-error if sequence is not a proper sequence. + +Notes:: +....... + +map-into differs from map in that it modifies an existing sequence +rather than creating a new one. In addition, map-into can be called +with only two arguments, while map requires at least three arguments. + + map-into could be defined by: + + (defun map-into (result-sequence function &rest sequences) + (loop for index below (apply #'min + (length result-sequence) + (mapcar #'length sequences)) + do (setf (elt result-sequence index) + (apply function + (mapcar #'(lambda (seq) (elt seq index)) + sequences)))) + result-sequence) + diff --git a/info/gcl.info-7 b/info/gcl.info-7 new file mode 100644 index 0000000..9bec7bb --- /dev/null +++ b/info/gcl.info-7 @@ -0,0 +1,9206 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: reduce, Next: count, Prev: map-into, Up: Sequences Dictionary + +17.3.9 reduce [Function] +------------------------ + +'reduce' function sequence &key key from-end start end initial-value => +result + +Arguments and Values:: +...................... + +function--a designator for a function that might be called with either +zero or two arguments. + + sequence--a proper sequence. + + key--a designator for a function of one argument, or nil. + + 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. + + initial-value--an object. + + result--an object. + +Description:: +............. + +reduce uses a binary operation, function, to combine the elements of +sequence bounded by start and end. + + The function must accept as arguments two elements of sequence or the +results from combining those elements. The function must also be able +to accept no arguments. + + If key is supplied, it is used is used to extract the values to +reduce. The key function is applied exactly once to each element of +sequence in the order implied by the reduction order but not to the +value of initial-value, if supplied. + + The key function typically returns part of the element of sequence. +If key is not supplied or is nil, the sequence element itself is used. + + The reduction is left-associative, unless from-end is true in which +case it is right-associative. + + If initial-value is supplied, it is logically placed before the +subsequence (or after it if from-end is true) and included in the +reduction operation. + + In the normal case, the result of reduce is the combined result of +function's being applied to successive pairs of elements of sequence. +If the subsequence contains exactly one element and no initial-value is +given, then that element is returned and function is not called. If the +subsequence is empty and an initial-value is given, then the +initial-value is returned and function is not called. If the +subsequence is empty and no initial-value is given, then the function is +called with zero arguments, and reduce returns whatever function does. +This is the only case where the function is called with other than two +arguments. + +Examples:: +.......... + + (reduce #'* '(1 2 3 4 5)) => 120 + (reduce #'append '((1) (2)) :initial-value '(i n i t)) => (I N I T 1 2) + (reduce #'append '((1) (2)) :from-end t + :initial-value '(i n i t)) => (1 2 I N I T) + (reduce #'- '(1 2 3 4)) == (- (- (- 1 2) 3) 4) => -8 + (reduce #'- '(1 2 3 4) :from-end t) ;Alternating sum. + == (- 1 (- 2 (- 3 4))) => -2 + (reduce #'+ '()) => 0 + (reduce #'+ '(3)) => 3 + (reduce #'+ '(foo)) => FOO + (reduce #'list '(1 2 3 4)) => (((1 2) 3) 4) + (reduce #'list '(1 2 3 4) :from-end t) => (1 (2 (3 4))) + (reduce #'list '(1 2 3 4) :initial-value 'foo) => ((((foo 1) 2) 3) 4) + (reduce #'list '(1 2 3 4) + :from-end t :initial-value 'foo) => (1 (2 (3 (4 foo)))) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: count, Next: length, Prev: reduce, Up: Sequences Dictionary + +17.3.10 count, count-if, count-if-not [Function] +------------------------------------------------ + +'count' item sequence &key from-end start end key test test-not => n + + 'count-if' predicate sequence &key from-end start end key => n + + 'count-if-not' predicate sequence &key from-end start end key => n + +Arguments and Values:: +...................... + +item--an object. + + sequence--a proper sequence. + + predicate--a designator for a function of one argument that returns a +generalized boolean. + + from-end--a generalized boolean. The default is false. + + 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. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + + key--a designator for a function of one argument, or nil. + + n--a non-negative integer less than or equal to the length of +sequence. + +Description:: +............. + +count, count-if, and count-if-not count and return the number of +elements in the sequence bounded by start and end that satisfy the test. + + The from-end has no direct effect on the result. However, if +from-end is true, the elements of sequence will be supplied as arguments +to the test, test-not, and key in reverse order, which may change the +side-effects, if any, of those functions. + +Examples:: +.......... + + (count #\a "how many A's are there in here?") => 2 + (count-if-not #'oddp '((1) (2) (3) (4)) :key #'car) => 2 + (count-if #'upper-case-p "The Crying of Lot 49" :start 4) => 2 + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note Rules about Test Functions::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + The function count-if-not is deprecated. + + +File: gcl.info, Node: length, Next: reverse, Prev: count, Up: Sequences Dictionary + +17.3.11 length [Function] +------------------------- + +'length' sequence => n + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + n--a non-negative integer. + +Description:: +............. + +Returns the number of elements in sequence. + + If sequence is a vector with a fill pointer, the active length as +specified by the fill pointer is returned. + +Examples:: +.......... + + (length "abc") => 3 + (setq str (make-array '(3) :element-type 'character + :initial-contents "abc" + :fill-pointer t)) => "abc" + (length str) => 3 + (setf (fill-pointer str) 2) => 2 + (length str) => 2 + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note list-length:: , sequence + + +File: gcl.info, Node: reverse, Next: sort, Prev: length, Up: Sequences Dictionary + +17.3.12 reverse, nreverse [Function] +------------------------------------ + +'reverse' sequence => reversed-sequence + + 'nreverse' sequence => reversed-sequence + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + reversed-sequence--a sequence. + +Description:: +............. + +reverse and nreverse return a new sequence of the same kind as sequence, +containing the same elements, but in reverse order. + + reverse and nreverse differ in that reverse always creates and +returns a new sequence, whereas nreverse might modify and return the +given sequence. reverse never modifies the given sequence. + + For reverse, if sequence is a vector, the result is a fresh simple +array of rank one that has the same actual array element type as +sequence. If sequence is a list, the result is a fresh list. + + For nreverse, if sequence is a vector, the result is a vector that +has the same actual array element type as sequence. If sequence is a +list, the result is a list. + + For nreverse, sequence might be destroyed and re-used to produce the +result. The result might or might not be identical to sequence. + + Specifically, when sequence is a list, nreverse is permitted to setf +any part, car or cdr, of any cons that is part of the list structure of +sequence. When sequence is a vector, nreverse is permitted to re-order +the elements of sequence in order to produce the resulting vector. + +Examples:: +.......... + + (setq str "abc") => "abc" + (reverse str) => "cba" + str => "abc" + (setq str (copy-seq str)) => "abc" + (nreverse str) => "cba" + str => implementation-dependent + (setq l (list 1 2 3)) => (1 2 3) + (nreverse l) => (3 2 1) + l => implementation-dependent + +Side Effects:: +.............. + +nreverse might either create a new sequence, modify the argument +sequence, or both. (reverse does not modify sequence.) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + + +File: gcl.info, Node: sort, Next: find, Prev: reverse, Up: Sequences Dictionary + +17.3.13 sort, stable-sort [Function] +------------------------------------ + +'sort' sequence predicate &key key => sorted-sequence + + 'stable-sort' sequence predicate &key key => sorted-sequence + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + predicate--a designator for a function of two arguments that returns +a generalized boolean. + + key--a designator for a function of one argument, or nil. + + sorted-sequence--a sequence. + +Description:: +............. + +sort and stable-sort destructively sort sequences according to the order +determined by the predicate function. + + If sequence is a vector, the result is a vector that has the same +actual array element type as sequence. The result might or might not be +simple, and might or might not be identical to sequence. If sequence is +a list, the result is a list. + + sort determines the relationship between two elements by giving keys +extracted from the elements to the predicate. The first argument to the +predicate function is the part of one element of sequence extracted by +the key function (if supplied); the second argument is the part of +another element of sequence extracted by the key function (if supplied). +Predicate should return true if and only if the first argument is +strictly less than the second (in some appropriate sense). If the first +argument is greater than or equal to the second (in the appropriate +sense), then the predicate should return false. + + The argument to the key function is the sequence element. The return +value of the key function becomes an argument to predicate. If key is +not supplied or nil, the sequence element itself is used. There is no +guarantee on the number of times the key will be called. + + If the key and predicate always return, then the sorting operation +will always terminate, producing a sequence containing the same elements +as sequence (that is, the result is a permutation of sequence). This is +guaranteed even if the predicate does not really consistently represent +a total order (in which case the elements will be scrambled in some +unpredictable way, but no element will be lost). If the key +consistently returns meaningful keys, and the predicate does reflect +some total ordering criterion on those keys, then the elements of the +sorted-sequence will be properly sorted according to that ordering. + + The sorting operation performed by sort is not guaranteed stable. +Elements considered equal by the predicate might or might not stay in +their original order. The predicate is assumed to consider two elements +x and y to be equal if (funcall predicate x y) and (funcall predicate y +x) are both false. stable-sort guarantees stability. + + The sorting operation can be destructive in all cases. In the case +of a vector argument, this is accomplished by permuting the elements in +place. In the case of a list, the list is destructively reordered in +the same manner as for nreverse. + +Examples:: +.......... + + (setq tester (copy-seq "lkjashd")) => "lkjashd" + (sort tester #'char-lessp) => "adhjkls" + (setq tester (list '(1 2 3) '(4 5 6) '(7 8 9))) => ((1 2 3) (4 5 6) (7 8 9)) + (sort tester #'> :key #'car) => ((7 8 9) (4 5 6) (1 2 3)) + (setq tester (list 1 2 3 4 5 6 7 8 9 0)) => (1 2 3 4 5 6 7 8 9 0) + (stable-sort tester #'(lambda (x y) (and (oddp x) (evenp y)))) + => (1 3 5 7 9 2 4 6 8 0) + (sort (setq committee-data + (vector (list (list "JonL" "White") "Iteration") + (list (list "Dick" "Waters") "Iteration") + (list (list "Dick" "Gabriel") "Objects") + (list (list "Kent" "Pitman") "Conditions") + (list (list "Gregor" "Kiczales") "Objects") + (list (list "David" "Moon") "Objects") + (list (list "Kathy" "Chapman") "Editorial") + (list (list "Larry" "Masinter") "Cleanup") + (list (list "Sandra" "Loosemore") "Compiler"))) + #'string-lessp :key #'cadar) + => #((("Kathy" "Chapman") "Editorial") + (("Dick" "Gabriel") "Objects") + (("Gregor" "Kiczales") "Objects") + (("Sandra" "Loosemore") "Compiler") + (("Larry" "Masinter") "Cleanup") + (("David" "Moon") "Objects") + (("Kent" "Pitman") "Conditions") + (("Dick" "Waters") "Iteration") + (("JonL" "White") "Iteration")) + ;; Note that individual alphabetical order within `committees' + ;; is preserved. + (setq committee-data + (stable-sort committee-data #'string-lessp :key #'cadr)) + => #((("Larry" "Masinter") "Cleanup") + (("Sandra" "Loosemore") "Compiler") + (("Kent" "Pitman") "Conditions") + (("Kathy" "Chapman") "Editorial") + (("Dick" "Waters") "Iteration") + (("JonL" "White") "Iteration") + (("Dick" "Gabriel") "Objects") + (("Gregor" "Kiczales") "Objects") + (("David" "Moon") "Objects")) + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note merge:: , + + *note Compiler Terminology::, + + *note Traversal Rules and Side Effects::, + + *note Destructive Operations:: + + +File: gcl.info, Node: find, Next: position, Prev: sort, Up: Sequences Dictionary + +17.3.14 find, find-if, find-if-not [Function] +--------------------------------------------- + +'find' item sequence &key from-end test test-not start end key => +element + + 'find-if' predicate sequence &key from-end start end key => element + + 'find-if-not' predicate sequence &key from-end start end key => +element + +Arguments and Values:: +...................... + +item--an object. + + sequence--a proper sequence. + + predicate--a designator for a function of one argument that returns a +generalized boolean. + + from-end--a generalized boolean. The default is false. + + 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. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + + key--a designator for a function of one argument, or nil. + + element--an element of the sequence, or nil. + +Description:: +............. + +find, find-if, and find-if-not each search for an element of the +sequence bounded by start and end that satisfies the predicate predicate +or that satisfies the test test or test-not, as appropriate. + + If from-end is true, then the result is the rightmost element that +satisfies the test. + + If the sequence contains an element that satisfies the test, then the +leftmost or rightmost sequence element, depending on from-end, is +returned; otherwise nil is returned. + +Examples:: +.......... + + (find #\d "here are some letters that can be looked at" :test #'char>) + => #\Space + (find-if #'oddp '(1 2 3 4 5) :end 3 :from-end t) => 3 + (find-if-not #'complexp + '#(3.5 2 #C(1.0 0.0) #C(0.0 1.0)) + :start 2) => NIL + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note position:: , *note Rules about Test Functions::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + The function find-if-not is deprecated. + + +File: gcl.info, Node: position, Next: search, Prev: find, Up: Sequences Dictionary + +17.3.15 position, position-if, position-if-not [Function] +--------------------------------------------------------- + +'position' item sequence &key from-end test test-not start end key => +position + + 'position-if' predicate sequence &key from-end start end key => +position + + 'position-if-not' predicate sequence &key from-end start end key => +position + +Arguments and Values:: +...................... + +item--an object. + + sequence--a proper sequence. + + predicate--a designator for a function of one argument that returns a +generalized boolean. + + from-end--a generalized boolean. The default is false. + + 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. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + + key--a designator for a function of one argument, or nil. + + position--a bounding index of sequence, or nil. + +Description:: +............. + +position, position-if, and position-if-not each search sequence for an +element that satisfies the test. + + The position returned is the index within sequence of the leftmost +(if from-end is true) or of the rightmost (if from-end is false) element +that satisfies the test; otherwise nil is returned. The index returned +is relative to the left-hand end of the entire sequence, regardless of +the value of start, end, or from-end. + +Examples:: +.......... + + (position #\a "baobab" :from-end t) => 4 + (position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car) => 2 + (position 595 '()) => NIL + (position-if-not #'integerp '(1 2 3 4 5.0)) => 4 + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note find:: , + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + The function position-if-not is deprecated. + + +File: gcl.info, Node: search, Next: mismatch, Prev: position, Up: Sequences Dictionary + +17.3.16 search [Function] +------------------------- + +'search' sequence-1 sequence-2 &key from-end test test-not key start1 +start2 end1 end2 +=> position + +Arguments and Values:: +...................... + +Sequence-1--a sequence. + + Sequence-2--a sequence. + + from-end--a generalized boolean. The default is false. + + 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. + + start1, end1--bounding index designators of sequence-1. The defaults +for start1 and end1 are 0 and nil, respectively. + + start2, end2--bounding index designators of sequence-2. The defaults +for start2 and end2 are 0 and nil, respectively. + + position--a bounding index of sequence-2, or nil. + +Description:: +............. + +Searches sequence-2 for a subsequence that matches sequence-1. + + The implementation may choose to search sequence-2 in any order; +there is no guarantee on the number of times the test is made. For +example, when start-end is true, the sequence might actually be searched +from left to right instead of from right to left (but in either case +would return the rightmost matching subsequence). If the search +succeeds, search returns the offset into sequence-2 of the first element +of the leftmost or rightmost matching subsequence, depending on +from-end; otherwise search returns nil. + + If from-end is true, the index of the leftmost element of the +rightmost matching subsequence is returned. + +Examples:: +.......... + + (search "dog" "it's a dog's life") => 7 + (search '(0 1) '(2 4 6 1 3 5) :key #'oddp) => 2 + +See Also:: +.......... + +*note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + +File: gcl.info, Node: mismatch, Next: replace, Prev: search, Up: Sequences Dictionary + +17.3.17 mismatch [Function] +--------------------------- + +'mismatch' sequence-1 sequence-2 &key from-end test test-not key start1 +start2 end1 end2 +=> position + +Arguments and Values:: +...................... + +Sequence-1--a sequence. + + Sequence-2--a sequence. + + from-end--a generalized boolean. The default is false. + + 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. + + start1, end1--bounding index designators of sequence-1. The defaults +for start1 and end1 are 0 and nil, respectively. + + start2, end2--bounding index designators of sequence-2. The defaults +for start2 and end2 are 0 and nil, respectively. + + key--a designator for a function of one argument, or nil. + + position--a bounding index of sequence-1, or nil. + +Description:: +............. + +The specified subsequences of sequence-1 and sequence-2 are compared +element-wise. + + The key argument is used for both the sequence-1 and the sequence-2. + + If sequence-1 and sequence-2 are of equal length and match in every +element, the result is false. Otherwise, the result is a non-negative +integer, the index within sequence-1 of the leftmost or rightmost +position, depending on from-end, at which the two subsequences fail to +match. If one subsequence is shorter than and a matching prefix of the +other, the result is the index relative to sequence-1 beyond the last +position tested. + + If from-end is true, then one plus the index of the rightmost +position in which the sequences differ is returned. In effect, the +subsequences are aligned at their right-hand ends; then, the last +elements are compared, the penultimate elements, and so on. The index +returned is an index relative to sequence-1. + +Examples:: +.......... + + (mismatch "abcd" "ABCDE" :test #'char-equal) => 4 + (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) => 3 + (mismatch '(1 2 3) '(2 3 4) :test-not #'eq :key #'oddp) => NIL + (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4) => NIL + +See Also:: +.......... + +*note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + +File: gcl.info, Node: replace, Next: substitute, Prev: mismatch, Up: Sequences Dictionary + +17.3.18 replace [Function] +-------------------------- + +'replace' sequence-1 sequence-2 &key start1 end1 start2 end2 => +sequence-1 + +Arguments and Values:: +...................... + +sequence-1--a sequence. + + sequence-2--a sequence. + + start1, end1--bounding index designators of sequence-1. The defaults +for start1 and end1 are 0 and nil, respectively. + + start2, end2--bounding index designators of sequence-2. The defaults +for start2 and end2 are 0 and nil, respectively. + +Description:: +............. + +Destructively modifies sequence-1 by replacing the elements of +subsequence-1 bounded by start1 and end1 with the elements of +subsequence-2 bounded by start2 and end2. + + Sequence-1 is destructively modified by copying successive elements +into it from sequence-2. Elements of the subsequence of sequence-2 +bounded by start2 and end2 are copied into the subsequence of sequence-1 +bounded by start1 and end1. If these subsequences are not of the same +length, then the shorter length determines how many elements are copied; +the extra elements near the end of the longer subsequence are not +involved in the operation. The number of elements copied can be +expressed as: + + (min (- end1 start1) (- end2 start2)) + + If sequence-1 and sequence-2 are the same object and the region being +modified overlaps the region being copied from, then it is as if the +entire source region were copied to another place and only then copied +back into the target region. However, if sequence-1 and sequence-2 are +not the same, but the region being modified overlaps the region being +copied from (perhaps because of shared list structure or displaced +arrays), then after the replace operation the subsequence of sequence-1 +being modified will have unpredictable contents. It is an error if the +elements of sequence-2 are not of a type that can be stored into +sequence-1. + +Examples:: +.......... + + (replace "abcdefghij" "0123456789" :start1 4 :end1 7 :start2 4) + => "abcd456hij" + (setq lst "012345678") => "012345678" + (replace lst lst :start1 2 :start2 0) => "010123456" + lst => "010123456" + +Side Effects:: +.............. + +The sequence-1 is modified. + +See Also:: +.......... + +*note fill:: + + +File: gcl.info, Node: substitute, Next: concatenate, Prev: replace, Up: Sequences Dictionary + +17.3.19 substitute, substitute-if, substitute-if-not, +----------------------------------------------------- + +nsubstitute, nsubstitute-if, nsubstitute-if-not +----------------------------------------------- + + [Function] + + 'substitute' newitem olditem sequence &key from-end test test-not +start end count key +=> result-sequence + + 'substitute-if' newitem predicate sequence &key from-end start end +count key +=> result-sequence + + 'substitute-if-not' newitem predicate sequence &key from-end start +end count key +=> result-sequence + + 'nsubstitute' newitem olditem sequence &key from-end test test-not +start end count key +=> sequence + + 'nsubstitute-if' newitem predicate sequence &key from-end start end +count key +=> sequence + + 'nsubstitute-if-not' newitem predicate sequence &key from-end start +end count key +=> sequence + +Arguments and Values:: +...................... + +newitem--an object. + + olditem--an object. + + sequence--a proper sequence. + + predicate--a designator for a function of one argument that returns a +generalized boolean. + + from-end--a generalized boolean. The default is false. + + 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. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + + count--an integer or nil. + + The default is nil. + + key--a designator for a function of one argument, or nil. + + result-sequence--a sequence. + +Description:: +............. + +substitute, substitute-if, and substitute-if-not return a copy of +sequence in which each element that satisfies the test has been replaced +with newitem. + + nsubstitute, nsubstitute-if, and nsubstitute-if-not are like +substitute, substitute-if, and substitute-if-not respectively, but they +may modify sequence. + + If sequence is a vector, the result is a vector that has the same +actual array element type as sequence. The result might or might not be +simple, and might or might not be identical to sequence. If sequence is +a list, the result is a list. + + Count, if supplied, limits the number of elements altered; if more +than count elements satisfy the test, then of these elements only the +leftmost or rightmost, depending on from-end, are replaced, as many as +specified by count. + + If count is supplied and negative, the behavior is as if zero had +been supplied instead. + + If count is nil, all matching items are affected. + + Supplying a from-end of true matters only when the count is provided +(and non-nil); in that case, only the rightmost count elements +satisfying the test are removed (instead of the leftmost). + + predicate, test, and test-not might be called more than once for each +sequence element, and their side effects can happen in any order. + + The result of all these functions is a sequence of the same type as +sequence that has the same elements except that those in the subsequence +bounded by start and end and satisfying the test have been replaced by +newitem. + + substitute, substitute-if, and substitute-if-not return a sequence +which can share with sequence or may be identical to the input sequence +if no elements need to be changed. + + nsubstitute and nsubstitute-if are required to setf any car (if +sequence is a list) or aref (if sequence is a vector) of sequence that +is required to be replaced with newitem. If sequence is a list, none of +the cdrs of the top-level list can be modified. + +Examples:: +.......... + + (substitute #\. #\SPACE "0 2 4 6") => "0.2.4.6" + (substitute 9 4 '(1 2 4 1 3 4 5)) => (1 2 9 1 3 9 5) + (substitute 9 4 '(1 2 4 1 3 4 5) :count 1) => (1 2 9 1 3 4 5) + (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) + => (1 2 4 1 3 9 5) + (substitute 9 3 '(1 2 4 1 3 4 5) :test #'>) => (9 9 4 9 3 4 5) + + (substitute-if 0 #'evenp '((1) (2) (3) (4)) :start 2 :key #'car) + => ((1) (2) (3) 0) + (substitute-if 9 #'oddp '(1 2 4 1 3 4 5)) => (9 2 4 9 9 4 9) + (substitute-if 9 #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) + => (1 2 4 1 3 9 5) + + (setq some-things (list 'a 'car 'b 'cdr 'c)) => (A CAR B CDR C) + (nsubstitute-if "function was here" #'fboundp some-things + :count 1 :from-end t) => (A CAR B "function was here" C) + some-things => (A CAR B "function was here" C) + (setq alpha-tester (copy-seq "ab ")) => "ab " + (nsubstitute-if-not #\z #'alpha-char-p alpha-tester) => "abz" + alpha-tester => "abz" + +Side Effects:: +.............. + +nsubstitute, nsubstitute-if, and nsubstitute-if-not modify sequence. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note subst:: , nsubst, + + *note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + The functions substitute-if-not and nsubstitute-if-not are +deprecated. + + nsubstitute and nsubstitute-if can be used in for-effect-only +positions in code. + + Because the side-effecting variants (e.g., nsubstitute) potentially +change the path that is being traversed, their effects in the presence +of shared or circular structure may vary in surprising ways when +compared to their non-side-effecting alternatives. To see this, +consider the following side-effect behavior, which might be exhibited by +some implementations: + + (defun test-it (fn) + (let ((x (cons 'b nil))) + (rplacd x x) + (funcall fn 'a 'b x :count 1))) + (test-it #'substitute) => (A . #1=(B . #1#)) + (test-it #'nsubstitute) => (A . #1#) + + +File: gcl.info, Node: concatenate, Next: merge, Prev: substitute, Up: Sequences Dictionary + +17.3.20 concatenate [Function] +------------------------------ + +'concatenate' result-type &rest sequences => result-sequence + +Arguments and Values:: +...................... + +result-type--a sequence type specifier. + + sequences--a sequence. + + result-sequence--a proper sequence of type result-type. + +Description:: +............. + +concatenate returns a sequence that contains all the individual elements +of all the sequences in the order that they are supplied. The sequence +is of type result-type, which must be a subtype of type sequence. + + All of the sequences are copied from; the result does not share any +structure with any of the sequences. Therefore, if only one sequence is +provided and it is of type result-type, concatenate is required to copy +sequence rather than simply returning it. + + It is an error if any element of the sequences cannot be an element +of the sequence result. + + [Reviewer Note by Barmar: Should signal?] + + If the result-type is a subtype of list, the result will be a list. + + If the result-type is a subtype of vector, then if the implementation +can determine the element type specified for the result-type, the +element type of the resulting array is the result of upgrading that +element type; or, if the implementation can determine that the element +type is unspecified (or *), the element type of the resulting array is +t; otherwise, an error is signaled. + +Examples:: +.......... + + (concatenate 'string "all" " " "together" " " "now") => "all together now" + (concatenate 'list "ABC" '(d e f) #(1 2 3) #*1011) + => (#\A #\B #\C D E F 1 2 3 1 0 1 1) + (concatenate 'list) => NIL + + (concatenate '(vector * 2) "a" "bc") should signal an error + +Exceptional Situations:: +........................ + +An error is signaled if the result-type is neither a recognizable +subtype of list, nor a recognizable subtype of vector. + + An error of type type-error should be signaled if result-type +specifies the number of elements and the sum of sequences is different +from that number. + +See Also:: +.......... + +*note append:: + + +File: gcl.info, Node: merge, Next: remove, Prev: concatenate, Up: Sequences Dictionary + +17.3.21 merge [Function] +------------------------ + +'merge' result-type sequence-1 sequence-2 predicate &key key => +result-sequence + +Arguments and Values:: +...................... + +result-type--a sequence type specifier. + + sequence-1--a sequence. + + sequence-2--a sequence. + + predicate--a designator for a function of two arguments that returns +a generalized boolean. + + key--a designator for a function of one argument, or nil. + + result-sequence--a proper sequence of type result-type. + +Description:: +............. + +Destructively merges sequence-1 with sequence-2 according to an order +determined by the predicate. merge determines the relationship between +two elements by giving keys extracted from the sequence elements to the +predicate. + + The first argument to the predicate function is an element of +sequence-1 as returned by the key (if supplied); the second argument is +an element of sequence-2 as returned by the key (if supplied). +Predicate should return true if and only if its first argument is +strictly less than the second (in some appropriate sense). If the first +argument is greater than or equal to the second (in the appropriate +sense), then predicate should return false. merge considers two +elements x and y to be equal if (funcall predicate x y) and (funcall +predicate y x) both yield false. + + The argument to the key is the sequence element. Typically, the +return value of the key becomes the argument to predicate. If key is +not supplied or nil, the sequence element itself is used. The key may +be executed more than once for each sequence element, and its side +effects may occur in any order. + + If key and predicate return, then the merging operation will +terminate. The result of merging two sequences x and y is a new +sequence of type result-type z, such that the length of z is the sum of +the lengths of x and y, and z contains all the elements of x and y. If +x1 and x2 are two elements of x, and x1 precedes x2 in x, then x1 +precedes x2 in z, and similarly for elements of y. In short, z is an +interleaving of x and y. + + If x and y were correctly sorted according to the predicate, then z +will also be correctly sorted. If x or y is not so sorted, then z will +not be sorted, but will nevertheless be an interleaving of x and y. + + The merging operation is guaranteed stable; if two or more elements +are considered equal by the predicate, then the elements from sequence-1 +will precede those from sequence-2 in the result. + + sequence-1 and/or sequence-2 may be destroyed. + + If the result-type is a subtype of list, the result will be a list. + + If the result-type is a subtype of vector, then if the implementation +can determine the element type specified for the result-type, the +element type of the resulting array is the result of upgrading that +element type; or, if the implementation can determine that the element +type is unspecified (or *), the element type of the resulting array is +t; otherwise, an error is signaled. + +Examples:: +.......... + + (setq test1 (list 1 3 4 6 7)) + (setq test2 (list 2 5 8)) + (merge 'list test1 test2 #'<) => (1 2 3 4 5 6 7 8) + (setq test1 (copy-seq "BOY")) + (setq test2 (copy-seq :nosy")) + (merge 'string test1 test2 #'char-lessp) => "BnOosYy" + (setq test1 (vector ((red . 1) (blue . 4)))) + (setq test2 (vector ((yellow . 2) (green . 7)))) + (merge 'vector test1 test2 #'< :key #'cdr) + => #((RED . 1) (YELLOW . 2) (BLUE . 4) (GREEN . 7)) + + (merge '(vector * 4) '(1 5) '(2 4 6) #'<) should signal an error + +Exceptional Situations:: +........................ + +An error must be signaled if the result-type is neither a recognizable +subtype of list, nor a recognizable subtype of vector. + + An error of type type-error should be signaled if result-type +specifies the number of elements and the sum of the lengths of +sequence-1 and sequence-2 is different from that number. + +See Also:: +.......... + +*note sort:: , stable-sort, + + *note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: remove, Next: remove-duplicates, Prev: merge, Up: Sequences Dictionary + +17.3.22 remove, remove-if, remove-if-not, +----------------------------------------- + +delete, delete-if, delete-if-not +-------------------------------- + + [Function] + + 'remove' item sequence &key from-end test test-not start end count +key => result-sequence + + 'remove-if' test sequence &key from-end start end count key => +result-sequence + + 'remove-if-not' test sequence &key from-end start end count key => +result-sequence + + 'delete' item sequence &key from-end test test-not start end count +key => result-sequence + + 'delete-if' test sequence &key from-end start end count key => +result-sequence + + 'delete-if-not' test sequence &key from-end start end count key => +result-sequence + +Arguments and Values:: +...................... + +item--an object. + + sequence--a proper sequence. + + test--a designator for a function of one argument that returns a +generalized boolean. + + from-end--a generalized boolean. The default is false. + + 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. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + + count--an integer or nil. + + The default is nil. + + key--a designator for a function of one argument, or nil. + + result-sequence--a sequence. + +Description:: +............. + +remove, remove-if, and remove-if-not return a sequence from which the +elements that satisfy the test have been removed. + + delete, delete-if, and delete-if-not are like remove, remove-if, and +remove-if-not respectively, but they may modify sequence. + + If sequence is a vector, the result is a vector that has the same +actual array element type as sequence. The result might or might not be +simple, and might or might not be identical to sequence. If sequence is +a list, the result is a list. + + Supplying a from-end of true matters only when the count is provided; +in that case only the rightmost count elements satisfying the test are +deleted. + + Count, if supplied, limits the number of elements removed or deleted; +if more than count elements satisfy the test, then of these elements +only the leftmost or rightmost, depending on from-end, are deleted or +removed, as many as specified by count. + + If count is supplied and negative, the behavior is as if zero had +been supplied instead. + + If count is nil, all matching items are affected. + + For all these functions, elements not removed or deleted occur in the +same order in the result as they did in sequence. + + remove, remove-if, remove-if-not return a sequence of the same type +as sequence that has the same elements except that those in the +subsequence bounded by start and end and satisfying the test have been +removed. This is a non-destructive operation. If any elements need to +be removed, the result will be a copy. The result of remove may share +with sequence; the result may be identical to the input sequence if no +elements need to be removed. + + delete, delete-if, and delete-if-not return a sequence of the same +type as sequence that has the same elements except that those in the +subsequence bounded by start and end and satisfying the test have been +deleted. Sequence may be destroyed and used to construct the result; +however, the result might or might not be identical to sequence. + + delete, when sequence is a list, is permitted to setf any part, car +or cdr, of the top-level list structure in that sequence. When sequence +is a vector, delete is permitted to change the dimensions of the vector +and to slide its elements into new positions without permuting them to +produce the resulting vector. + + delete-if is constrained to behave exactly as follows: + + (delete nil sequence + :test #'(lambda (ignore item) (funcall test item)) + ...) + +Examples:: +.......... + + (remove 4 '(1 3 4 5 9)) => (1 3 5 9) + (remove 4 '(1 2 4 1 3 4 5)) => (1 2 1 3 5) + (remove 4 '(1 2 4 1 3 4 5) :count 1) => (1 2 1 3 4 5) + (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) => (1 2 4 1 3 5) + (remove 3 '(1 2 4 1 3 4 5) :test #'>) => (4 3 4 5) + (setq lst '(list of four elements)) => (LIST OF FOUR ELEMENTS) + (setq lst2 (copy-seq lst)) => (LIST OF FOUR ELEMENTS) + (setq lst3 (delete 'four lst)) => (LIST OF ELEMENTS) + (equal lst lst2) => false + (remove-if #'oddp '(1 2 4 1 3 4 5)) => (2 4 4) + (remove-if #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) + => (1 2 4 1 3 5) + (remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t) + => (1 2 3 4 5 6 8) + (setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5) + (delete 4 tester) => (1 2 1 3 5) + (setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5) + (delete 4 tester :count 1) => (1 2 1 3 4 5) + (setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5) + (delete 4 tester :count 1 :from-end t) => (1 2 4 1 3 5) + (setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5) + (delete 3 tester :test #'>) => (4 3 4 5) + (setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5) + (delete-if #'oddp tester) => (2 4 4) + (setq tester (list 1 2 4 1 3 4 5)) => (1 2 4 1 3 4 5) + (delete-if #'evenp tester :count 1 :from-end t) => (1 2 4 1 3 5) + (setq tester (list 1 2 3 4 5 6)) => (1 2 3 4 5 6) + (delete-if #'evenp tester) => (1 3 5) + tester => implementation-dependent + + (setq foo (list 'a 'b 'c)) => (A B C) + (setq bar (cdr foo)) => (B C) + (setq foo (delete 'b foo)) => (A C) + bar => ((C)) or ... + (eq (cdr foo) (car bar)) => T or ... + +Side Effects:: +.............. + +For delete, delete-if, and delete-if-not, sequence may be destroyed and +used to construct the result. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. + +See Also:: +.......... + +*note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + The functions delete-if-not and remove-if-not are deprecated. + + +File: gcl.info, Node: remove-duplicates, Prev: remove, Up: Sequences Dictionary + +17.3.23 remove-duplicates, delete-duplicates [Function] +------------------------------------------------------- + +'remove-duplicates' sequence &key from-end test test-not start end key +=> result-sequence + + 'delete-duplicates' sequence &key from-end test test-not start end +key +=> result-sequence + +Arguments and Values:: +...................... + +sequence--a proper sequence. + + from-end--a generalized boolean. The default is false. + + 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. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + + key--a designator for a function of one argument, or nil. + + result-sequence--a sequence. + +Description:: +............. + +remove-duplicates returns a modified copy of sequence from which any +element that matches another element occurring in sequence has been +removed. + + If sequence is a vector, the result is a vector that has the same +actual array element type as sequence. The result might or might not be +simple, and might or might not be identical to sequence. If sequence is +a list, the result is a list. + + delete-duplicates is like remove-duplicates, but delete-duplicates +may modify sequence. + + The elements of sequence are compared pairwise, and if any two match, +then the one occurring earlier in sequence is discarded, unless from-end +is true, in which case the one later in sequence is discarded. + + remove-duplicates and delete-duplicates return a sequence of the same +type as sequence with enough elements removed so that no two of the +remaining elements match. The order of the elements remaining in the +result is the same as the order in which they appear in sequence. + + remove-duplicates returns a sequence that may share with sequence or +may be identical to sequence if no elements need to be removed. + + delete-duplicates, when sequence is a list, is permitted to setf any +part, car or cdr, of the top-level list structure in that sequence. +When sequence is a vector, delete-duplicates is permitted to change the +dimensions of the vector and to slide its elements into new positions +without permuting them to produce the resulting vector. + +Examples:: +.......... + + (remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) => "aBcD" + (remove-duplicates '(a b c b d d e)) => (A C B D E) + (remove-duplicates '(a b c b d d e) :from-end t) => (A B C D E) + (remove-duplicates '((foo #\a) (bar #\%) (baz #\A)) + :test #'char-equal :key #'cadr) => ((BAR #\%) (BAZ #\A)) + (remove-duplicates '((foo #\a) (bar #\%) (baz #\A)) + :test #'char-equal :key #'cadr :from-end t) => ((FOO #\a) (BAR #\%)) + (setq tester (list 0 1 2 3 4 5 6)) + (delete-duplicates tester :key #'oddp :start 1 :end 6) => (0 4 5 6) + +Side Effects:: +.............. + +delete-duplicates might destructively modify sequence. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if sequence is not a proper +sequence. + +See Also:: +.......... + +*note Compiler Terminology::, + + *note Traversal Rules and Side Effects:: + +Notes:: +....... + +The :test-not argument is deprecated. + + These functions are useful for converting sequence into a canonical +form suitable for representing a set. + + +File: gcl.info, Node: Hash Tables, Next: Filenames, Prev: Sequences, Up: Top + +18 Hash Tables +************** + +* Menu: + +* Hash Table Concepts:: +* Hash Tables Dictionary:: + + +File: gcl.info, Node: Hash Table Concepts, Next: Hash Tables Dictionary, Prev: Hash Tables, Up: Hash Tables + +18.1 Hash Table Concepts +======================== + +* Menu: + +* Hash-Table Operations:: +* Modifying Hash Table Keys:: + + +File: gcl.info, Node: Hash-Table Operations, Next: Modifying Hash Table Keys, Prev: Hash Table Concepts, Up: Hash Table Concepts + +18.1.1 Hash-Table Operations +---------------------------- + +Figure 18-1 lists some defined names that are applicable to hash tables. +The following rules apply to hash tables. + +- + A hash table can only associate one value with a given key. If an + attempt is made to add a second value for a given key, the second + value will replace the first. Thus, adding a value to a hash table + is a destructive operation; the hash table is modified. + +- + There are four kinds of hash tables: those whose keys are compared + with eq, those whose keys are compared with eql, those whose keys + are compared with equal, and + + those whose keys are compared with equalp. + +- + Hash tables are created by make-hash-table. gethash is used to + look up a key and find the associated value. New entries are added + to hash tables using setf with gethash. remhash is used to remove + an entry. For example: + + (setq a (make-hash-table)) => # + (setf (gethash 'color a) 'brown) => BROWN + (setf (gethash 'name a) 'fred) => FRED + (gethash 'color a) => BROWN, true + (gethash 'name a) => FRED, true + (gethash 'pointy a) => NIL, false + + In this example, the symbols color and name are being used as keys, + and the symbols brown and fred are being used as the associated + values. The hash table has two items in it, one of which + associates from color to brown, and the other of which associates + from name to fred. + +- + A key or a value may be any object. + +- + The existence of an entry in the hash table can be determined from + the secondary value returned by gethash. + + clrhash hash-table-p remhash + gethash make-hash-table sxhash + hash-table-count maphash + + Figure 18-1: Hash-table defined names + + + +File: gcl.info, Node: Modifying Hash Table Keys, Prev: Hash-Table Operations, Up: Hash Table Concepts + +18.1.2 Modifying Hash Table Keys +-------------------------------- + +The function supplied as the :test argument to make-hash-table specifies +the 'equivalence test' for the hash table it creates. + + An object is 'visibly modified' with regard to an equivalence test if +there exists some set of objects (or potential objects) which are +equivalent to the object before the modification but are no longer +equivalent afterwards. + + If an object O_1 is used as a key in a hash table H and is then +visibly modified with regard to the equivalence test of H, then the +consequences are unspecified if O_1, or any object O_2 equivalent to O_1 +under the equivalence test (either before or after the modification), is +used as a key in further operations on H. The consequences of using O_1 +as a key are unspecified even if O_1 is visibly modified and then later +modified again in such a way as to undo the visible modification. + + Following are specifications of the modifications which are visible +to the equivalence tests which must be supported by hash tables. The +modifications are described in terms of modification of components, and +are defined recursively. Visible modifications of components of the +object are visible modifications of the object. + +* Menu: + +* Visible Modification of Objects with respect to EQ and EQL:: +* Visible Modification of Objects with respect to EQUAL:: +* Visible Modification of Conses with respect to EQUAL:: +* Visible Modification of Bit Vectors and Strings with respect to EQUAL:: +* Visible Modification of Objects with respect to EQUALP:: +* Visible Modification of Structures with respect to EQUALP:: +* Visible Modification of Arrays with respect to EQUALP:: +* Visible Modification of Hash Tables with respect to EQUALP:: +* Visible Modifications by Language Extensions:: + + +File: gcl.info, Node: Visible Modification of Objects with respect to EQ and EQL, Next: Visible Modification of Objects with respect to EQUAL, Prev: Modifying Hash Table Keys, Up: Modifying Hash Table Keys + +18.1.2.1 Visible Modification of Objects with respect to EQ and EQL +................................................................... + +No standardized function is provided that is capable of visibly +modifying an object with regard to eq or eql. + + +File: gcl.info, Node: Visible Modification of Objects with respect to EQUAL, Next: Visible Modification of Conses with respect to EQUAL, Prev: Visible Modification of Objects with respect to EQ and EQL, Up: Modifying Hash Table Keys + +18.1.2.2 Visible Modification of Objects with respect to EQUAL +.............................................................. + +As a consequence of the behavior for equal, the rules for visible +modification of objects not explicitly mentioned in this section are +inherited from those in *note Visible Modification of Objects with +respect to EQ and EQL::. + + +File: gcl.info, Node: Visible Modification of Conses with respect to EQUAL, Next: Visible Modification of Bit Vectors and Strings with respect to EQUAL, Prev: Visible Modification of Objects with respect to EQUAL, Up: Modifying Hash Table Keys + +18.1.2.3 Visible Modification of Conses with respect to EQUAL +............................................................. + +Any visible change to the car or the cdr of a cons is considered a +visible modification with regard to equal. + + +File: gcl.info, Node: Visible Modification of Bit Vectors and Strings with respect to EQUAL, Next: Visible Modification of Objects with respect to EQUALP, Prev: Visible Modification of Conses with respect to EQUAL, Up: Modifying Hash Table Keys + +18.1.2.4 Visible Modification of Bit Vectors and Strings with respect to EQUAL +.............................................................................. + +For a vector of type bit-vector or of type string, any visible change to +an active element of the vector, or to the length of the vector (if it +is actually adjustable or has a fill pointer) is considered a visible +modification with regard to equal. + + +File: gcl.info, Node: Visible Modification of Objects with respect to EQUALP, Next: Visible Modification of Structures with respect to EQUALP, Prev: Visible Modification of Bit Vectors and Strings with respect to EQUAL, Up: Modifying Hash Table Keys + +18.1.2.5 Visible Modification of Objects with respect to EQUALP +............................................................... + +As a consequence of the behavior for equalp, the rules for visible +modification of objects not explicitly mentioned in this section are +inherited from those in *note Visible Modification of Objects with +respect to EQUAL::. + + +File: gcl.info, Node: Visible Modification of Structures with respect to EQUALP, Next: Visible Modification of Arrays with respect to EQUALP, Prev: Visible Modification of Objects with respect to EQUALP, Up: Modifying Hash Table Keys + +18.1.2.6 Visible Modification of Structures with respect to EQUALP +.................................................................. + +Any visible change to a slot of a structure is considered a visible +modification with regard to equalp. + + +File: gcl.info, Node: Visible Modification of Arrays with respect to EQUALP, Next: Visible Modification of Hash Tables with respect to EQUALP, Prev: Visible Modification of Structures with respect to EQUALP, Up: Modifying Hash Table Keys + +18.1.2.7 Visible Modification of Arrays with respect to EQUALP +.............................................................. + +In an array, any visible change to an active element, to the fill +pointer (if the array can and does have one), or to the dimensions (if +the array is actually adjustable) is considered a visible modification +with regard to equalp. + + +File: gcl.info, Node: Visible Modification of Hash Tables with respect to EQUALP, Next: Visible Modifications by Language Extensions, Prev: Visible Modification of Arrays with respect to EQUALP, Up: Modifying Hash Table Keys + +18.1.2.8 Visible Modification of Hash Tables with respect to EQUALP +................................................................... + +In a hash table, any visible change to the count of entries in the hash +table, to the keys, or to the values associated with the keys is +considered a visible modification with regard to equalp. + + Note that the visibility of modifications to the keys depends on the +equivalence test of the hash table, not on the specification of equalp. + + +File: gcl.info, Node: Visible Modifications by Language Extensions, Prev: Visible Modification of Hash Tables with respect to EQUALP, Up: Modifying Hash Table Keys + +18.1.2.9 Visible Modifications by Language Extensions +..................................................... + +Implementations that extend the language by providing additional mutator +functions (or additional behavior for existing mutator functions) must +document how the use of these extensions interacts with equivalence +tests and hash table searches. + + Implementations that extend the language by defining additional +acceptable equivalence tests for hash tables (allowing additional values +for the :test argument to make-hash-table) must document the visible +components of these tests. + + +File: gcl.info, Node: Hash Tables Dictionary, Prev: Hash Table Concepts, Up: Hash Tables + +18.2 Hash Tables Dictionary +=========================== + +* Menu: + +* hash-table:: +* make-hash-table:: +* hash-table-p:: +* hash-table-count:: +* hash-table-rehash-size:: +* hash-table-rehash-threshold:: +* hash-table-size:: +* hash-table-test:: +* gethash:: +* remhash:: +* maphash:: +* with-hash-table-iterator:: +* clrhash:: +* sxhash:: + + +File: gcl.info, Node: hash-table, Next: make-hash-table, Prev: Hash Tables Dictionary, Up: Hash Tables Dictionary + +18.2.1 hash-table [System Class] +-------------------------------- + +Class Precedence List:: +....................... + +hash-table, t + +Description:: +............. + +Hash tables provide a way of mapping any object (a key) to an associated +object (a value). + +See Also:: +.......... + +*note Hash Table Concepts::, *note Printing Other Objects:: + +Notes:: +....... + +The intent is that this mapping be implemented by a hashing mechanism, +such as that described in Section 6.4 "Hashing" of The Art of Computer +Programming, Volume 3 (pp506-549). In spite of this intent, no +conforming implementation is required to use any particular technique to +implement the mapping. + + +File: gcl.info, Node: make-hash-table, Next: hash-table-p, Prev: hash-table, Up: Hash Tables Dictionary + +18.2.2 make-hash-table [Function] +--------------------------------- + +'make-hash-table' &key test size rehash-size rehash-threshold => +hash-table + +Arguments and Values:: +...................... + +test--a designator for one of the functions eq, eql, equal, or + + equalp. + + The default is eql. + + size--a non-negative integer. + + The default is implementation-dependent. + + rehash-size--a real of type (or (integer 1 *) (float (1.0) *)). The +default is implementation-dependent. + + rehash-threshold--a real of type (real 0 1). The default is +implementation-dependent. + + hash-table--a hash table. + +Description:: +............. + +Creates and returns a new hash table. + + test determines how keys are compared. An object is said to be +present in the hash-table if that object is the same under the test as +the key for some entry in the hash-table. + + size is a hint to the implementation about how much initial space to +allocate in the hash-table. + + This information, taken together with the rehash-threshold, controls +the approximate number of entries which it should be possible to insert +before the table has to grow. + + The actual size might be rounded up from size to the next 'good' +size; for example, some implementations might round to the next prime +number. + + rehash-size specifies a minimum amount to increase the size of the +hash-table when it becomes full enough to require rehashing; see +rehash-theshold below. + + If rehash-size is an integer, the expected growth rate for the table +is additive and the integer is the number of entries to add; if it is a +float, the expected growth rate for the table is multiplicative and the +float is the ratio of the new size to the old size. + + As with size, the actual size of the increase might be rounded up. + + rehash-threshold specifies how full the hash-table can get before it +must grow. + + It specifies the maximum desired hash-table occupancy level. + + The values of rehash-size and rehash-threshold do not constrain the +implementation to use any particular method for computing when and by +how much the size of hash-table should be enlarged. Such decisions are +implementation-dependent, and these values only hints from the +programmer to the implementation, and the implementation is permitted to +ignore them. + +Examples:: +.......... + + (setq table (make-hash-table)) => # + (setf (gethash "one" table) 1) => 1 + (gethash "one" table) => NIL, false + (setq table (make-hash-table :test 'equal)) => # + (setf (gethash "one" table) 1) => 1 + (gethash "one" table) => 1, T + (make-hash-table :rehash-size 1.5 :rehash-threshold 0.7) + => # + +See Also:: +.......... + +*note gethash:: , hash-table + + +File: gcl.info, Node: hash-table-p, Next: hash-table-count, Prev: make-hash-table, Up: Hash Tables Dictionary + +18.2.3 hash-table-p [Function] +------------------------------ + +'hash-table-p' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type hash-table; otherwise, returns false. + +Examples:: +.......... + + (setq table (make-hash-table)) => # + (hash-table-p table) => true + (hash-table-p 37) => false + (hash-table-p '((a . 1) (b . 2))) => false + +Notes:: +....... + + (hash-table-p object) == (typep object 'hash-table) + + +File: gcl.info, Node: hash-table-count, Next: hash-table-rehash-size, Prev: hash-table-p, Up: Hash Tables Dictionary + +18.2.4 hash-table-count [Function] +---------------------------------- + +'hash-table-count' hash-table => count + +Arguments and Values:: +...................... + +hash-table--a hash table. + + count--a non-negative integer. + +Description:: +............. + +Returns the number of entries in the hash-table. If hash-table has just +been created or newly cleared (see clrhash) the entry count is 0. + +Examples:: +.......... + + (setq table (make-hash-table)) => # + (hash-table-count table) => 0 + (setf (gethash 57 table) "fifty-seven") => "fifty-seven" + (hash-table-count table) => 1 + (dotimes (i 100) (setf (gethash i table) i)) => NIL + (hash-table-count table) => 100 + +Affected By:: +............. + +clrhash, remhash, setf of gethash + +See Also:: +.......... + +*note hash-table-size:: + +Notes:: +....... + +The following relationships are functionally correct, although in +practice using hash-table-count is probably much faster: + + (hash-table-count table) == + (loop for value being the hash-values of table count t) == + (let ((total 0)) + (maphash #'(lambda (key value) + (declare (ignore key value)) + (incf total)) + table) + total) + + +File: gcl.info, Node: hash-table-rehash-size, Next: hash-table-rehash-threshold, Prev: hash-table-count, Up: Hash Tables Dictionary + +18.2.5 hash-table-rehash-size [Function] +---------------------------------------- + +'hash-table-rehash-size' hash-table => rehash-size + +Arguments and Values:: +...................... + +hash-table--a hash table. + + rehash-size--a real of type (or (integer 1 *) (float (1.0) *)). + +Description:: +............. + +Returns the current rehash size of hash-table, suitable for use in a +call to make-hash-table in order to produce a hash table with state +corresponding to the current state of the hash-table. + +Examples:: +.......... + + (setq table (make-hash-table :size 100 :rehash-size 1.4)) + => # + (hash-table-rehash-size table) => 1.4 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if hash-table is not a hash +table. + +See Also:: +.......... + +*note make-hash-table:: , *note hash-table-rehash-threshold:: + +Notes:: +....... + +If the hash table was created with an integer rehash size, the result is +an integer, indicating that the rate of growth of the hash-table when +rehashed is intended to be additive; otherwise, the result is a float, +indicating that the rate of growth of the hash-table when rehashed is +intended to be multiplicative. However, this value is only advice to +the implementation; the actual amount by which the hash-table will grow +upon rehash is implementation-dependent. + + +File: gcl.info, Node: hash-table-rehash-threshold, Next: hash-table-size, Prev: hash-table-rehash-size, Up: Hash Tables Dictionary + +18.2.6 hash-table-rehash-threshold [Function] +--------------------------------------------- + +'hash-table-rehash-threshold' hash-table => rehash-threshold + +Arguments and Values:: +...................... + +hash-table--a hash table. + + rehash-threshold--a real of type (real 0 1). + +Description:: +............. + +Returns the current rehash threshold of hash-table, which is suitable +for use in a call to make-hash-table in order to produce a hash table +with state corresponding to the current state of the hash-table. + +Examples:: +.......... + + (setq table (make-hash-table :size 100 :rehash-threshold 0.5)) + => # + (hash-table-rehash-threshold table) => 0.5 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if hash-table is not a hash +table. + +See Also:: +.......... + +*note make-hash-table:: , *note hash-table-rehash-size:: + + +File: gcl.info, Node: hash-table-size, Next: hash-table-test, Prev: hash-table-rehash-threshold, Up: Hash Tables Dictionary + +18.2.7 hash-table-size [Function] +--------------------------------- + +'hash-table-size' hash-table => size + +Arguments and Values:: +...................... + +hash-table--a hash table. + + size--a non-negative integer. + +Description:: +............. + +Returns the current size of hash-table, which is suitable for use in a +call to make-hash-table in order to produce a hash table with state +corresponding to the current state of the hash-table. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if hash-table is not a hash +table. + +See Also:: +.......... + +*note hash-table-count:: , *note make-hash-table:: + + +File: gcl.info, Node: hash-table-test, Next: gethash, Prev: hash-table-size, Up: Hash Tables Dictionary + +18.2.8 hash-table-test [Function] +--------------------------------- + +'hash-table-test' hash-table => test + +Arguments and Values:: +...................... + +hash-table--a hash table. + + test--a function designator. For the four standardized hash table +test functions (see make-hash-table), the test value returned is always +a symbol. If an implementation permits additional tests, it is +implementation-dependent whether such tests are returned as function +objects or function names. + +Description:: +............. + +Returns the test used for comparing keys in hash-table. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if hash-table is not a hash +table. + +See Also:: +.......... + +*note make-hash-table:: + + +File: gcl.info, Node: gethash, Next: remhash, Prev: hash-table-test, Up: Hash Tables Dictionary + +18.2.9 gethash [Accessor] +------------------------- + +'gethash' key hash-table &optional default => value, present-p + + (setf (' gethash' key hash-table &optional default) new-value) + +Arguments and Values:: +...................... + +key--an object. + + hash-table--a hash table. + + default--an object. The default is nil. + + value--an object. + + present-p--a generalized boolean. + +Description:: +............. + +Value is the object in hash-table whose key is the same as key under the +hash-table's equivalence test. If there is no such entry, value is the +default. + + Present-p is true if an entry is found; otherwise, it is false. + + setf may be used with gethash to modify the value associated with a +given key, or to add a new entry. + + When a gethash form is used as a setf place, any default which is +supplied is evaluated according to normal left-to-right evaluation +rules, but its value is ignored. + +Examples:: +.......... + + (setq table (make-hash-table)) => # + (gethash 1 table) => NIL, false + (gethash 1 table 2) => 2, false + (setf (gethash 1 table) "one") => "one" + (setf (gethash 2 table "two") "two") => "two" + (gethash 1 table) => "one", true + (gethash 2 table) => "two", true + (gethash nil table) => NIL, false + (setf (gethash nil table) nil) => NIL + (gethash nil table) => NIL, true + (defvar *counters* (make-hash-table)) => *COUNTERS* + (gethash 'foo *counters*) => NIL, false + (gethash 'foo *counters* 0) => 0, false + (defmacro how-many (obj) `(values (gethash ,obj *counters* 0))) => HOW-MANY + (defun count-it (obj) (incf (how-many obj))) => COUNT-IT + (dolist (x '(bar foo foo bar bar baz)) (count-it x)) + (how-many 'foo) => 2 + (how-many 'bar) => 3 + (how-many 'quux) => 0 + +See Also:: +.......... + +*note remhash:: + +Notes:: +....... + +The secondary value, present-p, can be used to distinguish the absence +of an entry from the presence of an entry that has a value of default. + + +File: gcl.info, Node: remhash, Next: maphash, Prev: gethash, Up: Hash Tables Dictionary + +18.2.10 remhash [Function] +-------------------------- + +'remhash' key hash-table => generalized-boolean + +Arguments and Values:: +...................... + +key--an object. + + hash-table--a hash table. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Removes the entry for key in hash-table, if any. Returns true if there +was such an entry, or false otherwise. + +Examples:: +.......... + + (setq table (make-hash-table)) => # + (setf (gethash 100 table) "C") => "C" + (gethash 100 table) => "C", true + (remhash 100 table) => true + (gethash 100 table) => NIL, false + (remhash 100 table) => false + +Side Effects:: +.............. + +The hash-table is modified. + + +File: gcl.info, Node: maphash, Next: with-hash-table-iterator, Prev: remhash, Up: Hash Tables Dictionary + +18.2.11 maphash [Function] +-------------------------- + +'maphash' function hash-table => nil + +Arguments and Values:: +...................... + +function--a designator for a function of two arguments, the key and the +value. + + hash-table--a hash table. + +Description:: +............. + +Iterates over all entries in the hash-table. For each entry, the +function is called with two arguments-the key and the value of that +entry. + + The consequences are unspecified if any attempt is made to add or +remove an entry from the hash-table while a maphash is in progress, with +two exceptions: the function can use can use setf of gethash to change +the value part of the entry currently being processed, or it can use +remhash to remove that entry. + +Examples:: +.......... + + (setq table (make-hash-table)) => # + (dotimes (i 10) (setf (gethash i table) i)) => NIL + (let ((sum-of-squares 0)) + (maphash #'(lambda (key val) + (let ((square (* val val))) + (incf sum-of-squares square) + (setf (gethash key table) square))) + table) + sum-of-squares) => 285 + (hash-table-count table) => 10 + (maphash #'(lambda (key val) + (when (oddp val) (remhash key table))) + table) => NIL + (hash-table-count table) => 5 + (maphash #'(lambda (k v) (print (list k v))) table) + (0 0) + (8 64) + (2 4) + (6 36) + (4 16) + => NIL + +Side Effects:: +.............. + +None, other than any which might be done by the function. + +See Also:: +.......... + +*note loop:: , *note with-hash-table-iterator:: , + + *note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: with-hash-table-iterator, Next: clrhash, Prev: maphash, Up: Hash Tables Dictionary + +18.2.12 with-hash-table-iterator [Macro] +---------------------------------------- + +'with-hash-table-iterator' (name hash-table) {declaration}* {form}* => +{result}* + +Arguments and Values:: +...................... + +name--a name suitable for the first argument to macrolet. + + hash-table--a form, evaluated once, that should produce a hash table. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by forms. + +Description:: +............. + +Within the lexical scope of the body, name is defined via macrolet such +that successive invocations of (name) return the items, one by one, from +the hash table that is obtained by evaluating hash-table only once. + + An invocation (name) returns three values as follows: + +1. + A generalized boolean that is true if an entry is returned. +2. + The key from the hash-table entry. +3. + The value from the hash-table entry. + + After all entries have been returned by successive invocations of +(name), then only one value is returned, namely nil. + + It is unspecified what happens if any of the implicit interior state +of an iteration is returned outside the dynamic extent of the +with-hash-table-iterator form such as by returning some closure over the +invocation form. + + Any number of invocations of with-hash-table-iterator can be nested, +and the body of the innermost one can invoke all of the locally +established macros, provided all of those macros have distinct names. + +Examples:: +.......... + +The following function should return t on any hash table, and signal an +error if the usage of with-hash-table-iterator does not agree with the +corresponding usage of maphash. + + (defun test-hash-table-iterator (hash-table) + (let ((all-entries '()) + (generated-entries '()) + (unique (list nil))) + (maphash #'(lambda (key value) (push (list key value) all-entries)) + hash-table) + (with-hash-table-iterator (generator-fn hash-table) + (loop + (multiple-value-bind (more? key value) (generator-fn) + (unless more? (return)) + (unless (eql value (gethash key hash-table unique)) + (error "Key ~S not found for value ~S" key value)) + (push (list key value) generated-entries)))) + (unless (= (length all-entries) + (length generated-entries) + (length (union all-entries generated-entries + :key #'car :test (hash-table-test hash-table)))) + (error "Generated entries and Maphash entries don't correspond")) + t)) + + The following could be an acceptable definition of maphash, +implemented by with-hash-table-iterator. + + (defun maphash (function hash-table) + (with-hash-table-iterator (next-entry hash-table) + (loop (multiple-value-bind (more key value) (next-entry) + (unless more (return nil)) + (funcall function key value))))) + +Exceptional Situations:: +........................ + +The consequences are undefined if the local function named name +established by with-hash-table-iterator is called after it has returned +false as its primary value. + +See Also:: +.......... + +*note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: clrhash, Next: sxhash, Prev: with-hash-table-iterator, Up: Hash Tables Dictionary + +18.2.13 clrhash [Function] +-------------------------- + +'clrhash' hash-table => hash-table + +Arguments and Values:: +...................... + +hash-table--a hash table. + +Description:: +............. + +Removes all entries from hash-table, and then returns that empty hash +table. + +Examples:: +.......... + + (setq table (make-hash-table)) => # + (dotimes (i 100) (setf (gethash i table) (format nil "~R" i))) => NIL + (hash-table-count table) => 100 + (gethash 57 table) => "fifty-seven", true + (clrhash table) => # + (hash-table-count table) => 0 + (gethash 57 table) => NIL, false + +Side Effects:: +.............. + +The hash-table is modified. + + +File: gcl.info, Node: sxhash, Prev: clrhash, Up: Hash Tables Dictionary + +18.2.14 sxhash [Function] +------------------------- + +'sxhash' object => hash-code + +Arguments and Values:: +...................... + +object--an object. + + hash-code--a non-negative fixnum. + +Description:: +............. + +sxhash returns a hash code for object. + + The manner in which the hash code is computed is +implementation-dependent, but subject to certain constraints: + +1. + (equal x y) implies (= (sxhash x) (sxhash y)). + +2. + For any two objects, x and y, both of which are bit vectors, + characters, conses, numbers, pathnames, strings, or symbols, and + which are similar, (sxhash x) and (sxhash y) yield the same + mathematical value even if x and y exist in different Lisp images + of the same implementation. See *note Literal Objects in Compiled + Files::. + +3. + The hash-code for an object is always the same within a single + session provided that the object is not visibly modified with + regard to the equivalence test equal. See *note Modifying Hash + Table Keys::. + +4. + The hash-code is intended for hashing. This places no verifiable + constraint on a conforming implementation, but the intent is that + an implementation should make a good-faith effort to produce + hash-codes that are well distributed within the range of + non-negative fixnums. + +5. + Computation of the hash-code must terminate, even if the object + contains circularities. + +Examples:: +.......... + + (= (sxhash (list 'list "ab")) (sxhash (list 'list "ab"))) => true + (= (sxhash "a") (sxhash (make-string 1 :initial-element #\a))) => true + (let ((r (make-random-state))) + (= (sxhash r) (sxhash (make-random-state r)))) + => implementation-dependent + +Affected By:: +............. + +The implementation. + +Notes:: +....... + +Many common hashing needs are satisfied by make-hash-table and the +related functions on hash tables. sxhash is intended for use where the +pre-defined abstractions are insufficient. Its main intent is to allow +the user a convenient means of implementing more complicated hashing +paradigms than are provided through hash tables. + + The hash codes returned by sxhash are not necessarily related to any +hashing strategy used by any other function in Common Lisp. + + For objects of types that equal compares with eq, item 3 requires +that the hash-code be based on some immutable quality of the identity of +the object. Another legitimate implementation technique would be to +have sxhash assign (and cache) a random hash code for these objects, +since there is no requirement that similar but non-eq objects have the +same hash code. + + Although similarity is defined for symbols in terms of both the +symbol's name and the packages in which the symbol is accessible, item 3 +disallows using package information to compute the hash code, since +changes to the package status of a symbol are not visible to equal. + + +File: gcl.info, Node: Filenames, Next: Files, Prev: Hash Tables, Up: Top + +19 Filenames +************ + +* Menu: + +* Overview of Filenames:: +* Pathnames:: +* Logical Pathnames:: +* Filenames Dictionary:: + + +File: gcl.info, Node: Overview of Filenames, Next: Pathnames, Prev: Filenames, Up: Filenames + +19.1 Overview of Filenames +========================== + +There are many kinds of file systems, varying widely both in their +superficial syntactic details, and in their underlying power and +structure. The facilities provided by Common Lisp for referring to and +manipulating files has been chosen to be compatible with many kinds of +file systems, while at the same time minimizing the program-visible +differences between kinds of file systems. + + Since file systems vary in their conventions for naming files, there +are two distinct ways to represent filenames: as namestrings and as +pathnames. + +* Menu: + +* Namestrings as Filenames:: +* Pathnames as Filenames:: +* Parsing Namestrings Into Pathnames:: + + +File: gcl.info, Node: Namestrings as Filenames, Next: Pathnames as Filenames, Prev: Overview of Filenames, Up: Overview of Filenames + +19.1.1 Namestrings as Filenames +------------------------------- + +A namestring is a string that represents a filename. + + In general, the syntax of namestrings involves the use of +implementation-defined conventions, usually those customary for the file +system in which the named file resides. The only exception is the +syntax of a logical pathname namestring, which is defined in this +specification; see *note Syntax of Logical Pathname Namestrings::. + + A conforming program must never unconditionally use a literal +namestring other than a logical pathname namestring because Common Lisp +does not define any namestring syntax other than that for logical +pathnames that would be guaranteed to be portable. However, a +conforming program can, if it is careful, successfully manipulate +user-supplied data which contains or refers to non-portable namestrings. + + A namestring can be coerced to a pathname by the functions pathname +or parse-namestring. + + +File: gcl.info, Node: Pathnames as Filenames, Next: Parsing Namestrings Into Pathnames, Prev: Namestrings as Filenames, Up: Overview of Filenames + +19.1.2 Pathnames as Filenames +----------------------------- + +Pathnames are structured objects that can represent, in an +implementation-independent way, the filenames that are used natively by +an underlying file system. + + In addition, pathnames can also represent certain partially composed +filenames for which an underlying file system might not have a specific +namestring representation. + + A pathname need not correspond to any file that actually exists, and +more than one pathname can refer to the same file. For example, the +pathname with a version of :newest might refer to the same file as a +pathname with the same components except a certain number as the +version. Indeed, a pathname with version :newest might refer to +different files as time passes, because the meaning of such a pathname +depends on the state of the file system. + + Some file systems naturally use a structural model for their +filenames, while others do not. Within the Common Lisp pathname model, +all filenames are seen as having a particular structure, even if that +structure is not reflected in the underlying file system. The nature of +the mapping between structure imposed by pathnames and the structure, if +any, that is used by the underlying file system is +implementation-defined. + + Every pathname has six components: a host, a device, a directory, a +name, a type, and a version. By naming files with pathnames, Common +Lisp programs can work in essentially the same way even in file systems +that seem superficially quite different. For a detailed description of +these components, see *note Pathname Components::. + + The mapping of the pathname components into the concepts peculiar to +each file system is implementation-defined. There exist conceivable +pathnames for which there is no mapping to a syntactically valid +filename in a particular implementation. An implementation may use +various strategies in an attempt to find a mapping; for example, an +implementation may quietly truncate filenames that exceed length +limitations imposed by the underlying file system, or ignore certain +pathname components for which the file system provides no support. If +such a mapping cannot be found, an error of type file-error is signaled. + + The time at which this mapping and associated error signaling occurs +is implementation-dependent. Specifically, it may occur at the time the +pathname is constructed, when coercing a pathname to a namestring, or +when an attempt is made to open or otherwise access the file designated +by the pathname. + + Figure 19-1 lists some defined names that are applicable to +pathnames. + + *default-pathname-defaults* namestring pathname-name + directory-namestring open pathname-type + enough-namestring parse-namestring pathname-version + file-namestring pathname pathnamep + file-string-length pathname-device translate-pathname + host-namestring pathname-directory truename + make-pathname pathname-host user-homedir-pathname + merge-pathnames pathname-match-p wild-pathname-p + + Figure 19-1: Pathname Operations + + + +File: gcl.info, Node: Parsing Namestrings Into Pathnames, Prev: Pathnames as Filenames, Up: Overview of Filenames + +19.1.3 Parsing Namestrings Into Pathnames +----------------------------------------- + +Parsing is the operation used to convert a namestring into a pathname. + + Except in the case of parsing logical pathname namestrings, + + this operation is implementation-dependent, because the format of +namestrings is implementation-dependent. + + A conforming implementation is free to accommodate other file system +features in its pathname representation and provides a parser that can +process such specifications in namestrings. Conforming programs must +not depend on any such features, since those features will not be +portable. + + +File: gcl.info, Node: Pathnames, Next: Logical Pathnames, Prev: Overview of Filenames, Up: Filenames + +19.2 Pathnames +============== + +* Menu: + +* Pathname Components:: +* Interpreting Pathname Component Values:: +* Merging Pathnames:: + + +File: gcl.info, Node: Pathname Components, Next: Interpreting Pathname Component Values, Prev: Pathnames, Up: Pathnames + +19.2.1 Pathname Components +-------------------------- + +A pathname has six components: a host, a device, a directory, a name, a +type, and a version. + +* Menu: + +* The Pathname Host Component:: +* The Pathname Device Component:: +* The Pathname Directory Component:: +* The Pathname Name Component:: +* The Pathname Type Component:: +* The Pathname Version Component:: + + +File: gcl.info, Node: The Pathname Host Component, Next: The Pathname Device Component, Prev: Pathname Components, Up: Pathname Components + +19.2.1.1 The Pathname Host Component +.................................... + +The name of the file system on which the file resides, or the name of a +logical host. + + +File: gcl.info, Node: The Pathname Device Component, Next: The Pathname Directory Component, Prev: The Pathname Host Component, Up: Pathname Components + +19.2.1.2 The Pathname Device Component +...................................... + +Corresponds to the "device" or "file structure" concept in many host +file systems: the name of a logical or physical device containing files. + + +File: gcl.info, Node: The Pathname Directory Component, Next: The Pathname Name Component, Prev: The Pathname Device Component, Up: Pathname Components + +19.2.1.3 The Pathname Directory Component +......................................... + +Corresponds to the "directory" concept in many host file systems: the +name of a group of related files. + + +File: gcl.info, Node: The Pathname Name Component, Next: The Pathname Type Component, Prev: The Pathname Directory Component, Up: Pathname Components + +19.2.1.4 The Pathname Name Component +.................................... + +The "name" part of a group of files that can be thought of as +conceptually related. + + +File: gcl.info, Node: The Pathname Type Component, Next: The Pathname Version Component, Prev: The Pathname Name Component, Up: Pathname Components + +19.2.1.5 The Pathname Type Component +.................................... + +Corresponds to the "filetype" or "extension" concept in many host file +systems. This says what kind of file this is. This component is always +a string, nil, :wild, or :unspecific. + + +File: gcl.info, Node: The Pathname Version Component, Prev: The Pathname Type Component, Up: Pathname Components + +19.2.1.6 The Pathname Version Component +....................................... + +Corresponds to the "version number" concept in many host file systems. + + The version is either a positive integer or a symbol from the +following list: nil, :wild, :unspecific, or :newest (refers to the +largest version number that already exists in the file system when +reading a file, or to a version number greater than any already existing +in the file system when writing a new file). Implementations can define +other special version symbols. + + +File: gcl.info, Node: Interpreting Pathname Component Values, Next: Merging Pathnames, Prev: Pathname Components, Up: Pathnames + +19.2.2 Interpreting Pathname Component Values +--------------------------------------------- + +* Menu: + +* Strings in Component Values:: +* Special Characters in Pathname Components:: +* Case in Pathname Components:: +* Local Case in Pathname Components:: +* Common Case in Pathname Components:: +* Special Pathname Component Values:: +* NIL as a Component Value:: +* ->WILD as a Component Value:: +* ->UNSPECIFIC as a Component Value:: +* Relation between component values NIL and ->UNSPECIFIC:: +* Restrictions on Wildcard Pathnames:: +* Restrictions on Examining Pathname Components:: +* Restrictions on Examining a Pathname Host Component:: +* Restrictions on Examining a Pathname Device Component:: +* Restrictions on Examining a Pathname Directory Component:: +* Directory Components in Non-Hierarchical File Systems:: +* Restrictions on Examining a Pathname Name Component:: +* Restrictions on Examining a Pathname Type Component:: +* Restrictions on Examining a Pathname Version Component:: +* Notes about the Pathname Version Component:: +* Restrictions on Constructing Pathnames:: + + +File: gcl.info, Node: Strings in Component Values, Next: Special Characters in Pathname Components, Prev: Interpreting Pathname Component Values, Up: Interpreting Pathname Component Values + +19.2.2.1 Strings in Component Values +.................................... + + +File: gcl.info, Node: Special Characters in Pathname Components, Next: Case in Pathname Components, Prev: Strings in Component Values, Up: Interpreting Pathname Component Values + +19.2.2.2 Special Characters in Pathname Components +.................................................. + +Strings in pathname component values never contain special characters +that represent separation between pathname fields, such as slash in Unix +filenames. Whether separator characters are permitted as part of a +string in a pathname component is implementation-defined; however, if +the implementation does permit it, it must arrange to properly "quote" +the character for the file system when constructing a namestring. For +example, + + ;; In a TOPS-20 implementation, which uses ^V to quote + (NAMESTRING (MAKE-PATHNAME :HOST "OZ" :NAME "")) + => #P"OZ:PS:^V" + NOT=> #P"OZ:PS:" + + +File: gcl.info, Node: Case in Pathname Components, Next: Local Case in Pathname Components, Prev: Special Characters in Pathname Components, Up: Interpreting Pathname Component Values + +19.2.2.3 Case in Pathname Components +.................................... + +Namestrings always use local file system case conventions, but Common +Lisp functions that manipulate pathname components allow the caller to +select either of two conventions for representing case in component +values by supplying a value for the :case keyword argument. Figure 19-2 +lists the functions relating to pathnames that permit a :case argument: + + make-pathname pathname-directory pathname-name + pathname-device pathname-host pathname-type + + Figure 19-2: Pathname functions using a :CASE argument + + + +File: gcl.info, Node: Local Case in Pathname Components, Next: Common Case in Pathname Components, Prev: Case in Pathname Components, Up: Interpreting Pathname Component Values + +19.2.2.4 Local Case in Pathname Components +.......................................... + +For the functions in Figure~19-2, a value of :local for the :case +argument (the default for these functions) indicates that the functions +should receive and yield strings in component values as if they were +already represented according to the host file system's convention for +case. + + If the file system supports both cases, strings given or received as +pathname component values under this protocol are to be used exactly as +written. If the file system only supports one case, the strings will be +translated to that case. + + +File: gcl.info, Node: Common Case in Pathname Components, Next: Special Pathname Component Values, Prev: Local Case in Pathname Components, Up: Interpreting Pathname Component Values + +19.2.2.5 Common Case in Pathname Components +........................................... + +For the functions in Figure~19-2, a value of :common for the :case +argument that these functions should receive and yield strings in +component values according to the following conventions: + +* + All uppercase means to use a file system's customary case. +* + All lowercase means to use the opposite of the customary case. +* + Mixed case represents itself. + + Note that these conventions have been chosen in such a way that +translation from :local to :common and back to :local is +information-preserving. + + +File: gcl.info, Node: Special Pathname Component Values, Next: NIL as a Component Value, Prev: Common Case in Pathname Components, Up: Interpreting Pathname Component Values + +19.2.2.6 Special Pathname Component Values +.......................................... + + +File: gcl.info, Node: NIL as a Component Value, Next: ->WILD as a Component Value, Prev: Special Pathname Component Values, Up: Interpreting Pathname Component Values + +19.2.2.7 NIL as a Component Value +................................. + +As a pathname component value, nil represents that the component is +"unfilled"; see *note Merging Pathnames::. + + The value of any pathname component can be nil. + + When constructing a pathname, nil in the host component might mean a +default host rather than an actual nil in some implementations. + + +File: gcl.info, Node: ->WILD as a Component Value, Next: ->UNSPECIFIC as a Component Value, Prev: NIL as a Component Value, Up: Interpreting Pathname Component Values + +19.2.2.8 :WILD as a Component Value +................................... + +If :wild is the value of a pathname component, that component is +considered to be a wildcard, which matches anything. + + A conforming program must be prepared to encounter a value of :wild +as the value of any pathname component, or as an element of a list that +is the value of the directory component. + + When constructing a pathname, a conforming program may use :wild as +the value of any or all of the directory, name, type, or version +component, but must not use :wild as the value of the host, or device +component. + + If :wild is used as the value of the directory component in the +construction of a pathname, the effect is equivalent to specifying the +list (:absolute :wild-inferiors), or the same as (:absolute :wild) in a +file system that does not support :wild-inferiors. + + +File: gcl.info, Node: ->UNSPECIFIC as a Component Value, Next: Relation between component values NIL and ->UNSPECIFIC, Prev: ->WILD as a Component Value, Up: Interpreting Pathname Component Values + +19.2.2.9 :UNSPECIFIC as a Component Value +......................................... + +If :unspecific is the value of a pathname component, the component is +considered to be "absent" or to "have no meaning" in the filename being +represented by the pathname. + + Whether a value of :unspecific is permitted for any component on any +given file system accessible to the implementation is +implementation-defined. A conforming program must never unconditionally +use a :unspecific as the value of a pathname component because such a +value is not guaranteed to be permissible in all implementations. +However, a conforming program can, if it is careful, successfully +manipulate user-supplied data which contains or refers to non-portable +pathname components. And certainly a conforming program should be +prepared for the possibility that any components of a pathname could be +:unspecific. + + When reading_1 the value of any pathname component, conforming +programs should be prepared for the value to be :unspecific. + + When writing_1 the value of any pathname component, the consequences +are undefined if :unspecific is given for a pathname in a file system +for which it does not make sense. + + +File: gcl.info, Node: Relation between component values NIL and ->UNSPECIFIC, Next: Restrictions on Wildcard Pathnames, Prev: ->UNSPECIFIC as a Component Value, Up: Interpreting Pathname Component Values + +19.2.2.10 Relation between component values NIL and :UNSPECIFIC +............................................................... + +If a pathname is converted to a namestring, the symbols nil and +:unspecific cause the field to be treated as if it were empty. That is, +both nil and :unspecific cause the component not to appear in the +namestring. + + However, when merging a pathname with a set of defaults, only a nil +value for a component will be replaced with the default for that +component, while a value of :unspecific will be left alone as if the +field were "filled"; see the function merge-pathnames and *note Merging +Pathnames::. + + +File: gcl.info, Node: Restrictions on Wildcard Pathnames, Next: Restrictions on Examining Pathname Components, Prev: Relation between component values NIL and ->UNSPECIFIC, Up: Interpreting Pathname Component Values + +19.2.2.11 Restrictions on Wildcard Pathnames +............................................ + +Wildcard pathnames can be used with directory but not with open, and +return true from wild-pathname-p. When examining wildcard components of +a wildcard pathname, conforming programs must be prepared to encounter +any of the following additional values in any component or any element +of a list that is the directory component: + +* + The symbol :wild, which matches anything. + +* + A string containing implementation-dependent special wildcard + characters. + +* + Any object, representing an implementation-dependent wildcard + pattern. + + +File: gcl.info, Node: Restrictions on Examining Pathname Components, Next: Restrictions on Examining a Pathname Host Component, Prev: Restrictions on Wildcard Pathnames, Up: Interpreting Pathname Component Values + +19.2.2.12 Restrictions on Examining Pathname Components +....................................................... + +The space of possible objects that a conforming program must be prepared +to read_1 as the value of a pathname component is substantially larger +than the space of possible objects that a conforming program is +permitted to write_1 into such a component. + + While the values discussed in the subsections of this section, in +*note Special Pathname Component Values::, and in *note Restrictions on +Wildcard Pathnames:: apply to values that might be seen when reading the +component values, substantially more restrictive rules apply to +constructing pathnames; see *note Restrictions on Constructing +Pathnames::. + + When examining pathname components, conforming programs should be +aware of the following restrictions. + + +File: gcl.info, Node: Restrictions on Examining a Pathname Host Component, Next: Restrictions on Examining a Pathname Device Component, Prev: Restrictions on Examining Pathname Components, Up: Interpreting Pathname Component Values + +19.2.2.13 Restrictions on Examining a Pathname Host Component +............................................................. + +It is implementation-dependent what object is used to represent the +host. + + +File: gcl.info, Node: Restrictions on Examining a Pathname Device Component, Next: Restrictions on Examining a Pathname Directory Component, Prev: Restrictions on Examining a Pathname Host Component, Up: Interpreting Pathname Component Values + +19.2.2.14 Restrictions on Examining a Pathname Device Component +............................................................... + +The device might be a string, :wild, :unspecific, or nil. + + Note that :wild might result from an attempt to read_1 the pathname +component, even though portable programs are restricted from writing_1 +such a component value; see *note Restrictions on Wildcard Pathnames:: +and *note Restrictions on Constructing Pathnames::. + + +File: gcl.info, Node: Restrictions on Examining a Pathname Directory Component, Next: Directory Components in Non-Hierarchical File Systems, Prev: Restrictions on Examining a Pathname Device Component, Up: Interpreting Pathname Component Values + +19.2.2.15 Restrictions on Examining a Pathname Directory Component +.................................................................. + +The directory might be a string, :wild, :unspecific, or nil. + + The directory can be a list of strings and symbols. + + The car of the list is one of the symbols :absolute or :relative , +meaning: + +:absolute + A list whose car is the symbol :absolute represents a directory + path starting from the root directory. The list (:absolute) + represents the root directory. The list (:absolute "foo" "bar" + "baz") represents the directory called "/foo/bar/baz" in Unix + (except possibly for case). + +:relative + A list whose car is the symbol :relative represents a directory + path starting from a default directory. The list (:relative) has + the same meaning as nil and hence is not used. The list (:relative + "foo" "bar") represents the directory named "bar" in the directory + named "foo" in the default directory. + + Each remaining element of the list is a string or a symbol. + + Each string names a single level of directory structure. The strings +should contain only the directory names themselves--no punctuation +characters. + + In place of a string, at any point in the list, symbols can occur to +indicate special file notations. Figure 19-3 lists the symbols that +have standard meanings. Implementations are permitted to add additional +objects of any type that is disjoint from string if necessary to +represent features of their file systems that cannot be represented with +the standard strings and symbols. + + Supplying any non-string, including any of the symbols listed below, +to a file system for which it does not make sense signals an error of +type file-error. For example, Unix does not support :wild-inferiors in +most implementations. + + Symbol Meaning + :wild Wildcard match of one level of directory structure + :wild-inferiors Wildcard match of any number of directory levels + :up Go upward in directory structure (semantic) + :back Go upward in directory structure (syntactic) + + Figure 19-3: Special Markers In Directory Component + + + The following notes apply to the previous figure: + +Invalid Combinations + Using :absolute or :wild-inferiors immediately followed by :up or + :back signals an error of type file-error. + +Syntactic vs Semantic + "Syntactic" means that the action of :back depends only on the + pathname and not on the contents of the file system. + + "Semantic" means that the action of :up depends on the contents of + the file system; to resolve a pathname containing :up to a pathname + whose directory component contains only :absolute and strings + requires probing the file system. + + :up differs from :back only in file systems that support multiple + names for directories, perhaps via symbolic links. For example, + suppose that there is a directory (:absolute "X" "Y" "Z") linked to + (:absolute "A" "B" "C") and there also exist directories (:absolute + "A" "B" "Q") and (:absolute "X" "Y" "Q"). Then (:absolute "X" "Y" + "Z" :up "Q") designates (:absolute "A" "B" "Q") while (:absolute + "X" "Y" "Z" :back "Q") designates (:absolute "X" "Y" "Q") + + +File: gcl.info, Node: Directory Components in Non-Hierarchical File Systems, Next: Restrictions on Examining a Pathname Name Component, Prev: Restrictions on Examining a Pathname Directory Component, Up: Interpreting Pathname Component Values + +19.2.2.16 Directory Components in Non-Hierarchical File Systems +............................................................... + +In non-hierarchical file systems, the only valid list values for the +directory component of a pathname are (:absolute string) and (:absolute +:wild). :relative directories and the keywords :wild-inferiors, :up, +and :back are not used in non-hierarchical file systems. + + +File: gcl.info, Node: Restrictions on Examining a Pathname Name Component, Next: Restrictions on Examining a Pathname Type Component, Prev: Directory Components in Non-Hierarchical File Systems, Up: Interpreting Pathname Component Values + +19.2.2.17 Restrictions on Examining a Pathname Name Component +............................................................. + +The name might be a string, :wild, :unspecific, or nil. + + +File: gcl.info, Node: Restrictions on Examining a Pathname Type Component, Next: Restrictions on Examining a Pathname Version Component, Prev: Restrictions on Examining a Pathname Name Component, Up: Interpreting Pathname Component Values + +19.2.2.18 Restrictions on Examining a Pathname Type Component +............................................................. + +The type might be a string, :wild, :unspecific, or nil. + + +File: gcl.info, Node: Restrictions on Examining a Pathname Version Component, Next: Notes about the Pathname Version Component, Prev: Restrictions on Examining a Pathname Type Component, Up: Interpreting Pathname Component Values + +19.2.2.19 Restrictions on Examining a Pathname Version Component +................................................................ + +The version can be any symbol or any integer. + + The symbol :newest refers to the largest version number that already +exists in the file system when reading, overwriting, appending, +superseding, or directory listing an existing file. The symbol :newest +refers to the smallest version number greater than any existing version +number when creating a new file. + + The symbols nil, :unspecific, and :wild have special meanings and +restrictions; see *note Special Pathname Component Values:: and *note +Restrictions on Constructing Pathnames::. + + Other symbols and integers have implementation-defined meaning. + + +File: gcl.info, Node: Notes about the Pathname Version Component, Next: Restrictions on Constructing Pathnames, Prev: Restrictions on Examining a Pathname Version Component, Up: Interpreting Pathname Component Values + +19.2.2.20 Notes about the Pathname Version Component +.................................................... + +It is suggested, but not required, that implementations do the +following: + +* + Use positive integers starting at 1 as version numbers. + +* + Recognize the symbol :oldest to designate the smallest existing + version number. + +* + Use keywords for other special versions. + + +File: gcl.info, Node: Restrictions on Constructing Pathnames, Prev: Notes about the Pathname Version Component, Up: Interpreting Pathname Component Values + +19.2.2.21 Restrictions on Constructing Pathnames +................................................ + +When constructing a pathname from components, conforming programs must +follow these rules: + +* + Any component can be nil. nil in the host might mean a default + host rather than an actual nil in some implementations. + +* + The host, device, directory, name, and type can be strings. There + are implementation-dependent limits on the number and type of + characters in these strings. + +* + The directory can be a list of strings and symbols. There are + implementation-dependent limits on the list's length and contents. + +* + The version can be :newest. + +* + Any component can be taken from the corresponding component of + another pathname. When the two pathnames are for different file + systems (in implementations that support multiple file systems), an + appropriate translation occurs. If no meaningful translation is + possible, an error is signaled. The definitions of "appropriate" + and "meaningful" are implementation-dependent. + +* + An implementation might support other values for some components, + but a portable program cannot use those values. A conforming + program can use implementation-dependent values but this can make + it non-portable; for example, it might work only with Unix file + systems. + + +File: gcl.info, Node: Merging Pathnames, Prev: Interpreting Pathname Component Values, Up: Pathnames + +19.2.3 Merging Pathnames +------------------------ + +Merging takes a pathname with unfilled components and supplies values +for those components from a source of defaults. + + If a component's value is nil, that component is considered to be +unfilled. If a component's value is any non-nil object, including +:unspecific, that component is considered to be filled. + + Except as explicitly specified otherwise, for functions that +manipulate or inquire about files in the file system, the pathname +argument to such a function is merged with *default-pathname-defaults* +before accessing the file system (as if by merge-pathnames). + +* Menu: + +* Examples of Merging Pathnames:: + + +File: gcl.info, Node: Examples of Merging Pathnames, Prev: Merging Pathnames, Up: Merging Pathnames + +19.2.3.1 Examples of Merging Pathnames +...................................... + +Although the following examples are possible to execute only in +implementations which permit :unspecific in the indicated position +andwhich permit four-letter type components, they serve to illustrate +the basic concept of pathname merging. + + (pathname-type + (merge-pathnames (make-pathname :type "LISP") + (make-pathname :type "TEXT"))) + => "LISP" + + (pathname-type + (merge-pathnames (make-pathname :type nil) + (make-pathname :type "LISP"))) + => "LISP" + + (pathname-type + (merge-pathnames (make-pathname :type :unspecific) + (make-pathname :type "LISP"))) + => :UNSPECIFIC + + +File: gcl.info, Node: Logical Pathnames, Next: Filenames Dictionary, Prev: Pathnames, Up: Filenames + +19.3 Logical Pathnames +====================== + +* Menu: + +* Syntax of Logical Pathname Namestrings:: +* Logical Pathname Components:: + + +File: gcl.info, Node: Syntax of Logical Pathname Namestrings, Next: Logical Pathname Components, Prev: Logical Pathnames, Up: Logical Pathnames + +19.3.1 Syntax of Logical Pathname Namestrings +--------------------------------------------- + +The syntax of a logical pathname namestring is as follows. (Note that +unlike many notational descriptions in this document, this is a +syntactic description of character sequences, not a structural +description of objects.) + + logical-pathname ::=[!host host-marker] + [!relative-directory-marker] {!directory directory-marker}* + [!name] [type-marker !type [version-marker !version]] + + host ::=!word + + directory ::=!word | !wildcard-word | !wild-inferiors-word + + name ::=!word | !wildcard-word + + type ::=!word | !wildcard-word + + version ::=!pos-int | newest-word | wildcard-version + + host-marker--a colon. + + relative-directory-marker--a semicolon. + + directory-marker--a semicolon. + + type-marker--a dot. + + version-marker--a dot. + + wild-inferiors-word--The two character sequence "**" (two asterisks). + + newest-word--The six character sequence "newest" or the six character +sequence "NEWEST". + + wildcard-version--an asterisk. + + wildcard-word--one or more asterisks, uppercase letters, digits, and +hyphens, including at least one asterisk, with no two asterisks +adjacent. + + word--one or more uppercase letters, digits, and hyphens. + + pos-int--a positive integer. + +* Menu: + +* Additional Information about Parsing Logical Pathname Namestrings:: +* The Host part of a Logical Pathname Namestring:: +* The Device part of a Logical Pathname Namestring:: +* The Directory part of a Logical Pathname Namestring:: +* The Type part of a Logical Pathname Namestring:: +* The Version part of a Logical Pathname Namestring:: +* Wildcard Words in a Logical Pathname Namestring:: +* Lowercase Letters in a Logical Pathname Namestring:: +* Other Syntax in a Logical Pathname Namestring:: + + +File: gcl.info, Node: Additional Information about Parsing Logical Pathname Namestrings, Next: The Host part of a Logical Pathname Namestring, Prev: Syntax of Logical Pathname Namestrings, Up: Syntax of Logical Pathname Namestrings + +19.3.1.1 Additional Information about Parsing Logical Pathname Namestrings +.......................................................................... + + +File: gcl.info, Node: The Host part of a Logical Pathname Namestring, Next: The Device part of a Logical Pathname Namestring, Prev: Additional Information about Parsing Logical Pathname Namestrings, Up: Syntax of Logical Pathname Namestrings + +19.3.1.2 The Host part of a Logical Pathname Namestring +....................................................... + +The host must have been defined as a logical pathname host; this can be +done by using setf of logical-pathname-translations. + + The logical pathname host name "SYS" is reserved for the +implementation. The existence and meaning of SYS: logical pathnames is +implementation-defined. + + +File: gcl.info, Node: The Device part of a Logical Pathname Namestring, Next: The Directory part of a Logical Pathname Namestring, Prev: The Host part of a Logical Pathname Namestring, Up: Syntax of Logical Pathname Namestrings + +19.3.1.3 The Device part of a Logical Pathname Namestring +......................................................... + +There is no syntax for a logical pathname device since the device +component of a logical pathname is always :unspecific; see *note +Unspecific Components of a Logical Pathname::. + + +File: gcl.info, Node: The Directory part of a Logical Pathname Namestring, Next: The Type part of a Logical Pathname Namestring, Prev: The Device part of a Logical Pathname Namestring, Up: Syntax of Logical Pathname Namestrings + +19.3.1.4 The Directory part of a Logical Pathname Namestring +............................................................ + +If a relative-directory-marker precedes the directories, the directory +component parsed is as relative; otherwise, the directory component is +parsed as absolute. + + If a wild-inferiors-marker is specified, it parses into +:wild-inferiors. + + +File: gcl.info, Node: The Type part of a Logical Pathname Namestring, Next: The Version part of a Logical Pathname Namestring, Prev: The Directory part of a Logical Pathname Namestring, Up: Syntax of Logical Pathname Namestrings + +19.3.1.5 The Type part of a Logical Pathname Namestring +....................................................... + +The type of a logical pathname for a source file is "LISP". This should +be translated into whatever type is appropriate in a physical pathname. + + +File: gcl.info, Node: The Version part of a Logical Pathname Namestring, Next: Wildcard Words in a Logical Pathname Namestring, Prev: The Type part of a Logical Pathname Namestring, Up: Syntax of Logical Pathname Namestrings + +19.3.1.6 The Version part of a Logical Pathname Namestring +.......................................................... + +Some file systems do not have versions. Logical pathname translation to +such a file system ignores the version. This implies that a program +cannot rely on being able to store more than one version of a file named +by a logical pathname. + + If a wildcard-version is specified, it parses into :wild. + + +File: gcl.info, Node: Wildcard Words in a Logical Pathname Namestring, Next: Lowercase Letters in a Logical Pathname Namestring, Prev: The Version part of a Logical Pathname Namestring, Up: Syntax of Logical Pathname Namestrings + +19.3.1.7 Wildcard Words in a Logical Pathname Namestring +........................................................ + +Each asterisk in a wildcard-word matches a sequence of zero or more +characters. The wildcard-word "*" parses into :wild; other +wildcard-words parse into strings. + + +File: gcl.info, Node: Lowercase Letters in a Logical Pathname Namestring, Next: Other Syntax in a Logical Pathname Namestring, Prev: Wildcard Words in a Logical Pathname Namestring, Up: Syntax of Logical Pathname Namestrings + +19.3.1.8 Lowercase Letters in a Logical Pathname Namestring +........................................................... + +When parsing words and wildcard-words, lowercase letters are translated +to uppercase. + + +File: gcl.info, Node: Other Syntax in a Logical Pathname Namestring, Prev: Lowercase Letters in a Logical Pathname Namestring, Up: Syntax of Logical Pathname Namestrings + +19.3.1.9 Other Syntax in a Logical Pathname Namestring +...................................................... + +The consequences of using characters other than those specified here in +a logical pathname namestring are unspecified. + + The consequences of using any value not specified here as a logical +pathname component are unspecified. + + +File: gcl.info, Node: Logical Pathname Components, Prev: Syntax of Logical Pathname Namestrings, Up: Logical Pathnames + +19.3.2 Logical Pathname Components +---------------------------------- + +* Menu: + +* Unspecific Components of a Logical Pathname:: +* Null Strings as Components of a Logical Pathname:: + + +File: gcl.info, Node: Unspecific Components of a Logical Pathname, Next: Null Strings as Components of a Logical Pathname, Prev: Logical Pathname Components, Up: Logical Pathname Components + +19.3.2.1 Unspecific Components of a Logical Pathname +.................................................... + +The device component of a logical pathname is always :unspecific; no +other component of a logical pathname can be :unspecific. + + +File: gcl.info, Node: Null Strings as Components of a Logical Pathname, Prev: Unspecific Components of a Logical Pathname, Up: Logical Pathname Components + +19.3.2.2 Null Strings as Components of a Logical Pathname +......................................................... + +The null string, "", is not a valid value for any component of a logical +pathname. + + +File: gcl.info, Node: Filenames Dictionary, Prev: Logical Pathnames, Up: Filenames + +19.4 Filenames Dictionary +========================= + +* Menu: + +* pathname (System Class):: +* logical-pathname (System Class):: +* pathname:: +* make-pathname:: +* pathnamep:: +* pathname-host:: +* load-logical-pathname-translations:: +* logical-pathname-translations:: +* logical-pathname:: +* *default-pathname-defaults*:: +* namestring:: +* parse-namestring:: +* wild-pathname-p:: +* pathname-match-p:: +* translate-logical-pathname:: +* translate-pathname:: +* merge-pathnames:: + + +File: gcl.info, Node: pathname (System Class), Next: logical-pathname (System Class), Prev: Filenames Dictionary, Up: Filenames Dictionary + +19.4.1 pathname [System Class] +------------------------------ + +Class Precedence List:: +....................... + +pathname, t + +Description:: +............. + +A pathname is a structured object which represents a filename. + + There are two kinds of pathnames--physical pathnames and logical +pathnames. + + +File: gcl.info, Node: logical-pathname (System Class), Next: pathname, Prev: pathname (System Class), Up: Filenames Dictionary + +19.4.2 logical-pathname [System Class] +-------------------------------------- + +Class Precedence List:: +....................... + +logical-pathname, pathname, t + +Description:: +............. + +A pathname that uses a namestring syntax that is +implementation-independent, and that has component values that are +implementation-independent. Logical pathnames do not refer directly to +filenames + +See Also:: +.......... + +*note File System Concepts::, *note Sharpsign P::, *note Printing +Pathnames:: + + +File: gcl.info, Node: pathname, Next: make-pathname, Prev: logical-pathname (System Class), Up: Filenames Dictionary + +19.4.3 pathname [Function] +-------------------------- + +'pathname' pathspec => pathname + +Arguments and Values:: +...................... + +pathspec--a pathname designator. + + pathname--a pathname. + +Description:: +............. + +Returns the pathname denoted by pathspec. + + If the pathspec designator is a stream, the stream can be either open +or closed; in both cases, the pathname returned corresponds to the +filename used to open the file. pathname returns the same pathname for +a file stream after it is closed as it did when it was open. + + If the pathspec designator is a file stream created by opening a +logical pathname, a logical pathname is returned. + +Examples:: +.......... + + ;; There is a great degree of variability permitted here. The next + ;; several examples are intended to illustrate just a few of the many + ;; possibilities. Whether the name is canonicalized to a particular + ;; case (either upper or lower) depends on both the file system and the + ;; implementation since two different implementations using the same + ;; file system might differ on many issues. How information is stored + ;; internally (and possibly presented in #S notation) might vary, + ;; possibly requiring `accessors' such as PATHNAME-NAME to perform case + ;; conversion upon access. The format of a namestring is dependent both + ;; on the file system and the implementation since, for example, one + ;; implementation might include the host name in a namestring, and + ;; another might not. #S notation would generally only be used in a + ;; situation where no appropriate namestring could be constructed for use + ;; with #P. + (setq p1 (pathname "test")) + => #P"CHOCOLATE:TEST" ; with case canonicalization (e.g., VMS) + OR=> #P"VANILLA:test" ; without case canonicalization (e.g., Unix) + OR=> #P"test" + OR=> #S(PATHNAME :HOST "STRAWBERRY" :NAME "TEST") + OR=> #S(PATHNAME :HOST "BELGIAN-CHOCOLATE" :NAME "test") + (setq p2 (pathname "test")) + => #P"CHOCOLATE:TEST" + OR=> #P"VANILLA:test" + OR=> #P"test" + OR=> #S(PATHNAME :HOST "STRAWBERRY" :NAME "TEST") + OR=> #S(PATHNAME :HOST "BELGIAN-CHOCOLATE" :NAME "test") + (pathnamep p1) => true + (eq p1 (pathname p1)) => true + (eq p1 p2) + => true + OR=> false + (with-open-file (stream "test" :direction :output) + (pathname stream)) + => #P"ORANGE-CHOCOLATE:>Gus>test.lisp.newest" + +See Also:: +.......... + +pathname, logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: make-pathname, Next: pathnamep, Prev: pathname, Up: Filenames Dictionary + +19.4.4 make-pathname [Function] +------------------------------- + +'make-pathname' &key host device directory name type version defaults +case +=> pathname + +Arguments and Values:: +...................... + +host--a valid physical pathname host. Complicated defaulting behavior; +see below. + + device--a valid pathname device. Complicated defaulting behavior; +see below. + + directory--a valid pathname directory. Complicated defaulting +behavior; see below. + + name--a valid pathname name. Complicated defaulting behavior; see +below. + + type--a valid pathname type. Complicated defaulting behavior; see +below. + + version--a valid pathname version. Complicated defaulting behavior; +see below. + + defaults--a pathname designator. The default is a pathname whose +host component is the same as the host component of the value of +*default-pathname-defaults*, and whose other components are all nil. + + case--one of :common or :local. The default is :local. + + pathname--a pathname. + +Description:: +............. + +Constructs and returns a pathname from the supplied keyword arguments. + + After the components supplied explicitly by host, device, directory, +name, type, and version are filled in, the merging rules used by +merge-pathnames are used to fill in any unsupplied components from the +defaults supplied by defaults. + + Whenever a pathname is constructed the components may be +canonicalized if appropriate. For the explanation of the arguments that +can be supplied for each component, see *note Pathname Components::. + + If case is supplied, it is treated as described in *note Case in +Pathname Components::. + + The resulting pathname is a logical pathname if and only its host +component is a logical host or a string that names a defined logical +host. + + If the directory is a string, it should be the name of a top level +directory, and should not contain any punctuation characters; that is, +specifying a string, str, is equivalent to specifying the list +(:absolute str). Specifying the symbol :wild is equivalent to +specifying the list (:absolute :wild-inferiors), or (:absolute :wild) in +a file system that does not support :wild-inferiors. + +Examples:: +.......... + + ;; Implementation A -- an implementation with access to a single + ;; Unix file system. This implementation happens to never display + ;; the `host' information in a namestring, since there is only one host. + (make-pathname :directory '(:absolute "public" "games") + :name "chess" :type "db") + => #P"/public/games/chess.db" + + ;; Implementation B -- an implementation with access to one or more + ;; VMS file systems. This implementation displays `host' information + ;; in the namestring only when the host is not the local host. + ;; It uses a double colon to separate a host name from the host's local + ;; file name. + (make-pathname :directory '(:absolute "PUBLIC" "GAMES") + :name "CHESS" :type "DB") + => #P"SYS$DISK:[PUBLIC.GAMES]CHESS.DB" + (make-pathname :host "BOBBY" + :directory '(:absolute "PUBLIC" "GAMES") + :name "CHESS" :type "DB") + => #P"BOBBY::SYS$DISK:[PUBLIC.GAMES]CHESS.DB" + + ;; Implementation C -- an implementation with simultaneous access to + ;; multiple file systems from the same Lisp image. In this + ;; implementation, there is a convention that any text preceding the + ;; first colon in a pathname namestring is a host name. + (dolist (case '(:common :local)) + (dolist (host '("MY-LISPM" "MY-VAX" "MY-UNIX")) + (print (make-pathname :host host :case case + :directory '(:absolute "PUBLIC" "GAMES") + :name "CHESS" :type "DB")))) + |> #P"MY-LISPM:>public>games>chess.db" + |> #P"MY-VAX:SYS$DISK:[PUBLIC.GAMES]CHESS.DB" + |> #P"MY-UNIX:/public/games/chess.db" + |> #P"MY-LISPM:>public>games>chess.db" + |> #P"MY-VAX:SYS$DISK:[PUBLIC.GAMES]CHESS.DB" + |> #P"MY-UNIX:/PUBLIC/GAMES/CHESS.DB" + => NIL + +Affected By:: +............. + +The file system. + +See Also:: +.......... + +*note merge-pathnames:: , pathname, logical-pathname, *note File System +Concepts::, + + *note Pathnames as Filenames:: + +Notes:: +....... + +Portable programs should not supply :unspecific for any component. See +*note ->UNSPECIFIC as a Component Value::. + + +File: gcl.info, Node: pathnamep, Next: pathname-host, Prev: make-pathname, Up: Filenames Dictionary + +19.4.5 pathnamep [Function] +--------------------------- + +'pathnamep' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type pathname; otherwise, returns false. + +Examples:: +.......... + + (setq q "test") => "test" + (pathnamep q) => false + (setq q (pathname "test")) + => #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test" :TYPE NIL + :VERSION NIL) + (pathnamep q) => true + (setq q (logical-pathname "SYS:SITE;FOO.SYSTEM")) + => #P"SYS:SITE;FOO.SYSTEM" + (pathnamep q) => true + +Notes:: +....... + + (pathnamep object) == (typep object 'pathname) + + +File: gcl.info, Node: pathname-host, Next: load-logical-pathname-translations, Prev: pathnamep, Up: Filenames Dictionary + +19.4.6 pathname-host, pathname-device, pathname-directory, +---------------------------------------------------------- + +pathname-name, pathname-type, pathname-version +---------------------------------------------- + + [Function] + + 'pathname-host' pathname &key case => host + + 'pathname-device' pathname &key case => device + + 'pathname-directory' pathname &key case => directory + + 'pathname-name' pathname &key case => name + + 'pathname-type' pathname &key case => type + + 'pathname-version' pathname => version + +Arguments and Values:: +...................... + +pathname--a pathname designator. + + case--one of :local or :common. The default is :local. + + host--a valid pathname host. + + device--a valid pathname device. + + directory--a valid pathname directory. + + name--a valid pathname name. + + type--a valid pathname type. + + version--a valid pathname version. + +Description:: +............. + +These functions return the components of pathname. + + If the pathname designator is a pathname, it represents the name used +to open the file. This may be, but is not required to be, the actual +name of the file. + + If case is supplied, it is treated as described in *note Case in +Pathname Components::. + +Examples:: +.......... + + (setq q (make-pathname :host "KATHY" + :directory "CHAPMAN" + :name "LOGIN" :type "COM")) + => #P"KATHY::[CHAPMAN]LOGIN.COM" + (pathname-host q) => "KATHY" + (pathname-name q) => "LOGIN" + (pathname-type q) => "COM" + + ;; Because namestrings are used, the results shown in the remaining + ;; examples are not necessarily the only possible results. Mappings + ;; from namestring representation to pathname representation are + ;; dependent both on the file system involved and on the implementation + ;; (since there may be several implementations which can manipulate the + ;; the same file system, and those implementations are not constrained + ;; to agree on all details). Consult the documentation for each + ;; implementation for specific information on how namestrings are treated + ;; that implementation. + + ;; VMS + (pathname-directory (parse-namestring "[FOO.*.BAR]BAZ.LSP")) + => (:ABSOLUTE "FOO" "BAR") + (pathname-directory (parse-namestring "[FOO.*.BAR]BAZ.LSP") :case :common) + => (:ABSOLUTE "FOO" "BAR") + + ;; Unix + (pathname-directory "foo.l") => NIL + (pathname-device "foo.l") => :UNSPECIFIC + (pathname-name "foo.l") => "foo" + (pathname-name "foo.l" :case :local) => "foo" + (pathname-name "foo.l" :case :common) => "FOO" + (pathname-type "foo.l") => "l" + (pathname-type "foo.l" :case :local) => "l" + (pathname-type "foo.l" :case :common) => "L" + (pathname-type "foo") => :UNSPECIFIC + (pathname-type "foo" :case :common) => :UNSPECIFIC + (pathname-type "foo.") => "" + (pathname-type "foo." :case :common) => "" + (pathname-directory (parse-namestring "/foo/bar/baz.lisp") :case :local) + => (:ABSOLUTE "foo" "bar") + (pathname-directory (parse-namestring "/foo/bar/baz.lisp") :case :local) + => (:ABSOLUTE "FOO" "BAR") + (pathname-directory (parse-namestring "../baz.lisp")) + => (:RELATIVE :UP) + (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/BAR/../Mum/baz")) + => (:ABSOLUTE "foo" "BAR" :UP "Mum") + (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/BAR/../Mum/baz") :case :common) + => (:ABSOLUTE "FOO" "bar" :UP "Mum") + (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/*/bar/baz.l")) + => (:ABSOLUTE "foo" :WILD "bar") + (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/*/bar/baz.l") :case :common) + => (:ABSOLUTE "FOO" :WILD "BAR") + + ;; Symbolics LMFS + (pathname-directory (parse-namestring ">foo>**>bar>baz.lisp")) + => (:ABSOLUTE "foo" :WILD-INFERIORS "bar") + (pathname-directory (parse-namestring ">foo>*>bar>baz.lisp")) + => (:ABSOLUTE "foo" :WILD "bar") + (pathname-directory (parse-namestring ">foo>*>bar>baz.lisp") :case :common) + => (:ABSOLUTE "FOO" :WILD "BAR") + (pathname-device (parse-namestring ">foo>baz.lisp")) => :UNSPECIFIC + +Affected By:: +............. + +The implementation and the host file system. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if its first argument is not a +pathname. + +See Also:: +.......... + +pathname, logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: load-logical-pathname-translations, Next: logical-pathname-translations, Prev: pathname-host, Up: Filenames Dictionary + +19.4.7 load-logical-pathname-translations [Function] +---------------------------------------------------- + +'load-logical-pathname-translations' host => just-loaded + +Arguments and Values:: +...................... + +host--a string. + + just-loaded--a generalized boolean. + +Description:: +............. + +Searches for and loads the definition of a logical host named host, if +it is not already defined. The specific nature of the search is +implementation-defined. + + If the host is already defined, no attempt to find or load a +definition is attempted, and false is returned. If the host is not +already defined, but a definition is successfully found and loaded, true +is returned. Otherwise, an error is signaled. + +Examples:: +.......... + + (translate-logical-pathname "hacks:weather;barometer.lisp.newest") + |> Error: The logical host HACKS is not defined. + (load-logical-pathname-translations "HACKS") + |> ;; Loading SYS:SITE;HACKS.TRANSLATIONS + |> ;; Loading done. + => true + (translate-logical-pathname "hacks:weather;barometer.lisp.newest") + => #P"HELIUM:[SHARED.HACKS.WEATHER]BAROMETER.LSP;0" + (load-logical-pathname-translations "HACKS") + => false + +Exceptional Situations:: +........................ + +If no definition is found, an error of type error is signaled. + +See Also:: +.......... + +logical-pathname + +Notes:: +....... + +Logical pathname definitions will be created not just by implementors +but also by programmers. As such, it is important that the search +strategy be documented. For example, an implementation might define +that the definition of a host is to be found in a file called +"host.translations" in some specifically named directory. + + +File: gcl.info, Node: logical-pathname-translations, Next: logical-pathname, Prev: load-logical-pathname-translations, Up: Filenames Dictionary + +19.4.8 logical-pathname-translations [Accessor] +----------------------------------------------- + +'logical-pathname-translations' host => translations + + (setf (' logical-pathname-translations' host) new-translations) + +Arguments and Values:: +...................... + +host-a logical host designator. + + translations, new-translations--a list. + +Description:: +............. + +Returns the host's list of translations. Each translation is a list of +at least two elements: from-wildcard and to-wildcard. Any additional +elements are implementation-defined. From-wildcard is a logical +pathname whose host is host. To-wildcard is a pathname. + + [Reviewer Note by Laddaga: Can this be a logical pathname?] + + (setf (logical-pathname-translations host) translations) sets a +logical pathname host's list of translations. If host is a string that +has not been previously used as a logical pathname host, a new logical +pathname host is defined; otherwise an existing host's translations are +replaced. logical pathname host names are compared with string-equal. + + When setting the translations list, each from-wildcard can be a +logical pathname whose host is host or a logical pathname namestring +parseable by (parse-namestring string host), where host represents the +appropriate object as defined by parse-namestring. Each to-wildcard can +be anything coercible to a pathname by (pathname to-wildcard). If +to-wildcard coerces to a logical pathname, translate-logical-pathname +will perform repeated translation steps when it uses it. + + host is either the host component of a logical pathname or a string +that has been defined as a logical pathname host name by setf of +logical-pathname-translations. + +Examples:: +.......... + +[Reviewer Note by Laddaga: Shouldn't there be some *.*'s in the list of +translations for PROG below?] + + ;;;A very simple example of setting up a logical pathname host. No + ;;;translations are necessary to get around file system restrictions, so + ;;;all that is necessary is to specify the root of the physical directory + ;;;tree that contains the logical file system. + ;;;The namestring syntax on the right-hand side is implementation-dependent. + (setf (logical-pathname-translations "foo") + '(("**;*.*.*" "MY-LISPM:>library>foo>**>"))) + + ;;;Sample use of that logical pathname. The return value + ;;;is implementation-dependent. + (translate-logical-pathname "foo:bar;baz;mum.quux.3") + => #P"MY-LISPM:>library>foo>bar>baz>mum.quux.3" + + ;;;A more complex example, dividing the files among two file servers + ;;;and several different directories. This Unix doesn't support + ;;;:WILD-INFERIORS in the directory, so each directory level must + ;;;be translated individually. No file name or type translations + ;;;are required except for .MAIL to .MBX. + ;;;The namestring syntax on the right-hand side is implementation-dependent. + (setf (logical-pathname-translations "prog") + '(("RELEASED;*.*.*" "MY-UNIX:/sys/bin/my-prog/") + ("RELEASED;*;*.*.*" "MY-UNIX:/sys/bin/my-prog/*/") + ("EXPERIMENTAL;*.*.*" "MY-UNIX:/usr/Joe/development/prog/") + ("EXPERIMENTAL;DOCUMENTATION;*.*.*" + "MY-VAX:SYS$DISK:[JOE.DOC]") + ("EXPERIMENTAL;*;*.*.*" "MY-UNIX:/usr/Joe/development/prog/*/") + ("MAIL;**;*.MAIL" "MY-VAX:SYS$DISK:[JOE.MAIL.PROG...]*.MBX"))) + + ;;;Sample use of that logical pathname. The return value + ;;;is implementation-dependent. + (translate-logical-pathname "prog:mail;save;ideas.mail.3") + => #P"MY-VAX:SYS$DISK:[JOE.MAIL.PROG.SAVE]IDEAS.MBX.3" + + ;;;Example translations for a program that uses three files main.lisp, + ;;;auxiliary.lisp, and documentation.lisp. These translations might be + ;;;supplied by a software supplier as examples. + + ;;;For Unix with long file names + (setf (logical-pathname-translations "prog") + '(("CODE;*.*.*" "/lib/prog/"))) + + ;;;Sample use of that logical pathname. The return value + ;;;is implementation-dependent. + (translate-logical-pathname "prog:code;documentation.lisp") + => #P"/lib/prog/documentation.lisp" + + ;;;For Unix with 14-character file names, using .lisp as the type + (setf (logical-pathname-translations "prog") + '(("CODE;DOCUMENTATION.*.*" "/lib/prog/docum.*") + ("CODE;*.*.*" "/lib/prog/"))) + + ;;;Sample use of that logical pathname. The return value + ;;;is implementation-dependent. + (translate-logical-pathname "prog:code;documentation.lisp") + => #P"/lib/prog/docum.lisp" + + ;;;For Unix with 14-character file names, using .l as the type + ;;;The second translation shortens the compiled file type to .b + (setf (logical-pathname-translations "prog") + `(("**;*.LISP.*" ,(logical-pathname "PROG:**;*.L.*")) + (,(compile-file-pathname (logical-pathname "PROG:**;*.LISP.*")) + ,(logical-pathname "PROG:**;*.B.*")) + ("CODE;DOCUMENTATION.*.*" "/lib/prog/documentatio.*") + ("CODE;*.*.*" "/lib/prog/"))) + + ;;;Sample use of that logical pathname. The return value + ;;;is implementation-dependent. + (translate-logical-pathname "prog:code;documentation.lisp") + => #P"/lib/prog/documentatio.l" + + ;;;For a Cray with 6 character names and no directories, types, or versions. + (setf (logical-pathname-translations "prog") + (let ((l '(("MAIN" "PGMN") + ("AUXILIARY" "PGAUX") + ("DOCUMENTATION" "PGDOC"))) + (logpath (logical-pathname "prog:code;")) + (phypath (pathname "XXX"))) + (append + ;; Translations for source files + (mapcar #'(lambda (x) + (let ((log (first x)) + (phy (second x))) + (list (make-pathname :name log + :type "LISP" + :version :wild + :defaults logpath) + (make-pathname :name phy + :defaults phypath)))) + l) + ;; Translations for compiled files + (mapcar #'(lambda (x) + (let* ((log (first x)) + (phy (second x)) + (com (compile-file-pathname + (make-pathname :name log + :type "LISP" + :version :wild + :defaults logpath)))) + (setq phy (concatenate 'string phy "B")) + (list com + (make-pathname :name phy + :defaults phypath)))) + l)))) + + ;;;Sample use of that logical pathname. The return value + ;;;is implementation-dependent. + (translate-logical-pathname "prog:code;documentation.lisp") + => #P"PGDOC" + +Exceptional Situations:: +........................ + +If host is incorrectly supplied, an error of type type-error is +signaled. + +See Also:: +.......... + +logical-pathname, + + *note Pathnames as Filenames:: + +Notes:: +....... + +Implementations can define additional functions that operate on logical +pathname hosts, for example to specify additional translation rules or +options. + + +File: gcl.info, Node: logical-pathname, Next: *default-pathname-defaults*, Prev: logical-pathname-translations, Up: Filenames Dictionary + +19.4.9 logical-pathname [Function] +---------------------------------- + +'logical-pathname' pathspec => logical-pathname + +Arguments and Values:: +...................... + +pathspec--a logical pathname, a logical pathname namestring, or a +stream. + + logical-pathname--a logical pathname. + +Description:: +............. + +logical-pathname converts pathspec to a logical pathname and returns the +new logical pathname. If pathspec is a logical pathname namestring, it +should contain a host component and its following colon. If pathspec is +a stream, it should be one for which pathname returns a logical +pathname. + + If pathspec is a stream, the stream can be either open or closed. +logical-pathname returns the same logical pathname after a file is +closed as it did when the file was open. + + It is an error if pathspec is a stream that is created with +make-two-way-stream, make-echo-stream, make-broadcast-stream, +make-concatenated-stream, make-string-input-stream, or +make-string-output-stream. + +Exceptional Situations:: +........................ + +Signals an error of type type-error if pathspec isn't supplied +correctly. + +See Also:: +.......... + +logical-pathname, *note translate-logical-pathname:: , *note Logical +Pathnames:: + + +File: gcl.info, Node: *default-pathname-defaults*, Next: namestring, Prev: logical-pathname, Up: Filenames Dictionary + +19.4.10 *default-pathname-defaults* [Variable] +---------------------------------------------- + +Value Type:: +............ + +a pathname object. + +Initial Value:: +............... + +An implementation-dependent pathname, typically in the working directory +that was current when Common Lisp was started up. + +Description:: +............. + +a pathname, used as the default whenever a function needs a default +pathname and one is not supplied. + +Examples:: +.......... + + ;; This example illustrates a possible usage for a hypothetical Lisp running on a + ;; DEC TOPS-20 file system. Since pathname conventions vary between Lisp + ;; implementations and host file system types, it is not possible to provide a + ;; general-purpose, conforming example. + *default-pathname-defaults* => #P"PS:" + (merge-pathnames (make-pathname :name "CALENDAR")) + => #P"PS:CALENDAR" + (let ((*default-pathname-defaults* (pathname ""))) + (merge-pathnames (make-pathname :name "CALENDAR"))) + => #P"CALENDAR" + +Affected By:: +............. + +The implementation. + + +File: gcl.info, Node: namestring, Next: parse-namestring, Prev: *default-pathname-defaults*, Up: Filenames Dictionary + +19.4.11 namestring, file-namestring, directory-namestring, +---------------------------------------------------------- + +host-namestring, enough-namestring +---------------------------------- + + [Function] + + 'namestring' pathname => namestring + + 'file-namestring' pathname => namestring + + 'directory-namestring' pathname => namestring + + 'host-namestring' pathname => namestring + + 'enough-namestring' pathname &optional defaults => namestring + +Arguments and Values:: +...................... + +pathname--a pathname designator. + + defaults--a pathname designator. + + The default is the value of *default-pathname-defaults*. + + namestring--a string or nil. + + [Editorial Note by KMP: Under what circumstances can NIL be +returned??] + +Description:: +............. + +These functions convert pathname into a namestring. The name +represented by pathname is returned as a namestring in an +implementation-dependent canonical form. + + namestring returns the full form of pathname. + + file-namestring returns just the name, type, and version components +of pathname. + + directory-namestring returns the directory name portion. + + host-namestring returns the host name. + + enough-namestring returns an abbreviated namestring that is just +sufficient to identify the file named by pathname when considered +relative to the defaults. It is required that + + (merge-pathnames (enough-namestring pathname defaults) defaults) + == (merge-pathnames (parse-namestring pathname nil defaults) defaults) + + in all cases, and the result of enough-namestring is the shortest +reasonable string that will satisfy this criterion. + + It is not necessarily possible to construct a valid namestring by +concatenating some of the three shorter namestrings in some order. + +Examples:: +.......... + + (namestring "getty") + => "getty" + (setq q (make-pathname :host "kathy" + :directory + (pathname-directory *default-pathname-defaults*) + :name "getty")) + => #S(PATHNAME :HOST "kathy" :DEVICE NIL :DIRECTORY directory-name + :NAME "getty" :TYPE NIL :VERSION NIL) + (file-namestring q) => "getty" + (directory-namestring q) => directory-name + (host-namestring q) => "kathy" + + ;;;Using Unix syntax and the wildcard conventions used by the + ;;;particular version of Unix on which this example was created: + (namestring + (translate-pathname "/usr/dmr/hacks/frob.l" + "/usr/d*/hacks/*.l" + "/usr/d*/backup/hacks/backup-*.*")) + => "/usr/dmr/backup/hacks/backup-frob.l" + (namestring + (translate-pathname "/usr/dmr/hacks/frob.l" + "/usr/d*/hacks/fr*.l" + "/usr/d*/backup/hacks/backup-*.*")) + => "/usr/dmr/backup/hacks/backup-ob.l" + + ;;;This is similar to the above example but uses two different hosts, + ;;;U: which is a Unix and V: which is a VMS. Note the translation + ;;;of file type and alphabetic case conventions. + (namestring + (translate-pathname "U:/usr/dmr/hacks/frob.l" + "U:/usr/d*/hacks/*.l" + "V:SYS$DISK:[D*.BACKUP.HACKS]BACKUP-*.*")) + => "V:SYS$DISK:[DMR.BACKUP.HACKS]BACKUP-FROB.LSP" + (namestring + (translate-pathname "U:/usr/dmr/hacks/frob.l" + "U:/usr/d*/hacks/fr*.l" + "V:SYS$DISK:[D*.BACKUP.HACKS]BACKUP-*.*")) + => "V:SYS$DISK:[DMR.BACKUP.HACKS]BACKUP-OB.LSP" + +See Also:: +.......... + +*note truename:: , *note merge-pathnames:: , pathname, logical-pathname, +*note File System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: parse-namestring, Next: wild-pathname-p, Prev: namestring, Up: Filenames Dictionary + +19.4.12 parse-namestring [Function] +----------------------------------- + +'parse-namestring' thing &optional host default-pathname &key start end +junk-allowed +=> pathname, position + +Arguments and Values:: +...................... + +thing--a string, a pathname, or a stream associated with a file. + + host--a valid pathname host, a logical host, or nil. + + default-pathname--a pathname designator. The default is the value of +*default-pathname-defaults*. + + start, end--bounding index designators of thing. The defaults for +start and end are 0 and nil, respectively. + + junk-allowed--a generalized boolean. The default is false. + + pathname--a pathname, or nil. + + position--a bounding index designator for thing. + +Description:: +............. + +Converts thing into a pathname. + + The host supplies a host name with respect to which the parsing +occurs. + + If thing is a stream associated with a file, processing proceeds as +if the pathname used to open that file had been supplied instead. + + If thing is a pathname, the host and the host component of thing are +compared. If they match, two values are immediately returned: thing and +start; otherwise (if they do not match), an error is signaled. + + Otherwise (if thing is a string), parse-namestring parses the name of +a file within the substring of thing bounded by start and end. + + If thing is a string then the substring of thing bounded by start and +end is parsed into a pathname as follows: + +* + If host is a logical host then thing is parsed as a logical + pathname namestring on the host. + +* + If host is nil and thing is a syntactically valid logical pathname + namestring containing an explicit host, then it is parsed as a + logical pathname namestring. + +* + If host is nil, default-pathname is a logical pathname, and thing + is a syntactically valid logical pathname namestring without an + explicit host, then it is parsed as a logical pathname namestring + on the host that is the host component of default-pathname. + +* + Otherwise, the parsing of thing is implementation-defined. + + In the first of these cases, the host portion of the logical pathname +namestring and its following colon are optional. + + If the host portion of the namestring and host are both present and +do not match, an error is signaled. + + If junk-allowed is true, then the primary value is the pathname +parsed or, if no syntactically correct pathname was seen, nil. If +junk-allowed is false, then the entire substring is scanned, and the +primary value is the pathname parsed. + + In either case, the secondary value is the index into thing of the +delimiter that terminated the parse, or the index beyond the substring +if the parse terminated at the end of the substring (as will always be +the case if junk-allowed is false). + + Parsing a null string always succeeds, producing a pathname with all +components (except the host) equal to nil. + + If thing contains an explicit host name and no explicit device name, +then it is implementation-defined whether parse-namestring will supply +the standard default device for that host as the device component of the +resulting pathname. + +Examples:: +.......... + + (setq q (parse-namestring "test")) + => #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test" + :TYPE NIL :VERSION NIL) + (pathnamep q) => true + (parse-namestring "test") + => #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test" + :TYPE NIL :VERSION NIL), 4 + (setq s (open xxx)) => # + (parse-namestring s) + => #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME xxx + :TYPE NIL :VERSION NIL), 0 + (parse-namestring "test" nil nil :start 2 :end 4 ) + => #S(PATHNAME ...), 15 + (parse-namestring "foo.lisp") + => #P"foo.lisp" + +Exceptional Situations:: +........................ + +If junk-allowed is false, an error of type parse-error is signaled if +thing does not consist entirely of the representation of a pathname, +possibly surrounded on either side by whitespace_1 characters if that is +appropriate to the cultural conventions of the implementation. + + If host is supplied and not nil, and thing contains a manifest host +name, an error of type error is signaled if the hosts do not match. + + If thing is a logical pathname namestring and if the host portion of +the namestring and host are both present and do not match, an error of +type error is signaled. + +See Also:: +.......... + +pathname, logical-pathname, *note File System Concepts::, + + *note ->UNSPECIFIC as a Component Value::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: wild-pathname-p, Next: pathname-match-p, Prev: parse-namestring, Up: Filenames Dictionary + +19.4.13 wild-pathname-p [Function] +---------------------------------- + +'wild-pathname-p' pathname &optional field-key => generalized-boolean + +Arguments and Values:: +...................... + +pathname--a pathname designator. + + Field-key--one of :host, :device :directory, :name, :type, :version, +or nil. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +wild-pathname-p tests pathname for the presence of wildcard components. + + If pathname is a pathname (as returned by pathname) it represents the +name used to open the file. This may be, but is not required to be, the +actual name of the file. + + If field-key is not supplied or nil, wild-pathname-p returns true if +pathname has any wildcard components, nil if pathname has none. If +field-key is non-nil, wild-pathname-p returns true if the indicated +component of pathname is a wildcard, nil if the component is not a +wildcard. + +Examples:: +.......... + + ;;;The following examples are not portable. They are written to run + ;;;with particular file systems and particular wildcard conventions. + ;;;Other implementations will behave differently. These examples are + ;;;intended to be illustrative, not to be prescriptive. + + (wild-pathname-p (make-pathname :name :wild)) => true + (wild-pathname-p (make-pathname :name :wild) :name) => true + (wild-pathname-p (make-pathname :name :wild) :type) => false + (wild-pathname-p (pathname "s:>foo>**>")) => true ;Lispm + (wild-pathname-p (pathname :name "F*O")) => true ;Most places + +Exceptional Situations:: +........................ + +If pathname is not a pathname, a string, or a stream associated with a +file an error of type type-error is signaled. + +See Also:: +.......... + +pathname, logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + +Notes:: +....... + +Not all implementations support wildcards in all fields. See *note +->WILD as a Component Value:: and *note Restrictions on Wildcard +Pathnames::. + + +File: gcl.info, Node: pathname-match-p, Next: translate-logical-pathname, Prev: wild-pathname-p, Up: Filenames Dictionary + +19.4.14 pathname-match-p [Function] +----------------------------------- + +'pathname-match-p' pathname wildcard => generalized-boolean + +Arguments and Values:: +...................... + +pathname--a pathname designator. + + wildcard--a designator for a wild pathname. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +pathname-match-p returns true if pathname matches wildcard, otherwise +nil. The matching rules are implementation-defined but should be +consistent with directory. Missing components of wildcard default to +:wild. + + It is valid for pathname to be a wild pathname; a wildcard field in +pathname only matches a wildcard field in wildcard (i.e., +pathname-match-p is not commutative). It is valid for wildcard to be a +non-wild pathname. + +Exceptional Situations:: +........................ + +If pathname or wildcard is not a pathname, string, or stream associated +with a file an error of type type-error is signaled. + +See Also:: +.......... + +*note directory:: , pathname, logical-pathname, *note File System +Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: translate-logical-pathname, Next: translate-pathname, Prev: pathname-match-p, Up: Filenames Dictionary + +19.4.15 translate-logical-pathname [Function] +--------------------------------------------- + +'translate-logical-pathname' pathname &key => physical-pathname + +Arguments and Values:: +...................... + +pathname--a pathname designator, or a logical pathname namestring. + + physical-pathname--a physical pathname. + +Description:: +............. + +Translates pathname to a physical pathname, which it returns. + + If pathname is a stream, the stream can be either open or closed. +translate-logical-pathname returns the same physical pathname after a +file is closed as it did when the file was open. + + It is an error if pathname is a stream that is created with +make-two-way-stream, make-echo-stream, make-broadcast-stream, +make-concatenated-stream, make-string-input-stream, +make-string-output-stream. + + If pathname is a logical pathname namestring, the host portion of the +logical pathname namestring and its following colon are required. + + Pathname is first coerced to a pathname. If the coerced pathname is +a physical pathname, it is returned. If the coerced pathname is a +logical pathname, the first matching translation (according to +pathname-match-p) of the logical pathname host is applied, as if by +calling translate-pathname. If the result is a logical pathname, this +process is repeated. When the result is finally a physical pathname, it +is returned. If no translation matches, an error is signaled. + + translate-logical-pathname might perform additional translations, +typically to provide translation of file types to local naming +conventions, to accomodate physical file systems with limited length +names, or to deal with special character requirements such as +translating hyphens to underscores or uppercase letters to lowercase. +Any such additional translations are implementation-defined. Some +implementations do no additional translations. + + There are no specified keyword arguments for +translate-logical-pathname, but implementations are permitted to extend +it by adding keyword arguments. + +Examples:: +.......... + +See logical-pathname-translations. + +Exceptional Situations:: +........................ + +If pathname is incorrectly supplied, an error of type type-error is +signaled. + + If no translation matches, an error of type file-error is signaled. + + [Editorial Note by KMP: Is file-error really right, or should it be +pathname-error?] + +See Also:: +.......... + +*note logical-pathname:: , *note logical-pathname-translations:: , +logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: translate-pathname, Next: merge-pathnames, Prev: translate-logical-pathname, Up: Filenames Dictionary + +19.4.16 translate-pathname [Function] +------------------------------------- + +'translate-pathname' source from-wildcard to-wildcard &key +=> translated-pathname + +Arguments and Values:: +...................... + +source--a pathname designator. + + from-wildcard--a pathname designator. + + to-wildcard--a pathname designator. + + translated-pathname--a pathname. + +Description:: +............. + +translate-pathname translates source (that matches from-wildcard) into a +corresponding pathname that matches to-wildcard, and returns the +corresponding pathname. + + The resulting pathname is to-wildcard with each wildcard or missing +field replaced by a portion of source. A "wildcard field" is a pathname +component with a value of :wild, a :wild element of a list-valued +directory component, or an implementation-defined portion of a +component, such as the "*" in the complex wildcard string "foo*bar" that +some implementations support. An implementation that adds other +wildcard features, such as regular expressions, must define how +translate-pathname extends to those features. A "missing field" is a +pathname component with a value of nil. + + The portion of source that is copied into the resulting pathname is +implementation-defined. Typically it is determined by the user +interface conventions of the file systems involved. Usually it is the +portion of source that matches a wildcard field of from-wildcard that is +in the same position as the wildcard or missing field of to-wildcard. +If there is no wildcard field in from-wildcard at that position, then +usually it is the entire corresponding pathname component of source, or +in the case of a list-valued directory component, the entire +corresponding list element. + + During the copying of a portion of source into the resulting +pathname, additional implementation-defined translations of case or file +naming conventions might occur, especially when from-wildcard and +to-wildcard are for different hosts. + + It is valid for source to be a wild pathname; in general this will +produce a wild result. It is valid for from-wildcard and/or to-wildcard +to be non-wild pathnames. + + There are no specified keyword arguments for translate-pathname, but +implementations are permitted to extend it by adding keyword arguments. + + translate-pathname maps customary case in source into customary case +in the output pathname. + +Examples:: +.......... + + ;; The results of the following five forms are all implementation-dependent. + ;; The second item in particular is shown with multiple results just to + ;; emphasize one of many particular variations which commonly occurs. + (pathname-name (translate-pathname "foobar" "foo*" "*baz")) => "barbaz" + (pathname-name (translate-pathname "foobar" "foo*" "*")) + => "foobar" + OR=> "bar" + (pathname-name (translate-pathname "foobar" "*" "foo*")) => "foofoobar" + (pathname-name (translate-pathname "bar" "*" "foo*")) => "foobar" + (pathname-name (translate-pathname "foobar" "foo*" "baz*")) => "bazbar" + + (defun translate-logical-pathname-1 (pathname rules) + (let ((rule (assoc pathname rules :test #'pathname-match-p))) + (unless rule (error "No translation rule for ~A" pathname)) + (translate-pathname pathname (first rule) (second rule)))) + (translate-logical-pathname-1 "FOO:CODE;BASIC.LISP" + '(("FOO:DOCUMENTATION;" "MY-UNIX:/doc/foo/") + ("FOO:CODE;" "MY-UNIX:/lib/foo/") + ("FOO:PATCHES;*;" "MY-UNIX:/lib/foo/patch/*/"))) + => #P"MY-UNIX:/lib/foo/basic.l" + + ;;;This example assumes one particular set of wildcard conventions + ;;;Not all file systems will run this example exactly as written + (defun rename-files (from to) + (dolist (file (directory from)) + (rename-file file (translate-pathname file from to)))) + (rename-files "/usr/me/*.lisp" "/dev/her/*.l") + ;Renames /usr/me/init.lisp to /dev/her/init.l + (rename-files "/usr/me/pcl*/*" "/sys/pcl/*/") + ;Renames /usr/me/pcl-5-may/low.lisp to /sys/pcl/pcl-5-may/low.lisp + ;In some file systems the result might be /sys/pcl/5-may/low.lisp + (rename-files "/usr/me/pcl*/*" "/sys/library/*/") + ;Renames /usr/me/pcl-5-may/low.lisp to /sys/library/pcl-5-may/low.lisp + ;In some file systems the result might be /sys/library/5-may/low.lisp + (rename-files "/usr/me/foo.bar" "/usr/me2/") + ;Renames /usr/me/foo.bar to /usr/me2/foo.bar + (rename-files "/usr/joe/*-recipes.text" "/usr/jim/cookbook/joe's-*-rec.text") + ;Renames /usr/joe/lamb-recipes.text to /usr/jim/cookbook/joe's-lamb-rec.text + ;Renames /usr/joe/pork-recipes.text to /usr/jim/cookbook/joe's-pork-rec.text + ;Renames /usr/joe/veg-recipes.text to /usr/jim/cookbook/joe's-veg-rec.text + +Exceptional Situations:: +........................ + +If any of source, from-wildcard, or to-wildcard is not a pathname, a +string, or a stream associated with a file an error of type type-error +is signaled. + + (pathname-match-p source from-wildcard) must be true or an error of +type error is signaled. + +See Also:: +.......... + +*note namestring:: , *note pathname-host:: , + + pathname, logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + +Notes:: +....... + +The exact behavior of translate-pathname cannot be dictated by the +Common Lisp language and must be allowed to vary, depending on the user +interface conventions of the file systems involved. + + The following is an implementation guideline. One file system +performs this operation by examining each piece of the three pathnames +in turn, where a piece is a pathname component or a list element of a +structured component such as a hierarchical directory. Hierarchical +directory elements in from-wildcard and to-wildcard are matched by +whether they are wildcards, not by depth in the directory hierarchy. If +the piece in to-wildcard is present and not wild, it is copied into the +result. If the piece in to-wildcard is :wild or nil, the piece in +source is copied into the result. Otherwise, the piece in to-wildcard +might be a complex wildcard such as "foo*bar" and the piece in +from-wildcard should be wild; the portion of the piece in source that +matches the wildcard portion of the piece in from-wildcard replaces the +wildcard portion of the piece in to-wildcard and the value produced is +used in the result. + + +File: gcl.info, Node: merge-pathnames, Prev: translate-pathname, Up: Filenames Dictionary + +19.4.17 merge-pathnames [Function] +---------------------------------- + +'merge-pathnames' pathname &optional default-pathname default-version +=> merged-pathname + +Arguments and Values:: +...................... + +pathname--a pathname designator. + + default-pathname--a pathname designator. + + The default is the value of *default-pathname-defaults*. + + default-version--a valid pathname version. + + The default is :newest. + + merged-pathname--a pathname. + +Description:: +............. + +Constructs a pathname from pathname by filling in any unsupplied +components with the corresponding values from default-pathname and +default-version. + + Defaulting of pathname components is done by filling in components +taken from another pathname. + + This is especially useful for cases such as a program that has an +input file and an output file. Unspecified components of the output +pathname will come from the input pathname, except that the type should +not default to the type of the input pathname but rather to the +appropriate default type for output from the program; for example, see +the function compile-file-pathname. + + If no version is supplied, default-version is used. If +default-version is nil, the version component will remain unchanged. + + If pathname explicitly specifies a host and not a device, and if the +host component of default-pathname matches the host component of +pathname, then the device is taken from the default-pathname; otherwise +the device will be the default file device for that host. If pathname +does not specify a host, device, directory, name, or type, each such +component is copied from default-pathname. If pathname does not specify +a name, then the version, if not provided, will come from +default-pathname, just like the other components. If pathname does +specify a name, then the version is not affected by default-pathname. +If this process leaves the version missing, the default-version is used. +If the host's file name syntax provides a way to input a version without +a name or type, the user can let the name and type default but supply a +version different from the one in default-pathname. + + If pathname is a stream, pathname effectively becomes (pathname +pathname). merge-pathnames can be used on either an open or a closed +stream. + + If pathname is a pathname it represents the name used to open the +file. This may be, but is not required to be, the actual name of the +file. + + merge-pathnames recognizes a logical pathname namestring when +default-pathname is a logical pathname, + + or when the namestring begins with the name of a defined logical host +followed by a colon. In the first of these two cases, + + the host portion of the logical pathname namestring and its following +colon are optional. + + merge-pathnames returns a logical pathname if and only if its first +argument is a logical pathname, + + or its first argument is a logical pathname namestring with an +explicit host, or its first argument does not specify a host and the +default-pathname is a logical pathname. + + Pathname merging treats a relative directory specially. If +(pathname-directory pathname) is a list whose car is :relative, and +(pathname-directory default-pathname) is a list, then the merged +directory is the value of + + (append (pathname-directory default-pathname) + (cdr ;remove :relative from the front + (pathname-directory pathname))) + + except that if the resulting list contains a string or :wild +immediately followed by :back, both of them are removed. This removal +of redundant :back keywords is repeated as many times as possible. If +(pathname-directory default-pathname) is not a list or +(pathname-directory pathname) is not a list whose car is :relative, the +merged directory is (or (pathname-directory pathname) +(pathname-directory default-pathname)) + + merge-pathnames maps customary case in pathname into customary case +in the output pathname. + +Examples:: +.......... + + (merge-pathnames "CMUC::FORMAT" + "CMUC::PS:.FASL") + => #P"CMUC::PS:FORMAT.FASL.0" + +See Also:: +.......... + +*default-pathname-defaults*, pathname, logical-pathname, *note File +System Concepts::, + + *note Pathnames as Filenames:: + +Notes:: +....... + +The net effect is that if just a name is supplied, the host, device, +directory, and type will come from default-pathname, but the version +will come from default-version. If nothing or just a directory is +supplied, the name, type, and version will come from default-pathname +together. + + +File: gcl.info, Node: Files, Next: Streams, Prev: Filenames, Up: Top + +20 Files +******** + +* Menu: + +* File System Concepts:: +* Files Dictionary:: + + +File: gcl.info, Node: File System Concepts, Next: Files Dictionary, Prev: Files, Up: Files + +20.1 File System Concepts +========================= + +This section describes the Common Lisp interface to file systems. The +model used by this interface assumes that files are named by filenames , +that a filename can be represented by a pathname object, and that given +a pathname a stream can be constructed that connects to a file whose +filename it represents. + + For information about opening and closing files, and manipulating +their contents, see *note Streams::. + + Figure 20-1 lists some operators that are applicable to files and +directories. + + compile-file file-length open + delete-file file-position probe-file + directory file-write-date rename-file + file-author load with-open-file + + Figure 20-1: File and Directory Operations + + +* Menu: + +* Coercion of Streams to Pathnames:: +* File Operations on Open and Closed Streams:: +* Truenames:: + + +File: gcl.info, Node: Coercion of Streams to Pathnames, Next: File Operations on Open and Closed Streams, Prev: File System Concepts, Up: File System Concepts + +20.1.1 Coercion of Streams to Pathnames +--------------------------------------- + +A stream associated with a file is either a file stream or a synonym +stream whose target is a stream associated with a file . Such streams +can be used as pathname designators. + + Normally, when a stream associated with a file is used as a pathname +designator, it denotes the pathname used to open the file; this may be, +but is not required to be, the actual name of the file. + + Some functions, such as truename and delete-file, coerce streams to +pathnames in a different way that involves referring to the actual file +that is open, which might or might not be the file whose name was opened +originally. Such special situations are always notated specifically and +are not the default. + + +File: gcl.info, Node: File Operations on Open and Closed Streams, Next: Truenames, Prev: Coercion of Streams to Pathnames, Up: File System Concepts + +20.1.2 File Operations on Open and Closed Streams +------------------------------------------------- + +Many functions that perform file operations accept either open or closed +streams as arguments; see *note Stream Arguments to Standardized +Functions::. + + Of these, the functions in Figure 20-2 treat open and closed streams +differently. + + delete-file file-author probe-file + directory file-write-date truename + + Figure 20-2: File Functions that Treat Open and Closed Streams Differently + + + Since treatment of open streams by the file system may vary +considerably between implementations, however, a closed stream might be +the most reliable kind of argument for some of these functions--in +particular, those in Figure 20-3. For example, in some file systems, +open files are written under temporary names and not renamed until +closed and/or are held invisible until closed. In general, any code +that is intended to be portable should use such functions carefully. + + directory probe-file truename + + Figure 20-3: File Functions where Closed Streams Might Work Best + + + +File: gcl.info, Node: Truenames, Prev: File Operations on Open and Closed Streams, Up: File System Concepts + +20.1.3 Truenames +---------------- + +Many file systems permit more than one filename to designate a +particular file. + + Even where multiple names are possible, most file systems have a +convention for generating a canonical filename in such situations. Such +a canonical filename (or the pathname representing such a filename) is +called a truename . + + The truename of a file may differ from other filenames for the file +because of symbolic links, version numbers, logical device translations +in the file system, logical pathname translations within Common Lisp, or +other artifacts of the file system. + + The truename for a file is often, but not necessarily, unique for +each file. For instance, a Unix file with multiple hard links could +have several truenames. + +* Menu: + +* Examples of Truenames:: + + +File: gcl.info, Node: Examples of Truenames, Prev: Truenames, Up: Truenames + +20.1.3.1 Examples of Truenames +.............................. + +For example, a DEC TOPS-20 system with files PS:FOO.TXT.1 and +PS:FOO.TXT.2 might permit the second file to be referred to as +PS:FOO.TXT.0, since the ".0" notation denotes "newest" version of +several files. In the same file system, a "logical device" "JOE:" might +be taken to refer to PS:" and so the names JOE:FOO.TXT.2 or +JOE:FOO.TXT.0 might refer to PS:FOO.TXT.2. In all of these cases, +the truename of the file would probably be PS:FOO.TXT.2. + + If a file is a symbolic link to another file (in a file system +permitting such a thing), it is conventional for the truename to be the +canonical name of the file after any symbolic links have been followed; +that is, it is the canonical name of the file whose contents would +become available if an input stream to that file were opened. + + In the case of a file still being created (that is, of an output +stream open to such a file), the exact truename of the file might not be +known until the stream is closed. In this case, the function truename +might return different values for such a stream before and after it was +closed. In fact, before it is closed, the name returned might not even +be a valid name in the file system--for example, while a file is being +written, it might have version :newest and might only take on a specific +numeric value later when the file is closed even in a file system where +all files have numeric versions. + + +File: gcl.info, Node: Files Dictionary, Prev: File System Concepts, Up: Files + +20.2 Files Dictionary +===================== + +* Menu: + +* directory:: +* probe-file:: +* ensure-directories-exist:: +* truename:: +* file-author:: +* file-write-date:: +* rename-file:: +* delete-file:: +* file-error:: +* file-error-pathname:: + + +File: gcl.info, Node: directory, Next: probe-file, Prev: Files Dictionary, Up: Files Dictionary + +20.2.1 directory [Function] +--------------------------- + +'directory' pathspec &key => pathnames + +Arguments and Values:: +...................... + +pathspec--a pathname designator, which may contain wild components. + + pathnames--a list of + + physical pathnames. + +Description:: +............. + +Determines which, if any, files that are present in the file system have +names matching pathspec, and returns a + + fresh + + list of pathnames corresponding to the truenames of those files. + + An implementation may be extended to accept implementation-defined +keyword arguments to directory. + +Affected By:: +............. + +The host computer's file system. + +Exceptional Situations:: +........................ + +If the attempt to obtain a directory listing is not successful, an error +of type file-error is signaled. + +See Also:: +.......... + +pathname, + + logical-pathname, + + *note ensure-directories-exist:: , *note File System Concepts::, +*note File Operations on Open and Closed Streams::, + + *note Pathnames as Filenames:: + +Notes:: +....... + +If the pathspec is not wild, the resulting list will contain either zero +or one elements. + + Common Lisp specifies "&key" in the argument list to directory even +though no standardized keyword arguments to directory are defined. +":allow-other-keys t" may be used in conforming programs in order to +quietly ignore any additional keywords which are passed by the program +but not supported by the implementation. + + +File: gcl.info, Node: probe-file, Next: ensure-directories-exist, Prev: directory, Up: Files Dictionary + +20.2.2 probe-file [Function] +---------------------------- + +'probe-file' pathspec => truename + +Arguments and Values:: +...................... + +pathspec--a pathname designator. + + truename--a physical pathname or nil. + +Description:: +............. + +probe-file tests whether a file exists. + + probe-file returns false if there is no file named pathspec, and +otherwise returns the truename of pathspec. + + If the pathspec designator is an open stream, then probe-file +produces the truename of its associated file. + + If pathspec is a stream, whether open or closed, it is coerced to a +pathname as if by the function pathname. + +Affected By:: +............. + +The host computer's file system. + +Exceptional Situations:: +........................ + +An error of type file-error is signaled if pathspec is wild. + + An error of type file-error is signaled if the file system cannot +perform the requested operation. + +See Also:: +.......... + +*note truename:: , *note open:: , *note ensure-directories-exist:: , +pathname, + + logical-pathname, + + *note File System Concepts::, *note File Operations on Open and +Closed Streams::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: ensure-directories-exist, Next: truename, Prev: probe-file, Up: Files Dictionary + +20.2.3 ensure-directories-exist [Function] +------------------------------------------ + +'ensure-directories-exist' pathspec &key verbose => pathspec, created + +Arguments and Values:: +...................... + +pathspec--a pathname designator. + + verbose--a generalized boolean. + + created--a generalized boolean. + +Description:: +............. + +Tests whether the directories containing the specified file actually +exist, and attempts to create them if they do not. + + If the containing directories do not exist and if verbose is true, +then the implementation is permitted (but not required) to perform +output to standard output saying what directories were created. If the +containing directories exist, or if verbose is false, this function +performs no output. + + The primary value is the given pathspec so that this operation can be +straightforwardly composed with other file manipulation expressions. +The secondary value, created, is true if any directories were created. + +Affected By:: +............. + +The host computer's file system. + +Exceptional Situations:: +........................ + +An error of type file-error is signaled if the host, device, or +directory part of pathspec is wild. + + If the directory creation attempt is not successful, an error of type +file-error is signaled; if this occurs, it might be the case that none, +some, or all of the requested creations have actually occurred within +the file system. + +See Also:: +.......... + +*note probe-file:: , *note open:: , + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: truename, Next: file-author, Prev: ensure-directories-exist, Up: Files Dictionary + +20.2.4 truename [Function] +-------------------------- + +'truename' filespec => truename + +Arguments and Values:: +...................... + +filespec--a pathname designator. + + truename--a physical pathname. + +Description:: +............. + +truename tries to find the file indicated by filespec and returns its +truename. If the filespec designator is an open stream, its associated +file is used. + + If filespec is a stream, truename can be used whether the stream is +open or closed. It is permissible for truename to return more specific +information after the stream is closed than when the stream was open. + + If filespec is a pathname it represents the name used to open the +file. This may be, but is not required to be, the actual name of the +file. + +Examples:: +.......... + + ;; An example involving version numbers. Note that the precise nature of + ;; the truename is implementation-dependent while the file is still open. + (with-open-file (stream ">vistor>test.text.newest") + (values (pathname stream) + (truename stream))) + => #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.1" + OR=> #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.newest" + OR=> #P"S:>vistor>test.text.newest", #P"S:>vistor>_temp_._temp_.1" + + ;; In this case, the file is closed when the truename is tried, so the + ;; truename information is reliable. + (with-open-file (stream ">vistor>test.text.newest") + (close stream) + (values (pathname stream) + (truename stream))) + => #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.1" + + ;; An example involving TOP-20's implementation-dependent concept + ;; of logical devices -- in this case, "DOC:" is shorthand for + ;; "PS:" ... + (with-open-file (stream "CMUC::DOC:DUMPER.HLP") + (values (pathname stream) + (truename stream))) + => #P"CMUC::DOC:DUMPER.HLP", #P"CMUC::PS:DUMPER.HLP.13" + +Exceptional Situations:: +........................ + +An error of type file-error is signaled if an appropriate file cannot be +located within the file system for the given filespec, + + or if the file system cannot perform the requested operation. + + An error of type file-error is signaled if pathname is wild. + +See Also:: +.......... + +pathname, logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + +Notes:: +....... + +truename may be used to account for any filename translations performed +by the file system. + + +File: gcl.info, Node: file-author, Next: file-write-date, Prev: truename, Up: Files Dictionary + +20.2.5 file-author [Function] +----------------------------- + +'file-author' pathspec => author + +Arguments and Values:: +...................... + +pathspec--a pathname designator. + + author--a string or nil. + +Description:: +............. + +Returns a string naming the author of the file specified by pathspec, or +nil if the author's name cannot be determined. + +Examples:: +.......... + + (with-open-file (stream ">relativity>general.text") + (file-author s)) + => "albert" + +Affected By:: +............. + +The host computer's file system. + + Other users of the file named by pathspec. + +Exceptional Situations:: +........................ + +An error of type file-error is signaled if pathspec is wild. + + An error of type file-error is signaled if the file system cannot +perform the requested operation. + +See Also:: +.......... + +pathname, logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: file-write-date, Next: rename-file, Prev: file-author, Up: Files Dictionary + +20.2.6 file-write-date [Function] +--------------------------------- + +'file-write-date' pathspec => date + +Arguments and Values:: +...................... + +pathspec--a pathname designator. + + date--a universal time or nil. + +Description:: +............. + +Returns a universal time representing the time at which the file +specified by pathspec was last written (or created), or returns nil if +such a time cannot be determined. + +Examples:: +.......... + + (with-open-file (s "noel.text" + :direction :output :if-exists :error) + (format s "~&Dear Santa,~2 + Please leave lots of toys.~2 + ~2 + (truename s)) + => #P"CUPID:/susan/noel.text" + (with-open-file (s "noel.text") + (file-write-date s)) + => 2902600800 + +Affected By:: +............. + +The host computer's file system. + +Exceptional Situations:: +........................ + +An error of type file-error is signaled if pathspec is wild. + + An error of type file-error is signaled if the file system cannot +perform the requested operation. + +See Also:: +.......... + +*note Universal Time::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: rename-file, Next: delete-file, Prev: file-write-date, Up: Files Dictionary + +20.2.7 rename-file [Function] +----------------------------- + +'rename-file' filespec new-name => defaulted-new-name, old-truename, +new-truename + +Arguments and Values:: +...................... + +filespec--a pathname designator. + + new-name--a pathname designator other than a stream. + + defaulted-new-name--a pathname + + old-truename--a physical pathname. + + new-truename--a physical pathname. + +Description:: +............. + +rename-file modifies the file system in such a way that the file +indicated by filespec is renamed to defaulted-new-name. + + It is an error to specify a filename containing a wild component, for +filespec to contain a nil component where the file system does not +permit a nil component, or for the result of defaulting missing +components of new-name from filespec to contain a nil component where +the file system does not permit a nil component. + + If new-name is a logical pathname, rename-file returns a logical +pathname as its primary value. + + rename-file returns three values if successful. The primary value, +defaulted-new-name, is the resulting name which is composed of new-name +with any missing components filled in by performing a merge-pathnames +operation using filespec as the defaults. The secondary value, +old-truename, is the truename of the file before it was renamed. The +tertiary value, new-truename, is the truename of the file after it was +renamed. + + If the filespec designator is an open stream, then the stream itself +and the file associated with it are affected (if the file system +permits). + +Examples:: +.......... + + ;; An example involving logical pathnames. + (with-open-file (stream "sys:chemistry;lead.text" + :direction :output :if-exists :error) + (princ "eureka" stream) + (values (pathname stream) (truename stream))) + => #P"SYS:CHEMISTRY;LEAD.TEXT.NEWEST", #P"Q:>sys>chem>lead.text.1" + (rename-file "sys:chemistry;lead.text" "gold.text") + => #P"SYS:CHEMISTRY;GOLD.TEXT.NEWEST", + #P"Q:>sys>chem>lead.text.1", + #P"Q:>sys>chem>gold.text.1" + +Exceptional Situations:: +........................ + +If the renaming operation is not successful, an error of type file-error +is signaled. + + An error of type file-error might be signaled if filespec is wild. + +See Also:: +.......... + +*note truename:: , pathname, logical-pathname, *note File System +Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: delete-file, Next: file-error, Prev: rename-file, Up: Files Dictionary + +20.2.8 delete-file [Function] +----------------------------- + +'delete-file' filespec => t + +Arguments and Values:: +...................... + +filespec--a pathname designator. + +Description:: +............. + +Deletes the file specified by filespec. + + If the filespec designator is an open stream, then filespec and the +file associated with it are affected (if the file system permits), in +which case filespec might be closed immediately, and the deletion might +be immediate or delayed until filespec is explicitly closed, depending +on the requirements of the file system. + + It is implementation-dependent whether an attempt to delete a +nonexistent file is considered to be successful. + + delete-file returns true if it succeeds, or signals an error of type +file-error if it does not. + + The consequences are undefined if filespec has a wild component, or +if filespec has a nil component and the file system does not permit a +nil component. + +Examples:: +.......... + + (with-open-file (s "delete-me.text" :direction :output :if-exists :error)) + => NIL + (setq p (probe-file "delete-me.text")) => #P"R:>fred>delete-me.text.1" + (delete-file p) => T + (probe-file "delete-me.text") => false + (with-open-file (s "delete-me.text" :direction :output :if-exists :error) + (delete-file s)) + => T + (probe-file "delete-me.text") => false + +Exceptional Situations:: +........................ + +If the deletion operation is not successful, an error of type file-error +is signaled. + + An error of type file-error might be signaled if filespec is wild. + +See Also:: +.......... + +pathname, logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: file-error, Next: file-error-pathname, Prev: delete-file, Up: Files Dictionary + +20.2.9 file-error [Condition Type] +---------------------------------- + +Class Precedence List:: +....................... + +file-error, error, serious-condition, condition, t + +Description:: +............. + +The type file-error consists of error conditions that occur during an +attempt to open or close a file, or during some low-level transactions +with a file system. The "offending pathname" is initialized by the +:pathname initialization argument to make-condition, and is accessed by +the function file-error-pathname. + +See Also:: +.......... + +file-error-pathname, *note open:: , *note probe-file:: , *note +directory:: , *note ensure-directories-exist:: + + +File: gcl.info, Node: file-error-pathname, Prev: file-error, Up: Files Dictionary + +20.2.10 file-error-pathname [Function] +-------------------------------------- + +'file-error-pathname' condition => pathspec + +Arguments and Values:: +...................... + +condition--a condition of type file-error. + + pathspec--a pathname designator. + +Description:: +............. + +Returns the "offending pathname" of a condition of type file-error. + +Exceptional Situations:: +........................ + +See Also:: +.......... + +file-error, *note Conditions:: + + +File: gcl.info, Node: Streams, Next: Printer, Prev: Files, Up: Top + +21 Streams +********** + +* Menu: + +* Stream Concepts:: +* Streams Dictionary:: + + +File: gcl.info, Node: Stream Concepts, Next: Streams Dictionary, Prev: Streams, Up: Streams + +21.1 Stream Concepts +==================== + +* Menu: + +* Introduction to Streams:: +* Stream Variables:: +* Stream Arguments to Standardized Functions:: +* Restrictions on Composite Streams:: + + +File: gcl.info, Node: Introduction to Streams, Next: Stream Variables, Prev: Stream Concepts, Up: Stream Concepts + +21.1.1 Introduction to Streams +------------------------------ + +A stream is an object that can be used with an input or output function +to identify an appropriate source or sink of characters or bytes for +that operation. A character stream is a source or sink of characters. +A binary stream is a source or sink of bytes. + + Some operations may be performed on any kind of stream; Figure 21-1 +provides a list of standardized operations that are potentially useful +with any kind of stream. + + close stream-element-type + input-stream-p streamp + interactive-stream-p with-open-stream + output-stream-p + + Figure 21-1: Some General-Purpose Stream Operations + + + Other operations are only meaningful on certain stream types. For +example, read-char is only defined for character streams and read-byte +is only defined for binary streams. + +* Menu: + +* Abstract Classifications of Streams (Introduction to Streams):: +* Input:: +* Open and Closed Streams:: +* Interactive Streams:: +* Abstract Classifications of Streams:: +* File Streams:: +* Other Subclasses of Stream:: + + +File: gcl.info, Node: Abstract Classifications of Streams (Introduction to Streams), Next: Input, Prev: Introduction to Streams, Up: Introduction to Streams + +21.1.1.1 Abstract Classifications of Streams +............................................ + + +File: gcl.info, Node: Input, Next: Open and Closed Streams, Prev: Abstract Classifications of Streams (Introduction to Streams), Up: Introduction to Streams + +21.1.1.2 Input, Output, and Bidirectional Streams +................................................. + +A stream, whether a character stream or a binary stream, can be an input +stream (source of data), an output stream (sink for data), both, or +(e.g., when ":direction :probe" is given to open) neither. + + Figure 21-2 shows operators relating to input streams. + + clear-input read-byte read-from-string + listen read-char read-line + peek-char read-char-no-hang read-preserving-whitespace + read read-delimited-list unread-char + + Figure 21-2: Operators relating to Input Streams. + + + Figure 21-3 shows operators relating to output streams. + + clear-output prin1 write + finish-output prin1-to-string write-byte + force-output princ write-char + format princ-to-string write-line + fresh-line print write-string + pprint terpri write-to-string + + Figure 21-3: Operators relating to Output Streams. + + + A stream that is both an input stream and an output stream is called +a bidirectional stream . See the functions input-stream-p and +output-stream-p. + + Any of the operators listed in Figure~21-2 or Figure~21-3 can be used +with bidirectional streams. In addition, Figure 21-4 shows a list of +operators that relate specificaly to bidirectional streams. + + y-or-n-p yes-or-no-p + + Figure 21-4: Operators relating to Bidirectional Streams. + + + +File: gcl.info, Node: Open and Closed Streams, Next: Interactive Streams, Prev: Input, Up: Introduction to Streams + +21.1.1.3 Open and Closed Streams +................................ + +Streams are either open or closed . + + Except as explicitly specified otherwise, operations that create and +return streams return open streams. + + The action of closing a stream marks the end of its use as a source +or sink of data, permitting the implementation to reclaim its internal +data structures, and to free any external resources which might have +been locked by the stream when it was opened. + + Except as explicitly specified otherwise, the consequences are +undefined when a closed stream is used where a stream is called for. + + Coercion of streams to pathnames is permissible for closed streams; +in some situations, such as for a truename computation, the result might +be different for an open stream and for that same stream once it has +been closed. + + +File: gcl.info, Node: Interactive Streams, Next: Abstract Classifications of Streams, Prev: Open and Closed Streams, Up: Introduction to Streams + +21.1.1.4 Interactive Streams +............................ + +An interactive stream is one on which it makes sense to perform +interactive querying. + + The precise meaning of an interactive stream is +implementation-defined, and may depend on the underlying operating +system. Some examples of the things that an implementation might choose +to use as identifying characteristics of an interactive stream include: + +* + The stream is connected to a person (or equivalent) in such a way + that the program can prompt for information and expect to receive + different input depending on the prompt. + +* + The program is expected to prompt for input and support "normal + input editing". + +* + read-char might wait for the user to type something before + returning instead of immediately returning a character or + end-of-file. + + The general intent of having some streams be classified as +interactive streams is to allow them to be distinguished from streams +containing batch (or background or command-file) input. Output to batch +streams is typically discarded or saved for later viewing, so +interactive queries to such streams might not have the expected effect. + + Terminal I/O might or might not be an interactive stream. + + +File: gcl.info, Node: Abstract Classifications of Streams, Next: File Streams, Prev: Interactive Streams, Up: Introduction to Streams + +21.1.1.5 Abstract Classifications of Streams +............................................ + + +File: gcl.info, Node: File Streams, Next: Other Subclasses of Stream, Prev: Abstract Classifications of Streams, Up: Introduction to Streams + +21.1.1.6 File Streams +..................... + +Some streams, called file streams , provide access to files. An object +of class file-stream is used to represent a file stream. + + The basic operation for opening a file is open, which typically +returns a file stream (see its dictionary entry for details). The basic +operation for closing a stream is close. The macro with-open-file is +useful to express the common idiom of opening a file for the duration of +a given body of code, and assuring that the resulting stream is closed +upon exit from that body. + + +File: gcl.info, Node: Other Subclasses of Stream, Prev: File Streams, Up: Introduction to Streams + +21.1.1.7 Other Subclasses of Stream +................................... + +The class stream has a number of subclasses defined by this +specification. Figure 21-5 shows some information about these +subclasses. + + Class Related Operators + broadcast-stream make-broadcast-stream + broadcast-stream-streams + concatenated-stream make-concatenated-stream + concatenated-stream-streams + echo-stream make-echo-stream + echo-stream-input-stream + echo-stream-output-stream + string-stream make-string-input-stream + with-input-from-string + make-string-output-stream + with-output-to-string + get-output-stream-string + synonym-stream make-synonym-stream + synonym-stream-symbol + two-way-stream make-two-way-stream + two-way-stream-input-stream + two-way-stream-output-stream + + Figure 21-5: Defined Names related to Specialized Streams + + + +File: gcl.info, Node: Stream Variables, Next: Stream Arguments to Standardized Functions, Prev: Introduction to Streams, Up: Stream Concepts + +21.1.2 Stream Variables +----------------------- + +Variables whose values must be streams are sometimes called stream +variables . + + Certain stream variables are defined by this specification to be the +proper source of input or output in various situations where no specific +stream has been specified instead. A complete list of such standardized +stream variables appears in Figure 21-6. The consequences are undefined +if at any time the value of any of these variables is not an open +stream. + + Glossary Term Variable Name + debug I/O *debug-io* + error output *error-output* + query I/O *query-io* + standard input *standard-input* + standard output *standard-output* + terminal I/O *terminal-io* + trace output *trace-output* + + Figure 21-6: Standardized Stream Variables + + + Note that, by convention, standardized stream variables have names +ending in "-input*" if they must be input streams, ending in "-output*" +if they must be output streams, or ending in "-io*" if they must be +bidirectional streams. + + User programs may assign or bind any standardized stream variable +except *terminal-io*. + + +File: gcl.info, Node: Stream Arguments to Standardized Functions, Next: Restrictions on Composite Streams, Prev: Stream Variables, Up: Stream Concepts + +21.1.3 Stream Arguments to Standardized Functions +------------------------------------------------- + +The operators in Figure 21-7 accept stream arguments that might be +either open or closed streams. + + broadcast-stream-streams file-author pathnamep + close file-namestring probe-file + compile-file file-write-date rename-file + compile-file-pathname host-namestring streamp + concatenated-stream-streams load synonym-stream-symbol + delete-file logical-pathname translate-logical-pathname + directory merge-pathnames translate-pathname + directory-namestring namestring truename + dribble open two-way-stream-input-stream + echo-stream-input-stream open-stream-p two-way-stream-output-stream + echo-stream-ouput-stream parse-namestring wild-pathname-p + ed pathname with-open-file + enough-namestring pathname-match-p + + Figure 21-7: Operators that accept either Open or Closed Streams + + + The operators in Figure 21-8 accept stream arguments that must be +open streams. + + clear-input output-stream-p read-char-no-hang + clear-output peek-char read-delimited-list + file-length pprint read-line + file-position pprint-fill read-preserving-whitespace + file-string-length pprint-indent stream-element-type + finish-output pprint-linear stream-external-format + force-output pprint-logical-block terpri + format pprint-newline unread-char + fresh-line pprint-tab with-open-stream + get-output-stream-string pprint-tabular write + input-stream-p prin1 write-byte + interactive-stream-p princ write-char + listen print write-line + make-broadcast-stream print-object write-string + make-concatenated-stream print-unreadable-object y-or-n-p + make-echo-stream read yes-or-no-p + make-synonym-stream read-byte + make-two-way-stream read-char + + Figure 21-8: Operators that accept Open Streams only + + + +File: gcl.info, Node: Restrictions on Composite Streams, Prev: Stream Arguments to Standardized Functions, Up: Stream Concepts + +21.1.4 Restrictions on Composite Streams +---------------------------------------- + +The consequences are undefined if any component of a composite stream is +closed before the composite stream is closed. + + The consequences are undefined if the synonym stream symbol is not +bound to an open stream from the time of the synonym stream's creation +until the time it is closed. + + +File: gcl.info, Node: Streams Dictionary, Prev: Stream Concepts, Up: Streams + +21.2 Streams Dictionary +======================= + +* Menu: + +* stream:: +* broadcast-stream:: +* concatenated-stream:: +* echo-stream:: +* file-stream:: +* string-stream:: +* synonym-stream:: +* two-way-stream:: +* input-stream-p:: +* interactive-stream-p:: +* open-stream-p:: +* stream-element-type:: +* streamp:: +* read-byte:: +* write-byte:: +* peek-char:: +* read-char:: +* read-char-no-hang:: +* terpri:: +* unread-char:: +* write-char:: +* read-line:: +* write-string:: +* read-sequence:: +* write-sequence:: +* file-length:: +* file-position:: +* file-string-length:: +* open:: +* stream-external-format:: +* with-open-file:: +* close:: +* with-open-stream:: +* listen:: +* clear-input:: +* finish-output:: +* y-or-n-p:: +* make-synonym-stream:: +* synonym-stream-symbol:: +* broadcast-stream-streams:: +* make-broadcast-stream:: +* make-two-way-stream:: +* two-way-stream-input-stream:: +* echo-stream-input-stream:: +* make-echo-stream:: +* concatenated-stream-streams:: +* make-concatenated-stream:: +* get-output-stream-string:: +* make-string-input-stream:: +* make-string-output-stream:: +* with-input-from-string:: +* with-output-to-string:: +* *debug-io*:: +* *terminal-io*:: +* stream-error:: +* stream-error-stream:: +* end-of-file:: + + +File: gcl.info, Node: stream, Next: broadcast-stream, Prev: Streams Dictionary, Up: Streams Dictionary + +21.2.1 stream [System Class] +---------------------------- + +Class Precedence List:: +....................... + +stream, t + +Description:: +............. + +A stream is an object that can be used with an input or output function +to identify an appropriate source or sink of characters or bytes for +that operation. + + For more complete information, see *note Stream Concepts::. + +See Also:: +.......... + +*note Stream Concepts::, *note Printing Other Objects::, *note +Printer::, *note Reader:: + + +File: gcl.info, Node: broadcast-stream, Next: concatenated-stream, Prev: stream, Up: Streams Dictionary + +21.2.2 broadcast-stream [System Class] +-------------------------------------- + +Class Precedence List:: +....................... + +broadcast-stream, stream, t + +Description:: +............. + +A broadcast stream is an output stream which has associated with it a +set of zero or more output streams such that any output sent to the +broadcast stream gets passed on as output to each of the associated +output streams. (If a broadcast stream has no component streams, then +all output to the broadcast stream is discarded.) + + The set of operations that may be performed on a broadcast stream is +the intersection of those for its associated output streams. + + Some output operations (e.g., fresh-line) return values based on the +state of the stream at the time of the operation. + + Since these values might differ for each of the component streams, it +is necessary to describe their return value specifically: + +* + stream-element-type returns the value from the last component + stream, or t if there are no component streams. + +* + fresh-line returns the value from the last component stream, or nil + if there are no component streams. + +* + The functions file-length, file-position, file-string-length, and + stream-external-format return the value from the last component + stream; if there are no component streams, file-length and + file-position return 0, file-string-length returns 1, and + stream-external-format returns :default. + +* + The functions streamp and output-stream-p always return true for + broadcast streams. + +* + The functions open-stream-p tests whether the broadcast stream is + open_2, not whether its component streams are open. + +* + The functions input-stream-p and interactive-stream-p return an + implementation-defined, generalized boolean value. + +* + For the input operations clear-input listen, peek-char, read-byte, + read-char-no-hang, read-char, read-line, and unread-char, the + consequences are undefined if the indicated operation is performed. + However, an implementation is permitted to define such a behavior + as an implementation-dependent extension. + + For any output operations not having their return values explicitly +specified above or elsewhere in this document, it is defined that the +values returned by such an operation are the values resulting from +performing the operation on the last of its component streams; the +values resulting from performing the operation on all preceding streams +are discarded. If there are no component streams, the value is +implementation-dependent. + +See Also:: +.......... + +*note broadcast-stream-streams:: , *note make-broadcast-stream:: + + +File: gcl.info, Node: concatenated-stream, Next: echo-stream, Prev: broadcast-stream, Up: Streams Dictionary + +21.2.3 concatenated-stream [System Class] +----------------------------------------- + +Class Precedence List:: +....................... + +concatenated-stream, stream, t + +Description:: +............. + +A concatenated stream is an input stream which is a composite stream of +zero or more other input streams, such that the sequence of data which +can be read from the concatenated stream is the same as the +concatenation of the sequences of data which could be read from each of +the constituent streams. + + Input from a concatenated stream is taken from the first of the +associated input streams until it reaches end of file_1; then that +stream is discarded, and subsequent input is taken from the next input +stream, and so on. An end of file on the associated input streams is +always managed invisibly by the concatenated stream--the only time a +client of a concatenated stream sees an end of file is when an attempt +is made to obtain data from the concatenated stream but it has no +remaining input streams from which to obtain such data. + +See Also:: +.......... + +*note concatenated-stream-streams:: , *note make-concatenated-stream:: + + +File: gcl.info, Node: echo-stream, Next: file-stream, Prev: concatenated-stream, Up: Streams Dictionary + +21.2.4 echo-stream [System Class] +--------------------------------- + +Class Precedence List:: +....................... + +echo-stream, stream, t + +Description:: +............. + +An echo stream is a bidirectional stream that gets its input from an +associated input stream and sends its output to an associated output +stream. + + All input taken from the input stream is echoed to the output stream. +Whether the input is echoed immediately after it is encountered, or +after it has been read from the input stream is +implementation-dependent. + +See Also:: +.......... + +*note echo-stream-input-stream:: , echo-stream-output-stream, *note +make-echo-stream:: + + +File: gcl.info, Node: file-stream, Next: string-stream, Prev: echo-stream, Up: Streams Dictionary + +21.2.5 file-stream [System Class] +--------------------------------- + +Class Precedence List:: +....................... + +file-stream, stream, t + +Description:: +............. + +An object of type file-stream is a stream the direct source or sink of +which is a file. Such a stream is created explicitly by open and +with-open-file, and implicitly by functions such as load that process +files. + +See Also:: +.......... + +*note load:: , *note open:: , *note with-open-file:: + + +File: gcl.info, Node: string-stream, Next: synonym-stream, Prev: file-stream, Up: Streams Dictionary + +21.2.6 string-stream [System Class] +----------------------------------- + +Class Precedence List:: +....................... + +string-stream, stream, t + +Description:: +............. + +A string stream is a stream which reads input from or writes output to +an associated string. + + The stream element type of a string stream is always a subtype of +type character. + +See Also:: +.......... + +*note make-string-input-stream:: , *note make-string-output-stream:: , +*note with-input-from-string:: , *note with-output-to-string:: + + +File: gcl.info, Node: synonym-stream, Next: two-way-stream, Prev: string-stream, Up: Streams Dictionary + +21.2.7 synonym-stream [System Class] +------------------------------------ + +Class Precedence List:: +....................... + +synonym-stream, stream, t + +Description:: +............. + +A stream that is an alias for another stream, which is the value of a +dynamic variable whose name is the synonym stream symbol of the synonym +stream. + + Any operations on a synonym stream will be performed on the stream +that is then the value of the dynamic variable named by the synonym +stream symbol. If the value of the variable should change, or if the +variable should be bound, then the stream will operate on the new value +of the variable. + +See Also:: +.......... + +*note make-synonym-stream:: , *note synonym-stream-symbol:: + + +File: gcl.info, Node: two-way-stream, Next: input-stream-p, Prev: synonym-stream, Up: Streams Dictionary + +21.2.8 two-way-stream [System Class] +------------------------------------ + +Class Precedence List:: +....................... + +two-way-stream, stream, t + +Description:: +............. + +A bidirectional composite stream that receives its input from an +associated input stream and sends its output to an associated output +stream. + +See Also:: +.......... + +*note make-two-way-stream:: , *note two-way-stream-input-stream:: , +two-way-stream-output-stream + + +File: gcl.info, Node: input-stream-p, Next: interactive-stream-p, Prev: two-way-stream, Up: Streams Dictionary + +21.2.9 input-stream-p, output-stream-p [Function] +------------------------------------------------- + +'input-stream-p' stream => generalized-boolean + + 'output-stream-p' stream => generalized-boolean + +Arguments and Values:: +...................... + +stream--a stream. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +input-stream-p returns true if stream is an input stream; otherwise, +returns false. + + output-stream-p returns true if stream is an output stream; +otherwise, returns false. + +Examples:: +.......... + + (input-stream-p *standard-input*) => true + (input-stream-p *terminal-io*) => true + (input-stream-p (make-string-output-stream)) => false + + (output-stream-p *standard-output*) => true + (output-stream-p *terminal-io*) => true + (output-stream-p (make-string-input-stream "jr")) => false + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if stream is not a stream. + + +File: gcl.info, Node: interactive-stream-p, Next: open-stream-p, Prev: input-stream-p, Up: Streams Dictionary + +21.2.10 interactive-stream-p [Function] +--------------------------------------- + +'interactive-stream-p' stream => generalized-boolean + +Arguments and Values:: +...................... + +stream--a stream. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if stream is an interactive stream; otherwise, returns +false. + +Examples:: +.......... + + (when (> measured limit) + (let ((error (round (* (- measured limit) 100) + limit))) + (unless (if (interactive-stream-p *query-io*) + (yes-or-no-p "The frammis is out of tolerance by ~D + Is it safe to proceed? " error) + (< error 15)) ;15 + (error "The frammis is out of tolerance by ~D + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if stream is not a stream. + +See Also:: +.......... + +*note Stream Concepts:: + + +File: gcl.info, Node: open-stream-p, Next: stream-element-type, Prev: interactive-stream-p, Up: Streams Dictionary + +21.2.11 open-stream-p [Function] +-------------------------------- + +'open-stream-p' stream => generalized-boolean + +Arguments and Values:: +...................... + +stream--a stream. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if stream is an open stream; otherwise, returns false. + + Streams are open until they have been explicitly closed with close, +or until they are implicitly closed due to exit from a +with-output-to-string, with-open-file, with-input-from-string, or +with-open-stream form. + +Examples:: +.......... + + (open-stream-p *standard-input*) => true + +Affected By:: +............. + +close. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if stream is not a stream. + + +File: gcl.info, Node: stream-element-type, Next: streamp, Prev: open-stream-p, Up: Streams Dictionary + +21.2.12 stream-element-type [Function] +-------------------------------------- + +'stream-element-type' stream => typespec + +Arguments and Values:: +...................... + +stream--a stream. + + typespec--a type specifier. + +Description:: +............. + +stream-element-type returns a type specifier that indicates the types of +objects that may be read from or written to stream. + + Streams created by open have an element type restricted to integer or +a subtype of type character. + +Examples:: +.......... + + ;; Note that the stream must accomodate at least the specified type, + ;; but might accomodate other types. Further note that even if it does + ;; accomodate exactly the specified type, the type might be specified in + ;; any of several ways. + (with-open-file (s "test" :element-type '(integer 0 1) + :if-exists :error + :direction :output) + (stream-element-type s)) + => INTEGER + OR=> (UNSIGNED-BYTE 16) + OR=> (UNSIGNED-BYTE 8) + OR=> BIT + OR=> (UNSIGNED-BYTE 1) + OR=> (INTEGER 0 1) + OR=> (INTEGER 0 (2)) + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if stream is not a stream. + + +File: gcl.info, Node: streamp, Next: read-byte, Prev: stream-element-type, Up: Streams Dictionary + +21.2.13 streamp [Function] +-------------------------- + +'streamp' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type stream; otherwise, returns false. + + streamp is unaffected by whether object, if it is a stream, is open +or closed. + +Examples:: +.......... + + (streamp *terminal-io*) => true + (streamp 1) => false + +Notes:: +....... + + (streamp object) == (typep object 'stream) + + +File: gcl.info, Node: read-byte, Next: write-byte, Prev: streamp, Up: Streams Dictionary + +21.2.14 read-byte [Function] +---------------------------- + +'read-byte' stream &optional eof-error-p eof-value => byte + +Arguments and Values:: +...................... + +stream--a binary input stream. + + eof-error-p--a generalized boolean. The default is true. + + eof-value--an object. The default is nil. + + byte--an integer, or the eof-value. + +Description:: +............. + +read-byte reads and returns one byte from stream. + + If an end of file_2 occurs and eof-error-p is false, the eof-value is +returned. + +Examples:: +.......... + + (with-open-file (s "temp-bytes" + :direction :output + :element-type 'unsigned-byte) + (write-byte 101 s)) => 101 + (with-open-file (s "temp-bytes" :element-type 'unsigned-byte) + (format t "~S ~S" (read-byte s) (read-byte s nil 'eof))) + |> 101 EOF + => NIL + +Side Effects:: +.............. + +Modifies stream. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if stream is not a stream. + + Should signal an error of type error if stream is not a binary input +stream. + + If there are no bytes remaining in the stream and eof-error-p is +true, an error of type end-of-file is signaled. + +See Also:: +.......... + +*note read-char:: , + + *note read-sequence:: , + + *note write-byte:: + + +File: gcl.info, Node: write-byte, Next: peek-char, Prev: read-byte, Up: Streams Dictionary + +21.2.15 write-byte [Function] +----------------------------- + +'write-byte' byte stream => byte + +Arguments and Values:: +...................... + +byte--an integer of the stream element type of stream. + + stream--a binary output stream. + +Description:: +............. + +write-byte writes one byte, byte, to stream. + +Examples:: +.......... + + (with-open-file (s "temp-bytes" + :direction :output + :element-type 'unsigned-byte) + (write-byte 101 s)) => 101 + +Side Effects:: +.............. + +stream is modified. + +Affected By:: +............. + +The element type of the stream. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if stream is not a stream. +Should signal an error of type error if stream is not a binary output +stream. + + Might signal an error of type type-error if byte is not an integer of +the stream element type of stream. + +See Also:: +.......... + +*note read-byte:: , *note write-char:: , + + *note write-sequence:: + + +File: gcl.info, Node: peek-char, Next: read-char, Prev: write-byte, Up: Streams Dictionary + +21.2.16 peek-char [Function] +---------------------------- + +'peek-char' &optional peek-type input-stream eof-error-p eof-value +recursive-p => char + +Arguments and Values:: +...................... + +peek-type--a character or t or nil. + + input-stream--input stream designator. The default is standard +input. + + eof-error-p--a generalized boolean. The default is true. + + eof-value--an object. The default is nil. + + recursive-p--a generalized boolean. The default is false. + + char--a character or the eof-value. + +Description:: +............. + +peek-char obtains the next character in input-stream without actually +reading it, thus leaving the character to be read at a later time. It +can also be used to skip over and discard intervening characters in the +input-stream until a particular character is found. + + If peek-type is not supplied or nil, peek-char returns the next +character to be read from input-stream, without actually removing it +from input-stream. The next time input is done from input-stream, the +character will still be there. If peek-type is t, then peek-char skips +over whitespace_2 characters, but not comments, and then performs the +peeking operation on the next character. The last character examined, +the one that starts an object, is not removed from input-stream. If +peek-type is a character, then peek-char skips over input characters +until a character that is char= to that character is found; that +character is left in input-stream. + + If an end of file_2 occurs and eof-error-p is false, eof-value is +returned. + + If recursive-p is true, this call is expected to be embedded in a +higher-level call to read or a similar function used by the Lisp reader. + + When input-stream is an echo stream, characters that are only peeked +at are not echoed. In the case that peek-type is not nil, the +characters that are passed by peek-char are treated as if by read-char, +and so are echoed unless they have been marked otherwise by unread-char. + +Examples:: +.......... + + (with-input-from-string (input-stream " 1 2 3 4 5") + (format t "~S ~S ~S" + (peek-char t input-stream) + (peek-char #\4 input-stream) + (peek-char nil input-stream))) + |> #\1 #\4 #\4 + => NIL + +Affected By:: +............. + +*readtable*, *standard-input*, *terminal-io*. + +Exceptional Situations:: +........................ + +If eof-error-p is true and an end of file_2 occurs an error of type +end-of-file is signaled. + + If peek-type is a character, an end of file_2 occurs, and eof-error-p +is true, an error of type end-of-file is signaled. + + If recursive-p is true and an end of file_2 occurs, an error of type +end-of-file is signaled. + + +File: gcl.info, Node: read-char, Next: read-char-no-hang, Prev: peek-char, Up: Streams Dictionary + +21.2.17 read-char [Function] +---------------------------- + +'read-char' &optional input-stream eof-error-p eof-value recursive-p => +char + +Arguments and Values:: +...................... + +input-stream--an input stream designator. The default is standard +input. + + eof-error-p--a generalized boolean. The default is true. + + eof-value--an object. The default is nil. + + recursive-p--a generalized boolean. The default is false. + + char--a character or the eof-value. + +Description:: +............. + +read-char returns the next character from input-stream. + + When input-stream is an echo stream, the character is echoed on +input-stream the first time the character is seen. Characters that are +not echoed by read-char are those that were put there by unread-char and +hence are assumed to have been echoed already by a previous call to +read-char. + + If recursive-p is true, this call is expected to be embedded in a +higher-level call to read or a similar function used by the Lisp reader. + + If an end of file_2 occurs and eof-error-p is false, eof-value is +returned. + +Examples:: +.......... + + (with-input-from-string (is "0123") + (do ((c (read-char is) (read-char is nil 'the-end))) + ((not (characterp c))) + (format t "~S " c))) + |> #\0 #\1 #\2 #\3 + => NIL + +Affected By:: +............. + +*standard-input*, *terminal-io*. + +Exceptional Situations:: +........................ + +If an end of file_2 occurs before a character can be read, and +eof-error-p is true, an error of type end-of-file is signaled. + +See Also:: +.......... + +*note read-byte:: , + + *note read-sequence:: , + + *note write-char:: , *note read:: + +Notes:: +....... + +The corresponding output function is write-char. + + +File: gcl.info, Node: read-char-no-hang, Next: terpri, Prev: read-char, Up: Streams Dictionary + +21.2.18 read-char-no-hang [Function] +------------------------------------ + +'read-char-no-hang' &optional input-stream eof-error-p eof-value +recursive-p => char + +Arguments and Values:: +...................... + +input-stream - an input stream designator. The default is standard +input. + + eof-error-p--a generalized boolean. The default is true. + + eof-value--an object. The default is nil. + + recursive-p--a generalized boolean. The default is false. + + char--a character or nil or the eof-value. + +Description:: +............. + +read-char-no-hang returns a character from input-stream if such a +character is available. If no character is available, read-char-no-hang +returns nil. + + If recursive-p is true, this call is expected to be embedded in a +higher-level call to read or a similar function used by the Lisp reader. + + If an end of file_2 occurs and eof-error-p is false, eof-value is +returned. + +Examples:: +.......... + + ;; This code assumes an implementation in which a newline is not + ;; required to terminate input from the console. + (defun test-it () + (unread-char (read-char)) + (list (read-char-no-hang) + (read-char-no-hang) + (read-char-no-hang))) + => TEST-IT + ;; Implementation A, where a Newline is not required to terminate + ;; interactive input on the console. + (test-it) + |> |>>a<<| + => (#\a NIL NIL) + ;; Implementation B, where a Newline is required to terminate + ;; interactive input on the console, and where that Newline remains + ;; on the input stream. + (test-it) + |> |>>a[<-~]<<| + => (#\a #\Newline NIL) + +Affected By:: +............. + +*standard-input*, *terminal-io*. + +Exceptional Situations:: +........................ + +If an end of file_2 occurs when eof-error-p is true, an error of type +end-of-file is signaled . + +See Also:: +.......... + +*note listen:: + +Notes:: +....... + +read-char-no-hang is exactly like read-char, except that if it would be +necessary to wait in order to get a character (as from a keyboard), nil +is immediately returned without waiting. + + +File: gcl.info, Node: terpri, Next: unread-char, Prev: read-char-no-hang, Up: Streams Dictionary + +21.2.19 terpri, fresh-line [Function] +------------------------------------- + +'terpri' &optional output-stream => nil + + 'fresh-line' &optional output-stream => generalized-boolean + +Arguments and Values:: +...................... + +output-stream - an output stream designator. The default is standard +output. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +terpri outputs a newline to output-stream. + + fresh-line is similar to terpri but outputs a newline only if the +output-stream is not already at the start of a line. If for some reason +this cannot be determined, then a newline is output anyway. fresh-line +returns true if it outputs a newline; otherwise it returns false. + +Examples:: +.......... + + (with-output-to-string (s) + (write-string "some text" s) + (terpri s) + (terpri s) + (write-string "more text" s)) + => "some text + + more text" + (with-output-to-string (s) + (write-string "some text" s) + (fresh-line s) + (fresh-line s) + (write-string "more text" s)) + => "some text + more text" + +Side Effects:: +.............. + +The output-stream is modified. + +Affected By:: +............. + +*standard-output*, *terminal-io*. + +Exceptional Situations:: +........................ + +None. + + [Reviewer Note by Barmar: What if stream is closed?] + +Notes:: +....... + +terpri is identical in effect to + + (write-char #\Newline output-stream) + + +File: gcl.info, Node: unread-char, Next: write-char, Prev: terpri, Up: Streams Dictionary + +21.2.20 unread-char [Function] +------------------------------ + +'unread-char' character &optional input-stream => nil + +Arguments and Values:: +...................... + +character--a character; must be the last character that was read from +input-stream. + + input-stream--an input stream designator. The default is standard +input. + +Description:: +............. + +unread-char places character back onto the front of input-stream so that +it will again be the next character in input-stream. + + When input-stream is an echo stream, no attempt is made to undo any +echoing of the character that might already have been done on +input-stream. However, characters placed on input-stream by unread-char +are marked in such a way as to inhibit later re-echo by read-char. + + It is an error to invoke unread-char twice consecutively on the same +stream without an intervening call to read-char (or some other input +operation which implicitly reads characters) on that stream. + + Invoking peek-char or read-char commits all previous characters. The +consequences of invoking unread-char on any character preceding that +which is returned by peek-char (including those passed over by peek-char +that has a non-nil peek-type) are unspecified. In particular, the +consequences of invoking unread-char after peek-char are unspecified. + +Examples:: +.......... + + (with-input-from-string (is "0123") + (dotimes (i 6) + (let ((c (read-char is))) + (if (evenp i) (format t "~&~S ~S~ + |> 0 #\0 + |> 2 #\1 + |> 4 #\2 + => NIL + +Affected By:: +............. + +*standard-input*, *terminal-io*. + +See Also:: +.......... + +*note peek-char:: , *note read-char:: , *note Stream Concepts:: + +Notes:: +....... + +unread-char is intended to be an efficient mechanism for allowing the +Lisp reader and other parsers to perform one-character lookahead in +input-stream. + + +File: gcl.info, Node: write-char, Next: read-line, Prev: unread-char, Up: Streams Dictionary + +21.2.21 write-char [Function] +----------------------------- + +'write-char' character &optional output-stream => character + +Arguments and Values:: +...................... + +character--a character. + + output-stream - an output stream designator. The default is standard +output. + +Description:: +............. + +write-char outputs character to output-stream. + +Examples:: +.......... + + (write-char #\a) + |> a + => #\a + (with-output-to-string (s) + (write-char #\a s) + (write-char #\Space s) + (write-char #\b s)) + => "a b" + +Side Effects:: +.............. + +The output-stream is modified. + +Affected By:: +............. + +*standard-output*, *terminal-io*. + +See Also:: +.......... + +*note read-char:: , *note write-byte:: , + + *note write-sequence:: + + +File: gcl.info, Node: read-line, Next: write-string, Prev: write-char, Up: Streams Dictionary + +21.2.22 read-line [Function] +---------------------------- + +'read-line' &optional input-stream eof-error-p eof-value recursive-p +=> line, missing-newline-p + +Arguments and Values:: +...................... + +input-stream--an input stream designator. The default is standard +input. + + eof-error-p--a generalized boolean. The default is true. + + eof-value--an object. The default is nil. + + recursive-p--a generalized boolean. The default is false. + + line--a string or the eof-value. + + missing-newline-p--a generalized boolean. + +Description:: +............. + +Reads from input-stream a line of text that is terminated by a newline +or end of file. + + If recursive-p is true, this call is expected to be embedded in a +higher-level call to read or a similar function used by the Lisp reader. + + The primary value, line, is the line that is read, represented as a +string (without the trailing newline, if any). If eof-error-p is false +and the end of file for input-stream is reached before any characters +are read, eof-value is returned as the line. + + The secondary value, missing-newline-p, is a generalized boolean that +is false if the line was terminated by a newline, or true if the line +was terminated by the end of file for input-stream (or if the line is +the eof-value). + +Examples:: +.......... + + (setq a "line 1 + line2") + => "line 1 + line2" + (read-line (setq input-stream (make-string-input-stream a))) + => "line 1", false + (read-line input-stream) + => "line2", true + (read-line input-stream nil nil) + => NIL, true + +Affected By:: +............. + +*standard-input*, *terminal-io*. + +Exceptional Situations:: +........................ + +If an end of file_2 occurs before any characters are read in the line, +an error is signaled if eof-error-p is true. + +See Also:: +.......... + +*note read:: + +Notes:: +....... + +The corresponding output function is write-line. + + +File: gcl.info, Node: write-string, Next: read-sequence, Prev: read-line, Up: Streams Dictionary + +21.2.23 write-string, write-line [Function] +------------------------------------------- + +'write-string' string &optional output-stream &key start end => string + + 'write-line' string &optional output-stream &key start end => string + +Arguments and Values:: +...................... + +string--a string. + + output-stream - an output stream designator. The default is standard +output. + + start, end--bounding index designators of string. The defaults for +start and end are 0 and nil, respectively. + +Description:: +............. + +write-string writes the characters of the subsequence of string bounded +by start and end to output-stream. write-line does the same thing, but +then outputs a newline afterwards. + +Examples:: +.......... + + (prog1 (write-string "books" nil :end 4) (write-string "worms")) + |> bookworms + => "books" + (progn (write-char #\*) + (write-line "test12" *standard-output* :end 5) + (write-line "*test2") + (write-char #\*) + nil) + |> *test1 + |> *test2 + |> * + => NIL + +Affected By:: +............. + +*standard-output*, *terminal-io*. + +See Also:: +.......... + +*note read-line:: , *note write-char:: + +Notes:: +....... + +write-line and write-string return string, not the substring bounded by +start and end. + + (write-string string) + == (dotimes (i (length string) + (write-char (char string i))) + + (write-line string) + == (prog1 (write-string string) (terpri)) + + +File: gcl.info, Node: read-sequence, Next: write-sequence, Prev: write-string, Up: Streams Dictionary + +21.2.24 read-sequence [Function] +-------------------------------- + +'read-sequence' sequence stream &key start end => position + + sequence--a sequence. + + stream--an input stream. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + + position--an integer greater than or equal to zero, and less than or +equal to the length of the sequence. + +Description:: +............. + +Destructively modifies sequence by replacing the elements of sequence +bounded by start and end with elements read from stream. + + Sequence is destructively modified by copying successive elements +into it from stream. If the end of file for stream is reached before +copying all elements of the subsequence, then the extra elements near +the end of sequence are not updated. + + Position is the index of the first element of sequence that was not +updated, which might be less than end because the end of file was +reached. + +Examples:: +.......... + + (defvar *data* (make-array 15 :initial-element nil)) + (values (read-sequence *data* (make-string-input-stream "test string")) *data*) + => 11, #(#\t #\e #\s #\t #\Space #\s #\t #\r #\i #\n #\g NIL NIL NIL NIL) + +Side Effects:: +.............. + +Modifies stream and sequence. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. Should signal an error of type type-error if +start is not a non-negative integer. Should signal an error of type +type-error if end is not a non-negative integer or nil. + + Might signal an error of type type-error if an element read from the +stream is not a member of the element type of the sequence. + +See Also:: +.......... + +*note Compiler Terminology::, *note write-sequence:: , *note read-line:: + +Notes:: +....... + +read-sequence is identical in effect to iterating over the indicated +subsequence and reading one element at a time from stream and storing it +into sequence, but may be more efficient than the equivalent loop. An +efficient implementation is more likely to exist for the case where the +sequence is a vector with the same element type as the stream. + + +File: gcl.info, Node: write-sequence, Next: file-length, Prev: read-sequence, Up: Streams Dictionary + +21.2.25 write-sequence [Function] +--------------------------------- + +'write-sequence' sequence stream &key start end => sequence + + sequence--a sequence. + + stream--an output stream. + + start, end--bounding index designators of sequence. The defaults for +start and end are 0 and nil, respectively. + +Description:: +............. + +write-sequence writes the elements of the subsequence of sequence +bounded by start and end to stream. + +Examples:: +.......... + + (write-sequence "bookworms" *standard-output* :end 4) + |> book + => "bookworms" + +Side Effects:: +.............. + +Modifies stream. + +Exceptional Situations:: +........................ + +Should be prepared to signal an error of type type-error if sequence is +not a proper sequence. Should signal an error of type type-error if +start is not a non-negative integer. Should signal an error of type +type-error if end is not a non-negative integer or nil. + + Might signal an error of type type-error if an element of the bounded +sequence is not a member of the stream element type of the stream. + +See Also:: +.......... + +*note Compiler Terminology::, *note read-sequence:: , *note +write-string:: , write-line + +Notes:: +....... + +write-sequence is identical in effect to iterating over the indicated +subsequence and writing one element at a time to stream, but may be more +efficient than the equivalent loop. An efficient implementation is more +likely to exist for the case where the sequence is a vector with the +same element type as the stream. + + +File: gcl.info, Node: file-length, Next: file-position, Prev: write-sequence, Up: Streams Dictionary + +21.2.26 file-length [Function] +------------------------------ + +'file-length' stream => length + +Arguments and Values:: +...................... + +stream--a stream associated with a file. + + length--a non-negative integer or nil. + +Description:: +............. + +file-length returns the length of stream, or nil if the length cannot be +determined. + + For a binary file, the length is measured in units of the element +type of the stream. + +Examples:: +.......... + + (with-open-file (s "decimal-digits.text" + :direction :output :if-exists :error) + (princ "0123456789" s) + (truename s)) + => #P"A:>Joe>decimal-digits.text.1" + (with-open-file (s "decimal-digits.text") + (file-length s)) + => 10 + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if stream is not a stream +associated with a file. + +See Also:: +.......... + +*note open:: + + +File: gcl.info, Node: file-position, Next: file-string-length, Prev: file-length, Up: Streams Dictionary + +21.2.27 file-position [Function] +-------------------------------- + +'file-position' stream => position + + 'file-position' stream position-spec => success-p + +Arguments and Values:: +...................... + +stream--a stream. + + position-spec--a file position designator. + + position--a file position or nil. + + success-p--a generalized boolean. + +Description:: +............. + +Returns or changes the current position within a stream. + + When position-spec is not supplied, file-position returns the current +file position in the stream, or nil if this cannot be determined. + + When position-spec is supplied, the file position in stream is set to +that file position (if possible). file-position returns true if the +repositioning is performed successfully, or false if it is not. + + An integer returned by file-position of one argument should be +acceptable as position-spec for use with the same file. + + For a character file, performing a single read-char or write-char +operation may cause the file position to be increased by more than 1 +because of character-set translations (such as translating between the +Common Lisp #\Newline character and an external ASCII +carriage-return/line-feed sequence) and other aspects of the +implementation. For a binary file, every read-byte or write-byte +operation increases the file position by 1. + +Examples:: +.......... + + (defun tester () + (let ((noticed '()) file-written) + (flet ((notice (x) (push x noticed) x)) + (with-open-file (s "test.bin" + :element-type '(unsigned-byte 8) + :direction :output + :if-exists :error) + (notice (file-position s)) ;1 + (write-byte 5 s) + (write-byte 6 s) + (let ((p (file-position s))) + (notice p) ;2 + (notice (when p (file-position s (1- p))))) ;3 + (write-byte 7 s) + (notice (file-position s)) ;4 + (setq file-written (truename s))) + (with-open-file (s file-written + :element-type '(unsigned-byte 8) + :direction :input) + (notice (file-position s)) ;5 + (let ((length (file-length s))) + (notice length) ;6 + (when length + (dotimes (i length) + (notice (read-byte s)))))) ;7,... + (nreverse noticed)))) + => tester + (tester) + => (0 2 T 2 0 2 5 7) + OR=> (0 2 NIL 3 0 3 5 6 7) + OR=> (NIL NIL NIL NIL NIL NIL) + +Side Effects:: +.............. + +When the position-spec argument is supplied, the file position in the +stream might be moved. + +Affected By:: +............. + +The value returned by file-position increases monotonically as input or +output operations are performed. + +Exceptional Situations:: +........................ + +If position-spec is supplied, but is too large or otherwise +inappropriate, an error is signaled. + +See Also:: +.......... + +*note file-length:: , *note file-string-length:: , *note open:: + +Notes:: +....... + +Implementations that have character files represented as a sequence of +records of bounded size might choose to encode the file position as, for +example, +<>*<>+<>. This +is a valid encoding because it increases monotonically as each character +is read or written, though not necessarily by 1 at each step. An +integer might then be considered "inappropriate" as position-spec to +file-position if, when decoded into record number and character number, +it turned out that the supplied record was too short for the specified +character number. + + +File: gcl.info, Node: file-string-length, Next: open, Prev: file-position, Up: Streams Dictionary + +21.2.28 file-string-length [Function] +------------------------------------- + +'file-string-length' stream object => length + +Arguments and Values:: +...................... + +stream--an output character file stream. + + object--a string or a character. + + length--a non-negative integer, or nil. + +Description:: +............. + +file-string-length returns the difference between what (file-position +stream) would be after writing object and its current value, or nil if +this cannot be determined. + + The returned value corresponds to the current state of stream at the +time of the call and might not be the same if it is called again when +the state of the stream has changed. + + +File: gcl.info, Node: open, Next: stream-external-format, Prev: file-string-length, Up: Streams Dictionary + +21.2.29 open [Function] +----------------------- + +'open' filespec &key direction element-type if-exists if-does-not-exist +external-format +=> stream + +Arguments and Values:: +...................... + +filespec--a pathname designator. + + direction--one of :input, :output, :io, or :probe. The default is +:input. + + element-type--a type specifier for recognizable subtype of character; +or a type specifier for a finite recognizable subtype of integer; or one +of the symbols signed-byte, unsigned-byte, or :default. The default is +character. + + if-exists--one of :error, :new-version, :rename, :rename-and-delete, +:overwrite, :append, :supersede, or nil. The default is :new-version if +the version component of filespec is :newest, or :error otherwise. + + if-does-not-exist--one of :error, :create, or nil. The default is +:error if direction is :input or if-exists is :overwrite or :append; +:create if direction is :output or :io, and if-exists is neither +:overwrite nor :append; or nil when direction is :probe. + + external-format--an external file format designator. The default is +:default. + + stream--a file stream or nil. + +Description:: +............. + +open creates, opens, and returns a file stream that is connected to the +file specified by filespec. Filespec is the name of the file to be +opened. If the filespec designator is a stream, that stream is not +closed first or otherwise affected. + + The keyword arguments to open specify the characteristics of the file +stream that is returned, and how to handle errors. + + If direction is :input or :probe, or if if-exists is not :new-version +and the version component of the filespec is :newest, then the file +opened is that file already existing in the file system that has a +version greater than that of any other file in the file system whose +other pathname components are the same as those of filespec. + + An implementation is required to recognize all of the open keyword +options and to do something reasonable in the context of the host +operating system. For example, if a file system does not support +distinct file versions and does not distinguish the notions of deletion +and expunging, :new-version might be treated the same as :rename or +:supersede, and :rename-and-delete might be treated the same as +:supersede. + +:direction + These are the possible values for direction, and how they affect + the nature of the stream that is created: + + :input + Causes the creation of an input file stream. + + :output + Causes the creation of an output file stream. + + :io + Causes the creation of a bidirectional file stream. + + :probe + Causes the creation of a "no-directional" file stream; in + effect, the file stream is created and then closed prior to + being returned by open. + +:element-type + The element-type specifies the unit of transaction for the file + stream. If it is :default, the unit is determined by file system, + possibly based on the file. + +:if-exists + if-exists specifies the action to be taken if direction is :output + or :io and a file of the name filespec already exists. If + direction is :input, not supplied, or :probe, if-exists is ignored. + These are the results of open as modified by if-exists: + + :error + An error of type file-error is signaled. + + :new-version + A new file is created with a larger version number. + + :rename + The existing file is renamed to some other name and then a new + file is created. + + :rename-and-delete + The existing file is renamed to some other name, then it is + deleted but not expunged, and then a new file is created. + + :overwrite + Output operations on the stream destructively modify the + existing file. If direction is :io the file is opened in a + bidirectional mode that allows both reading and writing. The + file pointer is initially positioned at the beginning of the + file; however, the file is not truncated back to length zero + when it is opened. + + :append + Output operations on the stream destructively modify the + existing file. The file pointer is initially positioned at + the end of the file. + + If direction is :io, the file is opened in a bidirectional + mode that allows both reading and writing. + + :supersede + The existing file is superseded; that is, a new file with the + same name as the old one is created. If possible, the + implementation should not destroy the old file until the new + stream is closed. + + nil + No file or stream is created; instead, nil is returned to + indicate failure. + +:if-does-not-exist + if-does-not-exist specifies the action to be taken if a file of + name filespec does not already exist. These are the results of + open as modified by if-does-not-exist: + + :error + An error of type file-error is signaled. + + :create + An empty file is created. Processing continues as if the file + had already existed but no processing as directed by if-exists + is performed. + + nil + No file or stream is created; instead, nil is returned to + indicate failure. + +:external-format + This option selects an external file format for the file: The only + standardized value for this option is :default, although + implementations are permitted to define additional external file + formats and implementation-dependent values returned by + stream-external-format can also be used by conforming programs. + + The external-format is meaningful for any kind of file stream whose + element type is a subtype of character. This option is ignored for + streams for which it is not meaningful; however, implementations + may define other element types for which it is meaningful. The + consequences are unspecified if a character is written that cannot + be represented by the given external file format. + + When a file is opened, a file stream is constructed to serve as the +file system's ambassador to the Lisp environment; operations on the file +stream are reflected by operations on the file in the file system. + + A file can be deleted, renamed, or destructively modified by open. + + For information about opening relative pathnames, see *note Merging +Pathnames::. + +Examples:: +.......... + + (open filespec :direction :probe) => # + (setq q (merge-pathnames (user-homedir-pathname) "test")) + => # + (open filespec :if-does-not-exist :create) => # + (setq s (open filespec :direction :probe)) => # + (truename s) => # + (open s :direction :output :if-exists nil) => NIL + +Affected By:: +............. + +The nature and state of the host computer's file system. + +Exceptional Situations:: +........................ + +If if-exists is :error, (subject to the constraints on the meaning of +if-exists listed above), an error of type file-error is signaled. + + If if-does-not-exist is :error (subject to the constraints on the +meaning of if-does-not-exist listed above), an error of type file-error +is signaled. + + If it is impossible for an implementation to handle some option in a +manner close to what is specified here, an error of type error might be +signaled. + + An error of type file-error is signaled if (wild-pathname-p filespec) +returns true. + + An error of type error is signaled if the external-format is not +understood by the implementation. + + The various file systems in existence today have widely differing +capabilities, and some aspects of the file system are beyond the scope +of this specification to define. A given implementation might not be +able to support all of these options in exactly the manner stated. An +implementation is required to recognize all of these option keywords and +to try to do something "reasonable" in the context of the host file +system. Where necessary to accomodate the file system, an +implementation deviate slightly from the semantics specified here +without being disqualified for consideration as a conforming +implementation. If it is utterly impossible for an implementation to +handle some option in a manner similar to what is specified here, it may +simply signal an error. + + With regard to the :element-type option, if a type is requested that +is not supported by the file system, a substitution of types such as +that which goes on in upgrading is permissible. As a minimum +requirement, it should be the case that opening an output stream to a +file in a given element type and later opening an input stream to the +same file in the same element type should work compatibly. + +See Also:: +.......... + +*note with-open-file:: , *note close:: , pathname, logical-pathname, + + *note Merging Pathnames::, + + *note Pathnames as Filenames:: + +Notes:: +....... + +open does not automatically close the file when an abnormal exit occurs. + + When element-type is a subtype of character, read-char and/or +write-char can be used on the resulting file stream. + + When element-type is a subtype of integer, read-byte and/or +write-byte can be used on the resulting file stream. + + When element-type is :default, the type can be determined by using +stream-element-type. + + +File: gcl.info, Node: stream-external-format, Next: with-open-file, Prev: open, Up: Streams Dictionary + +21.2.30 stream-external-format [Function] +----------------------------------------- + +'stream-external-format' stream => format + +Arguments and Values:: +...................... + +stream--a file stream. + + format--an external file format. + +Description:: +............. + +Returns an external file format designator for the stream. + +Examples:: +.......... + + (with-open-file (stream "test" :direction :output) + (stream-external-format stream)) + => :DEFAULT + OR=> :ISO8859/1-1987 + OR=> (:ASCII :SAIL) + OR=> ACME::PROPRIETARY-FILE-FORMAT-17 + OR=> # + +See Also:: +.......... + +the :external-format argument to the function *note open:: and the *note +with-open-file:: macro. + +Notes:: +....... + +The format returned is not necessarily meaningful to other +implementations. + + +File: gcl.info, Node: with-open-file, Next: close, Prev: stream-external-format, Up: Streams Dictionary + +21.2.31 with-open-file [macro] +------------------------------ + +Syntax:: +........ + +'with-open-file' (stream filespec {options}*) {declaration}* {form}* +=> results + +Arguments and Values:: +...................... + +stream - a variable. + + filespec--a pathname designator. + + options - forms; evaluated. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +with-open-file uses open to create a file stream + + to file named by filespec. Filespec is the name of the file to be +opened. Options are used as keyword arguments to open. + + The stream object to which the stream variable is bound has dynamic +extent; its extent ends when the form is exited. + + with-open-file evaluates the forms as an implicit progn with stream +bound to + + the value returned by open. + + When control leaves the body, either normally or abnormally (such as +by use of throw), the file is automatically closed. If a new output +file is being written, and control leaves abnormally, the file is +aborted and the file system is left, so far as possible, as if the file +had never been opened. + + It is possible by the use of :if-exists nil or :if-does-not-exist nil +for stream to be bound to nil. + + Users of :if-does-not-exist nil should check for a valid stream. + + The consequences are undefined if an attempt is made to assign the +stream variable. The compiler may choose to issue a warning if such an +attempt is detected. + +Examples:: +.......... + + (setq p (merge-pathnames "test")) + => # + (with-open-file (s p :direction :output :if-exists :supersede) + (format s "Here are a couple~ + (with-open-file (s p) + (do ((l (read-line s) (read-line s nil 'eof))) + ((eq l 'eof) "Reached end of file.") + (format t "~&*** ~A~ + |> *** Here are a couple + |> *** of test data lines + => "Reached end of file." + + ;; Normally one would not do this intentionally because it is + ;; not perspicuous, but beware when using :IF-DOES-NOT-EXIST NIL + ;; that this doesn't happen to you accidentally... + (with-open-file (foo "no-such-file" :if-does-not-exist nil) + (read foo)) + |> |>>hello?<<| + => HELLO? ;This value was read from the terminal, not a file! + + ;; Here's another bug to avoid... + (with-open-file (foo "no-such-file" :direction :output :if-does-not-exist nil) + (format foo "Hello")) + => "Hello" ;FORMAT got an argument of NIL! + +Side Effects:: +.............. + +Creates a stream to the file named by filename (upon entry), and closes +the stream (upon exit). In some implementations, the file might be +locked in some way while it is open. If the stream is an output stream, +a file might be created. + +Affected By:: +............. + +The host computer's file system. + +Exceptional Situations:: +........................ + +See the function open. + +See Also:: +.......... + +*note open:: , *note close:: , pathname, logical-pathname, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: close, Next: with-open-stream, Prev: with-open-file, Up: Streams Dictionary + +21.2.32 close [Function] +------------------------ + +'close' stream &key abort => result + +Arguments and Values:: +...................... + +stream--a stream (either open or closed). + + abort--a generalized boolean. The default is false. + + result--t if the stream was open at the time it was received as an +argument, or implementation-dependent otherwise. + +Description:: +............. + +close closes stream. Closing a stream means that it may no longer be +used in input or output operations. The act of closing a file stream +ends the association between the stream and its associated file; the +transaction with the file system is terminated, and input/output may no +longer be performed on the stream. + + If abort is true, an attempt is made to clean up any side effects of +having created stream. If stream performs output to a file that was +created when the stream was created, the file is deleted and any +previously existing file is not superseded. + + It is permissible to close an already closed stream, but in that case +the result is implementation-dependent. + + After stream is closed, it is still possible to perform the following +query operations upon it: + + streamp, pathname, truename, merge-pathnames, pathname-host, +pathname-device, pathname-directory,pathname-name, pathname-type, +pathname-version, namestring, file-namestring, directory-namestring, +host-namestring, enough-namestring, open, probe-file, and directory. + + The effect of close on a constructed stream is to close the argument +stream only. There is no effect on the constituents of composite +streams. + + For a stream created with make-string-output-stream, the result of +get-output-stream-string is unspecified after close. + +Examples:: +.......... + + (setq s (make-broadcast-stream)) => # + (close s) => T + (output-stream-p s) => true + +Side Effects:: +.............. + +The stream is closed (if necessary). If abort is true and the stream is +an output file stream, its associated file might be deleted. + +See Also:: +.......... + +*note open:: + + +File: gcl.info, Node: with-open-stream, Next: listen, Prev: close, Up: Streams Dictionary + +21.2.33 with-open-stream [Macro] +-------------------------------- + +'with-open-stream' (var stream) {declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +var--a variable name. + + stream--a form; evaluated to produce a stream. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +with-open-stream performs a series of operations on stream, returns a +value, and then closes the stream. + + Var is bound to the value of stream, and then forms are executed as +an implicit progn. stream is automatically closed on exit from +with-open-stream, no matter whether the exit is normal or abnormal. + + The stream has dynamic extent; its extent ends when the form is +exited. + + The consequences are undefined if an attempt is made to assign the +the variable var with the forms. + +Examples:: +.......... + + (with-open-stream (s (make-string-input-stream "1 2 3 4")) + (+ (read s) (read s) (read s))) => 6 + +Side Effects:: +.............. + +The stream is closed (upon exit). + +See Also:: +.......... + +*note close:: + + +File: gcl.info, Node: listen, Next: clear-input, Prev: with-open-stream, Up: Streams Dictionary + +21.2.34 listen [Function] +------------------------- + +'listen' &optional input-stream => generalized-boolean + +Arguments and Values:: +...................... + +input-stream--an input stream designator. The default is standard +input. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if there is a character immediately available from +input-stream; otherwise, returns false. On a non-interactive +input-stream, listen returns true except when at end of file_1. If an +end of file is encountered, listen returns false. listen is intended to +be used when input-stream obtains characters from an interactive device +such as a keyboard. + +Examples:: +.......... + + (progn (unread-char (read-char)) (list (listen) (read-char))) + |> |>>1<<| + => (T #\1) + (progn (clear-input) (listen)) + => NIL ;Unless you're a very fast typist! + +Affected By:: +............. + +*standard-input* + +See Also:: +.......... + +*note interactive-stream-p:: , *note read-char-no-hang:: + + +File: gcl.info, Node: clear-input, Next: finish-output, Prev: listen, Up: Streams Dictionary + +21.2.35 clear-input [Function] +------------------------------ + +'clear-input' &optional input-stream => nil + +Arguments and Values:: +...................... + +input-stream--an input stream designator. The default is standard +input. + +Description:: +............. + +Clears any available input from input-stream. + + If clear-input does not make sense for input-stream, then clear-input +does nothing. + +Examples:: +.......... + + ;; The exact I/O behavior of this example might vary from implementation + ;; to implementation depending on the kind of interactive buffering that + ;; occurs. (The call to SLEEP here is intended to help even out the + ;; differences in implementations which do not do line-at-a-time buffering.) + + (defun read-sleepily (&optional (clear-p nil) (zzz 0)) + (list (progn (print '>) (read)) + ;; Note that input typed within the first ZZZ seconds + ;; will be discarded. + (progn (print '>) + (if zzz (sleep zzz)) + (print '>>) + (if clear-p (clear-input)) + (read)))) + + (read-sleepily) + |> > |>>10<<| + |> > + |> >> |>>20<<| + => (10 20) + + (read-sleepily t) + |> > |>>10<<| + |> > + |> >> |>>20<<| + => (10 20) + + (read-sleepily t 10) + |> > |>>10<<| + |> > |>>20<<| ; Some implementations won't echo typeahead here. + |> >> |>>30<<| + => (10 30) + +Side Effects:: +.............. + +The input-stream is modified. + +Affected By:: +............. + +*standard-input* + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if input-stream is not a +stream designator. + +See Also:: +.......... + +clear-output + + +File: gcl.info, Node: finish-output, Next: y-or-n-p, Prev: clear-input, Up: Streams Dictionary + +21.2.36 finish-output, force-output, clear-output [Function] +------------------------------------------------------------ + +'finish-output' &optional output-stream => nil + + 'force-output' &optional output-stream => nil + + 'clear-output' &optional output-stream => nil + +Arguments and Values:: +...................... + +output-stream--an output stream designator. The default is standard +output. + +Description:: +............. + +finish-output, force-output, and clear-output exercise control over the +internal handling of buffered stream output. + + finish-output attempts to ensure that any buffered output sent to +output-stream has reached its destination, and then returns. + + force-output initiates the emptying of any internal buffers but does +not wait for completion or acknowledgment to return. + + clear-output attempts to abort any outstanding output operation in +progress in order to allow as little output as possible to continue to +the destination. + + If any of these operations does not make sense for output-stream, +then it does nothing. The precise actions of these functions are +implementation-dependent. + +Examples:: +.......... + + ;; Implementation A + (progn (princ "am i seen?") (clear-output)) + => NIL + + ;; Implementation B + (progn (princ "am i seen?") (clear-output)) + |> am i seen? + => NIL + +Affected By:: +............. + +*standard-output* + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if output-stream is not a +stream designator. + +See Also:: +.......... + +*note clear-input:: + + +File: gcl.info, Node: y-or-n-p, Next: make-synonym-stream, Prev: finish-output, Up: Streams Dictionary + +21.2.37 y-or-n-p, yes-or-no-p [Function] +---------------------------------------- + +'y-or-n-p' &optional control &rest arguments => generalized-boolean + + 'yes-or-no-p' &optional control &rest arguments => +generalized-boolean + +Arguments and Values:: +...................... + +control--a format control. + + arguments--format arguments for control. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +These functions ask a question and parse a response from the user. They +return true if the answer is affirmative, or false if the answer is +negative. + + y-or-n-p is for asking the user a question whose answer is either +"yes" or "no." It is intended that the reply require the user to answer +a yes-or-no question with a single character. yes-or-no-p is also for +asking the user a question whose answer is either "Yes" or "No." It is +intended that the reply require the user to take more action than just a +single keystroke, such as typing the full word yes or no followed by a +newline. + + y-or-n-p types out a message (if supplied), reads an answer in some +implementation-dependent manner (intended to be short and simple, such +as reading a single character such as Y or N). yes-or-no-p types out a +message (if supplied), attracts the user's attention (for example, by +ringing the terminal's bell), and reads an answer in some +implementation-dependent manner (intended to be multiple characters, +such as YES or NO). + + If format-control is supplied and not nil, then a fresh-line +operation is performed; then a message is printed as if format-control +and arguments were given to format. In any case, yes-or-no-p and +y-or-n-p will provide a prompt such as "(Y or N)" or "(Yes or No)" if +appropriate. + + All input and output are performed using query I/O. + +Examples:: +.......... + + (y-or-n-p "(t or nil) given by") + |> (t or nil) given by (Y or N) |>>Y<<| + => true + (yes-or-no-p "a ~S message" 'frightening) + |> a FRIGHTENING message (Yes or No) |>>no<<| + => false + (y-or-n-p "Produce listing file?") + |> Produce listing file? + |> Please respond with Y or N. |>>n<<| + => false + +Side Effects:: +.............. + +Output to and input from query I/O will occur. + +Affected By:: +............. + +*query-io*. + +See Also:: +.......... + +*note format:: + +Notes:: +....... + +yes-or-no-p and yes-or-no-p do not add question marks to the end of the +prompt string, so any desired question mark or other punctuation should +be explicitly included in the text query. + + +File: gcl.info, Node: make-synonym-stream, Next: synonym-stream-symbol, Prev: y-or-n-p, Up: Streams Dictionary + +21.2.38 make-synonym-stream [Function] +-------------------------------------- + +'make-synonym-stream' symbol => synonym-stream + +Arguments and Values:: +...................... + +symbol--a symbol that names a dynamic variable. + + synonym-stream--a synonym stream. + +Description:: +............. + +Returns a synonym stream whose synonym stream symbol is symbol. + +Examples:: +.......... + + (setq a-stream (make-string-input-stream "a-stream") + b-stream (make-string-input-stream "b-stream")) + => # + (setq s-stream (make-synonym-stream 'c-stream)) + => # + (setq c-stream a-stream) + => # + (read s-stream) => A-STREAM + (setq c-stream b-stream) + => # + (read s-stream) => B-STREAM + +Exceptional Situations:: +........................ + +Should signal type-error if its argument is not a symbol. + +See Also:: +.......... + +*note Stream Concepts:: + + +File: gcl.info, Node: synonym-stream-symbol, Next: broadcast-stream-streams, Prev: make-synonym-stream, Up: Streams Dictionary + +21.2.39 synonym-stream-symbol [Function] +---------------------------------------- + +'synonym-stream-symbol' synonym-stream => symbol + +Arguments and Values:: +...................... + +synonym-stream--a synonym stream. + + symbol--a symbol. + +Description:: +............. + +Returns the symbol whose symbol-value the synonym-stream is using. + +See Also:: +.......... + +*note make-synonym-stream:: + + +File: gcl.info, Node: broadcast-stream-streams, Next: make-broadcast-stream, Prev: synonym-stream-symbol, Up: Streams Dictionary + +21.2.40 broadcast-stream-streams [Function] +------------------------------------------- + +'broadcast-stream-streams' broadcast-stream => streams + +Arguments and Values:: +...................... + +broadcast-stream--a broadcast stream. + + streams--a list of streams. + +Description:: +............. + +Returns a list of output streams that constitute all the streams to +which the broadcast-stream is broadcasting. + + +File: gcl.info, Node: make-broadcast-stream, Next: make-two-way-stream, Prev: broadcast-stream-streams, Up: Streams Dictionary + +21.2.41 make-broadcast-stream [Function] +---------------------------------------- + +'make-broadcast-stream' &rest streams => broadcast-stream + +Arguments and Values:: +...................... + +stream--an output stream. + + broadcast-stream--a broadcast stream. + +Description:: +............. + +Returns a broadcast stream. + +Examples:: +.......... + + (setq a-stream (make-string-output-stream) + b-stream (make-string-output-stream)) => # + (format (make-broadcast-stream a-stream b-stream) + "this will go to both streams") => NIL + (get-output-stream-string a-stream) => "this will go to both streams" + (get-output-stream-string b-stream) => "this will go to both streams" + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if any stream is not an output +stream. + +See Also:: +.......... + +*note broadcast-stream-streams:: + + +File: gcl.info, Node: make-two-way-stream, Next: two-way-stream-input-stream, Prev: make-broadcast-stream, Up: Streams Dictionary + +21.2.42 make-two-way-stream [Function] +-------------------------------------- + +'make-two-way-stream' input-stream output-stream => two-way-stream + +Arguments and Values:: +...................... + +input-stream--a stream. + + output-stream--a stream. + + two-way-stream--a two-way stream. + +Description:: +............. + +Returns a two-way stream that gets its input from input-stream and sends +its output to output-stream. + +Examples:: +.......... + + (with-output-to-string (out) + (with-input-from-string (in "input...") + (let ((two (make-two-way-stream in out))) + (format two "output...") + (setq what-is-read (read two))))) => "output..." + what-is-read => INPUT... + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if input-stream is not an +input stream. Should signal an error of type type-error if +output-stream is not an output stream. + + +File: gcl.info, Node: two-way-stream-input-stream, Next: echo-stream-input-stream, Prev: make-two-way-stream, Up: Streams Dictionary + +21.2.43 two-way-stream-input-stream, two-way-stream-output-stream +----------------------------------------------------------------- + + [Function] + + 'two-way-stream-input-stream' two-way-stream => input-stream + + 'two-way-stream-output-stream' two-way-stream => output-stream + +Arguments and Values:: +...................... + +two-way-stream--a two-way stream. + + input-stream--an input stream. + + output-stream--an output stream. + +Description:: +............. + +two-way-stream-input-stream returns the stream from which two-way-stream +receives input. + + two-way-stream-output-stream returns the stream to which +two-way-stream sends output. + + +File: gcl.info, Node: echo-stream-input-stream, Next: make-echo-stream, Prev: two-way-stream-input-stream, Up: Streams Dictionary + +21.2.44 echo-stream-input-stream, echo-stream-output-stream [Function] +---------------------------------------------------------------------- + +'echo-stream-input-stream' echo-stream => input-stream + + 'echo-stream-output-stream' echo-stream => output-stream + +Arguments and Values:: +...................... + +echo-stream--an echo stream. + + input-stream--an input stream. + + output-stream--an output stream. + +Description:: +............. + +echo-stream-input-stream returns the input stream from which echo-stream +receives input. + + echo-stream-output-stream returns the output stream to which +echo-stream sends output. + + +File: gcl.info, Node: make-echo-stream, Next: concatenated-stream-streams, Prev: echo-stream-input-stream, Up: Streams Dictionary + +21.2.45 make-echo-stream [Function] +----------------------------------- + +'make-echo-stream' input-stream output-stream => echo-stream + +Arguments and Values:: +...................... + +input-stream--an input stream. + + output-stream--an output stream. + + echo-stream--an echo stream. + +Description:: +............. + +Creates and returns an echo stream that takes input from input-stream +and sends output to output-stream. + +Examples:: +.......... + + (let ((out (make-string-output-stream))) + (with-open-stream + (s (make-echo-stream + (make-string-input-stream "this-is-read-and-echoed") + out)) + (read s) + (format s " * this-is-direct-output") + (get-output-stream-string out))) + => "this-is-read-and-echoed * this-is-direct-output" + +See Also:: +.......... + +*note echo-stream-input-stream:: , echo-stream-output-stream, *note +make-two-way-stream:: + + +File: gcl.info, Node: concatenated-stream-streams, Next: make-concatenated-stream, Prev: make-echo-stream, Up: Streams Dictionary + +21.2.46 concatenated-stream-streams [Function] +---------------------------------------------- + +'concatenated-stream-streams' concatenated-stream => streams + +Arguments and Values:: +...................... + +concatenated-stream - a concatenated stream. + + streams--a list of input streams. + +Description:: +............. + +Returns a list of input streams that constitute the ordered set of +streams the concatenated-stream still has to read from, starting with +the current one it is reading from. The list may be empty if no more +streams remain to be read. + + The consequences are undefined if the list structure of the streams +is ever modified. + + +File: gcl.info, Node: make-concatenated-stream, Next: get-output-stream-string, Prev: concatenated-stream-streams, Up: Streams Dictionary + +21.2.47 make-concatenated-stream [Function] +------------------------------------------- + +'make-concatenated-stream' &rest input-streams => concatenated-stream + +Arguments and Values:: +...................... + +input-stream--an input stream. + + concatenated-stream--a concatenated stream. + +Description:: +............. + +Returns a concatenated stream that has the indicated input-streams +initially associated with it. + +Examples:: +.......... + + (read (make-concatenated-stream + (make-string-input-stream "1") + (make-string-input-stream "2"))) => 12 + +Exceptional Situations:: +........................ + +Should signal type-error if any argument is not an input stream. + +See Also:: +.......... + +*note concatenated-stream-streams:: + + +File: gcl.info, Node: get-output-stream-string, Next: make-string-input-stream, Prev: make-concatenated-stream, Up: Streams Dictionary + +21.2.48 get-output-stream-string [Function] +------------------------------------------- + +'get-output-stream-string' string-output-stream => string + +Arguments and Values:: +...................... + +string-output-stream--a stream. + + string--a string. + +Description:: +............. + +Returns a string containing, in order, all the characters that have been +output to string-output-stream. This operation clears any characters on +string-output-stream, so the string contains only those characters which +have been output since the last call to get-output-stream-string or +since the creation of the string-output-stream, whichever occurred most +recently. + +Examples:: +.......... + + (setq a-stream (make-string-output-stream) + a-string "abcdefghijklm") => "abcdefghijklm" + (write-string a-string a-stream) => "abcdefghijklm" + (get-output-stream-string a-stream) => "abcdefghijklm" + (get-output-stream-string a-stream) => "" + +Side Effects:: +.............. + +The string-output-stream is cleared. + +Exceptional Situations:: +........................ + +The consequences are undefined if stream-output-string is closed. + + The consequences are undefined if string-output-stream is a stream +that was not produced by make-string-output-stream. + + The consequences are undefined if string-output-stream was created +implicitly by with-output-to-string or format. + +See Also:: +.......... + +*note make-string-output-stream:: + + +File: gcl.info, Node: make-string-input-stream, Next: make-string-output-stream, Prev: get-output-stream-string, Up: Streams Dictionary + +21.2.49 make-string-input-stream [Function] +------------------------------------------- + +'make-string-input-stream' string &optional start end => string-stream + +Arguments and Values:: +...................... + +string--a string. + + start, end--bounding index designators of string. The defaults for +start and end are 0 and nil, respectively. + + string-stream--an input string stream. + +Description:: +............. + +Returns an input string stream. This stream will supply, in order, the +characters in the substring of string bounded by start and end. After +the last character has been supplied, the string stream will then be at +end of file. + +Examples:: +.......... + + (let ((string-stream (make-string-input-stream "1 one "))) + (list (read string-stream nil nil) + (read string-stream nil nil) + (read string-stream nil nil))) + => (1 ONE NIL) + + (read (make-string-input-stream "prefixtargetsuffix" 6 12)) => TARGET + +See Also:: +.......... + +*note with-input-from-string:: + + +File: gcl.info, Node: make-string-output-stream, Next: with-input-from-string, Prev: make-string-input-stream, Up: Streams Dictionary + +21.2.50 make-string-output-stream [Function] +-------------------------------------------- + +'make-string-output-stream' &key element-type => string-stream + +Arguments and Values:: +...................... + +element-type--a type specifier. The default is character. + + string-stream--an output string stream. + +Description:: +............. + +Returns + + an output string stream that accepts characters and makes available +(via get-output-stream-string) a string that contains the characters +that were actually output. + + The element-type names the type of the elements of the string; a +string is constructed of the most specialized type that can accommodate +elements of that element-type. + +Examples:: +.......... + + (let ((s (make-string-output-stream))) + (write-string "testing... " s) + (prin1 1234 s) + (get-output-stream-string s)) + => "testing... 1234" + + None.. + +See Also:: +.......... + +*note get-output-stream-string:: , *note with-output-to-string:: + + +File: gcl.info, Node: with-input-from-string, Next: with-output-to-string, Prev: make-string-output-stream, Up: Streams Dictionary + +21.2.51 with-input-from-string [Macro] +-------------------------------------- + +'with-input-from-string' (var string &key index start end) +{declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +var--a variable name. + + string--a form; evaluated to produce a string. + + index--a place. + + start, end--bounding index designators of string. The defaults for +start and end are 0 and nil, respectively. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + result--the values returned by the forms. + +Description:: +............. + +Creates an + + input string stream, + + provides an opportunity to perform operations on the stream +(returning zero or more values), and then closes the string stream. + + String is evaluated first, and var is bound to a character input +string stream that supplies characters from the subsequence of the +resulting string bounded by start and end. The body is executed as an +implicit progn. + + The input string stream is automatically closed on exit from +with-input-from-string, no matter whether the exit is normal or +abnormal. + + The input string stream to which the variable var is bound has +dynamic extent; its extent ends when the form is exited. + + The index is a pointer within the string to be advanced. If +with-input-from-string is exited normally, then index will have as its +value the index into the string indicating the first character not read +which is (length string) if all characters were used. The place +specified by index is not updated as reading progresses, but only at the +end of the operation. + + start and index may both specify the same variable, which is a +pointer within the string to be advanced, perhaps repeatedly by some +containing loop. + + The consequences are undefined if an attempt is made to assign the +variable var. + +Examples:: +.......... + + (with-input-from-string (s "XXX1 2 3 4xxx" + :index ind + :start 3 :end 10) + (+ (read s) (read s) (read s))) => 6 + ind => 9 + (with-input-from-string (s "Animal Crackers" :index j :start 6) + (read s)) => CRACKERS + + The variable j is set to 15. + +Side Effects:: +.............. + +The value of the place named by index, if any, is modified. + +See Also:: +.......... + +*note make-string-input-stream:: , + + *note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: with-output-to-string, Next: *debug-io*, Prev: with-input-from-string, Up: Streams Dictionary + +21.2.52 with-output-to-string [Macro] +------------------------------------- + +'with-output-to-string' (var &optional string-form &key element-type) +{declaration}* {form}* +=> {result}* + +Arguments and Values:: +...................... + +var--a variable name. + + string-form--a form or nil; if non-nil, evaluated to produce string. + + string--a string that has a fill pointer. + + element-type--a type specifier; evaluated. + + The default is character. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + + results--If a string-form is not supplied or nil, a string; +otherwise, the values returned by the forms. + +Description:: +............. + +with-output-to-string creates a + + character output stream, performs a series of operations that may +send results to this stream, and then closes the stream. + + The element-type names the type of the elements of the stream; a +stream is constructed of the most specialized type that can accommodate +elements of the given type. + + The body is executed as an implicit progn with var bound to an output +string stream. All output to that string stream is saved in a string. + + If string is supplied, element-type is ignored, and the output is +incrementally appended to string as if by use of vector-push-extend. + + The output stream is automatically closed on exit from +with-output-from-string, no matter whether the exit is normal or +abnormal. + + The output string stream to which the variable var is bound has +dynamic extent; its extent ends when the form is exited. + + If no string is provided, then with-output-from-string + + produces a stream that accepts characters and returns a string of the +indicated element-type. + + If string is provided, with-output-to-string returns the results of +evaluating the last form. + + The consequences are undefined if an attempt is made to assign the +variable var. + +Examples:: +.......... + + (setq fstr (make-array '(0) :element-type 'base-char + :fill-pointer 0 :adjustable t)) => "" + (with-output-to-string (s fstr) + (format s "here's some output") + (input-stream-p s)) => false + fstr => "here's some output" + +Side Effects:: +.............. + +The string is modified. + +Exceptional Situations:: +........................ + +The consequences are undefined if destructive modifications are +performed directly on the string during the dynamic extent of the call. + +See Also:: +.......... + +*note make-string-output-stream:: , vector-push-extend, + + *note Traversal Rules and Side Effects:: + + +File: gcl.info, Node: *debug-io*, Next: *terminal-io*, Prev: with-output-to-string, Up: Streams Dictionary + +21.2.53 *debug-io*, *error-output*, *query-io*, +----------------------------------------------- + +*standard-input*, *standard-output*, +------------------------------------ + +*trace-output* +-------------- + + [Variable] + +Value Type:: +............ + +For *standard-input*: an input stream + + For *error-output*, *standard-output*, and *trace-output*: an output +stream. + + For *debug-io*, *query-io*: a bidirectional stream. + +Initial Value:: +............... + +implementation-dependent, but it must be an open stream that is not a +generalized synonym stream to an I/O customization variables but that +might be a generalized synonym stream to the value of some I/O +customization variable. The initial value might also be a generalized +synonym stream to either the symbol *terminal-io* or to the stream that +is its value. + +Description:: +............. + +These variables are collectively called the standardized I/O +customization variables. They can be bound or assigned in order to +change the default destinations for input and/or output used by various +standardized operators and facilities. + + The value of *debug-io*, called debug I/O, is a stream to be used for +interactive debugging purposes. + + The value of *error-output*, called error output, is a stream to +which warnings and non-interactive error messages should be sent. + + The value of *query-io*, called query I/O, is a bidirectional stream +to be used when asking questions of the user. The question should be +output to this stream, and the answer read from it. + + The value of *standard-input*, called standard input, is a stream +that is used by many operators as a default source of input when no +specific input stream is explicitly supplied. + + The value of *standard-output*, called standard output, is a stream +that is used by many operators as a default destination for output when +no specific output stream is explicitly supplied. + + The value of *trace-output*, called trace output, is the stream on +which traced functions (see trace) and the time macro print their +output. + +Examples:: +.......... + + (with-output-to-string (*error-output*) + (warn "this string is sent to *error-output*")) + => "Warning: this string is sent to *error-output* + " ;The exact format of this string is implementation-dependent. + + (with-input-from-string (*standard-input* "1001") + (+ 990 (read))) => 1991 + + (progn (setq out (with-output-to-string (*standard-output*) + (print "print and format t send things to") + (format t "*standard-output* now going to a string"))) + :done) + => :DONE + out + => " + \"print and format t send things to\" *standard-output* now going to a string" + + (defun fact (n) (if (< n 2) 1 (* n (fact (- n 1))))) + => FACT + (trace fact) + => (FACT) + ;; Of course, the format of traced output is implementation-dependent. + (with-output-to-string (*trace-output*) + (fact 3)) + => " + 1 Enter FACT 3 + | 2 Enter FACT 2 + | 3 Enter FACT 1 + | 3 Exit FACT 1 + | 2 Exit FACT 2 + 1 Exit FACT 6" + +See Also:: +.......... + +*terminal-io*, synonym-stream, *note Time:: , *note trace:: , *note +Conditions::, *note Reader::, *note Printer:: + +Notes:: +....... + +The intent of the constraints on the initial value of the I/O +customization variables is to ensure that it is always safe to bind or +assign such a variable to the value of another I/O customization +variable, without unduly restricting implementation flexibility. + + It is common for an implementation to make the initial values of +*debug-io* and *query-io* be the same stream, and to make the initial +values of *error-output* and *standard-output* be the same stream. + + The functions y-or-n-p and yes-or-no-p use query I/O for their input +and output. + + In the normal Lisp read-eval-print loop, input is read from standard +input. Many input functions, including read and read-char, take a +stream argument that defaults to standard input. + + In the normal Lisp read-eval-print loop, output is sent to standard +output. Many output functions, including print and write-char, take a +stream argument that defaults to standard output. + + A program that wants, for example, to divert output to a file should +do so by binding *standard-output*; that way error messages sent to +*error-output* can still get to the user by going through *terminal-io* +(if *error-output* is bound to *terminal-io*), which is usually what is +desired. + + +File: gcl.info, Node: *terminal-io*, Next: stream-error, Prev: *debug-io*, Up: Streams Dictionary + +21.2.54 *terminal-io* [Variable] +-------------------------------- + +Value Type:: +............ + +a bidirectional stream. + +Initial Value:: +............... + +implementation-dependent, but it must be an open stream that is not a +generalized synonym stream to an I/O customization variables but that +might be a generalized synonym stream to the value of some I/O +customization variable. + +Description:: +............. + +The value of *terminal-io*, called terminal I/O, is ordinarily a +bidirectional stream that connects to the user's console. Typically, +writing to this stream would cause the output to appear on a display +screen, for example, and reading from the stream would accept input from +a keyboard. It is intended that standard input functions such as read +and read-char, when used with this stream, cause echoing of the input +into the output side of the stream. The means by which this is +accomplished are implementation-dependent. + + The effect of changing the value of *terminal-io*, either by binding +or assignment, is implementation-defined. + +Examples:: +.......... + + (progn (prin1 'foo) (prin1 'bar *terminal-io*)) + |> FOOBAR + => BAR + (with-output-to-string (*standard-output*) + (prin1 'foo) + (prin1 'bar *terminal-io*)) + |> BAR + => "FOO" + +See Also:: +.......... + +*debug-io*, *error-output*, *query-io*, *standard-input*, +*standard-output*, *trace-output* + + +File: gcl.info, Node: stream-error, Next: stream-error-stream, Prev: *terminal-io*, Up: Streams Dictionary + +21.2.55 stream-error [Condition Type] +------------------------------------- + +Class Precedence List:: +....................... + +stream-error, error, serious-condition, condition, t + +Description:: +............. + +The type stream-error consists of error conditions that are related to +receiving input from or sending output to a stream. The "offending +stream" is initialized by the :stream initialization argument to +make-condition, and is accessed by the function stream-error-stream. + +See Also:: +.......... + +*note stream-error-stream:: + + +File: gcl.info, Node: stream-error-stream, Next: end-of-file, Prev: stream-error, Up: Streams Dictionary + +21.2.56 stream-error-stream [Function] +-------------------------------------- + +'stream-error-stream' condition => stream + +Arguments and Values:: +...................... + +condition--a condition of type stream-error. + + stream--a stream. + +Description:: +............. + +Returns the offending stream of a condition of type stream-error. + +Examples:: +.......... + + (with-input-from-string (s "(FOO") + (handler-case (read s) + (end-of-file (c) + (format nil "~&End of file on ~S." (stream-error-stream c))))) + "End of file on #." + +See Also:: +.......... + +stream-error, *note Conditions:: + + +File: gcl.info, Node: end-of-file, Prev: stream-error-stream, Up: Streams Dictionary + +21.2.57 end-of-file [Condition Type] +------------------------------------ + +Class Precedence List:: +....................... + +end-of-file, stream-error, error, serious-condition, condition, t + +Description:: +............. + +The type end-of-file consists of error conditions related to read +operations that are done on streams that have no more data. + +See Also:: +.......... + +*note stream-error-stream:: + diff --git a/info/gcl.info-8 b/info/gcl.info-8 new file mode 100644 index 0000000..f97cdd0 --- /dev/null +++ b/info/gcl.info-8 @@ -0,0 +1,8650 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: Printer, Next: Reader, Prev: Streams, Up: Top + +22 Printer +********** + +* Menu: + +* The Lisp Printer:: +* The Lisp Pretty Printer:: +* Formatted Output:: +* Printer Dictionary:: + + +File: gcl.info, Node: The Lisp Printer, Next: The Lisp Pretty Printer, Prev: Printer, Up: Printer + +22.1 The Lisp Printer +===================== + +* Menu: + +* Overview of The Lisp Printer:: +* Printer Dispatching:: +* Default Print-Object Methods:: +* Examples of Printer Behavior:: + + +File: gcl.info, Node: Overview of The Lisp Printer, Next: Printer Dispatching, Prev: The Lisp Printer, Up: The Lisp Printer + +22.1.1 Overview of The Lisp Printer +----------------------------------- + +Common Lisp provides a representation of most objects in the form of +printed text called the printed representation. Functions such as print +take an object and send the characters of its printed representation to +a stream. The collection of routines that does this is known as the +(Common Lisp) printer. + + Reading a printed representation typically produces an object that is +equal to the originally printed object. + +* Menu: + +* Multiple Possible Textual Representations:: +* Printer Escaping:: + + +File: gcl.info, Node: Multiple Possible Textual Representations, Next: Printer Escaping, Prev: Overview of The Lisp Printer, Up: Overview of The Lisp Printer + +22.1.1.1 Multiple Possible Textual Representations +.................................................. + +Most objects have more than one possible textual representation. For +example, the positive integer with a magnitude of twenty-seven can be +textually expressed in any of these ways: + + 27 27. #o33 #x1B #b11011 #.(* 3 3 3) 81/3 + + A list containing the two symbols A and B can also be textually +expressed in a variety of ways: + + (A B) (a b) ( a b ) (\A |B|) + (|\A| + B + ) + + In general, + + from the point of view of the Lisp reader, + + wherever whitespace is permissible in a textual representation, any +number of spaces and newlines can appear in standard syntax. + + When a function such as print produces a printed representation, it +must choose from among many possible textual representations. In most +cases, it chooses a program readable representation, but in certain +cases it might use a more compact notation that is not program-readable. + + A number of option variables, called printer control variables , are +provided to permit control of individual aspects of the printed +representation of objects. Figure 22-1 shows the standardized printer +control variables; there might also be implementation-defined printer +control variables. + + *print-array* *print-gensym* *print-pprint-dispatch* + *print-base* *print-length* *print-pretty* + *print-case* *print-level* *print-radix* + *print-circle* *print-lines* *print-readably* + *print-escape* *print-miser-width* *print-right-margin* + + Figure 22-1: Standardized Printer Control Variables + + + In addition to the printer control variables, the following +additional defined names relate to or affect the behavior of the Lisp +printer: + + *package* *read-eval* readtable-case + *read-default-float-format* *readtable* + + Figure 22-2: Additional Influences on the Lisp printer. + + + +File: gcl.info, Node: Printer Escaping, Prev: Multiple Possible Textual Representations, Up: Overview of The Lisp Printer + +22.1.1.2 Printer Escaping +......................... + +The variable *print-escape* controls whether the Lisp printer tries to +produce notations such as escape characters and package prefixes. + + The variable *print-readably* can be used to override many of the +individual aspects controlled by the other printer control variables +when program-readable output is especially important. + + One of the many effects of making the value of *print-readably* be +true is that the Lisp printer behaves as if *print-escape* were also +true. For notational convenience, we say that if the value of either +*print-readably* or *print-escape* is true, then printer escaping is +"enabled"; and we say that if the values of both *print-readably* and +*print-escape* are false, then printer escaping is "disabled". + + +File: gcl.info, Node: Printer Dispatching, Next: Default Print-Object Methods, Prev: Overview of The Lisp Printer, Up: The Lisp Printer + +22.1.2 Printer Dispatching +-------------------------- + +The Lisp printer makes its determination of how to print an object as +follows: + + If the value of *print-pretty* is true, printing is controlled by the +current pprint dispatch table; see *note Pretty Print Dispatch Tables::. + + Otherwise (if the value of *print-pretty* is false), the object's +print-object method is used; see *note Default Print-Object Methods::. + + +File: gcl.info, Node: Default Print-Object Methods, Next: Examples of Printer Behavior, Prev: Printer Dispatching, Up: The Lisp Printer + +22.1.3 Default Print-Object Methods +----------------------------------- + +This section describes the default behavior of print-object methods for +the standardized types. + +* Menu: + +* Printing Numbers:: +* Printing Integers:: +* Printing Ratios:: +* Printing Floats:: +* Printing Complexes:: +* Note about Printing Numbers:: +* Printing Characters:: +* Printing Symbols:: +* Package Prefixes for Symbols:: +* Effect of Readtable Case on the Lisp Printer:: +* Examples of Effect of Readtable Case on the Lisp Printer:: +* Printing Strings:: +* Printing Lists and Conses:: +* Printing Bit Vectors:: +* Printing Other Vectors:: +* Printing Other Arrays:: +* Examples of Printing Arrays:: +* Printing Random States:: +* Printing Pathnames:: +* Printing Structures:: +* Printing Other Objects:: + + +File: gcl.info, Node: Printing Numbers, Next: Printing Integers, Prev: Default Print-Object Methods, Up: Default Print-Object Methods + +22.1.3.1 Printing Numbers +......................... + + +File: gcl.info, Node: Printing Integers, Next: Printing Ratios, Prev: Printing Numbers, Up: Default Print-Object Methods + +22.1.3.2 Printing Integers +.......................... + +Integers are printed in the radix specified by the current output base +in positional notation, most significant digit first. If appropriate, a +radix specifier can be printed; see *print-radix*. If an integer is +negative, a minus sign is printed and then the absolute value of the +integer is printed. The integer zero is represented by the single digit +0 and never has a sign. A decimal point might be printed, depending on +the value of *print-radix*. + + For related information about the syntax of an integer, see *note +Syntax of an Integer::. + + +File: gcl.info, Node: Printing Ratios, Next: Printing Floats, Prev: Printing Integers, Up: Default Print-Object Methods + +22.1.3.3 Printing Ratios +........................ + +Ratios are printed as follows: the absolute value of the numerator is +printed, as for an integer; then a /; then the denominator. The +numerator and denominator are both printed in the radix specified by the +current output base; they are obtained as if by numerator and +denominator, and so ratios are printed in reduced form (lowest terms). +If appropriate, a radix specifier can be printed; see *print-radix*. If +the ratio is negative, a minus sign is printed before the numerator. + + For related information about the syntax of a ratio, see *note Syntax +of a Ratio::. + + +File: gcl.info, Node: Printing Floats, Next: Printing Complexes, Prev: Printing Ratios, Up: Default Print-Object Methods + +22.1.3.4 Printing Floats +........................ + +If the magnitude of the float is either zero or between 10^-3 +(inclusive) and 10^7 (exclusive), it is printed as the integer part of +the number, then a decimal point, followed by the fractional part of the +number; there is always at least one digit on each side of the decimal +point. If the sign of the number (as determined by float-sign) is +negative, then a minus sign is printed before the number. If the format +of the number does not match that specified by +*read-default-float-format*, then the exponent marker for that format +and the digit 0 are also printed. For example, the base of the natural +logarithms as a short float might be printed as 2.71828S0. + + For non-zero magnitudes outside of the range 10^-3 to 10^7, a float +is printed in computerized scientific notation. The representation of +the number is scaled to be between 1 (inclusive) and 10 (exclusive) and +then printed, with one digit before the decimal point and at least one +digit after the decimal point. Next the exponent marker for the format +is printed, except that if the format of the number matches that +specified by *read-default-float-format*, then the exponent marker E is +used. Finally, the power of ten by which the fraction must be +multiplied to equal the original number is printed as a decimal integer. +For example, Avogadro's number as a short float is printed as 6.02S23. + + For related information about the syntax of a float, see *note Syntax +of a Float::. + + +File: gcl.info, Node: Printing Complexes, Next: Note about Printing Numbers, Prev: Printing Floats, Up: Default Print-Object Methods + +22.1.3.5 Printing Complexes +........................... + +A complex is printed as #C, an open parenthesis, the printed +representation of its real part, a space, the printed representation of +its imaginary part, and finally a close parenthesis. + + For related information about the syntax of a complex, see *note +Syntax of a Complex:: and *note Sharpsign C::. + + +File: gcl.info, Node: Note about Printing Numbers, Next: Printing Characters, Prev: Printing Complexes, Up: Default Print-Object Methods + +22.1.3.6 Note about Printing Numbers +.................................... + +The printed representation of a number must not contain escape +characters; see *note Escape Characters and Potential Numbers::. + + +File: gcl.info, Node: Printing Characters, Next: Printing Symbols, Prev: Note about Printing Numbers, Up: Default Print-Object Methods + +22.1.3.7 Printing Characters +............................ + +When printer escaping is disabled, + + a character prints as itself; it is sent directly to the output +stream. + + When printer escaping is enabled, + + then #\ syntax is used. + + When the printer types out the name of a character, it uses the same +table as the #\ reader macro would use; therefore any character name +that is typed out is acceptable as input (in that implementation). If a +non-graphic character has a standardized name_5, that name is preferred +over non-standard names for printing in #\ notation. For the graphic +standard characters, the character itself is always used for printing in +#\ notation--even if the character also has a name_5. + + For details about the #\ reader macro, see *note Sharpsign +Backslash::. + + +File: gcl.info, Node: Printing Symbols, Next: Package Prefixes for Symbols, Prev: Printing Characters, Up: Default Print-Object Methods + +22.1.3.8 Printing Symbols +......................... + +When printer escaping is disabled, + + only the characters of the symbol's name are output + + (but the case in which to print characters in the name is controlled +by *print-case*; see *note Effect of Readtable Case on the Lisp +Printer::). + + The remainder of this section applies only + + when printer escaping is enabled. + + When printing a symbol, the printer inserts enough single escape +and/or multiple escape characters (backslashes and/or vertical-bars) so +that if read were called with the same *readtable* and with *read-base* +bound to the current output base, it would return the same symbol (if it +is not apparently uninterned) or an uninterned symbol with the same +print name (otherwise). + + For example, if the value of *print-base* were 16 when printing the +symbol face, it would have to be printed as \FACE or \Face or |FACE|, +because the token face would be read as a hexadecimal number (decimal +value 64206) if the value of *read-base* were 16. + + For additional restrictions concerning characters with nonstandard +syntax types in the current readtable, see the variable *print-readably* + + For information about how the Lisp reader parses symbols, see *note +Symbols as Tokens:: and *note Sharpsign Colon::. + + nil might be printed as () + + when *print-pretty* is true and printer escaping is enabled. + + +File: gcl.info, Node: Package Prefixes for Symbols, Next: Effect of Readtable Case on the Lisp Printer, Prev: Printing Symbols, Up: Default Print-Object Methods + +22.1.3.9 Package Prefixes for Symbols +..................................... + +Package prefixes are printed if necessary. The rules for package +prefixes are as follows. When the symbol is printed, if it is in the +KEYWORD package, then it is printed with a preceding colon; otherwise, +if it is accessible in the current package, it is printed without any +package prefix; otherwise, it is printed with a package prefix. + + A symbol that is apparently uninterned is printed preceded by "#:" + + if *print-gensym* is true and printer escaping is enabled; if +*print-gensym* is false or printer escaping is disabled, + + then the symbol is printed without a prefix, as if it were in the +current package. + + Because the #: syntax does not intern the following symbol, it is +necessary to use circular-list syntax if *print-circle* is true and the +same uninterned symbol appears several times in an expression to be +printed. For example, the result of + + (let ((x (make-symbol "FOO"))) (list x x)) + + would be printed as (#:foo #:foo) if *print-circle* were false, but +as (#1=#:foo #1#) if *print-circle* were true. + + A summary of the preceding package prefix rules follows: + +foo:bar + foo:bar is printed when symbol bar is external in its home package + foo and is not accessible in the current package. + +foo::bar + foo::bar is printed when bar is internal in its home package foo + and is not accessible in the current package. + +:bar + :bar is printed when the home package of bar is the KEYWORD + package. + +#:bar + #:bar is printed when bar is apparently uninterned, even in the + pathological case that bar has no home package but is nevertheless + somehow accessible in the current package. + + +File: gcl.info, Node: Effect of Readtable Case on the Lisp Printer, Next: Examples of Effect of Readtable Case on the Lisp Printer, Prev: Package Prefixes for Symbols, Up: Default Print-Object Methods + +22.1.3.10 Effect of Readtable Case on the Lisp Printer +...................................................... + +When printer escaping is disabled, or the characters under consideration +are not already quoted specifically by single escape or multiple escape +syntax, + + the readtable case of the current readtable affects the way the Lisp +printer writes symbols in the following ways: + +:upcase + When the readtable case is :upcase, uppercase characters are + printed in the case specified by *print-case*, and lowercase + characters are printed in their own case. + +:downcase + When the readtable case is :downcase, uppercase characters are + printed in their own case, and lowercase characters are printed in + the case specified by *print-case*. + +:preserve + When the readtable case is :preserve, all alphabetic characters are + printed in their own case. + +:invert + When the readtable case is :invert, the case of all alphabetic + characters in single case symbol names is inverted. Mixed-case + symbol names are printed as is. + + The rules for escaping alphabetic characters in symbol names are +affected by the readtable-case + + if printer escaping is enabled. + + Alphabetic characters are escaped as follows: + +:upcase + When the readtable case is :upcase, all lowercase characters must + be escaped. + +:downcase + When the readtable case is :downcase, all uppercase characters must + be escaped. + +:preserve + When the readtable case is :preserve, no alphabetic characters need + be escaped. + +:invert + When the readtable case is :invert, no alphabetic characters need + be escaped. + + +File: gcl.info, Node: Examples of Effect of Readtable Case on the Lisp Printer, Next: Printing Strings, Prev: Effect of Readtable Case on the Lisp Printer, Up: Default Print-Object Methods + +22.1.3.11 Examples of Effect of Readtable Case on the Lisp Printer +.................................................................. + + (defun test-readtable-case-printing () + (let ((*readtable* (copy-readtable nil)) + (*print-case* *print-case*)) + (format t "READTABLE-CASE *PRINT-CASE* Symbol-name Output~ + ~ + ~ + (dolist (readtable-case '(:upcase :downcase :preserve :invert)) + (setf (readtable-case *readtable*) readtable-case) + (dolist (print-case '(:upcase :downcase :capitalize)) + (dolist (symbol '(|ZEBRA| |Zebra| |zebra|)) + (setq *print-case* print-case) + (format t "~&:~A~15T:~A~29T~A~42T~A" + (string-upcase readtable-case) + (string-upcase print-case) + (symbol-name symbol) + (prin1-to-string symbol))))))) + + The output from (test-readtable-case-printing) should be as follows: + + READTABLE-CASE *PRINT-CASE* Symbol-name Output + -------------------------------------------------- + :UPCASE :UPCASE ZEBRA ZEBRA + :UPCASE :UPCASE Zebra |Zebra| + :UPCASE :UPCASE zebra |zebra| + :UPCASE :DOWNCASE ZEBRA zebra + :UPCASE :DOWNCASE Zebra |Zebra| + :UPCASE :DOWNCASE zebra |zebra| + :UPCASE :CAPITALIZE ZEBRA Zebra + :UPCASE :CAPITALIZE Zebra |Zebra| + :UPCASE :CAPITALIZE zebra |zebra| + :DOWNCASE :UPCASE ZEBRA |ZEBRA| + :DOWNCASE :UPCASE Zebra |Zebra| + :DOWNCASE :UPCASE zebra ZEBRA + :DOWNCASE :DOWNCASE ZEBRA |ZEBRA| + :DOWNCASE :DOWNCASE Zebra |Zebra| + :DOWNCASE :DOWNCASE zebra zebra + :DOWNCASE :CAPITALIZE ZEBRA |ZEBRA| + :DOWNCASE :CAPITALIZE Zebra |Zebra| + :DOWNCASE :CAPITALIZE zebra Zebra + :PRESERVE :UPCASE ZEBRA ZEBRA + :PRESERVE :UPCASE Zebra Zebra + :PRESERVE :UPCASE zebra zebra + :PRESERVE :DOWNCASE ZEBRA ZEBRA + :PRESERVE :DOWNCASE Zebra Zebra + :PRESERVE :DOWNCASE zebra zebra + :PRESERVE :CAPITALIZE ZEBRA ZEBRA + :PRESERVE :CAPITALIZE Zebra Zebra + :PRESERVE :CAPITALIZE zebra zebra + :INVERT :UPCASE ZEBRA zebra + :INVERT :UPCASE Zebra Zebra + :INVERT :UPCASE zebra ZEBRA + :INVERT :DOWNCASE ZEBRA zebra + :INVERT :DOWNCASE Zebra Zebra + :INVERT :DOWNCASE zebra ZEBRA + :INVERT :CAPITALIZE ZEBRA zebra + :INVERT :CAPITALIZE Zebra Zebra + :INVERT :CAPITALIZE zebra ZEBRA + + +File: gcl.info, Node: Printing Strings, Next: Printing Lists and Conses, Prev: Examples of Effect of Readtable Case on the Lisp Printer, Up: Default Print-Object Methods + +22.1.3.12 Printing Strings +.......................... + +The characters of the string are output in order. + + If printer escaping is enabled, + + a double-quote is output before and after, and all double-quotes and +single escapes are preceded by backslash. The printing of strings is +not affected by *print-array*. Only the active elements of the string +are printed. + + For information on how the Lisp reader parses strings, see *note +Double-Quote::. + + +File: gcl.info, Node: Printing Lists and Conses, Next: Printing Bit Vectors, Prev: Printing Strings, Up: Default Print-Object Methods + +22.1.3.13 Printing Lists and Conses +................................... + +Wherever possible, list notation is preferred over dot notation. +Therefore the following algorithm is used to print a cons x: + +1. + A left-parenthesis is printed. + +2. + The car of x is printed. + +3. + If the cdr of x is itself a cons, it is made to be the current cons + (i.e., x becomes that cons), + + a space + + is printed, and step 2 is re-entered. + +4. + If the cdr of x is not null, + + a space, + + a dot, + + a space, + + and the cdr of x are printed. + +5. + A right-parenthesis is printed. + + Actually, the above algorithm is only used when *print-pretty* is +false. When *print-pretty* is true (or when pprint is used), additional +whitespace_1 may replace the use of a single space, and a more elaborate +algorithm with similar goals but more presentational flexibility is +used; see *note Printer Dispatching::. + + Although the two expressions below are equivalent, and the reader +accepts either one and produces the same cons, the printer always prints +such a cons in the second form. + + (a . (b . ((c . (d . nil)) . (e . nil)))) + (a b (c d) e) + + The printing of conses is affected by *print-level*, *print-length*, +and *print-circle*. + + Following are examples of printed representations of lists: + + (a . b) ;A dotted pair of a and b + (a.b) ;A list of one element, the symbol named a.b + (a. b) ;A list of two elements a. and b + (a .b) ;A list of two elements a and .b + (a b . c) ;A dotted list of a and b with c at the end; two conses + .iot ;The symbol whose name is .iot + (. b) ;Invalid -- an error is signaled if an attempt is made to read + ;this syntax. + (a .) ;Invalid -- an error is signaled. + (a .. b) ;Invalid -- an error is signaled. + (a . . b) ;Invalid -- an error is signaled. + (a b c ...) ;Invalid -- an error is signaled. + (a \. b) ;A list of three elements a, ., and b + (a |.| b) ;A list of three elements a, ., and b + (a \... b) ;A list of three elements a, ..., and b + (a |...| b) ;A list of three elements a, ..., and b + + For information on how the Lisp reader parses lists and conses, see +*note Left-Parenthesis::. + + +File: gcl.info, Node: Printing Bit Vectors, Next: Printing Other Vectors, Prev: Printing Lists and Conses, Up: Default Print-Object Methods + +22.1.3.14 Printing Bit Vectors +.............................. + +A bit vector is printed as #* followed by the bits of the bit vector in +order. If *print-array* is false, then the bit vector is printed in a +format (using #<) that is concise but not readable. Only the active +elements of the bit vector are printed. + + [Reviewer Note by Barrett: Need to provide for #5*0 as an alternate +notation for #*00000.] + + For information on Lisp reader parsing of bit vectors, see *note +Sharpsign Asterisk::. + + +File: gcl.info, Node: Printing Other Vectors, Next: Printing Other Arrays, Prev: Printing Bit Vectors, Up: Default Print-Object Methods + +22.1.3.15 Printing Other Vectors +................................ + +If *print-array* is true and *print-readably* is false, any + + vector other than a string or bit vector is printed using +general-vector syntax; this means that information about specialized +vector representations does not appear. The printed representation of a +zero-length vector is #(). The printed representation of a +non-zero-length vector begins with #(. Following that, the first +element of the vector is printed. + + If there are any other elements, they are printed in turn, with each +such additional element preceded by a space if *print-pretty* is false, +or whitespace_1 if *print-pretty* is true. + + A right-parenthesis after the last element terminates the printed +representation of the vector. The printing of vectors is affected by +*print-level* and *print-length*. If the vector has a fill pointer, +then only those elements below the fill pointer are printed. + + If both *print-array* and *print-readably* are false, + + the vector is not printed as described above, but in a format (using +#<) that is concise but not readable. + + If *print-readably* is true, the vector prints in an +implementation-defined manner; see the variable *print-readably*. + + For information on how the Lisp reader parses these "other vectors," +see *note Sharpsign Left-Parenthesis::. + + +File: gcl.info, Node: Printing Other Arrays, Next: Examples of Printing Arrays, Prev: Printing Other Vectors, Up: Default Print-Object Methods + +22.1.3.16 Printing Other Arrays +............................... + +If *print-array* is true and *print-readably* is false, any + + array other than a vector is printed using #nA format. Let n be the +rank of the array. Then # is printed, then n as a decimal integer, then +A, then n open parentheses. Next the elements are scanned in row-major +order, using write on each element, and separating elements from each +other with whitespace_1. The array's dimensions are numbered 0 to n-1 +from left to right, and are enumerated with the rightmost index changing +fastest. Every time the index for dimension j is incremented, the +following actions are taken: + +* + If j < n-1, then a close parenthesis is printed. + +* + If incrementing the index for dimension j caused it to equal + dimension j, that index is reset to zero and the index for + dimension j-1 is incremented (thereby performing these three steps + recursively), unless j=0, in which case the entire algorithm is + terminated. If incrementing the index for dimension j did not + cause it to equal dimension j, then a space is printed. + +* + If j < n-1, then an open parenthesis is printed. + + This causes the contents to be printed in a format suitable for +:initial-contents to make-array. The lists effectively printed by this +procedure are subject to truncation by *print-level* and *print-length*. + + If the array is of a specialized type, containing bits or characters, +then the innermost lists generated by the algorithm given above can +instead be printed using bit-vector or string syntax, provided that +these innermost lists would not be subject to truncation by +*print-length*. + + If both *print-array* and *print-readably* are false, + + then the array is printed in a format (using #<) that is concise but +not readable. + + If *print-readably* is true, the array prints in an +implementation-defined manner; see the variable *print-readably*. + + In particular, this may be important for arrays having some dimension +0. + + For information on how the Lisp reader parses these "other arrays," +see *note Sharpsign A::. + + +File: gcl.info, Node: Examples of Printing Arrays, Next: Printing Random States, Prev: Printing Other Arrays, Up: Default Print-Object Methods + +22.1.3.17 Examples of Printing Arrays +..................................... + + (let ((a (make-array '(3 3))) + (*print-pretty* t) + (*print-array* t)) + (dotimes (i 3) (dotimes (j 3) (setf (aref a i j) (format nil "<~D,~D>" i j)))) + (print a) + (print (make-array 9 :displaced-to a))) + |> #2A(("<0,0>" "<0,1>" "<0,2>") + |> ("<1,0>" "<1,1>" "<1,2>") + |> ("<2,0>" "<2,1>" "<2,2>")) + |> #("<0,0>" "<0,1>" "<0,2>" "<1,0>" "<1,1>" "<1,2>" "<2,0>" "<2,1>" "<2,2>") + => # + + +File: gcl.info, Node: Printing Random States, Next: Printing Pathnames, Prev: Examples of Printing Arrays, Up: Default Print-Object Methods + +22.1.3.18 Printing Random States +................................ + +A specific syntax for printing objects of type random-state is not +specified. However, every implementation must arrange to print a random +state object in such a way that, within the same implementation, read +can construct from the printed representation a copy of the random state +object as if the copy had been made by make-random-state. + + If the type random state is effectively implemented by using the +machinery for defstruct, the usual structure syntax can then be used for +printing random state objects; one might look something like + + #S(RANDOM-STATE :DATA #(14 49 98436589 786345 8734658324 ... )) + + where the components are implementation-dependent. + + +File: gcl.info, Node: Printing Pathnames, Next: Printing Structures, Prev: Printing Random States, Up: Default Print-Object Methods + +22.1.3.19 Printing Pathnames +............................ + +When printer escaping is enabled, + + the syntax #P"..." is how a pathname is printed by write and the +other functions herein described. The "..." is the namestring +representation of the pathname. + + When printer escaping is disabled, + + write writes a pathname P by writing (namestring P) instead. + + For information on how the Lisp reader parses pathnames, see *note +Sharpsign P::. + + +File: gcl.info, Node: Printing Structures, Next: Printing Other Objects, Prev: Printing Pathnames, Up: Default Print-Object Methods + +22.1.3.20 Printing Structures +............................. + +By default, a structure of type S is printed using #S syntax. This +behavior can be customized by specifying a :print-function or +:print-object option to the defstruct form that defines S, or by writing +a print-object method that is specialized for objects of type S. + + Different structures might print out in different ways; the default +notation for structures is: + + #S(structure-name {slot-key slot-value}*) + + where #S indicates structure syntax, structure-name is a structure +name, each slot-key is an initialization argument name for a slot in the +structure, and each corresponding slot-value is a representation of the +object in that slot. + + For information on how the Lisp reader parses structures, see *note +Sharpsign S::. + + +File: gcl.info, Node: Printing Other Objects, Prev: Printing Structures, Up: Default Print-Object Methods + +22.1.3.21 Printing Other Objects +................................ + +Other objects are printed in an implementation-dependent manner. It is +not required that an implementation print those objects readably. + + For example, hash tables, readtables, packages, streams, and +functions might not print readably. + + A common notation to use in this circumstance is #<...>. Since #< is +not readable by the Lisp reader, the precise format of the text which +follows is not important, but a common format to use is that provided by +the print-unreadable-object macro. + + For information on how the Lisp reader treats this notation, see +*note Sharpsign Less-Than-Sign::. For information on how to notate +objects that cannot be printed readably, see *note Sharpsign Dot::. + + +File: gcl.info, Node: Examples of Printer Behavior, Prev: Default Print-Object Methods, Up: The Lisp Printer + +22.1.4 Examples of Printer Behavior +----------------------------------- + + (let ((*print-escape* t)) (fresh-line) (write #\a)) + |> #\a + => #\a + (let ((*print-escape* nil) (*print-readably* nil)) + (fresh-line) + (write #\a)) + |> a + => #\a + (progn (fresh-line) (prin1 #\a)) + |> #\a + => #\a + (progn (fresh-line) (print #\a)) + |> + |> #\a + => #\a + (progn (fresh-line) (princ #\a)) + |> a + => #\a + + (dolist (val '(t nil)) + (let ((*print-escape* val) (*print-readably* val)) + (print '#\a) + (prin1 #\a) (write-char #\Space) + (princ #\a) (write-char #\Space) + (write #\a))) + |> #\a #\a a #\a + |> #\a #\a a a + => NIL + + (progn (fresh-line) (write '(let ((a 1) (b 2)) (+ a b)))) + |> (LET ((A 1) (B 2)) (+ A B)) + => (LET ((A 1) (B 2)) (+ A B)) + + (progn (fresh-line) (pprint '(let ((a 1) (b 2)) (+ a b)))) + |> (LET ((A 1) + |> (B 2)) + |> (+ A B)) + => (LET ((A 1) (B 2)) (+ A B)) + + (progn (fresh-line) + (write '(let ((a 1) (b 2)) (+ a b)) :pretty t)) + |> (LET ((A 1) + |> (B 2)) + |> (+ A B)) + => (LET ((A 1) (B 2)) (+ A B)) + + (with-output-to-string (s) + (write 'write :stream s) + (prin1 'prin1 s)) + => "WRITEPRIN1" + + +File: gcl.info, Node: The Lisp Pretty Printer, Next: Formatted Output, Prev: The Lisp Printer, Up: Printer + +22.2 The Lisp Pretty Printer +============================ + +* Menu: + +* Pretty Printer Concepts:: +* Examples of using the Pretty Printer:: +* Notes about the Pretty Printer`s Background:: + + +File: gcl.info, Node: Pretty Printer Concepts, Next: Examples of using the Pretty Printer, Prev: The Lisp Pretty Printer, Up: The Lisp Pretty Printer + +22.2.1 Pretty Printer Concepts +------------------------------ + +The facilities provided by the pretty printer permit programs to +redefine the way in which code is displayed, and allow the full power of +pretty printing to be applied to complex combinations of data +structures. + + Whether any given style of output is in fact "pretty" is inherently a +somewhat subjective issue. However, since the effect of the pretty +printer can be customized by conforming programs, the necessary +flexibility is provided for individual programs to achieve an arbitrary +degree of aesthetic control. + + By providing direct access to the mechanisms within the pretty +printer that make dynamic decisions about layout, the macros and +functions pprint-logical-block, pprint-newline, and pprint-indent make +it possible to specify pretty printing layout rules as a part of any +function that produces output. They also make it very easy for the +detection of circularity and sharing, and abbreviation based on length +and nesting depth to be supported by the function. + + The pretty printer is driven entirely by dispatch based on the value +of *print-pprint-dispatch*. The function set-pprint-dispatch makes it +possible for conforming programs to associate new pretty printing +functions with a type. + +* Menu: + +* Dynamic Control of the Arrangement of Output:: +* Format Directive Interface:: +* Compiling Format Strings:: +* Pretty Print Dispatch Tables:: +* Pretty Printer Margins:: + + +File: gcl.info, Node: Dynamic Control of the Arrangement of Output, Next: Format Directive Interface, Prev: Pretty Printer Concepts, Up: Pretty Printer Concepts + +22.2.1.1 Dynamic Control of the Arrangement of Output +..................................................... + +The actions of the pretty printer when a piece of output is too large to +fit in the space available can be precisely controlled. Three concepts +underlie the way these operations work--logical blocks , conditional +newlines , and sections . Before proceeding further, it is important to +define these terms. + + The first line of Figure 22-3 shows a schematic piece of output. +Each of the characters in the output is represented by "-". The +positions of conditional newlines are indicated by digits. The +beginnings and ends of logical blocks are indicated by "<" and ">" +respectively. + + The output as a whole is a logical block and the outermost section. +This section is indicated by the 0's on the second line of Figure 1. +Logical blocks nested within the output are specified by the macro +pprint-logical-block. Conditional newline positions are specified by +calls to pprint-newline. Each conditional newline defines two sections +(one before it and one after it) and is associated with a third (the +section immediately containing it). + + The section after a conditional newline consists of: all the output +up to, but not including, (a) the next conditional newline immediately +contained in the same logical block; or if (a) is not applicable, (b) +the next newline that is at a lesser level of nesting in logical blocks; +or if (b) is not applicable, (c) the end of the output. + + The section before a conditional newline consists of: all the output +back to, but not including, (a) the previous conditional newline that is +immediately contained in the same logical block; or if (a) is not +applicable, (b) the beginning of the immediately containing logical +block. The last four lines in Figure 1 indicate the sections before and +after the four conditional newlines. + + The section immediately containing a conditional newline is the +shortest section that contains the conditional newline in question. In +Figure 22-3, the first conditional newline is immediately contained in +the section marked with 0's, the second and third conditional newlines +are immediately contained in the section before the fourth conditional +newline, and the fourth conditional newline is immediately contained in +the section after the first conditional newline. + + <-1---<--<--2---3->--4-->-> + 000000000000000000000000000 + 11 111111111111111111111111 + 22 222 + 333 3333 + 44444444444444 44444 + + Figure 22-2: Example of Logical Blocks, Conditional Newlines, and Sections + + Whenever possible, the pretty printer displays the entire contents of +a section on a single line. However, if the section is too long to fit +in the space available, line breaks are inserted at conditional newline +positions within the section. + + +File: gcl.info, Node: Format Directive Interface, Next: Compiling Format Strings, Prev: Dynamic Control of the Arrangement of Output, Up: Pretty Printer Concepts + +22.2.1.2 Format Directive Interface +................................... + +The primary interface to operations for dynamically determining the +arrangement of output is provided through the functions and macros of +the pretty printer. Figure 22-3 shows the defined names related to +pretty printing. + + *print-lines* pprint-dispatch pprint-pop + *print-miser-width* pprint-exit-if-list-exhausted pprint-tab + *print-pprint-dispatch* pprint-fill pprint-tabular + *print-right-margin* pprint-indent set-pprint-dispatch + copy-pprint-dispatch pprint-linear write + format pprint-logical-block + formatter pprint-newline + + Figure 22-3: Defined names related to pretty printing. + + + Figure 22-4 identifies a set of format directives which serve as an +alternate interface to the same pretty printing operations in a more +textually compact form. + + ~I ~W ~<...~:> + ~:T ~/.../ ~_ + + Figure 22-4: Format directives related to Pretty Printing + + + +File: gcl.info, Node: Compiling Format Strings, Next: Pretty Print Dispatch Tables, Prev: Format Directive Interface, Up: Pretty Printer Concepts + +22.2.1.3 Compiling Format Strings +................................. + +A format string is essentially a program in a special-purpose language +that performs printing, and that is interpreted by the function format. +The formatter macro provides the efficiency of using a compiled function +to do that same printing but without losing the textual compactness of +format strings. + + A format control is either a format string or a function that was +returned by the the formatter macro. + + +File: gcl.info, Node: Pretty Print Dispatch Tables, Next: Pretty Printer Margins, Prev: Compiling Format Strings, Up: Pretty Printer Concepts + +22.2.1.4 Pretty Print Dispatch Tables +..................................... + +A pprint dispatch table is a mapping from keys to pairs of values. Each +key is a type specifier. The values associated with a key are a +"function" (specifically, a function designator or nil) and a "numerical +priority" (specifically, a real). Basic insertion and retrieval is done +based on the keys with the equality of keys being tested by equal. + + When *print-pretty* is true, the current pprint dispatch table (in +*print-pprint-dispatch*) controls how objects are printed. The +information in this table takes precedence over all other mechanisms for +specifying how to print objects. In particular, it has priority over +user-defined print-object methods + + because the current pprint dispatch table is consulted first. + + The function is chosen from the current pprint dispatch table by +finding the highest priority function that is associated with a type +specifier that matches the object; if there is more than one such +function, it is implementation-dependent which is used. + + However, if there is no information in the table about how to pretty +print a particular kind of object, a function is invoked which uses +print-object to print the object. The value of *print-pretty* is still +true when this function is called, and individual methods for +print-object might still elect to produce output in a special format +conditional on the value of *print-pretty*. + + +File: gcl.info, Node: Pretty Printer Margins, Prev: Pretty Print Dispatch Tables, Up: Pretty Printer Concepts + +22.2.1.5 Pretty Printer Margins +............................... + +A primary goal of pretty printing is to keep the output between a pair +of margins. The column where the output begins is taken as the left +margin. If the current column cannot be determined at the time output +begins, the left margin is assumed to be zero. The right margin is +controlled by *print-right-margin*. + + +File: gcl.info, Node: Examples of using the Pretty Printer, Next: Notes about the Pretty Printer`s Background, Prev: Pretty Printer Concepts, Up: The Lisp Pretty Printer + +22.2.2 Examples of using the Pretty Printer +------------------------------------------- + +As an example of the interaction of logical blocks, conditional +newlines, and indentation, consider the function simple-pprint-defun +below. This function prints out lists whose cars are defun in the +standard way assuming that the list has exactly length 4. + + (defun simple-pprint-defun (*standard-output* list) + (pprint-logical-block (*standard-output* list :prefix "(" :suffix ")") + (write (first list)) + (write-char #\Space) + (pprint-newline :miser) + (pprint-indent :current 0) + (write (second list)) + (write-char #\Space) + (pprint-newline :fill) + (write (third list)) + (pprint-indent :block 1) + (write-char #\Space) + (pprint-newline :linear) + (write (fourth list)))) + + Suppose that one evaluates the following: + + (simple-pprint-defun *standard-output* '(defun prod (x y) (* x y))) + + If the line width available is greater than or equal to 26, then all +of the output appears on one line. If the line width available is +reduced to 25, a line break is inserted at the linear-style conditional +newline + + before the expression (* x y), producing the output shown. The +(pprint-indent :block 1) causes (* x y) to be printed at a relative +indentation of 1 in the logical block. + + (DEFUN PROD (X Y) + (* X Y)) + + If the line width available is 15, a line break is also inserted at +the fill style conditional newline before the argument list. The call +on (pprint-indent :current 0) causes the argument list to line up under +the function name. + + (DEFUN PROD + (X Y) + (* X Y)) + + If *print-miser-width* were greater than or equal to 14, the example +output above would have been as follows, because all indentation changes +are ignored in miser mode and line breaks are inserted at miser-style +conditional newlines. + + (DEFUN + PROD + (X Y) + (* X Y)) + + As an example of a per-line prefix, consider that evaluating the +following produces the output shown with a line width of 20 and +*print-miser-width* of nil. + + (pprint-logical-block (*standard-output* nil :per-line-prefix ";;; ") + (simple-pprint-defun *standard-output* '(defun prod (x y) (* x y)))) + + ;;; (DEFUN PROD + ;;; (X Y) + ;;; (* X Y)) + + As a more complex (and realistic) example, consider the function +pprint-let below. This specifies how to print a let form in the +traditional style. It is more complex than the example above, because +it has to deal with nested structure. Also, unlike the example above it +contains complete code to readably print any possible list that begins +with the symbol let. The outermost pprint-logical-block form handles +the printing of the input list as a whole and specifies that parentheses +should be printed in the output. The second pprint-logical-block form +handles the list of binding pairs. Each pair in the list is itself +printed by the innermost pprint-logical-block. (A loop form is used +instead of merely decomposing the pair into two objects so that readable +output will be produced no matter whether the list corresponding to the +pair has one element, two elements, or (being malformed) has more than +two elements.) A space and a fill-style conditional newline + + are placed after each pair except the last. The loop at the end of +the topmost pprint-logical-block form prints out the forms in the body +of the let form separated by spaces and linear-style conditional +newlines. + + (defun pprint-let (*standard-output* list) + (pprint-logical-block (nil list :prefix "(" :suffix ")") + (write (pprint-pop)) + (pprint-exit-if-list-exhausted) + (write-char #\Space) + (pprint-logical-block (nil (pprint-pop) :prefix "(" :suffix ")") + (pprint-exit-if-list-exhausted) + (loop (pprint-logical-block (nil (pprint-pop) :prefix "(" :suffix ")") + (pprint-exit-if-list-exhausted) + (loop (write (pprint-pop)) + (pprint-exit-if-list-exhausted) + (write-char #\Space) + (pprint-newline :linear))) + (pprint-exit-if-list-exhausted) + (write-char #\Space) + (pprint-newline :fill))) + (pprint-indent :block 1) + (loop (pprint-exit-if-list-exhausted) + (write-char #\Space) + (pprint-newline :linear) + (write (pprint-pop))))) + + Suppose that one evaluates the following with *print-level* being 4, +and *print-circle* being true. + + (pprint-let *standard-output* + '#1=(let (x (*print-length* (f (g 3))) + (z . 2) (k (car y))) + (setq x (sqrt z)) #1#)) + + If the line length is greater than or equal to 77, the output +produced appears on one line. However, if the line length is 76, line +breaks are inserted at the linear-style conditional newlines separating +the forms in the body and the output below is produced. Note that, the +degenerate binding pair x is printed readably even though it fails to be +a list; a depth abbreviation marker is printed in place of (g 3); the +binding pair (z . 2) is printed readably even though it is not a proper +list; and appropriate circularity markers are printed. + + #1=(LET (X (*PRINT-LENGTH* (F #)) (Z . 2) (K (CAR Y))) + (SETQ X (SQRT Z)) + #1#) + + If the line length is reduced to 35, a line break is inserted at one +of the fill-style conditional newlines separating the binding pairs. + + #1=(LET (X (*PRINT-PRETTY* (F #)) + (Z . 2) (K (CAR Y))) + (SETQ X (SQRT Z)) + #1#) + + Suppose that the line length is further reduced to 22 and +*print-length* is set to 3. In this situation, line breaks are inserted +after both the first and second binding pairs. In addition, the second +binding pair is itself broken across two lines. Clause (b) of the +description of fill-style conditional newlines (see the function +pprint-newline) prevents the binding pair (z . 2) from being printed at +the end of the third line. Note that the length abbreviation hides the +circularity from view and therefore the printing of circularity markers +disappears. + + (LET (X + (*PRINT-LENGTH* + (F #)) + (Z . 2) ...) + (SETQ X (SQRT Z)) + ...) + + The next function prints a vector using "#(...)" notation. + + (defun pprint-vector (*standard-output* v) + (pprint-logical-block (nil nil :prefix "#(" :suffix ")") + (let ((end (length v)) (i 0)) + (when (plusp end) + (loop (pprint-pop) + (write (aref v i)) + (if (= (incf i) end) (return nil)) + (write-char #\Space) + (pprint-newline :fill)))))) + + Evaluating the following with a line length of 15 produces the output +shown. + + (pprint-vector *standard-output* '#(12 34 567 8 9012 34 567 89 0 1 23)) + + #(12 34 567 8 + 9012 34 567 + 89 0 1 23) + + As examples of the convenience of specifying pretty printing with +format strings, consider that the functions simple-pprint-defun and +pprint-let used as examples above can be compactly defined as follows. +(The function pprint-vector cannot be defined using format because the +data structure it traverses is not a list.) + + (defun simple-pprint-defun (*standard-output* list) + (format T "~:<~W ~@_~:I~W ~:_~W~1I ~_~W~:>" list)) + + (defun pprint-let (*standard-output* list) + (format T "~:<~W~^~:<~@{~:<~@{~W~^~_~}~:>~^~:_~}~:>~1I~@{~^~_~W~}~:>" list)) + + In the following example, the first form restores +*print-pprint-dispatch* to the equivalent of its initial value. The +next two forms then set up a special way to pretty print ratios. Note +that the more specific type specifier has to be associated with a higher +priority. + + (setq *print-pprint-dispatch* (copy-pprint-dispatch nil)) + + (set-pprint-dispatch 'ratio + #'(lambda (s obj) + (format s "#.(/ ~W ~W)" + (numerator obj) (denominator obj)))) + + (set-pprint-dispatch '(and ratio (satisfies minusp)) + #'(lambda (s obj) + (format s "#.(- (/ ~W ~W))" + (- (numerator obj)) (denominator obj))) + 5) + + (pprint '(1/3 -2/3)) + (#.(/ 1 3) #.(- (/ 2 3))) + + The following two forms illustrate the definition of pretty printing +functions for types of code. The first form illustrates how to specify +the traditional method for printing quoted objects using single-quote. +Note the care taken to ensure that data lists that happen to begin with +quote will be printed readably. The second form specifies that lists +beginning with the symbol my-let should print the same way that lists +beginning with let print when the initial pprint dispatch table is in +effect. + + (set-pprint-dispatch '(cons (member quote)) () + #'(lambda (s list) + (if (and (consp (cdr list)) (null (cddr list))) + (funcall (formatter "'~W") s (cadr list)) + (pprint-fill s list)))) + + (set-pprint-dispatch '(cons (member my-let)) + (pprint-dispatch '(let) nil)) + + The next example specifies a default method for printing lists that +do not correspond to function calls. Note that the functions +pprint-linear, pprint-fill, and pprint-tabular are all defined with +optional colon-p and at-sign-p arguments so that they can be used as +pprint dispatch functions as well as ~/.../ functions. + + (set-pprint-dispatch '(cons (not (and symbol (satisfies fboundp)))) + #'pprint-fill -5) + + ;; Assume a line length of 9 + (pprint '(0 b c d e f g h i j k)) + (0 b c d + e f g h + i j k) + + This final example shows how to define a pretty printing function for +a user defined data structure. + + (defstruct family mom kids) + + (set-pprint-dispatch 'family + #'(lambda (s f) + (funcall (formatter "~@<#<~;~W and ~2I~_~/pprint-fill/~;>~:>") + s (family-mom f) (family-kids f)))) + + The pretty printing function for the structure family specifies how +to adjust the layout of the output so that it can fit aesthetically into +a variety of line widths. In addition, it obeys the printer control +variables *print-level*, *print-length*, *print-lines*, *print-circle* +and *print-escape*, and can tolerate several different kinds of +malformity in the data structure. The output below shows what is +printed out with a right margin of 25, *print-pretty* being true, +*print-escape* being false, and a malformed kids list. + + (write (list 'principal-family + (make-family :mom "Lucy" + :kids '("Mark" "Bob" . "Dan"))) + :right-margin 25 :pretty T :escape nil :miser-width nil) + (PRINCIPAL-FAMILY + #) + + Note that a pretty printing function for a structure is different +from the structure's print-object method. While print-object methods +are permanently associated with a structure, pretty printing functions +are stored in pprint dispatch tables and can be rapidly changed to +reflect different printing needs. If there is no pretty printing +function for a structure in the current pprint dispatch table, its +print-object method is used instead. + + +File: gcl.info, Node: Notes about the Pretty Printer`s Background, Prev: Examples of using the Pretty Printer, Up: The Lisp Pretty Printer + +22.2.3 Notes about the Pretty Printer's Background +-------------------------------------------------- + +For a background reference to the abstract concepts detailed in this +section, see XP: A Common Lisp Pretty Printing System. The details of +that paper are not binding on this document, but may be helpful in +establishing a conceptual basis for understanding this material. + + +File: gcl.info, Node: Formatted Output, Next: Printer Dictionary, Prev: The Lisp Pretty Printer, Up: Printer + +22.3 Formatted Output +===================== + +[Editorial Note by KMP: This is transplanted from FORMAT and will need a +bit of work before it looks good standing alone. Bear with me.] + + format is useful for producing nicely formatted text, producing +good-looking messages, and so on. format can generate and return a +string or output to destination. + + The control-string argument to format is actually a format control. +That is, it can be either a format string or a function, for example a +function returned by the formatter macro. + + If it is a function, the function is called with the appropriate +output stream as its first argument and the data arguments to format as +its remaining arguments. The function should perform whatever output is +necessary and return the unused tail of the arguments (if any). + + The compilation process performed by formatter produces a function +that would do with its arguments as the format interpreter would do with +those arguments. + + The remainder of this section describes what happens if the +control-string is a format string. + + Control-string is composed of simple text (characters) and embedded +directives. + + format writes the simple text as is; each embedded directive +specifies further text output that is to appear at the corresponding +point within the simple text. Most directives use one or more elements +of args to create their output. + + A directive consists of a tilde, optional prefix parameters separated +by commas, optional colon and at-sign modifiers, and a single character +indicating what kind of directive this is. + + There is no required ordering between the at-sign and colon modifier. + + The case of the directive character is ignored. Prefix parameters +are notated as signed (sign is optional) decimal numbers, or as a +single-quote followed by a character. For example, ~5,'0d can be used +to print an integer in decimal radix in five columns with leading zeros, +or ~5,'*d to get leading asterisks. + + In place of a prefix parameter to a directive, V (or v) can be used. +In this case, format takes an argument from args as a parameter to the +directive. The argument should be an integer or character. If the arg +used by a V parameter is nil, the effect is as if the parameter had been +omitted. # can be used in place of a prefix parameter; it represents +the number of args remaining to be processed. When used within a +recursive format, in the context of ~? or ~{, the # prefix parameter +represents the number of format arguments remaining within the recursive +call. + + Examples of format strings: + + "~S" ;This is an S directive with no parameters or modifiers. + "~3,-4:@s" ;This is an S directive with two parameters, 3 and -4, + ; and both the colon and at-sign flags. + "~,+4S" ;Here the first prefix parameter is omitted and takes + ; on its default value, while the second parameter is 4. + + Figure 22-5: Examples of format control strings + + + format sends the output to destination. If destination is nil, +format creates and returns a string containing the output from +control-string. If destination is non-nil, it must be a string with a +fill pointer, a stream, or the symbol t. If destination is a string +with a fill pointer, the output is added to the end of the string. If +destination is a stream, the output is sent to that stream. If +destination is t, the output is sent to standard output. + + In the description of the directives that follows, the term arg in +general refers to the next item of the set of args to be processed. The +word or phrase at the beginning of each description is a mnemonic for +the directive. + + format directives do not bind any of the printer control variables +(*print-...*) except as specified in the following descriptions. +Implementations may specify the binding of new, implementation-specific +printer control variables for each format directive, but they may +neither bind any standard printer control variables not specified in +description of a format directive nor fail to bind any standard printer +control variables as specified in the description. + +* Menu: + +* FORMAT Basic Output:: +* FORMAT Radix Control:: +* FORMAT Floating-Point Printers:: +* FORMAT Printer Operations:: +* FORMAT Pretty Printer Operations:: +* FORMAT Layout Control:: +* FORMAT Control-Flow Operations:: +* FORMAT Miscellaneous Operations:: +* FORMAT Miscellaneous Pseudo-Operations:: +* Additional Information about FORMAT Operations:: +* Examples of FORMAT:: +* Notes about FORMAT:: + + +File: gcl.info, Node: FORMAT Basic Output, Next: FORMAT Radix Control, Prev: Formatted Output, Up: Formatted Output + +22.3.1 FORMAT Basic Output +-------------------------- + +* Menu: + +* Tilde C-> Character:: +* Tilde Percent-> Newline:: +* Tilde Ampersand-> Fresh-Line:: +* Tilde Vertical-Bar-> Page:: +* Tilde Tilde-> Tilde:: + + +File: gcl.info, Node: Tilde C-> Character, Next: Tilde Percent-> Newline, Prev: FORMAT Basic Output, Up: FORMAT Basic Output + +22.3.1.1 Tilde C: Character +........................... + +The next arg should be a character; it is printed according to the +modifier flags. + + ~C prints the character as if by using write-char if it is a simple +character. Characters that are not simple are not necessarily printed +as if by write-char, but are displayed in an implementation-defined, +abbreviated format. For example, + + (format nil "~C" #\A) => "A" + (format nil "~C" #\Space) => " " + + ~:C is the same as ~C for printing characters, but other characters +are "spelled out." The intent is that this is a "pretty" format for +printing characters. For simple characters that are not printing, what +is spelled out is the name of the character (see char-name). For +characters that are not simple and not printing, what is spelled out is +implementation-defined. For example, + + (format nil "~:C" #\A) => "A" + (format nil "~:C" #\Space) => "Space" + ;; This next example assumes an implementation-defined "Control" attribute. + (format nil "~:C" #\Control-Space) + => "Control-Space" + OR=> "c-Space" + + ~:@C prints what ~:C would, and then if the character requires +unusual shift keys on the keyboard to type it, this fact is mentioned. +For example, + + (format nil "~:@C" #\Control-Partial) => "Control-\partial (Top-F)" + + This is the format used for telling the user about a key he is +expected to type, in prompts, for instance. The precise output may +depend not only on the implementation, but on the particular I/O devices +in use. + + ~@C prints the character in a way that the Lisp reader can +understand, using #\ syntax. + + ~@C binds *print-escape* to t. + + +File: gcl.info, Node: Tilde Percent-> Newline, Next: Tilde Ampersand-> Fresh-Line, Prev: Tilde C-> Character, Up: FORMAT Basic Output + +22.3.1.2 Tilde Percent: Newline +............................... + +This outputs a #\Newline character, thereby terminating the current +output line and beginning a new one. ~n% outputs n newlines. No arg is +used. + + +File: gcl.info, Node: Tilde Ampersand-> Fresh-Line, Next: Tilde Vertical-Bar-> Page, Prev: Tilde Percent-> Newline, Up: FORMAT Basic Output + +22.3.1.3 Tilde Ampersand: Fresh-Line +.................................... + +Unless it can be determined that the output stream is already at the +beginning of a line, this outputs a newline. ~n& calls fresh-line and +then outputs n- 1 newlines. ~0& does nothing. + + +File: gcl.info, Node: Tilde Vertical-Bar-> Page, Next: Tilde Tilde-> Tilde, Prev: Tilde Ampersand-> Fresh-Line, Up: FORMAT Basic Output + +22.3.1.4 Tilde Vertical-Bar: Page +................................. + +This outputs a page separator character, if possible. ~n| does this n +times. + + +File: gcl.info, Node: Tilde Tilde-> Tilde, Prev: Tilde Vertical-Bar-> Page, Up: FORMAT Basic Output + +22.3.1.5 Tilde Tilde: Tilde +........................... + +This outputs a tilde. ~n~ outputs n tildes. + + +File: gcl.info, Node: FORMAT Radix Control, Next: FORMAT Floating-Point Printers, Prev: FORMAT Basic Output, Up: Formatted Output + +22.3.2 FORMAT Radix Control +--------------------------- + +* Menu: + +* Tilde R-> Radix:: +* Tilde D-> Decimal:: +* Tilde B-> Binary:: +* Tilde O-> Octal:: +* Tilde X-> Hexadecimal:: + + +File: gcl.info, Node: Tilde R-> Radix, Next: Tilde D-> Decimal, Prev: FORMAT Radix Control, Up: FORMAT Radix Control + +22.3.2.1 Tilde R: Radix +....................... + +~nR prints arg in radix n. The modifier flags and any remaining +parameters are used as for the ~D directive. ~D is the same as ~10R. +The full form is ~radix,mincol,padchar,commachar,comma-intervalR. + + If no prefix parameters are given to ~R, then a different +interpretation is given. The argument should be an integer. For +example, if arg is 4: + +* + ~R prints arg as a cardinal English number: four. + +* + ~:R prints arg as an ordinal English number: fourth. + +* + ~@R prints arg as a Roman numeral: IV. + +* + ~:@R prints arg as an old Roman numeral: IIII. + + For example: + + (format nil "~,,' ,4:B" 13) => "1101" + (format nil "~,,' ,4:B" 17) => "1 0001" + (format nil "~19,0,' ,4:B" 3333) => "0000 1101 0000 0101" + (format nil "~3,,,' ,2:R" 17) => "1 22" + (format nil "~,,'|,2:D" #xFFFF) => "6|55|35" + + If and only if the first parameter, n, is supplied, ~R binds +*print-escape* to false, *print-radix* to false, *print-base* to n, + + and *print-readably* to false. + + If and only if no parameters are supplied, ~R binds *print-base* to +10. + + +File: gcl.info, Node: Tilde D-> Decimal, Next: Tilde B-> Binary, Prev: Tilde R-> Radix, Up: FORMAT Radix Control + +22.3.2.2 Tilde D: Decimal +......................... + +An arg, which should be an integer, is printed in decimal radix. ~D +will never put a decimal point after the number. + + ~mincolD uses a column width of mincol; spaces are inserted on the +left if the number requires fewer than mincol columns for its digits and +sign. If the number doesn't fit in mincol columns, additional columns +are used as needed. + + ~mincol,padcharD uses padchar as the pad character instead of space. + + If arg is not an integer, it is printed in ~A format and decimal +base. + + The @ modifier causes the number's sign to be printed always; the +default is to print it only if the number is negative. + + The : modifier causes commas to be printed between groups of digits; +commachar may be used to change the character used as the comma. +comma-interval must be an integer and defaults to 3. When the : +modifier is given to any of these directives, the commachar is printed +between groups of comma-interval digits. + + Thus the most general form of ~D is +~mincol,padchar,commachar,comma-intervalD. + + ~D binds *print-escape* to false, *print-radix* to false, +*print-base* to 10, + + and *print-readably* to false. + + +File: gcl.info, Node: Tilde B-> Binary, Next: Tilde O-> Octal, Prev: Tilde D-> Decimal, Up: FORMAT Radix Control + +22.3.2.3 Tilde B: Binary +........................ + +This is just like ~D but prints in binary radix (radix 2) instead of +decimal. The full form is therefore +~mincol,padchar,commachar,comma-intervalB. + + ~B binds *print-escape* to false, *print-radix* to false, +*print-base* to 2, + + and *print-readably* to false. + + +File: gcl.info, Node: Tilde O-> Octal, Next: Tilde X-> Hexadecimal, Prev: Tilde B-> Binary, Up: FORMAT Radix Control + +22.3.2.4 Tilde O: Octal +....................... + +This is just like ~D but prints in octal radix (radix 8) instead of +decimal. The full form is therefore +~mincol,padchar,commachar,comma-intervalO. + + ~O binds *print-escape* to false, *print-radix* to false, +*print-base* to 8, + + and *print-readably* to false. + + +File: gcl.info, Node: Tilde X-> Hexadecimal, Prev: Tilde O-> Octal, Up: FORMAT Radix Control + +22.3.2.5 Tilde X: Hexadecimal +............................. + +This is just like ~D but prints in hexadecimal radix (radix 16) instead +of decimal. The full form is therefore +~mincol,padchar,commachar,comma-intervalX. + + ~X binds *print-escape* to false, *print-radix* to false, +*print-base* to 16, + + and *print-readably* to false. + + +File: gcl.info, Node: FORMAT Floating-Point Printers, Next: FORMAT Printer Operations, Prev: FORMAT Radix Control, Up: Formatted Output + +22.3.3 FORMAT Floating-Point Printers +------------------------------------- + +* Menu: + +* Tilde F-> Fixed-Format Floating-Point:: +* Tilde E-> Exponential Floating-Point:: +* Tilde G-> General Floating-Point:: +* Tilde Dollarsign-> Monetary Floating-Point:: + + +File: gcl.info, Node: Tilde F-> Fixed-Format Floating-Point, Next: Tilde E-> Exponential Floating-Point, Prev: FORMAT Floating-Point Printers, Up: FORMAT Floating-Point Printers + +22.3.3.1 Tilde F: Fixed-Format Floating-Point +............................................. + +The next arg is printed as a float. + + The full form is ~w,d,k,overflowchar,padcharF. The parameter w is +the width of the field to be printed; d is the number of digits to print +after the decimal point; k is a scale factor that defaults to zero. + + Exactly w characters will be output. First, leading copies of the +character padchar (which defaults to a space) are printed, if necessary, +to pad the field on the left. If the arg is negative, then a minus sign +is printed; if the arg is not negative, then a plus sign is printed if +and only if the @ modifier was supplied. Then a sequence of digits, +containing a single embedded decimal point, is printed; this represents +the magnitude of the value of arg times 10^k, rounded to d fractional +digits. When rounding up and rounding down would produce printed values +equidistant from the scaled value of arg, then the implementation is +free to use either one. For example, printing the argument 6.375 using +the format ~4,2F may correctly produce either 6.37 or 6.38. Leading +zeros are not permitted, except that a single zero digit is output +before the decimal point if the printed value is less than one, and this +single zero digit is not output at all if w=d+1. + + If it is impossible to print the value in the required format in a +field of width w, then one of two actions is taken. If the parameter +overflowchar is supplied, then w copies of that parameter are printed +instead of the scaled value of arg. If the overflowchar parameter is +omitted, then the scaled value is printed using more than w characters, +as many more as may be needed. + + If the w parameter is omitted, then the field is of variable width. +In effect, a value is chosen for w in such a way that no leading pad +characters need to be printed and exactly d characters will follow the +decimal point. For example, the directive ~,2F will print exactly two +digits after the decimal point and as many as necessary before the +decimal point. + + If the parameter d is omitted, then there is no constraint on the +number of digits to appear after the decimal point. A value is chosen +for d in such a way that as many digits as possible may be printed +subject to the width constraint imposed by the parameter w and the +constraint that no trailing zero digits may appear in the fraction, +except that if the fraction to be printed is zero, then a single zero +digit should appear after the decimal point if permitted by the width +constraint. + + If both w and d are omitted, then the effect is to print the value +using ordinary free-format output; prin1 uses this format for any number +whose magnitude is either zero or between 10^-3 (inclusive) and 10^7 +(exclusive). + + If w is omitted, then if the magnitude of arg is so large (or, if d +is also omitted, so small) that more than 100 digits would have to be +printed, then an implementation is free, at its discretion, to print the +number using exponential notation instead, as if by the directive ~E +(with all parameters to ~E defaulted, not taking their values from the +~F directive). + + If arg is a rational number, then it is coerced to be a single float +and then printed. Alternatively, an implementation is permitted to +process a rational number by any other method that has essentially the +same behavior but avoids loss of precision or overflow because of the +coercion. If w and d are not supplied and the number has no exact +decimal representation, for example 1/3, some precision cutoff must be +chosen by the implementation since only a finite number of digits may be +printed. + + If arg is a complex number or some non-numeric object, then it is +printed using the format directive ~wD, thereby printing it in decimal +radix and a minimum field width of w. + + ~F binds *print-escape* to false + + and *print-readably* to false. + + +File: gcl.info, Node: Tilde E-> Exponential Floating-Point, Next: Tilde G-> General Floating-Point, Prev: Tilde F-> Fixed-Format Floating-Point, Up: FORMAT Floating-Point Printers + +22.3.3.2 Tilde E: Exponential Floating-Point +............................................ + +The next arg is printed as a float in exponential notation. + + The full form is ~w,d,e,k,overflowchar,padchar,exponentcharE. The +parameter w is the width of the field to be printed; d is the number of +digits to print after the decimal point; e is the number of digits to +use when printing the exponent; k is a scale factor that defaults to one +(not zero). + + Exactly w characters will be output. First, leading copies of the +character padchar (which defaults to a space) are printed, if necessary, +to pad the field on the left. If the arg is negative, then a minus sign +is printed; if the arg is not negative, then a plus sign is printed if +and only if the @ modifier was supplied. Then a sequence of digits +containing a single embedded decimal point is printed. The form of this +sequence of digits depends on the scale factor k. If k is zero, then d +digits are printed after the decimal point, and a single zero digit +appears before the decimal point if the total field width will permit +it. If k is positive, then it must be strictly less than d+2; k +significant digits are printed before the decimal point, and d- k+1 +digits are printed after the decimal point. If k is negative, then it +must be strictly greater than - d; a single zero digit appears before +the decimal point if the total field width will permit it, and after the +decimal point are printed first - k zeros and then d+k significant +digits. The printed fraction must be properly rounded. When rounding +up and rounding down would produce printed values equidistant from the +scaled value of arg, then the implementation is free to use either one. +For example, printing the argument 637.5 using the format ~8,2E may +correctly produce either 6.37E+2 or 6.38E+2. + + Following the digit sequence, the exponent is printed. First the +character parameter exponentchar is printed; if this parameter is +omitted, then the exponent marker that prin1 would use is printed, as +determined from the type of the float and the current value of +*read-default-float-format*. Next, either a plus sign or a minus sign +is printed, followed by e digits representing the power of ten by which +the printed fraction must be multiplied to properly represent the +rounded value of arg. + + If it is impossible to print the value in the required format in a +field of width w, possibly because k is too large or too small or +because the exponent cannot be printed in e character positions, then +one of two actions is taken. If the parameter overflowchar is supplied, +then w copies of that parameter are printed instead of the scaled value +of arg. If the overflowchar parameter is omitted, then the scaled value +is printed using more than w characters, as many more as may be needed; +if the problem is that d is too small for the supplied k or that e is +too small, then a larger value is used for d or e as may be needed. + + If the w parameter is omitted, then the field is of variable width. +In effect a value is chosen for w in such a way that no leading pad +characters need to be printed. + + If the parameter d is omitted, then there is no constraint on the +number of digits to appear. A value is chosen for d in such a way that +as many digits as possible may be printed subject to the width +constraint imposed by the parameter w, the constraint of the scale +factor k, and the constraint that no trailing zero digits may appear in +the fraction, except that if the fraction to be printed is zero then a +single zero digit should appear after the decimal point. + + If the parameter e is omitted, then the exponent is printed using the +smallest number of digits necessary to represent its value. + + If all of w, d, and e are omitted, then the effect is to print the +value using ordinary free-format exponential-notation output; prin1 uses + + a similar + + format for any non-zero number whose magnitude is less than 10^-3 or +greater than or equal to 10^7. + + The only difference is that the ~E directive always prints a plus or +minus sign in front of the exponent, while prin1 omits the plus sign if +the exponent is non-negative. + + If arg is a rational number, then it is coerced to be a single float +and then printed. Alternatively, an implementation is permitted to +process a rational number by any other method that has essentially the +same behavior but avoids loss of precision or overflow because of the +coercion. If w and d are unsupplied and the number has no exact decimal +representation, for example 1/3, some precision cutoff must be chosen by +the implementation since only a finite number of digits may be printed. + + If arg is a complex number or some non-numeric object, then it is +printed using the format directive ~wD, thereby printing it in decimal +radix and a minimum field width of w. + + ~E binds *print-escape* to false + + and *print-readably* to false. + + +File: gcl.info, Node: Tilde G-> General Floating-Point, Next: Tilde Dollarsign-> Monetary Floating-Point, Prev: Tilde E-> Exponential Floating-Point, Up: FORMAT Floating-Point Printers + +22.3.3.3 Tilde G: General Floating-Point +........................................ + +The next arg is printed as a float in either fixed-format or exponential +notation as appropriate. + + The full form is ~w,d,e,k,overflowchar,padchar,exponentcharG. The +format in which to print arg depends on the magnitude (absolute value) +of the arg. Let n be an integer such that 10^n-1 \le |arg| < 10^n. Let +ee equal e+2, or 4 if e is omitted. Let ww equal w- ee, or nil if w is +omitted. If d is omitted, first let q be the number of digits needed to +print arg with no loss of information and without leading or trailing +zeros; then let d equal (max q (min n 7)). Let dd equal d- n. + + If 0 \le dd \le d, then arg is printed as if by the format directives + + ~ww,dd,,overflowchar,padcharF~ee@T + + Note that the scale factor k is not passed to the ~F directive. For +all other values of dd, arg is printed as if by the format directive + + ~w,d,e,k,overflowchar,padchar,exponentcharE + + In either case, an @ modifier is supplied to the ~F or ~E directive +if and only if one was supplied to the ~G directive. + + ~G binds *print-escape* to false + + and *print-readably* to false. + + +File: gcl.info, Node: Tilde Dollarsign-> Monetary Floating-Point, Prev: Tilde G-> General Floating-Point, Up: FORMAT Floating-Point Printers + +22.3.3.4 Tilde Dollarsign: Monetary Floating-Point +.................................................. + +The next arg is printed as a float in fixed-format notation. + + The full form is ~d,n,w,padchar$. The parameter d is the number of +digits to print after the decimal point (default value 2); n is the +minimum number of digits to print before the decimal point (default +value 1); w is the minimum total width of the field to be printed +(default value 0). + + First padding and the sign are output. If the arg is negative, then +a minus sign is printed; if the arg is not negative, then a plus sign is +printed if and only if the @ modifier was supplied. If the : modifier +is used, the sign appears before any padding, and otherwise after the +padding. If w is supplied and the number of other characters to be +output is less than w, then copies of padchar (which defaults to a +space) are output to make the total field width equal w. Then n digits +are printed for the integer part of arg, with leading zeros if +necessary; then a decimal point; then d digits of fraction, properly +rounded. + + If the magnitude of arg is so large that more than m digits would +have to be printed, where m is the larger of w and 100, then an +implementation is free, at its discretion, to print the number using +exponential notation instead, as if by the directive ~w,q,,,,padcharE, +where w and padchar are present or omitted according to whether they +were present or omitted in the ~$ directive, and where q=d+n- 1, where d +and n are the (possibly default) values given to the ~$ directive. + + If arg is a rational number, then it is coerced to be a single float +and then printed. Alternatively, an implementation is permitted to +process a rational number by any other method that has essentially the +same behavior but avoids loss of precision or overflow because of the +coercion. + + If arg is a complex number or some non-numeric object, then it is +printed using the format directive ~wD, thereby printing it in decimal +radix and a minimum field width of w. + + ~$ binds *print-escape* to false + + and *print-readably* to false. + + +File: gcl.info, Node: FORMAT Printer Operations, Next: FORMAT Pretty Printer Operations, Prev: FORMAT Floating-Point Printers, Up: Formatted Output + +22.3.4 FORMAT Printer Operations +-------------------------------- + +* Menu: + +* Tilde A-> Aesthetic:: +* Tilde S-> Standard:: +* Tilde W-> Write:: + + +File: gcl.info, Node: Tilde A-> Aesthetic, Next: Tilde S-> Standard, Prev: FORMAT Printer Operations, Up: FORMAT Printer Operations + +22.3.4.1 Tilde A: Aesthetic +........................... + +An arg, any object, is printed without escape characters (as by princ). +If arg is a string, its characters will be output verbatim. If arg is +nil it will be printed as nil; the colon modifier (~:A) will cause an +arg of nil to be printed as (), but if arg is a composite structure, +such as a list or vector, any contained occurrences of nil will still be +printed as nil. + + ~mincolA inserts spaces on the right, if necessary, to make the width +at least mincol columns. The @ modifier causes the spaces to be +inserted on the left rather than the right. + + ~mincol,colinc,minpad,padcharA is the full form of ~A, which allows +control of the padding. The string is padded on the right (or on the +left if the @ modifier is used) with at least minpad copies of padchar; +padding characters are then inserted colinc characters at a time until +the total width is at least mincol. The defaults are 0 for mincol and +minpad, 1 for colinc, and the space character for padchar. + + ~A binds *print-escape* to false, + + and *print-readably* to false. + + +File: gcl.info, Node: Tilde S-> Standard, Next: Tilde W-> Write, Prev: Tilde A-> Aesthetic, Up: FORMAT Printer Operations + +22.3.4.2 Tilde S: Standard +.......................... + +This is just like ~A, but arg is printed with escape characters (as by +prin1 rather than princ). The output is therefore suitable for input to +read. ~S accepts all the arguments and modifiers that ~A does. + + ~S binds *print-escape* to t. + + +File: gcl.info, Node: Tilde W-> Write, Prev: Tilde S-> Standard, Up: FORMAT Printer Operations + +22.3.4.3 Tilde W: Write +....................... + +An argument, any object, is printed obeying every printer control +variable (as by write). In addition, ~W interacts correctly with depth +abbreviation, by not resetting the depth counter to zero. ~W does not +accept parameters. If given the colon modifier, ~W binds *print-pretty* +to true. If given the at-sign modifier, ~W binds *print-level* and +*print-length* to nil. + + ~W provides automatic support for the detection of circularity and +sharing. If the value of *print-circle* is not nil and ~W is applied to +an argument that is a circular (or shared) reference, an appropriate #n# +marker is inserted in the output instead of printing the argument. + + +File: gcl.info, Node: FORMAT Pretty Printer Operations, Next: FORMAT Layout Control, Prev: FORMAT Printer Operations, Up: Formatted Output + +22.3.5 FORMAT Pretty Printer Operations +--------------------------------------- + +The following constructs provide access to the pretty printer: + +* Menu: + +* Tilde Underscore-> Conditional Newline:: +* Tilde Less-Than-Sign-> Logical Block:: +* Tilde I-> Indent:: +* Tilde Slash-> Call Function:: + + +File: gcl.info, Node: Tilde Underscore-> Conditional Newline, Next: Tilde Less-Than-Sign-> Logical Block, Prev: FORMAT Pretty Printer Operations, Up: FORMAT Pretty Printer Operations + +22.3.5.1 Tilde Underscore: Conditional Newline +.............................................. + +Without any modifiers, ~_ is the same as (pprint-newline :linear). ~@_ +is the same as (pprint-newline :miser). ~:_ is the same as +(pprint-newline :fill). ~:@_ is the same as (pprint-newline +:mandatory). + + +File: gcl.info, Node: Tilde Less-Than-Sign-> Logical Block, Next: Tilde I-> Indent, Prev: Tilde Underscore-> Conditional Newline, Up: FORMAT Pretty Printer Operations + +22.3.5.2 Tilde Less-Than-Sign: Logical Block +............................................ + +~<...~:> + + If ~:> is used to terminate a ~<...~>, the directive is equivalent to +a call to pprint-logical-block. The argument corresponding to the +~<...~:> directive is treated in the same way as the list argument to +pprint-logical-block, thereby providing automatic support for non-list +arguments and the detection of circularity, sharing, and depth +abbreviation. The portion of the control-string nested within the +~<...~:> specifies the :prefix (or :per-line-prefix), :suffix, and body +of the pprint-logical-block. + + The control-string portion enclosed by ~<...~:> can be divided into +segments ~ by ~; directives. If the first +section is terminated by ~@;, it specifies a per-line prefix rather than +a simple prefix. The prefix and suffix cannot contain format +directives. An error is signaled if either the prefix or suffix fails +to be a constant string or if the enclosed portion is divided into more +than three segments. + + If the enclosed portion is divided into only two segments, the suffix +defaults to the null string. If the enclosed portion consists of only a +single segment, both the prefix and the suffix default to the null +string. If the colon modifier is used (i.e., ~:<...~:>), the prefix and +suffix default to "(" and ")" (respectively) instead of the null string. + + The body segment can be any arbitrary format string. This format +string is applied to the elements of the list corresponding to the +~<...~:> directive as a whole. Elements are extracted from this list +using pprint-pop, thereby providing automatic support for malformed +lists, and the detection of circularity, sharing, and length +abbreviation. Within the body segment, ~^ acts like +pprint-exit-if-list-exhausted. + + ~<...~:> supports a feature not supported by pprint-logical-block. +If ~:@> is used to terminate the directive (i.e., ~<...~:@>), then a +fill-style conditional newline is automatically inserted after each +group of blanks immediately contained in the body (except for blanks +after a ~ directive). This makes it easy to achieve the +equivalent of paragraph filling. + + If the at-sign modifier is used with ~<...~:>, the entire remaining +argument list is passed to the directive as its argument. All of the +remaining arguments are always consumed by ~@<...~:>, even if they are +not all used by the format string nested in the directive. Other than +the difference in its argument, ~@<...~:> is exactly the same as +~<...~:> except that circularity detection is not applied if ~@<...~:> +is encountered at top level in a format string. This ensures that +circularity detection is applied only to data lists, not to format +argument lists. + + " . #n#" is printed if circularity or sharing has to be indicated for +its argument as a whole. + + To a considerable extent, the basic form of the directive ~<...~> is +incompatible with the dynamic control of the arrangement of output by +~W, ~_, ~<...~:>, ~I, and ~:T. As a result, an error is signaled if any +of these directives is nested within ~<...~>. Beyond this, an error is +also signaled if the ~<...~:;...~> form of ~<...~> is used in the same +format string with ~W, ~_, ~<...~:>, ~I, or ~:T. + + See also *note Tilde Less-Than-Sign-> Justification::. + + +File: gcl.info, Node: Tilde I-> Indent, Next: Tilde Slash-> Call Function, Prev: Tilde Less-Than-Sign-> Logical Block, Up: FORMAT Pretty Printer Operations + +22.3.5.3 Tilde I: Indent +........................ + +~nI is the same as (pprint-indent :block n). + + ~n:I is the same as (pprint-indent :current n). In both cases, n +defaults to zero, if it is omitted. + + +File: gcl.info, Node: Tilde Slash-> Call Function, Prev: Tilde I-> Indent, Up: FORMAT Pretty Printer Operations + +22.3.5.4 Tilde Slash: Call Function +................................... + +~/name/ + + User defined functions can be called from within a format string by +using the directive ~/name/. The colon modifier, the at-sign modifier, +and arbitrarily many parameters can be specified with the ~/name/ +directive. name can be any arbitrary string that does not contain a +"/". All of the characters in name are treated as if they were upper +case. If name contains a single colon (:) or double colon (::), then +everything up to but not including the first ":" or "::" is taken to be +a string that names a package. Everything after the first ":" or "::" +(if any) is taken to be a string that names a symbol. The function +corresponding to a ~/name/ directive is obtained by looking up the +symbol that has the indicated name in the indicated package. If name +does not contain a ":" or "::", then the whole name string is looked up +in the COMMON-LISP-USER package. + + When a ~/name/ directive is encountered, the indicated function is +called with four or more arguments. The first four arguments are: the +output stream, the format argument corresponding to the directive, a +generalized boolean that is true if the colon modifier was used, and a +generalized boolean that is true if the at-sign modifier was used. The +remaining arguments consist of any parameters specified with the +directive. The function should print the argument appropriately. Any +values returned by the function are ignored. + + The three functions pprint-linear, pprint-fill, and pprint-tabular +are specifically designed so that they can be called by ~/.../ (i.e., +~/pprint-linear/, ~/pprint-fill/, and ~/pprint-tabular/). In particular +they take colon and at-sign arguments. + + +File: gcl.info, Node: FORMAT Layout Control, Next: FORMAT Control-Flow Operations, Prev: FORMAT Pretty Printer Operations, Up: Formatted Output + +22.3.6 FORMAT Layout Control +---------------------------- + +* Menu: + +* Tilde T-> Tabulate:: +* Tilde Less-Than-Sign-> Justification:: +* Tilde Greater-Than-Sign-> End of Justification:: + + +File: gcl.info, Node: Tilde T-> Tabulate, Next: Tilde Less-Than-Sign-> Justification, Prev: FORMAT Layout Control, Up: FORMAT Layout Control + +22.3.6.1 Tilde T: Tabulate +.......................... + +This spaces over to a given column. ~colnum,colincT will output +sufficient spaces to move the cursor to column colnum. If the cursor is +already at or beyond column colnum, it will output spaces to move it to +column colnum+k*colinc for the smallest positive integer k possible, +unless colinc is zero, in which case no spaces are output if the cursor +is already at or beyond column colnum. colnum and colinc default to 1. + + If for some reason the current absolute column position cannot be +determined by direct inquiry, format may be able to deduce the current +column position by noting that certain directives (such as ~%, or ~&, or +~A with the argument being a string containing a newline) cause the +column position to be reset to zero, and counting the number of +characters emitted since that point. If that fails, format may attempt +a similar deduction on the riskier assumption that the destination was +at column zero when format was invoked. If even this heuristic fails or +is implementationally inconvenient, at worst the ~T operation will +simply output two spaces. + + ~@T performs relative tabulation. ~colrel,colinc@T outputs colrel +spaces and then outputs the smallest non-negative number of additional +spaces necessary to move the cursor to a column that is a multiple of +colinc. For example, the directive ~3,8@T outputs three spaces and then +moves the cursor to a "standard multiple-of-eight tab stop" if not at +one already. If the current output column cannot be determined, +however, then colinc is ignored, and exactly colrel spaces are output. + + If the colon modifier is used with the ~T directive, the tabbing +computation is done relative to the horizontal position where the +section immediately containing the directive begins, rather than with +respect to a horizontal position of zero. The numerical parameters are +both interpreted as being in units of ems and both default to 1. ~n,m:T +is the same as (pprint-tab :section n m). ~n,m:@T is the same as +(pprint-tab :section-relative n m). + + +File: gcl.info, Node: Tilde Less-Than-Sign-> Justification, Next: Tilde Greater-Than-Sign-> End of Justification, Prev: Tilde T-> Tabulate, Up: FORMAT Layout Control + +22.3.6.2 Tilde Less-Than-Sign: Justification +............................................ + +~mincol,colinc,minpad,padchar + + This justifies the text produced by processing str within a field at +least mincol columns wide. str may be divided up into segments with ~;, +in which case the spacing is evenly divided between the text segments. + + With no modifiers, the leftmost text segment is left justified in the +field, and the rightmost text segment is right justified. If there is +only one text element, as a special case, it is right justified. The : +modifier causes spacing to be introduced before the first text segment; +the @ modifier causes spacing to be added after the last. The minpad +parameter (default 0) is the minimum number of padding characters to be +output between each segment. The padding character is supplied by +padchar, which defaults to the space character. If the total width +needed to satisfy these constraints is greater than mincol, then the +width used is mincol+k*colinc for the smallest possible non-negative +integer value k. colinc defaults to 1, and mincol defaults to 0. + + Note that str may include format directives. All the clauses in str +are processed in order; it is the resulting pieces of text that are +justified. + + The ~^ directive may be used to terminate processing of the clauses +prematurely, in which case only the completely processed clauses are +justified. + + If the first clause of a ~< is terminated with ~:; instead of ~;, +then it is used in a special way. All of the clauses are processed +(subject to ~^ , of course), but the first one is not used in performing +the spacing and padding. When the padded result has been determined, +then if it will fit on the current line of output, it is output, and the +text for the first clause is discarded. If, however, the padded text +will not fit on the current line, then the text segment for the first +clause is output before the padded text. The first clause ought to +contain a newline (such as a ~% directive). The first clause is always +processed, and so any arguments it refers to will be used; the decision +is whether to use the resulting segment of text, not whether to process +the first clause. If the ~:; has a prefix parameter n, then the padded +text must fit on the current line with n character positions to spare to +avoid outputting the first clause's text. For example, the control +string + + "~ + + can be used to print a list of items separated by commas without +breaking items over line boundaries, beginning each line with ;; . The +prefix parameter 1 in ~1:; accounts for the width of the comma that will +follow the justified item if it is not the last element in the list, or +the period if it is. If ~:; has a second prefix parameter, then it is +used as the width of the line, thus overriding the natural line width of +the output stream. To make the preceding example use a line width of +50, one would write + + "~ + + If the second argument is not supplied, then format uses the line +width of the destination output stream. If this cannot be determined +(for example, when producing a string result), then format uses 72 as +the line length. + + See also *note Tilde Less-Than-Sign-> Logical Block::. + + +File: gcl.info, Node: Tilde Greater-Than-Sign-> End of Justification, Prev: Tilde Less-Than-Sign-> Justification, Up: FORMAT Layout Control + +22.3.6.3 Tilde Greater-Than-Sign: End of Justification +...................................................... + +~> terminates a ~<. The consequences of using it elsewhere are +undefined. + + +File: gcl.info, Node: FORMAT Control-Flow Operations, Next: FORMAT Miscellaneous Operations, Prev: FORMAT Layout Control, Up: Formatted Output + +22.3.7 FORMAT Control-Flow Operations +------------------------------------- + +* Menu: + +* Tilde Asterisk-> Go-To:: +* Tilde Left-Bracket-> Conditional Expression:: +* Tilde Right-Bracket-> End of Conditional Expression:: +* Tilde Left-Brace-> Iteration:: +* Tilde Right-Brace-> End of Iteration:: +* Tilde Question-Mark-> Recursive Processing:: + + +File: gcl.info, Node: Tilde Asterisk-> Go-To, Next: Tilde Left-Bracket-> Conditional Expression, Prev: FORMAT Control-Flow Operations, Up: FORMAT Control-Flow Operations + +22.3.7.1 Tilde Asterisk: Go-To +.............................. + +The next arg is ignored. ~n* ignores the next n arguments. + + ~:* backs up in the list of arguments so that the argument last +processed will be processed again. ~n:* backs up n arguments. + + When within a ~{ construct (see below), the ignoring (in either +direction) is relative to the list of arguments being processed by the +iteration. + + ~n@* goes to the nth arg, where 0 means the first one; n defaults to +0, so ~@* goes back to the first arg. Directives after a ~n@* will take +arguments in sequence beginning with the one gone to. When within a ~{ +construct, the "goto" is relative to the list of arguments being +processed by the iteration. + + +File: gcl.info, Node: Tilde Left-Bracket-> Conditional Expression, Next: Tilde Right-Bracket-> End of Conditional Expression, Prev: Tilde Asterisk-> Go-To, Up: FORMAT Control-Flow Operations + +22.3.7.2 Tilde Left-Bracket: Conditional Expression +................................................... + +~[str0~;str1~;...~;strn~] + + This is a set of control strings, called clauses, one of which is +chosen and used. The clauses are separated by ~; and the construct is +terminated by ~]. For example, + + "~[Siamese~;Manx~;Persian~] Cat" + + The argth clause is selected, where the first clause is number 0. If +a prefix parameter is given (as ~n[), then the parameter is used instead +of an argument. If arg is out of range then no clause is selected and +no error is signaled. After the selected alternative has been +processed, the control string continues after the ~]. + + ~[str0~;str1~;...~;strn~:;default~] has a default case. If the last +~; used to separate clauses is ~:; instead, then the last clause is an +else clause that is performed if no other clause is selected. For +example: + + "~[Siamese~;Manx~;Persian~:;Alley~] Cat" + + ~:[alternative~;consequent~] selects the alternative control string +if arg is false, and selects the consequent control string otherwise. + + ~@[consequent~] tests the argument. If it is true, then the argument +is not used up by the ~[ command but remains as the next one to be +processed, and the one clause consequent is processed. If the arg is +false, then the argument is used up, and the clause is not processed. +The clause therefore should normally use exactly one argument, and may +expect it to be non-nil. For example: + + (setq *print-level* nil *print-length* 5) + (format nil + "~@[ print level = ~D~]~@[ print length = ~D~]" + *print-level* *print-length*) + => " print length = 5" + + Note also that + + (format stream "...~@[str~]..." ...) + == (format stream "...~:[~;~:*str~]..." ...) + + The combination of ~[ and # is useful, for example, for dealing with +English conventions for printing lists: + + (setq foo "Items:~#[ none~; ~S~; ~S and ~S~ + ~:;~@{~#[~; and~] ~S~^ ,~}~].") + (format nil foo) => "Items: none." + (format nil foo 'foo) => "Items: FOO." + (format nil foo 'foo 'bar) => "Items: FOO and BAR." + (format nil foo 'foo 'bar 'baz) => "Items: FOO, BAR, and BAZ." + (format nil foo 'foo 'bar 'baz 'quux) => "Items: FOO, BAR, BAZ, and QUUX." + + +File: gcl.info, Node: Tilde Right-Bracket-> End of Conditional Expression, Next: Tilde Left-Brace-> Iteration, Prev: Tilde Left-Bracket-> Conditional Expression, Up: FORMAT Control-Flow Operations + +22.3.7.3 Tilde Right-Bracket: End of Conditional Expression +........................................................... + +~] terminates a ~[. The consequences of using it elsewhere are +undefined. + + +File: gcl.info, Node: Tilde Left-Brace-> Iteration, Next: Tilde Right-Brace-> End of Iteration, Prev: Tilde Right-Bracket-> End of Conditional Expression, Up: FORMAT Control-Flow Operations + +22.3.7.4 Tilde Left-Brace: Iteration +.................................... + +~{str~} + + This is an iteration construct. The argument should be a list, which +is used as a set of arguments as if for a recursive call to format. The +string str is used repeatedly as the control string. Each iteration can +absorb as many elements of the list as it likes as arguments; if str +uses up two arguments by itself, then two elements of the list will get +used up each time around the loop. If before any iteration step the +list is empty, then the iteration is terminated. Also, if a prefix +parameter n is given, then there will be at most n repetitions of +processing of str. Finally, the ~^ directive can be used to terminate +the iteration prematurely. + + For example: + + (format nil "The winners are:~{ ~S~}." + '(fred harry jill)) + => "The winners are: FRED HARRY JILL." + (format nil "Pairs:~{ <~S,~S>~}." + '(a 1 b 2 c 3)) + => "Pairs: ." + + ~:{ str~} is similar, but the argument should be a list of sublists. +At each repetition step, one sublist is used as the set of arguments for +processing str; on the next repetition, a new sublist is used, whether +or not all of the last sublist had been processed. For example: + + (format nil "Pairs:~:{ <~S,~S>~} ." + '((a 1) (b 2) (c 3))) + => "Pairs: ." + + ~@{ str~} is similar to ~{ str~} , but instead of using one argument +that is a list, all the remaining arguments are used as the list of +arguments for the iteration. Example: + + (format nil "Pairs:~@{ <~S,~S>~} ." 'a 1 'b 2 'c 3) + => "Pairs: ." + + If the iteration is terminated before all the remaining arguments are +consumed, then any arguments not processed by the iteration remain to be +processed by any directives following the iteration construct. + + ~:@{ str~} combines the features of ~:{ str~} and ~@{ str~} . All +the remaining arguments are used, and each one must be a list. On each +iteration, the next argument is used as a list of arguments to str. +Example: + + (format nil "Pairs:~:@{ <~S,~S>~} ." + '(a 1) '(b 2) '(c 3)) + => "Pairs: ." + + Terminating the repetition construct with ~:} instead of ~} forces +str to be processed at least once, even if the initial list of arguments +is null. However, this will not override an explicit prefix parameter +of zero. + + If str is empty, then an argument is used as str. It must be a +format control and precede any arguments processed by the iteration. As +an example, the following are equivalent: + + (apply #'format stream string arguments) + == (format stream "~1{~:}" string arguments) + + This will use string as a formatting string. The ~1{ says it will be +processed at most once, and the ~:} says it will be processed at least +once. Therefore it is processed exactly once, using arguments as the +arguments. This case may be handled more clearly by the ~? directive, +but this general feature of ~{ is more powerful than ~?. + + +File: gcl.info, Node: Tilde Right-Brace-> End of Iteration, Next: Tilde Question-Mark-> Recursive Processing, Prev: Tilde Left-Brace-> Iteration, Up: FORMAT Control-Flow Operations + +22.3.7.5 Tilde Right-Brace: End of Iteration +............................................ + +~} terminates a ~{. The consequences of using it elsewhere are +undefined. + + +File: gcl.info, Node: Tilde Question-Mark-> Recursive Processing, Prev: Tilde Right-Brace-> End of Iteration, Up: FORMAT Control-Flow Operations + +22.3.7.6 Tilde Question-Mark: Recursive Processing +.................................................. + +The next arg must be a format control, and the one after it a list; both +are consumed by the ~? directive. The two are processed as a +control-string, with the elements of the list as the arguments. Once +the recursive processing has been finished, the processing of the +control string containing the ~? directive is resumed. Example: + + (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) => " 7" + (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) => " 7" + + Note that in the second example three arguments are supplied to the +format string "<~A ~D>", but only two are processed and the third is +therefore ignored. + + With the @ modifier, only one arg is directly consumed. The arg must +be a string; it is processed as part of the control string as if it had +appeared in place of the ~@? construct, and any directives in the +recursively processed control string may consume arguments of the +control string containing the ~@? directive. Example: + + (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) => " 7" + (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) => " 14" + + +File: gcl.info, Node: FORMAT Miscellaneous Operations, Next: FORMAT Miscellaneous Pseudo-Operations, Prev: FORMAT Control-Flow Operations, Up: Formatted Output + +22.3.8 FORMAT Miscellaneous Operations +-------------------------------------- + +* Menu: + +* Tilde Left-Paren-> Case Conversion:: +* Tilde Right-Paren-> End of Case Conversion:: +* Tilde P-> Plural:: + + +File: gcl.info, Node: Tilde Left-Paren-> Case Conversion, Next: Tilde Right-Paren-> End of Case Conversion, Prev: FORMAT Miscellaneous Operations, Up: FORMAT Miscellaneous Operations + +22.3.8.1 Tilde Left-Paren: Case Conversion +.......................................... + +~(str~) + + The contained control string str is processed, and what it produces +is subject to case conversion. + + With no flags, every uppercase character is converted to the +corresponding lowercase character. + + ~:( capitalizes all words, as if by string-capitalize. + + ~@( capitalizes just the first word and forces the rest to lower +case. + + ~:@( converts every lowercase character to the corresponding +uppercase character. + + In this example ~@( is used to cause the first word produced by ~@R +to be capitalized: + + (format nil "~@R ~(~@R~)" 14 14) + => "XIV xiv" + (defun f (n) (format nil "~@(~R~) error~:P detected." n)) => F + (f 0) => "Zero errors detected." + (f 1) => "One error detected." + (f 23) => "Twenty-three errors detected." + + When case conversions appear nested, the outer conversion dominates, +as illustrated in the following example: + + (format nil "~@(how is ~:(BOB SMITH~)?~)") + => "How is bob smith?" + NOT=> "How is Bob Smith?" + + +File: gcl.info, Node: Tilde Right-Paren-> End of Case Conversion, Next: Tilde P-> Plural, Prev: Tilde Left-Paren-> Case Conversion, Up: FORMAT Miscellaneous Operations + +22.3.8.2 Tilde Right-Paren: End of Case Conversion +.................................................. + +~) terminates a ~(. The consequences of using it elsewhere are +undefined. + + +File: gcl.info, Node: Tilde P-> Plural, Prev: Tilde Right-Paren-> End of Case Conversion, Up: FORMAT Miscellaneous Operations + +22.3.8.3 Tilde P: Plural +........................ + +If arg is not eql to the integer 1, a lowercase s is printed; if arg is +eql to 1, nothing is printed. If arg is a floating-point 1.0, the s is +printed. + + ~:P does the same thing, after doing a ~:* to back up one argument; +that is, it prints a lowercase s if the previous argument was not 1. + + ~@P prints y if the argument is 1, or ies if it is not. ~:@P does +the same thing, but backs up first. + + (format nil "~D tr~:@P/~D win~:P" 7 1) => "7 tries/1 win" + (format nil "~D tr~:@P/~D win~:P" 1 0) => "1 try/0 wins" + (format nil "~D tr~:@P/~D win~:P" 1 3) => "1 try/3 wins" + + +File: gcl.info, Node: FORMAT Miscellaneous Pseudo-Operations, Next: Additional Information about FORMAT Operations, Prev: FORMAT Miscellaneous Operations, Up: Formatted Output + +22.3.9 FORMAT Miscellaneous Pseudo-Operations +--------------------------------------------- + +* Menu: + +* Tilde Semicolon-> Clause Separator:: +* Tilde Circumflex-> Escape Upward:: +* Tilde Newline-> Ignored Newline:: + + +File: gcl.info, Node: Tilde Semicolon-> Clause Separator, Next: Tilde Circumflex-> Escape Upward, Prev: FORMAT Miscellaneous Pseudo-Operations, Up: FORMAT Miscellaneous Pseudo-Operations + +22.3.9.1 Tilde Semicolon: Clause Separator +.......................................... + +This separates clauses in ~[ and ~< constructs. The consequences of +using it elsewhere are undefined. + + +File: gcl.info, Node: Tilde Circumflex-> Escape Upward, Next: Tilde Newline-> Ignored Newline, Prev: Tilde Semicolon-> Clause Separator, Up: FORMAT Miscellaneous Pseudo-Operations + +22.3.9.2 Tilde Circumflex: Escape Upward +........................................ + +~^ + + This is an escape construct. If there are no more arguments +remaining to be processed, then the immediately enclosing ~{ or ~< +construct is terminated. If there is no such enclosing construct, then +the entire formatting operation is terminated. In the ~< case, the +formatting is performed, but no more segments are processed before doing +the justification. ~^ may appear anywhere in a ~{ construct. + + (setq donestr "Done.~^ ~D warning~:P.~^ ~D error~:P.") + => "Done.~^ ~D warning~:P.~^ ~D error~:P." + (format nil donestr) => "Done." + (format nil donestr 3) => "Done. 3 warnings." + (format nil donestr 1 5) => "Done. 1 warning. 5 errors." + + If a prefix parameter is given, then termination occurs if the +parameter is zero. (Hence ~^ is equivalent to ~#^.) If two parameters +are given, termination occurs if they are equal. + + [Reviewer Note by Barmar: Which equality predicate?] If three +parameters are given, termination occurs if the first is less than or +equal to the second and the second is less than or equal to the third. +Of course, this is useless if all the prefix parameters are constants; +at least one of them should be a # or a V parameter. + + If ~^ is used within a ~:{ construct, then it terminates the current +iteration step because in the standard case it tests for remaining +arguments of the current step only; the next iteration step commences +immediately. ~:^ is used to terminate the iteration process. + + ~:^ may be used only if the command it would terminate is ~:{ or ~:@{ +. The entire iteration process is terminated if and only if the sublist +that is supplying the arguments for the current iteration step is the +last sublist in the case of ~:{ , or the last format argument in the +case of ~:@{ . ~:^ is not equivalent to ~#:^; the latter terminates the +entire iteration if and only if no arguments remain for the current +iteration step. For example: + + (format nil "~:{ ~@?~:^ ...~} " '(("a") ("b"))) => "a...b" + + If ~^ appears within a control string being processed under the +control of a ~? directive, but not within any ~{ or ~< construct within +that string, then the string being processed will be terminated, thereby +ending processing of the ~? directive. Processing then continues within +the string containing the ~? directive at the point following that +directive. + + If ~^ appears within a ~[ or ~( construct, then all the commands up +to the ~^ are properly selected or case-converted, the ~[ or ~( +processing is terminated, and the outward search continues for a ~{ or +~< construct to be terminated. For example: + + (setq tellstr "~@(~@[~R~]~^ ~A!~)") + => "~@(~@[~R~]~^ ~A!~)" + (format nil tellstr 23) => "Twenty-three!" + (format nil tellstr nil "losers") => " Losers!" + (format nil tellstr 23 "losers") => "Twenty-three losers!" + + Following are examples of the use of ~^ within a ~< construct. + + (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) + => " FOO" + (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) + => "FOO BAR" + (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) + => "FOO BAR BAZ" + + +File: gcl.info, Node: Tilde Newline-> Ignored Newline, Prev: Tilde Circumflex-> Escape Upward, Up: FORMAT Miscellaneous Pseudo-Operations + +22.3.9.3 Tilde Newline: Ignored Newline +....................................... + +Tilde immediately followed by a newline ignores the newline and any +following non-newline whitespace_1 characters. With a :, the newline is +ignored, but any following whitespace_1 is left in place. With an @, +the newline is left in place, but any following whitespace_1 is ignored. +For example: + + (defun type-clash-error (fn nargs argnum right-type wrong-type) + (format *error-output* + "~&~S requires its ~:[~:R~;~*~]~ + argument to be of type ~S,~ + with an argument of type ~S.~ + fn (eql nargs 1) argnum right-type wrong-type)) + (type-clash-error 'aref nil 2 'integer 'vector) prints: + AREF requires its second argument to be of type INTEGER, + but it was called with an argument of type VECTOR. + NIL + (type-clash-error 'car 1 1 'list 'short-float) prints: + CAR requires its argument to be of type LIST, + but it was called with an argument of type SHORT-FLOAT. + NIL + + Note that in this example newlines appear in the output only as +specified by the ~& and ~% directives; the actual newline characters in +the control string are suppressed because each is preceded by a tilde. + + +File: gcl.info, Node: Additional Information about FORMAT Operations, Next: Examples of FORMAT, Prev: FORMAT Miscellaneous Pseudo-Operations, Up: Formatted Output + +22.3.10 Additional Information about FORMAT Operations +------------------------------------------------------ + +* Menu: + +* Nesting of FORMAT Operations:: +* Missing and Additional FORMAT Arguments:: +* Additional FORMAT Parameters:: +* Undefined FORMAT Modifier Combinations:: + + +File: gcl.info, Node: Nesting of FORMAT Operations, Next: Missing and Additional FORMAT Arguments, Prev: Additional Information about FORMAT Operations, Up: Additional Information about FORMAT Operations + +22.3.10.1 Nesting of FORMAT Operations +...................................... + +The case-conversion, conditional, iteration, and justification +constructs can contain other formatting constructs by bracketing them. +These constructs must nest properly with respect to each other. For +example, it is not legitimate to put the start of a case-conversion +construct in each arm of a conditional and the end of the +case-conversion construct outside the conditional: + + (format nil "~:[abc~:@(def~;ghi~ + :@(jkl~]mno~)" x) ;Invalid! + + This notation is invalid because the ~[...~;...~] and ~(...~) +constructs are not properly nested. + + The processing indirection caused by the ~? directive is also a kind +of nesting for the purposes of this rule of proper nesting. It is not +permitted to start a bracketing construct within a string processed +under control of a ~? directive and end the construct at some point +after the ~? construct in the string containing that construct, or vice +versa. For example, this situation is invalid: + + (format nil "~@?ghi~)" "abc~@(def") ;Invalid! + + This notation is invalid because the ~? and ~(...~) constructs are +not properly nested. + + +File: gcl.info, Node: Missing and Additional FORMAT Arguments, Next: Additional FORMAT Parameters, Prev: Nesting of FORMAT Operations, Up: Additional Information about FORMAT Operations + +22.3.10.2 Missing and Additional FORMAT Arguments +................................................. + +The consequences are undefined if no arg remains for a directive +requiring an argument. However, it is permissible for one or more args +to remain unprocessed by a directive; such args are ignored. + + +File: gcl.info, Node: Additional FORMAT Parameters, Next: Undefined FORMAT Modifier Combinations, Prev: Missing and Additional FORMAT Arguments, Up: Additional Information about FORMAT Operations + +22.3.10.3 Additional FORMAT Parameters +...................................... + +The consequences are undefined if a format directive is given more +parameters than it is described here as accepting. + + +File: gcl.info, Node: Undefined FORMAT Modifier Combinations, Prev: Additional FORMAT Parameters, Up: Additional Information about FORMAT Operations + +22.3.10.4 Undefined FORMAT Modifier Combinations +................................................ + +The consequences are undefined if colon or at-sign modifiers are given +to a directive in a combination not specifically described here as being +meaningful. + + +File: gcl.info, Node: Examples of FORMAT, Next: Notes about FORMAT, Prev: Additional Information about FORMAT Operations, Up: Formatted Output + +22.3.11 Examples of FORMAT +-------------------------- + + (format nil "foo") => "foo" + (setq x 5) => 5 + (format nil "The answer is ~D." x) => "The answer is 5." + (format nil "The answer is ~3D." x) => "The answer is 5." + (format nil "The answer is ~3,'0D." x) => "The answer is 005." + (format nil "The answer is ~:D." (expt 47 x)) + => "The answer is 229,345,007." + (setq y "elephant") => "elephant" + (format nil "Look at the ~A!" y) => "Look at the elephant!" + (setq n 3) => 3 + (format nil "~D item~:P found." n) => "3 items found." + (format nil "~R dog~:[s are~; is~] here." n (= n 1)) + => "three dogs are here." + (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) + => "three dogs are here." + (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) + => "Here are three puppies." + + (defun foo (x) + (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" + x x x x x x)) => FOO + (foo 3.14159) => " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" + (foo -3.14159) => " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" + (foo 100.0) => "100.00|******|100.00| 100.0|100.00|100.0" + (foo 1234.0) => "1234.00|******|??????|1234.0|1234.00|1234.0" + (foo 0.006) => " 0.01| 0.06| 0.01| 0.006|0.01|0.006" + + (defun foo (x) + (format nil + "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~ + ~9,3,2,-2,' + x x x x)) + (foo 3.14159) => " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0" + (foo -3.14159) => " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" + (foo 1100.0) => " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3" + (foo 1100.0L0) => " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3" + (foo 1.1E13) => "*********| 11.00$+12|+.001E+16| 1.10E+13" + (foo 1.1L120) => "*********|??????????| + (foo 1.1L1200) => "*********|??????????| + + As an example of the effects of varying the scale factor, the code + + (dotimes (k 13) + (format t "~ + (- k 5) (- k 5) 3.14159)) + + produces the following output: + + Scale factor -5: | 0.000003E+06| + Scale factor -4: | 0.000031E+05| + Scale factor -3: | 0.000314E+04| + Scale factor -2: | 0.003142E+03| + Scale factor -1: | 0.031416E+02| + Scale factor 0: | 0.314159E+01| + Scale factor 1: | 3.141590E+00| + Scale factor 2: | 31.41590E-01| + Scale factor 3: | 314.1590E-02| + Scale factor 4: | 3141.590E-03| + Scale factor 5: | 31415.90E-04| + Scale factor 6: | 314159.0E-05| + Scale factor 7: | 3141590.E-06| + + (defun foo (x) + (format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,' + x x x x)) + (foo 0.0314159) => " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2" + (foo 0.314159) => " 0.31 |0.314 |0.314 | 0.31 " + (foo 3.14159) => " 3.1 | 3.14 | 3.14 | 3.1 " + (foo 31.4159) => " 31. | 31.4 | 31.4 | 31. " + (foo 314.159) => " 3.14E+2| 314. | 314. | 3.14E+2" + (foo 3141.59) => " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3" + (foo 3141.59L0) => " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3" + (foo 3.14E12) => "*********|314.0$+10|0.314E+13| 3.14E+12" + (foo 3.14L120) => "*********|?????????| + (foo 3.14L1200) => "*********|?????????| + + (format nil "~10") => "foo bar" + (format nil "~10:") => " foo bar" + (format nil "~10") => " foobar" + (format nil "~10:") => " foobar" + (format nil "~10:@") => " foo bar " + (format nil "~10@") => "foobar " + (format nil "~10:@") => " foobar " + + (FORMAT NIL "Written to ~A." #P"foo.bin") + => "Written to foo.bin." + + +File: gcl.info, Node: Notes about FORMAT, Prev: Examples of FORMAT, Up: Formatted Output + +22.3.12 Notes about FORMAT +-------------------------- + +Formatted output is performed not only by format, but by certain other +functions that accept a format control the way format does. For +example, error-signaling functions such as cerror accept format +controls. + + Note that the meaning of nil and t as destinations to format are +different than those of nil and t as stream designators. + + The ~^ should appear only at the beginning of a ~< clause, because it +aborts the entire clause in which it appears (as well as all following +clauses). + + +File: gcl.info, Node: Printer Dictionary, Prev: Formatted Output, Up: Printer + +22.4 Printer Dictionary +======================= + +* Menu: + +* copy-pprint-dispatch:: +* formatter:: +* pprint-dispatch:: +* pprint-exit-if-list-exhausted:: +* pprint-fill:: +* pprint-indent:: +* pprint-logical-block:: +* pprint-newline:: +* pprint-pop:: +* pprint-tab:: +* print-object:: +* print-unreadable-object:: +* set-pprint-dispatch:: +* write:: +* write-to-string:: +* *print-array*:: +* *print-base*:: +* *print-case*:: +* *print-circle*:: +* *print-escape*:: +* *print-gensym*:: +* *print-level*:: +* *print-lines*:: +* *print-miser-width*:: +* *print-pprint-dispatch*:: +* *print-pretty*:: +* *print-readably*:: +* *print-right-margin*:: +* print-not-readable:: +* print-not-readable-object:: +* format:: + + +File: gcl.info, Node: copy-pprint-dispatch, Next: formatter, Prev: Printer Dictionary, Up: Printer Dictionary + +22.4.1 copy-pprint-dispatch [Function] +-------------------------------------- + +'copy-pprint-dispatch' &optional table => new-table + +Arguments and Values:: +...................... + +table--a pprint dispatch table, or nil. + + new-table--a fresh pprint dispatch table. + +Description:: +............. + +Creates and returns a copy of the specified table, or of the value of +*print-pprint-dispatch* if no table is specified, or of the initial +value of *print-pprint-dispatch* if nil is specified. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if table is not a pprint +dispatch table. + + +File: gcl.info, Node: formatter, Next: pprint-dispatch, Prev: copy-pprint-dispatch, Up: Printer Dictionary + +22.4.2 formatter [Macro] +------------------------ + +'formatter' control-string => function + +Arguments and Values:: +...................... + +control-string--a format string; not evaluated. + + function--a function. + +Description:: +............. + +Returns a function which has behavior equivalent to: + + #'(lambda (*standard-output* &rest arguments) + (apply #'format t control-string arguments) + arguments-tail) + + where arguments-tail is either the tail of arguments which has as its +car the argument that would be processed next if there were more format +directives in the control-string, or else nil if no more arguments +follow the most recently processed argument. + +Examples:: +.......... + + (funcall (formatter "~&~A~A") *standard-output* 'a 'b 'c) + |> AB + => (C) + + (format t (formatter "~&~A~A") 'a 'b 'c) + |> AB + => NIL + +Exceptional Situations:: +........................ + +Might signal an error (at macro expansion time or at run time) if the +argument is not a valid format string. + +See Also:: +.......... + +*note format:: + + +File: gcl.info, Node: pprint-dispatch, Next: pprint-exit-if-list-exhausted, Prev: formatter, Up: Printer Dictionary + +22.4.3 pprint-dispatch [Function] +--------------------------------- + +'pprint-dispatch' object &optional table => function, found-p + +Arguments and Values:: +...................... + +object--an object. + + table--a pprint dispatch table, or nil. The default is the value of +*print-pprint-dispatch*. + + function--a function designator. + + found-p--a generalized boolean. + +Description:: +............. + +Retrieves the highest priority function in table that is associated with +a type specifier that matches object. The function is chosen by finding +all of the type specifiers in table that match the object and selecting +the highest priority function associated with any of these type +specifiers. If there is more than one highest priority function, an +arbitrary choice is made. If no type specifiers match the object, a +function is returned that prints object + + using print-object. + + The secondary value, found-p, is true if a matching type specifier +was found in table, or false otherwise. + + If table is nil, retrieval is done in the initial pprint dispatch +table. + +Affected By:: +............. + +The state of the table. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if table is neither a +pprint-dispatch-table nor nil. + +Notes:: +....... + + (let ((*print-pretty* t)) + (write object :stream s)) + == (funcall (pprint-dispatch object) s object) + + +File: gcl.info, Node: pprint-exit-if-list-exhausted, Next: pprint-fill, Prev: pprint-dispatch, Up: Printer Dictionary + +22.4.4 pprint-exit-if-list-exhausted [Local Macro] +-------------------------------------------------- + +Syntax:: +........ + +'pprint-exit-if-list-exhausted' => nil + +Description:: +............. + +Tests whether or not the list passed to the lexically current logical +block has been exhausted; see *note Dynamic Control of the Arrangement +of Output::. If this list has been reduced to nil, +pprint-exit-if-list-exhausted terminates the execution of the lexically +current logical block except for the printing of the suffix. Otherwise +pprint-exit-if-list-exhausted returns nil. + + Whether or not pprint-exit-if-list-exhausted is fbound in the global +environment is implementation-dependent; however, the restrictions on +redefinition and shadowing of pprint-exit-if-list-exhausted are the same +as for symbols in the COMMON-LISP package which are fbound in the global +environment. The consequences of attempting to use +pprint-exit-if-list-exhausted outside of pprint-logical-block are +undefined. + +Exceptional Situations:: +........................ + +An error is signaled (at macro expansion time or at run time) if +pprint-exit-if-list-exhausted is used anywhere other than lexically +within a call on pprint-logical-block. Also, the consequences of +executing pprint-if-list-exhausted outside of the dynamic extent of the +pprint-logical-block which lexically contains it are undefined. + +See Also:: +.......... + +*note pprint-logical-block:: , *note pprint-pop:: . + + +File: gcl.info, Node: pprint-fill, Next: pprint-indent, Prev: pprint-exit-if-list-exhausted, Up: Printer Dictionary + +22.4.5 pprint-fill, pprint-linear, pprint-tabular [Function] +------------------------------------------------------------ + +'pprint-fill' stream object &optional colon-p at-sign-p => nil + + 'pprint-linear' stream object &optional colon-p at-sign-p => nil + + 'pprint-tabular' stream object &optional colon-p at-sign-p tabsize => +nil + +Arguments and Values:: +...................... + +stream--an output stream designator. + + object--an object. + + colon-p--a generalized boolean. The default is true. + + at-sign-p--a generalized boolean. The default is +implementation-dependent. + + tabsize--a non-negative integer. The default is 16. + +Description:: +............. + +The functions pprint-fill, pprint-linear, and pprint-tabular specify +particular ways of pretty printing a list to stream. Each function +prints parentheses around the output if and only if colon-p is true. +Each function ignores its at-sign-p argument. (Both arguments are +included even though only one is needed so that these functions can be +used via ~/.../ and as set-pprint-dispatch functions, as well as +directly.) Each function handles abbreviation and the detection of +circularity and sharing correctly, and uses write to print object when +it is a non-list. + + If object is a list and if the value of *print-pretty* is false, each +of these functions prints object using a minimum of whitespace, as +described in *note Printing Lists and Conses::. Otherwise (if object is +a list and if the value of *print-pretty* is true): + +* + The function pprint-linear prints a list either all on one line, or + with each element on a separate line. + +* + The function pprint-fill prints a list with as many elements as + possible on each line. + +* + The function pprint-tabular is the same as pprint-fill except that + it prints the elements so that they line up in columns. The + tabsize specifies the column spacing in ems, which is the total + spacing from the leading edge of one column to the leading edge of + the next. + +Examples:: +.......... + +Evaluating the following with a line length of 25 produces the output +shown. + + (progn (princ "Roads ") + (pprint-tabular *standard-output* '(elm main maple center) nil nil 8)) + Roads ELM MAIN + MAPLE CENTER + +Side Effects:: +.............. + +Performs output to the indicated stream. + +Affected By:: +............. + +The cursor position on the indicated stream, if it can be determined. + +Notes:: +....... + +The function pprint-tabular could be defined as follows: + + (defun pprint-tabular (s list &optional (colon-p t) at-sign-p (tabsize nil)) + (declare (ignore at-sign-p)) + (when (null tabsize) (setq tabsize 16)) + (pprint-logical-block (s list :prefix (if colon-p "(" "") + :suffix (if colon-p ")" "")) + (pprint-exit-if-list-exhausted) + (loop (write (pprint-pop) :stream s) + (pprint-exit-if-list-exhausted) + (write-char #\Space s) + (pprint-tab :section-relative 0 tabsize s) + (pprint-newline :fill s)))) + + Note that it would have been inconvenient to specify this function +using format, because of the need to pass its tabsize argument through +to a ~:T format directive nested within an iteration over a list. + + +File: gcl.info, Node: pprint-indent, Next: pprint-logical-block, Prev: pprint-fill, Up: Printer Dictionary + +22.4.6 pprint-indent [Function] +------------------------------- + +'pprint-indent' relative-to n &optional stream => nil + +Arguments and Values:: +...................... + +relative-to--either :block or :current. + + n--a real. + + stream--an output stream designator. The default is standard output. + +Description:: +............. + +pprint-indent specifies the indentation to use in a logical block on +stream. + + If stream is a pretty printing stream and the value of *print-pretty* +is true, pprint-indent sets the indentation in the innermost dynamically +enclosing logical block; otherwise, pprint-indent has no effect. + + N specifies the indentation in ems. If relative-to is :block, the +indentation is set to the horizontal position of the first character in +the dynamically current logical block plus n ems. If relative-to is +:current, the indentation is set to the current output position plus n +ems. (For robustness in the face of variable-width fonts, it is +advisable to use :current with an n of zero whenever possible.) + + N can be negative; however, the total indentation cannot be moved +left of the beginning of the line or left of the end of the rightmost +per-line prefix--an attempt to move beyond one of these limits is +treated the same as an attempt to move to that limit. Changes in +indentation caused by pprint-indent do not take effect until after the +next line break. In addition, in miser mode all calls to pprint-indent +are ignored, forcing the lines corresponding to the logical block to +line up under the first character in the block. + +Exceptional Situations:: +........................ + +An error is signaled if relative-to is any object other than :block or +:current. + +See Also:: +.......... + +*note Tilde I-> Indent:: + + +File: gcl.info, Node: pprint-logical-block, Next: pprint-newline, Prev: pprint-indent, Up: Printer Dictionary + +22.4.7 pprint-logical-block [Macro] +----------------------------------- + +'pprint-logical-block' (stream-symbol object &key prefix per-line-prefix +suffix) {declaration}* {form}* +=> nil + +Arguments and Values:: +...................... + +stream-symbol--a stream variable designator. + + object--an object; evaluated. + + :prefix--a string; evaluated. Complicated defaulting behavior; see +below. + + :per-line-prefix--a string; evaluated. Complicated defaulting +behavior; see below. + + :suffix--a string; evaluated. The default is the null string. + + declaration--a declare expression; not evaluated. + + forms--an implicit progn. + +Description:: +............. + +Causes printing to be grouped into a logical block. + + The logical block is printed to the stream that is the value of the +variable denoted by stream-symbol. During the execution of the forms, +that variable is bound to a pretty printing stream that supports +decisions about the arrangement of output and then forwards the output +to the destination stream. + + All the standard printing functions (e.g., write, princ, and terpri) +can be used to print output to the pretty printing stream. All and only +the output sent to this pretty printing stream is treated as being in +the logical block. + + The prefix specifies a prefix to be printed before the beginning of +the logical block. The per-line-prefix specifies a prefix that is +printed before the block and at the beginning of each new line in the +block. The :prefix and :pre-line-prefix arguments are mutually +exclusive. If neither :prefix nor :per-line-prefix is specified, a +prefix of the null string is assumed. + + The suffix specifies a suffix that is printed just after the logical +block. + + The object is normally a list that the body forms are responsible for +printing. If object is not a list, it is printed using write. (This +makes it easier to write printing functions that are robust in the face +of malformed arguments.) If *print-circle* is non-nil and object is a +circular (or shared) reference to a cons, then an appropriate "#n#" +marker is printed. (This makes it easy to write printing functions that +provide full support for circularity and sharing abbreviation.) If +*print-level* is not nil and the logical block is at a dynamic nesting +depth of greater than *print-level* in logical blocks, "#" is printed. +(This makes easy to write printing functions that provide full support +for depth abbreviation.) + + If either of the three conditions above occurs, the indicated output +is printed on stream-symbol and the body forms are skipped along with +the printing of the :prefix and :suffix. (If the body forms are not to +be responsible for printing a list, then the first two tests above can +be turned off by supplying nil for the object argument.) + + In addition to the object argument of pprint-logical-block, the +arguments of the standard printing functions (such as write, print, +prin1, and pprint, as well as the arguments of the standard format +directives such as ~A, ~S, (and ~W) are all checked (when necessary) for +circularity and sharing. However, such checking is not applied to the +arguments of the functions write-line, write-string, and write-char or +to the literal text output by format. A consequence of this is that you +must use one of the latter functions if you want to print some literal +text in the output that is not supposed to be checked for circularity or +sharing. + + The body forms of a pprint-logical-block form must not perform any +side-effects on the surrounding environment; for example, no variables +must be assigned which have not been bound within its scope. + + The pprint-logical-block macro may be used regardless of the value of +*print-pretty*. + +Affected By:: +............. + +*print-circle*, *print-level*. + +Exceptional Situations:: +........................ + +An error of type type-error is signaled if any of the :suffix, :prefix, +or :per-line-prefix is supplied but does not evaluate to a string. + + An error is signaled if :prefix and :pre-line-prefix are both used. + + pprint-logical-block and the pretty printing stream it creates have +dynamic extent. The consequences are undefined if, outside of this +extent, output is attempted to the pretty printing stream it creates. + + It is also unspecified what happens if, within this extent, any +output is sent directly to the underlying destination stream. + +See Also:: +.......... + +*note pprint-pop:: , *note pprint-exit-if-list-exhausted:: , *note Tilde +Less-Than-Sign-> Logical Block:: + +Notes:: +....... + +One reason for using the pprint-logical-block macro when the value of +*print-pretty* is nil would be to allow it to perform checking for +dotted lists, as well as (in conjunction with pprint-pop) checking for +*print-level* or *print-length* being exceeded. + + Detection of circularity and sharing is supported by the pretty +printer by in essence performing requested output twice. On the first +pass, circularities and sharing are detected and the actual outputting +of characters is suppressed. On the second pass, the appropriate "#n=" +and "#n#" markers are inserted and characters are output. This is why +the restriction on side-effects is necessary. Obeying this restriction +is facilitated by using pprint-pop, instead of an ordinary pop when +traversing a list being printed by the body forms of the +pprint-logical-block form.) + + +File: gcl.info, Node: pprint-newline, Next: pprint-pop, Prev: pprint-logical-block, Up: Printer Dictionary + +22.4.8 pprint-newline [Function] +-------------------------------- + +'pprint-newline' kind &optional stream => nil + +Arguments and Values:: +...................... + +kind--one of :linear, :fill, :miser, or :mandatory. + + stream--a stream designator. The default is standard output. + +Description:: +............. + +If stream is a pretty printing stream and the value of *print-pretty* is +true, a line break is inserted in the output when the appropriate +condition below is satisfied; otherwise, pprint-newline has no effect. + + Kind specifies the style of conditional newline. This parameter is +treated as follows: + +:linear + This specifies a "linear-style" conditional newline. + + A line break is inserted if and only if the immediately containing + section cannot be printed on one line. The effect of this is that + line breaks are either inserted at every linear-style conditional + newline in a logical block or at none of them. + +:miser + This specifies a "miser-style" conditional newline. + + A line break is inserted if and only if the immediately containing + section cannot be printed on one line and miser style is in effect + in the immediately containing logical block. The effect of this is + that miser-style conditional newlines act like linear-style + conditional newlines, but only when miser style is in effect. + Miser style is in effect for a logical block if and only if the + starting position of the logical block is less than or equal to + *print-miser-width* ems from the right margin. + +:fill + This specifies a "fill-style" conditional newline. + + A line break is inserted if and only if either (a) the following + section cannot be printed on the end of the current line, (b) the + preceding section was not printed on a single line, or (c) the + immediately containing section cannot be printed on one line and + miser style is in effect in the immediately containing logical + block. If a logical block is broken up into a number of + subsections by fill-style conditional newlines, the basic effect is + that the logical block is printed with as many subsections as + possible on each line. However, if miser style is in effect, + fill-style conditional newlines act like linear-style conditional + newlines. + +:mandatory + This specifies a "mandatory-style" conditional newline. + + A line break is always inserted. This implies that none of the + containing sections can be printed on a single line and will + therefore trigger the insertion of line breaks at linear-style + conditional newlines in these sections. + + When a line break is inserted by any type of conditional newline, any +blanks that immediately precede the conditional newline are omitted from +the output and indentation is introduced at the beginning of the next +line. By default, the indentation causes the following line to begin in +the same horizontal position as the first character in the immediately +containing logical block. (The indentation can be changed via +pprint-indent.) + + There are a variety of ways unconditional newlines can be introduced +into the output (i.e., via terpri or by printing a string containing a +newline character). As with mandatory conditional newlines, this +prevents any of the containing sections from being printed on one line. +In general, when an unconditional newline is encountered, it is printed +out without suppression of the preceding blanks and without any +indentation following it. However, if a per-line prefix has been +specified (see pprint-logical-block), this prefix will always be printed +no matter how a newline originates. + +Examples:: +.......... + +See *note Examples of using the Pretty Printer::. + +Side Effects:: +.............. + +Output to stream. + +Affected By:: +............. + +*print-pretty*, *print-miser*. The presence of containing logical +blocks. The placement of newlines and conditional newlines. + +Exceptional Situations:: +........................ + +An error of type type-error is signaled if kind is not one of :linear, +:fill, :miser, or :mandatory. + +See Also:: +.......... + +*note Tilde Underscore-> Conditional Newline::, *note Examples of using +the Pretty Printer:: + + +File: gcl.info, Node: pprint-pop, Next: pprint-tab, Prev: pprint-newline, Up: Printer Dictionary + +22.4.9 pprint-pop [Local Macro] +------------------------------- + +Syntax:: +........ + +'pprint-pop' => object + +Arguments and Values:: +...................... + +object--an element of the list being printed in the lexically current +logical block, or nil. + +Description:: +............. + +Pops one element from the list being printed in the lexically current +logical block, obeying *print-length* and *print-circle* as described +below. + + Each time pprint-pop is called, it pops the next value off the list +passed to the lexically current logical block and returns it. However, +before doing this, it performs three tests: + +* + If the remaining 'list' is not a list, ". " is printed followed by + the remaining 'list.' (This makes it easier to write printing + functions that are robust in the face of malformed arguments.) + +* + If *print-length* is non-nil, and pprint-pop has already been + called *print-length* times within the immediately containing + logical block, "..." is printed. (This makes it easy to write + printing functions that properly handle *print-length*.) + +* + If *print-circle* is non-nil, and the remaining list is a circular + (or shared) reference, then ". " is printed followed by an + appropriate "#n#" marker. (This catches instances of cdr + circularity and sharing in lists.) + + If either of the three conditions above occurs, the indicated output +is printed on the pretty printing stream created by the immediately +containing pprint-logical-block and the execution of the immediately +containing pprint-logical-block is terminated except for the printing of +the suffix. + + If pprint-logical-block is given a 'list' argument of nil--because it +is not processing a list--pprint-pop can still be used to obtain support +for *print-length*. In this situation, the first and third tests above +are disabled and pprint-pop always returns nil. See *note Examples of +using the Pretty Printer::--specifically, the pprint-vector example. + + Whether or not pprint-pop is fbound in the global environment is +implementation-dependent; however, the restrictions on redefinition and +shadowing of pprint-pop are the same as for symbols in the COMMON-LISP +package which are fbound in the global environment. The consequences of +attempting to use pprint-pop outside of pprint-logical-block are +undefined. + +Side Effects:: +.............. + +Might cause output to the pretty printing stream associated with the +lexically current logical block. + +Affected By:: +............. + +*print-length*, *print-circle*. + +Exceptional Situations:: +........................ + +An error is signaled (either at macro expansion time or at run time) if +a usage of pprint-pop occurs where there is no lexically containing +pprint-logical-block form. + + The consequences are undefined if pprint-pop is executed outside of +the dynamic extent of this pprint-logical-block. + +See Also:: +.......... + +*note pprint-exit-if-list-exhausted:: , *note pprint-logical-block:: . + +Notes:: +....... + +It is frequently a good idea to call pprint-exit-if-list-exhausted +before calling pprint-pop. + + +File: gcl.info, Node: pprint-tab, Next: print-object, Prev: pprint-pop, Up: Printer Dictionary + +22.4.10 pprint-tab [Function] +----------------------------- + +'pprint-tab' kind colnum colinc &optional stream => nil + +Arguments and Values:: +...................... + +kind--one of :line, :section, :line-relative, or :section-relative. + + colnum--a non-negative integer. + + colinc--a non-negative integer. + + stream--an output stream designator. + +Description:: +............. + +Specifies tabbing to stream as performed by the standard ~T format +directive. + + If stream is a pretty printing stream and the value of *print-pretty* +is true, + + tabbing is performed; otherwise, pprint-tab has no effect. + + The arguments colnum and colinc correspond to the two parameters to +~T and are in terms of ems. The kind argument specifies the style of +tabbing. It must be one of :line (tab as by ~T), :section (tab as by +~:T, but measuring horizontal positions relative to the start of the +dynamically enclosing section), :line-relative (tab as by ~@T), or +:section-relative (tab as by ~:@T, but measuring horizontal positions +relative to the start of the dynamically enclosing section). + +Exceptional Situations:: +........................ + +An error is signaled if kind is not one of :line, :section, +:line-relative, or :section-relative. + +See Also:: +.......... + +*note pprint-logical-block:: + + +File: gcl.info, Node: print-object, Next: print-unreadable-object, Prev: pprint-tab, Up: Printer Dictionary + +22.4.11 print-object [Standard Generic Function] +------------------------------------------------ + +Syntax:: +........ + +'print-object' object stream => object + +Method Signatures:: +................... + +'print-object' (object standard-object) stream + + 'print-object' (object structure-object) stream + +Arguments and Values:: +...................... + +object--an object. + + stream--a stream. + +Description:: +............. + +The generic function print-object writes the printed representation of +object to stream. The function print-object is called by the Lisp +printer; it should not be called by the user. + + Each implementation is required to provide a method on the class +standard-object and on the class structure-object. In addition, each +implementation must provide methods on enough other classes so as to +ensure that there is always an applicable method. Implementations are +free to add methods for other classes. Users may write methods for +print-object for their own classes if they do not wish to inherit an +implementation-dependent method. + + The method on the class structure-object prints the object in the +default #S notation; see *note Printing Structures::. + + Methods on print-object are responsible for implementing their part +of the semantics of the printer control variables, as follows: + +*print-readably* + All methods for print-object must obey *print-readably*. This + includes both user-defined methods and implementation-defined + methods. Readable printing of structures and standard objects is + controlled by their print-object method, not by their + make-load-form method. Similarity for these objects is application + dependent and hence is defined to be whatever these methods do; see + *note Similarity of Literal Objects::. + +*print-escape* + Each method must implement *print-escape*. + +*print-pretty* + + The method may wish to perform specialized line breaking or other + output conditional on the value of *print-pretty*. For further + information, see (for example) the macro pprint-fill. See also + *note Pretty Print Dispatch Tables:: and *note Examples of using + the Pretty Printer::. + +*print-length* + Methods that produce output of indefinite length must obey + *print-length*. + + For further information, see (for example) the macros + pprint-logical-block and pprint-pop. See also *note Pretty Print + Dispatch Tables:: and *note Examples of using the Pretty Printer::. + +*print-level* + The printer takes care of *print-level* automatically, provided + that each method handles exactly one level of structure and calls + write (or an equivalent function) recursively if there are more + structural levels. The printer's decision of whether an object has + components (and therefore should not be printed when the printing + depth is not less than *print-level*) is implementation-dependent. + In some implementations its print-object method is not called; in + others the method is called, and the determination that the object + has components is based on what it tries to write to the stream. + +*print-circle* + + When the value of *print-circle* is true, a user-defined + + print-object method + + can print objects to the supplied stream using write, prin1, princ, + or format and expect circularities to be detected and printed using + the #n# syntax. If a user-defined + + print-object method + + prints to a stream other than the one that was supplied, then + circularity detection starts over for that stream. See + *print-circle*. + +*print-base*, + *print-radix*, *print-case*, *print-gensym*, and *print-array* + These printer control variables apply to specific types of objects + and are handled by the methods for those objects. + + If these rules are not obeyed, the results are undefined. + + In general, the printer and the print-object methods should not +rebind the print control variables as they operate recursively through +the structure, but this is implementation-dependent. + + In some implementations the stream argument passed to a print-object +method is not the original stream, but is an intermediate stream that +implements part of the printer. methods should therefore not depend on +the identity of this stream. + +See Also:: +.......... + +*note pprint-fill:: , *note pprint-logical-block:: , *note pprint-pop:: +, *note write:: , *print-readably*, *print-escape*, *print-pretty*, +*print-length*, *note Default Print-Object Methods::, + + *note Printing Structures::, + + *note Pretty Print Dispatch Tables::, *note Examples of using the +Pretty Printer:: + + +File: gcl.info, Node: print-unreadable-object, Next: set-pprint-dispatch, Prev: print-object, Up: Printer Dictionary + +22.4.12 print-unreadable-object [Macro] +--------------------------------------- + +'print-unreadable-object' (object stream &key type identity) {form}* => +nil + +Arguments and Values:: +...................... + +object--an object; evaluated. + + stream-- a stream designator; evaluated. + + type--a generalized boolean; evaluated. + + identity--a generalized boolean; evaluated. + + forms--an implicit progn. + +Description:: +............. + +Outputs a printed representation of object on stream, beginning with +"#<" and ending with ">". Everything output to stream by the body forms +is enclosed in the the angle brackets. If type is true, the output from +forms is preceded by a brief description of the object's type and a +space character. If identity is true, the output from forms is followed +by a space character and a representation of the object's identity, +typically a storage address. + + If either type or identity is not supplied, its value is false. It +is valid to omit the body forms. If type and identity are both true and +there are no body forms, only one space character separates the type and +the identity. + +Examples:: +.......... + +;; Note that in this example, the precise form of the output ;; is +implementation-dependent. + + (defmethod print-object ((obj airplane) stream) + (print-unreadable-object (obj stream :type t :identity t) + (princ (tail-number obj) stream))) + + (prin1-to-string my-airplane) + => "#" + OR=> "#" + +Exceptional Situations:: +........................ + +If *print-readably* is true, print-unreadable-object signals an error of +type print-not-readable without printing anything. + + +File: gcl.info, Node: set-pprint-dispatch, Next: write, Prev: print-unreadable-object, Up: Printer Dictionary + +22.4.13 set-pprint-dispatch [Function] +-------------------------------------- + +'set-pprint-dispatch' type-specifier function &optional priority table +=> nil + +Arguments and Values:: +...................... + +type-specifier--a type specifier. + + function--a function, a function name, or nil. + + priority--a real. The default is 0. + + table--a pprint dispatch table. The default is the value of +*print-pprint-dispatch*. + +Description:: +............. + +Installs an entry into the pprint dispatch table which is table. + + Type-specifier is the key of the entry. The first action of +set-pprint-dispatch is to remove any pre-existing entry associated with +type-specifier. This guarantees that there will never be two entries +associated with the same type specifier in a given pprint dispatch +table. Equality of type specifiers is tested by equal. + + Two values are associated with each type specifier in a pprint +dispatch table: a function and a priority. The function must accept two +arguments: the stream to which output is sent and the object to be +printed. The function should pretty print the object to the stream. +The function can assume that object satisfies the type given by +type-specifier. The function must obey *print-readably*. Any values +returned by the function are ignored. + + Priority is a priority to resolve conflicts when an object matches +more than one entry. + + It is permissible for function to be nil. In this situation, there +will be no type-specifier entry in table after set-pprint-dispatch +returns. + +Exceptional Situations:: +........................ + +An error is signaled if priority is not a real. + +Notes:: +....... + +Since pprint dispatch tables are often used to control the pretty +printing of Lisp code, it is common for the type-specifier to be an +expression of the form + + (cons car-type cdr-type) + + This signifies that the corresponding object must be a cons cell +whose car matches the type specifier car-type and whose cdr matches the +type specifier cdr-type. The cdr-type can be omitted in which case it +defaults to t. + + +File: gcl.info, Node: write, Next: write-to-string, Prev: set-pprint-dispatch, Up: Printer Dictionary + +22.4.14 write, prin1, print, pprint, princ [Function] +----------------------------------------------------- + +'write' object &key \writekeysstream +=> object + + 'prin' 1 => object &optional output-stream object 'princ' object +&optional output-stream => object + + 'print' object &optional output-stream => object + + 'pprint' object &optional output-stream => + +Arguments and Values:: +...................... + +object--an object. + + output-stream--an output stream designator. The default is standard +output. + + \writekeydescriptionsstream--an output stream designator. The +default is standard output. + +Description:: +............. + +write, prin1, princ, print, and pprint write the printed representation +of object to output-stream. + + write is the general entry point to the Lisp printer. For each +explicitly supplied keyword parameter named in Figure 22-6, the +corresponding printer control variable is dynamically bound to its value +while printing goes on; for each keyword parameter in Figure 22-6 that +is not explicitly supplied, the value of the corresponding printer +control variable is the same as it was at the time write was invoked. +Once the appropriate bindings are established, the object is output by +the Lisp printer. + + Parameter Corresponding Dynamic Variable + array *print-array* + base *print-base* + case *print-case* + circle *print-circle* + escape *print-escape* + gensym *print-gensym* + length *print-length* + level *print-level* + lines *print-lines* + miser-width *print-miser-width* + pprint-dispatch *print-pprint-dispatch* + pretty *print-pretty* + radix *print-radix* + readably *print-readably* + right-margin *print-right-margin* + + Figure 22-6: Argument correspondences for the WRITE function. + + + prin1, princ, print, and pprint implicitly bind certain print +parameters to particular values. The remaining parameter values are +taken from *print-array*, *print-base*, *print-case*, *print-circle*, +*print-escape*, *print-gensym*, *print-length*, *print-level*, +*print-lines*, *print-miser-width*, *print-pprint-dispatch*, +*print-pretty*, *print-radix*, and *print-right-margin*. + + prin1 produces output suitable for input to read. It binds +*print-escape* to true. + + princ is just like prin1 except that the output has no escape +characters. It binds *print-escape* to false + + and *print-readably* to false. + + The general rule is that output from princ is intended to look good +to people, while output from prin1 is intended to be acceptable to read. + + print is just like prin1 except that the printed representation of +object is preceded by a newline and followed by a space. + + pprint is just like print except that the trailing space is omitted +and object is printed with the *print-pretty* flag non-nil to produce +pretty output. + + Output-stream specifies the stream to which output is to be sent. + +Affected By:: +............. + +*standard-output*, *terminal-io*, *print-escape*, *print-radix*, +*print-base*, *print-circle*, *print-pretty*, *print-level*, +*print-length*, *print-case*, *print-gensym*, *print-array*, +*read-default-float-format*. + +See Also:: +.......... + +*note readtable-case:: , *note FORMAT Printer Operations:: + +Notes:: +....... + +The functions prin1 and print do not bind *print-readably*. + + (prin1 object output-stream) + == (write object :stream output-stream :escape t) + + (princ object output-stream) + == (write object stream output-stream :escape nil :readably nil) + + (print object output-stream) + == (progn (terpri output-stream) + (write object :stream output-stream + :escape t) + (write-char #\space output-stream)) + + (pprint object output-stream) + == (write object :stream output-stream :escape t :pretty t) + + +File: gcl.info, Node: write-to-string, Next: *print-array*, Prev: write, Up: Printer Dictionary + +22.4.15 write-to-string, prin1-to-string, princ-to-string [Function] +-------------------------------------------------------------------- + +'write-to-string' object &key \writekeys +=> string + + 'prin' 1 => -to-string object string + + 'princ-to-string' object => string + +Arguments and Values:: +...................... + +object--an object. + + \writekeydescriptions + + string--a string. + +Description:: +............. + +write-to-string, prin1-to-string, and princ-to-string are used to create +a string consisting of the printed representation of object. Object is +effectively printed as if by write, prin1, or princ, respectively, and +the characters that would be output are made into a string. + + write-to-string is the general output function. It has the ability +to specify all the parameters applicable to the printing of object. + + prin1-to-string acts like write-to-string with :escape t, that is, +escape characters are written where appropriate. + + princ-to-string acts like write-to-string with + + :escape nil :readably nil. + + Thus no escape characters are written. + + All other keywords that would be specified to write-to-string are +default values when prin1-to-string or princ-to-string is invoked. + + The meanings and defaults for the keyword arguments to +write-to-string are the same as those for write. + +Examples:: +.......... + + (prin1-to-string "abc") => "\"abc\"" + (princ-to-string "abc") => "abc" + +Affected By:: +............. + +*print-escape*, *print-radix*, *print-base*, *print-circle*, +*print-pretty*, *print-level*, *print-length*, *print-case*, +*print-gensym*, *print-array*, *read-default-float-format*. + +See Also:: +.......... + +*note write:: + +Notes:: +....... + + (write-to-string object {key argument}*) + == (with-output-to-string (#1=#:string-stream) + (write object :stream #1# {key argument}*)) + + (princ-to-string object) + == (with-output-to-string (string-stream) + (princ object string-stream)) + + (prin1-to-string object) + == (with-output-to-string (string-stream) + (prin1 object string-stream)) + + +File: gcl.info, Node: *print-array*, Next: *print-base*, Prev: write-to-string, Up: Printer Dictionary + +22.4.16 *print-array* [Variable] +-------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +Controls the format in which arrays are printed. If it is false, the +contents of arrays other than strings are never printed. Instead, +arrays are printed in a concise form using #< that gives enough +information for the user to be able to identify the array, but does not +include the entire array contents. If it is true, non-string arrays are +printed using #(...), #*, or #nA syntax. + +Affected By:: +............. + +The implementation. + +See Also:: +.......... + +*note Sharpsign Left-Parenthesis::, *note Sharpsign Less-Than-Sign:: + + +File: gcl.info, Node: *print-base*, Next: *print-case*, Prev: *print-array*, Up: Printer Dictionary + +22.4.17 *print-base*, *print-radix* [Variable] +---------------------------------------------- + +Value Type:: +............ + +*print-base*--a radix. *print-radix*--a generalized boolean. + +Initial Value:: +............... + +The initial value of *print-base* is 10. The initial value of +*print-radix* is false. + +Description:: +............. + +*print-base* and *print-radix* control the printing of rationals. The +value of *print-base* is called the current output base . + + The value of *print-base* is the radix in which the printer will +print rationals. For radices above 10, letters of the alphabet are used +to represent digits above 9. + + If the value of *print-radix* is true, the printer will print a radix +specifier to indicate the radix in which it is printing a rational +number. The radix specifier is always printed using lowercase letters. +If *print-base* is 2, 8, or 16, then the radix specifier used is #b, #o, +or #x, respectively. For integers, base ten is indicated by a trailing +decimal point instead of a leading radix specifier; for ratios, #10r is +used. + +Examples:: +.......... + + (let ((*print-base* 24.) (*print-radix* t)) + (print 23.)) + |> #24rN + => 23 + (setq *print-base* 10) => 10 + (setq *print-radix* nil) => NIL + (dotimes (i 35) + (let ((*print-base* (+ i 2))) ;print the decimal number 40 + (write 40) ;in each base from 2 to 36 + (if (zerop (mod i 10)) (terpri) (format t " ")))) + |> 101000 + |> 1111 220 130 104 55 50 44 40 37 34 + |> 31 2C 2A 28 26 24 22 20 1J 1I + |> 1H 1G 1F 1E 1D 1C 1B 1A 19 18 + |> 17 16 15 14 + => NIL + (dolist (pb '(2 3 8 10 16)) + (let ((*print-radix* t) ;print the integer 10 and + (*print-base* pb)) ;the ratio 1/10 in bases 2, + (format t "~&~S ~S~ + |> #b1010 #b1/1010 + |> #3r101 #3r1/101 + |> #o12 #o1/12 + |> 10. #10r1/10 + |> #xA #x1/A + => NIL + +Affected By:: +............. + +Might be bound by format, and write, write-to-string. + +See Also:: +.......... + +*note format:: , *note write:: , *note write-to-string:: + + +File: gcl.info, Node: *print-case*, Next: *print-circle*, Prev: *print-base*, Up: Printer Dictionary + +22.4.18 *print-case* [Variable] +------------------------------- + +Value Type:: +............ + +One of the symbols :upcase, :downcase, or :capitalize. + +Initial Value:: +............... + +The symbol :upcase. + +Description:: +............. + +The value of *print-case* controls the case (upper, lower, or mixed) in +which to print any uppercase characters in the names of symbols when +vertical-bar syntax is not used. + + *print-case* has an effect at all times when the value of +*print-escape* is false. *print-case* also has an effect when the value +of *print-escape* is true unless inside an escape context (i.e., unless +between vertical-bars or after a slash). + +Examples:: +.......... + + (defun test-print-case () + (dolist (*print-case* '(:upcase :downcase :capitalize)) + (format t "~&~S ~S~ + => TEST-PC + ;; Although the choice of which characters to escape is specified by + ;; *PRINT-CASE*, the choice of how to escape those characters + ;; (i.e., whether single escapes or multiple escapes are used) + ;; is implementation-dependent. The examples here show two of the + ;; many valid ways in which escaping might appear. + (test-print-case) ;Implementation A + |> THIS-AND-THAT |And-something-elSE| + |> this-and-that a\n\d-\s\o\m\e\t\h\i\n\g-\e\lse + |> This-And-That A\n\d-\s\o\m\e\t\h\i\n\g-\e\lse + => NIL + (test-print-case) ;Implementation B + |> THIS-AND-THAT |And-something-elSE| + |> this-and-that a|nd-something-el|se + |> This-And-That A|nd-something-el|se + => NIL + +See Also:: +.......... + +*note write:: + +Notes:: +....... + +read normally converts lowercase characters appearing in symbols to +corresponding uppercase characters, so that internally print names +normally contain only uppercase characters. + + If *print-escape* is true, lowercase characters in the name of a +symbol are always printed in lowercase, and are preceded by a single +escape character or enclosed by multiple escape characters; uppercase +characters in the name of a symbol are printed in upper case, in lower +case, or in mixed case so as to capitalize words, according to the value +of *print-case*. The convention for what constitutes a "word" is the +same as for string-capitalize. + + +File: gcl.info, Node: *print-circle*, Next: *print-escape*, Prev: *print-case*, Up: Printer Dictionary + +22.4.19 *print-circle* [Variable] +--------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +false. + +Description:: +............. + +Controls the attempt to detect circularity and sharing in an object +being printed. + + If false, the printing process merely proceeds by recursive descent +without attempting to detect circularity and sharing. + + If true, the printer will endeavor to detect cycles and sharing in +the structure to be printed, and to use #n= and #n# syntax to indicate +the circularities or shared components. + + If true, a user-defined + + print-object method + + can print objects to the supplied stream using write, prin1, princ, +or format and expect circularities and sharing to be detected and +printed using the #n# syntax. + + If a user-defined + + print-object method + + prints to a stream other than the one that was supplied, then +circularity detection starts over for that stream. + + Note that implementations should not use #n# notation when the Lisp +reader would automatically assure sharing without it (e.g., as happens +with interned symbols). + +Examples:: +.......... + + (let ((a (list 1 2 3))) + (setf (cdddr a) a) + (let ((*print-circle* t)) + (write a) + :done)) + |> #1=(1 2 3 . #1#) + => :DONE + +See Also:: +.......... + +*note write:: + +Notes:: +....... + +An attempt to print a circular structure with *print-circle* set to nil +may lead to looping behavior and failure to terminate. + + +File: gcl.info, Node: *print-escape*, Next: *print-gensym*, Prev: *print-circle*, Up: Printer Dictionary + +22.4.20 *print-escape* [Variable] +--------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +true. + +Description:: +............. + +If false, escape characters and package prefixes are not output when an +expression is printed. + + If true, an attempt is made to print an expression in such a way that +it can be read again to produce an equal expression. (This is only a +guideline; not a requirement. See *print-readably*.) + + For more specific details of how the value of *print-escape* affects +the printing of certain types, see *note Default Print-Object Methods::. + +Examples:: +.......... + + (let ((*print-escape* t)) (write #\a)) + |> #\a + => #\a + (let ((*print-escape* nil)) (write #\a)) + |> a + => #\a + +Affected By:: +............. + +princ, prin1, format + +See Also:: +.......... + +*note write:: , *note readtable-case:: + +Notes:: +....... + +princ effectively binds *print-escape* to false. prin1 effectively +binds *print-escape* to true. + + +File: gcl.info, Node: *print-gensym*, Next: *print-level*, Prev: *print-escape*, Up: Printer Dictionary + +22.4.21 *print-gensym* [Variable] +--------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +true. + +Description:: +............. + +Controls whether the prefix "#:" is printed before apparently uninterned +symbols. The prefix is printed before such symbols if and only if the +value of *print-gensym* is true. + +Examples:: +.......... + + (let ((*print-gensym* nil)) + (print (gensym))) + |> G6040 + => #:G6040 + +See Also:: +.......... + +*note write:: , *print-escape* + + +File: gcl.info, Node: *print-level*, Next: *print-lines*, Prev: *print-gensym*, Up: Printer Dictionary + +22.4.22 *print-level*, *print-length* [Variable] +------------------------------------------------ + +Value Type:: +............ + +a non-negative integer, or nil. + +Initial Value:: +............... + +nil. + +Description:: +............. + +*print-level* controls how many levels deep a nested object will print. +If it is false, then no control is exercised. Otherwise, it is an +integer indicating the maximum level to be printed. An object to be +printed is at level 0; its components (as of a list or vector) are at +level 1; and so on. If an object to be recursively printed has +components and is at a level equal to or greater than the value of +*print-level*, then the object is printed as "#". + + *print-length* controls how many elements at a given level are +printed. If it is false, there is no limit to the number of components +printed. Otherwise, it is an integer indicating the maximum number of +elements of an object to be printed. If exceeded, the printer will +print "..." in place of the other elements. In the case of a dotted +list, if the list contains exactly as many elements as the value of +*print-length*, the terminating atom is printed rather than printing +"..." + + *print-level* and *print-length* affect the printing of an any object +printed with a list-like syntax. They do not affect the printing of +symbols, strings, and bit vectors. + +Examples:: +.......... + + (setq a '(1 (2 (3 (4 (5 (6))))))) => (1 (2 (3 (4 (5 (6)))))) + (dotimes (i 8) + (let ((*print-level* i)) + (format t "~&~D -- ~S~ + |> 0 -- # + |> 1 -- (1 #) + |> 2 -- (1 (2 #)) + |> 3 -- (1 (2 (3 #))) + |> 4 -- (1 (2 (3 (4 #)))) + |> 5 -- (1 (2 (3 (4 (5 #))))) + |> 6 -- (1 (2 (3 (4 (5 (6)))))) + |> 7 -- (1 (2 (3 (4 (5 (6)))))) + => NIL + + (setq a '(1 2 3 4 5 6)) => (1 2 3 4 5 6) + (dotimes (i 7) + (let ((*print-length* i)) + (format t "~&~D -- ~S~ + |> 0 -- (...) + |> 1 -- (1 ...) + |> 2 -- (1 2 ...) + |> 3 -- (1 2 3 ...) + |> 4 -- (1 2 3 4 ...) + |> 5 -- (1 2 3 4 5 6) + |> 6 -- (1 2 3 4 5 6) + => NIL + + (dolist (level-length '((0 1) (1 1) (1 2) (1 3) (1 4) + (2 1) (2 2) (2 3) (3 2) (3 3) (3 4))) + (let ((*print-level* (first level-length)) + (*print-length* (second level-length))) + (format t "~&~D ~D -- ~S~ + *print-level* *print-length* + '(if (member x y) (+ (car x) 3) '(foo . #(a b c d "Baz")))))) + |> 0 1 -- # + |> 1 1 -- (IF ...) + |> 1 2 -- (IF # ...) + |> 1 3 -- (IF # # ...) + |> 1 4 -- (IF # # #) + |> 2 1 -- (IF ...) + |> 2 2 -- (IF (MEMBER X ...) ...) + |> 2 3 -- (IF (MEMBER X Y) (+ # 3) ...) + |> 3 2 -- (IF (MEMBER X ...) ...) + |> 3 3 -- (IF (MEMBER X Y) (+ (CAR X) 3) ...) + |> 3 4 -- (IF (MEMBER X Y) (+ (CAR X) 3) '(FOO . #(A B C D ...))) + => NIL + +See Also:: +.......... + +*note write:: + + +File: gcl.info, Node: *print-lines*, Next: *print-miser-width*, Prev: *print-level*, Up: Printer Dictionary + +22.4.23 *print-lines* [Variable] +-------------------------------- + +Value Type:: +............ + +a non-negative integer, or nil. + +Initial Value:: +............... + +nil. + +Description:: +............. + +When the value of *print-lines* is other than nil, it is a limit on the +number of output lines produced when something is pretty printed. If an +attempt is made to go beyond that many lines, ".." is printed at the end +of the last line followed by all of the suffixes (closing delimiters) +that are pending to be printed. + +Examples:: +.......... + + (let ((*print-right-margin* 25) (*print-lines* 3)) + (pprint '(progn (setq a 1 b 2 c 3 d 4)))) + |> (PROGN (SETQ A 1 + |> B 2 + |> C 3 ..)) + => + +Notes:: +....... + +The ".." notation is intentionally different than the "..." notation +used for level abbreviation, so that the two different situations can be +visually distinguished. + + This notation is used to increase the likelihood that the Lisp reader +will signal an error if an attempt is later made to read the abbreviated +output. Note however that if the truncation occurs in a string, as in +"This string has been trunc..", the problem situation cannot be detected +later and no such error will be signaled. + + +File: gcl.info, Node: *print-miser-width*, Next: *print-pprint-dispatch*, Prev: *print-lines*, Up: Printer Dictionary + +22.4.24 *print-miser-width* [Variable] +-------------------------------------- + +Value Type:: +............ + +a non-negative integer, or nil. + +Initial Value:: +............... + +implementation-dependent + +Description:: +............. + +If it is not nil, the pretty printer switches to a compact style of +output (called miser style) whenever the width available for printing a +substructure is less than or equal to this many ems. + + +File: gcl.info, Node: *print-pprint-dispatch*, Next: *print-pretty*, Prev: *print-miser-width*, Up: Printer Dictionary + +22.4.25 *print-pprint-dispatch* [Variable] +------------------------------------------ + +Value Type:: +............ + +a pprint dispatch table. + +Initial Value:: +............... + +implementation-dependent, but the initial entries all use a special +class of priorities that have the property that they are less than every +priority that can be specified using set-pprint-dispatch, so that the +initial contents of any entry can be overridden. + +Description:: +............. + +The pprint dispatch table which currently controls the pretty printer. + +See Also:: +.......... + +*print-pretty*, *note Pretty Print Dispatch Tables:: + +Notes:: +....... + +The intent is that the initial value of this variable should cause +'traditional' pretty printing of code. In general, however, you can put +a value in *print-pprint-dispatch* that makes pretty-printed output look +exactly like non-pretty-printed output. + + Setting *print-pretty* to true just causes the functions contained in +the current pprint dispatch table to have priority over normal +print-object methods; it has no magic way of enforcing that those +functions actually produce pretty output. For details, see *note Pretty +Print Dispatch Tables::. + + +File: gcl.info, Node: *print-pretty*, Next: *print-readably*, Prev: *print-pprint-dispatch*, Up: Printer Dictionary + +22.4.26 *print-pretty* [Variable] +--------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +Controls whether the Lisp printer calls the pretty printer. + + If it is false, the pretty printer is not used and + + a minimum + + of whitespace_1 is output when printing an expression. + + If it is true, the pretty printer is used, and the Lisp printer will +endeavor to insert extra whitespace_1 where appropriate to make +expressions more readable. + + *print-pretty* has an effect even when the value of *print-escape* is +false. + +Examples:: +.......... + + (setq *print-pretty* 'nil) => NIL + (progn (write '(let ((a 1) (b 2) (c 3)) (+ a b c))) nil) + |> (LET ((A 1) (B 2) (C 3)) (+ A B C)) + => NIL + (let ((*print-pretty* t)) + (progn (write '(let ((a 1) (b 2) (c 3)) (+ a b c))) nil)) + |> (LET ((A 1) + |> (B 2) + |> (C 3)) + |> (+ A B C)) + => NIL + ;; Note that the first two expressions printed by this next form + ;; differ from the second two only in whether escape characters are printed. + ;; In all four cases, extra whitespace is inserted by the pretty printer. + (flet ((test (x) + (let ((*print-pretty* t)) + (print x) + (format t "~ + (terpri) (princ x) (princ " ") + (format t "~ + (test '#'(lambda () (list "a" #'c #'d)))) + |> #'(LAMBDA () + |> (LIST "a" #'C #'D)) + |> #'(LAMBDA () + |> (LIST "a" #'C #'D)) + |> #'(LAMBDA () + |> (LIST a b 'C #'D)) + |> #'(LAMBDA () + |> (LIST a b 'C #'D)) + => NIL + +See Also:: +.......... + +*note write:: + + +File: gcl.info, Node: *print-readably*, Next: *print-right-margin*, Prev: *print-pretty*, Up: Printer Dictionary + +22.4.27 *print-readably* [Variable] +----------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +false. + +Description:: +............. + +If *print-readably* is true, some special rules for printing objects go +into effect. Specifically, printing any object O_1 produces a printed +representation that, when seen by the Lisp reader while the standard +readtable is in effect, will produce an object O_2 that is similar to +O_1. The printed representation produced might or might not be the same +as the printed representation produced when *print-readably* is false. +If printing an object readably is not possible, an error of type +print-not-readable is signaled rather than using a syntax (e.g., the +"#<" syntax) that would not be readable by the same implementation. If +the value of some other printer control variable is such that these +requirements would be violated, the value of that other variable is +ignored. + + Specifically, if *print-readably* is true, printing proceeds as if +*print-escape*, *print-array*, and *print-gensym* were also true, and as +if *print-length*, *print-level*, and *print-lines* were false. + + If *print-readably* is false, the normal rules for printing and the +normal interpretations of other printer control variables are in effect. + + Individual methods for print-object, including user-defined methods, +are responsible for implementing these requirements. + + If *read-eval* is false and *print-readably* is true, any such method +that would output a reference to the "#." reader macro will either +output something else or will signal an error (as described above). + +Examples:: +.......... + + (let ((x (list "a" '\a (gensym) '((a (b (c))) d e f g))) + (*print-escape* nil) + (*print-gensym* nil) + (*print-level* 3) + (*print-length* 3)) + (write x) + (let ((*print-readably* t)) + (terpri) + (write x) + :done)) + |> (a a G4581 ((A #) D E ...)) + |> ("a" |a| #:G4581 ((A (B (C))) D E F G)) + => :DONE + + ;; This is setup code is shared between the examples + ;; of three hypothetical implementations which follow. + (setq table (make-hash-table)) => # + (setf (gethash table 1) 'one) => ONE + (setf (gethash table 2) 'two) => TWO + + ;; Implementation A + (let ((*print-readably* t)) (print table)) + Error: Can't print # readably. + + ;; Implementation B + ;; No standardized #S notation for hash tables is defined, + ;; but there might be an implementation-defined notation. + (let ((*print-readably* t)) (print table)) + |> #S(HASH-TABLE :TEST EQL :SIZE 120 :CONTENTS (1 ONE 2 TWO)) + => # + + ;; Implementation C + ;; Note that #. notation can only be used if *READ-EVAL* is true. + ;; If *READ-EVAL* were false, this same implementation might have to + ;; signal an error unless it had yet another printing strategy to fall + ;; back on. + (let ((*print-readably* t)) (print table)) + |> #.(LET ((HASH-TABLE (MAKE-HASH-TABLE))) + |> (SETF (GETHASH 1 HASH-TABLE) ONE) + |> (SETF (GETHASH 2 HASH-TABLE) TWO) + |> HASH-TABLE) + => # + +See Also:: +.......... + +*note write:: , *note print-unreadable-object:: + +Notes:: +....... + +The rules for "similarity" imply that #A or #( syntax cannot be used for +arrays of element type other than t. An implementation will have to use +another syntax or signal an error of type print-not-readable. + + +File: gcl.info, Node: *print-right-margin*, Next: print-not-readable, Prev: *print-readably*, Up: Printer Dictionary + +22.4.28 *print-right-margin* [Variable] +--------------------------------------- + +Value Type:: +............ + +a non-negative integer, or nil. + +Initial Value:: +............... + +nil. + +Description:: +............. + +If it is non-nil, it specifies the right margin (as integer number of +ems) to use when the pretty printer is making layout decisions. + + If it is nil, the right margin is taken to be the maximum line length +such that output can be displayed without wraparound or truncation. If +this cannot be determined, an implementation-dependent value is used. + +Notes:: +....... + +This measure is in units of ems in order to be compatible with +implementation-defined variable-width fonts while still not requiring +the language to provide support for fonts. + + +File: gcl.info, Node: print-not-readable, Next: print-not-readable-object, Prev: *print-right-margin*, Up: Printer Dictionary + +22.4.29 print-not-readable [Condition Type] +------------------------------------------- + +Class Precedence List:: +....................... + +print-not-readable, error, serious-condition, condition, t + +Description:: +............. + +The type print-not-readable consists of error conditions that occur +during output while *print-readably* is true, as a result of attempting +to write a printed representation with the Lisp printer that would not +be correctly read back with the Lisp reader. The object which could not +be printed is initialized by the :object initialization argument to +make-condition, and is accessed by the function +print-not-readable-object. + +See Also:: +.......... + +*note print-not-readable-object:: + + +File: gcl.info, Node: print-not-readable-object, Next: format, Prev: print-not-readable, Up: Printer Dictionary + +22.4.30 print-not-readable-object [Function] +-------------------------------------------- + +'print-not-readable-object' condition => object + +Arguments and Values:: +...................... + +condition--a condition of type print-not-readable. + + object--an object. + +Description:: +............. + +Returns the object that could not be printed readably in the situation +represented by condition. + +See Also:: +.......... + +print-not-readable, *note Conditions:: + + +File: gcl.info, Node: format, Prev: print-not-readable-object, Up: Printer Dictionary + +22.4.31 format [Function] +------------------------- + +'format' destination control-string &rest args => result + +Arguments and Values:: +...................... + +destination--nil, t, a stream, or a string with a fill pointer. + + control-string--a format control. + + args--format arguments for control-string. + + result--if destination is non-nil, then nil; otherwise, a string. + +Description:: +............. + +format produces formatted output by outputting the characters of +control-string and observing that a tilde introduces a directive. The +character after the tilde, possibly preceded by prefix parameters and +modifiers, specifies what kind of formatting is desired. Most +directives use one or more elements of args to create their output. + + If destination is a string, a stream, or t, then the result is nil. +Otherwise, the result is a string containing the 'output.' + + format is useful for producing nicely formatted text, producing +good-looking messages, and so on. format can generate and return a +string or output to destination. + + For details on how the control-string is interpreted, see *note +Formatted Output::. + +Affected By:: +............. + +*standard-output*, *print-escape*, *print-radix*, *print-base*, +*print-circle*, *print-pretty*, *print-level*, *print-length*, +*print-case*, *print-gensym*, *print-array*. + +Exceptional Situations:: +........................ + +If destination is a string with a fill pointer, the consequences are +undefined if destructive modifications are performed directly on the +string during the dynamic extent of the call. + +See Also:: +.......... + +*note write:: , *note Documentation of Implementation-Defined Scripts:: + + +File: gcl.info, Node: Reader, Next: System Construction, Prev: Printer, Up: Top + +23 Reader +********* + +* Menu: + +* Reader Concepts:: +* Reader Dictionary:: + + +File: gcl.info, Node: Reader Concepts, Next: Reader Dictionary, Prev: Reader, Up: Reader + +23.1 Reader Concepts +==================== + +* Menu: + +* Dynamic Control of the Lisp Reader:: +* Effect of Readtable Case on the Lisp Reader:: +* Argument Conventions of Some Reader Functions:: + + +File: gcl.info, Node: Dynamic Control of the Lisp Reader, Next: Effect of Readtable Case on the Lisp Reader, Prev: Reader Concepts, Up: Reader Concepts + +23.1.1 Dynamic Control of the Lisp Reader +----------------------------------------- + +Various aspects of the Lisp reader can be controlled dynamically. See +*note Readtables:: and *note Variables that affect the Lisp Reader::. + + +File: gcl.info, Node: Effect of Readtable Case on the Lisp Reader, Next: Argument Conventions of Some Reader Functions, Prev: Dynamic Control of the Lisp Reader, Up: Reader Concepts + +23.1.2 Effect of Readtable Case on the Lisp Reader +-------------------------------------------------- + +The readtable case of the current readtable affects the Lisp reader in +the following ways: + +:upcase + When the readtable case is :upcase, unescaped constituent + characters are converted to uppercase, as specified in *note Reader + Algorithm::. + +:downcase + When the readtable case is :downcase, unescaped constituent + characters are converted to lowercase. + +:preserve + When the readtable case is :preserve, the case of all characters + remains unchanged. + +:invert + When the readtable case is :invert, then if all of the unescaped + letters in the extended token are of the same case, those + (unescaped) letters are converted to the opposite case. + +* Menu: + +* Examples of Effect of Readtable Case on the Lisp Reader:: + + +File: gcl.info, Node: Examples of Effect of Readtable Case on the Lisp Reader, Prev: Effect of Readtable Case on the Lisp Reader, Up: Effect of Readtable Case on the Lisp Reader + +23.1.2.1 Examples of Effect of Readtable Case on the Lisp Reader +................................................................ + + (defun test-readtable-case-reading () + (let ((*readtable* (copy-readtable nil))) + (format t "READTABLE-CASE Input Symbol-name~ + ~ + ~ + (dolist (readtable-case '(:upcase :downcase :preserve :invert)) + (setf (readtable-case *readtable*) readtable-case) + (dolist (input '("ZEBRA" "Zebra" "zebra")) + (format t "~&:~A~16T~A~24T~A" + (string-upcase readtable-case) + input + (symbol-name (read-from-string input))))))) + + The output from (test-readtable-case-reading) should be as follows: + + READTABLE-CASE Input Symbol-name + ------------------------------------- + :UPCASE ZEBRA ZEBRA + :UPCASE Zebra ZEBRA + :UPCASE zebra ZEBRA + :DOWNCASE ZEBRA zebra + :DOWNCASE Zebra zebra + :DOWNCASE zebra zebra + :PRESERVE ZEBRA ZEBRA + :PRESERVE Zebra Zebra + :PRESERVE zebra zebra + :INVERT ZEBRA zebra + :INVERT Zebra Zebra + :INVERT zebra ZEBRA + + +File: gcl.info, Node: Argument Conventions of Some Reader Functions, Prev: Effect of Readtable Case on the Lisp Reader, Up: Reader Concepts + +23.1.3 Argument Conventions of Some Reader Functions +---------------------------------------------------- + +* Menu: + +* The EOF-ERROR-P argument:: +* The RECURSIVE-P argument:: + + +File: gcl.info, Node: The EOF-ERROR-P argument, Next: The RECURSIVE-P argument, Prev: Argument Conventions of Some Reader Functions, Up: Argument Conventions of Some Reader Functions + +23.1.3.1 The EOF-ERROR-P argument +................................. + +Eof-error-p in input function calls controls what happens if input is +from a file (or any other input source that has a definite end) and the +end of the file is reached. If eof-error-p is true (the default), an +error of type end-of-file is signaled at end of file. If it is false, +then no error is signaled, and instead the function returns eof-value. + + Functions such as read that read the representation of an object +rather than a single character always signals an error, regardless of +eof-error-p, if the file ends in the middle of an object representation. +For example, if a file does not contain enough right parentheses to +balance the left parentheses in it, read signals an error. If a file +ends in a symbol or a number immediately followed by end-of-file, read +reads the symbol or number successfully and when called again will act +according to eof-error-p. Similarly, the function read-line +successfully reads the last line of a file even if that line is +terminated by end-of-file rather than the newline character. Ignorable +text, such as lines containing only whitespace_2 or comments, are not +considered to begin an object; if read begins to read an expression but +sees only such ignorable text, it does not consider the file to end in +the middle of an object. Thus an eof-error-p argument controls what +happens when the file ends between objects. + + +File: gcl.info, Node: The RECURSIVE-P argument, Prev: The EOF-ERROR-P argument, Up: Argument Conventions of Some Reader Functions + +23.1.3.2 The RECURSIVE-P argument +................................. + +If recursive-p is supplied and not nil, it specifies that this function +call is not an outermost call to read but an embedded call, typically +from a reader macro function. It is important to distinguish such +recursive calls for three reasons. + +1. + An outermost call establishes the context within which the #n= and + #n# syntax is scoped. Consider, for example, the expression + + (cons '#3=(p q r) '(x y . #3#)) + + If the single-quote reader macro were defined in this way: + + (set-macro-character #\' ;incorrect + #'(lambda (stream char) + (declare (ignore char)) + (list 'quote (read stream)))) + + then each call to the single-quote reader macro function would + establish independent contexts for the scope of read information, + including the scope of identifications between markers like "#3=" + and "#3#". However, for this expression, the scope was clearly + intended to be determined by the outer set of parentheses, so such + a definition would be incorrect. The correct way to define the + single-quote reader macro uses recursive-p: + + (set-macro-character #\' ;correct + #'(lambda (stream char) + (declare (ignore char)) + (list 'quote (read stream t nil t)))) + +2. + A recursive call does not alter whether the reading process is to + preserve whitespace_2 or not (as determined by whether the + outermost call was to read or read-preserving-whitespace). Suppose + again that single-quote were to be defined as shown above in the + incorrect definition. Then a call to read-preserving-whitespace + that read the expression 'foo would fail to preserve the + space character following the symbol foo because the single-quote + reader macro function calls read, not read-preserving-whitespace, + to read the following expression (in this case foo). The correct + definition, which passes the value true for recursive-p to read, + allows the outermost call to determine whether whitespace_2 is + preserved. + +3. + When end-of-file is encountered and the eof-error-p argument is not + nil, the kind of error that is signaled may depend on the value of + recursive-p. If recursive-p is true, then the end-of-file is + deemed to have occurred within the middle of a printed + representation; if recursive-p is false, then the end-of-file may + be deemed to have occurred between objects rather than within the + middle of one. + + +File: gcl.info, Node: Reader Dictionary, Prev: Reader Concepts, Up: Reader + +23.2 Reader Dictionary +====================== + +* Menu: + +* readtable:: +* copy-readtable:: +* make-dispatch-macro-character:: +* read:: +* read-delimited-list:: +* read-from-string:: +* readtable-case:: +* readtablep:: +* set-dispatch-macro-character:: +* set-macro-character:: +* set-syntax-from-char:: +* with-standard-io-syntax:: +* *read-base*:: +* *read-default-float-format*:: +* *read-eval*:: +* *read-suppress*:: +* *readtable*:: +* reader-error:: + + +File: gcl.info, Node: readtable, Next: copy-readtable, Prev: Reader Dictionary, Up: Reader Dictionary + +23.2.1 readtable [System Class] +------------------------------- + +Class Precedence List:: +....................... + +readtable, t + +Description:: +............. + +A readtable maps characters into syntax types for the Lisp reader; see +*note Syntax::. A readtable also contains associations between macro +characters and their reader macro functions, and records information +about the case conversion rules to be used by the Lisp reader when +parsing symbols. + + Each simple character must be representable in the readtable. It is +implementation-defined whether non-simple characters can have syntax +descriptions in the readtable. + +See Also:: +.......... + +*note Readtables::, *note Printing Other Objects:: + + +File: gcl.info, Node: copy-readtable, Next: make-dispatch-macro-character, Prev: readtable, Up: Reader Dictionary + +23.2.2 copy-readtable [Function] +-------------------------------- + +'copy-readtable' &optional from-readtable to-readtable => readtable + +Arguments and Values:: +...................... + +from-readtable--a readtable designator. The default is the current +readtable. + + to-readtable--a readtable or nil. The default is nil. + + readtable--the to-readtable if it is non-nil, or else a fresh +readtable. + +Description:: +............. + +copy-readtable copies from-readtable. + + If to-readtable is nil, a new readtable is created and returned. +Otherwise the readtable specified by to-readtable is modified and +returned. + + copy-readtable copies the setting of readtable-case. + +Examples:: +.......... + + (setq zvar 123) => 123 + (set-syntax-from-char #\z #\' (setq table2 (copy-readtable))) => T + zvar => 123 + (copy-readtable table2 *readtable*) => # + zvar => VAR + (setq *readtable* (copy-readtable)) => # + zvar => VAR + (setq *readtable* (copy-readtable nil)) => # + zvar => 123 + +See Also:: +.......... + +readtable, *note readtable:: + +Notes:: +....... + + (setq *readtable* (copy-readtable nil)) + + restores the input syntax to standard Common Lisp syntax, even if the +initial readtable has been clobbered (assuming it is not so badly +clobbered that you cannot type in the above expression). + + On the other hand, + + (setq *readtable* (copy-readtable)) + + replaces the current readtable with a copy of itself. This is useful +if you want to save a copy of a readtable for later use, protected from +alteration in the meantime. It is also useful if you want to locally +bind the readtable to a copy of itself, as in: + + (let ((*readtable* (copy-readtable))) ...) + + +File: gcl.info, Node: make-dispatch-macro-character, Next: read, Prev: copy-readtable, Up: Reader Dictionary + +23.2.3 make-dispatch-macro-character [Function] +----------------------------------------------- + +'make-dispatch-macro-character' char &optional non-terminating-p +readtable => t + +Arguments and Values:: +...................... + +char--a character. + + non-terminating-p--a generalized boolean. The default is false. + + readtable--a readtable. The default is the current readtable. + +Description:: +............. + +make-dispatch-macro-character makes char be a dispatching macro +character in readtable. + + Initially, every character in the dispatch table associated with the +char has an associated function that signals an error of type +reader-error. + + If non-terminating-p is true, the dispatching macro character is made +a non-terminating macro character; if non-terminating-p is false, the +dispatching macro character is made a terminating macro character. + +Examples:: +.......... + + (get-macro-character #\{) => NIL, false + (make-dispatch-macro-character #\{) => T + (not (get-macro-character #\{)) => false + + The readtable is altered. + +See Also:: +.......... + +*note readtable:: , *note set-dispatch-macro-character:: + + +File: gcl.info, Node: read, Next: read-delimited-list, Prev: make-dispatch-macro-character, Up: Reader Dictionary + +23.2.4 read, read-preserving-whitespace [Function] +-------------------------------------------------- + +'read' &optional input-stream eof-error-p eof-value recursive-p => +object + + 'read-preserving-whitespace' &optional input-stream eof-error-p +eof-value recursive-p +=> object + +Arguments and Values:: +...................... + +input-stream--an input stream designator. + + eof-error-p--a generalized boolean. The default is true. + + eof-value--an object. + + The default is nil. + + recursive-p--a generalized boolean. The default is false. + + object--an object (parsed by the Lisp reader) or the eof-value. + +Description:: +............. + +read parses the printed representation of an object from input-stream +and builds such an object. + + read-preserving-whitespace is like read but preserves any +whitespace_2 character that delimits the printed representation of the +object. read-preserving-whitespace is exactly like read when the +recursive-p argument to read-preserving-whitespace is true. + + When *read-suppress* is false, read throws away the delimiting +character required by certain printed representations if it is a +whitespace_2 character; but read preserves the character (using +unread-char) if it is syntactically meaningful, because it could be the +start of the next expression. + + If a file ends in a symbol or a number immediately followed by an end +of file_1, read reads the symbol or number successfully; when called +again, it sees the end of file_1 and only then acts according to +eof-error-p. If a file contains ignorable text at the end, such as +blank lines and comments, read does not consider it to end in the middle +of an object. + + If recursive-p is true, the call to read is expected to be made from +within some function that itself has been called from read or from a +similar input function, rather than from the top level. + + Both functions return the object read from input-stream. Eof-value +is returned if eof-error-p is false and end of file is reached before +the beginning of an object. + +Examples:: +.......... + + (read) + |> |>>'a<<| + => (QUOTE A) + (with-input-from-string (is " ") (read is nil 'the-end)) => THE-END + (defun skip-then-read-char (s c n) + (if (char= c #\{) (read s t nil t) (read-preserving-whitespace s)) + (read-char-no-hang s)) => SKIP-THEN-READ-CHAR + (let ((*readtable* (copy-readtable nil))) + (set-dispatch-macro-character #\# #\{ #'skip-then-read-char) + (set-dispatch-macro-character #\# #\} #'skip-then-read-char) + (with-input-from-string (is "#{123 x #}123 y") + (format t "~S ~S" (read is) (read is)))) => #\x, #\Space, NIL + + As an example, consider this reader macro definition: + + (defun slash-reader (stream char) + (declare (ignore char)) + `(path . ,(loop for dir = (read-preserving-whitespace stream t nil t) + then (progn (read-char stream t nil t) + (read-preserving-whitespace stream t nil t)) + collect dir + while (eql (peek-char nil stream nil nil t) #\/)))) + (set-macro-character #\/ #'slash-reader) + + Consider now calling read on this expression: + + (zyedh /usr/games/zork /usr/games/boggle) + + The / macro reads objects separated by more / characters; thus +/usr/games/zork is intended to read as (path usr games zork). The +entire example expression should therefore be read as + + (zyedh (path usr games zork) (path usr games boggle)) + + However, if read had been used instead of read-preserving-whitespace, +then after the reading of the symbol zork, the following space would be +discarded; the next call to peek-char would see the following /, and the +loop would continue, producing this interpretation: + + (zyedh (path usr games zork usr games boggle)) + + There are times when whitespace_2 should be discarded. If a command +interpreter takes single-character commands, but occasionally reads an +object then if the whitespace_2 after a symbol is not discarded it might +be interpreted as a command some time later after the symbol had been +read. + +Affected By:: +............. + +*standard-input*, *terminal-io*, *readtable*, +*read-default-float-format*, *read-base*, *read-suppress*, *package*, +*read-eval*. + +Exceptional Situations:: +........................ + +read signals an error of type end-of-file, regardless of eof-error-p, if +the file ends in the middle of an object representation. For example, +if a file does not contain enough right parentheses to balance the left +parentheses in it, read signals an error. This is detected when read or +read-preserving-whitespace is called with recursive-p and eof-error-p +non-nil, and end-of-file is reached before the beginning of an object. + + If eof-error-p is true, an error of type end-of-file is signaled at +the end of file. + +See Also:: +.......... + +*note peek-char:: , *note read-char:: , *note unread-char:: , *note +read-from-string:: , *note read-delimited-list:: , *note parse-integer:: +, *note Syntax::, *note Reader Concepts:: + + +File: gcl.info, Node: read-delimited-list, Next: read-from-string, Prev: read, Up: Reader Dictionary + +23.2.5 read-delimited-list [Function] +------------------------------------- + +'read-delimited-list' char &optional input-stream recursive-p => list + +Arguments and Values:: +...................... + +char--a character. + + input-stream--an input stream designator. The default is standard +input. + + recursive-p--a generalized boolean. The default is false. + + list--a list of the objects read. + +Description:: +............. + +read-delimited-list reads objects from input-stream until the next +character after an object's representation (ignoring whitespace_2 +characters and comments) is char. + + read-delimited-list looks ahead at each step for the next +non-whitespace_2 character and peeks at it as if with peek-char. If it +is char, then the character is consumed and the list of objects is +returned. If it is a constituent or escape character, then read is used +to read an object, which is added to the end of the list. If it is a +macro character, its reader macro function is called; if the function +returns a value, that value is added to the list. The peek-ahead +process is then repeated. + + If recursive-p is true, this call is expected to be embedded in a +higher-level call to read or a similar function. + + It is an error to reach end-of-file during the operation of +read-delimited-list. + + The consequences are undefined if char has a syntax type of +whitespace_2 in the current readtable. + +Examples:: +.......... + + (read-delimited-list #\]) 1 2 3 4 5 6 ] + => (1 2 3 4 5 6) + + Suppose you wanted #{a b c ... z} to read as a list of all pairs of +the elements a, b, c, ..., z, for example. + + #{p q z a} reads as ((p q) (p z) (p a) (q z) (q a) (z a)) + + This can be done by specifying a macro-character definition for #{ +that does two things: reads in all the items up to the }, and constructs +the pairs. read-delimited-list performs the first task. + + (defun |#{-reader| (stream char arg) + (declare (ignore char arg)) + (mapcon #'(lambda (x) + (mapcar #'(lambda (y) (list (car x) y)) (cdr x))) + (read-delimited-list #\} stream t))) => |#{-reader| + + (set-dispatch-macro-character #\# #\{ #'|#{-reader|) => T + (set-macro-character #\} (get-macro-character #\) nil)) + + Note that true is supplied for the recursive-p argument. + + It is necessary here to give a definition to the character } as well +to prevent it from being a constituent. If the line + + (set-macro-character #\} (get-macro-character #\) nil)) + + shown above were not included, then the } in + + #{ p q z a} + + would be considered a constituent character, part of the symbol named +a}. This could be corrected by putting a space before the }, but it is +better to call set-macro-character. + + Giving } the same definition as the standard definition of the +character ) has the twin benefit of making it terminate tokens for use +with read-delimited-list and also making it invalid for use in any other +context. Attempting to read a stray } will signal an error. + +Affected By:: +............. + +*standard-input*, *readtable*, *terminal-io*. + +See Also:: +.......... + +*note read:: , *note peek-char:: , *note read-char:: , *note +unread-char:: . + +Notes:: +....... + +read-delimited-list is intended for use in implementing reader macros. +Usually it is desirable for char to be a terminating macro character so +that it can be used to delimit tokens; however, read-delimited-list +makes no attempt to alter the syntax specified for char by the current +readtable. The caller must make any necessary changes to the readtable +syntax explicitly. + + +File: gcl.info, Node: read-from-string, Next: readtable-case, Prev: read-delimited-list, Up: Reader Dictionary + +23.2.6 read-from-string [Function] +---------------------------------- + +'read-from-string' string &optional eof-error-p eof-value &key start end +preserve-whitespace +=> object, position + +Arguments and Values:: +...................... + +string--a string. + + eof-error-p--a generalized boolean. The default is true. + + eof-value--an object. + + The default is nil. + + start, end--bounding index designators of string. The defaults for +start and end are 0 and nil, respectively. + + preserve-whitespace--a generalized boolean. The default is false. + + object--an object (parsed by the Lisp reader) or the eof-value. + + position--an integer greater than or equal to zero, and less than or +equal to one more than the length of the string. + +Description:: +............. + +Parses the printed representation of an object from the subsequence of +string bounded by start and end, as if read had been called on an input +stream containing those same characters. + + If preserve-whitespace is true, the operation will preserve +whitespace_2 as read-preserving-whitespace would do. + + If an object is successfully parsed, the primary value, object, is +the object that was parsed. If eof-error-p is false and if the end of +the substring is reached, eof-value is returned. + + The secondary value, position, is the index of the first character in +the bounded string that was not read. The position may depend upon the +value of preserve-whitespace. If the entire string was read, the +position returned is either the length of the string or one greater than +the length of the string. + +Examples:: +.......... + + (read-from-string " 1 3 5" t nil :start 2) => 3, 5 + (read-from-string "(a b c)") => (A B C), 7 + +Exceptional Situations:: +........................ + +If the end of the supplied substring occurs before an object can be +read, an error is signaled if eof-error-p is true. An error is signaled +if the end of the substring occurs in the middle of an incomplete +object. + +See Also:: +.......... + +*note read:: , read-preserving-whitespace + +Notes:: +....... + +The reason that position is allowed to be beyond the length of the +string is to permit (but not require) the implementation to work by +simulating the effect of a trailing delimiter at the end of the bounded +string. When preserve-whitespace is true, the position might count the +simulated delimiter. + + +File: gcl.info, Node: readtable-case, Next: readtablep, Prev: read-from-string, Up: Reader Dictionary + +23.2.7 readtable-case [Accessor] +-------------------------------- + +'readtable-case' readtable => mode + + (setf (' readtable-case' readtable) mode) + +Arguments and Values:: +...................... + +readtable--a readtable. + + mode--a case sensitivity mode. + +Description:: +............. + +Accesses the readtable case of readtable, which affects the way in which +the Lisp Reader reads symbols and the way in which the Lisp Printer +writes symbols. + +Examples:: +.......... + +See *note Examples of Effect of Readtable Case on the Lisp Reader:: and +*note Examples of Effect of Readtable Case on the Lisp Printer::. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if readtable is not a +readtable. Should signal an error of type type-error if mode is not a +case sensitivity mode. + +See Also:: +.......... + +*note readtable:: , *print-escape*, *note Reader Algorithm::, *note +Effect of Readtable Case on the Lisp Reader::, *note Effect of Readtable +Case on the Lisp Printer:: + +Notes:: +....... + +copy-readtable copies the readtable case of the readtable. + + +File: gcl.info, Node: readtablep, Next: set-dispatch-macro-character, Prev: readtable-case, Up: Reader Dictionary + +23.2.8 readtablep [Function] +---------------------------- + +'readtablep' object => generalized-boolean + +Arguments and Values:: +...................... + +object--an object. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +Returns true if object is of type readtable; otherwise, returns false. + +Examples:: +.......... + + (readtablep *readtable*) => true + (readtablep (copy-readtable)) => true + (readtablep '*readtable*) => false + +Notes:: +....... + + (readtablep object) == (typep object 'readtable) + + +File: gcl.info, Node: set-dispatch-macro-character, Next: set-macro-character, Prev: readtablep, Up: Reader Dictionary + +23.2.9 set-dispatch-macro-character, get-dispatch-macro-character +----------------------------------------------------------------- + + [Function] + + 'get-dispatch-macro-character' disp-char sub-char &optional readtable +=> function + + 'set-dispatch-macro-character' disp-char sub-char new-function +&optional readtable => t + +Arguments and Values:: +...................... + +disp-char--a character. + + sub-char--a character. + + readtable--a readtable designator. + + The default is the current readtable. + + function--a function designator or nil. + + new-function--a function designator. + +Description:: +............. + +set-dispatch-macro-character causes new-function to be called when +disp-char followed by sub-char is read. If sub-char is a lowercase +letter, it is converted to its uppercase equivalent. It is an error if +sub-char is one of the ten decimal digits. + + set-dispatch-macro-character installs a new-function to be called +when a particular dispatching macro character pair is read. +New-function is installed as the dispatch function to be called when +readtable is in use and when disp-char is followed by sub-char. + + For more information about how the new-function is invoked, see *note +Macro Characters::. + + get-dispatch-macro-character retrieves the dispatch function +associated with disp-char and sub-char in readtable. + + get-dispatch-macro-character returns the macro-character function for +sub-char under disp-char, or nil if there is no function associated with +sub-char. If sub-char is a decimal digit, get-dispatch-macro-character +returns nil. + +Examples:: +.......... + + (get-dispatch-macro-character #\# #\{) => NIL + (set-dispatch-macro-character #\# #\{ ;dispatch on #{ + #'(lambda(s c n) + (let ((list (read s nil (values) t))) ;list is object after #n{ + (when (consp list) ;return nth element of list + (unless (and n (< 0 n (length list))) (setq n 0)) + (setq list (nth n list))) + list))) => T + #{(1 2 3 4) => 1 + #3{(0 1 2 3) => 3 + #{123 => 123 + + If it is desired that #$foo : as if it were (dollars foo). + + (defun |#$-reader| (stream subchar arg) + (declare (ignore subchar arg)) + (list 'dollars (read stream t nil t))) => |#$-reader| + (set-dispatch-macro-character #\# #\$ #'|#$-reader|) => T + +See Also:: +.......... + +*note Macro Characters:: + +Side Effects:: +.............. + +The readtable is modified. + +Affected By:: +............. + +*readtable*. + +Exceptional Situations:: +........................ + +For either function, an error is signaled if disp-char is not a +dispatching macro character in readtable. + +See Also:: +.......... + +*note readtable:: + +Notes:: +....... + +It is necessary to use make-dispatch-macro-character to set up the +dispatch character before specifying its sub-characters. + + +File: gcl.info, Node: set-macro-character, Next: set-syntax-from-char, Prev: set-dispatch-macro-character, Up: Reader Dictionary + +23.2.10 set-macro-character, get-macro-character [Function] +----------------------------------------------------------- + +'get-macro-character' char &optional readtable => function, +non-terminating-p + + 'set-macro-character' char new-function &optional non-terminating-p +readtable => t + +Arguments and Values:: +...................... + +char--a character. + + non-terminating-p--a generalized boolean. The default is false. + + readtable--a readtable designator. + + The default is the current readtable. + + function--nil, or a designator for a function of two arguments. + + new-function--a function designator. + +Description:: +............. + +get-macro-character returns as its primary value, function, the reader +macro function associated with char in readtable (if any), or else nil +if char is not a macro character in readtable. The secondary value, +non-terminating-p, is true if char is a non-terminating macro character; +otherwise, it is false. + + set-macro-character causes char to be a macro character associated +with the reader macro function new-function (or the designator for +new-function) in readtable. If non-terminating-p is true, char becomes +a non-terminating macro character; otherwise it becomes a terminating +macro character. + +Examples:: +.......... + + (get-macro-character #\{) => NIL, false + (not (get-macro-character #\;)) => false + + The following is a possible definition for the single-quote reader +macro in standard syntax: + + (defun single-quote-reader (stream char) + (declare (ignore char)) + (list 'quote (read stream t nil t))) => SINGLE-QUOTE-READER + (set-macro-character #\' #'single-quote-reader) => T + + Here single-quote-reader reads an object following the single-quote +and returns a list of quote and that object. The char argument is +ignored. + + The following is a possible definition for the semicolon reader macro +in standard syntax: + + (defun semicolon-reader (stream char) + (declare (ignore char)) + ;; First swallow the rest of the current input line. + ;; End-of-file is acceptable for terminating the comment. + (do () ((char= (read-char stream nil #\Newline t) #\Newline))) + ;; Return zero values. + (values)) => SEMICOLON-READER + (set-macro-character #\; #'semicolon-reader) => T + +Side Effects:: +.............. + +The readtable is modified. + +See Also:: +.......... + +*note readtable:: + + +File: gcl.info, Node: set-syntax-from-char, Next: with-standard-io-syntax, Prev: set-macro-character, Up: Reader Dictionary + +23.2.11 set-syntax-from-char [Function] +--------------------------------------- + +'set-syntax-from-char' to-char from-char &optional to-readtable +from-readtable => t + +Arguments and Values:: +...................... + +to-char--a character. + + from-char--a character. + + to-readtable--a readtable. The default is the current readtable. + + from-readtable--a readtable designator. The default is the standard +readtable. + +Description:: +............. + +set-syntax-from-char makes the syntax of to-char in to-readtable be the +same as the syntax of from-char in from-readtable. + + set-syntax-from-char copies the syntax types of from-char. If +from-char is a macro character, its reader macro function is copied +also. If the character is a dispatching macro character, its entire +dispatch table of reader macro functions is copied. The constituent +traits of from-char are not copied. + + A macro definition from a character such as " can be copied to +another character; the standard definition for " looks for another +character that is the same as the character that invoked it. The +definition of ( can not be meaningfully copied to {, on the other hand. +The result is that lists are of the form {a b c), not {a b c}, because +the definition always looks for a closing parenthesis, not a closing +brace. + +Examples:: +.......... + + (set-syntax-from-char #\7 #\;) => T + 123579 => 1235 + +Side Effects:: +.............. + +The to-readtable is modified. + +Affected By:: +............. + +The existing values in the from-readtable. + +See Also:: +.......... + +*note set-macro-character:: , *note make-dispatch-macro-character:: , +*note Character Syntax Types:: + +Notes:: +....... + +The constituent traits of a character are "hard wired" into the parser +for extended tokens. For example, if the definition of S is copied to +*, then * will become a constituent that is alphabetic_2 but that cannot +be used as a short float exponent marker. For further information, see +*note Constituent Traits::. + + +File: gcl.info, Node: with-standard-io-syntax, Next: *read-base*, Prev: set-syntax-from-char, Up: Reader Dictionary + +23.2.12 with-standard-io-syntax [Macro] +--------------------------------------- + +'with-standard-io-syntax' {form}* => {result}* + +Arguments and Values:: +...................... + +forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +Within the dynamic extent of the body of forms, all reader/printer +control variables, including any implementation-defined ones not +specified by this standard, are bound to values that produce standard +read/print behavior. The values for the variables specified by this +standard are listed in Figure 23-1. + + [Reviewer Note by Barrett: *print-pprint-dispatch* should probably be +mentioned here, too.] + + Variable Value + *package* The CL-USER package + *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* The standard pprint dispatch table + *print-pretty* nil + *print-radix* nil + *print-readably* t + *print-right-margin* nil + *read-base* 10 + *read-default-float-format* single-float + *read-eval* t + *read-suppress* nil + *readtable* The standard readtable + + Figure 23-1: Values of standard control variables + + +Examples:: +.......... + + (with-open-file (file pathname :direction :output) + (with-standard-io-syntax + (print data file))) + + ;;; ... Later, in another Lisp: + + (with-open-file (file pathname :direction :input) + (with-standard-io-syntax + (setq data (read file)))) + + +File: gcl.info, Node: *read-base*, Next: *read-default-float-format*, Prev: with-standard-io-syntax, Up: Reader Dictionary + +23.2.13 *read-base* [Variable] +------------------------------ + +Value Type:: +............ + +a radix. + +Initial Value:: +............... + +10. + +Description:: +............. + +Controls the interpretation of tokens by read as being integers or +ratios. + + The value of *read-base*, called the current input base , is the +radix in which integers and ratios are to be read by the Lisp reader. +The parsing of other numeric types (e.g., floats) is not affected by +this option. + + The effect of *read-base* on the reading of any particular rational +number can be locally overridden by explicit use of the #O, #X, #B, or +#nR syntax or by a trailing decimal point. + +Examples:: +.......... + + (dotimes (i 6) + (let ((*read-base* (+ 10. i))) + (let ((object (read-from-string "(\\DAD DAD |BEE| BEE 123. 123)"))) + (print (list *read-base* object))))) + |> (10 (DAD DAD BEE BEE 123 123)) + |> (11 (DAD DAD BEE BEE 123 146)) + |> (12 (DAD DAD BEE BEE 123 171)) + |> (13 (DAD DAD BEE BEE 123 198)) + |> (14 (DAD 2701 BEE BEE 123 227)) + |> (15 (DAD 3088 BEE 2699 123 258)) + => NIL + +Notes:: +....... + +Altering the input radix can be useful when reading data files in +special formats. + + +File: gcl.info, Node: *read-default-float-format*, Next: *read-eval*, Prev: *read-base*, Up: Reader Dictionary + +23.2.14 *read-default-float-format* [Variable] +---------------------------------------------- + +Value Type:: +............ + +one of the atomic type specifiers short-float, single-float, +double-float, or long-float, or else some other type specifier defined +by the implementation to be acceptable. + +Initial Value:: +............... + +The symbol single-float. + +Description:: +............. + +Controls the floating-point format that is to be used when reading a +floating-point number that has no exponent marker or that has e or E for +an exponent marker. Other exponent markers explicitly prescribe the +floating-point format to be used. + + The printer uses *read-default-float-format* to guide the choice of +exponent markers when printing floating-point numbers. + +Examples:: +.......... + + (let ((*read-default-float-format* 'double-float)) + (read-from-string "(1.0 1.0e0 1.0s0 1.0f0 1.0d0 1.0L0)")) + => (1.0 1.0 1.0 1.0 1.0 1.0) ;Implementation has float format F. + => (1.0 1.0 1.0s0 1.0 1.0 1.0) ;Implementation has float formats S and F. + => (1.0d0 1.0d0 1.0 1.0 1.0d0 1.0d0) ;Implementation has float formats F and D. + => (1.0d0 1.0d0 1.0s0 1.0 1.0d0 1.0d0) ;Implementation has float formats S, F, D. + => (1.0d0 1.0d0 1.0 1.0 1.0d0 1.0L0) ;Implementation has float formats F, D, L. + => (1.0d0 1.0d0 1.0s0 1.0 1.0d0 1.0L0) ;Implementation has formats S, F, D, L. + + +File: gcl.info, Node: *read-eval*, Next: *read-suppress*, Prev: *read-default-float-format*, Up: Reader Dictionary + +23.2.15 *read-eval* [Variable] +------------------------------ + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +true. + +Description:: +............. + +If it is true, the #. reader macro has its normal effect. Otherwise, +that reader macro signals an error of type reader-error. + +See Also:: +.......... + +*print-readably* + +Notes:: +....... + +If *read-eval* is false and *print-readably* is true, any method for +print-object that would output a reference to the #. reader macro either +outputs something different or signals an error of type +print-not-readable. + + +File: gcl.info, Node: *read-suppress*, Next: *readtable*, Prev: *read-eval*, Up: Reader Dictionary + +23.2.16 *read-suppress* [Variable] +---------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +false. + +Description:: +............. + +This variable is intended primarily to support the operation of the +read-time conditional notations #+ and #-. It is important for the +reader macros which implement these notations to be able to skip over +the printed representation of an expression despite the possibility that +the syntax of the skipped expression may not be entirely valid for the +current implementation, since #+ and #- exist in order to allow the same +program to be shared among several Lisp implementations (including +dialects other than Common Lisp) despite small incompatibilities of +syntax. + + If it is false, the Lisp reader operates normally. + + If the value of *read-suppress* is true, read, +read-preserving-whitespace, read-delimited-list, and read-from-string +all return a primary value of nil when they complete successfully; +however, they continue to parse the representation of an object in the +normal way, in order to skip over the object, and continue to indicate +end of file in the normal way. Except as noted below, any standardized +reader macro_2 that is defined to read_2 a following object or token +will do so, but not signal an error if the object read is not of an +appropriate type or syntax. The standard syntax and its associated +reader macros will not construct any new objects (e.g., when reading the +representation of a symbol, no symbol will be constructed or interned). + +Extended tokens + All extended tokens are completely uninterpreted. Errors such as + those that might otherwise be signaled due to detection of invalid + potential numbers, invalid patterns of package markers, and invalid + uses of the dot character are suppressed. + +Dispatching macro characters (including sharpsign) + Dispatching macro characters continue to parse an infix numerical + argument, and invoke the dispatch function. The standardized + sharpsign reader macros do not enforce any constraints on either + the presence of or the value of the numerical argument. + +#= + The #= notation is totally ignored. It does not read a following + object. It produces no object, but is treated as whitespace_2. + +## + The ## notation always produces nil. + + No matter what the value of *read-suppress*, parentheses still +continue to delimit and construct lists; the #( notation continues to +delimit vectors; and comments, strings, and the single-quote and +backquote notations continue to be interpreted properly. Such +situations as '), #<, #), and # continue to signal errors. + +Examples:: +.......... + + (let ((*read-suppress* t)) + (mapcar #'read-from-string + '("#(foo bar baz)" "#P(:type :lisp)" "#c1.2" + "#.(PRINT 'FOO)" "#3AHELLO" "#S(INTEGER)" + "#*ABC" "#\GARBAGE" "#RALPHA" "#3R444"))) + => (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL) + +See Also:: +.......... + +*note read:: , *note Syntax:: + +Notes:: +....... + +Programmers and implementations that define additional macro characters +are strongly encouraged to make them respect *read-suppress* just as +standardized macro characters do. That is, when the value of +*read-suppress* is true, they should ignore type errors when reading a +following object and the functions that implement dispatching macro +characters should tolerate nil as their infix parameter value even if a +numeric value would ordinarily be required. + + +File: gcl.info, Node: *readtable*, Next: reader-error, Prev: *read-suppress*, Up: Reader Dictionary + +23.2.17 *readtable* [Variable] +------------------------------ + +Value Type:: +............ + +a readtable. + +Initial Value:: +............... + +A readtable that conforms to the description of Common Lisp syntax in +*note Syntax::. + +Description:: +............. + +The value of *readtable* is called the current readtable. It controls +the parsing behavior of the Lisp reader, and can also influence the Lisp +printer (e.g., see the function readtable-case). + +Examples:: +.......... + + (readtablep *readtable*) => true + (setq zvar 123) => 123 + (set-syntax-from-char #\z #\' (setq table2 (copy-readtable))) => T + zvar => 123 + (setq *readtable* table2) => # + zvar => VAR + (setq *readtable* (copy-readtable nil)) => # + zvar => 123 + +Affected By:: +............. + +compile-file, load + +See Also:: +.......... + +*note compile-file:: , *note load:: , *note readtable:: , *note The +Current Readtable:: + + +File: gcl.info, Node: reader-error, Prev: *readtable*, Up: Reader Dictionary + +23.2.18 reader-error [Condition Type] +------------------------------------- + +Class Precedence List:: +....................... + +reader-error, parse-error, stream-error, error, serious-condition, +condition, t + +Description:: +............. + +The type reader-error consists of error conditions that are related to +tokenization and parsing done by the Lisp reader. + +See Also:: +.......... + +*note read:: , *note stream-error-stream:: , *note Reader Concepts:: + + +File: gcl.info, Node: System Construction, Next: Environment, Prev: Reader, Up: Top + +24 System Construction +********************** + +* Menu: + +* System Construction Concepts:: +* System Construction Dictionary:: + + +File: gcl.info, Node: System Construction Concepts, Next: System Construction Dictionary, Prev: System Construction, Up: System Construction + +24.1 System Construction Concepts +================================= + +* Menu: + +* Loading:: +* Features:: + + +File: gcl.info, Node: Loading, Next: Features, Prev: System Construction Concepts, Up: System Construction Concepts + +24.1.1 Loading +-------------- + +To load a file is to treat its contents as code and execute that code. +The file may contain source code or compiled code . + + A file containing source code is called a source file . Loading a +source file is accomplished essentially by sequentially reading_2 the +forms in the file, evaluating each immediately after it is read. + + A file containing compiled code is called a compiled file . Loading +a compiled file is similar to loading a source file, except that the +file does not contain text but rather an implementation-dependent +representation of pre-digested expressions created by the compiler. +Often, a compiled file can be loaded more quickly than a source file. +See *note Compilation::. + + The way in which a source file is distinguished from a compiled file +is implementation-dependent. + + +File: gcl.info, Node: Features, Prev: Loading, Up: System Construction Concepts + +24.1.2 Features +--------------- + +A feature is an aspect or attribute of Common Lisp, of the +implementation, or of the environment. A feature is identified by a +symbol. + + A feature is said to be present in a Lisp image if and only if the +symbol naming it is an element of the list held by the variable +*features*, which is called the features list . + +* Menu: + +* Feature Expressions:: +* Examples of Feature Expressions:: + + +File: gcl.info, Node: Feature Expressions, Next: Examples of Feature Expressions, Prev: Features, Up: Features + +24.1.2.1 Feature Expressions +............................ + +Boolean combinations of features, called feature expressions , are used +by the #+ and #- reader macros in order to direct conditional reading of +expressions by the Lisp reader. + + The rules for interpreting a feature expression are as follows: + +feature + If a symbol naming a feature is used as a feature expression, the + feature expression succeeds if that feature is present; otherwise + it fails. + +(not feature-conditional) + A not feature expression succeeds if its argument + feature-conditional fails; otherwise, it succeeds. + +(and {feature-conditional}*) + An and feature expression succeeds if all of its argument + feature-conditionals succeed; otherwise, it fails. + +(or {feature-conditional}*) + An or feature expression succeeds if any of its argument + feature-conditionals succeed; otherwise, it fails. + + +File: gcl.info, Node: Examples of Feature Expressions, Prev: Feature Expressions, Up: Features + +24.1.2.2 Examples of Feature Expressions +........................................ + +For example, suppose that in implementation A, the features spice and +perq are present, but the feature lispm is not present; in +implementation B, the feature lispm is present, but the features spice +and perq are not present; and in implementation C, none of the features +spice, lispm, or perq are present. Figure 24-1 shows some sample +expressions, and how they would be read_2 in these implementations. + + (cons #+spice "Spice" #-spice "Lispm" x) + in implementation A ... (CONS "Spice" X) + in implementation B ... (CONS "Lispm" X) + in implementation C ... (CONS "Lispm" X) + (cons #+spice "Spice" #+LispM "Lispm" x) + in implementation A ... (CONS "Spice" X) + in implementation B ... (CONS "Lispm" X) + in implementation C ... (CONS X) + (setq a '(1 2 #+perq 43 #+(not perq) 27)) + in implementation A ... (SETQ A '(1 2 43)) + in implementation B ... (SETQ A '(1 2 27)) + in implementation C ... (SETQ A '(1 2 27)) + (let ((a 3) #+(or spice lispm) (b 3)) (foo a)) + in implementation A ... (LET ((A 3) (B 3)) (FOO A)) + in implementation B ... (LET ((A 3) (B 3)) (FOO A)) + in implementation C ... (LET ((A 3)) (FOO A)) + (cons #+Lispm "#+Spice" #+Spice "foo" #-(or Lispm Spice) 7 x) + in implementation A ... (CONS "foo" X) + in implementation B ... (CONS "#+Spice" X) + in implementation C ... (CONS 7 X) + + Figure 24-1: Features examples + + + +File: gcl.info, Node: System Construction Dictionary, Prev: System Construction Concepts, Up: System Construction + +24.2 System Construction Dictionary +=================================== + +* Menu: + +* compile-file:: +* compile-file-pathname:: +* load:: +* with-compilation-unit:: +* *features*:: +* *compile-file-pathname*:: +* *load-pathname*:: +* *compile-print*:: +* *load-print*:: +* *modules*:: +* provide:: + + +File: gcl.info, Node: compile-file, Next: compile-file-pathname, Prev: System Construction Dictionary, Up: System Construction Dictionary + +24.2.1 compile-file [Function] +------------------------------ + +'compile-file' input-file &key output-file verbose print external-format +=> output-truename, warnings-p, failure-p + +Arguments and Values:: +...................... + +input-file--a pathname designator. (Default fillers for unspecified +components are taken from *default-pathname-defaults*.) + + output-file--a pathname designator. The default is +implementation-defined. + + verbose--a generalized boolean. The default is the value of +*compile-verbose*. + + print--a generalized boolean. The default is the value of +*compile-print*. + + external-format--an external file format designator. The default is +:default. + + output-truename--a pathname (the truename of the output file), or +nil. + + warnings-p--a generalized boolean. + + failure-p--a generalized boolean. + +Description:: +............. + +compile-file transforms the contents of the file specified by input-file +into implementation-dependent binary data which are placed in the file +specified by output-file. + + The file to which input-file refers should be a source file. +output-file can be used to specify an output pathname; + + the actual pathname of the compiled file to which compiled code will +be output is computed as if by calling compile-file-pathname. + + If input-file or output-file is a logical pathname, it is translated +into a physical pathname as if by calling translate-logical-pathname. + + If verbose is true, compile-file prints a message in the form of a +comment (i.e., with a leading semicolon) to standard output indicating +what file is being compiled and other useful information. If verbose is +false, compile-file does not print this information. + + If print is true, information about top level forms in the file being +compiled is printed to standard output. Exactly what is printed is +implementation-dependent, but nevertheless some information is printed. +If print is nil, no information is printed. + + The external-format specifies the external file format to be used +when opening the file; see the function open. compile-file and load +must cooperate in such a way that the resulting compiled file can be +loaded without specifying an external file format anew; see the function +load. + + compile-file binds *readtable* and *package* to the values they held +before processing the file. + + *compile-file-truename* is bound by compile-file to hold the truename +of the pathname of the file being compiled. + + *compile-file-pathname* is bound by compile-file to hold a pathname +denoted by the first argument to compile-file, merged against the +defaults; that is, (pathname (merge-pathnames input-file)). + + The compiled functions contained in the compiled file become +available for use when the compiled file is loaded into Lisp. + + Any function definition that is processed by the compiler, including +#'(lambda ...) forms and local function definitions made by flet, labels +and defun forms, result in an object of type compiled-function. + + The primary value returned by compile-file, output-truename, is the +truename of the output file, or nil if the file could not be created. + + The secondary value, warnings-p, is false if no conditions of type +error or warning were detected by the compiler, and true otherwise. + + The tertiary value, failure-p, is false if no conditions of type +error or warning (other than style-warning) were detected by the +compiler, and true otherwise. + + For general information about how files are processed by the file +compiler, see *note File Compilation::. + + Programs to be compiled by the file compiler must only contain +externalizable objects; for details on such objects, see *note Literal +Objects in Compiled Files::. For information on how to extend the set +of externalizable objects, see the function make-load-form and *note +Additional Constraints on Externalizable Objects::. + +Affected By:: +............. + +*error-output*, + + *standard-output*, *compile-verbose*, *compile-print* + + The computer's file system. + +Exceptional Situations:: +........................ + +For information about errors detected during the compilation process, +see *note Exceptional Situations in the Compiler::. + + An error of type file-error might be signaled if (wild-pathname-p +input-file)\/ returns true. + + If either the attempt to open the source file for input or the +attempt to open the compiled file for output fails, an error of type +file-error is signaled. + +See Also:: +.......... + +*note compile:: , declare, *note eval-when:: , pathname, +logical-pathname, *note File System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: compile-file-pathname, Next: load, Prev: compile-file, Up: System Construction Dictionary + +24.2.2 compile-file-pathname [Function] +--------------------------------------- + +'compile-file-pathname' input-file &key output-file &allow-other-keys => +pathname + +Arguments and Values:: +...................... + +input-file--a pathname designator. (Default fillers for unspecified +components are taken from *default-pathname-defaults*.) + + output-file--a pathname designator. The default is +implementation-defined. + + pathname--a pathname. + +Description:: +............. + +Returns the pathname that compile-file would write into, if given the +same arguments. + + The defaults for the output-file are taken from the pathname that +results from merging the input-file with the value of +*default-pathname-defaults*, except that the type component should +default to the appropriate implementation-defined default type for +compiled files. + + If input-file is a logical pathname and output-file is unsupplied, +the result is a logical pathname. + + If input-file is a logical pathname, it is translated into a physical +pathname as if by calling translate-logical-pathname. + + If input-file is a stream, the stream can be either open or closed. +compile-file-pathname returns the same pathname after a file is closed +as it did when the file was open. + + It is an error if input-file is a stream that is created with +make-two-way-stream, make-echo-stream, make-broadcast-stream, +make-concatenated-stream, make-string-input-stream, +make-string-output-stream. + + If an implementation supports additional keyword arguments to +compile-file, compile-file-pathname must accept the same arguments. + +Examples:: +.......... + +See logical-pathname-translations. + +Exceptional Situations:: +........................ + +An error of type file-error might be signaled if either input-file or +output-file is wild. + +See Also:: +.......... + +*note compile-file:: , pathname, logical-pathname, *note File System +Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: load, Next: with-compilation-unit, Prev: compile-file-pathname, Up: System Construction Dictionary + +24.2.3 load [Function] +---------------------- + +'load' filespec &key verbose print if-does-not-exist external-format +=> generalized-boolean + +Arguments and Values:: +...................... + +filespec--a stream, or a pathname designator. The default is taken from +*default-pathname-defaults*. + + verbose--a generalized boolean. The default is the value of +*load-verbose*. + + print--a generalized boolean. The default is the value of +*load-print*. + + if-does-not-exist--a generalized boolean. The default is true. + + external-format--an external file format designator. The default is +:default. + + generalized-boolean--a generalized boolean. + +Description:: +............. + +load loads the file named by filespec into the Lisp environment. + + The manner in which a source file is distinguished from a compiled +file is implementation-dependent. If the file specification is not +complete and both a source file and a compiled file exist which might +match, then which of those files load selects is +implementation-dependent. + + If filespec is a stream, load determines what kind of stream it is +and loads directly from the stream. + + If filespec is a logical pathname, it is translated into a physical +pathname as if by calling translate-logical-pathname. + + load sequentially executes each form it encounters in the file named +by filespec. If the file is a source file and the implementation +chooses to perform implicit compilation, load must recognize top level +forms as described in *note Processing of Top Level Forms:: and arrange +for each top level form to be executed before beginning implicit +compilation of the next. (Note, however, that processing of eval-when +forms by load is controlled by the :execute situation.) + + If verbose is true, load prints a message in the form of a comment +(i.e., with a leading semicolon) to standard output indicating what file +is being loaded and other useful information. + + If verbose is false, load does not print this information. + + If print is true, load incrementally prints information to standard +output showing the progress of the loading process. For a source file, +this information might mean printing the values yielded by each form in +the file as soon as those values are returned. For a compiled file, +what is printed might not reflect precisely the contents of the source +file, but some information is generally printed. If print is false, +load does not print this information. + + If the file named by filespec is successfully loaded, load returns +true. + + [Reviewer Note by Loosemore: What happens if the file cannot be +loaded for some reason other than that it doesn't exist?] [Editorial +Note by KMP: i.e., can it return NIL? must it?] + + If the file does not exist, the specific action taken depends on +if-does-not-exist: if it is nil, load returns nil; otherwise, load +signals an error. + + The external-format specifies the external file format to be used +when opening the file (see the function open), except that when the file +named by filespec is a compiled file, the external-format is ignored. +compile-file and load cooperate in an implementation-dependent way to +assure the preservation of the similarity of characters referred to in +the source file at the time the source file was processed by the file +compiler under a given external file format, regardless of the value of +external-format at the time the compiled file is loaded. + + load binds *readtable* and *package* to the values they held before +loading the file. + + *load-truename* is bound by load to hold the truename of the pathname +of the file being loaded. + + *load-pathname* is bound by load to hold a pathname that represents +filespec merged against the defaults. That is, (pathname +(merge-pathnames filespec)). + +Examples:: +.......... + + ;Establish a data file... + (with-open-file (str "data.in" :direction :output :if-exists :error) + (print 1 str) (print '(setq a 888) str) t) + => T + (load "data.in") => true + a => 888 + (load (setq p (merge-pathnames "data.in")) :verbose t) + ; Loading contents of file /fred/data.in + ; Finished loading /fred/data.in + => true + (load p :print t) + ; Loading contents of file /fred/data.in + ; 1 + ; 888 + ; Finished loading /fred/data.in + => true + + ;----[Begin file SETUP]---- + (in-package "MY-STUFF") + (defmacro compile-truename () `',*compile-file-truename*) + (defvar *my-compile-truename* (compile-truename) "Just for debugging.") + (defvar *my-load-pathname* *load-pathname*) + (defun load-my-system () + (dolist (module-name '("FOO" "BAR" "BAZ")) + (load (merge-pathnames module-name *my-load-pathname*)))) + ;----[End of file SETUP]---- + + (load "SETUP") + (load-my-system) + +Affected By:: +............. + +The implementation, and the host computer's file system. + +Exceptional Situations:: +........................ + +If :if-does-not-exist is supplied and is true, or is not supplied, load +signals an error of type file-error if the file named by filespec does +not exist, + + or if the file system cannot perform the requested operation. + + An error of type file-error might be signaled if (wild-pathname-p +filespec) returns true. + +See Also:: +.......... + +*note error:: , *note merge-pathnames:: , *load-verbose*, +*default-pathname-defaults*, pathname, logical-pathname, *note File +System Concepts::, + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: with-compilation-unit, Next: *features*, Prev: load, Up: System Construction Dictionary + +24.2.4 with-compilation-unit [Macro] +------------------------------------ + +'with-compilation-unit' ([[!option]]) {form}* => {result}* + + option ::=:override override + +Arguments and Values:: +...................... + +override--a generalized boolean; evaluated. The default is nil. + + forms--an implicit progn. + + results--the values returned by the forms. + +Description:: +............. + +Executes forms from left to right. Within the dynamic environment of +with-compilation-unit, actions deferred by the compiler until the end of +compilation will be deferred until the end of the outermost call to +with-compilation-unit. + + The set of options permitted may be extended by the implementation, +but the only standardized keyword is :override. + + If nested dynamically only the outer call to with-compilation-unit +has any effect unless the value associated with :override is true, in +which case warnings are deferred only to the end of the innermost call +for which override is true. + + The function compile-file provides the effect of + + (with-compilation-unit (:override nil) ...) + + around its code. + + Any implementation-dependent extensions can only be provided as the +result of an explicit programmer request by use of an +implementation-dependent keyword. Implementations are forbidden from +attaching additional meaning to a use of this macro which involves +either no keywords or just the keyword :override. + +Examples:: +.......... + +If an implementation would normally defer certain kinds of warnings, +such as warnings about undefined functions, to the end of a compilation +unit (such as a file), the following example shows how to cause those +warnings to be deferred to the end of the compilation of several files. + + (defun compile-files (&rest files) + (with-compilation-unit () + (mapcar #'(lambda (file) (compile-file file)) files))) + + (compile-files "A" "B" "C") + + Note however that if the implementation does not normally defer any +warnings, use of with-compilation-unit might not have any effect. + +See Also:: +.......... + +*note compile:: , *note compile-file:: + + +File: gcl.info, Node: *features*, Next: *compile-file-pathname*, Prev: with-compilation-unit, Up: System Construction Dictionary + +24.2.5 *features* [Variable] +---------------------------- + +Value Type:: +............ + +a proper list. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The value of *features* is called the features list. It is a list of +symbols, called features, that correspond to some aspect of the +implementation or environment. + + Most features have implementation-dependent meanings; The following +meanings have been assigned to feature names: + +:cltl1 + If present, indicates that the LISP package purports to conform to + the 1984 specification Common Lisp: The Language. It is possible, + but not required, for a conforming implementation to have this + feature because this specification specifies that its symbols are + to be in the COMMON-LISP package, not the LISP package. + +:cltl2 + If present, indicates that the implementation purports to conform + to Common Lisp: The Language, Second Edition. This feature must + not be present in any conforming implementation, since conformance + to that document is not compatible with conformance to this + specification. The name, however, is reserved by this + specification in order to help programs distinguish implementations + which conform to that document from implementations which conform + to this specification. + +:ieee-floating-point + If present, indicates that the implementation purports to conform + to the requirements of IEEE Standard for Binary Floating-Point + Arithmetic. + +:x3j13 + If present, indicates that the implementation conforms to some + particular working draft of this specification, or to some subset + of features that approximates a belief about what this + specification might turn out to contain. A conforming + implementation might or might not contain such a feature. (This + feature is intended primarily as a stopgap in order to provide + implementors something to use prior to the availability of a draft + standard, in order to discourage them from introducing the + :draft-ansi-cl and :ansi-cl features prematurely.) + +:draft-ansi-cl + If present, indicates that the implementation purports to conform + to the first full draft of this specification, which went to public + review in 1992. A conforming implementation which has the + :draft-ansi-cl-2 or :ansi-cl feature is not permitted to retain the + :draft-ansi-cl feature since incompatible changes were made + subsequent to the first draft. + +:draft-ansi-cl-2 + If present, indicates that a second full draft of this + specification has gone to public review, and that the + implementation purports to conform to that specification. (If + additional public review drafts are produced, this keyword will + continue to refer to the second draft, and additional keywords will + be added to identify conformance with such later drafts. As such, + the meaning of this keyword can be relied upon not to change over + time.) A conforming implementation which has the :ansi-cl feature + is only permitted to retain the :draft-ansi-cl feature if the + finally approved standard is not incompatible with the draft + standard. + +:ansi-cl + If present, indicates that this specification has been adopted by + ANSI as an official standard, and that the implementation purports + to conform. + +:common-lisp + This feature must appear in *features* for any implementation that + has one or more of the features :x3j13, :draft-ansi-cl, or + :ansi-cl. It is intended that it should also appear in + implementations which have the features :cltl1 or :cltl2, but this + specification cannot force such behavior. The intent is that this + feature should identify the language family named "Common Lisp," + rather than some specific dialect within that family. + +See Also:: +.......... + +*note Use of Read-Time Conditionals::, *note Standard Macro Characters:: + +Notes:: +....... + +The value of *features* is used by the #+ and #- reader syntax. + + Symbols in the features list may be in any package, but in practice +they are generally in the KEYWORD package. This is because KEYWORD is +the package used by default when reading_2 feature expressions in the #+ +and #- reader macros. Code that needs to name a feature_2 in a package +P (other than KEYWORD) can do so by making explicit use of a package +prefix for P, but note that such code must also assure that the package +P exists in order for the feature expression to be read_2--even in cases +where the feature expression is expected to fail. + + It is generally considered wise for an implementation to include one +or more features identifying the specific implementation, so that +conditional expressions can be written which distinguish idiosyncrasies +of one implementation from those of another. Since features are +normally symbols in the KEYWORD package where name collisions might +easily result, and since no uniquely defined mechanism is designated for +deciding who has the right to use which symbol for what reason, a +conservative strategy is to prefer names derived from one's own company +or product name, since those names are often trademarked and are hence +less likely to be used unwittingly by another implementation. + + +File: gcl.info, Node: *compile-file-pathname*, Next: *load-pathname*, Prev: *features*, Up: System Construction Dictionary + +24.2.6 *compile-file-pathname*, *compile-file-truename* [Variable] +------------------------------------------------------------------ + +Value Type:: +............ + +The value of *compile-file-pathname* must always be a pathname or nil. +The value of *compile-file-truename* must always be a physical pathname +or nil. + +Initial Value:: +............... + +nil. + +Description:: +............. + +During a call to compile-file, *compile-file-pathname* is bound to the +pathname denoted by the first argument to compile-file, merged against +the defaults; that is, it is bound to (pathname (merge-pathnames +input-file)). During the same time interval, *compile-file-truename* is +bound to the truename of the file being compiled. + + At other times, the value of these variables is nil. + + If a break loop is entered while compile-file is ongoing, it is +implementation-dependent whether these variables retain the values they +had just prior to entering the break loop or whether they are bound to +nil. + + The consequences are unspecified if an attempt is made to assign or +bind either of these variables. + +Affected By:: +............. + +The file system. + +See Also:: +.......... + +*note compile-file:: + + +File: gcl.info, Node: *load-pathname*, Next: *compile-print*, Prev: *compile-file-pathname*, Up: System Construction Dictionary + +24.2.7 *load-pathname*, *load-truename* [Variable] +-------------------------------------------------- + +Value Type:: +............ + +The value of *load-pathname* must always be a pathname or nil. The +value of *load-truename* must always be a physical pathname or nil. + +Initial Value:: +............... + +nil. + +Description:: +............. + +During a call to load, *load-pathname* is bound to the pathname denoted +by the the first argument to load, merged against the defaults; that is, +it is bound to (pathname (merge-pathnames filespec)). During the same +time interval, *load-truename* is bound to the truename of the file +being loaded. + + At other times, the value of these variables is nil. + + If a break loop is entered while load is ongoing, it is +implementation-dependent whether these variables retain the values they +had just prior to entering the break loop or whether they are bound to +nil. + + The consequences are unspecified if an attempt is made to assign or +bind either of these variables. + +Affected By:: +............. + +The file system. + +See Also:: +.......... + +*note load:: + + +File: gcl.info, Node: *compile-print*, Next: *load-print*, Prev: *load-pathname*, Up: System Construction Dictionary + +24.2.8 *compile-print*, *compile-verbose* [Variable] +---------------------------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The value of *compile-print* is the default value of the :print argument +to compile-file. The value of *compile-verbose* is the default value of +the :verbose argument to compile-file. + +See Also:: +.......... + +*note compile-file:: + + +File: gcl.info, Node: *load-print*, Next: *modules*, Prev: *compile-print*, Up: System Construction Dictionary + +24.2.9 *load-print*, *load-verbose* [Variable] +---------------------------------------------- + +Value Type:: +............ + +a generalized boolean. + +Initial Value:: +............... + +The initial value of *load-print* is false. The initial value of +*load-verbose* is implementation-dependent. + +Description:: +............. + +The value of *load-print* is the default value of the :print argument to +load. The value of *load-verbose* is the default value of the :verbose +argument to load. + +See Also:: +.......... + +*note load:: + + +File: gcl.info, Node: *modules*, Next: provide, Prev: *load-print*, Up: System Construction Dictionary + +24.2.10 *modules* [Variable] +---------------------------- + +Value Type:: +............ + +a list of strings. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The value of *modules* is a list of names of the modules that have been +loaded into the current Lisp image. + +Affected By:: +............. + +provide + +See Also:: +.......... + +*note provide:: , require + +Notes:: +....... + +The variable *modules* is deprecated. + + +File: gcl.info, Node: provide, Prev: *modules*, Up: System Construction Dictionary + +24.2.11 provide, require [Function] +----------------------------------- + +'provide' module-name => implementation-dependent + + 'require' module-name &optional pathname-list => +implementation-dependent + +Arguments and Values:: +...................... + +module-name--a string designator. + + pathname-list--nil, or a designator for a non-empty list of pathname +designators. The default is nil. + +Description:: +............. + +provide adds the module-name to the list held by *modules*, if such a +name is not already present. + + require tests for the presence of the module-name in the list held by +*modules*. If it is present, require immediately returns. + + Otherwise, an attempt is made to load an appropriate set of files as +follows: The pathname-list argument, if non-nil, specifies a list of +pathnames to be loaded in order, from left to right. If the +pathname-list is nil, an implementation-dependent mechanism will be +invoked in an attempt to load the module named module-name; if no such +module can be loaded, an error of type error is signaled. + + Both functions use string= to test for the presence of a module-name. + +Examples:: +.......... + + ;;; This illustrates a nonportable use of REQUIRE, because it + ;;; depends on the implementation-dependent file-loading mechanism. + + (require "CALCULUS") + + ;;; This use of REQUIRE is nonportable because of the literal + ;;; physical pathname. + + (require "CALCULUS" "/usr/lib/lisp/calculus") + + ;;; One form of portable usage involves supplying a logical pathname, + ;;; with appropriate translations defined elsewhere. + + (require "CALCULUS" "lib:calculus") + + ;;; Another form of portable usage involves using a variable or + ;;; table lookup function to determine the pathname, which again + ;;; must be initialized elsewhere. + + (require "CALCULUS" *calculus-module-pathname*) + +Side Effects:: +.............. + +provide modifies *modules*. + +Affected By:: +............. + +The specific action taken by require is affected by calls to provide +(or, in general, any changes to the value of *modules*). + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if module-name is not a string +designator. + + If require fails to perform the requested operation due to a problem +while interacting with the file system, an error of type file-error is +signaled. + + An error of type file-error might be signaled if any pathname in +pathname-list is a designator for a wild pathname. + +See Also:: +.......... + +*modules*, + + *note Pathnames as Filenames:: + +Notes:: +....... + +The functions provide and require are deprecated. + + If a module consists of a single package, it is customary for the +package and module names to be the same. + + +File: gcl.info, Node: Environment, Next: Glossary (Glossary), Prev: System Construction, Up: Top + +25 Environment +************** + +* Menu: + +* The External Environment:: +* Environment Dictionary:: + + +File: gcl.info, Node: The External Environment, Next: Environment Dictionary, Prev: Environment, Up: Environment + +25.1 The External Environment +============================= + +* Menu: + +* Top level loop:: +* Debugging Utilities:: +* Environment Inquiry:: +* Time:: + + +File: gcl.info, Node: Top level loop, Next: Debugging Utilities, Prev: The External Environment, Up: The External Environment + +25.1.1 Top level loop +--------------------- + +The top level loop is the Common Lisp mechanism by which the user +normally interacts with the Common Lisp system. This loop is sometimes +referred to as the Lisp read-eval-print loop because it typically +consists of an endless loop that reads an expression, evaluates it and +prints the results. + + The top level loop is not completely specified; thus the user +interface is implementation-defined. The top level loop prints all +values resulting from the evaluation of a form. Figure 25-1 lists +variables that are maintained by the Lisp read-eval-print loop. + + * + / - + ** ++ // + *** +++ /// + + Figure 25-1: Variables maintained by the Read-Eval-Print Loop + + + +File: gcl.info, Node: Debugging Utilities, Next: Environment Inquiry, Prev: Top level loop, Up: The External Environment + +25.1.2 Debugging Utilities +-------------------------- + +Figure 25-2 shows defined names relating to debugging. + + *debugger-hook* documentation step + apropos dribble time + apropos-list ed trace + break inspect untrace + describe invoke-debugger + + Figure 25-2: Defined names relating to debugging + + + +File: gcl.info, Node: Environment Inquiry, Next: Time, Prev: Debugging Utilities, Up: The External Environment + +25.1.3 Environment Inquiry +-------------------------- + +Environment inquiry defined names provide information about the hardware +and software configuration on which a Common Lisp program is being +executed. + + Figure 25-3 shows defined names relating to environment inquiry. + + *features* machine-instance short-site-name + lisp-implementation-type machine-type software-type + lisp-implementation-version machine-version software-version + long-site-name room + + Figure 25-3: Defined names relating to environment inquiry. + + + +File: gcl.info, Node: Time, Prev: Environment Inquiry, Up: The External Environment + +25.1.4 Time +----------- + +Time is represented in four different ways in Common Lisp: decoded time, +universal time, internal time, and seconds. Decoded time and universal +time are used primarily to represent calendar time, and are precise only +to one second. Internal time is used primarily to represent +measurements of computer time (such as run time) and is precise to some +implementation-dependent fraction of a second called an internal time +unit, as specified by internal-time-units-per-second. An internal time +can be used for either absolute and relative time measurements. Both a +universal time and a decoded time can be used only for absolute time +measurements. In the case of one function, sleep, time intervals are +represented as a non-negative real number of seconds. + + Figure 25-4 shows defined names relating to time. + + decode-universal-time get-internal-run-time + encode-universal-time get-universal-time + get-decoded-time internal-time-units-per-second + get-internal-real-time sleep + + Figure 25-4: Defined names involving Time. + + +* Menu: + +* Decoded Time:: +* Universal Time:: +* Internal Time:: +* Seconds:: + + +File: gcl.info, Node: Decoded Time, Next: Universal Time, Prev: Time, Up: Time + +25.1.4.1 Decoded Time +..................... + +A decoded time is an ordered series of nine values that, taken together, +represent a point in calendar time (ignoring leap seconds): + +Second + An integer between 0 and~59, inclusive. + +Minute + An integer between 0 and~59, inclusive. + +Hour + An integer between 0 and~23, inclusive. + +Date + An integer between 1 and~31, inclusive (the upper limit actually + depends on the month and year, of course). + +Month + An integer between 1 and 12, inclusive; 1~means January, 2~means + February, and so on; 12~means December. + +Year + An integer indicating the year A.D. However, if this integer is + between 0 and 99, the "obvious" year is used; more precisely, that + year is assumed that is equal to the integer modulo 100 and within + fifty years of the current year (inclusive backwards and exclusive + forwards). Thus, in the year 1978, year 28 is 1928 but year 27 is + 2027. (Functions that return time in this format always return a + full year number.) + +Day of week + An integer between~0 and~6, inclusive; 0~means Monday, 1~means + Tuesday, and so on; 6~means Sunday. + +Daylight saving time flag + A generalized boolean that, if true, indicates that daylight saving + time is in effect. + +Time zone + A time zone. + + Figure 25-5 shows defined names relating to decoded time. + + decode-universal-time get-decoded-time + + Figure 25-5: Defined names involving time in Decoded Time. + + + +File: gcl.info, Node: Universal Time, Next: Internal Time, Prev: Decoded Time, Up: Time + +25.1.4.2 Universal Time +....................... + +Universal time is an absolute time represented as a single non-negative +integer--the number of seconds since midnight, January 1, 1900 GMT +(ignoring leap seconds). Thus the time 1 is 00:00:01 (that is, 12:00:01 +a.m.) on January 1, 1900 GMT. Similarly, the time 2398291201 +corresponds to time 00:00:01 on January 1, 1976 GMT. Recall that the +year 1900 was not a leap year; for the purposes of Common Lisp, a year +is a leap year if and only if its number is divisible by 4, except that +years divisible by 100 are not leap years, except that years divisible +by 400 are leap years. Therefore the year 2000 will be a leap year. +Because universal time must be a non-negative integer, times before the +base time of midnight, January 1, 1900 GMT cannot be processed by Common +Lisp. + + decode-universal-time get-universal-time + encode-universal-time + + Figure 25-6: Defined names involving time in Universal Time. + + + +File: gcl.info, Node: Internal Time, Next: Seconds, Prev: Universal Time, Up: Time + +25.1.4.3 Internal Time +...................... + +Internal time represents time as a single integer, in terms of an +implementation-dependent unit called an internal time unit. Relative +time is measured as a number of these units. Absolute time is relative +to an arbitrary time base. + + Figure 25-7 shows defined names related to internal time. + + get-internal-real-time internal-time-units-per-second + get-internal-run-time + + Figure 25-7: Defined names involving time in Internal Time. + + + +File: gcl.info, Node: Seconds, Prev: Internal Time, Up: Time + +25.1.4.4 Seconds +................ + +One function, sleep, takes its argument as a non-negative real number of +seconds. Informally, it may be useful to think of this as a relative +universal time, but it differs in one important way: universal times are +always non-negative integers, whereas the argument to sleep can be any +kind of non-negative real, in order to allow for the possibility of +fractional seconds. + + sleep + + Figure 25-8: Defined names involving time in Seconds. + + + +File: gcl.info, Node: Environment Dictionary, Prev: The External Environment, Up: Environment + +25.2 Environment Dictionary +=========================== + +* Menu: + +* decode-universal-time:: +* encode-universal-time:: +* get-universal-time:: +* sleep:: +* apropos:: +* describe:: +* describe-object:: +* trace:: +* step:: +* time:: +* internal-time-units-per-second:: +* get-internal-real-time:: +* get-internal-run-time:: +* disassemble:: +* documentation:: +* room:: +* ed:: +* inspect:: +* dribble:: +* - (Variable):: +* + (Variable):: +* * (Variable):: +* / (Variable):: +* lisp-implementation-type:: +* short-site-name:: +* machine-instance:: +* machine-type:: +* machine-version:: +* software-type:: +* user-homedir-pathname:: + + +File: gcl.info, Node: decode-universal-time, Next: encode-universal-time, Prev: Environment Dictionary, Up: Environment Dictionary + +25.2.1 decode-universal-time [Function] +--------------------------------------- + +'decode-universal-time' universal-time &optional time-zone +=> second, minute, hour, date, month, year, day, daylight-p, zone + +Arguments and Values:: +...................... + +universal-time--a universal time. + + time-zone--a time zone. + + second, minute, hour, date, month, year, day, daylight-p, zone--a +decoded time. + +Description:: +............. + +Returns the decoded time represented by the given universal time. + + If time-zone is not supplied, it defaults to the current time zone +adjusted for daylight saving time. + + If time-zone is supplied, daylight saving time information is +ignored. The daylight saving time flag is nil if time-zone is supplied. + +Examples:: +.......... + + (decode-universal-time 0 0) => 0, 0, 0, 1, 1, 1900, 0, false, 0 + + ;; The next two examples assume Eastern Daylight Time. + (decode-universal-time 2414296800 5) => 0, 0, 1, 4, 7, 1976, 6, false, 5 + (decode-universal-time 2414293200) => 0, 0, 1, 4, 7, 1976, 6, true, 5 + + ;; This example assumes that the time zone is Eastern Daylight Time + ;; (and that the time zone is constant throughout the example). + (let* ((here (nth 8 (multiple-value-list (get-decoded-time)))) ;Time zone + (recently (get-universal-time)) + (a (nthcdr 7 (multiple-value-list (decode-universal-time recently)))) + (b (nthcdr 7 (multiple-value-list (decode-universal-time recently here))))) + (list a b (equal a b))) => ((T 5) (NIL 5) NIL) + +Affected By:: +............. + +Implementation-dependent mechanisms for calculating when or if daylight +savings time is in effect for any given session. + +See Also:: +.......... + +*note encode-universal-time:: , *note get-universal-time:: , *note +Time:: + + +File: gcl.info, Node: encode-universal-time, Next: get-universal-time, Prev: decode-universal-time, Up: Environment Dictionary + +25.2.2 encode-universal-time [function] +--------------------------------------- + +Syntax:: +........ + +'encode-universal-time' second minute hour date month year &optional +time-zone +=> universal-time + +Arguments and Values:: +...................... + +second, minute, hour, date, month, year, time-zone--the corresponding +parts of a decoded time. (Note that some of the nine values in a full +decoded time are redundant, and so are not used as inputs to this +function.) + + universal-time--a universal time. + +Description:: +............. + +encode-universal-time converts a time from Decoded Time format to a +universal time. + + If time-zone is supplied, no adjustment for daylight savings time is +performed. + +Examples:: +.......... + + (encode-universal-time 0 0 0 1 1 1900 0) => 0 + (encode-universal-time 0 0 1 4 7 1976 5) => 2414296800 + ;; The next example assumes Eastern Daylight Time. + (encode-universal-time 0 0 1 4 7 1976) => 2414293200 + +See Also:: +.......... + +*note decode-universal-time:: , get-decoded-time + + +File: gcl.info, Node: get-universal-time, Next: sleep, Prev: encode-universal-time, Up: Environment Dictionary + +25.2.3 get-universal-time, get-decoded-time [Function] +------------------------------------------------------ + +'get-universal-time' => universal-time + + 'get-decoded-time' +=> second, minute, hour, date, month, year, day, daylight-p, zone + +Arguments and Values:: +...................... + +universal-time--a universal time. + + second, minute, hour, date, month, year, day, daylight-p, zone--a +decoded time. + +Description:: +............. + +get-universal-time returns the current time, represented as a universal +time. + + get-decoded-time returns the current time, represented as a decoded +time. + +Examples:: +.......... + + ;; At noon on July 4, 1976 in Eastern Daylight Time. + (get-decoded-time) => 0, 0, 12, 4, 7, 1976, 6, true, 5 + ;; At exactly the same instant. + (get-universal-time) => 2414332800 + ;; Exactly five minutes later. + (get-universal-time) => 2414333100 + ;; The difference is 300 seconds (five minutes) + (- * **) => 300 + +Affected By:: +............. + +The time of day (i.e., the passage of time), the system clock's ability +to keep accurate time, and the accuracy of the system clock's initial +setting. + +Exceptional Situations:: +........................ + +An error of type error might be signaled if the current time cannot be +determined. + +See Also:: +.......... + +*note decode-universal-time:: , *note encode-universal-time:: , *note +Time:: + +Notes:: +....... + + (get-decoded-time) == (decode-universal-time (get-universal-time)) + + No implementation is required to have a way to verify that the time +returned is correct. However, if an implementation provides a validity +check (e.g., the failure to have properly initialized the system clock +can be reliably detected) and that validity check fails, the +implementation is strongly encouraged (but not required) to signal an +error of type error (rather than, for example, returning a +known-to-be-wrong value) that is correctable by allowing the user to +interactively set the correct time. + + +File: gcl.info, Node: sleep, Next: apropos, Prev: get-universal-time, Up: Environment Dictionary + +25.2.4 sleep [Function] +----------------------- + +'sleep' seconds => nil + +Arguments and Values:: +...................... + +seconds--a non-negative real. + +Description:: +............. + +Causes execution to cease and become dormant for approximately the +seconds of real time indicated by seconds, whereupon execution is +resumed. + +Examples:: +.......... + + (sleep 1) => NIL + + ;; Actually, since SLEEP is permitted to use approximate timing, + ;; this might not always yield true, but it will often enough that + ;; we felt it to be a productive example of the intent. + (let ((then (get-universal-time)) + (now (progn (sleep 10) (get-universal-time)))) + (>= (- now then) 10)) + => true + +Side Effects:: +.............. + +Causes processing to pause. + +Affected By:: +............. + +The granularity of the scheduler. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if seconds is not a +non-negative real. + + +File: gcl.info, Node: apropos, Next: describe, Prev: sleep, Up: Environment Dictionary + +25.2.5 apropos, apropos-list [Function] +--------------------------------------- + +'apropos' string &optional package => + + 'apropos-list' string &optional package => symbols + +Arguments and Values:: +...................... + +string--a string designator. + + package--a package designator or nil. The default is nil. + + symbols--a list of symbols. + +Description:: +............. + +These functions search for interned symbols whose names contain the +substring string. + + For apropos, as each such symbol is found, its name is printed on +standard output. In addition, if such a symbol is defined as a function +or dynamic variable, information about those definitions might also be +printed. + + For apropos-list, no output occurs as the search proceeds; instead a +list of the matching symbols is returned when the search is complete. + + If package is non-nil, only the symbols accessible in that package +are searched; otherwise all symbols accessible in any package are +searched. + + Because a symbol might be available by way of more than one +inheritance path, apropos might print information about the same symbol +more than once, or apropos-list might return a list containing duplicate +symbols. + + Whether or not the search is case-sensitive is +implementation-defined. + +Affected By:: +............. + +The set of symbols which are currently interned in any packages being +searched. + + apropos is also affected by *standard-output*. + + +File: gcl.info, Node: describe, Next: describe-object, Prev: apropos, Up: Environment Dictionary + +25.2.6 describe [Function] +-------------------------- + +'describe' object &optional stream => + +Arguments and Values:: +...................... + +object--an object. + + stream--an output stream designator. The default is standard output. + +Description:: +............. + +describe displays information about object + + to stream. + + For example, describe of a symbol might show the symbol's value, its +definition, and each of its properties. describe of a float might show +the number's internal representation in a way that is useful for +tracking down round-off errors. In all cases, however, the nature and +format of the output of describe is implementation-dependent. + + describe can describe something that it finds inside the object; in +such cases, a notational device such as increased indentation or +positioning in a table is typically used in order to visually +distinguish such recursive descriptions from descriptions of the +argument object. + + The actual act of describing the object is implemented by +describe-object. describe exists as an interface primarily to manage +argument defaulting (including conversion of arguments t and nil into +stream objects) and to inhibit any return values from describe-object. + + describe is not intended to be an interactive function. In a +conforming implementation, describe must not, by default, prompt for +user input. User-defined methods for describe-object are likewise +restricted. + +Side Effects:: +.............. + +Output to standard output or terminal I/O. + +Affected By:: +............. + +*standard-output* and *terminal-io*, methods on describe-object and +print-object for objects having user-defined classes. + +See Also:: +.......... + +*note inspect:: , *note describe-object:: + + +File: gcl.info, Node: describe-object, Next: trace, Prev: describe, Up: Environment Dictionary + +25.2.7 describe-object [Standard Generic Function] +-------------------------------------------------- + +Syntax:: +........ + +'describe-object' object stream => implementation-dependent + +Method Signatures:: +................... + +'describe-object' (object standard-object) stream + +Arguments and Values:: +...................... + +object--an object. + + stream--a stream. + +Description:: +............. + +The generic function describe-object prints a description of object to a +stream. describe-object is called by describe; it must not be called by +the user. + + Each implementation is required to provide a method on the class +standard-object and methods on enough other classes so as to ensure that +there is always an applicable method. Implementations are free to add +methods for other classes. Users can write methods for describe-object +for their own classes if they do not wish to inherit an +implementation-supplied method. + + Methods on describe-object can recursively call describe. +Indentation, depth limits, and circularity detection are all taken care +of automatically, provided that each method handles exactly one level of +structure and calls describe recursively if there are more structural +levels. The consequences are undefined if this rule is not obeyed. + + In some implementations the stream argument passed to a +describe-object method is not the original stream, but is an +intermediate stream that implements parts of describe. Methods should +therefore not depend on the identity of this stream. + +Examples:: +.......... + + (defclass spaceship () + ((captain :initarg :captain :accessor spaceship-captain) + (serial# :initarg :serial-number :accessor spaceship-serial-number))) + + (defclass federation-starship (spaceship) ()) + + (defmethod describe-object ((s spaceship) stream) + (with-slots (captain serial#) s + (format stream "~&~S is a spaceship of type ~S,~ + ~ + and with serial number ~D.~ + s (type-of s) captain serial#))) + + (make-instance 'federation-starship + :captain "Rachel Garrett" + :serial-number "NCC-1701-C") + => # + + (describe *) + |> # is a spaceship of type FEDERATION-STARSHIP, + |> with Rachel Garrett at the helm and with serial number NCC-1701-C. + => + +See Also:: +.......... + +*note describe:: + +Notes:: +....... + +The same implementation techniques that are applicable to print-object +are applicable to describe-object. + + The reason for making the return values for describe-object +unspecified is to avoid forcing users to include explicit (values) in +all of their methods. describe takes care of that. + + +File: gcl.info, Node: trace, Next: step, Prev: describe-object, Up: Environment Dictionary + +25.2.8 trace, untrace [Macro] +----------------------------- + +'trace' {function-name}* => trace-result + + 'untrace' {function-name}* => untrace-result + +Arguments and Values:: +...................... + +function-name--a function name. + + trace-result--implementation-dependent, unless no function-names are +supplied, in which case trace-result is a list of function names. + + untrace-result--implementation-dependent. + +Description:: +............. + +trace and untrace control the invocation of the trace facility. + + Invoking trace with one or more function-names causes the denoted +functions to be "traced." Whenever a traced function is invoked, +information about the call, about the arguments passed, and about any +eventually returned values is printed to trace output. If trace is used +with no function-names, no tracing action is performed; instead, a list +of the functions currently being traced is returned. + + Invoking untrace with one or more function names causes those +functions to be "untraced" (i.e., no longer traced). If untrace is used +with no function-names, all functions currently being traced are +untraced. + + If a function to be traced has been open-coded (e.g., because it was +declared inline), a call to that function might not produce trace +output. + +Examples:: +.......... + + (defun fact (n) (if (zerop n) 1 (* n (fact (- n 1))))) + => FACT + (trace fact) + => (FACT) + ;; Of course, the format of traced output is implementation-dependent. + (fact 3) + |> 1 Enter FACT 3 + |> | 2 Enter FACT 2 + |> | 3 Enter FACT 1 + |> | | 4 Enter FACT 0 + |> | | 4 Exit FACT 1 + |> | 3 Exit FACT 1 + |> | 2 Exit FACT 2 + |> 1 Exit FACT 6 + => 6 + +Side Effects:: +.............. + +Might change the definitions of the functions named by function-names. + +Affected By:: +............. + +Whether the functions named are defined or already being traced. + +Exceptional Situations:: +........................ + +Tracing an already traced function, or untracing a function not +currently being traced, should produce no harmful effects, but might +signal a warning. + +See Also:: +.......... + +*trace-output*, *note step:: + +Notes:: +....... + +trace and untrace may also accept additional implementation-dependent +argument formats. The format of the trace output is +implementation-dependent. + + Although trace can be extended to permit non-standard options, +implementations are nevertheless encouraged (but not required) to warn +about the use of syntax or options that are neither specified by this +standard nor added as an extension by the implementation, since they +could be symptomatic of typographical errors or of reliance on features +supported in implementations other than the current implementation. + + +File: gcl.info, Node: step, Next: time, Prev: trace, Up: Environment Dictionary + +25.2.9 step [Macro] +------------------- + +'step' form => {result}* + +Arguments and Values:: +...................... + +form--a form; evaluated as described below. + + results--the values returned by the form. + +Description:: +............. + +step implements a debugging paradigm wherein the programmer is allowed +to step through the evaluation of a form. The specific nature of the +interaction, + + including which I/O streams are used and whether the stepping has +lexical or dynamic scope, + + is implementation-defined. + + step evaluates form in the current environment. A call to step can +be compiled, but it is acceptable for an implementation to interactively +step through only those parts of the computation that are interpreted. + + It is technically permissible for a conforming implementation to take +no action at all other than normal execution of the form. In such a +situation, (step form) is equivalent to, for example, (let () form). In +implementations where this is the case, the associated documentation +should mention that fact. + +See Also:: +.......... + +*note trace:: + +Notes:: +....... + +Implementations are encouraged to respond to the typing of ? or the +pressing of a "help key" by providing help including a list of commands. + + +File: gcl.info, Node: time, Next: internal-time-units-per-second, Prev: step, Up: Environment Dictionary + +25.2.10 time [Macro] +-------------------- + +'time' form => {result}* + +Arguments and Values:: +...................... + +form--a form; evaluated as described below. + + results--the values returned by the form. + +Description:: +............. + +time evaluates form in the current environment (lexical and dynamic). A +call to time can be compiled. + + time prints various timing data and other information to trace +output. The nature and format of the printed information is +implementation-defined. Implementations are encouraged to provide such +information as elapsed real time, machine run time, and storage +management statistics. + +Affected By:: +............. + +The accuracy of the results depends, among other things, on the accuracy +of the corresponding functions provided by the underlying operating +system. + + The magnitude of the results may depend on the hardware, the +operating system, the lisp implementation, and the state of the global +environment. Some specific issues which frequently affect the outcome +are hardware speed, nature of the scheduler (if any), number of +competing processes (if any), system paging, whether the call is +interpreted or compiled, whether functions called are compiled, the kind +of garbage collector involved and whether it runs, whether internal data +structures (e.g., hash tables) are implicitly reorganized, etc. + +See Also:: +.......... + +*note get-internal-real-time:: , *note get-internal-run-time:: + +Notes:: +....... + +In general, these timings are not guaranteed to be reliable enough for +marketing comparisons. Their value is primarily heuristic, for tuning +purposes. + + For useful background information on the complicated issues involved +in interpreting timing results, see Performance and Evaluation of Lisp +Programs. + + +File: gcl.info, Node: internal-time-units-per-second, Next: get-internal-real-time, Prev: time, Up: Environment Dictionary + +25.2.11 internal-time-units-per-second [Constant Variable] +---------------------------------------------------------- + +Constant Value:: +................ + +A positive integer, the magnitude of which is implementation-dependent. + +Description:: +............. + +The number of internal time units in one second. + +See Also:: +.......... + +*note get-internal-run-time:: , *note get-internal-real-time:: + +Notes:: +....... + +These units form the basis of the Internal Time format representation. + + +File: gcl.info, Node: get-internal-real-time, Next: get-internal-run-time, Prev: internal-time-units-per-second, Up: Environment Dictionary + +25.2.12 get-internal-real-time [Function] +----------------------------------------- + +'get-internal-real-time' => internal-time + +Arguments and Values:: +...................... + +internal-time--a non-negative integer. + +Description:: +............. + +get-internal-real-time returns as an integer the current time in +internal time units, relative to an arbitrary time base. The difference +between the values of two calls to this function is the amount of +elapsed real time (i.e., clock time) between the two calls. + +Affected By:: +............. + +Time of day (i.e., the passage of time). The time base affects the +result magnitude. + +See Also:: +.......... + +*note internal-time-units-per-second:: + + +File: gcl.info, Node: get-internal-run-time, Next: disassemble, Prev: get-internal-real-time, Up: Environment Dictionary + +25.2.13 get-internal-run-time [Function] +---------------------------------------- + +'get-internal-run-time' => internal-time + +Arguments and Values:: +...................... + +internal-time--a non-negative integer. + +Description:: +............. + +Returns as an integer the current run time in internal time units. The +precise meaning of this quantity is implementation-defined; it may +measure real time, run time, CPU cycles, or some other quantity. The +intent is that the difference between the values of two calls to this +function be the amount of time between the two calls during which +computational effort was expended on behalf of the executing program. + +Affected By:: +............. + +The implementation, the time of day (i.e., the passage of time). + +See Also:: +.......... + +*note internal-time-units-per-second:: + +Notes:: +....... + +Depending on the implementation, paging time and garbage collection time +might be included in this measurement. Also, in a multitasking +environment, it might not be possible to show the time for just the +running process, so in some implementations, time taken by other +processes during the same time interval might be included in this +measurement as well. + + +File: gcl.info, Node: disassemble, Next: documentation, Prev: get-internal-run-time, Up: Environment Dictionary + +25.2.14 disassemble [Function] +------------------------------ + +'disassemble' fn => nil + +Arguments and Values:: +...................... + +fn--an extended function designator or a lambda expression. + +Description:: +............. + +The function disassemble is a debugging aid that composes symbolic +instructions or expressions in some implementation-dependent language +which represent the code used to produce the function which is or is +named by the argument fn. The result is displayed to standard output in +an implementation-dependent format. + + If fn is a lambda expression or interpreted function, it is compiled +first and the result is disassembled. + + If the fn designator is a function name, the function that it names +is disassembled. + + (If that function is an interpreted function, it is first compiled +but the result of this implicit compilation is not installed.) + +Examples:: +.......... + + (defun f (a) (1+ a)) => F + (eq (symbol-function 'f) + (progn (disassemble 'f) + (symbol-function 'f))) => true + +Affected By:: +............. + +*standard-output*. + +Exceptional Situations:: +........................ + +Should signal an error of type type-error if fn is not an extended +function designator or a lambda expression. + + +File: gcl.info, Node: documentation, Next: room, Prev: disassemble, Up: Environment Dictionary + +25.2.15 documentation, (setf documentation) [Standard Generic Function] +----------------------------------------------------------------------- + +Syntax:: +........ + +'documentation' x doc-type => documentation + + '(setf documentation)' new-value x doc-type => new-value + +Argument Precedence Order:: +........................... + +doc-type, object + +Method Signatures:: +................... + +Functions, Macros, and Special Forms +.................................... + +documentation (x 'function') (doc-type (eql 't)) +(setf documentation) new-value(x 'function') (doc-type (eql 't)) + + documentation (x 'function') (doc-type (eql 'function)) +(setf documentation) new-value(x 'function') (doc-type (eql 'function)) + + documentation (x 'list') (doc-type (eql 'function)) +(setf documentation) new-value(x 'list') (doc-type (eql 'function)) + + documentation (x 'list') (doc-type (eql 'compiler-macro)) +(setf documentation) new-value(x 'list') (doc-type (eql +'compiler-macro)) + + documentation (x 'symbol') (doc-type (eql 'function)) +(setf documentation) new-value(x 'symbol') (doc-type (eql 'function)) + + documentation (x 'symbol') (doc-type (eql 'compiler-macro)) +(setf documentation) new-value(x 'symbol') (doc-type (eql +'compiler-macro)) + + documentation (x 'symbol') (doc-type (eql 'setf)) +(setf documentation) new-value(x 'symbol') (doc-type (eql 'setf)) + +Method Combinations +................... + +documentation (x 'method-combination') (doc-type (eql 't)) +(setf documentation) new-value(x 'method-combination') (doc-type (eql +'t)) + + documentation (x 'method-combination') (doc-type (eql +'method-combination)) +(setf documentation) new-value(x 'method-combination') (doc-type (eql +'method-combination)) + + documentation (x 'symbol') (doc-type (eql 'method-combination)) +(setf documentation) new-value(x 'symbol') (doc-type (eql +'method-combination)) + +Methods +....... + +documentation (x 'standard-method') (doc-type (eql 't)) +(setf documentation) new-value(x 'standard-method') (doc-type (eql 't)) + +Packages +........ + +documentation (x 'package') (doc-type (eql 't)) +(setf documentation) new-value(x 'package') (doc-type (eql 't)) + +Types, Classes, and Structure Names +................................... + +documentation (x 'standard-class') (doc-type (eql 't)) +(setf documentation) new-value(x 'standard-class') (doc-type (eql 't)) + + documentation (x 'standard-class') (doc-type (eql 'type)) +(setf documentation) new-value(x 'standard-class') (doc-type (eql +'type)) + + documentation (x 'structure-class') (doc-type (eql 't)) +(setf documentation) new-value(x 'structure-class') (doc-type (eql 't)) + + documentation (x 'structure-class') (doc-type (eql 'type)) +(setf documentation) new-value(x 'structure-class') (doc-type (eql +'type)) + + documentation (x 'symbol') (doc-type (eql 'type)) +(setf documentation) new-value(x 'symbol') (doc-type (eql 'type)) + + documentation (x 'symbol') (doc-type (eql 'structure)) +(setf documentation) new-value(x 'symbol') (doc-type (eql 'structure)) + +Variables +......... + +documentation (x 'symbol') (doc-type (eql 'variable)) +(setf documentation) new-value(x 'symbol') (doc-type (eql 'variable)) + +Arguments and Values:: +...................... + +x--an object. + + doc-type--a symbol. + + documentation--a string, or nil. + + new-value--a string. + +Description:: +............. + +The generic function documentation returns the documentation string +associated with the given object if it is available; otherwise it +returns nil. + + The generic function (setf documentation) updates the documentation +string associated with x to new-value. If x is a list, it must be of +the form (setf symbol). + + Documentation strings are made available for debugging purposes. +Conforming programs are permitted to use documentation strings when they +are present, but should not depend for their correct behavior on the +presence of those documentation strings. An implementation is permitted +to discard documentation strings at any time for implementation-defined +reasons. + + The nature of the documentation string returned depends on the +doc-type, as follows: + +compiler-macro + Returns the documentation string of the compiler macro whose name + is the function name x. + +function + If x is a function name, returns the documentation string of the + function, macro, or special operator whose name is x. + + If x is a function, returns the documentation string associated + with x. + +method-combination + If x is a symbol, returns the documentation string of the method + combination whose name is x. + + If x is a method combination, returns the documentation string + associated with x. + +setf + Returns the documentation string of + + the setf expander + + whose name is the symbol x. + +structure + Returns the documentation string associated with the structure name + x. + +t + Returns a documentation string specialized on the class of the + argument x itself. For example, if x is a function, the + documentation string associated with the function x is returned. + +type + If x is a symbol, returns the documentation string of the class + whose name is the symbol x, if there is such a class. Otherwise, + it returns the documentation string of the type which is the type + specifier symbol x. + + If x is a structure class or standard class, returns the + documentation string associated with the class x. + +variable + Returns the documentation string of the dynamic variable or + constant variable whose name is the symbol x. + + A conforming implementation or a conforming program may extend the +set of symbols that are acceptable as the doc-type. + +Notes:: +....... + +This standard prescribes no means to retrieve the documentation strings +for individual slots specified in a defclass form, but implementations +might still provide debugging tools and/or programming language +extensions which manipulate this information. Implementors wishing to +provide such support are encouraged to consult the Metaobject Protocol +for suggestions about how this might be done. + diff --git a/info/gcl.info-9 b/info/gcl.info-9 new file mode 100644 index 0000000..c74b73f --- /dev/null +++ b/info/gcl.info-9 @@ -0,0 +1,4877 @@ +This is gcl.info, produced by makeinfo version 6.7 from gcl.texi. + +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI +standard for Common Lisp. + + Copyright 1994 William F. Schelter + +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY + + +File: gcl.info, Node: room, Next: ed, Prev: documentation, Up: Environment Dictionary + +25.2.16 room [Function] +----------------------- + +'room' &optional x => implementation-dependent + +Arguments and Values:: +...................... + +x--one of t, nil, or :default. + +Description:: +............. + +room prints, to standard output, information about the state of internal +storage and its management. This might include descriptions of the +amount of memory in use and the degree of memory compaction, possibly +broken down by internal data type if that is appropriate. The nature +and format of the printed information is implementation-dependent. The +intent is to provide information that a programmer might use to tune a +program for a particular implementation. + + (room nil) prints out a minimal amount of information. (room t) +prints out a maximal amount of information. + + (room) or (room :default) prints out an intermediate amount of +information that is likely to be useful. + +Side Effects:: +.............. + +Output to standard output. + +Affected By:: +............. + +*standard-output*. + + +File: gcl.info, Node: ed, Next: inspect, Prev: room, Up: Environment Dictionary + +25.2.17 ed [Function] +--------------------- + +'ed' &optional x => implementation-dependent + +Arguments and Values:: +...................... + +x--nil, a pathname, a string, or a function name. + + The default is nil. + +Description:: +............. + +ed invokes the editor if the implementation provides a resident editor. + + If x is nil, the editor is entered. If the editor had been +previously entered, its prior state is resumed, if possible. + + If x is a pathname or string, it is taken as the pathname designator +for a file to be edited. + + If x is a function name, the text of its definition is edited. The +means by which the function text is obtained is implementation-defined. + +Exceptional Situations:: +........................ + +The consequences are undefined if the implementation does not provide a +resident editor. + + Might signal type-error if its argument is supplied but is not a +symbol, a pathname, or nil. + + If a failure occurs when performing some operation on the file system +while attempting to edit a file, an error of type file-error is +signaled. + + An error of type file-error might be signaled if x is a designator +for a wild pathname. + + Implementation-dependent additional conditions might be signaled as +well. + +See Also:: +.......... + +pathname, + + logical-pathname, + + *note compile-file:: , *note load:: , + + *note Pathnames as Filenames:: + + +File: gcl.info, Node: inspect, Next: dribble, Prev: ed, Up: Environment Dictionary + +25.2.18 inspect [Function] +-------------------------- + +'inspect' object => implementation-dependent + +Arguments and Values:: +...................... + +object--an object. + +Description:: +............. + +inspect is an interactive version of describe. The nature of the +interaction is implementation-dependent, but the purpose of inspect is +to make it easy to wander through a data structure, examining and +modifying parts of it. + +Side Effects:: +.............. + +implementation-dependent. + +Affected By:: +............. + +implementation-dependent. + +Exceptional Situations:: +........................ + +implementation-dependent. + +See Also:: +.......... + +*note describe:: + +Notes:: +....... + +Implementations are encouraged to respond to the typing of ? or a "help +key" by providing help, including a list of commands. + + +File: gcl.info, Node: dribble, Next: - (Variable), Prev: inspect, Up: Environment Dictionary + +25.2.19 dribble [Function] +-------------------------- + +'dribble' &optional pathname => implementation-dependent + +Arguments and Values:: +...................... + +pathname--a pathname designator. + +Description:: +............. + +Either binds *standard-input* and *standard-output* or takes other +appropriate action, so as to send a record of the input/output +interaction to a file named by pathname. dribble is intended to create +a readable record of an interactive session. + + If pathname is a logical pathname, it is translated into a physical +pathname as if by calling translate-logical-pathname. + + (dribble) terminates the recording of input and output and closes the +dribble file. + + If dribble is called while a stream to a "dribble file" is still open +from a previous call to dribble, the effect is implementation-defined. +For example, the already-open stream might be closed, or dribbling might +occur both to the old stream and to a new one, or the old stream might +stay open but not receive any further output, or the new request might +be ignored, or some other action might be taken. + +Affected By:: +............. + +The implementation. + +Exceptional Situations:: +........................ + +If a failure occurs when performing some operation on the file system +while creating the dribble file, an error of type file-error is +signaled. + + An error of type file-error might be signaled if pathname is a +designator for a wild pathname. + +See Also:: +.......... + +*note Pathnames as Filenames:: + +Notes:: +....... + +dribble can return before subsequent forms are executed. It also can +enter a recursive interaction loop, returning only when (dribble) is +done. + + dribble is intended primarily for interactive debugging; its effect +cannot be relied upon when used in a program. + + +File: gcl.info, Node: - (Variable), Next: + (Variable), Prev: dribble, Up: Environment Dictionary + +25.2.20 - [Variable] +-------------------- + +Value Type:: +............ + +a form. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The value of - is the form that is currently being evaluated by the Lisp +read-eval-print loop. + +Examples:: +.......... + + (format t "~&Evaluating ~S~ + |> Evaluating (FORMAT T "~&Evaluating ~S~ + => NIL + +Affected By:: +............. + +Lisp read-eval-print loop. + +See Also:: +.......... + ++ (variable), * (variable), *note /:: (variable), *note Top level loop:: + + +File: gcl.info, Node: + (Variable), Next: * (Variable), Prev: - (Variable), Up: Environment Dictionary + +25.2.21 +, ++, +++ [Variable] +----------------------------- + +Value Type:: +............ + +an object. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The variables +, ++, and +++ are maintained by the Lisp read-eval-print +loop to save forms that were recently evaluated. + + The value of + is the last form that was evaluated, the value of ++ +is the previous value of +, and the value of +++ is the previous value +of ++. + +Examples:: +.......... + + (+ 0 1) => 1 + (- 4 2) => 2 + (/ 9 3) => 3 + (list + ++ +++) => ((/ 9 3) (- 4 2) (+ 0 1)) + (setq a 1 b 2 c 3 d (list a b c)) => (1 2 3) + (setq a 4 b 5 c 6 d (list a b c)) => (4 5 6) + (list a b c) => (4 5 6) + (eval +++) => (1 2 3) + #.`(,@++ d) => (1 2 3 (1 2 3)) + +Affected By:: +............. + +Lisp read-eval-print loop. + +See Also:: +.......... + +*note -:: (variable), * (variable), *note /:: (variable), *note Top +level loop:: + + +File: gcl.info, Node: * (Variable), Next: / (Variable), Prev: + (Variable), Up: Environment Dictionary + +25.2.22 *, **, *** [Variable] +----------------------------- + +Value Type:: +............ + +an object. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The variables *, **, and *** are maintained by the Lisp read-eval-print +loop to save the values of results that are printed each time through +the loop. + + The value of * is the most recent primary value that was printed, the +value of ** is the previous value of *, and the value of *** is the +previous value of **. + + If several values are produced, * contains the first value only; * +contains nil if zero values are produced. + + The values of *, **, and *** are updated immediately prior to +printing the return value of a top-level form by the Lisp +read-eval-print loop. If the evaluation of such a form is aborted prior +to its normal return, the values of *, **, and *** are not updated. + +Examples:: +.......... + + (values 'a1 'a2) => A1, A2 + 'b => B + (values 'c1 'c2 'c3) => C1, C2, C3 + (list * ** ***) => (C1 B A1) + + (defun cube-root (x) (expt x 1/3)) => CUBE-ROOT + (compile *) => CUBE-ROOT + (setq a (cube-root 27.0)) => 3.0 + (* * 9.0) => 27.0 + +Affected By:: +............. + +Lisp read-eval-print loop. + +See Also:: +.......... + +*note -:: (variable), + (variable), *note /:: (variable), *note Top +level loop:: + +Notes:: +....... + + * == (car /) + ** == (car //) + *** == (car ///) + + +File: gcl.info, Node: / (Variable), Next: lisp-implementation-type, Prev: * (Variable), Up: Environment Dictionary + +25.2.23 /, //, /// [Variable] +----------------------------- + +Value Type:: +............ + +a proper list. + +Initial Value:: +............... + +implementation-dependent. + +Description:: +............. + +The variables /, //, and /// are maintained by the Lisp read-eval-print +loop to save the values of results that were printed at the end of the +loop. + + The value of / is a list of the most recent values that were printed, +the value of // is the previous value of /, and the value of /// is the +previous value of //. + + The values of /, //, and /// are updated immediately prior to +printing the return value of a top-level form by the Lisp +read-eval-print loop. If the evaluation of such a form is aborted prior +to its normal return, the values of /, //, and /// are not updated. + +Examples:: +.......... + + (floor 22 7) => 3, 1 + (+ (* (car /) 7) (cadr /)) => 22 + +Affected By:: +............. + +Lisp read-eval-print loop. + +See Also:: +.......... + +*note -:: (variable), + (variable), * (variable), *note Top level loop:: + + +File: gcl.info, Node: lisp-implementation-type, Next: short-site-name, Prev: / (Variable), Up: Environment Dictionary + +25.2.24 lisp-implementation-type, +--------------------------------- + +lisp-implementation-version +--------------------------- + + [Function] + + 'lisp-implementation-type' => description + + 'lisp-implementation-version' => description + +Arguments and Values:: +...................... + +description--a string or nil. + +Description:: +............. + +lisp-implementation-type and lisp-implementation-version identify the +current implementation of Common Lisp. + + lisp-implementation-type returns a string that identifies the generic +name of the particular Common Lisp implementation. + + lisp-implementation-version returns a string that identifies the +version of the particular Common Lisp implementation. + + If no appropriate and relevant result can be produced, nil is +returned instead of a string. + +Examples:: +.......... + + (lisp-implementation-type) + => "ACME Lisp" + OR=> "Joe's Common Lisp" + (lisp-implementation-version) + => "1.3a" + => "V2" + OR=> "Release 17.3, ECO #6" + + +File: gcl.info, Node: short-site-name, Next: machine-instance, Prev: lisp-implementation-type, Up: Environment Dictionary + +25.2.25 short-site-name, long-site-name [Function] +-------------------------------------------------- + +'short-site-name' => description + + 'long-site-name' => description + +Arguments and Values:: +...................... + +description--a string or nil. + +Description:: +............. + +short-site-name and long-site-name return a string that identifies the +physical location of the computer hardware, or nil if no appropriate +description can be produced. + +Examples:: +.......... + + (short-site-name) + => "MIT AI Lab" + OR=> "CMU-CSD" + (long-site-name) + => "MIT Artificial Intelligence Laboratory" + OR=> "CMU Computer Science Department" + +Affected By:: +............. + +The implementation, the location of the computer hardware, and the +installation/configuration process. + + +File: gcl.info, Node: machine-instance, Next: machine-type, Prev: short-site-name, Up: Environment Dictionary + +25.2.26 machine-instance [Function] +----------------------------------- + +'machine-instance' => description + +Arguments and Values:: +...................... + +description--a string or nil. + +Description:: +............. + +Returns a string that identifies the particular instance of the computer +hardware on which Common Lisp is running, or nil if no such string can +be computed. + +Examples:: +.......... + + (machine-instance) + => "ACME.COM" + OR=> "S/N 123231" + OR=> "18.26.0.179" + OR=> "AA-00-04-00-A7-A4" + +Affected By:: +............. + +The machine instance, and the implementation. + +See Also:: +.......... + +*note machine-type:: , *note machine-version:: + + +File: gcl.info, Node: machine-type, Next: machine-version, Prev: machine-instance, Up: Environment Dictionary + +25.2.27 machine-type [Function] +------------------------------- + +'machine-type' => description + +Arguments and Values:: +...................... + +description--a string or nil. + +Description:: +............. + +Returns a string that identifies the generic name of the computer +hardware on which Common Lisp is running. + +Examples:: +.......... + + (machine-type) + => "DEC PDP-10" + OR=> "Symbolics LM-2" + +Affected By:: +............. + +The machine type. The implementation. + +See Also:: +.......... + +*note machine-version:: + + +File: gcl.info, Node: machine-version, Next: software-type, Prev: machine-type, Up: Environment Dictionary + +25.2.28 machine-version [Function] +---------------------------------- + +'machine-version' => description + +Arguments and Values:: +...................... + +description--a string or nil. + +Description:: +............. + +Returns a string that identifies the version of the computer hardware on +which Common Lisp is running, or nil if no such value can be computed. + +Examples:: +.......... + + (machine-version) => "KL-10, microcode 9" + +Affected By:: +............. + +The machine version, and the implementation. + +See Also:: +.......... + +*note machine-type:: , *note machine-instance:: + + +File: gcl.info, Node: software-type, Next: user-homedir-pathname, Prev: machine-version, Up: Environment Dictionary + +25.2.29 software-type, software-version [Function] +-------------------------------------------------- + +'software-type' => description + + 'software-version' => description + +Arguments and Values:: +...................... + +description--a string or nil. + +Description:: +............. + +software-type returns a string that identifies the generic name of any +relevant supporting software, or nil if no appropriate or relevant +result can be produced. + + software-version returns a string that identifies the version of any +relevant supporting software, or nil if no appropriate or relevant +result can be produced. + +Examples:: +.......... + + (software-type) => "Multics" + (software-version) => "1.3x" + +Affected By:: +............. + +Operating system environment. + +Notes:: +....... + +This information should be of use to maintainers of the implementation. + + +File: gcl.info, Node: user-homedir-pathname, Prev: software-type, Up: Environment Dictionary + +25.2.30 user-homedir-pathname [Function] +---------------------------------------- + +'user-homedir-pathname' &optional host => pathname + +Arguments and Values:: +...................... + +host--a string, a list of strings, or :unspecific. + + pathname--a pathname, or nil. + +Description:: +............. + +user-homedir-pathname determines the pathname that corresponds to the +user's home directory on host. If host is not supplied, its value is +implementation-dependent. + + For a description of :unspecific, see *note Pathname Components::. + + The definition of home directory is implementation-dependent, but +defined in Common Lisp to mean the directory where the user keeps +personal files such as initialization files and mail. + + user-homedir-pathname returns a pathname without any name, type, or +version component (those components are all nil) for the user's home +directory on host. + + If it is impossible to determine the user's home directory on host, +then nil is returned. user-homedir-pathname never returns nil if host +is not supplied. + +Examples:: +.......... + + (pathnamep (user-homedir-pathname)) => true + +Affected By:: +............. + +The host computer's file system, and the implementation. + + +File: gcl.info, Node: Glossary (Glossary), Next: Appendix, Prev: Environment, Up: Top + +26 Glossary +*********** + +* Menu: + +* Glossary:: + + +File: gcl.info, Node: Glossary, Prev: Glossary (Glossary), Up: Glossary (Glossary) + +26.1 Glossary +============= + +Each entry in this glossary has the following parts: + +* + the term being defined, set in boldface. + +* + optional pronunciation, enclosed in square brackets and set in + boldface, as in the following example: pronounced 'a ,list . The + pronunciation key follows Webster's Third New International + Dictionary the English Language, Unabridged, except that "e" is + used to notate the schwa (upside-down "e") character. + +* + the part or parts of speech, set in italics. If a term can be used + as several parts of speech, there is a separate definition for each + part of speech. + +* + one or more definitions, organized as follows: + + - + an optional number, present if there are several definitions. + Lowercase letters might also be used in cases where + subdefinitions of a numbered definition are necessary. + + - + an optional part of speech, set in italics, present if the + term is one of several parts of speech. + + - + an optional discipline, set in italics, present if the term + has a standard definition being repeated. For example, + "Math." + + - + an optional context, present if this definition is meaningful + only in that context. For example, "(of a symbol)". + + - + the definition. + + - + an optional example sentence. For example, "This is an + example of an example." + + - + optional cross references. + + In addition, some terms have idiomatic usage in the Common Lisp +community which is not shared by other communities, or which is not +technically correct. Definitions labeled "Idiom." represent such +idiomatic usage; these definitions are sometimes followed by an +explanatory note. + + Words in this font are words with entries in the glossary. Words in +example sentences do not follow this convention. + + When an ambiguity arises, the longest matching substring has +precedence. For example, "complex float" refers to a single glossary +entry for "complex float" rather than the combined meaning of the +glossary terms "complex" and "float." + + Subscript notation, as in "something_n" means that the nth definition +of "something" is intended. This notation is used only in situations +where the context might be insufficient to disambiguate. + + The following are abbreviations used in the glossary: + + Abbreviation Meaning +adj. + adjective +adv. + adverb +ANSI + compatible with one or more ANSI standards +Comp. + computers +Idiom. + idiomatic +IEEE + compatible with one or more IEEE standards +ISO + compatible with one or more ISO standards +Math. + mathematics +Trad. + traditional +n. + noun +v. + verb +v.t. + transitive verb + +Non-alphabetic +-------------- + +() + pronounced 'nil , n. an alternative notation for writing the + symbol~nil, used to emphasize the use of nil as an empty list. + +A +- + +absolute + adj. 1. (of a time) representing a specific point in time. 2. + (of a pathname) representing a specific position in a directory + hierarchy. See relative. + +access + n., v.t. 1. v.t. (a place, or array) to read_1 or write_1 the + value of the place or an element of the array. 2. n. (of a + place) an attempt to access_1 the value of the place. + +accessibility + n. the state of being accessible. + +accessible + adj. 1. (of an object) capable of being referenced. 2. (of + shared slots or local slots in an instance of a class) having been + defined by the class of the instance or inherited from a superclass + of that class. 3. (of a symbol in a package) capable of being + referenced without a package prefix when that package is current, + regardless of whether the symbol is present in that package or is + inherited. + +accessor + n. an operator that performs an access. See reader and writer. + +active + adj. 1. (of a handler, a restart, or a catch tag) having been + established but not yet disestablished. 2. (of an element of an + array) having an index that is greater than or equal to zero, but + less than the fill pointer (if any). For an array that has no fill + pointer, all elements are considered active. + +actual adjustability + n. (of an array) a generalized boolean that is associated with the + array, representing whether the array is actually adjustable. See + also expressed adjustability and adjustable-array-p. + +actual argument + n. Trad. an argument. + +actual array element type + n. (of an array) the type for which the array is actually + specialized, which is the upgraded array element type of the + expressed array element type of the array. See the function + array-element-type. + +actual complex part type + n. (of a complex) the type in which the real and imaginary parts + of the complex are actually represented, which is the upgraded + complex part type of the expressed complex part type of the + complex. + +actual parameter + n. Trad. an argument. + +actually adjustable + adj. (of an array) such that adjust-array can adjust its + characteristics by direct modification. A conforming program may + depend on an array being actually adjustable only if either that + array is known to have been expressly adjustable or if that array + has been explicitly tested by adjustable-array-p. + +adjustability + n. (of an array) 1. expressed adjustability. 2. actual + adjustability. + +adjustable + adj. (of an array) 1. expressly adjustable. 2. actually + adjustable. + +after method + n. a method having the qualifier :after. + +alist + pronounced '\=a ,list , n. an association list. + +alphabetic + n., adj. 1. adj. (of a character) being one of the standard + characters A through Z or a through z, or being any + implementation-defined character that has case, or being some other + graphic character defined by the implementation to be alphabetic_1. + 2. a. n. one of several possible constituent traits of a + character. For details, see *note Constituent Characters:: and + *note Reader Algorithm::. b. adj. (of a character) being a + character that has syntax type constituent in the current readtable + and that has the constituent trait alphabetic_{2a}. See + Figure~2-8. + +alphanumeric + adj. (of a character) being either an alphabetic_1 character or a + numeric character. + +ampersand + n. the standard character that is called "ampersand" (&). See + Figure~2-5. + +anonymous + adj. 1. (of a class or function) having no name 2. (of a + restart) having a name of nil. + +apparently uninterned + adj. having a home package of nil. (An apparently uninterned + symbol might or might not be an uninterned symbol. Uninterned + symbols have a home package of nil, but symbols which have been + uninterned from their home package also have a home package of nil, + even though they might still be interned in some other package.) + +applicable + adj. 1. (of a handler) being an applicable handler. 2. (of a + method) being an applicable method. 3. (of a restart) being an + applicable restart. + +applicable handler + n. (for a condition being signaled) an active handler for which + the associated type contains the condition. + +applicable method + n. (of a generic function called with arguments) a method of the + generic function for which the arguments satisfy the parameter + specializers of that method. See *note Selecting the Applicable + Methods::. + +applicable restart + n. 1. (for a condition) an active handler for which the + associated test returns true when given the condition as an + argument. 2. (for no particular condition) an active handler for + which the associated test returns true when given nil as an + argument. + +apply + v.t. (a function to a list) to call the function with arguments + that are the elements of the list. "Applying the function + to a + list of integers returns the sum of the elements of that list." + +argument + n. 1. (of a function) an object which is offered as data to the + function when it is called. + + 2. (of a format control) a format argument. + +argument evaluation order + n. the order in which arguments are evaluated in a function call. + "The argument evaluation order for Common Lisp is left to right." + See *note Evaluation::. + +argument precedence order + n. the order in which the arguments to a generic function are + considered when sorting the applicable methods into precedence + order. + +around method + n. a method having the qualifier :around. + +array + n. an object of type array, which serves as a container for other + objects arranged in a Cartesian coordinate system. + +array element type + n. (of an array) 1. a type associated with the array, and of + which all elements of the array are constrained to be members. 2. + the actual array element type of the array. 3. the expressed + array element type of the array. + +array total size + n. the total number of elements in an array, computed by taking + the product of the dimensions of the array. (The size of a + zero-dimensional array is therefore one.) + +assign + v.t. (a variable) to change the value of the variable in a binding + that has already been established. See the special operator setq. + +association list + n. a list of conses representing an association of keys with + values, where the car of each cons is the key and the cdr is the + value associated with that key. + +asterisk + n. the standard character that is variously called "asterisk" or + "star" (*). See Figure~2-5. + +at-sign + n. the standard character that is variously called "commercial at" + or "at sign" (@). See Figure~2-5. + +atom + n. any object that is not a cons. "A vector is an atom." + +atomic + adj. being an atom. "The number 3, the symbol foo, and nil are + atomic." + +atomic type specifier + n. a type specifier that is atomic. For every atomic type + specifier, x, there is an equivalent compound type specifier with + no arguments supplied, (x). + +attribute + n. (of a character) a program-visible aspect of the character. + The only standardized attribute of a character is its code_2, but + implementations are permitted to have additional + implementation-defined attributes. See *note Character + Attributes::. "An implementation that support fonts might make + font information an attribute of a character, while others might + represent font information separately from characters." + +aux variable + n. a variable that occurs in the part of a lambda list that was + introduced by &aux. Unlike all other variables introduced by a + lambda-list, aux variables are not parameters. + +auxiliary method + n. a member of one of two sets of methods (the set of primary + methods is the other) that form an exhaustive partition of the set + of methods on the method's generic function. How these sets are + determined is dependent on the method combination type; see *note + Introduction to Methods::. + +B +- + +backquote + n. the standard character that is variously called "grave accent" + or "backquote" (`). See Figure~2-5. + +backslash + n. the standard character that is variously called "reverse + solidus" or "backslash" (\). See Figure~2-5. + +base character + n. a character + + of type base-char. + +base string + n. a string of type base-string. + +before method + n. a method having the qualifier :before. + +bidirectional + adj. (of a stream) being both an input stream and an output + stream. + +binary + adj. 1. (of a stream) being a stream that has an element type + that is a subtype of type integer. The most fundamental operation + on a binary input stream is read-byte and on a binary output stream + is write-byte. See character. 2. (of a file) having been created + by opening a binary stream. (It is implementation-dependent + whether this is an detectable aspect of the file, or whether any + given character file can be treated as a binary file.) + +bind + v.t. (a variable) to establish a binding for the variable. + +binding + n. an association between a name and that which the name denotes. + "A lexical binding is a lexical association between a name and its + value." + +bit + n. an object of type bit; that is, the integer 0 or the integer 1. + +bit array + n. a specialized array that is of type (array bit), and whose + elements are of type bit. + +bit vector + n. a specialized vector that is of type bit-vector, and whose + elements are of type bit. + +bit-wise logical operation specifier + n. an object which names one of the sixteen possible bit-wise + logical operations that can be performed by the boole function, and + which is the value of exactly one of the constant variables + boole-clr, boole-set, boole-1, boole-2, boole-c1, boole-c2, + boole-and, boole-ior, boole-xor, boole-eqv, boole-nand, boole-nor, + boole-andc1, boole-andc2, boole-orc1, or boole-orc2. + +block + n. a named lexical exit point, established explicitly by block or + implicitly by operators such as loop, do and prog, to which control + and values may be transfered by using a return-from form with the + name of the block. + +block tag + n. the symbol that, within the lexical scope of a block form, + names the block established by that block form. See return or + return-from. + +boa lambda list + n. a lambda list that is syntactically like an ordinary lambda + list, but that is processed in "by order of argument" style. See + *note Boa Lambda Lists::. + +body parameter + n. a parameter available in certain lambda lists which from the + point of view of conforming programs is like a rest parameter in + every way except that it is introduced by &body instead of &rest. + (Implementations are permitted to provide extensions which + distinguish body parameters and rest parameters--e.g., the forms + for operators which were defined using a body parameter might be + pretty printed slightly differently than forms for operators which + were defined using rest parameters.) + +boolean + n. an object of type boolean; that is, one of the following + objects: the symbol~t (representing true), or the symbol~nil + (representing false). See generalized boolean. + +boolean equivalent + n. (of an object O_1) any object O_2 that has the same truth value + as O_1 when both O_1 and O_2 are viewed as generalized booleans. + +bound + adj., v.t. 1. adj. having an associated denotation in a binding. + "The variables named by a let are bound within its body." See + unbound. 2. adj. having a local binding which shadows_2 another. + "The variable *print-escape* is bound while in the princ function." + 3. v.t. the past tense of bind. + +bound declaration + n. a declaration that refers to or is associated with a variable + or function and that appears within the special form that + establishes the variable or function, but before the body of that + special form (specifically, at the head of that form's body). (If + a bound declaration refers to a function binding or a lexical + variable binding, the scope of the declaration is exactly the scope + of that binding. If the declaration refers to a dynamic variable + binding, the scope of the declaration is what the scope of the + binding would have been if it were lexical rather than dynamic.) + +bounded + adj. (of a sequence S, by an ordered pair of bounding indices + i_{start} and i_{end}) restricted to a subrange of the elements of + S that includes each element beginning with (and including) the one + indexed by i_{start} and continuing up to (but not including) the + one indexed by i_{end}. + +bounding index + n. (of a sequence with length n) either of a conceptual pair of + integers, i_{start} and i_{end}, respectively called the "lower + bounding index" and "upper bounding index", such that 0 <= + i_{start} <= i_{end} <= n, and which therefore delimit a subrange + of the sequence bounded by i_{start} and i_{end}. + +bounding index designator + (for a sequence) one of two objects that, taken together as an + ordered pair, behave as a designator for bounding indices of the + sequence; that is, they denote bounding indices of the sequence, + and are either: an integer (denoting itself) and nil (denoting the + length of the sequence), or two integers (each denoting + themselves). + +break loop + n. A variant of the normal Lisp read-eval-print loop that is + recursively entered, usually because the ongoing evaluation of some + other form has been suspended for the purpose of debugging. Often, + a break loop provides the ability to exit in such a way as to + continue the suspended computation. See the function break. + +broadcast stream + n. an output stream of type broadcast-stream. + +built-in class + n. a class that is a generalized instance of class built-in-class. + +built-in type + n. one of the types in Figure~4-2. + +byte + n. 1. adjacent bits within an integer. (The specific number of + bits can vary from point to point in the program; see the function + byte.) 2. an integer in a specified range. (The specific range + can vary from point to point in the program; see the functions open + and write-byte.) + +byte specifier + n. An object of implementation-dependent nature that is returned + by the function byte and that specifies the range of bits in an + integer to be used as a byte by functions such as ldb. + +C +- + +cadr + pronounced 'ka ,de r , n. (of an object) the car of the cdr of + that object. + +call + v.t., n. 1. v.t. (a function with arguments) to cause the code + represented by that function to be executed in an environment where + bindings for the values of its parameters have been established + based on the arguments. "Calling the function + with the arguments + 5 and 1 yields a value of 6." 2. n. a situation in which a + function is called. + +captured initialization form + n. an initialization form along with the lexical environment in + which the form that defined the initialization form was evaluated. + "Each newly added shared slot is set to the result of evaluating + the captured initialization form for the slot that was specified in + the defclass form for the new class." + +car + n. 1. a. (of a cons) the component of a cons corresponding to + the first argument to cons; the other component is the cdr. "The + function rplaca modifies the car of a cons." b. (of a list) the + first element of the list, or nil if the list is the empty list. + 2. the object that is held in the car_1. "The function car + returns the car of a cons." + +case + n. (of a character) the property of being either uppercase or + lowercase. Not all characters have case. "The characters #\A and + #\a have case, but the character #\$ has no case." See *note + Characters With Case:: and the function both-case-p. + +case sensitivity mode + n. one of the symbols :upcase, :downcase, :preserve, or :invert. + +catch + n. an exit point which is established by a catch form within the + dynamic scope of its body, which is named by a catch tag, and to + which control and values may be thrown. + +catch tag + n. an object which names an active catch. (If more than one catch + is active with the same catch tag, it is only possible to throw to + the innermost such catch because the outer one is shadowed_2.) + +cddr + pronounced 'kud e ,de r or pronounced 'ke ,dude r , n. (of an + object) the cdr of the cdr of that object. + +cdr + pronounced 'ku ,de r , n. 1. a. (of a cons) the component of a + cons corresponding to the second argument to cons; the other + component is the car. "The function rplacd modifies the cdr of a + cons." b. (of a list L_1) either the list L_2 that contains the + elements of L_1 that follow after the first, or else nil if L_1 is + the empty list. 2. the object that is held in the cdr_1. "The + function cdr returns the cdr of a cons." + +cell + n. Trad. (of an object) a conceptual slot of that object. The + dynamic variable and global function bindings of a symbol are + sometimes referred to as its value cell and function cell, + respectively. + +character + n., adj. 1. n. an object of type character; that is, an object + that represents a unitary token in an aggregate quantity of text; + see *note Character Concepts::. 2. adj. a. (of a stream) having + an element type that is a subtype of type character. The most + fundamental operation on a character input stream is read-char and + on a character output stream is write-char. See binary. b. (of a + file) having been created by opening a character stream. (It is + implementation-dependent whether this is an inspectable aspect of + the file, or whether any given binary file can be treated as a + character file.) + +character code + n. 1. one of possibly several attributes of a character. 2. a + non-negative integer less than the value of char-code-limit that is + suitable for use as a character code_1. + +character designator + n. a designator for a character; that is, an object that denotes a + character and that is one of: a designator for a string of length + one (denoting the character that is its only element), + + or a character (denoting itself). + +circular + adj. 1. (of a list) a circular list. 2. (of an arbitrary + object) having a component, element, constituent_2, or + subexpression (as appropriate to the context) that is the object + itself. + +circular list + n. a chain of conses that has no termination because some cons in + the chain is the cdr of a later cons. + +class + n. 1. an object that uniquely determines the structure and + behavior of a set of other objects called its direct instances, + that contributes structure and behavior to a set of other objects + called its indirect instances, and that acts as a type specifier + for a set of objects called its generalized instances. "The class + integer is a subclass of the class number." (Note that the phrase + "the class foo" is often substituted for the more precise phrase + "the class named foo"--in both cases, a class object (not a symbol) + is denoted.) 2. (of an object) the uniquely determined class of + which the object is a direct instance. See the function class-of. + "The class of the object returned by gensym is symbol." (Note that + with this usage a phrase such as "its class is foo" is often + substituted for the more precise phrase "its class is the class + named foo"--in both cases, a class object (not a symbol) is + denoted.) + +class designator + n. a designator for a class; that is, an object that denotes a + class and that is one of: a symbol (denoting the class named by + that symbol; see the function find-class) or a class (denoting + itself). + +class precedence list + n. a unique total ordering on a class and its superclasses that is + consistent with the local precedence orders for the class and its + superclasses. For detailed information, see *note Determining the + Class Precedence List::. + +close + v.t. (a stream) to terminate usage of the stream as a source or + sink of data, permitting the implementation to reclaim its internal + data structures, and to free any external resources which might + have been locked by the stream when it was opened. + +closed + adj. (of a stream) having been closed (see close). Some (but not + all) operations that are valid on open streams are not valid on + closed streams. See *note File Operations on Open and Closed + Streams::. + +closure + n. a lexical closure. + +coalesce + v.t. (literal objects that are similar) to consolidate the + identity of those objects, such that they become the same object. + See *note Compiler Terminology::. + +code + n. 1. Trad. any representation of actions to be performed, + whether conceptual or as an actual object, such as forms, lambda + expressions, objects of type function, text in a source file, or + instruction sequences in a compiled file. This is a generic term; + the specific nature of the representation depends on its context. + 2. (of a character) a character code. + +coerce + v.t. (an object to a type) to produce an object from the given + object, without modifying that object, by following some set of + coercion rules that must be specifically stated for any context in + which this term is used. The resulting object is necessarily of + the indicated type, except when that type is a subtype of type + complex; in that case, if a complex rational with an imaginary part + of zero would result, the result is a rational rather than a + complex--see *note Rule of Canonical Representation for Complex + Rationals::. + +colon + n. the standard character that is called "colon" (:). See + Figure~2-5. + +comma + n. the standard character that is called "comma" (,). See + Figure~2-5. + +compilation + n. the process of compiling code by the compiler. + +compilation environment + n. 1. An environment that represents information known by the + compiler about a form that is being compiled. See *note Compiler + Terminology::. 2. An object that represents the compilation + environment_1 and that is used as a second argument to a macro + function (which supplies a value for any &environment parameter in + the macro function's definition). + +compilation unit + n. an interval during which a single unit of compilation is + occurring. See the macro with-compilation-unit. + +compile + v.t. 1. (code) to perform semantic preprocessing of the code, + usually optimizing one or more qualities of the code, such as + run-time speed of execution or run-time storage usage. The minimum + semantic requirements of compilation are that it must remove all + macro calls and arrange for all load time values to be resolved + prior to run time. 2. (a function) to produce a new object of + type compiled-function which represents the result of compiling the + code represented by the function. See the function compile. 3. + (a source file) to produce a compiled file from a source file. See + the function compile-file. + +compile time + n. the duration of time that the compiler is processing source + code. + +compile-time definition + n. a definition in the compilation environment. + +compiled code + n. 1. compiled functions. 2. code that represents compiled + functions, such as the contents of a compiled file. + +compiled file + n. a file which represents the results of compiling the forms + which appeared in a corresponding source file, and which can be + loaded. See the function compile-file. + +compiled function + n. an object of type compiled-function, which is a function that + has been compiled, which contains no references to macros that must + be expanded at run time, and which contains no unresolved + references to load time values. + +compiler + n. a facility that is part of Lisp and that translates code into + an implementation-dependent form that might be represented or + executed efficiently. The functions compile and compile-file + permit programs to invoke the compiler. + +compiler macro + n. an auxiliary macro definition for a globally defined function + or macro which might or might not be called by any given conforming + implementation and which must preserve the semantics of the + globally defined function or macro but which might perform some + additional optimizations. (Unlike a macro, a compiler macro does + not extend the syntax of Common Lisp; rather, it provides an + alternate implementation strategy for some existing syntax or + functionality.) + +compiler macro expansion + n. 1. the process of translating a form into another form by a + compiler macro. 2. the form resulting from this process. + +compiler macro form + n. a function form or macro form whose operator has a definition + as a compiler macro, or a funcall form whose first argument is a + function form whose argument is the name of a function that has a + definition as a compiler macro. + +compiler macro function + n. a function of two arguments, a form and an environment, that + implements compiler macro expansion by producing either a form to + be used in place of the original argument form or else nil, + indicating that the original form should not be replaced. See + *note Compiler Macros::. + +complex + n. an object of type complex. + +complex float + n. an object of type complex which has a complex part type that is + a subtype of float. A complex float is a complex, but it is not a + float. + +complex part type + n. (of a complex) 1. the type which is used to represent both the + real part and the imaginary part of the complex. 2. the actual + complex part type of the complex. 3. the expressed complex part + type of the complex. + +complex rational + n. an object of type complex which has a complex part type that is + a subtype of rational. A complex rational is a complex, but it is + not a rational. No complex rational has an imaginary part of zero + because such a number is always represented by Common Lisp as an + object of type rational; see *note Rule of Canonical Representation + for Complex Rationals::. + +complex single float + n. an object of type complex which has a complex part type that is + a subtype of single-float. A complex single float is a complex, + but it is not a single float. + +composite stream + n. a stream that is composed of one or more other streams. + "make-synonym-stream creates a composite stream." + +compound form + n. a non-empty list which is a form: a special form, a lambda + form, a macro form, or a function form. + +compound type specifier + n. a type specifier that is a cons; i.e., a type specifier that is + not an atomic type specifier. "(vector single-float) is a compound + type specifier." + +concatenated stream + n. an input stream of type concatenated-stream. + +condition + n. 1. an object which represents a situation--usually, but not + necessarily, during signaling. 2. an object of type condition. + +condition designator + n. one or more objects that, taken together, denote either an + existing condition object or a condition object to be implicitly + created. For details, see *note Condition Designators::. + +condition handler + n. a function that might be invoked by the act of signaling, that + receives the condition being signaled as its only argument, and + that is permitted to handle the condition or to decline. See *note + Signaling::. + +condition reporter + n. a function that describes how a condition is to be printed when + the Lisp printer is invoked while *print-escape* is false. See + *note Printing Conditions::. + +conditional newline + n. a point in output where a newline might be inserted at the + discretion of the pretty printer. There are four kinds of + conditional newlines, called "linear-style," "fill-style," + "miser-style," and "mandatory-style." See the function + pprint-newline and *note Dynamic Control of the Arrangement of + Output::. + +conformance + n. a state achieved by proper and complete adherence to the + requirements of this specification. See *note Conformance::. + +conforming code + n. code that is all of part of a conforming program. + +conforming implementation + n. an implementation, used to emphasize complete and correct + adherance to all conformance criteria. A conforming implementation + is capable of accepting a conforming program as input, preparing + that program for execution, and executing the prepared program in + accordance with this specification. An implementation which has + been extended may still be a conforming implementation provided + that no extension interferes with the correct function of any + conforming program. + +conforming processor + n. ANSI a conforming implementation. + +conforming program + n. a program, used to emphasize the fact that the program depends + for its correctness only upon documented aspects of Common Lisp, + and can therefore be expected to run correctly in any conforming + implementation. + +congruent + n. conforming to the rules of lambda list congruency, as detailed + in *note Congruent Lambda-lists for all Methods of a Generic + Function::. + +cons + n.v. 1. n. a compound data object having two components called + the car and the cdr. 2. v. to create such an object. 3. v. + Idiom. to create any object, or to allocate storage. + +constant + n. 1. a constant form. 2. a constant variable. 3. a constant + object. 4. a self-evaluating object. + +constant form + n. any form for which evaluation always yields the same value, + that neither affects nor is affected by the environment in which it + is evaluated (except that it is permitted to refer to the names of + constant variables defined in the environment), and that neither + affects nor is affected by the state of any object except those + objects that are otherwise inaccessible parts of objects created by + the form itself. "A car form in which the argument is a quote form + is a constant form." + +constant object + n. an object that is constrained (e.g., by its context in a + program or by the source from which it was obtained) to be + immutable. "A literal object that has been processed by + compile-file is a constant object." + +constant variable + n. a variable, the value of which can never change; that is, a + keyword_1 or a named constant. "The symbols t, nil, :direction, + and most-positive-fixnum are constant variables." + +constituent + n., adj. 1. a. n. the syntax type of a character that is part + of a token. For details, see *note Constituent Characters::. b. + adj. (of a character) having the constituent_{1a} syntax type_2. + c. n. a constituent_{1b} character. 2. n. (of a composite + stream) one of possibly several objects that collectively comprise + the source or sink of that stream. + +constituent trait + n. (of a character) one of several classifications of a + constituent character in a readtable. See *note Constituent + Characters::. + +constructed stream + n. a stream whose source or sink is a Lisp object. Note that + since a stream is another Lisp object, composite streams are + considered constructed streams. "A string stream is a constructed + stream." + +contagion + n. a process whereby operations on objects of differing types + (e.g., arithmetic on mixed types of numbers) produce a result whose + type is controlled by the dominance of one argument's type over the + types of the other arguments. See *note Contagion in Numeric + Operations::. + +continuable + n. (of an error) an error that is correctable by the continue + restart. + +control form + n. 1. a form that establishes one or more places to which control + can be transferred. 2. a form that transfers control. + +copy + n. 1. (of a cons C) a fresh cons with the same car and cdr as C. + 2. (of a list L) a fresh list with the same elements as L. (Only + the list structure is fresh; the elements are the same.) See the + function copy-list. 3. (of an association list A with elements + A_i) a fresh list B with elements B_i, each of which is nil if A_i + is nil, or else a copy of the cons A_i. See the function + copy-alist. 4. (of a tree T) a fresh tree with the same leaves as + T. See the function copy-tree. 5. (of a random state R) a fresh + random state that, if used as an argument to to the function random + would produce the same series of "random" values as R would + produce. + + 6. (of a structure S) a fresh structure that has the same type as + S, and that has slot values, each of which is the same as the + corresponding slot value of S. + + (Note that since the difference between a cons, a list, and a tree + is a matter of "view" or "intention," there can be no + general-purpose function which, based solely on the type of an + object, can determine which of these distinct meanings is intended. + The distinction rests solely on the basis of the text description + within this document. For example, phrases like "a copy of the + given list" or "copy of the list x" imply the second definition.) + +correctable + adj. (of an error) 1. (by a restart other than abort that has + been associated with the error) capable of being corrected by + invoking that restart. "The function cerror signals an error that + is correctable by the continue restart." + + (Note that correctability is not a property of an error object, but + rather a property of the dynamic environment that is in effect when + the error is signaled. Specifically, the restart is "associated + with" the error condition object. See *note Associating a Restart + with a Condition::.) + + 2. (when no specific restart is mentioned) correctable_1 by at + least one restart. "import signals a correctable error of type + package-error if any of the imported symbols has the same name as + some distinct symbol already accessible in the package." + +current input base + n. (in a dynamic environment) the radix that is the value of + *read-base* in that environment, and that is the default radix + employed by the Lisp reader and its related functions. + +current logical block + n. the context of the innermost lexically enclosing use of + pprint-logical-block. + +current output base + n. (in a dynamic environment) the radix that is the value of + *print-base* in that environment, and that is the default radix + employed by the Lisp printer and its related functions. + +current package + n. (in a dynamic environment) the package that is the value of + *package* in that environment, and that is the default package + employed by the Lisp reader and Lisp printer, and their related + functions. + +current pprint dispatch table + n. (in a dynamic environment) the pprint dispatch table that is + the value of *print-pprint-dispatch* in that environment, and that + is the default pprint dispatch table employed by the pretty + printer. + +current random state + n. (in a dynamic environment) the random state that is the value + of *random-state* in that environment, and that is the default + random state employed by random. + +current readtable + n. (in a dynamic environment) the readtable that is the value of + *readtable* in that environment, and that affects the way in which + expressions_2 are parsed into objects by the Lisp reader. + +D +- + +data type + n. Trad. a type. + +debug I/O + n. the bidirectional stream that is the value of the variable + *debug-io*. + +debugger + n. a facility that allows the user to handle a condition + interactively. For example, the debugger might permit interactive + selection of a restart from among the active restarts, and it might + perform additional implementation-defined services for the purposes + of debugging. + +declaration + n. a global declaration or local declaration. + +declaration identifier + n. one of the symbols declaration, dynamic-extent, ftype, + function, ignore, inline, notinline, optimize, special, or type; or + a symbol which is the name of a type; or a symbol which has been + declared to be a declaration identifier by using a declaration + declaration. + +declaration specifier + n. an expression that can appear at top level of a declare + expression or a declaim form, or as the argument to proclaim, and + which has a car which is a declaration identifier, and which has a + cdr that is data interpreted according to rules specific to the + declaration identifier. + +declare + v. to establish a declaration. See declare, declaim, or proclaim. + +decline + v. (of a handler) to return normally without having handled the + condition being signaled, permitting the signaling process to + continue as if the handler had not been present. + +decoded time + n. absolute time, represented as an ordered series of nine objects + which, taken together, form a description of a point in calendar + time, accurate to the nearest second (except that leap seconds are + ignored). See *note Decoded Time::. + +default method + n. a method having no parameter specializers other than the class + t. Such a method is always an applicable method but might be + shadowed_2 by a more specific method. + +defaulted initialization argument list + n. a list of alternating initialization argument names and values + in which unsupplied initialization arguments are defaulted, used in + the protocol for initializing and reinitializing instances of + classes. + +define-method-combination arguments lambda list + n. a lambda list used by the :arguments option to + define-method-combination. See *note Define-method-combination + Arguments Lambda Lists::. + +define-modify-macro lambda list + n. a lambda list used by define-modify-macro. See *note + Define-modify-macro Lambda Lists::. + +defined name + n. a symbol the meaning of which is defined by Common Lisp. + +defining form + n. a form that has the side-effect of establishing a definition. + "defun and defparameter are defining forms." + +defsetf lambda list + n. a lambda list that is like an ordinary lambda list except that + it does not permit &aux and that it permits use of &environment. + See *note Defsetf Lambda Lists::. + +deftype lambda list + n. a lambda list that is like a macro lambda list except that the + default value for unsupplied optional parameters and keyword + parameters is the symbol * (rather than nil). See *note Deftype + Lambda Lists::. + +denormalized + adj., ANSI, IEEE (of a float) conforming to the description of + "denormalized" as described by IEEE Standard for Binary + Floating-Point Arithmetic. For example, in an implementation where + the minimum possible exponent was -7 but where 0.001 was a valid + mantissa, the number 1.0e-10 might be representable as 0.001e-7 + internally even if the normalized representation would call for it + to be represented instead as 1.0e-10 or 0.1e-9. By their nature, + denormalized floats generally have less precision than normalized + floats. + +derived type + n. a type specifier which is defined in terms of an expansion into + another type specifier. deftype defines derived types, and there + may be other implementation-defined operators which do so as well. + +derived type specifier + n. a type specifier for a derived type. + +designator + n. an object that denotes another object. In the dictionary entry + for an operator if a parameter is described as a designator for a + type, the description of the operator is written in a way that + assumes that appropriate coercion to that type has already + occurred; that is, that the parameter is already of the denoted + type. For more detailed information, see *note Designators::. + +destructive + adj. (of an operator) capable of modifying some program-visible + aspect of one or more objects that are either explicit arguments to + the operator or that can be obtained directly or indirectly from + the global environment by the operator. + +destructuring lambda list + n. an extended lambda list used in destructuring-bind and nested + within macro lambda lists. See *note Destructuring Lambda Lists::. + +different + adj. not the same "The strings "FOO" and "foo" are different under + equal but not under equalp." + +digit + n. (in a radix) a character that is among the possible digits (0 + to 9, A to Z, and a to z) and that is defined to have an associated + numeric weight as a digit in that radix. See *note Digits in a + Radix::. + +dimension + n. 1. a non-negative integer indicating the number of objects an + array can hold along one axis. If the array is a vector with a + fill pointer, the fill pointer is ignored. "The second dimension + of that array is 7." 2. an axis of an array. "This array has six + dimensions." + +direct instance + n. (of a class C) an object whose class is C itself, rather than + some subclass of C. "The function make-instance always returns a + direct instance of the class which is (or is named by) its first + argument." + +direct subclass + n. (of a class C_1) a class C_2, such that C_1 is a direct + superclass of C_2. + +direct superclass + n. (of a class C_1) a class C_2 which was explicitly designated as + a superclass of C_1 in the definition of C_1. + +disestablish + v.t. to withdraw the establishment of an object, a binding, an + exit point, a tag, a handler, a restart, or an environment. + +disjoint + n. (of types) having no elements in common. + +dispatching macro character + n. a macro character that has an associated table that specifies + the function to be called for each character that is seen following + the dispatching macro character. See the function + make-dispatch-macro-character. + +displaced array + n. an array which has no storage of its own, but which is instead + indirected to the storage of another array, called its target, at a + specified offset, in such a way that any attempt to access the + displaced array implicitly references the target array. + +distinct + adj. not identical. + +documentation string + n. (in a defining form) A literal string which because of the + context in which it appears (rather than because of some + intrinsically observable aspect of the string) is taken as + documentation. In some cases, the documentation string is saved in + such a way that it can later be obtained by supplying either an + object, or by supplying a name and a "kind" to the function + documentation. "The body of code in a defmacro form can be + preceded by a documentation string of kind function." + +dot + n. the standard character that is variously called "full stop," + "period," or "dot" (.). See Figure~2-5. + +dotted list + n. a list which has a terminating atom that is not nil. (An atom + by itself is not a dotted list, however.) + +dotted pair + n. 1. a cons whose cdr is a non-list. 2. any cons, used to + emphasize the use of the cons as a symmetric data pair. + +double float + n. an object of type double-float. + +double-quote + n. the standard character that is variously called "quotation + mark" or "double quote" ("). See Figure~2-5. + +dynamic binding + n. a binding in a dynamic environment. + +dynamic environment + n. that part of an environment that contains bindings with dynamic + extent. A dynamic environment contains, among other things: exit + points established by unwind-protect, and bindings of dynamic + variables, exit points established by catch, condition handlers, + and restarts. + +dynamic extent + n. an extent whose duration is bounded by points of establishment + and disestablishment within the execution of a particular form. + See indefinite extent. "Dynamic variable bindings have dynamic + extent." + +dynamic scope + n. indefinite scope along with dynamic extent. + +dynamic variable + n. a variable the binding for which is in the dynamic environment. + See special. + +E +- + +echo stream + n. a stream of type echo-stream. + +effective method + n. the combination of applicable methods that are executed when a + generic function is invoked with a particular sequence of + arguments. + +element + n. 1. (of a list) an object that is the car of one of the conses + that comprise the list. 2. (of an array) an object that is stored + in the array. 3. (of a sequence) an object that is an element of + the list or array that is the sequence. 4. (of a type) an object + that is a member of the set of objects designated by the type. 5. + (of an input stream) a character or number (as appropriate to the + element type of the stream) that is among the ordered series of + objects that can be read from the stream (using read-char or + read-byte, as appropriate to the stream). 6. (of an output + stream) a character or number (as appropriate to the element type + of the stream) that is among the ordered series of objects that has + been or will be written to the stream (using write-char or + write-byte, as appropriate to the stream). 7. (of a class) a + generalized instance of the class. + +element type + n. 1. (of an array) the array element type of the array. 2. (of + a stream) the stream element type of the stream. + +em + n. Trad. a context-dependent unit of measure commonly used in + typesetting, equal to the displayed width of of a letter "M" in the + current font. (The letter "M" is traditionally chosen because it + is typically represented by the widest glyph in the font, and other + characters' widths are typically fractions of an em. In + implementations providing non-Roman characters with wider + characters than "M," it is permissible for another character to be + the implementation-defined reference character for this measure, + and for "M" to be only a fraction of an em wide.) In a fixed width + font, a line with n characters is n ems wide; in a variable width + font, n ems is the expected upper bound on the width of such a + line. + +empty list + n. the list containing no elements. See (). + +empty type + n. the type that contains no elements, and that is a subtype of + all types (including itself). See nil. + +end of file + n. 1. the point in an input stream beyond which there is no + further data. Whether or not there is such a point on an + interactive stream is implementation-defined. 2. a situation that + occurs upon an attempt to obtain data from an input stream that is + at the end of file_1. + +environment + n. 1. a set of bindings. See *note Introduction to + Environments::. 2. an environment object. "macroexpand takes an + optional environment argument." + +environment object + n. an object representing a set of lexical bindings, used in the + processing of a form to provide meanings for names within that + form. "macroexpand takes an optional environment argument." (The + object nil when used as an environment object denotes the null + lexical environment; the values of environment parameters to macro + functions are objects of implementation-dependent nature which + represent the environment_1 in which the corresponding macro form + is to be expanded.) See *note Environment Objects::. + +environment parameter + n. A parameter in a defining form f for which there is no + corresponding argument; instead, this parameter receives as its + value an environment object which corresponds to the lexical + environment in which the defining form f appeared. + +error + n. 1. (only in the phrase "is an error") a situation in which the + semantics of a program are not specified, and in which the + consequences are undefined. 2. a condition which represents an + error situation. See *note Error Terminology::. 3. an object of + type error. + +error output + n. the output stream which is the value of the dynamic variable + *error-output*. + +escape + n., adj. 1. n. a single escape or a multiple escape. 2. adj. + single escape or multiple escape. + +establish + v.t. to build or bring into being a binding, a declaration, an + exit point, a tag, a handler, a restart, or an environment. "let + establishes lexical bindings." + +evaluate + v.t. (a form or an implicit progn) to execute the code represented + by the form (or the series of forms making up the implicit progn) + by applying the rules of evaluation, returning zero or more values. + +evaluation + n. a model whereby forms are executed, returning zero or more + values. Such execution might be implemented directly in one step + by an interpreter or in two steps by first compiling the form and + then executing the compiled code; this choice is dependent both on + context and the nature of the implementation, but in any case is + not in general detectable by any program. The evaluation model is + designed in such a way that a conforming implementation might + legitimately have only a compiler and no interpreter, or vice + versa. See *note The Evaluation Model::. + +evaluation environment + n. a run-time environment in which macro expanders and code + specified by eval-when to be evaluated are evaluated. All + evaluations initiated by the compiler take place in the evaluation + environment. + +execute + v.t. Trad. (code) to perform the imperative actions represented + by the code. + +execution time + n. the duration of time that compiled code is being executed. + +exhaustive partition + n. (of a type) a set of pairwise disjoint types that form an + exhaustive union. + +exhaustive union + n. (of a type) a set of subtypes of the type, whose union contains + all elements of that type. + +exit point + n. a point in a control form from which (e.g., block), through + which (e.g., unwind-protect), or to which (e.g., tagbody) control + and possibly values can be transferred both actively by using + another control form and passively through the normal control and + data flow of evaluation. "catch and block establish bindings for + exit points to which throw and return-from, respectively, can + transfer control and values; tagbody establishes a binding for an + exit point with lexical extent to which go can transfer control; + and unwind-protect establishes an exit point through which control + might be transferred by operators such as throw, return-from, and + go." + +explicit return + n. the act of transferring control (and possibly values) to a + block by using return-from (or return). + +explicit use + n. (of a variable V in a form F) a reference to V that is directly + apparent in the normal semantics of F; i.e., that does not expose + any undocumented details of the macro expansion of the form itself. + References to V exposed by expanding subforms of F are, however, + considered to be explicit uses of V. + +exponent marker + n. a character that is used in the textual notation for a float to + separate the mantissa from the exponent. The characters defined as + exponent markers in the standard readtable are shown in Figure + 26-1. For more information, see *note Character Syntax::. "The + exponent marker 'd' in '3.0d7' indicates that this number is to be + represented as a double float." + + Marker Meaning + D or d double-float + E or e float (see *read-default-float-format*) + F or f single-float + L or l long-float + S or s short-float + + Figure 26-1: Exponent Markers + + +export + v.t. (a symbol in a package) to add the symbol to the list of + external symbols of the package. + +exported + adj. (of a symbol in a package) being an external symbol of the + package. + +expressed adjustability + n. (of an array) a generalized boolean that is conceptually (but + not necessarily actually) associated with the array, representing + whether the array is expressly adjustable. See also actual + adjustability. + +expressed array element type + n. (of an array) the type which is the array element type implied + by a type declaration for the array, or which is the requested + array element type at its time of creation, prior to any selection + of an upgraded array element type. (Common Lisp does not provide a + way of detecting this type directly at run time, but an + implementation is permitted to make assumptions about the array's + contents and the operations which may be performed on the array + when this type is noted during code analysis, even if those + assumptions would not be valid in general for the upgraded array + element type of the expressed array element type.) + +expressed complex part type + n. (of a complex) the type which is implied as the complex part + type by a type declaration for the complex, or which is the + requested complex part type at its time of creation, prior to any + selection of an upgraded complex part type. (Common Lisp does not + provide a way of detecting this type directly at run time, but an + implementation is permitted to make assumptions about the + operations which may be performed on the complex when this type is + noted during code analysis, even if those assumptions would not be + valid in general for the upgraded complex part type of the + expressed complex part type.) + +expression + n. 1. an object, often used to emphasize the use of the object to + encode or represent information in a specialized format, such as + program text. "The second expression in a let form is a list of + bindings." 2. the textual notation used to notate an object in a + source file. "The expression 'sample is equivalent to (quote + sample)." + +expressly adjustable + adj. (of an array) being actually adjustable by virtue of an + explicit request for this characteristic having been made at the + time of its creation. All arrays that are expressly adjustable are + actually adjustable, but not necessarily vice versa. + +extended character + n. a character + + of type extended-char: + + a character that is not a base character. + +extended function designator + n. a designator for a function; that is, an object that denotes a + function and that is one of: a function name (denoting the function + it names in the global environment), or a function (denoting + itself). The consequences are undefined if a function name is used + as an extended function designator but it does not have a global + definition as a function, or if it is a symbol that has a global + definition as a macro or a special form. See also function + designator. + +extended lambda list + n. a list resembling an ordinary lambda list in form and purpose, + but offering additional syntax or functionality not available in an + ordinary lambda list. "defmacro uses extended lambda lists." + +extension + n. a facility in an implementation of Common Lisp that is not + specified by this standard. + +extent + n. the interval of time during which a reference to an object, a + binding, an exit point, a tag, a handler, a restart, or an + environment is defined. + +external file format + n. an object of implementation-dependent nature which determines + one of possibly several implementation-dependent ways in which + characters are encoded externally in a character file. + +external file format designator + n. a designator for an external file format; that is, an object + that denotes an external file format and that is one of: the symbol + :default (denoting an implementation-dependent default external + file format that can accomodate at least the base characters), some + other object defined by the implementation to be an external file + format designator (denoting an implementation-defined external file + format), or some other object defined by the implementation to be + an external file format (denoting itself). + +external symbol + n. (of a package) a symbol that is part of the 'external + interface' to the package and that are inherited_3 by any other + package that uses the package. When using the Lisp reader, if a + package prefix is used, the name of an external symbol is separated + from the package name by a single package marker while the name of + an internal symbol is separated from the package name by a double + package marker; see *note Symbols as Tokens::. + +externalizable object + n. an object that can be used as a literal object in code to be + processed by the file compiler. + +F +- + +false + n. the symbol nil, used to represent the failure of a predicate + test. + +fbound + pronounced 'ef ,baund adj. (of a function name) bound in the + function namespace. (The names of macros and special operators are + fbound, but the nature and type of the object which is their value + is implementation-dependent. + + Further, defining a setf expander F does not cause the setf + function (setf F) to become defined; as such, if there is a such a + definition of a setf expander F, the function (setf F) can be + fbound if and only if, by design or coincidence, a function binding + for (setf F) has been independently established.) + + See the functions fboundp and symbol-function. + +feature + n. 1. an aspect or attribute of Common Lisp, of the + implementation, or of the environment. 2. a symbol that names a + feature_1. See *note Features::. "The :ansi-cl feature is present + in all conforming implementations." + +feature expression + n. A boolean combination of features used by the #+ and #- reader + macros in order to direct conditional reading of expressions by the + Lisp reader. See *note Feature Expressions::. + +features list + n. the list that is the value of *features*. + +file + n. a named entry in a file system, having an + implementation-defined nature. + +file compiler + n. any compiler which compiles source code contained in a file, + producing a compiled file as output. The compile-file function is + the only interface to such a compiler provided by Common Lisp, but + there might be other, implementation-defined mechanisms for + invoking the file compiler. + +file position + n. (in a stream) a non-negative integer that represents a position + in the stream. Not all streams are able to represent the notion of + file position; in the description of any operator which manipulates + file positions, the behavior for streams that don't have this + notion must be explicitly stated. For binary streams, the file + position represents the number of preceding bytes in the stream. + For character streams, the constraint is more relaxed: file + positions must increase monotonically, the amount of the increase + between file positions corresponding to any two successive + characters in the stream is implementation-dependent. + +file position designator + n. (in a stream) a designator for a file position in that stream; + that is, the symbol :start (denoting 0, the first file position in + that stream), the symbol :end (denoting the last file position in + that stream; i.e., the position following the last element of the + stream), or a file position (denoting itself). + +file stream + n. an object of type file-stream. + +file system + n. a facility which permits aggregations of data to be stored in + named files on some medium that is external to the Lisp image and + that therefore persists from session to session. + +filename + n. a handle, not necessarily ever directly represented as an + object, that can be used to refer to a file in a file system. + Pathnames and namestrings are two kinds of objects that substitute + for filenames in Common Lisp. + +fill pointer + n. (of a vector) an integer associated with a vector that + represents the index above which no elements are active. (A fill + pointer is a non-negative integer no larger than the total number + of elements in the vector. Not all vectors have fill pointers.) + +finite + adj. (of a type) having a finite number of elements. "The type + specifier (integer 0 5) denotes a finite type, but the type + specifiers integer and (integer 0) do not." + +fixnum + n. an integer of type fixnum. + +float + n. an object of type float. + +for-value + adj. (of a reference to a binding) being a reference that reads_1 + the value of the binding. + +form + n. 1. any object meant to be evaluated. 2. a symbol, a compound + form, or a self-evaluating object. 3. (for an operator, as in + "<> form") a compound form having that operator as its + first element. "A quote form is a constant form." + +formal argument + n. Trad. a parameter. + +formal parameter + n. Trad. a parameter. + +format + v.t. (a format control and format arguments) to perform output as + if by format, using the format string and format arguments. + +format argument + n. an object which is used as data by functions such as format + which interpret format controls. + +format control + n. a format string, or a function that obeys the argument + conventions for a function returned by the formatter macro. See + *note Compiling Format Strings::. + +format directive + n. 1. a sequence of characters in a format string which is + introduced by a tilde, and which is specially interpreted by code + which processes format strings to mean that some special operation + should be performed, possibly involving data supplied by the format + arguments that accompanied the format string. See the function + format. "In "~D base 10 = ~8R", the character sequences '~D' and + '~8R' are format directives." 2. the conceptual category of all + format directives_1 which use the same dispatch character. "Both + "~3d" and "~3,'0D" are valid uses of the '~D' format directive." + +format string + n. a string which can contain both ordinary text and format + directives, and which is used in conjunction with format arguments + to describe how text output should be formatted by certain + functions, such as format. + +free declaration + n. a declaration that is not a bound declaration. See declare. + +fresh + adj. 1. (of an object yielded by a function) having been + newly-allocated by that function. (The caller of a function that + returns a fresh object may freely modify the object without fear + that such modification will compromise the future correct behavior + of that function.) 2. (of a binding for a name) newly-allocated; + not shared with other bindings for that name. + +freshline + n. a conceptual operation on a stream, implemented by the function + fresh-line and by the format directive ~&, which advances the + display position to the beginning of the next line (as if a newline + had been typed, or the function terpri had been called) unless the + stream is already known to be positioned at the beginning of a + line. Unlike newline, freshline is not a character. + +funbound + pronounced 'ef unbaund n. (of a function name) not fbound. + +function + n. + + 1. an object representing code, which can be called with zero or + more arguments, and which produces zero or more values. 2. an + object of type function. + +function block name + n. (of a function name) The symbol that would be used as the name + of an implicit block which surrounds the body of a function having + that function name. If the function name is a symbol, its function + block name is the function name itself. If the function name is a + list whose car is setf and whose cadr is a symbol, its function + block name is the symbol that is the cadr of the function name. An + implementation which supports additional kinds of function names + must specify for each how the corresponding function block name is + computed. + +function cell + n. Trad. (of a symbol) The place which holds the definition of + the global function binding, if any, named by that symbol, and + which is accessed by symbol-function. See cell. + +function designator + n. a designator for a function; that is, an object that denotes a + function and that is one of: a symbol (denoting the function named + by that symbol in the global environment), or a function (denoting + itself). The consequences are undefined if a symbol is used as a + function designator but it does not have a global definition as a + function, or it has a global definition as a macro or a special + form. See also extended function designator. + +function form + n. a form that is a list and that has a first element which is the + name of a function to be called on arguments which are the result + of evaluating subsequent elements of the function form. + +function name + n. (in an environment) A symbol or a list (setf symbol) that is + the name of a function in that environment. + +functional evaluation + n. the process of extracting a functional value from a function + name or a lambda expression. The evaluator performs functional + evaluation implicitly when it encounters a function name or a + lambda expression in the car of a compound form, or explicitly when + it encounters a function special form. Neither a use of a symbol + as a function designator nor a use of the function symbol-function + to extract the functional value of a symbol is considered a + functional evaluation. + +functional value + n. 1. (of a function name N in an environment E) The value of the + binding named N in the function namespace for environment E; that + is, the contents of the function cell named N in environment E. 2. + (of an fbound symbol S) the contents of the symbol's function cell; + that is, the value of the binding named S in the function namespace + of the global environment. (A name that is a macro name in the + global environment or is a special operator might or might not be + fbound. But if S is such a name and is fbound, the specific nature + of its functional value is implementation-dependent; in particular, + it might or might not be a function.) + +further compilation + n. implementation-dependent compilation beyond minimal + compilation. Further compilation is permitted to take place at run + time. "Block compilation and generation of machine-specific + instructions are examples of further compilation." + +G +- + +general + adj. (of an array) having element type t, and consequently able to + have any object as an element. + +generalized boolean + n. an object used as a truth value, where the symbol~nil + represents false and all other objects represent true. See + boolean. + +generalized instance + n. (of a class) an object the class of which is either that class + itself, or some subclass of that class. (Because of the + correspondence between types and classes, the term "generalized + instance of X" implies "object of type X" and in cases where X is a + class (or class name) the reverse is also true. The former + terminology emphasizes the view of X as a class while the latter + emphasizes the view of X as a type specifier.) + +generalized reference + n. a reference to a location storing an object as if to a + variable. (Such a reference can be either to read or write the + location.) See *note Generalized Reference::. See also place. + +generalized synonym stream + n. (with a synonym stream symbol) 1. (to a stream) a synonym + stream to the stream, or a composite stream which has as a target a + generalized synonym stream to the stream. 2. (to a symbol) a + synonym stream to the symbol, or a composite stream which has as a + target a generalized synonym stream to the symbol. + +generic function + n. a function whose behavior depends on the classes or identities + of the arguments supplied to it and whose parts include, among + other things, a set of methods, a lambda list, and a method + combination type. + +generic function lambda list + n. A lambda list that is used to describe data flow into a generic + function. See *note Generic Function Lambda Lists::. + +gensym + n. Trad. an uninterned symbol. See the function gensym. + +global declaration + n. a form that makes certain kinds of information about code + globally available; that is, a proclaim form or a declaim form. + +global environment + n. that part of an environment that contains bindings with + indefinite scope and indefinite extent. + +global variable + n. a dynamic variable or a constant variable. + +glyph + n. a visual representation. "Graphic characters have associated + glyphs." + +go + v. to transfer control to a go point. See the special operator + go. + +go point + + one of possibly several exit points that are established by tagbody + (or other abstractions, such as prog, which are built from + tagbody). + +go tag + n. the symbol or integer that, within the lexical scope of a + tagbody form, names an exit point established by that tagbody form. + +graphic + adj. (of a character) being a "printing" or "displayable" + character that has a standard visual representation as a single + glyph, such as A or * or =. Space is defined to be graphic. Of + the standard characters, all but newline are graphic. See + non-graphic. + +H +- + +handle + v. (of a condition being signaled) to perform a non-local transfer + of control, terminating the ongoing signaling of the condition. + +handler + n. + + a condition handler. + +hash table + n. an object of type hash-table, which provides a mapping from + keys to values. + +home package + n. (of a symbol) the package, if any, which is contents of the + package cell of the symbol, and which dictates how the Lisp printer + prints the symbol when it is not accessible in the current package. + (Symbols which have nil in their package cell are said to have no + home package, and also to be apparently uninterned.) + +I +- + +I/O customization variable + n. one of the stream variables in Figure 26-2, or some other + (implementation-defined) stream variable that is defined by the + implementation to be an I/O customization variable. + + *debug-io* *error-io* query-io* + *standard-input* *standard-output* *trace-output* + + Figure 26-2: Standardized I/O Customization Variables + + +identical + adj. the same under eq. + +identifier + n. 1. a symbol used to identify or to distinguish names. 2. a + string used the same way. + +immutable + adj. not subject to change, either because no operator is provided + which is capable of effecting such change or because some + constraint exists which prohibits the use of an operator that might + otherwise be capable of effecting such a change. Except as + explicitly indicated otherwise, implementations are not required to + detect attempts to modify immutable objects or cells; the + consequences of attempting to make such modification are undefined. + "Numbers are immutable." + +implementation + n. a system, mechanism, or body of code that implements the + semantics of Common Lisp. + +implementation limit + n. a restriction imposed by an implementation. + +implementation-defined + adj. implementation-dependent, but required by this specification + to be defined by each conforming implementation and to be + documented by the corresponding implementor. + +implementation-dependent + adj. describing a behavior or aspect of Common Lisp which has been + deliberately left unspecified, that might be defined in some + conforming implementations but not in others, and whose details may + differ between implementations. A conforming implementation is + encouraged (but not required) to document its treatment of each + item in this specification which is marked + implementation-dependent, although in some cases such documentation + might simply identify the item as "undefined." + +implementation-independent + adj. used to identify or emphasize a behavior or aspect of Common + Lisp which does not vary between conforming implementations. + +implicit block + n. a block introduced by a macro form rather than by an explicit + block form. + +implicit compilation + n. compilation performed during evaluation. + +implicit progn + n. an ordered set of adjacent forms appearing in another form, and + defined by their context in that form to be executed as if within a + progn. + +implicit tagbody + n. an ordered set of adjacent forms and/or tags appearing in + another form, and defined by their context in that form to be + executed as if within a tagbody. + +import + v.t. (a symbol into a package) to make the symbol be present in + the package. + +improper list + n. a list which is not a proper list: a circular list or a dotted + list. + +inaccessible + adj. not accessible. + +indefinite extent + n. an extent whose duration is unlimited. "Most Common Lisp + objects have indefinite extent." + +indefinite scope + n. scope that is unlimited. + +indicator + n. a property indicator. + +indirect instance + n. (of a class C_1) an object of class C_2, where C_2 is a + subclass of C_1. "An integer is an indirect instance of the class + number." + +inherit + v.t. 1. to receive or acquire a quality, trait, or + characteristic; to gain access to a feature defined elsewhere. 2. + (a class) to acquire the structure and behavior defined by a + superclass. 3. (a package) to make symbols exported by another + package accessible by using use-package. + +initial pprint dispatch table + n. the value of *print-pprint-dispatch* at the time the Lisp image + is started. + +initial readtable + n. the value of *readtable* at the time the Lisp image is started. + +initialization argument list + n. a property list of initialization argument names and values + used in the protocol for initializing and reinitializing instances + of classes. See *note Object Creation and Initialization::. + +initialization form + n. a form used to supply the initial value for a slot or variable. + "The initialization form for a slot in a defclass form is + introduced by the keyword :initform." + +input + adj. (of a stream) supporting input operations (i.e., being a + "data source"). An input stream might also be an output stream, in + which case it is sometimes called a bidirectional stream. See the + function input-stream-p. + +instance + n. 1. a direct instance. 2. a generalized instance. 3. an + indirect instance. + +integer + n. an object of type integer, which represents a mathematical + integer. + +interactive stream + n. a stream on which it makes sense to perform interactive + querying. See *note Interactive Streams::. + +intern + v.t. 1. (a string in a package) to look up the string in the + package, returning either a symbol with that name which was already + accessible in the package or a newly created internal symbol of the + package with that name. 2. Idiom. generally, to observe a + protocol whereby objects which are equivalent or have equivalent + names under some predicate defined by the protocol are mapped to a + single canonical object. + +internal symbol + n. (of a package) a symbol which is accessible in the package, but + which is not an external symbol of the package. + +internal time + n. time, represented as an integer number of internal time units. + Absolute internal time is measured as an offset from an arbitrarily + chosen, implementation-dependent base. See *note Internal Time::. + +internal time unit + n. a unit of time equal to 1/n of a second, for some + implementation-defined integer value of n. See the variable + internal-time-units-per-second. + +interned + adj. Trad. 1. (of a symbol) accessible_3 in any package. 2. + (of a symbol in a specific package) present in that package. + +interpreted function + n. a function that is not a compiled function. (It is possible + for there to be a conforming implementation which has no + interpreted functions, but a conforming program must not assume + that all functions are compiled functions.) + +interpreted implementation + n. an implementation that uses an execution strategy for + interpreted functions that does not involve a one-time semantic + analysis pre-pass, and instead uses "lazy" (and sometimes + repetitious) semantic analysis of forms as they are encountered + during execution. + +interval designator + n. (of type T) an ordered pair of objects that describe a subtype + of T by delimiting an interval on the real number line. See *note + Interval Designators::. + +invalid + n., adj. 1. n. a possible constituent trait of a character which + if present signifies that the character cannot ever appear in a + token except under the control of a single escape character. For + details, see *note Constituent Characters::. 2. adj. (of a + character) being a character that has syntax type constituent in + the current readtable and that has the constituent trait invalid_1. + See Figure~2-8. + +iteration form + n. a compound form whose operator is named in Figure 26-3, or a + compound form that has an implementation-defined operator and that + is defined by the implementation to be an iteration form. + + do do-external-symbols dotimes + do* do-symbols loop + do-all-symbols dolist + + Figure 26-3: Standardized Iteration Forms + + +iteration variable + n. a variable V, the binding for which was created by an explicit + use of V in an iteration form. + +K +- + +key + n. an object used for selection during retrieval. See association + list, property list, and hash table. Also, see *note Sequence + Concepts::. + +keyword + n. 1. a symbol the home package of which is the KEYWORD package. + 2. any symbol, usually but not necessarily in the KEYWORD package, + that is used as an identifying marker in keyword-style argument + passing. See lambda. 3. Idiom. a lambda list keyword. + +keyword parameter + n. A parameter for which a corresponding keyword argument is + optional. (There is no such thing as a required keyword argument.) + If the argument is not supplied, a default value is used. See also + supplied-p parameter. + +keyword/value pair + n. two successive elements (a keyword and a value, respectively) + of a property list. + +L +- + +lambda combination + n. Trad. a lambda form. + +lambda expression + n. a list which can be used in place of a function name in certain + contexts to denote a function by directly describing its behavior + rather than indirectly by referring to the name of an established + function; its name derives from the fact that its first element is + the symbol lambda. See lambda. + +lambda form + n. a form that is a list and that has a first element which is a + lambda expression representing a function to be called on arguments + which are the result of evaluating subsequent elements of the + lambda form. + +lambda list + n. a list that specifies a set of parameters (sometimes called + lambda variables) and a protocol for receiving values for those + parameters; that is, an ordinary lambda list, an extended lambda + list, or a modified lambda list. + +lambda list keyword + n. a symbol whose name begins with ampersand and that is specially + recognized in a lambda list. Note that no standardized lambda list + keyword is in the KEYWORD package. + +lambda variable + n. a formal parameter, used to emphasize the variable's relation + to the lambda list that established it. + +leaf + n. 1. an atom in a tree_1. 2. a terminal node of a tree_2. + +leap seconds + n. additional one-second intervals of time that are occasionally + inserted into the true calendar by official timekeepers as a + correction similar to "leap years." All Common Lisp time + representations ignore leap seconds; every day is assumed to be + exactly 86400 seconds long. + +left-parenthesis + n. the standard character "(", that is variously called "left + parenthesis" or "open parenthesis" See Figure~2-5. + +length + n. (of a sequence) the number of elements in the sequence. (Note + that if the sequence is a vector with a fill pointer, its length is + the same as the fill pointer even though the total allocated size + of the vector might be larger.) + +lexical binding + n. a binding in a lexical environment. + +lexical closure + n. a function that, when invoked on arguments, executes the body + of a lambda expression in the lexical environment that was captured + at the time of the creation of the lexical closure, augmented by + bindings of the function's parameters to the corresponding + arguments. + +lexical environment + n. that part of the environment that contains bindings whose names + have lexical scope. A lexical environment contains, among other + things: ordinary bindings of variable names to values, lexically + established bindings of function names to functions, macros, symbol + macros, blocks, tags, and local declarations (see declare). + +lexical scope + n. scope that is limited to a spatial or textual region within the + establishing form. "The names of parameters to a function normally + are lexically scoped." + +lexical variable + n. a variable the binding for which is in the lexical environment. + +Lisp image + n. a running instantiation of a Common Lisp implementation. A + Lisp image is characterized by a single address space in which any + object can directly refer to any another in conformance with this + specification, and by a single, common, global environment. + (External operating systems sometimes call this a "core image," + "fork," "incarnation," "job," or "process." Note however, that the + issue of a "process" in such an operating system is technically + orthogonal to the issue of a Lisp image being defined here. + Depending on the operating system, a single "process" might have + multiple Lisp images, and multiple "processes" might reside in a + single Lisp image. Hence, it is the idea of a fully shared address + space for direct reference among all objects which is the defining + characteristic. Note, too, that two "processes" which have a + communication area that permits the sharing of some but not all + objects are considered to be distinct Lisp images.) + +Lisp printer + n. Trad. the procedure that prints the character representation + of an object onto a stream. (This procedure is implemented by the + function write.) + +Lisp read-eval-print loop + n. Trad. an endless loop that reads_2 a form, evaluates it, and + prints (i.e., writes_2) the results. In many implementations, the + default mode of interaction with Common Lisp during program + development is through such a loop. + +Lisp reader + n. Trad. the procedure that parses character representations of + objects from a stream, producing objects. (This procedure is + implemented by the function read.) + +list + n. 1. a chain of conses in which the car of each cons is an + element of the list, and the cdr of each cons is either the next + link in the chain or a terminating atom. See also proper list, + dotted list, or circular list. 2. the type that is the union of + null and cons. + +list designator + n. a designator for a list of objects; that is, an object that + denotes a list and that is one of: a non-nil atom (denoting a + singleton list whose element is that non-nil atom) or a proper list + (denoting itself). + +list structure + n. (of a list) the set of conses that make up the list. Note that + while the car_{1b} component of each such cons is part of the list + structure, the objects that are elements of the list (i.e., the + objects that are the cars_2 of each cons in the list) are not + themselves part of its list structure, even if they are conses, + except in the (circular_2) case where the list actually contains + one of its tails as an element. (The list structure of a list is + sometimes redundantly referred to as its "top-level list structure" + in order to emphasize that any conses that are elements of the list + are not involved.) + +literal + adj. (of an object) referenced directly in a program rather than + being computed by the program; that is, appearing as data in a + quote form, or, if the object is a self-evaluating object, + appearing as unquoted data. "In the form (cons "one" '("two")), + the expressions "one", ("two"), and "two" are literal objects." + +load + v.t. (a file) to cause the code contained in the file to be + executed. See the function load. + +load time + n. the duration of time that the loader is loading compiled code. + +load time value + n. an object referred to in code by a load-time-value form. The + value of such a form is some specific object which can only be + computed in the run-time environment. In the case of file + compilation, the value is computed once as part of the process of + loading the compiled file, and not again. See the special operator + load-time-value. + +loader + n. a facility that is part of Lisp and that loads a file. See the + function load. + +local declaration + n. an expression which may appear only in specially designated + positions of certain forms, and which provides information about + the code contained within the containing form; that is, a declare + expression. + +local precedence order + n. (of a class) a list consisting of the class followed by its + direct superclasses in the order mentioned in the defining form for + the class. + +local slot + n. (of a class) a slot accessible in only one instance, namely the + instance in which the slot is allocated. + +logical block + n. a conceptual grouping of related output used by the pretty + printer. See the macro pprint-logical-block and *note Dynamic + Control of the Arrangement of Output::. + +logical host + n. an object of implementation-dependent nature that is used as + the representation of a "host" in a logical pathname, and that has + an associated set of translation rules for converting logical + pathnames belonging to that host into physical pathnames. See + *note Logical Pathnames::. + +logical host designator + n. a designator for a logical host; that is, an object that + denotes a logical host and that is one of: a string (denoting the + logical host that it names), or a logical host (denoting itself). + (Note that because the representation of a logical host is + implementation-dependent, it is possible that an implementation + might represent a logical host as the string that names it.) + +logical pathname + n. an object of type logical-pathname. + +long float + n. an object of type long-float. + +loop keyword + n. Trad. a symbol that is a specially recognized part of the + syntax of an extended loop form. Such symbols are recognized by + their name (using string=), not by their identity; as such, they + may be in any package. A loop keyword is not a keyword. + +lowercase + adj. (of a character) being among standard characters + corresponding to the small letters a through z, or being some other + implementation-defined character that is defined by the + implementation to be lowercase. See *note Characters With Case::. + +M +- + +macro + n. 1. a macro form 2. a macro function. 3. a macro name. + +macro character + n. a character which, when encountered by the Lisp reader in its + main dispatch loop, introduces a reader macro_1. (Macro characters + have nothing to do with macros.) + +macro expansion + n. 1. the process of translating a macro form into another form. + 2. the form resulting from this process. + +macro form + n. a form that stands for another form (e.g., for the purposes of + abstraction, information hiding, or syntactic convenience); that + is, either a compound form whose first element is a macro name, or + a form that is a symbol that names a symbol macro. + +macro function + n. a function of two arguments, a form and an environment, that + implements macro expansion by producing a form to be evaluated in + place of the original argument form. + +macro lambda list + n. an extended lambda list used in forms that establish macro + definitions, such as defmacro and macrolet. See *note Macro Lambda + Lists::. + +macro name + n. a name for which macro-function returns true and which when + used as the first element of a compound form identifies that form + as a macro form. + +macroexpand hook + n. the function that is the value of *macroexpand-hook*. + +mapping + n. 1. a type of iteration in which a function is successively + applied to objects taken from corresponding entries in collections + such as sequences or hash tables. 2. Math. a relation between + two sets in which each element of the first set (the "domain") is + assigned one element of the second set (the "range"). + +metaclass + n. 1. a class whose instances are classes. 2. (of an object) + the class of the class of the object. + +Metaobject Protocol + n. one of many possible descriptions of how a conforming + implementation might implement various aspects of the object + system. This description is beyond the scope of this document, and + no conforming implementation is required to adhere to it except as + noted explicitly in this specification. Nevertheless, its + existence helps to establish normative practice, and implementors + with no reason to diverge from it are encouraged to consider making + their implementation adhere to it where possible. It is described + in detail in The Art of the Metaobject Protocol. + +method + n. an object that is part of a generic function and which provides + information about how that generic function should behave when its + arguments are objects of certain classes or with certain + identities. + +method combination + n. 1. generally, the composition of a set of methods to produce + an effective method for a generic function. 2. an object of type + method-combination, which represents the details of how the method + combination_1 for one or more specific generic functions is to be + performed. + +method-defining form + n. a form that defines a method for a generic function, whether + explicitly or implicitly. See *note Introduction to Generic + Functions::. + +method-defining operator + n. an operator corresponding to a method-defining form. See + Figure~7-1. + +minimal compilation + n. actions the compiler must take at compile time. See *note + Compilation Semantics::. + +modified lambda list + n. a list resembling an ordinary lambda list in form and purpose, + but which deviates in syntax or functionality from the definition + of an ordinary lambda list. See ordinary lambda list. "deftype + uses a modified lambda list." + +most recent + adj. innermost; that is, having been established (and not yet + disestablished) more recently than any other of its kind. + +multiple escape + n., adj. 1. n. the syntax type of a character that is used in + pairs to indicate that the enclosed characters are to be treated as + alphabetic_2 characters with their case preserved. For details, + see *note Multiple Escape Characters::. 2. adj. (of a character) + having the multiple escape syntax type. 3. n. a multiple + escape_2 character. (In the standard readtable, vertical-bar is a + multiple escape character.) + +multiple values + n. 1. more than one value. "The function truncate returns + multiple values." 2. a variable number of values, possibly + including zero or one. "The function values returns multiple + values." 3. a fixed number of values other than one. "The macro + multiple-value-bind is among the few operators in Common Lisp which + can detect and manipulate multiple values." + +N +- + +name + n., v.t. 1. n. an identifier by which an object, a binding, or + an exit point is referred to by association using a binding. 2. + v.t. to give a name to. 3. n. (of an object having a name + component) the object which is that component. "The string which + is a symbol's name is returned by symbol-name." 4. n. (of a + pathname) a. the name component, returned by pathname-name. b. + the entire namestring, returned by namestring. 5. n. (of a + character) a string that names the character and that has length + greater than one. (All non-graphic characters are required to have + names unless they have some implementation-defined attribute which + is not null. Whether or not other characters have names is + implementation-dependent.) + +named constant + n. a variable that is defined by Common Lisp, by the + implementation, or by user code (see the macro defconstant) to + always yield the same value when evaluated. "The value of a named + constant may not be changed by assignment or by binding." + +namespace + n. 1. bindings whose denotations are restricted to a particular + kind. "The bindings of names to tags is the tag namespace." 2. + any mapping whose domain is a set of names. "A package defines a + namespace." + +namestring + n. a string that represents a filename using either the + standardized notation for naming logical pathnames described in + *note Syntax of Logical Pathname Namestrings::, or some + implementation-defined notation for naming a physical pathname. + +newline + n. the standard character , notated for the Lisp reader + as #\Newline. + +next method + n. the next method to be invoked with respect to a given method + for a particular set of arguments or argument classes. See *note + Applying method combination to the sorted list of applicable + methods::. + +nickname + n. (of a package) one of possibly several names that can be used + to refer to the package but that is not the primary name of the + package. + +nil + n. the object that is at once the symbol named "NIL" in the + COMMON-LISP package, the empty list, the boolean (or generalized + boolean) representing false, and the name of the empty type. + +non-atomic + adj. being other than an atom; i.e., being a cons. + +non-constant variable + n. a variable that is not a constant variable. + +non-correctable + adj. (of an error) not intentionally correctable. (Because of the + dynamic nature of restarts, it is neither possible nor generally + useful to completely prohibit an error from being correctable. + This term is used in order to express an intent that no special + effort should be made by code signaling an error to make that error + correctable; however, there is no actual requirement on conforming + programs or conforming implementations imposed by this term.) + +non-empty + adj. having at least one element. + +non-generic function + n. a function that is not a generic function. + +non-graphic + adj. (of a character) not graphic. See *note Graphic + Characters::. + +non-list + n., adj. other than a list; i.e., a non-nil atom. + +non-local exit + n. a transfer of control (and sometimes values) to an exit point + for reasons other than a normal return. "The operators go, throw, + and return-from cause a non-local exit." + +non-nil + n., adj. not nil. Technically, any object which is not nil can be + referred to as true, but that would tend to imply a unique view of + the object as a generalized boolean. Referring to such an object + as non-nil avoids this implication. + +non-null lexical environment + n. a lexical environment that has additional information not + present in the global environment, such as one or more bindings. + +non-simple + adj. not simple. + +non-terminating + adj. (of a macro character) being such that it is treated as a + constituent character when it appears in the middle of an extended + token. See *note Reader Algorithm::. + +non-top-level form + n. a form that, by virtue of its position as a subform of another + form, is not a top level form. See *note Processing of Top Level + Forms::. + +normal return + n. the natural transfer of control and values which occurs after + the complete execution of a form. + +normalized + adj., ANSI, IEEE (of a float) conforming to the description of + "normalized" as described by IEEE Standard for Binary + Floating-Point Arithmetic. See denormalized. + +null + adj., n. 1. adj. a. (of a list) having no elements: empty. See + empty list. b. (of a string) having a length of zero. (It is + common, both within this document and in observed spoken behavior, + to refer to an empty string by an apparent definite reference, as + in "the null string" even though no attempt is made to intern_2 + null strings. The phrase "a null string" is technically more + correct, but is generally considered awkward by most Lisp + programmers. As such, the phrase "the null string" should be + treated as an indefinite reference in all cases except for + anaphoric references.) c. (of an implementation-defined attribute + of a character) An object to which the value of that attribute + defaults if no specific value was requested. 2. n. an object of + type null (the only such object being nil). + +null lexical environment + n. the lexical environment which has no bindings. + +number + n. an object of type number. + +numeric + adj. (of a character) being one of the standard characters 0 + through 9, or being some other graphic character defined by the + implementation to be numeric. + +O +- + +object + n. 1. any Lisp datum. "The function cons creates an object which + refers to two other objects." 2. (immediately following the name + of a type) an object which is of that type, used to emphasize that + the object is not just a name for an object of that type but really + an element of the type in cases where objects of that type (such as + function or class) are commonly referred to by name. "The function + symbol-function takes a function name and returns a function + object." + +object-traversing + adj. operating in succession on components of an object. "The + operators mapcar, maphash, with-package-iterator and count perform + object-traversing operations." + +open + adj., v.t. (a file) 1. v.t. to create and return a stream to the + file. 2. adj. (of a stream) having been opened_1, but not yet + closed. + +operator + n. 1. a function, macro, or special operator. 2. a symbol that + names such a function, macro, or special operator. 3. (in a + function special form) the cadr of the function special form, which + might be either an operator_2 or a lambda expression. 4. (of a + compound form) the car of the compound form, which might be either + an operator_2 or a lambda expression, and which is never (setf + symbol). + +optimize quality + n. one of several aspects of a program that might be optimizable + by certain compilers. Since optimizing one such quality might + conflict with optimizing another, relative priorities for qualities + can be established in an optimize declaration. The standardized + optimize qualities are compilation-speed (speed of the compilation + process), + + debug (ease of debugging), + + safety (run-time error checking), space (both code size and + run-time space), and speed (of the object code). Implementations + may define additional optimize qualities. + +optional parameter + n. A parameter for which a corresponding positional argument is + optional. If the argument is not supplied, a default value is + used. See also supplied-p parameter. + +ordinary function + n. a function that is not a generic function. + +ordinary lambda list + n. the kind of lambda list used by lambda. See modified lambda + list and extended lambda list. "defun uses an ordinary lambda + list." + +otherwise inaccessible part + n. (of an object, O_1) an object, O_2, which would be made + inaccessible if O_1 were made inaccessible. (Every object is an + otherwise inaccessible part of itself.) + +output + adj. (of a stream) supporting output operations (i.e., being a + "data sink"). An output stream might also be an input stream, in + which case it is sometimes called a bidirectional stream. See the + function output-stream-p. + +P +- + +package + n. an object of type package. + +package cell + n. Trad. (of a symbol) The place in a symbol that holds one of + possibly several packages in which the symbol is interned, called + the home package, or which holds nil if no such package exists or + is known. See the function symbol-package. + +package designator + n. a designator for a package; that is, an object that denotes a + package and that is one of: a string designator (denoting the + package that has the string that it designates as its name or as + one of its nicknames), or a package (denoting itself). + +package marker + n. a character which is used in the textual notation for a symbol + to separate the package name from the symbol name, and which is + colon in the standard readtable. See *note Character Syntax::. + +package prefix + n. a notation preceding the name of a symbol in text that is + processed by the Lisp reader, which uses a package name followed by + one or more package markers, and which indicates that the symbol is + looked up in the indicated package. + +package registry + n. A mapping of names to package objects. It is possible for + there to be a package object which is not in this mapping; such a + package is called an unregistered package. Operators such as + find-package consult this mapping in order to find a package from + its name. Operators such as do-all-symbols, find-all-symbols, and + list-all-packages operate only on packages that exist in the + package registry. + +pairwise + adv. (of an adjective on a set) applying individually to all + possible pairings of elements of the set. "The types A, B, and C + are pairwise disjoint if A and B are disjoint, B and C are + disjoint, and A and C are disjoint." + +parallel + adj. Trad. (of binding or assignment) done in the style of psetq, + let, or do; that is, first evaluating all of the forms that produce + values, and only then assigning or binding the variables (or + places). Note that this does not imply traditional computational + "parallelism" since the forms that produce values are evaluated + sequentially. See sequential. + +parameter + n. 1. (of a function) a variable in the definition of a function + which takes on the value of a corresponding argument (or of a list + of corresponding arguments) to that function when it is called, or + which in some cases is given a default value because there is no + corresponding argument. 2. (of a format directive) an object + received as data flow by a format directive due to a prefix + notation within the format string at the format directive's point + of use. See *note Formatted Output::. "In "~3,'0D", the number 3 + and the character #\0 are parameters to the ~D format directive." + +parameter specializer + n. 1. (of a method) an expression which constrains the method to + be applicable only to argument sequences in which the corresponding + argument matches the parameter specializer. 2. a class, or a list + (eql object). + +parameter specializer name + n. 1. (of a method definition) an expression used in code to name + a parameter specializer. See *note Introduction to Methods::. 2. + a class, + + a symbol naming a class, + + or a list (eql form). + +pathname + n. an object of type pathname, which is a structured + representation of the name of a file. A pathname has six + components: a "host," a "device," a "directory," a "name," a + "type," and a "version." + +pathname designator + n. a designator for a pathname; that is, an object that denotes a + pathname and that is one of: + + a pathname namestring + + (denoting the corresponding pathname), + + a stream associated with a file (denoting the pathname used to open + the file; this may be, but is not required to be, the actual name + of the file), or a pathname (denoting itself). See *note File + Operations on Open and Closed Streams::. + +physical pathname + n. a pathname that is not a logical pathname. + + [Editorial Note by KMP: Still need to reconcile some confusion in + the uses of "generalized reference" and "place." I think one was + supposed to refer to the abstract concept, and the other to an + object (a form), but the usages have become blurred.] + +place + n. 1. a form which is suitable for use as a generalized + reference. 2. the conceptual location referred to by such a + place_1. + +plist + pronounced 'p\=e ,list n. a property list. + +portable + adj. (of code) required to produce equivalent results and + observable side effects in all conforming implementations. + +potential copy + n. (of an object O_1 subject to constriants) an object O_2 that if + the specified constraints are satisfied by O_1 without any + modification might or might not be identical to O_1, or else that + must be a fresh object that resembles a copy of O_1 except that it + has been modified as necessary to satisfy the constraints. + +potential number + n. A textual notation that might be parsed by the Lisp reader in + some conforming implementation as a number but is not required to + be parsed as a number. No object is a potential number--either an + object is a number or it is not. See *note Potential Numbers as + Tokens::. + +pprint dispatch table + n. an object that can be the value of *print-pprint-dispatch* and + hence can control how objects are printed when *print-pretty* is + true. See *note Pretty Print Dispatch Tables::. + +predicate + n. a function that returns a generalized boolean as its first + value. + +present + n. 1. (of a feature in a Lisp image) a state of being that is in + effect if and only if the symbol naming the feature is an element + of the features list. 2. (of a symbol in a package) being + accessible in that package directly, rather than being inherited + from another package. + +pretty print + v.t. (an object) to invoke the pretty printer on the object. + +pretty printer + n. the procedure that prints the character representation of an + object onto a stream when the value of *print-pretty* is true, and + that uses layout techniques (e.g., indentation) that tend to + highlight the structure of the object in a way that makes it easier + for human readers to parse visually. See the variable + *print-pprint-dispatch* and *note The Lisp Pretty Printer::. + +pretty printing stream + n. a stream that does pretty printing. Such streams are created + by the function pprint-logical-block as a link between the output + stream and the logical block. + +primary method + n. a member of one of two sets of methods (the set of auxiliary + methods is the other) that form an exhaustive partition of the set + of methods on the method's generic function. How these sets are + determined is dependent on the method combination type; see *note + Introduction to Methods::. + +primary value + n. (of values resulting from the evaluation of a form) the first + value, if any, or else nil if there are no values. "The primary + value returned by truncate is an integer quotient, truncated toward + zero." + +principal + adj. (of a value returned by a Common Lisp function that + implements a mathematically irrational or transcendental function + defined in the complex domain) of possibly many (sometimes an + infinite number of) correct values for the mathematical function, + being the particular value which the corresponding Common Lisp + function has been defined to return. + +print name + n. Trad. (usually of a symbol) a name_3. + +printer control variable + n. a variable whose specific purpose is to control some action of + the Lisp printer; that is, one of the variables in Figure~22-1, or + else some implementation-defined variable which is defined by the + implementation to be a printer control variable. + +printer escaping + n. The combined state of the printer control variables + *print-escape* and *print-readably*. If the value of either + *print-readably* or *print-escape* is true, then printer escaping + is "enabled"; otherwise (if the values of both *print-readably* and + *print-escape* are false), then printer escaping is "disabled". + +printing + adj. (of a character) being a graphic character other than space. + +process + v.t. (a form by the compiler) to perform minimal compilation, + determining the time of evaluation for a form, and possibly + evaluating that form (if required). + +processor + n., ANSI an implementation. + +proclaim + v.t. (a proclamation) to establish that proclamation. + +proclamation + n. a global declaration. + +prog tag + n. Trad. a go tag. + +program + n. Trad. Common Lisp code. + +programmer + n. an active entity, typically a human, that writes a program, and + that might or might not also be a user of the program. + +programmer code + n. code that is supplied by the programmer; that is, code that is + not system code. + +proper list + n. A list terminated by the empty list. (The empty list is a + proper list.) See improper list. + +proper name + n. (of a class) a symbol that names the class whose name is that + symbol. See the functions class-name and find-class. + +proper sequence + n. a sequence which is not an improper list; that is, a vector or + a proper list. + +proper subtype + n. (of a type) a subtype of the type which is not the same type as + the type (i.e., its elements are a "proper subset" of the type). + +property + n. (of a property list) 1. a conceptual pairing of a property + indicator and its associated property value on a property list. 2. + a property value. + +property indicator + n. (of a property list) the name part of a property, used as a key + when looking up a property value on a property list. + +property list + n. + + 1. a list containing an even number of elements that are + alternating names (sometimes called indicators or keys) and values + (sometimes called properties). When there is more than one name + and value pair with the identical name in a property list, the + first such pair determines the property. + + 2. (of a symbol) the component of the symbol containing a property + list. + +property value + n. (of a property indicator on a property list) the object + associated with the property indicator on the property list. + +purports to conform + v. makes a good-faith claim of conformance. This term expresses + intention to conform, regardless of whether the goal of that + intention is realized in practice. For example, language + implementations have been known to have bugs, and while an + implementation of this specification with bugs might not be a + conforming implementation, it can still purport to conform. This + is an important distinction in certain specific cases; e.g., see + the variable *features*. + +Q +- + +qualified method + n. a method that has one or more qualifiers. + +qualifier + n. (of a method for a generic function) one of possibly several + objects used to annotate the method in a way that identifies its + role in the method combination. The method combination type + determines how many qualifiers are permitted for each method, which + qualifiers are permitted, and the semantics of those qualifiers. + +query I/O + n. the bidirectional stream that is the value of the variable + *query-io*. + +quoted object + n. an object which is the second element of a quote form. + +R +- + +radix + n. an integer between 2 and 36, inclusive, which can be used to + designate a base with respect to which certain kinds of numeric + input or output are performed. (There are n valid digit characters + for any given radix n, and those digits are the first n digits in + the sequence 0, 1, ..., 9, A, B, ..., Z, which have the weights 0, + 1, ..., 9, 10, 11, ..., 35, respectively. Case is not significant + in parsing numbers of radix greater than 10, so "9b8a" and "9B8A" + denote the same radix 16 number.) + +random state + n. an object of type random-state. + +rank + n. a non-negative integer indicating the number of dimensions of + an array. + +ratio + n. an object of type ratio. + +ratio marker + n. a character which is used in the textual notation for a ratio + to separate the numerator from the denominator, and which is slash + in the standard readtable. See *note Character Syntax::. + +rational + n. an object of type rational. + +read + v.t. + + 1. (a binding or slot or component) to obtain the value of the + binding or slot. + + 2. (an object from a stream) to parse an object from its + representation on the stream. + +readably + adv. (of a manner of printing an object O_1) in such a way as to + permit the Lisp Reader to later parse the printed output into an + object O_2 that is similar to O_1. + +reader + n. 1. a function that reads_1 a variable or slot. 2. the Lisp + reader. + +reader macro + n. 1. a textual notation introduced by dispatch on one or two + characters that defines special-purpose syntax for use by the Lisp + reader, and that is implemented by a reader macro function. See + *note Reader Algorithm::. 2. the character or characters that + introduce a reader macro_1; that is, a macro character or the + conceptual pairing of a dispatching macro character and the + character that follows it. (A reader macro is not a kind of + macro.) + +reader macro function + n. a function designator that denotes a function that implements a + reader macro_2. See the functions set-macro-character and + set-dispatch-macro-character. + +readtable + n. an object of type readtable. + +readtable case + n. an attribute of a readtable whose value is a case sensitivity + mode, and that selects the manner in which characters in a symbol's + name are to be treated by the Lisp reader and the Lisp printer. + See *note Effect of Readtable Case on the Lisp Reader:: and *note + Effect of Readtable Case on the Lisp Printer::. + +readtable designator + n. a designator for a readtable; that is, an object that denotes a + readtable and that is one of: nil (denoting the standard + readtable), or a readtable (denoting itself). + +recognizable subtype + n. (of a type) a subtype of the type which can be reliably + detected to be such by the implementation. See the function + subtypep. + +reference + n., v.t. 1. n. an act or occurrence of referring to an object, a + binding, an exit point, a tag, or an environment. 2. v.t. to + refer to an object, a binding, an exit point, a tag, or an + environment, usually by name. + +registered package + n. a package object that is installed in the package registry. + (Every registered package has a name that is a string, as well as + zero or more string nicknames. All packages that are initially + specified by Common Lisp or created by make-package or defpackage + are registered packages. Registered packages can be turned into + unregistered packages by delete-package.) + +relative + adj. 1. (of a time) representing an offset from an absolute time + in the units appropriate to that time. For example, a relative + internal time is the difference between two absolute internal + times, and is measured in internal time units. 2. (of a pathname) + representing a position in a directory hierarchy by motion from a + position other than the root, which might therefore vary. "The + notation #P"../foo.text" denotes a relative pathname if the host + file system is Unix." See absolute. + +repertoire + n., ISO a subtype of character. See *note Character Repertoires::. + +report + n. (of a condition) to call the function print-object on the + condition in an environment where the value of *print-escape* is + false. + +report message + n. the text that is output by a condition reporter. + +required parameter + n. A parameter for which a corresponding positional argument must + be supplied when calling the function. + +rest list + n. (of a function having a rest parameter) The list to which the + rest parameter is bound on some particular call to the function. + +rest parameter + n. A parameter which was introduced by &rest. + +restart + n. an object of type restart. + +restart designator + n. a designator for a restart; that is, an object that denotes a + restart and that is one of: a non-nil symbol (denoting the most + recently established active restart whose name is that symbol), or + a restart (denoting itself). + +restart function + n. a function that invokes a restart, as if by invoke-restart. + The primary purpose of a restart function is to provide an + alternate interface. By convention, a restart function usually has + the same name as the restart which it invokes. Figure 26-4 shows a + list of the standardized restart functions. + + abort muffle-warning use-value + continue store-value + + Figure 26-4: Standardized Restart Functions + + +return + v.t. (of values) 1. (from a block) to transfer control and values + from the block; that is, to cause the block to yield the values + immediately without doing any further evaluation of the forms in + its body. 2. (from a form) to yield the values. + +return value + n. Trad. a value_1 + +right-parenthesis + n. the standard character ")", that is variously called "right + parenthesis" or "close parenthesis" See Figure~2-5. + +run time + n. 1. load time 2. execution time + +run-time compiler + n. refers to the compile function or to implicit compilation, for + which the compilation and run-time environments are maintained in + the same Lisp image. + +run-time definition + n. a definition in the run-time environment. + +run-time environment + n. the environment in which a program is executed. + +S +- + +safe + adj. 1. (of code) processed in a lexical environment where the + the highest safety level (3) was in effect. See optimize. 2. (of + a call) a safe call. + +safe call + n. a call in which the call, the function being called, and the + point of functional evaluation are all safe_1 code. For more + detailed information, see *note Safe and Unsafe Calls::. + +same + adj. 1. (of objects under a specified predicate) + indistinguishable by that predicate. "The symbol car, the string + "car", and the string "CAR" are the same under string-equal". 2. + (of objects if no predicate is implied by context) + indistinguishable by eql. Note that eq might be capable of + distinguishing some numbers and characters which eql cannot + distinguish, but the nature of such, if any, is + implementation-dependent. Since eq is used only rarely in this + specification, eql is the default predicate when none is mentioned + explicitly. "The conses returned by two successive calls to cons + are never the same." 3. (of types) having the same set of + elements; that is, each type is a subtype of the others. "The + types specified by (integer 0 1), (unsigned-byte 1), and bit are + the same." + +satisfy the test + v. (of an object being considered by a sequence function) 1. (for + a one argument test) to be in a state such that the function which + is the predicate argument to the sequence function returns true + when given a single argument that is the result of calling the + sequence function's key argument on the object being considered. + See *note Satisfying a One-Argument Test::. 2. (for a two + argument test) to be in a state such that the two-place predicate + which is the sequence function's test argument returns true when + given a first argument that is the object being considered, and + when given a second argument that is the result of calling the + sequence function's key argument on an element of the sequence + function's sequence argument which is being tested for equality; or + to be in a state such that the test-not function returns false + given the same arguments. See *note Satisfying a Two-Argument + Test::. + +scope + n. the structural or textual region of code in which references to + an object, a binding, an exit point, a tag, or an environment + (usually by name) can occur. + +script + n. ISO one of possibly several sets that form an exhaustive + partition of the type character. See *note Character Scripts::. + +secondary value + n. (of values resulting from the evaluation of a form) the second + value, if any, or else nil if there are fewer than two values. + "The secondary value returned by truncate is a remainder." + +section + n. a partitioning of output by a conditional newline on a pretty + printing stream. See *note Dynamic Control of the Arrangement of + Output::. + +self-evaluating object + n. an object that is neither a symbol nor a cons. If a + self-evaluating object is evaluated, it yields itself as its only + value. "Strings are self-evaluating objects." + +semi-standard + adj. (of a language feature) not required to be implemented by any + conforming implementation, but nevertheless recommended as the + canonical approach in situations where an implementation does plan + to support such a feature. The presence of semi-standard aspects + in the language is intended to lessen portability problems and + reduce the risk of gratuitous divergence among implementations that + might stand in the way of future standardization. + +semicolon + n. the standard character that is called "semicolon" (;). See + Figure~2-5. + +sequence + n. 1. an ordered collection of elements 2. a vector or a list. + +sequence function + n. one of the functions in Figure~17-1, or an + implementation-defined function that operates on one or more + sequences. and that is defined by the implementation to be a + sequence function. + +sequential + adj. Trad. (of binding or assignment) done in the style of setq, + let*, or do*; that is, interleaving the evaluation of the forms + that produce values with the assignments or bindings of the + variables (or places). See parallel. + +sequentially + adv. in a sequential way. + +serious condition + n. a condition of type serious-condition, which represents a + situation that is generally sufficiently severe that entry into the + debugger should be expected if the condition is signaled but not + handled. + +session + n. the conceptual aggregation of events in a Lisp image from the + time it is started to the time it is terminated. + +set + v.t. Trad. (any variable or a symbol that is the name of a + dynamic variable) to assign the variable. + +setf expander + n. a function used by setf to compute the setf expansion of a + place. + +setf expansion + n. a set of five expressions_1 that, taken together, describe how + to store into a place and which subforms of the macro call + associated with the place are evaluated. See *note Setf + Expansions::. + +setf function + n. a function whose name is (setf symbol). + +setf function name + n. (of a symbol S) the list (setf S). + +shadow + v.t. 1. to override the meaning of. "That binding of X shadows + an outer one." 2. to hide the presence of. "That macrolet of F + shadows the outer flet of F." 3. to replace. "That package + shadows the symbol cl:car with its own symbol car." + +shadowing symbol + n. (in a package) an element of the package's shadowing symbols + list. + +shadowing symbols list + n. (of a package) a list, associated with the package, of symbols + that are to be exempted from 'symbol conflict errors' detected when + packages are used. See the function package-shadowing-symbols. + +shared slot + n. (of a class) a slot accessible in more than one instance of a + class; specifically, such a slot is accessible in all direct + instances of the class and in those indirect instances whose class + does not shadow_1 the slot. + +sharpsign + n. the standard character that is variously called "number sign," + "sharp," or "sharp sign" (#). See Figure~2-5. + +short float + n. an object of type short-float. + +sign + n. one of the standard characters "+" or "-". + +signal + v. to announce, using a standard protocol, that a particular + situation, represented by a condition, has been detected. See + *note Condition System Concepts::. + +signature + n. (of a method) a description of the parameters and parameter + specializers for the method which determines the method's + applicability for a given set of required arguments, and which also + describes the argument conventions for its other, non-required + arguments. + +similar + adj. (of two objects) defined to be equivalent under the + similarity relationship. + +similarity + n. a two-place conceptual equivalence predicate, which is + independent of the Lisp image so that two objects in different Lisp + images can be understood to be equivalent under this predicate. + See *note Literal Objects in Compiled Files::. + +simple + adj. 1. (of an array) being of type simple-array. 2. (of a + character) having no implementation-defined attributes, or else + having implementation-defined attributes each of which has the null + value for that attribute. + +simple array + n. an array of type simple-array. + +simple bit array + n. a bit array that is a simple array; that is, an object of type + (simple-array bit). + +simple bit vector + n. a bit vector of type simple-bit-vector. + +simple condition + n. a condition of type simple-condition. + +simple general vector + n. a simple vector. + +simple string + n. a string of type simple-string. + +simple vector + n. a vector of type simple-vector, sometimes called a "simple + general vector." Not all vectors that are simple are simple + vectors--only those that have element type t. + +single escape + n., adj. 1. n. the syntax type of a character that indicates + that the next character is to be treated as an alphabetic_2 + character with its case preserved. For details, see *note Single + Escape Character::. 2. adj. (of a character) having the single + escape syntax type. 3. n. a single escape_2 character. (In the + standard readtable, slash is the only single escape.) + +single float + n. an object of type single-float. + +single-quote + n. the standard character that is variously called "apostrophe," + "acute accent," "quote," or "single quote" ('). See Figure~2-5. + +singleton + adj. (of a sequence) having only one element. "(list 'hello) + returns a singleton list." + +situation + n. the evaluation of a form in a specific environment. + +slash + n. the standard character that is variously called "solidus" or + "slash" (/). See Figure~2-5. + +slot + n. a component of an object that can store a value. + +slot specifier + n. a representation of a slot that includes the name of the slot + and zero or more slot options. A slot option pertains only to a + single slot. + +source code + n. code representing objects suitable for evaluation (e.g., + objects created by read, by macro expansion, + + or by compiler macro expansion). + +source file + n. a file which contains a textual representation of source code, + that can be edited, loaded, or compiled. + +space + n. the standard character , notated for the Lisp reader as + #\Space. + +special form + n. a list, other than a macro form, which is a form with special + syntax or special evaluation rules or both, possibly manipulating + the evaluation environment or control flow or both. The first + element of a special form is a special operator. + +special operator + n. one of a fixed set of symbols, enumerated in Figure~3-2, that + may appear in the car of a form in order to identify the form as a + special form. + +special variable + n. Trad. a dynamic variable. + +specialize + v.t. (a generic function) to define a method for the generic + function, or in other words, to refine the behavior of the generic + function by giving it a specific meaning for a particular set of + classes or arguments. + +specialized + adj. 1. (of a generic function) having methods which specialize + the generic function. 2. (of an array) having an actual array + element type that is a proper subtype of the type t; see *note + Array Elements::. "(make-array 5 :element-type 'bit) makes an + array of length five that is specialized for bits." + +specialized lambda list + n. an extended lambda list used in forms that establish method + definitions, such as defmethod. See *note Specialized Lambda + Lists::. + +spreadable argument list designator + n. a designator for a list of objects; that is, an object that + denotes a list and that is a non-null list L1 of length n, whose + last element is a list L2 of length m (denoting a list L3 of length + m+n-1 whose elements are L1_i for i < n-1 followed by L2_j for j < + m). "The list (1 2 (3 4 5)) is a spreadable argument list + designator for the list (1 2 3 4 5)." + +stack allocate + v.t. Trad. to allocate in a non-permanent way, such as on a + stack. Stack-allocation is an optimization technique used in some + implementations for allocating certain kinds of objects that have + dynamic extent. Such objects are allocated on the stack rather + than in the heap so that their storage can be freed as part of + unwinding the stack rather than taking up space in the heap until + the next garbage collection. What types (if any) can have dynamic + extent can vary from implementation to implementation. No + implementation is ever required to perform stack-allocation. + +stack-allocated + adj. Trad. having been stack allocated. + +standard character + n. a character of type standard-char, which is one of a fixed set + of 96 such characters required to be present in all conforming + implementations. See *note Standard Characters::. + +standard class + n. a class that is a generalized instance of class standard-class. + +standard generic function + + a function of type standard-generic-function. + +standard input + n. the input stream which is the value of the dynamic variable + *standard-input*. + +standard method combination + n. the method combination named standard. + +standard object + n. an object that is a generalized instance of class + standard-object. + +standard output + n. the output stream which is the value of the dynamic variable + *standard-output*. + +standard pprint dispatch table + n. A pprint dispatch table that is different from the initial + pprint dispatch table, that implements pretty printing as described + in this specification, and that, unlike other pprint dispatch + tables, must never be modified by any program. (Although the + definite reference "the standard pprint dispatch table" is + generally used within this document, it is actually + implementation-dependent whether a single object fills the role of + the standard pprint dispatch table, or whether there might be + multiple such objects, any one of which could be used on any given + occasion where "the standard pprint dispatch table" is called for. + As such, this phrase should be seen as an indefinite reference in + all cases except for anaphoric references.) + +standard readtable + n. A readtable that is different from the initial readtable, that + implements the expression syntax defined in this specification, and + that, unlike other readtables, must never be modified by any + program. (Although the definite reference "the standard readtable" + is generally used within this document, it is actually + implementation-dependent whether a single object fills the role of + the standard readtable, or whether there might be multiple such + objects, any one of which could be used on any given occasion where + "the standard readtable" is called for. As such, this phrase + should be seen as an indefinite reference in all cases except for + anaphoric references.) + +standard syntax + n. the syntax represented by the standard readtable and used as a + reference syntax throughout this document. See *note Character + Syntax::. + +standardized + adj. (of a name, object, or definition) having been defined by + Common Lisp. "All standardized variables that are required to hold + bidirectional streams have "-io*" in their name." + +startup environment + n. the global environment of the running Lisp image from which the + compiler was invoked. + +step + v.t., n. 1. v.t. (an iteration variable) to assign the variable + a new value at the end of an iteration, in preparation for a new + iteration. 2. n. the code that identifies how the next value in + an iteration is to be computed. 3. v.t. (code) to specially + execute the code, pausing at intervals to allow user confirmation + or intervention, usually for debugging. + +stream + n. an object that can be used with an input or output function to + identify an appropriate source or sink of characters or bytes for + that operation. + +stream associated with a file + n. a file stream, or a synonym stream the target of which is a + stream associated with a file. Such a stream cannot be created + with make-two-way-stream, make-echo-stream, make-broadcast-stream, + make-concatenated-stream, make-string-input-stream, or + make-string-output-stream. + +stream designator + n. a designator for a stream; that is, an object that denotes a + stream and that is one of: t (denoting the value of *terminal-io*), + nil (denoting the value of *standard-input* for input stream + designators or denoting the value of *standard-output* for output + stream designators), or a stream (denoting itself). + +stream element type + n. (of a stream) the type of data for which the stream is + specialized. + +stream variable + n. a variable whose value must be a stream. + +stream variable designator + n. a designator for a stream variable; that is, a symbol that + denotes a stream variable and that is one of: t (denoting + *terminal-io*), nil (denoting *standard-input* for input stream + variable designators or denoting *standard-output* for output + stream variable designators), or some other symbol (denoting + itself). + +string + n. a specialized vector that is of type string, and whose elements + are of type character or a subtype of type character. + +string designator + n. a designator for a string; that is, an object that denotes a + string and that is one of: a character (denoting a singleton string + that has the character as its only element), a symbol (denoting the + string that is its name), or a string (denoting itself). + + The intent is that this term be consistent with the behavior of + string; implementations that extend string must extend the meaning + of this term in a compatible way. + +string equal + adj. the same under string-equal. + +string stream + n. a stream of type string-stream. + +structure + n. an object of type structure-object. + +structure class + n. a class that is a generalized instance of class + structure-class. + +structure name + n. a name defined with defstruct. Usually, such a type is also a + structure class, but there may be implementation-dependent + situations in which this is not so, if the :type option to + defstruct is used. + +style warning + n. a condition of type style-warning. + +subclass + n. a class that inherits from another class, called a superclass. + (No class is a subclass of itself.) + +subexpression + n. (of an expression) an expression that is contained within the + expression. (In fact, the state of being a subexpression is not an + attribute of the subexpression, but really an attribute of the + containing expression since the same object can at once be a + subexpression in one context, and not in another.) + +subform + n. (of a form) an expression that is a subexpression of the form, + and which by virtue of its position in that form is also a form. + "(f x) and x, but not exit, are subforms of (return-from exit (f + x))." + +subrepertoire + n. a subset of a repertoire. + +subtype + n. a type whose membership is the same as or a proper subset of + the membership of another type, called a supertype. (Every type is + a subtype of itself.) + +superclass + n. a class from which another class (called a subclass) inherits. + (No class is a superclass of itself.) See subclass. + +supertype + n. a type whose membership is the same as or a proper superset of + the membership of another type, called a subtype. (Every type is a + supertype of itself.) See subtype. + +supplied-p parameter + n. a parameter which recieves its generalized boolean value + implicitly due to the presence or absence of an argument + corresponding to another parameter (such as an optional parameter + or a rest parameter). See *note Ordinary Lambda Lists::. + +symbol + n. an object of type symbol. + +symbol macro + n. a symbol that stands for another form. See the macro + symbol-macrolet. + +synonym stream + n. 1. a stream of type synonym-stream, which is consequently a + stream that is an alias for another stream, which is the value of a + dynamic variable whose name is the synonym stream symbol of the + synonym stream. See the function make-synonym-stream. 2. (to a + stream) a synonym stream which has the stream as the value of its + synonym stream symbol. 3. (to a symbol) a synonym stream which + has the symbol as its synonym stream symbol. + +synonym stream symbol + n. (of a synonym stream) the symbol which names the dynamic + variable which has as its value another stream for which the + synonym stream is an alias. + +syntax type + n. (of a character) one of several classifications, enumerated in + Figure~2-6, that are used for dispatch during parsing by the Lisp + reader. See *note Character Syntax Types::. + +system class + n. a class that may be of type built-in-class in a conforming + implementation and hence cannot be inherited by classes defined by + conforming programs. + +system code + n. code supplied by the implementation to implement this + specification (e.g., the definition of mapcar) or generated + automatically in support of this specification (e.g., during method + combination); that is, code that is not programmer code. + +T +- + +t + n. 1. a. the boolean representing true. b. the canonical + generalized boolean representing true. (Although any object other + than nil is considered true as a generalized boolean, t is + generally used when there is no special reason to prefer one such + object over another.) 2. the name of the type to which all + objects belong--the supertype of all types (including itself). 3. + the name of the superclass of all classes except itself. + +tag + n. 1. a catch tag. 2. a go tag. + +tail + n. (of a list) an object that is the same as either some cons + which makes up that list or the atom (if any) which terminates the + list. "The empty list is a tail of every proper list." + +target + n. 1. (of a constructed stream) a constituent of the constructed + stream. "The target of a synonym stream is the value of its + synonym stream symbol." 2. (of a displaced array) the array to + which the displaced array is displaced. (In the case of a chain of + constructed streams or displaced arrays, the unqualified term + "target" always refers to the immediate target of the first item in + the chain, not the immediate target of the last item.) + +terminal I/O + n. the bidirectional stream that is the value of the variable + *terminal-io*. + +terminating + n. (of a macro character) being such that, if it appears while + parsing a token, it terminates that token. See *note Reader + Algorithm::. + +tertiary value + n. (of values resulting from the evaluation of a form) the third + value, if any, or else nil if there are fewer than three values. + +throw + v. to transfer control and values to a catch. See the special + operator throw. + +tilde + n. the standard character that is called "tilde" (~). See + Figure~2-5. + +time + + a representation of a point (absolute time) or an interval + (relative time) on a time line. See decoded time, internal time, + and universal time. + +time zone + n. a rational multiple of 1/3600 between -24 (inclusive) and 24 + (inclusive) that represents a time zone as a number of hours offset + from Greenwich Mean Time. Time zone values increase with motion to + the west, so Massachusetts, U.S.A. is in time zone 5, California, + U.S.A. is time zone 8, and Moscow, Russia is time zone -3. (When + "daylight savings time" is separately represented as an argument or + return value, the time zone that accompanies it does not depend on + whether daylight savings time is in effect.) + +token + n. a textual representation for a number or a symbol. See *note + Interpretation of Tokens::. + +top level form + n. a form which is processed specially by compile-file for the + purposes of enabling compile time evaluation of that form. Top + level forms include those forms which are not subforms of any other + form, and certain other cases. See *note Processing of Top Level + Forms::. + +trace output + n. the output stream which is the value of the dynamic variable + *trace-output*. + +tree + n. 1. a binary recursive data structure made up of conses and + atoms: the conses are themselves also trees (sometimes called + "subtrees" or "branches"), and the atoms are terminal nodes + (sometimes called leaves). Typically, the leaves represent data + while the branches establish some relationship among that data. 2. + in general, any recursive data structure that has some notion of + "branches" and leaves. + +tree structure + n. (of a tree_1) the set of conses that make up the tree. Note + that while the car_{1b} component of each such cons is part of the + tree structure, the objects that are the cars_2 of each cons in the + tree are not themselves part of its tree structure unless they are + also conses. + +true + n. any object that is not false and that is used to represent the + success of a predicate test. See t_1. + +truename + n. 1. the canonical filename of a file in the file system. See + *note Truenames::. 2. a pathname representing a truename_1. + +two-way stream + n. a stream of type two-way-stream, which is a bidirectional + composite stream that receives its input from an associated input + stream and sends its output to an associated output stream. + +type + n. 1. a set of objects, usually with common structure, behavior, + or purpose. (Note that the expression "X is of type S_a" naturally + implies that "X is of type S_b" if S_a is a subtype of S_b.) 2. + (immediately following the name of a type) a subtype of that type. + "The type vector is an array type." + +type declaration + n. a declaration that asserts that every reference to a specified + binding within the scope of the declaration results in some object + of the specified type. + +type equivalent + adj. (of two types X and Y) having the same elements; that is, X + is a subtype of Y and Y is a subtype of X. + +type expand + n. to fully expand a type specifier, removing any references to + derived types. (Common Lisp provides no program interface to cause + this to occur, but the semantics of Common Lisp are such that every + implementation must be able to do this internally, and some + situations involving type specifiers are most easily described in + terms of a fully expanded type specifier.) + +type specifier + n. an expression that denotes a type. "The symbol random-state, + the list (integer 3 5), the list (and list (not null)), and the + class named standard-class are type specifiers." + +U +- + +unbound + adj. not having an associated denotation in a binding. See bound. + +unbound variable + n. a name that is syntactically plausible as the name of a + variable but which is not bound in the variable namespace. + +undefined function + n. a name that is syntactically plausible as the name of a + function but which is not bound in the function namespace. + +unintern + v.t. (a symbol in a package) to make the symbol not be present in + that package. (The symbol might continue to be accessible by + inheritance.) + +uninterned + adj. (of a symbol) not accessible in any package; i.e., not + interned_1. + +universal time + n. time, represented as a non-negative integer number of seconds. + Absolute universal time is measured as an offset from the beginning + of the year 1900 (ignoring leap seconds). See *note Universal + Time::. + +unqualified method + n. a method with no qualifiers. + +unregistered package + n. a package object that is not present in the package registry. + An unregistered package has no name; i.e., its name is nil. See + the function delete-package. + +unsafe + adj. (of code) not safe. (Note that, unless explicitly specified + otherwise, if a particular kind of error checking is guaranteed + only in a safe context, the same checking might or might not occur + in that context if it were unsafe; describing a context as unsafe + means that certain kinds of error checking are not reliably enabled + but does not guarantee that error checking is definitely disabled.) + +unsafe call + n. a call that is not a safe call. For more detailed information, + see *note Safe and Unsafe Calls::. + +upgrade + v.t. (a declared type to an actual type) 1. (when creating an + array) to substitute an actual array element type for an expressed + array element type when choosing an appropriately specialized array + representation. See the function upgraded-array-element-type. 2. + (when creating a complex) to substitute an actual complex part type + for an expressed complex part type when choosing an appropriately + specialized complex representation. See the function + upgraded-complex-part-type. + +upgraded array element type + n. (of a type) a type that is a supertype of the type and that is + used instead of the type whenever the type is used as an array + element type for object creation or type discrimination. See *note + Array Upgrading::. + +upgraded complex part type + n. (of a type) a type that is a supertype of the type and that is + used instead of the type whenever the type is used as a complex + part type for object creation or type discrimination. See the + function upgraded-complex-part-type. + +uppercase + adj. (of a character) being among standard characters + corresponding to the capital letters A through Z, or being some + other implementation-defined character that is defined by the + implementation to be uppercase. See *note Characters With Case::. + +use + v.t. (a package P_1) to inherit the external symbols of P_1. (If + a package P_2 uses P_1, the external symbols of P_1 become internal + symbols of P_2 unless they are explicitly exported.) "The package + CL-USER uses the package CL." + +use list + n. (of a package) a (possibly empty) list associated with each + package which determines what other packages are currently being + used by that package. + +user + n. an active entity, typically a human, that invokes or interacts + with a program at run time, but that is not necessarily a + programmer. + +V +- + +valid array dimension + n. a fixnum suitable for use as an array dimension. Such a fixnum + must be greater than or equal to zero, and less than the value of + array-dimension-limit. When multiple array dimensions are to be + used together to specify a multi-dimensional array, there is also + an implied constraint that the product of all of the dimensions be + less than the value of array-total-size-limit. + +valid array index + n. (of an array) a fixnum suitable for use as one of possibly + several indices needed to name an element of the array according to + a multi-dimensional Cartesian coordinate system. Such a fixnum + must be greater than or equal to zero, and must be less than the + corresponding dimension_1 of the array. (Unless otherwise + explicitly specified, the phrase "a list of valid array indices" + further implies that the length of the list must be the same as the + rank of the array.) "For a 2 by~3 array, valid array indices for + the first dimension are 0 and~1, and valid array indices for the + second dimension are 0, 1 and~2." + +valid array row-major index + n. (of an array, which might have any number of dimensions_2) a + single fixnum suitable for use in naming any element of the array, + by viewing the array's storage as a linear series of elements in + row-major order. Such a fixnum must be greater than or equal to + zero, and less than the array total size of the array. + +valid fill pointer + n. (of an array) a fixnum suitable for use as a fill pointer for + the array. Such a fixnum must be greater than or equal to zero, + and less than or equal to the array total size of the array. + + [Editorial Note by KMP: The "valid pathname xxx" definitions were + taken from text found in make-pathname, but look wrong to me. I'll + fix them later.] + +valid logical pathname host + n. a string that has been defined as the name of a logical host. + See the function load-logical-pathname-translations. + +valid pathname device + n. a string, nil, :unspecific, or some other object defined by the + implementation to be a valid pathname device. + +valid pathname directory + n. a string, a list of strings, nil, + + :wild, + + :unspecific, or some other object defined by the implementation to + be a valid directory component. + +valid pathname host + n. a valid physical pathname host or a valid logical pathname + host. + +valid pathname name + n. a string, nil, :wild, :unspecific, or some other object defined + by the implementation to be a valid pathname name. + +valid pathname type + n. a string, nil, :wild, :unspecific. + +valid pathname version + n. a non-negative integer, or one of :wild, :newest, :unspecific, + or nil. The symbols :oldest, :previous, and :installed are + semi-standard special version symbols. + +valid physical pathname host + n. any of a string, a list of strings, or the symbol :unspecific, + that is recognized by the implementation as the name of a host. + +valid sequence index + n. (of a sequence) an integer suitable for use to name an element + of the sequence. Such an integer must be greater than or equal to + zero, and must be less than the length of the sequence. + + (If the sequence is an array, the valid sequence index is further + constrained to be a fixnum.) + +value + n. 1. a. one of possibly several objects that are the result of + an evaluation. b. (in a situation where exactly one value is + expected from the evaluation of a form) the primary value returned + by the form. c. (of forms in an implicit progn) one of possibly + several objects that result from the evaluation of the last form, + or nil if there are no forms. 2. an object associated with a name + in a binding. 3. (of a symbol) the value of the dynamic variable + named by that symbol. 4. an object associated with a key in an + association list, a property list, or a hash table. + +value cell + n. Trad. (of a symbol) The place which holds the value, if any, + of the dynamic variable named by that symbol, and which is accessed + by symbol-value. See cell. + +variable + n. a binding in which a symbol is the name used to refer to an + object. + +vector + n. a one-dimensional array. + +vertical-bar + n. the standard character that is called "vertical bar" (|). See + Figure~2-5. + +W +- + +whitespace + n. 1. one or more characters that are either the graphic + character #\Space or else non-graphic characters such as #\Newline + that only move the print position. 2. a. n. the syntax type of + a character that is a token separator. For details, see *note + Whitespace Characters::. b. adj. (of a character) having the + whitespace_{2a} syntax type_2. c. n. a whitespace_{2b} + character. + +wild + adj. 1. (of a namestring) using an implementation-defined syntax + for naming files, which might "match" any of possibly several + possible filenames, and which can therefore be used to refer to the + aggregate of the files named by those filenames. 2. (of a + pathname) a structured representation of a name which might "match" + any of possibly several pathnames, and which can therefore be used + to refer to the aggregate of the files named by those pathnames. + The set of wild pathnames includes, but is not restricted to, + pathnames which have a component which is :wild, or which have a + directory component which contains :wild or :wild-inferors. See + the function wild-pathname-p. + +write + v.t. + + 1. (a binding or slot or component) to change the value of the + binding or slot. + + 2. (an object to a stream) to output a representation of the + object to the stream. + +writer + n. a function that writes_1 a variable or slot. + +Y +- + +yield + v.t. (values) to produce the values as the result of evaluation. + "The form (+ 2 3) yields 5." + + +File: gcl.info, Node: Appendix, Prev: Glossary (Glossary), Up: Top + +27 Appendix +*********** + +* Menu: + +* Removed Language Features:: + + +File: gcl.info, Node: Removed Language Features, Prev: Appendix, Up: Appendix + +27.1 Removed Language Features +============================== + +* Menu: + +* Requirements for removed and deprecated features:: +* Removed Types:: +* Removed Operators:: +* Removed Argument Conventions:: +* Removed Variables:: +* Removed Reader Syntax:: +* Packages No Longer Required:: + + +File: gcl.info, Node: Requirements for removed and deprecated features, Next: Removed Types, Prev: Removed Language Features, Up: Removed Language Features + +27.1.1 Requirements for removed and deprecated features +------------------------------------------------------- + +For this standard, some features from the language described in Common +Lisp: The Language have been removed, and others have been deprecated +(and will most likely not appear in future Common Lisp standards). +Which features were removed and which were deprecated was decided on a +case-by-case basis by the X3J13 committee. + + Conforming implementations that wish to retain any removed features +for compatibility must assure that such compatibility does not interfere +with the correct function of conforming programs. For example, symbols +corresponding to the names of removed functions may not appear in the +the COMMON-LISP package. (Note, however, that this specification has +been devised in such a way that there can be a package named LISP which +can contain such symbols.) + + Conforming implementations must implement all deprecated features. +For a list of deprecated features, see *note Deprecated Language +Features::. + + +File: gcl.info, Node: Removed Types, Next: Removed Operators, Prev: Requirements for removed and deprecated features, Up: Removed Language Features + +27.1.2 Removed Types +-------------------- + +The type string-char was removed. + + +File: gcl.info, Node: Removed Operators, Next: Removed Argument Conventions, Prev: Removed Types, Up: Removed Language Features + +27.1.3 Removed Operators +------------------------ + +The functions + + int-char , char-bits , char-font , make-char , char-bit , +set-char-bit , string-char-p , + + and commonp + + were removed. + + The special operator compiler-let was removed. + + +File: gcl.info, Node: Removed Argument Conventions, Next: Removed Variables, Prev: Removed Operators, Up: Removed Language Features + +27.1.4 Removed Argument Conventions +----------------------------------- + +The font argument to digit-char was removed. The bits and font +arguments to code-char + + were removed. + + +File: gcl.info, Node: Removed Variables, Next: Removed Reader Syntax, Prev: Removed Argument Conventions, Up: Removed Language Features + +27.1.5 Removed Variables +------------------------ + +The variables + + char-font-limit , char-bits-limit , char-control-bit , char-meta-bit +, char-super-bit , char-hyper-bit , + + and *break-on-warnings* + + were removed. + + +File: gcl.info, Node: Removed Reader Syntax, Next: Packages No Longer Required, Prev: Removed Variables, Up: Removed Language Features + +27.1.6 Removed Reader Syntax +---------------------------- + +The "#," reader macro in standard syntax was removed. + + +File: gcl.info, Node: Packages No Longer Required, Prev: Removed Reader Syntax, Up: Removed Language Features + +27.1.7 Packages No Longer Required +---------------------------------- + +The packages LISP , USER , and SYSTEM + + are no longer required. It is valid for packages with one or more of +these names to be provided by a conforming implementation as extensions. + diff --git a/info/gcl.pdf b/info/gcl.pdf new file mode 100644 index 0000000000000000000000000000000000000000..0002601160fedbf3c3cc229c6c0f562ebc76878b GIT binary patch literal 2490109 zcma&NL$ENwvaPvo+qP}nwr$(CZQHhO+t$BrqtA=zh<-Qv4$iD*wX!C;zRXpm3L;{( zjC8C}q$l?`?@+7+3Ij*E4b|(MtrT;noAC-*E|BYN`1}4`3TW_kSrv1(YqThUdMtdnhq#=F} z+r+TeE0IV0_ zlLSn&xBJMCA`(o4WO?AW`debtSI~QCCJV;Sgfw2aACFVB)dx3Tb)Yt>gp~Q9pOua` zV2Fi0&djo11zat4=E=sxMde+Vol9OCi<}4~95r557gpjHvho$4=cwzt4x;@;45X?| z4~vVjad1BM$yf#kJjb&rvqOCVD!Aq2`LQU>O`p>fWkar9puJ|ys7zR=^RR*^((p1v zml*`T0N~?+*~y~S295&yjUg4BTpJJaV;ZEWPQ*bn1w~aDNZ71mpPv;K_4+OD+r`j* zZI<#)&v&=qy?4k&c-wHMd@D74okxYEdyY3IYn`~B5iT>mggiw{UC{Wyd7ZQlmO+j| zM^#1V`Wr7hlt;X5Z_imKE)E&he?#jld~n4sir%wU{j8~f#T!MynPzkc+V|&;7FC~- z+aw(CpXy1e`BY0!rt-61z_rCW@Ukdsc%XMtd&yq`FkF`v02D<0u3z7$3 zV^iEeAT7vi2`EAT~yY_mc6UB=P1JRQ6G=oYEdI-D;hMI6#(p|GjrknMXzk7d~j zg4e%Xhr`Za=(>#KmPD7GTD z^k29WV&qUUZZ#WFn)ECe*plTK9l;ub(CtD&fkmnIz7FudiZ`9w!_bD((W_Ucl8_}v$7i#(88MpKGC5&tr45+uKW{mTqlQ&K zK`c!Noi&pE66}$~8dvq@+2Zq%{k3qb5liE9-TUR2E$^r}UAJC$WFku(Uidw}?!Nwm zxo`IS`jx1Z#Oqv1Vr0G5kfOWA%hhSJPsSqn9jf~wo zIJ_^a%FpsUh_DB6Q~-XOfDJDL0}Mr`0Zajp93ZJUvfPm#vp#e%qdP>sfYL;Ju6S7^ zb||569OFJ9ic9MJ1yIHZw5p2tV4aIv9N}RX9Bit2Viqq<`_oaNP_=4+ABIK^$AQXs zQ+1VFMt;5+Iy0b@2`wzc)O>&w8KbL+Q-d%b9zp%btn3*04=_rzXMkKqfRIbM&&EnQZC5LkDxiF3fz z&n%BXVcox$zS-y!SHif=(j4AO*+Ufq1bol4aePq^4+KGc_YO<{L5yBXS1=vU>m7nQy5O) zWJd;ue%TzQ5fC{56dU4AnMvY`M~+n*(v1&Um=zq5u33J;xc7jzZ zs5lRU0PEoP-4%+qN*hXG~D3LAhq%5cE?6NU-? zIR;lDV|~E-ZdjedW+40Hm8CZ3_tDXd^?6qEf;sUxlfeV=FW>hd{pP_<=m1ye&2yc* z!#TVKSlcULvW<7#w*@tyK$>2U&9>`$t4LYN%?$@q`C1Y8uRD(U)r)t2Gz<&_iXF!u zHai+Orct0k%oi`-{nrC2AAd>XX0n@lzWc1@Rc^dXPlWBGGyu5B6>ZjX<3*whbUrHdP0S4lNe*?RxoR8v!kuagj45aq%6Xly^lF}{Ud`XSb z3Bn!o*_`-r6iK24v|n_k)p9_KN&c=09}w8_MsvElxCO9GzkgCeRknGK^tGiFIB~{A zQlUW@?sMod9?`?dfYIzKv>MJmgk&i_Pr9r-q!`54IWA>ExG2eMJ1{T2?_jC{slprc zU-MYTKF^oj;SFfkE#$UkN`m@{`vHtlx&;5=z7n*%yC_X0=-_LsaOG6zO`dTE_>^gC z1#L3bL$mZ-xv!cD^J2|eNi|NL$?vi9?i@TZWf*FH9odYDJJ zwRz4xSd0q->kp8MP@s0?r8SMZ*ZNV~{Leh7Bp*>P0=Q@kgt6BPkWaN20)NG}OReBWPsW7}xQw8sh#1FjhaxVPQqfE1k(unjWa0 zAg0ta8d#%hP?J&?YEJYeb^YUkwEd;!BuqYD*SWRT<0fb(JZacZ!%mtw7(JAH{Z0x5rC*1Agz2jwrxji{>8@!#} z{RPd`PV??cvmhnC_oS^YnZRg}$__n&f3UO>uE5}}`&`Sd5=XfM)Lk-l{)`u^ ztqNEmT)CS`Ma_#{k|e9DX9y)L2|-pco@cutuqVN}IHL2w(wm?*?FZLW0Z}v3I($*X zs5Or@%=}%jP$AKyr5twEAh!AfeS;pEM^U-@5mmstsDnk+nOQ0W0o{2ahm62ohm0^a zc|Pmv%PND~NwdS|_WicdxWoltlVi?b8S2m_KC! zd=E3Po5mXv5F~Bwlt7Yd>nKK*W8Gt2G8E{$3Lt%kr4?sI9l>BvI?T<)| z24~J|f+Gen+JsOtv|h3xJ}WkhTLZM*=pamWM^zI$Rbu`w-*;;ygq;~H(|{ug>Jc3_ zlL#8j87EO@N(1nI-bhbz+3-LGwb4+a6fom4Yq*&IBEtD@kuP-2oP(SW6}u}@{moR1 zT!7rGgBA(9VG^c#r3i!7tUJI%2?u9nxKZB414l`6zNrpba%4}YNut`rQ&C-}BtMX4a)$Vt9US!pFS zi7ltVsW~p#Uvbv(GUN; z`4}ZRO!CHBeg2ZT@>9qEBVbUi$7NursddMT4Y9ODd@X;V@aZy8}iVKAmuo7(LD7>!o}@`FYmsYH}&V>81v7&ifu?EqC_GMq~aESY3l z9Rj$Z1-g@dw8=XNx>7IqyiBh*zHjD+O26;$5?wRSWb1&5fQ23`2{v=~BiA+k_5;Hc_Xyvq3i(i}<;_du#9ijt|9XO7g#80o#9t1uU#g z{{suO{y!{G2ndsI%2wZNNn2kWa>_}~r9n6^9JQ2;;k<^NY$P3?u$R}J6&5yhClsVn zQ_olZSrxSX?T%ze{2s~X3Ea0(zG3J0+xWg$Zi*~!h?(+uI0m+5i(>a|W>8{F>VXLwu6wM{0fi1Xgg zBlTohsL?jcQf0v|n zOC~i;EYD_$GQ#@vCu-er#yXSi+l&)xe_6;sZV+9-r`BPtrG%5YD{qz2>GKN>f%ee<+!Ac1v#5PyTJ3i;914e6Q7pNk@Kz@?T* zrBdrVK3GKExF=B2F{=J??W z>*YyrF0;<-F@OtlaL_6r^v+qe^TcPglbvs6NeGJ~>S!4+JU=y-S74}Jcg??g%@aKt zLp61<+}dKB`B~g`gA?tS>i6O?>*(*GPhr|oOaX*Zf_K=s4eYQ0BPWhbeAxes3JMJU9R!2WqXU=XP;BARDG_-?(Sl zpnaJsE!Vo8&UOl-Sl+{*?S*|9C_XqFbOo+BavAl&t?5jDxukh7Jp*RP%}WAvxu%Kt zhqfA5{YP>TZFC3O*Mhe?#A|_g&$81|%`e&*WC_As2|I3nd{raS&SbdzD(qfk!ptBb zA09{?IV<99{qM@Vg&Xvp?f&WWQg{O8;%*T44*xy&CTTOSa`IOdr9}>mf#?ownE_Hj z3o*w!HR79s%pJC3Q&+fJQklM~TGp5vb9cA);&7_E?{JX`)yHl#MBA@alesr#N6+b) zRx`AAX0It_F#G$IW)?`9{j9B#=3L9}tQg?P2|7(j8`HZjFpv8hR@S|TdDY?i;4FtO z*A{tXn&f@;vDf>1jydImkGpwTJEe#oly)18MfxslKm0RqhWLY8S|nmB-(A!Y5X`)4wgG8wiW|MPoaa#h3tSB=!;{c&D=Wpw*b#e zFIy@BP>*Vv1qAyP1G51FkJ*?Sj+K=bB`5|p)Bv8JS{M!?CbPU8Mr>B%vQW1S-4+p~ z{KUjYebuBL`p~>8w5@yYrqgyM>)`1VW#>xy{`K>6d6TohuuE>;>#2o&fPnret7~XL z7`+1Jp33LYIWSVF4Q>RF7?`Iu5VXgT5I0>kCLK#*i`(-^9uF5x!^_2hhKH*s+OJ?= z$#uY>-!F>pijQw@SjO}yf!yAY*S!s@;AktsoIi+fZO5yG;!N}Xg=1=nL;v$-+IU=# z1o^J&ps5L6%*v&X>a7lcb9&XpYK`P<5+Kgw;N21*K4y64I68!&_sSDuIG*>WYDoHZ zAg7ynCtM%Ve)2B%nG$6$!0y zr_lK=ck^!2FJTehr53AeK}+_&c9n&@)&?{r?Nt}#EteZlAyX6Q`&tX8Uj_5~sgP_r zWI{NphRMN0*1PPDl_rw4j$*6m82E7x%YSO);GI%JW|?FVROTNzs7l1#IzWXJN>xS7 z;t&suH*A7_~{b__?W{G>-RlC!gSJ80e4hL`iXWlnf@vg zgrP`{w4iWw8tz?C&qAie9k7E^c-a4pRJ=h@F{^?Lr? zdny6O>tb^&LP^zuJs#-fhh@JG!ELVPr>8bsD=tG8X!t8WjICTM!<2bddizrPOgE|Q9N{J%p@cy&4@{v?{k8OefW&~D>ZToP+tZNFZ?Z`Ho2(CaiIuS z%J=OhZ6$`@?F73RUm3tq`P=!<-IXwJDySJJK_8Ds^M4-X`NTg^UOh{J8`T;Uohcil zcIwS+nv)g!@}ya0Cc)s}jOGTiV_B&o_+--k7LSv9q+EW-p^3>eZCy3B)acSd+7Q4& zcAD@Nxk5q9;0{9ajVaY6RWjp-^u-ERcN4zEDoly52^2zZf#=gK8{fWUln)HoRT-Yi z}s&x9hYG*aq*}|O83NntfCG% zu$Q;+);9K1Gz-eOS3Cz^UCtl2^S0wr{c7{bN_J4*VH_HF=A$w`N>u1z@}l>Q$qUO2 zbZ7%fY~U+tK038JAJ9iElE$<4OTC5S*HP+Ah(*KO96G^5iqntL4O{^ko&TMVvP;jZ zBI224Sr3Z&i7hMEmz2HVKywO+c>JXh4f;0v%j0_$xFHy{>* znK|6`qr%QLhXFA3j_lLgwUmHY!!_mBXFtMHt`^@a0F(aTqGyYeY#=j@5^B%cjUzC~ z6H16_seG|?-QyubPCt-fMHt9#ciz7#*4V>^wM6>zhnJM40}Z}XPS%(G8V#wGLJ;Lt zz4uyYv)+^?fr2bky+ek9H)y=+aWW+PAhHjZHJh@TVV3B0NZBNELnV*?92q~&RK!5f zajSUX=uo0{*qx9MaW=9?US{7g+`@WG_XP$2Cvc@P=i#UU?rW1Yt*m1v>dL%ypd4*O zy#_6O9cqDa-e0JT&AyD`hBRUr>aM`4VuAjDR#gb1II0BFGTi7qvuGYw#WBF%7x#_~ z@HCyn!V9&jkai~NG-2I;b{(bsdrF2dmi#jqZT#KWTyjDRKX<)1ju}(B@zD%ZN6Wp` zF+`*fU`j=8zuaFI8y@Cbj2LU=2>m^M-|v?%oNo-@7x@&)IaHuDR$1QO+p$bP25%~p zGG#Ix4}lg*@gH|qp2)^&Gx!Zy!TcohRYMe|n&H z^9A7h5RDEEnV&1stYB?rDShn)w51yAhH$H86M{tUwOiH88PuVe>QKtRbHPV6plxVJd`#q&nSdacbMs#?4TCvzK`C}TG3yD{tLzB*dij?Xt zhmFqrH4;8`+Fg4a|KjrZ!VPt)L2L4@_!u5ko&YCF$&PNzKh%(h9{~LJ+jE%UqBpv4 z%yaAQ_LyIyc_j>(Yt%ibloev4X+ku-0Ha*OBnc_0kXmdx7VY1&;@0uAN%VH)N+D7( zmdQ~FsYe#z7tRwkpQsMpgVd8t0yXw>p>XC0GVi1Jo=L!A1IyNl0=gJ)BVT>@Hw1V27;nbSlPt> zQ8XrVlsSUui@xm$;gMkez{e2kJ5?F4D}D#=iaTV@Zf#F7nv6B%i=mB1M~`v0xwXJp z`wLzNOeCX%uk)i=U}CD&N|BD7a%u69+B>53H0D}{{5em|XB+Q3%Yx{YETDqh$H~j| zych+y>fi_0=~5`K_C6njo8MEf+fJR0N>*CX3;~^2qs$c8LZZEQ9D@v27rdrfA zAB5Ysr^oSB)oTC%UneAQ>QL=W=%@@fO!^aOSHDZCaXRc`&AKu{#|1(FDX~F$NNuFb zYamXSCO1ElZD1(HE29a3qEQGp#t!=RFZ7*#VOJ=@bK3`y{FROx))OtxZPrX4ri% zEJ{gf5iqr;5_Ar&ZGu(bm-_Q;!APbwO9t__i_o%v*RtqD^P;M|3}R1t=(JlmBIUgD ziOF&9I~*wZ(=vp+URp>6%Th}eH|ih2sCT4;3LbmF$A8p_axM6>Ia?AmbNZJNMyuoH zceJGMzw!Me{|A0bm{$6~5FF=!MQ}`v|AXK{F*lt~+8%iI8SM{MEG>dS>fbGU#cMRK zc570as+%NHMTD52A2SkiQcuHuygz}$R}`|7s>&8E0Aj`VcfQSw*#N&QWwD0*8z{48 z;oYvSLi(J?3_xnac8{N6H+E{!ei$}aKyu{+cr!$@)Io9^Z`?lZ8EUVn+LDF6z;8>p#zHD~C9#Lu?iKnvK41*+tM`Qu^S-nMshJoq(_b^zDWR40s{PZQmB zc;wK$M%B??JEn{dTX+?Q26O$|&Y z?#Z&^{M^vNroKga2)DfM>F?_@3L1Vbs?gR~Nm+x9@jvShPi&8^yjWb)^DJg8J%UV> zU1EMjcxTh{oF!k6Bwcv0Y}C6{?ydOz66dJ!FY*SB!pc>c7oa>Sc^Ia7{Aca7Wp?iv zzT>Tqz4LgLhGG%09pZVNnTFo~O}D?1btt|-8-}IhQZ;_5u?<>1V!4V(b5R(GK03Ut z5d!cCeY`_`I_2t4;xA-QKE+J@3-%5KlMs6hQ;B7CKZ~)7v36F~+GD-QI-{x``~Ed@ z;SD}~iO-G0Q=~HyPjK66sl5UbGT2`;(Hp$%on(t8lZ9k?`eWt2b?^RYF$d>*vAMtL zMH|(QKmrY4n7MXk-aBpSN_zLJr_B8C9nI=GA0hbCz!YK!oDz3cOS|A6Mv zb&^J(Z+;@;1*ShNy(9`)mdZDL*LJ|cMd-!x@=nK7p{0;IHVKY!>yE^l)v`nniVK16 zmm_xcRVLa^6952#ytg|Tg^xCs*_NMMBd6S#AQwpfYzm>nZa^}71iQXtkMyOPB6sVa zUfPU(JhvQc`SuZuc<4tT%dfU5{RXFcQ7ti9IG;AOx=aBQdmde0nNPlX^x${9wHuGx zQKx6qC_s*OSVYW$)TjWdg!?y_VoC0mBB2rB>ddPZz2tc$K5wj&L8;Flt$42o{28jk zxgQaXF!IW&@BmrcWCGKTRzQ8DaHB0&1Uo}EEJ>QE;DcbmpQB4D&sjS@Ilp(64PWrw zcMTAX9=v>lS1dup?0C!gpuv{O9-&N0)e#J)D4Y@ysiH(!fC0Zs(2_*0>d#ROzy*Cp zG(oYTE83ZXhcGWU-g0f>)gapbLCo>E*e2u2#nfcA-ePIFDQChZpF3qx1GAiB1&`q9PHl(bv$USB6NvlzCisTbO?Iq$KJ&}~dl;^k z3QVk!1%1>D)u*FY9A6?%d4D*Ru@pO0cjs>U z7Ql^yGkn31S>6|qdZ3zoukTK7Jn#@RJ3(`{2ecWoBfs9hj>Aj8@++xbS%z1oG9V>rH^AR1Kjps&~sZ=H#a{l)Y-Kik#9pN z7X%%n-TWySXKSteh|8~F+C+$+m0HDMC)9!K|i^BU;v>U}C zQt?MOcSbZq7e)vZ`^kzSAI~G;6@H%x?8`nr!u;~&U2!2z)I4& zb-)bud&i`$)}3x8SGsTgq`zhc6r4;>aE~eS0A#0?KarjPO6487`=^p=r5{sW@7LFR zmd-IAMJWq1v1(YNw)HiLcE+NSSDYdON=GqdjJ5&Dn&LVSnP=}iYReai8Q6XYlgiR# zB1*^+FGnU>08OcgOC(8R5S5+90W3OXfGHW4Eb*V6_f)v=s#0ox$=sEaGtF9Mbys3T zYdj2uvjkkKf-lvF0FB~T)qu)Bq77Y?`ogO>Vg}Z+Szpy|HT^QiLdfKZ?HqyEShjM% zy|b0NSxIjNYfQ(2Z&TN^fkYiBj3RITO;xyu5`j4?ZUy6o4+)x1&mId%<-@%Po|Gh0 z+sq0!UiMpOb+gy91bSuyUT!66B%lf0vv=HL!B7QFjrLAj{L|%VAc^@#H}GMw={qn1 z-Y*w~TCPNDb!0Uqz%-va6-xqJ$g5@v+*%fY-42Bd5~7a8XQZJSbxn~OO8${`m|plF zJf--`%0#DbB!5j&K#$-eg&|OpXGdDUgI#C+&`g);3n;*pyzSgah%c^+12bQ3%#L^B`=f#8Vzzr+=AlTd)KZ8>1 z-SiUb4)Q1noG@!r@^dw&8N3VAp`Fv@607v!Q;LqE6~XnqI(DjgfHNS8VNo~%1eo{lzoDck&*ZN3UO1sXvO zBhni}=KL>cA`Xt+6uT(5T@>o^2-$(s`{pcHZ1s@Qgl=Og3R%J_h#f%{! z?>HSt-y{cp;Uy zr%AG2sF7`+1FchGNV1p^)`dV0EDmy`lx59ejK|xEiRDv7njw-qz(vMGg8)E#it8zc z@_isYz1u&&@_)gT-*$@s|3t&|Uq#iJI2btp@14}B)~@q*2crL-eqp;(E(D3*j8FFd>t6l!_#k`Tp#){T&@z0Yz$4a^^^$2@OJi^zOc2Qu3e7J4uMY zPZ8)hJo$&y1rKuzS;g5|-t0M-q9EiPU3QLwpqQ~IuTCmia|=z) z7TlNh{PA0i$P7qY^5(p$8|b4X&6Kj3a0bYe0b_3KyWC=gvNAb_`iSjXM!PC3In*T4 z!t}%44YMRj%AF9`Q_AdkTQXE=RCniSMau>e?;$=Nej3Hw32)RDQ)vK7DxwXh?V|JD z(b4Yd&5z9&)Y*<9RZTw7`)_ZoaltkQ{2N-)hM?CA*5VAx()=#-XV^EN>#X74jAVTv zcl7|{x{L@SZkI6iRK@~xJ1m>3g6e%^-9fDQFvwQzyC)r56rtb*hXIGwrJe`9)d_4U<~z8K<3= zic?bB5k~pl28RS;x)6-qqb$>CAC<~Z;2V)qvB?O{D^tyD9jOA5k1DpxLF!Q9X7fAd z7P{I^aB8Fn?Dm&ynh9e*V4@XH{G*pBTxB0SNZF|@@E%Fos_kXx6dFNAtfFd3W3LI~ zzNG!YWqEKZh@Suo;u=Z?=EHF@2m1BgUUiprPvesmqsP~+Wop$A^~X4JdhKiYo4%G@ zm6WeBm6a+^`Anix4H-}7&Hn)8W?gb%OrH-eAmZZZz;BdmNld9!=q++OB{CtB9Sw{1 zH<8$k%qeW3`?JgdityY!ct$xcO>u4y!zRi_hKBDsCvoh~Oo)VGD;BijoQnev<766) zr2!8&ciaznbK?#RDY=QgPA0sn;KC$>k66)DL1~3eTE%=&=Y%pR#^pJ7#R3H(3Woy2PjU^HrR4N@) zBSgB4%LSbsG)%-V2dSp_6L}A$|^XF-v7c0}SVB(gns2&dVJ!1mZxlVjrF$Tp1-~U>7lNm)#mb zaL&lIxn8b65IWzke=A+YoXI*oB*QBKBLCr$NOcB_M80EUnI~))ON4k7oj<4(GXlOx z0U|x1Ol=f43KH=VB8|g=m6Idolb*fqoK{hQd%oWmLQ%Z*Y+`iP>VjUVCUtP0?b)T( zcmHIIQ9{2AL`db{hTCQ^;o6Ss&BtsV)3broulu@?_&`b+or1rci|4V_W7#G2kW_@i zfuFgupR7B9uXu4ojhuU~nXX*cXlidRg$+s&pB)+#8ZHr^gzxj1CVdU_?QFm-EK9P| zM0@Rh_f0i&hq&|^t3o@tmN`^Uy)Hm4 zuDNSUJ)z`3w4fj~rqv09$L_%WaFaXaS3c-vKS~&v!tEMV##md8r>X*#0J&Off>bO> zi?!cM^~i543ni|j6{mq%=M~;e6PVD+CVK03fmjadxL{5>J{I7l1CtU@+M&g7Ez|v< zVv6~6>cCf}mo;`32W<_$R?Gg}q&}PXvz;Mtp1ZaB>?PXFBF}<}*e>~XO%+DM$kj*I ztmF~1g^LP*8g0R$k~Hmk>3{ECKQ+ipj1KWorI8@Wz~ku8d<>Y6|D1gkxms|@M~!Ub zpP`F#vpVF>|G3)-73h0#6a1qX9|ve{&fXJrm@#nbu|po@1n{bE0&w!s%a~$m1qO$$ zb`=)e?ONNpwZP{k%z4WJtklo>+t+@ejlt$-2h(&jb2BD~q1SCp@4$u&qO zjb_7NN$J7Y+KYA#mofZB=^K6ZD4=`;H2(yuU)*8dxk<(Ai2nb!|fTlI?%k)>gd=H0> z4qYKl-{@e_RSPx@=ef`)b8imF&!yg3Kcz5fF|y>LkT(!{Yn%9+xHtv7Hr&zEoZNXI z-HhGe>q{6svvtT&q*+3F3Uw3}>i=P|_{SMSApPNfl;GcsA3mgN-tYp4S%f3paQs<# zGlR6P=y0QFcLutJw6w42;;8VSV46COsl$jxa{iUP?A^P=LC&J2_^7Dhpq-%<`)i)A zVa%~IZ~I*WXF2Bm{9HVW!bHPFNpL$DPsbx#VL>OEG!L zu7BPEXk2}z!hwJO97;nd4eaZO(KN8fid_On>1+o6*vn_VJgwB(=Mhm)}{Bd z2B-p-NjC-8pVTZR;9Li+pB_6YM)2H|{~CVl;cyy|0KlU!DglrJm!Cu;*L0w79KMGW z1UfUq+N|Y8hMr`cF~4b*`;1-fY0_@;V*NQ%Tck8c?KzSgayrhfWL{p=kTu_c`RfO|!~RM0hIWv5x^1kpsN_Pr0yLG_+X1x+r+& zLj_tHhW|UkrIoVQ45j0}|3bCK6;*C)`rg)ff;o$=`0TOkT^|AVCSzO6N7X)abp=b5 z{UOY19kqMSO})Eyn!1}(n)Y!3D$HlZg+VLTq|Un(3f-@a^|d+^F%a?r{P2kL-Ro;5 z%Ee0s#7F^yCpOOCCtl_s985I~+?*n5@j<<1#Jyt}g^6U7>K?^PT#XkR6kuD}?*8gFjYc*~EkA42# z(=W{QqgZ7`1OnNAluf%?;oB_N=$m%EbOS3xh=dibB1s)%&isA7H4=n;WIX3MmLvlT z9Nlj2p1&n3{)>612;lcgfq2J`d7Qm?wtGGkit!j|A~-JYjwjBG^O#`DjJr+yyDzhD zy>VfF9cFlb-)^KYeWt5!l<29e9OwI{bN5tVS$)rUS0|=4LYu^38=Or1=k1Kxb@kO7 zL(iP%WJ&U8MOsRYNlJs)NN^x_^7#FY(-u!;zgTHinMLaBTZ3&gvS+DSd6vjUKc(d= z+WL5IjOgtO2rkzPH(tVS8D-bIsGGPg8(&9nG?&DH`|%YkZ=i+cnVda(n*EEwh%9fFD1jlUKS38R)Lrs=Ii@C7b^u{++t#S@~2)>7=T}uM>;KqM$Cir!{G% zs-ney<2RU-$amX|{iBcc`Na|1nl1lkOdU#Y5bVWp|0&cU5MiEzz<~uZJhBMjhY4#? zterhwx<@1qta%mt5!dUfT#wbd86YO%R93YrSNq%mhD27{ke#;>b-U-LJ(s+4u8EfO ze80>C{wp{$Or9}KICJxcc;W={h(L%AcLGE(|86ZPmsghEWYON>mF3m`S#0N$dYrp7 z)2$|E0`87EkQ5#is_8PI1UA&IjV|WO@TKNYr{$o>jO69+fvW4$wNo)Ain?5D?3R1Hl}K-8Rbs)#HWZ zNI&lHvK@5lpPQ9eiYGp#t+nV=8`Cf~n<}ec-Mz*ZYb^+k__2i8=jIHq*DTq)dA;CJ zXgT-jT8Fiu0+tPVV2d|Blbu-`fYFG5GIgWHYmjd!Ol<7~h^?yo(T{$x7d6+dtNjae zEg3=ck1ywT8P1Sa84Wb^YL_s`ub|pNBbg@x^J0`L*+2bjCT1PNzRF{EyT4@v zng3jn$&k=}L&7A{UA3NC>y|4YXvSLS01nUu7xhA-oTvmMtT;~iFiD~M!MLlhFN&)xKxZUj`GtkorNr}Cx zn(%Y@HZ3$3DgnnYz8jOTVSKgj+SOb(p&w}~pqA7wLY>Z0ScI8j9HJT4kry4_b~ZU; zlA&?>*WN)pEkcg~gM<_8U(}U*rh6Ge`g~|?MFoK~i_~>YkPv3Ud_Wn|-97?t?Fb0D zoaI*UDp19WnGg@C?8CK$vYH^6Q8pt$_@3~Fe`;RQV=#?u2KK$ZtZE zQLJ+0UdRlY#7GLo7HclVCyaQH6&A036cv42*cCvyzO0|>txNQNAgK%nhb@4j@d^vW zt}AV^I8-xLgW)jB(bUKr2;#TSx{eodAO3gIsi!Q6p0?%NL=+d%G zKWPSuj=mXP5#_iDCq|QsKG4fd{+YxpzCVWhzzYsdY{1S2MNfeydhT^?gN-9~u( z*8@9-fWT>d=PC6216(v;A}LD${nUG7ywCH)IIGmu5`#+}qQo7!HuwQhLJ^~ug`SH_ zMu?zEbSe(@m#gR~&eYx|?PyV1v1CHSrs$htm7;G!lXo}N?;gVouwc~Eh&j?Ox_AZN zd*G;00#fhO-&JP|VMsBrD8mc`Vu60uT_Gc-daI`>W2n>F%G232_KmfQL=+e*T@psmt!e7)(0K>X zMlFV| zZ$t~n{0ME%>l_O3hL(#~`mkl({@u-Gb3E!!B&s1$W~1UbpUR4uiKH=EZU9%X4Kh|h za{*dN*hC0eiZ+j38`)9IsGV`S8i_e`VxPv~*eFNfN)Ho!_E{>#i0#NDc-0>2YR~fk ztIAVQQ1UyZB6#Jzr^f{SNc*MUWYLLfOv6S+)3wUSqO7w*^D|i62CLOfupY8?Uqq(t-W7Go?bj07ZNT&=)L&o%ye%)Xd7$up6YK?K5Zcf?`81Qy&#@X0~PpN zaZ}kWai8c@EOGxbS!0ujl`TrW>O~ftgK|)e*`~1Z2F5&Fhj3!}yo&iT9rpC8L=n9? zHCV@E%8xc&>s^7&H)$7gjC39>FwV>jdP+q2aNc&Kb{0m5L}zw_q%T--zgt$jGS*=CwDDCv0grR zFMjj?Nbm-cK*( zt$OULswx|4zxShVC5r8{X4#~Ed@5XeBa!;q%lmpv@Q?w~nTDdI!z(V<7o zu%{>di|vKUE{o{1x|+AqUBdU$OaY@KZnK3K7k6{#9N}Fb!*10@ZOgC9)H&*>Mx*Gl z3)YdW?LsCkj@;V|#vHbHmR0Jvr}B7Ryu_13d;9Sxt59(0egsnoNnr3o2I5Z1kOB{u zBnb^j!mBxZC1HT-*?B;`0(lD3ng6npq<|(vQxnLfZnK+g5*C#e?;__*6-I~)OOh1^ zAhdc-&^K+e4gD>`@?Pa_?&fF@y*u5%_3fB$*+(d(1m62E!_PZ=cS_8#lYUutMSo~| zNecQj5odsBQD1zQ)x`YbI^P=$&0=6$)l&6{`N6hsyuFJB@v$JMkn|VFbpp30m5d!( zytr6$%gjnuWj{kuLw9Xv*BYR8hw1Pf8nXQ;v+I;^hRI^T4VqJVUjKX-j;n%ZpfC>r zqhTH2Vw0swh@2HkBuda1QexoZLo(plsn6&m#JpZ0<(FO~jH{h{mtE^B_ho|Y{xxk) z0l@!t?xl;mJG58#!ii~_5(wEv^x9GFqNgU7%EZzfHseDM=cSU#;m3=8XtlZtv+uZi zYU6kh%pl#JJj8%k z8VLAif$=<0VMqdvy>lpet?%JezsFuJkrcWzk&J{~s}?nq z%tRoXUjQC4c3!q%FGD{WhbaWSmF)#KMv=5+fR!;)MRg&wZv?js$3_}la~`yr#q9Ui zC3Y;;H3$IKE(^B5R=GCi6ff%28mWx_G5|rm-6iPjbKfn%63}F#R}(Z-bEzJ_>o(%6 z)YsAj@prpBm?p|BVn-V5qn372-zIPyz721+}V&Z&n5nBZ+*~R$b1)^T6 z2CUzF7SS|X-lOn)0*AXk?+xa`I32x*z-~0J6AC!t%cw=f7y;#!4CAt-!@H#Z@}LwT z9#$`T$zh4RnZ3bVoNfU8<7q2%Rfz;f97j{mQ&L9(M-t-HasebjFfH^q$1}pxvXNu@ zThOQ|c6@qAN@;DPrhb{60NLJ+AnX96Xs;eT>m~*eVs>e{Hz~1ctAOm?U3{%mtHveZ z0z~ZiNTAnHXDbRAx6z)>T%14fJ{#f=@WNgM42n^s|AnvSe;NbYfwPhy@p}`vTgLEK zUcyldN`@oQ(|Z)nfvu9{XfE&b`@7x!s=l$eulLtiW_^!$Q7L}G$sd@kU7Run*jua% zeM<<)?h=WQYY-2K1&lg9io5o^Sicn$68;A>%Rw`8lA7JlgC>|Y#Y(~xk4vxPax0hg zl$=Bpk=gy&;FbqHNIYl#w9NkL=RuhT$bcz6)O;JDzD1`L!)Co{i-EM)lHwdIA2tq#8FN5_@!Hlx6V7K$M1ft9!$^1MJXr$LJ2 zL&F;6vC;bC4(GxwSswtw{%Z7wdR&;R7eHVu{#|4HR8viDai7Iuc9XZA*H#kv21_ks zfXgs}uF8ARv3uAuZNi*(QXoWvN-Av^l5j#nh^}m~t`H3bZMiv53=&?THLI+GM@q>Q zmD|^a$Ab`JKoP&kx9zc3N=#6wcPYb_&PGL82quJO6F6^Sq}5)9KDsK9uSbCOFx<{s zVl;y(ytfPXqE&ZZKoMYYQ86?@2;WzZ7zfljxE-2A@hN_T_Bf|`02(x5b9MwGPPJPm z8zjJ+{!aGeU@Zx;qs@v3#uE&HHIyP?G8}kE@r}p!;L4f>q64LsDT+Zlh*oVx0G!P` zz=UB1g)NQ7*tKw%B_eFww@Heie*SC929axLX^BS~hJ1X&90BqUK9<)=_X0n9waDl?^okAVj~Zb|{vkd5)S zAMRQ|rMDyl?vr^MG~BuRbr^3=ljXcc?Ppl|kdLq~p^SKD@XS(Ic+b+LGD5b(t;C_T zcenbt?w-De1NFOK%E_WtZ3lpvNppn3mbop5K#cH@mp&FbprBwCjEcf_(XHN=okgmk z=bM&IeErtKGs0B|oNu<9cpgPz3c%wQx%SA9 z@21KU5EwZf0nQ!do`EaesE|)rtY?^KGNhlu;20@go?|8!oh5AQTmhiGuq*uYi{r%d z;Jc`wqZ)mU?uq@VbDiGAQyu%VZW?2^>$cq;$C}B;(c@c9INpdFbrjnYyXvrsnrckN zpEtN~x>U5&PoY*7ktaeeN`2&Xu6EPradX3KvDwu(OKo$W>6@XtU@SM`@$u+WM zl|g;a9LV5+seQlFhcu&xYJ&xmK6%0(;PCP-$lx;XClw-QL|Hw8-=N`L4xTJdTIDVj zIZREaPgH=(0?~AMTuQ=Z<#%U7oQwh~Q6reZI>0k&4HvW<9PMq_$AyW;W*a#*cVC+5 z96S<@%zCG{pWGG;-Q9ZHKa9d`Ei1A7kyCyp9IqKK>427gm~Z6YNFenLBP`C4|KfK) zhvG;GlLG{i?T%_nNu1vyth@xCNGLCus(^{8f1dlty6dfRwA1t)k6h-!SV&U+iIw>W zWKHLvn?m3~qA8oJRyL?6fr@Az#hMpvwgLlS z7!j(e!;Fb$R{5C6Lj?WXiTUJc8Q{*K*bN{AH7~IclLxZO5uBVD+%k%SJHaiW;5ux2 ze>7p4c6TYyqZAI#cY$G7{M^U?0sPQ^ym|i8{C2x$y+d@2ap)mjaAp66DwUifQ8?W=s~gO$z=V;tZ8E~DlI1y6%`W^ zGoHSoqDSp-(OtZ1*dTs2+U3Qt>+__v9-|bF>)(!^%8cp^0=bO~uXj5)SMA;Ftm|PN z2u5Rh`V*yz^{Q!5_Qvg&&Wyp^2fupj>Rs%U_iw>!Ok{**nw2)e}ocI^24h5Aki- zx+9~OPFn{8^Y8e+rXM^!5Fm})mBa!5UVVKB?$0y!7o+~*K$dy{PqaYkMynNBjqAfO zT>>#Qw=}k1?dE8+cNlX4FYVibkA`#f&6k;~)7`M`=c}IA`1d~G=8|QcsgWf;?!>0x ze%V%CZzeNJ#2ithlS=(h^534C9yJjw^FQ{ehAd9S~;DUnTmSfeKAY2trak3i2V`>5`MO2ujU-{+6o^ zX}N02S4XDNEjpua#Y$u2F#>a0{hn>wHpYt2FF`+rYvr4#q`$A%l76BhUAT^4uZvdtv9fY%(72$vVlrlO)+3Qj3m0#_y!b zC169@jU7UMt8od5!muX>fU*Pl?G4A6lJ&@Gv+drt$nJ(`1ip8=*Yf*747w`Yf0VSq zGim%Coc;4`$XXc^k7o$kYKLQWD=j|u7o>6@0W)-w0ZA^g|DD5wgC=%H@$`KbiATId zdFfr&ZXzsEN_4OZ6f=i3rK27uhY2Ac-E^!w+exT&B2>cgZ+Xa@iG+OW(+JR1VcW*?hJ<<2I z=C?JKn+?eutHTFQa!Ocw<`_}M@SFmTYB7T)yM~j`vJy)e2n~Do@Sn@gY4V&0#VOr` zpuFc-;k3uvcLU&o7qYHi$i?1Ytg=gnYIeufqMjhi0TAwg)D+4XZrz&bDGHoLVNc(< zjX+Gcc{tjbRz_;dy3%EG>ng&nbZ`fI&{B_UQ%F|MzcTObeRryXGZfzz?BNcI8b&Wj z5`r|#qL54@N?sZaXa>qoPO=qdL^d|Z* zk2RpfIT2IsnMxwoej5fdmJ&T5wRbi3!)3YA{rgVYp6JeVR29ry(f#*OKaW4dlr|O2 z;D-u=e|ZK65t6Mx(mOR+*0O`@qL9u#$Y_>$i{(Y!;kFuo=PJGG3%pv6O=2Qi;mQi0`cR6;TEWYb4NM-nR=Zhre$z6C~eLs znK8;bBW-B|nk2YWvVk(_bBY0DdAULjmccghiu;78{7j|z3L3LOxx|GxACDm=ec2qR zL?jUB?kAzC&0e+tCSKZY2F#Nb0Qrw3Z79-*G_D@I5Oqge*M+xG=3{i~XTc~=k@LkB zj2EQv^OXzApIMLVf!Rhb7EuW2E#7gmx5FfJUVDUarG1nDl+T%*At!m|-#PpLv?0vk zr%O3r)&0Gw7sG+ZbuVWyA!mb+MLbB!}62aD7rxFUxDtRmN$PNz4FuGehF2WCpO|?QIc? zh_rgyiQ3__VjADE7&L7$a{GPtIjrLdNqgmtQ?Y)#e=0hk10W;glt?}t7Kmu}?x265 zsc&c>!{aYdtGLHCdI@39+^&Q@?IHBS0M$EZ?Cz^`&L*n~1)3%e{`-|;UI3UGwgSLB z9N*XOgBq^Alj6pL7UczXhhEP1CC+ct?o(i;ks|ZwMg5q;j7Spc#xx<@ym#ZEa#mR(clwk_is zWr?&K%}ISx8B|1~x{y_hMp;~_`iM!+x8jO!L?hi)N49QbWYMR@=&&2IWO9RV033^1fNnslky9^A zq;5uNkP&bp+ryde&)lJm?jZcD0x2b_3WyamC8>$jinMhB z?_FYu2ljRV&o{y&%99Qtoe%ncY>tvqARJ~N@≪SPB5KWPs6kdmDHF4mX|n*o^mq zU-AIsBaps&7`FVg8Hk{(78eEGgOjSD89V4?VX*s0C7yvnQlX;T?*1HoY( zwK<{Y=D|n})Hjo|;K*+Qvw0SxyN2rmaTEO-7iFAy|td9uIk1zIb!a0=7rZxG7{ zZRZ2E^n`v-u(7J6D}axmjS}_aAL^U{MZj_5{rE2@TJ6S=i2O^P$Y=40Gh6pZ%tlUY zpSOZ)ZzIqImzozLX^htn3CZX6t9Uwydj;Eci|)@%cp)}dXOe=Zh;VR8SuzU{;IUym z`MWw=3YE^5xji_0YPV1-dW=2cIkKQ?OoZoH@J5BV2 zVQm&`vZ8&Z9nX5~n50-JsU8~aO}l#RMU&ct_>`rUSHGUlt~wd`AdVWc&N35kCT+JbBS?NACu zDH3D-V$i=PJkHcp!y+`r13pX)i)M>ecKWQMvBV#q_9Twhp{pzA3|1xW%5Ak(H|}Z( z*}2WG%w<*og!65J#Im)GO{${5a^b>NO7{F<^-Y!E*)kgV%?2Fy3C)u@q~t;+MQ-b# zm^0BdU;wz>g$RJe#kz{doRXv(Hj=n=OG49-awFCn!Y~6I-5O>z&7LdE;U5L+1PP-8 zYf>QVn~e^;SP8tU6FhaTjBHMCO#_*478UqQlE|oyEx?679S9$A#D_7XUBN zbSCHL@&c^JrFoy%n_2Rkq==zWzOGOIJ7>hAaS+5v{ohf9;jO!{$GExA0{WD`?tWvr z2N^jX!=RcwpU!3u_B0cpt#~a<8%>Msu-CM;Pd_7^kJO#TJ5rdz0E=?f!HDPbrxgC} z816W|=ZOttq;t30I#sm3x@LFeQOCa+d4D>nI?NYk{mo{^>M|YS2HHKC8(Q;(v?@jg z?j7nR!>PDhi-%!bIbw4Az19Vbl@Sb-_oBBIcTi3YVQ097OSj>=oli!St1oY=I^3kc zG|Pa?w_xprmbG|=%8Fw4qmL}!Mpp4*cWGz^HJ2F!u5egS!AhKg&309^K1@4P==K+= zOoV81`+lOmz+|qsJ6t;C6dc^~X8I!%19%}?_d3DGP@c>FMjP_Di^-3KNZX&hmY>mH zM^9f%OW^zSB z2AGXJ*6A&*o{4@Lc^U4Va%O|mK5KPwx4!Y3Y1Lhvm_f%Mv2z$J>ohv4KiLiWv(njXu?KkW`6PD|mG}-#h9Jr{o^#)W z%M48kOY^Sn=8jt<-z=!4iH8>o&uCwZU2VGhtTFyZ9p0dV1EmS(PbHt@MFvwfG&w{t7NmyVCRn?rxV8O%We$CN`h zt+x`#ykGG?i%RANUpsLkLl((#Ejco(xox4^LXH+epOCe34|a7q(3^Ezclw=5r42}; zj|{pS#UN$9bNgze08J3?j_5PJk;+OQOxY9I4}f;UC?)bht6VAhl=<f{24~W$OU>MB9sg8&nXx1@Z zXz>8X54-W9ZHlU(Pk$?HQR}0-6Eu=CF~^tltLScC={iP)1mzfV0m~dO(%5322#6-9 zTzmaB&f2ile41E|!drnHYs34iP(A;+m;L%2`pIv|DrtaAf%%>-{=JlX#q7R>w-Zx_e@12lSGc}2lQ4NPFfv6Gg78OQr0mk z^GNcz;Q}fwGFuCd=I1=4(jAN1Y6W2}%sT zi)CDs06ve~WsGK|)vx@c(AtGT03ZoDKk!Nr9W`J&WSGVa0JWk3K51{Xg4{2x;M$!o zpmFR{-m+`B31Ij@G8b|s=(3ftu%ENKZv>h~bnvP=)7$M_G-)vPA#-#tyhvqZIr!p_ zV@1cc$~|bf=+Si-NV$T64(e}lN)BGG#{j#$dIq% zZ`%_ZjuNxS%LEyLBZw#;?sR${alM`|rD}}clB-nu{kt}B)%bV*_V`z;F`;?pOfFAv zOPNtuirO_S%f8p19rtj+)o9x{tt5UKb~BEM@UvQ{iV3gQu;0)AK zl}YJgMd;}REtH$3%gB+JaWE+6rsGE!i8`Y7rWdJ0rcVYAX(0NCskgTzkRUT8b^2Gd z;Zzw_H^a@iRN@e4rCA7D6u*ng&0>mIgJZh*1ujn$2i7|r78AAA1v?G3aU!yaRzrt(x^Rn`zu7!=tYV-yu=^RJRMk;R}-_TOSLEYBaQU~9SF03@! zio?n**j#o=5(>UpS(``cUIzWBVugOSeSe9S*ZVzSVdqd&`{r(xqa824K-HzU)~zCe zw-+r}J4pkJHf7!qx}8LX&c)~pWN9)fv{XUqoikcZlwRf=r2j&}k;owhw%YPc*BioU zV;u|=#9Lv=&en8^&E3|$BJ0(G$G8}(+S_4T!64&Rnn(h|vU()>Doj~%75=V$N-wqd;7Hrmd}(NJ9%qB+8q8R!w2416Xt!mPRC58NCwYfJpBRjt+=%DUmT~6Z^FlY0 z78{oKH3bgDWowm9&kO|Z>TDaFCFC*+i`!+0VD81&Rr@nO3X4fj8Rlnk=DFPKtlRpu za*T-=+C>QlYm9iF$OpraP^t{DKGyBCXp?2Q-}u3O)Ak;Or$s+#)c^B5Ha~p^EhMsJ zWt_1_LsH2j9-8hJx&=nwB~+U%$uW)k>L1JBN&;2L_9LmHa^fXGinLf3 zZ93KgqP*^n(BUHuA^H0aWRmV8J^`=EWx!KJZAHVu98p8Vi_b1+1FuyTN)xfUSg&c$ zv{1q!bbSKoI}&h{Vl2pBFX*kz!ITj5+BLiT2{#tCU@ZZO;p196_iDS@DM$`U zWU)S00lOaC>%E40r&YkyNaffFQEsvT5!<mYob ziLE>>3dTdO5aP8ALO_su(7pC`_3qIc4&=;Cz=uMwUh-Lx@bNN^lu;7g)O5^j%ugQ^ zWp}waVnyL9edu@Oqd}v25 z1(FCIyUhTr;QOyqB(&`|seOjDjjVIJVM;!I)4bR>G??*KH$n ze1HvZ_8;RnBYKY~Jh6R;f}pbF!v`Q_AZ7PNp8jR&ff;`uuwf16X3_hzFiF6V=W@4F zml^heE(?wIijVSae5s{6Vt2aUF5~_E`h{{(-)679?tPdy9(p9JyIeYe%$P`3 zea;c{O{k*khZ|+gdCiY?xS@|8MKXh>me{+vu%!A{UFFbn{uKB9f%ir^6yz|J4M97)meJR6J}{gBVTlC1n74ygo?Yb zbw{a=2gno?_N7`K6(B5Hq4DQvsd;kM`O5@4GJ@U%i*ywbV4t<^#KD1q+DdX|GuXu6 zrI&TIhNu2I^=lNEMJH=^mn)ulleiIE5AoHA7tA9QvM0Dj=jHp2$ijhBQa6CK9vnL ztVuOG+{SmSIuB_7FdGSY4p2Lf-UB#~E7#cK%09$ZU9ZWhs3k<`AYIL_hN;H^?I0Z_AOKMch z&$aR66aNR;YCW;=e=9DQ|HwOIW@Kjg?~1EhOW%2`*W%8%ag&ubZu!e~{o3-ScKTh&>~Y!9{LdmG8DS4NRI&MOVe8u|>6=+Iw@scD;Yup#Z|<)_}Whjg{A$r!a`lRheFD zO>cJp+GshQ{nUZ1Rh;eiV+D=dtw%zc^S7R?NVl=^rbNG2YLrPT#VB*aJjQt+PWR>| zRTn{de;;UwLdgrx=2cXm&GmF#RwPfVEaYjRJD_?W0u)aW(0?A7I>A&?wW-9ON0D`& zcs3I-6G_#;4tG;FAl3}oYMp$uX)(LimV8e zDu&Z^U@P{~3MN4Mqm%HepY{`n6xq}M3MGDx>tQ}RqitcTqcKl%b2lhyw5RF{8(E?V zb7c@yA07%uLnAoBF2Jg-4RoD;X4wy^IZV9umPyQI;s7Tm4#)IFtJ ziUAkAc41eF%41Q7=sCI^s2v^Pu|H2rwJz|a*ioD*sq$Sk(ltytc{{pRy$M6}?o5vo z*mY%d(`-%Gj#7d{c(>Dw`SD&)|#LEoJAxr_;AtPUBmthx(=<%o*WJQ9-9f}W7z1$6x5r+LfEh1Y#!q65!gxE3g( zLDHSVb(kb-Z{w-e(JeLtG+gQAZ{V?k-|$!dmqXI+0eLbwE6`8F(ejL(=SLL8ORd^= z-MBbh=H>lFV^C;!6KimKx#k9nez~OI`Z8D4oK~zOu|}0Fc_g`>oWD>(Fce~Yq@ka_ z+AF?o?^G}y@z)HInC6~6JpNah-y&V0HWq{&CI|^;a`uq2s|2mc^cb^Ac_K3@ln}Gf zgqkz*SYFGNO55nz?< z0J&}s!4a}531KoSzA_U}`bSV4m8N6TG07-Nc!4n?{fvYi#_brOLx+X~CCn7aE?0C(G+?(^~y z1Q=bW@+xI2KxeV;D3{echTwsbhId6|z0R3v6TI|LQo4@qdBK(Ma#hv4;^+lCm#?Q6 z^3$7SI#B>LN-lUp53B3n*o5ySIl@a8ut2$P3I75G6Z(iiyZ@s%MS*pUCP9892MvL> z4+*m9jK?qsWaw)!X7FVH3akgr99^VS6o9MCm;O`-=z-D~Unv$KAYf4FBT?2E$?0#; zBVkKPvGm__i|X`pnnz9*f9U?Lrq+-H*8{|w1~=E;?4hVqAjdYlQDvTqH33*v0vjSe zPArtIck%$UN~1O(c$(AoErmc)6BVyg0@$u`$V9?xFXusxGzA+*hEIGGmEkzdcs(gR zDeI#$=YjNlxOOI@09t$5fh-TR%8(nxzAesXf?%3G-s@$ATEjEUlo_QwepD|1-9zrH zNW&gRiQ+EUWR0H8HBI*DbOBYA9rri~5ZT|4?alH1IqbB3H1~HN;)*aut4JshIJvhC z$f?y@P3-H;k9wJb*S#C+*Nz}||JgIUpn@_fz+W8Ikf1kW8G%NN_Mie|!46tHg&!3% zit;R#!I*uZ7wk3<23WEL%+VDQ1(1*iA>Kt%Mb{A|XgH{gfeYuQ=fS~I!q`AvGXnT) z2;DcvuWty*_B&kTwYo2@`z%|W52vbsqk9kIZl5LY1Z%a~RwgMydG7%qKvYrP{xKZN zyv2cbU6_WEq#OG}6JAChS9wlZ2&RqdXI1BwQyOF^D-RT?yZAAR(Ep{Q{8>3y1*j8J ziu+PR;PVbRVmFD8xld9(5xZd&9tOCHEfl zY`y;c3jaEnNe*&Lae#tiohE(3!q$_20eBZyv?Ob3KWkw~k&`|-v!Z)8Yjd_Au;UP( zmpd$zEpEd_oc+^t)-~PX1G?Jk-uW0(9N4#8<`o9nyP1~Ct7s&d2-gQtC~Gd?wfGS%b{F2|KU;X>@VkMGc1f#Mi+JMbJ)EuA_z?4o(SK$l+bE@%_0d@6b5UG)_t(rFnQI z=lscx5(O;d<}}kEoe4`*g$vy0tL0!>HUq?wa3DYFej>w zGPDc~HMiZxtby9*-kT~X)t8LmJ3P5_D_erI9)qp48YTrH*up^hg#!(n8!1ll&RNLu zNVxR*VtN62E`0@q`d9qEsFm?0b|?e+j}lO1c%nykmRo6D9y52u&`2&ol|%NA{o~73 ze*X2LsD=5O)${SSKUO_CQwXGbYPI>oBaBfM%wSruli-2&^10Caz$KlQ(Tx_qdgXY~ zE#v%nU$2D|(nU7C~*-~cjP4aW1)958ECD!Jh!xy`{sxJ2dWtw#0*mzIO z)3rEInFj3aE!WaOq{~5Lt>svggN#rELz&blh|^Bwz9tq|haSK8dnti~$me<$Ip?SQ z#U>!^I^)46@%a3NeSyHI$vHjXzo9bi7Pg{$e3A)2c>(;X48S`m&QWB7_;gXy_`}C6 zQQ>i-|HkzpTXOV0&OvsHQ}}#2mVx*ipNVD=gVqF-^vP={%k;^KZ?Rk%=QP+CjSzZw zD21vd<=IESG`TOD+4!AU2+pFdlw8*WJ#cxiU>*TIH3hAC)ZJKmM!hWQq@8{k9CmUBXQ13N7oD_M$a%N0Ew0(s%EeM$B8 zcM^AjMrZ%ZN^l1m^-J5e!is zmQ_IM44{adO<>01W5)4(_7qj;{F+zo-{aS}eXU|wue#l7M4gt*Om}g0?JV*V<)jSN z)4l#l?C!3OGv2Oc&v}gT>)nAMY=94ErEaLdUBPa=o@k0h)A-avQa03AU*aXMxEr#eX-6nXJ@d=TmIfF0a=_<$JRm^ZV&9W z8~wa-afgSPZfM>1gGXk%j-PgDswSR7FZ(QAUk2tY)HK!i(Ui_q^;M34`zuI0~zwF^+8CBMfZT9xN#hTvtz>1~faF?qnF}qnd1b0i} zxs)S*31}Jnuv+~x!_U6IVs3I?-r#NoGoZ*=kJSWcSfaM5V5-^>!T&7d)Yw1tJCfFV-GaF(?hRk(WuA?@ zR{pOKk~QQ5D#8R;C1Wlp70Cv(@ND~r^61ZbVrp)q9zbJN;1$_7x&*Izb<1m{-KeW$%n%oGv#bcS}mxJ z_vPid#mnI}PEwT%NrPKv8^l1CH5|~Ryz5(QU?$37mveut#Zvd>7CVojRv3ZTjMZ~K zO@8jbMLV<~U_jqG*n)6snA)jj?YjB)t9lu2@pJ802cbmGeV?#?0#59%zqwn{i|E!d z=U*G)_V)Dej-xl^gR}{=Oy?eX`0V-du?ny?{Gp`_o)PPWGJf^7`Sb4V?8DUjG*m`` zs7VtcYC66JL;yb26^TSv4hy0c)i6}r7Y$2f+t}E;dBYGh?UB`{lG0agM(i!c^qs(A zrW7{H`%-VR-Q0Joq`+WeGa>^~l=_-!7{Z~1X|>i>)49S&>sXmEAlgsI&BF07!r% zjhnzOvpdzvG*sqv8Wlz765;7fXGorIDXk$}$R9+$k70qG3Ex>Q@iiW2hkG60vmvNIEyS8c>z;bb|; zf-@7XFr8z2O)*1yg(8}#jX#zdJ-oJ|nX5~qHsW7!2(YtxW0U>|mKixw`H;dRvhIMIeX9OKe6#;v594i~g0YtZ68-5?W}1Me zGmk#Jflq3sO5tGNo7>7`o}WznjL5_&m@fqy5uwbtJg z@fm~x`kBYkHf?PBq^C9)(o->^2<4G?WrdjI$D!Nrc##R6-yF{t$mVosbJEuRf*s9z z&}OT}&?z~%@sCj%geM~J^IIHSq3L5tT8Hs$czpdb^y88+&wOE&!#Vp<_jAVpSLKY& zSTi_|Ej&jk_nt+vrJx@-LJS($C&R|*il%E0du7m8)tvrhw$^)})vG$=AwP^{kwubMJ16aCVPC@PA}#$UIGyw1(glEA zIJM8iHw)CZlqO(Aw4hL7O{czkG43?nWL+%fRFH)~=0>vvycPUpGM>I73`d4B4WUd( zTTk~9mx#FH1DSRkudC>8)Z`2oE;(I{4;DIj9*TrfkM$!9#+zckl>sqhpGoLg(~Ow} zIeEClc%*^LBu87yZa?hk{-AYnwR;BG)Eu=%hOmbMXQ|0 zWSkj56=OHp{#%aCP>)OE>*1efdJ}g}+4GR=>fxH6rQjEsKBdFDxqZgknQ;g$5>t!> zOaQdD0m8V9vv8v{-luW}=Oj#Rv~c8T&kgLNQ3XQOW=|v<;wsVqgQ9pOAu=$dxe&dO^jAKT8>~ z-s~df=M!l{$W5dcreLr15CM^hX@e=pnzpK1Qtq!Qo z>;nadWDHf1vn7m0P{xRer4Wko7z0P9wDl2?Ux0`al80f0=41>Jkkc`YMN-NH=3p2> z9SxCyaWYOZK_3mFh!Ow0F`Zu@C?=<4kbsOlPD!1JjE>3Rbbvgyn2##}z$)3LT3SRJf;u z3v^f&@~l1PVS;t6PwsE>|~8qxfXq z0Whx2Xs<@ruJX9900}W1oaui-=W|z<MM>gdRQ%(MDb`ZJ>eY6^77&~yHokrOyD<|Uwa^p|FDy4 zp!!$qriz6^FmQ1e3cQDG`1nayVq#6+v`*OF0^d=1C|cFv`XN&(l`=fHm(E$aj3Hmt zaISE3)wr>C8>g%&^&ItA0!-TJN6)wYiz<@NhhDh~FtQHgbvZ!QkU6V*UZD6j6`rOv zK`AspHn|fZDetkC>Ib|xben`UeqaHrgmzAI>+dwORi+dNQ;?^8Z7fbNnaG8fIpu z|G~ZQ*4q9rb^ebMX?R5Xz^XPxuXu$EH^w@?AN3N%ru|g730^H*i#nD>J-%-9`!VBC zK~I1Ej5kNrA5~-mclyaLO#9Pq5DoHEA9`}fule^iI^Pb>p8o+<+9(;LrEQ%~qs4%T zjY)gU<_D9p=WBI3A5G^@!y1r(WZb>i@5i(qNl3)Axv+n>_a_(3|L^N($3T6|k4_VK zmajg&I#2YDAps)7{ToU0`lqYAddq?9SP3Np5oKFOL4|>3Qjy_J29l>*YYRta2co65W4f zSr4)P{m81zunu1g$^4M(lS}q z9GhOH5`E?jXk7asGn7MF>(r{G3eG8KoT)=;%WKmOhL;-Ev&OoXkb;mqcU8iI$W%)# z&AvUeaLBg%skrkoe7rSBdbec{e9cILj!Pc%?ymFX0-a_WL7zCB$!9v5Y3KVoOos|l zXDzJ4G*_MSlOD^<(vmy6-7eIqA@Lj|)L+q1g1$XCljI{CwUpa=;G{l`4EMjpB1JRv47XV!E5lZrRA+w2R1Qq)CH zldUxJnWTs9BdL6`_=jZcKu_X~&*J|#j<_=O~LqHcWls^ojgdxRr zV@;J&=0zl8B2~t}6g0CcPM~$UJ2cr`AjljtGro93qBr|_+o3BjJKDEWbM7>If%JIp79$1m{b0?w_9d~=&f7Zu=!$)f^@D8S!R#cT zaDXVG7sjBd-auYe7j+Nac%dM<9=0??+-RB^Lp+q+!Q6Z?azXN0VT#^buoCER9W!b!!3vTlkVHzaQ{gn%OsO}<&ECbf@o$h$f4b%r<6V0L7k!>E}6;V=<<{nU{%n5_Oido?em8B4;`;N;i1p zCP9H5&WtW&8B)#_UUpts!UA-5$YiT5kR$#!S9R3r6d(~A6r9ts=7ew|NS?ZPz|-Zy zn~1Fm!-)LJrBZ9y8g(cdiXm3Qw1j2PUjGWe%!GPWsA#Di>uq>8hoktjOOP^WmkXdC zZUf}c(67sgI?f$1G}DLFUkVwQ76PnE&qX_NRpDHqSPo#H`cP5)n$k1vZJ3I?b^ipSO$uM`-b@_em@ZrkncxOA#b$1_)?!>&bb)vd8w(Dk;4IwGpeaRK*W0U z8#Qf1{nyu+>fsq_89RZ!9XN<1xS5H@AMmO@Fg6AMAdxhu?4FI9%cD0AS3S^Z6#&bb z9P12Vv^YzAe^@#Dy#+EE;w2rG+lWpynmSX_>%&4!ho*iWIu~kDYIq9eZjaa9U^OG4 zelfm>?<}4BOuTAJPxrjn^ zw$5P!)Y~ZHJ^{hLe+eYufYaR?><4A(W4%87laf6o^?K4sf8)NirVAK2LLDp&Tkr$}W6(NZNdD(1bOpj$NKhD1;0jdB;Avy?kMmY7TiSsw=$6|) z2dE-@u1lhh;Za3yy(R@ws^RJYqL~?jtoUVC$iiP;Qb1-`RWBG_L6~kYr;zsAB@mY?p#`{2YZiW9BCH2 zvpE3rXxeS}&VAO=T4+Fr)uLpc1&(rcZ!|`42%Et7bDwLrEQixz4%8RHxR1R9c5Xwk z3Xxn6LQybcfF!fk6vzOmu(G}irkZ1CD&RTpiYZB%he+=B3R2M}86)hjJ*(aD(kk+b zmVl2)1C%Zv5Tq{0qCsnEb%w>Vv-D}~fwDF;!LmSDp&*R9BIqlpr+HLhi&7V_Abac( zsIX5VWbx2mI9g>p4VPQl-XiTRzExMFgxgF;VKGrsF5sIP0y$28ae<3i-P{NyvQdtZ z>;jIE&9hb+v&rI#4cM^gNZAJq{Z`!Wo)NpNYy-ksCdB-ud+Ts(Dil=L-2QVoSUk-( zy5Da4)?m(T(g2?@KBOhwn<*uXr44J3fq}%K7x3^2okqSSTc;-moFdR1#Vw!eO=}%rQWm7s zg)6C>s=!VoUfmCiDw+qb@hi?C41i$oN6j{OjcD@u_ut{V`>xU6a;1Kq{lIW4*pz_w z#qs`PZ}_EjoPnvjw&C;v`-G=TSVZXDtG@=IA%V@Gm7H)&-&hH-I!%-83n~s?u2T(}PDq*^8u7Tke z{uU_AENi%PvKJi+d!+^`eYkO68G;O_=bVqG-&ho;BX6M4jVUET;mK#I+^yx{3^vzm zpGpiat=ly+D3ml_dR0(ojFG=B4#u!x$|v53MM+~U1*As(;5;=suqDw)=AMfONy3oJ z)S!n)g9Ees88MlhRbrhfjsAfnvqjE*v**Q0p(4+odqh158TR3@?yj+fuO}Zb4ZnNx z1Yk?*`tX=g@I`T2LQI z=O-pM4(9*=?M8~`X57D;o$stV%NG*s$~3CzMQW>wAuwDJK)+la{5e3u^1p(VRXMHV z%M=lQ9+jG6T8r6AG$zcgO1;O03aa_5C%HT0*O+c@pM6(lO=mC9m7h=El?ly6TXJXk zqZ}G{xk!2R_Tahxyga(IbIUG%vQom=;!l2a9ADEXNxaVPHM~OZ$i%X4=kM#FzB^X} z&}-zkQMu1){4J>+<{qrgz*qp!{MT}M13q zqlc%CK1lXojt9$}JGanXJ|G52DEDaESn;Azs?^Qa2|+^e`D^KQt}${iJV9^^BI2ht zgHll4@}s_ge*{vE6=m<*i-b4&C|A5S3dna6DYW0&I>F|6K&> z55GU$vtsA6E%fakA681 z3T1EZ4gUERB{mTegl$|jeEaYuuH0(j&EbhLZea-m^FGNZOT3uga4Nf&~XBS(pk;xnoFNY;p$5H;A8OGW&`mg?z8eGyE&twKYsfLDj(tjsD zTktZ!Nzo+CpYiWE+Jb((WR5SAE58s8Tew?b4c;&01{bkCV-DKT9 ze6$vk-+RY2u$sHh7tQz5qB{4$JRqb5V0eSfb*jdv=QsiYmdq%cj+q{3hni*ZOYEhx z*RA_1GG~$&7XDt#1XIoW2Uxt}TQ9h<&h^xi5KbGm#$78tmp2OD$8$(j^BUl7CqG_C z=Z%r#rK-#3PZdw?=mLBLK1?($K*y;TmSm^{_=`LZqpfGwXvWzWQQ@_BUAxjm@MjJG zf#s#a&pXI@l?9Jdzx!-#Nj8>CL<50`g$b1nKg$k7W>(;_C2~NgBam&IOU9x1x$eBp8SykQwbGZWA7*d%A4Qt=okH=+yXU&KD7g|u)_dG2J4QRvdglr1-#0cFBD{v)vBDk~o>yVq5c5o996N4CL< z&}(`V3HZOea=Sq@m#A&awWG5qwE;D(`+uo zb?rm8Y|^dWQokt%{45tGN5AQ5%YBzd1MC-W`j^>jAec+<%!AC;T2IeOrd$Z=k-$0< z@j`{LS_wF%5*-owo-}f$wIxp!fuz|R_k#>$Zg;vj-$`3x4~>gG3I7YNh^<-+DidX% zj)?^S&DJu}vFX~d`oBp?55FfF5@5cyYKe59+%u(4D#YDYV492?C1W<_7`vNF?Fuk# zlHeTM)L@+&j7Pc>bFM$Ldw>k)rdZvF6nMj_>qG9$E$#mKPWOF;&QYkOHz!s6IVL}& z<@+*B;fK^YWYoWOLSBlkBhim|uV?$|zYcXh0kO@K>3Kq#MA!kuWFpi0N+0siy|+IM+nzB`ybKtDaXSYJ$>9`$)ZHxP+CKu69p z)eAf$BrxKtKQpFoaE$rSj)Dnr+jD8J$4 z1*{;H8%+z06D<@0q#8Qs7?R2XH?K~`1TSq=SOC_Hi z5nY$#U3z4^X&%Y(=V2;xF9e=GQME!ORc8G;L!{8W-#jjs;BjKo1-JAi-Z%hzcsJUe zuki16W3rNo;|s62qR`}C?^pN;^~mp6N3$nd^Ors3XNvcUtdTHh-{yq9n_@75!kJX3;zLXF?KM-aKf=nUn5i?LxUk$_36meXSka;-W z`{tOTeVPnre*?sDr-#xouNbeFs;=kb%_Jf(-VytQou194VCgT)VX&=YXe3tlh#c#E9tntFcAW`F|f5y^4}2Cd|ZxdwqV;Vg0P&!(006XMWV4<3+xeJ9ox- zHu2zlG^NvE4Oe3w!XVe&il9@WaoK*gVBy=wOl+0;_s7hBt0(pI_~tyKFY$dme9AMu zTXrmn8!pLg-Ur2*k;SM}CyjI9LI?@L6EU+wp@O($({N5SB2x%8N`nB(OSt&1dSI)Jm6>jWl8I;U@=agK9+RU zfh~e#3=c}CQwJj0c( z1%s(Jr5Jy?a}}=>@PY3xEa$u#HtixgsnhXpRo4lvU(cGuhBrYX4(M=^UhOsl!HySx zGMROYzwrluXej|)Q#Y$>KBUbl?G6XrT?XQ|D){*^ySI>Gk)@`_p#!a)2+i+g*nk5P z2bGWRaJYETadTr%#E$HmR@SG3_1!vxBJX>yHg6Ej%QI|2TVd=jVSZZIdj|d(70>V` zzp<=`Z_>owob{j8ckAxfq_KeBgkzo`jD%zYM>$^2>p~=XMlk-hr`;O=j@bJPOj`jg ziB3@Ed=lad98zLt74nf)kcDnJ-S7&&sHw0%^@)A}yOVc3A%~LzBzCcr^fw1TPPfs7 z8hVs7sqmL*c4|Dt>S-XfV=r`H3K&^OruOM9`W@Sc@l9=?Ob{ktDo`Tl-AIV>U6=Q@ z6R?|~@86vVijb`O%iuDR5~+DbdcS4Z;Si6=c?%jJm4cP-y^-am*vV z5wdTwFPPjX5eF&E_T*mjR4$NI(-n3frKX)6!h)6_)X`pHC{O&MJqKW2Ql(E2E{k^` z+!#(>BO!XZNI#UR8J!cP+688njGON3HBk&&RX0S@>p?vFpC`SpUpyLJ7u>DP3|EG$ zE-Tzo7o}|y?!f^5M{MQ*&A}rKh|CJT4GoQvXb>TUF8szw(36y)Gaj*LO}bvmFbF1^ zToM>&ouTEQ&AluC6 z`z$nz0H{W-sDCdbA^!GSopvtbF`f9ny(suWrVs1$sAx!pPA;Zw0WB;F8yKt=PAf%9gOC9E)t`snN6pL56ze z3b38b-T8CU4C!E&31%AX(E#?Co&b`Eh_$W?zAxj zRP~M`+*F`v)liP<4rMW}(9CpS=MT)OmJ>V`V1;X;MYvZynp+2=1>+#I-XnOyI@pZM z^&m&><4kz9R79mLYAU!tFgk_N3pmw!>QW%d)A*V`8gWa{MyXmjNs^0i0@XzSD|`x! zkbp9UWhOSCfJGv3A>vjHE`11QVyT^NQig6yGFvarnD&+xz{ECu1vA~A$s)D4U94CL zefM6l1Mbz7A^Xf{+0)72Oc-dSa8xp8h3o8g6>ac$O+}Vf#Z>pZxpNmaSAKCT^L`5@aE{ zmbWhO`fkHl+l95{_Bc4*-bF=ustLRM`}KyHygYE@4VhU>B1`7tM5H*8&StG7EF8G? z9ZfSaGgqE6w-YBj%G8d#&EONBi`9ktfIM$KI1^aN!jtrEriS~a8_+kDN8Yt15$z!) zD*VpbY5VrGV5Zzx`-lAd=VltqdvXS5^Drd)7IdzJS`WVF(0ZgD-2F?}UC zgR=CfC);H3-&#J%kC8l=1tUdIgC!2GPWuv72c`X-2T{TC_7pOhPgx@ApW)Y&U4^bT zHrGMyzb_iKVS!TX$FGnkcQVk_O;IKIkSKR;(+^g7H)6%g$g?sw}#wPBq1nfbLgXYCwcgZs^DJt61o;CvioG zEvf|-KCq%VSzIqg|Hg3?x5+w6IHobd>)23Mh9~8{Z4rlWRYO1wAfpd36^lY8)@_|i4J(Dk%|BLeK&iK-~GlfVA72EKh!Dv z|D;aY8UCxhnxZKkf7piDbE=NvoETWIR!ku^kxLeAYvMEpyeRNX`CBtE*Yz1y2XwCszd*Ay(E8ls9_9=JKWp zW@}okS+?Xqp>Q&C!vjhtnRT95Vfg@TP9++alXc6CzPE?1Ie#OmPLX zq0andDJY(@aglfZaQ+-o?9WC`b8K#c{A=uwJHDgPc-P)k$E~;(Qy#~YkJDX8QhywH zS#<^2>Q`J2&BbN+CdV4HYiEIZkeV4BF2y0h<=%bLdb=h0+-uD;6oQ5cd-0IiATtkv-jH z69qp;aRyZdJdYMUkLT5Rs$ua#;NV)_>)hUB`L!u_3oaqp;rNh;9&}{)02#C%;Kj56 zB>bgNV_V=vw@TXOdV!y<+-S4UR@Kp=7O7VF$WbhV<4LT*7L?bpOIqGfu;0@$mj*VG8K>^d-G%UaR$Xg z#V8q%lp-k*h(uao2yaXsrgOhA^kA#Q@mvr9MfHq0WG$58jZrnewD-kB@4>H@M)A3a z@h1(93DJ@{LB@sN{N06lV@8Lvn`FacEVn z0Lma}rxUxXqGXvIpM(JeI4>87k4yM+$08hoaXod7W+U#4HL1qH#kO2Qo*0JCj0Gr0 zOSzcE1`yw$w{;HWN&@;!8O`NalmQCM+<1!IDNsd3&O)#Q95VDm6BJ1OxGhw_yiPj` zDzI;4>M+)*7T9bXA>#-(bH~Dam#>Xx1o&jj`<3#4y*n-D_e?}THuBePl9Wd7c6Vsc zs{ppt`3yS^WfTFrF|bQxC^@h}O9sl+<{)s9#H7Rwe2|A|H7w`RSw(OJYV!ub^QUI=j0%zp{o6KOnpksN&j|K0=)Y)9%^)CZ0uTO&RM{elFE{RPsMOJW^Y6SYZXuc zBQxGPrv8S|1+;r45OYe7&81~fzeJzP8z+?rDiNh6*BWncheJhA<3ad=8Su~Vv6xz5mLW(^~1bq z$vs8}th9f$MGCu1nzPR;p3mtC9kf~Z$0aWsL^a@&*mNmuUd?x@NasOc&8YVN zWtIZ&nmK@vrVOT{;1$l{RH2L%`#JpmLz4>dUs{i^~TC3i4nTsGc7OGJ2%g3S(6n4;y^ zBSz4pdbe)o*!_?&Tr7%UE~7Ogm!ysBs}+YRr7b}IsWulv9SjfmQN8zPq+QjpG%Xd- ze67f4mPENug4E6^*k-CBmJr>kcGF@_sM2SI{sS%h5~fw?sA8(^z+^ArTY>enVh}bk zlwg;sH0H$>o^XMfBT?QH+D(YR@8_|ck6X_o^Q77;ECQt50|nZ0I^-PV*goA3VlgY# zIdIi4?vPU)&V&ApWF>$YnQJ>S*61XC4SZCmZrb7<1B46`YbHbk^_75RqX>TUpM-dLriDt$!pMho)R( zYU`7IA%{iTup71r4(a51>>Rl?bF|{`NkNt(^x4J>$@d1Sy1Ox`~*OuoSw|a%ls93nW6blxe zYEQz9>;_~5N)KV8TUQJU+9dK?SR>ThzxZUz%pu4PvI*GD==o*W| zp`mW!r#=AV-3-9^75^#%NQK?r4nLd>c?M9E-|L^|J}P~88!NkWqi`^#{KLJJA0=3o z`LaviVG;`-L!P?%-#T>&$W(xdIu9}C;x%T}@Rm*Sts*b3&xg6dyu5DBhm-G7_^utd zPf(Tm>F9i!v%PZAq#eHwx%+0ncY;uXn#d0)7M43R#amo! z%#ZM_z5;hsLv3nR*~>@Twf@oY_%7#NuOO+?yW^BdZt?zoS1_5ktTl**>Z$G}`90cT z`ai+ItTT@1l;i6F`iijcOr6i*P;Lu5%M_07A1|(>hUHnCms?+oF(j}V?yopk% zPPg5@t`wXFX?k+PTH&sJIpCh#d0I-Mk>$6THRTNqjwZo{hV8SpyIE(Dnd0%l_`w}ZBAX$I!THPi@<#p6e2Bt^ zjLFe8e#U@Bo+J_b67q$;=a?2(V@>v{as6*P3{jszbCi%R=HG91VdSbhck$GJKNj(I zwfBDiUq#FIzXb-^IsYp#Fs!9r`!8_)9{}D<2@`_zaI{@~maI~-1_eu8nCwea-&xJ(UahL>IVj_tzv`1NMTpn(;42kg_CWmDeP z0{R@aVNw5WH7>kPU>(Yr)Clt=ppDzkO|ndq7l$h>TRUl&1dOYgGsa!SZtIwga8lmp zyCui;lI4aaUo5=suLQM$ywwsg;woQm81h|_NJ^hXZZ=$72Dh0D^rFdHEt^ErIZNDN zxxE7z(;u#d_7Y!0it{1h-odr>giN)W{LMoNDqA_VEeq(UMW14;4I}y9MM3wRT^p-k z>+}*L2}a`v3L47Zrd!8uPdoD9g;P>SLeJc--QJ&k_|X{|{y6|lBKp0_PD8jsXt#Xx z_5Sgv#io}cyxAr9Cna|2J~)d>zjRBWF+VFor2P7LRrv?t%XXu53o$cu0;PD^ae9xq zMnoH~!%|56^@wC5%h#uR_T~(-VjP=?Qjpz@-D(i=d_WP_Kor$X&M2x}407Qs$Vx?? zTHCGD7l)=5mKXufObjQrKvj1yn_J}?tLsqc$;g7Jq~y}|r{|2GrMBy&@`Qv}WZ4b) zLs?8D-*Ny%4Sv}i24(sw6kLBW;#FKMF|GDNLm#er%cej-jLnnz4;)Ve`b45sFWTpY~xtsDg!i+hmD|W(CT#ddMkxgB_P%+E7j|`ZBBJi-~kP&HPMzmj8!-LW(>KS!5;R9ff36wCiJAjl?TFy zSTspNlVd(<6d2LiCzY@Qb>b?%Rq$Ora`R@t4~LuW_Dnuf6u#w*lq!wu98g1`u9gDm z5JsPom{|0wNE zj`7w{=KcmzCSK*qoKYeJpVMkzj;2ME$PSL+e=C9$(ES`>e4EW?4?BhCSa5!gxmPC{ zXeA=X{p?SOrm0&vNTXsQH@7 zPifRMvhJ-BK&~uIAry+w$-@-NQAI$Y0di1~OEmhIuu(8Glc}HsZZY1*kRTqP;KW66 z>y+NqXX(6ja7n0By)pvl&43<(F7qFeJ@K-Sd1^yYL|<<_$oa5JWgxMVVnf!L>;^<0 zZRJ1*1EWyaffyPmoW)0PJGh4pwS!D0_Dcc3^2DHHJOl(#rE4Q|8j>=M%EwaIUYnVW z;6x3H8Kz5CL9ZdEhKh91WCn2inIY>j{t$T?z}cvwS4Sw3Cd+wLLu3V9W@xEV11Via ztAUU{-UFmC!Lf&j))|XHFqFi2D{p)<7imMaMXNkOa|9PbpLdsBU*4c3UR2Vm&O8Vl z{Va7Bv$T*$u)c~pwwqAUsntQD2alAUz!i{%@PW5HrkN4S_(-E*;oC06w@;vK!@bcQ z;{ytKjyE)QO(fYEC=N5h%nKNodfDi**^$3jg8O98fP8!m#x5h=6ZDp}z$2g}IzE%~ ztF}*DTRa*%ZQdT{1Mv*VazaO9ba0&PA6>LoS)QiRCaKtSB8v(r8=pnvWCYrUuF{(5 zz0epx{y8(m9AmS1eJ_WN5mG4WM8VlOOd%1EiOSXpNKFQp3!Z_A#39XMRHw`s>ry_a zjDkxXr+UNvODWX`5TZ2_t7>TM^twGl%9M;Rd5*yCWu?W~KWq*R5TMlGh>E6f4*!Rr ziIkC8NTC8Pj=DGNP|Kb8r@#KEy;=YZ8cprgL4Zxq=P^6TE-VFT>4-3N;Q5CP#oZaS zzWRWgzIC}6=6=84x{Un7rNf`+TwIv<;iagEdNPvk?e1#-Rjc>kI8%W0gCKPu=M8#d zIdtJ@5e5QX580w3LIX6uifb%;Nn`}suy4>ug8|jqVT_9i(d!)`UctycH?T<3=+*dZ6C6Mrsxea3^h`?8#wT4L|d^lL~d@g7sh_W zJ{5*9G99i;-+@P2=BcPf??g?2H{Eg6=d86B1EN#mC+G?^zzc_vARJ*dlf@2~z-i6o zCJpE=fTe%fHB>|Ngf_+nKiLdQ@_A_&`{}8nOPYuK0=h(NA`P_Otz0DDB(#5L)odrE?=hrrx-59EPBH0qYa>l+E-EnLa>$P{uviig*^tOehVHY z0pGTvl;;R~O!9&Ngi>^t8x2m-MRd~#-M&KcmeYfOsIZh5D!O&@2;g?cyq-flb=lsY zMN{>cF?OKy^F1%bBrU*35k}m|HF5`d;kBxK*xa-3tZ()UOaVfU#46?9^ z_G6P?XQE1uNvWQO{cifCF)E$L5}NV>=Sf)HO56vqs{j$QN5iaA$;f|xXe;jj^UItuk{An-rTx}L*W zO#2o4gNv1-d}!;mz{-@3^0sP$?a}c(G}Jmqr?*aX8Wx+7FbZVdUU7G{W-GSrzW1@*pJ5Kq&Sm6jb-%VO&44)zhvs4Swaz@o;W7l%zX8&10Sf98@#0RZ z+o~FNWcVwGO;z0=r&JbOH9Z?OixC})wLu|tuo-H$py-`RfgM5(_eReuX`!v^+b_9R z>f|l(#UrwpTAwzgIbAr=^-aABRWQwr(u>n3I87s!DY_p>9v(bT93*x;1NsB6{d^em zbolx_+39w%6d__c4um$4yhR7aK%6Og3^GwrAkY-oRO;A9aF=5cuFkv%2qi&oiF!wl{qqZ2rl+goY8kNc^|hDUv_FO;^TazKwl zjEc=ihSfBKLZW?g@Gn3ucIjNdIQ1$6&F*opsQ_MJ%}iS&sP&E2Yj4^7e;0oNmNQZQ z{vUGre~Tw@u>aSL#k7{R{o&Yu3}A?!5Fjy}m#nE=Gk3E9SvhR%F~cr!sX|*j5+%ap zXAj_`*0PGqEGs2h&1ji`P}sWyGgsGVb$#Bk;a)VGgnoQ&47lHQqegun|5lIR40?@J zG|hfAcX;Sj`g95C4EmcE{Y3oSiNX4dRBA$zfu9B)Ny;SrEK>IIdh0Z54!b<|(GJ^G z{@rg^LQZK#IWv5-ksY0JnKBtH4$6gW$Qbb=Dp^I|4owQm#Y!}4gU+@( zT@uc$i97vXd7T%u_ngwK?15j#($bXhcGV@?+S_x8YG)wj2?V)lW$%~YhU(Q_x}H>~ z^%{YRGV`~e6`ZMqeljkJo>mWA*E4yaYc>vw%f3q}py1e00K7 zqDn6=RXuoa&!v1fdgmQ>EzhMqK}0VNqPITfpHXz5Zu;GQITP@uhxg@f2VSQ@Sy-!$ z^&=q66EY;Smu5S5)?KuOs@vSk|3-mrrq+B# z?-z|KoA`psJ9}c!Or`AmgR?j{kI-?(m#{{I7>@@!%BbNju^1P1wKmJ8^VIb43VVO+aJcS*& zjcnS=b<5j=hv{daY`ihgtJI;B4wzfeL_TPLM&bBDHp0!>-u(^G@O2Nq+w)jw(;kg| z`^06+oknp{nx_CPveWOk^TtAgK!^;@P2rwkRC?1Kr+F8EvaR%6Tn;CUGa-Hvp!J+d zDoZ_E(KDzRcgC)Fa8z|a3y8axH|3cFpnbnS(|@(zYH>p+B)T zMh1o!x+WfpjG7J#pv2!eHRGP4mHQ$jtMU)}kWD@^40!E|M;?+15o}9q?;xp?2z|kJ z!44zG=lw{^>R)Cf(QJeBnJB@4IfzmirWj2xl7howvMC2W*by4Sj1Di3R98L2n+Yj5<3J|5`3+Po&-SPh~&JdF_5d#=!@jwd5e^9pW`>I6veRi=S!fG?8Q|@Rt*QC z${Gng3%8Oi{e z6%tZo4I_V`XrZ?89C(}pJLe6Id;zeRllJm3h$6&#V;86kH9(Y@=qB;7p@Ph9cU3o* zY^@C`d8kYQ2fb0*@wDNGY*i3{%C3xb=XZ&p^*)VH))i1w^cu>^`1cqTe3Pv5D}wZ` zIb8L+rw{|Fq=v;-Yx7@UjrRf`2e z=*>`A=p=ZKG?5G1)ytZX=CHzU&#p)&$R%ATEg&rk-ElRo{&GlMbh4KBfUZ z;*1Iwn1ezr+~QarO9(=gIvxhWeNUa^`C_+^&Q2eM~1-27+|33>>V3-U~r>CCQ^`**S*N<(xKvgC<-G*S0>WfB4`B z!~Mb&CDot%th0)$qa+GEH?VBx7tFX?3u!hz;O%K5sHHF$Xkm5d9+>_aa zn=F0)Vvs*OYpB9loJFM~n4wR^6kweI<0O@N2<3-|^t}VQa)s+qhJhlQh%he~1aO&Y zNnKUc*2G2?PToY7-@(evkjX0Nlz5Jm@d=L86-T%5@}0tt6kDB*EP(fY+FSHOn*3{QJ;|NBZWzgQe-DxOi52iSS3TXG5jh@8^%^a=gx1O*===8VVE^ zgGX{P>b0h)P(YQ82!Y|kOEtA8rw#%tnQo5E%*hcJf!Ap}s0GatbvhTHz zaIX&qvw#fC(5LcT8=msy^?Lyt(9-WmBZ6 zn+Bs?>~U#CXQEuKq2ubfY`3Y#ID0Yr8y2+$!&}7oTIivjT1dp38oYspQp2ff=;xOL zw|~%8Nq`BzOWe1-tQ*R+tjQ;p0xejD=zSUm+L~%6Gq_3y635stz-G#Mf6Sjtb!lcm zF6@iP5yZa04(d#=O`3mHfxC}TYKlQA=+)lOzEvW-ckL>lG|W8!3WCpO`w!cFb!4Kx zDhBFMIzj%?wtO(DB7yr6Ri|ist_CKK?oQW)2?V@B6I|{(DG{+y@}+ z@b%!RbnlPVZ31ZI78=cCE!?+f89nG{U|5-v0Z+pbAPMnKoA&X^SIBYb9GORQ95*Z4 zcRGw8GV41C;n@_g#6@!a&_K8P%6#{UZ`@ zf2KH+Y@88vk=6UWV}W!uF3h)0>-Vwf514X@@B4p<@c%7^!N&ey2)}=xwe#l4e=@>* zM})v`L$EJB61iJiHyn#x=MwkQ$>8Y$B1(kZG#v$F+&+;3`C0U9ijCHvOJDFa@599qGpuK~)F~IDENZ@>`v{#x z8^8OVYE9j`LpH%%wK_|v{afwqoTx5ls(WfaU01i@VI$HFLLg;B(BvJ3C>4c1*lRAD zNkN-LTY6o+lV2K9sY%v`Xw*~!SVMe&U5$6?JHcPaO*@Y~+4`zCEsZ4RFc6gh0A*25 zQ~RDv&lTx1Sg)^pHdFk(D;g%EUI4F(8#~;s2TR@TZ!a2bH@I7^FhfOuRZPF2!;1jE)KD#6<=+twc>B3VKq zoyi*QmugKr4BGe2mrIJM22vGF28wD|pjEt3FlfeE-Swdu8wmYP2SP@R>tlgSuRF;HU*T@D zZrUlexkbpcW9Qt7JN@ZZA*heS&XwkrbOSW?LOb; zq1>u!iw{UBlN53DJm-%lts)RKwG8cX06Gq=K^M@%v>raV$5#F_-+I@w{rTLYx9STI zvBme6Zv_p^2U#K8xr0}+A&g^+^G-f%Q@pL#{kT%oQ{CC2yV_%QC)d4QB<45DsxZ5^ z)BUelSCc95js)SjG&`)GdpCVt=4vabZs$v49~K;o{iY;j{V&Ei8?3!Dm|4sMYA{}8 zWuGcJisS(dm*_y_CpOygrE+uAYLEs(3d)BJ-SAtfPWeZ0K2lv&jL^bSTu;d6=JI?1 zClgUl^qzcPMqt04mTt?9sFHjuIY+;xZ6t-203={p6J;RyvjKZ6#h9fJ9gP7+-BjK8 z6bIk{V9i@g^~n`MDyL6ERM;-jFsKfrw;(x^RXHdfU=K`7HYzpDi<9Ec+}=8mYFD#< z|6qDSz#wp`W1Ejd{S$F}1`>YO|IYIwJ*u|rsaJ;syp#Smv4QC?ORT4y+6$28x$;0< zp2>oF6mq1O@5_s*Y{de zin!okeK{!Rglj2ncW#=LSHAF+9B*G>xEI@s;+X_(BIwn!_JE>u3dAiTSk4OFQia2Sa7Rgt);3&E#MzG%H~gr#9GDGt zL(>;G&fqbHTeZzJi7J=`E#I)A#ktI63CRH`SG-6ujHqJ)iqA#0<3=Vlg{;x!Hzv&L z3@A+xi+_6!M8%M*FgqwUI!?SyI~z?w==Deg^aP_Sv1u6iT#?&J!ucr2!_NRkcViP- z6-N1{6m6V{jq-))SX~%tx05~YOR{WNzJlQQa9Ed)T+RfmedGjNR{H4T*MlDcT9S9F zM!NVbo$OvXu^t1VwJSb>8f^*QP*XNw7%#M+mTjbZG_`B2zFW zRc4e!Yk7=~d^dw`LyABAH0#ze!{{Q|^b4Wbf+$Rpm|@JOSX7w;4$fhKS8Wm^(PPut zGRk2P9iN_;x&j$lGua7{&pm-X$|0WO`G$w!k z_*Ef?NJ?K1iBnUWH_gS@|bBiY?Ap z^w7d<=f&GK*!o`9763Q^V_xPE3{NvbHt?XHKV!~6*Ltm8T}wvuN3{YhpDEOlAj5(GXH;!z0;B?(6%63wr$(Cy~?(2+qP}ncGW7|wrv}CowyMly`#^= z{)73LF~=C0=M9dxZH7O=!Q;*lboJJ7P@PqqolS%o{twF2mK5!Z5SG15SNJx&a<6$+ z$(&6=3VPn^$N~&C9~l;=G_>B^v5D)l!4=jUlR+3zmNS36#Y-TDw?-jt38E`FXyQH) zG_{Y#)S_)*-16u^BY7#&=JbTu9yHKzts{Aht@b~Y06cevXPH8}P9caw1N zL?kcVL^GO!Ga`037A8^k`$V>%nPrgCXLAGv#4+z4!>JfXVrl>%jbPWl7@KfIti+6% z14^p(<5i{7l9Nt^5}t^!rj%*9oi~MKRnJFh}qOP8e~1L zQoMm{wTzFLY%T~z5d`_~pHafZ(V`a_Om){$A@>#jB#v~5Dd&ds@8>xjJF3wf*s$Y? zu5Q)fbq$Lth1n1ji9qGhnqHY)Bq4hy#E0=(!q_{TVezJ2_89mk`Bw)RvI%hHV^f0- zFl1IW@uRs&IctNEKK)zLQ?TC|;Kw~rHW~p|AsI%#O4TNC)@&qXGqjn48u*!y)+s_| zkQ(pPP*$fuuyIo=PuImj8u!g$t0tFk@Cj=fT7a9;xzhilURJGHkx=h<_-P_Z24E8u z$bcO9kU=9@ie+**fLQn4Zv&{<=LHFbUlvi&<8f$tkVq_H#n^F#b4P)f8c9aZE67RY zINAU1_PODi&Da<}_3IiI6iw{3+T1icG%C`3`ig*Ghg6N;#IkCQNDCP2r4K%jpAUBZ z-s$0ln%@3jZe?fqueOI7IT-(MIYWzvmQxW2n(waO{sy`BvT6}DfobkZYQ@e*M$WqI z^`t32Ln^L{kv;H@^T+D#d_r(PB1uLrWf>5}pVOC|EOj64c@-G`&IydK;i`YT!#}Ri zFQGN&(hnSERh!?D6R5`|=#DO3pLS1!{{m$yT|4$O#2?e1#KGY^%T}qPKAY9-_S-p= zy6n#%er><%kYW+*)mV7CCd}=J&q}grfcGPs270`wS() z4jn`e(hfEXxBmQ8g+wB;fC)T$HlgSEONYWi$x}>-*cahEyT~#=%X_B-+cYs$4p^&KggZ%yEB~cF}wOF51Gh|790T zNLUPKp4`OdYXFdPB6=`x0hC%CLh6K!lyaxaW=(*|C#XJ7AF9Z5w|s6e$2V|Iuxq%r4htmxRMFW;pk&lKf#QA#B=L3IQRQb8r zn^?TirRm0(Lsc_(mG3eSng;9OK5n`V2&8-3W6y@6tCbUDmFbW>ta$RmnzPz@18wHk=3dq zAq@23*2xFr5q6hEGS%QL-(u+kiCxUJk#{LY(-m4t&>%f3|J*E0VL)xj2XtzPp*=+)lmZE}Ku~oaC_?EjD3*r+>%~sa^WwQf8I*^W10X@TuzxW?9FMaX zCJ>|!RqAV$F!m5FKS9>Hl?%Jb)5OS8j3@c9#2vtwOJ(AX+P3X(YKkgG_*Nf9sws7` zRpIJ{NFu<3Y#g3GYXNSUNAAA?0F-kxJ7!>(hkv7DMFdE~h>fH_HNP4}?Y{!>Ej-Y! z4{qq}mJ6TCL(J&MSx3_&$-0uF;EF_`Og@qA^3?uCP|wUUqJoUX+nNdOV{Hx?4eV@j%wqH-ZT>cE5Y7faLIG z9Mw5{otSn)LT z5J4)D1!etM0h8zIrf4n*R|}?m9^q?pXWiC8r9EYtBDZ!{SIeFxx!Gc&OINn0N@dQV zCy&^gJp5HwrDZe-yj9aujO}#zJc?PlfD#8w&Ci1RO4LN}23k!BEUNr+q{D)r+NO!h zJYKS}_NDXj%k?%)%dO1CNz;6KW;N5E{>8UC#4`Gqbk#bFtxtQ?#kf50uBPY4`+9=~ zZk+r(=SY@kXj<|dA;zzQZa4Bv%xW7gF$2LJ52=uBW83ts*5vOD6Mt(0G`)9Z4SQ{Q zb>-(!-B%kA2U($SJL`a?v4(@T>Fl{pAY)Fn6~u&5}30=AmUdFLP?XgJoLJ?1JP)4hz zvp7`{l4&uhgTPN+M)S5S8d$XMAFCcGiZG1VGt8#`Hv~EMpK>fu2sQNrfZN>?;qeBI zV|s&yBt=E-q#F4Vl3>yuMkVtnhpkX}I^f`LDIYMDl@D?7Sd9^vOrffU)YxkC?aN;5 zwp_B@Ku(+aU?oGHt~4JF6k1iH%G!k1(0ngn74dPaURVljBdn_>F+x{Cn>y)0oZ1EJh%hPUfk=M;NmCK z!2QhQqo{j&Rylg9$xkl1z2$zXad5|`YsbmP4e(u@Ghb~r5+8-vzuuvn$J3l!aJZ*9 zlY7rB8Rl<2lU*Z#&Emg*@7%RJ!h7WheQXdBiFUgE-N6EnX8S0m=IM|P2zPHHU6)Y5 zui}6>pPK8!C+gDNpLq8m(Zd+gr3|pSW#?Ycv_#s+5J5_1>)(Iw+eN$8=!3{mmVUU> zEZ5@Ux`wAcB-;@djhQ!ga(1YI0i|gI#cHUsglqm%y!L=4!9;iA820Y@bl`L%ZR9|Eqina zYLsg!=|2a;Xw+csG5>U<+`k|C2dy*%_=m}^`dUNnd&C#X;1P#}bNq~Sz#0UhJIdE) zpzJ{iX}r{AGSS-cjf)8+7HRHsf(q{J*L|gi|EV#I(eO#e3@&BK+Y1Ho51?q%S25!f zmhhr;+XyHBcCGL4<}aX7PiX1?f-=ni70Ph1{>L2r-xplmR_p(K!C@Q`E(76(vPUR? z9KoS>SK*nX_(aure=*EL8WrKl7q1QeQi^*6t73#}`mUhVgvOxY2D*(_^2mWC*K76<~LZ$76+7WwruC7iCG5z ziw-Zsk6K!G6pigAV9TiJ_0Q7s9j{klmA39AKGihJ9-*}Ygq1j=dGaX(Uvis!wEukw zT`_cat**b#1&=(X3<#7#fILh*0&H8YFlMNTXk7Rzydj2h~R z>H`N2VKvo^wK@cA^(~0$Zl8yZTP)jEQbMT~Vbv8TrSo>gf@2jq2;1|f)-g*Z%ry-p zUb!&-<`@M4#1J+!44wd(!A<&(1b5RiYZ`vXqQE#n&ME^^%Vf(1Tk%!mv}^q zBk5uO0+p#Qn6TON7LR7!pQ*XLpZ26Xn}`ccII&{q$6AJ0)RA7IGS($%2s89S~I9 zU=6xkL$UaU4kP|mK+Wt(-I^_|;T<4(`7XZo@Fs#5SF_8sI_w3-?0!8=i-WrFgVxW% za1UN-*>yjuLQgu8!}|_hsIojbH-KmFx8FKx#ayz!@O`gMHEmt$F5QcbNlB7WumZZ& z5Nk)X%mH=V7X*361o0(gd(_o0%GYo}92C0_{#0l1_M!lPu)d%J@YvbKy~&=Nr3jds z3?G%>#+S2Af5bi-{EKP=m;8Y^%oW5=q$-tK)}J-;vHu=zOVx`9H}mXu5K%L}6)&u6 z)I!ci2iF}yeij0Y3JPC(Uh=PN>Jp+Z0ujx1A@(NjmGdb5oQ)&2LBwArhV19gQOIr= z)+^t*uC}qMBRb?TIFU0)+?o23!5a$|5#N;!k4b|rNE8YN`V4WPvqjq#C?!7f6BYuM zmp4;*nH-hTVjAO3kDg-sX?^glfb-G_xxa>aXHlA=+p0B%=7NM`{2(YC$BYpmtE~XC5_0f4(NWEc2OA9#9lOj+ke@%+!FgE zfk}OeX8_L|0<9r2Y*lAB(IL;6(wJEnzb!ryRJJxLcU%uC0T2VJ$|=5PWYK;me|W6# zxtq;c(Zo9yCam30WD?ncH{x(=y!kN4+Hj4 zg>F3zwc&I7Jh_NqHrTIq!WRdR833dgf%LX7d%P+iVuVvRymsce1pxFyxVIWtx9c_L z(!PmKV3Fs{LeDy(&<2d@PB+uxptmU=38gI(RT5B4MBdUw2dJQ|$FYIvHW9=-MKiFWi;| z?Vu32zqlT{9D9UQcdhSzG3?#1re|mEkR-mM_}174H{_$iTOa-u?r#kjFJ=JC(58EN zofn?wZl9)UPv8h#p9_5W-l2>`vwLM|AT_-Nf`6^B$QIJV8sucsgzam3p*T-V?i^)i z0Ej?{NpevB2!!*8DHFdY0f+oxGzp?-Zew`b4N%0IGOR(>CF$F&7;VW*&I>%8*cRTN7(44RupLlL z7*_6q;YdqJGZuLl1)z>0)xs~*BqNIq-PAKuwl2w->>nR!g77vVOdjDVMi@yeAWB-Q z&_JPE)v$Mj*NyTn4U_L;%nXmnB)iK>aP9`1^#LF|j4nDg^kj0O8@A?rF2G7!U`=h9 z2GS=hMF(4q(qRrhnI7y4X2=76OfRW_3dj&LNB0Pfj&#ec*3lf7wMU$N;45z)%iu@< z^G<R<7Zo;j%r(ELdyI)l^~Pwwb~~GO-%ip!(Z<)-F|~sHi{@X zZkI%=wZG%+Au*MQ5(Ft9TWN;F8z` zukw(!qS-JYtr`IdyKE}3=U(+B5P&!&bNutMby3#Hsl9(Pud%Q3wZI?(T^2T8kq^?B zK6fK8>%8?}?AQ<$n^K`B`=HAee*Feh{SaGh6KZwK1+v}UPiZYVl$M;x0$d|Jh1 zw^vh{6E^*F2IUrH1!(kvCf^_RlzSR|b}Kvph8^5?w33X{X8|}(2(v4<5kEHri+|4H z{m|mY$7QlaRJZ?h6QR2K6(8Kw}bg#$Nn8jyJI#CboJNp0ZtQW4r8t$jC* zF#Evkx?>{LxA|S&;0z^_^V|vKvh~NW!>v*5O*|`BVn86JHr{lVU-fM5)-Mg{UNvBl zty4WDs7}dBq$)=2DM9Y^M`)_T^zo;aKO|HA;+8F0-U;H_3aJ=6WA{he#8zX*~C-Jzw*)YYkg=W3Otv9f~}yp0VofT(5I)IY?Zt)ZD)E9q;vH7#)YZ zj7erX+?{(2v!$J|#`<^$%k5fpwfwOCzMR%mm9!6abYxezUu{?L=x?XmFEK?`yV>k= zA#L)t$KB~&god>&jj|km$nL5IZ^B*4H2XgDqJK(3J;X5{y(!%+DGoFxQZuVKL^RR- zYO;}rrd||X5jM)zV9&|;AmlXCXwaTqkG8Yd5@GW#^p zF;%Qw2D6@N`HZ}9c1_EcZPfNWWUI)aDh1$Q+E4rI>79)ZK~@GjFgfec<~#gdrQ*u+ zIxgy1qCwb<{y7Ep*xqTjk`I-NK3iiz7gfXFi3XwS09vi@9|+!eE0@C!{b#KlN}twS zE-4YTaA2s0bBhqd%@md`QDZY&NwSGQ z9Lpm|FzeRaymb5~8|FN=!fI!|hqFa@;83$_s+nBMD9d&i9vt~ws&|eThk-u*9roa? z&vA`#ivWX=WfC=JPr9GKz(5Zw;oEyigXwaHKc?oyi1V#R5j4ps1qmM4SOA#_YiR#n z4niq%ywY11?X+6HKlS$eeUvnnD#)e}J?HzaJ@u?$W9MosBQTEt!v#i7XC)MUPuU<7 zmLAafD9~>$X$*39U;Jw^sXGU^P1q@V5jdHTb!KF4(@N1Dp>NV0F10t{bBiN8et2uO zD+&Lt!GR!%>=d!sMI8`cAaDEg+@FJ3dZS-%$BTE`-jB=O8&K@j-To3Vq}z&gd2iS^ z6HK@+YW~O?GGh%NolYe^-B&t@75Uu+12_M~b-3BSF?nI0k;CC7i4#Zblk803PUP>( z8^DDs(LIZs>(>ajB%Kd#uT2{~TOH5V z+WThG2nsJ8_R*tz#4|`|UOjDRKIo~e*6*u=*L@IMbztjF<{3cJ;1*6k1X%i@eZSxk zQnx_JN`$(Momq&DAlvC*Kx*szUi_$hu+6#7XhhHit`m5 zT-pS<@2I)K|y@rp~hq%!3`9k?i}cqiL2E-x`bYZFnxE;R5w`Nps0BxYI79j z5O=s0CT2aC7p^jHazvi=2LDS`nS#oz&GU9k* z4;QUGjih{KA9J@?Eqm*juByCE_1>*sRZjaG(Lh zO!k01LQ){zXxiu;cDTeNxTp4mZ-vdIe7FyG?p8kK#-|jI?(o=0M_0xdl}I$)rH7dj zOHrzihIwX#E5;CCieRPA{-kg(@Sh!S#9mw2tDq@&@`r#1JU&3sky86d(P%T$MLh0F zcR)-Y6A}C(b%Yp6>mhIjtSy;DJKbCNR|jn?K@IR)IAxLq=mg9(2sqHHoT5@YuMH5~ z9SS20Q~kY&hXRcMqfy7B6~}MaLzU)q*}r5=$}kLbN_@7p>P^IW2-(*)YaeCyv?CXMs+V5id>ufI^<}tTy$(&p_3`D%&9bQ-`avv zl6V!sjg+N#6_k;91VSzSMatqo8d1V@^4dLMsLe|LRUrLA(yu((NW_R}-a{ia{Mx>aaZ}|`{NxGqN2Z+4md4~cJxxmtKotCQ`hT{c+B)x%$;Yi z&kA$=d7}6k!+9q>s57hW}_68Ps4~(73tz#CQOz zl8{GthlLuKQqQjELFUN)62@XB|Mo%JSVi8bbD%i#Z|0HoUd_5q2+`lX;)JD$1p5wo2`+3*bW6DC>u0%%juA#o7OT+LmKFZb`KU-G-|)6w zndvV9d4Q0hJYz3({el$}vqMybACim0D6n+rI&)v3+2=e612`<`i-aP3LtqjS5CU%Wrf z=O`HOf?*@|AdV%}7NfQZG&3<2gRJUSyTc*qh=CZ*G3Pm>7|DE?FGXR=lN%b}mtb1b z1rM>&aWrby7;ix%*Dpa#|4^`sI$P(6{!VpMm>04BaNt-cPk8fn8F$W|j?+z)$6OVD z##!;AyuQuZT}kofr+pap6>aNQT*XWKn+M?4!O*nH+S_+E2GWr`CgSa~RR&XQi&kqk z^G*_Zj|_$$@-Ak!C@KWuocK#VwJ*68ilcJJ`QhrU%iQtRBI)^~TNgrmSt0paC zEjdM7udN8y5oNVXU_i$oLO1^b6Hel({^j@ ze~Jh&+30Zj=hxKq{Y3svy5MkVU`Q6Pq!Yl?78c=C@l7P+sSnQ;7Z)e-MWrO*U_h8B zHC>fmbY-&7)xLTWsA2pK6C_`URTuRilhYSragL-M)b50;>~8)_St*4l~w7Y5?R@p@{DJ9zwM=M0Mx$D}%p(*c>!Gw|t`#3pIus%eh$ z7oo|}+H1tRi0g@hYqF2M8ImqXZ6UK7bUV{hMa(44T=e;x7zvu6*Ut(*{`{DB=~%15 zq=gp$IYoJc7hf<$(j;6_9r9P`WiN>m3C1v#KFLKVe&V@B`aHtgDwf4B2)fBmw zVuG5%xUBK~^GECEbn3bix4My`FR=pVg3UpD}#IO zQtfpBkdr?Xz$S95o$pF8(+B{t!G~hS(deF`=1zVLDHrt+2o_9pkZIo1(atC7(Ipw` zj1|%n(diDX%vg`)Fkan6^Kxn=pZvb5eG7dCnOaVnOvJ2(9R6P+V)VVO`;37M*eBZ5feH=3UW4~%5eR;3SDq#8o?&M=);TCl9it?Fx(5JU;UJWvenM85{Dccy`rtkue5>U7-8T7!3aZ>T zNJa=L&wNQ$om=3~!sk=Rx!U_7mldPZ{apnmmjz$!C(+Nr{=hr>TXPYudT zSOj11pb##{CXw|PQ@_dhhJyl z&{U4I99FoqmKooq!@wFTh^T-HP!*qwL4kdc#aD6&Uew7f2c9!FF)ZRJ69v1PEbgw) z1YP3#yjPG;U2lA6&8hSwb@-y{G_@63eI!=LBql<1$_=c_uM|sTUkj#IJ8k0?isHH| zMlWL>KvZxr+Ch|*dl9HURNpZJHSV-*14@%|4i}@0pAP^cU2|jM=VssULk;2(1l%`7 zN}d}*@jcV(V1L%9S{#^00%5^r1Jn^5oy)9)@BtQ4B0-WjB_A{8^dAjwU{n_40oBQ& zO74n!bY}LgZB79f5FV3$J5b<{%~sT9dF5p%&AMDJc8r3W)aPRo3#p#i-fVpL4x{>k zGCHJ!oD(h_*wFm(A(l!+d`h7&yu~-Nq9F_YX56VVW&$}m{U-&K{UVQ?#(B`y(SPI# z2_}g=kVwx43MJ_KS3kt@4>hwpR>&<`)(S)nqmF-jaR?u$P%qbtS%hhvkxwa6% zf0*P=(OtW~2G_c7Aom~t?#j=swP_nR9@RSHcfYoVXQE~z`AfjZ=8RN~eSHlfa}BTF zdvoC=InE$RzWIp6<3u$&B0{87*s1BN97=?9#v2U)(@}?y!!3+ecI@qRdzT{%_xv3j z>%0{oVgI4aPEr}IdM3og_>!jOrWptY5s7vIFo(!Fa^rT{$j*d%Nc8-b9)>#X5!2r5 zP7Fy|Bs{S;N{kEe{5`-{e~g{5=jziC*pcDiQZ@IIu(gt9DGUlI6n|fxK0IqM9|-jz zjJ~@a2)9y%1~SLIz7+UOXo#5f%=HS7&PNs{WXIa z>+M=lGHP!drjy-BcyiSDlk3(m>FWo=rx7@gJ+w>CqmBAU*%Pd4eCQWAh&jKbG~H!@ z-3Xk0P~W?u#b`=sKlA{kvXWU=Np#rA#@|-* zL@BA%VgbI7dU6K0$s``J^)+R}udL7?IG|RzN2n8Sc4Sc@eQ^^w!@InSp`xV94JM|l zAp#Ek&AB#BcIJ7ZoiT-*3pPNN^U4vMv@!jZU^Pe`gA0^Vk&{M9Bhu{eIfO|wC18}x zCpza##P$A}QKa+0>Gd%@l57AsdZmJuQ_hv z9QNP#agE3Jh)E^Tt=qr|=@W)LZ3ik55 z({OJ8-SfsA&gYnTGIlO!@c?y39uRe!1n97Aze$vW|K*qMJ*y}j@Z$2L$me}ufPc2f z`f@*D_6}}#y!AwNEUP`3Tf$^C2C3*+|?=IPnV2c2+AyJU6KBVmmH9>k-EY4F`_QZv=Dk;8v z?_9NmG|fF*99+!~NTisW1s#rYZumwCkB-ItaZ+HEVdI0GnClxIhY3V|_dZtsdg_O& z0?qpgd5@`n&RIU?2bwLiL!({wpsnlMtMUB}{|g!#=`i^JQX>b`e?^Tf?EkT<*`uLh zhtq-RJNs|Hp#pqu|KZB0LA}qR+dqgvfT%~*!(2v5(a5aR>{Gq&*QZi_m`{vWiY+k& zHeTl_-o;mi=Gu3=A}83-GR@+R-fi^phQ6)q)^CNIRFn|9rORin!n-V*!n(Js<|n7y zkBUC%_66KXy3ltGzq)07)U>Y2_-x}FaKw@a&SmrJ*Xgq@XIXNOlj%!6OMvHJ`o)Af z9fe4Zt-2o*Jg4lBh6?M?7xx>@9`o11XWn*V2@5h=3pZg2)L-749LbH7g6kQVM~H69 ztfkY*@jM^qWMt;mKuqf7DYvlm>`rn#Zzt=~TJI-RU$b!?M}9aKn~i`M=bzPv8*i7k zvXFw3hJT)C@piAeMPq`57ReBm^BaIp1imb}3N(p-K z%#?qR(z$8poyabR!JNmm~n!2BZz5z8T&HJ z)>;9eS%%NEaB+WlqE@E0p?V+b>Ouq&QDN;x@-yW`?Q8`RRFH*KZ7iHSij(93B)Wp9 zTOQZba;7?&8_O7+BD)5TrF*~o{AYY0`%XpLw@-;!n%lo^tp-_CMy)=vN?W1xNs_Wk zI8L2C%bQq)^sSU}#AmrWFXF-5d@QlP*xTJ0peny-reC<5A`>AKAJVv`H&Od1Hp`eP z_x8KG_}u%-RkoL3fuNpVIG+r?WfD#0d2__*+CveIwf5*sjqJTa|D3DUf(kl>wn+v2 zstj$^Hr8Mi7LTr`5mOZ;jHP)(PdsUdXvp^A%`;@pGei{@?(j!NdBmzFe5QgpANyPnp2g5{ZGPKe@5o3f_5O5(%~xF+@0JZm z`^^Rdg(Pe8$N@AruZAK5@^c({pG9e0LxaT6%{@j_RJHHy$Xd0uK}}Vd@@;8kZ}-*P z)y2nJ4}JLg;tl86U-zq9q!Eub3u!u$W?Hxy1eOQ=aD&f|zs@|hz#M&4|9(FzW2Q8~ zg-#rW62cg%yH7wLefrsx1X(;1)8qtUgNyi7md7THJ{y^NVmD0? zOY=y-+g8SC3d^2xv<<4CoCJk=>9g6#3TN0+M(gs(U%xYIua}U$3EM^6@a`CgWNh5}tqA2Me=~Lpu&d zgx)0j02!kRW`Ff}&|ldbx_Vk@ooArOXN0M?rJ2b{)t~VL6Tj7X$&s#JRC`vihd0l! zq&kI1FdKCCsK8BId!YGV9A4YaWvmtxm`#?bsQ6nohB;x~XucG!o>m(z8?#K%&S)0z8 zJ5t6zw-mvxC&Wnl6f|NR#a^<#kG_$o{c9O$2?hzZA!jbKHw= z(fZpF#OGe6NGvJt{m4 zh3F0^aKlUGPjz*YNCSrN*Sy@|HUx zquOQEkGx_!=Z|tap0NP>Krg9;jX?W1Tk1}ou?Hp8*ATHV9TYG8wl8NF+mm3r#`isR zE}Xt%ZN3My?arn89qkDVcygR;1<-E997Hue%OmrWkjW*r$qvg4ghVW2$EHY-i^p>G z4<53RvH7}J55o#kn_OW+K&q(;|NWjB`pFtB6iMhbJGLjiGtY~Psq|&M+!?{^kw2C@ zVH$5%;Ib6coUZQK!QNK~#5?1#*!vZat(lbN+rYrlVCK%}T$+?z9E{aU!5wh0pTAJB z@11|g>Y^auJq5=2i7<9(*6~q5D=4HV?V6ur9^RtgDOQu(WB?&Q+Rr549xs zb&%k~u;)Ve$((a@Rp&!1796^AZ3r5AqO~MM+h5Kr`1o|L{{s071U-ehJ)mNYVPl%r zO0r$63m|HGyR3c;Uf<;TebBeyJa7Cju*dpe!5%Bie^~unG^CskNB&3ZRBs6nXk!%Z z0T8q<%~4b7t&+iKG~Bo@r=qRozTC#7%M z-3iAwBE^7H?S^hfk*w7r6OyBIy-i1l72dvFwkWUjrGWZkC$Gg_v@xQ?G$Z*Yp547C zR#M9O`UD)%1;1)vpk{wB&G}_e-GwcF^RPU8!$)29xw#hKA5`?TV-7#^aNenuXKeQCV|n@pi=mZSF}6!$~& zamGs)aEb>~Oizi}CQe>CE6xT(d)qLBYwN4ji$Orv$$W!3-pD~e{Y_rD$}o9y?0sbb zGMg*OaBet;$c)mBLa&Kn+j_d2}R=#Hj0%m=6$dW7h@U{zPhXv!!|J z(7}p~VZZLBTN;`htHI_P_s{%{{d!qHn-3@!PH^B5QjKd^GhSrrg;gEG?785*s_rkj z2e_j|bp!H|^wxpYkWIV0!j@Q*GEIq%F&gW&KP>D<%)$sEiwX`QXL~;j7b>oVF%KH9 zj4BDqW)2rOim+%F(^5EUr%|U5-AN@M?tH4bllBJkf^8O3=*rpY07C-yZ(x3Ct{2a& zI$RPn*aW>nKFXJgmjcarDvU^s0}P4GL!ez?BrAF(2wy2UzF}6*Ggrh*&|f2`f-phe zQB%c#4YJti3^=-_>blT*#^%3;Y8O#k5~+Wu(59D$(h{?&_~c3=-Gg9Hm6WMwxk7M{ zM(1L<#p!8DwA`qC5)Zg&a=6MjwVy#pmH=Bs%rLm!Q6$6%p} z%k|WBlpFDJu+UrbJv;1Yo9rS)dur7dfKK$v2VoR#n9v&z?xY%2)?;u_`O9RmUJMSC zU8y*4<4=KHhtMvaN`jmA#f%PsnfDGGQ{eg8QI_&e3Px+urGgG4%>a|hC`Wio@cy&p zD(v9b{8XQ&Es)wI@}S?=BmShr3e#E;JL(~k9@J5_0{`I!HijZIwh<8y?3z@*1_-6O ztV^6ee?FvL)xmsUf7$hgXUmCFg9V{2W$4^ZOIacXt>h16faCh|G*4UNaDBYbAI5%L55UsoU#g*31If0;=3U%;eIN zK3Gn;1(L__3f<@jNUL~V=qct5DyAKxkJPbBmSj*xjjn;D(~O7A>u~WXaRQ;1{MgVV zLQkUz2lm`Yx*_^B$BuV{qS9&mM#$6j|GQii^SWGST7BF4Q*2#esWD27b?a^UTWU=WJyK#^vm*U z)eW181zlbNyGOu|Gt$;l)!VR{A@Q`;n3ji+qZIbI1d$7nE`CSKl=NB z8W!ifu8-`87i!A#f1m^XIEZDWFq(zUi`whmq&ql?JL!s=a50rzp9kkHGqW@eY|^S0{7shRZ|1hsGv z)!Io|q#EN*+*Z8gIWPv5L`B{40Pvfk{I1uo%88?6`({#51TVxe$tzQqctHVb)f(&Irsevq2oRxXlE9j!-9+(l*QVLLVMxrAaO`(Pp1x_%yC-Ke;8xQBe` zJsV`7x>H$%2Fn_gpfdFK>w4e3{edo$xvKqNh>_#JBSz-`*v8D!(1_aO#s$C<{3A|XY$a8=w%vSB9Rex{r;+@rc}IS1QLbm@1y2|tEZCYn&)bn z)|a<&jP;YWec$|fZu|Puvr|Drm!x=ogXdPcMv0u(y0*RiSDc?;?Q|UWGl-E)(Qo_T z-{5?hZQY|e*2gzs@3VJyX7A>&!|T7lL8=iaq>XANEbmX<>*Sc2X%-}oH&Jk{k&wn_ z<>B?8cvG&AmW$kzi*dkVo*3VEt`6JaMR87xLCZ$&awgSG4Il8WH73h6;QG@qz%3iG zx6(h#^RT-1_2HJ?;)uAXNrzD#n&lQ>wr$(CZJ)Aj+qP|-vhAv=nR&UrZa;MXf_%wX zJNJ(Gf|%n)o3MLUhL7Is>yKY0!q=2PL^DoZG595!f?BqAI3omOgiLy1ophDrG2TA| zXC#?fa>POvW?28wqq=pCCJ6t!=eo0Gs;hE>Cj>C{aK~WlT-t zO8+~x>H1|0PERm5};=0s~VX9MX>%}}hF+FO{u|{rg z&>MoVPh1mGm-kqwkZ%I0{K5zf=9?j?Rdd3&>BO6IH#0g7(YDe(zjgn8zY;MGA!bqH z3=cuJDO%9fB@Gvoy88aK{<-BcZgjb@P+RV4%~{o;oH}? z>_kypV}ZG4wIMrG41ySR9L##0=7ydRWp6}0c6k0nMEVL5?ogz%J07%hm32x$Zjy+q zGnprPBhzlT(gP~-u3yx?L0V=JVh@5aptm%=GM66-5M#JA047R*`yxW98ufx6Y|; zb`a|h)pl6z^%3qY0AfTN-lszkZL7^e_$Nmn|A3YyoCQSSIM(NT{R^|i8L%}4~9Pg*(F!042AF_xI_Gc%iu$T-aNEhA?* zoFiD4r?U{*qkklJeBdQ%Q@lD)52Z}c?Rf!`)CX1wnU=R2Zej=eq}*)>ftBaG~FLN+0?8A(>jQxo(T>tQrOl6`h@<{$r6 zW%uI4TE$-ZmiFNByubC^Q@<_P4oQRBbnOe=X%+4+ivnW zx~d}<*SVfz-o{UPDQC@L<`swBo!rx;;?k;VT@7ga6H*~6o^zU`BPhXS<&frxxy(iJ zY+3rW60kBV$z_?R401l3Y74+5xIk};T1NaV z72zXhqki>9!r4WR2I)><=$ICvOw*x&=HvbmH&@(u5H);&E=KE3 zD%KRZFv!hJyGRoqO&2fTqtBXfOg;Zk3yDU#>S3XAGt3_j4%{t~WcPy#H{<(b&qg}S zvFmUp(?Ri3AGD6F(Z>{ zQ70fyyBZ`F3DIgfQHtVXVt7C=h(g@a5viVLf*rO%jEf^7a&&r62_@NOhf}fK!sXQ? z;3k&|2tsgtA<@oAFX5XTd%S#agdG{gzap-M1=XVgkd>gLGtj{hOnYEo>0SP(%1V47 z5~x^J`yFFyA47ekjC5-@w^}5UqI$Zp-w9}fJzaSd1WBD3E@Ms7){`+p+o>)r?ha7? z@k0`(MOB$$6CJ(N@P(P*!ZLq%N#jAZD>~LXDQHrOvK<*Z9h2-*-YH*35^7Fv#7%%`Ipq8KTGCEuX{stOu_9S0R3)(psuB-;(kCkxbxtcvs;uqvnfX0lbkuzP{-W-C`hX09*eRI?~xOg7sp%=9etN` zOeluJnA?v>SQ<6XX%y4Vb^e7yTj?3oZ6jrshvEpbVv1)Ry!gllcVnNVBNhv%*Y>TK zARI#f=&ih#y#A1B^;Gugdxk*7?kWC!&uxQ1+QY-)f z)%nUp{3aBD(*P_5|3}j6o23P)S6iY+#jVY%Wx=F3Vc7melB_V|#kV^)=KqeDdccm) z%Bv>K+xmAD%GDMCc%ig;M51`Rj%zp{)a4`HYqap+AfBFx*)urN=L=k?Mi?62wZ4P{& znzA5k;p9Y;Y5xS--LH1iV@IC%z@aB{iO;7UEnf{9HD^>MVR%gsn_qicOsCJi}*eh7YCtECZA7-M$bGxbfyN$Sr1HbXk1uMpx9{i#s zr&duD;-b`&!u72`!c#rcjd>csdd9&`>cMV)<(*0EL)92vPV6vVujkZjCU zC)r&ULz2_V?64VVPZ}xZ?PxiL7^v4=RXbs@rt4(d=Xl%clXKC|fJ)$gguP%&7dyaL z;eec4c(yldZV4)k2ZD?gQH|l(?+p%MksykQ!#*5&IfCoaf8*Cku6+f4IF%O19cr<` zAS>NpO^cLNDcoI(-T``HgWCU4t0B9?*e=K}vxqs(bpty$@auT>=1_K{k^jb;7;iQW zh)oEo;Z1e}2`d33KC4CA|GKS6;i`61GnS%LlS|i~Uf;37hLsC~U!I)_YrB^?w`Maq z8#BlFMh??NDC2nF*oXPB;aYNXCPDU?bGhwF?*Z3zJGhqO%&tWdLB$td(PnqXn7a7zrsFQ$E=E-#v-ym-|^#4S6SjFr`Xbl5c)l-u{xT$dEK`#CU`o5<7nofu9B`G*xmj(HoVLq{EOS_Ylj zq91bjxktaLYHB(nur9sx$)UmwMl6;dd@}^!PwzU`m)`T}W)!xag9J*mmZX%V!$VwG z-_y~h6jsot*ZcDiY`CKyq z-nz?IDj*7jrJzhKxDr&{yo(a=i|oS$h;bFn{MXRE>jk>P=%%rdgh4lwZq|zz*BR1W zSv*xj1V^ZWA5DyS=7YSG@oYt5Ic}H^2S6nT+-ZA8f#1e~g(EItKnEGn4>B<&y;Jgu zhg%=HR(k^awT*{4M3(*B0K#q>lK~mn5ovD4m9fiQAhU;LlUwG%F@khD>(Z_l8iM7j z#OfeXJQ{+Rb1Mg#G1TJM%IjxpL6CU2b(h|y!+seE5{9C=*Knq{D`nocTULq@K}hD} z60W8I^~Gv=Q?l8gw&|z%LW5dj>)A z)$^p0McF_8rAQobzYb!5))bqAnG8ybceGkgyq=y*J|uz#d%MhlK>jP-#JA&&Cs zdMPpJ?2PpFy26ZweZg_XltHf%+YIm0@NSqAv6V>gnOpIkntp!jw0V49rRjdA0b+52 zoLPv@UA~|CVpbX$m`RTHrKTKmp_EI~)M9;Tec})!^X~8Q-O~PDh5W1~jV!W|6GP-C zh1FE4@fkp+RvLhUI z-(d0FyJ3Al_Vv!pkAnX1bg}l>@xWge$g)c=aWP!uwD(DT`XbA zx)w%KDk;YSeVn5GdqB45e!J_yqqY%=r4y;>$DgjpnGTOkL<&&&NG2#f7RprxZV#uY zS)#i_3{wjTe{hNL`Q-|Ojnx^C1!w+}V$}QmnQ)kB^uK+gP74o063;?JlkQMQFusfn z>t_+G>;iCz+@L^FJd_4G5!pm70Vflg@21IE=N(ecZ=tG=&m+}~d7n^geu^}};z2}8 ziVnNQpXu@I?BdMs07g%9z`b07^L5DGO{W;59xN~Ff5zw_AU>Zq|GhYr(kJyha-c>T zO^nKCmN4@v4q%%f2~*P&UX7(#Qew!H1Q}AEQVj|tn0fGM9dCEkUSsVAOV3{($M~u9 z>D~~;p{WB@{-B?J>0?AnfXdgO^NfUyhsl_IMxi4qUt{=LTg*_SW(_3vb=p+@?KFF) zOGujw5J!_06o$fB7nsMZ=l~O{nWurN7G$ld3;GwtqN^6Nc!Jte6tcWKDoCKEGe=pu z?dh@u+6ias3}c`G75nZQnVJkabu_l?+u6~)WPRb=kVuirRRcfieM{l0@nE?2&jq*d zGAK6#hsZv4{)CLoAVa@1NBd2ekq@mD4|0WWQ%2`KUiy6(d}o0?f331Supa67dVD= z(O+NtjT**Cab3dhj=m>L62FuWro%g-cCi6NSmfa4)X1oF{T-HN()mhNKeMFVn0}mA z=CBIPzR2Qnbz;7BH9P+hedMYA4ad@S3n|D5WM$E`Z8r!aO|fq$(_^1G83bxfGjlw@ zs^$j(EBfL4Up~11iD%A0&&K|LesM9XT5*M}DE}|dyqu`9A!xeWQtjNPqT1C=OXhv) zEC^UO5X^ohEj{A>#Of9_iC>FE5$7R0?iXcV-%W>i5A-IW8+pWb8#(e}aAI>)9|n{L z&T;Pw4sU`7Wq@b0Q}ekvx_(@{U5f|DAiXG$1)sUg$L+i3PY>g>kZO51If!q0_s0rr z1@2<(N8QD&`2%?qAnQ$Jcg{6PNiVtz;1FX3Pn>=#$-L-0V~GVDq1HbF`DoAM&(&!$ zHY~yn;Y6M5;q?^NFjz)K(%NbTN-39!O&&j3kYUmI2itHEQX26%&8!9uQ#*C>gD}b< z{$%;IX_gnJ#(CxIL{!PFL1HQNV-^$xy)Jd3Af>2C8RMg(!%FP>gmX)1I1$cvgQKFV zo$MO0`SHPnf8j_ghUgsbJV$K}pZ>)hh6{~G1QwGP4 zv%G&L$V-27?xD-lT!^}2j-Q4sEgx`>SJI?d8o-A)~Ofnys;bBlNyE4(fH$)iaF0uZW_oUyD z++)_EIWH@y7A{(|hfv6xS?kcD%5=`83J7eKL9Jv}X28ve-HTa%FC~f|1LkqhqQ=D! z%%wvf*Jx`%?<}S_Q;TXL=>}Htyd3CJRE0~k*Kb~=hCdB30s?D7oth}~;J-87rI%Af z0kcbU%21KpQKk!tIbqR1)E9kxn=>d*(?edqB4nXFZqS9ak#J0KxENZRa#KA%^Zx$) zAoR0GvV3sCrcaye)7x%|hLi+~rf%PB70itfcBZVF&r!ona2z(;*Oohg9L=>ZQEg$d z9P-K&c~Yn^;#0sN3xPdEX9fu3?>4ZCtiop}W=Vo& z8sA-$qiJ@DE~OQ$c}fXBdUTj>U6j{s$=w(gcbPbR?v%(?+QB(Q?Ve;N%b%yztXQQ# z{gJYT=9!NVq#|5wZM2ppxtN;35`j1vW2R?3TI_V999DW}(NUmErI=-$e!7axLm82o zN=Fe=&0%vmNcy9*@7n2+z~wq&KH;CF^(K2lu%E>a&NFbjfm59>TRIn5xajcWO9C0- zw5OwlUb!^Zt=|2!%Mor1Pj+I1N;g%{;99-RIRBTFHY-P0j`Rx35zoX%gvNoj*mxJy zZ|T|b)>2&BthhTbA+UMdng94K1E0kv?l_R6%*J0GYBKLxjY4+>+UBZ=1OhiTDJg+K z8?v}&;|Nn?0*P7q6u6`-BQ3uRd&C`NM@@{wZ21W13)iPmHSVvedq9oscKNoX-pP@V z_U;{@-}~bmp!etPYvu;VCUw0HtF_^egzY3yTuIe($z`7Ju)m*5xjd%FM&JB)uG`Ly z-WRaGCf9%I|7D>6pP;l14DA0YK7Xa0Hdzt;Z@y5u6~XI3UT5mljY+dhEXX>RdH9K` z8B4@L{gFDq9(1}O~=ftA6W(zpmy0SAU=x}ydr(q#rS&35M`4{ZS0%; zqU~|_sV(j~H{AS&?Yulwqi^I>O&EL|g*QtA9}gY-j`lcj{b;) zqIY_WN1_Qpbzt-qVv7mw-oov_9`s@M8^jt(n?lMnWZl{&66vX~PkAEKf6KYBNoy2; zn?kkqM>`=R$WN3hUJS?Dr0r#Jf}lb*pIS=w5osrhcBkeh z#)Mkpz0+d(WfxJ#n65OTIQtn3$*6{M7zLxF9hhUS%Z<&`_;;2VEBy*p>KQ`|T|bXN zHe>Fs5T6ONc#dx;a_+Vkhrwr%w98NF6pM6e8bA!M(dY)r1=yBimDznmkQ0-%dQ=kc z@?B~sk_srh0fbB8tmQde+Qj)KPjDL<9^o#TB^1d#vTHGERt%^Kd6bQb8!1yD5okH zLD>&Z(bN>*4&#nqYEk_&FvqD1dYa*6_FPEllUX!3Mkl(U!shU5$|uj0w-?tqJHl|) zGAF_}_A_)eM?CaCmP$mgBOH>5yXZUl^c>eL{|s%6CWm_&uVk%daq2F`mbFHrMOR@fkF-Rt zQdDD!K;v$!yZZhy5E{q=Lk21+pB3=#T!no`sbBJyP3>^0wiTOrh4f{KI5Dzz+g18) zd)#0|sQcq$?Ua!$e>vM5TS(DV02c}X@vv~t9gwz@Fft;7ka&J)xM+YF1-XM3 zRp+MGx|GaQf7YA>^%#HPjpH&&VZ?&757?+ibBe=(@kta6BG~ePoC^yr|Z_!`5Nm+W2Jic6D#W+7Rmh$w9F!n>$L(n7SyM#sX1rKzciF{ z6w~FEkl0vMn2R_8`eKCQOn9y1$|s0-O{vZHjeR-xcMkelvbysESQ~HhI5yT3NHdKY zJ&b!_>kRUy8d0IxL>EsbSk-{udt_8>zj{Gxy<4 zWo8nu++YZptoKPqspm+6l!J6$!Ik^^cd= z-c@NFKHpcY@5k*Me4~AdYZ;n}bet!81in7z!X%E$+6~uY`BKE&JogtgYsSamAnm+m z@1~gF_apv>>^SHDJ!Ub`|4-0L1}4`32z6AeP1`fNerd@h`+6RAh!bzNN@c=+F4}?&iG&zGtxFAxRli6HItz4#z zK%QKCjCNdtT`X`j)ZR#ONc5Kzw;y4qtdVL*4!~v~rK%F8nQRk}1aQ?Jij?wRaB%e( z(bOi=9GjbSSTWrzik<9oR3`&g?fDhKwM0qY;V$VaG(LhvQ?sE#p!TC7Ka;9oL6&Jd)?{b2l0Q;L`5m(Pxfc`K*Yn zyd)w5Nc!Zq`-zQp-oLy6D_D zUq5exTdP6_T}wz$N!_Ls!~RPwOV>Q|j>j+~2KVWrqeblecW(-4#U0dY1>=wagbD`h zH2ul|5>7EZgp^X&GsPc(SY58OaX^YTS`jSWIUzb&x8<}BCMLQH((I^MIp49PMi8gb z3|zX>f<3U#lXF&IJ|pqu)_ma!L~1w{FhC|z<6dZAs(I?5qDt_AgL5%7ZsZxM;;)b{ zC_Le$7$xr?P@$kDJWLrM;(EmswEQS608$D5R+#NW-SfEFCb0r8>>rq|lL&>~Y_5FA z9EzD7&=lku%F}HRk2wK0z$GheK;f&lFvd>@c{3msv!(S$IV?0wRn;TBOZKTiFp^F0 z1`9qfb@Q8YJbRfQ8)(KNh$6RkuCFoiusUC`rEUlXhiTJArz(CEBR)~cY=Tp;TR z*8V@F%4?`osM`+;@5CW4yRiM~%A2fb$|3TKa8yr{TLqXKWXmDIrRl3dS)idkT-+Z0 z!Du<|+53TRD5^+pJzz?8@T1Qi*_D~GOR}~x<>mm3LiyF2) zYCF+Bdr|9mL`mbBE+dmKA}er!=acCg&T$K)31bKVmwJ=)5rmKXduRHS#{gf;tu4Ms z8rO-o%F+8SXBylJ%{PO*bgqwWv5NkZwsz1lz5y+e8$1yQ>VJeN3u787TJNIn9c-z+2(io6@^6UM{o z?Jz4X8&+2V7ESd9fgGFo)YG_u&)d{14xP8~kB7XoZpobiA0#4_aB5qy4Zt-Ids|P^ zRSe5ivjQ4_79Rj1-yV!f^{zzE^`Kx@nH?6V<)PW=DVLs;7$lSmTot~Q=$Tl|iTO;k zbt%~XfRePLHhg5HrVSTK1DAd}sO`$r+R0yxDJJRGEx^uKfGyF)p28x~lZ`wNiHtfd2)$!V zVZ$ou={=8KFm*{9@k7_UD9x-(n0}wxhV@j*nhIUL+3oi7i`nUEe^c>ukf`kG2wK%% ztG=hK#_LyT7EAGuTcBCttH|y2se<`FV|~A>^aBvQvr7JNy8J(}&3@(kKSod&)yde+ z|6iAzpyLrmcp9za0U#4gM7pFp;z>44DU)LHn9`q5oZe6p&4ld886z!{ydwJ@*N)PR&P9EfxTgY{vJ$3( z{;mwh^!MG&ix0#VZ26dNTc=}bFT0F6J1LJeL>S`<^qc%Uh>q1>Yn%gGRXG$NnV$&G zB0ShLi!V@;Xm2Xyi)GaMtg@C9Wm{=R)|xHp8fX;JJ~dr;)K(5L@>)Y5wp|`wJMb5k z7mAhRP31?35{*MAU7^2rc0dttQY%IrGfJ_rPc@^;`O(lT<+E6*l%Rq-9|C+UQW znzmmvPhc9E=e~uE#KCQjKji}(zDdkp)lJV8C|PzKGC(W}CN&2Nrag9O5x0VqBk*e- z!!oW=EecC}a%WnC1J1~qYBz{;Bnum-OfyV;+j!+*ns4N-!T*=VS~TH>auqejVq3;Eqt?RbUDATn+F66eGts!5)EGi6yIpGq>||}nUa3C^qwzl9$_JYt1`PZhp@Go z;1vD_#=9O$iYkkXQu$Ya?II554_)jm>6b7XJ2h<}EH$ODLO=S+|_1;0+SD!(5QPwmGF7wuRk2037dCl*d`s9V}g7dXa8`_EcD$q zmg$i?O8YoIlv&2eJk+dV(v$COrH5%pRtaw7FV|DUt&-hlKy)r0rvQ5HU0cGXN<RqP9Z)zqbBXX5A?*FW6Js#ByUr z10x%I4dsStzK#i)M((0)ss_^Fa_I2Ff*sHUoI@XzN8at7+D?vSj2(<=ETTY@X5EH8 z7MS@Nm(A1bAT%YUWt1G}WwzBdm3}X``j)e^%h~xHO#Py#3yVZkhe!*`sj()(@mgL6 zKv+xDQPP9EcT9a(R!=|Y&2LX8GOoo*)oS@5`FLsL%WDeO&?4ImmuPFP}H4jRUbKfpw3x~V# zy&@K=BPuBYjoP1g*WcTSCK|2;N|k!P-5*N5UFo9^Isd$T-Dg)sYQMSh6+AhaH^obh zG;xCkMJzOjM1m)nYbLb?_(<7vHJf^37cL>YCI-35t+JLGXzTXp6avyl3cQJc4>p5A zu**eTMs5po;4-UuGT7>^2mDnX(o+CW#j$t`MTuU5lfd?9idegY|5XM^K42Ka<~_R2 zQL>X1de@aRsgI}{ag?E>&aq-ydT9R>@o&AwoI$20M~|*aO=a!OQ<0ygoL&SlDL#lk zofIrd>6hW)T{uTFCPgcbo@C@Mu`$ezjhuiA!^i2W-x4DYke}ovRYk@o*4FUqYJ?T7 z-Q5G6Ukv4#V5d4jCN38`9pBJG=yrh)PD<^@@TZp57H)J=iDDb8t;)1jI59rcIJ^g? z`N4)D23%NW&jbk-E}@IJz~ZAjs3?Q+g-2zTkIlhQ&Jbn&*o~yl&5afDAON;XkRqr{ zHPK8>`4AOS^@$jd0d5Q6u`(~Snn+3U{<04Ar!MnBkarH`hGi9-x^4}rlc^r8rS?q# zF}b)?V6w~aQ}4vq)08$`tw-shBJhec{ki977O|zT0T#)sz^D2+fHK0r^&p1oWhTASe|&qVEEIEDHVIPjXi;%w>9l{^j!0!(6*4Pz>r& zeqt#GL^$$3uAE(#x=-xW|1dN35nG@M?(~v+&IQBYH(`Z_iis&<^>9Bye=_-+Z#;*u z%{|(l>SCG5%_UIZBv}teD`d}@2cT__HV$6m;#7c>G4yNTfZO2843y}% zjH_Ss$(D6wZ77V&W%F-Mcou#27@ozL(TS5jJa8uDJAxCkbM^fc#gdSPomM zYhqf4*6rZ_a5oqh=XUzl`LX*HSW&c~hD2QwHX2mnd_*ZG&C_(&{bo(zVw6$@KK*rv zLABD$E$rw0LPx5mEbw21iQ#`j3;a$y|8ZZ-R+Ea$`u_|e_Qpgm;O6Fiqw4kl$YYT` zYwkK?e;gHT+ecbLA-wx`sjOEBG+J?VIyK?UnTvRD=KG-MQ#Kqj4vCA|aQNb4J^0qx z6IeD~pl_8#2Z9fnCCt1nJTBZ|_tyCEkB6NvXm`?{H=dTqM%3t+yFpjX{JbA@eq>z1TC~x-Ix+?#z zlL|z+CDwro7m{N?OcHd@7Gl}yO3MmL=hd6Cc~>N*QnSO$rRrwwQ@fn$M5iORnZ`{V zPO6Di)0Ms+m^)IdbAYqIt#gc7$ZCz&h6Rv@T#`&8|kE5$bW zLI@galU*w!q565Y9CBDQA=s(A>4Gd`Eo9>Gg$ndo^;_4Ul4v{kYZ~SSr5>x17|{t5zoHrzX`ya0eapE zPC020e8(>e?WlA;xCqwf|3Y6#45yU{rEus_dt9u-n1^+xl5CkFjziCz*Pd5s`UO7t zW1OpXCe^48FiVa_vSO|Q-7uR57A8;C?MmCkr)&+rEb|t9k67Jymu03BL(31*32mnZ zk+hK^wt6o0=UBpd`K``xD_DE2{R3MPn72*;uz%s??0-AQmeoGCJU-(|U%xuXD4hrM zSc>TMtZR***G$Z{Ev6^LIA;w47*X>{DF}qc(I^qMgEZ>hD|13_dLQFj#SL48lC7$# zv)VYN8DKFxcE=pn=nATL%SuA2F~*<)I*~`BNOE&=xoUq4JIMWv`My}3eC&p655N}f z9vBACt*4tE*}EEr$LIZy_4WEWga68-RpHdBI5hgl*Tp${;bbkVOT4^*R}o=d_MrRihSWL-yfTuLx;={vrt;F(QkgYfN) z_wDb6XE!mlHhr;aohOCKi`*C(#cl8-JjIC=!1%hss^pkyNm5onu!MM!67(2 z->-KvZtwU(f)KA6wp=csU$4j!+PvptEHJv3rp=VFNHSWRxV(ge(lN59ezlk1DTr9D zR^>p-HT7&n67?wBaW+PpuP8jlxJNIrrn?Kk6 zgXQ3EtZi+c-a*xP5HEh#V4P}2(+n6|H~>|o;LxC@G-S-6{0oXZfy=(uEMa2saa+x~ zlr$&?aS^;nymnzuHn*5G#c|;Gbv|rOq-AIY4?K)}{YH)$H|4l1%_5jZAv?Bz^53?Z z3ld1&bPfns`>S+a;&U}Bkx3ZzXFK$^a8t}?YA64#z(I*xAlGaSQpE)HMlSy{RxT>D zKWeskTvn9gg#>t;*E1#TOx4gEfC3HueA4wRYu@~2VVx&d1T~Sv>t?5xYMOep- zdWzPf&^@hY&*yTwv8B%ExrM>cu+#irVQsRcjK33dxHAw9%O=-Y52mnQkFX-x1snucZSl!k5V^3WQ`BbHsYMS0or>bA>ib}%B#IhE zr*{nDuZ?TqI5cPX=h~In@P1|Br_=)e-rcni!~KNrpydgl@KnE*_v`b~WNYo|Luu!( zfkDUS#Nu|ScCA<4C%Tt${M|2b8pm?+|E5m= zQ&8&n2+8sv>ZCfJn8l9JJ*#FP9E3rf8pyH15PLi1o^HRr<&?*-L!M#7|7iI0X>4gg zaq7B;XkvEGb9B!b@{lW(4e%|0GPGy6hZ6H}efjwvz`=amNKiQQwv%5jB*Yh`c%tp= zwyWkr_qLZn52N!QCRRZ1$k&3$)$Vx84b*$2EI!}7(|gjJ6|R8q0R#$XWI~LHP|_!b zbZjP3hqVaXqu9d?crc~yB`%Q6 zB4QP-ikseV6V8?R;zJYpspzy|uaVBolSo{O+Fn3tvvVuso?3J?>j-TY=AQpsSaC-_ zD|-&}hc6@t$BbRoW1Vn1$-LIs+hWeEAA7q7Po^ScFO*A7#als)kt9&9CQVe$%uZ2xoHaX`uCoop2?i}k zB%rOHB2+5{ENh`d51xs2zrOBx62{H(ae|a$WT$_q_nu9EJ_)-xmKE9F1UzW0`nUGd zBDpgLh%FJbgkg|cVghi}C%^xOKx7v>W9=|}TgG{%N%JE0w!XY1*-JUiJ)(jqB}-)T zrvi#yK&kGyj#113jVk{iW3xvG88g!=y_<>`o`Erl zg9o+bwrZj=3K&5Qb)n3;`O%N`weafORq5%Z;^up1Py>{7tkh41GSEttH#Le}udcJO zv^CIOR$y$7Q5HLKEDcYEE2ktH{mH#ZYfE9wYx5cPJb})rMiYcg~);6E!>LCZ3-_LIuOEI zf{*cq-0}4#4Cf{n5_%A~^OIML1Fl9p z3_DTRWEyh+DdIh7(sGHc)!;S9}=B zAwLOuxBg9|+jn3neIzvr(4a#O|1f|OhZNjEqX)Azw0XVJU7+NG-xD1zT96$c9-k%?CuDkUAZ%0V3s~h9aP#M;3Sta5mUB(iK93?x<-zTImIL8bx%rgiXOU$vH5u z-lg(-UogR7Ihy@;C6yH8c*J;z%Vi7FA0g;>C6IgS&&(w!kjR4MGz~+Y5xD&dX(ZM1 zOm-wdOK!x>kb!}lg@I2v0R=KD+uKkQ5FEiiB_O6NR_RFgYQ_sWD^`^lyTJ3}9$SX1 zPt;{NzOthF-q)la+}qP>XDaVzPA%o53Tw1XU`x}BYfw*<G3&y~EHD%EA^=?^$}E$yKm zrAeesgq5?lPEL?{8lkBxX{&XxL#*t>nPc87#5>pUpX`Uk0lZi`twPwg6l^l%Mj#2h z_?~DcmgE!m$Xf-i(pkvDb8=^6-YV?Ds{9vhX+WYLY< zHkSzL!L9@U^rC&(+Eke6+CFtfMPhtM+!GC8j<6>E)QN?NN41ywRnJh<5@gydn3piHfAU{0mKdl|PLLU1Kxz6=3%$!wdU*vHicNeQ;UU zZ-f6P0RNK#nSuU4BQqhYlZl6b;aKNd@H^Kzr7qwpHRi$xOHIJmQjHGi_m zV9N^+&o1`AQf3nGFpfNY`)&+{AvnBo4y!oDd50l*<)o-OEuw$8zmXDP$e_q{vL7sU zgh2qT`b11pnMpKWq92&6NHN$TXR2~fL)*yu73vWGM|9AHgg5%~{*u*oGzxUlnx z2wm><_|047H<*JpN0I<5)MfzXxnfFfq0uz3WAq0Doq7rbM#>1ndiU5TXj);WDv#la zIpw_bkf!J+`;ebLHX>Ril4V{MsYW|EDZ5Mj`DT^C#-3f|jp3g0H!uYy9lFd}4) zs@Wx-Q3tDEJKrJ;7Ih8yUXa)!JZM#ybUyE6Guwh@hb^)0(v&=##;^cjP%5tkb)370 z?2prI2DDL=pqWIn*DV5*bQ2(aUU-hGE0Xcsr+#^=Hk)dRT3=gSldbu+Mak!osdO)Q z=MsA^MZ!RtGsH~eIpr9@s4+MwthA6dj@*!iOzLtH4zH|^=%ZJ=FNZ&ZX1_68w=)_? z(0V17tO3G5ZZ>#w9H+8-6w1tK=qdV++>LfC0Pe$$?k9cGc4D80?Z3Y;;~hZ08C z9F++sskz;uu7P{UMjh~fgm|#&B1$f%|UGOX&tTF@c!w0T%*_ z*2p*}F#fSJA#!iMAec(-X5j6;WJ-Rg55&0gF6_F&-V|^CXYVun`~Aq}cBvBG6SWAH z7m_^q&i&_Yv2?aKUyslCO^1%ZcZ5E3_n?4#ZqhOZ7f&CPu}WvXjHa~lJ9)x4TXp3^ z!zVl`@8cYk)w+kR1}U&+RsC zTc;SH^sfQPppFZq4oV+uRRi_%xi`!L^{f7agP$UDk`cAv@oqD0lnqgQk$GrP*YET3 zHuL+{_wvIbepll)RhF##eGmgsIb?b(iBQmF43(0fJnjJig}f$8T0l;l->?N-CahG# zLm+L~L^q?m^sT&b1E2~NVt_u(%Kr~0L?JBul+bVPKp7k6O0MP5b3kjn1?I)m zs~^$CeBGDm)A*TY_Mj7O#7YG*7vM+9*2R3ZL3B{l)^76}rvEi-~pX;dTSgFbmSOPzD0qht`` zTBa`91NU-#9&Yu{-+5>Sb}yl<@Ie9>0nzU&pOcx4O5D@k(9w0hl zJ-BsN3%dldJ_r^TT{I4>l$4nFK`?9^a9F}qnixPuo*YfihE}i)D!&@wiSB~8BK7D@ zLl-rWXjoxoE>gTFWz+O#ltarN5V!#fV)HxkrwJSzlsXnH>e+J}Hu(pNI!yq;Gv2r!nvgIh;_| zFDH+UNjAX8P1O;N9;_4WcRjRzCmc0_1rRMDD@F!#5 z$cl74@ta!qVoGqYP@=n|;rZl#EU3gAF;jgt(+surh5X_w9Ru8MI`f-K! z&YJs*(VP{*e1A&V9IcUbjh@g}wnFy&!W9osb9h|yCI zc_sU#Q!6SLgJsAuTd?oCXuCObCNxbWbvIRbtM4ZI@JLTBt1a!0V#{tv{WtXPYOb90 z|M5P+qP}nwr%d}I)8UW_v!d9zRNl1 zyK+XX6_M-B%rTzPmiJ|rU<59cw=9D_5aj`DKETQ0IAA8Ktr=0MP8d>#L zZNBZ!wBx3CJL^_4LU`XuSBhpn{2S}){fx9wdDH-LA4W{SiYm{t(HX=uu?A%l%oT5f zBA)iqbU$I9H8wm%IXZEKhiBZgjE(sd{D7 znEstenx3BR|J}y;KWmczh@?5k!OQc7yWFkj{zszXIq}?^WS$YKn^$_-{`G*%w3L%xaPq?ZiI0%oc)0tMu%e7nY=BNhE<;I$R4CY`EupmE!9+bc*{88k!U=>z z8Wbp~kmt3#+J|;YF0=jaN<8MZ!VAZwJo!j+IKATvS_fRKc<)g*(+E(F>L(#4Q%GtL z>?G$v>1r}CiLr(z%LpbWgj^GF^Kq%ex+_@y%~|DD12*75Te(9FmlA`6adpQmxv+?H zVjUn#Nyl@A?qJbCsWrbzwb)=$&}KWk2s^(F&{#o2OG_8J%#u+oAYBbDYJ{||gDpKq zY@ydth;@Nw!{bC`TXrZEbDZ5l(GvcBK`YI0SB!3^5}1I~ZQC0B3oIID zoZ&3bK(;n%kzs-+zrM72^H&gW$~fbGJY;)x+tL%FQFq zgB=K#mKjG}U9_OiQ8Ex#B;-oSBW^+gkajR9%+IlZ3`uhxAV)dHSg|&C_2V%qF$W2f z)DD2WoMq!PuB@Ru?NXBzpb=H`NKW2^n~nR993V0MM(Ak(KGJ9!B4sU&98W6~Ax%H| zou%?X<+D$~&Pq6+fqVv$t+IN9)YP+AQ0}J38ggN<^9ALtQR|YO$D0tf6W)IW^*#cu zRn>PiH#(S+x7C16)tb*xC`gD~ZKe^_l6L!kWY5l~Ho$}>dqo57q_OP?m*c9|nb)3= z$0OrBY(IvW58dzr<`<0*`$kHS&3nXVt8|ubD*yDS3lvAJH4p}!;Aj?YYPEP7WZhqO zODUg)76blFm|8x|X#FNjrE!e0KB?%#&P}Hp0cr~IB$}VWIc9yZ5UR4F-$QG3#}_5P zPi#=sXReI1`@MtY5XU2U?l%7CXvS~5=j*ZLPi{kIjYe>Y#4B=nbFEm4E7!930^Tux zC&#HA86E1|0>S+Cw>R|P_cK1VazeX*nl=8F-k9;fS`8&~WqM_L06`&8MnUCuQO-S6ZOJz?t?)?GxykaTTNrRZYqc>F z1PJp|FwMd@F{aGjLqU@-RaA|xBxWktUK;!M#X@*)E9{AHtF-BJf-ym)X^q^%5kI9_#VTgQT1a*NbFSJtX=%e(&wQyG`a7XA?qXZ!ZrWCP}1tL$I$`s3go zlk*9lpmMYa-x5vr7v@@+B10R*W)}y(MZ!<9DljHbSgu>7xhdYEc*4c>?iHpWH&8j*9g`4{4<;>-@|=P64EpMn)@~C z2%gv;RSeOIZZp!|?w6F;L2|Lz`Fp{Of*AcrH54q5RLBbjEp2=xpHyI>fJnsdM%2+k zo-Bn5IiXc#FO(p`iKIy%g7BG(+NEGi2{LXFu+|3rr$Mr3m zIs-M<`KY?iekK5Mbas#2xajKP%_!Vk3qJoov)^AFx^3dF5PBQnKHHw<(EJ`Fc#F8K z@sq+(Ov8rRo%mQf;>oU^FhQXHaFW%{Se)3h-4?9|QTyXXitv4MH58Yhgth}Fh7AH9Q zoOr;~?^QC4YXFo;tblYf!aOPOqKm%;kXaV4N*19dfe}XtVh?l0X-uSN8AJ-IvOeH` zb7&w9c~RW{DT6Vk6GBGYMWNHm&HfY;hWl&>`lBqtZ{wV{0C;{qdKN5?%QIVs*UC?6 z%qy&dDzt!A)q8mMx7abAq58FrY>nSk)qNNg?qZZD>zSrb+8f^W_!MqUl3u8?`!*2| zFe=BdZg)HAi>TG`gFBb%S6jIgd0}8JUSe2SX*Pth$w7U&K7pyP7e{L#zz_Ru1->5x zgt8hT>cKhUR)Z{xzlg*#c+)mTFE?uJ5B*L_geWiQ7-2F%SZ*eA3Wl907l$=*n*elJ zh1~=Uf~NK&JRjT4N%wOS_y^q+T!?At()29Of+$69es(V{;X4rc`h9A$Q~^tYwI{C2 zlU!mxH^D2%#JhWi)Pq{CN7pg(K)Bj0g(FB502CtFc_1`QSJ29ss~1T64K@Pku23LU z=l)11Wr%#XaCnh@`Sl?HNe=7l06uO}>`F*hzrfzbeeQ|-q$>c+(P>4~r@E?FirQ(K z2Di$mo`Ga^n@)vq~iUwr^X^;Oq@J!BvdNj_s@Np`H zxg>k-t~w40&MWvga}kuD=nP88NBiT{1PJjjTd`Xxtx^uaA>>0zn@c#ptdH(zntVDQ z?<(8fITf37y-d~j``AGJUKdi{!!^VXIxf(HioaOkE$QzLF)Lr0`v&%^jy$g@dW@D} zOW=Wgg7tZ81r-?jbFNmKR_j3KhEVd3+f$isT^TZ%T48P7!p!tNqWkS7z*lR@8NPO+Ht5s$may#4Rqh} z=1j}`i(?vLmb1|v(YMNiv3)+)zSR=|AzV;3E`u_FiJ{qX6+Iq9Ncry?8)2+wKt{Zg)8O!6FA4h7zF zHo14}BhK1wDbPbIujGpQ^rxCwH-HJ6NZapq~(p>iIRLG4E2v8RT30kaNKSK zsQ1cX@3ebaVBb{p!c1gAsG-n;p)PXlwhDES`RP<3Zyt_;0?PW)+QyTO=kf1-vsQ}Re3O(^yK!AmUiuYHgOZ-2ND3nrDI64y!nn+g=FUDGw_FMjeqV?J{}QQc+)Ek`29i zi)F}x`Rh3o!T(N0rQBtMmnwT{n1r96=VCz8JPd`FdgENUgd|d-L`mvJ*KZskod%*I zxlC+bZibdE^|sJgGaI7RQZr;$L)oEm3($~}&ANp8N0w+5BtX(zRJyWrQbVzEc9I|$ z3v%U+F0@q@`+cKa`~9lDSnHRpaIWe#oYM?>hO-)};oNU}H50B>JL*2Enq@Lla?27F zFkv**|LilQSy5VvK&2vT{-`bX1;}-@-jjGOnjc#f__pI!p^A_2M}B4{|9#=m>!EzC zR{Gh}jDcnD@mDVwT4c_1?96JI6sJy$b3RrIT5nO$emutz)Op-E;lrU-JJ;*8PXL6s zVuAKkA&8`6&8~_oA4zfPalptJ%eyl+Pimm3=A*rf;unp4YD5nG7j?K|evRhWG5gH+ zn#!JJQD#;f9{9e`*4vyjDFhcItbeJ?eH(4nXnHMkiKJL8E`&vUZ(&6)!VZ8cHtD3& zA9(Ak1z-78sI;{mkPbT1zMaTU*fFXox(~?Hfecn@=e&T=BRL-cMezOZe`?(Rr8t@O zzlifm|JU(Q2!=9{B21}MWKkln0AhY%y5J%pb+2BE8!aqD{~sqB!Gwbe*$}jTdUq!` z_sgc(BSk)fA0MU!*f%ld`ss(x<9VD&;%??4^EwV;IpMfHt#TvPH^2Xo&y{yHx|zBp zY{=Dd#tYu|5abE=S@mN?&i3~;n(asP6;}u9X^K1d+ZNtCy8#r6l9n?=!YF&q*d;3h zhpICBNl2b;pSpu_bP|)tQ>rcyGIoQsNGkj}Y$TZcDS<3Sy*`9cEoo^zRy(u%&ZLd% zjWUHSsJ7R0z=1Hm-!_Ji2hX~kpX@WRijY=}k+oObmJpvCQx|AlJhl`GYGe@Tf~#G5 zRR>wj{h|Kza|&6AZi^PXV-Tnj8oSJmtqo6!iI-d3gj%w}P(7&B)>83uRE#e^HkB0c zU}o`luiqP@m;b(WIX(n7b!ieTAkyzR5TsDX=`zQ zd49=ZN~v9*19VOZ!=^nu*4==Pbv@_M0X?u@=A_Z-FF5qX!|3cp6f93X5Fi46pgJ`v$z5*Vk1jsk}AY}2RAh8&G{G)f>V`%UpM5D1rE25@OVi;_%JyQ4qY40JrK|hdKQd~!FsxC68+b#r& zW!{oV96E+h`bxX+A-WJDHi>fGW9sn7Dn5etV%%eGc#|hF8*5SF7;xu4)q{r#o}YlkXU0HmM(Uco7-%E?KS!$L2}X?Yd|K@vp(n<;eXO41A6uEXal3 zqEtaHRt-X66|wrL;;^|onTK`OpGOOWPrE#F7M*fbdrj-e9}o$aAe)M*n?MN&s%=gp zW50sNe$m_GOgYgszC*;9NAki*;KfGL6HmrLQ?7)XdMZQyz+ur{XU9o+(8I6Ey*q%3 zY4p~OI`fQWr_jid_rucK)Hx~=HH8b3aWt8408*0a6j{vMPwTm(EwCb|E{8q2VvqfZ3U zqRC|=#+fCQHh4$w2cDwQJcBiAyT!wDp~fq3y#>c_AFNob&rFWkVTIRh8Q2KUckz8m zW9)@9=j8^FOmQ=K@C0y@VDfIWk)&;eo{f{13f=OMeBR9XOLs}tS)IoCB`cBbDvtYg zr?m=@H4&K%IOQB*`Q6jMdi$sY@QGp_K*f|{GGN5=2Nr?3-9h(>U*G}2yt=LuK^DN| zm~H6Z7RjJnvuq{=BB?x5D18CeZ~V!u{wRHUvRWXbgFDoG;__DLP{_;a1#>1`X^HRt zH-j$O-T`xD$q>dMcjSPC{cHK<+=UFcR$=tZl}0AFNbP5aS0>JIuzma&omDp9U#E;6 zu#EuvFx&^NqP-Mb8g>?##(}>nOzQ@4FtQ6Me~6YWoX|+#sBQ__l_oGhrty)D(~47< ziv`k7K``Mp$uq;zr?+zj2cDImchU3!oWH^;XQ8*WpE%*H6|Q;zDE z>PvQW1Av+Lnyot1KpEX)IpDB8x`%-O0C%3{8CmCQb%o*#Cs!7zMEtAVdB&9{tI~I( zGf7QzJ`i-9@F8d~>X7(Uw;QU#lGlCetZALWcOC{qEoO;<^cBQ&ab<)|9zSxN zOrM_lFa{J6Ckcp$4itNvEY}@u0gW=HsQeh|OftH}(wzoV(h`n=$tDov1?@qITn#_Zk}HyqJD0snD}rGnOT2fe(Qn3+8zdy; z4-XO8|B!Rw>(!aUlhuw;+PUq&WLjjA3Q4pU_% zqPenmv-gi@>B(jOBsEl{ei=BqIL}p;G!e+|)?6cmG;y#EM>(1;*K7^f$sG0DpG@4` z#Pw;MaON>@514Z&nuk)bR(NrQrKBQkXo}HtL~b%q1V8iq$Y@{gy6yLuDldTQXwyIZ z70FIpWaXdh=`2&yQ0ZNOyiY*1?NuR$cLrwlNEfC1M`_>dkW`EQdNT!F@vW4sY%d+) z+q+!&+k#h$rvfYkQe7H8m2nM1C(Y|3-f$Y@trI3#9O6e3PTe*TopuNe4J)1=PCbV< zEt*`R$^MRj4XkM&@K7V$#dHJVa3T2K6;2*uaBHKST$2w4h7E$)-VzwGAg0Bfxv3jS z;R-X@vG?f6c*swD?}_b6WzY9KC$x7yGVWWe_(>@~3;1*Cl>c|rZk?}46eppLU8jQr zhR)e&TcXgl-u_0N(wtKPKj871$EMF@<|0EO2$q)91xn>$wb4729der!67xw|<=k!< zf2j^8uoUTW=cUVK$9_sS8+hgPPgoY)5#GQPvJ6fkaY^u)o@_Ohu6TJ3GC`D9BIOWJ z46rxrcnD~6rO`_emq=a03f}dE`p|^8BT8Os7lTC!HTVoL@M)Hu1KG2Wtd+u21n`GA z?mT)$O-zN#j7(nO&amFua*!`m-tKYV0YYZD2t}#{9NJeVlSdt@wMmKI+f1PVC|fv^ z5)w&qQQeXkWXfoOS^*ILz_jA%_C02 zCBmJanxPI$yX%V~u=SfEkq{8c-%hju=UkiJ@-z#2!-vm z?Q}?z@K5|MZuBhaZdw|XLmB9e4ji7ZCyqzihaivG;U7?8Y&&onM>eCSzvFGAPK+NGCZ)LOrH zDOg#$H#}6EQU$BBf_ffqJTAvwA)?CCLEmuzd#`k&Tad8jIS+#fVQ8)<@B0|{Eb4_A z@HNKADvawI^{ZUI4-zE8sI@-&=2vwx^0mM<{5fs3#U!DL>LrX-Y4ZV5O^P17R>2Q# zFqYK3C6JiUYpiY8T1OAnU_*|Y{sB)D4zn{&2Tm^gs z4t!p8{?p&rztZh9GBEzvfp?dt^^XV_@vnD};L3KB1Fh+xE92Ex6HGdsh(hBO5a{|< z#PaerRGo=he1m<BMP6 z!|9q7>RjOJ;QZ+&V?Jqqrn*6X!yDXP#D$ZN*^%)$N6gy8m@))H&pIkn@d2k7*W2A? zggCvVo!!1D#2IEzSE5(hLi2*Mx?$;$6VyaE*KWrr7u0M}9Vd=BubRp)jV5BIx*^s{ zR%gUw=t!8n5e%ga=NnT1k%b zxO#n8YOfW;jfK1I;pe8+mRkC$t+!<@zZdC$`B&~Lumq^4TtQplIJx!;v=nCohTH5l z#K|N26T?qQpowV@=WtD!9I=vb!yCQ!?Gtz^SF|mxo?RC};Lbm-k0_jn1bkD`7htoy z>N3Me4Yw3J%-rHTnz^ysxK*w8{%IRQ^ZE5CYM0w=VC+s4DtWE0Y-y{I+5;s!<*O*n zb?zP%y3^{+sBNo{OW=p8CDk=q!)mgl_X-df*qHwfEy^`lxs z#0m7_H^x0TDPN+Zu=J;E42nKbm07o#$t)~s#N?D&scMM!m84bhD6p{0PW*XuPo{m; z&lW?*t#gz5+>?jVtsFGUw)%myB9mr*P4@J}Y_0|Y0Sa+U1|%P%g&k&9WX&9sCX;-~ zRVLz8zMlpm{z^K9h2ue$=S5DBtG=@Q({RqyV~&h} zTdv~z3woy+ou}QIK_;;n*fG*rc(mDnjVHw<-IW%Lm_VZNG65b5UQHmrL735=Uc}r` zIYl7+<0yTa4C}_VtV|Z6Db`AY+}6l6+YfA_lmB>_BRzKjZQTxu^@arRGnI{qz6S8l z^r#&~Lnd3F7W%YTgf7#bK4e^B8EE~qwPdVy7(3bCdVU_~wfO;!B^!M1#RFuV~RM?`N9vH7&L~@ncd@aJ|9?VNUd!~MkK(xd$P8E zmT?+P;#d4HGQ@E|-REv472jWlFlT1AdCqm#5IqnlHo>GFF=qkC`^0&dx`ais(99_T z;a7&g%X6WG)8UM9~k3aVxUb^v?)~N;6Iy! z54jJTfJq*f{R5DZW!C%Z1y$xT@y`w}9<{Kz@>_ z*osggaK=Q_E;0wNy-e3iwFNBAAv3sYaM&jYxgkP+7BS&?r8|T0=xTh$Y6jQAJe((D zfJC8#frAE2VMD<&_`uS$EKwn`cd}D{lV#`+8Q)+iD6t9AB7#`kX7RQS?n+>eeuW?@ zuF%l!kf;WJyv9g;i&fPYm@jaWl>zXa^&y)DB1b+2*8(wzYBs@t?<{{Jc{w@HLh=X= z1kefPn`?zRPI|4oH(8>%!0CY-x(nc)Cb|Cd#hbZ&d;;6`_OCQw{5a_Ms|*M?0L^tMb-6XP5j0% z9y1DKjztl&_wS~zmzlqab^d;J+>bL+$-1|oX8)My+vW)P zd`Ub)n_7RwqlWPQXLn!VQir?tD*~KtaA#IP&!?ZY$I)aCS)>-w$d#77So=3Oh|(4T zy5thnXSZk6)U^%H`{vzY|EW2G;N2{0cF6pU>0n79QGb zPJik&Y1L#}p8d1)Jn^A^0K(I00^Ajou9(e26boUz9F`au|fd)qzuvSUC zA}$S2AIEq;fX8K)yZ_LYu>31$5F_h|B4h#Y!?7A?p@TxA1-4$8;nq zT52q2%)WleeM3gMPVLPuE-p{tRa~RHe=l!V73x&Wh17Q^n67=Os14LpU8SO|({0~K z^1Tj(TnbW;G$Q^QZo6HGzS1F0hWToFn%cJ`-*`P9@~h9p2;v!5)5t6;ZV>lS} z=zcsOpIdQ}C@X4^mU2b?jA`)S2-|J+vSjJAO3p(2P_nE`O6Eu~W^N4|-S@X%H%~U< zHQ+Nt+h|H`pfjjGk_ zI2zD8`X$Rq0<{UAjU%ja6TZuM(QVbSNKj`ntdj|wK{1d5M^^7p{bevGKX+{|++j4i zfx~k+)LlReYl8NkK60z&mchFapzXpFsnD1~&)hDBTR>(XpA<{qj*14hnuymn>nt&n z-^7UIDvM1!Q-%RI60c?K--bPo#(^~c7WTcR;sqJjx!s9@#L7&a0RLl%gISxkH_gQ5 zI*vRAnP5C9q2NWgFKX4TreM~uHmBTS6NTmx%&~SMG1rr-KIZ$Sd(vSuZJ% zh*@g3S$9ZS^lkK~ASj66W^rCo`zovaAns=m&4Kgg9bPVyZ1N45xa_wyIbqSj4&dcs z201xY%S6&Vc7UexVJBh0JC(HLxQf{BCy}-L$pu6j%kw z$&8G;2&UH3NS%I>Uju<-4zC{{FF|=~O}~Forn`V;5elqtiD2ff{S$~Lv!Vj`aZ(E^ zU!~(*a$v8Qlo8`fU_xb(+5r4I7^x#)n1&6soQI%FwJ}o66PTUvRr=m+o^ueGe^u@- z1sB{XtXK?;z&erSRc88nZe3@X)ESC$*7Vl@2`#0wwsO3>C(TZI7^iZzv3rI2z^CgVspMkC56e}vvd-=*e1Zr?%u7kj8$V? z^)}BHjT*Wfum6)Hows1dc-}kfXf9PmPxWS&S%%qsmM1;ENb;oiz_4iGj zSA{eV_lMBizgy!E!BmncDGO*hNUflC++RnGB+X>sG9G(9lXfU8Fmh<<{&t57aZI4FLUd(-U5`D>lQWm2jm^Tk(kI&c&&-4I@2D(8!R=S z6QS1xPGE#w$fWJY9Q+mq>HkfPlTG+cP#EWhjy+m~0fg?Qy8Mb1o^GLvzJ>T&_V-$@ajBtJQO1S2`DQz23=HMzFiU8sv&Yo2Mb1*s!g#KXqRu8Dc#{z*w(}6ct|P4^ z{>J1xsDIh5zbxH7KQTmwAle|3r!;9XYTc)VDe6ijzPLJ>C<0_F3Tl&%zvPL6>`CwW z>ko%6I`=}WBwI#m=(QdqmTP7}!ty9Bs~r1zRkmQMT%OJT{WGiwp^kQHSp zD_Y_M3M^*rpgF+In-7b-g}rV>2HTexQtW5}Gd7|88=c^!I~|N$T{H z`amYfF=c~)seKABxS*&{!(QkQ)6#;DVq622R?og8vs!p4kg1UFhi3Q`EN7f<5n^1P zO9~!@J8P1f7g3z|`#M0Syamy~}Qgd`x$nJ@Ou(TMf3}558vorbg-8k0-53-zt7Il}=U}st% z6;FKcZsl%IBF#Nj3BUN^aCC`yoD}P@=GzncCRy(MQcx7I{|VBQIE&UaP#idT**V=% z_xfb5k=t%|!a5PlOM=qIla#Vos-iI~ql3=#<&IWB^F!Z8GV zYp3$MT}Oh+gji129D4G4Fc;|Kq?ZMdjVWzLQvrh+7wG~EG828(NbQ1lwcP>C?gfW9 z6E6^t320x6?M1Adk~d)DC$0a$mim|S*L7tsJ|97c*xDmcYB8Mj8}fo~sSKy9j&(0G zOEFgYqwzK2Mw}hVJ}1OGBX=CutSy4Kzq!F7!{;=Hnu)krfuXFmZ=67XId8V%L*GPt zHAv+X^Mf>m_%cm7-@NT+_POtBcz)K~?QXj=^!?|?uR*>MOUCSQ%1S!dZKx7PRqX{j z42NW?pQTIo&b6WVF;ThN)@IfV29566ixZM5JBjOiqF7Eq;aHlGD5m>yeHSzOGUKEp zXT%YpPWottZj2|ZuBg|}AHJM)ex)xG(ZaG%qhU zMMGv|XBz{63aCPdx~iUxV}zJJWiYF669b@PYy&b2{xwFHIpBNDxI2@ZH-p=Km^2YN zS)G%^gD1~a@Q*=ITBeRCgO`JfO}eEA<3Xm}niv@q!QkW3)p_8Vg;F=y+x=xin0_Na zy*)(U)~>X?4g>`m(-2fe;D=SW?p1nwTQxUsPm)ZAwFVm(c)l`fVB-$6DbMdIGkOEc zGVr`Bl{T6acI%g-!S=9NznPqDnQd99yvpoNX>_VVg;{X;jIF4!@zpqr*Q| zRX_e!N5#-c7C9@EK8NOV`q9g2-B^F)OHdkROFF26q1rA=VM|-Tv)ZmgP^rrzfNBhn zBcg_umR{FY-8fi15?|Y4Tp%GsAIgNI3IgV^uH#-c*bN~!MGs)lkSmx#vN|^GSJO)Z z?y@exZVV3yxV^Y8lb_FS3;vX39sMTY4&xz-h17%rBKHGuhL45O00|@)kq0Yef*Ae1 zB*3q0i~vuHXhsieugC!s!2eT$rD+BaUyj^Iz~uk|+jowS&sPrtp%xARNY4?duX7AE zL>1!ehJZmtJjRp)UjqwdGHDE7Y6K~m7i$6!l|(I)n|K6YYC-`tL>(~OIH6sT`EzMT zDX_}z7!aO}4=tHKg)hIL2okOdW}vWy7$~AKK_I`P2m-Z1?~kC&inAi@Kc6g=+gt>Z zU@{F+uH_G4LO(EVf_y{+%HMwoP-+VaK;;G2E1bfL`hg9wG&Kk?>K+ehhune;FlJ~D z=C_}WUwe514>Uw0!e4KUKyCvGB;^B3ppn9k`b`ZqG&KxC{ml_5XfK5jOC4+i|DWet zzSx2Vtwj*x$v*`&0{U37Lg=ArG61nu8UTS*psU=rzvd(XRv}ZRfBhy005~)Ou-R(n_!~f@o{C{p}fDBTK=o7^X z+0B_mNAaTq&gG8{17Z1L1G#_|2Jo9CV1Nu#{ZD~-s2aH6da@9Iry>X|5J#ZDn?g3e z{DuQWsM>$V3jvU!#{sd-7{|xgrTEVP{rsJr5R1*&g05*sKjZh>_{qoppL&1zRfyER zWBBHTUT%@xR%e74IqX`Y6MB?Wm%#fG*cho6IiH4&#E0>#c|4v32C(J?S2EbA^9%a6yD={(O42g%O%;5dPB z`O>smNU>u$hFTVTN(3Ck%q(=?ps+`T655@QRI(ljNnpBwtq`y7J>vS;7X(issOdOx zY7khUMrfMoRXCV-aHklf578~c`Z6E&yt`B4`x&#PseIihI_Ob3k(lcoJh*o;yh}U{ z`9g@Uio^LfaMXaqk355y+)*l9h!3WdEF~Y(77gv2&k7x{HcOr2Ul#r&nNKCVRVyma za~BM^T_`tKbr=J9Sx;U>R>g(#;2%M#{sx|DF8)1E69O7-c$hAcAaI(t<{JB{CRfog zU9Rf;IJ)S=37}6L>B%We{KFbw{4dB|*Ly)n&+;$)34r%74MV^Hv13IKsfrGK%$K<2 zG_7WN_()6;9&S@d9&*-^`GKHl$A2%1Sc)g(P?bQV*bAt;*BwaE~^Y-$GY z{O#OxFYdT!E_fcfp`UN0T=Q?DtJd=fb`Hj}`>S9vCB^0RfK27POJd}{);*6#OKH=h zZDuMTOOz2>ZoX!YV8ZNNSM>i7;CrQ9*DCC%IdU;iP6p+jd4T9rNar2 zpI?W+dDCHFZS_SaFz5=PD+D#}r7rFx4~*iYfK?!F`MLxbDSM;rJK598UV&d+s6|-1 z$d+oS$k^&)97lI@$DD70NmQyWm1E4%1gxkMhJC=f>xkqv@o--+UeG;TXtvfy>~ixl zVmp(|PP%hdm~`gnfQ2XvWskQ(I4EL0;G@}FLC@ zhpAf^9{=pX@3npRh-$?4U@RGtB7$8K)xs!I;9^b}#kN)YgIFpjl#40^)UIAb+i+i| ztW32d$BPoxtN|-$y39wP|J49@jo`=i?M603F8ldH05#!9-ndiyeH|kjuzRdKy|c?| zYkZHn9Al9YJL6xY3hXHGwR{%-`Wi|l_?}SUCK8x;hXNSvc7#9|#s|WB0qpqFJ^lCa zM~jM*&6CRRx{)`xDIzqK;MIRZ7Azz80$Ncs{CycZS6?X4y7ty6bT9`bG$Ddrg+?&a5<+z~13oH021`oh%h{?0Pae&f zDE#YJH4a8Gke2JvtZeH^E6CMTU2=47lU1gH+{>)15tbc z=K!SCXi%QLgFgA6^{{UW^I0}<)JTu__alTh2~eOEhhIVmo4xWFIN;Ya1a@q2u$yXP zhsB>n-V81O8E+{dBXvU$sKpiT`1ys%fvI*PMIvS!Hp&rL=yyEsSB>As6+zMf;J1Be zur$AvvBZ4-&kqcf=351S#5z{f6ZEqs8h};*6WA>uuYPK5j9uzt&Ma>}s%S%3eK)!+ zy|OaZ+xB->$F!ubj|wRr_v-5;v@#ETpk&{0*}y!Lg;$K!+|%exmGzl>k_PVcP{Zp_ zS5?2#<4*c5_E*9wpz9Lvu6M9ZrO)VAmtN0vZHi1=J9!J5_ZgoBo&j8n&#eZ1Me>u? z?DAC1$At?UkKX8XwZ4tuSXmDf@WNEH<*leu(*PWZH^6s4am{%aoAtO_gfAsq#!!_{ zo9>&Me%tjgc;16yVXOy^$;q4XYtxlGCSKF+;fG_(u8S^;zTc+Hr1#e@K|ZMfTEbk` zHhD3G3*|Q%D1Nv{Hg{KGw0{P-rp7m2jT@e8u*?n8Bvg$A`T& za!!OFWZLR@M88o(Q%|&)x!B|-Ir43Lyv<+`XZe4DD=}~WmEzX532|uocKbSm&htOC zAu0Q)fZ#hY;c)%oT}Y@)Z?hP;e-ETw=YjL`EYU`9*M#glr$qie-TEk4=h!|no$0=C z#xgmjSO$p=xBdo|H&DKKJbKD6V~e1q{zdiKp!U(u`*&is`rh`LJAs17L_OwqJIUeO#SZ4VrpW4K-2F~ zC?LOyyn9?jlg}c5in}{ zC{zMDneq}}fw{?1xy`HoQ)&KN&EVMdA|J548fm&o6n)c-p%)oHu^lCQwPW5Fi_W4d z`>7~H%WIX7tWs3f#PKl;aZjQtov$v5K9V%PSow$MM{}fDW3OHoqDZDFy1^VPG zH8mIO(>}j~CEg$xZl%Te-msx}caR_0Focb?fx^o>qH=iabcezaA1%AQ9z4ropQbe= zH|rApa&zD1>JlFe0WZ`f!LvGQrggfiT%Gyr$)KBOUMJ_Le;MQ&2}ey&nDqaVLPC|W zWw*7^Z?{jA3bQ72uK|%Y$6djBjJRO{e2q*6XEsm6W%z&+!j6K17iUS*CdXpr~ zZGHj3ipG!mYXKm@Qh^3AQkjhjz8c@{SZ*|>5*|(<_bF2JlVyHi{RUCC8-+feh`&9J zBN&3zVApfX)4G~3PKGz+_P64P)@d~XL|%>T@XK$5>f!9q&P42*{2<^D3;%6B(9IaD z9v?58&ZkFjq@eIPU}ZL99Gemd#qgj%9L`HzX03$Nx#+m`1e^Z~B8YV&8cqXW+r$0z zWSc^wpsvY}Sa5Z!{G!C^7L|Gd;7?|x6+L+(30@l|0Zv^4j1Od)jUq2TEAUc%747`9 zK@$|JfC&hpv$YVfW+4vNR19s4%fOv6G`B4f>=3)h_rVKaKfEUi<;o&WfBw34)QFSL zDuL7MA1v2+WM{`7Bp4r976`&>Q~tou5gfUZwqt(AMrk8C+*y+!{J$7Ghu}=ZZ41Y? zt&VNmwmWvxv2As1+qVDMwr$(a?Ygs5bp~htP2c+VUVE+eg!-_#_f0vVcEYMoHEFr8 zyeY=wEsEg>R(m1A=GyqWZTQcP+3m%~S-qgk-{xEL?0Za9CjR*5ua>|Uj)rh1*A0?~ zd+ucQKW>~irLF%cy@)(HTfBd@Ma1b%4C%#C%3uPHZKS}v$C_ZG;0cN;Ou6HjOTL6} zvsu*+B@0(kD(76ju8CE0gG_fbPv{9@mj!*X9c*PwDZls8|H@1Z5(@rhJs-b#M}tSk zaeqI}_2ILgby%Om7>c&Y)y4xWA#siWsSlSz#+Sx2Wr61DeYd(rA$K?~;e?S*9P%^@ z2BO3*QUwO_UVl5gv_8`je=zmDg_y}1{%~C=X>))CbntJ-7qHOo>RpO(62!F9=lgKkks+Y zlR6355w|B`i(&lX!VyuqjUlW1izT37|KjhNib6W){3<$QqsF1jH}L))Yr+YSAl?ag z3WgQ|oI=EWDK|pMy$W-Ct9TCLifEdQW>MsSqj|q`=13~5xKC={E69UwcyqP&)B02G zB1u(FL?aFRgnWN~hi@PRN&*4ido^VE4(*^ zm_|@18kVsl)5}@(^LiO?%EHDBMxig0=a6X(icsu!T#Ush_Rq{)Q1~ClYz_DZwn*$} zqQjb1q#baU8b+Hh<$N~Rve0jsu(wbLAXcRu1lmy)uASHZaErc##8r@kv9UEYnz{2h ztVoPj>*@xBinD!fS;lkKOVDh;b*Ci+cb3gu;k>=2&L%3?ixq;R2GQ_!07BOPaF|(r zGqD80Z2i}33nlBOK+$}y+?`AM!&xy=FEGV?i~w64{g$0g=Z!1yHHeqh&|HKKP6i=e zK=z;4-n@gSTdgBm#-n=clVqv>e9CQNz#NXu`0-b%a#$)sA^f;2Mf!^qBGKJ#$NflkB>Ig zt)(I9y?5xobDPJW<^YqgdmI3qVpt|`4E~d$a^J-UEcCP7n^wrNMV@PT6%RWl*hJAIr z$a4(Nzo4TK{%C9Qba#c(-|3xrg&`o`>{+_RCBC z6siXJ9}^(vjXb4{%ut6H1dio>jF{q`NRgG*ad(fqO(nhxYQ{Bx^{M8@CBF#eB^KMr zPS&7kmtq_nf&w*%*oEr@HsyuG1e12@RTd;C9l0xwDqnPfwNPe;MN!9#n^ew-3OT|| z1->LOJ!cWL96}vP4^h_l+IEU+pvY{57F2W1&g}&8_xns~{(Dl9D#oQ@%Cox?vixU3 z7+db0B(;i;C2?&B2VP5F$`-C$=useBaz5v4mHVO<$|hBWvxFJPF*=h`9oNw@ev6kK z0RT$x^MSv^I3_Ci=OPtSe3DU+H&Qf#`vc!l62!}3LGgMt92>~-Fz1ydFEvr9r+0ui z`45Cc8nbJDEht<4z(xQ}vg2Evnc?58G#b^;F}hwYW1n^XX>)_>)mSwnEB^{>T*;u+ zbmW+fLOUfyHF>Py*}*p5DM8|t%q);*kFsci9bkfsXWub^=LTM-NCQyFx|js@EH6Nm z_6ih?uz~<*hF2uBkt+&%tfRn5-YM=kQb+-#oVP0G5YUoXq}Q$afv4lDkJ86id=lf}{H z`fR_DQif@Oa>jiTP`+BNJFD&tujEU4znWuC3yHOVQdPLa+yFJ#Bgc=n)M%-|B8F4y z8#FqEI!*kgeW5`@`^g2z!RA=GvnQmEta(QCOw7d*H$C^cbj!Ddncc%Bc`3v+%##ce z7odr3wfmS@xPLva{mz^tzBusEf10{+(Y!=bhwXXTUb`C30R5GRFQW<@!3s-$Os!1? z@{rn)mV4<>wo@~5vlUOm%Qe*-3F+6d((N{PTn5EJZ~jx9s~)ouG1O!@e13*x(p@EJ z$f%mf>?JrHuw|by_LeX0Y)3l{Z7x9`%L)cZc8sCApN$TjgsE%`Z7m=8Vn}ylYaAuQ z^-_o=-%#`|cDxlE+C7qKO{0^_J+fS^$Ek}(v zLPIFlAk3rTeA>3XE7n7s*8-$HJ!Q>E1~d_mqoR?)fI^l1TL)EYfu&&Fom%)8>^xe% z+I)IvxAVG#<##8{tT{rMjz&McG7!$UO43IdRQnRsKg>Ft7Z>(Uj4Mwds*UU-mxF51 zzlA&ylO~OLCvK5dm5h@z%L#| zdqPqW>*PBTu@ZfHT{Y#{63G3^jiXmL@jw)DGielLq^(8wO?@IJ+Ldypg|99K= zTK&{?>w$OO9p@f4D5?e1(q12H#9R4?ro%d}&qfNmrReQlPahs)ea-i-_uNYn7(69X zzsT@NvMWyx>C5Qzp|IbqUB5mNtA3X6Pn?Qt5tw)16DkImgs^K6^bkaxToLk2@8o)_ z8HWHe*?y1Qdo-kQqtdvfMcr3v+@T<);iYXOQoKhDHOWSVR{<<&CD8hh$oAN&+sVas zaBkf;ho9cK5?^yL+vEao@$XH1O?w)rrS432zelRuW}rzy5)`NWH5eH5!0iXK!2HRzBr3&rpR(H98Hn`J8p0ao z+Q0kAjVgm`i$N=njW=m;`wUIRQuYBWA}Qp^&S$UT`MF_ny{0D`0r+!xZgMaC-<@;f zm|!2A!Imso3Vl;9Q@){y>cIeEsjy5%gZTr)I6jkDCt4W<5BWJECs65;+9QNvT8m_8 zemkKPe78%t1zZr2%l6gAmUYSqygoFJ=`!_9UY|vNygU-G%#?lSdMo8d+5QaZe(jZ9ZczIyL~Ub_x<%g580cd$ipXNsSYWc4w&~p)h@21Y{I+;)D87Zo_=FSF-NoLQ(m8Upg!Pa^{NSOd zSy)4mY_P2hqGO=%djh}T41aMw5uAxN!EvRJQb|hggNIAmcRE^YTxSZ_F*2(LY)~QY zGF`r3e6IB>K8-O|<(TZP4#0K5wbDTv?pRzr$(C;=jT!1dO-{2i>T+|_Lx|Irfoi|w zv^+M=Q!E@w39^2k`8^4d)3NaR#FhK4A8S;#D+vrlk+Sbg^O-v$ec==-?0+dSJD|2p zXW<5)#Zma4?+&g+7xpD}IS{}Ovd}y0INM168%{_&I6Al5;5&fY+Oeygtnb2STSXDKrGo|1%4IWiAAjR2S^qwhyr4JLYezimw2ZGy%ro!RoY&%s)k-p3>tSuAzX zZ7X{gV4{K$;LxQAf0BV-yq$!>=6iW80i` zG_(ZHc-`)22Efw~9}i3$3+;0bIB{X>>YbIf-mgJ5o#UmTLTvv$^jn=ddZt2sI6wXc56FK&(ko%Wlbm_$3m761Wa$V%O6T@ zSxxY0o4NSkaO8`8*I%2>TTQ* z0{dqEeFtO7cZx<9y;qhTR@#oV`N|Ngc-buOJnMqxi%#1#BSm7(R0_W{gEy!v#aRSA zTi`R-C`pntw6PgqA!vTd!7tg^;2R{i+7L{d@9NnVPdIn> zCS+M5UMeaCt}xG>I`g0QrLOmS8qbGw#Z_EqoJh(4&0zu1XXIq+V&RtXg#?W@W-Vi4 zPg!H}noJXczv=);H)UCiC1riia4n7p!=1`cv`q$-9b2)X3emu;jKL96Nj!O^}G(RBGO!M>8qLrYE z)q$zlhf%i!b572JH)+6rsB_tiY|EO+Wzj!SA{;zj2ZE;s&fB&XR~i^-5+bW@y-ot* zWg27qF4aq@y|UE(Z_q-0@d`j1$8*T1{N=KtRvG!HEm_DlzPl6i|Qm5V5qNgV<}90(3|vz=6L;^j$g ztXuuMS@04Po)rNXAn?}iF8QN-_Vhd6MI1f0uO^oy z&s{a%=v|qb!Vnz^5-37dn%}BXa`fXhqS!gW8v)sMX(hB5;yjlWwGU|ih!+^f!QX+$G9Sz&XP-E6|uOsRRp2v z4+y}6onc!Ee51z0noJ$2xlUYrZKa63L?8>jyT#zOtMu5_jv>=Kz9kr3Kr+HImghmn z<7+qe=V9BLtBvbgl3_w>{>qo}(ue7K?3;^n1Ufa$JM~Jg;rQ9?u83>7mZAH3U*z%A z7}*qF&ERwQP0s0BL^IcvNx3kG+=q7{xO&JI!olQfj^jZl2pEzK@F>8b33Sz(?RsvW z;48yHb-4QivF+8weVo}c#fktBSp&?^SG{>#k6(#+h;=Yxp1@v8F`?Q3&A5^^0c{@; zIUYJef`AtyDv}rJ6+tkdDF7*eYDj?JRez|+V=HaeJ2tx3bR&P5MMqK8(@AZT#O&dl zc_EvYPM-PPdcN9AO=TH)hH+7H0aKDV)F~bGy3=t3;HM%pUy}OUX2e^)+8-Ta5;2jE z8T3bahKmJlGU?fRUgTj`edN8jKmwLLS#OZ@%}?D+{bFd+d`E!Yn2%Q_EzS9E>SC%E zw@x!{;RBu{J1H{-?N<7wNQ<%0-4o%VDS^P(cPBV#;jrO8k!c#UKG z`);-2S0>XZg2@XK#Iu@T_!x?D;)7I}tF@vRQ;EbOZq z+FUt0MFh3mLn^KF9^( zC_^qQhvF=M3WP1R?AfPIOUa1J5r9`%moy0-mHU2!yEZ~i@THp%;`1L)n+$Axr~n8v zYo`9RnWS8>Ag*bQ7_&yb_-Bj~h$G5h3l7p}))1MGVtJ3M5+W7!fjJGIr=^>&$&`y( zlstM6fKl0w2EjNJ6ryXpZ##-=pD$VG5J7{}gQn2$oW5@&=yhJFuLyC3vxCS^y)Ry`besft(rLT&MzshxbF!b+K!62 z+uP7=UQsJeios?ec|w7j$*~Q4>=I~L-9Q4Lx$M=1!Ca&zvmogN>Q-r{iUOf)ziS7p zLJB+mp&$A?SqD@d$+~2s8<(5Ue9tIQ1gh`!75d|R!-%Drhhz}+p(4QgE$0Ilq6*ZG zDNX$c_&OXN@$Jx}BwcZTQj2S~yn%zeGR-Q<$u6XwzMva$Uaf-QAzYmW5xXlhO6d;V z_E9fAUUjCnMBW+-QpvTrSQiQ-v+R{iyW2955xyQ38-Dvaa0@7~tb+i;wY^sCv&`r0 z=(BWz4(ZIvQpdWc0~OuTptxm)JP}rB|;-uR#%or?j3WJ!uM{g<*^=ZWN5aWXXqB3;ex6 zWq@}*-VSPH+ZGKMH^#Yb-MEJ?%hh2#MW9KbCdkM%`6?j;byL zEhrC1_7zP3(ZzrmiOq1e4(x3X; z*+{bBjR~1iVAyU!>iIpAs8WKZy~*btHfDu+%W!`jkbyf@#Km!qis@kP92|=sp!<9( z7?Q4O97ROK{kW+jO<~hmTOkybeEz&1C`=jBD5%&Rkq2b1XNcD0p;YG+OU84eZUXs{ zSzSv=;LbRw@tzaNYhT;ncX)%I+BOO;)?$ zhjP{^vfQEsh3r&sSEc*64qLsOGp(-F)v2Y3ElZ|fLXDvaf5m4cm&s4Le!n`5ORL28 zB?8kx+0S%IXa~&Px-36Q!#^@a=M2X}B&e_3Y`hP&1%ALBg3Y(KHbkEVq4&?xmL0^t zF^eUcZ6nv$3wc=h?!~*&FPf(<4et1B^@B~nE}`qmGjo8S$wVQ8oTkO4UOL&LApL32 z(D*bfh`Nt$a<{=i$8_p zBIn5heXKBRoO$3-A0c15d#m@ns5S^DeF>x&$w7?cN^;4v46sfItos*;8Wdi7v`Mtj*X#$_viRZUfdlwj^{Z3VuijYn%gl?kXGwNaI@miS9kbba^ z*0ykrP~5IC{b>DC9~qH%H7c);3P*Ta)B`+GotZTdoA1A-p?t8i-S(ZkKy#Z^4#&Nf z=PU+ETxCZ2cIRU@>HwaSi86hVO%>@_3^yyxmVC1oC3@)1)D}bd1Jm}=sb^Pu^&-ly zQ2t__xHq$G=~i#PdkZ%{8b`|UW7!tE0yP77e9PN0DF&&7JS(*4igt^hy<|>Ic$n{V z-$%S)Ei#5C;MjJnhz5gC9fxvn@KR)7ROJn!2ar#XQ86)yivXFYnRotmC59p zo$i-I>8COp(fIh}KT-Q=5G_#IX$JOBo9~an>Pm<^G$6R2RfGO|gnabVMbQpfb|6#< zqb+~3mSKv>YQ96MyKBxq{L2@me5}$F9B#G5{G>nfPIkcjeDk7q55PwyJTEk7Gs$Nr zHOvm2snoInGv#ALj2(3Fn0AK2!J!E_F>ZdD1JMq>!pD!qb#Ju zgo1kbJf4!u0_fO21&#Wzy!Iaip&4`rtel3LO*&of;#=|wNGavTi#TT&9P81epNtKlFtQp7NuV_M#RD*5-X9u-v* zUnBb8-J4>a${*C<8H&ZpDCZtWEht+iJ~08tSs=NaAx)~)GTB+C)~@H8_O?x4gf!zj zk524BfaUK!DzNs4VqNA1wtaOyaBy&&9tSf~^^mwCYkeO}F?@yCS0k>Rp8g>%QKbVt z*8U_WTQ(pgS#7Q+!EWg-24&6pPO)X1MG{P8MTb7kRDt$(WD^eLWtekA{la8J+@G*A zO?2a)cfif?Z1(K!r6azT5u`!lE_Mt93HA!G=z)oscaT-#S8zl{sBr<~>)*Ics>-wh z(jPZapL!Xq@8R0+W2*f67UkiSFoD*a%c;q2_uHDclf&hwbJ;hS%Qf`7?I<<#*cSs@ zoh{&H=oV%RlvtSL&3X5XnxSM=qra%PE(e*=DJdkiOpH(tS991H0d<6ubOGGRKMZYH z8bfpSZdgTCBRslb>dBsh=Zfy>I68E{I*k8p#nM5%=@aKAF zk;_a-UDLVbYyDLw=SNWReTA=Q&eBFDvxFj4d<=v%=b0%$qvXhI3fLae zo0)D#K}T>YrAh%GcHXu_2FYNOdDOgZPLi?Z-=IjB+53o`70$6Ca41pkleQiv)M%@{ zpy+!oPNqz!*`mk=1%#xq>_)%e8MftYhZ*cTN4J$M^>*1BJI)%VCRL{;E>!^WM!93#sa{X~niHiwFDc^PomxML(Jiu(ylNumVKzcd=^>6NleS3s3w*QX01kr&p}khVNRJ~$E+-!YON6@4d?*u`C?J6y^T^`Oe3m32V?5rh`n zLmA@{MXs-tNNB!~ABp$$ZYpOhkdty&iUcbi~fhyUJhc#bijCU9bWHuPeGHu)0*OYgcERK0vR^B4FWr+JDo?^g@Z~X4FKI? z>tQg5c{4XefkQtJT11g08yI5I>7Fe#U!f}0ef$cB4#4Kd*^mh)lhscn; z2u)48qF*UeKbIUorp6N5l01&Uq(Cy;_S7L!I+lKz#+FR z*?DYu^%SQ8`P^V<)@@NIrxoroj%5UrXcCh{R9Gs(pvAp`UY>rk&@p(wdTv~)(0i+y zsck*vl7^97Q<^+@A9?e82(i6P3OICA7;%CE5`-ksgbpiX4cv1Nx|c&jbME6=D1^D8Kgo*W-<;z zEwgz?B1ACqg~a@Lnu;<-lF?lD&IxJUgqb3JmK zP=-oPfPFqwM}0D%5R{Um$$3gyeLstFzF}0~3OAt|$M6F7J0V;`uyfKg0v+HlrAxn3 z8~H3Xa}>C2#9$>q-oa&AKeCE+DTb^bggcy-#OVq!;@e+Um134WW|yji;dZ_3LyVyNdu>(3MY z2N!6rGx4gnOUulBn6O~VbUl%TXYnhF&6qA?Hip%iN2N>I*X zKd+?>%RW|a;rI{8?jyt_hJyx5`;I7Z#%N3IDs2x~CO)WZE$Ea=QY}%V%d<`xl{6k4 z$J_XVgTNwW?9{k-=v2aX;1tl)aya%nI4ax8x|7V6TE2Q&2iukd#COo&XSO7XuIB7q<7m4J&M>cuXopJwhvmz$XD~;Scti!ycSP>C^V$C#61V z))h5SgQzH$?69GCo4>|Ot4VrslDZPqids^uNlFXd&o(`q`z9q}ntoI{j*tr08$Qc7 zJqL)q8Qp>;VBrrRdHohn=Qg2pm2bK4%imwQ;APsunMrB^1IL6zj)}Ab;%86I->D(Dp@nt#XDsr zsv5s`?iiqPV%A~2MQN8HbJ$1ErCqlZkDrP0w`0q8a&!mISW!yTztf@}OiyMn_Zue2 z({S!JG8aHdaDy3V8+paI<(H5I3hy7IR8Zu$wFg?Xel|6wv~ewSDu+cI$!?DQGBP#O zSEZd{j8-bU3qsEyd#DeDNgIiPca>j;gJV>-sIR*liepk4MEi#{fCvwmZ0-lm02UGB z7Nk|NthB1*$z3wY>BAxl4K>25Rcvv-%CFojGc;s#gno$o1|N`b$)YDq^MF#=9tD zvo)DR?n5{^nGOj3YtMgjTp#>+Ei!d9hwqWHadiic=&)&w4aDb!;sHR=FNaGQoHKdCiXDNti5?kS$Ds8n*?%RcORf(2 zK+j?Yy(>Z0ZSBJFlxyHQaEzYL=&7C#lr!;3xVyVm+VL_{Z&u6-^fwAaKir&Z1)N4V zE1nW0A`2anXwBV!_H!U1S_$Tl4QeTo1&I#SKUH?M`NJm?<2!hoAQ07)%<2-4WtWoe zF>#_UCR(cX51_Q(Cs5E55LUi|4Jh}NY)vxDS^GGFDD~`?xjioR@U$ih&(=P(TQKc1 z5Z%zg(MYFxDx8bV32$6_pPNsW1_*o4vz0>T-Yo3DF{(PZqQcS3%((^^y*9)K754WjbH5EXq(w?^53mK2ci(ejcztaAn$L^6D zPo&%%K4wXEqPCw2ZGmHe2?;HakgBe+g&>CP(8g6;JIolI_}73q{Msi8L1wwJbY_AG z4{gu>-OqvbmTz|T4}$rHB9C&xOz4^5exspGBjcZ~Vv3&UA)$9o@vwAwOry&10c2Ej zYSPcn16$Kx_|>5`_xa~<0rYdbOfY>53wawpFs_)6f?7|>T_R|2&+bn#!o{}!uG7eF zXaqJ=M4J?r*1c7>96tMJm_2d~9(zy}VZ1P}oqPtul)El=VJi(Ij&E`_!&8?W3)Gr9 z!jY%L&rpx3l0W!?AQn5uf71`p7|?{i!24l!74hu< zZLI>H@8*Md$$iOLhyn~1E9W7eQ>t8UMWtPgZSVfOG5YW;^Z_K9EmZZ~k=wM^_Jf%e` zo0qA!8ZIXCOM|v}{XZB6Tbc7+P2ZXov;sBA^?8hp+JObgx1(D%vO&2$jZ9**Y@okkV zaJ0Sq4ryS29#rb|>bIj4Nf11kr@5YM7clFq=(wWAxTfl?$mOkrXOpq9}!7C>3!C}sYJVEJI$8E%@V#XJ~(e6m5!E;jIB z%D8JLG)%elM#U_A@P9de}%)-%Hy0;wDe}6KYm--fCX@({9~r!T^;iT<-Kdudq&&EFF+}k&a0aHna)Jw(tysd3d5T z`%RcW_cqj)qr0{v27UxL`;yiDPU3SUVGG!WK#{m^<%3Zi`KU>wJ^a}p{@Gall~VGl zCTr$Ee4i$E_=ebb3U_Vx2LrotQ!it$0R@Jt zK0$8%!MR`T$G!8_q$Mh>T*o{~($_J#-{DJn;Ol3VS%?Cq2W444MzL;VjnLE>}!Sb4F6Tk2XI5JEcw~!-YuW3Jhl=$rJZI%DX@zgzuANj z?;$k>eeSALTP?fZ`o~bHXZufIeR@Iw&i0-CRyhz@>o7DLob~i8_mViNpY{Z;Wmtt) zP+UH}8>2&wA`HJfsD_rZ3*YvV)LHDxg>asx`w@|A%PZWc_30dW9SGpGC z?FCbxpSsFn1i8q-O`^*?sALL`k3MY3nGtqGggkb{?JGzu9oLN<`mmIkB}mQ0T(H)) zt|drubZLq!czFAH!=YP&DlGBdh}zADhV-x$3k0@Ih*}3bqjs42Kx};fUNGl-_7uDg zS-aVQ*-oZGka-qj^{vD*8}Q;ND{AWiQyg`51ZQzjXU83G{lLbJigIp>NC@_WbiZr$ z_!*5og0`W2wyH+)7?_yvN=Hpp#JiV9%8Xn8W4e|(Fe86Bjqs~3@O5{=V`CLzSpr$? zX41L>>%rLf(8EPg{13-6FIFoy>beaj`(_TvBzp>u>IdD#&f3i1FcUTJzWQ#7pf58L zJlMnF&pj}yu6XJR@NB^$8b{m+0&xHq!)a{92-srrxUD8R{TI-hUJ^7;Q^DG;Ut5-i zCKYj$(x@QjJ^ooLjStl93e#u|AifI>j3{jFgKL%uHW{j>%ca}C0j`=gB_4)t{*(?< z$;;on>%G0&7GbBym88;6#1elzlG+B9qkpV?*qER2TsH`qTfE7?=)NSAUH8KjED7~z(HVIhgKup>%K042-LjLBVcoT=TzsQXhSmI2Fko>fxm zV>Cp(=ScANO$J3$zT!4VQXyEcUtI*`lM*ck;}-pEvL2pJRMQ|w*>ML{Sx3qQ_9>2L zTX`I(Bo1#H2hS;dIT>&(@)QWl#Ij9_V;Z(6o}Tu%TKLu&{0@TM)!Zj7_R)I&BLhV4 zL3!&zu^4fp4}~530hi0xJ_Y;Re;Ucg|G;17N2uueYa=Q$RN zaMeP0Nqs}vDGPs5jvsV=q+~$@9s2NX^7RGE5_r4n&^vFQsr+4LG@c~;g2KHnhMT9> znOrzWpUYo9aE|-3zoh-}=s6l@3?bCZM?+Ec=$M|@uW)mD^6l5BWYYtg8(=Xx<~Q5D zJ~4$f04h!ht?ur2+GK+C)wh8_fjJn-{3t1BSKCS5I^c|F`6$_Z@wGB?XTe-i=ID{9 zR1SjKR?-ken2fI_jPQss*S*zM$VqOzXW_3FW;o}{^;#d3Ar(OZU`sJwJ6+FNFy@N@ z0+5|0*3xOiaynozNOpF~^H{1D-G-2enNC6xpoxrneWjp74-ML;%7YWFE*)a8p@$hA z`x_Nmv8yTE#OVglpYIKF{t6a$IcA7F>~W1xl|6&D-vf__VrN&cRwS6v~GjmReTcp zRleWOs`0mNeT9Y9_?(_Q-hv`d0kI`kncRk;1sInvW~{fk_)#)2ClYe-K@TE;xfLmV zl)NOlr~o=#y)rf|FrJ{DHd@HQeaxI?Q(?|cn0BJ&TRp#^zsz*27 zSseQ7qVD1~LxO>gr9T7JO!s(eJd;w)qx3_H`RmtMjAOF)Q%}d3`EcI@Ydf)Un_jF) z@zKO_I5EC}K~EfjQi&Otl~ChBz-?`Ffg=<4N|u||$qD3wV63SPbb}K0E!wa?iA|CS z(dIE{%6emrG2^hC7mxuUcED{di)w3YnVi+!3mHfK(7!~7S{>mc=lwcz4o zz1h7<;V&_Csej{YM>a?4FIfLLSJ+;8qqEpj*xrwEtrb4PPnR2>xDVhre%)98;%B(x zEo0-xn$Ov8oZ-@>Ec={dgcb-G2OyMMG^(U`v3KH;kf4LFjgXs2oY@_SAtZMFk(LM` z>Xun(HbqPHQe1TNSH-z<5+X#!l5Wl4`ze%#?~41LI*)(Bz#dG%2Hub7kf8#)tl!`C zWi$W{0GB?JFWwQ*cdwO~0hQKNW%sz|niRfIf5sz42Xv!n_z3M%bvjlCcr-$*y;8?g z=w5kEdrDNp^N$28`ws2Z7ac(%8-{2o%fUVo@8^p@F!Gh<&%pTwVbh@-9rbqKH-SyC@X*uTR1j<--QzzC&$YR|(2;QPa41-HAPM(~ zDRWG6x5j9X1WKcH}y-8&g4`evYRpG$eiN3>+T6h~GEx zEHBA);h6ez8*`qeAolFU$D50nIrf=##k-+qgXGq-1j_)o#qEVpY7#Ai0d)8>u^-)@ zRUN~qCy5LWS?GzWIZ}m!IM$l=I9Eq`Fxe91x9U|q=2T4E_+ckj@4g(oD9ppwi2nMDwqLZoM!jRGY?!42&v9`k+ zh}N@(zhdyibDEu91m4NH2ujr0X5ctmjT18+`+@x>f987q@Y6Gzl!TKY@$T_p9L>nl zKBrcZ^JAH|y4Ud5I}SAF5E4y~%8vkS&kb%L5lNRf>tD8B^F%3QA`(;vfSoAPx5$g7 zT)#Vp$FF$E|FVv7{7-NoW@e`UtV+`S2dQO8`KJX#jf#oKT69ZIrz^INy4+PWd|@cC0k81ZTDXsAu*FsCTJ8mI5w=9)dRf4tbR z{|vH-OG(M3Y}K%sv5-qr*|-AU*?w*{uSQC8(S^gadUDbKDZvj;90%ltm9>pKwtnOP zywU(g!1saFH}_~x6( zGn{e{)U>#6zH6x?5FF4u@9lCdF%DMloA~TB0zJWmnUEgFJF3QwFoXy~Wqvx%h(wE1 zm+yx#<}Zek5qmY{kRH?8XpQr;1`SzOb>Z~+vM8Y0_v;6J*%|qsSe>fMH2)fNJ+8ALJ8fvYOcwbK{ ze!un2un0YDtva)4^0q8Nl$w4MGOBQ%>=E21r}|;g5anVQga~XA_M^C9$iw09ix>;2 zOiIBhQ%(Q|T)9+O-|vRLG2r%jy>&HoTXDa*76C{BHgLEvpIP&HhlA4i?3ST8$z@s8 zr`VSFIJ^hsU2e*rjH?B3zmb4|Q{NDErLj^6tv=KZF-@qD`xb9fnEqjG1T=5hLt?o& zc}bcOghn$SPv3UqXS?%2J? z!xxLkx=oPU1}(tp^Rtq&On;{}1j9IGtefOE>Z1&X!P1$wA$^tel>}~WQJ=<6f~Tq){B;WS_ok~&+U`dh@*hRI^rkJ&_N;$>bl zpv8)CS<=hRkIwU>DIv^>FEu*E7{*IH$dySBtSujroqDT!%+0Gt6>}?l_}CwKQ7voY zip&gvw3j?UXg$%&>Y3c1Ru(ED}h% zg^u7gf##gg`WY)DRP#|*qzb2#TfZvX8M``zi}47^Jq58^_V&Q)lB~OWBi)48Dc&*&?qWyDkc;d%Lqn-IH_Svs3PlqgkIKV{HW2+vGl4V)r z2c%q9?_Y4U$z2g)8i2sOu*?)tL~eK2)VixIaY>~mdnzThORd3Zc_ReIBcuj!3%~yGKDgOyYXf|h`gQ|f1pVc8&f0uZFAP*leNzJ^xpDzawDYkS zY`;5(jDR<;1@-{}sil6xqzpS1ez?c$9oQk42=y2{lJS6WH_lN9y>cJSji7WbWkRAW;&9}sa`diQb#(j8(TV>CemcsCTOzXd&t4>y($Ogwqrco2&I4HYN*vr`ZQkK`NHB> zhiE|8lZlDx7zN9k1H<}kl@|ay8=3RF5R*t>Xx-ztwU+TVijKP!6EwY-v?3=2TRWky zq+(jjTL>5#763;XV!gW%}Wn0q&^&%Zxi673e@Z`<|L1WTsN+D~*GW5u4{GF$TY1CavgNB!MU;aU+0+F`z>) z#cE%V;xN#Qj%k^E3-(FZxwhXq7TkWli;OIz;mkF%`*R!WBfnmBI^R_2D5t0|vAR5hjzDLGB0(vDm zvWdgEtAHQ0r4eebO!8r&BMDve=(eB-h3Z-`1zX4Qx?*QpV29b3MAmp~_U< zQm~tWVPgBlbwn*K*+{Co?ikOJS$!dg!y54{nV=4+zir)Nym;Pg)t$}TkvN^Jk9!G+ zrol9P0WroyMWKp^icZo_Z4a}onAcrk(aUX&cgqwc7}Cq5PJYEL%8GO1`JXe)(6D@3 zBKtO281Cj@_U}=zhx9X;{aBs)iB-UKY1#f*%H=fXd~8zoo@~K8CPFY-1ciGah?sDO zBkW%Dq`41Z>WOpfHy4$>0ntpRE>QUS#P8J;bK zeb)n}ReFz)GN3M!fEdzEPKr;gg4MNMu|1~O$4Jg*c6uLK0@6KZdQRthfMzj!;=)D& zyT=nq%RkXoi~Zy2!FcH=>^c8|^X>Mxh2`^-i1L}TLd@k)?V~db3WL1g+qGSu-+!$r z=lGwvU(BrR|8e;q(z3DJY(xIu)~^@*KgQ0XSri~yx7)UD+qTWKZQHhO+qP}nKHIkK zckb+UL=XBOR74FbE5FROddCHZQFkjI%Z`xR=-?!?+Rgn*K$CU;s@l07CpAYnfp6LM zVJ0TFv%QiE(2GXjsSNGgb3F2FZO}7wQSagBSb+JBSU2SI_GQk{uScU5(@1f3b>=Gm zOFWVXr)yJhnJH)abiaK@Ifyl#-Y~fHdOW>6Qk`a-ESsKE`g%Xo>b};i*Ji*ji9RcC zZoF@!PH4=?w5-=$okpEkxhpt}GBH$V9Tky;Ly&!4thV>QghnkH#fn#%l~9&tt>#E( zXnxdaZJ?{ph_uw8&*&OUp^@Ba1eJ-TIj6)C<#WRgnJt8bP6o)j{O^iSh_B}u&o zEcq{7P1*DapxP>5LdYc-47hzG`D|P32UVB^lO#qkbXnHu?bTXxckzscPIGa$m;ZHO zP=K~g{e57g#J=K{S+`An5&q}6qEj9WCJMnyu2mlFcV~+3^YhYbantcZp1%J&ToSy_ zDy}RcAywIxT~S|ON`??EM%tCl(Pm)Dh0GPf-<(I;urd>N>JJU2(8N>D^b1-XlNpE4 zP(c2{m0w2C%}jm`INr(8??86`cA`mpOcXV65=WtyBz$T+OZns>gOViJzkXW+Ou-}v z<@auhp;KNB`SUTVfllRBQx#72Q?|Ko-nH7m08>cJ&cDvcJrq zl1_|)lws;f2H~G$(J&ZU>`a3Wb!sP2vm3(FB7t>HeX{ytBrD!1`wD1SVqAv_X(%>) z<#)I{%Z=dBG! zMW@0?VN;*=wW)y*G>a^S2;k&`qkW%=kMgUeN5E)6gwP0tp&Pi8FbLMyLt*a*SbA2!d$&IV560bV zGK(Y&wsFJmBni+T2JyI8f;7>L?@zQie3jic-0QX?fKg%mxviN{#{N)g7`ez!uk641 zp)4k`Uf|ZTj<^8~_@)CZph?_ei)#Eu204>JH;RW-5KT%V5s*48e>gV-LXaQ4A<9tk zwL{Us?>h1V!)QSKmFiGu*kb6(r2`|oV)s9@NevG4B?sU&5@RXf`gy4(IdwhY%@$KvuuHPt2zwr!-3bethH_ruur9dwfrjq zHOB3^vWD>^6$tT*ap44ZJHShEuW#ow_AyDKwIRV83Eirx^L$XUXZIpU z+~+Qg0965`O&VGhzjUzSHgKsJZhc?|0cdaqzw`3`O*&`bIE?ax(c*>(d+C7HIJDvC zfuZk(CMVu*4fsfaIOQh)qNgUzo|i(rYl}yu=jG19o9O>~-kav9o!5s3cSS$eQ533! z9=T5TaRk1jbAL}$N|zwh*Bc4OneYR!T88(R$mP93N#t?s5KgVJtSrEl`&pNfmcH&2zG`_NC{T+p#p&;50= zQZvBwsmiO_G#(Wf~DZ~8AVtZ*IdHu1xEp?$|(j>y6lI{4giML z?+ZYpGS8uXaaa6Hr}Vlyo=cwYr&nj;YRj**tH$m+-sTegZM zii?g*G(zqdl&CCWOP=5~)68(51YECN{~3CVKX#nu%O=f}0^~^*hIyBl^7ig3m#LJ4 z1xIS0TCreElLS^8$4#mokdMRH#kZp_02#fY%xJj7fKz})jf{PfOj-(@by4a_MB)_6 ze_V_5Re-qhWo5iltk9n5D3r_sQEZURy-RI0oISfQsY5W@a8+&@@G=A?s#4%wBd7np zSu*@rYlH#m=7(}P{jhuK$<}-R-c&F;RW7+vNkqf?`Q2ZQOrbwUnehu{I3ER$x_uh6 zLY0!@fPiXKNYeo|><=pdH&lc450}y) z{8RiU_ zG2e@i!*XQtgS+cZPW0qYYd;Z)+_@$Rfbz)!SmNKlagJi6X|W1wr&iXJQ{G2W;X$DuS7>7`C`-pQBkV z4$r}1zpc9ejjAP^-e|ts-$mOyO!qC(RvsoDW2&ovi?T`}K~a>D?yh>)5-o3bM8zpy z4ka9I#sUonpD77rdt1QB zSQ&ClQ?I!DgKaaou~}};4CKnYfsFOS2eAdiZ_`E3wF}Lh^PIf^FqIZEO;`7w<}R?R zhDfI$0WV4p-GY%unlw--cr;5l$cyPJe}1S&e&(bPI*CRDx79C-TR9l_nG73wfMTYH zZ)owQ3lej0ycc!R>Bc`|W?_?!y(g7~txx^doLB!u+4vv~Z{C>2o4`sc zw%xNZFBHu=cBl9G&`_YTo2J&}_j3$y=ke#i*=X4RH%A^T3)BBUA2bc+@n{( zN1KwVuI(X-$7L~kBeQAK)|9&u#=%@7s%c0Zp&2N3Wm~qp1B~NOL^Hoo>a!6+4&=be z@rsScPrDvC$lp57`L!@&+4eSceXxn$tDl_QY#g;221<=46R(68wfW)mV5^K9TB=tn z6dv5CTdFj96jt_~csilLOUJ+UV?oGCe8SK|p4^yJktb^+2}O3D$w#Biv0nX`d$JgG z%3{&-&BVm<40{{khz7HE8cMnoPwg-G7N<29^w%afYCa800;V2%IXauQo*Dl&B}yB^#&=C8XH_$nUH^TEK`SkqR52D=u)U#OxzveF?D= zaf0~va;mTG+4f;!!B#Dw^LH(l{a17j>+BBp22V%S@zX&vwb&mG8l`v!W%uu@-inK6 zTfE9cR|&xQi%P-~E8UTKv%sXnWVtOgt9jTUR)>oPk&)~=Q>I8W)AwjE2r5$cc+UAe#8l|62Q-dp=#1vBq1Fvnxu&qzrbi%_ zG4ms2U!0HGYCp?MFmi#BX#outR()5U-MurTuDTX2@9>5G6e1yaDw_d@MYyp;z}H!I`AKQfavI{&gJf@4hM)V;d)B#8-+; z6|G`fQO5JDBmJ&-QJbzSa9Ymrl++ZI!D(O2=->Luk`B(iruNIO{n1=;)QoO2=fjIV zWas5n$H7!~XP!&XMc|S5kVFxG9x|4VDUuzx@;ARdH@iXLyA4$Dr1w|0?|-20n25-! z2AT{DkqEaj_lqp7yS_g}8wZ{UKV*I1yfj%zOZVDcTzHpX94(Y#V8w_s}PDCw2M&$t&2Mzj}B8gYc;@ZCc-BrlwKknrT z703>`z4OFaN?`y9z&fEq@-LK23t~jssni?8!M&Rd7te?XGC*_UlQREP!8s8e_Htqh z-3kAaS@?RM9ZJObYe{hNH{rByN>%K@wP-*1tzDYzCPr7!e@5%NjvFV8nqDdIyg9aF zMU}fb``Ys>3c!!=fZpg0I;?LArjhKB1k)JWB2-l5MxZRjns61U)VV5>f8$R%B?iz1Ur4!Zftn&0c|E?MkHF>WO3;XuCJ^Up@96;Qe*B_;^fKM#?Eg#^ z=JM6Tyved4K_Ejl)j@>pImom{_0n`N-$sGNcPS%8>Jkb_j=qeG;&IjvJS}RXTvRE~ zEtx{3Ja!vFL>X7OO<|I<1BwRoVY(00`HhWST^9*$eAH>Fx$OEBnf2_ipd%MkSh}x> zI50(_MHPbn(_5^i_sr<0YrsH98Qd^_Ii}`8ZF&Y6#!H~qrRpBuc`D)LOt$5(w-ZF0 z>v;v@8w%Pu8By8p)>*uU6PHqPN`Kv!G8g;Cf(e&@wU5(R_k&QptkYL}uH9mO)3nAw zXPz|xW`WYy0A<(oSs}apiT8d>cimcxv7o-q;sS%|#-Hi_X=BtE*hnYt`Q0IoIMlnRybi(<2dwu=1miXYLurW@IMJ&NQA>hazFC z-YcDenINQsAde?QXpvDFy>5!gf7t-x*n47BTb&x5>zX~gFuJl$$`1@ehIq2kP9ms! zcu?PHouJ_e7iW2uJQ@9<&D3HsPw1}tC|IbmdG9a7`#7`&IAjVmL;(D25JYY3x4ZrV z77dpY!_#api^ko*>#A0>>9fMmySwqns2dQ4MqK~pvD9TrHGMCT32hbCs2A-xq!}o^ zRe4J*sG;V1+DI@VBtqiiWLC?(q#4B=N3&QORh%?U!e~d2$lch@R zveK?iz9CDB@xBM$9ZC0X=2hGcST!IA_5WJd(0pC;GL<8c??GlUwXV#!Fi;qi@6xw0 z1u`;vJn&d@6(l3;D+Qh-dg)M5u(EAR%( z0+5>=>uY2@NpBQ40h=tbRXipj4y_kqOecHj#p#=YrzB65xzf{@Y({6&MROmNBvI?H zcc{2xs5=9r4Iku8*YArw-d!xhBte2aZ9%WvY%y07CNXz`hYo~xf!~|5A3_hZxSw5Z z!a4kGLN#tl^uw)#04KRQxX0QG2_CL0C@x^2lwxZv!ww*Ra3CXU9%$a1o9B#zpg+Z~ zT2FB~2-SpTJN5D07~{Ch^Dwvp=nLT9{ZWi6SvPr z*gZGAfEJJN$vD6MHY@s~hEQQlj5OhmK3^Z)_Px{J>9te*mo${)e^VH;aQ&FdwQke@83;OA%TsUBrfgt6uRV3a*9>w`&67?S(aVZbt~1qt~fu+OsrU6)d_Tl zNYytR{V7wdX4^%fmTQ4>D#SIK-TgapH@Qu6m&I z`=A8wiiXx7lU9w{?hzV+h#r;Ahp_IH@{z<|2 zR9o>WQLXpvn^&zAO&1RzJSf3pmKT#1xOlvO|bc?-e)LgBuWb1Z-!kwJ)P!Z7886V$U|D;-Obr6A)I zDEpbIi>kO~O4j`&O@u!N<8CY2nz6%<4NXx6&%MH+CqN$T$wbV;T0fH03P4RJmH5p< zKG{JSC71tXZS5CG6;0kY)t*^ErF-i&yRm4hvZS(CS)ZB{lz~$_6BbLi0##e5KCZFA zFZLC8RToEi=n(U~)c|!;?1AhQDMDWXwy$*P#XTv?jQQf_KXKKegUC?D41AcPm^Ist zQ$gm-wnYcEFN>u=ZII~&VQH3A_^BUr2XC{8Avvs7PM@2qEcb`VW~Eep!M<^(f*jmI zEW>v~KL8AK@6(NBC>jkI+V^$o-&qG*VV`q^?`Vb*Ll23%p^*U%m$;oRa7;FJo~w|0 zVTI!`o>WBBETLTQ7;yb83*hyq5jG?Sk3?{Ui#mgFTLGxrGsZO%o#7!fqq<3|soL~m z_5*?H_qb?BY=S2NbEum8Y!L|oKWXuU=fIT;n0o(s3)thYhSf_a%E>&V5MS7#u;xCMzp zoN?SE^Zmr{Hb>JB%Ql+lCdo-82PH~5 zSID(~hCCdVY?`@{M^2(tahXeHD6qeVWFT$ES+?qro~}bSbq@*=O~aZY<^tA6v8K-V zWz&9kxbD9iyvB&8-OFe{T`(FbQT`@r4~DOWENC%a1reTHYSw4MO$$OXH6)rwfmjfK zd)}G2Bbon$ZcZg+eb-h)-F-)xY0xJ+r;WV1@}v(kvbQ!^7aBZOfE=<~{}avZS?`gU zpS>ZHlT_$aa5AJMxV>zHW_=99GEpgA3uI+<)*S)S6$oB>wv#C0%!w-JpI{RIkgrfL z*=MO0(R$^MblJ^U*yPY2oVwwJsP+c#^^@l-%09BMxA5qu5!J9;|t8N zV5s(k;}syd-tSD;TsX^Pqu=-10i#c&uyEkfM~Gz8+4PM4m=j1Mu0X(m$RZ*WK|Iv9 zZmj5&zu*z*)TODeHc6ka8QkmO(CT} zHJw`OEV>#?bS%aFhGu{_NfRU75hend>z))o`!;S>ksXBx7Sir%nqk^y8K9GU=I7_N z{JtI@!`kflznCSW6G;n$-m5A`gDos(i7}^&TZ)*A^qI#*;F;*ehc@WjIW3vH|K*n9 ziL;gmBE+gE*r0-H&= zm^4X)Cj`I`9cY3sp*Pgkv@gKfuuNmEvVN>9^~u)%Q_ktB#X1v|U~Kcj$$Z#s5VI>KVu!ARL_bJUt~+b~gXeSQ8YM*k5Y|8k@}5GW{mLrd+$L z*><*38VKuEjL$OlkQGifn=MuNOPwxl;WmbVUSanv=~=c-L!Fm-&mU5Ykhy}ffF=!D zp%}dW<=48p-qS3<_2?emWUuP@p}B>QP1XgazQvHr$Du1Cjk3_MYx~YCg5@xpN0px# zfYfij_3%rg>pey%%%lQO4HBwvF#V5alQtU<#Qn)Jo4>(n zWwP#q5nXht+U4DNKi^V&)3kDVdarMVmVevhd3`AFgc3X$29JL&wMaXFYXnvE9@fk0 zx-ih7RhCfJlJv;oFWB8uKDE%04;5=Fw$%FXG)fG=?gkveV~DwK3f4dV(Z$pY$YISx z8JEgV96cg6+(P*GlOVA$;@*_}MI=w*e$HT6M~a%*oxM2ThxDGlwcTR+u=2k4`_JHG zz@VJ%gqrt>xpGV6r0!Ok9`KjFgXqj1kAJl#KKK(pek@=9sh`n<2&7N`TM76-xdRzF zSsDKSzTvTkP27?g!oP?Z@qR+kcth=$ZWkaxBm{)EOx1Eps&{xy<8-~^`Vz1Qe|ICN z#c1e*4kw%l70BW0`D&VZu6rY@56xO|pI*xx4!?8#3Qb-P4L_woL}LAUXUGNCWw)hkEg76bE_YRDG#WAGZ!w>avMU zt^}mKi@K+aZku92;J{BO-&9t8Tiv7`bR-KYkAAL1}!cjXYCJJ?L z4CV2%(Z_?uHg2j_?AFBrq=aD57cB66O;}+&Qr|KzBz`-(0F?R}L z#H4W$IA#2E<69O*Yjkhj8;raU4dC(!lA=rGTeT-M?v_6WaxGDUlsvpz9ct&0H{mN~ zjV`i@EX49V$PiTr$C+4yYEfQ5uZ}-N zXGgD&`Hdae(=$AQe)Q|DUeuQ+D6x%!7^l7CNt|e#VS?jCA2GFYSa0h@v9}^m|gkO9~kSLCRzR zCx!SJ(BKzzbqIwkY`a}G50=nnh1!Rq_7t8hTYZl+-@9}axa3=s=5?;_EJ@)$pG2P& z8`)+t%EX&*h(wKTfiL0DQ*#%lVZJHMz9GYvAM58A&;(}Hh8Tt#_|w}StIuFDZ&w(k zF5bvP;qiI$IS2`f|4933)mt>68WTDn&pd8dY@Q-IMnEh3)|a{RB|q;dUvjtz?L>06 zkfaOVp`qR)wpp_svBFVI{-2HJul=~CNcIG>JQikoXTu8b*BW<_m#S-vg`T zrIa{WUeZb~D?SpHe2^G1u`!^q^_;wL*(t%T&j@@NrgT#?kJxuCm8YvGjTQ{+I*m&_ z8^jy*jcxBTKx(P*&Ki-_gkzNfS}bTUfy8a6Cqe z9cX=X7gLs(K(r=dCRv>U%T40qDw{(|Q5M=-Ve+2n7mdBU>X5{QOD<`$DRzQZCN*oC z7^qUb+Tu0al-_)A!|;`i6X_-yzk zAr?3Oo1wUkF-f<-LB0hXv_*WN9+?nTd=YQ&%@D(EL&+@r@xfQ_*kLG)!k$|6`0ZKw zmm{!MUsRfhB$7);4o#NJ)}9qvWOMalLHO%>TD;oZY4fVDr?zZ3>Yz5Uokho?NVB1( zg|ID%p620U=Uo9*x`*Qco{AyXK)A(l@$;AxTUFqbVv5ji+0(Ppt0K6UtsOHBV4(rM z5kqJkyUX0WI!y@gK-w{L;?%!Fk&59J=9z)Dre_dyRybL9Dukf6kc{@w>@N$*DB%ek z2o5wIr8W+Cc@9le%RafXP25sq?W*ES9_#nSGPLp^_roS^TS$;RS>Kp$I5LMIrsBbL z$3=!Yjq#F0p+5x1N@ddXjnjA6#5h6(w)YfXS*R))>-p6ZY?!JBU=)x45KuHbHIq8f)~<$cbf#a>uPc`+|e ze}yN63Z{FON(fN#%ikCQ!@&*4C}*SQ?GQjg>5eDprJ)Na2PXnMe>^G6u|51LX>;$t zo9C%G9jGs(O6+;UUGbKCKm)qT%jyVzbg5SC_Ct?@-0c*Q^Fm;rYR=uYEzI)j9vs>Z zA?-UhO=Ry2@W<{6!@t}+*TUDEl1AkDzo5l`(q{hKBmX}MzL;1z{{s`=qG^+~+4_HT zU#k5$1XS$z-IBU0(i#Inle5yjK*!?O*7z?Q?duNT9sx5$q@ z=c*f{P^+~t5O?0f^XSpHe2E5T*jUpVWi+wFR9Q1ByXcjhs0O0Xj%(pRebnW*2c$<$ z;H8I}48MEb*ZQi-s8L3lXt#_b=9F6*rX|r!rZ@ZbAF((0hB1T_F8S!7C3r=jng8FI$P9n$eGWZzSvb<(m}z#;|rd|%WD&R35!A^jSi(oE3bByVzz9mm_yUt{%co81mQ z=x?{3S1z1*#Joe-HPYU}mSlwAwe_nBI`XS3a9$)s3F)ic!hEJB9{dJ*%TDT~>6;9- zK%q#Q!U~1UEh0X*SU({UXS_rTknn=fTTFHUjVH4^vejoVONTaE0C*@nQS$xe`lsmL zsA;5MvfT8VS&aPqhv0sDK!cmd1NH(ynu(oh`1pq4QdUer?OWx^2um{dPmma>C8j#p z@@*HD0sW9Xfnq8$`oEpN->n37GZA`~1{vv2h>rh&vXba35hCcKJVm(jgtt(nF6<0m zWqQ4}P6rYKsp;0TvRlVPZbm zV_^Pd0XZzb_dwv-LtcjV1jFPGKU!x$A#|7stOOPG5qulit9f^AvxukQD_NpETjPAY zHGxx+KJ%I1-;d6R_76N)bgS+j7^AgV9}ZtW>OX3Oq1an>f#CbJ>cBbS4sz(URs{p0 zM+S&FsbTUcIG`_g45GXw1QSe3lei75^uzB&0n+n*?2Z-9Ey|; z9JHXOM$&=1Rfvv?gQIEFAnln1y5}zBz$amjFPZMJmXeqlLCM@**m^PZ4afwxZ>D8? zt7>9r%b*cl%z?8+Q%j=2G7Xt7TKwWe=bri?44uyy?&+&Vk^uU|k2Gv1!7B4YC_*U* z-_-`0TWTNiSa2xOS$hm2S9 zSHd?VD_n6GXJS#j!x|9G)vy0;!~O0@ zT(&$1DAQKsASj3G5$z0}pN8@1_e zFe>GGIAt-lJOQ8Xw#wvOCjsL;FybmCg9W`niJF)zDm&`$ z`J8NDXAS6|QT8cH$BVabMxTs+A<~h6JPAd@apfT+8h;VW8P&^VVmkeHp@Vj9_UN;J zYC1|tViF{a@q9m#W$NG{>&_Oc_4fo-U&3%y$(-}zyYrwIx<|)aVh9r)Iq4hm^lV_( z;pWI==Yt&7&ZgDd7p)qlz&UbJO!zEERBS>F3G3Zk*F}H|i#<$Cgp_sUiO)7|ZqmPs zt*z~e>#vFcGAe-w?1il7ej3x9QHum+3|S07ag zQyATs^Lqy9VD57Z&T6{djus}>3rv*V@+7yVo zrbZWfJO~%u)CJEmIfv7~P_f;zU*&v@Tz~fuK$Ot)Y3JBbigkJ)f&QS_z{%k>@JGah!v>|NSioX9# zaVeR`q()HR2NiIFf&stn$!|_;$kC?wV`CzvJo6D$)*yC8fd7!2Kp^4tLoVw+yC8At{afs2km4(b;%Y zi2#uguXFQAGjphhG;siFE;|<$b0+E3>}o#jt$J;yfGsWZPVxw@j~x}>4_0&XrF*(} zBBvW>y?6YjZY*dzDGVp!rC@v10uHG8k>p~1ZcV#mXYFYYEM{|z@fQxhOqonw zSM3Wvtm4$7G|VV1_e^5XdVdvRU(OeBYlc84+{OX%{At7p2tP93F34GLC~@4$r5rCd zdw~atrVvYrXtw$IHmp$>oR1L2LEPK9TpnU96zq@NlXtt`0KRN{9Mp_^hgcBtHya)WLc^S6FA|T*RT>v0IhcZWJJQsKKF<6~J@RaUe1p3P}b?KOc zzGnwegJ|(u)kw%Q-Y>nHysrYn!GcBx-b1P<2nNYfS=Pv$-v@t5y!-TjsRKFxCtVCP z1LJ?xfjyerPX9!&ez$rB;*?JRbTR(yOJO84GsR1Ci&3A+Q^2$fY+gv`@yqXDyKd;v zfyFSBj-^YSa}gkdSBCt4U3(XCDeC{iK2_C0e7)<~s#`nNUEg@>0gYLwhRzNx$Tp=Z_O)Hvpem=GAi?yEzmnW}TeRa(!FnT9Hut}c-HIpby z44o^SPC}n%qFT1Ci^rFp=jVocz6U~U$GNt44%=qku9rUr7v{~EQJ#9uL)pl^S&t4a ztyhyT(7jTZ?aw+(o^-w6`lVh;{ZTHKBOK_t1s8Ab6mcfo=sqjUn?CRDjD|X^UKmi& z)4@%+s_TK#!3CmnIuqt|nvK)O4AKl0HGXdfhs#*)8=46lB&Ck&RfAjG6{L;? zQ1YNR97t&i?t$8L8BAO>fKbJhmaU|~h0x49d3bKn(N=J(sHHv9HNXe1G;MFKSRP=U$FcQP*y`naJ z=x&l4cPqCTthT0S(>mH@G6jo@1D6Y>f?!mZ&sNo8soKHE_>ytU2gawdDSr5Plj~zr zZSN|Jr>Lf>6MGF=r=A1?o`}$%0+HJ4DnZ#@Lo_*%y$PZ;A!NvPV2-Fv21h8&Pf|4) zlRl_3l{SV+Fh48^O3L9cYj5s67 zT7bh9A2MOfd9rK?px-gn==%5!!9b;WPn5h}qdq<55QEk2v|V!&pS{V?aC7yw&_0>0 ztEz4YE5TBsur^t3v~GlIA8}f3mI4c~i{|H*4O0mq=^it%L#FL1St(AAG7P&Kt9M1s z3K>Ocpwu(DQU{m+A?xSNoVe@Ru&4%kw&+j3Kz5ZR$*%OZrlLKOaX5S`KfpCTU^tpo zS_~E6_&VPMFTF7?=;Ag%jF`R(@bAOlngi?2T( z!q-f{g_Ye@zwb_n@4#+-b}*3Lh2OaELg~Xq;bQbSV`)r%K-ZWwr_v7Wr6N^N{G*1$kt`x} zP1F#Y@TwoP5|&^%zsXw46QVaYszH1iml4!Y;%jDbq&`{kBR_h#`sDBXfm>(4uKwZ8 zwVWv&{kKKzC~XClnGNxSsKstEb=U|cPW%5}PX#xDCOv78ivDwgn!p&+!pXPy7y{ov zcNB>LMjSey2|J3NF}xmecJBv9gyT{)o8RaH=98IqESkv`=@pYwvyP`S3%7nrYaupA zKcv{D-nzLsq9XuCN9jW*G}D{MhkL=w0*A6HLed{u;QZV0b8COyF`&rmmsk670Q!;c z6t0ix8@SL6-|NNeNB;~f92?KW94=&)eQLb>*IkAsxOMJo3lawbLD-viQo(!K9?4G^ zCYZU(Td2x7ccF%<2APF3i08C90WEI@Y7d-zJB!l6qOhghHj<5bg@-l$B=6pjay8Gt zngpx*5nll`o|p65cs)-}v0$h#NWT<}_DO?L1)zA7#+M$|?YDZb&fLQ+y<}j`0%fnC z_C{C{W=fG2c&fn5LW&r19(CXHPNB=Cd1d2kiQO#}4~ZuxJjHSFXCl9Pc-3c&Gy2F< zMBB@iJN<3**)zN_+!Gj13^Gm%2-04Fjeo0I0FJ_dRk686rlecm^VbS{X0*LZ8i_W^ zG+V<&L|GPtMSA`wAvs^DFUxTSu;(Q<`^lUv2Y5Dm0G_cVcHn*DKGvzSjF5oQfM|CJ zvf-q>?x{n%B`}$2&SmAvtsDxd4#nXlY4AA~w8Z`d1~H|410}gA!Y`fCc+$Et2JAk! z_ec@>_rTJ&yvJ%60hp}L#3n58LcbtRk^eWdgOy=?$0H$}0Eb)}BzH-_F=!WP`l+YCp^&2vB^bkze-ub53o7MEVqNhYDHFkelgXyk z^aUVyv$>oLZ;|YaPcTx3E8iePMU9Ife<^*$o2x7p)a~ePF7A&S0T)6xLL#}&>W&Nz zEB9Mr9h5-pXt>&aoe|d5yvCNyc*u*;oTIgjj#6$6>rLTHbBoY-0#eRv*vbnQkb7ys|R`?r>pmQp)fRx3RgS`W$sd z%3W??RE2_)Ze^bArc;kSR;7k@R2o`bqoTobMnakj3OCam8^hKO(HrFh%Cb7FQ93P0 zjtagbv)+y!?~34@e_j=?B)Onv*|DdpLD8CM28-L#Bs`%z-jTWpoX4J{N^Jr``UlOk z$>|rA)ogoSJI;J2JOOj&W}>hs09B~Zwdh923x>BW^UzHZVZ$;%_UeM|+W%m*eNA&? zJ*l3ah5*{RZ~#E|*j4FE{wSjE#4OCjh4!-_EH%PxO%qy;rvt-MEwfCu=hmU%-`>!Ph_dXQxd(fT(sy7C;6*g1AzEY??O?7-Wyr zgX%6S>Q`_88mPPt&nmnuXWCFftn3k>Mmn&&C<5*y)em()1hx~tkZmAE@akxi2l7Y0 z&eBankdXTw8Jn5o%l8DH2P7IAX}}-|A9htf{6>eOu@e9z6n}t*y76)WeA)ULvolF^ z_Kf!<1ADz2hk%HIP&){4@w0@)vWl5+zev5yjYR4u!3&S(!lRI5lOPkp))E-gVDm_s z7OqaCT{Ys$naY^T&QTe+Zb%%w^|1a~WHa#%vEd3YU0`d7Oq%)@4c`zlGx~!$bK8zk z{g3=BJ*Er1<9zrkwZETBCz0Xa*lWqlBbVdi5SS&X?%^@XHfVX?HCv$Z zD04b7q84d_$f&M23wC$7E8}|xVlh`jLu?VqIdy0TN4O%3C8b$#dM%B0gN>EJD<{ru zn-Mc_f;IERx-c!vM+I!xgfL^9ip5XkWElWQ7N@2S0YGq+i)mBPJCne!ZSQCXKC z?m=b(3(hXdXpGb-0)mvwx*JjkG``*xH=js|f1o&SlaT5Bcsx%DNenc~3{JJbJ*-W!Po*R?QD(7j ze;uyzpPih#wpn3!t4(Zn?k-*IZXQb=NxH0Wm{K+x+yCkFnn_TDs!n*Mve&2xJl5va z4Wt}RqqY%wSlxlE+D&DWorD{gNPxlKT8uFr#Ic4KUlCp0aMWRUyVGAR?kTatG@4VMD4qcN?Zh|i zZZ`z77RpNBEhy!7Or^YLCwRp`EzqcxiC>S>Oxdi_Nea%Xfz#3R6T4i$=C#52duMds z_8eB(=(CQ_y&{$W40EQ(RNG;+zT@3ozGN9*sf<Pvuce^VbdIjxadwLn8% z^KfL6%mDs5aT=}7U=WxvVIgq_A-JavQpPFX;CO*m4Dz>I$zoEe)~xj6%Ki+iE0mbB zguqc@Doj9Uww$_D6wJ=5w7>1{+NwDXjjCfHO0M$KM5Y!sTkUkQFB3P1iCJ(OMrQZZ zN(Q=9Uo5*o)nfTiO~3xSGh3xPXzJwqM&^pYW(EHU!?svU#oj7N zq)9Zne=G#w1Cbb!kq|f(dl`i>aY)KEbJ!lD5>Xfmf+Z&m6I~bM?1Uo2DyV8AkQUbv9;>>`c%YZwM=zDb~5pS7g~X0jdC zAeQ&x%F4k~ASE#3j|rh5trCR-bRe?c6%y|oqVYd|Lk%mK?##B0UElWj_IUQ=qxD326?NUun*}76Zi+_cBS#Qp z^1|TDJqR*IRMx`D*J|;TD~5OTY^k=cHt5G=9r{G5yR-Jf|_s3ytx5QTP zn~#*bs1sb+%8}~DJls=0w?+gKV`x_zT94%>YX}L^#JQkzSUNi0bzV!wH+w0aXbTx+=Ao`*O!C+LK(e@G<14Z;_k42Al<$d2!m7JQ*qxf_Fr8QdEk^S#x%DK-PFdu$IRK_&CqwBs$>^=m##r zZX;Q2rQ{neI*FT&ruXRQumjxzJivd$!x@(WQoqJt_FLfCv)eG&N)*7+>+-QLi zRv)WG*5glVT1*pU6mlN5;}q_)9zqy2u{}>SxYMbQ!5Y4?glxpSt2aUdeSe+4_bgs7 z?gPI1+PBc&#K>A7)E~a=#{;o`u1q;l4;zC?e) ze@c%bJO2AXzY~sAF4J_4ZH}xd(>~sggrB$m13ou2ZcLGOT+#TSuL0?>y3^M*)3SkV z6f+zF18iO>Ox~a9HYovxL5#**MlDp2Vp{#%zD3JyKrsF&0E0J?4NfWaf|EN-u(CMh+~l=AP*v` z*=fgb05He{u2tg|qkJIB!W)9rt9-P;LW*2ilD=eqfbNv3ZfBNj87K2p~!-h zamVx>maoS!!S#Jc^c@5@T~nImRHpo4Umd+?(0Rw@e=uadAu`c{Z98MJK3Qn)@pX;E zo)}Cjd{!o?ooN7~K!A{&*B!LvbpIXWqFPfb3ef%Cl$0?ZMs9klooAA_j1m;uLIx_M z<@pgN9%?p6TDuD$6Itqs*wE2#(PG&78N#p%XKGa2=ZzzSU5!5Rqew2*;6Kwb>$V4g@gmhD2)K%@l~Z1-+SyA`ooQTf;sh)VJVVNjYX$-) zwLwO65WA0+2;`2Ze^dK+UhqQwkB*a~HQZwf(Y4EqHKI*=0UmcPx2q;P*Kdsqf3WqI z&>TF%&Yu$}2x#z)-Zd}SAj;(o&6y?j$uQwzef`<*Z`vQwskiIx|D<;RD-H}jJLCUp z!zn`Fh(2ikjY#W17BO(B5TBbk0soOs7uLun_s{Y=fAk}oOU6`JBBt1W`^d(!o~R%< zNq91F6~oE?kY4|+4`W66+?USV^=T}V$*{#^)$LNvV1t|}jbx1pk?!0X6jv+$m@@pj z+3gU4n~vPjjwkkepKwkoHox5~+9@ZrdtZ3wjrmzEq=3D15MsSgh3#?2Bgz6FC0xo9 zT`w|jjZqX()`#qI?U-;t@%$0b37(efEguE)*nJ9MZ%Vqdq7_QeluuxqRH|DW5>EXK z5$6f{4SlGDN!)7G$El;mh$%=6z`7lPj<14Az1 zgPQ80FB`g@7B2Jc5S{`^v1K|M$yVn5q-q?Pe|~`}2Xtj!2e&|M_a7p}OHtKWdEdK=Ts&O9u{Z!$(*%C#-gjMr&u1eHM2pvhBXX8V9_jyntw z_Ve1UsBUu-lO))Vcz+#J>~c*_yV=^iJJR6?71Rk;RMjO^b|RMSeQdM`VvmgtvMIe| z9=HPK5JhP|yGfCjle51(RDl4OMrQeC+Pq}i0)M^GntgZU&OaFSv z4!MEDs<+;dr{b?^dF1~S@y7?cm#&Y5*xOrJkluvArT;!yKpmi4mqgzukx&;R;O!e@ zQgyA{Q@py_LEuW?j_myuo(;~kgfX3DD6*1e`-s1cPmCLd;9GeP#?wbV7;7`9o!o16 z@`PSw?|EeN19Hm*{VAv5=I00n7fX(ZSQvzyn|l~QlopLwkWtL;_cKWx8zJq_FFB)Z zm<>_f#)ToH>mFc$#8_)Q4O0W@9EJkxLp@j3G#BLos+3$Gnv*s^fCLalmUF#IJ7?6= zGwd5vL@qfvbRF=Eo^hJ_+a4S)`MmpJKI^jo0X`ohxgoqy*%o)57k9mri8=dXkb{Y? zXNglj+0P)ZS}y!9(e#>;mD5wIQE0gYWJ#(DrA%YNbX}xD77nCkaonasJx)j2ldE=U zUr&aL4~_1)nt#Zmz$}6ViH>_ab(Nf*P%Q76MR*3Jw!!R+7BIiYtF#w%>Fc z@gkn8^IBhYCu^+|6xm;TI}BU5L|JAt4o3_wua&2_axT)GXRN-(*Ws34R$FV$nA#ui z87D$lpkzpiAbh1D5=#t-yNfYkI><7ntBi6_5Y<&a;5zptmaF3=S+2LP$kVx*1ZaOK zVXj$C<(kZ|&Ro!j&PlJazDBH>4ebQ!5x(-trD6a>n(<|F7)EXpPAqD7QYy zxW;jA5I9UMQ;Qh13HLP)=Zj8|{y3c#j(m;M_{3h5bT$->7w+enpM+deJcKD6H30Iu z?GeAw&3@96S}2@}YMZO1H-k?jv85;^RqsrnPXg|)v7W_$IW1t+W1eU?fshbYK|K-HUNaE;G9IX^PYnLR- zYn7FOns~NeNq70Jlb!Eg73i=;edU1b^LlwO0K(W7gLWVIWqt>6zVp*TzXO$!e%M*)eFjNE%h*-pKfKl_(v{}vI4?%Ps7&N+T)um+^96DI_P`uh^ba>+MJtE$NAKuZYuj zRLa9!t8b?8#)ZqghRUet^ivW}cI+5*E*dRn2*#he>=Y(S*>f|Y!1e5|wkk1!oP2PG zS(oFp<)Zg>fa{>+*e1hZ*`ZKIO?GEwSkMK zw_sPFpVqfCxF29kjav2pbg=(dj1dL~w*Ql1=u*G1-5f^v+3wlTr9EaQ9PqkD*)YE% zrO^5#0#q>ymg9SWt-`_La+nsQCJ^;~m9>^uG`f(jmn%#ys72%AqSNDcX?AB$fJ*-v zDoncP)47U`YFmT0qcav1T0lrMxc}}5WQI=cT!t{Fa(X+5i`|GzYvMu+?D!UY};iVgsJ?JrFOLZlx&u%F8bSWr~=ZP5= z8rOk4Ash*4YE<+#S})KH2$A*;Ep@aowOhJletv+tC*$y1dN;d>RmRYqcIi;7N=hbJb z3zJqj1p}t06Gd^8v-HWEmzurxNf!G~iodAq{|;{#Y_on z8CI=9Tbmw>*5kU4QM?Yr@DZ~@|D~AstA&IyhE${#wSRBkRQdJRkFu5L8$2R)3eLWC=0VdOd-Voc{GTJ>7Pv6aPa5$$jnB3Ulu9M^rVAsy2{!o15lP_HWd(z2<_Hz=&x+V@X_h&cz;&|gr#juGM8Yt%_1sGcQ943c&I z4q&FMC>Tk}-h!AH!l2Ep_tckhy}qQRZ$k;)q~Q z0|DjRmmyVCHLvTMHu`pCA219Z9?-guF93rVY+vtsiAQTpZ17Q4_F8IN>NJc!SVrWn zewcu+Y=i(wVmT0XWzqKtkVZVYOX=QbmXF-SsDC7;#6{MMZunSt-=||_qY8=SBkdvI zdO0Qu2{thu0^Fe#b#^BRDImdGXF7g+#DD#ZRs-l#ZZU{uMjdQEZuLm=mNt^>DstsG z4X-FiplCMYF&vGF+HTJ+C<;YET0nm)P$U6ydbm#SLuf_cmG{GL{Age=;k z;i$2wP1z(5csG(tc(!$(0|~DxEF=qc3$#3B<*Pv76+}idfphm;pwFEA@t6ppAq?qRZ~=$a2^lzSWrTY{Tz2Mv&hR848H zrOYk5BN(~FH9I)6EeLI4M{vh@;M>wFvf|@q!+-VY`To=lZ`E#&!~t&~R?_mpR&G@< z%-1LJ-6PL^WHf-&=$>iB2&T`=>xG|67TJ^!WyIeVbc4@{FEoQEX8U)N&Y%4gr1_}H zLx`NNGC{az(sL*%>k1<~R(zVPYsEq@QNf&))4w|RuSa3PfpR#OW2?k~I|r<#)wh}T zC-QuBk{O2TL{C=asMl~pj640G_6 z1fy+qv&TTrPGc5xgOJpk!1kb+b=uywk7?=Ex=0u%(^-{?~6GBRN@>N?(5Gys=`e zDVJ<=IDZ9XaZc2>--dd(2YzHD&-A~G#c&-3i7~JU$(e<=lQW9K19ql|Gu=cFwMGCn z-DHw1DHdk%AVAg+r~?vhpbD8*VX+{u*4s4U#L=Ld+>}mYHtK0dwAifNWzdnk#(e%x zx8at1*$T?spBgSlk(X#WP*_)dYw4(h`&p^r{ul2$yr&%*@UOi)1O_t=nd!_l7KUc%n?v0usV~}$b ztMqlBw+g=XhkG;+fa!9UK(~-X=u9>;NWAwdWHXW4@8G4amzIy|BUMSqa1_-4!P-2N z%GPxO>nfkjf+kZH5EGb*PH=QcUl?jgquZ@Fn-}D=O=-?kfypXM;$ZASSvfzpPCPP(iEM^)ZfEj=p^YKd?Oh zhpX3bn0tg5@HWs+r|J145kQw>-;)Z-D#11K*Si|ku;d_H`Rr4In$6=1!*hg1;eKq` zEJVaENhRsUt3m7e+~eh)o+JMM%OwW7|Bivc#?JV^BcDybTYwuZ|Ks{OdXYI1!_>3I=7&MSfdi6(hQWEWTx^ z>cy2_P6O)r3e4$zwKrRxCV{&`B`Ia>q3&S%^1>KCZ2h{x$!;7_ln!2|N-SNr(ShFV z<%M@Vt#%w)7+&3cunAL{IbpP#0Xi0-Vub`jdp?HS(abr_qQ^I31w4}^gL`p|tFEys zAkG$nW)Dbw;(U!79V3x>JxF0>fV-?fILm;WP^{r*bl{CyP)Jz`)-+ z{~ZhG#5-t~%Pwx7x_G@0g+Q*J>hO}GE}5Pvh{ugCVKn}w1vFmraA;!tURuazS91u3 z2D+uBznA|I`SB3Ed}Zy!u~=009X-QL;Te(7i4%@r(T<@j++-S#1mTdL-LDsYJFW+w zKGVUB?Q&riPI6r4%iq8cRS_`ys$~>k$c4VD7@3C+`}eki)?I4~@d(rIy+6AdA-;Ohzi=2;` zvatL1hq<0oQ=KF;RL@cExs@Y-OF6>SKqp730+e1jMZhJf8uj46+`98Em#9HZ#9cZ=h&C`jmSS2QKKXHYyT56^W)fG_7V~Gwf|y{(3}N~;8{$1 zqVEThtH2gGg|f_IcY?p*UdFE6*AH!)rI|4$a0axr%O4rgEQFJBRmvOpCxCH>B_72_ zQ7T=06Fu#2x!dO9T^`_RH-yx@M^NVqVE-LCbd%XwQ3Fbr#nraHM}#>5bdREgl-#41 z-CP)Y)e;OVXrapN!wPfCPf)G3gp50ekH9?i&Uw%WJfhDW8#o(~O*pQk6*F;b*mh*B zWg#)8KiN#;?B^n8X5t#_YHuC!HGaUIGl(${rJEGEC>1oAN-~p-4h7EGxrKRh%z*b zdm!%%31Y4$*J_A>NH%?3w?m}8;CBV%hX>}l_hJ^#He3LZr^X{p01zqjcR@*P#Y48r z^aS|3Gl$V-X~MLNXyoQ3(gz%1yZ}3-D-$^xAOU|KVmm%ufm&YqQ8$g+dCqgW0t8@oVwX&A4J5lRf&3js*tl?5H~1iRubx=B(Qr4sr!MjW zs(>2goXa1f6nGJ1U(;uP_U)xem-8(q=yv#Hjni{;-`VCP&$EAK$pWg|@!S}Sk~&;m zvpG~BzmV~Yur`ozh)=U~!O!~8S$ek4(Tca$m9!2BvQsH1nmY%?OeyY3KVP^6)X|KP zc5aU<%7|?$GO(uj+#R%=Q6oc;o?Pm9zuG}vP*(<*g*IPTE-3^bf_?R4Pgr}MFuQKt z;Yk!-v3|!luE@BAPoCb?@ke9T52X7N`CUT~alL(s;j28O^A5_jjFU#_`Vo4N@8rl{ z4YA_2hryp)>T4t*wvx9de!AEbGx*4(9IU{rMo@j96li~e{hXWX{*=N;}^tkFG03~6xu_uBM|`$5z)L?hbJYk-{SbM z+L6fvhlbv|0{0Wco{cC)T^A+AH9eE=)p?}-=At8@Pv>7=>}<%M0o|Ru9Ap^39?GQ8 z>GY8t?<%C;W2-nzKf$B$nZi}%fL4+;Eqses_#YQG7t1tK()JL13n}GVo?>mU%Kocs zs_t5W=HR-QPf&my9h4V2PYfcijFn>%QEXK}QgEbCCrmxGfq3M`O5lAxw+y#zciak7 zMyt4zYS8mMkk*RVDi0380yN=%J9u?v8C8%R-||_dxh9aYH;^c>#wp}n6do9p>hQ`> zVFJ}P(;(QQ;~-d9=XOX%tXWzn2^>A#N+nj9QripUL-#JolGlSEl^)xfkl$2`{a>!s z62&u%;N-iFY$v?S)>NNZd)A+s$=m%$=*Rp*-trU}kC=i0333uSa3Cy75=FHalhi z`xo;pLmi34!059G-p5Ep7E1K)sO==*5Im^vrmB2gX~s6P?sYL!Vx$Ew@xoYVm*H)e z5;Hu)q=(y(1jtMTanNcAg~&qM))`fGaK@X>NS~cbo~lr}HXZJ2wh1eH14=**BMM!d zz8HSHqtAIKwXgPflKU&r7F~wJ>n-d|3K8D$MYOITuVW5f#MHZ}L#Wx<#r;&MFMo>u zDr(O#Z+%7sO{Vnuna?+0W2?_0mF$DYFl+ApE3xXW7Fa^h3q9o=hTB0fQ|`5=6Ii;Q zUcc$blL24tK1jw#tTvr+I;q*Qs&YwULqcGOk#ygnVC_lO_HdKZ7B7yNpo)tkBbJ~^ zx7z?!Dm9PN0NQ$Y{*xWz$hK@)s8cSWMr&Shs6H!e=?O2a1RZ6&%R&H50ja=hT#*(6 z*u7L229HXS#cCrkMs1e71}O5cw`#oeJ!~)-u7$ukw9<1m!f5kyv9Lh1=A^X7eL!Ip z?0O}ZXR7nE+OXDsw_T>r?0py6YLQ%%?D~;WdF*#oO%@ygu6;{Q^n5LGbIjF7*ZD&%<|;9XV+yT5~Vh_|V{Zfdz(+E?g2%4uyLi>ZcQJ#dFW;}CeY zT23GFGy!zxv=arsF##LXI&v$@fG~dsP2d&W#rY=;$(-{xoK^&FVL5-=rZ((cc6N6k zBe0y+^Lo{;yUlLfZw}ZV)*gkC6+LcSz^6Cg$6##!%zI_02(tXku*A7 z^XQ|wsh@*UG__DNw)iyhRnARYY`xKhc(Z0>Dxi=&@yuSE=Lu1ldyj+){U=FOJ^cE8c(=RihF%}NH7 zG|`4t+g%B(&&e>{uh3>$Rhf%X_Bq_IUvM7MmM--0W zRd$+6z%`3LNC`h_yIyVUi&Mf_%LY-7@t*CSDQQ}ayTBHIdsgPy&?R6<@V`_uN@sP$ zTRWKBQ(-9Et*U+p+*rGmWce_-Sy{=N!4C%Rg z3!XeP_Dcm%>5@#qr3DR;P8kwBc$(CPEYPvKu4P-`K{Q`$K95iOG;JsgI@JbL@NPYt zVZu=J!cDUf49=$ItnO90Jl48U9n@7_psu);r*FCZ!1?%$32#^4Spb_S8I9Sl?5=q| z=1dIb^}rcSG@pI#KNNi#^ca^}a(X$>(WW02SN~8l?zSG3OsS712iuL3fTz=wVjo2! zrVS?26G}rNk_RDb5Ys76oJw=D1y*Ad3nUkcFDi)ieL!heFR;14eE%^_MnrUphst8m z=&njfRN%MBK~ks~^=dro^#a>qsy?t8Wp(Gdsz78kiK&S%u1mE_W@$qnKE%aBA2W^< z+2V*GC}|+B*Hm-k?~{t)dU!yeluszQa<9QNdi3X`7S05ra=?qh8MpJ&ZJNqQrZcPj zvM%%1_uT9{+yefCQEM;0 zbrqj3Oj^%2T0VOc7Mbq63yQ%Uqouwz66UaRvieJ|mx}|h8o|MfZVE8qSltWub0Djt zXp8+^Wgnpi(r|SkYb+Gq_=riq3`@-*mOlZ=_0VmZ+3)R73pHe%+R?Z5;?E`D0?QPP z%N}PmdAaTd3NC-#X|AU27)Oh&!UqfkLe1y0b42`lWb?(vDmuVoQ2<4}QC%&Cr&wrE z8)~Yt5&(Lu(~F84hwO2}zB8LBuinM7!RD;(hUpI7n>9R;BV~|%s&V3n7R5}ay zuPWY8Rq$T`%oifz=x2z)6T3IC2TL6lAl()fP2{9I{yN~{+jT0W8hq%%L6IEUaBBRP%L3 z{hqve3WoLN5=Kak2WXQJ_AycL3*Bc6?>HfdBu|U&b$uQ?i&P52%kuCk=MYs=6%Du@ z1?mObPQ8y^;o&3yO)e%UlmmDUj{@_pZ6GXRzc776`H~+_mo?+`xJ*Bzhpys&rUrP4 zQl+9tQ!Nsz=1p9w=1}M11!CLl)1!|q;DVt3_ zro9A@16q!L&iV(H${sL)VS8Bku6E!ejg+3+#GKGz^1T5n(plWGPeH9hx&!-L_GFrm z2U_Ic*Wps*d#7XRhx_7_s5~?ScEJ&~1|ulOcnO>Pnn?@n@yP276|ukZub4ybe>BxV zh!dj|OO=Vy;(;yBJ(M5HNMCO{%m7A;oe+<~i(%bSOcB;tes~L(orHobTyZ<`Sb6-L z0OF6TDK(!SM3%jIo~V4VNmCmWLN@HvSKU;jnF4&C3d|h!mygoS+_)iLF$cWQddI@FDFYdTUPKaZ!=JL68ZNo5fvD&Fnk;QwLenGDT=Y zt|m?8(1nTeT}~t#J<2On=N;qtj43A?#zb2@JWznkAfdYic-GCp4)gb9qw6Z#t4Y(S z8*QXNBJaVgclhX1&-cjY3|cLe3!^4>-Gq^CP+4*irL}~VK@6-kZ_|-q!ym}>U^zMR8@-69DS$cQfub&Q!c|Xl%9Nizr*v8R=N<6GFByu+U5B z`Ge?G>QFXSI`0rRzcFU#m(l8s2-Titv|9zzn`7-A3o9f z=@XGlo&PMEeBan{<4I0>85frYTaY8_$t_GF6)Fhdw!yfbRgY&az`vZG>eEfUKY4(U z@fAv}uNl!dDgI+-1S1ipw%!_(B~qnzkwlMFI6f!NUrEZA%RRVqW^Lp3FRN~V7%@0qRQ3R0c*i9d|1kI(@O2? z7^eV0CTD_uM^xX30J1UYh%0?t$vrpP>pAr1deI!l!=h>7uorNA&^5f*i9BZ2fBH5I z*ziBzE8Xghls;|c;(O%tfPgs3*P?2(P&~C&b)YadgLzQX^QZC}o=2IA%P!^qu8_@s0GpoW*Yf;|DHm3t219}d$7#n^yPMsZ{jE;tjiKl#o1Dk{PN`6Z)(QxY1Cj;JmZ~5EM z?b7Qn^TuFeDtdj-!@_QmPXfGOgr|upr>u>*3bix(=r|2ooci-PxA(=%vW^OE00E{d zA5j7lLN4^dW<%8E2RxDhS6;!!vFQTYXvlz#P##%bnPbXLWshE19kpoP=b?MUk2KeL zG?Ll&DIV56+xEjISC#5P2%9tTh_KD?Sq^iJ>XG9)G9=IPE=&VJ4Z$LIbAc>mJ-VXh z^FxM(-5DM;axtICKD&tBSCFLAV|`ClW9URP>h>vI;nqm0#LFWbdW7|Kd-{S_cLSjZDjuPo!y{GhaX#Uuy}o0hwFgmR@aHj4R@CGZfERwsTAQhsF{_Iiv>H zI?|mGiO`2tj?KGyOaDz%e_0qOZ()bRq&B5sjy}e};gPTs!VCa}iT_3HoAHf|*)o-?`Lz zv+6SrJZPGbMvd~3-QF{hZ%PBNCOMyg!?69i1wU8`U|v?UE96`YkQ2q2X%s5=#9in| z+*$tfR5QyCvn?ysC^Jp_B_h5AiBqjhuQ#qXRz6W7(rTFRT9DRO&!jhjA?V?ZJA`%7xS=LrrM|5l;XR5s%=%sl$6GmaQ|QQzvUEMs>^@VKH4c~ zJ`3x#s_QjqHCylBGfPidrr7PrgIa(mj()~+x>epQpkGzy4E`GJEyC3`G`ZFh-yX6r zT$<+=or7BUF3j`9kg>I!;MYvZ83+F;*g^5^x8qMyy?JWfvTqd*?0lOJZ7$-9%1C3} zv{2c6O0rI_-!*5!um44#xHQI?=BB&l328K;+EFLaEA5?Trj(S=NZj5)=pZby&K%hq z-9aK3FOf&%YO?004TdS~hP0{~nP)DiZL5b%B$`^c-MbU3E)QptRMv(R#3Ejl&eGg- zOb60X7*rlixSk?ZjLL>PM4!6)6>*q_=D9n0>G~)+0w&KkS`HhwF8~A_H#_6n!RYUD zLCP0?gcal`)6x@Qvs4&4BCyv6t$3k=*~M6AbHx8kUsldxzeg!I--!n*IuVZQe>3pA z3i4D<05*@NM0Rk{lZO<;bMiKZ$uR-X7x?3dJN`5xfW2aF9DF9EI(i9{fZGv08nVQQV8BL#-b*RjvWVfhS^KaVA)@QRce z@msD+#6uS70?>NI%Sw@AcHohm8Yn?7^fVc|bBG(Ki>IWk-YbaL&eTvIJACZpwX2GJ ziuGKZn**KOZ;;XVqDNvl(30idsSH932%0)bhpgE?1u}`4ELXOqnELa5iiX|zN41v@ zYAxagRow(^(z0zVM69C7OjkIwQCqnFvsALrGN_SDKB$82d(BHKIe7??a=-?D8Ze>~ zjGYcnHj$9<418fR#Ch>d|{aVS9vap_+h1*3&{P!D!zsjGcjUY&(o zH3+qHjM*0wX=$|FKAiG`3>?KZ~@#)vGjexbl@C z+$tO>Lr3vZ?ofkxhwIrW&e2jluT zU`C_xDvHJ)@N;I+pxf!*@_NmzIh%N@v@q1M0ip~w9)@ahXY;`m=kT_-wSyMP7=MDT zGaRyFyZzm+Wj~#;U)vO*yZvbn#>@QS<=9&%=3TK~;Pu{O(q=%hmicm|KXzZpsGzEI zDPfjh`n##0vEV?Wkp8b@e)9d=iDfZHGQUVImZ`|(+e9@p8ACc;S~YtUssP6CQtD!e zqI2#le4567W6>$#eY52ipV=~9w|Pl>smZ7@ukc5te zZBErKx>qdWv^yit`15`#x>YN@pSvbU1L~1`vs3Sg%s+Y=yx-`|+?lbl7-WATR-AKw zHj`Q@sgJdI3xphx51pq(GimObPU)OIB+Raxgl_ozg1*cu2DEW>fg+{5K(diFCMlIz zLpsn-6EPoOpl~A;HQ$Feyj@J>RPkF%4c+DPLX|kmM=5}NSYrq&j>uhkvRc(x?%a*F zCfT~uUQX^p_az%fhbtG8<$sKKCDIb2chTbDuK5EXE{?zJm6!_PzoY5{qzxJupatLt zG9`KongawmRj;Zy*F}e{eJBptklFPcU-nny6A|OyNOXq_$pG+|pu&K_3y9$o+#PS# z9er~RRAPCrtliAo=P~s(s}#p4kosf(nH#!ib0zEs8w464#q4oNr)T&iO;Aa*Xk$5H zOYw8F_@x|>L11of$@0*1j=LF%UMn52pzbGfXAi zGt&6-`R#XT2e<{0@5SR^PrRb@a4?m4$**{Kh$hreNFNdY8{!L-ifRyE8RSDF0TtWv~_(pzo*uQ3kY|M1+!l&=w{;mjxr-47U9q4`X`ck_iN#cA|%gc7lsd}-S^OO zOsJRO+%tY?7(1{q&83YSccM)=1wq}xPdm6V-7Bdbszs znC|;y?l&p^W~LraKVxc`o$zIRELRGI|0u(B$aF9|=2v{`N0iaTDT$XUBC|)>{5ys! zau_5ss4xnYD_5eQm)pytdSl-S<7lB14IT0QK9Y48UhEFP5YwJRBv^mHU)yx-*_8G}+&ZTLa zD7tWKl5gb(LwdvRVbU#wRr9(h)ioV{q15xx8PWZi>o{a1QXCQ?MgtOBKclN$pE2UK zg36^Hf8?{ndN)tNIYXQM`D8E`aytbXp#GoRdF)Qf1_Fy$1%c5;y@1$;ZG3{O`@bC; zpd^CF1-sjFg=#y1_=G~g-Rz=<3BVu=^)YeioFS4D{5VMv}JT~w9_&L5!GD}4k ziXdFAO3pov)S=Cf6=UWW@;V)-eqsDkK0H>EyC?hb*p9?fVub`ohQGyAj%tzI&|_<%&s{nc88m@< zu_QKemRPE+aKGuHbVt*k8|*v=-D3xF&{VWZQx9uG#W4hIi{XVLUyaEQ$Z5t^RO2;l zM5|GTg?G(U$t7fL9aICzJk4|Ul!Rcs&zfl{D9(7`IvkGWkDV@hsy4rUqSgc9kb>1A zXoT0F+g31XrqL!bMqKAPwZ@3&W%$x1Jk!b!BFg9tvu=v$IR+U4a}{rP4d;bs-1(B) z!M+hQyAcOPgW!P5p*qjg6!g5T!T`{jC052o?LY)p$GjkU^$*; zr^%XJVyIqA_4D(E%(%LUIIyae(|>JK|Fkd-Fz7*5?M^){B0ZZaeNFF2-EvnRQQG?I zdf@>>yh>>ZKpt933fmRbi#> z!rJ(26*C=zIa=+ToSICV?5AKCTkSQ&En$VJt!z zeZz9j^B#!^1>#KFWK+O8@iC<8g1luCu4VGw)G~BhEl+O~1}euGH>X;pi^`HFOC@ZA zShAc;YW9snWzmQ!x8^d}to3%r&JA0D$!#x7w?eU1uSdyos4 zX_&S$A|%f*yQ0}mk}_){WF_0u0f0KUP;@H3p<4x1O7Bf4!`gGu#=WlfMebiJd)SmO z_w(^$+2wQz_5G28+a(4geVI-i!N=WjJ1TK>TTLC8l5;TxfiK-9A$^kIT02!XvHDW+<<67s%zc%^>j^0uEu_QK6WlLG}dd30V(gvK@*PUOq~ zSDkG(9%%%qy203Mv6K-Da~)%ds-z?8)#o31FNuo%oGs@7qds4wzs9E~9d%h2{JbdW zu@6j#k*v*jHBFbkpmf?Zp&0OwDyi$U-Rz)6o`VS4VRN>^9eCyu+Fj!iD*}!mQ@f=a zM{EP|nfOK6$&MLHcD#MFBcp!#*m%%S^gRw*Pbg^rLY;57I1feu zkHnDm74Sx7R{Ba&(({g91KXY-#vaf+wJ!)eTJiqx0T7&5vM-d0SBgIlxY*Xs6#~5P zE70unfyd@V=ddXB^>^E3qH*vxOcxrsy1w{X)KO^0X~+U4&JOX|&-qcCOHP}}rV?MP zSn+G9hvq9h!&*wPL)fPFQE%?hbn(S=KfhOu^ro~jJ`V(!odqiP#d7s7xFi)Z zL6LhO!!@ASNHZh@sW8@D9<}xFPl3UK>{`HHUaQ!;F8hysf57P!2|%Bee~SF^_Vi{> zw(Rorb|15zjx2&gw3{Hnf4XJ-SL_W27AE%pJ@%W@(6rtBAJZ4T7jEefLW+yRnSq~C zTrPF^70K|keioRqNORDnnF&c0&dbUTd*NW-aN-Dgy?FwDJV`hgSIUj&$!vr!+W+u3 z&|!a04Vtt&+q67iqG{1dK&V&u@7?<@{UH>@I$E`U;=f!quRqGQj|D;_do+#}#xK7F z8xBb?CT1q!Qhc<N_l!Zr1gm!zS4kBf&L#qk`N%FH>5Q&^p$hjCF6)6SXvu z%0=g5?lUK6$VaV0-;w)?O*Y!#Lc~c~tLCmSY8w2Toj;6zZ&O{%#`br0Sne z=tt>SJ=vr=X7tU6MTv*%m?^XUpW1Duhf6&-cHb!hE0Syd0)!v>j#j?b~oF;^a6}(*5 zwyRPhFWB>GxM{bw=?V;?>FWoLE(U-5kM+_EZosA;t`^SFteMs}9*aI#f@In{(5Fvi zRgp8S>7IcZ#83$GnHlAykgGP6CO&+s>1ZvZ{e_j6c8?c~R;Qpnb%{&>hVe6_JP|Jo zH3}!!kU^Pd4~%kcP}ZT3fg(ycx(#{%e0#sa?15K>lu-E0m_CZrvnbh7Z-BP*{p@ z4dOD-9tgL-$)t;Tp5W3Gh5T~H+i%BpiH&MyXF(t%7o4eCdAAmy^ENMdMwTnD>Bf$J znu%+YP4*Snz8zOzDPknFwnU*MhYCW((BJKSaEi|NEBhbimafEC4(y2qJfcfD{H}{N z;bYk}7N`iDYTqzLn*>1eE^VUg`v^t$s#dBlK>gyEpi1HjjwwzH9cxy{Q+lX2muA7c z#{Ex8tw^_K!o`!IRUojlI)vsJ%E31ls~_E$wtPYsL(0Y#|c{kQ$ z(-25RM`bSQcMbqzU%W$6H8OGCCvN&n@i~_-cnb%3$P~}&fbgzM&QjeN87pO0b~(t= z;um6o?h2^-Khk#xeL5d+J=#M-v)aGhWWkh46S~}iXiP|&dSJ)h5!O@2_kpPF%7+-y!K%(K%m;oIP+(Q_AxX*(x$S&TjUv2bA>`^nlDd)`)J zBA9W9vr0rzFpYki?hP1(zxF1pYFh#OciWaDJJ+@G7)c~AXcitQgc+LCnbSa_2+$bJ zDjY~CmZ;vHJThVUDPlw^MCkNMP-==#+`*p;gwCVFuFnTHiJGa@k6qgEUcE;#)N*ew zBNOGkf*+?=vpK6_3boXn3)_8_*^Ro~?lUEcvr!(QG{+NpAm4}EV?8@XPE)Zz69e%5 z3fgsdfgFX4GPC^$%U0jT;lgInpk}-fE%v&$Ug~vKtRBsUBRT1s(}>~#?bPiFeyg0 zr1>n0ge%*r*}|#Q)=5D60k83>I127b=Y|1LY(9YNt+QQ2etSVA6BlknSQprS(K`1skr&f`a!<`T#)+?>+f&*JFwewhK^BJTc;k>02R4u#`Wm2(ZLp!Rr zH|FxDmVYbzDR2Y;Xk;c~xnRCk^gpcc4na^MK$n#1lt8*M(1G%~$QXa;C?jj!wtA$0 z0|)E`pW)+mTUNnvHm{1RMo<>}ErHzp@exBN<Ka+;5;FILbuJwHC4{opM^p>miUc zVP>V+g2MQBc!9%87H8nTr%L5wEyi4Lt8I1s>qSfyRCZ6$1{3HtR}5 z)45O-q=4e2zznn#n}$IM=#Zt%Wpyh8kyGCutrdx=O4b1ylBPeEUKWx4i>6qf2Bvhv zjyv1!2Utl~D>V#(>Bz+yMx_BzdYY_^x=q*-dQO}a!YJ5n^}IIkUKA%Y%&W`^W9@M( z@KYY(Raz35!j$o%M-tRa4%+1rrL&zZ9NF__*VZ2JdAtfJjJEp5u}qfw&=*^49p1K_%c`w8U9ykDLZ0g%Otwqo?od3752AZaq@M zk22&4D4%9$oE+$=g&FNFhxh&-IEjWB}F{1df zdj^$er-14wVMHvzsT#IbWg|y5SGTKbU;uf+l*66kOyNW0GUtLNvg&(VRF07iO4(I$ z(J59&MpLx)&=1$da}@&euVX`9<~kRHrzr#41W`pFcIJ{{d&t!AqP? z*}112+~^pGkOy6GJKk;3QPP2jrbMaZ1Ee zM~o{Y39}F8-}zh&U`4e^A;r0JL3x-jB^E0q*VN{o7t807`^aik*(D4H<}QF$+BXI$ zGT5&F8DY5N$i>rUt=1Kc4+n#;P1P^Bm|=s+F_y2jhN}>u8n26qTa{b5S)yvb9QS!S zUMgl8md2oT5!9)sCjwqXKSNkpW)7j21w={tuaL2=f8XW9ON%$SoN3i!c4i` zDfA-CXW#e?U= zQeIjeK@$x!(&J>U@5p6wK9lL&wbFLLJJ<8;p0m}6!d zx(lC13GMS}-JaRqnXaupk1v_M{$^E*+&-MViGV-sT`GZqc^tN127kLUA z*m}wnv4h4VlI3q4x+soi@d-4c<^5r)6}+ym{W&$D3NbF*D!?3?2;oEqu|wb>W~zlG z0y@uGlUO$6JC5@|MXs(~}VBN^;no?0x%HOq_oxW+E1fz{p zjKEEeDu-s)9mlP;4{v$j9X9T{xqpt@Cl5Mzg`0R)y>6vxjTWnA!kC5;ND--5+Qpm! z0t1$2$C*1b6*PFxJ}APSG~i8IWSUEx5XSd8?(;#)^%+2Wj3OY8_I5dw2>fcMjB1$A zIpX_!s!i}^YGbQgutv8g5P1w~K#H?q*ZrBCbI!#gECU5C165Ha=bh5>pHrhCgmN}X z2+LRl9Rdas{mURg8>#$__U|!fW_>ns1CKSD1#dylH!(?u9r>ifIZ?v_=Jhvtyx|uE zOeJbXtJT?T>yP_LYt8jd&_=4e5UU>1y}PkGDI%ovLFLmRkfD!eN&ea?3Xob*>3>lk zSfri_j9Xw2wv7g1MB2TvKqO_v7{D?V=({Xq09W}xWPQ~?Tmr^0V11ZA7{p=3L-~Va zW!NqNP7Bq+0+-G}S&9>9-Dd$AnR}-cQJ^eYllZ8!WjptythO>KNtU@>L6AXs1d!!F z8B9b`VfI#f;3K9q7`jVjw%D$b_llhyVH9x|+WdLeDJDu;LIVg6W7w_-ljkgmD3gMF z7yh&ss%U2$@C}!XsFY^u&ap~tzSo11G9fVoz|zbGYXFIZ?*uha5M;`?&hi6MypEJM z27Gwh?QP&5C?}vvOEmwT>1}0z{cYcI0-$ZC6Us9U!O@y=S^oR$QQ$WRPOMod|+ zo+tzsNK*KxEwQ?Q`qXQM|MlK#QKkB|A1iNvT97Yjw?No7E!@IwGh^C1ywM0H$Ral# z?Y>WkBsWEV0D)@!fTo=E)PnIB&~P7NGWwQw;!k&QZZx$op%Il%i0SeuVJNZdYQ)T$2fb*wU{(K6TOCNoG*pv}fcu-6rZ)8jrMZBpJqQ*HQb|nP>jrl#d+R=Ce|}kw zRng{qbtg8$l8}aIAJI(MkR08vnP!qNiF>P$J(gWKhN6hWk~z1g4>?=biMg|+tR1#- zFWESv{mzp`ymihfW6A+r%9|lMZj!5XRdjap(Dt`$ZvPM;^A1MByeA)o#+)zHAygeD zfL>0>s?(&M&#Jm=-og$Y8m~oY0R?@&$I6D%vgh^n5eKszW=Di%Ku&n-H z3&xj!cS+*Ioa4R5T9gONm-Ivr`svs0ZTEknJ2phUtk(S? zOx4wtfh0agN@b$8amDGv*E%G($a$mZ3pjgw`xBxyPaU%@$-79 zVP=iqEJuivh>8|9AIFqd0L0KKm&{;z7})Bi#y_C?`$0dL=H~PkQ3w9CBjffB)wGvG z%doPjyCq}vvL=9b(o^InO_@B}`b9a5@D4m{$Wr9pM54DFa2M);hge9NUX3aB)mpXR zvw)bfmXD?N%Q>Ao5vAjdBL-_?q*Y~YT? z>FeSaKU?IDFA8fj7@Goowv`0z3mpp@-{5Bj7lQ4k>i8~b#=x_{AY<#k?T= z)s;?sCjJIl$X=|@1DhYdT9WZ+#deQ9kV@_R&Tu_5A}Eq*wZ8GTS|^sxJ7xo>*eSx6xGUV=F{!z8; zZ=nYLj(Gf5`N|jFMIHAc_YxHUxO=L^A1n*|I+3N*vdrgQ&x>>?4Cad%GB8;41%hz=UqBRc~Oy#Iq?~ zC%?c~KH9e6yFtwpNdaFep!v;TFx8b|7yv4poRoOGGUikVlWiF7$@Z5oyHPH(wm1Oa(b7lEecpa_N>38|9Ao;h;?4OsyW zI_CuF5e$7qf=u66?=B8k*)cwir*$0uqxAc$aZ_!TlLfc%%}&EM|4j;^1ZaT-f{s2z zE#$5(Y9VKAW$XFMX|NU5${{jZYA#c_aFbe9NR(L3Oz``F51h8QvBgicLJVU>^Tn55 z&83qDHW~n#nV3sd7VVdw4||<1$Nnp z=scF7q(L21batf?rweEfMAB51L&oFaNq$Kin&nG3myg838; zrZmcEzT0U##`^XOSu$emgzO{&6u^%ys^4U1kdjd6N#)ANSUm!S&(q=f?0~ipDGnDY zmbX7e^JyyxBC|0hLAi|z0qJ?IuAxV5<8fl%JoxVe41H@OvYdfH+t6|X-qKF$FM_?z z1eq?R_(MPw*D6hzttUJdp!a`PBkr4Ry;0+^1?mSGRk&N!XXe3;$#NykkUW)Lub7eQx!?+IRLd3uE!tg_UfGPjYPcB;NIp;u)|x5sFr70L2{mYgtQyb1 z$2f475{xe6F&^#$$coeSn=Ec(15h(Ream<+?73k&k*9$+_4xlvF;}BLD@Ox|-_$SdPr+CnkgH&Cq^%E*jV{>Q?z3i~CWIw1&9Tk^=-CC| zkrPfjGlr?^ySBJaZ!*;FSXYE+*#uQ><*z|v-S9b$4ot7OVnXz|L$`%zbgQZX-6VT2M9{{Db2Q9*zdV1v~ z=CaBp6s627%ZYKKQ8Cuw9|WBV4?5I}69n^Sa+H0IBDWQ~Dbza30eg!Of>RmTNa0`i zcX|;qj~&3JV(FUOhSLbNH)Vh7Hpt=70oQMmoCrAs}nnf`sSiH#Y&T|$t(&~BkjnWjuqh@KPX z%CTQJ>a0Cj#E>IRwhU>;9>OOt>;3dT#*zcZU;+y!LR~PZkWBw0eacN4*ES_%@u^Vx zS~B+hu$Zt}sSB+sQtFTnM=Wkm?Xk03Vu+-@8fdnJaePL&Z6b8j7A7s+^Sqx<&9^4r zdoP{5G!P6#i{eh3;B(v}<_G&W1VGJW47)?4Q=r$=t(W;$T|;`_@L{p*UC4z2+$QhV z8&yO(O4xAoxOlgQs6zAIT!#xIGMR6WE%3Jd^h{>PWb(w3|7q4l)9n5H@=)poI;{1H z-0g{XdWnkgc_?PyCg%5ODroWRgWw!dtuYIGwU7NFHl6X}Uc=gV-lnAmAX&Ho#{@~7lLKfy#t)9<~d36P-{qFOY?PD|n9t&|kB zqBm<@Sxb!xhaRZdC^5jKqVMJNhg}tOf*HN<58tdEnM<)Iao;xj$-Mbw-6s0KXlW?0 z8ki!U=HmSU(vhbUQqZ65XW1}F^1}Mi%&(ddV3dCo&&1tt0mZXpS;5}D1>7neBBh{W zcICqZ7LyiUp3y2C3kR+}>azU02A;!vZ_#uI1WsB>eQ=dH zQ|JBSh+(?)L|cOtyLE8#mfV+xS11 zSiiUR^xI%tO`m;t_S$#rwvMAtH@y6HS*7h72WHE>~;H zsXzX*w9v>#GKB8ELwY*`GF2pxZwm)%Y_&T~jgZ0fE*<~Xw~Cy$7;HyhRAtv)@s@pR zmzi(&mzGT%6_7WyZ2O=4ByY2>Q~-j3z?K8Kn5%Xy}Tpvv+H zezHPJ$4D1&%%en;T6*8)h1xh2=&2FV5V99Q%4dFnQV2A2IK?QS;$6aqe`T$%t(C%W zt5UW@x>D6ishsDcSGYL!g|efYVDT*SUNC0--A$b{(BLptIeb3Hf=yJw1!14vL+xdE zu2_u}wjGF<$xR79AB+^Qg>??H`e=L=e~^Uv+3n$ghB9TSAb%uhqrBd%XpTKw?O&!D zvKVeA?660Z;(5GTJuJ=eW>}@odTBh7dGS7Az}MH4b;|Bd5*_FhG8=CZh8e_Ea5%|S zY6yVyjc72vB8bdsfQdNEwE|pzW(vprJs`*aLhkhmtkD4*5MH*ML+n;bl4eI0J6v6z zZAR7VF&|e?in7DSTTcIxB!a_P;cs>aeD}J_EH;*^gHnnlT`^NFd|P3# zA`@&vdR<`v0BlW?7+P2)hrE!HRMD}ponsiE`x?dtgr?Yo&ZZ+H42%2zXrBW|fWPHp z__ina;$+gdm$IvO(;$0{G5xxCQ*U12mJgjQ4z@raBcmmMjIlbvv*e`QVvm%Fdiep zQJ92zjy0d3#e!n;iNvE@=Y$9t4J;dsenY2q$2A~7Ez=t+0<%1e`^9iJ97-$&j(lLj z63*nVv?{wm>L1UPTCn|)BcEGwd}h+YYsM4vsSG9GU@ham`C!(Q355bEqD-?a7e2w8 zAsvU&3aDvgNcVl3kmkT@Zy7J?6feG#aMp$}!QQ9qK zFA`*bh;K`LI3cI34Dfyc)A!}X!l*QNh8j1o&f1PdXYouA;vK39PUSg*nyX3y+;90s z!ZQ3*A6kY&m8WzzrZwHog-iDkbT%mC@OEh6OF8!hOp0!$H-RGLea}s~QA>03=bhrz zD8*l-ji5Or(7txG(|5s@)X(#$*(yzU@|)J>d%U$iBfirs z3n6)0h(kde9krz*U`9=%ng8TsR3=_w&F}K@RDXNYK?5Forf4JpEdgUi-_PqzaxsbQ zdiA@x*@K@@9SWdGZv;C;MWU*nq=H=VdbF-JY6tb(Ex1^Tq%H1wm9gUrZLc00y)jnfnazcIuSdrt(u(a(H;Q|Qu}vFiqOzsd~7m=(``s%xKg4msI-^xy9Ig+ z6+lq_?451M1Qh}EgV42==4+t0NfuI+Q|H2P3$CHMVY^LU9HfTF#FQ_#aonp(j0;>& zG1PclMW`zYq#=6I(ktimH|Hp9Ox9D^fNY~9YzScd5hH*u8ZbC#1MoNz)bHkj>F#U< z(L68`J01SrGk<08!{xN+1LwWU{bRGpUr8Ht(}ap{K*4O#Tz(vss^2T5ZRJaM%eI^N z)#M8GQ{CrtMLCa9m9PVNP3Ns7-CF04Es}z_QjKdPqHHFc#H^*ncPVF66C5jn>c*X~ zuk{&G1Fg4rV+_DohY85xsCCyt<5|><)AR7rC6J))FB!))dl8V*j*S}o@jERTRvB$w zcZb!kiu^3i>B4|Y`!migQjRMi%Ybj=Rx^3yBkwM01M#?^ctDQ#P!Hq~0k3Obu&Mh~ zJ#UV~mT41WwcGNU@u0wVReCq=!p^o>8gPdaVigPGI9?Atx$`mV@OAHnER=NIq-?M|_aO@z8dPMp?BLGeM7;uz6qL4Wzta|k$D4`fARAQ~l&)LgVw?QN zvOb*AIHjP&%x8#xNqzSfGLAZscfTO_N^R>Cy7Lk-b;9dQ_U|Y%Pr;!GLnf;|{OEJZ z(6|N3mON;K&DW=J)vnokef)p9Q+u<^wRit0^N)^fYHyT9a6%=7g|uQ{fV~djjZsCg zIBS9o!o4enQ9-y*D+!P&?2pK5f0OtR7N{af$`Plkf;rUk49R|ENffM=2b2cc&Z!8( zF>e+dLV`y!geGi5JP%zpHW$GLnbN*a9L0$+U;HL~GDjR-iSOkm7Y`Sh6?0XZ+f5$$ z%612_Dco__cBceB`B2JQ{Jnf0+rR*NXB?TMZ?~;2WdhFt`iF+QFGEMIe-onvaWE>U z;rIDy{%QPswIlVE9A(A1KELjtsG{$^3!ZU=WZ;Uv;7vRD$gILJg^0gDpQ1OX$v;?W zC!V26&^nj2wUewdWG-IC01_m8WzTPF{oPC>oenbc5fnf{o{4> z?5Dc}^IeVR0B}aq(y%~v+)1vkDNp?R*Ei`jhE7KU2AwRIP)LRMbA4Z#2dZlFp-Db@ zKn{GM&_$5|p)6V+21PS0iqaf7)HqZ80Z4n$*da(f>ks*1NRri{a##&< zASJw-fU}8FjO&BpfkNNw47A(GUvn~fF-YzU)Hn$3Ux?Y<7$k(J=eOcvhzE}x05hP* z2gkr@pb$Cm2>WfoVeRbQ!xAF#G3{u&h$T8B)*U&w0D`6r^9?+UqfwX-N|afIg`CKz zt4xFk7K6c`j*^LZMZJK8$nO)#*(u1G=%UHl`vN+N+2~VwbpMirbX|DAoqG>$b?`l& zZj#X?gx9P-52dJqr`7Mhw-4g(<706etD~%yg)hYPIlcD%WLk2bOjg~56~8Wl0g1-!5Lekn_OY@K>u9=`*(lobP5Lcq+7ss1yef@dZ_bn zS4hLh)}J0oSJze3Rki6^^2*|RFNgm7JNyR-cLqY^KZ)c23KPM^!Tf)^Ki672$y@&m zNj~QdaiRgyCmHbgH{bj$vv}TIVSjP1;n}a45)VmwA@NI5d5yoN<9jUtc9rtB{FvvA zmkc7P*SPwAZiA-1`Comk^c&10+N165(err<`wiw{&a5AJbs1ODcdz_w}uW z*IJ}e6N(J?>D3meENsbtkjfXy@zeNsfBO+~62CIC>K9M5)cRaXnTar3?z*;t#-z-b z=f>TwU^Ai-riD~_2vV4yG*Pcn=DHA3%A;5HF7a_Boj+O-_-%^Ef)P!rP9L6irnA<; zPob(Ode^o+U!V;YO6~Q3uuxHb=(GxhbL;acI>h8F;%Kv`MZV=^3Ck{Lsf^f|nb_zEo3CNkC zfx!0N)~C@BklAt^Z@79I$(;4w+KzX3hjg)(BnBg-m|u35HWQ*qdS9gZoeb@@dYIjv zIw|kEm-Lu}#6LQlYTg~{dt8jMxvpIGPe2`&nRU2Be}n(1$&3X$K_?^yN*I_Ni6V$; zK^r7IUfxyN!rFfQtY!CSj0U+VU^0?KN6Kn)e;OUQumEF7g9DKVmG7&8!N1Jb!Dov; zwhAFPyCnu@8xCm_jMj!c5Xur;(@WdA(_{n5W;I>5i}bfl3b z>ZZOA$%w?aLQ2&nqVX!m@i;V?Yc!NEa(J680(MzBSDSskw|hJ-xBJIR!~6c7!V3r= zdSPIpx%pAN**faXXv5`Kj2H7LwuVJA(T$kaLWr~(YbCzn4Y2wLbcJ@XDF*D&q#kW? zK?xZF;ZGSF+cOcx#q1wXOeVMhW;9*nZ2dx}SG-5d6c|{d|Mpm+_5wYC@+H!^q+1;? zXOtq#?Pwr^-83Kb-NP##7;14N+-DeX<6?#X;T*`CZ{zO5HVpTCwZ|Mvu$S~!L?s;Q z#1u`HC0t=5Mz&>VE2c2qPfn+;jheBItQAnI<&cq>Mgr^FxpP}Z-@sLb#Ng2sX^5*v zGGg5JakO9Vc%8!p%c-z_e=i;0k{esP_XH+R=VsqU+v;|OZD?i*mpsJgf`hI2&CB~$ zyQbJ@_13T-Q2wGrhoxjt64u5hZ8v4*|LhwcWV&g0Y^iZ7z47+8F>;qb_QzPiF1eBR zkl|!@8SPaUQN#Uk_UygE^+eUau1t`tr_-*1ZMX}#1egcjW!_DVlQ6;V044%Lr^B3O zUK7I7Llr@h=KKr9?d4#Bt58#I_?h47g^)~fLMpQvMi}tOp>UP(-babVLNpc&z5~_6 zeOM^>>Vt%wSr{=~ojZ?j60uV2Kv9o!nYJiV2nM^)#YEL6??|$= zxNdnEf`MWw2GLuY2e^MLBXSQ;(bZPb_U?P`M%)_eM#PD$KUMa0fEW!>pD>pWosU<* zG$egjuxJ$l2u%^-9YuWW9gy9U2QsgXw`IJ`1Bm{0?7}^R#F+M}h$M&+S7(pV`uROS zFBiudQ6KIul3c@^L{&G+WE)ClZt#(XKXC8Fc4kfP5ey*3^2Q{)p~&w2E8?y}-#*fr z8Cjxv-`FTkFO;PwGA1N57)Vo9)w5!P3HP?`rHWxYseTM!fm3q2lpRzvm3Amc}dXHTPy z5sJMNcCeUN5i(^(A=rbvfDoTRi6Sl|QJIQ;y3KdZwv6-8M@mO*h(`hJwq?wA%?##i zJ{y^1EgYj5o@R|SKM2Ti<voGMGU@?2 z0N*^px*2ZLR&RHL67lUvKXHv)DG0{o9t=nVLa(bb4FDtZI}IzS1)*Z{Kik(}WG_-~ z^>;43N2ssQM3YL&!aCRcPV>O@atoPPf&yyZp9#F5J$q!!QLhHDO>SLEz~RIADo}Ex zM>A-;34$WTIh2sOc$C{yXm_i?9H@Y&S&OmA+wP`-pH|Hq$RY1r^;g(l2kX*q=Pzt^ zgWyeKHUkDLO;j%_x-}}>BJ?r`U^7w$nBn|mtZO!5GL$j7ur6s6JPP2w!;SkOQ~(D{ zhAa?{WYa-9-iPp&T+SNuE;<+bD2^4c`#4+veqFrT74(Oo3xEXNaQe3lHB7HD&;c4V zMl|q_C~atZzMNvVA+p(JbbZwV2;xj|78O7Sl|LQpsOAv}GK7bYIiEwR;wZ|6@3AFhWa9S&1xUA^qwD2SB%glaM#=_cq8rhX=@cD@0QVMDYC zy&+z?O!EQo>ZJt;#V8sZoHi64gKR3aSU+)V2Z-sTIc-1BGbK)bjBJF)lz4QcW9G;6 zc$9Z0Xk>%ld3&V<-!7N?!{f1lvW?1s?l-s+9$6~7KJ8I|{V}%Y@Bebz_f0sCKTIL$ zu+PihCm}{5?6VGjd3ayE{I8XrW5UwjVG<+9WWz=bw4n^`W4HPrmpZ@V|=nWFNAH_MoV zPl~9?=4!ef=WtqW&)_N&qltz`J5LihZNS870+WfGQzG90b;;`TkzfFis2T3rd@xOF zX6>hZ4@iTh5^Q(QFhE^kH5atm zia!t^v4xAGRZkXV*wCCD50L8d99d3C@}8m-C$>R2V{~{ohYQ|@%jraZ6Ei^CGfgkk zT|;r5wB92(JX;EX>uG~GPUVRaphxnVVSia)9Ud)(jyJHAT%?4Y#l*!yRG^OzV+MvU zSk)6*OKA@15_0{&YWg1E4mM3;0f2xA!!5DR3^77JD#b_Eo43#$dXH)jRe|me8K66V zo%cUuq;kRSk8P%46{1V22vcf%7bid-?=lc?IMpz~MUqIYZ<^9vD7YYPsxHng==*S8 zh5YtG(*8uTvM0k(UWTtUSV8<_$P4bdw%dkt##{cU@VbAUil}?$u2U*_eOwNkZ|Vu$ zgV*(&%FDw#bog#o8BXR}CV1``O86rIpzGQQbxUCUZ%%YxACmLAa~PwLDGqscLR@Wg z*z=h5z4xO=V=p`CeQ|NC9wPbA=B(9)9^QI)eMQDGC?{lQ1Kt=I0H5VrT$JZihO8ID~Ps>wS~y42F#lYq9=`&jK{;Z$msA zn{ItLg36Q+OT-;C>Sf+P9{?AzJ+DFTpAD$>)%3k100$(vf0w>BF}3BsMm^<-gNz=D z@#*%V2cx&ZQzpvoHj~{souL?X@%xQpxvJ>wcs)U0Q6r+&}zG!<^9xh652nV{nmEEamVORb~-vb4wG@#y6ESN zd!I$A7?bzY1G$uyIHX3~o14zTt*s2Qf9Mw@882xltdhgDwpNTB#ZP)M?@!GL+yGuf zE_Rl(DnjjeWzU4P%LiS8GM>Svj4W~3WXVfU6Rr;|l1xlGpwZH4XeJ5RIAm>%Z6u?z zznoxF66uF#GA4t#4e-nxLwO9$Q1U~lM|-dm7gUw(6(z2oV^b>BiKPs)W(|aI*U$r}=i{;|k_DTz+Z7d^zHTscqv5r`A*s>dG^a=0*{L=Oq{za24p)llt5}M( z(86Bsg-!{u+f|BMsai7=P8B}zVS^tC?Xk%3Z8`x^f`11^-(QM_!{Zk0;47*GIE z!KsDHIXJlYja>(elNOQ~L>rLGVn|M*V=B%FY&)FGcSS&JvBR3KUR6;nG)F_{50F>k z##%rdtn#i`l9~eNDJp}RW#iG+zXcKs_Tt`910mjt zLRX5h32p>?4FQiJmcKomyL!JLRy)1se)M~_wC|J<61q@f4Dt78P|%WtoPI7RgIcjO z52JeQt34Vu;)kwzOIEiovpY6H$anlMdm^3MidKshLNY9SxVOA+C2Q2XN~n#vp3~Sw zm7@0N$e}XG5MY4pj(Q6Uv;ZHzgb#Rc^G$yuYR?!p}v(L1!+P@%$Gr(_)5uoH&&7 zcZBk6Yb#2HB%`9Hp5Mmj+WB@Frz43LwhpBlC}y#GDD;9#CLLPT)AWsg+at>2N=|U#5{7$=s`{ggy>`y9T+O1m?KZsSVPBVI`&jgi{2htKHWIGJ#tEP z|FDFgc!zHB{Sg{GFI4#BI=5QyrLvfCeS*w$W{klfZXKlJ!w$XY-NeR+MHeA-h5AtZ)04HMRX0|i25aN-V|2a|UrnH=%GZ@qDUMc;hotV@ISovkYG z2}fs*<69xu2U8t4;vE-GjxXdldSaJ!2!aQNzo4}j*6%3pdV|v8^~UH&ps*OPSyFR)WUb~V zl-h5ZS0P^#`{sazfn7YbQe<8P?KaKdXIU#(W2vX4W(=Ck=k8l*$)xmCz+QYI4^dS2 zQ&4sl=~HRNVU32h-_{uY{`$eThfd)IuZvqKF7wZ?AGUN z4x}~|Dfaht2MxoXg8Uyo5X}D_m*W42@tV=lcK+WDT!ZUy1K>(21W9~gpfjiE9L6{$p1jtu> z@ME@DKfG=~av;1WB03L-J~$6NhY6@u@P`%tLHt#(wQM&uNlM}S85$+2Q1x&xvc~!~ zee<83A4-KF=1-1ReUnAEUO#eq^;nZMhS^{VRGQPtS)GtI*{+o@8YvN^&ashr*{{Kt zm)wCcs9QQ+aoDA)7R?3grNxK&D}5Wb%!M$w!lSCimzG#n854g=BQqRHMR&C`M zRb}xt@7E<$e97zQNOI=e-fU4GHPP33lnMV~6g_GZ8PbV9;}CfM9{#Gw<6QAR(RL;S zV5e*0A{xnc&>MU0y~UxL5l)E8?VulJ98qM&oLjmcD1G{D-=57x6nY-6kAjINm_kxm zF>U_eeEwn5+ARl|bIhF>K6Hgf;*fGZO%VXPOhXPNU||W-=lo-7wqbo3)+d4I`jxj= z--S6796WY#9hB_N`&#FY>x!&woqske6N{~Wsu!|voi_Pch>=lrstOXU4y(3?atPT3CQ=#5X7#4Hl!HqFjLqjb-LtEHNpnQkBv8a-3sdCniBmvZfj%T7nF zl~U&(=r$`XwY6Z@>A+DtMXx2U!>`WU?X}*oYXN7SpwZU$LBA#SuGmXP-HM6fQA^-~ zLz}2XgA!}69rdSJ@N-fRy+a<&{NwBQ0OD6$wjHBUGexM3tT`t{HkJyTR&MTr<=h)Y z9np(^)%;>r@dq_CL}yjCQabq8H);t{9yo4jyqr$!>})mrwo+I9_3|=Nn5Tq&*=uJH zpZK=<<413Icga3J00%-%v{N`h)tx7?ItB-%=2mn3aeqrLf|De-f#YkuUD~LaiF@e! z{G^Up<;_q45n5|%i*wlGD=m2C=iFY$nMp!L6UHfkc5;d4ePu^9E1#pkl|aGL0qCLe z$uyj)G{Ibi*e>?wknphIXQ*f}P#n%x(r0l4Yj{0M^*Kp5m-ZEnf(-=RXG8kQB|0Y^;6nHi6^H#5ll)(HIF@sGWYB zX*85P-c(Zt?OV5EYLDTh{~*N}(Hw)%>J7pzl$d;i3nf6IQ`h_aLhBF;S_-~xU7N@d z*8O5SdN;HFQX7Y*)}T0OdKINr{JUi#Se?|7l%E!`a|eX z?L{IS>OjUpOmI(fOVZNEQJiW=(!sKymE?J;akUmbOMqI)Mxd}yjMU|qBk z2N`VYv1`)?3&kGoA`BMFk}4=lPbER1G8~OSTe8p-o)YKOl3|B7(yW-AC&=}d=N+d3 zl<+khg24h&IC74X1Bp7-x=^|i5oMfi_CD3?h%+aFQ9cNvWnsuW2K%wxS)7S$sEDH! z0tX)g2%Ibg(ab>;NTN~B6r>xv0%JmwRd1%%dPOfxlqIULFc!^Yj7xdT@ zi|HPKV$X7igxn;0Zm$s~NU!l6U&xrvP6=5hys;+ zm6BPU$$Ez^^FHcM_jp>PzWGb`cyal%1=p7_xRXPn0Riyj9S&n-IG`2y8#(4M_1brY z)dcI`EehlF;i3#2pUgUJX3%9IsV_V}P@V0-8@^yPIu4D9!j>~7q;c_<%0M+({tyAR zdZQ67CRX5*7z|-6XQxdA_rt*1e+$4RI{vl(e#wt_P!wyoM;x$@aPVUeAk%pT&CD zw7QUmKM&>s^4=r}3{YX?yg1R|5SwoUt)tS@$vX|U&q)875^+QFuJh40lNp^Df|Vq` z&C)P3anf1JYq-Z-0Iv&*eR?@RNI>mMH?K_4fz#i|lozt>*~GS5NA``I=o-=v+y!g8 zZtwv?eKh(zlc4ZGIyO9#XOa(HwwigIFg3{fts&kUp&EoNn`L4Y0n6=X1;z zqsCnjY|ziYu04RvmWRgwB$xg>WWfLVn^vY!VNhWJ5E2G;CMIA~keF44I06D-F$W3! zPY?L7R%w}7nf_1xuSavr?r*Lnhj+bJQZqq8?d>*z*0dB`5$NY(=DYdr&F&$+FB*0(bB1zIZ#jy;;o!Nb|F^QU8)y};WVPou+_FHXC znw3qrYe%xEv66RQz`W0;%-Q+TzSI>pxe}q-u6N`7_t5l`7DJx?h=0*>^qQbO8v1j0 zxaL*m+1fW(@^Ct}5M$BEr7(J3ZRbgs=v!1}U;4KkcX+n-E>KC7!}5B#AL}A~RLFE4Y-G zB*qA8vz$yF;bdM6yPf?qxe#ZsPV%NKH#B)QyXuCD-MY^F-iKV? z6aUIr-<&d?{ij3IEdzKl82*`Z`p7~aI2?6rh@FR?{My_!0hiAEmdO_9M+TYverrOQ zA;{r%dY9h#C<%NdlfuZO>7)r#q9UQF$E2+F2V;&t$s!XKODq=72EjV%(#EIKQUPRT z(ncTt?+R}yhUKX0^Kr#Sa-saUs*)ld$dvR$ZXTKprYkB{i`~uiY1y*!4LEseQJKP0 zR?V+9>f$s2r2Df2V-EH*#ncu3{>Q4$0F_B91tiTZPsx^<05!CkdVvhO)W${YtCc=L z0l7GV-eN_0g$@3RLCIpFM?AyM=U*Ev;B+r${9UBN|Hs%lH3 zqyllBIL`VCWDE&K{2}_?33a)4Ie9w(3e6lomO>NspF8e}_{5Vi0`T)B<#|WUi)KA-4Jx+fBy1woFQpNQoY1hj;iIHp&=5u_SMUAi zg1Bh3Xa?4*^z=#P1`LJ*qNKJa@F4N!mGC8_3Ik6@)G-oFgW|}UucuwCfNRLP9r1bk z0L-Cka;n2SY|xtI^>!~A=yK1@gYI)iWJIV|iiy&J;kYReoNMdbyTHkI|jEgc=8Xkg3TYw2^f*04q9rpM(!R zjD4R1yMQYjhYQ;V?F03M9{dPkkW)*Ow4_T&{p0C_VP#Cl%5`5?r^1`masI|Cyv+Wz z4Un4>W)Pr)4bpsVcMeF$ssFK_XBMYYs;W7Pk+(=Ph#rK}rFp8_iWKtv z2+4tSO-3u>@Q}=8OQ8Y-F{HBV_1;09nkYLZ*Owun&D5(-mA#cC`p1bxJNpHJUlE5V zw?dVJVx?ZM)QZFp4SgJ5Yu-#NQx32TLXJC#wgIg{k+H_k`dNGVZQLeO6R$9BD=d!M zu7IP>o8jxAoR!^eCSS4^xJrkC=EBdH+LNc^E9yjMLyh_@;Z?vYdCL%$MSdhJhj|lP zHG~Ll&Cr^KycU}XrH3=MdKIf`l2i(I5#w(b2~cu6Iy0Q=LR$hQM0*4Aag}uaT2?I`4G#VOWf+ zhHPt6-)O3pA^PWcuH#`zOT+3c=DZ$2|?Cx?N9xxNeL#XS5%H8WOyB7LK?Y#utw za&_e0?RTBy6_*(~o(_(1$^8DpXA)J+CFw^8a=@%669Gt0s+{38p60?MDDwc#1{YVO z@gy(^xV6*3pM`yi>%95*yv2=eU(2#f@}|-dJU;tH%dZYiPwKQ3vy!^T5N8nbb1#Ay zRD3&U-uR(4SI?#VZY@|JHfEJ4Pla}s+N2MQGTNH{>#|w!-bDax zoFt0kt1AfySl>|4>GVde(YZ`y!kc4^Gb91D?k+u!Hml1UrnW&CmcR1MQkWgfHSoj& zo))f#_`epIXyHZr4>(myyDFn9iaq&x)@9Sv*STTywuH4XFmjVO^aYrLQ9zWog~X*`z+L?IvL7N>nQx-x9`_D*<$H` zut*Z<5Aq7RU-5r9Baz19Hz7b1@2~TqhOZ)A3qzEEcPn}TCuP;iL3%t_*RvsezI-b{ z9qmT7SHwHb^^FpA!ffSWF>Hpn=_&l1s`c=?Ynd1G5-F#nA`!AHx<_M=w2*??KlmlV{V4u}Mr8S~K*>xj|GP=BtR)$L zID-1GAPK>z*k7jenV5yV83=3~K!E$UHy%h^-+8WJl2znY^6RTtO~fi1X)I3$F~UGe zr)uxN`?;2-&u$XDkH1a<^}9d))As(jeR6qw9%f)tN0`+a4m*!Mkg)IN?EcoS;PhGB z*=tMjSAr6ZelvQv>w6S_6W6$kVl$Zk{c_X)BdOPA)OdBnS?@~&e)i|0b=ytcwVofh z(oI^Gu|u`@CwHxz!N%5oXIR&5i$Jz*Gnx?S_sor)gto`mcG9>zoHd1_$GQ~;o!)h~ z*-cd}+7V)M24x@%S5boL#1uY0B4g$y8RQzy5xK%qvAM2a?cZc7)5!|C2En+f$7jK1 zBR52m%T|FGWtKAMib3g=R}c}6sYer@0GwUaeL2qey7PK?;|*XOf!6wo+mZom`9Yi> ztdl4#WDEH2=jrU`HTP{@gI)L*TOzTcg~xS|9lYyjy6a#ZW>gH2d4M#i<7}`0MVJ-z z4chSjl6Q0;{rOVMs5d&>b~&#~xCdyF=kqPkXJ>Po!yS4*6(%F)iA3a4fFaFomY0VX zQ`i8+p#==~Q9G$1F7CHWS$I~oRakl?QCIC~X~#2BynKqc-)Ns@$aqF<1^n`lOG}Jv z2k(eGT{j)V-y{v56OaNdN#@5UUB+>I+3q^fei+G$Q@UB(K?0TqK8sG~gu?ZwzetqC zbc^x^%~aoeI!PFTiw?fXu~wClkYdkxp-9hX)XLymFF#9MM~FL6{8aiwcpW9@SDCl_ zH+exISA~57GzK@&Q~1tUP!s~xP9e;77~P7JBpmX(SkaKGUCF+%cvTJ3!UhSE%uH5S z6dY*5#_q`kRbw*P9r?1`8wAi9ms~x|@G{SY=-k5>FE^laaZE?}2OPFwt*sv}JH z1jT>kmdymABgkZr(H9Fp6yo*H%+bqSv+RX|8p8Bf@~E0-6_&rOeM%TD`ih^%&0QD1Fw<7Vizp@vs~z>>l~=N9%4 zDtq57@avoBb{lo&-)q2GH~5vpy`@RDg`LyNKYh!p`i0cTQwT$4pa{a5swCc9qAWy0 zXYmZyetA0qR*YFa|60A? zkkd}o&2_r>1UOfcS8)jEIHPj789XlZDpd)}f+%}%XYNg_yGdJ6b?#R}!dj zhQtlof~zjZJxy9-_^Nr1GY1JxT!74(h5D=F2!Yg5kbg`-3t>PU=oBEX^!R_H1V&Cf zc<&_vOhtf_X3Syi6R3cu?{fLyCNgO&GXw?1kOk9*%!s2)h(>19lc|E8k)|({eL}Ik#Q4$xJsrlZL{?Y4x$@LKin_<{Ai)5VIH%|8U63W6TkV zTqY7EJK}sY`iKt*eZ8IAYshn|KH?lk5f8bsCR^yFbIv+}39LL%t7ChauE$>BJfuAB zewcJrv$DyIi2bAxUJgswu0@ERNkNDT_t4QMlYjSQLSa$yqP}9+aZ-&-1$;qMQ zbAp5o339mcZ=F3{Mthq1sUF&?UOUgL&<<5m`^RleuP0u(0)$$RNns^&T@LOnsK>Ad zV;3GT7DOffWOu8-+q?E)b1Z@f8N1`Rm^P)~q8bu8-PzKO?bk6naDJ%0yiUN@AoC82 zNk0leQpmpfK{$3m^DzAAY01u~A?Bwam^efap-$xJdbXuy;A1xA@`O`CD(loT6A=JM zy(U)2+gaSK>*2t633k71%+zIOmg{E%nyf*?WQpgqI^45?@lC*v?V~18&Td~~-uz=; zGU;oqHQA@XeyN&4*Iu@6tf94@%=E8J(&$YG6oR|R_$8GCWD>)-(a>mr{D$ng_PY@n zlr(Y#r>G!+y&!jX$|`9b&{Q%-lBZ@!O?!>A1SQ>oUTC?Hc&-p?O7G3B^{6rjS1#lE zsK~ho)Ti^x%h#bR$BAJ=;F7ee3oT58KCMXRHqBjy)$XASqsnN*b|@TeFe5o`N1SGi z;07Ow8!HT4g7Giv03LZ2$d^+Uh}yX{$e_`TR9`nGHDGPBVZoSGA2PcJB$$IrF{jmy zqQ#Llj}(AP5+$Rc1Y-Ve++eWGCFWUHA}ZV1pd%==V8pkHs2{vTU^yde{*c^S#t`Cb zYEC}0TTs7^;>RH8mD5$o_tl^uJomo4)>~1l(TuF+xiciV-9T=;gwYWdyP(2{m1|CB zz>(w)pSDHdEDF&rO%IwWS;CRIB@UTIo|RZX+zD||yj9QGW4g$`4tBwFhS0A?P>EIu zdnxd0JpnK4D#{!E3N`mBP&Z|s~9 zLh0sS^K>I3jAcVmoP*v00wc5E;csHuHH5R-kb6hc>=Z(+o`s-dT(z286-p?*$aZav8#HwVH@vv)l2|GI2O4% z%mX_t!P6o!2<+;JGQNXP)kcN8b63CLM3egGMSE>nz6c3q)9)sj_tdW~aB*rCBeefk z9dZK6_BVaXGTCqB)S0AqS$OgJxlX5{Tlv+2+zLh}IYZ5FJfHfCg1AX;)gq-fsHwPzz@oe^YB&RT|oC;w66-qVi>(1wa5&kUp zmJxGG&y$ah!$45~cw+yu$$*Os>bAnTeC(|E-R8Yf1kTe2D)9-x&oU zb>_Dn7y0NKC=v%8%gr)-ZAJTs zv8Wp97csTyey>wAcg@dz-Ny;C?w^LTiKr^PTs4te2x_Vtb@)&Hm0kRcw02B(?UA)i z-_CWXnN|E=8xZ}~?eg5sg3;Tvj+@t)g4^&z>CJU}Ki{|2C}pL+g`^W@s(cIPERLk z`WEGy77^4$#>SJ`!Fose$TvzY)Co(DE*lWd!PNcVXP%gG)%Gyb@7%cOTkMJzSc;Zy89%q&PAKy2{AtejbJYi*d|APTV5aCyNgDCJHFezr!?{4;ge44)&Yely2*%FOy+X zcajUX3Emx27y}xqX-#D$`Wi0_t&p}MVfu`%7Jym|^?n=%*{K^|VJTFHm~Yi&dIi>T zdsX?FBHAOYi}jF*(-C9CWQ7s2(@f}DT@;$A3-G${VGl~RnxHibGsq{7S-9Ev&(u~d*<3LqYcdK@z0iacIuQfiUhH`U1-n=J z=z!6?rPUIq1tId8C(-~%$<7rJc0X{HR&n*#%N9RX@$|Zngpta7%LKrpERxO)aF^Dv z8oaV~j12uX)#huJprF%Gm@sC-ugy8|<2jK*;zFY>ephoo08hTYGS&bAQk<_?PoFL~ zLNwmgJUJgZ)%rL<#Jx3iD8`N&+-1xhZP;Rcf|vFEBGOD%QfhYwxujizHfeyzDKIrE zMZ@*Jd>C&J`F+rG!vhW9dr0Tm2zTM*C=@#Yq6&qvvh{9Ry8ElXTAq=CxzcI{b|jTG zdrIJUj8w?59AO~Gj>oI| z!(IRTR|2r#4QG z5#>s66$)}#m`ziTf`0u;We@*l%SoRyr+{abkMDAm+May?6+S(}Ebz{UN2XCV0Bi_VyLkX8 zf_mnnoK-ZiY6r30b%_XY^FDNLXe5DubXD@o?=QxNXX|zEE^rcuQK(|!=a5ORP808X z)=SY28z_LeZIhmh=O(l-(WNH{Og+ucy9NmmnTheN27xxl*vNg+Qxs?j!6eOC>FB=2_(y-gP&t~>6fRHcV zJaF3Yx2U;W2)=*$jh&F-cKYLlDpQ@;xnF;?&?eZQ;8KQ9X_P?YPJ!3onfOe`)ALH9fwyi3QO!_%;W25U6rd%YV_v* z%I&f#mffQ%8(D}L)9v`vgE}I%O&%M7T)2gCh~aANBSHL`i}JC=KZ`!v-BidiTV?+j}fP4L?4A4 z8(#@bZ+M}C*dhQ0gJxni6k^2Nl8e0dZf5#iU>#Rl8;fKBnR*I|oq990Xx$tWifuWn zDj`KTz$-#-7)X~(b7?z*T~hFRWBY9!X1Ef6FRmlebHsJgKNM)yhVMs2rrqBq{yZLb z`Spe_R&xM5xuXmhJ?#pJ!+hsG69buKnuq4*j7B}~O{Jqy)&OTefpioYpS>wu;_)zb zO+Ron8A>9@rbB;DouoiZL@GZE3}tU%@A`|N@|42-1n^f@;t=&$O~i)Uhv7cAG&_nv z8fnJdB+6_+(z^|a(7iT!RWMHxS%FQfLr{=M!8E0~St8ciK4w$S~A! zvRiNrx-Z2v(O6Hefe&WwCV*{0cIy&1qxXFO!t z?5x-2BM?Ms=T!uZL~q-WJv!hLqf5p{0k~n@dtrXC{=^-B+U-k5l|wEpnChg<7BbjA z8z>->y3L=R&sKWpJWeG7BC;G=WHGjCyOW?;l#t+)9JP4aSy6%r`bM>{uJHc$^5O zAm?muqDY>Bol?4!g2v3Y%bu1#wZS`v)}in2J`OqIkHX60@<)eBR{wVJit{E4hVuDQiU@3P?C3R3)8|M*?;n>)A!IRX1O#3LXcRi z1}JXm!prC3ViU>UPg#^Rl_Cv}@_j@>76=(V4KoGZx$6WI;B<998552yJi1!>KoDcP z(Now?b7WWy(lw5;(k&>$Oe&VZadGP;lW{lJ1IOTOnYGQ!%|&py^}KmTrTxP{7%;X# z>MQPrvA7Nw19H~2GDq2CaaKc9dPAe$V8D`HuqNzt;sreB=B}Yqd@KRRuSR(Tdwk7R z4y2|r99uNqy(8%^)Qy($rND6?u~D|=LiB_)sEUv9NH?a=7A5B{UqT2UkZ9Gz^CfG} z?k0CcCbp0HDdaC#ou{-VjmAPU-ApTRzLydw45@~TU8NpY;xvq)En7O4!Oh4Rbj<;E z^9{$lZ$e+KHHC|>Reny0T0BQGMzu~SiK!x&*CJ$Sezh@0#X9buq+E1;{QTTZL!yb| zl$vEMIP>`6#KpFHa*e6GjpBUMUq>9k^rd@J)S38!XTD&O-dYLkuW)IJH!`9J=gZ|Q zAp+ZTz)M`(WNVB9XSK0o%oupkJ9N;`G-*~fI2T(R{xdNIw(Ae|*^W3&ll>c}-2F69 zIKc8+&bX0e6vK158xLQ}uVw%Xk*h8-1;xc@F%`IxvV74-glYqR7Sg*|?Wgyh?8Oh4 zyXavSHA`4gNOJ%`_qw`t2-7zzzI3@ZGwt1-Z%#oqLo`gVUZ9E2jyiZsrAmrweM&h^ z2d%barqGoiL?4a6JlCr}dGLz6K;e^Pg5#(mo-x&}1cC+w;pSL0OaBHAz2|@NmvXp# z*Z#U*fX^wQXaeD5vA-ui7%I#dO2yGCFOY!chB`Zce|xGDK>$;N|H1tph8P+5I& ztxH$Hr~-IlE5Y1uj9y7Aoc*lC?1y-eS8|UAK|Z4u2`G^J^FUXQ zkwA5XMbsT!W3254shNcFL{eA&=Y#6UK0?OnU{Sk!=1ZN@O~Zp z&!zlzqo*S%X#Foze78XPQG@s8hNWBM8|9-Hb&u+&U6BQ@61J(!TQo*6r2*VRue$_?eg>V*_%E(jHsc0*Crg^{#H)=JwIMwgv0v`Q;b{A zsI|UQo2knr=xi)szu;%ov;TH|Pewt@#US1>!u5QxyeOCX2#-4qim`&TZa9&Ri!m?|gmep{oi&U>x$sn7E#k zGeb)6k|exs`IWK zW9gk&mB}A})Cj#Fgc!!Uw6t}sy+Y5gw?GhamzMCbiUXIGSNR4~a`~(*afo+t@e{9c= zMsupMpS9x1B7zO3Ls_81UDMimH}9*w3VUo~|47(yQL$Rjj*HXI7GK4)>{`EevB>yeQA831*)&S~>#0=&zf(lSA#@ zag9KlM~7onG$uHRiLJ5?9hDHKQ3_lhvICN7qy8Lhv$L>pV~tZFa0nW!++YL>?{Bh} zKqx2RLZd<(XR7FGcrJx4q<0cm2RkSu$^md#dO84Mz-$%uFrbcfprmerovhP*<>x18 zluV#5%mW8ke=C7hLf=AEGuhGwBbJD5(owf+3|K5o%e+CtU^NEIB~uoFe1lp57EAp| z=fZAq>tjf>AoHf5csW8Ls7Z|9CnXwB-kR<_ooxi7U~Rp^ox5n6 z88bdL4#FOfu!E{C;hu5RDPi-Vs|@5FLs7_z|B}3vm~pvGFM< z&+UZqI&YM|-n*Lk{BEJ#llsO1sGcz>KMu}xJokX4;sV5>LYt$bg#_B5VBlnvflbo- zkA$IIGO4*3>eFvP{x$e`pgse9pbhi6*?M4j-XpR$&_ntJeq2=Xc()zu^S9t$qS2DvNCoCadMq~fiB#?k?b zae?1g^gH$H;~F2oMWQfmzO}01sIQtgRyF&q^?d}tQvqE9mlZ5)As<;387La7fFU_5 z^y6ajbtHpF5le=1GBdNhH@41t5G;l`^8pQdaMB{X zar_bNvH(K9S=Gh~HybLq|F>~FnlgatLNutJJvpfC>QcO9sE^k{VHFY}`JT~tvJDw{ zhC*}g>Miu~GW3ZavEBFnyP9h-#N>_Z1@y&nEk+_ucA-#`*N%(k(=Sp@Bm@5>EV+U+ zVF^5DEKph`feeXo)iRK)XhC+J>Gf%BKziaQHj+!ae|2={6n`1V5M)1xWa?|@r2775F{Udc9@ zpX@lrp0zj+=qF%!+D#Vx3sY3)wBU>Pp2vvhbO@h9AW zvS1_E-953%z?4hx9}HN8oX~G&rH|U!!4-QCP2TZ{7O6O zt^sa2v*O^@FJd@WTlizBQ^bOW9&x{5};}!2xietq;{8 zl;ViSx6y8k9DuFpltY=@cLf0e^{GyhK|}@+aJH*Ck0+llY#g2tK$D)4Uz|04fAg1` z4Og18(s= zLuT9A30eiwMe4kjo6aoP6y}XFV@jFnE(?;sJ;hgNS2O;Suh=7|E-t0HFYT&G|BAMs-;I-8IOKcMHi2j~E|Ih#b7Q%TT!&gIA{3WIpsvQ6g;T#^%*3Pq3#IXi zdkSwfKg4$4*|@xPRetCbbI2u#;MPh`ygC5Rb`G&%azUk%dT#{KSNY)9uYul?LN*J7 z`rgr?IUx6$@co#aaIKNN7YXAqu{PYB+ogIFM6+)$GWHSrIGG!d< zI#wYJz|B3~G039%`!a#VvE%ZF2LS-QUmG@R zWEpclrFSrV>zB4%a)wp>yz+m6JKZAN{0H^T`riS&IT`;y^=%t}D1rDhQycLXM9kKG z^J;gqc&rxORPUaZyp4Tk&%6 zkJ){6hp%e^_WLkw*8BEU_x2V_YawT2cYd&MDL5VEWE85&WAmHg>qiHt>#0-2af>E~ zq*O;rmlS+wzwAi)SXKUNx?POYNHAE|Xfz6B#y#R0-LVStj~|REd2Ix$tbD#}k>#tz zTLNiguvXUiT-+m0o5@`G*&3Obqa;aT>`)+C)8_r;yTBCVU`$tv)}FoV0s3hSpE*qG9nepk;rOzI$Hi|<*%`)dfpeS`|61v^Yb_LI4B&hRuDbWx$xmxpRh<+3 zLHOH+kE)WvN4v(Es>@EtgFke0+ZkuB&^fDWONGN>5u9x{^RNFY;_44tFfXQ_QXk!@ zMD0tsZsd+rSP*ouwcOH}KA&Gf1TQBHL|J|$P#`r~#6BKspFjv=yN={Afb~TSuqj6y zpGAr2%WLtmxiTr)bPjU`!L_sJ6_h!wZP4{VXPfSbS=K+H-fEdP4f%K8oPDM-o2@Le zx%;q1If2y0W7Sg(jyX*)-grHA)Ly!Tsa0Pq*nD3s-=08NNFktW_l zl+zVZ9n|KWenDL*Ks1}L*&I8{QEaApc5EgLFKx24V753!TA1K48*!abA|Um!2k3O& z4;`SCh8V2a*;EePpn;xEymcbECL5XX^T;tgG038XKEZrS976&0UkF_XkNQWYr<+AC z+Loy#l!QvXo0w#XYQS=<>BaW8ah{GA207?vb!n6Y*dtnEiiT*V+SfJ3@vJTLRBkzpBc@tX_&p%xxQJru6_u4id@(0mu zG6$5fcl>Hr0MYRK=0kar_p>rDAjTdCec?}Q|M0Ch9W?*WID(FlsJ&e@i}gPTR$Rlz zrKv2D|2rQidVOpp_NpEaN4~Aa(3d!7-&builz>~)LXWS(7ya4S5)wyoE^}zalA%X~ zn5>5i#7-6ZVii6`>`>b)5}Q0ZU@kYVCkaKl6I0`L0Fa=hxSrMfa7Tc{Q0pjlYl1N95Ub zV7)N2mt~b;r1)?3-Yytwj7?#cmdR5OZxXN2k#u=SQJcMvx0Wu0gaFUmp?cQ4pH3(A zRWCFfl(ZxVicN!*ZCX=b;MoE&JZzKy)H(>s?szUE+<>#5Xndd4(O8g&oFy$7l(XLw z2`r^qCS{VnP~`Lk2vHobt`H3hhx=iOH65l!feA3p`VP7+8B>>jRhm3VNDh^$+_1Z9-6VHZ%dfn zK$H}v#vJx|+xz7{8jCYdbRv#h(uQS%>DVxa6G9Vl9*q$(zJH`SD;m&I@fjbrW+SXNN}MdKUztzS}yvccg8U%i5|gImF6 zOwRRn2oXznonuGfNI=YMdx2vMt!}@j%d}&mByU~7Y!SgwToiR0UMPcdG(v*y*)#`3 z$V=s&FFwUN^{&^*r3;QgarHrvRxiONuwq*_H&(4`IRU%$Mh5pM`Oo| z*pag?Bk+~^kacppi#34ZBOX5rP#1B}-bT4#TjyGK951x&R0*Mg7dhsl=ii&cN0==v;LO!sc0j zS7vs?p_&_4{16B^)=;gz*pkxzno7%tipL}l1r(^PF7n;ju&f^znJ}W3Y{hV;tMm)% z-yCJ|1*5##70ohI>s__#TpH8z`&^oR)4sd1ml_X#)0?N}d&B^IaLrvTvtWBMa} zto6R;#hJu2HJPQWWa+5%_cA%Ub=rftU+~2H@I9kJv_r z);9X!I0b^e`82U*Rt%GYq24|pbig7?+rdTKFhvD9Av$B$4nP!l&HKqMxuICknsv>C zGeQHM)6L9+pCj;Z}!7AO-MTUV=x0gV{Aa5V^fXS5u-~#lA8F-fAO<# z8}>|b;OkTi4_FIOefwyqg*1Qs%iRUt;7M0uG-Xy*qL4Yi-V90KRJhUK=4Jih|Ln3a z=}}z?{_T1+2b9C@dOXR{xsNJRs~AdnICvxgB;(Hg%IHW4v~tD^XgSXv^rbHgyz|`Z z9xg#qaOLG2-$r+J<=96T%N3TMWdUVKtjq|+BY0H7Opp*KNMjH_J!|7uc9iC1G@|JH7AwOWY|JYv7sjUSaj zs(jkM1w<1I*I4@^esVx}06QiAT11&UbwIb)=G6v(U#)9u^F7MuVV^L1Z@yg2uMyP7 zhfkh^(-iwIjAX^4QFO}t;|#Yn>Z@G;Jv+RFeCh*Wn_3nvoL)-lFgUYT_U$C8s_|9` zTIPyQeUa(rVZ~m+|q`c6|@1#UlU4RsTy6P1U3m$ZaeSzUZeEyZ`#VUH;z# z`Oeo*=`8*omn_f1mf#4zssLKQ^uR4=$PwHoW&Y)Q4dyS1e0@}R61t9X}o z{I_ES^R$}<=)70+46|*VEH4{DS&HgvS7?9D`-Yu^*4I4#eMQB!xBBg-tRxQ^?Y>;z zv31Al%H+Iz-FZDlWQzzRAL21(6-nhH0_a9=ob4;l$f2|%vo#@V0n`#im@!q=kJhc+ z^I8xk)FqW5Nc6~6UeqR_H#MFhY#`eC z5PMi%HJ8quI8-OFF;`0J{mo%F!wt-~A#Rr*hG@vqyiWfevOJ}gCQ@(fX3G zIU0fx;@@d;S`HL)ADFJd0Im@ z&u`;RTgE3SYiI|=!4f(8p@SXF{TThtkF8G{Mz&!I^r^_CS4aoxAYl)Rq#y(yc-j(~ z<9>t~4L3?~!sEom`0t+!x;el{DE2F%KuM3d)xDPuL@JI#zCZb^Q+;=V|V|)9;_Q-`F+~TB#nX@$y#>B8O{c) z*_T9p!6k2S?eBR0y_dvGT`ijo#PI~RGxH5*sewI5D1C&0ecD@?_Fi3f*vZg;G5k?+ zF#<$0O#_Y>LB@mQprROo3gz?q)u8lzt@7kY+nV0!;e&O#1@xc~uG|a*=J$&IBJIh$ z_t%hvl=e8KO=ctpKY!*2_iM5pDKdx&XTFrYN&o)*l?!DJk!B4JFB6If7ltV-h&c8F z0>MXxtan9TWJp!ujRzuQaojLmAk&IalG9>7#W6{^Z~Z|gJ6pexpZ4H#v&OG=5w`I{ImO4LSQ7D za}!$KCnSvp!?wGYeH3p<9w^Mc)H(na1&l`=dP>h+f<-mcvnmf?nC#)n@iVsshF*5y z_nBeyY%lg;n&dR=Ubug!QlzX&%l9>jB;;l=5GT;WyDx&#FWMOZY zfMkCN&=$Dlg*cNN;H8usJfK&A#?c*2h(raH-yku?D^e54(1DD!k#Fdd6Fyl0L<(n; z%+d|w5#12A#mFVf*hM{FPI`+`dD=UBLG?QQ1TRbjthtY}RTLmC1pC>LbSlRjogOfj z%#+<#>&9WNneQ}z=cDoGD<5*Hh8OL5JmA;*rIJE}4w4y|n+6m0TBw(t42UY!!N-7e6s(Tov0aPn9IumJ+Ahhv|tQN>l-NvcILpK^`iVa{p>Y$ zq2eO#9bIZ=r=~11rYtF4w^ADiunU{)9A8QqDU9pPHy>tIZ9A8VJ~&sR^BC@go(zk8 zbo{8YauavRR?I}_@dv7ASak-18 zS=!-SlvdzgV^gyLQzpd|amT3lxKkz&-9{EII00!k_upiAM#zuwCbnr$=w?g>ZQo6? zDp%xSBSeNU9oV(aaO~%M&euY)7~Kev7}Kq$UjRo?@aa|IZCJeQA~R1@g^pOM-WM&8 z^p}eKn^kAA4Y!QemtK#TD6LYo<{Dp0Kw}gdmcTOY2U#&#z@Ixn7zSj&XGlh%#tJ1BJjD>O02yuT`$`#>Y5fMY!)cmZSN(gKsX3c`sJw@NQs)%HT9zlk& zP>dI&=lEYsg~u!=C86uo%lo`aS^tnO%uj|>F%Sm8JtZ-jL((TOnTb$=CHcGSqFFCV zru=}0V=>gW8`^xh^hC{xS$9LlTKP6GUoXdvLpHvwGGu6}W(f5jt+95e^;p7+n)dqT zkdvlhFch{1hy;MTYrf@(R1Hfys4`q9+l(%~nQpwt9g>dye@nJqy(pP#h!C^(_wZxM zO7hvtB@zRIaU?qC6*G5h)S`NV-~ytf%h#A<(nQT%(#Z9h!jiNn0BCEpyy5XC=76qs z>?owtFDF@6)PZ>ssDRa^kL_Jv&< z(>b~N1M%s%4@kvv+`ts4$+CYP*40zqN@^D@r~7mfkZOiiAgGk%e*InCVEK(&VN0eV zdvt=v?2}CM%iHrh1$qq9BUO3g?s$`J8Lfqnv$RS1lnBwudf<_~vmTQp?*4VxW&_?7 zC;UP8(-at$^F8prlNAC2{o$w6loxGzsM#?hWHGWkmU1@3+&4?##1#2}L#t7XkA`c~ zJi{WoYHgVTN<-a&{dWr{t+cO=YlqUvHRtF!S;ySU;*Bwe%`P*ALl4?M5!Qxz*ey+T z9O2W}k8r*Qy++LQ%Ts&x?+7pX&^Ye8p}X&qoEV87BuPgQ(^@XPY~sd31ArQ8_!CX$ zh(t+SXSbEm`vdcisowE6>8XZz=$gwryRM8avO@3+>Yf*1_B%p0aJ-+`|LB#;IQ2TE z;u+;G7Em%DYx;8jB9)cUtKpy#rJg{UbC^b;er+k|;D?YTk4F9a_S??%sParK_NZ}4 zhr@O&J%fhk|TvN#4#B>ZewiRdV>_EDj>R$^hO+u6OvKsT!?u*UIJhh2tNfU;uBMYoRv zttWxnuwRwTkf@BGmdKTrp~-poJ!fn16(KyZ5ep4XT2?VoyvrM}dG8KO3^UvKgSfAs z#f2ySK#kYOh7Xp}T`q%qFz~vy+W@Bq%F6 zkr!~^MnyA3jB0b>p#3OAX<#umjA3%-&UvOD#z&&b(aSw4K9GpoMDyLufcFhQ zKOYg0QCn%uB|AA|d_E3d;P<}c|F~c^{U^En-x29q{`XOPSW`NFbL@X2B@knV<+00~ z_HOoa*ygY#tpvbFb&cRs2U7?I5}`#l@IXhcr4{-_$0a;sK_J#wO>bovHKXeKsO-OM zb+DnoYb8f_@pf>f)A)F7{62fwVv)tEws^U0Q#R=YYMIl6_h|>;(yqA|hMmYlC9~q230sF6VH1^(!3_^cio7s{-uY3jHX~ zh4Ifx{&4mgOg1NK|A(=2Y7zxXmUY{zGs|7PPZni~f z+D)%Rx(;X*Oo~$B%VPo>)Y^@4MLy%@!Xp9xuj*QpB)v4D+m0NK|I}EQpGJ^qj zG8nRPfD&sByMH{+wT4`c06cV3*a6pjvirb+pI6|;Lyhz*ZO9=>cGyXE-Ycc zjBrm$GU9R=w(F(F{Ai%=P#O%N~3KR0~UeUx7V+yZ2qNo&zW3Nr8?*zzpNuMGYI#5n15vs#Ug*(}RQ~xHNy)|foo1!~LCVf#yiU<=%IqVo( zqqRhlBw_ycxq~MJ@aRrr2{|U6p?%Hqu*U&$!UBMb*B7!dWtUXv zmTWEF2;4+LOZ#==$BrT1MU0fb#tI9nImXxErJ8Eu&UEn1k~D^ zh6(3+sC&96Qj`}n^5|i71468kGVZ}}uNn)z7{&B#tJ0g~vSneOq@24$T!THn~Hl!Y_$V)L@YtdVQ~56S*?jj~z4t$<<0;wy1Q z2*zZFI%4{i*MU6o^@nm0e_?xO9`*v-!fz0G-{EX=l-mC@AONb&mI{%y_k&L5(91-I z$l&bLbuZkovwaIo)_H<&-@F*Vg{%#dss39hd&c(bxg*(c zg!OGALv%xkB{g!wzT2ai45AbXO3$ve!Nve!rZ+lt4UO0?=TCrBwHc6yQX({>m7DD|5rHtcS8U=W1*qAmohWvW za<$t4S!PUmP%+|O{!Ai@I+#Fpy5lkif#}u~v5jPWsZT>J1q!K`AJ=;}lf`PP|K|Q$ zTzxfcZxqWdUQd3H1Iifk2`kVjnrpZWfOfU| zymJ*fCe!h>=o;^p*v*!QDsBg+Wp1-B>cELT)Tw(@)4r` zd+4=bYdk9MRc=z~qtduNXpfvBtAeF!U&l0m3M?Sa?d`XNLD@%6y*7IuasiaKK8+l+ zd)WFtf{v3<+tCz2C;^gaB>v>BM&R!ZQj|4EPBTJj@A51Pn@mhqH632;lH~1 zW&iP~RBfRIhqVtNhsosR%5UI41))g+5=rAc?y2susP2VRnur+^22dzDw*=KMlYwE! z#;fDbFGSp+a+a`7X}WiOPNsN#g}F65~ko=~Qy#!xoXK(I(upVaE$uc|(pV|9)yrbw#^Z4Hs+yB&c z&cw{b{+}k`W=(DT%??E0n_3MLdM$zi(fFjYg;J8{4HU6?B02?vnV_m-+w8(gJjn~> zLcbp7uIi=|n_RuPK5EPI^gW%Px6sZv7h!hD&%#Weke~4qD|Y-EHgoi|P_iNksE+oI zErs^{XcQg08rL17bh}>tFPFrIq(jc2)VsZpS$%$6;}H!NS8k`fli42zbo`H&EAFo2 zf2O?G(+m7h8yv}sE*7e-vJV#XN(U^cA~yRpq@p9ur;fe$cu%QHNL1xZ?w!gjkVm?_ zOB6hl4P~@1VrFZYhR-1wRi%OFD-{iv`;Ki7R-bRgV=kaF%Ik+c~GTnqz~bhFx2Nu^h#yRb(LY zF?NDAbE{afKDV0jdivPIgjAUg(+s^Tm<)yac-xr&vogBDMkY={1k=Q740MP;XQw;w z9L$r6Z1lU!omyJyQ7r+;3U*hJ<)qZ6W=q|&Rd2Ccvosq5Os z+_3al>WaM3yMvy*@=Y(qSxO9JI*5yrgfN>Egq&8+m9xx8S&c4(U0VWAxt4K~X@I#! zVsiHxIuPCPZzcYRA$5X8OyT4(a%B<0CZ=fgahE^F3D+{H@$AU@jd^}rgUcxJ0Ezc; zu*$u}muFdi59cB~Q2~g^;w(ArClOb)iyL|qfn)@NlZr65)bDb#5PDB1Xjk6Z!D1Dx zErE33v6cHO>o(ccU3xs|=U{6a4^)st*Ba6yss|~cR_}Usd^H*Y42EI^7nBhJz^qo( z-wbd={OT}x0$_S;0e%8IcbUu#MCcsL(lQGjEAVo4e-tOp4&G*9&$>f?@Lt2^w$ znJ&ccwk*Dk%&q`{UYgMwL{FzOgr6Eb`NvJJR*GR^{)8X%<4!dW$r|ttv;6@(sla>M zJIEb176x^9w!N9$@|)rKn}(&LzSd)!2dkxQPw1>d>ljZHxJa;~J?Khcm!%zD|K&hk z|AcYY8U{G;R)@qLEfN9ebt2M1YX;5Z&*lX(_+bD9O#4U9|N6SqQUFUuZJ!_yj)*J1 zy)w&wRgM;LOcpF4`$VCy#C`N;`O(Lt)#@W2`fJBFcalgDs6RlRX_trb)@JAuGe`n9 z=(Qqar_ITPWEyAk^!=nrND=b9=zIk54t|{;V)`@?iO0}A_FY57-HsVZ=a@aH zUJ<^r4FLDl-dAl^zJk(3mN4Q*i=+tPVaxD`GcuMok_08=C_xarI-ghC09GzCG-*>< zs!kBlbjBx)g*&ee7^L>JUTxY=#~4dI8tz$-%AEP1#<^MY7WlqMN>p?SwTo(eNkCc}ga ztB|(F?>du*B$*+~bMbYOLohS?_Q-e>`W5gRG^M&xOv4FK>BTT3J}L`j0w!+JB?D>~ z;@ISvcC2HcIBWbZ2D+Z?-k)RuXKBx~u~Jq?eV9N$KxF)CMZ5E4IYh>IbY}!G_H^)} zaH3wI-dGYt*pSW8ig*e=j9P%uA6lyL7x%&srl_)rGdz`oGU-zwP(s=K70wj)uuc`1 za9pX06Z%}IS2hO|_lx8H1tX_$5dgd&v)k0;Cxm3@V8$#s00e&QQt}RXS*Le}ayLUa z#FB`xr{!ax@JsQqVoytk&}qMZ@{)*DCC1HyE4y+O22aL%vG+jFD3VO-$UJkUEqr}C zlksA5L%~Dc#E$0Y-)A&VIWl@~Oh{N68=HqBdsssCPqNkPk6iXc9$t*Mk8hlFNzF3EDB(pgpMjc@o2sIK zR-o1@Tc>n?orXlEJMaKbr)jL$`#n6B+T-)->iPaSKBYcPPSPKq=c?Ne8~^|)WPJHr zf49^Sl?do*q|CrWZ|fQ7iu7)#;i?#(Kn#xRBPV*JAtU^3hyNH1`8i*YbM6JwZ$2EW z5%bsJY3E%Fj`n%|MCfY>o+u(h`PdJ+~Uwgwf^=h#2IEf3PRZ zy#>?ELwf}y@l{WwD)0&9VePLwS$hQjb>ofILzX2|$|?K|PS3T*!lH=WlREiL-#+cP z7xs}jaW3HhJ%+XA>6_u=&#g0GU^Q&SztD@X0b(N7&PmGBxBVqF`T@_;i+}$Yb;b6- zfdbh7FG;3ZOY`rB7?SUfKH()_@PH?mj~lbcItE)@NWd`AL(2GX4TS~_i6f2DGe<9< zs?VK+GBI#x9pggR`8iilMb307?1sYYC|l^DU&mTDTkod5ulFo_bV5Rkjnhw)q3a+B zW%1VLjUV+kUd2g1pZ!fRLddJ77kM$ww$C<|rpj*b<8|2i z-RfhQXQf8{Y`j_m1u0n(er3$nSP^4+uU4{n`!>IS8 zw=Pwb&-%ZLt#Pv{A`!113*ch5vB>Ho*x35Ky!e^A%mld&0(3A%q4@ZXHY{yHOM4r+ z@zU+bTYaJHZGyRksf%lKAb<0DdX5hPF0wE79PJ9xPS)u^x9WmU?|$=VI?O|Oo(t-^ zwQ55d9;Z_?6Prfnq9zkABwhUs`AY7fJ8i~QBp6IMJV{>d0zyQsZc-2XSM?Y4Cs;1b zzjS8}?=t-iU6)7n-dB~B1Nnd+Lao=}_gWhyBD9LanY+ff0l_2sC;1lO4r>|gDfK*|0i~`jnvHY+{7-DF2 zg$$Lwt#Mspm7}4;UEjc3O+z&rg9}>5U)sc3%VMnyOz5s>`xgMes$xPPM$vAS`}s_% zje-GFo~IeJOsMb|lTO9KU1hJ$`qo`T?I3fiM=;LIz!sckZ9g}oz2L3^V^&dhtL_H- zM>tSukTgNvdI*SGn9V0Bl&do~<3hZ3fl1OUX{oYgFxmnL=;OLwxY2bi!pXlWM>Ck{ z!ZgBnb9L%-U105WX>tIlg2u0;#K%}*9Y%yy+Q(`_^0>)B@~g%wiei^|_GyD@s)m!3GEj8!u2Kz;&hyz~!|1$Y(zm83f}44}uJG z(N1NYc;mq+qZI$%4tXba6Oi>L7@rAHJG@T^W>x*B3^j}V-O0qNCy5c7PjJm_^=b?V zZZ(Q+YS@4aGZ_&22GWeQWX3cU-N)}QK}Z8dsfRko?p+iu>ZkOvEfAkeDV%n9*wK37eNbJx-1aL}e;x(n?6^75Rh<5n zPM;qauy{vAJC@5Pff2A~+BO~30^Rn9fQO!d8EB&wT3Ey@iA@NhK(|p~`MA||6BAoj zjlOn1OCEiq(zmbJQw^}H1GY!7oU`dGmWw|dMi13<4(#YFgjT!|8T>1M0l6h<+-;EU zHG*Chfaa}9KTZcmLacMa;|5v^u5Nq|+Wsr{=7P6>mxPMo$W>+)k}EHe>4)h!EMXiI zVY#uF2xCbRSR7Ha?+K2=^9U}n8L+JL3~G?^-c8L1W+79Y75bdyt;Cz^5=8FIXH5%I zGOLb7BV{qsF+Q%4UP@Pv^ep3VNzt^yTn6ayops;eKq^g^p(=0Tu2-8wsv?ZqydD-9 z0|%sc{D+GM5AVIj^BR8Z)~&0aYhB2Kc?N{PwjHIl$fUL{X})|C1o#L@dN4uXo>z=0 zpQd67Fd+DuEBRtY0kDYFtTY5cc;5be))1by>EMBKxE(5J7GV+S+>9c=yH~4`iZz(g zBZyhJQB_V#xW$(FT+}7aF2LKT`(ph|s_l%$rIQQIKQgl+1m1!n3_lZ; z4xL{@)XVwXE&7F;EU>^rNi~ZLPoFC%ZI>K=m|?umGW0Pbe!ieq&hRO2PDbd084w^r zVZ?5gh#O7|PoaMk4|5=q&SMcjV_u~c)FyE>$R?@Bw_I*^^xg1d`Y886iQ7^U9U+7~^XCRs6%sL8tw%9Poiv#YOOkYRRWvXFZVK*aJ zkYa9l7tLHaa+(~Vw}Z$!st5BkU;L)_YiN+R(py5wNLkgpI|2cc*7LJLtc7GbT!!xC zxx}(AB!zhRXIa%Xx{|qp1+jK@ciB!A-Zvh9)!c85bJbMl&w17rtW-26kh*T?pe4$Bf2E;}L$%X_uER<+*vUEls9|)M zXu3-58M}6hdN?B4B0Cl!GR=zI#F?x*<=wT)PB9~9n+%ImV;GwKGLr8_A6v7h;Dc4T zSvr==*&3(pf-vcQBT0?(ZL2B++^s@!Ib#mg;;NULwV`R=UAjLhIA693)CS)QL-ZS zgB2fMT|VY#y1%e#h0ZoyTv=DkKNx{xN#WC*4NIE#EYugcD>rI#OsP#XJ_&G3`#}y& z=D*w;n5r5X@H^=k_VdydO*`IAZN3E)$eT|?u4`s$0t#|>V0gm4J6hLQ@Swyf^`8o< zhO9?X>DTpm`#jf#a*|6Ng1F#0{JZXKvS*G?+dk|prCig}Key0grMYFp61Q*j_&h&; zpLIBg-xZeav)`OvwjLK3@?9+z%*hXirG{G+EIl1xaClA{`j_zb`Q&fp6u9NAM}Dl9W%y z(im(1Doa_CEv=2~wo*HxFcz$+ON9$yn3LC3Ti(?~CJNiv%cqVM`n8>F`3*Gkp#r=2 zJ=*#RG#K^30?a{wL1w1zXTAecxc2UoWip&VAC1xC)QrX87~+%kN?tE!aj-zMT>LZY z^HhJjR)C5mj78ne!CkAh!8&*aN9U{pn}LrwzWa-1h$^(AGn|-Mvx5$N5Gm*nH0JKg zy&QgF0PrIae5$GA>z3cA^Oo!S2W~Zl4EY++eZ5zc2QP@_(=brO{gepHRa%6}8h z{~IoXnT_o~Pm;r$zoK~z(Ra3XPP=T#s?q-WczkUrA}9pCUoMBqV^<*y5jG<0Xb*F? zR$dh!g_4zY7^3dhsMO=Px$SOAy?CjXxv>0#Z271CWAryB(sX>wxczzimMVV%d%`n*QLX)X_0YSyKYHw7VWksw zSX$xb>h?2V#ZDs~xu>vfU6Qzc{r*jyE48g)7H(1*!$49v5b23?e(f9cbBT^U9L@-) zcN9D^j{Qq$lVp=YlH1c2Rch5<3gALo+;)r6e}g}I6z&gaS;TkMck!`tvx1OK_AB>r z-gt888Vk)rB5m?(U1i^zt09%0ple}V2@XKsoHXfkJoPBNYxrphL#p_A3PA3z^U($CfU_#@Y z>Gp+Z11Q*MBa)3+T=YujQn#J#sD(nwyfHQkCJ2CN{C7N60+wKV_SwOAY-pQpduVN{IaG6>PeUM81=c34H4Y!0gb zukPAUN8ADttMU0-B11Zo)hmkFb>LjfWvCDTk_BTalY{&1yzv5F0RTh*WpGYphx{`s zM4U|D{dOR(-uU5*gU67lR79LnionZw%UPxH*-o$guRB$?bZ4wQOfI;)1OCvIa#pw% zddJ^WRG;vZJO1PIwr+ZG3ESo%)z2B4e$UnsDMfIzEIoPwi-0m-NK7vR4X|%J$t%;* zNya$;V0Tt&;K}7uJ|xYE|FR|eE1{kvr2)H6Wdfo3i|!`7O!%qE$#hYV&GylCYgLrZ zOb;fU!yq4$!4uV)Q{|X(EuSqyh7><5&ekPYNw4Jrh<{X<1GaQU(0(um%pn&&81xqS zk?|Pmy+6T;8PI{nOVw);?BEL5-F_=koP~^z4izCW-e&Vb3lQ*_g#4B|SOzb28&VSh z8c>qK=w0*{^yUuoRV(#iB!6=NlwWjl-05%GD^i(KGv2*G55t4VPe%$;ppgL29+mVx z8lys~wD=sQqSesGCqgqUiPwmbixaD4dJz}S+`Vuv|E09s1>SJe_rOJLzi}vAOEd900Hna_LFjSHd^i(%Fxq z^`S>K;N?MNE<5s$y2VUK3_5ag(z_h3dV{5xcJXn)k4HjmqAjMNBcJ2Hz4pkcC(il=&)KO^U}qxEljQ z%=W~s=(*Tn9SefP=2kR5FoGa%+hi}(-#HYQonA6tx^8P(Uc9w2zL~O3#1xbwFg;K* zolED^qG7TIS<8JmE4sanHeD+{74c@#g1&+5#i@$&L7VuA}%&n~nl$iY=U13Y-?P+IeG zS11|MIo}EO7J}@JCdj97O1JRyIxQDXggn_w?=GMt`qjPL)Pw~kmXbX4u)-eyJ-=Ew z(KsFa9020xI*Cs0ML3r4d=u`(XQZp4KO@$R@9yR-NjR#~B|s4NkXge0C!Xj^Y7cd% zTUdv347@BggNrz*9TKR(iCn2SDd=h9w8qvi6(aXU@gp25pnISlyz+6Ee*tdaM zfp=?PcW|EaI}Y(DP?>;(`WoRynN7MRW>Tv<$P@}7avFBG#0UizfkIAd#m-yes!7nQ zZX_+in;8!K60{2BI)v1qbneznO3>bn&)YhDEXM8^mYky9j)z`=Y;}4+szoq{_>*LV zWvwtyGN9(cGw* zf^UTe_u15|zZn_M8m+Z9q7v&QjCbH(gdcw=Kc7RXJQ`5yT~gga-hIJdlVbgts4c$t zQb7mk7a;ragrt^b>8ea`_EHJ3~081l}t<}IiD?iW8B!0~u4!<>EfxZx`BTjyp zaSV*n;lU(t;0;~T72Wp0J-i}R(Q!b^D{(7-u5b4ig8Ox}>1DGi!;{R8-R z*{Imjnk#k+wV)xl*hQD5*eMTd7Heqc2+s5%9g|vCPhxcTZ8sC&V9+jmqUMd5@a9H; z4MO6jTWSkigaVVnpJ_=Ipf%hF`*G>Ser+EVgg>ZtxXet@(I>-**s=1Xt6EbZ(Q|hv z6kdzhpIL~kD8btr9jU^hFx;7{|O?l`Z0jj`nES1pr6&reRktl|;J1P~{Ma&G{)h^=sc0 zLv1@JR(=sRBH`G3+j|b+kC3>B&)7IXo}eqDu?lCQNw+>2GwZpLBZ9>{G$^{{FC#$I zGZ)m(OFj#M?QFh@3QYK0`{U|z`e)yst?wr{-_Xhf04o1Yg#B+wEp~S1{}f@>TH1dP zT2O!gg&E?)#!fS+x5r`M=ZZ85d>{ki=ECFvvyH;PUq99jGTbjP+UxWWU zTu;C86zY_7Cw~!xK=g5ENh_*$DKDze%GzVBsd)2QfS)l~zy87g)BScL#USNyv3X@) zl==CZ{&#lMfflm3GNx`wVehwsZ0XCBI6e5^&gbs%&ta=|E2ME-zZLMI5@t_3|I&t0 z?`Q~7Cp`2+U1+GN+lSf5Fue!O#(Z^thQgp3^v^l^xWs5n`A5ms)ZkXlE%ug~fZ}Q;?T50q{q@H2ZYd6>9f{ovbdvoipCAIt$}qoR z4YIDChFv%dfrbJ7$wXySd8btvS91H<`{+D;)+$m5V~PgeQY%GZ$NDT7jVzKX)D)qO z_%b%Ni|d1iOHR1)Miu*%N#{b#Wx}F`Q8H9+)FNPlMM>$$&%vVF(_p&(r`2FGfmB9> zf9rJlRThuQa^BMs6}A4v6=d}rFb{MTHV1EiB@x{FXbVhkK1L_QMiGaB3<5DRwEb|p z!MN1`D!e`ilZ@JuHJEtPRS(TFK|T3r>81x!PUSb_T%8%0*NB^}0d`mDzlaroZvQ!# zmSNmp=UgQfCqa_%rH%L=6X^XwS_LRPq7poAj=~pz{c?O{p%MJ?bYdND&vTFaj+0@h z?i%%b0 zo!~ok7OHCD?1sQ}G8iie3GN|M6^9~-LkLtvlEhesw|JciDcTylcK>KJ-7RABcz@E6 z8Nh0oYOcCKAse=5Sqvkkh-XphQynfhT(+fnEUUQekltw_^b_N-mG)c^CIhsAWgU>s zP8db8@PR!dAsA1SjG&DY*C}(KUF+`=i#2v|0IZxDkVQj=!PfhUDUMNxA`pqd5mv}R zhMy3)BBsR3k`m%3Bd3d_Zn0kxdbAL&R|p0NePftt=)Ml)!qfjC}Iwmcm4K=xW3Pf@8*A7gW{&pSv- zs1%A!FNUs;g(jE~dwEMJf^~npH@@471_Kr33N|EJINKxO5islG8bD2Xu{7#`SwBe= zk(xmzKq)k8mqovrhr?MEa890=yx4&Gl7gIg?zX})X%s|h_eHj~mquxaw?G`PKpdzc zg`RDtF+j9fG-a9bgLVYkb%9%6@nc&5<7699`d6AXK$;ekbxtx{drpF%RYtG>j=Z{A z$$wIQUcn9H3sYbA(yQmraBH>_3<8dqL*$T5Oqbk;n-Pb9`yh z2FGW3OIMpuHN=UR=LGKG5i10O5}{b>Szp2qW&wE9+wq187mfI^;>)>Vm3#kgh-&ge zICW)LCpXP5P$NHkr|o1u*a03`8%8|y6RiM$;gt>pwxD2)+Yj|hg4sq9Q$Ck5%f3*3 zOvey2wRpoMUnV^x_%J$g`t+mm5=C~mzgQMh@l1KwC_yAwCK?O>mY)FkY_>|8AomDF zcwwAb$jdgm;k(C`|Mah`NpE&GSGIGC+%Ti5T{*@*>eH#tKt7(Nz=q)T#l^=V_h#jA$kxfnmEo zNt(}kK6OI70*CG|0t*h-VW;ZrDTEMV=!%%iKH9@GAC-&Vl^JQ_a2baI01UEV9S)Kf zgKfh8PBFEsa~%>kC=(8~Sj4z<@D=DPzY^GG3#!zay-u7kaI})!3^ihRZy*MjbZ%zh zL&+iY)2ge%5iZV_8jL3dK*muY*h2>!0}%t9w_t_+5$aG7Mi-6=mWtAi_)b%2kO&}% zP(-l%H4nq~qYnCIX+<`u0PhnY?+WFQDyl)Je{Hm9IkZJt#6-W-jktPQb;6GY#8f@d zJkQJ{0yD!p)%OAl6HZespwn^XK_Pg?$CmdAFB--9Ow_O7S8T!Qq7k?R?(>b)8`&60 zv!xckeoNpJt6sP9Owz|eZ!(vRYyt-i+ns2H5gN7U@l+V48LkPhk+0=VU|ym!Fq-!w z)Nh=*;?HnipyE-^qfwzrxz~`v{aHo>SL$xzfPIY$ilaZ6Q`a3im`DE!xoPfs+nsan z_Iu19td@Am18|>RTU)u95v;h2iv+>NjfiP2*q((2@?QlnKBm!kw2X@e?X%P$+wIUj$o0{O6<5Vy z-gzUkd>taxo&(`w!#nc#fN-&zXTo%T#w}R@C~4eKz=A$q0(J1E;Lu=9E&P{Eqf3M1h5f;tmZYd5q&Tq+3G!xBaRoCEXb$lT&&P z-0d)3(;>YBuxK@*%xpA-O5CGk*+f~)YcOQBz=r(I)EmVWjAUqAAQ6zYfzt>-EalNG zYeBLBW5?hwTWQ0cEUS1x=}_zfhqtpsP>_$u&TLEC^P0}PKq`kJ)PBB#{wUO;bXE)x zF{u|Io&WF(M6Ii;x~tEh*4hqnb?WN`QOL37@IMbSCb=u2gh(9;Y_G!iDS($akp#Tu z*LHxw{V6`ADogUiJsC^bt!u?%UwHezI-#0X_%n96pV#)8W4*l>J=ZU5v^w`A13PB> zxCTC4o5@%I{64VcF(fh<6Ajh$x{iR$kW*xfo|#iRaFU$M@bHXPQZx|4+#6hwX+R9B zKGCiCR(O(J$7;=~G$_a%p{~njKx?^;ygO4tFd@HZ=!*SPBv9`hDWpw&kN11lfZ$8&*IQt+VZ&?cAk7>~3SFpfml;t)8nAG=uN|M-_M9?{t3_eu5TpCLHWM9wP}oek8dDv8O>Q7Qa!#`f5w#%9NN0#-A(VgJl$Z!V}T3PfH8U^(F@Ke6N*}SDs zgW~2~fRZ!js=W&$<|q=D0*4O82^t-b=4I3j47?uE1fNf_lL`}+8K>fcEr`u-#t5=l zS@4WmyU4{24m5)|{#vH*){Q$VNnOhlG6Flvw;vi1|L{gWYsVv$dU1a-f((OgzB-!ziWg7&_gZve4m0 zRY%!I>HXgLt52Y3|BE(e|KCtzoXr0hH>)L`xbgpsQ%}*TGz}xzPkA{rIquY~l(FTX z6UGCG9mQlM_tT1a@J?n+v0-lsg^A^hsaWZtfdrik|9w4$g{tAJdnXU#>uUo3+%G-X zy$?>Gf4CV9JEThkji$L8~lwYu{Im8UkGJ$-P*4C){rH8g+VMeKd0=t=<}Sn zRV=*k?#s=gjwmgro7M1r)`xn|VBRnn)JUz?7oMe!I(+H1 zhPq+k*;^Z!sI`ABkM+%Lj{W2ppL27$sU1gaRUH7XfZNgHfMZpS4Rbn~Eyl>)dkYRcq~>cM3In zoq3Epm&cxWr=Ud6Ox_ySs%}m=A1O^(?K5Y0OZ9y)AE6C$QHa54W1KMYqSshb&6(4wQ-Q0@z-eOB=3R?9GKL8R*@LP`5Rq5r%GwhaWZeA&*! zn5zxhUbcM}i`R$W;6QrN!A#AAcksg>eNFab(f0TM<%nF`>a5qzW_OHPr|!f$2u z=@vHk8fh5^DDtj-7#S%g^%41$5~6Im8lW4{dBC4Me4WvCs`54ymi&r9!lw)-6Ly(M zG9gc+*zahy$Z=e~mUvg-BRQgypha%+C-g+ZUb%=z#13nLzov1SL1}e*1%QVY=<<`Z zBQh6?Sv#@;2h5#nJ4Qi|n;N&k&J8P6en-3d*Cj7oBYNjIJ<2hM%c*sZD#teHQmpc9 zcO`OsryNN`^2RRdNDzPnz^dJLV5_$DLJnX=s{#faOAEV|Yro=)lTF!bsl(j`nQFd^Fj$3k=#el(or;iM^ShdC4TYg(@NAN>v2+= z4AWKj<1v{`Urf@R8#1%sk)*+wK0N7X74M_uUZT>Oz-I#CO!~4ExJs4LbTc-ylqnMp zGA}fN>;$m4Jwm9XgZ~QLirq&l3snXc5!oXr0Rg5l?v_oVcsL>S7(u(!gvbpI$s-F= zRvMF&5c$$V*Tg!

Ge3 zyOSPtLdJltc-B3RS3HiLvhHyq)qIXQPLy`4V5 zoQfG4t!?bed;3PE{s`Hmko+kniJ~#E(~qZ_;SH(8gse81eJ>MpW4rq{ljX9uAYA?O zxwX#OwN`&(%03h3&-u!9)ZUf&a-57yM1_TyH$ z+TU)hc08J|+x5Kp6Nl7n`HRtV)teBQ+;3d26REx(7>we7E*UTu1Pmdsw0K9LaNYo8 zpWyK{|EW#(6)Q|qVf@zr_m#6h=;5Q?4T5` z!_36a_`hAsU2W~;?KaeZyOj!$4TW5YLEHl7ANwS3e?QT?Kj=Dh zu(WobZpN=Z%nY1UQDvAu>j=_#eUx~@7Z^K zwpIP>lhbLo(Z{h%12W$p@+sf!<8l+{H|RkdOE7>AVQe%;wT0|Y@NC;;A9wnN&_|iu za?*D>S@XTfN-+VkE@{-L`6z@NEz^ZcVx32!ERTo~EV56d9&~Y|k^XJM>6c+0Qi(I` zm4%%|JaNJJ+qaiyE#mxEVh> znDGEsQ*~W*Binr5uAfOy)J?rdx-OC-f&wnj)lBdev%3GD8UrqDfK%3#E{S{=LHW)9aXo_qcp^+X}(3tT&gK z+<{l}+evZXby4E;(?=Nb^!S|;91E|qwSvaylD5*bLb*2gQBaDP6EYqD?B>3zlDz_D znMYjbQo35XzL&P9E39?B9&O}!s|F`lH5~EO0RjndhAe8rzwDBsO0tMD>93G*#hR~{ zGa|8oNbiDqQQ8z<-37adS_y#~NFjwWH^b(3zRw>y<^sokZq(9X&H&|>*LCzrwPpl^ zEGHNEIx2R5i$CRNwaZITlmY={Ms_tqay|W|Sy2X1%Xtm7J0XrDtO68>6zFsUDhtjR z=v$meHkN}D`>SUtULLJS*=^QuAESlGQy266M1=Vh;wX|4wPqlzndR^Isn8LUah!6yV8ki$Ec7TOsOhPjjHrjodQx%0^ zlb#@sHguG_f~@O2HCO~*H&8f~x*(Jc*7t4g7w6zZv9yJFLH!-S9Oz#-#FZ=LrKAkn zO~`A#ZJX)L(5FbxtjC?tQ_@$kg)XM% z(q3~Ma6jRwLb(#2IA@jw<;Z@7&lH>W%bS65)tk{##PTvM^R!&_Oz+aqXr7k>^8_vF zXzwazu8L*M6|jHzlTD_LWEQFT!;`7U0!f=H9+{3{jD5VU5O@`j@(0k9>ITfD?Ni7u zfVHzUbx@Le=OQ;R2FjM&7%4%KvM|8l@>lwxWI!fQq$IL@w>R`M8*1&tWUsPA!Ll4` z?^b3u5)dYczHA;PpR&3fb-CWgUot04?qbZf<)>6a1YuJxc?|Pzp_6cQ#LGVt%(^_! z2R#|o-L+lpfY=i;x-_!uwg51_T;g9-tHpX)T$OOZuI7h7c!BFLi+p|ZfSl~!w-x}% z3`#!dCe2CReD!G)<}_DcYkl%>>z=n&P98KqVrjRHLg$~kRx8xJM7-^jzPA^_Mvbi^ z9K|f@5F^~Q+vM{4^08pY2Ex4?sF#Wx0hj(fe>&=S(9u?)_3_?LF9??6G(_-M22Y7c zMdV<}_gwcNFHeMPy4}eDs>|YjO<{rFqEO^Ojr`0;j+#n4*I}6G~1fTy7a?! z=bN;d?T(jK<^nBkb5ntD+);0RdKq^mG3#jT2WI1AQyf+aUl5Ov_(Wt7fy~6JhK|aP zjR*NO>b?AsCbq=Z4EEP~+dfp{Qsi6aj}=jEGs2@u$C#3(D!x*hdPKVPA8s11Se~H7 z1LeR@I~NB8>MF!te3!%`!%rqIc^xPE5%ZO{Fs3%BR_*#iq*m=tUsSJV6hm35ri0qrU_x(7x8Tt zok$s*;?Bu&?=3d}4M>ZdTv)|g#A`J_WAnC7NL}R!6Splpf`M25W@=x>LPjI-UuO&V z6R!Nr4v44g6Dq=*Y#Ph{Dmq9q&1W1AEg<=PY`8JU_2E$_L|jH({tkE8*JK$jl^g+E zr%VaR89lt)_ce7rjU`gcW>%v8n2^oeA*;;^K=}=Cx2qz_K8{tn*E2qgZ*+l}I>L4kE(a!;@%2gRmitDH?K$U{!0y=_pU8i${H4e|g zfKg<0tDnI>3W0vJj{Vv=$98)-ZLA6K?ONYe*WJ1E!3{Qat$J~)YtH@K?bNPKKbvpD z3N(``Pq3p%Wh~+DWh_@&^#?JZ=C2Dj54_nG7JHjJ{ObwJbO!cNxiH-EU_S;PP8Qpj z%SdqCX$-_`h5;VdgLXSF;dM53erLuLcLZ?!H9R}u`wVViAqfITRPMgRI7@Do5q!tl z-76-&9ZANP_=U3#T$6h~a{Omm^O7+=Z;TH}Kx;UG!P)~8e`3f=*fQsbHHb+$&`$%l zL|od#0a|j_Op8uHz;k+TH%-kxSS<&B+URHlO{OauX3ztd_D``HaGq1xAvucC#TZEmqp$dJJ9(q7EQw~o7F{3B(BPn?`}mNb#8Wf z`fNyT>VI_Ndp2N1s{6O54XoKq121a7RWg+nJW-Bm?9_N#d|C#&>B7D<-`-Bi?7TDO zWozq?g1wEIIYNTp6CqK!#q2y~tTa#+2B-7-7=1~5Pr2_*=*P7OM;DdaO>$saVW*Wq zQ~)tDO>{sm4!VX}8aaQntU;)#i0e|-HgwJ*^w;i5!32Va>B58=6FD-*gBVJ=7)zeb zOGOC)euIPT9})GFGMlfvq!s|B)JT4xzCHkOQ^SiN1=TxlhQw^4u|8rm-*AOybYvsq z8?Gk)-+f(ighQS2SnRZ&`rdBaZ$c>m8aP)~7q`VAzV*$z7M%Jged1}1dxVir1)`G3 z8|ctr4b`T<43rJw+~~$!-P`Ec=%!o7(tPEZr3hf=U2cmf^@rt5;9j0 z5Ym{-R_*2pN6&lof!SGaDP)=c2wcWYm2NiY;{|0^M2K*%;jXt(5go~NKA&;iAZmJf z9WI|Bd;BF4S&Dd)Wi-&AG!@RRF0WneXgLn)CLSSna%*b=3CH|rh_aI6WwE47O(idf z4DT~iDAk7H$hJnKJZg5t3meX>4!P#xRtvY%YrPg&f0f@zW>veG$1n+SmE|w-2gJ+( zqI%|pjQ#Cn@F3Am3Ja=lJ2QNUFrm1{0l^FFwfAp#%V(w~4E~NOgOX0mx15t&u|M^^ zC3e2EPtFxZLbYUPCol6%++@jHq((YNlCKr@8;(i|mh!kfgPBCL@1VPvIU5P8|<*YEA| zYxVkmoIl7lUp0R5*MI=hz*Tiszay0Re(Dn`{;|cuBtfy;LA4`N?RdxU>(cxBTmB26 zmY~M_pMFFC65AJ6i=Dw@;tp|cJemoM$?&;ywy7$Mk_rG0{ z?lVpt=Yq3c2bu$*)23-UDD8*ivkw>4Z-|hDLJpk}B`Jri$3v408+p-ucds4kA)|dI z!}-{{g?meLKePQolBml>p*$Y==28Ru`q7k25*Ij^rN9$sG{;Igz0uL4B}l1`-J!L1 zLZ!7xKoS8o5k+FmrL-mxl@^6!6If}Vc7Y5e6h=6crN9)6G9x-k4OZ1e^+m7B2wiyE z#{cMFQGRoVo1!&{P<%KY95G1>APpQjT+ip<4PE8?lWFm3m>GNhNMIm)eM-d7tG}#} zQ-gcyXxd!JByyPvk*nQ5-!{~`t>Qf+rLGokrQaVGCqd6GjZj`^O>}hiwejfgg6IQJ z{*8&=r%dQHV?3u`N}_!8V;4dZY#Th=M{jDz#7boV)hJS79Bgj>O9u9bmb!Y_Jy%;- zi?^S;da6EEB2Wsog3XZg*BBKzzPcKDRcBV^F>>z&^TZ^Gl=8PY)%kEbQNaPnh5(5C zIIHI4&ft@1@gQ9^DQxv|nP_sTj22R(1zwy0r2QjKAeQ%!J(W($L6@bw-d2kN)}fe9 zswcV^CpmwyuzrJXYeAo*Fjf3}SGh!|g0+~|gWB$f59CJfPp>tt2qn;b+$1vVo z)vstg5bkzoJmy9V3rqEb9PT-WW>2Fy8dC0MT<(#^KB_LN;wyo}mkmsAh~*87YF9^Y zpE4xLZdr4UOY9)@ZQEe&c{CX#3E|^&BxC}d5j=xw%X`!+)3~@^1`AajX3U0XrKo=Rz>ilYrYc z7BydxMBKrJ54VlYAx0@;4UF!c@9mh&n9$h}J`e^?DV)Z7_)sYvXm9;{4rHVRWFIC! z(g75yq94ENr|K#a18Lsj8Uhm@XrrI#EE0(_wnHwaMtqkkG;{!o|LWVy{q$s%5lXI- zWijYsr(W=bu)+QmVpY_FAdHNo#cHdqiEaO4+UtK0h6@U)LRJp=#ByCCV@5aCcLfnx z9ZSo%!kPhOF}S3*U|hw`ak^327kH`W+TYp-&I&Yw#oF8n)N=y}0&Yhtm_nBC3}{7u zHqKr#?rS5M2?ga9ObsEkiO|C)%HD5}H_Wt<`M5Lv^S(b%0@)E8JvTe}0^?9lU+zf3 z!$!7?kp>68fab~AGv6C)U@DB%mft}Gq(~iDk}%hcnuCvvZ&e0_Z%|FqbOx*|$lcvl z%u*gpgG^9-TeEL~DCgL#(+1mkff zrl`y$W*IlSFfvDsI|wh^s4*(-c;PJ7Wi~wqZeoZ#^_9)oep7O{dfc4t?sHn%gLO}h zo_yj07w(S77cnyfOoS$+jQLG^HFI7)YWDaNGcPE~ZV3EnU+K!7uFu5&vKg)wAgxSD zx|SAmiWaO`oWc{l4;S#5tKc}<3B=w}U;0?gLqH=Q(2Om*A)A?q<_w5Bea#%c@%XLz z32mJbo3xX`bEO=a>Z(&^u`+Z%<5uai# zqh?Me)T7lC@T&5ogM-jEbWys=#kDub2$UI z?;e(Izz7pWOO+~2+@MvI2ZQc2-oGc99B^t*Zj3+%m72J}wR9d7GIk8wP^WPwlW!tl z=R~%`6YB$ZR{4l`&Gpb+7qtA6IVgW~yC|kOWHh(To3$V}8nB2y$HA3i%!Q2|J^2%+ zSd<5^sF}s-w7%ECkO>>7OySGKjm3L8C_QtW)Sm-s#-vJ~Jp9ifD7+a(z~Nb`uvB$V zBYh4ceK2Y`rTAIp*Fw^QOJ=uE2RzaH%YEwJo`FupjKvn_cvXh5NXUgk8=Cj&{ab)X zPR*ojPbt`27E+mZd(*Kz^L$3TzkL}fwZI=SL%!xF_LteXD?9*f@%LrsT)z?BUlaBN+rElhcjl=sKsogL7TM)Y_y z|CiuBJAWr-fHBl>mpyk~SE2D!qkVP{rBCzRbv4DicwJh3R<0u-{Z2FJ%m1v!nw%7< zygWtAnp>QY8D2^`twc`N*e=%~M3wCgO2N78>o_@Q+m>Q+UTlM?rw%`^7I!b=S77f^ zl}mxxOa>|r`W!rIk!Ut`j!KppIt|mZb{qkNG{PQc=%MB8@8usq$0SvGXkkE3EksIU zXWpx&E(<{-a|( ziT@x;+5Rg|3ljsw|G|CsYVOAWr5O{p zwX`1F#D1RHhn1L27UJ9$(IN?;q#weV`!PRabA7TJV}|IrR-}!yXV|*3! z;%tG9GyN9c<_%qUyQw;4*UN`jX*wpq`mF~s3)8r365=+>gw1~E_j%TvX)zMzPD7N= z&~K@1*Il-EaL&G-95|L*^idvp?>;*wZ!XplubkI(Tr2&`WLCuC`iPtM@wSCCP-Uke zh0Uj0#8ZzNB$x5z>6b+|k3calme{_W5p>xNHUCNV&54|sZ7@V_wcX)y)sTiEKpIWx3yy+y$y6iZ&Z^&H)gy^te zz!rD)k$bwjRSI&HeiMxj$e4d_wB_-#$!n=>6Pb1O+FQLsU4MrQWo)78c@k$So?|a} zT?M6G+A~W*9uKFj215~W_a-eW3`GoqLWafVc@K$}>Tlsu@pYBCfHFgq8>^Mn8DzMp zpczCJ)d4E|*ACIIfFOBYrC>1VzS^b_I53By&jRiYRs0u!3RsTsgEL+*2L#5Al9b}y zHUh1Ecuq*DKzQca+@A-fdr$bg_MPTb{=6BJ~0pa=QFk8o%* z018qND4_Cfrp7@;wnD`~LMo+=eQqjpmCIF)^7*<(sp_Peis;#4O&2mebtm*bc|Qe? z0kN#hSt8`b{=ip5tIX9oBz_8a$~E9{TBSLPgBudD(&$HQbPWL{xN6*L8?PF|5zvs- z3_`zM(K){gKnxhB`yh#p<-W`qmwWX@!x+EJ{0n# zu>AoOsV9Fk%zU{_#W5wOtRlOM9zZ4Bgee4O{DhR(BUzd*a_wpCig|!TpQWS1G zbWo^KYzHpQBLAbyc8WJ>&nT))Uv^PWI1zhc8!ve;&EVQ_62Lg%ZMviZv2kxmiDonz zKx?corrc;UK7)7sIQGHLLPmrDctA7n#a9YW1@?0JXXPb-`kOM-xsWdtuzHUaBNvZ2 zvX(T|h^^zJPO6gQKt*pg4is20iN%V;!5t3F>a}u;=!qo%hxGzeXdL5hm&TXNLMzb zpJuFQlYDry5b>Km z2lsamk6m}426*Z?fQg?Qn%08FtdKQgQ7?tlI>9GWcP={9bx4V^poV|P)(stY^CkqaGwMqcrQ0=a+-87qr5M|O}47X2i+<) z*y#3l3oqPmGJ}XFpRF=~A$?E111_2p*zDWGk%#R9>EI|uideaRDni4ovX|IKrjQhJ zUTQfu16Rs7mg+|6dcAcNs(Qsl!$CBOesD^0pw^`(f@it`OTf!1AD$rwpkcDiRN%fV zIYWrvx*~BB$%O**xZlZ5R5gy5AN{MdXU+7uZ|YO;+I?n5u>9FcpLKA1@%Hn~%_><@ zNp-esstd`A>BrPe9H7)r4x^X9lX)+Hr!%AA$UYx=F|brL3c8T9M4tWt73&7~4zq`a zgE@h1{!2Ci92cbtY=s~`>$#kxZIiD7Kv>}t-x}=5$#{#8J7oY!;MgO)Dk=$$3S=cg zum2`a=>(z!;*p-dp8X$dfJ#AnT}N!O`bpWQ@w{O%KA+9!-JyCk~MJZ*(%0_QX&CWmJ-%)7Zd56ep9hWO z<5inffv4i!QudVAp4}5#GmdVZ`|^$$F@Jn|wYwo%I={7`L2ZTXn}aW0y(L*_eL* z&RY);KX5FM+sr{ALcVR`rZoL`eyKM8*CIEn;703nq_J@OLlVDZ(0KcmzE|(Zl{kY) z3nL-=lF@8yGmoDcMOcsuYI|6dn=q2qu96^$p=FzLy0I$FjoN|@)D+Rx#|I?GMh#W4;y~f{qn}#sRo&P1 zZ`DpOP|nwZQ$-f3k&e&pm1+rFJ#srC!&bi|^YGTw#pWR*yYll_W+*DgYE<3lVf{@I zJY0@H+G|2l;j5L33n72mP(%5tt~(FOup^5qiuhIx?qae8th^|V=^>}{WaEAT#%DRr zJJd|VDNohyXVsBrCJtI8g$6%!Kg21OOefT3J210{0dEiD`lB%Dh#tBbZDPCL3wHmR zWN%_fltoO(OHdHps4#4}+op;hGPw6APFeHzUNw0-X;h`dP5-;>A|XpIA|@(Q7*YU2 zO(Qyg&BcCyeXP>q44Pe<+*Ga z115QYoL28%ihq8EL$L5YHWsm;YcA}pcKi%77lQ#+=ILoNLP!?J`D|Ubnr8TkZ_T{v z7a^uFMZPhd+|mM7ZHcaxr6A#pRxJl-!Yc*Su)0dl6So*eo4GPk-Tus_*V%zgpY5f%t~O{gwk*ssH1d-?>CGGAIY5$y z7nJry_Er&5KrLoVLOWi(s(yPuV*(|Q6jAX>oG|8WBp}@J-nUHHUAd3Vrwb2Pe5l30 z{Q@dRx$m$A-MT96pW{b1bb~U@@=pa8*}SM>lp%{kmt-L!7(f56mwl9jI{gECSAU8y zB;c!H|Hpc)N++1Fwj?5z+0>|LT~zmFl)&vhd|UpWZ0goJd|1QP%{^Zv+-wHq?((5W zN-PAaMzTmG0v+qq(}HEF2TH~;QLvXvtze`xNl2syO0NT@c_nb3fii)_idbsc9YQoLDar1z8O0Y>B|&I&e&XJx1)wc@picku@C$~`ugGS? zkPV)ZM(kOBKYqBVaUVd=ahiJ!(#mKOIk7uOEJ82{Z>z9?)=p!0i4oZ`4o>)9UX+q( zteiAx!J!!~y zLDUn%69l#{{hechmid*5nZi4K^RG$J51Ku7d+AW|cD+fzQeAE%lsaDm8}^Z{^A%!k znJ?zGkmfp!D!g)_iwWZ5cI)#}W3}W0PmD8A#MaSeRWWq+FDRBw;5uZ0WIDskcV8UB z?4|Lm<1X$%xfN6%uxk&Hbfp&we=@~&p=4YUT#oThR{pCxGi)V*hCdf^J2F` zg%Dk4F!~-_{##`k(aVfOKJv=!J8^q2t`U;67Px5&!L|eN*_VAd5bUzLE5eUXjj+$< z$j(adq))!(Vc@-wCSQ>$MVOaWmhg;DBV0JXgt&rbX7DIAb>O3MH3rE`V)uQCh&?W0w7>c5Pp8A<^#ZZvQ#`0S8_h)Ss7V4c9(7`h|Zvz@0M!l36IhxJ0hxitqM9t z)$J#K&N|Va6|D#bnDtSynriE+qfA~wng(D7Y$GT36(tzX9q*X_F)}WVy7Ot+e2$3h zWKCpBS6tzjt;Lj(Y0)*nN;6UX)OhamDB;@fCZV?juSR*f6#x3gV^gG?#gYBDjV=p3 zp_U5*fJQXfZjCtn58kX$0Hx7GOd>_o7>T1cRo|SMureepD=;0ryXmW!C>@Bhs7ej`UG^~ZqVc>SEM8hA|L0WX)JI= z89=hmmps6=3xswi(ysDY*t=ppqepc-VB)E`a3RADo~i~`eryp-6RVy|MKs(<%v*gp zo7DNn$uNCfVdbwjJ1ye{;P}{<(ll2S(h9R7<657!xME< zp>V6;uYUuw>lTs5cb3O3cfm#mJ?-P?w7P7!LfFqSEIbW?7{Sf2A{Dkib$#%kE{KUWQNT}fnCIa{=m?8pWL6C>y-9SR&5kr1oayuHR ztdql$tmF&xb$8lZP`T7zx59pUWO|EG#xq=`ZG7HEsS~(a1RW|O(@i`HwODamppjkF zGbH|H3)r)@0)H2VII|x#+q~|l%eB7tPpaJOk<1wO!uP@H0c14TKqQN4oNeVFge-6$ z_VQ2TICnA1{Vs^IEp*aL_7%QNs(c;Ail_wigfg86{~4XtWi;c)!SO zT+rcbFMtv4mv}dPR_L;-2Qh6P&u)a#=59bYfUp*CtL%ODPc4+EgT%>8%w~ zRT0I|Lc&Z-_+VMJ(Y?{gIp;<77q zPRvpml+KPMs(Z%|wNps}-&4IRL$jj;#>8Wil7gfQK5h0u5U8!|v<*QN3t?W5icUm`P~i0>)w=TG-DE`LZ7X#=S8n6m190n zOsF^ss@a?~dj4`WtXq+;-m-&=Ji!fv{`IMeD+?Cgcf1H8ub9#{gj^$Dvak1v@JCL* za@LqY4Ul6QFg^x;uem@2(#Y^R@3D^8L|GK6;B1kIIG*2H3u+$^N~W=MhNO_H;5Q~S z^ZrRqflK$y5Hf?|Z^xdqVgQ-~>S!dKUXi!3Q&qb}0@RV2F6Yg)s=FwOL19ZLDgDe4 z2rBqgt)YK15&|JIXUd?!o3pj#$J~A5|_>>|v|olhkP+6@65ku6`3V+B5*QIJjs>Yv?WIi=2d0GOFOAkWs(o-9~t zj%eZQ_#QrH&*02?E>D0f*!O3k;4T?Atkam>`I&>{5l-5#X7zM{A296fJ zpORs&=ka4)zK=5;Zl>{}e!>RVJ48TqU9TTovOgLmKr9Bn{3$Lp`T^!g?s}7D4`Oms z`iD~b*;#ZGX8m9dD89l?z&Og|FTqyg^Ruj~NQx8L8fnHj27L0vQh1V_CRZEDfKt(r z$x!em?${DL408%E=mrm8U`X5_A@ojPE#3~Xq=0X`v}>3|?eG>nDgq4qiW6?5UKllp zS(Eg1huN#(e(m5)XkPF{8LG!j4B}?FBB1ls&0q&5ZwK%sw*k)fTj#wP5Hb7pPZ_Mt>EvF5mHPIq~o5 zwaQ1hi_nh%^yROXbg!?FA5))@y!6S_Fhf2u23*oe;nT}RMaq{*bg0OeidX*?2Aw2= zdJu`F7D&)3{e4+I9?aS!=u9SB8FWGywGz_QIj=To<#z8*Gu`G{gizSad_;O;X93z7 zYN033zSku0tH2RbmoRZ?n-f728F~zhj^9~#0^K6n->tC5@3?4tE<0t?O(=+*xwyL8 zBBoMcgIpF+hAH+Jaf$!3pXk1-yBm860ZGQw(q#|r!`HWi8i$Ob7w=rk^40r+a$tKO zHm2anA6cCVD6R3e6LMb)1N*75^^*9sZEW;K8@41vPL;m1Xvj%)YGYV?J=teteC!ADt+eB&A+&Adx|5FG|mL89$u%L;z=3e^|z-XVoGK zdqf;GrxCbOiW9IaA7=)&>xL+l%KM%1vGD@461jV(1FG-F%>T#0T8f?4VZ zAOw@F98bIOTqUC-mA56`69NUwb~_vkX@F__xwYvBDCem(s-ANl9%>|00;VFQ<+(hU zK(+HPh5m|ueMnKxk0z1^KG!s@V?4d1p8zG@SO0^KNal@!)^p>ify%?p&D?r738p<3 zj2=AGto<#WM9=~U7sh`(oiiO=m`sxLn5OV+X3*`P)aFNTu;szwH6MU_YjL?*MdWs!bc^D6yQ?&EN@FX0pgXEcKg41k;n;H&k|!`f_@^8uqA z4}Ui#f0#Nvn>cJZkK7`<=V9$$Ebr*nQ=Ntul@tcEzSJZ=hT0>2!mWjaI+whD>V*Or#g&8p=L<_1ItVw0H7|u_kR7z-;CsP)9 zJk{w%Q+eo`0s2uVCQKiU-=09jvsU1{?A%X{&rAR1ptEf1wrJGjkU)~}>%!MM=BnWO zuEb&^j9a!Jh$^*=R^Cp+e*OA<)^p^`29c*5S)M${U4uIMq>G`=BcD6&c+O9$HEJ_5 ztwx$9GGN>`axb3^2BLW-5~GCPB2Q~7-3>K2LU>b)b$eSIVWaB$v8n!wlq!>QtUJK zl;=G3`!n)oBG^X5V6#zLGHQmcI#i5wkc)PeCugyC-B^IZCwz^FMGm6*a1!1Cx^wPtijp*mLk((AFUn^_RVF9#a}Tx$-d)B&(WlM_3~ zf$uxyz#v@{rD>OQRTFa#;fK%q`eXl_WPITZ1j<$xlZ3hPklN1;!lRd<^7!M7>13ck zqGm3di9Q^yXlT#9;A@4!UT1ev^Leeaa@inV#53e59w0(JqkP;S?Lk3~_wIREE=Kyp zfuCqb;IUt8EP-Lu^5mJ7zJ_Z=bm4vN_}8(b{{Es90l1#wX`E1>;DloegRP%?lW2m2 z^Z<$iV)6irCt)L!MPMp`=yiDBKr}UFyu}iDU{sefVAWLPhdI5>5z3ZAM~+Ts3!)Ak z1xFDT)U7v$2iO0<}udxo5DsJVe_;3>iu8W%`C0zn*c4p>h}CUYm>Au zU!u2{9+5vxIc;eSe=JB#59(BpD)tHA+0hS3rQy&v0VT*Td({)3>+4PgGDQ2pI~!H6 zUqM(RCqT2HP;H=WoMLF9%#xH~)*z}dPi0%L#)WEE-nW%R>OV^xnJo&P9OZN6oc%+%OmA9x;^x zI1yJIbL8vj+%>|D9sf>7C!;^;{fqul{dYQd6!zQcGG3!?qFVi@SKC~F0V8-4R>;8> z-_css4Y?;hp(25Pt$)HB;avqMSLjHcom|8!q#fKA{TULS5`FkD&l{#u!qBtAP%q z@#rQg5$eC=#bbMu8M*J5QMBtz4iqqBcK=4?2)d`47O1t3V;DlTpWnkx3=a49@G^!E z4`lvpuQ{>nEl*_HJ32@~(|7AM)@eKS7Q_8n1Y0AxQ5kluF0O_7hoi*_kRcDWQKbiA zs8u-dwdCSuo(DkA2e|zTuk}qO7&ipzPCB&t! zN5Z04BH}(3lwss7(G2Jbr6RFWf%Ljpg_!R<*t9rsV((vUDm?Njn3>X46`4CPDM;+?zm zpe544Pwrx0F=rMAqyzcmhAB)_l^d#n3X4qOZn}@)tZmr32N%xKP^OxM7jp7OitGA7 z4MEbB`fQY7o{qdnfFZfyCI!5%BvK@%29pqbvK!cHdLGDa)}tXZH`HB(EWilKP)j!B zPH@#clpv_0w(HGGJ^~?=SB$5-mmb$ARU7@KK@_yVkApe2=op7P-NHOXd-_)N?lz}4 z;Rx%+Lv$WyCVA{AgB*ft)UbzBJr*0odWSNQRe1)*>y3yYyjY)aHwHOCAee=ivBMx3Sl_8OOg^d$#Kn5WaDmGyaMqzH1RdXv z=Z6S!DxVlLxB2hI=pezn*`??c?M$H3vb3xm8EP7a3c71Elfw+8*kjW$Y{k+@&cz?C z<9O<=NmSn~sgPo;Cv!vqN$WAAPW*s>;oDM24C-?I~J&^2Ckf=MPC!bN2S!| z3zuhJlYoM?nNl~%^pnY#{@-CD-=cuBQPfk*<>#BW>4(F`ne;khaQQ)CEq)Tc3RFK0 zkHS5bkH$ixnf>|Qc$z7Lv92A%;6VN5+}PXkYEO1labQA*@(OmVryAOk0{YRTT0g4a z+JwbTtqAK8x=T7vcA3xisl70Msu)T2@Zpj8C-C?s0eRYZ?@aiDda#Lx$7{((^3&6b zr-|wP8}%i_P4T+rvvE!qL1A7K2j>UzE8|FbmVyE(R&-io z)(gDRd$V+OfGNHaMo^NCSoGoP8lZn!lhm>HTdfcK9$?%=Ix7p|+~h8v7p`}8;QY8% z+dHTE-u>eJ<)}OYkUF)n^xhk4@UrlH?BtLAZ* zC0+km(L{H#n1C_eYTnlIW^B|x^+IyyCRjR3A2OXJ+fWYnvMDxj?=r9QYJ=5~bZ*QA z;W8EO{$9?h(CjojEro@NWIi{L60JM zY_||T;P&(~z}47w(UyQC&|EDw&3}n;r%TC7kb5= zF~EOQnExB*hn1P*{~JZW){_3SIr4w&>^%szNaHE&KUqfNp2^0eCC`)-fY1hM2@(Q8 z64fueW!`um3BXBC$4QmREm3<2XXmG@`tZp$0I8QC-)ou>x`M)mcdT!yu zYlf{8zt>>$wlCnf%_bk3cyKS=23@?GlzP3%Pqgg^>9h?cCYeQM}A<;!NUA_0h3X&IC5*>)EC{<|=T9wUGCCu@=@Ap3-7LA5 zoy1P&?pZY2)i3(TPohXO%aN$~>A~tj#wbfklx6X|l%4U#lE}2J;G$*l5)jq9$;;(~ z@PhCO_Hou{O~6g~YwarTY#fx4CmCA8UxdCI0t~&LhJraIWWI-_50fyGh}%#SVfu~8 zL)QE6N6Uz8)mdt`36ITslSPXbbPK`T*`2btbVD+UF`!!R`^}z-F|24vFrLmWPj~(Lf@o)M14@QK{N*U;K2YYquBPT zL0=V4S2}%?C!Wn!4SGKuh5#}ZK^{sLAPI8_)#@VWd{(sz%~t_l+*bt;n?5^FW2{*8 zllj$}3s8X~NitMFNcQKP)tba+hE0$&`F=>~86EI#&K87TMb19N(j z$9p|pydq0qDnO>N;2|4)I+2d0h0?WxKj*S-BQ245|>`Lzw2c9OxTns$YEp3fPuJS z&1gUEs4jC`)ohvHB~+xN1dSb9zk787_60lNEBEelZpYV-+cEKW>-hmQd7j zPJbnv8At-*#2N+(%q=t1tTD=zQ~3enG}kQZ0V~X>3(}{Hm2}n-Vkh9-ak}x$9)%R; z*j<9GqaQF#@KKOg)L~^oHq_&Sv)tOtSWWh3gQ_#iP-eKE(gu}7_w6kFcv=XAsmlXU z-K7zDr9@$cB%FdU%$XS@0V9}+!+g+(_6T!|g!ReYZSf_UT3 zV}Kgtyl&N~B!)wK-3N)?>;gartCQ<>SxcXiFb}cU^nN%L$^avlXv$aaxwJIh!?o@~ zqG-E1$?X8?56Dg;Zmg)Z)`mnu{F1fVe46A~ZkTAC@R7PEEO*E{02_F_5VQ35Hs&%t z49*oVb_L~rJ5o|{IMO#APPu)_QakE!b}Z!8>+=q~M}h6EKaPI|!OZI_%`}vsd>PGS ztpgsv*Pi`MOcG}9`nSiT(e>Gtgu;23Z%#)XyJmc`JA|+8vSdeY$XRgt)n&~4oSlfp z^W9^4Dk+5>@*kt7aA?D9g*$PmkymjNx* z5ru(M)Su);lOe}fVeb1Kos<>v#$_x2vBuk+$$BD|SJX>(F{wgs<-n!GQ-6BwiTe;Lx(o%hCYw=;t&fKHU}x@1N;hbH&j<3q469mEP@cO2oFh1MjR)>DvjEz-jrH z6;Bl)uavX%c)*tnO%q<1+0LZj;gNAdht{DW;(*XVp7fc2 z+l!>Dp78U->bJJj2g@TqAj%g0aHn)!pb|!4U{A8vPPMVsy|YC0>}|}DGX4aMZf#-O z8%Qcu4`I7QFc2>o??eBt2*I)hZym~PHE5D&su)h~XZaDpLOZvia8vH?}T z@B{qbi!fK6*3L#aRh;@^bVu&TUTO$Z3CYvbU;66J#+dbS>oaNA%nb`oOq3)Z((M^T zF|y9r#j?%iKg7HlV@rc@0S#uF5KlYmg9Cd@s9^uX;I-W#t4Jj3G0?z^9a%~2A5Wb&7H*$HV$uvr&>JKaoUXXJ=M;kQn4V~~> z+AXf+(lsRHmqh-bu$;v-rWMaSgaY+~Celk&qZ#&L%!g<35n_~|^AyH+^sy`9XZY;% zRqix}l;expV(gm{7ZFZL(74++c89-JA&wNCsso(yZ&+oy?zs1P;=QRCI-1&SzZ-KxxSd@`F{^P3$wmb|@b~dZ#o3>mXoqC zz%M94rv9yqd;x*U&mh-Lo65u?c~QoS+Q>q?{(nn<(@5^K=Ty2;mI`qG(PD5!vqwIn zp^HScC$3)iuN@RvMUgfuA=5paE>RUGdsVsx7H0QoXc*V!02IXG|DCF96|fk2k`Bd# zzWo0ATm0*~Ye$iII(`WARmKSl5)oUQOmrm`kzxlyWF#6MeqoD{!Ge`A!JN-vck~zg z*^scl%(swJxpAgzch^CL5!!GNMXF%>xB>&}82YRC3NMR2!61b^E)Ie5Mb@4UV^CWq z0%ZVk)yfUH%MTU{{+3s_^teuTYLk>5`!4I5rZk`4L=+Mu4mA6yn<;$dP2U9n(}J-g zjNb(2Ap_Ct7Hvh4^4zZi<)8Q)oW-pbZ(Hc)t!5wh5%dC!8^(J}&_r5qlP!$WiTFgt%_W*K?8 z6Ku)(TnbwtXB(%E1HTFX@lPd7X2ywnl?oTJUp5-zM#zZe$~j^xc#%P05d=3C@Vv== z05w%YBP&!gh)T=5ymplw{Duzhd?_YksfuPi4g}K@NtP{k03}AJaI3&o+sSLP#=5gJ z#rrJI=rM#LhjZW+08`4{!Y+@NZ7*hO7#WWqXASe%u3|E$W)JbcpY&`31RigksOCLi zGvw{;Nae(XH+kBiI?G1t$g?p}dmjKzM3<0za$kkngx#zFy#YDO#XmaSEB@(O<;P3V zU;trZjj>1NRV7fM3l&QxwDENa0Qc^gxqqs&}_(xu?H=&|d!AnPB`57`m;}m-Q zpoh0j-F7GNa?cbuK&8}3h%ql_X&^hwoW8REvdlNM8J12bA2Ce<;)v@?Rb08%By+Xq zT^s29$-@nOumXDSof3G}xDKlPNv9o_yQXE2{8J6qSJR$1_;m{0z?;n3UCEH#34N8c zi!vi1-hJdcNz%FX0{nC8PUxQKZs0y?Uv&RCioF?V`A z#J#fm=gE9M0~w`Pz-wE;Jz(vx+E0GSm|c?XX9bL5F5PZA`C-Dv9$7a@9JOop9 z81n`45$u`}o$N}%T>se_Lp$l68m@1I-!Njxd*OiG{%g1zN*v4?O^;TLj%#?`&1>{P z7;zAR+CQ4$t>-GyBo9mnM%MN_4BxK!T46_m{B4z~!ay%^43@bC6C(HFK)2BTQPfX< zOqzbp_+V0PP#rL7k0bS#YPt^Rawtj0{0#b*=2|`i7a3MS(Bz6Ioi~S%eV+Esl^4DO z;r1e3)Vuwy^bI2lJpEoc&5>gNGpTGb^n!w-jl2c3NZXt!kVVKeO&@RUhuENqfQ;`&i94I z0-@+c6)$C9x*%P81TP%4=9-U|&(5F$hHTP(Un+m#RY%heJTrg0CRk^X0sD8`wjYrizHWK7a6 zVR7Gps;jU8>KEbchk4nle6l}o4D1z1S9gPPPXSS-$O|?EZhJ>_JX!&sy%yAvJ*fEVi_#buL8p z!Ip2(Hn{MkA!Q35BpcuQYIB-facp_dePm6MvTOF}8R;CKh3^55);|y_llf+~DAy|h;Uw*J{?BSre@^ilhXlYwquMR}yk!*w%78gi9kYwG87 zYQ`CJAuo<=%@ z2hmqu5Vk@Pf|(V*REyzCo*v(7&H03oLk%bJmgC!DSIN0O<7gvZWd<^sr0_R(xu!;;N-2|lmW@K0SF{CIN=G5E z1|Yy6#2<-5T#||8IzMX~hAa9xu(tqg%@NkFiB5)@KxGWocur}N@Hdw|!OJG7i9jIf zz_N}sl~Sg;NVKhr%eMw(j?I%`G1(8BW@?3v_H;&U?2`I@1U)sf*_pL-w0-P_n7WMv zrUIssp+ePw-ke+7OQgsaGK~`3J?PBi($XbpckCx7BljHDG8k3_wywN|i)5y12IGi@ z2vgm1FERV%dIeJfKZu83vNfSEIFNmRJkp3E!7vCfn0YGxc_sar^R%bfq7YX%k4|AM zLN`BIpWo;UjN&-V(T+pxoo#+X*2lF-Vjx>$+8&_&6b%{N2OM zz2Uac!){&QlPrLl*Xw@tRpW*T;-VN>fKVj+RCxH!R5c0G&&zKfTy8potL~_*3a0qq z1bGhRS6S)U?=ip{-ONftL8#k;F%Y?*m;y=xKN04$yw?q>7r9#3sln?vGx&Hc7A#Yb=%UQp zDd=Knz8u@PRU31WlT7qewqSdO=U)Mk?2lf}xtmCac>Te)lE*3-#vQBu*#rtYruabG z;!jt7m`c8=c62s+YXY>56HWOpOSVaba$MQew4@y@Q)M-DvN~F{!KL6cMJSMUs*PFF za$Urn1+Zum0?{|k{aG1`20INko-KZCLYOEke9l%q6%7YE}iJ^^!%r`$UFciGKJ=>m!LV@1cE%TRK zeM6}EdU00pH-vkq7_J9dm4q+R(=&~Zw(4W&ZI96gV;QQb#%pxf%F0o%sbU_)-`bn- zWx%#}8yjQ|Iz!2p0fO=Q_&YM!3ZnxGFWoMJWi&(WDz zLs8xMt6cjjG>v~7cW8j6+>WD)UG-ymq2lYJ+yNb~#L>>3Q2z)HU4DAeb#5PFc;irg zGy&KAT5M#urxo8feN}Zo*T!aJzDU*3ONW`K`!CWTJy{?SGR9S)YSE2Lpm6Xnxw!V$ zK-FCOOI1d?vXl^Bg}2L(QTZ6MR@duocYol}qj|Ca@|)!N-xv_=Z2wVhFs!v6w>gID zJF5~klNUOLFL!u!HSm{W2GS{jG4j#h!Qj)0H5DNbB^Q*f!Q# z>%6_ikP|jk%XUG{)fx}NAiHi1!XQeeF7a$>307keu4#~WpA<3~HH&rj`8ODOk9TG? z?1Uk|<~T5UBgpEf0G0Gu*HXF_9!`d~52_gT7Vfu*=dj_Fh9$>1;B=k0r2?NkUK*F` z;a^7Xj4ndaNTAbp%}1jw%p{qt60PcEbIJY<7gO+XRdSWt;d!AB?mcL-*|3A#SyHIk z%tc~54YQ^iSlvznblYFvdz%~gQK<=)3d@_R=@lQ;{S$fuX0QGg4qrhEW<5Enwj^S8 zX!|Igffb?rztetZ&HYoH4JT6$A|@vR|UcFYN7=)Ua*b&C0=^CK{j$^RrC3IFMIuknHeQn;>RgEGO8jYJ8ZCo zv(>>!Krx`XkWek^;_4gIS)Ow3riJGQj9qrSvp4udP41JdthC;J!*-!Y2Li&riQX{5 zBCSw@VF0ju>)?X+cj|x9|23TE)n#G{EzqZs<6i_yP**%tZRrTNWep|4F;CNGs9(eV zWC&eL;prWo25q_}I3{$+M=Nns+CYec*{F#^Wdk(7*xymgk?dR~hWe_SI2E>lwuoG`k2PPE2gWBDoc0z(k030p@Yhk7?P)nhRynVgHY)>^mW5%qY`S zS&Z`;WKf#_pdc8j@6pD&34kJ2&KxuVdv@4HZEQei2UI|HZK%ciMe^k|!Gj&R9Hfr3 zWW6$<=VS3VXkG(ArBsI<4xTCV2Elp?I|zyx>LndZ^BPfDcgB4J8%I|U?IMW<(9OIO z5xVgGyx$_$n(_ByrA7~6*pfZ~i-7?vyemhO6C{*?tuK0X-&9uCTpD@BtH8dQl|Yyz zZDj>z+($hnOZ}5U7>yNIRDg(xvo~fj;YCT#YFJZGu=G)(kiHDr6fnCAi)Nvnwrz=t zv6*6F&dEXjPf0b$E4b-;MEa7j{&mYt3B2aQSn`>MfVEPh$-Y_$l_#1s`B+1uvVDLh z02mB{N!^Y*dD>=hJOg#I;5+EE(Jmz~JK&9qcXe!Vx{ZT<_}3doQ1i)~N~+I$TSa(F zm0;NbHqD1Ox5~}7xK4~N==AqP>#u*sJ#dKAYy?OYSn`%{aEOch#_?S|+N=h*FQKO6 z^dHBO@s~>og-e8NBLm)xT|fGJ!Or#8bg5Iua6`?-=C6lhr|_e7vg~Q=m?)nUudyC@|GR-aK~jJdi8AyimI5d; z+~|y=CDd{0P33c)w`(-zN3@u+PT;b~UybLUD?Q*oDWTZhwnJz(pd`1H{8;e?fQ#N| z^zeg}5jWW=2u4^W`8t-U2AcLoRuJl>2u zaP`$sLZj=O%E6kZ02VEP;_oN zD*5Ucqgl%i^FUOV7!EfKILv6=4)T?Pdyj5yuk#r|Gkr!} z9~FuJWR${WUh=304^9^g zzH<`LAz`#tt>rM#CoDa9I#cDiq%}IO!Trk14ZAR{N(jF6&EKSF>c}N2q_Yq0OSo<* zsN4iJso3zfUNiol?o!#u`}w*Q2fOz6i#Uw2k6%afN2 zi?(7?iNlF-OvpYV2O(@e*0i z&rLV%s@isIkG);pK*%&?rIw&h)p^qycWToF*p_w6?y_y$wr$(CZQC}wY<^|iHo9!P`t;ft``PO`^J4ymyvUImBjSy< zE~R~OHBae_&#ZWM3g&3Qu24LJt--;wZ&-vjrrr;|6d+O^n7-~Q6^klb$|SI$>%;3BPCA56wFOsPbLTh)#SSL5q1=9%2G^q2?GWCgmVELrwKB>J2U1i_s%odLqyaBNqOyJc|1RZ82hZT7k{CU zir6nJ%JR>~dmPeC&=A-hU&n7~ikdq${n!{_#6I#)XEtujOGunkfc10mIJZD6dTFF8 zn=6@#@&+pwMdDW-*rZS{^$#AjtN+z-(J)B~76Ff+>+=57QrZMU7#JgLz5;wc{v8Lr z1f?B}^;(Kqt?Xb#%otjNlgI@7GEIutel}!hd=a z|5tS!Oq@*r3+d6L`G1w8wuni+kq2@m+Hl|=v-Jiv%M?CRc5_F}v21%#4k_BrVKAr^pg8N9N;!5*{cXDH|VXy_} zgxNI*vsnvj9kipwjZ9)r9q-fXWW zI`rJpN(0+-aCL`=GC@I9r znlL$_Uh3;hNDv3xw=kZ&KQ4it4T|q;^u8L|H1S-|7il5&WM=K;HyHG`gkerP6 z3g=-h0#I`$tDquO2V;%xiy}Z6f#*Wm)`BgZ3{qD!+{+#Jol#h!B2C^gn=#6GWH7d| zDY)?3SNnx@P>)b_EF$>v;@8Rv4yO2j(LoT#`ed*&_Ge~}Z=E)tb8|MA zT5V&YgdW7Eq{fx^z(9Zk;l09^b73ZuSNKzl3?fgUDOvHyoO8H50TFT+Lh@()%SI&u zkN6^4@9{s3tLbJtW~GQ8zw4c%7+m_Qn1nT^fC@q}fzGXs5?b=tc9|n&Y*=-Cz4$AW zYHTui9x+igBGb5JOt4YJHrHF-1K|91!xP}-$tI3tQGv#Ykvo(}O0+{l_VfbbvlRaQHS~K9Kp#h2FX(M=rN+0!M1Wt*uWs2M@h=`;9t7zy%$E4na zJQyRkwD8^<{fZQv)Pc^LwZaD1uScwXPU0Injz(%@*d|bz2da}QAG3D8wgncPUVJNO zO{=A6)rUk$K&~3S>g?BsKOa?C`1LzaJ662uAhH9iMlJWuw?zykmKx&Z@PVHltpK7E zZkxvGKP*(($MPlFh1ROf-ho|-i3%3rn2ux6V0pg zcYI?0^JCWn<#mq%@{97ZfvSzPlCDjzAvtt3(>5)XZXdz1nU`4p^z_>qFM~_Q)jaiR z-rbg&)p%C#arrC+b2h^I)<+`&Cc*>d`%hd&!R3S-tC`W3b<1#T;-}Y=+nkty20TtB zgmOEy7D>LF9c;!19jYSl*yNedeSSR}X1iatybh?p(!tj+7`3r&B}Lri1oMiul+4tjO_;RZoy}6AfvDAvhRSMT(MG}*@pg-xzc|7bl*Fl@#}jv z5;$qbw(I?T$k^cZS{W-+Y5r_*$PvyNv{Q;Zr_T_3L`^&N0UFHD_=F}cY|K-YRco=n zQuCL;_FJsM?GXNcUABgJ6?||Y*AiO1eW}+o^W7Li7Z~4W|4gPseBL>*sM_G_x0HKE zh{TM(`0xr@Bds%3XRmOcuP66)K5^tkaNLa_h)_tHq8Ku@T?9l;B#>Yk_8Xt(&1_QK zAomqI^TLQP{qa5wum^hm7v-M3YXUy`!3^phoK?)fg3FSn$Y9$0fot~}$~avp*!zZ5 zB7D~WPZRdPLcFsuvi>i`d+YzWj643vW&GP&%X(@M*a|lJ80LIq}UFUw)qQ4_T?Eqf_iZD%goBu+UyM0+#cv_IjV^ z6hdV+aHO*B%|Y&;l7+1yXdnO3qZOGDyW6fPLcl_B# zcd82-a>&C9G~+4EE6LYgtF8L*3D%OypNYsxD@4nu1wJ4k%)FfK<8biIo$4d+X^6?B zAB~>amL`t8L4(&KW(X}znad&(d(x*?Yp1{5=@00j9S$Dc`o3y+=yA=4!br27=P4*u zl|Mf^`7k1eG};R)MtQT!J$W;)H=kWw0h_Ik^ysU?oy1w=J(8nSNGW;dqSnU*r1JDI zRft$&;iR3*1B8a+;Q(nFo=l;yXS_021JGdqfOq!AcnpV$mUNg+= z$UaQ98PE>hn>g!4$)K`uJQnb^pLolxNrC0Drj_tb5be=W#0Lw$q_sI6SDWkohW^}d zdJBbl`~?Z+7se#8LYC!2=z%#)fBZIDc5=?|b`pLkQq!nuBs{0H3 zKY!QkzYi=EC|w#>$)(s}@n7wbHgqJ(-+- zl_yKqbwga^JRkMdKDaOBoy3lJ@9~^U1V@)LUBAz_-i)cJ5HyCxtAFspwI^8!ka* zh)&uX7f}F$+>8EY(L7^ysOClje)C;`XMaEFLEpiz>$^(^U{Eg;2)y{KbL15ZYI3N=~4O_oFyzx!HY zfOJ5hcE}@|!~h@(Z$|A7x;8miFneD{uzmhKTY?AnXmvu{$4-Dz#_$Ys2kSrj-DuN*z z*wb`gG{wXNReOb)%QA8pqK&Ex> z5LJw2|26k1C|!tXX*CPyx@WZ2`~y9ME+IFedNEi`HT&a@6fuqLvRrOL@R%ak9xaTY zbq7!~?_|(ygP?*7QAcBrKW7ADr}w+@H)uByd!-Hbb9?Ulo?4%}2oOfgs8C9sQG$(r z6VBW|fl`Z0h77j#BX>PmeiVpxdeB8+ARn?~M_JYQwpjq^s81PAWY$pYmL6OksW~3Q zHxNfDVkaf$sa!|{V#}JS#F-ccUdao&k_@i`gYTHX3~<@&XA@c_`TaSG!XO7#wC|Rf z-_d+1q4Zqc9;wW?{cdQ2?>mu9+8}WdZ5?ukLGlP`J*8O%l0?Dm7t(iz=PO8<7=Pmf z=VydpOh9>&r+F7TBH3lC2vkXukvVeAj6b+NC86FC>7&)M51UN08& z{cIh)lBK$o^VBPT0b+e9?q3|$4LTLA-tFDHu|1x!?ZSRLwm?y+RfeLG)<-b4LU3_F zaBJ-2)`!T3Zw<;B%3?70xS0ltSi9m@4R`tyK2l|Y)SWvf^`woBh-$|{%;-dX79+1< z>aaI15ki!{C1n+XKak;5PQf~su;-;`x(`E6$t{=iP|rkPDYC!JppnUR~RqIpA z-S9WhN=KIIy5-vT!-`+BaTJ@$F-K;b-7)`|B%^}Xi`T<{Bds>2#5L_wi?N0lPt8PR z+4cw%UP~u?5jxyNeD4StQ?@4CQ0C_d6v9U@5t1b{QD1MICCV^4o;i%CgcjVJ6!ac0 ze9oefRv6tE+{Laj5WZ!;&IM?PiUf$w;_&A#?%2XfL_U)t1 zg;^0j?`od<&;C{5w3P}HXcy^^^Q$C)kzD+Q$+EOZp+XdPD&&m zn_V(w@$)@jSGwNEndb{iz7)t+Ui9hj{#2#ph_7$@C=oMg#*~-|e0?pr(9*((hgH_^ zcfvpDw0*;Z<-9hg(r>aRjeqK$kp->u$7N|klN$n6IW)T`9S-sHW8!<>=?MqI7tg!J ztZm>{0U`%KA$tvCOiewedi8D}cZr6ZhHg!6D_m+A4?Lj*cjlF~*(?Fl(RT>+>ZFlT z&SZ$HY5R>9F#u};K9aZaEJH2mhW8dle4`do5J6M+t=wp!#i{EbgG{%=g1+=xFPCRb zM06g})U6wMx%|B!5Wi+5%)0K27HFED7We?Cw4Fsa}-mnE?_F3$_?hyx&qRX( zNqrXwY_vl)@9WQYDV~y)CDD`XY2AbMn3gf$gvCPA>Y;*8#mv(HV+K zho|k5aGyPv7?B`M_T|S3E~{zhW~*t!T`oBkKlUIAkdMWkrRqTYt|I|g6tZtJWECQf zEH|Ud#6pewiRS9XUpC|AXx0Iw;Rd6wMGsry z>djd=?;}os6A3#ei@!N798_!>3r!kbikkHzv$cOsehmcx+mf#d{D;p1*M9}y zXJTdiUk>vXjsGjh%>y?EMWQ)$wJ7v(+Jw^zX?S2v`y`Tep_51b^OxWE?G;H*lpn4? zGrQv13Zjloah-nl4vCyLhu|UjuR}w9@ljCauBn{9gF7`u5Hk$Ux*qJ$51@+Cx|W|4 zkjQ@B7c3Fr2}8qxz%;AfR$n4ym}Dq(M^CA8_;>vL#&IxJ8dq-JIHRuC=z6Wi1(4#B zT?(g~Ajf9Aubg7Ide~q@@WT)vcF+nFnP2NSE74)MN2W-3O)%FTmLjdJABQI7&zSG! ztZvw*j*alfJ@d#~QzKzq#KkSQY;^1(eeypHLbVk`xikw=C-c^caPTt5Vu%+;^ z{L1n2Qs?kq*P?dOEY<;TlXug}DN>&oIBIi{$R(c541r=pk9!r1K>VY!=k#f$!ZH~= zXNE7f9OA?&41E7QZl(?jPlQi)--TYjLmOs|csA{_L^hK>&8+BkEe7$0$BCNEN9q$B zMH~t&&xf#T|C-q@i})e79b>u^sfv@FmTqQPN2{(yU)8LQFh9hypRqYZMk*NU1dBdX zzg3fLHr495oJ#|b+-gmBa&al1(llQx+dM)}BXHhZQ|TsR^gFWLQ`dpj>d2>AnRgC+ z6IMA=nC6MWpf^;`*YLpAij(dAcqQ%g5-`!~uO?q@u@t2lftR8vOC5eo_w%{3yQfdO)| zJduYm>yt-LE0MLw4Fd$!-&PV3HIrAPycHsv?gjyjMzx4npM4_&+t|oWGyKkoJJpd8 z>>oWMO!{lHWTF;n=b`he^!MrwSudvOxixd^H6DaFJG=YDBz{BLANLHAaKDL@;>;LU zv`V=|ZFhJ{F|!@r@v8Y+fLS`N8%vt8BrZvdAMG8eXb8~sF)lc(BJCLf$h_cvOmiNd zV9`*IUCUlDl1NBU9R~cYAMI#Krqme6ENCc2wx_j|AKn3@n$yRZU=$_Q! zO*V(6`ppyI*X(5YTuO%URw+;%4xO`<4jvmr^>i4h71w>rnI+d$7d>(Nt?y2T&4k!J zFoI>l(lnQzMko^)5y9|w=X^lLB_<@y2LpLw_Wvu)WD7}s{xJWTWquXvV%fO+sAZEa z*$!C6ntLG#v|Vm=El;q6~by=7liu;CIvA87>cNP z0U^`JGZ{N6tAMCwSHZk(#Jp?9bk!)_y$E|X)!aHPpUGx3*X-?~Tu(*576^ZNcsJ|W zidN$Vi~&vfT82i2=zS>b(_JS2F`~YjmK6*rn)FL(imMLL&B~{W*)CJoE80a6OtKi! zA^%n_p%&DsspA#?Ko3-s<-QG0X&qEN0f63B^=+`y^3&WQ{1?_Ct~?kaJd9r*$c~56zGr_tc((H}!S?zK zHz-mid`Ii8@ybrz%XSq0D)8qZ~|LOYv zuK?*xT#PLLZ=$?MQ|ezp2(|ZB1L};(8Heexe5Aca5*}Qebq0uU7`Qlz%LG^(S1SK_ z@0HKK4dQ9oE~P&tNi-?J;k#Ettbhc&?5;# zi%JYh&rV>t@22XzX7v9AgS^wAhz>bCXs8aW_*7k3p5Ed|)cV*`{PDW{ma;hr>iuKD z(nycEu3{c2r=HKM+rM0wLNQVmvB`=_!O^@g$kjd6a<*?#ZHcl1gIc{6pN-VtXph`@ zRJTm=UuwHluFcE9Rir~vl|a}Pv64xYZ_zBLT#)+gD~x*DrkYfaRMr_G39y9U>?;d@H?@KyAyz3M&~?as=xvV4yO*C;HR5{IZ!;CeRQiit_l@V460Tl={73u*Hb}x*Vs+kRH z4uMe`)1!D+s1aRHCEpPPG~bbxCA&5dK9%HB_LhQ=Oxu?IhjVN?Q11)>IuOig+7Vo* zTC=a&XI||91rZ6IHlQwY!tzMuJI&sz@zs&WMNnC)N;9836^_|vqm>FEMpKfOu19ic z`DUhKS$)j=?@J{CK0pj3I?a%5JUQA4f5TEIioiJ=X~+W(<~M8OE>kyt{B2LLxWEX? z2Xs&IKI9WvbZ()34`gSX_IIwZ0->E93S0g{4`N&FDSm zvWKv)@(I2xM=o9a@pvLf3`Yrrs_-8pYLas^%B#L}Mf-L^-fc=K|KQJHY_CtJSlexI zw;%WkOqUzB52a+U%KvNqgbp812Cg;LKG{+mI2vHby(qc}EL;on3OMR^I&%min+8v! zZHLvxX;9->_59;p=)49Wstq~zQ&P40!W6XOuHKb-XT>%23LXM{d2Q~>T3ET*Tg$QA~ln2MevMhdE z;t_Ph5}}V|Uex!yasS!9LcA1u97 zrbF$s2T3z7T_Z@cB5^cpUe&DSECSyoeZ9dst3VhTrl_T{vQEcLye`MzCzlN#($BU3lYcm|B@jYPS2hW`s$arUmCpXl^3R%MI#+Dh zK_CUFG{r}zp`%nsVT|Sa{%V>z;Wz@I4J@fHJsTc&Qi-njA|AKeLcM1|Ow)dM`Pqo| zmfeXFs}W9lZJl)(<>8^5T#9<6Q3~DaJQ=i^dn!vB1P5?)Mg&X zkV6*@u|L;974_lIA4;)Ue6fTgOIi&++Up3|bw8Uby{*6_BU6z@AviL)XCy{vj%jl@hv~ z1F$%e)%jL~lQJ@NYGUGYz99VwW?z3mJ+t)%$vLO6M%6^HPZKA5Ls7Uc)VJN`Z;5LB zY;2$K$%p!jTWm{WWlkkG7;Dz)VX|EG?pQ{g$Ckikn5R(4Pp_*kY&=|E+@t}8LBVGH)cWPv6~+p5Soxgb zQ(IdmVf+7VXr8DPLAP{!$!ZlQ_(32CAOJ5X#-D}ftJ9Q9GImmYZ9!jes*RFu%OW$e z9Fm46*~O$ynhEv2#I5fgNI39+hsiVU3LIX>W(xM~d%vaZ!7RuaMozA;#ZhsJG%I6f zwuS(** zdWtPR=k{{*OP-|Jdry_lJ?rXroutY8ce(%DzJ0YdS;Rs(m6zwvtADJ(|Q z;ZkCgUVUVS(d}#k(DoI5@R$e_B}o8Jv}^)CFDXSGS*+%v>zcx^mpVxI^^^Q=)b;ji6`Nd zXXLZg6*uMH^0DscH<;#Gp#7w7H0~b7eOB3stA^7%IxTZ9+l6uTC5{$aoV>xG-54XuV> z3aMxJz$=VxuAAZCSua5E`v&7nG_8r(+O#BYR_~xvL<^%nS=eVKHbAcVh@&mkKa>}Ks+%5JN081S zb2$hUK=UOuq=_qA2Xn;U;w(^&>wg|ZK^Pn#KtpXL1*5IhHt z*$aigjjLey%ZVLHv$Ul=GmkEHO!gf7LgCjYoS2p5)2>J$6)=c&J>&rzl14SF=u_n; z50F#op-z7bY87bQ0h8+s6PG$2q4U$a$f7j5vl5|ELH0TSwQ5ZZ@ZRVN)ID#Z3si2* z9NzRSuC4401tIVsq&dHfV7C`~Qsr#~%xqecpRv}RPIEWe*^l5p12j3f2UE8Z>|pL>Mvm6f8(j%8{hLZhS(Ju#=iGa);c`jA4;At{Axb__=LdZs(9DXj9%P> z4OT%998HAnC{I*z$0K$jEma6rEt-P z)R(-HQiv&soY7Pl@&=}XwCDzr<~BcEj^>v#x(jcUkA>-3bv^nYC?iZDq`k>WjjPSi zA#GTOoh-qUa@ zI~?I@G@$;`yoj6a%CiIUO@?{L3~2ZLU8}8$wE}s4RtLyH-*O`ew2>b{=PTFVIuJz% z!RKyfR}_&jSLL1cz0-pfl8g@;C0fCrYL}52Ytdic^^j~HGZVMc!*iwYCDV%%!Fslugjn0A9;nan98SFwMP=btg1eWOr zD2#lm&9EqONJ6gYi9IF22--D5gJT7s_cF`Nn&n!_Xm;=}QjWY7|1Efh3)4g!DLoCn z0|k`mUpRD6!fX1HJB4`ql$KYauQJ!P=Q*2k(b1`vvrq(=rOltE8@Q1Tbznu64(vs z;UzTkk;5>l={U9TDZ^EZ)Qu$tYt8$(!&?xeFbB1An_#XdjPbD;Uv?Cua*g|u`|0ed zAV_LRfl~~KNsGR47ppw|6J#awg^3NW2aGdFpD}3E=~1UloO4mAf4`jC%ZFC&C;qt# zko#TeP6}cN>-j5h@ML2|_hyl9-1sMJRwUwcf(JD6?`BC0$;ND-L{&0hQXmr2c#a=S zC$0S>7Eu4l=X6@&-FhXqFQeD{Nj1z$_6d16Lg~clj^-##iq0u_?JXf>%=*xC-oiHlkH=&NH@fqKXh}`%7HeTyEXDaBO<#6SYC zudqkz6klJ)4N%vJ9bMl+cBZHZ-UsrZXbWy&TLPjC7};*dpePfYLIdv^UT&w5q}<)^ zXhH;|#k`2NrLrd0-yvx5QXTi4O$Z*hQBr7H*F3*LF7cScWekw}X%6DVup8O0*i<_Ju#oCTKVcxGuMlESbDXeeeF8<{l(J62N*6D#P!HIUdn~m9!@2a@6YH|@5@UAuWE-i7Jp5lD%f>MNzTt6Hy|NU+!_CNxGaJ= zfOp+_i-1CF5X-04D}19j7&T78H8Fd;OtEhN5#}+O!?UmCp`!#POpN-9BGpKx;s)<29VyWF8QDz4IL zvh{2gh$vy=eoide-wE1H$-wQyPucp{2~($|c2^>v=1SG|`FB}Afxg-^#7B^TtzoHw z7?}_ue6z2HWSliw#3STOFzoemkI~WZKXoXz{MO+0U(7&)U(SYXCwjEZ_*yMsq2c4{ zi=%j%sK=&c=@kX{T*QsBLSKa7jHV(`Laq!-?oeR6Lx_$TA#8|e8bOH7guV|b!+VPh zi|2{F!9*af$F;ZYOvi!qmu!&yMN_FWu@U8jToFX0OZfN53;g!9V$;6DnuyF_J(<6! z>x!Ng^CAZO_@h)R=qTzK0(8dko$V;G+?9x;Hu8O)OlvFvCxBw`OEN^Y)+HQ90Q>Fm z^MyXRL2S(FZ5MbOOnF9BV+whvFMXFK#2Q+;?IZg-AY(Iexo~+R*>^4`DDFMK({25&%-fo7hPjtZj|>ED_hn#+`ToVs@~EA%gFAT zvd8no1@{+5n7(iP@8d^37I%J|CeStqow7t#g6!ov%b&DkcvY*JV4{`tn4$I zhl?U{E=w^9N-BhogAXG$;S}J9fgz@pdfXD9(r5t{+<&+=;tzlwe?K%Fix9XH1^e-{ zNatY~oo$9aG$bJN56-(E9B2%olGeP6Jtf%5km^SK@|Que{O0Nsn#h`Qai~*iyLoR3Ue1U3^P8Q z1z#5?k&4j@dk&5IbYpIs*>gRr_U9EsX%CibnmVv#P7ZiYl8=`z=+K%t)lWGYyj(Z( zoVYF~6C-MorvcWCr*^EdhhKun`FFYcQWYhM196s3zgx_eyAVVk7>{Ib;xt<8EJ zivqNtr>B?q{rocwb0jWmt$6nfa<0JKJo=kf&ZIohZ+?8pe;<(1GeM(tY^7Im{UoME zWqN9I8Z-2-bMs=GlQuet5^Vku>L8TMt70kv>7_D->o(6Ldy|LOq@M{>j5sy1HyfR{ zp4uO98Lk3K$#8m3jOGGp2hl63Fptc7`0>5k$jgqEk7&CgpJ5h}B5K=WF0`6fL?m@K z@D`YU(1%Hr#1zvUA{v_>d?XQg_p4mL{6BeYyc0f?D5nv%O z83tKJ0b#+=9t|0~sc}H`L?7f3O~bIz5MZwY3WSWKuFbEm>aO$5|JQiU;N>U59%-u#J$)d#5jh{L-+^1UY3!PavDZ59W_D}6)xz=>z`M}*E zQz2v^-;)x`L~jQGrMQtNt;-USvDdcC9zv^_Rd5bn&00DhHRAKsLwtD-DA9#w9N+QZ zr*lBY({zn2EBmqBRWM}cx9MSi7H=s5gNL)8%;~^(l?(<=-)_qt`#0`J(jO#{^mv5h z@d74Z#@xUm*Ah@r59q-^k+4i!Y@-K%W8nd(!*;rw9IF_YEsdx9J)F$^lr71tvRcn7~krjiJH|qmC{F zn9%&Vci~^%X!qw1&m?8tP@LZmUs+&i?ryyq61x?F0JHwXmw+WJlD+rvIxIwXT4?F< z2iTW~=?zUHLRCgzz-E?VHMs~3BN`2FpVY*3X1-;jjh6T<8s>Z<<}{usGI9=rNb>C; z$?o7nD@acdQ%Fve!tA7VqhlfF3tAVUj|-JP6(zc_u#e}%OAUg(5OP6W0ii+Qu_6U(c;Kr$S;oAVw91znQM^Cq;)N{^@86WyE<}yQy)%w@`=SD+=XDS6Fppgmi*t zYcozskUOhPgN{8)-T|&`6S6b@FDzytK|vGu$er)i+ipa@@?qOT+w~zcXd8 zMy{G;3S)v8wbHc_jhBA-nN3^4l+3*zs?lkU#O!+1Iz21S zT?iF}uH6)BSFd{o zncBj8r8CMnD{JB-c#oetj{2)t|_ARhj_k7?Z5SI?_eYMsR{?f2o6Eag~9lhG@mMT>brIbC!C0p z6C~j#)+K+&Fm&G|*dt+xnRqZo55eAP->{OMJn~*J?{6{!fX8rDEB@2;{I3|&Ok5ny z|F3p9q9yY`)AQfP&vH}bHx>%nuBnf+$}3x*sd9CXDAzo)9ZQ*HR_UU5xj-)fND_$| zRYxjCo|g!^t^q*Mt7n+e48Y1GyGxj54e2v&+nnyzneP1wnz0maA}whid5$e-nUo@5 z+%W#;F6PbZ)B0jI$wjK=`ofl&Gtm9vP2f6J(yzasNnr4A=a|cxDX+ZO7wt>mS&jGK zn>I-ouih#DeJU%_lf`DPnv!bPtZ7PGHYn>4EdU&4tfs%0@f?Tr^#RG$s^mQA#ZDq6 zJfm>YZ>72)@Xl?2alyYEUY3tK{2^e%e!ZblC?5PG%wk$+=jV%?OP zu$aGE=fT6Ku#B28s)pkbblNI^u5!Z}`|XvSeydoocnKH>4A4t)TSAVno+ec)6XUcB zdXiU-8}j$IPUYf^seVq27V=BGC24ZQhBn+*Hv^qmEvP4(P55Eiv4v7StcaZrSMSE3fWzv+IBc8g z78MbveIP~|ylA5|Adf_DLoO7sT;_C_WaK!PhBN!Mr{988XKWB46_`+7W)b>bNREY8 zdmT~lsVPv<4OuQMjd^tao{{DdNk%1|o!&O%y%%}EA4I7Z5VJy^aPp_T7(>C5goSD0 zj1kD6zY^S}Nh|PSPOsx8;P(v^Vv572==a|U9^oRDuA^^q9E2|*+Y`=S2GfPst*?Fm zLaw7{CQw1ydBYVPE%{w0MM;bRI#De>cQGyrQ4UelK@MG_hhN3ot*7XcU0pNqJUpCq zLX$~NL>Uj@cxFRG8MC;l##cp7TuM{0OT@|hxl#~5nL@lF2ArdT>)HYKu_69zt9p{P z(}96sRzNn%kwMkN*ErCe6`bZ=lJ_JqOc>1CY;GFc*U{c;uI{7`Gc;(|guj`1mdRTV z;$+ezOx2@HwYk&OHh4~v5YxC_P#D``H>z0=N^E4tDXOj8cO6Xm;ZiA+yluduR~42@ z2ty%s38^dUCN1?`{Qx>6=nVF;#`?WiQy%1bMu(%JC)X4b>ldfBF@29SZP~-68PS}j zVC8(}^d)s?w}eYfL7$5@_}oqp6dr?U-JQ9Fyk=;J|mM_!5Fk|FK!gV0Kh91@M7#uqsL1g#o3GcIyQmHV;`N?}!-f!{ z^&8LR=3tccZ%FYWW*g_}(DrE-i98)oQu=9`J``OUwo&qX1jC0`+QX_-tdX@e2KpQ`83T`nj4HVov;MuB)+t*(`+QaKv?6~6g!7Ea zr@J||j%)RfET)2_G{!tj!zNZMh%XmSAaLrr9bZ_#tsaEVvDSTlbO`8B{LoqYKA?E$vMV+#!~M=mk9lWiheY_%avh1fmzK?gY_vvWSjfXak3A9qP29~7iS1zwEmNtmB~@cywMc0O%<_$#f8XfI>> zKJzLC4~p!)w+3NM>8BG_e~nzSP!#u6E#XSOw0d;hgg<5I+o42r{Nw&Ke5;NMFJ3D$2MYV!aq^LX6!LDi|`YAF;kOK+nE` z25+I@t5)+O?e5}`e&7Ge5vr_R`I{^@?%0J9YAs-=Yh2B}tSb|hjF4k9Kn|HY$-H4v zlSx6Ct+8U+wKuISS^+B3RooRH-?6ghrgAR+M%lm_;azK|Fa&Jk@lej%9{@!j3?X*mtY#Ec{kb z+%l)V{1nz9$A)8>ox`s8+!4w2LVMt@*QGfV0dA&FTgPe3ISl7DZx|-X`O^%H;KBY1 zUW%&RLXwu|)0b89w`JZd*RItUKF}JgbHXg`=bgsJ9y@@)V>9t{QI*fCb;Gn(1#RHn z=wDYMNDs?5Wsqmn?T9;o&Uj}-p3>6;CsuO3DES_hIdrIX3d+^(!EY6ow8eHXIrx9~p88D8`wU$8s|vhf+wV+!DDEa|B8kXN!(}o~VjW zDA4PGu3XBS`iEUFkXW1+zF@ce*rz(h16qpli$qHP0Fq+L?qNsm;R{U;N*voJS+^FY z7<+pnNnOKh>CCAUq z%t`_@1&CDoP)|C6(QqDrfY=oqrhRLMIiK1nn{p_Rb~vhXjI3lfJ)X*v>6Y=v@`kqt z-Ox&>WIaQM%u<`13yNlQBR}VaBz$+)5!cvwfRZfS0GM$y_&~L>4amx{t||$UB;iMw zf5UdPTx_gYnv+i`6;FzQ$jWcM6+F72Mi@DE@WNu4MF$9MbY)x z6Kp2xJSj_g-n|yKolTxwJ8TxBl1LgP(tsxLb1w8!gYjULSz(e|wL-{8E;O1)BSde; zbJW;aW>ToYBq~u>H-kRg8+XUK;G`BCx*N|xUZ8(1Z078^vOZ2oDS!w<0ei@(j;pe7 z-C;~6T>S(P!9UHoWx~SG>!M8ISOb_yv>=2(sYU`AN~a;*n#oueX1P@@z27_Q&1O&V zaY?wjd?dc~O0(pH1R?@UP_GAHw4;i|RG*@3;ZnMjiGbR0aA_AJ6FZlX9tek#Yz`Okx5nU`ild!7!nnb4YtR?i;D}taJZ5 znOrXK2uLlKMoSNHoi-!mxle%M}my$blqXrwZ zL3lupi`Tr&s=8QePpzIGs`lE-wQn4pwIxbI5OvP}Zu!TJL8=65Gv0IZ>-+0w_d0fN z-j!eZdbBY7e~i6DkSM_#{n@r{+jjSD+tzK{wr$(CZQHhOn{#JoG4uZM7H?DQipZ!u zUsj&;JCII%IyF__6lLu}^l7f#mV+y~C^Bx%m8vJSWL-elTLSGd8>mRgXmS(@{IwxX z>MaU6^2BL3v}$VWF#PIp-iGi*k?y7Z2)(c#L-*j;x^$lZwkRY=7KCSmp>>3SAd`F9 zVtAAo8hbE0(u1rFfjaA22C`8G#4*u0H^ZpVf#Z^DaD*{;ge@^g&3=UM8^jB_x>6g@6)iW})Gw1G!Nj31x$(WwBl*#d`S@p@nBif~e0nD9u; zQwG$Hboh^9 z$M|QXtg44g*AW9HYdafQ^;8Wq>n=ZcA6zEzXXaz_%!T2OR^Q3DQtZK#*~1i^V}S+j zx!*UkjNfD?h>3 ze8^hjEAP9XK%E8D?TrSbBL&TlKCXKi&5Om0z#pF~ysM2gM6#{S#a&?wJ>KU-E{;uA z&jp3~e{I&$m2v;}U#04pu$Iz4HL1%!d80JOd*=U^3ZZ1*scy0wJEISm3Iefuu*hsFXN@e}P2t|GiFKGQK zYG2IN`E}TrtG$_A$qmL*3tXAlMCjEy%SCXJ}gUu%j*cMGz`NG$dK90AnuY0BA#m+KirQ%gYrA6y^V_W~v zQvk3Vt~Cw|0F71^^#hC89lz_i-EHE4Dfl!+wvqcQbcJ;cZ+c-S`TP+H)HM;hHs zWdSD%44VZU?!bs=n)+q|;^Nm`MjQ1I!#@W<@0tTK*?XY@)~*xs2prSSk{nIw#A%ms zFyE%s%q!t!TO69?N`l4&6<@qRlq0_&L}$zRE83jDI1H&2K(6}c7}dB_QK2+ z7tFy?`6oMmFQ>qZoH(7A_l^ZrTj4ozS*ZRzo`y7Kr?lez&RJT_9tTb7=S8a8c&+X? zAo9{$=zlvU|8IO+Hn#tRGO}s2DT?5ItA;=kCtu#azvBiu2hMH}h3=oY1ci`C71u1h zDNLbAST6kWIkQ7i)1+w4LW$%jWzXSwGIh0{A4m@fXYdvpnAG>n@h^t8ThjlyO47$T zafk!HxCvkiSVCc{!SMGB)j*QWSMC=Af|NprvWwQ2x3{AwOE_skehIq!?fW87r^_m3 zvLwY4t%tHR`R7@MIb0lVW_7Y4CywPRdG)mRoWseeP?$yx(}Ze;+3?)&h*A;=WmG*~ z`WD)7XhbxKNLB*@)$3~@WE__$<}?B{R9eQ z>7d0t)x-I$s29E4$7H)&colU*<)Cc=qkT|z0Abt?LBO41mE#mSX3(UasfwtY>NRmw#T7>9?-%1Umkf*>bQUI@T&v01mYF~xLMwuL)+SK6zkLi%&r zS@uktU5H%*2d0!!2XWUJg$QN8p&s-fh7hC-j80~|@y9z8YtO3}qbL&5w0&Q>oS`sB z!<8uQieMSflF)%ah+%50LC$~DWX*cm4_#w)>y{m$$hbTZGc(AdD2 zeiqsqzUF{F(p7sY&a3DK{#_Lk%;gz4Ow;mF%wnwX{uZKX#5v}I{KIm>7>x-0WW0!WOdF7r zfL_%?h>=Q$EZ79TbeF-kq{h$rui@0~qBg|kP0^_gbLabISu!thlI0Ko0+C75oZt0{ zt~p!}aIK}sy#BCtiLSPnL!1RHuPrnC{*}DmWt9(&G~LR7H0&rFP-cc)6jlnhJudNy z6VxfVz{RIFUpNPnu3gyo#WbNL6N=kYDH4u|3%pPdDD+zd9kT(lEQY%R21QJXCrN6l z%NUP7nzgTrwX9SNZfIT+!GyZZH|=w*5t@oAscFZW56gQ8_xZK zi2*=gp!KRpoK#V9qStxr$Qck2Qgnm&$Y3f2jRbl@isA=>tE9JN9kd(R?-#w%>kdkI z_2`~QXUgnT!X>hoOhiI4b@$U7s$<#{0P-s~6A4^@{)9jE)kzbeG-Uv>3pEZ#Hj8;t z9t+$=sJL-*97n~m1&df(>SnYm5e571ILi!F1E@LjS~|>iDXP1Jp#j%fg1*oBY(Imt zre3`cBxu*T2Kcc+S5eq~el^sE3jtvZuXsV6YpiRrJp?A7$_y)VEb}@7sVj2^m|7h5 zFA)>aqEG1X=b>9Z#e{pTJ(Er z-kq3nS}MJ-alu*(Ki=H=wRS~*J36uh!?kp2S^apTKzjolv->b(z+__*Qd)Cfx@Ik= zx(L!TW03pHl38fBH;H=!5jKDaHgZwBFY5lwk(rggs%Xl#0LrQhQE&nEtBcsRv_TI= z{U^pxw3A*Oa<6=5ne9~n!9yW6IX5^AxLC10U&#I;tzv2*GWND41Wax0$UQjp_V+d? zxwh}uFl8$9_?2?!%o^|K>uGc~fwwJ%M1X}XlzFV+%0po`(rnqOcuGcjkl$d*(Xs}+ zFjmXq1H;<$azAy@-vmvRtM0j_|1j_=tvkwMKI$r#+7twzRI`aRI~J)*Ep>JAu`(5X zzO!{Tb#by)?bKG*DJpbQpXo!}>UBKIRl)||my5*sgv2M}tuXm%HNKqdhv7k%*~O}X zN6*f;MR|RYC-*e{@L593>EsK1p|G|<6Bx0;irZ9suBC*=N*gUL-{37`bI;6}JVUzl zL~j+Rq2H&ou{RCu*7pOvbYvjxzi1ib{{)d`WMupgx9G6irp+PS|EpzlV_K1jlouve z{w?M}PWVtXE4C{BDn?w06ume;GPNc07CEe+=W17Olh%#J58q0Gd0AP9A9;DGRr zwV($uUmf79t{4Q+V5)w7KM-;7aj?J#f#3UbhbN3w*qYYTn=P=Ot&EU_BiEB7grZ4& zVls+H+sszN@BYx+C>rTSU*o!;@O}i~9WA4F+@51CpWBz*THvhlmO=;ZeI$TSi08&a zhe7Nmf#LRo+qHu~nZ|ABu~VYo>5*f_TqRe}v67y%-};;#E&} zo2tdwf?=k06Dr1-GuXE{HsjdhPX$8b>XAp2*l_ra@J&>I#?v#j*FKWgD1^i-))&8G{Jy z$>K3U19Bu&aG&&YiY(BERr*_p`yX=o`k;J`)VUOt7woi;oRN=ZD4oP8VqDZQT;177 z7foJ8xE7D^CO{X7r@%eqan8q&7qTte#m#>R4*x(`qkT!yG@dp|sMiHQcn<(ChvF_1 z4Idu_9mi-tx&PHI$VCh07&}BzIH`WB8$*Y@oA!)f+tnQo6l!ERx=_?9GZt<1)U@}kNYD-* zkzE9wA`u5K2ByHNa#U`Cn!id59r=v9M|wxUal;db}WAAnhnuhIbJ(z|)51xZ~b?%N!?K($fCD<3BZp)^zh5 zs9kLUr{M`Q%QyChixyfy?MmAoE|Bd2!!F+1Q6(EzJsD6n8C7M!G!sCkD_3{bAr*6n zpH>|4^+CBOgH?Q~)SEk%9TC4=Qt(oddMR?@T zS>1)&LK!A%ew(-wR;A)MzayJW)Je#@^pgg5L`#SFvM=(yHf5$XskUh)zQ9P6@rb=k@6KN3-nXk%k(Gd`tLUVYV>rc~#flZM(| z?{*+Lzuq1(wih5t9l;Bx?`lK-DHs8EOO~H)@gDNq*e;V;z7U4M7VHY0!8vZ*VpbyW zC#n-Cp+m@=B*Ts{dOJfOm)7cq>&mzRe8*8QVdjxzXtkr-+b;2xG|hgapZC`dzS{!{ z>wnv!{x_x{Ckx~M|4wT9|6}^qg^r61KU7FT!HiW0hq9O>+MZ<`3DlWrY_(G&FxP$k6EN*3f)afd~>!;|4yf;C|3+Ek> zA276S;kbu9Ol(}I$1_F|K@8lqaQ(b<09K?8KsNhjI=W5Z~o@ZwQU6_H?f z!c{?4>brdGflpTu0lmxiOzw{yP=GrS58R7s%69qh;mSXv#hMMy?d;C^v*&jhSAkF^ z5O1?N%8)3l4DI|v_J`+ZXDv*#nDqlhJ;I;tHBn8Ypq0Y{P!#eB8_&hV^_Tsdp8GdX z;23|<)}6&48v_^L+uUWU^6j7XxG1d+j~PjXE?%yjnG&(kP4HOG86Rx3&nFqREFWgvg4=>RJ{}kP@AZsDpQJz-V5tp-8@^@iN z4UcSNn*C~clX@vU;Y8#0;HjAHH$AjY)im_l0Rau(DCyfjB)RAU%$R)GK_98W-P1p6gC-V}K)^`Y3K#`7h3b zt&zSC^)V%BH$rqe3m#z(k`t>FBD4aCr4?{l(Ta(6$1pViZxs*9zuIAWVIwKit*PyD zQ(-S#l;{FL+QGe{l;{rytOsP9A{FTcnMOw0QT{XLSwYt>^m%y6IRdR?2{NL_ucF2* zIE+*bQRluUOAsQAw^0>XOJ%EhC1^R4TMBLm7^J^_L%QhMzfwYYyO^H>UbD$jQ@I1O zXY37#nQ30nDmI z_a7}D#%>T4s#@d(8PL^vMb#(DE7_SW&Q6jXLNLk6HM*SXkRAd01Z1+!dn*?8f|hyq zM6v^l81S-Ttz>h%kli*0E->)?UMm#|5E?m%@tnLad4V+h*B(AN-x7j|gz0FpqPnQ) z_CB>P(Jw9fL-4z5g`BUZQS_o(1$w!mrtxvhidD_LaJKoPU-mCuv6K;%BfV@Dz`8@S zlwVhf=QR=s*phnP@?|?z4D~RO5QUkl`Qq4d1>-&$MnMw%z_sXKs?~Qv$Q(bp{b$W@ z@=7W#@$Sm9d5}+lvMUcFf&~ZE2*#<~57puxY^+qt%fzJ;kL#pUz!y&1t&VarQf86ju?eFfZ9Rup^-*rW1aj>S4t>*Sjc&i1OhkSn$$T_o#s(CbL7FvJ}xy zO2oPDZUZ5^&b1Kma z{8f!~*X3YW)Uxsg5o*(n%V>-2Ne?%Z^2#Lx*ktfH=zyJbB;yLCS9Ej3wW3qjxU5SE zyCeV}@gJDsurdkWq8{syq@IC4?u%@GHQJms(A%t`Vt|hq=vdcDM1QHYBF1JHkJ}xN zh+rS8Y@SZW!z<571Fs9%{=VfpLF zh@KN81p~P1^Y4`ut2=|ZAq(dIa65*h35`7%CHAN`y_7Pl9RiNGA>TSAF6VHHN&YjO z&M(VTh6o)8E`@-gcjq@eH&uSuk$XaH)zEF8L<*SKJbRTZz+!w^CjjI!RN^z9SYw8@ zza9dA5+J%*MOI5PSYqukukN6}xM8Q5k|Oz{snRCl44_=h;$a6(Lxu?JU_&-axwr{I zJ~=@Pe8$<@AZxx9-HL|2=DN?UYG1%=<}IhLKg>~-V~o$hVG$@V?wy)^WMTi#7W7Di z>A>Zs)HPMnppmJp>970qxbuC-E=;;b{ol0xf1(L8adP}eXL+{fro+Fi+P?}5>FdD^ zNfz}jNDjGhdX>xurRMO5rbZPhdx}U#(=t-dl&o4gcDgP|;&Hl83vmPztnJcHIrgS^ z!$CHbpL&^@{Xg4Dq0_syY=62>u|>m+Q><%j*ru$~2vjqsmw#5TrmgMSmA8jgA>zYV z(X}XzUv4IY6ExUGxqQk6cruztg`9B| z71y(ll&6ZJCU@D(|noodc=Nl^zCMVe}(xTlADmzM$Ey zUB$&s2eT9jNbzkx1=KF^So0u-A`VY@7Yr|S08wH-hFG&u^Y6~G zpSjMo7lLV?wa!B3w805V8~}OjbFJlt!?AhM{Z0c0S_Fi!V{F_vWV|HMza>;jW*tEZ zWlr;q7X8j($tcJ(;zjQHa~kcWXg$$RTGlVx+~Iyp@31zKP7ftfh9b4PUpHF81G~c; z1TS*8>GE0O$fYztE^>Eqg0l1ELtL;6VYfSPn#x@gVn&tAoJuxP7S^4vyj6*Xb~hH* zfc9@#u=)|Hw%S z1vH_Jj^|!y=iO#`(SVmxEAU{r-sFuMCX6dgH&YDD4d!=QBChI3Q-rDeI;8Zco6zKr=n70!JCm+u%FFNFa#$BQs8)ikNEb`GnvvgOPh5 z6wSe~N9~(+QRCnaBAAgGGE_?6xluT0xgndbL7%OPWLOAfqjWHq9zyUOlSOsUS`Haa zSSzc@Y9N;Kb}5$Xx6Q_f0zMVU*MA!cKwTW3=dr(q&u{u|o4QlvI$TOc3YIn^{<)R& z#(ovf+g$!Wx86NrB&aAriPAM)@@K^B09PbrXJd&vVdU^t~^gi9==P*3C{ zwJgBOqEK`4;HZ z`U9OIxu&*PFRh|$lcufLnNyR=gKaT@4s|xS^u9d`$AU=k%^RIiE{eErgkMRUP`)Y5XgA!wn>r#oV7O>5>svE|`uDzN1K| zC>Q|Mbt|`K7KsRAsGW^k&`H%yV*XKgpnhc|1`IvL@(b8p4wiLC45fU*mr3wbnSzvHVFHq4ngn+SyHnYe-!KF ztWk{>*@~t|ztpF>*s@jIR-Uo){KbJ3^7cwN*PoS(!o#{sf>PL{D@611SCp~RsNMiE zkmh3cwSU%GFfF@8q}L!85|ydH5ovSGiw67hn)D}zY z7ly`!c>P!893jO*Hb@<;yrrv6>^>5S&ldv^A6H^gwlj};x6_QeJ?yjlySEaOXK~GB z|J5`3b5Qyh&8PkE%PE81weRo^&~Nbst*HNp&<3e?nR}vsvqadSrl0DFIsWfUh{yw2 z{%S_M?)3=nq_hX3vWGh@L@3W)btUuVDx18me4{-0SfuqS#$G&(Jt?~;`zrpPxSGCMPc`2v1na z(a62g;F5vIi!cFOmWrjWc^Hf|zVl!Y>tHVFFS*^CWgoeJd@<+^3h6>Q zs*ffnnA_3t8O$m7u{nndZB-uWe7q@-RffVbuOqgR^4}fRQHarQZMCLQ+*U#Lz~ibF zxPo&>DPV|mD{Fr$qUc3TF+qd+CSWp0(L=Xv@Sb|W`)jr#`%#?8bW1cb5orumMz`_@ ziGiVOTM!%qNOi!&rQ2WwHjb4Y~)XrY}oKHz*C7xU;=QE3iZB3EhD~C5-?jLTj zd(eb+MF7G>1N2OTRcMvrLe~+BKC&L%LG~)y61bU^^GIq+HWYx6&j>McGuC_p{l^3} zP9TY9D>T@fHf~2pjvDd-{LQJtN}1(%f#K+b z`H$peboXY5M*#yJ`c1umtzn6MrvvD;8zN=x$4Go(k2mrh=@_o3r=UOnV{)}KLOXSQGP8~L@F7FmIh3Ki z=7%pHR%-+xgD-SzNa8}eVOh#2&fPart8=}k$YLl~tOE`kRKEk9;>nT6A6X1#8C* zV6L(5uM7z>fcs`e^`rWddmU`kuA2o_gMEjEJr;5e30kui{fA_@c z`@Apy0-pY;CjFO@pXq;M0y6!d7Y^#ywufzqKRdela@g&rkHQg1#XF_jn=-bM+c*xF zz=}(tswrp9@){0L32WcaxDMhP4o4)e-38(RF%&&hlgzVGS6kdm_j|Ei0sXzFMck*` z3-3P}oJ+*@=t`#T_GU-&xkEe-DeHf3&ZbauEr=)~Zc*cf8&?wBCAd$&5n= zbZvb^_D3yRD|eZDwd%%XI-lYjAT@K=#2<(xGkn5X{ zZFMOW-nMKOiIi{bWx7z?8z?Pvd+)ri{*0lBhU-lc=7>GdTQ*u4*#TGvHJ+hQ@5}GE z$GUe8A0p#q*!0pnq|?5*ee;zkW?LCY*GjpKO}%?v$=AihH@PWImSissy@o-o^Cu^3 zsnYI%>Fn<%^Jq;c1?XF8*FI6tr}Kpt0@;xb#e#hRxSL%TC8@0HVPqW2y8FWRBiN`& zbJCgwJ^Ra+E=7goJ2Vo|-|IzzLWt}%QB?D9mk1K%VKQ(s1Wuu4ecos}3MyVvZB1-9 zRamBH(8fw08iAd0W^_{F9P7j9SXBXGQPg3MKsKV~6C?%L5^Tjk+mNw$l2q?^`PsLY zVWCd>f!r8}<0$(f80h4< zyX`9-yc-lT0czfw3<+s7!{?`` zmQsXn@hg@{te#cDFFhP(meT(5ZxOf@DW=L=zo^uK_r-!r5kE*z2kU$7~8? zl#z#_Z)nePRCNp(WsghW+*n$l3FVCQ;rDNfJ<9uDqJ>-?_{kFl5Q2DcX}|5M$QTg> zO9}!aLk9_hQZ4xa)l#1d12tMtxa=w60~lG$A?zonWjAQs!K&7h53N1GniV8^lwlPq zETGa>uoT%cP`;-e70+0zzqL&(84scD3J?_8;4Gvfeu5ZMIWpfl zP`c%P)_bc@EQ5E@4TP^qsgRa-Om<)jBtgxY8}j2M6GXCOlx}FE!gk*sXHs#$^~6Jy zi`DD_fusNquHoqgJjE7QF?YojxOu5wxDG3&(w!~s8UY!5B5h?9%$Lrc15-6#V-PPS zF~Qzyl95$r3x){R){n1zC{M3y>Z?U$t#sn`FU%~O&YYe{QPPVgfD=o*iqzKqAP*M< z353e%QWj9rl)(Y2hAylMT^Q~GML*M=s28OGW&f*yLvC@NR{eQlp$?0;dgiR8mk$aw zkyTLwlomhwd+87{uq+8IHc8OcGx766q$Q&%Wr!sFgRg(JzVut0JSU>cpHVLT>I@Gp zCll|xdEudq^9$tq!FITx4J2C~t}Q&LxaI0zou~w{nGu*|dlj{AT*-dLxUBV;xg>p@ zS#qvCfWx&UcXv+_{QjgW15Bq@SRNCO$aKM2Mq92SU(U&X`)S1~HPGTg1S zx|I@O6#|e|jVWT|n2tO>Q9e6ZEDuSiH{ofb{hmDSFy@PA(_?A%66DoxzFC7mmAG!- znQ%a~TX?iPCFf^KA1RnFzxx^wY_Fup=)h(vPTLI(Z^mp=IWo-Gc;pv@1pImo*$SgA zUaJaWv~5*ykIppw2SVbl73(4MVCMOU_4vgy*&ABa6}ua4%Q zHW3jUJ|8S$Hkf?$h|sUMf*X#dRGBcy=pT7#yEkK_FrS-ggd|~>FKb2ym%X_zw3^u_ z!1WlJ6HcEsSg9X`g3{JUa_G}TJbj?<*$j(iMhQDFPNOep!b2s(&Y$mukJj1Hg^dC57HJKj;~dBr?mpAx(_SfeWnQSgkTC|VPLTNLN&+UI?OO>2 z0uCeZOt&4Y3~zzk)igK^9N#c)we|U}n2GNAV<8z0eW?h$qs&lZ=(WJ*y6+t?NI+w}sG{GVoVsGm^m?i9Y$Utfbl!vD*5KzDIQ04&7j+_J-o1<5 z`Ed(D!2%ZZx-BK4C#3xyih+PoGs0pL5R4(z+Q@xbs$iy~H?jKKY4$(^*C*FXX_V;@w3m5^o9?T>eI#AWtA}n_7kW7D- zTKT986vBz5JkXPYU$Riu!&&?-LrkSe(gs14QUJm%#0{6a-b967fhm$@=Y}8J+@XQK zYTRkZjkiA9JF?HxS@Q%9tvlH8W9l-1!8j8Lk@PQA-mQ}mPTD<;y`!~dD>3<%(xGe8 zwqbhXBVt?2UTTnsN+|jaft+NZ&yN58WDALyUmbOL_r~jPS=@yo?(XvNI0`@7yIvgm zuR@UgSVZpseg@lpI*^1rjr5t2+qAl|T-v)ixqXeY9lP;c=DNL>lgpTbR}IpF31LJ+ zB1p^E;fO#oK4epZ`jcw7wUtc<0_SEM%8Lg8TCYvvjuTX15=FIPfS^~}M``5OcyFcg z*Z0M+y)q_J#FrDdS-FcSA-`2bNH6Jhx185a*d*DaPc^MvvvC`j#KyVjj(O|IHmv@{ z88e!dK7y*3e1+3MNl^8BXG>g`Xv$?eC!@2^lhD^Rvlbt9R!eXi1b9zp?8@x$F_UMk zX2q?R7s-*Wq+sU9A!5p|N~uJJL0~H-)mG&p9vA7NxN4+81dThcCl8nJ)}-aLpvsY{ z25?+XSuAX-t8UjYVQ0dOb{aC5gfaaPuf<(A?N?e?7qt6G4Lszk?TAM*9w<6(y1j`- zksy2rnk=$9bjl8CBDlv1T*agaFdJ)5=AmC%I~jSt!69)jrm$c@HFBH%b1@QP+L&ZHn8YvE(?-|SORlP4 zw>F9frfl>$3C-7M&^1iNEu&#JY%AnQlH_tuh34Vp0Re^MQnhkI$w6G!3&+{1W3y_W z?jP?vRa|sb)p$M5Ak^D_cNd=qg28O=w`8rjPL78i)@i>j&5JYGbY4d~6l<73<16jh zl2^PXsfAbq>R5Y~1g#7AxwWLvi}KaXsd74fPE)iNqhk(OTcp42x8w+6qgx!#nes{I zA+&Ju&3QcRuORP^djQYyfVRzd$j63gb_;snknA!dB0(OaA%27b%mu;r3|@>J;SK96 zZJy7SV1ex97A9TL6<*k=A9V`dQm@Pzwj;kwog9iDgr=irXm2?P@`=WaBZgGnf)5y0 ze~>a0(LW;XS_H+LW>M8D-fw1&c!$<^x~<+| z2Ugl^onJe86hCd~@AymJhVvKCBn&Xz-)pqs7=*Wh3rMKET5UAa{!Simjk zRn&k*@*+p&@F$80y`EfxDYq1D36oUg2N+0IY1&X>VE_3js||~slnYBM&8lz`3H9>Z!o?Vq+K?>A1v6KVn(;}V5zt$ z$sCw4us0Q&T1LjosMTn0@6_C|GTEZRy_%g)o&j5m>4#@t6?)o+;}MM5>SXrh>|t+DHo)lc^r$@^s2EMN!g{=>ud{np>LnL)u~+1lL!@9SsL zR|zzH=fA1=|Af0_Vq*J`$a=TNX3VB2lJ{=y-eL%pDDF%0_By$#Aw3R>3y>TTNXx%Q zGS-6{VJZ^V7m)WiW!*I^i;M&lTMXb5iiV0ymkVXeciMglFkg;w$gjzSWxn?lw)YEE z3A+&G5<7=Zi8^Tpk%;jlmv6pdWjekcpHu`%`5YxTtzGZ?lkLml1jP)r=M9~&!|Bd$D^(FN~%i_GH__1ce$^6nFJ z9PtnckO_~k5#E6TF%TrZI&ZzdHc?Ay6r%A)6H*WUkzpj93Ga7hh;7uLWzu)h*s`Go zHN-SRQ=c&z7#b^^G&0YR{vByJua<O#pQe}OeTja8b zYvmG&XvhK=KOwSdgQMT;Ko?NVxV6IB7OCS)oCDVO+wXkUb~HL8%>vS#B(2IHv#y zvgzP-m@rkY@DB9{*4hkqr{#!|N8G{ebZ$~k;m_Yem|k9Yl~Yo@OT&SGAmrsEXO(N z?>zDz&-gM7*Azb7?J$0_4)^~C6+>Mlh#qJY^(VAA>4~$FnLb!i@)EaC< z&)UM60txT{%eIj_5`WKo*4N>?SANU^xv*cYJ#WKRTnps}_y4*Qxb|9PQ>Kuu(N!!C z1%Xiqi;w&@tAlObchPnXPLojvkQiKjm4mw$m;+d8!&0fr_}*W;)PV~(pRJ*vm<=ts zk=A}5m05&?Hyb^pwgw8|FeUm{*wkpbo9n5#t={s{a(=1cT%%|nPK%2GE;rWatAQ$; zH?v($-n&;IPpfC!*>N-rVyTiWU$D-Pebt*OyXC*T*e;|+wv6d<=$}v3H&;g#`c~=g z3`@yyXYqQs-NPevM#-1OuRi8fmtH5?3T^Q!%P=&>mZj)>&Xe0j0$SwyS<{HXmve<% zKjO8+)1x3rE2To-XQ9IZVr*DS?WQ-XfgkzXH+oba+t}||xJsZ@y?lIDo#+ILmwQeO{{AuG z3_K9CwUiZmYi^yQA+ zj2FbL1ZHPK#^PCKHcOOp^f4;CnSy7qaB`DNCZsmcRzi^IfLIoAGlRKQ7yf# z%gpRHlPufk-Jv@ddupgUWo^bllm?<6z9>7 zzjNgou&0*0*2siM>77|dUflj5RF3!C98{*8N?|IBG*}=InKOJ=MT1H|2>WX@1^m-( zKGjmlr2GL*6hXh3Kpj2nCap=P4L-#A`K zY}@5Pa+fkQ(iVas-z#;Ee-~P2o#**BP`nwG9Is&FxcI~>cTCK*UPfDPcz9#0dGw`U zQ7*h{VHCU|f!QaHniyyJ5kwOfq}(CLrBna}U{0A4g7y_f9ikr`+eO217{yQ1`U&KT zPYe1fNr3Re<3T zGSYVTM4J+aoX-_j9opGGdwrH)Ok_5`(b&uTrf$R0sMaU0EW=yf_cT!ZQ~W(L|+w#e8`^_XYDnYgmc zaz^ne$}rLANhE-zBuw=Wtw(SxBWZMw43Ai{7M+R5Cl!1sOanEQU)XvUG49jIpv_zM z;%J)Aug-H{!!{fB7Ul896I9c}yO<^V%7 zaM7l=x>RCJ&yTL^y25k(a<1L)!*eI}_1;RO%~a+;e!<$;#R~oznz1|C>+44erm+iI z{Ik9KXr?maK3ka7@gy>97}Xvq6U)plxvG$EB-JdsWyZ;xsbdQj7HZfoD_snv0p6Ak zB_6tDDN&kT;}SOsmmY+WH8Xf258I6#K$Q{J={*V(MP835w-WTwbjrD*sX3rDyVkK7fsrM@g)xA76{C5-sND0LW(ZrN?MWzPXAp@@LwPtbOg`XI z>zc`|RcVb3BBYRJY@wn?tf8yr2IAd~9vX0O3vRAH#;o@S*TuPSraW9&{3;K{oFGGy3MMghB3 zfuM}ZQ5SS;RBVCe?EH-t-_QNlo?$E+xH>b2M(g{Tf`5&tg~JCxk?-bcnbx&ngUm2F zBj>ENs^P@5Z0>jai`Sd4w^hqiVp;QC#hap+J$%(wE1-(8z9DD^Qp)BgdIKANj0RcF zb?Q}%On?y{A3X=riP=jV+XB!FREOoQ4G(>gBHt-I#)mUps*TpB;j8*k1l2MWQ}w3o zw9hUBSa!xEFnqpey`RGcv!n?@_+q<*a@f9xyOfA-RDb}HG7x)Q;~WaWZ3@WUhsRQe ztEIv!OHfEkI@7gA?c)nF4PESiel^h9KsrJz1(wZe(Kh)hi|0_otiZZ~Crt}IBwAwc z`52b4k+$e&MGcK4)6jOk}Twp5Pw!NvNaxvRvWor)`4|eK)y1JIOlc&q}75Xc2fXnEt;BwE>7hpki ze?rMWM(U2!d!Oo$My@s*t9rz{pSIZ~bbJ1J`q=sV`#kzOikmKCUO$>xp^7VBeaNSs zCcFCJ--pWu@v7Qu4Y!QL8E=2V965x}P;;^&@gC&u*1FyUd-Iws2q!+kb*NIj^lqc0 z&CrvYNkW3K(AOfrWtJcK?^}q*PmmBxr0Kaxh^|uE1*Y*REVQL7%7qpgPz47Gn;ZH{6#ZIn$VbjN+or4BymcISPg0|Zi0CfQo?_+Vlv za$i_5J)u>w<$azyP^*ISA4cVVfE_WVc3LIx-?}pClB?Od}Pcde1%K~ACp%=lB3Yt7q3D-c>(fh`PmyAn7&QWy}J3;Fe zW+-N!Qd4?3etN?@o{n8|)Tmzc`VGima5=q{QbtN(%Cb%xq99n(=h z0Y?~I4S2?cG3a9kWugXoJFvC-Z)Q#o(jr@rmIV-un7&TKLs}H%eyJmm?43^A@x?~p z^-dk#I2;a(GV+A1_I={=|iY&tHTY1N;XbNP~Qu+heM~y0vYz?~4hxbhrTI zdC1qt5xzG))BZ)qpxq#7^H#uimDd(@HQ=hsv0rI5{=3RK4!4`{v_D#=%~7P|lYMcs z6`W?GMYbMNVk!i8e~+C7{+T271=sV^KdjOlk50?POpG#JAB{|<9gUMgaNz^1o~jJGNMKy-^_jZUOl)=CK_L6fU`a)^Nl_QTZ64JCqIEdpW* z(Hu*N0!5UEII0NnkG-?PaDRmHvf^-aU^EefHVm5cbBarDrp+PxN*b2qlE$)ao`-5M zGIWP_sF+G(`oL1xp-m`ALLAb}r6&J2L#lAfSO!olB%63WPo9B}VFsd_b@NW%2*dRK zTiRY4Z`Z~@^R)N8y@?a(SNsb(9`!`{2zdy4U|ik3h7^NV2U=5zfAg-Khit*+2jaw! z2xiY10Jm(Z!1da<-VDX=iFr%3KDvNBhHQ8~w&t@M#TZ-$UaGZOa#9>o6Ro4#v<-EO-^s8ia>Qj<||lSq6`D8W%rn(k8nc!pAH4sX=+ zY+o|d;LjdjZ?2-ORUo%#ct&e0UnIa)kHJ7(avG~S3^_~ z$v1J_w3>IJPCEl#lUtZV!E=}bHb44L%on@>g+|xP&&oR%qHI3R%Ip~cu$N{2yQmJe zj6Lg7QH#^lG5LCu)L~Y3_f{#SNH>d&R1!|ow zl|}u8AhUu7_;;&@c=8o@muF>^nqJgPStVsmc}>g{Xr85a2N4B}X02a-St_X~BAaKh zm#Rr_>|VxRb`YQ&X$gq$M!+-a18bVAcWkbFkVQo5xMGpO>72#oYLnI57fXv6f7`oY-FPi2R z=Elk0mz!@e#G?TD|ErYzPgpWWR_6cugXz}%C6bCF_Wbg^Y4WJD^tYL|6BCkg>}+(c zRF3qI0OIq)X%LG5xszl6w~iaAZ8{^E(FBu(LbAQ+ znRHrL0M|UeySQ5sTk>kj!_+#keXW@CnQ?lRshVIJ-y>d49A%YTD=n&YKFBS9qDq<8{$~w$Bc7d{3+I#$jBgXX zD{Va(vA4JN<+(ZrQ{kyX6IG*K{JazjPBd6~b#Ogn( zfil74$pyggq1vM3&|1A769jLI?B1oErzk++=H*kBx@CVf7p$RVACW~KABV-<0@#DS zD^-@yZxpxKtAW<(c+}c8Sm-Nl6AD^1m8#zauWiOA00JO|7*9pdAX`@S-DC-tWU}^E zZw`P3UqF>DZGSU&3HJcPq_O6#%iSjPg|GoYB8`rAFU zf2b5?nP8RauP5(n*c~C`ENf0Xkg0O^=lB9_Z)a+O@!al7I9*hWtbru1~$z7jQP zphciMb*#}ks>f-<012Z4J#nQtzyQ*Mu;h3*TAigEua!`V9y0Nse=oVx*>If@3g-A? z8oa)@F0+P{*?}YM=9cbdGC*z{A4LeGyy$N`HqN7s!G5Ugv_yssSCFw6f;57lRP z@c|v#uF;s9NV?8_vxs=yD496baZbZLed&W10}Ps>`>iR{u=z*1z?*kPduNJwCR|>1 zmbYJ7CQBj^Pszfp6C;g2`qkcw%Zu-WMgZTwpm<&GaQVdXSfFcA_%qxn9aaTEa{It7 zY#d(Ef$}|oY;IvUtP%}Lk_qL`gFFKgQ9E5bfrAp^-Z4?riU6HR`eC7t^>@$h$C+&* zxyqhSkc%k~Aq=o*vFE`F+K2hf2qhF#5HS6vd-|`f>tQ}Qm4C$f-1HG~5#Fu)Nvd?| z`*6Cy6XQ@~LUhKbue@%z!Ft1wkOIhNqAVJdgId@G>EM&pgK`&0A&dwd8d_$NhYOR2 z6gl|S99bp71JEie%E$euO{n@NtL%e@levZ~2qaa$03p?Yyo$2<#}`of6`P z+Nbyc7RVM1Pi_s&7+_-cO`r+MP@HOH7<8~|R&4xfgo*U8cL5C_u7avqN#4EXK%vnV zC}MZjoE*17a9cAh(%`otab-*J^HZ7@{{fH)C$(VTKL+Tk2@?7S`7y>>{VmZ>Llj}n z(nP@GBydr>s3Am2-fg8?ORN;v#c|k>g+MEiDt&C(jU!(3;J(9|>hzY|ghUikf+A%B zs6@G22*^rFQaS@xM+`;gamW1Qr1ac$MOl1|ii3oXGpdmF z!Jbm(Y}Ankq@>te%o6lpa)ARx4Cn)>nDcOk@4JEc!%hVO2y&2eiLs#1q0pUM!hD){!z2u}s zY6a$U1JR;{JWsndl|+HOh<&*j8++k!kwhW9A3)a6iZOyx9JYNpLf+d6CGk|kR~+NU z!k~qwGXg*UMMNO?Xe7m6a&;r0P|5#n03{pA3ix31V@x1n2f2;)ZwlR9XxZ~u_AE%t z^!j%Y5T9LKupJ~}lZomPCL%`?gS2riKI_WM6;)Tlt+iHjHlCl7HC!fP^vwh<>`l~G zOZNEhI@Wl~N(i{O+r% z5R-v*De;@p?8{CK_vBRCES0tXRD6R=YXA@4eR$3lqj7`A-}^AN-wzkDyc4v@$HrWu zBPK8otLpWfNaSRSIbmm-FzNDTV@tEwdco3Fq!H~HndNTfljUK`aL^ArzXPt(bG z-QDkJrIo8<%RtsKxfoBhqz_>PdR)%7Vy0KqpqWnF_PE}JkE<@Z&kju%6OI#s?8@ZI znP@~F4^7Ubk&r>90T^e1H1V%ngE;K%Pf7Z<@#-Z4%>B3}R@?0hW>o6!Vc+`pUz z$iX{6MmNeqjRpxmu#Pa^cg0;>use;P3HEsd$hl|k`8_nOGHh)usi;ezrMH`>s|CD; zubP|Rvzy%LxKu}nWj`$!VPr z0m0#%TZhex=U$Tq_L{J-ouZyyv<|w=PO+Z=n(@%vM!C(SxyzeO!`9o$(l#ikaf@gf zt*t?grReB+{g^?^P#<)Y%CIsJlReoxea94<-UAPuykKTiNld+g~ll>tk% zz1W-bt)I`aKftFsP=^0kYx+N70DnE3|AkKaZB1i0#t?c=)J{<;>pa)&p5K#^ce$1VPvb_?haS|&`_)U2rKv2?#T>{lXx-zKBn zvgx3NE$P{+?sTJ3jncu=Ye-bs8aNtcEZLX6zQTw{)5i_6|6P?f0 zoesp&In9o; z50H3!)(UL5jxY7#G^;W5bC~k>6avR%iIY22oqQ) z6E%ymcdqSch_h0PLw2`qP@#WD6~P}RA<>am&_1Jqk;UXJgjq+?sn*hhjg6ExZHz=Z zn#O@p5B)@V$0$+2H0+YzVnX{WF3hA@t7>}g`<|9l=eoN9E{)1+Pi~jA+Vc^j+ zDEn+&&Wb?`Jror&|Hux09)S?tf(dkhMFKw5XQ;KR_N>d7gybthcE_dKcdOQ@3?2U! z9lKGnT!r~&fH>vYQJJ;uOd|}+2b|>%J$vc|5CYbq)+2J^165Y~tkT&ke_-c34Czn# z77?XvdTuakc{)QtTXf4V`tfE>=(+Ugd>>0o@4Nc-lyK1r5{`~kvap6eu+C5QX0Wd0 zg1?W{y)y08Q8mA(c`+bRchpAd7ckLY_w+&fWO@p5{ggGMmW2GVDoS`f7!wKC4dv?Q z64mKW=$eTBrlC%E=Kg3?n@UKTL8a;wrTi~gG=AkjANS>y_g}a{(nauhI=-#7>)9_s zyXLw2SbiRUyr}3fdlYX#rALQkn#Db(ol+hF9O)V8B8sH!;HVK9W<)URifQ@^kPAk> zX}`xEvL({66t|dU(gH?C9EpaIh-`Uyw>s&IV$6AtlpgFSGP2C=Lp*y*;n#_!b0!NR z!OwJC3sm%5Kf2O5jTriExcdceLde}LNWks4u!06}K>QG+M80$7J+B0$LqNsw-C&g| z#?GBtK(<8L55!i;&w6f0@vkB%?0!cPVG{R90G=3QVrmQ1#oD0uih_ETV=4Wb2LJl3 zP*arY4{gQm#cl0Cq;JjN(LvJIMn!9(`dz&c4wK2xO91@~I)l70R#zO&ae3o@Sa)g7 z(+`P@yZ67k4URQ~{me+XPeEd}gUwH~uB&-M8t?g&ScTe{JlN%jdNt z<4}GOVfSq{Id_)Dig=vQ01E8NLTzD^5KWzo_8A9t;mt}2Y+yP?>CBgJS!P{QHb)Lwn$`GwgM1#KV_FFw@Y0P!eU z{#Dg-JzH)8>Jl7*Fm*L2%g;%yNtnNeuX;W*gCcCXk1>;yLkAHV^Wq|t8}Z05F=G!S z>JnDpilOzn1dLjiC$vx(+N7xT7!^)m6|`}lch1)F=;J{~XjX~j-Y%^gqT}#*`@XZ& zY}45A!u8&)q>IO``1m6Ap@18iEiy7@O8*tsc`#{LFK?947L;~gocg>{4h8JM< zk0?CvMNU_xf(#G0g6ZAi1%u>=uyIcG(%Z41%{B%cj$Gt~lGe1s?^8xp#tJmwLs(%w z^D;olGG%t0u)8Pw2`K?|$Ic<)wJZUZWF$tc%84CTu+TT&KOg)6sau6zv7;P~p z^Gm=yX-Rcr=VZ=%0HXsdcU}!?4Z{1gCe@6No`iDlGKF~z>%(*;Ch>(;!?!~}cZa;^naVUg}wfkKLn3KIhZxH}UJ{oTAV&~@Gp6kdRKf$r%MHPD3}TBFH) zB&nsa4a3gL)pYz%YpqeP|HI&-#akHhg!eEWiNbZiz-t4IaFO-kbkA$#99iElW$DMZ zO(G3d6YI5m6$=gyRhEm16}fpKp_}0GUqFGOKNRQoUmEZfJnM58j+;)%_fi<)*gJtX zje9WuDS5*RdqPG<3(PD_ZZ^(H(_3ObSBOxxpxZWN1sH-Z{^mp^WYSUJJUdPrO* z5-@LN2S_ks>j;O`B4Acu z7^O=yM~FFdMl6(>r1&2`U=^`?w-V`!pOi4e zCrxiw<*0Y;3B@<(y6fvwTd1H%=4B}X#C}NK48OCj>2p25S2}I+UnGc$t+A7{qltmdf4=^sC}d{- zpWvH}4F8S48P@p!vakk^ljAFCR6UWBd^)Y2r_HCJ!yR;eo&l7sIF)8vyb?1uJ)3qn z(0a(@1c}!3R`CD{)Co*k9;P`Mmd^*#Gmfu?je-4syjpmsy;?KdU1m%fiHvk-*6rB} zJcU_Fg0m@^a%&qpF6S~_{~2)l^5}sRG`PL|4md6SYTi3I_PJ72Mq{uZTR5`LyS*Mf z-bT~&63BJ^wY6g*ZT);6deEVC?5o2=6`&LlWkPU1_Ds)4DA^ckbPu49I{f33sitZeH_&OSG6|!xEEQc{ht3- zbH3Ff+cLvynylo&j8&`m61}PjPb<~CxYbjySgk`md0p93WBWo{5(G4wJSEq4pU@>D zy}?@DY16_`PDvJ`XaEdHhKyMh4#E59UGWy8LDt4;MKvr032DAsU-+Lso)t>?Oid4P zSSF0aZ7N7SNHYL(G3?(M4p8Uhe!5*{d6({5O{-FZMLOiT$iq!JjY0T2U%e%<#o+UP zgv8%WV=-d?SLqwjahi+HFd%+}KQoH6ppT$n;1ds_c{)yI(AlPq6Z5y}Ma|cYaBC&I z!Vwa>D+7zL>}%YPZT7^|-Ar}t?CuX!-Zo}dkQyY*G(xL+dRQ6uwf-ny@MofDy`+f|#4AGeY0}S!u@(O^45dTW@@QYqWqW zy+xrJ^ctLuovuj5B#xohA?=ez?)xR(MhVZ5p}bHv>62d^Au}#E(KT5L$G%<@#=ImA_f^|)}QH6!?jjkHK%i@C&QDR47?r@y2;ChonsQ_ z&>GKgYm>vVGgfW~4)@vmn8)Crtij8$M6LTb=d&~(-AN%}g3yAwWi+2I`~Y2}vW=D& zVoIfajW}&kE1TI-mx@CaAVsyh&T0mOao?2;b7sgg*Gb24rmDv4nK;ISa#&6yj^QOva+xN`y(ry=VJcy$;#o>KkPOT=WGL^B zf3E3@Vf15toU5Q%pP;JN?&nA|fqWsELqX(@dig7kVY!!Y*$2ndD9o7u+)AArP>PrM z1x+6!S~n7cwm48^Pm%k5me&I}rRO4~^6gH0XEp#JuMG4&gmp}&waVIT=mSRwQ4$F} zx2|}14m_nWV97UkA6_L|971vAs=asdLw@HCkP-;Ke@Z-cKMG{Fl(?R)9m2S}62A{6T`YHK2k=^M zKhA-Ej1 z-XN|K9LPAjemER*xJpB(Q`SD~w&uUOvD2EtdQy7;Wj3RWVnIB3IU?)+fJ{AosQi(y zBGd5-Bua-7Btk`9f5~R}g(Dn2{|iLNKkl+1A3BI4RraWbcPz(?K-OJBBVf1PgJKzo zAxep=QcGtX6p<2C0Q&&yH5c{3Z^Qj@F!C!vV0G=x!XOkOY0Mmx!FOw?%qI|Djyj&t zQ%aW<07?C`oxJ-{ofwdzcwLVIATT#T#5&*BO07ALt5!e+_AJ0@!Q9$$)Z^IF)RxKqqF+Z4w9%wbw z?P9DBHPRN4)6_Vyy?E2%O*yPYO~TgN_Kw$`?rjhxoH_42j1U#@gj@>mXq%!tk6r>H z#_#Tb8Q$po0ZFRTk_4#AocND~W?3~aab8Ki#T`J7AB7-ct3FGS z{obC!j>-5|YBca}YPKF`@%&(6Mx7D#>Z3_XkR$vm^5?9bhV|ax9}l^v@oa6s50#v1 z^qq_rHH19W@~d}Ut!aPe&j5+nGW}{A*!H&UHh%|*PAt%d0!9B>SN?VJ3T;Fg)&8_>tC6soV*WZ}hpKb6^us=hD@wd5j%SZce ztx+pChl2Jgchc0htx)l_!G`IwXswxW@pGOYejlYF$_XS9fvtDfPtzZKv}%&&=GpPsyEOlc$<< z0{c?8n3O{TV8gC!g5-UcWzXbSEB0($gIn7961O zNhX5{7E%c4#K)t7@aW48Zvs{Zef9jB7VI65L`akrETT(!&2<*geB=AzoxBgbY7k9@ z8`LGHmG_r>=pe(j3JNcTw0b>|8o+cwZYU!EZPTR-NC?pv?{wF)4&$J8P_hzOtkc^D z>sbj61nXn77NX#3+XE^_#EyS0Ihr)Ea~^jR66@VA8f54#tNH}Aq$XugIA)xggU96z zYtmDIHR`Q5Arj0(h{{Gc1hojV50^@R(Sew5s9k*8w~v$?1>841LnKuuiXQpGVUge>V%h(pS&qFDK<*qyD;cMxkDX|1i;D9n4cG-OZ1 zJ=)tBrdnwIILeInzEq=G>9~1n3)Tj*0{VSnwZWWW&*EoVm=@dF#_qMzsT8~;P9QR-`+^O?DPDmP9OIW0iM^oBf4BDU zYIE&28V$&4h^rg6JW0R+yZ>d45@YN!KiDpkNC8T0)!>81P#z+ruMuWTYefbarG-+n zwu9*2zK9YkYNOzyPCVWYg+4}oHtXWt5%JgZ5E%Hz0iclAH9-o(D3UI}9V7@7cXTPW z1tG0j{pa23!=j=Gv1Q%S4M9>!bR+0>kr#{7qppE!td$9XdyJcLXPHp zmnJakkw2CA@~ZKCrwOGFh=7h5Utt)!oEc3%#eGXnO{nK(Y!9_v=Kd%y62#*O^}xg> zjO~}=c`T&80)kRry=~Q{eC)=VBn-XRsT z37LRTD@Nr5RUyquzmeLd4pA{UYC{BXJp5`5=1*lB*}@0Lv=B^9OYZbK8;ELvaTuG> zW<)pOK<@i&G@{0UF6pC1t(BZbeKk7@HVVz%ir)NEdTO$BtX#Ln)HOaK>bZI6ECAn` zLGI(O%m|Ks-A|@xK~sX!f5_MX`saT|&bNeN_BRT2*q*~TbX-FnCwE$Kkaah%qx2DC z33?CiphhtulN*R-=+tpis7Bm0cR0J*ydinzN5QSZkw1h{eiF?QGk7E_WSa>Vfk50n z&5_6QHf_No%SvxQfkML8;(NnMok_)!(|~1<-n&Z~@l}Bef+G2+nfIZ(Y1A1hV~b%S zJ+)Fr%%oQIiBY&uJTSsuru)tgz;e=oosS=PbC-cTLeNieR}2hJ>`})fl95ILwUW$+ zvHFEePE0lJ^nC4+5a;7kKCP(m!v46YM3&n8S>0HF3Gd;A*9&?G`k6X+cNmkv$4@pA znq>QB8_$u7$1xuiifPzGqnw5 z$q&FO66vD#H5T8}#~Y<`TS;yQtxr#%MOf~8Gf~*G$0`y^+J?Dmki!5kVHp&^aYfj_ z1jrOq%fL)G*A+J0`Exx*Pt#_ymi@hKucVEDyqtc7DUt&Kx0Y#*%WGbFo3w8d=~&eq zaa3O$d$Q6y|F$|i=U!em=X{%OTBF-R zG_JPOV0KH8OBv9? z*O4F2Lov@6r8#AT$CVF-LuT~2q!zbA2wSDbqzEuR)s3rMI z)vbqmb2Vju`{N?L=3CnA!GYz@i>s^s+TM4zH)Srn|Eq`kpQy+T94!Ck7i(7Eu-*KB zoh+v`nuCVKy2KM6<(cdJk<0>Eg>(-76Ph(@Wwcrn7egX^JwmV)QmiXz$O6&SBr&F; zOkqrB$e%dG0?eF+%t*0hDgMW;^^b;(6r0BgRL8eY!$vJ z3?qWB4Uz08du!8@w{>MN!|E>8zM_K#I)!r^HESv?yl;+oQhi7QiYWm))pUCUn?61> z$D%|j$HXWW@ON2b!B}gP_A72CI?B_Oh|0l!x}gVGvU|gK)^7(g^Khw^lgSD=U(1RQm)B)>6`Qe^K9|B*To)TH z<`sx^eW?{~6<39YzoMU6U%s!~=gZT4ry0*iJW*u2^V;F+W>wcKb>(UweV>X>Lt-eI zh?pf!fih1Nj*s~5cX*wZEfs~8R`auD1^*6Rolr3&waOm`K|*H6=u0w?J3|aOxr=-*jysNm zm&^ceLnA8@)VZTzN6UZ~yOncBS@+6iUK?%_hYa<#iBf4q(GZkZ>p(3QJ^TmhdwVr) zs@!F1_`Pk8Qv$DmuviZE6_YQ{7DsP~JdQo?)<9GeUY}^BZbwL;4WcC8_U@ZRe+?B6 zN(c|p`{-U`D1>D&T&Mv6y+)+>F;H@V3?4qd9w&Z+JdDiTAh@lvP>7#L`fs@lhmEV+ zR`^J6)?{!!ga}@*d|Az00ttnSI(3esf;h?C(;3m1s02JM) zN^gac3v%zA6*v^IwXoq1?lt*(*%Vjz(bpyi{CQ zY@T8Vq&9Fo*e~V%Gz=7$;TVD$sh8+q2d3GH3?cUx0K+1u&F*l!0ObtM<|Lf8W(SpW zTf|@N(&+?SE?5#cflE8gBZa~x_hinZp+6MCWQbG&bmjn2p}opY{ z)=<}lZY42^Pkp4t{h?gKgy6R`#f((6E+s_K<0>^=%0-K$m;8JG>SeiqR1*J70!a5< zMOeA=Ud7PXIKH#lUO>}YrWKcIX=07Xa=BqW4dQ`yXHbpNfmvEN^z$X(3$P_MtydLV zva&t25?~B7JgeX-QZcVU^4X%Kv;9MzexWYIkj;XryLToK^&w#M+zeO?KC6}xqH_bJ z!Q83oae%IX39Q^Od`;I+aS|7CY~pU%7%SWJS)0!HwD6@rMLz> z&KXCW!vB~8+iT@eD#NA@KRuHwYs65thrXi4tp?i6RucI%iatXEkYD_4S@@27Rtd<@ z7P7tpo@aIn%X)yC{1SKPK0?DvD>K&oWZ8OCPwyH;c-?gvTWAASU8)h)G5$orM9x=)UNw0MX=YU*tpS7iVIhOg3BD_7>LLvMfhoX9`OV~M+CH=&z{q|jP&H1g+TD&0LjRXnAIjGul?EaU zw~6B3RtTkL7UGryjMnWF?wyOL?+WnEp6p~gigccaBeyDGno2^P`!A2LD6f(?PO!8D zc9fH{*-cQ^e^@&45ycdIm6DUs1xNpm)ZmTU;H^KHL>{+j3U58MT7rpi7Tn0fvNv1p z(~ z-E-DA3pS00^`W?*J4<69Gqiy_zOQiG)I_cSN4019pMac{~qOF#BOR+>LDl-c5zC{WyafCP*hhW|pDfl3sWF zM;B2i_V<{q;_Iy2k;hAF=hkGav)H}#Nyg{U*@F*97PZb<5?;*NJJVzvWiwzJ9P$RjH_s+7PCBZT7j zpD=ua6vW@~G+4mIHHd^gQ&&d)^*S;vu+@*y7XjJkvlf4bS)^Fr!HU1GHKTw(V9hD5 z2_uoD*YZbUA>10eDdP|e1|t>v58n*`k9{a%*(+aTh{(f9IZz=~I=-qek?P?^^Gj+A z*4Myy3mP}Ww6Um`$%by?Mb(`3@DdhRl8=voj%ms1gR~Ex@GB*vxTry=_h7xMFn*P) zzznZ8HjFEJTo{aT4ZjxR&=0ghz6YbT8P~EImwr-s5wnaDRqytp?xghLKGdh(E@XlP z;c{EC1&<{7tmFBh&j$BCWEtL9;+^r=ej!rxXotT!RoHdLjw`_=v!sPG^Am0Gg~>MP-Fh)3yD}li_;~K)y7%3nr8jWe zi5WAG5BP!C{p=FHm4n?vc9LK-?l5FAf+d8f5cVPribI*C6qLlLKdzDO7R zT_2nrJ4bQ~<2dunkt{w!Lz6kqdr%nXYs5Ie?oLqaUk4^U$*_{Q&IKTZd|j;wIPi)x zLQQ$t{99X?Gpa#GfXL%S?Dq0#Ih?A=Pw^C%oath+MMi`mSSR-1mS!IvPQU~snVcw# z)IhS;9u^r+?wmV)bjM#$L>#Di&I!EB7Q?HEyGyxMDjcP-Q^&Fmcw_-N08Bd+z!1V7peI*! z3Esj#Xa=az9ky7;)jNPD?YxkNG?)0jiU*ZG8(80;rZ*Iu@6Q+t6V8C?9^ zMJIny!mf%wum^PJmnU~g8I8b6*Dv@fKv_T_stQ=Bgn?(mM8c6%h`+(C84+_pjxbt* zSyT3sVh{E87BGJeM$#sKcPqI-5s|CJw!%_n5CWWBJ0R98>`@jjTj_>(l)CY6Gr_xuFrqV{VhdX zT0@c4oqX3b&Mx2qBg(PKxXmGHqrQMe#gG&+ACY6X>jAVWn*-BDi!3iyg+=;Nq;E^J zX!pI2qBCeIlQ+H$B@dq$bde)CbhWbhf5;9w(L2!qO*D$M0i>tZ_4=%QoibSxVZ??L zIqUMzMov5So|?ZY;O|DMk-OEWP!1gdNwra=GOyKv{m#TjNtmh9tav@(&4<%a)3^!x zPEBXLk5X^M!l4$_p8T};L*7oWbnAzTt;lX`o>u&FEX7vGQ*YR64%?xbUtfIb1@6t% z$_5MwimMgxon)$2KTAqfEuLwHld7#K)au>#Iq%vDl~vk$!=A@I^9hAx&5)cY7MbFU2ErxH6?#~tknha;1b1iYA5XA^Ct zRz?CZI8=5mN9J=3F8fB%Z$@YI9HJ2nqWj4#ZONCfi2M;GZO>iUPj(D(i}zbb6yPLf zY^X))HHtyVwt@Fj^Knae?Rk+-fo@e*@YCW>^i#({hAf;GLHOQ7Y1R6*3sZc9KQg6m z5f+3_CLNyaEzS|WJWkaR@u*R0Dc_ib-MSnx9hFd2!K~};0lyW)NSHr>Gv;^NYcT}& z8C=Wb${$={AO9o}TJ%??WzSbaq@gv`PBz$+sgc&&?#|P66 zK-c_`K78)0vRZQmjS?WN;PF~}AQeSQLwP9GMR81T8F$_OCbqNn9L` zIW!7LYi>-SPOg8O=%D2~*g~D%w6Fp#2>w&FX7T?7ro_PAUXp(M{LZUBl=D63Rg>S# z@I4W3gIy|oa9bjb>fN520y2``?BfS4f71$tJUm&RMVs$0*Pe(uR4p1&2u8~WSB+YaK_Gfc zEptofep<=lbn<``MUZ&kG+UA)u{C!&T{`l;{j{>Bf5%;snTzc-)77uc@@4X4nol*s zL>L0bQvo+|y+?**IzrwtnNk*7`)+j0O6juFMziP9r16;ZY^7XLL(#{4-KbqQU6IoQ z&ZoJSH&qo{r?^f%g@Nm*epI41%;neo4N5N2cBt#Iw5W1$SXMM>;Gt++S>P&lZ#0Tn zeY~F^DuKGVzw|Uj8S?LKCdG*kG)I$3g zIE}GgBp!3cRW6-6HaodG;ve)OQ$bAKeecMfCh^j@e5zNhMqJPhmzxiFN*g3iVvmbm z$4StJpV#G9W{Y2gYpB3W#L~-Br}ZUzmIcrcaEflRQtGv&HpOm2z43{e+*Tw*!X5pG zFU|r0ZhsP9ePh9|95Iv!BVD<(K_a_fcm$%@(XieZXw4b{90y5PXrANIPh@eTgVYyP z=%2-tkwx})*qu-@j2oR188Ir=cjWV@^Kug*g1EWj;}-7sPoFIzybMMuz0)B%4?QQFvii6?qS!~9mq{L0ZcqEc+ zKc5x+>H8wTf!Ab3;^K!kx;+UdcRf!HM??c;Zn;CHnkX-jd#Zx)eMnrR zJpSFWfJohfaQOn{2cni?CpFjlVxXNymw%j0uSGN$oMcxp$GqnY2D>lcPDDRNuxDu zDK^sUcxlEm`zelL&;)8M!*M7mN!%*FHtHU)r?&?NQydy_Jk~m69B~@O=&GO&Ty2+q zT*y*Fbh8eHeW4)81S$rIm>3uc`v(Nd1ls(BAb=6tHsV6lV8{tq2Qe`MP&ytm>T|<7 z&FspDtiF6>c|i2ZkVOv4@M8pKy7YwjH2BB(lB9M zjrKq9`u&&uERao_MgRda+Q_&E02ouwpIu>?3@ssJOgH)X&b$2aR(8=$9prmLAwAYm z2CrkNdWqZG}L{|{sD)SU^mbzvr{IH_1~Y}>YNr()Z-ZQHhOR&3k0 z(e+()k3M6Zi}M%u#Ts+1J?As8Mn~JwB&leQlC>j2pir$Q1^Z6?>X}W#r%4vE0*Q2t z9P4nRkHvtw0j{uMxXej4xd+Rf?f3lJ>8|qRMr42dZw~Z-;f{g-(NrE9wP8@*Z)ELx zkd3DiDFb#h_L-wNmH*N>2I(g|ZZIE?Pn@%xP)bDLs@F)#b@>@#__Ngc!i9beM{~df zWpnA~dhvLypJ;-zz4xN705VD4_?e*|qKpqxPP;*v?^!A#LoDG_kAqvCD(_ z)lc_a4p|I`Ef$<5$VyV9;S(|#hmCRIWxy+PpU4AdOo&f4m@zTJ^Sya=tYDH{^&CduiecH8FeIDX@E!~a7&3~564NEDTuS|_vheSJkEY%k;8E3MHsFZt zT7fN(a;ZFgRanvYK%86Qppvmc09tvqvwOgvw|5tWU_`B8bCrmJV_!l-9@?QDc?Nvj zRhg@eINNmc1-7;u?o}2K-*UFA34h>s&{#z%Z3oWS#9Z?A3!J59*<+c1H3i~PB$K{b z+NN^*XBN5LG9>oe}J-!&gsjPh8z-;dHZfcgqbe|kx5v!h+3dw!^8*~fXKv(xwT?q zux3K8#k761Xrk}~k{OGr=Xt*i3Y;l>|SU? z3q~(uh_~4DW9G)U%ih+Py9It&=xXN&6VB9bCrP}IeZ)GQLp;3f=4VctD;6pc)7IBN&T@;U5E~h2(0>odL#aY;ihD}I$L);g!Ev=c?B+}Dh20_ z0#l_htP?;t*0CX-ap4l~d#a=>nB4C@efWdAtYi=|`-jqBp@b*e zz8c{G5`%rB5-~l_ZAsqk^Da>o*3`YaYm6+0Lr5|~CxI2i`?U*kP!@#nb3ORYmbo5G z;4AB_@`(DG#@`$ib!CFXyFA=F8o6SrnOvraeTu}Nud=clooV~hQ7C8dSMF^EJ_q)D z9;@o+V3a~h`gZ|U2N!|KlW z6#R0ePMn-b6POv-dw$v%&-W1|oJD_esLFV;iU3C!&TvgmyAy2y3=eB+b2Xj*?G0TG zD#$pRg<1s}$v`qb7Z%+U;z5HA2Cl z+_*CH1C@!2G%VS~x$#S$-h3I)_Pb?2Ah81JmZiu0@OVAr;RTn$7nd zF0^LYQ{%Jy3~zA5b*tmBWHk$}M(3ddqifODSFbE8z(!doMpM!}T%YljllL_ilq%%A z^Jd@G!h%sJxr$H|@~6M_9Rp(Oq&R$*RCafTlPq-Ml_|{Zyt7*?H6f#*8lIL+K`lrU zz(>I0U(6sJFprePH1*l{!D@*^5^$EP;p%I_CKSk<5=EEkmd3g0Fm>PD**8iG-LUmIjXKk(6e&#)j|^X z{r+22PJRs%)sPTPOiJ==^<LlTm+^ZbFB5+T1kLP5J>12mmkrzmhDuf_Y zu`cWmk@JB1eF0o542O4|uv1l1M%kcehcTax9D5(Td;5`r8O09jSWc+X*&8_wm77*j zbzdeLUBjwl(6G_V#!Q#M|mia_l$VITzl*HS>_1>s{bz;RSG~ z0-gt0Eu0r#6ZI=-78r|YNKx=V%+j=bIrcCpde*`qdLTw>DG8i7ccXm1y(Br#uUQ=Q zQ{7YMU@Ht7yM%OM#7j)~hUuDkNQQ6Jg~bmr$zhS7X62Fj^?3G=j9N;=)@g2QS=mZAPr>;MDku zNv`_ri3oUEPJ;59v1(Xy$mxb=t4Q*>$$~%YkR@i}2GK!-mog+`xaZ~n5 zB=0|)4_@#bDHC7DJ*~(+r4wY^i#U!wY;~5cbSIwEM^yPGVfl@iUmUsu^@J5G58Xjm zTt^-wFMK!HCe;auQ+A1FVArY8{LnBUp7yjb&@hYCsma=Qtg3CFZ{1Zvmnf;?X>=M1 zW`nvNMsw$`^S@9OWFB)%A=+d$1j@&t&G*|lNJYy4p4sVwW@r<{*=ZoQ7q@?-D1u6u zN^TEQ<_7CVhjOZ`K#?1fK%1{Kl*J3(`H5_r=(RWEwQpZIb>jq1k=#l6pDMb|B+hJn$D_IHq5yhB2 zd?8Md20vFJKSU7X;SYo5Hb$2*Gid%%O~p;Y-wJHwq;qxZ@xPnNmvi*=Jl}eb-OH9M zxSjtC&1c-1i@IkHh)mW=u=hvFjT~=L5-3=du3SBoLB)!Hv1*lAddTPiPpAtgf>G`IRgJvr5%b)PMmvYeh8ZoNLb zAis^*DFjdw32w@r1(0j|fz}ShLtJ{VLBbS2DN3o?;Y;>N77h-{{>q?tI%>c*3K0=0 z4&dzFzCmABs-A|=^~ROYb%F?PV5hcyjCaf6=)gnm=$Ic!d z)9#rt<%Or9aq;IxSu9Pb{4j_=l2WVfS2TIjZ%H~m2I8kSymyKp;M}k5$lE^Geh~=hedR-ftVZ%QKjp6_ zUH|n9^+R!;D|;O5e4rQ>qeC(#Cp70D{wTGxQ}LB32{&G_Iq?7w0y}-Zt;Ht92$qcX z)~TC047_EE{rt$pzg?jQ-sOFVoy@``*-JQqFRq9TX+T`rFvJaG%zw(vx^e-@iN!>At~KCfe#lwwjQEBjU*`ffc!7Dc*i)*l%k z4@!8UB^ousFkvt4nxdrfQd=pKLYxt+>?zf#SKJ&3G#Ch3V}$#)msIdZvW^+@z_`Q_gL;s%~U#q>yf zU+dObnn8EU;C&7B|6{v9rMitHKm*@ee6f?qZ4O*WaufqhM zq*=!R8V0%IC=Ra`dzyCanRi}ypNg-L>K+*t>(4TrEK&Hj)1r*+Cb8FF;eVhYj|29C zL?%!g1@XkUEjNKE7WUT>PnA&*f6wL#oUBxc78B@GGEv?!t zHO(+GjX9_MW_Vm6d3F`|=7u)kv{BuF9+2H_u$d3a5+&ch7IiG4u?_zA5j|+@4x*XzBcv)hb1YB{9vhxd7aJBRI9gx40yFYja3$%UC0X$!Q<`IW z<_s4 z1EeA+yIgAwJZhFPocRWLTW%%Igb`C_v}e6oG`qIg3ZuH|LLt{2Wk%; z#Fj4jZC{di3m2+G#P%ZV3G`P3qDq{EH*5bHgq!hD-JS+gLLVV#YLQa$UReszJR#jd z{M^4ZNjZm4tVpmF1qJj8sTb^;Q9fu)`sQ%?Rkq2=8J4e-1->NJ%9F>c!6O=M(jnslna4-{X zhY2v1mSnAo7qE;_ttTOo3dXI*_-znRfkqK9;{KlAqU3Nn`9TkOon8c9U;lkVc+4t#LU8e#G)X-sQ3N{C{$(~eZ>Pd&rJW@0FJ;}av$?}mf1Kwl@s zSd7a zT6(I zs+nTB$Ron6OEiv^Hdb#iE0N-@G)?_|&_s!yZLgV1&YN>zqAq#ATO5?$EpFPLm%a#|HWHb#9Zm%Q8_AH3okl|q04s}@l z!%W!^^}&(SiXm=H_fLNRLP1549FG9i!rF6**$w9ugrGz|3H^=j%>FA$iy0Z0lW~$}ngj z7XZ@f_>gQJYILEMtQw^b=Quofa!xLyu9lBY-vGb;1G(_&2RXNpfH?=OzGZsBwSASXo=(t;T!dr$7{)8)<%Ie67D9%xJ`TGEB6$mpJ(k4E>aDl z)~YM84JMb`x4K~~d<#Y+v1RS5>I_%oXeO;UH?qCPdgS8q_{92V590L;t%dALRQt9P zi%wWYm{Y7RVx3-%_dO=SV*hUBSL#0@Pk97;GC?V{F|i8RU!{cf_fJ~iymc!oI1!Xc z11mK%G>xW=csEny%*3dW*IblQ4ik5N-S6rq7tUtck?83 z^7vW3>g0i&Q!dahygP@0MBX24v3#)ss~|csnPPyoTkpY>-+undR{AO>*maOkZLnXd zS8So+T!h>dbI6f0b&0@xd~M&pqNXcmGa^Z_f7gx)#c3w1a>m@*DJs3@gVD25P2H@)}Fe&EFuy^~w z4gZGxM8vB@>+?Q!2N*50NaMeW_x}ww&B6X35T@#X5&8{Qgzp|*g3CeDU#L_)VF{Xg z{L8JzFb#0ye)@lT#~QFhuUBe-#Iay;EeJ$~F4VfJD@ z7y^CsQ)|2N=(zAX4B@ru| z?UmA}OI*WOf?!#zZ6-~XjJEF6YPG7|fo$&&-DEZclG!d=sv@RgwNh6q0f}`8U5vg8 zup+Ir7XuU1j}UuoSMoJ~XV&CdO}4a(bxnqvEC9V{9}a&|%a~C0aDe4x&5BrXqi6l5 zC4rYj!504s$1Pal8N5;{dJfDtBeXE`ds~y+L}z1gG|5Hor8Vk1j;aY^+iD#mrpn{Iz;Di#54u|siRdpC zjZJbeg{0fs&juIukn`%~3AN>u^|5vC$s0E7%4Ca<{HoeHaSy5WIOJOGDFkUp62lKk zx~F@dT!R!Cq;vIrA1ae~fkXOKDo1 zTWBBh+OQ%#*mlGrOV#m%(yjyBpxH?XcGT{>0E;2%V8o^qT7wm9KrYh0{#(X6aK@^8 zFoebHY2$u~p$cY5h~rjc+wD%0P?1PX{QZ(pzw-78hjp})-8s7CYvY%P>LoFeNQsCH z-&P5CIm4ah^SQ&t;8cRTYrWqS3kOp;?Im={4sCr?PyY48?7dx)@$^no=!3yFQ3$i6nY@G36=c8L zBfALMZst5<*jo%aMcmG&y)XipMKGk!yC7*JTB)(W5Fq98S%g>y_cH}6@!=w2YJ&Vy zL}DDe1Vy)ti1q6iv(7OfB{oj!OQ$MjSUR8OGvL6GJt7JTL}99ru-baWVB&1XN}XSo zVQYS_;Q@gdc?6IW`ziMCX4O1F*XxsdF7p@e>@x(p8!U0Ll{mm!aKHzw1Vc#+Rh?if z8VHv2n4Re255kSb{te5a{6&5kX*{`>x~N7T<1N?fM;5oj#L5%lmwb|OlpQ}w5?&O2 zh)SBBKUD>jEun~4*X8D4qzkuNYzv+tV@z7b_~gSh2$C*#mJi9sF$)?d%z2NLV>bx> z7>A1V3`rFvT;ebat=UU71_my1%KYO31^SNp%Pf@0+6EDtP~AyhJ}s)V%Gm}E%*Xti z3oZ=o-p`26-SZ2Rseb_zS*Yt&zIsbW&gfijtB&GZ@7l^KH+{ZBDo0=i!b8?jIqc;( zkh>SAoF#^`fWN}tY_Y4JsZ6W2GoJIt(W$zMv~wm~rblV2&$mBmz+up^(kt&DkhHFy z!y~VRc;D_1Sg!V~iTB-kqnn9?C6IX{EqL~npO;V#exdk)GEWOErN2B%Vw~QPj~t{l z&FytXX~2r|Wwz0zw!S>RY~@lw=F&*G^Ctw>`!WZ0?)HnRrmwTX9f0$JKaflQdJs=c z12%i>hDc}c6N=RY+;Cy-HwSk;7mmxCYFL+6cXw-GNL;=3jzDHFh^8Dy?5482(z zxJYxct_S#tI)D1(HUX0RKIG-<@S2IU-rWcuu4iA*Q@*!X?mPcY2mDW*a0Vv!|M+*T zR{Q^SfKwl3VKQYz(VuyJ{^cV6P}Z}I%fIJ7dRFWE73gY3$fc{_A2EdG;w_u#dE!9h zi+9(1TRg5}H;JKLkl%5sBe!_&krN+Z>z>by&+;h83Nc+5$)Sw!d-P=KuH9ZYz2vK+ zcP?mpQQlq#IVY`5l3uDd=}0owD+aksQV(|`O4h>WJzj0!gG6B=P_q3s%c11ws=3`m zLWRJx_w@PU=yBYW2xmqo-wAY*%l8`mh84csD^*C5em5w!$r>~#jc-*-0C!*@vBhhe zc88B+-ph+-tJQrXtp~lf7QJd85>cI6r2IH}izmX$*P7jC#GDVs=7K*E35_la7{;-G zw0qng-4VNdoS&ZKHRey7>*NokE!B?iCZkYMAX46R^wx;%J*GW(gJ?2Y<(eQmTIm)K7tER^n{_m_%; zm?M+b(U&2>I-3(J>gX;-lLWUmmPP_3#qt>I((yA@6a}QC^;J`*0w{RXjcrzDyW#Br z7E4hOB*Qi{nIGn6uq1}F?mPu-cK9*1L-;NMg>a3*P-!r4IGAtSZbD5N)*ltJ#~}8P zzevlxE22(<+-xGK!#|2=F5&jvNx&nIuk~^bbss7=U6vf`w?>DUXI;-3j;m??g>TXB zDEc|-KeZ93b*THOjM~95#O8t(5A{W9XW_fGbWHTr=H6?vfzz(*L zc;4MWM#cj?)VuGR!%CnXyI(&Iy^DU6fD6RvWyh?t-G7_5*xNLv%j3Lsg>zh0yr|lr zx%6;#vv+zO`0y}fT-h$ZEgv>IlowO=5;bkw^B)M^kYB?MyC}JN06MGLDf2{)iX`bDZk4Wxd zuDxhf76cvbmkx+uZTFo#r^4G;BD@cQEwx-%-z}@n`p_JLXf83dQlgQPp_;a-JQ8<= zrwxyX{5e`R9GV@t1ja2;DDGx)wbF<)ERyUO^MwvfIH2awNM&7FRvX0nlK6q8dNTcd zb9=HWLD2eYuakIy&xBB46*+(eFI+srNWTa%muz%ev3@%MMFf>q&M;3xUI*1WBhMOY zt`wQrpJ$3LMcY}wM86iWGIm*KK9{?v7W`SAnK<)fh&yMP{RWMZbBC`Qq}?cYRT6hJ zn^=X0G*7Z7Y5ir~sG>++ZLK5rSRg-dQBb(YB8U*SdfpJuq0cZa6oFlmcovQ#~CxTeRrSlz{p(L%KH=4j^{^2bGJoBgP8 zy52m~nQ!HLcR?OSQP6kDd{ZABOs}dH&3Fc@$d)lar_`C>{}Kv>b%=e)Ww(2uvs!UK zH>H8Y-km?hJ@0pEAN#^L&N0+i{8Cm1pxvKz-7>0_84fC))Mv@;WS@Cys^YvxrEc9S zPcm}mx&Ta(WBTLJFEa(OKY&`>-(JdAXNJBx&HA``U9NZfZ_Dt2KN6(&t>HJkAdC%&nU7n@_$B={8mN( z<~2Fmbhc6(5Ofhg!j+yy?_G&5t^y>A$fTK2;vY}b=g7{*b7}|*E9}%mhn^EQrpl#J zR4s+qQPqq=-;Q-$)t#N{o-hAe3=)>=wexHJ;R;mbqLig`o0ppaik|P8tsPZuyMkuF z+PkxjTpyp_ZAgNMlAX2TSiY|X+HXc|IH6d}e;yI6*ypoO{q8-LdLF!WpDAYsK*i2? zUmO5zd(7jY-O5OYlJs|NuI_uY-teN=_chl`eArQOc=h4UoSmMxI@V0qW_;B1QIzsBCnR0N z{2zM#r{4qj#dT6AixKoSvl2lt)(5+fX4nzmfIv^>X`cDY2GuGc=Si?1x8?+V6jX%) zsYlC1qRBHWTq!G}B-%Je=cG>fr19q@L-_$DkV!>+j(03k5``qP>5SiL$I?*sDqEzq zaiDD;EpbRx^yKTzxs@k(+gU&+`~^OZ>@NZ;iBFf69v<58=@K% zu(OtyZ{!eE?d<-_7N^0W%do%1{ctgDl?&`FIBcuisD{}>e=&i4+iXl2X%{yy3a({y;A74Vtv*;5o3 z22s*GPU0P=c;NxXO~0YVqjg@&~|=$`Xk zwS}8{X1?5@7_HeaLgJO{oVz#Y%i)S#^}JLf(7$aT1eL#k1C?!kf^=cy@Xuqn7pzx^ z_~bs>LIN*)bYJn|&C%p1+~5`h@clO3(b<>`1+%j7=p6;@blH|vedU`E9?3k1swPDE zNuWuAl91pFVPj4CcwkP)$~77RMv6gEP+ISfh#!x9aUYH%7K>wHAIq=Eq5#u!=8(hf!VG(^I$$tDC_l1I6H#01BZ&o2TAJa_LB+jYn2Apu%V}gvu-9 zbdFo{DQq{rApc4j&SX%W+16mleE2YKmajrX@F_XN+_g@nkJ+4cpNrSmnJi-aCkIJ^ z9--iWS5#Pn@U6MfPXnj6ORoz*@-(+5x9gJ9npR7#AAJTJ2sMbyZgT`lR$K8)LtdPQ zK}iycaZ~NAU-SS^H!uZf1_5i7)RmIFh5(83ER}KRo;m8Lkro!MD#(5g?WK6f$*ruV zk=Fphm1z-!ud<(AILo$+tXqM7fd}Fn+7Sw%*p)onT(;agnz3axnV{wPjkpR|tpRQq ztnEzpShgblXxn?6N(%jaI*%=DW1HKpFz6FFMAuL$oZ8qCwl^luSwF?w_N^SUM~jda zT41z^ol@ALJP#J|r%J|yu3cAVB}H5#dyIiM=*@>Wk$usA;l zLF0S!b9LZX_Ab~lBv+(0agwOWqt6^X0p?0NEXG}3P9U1}%=*hkn6|n0mFTlvsT?N< z&?{XI1Tjn=QuaGODTDA6hp#9H)u3k=IAmzOX1?#*yk3h0IXybuuqpdPmteK-Tl~Y zQYFd{-avur_0I}L*^Opdk;{5;w;~ZIXJa1Y1Zi9q#0)jkG)SBtI@<_iyN8-8<3$a7^bhm|iIBT1 zM0xk%RTab_yUUQj)$oAZ1t1wUL$W$qQw4j14Y8z{4KRaYH)*V(u!P2xlYhiZ`wT^z zWgwlxnxtpFJUS++kvW=uhv^7IKgRU`j_uJpynZqy!7Q95kB{;F8e3CvV4ROc+ZGlz z0w+jGM;4@fOmhGz?k~mdD+lH-RudGX6M${m=-d$(4T*?%JEMZY<6kAoUKBYI(;2|; zcctej9t7DcJVoB zy`!wXAb!@P6t;rlzt&}@fTS-ueK`ZMqsCk~eqURdz^F&LP1>k3Sn0#)Vu`&(eksTc zNUmuZ-|;eH*g!!Tj3A&!MY|>N1ZuGp3R$u)`-HM$tC=}gB%MtLoykk1MPIo*AFcR9 z*GiCF9G$H%L29B=?wO_p>o$*{Dp{s(nbk&jUvA0yO!2Oq1q3StB%H3eYvA~P6+aNr zyJ5&e4Q@&8V0Tn^YrL;1k8U}qzZ}FNcy7YKxQ}y85)?1$BH%DY&vJ(QAB^9I`G5h> zP*g(DUbgepSaor_CC1~@GJ5<7SfWEgdO#{ciIYO%k~L+G7byiuo@yIBY?~Xx6`UX% z#LT_LVcdML!tS~O4MiBErSX0NeqdczDtD{TALDi_=l5$}|Cv_Ke5EN~&i;#hV*8)a zu?%cXZ2y0sZTCM$$c89__l?>ujWXuHip6<%NhK_iT+Kdy1!eENVijR!LevC@Dlcyn z+b(gb(U`yjfnkzVCR5YtECA;_${u;}j~y}8r&Qq*@B0y}ho=x>Rsr{vy;Enn9h!cG zLyAc2h3`K6#{O)%NxZzIp+~bghT+}QS3qOiDo$ig71dYNkVtb&Chy{hPNaGuB&Y<`SWpxSG{1T10mDkx3W8A87Jau7OllG;eyRjc!|<=RK(GI{Hd?PWG0B!psY`pdk)z6^+< zdnx%}oY%gK;0$A;VR0?SXP%H$)tH$12M#7)+&KIj)XK` z7AK7q_qvQ!cZ)jkD#ZwlJ4E_XNPu)a@qjfW8EBwDToC`VLvD-C9JskK^Y2fM?Vw9> zP?a0_4VF4B6lBsK&-j;%%w#=S4Y*N#W~kFtXwRs&j*qD40&7zK zJlb28OQx4jZGyLJ#i25z#mx}4n}$zycv{N|O?hE48X1!iaoC`M$v1hcg*iT{F+S+= zrD(G}bY4DhRe-QAY$JKO$Ai~1fRJ!J=u5E>h8YzkJSC@9WC5il7gP#pVvWh+lye?Z zi+0q0(W@UJW=ocDVqer+xv(PHVk`e5uL;T@@-H~~@fcZM@}2tC;vW^AI#y)LJUXO* z=EgZQby!WC4cr&WO1#4L`t~)DNf$>4wn2(M1i;)0KMywb@cME+Y*z$>WVaLf)j*OO zr_!H)0^sCl-T}#PDKwD6zk?@~JCG4V#~^1-Y%nYqZQi4AoMu}2plM4^kJyn@;TD)H zCD!1i@7ErnQJX&zNW%X(9iePD8DRBDZKT>k_$abcRQ*x4MR+)Iv<29;1129X)p(=Og-qyMTzf6zeP%>YSK_f80Wvd79y-VfO?co+3IEk;*Al9YDUtJ0Pu(cgp z%L-${CJ@9~6(KJ|a2I&`ylLH9tw2amZzK)fQV&`MA=Gb`=J(0HN(S#*f9Uo!?cTQ0 zk%x=!pt~@%REzs+Xn07}Sc&AC z)EotN=sF8wzc8nMGQCrc7W+7GT$>yNb-jQCERi0#aXwl^2K(&I+PeSW#ZS(a3ycT4 zbarOD6Z!KvU9l5GM@=HC)RN;~ecBF10dYNZ+@L{)ocZNwWeybf&0 zMXJu3{cY>gx{eBW%j9sb&7~Lw+mNL9VCrRTjZwNAjR|C3jGmtoeA|n%bMtmTU#cJ3 zGht}S@0lEWzXIMCik_LLlX8L{otTeu$To}iO|oL2Wi5+pzs}guqAa)z6A9U>m!krn zJG+;eh`sPPdY${r+FX3uF?*`>$v}g^48e7MzBlIaVPq~r?!M`Ci!-}q2LITFp)p%u zbu_+oaDaMc}n;HoJPZL=cs1TJ&JkW5B#IT@;n?i zrE?E%AV=(^{vA4cF$4NmAhh$w`g&VXQ=_E#Z}(re|BXA!!1y1`tSOEEw~PmpLjkKX z^~)f!hhxpHUO*53_VDn|zrcgofJAZ6aKs_*C#RyuCL)O=L*rkK2y2y3eMd(}Petu| zrEm2sr9YpSG3cj^>XH4^N#|1R&2R)6wVXpwho}1gwekE_Y3bPTiD*;3m~r*hf}%)c zK(WyloKn_58YxfYIs^-F)7}P~p8C~cPQ9|`zdVQOi z;k&9tI(hcN<6&~iU?6g^UH%BFqR95Uo`^IPj~yLrR_`@gMpkci&>5s3OBI{Q`XytI$ zBg)U~SxTWxxb z$vyy+JWDX`)cBY>GT^ez!-(Dm9@nssm`r{H^x-Ot{XM zWp1!qnsgvE?(Iry<889dYwY%CzHlAexwzB*7(1l!MnofT!t%^9%7Hx|j)f@pL}Y}n zVWKv-V8QWdjY=NP>0mq&6K2PSo#{8dh~UWP7a$`>KC3_RFhE~H#bqSG@etuqVs_Xy zP&F_}HT(M^y+yS?2VIT{MwRP(LV~ibLCS%>O7JUeE*j~)5i;!!&?nxWq>l@Yz3P_P z_tf1}UE31?JQ`jbKILGPq>8eCJvpxU&Yjw1k3)J>smY6}Tbbn@USHcoLm3eET|28; zUlF1_VEYw}yzZ8d)t|k;E;^~`@~pdgfPBNMqY57qW6fbwjgJ~YH5V8_X%TQaEndA0 z8?+DkOOP5ayZ1IxSaF0D6druwgh!}=P*5>2RW-HXY0iq0^wp$($_lUom=?g(KA2$9 zuL%H+E&sZ8H0+TD#{6){LxtY5>p;lieAM_%Hd^jr2I-CtsMq0&e^Ykk5=jR8Rv?wV zrH}YAvRYe8`L4o_$yC%#pXXOE5Wj=@+k&=%=5+w-1`ECY!2>g5XQ7C)N9{H8dtUo% zS-?R2E@`PTz1mMaUS1-HLC6c--a8BkW`vejv{5Yfh_>_|&SIOCG@NKX0#xOe`p?L` zK^aeX#iXkDf_QV=2Mx4|VW6`8L_ILoCI&c4y7Ev34h@J{$NUz3v@NNlz@_jWaqTh@ zwCk0Y(EkOz?Q-aIDp%5jD&yML3$`^N3}D@dk9P$dggUtxTD;_~xoZ7ZY)(Hv>+hO) z(LkVehfQMw)TRGYa%=Hhq0kMB=0R(w?VtgA%NJ7qHkk??HG#kcFT9E}ep%qkqI!Qz z^Cx42On%~z5zcJ`o$#p4Pvf1L7dbOgh)|o&RZHPg+QqEwXky8o0n_lmJUMuaQp30k zy~ayTDp7zAm0VQFIG2$pA4J_sq2BQ;12q_`ysHJLQ9*`1@XP;W?`B=0of5tWP0toO z-aBLfvYSZ4U?BGTK>10!QOO%$`G4bi6ulY20YBi}t- zlx{o1hy+BNX-&R=9~HeFn-39~cAmcWc{ScVd47A0l9lWBF8q|gJT=qHGyNe@lI;>K z+0RfbT9f(HkK8{`tvgID@tUN4s&yFPV}K8^YA5#FCtRvjIPMhcwGG+IQ6>Q@-XEAz z+CMSh&vBrDKAz|Knaa7i6#{#O*2mkp_CVRaPiL!_mP=Tf8kO-v#)_meg26DdTtCwC z+dl=(vr!Q1g;SF)9wshyOi8rn92l1K5{&MgT&A0S9-D?_^1qp>+T)k@M;z*&#vHQb1n1H2_=Mc z6n29yJFjUSem+8}_PNQo$WmhyT&psB_c&ldv0}JTl{lkhmfBxITnI9^MpB((erxW5n6(eCD-z)%;+r*rQ)KEF4jrBT{cd1{Az*Z z*w#G6LnVj2aA-DTbMx&v;)OHS6NIt?H>X@+6r{QnJh(1C0&7Wi?$%?C%JGlCOs@)H^ z_sE*8mMTsNZ(k`DE8icacB@KkZJ(E)ae1YZIJ*`J@I9tlF3e~8?)+Gn{@WL+^>nr6 z%&a|oKO}Zpv0a8`l=vuBP^p3&4Ef;YS|iV%6^R$zTu+YA-t^ySQNg5>Tn5gTaqM=Q zD(Oak>yD+UN!#zm-1l;}7>sOL_F{+^M;bW}C!8@lDyb_o=fkKbJEWQbsFLf5e(Gz9 z$?F8NQK6kg6*FoVHXITRVoYj99Lz3&eRWm3IWwoz$)#Lde8Q?>PLkRkglb&cx2wI= zYde!57t5Sm5KcczxLCK4!yS85x!v0be#uRSd2_yf_60MCj$`{qlNfG143GG-9O#?X zu(MNFwWzE(SucptP;mV1A{Ax#R3$#1?JG}4C4hLyx(L^d{&BXAF|i7HuV;C5JBQ#K ze8R3$Qs; zjYGtNesqH$q(o3)Q59xkUms)WQkpc^{u4XwHRyGCXF(6P1v2A#N@)c?WPM>RmJ1V> zla;0(?sMTCN+*~?cnU?27mtc1@-8K2OTb!R0h(!}G`oH2@ zrClV4{AjU=|A(=6>drJ=qP1f?>7;{>@y1riwr$(CZQHhOn;qM>jh%h+jlIUV4%QgY z!Sf5M>aIEKnsRcz<7dA(iPh7|hbKINV{`t&v`M<($(f+PY}!t0G8Aziq?Q}XzuyFi zA>Kj+P_Nxlu`d%{D$dJTbhDUlVk~=fEd^uR#_3Hd(S7@<}%6 z7^V)XhSr+w#4}XEo_YfBU(yE^ZG+6sgd>3bG`SdPlWg9PoV>DAQJu3?@!OoU>63^` zS1tiI*8DVxkrbG~svDGmn(c~m_RGzhE-iQ8*$Yn1H$~k2@Q>xz6~4K)rLJ5!+0@}0 z7SLRy7-Hb0nvyF^AWif-{85SqBmTwBSa^Eb;LtX3OD=9snQh{$dsRmqQ*xYw?z0t> zz?o;5gECFs{(~+s!U*ElZ5Y(DTvDUbQ9Z3x8SdN zi^O-CulQl8GW;S--j>?CaBZ6N0P6-b_igMuCk~RNez$BZw|#DZOC?NxPZ*bo6@fIz z)9yOEukc(H60D9jL=+l-CtuWe)TnhK& zk;Nu&qN(AStbg_DjY3tMw+Gx7p3xMuKtWK^dScBx95SaQ-R+3Ypbce#4B+_UOtJlw z9bPdn4Xr`64Y#Q?Hi~6oN)~Sz*a}%_&&QHX!t>47UB|j$i zNUJvNQ&a+*^B)hjvjY}nZ^aFsaQ$1sc_7IO5+u-*KtMkxRjvb4rycAya;%>Ta>jGL zm&`MZuq9TWDaOuf=Tk(tjW`c)d-S1vMuBPJ2_!EZshYw~sGRGLHm3u|D*`!=Gve-= zryf$;`R7C&+cYH5uXLuVgLCvX`HJ9y|Kg#(GoPHa(O9Xdo7wfOD0r|5hwymk^;6bM|FOI2&P+E9&11!p_XYIxtjd79QOLhR*hC=$@fN z*!xLEk1jzd%N5+f#QiE<@DL^ee(5Co^jo%Bcq}?0NweZT7X3oFAsee(HkZw2<&|<~ zIQ@r{5CS)vMl>-oZ+R*A=+wZk7|LY36xMJfU*Vf;M6`+C&j_l(dbCGKC5`O$a(E-x zsx@1K8Wey|-kSOnTXLcJp~PQHHR%FviNEV6KfhB@j7z5!h|dTOWe1nDzqO=cg4iy9 zHJaejmZq+sAl#*YDWacXCCxkk9bq_F#{o%lSj&-*5gm1I5mAwzZ{Rv2_4_K2fB*Tk zD4KFOIMH{^EAJLEnsl<*{H2n9FU!2tQclB7}`GCUIywUnz%OjUC< zL`TqIn-15*sa0`Hhn>#?_nuB@!ha0#6x=Ry%)ff!heWJL@M#1c!N_)OT}38u2*8#r z(Vj#XtZK$`A#GQ-gWtwvS>bYpeZsxpe4Pm#abh|>F=EuwkvXF+3*xB;z;Bx=dL#JC zl;^N9^bYRckdaa!b|wZK0>~hylyD6Ia+x;^_i)_&@s9+QSAv18$|BLf1yCg700*F>ZpP9&$@< zAR2o|qt?iHX3WoOTP}YylZ&|TKNZT z;jjwJrFRQ$eSSwi^XRd?Q-1f@47TXgkan?bsldNMrIJIiSdR}V{Hpq-hIRbfAM`Oo z=q)NTR`r}RJ;+B-^K03E4q=5>N4AH$ImD(eqwwxtqr)*zh zIvsi6`~i&m7|`Nn{g+va?SCVsGSdBr*MCY?%4VMhsq0zgM7b=qbuR^Qon0^1oS`4r zT)Qrj89?~28A#3E$PK&T(&zd{p#ES^THbM;@CRvEF!F31d?4AW!+9Ze6Tro{!+KZW z^z41q^~%eMlPAX1w`IAzJ2-$QrMfqD=Ye<6=9=ntj4U3Dgtn!;t-U2>6A&wZR-$AL zvAy+a2%+-muBBo=`5`mpY|!0R9S}?G-K;S|f!}Y#e3pUe+3F}-%L|?6N|2EY#@Mx# zZ@skSI+y^32ECgH=wGYWDx$6&Lg7idhiVYFo_e^^t*fYSo;}b_W|T1^- z8-{CWhk1k{K!zI%yWxjIK2mP=G;d+SvKEUZ>Th46X0kH-3QUZ^fJLD%1aF`lRo6|T zMov8e(&tA~{(!nM4BnnnXx~b-e}Ag-3PRu`7sv$gfebAOer$H&9|XQOBq@Sk(N4V4 zQ%`iI9oow&GO#8Hh%R2dIlm1YUYr%AS*bi$H#*0lmv4Fm zjpWM0;5)59)UG(UtS&^^cQu!e=Tnp)2Blq5$XenR9qnJeuU>AJtaoJm>o0JET-81G zPL@(QuwTC=zYwKCXRwG97}&@~vjAmhove(;VKH1Yu5hD6l7#Tm z?L+`REtXhy9)OD%Mf5nYL9}?1iAKkJ-6^pATjKK7Fda)8H+itU*f-t2#r*5!$sC!#i~cnGr=&JRTyw#5W~bUMUb{+!3LfLD3R&Ot(H=#2_MPlT5^&`#~hWv z){XpaQVn-zI{8^{t&<{1d#}Kz{@!E16sC1=K1E|P|Lud2wT69cSl1ILphM^vZG+c( z{G%UgaVwP3u=jmT*lRqqB4Kaw#&vm?dgm2fwtnxF%M&?#YpF)Knj#Mzid6QEgZJ$a zUcu$&)&_}R_3P7z?^!qXyWtVdsTe-9c;V3~W+lB~hnB)B$^I!f0nDk$a*o)B8ilcc z21Do5f3~PbeL#$WAfbNsdL+zmN#M)u`NWfXPkS8zwxb!ciA@=3S^(lma*#5TA41r( zquUi&oO6rWJ71rVd84i;&Um|_LdG*P&q};?+r=_h{?u5D=CZJj?^4H9^!j-4%@e(* zfx^MKpHtuialUV}OV!P5uoaG%fdO|fv0FZ#4ttrsaGmHRL@in@5}O%-(-8Tj9ObJ$ zhH!08;2h^S9~rGs;=d@yFn0-|(0iY+{+WN!jB^#7XxW5iLo}8%^tb&&$z~VBQtU45 zm_$r3Tn*PkD`nLXrotl_;C30<*BN!I9dv(30 zVVLO{)&L8IzSDl8oO^(a z{{j4bnC9TV$o^GFYTM*vT&oG9#*<)1v9Kab5si!e>=PTl(R$cZ4NNi?(;aZ{Q!1K} z2)&<;NQ5lI6Hf2i`?=6F%&$YY77poYH>QuLX5xM_NUQy5w?vArRCGFz6^bpU83>ai zmk5c-e{o$pdCqU*U7Ay;^`FZOMjTzIK%w7HCw#%KCX=IK{KJoGG&l zS&T%(^PA;uum^2!YFYq;P$Lj65J;(`v}kFgmgpat?74tFC)D;>7=Ff6F_;E$J15JC zT&GkB6*?J@u6B@8KWkk_S)tiN)^BxUOw%?>$^E<#4&7A3ma6s3GrtW-Ya?@#jkF)( z!Tn-SS;-}(MfKTMV?m=8=un#yNQ$&G?qu?s2CNuIbd)BIm>Z8U;b-m6F1V&LMDpz{Ir05fVM7XhA`N~3p*j2Fc?Z?{_{Ih8-Y<0 z{+*@Qb(@osIJTl1DBbJtX46xJ^VLUJK55)l0%r!IG#p8dbghPXrfPvmHZo|#?Y=1! zxF#^(QPkS!qu7=$=~#eLzcFA^&L-}0uCQ)1O~FFoCZK>&0H{@_1nc zk{ix=5P#s=Ep`{CSdKJdCH)TrCzw`(Tt9J-Exb8s9rPD;J7n|;0UOc{Dy$^iK#d)b zZyL>Z7B8%gST-{00@G)7V0#Kf7lN^$ucpXg6iDf=HhHvjKx`ziw(^9_{wOum zQVVQDBJc*60?{wbo~?*^a55AEaiM`xi}&Wjm8J0@7 zU*_ttyw5DkV}ozXAy!xRQ>omfsIb8$Yh=)$hM#}wV7E8nZEVdnREL0u&_7=X^#Vat zWgJTA_4jC6>%rYWLOkj{6(NltPfULZV+{C$kkq9rU6?Eu9+hnVsd$nby!5;U=4sF?s#KYy0rPYSdy+TPv$H{yA&n`^UGSn&^R8dTwB#F<-% z;IL~^`pSnhB#V>QBgIz^eS_|+^^fwsVQ)N#h2KWp&VDWI2YL?#t2no^UOT@fo9JGq zgz+UGa<;NnxSv@`RTINRHN(GMb*k8+I2>4qVRWLC&e=h6dcN;U9;i@BkT3#@6TTv8 zn_s^_*jSJ-=(BewBzIM&E}=^d6FdG4B@@)W7J=O>R)@+8MBKDMvuK8GTVG40BuD5L z=L(X3{4)ff=Py2$jN4Xbt3Z3*GOA>4nulh%*jHya!TIb3^64cjQZuJbA{LL@cU9Ve z9J*IjxZPTFUOo`%bV&@Mp13#vCb8LUtP07)setx=>|67<8Mw*f-nx_k0-z$^GPbaD z&e30S>FisFv?;q!?43Oww6!mR|JC`98j6Y(mFHWu;4tlwYH(>(D1APREe^kVb&aX# zD+&r;oyzwIiBZ^JZS)5B!2P&H=t@=Ou(KS+dWS{))v!HG0|1JSd`wOo!VcnfJs zDzv?#m*u(GX*Bp>7kqDQCoM(lM6o%PY~0W{g3i`v9rjlF8S(=`KQ_}BX}GNZDr~XR zVC@qXHOBXFF&Q_|Tep4lgP}@8ILz(D;r`YtB))ks4G);lRijQBy+N{VBhZ+9emDdC4*g!dn!Q<%Bx&zat?h=EkLW*y6^86dT(-WIBS2Z zKe1R6Me=SW7~}Bnuuco6lzsaZ56P9{$fW}RtA6skQ38IsL+at&EU?WOD!N#5 z29$#hc`K2f+n1;CQ{aSH>(2v#MW9h=#^z&DsCJRS1a1fi2_@>O8o*9)LO$AXZsu_! zQQMKoGD*uCf;o+(P$s#F1>=hrX1aS)K+e2XD*BJn&NhkjJF&A9!jlkq+bI7&s=+y} zgE3F!=4QqvI5BqTl8$L|<1lqB-EF;l{_xNV_2Ay0I+MIs7a^St7=UtEcch#&p6em^ z<7UN55RE!`7C2V>P^EXB=u@BT0lzk^0w8M9JR|(sm}=ybp^hlZwww2>88%q46surZ zAFEJEu1}&OGQT&!>wwW9vAYT>rHvvzUZybj5iT^)f|=Rl=6OslPBh(%T90?x=f?;Ya)eD z>$4oxhL2!yk?Q&y74*Ho89NdmQ0{cqK@W)W#(-#`>X|>mP%Y^kad&=O!!^3ks#Vkl z-V-Y`SL6{kw^14Ws^>=J!X~2(d7hgaxA4E`CYkrB$3}J*NMaR@3)R=CFyMVw57kx?E zoCB?6v&-!_wrxw?5-`^J)o1^Ul95ZVI@l&1>cd>@aRx^VJySd?@F%$mx1c6V7|M1& zobRsn3BEz2)XmFE{xY9{?x1*FD-%1YbKCWdE2zK`inp2bliLZQ92QoSVM~gV7Tg<52>~*F-mJ)Lr$8X9 zoKK<8mAORmqJwso?~1}vqL6{FK``Nv@%)&^AyY&bodN_wkjMT&k*7b9G-bpPB(W}~ z0%d3jqDmDEYSE~nqw6H0rM$N~Lb*c)iHsIlkEI2Nr@t@L8hTfPp^$p-y-Q?5`T=x~ zxxJNoe%8^!H}1tfkmzlAJi$@*@P8N0RKavm(>&nu(zSpbWj>? z?_dBwLV1%Bi#XSz?uy{6m?kEip+5Rz(i7c+_9{!)2j_UPVg!27+w4$zH&%v-MmT9{ z&D3+B8EzOF`unk^`UW;Iv&e4W$9~mf|?&>1wO0vMi>6pueni z#p-K)>Ft;uq|k4BzbW1Til4x2S@1Jsi|23En9s^Xr*j>Pdo$Nxkm@WYA^)YTvj0!) zKYDid|5zywsY(1__TP^@dn0NEUpJW1DAVxt7AsILpDm8S!EH+%ITS8PK{%2v#`4Xz z2?PbqIIF7BaY)@kg#z>s(b4CVS@WYKR|ww6G!OHmD&n#G<+S+a7L?LdYOTF!Xv&K( z!{2@`ytsAsL%w_6Ib;<_<=1iNfsJw!QvS#5gm`%UI+vpZ4+7iBxb;e_(Dm?V-gaA> z466?{SdyR}yuBR{g$Bpl{!i*(RjVabg_&GfGLzy;Q%l8ql8&TY36}EukUVOik{rEo ztD^IzhyiaW`r)HB)^_J@PME5&mZD++h4p=u+I4%uEi5XcE#J);x#yuuscR5nqn>vk zOG^;GBo!=fa8z4W+3!ixmK51S<%mY^mNZgHhn^jb3YVU5$EI@C`NWW`hOx_Xc4T=^ z3861+MNg>#SK1oYB^xvZ$=mB9rM;E`JFp=~Ot%`Y>n?~r!OuANIh(c^l3QiyrC4Qw zL3{o~3%}CDuV}xO6KA^@}oS8WBd^Bk%2RvIrJ_6o^y}kNKs(N5%GHXCOGhU|q-^_(xu=y31g?hu?w6h_M^aGo zp%#zj+pYtPFIGNieY{c;7}q{Gl+V!GPWQM8xKbfN)i5z|t?$E?+eT6qB$Bl6k7zdY$(Vt`d&+;rQ(p}if( z1YdQ&gQ9z4RS#Ck8yq_NlgZledhn)WDX6IoLZiC4y}ehkOYWdy4&9<;UH@;$&Cj6?Outku!qo#@P*?O$eo=5%O zJQ+(!;`@)lve+Md8&zQO|6Dj1Y)oOemMh0#};EvtyR10xkX|0u(R98n|U@T2~#W`ya6ndSDawqY&@ zW~qeolgbj%$U?0kBEpry=IuZ7UGENbufLExgHxc`yC;OKZB>=BrnJj z^_4Y8+YR+B6$bT+ccN2HxVeiu9~|_YY;vhHw$}2QKrSJQsD^u5I7?kpve0XxmN}Wv zr&-IFmo6EA!Z&5JyMyyj8np0SNH*gu0)z<|gJ{wzkIwstfe!7J^wz7sgJe*GkE_7J zJzw>BtdUMBh5a--yZBJ;JmnU;b(eOpJ122-oiE{^-b-PNstEkyKQusm|QY)<^I(z6NT4_8EEvxdqBEfUF}NV z%*MMR)k6Do>i|e{RVs>qXq|30KvV7W=T!hmXk{CTnpQMKfkFapMOLdzUM&Xys(tkp zx~js1NFW2|U0oB_f|#Iq!1`Sdpqa@A;NW}pfy^Y(jlv^zrHFJNbvEzllzBJQa{;OM zJV{|U#y$~}M#p*&XGd7z|651E8CQH=>~d+FS8&C1INjxY3*MsO;_T8?FfTO*-0P)p z-jv1nCAtY-V*IKzROF8PY-zUby`G~zdQ%xC7p6sE6Ytjo974zf^uSZImiL6MoxVj~1 ze0bTT6|eW|B4&EXt_F6i%>&UfNq?&>ih_7F8q_``_4PM6=gYI(YG0m?f#BDnrH4Um zhI*mW4@b_zDXT&N2%j*126w5C>nH=E9bjctYN;ovH^*t=(=|zm`b6{#X|`XeC+@#K z>KABTq5EuN`M8mABKC!_S!sp&Qw%t|FVDX7ULCb*7yxYkz#96kIQgN4r=mf)bl4Wo zvOvWNZu7JZZ}ph*LUou$Ae{==18vBf#=W#~bPU#n^A8}^Y57@lXmsM&_J8LZG6--F z@IZCOV$yo3bP5e<;TLaS%sm<^22R4Mi2vIxcyft}y4+z9=RKF3k5EVS9g{WhFl+lT zei~=tzN|s7w7d>5WiCSNc0i>)?WW8?9@+NrN6a2&{!tlFI45RnIxF8-4X@Q=PZ>Y` z%h$i{R9|HHf$>1AUSEq}-gUkZE4436{@XTG3HJhKqD(~x>9R-1+ z!(flwP(P5eeK2wmjIhNL03uUUIJ9gbzg#oi!HCOfmKN?>skH2huj|w#>oyL@zSmXDbPU|~khVqVrC23m@Pj1}Ar!!^vfe80+~gUS{Iin0ejVkO36t02!O0^<$>2|a ztY*1EoJr9lK_r4dzF7(`LGI6)9*LeEoF7^s<5ED^9L|+ax8v&+N<5GTeON2op-zcFF*8M3+`LInYN#@jSo3cM-cl?UR-n=R-P~bmEg}MLsG(wo0C%TI&k_=~4)&MJNtMDa>$m<2% zDLP>2p89P%6eJTq`OjJQPaXhAWs~epO+t3FognP~WA?<+o`m@qG$9`Aqn+5|;a|2j zB=Z7*VI%|7xTAUwUbBVOd&G#E(MY;F^Mep z`ahx*Z+awoch)UPE=6hnRDLM(Moa=i!gw$)?rB6VaiN^TVWDW6JL69#ZMO@m=8^@G zmn;X>X?=RdNU0vPh}qa2tMFlfYqN@*R@J5nk`ciRmG>T!`~B5EJgy+CN{Ww8PcwB% ziQmk0zMQem!T?o+PnF9izLjYm(X_(}$c)G>`=#XZN|v|`=GT|#6gjjTC(U^gW?2Z$ z=1e7BAzP_p z%%X~Rp#=SQbzmRourp;MRh3{nCj?pkso$&%UM*_?*amLTwuV@2&c@bQVzGJXsUR(6 z9AEs${?IR=Y`Xp!r-cT+*K~TQb=91EP`|-n6u)_)evyU2v`17q@NP3ddYdqsYm3(k z^}o5Ri`}k@Q?vv1Yp*?Bfmt*uEMi$_`I<@UDMS@B1BFbhz_*NqXf48_v#rd2w|tec zi@P4*r=41Yg{95gF!$;UIFX6*^skW!XJKB5{A5?99GP*eT_u@?5xH^aVr^-7eriw{ z?CMlb(Q|7{BSnob0-+=dz*xPzesQ02kxh98f=VK2;(H$K~_5 zrDA}4l$1+G+XRj+bp_iM#Zd3nPoPN{4j@ljRtNSnVxxq|d9XCe77+xgoKRVPUvYK@ z!wtz4x`PK#9MA&*IQR8f2jpzk`U(?AFko$1gQPuLYF>$Wui81C=X#?D`!ver>PnkZS<0pT-J^vk!pvjs6WS;NDZ^yX4%9|v0EvBU+ljVE#_o^w%_xmdy%=;c_F5UP!y}h z8RIwq?a-korY4vQW~9pRDoDMk{!2;wDw4aRcD*8hlCt5kRefbjQ5*$Uud3@W)?GcL zquV11&uWtqZ>4014Rm+OEx^H{6du-T(&b$|t*he36rGGL83nmxQz2+wZ$xr;KG)Wf zv|hezy$(jEz@*sz-xprx;ZX=dPZ`ZE=DL^0QrG%>fl@zxRXSl!`R=XR(8yuhF9)K* z1t|I}&*o62RTl1-^B$XOYU&IVFbOd%2RbSOwPdrmmQ+h} z#P=$O2$1;5v09ro?W)a+Ar$Q@W^lvPEN@G6Drh`(D)>d%m)Ieqm?I$QZVS4_n}5U% z7gXnK-K=Lrj0*B%^@-}4+ewe@mDe0O1pG)?Z4Wjq+&!|w^~4RtWOxa1D#^Sf@XT5{ zXPzqPw2~0FV4){)&MqOiu*po#Fmb^h_FdJ9Ze~d=cyt1{E%GDvy_K5dioq?`Ix*T` z{#O>0N1Z>^=tMhjlOU$8)PRE23P_$e%K#(((*?GJW*Qab!}2Bud{cf>Jq3C$~t^*m}^nC4i&vC2{xoZ{|vKjxRo~)qX;&6ne~Wh zoCf(6*yf*y>77CreT8M2$J+tR=vM7m0>Qf@00Bb_7M66?vfDb2Mk|NetB?|ua}hA^ z(}0Me-Q^UNP8FWfy$0IEGvu6_Ia@Mlxan*r ze?H^#;)v)(L8sK4`Ua^KSzks5I1h=Xh8oh&%ONI%%OUKLcbn^yAUzGoT`GFuW@+vO zOkB=P1*k^UkwyZgD1jU0-k5v`Y*-(xL0AsDX8frLkxODUdLh5{pobuk(s2}7MXY3K z81#P(I1Z=d>`zXnS=_!}zQx22M!~8e<@3NXV4UQ2F8UzS;-sO8={EuVIikR(XXz=l zUM4Kfa4Yob#t!E~NVP`FOgox%= zoJ&^hjY^oh#t0?9R)cw^Y;dHjd(wtBE&`{iFv|1rR}D6m0IOpB?Rd>h8Yadd_~ze@ z23IV-{Q#%48B`E};Bs4o@dlk7X9%c4#KP9rj#cKDey5nGZ35uCfDIbu`2QKW_1QI) zAXddMIr&m^64JOrjsOi@HG=Yy%|UD~qm*(pvMb+3)^K$^QbOPnLu+3rd_uR7%8Kfm z?<9y~4{IoiJg{xUtVTAn`t6RbiPNt7chlr7u|hTu?rkAtj<+;;@~SIKRFbge8}{LQ zJai78i{?sV-qbyhGEZoVCgpwFhcBd?+vuKeghhm)SdP(wzNp4d=o;SEkT4_lqJxDf zyN+o}nw7?}TPA=58_CK29wi%gel-mkLOL{=31nOAQG+$4o(TE*r*?O0?E~>4mK}kX z+Z;!a zE*xx-dUQQK8&79@=~f>38UsMtpcz+laIw6b`QNS+1YicxQWd|f?W zu0LOIxX#sQyp0C1Aukyns)X@(4V0ZZ7#rHNmR(Vm;>-mF|UP zXm9@I&L$HFxQB>&-K`6G9~+n1GH>8eNlv(fluD_s^fgE~hT+xV=<`8O9M%Y!q_Jke zYi~3ePFOJ{4J#n~>>^PwZ<|`4$~fiVWjQY~Aa8a0e4ZU0@d%SK9=v9IQk|DqX3dlr zn~ea|ycoPSjaGdPwg2(=^1}XjiuneSrV^z6Z*#)`$Q@&(`+wheU22;@Ix31!PmjM0 z>s(aOP6qF1qV{>lhGs&u-SzGs=PZh$op>0G*s4>B&j)okKpw*Au-GAC5(=zuNdLK| zXEUgQ7ITd5gGfz!muEV8{bGInVhVl=N*K!`ezTe}pP@hYh@wNwD;-(vILGEYO-@)Y zoAG6By4&mfcGI)(cgC-dB)pIPPg?JrXZMaO7w1WnZ;JJv5~s4iEGOXC11k%@6AY zlJ>EKNXWbIPD;yBI$o?A=z1^Mo+!u4dRMD3F!@^>qj73%0-85)a_9%s3L?2^Vx$d1 zJ#ad1U17^HfS^WYx>?a){*HsUx3!wK&BQ8|!4GB2XC=9#89{mw2VU{Or?X2p10$A(g|0sD`#4Ea9LhgAo1K{f1?_5 zOYP(4vk0OIrH@YJUK2eZ9V2eLFAPvd0mCQ~2A`sx?As`Pndiq0=x(Qu)N@A`>{D=4 zPjz#E3w@tLYYB#`b=@ElckxH9q8r`Fe=wgnsX>gLi;`aMb~EcB7(auAT)v!Zr!=nw z|Eu4+nkZ)zJ_YU;EIXP1EeCE)(k3VlDtv!!hHImNom$em~-l{SFRT}Wt0abU;6Y?1FUY59uU$&1NaR#eC}KT;rFOijG>EBLtR>6bNj$0)x+JKrJp+hgSGTzMuju-&*^zv5SRgBT3bN2sQxh3<*wlGLMd?lr z4QvC^JMsYjBXs+CHFP6VDlqRAaU3EI!xwZz^I55a8-&>IGeham zbsb>9>XL+>h#M!u;@M10HWL6vQdmExIX0B5kU=h|DB1zj_^ zhS{Vyxw)lqg0y4Wu1j^kL6X96vQkt6W-$O5P~?szcose~j-GcWCX@d@C+s;IT6L{# zfXXTWewO@w3MF#PYzpn#VnZoXz_As7h}EzT!e1yCn1;k_EEPOi`IKD&6THE!QFCA`6BL z*B1B$`=enTya6@BE>vfLt-Ji%6qS(1>D9Ijy+(+g?68g%7(T=@kH zH%Tu|O57#Y0{&LG6G;v{BXKVqqk91fYE%?B(dq4)o>U*0q&zYN?BEdaw{?AzWFyVub=wi+WM>67at zgofE=wtdu~ve6g2PbP|+w@uX-D0@z{8a9)XzVBY|o&!<+h!yacvqgv<8ftiuC?NtA zDVea9jeZK9ZOhZARo$jiaYrkZ#tItQzNqX9FPf#H^?=fv%_JdeV#(&_Q+wHkYVSk6 zX^5VZ^Cw+5J#%G;`b!VKpmdOIWL!QWU!t4jemy3-IB?`aVp)VFMjFLHR?&ISnTG4TBa)MF|XB-I;QVZ{Ti>$0P*sqbRT zySv)Ma1W#4r*HOP$?E-0*BulT3@>>yWbO#tL^~^Mu@{SI5&p`7+LjXPwJ@*#Ah^e5 zCayHlr{}tSdWY-Zk>)eLbr}CUO&;iGA2k)Je?B1);`sS@Cc+`9rm-4`;i$W}sUY4b zWqYsVbdxy2CH8|{M!%Dggbv!SQqA{A^vbtX^!npULmvL~lTV3MuX{IW1xaGy1F54{?9JwIGoZka$=Y!N{?)Oz98=T{AUaL%sYJ(3GEo zenqS*<@?DExb(_S&5<$%)$NED>KgR++O>hxL-h8SqQg z0v#PZ%Tb-RYdOzN6$3i0!f9o5`x4#1kdz{ruvkoW<#I>W2IS>i-aXQko5`Y+#9MrYF2!l>aK+sj%WJ++1I zLr8@DwJb2&_vye4-tCo=%Q@wu8VYM?MmTiEViy(!!?S+8Wd2H_`5;gcgum9$N;>^r zy`bL=i_XDH$aIppEJ8I%_;W10&4HqUA!lC7LtV>*e9+bq<~U}zyY>!Lx##Qk-OxoG z%Ebdu*z-2w*84HO4fQ^f_^$7JGGlLh?FLP}zf(1+#QU95mPs(c=%IMw|bV*M3%k!yAH6 z=u@70b$IIYtFaKvBXigLww?c!6n72*mX=(AG*WCC}|keLJ#uz*;X?MVvh@JJvp zfisyh*f(uKhjaL|%HGf>emNs4SKt9wtLFRamj}H#1wfL-dE`u;XXgD6pd0~vCd>|W z1M$}%(JAMiXGcRIX4x8n6BHj&Fyl=v&sC8qHoKKSrcp0F5fasL#_LmTu;g#cG<$R~MI6mS(Oefa^T}Y%=W4F*F%< z0~{UaZ~H*i&IKMuNH;#eXf;?5V43XdZ)RIg&=qR5`%OI~MF0E5!3^FP*rm%#JG2j?*mpA&G<^myvEvJEb^!G|)ttFJ4G# zJV@?1d{)|_+{pr}owb+}$oJu}7^X-Xy0*D$rn+e}+Dm(%!pZO^zGQczuBNbg#s~K? zuMmqJpT1hH5RzQXRk-&6SAV#@Mat3sy0Sf-{KHt`(wrP`w3;72LS~w3y17n7v<|Po z=8Rt(A!6Gg`YyEoi0Y4_AY}pfu%-U2-JH1cCKsJktoub5A0GKuZMKmwUr3dJ8sTl~ z?vQl(rS0q+V6UaPI3eF~VBEGxDDg&Z9R&J?hwzBSwd>8bYYh7?O7arFIyfuBBvu5& z@lfhvy7mX3rk*qlcr?00ll=Fmv&BZHQyrrsx;A!0bvSymfe(8} zfDk@Z;1eJ3#Z5Ibj>98gLrv49O?-V3DxU_AL z?U^;UZQHhO+qP}nwr$(Ctu^Mq-v8*^Rr_F{rBX>HsigYpJKguyN&{osZ|0VFdzD`! zo<>cMhZCwaTqsltUuZQt%3%ukQ65Hfneipcu=U@1 z$wTI@6R;@xgR=X~7=|Q_;`8X)@rI6`qtHsSvrF7-1`f|7^z1lGNWxCPP0-Qj*dDBf zbo)fJ9Y;hkJux2Sa4L7~`PYUWq7?B&KhK@fNL&RJ1;^Ds<;fNQNJ9vpu=<=kC<`B) zb)uyXPY!X;E*`WwWzz9~Eueuy^7uc!mTI;ZL$6sTuJ%%6yVhmdWt!?Wq?Q??9qYrn zOJCKQfsq0&(?>c3J-dL>h+FonKh3 z8(}`I`Awe$=%rBukU~$)D%^8HdIKQ!OJJo}cvEr)P%!S>I8_aV) z)QXjx>eag98hxFIvXIVPZhW<#gseu(m{+bH!H@~dXJ=vAiM_=K2f_N)mxOV$%GSf* zUFHE5`b;U{4T~NqC+?`o31Z3N317n*recZmhwjR19$o_4LLW|-p@Aa{pBgO z&-ILY{3&nc2f-g-Spq*Xv?2Ui3j>_;?YP;zVz@=>K*QvD8V4s$w*x9Fq_yP%PwZ;~ zieu3b6BPVrTJ6T|w`QY9n3K(4*jvW&Gye8c=|;)LBAjtc>{}xg!dVh4Ow( zf@KT4oh#kLZD4@Y;CDg7It&!tj`a#1NVbrOpMgqJzJM~p;mS!FqApLFwx`e<8005Dnlg>te*Sfj_8-Vil9C~~Xd9D(tc)n* zJ=!qPn`sI)Jd-_cQw#R4d37-{adBkmyQnX>R#l)E5H?~oFhrBhyHEax#kCC=Qpv^1 zAGh=DRHOXjkMX~?2uAW~(2VOx^8{mK)nG+nqG6bpjScC;LqRGG6W;arYF{E3BtMhH z#@FP28eRgCV7^91yc~HkBf*RKSaIaAjK9LLGUTw${0AqK=&#q)ocpU#@{Sc6+;pL2$#D3YigBPE z2cXi5Fmb?3R}+h>>Oz(z;oT?W)wa$DT#fpGG2$e)&kp%$x%dCE935@Z%>d}qLf%(W zqY*GN2D+aAY;zkaI|1OAI=gjcqAm;7sSZ`L>AIdMX#I;C4CrPIzm|c70?ke0D^gK& z^B_&17<~Qrwu3+2*|xCVS%tbpc{-b_o@pS`IR}qpWagonMvU;DxRsx1iGK>s2--0; z^r?DOp_>Y?jdw&bV~aC|lCh(P5#ERen_?K+TRHoBaR6DSWjZbzou-w(7Lq5GKW}T- zr)Ded;5Z{U+bjwJldXYZpqUt+=w}6X?4A$_6A$IkMtNNuyNU7HsLzGS*9H9AR_pb) zu~%!9Y(ixcXw=r5ScqeCx%s}LNG~fNKc7fQrPOU{XJD_%iju3T?=#9GtLO89yNwV? zLP~*y2LzuZmDyYITeCM`gV70rM$zSX(yIK~{c-<3_K7H|v}r&z;s`o@?lGjuAvgVur~R=U zxlAm;Q#t24vPElO`_G)v)|y`#|RP_WtMA^`VaM8&4p{==Q&5i2oB5jf3?+62z4>8K-P^ zgwVTBs&Z|Z76F01{j4KLOE>t9O~y89I7T9PWd?un>z3c|*7$V#F2eN)pLNX2H_H}W zmp)6+z%BrA$S-?*NNfrD>!3J~`vYW1`@lxxApu{kedc}?6KdGUo3#5z<(+(Z1!)S{ z3l9{g(ZQ;)@Fw|{SIhFv(Qcvw%huKN#vL~mn?3KDUkLP5ae2tUn11T_4;Nu_>(WX6 z)uxN?jgcCmiqoQ7Rbnl7mOFWQT?Edv5*UXdVET~27wr1Ts5VRRl^C7mr@?KZy*cI7%kru|Fkz8ra~|%i z=iol!QHm^Gl^gFF5|*_gWDU*)@vGFoH?LRdu~Bc2b8~C&BWK>&s7m56X3jJXzXH19 z=9b+JYfTp|L!^DhPzAHj@!(=j{&#JjF zaJzJJ9q?LJdLrTo8g%#4cuI=>`+Ps@A>j5r%606fXc)W)hcjhy^Ai?&KwnlKL+oHr z$R+mFnS--#nrSoNk!DNR`M&9dm8@Pv_WI>;tfIR*8_EV%u+84CoE5H2*^*ymW$s2C zJqR%ZCIkFjPindFC#X4!cKU=IH;)ogB$kp9&FdOs#z#m8l+l7%XPS%;#>$MEycUzm z$b4*dFUd)%VF^-)+%rOMYIxvFyy~mAuvE6Jc7%mP;a3W5UQRh-!LRg@J2&1U_=yo7 zms_qeZ{p)1q1Atu*ZRQy0>k{$R18WfeQYVbXTzKB@?O{w#|*SydH0xwv>DB`Die0~ zyIg{(r(vm0w0Bj}S~%0uGt-2u@;Hm^3?6DwTp5OzWtPi(UJi$;0~8YzkXeL=eQ+TS zjS1;SNo0MfPwJsu%9mws^1wRLGoaX9kqPP|8&MFig_$vRt!ze|6kcx>cn8VwK4oZq zoS1~yle4|%=^>I>5ESFsNaYFZn`*pgi6u==VS2r<9%L}X>h5mvMrCiB=eVpDGGsTs zyp)fkaYd|QY9IIO^nL(QRwtkTOCVtQpNKw;|G}G3B3GtYrUwud0(Bz7XOtJ8Re?AL z0$?@+3HWap_@9s#j2!g;5o%^MrQ){#e}B(Y1GqhtH(%_mCl0%~E26$_D}1KyY_sbp z169RXF37l@T!M&#BK*pdYrG6Suz2D62<7TkRUv90&3fPG1VE$`kBsA(f8Q!o?B&~%D1rL2yG7o9%5FocjJ9$bL#8aC0u zjK$8%n9#>}u-6-pQ?P^amrZ8js1iDvHhMaSsdImkp_E?X2xvoKS%eEpAWfD1!IYd- ze9YEKgUwaf4pVOxd>(mHSm)n7TYJqbu5ON9G!4X9aoRPR@LMHwD%{E?nIB@7r*?m$A{Z1R7be1-M@FEEHi% zhY?;Tscc4#dZ3z=WBM_FTTp|@k%%@nQ99(6M_+}(7%Ahbezr7ck9#?`ZE7FjxIvol zwK1KZ+OGV;`_6~B7`tzR>5DHg@Tykw{7|pcTIF0q=D8l|<-CLdyx32kbVu#8I+ss~ z$P{V+fwr7FR=a)B@{X;KVZFp4z@pb)3;&_|^++dJ+YLK}TX*>k1pVZ!&W9^<1NU1r z_*Z^3J6W5~j0UB8@`95NS~bB86KMGTBZU{v^**~uuKYiMdve6P`<8mG&z$v5uyNc_ zYU(-`NVm0HX6aNPD*d8d+U7^_W3|%Qg)uE=i7iYA{ES=-O6vgkcyOPy1j+$Up=x~Z zbRuQR!V)ekf?!_;hlvU{3nX3+hWU^$5t~&53JHnX=P`@>tm2kOcU|TG;26>ye+Hym z4mBh|6En?gz$0zevL_Qn91WX3XA&_P+Tb({M9a3rD^7y774adp*r+$}7A<{1@Y1Ky z!OHVQ@>1#}(G8L`mAW@jZ^E3$b$Fa!%ZAvQCM8E3j`g#}Oj5w2~G>T5`E)2DTRBkkcn93OS--B<&Ui_>ex9TW(Hw*+DCr)RSXG?-_87jFpg3rxD!E=pIpPU*<-ijA zoc3%?FtT-Z4>tpcaTD6ueD1+(9}hQe9!D$xC)JqTG0$9(UR0^*i}7w0@fBwh3?^z4 z4q988RbOCMkG(|qLuEGjtbsgB@2E@3Y5Wrf&8s@IRyWU8MG0xlVi3JgFy9{#BBY)1 z1Q?$OK@y4mjAK5j-0yhPS`}1r`i`j}9sAwsmZ22z4!P!WE2*{_l*{ z*to0ZzjqHM&N1iZFnkZn2CIuK2urjuDrugGCA!Uwsv|o-(CtZ78+bP;>m7mBuociD zKm!Uo@QFo5h;>l&t9gUx#{1UQ{9Vg3XOdqXjdnMx_d3MYIKT`|F=O~^Fk zNE!xWA$9-@(#ho_qFJw?o#MEi&81O3@=>gQbC|2jmVbFho{jA-JzA~IXd?kb0~WzV zHmIMn8#jN6?Y_{1|GLl$be_IpZd3HX(-Oov?x;;?OjsQ{>B_R-q8p8&rH}-r3B~h=I96L-l52ck zO$;C_$pc1&zw>s}aYgzM_j$uNpGud~24~R0xWQ00{S-W4hj~PTXcfr^V=Ff|oX9qi z5-aY$*U#w!o9 z!{G?XL^4sN&dF$^`b1d@wdQ(UOKG)y<9>@B2MQn%(P&4S3v2Lp47`i$ z`U$=IOe&Lp>!~3VsAO@r?LRyb{a`f)n?fPEj1mrReLlcn@jw;#0au~lMoqpt0d4Q+ zdF8k*Hg&DHI;-FH=Xh1b1lSarB3oNUeKS*>yn0KBqMtUU9A-S-*5YiVh$KhFxgH@p ztUI#~J3tq&TJS`_t^(||#K2TG+%PI^zTC-8mwX)$mAAm~`LW!MOI%V6&gH{%|C4nY zv4$>wNXlRsKwP1uKh>DyE1wzVJjC4^j;_;c|6-a&#lJ!o_?L2GGIEYj?N+LlKY;r- z`JoVqJD#8qA%>JZ@MPYbne5Q>0dH~GxoY|~T_w^BG{Wv6`=$fGkojIwe{n@e$uYt zvvl>nDhGlUIiJrPUR0=U&1l^1PI)lfN}tPX)viWGVC+9?Zq6#Qh6Ly`s$9DvVBe2u z;lb?lylpvqN7Wg;WJdb9wR_Xg$MMJ95i8C%|XKL zbC~=^S*2{(KRJc)45@JL=yyd%Kmsn&$M?LU)~H!T2Z27+qkrG5M@9i&8OQn#vW>TC zjXf0^!9^2{;2yl&{zhD2pn$T9IBHkG+o<8J{teKA8r)E40VwkAR{jWd*SgNjb(!sWF?3*!0YU!ZRCL0nU?Di|!9&x^kCR zCk+RVx8(46210$N_y?s&+E=Jj^H~N22LrF_hVU;TcDA1pQjlXxUJjdg_yA%Q-GDBN zo&h=Qfc|7!DJ`BY0|Ywrr`R3@4LGeofDjf0{H(uot&t3~EGbk&Pp~rwLnC} z)i0tQn}|P(=6nZ~)M3F`KsP$rA$n=FhFd*;Ov>5`G(?qrd(JcP7^F~CGQFY2)m7oJ zXwdJ2HhIYNzd9z{q?IJJzw2_Yd^{-_S}C-o7sw9|iDzx7x<8+Y0qw zBob#pizuATbG%fNlDLOz&BR(|i+_KFi>y!s4qg)h)`)ISGks`O^j(ov%o$AD%IQbnKp2KnM6rDc*}-bWc?$R3B>= z!a#u=uTQzl0ac^?-VvD%9_gs)yOj`c0XL+Hq-_D5Y|6mk-uO8l?!$Za(4 zOooM2=9j^Q-)!v6b$Z5M6_NIYBmaMrgEo`}pkvJE-H3o(sHUrsKa82BA06Z${!t;g zxk%~oO$D{v@@tlFha4jgGXD~;2oo{B*=NR}z9wHui@*_c3##~QK!LraZOyh~+~-V< zZ6(D8h9!SW4=cvi$((?FJY!KOcyY&wXF+xLBM@{{ZH*wXVBH+F;~GM&<>N z9l=yc6QP;-=$ZKS<_zo&fQ__RnpjSGLIXc?5juZ*bYZKfCts zaE06Z^I~^<5Orx^9{WbU>PL~4|{xGHWr-Bde>fbL=7S!0SNF;7?zto{u_W0b|ccyJ2Lp_CT6^ zqC+cZwYsQ#CM?}cm0Q&vk4G-jPz%`{XaR$Vgfh7ugtWVacCj$XVIVRNVp?#>Vd%Jt zLq=djZ~Jku*zm}(ss%($xS4+C!|;N`)S;w*ML;{4644{Z`sI`rSS#(672qh?BW85W zI9B~?8XHWtPAVJr^o+L$=&9&2?E2M|8MCF`=)f+&Za|N<#;$))FSiT@dUrLy5*TV2 zCX{rn#d*XG3KM;)00ttVe7wGkv;Z{2>VnQ#ac zP;@LsdBg%Ya1jwyVBo^?8Umqh3&3`!Ie@)FLp9)pognPE9p(zab*4GKy9hH%zgl?# zLZ2a~zkVPnCWHYZEG#~%r8#aJc6`4yGs3vBFmOKgGJUuSA}p{u>jFP}l!dX<6cb2u zxF}dSse67vJn9mFG&HmNWMOI(io8u>Kz%78roUAIn23IqIY5CvGHh^bdT56FEV`kV zFtGdp2*>!pEotC-n&tg)8&8cOqSg>h2wMhNkT!lH{7w;OkV38UfP2&>d8H|mLoHz; z!rlpfp<$Xd2>Svs!fcII`EdJyP{H7+e}=md%y4@|*cb>jb93SLbTC5g{vT#SZQ&vO zK~T)lF&eh;|2t)y(Zm>oPdhGqfSD#Q%8;blAS2Q!uyBKY^1jJ6$u|Bk>v z3jn0GG9PZ02d=*f3AOP~*^>i`GM+ym)zq9HD0O68bA!?v(OL80wT;SCq>LSDMTQL( zo-H*e)0%}XjabkiyFWtv?6!zJ{ia$Q&wVU2v{g0_a^Gw_{Qai*2lkS4+fut35gBtVwd*|36tDR) zijuuCw_UiPQQcuWaQyd2_v<&p9hN_N$MK<$HdaK(cKc~>8w2iWE2h=7vF24~;dXm< z=cO=>ygHHbTGUoDS#g%da+L*JrzqP>`3|#-31Yw`|L;#b62@&U0SX{AqP#5JF4cKt zF#}o^ct|bK`3Oy=n9FvmYtvK6$$gcKLuamY{MrsW()$p?4 z(sJepd^(5i_C6T=VqVZ|q+s7*-94UtgYq6R#aN6LR^I9l0b<=TSaQX$#m@r(DM?%Z zsjiO_YnEZ(T%3rDZS6C@vo{4XZad&tss=n1XQn=YZ%tM-K?B- zMq*$jWuNe>WB+WlkjyOf>T z?rSN~oBZAgx;wWJCJ*l6k6BFkQ`F}X?qJd9R$`qGZ-lBZH3PPMAQIy?KXucnb?!c3Y;+BVRq%84p}V8=+`j z#%y|vqMgYCA{&vpRsF|LD`Mk>$($3Bdj$@pf zU4QkDJYRn$i_z1;bq)x)dF0q_z8?hRdkzW^p58v1rZvA0^`_%M^Hayj(ipt(j}qeg zS4l;V)jDOipoS?g5O5*-2~&4XHK7cbm#YE1y2p{1ZPOmmxy_@**t0#4uWRWs=y!3Q zhP_u)#7 z@Fm{n@TsfJ`OxJ`lsYyW1i`KfB3W?&oLVdNFG+6Hh3Q;&SM#O9a#9>!*=&4ir;KfY zE{@`!!xi*nyj`$euO4KWT9L=!7UU$$S>g|NMxGHz?#X^SDz$!|-8u!4E3$UQW)Z)P z0zea84Zv3??Oaf>o*Xd^uVf=NJrqtw{XvT26?y;oW_9E zsnSo>{iVmtf9wpG_UKa93%)K>$`QR(<@q<>xx9$) z^8_X6IleFspOH<(t8P{o=zNxi)*){Vc)NHLbXSb}dPQ59zi2j0rjLTa5LvL8*(-p# zB9;Jle@tHBNWAEJrrkaFaP-PwE1`Ngd#*9y=q{?%fvF}o-Kzqy_r~|MXVdcDQ$+{8o-HD~-0ZK?gf7S%eM)-(vC6>A}OtiNi_2 z5?+RJ9dS~3M3D`jY=#!!FDS)^$|>wD?9AG}n$1BTSkjV>kGVbXuo|!utF@$|x`OWu zx`j=tBrdY4SEYQgV->}^rC-*QMn%=DJfP^A<&Yg4O? z#xy?Lg37rEZjdOQAi}M_L{2VpXnieQBzEc3qvWNv(A6%?(JQ56cu3+Q5|rGmjKl!)P>*RBw%f-8)QpbH865Tf865Y8;yCG~P(Y$Z z3cUH+J`$05j`h8tVGD-96uYJzXbAXG>!tR=2>mdE{&tKMxhhxh7O^BYwCLpGh;hi&4Gba zIi7CU9;|HcnDv^4eJe@E9Ql67BwpeoNk^lDaaC2*?|){blm`aCkyNY=uGZ zU9}kbhs2xo+{CyEWpLmkmjlt|%i+uvO`X8^;DP9*Fm9C<#)}uLBn~F`S9in-HR-wQ z+9XbN{wW|X1bn9mkA;Q3Rw<4(pO!)B9Hcv~Sbg^cXot@lu?(U2=Bv~&1Ij$k=5Z_U z0csMn$T%*0@{{w>@9zp)))7>A-t9A+?1h<)k9JlR_pn= z+8*Y5QpS>@T(QD@7q8FrXmSQ3Y1Y~)DzyD?FRxHX+fJ3i&pr3)gF3~tC5yk(+= z`=7MPQPr-1Pt*3}jMeH{+L>H@k9GJw}8mNc03a{6Lohj-AUv5eV;^2P zSgw^Fk-#JMvCy7%Sp~jLAPHGrum1*TK(M4llUBNI3Q`1ShqiruzuMWXZ%b%usnIy< z$$yImLF#Xy7d|0V2FwvI{uu@Rt*q+}^W9+sp^C?aY>5|pbP2Q8^w)B)wwP2c4<+G= zdFT3DA5S^;%sUdvBYbZeyt$5ILy?PhmiV6;UeO+7i&Pr3Gba|UG1a45C6eP{&A0T^ zO0rXwgl2Kj6a*_m6AUIjwv>WGi@uEWz~OifsY;LbW)=`ziKO?_z_{?jFMDD}Na2)` zOXGwy(ubFH@sSGFDg zFi0Ki3w>|y6r~mfDM9VBR7#9cO^hXm64#=9S(P1EzA2B{c9C__QFL?AamF>oES!)! z-BpD8rXynvd1W5mtAA|+4lNF(?%is)`E}DgPN?#r~Z6JxWDb967 zjFnkpQx?__o!AG^7ImHL#NzKx;v1>au2m=+wxva{+cyg4W-;WqR(}|}n_X5C)+~9AE_jhdDP-t(0MQcZu_`?r8hX&Hxb0+w%<3MN zV85fn2)04uY(!x_ z1t&qATL}aE^mVhX6JvJyEL+UctI|FRMFvE&M^5|W7hO9eGFW0{sU!PTN6+_SGb904 zCxaX%Q_{|gAPxcabln&^zk8E>u#C^x_IHMv0!2sWcVI0rKRPp6hGEhXK$(h}x=F+( zDVz#NC!qHwD~PK@f4o6(;=^QTzmkT^S_%l^x9tQZh9SCzT6+Nd%UF2d72R~j)Qlwf zra|yCCuJ!E$yz6L#c)h_9DRap%325{K>(YQ@wj!z4ose|JqL3Dkn<@a=1&~?<(7I| zkn4qHOAnLmJh8L!{|sM2Fz{*n!`~y^+a_&p*FU#}UtT$~c}BpjEtQ%Ua$3<~H|VcB zM8mI%mO7g!KDU<+TMbSAGgSa5q-I#~}R48mq}(c?Zfn4jdj6MhW?;>3|cIB~xDk z$eXQ*ZOinmc5JzZ1JET6imyLA%mEGz1e#}n7^I!m$gC$gy{CNvht80sNfx`FwgRN9 z!?#XbL!W+U=;_d`6dgOnbOK8k8m#$bR;K8}`+Vzryj=!G-=$bxJ6~lMP_}+V?%n@x^cwixmJFjtGhF$;F@7QHaw@IoOugON zVnBW?HC9+L_vY;3$3`YKwRf<3&U!)vh|VLGTRq!)m@3`%YsusT*#Wz;M}7-@ zVCRrBL==~rjDzJWj)xl|`_qT4Qsahl+~Sh!cmK^DAOd!-ZVSwPaaCu;&V$6J+J`00IOt7$Sbn>zNm2HfZtwrZE2a6rnb~||4$f| zBNm6(_ECAixBW+odSsMKu6OUI8p`DKD+e`n`o_vPEjhARSN;ybjN*wNc$Ck*<+b$W z z;wFM1RB79r%(u-;4rR!%%TN3g^)nce%Hoq!pJ$)AxcmXEC!IE=xd|e-L+Jks{Hm_B8wW@ct$CCD{kBZf`wQ7axkRy^h)wQmDWQ1o|e6_xs5+oYARO~Tb zd%C_K4mp%1iIqDGhhbBD<_`s1cU`D!obMgDaLu1SZL%f_)^T22wI;dIu~wMtrJcqh z^RXOSWhKfJV_`Ks(N=GTNtXR(lGj586>ZP!+>4*|szo~somh4@etPgPH=Hc^h`Kxr z4ou5kotNJQp3R>DZ?;vbFRZd$e*5c%t8cwEd`<;7vsKQZ)CxAek^>@x>@GYmzJ*{> z9t_A)ce>QHRl6TOu4;A@Al^IqX4oFN+po{+ZEUi;UC@8T#4$&rQ+ZMCxF@K?Lr)lA zLGrs*Njuch7%w~zZSg9<3k1|C0BbMBe_DrT7FcyplCWy=e7dD4j8#29Lyq)3K&7ks zC+r2Fwl`W3CtN`eperW>Cm7E^QX5U4VtogdF-v1!ijR%}H#S9bBP|dix~`Cw+UjFq zHQ2c)4kJn%Zf4x2G_aY}=Ot0HE2R4-)j@5K2G)5h?Xg9VY2_%w3*mZjx+ASAKov7E zNC{v#sQ#6$d4tT!SXmUwx^CMotUY&}SHihS5wrbt=`NBZ6Eg%oOcxotpnThJGfRbd zZW%Cg3S(+k8KrJl%WwI;qI|t{#qQFqGa~$QXzX;2B0l_5gQ+Kw@bVW_%IaJS-!)Nt z-{A>9oVnv^cl>>#jC>3Im|rV*kNkENM^WX6m0V<9k}WCfk74D=!zPM-)fdUpq-9FZ zKQfZMuF!;9UL`l?M|aE=<#Qkug!$g?+G^*9&MY^gK&hI2D{cl9!{v2f>EQ``w0{*t zOh>0T*Yw+PQu{&y;(_YR?-NKqXC3@w=snE+a9z&#UDgD%W(ES{?Pzcauo5^E>zi!Y zHYFwn?UPTVg`!A^^dq~M&y^<}iHbzgKH5UNYkxczZAes87YVY85mt(o(G3j^C(J9&CjYGqA&=xgP zm1Tssa0zYVeC)Prq>$cV6m%%TfQ8DKf8}97=eR+qlZ=?)h|6tzj!VRi?WMuV;PXlF zfrg#_xrV_=lcXsfG7mbb=L>XUI#7>s^A+U9dO{vflOfSz##wutkmmgbQ{KB3gW>`p z{>rDpp&c%@a7OtmbB66oazNr`589p#lj{gOp}Kl`nOD*@MBS&+&I%%w6Y`$y-?#7S zW4O#1I+#jV@oRcLJhM|jf}$`FT+uvMqXGug`zP^ioUsUYC5p|+SUm<-P{=Mp z6wazcfeADD@nv**k&k(GzX6^2-0A87fbEGY1no;M)YjG3LNavXF zfUt&Zi>fO^gx#d_JI^MgLI;*wc#p1Y3j&>wtDo`0223d9s(qdYqdXyhrf?ehB^*6Q zs7`tI$6SDf8Ubwe5(C_KQOc=5Q_HR(7C(PW169)QYeMLnbk8Sge?j!j9v5J-=y)Xw zcCpafflx9nrzc&MVp?-X`?RkY|7ah#RNhhPg*H+bWN3jW^)L|#G6v})zO5K}hQXc~ zL*$j%Q`5U#mro?F0^LD|WO(KrVN{_(m{Loa-kKEpFa~UhV~e1^uQ^4RM^uqTR+nb2 z0iTENJ_ZX8Z}8W+KUSRyqcr&XvxFib<8n&g;Y)(TD(0i*2K!f)bmkF;!`<1eNK2Y5 zsRsaR?KQimDPCdUNYD{SQa9_Jb8qV~f$E{3;razw24T(4PlHZ&YGIM5pPGZ$74SJ4 zvR0fb8n@qkFi5h`dORAcYU6Fud=R-CF%o1+r{k4hP@39l0~z-Fn9FTk!c$aB0-d8h z&osQEfqtiX%2mk`ElaQ5UGfQ$y#X}1No?R$M7lUWe^owMz!`gP_JCx|=mLeE4X%}D zPOV`cTWO;|{n>%te(AuXIrASCjCMmMX}y*8|1c3*lr_xLgKi`w#u@NQJ_@trM&3VR zpWkO;A4~HU8b3hQ8)ib}34wP+AwSfoc7tj1zIY5gm(E^WJBa?8*xte(o0q2Q0|Kre z=6TDZz2sc??<1hz#7{Ohbu?jd{q%%>B8^jFd#}3F2^<=c`Xk5XG|I>j*P8`Vn_Zd; z9+EvbdE-%Nl(I-+MvLoj$*jOKdr@?o-EkXDCd=a1iurU^N$_3b(kJ3mli1$;8nq8i z8?wpW1^=7XZcIWQg#j|yeDR{IwkN>(yEO>BulUa|D>lh?&HwslB`oGf6=qd20E2QB zr&guc_l{M3oH+R3R^I=KhR49j{2ybdYt&@oj)W0<{!)1l3ADHM@r5E&Uk6|*7V`ig z$sTT?lf3A2abeaB+m&@zZ8ap}rUP%LTsL=BRq6J4swjP_)CUgoss8JEv}oW%Bl}UAR z>zBEcduAWJyxYoyo#JGU3w+1@pUQ)lQ@P*-1`YuoE3}{L|Dt?5L{T^dR&%Jk-%w z{9b6Qifr!2`I-*7GaxOvtIQ|~dYyqVTT}amzK5HoBPtj_vFb|1XxMx2W8O#ei{%?( zRy8ol;4%{GaZEY#2r6+Ng@4d$8A|P!(kS(X*N?-joj|(0-3pD|pH(kJMRG7Fh74dq zO-4$RJ?hhtxeWsepd(u*BtO$~&n?W=@{`tVS#eOCQ&F$+^#V?8TDR ztnyG2Sz-lhsFs&){N@KS&(}-;JJ9;Tiy8%n`8wTGdsE=l8sl~4?L6~Lo0DB-_&ylR z-l#~Oy&~GozwjPd6_q%?8C!3b>$igMq~1RCeuHpAm4II`c@d$5D0)lf&tw;6wi72! z3;vXWn6%+c?=3z|5vn;l?3V>xJ9d9yO7cE7XSC(vdJ2@#CrAH*410|IflU&xSZ+T57yT@hEI6H7Q?Z}j;I-m@(mbKX{`nr+1VRQ=_kWN z5%>>G$9gpJY&Xl@27j}gKn;=(165!kHPfdLswP-B6BSN5@xMNhPh`8<%7RAWbC=K# zZR7N+WCPrWzjNE)sJCq&yuKHW-E$#w5r3SXRXM{F3is3cBGulFT3Bk>CaZ;c{9VQWSlbTpFU^F zCu|*yF0jkW0J3h4PEsXlkg4=SkNoF3)2EYeGhu_pJcP1 zh&c`^hUuRF38Ax^sq=CeZ)Fvzc6nD!%Knk6a4?jiY{{o^pNprlfZX`=`ZuJHfJ=|u zQm=0_4z=kk$XC*|z=^eBBxD`$)4FcSKU=)J+JH02H0t>j`|G{ows1{%e_re*RM(t* zL2)-W<$K*^2NNX$1EnNX&4`ebPwao^sv3Y9$o4l|8H^ff1-ggu(C4zzrR9b)c4}DS^v?V^#+b= zQ6O0L^X+Ult29*-Dz#U_O5u4|+pa=Kuz=IHj`QxKZK7vvD#^>J+xFidX4v*%(!8a` z6NmT`mr;Bli@C`7cFF4Q%mp8-XS5Qx`ACZ;#1mRflD6@Fb`vshe>;9@3P5KrJN=j5 zZs6_qzB}cj3fCVF^yz#(KFfOCi)PJO_FXzYbz;#zZ{#fV7ERY?%owgMda|Ndk{4Nt zL~@FwO=+lN9GD~6AWblgTAbe5;dh7!=yxl(V2WDYL_K<+2v0Pfn!R08|58>}kxCF? zC?Z;EOkFsmCS5BQv@EX5D4132Y-5k$GjG4%Dkh%2A07q75#o^1gcUtEV#oFb2k4`+ z*kr#W0Y7Dw<-sx1txuwM_S5 z)3B&p$qI)G9b4p@!A8t`#EStBU(-`YM*rEZ=bVgvy$F#j3&;cf1^9t1=mSz|05bTB ziXjK&=)jz>E-q=~!(Mvjs6c6JyW*^}L?yd7M$ndmk+7Dr%Nvla`{IaV+V!nZ*d)uO zq{?D+eS*w8^i)3}R1t-Y*voSZlvt$pfqBlD~ z!<=4Xuh4i=q6}-kdT0MAw)F(e+ypu4xA`n^k482JS_@0hzAz+lUXAF5&%*MAIC6*` z)HZ~D!1azU6*1Qcj;HzYV2fxGDqkBBcv*GL{o~Ql@-3*9jb#{)WP*sVf{x+zl5&I! z;k;mbV^@`u_)@|N*pIdmC4>!{iUZ>1VANUe))7qo+KVDzU+MY_q@Wg9<9Vg?eE2TP zL~8>j_^1!0TMna8|A(#Q{h`D$!A4MMj115_pqP*}D3Dp|0te5szw=3^gBNCa2Dsrl z6?jbj0*bN8jBeZh-$VmLE{H|ZJTvM#qN4`XMHprxQFC;)Tt&yNb|#<`;Ss2^IIb4R zO&H*sLSFxe9#Y=}&nHz1qiGG;1F1Bkf`=gQL?VDh-gLk;UsO$wPwM=NHT57#9A*gi z^e&54LQ7^%Qx5?_eKqoWeQ+y<`Thh0O6c@U*qYm5 z8|yz0WU>-fMK90Vk_MxpDO;q8TPOAqx#;;exC~{DXuX%d;a2C=E};0Rqda7^;|iA0G;Ny=DY?D6k+>vJgj%PnOn zoC6e%6jav-ti!GX+)rzTBrHM}IneOT7@TXhiPbAl4T59fw>4QZQ@8P5S6SN}yDrcx zo{fuJ)8-3mzc{z~^sTErU`Q39u&!nYH|O9|zOZ;GuMmEaH@QR7^1jgFRxgqklh*jD zmbYLXIUZ#2jVc7wrl`bW3SF9a@G%;$SXr^}F>rP!h#;y%%D)DC+tlv1Bk}p7f_$L6 z;kPDvoEhqZ3X?)rH+?@*O+!Z>pK$=`8w-t5_9T?RxNJd{EAz+lf6j4k3+tD5u(FAN zw4Z3BNCIg5TTh4e$Sg*MWL%dfbb`I2-wnHCk*POMHDh0vsBP!x?x8_3)c!skPm_Oo zAQ+XM1kEAf9@+YM`ly8IFddPkG-iHPYUIxpPst6NKD2S_Hn{zpOp~ z1-yKkR4nu--GF#6LR={YqBw0&>Tz_Pnx|E6f7JPIfwe(~j^*I9x77;4>GXYn@ft$C zwc@Q&6Q5oDrO`J+5!?U3b%foGQ1)Y*CUn>G?Qvv3unw>I#as>hWbt!B#tYvg4D{PNEGdf4$Jpu1K6FKZan{{(enrf2-ma-No! z-O=cue-jJjKZT1{gPrieW`r(D`%y)<^kJU}uuvL>x1>!b5{@}V1Abn7&1g|5=ES!_ zBdHG&IWnD2x9u{&8IPJUe;+dbys6El$~E!r&h~!jPP@-!b{;fsePXyV(P|WJU%NgV zx%_Q+=lv%WI+7a|_4H;^6jyFi>Q}b@u3-CZ^7JUJ7&bv=*{()?zp~9 zw_$VNWR_{+1GqPA%e1?zJ=Ij>YnuuJSDdp4Im-N88Y+0&W|p=`WVr0}@t*52RPFK| zx;61|-)ITKak}Nl>R^hxG7sB@C=l{VB0Yx46E5 zm30d+pXOxCnhK?$`8vJp0_TtF{)+qNto{-0mjSrN^Y-4t+bnzC{<`#%EmROv6qi5U zWVi*vHz!SbLO=oDbj~j4wXQYR!Exn>@>8RGI9$BEtcUd*3yUj`C)X$75@7F*(Rvb> z2VDvjbSlte2Rw=I8>dM=qnyDI3NKz`%kIZU+zHes_c2c8p zKB?GpFEPj7Z8lhF;`D}@3>?v!FBlt1ppM(f+b9VF!0JKWcKfr>Ht z{}?-mCP9F--Ii_Jwr$(CZQHhO+qP|V+3d27+u!0YCSn%z8!|E@pBLvqVYzyR(^!(2 zccnSrx~j-V$kK29j9wbIlZ<+k1R|^wK`uBo>a|xFeCfg)gvb_WszplegqgTXz8!1U z(KJ&P4i{Ac;#RVtWkHV5Ljar4{f!PaM_aE;L3HUfVsA|KEhgmyx|HDEI}-*t6)6`~phnac(|TERg8lulf~K59pra3=gM4`WsVIaW27CYKln)E#_L_&beWmfUkn&; z?QN0`juavvCqe_fU|2~=lJJ(GJD_lMJ7@}up$uaIPNIIYv(M1ky>BFYSpLgFyENo3Ezi- zIM`j#lSJPA+0Q$pCWnh`9lVz5LODC=gTt&PN9t*FGjVREZ4FcEZx8M4mK0klPiU1R-}53Hq480I3PIaXygnc}8FH9i!0u4kaGF0(Rs!n1`F z;d)&@_z#^7vdAp(`O0rSw>N(rnMKzyO*(}z4w}}zynMdM=ZV94bY2qe)8LNF zT6vwDG8~*{QeiWswfnnsznP4qtW@g_O2a$^FiC7u!g6?KC&H9MQuAue@y+>7ppy3S zf{&oFap6PBezxqV8Vnv%ZN(Z0q|~Az2T+WF)=Ll>2IDyM{5coS;TaPrrqiFMfplFZ zGbW5*eEQ(d`p4e#tQfrY>AaxvlT0L)9Q0#0@RhS|B!HEDm8b&4&I{HfGSxNdL8=Xw z()q-^Al}H%f-|8fVRNi(%S8Z$UdAqPwQ<3PC4yLna1fp?Pg#=2kAjip8)pfp?mt7I zP(|eqLSI^_#KlRVB0a0;wuV%YLue`zJpb@LqMUeh4$`C#8{h^!{-i}!TOsADWXcH< zQx;`yBq|Icz}+xah9n}uF_xu9v~76BpMaV=$|>B5h1kQv41YF>{2_O;H&u#6$@<3> zV`*$CR>Bpn6*wLy>*3;Yb6j>hm^Rfo;RqI)NQ#o0#*{(F2$rd4tMgYnhJN9s9OBzJ zAHj$>0LfLy)~ZU{3<&G%Q%korB9wV%=q63b?3P5Rcbna}Q<+G)`%b?hYZcR~8h1ZR z9NI(k0-oxGtg7^iPE3^}(NTkCP}`R;z7mZ|C4fCOj$udc0F0`>n>B`ER%Ee`D8p_L zWa-Kv&oGm^*M-z2gF}z9Op+Goqz8BGXjpU_7bm??$R6<63y9VFThbZgc*a-`QB(Rs zOuMDu&0DF_k>KBA@2=Yof2pzLdp1(Q{+zD*7 zSKeV3qkHxwtfWvSo*RxfKcB) z;6Z`f_S`^dxHv&zsAgg}tdD(Ymci}7+!%cWhL&;vL`7Ya%(p&sGhWX%)o=`a`(9De zHTAhxrGIfi8I;LeqES@kRRuda7bEBVBV0P)M;*?sE9qAZeRKds7K$VX9>4wW5kd$w(bnpx+=DCggJO1BKC z!ki>uL(A@N1(++{1JOE#2n#tX0|>;eXI|D{E4*r{A4b*Gij52^`;CT3B}WKc(m!F) z`0RwJ>Njr{6THHm9T3>KhiN3?S~?V@LJOa4ljsY~duFs<8W{Kw&@Ee7e_3N$b@203 zP+CBBNBYDf86}7)(^Ki4jt?B=$~rND zj#+F?M@=Jgl1M7$?IcyHEq#xMfMJ!%HI9!6kAI-_pPw72cT6#&kK~lbeXmZB()7w8 z_g^T3{LY2Aos-vOMMA$o90>PWi~wHA0<>$|0h_Ay48e!28ueZ$LYDA#vY4EtfED1$ zr}|1TbE(+I6R|XXKU|!dG|-!bXduGuV{eH7Ub+LC=?5l? zgrbEji&UFuJHGhR$KI)&WEa6{9Pz_zHaVb0ylq;;1Wce~;{Nv4NqJRVSrAE%dZmv; z`df5dHE4vNxPcerkHFl1KVjP50mX?TIFtqf!0qLv_H&Yp$3>rl!|c5(n#!Lj#J2U2 zNUhAN_%o> zexNYxAuvnmXEsv9=2Q_sUyCk>Iyi%74l&0*Haa7P(e_bwa|~VG$_wQTg?Fsaf7hw; zeQyKHb+e_(l6q(*9(Ix{%P~KP!8#XY*lO2H0l^$vK+q2>k!N+^a=>GKaR?EP#gaOtLnmqUq5@Jo&ga%`ca&0- z3GxJcY9RS9Kl+8wJeWe^7R48!+m@mPV{1lz}wiSzb#G!D$B62`x^0eC^tW*Q_No_V$8G-G_y^O&%Zv!_}#q(2`y(bHN;OG&v%2&MZJa` z$a&(FQ7usOMt?|L8%JTPDLx6ukbSWV^`{^#V%~cAG|9wgA%)6$jae*UuAJaMN@844 zi1efEhJzraL8%k|wsAa^jkI`ru%oEr_`SfzW%f0@38^tbzSmy5Hy z#~H2&r60DMe`7ot9RTcHPsndVQxPoU|er|4GI2$ac3nbx~sO!T*XI7+qga z&%Cs1o*iow>R#yeOfMwbK;txva1`=mQw{=)_ZK<>1LWdcF#W2x5VCOoLXE9n`f+QQ z?k|8un^5g*?YC3+^Qd|Y2IG*}8?K++W@{7G%cvQfE`x`6E~mt*+b5T;T#nPypZdL*zjwDJ z{H#B+x3h3WRz;caCr+`6G_vjZqc2dKU#GlOl~K52PoOX#9nKb>jnUTp^NWs)H>QO5 zIc)y}J_D$h^54S${{-7)W?}db?NzC^cJfx+|Aqer;&x-gkywC-Qx3=RTsCIgw&idZ z_?8h}##D*WlAaxxvi{yP00I#w!6>OQyyy~&{e7MOTY%lKrowELpM_YXJNBI`xomqp zc70zH>@1{YtS(QVO@-dV9E?Kt_)mP~s*z#&c>i67xdJg2Xy?4<;uD{EfRmqt!D2J+wTTbt_@u|(dPk`r47aY4~lSQdrVak=H?A3VHQ-k zx*bOQt)l1Kc##v#!pz+SmeQBi9!dkYG&0x69QBj>(cPUiJ1K-f<>cd=gFc%m-L?Lt zTRr!2r!%{}>@Obzcx}R^<9mgt;;;j5oSPHCKS$x)>9*=>^XW~z0|AMtj){pXm9uOU zT`e?HDP?P>z0LHtpvxlz2nM)RJM60eoEDLb2uT>Zp4P67k}QfcpXdt_iGmo!l?p$( zZNcpiX8pDQoQtJ0eqbk~W2#AaEw9K6hGiTV3{@y{OoHFlYWR(SnM9gqU)uf7gWn9{ zJ)oCmWR({c2AGCYFVOut_$0DXV86NzSs>;x{14E-D}yX3I1R4(o;GZR5mTq;(X*{5 zSgSN*a|-+iSxqHx4+Hyqr>tC<#99-qTxY#((Z5$w&SztE-EACv2Nz77=4!%_=x+UZ(EMb+A@tjI8l#;dByA z#o}f#(>bfTK%mTA5j(WtuKQA*GiE+8LYccKMoCD8BL=M;<4x9rn}Or%2*t!{@RAmx8a^P7<;avrqZnwaE!7f4O(nD5+rWkmM#Ev)PVYZ{c2VC+k>}svS9^cR?&dt4T4SszM98gB_9?O7 zG}p?Dx(9Hb*u|gp*RtNj5pVII$m5*5gLq0ZiKj^D9sO zG+j=05%Is9{);e2A*<X75y1UCB zTnV*TG@}IwPR`3pNGY>okRYYaq&tzC9h%w|RE?f293m3} ztIwotlCucwNwC1!=KCqMCrEW_9)O@YpFRjR}Rg3}@ z`Ric)Q#Ms_-X<-Uf0J_FT4oVv8<;{trl>4WuQlSe)VSRut z#(snZm=I**jx7BdF%c{wVX_S8Mq=wWq4@xx?&t%--oG97x*Had3P-XMpWzmxL^4lW z-723z#r04T7A#o*z97pfiVgsy_3Fd%`C(M;o_hdT?U`fYUHXxth#vQYfZO@IftpJH z$uiM($QFOVrI12O*Sg*{4@$Q0})m7tZ{3CXm(M|BSG_)X_!O8 z`Ub`V>Bx3o#w+>$bTkDQrxjIQW+vd?26qgsZ@-WN0mJIHE^M+T3y3f%x$+hcE?%I5 ziy34rBuiT^Pf|7>T?6L>Gwn?xC@)+%X&^3Kd?m2%h+oWX zWB}og0Uh%|Mp>yVGHVD(C57R-P)F8Kpw2UA!5E!Ho2SGCRE0YC&@G;uhLVO*9}RTx zk1OruZl=1}d{or}zNA;u{6{xX>%F*!QFEiI2i!&!oV{lg%$0^JGAmXT<*uFUStR<4 zs#Jqhn#m5zVqzsb&%`*!EB*x7p`UdOo@CtRR@a_CY>U+HjL_0fKE1g&(l6G4w*Hu6_u>IViA+Y`d^P_Y0l+ zLi*Ih2%5VG6YamkgpmVI_hjFY%Ti=08D?Q|Zpc#1K)O(x52F}*N7;4Q0)|L8+@=+QTLSP=Mqq$0tb6)J zFiNM+{A!)AxHl~~P_kKz?z0Yue$CW>k>&6}SmM!9#OXrbvu5$FY95fvB&de`m`YTCr5_x5Kt7EeZ;a$)g}0&Td@R+4Vf zGS$Q<&Zj?V+)7&=a-bZr{$MLP1gu?UEy$j(>t-1pS`gR}B0jbL1;fAH1#)un#8PbW zy^mL{4q$!{G$WumRvbL8+DEKj=GaeCiS@{d*Yj=!;18G>Ej4UjnqjzMpU&D@JAI0( z{xoQCirYjac9ocMr~10ER8#8iog{}0k3g3Gnxer~O+%Hn*iT^vl_ zq9s7Itl3upcKxTc?LjplopT~aQ@6ezeIJRi=Zq==NV{3}PA23}l)d+G7CEoGhf`?y z`~B1*=@~JaKNo)VazY%z@SMeik{fu>;eZAKb;?Z$$nNcf^G_#Fnyw~5*pAg)((9^? zJq!uq;sbl>mW+w96wIpSQnFnxfbMmAF@TcU288)>#@5DR9)t(gQ8k+-h@#+f`NR8u zI|s-YflcUv&Hb1X8Dy!;cV3gsDvM==WVT%B%Y7~>z;%jO6B$Xrrgkf#Q*4xjG%C~@ zMv}aTq;atlxc+kpHhtD%y7Y#I8R0iuvCEb?m18fQPZ5}3LE1|!huzGyE1}7H!{6v+ zoawepQOat}`AH$LPYpi(tU{x=64{OH3;)GJFiNejwP7;}Gn<~!n&Qed2@3r+WRVE- zj0SU=jHYZP#uEUIAP8vw3*bG_Z#R7oVs&p1l%49KIE=Mm%fJjG{833yrDN`vwZR?2 z5Mf0w=*A*l4#OSORZ0rTg>YE1HcLD+%oDoX@redN)Ccx0SBQX9gs{9n*jE-6CX_80 ztI@8>Q7bnAJId^P^9b&+(1_IoK`UH9XvfbE0DAdRJyycYlt~sa1U(A10Q?*Z9Lj5A z+2oFYL;IrZ!DjV7)ta|zHmIWV`$F4yH36z6C)MnLjb5ecmuO8P!qv-cqB-lHYnvmv z=K*XkhjV41w6Otiwjc#Iy)Irr&Kc@pd_X0X{f^qFCnPw!`@0k$~`2^Tgsa2I>R zfd+FsxE(D7+S)8HLNcGQtL_6`BT!RjUK8(jGQ-y}y}uP?^5TSmZx}osUAiISDwuRw zi5}$&-!)!h)@M$Q)P+~6QI6oAC^Nt3B+=yb@oWLH3jA-W{9 zs}92`4irhr)eeqAz63VZuyV+>A~{gNSSw(v8vMwvWH#x}n~=#Fj4T&P zC&w=4%BZ8dd^zY=*RVY=wzX}O3Xp|3u! z{#r^KY8};M{2wWT>NX|W)tRzXA zKt6x7BUB0TYYRA`@>PS%#=f#X58CRNSCrq3ZCDESIaU`R;MCy)jP87Pk0NlIePid` zgy+JxGYI!K@;DLuEOHT#c%*aUoQfaq%fsk6knrl(zT2Ji7b$sq=bm=e+S(Qu1hb;nYfe|NcY)AKEPS&iJr=F>n2m(m|n5_V9N|Ps@}>h#;bv-!R@Z4QlZ8oxd6vUssu5Y~O-<@x@; z*QfqBgh>?4sfae6;@g#)f|Lv0F%fCFht4408UNWxCHt zD@TH#SW57O`5;&_k?=r}^kNZ%M^e*o|tvvO47W@k!Fv@ORx zB+zf}J4fE#v=M%n>1HRrt|?41lbAe{aWSpbctuZdhZ(GKz_4Dg*&NSDwR zO(<}gMhos^b;!wppW}!@2EHfrT=Z9m)0bzvn*N&%brikd| zvJYpww-tuxE<@+LT>!*kKI-P(g(i3Wh=}qz@;mO{t|Q#nT#hUHv(VK{n1&HedjE7K zJ&!|0QrHR-ejRYGpiEi=;C$@48s@Wa1NhYQ%WUbOyXMHV{(%(4o7jzFRW+9 zX%cY?u8WVkz2qv~fwfaNOxl(#i%A`~YRF>AjuNDpD9%k4=Nu>W@JDn}_y&jp3JE}@ z43rOLJ25Guh)tW+<8v@5XZMXvATABxW)_TH?ews@PExMrenuafGGg0FkQ_-OG@67_ zRmUW(jZ#4sA51%5dGaoJwm>knMvR!Nqf)k|!%!W_fQ6U4az}jGSCSj2#Ie|JHa_E!M1py+ykt%*yM;U{Ff#W%P}%^4p=_j?V>W&g9Vr^x(K-N16& zKy$_vfho7Zwap0#yv<~Jc@liSX9j2)2aw3~aWX#-4@cag8O3%psPY33c)Rjzxz^;7 z59k9f&N!rAWF%XP_u)0bR>1%OqfGx6hCZ|aOqxEl43vFCi$E8ud6vy}+Qy6Tb0ysl zF?(ZX=77KRop2cx%2+7WO0-TzHV2B4OjLGiI1y&9&O#&z@tPj^*|FpTTh4JZrv0KT z#RkE)3}3U3W^9OnabQ8CfPfUha|Ain254XFbxb+KK8BC)MHy5OvuH(v(C^$}N6fnC>bo>a#)(VxC;p8NY9<@KY^m`Xv)6Gnj+zJAkDprx1L0(tkZf?OrW zxpvtR;#P@BW+X@XmprklTEEQvLJ!l!z2?wBu>KXFy_q~vCZBV2nGFdz#IyS)A4Kn( zu2g-=x6fug*a1{OUox&BsR{f7TXk$9lnpR!)U2Q6o|M<{dU=D4&~-)7R`@%;3YtsY zGvR}bXqJ(S6%+pW$8NHBHhsTk45f4{QfG=AUO@!R@D@xo*#EI6U{ngpNwGG8sQ~pK zC7YV~km~Ug(m`f+H}S;Pnu7+1O27~4R0Sq9hGm(yuUzv%i3Vkw9PP2if@*nh(y`3m z{H3XKyRmlkv|UOV$Oy3t)inY#ghTanY`Ly^>llgB>?J2r@!o)8;FCjaRMn}&SKw2> z`#Ktn0svL0T<5sk`2co4+B3Rv1SfyXYN`N5w=bli+c97 zT)UnF?nyO#{^%IwpBIOrsJkx!B}y$v9~cMaX;?wBtJ@d)t-_o-I|f>xMU63;>zA3= zM>&e-rXcY)ae3PW-t$9P?3&Mkoq#-OtA{?F3#p&7Z_O{9ICSj)6JwFMoH;(n%{t~4 zWk26+q8l5d6W&)_nvWeX!64qK(hwe8xXB8B$8S=WbQ*m?!x$junstcb)WngT2dei? zSj#e?cRtoXDB0+~`?8CNY#x>!$viykl4quFj*041v=>e+-~~q3SDpQdsZ^PQTr7_5 z7Z-O)Cod+P#Mx55IZb;(Z}9>&`!m~?B&&kH6e>GWSTHwk5+!(%tOoUNs^Y$GBik2gege)Ph_*#qnck@>|Dwx_Dk!nwy5Vpp>40NJcNoeH<^c%1lOSm9^zs^OKniYxVT@^dTi(#90N6$(^82zWX`*R(i#SU zfJ{Xiz8&_gV7pF$-MkAH=R4-Ht%?w7ovlDBS+U8{55LarScI-B}1P2Bsul~0019l(~PXG%qlESeBzfms-ecwuFl ztJPu)UzkOVF2Vi4(_}JQ%P}G6(+hn!|qcY9g2z1;`b2&%v4~md`L!uDrli_8*mcjt~&{)!QD24wWWEC`!{n!JuY7pJ!#NM!I5&?)>(PE zt*li6{_}0_dT%OCih@%~L^S*2<~?3ei6#8sv4+mUR&qWi!zUq2cePMFl??SpV8Gmu zb-7+8Z^Ld~Kv^Bl&KkJ4^j&>fr3N{Pd{aQ~=0)1yZw*!%%XWSh&6p<1AXb_MDQO2@ z`=p<9P)YBGg^V6^pU3;DAV%B#^3;Qn^bN{^CpYFUiWbZalh9E?R)Ia1~k^W-HG{H39-M)+PT!ndH*o1Ty<6V`yC#HMAMYUb&)v}2dD zY(qKRTS!>2kAQA?ia+Ll(=oVH2%&UepkWlc8K$=F_VJN{{Q*&N zN<{F6RtpGMMw}r2i_iFTGa+LtwxJJ=M(ix(m|A}O&P5%JST?=gyaj<3KQzh^BhizM zFyhHhc-Y^St#nx*$ZrSW58$^a7Y)b_W0ZeP&`=+VQzFK_f8+xPMRXBp-_$@F%{Ad{ z|E5&F)k46H_GMyVa2J3R?KkH62g~q#B1yAR!F|S1lG^A^NVhA9=m>&%A_Q^23(Nw> z>bwa_=~o3G|NU>yb%3+Gb9z3!5R_@jW6L36v`3SN25h2NtmSL&z?S zP#~j3lt4AF=%R@A3P>uO z=D9=?%J?ye8{zLPNIl@!NC;y6z8zRLin(VjzyRS_oJXp=`kMPRq!biUWW1k*q#&pM z+hd4>Zh#0k84GC~(5g7O_&<;zRKtKLRRe<=7&9v9Aq1hB$b$mO1!HT0h@yx~x`B7@n&S!IAy%DpiathBOOV}~2H9yM-Huzq$ufCSksw;nZRZ&&yU{*0XzqCJ#2uZC?dAi zLlMFeTL(aRgf?5qcx#k>f$avH7%5^`;iDEe?b#Q`y1qs$k*kh6KTYL#M<#pZ;T!nV z!*x79;4fIjHWS&3s~@oSmQ_~E5Auiu*6J`kbEvp-I|O#Fc?$G&yQv}++Pt-w+IMXpD6A{qNJaFiDT_-m)diBAN1tq+G;$ZoYp5 z+g*U(oVqs31@Q;(>yD?DJ@=XMxt3)Rzp$EttVo|5vH73~h+yeK6$V!^1w(AQK2cdKr z?z!xC2x?D9>FwW=V2Mc$u`>M1xCPX z((hy@$Nj9@^d7LD!n^H>09IN)DG5)Pp_yKgZ=HM;Dp09a$U}wLtf#$}bG>4ab@@yx zvK#3{*<2blsJy`ayh6pN-kKqf-R0*|YM*SX*T)CPAuw?{zqO)e9QPONpUGX_f1LJk z%VKhYo-!H-f9Fo<>y8D(c*ldjDWXPAyZIM9trK5)>8fp8rM>Kxg>UoHW!_Q+shvB% z=LE>u4G_V4{sa`eC_AGWmY_$~K%#MR0;nWnr*7v*B&x#(EfrpLal34zQP3`=2GPQN z3`8ioFQDBv_1nC$krOurpTzESx`i)7%d<{2*YM+9-?7eLC+e>Rp)uPhgY%6}2gh|1 zU)NGEX2eqWkskW^4eNZvc06uwla>Tbg{M z6nWY=e8`D5W$*300X|d7EC$#8SkoF2JX5vdSvAABCLl>NdbNdH$@T%+#7h?cCqo49 zv(;O!gLfU0%2upxDqS9ye<$Dzz|KYozt8WtyghKd@xJ4Axp*Y+LfP=V1g{rhm#r_r=1~|Wy$oS9TnAK5NFg{a)7E_; z1@{{@Wvrq!cS#nQATer>c z4n{Y1CIYq0;?+OHZ5a?jq2v5I$7Y}sRcLb>frqT$ zC-^1s%|%<;mO~NbD5rC?AEfV|b$Jjc4!rOzO18^yJIQK-idocxOM$%uZZaFG9+G(K znKc067ULQ*Ea|Fr^Xc$UjmjB_t)_5Bib(#efu@Fn7E7XW0ALL)Fbsz42JyH;BR~zX zO^DsWFtuhY>J~$R8#4tgjrn0@Hnaop#Jnjlu~Yk<0n)m*5Cwi?5M+* z(q7jc?~8@Eb7#DOl4+#Leoc@o{&gHE@PoWMit#*svz7B>8ct%lV|MiMEdL8$!ngeN z-y-M#r2As#VEK<#xKeG~cpI!aJcqFfO&AwzwtpZo%0x<-Z7vJg+L)z<|$yIF< z-75f5Kkxhlhdmb^NjZbz%@ZfiV~5jB^RUawd1OY)dvTeZkv*rTb(xE2+W%l{i9~FGFSEjFyq(=z7e1xp~#g=TxP4qIYHF`cj$`EZ@=(r7EJ7 zqXIusq&M)-MS6M*wND=Ek$o!m(5e?XD%=Sdx{6x-2_G1sIkNL8o9B{>X+*OzpA~-j zERk)?`H#Syf4c%jE{x|xGj|2#*=Nq-Ht!2@?HL#eq07CFe7%Q9eulc{=~%eL--ZC& zEyJ$D-eXk&i9Z*%Bv1_$c>6J#@lkl3%-JeYI?hbhRI|1hwoTuaE=BrEoA>D0S8|u)> zcljc7BaIGU8gVS(aDy{$+U|weFhZ-(E+)`Xe`(ai&1#%Yr7&vRBqhhw;hBjw$~j}L zuFBym9}S;g4aHEdFK>m3w$KRjwQD$5$Y!RI!w*vP%+&xyH z!LStJcYCzd%CCq(Wro%ViI|tgd=#!*Acuq(RXXXLEf~iPs{DRTcJ%;X9n9Q!Q>})0|7v>=* zp=F%)O%RvS#@K0$`S63K^SuVVGQuR9k_X95ecSGm+L~HI$1qTSqLAV@(-g~}0i*}N zYgDgV-Di?8LL3@5>D;!6W9oLri0Mz6%j87=t^zDhM7FLi&&KVRQV;E}GVW$jYHXfH zEXJlRyZTOv@)fdZCzehSap7x&yZN!ugllZv|2C;;9G+L2VaJrAq2T)A0b6yYxk z&?D;(-e}yXnTHRJAls2-Zd$;>te0TcD0LRL+F0EDT5^^&LuV>uFb;`TD1^Znr5<&##qSTSP9ZB7 zuN5i$1Qt#!GPwp*oG4>Wg?q4)DP>CkaB1t-SC8gW-D-P2Lng<)t1Ea8VB{0=qT7eO za~J(YxGg%p%We`pC<{+_y?F27z5^`}C3vsQUDkT4%{tq$$lOVtSe2%=m&y~h?xV~c ztzaY^vd^bf~nuSPPTB!qDmNy5rQP11mwXDDakd_{xt`nHeaP3g zpa7|KE-v4kheAq@!o-BM!!hlj%9qFh)o|kW1(Lt*dWiS?=}c5 zM*m=)@RC>;T4T%dCGaZHC2?J|s)ryLg5n}rR8jDvKu{1w^-(PcuVsmG!)pK(hzk6a8OB0?{;QV1o}$tGBS~( zrd@+G0~acnSg{K*6vbPLYy_ZKQf^Gj52BYMmBn4I>_=I9J4(`3WaI$0gmKFpn5wDu zJ!A`@lIo1~A|nV6QIw`Bex`@UO}Xl}-PDfe6csBxeh83C4%?^D4s8!sp0QXXLM@oi zz_v$AmqDn#B^Rx`QvZq78hdC99lu%Wh>dO0-poF!NPtrab=C+WP-s-)QYn(6j1X`W zAuCu?nx0IsfZ*JNWq@5%&alV1ViXlB(rBsac9riX7CaSltq!83hD$wMACimH85rp2 zt0hmvtdjavWS8nNlmAJ#iy{e=@a0zt$qqZ@FoEiphDT&fqOOtb>({ss0rSm{b*1qx zguhGz>#JQ~dgOxwvHX?Cil%opg>ab9A_P(M`p^oD9dMb2QE`mIZnMUyYvA-~I*X+% z3k?*X&qRCWNzQDY_m6>IZ-;jG{#eT)ink@o(bjfbc2+&lMQ}@<2$zVAiRTju#Jfxh z;2UCK*sU@BAcmbR!(E)qTEKSrD-31c^!_0`ZOugG#IH75TO4aooo<(u_*WOdaG4=v zDl4z1AHY^;qkpcz_ookjRXY4xeKkTdMzMV)rUdlH%nYRrI++ClKq(85ib-9*<=~Id zx5;>lj5)ZqdwbCLA?w#&@%bI5!pk|lz-Prpu5FVjaNF80kB<^w~bPzaWk86iUZOb+^#)8ipZ_fPhOe0Aa(tNb@@bg%PJU%>q^*_ym zh+Bl1+vBEVzt)OAk5tNzoJqU3-@Q`NHnuoMCa~Uxp6By}r)w}A$$XsiMoW%FDhs)D zxJ%ypNQfAH32cfMb%WkUYmBeg2`d0;ucegl`@n0faSkqa@Mb=Ka#f?CU$@^sA}FD; zXlIXSk$WXWe|&0^$Bu@2SFD-S`09Dbfh@QGYeTe0j}2E20&vyvgCF>h?aUK#hWSN4 zuT**bq0ls1T^{bTI|o@yV6>7NLZD&m|6}Z&wnK{+EgRdmZQIF?ogLe@ZQHhO+qP}n zPHNwJsCKKh^KgD)z05V{>|^xEYk|)v#^HC&{By#!+m(7NIfn)=uyN~B9@{3Euo#UK zX6dbI?&`yu!NjXW5R~)B=y$!uC@X|LI%s4tj7GGzQEBIR>lG|TC26kCDg2+jQI1Fu?2hd z?1B?nps8R8iFYy0WSsE0zxQTdNxfPR=Z%Dinec$AUaJq*!V+xr_quYk5ZO(7m2Z9+ z+bZYB!!f-}fwA&)+&FScd7VtbF2c&Yhm#*e+8M3*#OVe4F@`UP8u-yKS)ry}2Ud$q z1)QQUf9!x0-BoRgK;KBo(9}tx%)T;^&ZYJkzBCZBUU+|toWR!qHb;=-ZOF2h8^KPj z#K$%!D%;7J`ljx=emQQ`*O7}7CKk-66Nup-f7zojJ*X7f<_GbGUJ8QSfaB4Tj+LCB z@>k=7uZDgd)tKQtj_y6g$>|20ozl4*Qdn`@^LZ{4o5`Z+`jq2=3%}{G9=3kD&TO~e zE!%c`bJWY6YTd)nb6ON^$6-ReaC9xTMAAZGgFN!MbunpQCei zw;-~dS{=m-a`A{ao%jOViaYtk;W5S0Q3AvYbihjgu39MTa6gzmOrdWNA(h(0dn{=iRR z#FhQ0ApKvN`ItC3|384S`hNh%|Le^@8!L~{JAmCt4s=B(&)l$5b|Fs|P68GyFi8_X z3M%4xG4}QB07L*{%^M0=y4(O1M2M}`)n#w`n2o4$c#ExJ3G{up@YM2l?e%yKuQrp7 z=*p}7{Eo;#JuX5paqj&T6K!t)JpIm9jbbif4Xv$zJ(TPHvTHrbGBs{=jOPD&Vqbmh z;l51(t-4ho?9+!xdin1jnz>`f$XCI$C8sX7!ewB#AKN%Di_j z-2ez#FS(a|7i?QMSZ}kC?w!i*@UL!KIG*ORt@m&*6H|GDQ~v0hcACX~pFI;WW3qTN z(y;^Z8MkV3pUZ0?{6S^m$bV4e;82GW{*$zzqrjHw4ze87t)QDwU=Ht4q0Qm!>C#mm!Pv*3JXk><7)7sU>e=5HA{Vi}~g@$+OyULHsn4o*sy z)m(|6TlI~i7+wYs=4AyP@r6dz^BoO4`4BTyKCZu>gU%WN@wUR+{i1TI3m}a^vTm() zh6>_zPhm#G2-ip1#V=e>kDd0%7|!_$f-NNWeXGBWh-He49=KZUH{8WyRce#cO3{w1 zS*bs|d6CDu6y_RbbZXFJ%ea?>6bi5c zqyFt#Wh>i|)-*7!kcQLjdI^ulkLC`}s9+;Q` zunTfehNh8lg_-cEX_j7T=Ksm?fTh9soo2^9^BA^iFH5`;BIj9JjA$(dsTI(c zA@);B47lGw`Gb1PK+B(H7m`zL4hRK&JvL2CVgZVXu%gq*QhYKP!62g4994)paj*xp z=%L%!Jcf5UE0C@A%0S1R!Pi17Bfqf-az?QTB0xzL3EFa-ahS50<2P_0p(S^2CA7)! zaXRY=oY`6$xYEcx))Br#_8k^dCDLfy2qPKQbs+}B*iQ;R3=Z`%VXJqVwKJc-6eq+m z!egUva0ghbXihE&8o%U~sq}|oNRfd}bn1ODA-J~xBCHri|a`0poCUf>g zdkXOMkN(Ai-j?^VSh`iz}j_OU9E`wkjB6!C23T88Vbkn zl;~ixATU?Oe>9m{E6Z!KYQzC7t@kmzK=5JafysWyetk6l@ntKO%DX9&Nwxf6a!q^ujiPS+e`4RV%CBcR7RZ+k2~$+&qdWhPgJ#!zi0u2 zTo=hSbj~V>gJR*=6*97al;E8=-)P)y85eUWXkHgeK?qzr1f!ac%4zb53e{|b(*bwO!qXajN(r_XG`jh zE`1AI6hr8trIo<-r)e%SuUNr-U3k*Tr*SOYum+V=7$q%G1qoF$OebAQA4)M%9!{nZ z`kpV#m$^PNNcjsMz>%>$uyY8o%xUJyaz#sgG-JQkusFCOr=;&P8}00Io_8uA=n<+A z?ca3!9Qft-)mLMZKmdQSl^`l)0S_#xZKhNIP)w{K@qw-#%_Z*l<=->^t%zWcqXoZc zSE3;X&i4FlSVqG24ui~mm1nz$RYzHd{T#Yi@E}nq0k@1q#8QBSp6ZSOJ7>13W_hB| z#7M0aS|3rJBL}su$vvCHs+XZmr&Qw8Bk0#l+b2BPXZ_O-$zSE?1U3f%BKFp`%|Cos z14EpP9#o$kF)f2i2|ic`0XB5^>5k|VNp*RRs`6khnjmD`r4k7H`&j!jQwlOwKilLM zx5!W|ZUT`CT~44)X(0F(-~nUd0|CgBJ~g5nde0J*SD)|84yO`rcgHhJlo;d5Y65+a zcB33BQeAQhR5I6~Z&`V>om^CYd#f9M*?EIo9e!~Yo_+bpr1&W4nee@N5HqeX2v`P+ z6!Y5R zEdGBg=mqfY#*Oauf^@gKfci)6qScD26Og3pPjFDbt$`YyC(fhE6@9SZKv{n>($O5L z3jL)e8U+lU>Sj3%-~4KFHNayluV;FD`ou0z?eDEslZB7DCM!Slv67UuwWOt_HERb7 zAH-8%*dm`p<+i;o2ZpU}1J^{^+o71gVxvFTWvP-woiMYuo@`FlVCAYwQ|%x;E)nvA zPRI5M2Dxvv4r_y1el*07Oxf9CrTY#8fO3Z zO$@Rj`RhD%ZCaIgTgN$zN&Zk2x6T@l3mJFMy0^}(&E%CKqLiM@t>Yyqf3S)bDkWx4 z#~l_E*$RS0tNkFd=T$cvjrhg;zYku-oLp^9dar)yyRdWEY`SP4yY8}ea)!zShzJtm zSAw~1pxuV~N#jqGj_-X~#^J}fYHK_Yx&oW)?xe263 z`Rgja9K2RNnNFfLy5GQFMb@E*c2}D_8QKHa%5J&;+Vy^1+WtVZ!?rj4haYm*|H|3M z%)-p^zlVymHU6KoZ5}oXvj^W(-6{ZvA=1ikdx|L33eG~4mv+e7mByWHUAI@+E8HQ` z=2Z`jHoRcmp#Gw=HbUdO$AB8@cWuJ%O-^;Qbh#B@b+_x3S~R>crkanhDova5->Q3M zY^UzZF0ae1l5fW*1mVg2o#wmv$SckAs4qK5DHTWqpX zgqgmcEKVfmsU~}ZVnMbawir#~&+%;RHz3%a2QTl7o8gKk4&{~)I-Rf=&vWNbZ_>DM zuV*N&OLupmE}u)NoDN>wt*m|0>EeC+=aS4f9go~7#|nzk*GV^3>MSm?=p<@>l6!y1 zAcu44b+*AJ-?u?NgLxR6L-TkqL`7dRjwLgM1PQBcnjUc#=}5;i7+XmBUF9M0Ous%; zFXmgHgQ1~y2GUw!8}{KlUg;LvrgJ-kOp;`#nBC?12Y=h8OZR2T{vD+>TTUy*fMH50 zQ=`%l18OK0x>mL-f`#*y*ON-ic8;83mfk?6nRF3mJ=3>~o5#+p+_yfEd2Hx(jqi&i zp3B@{RTfqewR-s{7M|x@yLl6D-yC_YZa$nr=Uw;RzD>v|_*>~Z-QCJx;+Ijz0c};} z40ZX~19QWd(F&(5r1Jzg`_jWErNJ>8XE1Dl%2=Z780IAksEynKnL2JK54V(=%x+)CKDfh9^RxulzDpaJ z)hOKjM_wVZs{l_`V9*&z;5?`Uo-BAxma;V^ov~``i?v@JO{^`AbEsAazcRc>fiy>f zeIDU1v=+bE9ke?W=ohZ%{T^r` zybpS1TcrTC{vJ^Zq(k)9q4Z#0;Wr@KQ4aSW0Eu}aYEf1YAxCbyhc4aCLwz3p;4|u# zLnj{R9oRknvVdOZAgQ0^v9UIijP+uypoJj^Fb}_cnYuyz*fvP5ax)^Wb50HLJb79a z5aYQk48ph7D+R>Ug%G30QOwqD_bRLogCK>MihQYp2OR>bKE~T`*%yVYZ8$+-TVApO z=ha)!JhZcsscL>6EzMlNJL>h!mD7HVAqoh&rSAG1E?P!ZZqLWjN%X(dRrr~%L$vFP zZp)$UhOyc#f8=Vb0WmW7DIu<7a|HKtZDJ!F6gvHi=RoMsxE?a>+jdo>H~hhkWSN$_ zgAhll`IuU=g6=Uz+TvyYruOyQ;Hx2%BQ@S#Aw9Epa$yN>VaXQ7lXCg?`5DU$GIP#Z zYu}Bwa+A-Q-SzVHr9y}%w-YQ$DI_efu3Cp9Jg)hx4r-i;9|Kd?+z@J2uGn%SLZ@uG z00@)hP0;LPgwT2uOu15=0&^sYv=vK{;Mei>LF0J?Ag3h!?K31m^~-@)1e_(r6^yzz zj195GU?88qs3A;}r~%}huddlAn7F*G>F>v#R(%(3PysUt^h_qWS%+9P`F@A1E8Wcf zE`%#m+WY{s6l;^ObyV9|#0YmQ64nV_Wpq>O#kDKsT@kWO-Qf$kA8z?KpLos)X9uzB zXGrj`_E32Njf9vCYL=M?){zQPFLz3nn1%vb3xk7@vOv-BNPQF zJd8nXCf(U2*GW-n8y@IqnCP7M0@Uos&nM_SZ4D$>aPHb4Ji;*j?&nzW(2q64H(N}^ zK_pWH)X>}n-$HhLnE_aqXAoj1SY7JtQ^7c8S4cn$1tF+n`9dZr&e~co-=CWSG6;a_ z0)2=s3Ih6yrvfXscW1O)7!oeUWG;a)rO^TE*}(bO23CVfFO)qHn{5Pn2FE_WYJzBl zB-j+rieWoLY>P}d&5jdde)cl>d%{pbn5@_VQ^^0K`{FCgcU`Uq8-fxq*=)r(Xg7U^ zXmc#Ypnx2uAZ_tiMEbhZcefY|!WHT{(80lU!$HVo$WiBhf&I@Wdp$?1_)2z6({%6! z8XHKI0|x8pqYqRxUT=Q2Tw9LA>sz43-@woGrVqClo@`z5%;lxyDGWp~y`g08H#;6) zR;z%ArZRAnRiTI!X`rmt_EjQS;;hT!MhS(y^rK|EK<%z}dXrQsu|mDnaX;5@Ve>Po z8c=nv#m9mT>eJ@r&&-fYO6dNV>bK_jJu^P9Ak40CsrIGue2qqs+5I3)$9P+smn~0K z%XAgwVkv3#>FZ-?cpF=K!{4 zTS-K{E>el$5QGFZb<*d>k4dIKj&zt*PqBniq8k$GkuF@~nvTkQ2`&%P+`-4K3$nsl zv`h^IcF8^g_e|d*REJux5t06H;aN`w2OEAwV{XM=`l?q%-e?18Sv$Gt5V^#M!>QoC zdOmhrQOG13a~3J6|H|v=EBblp$=TGT!jKk5>`IQpRtkoL?HXsJVPlwY))r|UyEhIM zz>}M)9gZzaEn?)+Av=C`^5>oVKprXg<+J#Wi< z>6@mtkGoxH_0E!xJ{R!c=4&B>HOdOy3!dGPoqgcIE?=rixZ8Fj{&vp{>`vD=POjP?De2y=%R6~SvwxU!p%N=Y8;mOLMh zz*ga`fV#^sZrmlfFi5G`Z$C2;^7#%ZY$b!cJ(>Gq+$o|iU2G0-`zR@}+2mXG#|^mM zT5L~~-*SVca^7Rhb|Il_I2@1!>*lBEw;Fk5n2!?Y)To^@7q04{mB}JX4*1Zzj2r@@ z2Sr}#-&Av`2XE$C1Hx+TJG{Zhw?O6?^^7&NPu$t90&xe#T#g>QTxxZ#D+R?sHE{?m zpD01Fdg(ifb|Wf^P$mfyi+|GOqqOsffd+8s6+`?s(qI#A^@^5x{VwlP;&B##e;|eswW+BF&CZF7o5FfGwx|~g-2LDR)`GsforR^fkw)w zGS5?z9Yz-FckvP*f>P!j<2OJa6EaXCM=`JpzG#Y2GfhPM3H-<3CyN83J1X?5(U#$| zXz^}y1!XD)B#`75;gHJ4p3?%?;&S0SPGDmj+Eu zjHSwd-n@BQ%058HQlN>@AC5TL~8`mpvf}>gBIYfqNj8^KK!NNTU^oS9K5onAQ0bzyICpWi(KnwLKRCOn<`z4=O&dVSV%rt!2uTWE)PV&c zjnZJ!PihJIp#qh|Q9Bzn+T0sQ_@GOK>P#}0X?aNZ@REk^<@&*AbuH`jW%5HL3B;4N zfQ$Bcu-jNLUy&B8snB^CoXsyD5!}uXfsbGgQ(8tVv2blM6K1 zkTjRy;HF8()PByr%D$FPzvg+^iPUAtcwuF+*ZORB?{vs3qwdH{q!*_=_1I3dhEI2b z<5@HtR|+AiR5QhRK;fsQ`p_dKN46mTtuP{>$IP=b#+in9vZj)kregG9>ii1)*W0xoK>VyPajQK&#+D|m$nX12|FspG&PVs|58Urt0m@w}{mSR? zt83({?Qp8JSO}5!{YWXnh=yq%D+n~)!xtZ@6KaM$@Jw= zSlFMB#a^?!l7A*l;27nXR~L?jW&Dm~$uukP9rn;-ipIq3=Vwh;ZI5GB_3{YJnk$V< zZC;q0b8-28b@Qo!W6oCi9*vqLru9MZ&Jom`{YrUt?!D5Pm1mn(D?2Tt=a;1?7A@D$ z!y3+J3P!#a>+_HEp8WpNtV$n_`R)BBobv`>8#xc_jcY^CH=J)Y{M*^f#dh0+-97Jx z(y(UoU==+dojBQReU9bO=Y~D?#0GzsDw?)Os75(I#Po5gv=XCY66~FP5yh}8M@KV{ zI(V=6^%pNS&1vMCJx*|V2=+(JCa^@C3#CQ}BGyXl)!Gk}#k^p+X%p5sY=4TjyU+J>$0#a}yTe=rI8n^^GJV)ApLJfK{t96r~aV zuSn%4LfrxSs*@3mo_uONom;2zm?w5I(^KLRDC4ku_Hv z{nJK-Oy9@(JM6-3sY1~zRTKtGS6qKrEVOR-Mi-0*Yq&|XmGW|-Z!{f*vuA`Rnf9Mcha$MM zzDkJW;eo-wZpUqj_f0@4Xahs1RU33fD8yI4;kU(d`=KH6Q2d_8$M1z zGx?fZ!V(07qc^3K<$Q;*d+!1kORvxlHHe0l{{RJ<+ zvSBa=d%}H_Xrv(k)F@@~b~x@b(n=36p;iu{79NV;2l-(ZV`T zqGHR_7bjC1{KJP3GQKbhk75dZZoUj?MA-VhQI+`KNmH=a#-w3tt7+g)dUMQH{w0~R zFyLVEUCFS(b%da~$zmC$)k~NJEn_c?LP}-`3Rt%-Fy#Lk>x3Yn3Mx%hT*;a%2nd-Xl48~Ct)EJ&2)PmKSR?rxJNa>j&fB2y ztJp7OcxEKmhaI*sR|nCRZzVUe0~%OsGtIJNvUcv9bGg*9K2~ZkVQ-2%Q^=Z&FJ2>! zD|8+qh_O7qWABj|(f{ok2az!#oXXBws#pbZY&^`!!A>Ep;rcuW4U%-TWfM?42=;le zV(hCSP5XRd3Jo3s4@!9l1Gn&F7cCiCu%LknH-aFfoC8swG(kg>vHD9fj7fS*DW~1j zY21TZ_?o)x@3OOrZD^sSLh5+6E3;JH6g1v#rt_jtz13WN(5fxxOS^*>v~_(>C_f` zQZR`RC07d`C8CT7)!te{+2>t7+)6$6H35hVs|@|^)=`D$m3o@K+Yw~|Ty1+Znnv&! z%J9}wqjP*hY*@!E#-k-pl|p|=H2M|Zh2&V=&y7dpx|qYHqB9I12uj&se>2BMn^wGB zHZ+*U(Ik2xoI~&hz%JT~PAyvha#>+#GvGvuM@%#w2eODvYaEVOr#Fm! zP%tsIIW9C!S#3qZwVf`v^c^;u5wCUBuON zV+b&cNXY)#L2@VO?8X@jQcOcUGaBBm~_Vlax z%r;5{F5<(G?Zpdxlj?)Vd`nE-`m9W9GTQa9j7*VgJ&K&7XT>0`sA7kt6{*zPeaGuH zHIGn=87iIaIcL-j&ze{YoR+($p$|l=3eqE#gsGG`lzxA*hsnl{vWlceWl}R89r`Mr zsxq2%%5GY|F7nl&i@NtCqikwm&XS*qU)_m55`|Ph-RRRybdhe7jGvpjBza)gT+cfY z1!uh(sqscJo`@5tJ2f=ALl3;%8h3*g+0rsl0)qw226Ulbw2{vbj=8g=T>O~ljb9e; zFyLkvWl`^nbRsK{sKYRT8wg(`w?zw4CQO%|^ZAyag-J-rD652`NS;}rA|@)CR1`D? z_Nz`FqknuRl)mP0Q!5pqae3HTJTPVU0;Vdfgl6@}#OSi<&AjvKYc%oiwtk?zI2pI> zcgh`_f9q%!=h54Uf2npNmz#jUA}AotCe_wQjEdS z$%=y5mUKhczBeMDH6u?e;6z-CDG+DSihwDkiWiuQA_MJPTef1Oz4-P?<&cG(aN{5v z!)nVtENHXm^}fMPfG`?t(6v?h>lIRqu)fXe*9!1)a!nF9&xwa*OnK7&O*ZA+J_?=( z+OB*I;P{Q~Et^DoyeH4|KKv^X~ zUM&desMJ(Q5mAT3r(yitmdUR|-bzJN;Cyd~c^612Tm7jQdExe?x*_)K%CYn_(_Z=d ze3}rU)a`otdnYl&R)iU^Xf3X;NNxeJOiFuqx`O8Y2K2kh+9tjIte>8)?IaOZmuana zBA-8?dz)r2<-d}wYPRa4z3utfRO;>MF;Sr`Y0#Fnw2{B>kdRK6RW9-%#f(En%#r9I z6<(A{+ZH4FDzD31s8I|C+*}4z7VbmSU$&n@S+VnryQ+RMhLO+HMxQ}jNW?lMiHt|$ zheQ|oDZCBNIEbr+$4~*0`jNL_wxD+ulqvZxvMjRy%H^Ksp;l>(jwpWyWoL@{xM+?p3u58cHGBgxXIG=tix=CIZ;d zpn}FsU^np87F%&ih0n-2=4Va=D~Fers(yYqeir@K6vBY1q83^bAb^)Eq;~D-;V3Zy zQF!SgHBc=cMKf_wYc0!57N%@r-b9PO@W+WW_AHBrG(0Q~7jAhkdg*CLGWj=x!z&cu zeO}ik>`>UQPF`dq-M5l2lov{1udpOHvi8|VU`(7W(%aLWV`X#HFmmA@igt3=Rs9Vz z&QLV9XK*imr%~GRFWRqk4y!6Nykq()?Jm=RRL)xfWYl>TGYz8E*1wg){eb#`Y7>Ng zHs+e{TKv$af}^B;1Y)nP@1E#laMx&7A`(GSj6TNkfPY*|$cAc3{lL)yz86Y;ofOrY zBCMp76VSb4GANFpd>H3sdgo*PMt+&_iVBpUlr3Zx#sy&35)E#Yd~pkghHvYG?k-K3 zqOi-@a7>y(Xg4M|%LX*e@P z4TqC+G9?U&SJ0UbDbyfB;Yq8$tBm7fi=NmjlKWxO5Omp$Nv5`t-#2O(;z4LZvP07Eo%j2U2iDyZyu~ISt)uJGF)F^!4F5u z2vsCIc*twE0^7)fT0uJ7B}4V{Rjwfem{F>iPz$JXo|GbTUkK1<(2Ev=c{Yp#d5dTYF_7`5>!$ne3|tSCVIBLYtz|cz^+i$p*w_FHKoHQiSLbjztbMxL!v2 zCaLjN|Hrhe&ERF3wB<&-#SHjQ%Scsa!t6U17XOH85E4o{M6uvhTLYxWFrO4%3IZZz z%%TSynD#k>8qGiIUHM`?izNHEt?y{KN)&|Pd9DLzzLtfB<=iRTB}F(p ztDe!Qcx)tt!5CV`bC-RN{X?q8sE^ol>)6o|DpePbptnc#q^u>5#n${@#!9yv&+@7c zgJ#NgkvM!j8gR5SUN zU2k{FdT?3?hOBBERC3V$D(Q8_JODal?so_q^iQaf^m}w6m-Q5^OV$ZB`<&w5B3t^^ zoBHsNWRZOq;hL4M8}F7A*L!%smqxnMoLcy96SW${3mjZz-3=C6dE*N$8%iXt&LJQh zr#VJ?45)_L(sdywaLk;0qmbU4!Z_6MVp!FEYfcX_=U7y8Q7O$-2?jYU;s!#!Opv|mLOaRbU6k=-a*Q@rXbtz=o zeB+S&pcW>ZwbV!VpqQ|;y{}nAFuo)u^)xI`Oa@CaM7e4v&NtX;Xv>xLj2vV(&BqyN z%`gZ#n{3dE;efQn{iiU|8bc&vo+(1I1>cO%ZkEgFq)&BVLInNZ0HLUmqV|GE8BNG` zkP~RK_u7SuQqLDT`2{HjC*ruygpQ51J)iMAG^yeL+FF zC!+#5IYr4(Uu0fy>-^QxB;J+9Egq`EG zhbzh_OG&Ep2=6Wez~G#xhK-gXhpqM65nP9>;I2ZvY?#E%6X&=wHordBjch!G(v0hZqM{{%ehouufqdA zJ-qyS8n&_O{a_qr%BqE)^H(H|3EQa`e4HbZJ5~YmyCyENTv5y<-<2x_`bhyi;}_FA)Mji4eRoVEm>51 z`cDs9Z#%duR2o_I+Z+>+s$2HOk_4MPK8{m(^dEbDa*G#BN#$WRcHQa31@9bm* z;Uh~7xSvc?j-x&9lI97o%qORsWpc;OZP%6xLfs(k6T$^?yzBwcJ%KaSov>4s#a>E zVn?mhiHeR1~pk*%nU`ni7nBrzV zUcLkHL^In@RI)gYK-62q`oRviYew)Tb=Am?@paTohvFRB?jcrBXUtJ)aNmu{7P69` z-MD6Y=W&^op16wv;|Fs9zE@paCZUwrwJy)|xl?!<%xu{RUCWM_8ZIqdHNaFkUCb=O z6$mu1E=s))O=bqN4lEGM?lyKMx1z`dK2;gDsIc_LNg_g;895Oi+qF@yaRiar5F|5v z21?H#(M{`Co@(5!rL_<1wJ?RWf%Iv&N~=F7wsmI++nLaF(&@r6Uke>tCq23KJDWA%B^y(ma^pD+)LzmHj>ydrN=(g z}1V6ea~XKo+YlFlkQAn zeMTOju{6S0X$aQK+7Y>#pH4=d>kpkGj!XB=F#3%_GZ+Z6uq?dGChTQ%a=4ZSz!I3A z_%kJg*1*L9VQz8E5VQmKSG~U)ZEpbaTuC(hUBehs-oiWSnF^pv_Mrj-&=PUUurSjl zB}SEIKWEiHs!f^P=_4N>yFe}FK9kLPZS)VKHxN2^NqpXLInY`|5lz-_^e6qGz|5({ zjH54BaV9wA#AppXK_y^p1br~|(Rd>7pOmmFtuXM*$}>GU!`X*{{*Z} zlN39fb=q`gY-;hoc1E+GZh8?AvcwP;#Bwz=h(OT7?y8Dq#(_kl2+*|p@_`5-7MSrS zc-U4;Qr8aqaAtZ%IUNLaAvM8$PQzB?@bGZ;YBZkUDz&45$rc5@JPKeP|2rve-6k!t ztw)Ztk5L~WhJ(Oy`Fnmv>PiU^5H8D1p#z0!MvNVW38Dxt?T|u)egz~XizF0ei~X}? zrsuqFV%!fhLdBd4GgAg3qT{$T~HI*b%sr6DLBT}I9i$bu5hQe#vL(0ub>BWE` zDq0W?uwc~iUKGvbWCjd{#b7$dm4Gp|)Fphe6!OYtCNJ*f(`tD^5t+~{(r%N8DbYZq zO5(HyTMK^rj%4tJxPOA0h4@%gY-mmq{(O~eo_1;yc0~DS(hDS-%fpGJfI~iKdLU+s zB~paot+}*>&z|1E&;W#(C(O8;TSX?a7*k7ur~?f+T>atEso#C#MWbYb_z|~O*}sdd zoh!d7g2$NmnDy9CobAIhCJ^3GxfTAijsu9p~sC)F@3=VT1+%keBNLTNs{hzr4Bu~5HX^%sEwW`^pl%2mu^Jd*v- z8lGcL(Uf~wgL{_!QV+eNyduLH(;j@3+mgTG`Eb?!^jgJn%_PaQauNP*GN1a+Lx-B? z)_zqV-U82QVUhoJrE_fEevfCO#2s|(vN_tw&B8^;lH2K&UXGz5n*yAQ5 zw7IK)67ngfU+|X`J3R1p5Prm&ku8wPa{oPv-2OcXu6(HIKKT&_A8zlNjKB8=9RxiD ziGD*@C*!m%6x?p{$R6F zIC|Ia9TK2U-d9MfOo|Z?pN(68CMO9SSavo+8C%p$p32F zgI%3uK11^eb_s+nhST?x#QKR-(n*u?G11nayln5BHTi&8Uo}R2Pc6;jp99b!S}L^e z4GLMC@f2)_HvLB1P%s7p=gI*^#fUR0etdHlq7+gs#C?(LE(uZ$Q|En7Z#LQGob}D~ zzXER`vI|+*NxWKnEf&6Xb|n}S$p>h@Z%9CL%&%BBbtX%F%8O|*?YSSJJaQEowGK~Y z{_3bs<-e*hA_?yW^Raa6omH{gOR-5E$4b<*EnsO_s8v(mQGGZ&#aZl+!7{AybgG%8 zs2*az{t{O}A;~}iv6<2X&|thMY{YX?%TJc7IY(~B2lLx}Qm~i%`WtZ#b~y9_Cm=dH zuO-A5PtPTw8{Bok%>crLa}^yf2gssOBR+ZG_-GY;Tsn_L{t0?6-MxEaBy(M%qsu)q z^tv{SNf5dYy+W@GwqPGu%W_W!R6 zJN-XZST>}dQ`NJi0!88=H>9j;UZdsjR?*gb91awdkZ=(y5@WIV=S^5Y3`H=~ zVS7$Zmvj`+0&HFW-W2p++B2eHey4cGw@kW;?E~G*;nm$nP#KAw6Q_C~4f*c8tRo@% zmCVnhX{q{KnNBVH8D#rTEl9$I=LF+%`(Ca7VW+oj@d%GYwC;5@ZE!jK6@EI9WRZIq zqkl`}j-OALx0Dg$f<#bSu$3xA-qR7u|G$bHO0!+F)i$gkH}T@ytYTg_{5auWuftk|x*qkwsSezL*4i&rn-h%13m zXi+SFjPt@w1Lt|n>NQO9vw%~e;{o3MkbQ$D$)U|*;h?FAA{4NEeSo?ayJv8*F0Z3$OUv}h#!VcxSfP)zCoELD?8qRXtgcbCpn5e`o^15@} zHzz#kt7`tpg72Wz3__T&q2Zu3z)#G8s)7$ZjnKX}|CS14|Jt)DVj@aw`8V?hyfHvk zeqa(BIL5~*jL~|)xidz7;YcPJF>%+=M46=wYJ8VY2aF z?|8@H1B8=Flu6B2QC1&V92Bh9F|tj#lZG_@nOdR6l-$*J*krPsG1I2>f!qQf=(>UG z==B7$ytxKT(lvig8&GmZts2@gT72RtflkxM%y;k4ZK$>71uWCgipT(*Z~`oDn`m}} zfjY2&Rdn-FFycs+-9^1o;kG5Z*evQacrsb`IcQBquPz{fQ2uW%D?|B#v;}$sKkHuJ zc4{*zV#CTH6B3lugaVJ53=((E8+2MSg%tjbU6J(jU|obgxT|`d6m~s#E-pvOzAJrM zn#_K$?73&Qctx^qDrM8&(hYw2zJGO`^Nl1Srx%*{FHH&XngC%MsUYL28RehwTLedQn9LR4$OoOwQiSw%jUpyIX3OR+!1B!4 zGb)j1c-Vsv-w3|fnV-!akh)eZG`U`#`9q$uOmJgOIbOMzR1IoY7Vp}+3I}nRZ0yzA zsV849aH}SG&tCIOa9-xJ)2V!M(|V9;%4JpT#e=2bs;NRPf+}y_M*ty;W;lhki zS8beRzT9a{3<=!?m{NqH%f^=vyJ#P-^W|X1IK*o`?4Pw zv?YM%{l(_uy-qUhwaemV+3(&RhUEbA`7<8>hav?5>SM4uQRu`v556nGu>w2#K}C>p z=e8|n9f2J&26$$;d`Y)2yTm)1GdvKPg8;6CmqNnF`FYIuJ9CBXCPjJRJUXY$1)0P3 z42pYpc-}WfRt6zG-qLkGf%cC!Cly!nj9gJ)$Z2y%dG`UQS542-qPy8cYxJzT^1z~n zRx6N^BY_+SbTp;e6k6Ead3GpHhpul(sE~ll1%tubbrnbNpdlg?09>;Zq8of4+2lFv zPC#Np@$I9Ua*g{Al+q~_^T?bif|4~@5V=DkXJ&{FU1r7Uw&uTNQ>3io5*E1 z|A`&_#jTGOXyPGxku39tpu03{=M^G8t0U(nd0m-2gyT&kXWJ@>BJ$`m z3o|e#3yN!QcF=2TeIja#$%)kCn&v+m$H zaegc3xSOxCMj_%gODK82%8O~% zFR@lG3k8$#vnUL2)MpV;>bHo9b(|SJHZS=dBd~_H-!QWwP{RW$iQq~4U{a@nr?7Mlk>#88h;YI?%- zQYR|b4VM*#gT#U($*EbPy_PrI?zda?U*Jq#+{FJTVE!jWG!q-se|#$pYiPu6jv@Na z*3Bge0~YDN2(q20_1z{qaT}#MiR`{5??Z(EGmkeBS16IAEMS%&x0-qt2~qH}07Dv$~l_oLli+ zcFA8Cj3Q$Nsdso&1&_a5$F4L{Zr@8;KQn%IHgV$vN+Nkg>Nsz9-rSfKf>DUm=^nv$JS z?nkn3jS;YD{9Qk?lTrJJgV1Z4*0)Dw;_z6VwflFUidR(#_N&74G4~Ssr|qmXuKDMu z&d*D->Q(3QGdK0So3qoc%hgVeh)T=R?s2&XRa~{n>b&G&B~-x6argG4MWRN=-XYIU zRs($$NPd@-u7)4Z_v-C>`hLc`#+f44INvxKO#UfM-ZhUp+~7D{m_Gs4DA9O0B@K0z zgu1r&wkr0IiC1MC%7TvG^3A96DIfX$y@f_rVMQkQ>p*}H791zn`4vvzS`P4^K~4c; zd_c`uP#n>KK73p?_brU364c6xjh<$xqUnm%`=3dl{Xeh6`vOuT+Xr$jMbzpG^I}oi zFIMi5<7Z=@sM?!3DMrlZE(#v|1YqOpHUWr`moObrREBy_q&*JuZA0*Ax4vI@A0OZF z_**Yq_zHQ*e)@o2iF|bt+E~k~tBaPac(2WtZqA~)D6p1TupOoucLJ^4tR>6F01zld zO`87wrjZP@`vL>bh1;Vh^K%K=k@sRn%r@H*SsxDZfoRCAbD`4Q`VFqh=`tiBW<;yX z*f!Kd!9L6JMExZKgLe1|+b7|KwU1*kKG6S{d)k;FDCwFkKQ+eQt}5Y?uDl1HZgyA2wZOTf)x zII4Xb$BPp(C+KRXkV#vY@Al1>p5?7*K^@UOD&IbH(VXt7AF15_zmN&C0PvEzQJnb{ z%cK-k8R6X)HF5#vlu}FkyxXWIevP7_c~+lLZQivUeki#Ds($^FY*5f^pdyJW!Sn7<$_MLdzaA~(3az@DYx4E`@IHiqvnTc?LVS8Zz<)e1{B^$1B>!z#jFK`0&$N}Du%=`gOpNaK%hCO) z_AuibOvNL&yFZU*_&@h#>Vp#zUTbf36SKoQ9NQx_)7@S>xt?_iBW^M?a4aC4S(k*1 zRU{oUhVh09a1}np{Ss8urjftrJ1l06zBBawV6YofWycgG(Onn)z5#s2jt?cq)kJ)18s$_K^x=B%2~D0=V)PE z4*wd`$o z!s~r1uL)e9Y++w(ud`zerdAF8%BPo+noZ?0gcPe5CZX_IQM?wJhy_&SE_X%ED?w4n zgbCZ|CDyZ?`b+bB(taQY8O#F$mx{4p%g@R$wp(_RI@1WRT9oV7+yVDxsVjWfyTk%Pdb@=xz~JERVb1Ct;iW6>|k8LA8&9M}Prs*E$OYs~Cu zDF%_k;@w^PuV#E|qffAu+S==5{$S$kaErh$Uk@7lRenMdO$tiFsb`cdj(Me1S&U23 zi_O2~tazI~t=cTAlDw*e(~ig+NwcGT7NxKb0cTg@M$lcHC@#IaY3+K`2Xz*>J?Hm8C;TNfxxGw}CN3 zgI`kt&V}f%E$3oC@5vt8bUs4AiXqiM_&Ywfy$zs$Y5l25+x+xQk5=18CADIQn7uQL zhFdbpTxi#LSD4MttPv!!Fo(&5Rel<9MYr{|nZIB=AMyM-aCU>xP)#~(9GxXc@! z*Srg>KUc`r3+Cd%CWCCfc`ATmfHpzOhq2L|4dCS>uwDZm7`b~%TGxXZSjay9NR(up z@k^5Y%^cEr>LFa28-7*w09q9@Dq%dweH1!8tshS!TqFp3U?PzNW9{tPdMhg z_F>pAmVtDsU^%3*rPg*R9H-}Km|8bpfFa@amVn2u zKP1Di-Ji>UeQ(|-RBxF&GrP3Rk>@#CIDDrf4rMY5=>Dx^I&7=>XYJH}>)-}66D(rIePgg<^GQInDCn%Y=S?L9Fj;6C|we4k1&i8?Cw<+h_OPCVO^l#tMavPczXI0vw##!l|BOfA_ypw(36e0C&vPoQGwgkg0rgn^zKfHGlW7G`)7(1Swrky#<)^ zXEAJWR|g5pnUnQXAo+qCOho*(xtQ_pPWQZw2AKR)(=V2xb3td_+~Srj+4T7BdQ093 z+ig!=k?g56Uel(+KdRUBD2BbR7eQdeYhlVG=% z3$KX6oM5+dBW!Yf$-TUrzb(c;hnlK{M8mCu#n@j2eAB7PN{~;$pcl z{GK8WG(|?l3@IW26#rw``X3{&{{EKIE*vi{{uqrX zZPg?Velhn42^4beNCHxvF)(MT++Y=d2VAnmGk|Obvz=@Sjm`picQMTor+F#}{F${F z*SMuuw8N-mV!Vx3?_$$ak|j9Kn_Ty*-laxr$;Uc!x)PCTWf=23pGz z?yGI34-PkIK+PvJ zf@S`ha;B2%OVSgE?A!G=U%Z@SRaZF}?s5a${%D}orm>ziqHn~DyU9BXLq_ht?J8+0X ze3jw)AqHGHrxDg1PM?NXAY}sT_egV2O>uIiB9pX(`w3AnxebHwyFc6QkHtq}_HbP- z;-JV^`gubBr8(1mV_cvios(^gc8f8f*CfV+TXv@x&c8@V6b_Ix_jgwMAGy668Nk;< zPc(S2LQ%m&uK%V1e^6ev1;9YQqp+ud`~X~Yj-t+@NnD;>oEIvrpKh|=`LM8mrPDK( zI)cWY2>Lkn3+9vC@aJxH`{fCdXoAP`aqK?IBAYI>t8p@94;2dZKZb9l{XyD$0cQ7g zDdDpbRTS{18~yXub>3RTdsrK^;H_~E9}CG>;*Ou5a&iTm39x=VUn8HQ2VcqKInC90 zRBJEfdXi`o!HFfIoUXo137DQ=bQScpEHI2D)f`9nnn?H&=V1(Yh_ms$O#Q~+OF)GXvBsCe=Yzi;-a7@Yv zFQRXn6$taZP_fY}cVr7_-W*+N&~UZt!sm7F+55Syz+mjlD?H=?4k~{i@}dMDaRmvC ztP9oN7wjY1?F|Wg42+({bF2dD*R!NB!8&Re%Xa0xE8^p>tE30aQm7R~(>eL2+O82giXXD)8h>g6cz{iNc#3K6iCXDo3)Iz7vULAH>K#)sA_Lv~Q&XR|< z^zk)sz@Y2m&uBYU@$k~Jc{ACi-pVX-p`4ym6;{lIL6!2cn4Ex2O+Mq0Bpk2!UQG7W zO!q+ZrulG(!jTm&=E=h{c3mJb9azs+S_%|7>ohj4ddVGoq83H-Io^vz*`1XI6Nmy) z8yy>ZNw3`vfLGVQ!HHRWYujLd??oRf3Dy~iluHkm=R8CUZh3SAhjb21Wh({6ThlI_ zxJhGG_;jWc2F<4iN-E-pk>0W2xV0x8vQRe$+i`{U94FhN)oC$@IHqc4D*E{Z6cl?y zeE2QuXtqxU|G|AOfVB@KAAsJAcrZ6rbeg?6Qeft`?rBKJ=+Q|-4Wd`LsUSvKQ941= zATnD0HPKdY>a|`Qg0bxD_g82A=|hGB)0VtHmM`uLTg5JkJht(Y}v%Sbl3BdvsPsuNocPnIu3i^a98T&Z1d=T7!lP*<-!q9wb( zlkrR53cwEo>!;g~N!JhU-;ec|3h!*;g3=$R=FGI%nQ#1NE=kR`Ggm%!P#MbQD5wB@ zC*JPGvU6=v6I(`x6m&>#t{a|!hk!bKoUmV0oq*Z;LRdH8=NTLL^NJUGZQ)rJgkebP z&^6`{HWvPBoD_9}oTPYbOonwxM&x!f6AR6*vfRr0Y zKKz;p7uUlmt4-wJg!3RjJULkW+Mi%~Sao=)S3PeXcwFU3eyTfeWYc0|NO}&%Am(ft zKYI_CwAOsG>f}}Ie+l_`9^~*`7CD|jWnOJ$zKjNak$oxX3-Jrq2QqyRte9)1?9LC1 z@cN4Ui-6JNC`vdAKhAcS0h^Ba%oZP1;SNwcoJz_}cVfx6s@os(8Xy=vVE9u1f80A+Oi8g zOUf!{_esakl~~-bKW_8aBnFzZz|q0Dy3yTOK!zUQPhf>~0_6mv?_0*uit6=>Q;E%E zofBZk3#>W8nbD&Ht05pzzcw~5&A+VB>s{e+fBgrj&x!;GNN;BSKJgU*4&nZb0Av53 zV603G%$)yMfDLO%CmpsT{y!H}LY3Cw??2wsG}la#5*>N23S2BaN=Qb5YyxuP#`D{1 z88!f=CD_qegHFY^<~<-A*0!GC_u96ftF`z({3a%x-+3+9^^bkq=aqDiQL?(_`pu2+ zXe2K3(1f9z+ZUTr$c~@e>nbjKHU{yYmG{R_mEBL{YzTtJI^N)LUeCurs_R^ioKDm# z)29|MPe_@b^Jg}?h6`VZ>#QuBXGNY*MXJ{6B3(ywvHrrXi=S;(16ag<5VcMSsmc{Z z$rL@Q*PDXrucvc+Z=uHZ>qmQ7P8a^2o||`=oxttVPbxC(>5N$be65R*PCvPrHI))W zy9&DOR$MJtoUK27NyzkHw!wFXc1CTtSH(dG35$VrlEyt~RXJPltCvWVQNj}cBl`+^ zD4dCY+`$_imXWu!L@{(QTbRw`J=fBKQ&nZSAn6+t7DQ_xp;hqLmC>^m&+6|APN@?kUYS`AUW$ zuzM?|>WRSZarZ`z;p|jgU&Ka6UA$w&UeJX-BBS^U45UPMAN}P)XsAZ(sU%eOM~${q zzn!GKWHWcGchKLcE8y%YTP?3f7neLsj^Ny^zLAc zO7+jv=R?DVdK+teh;=y-PbOLi?xITFk*%Ww)Zq3d)xloB2SdcZvKpeY#;Dt<1&?5` zRKVeqgPVcmXB9xiq#+Jr061tpJS}sT1KY{6Wpf|?93~J7O7fU8co#%8d{FI~sv8XP zEaBhV=MEFZPaqh<%eqly)f+~3y;VkBadq1QdXrF%#m`WhheIhHsS6}MX90~ObkC-o ztTP1Wn)po>K|ij0<#$c=e4lt=Y*TJ|3pl>bM2UMu+T$gL_yt%Qzqs5|ffp-u+`$?L z-apPNhk_zbA19@`M|OV+vDRf33wz@-7Wu8&Shc135PgipeKyDIfV25;IJS z2AQ`GymhAq~1nU#|)T0#x!4E`+$x4NweaNqI+|%0u=61N6T3A zD=C0oQc91|3@w!o%3K7!?D3jk1=rFaKQHoD-`9fHrhKCAp#|E-n{i=2@n8J~zwcS& zF#wQ_$ow2+S3agEbR;gII8xL8)MD)TlFjh0nf>E5%9FvHZ?^q{WEoTiQ9`zD!6c2+ zO?r@$IdLN&w;eyl5lAZ)-suxWQ$naD&qZW0nvn>-A>@l$U=QUW-vH}H1@FQf^RL(2 zZgnr_whsEL&Zi7azIH)5L%sx+xVk-eY-n$?WM1D}8@3<#<{>+TvuIFncaPl5z&eFQ zdR6})C0!w4)6I zLz{I8-ew)fA&Tv*v*-23f06}pkXp3fRa?`K8d>m}=^7)rOrJ6$@gva=wPii5(PGXI zGD9he5;AuJ|BHbjj=@FJQD0;xB*85+F#Qtu$l>n_^|%(Z#26PM81*7)$JCB*9P8+M z1_XL6vsNtdOrE^GLw00r5V5v3bQ_p!JC;rjTVU$C)&yk3Siq*P3N$^M^I}vVwh-Nd z-H!u2j2_!*a{z5dNLasg!vT9fz3uR|FSC>U^>?VFS}0It<*IL!>!RIB%4*=jozh!pCpgu*y_Uks~jB64(03=&K`JbNscn~Ifqa(}=L)?tOT?xG5sc3%a1izbl z;IE^o2nD65+eF?GaO1%AyjFi7$>*=(;LbgN;H@9Hp#cy ztcPG(2BnsMF7bI9=Rk#vCH@Y+3c?}+YdqvuY8YQk-tPN6{d}w}ab2sJ$a~`8G$VWN zn0}){U+J=k(XQ=XzgN9eb3(4-SH@BQ{8c?|8RJ88ek9)lv-Q77?A2*R=aK3CJMs64!sn#oMurGqWxS;- zRU#l1K~Pr_W=NFcEiq>b}gUoujWq^Z=s&8mbF@(#s{NM2eL$S^N27eIlZxthYq zG;M(#Tjx?=w@Sp5(FHeVWoOK55z3BGoR67xwU#DB80C>Tsfoy}L+B?NOKy>sZ8+eF z;qE6%L=dHiJ>k6k^ig3RMxIs%nf^-%^uW00PH7K*tH`pff?Ui3*|8#*NC*Z1*bM0y zs>i4hQ?`na*SUl96;re)UWQE|0AMKe>$R0_gZHRV$T*~zmSI2r3qG_pbT1BJ808HCD(<{CyhibFjkv9LlR@N3_2OB1tqmY%;H; zAW!0x8-_z%ZZ7W;&I=D;y34MQAm_H59&BI+F<{H+d_f8Yrx-byiCB!9_x@9ID$DYT z;Se}DvjZE8{?~sZcb`&)8E{%EnF^;F4vu|OeuOGU8NZTiu;}vh@2jVlleMgwC3N-9 z_3+{rKi8T>m9tyr!%7{_BirAT*mxN*u>OISwm+ZVq9Pw1)|zz_lL7CFmzd%*@Z{4q z6|!1rKMdWR%ONpt$rF97(Pj{#q0t4=;Tr3nO?^U)q`i+rJ+<}AZ6GP7Ni{YC~zynFEZ6l^vYn@DB;W~ zO`MpcZuQs_T0}ma^w(|O5*pf*0-@|5w0>C|nHNU)tH@pKMgb_u$VNb5pNtx*qP@2= zsr973GYYwH^t~kALH3~V!94=w54gDnO0049BEV$fP(TV3+>=nyOlF(Bye_R94d~j~ z7~1$ZzZf(`316#N#8YJk#Voc~JBhQlxhJ8UsJ;m6S)sDLKn6otI&19aPT1axJ_;-E zieXC-0OQ^J#5%Mg7+0^4owVrl_@tq)_;<4dbWQ-u+tUdm=7jFwsI=ZVqtx<%zIAA+ zdF`#jY!q^shBNpu;)rcrKh9Xq0)OpUKhA?{znZr7X$3qJnf39XLnKZ^A~lIxk&H62 zffuS%VKV?zIA&BKxN!szMR&fEPAL{ZJCHoFmr$$saip;MaqV1tL)u+j^hc>%cLa2G z^Wu_;!$N>s1}T6OT;Ws+HePkT1tiFhVMh_fi7`O&WY0r(4{{1ch^fz%?Zi;iV9jD0 zqvtY&UzEWN9Inr^sh*mA2%4BtDZ|_*hFA&$yh=6t^_5Xis`&2ITDZ~4)T?TImVEkf z7J!T3&yc16oRo~H%VRh+m3NuTw}|3mD~w94fza{Q=>v^dC4J5e+{GWRUxI~-?k*2( ztJh}RBXG6>Uv0q&_~>F7Z$wp1hoY`NYNq?3}#dKP^&R1;`KT?wZyD*Z-0ljRLuA|eeqhan$glNa?q$ATLgdBuW z$J(TiwhgXM>T~Z z)}Tzco>wZ-uOZYFQ18U&OuwT+8%P%XGIC^jzv-e)fYxrGM9H zs@7T&B<-i@Lx^Sln@JE;U^x8H9DykIW2AkO5*>H|?2G^UZqi5ua8yAis4c<7rB1#V z77RP<_ZSqd6-Y2RLpBonNt~@%+>yHd(Gw;C0B2VEPtwO>A`{_BoY%OWtUhm#D1nFx z*UZ~Dx4vv5R+i$B!_K~to{e!%B~ChnO6iL}OF{rjaxeDGc<%c4tnI%H_X>zwc<|l( zcuw>X+^ra|SF-$|n{KCVu^;O@8hh_*eH7WakdM`-`Y|6&C<*%@s3an`zpbS>0{DdJ zT7e-!wt{{rFkKmqqd9ux#+{8l%!jG1290P&`l=!;6SjQP$>R%EeN(lZ0!W&N<27ny z?uXtk3M#;C6Bf4|@p-ZL=E+|aVrN8M59cz)3&U+viDx|bw&3Xe0v`~9i$9NZBCe~} z!*eCE*PYfexVA7|Q8yuh#3Ov=noPxSK72K9v#xQ^_~2r0Ho)SkIWhZiIOtY?l|hKL zjI%A1tK!dk{H`kigxl~hYS2eEA7&1cOILZvS=lntI+W*0V1PLr@l)RI>#Evg+k)Y8 zo+9cGy6Z2BTNYKV=TvzrtBxMeEBDr%8l^z?zcdX*wRt-L=1!MXQ5uEK&Zuh7&Iz2x zZDN9z_6dUSldA(EjxBqt7qqo6Zi>``x)-N$g^`U5DjQ4T$i%y-#f;-Inp9I#nXLEg z-`~;TxT4SKlT}HqkE@f2Y@2iER4o;zn4M8!MJ0G1vLD_Pz!M6ODykd*aBHBZ0f`85 zN;w3BiGvR;3bKnZrE4@5ZqWWaQQma4NLXkXcs5$h%n|>5H4fL$c1i8y;ZaAr4EWfL z7>Jzwq9$kP{kqmDkoSjtAa?_H9Xq8|fs?D+#;}%C(X8Ra{^XNG0%22;3Zv;K52J_F z@ih-P_SE{6YRR|i1{DT9bO*KCiv?7K3$oY5E)%PdKIdFYPdfAmdH?hH7{fJ;O9dWx ztTs;wR6j=Su_whl9kkaz37jznd}g(s_Q&QWAGx!Nbqq4B^rANZYOuB0jl?IE@N6=r zE4m7<=GTWPw=XUH--bTTSZJhAa`-^OL5*&EXbflG_cXWGKg8z}1j$py5e6J{B+UE# zDr_6Oi8En10rh5?ZHa&Zzd@B-fRj+r7?&?ZtkA&X1WCnlmMD7M)D)c9#y4^JcMSl< z!=VJU1q{G2;ZF6syVv0PHM+0226|@)e6=@H4=s=ZaS*`cs3bjQi3c8mQ~MXrmFBW* zKep{0T<$XEJec;9$u{q2J=T|I(_Ib(OKFGihFl955CzJ`mB@tiZhn!B#0U9;{>4|N zD#8``t0rm7(giV28F)Bf`l;eCw;BUZyY_v3Q{PS+oq2h-R-`A++V#k0qdP}6H^iMF ztsuto`;RO{w2=^xscpx$#WXZ^HHhY=V(;jGL2U#z6QCW{S9Lb`M z#ogW!YBp9>w?PIH35rNB+2`(h7s>F+-I0XxyAwfvO_Nt`AFaM0J>zEV;hbw9j(aor zTLw}t$jF{tzOHYE8SZ8dI*U;@ ze!}N~ndw7OP+3z5? zlT2t|cPrvYJQ~i7=W06u$F~-Mam#iEuWZ{A=GTY%qSS2q2bDW1krr~Ii~UwPReheu zT3sdyGq^%15%N^C;F+EK^~K(A3-fl5>?1Ai^Hn2hJbhd*GTAxN&A?-Wwx-=P3rU2K z&I4UA*%h`R-02~w@rHe|8t%A<_VOaLIg3BJ)fm!!SjFY?A}zk!hvCQ8NYk%u=gq2N zyL2lcLO}CS-@N;4)WdU`O|r~h-8FrY55%Q>Jf36WPl|D(0p>S*b6Zz@0y)#HF^GW08#G3UV6xWq}cm`7}#G&X~> z>xZ{zIW{_6?zY{fNdk;N01Fu+KLZs;BkbDcxV`=#sLmOqX+UVahRxB7LwpUy6$*= zgpnr8nO;%YI7BUH&**N0Jeiig>0&(mMFgCEoDmu*`9bCv1%q@r&TAnda9%BQ`)DWg zD@evDUqtz#lQdOQMvssLK0D+7S8F9Q#2AJ7U0>?zzv(_}6k&XGXjdw|Z2V;;hFeyK z{Pc94*8-LPred8BTV+G{JE4l?j>+O<&ZxjgQ)p9%$-;oP@}%N~vKLE?XmF4bwiN7q zjR`U^&16tKh*lG~GM_?3)pr#IUEb#3B~)z|Rv6%x9`?Ta~lNOnP+njGG`=a z^+G_FbKzKUI`v+}s)T(W^$14p6EpYCgTYzJFHle=$SqVfcVJ7yqE@dEB2!yna(BpZIrVpHzXhtzon4shzLJ3a9pa06HQ z_6+{F(*&Q{;(PNAmIDfi{$|&=VbQ#qbaz0Kl*kTYPJI;A9_L5Jw1-%dwI6@kVbCl7 zP9iE^R7VEVE>W2>c4&ih4?G%srD7q<&>^HbzM~G|o)PI|KGICTK%7Es;;j)6*d{Ca zCU0cqkhVzkbK?G7at!;eae$h&+ovx7n&cO%!Kv(Bm_#4y9~8hS&a(!|I%YpiLic1P zg0*LfGr9e4S-U3T^dpR)v&ZUVc_JaC-6BV!&+4Jm5f#yWD5;D`Nat(sF~-3UOC~qf z$?HI6hJDO4qhHTzcU-hYXorCTL-RZJ8>)K2&}rMes~ylu`>mdjCj%2DQj0Tk=PjI3 z>gy48$#(4yOt{>D7etTqkpvys`a7GZ%1ZG~kxJb;J;{Qie;i7Fj7Y!A!Vax2zl_&S z*z2!{Qo_z@Fz}hzE26sUZf*mf7&!_A**}Co^-XK51sG7$u>D*Ffqu`s$Sz-IN{T3k zGv5cc!!qNHP)D{epzE-s$^czdP5vQwuUux8yvQixdD#{PSVXie@2`iWwkby9BgdHM zxC0!=A)Ja#`Z*H~zylkZ0x}9k6088$&qY#~_ZvQ!JRcD7a~ zAThm{HZ&i{yi6wkvt%ha}Ngi57mhzLJ z;AP!Qx?6N&ShJrY-{$s}-%GOWBj5LplLsQX7r?7y2EG8;U`PB;m~E`Q%N$$Sia|t) zs>8|52WMHR#3$gEB_?%O)LucmUPgQ8iW!n%#Nsy)7Ko{Al8LlH`b`N)9az6)mWPx}`GHJYk)$NJ5@G7H z@TKjUgf@kP;Q;Fw9llu41wAc)_;ydA$n-5($dzE^hDVO^@;e zp8@1Bekw(uUZ%C{ID6I6yOjh6X((1|buCgU@<;?Cmxj%5>D1iS_Qfa&2SN#l@8)%n zx6{3Fs?*G3XV+)hnDflpskg}mjOrS^YF3Z=G`i64 zlncN6XaHe)Xb<|D6Pw2723$|7v- zA@FfN4BAp>S=C3@uwdUqA$Z|noKffMGJ3I@-j5$YqxahcYv%49Q&2!)OmsV19W9E5 zYT(KJgep7!5jhcpaxegoI1R({^tXdQD_ylV;)urkoD1z|>%s(Wy0K6M{UHhPqp=%L z{aE0dOy<}^W>y;wPun&4E{@3*;|$RsBT=QINhau+aV0zmC~eHqj!>#An^E|mp@OMi zXWeE|)zxEpF*;}GqU_S+--Z@pIwZbkA^wH2|5IhKrZY*>7Rrf z^p~%hV=G_@m||h2r?*bC>-(eJ!FIy4a}F!3SZZ`K95fJ2s}Muj!?p4$)p{a8YJf6s zbmQ7*6+4@)jj?WFYQgo4MY>-gbb+xxfo@-l=R009pt`&jFNVn*uZAo{kjdRqbi4@_ z6sL=PwV;rPBybOJ+EGJ50w#50GsTKhSaDui^x4*ae+aN2e&k1^A1SX}pVOb8N?mdI zVX~K4!=6OrL1mjKDnmg6?nh*PF%zStCwxZ_o%j7V91rD+!1KlcfwvEiF+6wE;p31^ zE)s7?vQa!TmxMuSY}2I785V{zm}5q8h%8@0_M)Yw+r~}RrfuhKgEjv9z>=osuj6`a z6E^tjS1$RX0Td|qT1IE|jygd95e}k30bhqc5G^|Nd!$qzp{;{Z;7zC+yxV(Eo1n{N z{)EZ5LR*llXV&Nh<|H^mk*e`bd|0M`1zD%M-%!HZnW7oJPE_{BSR$zaOBy`ZIS{M< z8yss4FC#V9<}yZIUS+eywmZ_$#(q97Tn7u+6tpIvsjj|u0bC_G;DDk(Xt+n~T=y)R zX9he>J3k3jTTzb0pg^1iDS=D)hk<(V%}{ot85c^c02kzdfi`p%-Q2j=n*Q}I zGwctJoL7L;;Szg-J<*2e_6EG_dDSFthvfzaDFBG#9fX|!$c$=so(BwZ;CaXg3^V*A zv;5*unt1N)FRstTo#TN)Q^UR=$Gv@-xgJ>VSl{C|)%$T3KVZ*(Pr`qDUH+#=M-6=|mWZ;az7GoFB{x7f3IP|Mv%2A%MK-M|7pRq7RgOkar(%fC z3)F_u1nZ%ruwqW8-e<14#n(@xjWK=_WE9`xny&dif4DwhfTtnEz_1f_cFjc0f(Zv* zT)Vr*{oHBtLNDqmF^o8SH&C)4zdVIieLXi&?v$Qim~+#vXY4)-C_nN3@az2Y9*Pi* zql`71AqsC@wBd)N1_&0Sst@UavP&S}9J_jP882~tLo0o^XDbt)Q9ygG}_yV6d1>{4ni@J!X};lDr&ZI*B)Q2QGmqG4Kf( zK7oDV_tBu(AZ(v6PSoFzjxB!HWp=wAacL4*>7W7hd<7i4xux&;PBKOaCuFu5iGCf| zl;`SJJRZ6FgKW@Ae?p$8V?Le~L?E_T=$Pi{uw5=zP*e{u5PnDb&Dv`__6jeH=x{P( z?~r7c-`evoNVXfLS!{#vhciS94Deud1pLZ<_q!bdi6zE>G?Kd%g84A_Rj=p8lVh6B z24S!ny3OSN^1!{+xQMR?L|ytSb+R^-+InLj96pe~BdQxg0v0$prmkJDMwktm6%7W+~QqdWBe|H_}`IR6*lCtWu0Crr!V)M zUF_@Up~dC9y0}$lUCt+iwjKEkS>%P|!%$T9T%j!S(G6J2q*0{uQW2(9h^UG;#}R|6 zLY6?E_dS69tZD1h{_yky9t86`3@{&v%nqF=C4u}6hZ?$HRj&72y1ucwIX3ZzA#v0S ziu-D_#ZRO<%&66Ks*5XI31m#>*BgMbdrYRZQHq}bzH)f!I-0unkCMb|C6&e?pgjoX z?+l7Wsgc61Wf-6#s|ZUbS{w{2Lj`eCBPxY_JJH+gS&pIx1iyXa2LgZD@iBWG9Ix}$ z!+SXBl8I?MC^CVxpbc(bHNNCw>W++F5D&%!?)LU zYZ^%tquIf&w8G|#uA$6SS4qj+Ox1;Q*h`W#OL>xfs+yfS)8x}7wWMCcTiFb8um>EVL)MTba~ z4f#%o9QMrZVc9apyO(a9Q2vV4W-L%Tq9PR-Al|oI5jPYJbbnzL{&GD8@x>!AenPXy z{?K%zrC-q@Dm{eM5*H+K`;zTSDjtjLJ{+pwYMCCd<8+0ovx?zu_=d_uYd)wU3?k4E za8lkYNufSc-D`jRS+gbAIl6+vsV*B<6CNa+p8Y8C7idg}R3iZFq)f2?9)Q{orh)G1 zr`g;j7gT!e$-&P3oi3$$Yb8#~SE)zkfz9#bO`88q(gVa&Xv9;Xah-dmx|}Oz zQ7vbtD~6z*W5o`!EU!@~8!-;>@ariFmHdI56+6Lzfj~2ps{-1jh(RbaT@9bB6mc0b z7*i~Ux#v*dS9m}$BCtnIAUz@0Ws)EsvdM4tIP@N6;JW2^`IYeUExuZ(as)ul06n@0KwK|}4ws(#2c&|F+>ag2m!GZ1&QF9v={`Mmuet<;mE$};no7rx4Hnzn z`}b3r9^jS_^VWY;8~;7p?0s9L)ymYk|BtbEh|(n7wzbo?ZCBbxrEOK(wr$(C zZGLH6m9}j=Z|!ma#y#UdjopYC(Ti5RW5!%_J(C#s>$(ni^Q+5<=U-#%jQwj7;OpU9 z-VMOev&SPQDFoXJ@LFX87zLs&Twfyym{jj_++2Tm9t5Hqfpx{W^?rVj+Sxf0i>R?f z`rW79{Orm1SmxzzK+Kvv>umMD0`%HAxZ2jfAGO&yHjRUd-iQC$4@LFt^f_@=hmAz3 zl5H4s!Z@^6^0stEjR4$s?B9-{^eZ>I2W{aw29W@XoyS^kp}prC}Mv! z-c4@ul;K%S{wvw0Vp{kXjw~ioilMiMeFU51fzP%7@)u8isu5TY5+JB7#jo`3T2mi| z{2ACdHRs|8c^JbZ38FqeeW{x*w>nfeyJ8w=OqaGfdbxs!fP&qFrGzBR8_Q(m1*QM` zvL!${;Q4m9WNg1HL2`!tx&FW{X}ou@>~q&&V>@sVjc6&V3i5w3??zwi1HU@WTbdnB zcHgZH(Pt6(O;Ci_mkd^FIZFC!7msQzS)U4P5kVgr0zFaSQ~Pq8$;`iBG0A7Y6b9?u z!}LXlMa$YSLLYd^`x7GWNFQ;?f4CcM51qNlyV1r!?(z};fJEDKY)&Y`th&rAM{w@uFZF7vjrqkjk76k^H_`hyc7UxQ(?-7GbLw5X z?k~<`Attojg1m3VgkVSVx|nWK^}>VY6LnA3UUEg$CW}x+JxTrS!ts&WdXu*H5@S)G z;*f2_)Oxj#M5loerwQSiFtcy}7N!+;e8L$M@mFJ=E~9qv`1uIK=E`8jQ2FK8Q$O)P zurk88?p85L1hqXc)5KjeD~ECL9Wan6`g#p;CA6jEb%Bc#n$qq3wBP%lGn}e~Qj>&V zz9iz!M5)cWkH=#g?ARgL^9$iR{Xl=3(UY|MI-erJhg%x~QBU%}f!+XJ5N%%_b-+(u zG9zWG-1KiM2|Uw;NTu8R-#u@YF5icNhBu_7sI6hY3zRc3mTjAbVOvnKUHi?-; z`q6O*0qfIueP%caK#3M&U@cMJ&sT#mN^C%$&?VMcf{{kZ*o1DwxfT+iI;sS^U!vUi z3FK6QcT1Ygw5#F+_vi-LDi&NuKsg!cR;~MyjHLp4o&G3_<%$cnICA)$UK;IH1e4eH z)$jZh2;!h$V&J?kz-m%sahAa;0nL8jpkj7j+ytLT$`LC!c6h9zJeEV_st0EzmqD2C zJv{H*cx7S8XDml^!_Ds#+qdq`s1a0{x3mv*3xeV-HE&C1hU{8-%P8#_!j(I#l z`NpPgY_`1g^*HRbt%O>?T5?)wi51BDNG8%ke(b3F!aD10eU7#5gvrx39{ju3nPN-& z$jjqUFuvU+lpwn?hJSb_fpCmTgN}T6T*Ep&;9x8%MLQPm=Lq8HxbMSm;n3X5ZNIWq zf)bp{J3}4og@kCS`k%<=g4L$^$0Gxqui+?Q_)J^1PgRA9IY9uU<=dz9FjrdHC)^sQ z;0FN_Yi}g;o->(ovR_tbgUb`u0$ZcH6ibc%ZH*qKQJO9Vd?OJ;w*vew)gQ&Mfq7Qu zR;dxF0H&~=l@!Q~Nx|{0OrZjdh}mV$8!Dc`I!GoLMUJ#VaAwv_k#vtx@PN!HVA>F2 zbZ1a)2+Tx>;5}oM3+8!b!Rqyaz&!DIMTFc<%-E^ z6=q>PQ=gII2@D`segyGa^-;IEP0`mLHZ-nc20mqhLFqB3UnAW1jroO!I6879~|6nay(}G3_WqTT^~_A z?t@#krX>|%_(rvjPjEqtM@%!tQ9qPR7+Gt)&XkY6;CxMxr$#69a_^_K0|FrJ+e@Wf zeWY~~=5s#Sv=__8zuubma%AQf1Z+8J(DwQ8{ID zcR6@=5$XtnnaOIwrOY2`KF<_S^zJ_cMNP|`b3%EK2f4}odk&SQ(-_$UUO54n4$4zS zp9=7*FWMYSAU#nmKD!J~KAW+CxV^pFhX)Gm07X3k_9JAscqMy*KDQ|q+GZZX=ZZ@r zl)tD7FAzEPAq|-IA+(E>L9n6%mNSQ%P89pmFEjwCj3Ufeklq=lbT`ZGTGxc=JC6X! zMl0}bIUd`-s!5Dky>R>(R7KW#sSL11P;!G%<;!<(@Qdu#~AMAS)!^pkH zWYVo2d8L(pm%&=Sb##ZgAQsdvChNbi8D}mWL#sM0G?4y35hfZ2Qh@!?-3kY>`WZ?? zF&4L8*zDhk%??#q^?$vC_rgo>u;Qa1#*PnPF#ckoCZa9Nw`89Cg3J#s{8fWW%-`Uee}yRlYPd=a^fjU1F&|haiN?m z(ssyq|7`==L(%S4G3Ii~J}m9`<$qC8ZFIuhk-R_o0!O_+fpYeTrZa#(c6e83H4cu` zrvxzZIwio0>#>$cGD6tZT7OB@XRBHX*Rs(Db?+q0s<*P&gy+b!aFX-Zwr5jt|1Q$2 zs)aXfPU57_3+kj>ZJj5NapL8`)uDu;n+e9C-#|z#BmTYS@#LG8^Db$2PpcujIpT<_ zpET{7H;YRrB>Kq?EC^jpOmwY;_o8?zC-zc2&u3vjn!xR&J@80=GDmXXRL6ZSZcn*|H>OLWI=UnJL8MNjhR-tF(tPAlP#Hl*n#WUdD0QgyJ^8aR)LRsTW%F zxh9%V&2Tmg z2otyNn}n}y=$aumi{2iQj+V`m>71vi7&_|j#dpP3=qCu*C%2dlCFIkkhE8D_)_kg6 ziJQ6ni~6Yr$+Vi|XsbsT6|JEA2t%|a<*AE>R-o^4?*4nKi0x<51NIjyj(i%e`{H?t z;kS3&$H&b#=o8uJ!2hD?x&Av6Br^-k|2v%+{_`&j(2BABqK-99axXe`E6W66HTTzb zRyKBZz-Xk6Qyp7SNleP{^FtJkOf{v_V&RaS2U-|A+#9{&^;lgJ_|-UYOQ=Z=^K(nX zQ|k-R?EaEa2P2JP)7-jLC(}d@WtCUs0L;#Z345*_O>>(@i+*l#A7_hmSXCB=0bJnX zy4ZT}sA^nY=faq6v|itjj(dN}fhEfHXNqCWSO4I!BoM*n8PzKOcKc290$BX~&4%l8_e~ z;zUM;4_)^nQ~@SQKcmExKc&ykD;Y$n_1W-4T%Wox5oO%G+$NlW{f+1u zHln4`9Pz!XwUWMxx@)kwwMYkJh@6p#*eF0Q$lWo`auu zQyKSv%eM{<>;glj4#ikUowu^K(k<2l^ELqke|n+{X1Pe@F@fXBV6|NhmSJ}asAe>@ zTafA73gIh@1_(O1v7CJbk|*HS-iw?^8%g zkTs_lUb|?Nj1r-*PVb$Jp|H@+RLcmL3vN5SXa)81zfH@z5fO7E&bxX!DpB6=Q5S7A zZkL+8>Gxhc*0bq8IUs#k--9%7uO?Vn34}J~t4Sbk68x>^0E61hzFn)4j^)HXR&hBP z()%-#3@bs+e|NKtojGqhFYdJq=(%t*Hu@q64!b86zNh5*?n0%$Tipz+@s^!bj_(8W z#zt&1J%?hH?xZ~n^wQ@K_CBnno9bg<8xphOMM`TO$Rk8Jeey0IkJ=AtM?z$k#TW&p zpy)(v63TW5rT%MlQw&%%R}z2w%K5dmj{O=T7#L6e*-v#uUZgS^&1}jmlvp1DN;fN| zso7R$s+J%_EVb$qbjScTkoJW#0;8v`MtO^ebn#g>byIN3cJ|k2tg245F07OLSk>Of zaE7S|Ote3Ff)R|dUq`OREcaT9*+(ExI6rw`_euT2=%|}Gs0+=hJiPT;0lgT~dxLUw zYQ(f?NH-+|F>g;MQE**GY`9(XS54rgAoXxwZxFV0z+6z6`y-Y2?dXt)X8#grA<125 zH2UZ~VQllYesx}uiHSv4(5M5`h1oji$wS)-$)71QbD@9BNfmUlZa&u`Pgz|&Z1J9u zMx>#@a423z7dBL(H3JEgQ=eb_Ar&4U*EzT|6c<^_rJB&DOt`HaifSja5acEKyq?{_ zc3~U_)g!#j<+vYdD|!!b_azLZM(d3puGoyqq@0+ZmDaBjo)%=c{re6rMn!P0>Ba&q3Q?@%Ju~#9f z9Bb;wzQcev=7?DWCj*tdDzNQz*Bj_~{y!Vvm>lg9E7W19qpr&tCd9*@g;=<>#V}LTk&s#w6q_}Ri4M+MOjARA)IVg zStf=VpscZDppO&3%OJbuSOQ+Vxw>z=fKt(B)bU6~EG5ggOwFd?De zj_tcP7ds=T^ieqlbKp44sYVlVyxSN$yxWWqB!ue3!a7W~!i}HTo2EzeWraLXbW=_i z_r-e-wNjzSN|uD0SDg(RHrah;13DIq9yE*;2p)4#tN}4 zda4L*7|at!0IBl1G6~B4`Gg(r>yFy2cWO4LMR0*`xAn?MX1rXK7%)N%*-1MH%T9<$ z0_~qgkXtvpxOBrNNH%_MrEY&}mk8=|QtXw#rl7K98t6GAnoh6@r@-_}?hv(%ZK6?f zuzei32%t@`<(`Y->_iZ1=`pL+|k;*2JJzyoE@El|@SM*nonz zfv&q=8RfogHU-CIejy?Ambd!U>1^Im-weu9YWn<|DjVn(xH-?bOhnZ}=mz zary0MXeacubQH4WQXAM7rsf>5mCQzw2F7g~P^H0D*T|A#tgbms%ZqYu8-Tke^ZqsP z*pYb%elc$vV4aV-pI-L~FxP#bnLRTnX}VZs#fU4SGaX_l6CW1RJr;MPI}Lo3VNixC zpG->Iv041f+r^@#?_so@s%Vx*|8U;Q6TE@?hZuO?Rt3xZ+|IOs$X&0sg#rA~o7z78 zZ1Xjjm9wQc7fRy5aj~2>FciM*z8^_|<7CpnRt}$V1v*NbcdNQLeIRi1l)ig3ddp>o zMd&wqqSBWL|7^|j?6cpJL>6aL_4PeN?PiVK26Btc^#P1)zrq3_arxk`DQ1eGr^Z!l%{C6NpPUioie`@|{*=>ydXMQ@TRY8(# ze|`8|v2}@|WesY*awUz2*39~^-K6-plAQKs+zpo#Dm9`Fwk8=61I|n~SK5vDNwj*N zx^v2)K<5J7_es^X@6*b~(gxvLk`26AUP!3n=X`lhzAB z_m7fX?_#7q{gu0)qd>p9DbKRFxXJAjut7;-`yc9(?8My|+*>WF>O_0=K3l7Xev%bVbj#M_nSK?6 z={Q1V$25J7??n0mG(hc683pi*ekbonm$$`36ZLNE?olKokl;nj1(}@S5cKUR=TxWI zgbVSMf!PG0))l(2w@G5wf}I4-YR>^7`+4UA`wIV{} z+K+%>KFwm84K|f{9kihyG@BlpNn4(1#G7wbbefU28fILtQGZl`FAt0L`@4T-v;l3dyr2XIqaRZWxo~D$FuJHSWxh!vThK|y_#*i&yYJiz;&M$J zy`eSl5pgcWkH4ERIOjc!opWjgT1d zrHNhT@;xyy4al)^UD1cCNzGd#m?cFx2C%6d5eR#?^Iw=tG-YKzPJ`?7Ft$IH!{Wdy z^HE0cUyNz>j%iyBTdQM@@_N@7@Hn5_(-4Y?(E7JhV{ChlBj65c71Kfs#qwqdaiYV zl8C77mJ{1+Rnp3_*$2oVNZmpAk0VIeLnDwegHa)1{1c1M%<1G1Z!){G_am-~HU3Y3 zyrHGzX9}H)BIO@xs1D7Y%`RCICIqzkKkAW@`Wd`Ua&DV-LTqh4`>q1*F(>W5v=54s zq8V57H*sphw}%1`MTiP-`0qFtEv>nE+|c@O zseLN}tP8iUGlW_;1IiL<%VXL+PU+23)l@-SqE{KsAi~>$WpL7vMESs&CdqnWZhXjt z4=MI3&Q!$lQ^@qA0ALlPHpt*Fhq)kQbWKHyBh7DGrPkO z$IFnLL=)oJPzNuYJ(2cmVTj;cnd$5};=>9VHS*W3Y@@swXW0Y(nt_0J9e-Uu5a{AJ zNH8Xi6mW3LKY4c>#n%-mqEi01%Jk{t9CO7c`vMNaaNZo!@+vD=hxC?d&+y<$1QG3&vuE3fk_AM`Mz-_KCUjx4Q)cO|xVHXB0%~@Fy z44V6%#Ge&f;aS=1sECC@LUBgRX3)HnE>aQ7xs3Qsfrb(Y3RuHR-?Np|TEWvlX5)uD zOo~G?zbN77m>3irr~zq5l7iA z%C^vUngai5YP6**jjd}k=0U67Aj)=Eh)+^CAlPxpVkXIK@hh7sF&7r%X3?qldo#=(D$+6HuL&*S0KhsGknR}i zgqLyeez~!_T9+L~Ur*hqh-2Wh4FX_|>bF7L8AS}!o^o_iTplS3Kw6J^g9+bPi~}~! zdM;?)ooiuFD$@W>PYQWrLdtLqH?x~5LfUhwLO+3>t|?gG8Us?8HO+eyTev36JxxWC)VBrR@1E`V>w7sa`H8WVf}KG4slCTDY=!@Vp3pKjXc8bN0XW=x{h zj#!IbSaNa_kI1@je|_#6EWXaOSM23P;Uhm+2>BmT_g|`s734|t}E7c{eR-Po`jyq`e;cE1C&x62q zEIb8imx~R-%3IJVjZPe}CJl-WziQ8bcshax{0Fo*@|ale>|5al^%~1oCHx%?w#<%Q zth=Q?qJLO}fNkFr90VYE|LS4{PwYi=v0Xb_e1sACKI)Ayi4t-L8%Wsi+!KdVP_ z2&d#?U8@4w8&oL{qS&q$*-c>+cI1M6@#~WXR4M?GFMVW-o-Q((gn+PHXt^2hR&cq< zJJrOXJ4(4@HfZhO-SSb`nI1J)hv(5Ky@CR6|&hPVo zQ`7$?5|fSd|8*1plScf%Y8pu)zW~T-pko&7DhS{Jgt?_-d_@N{1e}^`o~09^B0&?; z_I1Z+W-5^|qp2B{HA~{&@`~`?HmQwn z)5q_tEhImYs#b_{qEM|9VByDuo{B}Y8Q1Y~c7)5+I*epG9B7Q~GFu%5uvMr@Bk_`AxuzLHIDue-l|!JkDJzXHHT~a5f3Z zui3tyklkbGbi|#R;Ne{;_WHMvnXo{Jv-t#x%|sK5>QB8soH=56ZH4$ zyOoarGRhJ<;i9k;o3n0F$PLl~qPOUsI4s*ZkU@!4Y3;Jw*|SAWnlaaIy(Q|FA@QaV1Zk zi_UIVN))>G_7z9gsJ^`We!Q6TKpFCkZDJ0jBIw1S5ub?+O3@S^}SD&-2kr1 zNgO@G1^Z?-(y~sBI=2I7$U)D0OC^&|UZuISvly8EQPe3FVa{dosl>W;c~(AuD~jf^ z_q}{;{Qk0}O_B5*3OB81nm*-{N2I&1xH59FqhHsyRZ&F_5%2y1R4zP*VKKVp+PfMCRo9Xk$ecU2aw}Kr?sG4ub{FAwUsS zy6~l7^O_yJYwgG>*IYJQaqrINIvxIKvbd}6oI)d2eGu`yzH>w055L}wyg>#sP1t;b z-Im-SQ$SQU+K@9qblXeW!c2)kK~ z8Cw33Lz*&1N#B|Ycr<3P$M14>@If|7pj1}(>-=W-LyjLd5XK~K-u?{0AEC{7^zhc92) z5{V-3HG1jMLEYVI1M#DadckI!?dW9tT3`uai#GUe0qyZ!la6@8z|n(?#dX6lgMeb2 z$bzziSRp6Dl|Hh~UU*6cu6RB?J$NzIi^7Z}sUN-3`ra0M5 zrr{@E-c4gaY?+X4x9;hG9W2@eZTa;l(v2x_H$%_MjA<5a@yFMJU&I52J0q9kWhvl? zq%oKz1IPWBl&VO5k6ah%KV*Wca<4f1RHJd)4kl9r1hI8bW{iI;m1LX_G5^EGrA?1b_d2vt3gP0KYB>Srjjm+%_+YiEvnBBLiy? z=lIiV7;Erv*4MQsGqHb!rXzZ0OAor`4&;UzDFW7>9(w!d>YtThnkU&nkEc_fzj*5n z=tDAVhYLH@ncnF3BjA)Ux&$1Awf&>-abJW4dMosh!0+6GgnmZj=x90T-)BT`o{N_4 z!TsGG!A#`(IpcOiYz-j&1=!7hL4YX+{K3&>nD9nB$!GBt_7rx7CJ(o=N{%E?eRoDJ zmzsm~vC1m|8by$UY--0AMQKV3WG%fA-PBPt;B!f5xgCf)g4H%qTpA|l@4@H zm~>h|=v0k*7{+hG{AAI4VS$%lj|7)9U9gOqX&26z46{Iz22*68C)3@agkfiZr<8Rg z`2BB0IG*VDqFm(}aUZm)S94nn#Ni(iNUc;Krj`QnGC7+y3E+rvc>}z@d60cU{nQMc z>2JN5QhNh;#&tZQMUi^2$r^0hIC;}Z1z|IVOc>jw_h&uu_lC&x`nhopKCC>Lnj|X@ zZkPZc=bjyBcj6?22OqLK+-94mk!}^|>{_3v0Le zjrI=@wgXVYRz*{9|7NW0U*h~S6}H^ej3kd7tiBTf6`I17?Az;$LLIh}Dq_%%Myw9U zm)9d5Z=+D(0==Gni7T{AT3t3B(MG@?avi43>^Skd~60P#=|HqMGc=C*<;Ki zi~~)l36nk9@Hx5A!EP1wdEU%5s}?1A*_*A0dshB;(_ofa&J9+!1RFnXHqJf(f?J4G z)e+^`3?VxQEA-FgbLRiXMLjhCyUz-VWgcm}^Lj%$A(M)r`;mf3*;^f1IytD0z>(K` zo4C0WFqrg?CC-R9$$VEm%xEmhRY<0PJt-99)=x&5rqmg_Qx)R`bvVe$jxXOjnywJ1 z2IEB7Z9ibrFTi{D<#!0uyN+J^q0m<>IrWok`bm1PAX09FW0H8N3UJr+y2gS zUh~HlyIp>Y6(vICtxcot#zGTJ>+utYu$Puvm>q|8C?+yDcG&?{GfVMU=r&8Tq(Teb z4dLf+H}1^Bkh3wCrQxUjE5dKsJb5IM|G)V9hYk5}O8r=vIR6LGYWj~&+&>)V_qN`i z9VI4Z=uPoGolggeXj0)->(?9|QqA<1s(}`+WX~Z^es4DmnW!{-%kvhxkOO48wBn&X z=ff0>a7~Y11A2&`wF&2E*?-*3D!>xv&1yJyZ zKC8)3BFj}PxGI_-mH*K~4VJg&_q@9FFO;l;y1f@Bg>N`&`B}p#1^&H#(HYZOb$~wI z(08F=kRv1Ea`ABZcF&~7d`}9)Ed3%tZO9*EAU2Et(&*xvIw{Q59)PF_+HurE{O9!5 z*3bJ^x?$i50|jH5$-(*~JuB9Mq$65*q(dqAFw8S@=fa9h$+uZ2bD{>es!Kt|9Ky}`nHNN;GTR#JI`0_B z1Nt>NWfW`h#{4?_l|x(38Nw2GyX_91w!+cvx&*B+m& zr4*vV&iblw`wXRiufFLw=HucC8+pIbDc3bv#XC^pYLf*L zp3aJyOIZYZk%3=~a<*1`Jz}R$}cuFfQ59!x>&z-L4A7oeY zC_;r)L1`pCjwf48g4fefqb%acj=1Jcf!Ys;m~3K6S*jF{s^&P*S`AD=CRuHmq8tTf zltN>N%dOPSe_v@~=W7w92Nnp<&DM*!+v<=3!4rBSoxE)Uy0558^i6~jLM?Fc<^4Cw zKaPr8uE~^pY8X2YVLW*b)ZE48h&-kIi4XS4@8oK-fM`pY&=x|xAbJ{-)xqDdpaW#8 z6z~0Lgvej%oDU(uK|T;G`dSvJ(}&?_*j$09-}P3xAipX}epQz8;$E$Y^IhiMUz#su zO*1vZ&0wW(W;?pI%=#1MfU~A3q3L~8r=v5taIj__)Lu6R_$xxFX!%*+=ZjxK{#glY z!Enbn_GhMMyyK?$eVwKWtjh>ppJt9vIz{2FogNM*BU=>I(@(lrw1+ z0TR(1F@kqN`>zkA;Lz2Txx&1`W;T)b5sB|5K7MlXyFV=bhBtJ6(pcdL<=0R|oIRwd z2na}`$v>7y4frkt_9gP_{MB}Tz*1b8z5UHffOraCV~R1qHdQp7_GzITP|U_0IPLEd zB{+mxQ~?Sh&s6>D@g$kPY-5Iic)TEo^y*WJNF^A;Gl^q_x8|$b}3uUr2$nBgtsw$Bzp}h<%ON z810L!X5+GK*o?J$g(e)*9udIeiqF4UxT4yE<%c#e&wV2RPJ@`H*(B%j;iwS9>p7~9 z;Qtu`4H<&JX3r^QGP1lu7EIYHos|g#n{!``8ket))>|t+6u*a(?&3^;8l8*;T^*WS z@?t#Hf)2~*0%n7wzm$9-dkmj5-Z5(z*SBAEx0+(x z?^jGSbzL2xeG(Zae{Iy!(Eb44^&W`8mCRud`Sofnnr<-L%hPtuI|2FP-#M=eGK2Li z%FTV}?}*~{D9)&Xlz#F_v{L2(?t?V~{z;!NIFD}xw9N^svO75j^4-zxU*XJ7CxhI6 z)Gl)=2XA{5Zc%*|KiEmU+zE{v8zt(5wSl%cFJmwxk4ngXaI@_TdkHW@a~)d&NZo8w zKdgc$eznm(FzI2FyJLryeecMs{pnip25-p2)-^#rAxp&^au_C1*5bqmt)`I7dT_Ju zDf~sNj-c*LF8dL?F+3FJ?SnNN?fb)33ELHVH2Yu-jyF6i;b}bJq#zsKN>k;V>y-l? zU=jYoH#p*LgXNRyw1bu-dP+EqJEhmo$(=gY-M3Fmx|}su_+D<=izqZ*M#iD)ernN5 zhgXIsNbaJj3~V6rYB@?(Hyu8bWUeR|Xpkg`p-)|NB{hwD3r-aW3q3VBt~iGC96hh4M>qSf9iYjC>pQlqk}7RqxjkuFcQZ*3?1=o2psLJI-`mu;GLXqHMO zcHyM3n6N52wU$!kT~dw^GL)C^J)AwfE>Fug(stt|4~oWAOtc~j%+aUG&hKs8hj6~< z<9U|>ea6Nv!@vQ%s{eRC!eo=sllsc38M7|4=U`U{@a6RsZ)J46dGjnktR6qrv`{K0 z*Pm0p(HuEE<^JioU!wKtLk;GWt5B`cae+aGI|D8qflDait%yG` zj)-q?smLkU$=oU}_rA?L!;tgoYp;r2q;M6GrC9>{zb_if;-0v&tlgjEUo zu}sC@FF3)%iFvjvbNM8QDM+OuYG&@x+h422g7;x>3Bzx97iY?GEe& zmJm5dYi`d7^tK{OkiJmdt1$yp$*dDi+^hB*aTKv$iNWBx0mR`6`8Yz#3arg@M~Z55 z{)MK2g==weXa;3=5MmOu>jdOt_hd(07)BWbQ2a-FODI1B@^W$+&m_Rg_wS={y!ay| zz&x@^P#P^VeXIrRx<>kct5C@0p2Q@9Q>O5^4P!yD4%wMR4U+=5v%4G&A7{t5-Ngn^ zE@LRhzPVO$<9e;b^;u-1&w3{I0a$GZ$Dw7B$fpN#@OT$hi z5`mfz^WW6MMj1Rr4_Uou-?|UN1w)3|n4R_FK_mKFU_!-dbT;dY8L{0dzsiM&iUs&J zdN17Ez}`JT{p1`spR3Klnp4_Lg%nvT8EA&f_#;|?wyCIMko7{$2h%7%vys|3Fe*{gJji_!mRn(c9BOC)y9UW1{Ocp9i74J_cE1)1hL*uS%&= zNu+e}`{E1x4Gc+m82`f7jhmJY}GFfYD)m&7%_m~S+8Rm&_ z{l>HyQIjGO3FK03ulaKdA|mp=KRi(8*LwyhMD5b9@^P{a&6AG>+q|mJF>`Whn$Czc3q9>(`U5FSh!_{Esc7vtPebJW$ zQKlc6mg~^tDbX2c_P(M=Tmh!A6yvH3I!r0NdJVi4UqL1wX^OVEfMKjt!x>{o`*UAF ze^TF>>cT)8Tu)yTq_)IrX-q^B^|*#zimi^b??a)dm zn)~k5c@S9P3lbT>S4i`x0*2}vKIJY|2%6ydTD?siXcVM5g6K(XYAqzXCFUfgYbxG(-bh@uUH)B2H4xFhHVG-1Hbxf49+ZVcc!ZQUIa9qbZB z1t)^y%GyJGxS)XQ{9er~L4)AU52qiOTLZQyPGL^x!e9q3I=uHWriL21Fbh(|<52?M zX1A4j2z%|)<5b{T6}j4mvMwbLz@YJ7b9LXG13Y!v5SCLy=sCk;{4v*9N}Ti=HTcHY zaZjzO3L2j4VR>P@jOZN!%|w$}uo32j%R=~3Yg62+r#l+}!q7)d7Rm;E*`tbl6x^@U z?Ar9(fv+G@h{f}dygN`vy-td|zor+SSg>AI#&e-M0*njIKB}pnr3hcz#etsl>gH#k zKkDN#dSY*?PbbTRv-o?(m4ytHP~xl(W}}2bZ*)1>RvE@Mb!`G7b+M*Jpf|Ow_%>TS z;XL@RFIdTgb5eB19A_pa%$QXnUz<@pU;&m&0X)oOycCT}^;$3{@89LfC8rX{sfbiV zIcvTvV&L0$P0hkPUT@)q<*r2PnTsaokgL+)q4*N(5lc8s+Jy5!U2nZ7Krk6c)#4&= zbU49=GSYFNwu$)Jfdw&paStrH>$0jOW5qxj`h+)A`nqJ3ND{Pv8xcXhNBM4#Ow63b zn-=@TwBHv}bgF0xEeTYZoNEwU)TdBb!MT|a218_T3kvXPPM8u;z6kh`0594eZhZBL z@t;dU1tBW27i5$oaPZBQ20Uy3ne|&E$-l~-NnDdbk&{=@Sryw%DC)QK25jF<7y04VS5ph(V}@+~w+WYyy5$-5}6a~@aV2j`b+p7z}rAyBq_U<*!MCX}_GEvHQ6ZSf6A(m`92tMT>EdlXlgnOt!4as#v zLj>27t>fuud3NUlp@RB;jxoo#`Fr0HJUql2e)dxOZjRV4THYrzsH|YSuZTVQJ6Q_pV>pC793|s!p3ccuArixF<&B7GVfMmPea|F;y-vDvSy(b;rM8$mm4_B} zu|I(!k1=v`2JL;4a!jsIrT(er1~fh>EK>7%0Px($vW~Z2WkGk2kjAB|3ZO6D$34(yH>on5Y_^(9?qQTrRuY zj^F#;f#WdNWTfW>{rCMDrQ2QEvAeaU({xj>>Q)rsL%2zMo_8ZV)}*_b=7MhNh99X3 zJG6Uxxys;QZ#5O==Jk`2CJ6L!(@R*b$IFZWrBUjgp(t8n^cv)|@3;g_ELByAmKwDl%KI76Zc`7`Wa=MfNKm%JT{26B|XSOPFUpg$L>u??}u2t;1 z3U@h*s79->#=)ix`Nx{k$ebL3tDwh4nqOV?Y@)5bgau~%^l&Z^b@c!0XlxvzZu|=| zmgXxk@HU8KDz&%2egk?4;&4Gxnw?nk99^&j>;$)3C?a zhlERfw3;C5JhIU&&cUXuDC8!5T4cyL;>>$% z=(!W<#uQ2`b4|4sN;?cW4K;l3aNegbD_oyaRhP$Guvdr#Mn!e;FCzns7r%hxQwo1q z;ayVanQ5mIV?_47m|3Twu!a(%HRMR36o*$P%m?gO&u1LJz_89;R=&R})DlTYm7XS@ z=@E%JTRZ9REtU7LWzTzL;dkt!q$5A~LyR^$B|y0!#M z2+Scesk^R&tWiKz7peZ+GF&b3ds-MGAd?(&B`OI+(r~k=L?TN*xLa1j;(=ko_=vW~NCuI_vodP>zR5ROn|EaY`{{U5invsFiHfd;^SBs*T{UkX8JN+}(l(8v9r=Yc7=S4WW?q!ebW8MU-&yyk zTmwH$2jb@k^@A0})4+Y9k<~a(YHSCFf(Vr*eI}o zvqynZ#Iem4nHgE_%zF3vEXa%CV|7L`EBHrZ$Pg$ZDMZREEa`YoK-4kCh901;Sup=} zK73yeWUKlG287LS*lrP%jp;MPIBZ9{M3PAe;wVVJ7_bz6Aq(pTg$?nxYEv=-Vs9>!xZ(}?6G=4y|zpN!-7u} zfCuJ&g`_mQ`YDevw|Uc49+{_>PKC}63CHr$GSdz^QUGdMF@p>n9Uz3}U%Sd{irt$m zzn7huTGGNF;^(*3va4K8D*gu}fWtvq|KHfXfUPmWJpj_-%AiSbN zRi?!frwStTvzBYN(md&THowX_V}gIV1Ab;)$YmV_ON=f{fHx#0PzQuEs>&3>M5CAX zx9}qzwH)08qPl*qy=~#j$3T5?jjJ0N1xR>gQpKMC{w!t9(1nvFUS~K3h}eWE|18{R z1C^OVjowq_@mt*z0uB$YxC><jeu z;>Ik?H4bop9mdWthoDaw8OaHdEJb}$9k`f-eVBuKv``_!9LTQvng)b5F(~9guoBY( zsw;h{PZbFPIHh+$#inG2(7R$l{( zqu;pY6|oqY*H};(gD_6@%qInm`zGhCBxl-y1b3<^+EXh_ByB(9EK-7DM>bBC4u>Ja z7jto=mndX_<^$xTnmf^*3y`WGid>DBb)SvquheuDXzJo5_mK{683LHp_?jY9aGcj& zY8i3o1LZ~s7jozK4TP!)IH)hH!$rY}4nA1};FwRvM*d6ki{&f0Db9#>*bS|V$XQ1v z8JyT_aPvSEuC8Gu@2gK8)wyTInDxobhR7IH3@BMgp%TJZf6?{az4|N;gj9j zto5Y%j*by#awxYmU$48Nf9_Dtn+W%AtbL15^be51 zfnBm&4+ZcFCT935n$*z{o^T|2;W&vK?WYycvkg1RqCq0frCj!W#|(+Rnpwih(ZkJ>JVsRBfVW7;G>-!a%E%W~ zfNY7r*Nb>|q`buGH-ITBBM+9O0ho*m`LlnM-PZ4>GU*E9p9E+;5Yh8{ft)ZgDr1wj z*Tz|EzmSZW!cLAWH3OK2Gr6#fllA#gwUMxBdP1p^R5AN@DM^rYJqdI4YVZN8{Bhmv z0X0F2W3}V`{_q>MoXOm80rB%S)BmD$~$Zb|3?yFX^w@DOug1U+D;M*lM6tpvln(8%sJwCW2kSdFU9oppsU%` z80iC!3j`btPk6`Y^}4Am3E~gV5pf6&o;2W&BU2xweta-W2k8)_QscnT2jPHZ5QQQg z^zb41{>h}P*7eW&yp&)YPc){%frp6cryED)ak2Cr8*1rhN8YPfVhUMYe!LGH#)+g7 zByS8&ts39AF*+s+gBLqok%`I}iZpZ8$-REL>Qp#=WBUemV^jj;2t;oHNx$?NDyiYC zdqvTYA)3>0ugQhk$u9aPJDEU2BoLy-e^Zm^D@0S^w)JrSqaJR5U745^0R=TjIfUb# zD=%cj_kgeoo*DD)Koo~@ZV*inI!Y!|BsOAe00$qpE3(-P!K|9Y;qkIEOq_2W6A0NE z2}v_E4u_0<-KlqeyH_6k_T?7&+RSVuSmBEE!;~A+=!^Ob;r6=UyZiC10-|~T!u19> z#%=Eww}#|gM?Y1iAxr%wRa&36I12z@e{)>z>+_TxN-F4B6qFXst;D*w>5q;ZAHUa+ zryZe@iF0@z#12`%)bFwa$b}+A17ZU037{ewlyVh%gI1Bh+&V&*yL*~`_XCU|-^NoF@Z)hsdV!kExlV35b>HrN;sL4`IvKX=kw8m{-aCZ21%h1O-4h$eQS zjo%n+(?6%qRZT1yhl63mBDxf~)Xrbj?hX&rqF0POQ~5wYulzADrs-XhZTKUBT=+gHh+J>zugP7y)waL)~5+p?GPLSr%CqM(n$alh` z{#144++p0>n~T#G0Gv}6A^B=C=+|V$)~IfCE>C6GJIPY(Di$VcJjRI~Yd*Kj(75FD zi-^8FKzTwuxjm)Soq4 z*F~Ud$qaN=uQrE{zLACLhONihHxY*Pmd;U zB@`pB+A~kLtL^sDUT6*PyvAh@`%;h!%b~3NpGt9@@H4AuC(Au7M+dA_X=a;WHg>9| z(Dq|zl5M09>pqr)rOsTm%+=d^UGHPSQ4DXau-O#P;*9b}QWkh5W>`&&x zftL!mgh^07HP}eM_t6OM@+-M8y9aSlqS)LM=QT(`63BA$Op7zQuH0k$8p@f~# zWG8}Y%^2yauW$0Fdt6?Id$czk(XO(YEUiy^Tu7btbgk?GM|N1Yz)nJ`vG<7N6KqnC z>dVS_qs)FgGiBP;+)$9TNo&vv{5dZ$!y2-#&tyLWk$Du1h{RH*vpfhaRbon#Xg?zc z2Tgq}iH0&dX(ZL5kpaeJ0eE-@!?Yv9rfmA|KN#MGLEKlyNHXRgt@37Th#@NN9ht<0 zShFV8pf6B3Lh@Be4u$mR%iAt80X6COa1$uPFDn0vUVznM3S+QiF8(EM>~h(1A*RWx ziz-?y1#eWsg`7kC(2P!)CgXX)!iWq?+Nd|=K0b)g{|o$7^CSQNopk?$FjDb!Fr}9_ zvQl=jrI#aMVql;bvvhKHAz(tE=w{kin$ zy6Vq$zFJ~c&UGj3&eE}VC32Y!Ri)Xxp2|`_%=67+rgma_8r})zMd6r=(6re zbf_Z#orZVDgCM| ziAM*{Db~PAMf-iC(h*MQRAyN*c$$=2C?f=omvp=10zY?3$BxAdZ(6OY?xTD-;Z^`r zD896pjdUf2wX@Sr?McyEHBun#C-tN{Sw=R3!aItqLWCsn;(_kj&1Yb!P+yCL7@=}Y z*p}6Z3`|;6!ZvnbRos9$u|jtNkj0gCb*B47g#c+==<5=ol6w~qtigXQ1q(^{JXFf1{l662T2)sgaXD2{; zdPhdT_gLr;5R#_)T39+ZFobO*yhHCO97I?HqU6PdtWCr~EE1{y4gv)7{SbXa@ZlmT zf&?p=Bl*LWcOe8yu#_QaeNa3Bk?11XpGjdLjl=bSizsNq!4?j42J~v4}T=Tprjm;VTDMp$cRG0auTXA!aWGRgCMj8MvvT`nnB4|oRKM- zE=b3ZYtCq{)GHH7jXRAgq$ZvTZ#0zDdQt6-Y!c6SCpFP!8v!;g0EiA)6emKTOG zg)EhU8CqQ&@Q%Wm*v*ZKy*+nCy&6!Hol+vXg!DoHU~FK-;7aP2LZHVM0V{wc==7%- z2dxr8S>;-yF!m<-)RtilY6Of|f&HRTt4wbw7BMdO-6OI}CC><)EomfVNO^cAWO`h} zHljxxy&}L&#O2RY?@0JtwnwYTcPNtf^O`^{l0J(VL9u$1`iX5XV|PT3*Sbbxt-v-T z%CO=Ki1O7bQd#Qn-WZBgWQe$upQMY}nct`txMGP@k_VR}#BnEfPkLDpEEbF<&UpTb zJarXh>KBRWNhla`P)5aGlLbyOL{bQY#Gyx0o|Q@HC*hX@bvq9Jw2bNfB$C3XAx6c{VmMzPG5=$ zr+)bUm&(sII^}wmfPy}cKHl8csViOSdE9ce`$eMij8h!ITZ z9whiVJ^A`t)n|Us0)Rt3J6=bDl+l#3qH+-b-_AK-L-v8kb2UspW|Ds^SWU)#6hellhtQl!La?Vo7`rzGVhuOi$ zT%-$cT^5aW-C8HPD!)H2dp>mT{Jv0fBda2Y+NG~Ic-d*$bU?H5&y7-s9f6D+jy%Yo zxgC67g_QCQ^G3+tc`a& zRB7Uj^EX52$s=_zu~ zX0WcdSuLk?huPl_uNdtfU9%~M>D1H0&EyB*{mEitWSf5?6VskXZ;P^fn7P$#88EW$ zzi5-*A{jN2&krI8%+5Vtm&Q^*+1au4=HqGJa?OxWu=M+C@ZkBKwbnS7tKgw(uz_Xb ztnj%QoQWyxUu*gAG+RaSlA3GJi)D(@R$REDZ!K@%4<3t5wyfOe@r*L@e`eNS!pw!@ zbICM$BXxd6tXL)OG(hqM%+L*A7amlPEB9R@&A9-zeT9x7VHfAEt-Ng#Jom;g;Akan z*HNY8n0No6d+zL*on76;t->#rdE0}LdMY<}M5YdAF={64kFAN`p- z&K>6NRV&->j+XD6KhICo4}L&_o5p|{mN(pJ-x=q42c-g|PG99_n}#=-@5h{dY&H(h z+pgoTUwd1${ZGt(Pp zU4D-CA`ydv`I8AKpn4HW8&YLLiY@BT1E+JbgjWZ({Tgi#1Em$m`D^Y|F0d+-P&bu=gMn;uWyRFUwcR3<4D(q6btW*RTu%^u!5zqOnR0HBWBNqpZPLp^(kcee|0u%6MH(_4fA0 zTtVskI1{^%?ILbgRqW<)CQ58|Bz(T>%r^P>f>5B9DAi7pko0SC#&2M9=NTx8ghXXZOKZ~1 zV4bm9877j5YnlEZsqIiRmV7C;4@c5r`b*_)h@u4b5)N)G^pF4} z(b8O8TRt765QlMe<^ed=1@N2Dow=g+MOsq;Vwi42O_SJV{o?G%3!>l%j1B-dfeEdRzO0n#hWnR$DWfj*a!6l+C@|Xc& z&g91_E_)3fgi~dzxUP`0V28d`ZP)>LRE=BlCG_VId|SfGaEh{D0tgG!%4DeIW0c5U zTlu@YJu*{~Bqi&pTU`)5vL)3NQdUToq&`al5T-TGFUkVQFn4xt9_MVktK_}y2YX9z zhkP9{DP!NZmiwOA>~>mtL;u90(#RsH%GYTiEg)nNytV0HnC7_R0B=(9Le1DV(iePO zC?!KMLP`loz2a@_aiJdgdsbrl3?VTUTqXQ&*U&2^$FmW)}k95!>c>k zUs1{^h!8r5@AY#eSHaMQHS^|X+srVaBs$^8mVvDpb3RPyJdnuOx+$IsNy+m{v%XT= z!dC7k+o`uNLS+CVGH53 z{Nys+pcE?xnUwZ_!~2Zy^87n?#OM{a0706R9}R%UNqLK88WUsG7=1H|c+=gi+)4-2 zQf-90ogz&zn5S8c0m=vaZ<)JQB-5FfO4g6lF54HD^R)^OHtvJHirZzL@g>Ch{wS3_ zyAk|Tnb}b}(`OUhRRz1oKgJf47)13sLt7OhMD^9hyM4lFf%O%WgPX!RWfH&zBc?z^ zl6|Z~;oWq;lFCbip(RI7Tb2X})wYuhSLU?Kt!A^u052qG#9DI~hb>duv}0fg#GavL z);Y+ROAa(d(%|3F%Z2+VQVM}&bn=EPSZ9iM&(`CuQTfhV`4TGC*N#o))bqCQ=Cee$ZBOZx+#hx42!x!@efG z1?*?+cK2g~{WO*RT;X5V-4hau`cK0Ap_~RLsXu20m7Z>;)fc7a@g7r=d>iyzbG}aH zXy@DS9doi^%NCq1;W%UTV_fS={TS*r`f>LYti|iG`FP>&6)(Lpi8$DoiWy3m;e~ zd#64(gDDKW<`cQerHw|ppF0wo^GLh4#?{e8jQoA&Bt7K#K9I@ybY=6mTXIdYqK9-hKi|>ueQRlST0JiLa{oEnnw+|?hqj1%^uvvM8F3Eq zeYLU#<29aF3OsI$er^hC*}CkfGU0R)22wIyE^K&GOn*jRZf`90Ib30_v##AeRndcJRjHU09uA6jwG^$(oUjF+xoXdO9oXeBv_M~_@7$m}&l}|rx&Qw>$^}IWy)iWP; z7MLFvSq4nkaG@mkXI4Rf%bob}@5$(v4P%)9Mrtvhi&87oMu_bAQJ-K_Iosuh#=*M;vdHn#JV@W|Ug^P}#AHSHn=a=s9Qf z+%JA~pH4&_!-Z#7)vsnmAI61WhxYdqy+1%;!zJN=0!{ye`S|}KH#pfD{wHYqf4f{U zcqa#<5cQE-+gW4-&_oxB#OSYiDcIcAYiT)?dL*O2-{%rgXe}#S7s&(@L`f7^9NuTI zvArJr1koYCi=$%(^_w>Sp!3(D(eE{Y%1Y#&xHNWYE3_8moCwjXZD(Js3Oio7G{)k}Pg)VNd&O-~5N_v7>7ty3CFn=Dwj*=p2 zAfm^7X*Nzo77fk#{x}xH|ARK8a3f|!UfOQsK;T=~*5sxoZcP!EU`8Du-=?AZfo`(O z#gCa$SKM!zIDTZPiIGlFZVlv;#5ZJ7hazK%?}seE0ihI^-%B2UV6*8T%reU6ej1s!|~)c2mZU+*fQQk!_b4mATn(&*ujavoQp)1HSCPnJ?aL~uV3wY^DV$JVC z{wF=*(Hl35G6jFBLy&<0U4y4ooUzF z4taE1Tjx_PDO5Em@PpLKWw3uDoCmM~a+S1zlas_S32E{lmtm95V>Btj?D;`AmT4g2 zMtS3Ei758C5}C1{AA9iZu#c+Q9~W6d1zYZr1EIP) zhNt75X;=Hsq_A*fmnCsd5H?dv&ELfO5>7ZL&I;rS(LC0lK?0y0A3>gFd--o%#y=EV zz^rT{SQUTc)FgyPAY8JCSDO+lh=%t)oUZ;;#e4#EaXwV7kVsEl+CNB&cFm{I9z|=q zqwPQOeRUo=Qe0DI6kw7-&@>N&{8;Z^B8MkG;oOqDFh-ouE%haU9Z2(BzF9*R%V>a% zHu13q%%kNO;;p@IUC8?Cr~X=eSzu7_tq8EZ*=1y2S%$HTUf=S#;wVz3F#;5bTg0l$ z;qQ#tgeVL7-2UZ|o;#6DsNQdsaC&#jsbiC<7p}&*TFXAZTVQe$@LZdIVZyj`QD`4r zB`Nva2J#9xqYv18bw5>Xdo#(;hecMod(``p0JJgIej{AE$nt)Onj7e!J8URq<&+514&Ew#uQl&M5y$~M%=sU@a) z>zd#bP!Gf^V(ZXGFtHCr~5LDk~Hr|yWr`FD1YQpg67{|#^;MT;u+CVO{O}# ziLXsT#!Ewp5YChXF+IvhEd>Bu(p64nzt)Wz6SfM(xH#su*p6M+vTOC+dl|VMo`fGP zb__X;Z#mKo^GyqG^Q6X*q=ljgeeXiJSbLqZ(7$w{@qjc`!CjY)&kSSE?0s0cb8r*> zwXq`TM>Gqtuh-~boh0q(U63zXh#XlME@(t6F6a&c<=Ck#)fnIeTpf&C*=Atj;+QV^ z=p)WX6!ftmKB#`(I%^77-5_t3H_pE^U&MXe-}d(Q0%X5#)un#29z3w9{R_PuHYlqZ zIE>0&fp7Q9oqp-CS*O20f3?U;bQ}NgUX1=X7)1ruTR&4gGKV^(Cwy^U3_9X5=A1mN0u09%q|P9o^TIe@K&^+K0$diZBSB=8w)9!tbD ziWJLRr z+Sz1yr~Yg%f#X--Egu6_1sS=RNcwP+M!FF|PcsP7%iiT+<(eVm5MwUeG!9&uEXqz8 z(tJpcU>T&y4CR`Wq`StQ2>CSGhKVhLDL@!AA?_SZ8ubxnU`!snj&F&*EP;(eR=nI9 zxK&uvxe0~0@ppQ~9KA9hZbf|fJ-BDCY`|lPknC0vRS_BQX=#Mzwctn+Cy#vID#_?{BO1j> zUR;kwzk^WtW9Wxcrfq{kmv6pRLkuZDboeUJ&8TRXl#Z3JzI4G#*J6p@l|aT6Y)2!{ z^cZmvrf_b8)v3@D>0!hg%eY4JX!u98SaV4DFIt?;P&WgE-;7TyBNu1Sn}? zo=EIFZD+nik_+IT^9OF1W)c%h-8{V3&h^t|p)5fyi`6xVDU4ALOt zXtp=gg9#U04+zQdohYFAJ}%e><(CJBuFgV$LCQfm=z^EPK>$O_16TGTE5Vq%Bj*oI zQ7l0Twq*A5Q+};aj%Z9HGrhz2{dg(=<)B%srfQkz`R=_~b8{7Lg|x^q!$z$uR{^yx zcRh;AIL5HSRz_@2dIT8-d1vFhQ&#<=#D2H;LSz$>=15WjMO2hvQiGfk+L>n$5Lm#I zgT75ce;eJ#cn8F1rkaUvtC-p>S)PC}0tyZbgDB_)yZLXySM+LGTe~4Q(U%3ESa)4@ zn|i?eQEKP!00uY@FtADUExn%VTPbC0*cSgI)m`Cg@2qEgCFdzLz`m({0W%XFuGc`> z=H_0E?-DPE{uaH)mnK?io{VQgf>K1*MO*=YxkRX|K07eEIWS8hzddV3k54sCC8FMXfVqR_w9SdN-fv**Cm!i7dSJ=P4_k*OOqy{SzVG zAIH}8cfxte`||az?%}@X*rfmMND8hPD-sXKf?!EX&Ic5ZjO&qjssFaOKCKOzwT36^OBQ9K49lO$BkTrRL8mtp4=!q1I#AO+)JT0;47Yo}fc2Jd|9)i4E!(Nd@OtnXD<@N_EQ^K&FY;j5>ySB1>j2v=$g(!<7}gthH!w1cJ( zLxhnA;o=}@QtD#@<0ookt?wvUg#`L>^mvcdWu z>qY!=Ubg3)&71y1s`PITyqteE0N=j(6ADQVnnTK9 z7==-6M#h|tpPxhK=23OSe6@t1urDv$+I*aPb|-!2m?N%pqqir^r!IlRj$Ne0uRrjnq=kvAUb~Y-&$7zh3Wbe65ZQdUt#g^kZ_&* z`=`%-o3G|qF`hgCY|!J?0WLp~QrQwr(w6RUFAr;b%dV=d>rSakPz{Sxy(;og$R4Iv z`nn)3`qAyWU!Y3|aA`xV-h?@5Nd>TYa@X}`+t0r9Q(cv?oR-=VbVh9n4@ zaYNZ7JeV3J_*Y?mkW)l4b!9^J&}kK{6r39u{DrFr6yaU%BndDEQo9mvuyV8ZeG#Z( z7M;~j#t6Nb6e{lBkqq}2`}tb^AoW~@f`iQ3vDqmtJami>!6l6gBJoPb8L0bxLj$v# zErDCcRSb7u38t$eb@LsF%G>KPmvA+WZ{H z&prQdts}`gO1V|W)oy2HSjyr-%7R2HzPN`R+HPrq6&vh@JD>xwf%JO0-52GVf+Cb6_Z~rQT#vtdsu0r zSxDbEk}f2O?cLO51`KQUfuZ%-ge6*Hv*_{_EQv;SbZ>Ek^$f{OfZO-PxnSq7e$ZLm zw6}^u`<+DhZV)?ZMz?@=VFOGFnLuJk6iyDfnyDw5)TL@n#LSnOy=nlO^hQ8^ewO&3 zWaDaFSAaFFO>)v@j{H%5W-h|v)d$L@>k-1ka0nfLVsp+5*+0S5^NpxoBtiTfE$S#( z7Eh^0)?zf?k2b#i3}i^V5*eUJy+RvehxtUDxej3|H(+*yZO^uDnJVNX6B3}Lbl`E? zxw1KiIeR4L<7ndOC#xapUdHRmq+|=!BYFvlsshAxo>EP#5dmPYVKQV;pUAzvBk%&l zaz>}ampysFC;|!>A)2QGck8ee@sG7ku;!Uh<8=Ef)aZ`Dx53K6A4PfYeA?fR4geR} z9%%PwZXM96WfZkQ>VRNFW={Sf_ZQ~)- z@b#S5)m{L<5xxjszfTNWo@QrWH1LV`8t=cTvp5YL+UiS{+$ha{=)4I%OnQlXPfe)h(ou=8FHvtY&(1oFSI|0=$w(L zztxx)1?u&M9vmDqi&bg~;VN1eeuaPKjLe+=mc{u=i#@#1iExj@vlm!%2mOw{#_t;G zAq~=6nTNywgW#V`}!ei&eLl_(ZF9$YF1MZ%V#CF{sLGb6s1Tpj}`yNyF>DvB&lK%ydd2WFH zPk@H)ze#svV&P!_pG0r%zwLPS1ft)3eZ#A1qsv9gvAFDvh6>qH37G7gEgc^J?3}SMKuFcYKYg zvl5A@E-x+mi$0>9lp=jzTR+T(nHs;>m-EzPn2TA%+Z>laiP94qZ|Gxk1 z-;CaE4;S(twMzU|dL!rl40p?I;@QlDUv->yVZx}aM9+>2I#IzmOvx};LT)9}6q`L* zwgwH-NL0yRS0XWWrVHPq0XDX6ukQMM50W;O>}J37f0LYR8)Y7%s9}lvGe7^;#{F#f zIs+kuxL}p@sRm!)s$CN!i5`QZ1TrKq+o>y^rNVeAlbmxc>9ec7*lktOCG1<{=JwB| zT){@`c(gctigQt=zKeRH?aZq}2RoeJFz1`cC_PN4>us1ko8-!1 z2uT#GU1U^GLIz%g;A~6wGojg1PQ%b0BurPl)Fk97ytJj;ydvQeM=W|$R1RrK!t9o= zd|3mXIsMz*i<4Z28S{E|5Aw$Xh&gi|Y~Py77a{IeOSQh9?6>x{$FHK;0KXo!kL*M! zK{11}9-cePfKvqRsTmfk0GZK#B@&ro*Vgdd$2l##JzLfCgWkBX34RQc&UtT&x-I`}OGZbC+ z*=3^2{ehAGH*90{aFResq21duZE~c@liKTe`bzEClO!_lM)Z5^*4__yv7nUBPlvld zew#IhLL*t0CadJgS{?P7ON{y}n1z|)G%|aN>1qeacvr#4n7*m{CSIBq1S(W$u9mVT zk8xq)t1rQ-TMPth8O|JIY6@HqX3apo-9ydOyrr%j#Jw)iTGq1XaB>8ZGv^wA;ARWQ zx{0lGhvOHhxWQNAnmA()358+}JoXb)oJ*EF{afXpH=CfY`PA`F|1jz{i>^~*6q@A* zHNr2Z1TYt!kqvQzkwe3hKIU&{r@w_H-*<9ka=~3~h8$ zo2t`FPzI1iiI+atzwpU*XAtkJ^F@QT~;n<+hWDE>FAWF-Rk7XQ0e@wv-njg7M_w(WGOhKox0_{>;PE zDjuoZ>o1Q+DFmRK_}OE$)g(O{p(L03dJ6btXa$%iRWN0(Z$^_Amy@jPsS-#ZB=wms zC07Y;q(x&jTR38Z0UfO!G?it1vJXGom9vT0W?vp)jnR3q`brbjD5(nw*68W-)mR0} zYA^t=pm)iWck9q3ujbjQDXwH3099g7GjJzVRKSuvl%AxLa4)l)J_lvM-`^l{X(n^b zn+PboHcFG|gR)`%@CVvfT##)jjhFhMYM4DCHu!2tsRz_fISziQ7I1S@V;6jVAnpf@ zhq>C&5%0l{95t#3mVh%p3d|UR=nSG3r#K`X(JOIpBMjfLuV3yvY+15?UiluX_FBIyj~@q zewVB_y?YYGL$H%3j5V}1)xg_Lr8HeLI9*foF?}=o%BRBgk`d*&*pkWRl~-O|6}BgB zft&7X>=?m0kP>R(=y|^?Nol1~N>Mrp_|2db?L&% z<=U&Jy9%$2O8c1USO*!aLBbLZk%Y*~q`usg!TKYY%e`K8N8c%BX`lT`zTDcf0zNfo zyxQ5uISWNJ10GOGb|xsBGh20t(HQpj!vamdiUxRH?lO??es0(pI~jAbnae{j&eh0j zaB+(15*J!Uq6A873Ae#Cn%VIlR+MtrW}gm16iGqn+^?hb2)C^2BzBFdZPMjX86B=v zOr|v#05GbT1{kAtcK40q0haBaEN!!*Y`RRans!PQbkF0-2k&;zkP5-^wpoVu^~Xrm zN3SnMPp7wC7%he(YJiOluj~=2jpL+uTy8(zb(tGdZi!;>)Vu==@#AWEsij~4DocSj zs*=*C=wbuUx3;1GqO6#X4o836%smnO{DG;h6*ydt9S19*uVW75D9Bib;W2}}`~G}j z&}q>8klxSmy}2=l5-_mKa8MeWEU2NRuV{8f!^?C_i;bC1FnKy&kYknC{qE|d6o`g8 z`;&icmO13uca_lk@3f&67pE0N(@nDfhVS7To)XmPc!wpEym4 zs08Bab;WOtop7`dryRS&?`D?$8T%LYSX+a#R4%U^5%8}K05MnndJzxXl<=rIS6RZQ zQ-zsu;qMP@h$LB5$R|CV)!14<9DuDXC2{Efx>ukhRb9aA0Xuv34Lm;o$F7f$*3XUl zFL2M9P0)Wrf1Ljn`eSDJUu=J_rgZ%A|4qbrN8_|`9to##v}ev{O&~}&_)MDBj}o0q%D#P|>jG3XshsfgRTZW8qj@I^L{%J~Ej#Y0uh%pf}2()LxI`P zOS|RHW7Y$}#Yr~L`{Qy8FOfdj(LM~1)gM~fbp?*~+v=m`#iztrnR-6VTWq@-`onkL zEXYS(pGqMh#A}Q;_hnjZ?gT`6L!AK$L}QGF805i37@YI|hFYI$jtfQQl)RB{nnr5sO9#F^E?23TL*v6`CHo`trLJ{Y zX;`TlP;rGE>kunko_IiTD#7V)?1aR%3LIgyWWup=CRgY*3q^d3V&yDdk?LZn=%Ic6 zMFQQnw?mE@hA$abYz&QrHd!Y`9Asm-={!}I6Jx?bB)4rkhV1ZnBQA^*wWxg;JTLWJ zuNVm&D5OALnu4K)rB|?(oQ;ZO+=0EgYO+XfeXrmCg7BC|dGIcy`~X6a(rT#^A4fmH zzAnT}2SPlPQ2>)HuoZ36ox6a;Gwu7;jVim(Dx0rO9SUt`FzLi)f4dmBs(87MGRf** z{>?5axmjTQpX<>VPanl$KS8Y#URmsVD%(JIf_45`5tibEjj^?bJPCT`KVDyMQs z1{M@MMKSLno_JbWm+N|)f&qnwIw&jN4A!UxoH}iNso40w@-(?FBA3UgHCUO4581| z&D!f;z2Yp(R@&@N{4VsL9l*vH%7*8BP%Uybjh!}E+jd~QM3X&aL@`QS0#RbPqlTfnt)8;D87+j!$*bMr!&*+xWfzhp~6+5(P?@Fw3@W z+qQYiwr$(CZQHhOyXur}YtEgg=~?~IKVZLR#)_R0Ur1M@R~e_h;`ob>N}#m3+Z+Lp zDVW%|n z6aQ?gWm0AJ<*NxHuK7bW3>e8uZtFV1ikFPTdGoq|Z11vC4}s!n z3}uEqA>Y6h!--J$KY`8BG8x_qhpxW-fP;*9L4+03-gotP(VmDV}R(=y9G4*5bS+7F+W|e{s&njl$>qQFFybWP%h0 zcurOVY+#u^JH?8EFQsEji&Uw*y)xkB1z8>ig)1-fj@$e^kSzW9CfboScrH?Eyn@SN zfK)R3_6iT_A83u`7T20%zEY_MTbq+^w!_y^h%`{t!PayEyb}E`sKTebHGMtf6f$P& zBm+s@LHZUHrLZGc=&{CA0(A-Nl1u59$!ISvM$4&Wt=A@)jbuWuQTy>ZdjPcRjG9J zk~gMs`i)}I8%^|13NRq(vVP&q$Qa{B7!s`v`)t{&tj|71q9GA-JO&YcOQ*O+0{0ryAh&S$o<89&O>an6`|Iv0AzhB0VKK4B6 zy}^@@Lpi)Svnp}ejYQWsoSmI7jcLrp_@nCc#F_ zlP}4WJe?dHizPO8lw2)yD)!@J`J6}jiFO-gR}KJG!B}O)ue8eOo7K=mLmt=85q*K? zk`XEXA@Bj>S3AG*C$=|AQV}w-Iu$2bwN*Q{x@PpVFSq~wOIs#S&1kzn0ow$77ww$S zSqt>MKHF>kdCJUC8K9?L8LZFs9JWm-l|62NWRlY9ZOJTzInW&>H8p#C?V$(&JdQkc81voZfodgL~zWc&&y1X~9UGo}HMv1WnhA zR2)<@^0U!6lN1Ou?-p3qMmp<)sv3n^yOls`rM6L<$SWGciGL@kSJ9yVRVY72vMemb+zJynXv7hbPERiZLrD}Nm@G9dd=b@pioJFFO(&r_r z@S5q{)9t>lOG`~CR)AE=pDq2=>-X^Qu0K549g2&tbt-oFLT;cAsdH9X#lJ)OTp64TC>GU$l>!we3n^lYn5|4pYfkn z>QgADTk2*jokSMaM|hfrJI2fS13>yFPTi7|qMKtGCriBx)!z5z4`u&oV{^dpykMhj z>fDbopoXgPLw~)rzrE`Hz~kr08vhpw#r!{!?im>wS^vX8Q`@uKVnguV(<=~%Ojo~W zPvLFRVRFWRa&~=PeEKJ$l>Kcu3%fnm`TL3_CKQFHWN}IS<%Z9@4tIR;E6x}P6~O#B z5fy zlNa09YqIaR#^z?-^=#T!W;bbmidekbKCDuTMMkEERBw@p4ogLSoWgACVGOtCEzn6# zI2F@d8aM{;#uAgEk@oPSu6>JO{iX2KtX{d7V%luuJ`K$#EzNj-%&jz%4I@BGXzu`^ zk*pi`+uloa8iHjJ5ZT%EP}ys+?`^G*Ofwrf-)wTWwY~YG<-&!uq4Y!!8&8;4$9x8x z+=-kf5)iig+H2XeCdEF%TYBZ!aT2rx2@%~?x};IADqJ^E=uZ2PXAcYMqDI8R7LhrT zG}3k$lS2iRnQrY5anI%nRZt*f3j#2aJTBev_s9il0?W_9F4ANzGRb4+w|uynRdkkr zJ6YEOFJ1Km?|ChultKvOtdQ&n*ubwN+iNebp$++rHA061NCOU1Pl2;aE1w@zLxQ{* z(6`4zCp@2K9nWMo^vA{!aKK9MYlo1v^fAnr?FPuSZ}7BVTK^QBOQl#hgqc9WW2ST5 z)<+#HVn5>WKHE~x0H(GV(Bs3koRa>=?Q&SHE^cqdI>~S7QjWH~D!)%Hnn|F>!*XI> z#_AUkodBoqjZGE8u>v;>%+F3y2|!2^RZE1ST!Dxuj!Q~Og&6|7+hhzAWl%1a#Uvhzw$;hVb>h#lORR zhY@>8M{z)LXgHj5OWw&z6AcGN-z;yilJ^-`D>3RK7M4#KK+~7_mI@@5aBpDEJ@iNR zZ`nD*X({H=SHoHwFgQ2frL^arR7;Zed|Xv?fPlq0vO?2H@~N`qzr6EQ@j#KRWKip7 zzMPIJxf0joD2wRM{!(XN1a^oqX2Dsaw;Q9N|DgxIF7(7CgWJMyzbh%B&`uSXSNu8Wr7|>x}L> zuv)ctznTy|bJ$4!`r#I~XtZ;uN{vo30a1a3?ghH1TAxio<8pI0Vh2bs-n_ zq?}z*Kku{l6!;OX8)1e)=HrB?ZzqLCeZ-iMZ%GQJ`+4DPvQLhfyj=yLE?}JsrAQfjKCVS`sPxg}9e-q-B~a=2qs-K^{LaKe5R71@$&uu0u7V0+&Gnh>$U1pvapZlOX4o zk9Iu?to~WAf6CeRi{Z>pb0nE_)1Ms7#_vA%Auepz*yGmenfiIZM*)Ks_<@Qf1Y924 zFAT0cUya`aSrqY`Z$EEZNrP3Z_tspE98%<+BeWYF`}nRekSWW6vA6Pcv_{_CT#a^n z29wb3dBo!?UsAn=D9m&+IywwpI`~LW{M6Z^nrA%}aF|n2l8%L!ME2BdB0cDuK}v?*fEPP~6>+vmuU24kX-C(cwY&Px?TiPwxl52xCa7F*~@PO)D25qxx7VZ|ZO z-&PvHCol>%IH-Xpfwf^mPG~cncI_4b9*VQazaP%B;>b_1YW<~!A`qyEj8eqVF0YA! zb=V#hJfB zyoCGhdM>uX;>Syj7Q_H)kYcY=zmquYn+sLQ zEBJR0B1-TR7U%?U>Tbms2NwiQ_;R;DpIbvYlJZ_#dg3f(9{nYVfjp5kJRQu~9EA;Y zSdc>nIp}V4nOS)1;alu6x)daJeKg{oaQ9{Y_)?6q&ujIbCfvT?LHWaOzLJzbm8uroO9G_>+HO-C}9-vKmW zaN#cPo6*DyI383&kC1!?qn2`-4*?vREWWPf)@5riVhDV5?-Brg>V?*eE{+s3gNC__ zOj0hCAVhv|wKd;z-yOD}?bXeJDVjk{N9K+i=*cO??8}qsSOM+#v~<}x7#3LPO1u7P z`-FaE;og6$eIOOZr-3C$7|mc+As9It_?zJ!TnX|X zPE!n8{#>fGYn&X^>U2y>RQ$Xt6+K+c+n%v*2;Yn}hqtKihYO#_vmVcVyr@AUs`OX) z2lbl<4jPdgUe&&Lo=NyV{-3k^^e_#yAzK`u@0T?8FoIYky;f96{_gLTV7so%7Apm` zAGv4yqJ`T|;eMyS?Al7+yJ>t@%l<_gnr?z)g9Ip8S}zwa5SZ8GlxokO*b$oPron7q zRo6C5FhXO;A@M_zphPLrv`(G9c|QmUVx+WE+QCE(6tZr$ z(i41_Jo2hte9K7t1`Col_NH|vr;9jlTzs5jqPg3H!aRub;hidMn!>&aFd2R zUiBo{8D5-V#s(!X2@EWt%FK~5_INHaA62ZUXYv7qKU6=&1a!z5ERDO6k$;zyfV zntI2tE^j=muvfsbI|q!xIONKaLoIE;@oZQf@#Ancn3!}?wa@EWvl%wIg1EpCv>7hwAD4?=+&Bc5u-ESb(&@XOs^jTSF&Xh zS_7Pmc^CdM0ho6{(D6A>R+pVv76xl>MkzNzRPr&;5@!apvG=**Nng=wPmY4ldKN(F zFYU!!Bn_?MJi-jG?Jr7qHP9Wq{J*fp5OLXcFLuSi;|4iEF>;DKa(&C^l>D7CP-EYUI2E#y&W_}31P?Zm2 zcj4Hko%9>8@D&p{p<`UcGyHxRZz6%VlocWn##vkQ>v4J6t#Hi9h{h0?HlX+RU5FH< z#2q?Ye8DJYONzTl>-KwKxEEO1fT8p|m*;yVeS6p{K9x3XIRT6ejle z1#}+Sg-DGSfSZYW?HU^>FwPRmSS8G6SCG{Lvw%n2YPQGyO8lv$B%U4NFZTG zR3VPuIuIDhqEZbp!63vIx}}&BUQUu4Y+Wm`hK=g#$wmHX)R#(JWy7(Q`6QN?nL){V zM!5p{dJ9&p_YDR@7SPlp{2R--WIg#*e8zO%l?}0Xp+r8@3b9vkDg;DC!D$E!D8y+A z*CpO~1I%V)g3#_^`t|^OmQbfygTk$PNnWCGNjKaI?2n3<26d1eq%C9{(?_bq$o9<@ za;)IwoWFUV1V=9Y?Hpkh!ht-|V1aQIU3jehn;~S{#V$a8y!|#AC(1ZG1>wORrIwPR zgU_0+>CR}N|e0L8qWz6?*?x zYcaYAM$dq)PCW?RK-AxI6_f0b7rv^S)D0j_luIWWM*KRz{e|%#e!!f2R*|ytr;NY? zTdv-s!KXl$QuA_^xvm{_?;f&R+OO9`S{1rQ98t)WBjPJC>E8&u4!d4TuFRp|#{DD| zpqc$FZ_8qUoe(@m!Fx?&a%@#;Egwza>KimAgGz<&&z8%6VDUwm2g9_uoaY zk7mCBC8($J|7C-*{7)1}MozZ>-v*njJ7huVeN+?qnQ8*^@&eJ?tvTh2Xkh(8wv=;y)MORCpLLbnGM za!w;fjmKl1yj!N-IE5-HY^UzrZR~?*!yrkLQt8_>iLzvo{aN`iTI$kPJg@h%D~4jx z;!GJ0Jml=nSTsl(X+PV6>9P?a*d!cUkB1JaDxRXKmx1**Fdq(Lpt#&#s+u{cO z$8py<-%3p`b$W-M4Xg|2dNxX48Zl#>bxJzPcwYi;QC_vnE4pHdlzMXU68pOKwvfo9 zHhsE8uZ=sYIvRVzenfGh0`GTx_gH(w6@AGZ2BTcBav_oWqaj0ekXiSr8f1DNZToLf z&WoG%F%t-22+Sc$lxj(ayr7d4R~uR&-^$q=40~X~r7HufQlf)Gy_C6t+DI}QNacw= zW;OWz-mw)H;IfGSri41QyW&13!yxU}D&KD0ejrmz)P7fr+>G;=xVs3nYB&&reH9NUHB?1}o#=K+ftD+WfWir#y( zW=Wb9cUQ}yIy`>QAm3ZLO;JTZ^+>yLIUolrAU>vMhE7fR6`9_5DWEhUiUt2we2jf~ z=Y51k;aw+aS_Ie_p2uHEyZBc$ps! zEhLA*4|GN7zh@5v(m7zzI1NU#vGopzY(Mr-{uW%$-aaL9-}8Bfd{e)DO{1)00jNH2 zFFsp|dSb3}>;h}!bB?M5LTJD9psS=w{X%(sX|$D`ikd5jR`e3Pd(Yf?PMYQzdM@bH zFHmpZUmP3OJX^Fs0-S%^GM4ZahC2*3D+GA6(v4>cO@Qfr%eSU{9QFYKNuR_vGed)! z>dj%j!-OE8XRgu0sBo`#;ew)+&L1I7@fSSszqc7P7qx{jg1c)hrey1iO7j;%K5Nxe z`vY7)gKt}uxE8lluC`rq-sQ&5#PStUn3n4UsHnfxZvVzsK#itophbJq2~rOTG3W$> zYvd|fcwuE)G%kR|M^a8Cd7Q67KL!BN)cx)lVTx~ja{b)Avc7Wald;alG&4{#^P%EC8 zU?Z8}q4>?cThx`e7(SG0>R@~rW-D7@!}1zxF9!k+Ve6K`$Hr3WwNIm?8pT#YkOS_& zj;P;*?@dmFun38t9cMbjP}Zoqi`MsRGhp6b=q))WGJJ27H8xlc@y0UyZI5wB ze;Jy2!tjJi3-lSs^|Qt-<8$tl{`;X#qcV(Z_pwFidJGE*8W&}j3JB;u1B^|>Rp0_R zA2qZ94Y`mtN)5?0Jjv!W*V^4_h3$OibU)05!pjZizmlEeL}M80pn7qNU3$Qy3j%ZK zaM-EF&cT8&pEhDjBaUQW9{_)&-T&yND(DF8S7YU{Bui)gs@`qC|K!kw?BY?|Y5+Kb zivj09^jOH^QE6^iUwgcTP0Cy4@MU`?Je!D8Lu6m#4K~sh`rbDl5U-8o(x5%CA9G0hlb9fIol(iYqCfb1x+P zJx@)&8i){Z7d6n^$8s}Fl5f+oM&_T~4O2Tr6$KF2fk9s)RCU=OmepyY0P-yExlp*@ zxT(X{&+b^6?;2ITfKy$O>OKn31Lbc7<4bzd0tJHxEm# z)s@#+F&BDb4})HW*gB-Qv?JMG*zU=xjUK&fSRbFXy@KI_3Dmsm4vEe?IMgA17_xTF z`NNxYh`1MS^ZIa{SDGm|b@Jk^D@4TATm!fAa3T<1qsK-s9I?A6PoA7g-L+dH%rAJ^ z+NpFWEaTeADbG?OaO^nc3yvUG^TZV0gwcXf6qNpj%&05hnmBxV)o0q}o^l-|YTAf2 z2-`0ev%qVmYnH|npDOj*pN z0zilbAjzIDfiMQzC+a{kv`;_!w*Xh2jJ`g%^&WdPayEPG@Gi_Y*REGrvsi8Z=zOkk z9Ht0Bmm*|NOamxITI}Du2bc$TQ%S+Kce_(YuJOJXWquYJP)Ty8Ys{O8Z~f-lGS&90 z4Wc*gFK{vwijC_nytcKvH4}vs)ez*jjny}PBY|h5%b?zmd%o6-px8eU!E>k}&sJG! zw)esls%>yBa=n{7Zx!gFWv4}=VniTs;P2G`;xqY04xcyJbrC~u=e3Ow0=fa6{n}7| zF%y`nhkwpgihB;Yku^V_lY@z%D?BOLw9%0k60Tab2}GHJ7N@_Fz8wr6;1r5p`ai6! znz=o4%m?@vd%A4O$X3XM#dAPXO2MUbZ;x z=>NSkEQc6@At4qTWooo1GG0%FED$tHbdcx>|6EoX0-)=$F9lgJMu7#=PJOSu-%vgw zGgitt6}$%EQX;sr9==D6Y`6IuT_A7jjK$r)bvrxm;Mx}$Zc zPyrV02Lse)1)g0|p7BF@o*ALcTfDhjEO-JlPXk%ePhN{XKI#+Y08(KVre`>f86~^Y zhQeURapXIoJDm@g;hv6!Ri&P(aeZ&xgvdxNS|aR4JM1NNnm^dMr^MD2y|q}eWwXTq zf9bQg<`T`rD{wd1QP)zcv`0ysiJClvAtBcESAJyHlE=ng+;Oe7X@_~BA6n&Ukbu8^ zqLEOL&7yav%Fw&fyf@HfBio~)|7#8f=NXf=wLdCQNc*h8@YPw)8D6pq@F5KBKL0bZR!B^GRa))C^ZR&QYcm&2RB=Mz@Oe$-73AwajUj zblA1Y3(q}`QM`RAp*-yO8A5K{KJz}blRdwfigFq}Ci=zGysPa8sK=_+rabiKn*|bt z^gApRA-Y{1GE^p;(5~CH!@0;A&|~476DD)`s5GQmc!u>ys5Q}??Ic)C5*09ADpeZ= zO7{4Bi3zb54de;;3wxUD#M62MkBWRLZxtGT{23)mIkX)1D@uQSfG~r7#%HP-7AzmV zQ9TDuI6@~qVKi0TyeI)g{!+o?HG3_47AYzL5^BL;qN`*+eCa*C zgyO)^-hz>Z5mbfJlp;{9372MHNq~MPb7aJN#lKBfuo?v#ep}$>7k(ZA3xD;5Gj!L=M#_D zw3SS;=(6rYM40_>VBHT+EBfG34B)w^q<-%P`_Q>+LNwzt5Bhd02(L`^Y6h|Oyl(5~ z$qjJp^q~J-EF)*6)(+op`fnbPB-*hgXZ`vqt&jcEGbC&3KSq>HOQvG#zGW|X3#e4 zC3WKYbD!Lr{OW#cpE<5+LILC>#q5uX9#-BeTw=86I-7(h?r!U{)5P-czdyDvkJy~(#KKe~D zSDS<{H5~FRN@dS4rDscmfb}#+>ejR+c>RYSdXdJ%u4zAx-M|Jl#wB(dbgP|C$#UHKAhjU8;h=5b`j{DdxWQOSV2gj# zoQ_)pDA?%`h?uJp8d?TyQNA4}C@_&t7wfn1gd?mtMD-hgP4hhAuooClD zp$%->oOZnT*SOjH+C$&x##|iE7lyRG9N55YN?sx};m3P}1>LffbOdl?*x3uf7A~hg zxTWRrTH&8i47y6nwyV$S>y1r+00c{#CDP+P`Cbzr^igCIv z8ixd&QD@OSvi;~;W!bAuv*4Im|^fZO_U0=pd?b1i*YTQ9_C@a*=C+g7n~V32C%2^ zVbOIL=x#E0E;Vck2qPUVf5^HK7tH79^p6|EHOl^c|BjnIv0v4yMWJkKb$q z+xL%s_S5nc?tQI{%`%F>dIuAz&WTKXB9pi}l9WK+oy&x(pH5JqnqA-L)Mp$5wN!QO zDy!b}kngb8b*JfNJ-U}%WP%J0CxBYZEZD3Ak*FLu!9ODnjjZ=yge-?fC_RxvZuvG zR*>xSMwi>sqaLwob8wDQQ!eoGt*P!-c2WT&XdXGu-Jk=4|8gr8`}BVI!FmO=9C&M) z5-RngFkY!xF#wm>y+Bq1e{<1IOCEoxg|&+^@59^t=0@jx?Amud6VN4|+0@Dp(lfAf zb^&l>oxXz8Ame-cwrH7#xBb?E3pL3EEjgaW{$92 z3RNqwul|QUm2o0lP!SZ0$VwHdluiqO=5$CCO@9{g!akC)KS^<3$zVv>xebM%4MRBFBL<}V6--c1gzRJ}NY0vo1#?_5H@nX3=g)bbc*fNcPAz-lRG`K+7Z4CK((?PEei(Mekhu3}JF^E7~~kNo}aUJd)lKD;puq`{RJZdwnK+nQrrh>TxBKz6-d>L6d27h}Zblo>7)d+Y`P4-T@So4GeoTGdx;n@f(q1Sg+e8a&LbHXuWl@{={uO zb~?+0jce~*4s=aU+I$iLYg($yxqPTI{3xbL+c_^@Z{RN8-m@1FSFbfc&$#0Y{>5Vl zi1+x#SqRvSbCgH3t*%J>fufgM7?Z(HO-f-eHKNO#OzT_AL6z?+EFOl!D0+^o`(DWP zRiV}xJlNa_Mu4cAjb=}KUJlAF$Q;``r{aCVB6Nm+mV#v`f4KZ|aW` z00fOzHGxdHF+?CEivD#Tp+4yT#b@ML%aj2bsrKJ+^=64+f__d9oEAejq%^DK9g0aoGX!qCnIKD9UhQ&{DVa&TlGjKC-(&OTyZpJ?fEd_Pv_E| z3K7&6^dfPUGNc1jtgxW2TW|rBx}`(IsME>z`=1NWah?wU7OID1Ti;Laa?-9RYd{(* zQ-x4L{*u|aQp{f|#6*#Xkzk8$m>C19ghXeD{Wv|+48=cUbsQA=?=p;>cNHWwRrIs+ z09-4;8J=@KucAe*ml2U(aj6`~N=o$NMm`O!xsT37l5`IR0>wk7&sIx6u@wrSP z#ycY`7tpN}u~Ls&&+ysMuh-}srrc*4e$xU3{bY^1%l$$~N@$9-pJmZaCusjnm3xEFp*Vq+~g3+yrI1QF`_Lmc^@xbZoo5&Le z7XPf<-k19yD1GaSiXf_s>~L(6mw8S9G@}LQdeJK61aET4oiuX9Bo!V?fl37F0U#Q) z%89s1Y?71M6YL8;P_UTEhb!If8i{`OEdR}Cpj)Hd2D+9)3YltpJGF)eHDF=qLo?t4 zxlEwJl5lea{2K~*)AK?gThk3;F`o#>B?(A4b{#!G#Z7{|_!)J{cxofhyB2dD<-5 zUExA{S?uaKdDOokK&(QcKvvZ2Cw)bZx_9z` zzqb+S=eX+H;W;d8rOj?Q^0azdy0>$q#=YThVoIg@&h{_!zvHT3m&YL~iGk{rJ61lQ z@0;(fXECV^l`^l+x5qBO`4RlA!v@ZSmdPK-v)QL7xfxI5NNX?7&Lz$D>enV)khW@s zW6L6`e|ai$za~24)#kgL@h0C}uCO$oF6Wh?OWlK*!BZA}H%^<+AU%Z9>`EgHpR9M( zUY{be$&EnF`P^g9*C>^mt&jj_Y6gwU6;q5iD%KnWP4u;i8#o_Fx`|>ca;JcB-Ld3w z(x#A}Kby2OmKh6%ESJ}rG>+QPz@r!Ea8FLO8O3&kcFjA&JKHL(yf{}9pN3LoEgCig zuC?D!uQzO`7tZ~Hb>>Q2P^FgVoqK9!`$)~NF6;M|wfsv_3_)G+7iSfl_BKI&vcVbW zw9={K{KgAWEK@zrp_FeUYPa_9ie@qBj1BpU)yob8wcz5ln=L0B-v?%=eu8I>?usb6 zR;m<;CmhbrhL^sbIGXc|d(VQg+;*_y>^sNaFR!v&U0%(mbWL5-a&}cpivnQU>~tP@poVOv(AokUpW|yb<(m?pFs7I%>X`jtb zCjloqK!lE*cJzHAxr08?>JsYgQ6sTuyJ4!+0AU2afkP+g^gZ9Zy0e)M8}nD<&1Ks) zyARVPJiM3WKVL@ZB)!Unr2TC(v3KQ`_@xtOrvEzJOpgE{(zxyG4;NRRFpGY=7=&WQ zt&8a}InIYsZJTDF38F)vT(VS7ng14|aebb&8NhMp7R}ph1gm)KO4ESgnHf6={uY-m z5W4{(7n23Z3`UjD`T2o+kTAv}xMPC(_*dVTM1)#Q4>N6J^vfx`YPRRcrB((iy1TkoQKnT$|RX^DZE zhzJf1!KrddW}|&)SoI_wU4_BU_>SxF8g7ThcPC2>Id{MIDBF(lM&^DQ-iG}iuD$ss zMK>crchD4xH$7hR4%D%Yl8x#a$SGH?oyvS`ah) zN>NEG`mASg6I%E>(>Yvta8|^{G1nBBc~QA$L2g8K8utXCNrHBW;fTEk46;8f5@;2% zpE)iZKMkgu?R-y!|Gx0ZyNzrrhyq?p2Ev%zoC-y90W=d^LZPcf8L0-haNkQTh`uj& zgi|loH%)i;8x4&r6gzGVb3a5!GytJN9+D^W!lBzp80G1}&eKEW!yJ2GKm@+>2YBCk zsOg9g1yXiwe~nf|3XlSu_W(h4$OlFOy#t*PfDd5Ml>@fJ`6P1xMaq|UcVgRJjIVX% zQ+=kmb-i)yzDq$WY4wY;rr-)&%?B#K{KCtP=k@HxeJdLw{VPf*j-gZp68V-IKx(ex zyQ&ke2=c;Srrfdf#@?+Q5MGBJPiP#jIu4t)Y-8Z-h~5|W)@|55OTmVY*A^_yT!^f2 z3z2FFH?i!K<(ksRiv%Be3*&`#6UsLQjHmqO2%v4}^f1S*i)-UlfINyy2{mNt z7E<11SSzi1EXG7rK`e^G0^x?p zQ_1MYiiw!4GHc)!l)%H|ob5+JAbgkfH6Td~YkYbgZF2|-sJ0v|ZB>W_Q{-_teH>9m zvBU=>1M{U4jjKEO$M2=ZWXpHe0!#sWFnd%DkF{#1V+UD-X$Kjl7(`3dR4hiw@)TSCG-0!VT>f_Yr0~Ef@{X*8h69N|e~o2#aTJ<;NAKK^K?dp2U&C*{E;cEB!Ru#;AN(coD?buNY)r(SL&n4a ztD`ehCIP_ks)j58fuRwG(t}qL$BRG#vN6QE&})hfO4=V|JEwPqmaT9_EnTHm)(M{L zrp$RzKJauw%IdEM0W-#hcDj3-ae2*mgjaUgYN20q8;5Skdb9$y0!HZDn#$9|BY59D zzG=*!o8*7f?x^daMYE#2Sn@4VmF1Y(1pZnrU07@m4d| zaAKu`=W>Jw(G_j`TG@LwUE`up!!{S3{sOa@Ozn88@}W+AMHyIK-)2c~6Zt!3wBYuP z=mCe{kRyUw!+TM7bZVY&Kpeq>N-Q(qNY)#NXYZF%0vQJ!BZt(CWu_);RLopCe7T*t z6n4S0>H8Cc5aHSKrzCj-zp`PFo2g=xme+Hq#Y&gNXb<-uOb#!0C-d@X=mS5_PgAm# zi54n9#>|mydj}s6BXKf-3F*&Jt#WFH!Q!%qTE0Zo4A|RdX&Ibvrt#KQ?h?EY^X4rNW{bQ%ArqSOLe5$wX+OtT&1fyY zVYKAYHFkSYHh&V%itARi?3(HrhnZ;UE*{F{IJr}>@eYbh^j_KN!nh|i{hWV0ADLFL-g^Hoy_jZ4 zUHsP3;v*y;o_a4nA$6m-fM@~ilG&hTLA=CiU1m$P<2yxW)tuq8=-UZ>k z-BEJ@zs#^1V+~)@#trAO8Z}}HJmn61Vun^BBjH_1(6ou#+du7##RU*{p=M-ec@@N? z>VU3rKY*eKS28wR0T9aEl}I?49E*bux8dS80~qT>^ndBbCXV$}f;#rV;bS`qf;iMh zc+?XJ)iU(&=cX8t_~q!hwKaj6n4dSnbxSDI!@Tky>>g~lyVsj{Nn+V$MZ9!;D( zX4MAMEMdJ1G~25^tiH5824A;_7%r8|=ZuVRdP)8YI6)4HI-41N8<#vf)3X zam&?9jmty+8GX(-Ha2YpGF(a#?g_6Mke;8fw?^PVx6^kS(wo?cP_#FUrex3orTpHY zMp-U6Jx3m+8;S#QbTffA))K`9mV>-$({~%eAdDJq5X2&YooyftKMk)d1whDymzU$Dhkb*~r*LQVt%5EIh&cQ*B;bASno)%U-O$eLij zwkmZ@Mm#ud+PSt+;2!?Rp1KPy-7e+*Bo@6~5k-?wf2fuKT?Yp#A=9WZ(I&Q0X=6|m zG=U-dFSUYdx>oJd5kg)$V+ea_(%rm)MgG!|1PsJ-56ZqAVh*UTz+o6L=ILW5ePHnf zNZ^b~00;|tJ3R+wfwB}F2`sxu{szf!8Zg5KPBZP+ymgRm+C|{obGJa?d&qt0-5jX< zM}_2uASm$K>giJ{MgmtN29nZtqdE9I-NA5`!~Qe5rL7&(LvVetEHCexewWhlomn`71KWg#Exu z&gv!5s}3bfCZr&s>+y4Cf(iU?EYBTqK@KRS4-8RMKHPc~7rXl(C&tVR7j^9oz}NyROfUlod*w{Kp5K_Qe zo8sgs%{f7QPEc~OLGmwd-A}e$(9I);Pzn)>t1v{I@?3o5>GQNKtUHxfSF>@jT-9B- zkwktQVyKH+B2F9;i||q%zyrxHNx2`oL8Na-XU}oi^syuckxQQbIcUQ3I^xW3%Ug z=H`ni3&Qkyrz~-2%l0z4_-|P`fE%Aj#*pL(?QYExW@jdT$bw;_qBF6kvCV>Al=YS` z;{FU>+(NUI~B-=FBOX7WXGD`rYlG zv!B7Qq}2TFJw4sp^YH1^tBEq@1Bzg-q>j=6G|j4vTH%#$HD%INk=K8uYu&bMxH478 z9G_nQSB8i+bH;AiuJ(jfmOGl=w^Cuq3J8cfwo>Zg$FD5 z9bI906e?|)*iyiE6&lUIOjtOKW+G|wu{ZW6aCaFwb7ca@*NKpG zD9TeYlW*INe%~NW;ZhReSu&@4+uWxo8J1EvN*JZ1TW?C*y)u*~zdL~Nv&#bc3(~tv zGb8}m=}mQB(|>yX?8TLivd5Np{a*1!ehB{?B8v5Y1cd%)0kB2WGk&uj^|vp7&>|o% zr@G^y#8?|;oQ!(}Et*BtTpPs^%EH8}dN2(~G7oqSe)sk5UkUJU6Wj(7pva?#&)BVQ z&U!j#{>WYYoD$&gp=L+6uRrtWi`KNq^aICfQ}%O=IWwJRZR7gPg)&KdmVfX2qm0DB zg36#}j_>EbJ^w7a(qwtLI?LN)c)sOb?fP{V))>`C#l;KDXKyCG2wG}*ZpA54te3Pa zp~oas;v5>4Ii`Br+stVH4o~c~aeOxN8cbhux#l5zF!#ANUR9o0TUvX?1@}jf4q98k zrgHYOeLQ!7ktPn8F!PVia;W81bS*PA7W??aH_oc|n0AlTDb(w=#9(PDEQ2lS5tK{C z9yR8wS})#lazn&NYk3!|Qc6Sf!hV~LgrIFxiS0N6or>$Sx~RRHO|L@1R<`VXSLzKm z&QW5=*dM(ih7sbM^5l;x;mh*(ra0_#Ru}cq~VTHK3N%~73Y6J&#tZ7~ahK(D6FSG#%KT~z8h z>BEdi9^O;`N>9owOrVbK@9P#kZmA;7xsXSQ!J;M0=KM`R_Wv=yDvik8MJ2y zF-TO%4~;oBA@L->6(qO9EBFz&Pmx7$r);9`r4l8bmM$8Z z1cSv|1Y!<#He2h?p2y-;P$D})={M%N?WpNhuBW!MeI-kI^~&L$NM(5Jza%0lu-_m~ z^3D5!ah=Jfm(iQH%eLd|Oo9j_u@FL*lX-rc;DPpi4SG=G=h4ifx8gSzkQen?oL83i z9U~4)vIQI-Nl}Z$cS~zaMBpAKvrFL8_l1?}(Y~8cVhE}Q8ZLIIqnBH+FGS*V~S%A$8k`sC9KY=Dlwp2kF+`*j*I=Jt%sLnsPW=g|Z)%WeFlb$3N z`Eu!zX~JX;P4(l73^tE{vBoTlj`+nFg44gb@U}$`EWBTpk2ieGS16@PP|=)OaO^}a z0efFVfCa)*B=5xffhShNCq-*kf7cd?0>BsK){i+StO8%?+i#_rG>S6gFcMNS(VV)W zX9!UTJTUaZF&1S4bt8LDg`LA~^0~mCabfFx-mF^mz-ihHIL|5p%0M!xB`FlH?W{+^ zPsg2uUi0l8-dgk+c{6Og?}pmtVBL~7Nl@S+*Ny2%AuuB5XRV$rrk+=Jb)IFjiJ*f_ z`p6g(Rw79C4={61RFI>glcUW!J7Sh?=h>J6?^PBsfbtN3b2NInl7gF1aZmb*;^h^` zNWT|}5QXttj3}aT8Ie<@93jB-?D%tz%K0WWCjnl*u3QOfB|#pywUqKVx9$zSxkS%X zp7n8oJ5)k{p$8!4NAZI)M%57}#t44xxR`2RC!Uc?_(B_&auMS)V0nwpQAC*slwTzo zkYw^9S<5l6Hbp7jIY=Ox3n$6TFpYGxiw*Nrs5<%H2;nj-9GfbQ3r4M^loq9g&j(ST zEpT;~IV6HGr)YQ8MJc3#Jp~!L5J*KYCa?zpev-@a66&dSNc%c=RdMN)_g^t}^0vpi z9)i&})1n?Zq308Njug;v(p?k?iIL0BZb%5*1SH^%sbs5keXkTGqo2B@o5@6(u;lJII%z*Awge&kM4W)?*^lSMHn_f5cKF8$+BE<)%c| z{)zo3%vy&_#=k$yBR}}_LT)kbTn^Af97CO;%mC#VBhyO#^Yf+!xC)vJ69m`Cpi(fQ zBPxr_9B&0Ir0k9-d{WO^ts5Y;M(^+{7i5YZAr+6y_;<~&0`c^8%Yjg!9Awu`EQ+TN zKq6+Nt*+%6g)}~9FTTX~y+lcIH6VMPb5)zt93uw{9IB1d0wd2l4MwUXrokArPGpTl z;WM((wXH{5S(q8~W}OiCj0RUo;Vc%=C?!v6NGu!AB8g;UQ>&oieyc-=q1yNqprt4W z!`R$g@j=^D1o$TazMTbiW1-j5@Z61#0D|U=2hNreX_iLG%Qe1--t|^S0~^d0Aa%&W z0ma(M^@R>}z+Is_mbT&v-p6GT3uqwhNcrh1WDc208P12H>koUAYKz~)0lIJdKSpx} z3oiI)lh(LK+Hskdfgt#x`kE!-N~Rw!h~;$3lJRdE4<;lGKimr=vbb7W!c)n)AH1{B8hN;aJ27FSwZ4&kP-%#l0u1l#JuHKOEGdl~ zk3yxvMj+PGGv;?P)7vu-GU8iW9sAa2jY^iOm(gbYCJ@Qz7p$tz=K&ps zc9Hnj*RLoxGIV+?4i7`5ujS>=FCKI?QylJEF@Ne`(+wF98oTs}0s6mD(07DiXJ;3& z)LwF^0h-+YE1h{;gdl(A#Bym`2B6P+kSfNk^gnj|eO{69+Z{>L9vQGbtsnt?T`{qn zWji;}b)<`Zkl2B_JX~8KcJrtpVkgw8_m}Z&{eSLmPR9Ct2tK0uxoV1K$PPlXf0bzU zN7jP+iqjFv>uTLbi0=u`|A6m+#45G<#EI6T#wrbhIfw#3_nFzZOY?R`!>WggKv=!cC07@zCva*ZX7;aROKB!Hqo>IiX1G zlqw(mnhU7DzGAeVJ{pX3iV|RF zi%d|5=f@2(E>&E`FvOwgG)huN=0CqLpZ3`6^Ayubh^Rf2@9})LxBHB`wD)U5%gc#E zO|+~gs`V#hT~+Jbxq^!4JkcLk&EY-#6FI-uUHjZ8`yH5+`!ieZ+b9q1*6mIGGEz|y zg)*=-e5xul<<%GUs&d+2)wNIi?4s+dYvcQaW*_Lb7du`2o3`%-o35Jt!%lCCEDd_F z%Vwz<#6z2_?bb6d-Kw*SzGpt?JI{1pG{+T|%;>@S(y9ugPY;6=tBT*ajgG~*+z%&X zQ@9!ZbBkk5b(On5|D~R*==PnpczNIU{L*~z4ae0x(0M!_YNvgnLNOLU)Rs6A~(eQoLR zFHW}fL$?{fvs0s;e8|^bbXWrlQJ^8gg(2%UpW1+7$^%8Oo2|W_Q0uje$^ojalXzQ6 zh;R%d7>=k_i@vD_rO12)u_Y9e4cgjaA&?}NeS2tBgyBn_pK#SAR2$~`(Fsc`f;ttS z^SAazXe-vv|HutnZcz~OeOa1ZPJ9k>XvHqNxzPDbcf_;nlKO_HbuoC^v3YVKYii8W z#gW7HIW6ggx*9~8IH{pN;!o_)Uq^712q(^;;bo+!imkjR-*}9a=C2ZfOg_gb!?S6BPWqr{vsEi@n`WmL*956}4LUEwwPEB=8xwnZ4 z8aHj+`;H`=XJM8hSFi)+(w`c-dSHW|5%JjwnZxGw(WT@5_++zwWWi4QkR%}wd*Tnx z5e~Im_PY&iD#V~Hu)7V+5jLR|S<)NoVmHBY??JBPyhMQ9RsD`^>(-YiJ}}LV8Ub_S z$*7Nm6_U+9I?t9F^W`G-PzwezA%$Wd#K1#La>xs%WLu&bKma8KNDDbRPRRH<_urzmx`;P1!Wjt}w$nV~`;;y1g9; zou-#)Y_gi7icku^4JlEHo7qk;a$k_6O z2_+39UK5zj>95ckvJBgA+t_yEn~tXeuf9C)m}9a9r%?Mdp4I!K~4|8?Oh)kU}6N%5xL2qwzBy<3e-u&|JA$kPYh{Zr`y z#|f}LwZ0T+;HyaDm|w6l;L3pa*CvklT89U~nBvk~T~kx|lt{Kf;DfEL1~$X&146Q~ zygW||7~Zu+nzdN!0_=tu-#JT!9X@m!;ty|P!W<*w{Kp6%^CzFZtPEz%VnUm+m?xQ! zl;__|OyXu9$P2++X$UgHZBe1Gy0~Fmk}R_EM>gMHkOKS8%D-|UZveO^`=%Ix0mDfm z;D;j{)r^~4DEd)ff1hhjYP!G(L4ivVDE%WTrSis50s-T_*z@tDD)GTVhx1|Jo6K5a z0Kz?sT%4*f1}njzl)Q@DEX^KS5@jCZk#^%8V;STr6a9_8rwX z$$d-LG9P3_#2?JVH&E-S#S42G6H1ODP{_QF&ypP#81gn0_V8 z9Oj$RENo8(R7FSSB_bM~l&;41??d=N6e3#ydaa@Y7l9$yTPYi#rFn4M$Q)u2AB*=< z84Hvw`Ak{DXaS)I1^SWqR*g{NaHoyH;)1dWeY)v^lo|f&4gMp<6}(gDLY7iYCr}V7 zv$5w_j3qYLDfz-w!*1huMotimA}MS%8E@ONmY#h0{5pm`L%>6nWkHIo(6jD=t4MKWyqYmGl_JR3E-31#&wm$YBeY{m1T{n_HfaSIGfal- zK9Jz=x9fjyWd7l27!%5%!g89B_CV-}5p&3|>P;KMQDh)tzz2Q(AQG$94#EIx54pJR zoF+L42Gq2Sk8;@tw}yubL*(MVyEGn0w!tGeaN5ZJyDZoZCMK{<@OtXy4S!B;-VlQ~ zWrceslF$;R3x=^am-wL?7MXwy)$3Ti_7>8@*YmCLa)e$3{x1uC`t;vuXvoIQl3A(C2zj*PbVyWTOdPfYI|^?6iV>(RQfpdO_ zpmvLDZ1QBvn-MRw?q@#+A#O=<)%P?y0u2`whH=RapfA`DSadm>{c0fQb6*+ti+2|H zyV<&L<99n+G#2OLyht#M!RrAC>&@Z^dnLxqiOo_Sk}62{EB#7&yiH)><5A1xSpD%80MGTFaqY{5KI7hV%BPM#qcZ zYTm9i8W3t@RNC!DA1dJ$6Gm!SyBComqMFvic3nhsdxD@SBZ)8$f8%2XZt~iXByfms zoR9rmv$V=qwFI`Cg_O??ETYP8+A;zONdUD4{!O&qymiy4<0;#!%27DW)>@**cT8n# z)p$olxcxX7B~wWzy~$ItBU3SADk3C_TNln%^{>(_=|O`7ZzDhox3V;FP=E*Ts}c|1 z&?S4rk_@$*rELm2S=gVEC^5WZQ*W_ha(pxyluQA4-5sAE`z16s477f(wL$cjTNgX;<{r6-HR93u^jU?SR_?FpaAtU+D)JFb} z+{nnRS+LZfZGYYFxo$kN@(w&!ogQP*b;Z$T zm!*$qX(KZI-I^Wd=npf4SUZ0dZWW*zv1?zjONq_kWE2l|zq}&bvg922zEIrwWPe9yedGPLq(ZZjrS^Gg$j|5U;CKRwi7|5R7QbC; zZllw081l{i{-$OM65+@|bE411dSn&okLK_I1*t`GpfHAb+=n7@Pk=P<v!GW zAuP#mURhj4!ruryhE((IYDOw(W9RlAKh&mCoLrUz5hzENeDmK1z!{GH0YZ&pg?1Fg z`tugjP+KOS`GtLhbJQqQI^lElQ+zIH9G9oqS@0eO8IFBIEguIT2%ns*_b+Ih>0IO- z7#NCgOIBV;YblN7#0)&qhYLvw>Q@s_x0d1bruclhnnrT9mZJ7#P&AH^|+Dy#LFYx#|% zY)^azRG&`SU$r*uS6uFsU|H)9GKYq%kbkvhUbDlF;v=r>*I>&lb~Ru^Q8SxoY&A`P zuZN$d*JzhdBzy2P-|U;VW~Za<#1>#sn9rkR1TagwWYx-4TW6w*ElQE~xl#wb1u0SD zDzi13H(kM9C`2p>)uu6~=oK7qH^gwyzA#cNgkS>S-~`(%3cwm66~Ig8U(+Q+d*Jr< z#VczVd4_+$8G-U=?L| zUM9nPeZ0wnBLT~V)s9ud5S=l__>v9%Y$*D;dw9Hm&x6?$tqXP*KOX_3nd4kV7T!m> z8s)jb!!hC^@q-AO%`tI&N~SS&+siz4U%;~v;db*(?_Q4G9oc@Ne z07h~aY)kq-IKaQ0%Q>wQNLHRSaSAZGr~4=-o6=iA?i}*RCg2C&Q3eQWf?>Fl*LkwM zDuz?Fp+iyCm6v`e7^-GF+0` zmjdHgBjOwqzXXkJ_1_00&+-^?^t^vrS{d&E_SUK_s)f2Mr)m#T$D4b`az={05$AqU z=mD8x zbRICd@snuhhB`8@lVpkN`>R=A%t34&5{#ezabX=}N+wAesA`CCn3ukuj=kl>sB4D=u(hH}z z-PYaBj)&6G$V?lSvPJe#{je$Go|ZDxV0vx|e2*EX|5_vXtV8mSqwW21UJ870z=B=> zN#2+y=SNE@pcnWAz90L?$A#QiP55sk{(s`*GBL8T{AY(^MiMnQHo{R#@%_N!Db9(o@sL%hhOaW=26-_%a2Pb+M~+uZRAUSH39x`!pNhEr~KI0_8<4E2qSbH7zAc1iF2m z#CYN7?Ztzpv#8doV5lQ*7)vm6hPG=rw$j(Fu)DX(4`;h6f zo<%V~=v^~K-|H=Bcl)iGb1mF0zw#d9D3YooeMH6iPHSU0S7#P+BlhnPUg2y721Koh z8>3nSciT2~5rl?#)xkfDK?apY@%HfGi>&i&V+Q6h~L8dtu`;W@|{BHDB=TnkE z_GCL@Jp_)a`LX`onZ3C{eFlz$p^Hf6WCF;|6()_*;j3my?eJ!2AU)QD%BGm;nim%0 zHRp12&iO?N1wqJ}6?w1x6sIwTBFK`N{#|YUrg#SxB*Ayg+@mzeB4h-;;}HgMKQr6U zFafAELIu&yuZ;D_eJ@xAs(P}YC$bUup{)8N@BR-6qH^d~0AeawHA>SFlkLADPd`Bd zf0?~~^=Y??fY^8iIZ4Zhhf!8W19dq;5O;39#y9^^-*u2Fsu5a~Uag zHfKTEPB#n}VoWUMKU})hVT1rQ=$iwH&ih3bd8Zl-L>lnA-A!#FjS+;kGcHz()~T_U zQTIxruTw3B7CSW2xQB&GMT&^Es78g4cY#RKkwNwr zaRA#75ChuU*ucS4sgwqrRtXJM>~k7PI`8SgTENMPBz=j@sxQGZ4{Jsq1IiY}llKVHajkRveHI~+9f(DCGzPfgc zdNf4VbffrQ47QO~c(P5j6X;Uj3N0kV0J8D1uxWz#b&<)2c`6`a@hC>79qno0kg>iy z)fY-7JyftrZfa#s2U6=f+s)*L>cwz}rlc7K3@>g>n_0~Q$nNq=oMa#vZQ?NZk%mJ^ zlFkR@#$7K-F0iO!8skw*bfLk_Z8>?rjcA2X>a;IuMOyY=YmG|!i%~#)QqbE-@VR$ z9rX33^EJHfZ2S*~vX4hYGd@t*;32rmOT3@JpagLPmo_)r6y<0eHc5*`8GaDRqZoi) zsMBnR5@ql9prm&LK?7ml)v2C8kkV<36saH=tE{9JzNVooX{khYWjMJ+s1k!qe(q(Cz zNPcBsBZXbg-*+o$@+D)VXNzTsa}U|r0^dQfiQX8z5is7MO@}kX;U(K2ubTx)?=M8? za4!hGeBZ_1N{M!S?-F`=2?N?{2{~o%t{kvm`s#@la;@sjgO3BOaI)JAvfl1;bs1`^ zPyVGU2^-}5zNO1U&x7k@psEMVY9T4Cg^hfqlGaZj3iZGs2>GUUgne|G z!kYwj>T`99r2D%R!xq)HV#?M=6we^PFIW(Ppj5g^`$WpQS%N7xzm`p!z&D9JD7+YDf@h8p$j!* z6TQ2=MJ&AE9G@?RjnbQn>%k@~A$Iutqw#^M#Vvk3WHfOC4&snWL#>{@!nUXIodiOV zM`Km@lW#nDsZS%@p^n#U7qTie=MP7)Ubm%dcxZj^C0}!@#r8kl2fJ#zV{3$416y?O z(?8oYH~Idb^kBs%(En|9`5(E`3{3z3>N28X`+xG0pI&{!D`{H-qY?LtAwCmZW*3dc z8cA>%$3RM^Ylvi0`J`-@wfJ4dVid_j8}unGjtC3QPVXDeogw0$KAtPkyMa8CJ9LkU z(a-$_Z$B{}oC1o7diRcpfA1`c2+b>fstR*p|LgEr9Yub#zYC$6WXh)0N1%VGu z0$#QtI&=zMJW1kn_;nH!k_>|g!c`(-a=c!xHv5h+qZ0@sN%Mmw|C=p7VA`gvl8)yF zYR(~P4Eq>J48(}2dHg3*H%!97Uk{KsOYUy&xL6dC2(Q(KAYBk29B>dY98kQF1z?p* z{W!-Mg7RDYd|;t(CB5i9owe;?>zEP9dOwkoV=Kd?3jzK6T{tvdSGU#xa4Oj7cDE1TMe$EO^En$7kvJ0BZ1hW&3I!v07`v5+T4_?mJ9nIZ#? zNRi+LR;u(^8S@hfIor!9(myBy6&?$zSdc+P8L;^X!o5a>*o53^0OdIt0g7gGP)65c zb=e0ieI2e(sIWo-ej$R(b)u7}9BwYA-|nt2g%gTk<5iA;ZGpg92t8@td-y0qk_w4S z@)&)@2Lj$I62ucpz(HbNrrNADlFwK1I&X86yFL_CbuqDQ+0+!o`-C==P-+CTw;?|Xn|xLTb(z8VF1nF6e*=M z-YqNofnMg!F1aR`?*zRn-r_j0Y>ry9k_LseX$Sq{yXko^L6Y=6g%SZ;~9cH*@tcJHD!wB2$B^n}3QJSh}O>X^2_R7M%;8TcB2$*rx$Db_(tMmU+-W*4R{t#0|C}Al1OQc9Lyzv(7HOX3MolB0IPM{K4oT#E##VXs3+#xz1$JEz zMI%5M!;R@rxKA{KUkjK#l3=iupR%xSrroJwp8FPRoG6cqtz3+4)OSziyf9(IcWKqA zc6aRfYVCV#)XX8Nto+CfzKnIsYdl|0bvR8*J$qyYh33}DfpOO8;v%zI9$vA};)XX5 zz=~nO#v`G7LfW>Q`?ywGHIlW-x$)vf!F=weI1;9>vxz;m&W-5r333)dZ)vn-vm=Qz zyRfU8h$zf(RVO~anx>>eQrxMWY-G@tDxqIp!I<*I%9WYlmu35`pDmLZ#*7?%lkDe=jd><#+k52D zm%gl&Suqw;*{P{o_7>cyH)bhd{&IJ4eA6C?5KN#<+nOjPwe0qO3QenEn6V*~ZG!evUzbFeBBWtBdZSEFXM(zgCyA#32>!8Lsd(hlEpk2yq|BJx%L%XP*A9QQJQ2 zZ8HCS396mpqUApY`BXyl|@>%LkS1E8Nfu!=mE_Aq0 zYvXj~mn00S!CaD?YlcvqEz2?dJD~~!W0HQ?$B&IoOswwmw*@07 zl~PQ_l)@NAbI6*f_fssEEI-SZT}9x90RL75;8~U7%~;h4Lj{vT0ma!?sa%X+IK%OS zAC9FA%vFHw5G2g2Igq1Exb;|Ex5(RMN4KHemysFYNHSs!;9udUarG(0loRpy(>HZj zyJlRY2$HFEWG#Q;#S~YEL~`EvI%cq$5ay znJjG4%U-x|IM2x$FfJ$>Ei$3*LHxQHnL{oMLcO>RD}|u;ha+gx|8YBRvdSqG~ z>*-MQKnZh%EJ6y}4@#7I%_?WF1K0-ye{OFL>l?gCso$ZEV3>B)6=yW;M2SfHaU@|&^5|b-(JuI^MJ!x}s; z$OL2??2x`R4P0OPj%*(`rZLnJKMKTn_yg?1)WC!{W`8;CJWHvr0u7=F*DA1>ahlG> z*#!H730%5xamDnym+@P78BO8w{K~}gwreY>t~bk`f+StCI$ELRfw`b&w9o~d*0ZlY zBG>}PCO1?aAN%D}G(r(E4nH|9u)wYq2OvWqt2X0AQgcaA6fzuR-!~>Flm)kwRw7VX z))3HgZL&3QV#!H8le=}}>3nlN>J!MB7fg(O&vu-i#Cl@8#ydy^_PCfnQQK-m-pq34 z$T&JOhB(!YucsYiJ+a>l9&LYU)(V9Iamhrj=48MEko{To#48_pCya25!KhsoYjn|h zCXr}xq}KrHo9eRQF7QVr0zCLIGGOg2)5$(2o)glGI*U&#Hbfw$WQ*nduQMVi2-1fJ z;9pp-CEvT2@^dd;HbGlbsq^6N>pDe)NT8Nk>zV-9K!@NfIe!Mq(kBKv6SDQSLrz7W zEadk?jzq!{cO{~5A}Rd@q={FQ#N3>5JX$~M z?Xf5$dTK9gm8PCyI3r=0jHhPa*|0hJFmLSP+?GijlKWg62x5@LI-9r2usYlW;ei%=&(G1jFztU7h#%@EO7^@4{~aXG3sph&%;O2Y0Y7i|M>&sKV+&|8d&h5`<$byqaTs#<{8L7}0xT5cy@GF1r~ah3qW28pEgGg|LGIrEIWV)vXJo53 zLbRr;v>3xPia`)Gos%AqWy}@o6@tf^tew68V~r3@+^5LcZ%DPdhhRc|VLLsSZtA#P z%3plF(93L)(gSxu1Df>tfQ}@OwEHJ}^ba1TnaN^xeD|#YGl};{hi!IP;wu})Z9uiz zr(R)!FEVdjMTm6Yk{@5}&)2!X&MHjwe;dmG6T6w2f%89t?GmlcxPNwU-#PU+Mc9~* zgWN41Tc&ja!FquN$cKc9;EkFcG$U<2>Abx6PnCN!rP5Ab2)BCK2_*WFO660OmUmlW zcG@p-_N;+Ewk*G z+wRXr`ro&yp)}_mmof6)w@3Qlr&#{D@F9=kR*N4t8FK&E!?$|V(sf<9@B6@WGq;|f zJLZuAEe!1Nol(WsK_uZ&>`P<*>)9boywSsW{;)O?zJ0f*k}QhZ?ZbR+s?Rm=4hBh( zm_zlu!j)t)hV#4rUhfdh%hFx>me~xll!m4CH0^yG#q(6ng{-@y!p+<>NdmCO@E45LZGqqe0p)*Evhc6LkX2C?~YtMMeSpdXjRyD!6maB zHgHcxv>dHL*iV0~`?{umZ6Qn}><$s;4&N1SbCIfw_URTKzLwp2`rhRBg^+7#Z1~Al zl=^J{Y_c||JoX!m4P=Haks0?N%ix@xg4bj%LqZO^>e#v8^q7achB06SoyMP*{ao3{ z&h6Lj4*lcK+{Ab7$eT%Pi(w4oeAHuufBZZlefYW5y^-?zKJt2dcjWW4$EUBe#~)t# z$E|2qCqapkq)v3e$G6wW<93s{HsP06N=u1pVd_3S3THH+id1qKzarBqQmj4Ng%5ly zWdpVuoQ5W=`Kkyo^R;uo<~Gs3{6zTrSA}M%gp}rLiUX`55!!e6!KjI$u)Z1s1fZ(Y zT;A$p8+=hV#nhncGe`a6t9c+>qS%PujN9phUX>X%LXbNweRFW0rcHCRe_hA5j95Zh zAk1*%$bA~J7bsh;^9X57wyuA-v0;})9?w(M(KF=WAFtsGSqu25`^>b_f@(*WSkr=q zN$+=6mxQ&FZizW}1*F>8a`cmqTp6`rYprV6av-u4rQq-Bz$(glXpL&Q%OH`;fOTX9 z1LL@qEqe0gg5RYA(8(mIsn&-|Zpw7sAN6eNA68~st*X@!5=&<_B6Ho??Q(+Os6EDp zq*ueyhiYWuXISas1FU)#05LQ>3U_jH;B?M{-Rdyscg4N@47|7XsT*|n9Ty>DQ)((u zMl{mwg7Fjb_b;|t(SfWMKgEfZ91?{a(=sI<7F+lQ7iuH{8N%ihj1Tv`i5RXT7v5A9YI^bAnd1??dZ41?n$MUVjf7-G1SIK+PJ^$e&vp9Un~hVizqvyD+d-dG!s~B z55NH0Q{A0k*79>E2-05&U2=kINZz7YhJM5Oi8paDpQ%*+g=Rja?1CNpcBmGwBkDf3 zS5`pl3Z&J#gZLW+)hH=osT}os_Vhs4I*Ttc0RPX5KQExn%W1$J!Y&esirvCsna8=~7c3R1_38uN ze3%s_mqhWC1F{85y)5Mj?NNFTY|16Cr(h{UoOMQ{!Xji4A=bQp<(;&4gy7H(Y82(Y zrzE&BXa%y^%~yT}Km0wKjoLrRj#x6qceYpj$k83wG(DtBDaBjB9Ke|>gUR^PaFQc5 zvg|7dPQHNHia2=c>>?kKLc~c~z$+hAgD)q6J!GUY;ce*@Tqf*nR$ti~C58FSbT0RN zsnAd@_sL+rzK5%c?<7)b!Z8?v-}M?I`;lR9cgX*`~lwL89V{spnv8^H$IW zoPjFA4L?Nu{XaJsq%O2Ke*D=k4H4i@XQlDjE{r?&n9U=-1KtwV`l8Fk%T~`(ov4fu zK=8b5MM!T`t;!0wfL%kDLHSKPn1sSA(Dc>6-N+w8CqZ4}@ASS*cL@w-Q|-6|_+K4D zelian=O^Mf7}B+*H&o{e41kb`K*+ls-@e=D`Ne>M?qQ2y6bzyMWI(@}hQ6CIae0t5 zOcz1~9p94HEOs&xr3^7V3I6LcM9ttvxIZ~0YAi}dYQ>t}wOtsdIT<8aH!rkj z^TVzy(lkV=jir90tXP4T3#8X6RQ90lX{|E!6KYXl8-11Gunus&B+r`xYXBEQsX4x? z8(Kwnja$kv&&x&NBnHmmgn*q$`flAIh|rLbY&>HuG(h9@hg;$t;_4u<1QasLN4DmbU@P86E=x*fi4V#Tg6Q^5TZpB z?3YKv%mFOE>ZPE_3|^Q1Yp>WpXsQ@~+Kz$Z zLVjUtA)-Ei&GqflIyU;0LdC!q^vOtF$ytoHl+dEIx6Iz+fwvPxs<}FfjPWodaR<{P z+Ql2+nPi3z`E=e?ji&5#VLCzdG;06y>ggLw6Am@qg836P3JM<|(!CIUxn+EOr-PIC z5>boDmRmL)Nu;#H;u;Z8<*KD_ACmNkLaq0B2#+QVrw1E^X6KE0c-e>&F{+7CVM`ij zcNyb_+EQ@_DAv|%gK-yh_q>u!7c1AMdeMN$Ptx4tgkZWGY^;#+>YZ3R7`3%%7Nk2V zBNq0p9$Gg8DW1?}nWxOKg33LWS~QV3;=qfmV6rSqzq0h!LRE%%^cLk&WYJJ)^*bK1 zFMxDV5^six$A4GZqXb^%-A6(AMcJr=nPv3lGnU$BtYn3eOh7VEsxN&X5uIlZYu;4{ zvH|{SlmCH&?>@D=u7_SIGo`A+V*HbBmp6o&^oQTU+)W!9`q;skJ#X&&DDvbCHPw3$ zcimDeK+SiK5Qp5B8W|TO@4No6p|2Fq44RLBSUF__4I0lsD#atjb8 zMwVDnd+jf-y4<6usPKVcoXtAfGs1wpbej{+WV2ZbK(|_kXWjG;P|Dx#2l9>5-)klx z&wif9F?c+K%dhVc?Wsu?g_f=(&41eTCt4!u=L-glA))XHfrCeIsC$V=hmfi&j%_6x zEod!?Hm?#)VY1wpZu@5Iz#4?lP%3ZrvDAv$RlUx;&8n`B-E{ZU)FIcgpP|HVlA4r` zCK{;#>%52A!YV1K;{1~vM}8Ul#BQ@)+NC~4gsg2(yXul^OHOeDi?0NskV6&r_SN3C z!2=!k&ll6lwYthC{QyZg^lq7rxn42tF;wD7lvdbRr{UOck#YgTh6b9wy&hCoSdb|! zKl}F=FM=k}D-U6P=)XuyXdhbb^ty5qL+Z~hcFYXA3#@$+%?leR*hEOZ)oQUoB#SM` zXkach=|A7I>L+u;@oh)PH8cqQ7$t5I`}&=fm0T^1Hcy^SA@Wb#r&1{tHXskV z(PB<*-qUS*wH^HPy}Ow6xU?#><3|)Lz03Uu;e}vLIubaGdySoQsn{>|VRhhL%k06M z`~PqQx^ktPUiuMwYaz+-`|79#M`M;|tgMR8dRAHrJy-j)Di+t=&Gpj9xAtr-J znK2>LiIk(^>$=_hnN+k*7j9C2(hK+3EhoF=9(nwGhA(9L(!01G@8fT-$62~^aRw;| zsqT$Ik_d63(*hQ4Yu&sC3|ne*$nnVre7 z%YBrW&@o?O6Z}oPJYpP?gILzmImsw3IKe!ESgD|?g~1HZjmWSI;nbMA(4aD+Xi1&aEO-bK+Q>P+G*zo8 z-~KSW2^i5KWpqDzKDiET#6_<~v4U=m$Vx}N5Y!?iOM;+QiYBZ?uts_%JG~4p?z{z5 ze)<9s5r`9n2E&^CFH0WfX-=f#crYsV&nOJ{{(?Lg-Bjr$X(DDg<-V%tEL*B4Sv~d` zi#2MpKj<($zC6+rLP&_H#6!d5f!ynJ-(BnVr zc3olzuIVILB(dj&4Ca_3C!`SAA>pKiNkGJt0&197&RI39B^G(S%-Vy!t4LrK&O{LE z&I8+TPQbqMAaWUfoG?4bfV^M+dvVI+=c{w={^2v z=>%6keA+k-E~_TLf&Zx~=Ct9(STUmncPkDO*i~(4%sl9{bR`xMZo*DGkQocN8!cK+ zTy#}(e5&YsdW%dh8_vT#m2r65yb5|{7uh#8Pj4naFq9NGwp&P_OZ7Aqqv}C$;)PH9 zQfG}AgGUUm&3m4vFulMh-P|7JFdOk8(3VV+$>dqrYi5hy z6zSj^&8!F!jW{Q(%0Tl)xI3L*u846`Z3Bs?!!Q~$goD`1FAbxPUztJB z2_}aFTizNNp6!=S2b~Mh47*2z*%U2O9ELBBC+j>(6=~~YhNH+!hfulUvX>W%q3S1# zQ@4VCIOj)YXT>ia6zcF&60DI9X&aKvdHA+w$hfnFJ;?Cztr5%v$C}`cwiFl}1_mO= z_6UjG!?8bXyVYuWLEn;V?bbTpiz}D;Xs?CNK}EqJZYa3i@Yxt%?>{qHeSuN0c5~)w z>UOf*0@kP~yf~;SlQbdEV-&*8wlcxY?ee`D4I3-B1DEGv=T<{HxFoabBxavFpD-TR zOj&D)UHyw9+PDZEML&3V41@U*e$3Zvb$Z?1A4~J_R2esw%bgT_nx~%q?NRPo_dX4% z`;c2`prTY@-g^SxEF!v1$TvhcJVsw}8Xe?aDCW%vbuQU?D>_H|@*XXWs;!M-+ z%GAk94?qt)=r|!1X5dln2S5M`Ch2~osWcc<_Cw3Lj*B<2Kk9&J2;MgrCEdzjyn;Uh z0<{9bjXk*@f8O@_lSE1z|HF5m0ugsI1nb~5)m1j` zFovM#^FR}>TzG>rJ$khFdoAp(?3lhjaWoTYF?fj>LgvgGsU<~Dy-t|39YJ`AzU%kU zUmkMZu6naM=8(e!_%J<4+>a?ippeRFjr|$){Blr4OY)DqxI)kmJ}_M?S33(6`^zQC za)s6vkaclC^FiO2=Rs>(k9yg1@r9R1^{TMnAx zAk!C3augNSrF0ayp=C*`dezT>-LfRnW)0Gl!=OXEuIrBwhh5aHD0xU>v0-q7!JrK$tO`)bAfxHvS6rP7afCid2Fv({ZS= zKl_~z*>b&uf@+HtV&io$mT#=mYXYUq^xiTE#6s~wTiOU$mP8T~@t9x?ck$vhl~uVw zrp<}R9t+|2D~;6<3lY0YOnF3U|KpdaDW}b>d{$f~}tsuc=@7)P{+s$t1`n`D%p5`zPET}KcJ5d|G=Tq$I`tR{6 z(`I?tFFw=rW|8pN-g+>*p+P2f`u}vgI@y)>lBmPB z96fjJrW&R0_8+s0r3Ss~{Bw7Bo3N`;>3dg7Pco2>62iS+Du|n7Ts(w#w}W}9t}^qN zojyPArlG^3Z?{L+TWMbR4mYqqS5JM!m)+^uxW9kEa%Xa!!U`Drmph!(3G)3>7<>l` z7@@LV%p+lkK~IWjBOV1`88uw!avL$W#{_->F9cg5$&s#uKW~`O(>|Wg!P{5EW~-}9 z1zwB}ai!_4UnUT4RVLVm<|0^1E#GU)@<m?u*azAm$7K#Il^m0GPH1s!IOFgZY)`p|7S>HaIS%z?Q3DCo3A#-tf zWi(lUA<-7Ys}wm_WEB232ja>Q6%J`q76zDT=`D*oppHPd*f~;|8z*LJql207F3Dr3 zd;8NZ3oR~u^!Q^sC8`p{A(qq-QqdL^WFgD#B9u^)skjMH^ zABXlrr0~WG!UDOT)NBP!JR^0>T9JNz>u=0Zv)V~VO{-$29w1Bhtfrri`@U>skzh2@ zVc5rkf|ANewxN8)%_o$BvJjAoA4tL&CqTj+%<_b{zG!h16Sj^5r5t7IGr$W*tf8C4 zpWNdzcieT#_WQRB_Xt#O@qe=(5GRwEDl^)lGOGAQ{3tWNL1}#T|LB{sR0v^ z1!Q9+O(~>SSJk$G7F>m$OJlZ>3dwv2Rq}$9LdSVVLSRPn(Bo=!F;xoW7vXhEeGy&2 zqSzswakVXfXktcOxI6*V@TY7zzk~`8<6rY8$wj%)ZnBGm{2Mwyp^;GQu($m*KOptq z;L865xBtqg%E-a|zcwa4nwoY1F{FQRBSgwC#c>+yk?bqs^ludi92C>P0xBVsB9=<} zSG0&6Pq4cY71rH+Oh|>IQMF=k<~nN^HqZx*VDuISD!J!}OLH5jUl*u;E9q~XJW7R7 zy9z7^BBMB&xcA2euXn?&i_Q)MxrF5iGb)@Bqj#oL=DMDtO6{bK-KB+)=_<2R>FPO@J2WilX5q}pBHuro6d@#|8R&(kN7ubq z-9}(i;Y*&6Xm$GCxdT+dx!X00d+nI@9kpgFr=t3QD9eu-aFZ) zvXP6)9I`$%Gmbb|lfgM@1Z7Z63rKD)l8v@mUL>)EGUL#|aI4Yhhh-bl$zQE%`2sP1@vG6@cTv;)_(Nm7kjrV=ens3jiVmJ zIdpksjGX;z6B?on36zr=r7(Qlb3Y@7&3*CbaDj{y!YPY>6Ze5Pc)a1I^LhPiDi5l#nD0>EdnCA2=fnn?3 zNRNUx+`Jc|SesTL32>^haa}hF8VnivrO>~a_E7|dnu=G`*URQMP#UGH>|Gxf%CKwv zYe)|^v<$0K!jVebQf=!$^1E#`W7%*F_!CNRx2i-=DYh_SOMAa;VD zNV>+FkVl1gg-P(@bT9-9nAp@>Bzfj+{Jg*H&#R3?VszY-zn4Bh%hIH-ihpPxb@g?C zNA)na`ILVNOA0p}N%Ct4_wUE#`c_|yLGKYbu=R|fMHrg6MpX)$~O+w}7;0Wc2 z-?C|%t=HWswJA|)u@pc?hn6BG7&~TD?s@Swl#^wIW_~Q-%6wsj@Et90C9TBUZeVS| z>@Jb&^*XYQWAF)8p804l^@W?pIZ83mle|GTl`B zIIB4yDTj7I$zK3)3ZzcpzhVP@`&u#hP6PhqNRiwFm=9x}{T%lMus`3VC;ZFX?1qNI z^c22|HM#uhv6KSwtiJ%9hN9ks_SqKs*31|M8Dg;=mHpxtROIVZNpYn>>>npycT}@R z#cI2f4#Ilq$6L@~!o;~x@dQplh(i%kKwuc(GK%;fxsm%1KgrPT%l__1oj+$uKrv9j zqEvZXmvyZ$Gz{3aFyX$L>>e%4+z~@4Ie+T&R`Pi2zFNq{y6KbR;Dz>d7B?j05L5Q5 znGP->Y$r6G7@5X?wMLnE2kp0H*!z%lV%-!=Kq*qJyuH@zw{& z5V-h%u_H`|*eJG8HqCaU`xC^7uGHeUP(G}B-^LiwdEio$XB}{b+h1ZwKetfQH+9<~ z7dJjz+j9DqD~7WaV&1MMd(_(n^Y27~A6(p=_CEplzq3oSa{Mpg&S+`>k6rQ~a2e*q zCM~AXZx4D)wq+Yehyf!qpG*@$)>FndHd6^#CQ46Zukm5UWbmxHG>%l{;Z#~D9X_Yj zGdnY9G-3Q)OK?BOO)I`HX@Cv4y7lOj;iJ%5TXtrxX-Wz)v?jo_?r3^?U(fevw1Zgl z$(>c#=fm@i{3G}&&u>I4ov-U>euw)tvpzcnSK7wB%bV~newIh@-;FCC`gkWY<`ixh zZgu5ksh~E}p2+1i!9?Kb5>-8J{0A)DF81jdx#g)FeJ2na>p4|7pSRxujr7ud+6uC0 zr#HpI9d%#2pb;6wLg;$Ue^V=hG;aEKvJtD4uaA;EA4K4p?(L11O69;BI$%DwQa+D$ z7Oiy;I#z}na;A8yI%gN96evlNLqGD8&;r1xIFVHXU`P!)e>LWDBnHi<{HU-(Wtz`C zv`selagn7Ypi&)$uM})o#0N_oq%bOEJG%WSxKy?BX;Ck<)0pZ6Ph7W3IZlTg45Iqk z6(ouX2(rL$TC@FNFxIR8%`aP~1R5m9YP~`FDTBU&TTqHapml=^l(db?KI*`C`c2^Q z%b71kDHk;pGT~waq$0|IipvhQ<^w1wO6mQ>GxmTC!0%x=N7wz}$k$A! zQ&+{#i5|8|0LyK_{_3%rN?|gM?C3RqamY~h9lZQ zxbYdn1)|gX_i|bjoHc7$$Ai`^!* zy#_uHf0!zGE1D8`D>f9#K(5VpHaEc!TrehskA8&BN{(BZv`!KUUD1YDr;M}+QC8L% zio=v{6n-#(+L|B}^#(FRxd45Y6Y;HLhivGN9E>6yDk*C;C8aRLj^%`63}vu<6^~ra zfc6-Xbq>xJmz$(*G$}ayT$N2R411@A@i|#fM$%yU*n;HU`59P$P>S*kZbLrC={MJS<#d?tFIcFc&3r`qJkc6%;e?w=(sDPQ8e`oV z$8valaCYx?A(H^@)^;E0v$)2Z#W|BS$yIraSQ!rD3AA#MyQv_y6TSNhp$`eg?1ka+ZLD@7%q999+$Z!t(3 z+rpeKl=r!FQKP5dmTG}1-9lJ8azE{=-;I%J(A;Wg#AGI&8HS_@z#B@y+Zt#%4tG3&2Fs+rVNR9pU&PT@{d?GdN6XV2@! zrXK5GDzbcg>}aA$qhUQ0rPXeytNI*lDB=u!mU24*+&g%C8Hj2Bs~TOYbw77z#3||GVJmIO z4IHRCK0VtnW;*;k(BA$&v|d6>B+Wa)*>?EMVUdW-^l!*Q$~V<3^IaVdOl7PQtkyzD_iUUqi;VClhRq>|%nX0{gx&D&JS*2Mm@J^^~CO*yPLXt%RPK z@FPL9USfxe8^Xhd;6$^rezZlk%l=+bh@2$TMbtYZ;xiGnRT%fJ#5U&K0|`bZ7UsY; zO^9q#EZ2SCC3b`V1O>AB5wVi@T5OT~R^Z43;JVVpy3W6eE$^qLFx=atIkz%Uw~-)! z|2uY#V z5$Ew{;b~Y%a32AqDEdnio^!KS0pdV`5)iJ-`9LPXT+7dSL81$-oTk~rpoEEIy z#L00GBu6y}0Ro=GvA(5X)fe@HsM}G{cl-cKU3jfnRInYldGRdZ9C)YXUSbaGoAw*| zP*!zc;QhGP%7{>XNqE#|5txt%kv#ejTqpSxIBTmtRxgtSNDgVpH zlbfN{zBYR0mg}5xt_jwp7V2j&^vuKh_s%}pd}T7G=Rg0i0J~ftGBK_31T<+#APv3m z8Wht&YAA$^uc-TLG*C}`OsjPDi(3?u&;rd!u_mQ~6xB~me(YT^5>Mumj0HO%=G(y= z@ZUJjyBo7|?W}Lr*q9)ejVcdAbH2~n3atoBRc2^|PtP~^>Wg5ZbM@d$(^xOJCR#wz z^|V45`~1{(owQZ$F0+TxgFs{Nb-u@ z*12PXzejcpak;kPR)|=tw+pV>6B@?DmTh^g)#AcXyTEBvrrJGqQ&Yxyvbgl{zYO6! z$1Sag#8V#qU7*jY5Kz3ToteZk1QltaRnRefX_z|vW36N3 zfcE~nbkyTz+>UN};kwmbMd1=9m8|38bokvly6gR6p}LdBOcz4Z%BIP?V<| z0|!t4SxnOJoE^EdT!Hnb#PrlX6UH3FjKg1!(GTxm^78z~y&VXre?*b^$bOq<{q~ds zW=I&SST2T1vJ`tZn^5QY#=Bh;c*F}b`gm{h3Zf7T=i+Sn-O-#8;U*vIgGX~hG^LryWuPVI!Pvhl(WxQnM_}})XYfahzdC%#2RfoDJLPN4` z&m(n;O2V?p8nwt54yc6G($WN@R3f7q`+3dT&|OUIPBs~nnUPwQ(?u3Nf~Jl*V7!X4Vj`Elt#XRg z7OiKt#dR$bN=OWbVSdT6HFN2;eXR8U-kjNFWXB0%3H{eT`nMP$tIM`p+O4DVOg+@m zO45ZJMgv_bd#RSl-OowpkjO!TndN9^=J|q_JucB6kO8n!M2F%;;A3B%kFN~3zbj&7 zXmKZ(z6NAD45D19>8!m|SJ@4$@xatJ85Q}6QHr9h$avye01?xAg5IMP@$%nA84 z)izXQnE~k&M@W3848Y+W#jKf9B}nD&F(M$V>VE0_kAZ<}Kd}@RPEY;b-Aqg(RehZf ztDu3W2|YuC5Y_00EUes?XgKteQrdX0n1QaYdGW zZgF+n_~&{aj?;lRm3sVvxQm7bJB-m(*ivvQczpd7)Hf1QNeX4B!#>5(@n0}B^<>`@ z&U(IeOiB21k+0SYul91%dDZ}uw~cdVF+5y?lV5{#P8C%h;{mllnHjNN6 z?bnk4bzrwkQQAsrI>5C?Jwq29ZKP-Ci1uU5WmP>Zr4=TKckgi$QwpCk@r5T-waP`$ zeS(DWgm>lJ64*%O+_FNph)xV?HaTKX*3#!1+HzbuJ-&QfMym!E9tdD$rT2L^SY+nWs#U$LYF14xf58JBv z{$^HTbp6k`2(Yp?b@y)rWYR6S=Q;N9sMjOBCSC z4xh>G_<-s{7&)Vbj>atkNnqc`c7cfZR20DQ5_?C4a_C4Hm?ce}Q&Eg+MD@d;BI56J z&5RE*9B`{N(9?uO5%Qk2Dkj`J7I}&6$)Vg>i6;*EN3Yz`Tvgu|=gn}@joNnOxzzT@ zYXc3*G-M8y8yJ+>=xXt9YncgM?|ICB`3~|7e-So9`-fa4q{(BoALJ}b$l&ClmFA>e zR4}wkqBwssBYgpqmf!haxCw-0cn_^Fzk$`95_hS}XS5-LF}%lSgx~Y5(F?~yganbr z`XUpR`U#Vrl_n9Ts7NBtN{8SJXJP^!IRIhOT7v6_;4zYUM5e6|+yr#U#2rhrxmeq9 z9x^s1qsACAWgOq;p9&t5FeA#OM?v3cQuBF|ZE=i?);6*R<1{9fbf=V|Z)S!^ka{!E z$0yXz#bEly)@@SlLZ*SR>0lU!l}1xK{q=@YvTruhvIT)k#@neY9_-E3EjGo#64Gxsrqe z?}I`zOqIH)ii^-QHz%QhEOTNl?3k7jmVXTdHfaO6o7Oa|3fPS5-=yti$-r>ct}J9r zK8A*hL6~#10oVDNth~Q-QfeWMk9fH#x1ioE)0T7nrlxH))m%N`QiHtf)xfP2r*7-j z@RSfaR4tz78s>CqvT|nj?FighY0o6OpUDQHAmUWhj>Uo! z3F#wcmsXJ=xCeH&>RVa~B=Y~TyV2ub5u507%dVe|LRlHrxxA5AZQB>|uQ$;WqFo=Q_G+3LX!^z|yM$%jz9BQAG#Y(^Wxm8B-oqT!65L!MOSQ*+KN#VxtH040 zj?Oq+XU+SUZcAK~@{0%>T@0lpQg<5x(9;khC?SEB;*B$T^ox7p_CXWx5scy@s0K+qvm-g6 zExPg=T;jy|5f zQF}TGkpw1;W{RjUg_nmj6n8|{k`ow9Ee(`a5fD#OCMFIny#V&#!`LWy3AQ1)pJRP0&Ab;4t z07|#up-UtwVrYM9l3+#$p|Xu?CZcDRg5;9?-j4UqRO^0fIkKaGSGPHO|;0bTt={anO3ww7T$`>LK6GXmbfzg%-uw&}I*-wTgV zL;Nz=M?+~X#3AL8%@rgIAW+N6=%k}kDq>^5zU8!s`?J78T$FKU)!IfrPF8o(0PGzi zxSr}Uzw_wLAv|}en^u}&B-Q5SES5Bz76poAEO}^SxEtJ6m;I!hw9=wJcyK%@A#?=1M5WXhugmr){T)+3BGrhq|8UP{yHcp_@->OgjD*RUHFwh_NG)=9=7rMbot& z!h^;7tii4qL8CM_P*m+PR@0uuQ;)_6rfTf!roQw1Ciugf*QA;5R3BY`lCT9Z9O()= zuHf6=&Ro3u%1mL;nwZ+}Y&xxesD=(mUIdgF>SS7jR}U_W9bN*<9)^8nZ}6|u&k9eD znD_t1QL2#)bYRp!Y06iWDNDjqkQwa?qz>J7zH#pZ2Ulh@dkT~gGEynE3*8yPBuaPO=glW0>Z9JjpYIZy#w`2 zTQisTmlp#MDoPx~zTpRrno+e;z?w4&6KM8H%>e=_rlNxemkB-)c>1 zodd2uG}eR-;&HeE1~@nE{&{m4lKaZWVEev9Am%)MCOeoR<7XG|0+lD5m(m(f*`^JBr1mKaVNsqA5 zmgz5*a2N$$qXFk9NSHbevA=gS{^*=Y|H_g-KToUWRT)UtyOsI$BDTONq%wVH!RmgK zoORBam#Vyg?}Urr0iHLfU_cHz2ey08pU}0!LnK+@#H1>G4k2MQJXM zM*J$#&NnPa3vc@z8OT?%wK3f7@d2tJA5RU zhl#?5-ePX$CnpajAZh5g>{%t-M(e50Ann2J9wyDcSe-M&NH)+$3Gza)aYHjdAd7^N zEc9ina-+sf+4JYhdjGl?2zYn>RWNqaxd|iQllHE~a?v&5h=2}?NU&fZ3aY8DHLv@3 zJ;gQ5d4VhVdQ0_eos*`!ANu##%x<`_!tQ^f(tqXqV`O9fUl(jE|5JnT|51s7FeM=J zI7jJqxn*VuU#%MUW$`JXAw#2z#-sCy>1ymYJ{fJI;2Nx_S~yU{?97SJ_f$^Y@BfMl zrevQUHJ=WW#lVW-%t^Vrq9t&ULz!~L%&QRZFI#q6OZ7;j8#KCgNV6Z`Vr*M<_Z#Tc zfAs6B90gUkR#go#Exff1Rh)90VIjn~d%e2~+Lc z-lk9qb`dtvJ@m!+XpmvPlsNjqv=vY3?OYLJi;>Fy4{i#77KmyDgqduiErOPy(1WDD zpi(SD(+OXx75gGIq!_OpPm6;|atAr7L{-{j>|~m%A8oS!_1>ltP538L?#(wn>@@4@ zvK2hq2eu>eF4=5n#IsDsBUSGv>xUj8ZT;=)d|S$K-v}jT3`D~wW8J~7%okCZWa1<2 z0%#S0a`iSP#4)9Go56Abu?yTdbA#PW*b@>Z^NIPK8c}@AasN zBA3B-*a=2lPl1NEJ6f)_vwJqvPB&wr&Po_d$p2%u@#t>4R~+?^uKJspz*cRiuzxKG zx(PYCfdjU#I#Mzf* z!G+P|oJcK@P`ifPj^=SpBM&z|62E}wKp*gPJxU`bJ~=oaNlDF)+($NyCD+G*_xHMy zw8RZ~8Ag_GPuj!5>ZBkIoOHq(C=uW$EKJ`0)ypFoJ?qBNj1qlXm60S)NPUbrV|TbT(Vr+MrX`G*AJ+I`y`+Kn&})15O&pwG zDKH3xu9&}{%B>ZEfdnKSJaqxz8b^-RMV8|HPTtyetriYRAepq($Lw-6on_oF(F`ee z2uI>vKId6)5){Ox{u`D%7dJ<%PP%jP8&$@MiV*7~vJTOKx?22&=gbktVYU~WW(s%P zkgfqG4i)NKUMddQR36APn(qbb14WL}I_G$)Zmv+MV$xNkJMJ{jhrT0D!bn@^MZd#{ z;Vc7_DdI!F>P7O~g0d>av5Ym1IH|x87t7U!fm5Nmj7`|lGzfi`k&KAbwGg-K#fe)! zoscdzAf~8%s}}gH2~r&2;ievzR|(>W$xxl}P7TJF*0Ot9G~w){5|HjVV86vCnPB&@ zO0kW|z{E~Foe(|zy+{xhJ=!_@3=USa1ofU4sF;k2{{}y*lW8b9K1*MD4uPYo#HB>%OMXCrnrkQC}tnq@qhGu>tc>12D*f%e_vV^YotzDMV@vXGq*Y?1ZT#y(?2Me^}Qi-M!GEMHPZo9*z zn;Js#VX4-#BzpUbrJ~;~M(uXDft&5!Aa_z8?AEtsIb5P$MYDvbDb`?#bipl9^1QIx z8&R4vEKEKW9*NPGvET8Y>A*gKgeHP6CcRx+a=}H>d0>A6&CxxU$n&leJGwLlcB(H_ zo3#Jjcia1hC|wrOq(c)T?iHA6HhaNPnACbf7Gv+Ig8|cy37cT${RDNyIGvTYX#Z@*OV(DlU%}!%biFK zk13jqxUmhQg>7y*1Zq*Av`Dc{Y8p zsL0bPKs*4YP?XQFahwUG3-qleHzr2L{}sHM(FDY9v7!7+^*gw7$kcg{3HrapPPuO?gT+ccS##*O+ZAW|jKDO&;IwoAlW?!^xna*@TYH-hZ|1Mc%+C6LxV&338McpPl7yi6TjoV;R)?WW9*+QK*-D4?i3&AB zW&8LiH5O_uHFh#_Y^;qm5)+diN0nUw>eLl<@1l^lBdy!3F~lK5*u!PxMYiMMrj0j; z=9ae2C(N4P^|piJvTb&>?rxRys#GLe@x;zQC}AlKU$wlevVZLxLEuwWUAFfqRWC;; zz@rPL5n?fdsZMy80SmV_>2%GZz29frZrXY#1j}ZQJ?jM_PRza{^+#p-Axq(aEdx%2yHDr{4aKf%491Wy`J?IjIdZqlXnxl z{DQbL*?XbPpG>SMNyRD$9hMRD=WU!YwuYppWv94h#h`yFviB(-0jGdj9Yu{&Bt5za3kw@2MhP)zXA?(y7^U%pCP58URM3-` zQ3tl_`_EVH5<-1E-oHc4ncx48qHO@DY~hlk94qvi!Z%Jq#gPKFi0$@v^wqJTOOcmu z^i(J;`{l^E{GY{$%s{g{CzX5Y!EN2^*1e({KeA(C^xmY7wda1!_I788-7c3KP7e-b`FlhVP#b^3d zb0DnDYdpFzsT6MW6cMXs~ z6%(HAlGLd>{*6=tc4^(0nBm;LRUd@Iry;7qu(I=eDSdc?$1RfV%mei~i}g}@s#B53 zlhdYTrW{m)#b0^9sq&S1>wa7z7n0S(!ZgajR`0$h<{l}+RcB_*Rn@75f%p)-nR?@>A zzVY9gu@}&oLikdQ&*5s(xq<&FW~g@L9jpB-ro}4jr!ijmX_|3_fs3VyryS9PvFva- ztgQ(RNlE-`vu_iVA0%O%mu~2x&t5PoN|eBQcXF22lqUxWpI{lMkV!EJCg3sTRkQM* z+o>Yxj7W>c^hj?#1yb#wzuqI8fa*jO-Mz#((LF)=U?vT-OemqjU?gIFsS~7Dpe2fCU$z4M8`=v*&HNjLXT4Uy{eUxcu90mdto=zL1K~&7>;A+@+UI z)rF;$5(+P;{Ny6I_a)wkxIafk({i$%;n5MI9^@ny1vc?A!Af@NQapjYVAZK^K$6F&Ck&TmlY$0BTqF+TtsHul^DvP`8wm;X%jxR%A*gDY)R+dH2ybvId`2 zLPAIEts5!U8>?iP964iB)2Favq;&K^BV9Yjfm+WHSKvj1!)V!Ui>X=o7CqP1xqHL8 z)4Gm_AlPnj7hHIs=$t~bS!XW(?H$WQrD9H;@c_hxd4%mQsWToLO|3LcfQq{mSl}kB zU*<}SSps})oyyod$!ocuXF??zJ1O{+eCg8-fpRuh?j~3$03XILY=K{C6r*~Nl{>x0 z!b4eI8BT@Z*9{V|zWLhvJmUld#nOgm?Vw?-!BGvYJ>w1E%B}re5C1y0y1Uy2rRVIt zfKzrG<(Y>jxJ%tys1^t9gn`<}+SNfCY35Uex z-4e3MknP!vtkq-1`Cw8*h42)Y(FP~_KO~?^6Q!;EXtrAg(Y7_-RiSj})c0n~M>#?) z$gJ^8T?77@^FDjKH~YYtq+h|lgA4-ai_89i$;Voo4@yrU^>S$6*$!XAyRW|4RGE#LmI||AxU3L^X6>I)tnQxa|-`XNEb9#48xa#iEq-H-V{3CD( z(mz+sl)Xr>W(%8sPfZng)KG1OG_JwEylIaC^;cti&yO}?IcelrJ$vnhMx}Tfab&m@ zCr>eHfsmg^&jhA)>Ycr+y3J4fT$Sq10hIOX(TSmc&0|)0B(;84z`@SfHJb%WDO-@}O`;#E}0VaIjvFPFI-O}>N+VRQbB;P4FUxgMx{L{~*WHs8EJ__*7 z)mKUoM%hm!$tL){;Xxh8ooSN#koG3rWXArusAgp~?sePsw$Nfd-8UT$^1j@etK9>) z{QyVxE0=~QikVt}cfUX5oas-ChH1$=Q0fXK1Od4e8ETleALw5iwff@BPH$--JS_NK z^^>kmn%QJ9H2=qynNFXWM1Qks`=njr?!dumahBgdGu@F$$@A$1RD)%ZbP*=Y?;n+5 zy45iX`g`Mi6e^KWm3m0{jEb}7O%Jeg(-`>xyK8@&Gh5@8^T$ntGoSXetA1h4UCVE$ z8nue=4Gw&C|FOYCS88~GQH;C;T4B_^cgb2%9F+W9+ogHt9__`X&n>K2I0||L=DtYv z$GdiRs~vKp3Q8e>%#eQju(y6}^7@Zw;wq?jodeuYs>iCU@x;Dh-U3Ile|@xP4NgB6 z-Y>!PAD~~OV-PF&K7RUXY^uNyzrHk9v>sf3Msw5UyQTfzMpkjirFVjDb_NC$p}iqa ztGz4&7_om0)*>h>&5#WpZc9n#PnCiC#ktST_I1Nih>oERvS_ei(`id#>4?aZC?&@{ zb8;

s|oe7feMHs9}kuvP({3f!$M|7N7eQAW%?6ZjW@;{d4J4`lyyC2os1cY%`^} zjxh2`k{UgI>=$Y}X|S>CGr zDkJ<}#k(eYF(rw^Td2sVmPm49U=k#Kwf;RLIx+}_F^~_?I3Yc-A1~6B49xrK{Yr}H zdMajhMqR%jYrt84{o?4If!kgpPa;%<)27-$_52 zm`>{8IC|?LQasd*tddR}HF;wI4>Z9_o*WesMhMNy5tT8AZa3;38nfPclfHnfN*f(s zJjd13_}$DxE;Qr#$_Bu1beC?ch)42J?)-jt)OBVBv$EXjsO0{9(Is%W`+7y}>t&R` zm7$)a8@lobJIB)Y%(|owoh_%84Rx!~A%K4hA!C=gseDV5GInr{-d=sK( zK43J!>~ZJ#_!m)7w}XTD+5~#;`u*I7!ZbBIu2ZA^NLL8sd*}@hX`?b!@1TtPTZ=hR z&zh4S1LK)NOCwsFOODe$Of<~Fa;;$bL&QZs<_U+kqb0R;oi;qa(7%Ml1SS68fN}d^ z6?(Vc%PCt#DD7xVH5RYRJp|qDaclyJ}bM{e4yM z!F#m+!J1>k>c~nB5`7Hzj{K49`ab#^Bm3;r==~a79=nLDvi{mQa=FEV3g-Of z4NV$Wj6h{PK{5}K{Jd!xUSd`b#}Cn$@jPWBLD&xMh>8GZ;XhpjGUs7of`unZo##f# za&>;ccyu$>)~BQM_4$2%!ry^~!VwT_3HSnGfdK*3h*5ah!eVHcb}jO&nN#WdCKqRbda zUI${@Zo3<#F)S>zIFJuAXS1)B?4Z3Q;}MctWMkY zV<4sq6o!hpAzukNz6SOuT6XqulJ{X998Kn?p!5sK|0#GMPX5g#{VD_r zI&1n`*#_iK{JUeOhh52^=8`8f_c`uny-%nd7iE z(HI4G@*Ykii+}yj=kB-`75kTsCNM3&6q+o!g9F2RDLT?TQ%O;tTg#*OW-Q|3_a^?$ zv+Gm_iQ!9n=}>~ay#XQdT2`yjW(F!+&5tdn4i9$3mJ`8Y_F1xf9xpPX)PAk=dFAKv z^^p&yzrZ!;j#cr(-cg^^a<$F9&D9rOkhJ9f-(gXZZSD_~(EhBywFI6#F$*(qXn;IW zZ6=_CWX8Ja#OJPVUA7Sfa5sNaz2vB}22kaJ<-a%L z%w=bmyuT&k4hU-TxNZyl2r(U+oD7QHOc!k7Ub3CAyB&sn_X%TMvTR158a#Nzmww8D zCWa@bur3RWivZzmt|5bYq+t>7&CICGXhc<=T9_84)wDgnzs7(#eUi-q+Po^;D;#4{ z@~iL9J28rqP1nqi-kD{?Okz%9!)6S+uatf~@UWBe)>wYfOoL%h(>^lAbexrQW)Eeg z(xi|L^rfbOj<-*R2tnTo%lLZR#y7mN^;_n?p{Xrf)(nEc4z93|p`djKCv176qV4K- z({{5)IISOBwY2wa+m*ZKTYxz8n8d+@TOQhz=Y{tZOji23pq=kW zJ1u{vhySFK|0@nBGcy<0|5V8{nwn1kIGnz7b@Q8w^hr@sr0ox^S(hdhDH}Aiy`mK` zv;!C{yv?L!=HEV@3xsl3MC(bF>(cA0U_$x0`aAG7zPfklK?1##;Ga#)t$IFAZSUtj z8V;#w)w@+)Vd$$g^hv^J%Ujn33Gp^xb6tJa!Dv#sGHWqSH@!cbVJ`ogrevFn2J-rT zc;LU+R$MlBHN^brK0s%_D|E+%B{q!#SuNv514=RAbEtHYs@0LAPDkN>?)@cVOU<@3 z>NksTccPi~!Zj$P?b^ERM~a!${2AvKU!mZ+(PY9WRj(cr3XdNLdx|NpZWnG9Z?&v4 z!Mk%duFreT@{8lnM87Dro73;gtA&!w*bG`@^I}7L;DJF7VFkfRQ+cCWFOtPtwZ?AC zg}qgCO=xrO00g!7iG;8zvx+`evbwern-k6@9d&`iOVr5BSxkXGu9!y1G@~dbdx{2P zyg3+wAeX#RlVM0{Iuz2>eGk-cOAMaEK3Iw&)GE%W zmlZZ~K2KDVyfTjL*IoK$yjFYmL+EN4yHIMLFNl;LU-k?6Hk&Kg)@PSYqVRO9z+MHIw{+tXPc(Yt9ARW8h5PmkT< zyj@$_O&1|GPeo+|4%uiO``C#TdDW$62QWNf2+HD-cZa$Bu@T#?6B42Xg0Q8-6@h&P zJ;CCXgw4D$$aY%@{WH?}vkVzGTgD4}Mg-FvETBT^=-DW9`%D`0-S{(GurKJNkYL^4 zn}li6pbei5xZ`IHf&$nVq36Vd821if5X1#4zC8b?BDIZ`$Zal{g7g9HHH_mS&>L&6 zNuib__z2-=n?|4<41{7lQ;!nCXES;q+ya+FBAX%&j!Z|vAa4;s?jKddyQk&40pvib zeK^%v5k-5-f@;i(wJo3=1>w6p1e2WSz{xp~ALoV1ynpL1vNP>QNKpQ9sQExj1wqTa zmpXBPkoc?>yK#4ni2q~g7G=^trF4z9*~*`s5);<=%;MAWK+% zJu(Xk27jl;P?W7etQxg<8)5W&lXGj(f|0;s`_E>`W$o<<0hhHxzibe%snuumvVliiQ;xrpgUUEeeA z;b6ULVrPGxo@8x{CbxPv4Eh$Ht$n<>chj>;V~8efYB5YCDiKwZ!W72e`2<}TM*6O| zyU`2r0QuAaP!9+VL&2ce*N$w?yMX3O5B@qXb^|pzfpjxYq!o^S&ge!#q7vYhH`Nuy z(sRIRJX56Hp*OG>>XYm1lk6q2H{rDX?sOgvtWYBmXMDkIy8c4XC!g~VxC%pBC8j1Z zQM|mpf*F`+r|lsU|2O6{M_)AO!b93<7;Rs5%!7=$?|UE9{o;+;;c7Cy{_jptd^Z=l zvrkwHU9f4d0`%VV3Jn7kym)zXYzxAlRKZs!xjlu>5{0 z9RfG(sDw*gF*o-48A8;n`Kx)>p(RoOQmlu#5=VU+Wx>1WsAo@9eMD^7`D!!c_i$}q z_XYz0qC=S<$|x{CEP3ig))?VSI^HLXi@_!WCs*lOIk2Dc{MS$j{EP3=-L#1gv2<{i z*2-sjwPV{Ld&CwuRjJD#wYL(d++?r-F!TCBYJZ8VZQ!yO}o&Lf)G?5;b40AERO z#)q?y|7-@ekg{fgW)2zSGg5st-MSSigCxjBO+d8N>pC2nZ7CQ$2ZEy+KHTMq#wefB z%RrEI);mSlH;-qgt-#)mm0ALJ9x3wP=32?gGD2zwxA!AQ>I+Vwt&iPVX}etWa&=Xg72g z?pT{qvT}&Awj!w`*oxWoEbL0{5O>Ram*>(QxKv{XM!4;iI=6x4L}fHRQy94Wb@|Yen3%2o zH#=j#`3ZNc`L5kmiSgu(O?XH5h@5y2cR-^cj%`V~!)soHoWVGQZtg>nda_H8(rX<$RZ(2@MBPHVSb?w<;t&2u$ ztnZ!?t1IycRZjxNZWx_|RG%awS<;DB`1eLzKGx^dSP%BSDFw`F4KqA-zZD}C9XoMI z1|h_bIa`iw2XYb_y9ItCUCeU&Ju5No^Z@k21MZW?F$`en?ug%nOdK%Xm09$Eo{B}} zu*J@eSZ_|E1CvYwJtxUH%`Gb1G(_HdOkhHX#Xb#^Sr)|ti3h?<-FaSa@T{Ib zBI|y?j;U+)|2VhsRr_{p`n(8LyH8FwA68|3pfjlHH2y}f$~td5{MyEo*sSCDJxS`- zwoO@**q6Cr5GO6Gy-@X{+l9f6{ZTuBkl=06*)pCq_B58IuO4Ymn}+i|$`*21`_hGI z)q6)Cy-}WsuG7)LMrZBC6YbKq**{0jg@1dqu9W_9RS*6y74* z>tJW~%4d}T?iY3EypiuBJc+iQV=noR#gOzje$K|s`VjxMKl8flm7;oXwzCk_4A^q} z4bBpH4sRfk6j$r;(PZz#V3O0G)Ce=MRlifI5I&x|!R6P&wyO}VVUH(*drh}9D zl|$2&{M9SOj!8tft^~s23TF!|_R0M2<{`rt6I2YhmenwOyY5E|mpQevZ&1B2#|k7* zu&I?*Gvm+;+*4P2YoJlR3Pj|@t*@(eiR!Ux^oDj~wwj00j3S4^k}kn?t!<580C#xy zD1ki8nmz4mKgiC`o2?EWSmy)o>s`GGY!#u5{n8Nk6v|@uXV*19c`Lm7E;|NoL?q=P z5P~vGipP(?S(;_tOvW%v0lOIpT=SW%n3X6)xsbSsaXj-S&q{2o!jc#Fdz+!OH9-Z_ z0z_tBz|7bF%lZ2x74P+8LPx0aY|FU;zsFm?(HvGtWn5QbZq`CouV@2b4eVZcFmzng zgjdk72g56P6i@lxV58c^G;CBYPhUD&lEE#VhGfWNW@0hQkz&-9_3`;*vE2lq&Yl_L z#m(;VsNJvnwqK`GCay(fc2|!O>X{89?hCuOi~g74^JK{eI(ZX?Z%T#52F!?f zsPIqjj(Uj2mHlCU8km9#3PYFXPMn2FWNK(+%32J?+}W`b<_uf@=5rlx6~qcj1w3oD zEsw@_)K++2+L}v4D{8Dm&5xt3glQ|$z7X@pL3{`w%CF6-I`pmE#kW zDp33R7LQKW5Ime8Cujh}1&L-DnF}u0gMRB&V5Ovq-#yYH?1s0~#>-cXT5Zt7=M!^u zZIqg|j|2^TaTKFHi`0LC$4@K3-<=R$mu;^E*Y-fl6^FyV!HpaoQh3F8R#i>;CfkR; zDKb4^Z692HT(iLp0wt1Y=Zv9(KZg(h%<1hzh*kc+4%u4P{=scO5}Z2NPTaAFDlMWw z!f`R7HttlcGc^O=r~cfXu%*W^$?lsC02-&07I3zMAl@(db>21lrvQ0tZAU?m(#a8s z!nXTmJ`=hj8k#46z>?|J3nVVln~Y!kV;8LxlAH~QWn$6or6>s>jx&7{rBi%ow=)z~ zl5Z->Z}Un+U|LulaSse(f;RxKzzYVAIDpF2Bef)$;#;*#b%5X#3?#LF{+1p_9EsJk ze=oStPlzNLh_2|G+f*mD?x^)}-(x|l^pJ&#PP;tNObbkiWH<&u?TF;S$bZ1s$;NlD z6JU%mcM8!zPOR~^M&vzi`ezL?YK>oAonuC+Xk>aHJ@4|$2od;AKHsnlB5f5v)&+Id zhY>9oQVU`B20^|FMllf3W_|JFo|VcKj8H+}-!22C;&4TYEbJ188KHicm*VxvAQ%~yaaiQsY1a)dg2lfd;zWD)Hg z3A%yh02RBo;VIoo4|NjW(aIFrJ=?2xcN>D{@~1{VcW@eg7y^BOapl6crasw7tndPt8%g{;e!O0!zUqkyBfuc zFR@LoWCnGsc?QOW%=F8Khg+osS_84BHBy8LLDL2aztq1yiNZ8UMKMmq+`jaCY1R|+ zq^7|%s13maeK!o^RA75{ga&ehx2gb8F%;sTV^O8NMW}xPQPn`C_O%GL-8c8m z$@?fb&v8JO=O|H1SXSX*EaYy*D$jt6`cl)x4CU`s38#=~YHCnri^o3J;VbymqR39V zKzwFzMH%Z??{==X8)^3v?IS61Ct+gjne0a)97~Sz`zZ3&MaTue5NQeY58QGBd%BEZ zN=x^@ML)*q%ubhSX}>!22S*)G%z61dl@VTbpI%HfeE2CYJ+;`E4P~S{TIF4-!hYKh zS;T%hbb+6lqrA@|aO_>#q(QC(8p~$LKHKS9=%uF`I@LZt{E<;9HoQbA^()M)1%a8< zgzEre&pvaCA?@d#e}_IE0c9XGMRvbQ0L~t4Ug#gnpq(v8QxxO#j=Ya-^4>4KOGe%R z!r`^uTn5Mp7QlrVVwqMHfF7>3R`{OOo6G)fK4*pavaS6r3hlc?@rqXgSyIS}uqj#%g7<-BW={G@|; zLe_6M3NKnv>b2q`_i`aVno85c7t|?{_-;bJnq9cgCM89d!L?3DjAVJ!iDk^v@Q2YnhRXn4P4=Zi;0lB?)@7 z`BA3_0$64uR|K5;tA;ci&FTUDZZBev-A~Q0*qx;7>w|SZ457S<11INO>Rf%KEa!p9 zsLhok8CJbnu4J?BSN(t2iNGdVqM{Fb=!qEZXdvZpIK{uK*bX;rsr*1AtUc9N%b&6Iu)eHU2^Rw+e z$L$NM?)^Fm)WaMraq?3CXf-{we&>ok4$mQq==E+H4MezCnAtT691F5D5^m ztUeRo^vXpQjrhi##B{pcg(#9SQ2!sDyuLsv!{5;3+6;px&HYin+TE?aQxr#iT07{A zTT3+OUF%@fc@;P3&`bE|TiaFDXn0HRo7p-O+T(9W9N&+Hs375Icdb^pU-(Z(LM?TJ z8ZtTj;Ubt?pwHQMO1ILI4@dAuZs%>=++|*@)Qzvwf_!x|vPUT$*RP&1WU!mc0?Tg< zb-eU97JA*1z_c0Q1DWhv#UTc?uT>#_^61BoK!dZZs^hHI*9}p!yrOexuwbh>23tVKeyqftz~*Ewyt}tylt3q0POHfbR(&c9aeX+P8C0UqS)CXhLBDW$oleNP88G+9*JY9HjSsHOB?^ZVodQ&w73_-`DHr%_s8 zpRYE}Phvz!%_=rn{S;keejj>FBd6s7}uCBcqP_KiH5&*peksPIR!XQNC5r%q`#U z8WYr=bd^PnCj^?nYFe6UeBwe$e9?3+R}jOl@74@zX93t&i2CZ z42Q%i@qzZ#_~cIcesc+B8+)0#<;~}L6FUz7xhyaPn0nnp6QR+Ye5<;OCL0La)z)%M zIvCN1_AtXaj0Qm=PZF4wBV?V%s@|}12w@kzWK5YIcdiA`C$YNJd#qnOHxzMR@_>t( zMUffY=ZPVdpk7(LBN?)9#yj2i#jF|Ig!+Rk>E`z-f~G19QT8{#lk`H8$ULU0*4(|u+ep#*e39} zMNMBBn}bvjL+1grg5P8P{TwXkWy?{a^J+qBgPlc-jMTH4Jq#2fK=0~MT)61o1Kqs0 zac+1%CKPgDR+ROysC3lTT4BkiND<+wV}X{KaF3Z?iyAPL%>m1yuUoY`6=lRN_C0^u zu1~@vdqa}YrTl92Z(kFUVx`W?|k89uZ9-MJP zaTEgMJT_(!>@Z)|g`LP*Zx2Oyu#jagrdNU{XfNii`q5RHG<0(;6vOCd2Ga)13gq!c zcnfL->zCy;k-Q%ugcFg+HkXGUONS!fk;9`dGH9RdNZu&24ZHK>`YL3vrgRP34-$t& ze9dQj!R}~_RmFE@DEn-K*Rr6NA5GDSTrP33XUMxK@}N0nb@9>xYuQ9UI_Q!yj&?{| znkO7M^UB_8=Sf$c#^zTKs{+qywW(@^i``tb6HGE#{zX7*?zPx*_)6)tFI!&wjXd=+ zW`wE6^w^c5fAhhTbULt9-^50&?w6OfWuM&$qn0qCs*Sl5Q+au&4^wQM00TupVbUAi z1;j?i+)Q{8`^FayiKumsCP=FsITxl^zmwH-5JavV?uVxDz;`ft=Um(7;FP-Gx2vTy ze^+NCdlqCv1`i7_icKdjrk*uZsOHm&-Q;%sJG8^0cZ^SmYO^scC>(FAb9zg&zI-O@ zj2I(X_5}fB6w%V*z_M^l@x=U+P4TgyYDtRc7HQ>3!Rcxw@pEj=dN%R$O6jTB!ipds zX`G>214466v&ATv5S1(P5ra2lbIy3l&zglqHy?|b;vqzugzCe2;u(Py?as|n15Ow7 z%)xO9ja&SLGR-9jp&=!?yv&oh8&Lf7RAmyPW#!|XNy=?1X{Zu6%HI&gCur$W8z0o( zFTAZ%N?hzSv)7QD-pqJItm>p2wcFA`+2PvSpg!MM#5R@5rvEh4{#$4))Bim09cjwM z{on4}Q%Xo0aqpzF3b{-X2C)S(hIPDVb~p7J09RtSl>g@|f_|fkazooD25=-;gY3e? zzBkJb<9ZmJIoanx2I+0vbZXY+*u~|McH$n&+3$nPclsgfAvDX<#*5{y&nJz z$`UTW7D_DRx2(##OPGIt^vOQYEt`Mk4L+OIS0EERwOQcEZ(}1L7kMn9Tqr7m{{m%- z=W6=BBWkM9nKk>w*VO6aFf46pB$4%6XgcxUfOi@s`VJq@y}a$O)*#62EK}W@uRjci zB{lD*J_M`_4N<0Q2GEt|%D{tzrBZm3(BkC=_j12l!|yOcp-2qJbl3XFa5;^#!{Fmo zvl_vdkRpb18K^{9H9Tz~1lWUeEr^=5wo8KhxkRy_TCbzJO1FwhnP84ZrEcsnD%vF# zF%BI4=;;}LYjN)X7A;HSMjMRQ$N5Onw9jT(MZ$Zne#dEKBT7OY=JKuFGxF4sJ$Eu| zXx~FRh(Ho1@_*NK?Jp|i771>2Kw=Wfj;O|3ncFxeHtYQARM4W1Cw{C*l?MXSD1oY` zsux6wf|@YV^5^Eye&;1WD}lTf7&=@JGTNaepHPPXabv8=H4P0RZ3;i62tPzf_-yRg z^&h9e+_5Anl_i4rf*C|o{&V$N(6eJV?FyXJa${2zGef|AeFH1^VAaF1Ri#c9)3DQ6 zHvqh=AQpX_Moku$yyx=b;bdI|WI{p|VKfZ6o1dHy(kP9}Rl#+F>^jP>lKRRTQ5sJX z4j)Yf$UrFv%a5hYl7Pt&n=~Mmfv`8N=1ijHMv+3P$b4&tJzJTv0IwYlyV~($ZU=b& z82rM_UY{=aY?A(n;)?J2EsK{6zthf;E0ti57qE*2j7PgKk$z#ujL-!2&G03{To0BR znku4DZ!a|oLZMmRRCD%nwE~vtV@>sJK38X+EXj85hZJO68h4HwENcxEFc@5tz2whP zs@?iDOTG)_%#QeoZ3J)|hjP{y`5hr0pV%Nd(+G?OZ}Difjw8vOu7Ebzc3k9x#8pf% zSJhf;yEM3TVGH$wu2K0h&n?9xHSWZi{~yBh%S>{}6s)F3*P6iu(m4EP#3bjQMR{7Q$y zH_NFqSr!r=M>RB2!@>@R4;jS_9`$42tkQr0GYZB>mRSP}*-W#y+7#|$u1P6z*;Z}M zWbc3;_gIVF{WuM2Bw2iGSb#<{YFnNBz&3mgTUr}d7OIbGtr?6F%p(oK8!PQ z2qxy+o&6(D@rhAcJek!48@jylilqpA1s|t8w<%)LYoldved2d&)uU@pazYzKO3bnR zC-jIY2X-=LMrtnI+M2kvxbuO$dZx_ttQJP-#uwHBnxS9v1e^Aw2dP7aX8;Ml+Gy%r zxXNiYjtbYn>epx>a&OS=C{5%HGC2cfyt5Wz+MQL4Rlxz{Dd+sR<|(~wZU{mGqf+$v zXr2^L00v@P&Ubi*Off)_+3emm;-foMoj&WT!vRAc2LqAfoUCIh*d?#(*1qco65rQU z*Cki8J;R@hEh4ZDy1uot%M_d%6wHpecDLiY7Quvs(JamCdT03rXr;@4|L{zD&vu;t zgxdu(N;vTmHdu=H$FoU$b!tOv%G8#k3dJU9VxON&3%Z;P2a%0qVw&(R-wxSl{Yf)o zDL}-9-N|%&Icp;}^;S#_j(}X9@7Qb|dU$9wX?}ZoTCWT!hA0wNjcs(Ye-v@6mdg!O$(hv=K%K(}SuG6SvI^gj}kM_G}JMRYxib^9>`W445uZQ2OC9*i#a3Q(*_4`R% z%X{_u1rTJ7{;lx>x#6>2OPmmrbJvClEdpFFC`51bPbHyDojixKad(q+$P$e{olBHJMxf#so^ai667 z=&T5XB8zEPK%h$pDq38p5Y)3iTtq5z*-GZ4lQQ8%NmCP@%mmtu>s;2n1v7uchuNyMbtKu#e1Kt6_1PlM3Iptm_NRfaxSNqc>~f z=*QPNs?ezHiB)33DIBc1*N{!=Y@%;9u4k*Rri+5oW%eh?T#~;3jHlOW;&aqiEXD=N zh%2cPI6@}F{!F|O`c35a#^QKzRO2-Vcs(tZn~sJAQ|nFM{Ge~$V2cz*`5-H;oh70u z5q^0Ic0Z(U`eo%_!>U?#1*seVV%J}@jvK@-Ph~{@bE(00`v8~I4Zs0eUL&c(nCw7x z*BBM5mZmwepI^r$DdjKKj4l}jb^clD2GZQEsWD6_3hKO$Hgy47|DG-X7 zT(|tee^$O?nPMPsi`!}iHx6qnpR-bqi4+6t%)E1%txKe^@B#cSVO0VdN-lgJ{iSerNGw6t*YM!RC1uL3L!H;k?`nM3%31=TeHu zl>%KQJEBRy%olFPaz$pwtMfSKqVL1W9c}T9AqnOh%wl#^k2_``v4?`u1wG(Q4wr<< z0d8_r`SYwz5SSEcnGmQFpGP(@6IEXqidZEH8=|!$9Hx(WWf<%>k;ADJ-w%v(N(QB~ zFKTFS#QKZJ??C~xhVljPMh9rShnIc0kN5he4Y}JE=_`>Db9}fOrcahvsO%4A@;h_E z>Doh^z}KV9TJ}i!7xuF-VL5Xwdh=DM6^kHG3H)!Y+Kq$f$trjaiiWCn z4n0YrDdc#0-bolGrdltRU-T=%&i!&UUX$Ouz1+{L(D}j-(OQddb|mPFokLCeV{n({ zwCwd$*^S`{%_(c0+!Zq$&`Lb7z=DIM-D3Xf!FpIw@?~Y~ql!c(LS65fI{pJ5{6i8T zI7k-O3C@trLQgk7p5lGK2GZ1LxRP|{Hqgc)yR^Lm_IE;s6za@&LpDcug#4w%DC~EF z|0)!C&6q9X6Z`45bp_S~F$;|xI2}q$eh9L+kx4@>ZcPW8u`7LmfVrp<-Km7k0U^dR zQg`ssXCW=6v?T;(U(tJmNsJI_D5vmS%|DDxxH}OrW&3dk^$nGNy!YfF;za_EiZTS7 z61l$p`uv@Y6uhY+d`jFs3oK{)MY)EJh^Hy{aGq+1+{`&ej%w|OYB*dWqt{$-6k@n2 zl91RG(kI?@>if3pgs(W_S?&A+_p=z(a=wCHKSt2Z+PIOWB> zBAIc717m(#CduG8M)McT=y=<57$gS4n_)8)wxuG%bqTayzC#6!HB%L8TH8F#r77ch z_(=aOTDDegF($rI)Ze0*Pf>T>E_T6RVO99;Z}c6kT)nF+SF?-w6>3cIet@>6!ZE*r z5G(y$=CPNO#3_6uXKNfXa_oXdrwKP|SW=#s?t7MH#LFfz(JD;9#>Y;Dq?95(SckII z;w>vsl!{o)dA}=!DVwFmYm8=?sl$)eR{XWuk+U!6WDAsT(tPKyF~yUc48Z`B`T1P- z1Gd}flK)TI;=jU$GBa{8{?ASRU;Rtmfhdyii8_|vijdSn@0AcQ?PV;OFw}5(+6=#Y zVs1o8T=ms7(N$d8yQ7T)MTQv2m9(w;hU&75?=q@SqG!UQ_7L)OP{h%Iql1j z!iu`uzv?#CwkS3A!E@#7y>?k2kZk}*Y8V*`-^I#qb^LNEdz~tYt~LHu4^^8-*a!lQ z>@g4R!?qH~zpumM(Zrk~#_rlnn}xkM!j6U{MQecO6%fO7DF8wc0`-o?=9O^bA2g{w z{yyssYSJJmQsuho0#H@j9p6=Fp{EW(stLUUz8OW~Eq)XBYAh)w2!4<;!`K;yo4Hd3 z(m^nNe!`AO*9FWJ;rIn&o{K?RAx}yYGoo`wm$EkM z_r8goQBXPbAhc< zieq$fwppd;M!7sB8>U3hR+lMM)P8TMW8?DJ0B`Sl2rjw;62+rS4D|@VN+u7@5IHHq zKi9ebQdN-}GlbiEBjiPCtHP7YqpQm*yK247K{V0$vBPLC?WUrY#VEP1Wi096RCM54 z-X^(os=DX=8-LgBc zVPPoXV`44%&3gC%xMuXErn;@Om|G5OIsy$G_}!S-7Ba}k0Ts`XwF|Vy&G4!`Vr)wj zIo}>2IRf$^X9($OJSl|<^JoiJe??2Gfe&NUm-sjzor|%ix*2-X6 zj;80K2S%J5enJeT*u?i!F4IH$7cft;tGEb6iSlR8eakHY$CDYNPk)j8euVz zMbjDL6`_~72d0e^u{p>UiFp}mg{MiSOBf^x`uzyfFutxHywLZdN@5W#o{BvmVV8Ky zw$js-ZLsCV!1{FmocA$pe2{zxzD;bzWj7Ou;+pUKEjmxzV8ba>EAt>`a<&+Jx0Mns z+dFde@2JIO1c5!eS{UP4gUnvJb^g$a@Ig@kL4*kWbQA;_azS(w?#)+piCBv9a=U|6 zwVuM(i5mKY=Rf*XHFUlyT5$qiQayb9fX1AkRaJ4uIK%t4a2{!NBKNo&lYkOP>Qd9xyc zXk*JP5gumz(LtVvH#$zbxPaimUhQ>iIRk-t1E?v&tru19Ux)JiyQ!w}J25r>JP|KG z7(FqmaFw}1hANbg3{Xz+^7g>aE|!9?!Rz0!{h5h+7HyMlSD5=yuI^?FgvU&!f@OVP z{|Z)mTU*nvNj^s~wF8wL)SE3ezE`nhUi50eYVUj>02b7i7f0Qj22c^RAU%7*E9|p=7v|)UNJ;4I#vNyF#7Ep_)aWwSRU4 zZV*$L%};qY8LxCe3ZByt*n*bAlCYPrY+;pL)XrIRU}mGHlZP*8`lQEY zM+_N^S@3%(0J|7l#A9B1B|-|>Sm+w21drys7cS6(>+1!S4CyYN@bk_jz(wqB80=uE zZu5JATB%?Uf_i?-j2Y+LrO-T?Za)oB2TL&StD0%NXLTrAlTF;=G|&ewL=G7Iz0l<3 zGjv7N3=o-naP(O|mzRz7Zuj6BeGmLB<3kqZ@W5*q2;u$jcZ7P}77J$wu z`eV3yF@+~lMK|LUulwl)W{5o~8;g(C=p7hpU2$|uP3OENhx7~Qd+mUMj?uAX`~I8! z{h-PZ2(&&t;XjBA=Km6g%J{#|1S1;%vhwUmemnXFd~(}XsXNKPFNw4l3y0LI!@JVj z5gTd825tV;WfRjskKMeI$tUFdYk@pfR*Fg5-cI^h$KmcN;an z@>a=Dd(%~wV+)51+M80yfz-ltX$fQNBcD7pT^6FU^UxrQGdp|tUeR=uxlQ>Jo7J>+4XuVP z*gdAZ9@RXWUU8M2N7~QWDLIjD|*!&2b{GkGAh72Zzw1>o00w@PKZZg`Zu*t-BM*!=`Yfz$Y z7XTknfftb#qYK2W7YkwuMM}5PWjQqFG7Q>XUuk7;rl0j z7)?%d@k%q+cE<~H>8v2Rl&1nM7QtsJ^M-bEAQ4Ua|B=iu?^CU@S0o+DgDBc}i;OdP zddBY0L}w3zZjLjiirvH$m4EIyyYXTXT_TiqeX8-~N%o84!sE(F!t{8h(WI&@IQMP5DL zWxS53YRy}j&eE^uU(+AT^(1Sun!H)P5Uom?br{$Tg)3~6X5oKsrEk)4ta?FcoJ^VG z3yih~h%c2q*Z?Lo%0uo96Bs7zR?cflr_SfokY1@Dqofx{f&<{PW@TwkyCT0Q-}3Hz&l-al|*oOrxYru#r5M7P`Mp4t9F=ylCm+N&m{`zV(+ zNH}d20jwu0gr%cxOF52zF{@Iq@GmKOu7nL%fBE@i!q|f}VVeyBg+*~NOX1WW@Mwpn zquk99bYAzsssa(*Oq(qYs7mMlEv&fT)C9jtC`H+T-nk(U9M)V1o4`*e^!DuOQCN!G ztAdi&z#-%*;vo+3!omb?R8Gl?@2m)$Imm;LClLpt_Q-HC)qTRw$eSDQYP#XtW%DEI^-n+WH&Ij!a@LP`?L3@eN>>$31Zhk7eS@Z(tgN?P;;)KqkHCp6nt4FHErndcyx_; zaLuW5`qTYev*{a}e@M~Wn@020xQb&y9V?>z5#bM_oT3k40Rj35hRi4Q$?d`*9Yxs$ zzsvvk&TCHKt8dn|TK>1t^C6sxl(U^3cJHL!Ep?>+J;Wr-* zD5qv#<)982J6#Eu(22*wv0Ml4-ZzW)?H@&&v8GQ@z{0aEP5qrH;TCS5q1Q3en9jKs zM$g-|zN4%o+<%%w|1JKM`F}0B8Zu7*_gro7Nwus2b+=E#MOML*Bwq#~Kc|`mP9%(i zC!;1c)&73c1%i!iCK@{{#`lm#inGJ)+M%zH?iFQ~-jyhd9?(ajYg@R`eEg(~vJj3e z&R?*>U*IjwMk9_htBSkJirH}M%#h_eY4B#sfFat~S1FT?3tzT93f*4nf}Yy1t)N*P z*l$ziGqm((d1L)xLs3agHYeOPV9s6Nu8>4Y#K6M=pQxx0YLZ(A5l$TaetRjn(y5{r zz?B843;5B5TA5QBW`s*7Dn>1yU&GGg+SL&TivOEE;DX9H7n>#9Md`LhHn6Qt3$-#W z0FRbUt2QYWIN7E=*#gkctH-zQza0fVRw}Azk)Kc)2Pm#bL{k`Kv#8XW7+!{rEYRSp z%BdnjsMIx~PdLXWXekpK-L+YOi+7bEpLb7UvVJ_3GIep`+p(0?~!XR|J?%4rUu`7cqLsJlTywjO&%*!3jqS#tPj+P#Fy zyO{QfNLlM32;znZgyA+`Lp<|HTKvTdNqKW~HuTrI7kMfe^mnMFPlJrE$!gpTc9&C@ zcc*4_{$=d)d$%}G3v&IO0g~0Qf{_+76}%9YR5vpr8-1P<%9Q?gM{^}0$<>xaz8nwc zC>m-)>9oa4II?pKWt%|)W!no3<fUD&))JBQ}&;p|xHDX+zB-rgXi|I13F-$swbU1P26n-? zovi0cINDvi8rKE=d!6q7)TV)s2pFwpiy1bY`vkA<}8 zvvGUtGx#;mmgx-e zx_7|)o(cbe>h=6rz~{s0VfD4)!@jeO(l?-Qn^=m}v9Ny5@on3~p$|W_s~FNm!s}s( z4wMz-6Io$P&?!Lnl{hGCRCHI1f~(Yq8u4Yvojb*X85?&Z!F2KSp6BqE>tXvl-Z1vP z553KLpW6Paer6baOXup_Qv!qB?1TD-g+<>DN8W>h7PAYNpUp8opWPdib|z=4kZXOX z?0b;voc=DwXi{j=?HdH_UGe2e#dm>6CSxbDG>R#GK?vEWyW^BWi*@PKvK;0Dees92 z#sKZ-1->Ig0^-%ki}_ow!$NQAmUca4hai zi!AMSX^_;2ubymSN5?xdRAYT0pv(LFlq<-JFX38wHOubQmTAo#81Yg`P7H6T704@s z*%oisegbVU_K+9dK@oS*o#U|3z{`|t&E7C%)M!_JZBNKCa(9;St?wJSLA5Z#e=A-8 zBl?u?KX7B+>Y9$3BFO)2p?lS3hSo1ok`GBI3nhv6B!;cDEx7O+no{s&eqQP4vA65c z5JkfB8l{G_X8y-lt~R^uoglivhl1%V~Fzy3s?LpBEl&lG$bBh_-5!chghRAveK-hPS9OBkyX}f#4&m zEp&REfQIGJu&2bM2u7lc7_=!_EsN-*;bV&wuWy$~!wg>A+%;%T0)mwH6NexW+ZYia zATvbsXrcjCK`=>74y=`HyW7wU>>V&`#4(WVWnu{t$x4iZ%2p^UOf>z5zbz1FIQ6b2 z-1CXa!aI_0qZ7Lt&=HF=Rkj0kL4`tfiK?((C(NQt=Z0-$ZjRioMG=wZ4@^?B3}AzU>YfMs(Cs&Zb3L|@ z-BVgi@#Zh_!$I3(@Cm};5Qz4J=!5wJL`&a7Uluo%H#WR{=ESQkifhf*R?OG8Dmqjo zkEE^0<+J3(>|%nN=wDQr)w69kx+p%6j(d)pnd->0Og#2!cl-jGjci9tq|tFl{5L+bXJZ^S8JlF~$ByVdaGAVz9?nxrFEN27lu6$4gPw2=xcV~+&IE!8-*R5RDzb@_H!2{6h#Y^W28#`EE*nG2 zjB4uQ{hU@VeaXPRPiAsIwgeY4PKMmF^nJo&p!5d}bTif6{q&eQoIpy}=rCKm`tpfm z#Mxuc%(pL0Z8pu5a@zl6WdL17`Ykz7cbwmSUM_`)Xl?+O&{YPhutxn%KRJ`*WX{;U z@WoC=lP;oF+fWXfJ%w;EM<>rg^mUp-TLp6LbkkUyI`aD=O;F@rUiq7F}SGixO!a5-O+h;^a_O7d$Xky*>D@O zz}vCY3#h3s451cBQ@Lg52ay6S^{@f5K2VH-CNp#@Vk0x=Vw_4qow^8N6{=33`>cnCO|BWX@j|A zb%S*;wLOnZ=~DXBiQBPOq;O=!g(8eW^XpUHiuRLWdf>b15e`=y%&E|jH54#VeQt*OsZU9Mlv1Jl_&00*aIfVP4VB*A?TSg-~4kL8=E zlbt6Kh=y)|DEA_tDWEheQP*Ob{Ix3O`90sJe(rp4o99+HMTe?796;-P1 zTFdh0NW2o$T&F4t%j{vKjHsLs@1NVQ8MZ+Cr)?clQ`DBl7-0^#vmoep$}HI3zUG<; zX)|uO$SdR`qe|J3 z@qbinsh(Js*H_FJH=fZfl6Ov%8LN1<=;c(~p)rix=XKUhq+=T@z;@P^jul!1Lm4^w zZFO{e-nS9&J16%n0iLA={<=fBO-+e-z=Bmp!J)2ez7lT$W4x6 zZveZTWe(#5#Q;G5B6#SvKK5f7k{5!rQjEiAJ>ZW*FtoeCrtzOBb$uF7* zt2WwUpOC5#<!YFe$gg&rDxj@HwnVB3ZB5=KH<7d3Lz7Wa8#@1#K0C3gD(JbS zyl>sEw3>F;V2dKUkT$a4Nv2 zw2II9xB^qhoiYn~$$4!u@S!;(iEi+ne;4a|8_Te>#eg5`l66DBFFyn$fhQS*rSc;B zqk7v>?NcEuZo5U}Inly^fqnL~+w!d7hwSlE_Lrx2qX#X-s1)d>AteO_XkboSNJw9B z%Y-rH`A6+>csckd0;IZ~`*RUoGIuLm1NUqD&CNoJSmR)#GrK6Trbqg=Yd@Z^`xZ{9 zEA+es2RkcGC^6UZrliOTYeBb*k1he8_cJ)t?(ki^_=jX<8ytsLVa@nuvm`P8hCNpj z`8;vQ|1tOQpAyS)>20&v4{Ai_)4;^_lY`=ll(bjKOatTgVQ={ceW&>N#&fh^l?NY= z=Ybh1^O|kl+xrQ3Ft*{I7k5yw_36FT7l5)(>%VwISQ-B}*eMgsf4IuK{|`dIg6i{c zfZIC8HxQ#8kU;Iu6=@w0D7A>} zUbFiSn|x#`kO=cLFGT+~nXt_BZkOownoi6_$g#-OzE0F6MnS;2=>34>`_ok@8!*k*D{)B9-0G zEFVQY`PNrr{_4mHUB|Cw)}zdAqdiD?Z1dVhruKo_oXh@io{?x^w_(`MnRb52rvHB5 zwDJ_%!eYsFKa=tDUSI$fLvh9&K`)$yL-x|Wtyb7FyHjVxB_8gVBOJEA?eBTvtacl@uk7~>~OlRd~;X2 zOvetoOh<8PW4O5Sb2Vrw09QgRzdrAQPg3$kCMFWdIhHi2SH|{8X@g23JNelTk$f+A zT4sh6#Vs8^6&%}bc!t8zJzZuOr*st9hH*{=7-6v0b%Z$*U^xIOyE(zT-;=^9YByd} zk9jn74{_<;X?iE4x%^r-(dXaaT3Kc3PlONnfI6q6Ojlur>4LbXvkyDox^<1k#uPin0u0`{uiE(YGCk5 zXi9+uAnc*?p}-HuK)!Js_OMfsOiN)d%XlgRl0O_?j1++%NF?T7?}4ohs~!6!Z28R)yejHD$X#F0XR3JG_OhoZhg|48qnqSvpT*&g+UK2eQB_ z+9-)E!YiWNC~S5GzOhIM9y1a&rLL-OV3n;w1)-n9MI!$p9jqiovf_KNMguT4T|rfV zYk11dEc4R?Ecek2MYD+fRR}(~A6RpCW2>r>QR+iC(n;0j+bG^|?nEP}^beL`SP)Fy zFob}CIBo)I4$ejPc?X|ONz)7)c~B2j%{ktKb-eOec-LS#n0Z6}Ao~x?-Ce96bV?&58?^$*0% zU?)s~RimqT0dUfcTE-+bAp_{jw-{{V3S{=g z_P`rBTx!poc*5-A>~l5_(>n8MeBJTwGQabA6q$n1P%S!eA zF9w{L?knsM$e0+(z&O{a;f#Cj>E=abPUT*CJOCeaSkURkm*nY5);)x=8P)_>)&lm) zo5*%mi%#)|2PFq8mlaqOVx`7Y`02`J%D+5oXNG(mH(G&4eOss>0s`y&RGKf6>m%w^ z2#^e0qw7F}9e?Y9ea( zD2BjqjdUo3I9J4s=i^Co{q7MZ_=VKD$Z@aRz#_914c8@%ff3qHUQP>F?DDD%e|X|x zJ@wXJ$E>dY$wB~l3iHrA+m?ire(6zFW=50DzhRWxG}|}mJ!GI>}IQs~j3lH~mz_5|VlZi_`3eFMEcl3xUE-M~0`&$$hEX31JR-w`_`R6ku zSo~yMm>s8pow(PHr9V4Oi@`ckc5{>yuhnV5h4zmVpUSim^V^eWMwI{FyurY_oM;}? zL|&!ZEWf?I*aJ5QQ*umox5FalspxD|W$&OwZ#y+>`-d3gC%w3=17eKa%^*%XDQQpd z6ew`g2)Mmn`H?n(OkGNE%ck)6oeg~%r(JxqD|zwMS1X>($O9OnY@4~-9R zZ&<-HPn=Y>bWy7IigKpB_G=Lqirjy04o6}5YpSnyuSBu>exJ_%YWTSQ-jmwOhW$l@ z6ilaGdwh|KJdDVL%0$2zYiYSv(V=v>^EzQ_k)IjdOuv<%h?V|R-4M*;`IEh#5{sh5 z_Bwsi&3L>r(ES%<>d#j|xuqzNsdqf*LlVTWwrMl6 z+?69h!?&IUzm33Qk7N%~@1Eyy{7Qnp2-Keqd+z=jFILV)@Y_B{rkGj5 z$?L#yeZoo4K5GhEkbVlQrh-vvT)**8$6f4;m842)Iy@xTX%Vc3b+MLdAa7@-y7X81 zt!7JDC~o+gC{MIw3bwu9)QZsthanM{4;Klf{=0ySZp!evf+p)j3gYZ@RpK6lC$*oi zy`3qU1_GIgw*p(c$HpPTk`AUY67G%zQ2&k#93_WUH@rm{>W1TEjeS z?(_{b0YMahw%>b!jp?_y@5jw?i3z}=w_K8yF_+w!TOPb|T?V{4SMnptgooc!Ky{`( zTKwLx-@X4bWMcf^Xr2GR5a9pm;kN!w{!UfZ4ghPH{&Kz23y6VgKvV#g`KK1a z?P!zIKW|`dZn7Zq<}j`{XWMV!@d;F4tl!_a`apT=TrY5WGJS zi`#`fP>qfcI|nESkWZvb(72?M>#tu-56eR4gNTdoTXuhbeLb&RNRvxPnwX;TX8oF= z?KXdUZ=Nwr>MDQt-}vm-tOylv9`;zN2$clxe;i9z1smgOM(TKyTc!{Or^h?*z#9K9 ztH$^gSfo_d3k4_$y0KKPNFA9kZ=Sxa!Cm*9-CWOJwm5RVrHR(SlTNHJ@7}Uf#w@nn z7(Sqjv?Is3m@(@n+eGOXqc~hmW^1E(OJxv+8T$*`BcTMMATqcL&8k@D#5*}Ut)T4j z#P5uzIR-EcZ@FHd#42Pq{52pT6J~oY+R=xn2$NdBuGA-UHEUMMD&lS7(7ILK7;!z> zy-DA1D^bHECK>`rv$s-9U&DFLusLjdMg{n`_N@A=lHpSKX2UB{Ok24#eXWBf?T6@6x#kW>OjNs04pJm0q< zdyoi{gAjs#+*d#ms~&zbSGQMnC3)DoiU^0*_mxYBfmtVO40|@(I5s`OA5A@!dSu5U zRs6Xak*SJ=0rvoiW+~kFQv!AHhFL?7V?ujfQE#xj)R?`lZ|~x~#idb(kx1h( z6CAx=q3uYfZ?xj70hTfsmU&1Cl+{&4}k?6Py z?W-hxe#M|F0D9r?g%F6y^G~ZSZu(N;CJubaJ5W7@1*oI91)!i(Z~ zu0V7*Re(m-NJDwBD-fl?JSj_Pv_vbUDH$fxZ7i8+vkr!(yXfa&5N1f13%V-NIJ{8r zxQ7%GfhL9mld`}=_Y_+-9ETSfui2B$UtNl|GjPi3nzTPVd1WMil&nJZaX!M&>Dq?kjrksRh0kk<-oZm(Ow)#aHb_ep{Flu^VFx7}IQ=ki1|B3jbPRYz-_H zD4cct1DI_70~SLvf(0jV)ejv-Nl8Y*!d4Ak>5&nec1!PRu2L}?CX zocEh@D03h9!9~O$7$Du9`6nJo-FjxHC^g4JFXg%gIRACYb68UK2I#C+Ed*p^ePV$TtpAhD%635Z%u&@kU=4L7x~V0hcie zy)D_rYi%q~w-yp(8QZ=3gKEH)2{J{;DG$&e3Ae1L+IvRDv?hOkcakosWUnZ~jmKuN z|I~B__yGdPb>c@~`?e>#r<5trmHwr}2hFimc<#(Vr-(iuo;Bs8T2jSrZVQL6sk!!rfp1#aE4%BaFLQNgp;IxoAnOo7c$A~W5r zP2eDxzgXTcmkmpCYFewsBRH5UB*iqZKv>XsiaryXOCS*=6s}gbim8r~vqib)FwOoH z+tGqX-_bXK+DM$%DFP;Y)@5y)+W3hyBY3{@bi>I#?Er|AkY3G61f+v%!v`Bu6)ah+jMEiY)o1Vcl=^j(~Kh-t_ay1 z0Lx@nM6ae}Zficrto&DxRXkB06XT%2@HL4uX8KeY;M1UY9ff~j0_pP#qbU#1D#!5O zp4L@#)Hw;t$VDA=n4f0|d2$(B(PMH8p{J;aD4H|P(Wk&G=N z|6cytwJ}AQ#kO#CHgY!yAb+g6pud2+oLtpuS@3 zW-FjgNTi=S!>lQMnqKwY-TB1+8gt4jvI!Sd^V2Wso>*-dsW*}%0~yiK?*Yrh zu<*mBsW0HxPKUvN`&|4_AWM2C_W!srXjZk3T@-=;+0os%Wkb~Is(sNZmOu{JfTGAV zFOInDN3*3t^?{5T+!p_Oo9SU|S$wuHFM|z#_TYM)Vw|0_377?hHFz837ueIqwyM}W zRld7IfwYS8>NZsV=fUrB4d;4e2K046=5_ru|BACo=)7m;%6hWiEY!}r8B=QmI_1-%> z*p$k&WU!sUZZaQfkZ`{mVwfh!@_%b;vIKc%h+qk_{6sCdmeq^1mWgx;;E~D$Uzi`+ z3FBmS`iQv$Pakh zToycmj)3R~WdC`93gin&ucL z?HNf#wimC$M;LmE2=21ZoT$+{OundDGctC+rBJq=IFVao?ct&;=A(a44e_P`s4`H9 z3^T|V$F00??_HC-l#hZS+cC@Gb$^DKz}rnQ3Q$;)RA{Yjl~BrKGbW_WrHqjG%HT~F zapv-K!jKu2x)7Z#T7YA?aaov$g5w8UvYFOI*X;7cTL^(ZUYOe#pN} z>&p{~zTM%(RD;2VI0G?*o0?XYi9i5X-a@OGS`HZ1zlluY`wUBjwMq)}M|aBcv0%T} zRP?3~1i+lhgb2K!cl`)YW5j?Z_I1nQZ${i{OlZ!qkr^le0!5~akSf<3bbzj)lWh@x znoyDUm0zu>&ItU27|#~mPlfHi=EjR1E#m3|ueGGik-KQu*;J`_gdblgu9-eBp#YXh zUJ0k^eQ`mmhxBv0STC%A-r+oN&f{R|T0OhzSxW>emT)*Kt}rww>s{HW#oF^K@>{W7 zy)inu)wvaQU}?F(gVHTFqyz|4Ebc3J-DOHjP=z*LKeNm+QpLmkGlUg5g66FdJgYvW z7j%XhP5GnW3~(a@bJ-y1dT7V#7=NDeQ(^cg#Wk4oX~$v!OAH0^mWQYLh{^v~kzh`&t8gCYdccF+exM zp3e-`2#lf*@9jU}{-+cb*S<9{E#|?_ zJgK5l#PZFN&M;8S7kFqNIoCLcRa^d9yo!I3C9`c7sO4gMg_zfB=Vq_fUz63nr}ff+ zu5RjljmCouGV6UDFboDZPtx*|Z67i#*hm6$DxL9$yC)D*7o-}y!)kXy@u#)t> zzT(ET!N^JkST7+Va#4$Vx2riFDxfH7QOZ+FO84#C9+VkG8#9$2i}_eDF(;lm==zJF zJp?y-eAvVH{WO!+ce4!=Sh?;!#X9Dt05H*~&e2436=~}!h`}_>yJB{jqoVf3tQ?zs zt?d+U&<-|~&Fu*9!3}S>8DT39c!K>xQ`P>9!fro@N zA~m~lcI^%WDzrjPSlrF1;IoGatvuqq{sVr6KVpRnEp2~8Z+yE5RU(^>&*IpqYZo$f_w}}C$Q!yk(|UXC@p7@oIWSHgFJ+~Rwz4-L()m+h}-?Duv- z31s~{?-PUdq2v;3SJ||*UISuw?mwlXWc&&WYt^|t+@9YA5ah)^8Z^@fuZ_M_2d)2? zZs<1one19mE1j*tBdX7}Uaf!$d)kz_EIf7kxPX_8AxqX7Lqs-Q>9*WQtN0@zgHDC^ zQ?28WOB*0Ocix9iKch!0oc79@LP5Ep@uxE*dg7spj?;EDTfP_awX@~8*S#Hv)p@yM z3V=u`a5HgIRph=xtTuWkShw!Po)5O;}hfeNozM(>yaT5 z!9rwhg~v4qhJWB6$YPtv7I5VNHw|Q0RH3>2kG(u}NR#1Dn14_#47jw?`*Q#)0wM?= z7`FZbw290ffTn5aiW&4);rZrhCo8tbI6yeofvgPR5%=gozlxnV-6$q zpm~3-ON9c@y#DjqCZ^nqno19VFlX;bCk@yAVR%wGdk8@_OuyRX7_jlLQej1IpDQTG zY!pPGwWKnv)MoU6jdd(b%t%;ksXQ^5m09fxA_9aY_!%*D)Ebj66PgnO>5r!fVrm)4XjwZb)8`I4`u$dRs6`BO!uu!%Aqate$_C zC)IlCf9f(Saq{$Lqb$6cA=ic?%2RqnF=*LDoG@?#pow5SZ~u8_zfUyZVs&lpj)+Wc zkPm5CKBuuB=zqU$Ey1K!z|kIy7GX|BA47&P9S%WMNc^t)!kFmQ6W6N8k(zrRyKL%n z7^9u%NXb8;S8?5a>dz#8ZozJHG}=@GPF#nH>alxjYB=s1x~^972ECWja&dn)L2A1o z5g&U@s%F1%RUk!#~YftA5fg8aQ^(j{aVYYP}R@zg5yS{YzOKzGmw# z>V3PT!0+$2%fQPTei8y1gd*8RrrloTs#sxm>0G179HYjNQVX~W+d00hoa3@ZVNWTQ zT-LX!xsit=iuP>n&2d1?^@jJ$+AcnqqzP3f;{k)G2VDiB)c>W#Y@6+Kyh}T9i3NyB zBML7>#1`!roWk&GX06)-Hv=!#jKk218gSy{#X!4}_t!3T^Tp(ZvE1*yl@Nw=2x7}C zwrL^)nt|H4gVA6Y_B5DF>t`p58yPLgq1$g-+bRl;;sVC5h>t0pWn%P4-4rg|d_|>0 zbN+?6@h?m3Gal_{HW&hYHG9NC=w~!@1`Oj}Y{6BH0Ff`#`+Yno3`uaEec}hrF`Y*q zzIQd8$4t)@zQm%ruP%X`^hp$P8*_uqtc$>1b;}o53K4#F%P4;(D7nMQ*y3FoF7)7}8m9Ho-H`&MkE7 z3Qns#`>seA3Y>!p20(Z@F16#AGIG8402wmEE#PKAqCn_x=zWS9rIcLN%FX}8EMuUf|BpT-TTL?dkOi^l zR25=O|5$h^%+}&1X%vQ~9R}6>2=TP9<-CQZg7)AqGxrSop zu#&o4{1ei?1xISXhp z)9Eb>s3Fy_Jlw`joffO-?|Ep;I(#~uwr2wt(XX8atI$y{YwzxN*8g|vteF!e-}-qC zZY7+Iw+=-^pxjSUMCaIqEiZIbvKMd^=+g#%!e+a@`;F!%mh<~E35rU@+NqKIwK5u6 zNSBSXar257B_peD0-Ays%|V{x2>r#CpN7Z~K@^_xPr#e2U^m1D4bn$O{71D+DSlj+ zoCM_zvF9}qXKI~EP~mU5#02p1Ahq*Px&ff1a3u`Fg>=_82n9=_K^S8^3Zc4UZi3EW z79k{{GJFX7{mWO4r&|z`RUf#Ztu`VdsMq6VNkKagcgD|lXVT9+qm}-gdz?d%GSiwa z$8c!UyabC@o0g$)-xEdL&m_3xBCL;o4ojB0aX+DFQi6eD^8m^jRoouYIbXv?A6CXK z3wFS_mwl|LDIeQt{`Cy`Oai{b_`CQOpc|Lp?n1Zkjdbs&g&0}E!y9$i`cm?{Y14r% zAO^X~&(HjQ2aNM(lnn9Z`ODAx6%IIX1pLS&uk`9h^4R7K@2s_{LP$Tcs6@PR&J%ff zmVb7k?&V0NLR zuB^u$_|f}JK{14xIctav>vzA?4;dbMgRBA_rf{0!Y}+#r$N5?D-dM-_YGzQUp|T8QpA1@~pmQx7(< z9ZE7HfNi8}4D}}tqbRvcHI)F$8x|-;COt!b%5Wl-MyUsP0JhFRfx& zgm!7N=jerE+Wf3-^<{KS`A#7nyT$&0lL=L-{-S!wV=xZz@$BSY{G2(R5~#!my&wt- zhV7<#T12%L-l#^@O0DQnRCevQ4?uszIlYoY2H>%9%($l6g`mjGLDofm&;Ljk&f-mv z)6Wh{n5W|DP0578#Hjz&ucs3QL7W9vwxUA>Kw(m{07F)CDFrdS^0JoP*Xm)B-M3iX zQPhI>s)KKoJkKg_a=kGqo#a1OTKnfGPj@SEE9)g8yo%hZhY*p@kJZEhb|#OY%+vR+ z4*XL>9hg5Cy>KN8R#r~q0a|kyB>Xn9-46rvyViX6^zdTzT4GflQ5D8foo~vT*Hf18 zN?~6a3x=p-qVQcI_A+apsg--7nYV8OZb(v`d{KRK za7epxg3NLAQ}&uqY`2P6ZJn6_{7VTdE+X0XV3zs&0XMnjb^@SJ!g4alp>qz&m@&*bsxj?Fo;3| zKWzs1w{geW#-gG&H zTgQxeU11DHW@m|@lqQ5sHSFd4x(SOz zk9BL$Jj2E`wPj6*WomTGdM9%~(e&AfQ$ofq2DsOO-{Ka6dcU|jGk*@cf=`LHb1)${ zjGDuBbx5%$XLZKg=bd@H#>jl!@%cs-HeOF`ocj9-`uj(O`+?%|TBkNwul1?ZH`2$V z^WPyMg8iS;;b=F&=>)sRzf11cW|!Fb1WT9x?(nG)bKUG*EIPx$FPJuugW|kH zc_TL!J~l=0KPgU`tcFW6z70{2XyJV)9$Jri7|nP-#?AMYwZDK3&+k69qW76?4>!l| zpKNNHqCV>y|<{P;j_h z;grOh;vynSs>R&J-R!z{v${1{{`I5nYxS*-aSM@%*S>NuzTv^}vZ(TZ=4N-fmKD#x&OA?cg?A`x?9R-ZI)GFX+&$65&K!x393X{l_ z3{Bj%hd*m<>=PUY4qhnieSbRCv`SA@V2vOY(mFTA!w~Sr{HVw&BAWqSH zko9A@f0dhgnqq!4(r816ofWON+AbyyblpYJ2}jlu{5`H^cDDULLtCgaPQrqW1!O3~ zf-!vK1CEfOYD6zrqDfP!WxTu+ir5S(NchXy%BFgS${x{ZZ}FG!%+v3D2^R+$tsd|g zUs^!u6EKEQ{kQsLf>f13`>EBxn$DjKMe*4gDl_wFl3IVp2zJp4qTaeVnkp|S2CJ%7 z@GYeBr1X4SU=b3@QYUcRw$51Lv|g?wrBR5=;xLSV6P-fVAn@S=R7QXVp(t%lPT{$g zzKygUHagHY{G(}x*y#F11l29`{ ziluuV=6jd2@)WlVDMdSpLixFo8e3fKD1%N7N7drLUyChTqvx6SEdp)Ed*Zb3&+eJo zHT;F!G_ZRfbCZtIY4l`VO-meME|D>>EU<@#8Yve7iNGi7{o_suE{YtF4KE3=w{{+6 zavvQSI;mO$anMF_SwJtz^)p=SG@RGTim%5||3?GSyc{cnHJ>do4$pyUS#Kf|vVLYr zbs0AUU;EMqZ9-){j>sLPZ8YVs%?b?tAWGBCX|xA+oI^DJR=|kuF5#!I-6#8Kj*Tgl zLg@dttcGN~kbyzS5CSIt!?K;x*3^Avg11vQ8c1|6mqP45u5<&kgJJXrV~E%iOKEYq zk$4M6KAlYI+Azm15^s2z3PS56c8 z0DQ3Sy!*280EUU>EkQ%ifAVEJP@b5yuN%y_9vek6sk$IdQA1#%C_C(K7$q%vmpZb! z#sqMR6dTlF`J+a~r0kSYLwg>8&~6qlSggGoEgDf)B(6PHWIluQDK~tyoqb9~p#bOY zYD|plgUaZN0-95f@HX5YOe#Mu1c>2Oyu*N#q?k#ho^OQySw&*;@&#|e(Evg*VuHru zvuG_A?CliD@|7Uba(bvp6^8T!_6$l&2q1m@a<17*rV`9KILKh>5LPx!5H13q7cS&f zY>LeSGav)W3P+!xHz$fD*+Bw#`x8*j|`Z3Od9NkAY zZ(_+j$)A`9F7GM?iMgu|Ym0;0y6an^0f1b19~J`zrvY2k#xPfGGsqIJfSqh`=gi}!1p4pI*giFO*e(T^HC`8NZ=L(t71mIUu9jzC4$i^pEp%)LA;$8JW}05) zlxH`3#c%8z$Qb{m6M?Yx8(`p!#sNc6yq&`HAHBgMRCOf&HRZP{)j>>yPpULVUcuq1 z+{7HXyI-?cuG!Z>-=T_E=Ns^$Z?Vy4#_n)Y7g`ew-Em)$c6M#L3ZA=+<0gw@M}2)j z0>6AP-js&anmsN!+StR-Th=DV6TZEwi4Cczq@mKY%p5#+?>v40V7tn_pocYYU>lA0~=m;2NkTXj1-d5wF2kywu zQ-}-%AO8{j;c*iPhraQ|WnNbBeP4)%V~a8qSo8IAf|Uk$dyw*pQA+pE?N+T)^QY0x zHCJ=8F_RqVTA&FM@+es#~~NH~KFG z+Wb3Q&*A=0k3;Y05D%i51~$T-lNrKtQMIJ|rA@2a?@4bT>VwJz>D7UO+SfW9=G22okJm^1mZfDi6X7C`P!Yj_W}IGI-2RO zI8%9vwhYh1RclWe0e;XeRcZUuTi-=A7bGq()qcDQQ!ax9Py95&pm>#XcI=xUV-j9? zrmM~u9bT{XtD8y_ESydkvVV2~BA;rTuz8tq z1j%0M$9Hoc?N&}gyUc>^FL#$q^Q9>b00tt0aDyySqA4XL)=vfiTe@De%$_eps!SkO zFwqUpE{C}_sdh`tA%lZJTo(_r+o{g_^%Pe6ed+dP;8r{F?}o9_95kA`FrQO4tJL$;-D&FgdI?CK; zV3#)9mg7u_Q5mvM#B(i9$J&tyA(AR4=GBrF`lTnw+ciwI&A1EWZ~(YKCA5m_x&n2! z*>ouIdQapq9wl-Vllrce|(TJf?%F==C5Y8FzMUGG$(tlV|X`?oW9JgLnalf4rb8`M=efcVb z#U*Kj@qB7nFKPld;456g)S=^H*>ZZ85iEIg{24)f@+f{MX4cH1aWBk$e>fq;rx<^U zeH{CxX$A*{DAvHgYQXlb;+yOO+Jb;cB zh_>XFg}OA9>tGtl`w4>VhXakdjd{(DZLJVjV&892c8C)b3=JQm6_7&OXn^i45P?*X z$1HqS_3$78Upj>X8@OeVd-+ZR0aa}5sRyLQ16th!RlRnbvvD%a))rW~LZTaw9p9XU zZrjdr&-$uFBNQKzE||5_LD5H(=BjqQn}PB0b|Kgke`+ae^D8zW=?oXxz3<}b9fP@o zkljf&Ny5Yb(gPM`!YQNm)wE9Q2b093E0|54YA~800Jy$>PTc8yhrPPja`sisa}!)a zF7SET@-D9Qa}Gk+uZa21?UG~DwMcZ~V%I07AEp*6LF;vJZh_7)Ol&YUL(gX zpu~Luo1*wb^;6@fx1z(E!)w$xVb?k+EUOE5^aKk;(=7Vm>jE=%C|u7P-XQ+TF$o0BdmlOo~`xN$xF z-VV>%b*Kr&eWWHiX&aI?(R*_BEDn(*URJ{S!~5u1iWGZIu6Spf#P2=$9%-mD6NINx z%>O%ELn1!9L^&&OB&B(;5_MHsBFi~=nh%&5)5;*o69Os?tSPDCJuj92E55(oZNey2 zBaa*q&Dlzsio2{17+O>%CVpH(#1-98e#-S1i=N=iJ0|u6eySNq?%t_DkCXz0@+DZq zq5n07tPmkHM%2dZ6mr7KbJ7fr{XHoQ#c_DIfjI}s!42Sv2I#naTl_4b!uaGYbkyh1 z4fPaFzuP*pbEPYkPDY`?vx)Fu0s}L*MAK~72#o6vNF8%DVCAaGWI>Vs(#Bb&UU8Uv z->@^KF;WEXWiRczte*f8GY-l{GqBImaZ0G(nCK85BaUQ68)a@K>qV@lxJli=9?bg) zcK+h(8QJkyK0!u=krhkb!I?c7wAM3zQ<(EG9y(-Xau#Y=v{>FmEvvUNVVu2G6x#t% zzttG$5Bb+Sof|vGBkY{Kc5P(F7hVFIPFG3afgIvgPsUgVl_wL0kZG*L@r{y;-5r1i z)kDYAZd%D?=0qif&)XS7nJYi%RW9~P4OjiQY(bSk4jg~n6m*ZFz6%p7*Z6a#&lNKw z7^P?N;_Jf%eQoLQJ2s=|c0lX;1#9v3W-Nk#CH;6q_F^>@^ARpLe~x%)KDS{wjG!-g z9Z%EUty#s$Dzm$#H7jBiMO3j|DG59xK%}ZzjGFdEYT3sN6HTEACWe@lyi)>x*^CKR z#ue8NwU_peAjH=VAL1((ZQcIfq}%N|hsrKWsp`(4TUW2W51E_GuzclY~y@c&`#9)bmnmNh^h+o)sPwr$(CZQHhO+p1&RwrzF2Nq66fJGc>h zwkKavXPNn)yXC--kv}%e7(>C3dPog4Du6X)9 z=frOr1k^c>BEJ$b&g+r zEuE;mKhFC8!TOA$v4wOw-PGXqo}Sckt|Vx#h8-pZF+}=Qe@a6=mGURE0rw}(G6jN^ z^)p`#BrHwNyI8APdMJ>(TtZYEN_^4q5)YytVGvDzZO~m{bI%7NN+td-Y;lD?6U%X_ z*;&Ux1SOgQ*Xjs})3DYlyQP|?@K{DaUEW~?k_2`IXADOHJhyAKlLqs;r zXggs7B)>4y-C(NUm0Hu)M3KAEQt6uQc4$&WvsKB$Strv%PHYJsavsq*=C7?9yv8&F zk|yxoq$SZ}k2JL_B#>19K_*F)aapo`!n#5VK^S0|lidjw4+L=M8@3*%&KOc|`gSyH z6-0@qYI|By<-ikLZO=Qtdt~^YrmoD%Dy`}%DM`dJ>9ke4yM=kkd7&2%HC+2a2kVJo z2&u=)`wg;_9Dh(Q&TtiB-);k|>J?oJ7{@JSXl;R$fb7E$w`B^y>gs3 z08E(D7a;iKqGU=oUj8M>I1e&JxHkeSkU>N+dcQoT=tkh8{&AR-MDcOYQ|9KO=M5hZ2I2K=-vxT=uK%6XJR z^*4W+=a5BUJbv{Zm>C!6ytDSgR1^nEwC}W*uUC`JMzig4z=1fteMf6^*@T&MwxS7y z!sA(XQ%FaH6D*_(1dg=m@cDv!FUf!6kB_MD^rq0#(Wp`ZQQvF4SBSzOoh63~3dx>% zHvQ{yZKF!cbSny6X2MG?oT?F^LjXd73x+7rWCAX<8mIXn&w*^%rjIc8+=k$Tps;|Y zc)Vp$;>~A31omHCZ^gVsQ)h8GGP3rG5uWj$X~<>+g|oqFX7|q19>OrI7~#ao2G>i^ zbn;`}!N*>nN2jsx*#c9LG*Cw4@tX?iI1kgxu)r*#oU%h96Nt{VIWl5m4?xD>=m*oeU-mL4Mz8K&~}9wCF1Kn!*z5C-H2$3#@_BNuc0 zZ7fKQ0@)bKQ@ICr6P00zL(mQ1tzpo`N$G!iO^iHfOv1A9$h|shHlWYxJd!raujRmX zUMQtEUI~hldG-3s3_)Q^z8r>)ha4IJ)4p+V)}&CC}uJeVeMcyX%C?v4DMY<#?-1;^*P zIq)J5+mmHN4f{PUwReXI{VE=LAcBhdFQ3IqSa56q=)EYeDIyr>F2>VaR^e~gd(8g@ z4@sBPZA*a0;3vt^SgippNm`b<47#KHv?ig-c}G}%SG4Wzhz$jP^#HvVlYK1hY|jSz z6qG(Ts#(w5I8HSr25*V~44$DJ`hCe}boNZQ4^LwA$U2t2B~YUAaoxUuLm5!>V{yXv zzRI9QNOhms6K(6`;wo>zpSZpg*-jxrX~*bwB_TFn^vW~po%hr0>2uav<^|X5*P)ao zVzXi;2{f=teVZL(99mMlO|tloDJZ`KH3#Y&Re=x})V75+wY%l>{W5#{`MF7Z4wG~H z`AR~c50*w`I{w((!@ada2Em&Rt=Lm7FNRFgK`Uh<>JfLkB_1v3CB75Pgy z47)lu{JsS;2rb@rLLUY~uw;9@a(Ba9Q?xq2{XNQd%lm3)g(OTm_zWd(EBO2Py}cdQ zrRN8d9u?~ds_lwOA`0Wp%C+U_`6_M6e~)m)Nf>^ba594Y>nHgAF1G#%BZEFZ zL1tpVy?W@Qf|9aI17C}5d^5|zWw%dB!_~JmUfCJS1W5^3jgaQNz};5|Hxtw2iC$^1 zYwE@JLov-rp0A+lV)B_Z8Zmy0}w==J&bi2N3db zkN4l&j{l8rV`TV`^voKyNyklAl9fBxW(d;iPy5DxJdxFm)V~HSKORykbB@<3<10S<8Cu$9gq8|?Cks&@rGu- zuJ#9e2qnx8Cslo0mohK-9>?zn=$%&!j}#?0r_!dDVVxQsjCr*p=Lu^mDQlIm2RpVQ zVuWtD-#ow51?dIk(F1Lb66V!zKA0fnl0xnh3V{_rZD%JT&5f!Ynnwn#?;H!yw|#um)E8SHx+|5fw1w;$Obo<=rV@ z!Q38V<^nL=;Y(AhsD~W{S;av0zu0(;(Hc=Z#`H~c`a;U6vn3iocj(0)oAybn;me_z zaOH!L_NW^meX|eQt1Wp^rOCHt`6PgYkgW$}%FEtEF_XD|7cUOy5XJO(j!N)URm5zW zxS;v1Ef%X*4Js|@U7sJ0l&*MU@(9GCX(+?Q3k)>ce;k;|&Se5L;#!4j0m#u&4q8p!z%A9koS~lb?K^4je$~)e%eZGVH#8G!I%0uK;po10?uBwzH%1@FzB#w@reooOFh`WctC~D%n{*PgK>ZTCaSB3E{U?WO$(h(^_R#wQq2ab@38rzHXmFI2 z$FF?Nn^8>XcBXQ~!U~xO3Yy%^VFJM9!3nVWKw>X+?5IW{4%gN>cXR4aRGHa{&4ZER zB@M`mg{o(_1pgWGb*NqWo!4T0vszR&XIp7{MPRW(K7M zQ0oY$f`}2aL&o-e@;(y4k%7jAOlIrjfD2M%SJTK;2&v&pQ1j-;C&W0R{}WTs{}8ly(g{odcldNra?y#K8Z{!b1V10&OaNF3Y$Uy866 zNwuLnYRL(OOje6Xf__aKX#FGpq%*bj9~}wZ?(dHT!V>Y!D|h~VkdUD8R1ey(nNcUW zb8n}3;AL?*!9Vyn~ZzZ_kIaDn)Nh>oOE;305?_=N>b8qzw_LbtXL;{zbTGZBd^ zc67CUzE9qQ;aI28OmD{@Y)tLRmn~Dz>799tjz&AZNx5-CZ0ofmHwHJVEh|k_3oO?} zGXMlz_ZA?6!d6;LZdrWA?}NK2jYty5?=VWwf4-~5q+=4>B~?!*tJ*y@YM|cr^=77# zr@6l?Xox__izWyG!!@{SAZ(uT&5f&**~Z8n~3I7LB2;d<;p7l-hZo$ntu3ybn=!c6OXoUT_9}4}GzmlasWH$mEpxs4umKcJ#?Y@|tEdB?B>b=n`v z;cf!931M5|$%!AkOvkXZd-O%hR;sjNgAMoy5164iBfX)@vbELvr%@BVnmI@RZ!~Tz z*WB?Vxgv78rf;cn;bjo3lbh-l-yaj;gb?w@b_7`OV^Ly@Y>aswDyX=@9qSU{_1=)U zPM@op+W1<3c`*&N5`2(?nRj%2+xRcaj!ri<_3yMSza1H{IxSSab*t1-jUU28v2a2hs87Kt43^zJtraVJ9cIYlG%TC2d6PZtiHWnLxQ3Vq2Y zOC;Djhr?}>g4;BC-lA`Ytd$3v(?v-lzj*kB5m%8mR*PZj-m(+%yrMgreA6L+6!>E{ zhzs%ynVOhBo2-PJPF*xbX1LHfDlB0(J>_Y(^a3coi)93hrAOoQU*p=zVO#HlsgGz- zj69K-1-ibrw%LCKa~CS;X|?dws@qle#ms7GsuulKy#_r5*Wd>VX}bvOVs`I~TFsJ9 zrUCbC^AdJwuPS=LJT{7ByC-$iX*tmX5?bzuqimtWZorn>`KmGWB7 zks14B#2GHTQu<60lym3%SJ}_?vbpW8{!3wG{hx>;26ndp1QP$>!iZ2GHo-srAX|w8 z=4=COP0ncz`?7$NZphRCrr}7^VG;WMhND|74r#(A!p2-~9Larpr`_u$!An9sa2H1$ zIfy5#x_MOgc(jfo10jkrBkt&%f{=p{%2=E9_#F1MOuFk*szHrmRN>zHPbpel^+?-9 z%{^J(@bgqrgRWett&r;CUuBAY4<$Z!(A7UY|RZdZuD zc80%{Rxc#$9DqnlERgJBLHmb+Gni;Vq!GJShZaP_>Q&F;im2`YEp(G2mzv@XYi+HF zF6;7pMHyOjp|+*%+689yXK06$?zPnChnrN)&w{sO?r-}7!xP&NSsWFKcP}gI+BTHl zAHOawb%x-^wxRn?8FdpFi;c%laiebb!t4+nP)2f5FmIr!+$p77>yF2k&GI)Wh2_O+ zx?e}2+D>$nN<`HjIbCY`Xl!!kAUqIVVnS*z!yQPUk%W_ViwWKwVp8U80fjt5^ru)6 zd&;)^77I0*hNb~VcDNk3>|L2QyGmB;Bjg~&zabD`MUpDwW<4#DRp!lmUWj6N!rFel zF?nJdb}d!i)-p@2C{-{6q?B0m`svj09auY^A;X0rK0F-xDCF&z;-cCs$1iqE!lVgXj^)h)-c+)G4~XA zChIFgf5$w|HvSSWn`ZFJzbkm>j#VQ;k8F2K^{)^AUUF2(LZl;@zlk=Hwnyiyq z5;bc4?TI!rlsoK9#iXbi?etZ1BT_ziHJI{0^#B5Xnwk_U1LOWd3^Z*r-TY`)8a zSwV14f|DT&Vxx}<3*Hscs3~H=+VBmA7A4w6h0Vais1RzgKmEm$WmCt^%B6Ur(Y)vf z)V40n5*CoNf%@C!blAdCYxBs&qifFD{yl;h;6#|zD`cvx{_J(Fl1mW$iN%_uSk2tD zoeE*(MRR#`yO*i=>+S}I&Zd{eM`Yn<@+QQt#+G$>f^p5=+JQ3EM80$PD%vEHRX#(i%;Q)cZ$Wo@L2?ubz+QNRNS32KOu1f_#M zR)}1BFY?9h6_{f$+AsLES*J|lE@Wj!ZA4H!0e^4CY92B;V4O4#)g?s23RF)?y?9Kg z<&W)?3>sI2)HA{kn!Bs&2sHt=4m6{gqH!Q;2DV=vOraz{0Wohzf)|m39Ri5e4hfGC zlX5MdnQ|x*%;M^@8vxKq*LzNOydQde&`7DaiNK*R@J|&wjg|gJ!eZ7&TJ}82AD+T8 z4I2NAF~_Y6z4dc{emVYp{V6>CA%Ijx#}58RM~cPTeLUY9_RvlDe=|a};Dz!3Ncs1U zNdu;2)G+Q&Uvg7nO}ugZONZ&wwUbTO=krRZ+NMtR-|prA$&_KB|Ica4W3}D?%YOMs z2NE>Hr}#%6%Oza+1FmOQ;{>8u_4EjP$Xk=n|I-;sjBe)me907%h=U??`pxHH84iM+ zyFYI}W5qVQUcA~yp?FvP8K$F_~oileLm@61S`KkPAj4TrufWy8C@oKtP@} z{Qf+BeHmpDW0D|-LjzioM@kqgfzUE17ls4=5zdI=fsw#Wq;KDd2a%}mj%WN!XqnAt z1)CyulXs-@{!#-i0jwsm0$~jXi>RQt%N7m& z`#>Fzv6r!`p`qPTe4XCLpr7-MSmc8*Z=}Jm6;56JJFJ4CARcfwN9w&Lb7+qZNh{5! z(Wa$y=7Jxdce2jc$?#|2Z)G`&`ApwW(vfsPmK0}Ae?sqFTq$oVb^bO zd%%3SuarI^*o+7?wP#>*Q80t3a0PB3GOw*3*TPzBu=bn3HdH)xqtaG;19>xrnln&%7)oI#MAP$a)Npg2pwBIA~#U5*5o< zy3U+e93eD2iSli=&Cy3KOQmzgWPtr+B78BzcVOt}0tisfY+0r?yPVK{hGCHgT7+3s6LTf}u!wJ6Z zHNn?KC!SkT0Xlw_lC^xebS?OpckZgdzmc~%ZUJG`qX{yAfj(p=yUD9z0uBrYHQJeQG zos7%QB!+Vo4+qs$y4*r^L~Lu1c*6&T;mmOo_B{EiJ#2xWAG^phrrTG%A5hJ`0r3A; zUj8Rlf{}rq>7|_`8c5_zS3y;le^*``BT898p zbeFEf%HCa`KHoOP<;0O@^=uQyi5v5?bno7W!Kcacm?VNp*-%~1I9Y8~!ie~D^<@EQYul0i>x*2WHmt+Wp`1IJ3SjdUw9QNkPZ}t#Gq|s3c1a zCfYN4*Ra@}yO?6UIQbT|^=`j1OP_(TlrnqiIxBl0>Hi9DLk)tWG{b=}!2*^m z$8%$~us6%rQb=xjobG7)uP4MSGU^v%;vAKAePb<2Xo0&V+S5STn;>>~+X}n-X?m;Z zGST0#0LzWy9$;fH_2$z8k(I{l|C>+YVo=R%LJsO)k1%laGGx0S(Ws`5?HQf7-981G zpFN7oKxo%S&W+m>J#>|c7m!biL2nx^6%HfX+2xncJ@4rA*)FW!L?!ew`*oEQd;v;R zaGvU(o?oAI7Vv^3mwg_~*|c0MAmlc=AHV?1+o>szj`}dyOGp-1FI5^<(hiUW!3m=Q zV<0&6vtcOj7U7MH&amqF*Vk}*UcTH`@d%gGI{#q5WyTuURq z_3n)WJq+lOD_CkQs9`O_s6!@VFV_cl8X(@=VY6~suFr=U&FVo3nlyi zIMyeu#l7Avj;7n{!Lm9-)Y44fJL!FOHm257ty-A}Q7-DWOXS<_Nw1Zdb7Gcn1(@Cw zAKM4AAvFfz7SU=_5GSpR-?8IL3ceHD*^fbcd7?cbC6vmCj+^LLyoB~^RvcPgmf7=4 zlWrxW8+3QxEr#Kzhi$crnH-$CsrcC!6-`_{z);_Y+Qo{fxudb#PDnz@XP2qB+&c+K z#6o4n8(^8{%~hyaBLiO@DuG0I?Safsh=I*fEqagl7PzUQh`2d5R|DqvbQRk}f<|sW zZ-6qXpB&O~!*ZEN&}{`;a>a6(yle1r+#oQwWUq=te}L5FBx%QHG{JH*V8_a(T=94W z=7Q=bpGwUhXbT|BL9c%FUf-*0ZaD$u(tryB_}eK< zC>L4iOOBM@Oo#Wo`x$2h5_iJ{Vl~mkvUt*o*04gPBqX1j&C+$GgQ8K@+0fGpIXO$V z$b*+Ka+QH*#8wM-7VYhfE;J5uHap+ry`JZvGxk8&oypf|^;v9t?FwFvr^Aq)2t(wF zIb65aShYdnP$nzamk%JYOTERB;2e7Aj?~ z$ObZzJB-XBFqVb(S!VYS3iOKDpq5W}SriS(q=+0w8lgX@WM$Q3zWh0>oE~95Bt*~q zo1XuJF=_VU=G}VUJK@iFO~Ac7x@_)R}-r*9YzDnlDyPi44abXdKW_9PpQbK9OOPGd=0PYBJ@dfv#RJ ztkxneW|v1NO@p>2(@E7M&UxaXOaB(`2jqD_?6vqI$Wq^z$jb=x_R8fs>zbQwJS!s5 z#wLu^&dWXt3NoF>PBHIY(_cvq+W1foBR?Tefk1tluM*K0kFbx>dxFDHx*S(IrRk(6 zr}I3YO5iSc<4qq63J`SxNU!**i=Mu8tqcV0JdLUY;N?}iV@+OYn?VK9FL<)X844E9 z`p_KGt0Zm>+H09&CLX^5eNOqvd!V{bTF-SEu*aeho=Yb0vf(QGIeulfZGagr%gK|~ zVM|Rx1+R8DTy^n!>P>4@=+Kd{EVBn^a@V8I!okplcyxl?SqO+hEQ*3YIBV1SLt;<4 zPZ+X@XfbdqRsPNF6^GHVNn_Cj4NbUUp`DJ|I-Dj7cgy>$0zArO%#pfVW(S-B}aTW3=n69=cE$(i@kC}yAWu=8HF*EhFdb=-^icR@qY?cHh z0)`-?aQct~?E%NskrNLY>StU?{qHM0?vP;H@j=-#gkIp^n!HwZ|$lW>GH&* z`D%cMlC?}^+?=@m`r#t)6;2ik@&p2zHH1`P4AaqP1%gHc2Rh1CsUtDEIY>U@d7l|i z*S>kP_#HvJ6b^)D`x3e~f3^~0IQ5E%jSKmoYY5Fif~lbkSDofu6`Pk9i^8@6l$gkS zS%y@aE33V|a`5ADq;Pql2?gO~N9Wzawr8F7bmVXV^c(+s?8>uJ?>+xuko&1?((?i+ zNF-F+ECw|-gW<|GW{adimS(uBLRKUq3!!N9xllM5rK_)|ts6E{QPcTUUSEq9>=&=w zRhP}Tl6^O&)?=@(t?Z+KoDPbQI`fyXimE$@1m&2MmF-9TmqzOi$2N1Nj|S`txR4pL ztkWD1w|%OWUnl_m#L&8v99UEAQ;1W9`}o`NJ6V_tLr&ymGbZ%uG6^^2@XK^at3})k z9YvZ_`P|buW{f*kF|(#fiJWbXVSVAi-GO`$h>=b?3+Z-YO|h`XN@9&6!rE9}@L&dV zWon+NM%YCSfX+vp%USey%bJNGhum%xWmj-GPqS` zibm|j4$KYgeAM~g1EQB@m{vlc1Rs;rXd55#%rtd0rJ!){`^Yt%Kbtwws{E-6;e)PR zML?}OC#t@FdTa64z3-$Y*oP2Xe@Q8cG4LwKn(CnI_E%SPd>s+sHr`1Jr?SelO2AwT z_&04y95i-=z!#<*fux4zm2zT_9<5Wl>@V?8edQ6;gBY zd?mOV&@qaD0ywqr%7Vi5u|SDZKP(yIAg0;v9gC92o6|vnloZ~B9YbM_LD~c4;kv}e zpiXtiSmex%3L%W?I7lzKwUpzh1^Hhdg0V<;X+=%Kgelnl1otUY|HL#4c?X`Y>WM$W zJMD2pGZOrs9m)1cOmYVqh1JhXDZqjKpp3SHZ(zd%_`?eFF8t==_BH><6iPzEoD`dL(S!&7#nJHJb0|A<<9(SVv#s znZ|VB05B##6+3UPA=|QU;3_<|=iBXyO4W$cnAG@Gs9OqCbD~5+6Eou|ciUBZYFV?w zk81+XKuhPXKyed6u}Mi@Y9QC!cCADc00E!7Z7t@rIxlXaxU53^_pi6x#CgU zycU`#rC?_RnXI}!B9%ZHMMA{Ngc|upI%JyhDZ9SRxPb4-Rm@1k;?HXnYa+uE7Uw5gx?q%VX z?xfaK`Cn^my`Osbma}FV?xvgV4|94Smpl~VF89|xz+_osrLwIk$h-|MZ-v!_OteiM zM9o=XS^`nG?S`hxnqM=6?;db&-brxg)fBG(B4LcejkR`bym~tH>S1nLxLi^D%417i zKzZn4f2#isug#*&>e^;jR>gx$fWk)}x-^bLiMUxKtU-X{?Q=Cr|KB4#hEbukTL?o8 z#!*hkH*9vMRPJ>YRuVNcq#;i2uiyE{-$3KpMJ|xQ!(lVz$-vUse4NObQJLri(g8^E zAGJ}~13Xu1hAlT9f3K+gv2pUiNFv%2j~F@PF<3xIuWg5lFdsL)^$tM1QF zjxl_7)TF%S^Pj8qVJ+mS94@^2Y@#m5`kL51iSPNZNe~CixOw;bp6-eb-NTePJF3Gp zj-bW-{{1!ZAp3jbyL(FGe*S^b&28_23SJw?=|^2A?YpThx~bln?k(7Ke2osyecdIt z?QbjOvP86qR@HuWz7wd}g)@GY9AXPC+Ju9SPq|p})6Hc{&_XvZl7c79&h7gxitT$r z3qJ-BBCm92lWVfLRk4>g7`3E3Lj{}HJ0pup=kz|!E+X{>ZIlTq!L{|t9`3k_X458% zZfZ9xqg#(a{nYUso)Z;{J7$!)Z5joa@2-YDnhj!i=@(k$Ak_(0rRq5BPC|%$V{s%$ zPygWKO!nv+r-5=$le}3;*M}^}Vg5pF_h? zXX;MU%!fZO1ulk{*pS`~lg4FkHLYGr#g@ojmv}t%f|Hm}6k5mCS0G+XAdlo`^F8Gf z)BS4HhlcuX2-&~m)2V)q;@hR`?L34Qm5_C6ZTHip@6r!ETA;mQ<1@)?9WJ2TJeGt= zsEC_PNoM>kJ%h$h&`_}ZDw31wIU>E>Gz|mh?%HILs%=_5o_+Px5ibq@1NJh)(t%|A zRK>-y<4!_B!ii>|fIL~8rS;PY?Nla+8E-E@ZeqLA+dsXlZ#LA}d43;g7B`97rg3if z@p4uxyuuxV=zZz}sgzkCl4(7_te_vQvUME5xJ->Y8QCiZNkU$*kX=lvXCK!1V%TH* zjcVQfkMtwA@i3pPeJXui+$+diM*YOUn^df*Uc-?}WW*{9g) z(rYB-b|uT@`KloU!-o8-@_Eov8TDsSMi2(JP@jD|To5BcS`SeK!3xY_+|dMM`X)8i z43-i;LEe{kE&y+E((tRXB=|T87;ozj)v(ITs2qI8Q`&_=24>K_u{PD92(Npg6t0P^ zaQdD;egjO}o)ZJ3ouG59n0R&+ZBY6EWU_b(nJmObutzXh2tOTEVl+LMV{&Ntd+qtXIeleou#8eKPpQEa0CJ=ku=WW#(X@OFOq^9$$xqm> z1^8)n9fXuw44!muOl}+7s=WupBTM@$1VIObjOliGMFO*;bms-JD%1*eRQ{~=Zkk0P zym;ZoidQ6z*Pt?hxX~RwcEf05Re&x0 zTc?dO7;sO8(IFj_B{7a24&i`&0S4ys>HAB^6P+UbRDvyf5fFrPkeNZFak1CvDc{a* zQzEX_t3Jz1d}T)k`pm%5ZhQ4_mJ>MG%Giz{X6o7m5zola$w|mn??6a7VO8h|N+5}` z2Q>%Hr;T7<1P0qGeVm^*s&O-yH+eZ&lo!Pu%=E5YtRt&{pdirX^!0xAV|?@YvA;fF z>50~samMWygoM_=e@r+}Bb4EFZE=6E|LVPtQv(`G`JULZ)Uftz#$M;LUubF4*S`NM z(StH;S4HUGIvsIjupdwECYJYGxM#18fRkK_*sV&_oN1KRd%G@%R9`SwBm8tgD`3AkamWixtZBrPZqYZwVKrMTz1o z(i4088q+~lNoG+m3Xm>vPJ(Df(9qLagU>B2JuF?<7y&Nk-{A&}>duiZ^ae^IBz{3^ zmH32y+8q~QvTa5P{sa&J6b(l3^J3FL&O_SHo>nLe5XjY0&=Y+9-Ugmd-&kl6iSb>FSP6Wz4BKo-v5` zkhgL%BCoPnMi&vYSf`f8C5^FC9jks_%P}A(A zCkuFhRRI6~Y+9l>-ZTMq-^b&0W%QeHq|$xi@a%?>v?>r!_WC?jrRiTXLIwh$ghowj zbH>^80T%-hPUw~{km8}N5vCW&pKFdHjVTA=0z|Kk8m!+O;gKGJ;KIRmGyu+%;(&;w zYZcQ9Wv-`!(LbuIMZbpnP}~U7T@?{4hX{4l2W9r7?h`iG-xZ2pWxbew0gsOGS1V+< zyQNqyskPjWr9%g24Y9Pm%j}Vg=CG19`eCaMv?9gccUbhK7aWdTpOFK|L6rbdI(gbQ z>a25Z?2)QHYugsyKTaPTNgMIa;L)f%e+@v~p2ip!c#hdgsFS*$YtKfB{JN{mYL=ZB z1N4Gt^2$K*p?tT}zM!#BK$y|``7I{+V1I$nKto#*8a=ZFt;v5mIBG3A1>3hn>JJe^;WgSUKHEE! zwDhOyR=S+qJ|M(&INMl!Z7!`HqIN*s0}18ppz_X%g4Z(VKlHVh0E_$@zFqdo7`@)@ zfkqGHOfI?-ynPQ8AR8QdSBZuVRN^COO9P?b_|f6VPG&3)RbZ+~qshfZzUd5I44{#|33}ZL0CqB?f=kBr@uCmghR9g@*Y@@w^=u^5icfk13pwGjGB>5E z|M7J^W((^M47MX9f&76ntR+rB`1%OlD?{Yzv~k+9`Kr8EgI27(qHxa8;Uf1{GB9KJ zJTc_*ADam3hhXf5C!mN&{6hDXxnY8V6S&x_{Wx$y6RYgJjPk^}F%gA;v?)XEt%vMy z-;r?&fG^f8X#&8hiuM4TSf|1Ft^@!EmQk*6QYi%t#&*dzr8x5#lgVN{<21M~-gTBR z#ueFN{&6?RFnzd77{%9gxm-XMc+058Evsa*oE!kSI+2ZvHhqnCz7*P99a1@`+Y<** zn3xUIX{q&8Qy5GFm^j8v%Ay8G^s(o1_j2gi_K8zk*Ln7aDb-_$GGoF6_Wz(eToX{% zaND{CH1-|#0mWH^*H(U3TD-yGe+xLhczVRb+%x|gEC4OHi#5p6SthU#I`|2qhC$7e z37PDef#vE6hvKl<-p(l00crvkLasMiZdT#@QiYryUpyyD|BXIT+w8<+4)C_gPJ{A= z>`M?XFNkJI=!x6u2l260Znh`?|lRSfhL-@INZkRXEi+B_qWdfo!0 z^>C43JkPhgFBF?BZ*@Dk4$|ds5t;pdlC^Ko3}*|3{r4^mSYVG2?m_3y5|_IVA23z{ zvy45x4wxEPT4BPNUQZ_^xM}_KJ^QKNim;$!R(FEMD_j?u2x6ZYz za>?k=j}EgJ*QXduR5;9|ZP^3{qJdShXt4d?AaVk7nRG;+RXIBYGzmeIKO|sTi(is9 zj6DZN3d<+wkI=lrcpb}#YyKRpUK6%$*$&v1zN2G1!9;@*$h$0+4pD3Ni1P~{A{VBY zDl{a93|JL2Y#KExW*%GxIhj0U=A)y{WZ_OX&05ErPAaUtJ=*vbUW#g!<0>7N-HzK6 z1uBz;pmmOSftmO0Q=1c3SaJsBvI_=ka4yU?I?1cZbC9THf~!>E$yYH<8!{Q!$*VX> z!wV6*)GIm}Z6YeBo7Xk4MlOq}cxKsQ>#Cy-Fq>pQO z90|tZ^$kO`n=uc#Xpx9!TjP_KSXFJj4a@;V6Sr>C-Al#jB#;=KCP^$D z;W;5#u}G14{W2|I`OF+1mn30CAM~~(cMIslFhHrL;RBjI4~6YFmL^4UzhUFhT;8kK zt{OgEl7rM+tMPxLS^+>#1X^12q>{YDDw_PRfF~9Z7ic#<2arMsDELVMn+JEGN!zfL zK@_>8`ObwD-_K0!$LF4~JhLM9qToT=vZ`HNS0~H>_7bVTNp)iFI0D#zklteVtT&Z) zBlglz@Qgri7zaIf;^kz84MUL%fawKLCW#)16ARmn(qPMV%!XG8ZK*Cj+I3w;GFoQh z4X=x^jbiJs5Pe@BfKp#VKkU@mIhoJxsO>7n6QsS?LZbe5mp|HOE%VT*Pewe;)L0Bq z2ndVgD2dArjI8E0ZTnVbqS0-^aY8|avd?Ge^n0|13=JY;I1CP!W&9lNFCH77ypRoj zGll|-0=MH@LvdCk5rHGb!)d}zt{~t~gpmz4u$m>SfB82y0R>7OgK+N-7W{#I4hq<$ z0)@{7BIN*$mVHl_OIj=vxR*PiarXp4N>3hy^<#~s4-Gf9UNGo8iOMYv4`5{auv~~k zxpelGEe2Ykk}Vy_Dq#HD2BuEFo;@3s4wd9dHjcTsFwoi;gIR79#!eOwWzaabPRornIvTI5`vOxdXK<&T zi=%Khz_N=XW31=q2{ zcAE!iLJ0f1{_oe3K8nQF$1S`a`4oZI2@f1ngwU-G(w`pi>d*LAo(auBq}*)e9im28 zRx{CP2;z3^(sU{($JbE)Kr%=a`}*Q90|W4}FA%{A?&i1NK0PI8b2sg8*JwuEq0d{R zobZC`QIackJ)QzJ)^Do~X|X&>gEQP6A|+*{SjB`Nd|C@hc9;mhQ*=q-Xs9dD{D^-grJcf6)h^08b;ef=LH$ZwO%h{HjhnL#kMgW3Q`-ImsU$~ z87^L(Af26U1@H(+99QkA6&8L-kVac7r0}dp%WM25yt~enQ7LTGPamD@ zOF}D^ip&w&i=A!{^^MuOnCKy&8dVWn&(064ojT`j@6ThQw$4@n0pkuAE$Ai`E2Zs| ziJz-VUaK!go^rlw@)SqDqMlsv->(Ngv0)zM|90E_Z+H_6`+uxA_Gtb?iANCsp~QFM zfJ3aG5{@z0E3RM;aDdr3Z-$@!1?)s4NEIX%88~Eoyei*>6*iKZMu_hF7OYvz%g1w6xv)h7|I&8Fi?GQNp`e{3){MGq>y^oiWpGclNup^!%QDKJ6 zmJ=R$qQ2@I&~{-`Z~)4{rRn3V$18KgZ%S!v4B;~Nze9MRiK@?IvT5{S? z3-@AR%=k=JmYdG=_Gg-#XVqq#Z8_)XBg?A+fp1b`pIF6@JH@NZvVd4U*(^jSgc_8b zK@#1>Npci{f>wNhr=pjYx^>$e>=^OL=PJvwI%Xn|(+c+aOCAR8CaY370lDZOY(Shs zDXA_=tl}B;TF;*1V5br~w1`VlHUWWSs&9sQ8~=7*Z{YD2zDQ^b)?~evQlwQ*1C#3f zV(dsDNdl2}W4?X(k615uV1W~05KnYqMHUig!+?3jawcN3P-A(K9wC8PG)S|s+bkqPAax5wrx~w+qP}nwr%dbyL|`y zZQnXr|6m?GZQgy1(fidStWii5iYUdInx8};;SEnKa2pRFAcZTD{CSYa$wj7R{p5^L zD$qHM-HJ-Z`v9ux!qi8WWV@-6KCRoR+)Y&v>4p8r!y@O?J^x;hottJLT>Rg`63BjM zs~05oh8%>81lpm%d2fQD(S)KhNq#V0%9m`|Z-3-AcF5r0$`yY%FDvcb12d9hkr7X# z_qp11W(isH_nQ1{iTJ%m-4foFcse{V_9nxGR_Y;Og^_a1f^K!E7yY4?NL3z~$Kld6 zMHP2plLJEqCdiQ=n4kNb84RUszbOpsfb!#EhPtE^Bj6$uX1Jd}AXnus&wJR0X!WZf zf;;VZwC3vjf5AogrG{tF)1HU8m%JT?P902!RHjdNpWQAr3!RYq_v&Xl4u2^_su1d# z{tn8Ep)VvgOm&$ALekpJbQxp4qg_UwD%k!LN?BADxa>(>hp$bhzg2bx1S%g|ipVRH zb`~1$L-f*_I$Jeh`?kmAqcEW2(j$#PmEY**#Xv8u(HrfEI4HnA%M1!z)Vm*n3%e>| z2Sy7VjIscA14B;yg3FXJA^;C)tYFB!oKS*nH_#Z-zVYMCWYPm6j1J~xfX${jwh%O- z66fp$MwjnXvQGAj7^dIry--%2tfoR!X$?_^-~zXcjN6$Te6%7(3aX#+-rV4PiRrMu zWO)p0W;Nj7#HvZP9~qBWcwM+eDm1yZnCHboRZ0XEeoE|tZz_hqvaJOWpylin=EUp_ zMQnO|)|IMXw}fkO6uG*DpS`h}$v%`B%81wWUHVzpof-HJ1tnmBvP%KiGDlhwE-ZkR z`((lYme-9Fdn+cJ)hVLOF&aJP40jsiqqyL9I+{L4l(iLua;Ru5Bn-* z>ea0;ubr}T=N#WX_o2}Vp20tQjNlT+AzpEFyFqcfk+9ubsbi*(t1Q>p(p(Mcv}>-D zqSzVQ49EWjEJef*o>3b%@-W0rFg6P&&>7<{9nU|Nr{@=OCW)euV(L*cpjEbM&<7O? zq?ZfHDbLh-LRz`!t_upY+s6#bY5KYdL}&bE%$d&5I2`e!KWIdyz{v+n+b>CL6r_|$ z^(BB?-98k6Mz(}2WE_$A7AHcATb7`O3UeyA7jyhN5fI$#|EoeM4J!@dSn}##qSC@L zcI{6{PQ12f#PkL}`k#gDv3@(@R{Yf;J0FyKHf%sw>hV>GORic>iHH4r{j zs3c?S$1*7*8}hItd!q3e%<&;-m+fuTazZg>1p_4E5mdqNCq{(}0j#+GGpKeXNI454 z9c=gn1wZhx_IV+zh{<82!3k#FX&pjJehBz6QPjH&2dqOfPQpt--w{UW#p zyT&rst<&`_i;nI(E=|DdSu^LBwKpMTaC-iFOIfj8PhfX0?dtHeHAd2(#!b~As52gd zF#OWqnMIJdQISunEDoK{5p)J^DE>Qi*9fO~^7#~?bK4wpVhCmp3F)(#sgp|GAx_z& zlMgzMuuS0BwQ%ok+MMOY(=7_Ji{BeLO_#=P>!2YoHJ5R>G@QjE5O4D+KAuhwyo zN%LxCLiAXi(t(g%^Is z9xse5AOpVwa#$-Sq#Rn=<5Eh(EnH%1Vm%4Q27gBf+D>M^TJjC8RPo4hWkz!pZHFHN z-VwH!=VjZ?l1K7xg%zJFp!r#0{+$zdlCDRgtOR`>jn$92&TSox4f;e_FP@&>L=tHw z(qXSF2hC60uvoSjy=kr-f_=`y6zSypu!ebaHAIGd|IY5ZKd@!RzLn4m{OG)(yE3HA zx_Ngc9Ki6LI94My^!jydC;u|>WoCn^Pd?=C zl*&IM=y~MDo|M5!vm(#3I^FfeqpwF9O?Q1-cXv3{e`=2h=C%--Y7o;Fbv>=O$i3TB zl?0efZoSj+uy?c4sbK zs{7z&fdzw#s9xHcZ@G+c))zz2*(=FB;QwY8^Mc%ZIf1gFC`PSJffzCZ1a@W@kprOg zGl#fa-XHXedTQHl(b4_$Y}ab>Y>W2sFZ9G3u^cN6OTPlyrzb-(%3n-Yi>mMR#RVPapHf?+J`fI%n4CHA;CEVl7QTqrbhOxip+gqdl4iIzVVhsd z*mykk)>iALT^XHT0Lz`}GLO87wbyM}K=sGw z(-9vZNH)zp)48`3Q@WrK5nblzL-IH9Wp>5ee^8hl{}s23k%8lXKqZXqA|Gr+~3G7Kj*358-;GBW&OLr&Ox4Ffw zZxCaE`VjyI(A^v(<2#Sku5Lo0{tDqr$Q4b%5+Hr@WAS=U&mQ7IS|7Dzs940lI z)m`rISH=HR!&iScCF||^o}THcn{2Fo%8B4Zl@_4=nX4nr0=QQyEd&48zhw505=|T| zwtzBmqeSPl+H^(4xFj-$WhLWq`ERm$*t3Wii>~fgDDT^dgxC%!(!fQj?4b#fcu5-` zs81okvV8H^Ldg)|whM7_?RV~VM{qot-2`Oty|(j0aD4|}?c_ujpeYPxtnogFO%b8k z@*0vj7O@Z5E*(f%o0S)eSX5%J)}uI0OU31%YIXbtR|}N}RJE^dNl=ge){+jp2=u&b z930JR^K8R#UK@d*tU5PRThfJsJ%gROi^?Br8zbaEl;XBoCbsoX;62R2hJHqT41bga z&x;Kz8#!{R4-Tk4bNj>nW(*dSh4EnnLulz%`-zL}#?r)~FFly4({sZXE0-}%sYt@! zp!!TaE9z`7%GAI&G$mr-4*yjhLTB~*dd>xt^v-P1@Rtl!OeZ ztT~Z|06CcigFsGFfD{s>`Y$)7jqE5o&_TYyUzZP?rL^_?ZZjcnt{j4l?p^-iKb5J|ZKAX7gpmk1 zAq|K#t=}zY28qk#ca1zy_F<$y_EE)nfzND-3xZIZrSoHyy6ymjKQe{V8LV4wQxXtr zCL5_Glf=}i6A4^?s|rtm7kp?|7{?Hs9PfUsqOu|?(9-rk17>tR7>`~H!Pr@L2xQ7wNso5AkW z4r%S$Y9YRSL}0%6o*dr!F%&p38V2OfJg1W0?`==~^GWz3^3<)XSgzLc?zvDp94hwP z%htB`QeIu21IyZ6cw~kdmll(RdN_H@K){6LA9aQDsBvttKfLdevLqveS90`a`&6%Y=^olxsG)w`aq z6+3`WcKWKk|I`J?&g1olAmlEBhnG+H+Feo~&`*|0-=ZrpZdJSe)8@3#p>se!`>UH} z^Aq~)xQxuFAb967zUVZP)ySVTSo=hXxI^{r8#0-=&gTu6VA|>1jdD`z%#eL0Ke;%{ znfITwq!PvsRR@>uaA-8&_1BjP+Q-{uw`)xw^MCpW`mYc^KT(bU1t`8$m$BIwMee+= zCaejO=U>tHVTW81VjIPMiXm(lrQ7G6LH@-k6^k8*z25uvQh8>rSg_G>(35(huMcV& zx4EdYSY4*0FkAdTgYK+2^NU>mBk$Y0%)_Jy`fP%cxoCd+duUpyeH;K~(~@^!`|?gm zx8eWBHC+C0TqFCLlNZTO$7ZAaI?a91aidu#2tn+c`wL4@*X_U}-zL}5EPk9=wJ zMz6O?k8sVx8fNPZ*m~qxB%z?p_v$<#H;sYqKic|` zz~6lCQ3JC%FqybQI5~Itp;-><19yeYlRsA;MA+j%u!zBT+ z_|@RX@X_2g$Y>4iR(BJJo#xvGuISE-bTA;lFS^X_2=_v?Pb=&q-nD1Zt;Yz5>G_rp ziwzZcT8+~|)Rwx0n>}`|G%G^j%B|*;KCR_E5q}41!)jF8I6KF)Od*6caW)ulVK~h? zUFkbq>n>fnTN`2%tQja(>BqKfBQRg@7#Ms%Ebp6~KY+$M9VRC^Q;SG_8pwf1h$(Ly z?LX~Dwo$TWvXW(zA!m$G{cAUgu81biS?|&!DDQZDwyL*sxDg_5fskFfPTO}r-tv2? zvIV({er%&pZ@ag-^T`+eGS>0vza8S-1#*9Vwp<{#X&(04wZ!^kJybcyrpKRo9WmwC zWf29+{$S_-Lvm5dwZ<>WLa8E`s)J z&W=GKe*Yc)=%pwHd(hS(=mj`CUhjoz=YD=B5o}LaXi^DL59fvn(i4bOU@4yDgJ7$g z(ECHc`$6#4J~AIQ<_2{PB8DpvH%`VO3)TcHN=clVm^hM4#733KPZ>xdMuADzgWS>D zn>?GW+J>it!?(tPoXgW3>$|Q_!KZ_+{Rc10&M#F4Dg6oALl84uWd7;TQSxo*kC5G% z3zjxgTDgs}+4c*;H7;Mkay7>X{j;{xi!ia1U}BHak(}xVj%0fbdhEx0GJWx~%eYNY zHd=a9uU7{{p0tsrmnu$fkT!=T&%A;K&YKUsGU==bOIi-N;LoA~umlzGKholC4!wWq zDREkVE>{eOPw(lMdN#CHMV(yc%OAiO5>!ovo_9QXfaj=zFBE8dx5fdayiPxD-2A zj|tf4ooybm-Ibulq4&1Q<-DccR$@i(!FS zVtq?+f0{Z?4Je?8s`KOOxI=K@IOQ4cuCx$O24o~;`?->nG2%*RnBFC8v&3inWf=x`)n=KR<`Pv- z`?;~|9yoMS64FDeBxW#_R+nb^V{-Z~pqZimc8u{xSRdWX2?(a25FyH)S27IpZaz6{ z*K-124jqpiCdnsTj27w9d|)hAmr671oI?q2D=M0&2q7qY*g9HVbLaD`{RYl<#hbsfGGo zbFke}c`Qvd?KPRp?%3B^Eww&`)Ftz9ErIcawj?6>@An0=(DA%5{4`X$QlB z;tPp_jMh!TK;Ye#1TN2Z!59bP03W7N16kr^^cHt(?N-`Po-7p4LHyV!#rWjg5a#WoJ~9B$OeHz2Ub2NyMc#}&PUgY4&+ zi*Cx1@(VNrA|)@fu-EdIjg&jHBmEN1_|Se9%Bm^A}#L3UN{{Ds$)3s7%*tmGS*u z;b-7eWg)Cx92k;pOpdY-1443p-N^E}!~h^*IZqKw~@BhG0J_oz8*`2 zJ}#3mGA^OuKcY;vISdjobaa7*u*OH(H`;$tLpOPrg-{NjC6$9tI>#b3=Tkey_pb{! z%tTmug6k94^_;V8IJL%I)}oO|dX7oF3n%|Jv_{vkKDe8w-OR*Pj}#^-NTO^(dih2W z>{18-0T}w9t_3&|!|k^#sMt%8|Ck2|CwuV%C5nRR3j>j*)Ht-+Ra8kqnGG}vMBf|H zu#|a(0+BQ~+wF;t8BGecUK$wv4E!oD#)@eL%;VJknvEB`xR?lQCby-sMd4kAHX-wm zW~+^LwwFn4GHMaULyZuRBg%N70xx8r>qqO4iA4ZNOQAT~itr$%XqW<&b1>`Nc4Q(uiQR$avj!NJhMY;T&z=Un$M@dE+*wOOk7$)dWJdb zkvoms>Nr!u3G_7UQ0I40F7*7(@)#&oL?QxYY^WKP&UctxFHd!5_?d?E_6;HxBcM&o za0U&wQ}={j$P*J&{-TZ@{kmw%am{Tm5^HB%~&V4Xsdw>GxPPL48q~rKd z66Pu1!Fp!%lbNls=u~F-|QY$67iAgRSLz3Qc6IGwll52{&MB-9C zk0;+~fH^BK!5ESw_&Mq|1DoS}prV_4vc7XllinUC7?WI&w}CBdZSPJ403OdhF{1MT zS%wMuwi|B4nKri}Ntg}qGv`5rM>6%IO84l4k*^c{8>j_mnyJEL1rO<*-U>1J6%_K4 z;oSZk$q%PMOL!hrK}PTC)#0~IiErR~y_obM00@gyzNknv3HjgV`LfJ?*gY0ToeAhOQq;s~-GcDb+4I$a223Z@z{( z(4a~t0VwILb8`KL5DP&FTG?xxxho04t`^XAySq4tjdeCZuW`$~m)ywBLh#-I+R3)t zsglTBapc(<0_QFVZAUx&(6BZ%adw@!JQNh(Ly4vzR*^-pVyq*C`(=a;+DvFx$`;eb z5`2%;*o_{f&S+7Is%BvW40Ahsv!jCJt4NpG{trrI_3H1S0f4k&nRUor`E7)pg7xb2A6(ep-WyDS|b$9zunm1;(E6+J)h2O?~LxupNDfr)#lp) z45yf*>6NmE#uyi87`^uE9o^byM(@2kJg`p(V*pRC7uMye)$FD6tF^p&t~2iC!ds~A zMV(AJA6{=(r}MSm+pW0q_*Dz$EcgzNuEU^Dr?U=uV>@qWPMi<-j_2FGiw>L#3NcP6736fAUNJKDm5y`T8VS&!~ndy?h;R7N;*} z*WJPCh3Nf=*XJVKq}?#mc<<7Am~;9E#kBEsLt731HOubQSV(=I_GZRq_H?CYQ#!$G z>C^Fc9*p8gs>INoC=q1WsoPEBObyGt9_C`V5QS3!a54P;<0A6@WQ93B9KJUhMd|9- z>i6FEw|#@g&J%i{0tN+D0?TP-x!6$t)1*EBH_gXnZp%=hs>nC&0ngy+s@g`B8JOf% zsIasLUe)g7x>DmNU@Two4^|7tO-o$hZcm4wJY`6_5Wen< zl~O}y_h|ahK}EsoSI5=wyc)u*)L-CCX_n3j0j@TZewcfhTS+W5TQ*oz;Ya2cu1{zc zDz_Dt1kf&2b^Gc+}{j!dt(HT zjFKab=n#!{Sb5M(7m@!!UD(>aSF{z-teswKKL)F9T@2ILJ~`Xy80?rf3Iw$xBzn}7 z3(1S-WIoPU1$~jG6nKi4logVbbDRg-jK}iwVBF+7SnIfbUD*PKKjFQX& z@+GQZPN{+~J`+_2@z67s0AsX2bUs-n=mcD&kizu_HtAH|elFoj@((irc03d$=}ax` zy@4Z$p_u-x1eQrzT3M^voB{iAKum|R74uVl&3f%>Q2uK{)zzCLT z8~w72ir_L>qc79%ycZoijyTh4P?bs_x{A0OpE0f!m69q&oqF(o+AWiCigmw}g;Fx1 zeVzrfcX>|p>@Tiv1U}cRHyP3F^rh;u%BPcj39}$yS8o*Hyjsz`&J5_ZB%uKZa zXiEBP2{5z~1ng6@oaB<9pB1R=U|ZZn@A-PnCs?I0|D%I7FD>TH@Z;NfUrSpEznH>E zmi&QIRxJZvVz&4o+>uR(d)inzU0W??J-z2~BrIln5by^QAGKWWG?WHeq3Hy3Cp87^ z$sf}*fC>!E+<%;>GdE6AU{dTvC)iQ~VdVbxKl0JVC513c#{~yq!xomRG3dfwQIA}p2(lWUo%ZKO>xZcxQ05jfEN}tFG+2<0 znMGlc!Vwm9vEQ_k##?Z6`X889PWwgp}s@us<53MQX!p~9lK(M@_xdH-T4$r2p4x7{0g zx_W|Oh-JmKpnAA%Rhc;{q?u$5%%ju;8Vm-SagqJ0#026G%n;LCO3}&+x&;ylegRc^zLFYK~jlWkSUS$kU-|u!smSVCM46CIqp6_|n_zJMIEpopi zxgCm4yvxO5eXBPy;0{&n@0zTTf+W21`i6e$4?^*T(IRj%j0nMNy`%{g-HL#ypc>$H zon*1Nd&U}i-Ufvgf<2bPpgc1m$hnVGnR0UWe26cm;z}|C0cq>l{$sQ$ZAoq1RYk5{XFNt zR>2k_V)wlrAk{(lqspm1Fbtj^HLe@-1wS>W&_$F8q^(!|R$4aj7=>|!^R#r=cm<#p zT0SWF2O(K3%1g!hGCWc9Qn$}QK>C*XwW{y*-?@1=(pqIVi_oIoSMfyww0g5Jjj(oLOf)i_kdA(b!48-cXXC&)}AD@poto&JXB;E8L56vohxXg36OaA-_0 zotsl*sM|zpjd2{r)sGlI1AVhPc>&tpeeZ$Dh@Hdm+l9YNE`sj^nG3=xMA4^)#5A}8 z+Wp9zmo(7IdAY> z0aFxJ-S8Ew7SCeU3+d;PFEnR3M>tnFNZtGab_REWGF!y?HuDE=ep0-9eUvNOD4a*i z%l)Rj`c^(IHBHA6aa{^sv-!Z}w1^>W;-rqwgFh4gO|{M)W=WBS30U5Kg?&fV_HH2A z_h~(y`npA{*(mkl;dK?;_sgUYa2Sqh$bV99{}oSvN3#$P|F{p3~4>(k%+N2$7AEb2NCn<{vm3>yX!@Nst4_htan>eJ?;E?Xcn zDOphSWAHIX<_;atmD2g20y=e2s?j+1MO(T@(eFw2D9IfDCW%^Mf5rQ^ z^!6t$3oM7!hsDYwgKhnL7vU%lblG+Rm=`243Sx!Qv$m#)+g((<)9q6DBoWpJXS+=O zrN@A;I0|DIE-LHkR>OZ~!CZ^2hEZ?`AH8I8k(|7r!~2s-`vsMT#0q})bepq9m$cE8 z>WYL42UjP%8y5{ChAdd1->y$t1u7V%Y`?u&t_vGR5XU)FvWX{Z6Q4cj%b$-WTqKj0 zd`}pbe5Z??aO|XfDN|4=#!8u;IZnHWd~tCrnz*G{+A~+9PDxmiY)FjAD6mA7%|J zg#p0y{*i7B7wHJk#rjFoR4o6A@vrnmLwO#)@N3D4CMExMMy}jpWw^otuEdqlXEKJ3 z?1aPk!hz*(gmP&HAh%&!V1tR^VdR;)~ zR|*7KxSxa3Oh~np9esNARSWEk!^zXD+6*dcU1=zIU@ivo>EoANB>KVc+r>@iEbRov zp8IZHZ5zWP64=?=XKhokVM>7?F!R2z#d<%-Zq3Dde)uTmNp(f}JX@h4A-o;S^@=E{ zQ*~QOIY{mopEg-?l|hY`3T8|$>0UfqQFlQ%{)0sZ35a#NDVZ25BkW(m-rtym(e>`6 z_9`!oeY8B|Ptl2%Rp}fd*aX`Fj%UcVE6hT{UjDAgtty3E-VbUGECIwOfdPFuQw-R{ zU|@HgXZmn60VSWRkdhprd_XHHr7jfq8$^H&L$04q7T1oHoxuI`y>#dyKPBxFDl6U|i+Y>q}N$ef$5DON|?r5HuBU3L_w9tec%?P>)@~BsF z8~ae`9LUbWry0j@wM>eTDxS4O&?Vot>*fsee(a8_=K|1`{aoVGaqm!BTyR(zLo1&J zJ;x{=XfDc0^`4!g-afcU5JLXV;i4IC=G?uZX6oO2`r0@*EKwpO1+b)Zg(FE$?DIqK zU!f7I2%h*x<7pt^@R7_u?Z@#cT=tqb#%GA&WC%jQ441~@Nku%7iH^Q z%xig8W8t)JTkD@)ja4?dGR-{MImxF$ep$Mxo6=TV9_DvXbHd0Lw+7GndTO-v!nl5d z!5B9&K{qKzFL{vabi)-v`pscQK#MB(iqKGjVy2(%*jH=yPky8homMiwJn4QlCkwR| z*qsF9j=hK|_weYycxJG|BcrH5wb3c69a&@BT$g9<@OGLDlA(mWCW7eO*iF-`W_EyU z`^ASL248qYXTz9NHg(z$w^H9MJNJO#Q93HZKPfX6r{V6KmO7;bs&FggTxdm1i zTr!XUfykmIL>%xn!JdfNbPAxltDL)^7mIaw-l9$|r&V{2^c%5k1@%y)go%*u~j(*G_K4t>V^>;25Lb5A0dEj~eVxN|hH;&ux4* zGz_DKPF-6XHhZ{8yDBHs>=sd`m=eLJoMt0wL;}odYQM2NKbO`b1ZkvJTW~}q5T}J_ z{I4?t8gpiy)4?;J21D+k-uR3MmX_IKRe7*-Q$u%5>Mz;LHYRwo!eP8TOq{NmxySf?Q-@Gv(+Pj)x@hE!YM47D*y21nRQ^CV{u#s%0LDoHv-nhp7D&H1w8tvLpkJ{=+3?lFA+wyRN1 zej28AP*{bt1M}s~+;lH-R|B@hI&z?x@Ht-vwpF~UYX~1=;eQDm4o@zASDfz2>s!61 z(#zHiGJsVCIrOLd{oyoM-n&>QfG4-|hvqrgWh4Oa%z4j6Sxpk?L2z65=Jj(>5PK7p zf77_&HH?u5Fts#%@{A)a<+dHE2u?#Xwm?5`_P9~m{FW;Qj)Eg26p=q~Ll zXzSwp8ni&(+)sJZFhR8iF=t<0s2MSV8L>&)#LOMBJ@nlaO@Qb3rQb2FSO;5&dKu-(;$g31)@6wi5BV%MEL_D`j?Q*rZtrJWS3ew=AYii-4 zhWy0c!)=e=s-*STMh_xt9qV2WYd%(=T;pmY=i}br`{(UX1hZIKq5q_u{yS7C1M~md zc}=Qs{?8G}XIpo-b5v*`d|TO<*U<{vawQE8?kVm-pfOR+*Pt+NgN6V51y3Tj2$$M9 zob8uJPnj_O^}b6tmyRicscTX%0e3vumr4ELG=J@V_D1PxO0}GB#Jk;9G2l|dLI1)P7>;Q;pan}`gEA|TT|&HOk780Iw#WT=EvQ| zG*&+@fO^;RS3H#ER+nqUqXJe&1%m8mS;C>XzR6M-y;KZ^`d!&o+Wx+NHWb>F2~|=} zY#Lm-{^$sKFceAuY5HSb#|VRF@^}ghxjgwzO;b1^o^m>q>Nvurvx6H1Emhn);+%1fvO~y;cz0q{ZZBW-v7#tx zoEGpHRUfV<#vj#t<*@+{`56gFrYQSSZ`22{R7X9!#dc zu}l9eio4Y5<#v_Utz*{AvKQN&LKA>|7elp>C0`jQIQz_pE#lA_EciZZY9ZJbmFCeF ztJmu5ouC*6(?A&R-^gE*7)4jBjZ9ins1!D- zEPZ^%d=;v~L~0;cm~g6P-czl&9}SoB3jL?KDMAKg(o-_VzNT%9;<%Y|BUb>Vg+$OT zlxrd~xYVaxb=-N%PSH8NExSey>5fH4DH3fjb;<{xVX{(6NH+%0y>D)I=k|6y0?f5g zF2E8ep1h!-nl*l@HiVO_DT0{z91zopsIUPrwI6S_q-ph3t=w+L` zSVF-DWb0s_a>J=VrOurHw{Ca}OB|0Q$SM)tksHCFZ~-!jiJG*SqMNz4GVX&`>m7Av z{_lTfCzDp%zo>Wg#*FP@#3$lJ`)}Rx;t^socx&vO7^jei9RoXl_2g?PMKU-jc0ZIe zkz=MLK!pU$k^7^_|5^EEk+bgSELLd>J|`%5T+2%0C(g!kuy=3xJne23{sOWvxmsn9#Hz!~A3+!>KF(XFs3 z04}3S4bjp=90`u$5J;kpy+_`%Fog6a3kcMF+hW%E^0_AV1lRM*-QP)N_(0G(P;ZSfR-{n9Z2=?4M?@#R{J9x_~wy zrcr&7$`CfD*7FP4;Un@wiPu)GpNZW0Y+hIjEeC;d@EHVDE#9O+WA9JLA&90w?N33_pmacoq4lbp-o zbtk*jpw$eRdR+p+kIpjsK5u6xFF7cK9qMq3Y0jm^HgB`u`8}44f*!`kL49-Y0vcT6 ztyLGk##X9q5OYSkts{MNO8d-M10mxsjsHC>J1SF16 zk>w`)7-59`IIfrwP>v;_1vn76WSr(7w=^xF-$qlr8Wz;-n!lIYQI9c) zZ>*hKY@pt2=2Ov0{&`$fiJmq%0z6B&I7>ZNsBLMY848$K;L2Bg-fndag8rO%%U)2= zp6p3L8c1!Gl6>u7t&$aHi$7spjX;Vl=qdeTygA~ZF3|a&lU}EG-mbZRP z2fh+-N_NVlIRh18eFSCN&!B||@j{3Qx_EyXc1aK)#)XP^Sth4QLPvQK~3o0qGU9OOuj*wnk7{ zyGQ=@0dLY&M1FUfqbE>KK&G|bDoI_L&Wr0ryjvYdwqd*bM~?>%z=5{~Vdr%n{-OiY z$nAA>7+z~BN6qusFU}_bS%a@C){91^dVTe~IbQT9$o?*U%eBPM;aT>*W5<3V8*ZRY zG?5BQd=!z+k_*2CgYwPsO_{5HmCcj%sVaLEruS2;1?%(_F4KjTR<1A)4$>u|=}Wz< z&rw~9>gl<8pQ$enuV-(}j8i(42s_dYUA2?1mv3^!7DHYY1g;SowCKq4;gT?dbc=yo z3IZvJ2nh&{eLF)uCuTO3>uPS3z`<)9Trd26vw;>q zqmunnXbEAg$`U4qOm*%E=x(12m8z1|0il^w543y{{y57f807=y$30H~Kn?Q2t+?_( zj@UWngo6?V$coprz=y&^2?3US4L;cl;zU&=bV0``6~lYY@1Gv_?o?2jhx!_{)s*l>J0ZjTH>4{I}!vmziI3b8HY5}R8 z2z7a*&h~qHZOT!1W5+gOq(7l_VX^wi-^6{fJH(+O&pM#sdx9KCPNY5hlSO7;iY3Bn zPgw2_q07pR0Bfe92}#$9QSGH`TP(sWIiOC_4%XYPkGk5LGf%=qt_=sk&{L;~YFlTZ=~$xld$ z*NtpEwXg&NpX2ykI7q^%+_Hh9kZ?da1ORy6WAz4^A|N3#^I9O53+WRUkVjA!oc?dq+UXst>z_O0K-wm)tU)Y!dg1+l zLCopvO;nDbt#lGWt#3&*rfCT>HX10Y4d+8lER;>npBOc*A`vwO78}#iI=u_Q0AvV> zG{RvI!d8o13y}#zlUwW63?MCldZjW|;zlDGoh{TaAZEY7Vzr+p!oSdsjG)56=qRXM z)8|ExNnwJn7E^vxF`@bWTDp|#kWMz%APEJcU5iC^uV)2x)K;H;KkH`W`nb2q3^t1DT{O!21eT0?8A>=mQ##x{hOlR(rjdT(Z}Cfjb3D8^3jy&yUv6pPTKX#OqLx( zQF7=RydQUhF69pGVdjD*b0gF*nEyzEe33xor2eu;{T^IB>=X5+j2Eyk3b}1p9h~M9 zW1N7KXnFbREM+xkBuZDz%EZ(yX<#(zwNuuRcj$sG-HXrQ>eb_ z=$O2Td^`w#2~~mkro*@^(;{e#k%}b!%EGuq+1_AMH?)-WmA`freLOj`tverko2*FZ z_y&E53YcPdak!I77I!?VT*W6ny%N~RcUEYOw$e*do*bJPakX_gCA7h$Z41w0{|pl+ z?v>nRUQ>7%?w9ea0R$RKc6@-vNf0a;n^6}HV`XF60^e7e7n!^q=xsV(2wZoWx@8uM zN!4{;F&JWCfG+nE)LVrPiIbh}I!CNu{!wYaT(UVWtBP9D?*-OX#lEg_rt^F0FYk5y z1ZAi5GJEegUC%DX$27+b==7j|-F{O3CnxLTWcqERAhP408~P?0QI@$(e^V>j_2PYI ziS%*X-<{ELweX+blmCv_$il$(|L*ZGe;gS59LPVtIJshONDi(9opSZe^ZfKrJq7_@ zrw;+Y{}=!_CB!C>Q68y24a(gvoRepk_FL&PO zd&{*@RZbMzzPy0Z@ZNBup&n0OOkVFs%YY(H1=&g>Pn_udyvm2ds^%OL$A*9jVA-{{ z=|(Q7K$vddW$>mzPC^pqphp}Uu==)IS)y87Af#2P&0_yjyv#ahkq9SMfElflLn1|` z8Upo~^Qy0Yv$1uZ;CV!~Ge;ybA@WwmKXY#^l1$Luji$3GXH)6gsQg&p%Iq{J_}u^b zO_!2MPdU~K-*w1&V8M$szDOHQSH0hv?3ZQzF$f}Uen%l?!`{>Zdb?g;E&`lXG(O>NC|9Wqq1c3=X5a_14mQ^hju z<&A_nB~48OD(Y}g)pRu994zl^R=fHCF2}V$86pW>yj`}rt+g|97c~Mxo7ZDA(6S+Q z^bVVKcGNDMPg8*8hN(G(neYi|!B+&u=s;p>Y&5E=ExwbjHs4ed4UC~|W{Ufxm~IH!tlMam969ppE3uXHBm4DwF#^`^@!Pz3EVX^x_a9w2;tUXz1Z%$bh)Oq=^s}=Dc1;huUs^W9sTeHSX2R>qAIgp~C~y z`WkUY|G+PI7m9-_D&|dTs_dNBm-i}6^qiQ(xuvSW=>P~v=+F;*&;^Br% zqL_iQr|0B~aL$kcIH zl)TM@t=MZ}P?E=Ou8bZXx4ae`p1i0n6aY)?)%8n6Av7tISSG&!P6GX~O-#Nn%U*Nc z;0Ywm4Mv|haVU%X-3=U;gC)8ZsjlGosMvorFYfwxIaxejLz^T zqXGg99f&zdjil_x64CZ98fZ|Wj)-lX)o6^#K><-U#HQK+Fw@Yp(GB3&(vO!j#<5~R zv3t+9)}&#BwoY6-XmPD^wFCCfk~3Bh!$ih-5zvn3ABV+dLu5B^_chi>ayX(Kl_6Og z{2s{@l1U12V6!o->MflZMur9_blq6DfR6`@MxV9CkXBqnBtv+Gyu7pv_$iQ<9rke& zPbM{tP$tG)F@I9E5gn?f`z9anxAy5cf5Ki8n_A$7Ffq{Eoq$2dHC`ph1eE7JuZbNfE$wrqBVC3!Bux@_)Tj z1#UJ9{vXEvsY$e8>!L-=wr$(CZQHhObCqq|wr$(CYZcG>;>JC3cEoqT+f&f#oc0C&h7Hjh1)#K)&lVN32Nx0?z-u#8JBz zVnUB*&uHHKu(I7mu-|pD2gHZp9E{n#Di-c}RAg0ht@0gQ04Zel?8P-qoH{si(2rCk z#AVpHw78KD^bI%BZ6BDa5$7&0AO?XaYs12A>0{(`_01f*n&AmVh*2}<*#KD!qFKK)F|VD zuDyL9J>eMzB{*?-fV?n+MpXXR!cgPh&IM3C7P#8fVAyCloPE-6C>FkVQX5v%7wo%* zyDsNWwUOFD3(paq7!V35w(GOL#oCfXfVO?4^qZQ;zNTNFN(LTZb6Pq=GD;wzjf|KA zqx(2*4l*DyFCaK`q z16X7(Ii02yV9e|dN@Hbj{#sq`ip}A{NV#J-DmOn9>#QlDVfI&8tCY=lnX$>^r$Lez zz;ACyOMAW$bujpcS?!pYxE}U{(1V8&n`G&M1W%H6{gR$H^szjlzbm2&o0oZcM+ZYu zXi>&$;h@9ktT(9Rw&|nh#F-4xo#g&2D^Pxcn%S({jBOe!haVl4%*le5dm1I6o9NDPxuq`caR32SA;97;r&DfYFeRN;joL zAxu;73k)n#6ZB^?C5&xPevqhWwKPs*Nfa{@yESVTS+n0xhe67~ci&92+rEe$w~Z0W zH_eH)YLyZAE}}-eCUUka**?A-9OxUg$(W(1HIw$YV$3@v)s@rqIB9`l%_@MVUW0He zi}r|H@|yvU`{KaIK>DdY2mu}n?TrxORy?KwvAx5V`>BI;wikn@Y)>^r(>jlr105wG zJ%l!nTX{e|k5cp5A`J&?b&jKd^K56tLYm_GRUtE$#?w=jPj{TaMJGLXUIOrSt#moU zU`^|Q9#*PhVvVSBHKodlB#y@LT`@T|!#UVAY+2PzK2Z>xTB{u+$7^-F< z&zCoF>^*F2B~CD3B|gB^muEn{Et5J^rM4{B^3RRfD2IuB>Yx0RdWsaEGO44CuE9e} z7F#CX2l&pP+l!r>+wpjB?U(ud^R$v@7w!Lh;qDbhCidUL+W#g4WM=yhe&j^!|Id#U z_+@shR(trU2Ed-Tx?TM-#mMxHV(za`87{Z+Yz;2ec-wPNrVwqEZ^+?t%o+e39ADmX zuIuI|d*|L4jKRml=>Nx5$_3%e1*6vy?lVdshJcr$1GWL8(gf z$SXP@U1NB!!B8-8ppfN|4kX@jb3D@^4j4r$*%)-FhPveVdQJhMY6A|;YSrIE$Df>Yd_~R!VIXD&BcBBqeh(CK~Oj++|AYtS~nIJF9 zZw@$0d(ii*7yUtlj1XK<5|wf}+{teMskW`jG*Zul8*7yI?zQY2vNZ_Dv3{M5`+Yx3 zPyn;J{IXF37Xlti_Xd!wk2(haO7T*ew=$7dI<3UO_iMYF=r}v#(x$sSr;e#g`>bf8 zT4yggh`aFU;=b@jp@m|5x%yt<3dT6Gb2HRy+j5aUxRso@*8^i5Ufw;EUJ~tddBV@b zg)|K!UZNl95sz|bB()l&)8vS=s>QtXLrPsg<1*3`z*;>XV%mTd9WZx5VKvBp3FS(j zcqnaysE&F(m8XFoZ;HhKq^()XXhI-}-nXu-s2SgxQ&t>>wL-JHV~@KuLbFu$kUiV* zug_06x@3R@Tf59e)G)&c^=;1mFx>sE&|2|HATK#J%SeBeY&o8o<&aO)DvJTuNqpEH zvnn>wK(Nk+St*Be?0>qzIl=aIJYUYXoeR2M;Wkne2_n->+@qE0s*g zDPYRj>vGuF$Liuaf3zo3AXpx)FQI<{H*A55_*D8Q3WT}{P$ zs}RloL@4E9uN7Ehq#u{-CH z#jM=*Ye@+RJ}g(jB(pH6PZE*Pb6B_KO?WCu{0z^@oRaK)E--7exm`3Qw~UzDn^Knb zYE-r+MnxS3WRG(zGhS03zLsU|5sQ~>nu8PYu(0>P}Y#a<47A-&>aVh zp{vDe;&?HV>@W%map2G@todW0!ed=8S5F?V+XftR^OP|*mE#UmoYJfaS7anl5_+Zi zSxBth$+9mxX*=^NQiM01hMFi7F-;a2uyyFiTPKEP(kC0}*cU#-tU?vs+hVaq0aFPP3FID7SZ)d%u!Y>ZFv=f_rW@sX0 zD-)d*L{Hav-|HP$>d-*?0y+kI6j5@rx4z6n z^}CIr)M6^?&h{>Sg{J&$l|h=@R(|w7-c|V?UOM&cC!t>5+7N`1H&^{5T*c+^8vkcq zZw)5h=P|c%c8v$WHM$Hcz0|(#Z%@L1Rgl&i*k>kEon87pX-lE%g*1_s96Bn)3J0Th zZZ8#0L-!du*~pa_LCK`9#CyHpM+LmMS36d(xP0Gn2O`W(8YA?+ax*%JweK8`Tl||x z(n}kEhf#J^2Hmr7R1^lKS~M6XrDnI$`#AZsUtjBwo6ouLqu_oP8{aK89}0JKY~EgN zCoxH7DhAAVq496Zyw|lCVZ$gU#jN?)DlYcx$7Ih+jj{ur59{l`CpOPYk}a%uwhrn) zSN-{L4}vm`yf-!c$vZeoP!VNhXwGfd>I{@8U?r6(88ZbFH4I}AXH%Y#lvzA3EYs6dNVLFb<~{s@FPseYjbH{5iZ-K4P_Xt84eAnblr>D~xq+n&>{HyWXmW?J2|f#kSA z>prtA4O=j#FK>I>;B1mGkxq|?71R&Wapn>5d>HA!VQ=pmV_`-iDqdnT(0R!xM5!X8 zfZJPl>DBJ@__t*3BIoe4-pJWr+1D&Y$mibNzlZYwoZkQ8k*5V<_1U(7(+xrdJH8rg z89Ua&!H|kk))ng^)LMjyPoDCij8t*D-#AGEh+q`nJnn?1q51#}6p{jZ z4C3EV(RDyYM^Tz&(eKV7%g$!Xj*z4(VnLAh1~Qd4gr{q&ER_*Y#q!^qBJec_83?oAJ|piW!tmAfP~)%g3SNzdGDH^0-q z*CA-S@7~4^^KN5KpSpX+3Cw(Md94F+X*C9>{dPo(L6{12=c@;(8FtP}2?|m_Drs!q zjqrlMhM7jch)R6_fqB1S@<;}e%OdkA$m?j9XY)=H_(Z9FcNIYrCSva0!)nD9?{}O> zkT`H|KtY!9+Ll)q8E>UQRZ2D~)bTN0(!7f)nI;ixCKM4VK+OjKO{Q${t0e4(F(ijA zA}xIQ@v9)dv|~cCqNwC#8Huk;@m`Lb=1(D`4&NC>3D68K$NmQ8V$7ylLSbAhKQ6o= ztlX1<86vEf*nMR6@2(B7)pTPn9&rn< zI|T*fyf^t?*yXJKTL{+~z5hw^hrU1f8 zGHM=}V(aGmkOw|n$36lO33rbtCUJ5ECDh*^i{qSGs-z*E8C;*bH;O=2>YL#*swZe^ z_bp7vEt+G5m;?l$uvs2(rEUk__t64hZUHgGiIhJ(FmDM4ImgE%@NW;&7ea{6OR?)E z3EpI-CW}ItE%xen&N^C?^-jDp8u&cjOSpJqQdDLSnT%-XLQR&I1X34&2^bsl9Vqq2 zz6nS`ri5US_>8ZqJ_XYoAphz%BA$0gZQK}XS0xfItd2b=0JDm-I`OXVQ;Zz{nICTs z0%R&v@hvb2aLf)WKu3)s;z3gjw%2W&`W!BWmJc2nHuq>R6f~lE5u`9Ghrx;d$=rtJ zs=uA};8M9-ErXm}F)}*s1_4@*!@3wHqGOB)T7?2;>#(d}VN7`H#deg*I$53w2%7MD zgn2UFBHUUCYDR)S3nb?}Mxfi!RGKWuQm|9mt+c94cWa#qPjpiEQv|+PX00kW7wiTG zUnEIFci<>**3dEB^s3Iwash>yn413sqmT1)czof90(0s}T@m(}y(0*heA&%t+EwR^ zh;NOtUAAt(d~bV6ffyPhsM|L<31xZ?nh&@aj>^a?kz`$C_#4!i)dqxJ_nxK=2t&o_ zQY)BokYSK~(3mcK&pbnx3|)AnXx@45jLbqg1M(>~PN;fF#c32eq#`oK8NJ-8mHQ$gDjI6>TPt{0?!NXhmA^igTZlblPBZcmC*d6V(F`Vm0rzf0K9Ejl z;Fm|YZF*jMS?^Xy&igCZM^v zZ?3H?u!@lG{e`90c4SlV5e=NnCGJxy)ispOxXW#zJJBc(mLN&z?BT3kaF9VSR1VWb zjw2SrOX`LF6(_&c+X?)h+51w}n8&CAs+6V)c z@~u#Ms#b2-T29x9^XJVn0Q-h;p0(82@={yH59K5I{bjethr;!ZpY2e>`G(m^F(ouy z!5_8*h5e|K(=jeKHI0xzGG%G99|IbHgaUoiPI);}n8M`N+QhrCBAHPkFsvF%&b2dq zeXp5AyCZve-xA@%>V_x-Wngvn+ix}@F{BYRe!g>XI=n_g93x$YX5o(Unoclpm{iTG zfPhC5eMa0sMPPayyVhA0mZWg60Y(5A|8|4)x8gtix_yH266nNJrho;s7{{#INxlV# z@GT`!rbI?ap@G0*D4}*)-hH2WZ4T_4hY*p`vvO_il?frv##8gPfv_?=3}x7xHK}_& zwz%*V>MR;_P*E}Bz)yIvB)!%D^;$we-Rt8Pa4Yy(62W3qUpdDJ7x4BuvOb&d$Kt9k ztS`t&y++K`#v)*ORDyMY{)b1u0RXG0^6mY8xqog05Fl2I(2Z);D>-?e{G$ z`o?c{f14R9vQ{DAt&#OR+s~q|9|`B`uClxhrs7?<*lKqsP%bb6YYK=)et(;$~L-C@z z+^!OuyPp!G=Lm%yjLC?Kt_B(2lUSHSLeO6rF8=sU^~()O3A+rHm!Q12W$msWq8k+8Z{yw_oK-54%f?WO63av-gEEM9CGOZ)HN1uTJbr~e`nq4`1G#mqc!lp z2-PGG{O2-fYvPTszR9f+=We`xjbhEwB54M<`Qob`olKVq&UNGc+bD|cFqr03<>P0? z%Xq^X&Bi=~!spJ?JUHl1pNP`T?ea=ifbw!tc*DhBT{zJ_qQ;OS8Xyutn)6i#gJj$~x z9h@4FN|YfJ?&htY5u%r6ny9ERX*blGO_SMU>_Yq9JIl4fTL!vQt&twwD>;XTRhXD< z-Ll88ipv(fd9FE!k9Oe3&-3NB$n7gbe?W{7h-|S*OY#e z8l@HeT?+Cw4 z9C&yzd6c=XybhcgfY>3xjW$8U5#X4~o3+U6h6hn$(1hI9uNf0@;}1|P_u}Z|N704RH5IkAUvUn@x5=p57o2v69+DWWN7j|zgfi7zB9Ps|T^E^D zQ|U!|Xr5%b-zV)PX!l#XkTR^{u$ml*dTH(96b~Nm@Ao}C`1pAHaLUC#?++e0Z|LQZ z5SUuq)#S5YjEK84P9LrWuUzk*quri?&CqIbdmRNIBC);hcS{PSg>~4)DzepKEO2Fb z28WyV>Zq`zQ_5OVn)i}vj0t6U4DQ8}J=o>#?Hu`ow)%foZDeCfbR3+KN&>FA5Yl|P zglRoMsp5T{Q=)a^kyMjab(04*Uj*t3a8bW%gYLQrUs8NFo+4>0x#+BwIi}r#_0hYp zDIiH~32MCnI@^={qfPJ!>Im&TU;^DIQ&LpH*TU%2LkjBBBMb= zjOgeFRblT)YeCu^6eK5G3|x>f=gT1^Sx123D2Ja|O*nq!rg6S^9x~y0-pJuZn)xcKrrIq_#p9vmO~|=s`nn3H@}O$ca5bq`5fg%*4q$#HmfJG-CSQ0Gn}mT zj1+#K*XeWJ4HJIVg3}Kf;i|{k7ViLuooVfDb|Vg}wIfeJbT}6)*hQ?RQWQoGFYxV& zXEsHza)Ny*`mJI*NoH)C#IoCkS_N~@6Q!Hvkp4xy+}olXhCvhbaMha)^Diw>;n|ep1z}`Bfl6rAu*X`MhwY|Ru z(NcUFLJu9#>sIHX`FH5~eCN_*kfPSCAAa}^OoAd8C!QRB+zLP3824b?wCO++LbN@HAX!&*jI1*+MX<@8mn>yKU@6_!v zZ$}Nzwm(o+YfVHY%XGHzw*=qR)sDUxRZ`GPc4#mH_aWNd$Trk^bJMXdl?WjfjI{GY z;HdpJ(sO1|&pu!cLk*%hU-@?cPV^lQ$3^$7V@BrVQ~zy0<=5Y(NuwS)iRng~EgWlk zvwchEeRWYrIS=^=<>G`cim|9n8roKvZ3H(LNp;fU(sDKiucN`*$NfCrSphCdK4CFO z`S$qtum-diCeW@KmpRlLCPAvC8toc=a55cA#j{bS4I?^&TK+Vv@56Y6O@_g!)3?A$ zzLO-fkhP7BJG^87jB9#glumW)=lE@rMop)=aJRpN;Zx)6yCbir9Wcs(m|nCyVHS}iY8s1vICvU>H_tx{Ru zh5jWbxP?j&4Z*DNf&629v&wIo>xTVl;;UE@Ub^!N5(SSu0eKV!>@yzqSk%%D(yS$Jqf*oypj-{i4~btIO;&fc^cQ8PkufP=5b$A6a8QhO1w4 zn{vypya!5uz+D%0hJg+P9n9FEV+488k`0bFSFfndnGR8*ff_fK_Xtta0+VQ8nVH8c z;l)j-I#I;57VL9`HoNt6`Pr>yclopXIT0B$pD{IH%j= z2t8Q)Q*<}XgL+|#e)Fc&ZH@KCV9W?m8`2VKF20nU(*RI-a6$T3Q3z46IFMzn8zVIc zjeZ~h-GLIY7EuiKsssFW1=#<0NdL-p&2JhNgv%&-tm(j%eWqvm7>l7TP}|MWOi<%j9aXMP)G&wpGJz#amPrIR8XA6i5j`+BzYUTb9>N^K=+6ITzmPFB%+I32-qA>WA3uyV#GO4{$xyWilkhR@?jO zTTThHoo5cyM`CiqFLN6KC&1|dGXJs7V7yJCYdN>N`rbB5oRooY*e-D%ZID2p(=6>J z>y&gn1w{O;?|4Nj4&x(#ij$qD5KRfl{op2sX_vBjjxLgNsyO(GGkENlnWVR5GUWB4 zbMKG*M^*JkK_ zW>^Z_IE*t0HkY`0_o)9Z-s^Z0D0LX#goMRpV9J-VW@O>+H92l`W*M0!tu#D*EG4w> z;u#lt^wOH#(U=_c!8RJl#{Qxfh6N zB}O3$KEiw#Bt_s-z<7W?Rcp|)0XZ!&6;=UVy&Q}s3p~P}@zZ>xMeEG`GB(LlklL=+ zy{8Fnd(xUnO2}C5HSDUEWI=Rahg$hvmUf>nWaUc{P%q#}mF&%!Xt}VzP#S7ozMwf} zG{2>l1%))S&d&B{`FiVy0Z5D*p&sBgug(la4bhBGWjHI|BO^Y(7B><%Yi@;~Fr zFJ>2}N_!|9eD{YuG;bJofvhh(*}(d67bg~2;Im)=uf=Q?SX9--8|+sE#p8NGi>_K~ z`f_no13X00`b0943S!ApGSts_-GMG_Y? zRCVDYq_%j{>_~h?sobn3jAK!7jzfLmcm0~zTEQx<)pz~OWmUlT)Y3=L0t#|uEIbHp zRf|E$1i=e)9Fvokxkb?G7;{#-lMswqO^kD+hENt`(l!Vf zz0u|@Nkj#N-U2hk9AUP8s2Ef~kWPicj7#o)&dr)`(@=%7h$dfr<61o1o;pN(jL%Jl z9yfZcr!z*O2!&PvSWRADO*`dShl=FReY0SV6^=(nWj+7a3!eS^ncW}LdakazHoJG$ z)WWoOlB@vIibDqfUGsUHVXI)irz}%YBwXWt5a1(`6ediD0tt4$;JID9{8BCc1|7(m z>{v45W=j?_LgXUKB5WmFH%KF?OQ;}pS>bIK+9a)(fmmw#mK>1Xu`yeLC zcA%0J0iT(wNT=CzAEE5oK(UvtK(J^1@B_yrRzSTl)YpwC{ABmE6mU=yv~kZ@4t2i} zY@%=VXG9E`(8WJ-aJ_ZDItQD>bpvfh3oH~H08;TrSUk>>G$!FmX2xN58ZdgUU<%_wgaD5Ao4o*~!52#YhhXtN) z^kAbEeZ`}SU6j@_k-Tvy&LgOgLFA}p`b{JS2{Zl)@NzZ-mC{el%ltU_)?8({^DC7~ z=mGhB_xjZg{lvPs)3_Ky)I?tswQ7wH`<+wbq8EBIy1DU zfKfL*A34XOC5jcUzI#>A*%|6UQB^3)G91Fz`H4tUzR8>``H3D;OYyRn=4I}@4+%fp zOCR_W-7oh?j0RXW;`Hn7MSA~QAXKKN`#OWanC6S|S$?RXK{rc?fsMgIXnArkwjp~j4Vab9v`hR|$$&zwzhN6Ec&am>bycbe!{QS{xu z*~9~f%l>4~H}wIIat^D?4rUC492+2Q*AmJvWvn~{h6Et9iPtEe?10lFxI0A8gRWMH zTssS5SaHIM0CX1tHyk`{h0uD>pqGXD(=XE9XF_I8a62g}xTqAn9@90QVtHR3M#kkE z?fY=mpwa#&3|(foYRFV9Mtr`n!xkO${!0SqJ4SgAm?bk1o(q5vI+~P*@UfT;j6dFo z0d7734ut&qIhAU6}+M?5sj%7G8#H zS~W|D5Sb=!f+Jkp&-FazOWar#!D_8Dh#%kg-gTItZ>(YFh~9_KDuMYIX*Oi|>P+wY z8Zl!f@JwFVG~_PWh;dGcvT0ZUAlH**{klI4#W;#BCJ$|SybZ0SO?i%U!khFkMc>u> zF-6;F&6HL+(gxvA*;(KI)MSLyKu7I}tvIKG^`w5>CSg>;<)kVclN1SEQF(3uLO5w4 zl?%B|_Hs3F$w@L1D~h~ur&-TW9_HI!?|O8njgUw`X>!=qWw{Yo)t4X7((}ejWS4sX z#oj=-SgE<3jUl^GMu7&ByM94=N(YnOIut$N7p1SG21R=0QSjgo8sh_IlCv0o17oqy zdrg;RLb%N*#_d`MX}xI0O-qPi=3dS%JD>KR_#%9zY?? zxS(;TvmI1LBo$8kmPdLTz#DQoUYmt z7X#Z{z0Bv5`oPiVh2||KL2hx}p@Us)!4o5xwB3ZSLQ+iWlt>stbJo{PZWze{?n`Ui z3p!Ff#5`kX^F_95u*(yMR`I5rGR8PjjLxSNy;HAs*Ww|aWP5_HI4p&uovnkJKi^c{ z3{-J>4M+VK%G5+2gQjnyIZCH=SKo`KQ3R3h@tdoctM85+|q*e zPijc3;YB&IW*n}j_my+^TQeY3Ku&^;3{ru0Gc#~ECX_;p`Kj8%vTlb`O_*bML2*Wu z-~Ma_#{Bhr`AI%s39v(zH@EygS+o6PwRB)U&XtlwL=RLtz}nLDFkNU*a%?Bc4Mr!+ ziY`=vRxJK=Ws0bNCV^V~Q;aaOz>8?~6=E!);EbYy$oyY$GK@RwFxc0O+GwYKvzSZY)l-ofYePXg`skmg}&zl;x<4 zWEcy1JzKExAetUY$wF?zAPn!I1Ts+=qdOG#%pswGGF22Hr_z?UNWh;E@s4tUVy}eg zMG7(_iFrk`%z1N^i8-O9@s|aXa(V@Y5D3OgUKpDBxp_I1gnou}IIk(07mlTrsQ^cL z3yR%(7L+uzXA^Nt3#6n7v$Fenh$u2#WJPkdD^7yKj}07$&4Cw#*f|J_aSCrakp~_o z1VwZdf*OdhBu?*`A|{-3mv}JocFMC~bi2&n#H`E*fNG|R#|e*iE3X)_Fc>kS0Dyff zmjG^tE{17eYVPk4us2ixt11O3bEO2cI;>J6ux=a=IGj5pXs&WiHPj#;EoPQE5#vPR zN*$DCOQ@%X^Gyk1qh@VdIjo{;wl!X2u|>cc_S(o6mf?)7bkAzwz4Lxk`BpiHw0c$J zk1pqXo0pc#y%zBGo6ts_ex_)Bz*Nb^@3>n)k(~opBoT{#^VeXZSaKmKTIB;E>Ppo~ znimv7HaTZ+FVjHVOE+aVT}uPh+sljCXjlhCa`9EOP~*wZhMm_ z%C&g0=w>jEaKulad8C2rq6Ykacs}$59}Kb7C1?XZPcFU>`#`ajk=n$X+EKz0p86$C zjDKYaQe)SKz0_x$@H`2DfqX1uTGKP*WC za$4P-BOCA6DL;`U#-wZwcL(LeuTQg?sFF?Vm9BJczuLjKh8m%zuLhVr>hBbxGSczX zQrGpe1~i>LpPpxy(5<6f?=OHo7nwx9V#s*f-w#3-ElTx08S(^X)-y1=YO#tGLF|h+ zs_lCk+{D1iR=Gj`JiOjII`62MpZ@ERP?1_y`%}$jicjDm<5a${aBq>Sx`DeAK3DqT z({*#Y>&XviqN~Q1j5HmNE{l+cFjjW*6)Oz`M&q&qqPh9oP?9CX;TpE*dd~pPSTgZE zKLu~rvnzqYZuWEa2_Jp`DDBbVa3-{`{@i~PyN#v43wQea_r{R5NB1^I8;p%-ZFVSG z#O*-oiNS+8a;wh2MbzK*?@{yOPZ=gz?iXBT+5mXdQxWrTf7o6ML%a8VVXfI?(Avd- zbrBKemEKPIt7s2C|F4fuKqStCnnHEKJ3I

4nFMOXaVX)Y-tgz}^EfD^DwdUo0rW zBPetf<0}OIYkLk`Z>{z3VZW4qNS{_3Te%D? z90(`J`(GP~lMR-Q7Ai-It?9L-#s+R3{qeJZcbLU!u^Uh*ee_p3)(kLJnmPWTf2|xn zUzS2?A4)4Ty?J~uzzS|tXFdJFTyxb0b35<8(XriO+F}?e4QCoraG@u zbZ}pwO_`}b^HM3|K{I|WmLe?-4tFWB3!_J_@%=wwF%JPS{!7MT`rq`lj7;qRUpQ*! z|CO8(?1w9fahz^*9FxKR;c!bJa7^$(MyY=dEHoo6M5#zzu0`$o?J=k8p7v@_BanpN zA`pd}^Eu<%n8jEDcjq-;T*6GqL@;_(ze_WrhNUb zO}nBfN(lQjL}ME6v%2S2kkL+GR=d46mZ^ybdu^#+0z&Gl%tRCK-CSM&>h?2;L!#EV zB}yjB@c$dRon?=+h(a6{9A-*3DoykIazZ^wH$7l?a^4((m*e31dOSSg-_`N^JUvrC zh5R{;j@L555dpw+emlzJwp`sgUXj#`QKCR{=O4aJtJ`d~ya7-9>_Bne(#g8w=Vw;` zV{tb*t7EPC>TN3ULR@z<)tT0HV7LQgKU2bu&n6ps8|=D~ULvaeX6l>hHuvMx+%<`s%AG+H?twSg!9?h@b+?1pOD|Mm#$NfpzYkvJ6YJx$31VJdO`c|X6&=^)+@sv z{Y9xUGUYqzTHf{s>ZA8MZWVE+A(8#j5BZxAFnHpACweUsxeJGJRuD}PQ?9xGWfJ{3 zM1Y7yFa(0tyHSNcx?X@|B#!RRm)kG~1aaW~o49RYm~M!w%UGk#kepJgiGT=&(G1P6 zC5|ygv@R$#NV=C#UuRu@!zWxrSgw3xsZf2x9}HY@c8Uo6Gs8Z6aZm|mh^-W=eDNSb z+6aZ*Ei$_}%DdPpd34ziC__L4%gt0b02)$Kc)Yi%gFCsahfe9TEP%C(t8SV)1?nsQLMB6jfWI_4+Wk>Sbw8eVtZsS=!~-cw;3v3yiDz+qM0= zi_mZ|Y###yXc@9TaDj&ja2JYt*f_37LxLP3Gx^*&1mWFLQB?eYSI`)x{{7;7$G!#k z*QVy#cncu}V*OJNQsxcwRm+BFTWJKDaA-8iuQLZ4Lj80kX44z(HEci>pdBjZJR9s> zU|6cwl(DV_>T8Wx%Y;IbXs4$WH6JYY)+w?d9ebP{k%(nqj=Kd$_j2aj$`cT;lHtBQ zA0$ArY-_g*5WWITC`SVl(Ru}cK7hlv8Y^S^wRWpr2pf9?Bc|Gw$=S%_U;wX7SW&DY zQe$gX5PrywRj^Wfdfd!>0e>n@=v6_L=em4*ZI{Ee-X!B*P!TvY+Egtu2%0uscC8S( zO%H35OL=@$U1u~f5>E!}-@*`xY#9Dl>`IllRi|qIvpVz-FlzKX|LZcF3On~GlNv@< z@j`35ProacCjsYABn&`*SRmi;g5T9i1rs|sGzM^hf%rkFkcuvq2Ns(E!p( zg>86q*PLRjo74}ddP(X|tpO=?HzlOUL}rdc3i@S_ygpJ@F>zS#>b`_Un2r?eu))*l zRHpvdIi1yjb1)nyAOgb&P~iJapWojbr>$sy9d;h>dY%Mn3ywYKv}69^D5v`aPS3K_ zoesJtppE8*Zc5&C&Of(C{W7=Z0=W*aaabL!JqF^<3i{r!eHv98X#Q5&WbDudmv_*| z+qFL87}Ik(Ht8MDP|cj#+`)u#c+X=y za|0pJ&RwDIcqi^1rYQmhJFMLG0NOsk# zEMF5`jSs_2fJ`#vhP&H;(148Lm>slTa*q}yVPY{neY(-RUQIp+SYS;djz0HG^_;h` z?+dy&XFEQJCFb*4ZPt)&=gz&K(|fT0jm~ID>&3HK+kWi`yw5P#D%!BL*`P#d7+^Cy zgrIkk2cRc|y78b0W#*OUyJ)<1M#xg^+-ls*@&zagA6tT1SjdURI@(Fi=`LH4QkCX9 z+&EL?{rjVlBD!I{2)miS+JxP<3Ln0UY{x%Pa*C+X&ot)o_n*yjtaaLZ>ZOJlPjI#% z8q`q%5lNyA)kUMMlAiFrFiRCEON|`Uc5+iLVE6kEx~=m`6(n6Se~c0tBp$J$%s;)E z$2N&H&EVEmhG&+hLsHwWGQXh9wU@iJ5E#x6BIF@a235H|K>$ORL%^mk3w6GGSEP## zbRGU+Q%a?GsDky1YFV2)g`kg(6n;%HF%Xe8i6;D}mn0_y9h1~wTaNs1Q-P%j`>0BI z9=>_`NM9n&}<=1)%!{oiC@1G!P`tWU132Ces2p}1vl@gW(}yh$g4ws#Q{#YT7uROWJHoA&NN_+=CwZ04R>sbh{&~Vn z9=F7WdWQ$G8iQ^x__(N<2!%F!aQYG!dlXp+u~!-8&1-Zgtny# zZjnGt?NEW|?M^4%M?ypBfIrm&?$<&IFR4$LlwR*CMA4|+aAL)F@G%6^$RtBLhj zH%_(bfD8A!f?kiAL@bakaW_t-b@5NOr1aHRC4JY2U-{PQiS+MEjA5ot23ZDz+b6rO zDvWC1hE!&m>y?Q?X z6?qyA=&~qTo)Ni8(r0XmE7VfSVs=HcGf@!C`TTyLs^(A{ zqbKTw#VPw;<)eZN=!ab&f!*B1L$>v#Nei)}?UPKRPI*SH-{v_DEnHdUUZJnCj7iM+ zzB_ATDN9YZ9Xz?ph_lX=&%08pnrNh<=UHoz{YD?P-AsQSbB_L_wV+cjeR_L?QX9EA zIz@Bbj{zj?TwoPQI=$i->1=W_Xq zKFvjw0JLGX4mKdXFSkTn$0v4hiIa&Q$ zDQ7tAylAe#4Op=k*(QMAYtKM{e<(Q_f$9Uq`j>hTJ#LSn*Qyb(msDJN%;hQ=>ryc% z=n7j-j7?rSKZy9FHGSz2MQF&Cxd}FmOdQqUOc!n#j%!fV9|*RbNF$YuO6SG9#hx+> z0SJ5Bo2bz;5&Mmz-9V3o?p>p6=x|rq8iuMsA%49>-02#E+LJ>(z~T?9 zr3_6zE^6TfKyYxQ{p~%>2myBG-r}qdI?ChU!aJ+O(}RNzQA`39eN#t$*KV^Y$OFv9 zIVLjXsRB8ES-A z*9CM8Py74Wyob}(5OQqb9{&b6AHLVSLjC9rmlLDN^!tE9YA{e_MnyjV0}z(P$pL_s z5>35s8_d_yg1GTfoVkx4q4=_F5^vQ#j!-ViIah#-*EDkj-yC}^!N&l!T5iJ|uv&Ef zJxp=GT`{Z@2g?%ejw>z$sEkcNnU)%hfDb>ZCj7}%Nad%9Ho66ZjEqNmBTclrd-zrD z1_@S*h-a`PMhC?vwTUY7e>_QE0#E~EbnNieLua296pJh!=-JAk>}Qkpntu7NzKyXr4hJBcI<3kaZ-#{k(Ms)KGdU7(!qM1wwGX*@9V1(J32SGAuvH zsxdW>p4_rQO}k&Bgs)&EA@DJEMM{F&7=qUG+5>~(h?Ds+s%O)FrRQ4R+J=TLG5NZlZ{_#W ztmbo4xi47dIB=fQM{Gb1Skv61l?kSnZk$88UNi7Qj=P6jdHinw-SBOwGa{$rs<`|8 zy*@Bpss_*Ijn4sz3g7!-Xf@N~Cb|X%-=kP_uqn{y;;?;GwPiXtH!c73gW>v^KbyWL z1@=JQRI%1;8NNro{(A(!;JgJm2tLhAPRCd`Q1BN+^Y?Cz@bsBT3U)?4L7wJN?+MYY z$fsf=tVNkehu45w+oe>4d4jW2akel>NZv-wlt+P#D+RdO+#f8NI*z?-ut&d4zs2od z`5jgTdeFWS~{jF zBZXea_bKCNXp$8uWSD1@q!$u3Qf(>6n5)XR< z8v7_Qa5a`>8#{j&p4$j;{uc~}Qfs)dDi{G5_;#LVc`()R`O`65DWei4kBQ7#U$B%$NkW4DXME*ZZV-2(}#h;%HrBh}UPw4{py84D>V z>QcK$@mKsH(y%1OU4H7F*Ve`v^ZV`2Vw9rO`M5BO?kGNU1`gNV#6YsJqBwb%5^_Ql zeGJ~#Y5GIZ64P#b3Bk&$yd4T0x!KMK1-&~uwdQ$ns?P$$fcN7~@UY$|L-5B4h59?- z4d^4xo#zYb#w{WRkbU6M%LeEihKk20vN1rl8-F59+k+qP|6ciFDqz4wVY@xBqyhiCnQ z^(FJlIdkS1w#{N7ofXawI4TwZM{(*}~4fkpp7= zlXTC|y?v4YEkL`iMtS8~4?2Y;RVd^>#?8U%@b>lTohtVg3PT#ZODj_h%`Znaa=NJ7 zq^if?B*2L#x(7Sr6e?0K2ggu_ikV)1CNW3N}W&@=t(U4DMgs*O)AE>J@Xgy85li_Yr zqZOPtu}wh*9$(1{`!j_KnkY$Q-L^ib=DwABME(4-f~y~dugwR}D=!U}-?t7cHE-S) zn)ZV3@QMUZ!+#`F5v5rO86!7EYMc?3*d3eChk$DoNmQB7qzVlOBIP!T3z`kd-3}Va z#qz=z+_$`|&nD&lqP}yfMc3gIHgH6OO65hM!!#ERqNWd^sw_f#rM(8rO(9o@`ZtzR zRf@B?sS@mlef{OIWP4wkOe9-ByWTa^-Caz?al%U`XA*2Sf2|i942+ceeBj=|5n^*^ zPtvshvA!Hz#VHjT!rDt;J7qxROoZpDz}I&uuIZPh27iYfN#r8JfLJjSr+7Kx;Hz(U zsv)m+g^4yK;>FDY&YUDF`CbUs1bmYSI9A?2Tr>J7 zr7D1XbT%m4)r7u@e@ZY9mq+|AtXvaNAESu@E1)lB{91!`gHspk)r0<3PZY0StRQOq4`QN zoLuuwO(ll>+)F7O^ibePKH^<0D7dH-nDo<33By*GXA?LO{9jfwozo)K92a2mt9U~) ztlw}#%wD7S&%2$6t$ONN#NoraUm3L*#3e5BWKWrKpoP#Imh0GIB5s|<&RGzfyj3!^ zD|47~b;^4=u$; z4mcQ5PL>E$S}{)k4bhcCrT&!cI%h4if$$_V$RxOkwwU}K8G02@3XFOTRRw#(Seg>H zC#uDAG)zo4fQIISRwjeLg@VQngNeTdFpHE5sux3G@B*727*}66?Z8~`Q@f_}%Byh5 zqQPzV_n@DP+mDx(ia6yfqX9Hl>AiT3tqrsN?Yxlr^V@66$V`8)-JTdd^)NFS04A?p z>hZR1pwPgwV`>yS%EGPL;x0ZNitT6=nX;RPayyAXwixYj;I;bjdwt5!{t|%01LEx# zB_OCfn>sStFtj%VBcd49S{YY1D*k3@1t$bWT?iU?IO3$c$?O3rl`A`M9d96e%4ZA| zrJhb|l&bXfk(@*<5N!P^MEf$pwai;J4YJ@cOl6d07-miQ0t)p_nD{{zCG0>rTO4}z zW9lUWPf>PPzYts|Lt*`c$L%Xus%h^fLMcf-B|%t6z!#cMo0es5K2cb^>J@Q|P|=2T z@PCqx-S0GbtZ0uITt^mv-y?#Mmg#>=F!OC5il<>Gq5^8FIXR4M9E%qk zErMaZ6kM>>UYIYojkZ;~(N4bQ+@88>?FRmg

    -YfVt}!y$R*&WhX8-j>CEefd&q zF|-i`&pa1LD4>F8E?L`MrzFrOVqx3rK>^WjlSP>6OQl;*a9=C|AF<`HpAz-+Gx@z! zqOZTV-q+Ucs4@3%DU_dyu;k}XZQAaz;4Lb+<@J8zPD$(G|A!=D{qG2zT%7-_{9e)8 zvfC0z^10Qxt06P6Yv*Lh;B1qMM6;Y9l-EDZ&#!2a^Cv-1lr|zF+}nViDCuq_BZXEZ z1G2PqcQc#Kn2HTl07gK03j-C}_d`j(+;5xO-=Ia=2Ro694VuaVG6ycDGS_nG_&`Dt zDvV3>gZQUC0SnmyEIqbi))l2I<6z88c7NT!X>(XldH5 zHAaL(LDD~O&{iYJ?Ay4y@aCd4;hCmiH0k@&uV!h#%;jy-FR!Hj!&^fc(J4w->^h*o zIK82bWY;^yU&eSI9n@(MbJ!2_o~yZ_Yb9I^0+R`4Hvl19v8AWd%Ts{K%Le_?f4Kwd zVH}MnxwC>xHHy97d~PM6si*zXUDm<2?|i|yJTZWty_>b_DUZ9XB#d@2O;5>NZ}~Oq zJoZ*v>5f5&)IG+U4osKv04FfZYKG0vY7x(RiOu-NHH9n>UGLv7U$h^R+)p?#_}FPr z2|<@EP4@;7{Hx1E$nqa#JhgMnjJytI8mHqy%9vVO*=9|h-w?!z-Abcp6;-z6lM7@P}ry_WK;v z4|)t?ss*emf-yo2>1dkfyW`xGD=g}+^m>(_@(zqy5*5*-JsGAWz%eXLZ`hH_Yu>U> zCtVZeuDff6I_l8jJm#L_1e%~X&gm$Fo6|9m_S_}~k|D*mz2!^iAV~z}vn5tJ4l28V z4i|cL_m2-S0!2~K=jU^albDVdyV3p*Z;N$Umr;F1Z_=rl`cTf5cNvuAo)*WDCi)t? zjgb@v$B4G40;-?|PwuMc2#6#bzV)2GkRpt7Xx<^XNGrPo&!N=1XGvL+UxGsYA*i&9 zS~yYs6Hi!|OgA-&3I`X^n?AO|7}}9H zZ?_e*@=Y_C-!GCBDx0(131tU%;yP3*tfEOukA=5YTcw<4L;7}&q3>Q6KB?wlRDF`+ zz3p>KJf?CcSut>=G`b`=z$zVqgip4SV7Ln9$)lRVD6$5V!A9}4YM%~vNhGtvTFH|t z?z?v~`F~DbTCL)guuC2j^tmOEHwHVD8@x_t%+N|un+7&E!A3Z1>^9tTROM*Sw>hdR zJDv%{i8D`!Tf?r%M6yp2ClDaD8?D2sig{t$xoxv%8~NkQlOp5b{L>rAynR5=5=F5q zmpBGE{D#agTOV0S#^%xS4)F}B4CNgyx~)K8nVfe{=GG1T5^vrvr!k{siC6-lcB<33 z;sYAEM6;uhDUr-!kmT@=6dpf*0tAJ`K>8 zsh#3@@|Ya4BsnfTRB;-6>hF`RFkU_)0D&HfnMv1Gm5fn#+r?PqJ%_r_FE2E^>LJ{g7NbSX z_9?b!U&tWk^V#@>#DiKkC%bf$U6kpTrJqjL8F+Tx#nMW-^d!L{n7DkR@unpVlBP;) zum7&%Wf1h-O!lo9WFbW#w*9ViDZw=gQb#Vgn%l2p878Mw6(f@zi{+#eyOU z^DoSsR<%(|*_Fb^ty6OyKvxknl-<6t3b>t2^AbkV^0t z#d;q38xLzX$rU-ZOmpimCmlIR;k9o7w=1B&bInd9G0D^QkBL+pAjex1?YW(<=);U? zA|8}%t#%fLXw2^qAmjk{smEU06k|BOQ)7Eby*D&yv1v(^v=G$OO{3n6Y_bS$`j4QL zZht`97L?Lj(~idBPiz(pZ9j9o!s@0Zvo|IaA|{e;K(uzAGctAFAuKwQ^!y&m0Y3k1 z?{jFL^1+m$-X~&m?c+;GtCYFw_ySI@{_)!1+pNk=I)~$re9`Zu)}4x zzf>C=f)?d#qhO{1MDaG_*qyd2gC*ng+zI$#Nj{INFyL%q5O2pGl|2&0)S_%!Y>`Q^ zy%pG^9Bkub*%So16zK#D+{El2{a)$wVn55oJmROXp48T&qra|!9e$TMzYj>Mb!4c`!>90 zmAF2E%}xhqNWXWvSP5sx`loXpCMTHkOkiFq7TAKS&i(>0u|{G}P`Sx)kGO`W!;-EgGP&68apVPZ+L2=h zU)Mj%mRg{<$sSJ^VvRaTP0t&Nk7-@yM@tYK(Zk|bFvk(Xz{t_H_i6+udg-hf7)ZmAVZb?AcOC^V?R z`j$k`DF&+|iIGcq=CRP~>TJ2PaKLj&G>Gz~RCAW}K06+>DuZghsvx)ErXCnaW`yQ! zRsyK* zaSOH#q?*P&0Mn{x9Be(u7%jjoKvb1RlF5$QgIjuLnOZS|&0`n@VlP9yTV7Qgv3;@} z?I;Km^GH)jFO@{W6Lp9IUxkUyx}2#jH$w}{DM>h}KR)=>l8za~Wc23vCC=OzHeMXY zZ=Rw+h`d?-htL&eBwADHSOo(bm@A^-*K63b^Jxp??vwx;b2hIHPX1_(CEH5iW&n(J zo-_sW_wN3+BDgXlDP1^}1T}~1dy&Ossjj=J-m|yClK1-J0xmL`BXu>r+=6XpCA;d4 z9gICtlu)tl+L;D|rXr@S)};z$R7nM@mTjtDhdzb@P}&fauPcT(91>~;oE<0#-oM|F zHHuIc4nlv!DN1g-o@e2L-}T@?2Dwb>hd~0%b8bpQIu>CbqzxCEx?(bplH-aey(E{tj zdEqaJuI^J{+3dy28f76tQJR5CSv5T4hPEH+5<2M9aRo~f4wr09S_h2}7h(g=9NPt2 zP#!WSSQ7dv4JO_-Q+ea+3>%g6`7_3M2XKBw;o3(E79(EBu`@ClP1891>qFq0MJ|@v zSnR!jVvln1`hL$eHZ|U7Zd~eUIxpxGWR$tOUF#uXC?X?;UA_LERLl@q zL7s5QVU~5RyJT3zbjNvffy=5-(3zz8j- zNqQAlLhx058hy2=rn#;m$TT;rQ!I>KCp{^h6FiR;tf2ivx+xW>(0Beh>+0!N`R!8= zKS!O7+MkC|T8XR{A7flwIdg1JAseKzvPX55AU*fb&H~Mja6HpO%X9$Gyz~Y_hE&&` zE76I4)|z|Y$-h{CaLOQ$L0K;+vN(TswFEt2$v5Yhe3a&lkliW+JJtMD(b1hlIGoKf zrT1a7fpRBUskpvf>6UgnY`u)9t-rwq_p9oM^9?uGkjjUH4G!{h5_C!>ka7>rHEPd8N$G)dNg)Sj|_SBI>3|3TQqa*>6F*fJ75jv$G8+%g>@k z0@@cCHjf^PD8r=3_>o|eg*NreQL^!O3P!qDjZVk51eKV>5L+QW7GTiQOiYa|J4$6W zk=167Czdj2{Z{T^d*;_REvd-ho6|PERDj2G#L<0Y&8NDIEFrbeUpHo;yQF%5tJ-prxO4*@jN{Y(dA#2DV%th?|dj*fS8SJs8vW+A=H!x z$RnYC`Ekd3peekVn8g73oPY?ZOng0zmpWI(Dvz3Oqg9%`31}$5SMq85ybk%fw*puH zr@;U3fSBBz|7$>RH8X4;gD;R2vwl- z(pRRu7}?N?qe+9mmhLfd#XZi*w-LuAlT4Rj(refAp*r4>zl&0f2OBVYbX2M90e2x( z1g}^!zM-(upli6At4`Hh(Hz7~_bHuLnGHDVLb^63nCt{6Z!}$TB9;MHHorH~Jj{?7 zR)jNNmcmh=q1+$H+5b7XwtJGsY&#`#y)EWw?ko;Z+U?)AJDv;{#C+l}lZ@O|b8UG) zRCQnDDaM5(2}c1JGLVPgYHO8KI*sv2n0j-2$tEWZ5%sw+YCaG2BBB@;H9*|whq65C z?O-n^`r$*1cBf+<24fG1qjEExMt+N?M`3^hqy1{glH?Gx_GZ-b{;?~Nydu3Byeui` zc7S&IrHr(mi{$1-C6@y!;basEOEsk$9Inx&t4TfGuZ>LZkk_RPML&pqWYZVAYjN4% z&w})ojqB5MwUW)>yY{NG-bE*Z*UIs7BV{~iC*-)@GMk4mNEY{3iwe-q*AJiPemSn7 z@^u`3M?lpV+CcgoXYR@*>fnaN137^Bk0eibNM(##2N9HDm^?wS-aBi822`ThGp}Te z=O~M~Xf93-o{wje*L*Ofn-EVsoJY}+*mvQ!f~J!MHAWl!tFh0e&ARfXyn{q6c;W95 zvJ(TAINQf7-dwiPJ$>-QE*m^64Pn%v^iUdD3m#%1c(afkckr?(!V zoVOu!T3}wvl0BC__SzyxhIJ%{<`b!d5%W*3ccgU;nAs+hBbExcPEN%?vC6r7YTa=a zVzv$^EufiHh>7bw;V$5EK0v%T>MKP#X9Ukn$s&kSp6@lH%cG8tdV94ZuL<5MW1Vpl zh#C!&06m*EMcJ|R90&%d22oPQZ;qKFEaCFyYsP=LRyN&&-#wkQz<{w7wV%#C^>GM2!{zd=ky3HU@*=H#fEU2NRsM-(T)4Cc zDBHsxw1zHF;RMWHHPc$)h9m@$o9UGA&l&+ryKF+P2hkzx$*rAo=U>rb0ZHaxUfi0+ zTI&Ov#FOhy+*s+-FaAOBo2em=4K1D=1{oJ-P4<@DzT*YQ4G2C=Mt#^of&!Gl<&9EM zxwn)MqcO>eTAVOT?S7P$5SKV6ylFfCLL3?I<1++%r-K@pIN_+pl840gbP|(0_9sC^_4i;qfr?1-N)SA-Vy9%}9 z*9tGOP;|s>CfsUmY3svVbnO>z%Yy8QMQ?Js9oIHiw$@zPf1w^yP~v#fi?NRzB(3N< z>oO|~nxtyJ@%i(6HKq(VYerTkxxvPTMokjo@(`)Dx^zE zx+DJriVz(CsEDw-8`x>>BqiagZCf&*`auErTAW@`8cG5yf1{eIJD|+oA23!woJ2D| zLZ&)P{9H9Vds*ue53dZ&o&+}|W4>M#zJ=0l7ml0I4_fy~gGQ_sIb07XWp4Gx-}O5a z+RjWzw=2ANN+U<7aJr5rf6V&2H`8ui(z};Iy_8O`t4^%F>;(JJOW4{|e92j-GN-!b zDBnLtt=*CW4w^153?dj2>^9wp-_gOr>_t`u{kB!-*H~*YR@r{girLzSR5|Lq2{<4p zhbACACuFGXIjf`o*xUTFB>_FC@q>leA{A=t2kBHI6Aj5G9E|I6HbdnUR`YObm&2Tj z?rc%dikdM}Gk{nU0R zb66eQf1$ITezo*xLjr?W$6XIYV=c&*MIW=Cuo71!L-|x`C{j(#QW%A$-_9ssb<%FZPm)c z2m<|+l=5)obqWG;i{zC=QCVqY0vE=**Wt&CunYOG+9yOH3+Ut0vu3J= zet+P^);|eIrC1Y1x3+c=Gs|Vo?3u1GIrQs-&L}#BafxHaT{AtE_VZj!Z8jWktCQvl z9;KI|5*zs-Y-8qx@&Bv#ZEKPw?QZxzVxEU#Zr@w*u}4U?_u!g9c9q2%TC;nbvQOWl%dYh(Y``;FIXldIJ|u)cpE&>y^Y1 zjlR;U&Q8b9^X7pP-?eUYv3JE}=U~*UFTFrBhM}#>T^=pwn!_I^Njj< z8wi&OF|f6$CQ)U$hZj=p0!lCmi0|d~-8pH4mv<@x;j|-8U89-S8En$@4(qF&MgyF{ z+YAbbV{UY{XFR&GE_CDxv3SWESAfw%$qn@X?KE&H*}scP6UnYq!T!dvcK@f2I%7-K z0PSPv@1L)MI`ygXKpQ*}8Z_ZmnlItVSObn0xl2?*rU-v7og+43hP|xbSu@qIZTT4% z)u>BqyD6lJ^7<@irM^t~Ba>?kMoyTg=6F2{;378;S6({WM><1u}`|iY3H+#rmUGe4k!PyTQrq$ z=b&d^k<-B>xFx5(SykB@*Yx_??0{G$Pt}BJ_I2IHN~NdQKYyQ{IT?jW8^UzWYg{VD zy71!itjU~ZR;mD$c`@!#9wo|0!6vx`i>Du!mczHkZ05SO$@o2}9Y-(`pW}oUBBXzL zk=HeGeJ|bmAh#|`oZ<40{dwm^CWWcAtT0)WJA@qO)W$c)o)A}YN*T7np^ZWJuNwfd z{cO-HkWq?%L|N!LP!uc^;3EB;1aA4i)fSb#4u)@_4;&&O`f7=*#VQ%W0T)tXW7xdZOz6ksWx3S z1Nmme#~NZQ7jB%|s3la=g#NoWvFbU|3;7?Bved5ES(^pTOw$9g{f%Ka742^~zewzxUuI z_1^F5YJT|;{8dR?tiVqMlYeN8=UquokV>31rTd=jKZZyt?tv?3Yfpp&$;LI(*K)6N+R zUsfSm!fixf9WK8`--|hlqajK9djQMZcbFg0VjY;&e+XT+|B6w_!otq>zq{-*aa-fa zy=NLwURpF*ts9IS7a@pQS3C~&Oh_h9kxu)P%W%wS)JeJj{ymcxzUm)`o{u}N>OX@IWM@^E-;w73ut>FyE6+E#2}~Cs zglm5K(A4S7D7~XQd3`_6Q#`54;$lrjBYC|)F&KU}h+(Y*Es?%eAEehmi?zlHVp~fE zHmif8K_wptO}UM+;GA@*?=)K2;Ba!6LZF%2S z4rR+vXjJ%d5^m(m^dgCpL(xp;Rwqjfjf|hZ0RocMVjKlOsMNd7p!AbrE$T{2d65O% z4f!9sL7Nc)Vw1)3snd$vq3ez_e@=Ip0hNp{C2MU4UKKMa)Co;&&Juqi3sgoLRcB3Z zAh{4?2?9e|=n_6Y$@U6owuTmdvTe!(2tHeX1ykXUh}xZI=7Vg~?hCh;?dfgUcL7F6 zOZ?7q0T{+ljsr50tkfY(>4D4OV-*A+@g|9^waIJTXz9%^l$n(XAH1e!&AKhW$E3rl zYy@XfP82u{Y70Y`XoR?v%JJm&m_lPrvb~6z4CR`4ayx%u1mufaNmEUC((Iy&1+kza z22e+isUVLP^=zvSevv0cIl;LPWUs_Gkv2g(cwj$?RijLZrUw2M)RU8P(`fhi6CFzf zg1I9rETGNw{q45H{l;Br9M}t@?N1>*fU5L90;UIAprEqdS5;5pUO$sRuS(Zqr(xto^+@g@F*ii@10wLLSI%>VgZ^ilNhTkR6 z@1-fOO{CLI4n07gDfo_DvF=aOzgYv;dE}SKJ~kTa8yu?Vn}O9Ez`Ez0Pi!XkVquvE zHJ_{}hhKWj4)rx&Ika>ux7B(OJ-JH~SPNFFd2PafSBC^Xi!3! z1@Wb3J^xXZLjX(#c{YU>QAL3PHI7_VUkc>Jn}y=HZc`?;8f;ojKS}lQ{oAFG$}+zH zOd8YqZ;vsWeB(Jr>UeT`x!$+bQzqWYaC>q4m4VoFoYC%{RQ*meiv|yNRPPnljQKX^ zp^eX5%NPbhfxyVPdqs-WalDvUgZhDA8ZCRqg85di8s`%kT;a`Y<7sY@Y6o~`-Qij3 z1wp5-%;U)1rAEm?k%YIf6qicP6dq{58<6FOaTYaG zOAlm#(57>`;okCdpKGVA=LK&sn-?p+_^c7(c#yb`mv~pTQ{ae+_gq+FV5)FqhbnwdYo3ShPD8f@77Ci08K6!l#R44 z;Lg?TB|9l#U+>Vwpawg^E78G3ul-wGW-DXT)k+W)N|9;s2%nIU5pjWGg2|gDHb<+; zhuWc^#YST{LA zN+-oS$SVX1W9Ntm?xv*SdeDpcr})E_<5CQko+8dbdV*Cja$3|!hDFxjX%ye=l=tM; zZAX#BP<8ff!vNKSC1)u}jtJ&&K&8mSJeKIUg)3E=Rv}O_4d?N7*UP@6PXQt1KKt#4 z)h1q_B`tH9Ik4Ig)elatDMG%w&>Ar?dRC3KtS*hv?>rKdK;Y3$H{{IB3SKXJ;iT+} z1|r58&wYC0JrQ5{q>|iKcBDPI#buO`L!z)?j=w3T(~_oT7Ej~2JjEBst7q2;^jS|hUS9ZMCR2lL-EYBG zTD=_BjzS{!NA~WeF(uz-wr6(dQxw>0m%b%R~Mi!fI&lNx}jGu7>5ok=@ zSv$ivx@4UZE zfY|#kr897x=XMhro*LuHCd+iX1eTg%1@7CCeXl^wS6Q-6jic^RqI)OqriID+nG#Lk zPv`}IBkYaygJ&eiiA$fMast(8G9T=;Ab6_H3;rT-ZgPiUN-@El&CnOL;q`KKdxfWm zx#VnfccbDrWRxS{*rena$i`4sSdV~a?JUHP}UFQd3F-Cmeg+qql~Q9^1-%`)5& z=z~B0RqE0eEF0^S>2fK|(TF{2DbASf$IN{kWV4lh7<<{}q=T18mYsGVNyr#pSYzz# zXqfDODqp_RH%7gl{GKRz=S$9S-x-@Pzg2h!o4ws~VSBTaiQcPXcFLQjOhaU>t6GaUfQ6f;F1KB-_4@b{>59fkX})Kf^`IoqHv=G`otN z^k+_hd>TqJr+@v3Vc0_gjFsTvo0Vgik023d5ksT^JK`i!rPr4WLnhTLa5U09E&@5l zXv;R2Q;u#Q)_W|&n;7ruZMvG1J1dTaAf5YsBdgw=K&gTeQqgh;UM_UAoaMsG)tzkS zkd)DCl(57~GrJCIn3CVtSsm>5oUYV2^`4|T`Bd|$Kh)&>vguK$RrNj zpgPt+<|%1Mt9JJtH}@5jqdckY3kOo3boReU-Qb7|3JzA73j_H51do6Nfx9jk-+1!flRxfh= zN~63#PBk5P|Covh^EvJE>)G8R=xW+Ra>lIJaeilL#DVtM0ZsekiG>hE_JVA>EJUV= zC2vyzCKw`g{^z@qFfO+5RiD5Uk}(d^&&TKKLGzl0WN(OANa<_<4k~|(i*F7W`#?*3 za$sYav|;Kbj%})PrE@&XnLjPLzS4@lEfx0CEXN#Iu(w^wD|uKT_pdt^a4EXQu%!yLb4^^X^Zwc#bc?m zLseza%DqpMZJUw&0m7An2`yo~9ten@aT?w>tO09aqmiQyt*IDrjXgJ2vfBD@n)Y{{ zN6ZVF58Se4e2c5PI#e0R>LvhA9b;L1COct3V$Q z5C5NCom@U7fc$m6 zG8sEm0^t^sX5zfv#e(|TMlb>lss18IG`>tN2!C*Ug%n%ka^^tIz*|Uys=(?C zlhmy3>fK$sCY+LM5MnTc#AOh4Bf2$!l4+;fuO;$&gT`TwlOw?{fA+Pq*KkHkyiy38FMToP(QC+FFD*-5U>ZroBJaA!3F z4POV+R1&Wih1wMqf!`EaSb zwcxAz4I;Lnx%EiIH32y|F}nW*f*};d6=27b#dM{9;*Dm0MLFMnFb15t1L+c{w_LUB=bhkwYEm})(%*jCjgE7Zeq2qP3wd^_aqgOso zrMg!>+)hvF;+wzviXn!AzlhlW;6s75@(?7|Ba>z|7H291MaTnLFcFNBmT>93M6A;bH6XY ztMB`veQGnb`+thM|BC#_%)$Da4hl$ev*b2VY6a8e z7AS>BDrMZ%>Yf36>W;V{C4w5Kh$Uv$in7sZvWS$4F^|c>jcl||<1@MFos;s)AeBur zTijB+GHR-~x9_WVs=#nTBFYOhLjx`WNSt9BR87~~ua`j?2{(wc*)b7YvZ zPX?$iOVLD=$RbLOQ1i*t?03%fFcnnoy6)IsRvThITsH@ z{o2)Bt|s$l(!q2&B&9x>AMX{;0uNxaE(}qQN7zSPa*;=XQXh>AYGkAKQs@HAPRjpP z+{qtl4 zu%1)3`2Vz+<3fuJ3wyfhmN(EvD#GbF+Gy9U6-0_xdbE~a=J8wT{gYIW&_SkpZncDl ze26@UZCE^Fqj3cxG1~+EOuqqzb49*_9B<;u2+V1Vv_=hk-%h);i}dhuYDgUwGM8_y zw>nRXC9WY(;2~2LORVpmiJwW63X+F$FI9UaLzoNoJk{}keH^7g9JIWg$7ua32?e)J zD$5yx+keko7W!1(R`Xz@m|XN*j-e!-rk)C{GKmQ}FNrgwK9+=tc+FVHuWhm7=9hFh z3h%_6Mc}Vw+7b{^2EopL8rtJaC&M-PXIu3hW90I~qz=00Q*t?PVRIaRF)(vj%8^k_t9_0Zn>+Zc1 zAT9=(cXt046MB=<(IqXrQi-6H{1SODWcU+J=9=sn`dwQ$1+YmueowmDY`xfoQ=bil z_uo+(OnsA|#@f!G>8@nMsS@{z_^le#^a6(+`L@tTB90t)O*_3-?KMBRWs_rdA6Z7H z_iWG4WKaN$wcmdcj3Kvao3+@z%biyzs6`gLvKHS07>^}BKp zL_A6&Tj= zuS8N?&cw(KVw3bu$^kO=n8hhxctg(9+R5|<%+5JytAuML#wBcNm9*6@BkFstFlqkgj}7P1zi+oxgMHuSxo5;a z=a)TzkC7)fDGl~KT{pbbhs6+n6_3r+nV3iXx;kEj>|KG1a|fbb!X&2)-bd!h^#ie{ zy24S;DJ@)j9o*-`%+`9)oYcxSE4OK7{)VTWnAa_LKTuFaPU!y-QtbaFx{ZnZf7WCF zASw1m|LNzvf1Rs3%k8hak;1_ihJqi4Zundo+v~zNv{o!%Q7vH z3{funpFjxA{k9P68GQf`I%6P2P%AStDW_EP<C@|~%YuzXl07`sEVgx0#Kl6!Mfw^`3HDI{(#m$0fuK4$Fx zd_eys$LpfNbFo61V^y&Vj#NAY7Q*sv=MRK_TBAE$PTS-*bHsTXa`B=~;a;|hL!QGviw{|ytTY! zVwOVoF>?yJSn#`hm|Gcns+1moN-1wilbOE>x$&q4BWgj+JeR&JK0Hy)T^4r%tGbjs zpaX}1R>JkqbXa-@*lB)@!!ff!=(86NKA6@st?}YQ)CBX`5rWo2_I~rv#QjGUa z(C`o#LTTkgG|kt?sV9x??DYTPj2 zkF`G;{HTf+#wqK*UP0s|xF>20=~I9Y50cD;%=2q|AC8RxLguOVmSaD1kDmzcUOvN? z{(q|p&#MVlL&4JiRuQg89LSeq#^fubh<@E(Gg+#-@GlCS#$3TkR{qR9f=Q5EPyznMb)%@-m<0D-06;B}AJJ+rOCw_0QhlZ+hTQ@vrESWQuh z<9%N}WEYf0a7>@iY#8^E;7U)n(O;R%m9*S6| zOeuh8A(i3t1?pmt)uhX4O;Ut*ozXBxh@rG;&G~sSBS|Cwnna4;qT1HZ2cc^9tRbtc zx~|pQGdlsmr2;b&Hb-CKwrc2furOUR6njwOze)VIk}P()TEXXO4cC>fnr*Ya>aYw| zVgu6H9u2!99R{{qPne~bRZm#%V`nngPtsm@-%L<-W+cMOak*psftCdp03L)qF>&t? zr(4Na^7Tbx_|#D)oAy|}*EXRIwDo01FeW2L@PRVgDZh>Q`w`BSCPqyaX)ySc)4(jM zBhG*kO27Ek(!SFk-wS0TJaaLBVr8t%h&R6b*mT7ZplRLJP|7eA31^cX&w1oHVUa*-)#bbpQK+|+ zpL3m{!p&0o5H`*DO@*{|S~1M%ajM$>&_hXUz%yi^82;8?`6yC5@Fso|c}J(eS>?p# zYn7=Y(y{|-G32PVVo*jyoF0|ZYVnsU=YInV{!T=d=e-r1;dV)$|Gj9{C*F4&Jz{w* zD+HS&`xZN5rq+r^$$~gRo02(~C4^L(p&6!JyRy)JV&PgKMsCxVp2Xc>HqU(Ew4${L zPOfO$hNuxQS)#2vz|AW{NP05TeGUMTeTJZ#VNlnI`ODhP%W~6%pl3UnKGI z4M)a_?nVs-cf!LxFywe7lfTUAng+0_Sf@q`2aHK3sQGaogC`yeg;2>eAsxp348$8* z)~}o_4)s;yYOv#`+ktl(ya)dLUBw?=fl^{znl__sifZjL;@XFDDVCVE6@U1lzLJh$ zfSaAjFjHrb=I`?e-@+)p|KBvo{|0JfcsW4uE6`c!XH7WwTa zvP?V-S$!~%2AEJ1Z5Br4a{Ti8&!@^Bg_2!O_qwhz7{LnJ)v9Wl94q=BnnyxEe|J2{ z4|$YP*V~2J{g8NLKjdU0480v2bT%D>D5f+z`-!c{qKT*bV;pD!h@|9!ZI9Re`^OSf zX|kB7@@7__|4&@cd&kbd(E47}d7f%tQ&rjx6PcyTbz7w-5+V#=>*{pLX>jGPSv`?hER8Tm2l(9HnbUwUnxStVoP>6aC%m zEF+EsEMVFoT+0dfu1+Pc7Z7n_Z-;T3W>-t~$W^f|P~E=hrt+Qk*FnJkM1q0vrS_^v zA#s6F8)78MOWURn2d;X?84i+!fSY^>=SR65``eZ$rvFQu3vsmr;8v_H@J3UD>@tKm zzT_^DSlx!<1i@Qp#DwVCEGOx{_a4(sUiD}V*vnNnd_*9RA_XBPeaQ++D2kP07eC*) zlO0U?%y*gCIJtfBW?))3rjQ{SQtA5G5V=?Gtp&@PPv_HROqpT#RhDmFhgL{5#wPR^<>Q#N+1xaWO0Q&rTEffnl>NM;+5xk`gVZ zDJ0peN>Gu+=Hmga)~{f%RFnc#aU8%6#vV)k!FcT`jWXBcV7?z5diKIZ0=0-b5a){X zwkGfzC%0fh&XlQo_2(k~6Vu}ETCd+XhE%Md0i`cKpg_nuc!LNx%ipLtCj#uW-;`C)WlkVLXkJ1PvMT*epIpU=2stP+op^D9m<>6AFcNNNqEgFf;bIIY z1WA;R)4_;LO5kHd7tt+mlK4T0H!bt;#L?H2@FQf ztJTTdby<{>)J;ABNB>hco3(_#pGC#Lt#R)90UVVH*nBa>_*So6sQGyNn3_xW;qG6o=#c7gJls>+UCp5!K@E%f3^Ngmu0e#2r zY5Tz1Y=cK6GZ$A3=W~(LNgXuV=qzF$!Hw~^Fg5vFq6n*J-IbS@WF-q&q$SC*;)i36 z0Yv4T0I87+OX<&~nX(Ayqw0N=Ue1&u+MP`> zZ`$gSmoWv~XAx1rlaEze-VgGfY5i;Np=GbO&igq`Op|NLdbP7o@6EC7&B_ekSlC1F zXVJgh-7UVCRoIF&@tK~*PcelS1BFKA`l*zd_b^vP@&p*Mr$FZMAYGKydxIv+zZf`h z6wKaO#*jGixPO8ti(g2pV3k9QRb($X9=Sf8%`HNH0Jj_6vk^rOT;y_Zyk92Z(Ub6P znVVnamP+A?ud>-;W?|OAqfZ|*0`MAOWQ~vR8=~m-Yx(s3TwF+v5s>_bFARa+%yhk5 z&AveE=XQ6tqzeS4_qx}o9wD&{JRkwi>slOfbu~KpH>T$P@}^T8GRYrD)5#q1x2%IM z&FEp zT$Y!Bnp{00mg%Mg45~jrEW4TBqGr5~hELy7y%3lvL}5VJQZsKzpy>jdDFJi?2P7P2 z=ozE8klvmVMNK+*FGB;!ecvU&`aaKlXz&W=80?;CWFN@QV~nh~2gl{{v7Dee_2@K`2!Ioz3w5*Jvoz58=NC7|~5y2x4L=x64^bi4_N8Cq31=Q--l0XC|=-XiCG0 zs~~XdXyx(h!SrY7ei#7z$a5H9k9~d4NbSQaF+W~!@m{`Vge!Ua7T{s)EiC6A(6@1hVf(-=c0+z z!XZe6SW9W5Xv_Zs&gE4aHY$ePj11w*^>^KE$Ro4u8{zmWaE?OHG2fSwi}#0>IO`i_ z`SrfE!T51E8{pEO*Nf7?0gNv;57;hPnNvy*-ypOCBIH!px$&c$yvYh*=D7_SIf5ehdg)x*pQH?hi*@{XhhSz^&V6 zPGpCmU})a&FI%AOzq|9YkiQEtW_NYl*Kt|=JGQ;wfwmTsmyM-aU16{_Y{^MlDp_4a zaU-wtGoE&1H?huo_Jk6?SEQkva1VUF539-o(H)VQ$<#A=&Y0!4ae{{!zyy{w>>)W=ur-oY$Y_6xSKcZ zNolWtH!U}Lvs<|^qW0&aIlDop;dfvLn?=^id7hr zlB+UGJuzw|y6R@uS@l2ISeuYS)O|8O?o%uL^ERVMl%`AzKWVKF#_*M=ltfXq10s$orX~R zHKC1cX&omfXNzeKR}1b>IKSFAXK^(R=`F}w9-Daej2 zjZ`T3fxovD6~X+xqEc+MDfAIPyv7M=4blx&$iAW?$f25b&D*l%cQY@VjGq_bD;U9H zjfL&sR05^%q_5!Eh*q9Fv}DLQ$Fx5sY=Oh5S>5e$vaU~b5ZlQw&ZI(m^7za6O(q;` zNe~CS7tZZ20zn#)wS_9HPwm~x;7P? z%1SAUBk#|6Q10T$GDM%$_1U;HP@}1(I$L_Td_K%?wJq_;BuPrBAmyq3Q`_uC?|+rQ z#Qw-0Ht{CJxEZ_`yCNFNt2{4(ntg*-3#qCw&H^@E49r;MTe4p&j=K>bFv4xne=gQv z;xdtq-NCesXsQe=PjaHrUu#WR>!gM!6aYFO%5c~l$PNH+@3+g9C8Y*K?r&%b)($@i z4cy__4Y_}T>=esuGkLiPCev#dlW4{b8dgfiR9bvK+G9^4KDq%Ux4{`ft`)^ z-U8%j`%EmmSW&xtwEYWE4c<6il9j8qCh~U3KIXX!O&CZcW8}yA&lGZ({lJ>;*r(c_ zzWEK%B~_h|atzo9-~?ek&pA{gOV~O~A1}dDjg$1?&l@Oyts$!jq}DW8v8khF(xOhb zKXYqp1)tZbNWqiZJNHbjL=`6pO@JXtbK9sskzGLWS19K}t~o6c>}_ti3k zbn`4_l|$7tFYhkY(JNYH9EXW&9(TTxD^kJ-=rJeJ2q*{Tp=f_#@Fmz~m}L?plQ$3m z3ft!P)K$|{c3lP_kv|gzoH~1ZH8B*;p*r4fPx=k@HU2LXz;vW#84cFg1~I^36k!Fc zu3(KEe=&=}&GIe&w-0%M_A1w47CF@-tE-v?kGaTh?sLY)0wSji3);2;YAbBAWQH?p9hnPwS=ja9Z*N#9f(Lkh1$c;3ph;#Y8^Udn;A!AqS*kUt12VDoN7^lx`rIB zDvWa1vgK+87^V(}DRAIu;aJ58(wS?LGPMsCUa1HbzjIn$7=zmZK={@>N0o&}{9Bm( zEbB70<>D2Ulrd@ITdZjQSSXMo+tAhAM zma~K_4>tTihmoc%5T4ySVZn`qMhq0trd%*njJbs^!FVy!hYl9AZ_FXi4Y-i0L9ktvTcK{n%vqv1nBDv;%ythdc7pcNb_G;I?_Ov z=z;rwN}HFofflnx?_0BH)*d=cCah>}v6T^{*zK^!OE)+TS`QL|$R6hTxc(vMjB&}a zou%;hI$-$n88xsG(=X0K#+}KoY*=}CH{w?2R`_GQNCr<&nzhpEY3VZzFSVMNeWz8^ zDXuIx2*4bVlQHk7d65_mj^km{5s^aCWK|Qs`~dkX>-hiophlw>(W9Om{x%QB*&2D^DdV%*9 znctOW0uMGGSgPmBF!Pk?LaB#1qlb$->@gHxdBT(wYC!A{1t4W$ZvCk~xJE?q;=J}6 ztE-Z@%p;Z_ubp07=c4(UGuUE1njS{|#?VICp~nhOK(!3(fO#y|wKBz3Rcs0>K%EIV zlq@SqWfFDqK#I)}goyURMFu>;c58z@^|zB7m%--%47U_F?q6RT;F1dvgSyyEXElI; zKg&@Sux^&FX^+%kB~9*_T`sLJJ3Fq;7t>LFgRjjfaBqJut`5vm0j~Sd&|fUeX?>R^ z7t5s>JhedXAe^eANA@kA(-6=1Y(t!^r6NWP5189C~jc7|m>7}%8w@{E-iu-FXn)lC-%2!*wwUJCm+tTEh zEUpAtm-GvmU5{6t2#x+O4q01W+GG2jCJnk7&SM{Bf8~VhdLKzg?zi1P|3Ou>D|v6c z!xM!y{uQ-K2C`K+@O+evDQD&}yS76`9Blj{T-9$CKT1xm>?Yg>@h|g2QO|?3pg>p# z?~IF50&t@*;%8_BlVy#SS?vX-LRlzK(Dc^qEH_Nv*<6^Hey!D&EA>%csNnQ259jaE@&V^aK$K6xNKsJ69$43YB2QRx&y}Hr85hsk)kaPEu^|!+Kdg9YXlW@J%N5)fyJSw1F{|r4Ixai)w!GV z!>lF){A1+Bpq}%6GNl;ii7}q+>D=&U{cF`vzD_V~UW$`Fc%`D2ddiX5GnP-0P%yK~ z{(>#RTo!>yeF~X2TOkJs2pv`!&$Og(m`+bS#IP^j?-=DTbHl-j>yc%sK>@3X_pFML zAPXuXYoCRdZpu0{Y09VmX0b6uZNwzeGP10ptXC0>BP&0%jYR2@JAP==wr@3tMB`7-|rGW%zyclu>EgXPBy0hShm(^{KIl`Ao%Xp zAt>Z0Ku4icUY@qKN=BjCqKoPnL_GshPq`SWpo=Hsp53~8B#CCtj@r%x6?$fHGCP}b zL_41ujD`8HM?ikP=5)L4%H^!xMg;pNe^9!WN`sTb!6`@~n|Ho#kwRjAGk+h)2jp|W z?X%?hK0bdOjY9|Z&s2uu_`H4S!tJj7 zTSOwsgx+=2tyKki?o^sMtjq84P)Dl4b!p-FeCJ}N`$iWgbBw<>#5)dg)tT-r8h5#> zwNL|)#9@|_Q9=n{dVDv0YO6`|R@JJK4<0~b5#W?~^Hy)xW-5m7bOH@=WhGJw2=dG) zu(ErT2hi31&M`gtjiu?9et1fYBd? zl<(sjy#z71trg9KTljEMYmQ-MQDTIR$EBouRbUt>OE5q=7Q3Zt(mijOB%&M$JVI6A zrYp~f(fWji4eX+HgWCuuOVI1xG&FDJ|8GV7YZO*c}j51(=bEAZ-KWRlVW)|Ob)Qr(#f^eDjih<0&&q~FIkb`7bKBL zSu?L?qdPt-@C>pCe8YvN=GZI#O>>1MgZ8IkcRM01p)^Tb9*99E+gwHH6Vb zo+lJ2sjelRSJo;586jbM1JMaruo!)^-eJsP(li$~fZPE@bQ(twEYU>Q%;n7idfoo( zr3}H3;7%t+yd*bqReB*=xhmpPlLD{AUA(CWISdB;?wAN^| zqzWxkt`c3XJTW{GVoUQ(4@$tm=eAXrOiQU6DKucu0-tHkF+s#v+o{2Gn<<@aioMud zUn(+Manl>9#O}cau|O1oKh6fhz|;#T>PP1i@B_6oX$nRt$3A9I2o0^(a$M5|` z=&CE7%@J12-0$xI&lDdItC}KqfP7bYn*2tQJ5f2%;odvewWffIpkV_sMp1UUrYFd9 zzh>rKr@B+Pa0rUI&hE&9iZtHpa#Kd>u|6h*nZU%uQF=nm6y#9}O3HG|sdoc@Aug0mv3e143UsW|suTiDyrZfPLDN zG}xHmbMh%Tr8~XMs=5^t449$`4=M;dr|fI9Qr!5?iOQR6FTU$9^?};E3^7s@X6l2TY}cbt44H6sqdO05Wxd$C38%D=uz)jmkHBQ9Uf ziwFo!v;dRsr)YCZ+jWKQ;MQiSTDym)yIOwv(WvKsmpHSmI$JrC?`ia!%g51uIP-bD zm(gW+nI)BHh0%APQhKkz=sG5xAVk131ozI3c!z>J3S5mWP*xk&077-E?}4sV6cR0a z{K5rbt8$s=KcwgH@9q06+Xu+d?6=^E(b^bQ_P1(hsH)e=ls_YlRkl=W4b)**JuQDu zQL9d-$aU-4^zKA{HSY6ojeYo+FM@gP<|~87HoZBla$Pg;vabKW$k^4;BQV#L^X+n< ziaOFAKko2_C9`L6GkXfS^Bu#F?NpqHjb}YxS18;z5jbzHvL9Dj1olV7Yx<^oNb$J* z;#lX@8M)}z%FGcafAqYD&6;nXly=FN&@HDV84j}HeqCb38zPVDw1n1=61jrlsO7xo z-tM}gXMvYELbA}GJlCY2bQh{R!w~bLhDzl_BNpI}Fh(|~zO-T?##S{ji=-x}-f_GL zeo)LVLz~a}zH}a#$XJiNgri;s(F`k!AqHnma7Q&E`JR#4yXo3A3%rH86MO$J@C>7% zng2GP{zo(=$A6e+XEe8*wnzW(7PvpNp3Iob4e&16T9m9DQH9j-Fn9tCF`ZaG2m}+5 zG9rSXmwN?t1t>|%c9K|$mL@1am$9@{7B8KfqNNHfF!R3gyC^-Yp-Qg}= zz3nlHA0!siq-4Ylqny0lr4JKN-Hfb|Q6L_vZ(Q)Zy5|7p8dtS`8LB9{C(wlNSt*}62w{yW;Ba%BmkaCthG7)phr25 z!YRM!wsdzYI}L7=pAww`|92-|we>LE>GEN+!hRVKdAEwpEJiwn)X{h=y#WW+^8!qV zeF$z__G(FSV_9wHW`57d_HjqpwXF4Mcdqe*=@TX`@4>@z%Jao_nYKT#;jH_^HlTSR z^Q>Yd*4~I5WK#6rN{%juHxzfd1ZW}=5L24O;z#N)sszpWxs55-w2ZG$z+jaaECsoI ze1fA&>Igbf(F={7SfGQTzHOemz;1EW@P|On@#tkOnGDY0PXZM?^jvg=%PwcJditmzC=Rr0ulH=a2*!r#E2d5V(=$us^9-2!3w9<+U ztNW$i&#FOZ%r3RvRR_?pe~!F<@7JCw0*1moHHUx%jWhzh@6Tgy2taIT*dH(G$-<}p zb%l=d+D4@j<*M`nTM&+|yqqz$o50$VQ8?xZxl|^cQIz8u^+Vir3g_Y_4)Hj`!M(l` zlYL&V1>1r5GUVqT+vY&Vd+`m2i-K_(Vs@ut^+Fndu#;V8hP*hjTo_2zB^AmYfY(&)0m3*3sKa>CPZ;J@VLj&!6?&rmNDk>iJTxX!uL?n)cBsg~+h7>m``& zW|Aj_l4Q|A&Ej?EOcr1uBDm60>&9;7J=zM`7l#W4S;eEI_@50)Y29A3jg8E>L!$0i zZRN-T*?3XQaiDN3rl%(!Je2d#=AxDyV{Oizn4SQ7ojhj1~A7u%lGDqsPUH=K~lJ zlk~?^vQzhnNdsqO=w1Zd1+qXwEuCszp0*cP{wYd8SBgXPChI~6=kpqPqW2`%y9a|s zzt;T^ZFMlr;ZGBJ3fptQzTXb&jFfeHOKLs6NZuMgQE8A7y;dHp!X%gT)?@4QJoFT0 z9h=E_ct&4Wl_jx5$j@J!6{ruUR<0WO?h?c8bHVhd!3&7@p=yT8St$jL>%zop8^Nk< z;!<`OMMN7f0{Ief!g!kQppQ9cXg+Sw1i$U?QIdRR$9?Z@-$7`VbmnsBv(_A|bF)fF zo zlI`m^R%Wi`*{SVyqf_VB6H&fhp4yE(qNY_VykDAqQX+L|{klD-rNjrBW`xw;U%2=A zd|Bd3Qx-MuEbfo#`;`pj!OJ>ZI93_Sb?hKo)&Y+k(w3HmV`Jq6wi3(jF@)0Xk3ivvFhJtj)B$?vt?DRF@$GosUFbd~!pW zJs{DN3^4GcfLnE_qG}6QdrYT<=)+U3-vCLO`A;WNJ|Lt*ep`0BtGTMO2h==ne= z4DBdhHUs_j;veP^uDm&%FB!Je^yn_k4d{;dsjr9FTPl|+2aS$}f@xCML0yQse`9TG_i_w}* z;GdnmP;@hXy4SftJ87d}6$yRTyW ziVQh#745i&tXN$2@9Wb(LUlcXO2v~_#0d>{a0UaGIu4|Wd}AtYZoST_eK~c8DFn%! zGTk)m*l_L+PX$!#vH5}o$?2%9Q$OT;sSk_-dM=b&|J51_+6YG)v;8GW2bO{6;BtDl zds(YfL&_Oi(A@`2`qO$(>z{r>eKu&oR0c+($6cP)RiKky%T>N*Tt1HGa8l@E&NDuZ z?rn1{n6@PXg+~Gj=+csO(19qI?`i+>2QtB3kRz~w@K4y(TDGjltDetx1GP}f$Ld!> zYe32)t~>~sArzBQj0)4Rf^;fyX)wU`-7Ils!4LZcB2&EHeNIFc0;Vk9Qv|-sp@S^S z)Y1`b3#jFp1kLOVR}RfVh}YDx5-h2X6Z*IDQdAzT=@XFc^a@Nw3}sHWe!8^mqJd!J zJB}~|?SzOZ7p|cfm`gUOrX=%B3$aqj1C%TMmePUsvbtHC5j0ymP#KAOCY(?r?kU zPB2Oc^!eS=-Nr25g!nmVgItnaG2aewK$9Re!$^{6Ld1X&qoMu2N7yuF1QvRErb)vF|a9Cg$R#f^-1~xn19s3)~ zaN(4jc8PEw;K7Q9itpQ|TcA#Id3b)`rzgPbT#ZOB&`*4ZKM6wy%7VPRLf{GL$PK@7 za73eba!a0_V;&9FCxMM(Fy&8cpd?d|37xoi0&-^xU-;9x zf24&1F-kAGTl4{>ZQjJ7w@^S^p;cMO?NL~aMI94}Qnyp`ZZcx5t5Ts9CJX+|O%xMP zMf6J5DHR9qCQ{%k!L~c~j3L1UIio&npg7;m5gC}ovFyt#7y8M&2+uSYV3J2=zEHoi zdghFd4|soA*`S>*6mcSdaY3FDw_i^UxHK2vyeUkrUg5IfFhFo(;T<{S7w>v}P)DJA zbAnC)@*XS$`jZ}p|K42J+h8q$GBV8sj89Af>?2*u`!}kDQrr9Xw&UjltoKIdLmrr` zno3u3QO}!O%&EFqH zM2$6KTxvoj)w8QZXo>P9;iczaEir0H0tiSw`q9Icc1%T=-a$edU}UT_l9&`TVyJ6G z6VkzK`8*%`Fh@Xn6yr`|zCIt4lM0j>Z!*4DvqVe0Yvd|ni5Y8J=-l8EO+A6|!$`!_E4iOF$7L;f5b9+POGd+@tn=w&V zgF8ffkepvOJ6v4IEn^H2e^-U9COR+$+R zIw101BC40xpgk-(@E?OFR%xg0>t(H%3x4||ceUCiCU(+pUbisaE7$9KriwC&zziy%`Nn`{Q9WzrMb~!$3!A$AisonOr7d!B;B)K_DclxR5Q~9E@!@ z{jD5AB>r4yD@U8ML`Z~~`RGMA)%WVX4XQVPfnbcE1p?DMez-~ByHlpO!)#C%GSBRP z(E#*$n*8izB51lc^@FXfLxyrYRL5E2cP~^(!a@3|f__v)w3$_#9@{Kb>7joKG#!Hj z&z)KgBtMOwzAt@(auP`SK=wtGjO8l*>_^I@aPwpZED<7dOw^BauIrV0ZP7$XkJ>1| zcD~(%DxKccs}(O(JpGNB^1dzmO{`SdHj~MiiR5EXG=$L-!+fag@0{Eu}+LM9sq%) zP2UY|)+_T>n^0X1_)lY26l^V85We>-CmjjGR?hPKZE$T?>a0|QcM+vhQT4la*?-_s znBnuPPFpWG&FZ%Q#bv02twT|md)5g2cvZr*MB7AtRTfGIn+-Hzto+YsplvqG{4BUv zu)S~^5~m?9Z^kvj8)Y;rd)J_6*H~r=BxziF)rLe4dV{iy`|8ZBvi)kVt@*=3KMjnG z-V!zb@by>=Lpmd4Agj7s=~sa@#!X1l1ePpKIli`P48ngKhyvNGbV<4XsUhEA9p#C= z-7{rrMpmC*;Aw0KiJz&x#1V>lj4zUImv6+0xjn!Tgc^69mV2%m4bivj;*>YnTXBv3 zF}II8U15l^L$_0v=krd-?Y`&2=`uqs!3Q5p$A^Nx(siv8E5}#0PtIm)#mc-EYv^wc=!0>_i{&b;_mf*4|FKp>u|9)BANAAVMxH3V*AB`8rCBV#;^lg%; ziD%`;q#Pz$@5#4PW>tG@``F%~h@E6Kf^4)o&begGH<`Xa5^fY;upM5v#fDVaoM5P)!`cY+6B^SsfUSCNJmt=*zcIs;k1KF|Qon zhbKjTN65g;@iT6!#u+r(r-x!6UQ3c$$=S!V&v|tqPq38q4I~S&etYe6*U?3CJbGWb z_L1)6gy7NS;iB>_sNSPWVeB)>_N&bv#&SDi#|pcK)}zD>^E*hNvjhn32o7hiPMllB zK;iN;;(hF)vFQwn?;%-L>bCOfO|jr%0aI^twkp5QvU+evUe8EU<5jQnJylPfe%E?T z>q;>i&MKDZ@#O;#n~(0^F0(NN(aj&U56jMf!0O&no-DC;~E!Fk+oics6{!9`au!i;K;1)e= z%*#=Pk)@jM9(_a--D&SOYDnZiO=iO-UCR4Rko+nha{=XX7=>mK zf{|QV{a*ewj1k-Es*%IoS}lBPG~}4hP&u33a|SROJCi6e9RzfpvaHb(`km2>ya5D?WNp7b>yR6|vds2 z_V5(qil5;@s1}zNmtDfJSkC_ES4|dR1N{thjQy@meZ;v_)cu4`PU0}3C1a(cr5}HV z_{~0uj7X0V>}0jYn7 zjv`H{YOuamvYZH!5l}Lg$0=b&g4U0Qo_Veg08i8;2?Cj*VJMVR3 zNDqR49T~(=*uL>jFV~wsHX=+oIRx@$)*LUES4MHr=+?*UAc+G@H~04xQ7Rq*r8l)J ztjwIeC_w45>_mlLFYl)Uy-zJlRCSW|aqsw9>9)603^3w*!Yd(#nCMGP(bqAWvu^(W`MXO;#`E^YgSSx4!`0AdpCE=AKNO_JOG?kkRmmWB6LkY5M7x zop|=US!3%psj@n&Ta(?BbB%k()olHakB(6)gaKk%lR5Z^=DumhX;>Jb5DZfH0a8P3 z-G{wOP3{meQpjkQCd!5BaD7f^IUFFw$eD>gXBZ;iFv9diwl{IP5-Hzahr}}|aX9f` zQUzju&MD4o8*^~lYoH|xL%5i?o~}$Y9}bk}7=i~#MilW>qbIeLvZ*2oo+Gp*ky}u- zL1H>EirE&%p{Zy_3A?a&dx?9>@$r$E@qpNF07QmL9yhNCGx^2SoRxL|&R;GVVII5|ZgcUo z+vks9ziYhrd|pHhl6?0yM0hy3=BKl@MWcs1qMT}~o@Q;)ANNxA+udH}W{!3i0AV5# z!U9W!(v9lx)b}jYmS&(y6?2HM;%G~l3O9qH{Xj+n)1)xMP7QQfI5a3b6E^r-C(Q_! zl?$(iab{woZni3>t`($!gnWtfnGP*&zI_OgNMm|w*v%H=FSTWWu*D`X62900*Q~RT zs)oK-Xo);J@(RR*izcGFm|1rb@J6w!o`yX?pvrZ0Z#CemU;&O%-|B}9Ql^aE5{8$i zl}e^hc|X}H^Hl&P{a`C#yMWwgok85_)GDi3Z8EiKZlbI@&G2IDS4n{3JQfk)Ot)fp zgk3}#@{-PxQeK2%9q!NCsLMpU_c^td6w{6kC-qpf^73%W&ThWgZ`x2gFxpUF;r<-h z{Mw)-W%!_MUOM!1<1znkUrQePgy)b~gPV{B#}!Rgl$DxGx6Xv@)X~#LR5%=OGVtR^ z>mywCKL$B-Q_bVidBrn1CJWHmcf~#h%)bjAuaK8UNWz%C&+W-vfESbzir2JU*c^gD z{dC>Tw>^I~yyG1TlNd`Pv@D`#36857M}^63ajlGbKnBq#Ck7-TTPMqcC(5#hT8n>g z+Bb5rhDr(vNK{~QDVWSNs#AjA!$fskT*;iCTd%2IDIp76RrHz(2}9_+DDfT!?4%Sx zp5L-ql%<%)F=x|}1R{Lox<2AH-~+?j&MlR4CK+ec(!@3gYLkUPWBY=CI;TdP-RwdJ z?vnjzL%enU=QvNAIYFqxazn=U#yNA0?b6Rb)-KrPt4fz_5)Vim$}=zgb$XbW|DGP8ukzjh~MlCp`V-b_w>|Soy`j}qF_*Kl}MOd4NGBbzF7dlWG6Ap2smcF zC;@A0a(ed5ta=qZ=;F4g6VFPvb(dpUzb55dRKlrp1}a)M~6Zh1+#$#3%~BYLh8Tq~4PlO1!Q zFiI34DlSg+qbsCL+rrS$`=$Agl}MNW@G6RT_?blm0QVN@>|w7gm%@LQ)27t@NwmR^ zeI!(3JJ01_vJN-;2b>s|nP|TO#7|b{bXFT0XUTV#85a(Ez!mh~7urK9qKKV_sc_zO zf-sRXu@`)$ggT=A84+tO3x zA`Tf1C;8Tn8d}lWsaLvYZ?U6$hNTS|)h`OU%$jSRzB^!Y_NNNN61NTbP2;jweA{3J zPUzCp(P^=$|U{hhqk8RAE>eQ_`Mu;fNRoTL*(iI`>Fj|FTbNCb$ z7O}NzL&qVu_>08rv%1v**+7BFz;^JjM}ad}LjGk@~@ptfJ`HN z0yuGLT|R^dG)jZ&YPEVvCAmU&or~=s_J)qb;2EsQqF&apM=0qQ-X&6I7Vrbzgw>cO z1O_ccvfg4(gM;}Q(m+R8eg{WPSFY!6G^4?RchS0FFjyO3Tj-juPVs!nt-^JWx}D4? z9O&rxpRiv*QXNr%|2DDzCzvM_BRk{&7asF}wIW-isQ;I5QWgR|HTf&tDL*?Ry0~hQ z1&Y<51zyXdg;*+)QGBiH?>o0mk%;HjBH9QBML&JuaH`YioUw5E9a+urMNBPv0AI%z zw&KoSWv{=4IzTbTskw8lMxu@Q$0@hQuGK#2_I0FT?S{)Vn)L95>m-|;AH~&*H1~H@qLcp8dxul=v*#si z*du8i5pmi6LqUZcmo$eEm4dws16K&KY>=K)ZN!XL0;#M-p|o9pgMGHy{VLf^QblNA zwvoWFhMx{3!>`Y6rXrsMkJ%i)iT*b zWwV0OATTthctnc1py0g#xds=b5YtV^MN8OX`63tO@@n81$vL`mhWmXu--l-FD5%m> z#mmM{f?_I|86XueNY`@Dqk^m59VqrEj&q&&LV0xBIwFGxOUrzJDFSI`A0udeJ;zr_ zmE}atafDLzjTIdMxss!gM<3>zOt#i_8XbSYWZw3TJ6P^qqawXH_uGXu8Ufx6A~eAE z!w(7mh%-=_<@i14}c98XQCY5_YJufT(IRo3lZ<-Xm)=E4SxGRHsxYJpQB~ zzH)|;uHl!W4l)SkGCdbYhn(&$$fZxU{lxZq!}cfMu;0u1;1s;pc(hv0OZy2BQTVh& zO@W84t|2MT-!eH0F0Y%JATC`8v%Wt1)!F};}zmtP8Tn5la?gC#35u&Mc4Lbo4Z5Uc;zB{j-2-% zcS8-J?XG{hI@RmtAip75W>OlEM1pSxveFd^f}x_D9mT=adh2ow&_5$cKRqHj!}@Tk z-_F&zHl@B-X0@Yf6ug;>z)H25^x$mCv);a+xv)v8_?RI{2}^L%lK`@*+A&adX_6L( z2u29O7~vQpib^m-f<;GaBL$&ICI18?M1&E*Ou6vJY~`Q*edxh6mCrn_{Sz8zz{!5+ zz-igrr{7D|Yn+){`4ba8yrPz)SvuwTJ0jtqh;S}O3y1=t7+Y&)>H9^JVyI9+p zNMDi1SG(IS4e79FO3-#;v&7`hZWGa&TS^~7SdeEKV9>VXTvys4m4((NGkTe|I69d+ z!NyfTIfWI!YkdHRsw3k-&8W7RzqG%Ptv83eus_wqT&my_rNg88JwF2GA8ruJ+!jVj ziH9{9QYgS0peGyEJSCiXgAXe(;sHUp)UtOtWYr6sc!adMw_qWS(a0eaPb;v^pZ0p) z&xD;LO}Go14>Hz&P3JkwUOaZ#R|Sz$tP35rpf`=k*oeZ5P&9u-0wxp}%Q6Oc&CiDd zZdA&B&=w^N*8oKIM=DC+>d;%g9$!bbi*>Yk=1(u(*CSkGG;YpdVI@mW73OE-jr2cS z>jEVb#2&r&dJOA?`lDW6kWK!QX-3hk_>*rH^o5BCU9#7rzfIK2wI{@azwdm*+DF{! z9b+rtN$X?BW00Rv0gt*mWw{a550^T_;EH^a%PWGh4206s!|^I6TlOTkQT!2Y(Ehnf+b$y6b=AOqZYUbqQ zq^(b=2i`^OO&mswiV>0R=Lp;0TxYi>MT~$R&pY^lrC=BH?$n+tf;S;)trz zvyjB^>4LT9n~e#`w43dYzn-tMT{MmsCV=QOEH~kC`ps@^o~o|X2B;l2Df~S>Cl>7k zUf8dJmJlE((XfDqPA-z~UATeh*P<%5_qhAc*b9Mls#K0A$k8XtCuV1oe+qj49&4=W z?RA`y2OiyVA3hfO9KpRuaxXPSx;E&x(YvEZbS5VIdmZR8k)uYy_qzVv zpB7|rP6LwL$wi2byKlv z^8Y#Sl>vr@{!a?#zhbm9F*33JZv}I#sqOqf3TC!$FRNc;&EPirNHX?#Er)G!%?h8W zk{JO~%0fZ_j6ihaY4r69c4z?_bAseXc=R9WfNu7fyUjjucobC6b#vSpL$5H>u(Ost@ z4rgpT_hGMbN2QS=gs?G!3of&GwBhYA|Lz#d!9B7xJ89h?Fa4{V!ijVd40?eAQS+7< zDdPy{28nRnX}ct>1j<;TIL|PKF901yp$&|-RWc0}a^EsSbGo&FZ~ipS5WFGRT|ex_ zTj0LJy#&d-ALXIq1REl#0)i-vmmmchxe3Bf2F6y?jtD_q2@?XvM$b~)EH{2b)P#=B zr<|J52fy)-u)4EJ*)1i~_#>A3r$q#?C=QV%{Fs`e6{uv$s}~maUpm(GOFpt#qkxID zPpWf!DQj*G#H1+(qQMtQfk>bNz3&w$9FjVwsg2q=H6qc(F-=K^nbKvX;m(+lSR}H~ z%SP?CWm|pL=lFRWGigZJcnQPZpe~Qz1rsGo#w);YQxL5R|KFK z&Vuuw6X89y2T;v4hbV|qMtE^+;Gg*~7G6DolEG~<)0tB2H0Rjys+CP=Rx~(6? zu+u6_hxuy(z+256eY|nNG}rL(91i-HACtbzuEL~yG~y)WGsc_o!C&qImpZo-JI9{L z)?QF?C!)I7MgRsu4E=_slBRzh;w@Ut96DMw>BWGV^QD4{vLg)dKyuW;#+>sb4&^kA zV4>Trk&`MhLX3dFFhu0dE#Ed^n1iBAv4=}Y z39-DD<&a5%DW&#zO&%$7H~*pK>w*8{hM+4R2`IBRWqek3)$T7KucD`8jZO5WZbK&a z(oeg&t(of*N|*IXnvFT}$L@Qp^(TT2@=9x(QZ;gHZl!YO0p)Or$SmCzWhl=yDrAuQmD^lh`u{ z@FP=fqxt6P2ZCuS`?8xU*TP6`I3n6)fQ(fXE4jL>5Nyo(IZlbr)P!OpF&~R5t_qn! z<3&-qT$!u>c2;hew~o-GOMTB}j(ScvS`IWAM6e&rMQMr|yl1I!A$sckFw6?9)HK#A zN@dE#z2bmX{evug^JHsR?cW}oeUg3$z7kAiUlX)PE1`vaGJ%?T^FkP`stvt1+r#Qc z6H#ns!D1JvvySWrV1gn)GX@feza%oCkk>g2E>{W{*9@_-XX=*hO~n=4w2N8tL1hRu zLhm^J*g6XzHy?rEBXW{+)1qXjWb}Ag{>z?7tGg{N{2L`K#u5|p?%kRL+3dDqXF>~v z^iTW3y8xYaGNoGF`;R8+1+z$bhR5CKMp_a!UkJqygY(o>uz>6i+J8H#ZI#*kzeA56 zO?iVWuwv;0Qe}9}`-K~KL}Y_m9<6RKWGiNM5hBiH+6H@OuA`ni~Ni-iMzjIik>iI`HoLD)V}&+oX^Mux_B8k zVfef$UfMe6feE}+(6h((DCeY_rsFcD8;<&wDpebU?aWqVyAZt#1PZ4P=JoUd=5Ou5 z%uokF4HX!60-PV>1Lld1%zZFgb9(u|?^amLX@c*?gC*d$7B#M}FktlUwcJOwKa5hg zRNO4vzpOY7Yl8xb?rEHdLpm609*Nyv5tc(?FMVn&Q(%Fa4eKjr5KvusK=FSSeAh0# zKWBhEeqOG=*Bk7J5T?hnb-WbYFH<^e$%6~>?gjVq?C&d3zbEv1UPp`okHK=>LR8Wv z;<<*)IvzJeJVo$@*PEujk7EFD>pzeekCr~39uXk~TlYE$&I&(JGUAj)yYQf76c_pODC+*c31iA4jy*w@Pd>a6l00~`8C>Tcqx_f&na=6Sn#iJDHmYodO-a8ODB<3MTKe>)J z_d*;Opb0nM%yOzCmFvnfcyM;&Iez!5(?`x6by{hE8tI9$@q6czbKA=wCu|xqIThB_ zl96-QWzHumReUG9O8$UF2dhw-I9lK(%_~gJCVufWdk@FtL~}FR^~xT?q~H4$&G-iF zY(0-8F?)rL4gH+%%VU8#AriDaNP~Irkv%h%tB-*GuF~!)@^xrFL^G~`b=fET@oCDyLqR0J`a5NL zS6xyi$sDJRnpNe>3vZwZNyJhao3aya6Ktw(dzZ3uVv$mlq*t5LrKkp=Z{%3CmjrgN z)h?&i%d%%XPbOu8_SyOpD_jJuVRd7SN2KKXwDK+HfSors&iWy!4Lo!FD!j404GSd3 zqZAww;dBCqh=n+_f$-4|jUn$S@n39xEDY*+)>^JMAJ^J;Kc~JV`O30~ zxT>)@J@r`F9o_EAYht;539cPCBeP>}ET#@UQ-UBUdos|ugVEz2xGei0K`mwx2>9PcF-y(?W!WGAtOx zQkjXQ>Q4K|Ja?y_LkZ~@KU;2GuZIyAy-CM(J;LDvxKwJ!2+;w=WN8_f=T-o>wRVjz zE;c&I(r4++qe^t+$e)CLz1slC4;*PUE%+}r^AHhmBTkE+ql1eF1>{2TM16@Y!(03V{F9z8y5#(!{FJGCbon^oFme(C+(Bjt=wsu>Q@)*L zOljx=0N$EZU%*%gqoU@RP`(MRu&k1XU$std=a|A#F^Wl&t}__Zy6GWRq(F73Fi?W_;)tvgiQj&>iq`hk=utVDIh7@$i6r?uq{S{Bm2rMke1mRgP8oI!sg!ktc zW6ee$rYwBiULhJqka81$&NWm8mLz!6CdWYT}F+NLc=hm)}1D}Q=sK6|Xw9EMer zjnc(bu8g<{!d)Kjb>+dvQM8hXKxSM)BDrB8NTMl?^C@e4?CHSHti{zQitQzFiDNK+ zd$@1S5+u!}!z#Z51?q6XM3T~qyZ7Q&`_j0`OjeDhr1s!%iA>Ke2}vwxwBI)HYw;YA z+G(y*glb3&Dw*u*bbV;%q6-2^xi^oVGss&e%=&vRfXItQeu$vBL>B4m_W^K$KqY_Z z2VhooT2VkW&@CB2G#~RZujK zu9bF~;cPV=jxeV$24gng6mAuK)9I68YWN4kY4)P}xoy)n*KSoQO*Ijf6bH04=x9LJ zQ+Ra4A#{*31(7tqySD{2I7p0w7_i1z{xt<5G+3;89%c8Gs1?#l_{y{QJAdcf86M0EuxSd4N8wCVzIL6?{ z%R6IY5E2`vp~;L<{CK&_VkXQ#=c7FE>C+uCz5_VKnnp?d*(VIXQc6t`NU1Da+@h|n!WC5Zca?iYQm9;}uWSY6X+oQ!HDmnyFQ4W*+3m0s3ym+y zX>pE-CYou7QJeKWw=|d-^iKj9Qp)^NpX{8ogdXq(M?5)3Id0*KDB*=`#IZCd{L_pO zsN-Nkcv6RU6PBx<>4ond8;3wUcxY_-n`BV{?_DE;t24KRWrAwj;Jr56JBRg4)Mh3$ zG1~5pYwwi^Wa!nf;A@X^kR*571w-izLHJ&bWTNe}V~0TR*FTm>LA`P`*i%Tt))fZ^ zK@MCd;>8^e8N%Ec=x=V9$(N z{ToYeX234SJNXNC?0fdamNE>bHewUH>UP{t!X#h?Q_Td2PlQsiHq$d%CMYF5c`M}& z*Yi}>nE~8Gw`%y8VlQJ|u~A~_cQ*YqW@fZn-4Sk*pySZ?6=Y)7*&+W@=Fg1qRR$Ie z1uQ@x@csRXBmQonV1V~+vFkGEr_N3+?STDPQ-4 z{;xtwME@yv|5q&Ae@^TFrzJA2shza=&-CTCZmej~z;N4khXSQE2W~O-De}1gk|Gj( z6s~o!@%x$guSNqp>80)DLLgxyZO&wwbB{9#THgO~Z1MkxV@noo)cfYx;_;G6;}FzH zG8nyV7PtsnN@09%)Z&MqK%?oW@!d#}Oh8Fly<)H5<@@^h|8Z=)TZ7r{f188Tru}x8 zyrv5ECvOaPd#q9!C5sN))t?i`%Gs6jx<|A$f&R8!c+4R+!IY$9>fR;;Ats8_SJry| zY}FteCnbr-kRl~#f^xH)9-s<`Aew(S=v7sLG-=fcFQf}Z_SxBCBBc^iZNI(-m$xf_ zld0*$1w>f!^XQK77|s*!R>s50fF_>jA8l$^hr(u^%6MZnO9zoWSeVHMZdpL2H6$m5 z#^r^|D~WWp&&qHyF|#EZr8;VR@6~p(Zj5D{FQrst+Vfx_LrWvM8 z9dd!Dl$Z-1V@?dcLXZCvyL37+Bl8d?JUG*znMsY1~?ILB5fHc3H6EPmVpP zb~RmX`S>6yg(1hZqv+|5`H~DBdeSRWH5n%Dlxwwks{WMdkbVf;s#IMFo%1fz&m=Mw zNg#Y_6tKd+DZCd25#}P62lpwZXJy!D>ACh?B`B;nxjMBdujty6sEXR>W&Y8YBL4)< z{dDM#+9;j%W}Qk#RtxAh-{{p+$HFv`SYjvq!$^q47zx{&%@{t{KWEX0 zn3`XK4~EAVMxJ4k_vw%+B5Vd@O=pM^uN`-E5U(?iaCk+OPmoL~a|8nTT%rID5Nkqn z;ogDih(XC+{?MadgS&h7Q_HDl&8-dif>X~g6td3VaSmXgW5*{sP9sW$d371PnpL{( z-fx2xArxmtE)=h=>)AjuQ1-x*3^L%-rASzTQj`qOvuw?5KOtm^C+XnQ1gtmSi7+b_ zLxMkGkSVKdW0{&Ug?+n)Q7|)nB6n>Iy$z61fS^r+oEd1pS4XhCjvz3bL;>(j0niHq1MVJ) z355d}DmaV7{xoo>>8iOfxIQR?IKRJ`h1@Q0dQNzK-F#G-!AjM=+N;xHkJiJ*rv^oU0KV3?0 zdi#{`o6aiBkvouBL}w+i59cvM3uy7>AHwW&uWAC~cFI(Qp$e(uR;l&?UR4OZN`%N7 zgz;^t{+}u+Mpoh@ORkF-dIS@uBAUAnBRnN|v#73Kgt3mo85MvL!jLikDu62^(ENxw zPEdfZK4E#c+mQ=t9RCll1b%55tqgtiEH4f+|L-lTGtTD(d42(Ed%wxQ78@(sz8Z;e zWNY@@HL_J-&`vh+Fyx|ahV9F9b8uaeR|2NlzkS zeYHyt$`O68sMB)Q7RkrvP)&5(ZYQqGXTFqtdMI#?WX$q1J#q9oWu;hWf+amLEEY@n zZ~~q!WWw%Xb1)VPBuYd?Z|Qvl#SxH3J>2aWq9}}0Ct~vUM|_$_XroabMkmfRS=3H)P2Y7KXanFu zkJyUUGUiUzukLo$CUat*=fsu6Z!(Qe7E|Arm@nE{MI8}`G*nZ;=7)2ofT(+vlNPEq zTmXS^zrV(M=hngBhV{d{V=|G!N<&Tk$16m@zeksQkXeB93K0X0HLru)>A}_#mfrj) zKg86<+{P59>*^NP&mXM`lV?UzQprY~`=uDrkhHWJI<;?A+~p)zR;f+d86d57wFJ&V z1%dM6b?@tbEzL^dRZV<2c`C7VFybVT5Ew;+&%F22c5V(QLB6}|pRms2M|Dc21>#~W zfu+{Sb^*R~s6kBnK(qt=HE6xRckEI7EOP%T+WuF7RVG&U|6RRLiRYCcWIzaW_Z$8b ztJ2B$iM6@DAq2)I(z?)Z1tThzgcS7l$x)FIg%TgnyUlwW4r?Dka45(?r3V>~Y(u5- zZ;J?u99QTW#saX#!K9$l-NyUrl<*02RjWxg!I8+Q&F}6oB;EdU(rU9MgURNs(+r0~ zjZL@I=_TX3%9}tZQYR~&*NZBA(M9tBgVgu|W2%=@PEMmZ(ievC1Jmg8q?$ge9hgeYZ!e}juhvY2hj*)AD6!`MjwbSkEPgw((tLUvGi*PYk?oAL@h z?Uv&+jo~zQ0n*r3>32i*x9Cz|wXPct*+IR3a2g$O!k6wpTqEay#e`zw_}{mvOrgS{ z!T=y74C+iwz@#8CqY7~Z1i)er68N7E_^+rQOq@*rXSB0LOFC(D1hMB-z1{^-!_RmTz_$)5Jp~Rp-CJv@apsh(U5w5g9^im49;X>z6ypL6v#h=ppDtRhbuI z!|qVIKT+i6p0F*#-v{RsFTq7OA(OS_k%S-v3F_@A4=NKPNY<<@?^c-k`6r9U{se0X z@*cE_!uB(VTfD&{_rh#3=t@bnWR(M&($cU`L@1y#K!zr+@?qjb%g#-;F6A_}7Qe@R z*iDm0-W8SOPKA0^u3BXQKLieei;gDc%-s}Lf~@+Fo91GQhXe`~e)1+K!$o{vDD_U) zROlb856;=YMyl+l^FIvw6#Yf1v6xJnG#PW_f7p~Kwp@U2AK{AiAW$9*}64@ zs<=YxCHhyIsjtwaG*UAIv?EsS94`RS2M)xaBz*-prI@Yl{=|vI$$8!62Ukv}rUxhO z5d~Vza%t5x{j|m0;LnpGHt6G>Y3e0On;y4r)$&waARxtRGcP#Y7`Zn&r}1LxTs(ET z!gN(F8RUcpt@4?0GUOHRM_U8>1~oCQpyN+U6FaR9Au+0y1VS;6-QHPQ=*q?jss zTM}NNDMglVvfGgsm6h(yHC1|CoMDQQ@>xzSZ&aYbTY5ary3Y5CdSd8LY|xeOEinxtFudg*@OA6(^N5IFlz2oRp-%XDMTMtVk@>`j%H)#>l;Tr= z2O%OCjNago6CCMOMSzH|M)gOl?-f(Pr6n6U=tpbC5oVvE3yuVVV}AF53IUC=LXQa_ z?F&%xAE^eu1VX$eyyU^_VFm-=Yb%=;E?mlGLCDuybY3-3ZMq8XbjGJL!){49`?A4u zMH`91Spn})c8RE?>_HP0#}<8QNAMQw5_iXJ+91o#ILY{Gs}V}+FwhNA6cg%lsSqo{ zX7rA|!XfqB9@Ind&73*uZR$XgU31z-BimjAx*e^jO7J6T5VQs$u^p%SMEHg5!nLar z5S~}dyCLvJL5`6b=Ur#oZ1SPPdcwtp`>Zda@;VsCtpZ}n)_|;y!Km7qkWG!EPlG7d z`c8X9ywFA=FeMvkdF3ym(20jmG#PD4E3z97GtVrC%nclO0Idzxn7o%nV=`m2tBLyR6kI_sHqefCd?m44A2xXc(?@(2zi1$2r>x-S68u{!eOcpr;lL4vi=~`pu7tF=bTChFuhbG2a^mC*sFFG^-FO>7 zq%Q;=0Bz;VV0ohA13_UDq3ZI^Crq;U1$$MPuk!g0mKfixAtqjP8wVcOOgzaM2&+y zge?{aV|s9{&gxOX3@xA0r7xj@(@2=qc1~qEf6ivLverVf&@8m4k<2t4K!_iKFjMwL zW)e2^v74%b;Tg_AVs>HEK=O$D*AUbzZd{!XFaxL;glk%)vrBqE=-q`SAjrqE?Gt+F zZSsK9T#YToBAj-n*g5cL$k|iCYiRP;#Y0UQO?uzn74*n{U!G=K`;e19!Yw)cxf{5s z3TN;0sAq>QX^w4m6_2i62QNr%1t94r_rlwHd~@Lc^aV>{W^F>Z@F-XhT%>n^sp8DD z-9vQ2gLwKXvU+iSkv4FeRGw~@vM5qa#(L-G!5YnUBcSx|C{W%~49`x}M5UqFBi&iJ zHher|Q4KZM%`A!JN<{^<^;152wvwhqeb1d0zz}P|Vl@zSm&8=KU!x9wMEK_eslh?Q zJzjO`5Dj5i9^Rq({YJm~aJrpwpYtc&&Ph`N3nPV?$E@%Zi=xlmYj{L~f=Pr{{xj;P zLIA?x7%YX0FPwp6sCn;XM2$WbmtCFYQ*UpoU_C)MgC% zjev)Cns#S+E-3h{m`l$QVr2FlmtSF>FAY%DLKFxurCGweL=l<06>|1>ruoV>pstD? zux}WNaezvOuT-q03CT=RGmE@Ajiq`Qj8sAwi&jlhpRvyaXUR#Z(olMVnUKC?3n9*Z zAWKh<>CajI@2B_E;q9_I{h%CHmcPO&7@FK?!Q8)w$!W5Z~?%GyC#5n9C~&Kk0w?kuIf?+w+bScx zmAZo)|eSauc51c?y_%-JV~tpsUSJPE06AT0ph z7)=;0G_mitW(bgZu$|o@<~kUSv=l-zh=;D~Bk*199gR_%iC$fIjbg*0aFE@(sH@D( zam(lGFrHkE_i&FV`24%RZy(RH3YEzffP2cefEqF#dLQ>7EOO?cVghD~+8`_HpmGaE zL$7%^JK2iHJTY26(x3`ce+927zz@IH_7rCTaEq=kudt&p*H@W1V;mtC0kYhBH&sgp zoqV~2R%t?vXwaUud*L8H#l_JemUJrx0mc3>?FgYnjjsXZM)^I&PV?Ph?$ngt<~EnA zd=>*imLcDjp7r(|B6M?g5&v33-(rk|Y*Zr3XoFw#QUQ2dc;6E*xLNp-52*|sn7p;4 z+bE>tYVGKU+qWGC4%mPDIJ?IjK*lZMk!SzIK>yDy@QdG5rcojkdDCsd0$B9tsSeU%aivkQUQ~KDcx6KbiNKC}eJiZQ3K=x7c@+M47mJjVK zIEq>Z{SxKj+edf^_pn-6OaEjOqkuH^e4>rH%HCin5pv^G3+K1vqvF&*x@zD>V-*l5@L;`Q61a(jMjmi_lCeAf2W zAWxz2?Q{3`+J2Sa_c3;Q>-CWVcgKCNEcoWj@2Ti!#(n{P^YevIGFO#^o?4ubtE$UM z&A-~MxwnPiH0{~Dtlo}q`+Wak3A02*qJeA7cXN64aB|h;bH6t4J9#tR&+gyA*yBWq z+5yhy>5wBm4h3)?;Xrl|(S*;B@OJ(@{+1Iay*Vgi>}12PAF&3Ue52ML_W1Hho-XjR8$}g)?zN7QHPxfdPF#rV;aKa=3`CyWa%JuclnN5qr!eIxN@Ed- z6Ewu;bf?ereA;Wc^=b00e%uIYTSY-RAjq&10+?z`Lyl4oC#htO>i#)r^GM#LwB#e1 zk=#hWQO%a^OG)^$R%WHZQ|@GBDbN>4vE&V`=|JkDx@Dr>BDCC3WlU#BnLh$}8#C8d zOiICl?DROB)yA(HL*C8yr>8G#D}&L#Uoocv)A?PWhWs1L1jN>Pp+xUo2wFn%%{0;q zc?bg)@QEALUXe0l8Lu)C-jR!0<;Q7T#mkTm7OtAd>x%@FcQirYVb#tol-CUt z!|0DYLrB7vtb!Kw2pbQTI_q+M!tlcU z+*iQiJe&w1$k zPRGJ8XLvFyYM^4KNwOC!vO{p7(DbT7U`kXVR&7jOaiv#QN2b-JOQGiX5d?7X<#ysFZe^UUa zsxe+}8d??0MhzY;kb;jF-KHIPvQ)7Auia_}{$Wk~0r>^o9>iFl&Upv{Z$BtJrUwBc zBru9J{R@F%>LZ#`e>7*PJjT&*3EO5 zDIE^xCAFgzs_Tg$&OEdmy#Nl#JqN>2wD0?3DF=vqp6!QNl?Ri;c;S3gPRVn0%tOq0 z*us6!tJWx(j3tg(nrDY~WSj`@-mEapiA#}lV*>^aGy?)hWTK{w`91eHa>4|uz9w88&7M;F{N zkSj*jTOJb&+EiuSZ>7A}U-a$0;j zlYDuI(Zr|$?3uoo#tq#sxCjs2`l6IchhZp<;>Brq5P8tEgiS7Glv;->R3UhJ_CD< ztO)1_FiAgts4jApMwjC}pmDX}KY9h>npb7ULxDV#9BP>s>vodjtWA#AN^P-oxcuCG6+mS3gHl{mGPy>58MnY zR}QTxFu%^*+8QNXC)Zd@;02N;w25%n9XbXoWa87TMpG0Y))ZZ+97?M4Yx-;^7)|>V zfMEyBadwJm?R<1#&2Hk~LJC4D-4KD^z0f#j={eu1(bf&n9T5TZ>1)CSXkFQ26_4}V z-I zobymvG$t(G|0c8TQ;YwUa(EJ|{ueM&N&{GJ;mIf}K>P?)j21W@q{ZYp{m)}g!pJfh zH&<2{N3h>WXFdruKx6|UAvAU^0lUC`;lZ5E)17H;oH3fvo9T3aM7~W@XlDsFb|OMf ziBSSeK5z9(++ImMK)hljBb8L28dYJh3t{_St>Q>1eT^Z4>(t#nQo7JEphNq7?Fh5J z9wmRi*bx9b@MV>10+Z`%qquS;bk7y*9(F6(QY{x%Nlltm{N}v{csgRLA6#|BE&7C! zZnaOitfUt!L}28RQV(hf!5(Tsd*=bDf+6~HmgAU06rJ(Z&n5Mfisb6a8(bANs-`Om zZ8)?edP%3d*5G(@0Ksrt!61S;m5Af*xC&?jAemRkJ)80~60k059&>O)Z|F znAwXCyk9}21I^7_bwYBnBIj>yVk&XvlhgMi9W{>YpjkqxGyO~D@74X`^ePG>l|*ks zqP;!c&0}4KLZ0?uKrvkQ;WQJX=yT=z)G&~(vY=`L5gc;q1e(xrgKPv-(C8b}#VCm* z0jT9eR5$P|id0Q)VfXjfA_RRgf$4f@gb zHeSrXAZ}sxC(vzZNS!yzakf(~w(c((TBw?vKVI#K)G zW)k~xxr$VRfbB09L%IZSUT8jL zq)jHKUuI@pPsUsu&~S2+yN;pR;72!Bv;@|ha-MkafPB}d{XkIF2i?%=okGVCN+;9! zDif>h@U663N-9Bh&`t9@mF;}MnZDyfML@JT_H0ytTUM85jvc0p30*qV$N~tDRqF`X z7Xf{=RS{G9KZD-F<+JFqVT`RFn-OuaPxrb*8GTwg0gFRO=+>EBx4v56S?}BaZ7bs1 z8KPHCl(I|lBx~fpFYj7mS)_h7?R(vet|fwLCYs!qr9X6 za3@4P1kadsHhAn%2B8ctnxuTTey^%;yle;O0+|K~BNI=iuBz^{s_$~m@+qpe;#*t| zOt`;G%XXb#yMFgSLU;_4IIi|Ke{H%hqhNM()#rBIC4OF&vVPtzn@~i{&y5{%iOw%{ zu8OZS&(^ow?`?`nltqD|(N_TXabAxv{i7zk<&qeeQO1+8Ki7_JyC%LoN4L&uSt&0c ztm~IwX$lia59o0EL*5Sm>Rp1#CE97dA>4Qw=hq}{IRwy0C8vv{8f%j(!$HWON`AcA z&sq{3G0NJ5@}G{2!K>wtSRwzqHevnSgTv8!gS$dZ^oiYp?H*1Q-|g;uBQ_amqLzp- zMt*;G8^u%ex1j~s6ci-pP@ICK4F=OqKUzvU(tRdRvrRSO@Iv;1K&vcr+r@D8)4%vL;SS%&a+K+Pb^I_sJovANuc6Po8iMU9 z%%4@)IY6_pp9MKaR|9mm5P6!Y2agzs%``H~g*lRXF|`1I*mvUkiAI=)Gc!l=d+fCs zjQO`=nnoRuz{xb69I5-~lY~;on z9xQT-ZPq`RYsrKHm@yL(PM$yofF?59@zWmZvaaL+d$_CXh#w!4#aeAF$Y2YSHY6TT zvf^y~rC#OE?chqAq!-UPN+F{YV9)OB@biS%SxeG~VFa58Ns%cQi3@ylsGIJg{cb|x%LF14iY)=z z=@5E1>S!DoW^NpKGtfDeo}o9@$BNuWCY>wxfdumyWYfEo$OQq$DoytM4}P0Cp7A=J zH@Lg`3gbx~N|<0D_5`zGiFRZK1e$|UZkzeY`kZiKrX4f3)X z{G6&{Ye3y!5x_IV%(~(1Dj&!TXmSh{edv@8q39drkQj3Q*(Ldh334@TQv#{e)8}(@ zy$!!?nJTbV^}!(7?)%kP2FQiU#+5==s?yDn`!6d}Xys`0QL^o)!jCGa!Jv z2tZt*{aXE8a(=;%?s?*0ABYK-nO-FZaU3vow*^taxdiUI4G}n9--0eC(lTQTXVJ(7 zPy_Y$@Th=4S82puEeOb7W{czjap*Mzk@|opy)`=OmSGpw#R`oH9t{N>6C(JzdX?46 z6`rL~lp&A(v%OzI+bA3ZDwgzMyGzShwPL(inn$26FaTVR<{YXfq9=*6loUjxDPTiO9v%5- zE1M<+bfb7Ai~<}((wlFL(i6|&*6|fIBk7;Z%WF>K(i)bb`e85V84!FZg1mI;>83`u zMXn9Km$Dg%7sr*=E@Ui=mVSQ7#nD?SO9n9y?Ll2{{*7^gFfd&ONajHWh@OlJP`DV? zz4jK|;nLgLnAe5!vkFT_Rkh~FuXeV)+DTUHQ2&-H99ru{K!9)WHryvSV7a9@6q&tw z{v>Dgr6V-7hiNx08C*H0M*@`dfMei)t z%HzHgSAbEUSnjJ-*1sic1P1@Z47>?h?GOjtPNw#?>x0Yo&Lgv|wDLLQ7%7X;;+$(f z?-%t-aRh*-KSd?9kR|4l6t<3#Tj=Yd(Q{}RMGHFw8dFDB$<(7G$T!0Nc1F%x;zjzogFSNxWP0T! zsk2n$*IA@|kO1o9m)*{S%4K$xKYjjB62kIje{~E%hPoM69f|`HqSke!8G^7#RKbXA zMd66Mo*5SK#BiLZiDD=io04Kf=S-wbID`Q4#PuA85Sw)Y#orK~;A!^iqX!4<8OIcsD-!-6ka$Pp$LZSo6Ys3^yc>;frTgt;4*~69XhzBGE zx4bw4+hOFw=m#NP%x~%-;a+9Gvi2dH?>wM3lT_XhSSF23OFaeqerTHe*o=p5*BYs0 zodfQ6=x_!wt!mRKs5JSOff|b^((}brO_@#lY3V52e2A{z=58xCw~7uPL=-uEr3>SQ z^w^*fXtx0C@IDAY3e;~XSlw5X>M=MC(P$ek`zg|m=kYu9RdiY_>)?MZ0CFL=h#)?A z!al=2Fw)Tm^m*XIZQTsm_0gbNRrH-1+tvk{Qpxe|LWszD9NQwuqeq>-!a@k7t!?hO}3K1mrAncPYvNXN}o zq3oNeNY|-VC*B_Ssv!NZ4jLr(zj`D*I~pV;(W;{SxpL$RpSb!99>_}#J2!r5(ZXTX zCE`x81;Pz~1Fj8pw*rvie2SaQP(IWxaCt{Z7r}VkE(ZqNIY+w6zCz{iq2LcT9VOc4 zsDTAB#_x-j+VYcdDzFPD*A;36RMcvcb5$mmhLt7SjgRsNZg|T z(dcL}D<1U)AdzrwOzk#i_r0vl!-RVs%7^SMV;X(U($8Bejm>Nma@s`M#H09^{7Pt% z*qgD;Motw3uA*%!=o|HXdv9^Uhi}Gezm;Ravu3hp#$R!qI=@m^DbH%YI?xpmGu@_G zb!B#<7<_?OizwYs8Ey)@4hQJ@vt=j(OKQTW`n~``)#NDZ8>;%Fb#eU&lHZWr*P46> zbJ+(X4Xi=_p;%OV;s9>r;NL!(@!{+W~kLGKE0j3IzN|Zf8XelRuxYE|62Y3F?LVgm4@54fWsNv zPQ|uuCl%YaZQD*Nwr$(C?FuXQ$vzjSo!#2HSQqmTd{^TgvyZ29GW=Hx8xscu>;J#< z-`4zprVBB+I_xQ55D%xVb{mBv>iWa*3@EKbV-=~Ruwu`{>T_1RLm6I;ah_a&A;z3N zM;2%6&DPlT4NgP(UYs>*$hT!9zm0F(ruTEEt%OSEMEvyjXXqK6LGiw)lbgGiJaKF9 z&Zmno7Hx{*Ez3;L$N4GyCZ17MS!WQ=$8o9N)}D$V*CSr6$6c$dw{xT4bt`v8)aUDx zvsOjq_;p92NJ?hrbnG8R6kGOQFZ0Xk8{NiaIw|SGsgf!x!?f&+*{kwTH}%dvLFGDF z*O;hXw9oj>#i_c7P^=3KZxnQuVb3hC$NXLSeLQrE;!Nf z!KKuIm?huGPknZ~Q8`t+l$;H>n+$i%*Nc%4J`TGpbU=T8M&|yKt3U`!b3*Zn0Izu( zWas>YKZ4}(npom2Is2UhwTJ@2?3eGiZ-oK*md3>aZ_UTSHH(1>Z~oln)`R?S&QQvv z;`p6l)r?}&)Bc%>D>-|Wk39r#mgmP;j&6VI;v9K;-bdu}(*#eACP9z^f7pyP|D@wN znbUp;fa=@%Pmh3kq}Z6!1uSI2i6BRu1|N{{)Jw_@)j+4KxB19If=~rC8xcc% zaaEDdgJ)C=)81Ghm? zhyUx8EpD_Da&ODD4PZ>TOXX-zCTt;hY1uu^q>UC&fQ|_Bo$~PTn_I*k#W3*gwkRFrKeuFOR9hqy@rYbx_ zDTRc{@~7Aumj%nvnx}t`J5J_*pT*-&%H6E^2@C$5%+JC<;^%(u*=l-roi+tYv^OM6 zi*p`2mHoizTeX1+-XH_hT-RjpXLDQIc0EROH9fTeq^Jy<$;Ll5CoT_uM@}54l70Q zk2_YTvvDX3yd*@Re|U`c_-$>srmJ>szNKIk%%O#+(hzOR1-hqq%!4}i8^&jE7^!Zd zCd)9v$8$z7lLbk~udM5PhT7WJVNo~EGm-1=WjMLWZX%|W!c_K*!l4oN6Z{b{ksN_V z^YY-|ofQ;qP}CKMR%eV$hl5=AcvKlFk&1ZZacv`7xoj&qix*_mYYtS$mN*f57HIn+P zIIY2KNd{U3F1F%tT&#=LVXxx{W(k>G&bZ0tThSX$?Gdz>(G`GwK$O&!07b7xl(b)r zc%Z2df+(4DD=V*a=_e=ySP?pW_EpqFcOk#V#zAL&qL+A^7ml7RpJWT z@~|U#$BFxoJc5MJpWeeXxRdy3QZ5JU3MKiE&P54%^5)d1^EpqCnyN>bC7TRju|~DP zYuD^6`qvh%rj)B_Cbfeu_=l`gw;3}Wu^%XoHq3;!57!(JC03~4ZizfcONRpUI_spi zp<-m}ftSRF1&uZK1s|=)v#hA4fR>;Gr!zqJvHa}=YZLX?10{<~IKj$bptS=bi=gm> zPiFxy(FIv_*9R%Y=v!)uAHrc~FrWiLu{HMBNciTZ`$ZqygYRLpVLf)FPpoJvRHE*z zedh?5Sp_EDT{A;9qJqH$t`{oPpL>qrXlom6ineLSW=!YW4V$q{duLF>4V4jioDYT6 zl9)E<%=<|LR}L49>pc3)=6d(Lay_zQ&5RawX1+f1h3^U1yRuIOlExps6VxgXZPrBIhR zhn@RMl$YhY=gO{EH|vO1i(~h1W)!jc?D+Nt%2OvS$q36GY1^)Qa*@ z>#NGf3HfZ(tKT^xHl8MG*j4_(Qe5tzPtJ#rVZXvje(qi2-i4e|g~yM-awahhmyQ22 z7oU`mwt^h-xoobqLs2WA-rT23Ttz^o65UWsy#-+tlE6<m z1w%}k`|qF?r)kX`x{~zCG$|eVh8aO&kK1iVUR6 zOt&m`Ua#F5JdD3u1Hf`CO-@e>&aH5irzFzu)8}x418!`O`#??Ed!2w#-&|{rJlyyn zO0`>|6$h|nZ{j|`25TyR!|_dLOF4zDmku=`c)zj=l^ZfeF(%1-`|%p9Ov#iNxPcK_ zUmrk?`<)RM@UG)dPhHL9)rv??HQ3wJtmi#Gu&O5hTh=i3SeP5khPO)bsN&7e^v;T& zu{F@pCdWF|>;M%)jRINk?#Jd~rsF@3zdboi<+-z-U6jReh7d2wD^jo;2mW|F65yAF zkJkJRFSGFd`ZNxFl*~x&>xBgsaLa;h*)s;`AF;gEXHHSEym|!aT;~upnryk@3Q`ZP zx6%OhVzbJd=+5%UWSKKd3{~6ZG68ym%ckYF```kkJtBY}aMQiJ$nb@j2AlN2?k(dA zZ7*vYzyoL3{mtlD^8OO*w^ctxKwuR+?)8(p9%@BvoA7n?FI?f@QO{?GV8_7bbE@hluDWyi$M8S2)SsLz)4&3UBvx_rwcZMNpsO}%U+M%^SHS#z2^$6yMLbbigfYG8Pz~qWLZ@>A*Py-8PQXF-%QiUF~(XFx6 z4UI-j2%6%OaMUoRFzOB!*K)L)Xp5w%%6eeoR&$pX08LIVfd=!9(}JC>A}Lcx-4pY5$2i2$)kn zJs*cUVNEI4&cu*yq23-8nS-)mPE;bwTOz><^yybfyYN1;=4UW{Z$V7{&thstSmo zxATuq8I~n1OkbMUw1uuIc5)yq((F&KY8%1Cyu&o|h-75w`1!?_gZj;yd{bZDV~;=_ zjm+j>JLE+dZ5ZL1dkr6DIds?2W0`?xN?PS!J05>(NOkkO@#0fV_t@TaeqAQ96vWIt z1w~yklRy#rm7QS<1bhwPNT6*roTMZG;qs@!y@sS*O0rPn(4@?Y5 z-v!{_rx6Yqz1Gozn#)FfbdJX(8yN%$*dK=9)#*nnjeScYgPFbq0qNaU}nPUncvjTE%Sk$nJ}=}Je;jzh9m z21Ycrt1t%=DxtYkHA#ztByoY!)n=Q%r-}{Y$NE$>(**hl*c(3e#9dhe8ON1pvmVXE zXM-(tH^vQsqy!+AVmx2Xr2DLEOXWU(M$mqGPFv)oM0`>M87}f_Z*@X$Y*q4>Q|HLJ zgoyF)^MT`NA4Bre<}6p8bA%OfnM_*YO=7H!kx##-h>H&yiPBV)%?|YILtx`=ajaYk z>zlUm@UgK<#oFm5oSPYP`8Q?QFjrx3L6a5YAdqtlK+E++A!dx6_fYqtVP)EoTXQ zmX+RdJLB!h@HV*l$Dc9-F+{ljtDx(#$on6?fp=|wb=YPXVB59m;nWm1=_R#bbHs>@i2BjGU zHNd+Zk;(5v`WwK2dlHDj-s9{8Vq&Q@1&GBae=t1+s~Z*LS_P~H@VyhOI=dv$*%jR zBCe2itgT~$(LF`CCFbmVrrMvYrz5gvI72d7S(BxK4{F7u;PlYcug1761Sw8pdDTe) zG|_Sqh^~FZ%pg;e0@@Ypvkw1ULvV)nuP+;HQ2;m)lrr+NDxTF+Q&hTRl0)FH z7$yy2wRumOif$#!XS3;9QGJfN5Rc#|V#PYuP;Mkr2kd0Wa2R`)CjiED}g8)KOC}xF$OyZlp1C5C#m}aQ6$m0FM^a@E|p2>_Ky% zB*w86V?hq^yP_p^YaUX5F{vk8lKQ`NOUTrh(rQ4O!~5M_%g2w{tVMpS}h7Oe0F z!LyTX=~V~uD=;XH5`)qA^0&*%j2WN#ods^a_+Gj2q*@cV7@F64Ndn3j-zgd&@NjR# zrUgsPcIUZrgE&&Qd&xrQ1cfc+9vs$H9eip3bc@8wcLwuC?35vsHtc|SZW}N<2ZIm?+T(H%DWeG4u2TBylJc{NA$N*43m&zyQDfDdT*LCOa$G0=$Rlq)C$8AtNrm))>Ris;?x~)J0fRs)dd#*i)EBtu zOaF!eG2pXfQs6<*jsA$kG7{5_K3AH#n>E$-hdr#Isa z2aQrkId`@3*m*YX#~o8_YT&;kMScbwpT|KliT(xUfz_9X&RM_rrfo^e!UDdzJ%n7p zqWAQg8?V>ESVswuAD zxNDj@k`IHd6|kWAGM~|Bo=Noa)tGM))=~M&OHh7(UM~EFwR};&P7ep+}MX2Jp-m0jhRKe znd6@F&W69-@8@zA!6r$CKV72+B1bG602xrtlq_8%>ejqkz>h1^(tic zJFb(9%HwlKXi0xtLcsWL@K~`7>A484MI@hyggtuc8>i4Mz5ev%BEmHVah`V-~3~RqWy{y-@#3(`5iKAJJT_2zo7btC{GnrubT|O(i_f zCQ2A+9R#yxUczrQmiFAQ9|IC7rk*)LJtm*Hs$l4s6JwED>%7(H(1C7%FpnmBuEUcj zIGtIWpn!m#sqL2sh!zerBJQUd(i2K}Jd{ zssGY|1r5mq?}5Ed9>c~+iS8e_GHXD;xIvl=Sc5G@kO4XlOucX$3`T8@EK#fqe$Vi2 z(!n6dg|^5EQ)i2x!uM`dw^6xghKGdkU+3v|XP(UIw{55wH@m&PZ})l_dVU`di>CzNB1UugW7}!Z{=>D2 z?_7=*-as1om3v$r5DkOIis2}lAgSi()$%JM-38}irsZX%R3zy<=BJOS1HCY!@csil zGpPwirONmQ{!u#q)Qqa>Y)#2>za%l^;6U;bWljyjrU(Vck#o9~*XWw0sMK*0D!nOzcWAy{nJFQJ=!&fRl}kS3ebxN` z=-b;9uE=7dL;nplF@nCU`oK*d&P^rYK%S6or{8F3E04e7h_c+{reQFXtSV8DxJ=w) zzEy$Yaf|O}XFG5fR0gb0rOO~?FsGKb>+G@j%Rn5B*iY*zptWt6i)$iR|>bnOhiZs1tnDq3|c~WOJxX|Kw zbxfHuPpf}>dct0FC$>?0BJU|bc){Mfu_*}%2e0got1}2t@YD9QGWv%ZE7B}F>9i-q z0=PPM$^2)6Iycm+9ST810%A=&ekWQG(4i%r=pUshYtU4n%)H{R#@FOOoW@?`GmCZ2 zVzqCno6?d&CNz-zA?LC&y30GC?iUpLW+4$EoC>>oDH1ZG=-uK$-|>rYwDb>Jz3jDz z-IuYyL(V~!PHayR?a*`^$0X|UK9BV`$l>WGexZ?>b_H9zC|*NwPoX-$f<*1xL?T+I zP6v)19UU-6WA5W`@(c-GVqcMOiH1j=BtbRbpl4Dg1{Be2#%x9}OyDPYD$`Nw>*m>FH-_{BT+7aniJ@an^Oj|C%4bM>E4bRAM~AVr;UcyVzs z1ANyaQ22LsdtUKedN%;GdBSiIzZtID@T3H6Hlo#FX3nat7YHx!+;+_IgbaH*GycwV zjCeih3^lVNL2;;*djHoe!ws1SEAQR`4Y~?E(=2rvoWbUF@Ih%={ZoKGUETwJ|DP=E zhXm3Arwi~rYDxc^P#JN`(lm?6@QQ}N=h=_0ZO9~jQs~Re>5Q~zB!%@OAxm#y+5nXl zvKF)BlNMXHa{<)~Ec-Cs8j3 zhynhZJZxoMgdoZ^cWd;9wFVSW*la+@YxC6X!*^)~Et zyFKmtR#0KYSqCvT`kgP-S-|8d&o#`U4(9Vv_fHP~o4Ee;1Z~yyvvN=ktsBf+E9 z&&uG3qyeHFJi^w>j`%ouvKRY0Gp7|SVfrA&>0_obp^H)&`b6KMWf;uh%Yy-uL0;@- zxRC!Yu%t(xw1*mtnv)_)l_Z(M%KO{u&WyF&@)w~dRfIFXnL}Z1Dd3M^lZ8IrxTTnR z#ilT9DBbo@HvoI;7CmcdQMz1iN7TOmE7EznI`s&_%ERLr+z11sRSCnQxoyEu1Rfdd3^*Pac zcXJqBaVR(z9VW6;H7q#C4*#JGPaI1WITfmgpPX;3$@U+u!?llXfp7H|(AHQN@$FfB zZL1}aB^XLKfU>(g__P_HiaIIeDgDVzmMGUEf>L+q=+>wjitCW_2%j6Fl19$|B)*R*io1%~E*CG^l) zGD1a?X9~DFuCCgFVrQzkq1m#1K%63LM2HVIakSXy+HP^Y*5kAL$R}9P1cSAfoZGgo9cTAQbJ6vlDDXu#xkBrRIKT+38)=H5P;}`_w)D$~;75MyF zxfGxxSBkPG0mmg3;kha5G32f^lAjBueo`t#MnnpS1}zyKHLm{KY?};n^|CASSjQRenx!XT53VPV;s4+aBTND=t82 zP`l69U}ho1jL71gybx6f6y1Lw+mb=DA@Ao7eeM^@Ww*EHy^iWf232lGzZ_pGs#fLV zOE8Oi3}D~BEbr6wJ|Wy7x)1-uz{&VuIipNW%>PT}nAZ4NSN>m>J+g}0}IPPA8yM`~}h zP`OVJIi>Wh)@{D^Msx@zm7Fu~Iu>b`h)$!X;q3ZW>0?{T0pGfHQ<~D~{&ZWH63x#) z!LV$@^!a{!mw1?!c>(BWS@~}(#`j%!ru@2?iAIHNqcY1xyS>>&YqbT})r(fyn_yMt z=8cQ4+#|1~ZFl>IN1>4M-OdjGhtii}isjeFh{57uH?lL|`VP zxGG;*N|{$tmaCK$b9uF&&I9ZlY`}zco!4r2?nw~)#pEKJy+8go^JwkGzrMa~te189 zhe7q#gnl@M%b<^MbELLb?sUU->aI|ON-;jxSdhbEyT#1#Y|V9FYFKE?q|M4}i`eeL zp=xu$s+6c(dblVdhsW)qSFqj@xiV5To*vROF&Dm&%voT~Y5aYj$60=_Fg$74vg2)f;UF;dPqxJ2B-A&!0yK(NZx65H`&x6F6FmnaywE6k;&kx#5QoL#E&9z@@)lfPywH@CQfWupq}#5vX_LCn*!^y$z1e zxN%Nzql-1xv|HVwI|7$1KBBsN{7IaV30j=(Sd@JA=5g7uq_eQ*GaJky=@g7Ltj~i` z19+8#lOwg8xpY6zlJwlKvkDFto_J$$>G7sKb9E0bEz>2Y257{_ewvxuff;VN3ZeE! z?~ABzwrY4W@B~sG^&j_uPZzjhv;>wq$p3L?E5v)*(q7fLeLRs~(*kZcn;i{L*t4pe z>wQ;>3bEJ@;n#F;}DX| z5ya#pygl+xy_X5!b~65uGzrqfs|LX(Aa6e`yNtN9Bx+&T#vt8bf2S5~(e-bk!3@1i z!u%)|DajncrY>hZ^`V3|zxxA&mQ3V#kMW&bb-&H)8a$hT38VF|F1fA&gexE`;5~%k z8~5^Q{{q%UPq@v`4Es*pdJhAFO|B`HN!gCN9URRM89cG+#}fEY5C@d-78UnT&?Zuf zrGLqH(ezViBY5IkCe+e+j7c$b?NB)qhJbl%zy?Y=_&@{rg`BZZLkFxNv?IKPh5#9* znUp!C;9`7!zSb{DqTi{54Kn_yL&;A>kkE-D@^~lJ0UGW4O0uvAa#&3L4AWCI2D&mC z8T@2UPHh=5b`T-_L*?RFZIkq%{W7Qq&^71x2kYCqP!KnLJ0a-t39fVz%g88mw94{% za*a~-tq0Is;*TjV4S*WC-v?9Y%B%PSs&1OwlsQ+)1NhqtD<`|7rm428fN{^EngV=D5D!x#(m zuBTbuw9|vTkt;Bfx$o`A`1A)DHka-+{a0w=8L8vIhtF9Zx*ueT%WDo?OZKyH2CH9x z)@(v=|1bAxlMf_{5HsbpGsvOyNLa@HA>G+nFzk1wD$8c2W4ALl`<{kBLXZi48gcI) zx$%~Y*<{_S%vkpj;@CkFix*m`Ko7qq@hv!HqBQ=l%_``EHI#f0ejW;QEyROX0zEis zr2psW)r@~g+AW_^|Ce&8a;UR3iN?hQyfk=_T#_e*; z5h&cVbKv2i8}c6C#NbFtCbU{pRPqS=WV(OJC&`<@zX@c-{?W^%? z>0r_XH-sQd1|4=zIk}l=x;U!?aB(`b&^P&eJ~ut@a^6(K{}bJsDU0h=3P^Uh(kP` z10F*HiPa|tO)xF=TA^F@$`j^6b@E-l{w^ddnLm+9FlNkbVVFd)PSEr$6@rInxckGe zM`xwypxiP+=uIs%jSgvcOD(uaqJ(LG%8;&CIeS8aE^*Z#EM#;z;3`gb_;jg1h$ju- zuw5zR0K#vs9z3E!pbLy8X4vFGc1b)SxqcHTo~cwTrUS_|e`=>d`e0iBl8t>wHmKDx z9m({K13Nmg2Aoa9z9S*@C~KOrbm;487JaI>sWjdgUV=>2~Ahv=uc6ux%TNcphogH z&kyR`Ea?e#!cEgcyNfP9{4N!A=X?at^Zi)t1;*bxbNEkF(0?ViGPANX|Nnu!)) zvMAbk#ete0TJx)ql8w|$C0poVuVW+k4{^};dcnJ^Oj48PZN0_VGJdoDO$-N}QSZRe7eo3KB$ zt;5%jmhU*Wk?WG%fO;(rW-Uo_Z$1|0E|SWFwPyGJsP<1Lz0AYAgbjj@*SW{9`Fxjx z9#49;O2kk}I`%3WYVyZ$6oz5@r*1W?6H*k?DWWG+cCGTi2ZLKVvpU}qp_V1(?@M9e zGAwDP*5?OHm!H;)jm8eVwy88ilJDxdqQ8JphOpB~; zv^*Miqw4e;4jFZ3(ioHvB)tPobV9WO1|2822ioZui#zbuK;rh@cDz6BI9t_JuJ-*d zjB$fVI3o4jY-#1$AB!Vy_s~UuLP@TEMi=_dS0*l;gCryNX>;wFD7&&@w++u`X?vgZ zX1N|jz0-y6Shb2XvNsz?wz*6w{3h-=_KLua_V0f)g9DXe4H#B9pNrh&kV|@7SIVc2z6^$0DKD4 zyN~fGWLRliZfy_mPc2o(2s3F&WUSOKn5~mFm|`%N-^cGuZ@oRl@6g2=tdA3YrzeZe zV$zhFmvJMr|HPDriazgS1DOe$AvK_t zM#jEN##tkU{!B5szpE|gStB6TB7YU6v}QLSARXcVEumHy2ZYvfF3?I%Gbz?rvhxyzNt-hXUh%E+__2hNHJChJAN5M}!> zT9COW(5gFxu8Kwcu71d!HI{Y(KRVI&N;mh){o<|8DE|=FGkXOkN=T8Nc6l*fI!Zkq zBrk}GdYK32$SQQd90z11Qm*YOxtb^LxyI(yuA3w}MB;ga{^}Y86xnlFzQcbt?pgm> z^F78ZtCJakV=Xx+vtn9Lvcn;5NZvrgHXU@6*3l;gpDx-DAmy?fHV=X1altf@h>uJ;lWLHxV{~2Nx+vJINbvwiYuNBr zA4z+A9*h?&!Z1KLR671)mu_ZFJBn+Sl^`A*qT|i)wretqQUX&yU`D6ROr&rgaoClv z=n--4`vP>)QXDjz6F3j^xfDJ(bAUCzePNnQLtOryp73f?@!vg9PDhZ%lZ~!xW8eyI z`kwPYhqo4OGAtmkin8f%q2(jKrKarg?U4P_lgUu%I|%I&f~LSH^;E;K81s1YBYk^W zo5d>Y3DF>9OAdMbChaMv%{8muNJvA<_>MM5QJj&4{?BUk%mVTaRY%Oi;id388)=e+ zM?h?APV1p7o_dz&Wc~?t;gG0ow4w6fTUYikkK9{gbghHkST{a<4X(pVWQl*JVQ%Z7 zga~n8mTE_)^ueD{$-{Z&r}}p-IGUZ&0;@Wgd(ag}3_$iGP;YNfjt0%bUWE|(jTv*K z!-+IY!;u=tKb`jWnhguY!oj30SoQ$50VfvqEINa560hlCd#-r0XorY1)$O@>-2Rg- z>-qWcO-JE?*q-tO-huE&RGwhGV;I(T>VYr>O znHTro8U~4S{lxd!niIYehO@ndSo~UCh@s^!Z-L6i}F0o83zxWOHyDG*|T0 z6PmX8ILdG@ga;NzzV7xZ3qE%!s6S68l;;D0X{yPozHO6i)cuAR zD$F>_n=3e&$i#TH&6HW6UOHn==$!{j{%4u3Q?9;YJk4K|Zk4508^m=h5fXl9_o$Tn z^L$uTKN4EkmuCF_)QIt?XZ-#^54N#0Nwr!~H1z%@dy~PtM6$!y?oSO2C3ma9vJ+9Vt<^XxO{{<)J<)S>kdK3w#TxD-rhwRWGBAXOw$ zGn6z>uI({8v=`eA;Yg@fNv1(>A0TR71c~poE`~?uLWxjN90PE#B^qV^p@tS-F&w6r zDoYRl8KAV(C58XGD^8D)(TE#;G#zB3QUA)2e}XdwQvo%fWZl$Tih{?W%eh=EGUQu*tpI&Ihpgp2ce%C@V2TY7AG&;fJp!(Mq?NWG?j6T;gc# zo;H+GyQAigtYNr}LZ(|_O-3bU)n|ZdhD(SMj=Ve+BV=Ru#{wqbnlDQ;klQ?m&P}}t zrirEyt;ii9BSan#FCNinnt9i zgXVgxj*Hx@P2coghT@I71+pjp2x^xPrW^t>WQ+d81=*Lu0VqPvCOv&65N7Ajxdn?7 zAoxXq)>{XoGoEKy!<%WcRm)@HFOrvEbTVT|ZVu8m z1Z`s8p&5&c&g6GVp7kfRB5=`!!>>&BO{w+*;TF~YyEz8f0LmT%WwpuooJF~$oUIm^ z)U~taF^rYrlIjt?rwG`NR*B96&1C+V*80~>=0!7QL5OtrEpM{KutqxgEpCO%^_`3f zjE6hNSGB;=-B}JF&G8xe(h5W6i(?LWi_0U_+>Kp4UVoyp#%1HaK6R5Rt6ye)baF#* z6Sg1mjw@X+8|F_1*6NZ6NWk=d5}r3`%||EW-&f?`aY&7Bx>%b-zLvQj$TPZY$*kYg zSIzr!=B1NIq@>3{e;wOv)m*aEJrxHosT)fT{;4Sk24`)I@_opg3M%n1{`JiD%guDZ zq)9|Y-hs<_{U<6bj8M1a@lcDx3OTw!Gt*!injY~-kWN^&4hmH9gWQX&UnIK9%Q5RK zlLb7jz_+q#l5=8xv2dwLNf#Fm?Q))g22fB8%TMY>x&$EYDusz*#Bkab*M=c`7wTXDuc61lW z|CuU}-f8-845NhA<-PP!yPC@v!X9CJlwS`R^ZjVCTx)JkW~DQP|Au1uYWfOJM<@(f zxQLnN4NTX07OvZ|POIqq`AZ=_xM>cG{@e{>ek1#pGs1Rgirp|8hlF~MIbJ|X;YCUV zjel#Mi7r`BT{IE=lj4o>LCK3!;N16X&<{B2{nz$?dOQAC{x~xO+y8ny7HewQ9gh7^ zWMhsPJlgY}&oux@vJS>N2l=wgrFK=^cId?6) zP`KE4+l~a~AHDqI?6>{4ujkR;S`sA@7&y?MnjNOyw?X;>To>XhGIURyBH~oZ-Djo7 zo03N{2dLKEOgr~V>?ey)3q0HWL58e>&qI57cAqvL@83Rehfj=Ke$w=OIbp)q&}kOo zL5uc3H_Se**$3giBXyQKHJSGDOQ8-2>Cn`=t8Am~7=5AkNS&-a(KLgiVNtSHV}rNt z(JYLb1Htyif?ou=9fa>X?6$L?P{n+qsr!uDrE{WerA`nH2Q645J!j95T6im4EVKM? z8tgKGo(|aJ+UdhlFn&s*B%%jX1__oeYJyG3^$5|G>Ot6vnXGypH?w&pqJMN`r8W=? zwY`~VUxWa-Tv%A#F>QE@&YNE-CJi|AZ_aDrL-bellF61Ub2Hw6-thEx;ul zNE1brCD+auak)OTx%@T0dPwEj8oaf^;2QSz8|oplm4i|oQdNuXCcSSqkF${wP^01S z+put{GXuy3U7j7YpAH{Dw18B8KsMwYXNX(hV?lXL+M>m-8@GJH$t~ICsh17^1hSPn z@?U$tx(aRD{Jr&jjPe-J!CRIoyC}u|I)QRQsu|>Ic`Dp$v}*nq8p#l5;p7_=6?ACZ zYJ$VZHeR=|>u~Pu4PLf}COg00zxbPzzC?SXfvmlJp{uSsp0e+&mTc1f3mMePJrRm( zuzh2q^~~Q+KD#rBl1MO^pr9c(%u*3-OszCFe-y-u>ek{=q*Qj=W4K$}LhAY5xEY}K zl^@K^ea~lEOAQB*!C_#uHsNN)1v(i*L055SNW3$6UsZrQ7+UUKnV)9%J={)tV;3_~NWLLnX>s_>GA7CJwlCkQos_ygg81k}^Oc{s6tn7pX znUYi|v5W&X5A^dt=noW(X*W^0Ge3ug3#L{tfsg!V7_?5X_5`L+nQy&SL?KnV1oJN= zB7{bohB*LK5z$dl*^Pip z_r?9|G#`}i1a~u$Lq&NU)#HTwEy)TD6hWur~mO|2N9;W_6-I)U>Bm|zyrNbN@H7FAX|51%sq zM0v}7EGVOtMbUsdLhQ1of=w+*GC*JXhwT_Fou@?s-Fk(lqLB>9n_20~gM^mIim&>; zkCGK~!Aatd3KJYtn>vZmoRB=PBi2?Txo zw$X$sj_85=#Oy(KgwQt3sH?|FK3+Q|`7e<3*XhHQWF#j(EhBk+@KS4v1qCp)maV*h zEyZ73J9z4iPi&_1Uud8owsP50+#y5wtXKONdqBe-H=4aX25%85e4g#=P=N_B~U|B-4I2m zate=m;L?0TS4lYC+fZL%PnNGiOaiuA*ccJv#+NtkOCWbb=%hFN9jcoAf;}Bec~Dn5 zmatn`;W9*1&UB$&pboL-cweCp+f~>Z@%IDt`@BvZQ0G z+9SbJ4m3#+&OdzZcAI7NHrNox_AQ%QmPrb1CvkDib#+Js0cRzCT9Y(R*N!sG3inYk z{QhnO&j}<2whfH-HuA!xGx+s#nLVJ_nts98JUXjm%^zyD8mf0I`I0j1i9jQws8CQe zsv@NaZGfRkV4r^T6BmPiqWcQ^5^!0>KipG8iDxbY@10nIBHJ5ws)(hF>@vTY3H!nf zCv~gw@V$s#_4tsbKDV!gbG1%Z_Z zPUAdbii!tPKyHT@;Vj^ZiZ8>BzAd+i5S1AJxaldBq&X0lLP#zpEVkX?>Iksgg1QmwL%jh?$jA zQ4jNK(sM8q(^0(<2Ll?N&TIyuuIaP_2(!(FNOIKj_CNyK?q8WB?#*FxzyFo*3y=25 zZMq5r&d$KCN49i*f{~8kPVWr+Ye=f(;VE5Msk~*IRU4(W};Cesi2oawEbnZAsESAdr>DYyRLFD z3BBo4xsM6dqX0N3Y|`aQFcHbk!vwSb$00)qPPqE}BwZ(Wu(jb4k9kQMy41dIfZS+; za=4`&hQf6Da2Z)$*3fmhW$GPMMSr}Tya8xApcikMPz~f6SSucAl;&sz=$AUS9BouN zqYzvS-Y{!fKXWAn15FR)^G_QgsQQBvL|wiq)z4S$KZVlP;7YOsuC`YhIqYe|EX(O z6RN(qHBg?{iGmaf?-+Q4gZO14b>A+kyssH>+U+3DLteLk?6&W0FSU(S=7So4W22pvtCwrZe$)%bkPI zvffV*Bb7-37$VTmJ~RGJM!eGWb1~T(I=MpBzvj6#8tmzg-iF}m*%uvPa}yqnV7{PQ zsSxVd+mem7WHxL*6pGM1jt7atE4>Hr-M*C`PKh7`Qu8ccP)+mevWkt_RXM4UAmE=7nn!7fE_FZ^ym>Y)h8UK?$_xwIbEpnh?(>=lo zcCYYnrG1PQPlEbcfim5GYllVKtS2X+vR%t%mryEhyr#cHhDXcgmwy`nIt^nRZDD{{ zRHr(m|5i8m`7+CEu+2<9$N>gxXo=ci0FPG{fnvHBydxq?4Y~S02c;ZZ3>HTrz$;Ud zJ{vMtg@H+Aep6g~3Ef1lYMM;R;J#o0`DZ2aN6HOC?Qq?+PMu4;gu(LvFm_Jep+HNv zj&0kvZQHh!9otTJY}>YN+uX5j`=;+x_Za8l{D(Da&8nI;KeI}V>4VSy!${CwK;qy0 z5lmQ9Y-~r$)0g4Oe1n^1`BDP;DHRjO^nVgq1-^SN(&JD(q1{iHaQDQ4t=Nrm#eHW&Q83)2r8^gba>XU8$X7M77t zmQB$7pDfKjIuaa>K_mBz6dEpDV&3CYJ@#K-$l+KY1YEflG$<#SQ>BiE_J&d1QtJ%_ zR^?=M25=!72e#z>>MNYg!1xCGLOEk*2qQ*gl9VvV#S=xhM}J{+)Y1_A3CGE@ARx*z z*!lge;7hx~kqU*tEWP0x|BS*G2v@UaPi-@`#MnS`#5-fl_gB`SHP@cCNl{S5c+I+bkrQZ zHy@cjNBAA|`svwW5U3;Hqj6!={fsH6JpD$?!`F;v<^PB7f$6`(?l3a5{hz3fVfEkc zfeqo86^Jkwn(U8CjMq^o5YVkuqya*^;#2WKFzHNNMcZDGG$i2X9g4G%g0ntSvV{go zkbwhdew?}Zu~?`F;n1qH`4Z_F9*KYBH$41d)@ftejrLtCb!Gn|j2uk!FzHKu;a}`) z-nPAYzqd#@%{(Bo|Cfjy6ZN>d*B3$vD}3|hS&FFx2^n$JJ~2LP3-@7@rB;{Xp7}DHw$406@8og)HCAV6?q44S)|0^7;0^FH55skWm-b$6 zDXnQ>t3dnxiT>w9NYL7@bmsB|8(z|W##az-N0%0(elCWHu zdz|b=kom!gfR-)Kh4~mk)Sh#zbhqDxcAs28Y z#H{Rq+ezGkbVgLWvDj_6-++P>R&KPzk^tfLwDpAOzaB z4wKOR z(e63OXwZmRRP~iUie0~dFX0RoSy|^tcE7c)xu!5ff_scI&^0)CXK&r3U5h+K zl;lDsUlDXGd+1otl3XE)X&ieB^ECbn@D}I!<3+;nvBtM=*ie;&$|7h#WP_0abC0MW zsCor?fl5)#5|xhTv7O_eHYgx6s^d6qVst?O%p{_pvLl+K45V|JQ>I>Fg6^|$hG#0ow)yVM%cGI}4Ubwb#L8 ztp{#~b^W?AMQ=QJ3eg0QgsiYLVIJ4j!rh$x^PBIZ!v_l{`Pa&t$^ol7$I=bdv){Hm zSy$B;b?yOhX{hHc&sxo}bw^TsExPR1Mx5(5fzw%BSm@m1_`7o+kQ=WHANMv0-8;*p z*ZYM%{wnb4Kh@^{ide?T$?<=@k=2^NF-UEwzqR>R+myx39eteulmLh%wbtyK=+ zL|YlUo>V*`QDz>$H2hc1@&&y2 zFh%`R!}8W(L^>++kW^#G#t*fZAH|H%dd=@#N9M<+J6_2Q->~?!vPAFa;~JlO9A#bz z*w9TtVNYG(55c$sn~-(9SkI=2G(@uZMG1ehM%xZ0b=^nJ*OfV0)yHFCJ$GlT)?r0= zV1Zpj@ZM8uTamRA_F#zVs2rY~Jkb97?-l}`eI`t2nsVjQW2Z1A+qmlUTvKMj2Fug2h6`_vODe65MhiDuY7NXIxmXFoAGkn*qgYn!Ql1NV zhej+rG=j*9ARoI|QVT0l0i(?;(mjv3!(?M)aci=aaY{q)Au`cSWuj;puMk>frkRL% zpZVf22F?ZZ)urD%Ay?jvy!(7r*Xz`=4A!x4(`ngbVT2xZN?^vi;$r4hBbFjP44Z-lT9*(0e ztk7H93ggh+?CFDV6&($!C4(5vLT&x4KoggQID&S?)g_MlqKJ?=2md1>Q-03=k8m{< z;}KZ_UlGMj^M{AW}(~tZ7HXN_dfIHVN z5z)dQgdpBfUALj-O0K^7~88qQ9f zl=ag4J8BBB_p447+~t&^F`M&rPcw}oT>**W4qO>gn&ypBQ6}B>5fx;XQ7jQzXNl&~ zBPZ<~MyJjRQT;X5Wsc`isw(H$X6h=RyXj2H=qcyLr2OIVqwT^XjZ5AUo(=E5`Iwj- zF3+Xlysm4VMwlaXrW=*zFxSt4RbkCSa7K5-vl8&Jc9y+?>@wzp|;VYPxEq!%|3xR6|>OxFwLdR4!shZ*^UEZgk{&{xIc zkT--mCMeBqqbFQF?-(@$U8L zfIqj}Q((-2tH(3#ak=o*n=)prWVGW^cNN~F+xO7*`JFHf#ntnRLYEx-PWF}oOrb|^ zTi8E4-)R*A_5?%U0yGMuCPgbC=zMltI4@Q^u`Se}wgQU_+qvuKJp!}nDUp<6Di7&F zhbGVPRFFmrJ+2#G=gdyS63Jh8{e_R76rj zJ&f`n*jqza$bUk7l5{opCKK;DOzW;bD7O)+dunlpIvqBVo(8HxV=4);PV5zAG!>&g+uPk&92e$+pa87liCI>5G|82mz`7ASh`~(01 zA-d8_FOz$SzB8YS_nysOsHbTKA^@qVK@tgB@_ZO_-W17o@bf6s$Q*D@mP`x^vY^Ic z1A-J5g&a17NpnDE@LI@c5JqV+<*@V}9s>+S+;6tyM1Psgf^N<#7>#y66V6)>NS>x`^9gX}EOzjekt-4^=}4Z`PNsaR<;0!W!M30Ilzpi)WsI-&Qbvr zyilE7%$@x{ur_7!qWjd1>ZqB)1OZJwW87Jurs+Qu`TdHdeIp~8DeC^H8vgBqk@p^=jrTu-+pq?JJ_BJ-R)1JOCd#2FUD zXtgDq=O=d%yX@_cG!@Q3F&xy^l~|VB1_<;wLyL@)Fb^lMyf!;X(lrGi$$>_5mT z8T){nDHxIvQymu7>3=w+%Liev(-Vx0ABf>vVPRX zRr(K1wTXs-$YI{GV@k^bK#IR!=`*f(vHU*Ha%=8Vzn#yytt0nGUA-L&{jOTMOCrB6 z#+|j*P!o$gpiSHg$TFa$yM~8lP!<~g9f(9Pv%rw`pPv1gwelNTLRh7Ith4LZ6xOWl$3@;LLXTU9S8-^|0tuC64x!5LK5mMd%U}{m9D#ap$JtvRCjw_70nDRUvzsyZ_!>f=R7@%k*NYZ2F#u;#k4KOftBbF+5$rnA)Fs zxo=^!JD!6d3^Br!s(!F#aYxk~-IQYQrz^5_AhoUgD3M7{?-r#IBxvVEC=5UpZ)B@f zy?$#4y^ANSH=N>c(T_D-jp#Pwzt8(&>F)_}US6zq#Rx)r*E1XRQ|)RZ4&&B_?ytS% zsf|}L)e}a3IUQ&R@U`G)r5ialk=0|D=3nIutd6#DU&@)`WRfGFIcIb7S>v~;;q1<$ z>f@Z{yLI75wB~0|*_!dT`bYnfi=Su*OD5}>IgRD~+S1<1P<`HvnpH<>VfgEqU&+nF zs9KYbu_inIYRw+68B$jT5$jZqW5A#Xw=0N@7l|C)&18QuMtt#(VqJRgw4VfusgSD_ z;KO`erXcBlWq#RzP`c;B-~Kho2|H~217bNhPE;b8tDC1#*$p)aMhK)_Jp!_Jx;yRM9iN+I!H?(dqQ z{%uV+)rnRSv!hWb();A6$p5ZRQ4hswX1Tp@o)2Bx!ltN=TL0t|t(0u04QZJK_Jnf1C$oCN;-3@3B^uJQ!g^}xOF)hdIR&das(v&5i- z9Z%lcK4`CzuM`Zizr3jc!RAn@ctzxo2kR~s6rF%yqGZ1ROTehHAJ4Oev|U&VXS0;j zvLUO?-`%AR6QIxGuHJq*Q%#%(+X_pL8Gm9kd*9PFHVeNbu;wOk_RDBhaO0=OZ7qhc zndWL_j@G0s2-JeQgZpdb06V`iLFw=w87a;6@!aXIBPReDBW>P4VLAE=;&nT;Q0zF4 zOZ@<#&?}u%S?Wbdg1Obmt72CZVpsF^%yq`WG}Fb6;MSj~1*{eLorTOIPL>S}TGB+u zB^I;R28vl$g;b~KW1_f!b(VM#*YaAI2hdka}=}} z%?H5)B6sIPE=WxN*cFukl(twXRR~L@%4uv(8C>d0@$o6>CZ?Mz3EI zKe*EL^)>)!DK5TuEz7!>zG^X3;w00P{sOF}DB&wnrDrILc+t0$0F6dE>73MIvfW$S?wQ zRsCqb`HG#(C+1hotn+&fv&nWK2eLZ$<*2MGl>14$`8xqIH^GTd6AP^K`cdOZ@l zHoHX!mcu)!jSl1&UiW_iDPRue_oU(ImXWyL@_2E-BPGQwa4%5ertr#7GzB&<#Z-d%}zxQz8`z z>@FIp!}qa#yY8@fdEGb+0C6Qc#f(!?4-k=#2Y^J0amxt;PdLYlQ&3ub2a;GpibyE? z)rb8^82xw|MBiqHB7>eKcKZ-`bEHuOs^G+H4Gc!uvDd4E5Nya8^+0+95G1_joUznT zCg}wbu3M}WEJ`T-z8t>Rqr;5B_KKmMDkKZ=L6|)qj22fA$uV9abu^xvjCyVc=k!4I2!l>(fhmf~0rxw-|OR4a;QPciC`Za#6Z9RY-6D<~9im5?aP zmSNcZ&9xnC?Hjnm};^jQP(egnLvuM zl5D2>By@Jpn~}dKab^bz2}M=wqjv2>`#pxEBt--fw6;FiT`Pz#ZR_&XFCr@OQsqRb|45&5kDQdm?LN^q{J>&>$#gtG!A36!6oSB6M^Cx{Zj{?F|FK-Ow;jv_;(4Ew#ct`W z_<5tOcl1iCV_P9>=$rj0E4KXkr|VVzx_SrhC(4p3ja^X^Z)%4(N1u zMRer*ntG#aJ;S(T`P829y~x#Ya;rK3P}ScU$%Q z?j_fRCU{@OvV%ZW@GDY(f{uqRJ{dI_%`8547I(6fbWwBpfQcZVAJ0J-Z)I!iLpq~b z8>eQX+3Sjp6v{M%0&{$U|B9cUw5v-xd@1m8}-BH7HPFi5=JW6}82E{TC2v@3t!zZl1U zZPgh|Dp`mn->($KJ6I)Bv!Ug5uh;`995x~#@TwJK*B_R^5H$Uq%!&md7}0!AQ0$k@ z9Ex%18NEoQ00Mn@vwwwzzy>1o@N7;Q*#E%Gw#6ZjlFsW3cxt~VoY2gh#r-+2|6cwC zPo=bMY>>)#T^6Y%tlKbq0qIeKVX7ERthl7+3F_#}jM5B~(I5sIt)XI% zLjs}BUmjCFl2uprk^nAgAimexV&B2NvsM4{)pw)gQR=_)fV`XPqHPjCmj9=RSiG-w z2=oy&(dR<8f??ENs}LPl#KRtogBqpqF~Gocsdye)xSa2s6+l%1YiMkrJ5kx>Ke))L zDuO~pB7zB{>pD)Va~hlGdb@Ta8!tjEd`Q`v$zX@{XsE^oa$(x6C1Y)1EF7Fw!8A%A zg<(UlJ%LU{tmZ%2ma=ZHAEx4t_}SE7xiWk?uBb)e-j`jkHr$HEV?=pjoBCn@yz8yo zL78I@b`zh3rvwC1Z>LandGBu=AtcLq6qxCi>#3j+a2QBc$|gra21?MT1`F3oS7yQX z259xuS*)@ig)QPF*w7cmK*V1w&5OHv6RS zzJBmk!V9(rlw+tfB*_DDp`n1@C<@$UZREf71j?-Bf^!Or$afyb?I`EbzUF$Ubh6+Uk*jhZS|UXUVk0i_DF!LK@5UyfSVVdj)oSL zud^NcS=&)_RmTo_XkX%wsF?5NeNUxQj$tC8?F@0=xI5{Pt^$Eo<{@jX6WaR(tFVnz z$v`0Cqek(=&Wh16UP%gQke)?$B0#Vr2LVEd8&DQ6P{oNDMiD_7P^1KP-%$6=wC$f~ zXe{+N4-oSB6^Lm&2D8`op(dW?{k_SQQMXT(i>U;bo!8P)*;sqC=y%WnAv-JN*T>cB zQ9!n}E~C`8h32`Rsv{sWZ4dc~EOY_w1gl_GL_15W<3-1~c6gB{y=!@!4p&qwRCk^x z-3Hl(#W1}iMi-#1Oc#K8+z#RiiNU%cl4j#9|h2%!PbV8vZf*X zkcMS}4u#8=5bC_6LTd{cjd?=IgvHm`(G2lJCeqQB&-7T-$CudN&L1AiiEv$QlRdzHV#j7* z2@Rx4>|p5+>e8A4)OtjLoE!zQpRXEhI78-@$Y_dqIkLYRX~_e^Pc%+<)-7OUDvyqx zV$aKZ%A+I{#~JOPI_#jsU%286z4WXX6=DurL!ehx))1Mn?fy0PI=x%+Qwm_-L3amZ z^Q;cEit?@-bKg<(2l0&5sj+_R#R6 zi%k!pg8FiKWD>2a5 z(^YxT5N3R%hVQ3+^z(W9u*3iPWGuI%OTRTskFLNL@{{X3(8~9AgKV#4)9NqCzbm@c z*3|#dv!zZUktHme6|nj}DB5%N&u1H-8(fKE!KLMWW7*D~5r==bU(&1F8=ZuPY(Q6d z8}HvW2L*QI!_4%nt;*Hsu(lIH7TTP&_ie1V4z2IkZ=^FF=JMo!5NXW+9S((=<^S#h zHMH$E|G!8}6PLX(9EudF7ln4-kX?-==p(ZIm^%xq%C~VDT`(yMUlsNH%o!AxDv%-1 z6pil_j%XcpdYf@;du!YKWuV_hqx}y9JvP(Mmd$QE0(Lfi9Cl}O)5g7dF9B24#un~p z!bH#Z$LHbeHMml32_71G=J zjR5=Lz8Tx&p)DqkCW8uEg)nuyP`zfS+yL1x1)0D|c((hpdh^K>12t(#WHXjNQ#t)V z|I)Yu(+r42(-vy+*meLF$!x|uL~qB~cRg#~sFU^%9<8t9y31;ejgR$@cC5_~?04Fj zl)EG>Qhdz!8-UhU`KC#8ZdFQRvca%PC$W~0`PcX?O@TI5UBfN&&HID#xpjUz*h`+| zl>qoguC){9)gDyGfXP8n@r}5hdsp?o$MYX;l)V<;KR(Y+c3Vr|fqZ|RvYn=xccrme zjK7lVOEHCiEV8S(mHlZC7er6T4u+Z1sQZ=iF8wpmJV%cp@cUE3lLm=3N?3(2mNo|m zKZ8?uiB>F#8KtQQ6Pl4D!uukQWf${gnm6si(A+6Z_1QOKu(F$O1I{i%;fh{DOYgoFhO}HHkKtw^T!6 zk6ic=^hoqQks*fgdwaJ*Tm_Q6$eEKRH=}sdkz6fIR0z&3)+n@kl_{Ap)kYsNV z?3x<)sq7!rp<^b9hloBR@KIH05w``}tL~({XQbuQ#diLHi4g!+)$t@W=}X?V&UZ%~ z#_uLK4gjOe6cdpAezAi%q%8w5-49`<9aLt~FiH>)MH9Q$! z^|}WTK{ODliYU8`XfXL)=mHE2+i#fT0?A`Om9-(g2}g+uMz4d9D_|Rc49J0U75!L|5n zFTO&3eO8={hh#}~bkXnC_rhm-Jjg_W&P<{!U{ zsi!e{_8|x;RDA6$gpn}<;BA%l4Ss3}XQemZM5 z@!)!85EvE6{&UrU;JO&^k*wPEYmVmR-4jR$_=`Ks>OKVZuC4zNEAAEN)t_V zaegugC8@Kw>Ix2%8|(>#q|if<3PG`JpN5zR)AZN`>Uw&b+5{gB${5)5{2S1nd|aB+ zboL&P`Dcp;;yAe=!-L9}_aIKeGPwg639RR6r-$HCP!)3L4jY8FCxk5 zBhn)669%@@nPMfu8_ZDza}??F_)~vE^orRf(3O-Zx==SD=8Mmx6sjyj$MXTtA4jkY zAz~LvOJaU=7XK`?vpNq%V|B)pIrqpO2KUUaj}|$O-gM0#xCWDf&F#0e-S*Kru#%r zmSAxg(^;z5y?CzUnm`@@tj+K|zuK;&aj+p+`+hP)lU01?gh41y~Nd3c+N`OuC zm+n=KHBJvw04M&owt;_!oH~^Es~6ltModi;CkrNdfG3c*ykg(4q+WXLz0}gkebWl8 zL5W;e@GJCfg-LZBp4k_-+BZiRcZ%cYO>s3RogaO9FM{2kFP%a?e@&exWTTBd%K2xt z`X?Nz4#K4t7>6)f;o))C5c%#7%ttZy+>Ds6wi@vXrApiVau$($G0Mc{b0c|)R?6R~ ztDHvrn;If??l0QNMQA3Sl&rYw@`q4aBq^~b=A_zp*4m9{#;YC1^ zI-Npvg5*dX{_QH;N8x@ViMG<#UjWRtJ?qQN^>|}1s_-IA1jCm^3FX^frKT{~d_HrQ zg$Uz_gM8i^GoFSB=7=ZKERz2qR(;rPPB(#R#ORGplJn#aU4t^D!X}~DtXC`xf+QWp zpfSMERDH)g1zu4(MUsRhRw;)#-;vrY-CglnAxQ~3m1rUuIZ`qKipuC5tYt%77!`@K zFhD{iZIPjKVaC~~bh4Utov%fj9qyVpHqs+ufyNfOVm}ka%r$$&IC@i(|X;;S`vUfl>{DtfwOwzT^@EZ5V^tS)P5gma(PUzM#%Y%`g z6{XUnv#k}V{{yjP-c4Amb!2>|O%8se1~d1(;>FA>v0L>>?uximz4~P&%-bG-x+L?j z--++`*3d0}P%mvcgn5{QJ;`5bK^(p|JVgRuIXZ0%fX0|DX0a1(*{+=mchsFlF zmhK!A&yXl;l-q30UALR8bph?Qy%{Z5=sdBToPQ0QuC`hpKaYK)TS-`&ut1a*aD~^r zlL01!s=MPaIl!YB47R(4vpcbZZ;XBEWMjT=oZVh{dZz?jUU0XG9JdsEhZMvk-F+NH zvlHx7u=jDBDnudU>xdgDx{9kEe0cSG@T+jExoRMxWUpiCpqm~JGx3nFZneMMR*?`EI{_+^wAJx>6&Yn?MvCVpC5a^g&(O$nUkY6_^L%Fy|NxA&_)(qL%&jCn<5to}XUQP;zo9*17GdlrB59zw?VeO7G4+gLYgB}1$E+1FcTy@f2y(6akJf^xy?m=k*BTlUM zbAcjw69JP2gv@H=0SRY~Au2M)c&)}+0|69}{jUWhL#(eu;qm7-HEaA- z`` zyL>Hb`>k4c!)9RZyk0!c##667J8|x?yj83F&FQ~dwmQYFzwRU_TsnJQfbXu903$&! zg-{v)vA;iE?TgjzDb!iD)?~xGuj+S7dtJ$kGeD`McrNWlUY&91(6?T>lwm?%N@AG} z?r-Egf7p6eYeAsZL>!UP%#`Jh7SuonQJ=$VvR!;&bJd7h?LI6%yyB7nWhDAbM`qfV zJ^RrU*`4S{JjXIH^>C)-!dMc1NQQEbC=a0DR)5i=Mwu4@Fxr3r;am0(?l^v4gVN(4 z1=Z@$=NzYa-86^OH5yq>r+;eT4a`h8c08E(DwArUJ>O~rX+i@>79h3={iSO@xm|aE z{?YUOAa4j7t*yIoxY`lZ>zW=JmfAR7&t6DP=*+ak;9L=GHdY3Uh!Yz-3veSow8x1* zR1mofx3#&Bg8l%o)asYhauNfbq-oiODlydeF`BM%!(G^?GVDd0q5}_|&e_wMjtjqB zQFLO*U;>`80mJAbDz+@eKFt|9JYJ7g83$0D$_Xrh2rJFhMwV)Hl$wp*>LQ>HGJxgJ zy-C}HF5%kyMg=M?@ygV{xr%|1sSt;|5(cu+cBoh%&etp7t|vpG?8Lz4JFgp=y9e}O z@iv>-JtybWYsW{13oL7R+#X<*GOQ?|gg;iP99&jm1~h}iu&WLcb@Uni3Si!FU+9R7 zO*ff-J8Jpqz?YR4^X7dZ?9i+hXu%Pu-54nb1w~E1f7C}xvFu;c%c(|_iGiQJ`*M0; zHlf{BFx;_oUS{2Ymx1l*pJasW!0LNiDSIp-az) ziA5K-MlMb{f@-i4eN2I~RYaoh_t4Yjf)N47v6wI z*no}80y`;rVFVHLET}agdr>DcBjUJb>oENDI2eCKqMp64ksc_p4iTVLS+tXl0;kI; z&eMsi5TJv#w3ZP&daGxe2_s^c-J@~}WHVUAPEh6QRirb94E{y36X?VD_4Lc$f%Vm` z7>i=jqQcrN(-b2X;{;|WHxokZn!)PoVSkKeTs5V{z=*AU=2G)D;;Mbb_i`+*K> zSOsxq=iKL5+Fl_VKHToi2UjSlt|+D-tdB4982>IBeY+oalLkN67PRM<{I+E(+!hJE znPN}27=N`3G6bc%!xzs^jJEtLH31~F1RLg5UNafv>?0tWADO7lB!eL zaCT8b;tUzHdE(;CF_mVXOj!Y|U1EPg(fB@kTspU1;@?)uM>dM*z73kHb+MmZ&kbji z0T`KU^WEf_-4uopuDAQ`}^HF?}gXU`7ICJ&KGbjN!bPa%A^c z0T?X-D9aOca``zG^ih|cZm%(R6oVjc1y6&H>oIU!OzU)c6d1zJG-Yg0v9&!9)6 z@ZO!6)$m>3V`wqtj?3nsu~>sXFC992#DzJ!5pdg+p;|_W@){GrTQWv6CST+IlVies zbAoLRsS>`4HnKW#mdXYwTZpmYQ{Pl=c0irz<>Giy2}W%&I~W&PX8dz3qBn0ng(1O| z^`HJfOx(w(-rTR->stBMd!jP>M3=(2snTwnAyuTA5Smqn!H#zk+lDI*>5!TcBw!qw zl`P9Tq)&U0>BtoDR*^-5Q5rIT!;a{Th61rsvz9}FUurT!Oq{6z6d@dBk+>IK4Iz0a zAwXuki*@AfB@I9vU#|Rh9T6dR1}{=O>v=@zp)S{oFc?rh0lKru8<`Ye1~{ zN)Ulvop%d`y*&Eew1elb8$f%wy1bzDb?j3zI-Pg+yoD3MbngPP|5gzmj8|P_*5I|d z4+ZO93lt|yS%svoZ!h6jU_mX_&Mbybr=1?ZNX#svDNeMFb+Y_5@LU0pRupB+5)>H$ z;YfUfB?tVJO*b7EGdmh%t$U{-9%Cxli{cYx5eQTo)?-XKTHt1XG^86;D`PTtspvHj$92t!0dE1C+THUd+ z>TvY14W2#;DB4_ILMy9a&vwY!;k3pTaTvD2h``AM@j>}LT;pYH_rZnB0<{}J_W&Gk z6QU}~C(@vDXus`dkYBk&vwg``_11QA?i|Ntu9tF!4AJ517a7#MFL94jF|!*WZ|yEj z3x(#=Q_}C^BTp9#My;bHJagp(L6!mm!=N+K*D3lz$yCWjJ>!7u;RakaWa@Ad&Q8kY z5FR?}1rwhzofT^VAs=|Z$C=gDU>#&KXmTJ-PWEHUalDsf#vLi6Q3P_}^`2HX*ep5T z51#(w@Ur*#{qK2HA)8w@4$x;#>#R&FYA@kqyu;l*v5Vsspq0<|wet4^;ggTvGtd9D z-{5*jY{E&AQH7(EoWHFz%5Tc;+$HTf?WEa7ZB#)@1{LoJ#OE`_7@ii6dB7e@j%`VV z)gotlL~1Q-PQ_0Q&<=AzY$A{X@%?)!1Yo^)mVj};1A0tKHD$%bKMtU7!c}{su})@- z^rzr2)xZ~seh_MvNJ|x20x1pTG34SKvZ2}debYCEYQ3zTkkEK=aKbo}l&9q*7+tk) zN>;O4R3lfsAr|1?Jc3`kTN~m?zFDYmQA>`ry-lNHiU-qfuK((!dLSte?nwp)cpPH0 z35JKNdj{YZBiCL1AS(Wf=1cho7wMhZX3@*A6lG5(U5duh2?;|Mewd=6Fd>Sz>Un+p zVZg?0lMx?sM%HKJCE%)qz-}CAU_W*&%QYy`^ea*H0;rEw$vrq-;li!@V=cU{XBI!h z`pC=yNT5Fhoqqa#ikXbZWSVwBq(L@7>q4H(X5;|Z?LJ+0pEqA7tMVC$8IHO^qnVKz zQ9dp3VsOvl8Hn3X$O)d`r&laLhB7u7wAhZrssp_>*Ki)o-eq&CssEA8xURpP+3{0N zx*MsQJ5m&Jg>I@=IUOOeO{J-h7O93&Ly8Y!5Wv8`n}ISRe<}$J4bsG~8Y|}?76ec_c)%2Nz*OS{z0MNh z{(xhyGSB|>4Vo>i;BJ^JuKxr5NQ^+VJhGO-R(5y|1=B8-S;m~t4Di)YeUv(j=QWjL%7aG?0RN*X>hOugYT?4JOHgdp)FEI~xnu0xd z7=?llz^Suvsg;_LbcDpwNdqA_HqrtmR%wo~0J+xHA&3 z`IV-lwMYB_(;n=fIpd#qv-?Ja-CDf~+&fT(iA~p1{h8TmLk&9EvC{(eE6VxJCT*x! zyZL){zrNglKtr)U3rv|GdbVBRWgUAqZ4Y}87zgN?mZIdZ)LjTlMFAW zqch3am_U=_eGEUfgIN<^DTEgJYEO{)VTj|mJMyM8g&{_J$bEvnM0LYj`qu_Wvm>Akb7)tQ2qTiItbtN-beL_|SgIMsg{mKqwcE5VDc6-#S9_n%HSl z7Ir6*uB-Xr)l1F7(78%Mvoz3z%SllGx`vKQkgNs~o2Q^3fO6&Ef%fS|TImVv@3`ogg|;f=9TE039tJ?%w1fI8FjfUSx0;T%i#6 zqxK0=x{pz6XcWXbT4X(8-A>E$YIGo?P`YiLVyc~*kF%Kw@UNHGpU43;E{iS^LQ0Oy z!L!5%$Td>KUHAVn_D)@b0BMwM+O}=mwr$(CZC2X0ZQHhOTa}r&=Dy78S^dyIA|g&i zoNsU2+;UheQu(iQRhy`!eYan0C{Rn>J96vZa$v_FG6)WlN*&q7OCDiE6d}t7ng( zYL|2COR%Y4;zE`=+|DBVmn@7F@b}|t5y`>90Sthe)qKxcpLroMH}M{~OnQv=of|3F zWUeS}v7~tCd5o7hLHINu%!?@ebSHVtT99a@bJY2}!H{jwQcwsorJt7OC{3;j3slh7 z(yCJfa9t-77MGeCo|x|H?aetQcNp1#ihug14FfZ< zG+|;KMjM`0Qj)vZiAZeDDDB=Efrv;vc|!DI5|6Zi0U7CVs@H;QHQI!i%v{afH;@-v zSiyR%3}smAmvILGg8oVX={;dBpzq$4wjaa`7$ap4#ljehzXTmg&UJ`RSk`MrnNSDn31Ao2iErN(c zOs+4EHBZEg40ct$f~xM_ZKOUiYM!+hH)+i3E)=?!5k}-qff>T|bDs5*K;V%p0Otg$ zAkO}0g)2u_bw5G;1FjkSc8#NF!DAJ59+Z`S`enXAg7X8&d}`VYpg?MJ87H8-21GEL zB{Y^9Mz~-hC$Opm#V!fjAAz);3`?0|x8CmoP-A{6O#;R}B((mJpqStJ7{h6sl{rEa z(ObJA4%{t~-(6BdBSjPVpbT)X&ZY!P3E-DSXR6`aiZm({rUoz)J79xP$5Xv&529W& z7m6iUdoe`*zz2zvxv6ba{Yl*q{I_+4xWd1x16_?=*&&UfEMQg$F44X<+(nOcvf2Bj zA-fv;vS<@hz{nLa-F1+#S|ohQ>vDgDbPk(pr^{?NGMiFQ^Lt0Kd1a>r1HZPms-{K~ zs@eN~yj;>&VL!xeBYUax{}i&s zQgO=h5esr&gF(jcHtJ#Zp`fZ6li>5BzZ6hvSIMr}NzuCOGeLofqq;}L6Culc%0$6% zWd_sL7D;YSst}KdBhsBD*y6zv38F#YuUwSOkC_IACSNwF@*q`((is`#r&T;dDWhgmhkV zz=}1RICv|e=bBNtS@dyq3nMY0@?1a(-boi7@{Mv(RqvcS!s#kCPdGX6gY8M!lQqwL zZ*57V5{7y5;GP~?=d#ACV#Z2Tf5#39IWTd7<-?3KkT@=ShzN6jqa{zdI8JqToOw_m z0MLLiH((0Ku7dX{3&LScC&2^{5gY9KOgtDtW{sOk2AnIkV0?%d2Q( z5W`JbeYI?>ZWC7}<6d4}it^|sNF{Hv(qt>elJcS;?zQi<{U<#j55h##E@X3E!ph~j z(pgDVc=A+MDV``|G`B}-AU`q2PyQXUGR=8-JsnW_*Yge^siEZL-{J3OK0e6`<%9{& z10xU@`6Lg2YG|yP*kyLz)6N*F+@p;y{VokNJ#4bumnxw=@{oc4#>%#oNRK_%|MTnb zPM1eOQ7kSK|E%4k2^BOktZ^sKOu+%L`lX;C92J(x7`ulyheHJKX zc!VAN$h-ib0X5Wz^tUTZ+nf}ZGupMeEL4R@UBYsZSnCW8$vy4OJ?&_7(@)va*B&~V z*C$(!<5$?a(&cKcrL`5E8x{fv0(&DXC>|bqF-sd4 zQzv>c8$%aU5mRG(6H|H_Q#*4P3jz+d|7hZ`sO{NjF(CX4Hv?Pa&F$->2+L(`)}=DG zl{Jwnwj02tW-TD;k3~{%YjX~zp%9BL)_A2Nj~k8rd%o^(m`AhyVI_X+4w0YQVhGq} z(nl6zFgAp9kM#{OusnkObV!W9PuPesah{N^fF}Cos^}2g4Y{ZnP zP{gg6lhsV=9if6G488hQwm)7VO)Z{JCbcsLyp?`0q03^+1(!ro3{?l;EGMcktd+a2 zEY4hZ8!(Jn70Mu<>wtA)zJLfpIF}g4A{0xrc>vFrM{~~$X$_k8OwB^md+MV#YR%Q##}SdaQQeKr|U5@CGe#qd#Ky-JTY3 z_nXAh$V)Gz_eJF$NTW|5D@Zi_O9~C!5eoOPm4OUmY)#x2J(eg8$(HF87&g`v@*fJP zzPK<3S3YmUNgzy+nJf|Y4ez}2O0b_QY^eGG?Y3yhh`dDj`9hl|jx0l}$Xb^wuyYJf zt|bV%lyHL)M3u8#!#rD`j#!SOh_0%u!Wd;~RU=5#1dmhMZ=A*HX2YtvU6YJo8!E8( zdQHG$^~`HMBVSwyLXajI7L6kSea(x(6V~sh^u)`%;^!k1FMo}GzG2J=d{-WQ7PP=B zpW03`140cA7!)wB4b6=Gsf`}8@Kd*`@OTDp?06kCh&U}Y+Dqp2;`x}Jb6F-So9P_O z)8iSkX6n$ZplcE=u^@BZNt+XOX2b@XhSz4C?#u`KBHco^+3Zc5C%{=dLDkK>W3Zdc zkMqZ2I!qR46lSBj1?D_o&+{jt#JK3$7CRKmz)RvOEBs3yVRe?3RlIlqeA%g9Xnf)) z*zs4-$WX?wmVJqxnsU(LDao2sv`S+3c?NRwf{MYZ80;i|y1BJ*>BFrKGxX_d5pDPw z@r-%vkG&$-aS49qK6J-K4Y)i%3sR^+546d_&P6jxZyE%jY)KM%cSv3PYD!$08h+`e zR#Bzde=58^v{LtJxl5|MyOP6A*~2OLS9H@KCEr;7{7TmUXx6!v>t*4)H2!&6Xa78H zDtUO>!OvLKCHrqH^?xGnGI4VJ$A?&rmbCM~S?u03^>c|5F^z6P8@r83HCeg}mF_YQ z@HiRm>J&+O%9-k4-_8dj3Sp)mZdPS9$N&%5w>5qC`VZS7Hk6-+*n|5#yVtp_zCByN z_Y8Xs(p0V14)5)HuOX0z#@%h+zipov^WE8-j$Oz?DxYKjI+&WiVTq^9u-~u#?!Vg- zr4eXYT%+(H#YS_8yA`drPRzd`iau&Ngx3m;nj-1!NI&MP}3LLmT+VbLNJgv&+Ka8-?&BkD4 zL^|#6;BHbXpr(c<$6iZp3!2x%Jd#AW;u{eo)F4Y?fo>&(2mS)~>ReYBM)Nw;gtZ0$Yc? zNNdqqAXI}Ntj-nF(p|Q0@;dpFafAfP+>OzeYyX8(mN~YYnQ}uSxx9n4 zPx>%M7smI!(Y4nbP1?qks1=eD^5}spjt-Rm_TPF{A{VB2GVRy)x=5 z1j*+-DO|utC+wMmZ>?PzJ#z}*maKMd^5&je4tz-HRvTOKJ-D5Q@24lux3b&z!mONq zfasp3CoZe9irlPkj*z(%Auv|P&5*gI$vXt`FFUSeF_ml$HS&f5@%tI}I+#Q(q73G;nCY)g)E84nkAJq5^)l71X|& zT)&kqgZpu%&=U`Ki; zR9*98m!AES-EeZ^L&OClf~c!$8F_9tuA-kpMDr1fTg_Hq%Njg)KW?FsnE@QwK9SFI z43#9O9J!R=KrBwzK~#3s9rex9Mb+UVnoLOg5i|Xy-ouWM{G@$k9`b7U&^g(R1xl=5 zbnC^)%k^s-;C$+gWNojhsu_9UV2t1{$*l5ii~@VhgcW^YvQ>m6;~Bcf96jiqjHOuO zUl~DD0{FjXJMd4Yg%wR?6gIObsp^?iCCGbhoXR0twL^$m^K#JaQb%Tlro3pQlmIRl zBdFr%Cm!CtM#jxuUfD24U&$hdbek z8*y@ZQvsA>*2!B|fCs_(+GF!uv@2@=P%9nza;V{LQZ{GlmJ`o(er|t3X|&!M3e-H9 z3gjB2xM$LJRyx~XR|c`-VV$+L4lorQG<=~(4{lZ9v@V9K>X}*uA=?o}={5n1c|eWS zCN_)8f3&vGus_EV>O{9;Hi&h@gN9LPMznQ+!dm&c7K|M0Ga^xe)+ADt>_$(pBut2N z&HjU9)ne>@ux7dWdEmMt2lzX(?igd7NYOz4QSrCfH6S2l4cIw7WdbDtZ?hQiJf?D{ zaph4^xJ=AYv(iu79CuPX!n4HM9mZ-ROZs zaojim+3RXQ>g1xp&2>(8{6wShFwe(!b~GWsI5)0t@)szJ+}`&f#2Uh)u!~|4FF#jv zc41`0YLzHJ1Gu%BAW@S~7$UbY66Jy{g2t5D;#Sw*B1YCxEGjDL5(TXb0%>iWqHPDCDg^PPyDkBwpP5<;l9w9&HU7?1!CW<+ zB-z-6u~UR3^^*t2@0K?^_Az);r&rPD+?D-i%5eyp zkABBdt+#`91RpHd%i1AO2^rDDL`!RlmAy8h>;QzqK&Tpt_mZ?X^TO`);;u|Hd(PID z+~DZnMf@$xN7se?8J>U)${hS@Ql_!nsSWJddA^1k;?cuwOT-60&vEHgeqxsW0U&fy zw9N2ry@|Adj_Ifdpkm%$3WF)3nn82}As5|$jG(&7lYwC*!*wLX^mOG$=0TGTJw!w@ z`Q20Qk)YBu-W`#2EF!p?H9{DM_$>h8NEK>8F|&7}4OJgNGV>Fy+>sN|UVxc6a^RQ8 z<9s-BaL;d95e2A0(T>w?0TY}6Z#W0efA`h0zzODnc&{39hKqeDKq;nEz{zb8iv2y- zUjQIuGl;nc95o4^{CkbSA=AltR=AjY9$;b`_vo=loS5bY$e8+DCjj%F7DA+;Bp5w2 z4;)W%~u@Rh{FwdjenxNvaSG&u$zU~(HkGq;2AGoG$e2s9G$ft$^M;&*5m zm3|}vrD}gPpoX>txPIU^2CpC)!XRT%KkBwAc(8iX$X1Z>`Ez4p6#0gfEy7WmbiUv9 zCM14z6BBGW+W^~!=&}O}qjicwuH!K~jp&dxo@M6kPl?WKJf30fY{rVV>yv(SoD)1N zm@RxXPKkJ(s{!#q3o~dodR`gWb1Z+^!= zw-FoJq0}RP`I(d^mC!XA`IQ$))P^L8Y?9*ev5i&u0KqM|G!`4|xmzc)iJA1in9Yjm z9@~t*G7-iFxKioIuA|45*L8UFAo%@G`(G3S*Mj~%*pEM%M3CBKr8Fmu_OSi7lVBL% zo7G*9TfI;%?=w=ykx!pCisc^pce>yLXM+AkwR`D4fP-wlYkPZxAG-J+qE$hq_2~st zLmW0sJ8pa>l73knSfaaSE2q>R1z3Y6<7d~dvOQU+(_F5ZmqVI-XQK9SWF+Fhc}39+ z$kV)>ZJnk6y^*_}%`3(%z>ljS$f?P<{DJ_+TTCbm#u`h&G4d=sv@h$xI~0wD2}XM> zJDpwpCfZlP$SeO)TZc0-+7T^838$ftk`NHq2wl>}J?G|mk32|{E*^`vd1r`$r#nhq z3EaGO{0yHzDDZ{-?g`G|=hYY{)h-BCj?&dVQ9G=V1oCE)>Gqz3b_rlcrwYmegu$TkgzQ^a{34yxgfcI8I z@ABvnT8}KQ-`ehZ7UX#u?CFat;m9e}XIk{zzV-Ku{uliD77yaTM19u(4Ufyt^dGnK z77bhbEjEOoUVXyrAu@PY>fQ@eTqu{UCe!go+6Oh1DZX+xW#}eS`NSg-jL$9iF=AB8 zge?=>g#NLk5V^lnpnY1&0`m&`& zu;^W}l;lK^+EuQXD{`u%O10HaDv|npyotVDAm&W48Yqs`E&8a|N5^2V!D1yI3^yd` zsvFHOb_;9gv{sbla7-yDVlGsj9afPF}0W zx-F!dO|+{kSviheZ`8`%1KU=8m{0bVq|%@ma0_RfT7HnNHEZm~dQ=lg3GFU4tLI9> z3A^Z5tg(99MKC?-)=ldzW)nL5%BjT&?zMzJgH{>b%#2lj^MxJWe+AM?Aks!ehe;t) zq5BH9MxzJklkHw6V>~C7M@&kyA4)oyUIIm;;2gsR3ELf*x*BO$!C5^kv^jiuGrH)OZEx27AeR!{fK+*FgH0pbx^UXC0*H^MC%R{8+2@&x`7*6K0)wj}R}Fi2 zG2gyV_PZ&4Tsd{_qZj^qolIZuqlLjc>9zwj0~P&n;;FjD7Er*#k0ViPf%=7vj- zNO~Ip?3CI@;ayN`H`nX=jdoLQw@Qphg|cA9 zg~H!Vn0{#mGeS>M?jG*~%vmm=K_%T-?+ms?2X$Cu_l`qPgJ`Y)ae`EbY9Hyx4SopW z0mEV%;ixA@JGkcBvsr5eB;U-HzV~GNa(y*Q1oXVu{ea>bl%PwlT=bT{QK!(J=q=hWDjc9j9Wf*|%IbCzmzRrt(XdG&81|L>x#n=BOKv*%dD z2G9FV(=R~aPL$UXG8JZt3!B1!mQFrNH(z^0VBz1@_lWN>9SRfBLowwbaf z=Dk0};ZutV98guukp+j{?^!ouNwj=o5M+$|37;R1N};I&xQP8b6!H4c;Ilessn^tm zPx^iadN|>{7@|Wg;)^^{r7lLRIq-4y#V(fqP>5v88;oI6RBO5%q}rtrQ=Iq(1a#uI zq?NU;yS>{B9_^{6E+hQFebG!%Em|rdt?pc$BFsWkWDKh7aK1cE6P;KW8v+PzF!mlo5APhngA#9Ho zhMbB|^BUc0^lVznm5=>U{GEiF{fOPCzZ+23j=(D* z)1fjV_V!!Xf|*1Uw2s~3E@i*Vi*5V@dKx{^KB6*FClV;cSO~I7jwZXzh>4a0l@^GO zV`dsAATAcCay9;YGInEPGN_1@2Rph%8S>F?0PyoA&&Y`dev~3C=OyokDgO|ComHJ0 zsoM6&%uHvpW=ajl?{0hU;t&Ls54U_9U1xkN8735F`0%MTt`^^2b$hUhRgK#~R_XPz zpIMIj4?O0~4P%Z-S4!0ZkhI_IT^R;fl~Zx{Nzqk(av_5uH&YcRFD|e2I)%#K6+R$* zp$r6$4AwQZUUcjfF{7r;5I6ZOU|B4f8ipxstBETdJT^^ko6U86U9DI!F}R)xVHk)X z@T2TJ0Ht;&|5`sMNKsa)doxU7RYPn;kz<40-jMyvEnO`gKwR;Gx|cUA#92a$3&Li$ z7tr79vP^Q>Yy7@|=oQuu|7}D0-*BcZO#gv1Ez$hH(mK>?uMKo~8w3OQ)hrGS4#-16 zyhEOO6jS6<30TTFTLOMQRoxvDZ9B;>NHYM`ukza3+Rw}T%d4n5qxUiOih$pT%I!M8 zPJQ3sXpM*T6USNgw=UEXF)<|w|kp+GVJ+g0oY(UbPN%@&EGqJz(GdMD3kv0(?M>_$b-sdgsw z@B1OIqR^<@PUFzzxVX8IgmV9%kJl&I1YOOzZvmGEZnYk5?T!+5_i3C;O{&EeFuI8r z&I3ZL&Rc=9Yp$+_(mdVo)i`hIx15q07Wk z`ut(IVJ)XLv4O1DG02S(A&#Yn>O_U~wi_*5pBnDA3;o<>T%Dd(lZfEwPs++M!mJv* zxj6?T%74VMYTxeV3?rRytL?Tz-yLRLGPg)A;t1J1VEGyfRK>OQY1$8B6oeHk0>I?AVfXM}k zTg7{pG*_ehmoK{PF5Hnyy|&VU4Khq9-(s!+HUSw2IzkXb%k9ibm82t?W)mfiVezuW z_K5*EM5j%z?Z#KLbnZv2y*B?)B2#Hn5RcOvN4k-te=o&g5YWX>7K#dq#fz0j@j*2m z^S*;*GXvTg?zz@@F5kePnv2{oHtIN%-B90T=a;hiqG=x-Z1Rz2I_$`Q6-4;tCD`|I@k)cg#?5*nKIXH9}PNkEDnk{ z)p|LZ_pXkaXHo{mR}COEhEC*%A%1%z^{Cv{0aSCvwGzgXFdk(%AKdN7WN$~a07JKg zuhF0K-PKuli{ZO?fMTTHTek-;Kf{p81X9`X5R-^k-cY0il3;LOa}RS-78W)OfG6RO zZ!LL2$h(=h00?Uw!Ch3<8SkiTo6%Eb2*iK}g3Qqs66z1{_j1MgVv8gtOG50C3xwSQ z4WbtJ1oCyUotJZl82YX#f+|Z*&jOO+e0%J|lct9|VZ6asbK#%?gt*rBaAO_GFC4+z zcZy>eE`~%-B+f#?MI*5i%824zefMsz?pwh|_9bWqqcxu;HVH(PB?(B(0p%Q8;9Tj4 z7Dbs#rv!^3-v?_C^X6h64d^%HMngwLXAFq)^c8s`L;k6c!(|}O1%ivVd4yg=bVhoiRjNKv+W+oC$iFEe)*> z@*pQ&a&l65l6#E>HGJ%j zzm(fkznsNatx zuOZ`lM!a&1S(#7g!$mPyOC`PiOzN4 zc9i0n6$cu;EH97J`%}Rn-1H{KZG!+zvM7WgD23wL#@~`$Nhj2u+fxF0kccxN`~V!D z1bqwG`{Ht9(i=R&d^wsaC?yyQzJn}!WXEi`NDev7`Y^^p-f0we%j_f!2Hpl1qx1q= z#;WVl)}|whC`6GCT_4JE@H0oH@fanzzqoprLxJn|3F1P5~4><3ZxxkPfh%I4 zfnUU5WJJqW-klj~uGBCCCpKCYZLuH+q5!PsD;m2EY%xA97m_P-N&5dpa@bdI-ekz2 zHo>1st#%U7K>xZj3RpEb_;@CU%*M7bJHn^SmK=Y~66}Ap%%|0>oaAN^mP_Rr46U{X z$JCqH2*BLY1|EF%V(%C+0o*uXQ$nGN7_Z*i*+8uQGUoZ*E?e@i2PH&MlhW@S&NjbZ zHF-h2P6fC?0gA(E0nHJ9OMa7s*g6yP^A#kc=PJnR&PiJiT9zDpAPIJYSS^yiYPpe5 z38YP4C`B=M4o_;7O}zX7mc~7xl9DOo7jm2_;P4PWtxy;Pq%5x$O(C-1udXhM=F-=% z%&4R?Pz{i-VE0ckq}w3($-beat)Jq>^1bX>MDNhX%G97~aKV9PJG|>4gq>5Ud^Ws* z10G8u$e~D+?Nbg00Ag+|b8xxU>QfQODob00s0?o#a;KtV3NnV0@YnKeE>C&fPT{m& z9#|A57h9n$EV2H+786=wWfe>bR7oFs&HMzmMk3c97mp@M!ZLoT*x;aGw` z#9aDZW3g^}HijCbED$=il^}&wp&TsmGyJJkjQeV!MAJp;8;h%Va)P7l>d^oHyVxA; z88rVb!2M6)P)26<|9lu#myQ4TFxvB`4slD!guqxRa!D)*&GK&~4W2f$^St0zF!h|Z zq48Kk#SIwc`{v(Zu;!)(x@0B+qr`*p=}gub;hOiAB7Mj|br|tGzSqfwcgIVvt|%U? zB;M)r79LNgCkq+pRJZL*+V4>V2lYZtFh|_?@duYd%txJJu|lKms=vMeE5->)Br-!a z`*3pBLO(1x4LPQ%nG!BEDB0k8T90j(o*K|ss9m~#t1M~DOW~-aBl+Y&J9D0?E=&)> z6~V!_zif!d=^^aayZ>G`(B7E7T@p^$!?5-#kvx%xvgh!~}0(>Af81ngsB z#dRmACS?KUOOWG^GPX~00?!MOL823Or-qXV^L>)$ZL!w#K;-QKQvY6+9R;cx$k6SK z`tjYGVDbl0nMslMKahK%u7u{=R_r)jZGXyx=}E6$Y>AR~A0Y-3!Hn@OsG8o6xXoCGqBv%>g1Ff#1+o`Amj^(3R%_LKb(W2msiq|1P{I_8RX+ag znO4*#<)3ldWQs7^LpfT;WYUn53vd`w$>RI~r=I~=c{0`O3IWFZk8Vh>e07-~X{%LEadJhp_nTR`4T}ti2hG3(UVF8?y zXAgG-UtCX{`+$pfY?7pMt>!m;8y_g%h-?in(Xc~dcdMh)(-PUk%z?XjqQQD@ViRV( zF5ydhE@#nOJDZ#7M54$!3c_pcIVI;@;qIhZ&W7iH#C8o&wdLRqLU~oCwm|o!T$*xb zdB(qcek}k51~_yHn3~u(kDQr4%ZKozL8-z*hYXn|Guco*=i8C)jksQEoWuyw!?3-$ zB|n-Z!gH-C678Sc4;&1dSIgJ_>G<-%&<1uVC#us z?`2l~6##Z2EK)yZP;_r=qM%Nc4`+qU@c#~o=4@qypxX{=y@tV$wUeJklE z?PwV0@HptW5GwP9wR_x+VPI6A{Axr1uQ^Xu{0>H!{4UA9(0(~f3i>$stB3mlKc7du zptHg~I0j?(`MY_#vVYtOCL+OP=5jB40=y3X2pe{&iNCRu-4fB56=4j7M2q^40{Q;| z?dT7ZGiD<_P&&!jHAv&_k}7pK>Sx7QK(Yv$u0gk-h4{rHxL0GCA|hE{PMk(F@6^eb zrl@{h;KRH6co4`h{A>>T6425yEISy}$={occ?egvDRP*4_~6hDvr3FrZfmWLjtPA^ z?o=I6bU7>>1-1AEz{6_X{=HbUy|;QYYszMFnBph5=H?eoA@s^d_mXCzB8N zy&|cjo50(Ky`oy_`Fr%evRCC@1jzlpQgT0%Y;cwN6#5>Fg*Od7<`d&SxFk&GFfj&c z`;*TsUaimIhJSGE)?3%0@w=1f8#n&09DY%Kc799P@uI90A4O9#B#Bf#k$s|ozn2+DskFQC zNVZ`hv$*8I;eDE!UhmtSR1N1RG9~4HO#Q^}Wi4w3KJP@zA@xb8+U{1JNE>qGkwtsQ z<~N1HaP_zM!;>_{WR=PTTYb;}ro!d=iIHUcEmCBZx7yU^Jjy$ zy-8~FzkF3&A}dDz5Vgz1tLMg)wxMievlP)p{cyc1fbPdkfpF+G*ku_#SR~bHjWj|ILpCabkbMIx~ zTCY75#G!@9HORPy61QEil|hUs_L;r#1%-tOu(kPZ7gkbUu# z1{JBgAmd<@_olAtHdt{{c?vhr76F9q;#Hcfeus;G3- zE~kq+3m}GV&*~3OF=magu5}K|%z!SF&)Kpov3tieT86f%%odJJdHVgTU+owvx5Pj@ zgqAKFvw0La024>sbdvtoDJVR^T{9{ygfr7rA}?-@{-&D4Y~$bQR^}t=kwr*DfTNv4 zJFxu{b(?{JB} z8RkK4Q1&JJ6VBa2yboqI`?;y94*#B^)t2ISC#A)iokw=^a;0Ol3@7H0&s=)$sXOe~ zn%c=H0MVB*r*Vmk5gA#>_m(UL$u8O)G@~U``Hejh$v8%hYqYQ72!*oM?NBQiQyEW} zOn8rB(@Qg<3b4Q${7BU{%9L=eH8B_N6*Rh&WX(Rbm$$RZ$j$cvNN^@7EvS<;>;igR z8dYba!-LigKykS(7x8%{2;!FRBe1C9dbC0k{$$)5mVcZ7U!b}Eqx zMQo#%Z1rh3JH!3pGLw2-W4dn@>i`e0#K6$C@3hgKLFPF+kaY@5v9*SPOhPOc-w4&- z>!gG?WHttlr=2#Bp)z;CT2yQmTI!{`NTD_{@wk&viZZTOkSkp&Wn&ng)h9A$nW}?@ zab~6^1CKgvj&QH>NqUv{apgYZcxEbr&4R#97KS8BO2P2+qW>XN<;%Lhy?C1X(&zIn zE?^%)8Z)EGA`RpJfnW;U^c%$hB)%!4h{N%46euUqZQ)-=WNtH{G4V$cW}NJ4rq11g z4$w7KnP#RV9xk)?N^FG0f&3IGb5q81I=1Mt6{p`L`|7ppS$w(qJS=KBli%zZ$ZJC& zwOjl7o@v|sd85CI-M56BOc0#8P8|rxiI$SMgxN6mC0k*G`U~?R~%MZQ&p%Or0!m z-giO~5KduWQ|acZSJRw{<~=hm%CZ#&0cg>-x9`S zoQs(Tj#{{tjv`s6?ph_$4Te=CgbkXMlcNWDz-F`fODuB z*&zaEhKUywo-m=qLg6=2BUPw_it5SK6yciX5>8AduB9s3-cJLcq4hb!wv491bqQjl zO`6+y5WuV84R{?g|2S*Kn_Eo*fhGQkrHJozTr{?k+KFE9w~l|3Rc7oabaTfv)0=y_tak4v9`v7GNZLrBHOv$TPT`?Zt7FZ+T&7}s zI80aUu=2g)Vx3tcW?~)@mBU+hAYXc?QE@K^t zJAc)9QRVI4jicCXk8h<9J7`X0YcrZ`N3_56tS6N)jB#|wayO&fmE&q*v77V6lWI24 zvV6js6L=^*d#$;X?=dg~3T=6Q`^H+i;oS&YCTDRusKH6hR#=0E?k+pa89k2@Dg{FR zm4+A`I6;SwGRwTEQ0RHB)zJb`D%(>v;ECqUcikuZi)qXF0P^Sfux6r+1&YUbH{sLv zc0YP&Ohp6^50u6>Y4=5VF3{>|FNRQ~O*r;J|I5d3pc~<(WulIuF7gwq;QQ@MX`IsFDx=|&Mn$AN->67Cs zDW1nnEj^)^o~~ISm3{t_X%8w37$4U^-W7AT(AOg*)met~#Z_B^d6GK)F(w_rd7QP% z?aS;i_ZTL82Nm_6+MKGu26NA^)W)iVf352?-fCey)AW!e56ba)Y335&{}VrnSWx1> z#lZiKXUNR*AD-_Wb?N`(`ToZN1 zz~3VbZyb(zV2gfL;)t-cGUKSbJEHg`E>r}=$2x)eX|(8x?(K`))oY9}D;|f!(zPe9 zB%YKcbaCnVVEu7WzYVXHSDN*#-X*O-AnFauaVqa(`?&cWlTeUEQ8!qpaLC-+X-o65 zW5q2|QbdpqP1#wo?Wy{$&JH>Y`$JGloM^f{sTTlE6Cd6+Nn@f@yEdi^#61S48>oxO zPlANUI(8Y**QOhPnD6e8`PEzLhOi7Kx+?3*lh0HBDp!63rt`ewaIKA!`Vh$&YB3AMPxhk|z`0?it#ZZ9mRJRr0BND-Q-5LtMxI8K2sazBU)LHY}-ZOb6_EMLoj;=wF0lR1~F6D@w5-Nrf8y z4}0F_YmA&T)xLH3CjVln%PPB}wzI(d3F3LQd_42hEdzz8PU->G88{o1Ps)rrNvOQ8 zUe#Wa?}Jp?6(nz)$~3DsLDhg(zFJJt9DNN$x&=3qIh$>x)~7C?*X8Hjuiwf#J!sOO z8AwdXb*XO7$_yahc12rj&EdVh9anX?&HVQ;DWdA3JQ5$h=kZG-Q3f3`5HvS0Bykuc z=#FHR5hxYs5dExcqL5k^b&)M)(utJDAoZ}(WEUFnXxlY_Sb%7s z+AZxS(tgM2B6cubpG1+%I2vB7&$B@Re>DWb>s#%z1G_45<28V+U~8Z-u>*IO z!v~(uE=ZxIJq_zVQLI!HUa$->{hSuQeO@e$0K%ZzZtg*)A#@@v#S8D8HWk|ymgM51 zeKr@`=a=LHqm4ELle?DZ68D<`)fH45On|q1k50S?{UAIYw5$H|^vVt>=G(9jz$g#) zhU{e|><$=-)W?ZyEFT3BolQFEKiVwsk|zd1e(kwvfW65f<5-gzdOD(E(*$qvC;bv~ z$PE6d@8?51)Pr)o1K}6}!gT)&P?dRpN8@y0D)7Lfz+-Z98kok$l46`wlKr`QiKFV=2BoaDAR+^#M*R zsBZtaefWQZDKauJ{6~{!MC~6}mII;pu8zQ|0!F0z{SQrn0AQPJ6b+Dlmt#Y?D}19Y zD-g+I%5fpETv*b zrR?*T70Y^<>UTB%q(-A@sIE4%d=iOeG)rDO*D}Pgv`mG|vPq_044~ z8u!vB)t!?^Xqyz2K4vB?HPXk=;(ea6w}raTT#nwn=uW_IYf^U4BOXmNNv3Kec1xVH?%eHOXwr$(C?K)-Kwr$(CZJn~`+?ki@ zwfdodL`Hs@5wZ8^VLs1!9{9P}>_*%KQuk}pevheTf>xmTV7|s`tu|VV= z`5^tfJ4)i!eysCS9FL+Z8|xfX3${#(4fzRg{NADwxeRdX=K#?1T-M`2&CB(fgiU`w z%^IrCwl>1&?d~lX=Cj66jEMiaaJhu>`v{P)C=NNJ;W^wx`VoW7rrrnxw6O{v&WM9b zKK2u$9YLW~I~XPX(AT^;8e)93xc2N0Y8H*Z!S`%~72 z&aW6gxLw~DxxL*=EoO9X)H^ppYsz|Mr*+X;Ft?}`F;`RD-E!^vHTUuN(7=m>mNr30 z@{6pKt0kVEB{ttw_9P$x?3N#|Bby&Pq;dsPdB5l+o^_J~w5^~$wQj1|<~cRV-1Q26 zVPlQ&MT*stLB9B(!QQ`Gw${p?qkZOoYFgH9!_8QnfeCSh=3SW_hVh1z*t#gx%z?KG zKrI1ucVi^325_0}d{=@03I_?_!qxshMFoTKSPqE=G1TK)n6~2+U2={~6o14mqqgz6 zrN#8x2r-+;`>jvc)!L$eyp8?dpGZ3Xmy*H$zhQ4!8U6!%v!W#(cQpF{t(#(2v3<(k z=4Nw%;gA3Z$s`WV;&GV7iKG)*CT?ypejO=)A5O_icEtvRFb7CfZsJzJTO$SkVRd{5l)oX|vPkNn_u^X$%f8%e>X65qa6Z;)pY3;r1%Tj)rpy zK34DILl7gg0~U8~Q@n$uIo2a;%kIe$9N3C`9|=TfZ@1Ar<6jQFX) zyfoQu2Wy>F-ZkB>)H1NVG-zI|=$R9)Sjd>S!^zdetA!ANZJB|`G6nnPr)dJxllU2* zawyOtoWKASLpa;$`7z}q)9Y&DKhr|^DiIJ}hc&uZoVQ=uzXC zWJe&Kh~jw4-pA9H!d2y!-fah3ZxXHue}9D6K?`OcWeH^ki9)Vc0}fobS~W@6qn|xX zegqS-Ubj=BHn183vz(=)K-8X1CJ3Q&%%u-3y3zIVOG4Di*jvmLTls;9w3N zI79tSx|Zd;=x%W7D-k0M1SgWZ$sa^*O@CVdxv6|@?Nrbs0s^r}s1LlhqUri}4$D}N z5X-vI!5(>9;&+?bqdlMI<;iX*g2Qbu4%9 z?8$Rsi+|n9uUXfK=4i)dzJAF#N<^P>&^OQl6v23yNFRNmf8wyHfsm=OO2`tkOrD|- zcD47>JJVUvW}IpMX@O%s7}RVCXjc>X@*?IO)dQg2w)Uu6?O=LlXaxNYDV+U@o2~}w z?2k1S@i|uy7%~Ow`4S5YG92L{=|tQyQ~$)SX5(#79MRkRlsN<>WGsUq*L|cy)!xML zN9vBs&e|cHDDcF{`o|C_2NL1lhy&ivMb9uP#EIRAh<9xRMS`3HAZw80~?x2u{F2*MKefISoVN5Z6P|t z62ZPB3|Y>$DQW!cu#1Z#FgG!z)X5+gz%tKuo6)HHNj+eCuamIX+;+h_TNye+R@O1x zUqsCBd_Dbu6i*z~0#*=lmgm(Yrazt`dKirDMurswkGk5X9iK{FjXzWr1ZFsnG-h(B z!z%eGkBo90iYn|TN3zB}I=)z5^1_h9O82fJFUzW0>M`iuy6oB+cP!%k0DC4mqm2~) zN~g@>1U9Yr5V z1IzF*f#1m3^GXt?NTrA(NFLj(@WX2G%7R8zf9$1?c)3pCl8G8(V<`;R=K||| zb3V^vbfU*hXd(2Wh5Q@fHgwK>ixrVi8!{CkC zNYpOnuid*t|Ed?b1|SrtKd_Q)VG9J6Ao3$2{QxhwKobm8!J7~V+u#1CGi(gLDA~%7 zLt0r-;bam%!3$(&=YOS=3zA&GknVt z_>NNN9ZI7Nn-pvqC>`gAMQLj_RA~wJBXGrq#e~MQY@r&6&kAUdE5G@6%Do_KNhT2$ z6jMCF7J(_N;;Q#^X(tMuY(Z=MsW7c6prk%>`fZ5}x>n|I{XNoyME) zdv$F0P{SVN6hCAazpA(UE^THz8v;*`jHJFuLwk zfs`P=sKo1>jhfI1_`zxzcWpotM@H5l9MxVmH&`*AxZfiDV{FJp;5@GOgn9i>VcTee zR0lUnuC_D8#9re>l`iXM4ENX6*LvJk0vEw#)ieK z%q-$-h3oJ=T1h~UAJ*4|+RTZ=RMKp#t%{yMZzOD(TS%hU>O{V&_iEtaRMv-!-9?VA zEa=D9IEfAc>y{nfB270m+({Ho*(LvXTVZ{pd0i(C>1q8h*o2w5{2du+yLvw>yUtjp zg70ohZGsBTrj%+?7b(5ASp?zp2sYk|{XMN&(dPoxoYnSIPeTPEumPl&Hu9W)LfuKbJ)|18e=n5D_~ zX%XKVb6N4dNZYj|4sO@!VkhIkHEi&?O^)dwRdWfYzOShY7IT0lDX!B^a8G6Q5^K~! z^s-VaFBCTvh&^NBPq>mM9`&1jm)Y$v%~ut;oI8<0JK>Q;3;2;Avv2`cc;w!*bUTvj)rdS`##xAT@kYXTPFOU zU_s0rjQ`QqtNf~n67s5N>nuWG(jpyOZ?_YcF z=+FWAFj7us&g{aGAb}%BuUk9t_cQkFU!_6*U!`dGeVrRTdp`c&k27(Hf7GW{WB0cC zwjI2ONS!Blx9xsg;tREYK40qCg`m{dka|bU^89~J%1)%DIyCOuTprW%eg)b6FLU#{ zcz3Ht_BMY)bARS()d%U=#?H+8P@awMduol^s87;QCf)gXSf^4Jts08#JJCyoEqZCga_Ek?#t`(Yora4FS@-mp`rQB`hp!{J&xgwW z6yrgy_5>IbQA~JQ|7}>_;J6T-uP1;*jI(Fu`LF@ZRl~r{Z#Pz!?|oFIMet^|)Ueeo zyFS}6G<8^T3vU(i77shHPEXEe4q$!{@wip*PB#6l8ON_?@BA@8*ax!m`78I&)@Gvz z$h`XoQSN-E25_Zd6`785FfD3}hwWQIW#0{?>Nb$fshdW&sAuB^h!8`qta*nvxT;?2 zXGqzS2;UdrXxKm8$+A^OlOn2OfU3JjBPoWiC;OueaD_%wwy&Rs(WuO9aM9F+s8*gm zm~Qq@#%n)PrD_-x8V+R^AX~L80BbT3=r_k#rJk7Odk2;|w~=US*k*>N=To0(HfH*( zO^MUv93X@sPn*HPy>Ieg@+_zoZ`%gll^V37=f_hY3VMnoA&QR0!os?J9!1u07GL{Q zyS2p&(b!2{>U&>qFc!&o00o7^!Z|1iPzIm`je;a{H+$YRxJT{B)ah7#4iY zmXSHCXxtBFvj|Vfph?U1TecMwBxb5i7WjO=mmg%TfzO=HSD&~oK!#e)dOniWcv^!} zu=`+o?wfReBKvo6q{E2-np*k+G_x%19koGg`wB(bqQ)AM+6_?3(bMyETnQ&mmm-_o z36XLl`3R*rxV!tE@5O~C=s-gu+;>v*rHMX=Qe4iYG9b+W(lkTN=9QgTWHfQ>orKXt zqTU4i%mcbJHY5Spg1U$hYKxGkR(y)RbBIqic*Ho&X$tyGm`C$zt@Z;r6;l&ICh&M$ z-*`Lo{8_~`d~m4KNc%WO>!@ZG%KQ41x3ijDr6_E!8ZbWy;yR6pGRan`NTl)HU#a)o&v3tV}WRA++THzEE@)l$#;_VC?25Oblt2y%u*y(Kfu#oRGL&>xKBs zXXKrDMQ(QlK%D#6~DIJWaU@I66uT^kd{Dt zAg|o$>nqT@*H=^W=B?Cpmv2Gm0#c&O+iKkNOGu|gk){!B2Bm|COL0w4U$_$raS1;L zSx?6JPVqRZ<0zen4P=qC_;7;w0cQYQlENAaS)u+V`+cy90Y#gsW>immKtt;H8V2Ea z1yxPpl&m2y4{eyVkf$)=8v))EfZyuP9uZh$(s~&3T4NX0K8x1Q%D@6pMsxFxNo85J z5f**hBw9iejL7C*07ttB&KPvWGNaCJ>CgZcujgMdCIm5`qmgW>yYWrK=)8&VZ2?_D4*GmxcxXhj7cI!(Le$3RwKHzfWHzr~V-e&fZo1BE7ap1ZBw7`Qp)stTj4pCsz8rLw3 zhDeE5KY;+vi`Kznjg#`GQ9m@#!d72Z{#pcHik-Qa7S(+rm~E!-B| ziL%?{C8wM*a<)U4+L$lRC!1zg1hquD{$j4F56VcOh@3|uT=rM5`0wso5^6-;octsA z*XhAL@6wj;Bg1^onbU!n1%6(99JY_PG}$>ePbl8R(D$ODVNRpEzK}D2<60mfI+`*n z0^t6$ML6G!dSA$>j%+wY_|S9c2uO=jZ(b!Ptj3FHZ*EEuCLLWV50fkAqC3Lx#1`=O zHFqZ1G!sbhDz&cbug_|DO-Q$-j$S%r3E|_( z_=VtCVPWQ)sn?1?b#-khprSZzw^HEj2siq}Q19W>s&xH+TW&6**unDmtzNpLIQ>L3 zr>dyQ7(;>7F+-wugA3h!GSA=CCeVPB>e>}njhv;`{MtYF{_;aDh8$9WQj(++UZyCZ z)fGwKy*Qb&O|}+rHvu4Zi)R*foo20#YiA3FT!da~XB1?x52TQ8s~Gtu2roshiF=jF zfjfvT;aRCndld+*@Z6&5F=}=Hpy<9_wnp0G^e3kUF7a4clFsJVg5Sfi}pSMGueQnCIB`WbHlse6E`oUPZDeS#sj=XL2^Y`obw~L za#Ol=YQ`;KOdRm zx;NRrPv^k`kGjT_i!F1Qd?F^fDUk+-ETDbj@^FtZqf}`r3S&ktYTOZ`utn#t-0q}( zzAk)+GC76*5ECYak6~T`lE}UJ{7ISNpd=O5Zf=#k09UJp$Zq?*UEUW|yst;C|=x+tNaSg`-zK zD?%rbRMs+*h7W`S{YdSl*+gl&lA8J3YP;~ohwb(Yfw_qj&&Z^|NOLfcdm?;_DPHJS z|M8Wh@@j;)AEf{MbS+~kf(!BK^V#_@WO<^LQoTa8E6Z_!%Z&8AFNpvBv16Hjxx@HY802xnNRm z-loLvkwQ5-sH7B<{bXbitcE~X-X!;!2Uu(8twOMA>=d=s!EFcbAYzz@feaL*6*K@P z{nfoWW`#}4?W=s*)rX%n{qz@7ZdJcfmmO=LB^(voU zOjx44B2ptRFDDvM&)5yf$H@#>iz-gDTfpfv_)Bw?H%ojfDb&s40aWg}KbISx1O$)C zzxGtxdY=mJ6D>&0LW<~iS<0hap!fzdtyhhjr`vM#`4b-umwsSO;91yfPueR(0(Z+h zBr-{woKnr?k*3Mn*NkPzsCmQ`b!J6eTiRi$Y&s)0Jpp>^squpm3dg_MN=~lOlP&Fd zY?)`;>87G9G7=719`PbgrYHl$GVjSt6K;ySnNz0M<_-rkDXl9$4AK_r-yFeB=Bz#F zx(78q_tKrpVSAozb+Git@89!7<4Ouezi8|SK`zg2>umlqAi$JgdGC64m)I~f0D;oy zfv~7#%Fl%y-U^dSc$~2Q$F~TzXo-=8-O7AO!jw>y4a_fKatRfPik~l6SWJf{|4-Ws z7j!&u^m9j6W+l)rfFn)Ig8f@NK*+7B$;Urh=b&X%J3+sJw})3`9=Be$fg{W;wYI>|e-e2HEl?qX~TBD3$!?BW_Ii1Zo z{_=UR3*QgvN$taXUe&yQY9DGu^5RfMiPFaD$jA&N84UVo_}aO4kMfxTZ{x)7D_9 zF2MxyYfvvi6j}e$Y7yO36`H5PtH$^9j`m9d>`&m+k2WS&04ZM~x~E*Y65^Pgs8WR~ z_$5l2Z#REC2sH+?dJ)`Eh((<&B7g;oidpb+(PuoO5c1bEnoa3pC}HrIT4kdrUy7zY z{14O-;Ki2Z^Bj=?ZXTL3HD7%~90jJTtLBCO5eVQxc;fBgzpH z$$HaC510rqo-Zz3zNZq^0ye+8ALM#Qo7(-L6KbKEV|Trhoy_ucZ{@ON#Za-3)y1nV z?Ve-y=+DHRZ4;U-qpxPktSSn z9NU71O&|xx8;~w6aq1`jr6S?tM{l=}=YaKFkH>>47*#HQOAe#Ce&0V|{9R5X%;CiT zWSsJ|(*ll28&qnmJ-cnQ43%Eq&-<;+m|q*Z$zPyE<7>J}C@WP&5U0?jFqBl8_EIJm z!tU~Fxu-nTDGv|QRo|sdgKPGkcq?HduHHCKG3cLlQteLZ)@CU-fHnhPCo-=YP0bK- zTl3<+@?o`Qtah`aT<1CO9YA}LEek($s6|175T25 zP+wn4tKbooEEiE5oe7G*J#vDuEJ~~ckrEc!p;*(6&Lk6yaCqAt;vonHnt}${+4ImL zJsRz+A^XTN>LGC!V`8Rsa?E0hQ*5P_jyI2a6Q=e$=$J*rPHvrS%gV$2f7YGPoo0p! z(-%2$IQq;(4l(&tWy09_Y|3f_sd5CV@Hy-E;$DvXn_46(iYOr{_wEx_QmUSot4VoQ z1s;M5n=>UcXi>hYP6Tk*bE@z_4%-QOss&M}WYM3B)7IIL2jQ8U5dvRD`4;3CaZ`V&A0aH{!1qxOviP;ofb5pPG-_+k7~$M|Vq4U9yw+PeO8^V|{@#DPO`e5Yl+Ws-bDVY#`eVMfhXq^RQ$if~ZX=TIL~F z3NHCV)RB15!bX7A&TlVT5yjQK<7=!YO1Mx#r>`*|0Nc9 z+TS82r-3bdIXwFwaQo!~a%z99Er6}rYWAXdc|9Lu<&Tvfw=>gXuOA<~=483S3G1~q z0p96>9EC|cv)9oez5vcy^K|K9(;R_pnzfGPs95{3l;RlyBTA4>Zf?L>3A^^LzimG3 zhYxQPW(i{Bkz3p_HRNVuu*u4Byw_h!-V4u0W!W0++87hd;-3WT(QT{Sw4BqYr%eZ= zwoHTJ8aI+!hb_6GidZF%~newA5-boWvUx(!;dmbtk$86j+z0M5ye8}D#0osu*L9vQ+y<2=qdkx=5_2g~w?Wyr$Cp;S^# z1%#2m@V5T;F|aQ!@DIUek&p2uF4zn0*A4ZLxD3idWSP9Ue@T`vDZnWyill>zFFd<` zxwKLTcoa=BV%UP&QDG-_+SZN`Ln|JSsn9x3*kLJGeJ#7gzLar)HfR@@`mm zg{o|5U-EO$oM+!t%0#F#I-pfdQZRVi0tu}_oe{E1);(sX>h{f$j!w&V$6hr9)gmh~ zEeL}XB1L`zNbU=-q;|AedOPaI7BMgyoNz``OR6Zt8L=F(9nwkn5~XU?a0#*LIv6g4 zAt5Ol>7_gP6C~A-nD@cAbweGKb2`d%RKKeG??0c~d&kTdGE%=EAnpcpQm9Q1jxVx$ z&cSxAEv%crSqHS{z}2WT4PNsyC4Z z#MSjIX_Q!~Xjzstyfc73gU+yT(`ru)CLh(Q7qMHuZ&lqebx zx1T&+a&Uj=Pz1OZ@ftKuG(`M~r}Zcsc|H>vn!Ut(U03^rioZ3n_<`Yd@Vs<;1(ejA zzfdSaqVjzrYAKw|pIbz6hCZx%(5&QY3-4L?5n~$v+E$FfVTQ)u)Kqu1t)7HQz0UUE zJI|oCly18n>P`*mR@HSLm(gA24?Y|mY!}UtriZw!wVSx?8r}*_T2~`ewF#GRu)HwJ z%Z6*LlJq~>h}Eo}9=++oGoWHPTHDxUtl{HdIEkWuxd?IV`nHYj<_$Uby>I9b$V~7r z0CAS4TeW&}1qD-sDD*F*Qvf_K^HW{*&LPZ<&ysGvvyB=siQ@1fX`GsSgqgD;Joi4% zvj3ikC?e%2f<>}_k`SmcZ+$5 z3|u(_xcXWw74&bgZ62G>JlyA~aDWWj?~(08P^e?VP{GadO0F+=qn63#s~Top@~X z`lH`Xl7?#@>ztf=j5T1$6>IFaP2QI`u}(XPXtTU}4hRl5$s~Y*V7Co_H!!-V(}y0$ zEPuUUkL1((x^;hFKJR|tAN$-UwyO4}2_!NV@O)rJsv*?tLj+YsM6s^TgmJ*UKr>)a;z@TOPFl(?Fz`(7PR+rd`6>n!@z1sS#e%WVa?Tf&lFaZ@EcJ!6 zFjz++N;ENS_3!bTbgBft+iVDqvF6t%AXMR|`C>@tj>;mc z@L>Jq2Hnb(mZZ=v#-+FMOSzphB$xd&qfad(bUzwYG}jcR`F>^^Q@8Y;)^uO7*4t>z z);JCyfF>)Mm`MXDfiQ9ByL5HSIWfTPuS-Qlh3B^B+5l$x{ZVS^&KKb*M3gEcikD3k z3qodt0Kr+?);`qVF~5<3=^P3Tp&bph{-L$m2|7&MGD_>9VIlw*EM z@7jC87*k@!w*jS$IfDvsH4<8;QCzgm%qks)we?!Ol#xHh?{!0#wn0IlLc3(V`|Tu` z^JhA~Eki^=W3m7Sm%JQ;Jj1*28J6+43XbBYOU!(5Hib0#!mucwAY;Ul2O;8RWCdoC>-wb{WcXqx2rJ>Sgf_QJiw3jb#QKo$80(0Ub`u(XCL9W}y2i}I@sIMA+bbxqAJd$M_2 zYacA(%X&-xn)HGi?ZZSI3t7q7gtIC(Xt4AVX4RhNk-)^|fNPq;sG&LX${m%)G8th& zW%9Wu^#>i!{SWzhN_^gI_3*o;>GY#q0tCMwJlOYvqU33Bm3e{4lDw=#U`G>i_xJQPS+s{LznhFa(axAT;p`O2ceXcS@Apw2Lg5_^9iWK zg9f9QWVh?*myHio z?>CS{FdV7*(!Any$hKJL63xm#UG|#GFia;D6d7K3!Y~Zi*4M0fO9r{L-i${AGxJfzh;7JepHZOxJ8ccVn_Zvn~xI_P-5-SprJ!%_y zLiu`zXP}%xAYZS3VG=6^4D5W?(tEoqx#B1NiRf#|NM-_L2hoYn2ZFxhTE$BzoPDDb z4f*@&#;wIS8U>Mz>?N(^MtI9p-0vqcsVarRlVo<#^}-O~wu(aD14)*e{5&hR^1BKu zJ9(7f*=BDH<7?4?fPiQ|0;G6A`(ut-B+O)ARaZt{6LN}CB*J(|D5DS^ziR-0=gK&q@<6q*?tiY9y-+sLs1HCuvA+DIX%=@-FpT`1>0E` z>T}Ewx#lvA?b0q;5X5te)ixT*M3ZVFTB*}MtNc=gO^v)rkJw;kL;qRS7JPmW+k1;& z92m?zKn(<1LxlXI{2V1g!C=;OP4lE_7~+g0**98r76EQjQ-)4JA8i2kDKa@hhr9;G zCCK)|+5r7VdZmJW^)GZ*B4*);ueXtNRSX?y?USm0k|-Ic&o@>*Y5e%G>=Ag>>WU*_ zoW!l~I9JI6@UgJ-#f&~XV*%kyA2vZD1xh|AN4yCfw8r^Q5#(ai>~q0>)7{XbgJd@; zHSkZ$6bRWSf1T@b7g<3we~wjEJq1*1{jR{cy6R3AmaBs8wrsz{p%A!Dt`3O{2FzUI z)Uzz)p|5Y|Ri{NAL42`Ks&-uv0?!4aOS(aJH;=k@P0c@(pvWRG`;en~-JGp)a5f!n5Cg`u4sbUNu4-Awv=E=loJMLe}?A-=dz?yJ!n=hQw9Gd zZRl`82nJ2Oa9x#r(HBcP9wvn}JsuW`Fec*@SKB#q+dB{r109y`Y~s;(rGy3AsiBt; z3Q>RbAoexd6uKM^m_zKmi~vFe@y8(YDB1gKDKy~>v^-=j*yAVMxSPF_IQO$F<1({_ zWgvMnXoo>&^F3d>yqJ=46_OUQ)FP|=NL{_3bSDC&Gi{pB#`-_4si^>#7%~|Mt44B- z#K-P)b|vihyrr**B1ndoSPFpIFOy*+4qZ!fA1ZX(9U{qeJ;pV^gXi{G2!TZ%*(V)> z9-^VNGC#h~V8PU*hyY;;*iRc@4D*Q16p#a6JJBG=5#B#}-pCbjG4R4>H}l_JhF%W; z4d9hKGj6HrkI(><3egKTpLlttpqWdk19kOO>arNhSIq7Xd>RIUbrasQ0(NJ#iU)aK znfU17 z#ta$W)*DL0Q$dNSXzc%49tMY_nIel>aH<2Wi5~X3jp!sXF}aPzM)r;N!}g8durOT? zrO?5l;o4qjvtU^ zYy7mER=Ub$bXAJl-2en6(q=GCN0GB_sPDUhmmGDTd_JJe7e)%mGaZOQ1G6(&5CN8w zTN)X)Z8&_xq5`_hpLvn^47Vk6z5}@jn`(Y$ZOWa+ca6Ol$hkh?qlE{UZ7U(fZHEVf z%vBb^JM2T03f7|aB}b#g#Ejm;z&ttFTZ7Pn4m8+W$!kE37N99-?$;YaEfm((RBMgh zFjzFST_9|lM+ZmBH2iq@>5WHl<8VO)UkV?3e6{J$Xvw!70u(YPawSAF9Whkch_MD2a^iC z`HqtdG7LQu5yvXD2c-?M-=JRUsqyTXQJev_SH@-m&4IU4>KT0i!SiCM#sVJo(I37W zEsh5_p>qXsJhiLTdH|137m8ci31@S25TlDqOOCJun%JCPQGeZesX!kXM+9%N6H^uA z_Iys3Y{lD;nalNT>EOBXY+GPNA6-E6d=arMuP=qmca(wLb1!Ho=P?>wHugZ1jtthO zfHP~UOzk^|oV}s{`{dZ;V3diDFzA5_cRk4DmC!p=@o(Mi$+l-GeztLA`w@}K>~|v4 zbp4e+29-=Zo^Yv1#3>ENiAeY~3Lz|-i~Xi&6HxB-P|w+?#4C2BO10Gy zD_AYqkqMc-oYL(pIxx$p#VI?GZj3B6w_EcxcZq^$9(}o(vfc3#k8{}EDZb#Aj{36w5~fPZzuS+ zx^<;@@qBOl!(+Geb%q@ugA%7@_GdFV)y8bO|4RptP`q_U($m~pwd0CzBK3!tWFf8b z8Cu3}30?l=#r^Ti(RK-n-K)#Ny9NJJy48Hno$7-hoB5G0uJ-9HfdkB9YfhNGYrm}9 zC2m4-CG5wuk{DO;wkwaVYVYR(osnxc@xMjH|A~pp$i~F}|A#F1Xh=I}iy{2eiXogJ zupttkjs&<$P)4LU9hN6*%!)1=Hgi)e9yWlfHCBEdEe*lYRD<`dI!da-T+e?$uf<)A ze(oF6hwxuR0{s@S&-LWV_XHas9w3k!2K6kJgc-vtC)clY>t??v*Kdqm+~E~~Knfn% zem|Wb?__BTP(GVBFhuRi?PiV8o93p4>M{S?YSm3I=}&1282R_ksxlG}+G|ySkGYg{ z^*e@$2z3XLQjAuwxZcuFlFg{{LUSBAcrVeWYHF(O$mXL@t7FCaDX}+N&6=P7ae@98 zp+1#B0Q{gB+_ut0e!eYDmDy&Tdq8zRp+r=qRxJp0#?%{ZBPpROGEm*Cn}LuyLp zkhT(0(nalqSW&DU)eHiJBL_{S4N5XyRWTAoGc&$-ut~%aV@6wRO;XXKDyLT_yIb5{ zGAN5~<+PA?H8@hRcGmvR(&(9|In7yda>V|LC7}WN6~!Z3uFUTEk_``BwdZb$CyvA* z*H+^az$WORd6|*QoTA$DV@eC14%(-0KmNN#xg11HlW1PV=lQsLCza{Z-~Wk=aCdI-|vAsY!qh3WG8%oQFlXj($WG z-T{jpgmiz*e7?>NgrIblQbSc_F-L?BfWyDP5pnH<72)`n@uVA`0g=QIbY4skYX`+j zC^=kJN_xyxEebE zp|vG6U{G_q1zrNgJVWqHPB2_y;H#*bPQS+~5MoOwj>1;Iy;WN*2TV8wQTu*%L?|aL z9o6a}ag+$jseUdcZn8JGd_V;%IHdNE(Q*KQ#UC7o0 z1kD$$dW_=;d$zIJ4)2IIh=4#JdQV~Xw%V7`94s1wNl|2>pP5!l$@uPI;g@g@-0f5RHdwkHFBYtBoUNV;JXth4D5@vID2i`V z)DTpWy_f1&9?crRk!>bPUF z#qe(PdMm)80MZ<2taeHhNC)s(CLPO=CQFy<3aB%~`K;74UjpJ3Om_pKCxerN`Sw>w zNTVyk;p(#+60)p$lxf}EdfE0|L>T@|^kgM%=I-=!h>$=CZa9vpXG0VoGv*yEKDtVh zmI(41>NYP zdf^5e@l(zc8}|VZH2H8(RnRxP5?nc6!YoM|NZCc44$_tKby9;ya_jA!qi2Ow$kK_3 zK!m?gE5Jy@Wni$>KEjBguw>^;&x9dT@4(vG7WC3txqHVH@pJ2@By+ubnWFIhe9RCw-|vi&shzsihIVn=jG_6r&= zcEL%{Dy|@}1UBp0xmfgRaRnm-{d6=B`QATIgn-4r!ckY71&bk~8kbP24{_Yx01L?y zt|(~(O(q2XDB{nE^keI`wQfS@5-sLeS8HU0r5v{%(1dMttO&;( zldn#hF0SQGHGU9k>KMz_S7m1<*9XP{MW{aq63EY@g?D(buDJfM08w@! z&x~VpZ&ZCWgD7Xxf|on4e;a+Q@J0=ilx4PV4brH_7v3(4@CsX1)^i-<5RNGe@Zcq| zRJ-5jGrY!vWMFk+X1glnRKl=K-FNSGo35)$a&7Ikx(%H)7O6(RxeEPWi|Y!!+m4V~ zX5q55g5|{|p2;bZow~>{JT;MV4QMy!OGyXi)n5g+%hv(gUgotyrUU39h6s=rnOVso zOdMYG7z#Ru#6%4y^rurf`zjIL??M-^ROp?%?R{*@AZc~beD=pOav6j;SoN6YL07f;0QbSxpFyEc7qT}qwrr>)H;0n zluqM5eYsb;o&B$?wa08NcS9OvIUxG=pl@X`P#|gxD;Z%X%bd6~--5}JZR__j-wt%Q z0#vZrL=Z?Gw+F?T0iY=YN*px<+%i_>cx4r>^;9D1$1;^ASmU`y-lbKh%*{akXCSY# zTDMYm5-S*c&~LM00>CELO$C~gbwpUCH>MC~2*bCPj9+iuuA7}SzcgS!5rF9kCORbi zDLN5MB~CFDD>OhlWQmN6;>8CZY9btrdD}BM;WB(pY8a4N&`q>10#^V16`Jy|o&^V) zQ%E;?;;DR@3APCjumF!sJWwyn=wi@Lah+$uEJXX7wMtSLhYPCZmZjO_OjBlDbEt$7 zjC;gd%=(or==83q`s&~Ag4Kw{n>&LMfV_~#DT!~A0YD>E0w75=1@O!FR9qTVBjtpl zuM%s*(a2Y$gQW$4`pxm+Tv=(usttDP3L@D1LpshdCCewGhB=`lkdkXrcSm%Iz zue(l?`Oah1M|cF}?pXtPq({oz>LD!ip}L$fxXC)q86nKTA%+PB%9CEQH1#S2$cXX) zF)in?Fv8jAA9AU{0_^fxl@H#v04jUC$R+j%%q01^0tld$ zRCctfiX4Fihjldo+qLr5=;&_tvC>CZzDT3}mR;K@S>2$AwL*^~p>j${@J?Pez>tGW zsHEqCIKcr5tpi0~-S_4@MbXQ*Qke{>P&ov5JCX1>s7j7xSFFs~u3R@4UJ~l4PQWB& z$ej_X%LOn`)Uu0Yxhb$Cz4Y4h-cCveC?uDlI8ySJ6&iv>hC05Hcv6fg>qqsGtO@#t zP9(=S7hxDuOr>_Eugu({E1(|RTuAEPDcpumXWX>fAzm|x(mHUL<_M=-zHTUNMj-C`Eu@!4;bie~=2v4PP1*3_Ll={Gof`R#W&>R?` zPm&=Bb)?^8(QqRgzn}CBL$0!kG3g>!daZ%sh;!D#nSb5}E%_!3lts}B8vhWE0BAKB;q({tGA10FeIP|G%UO2@jVE_<|r<`p+mQ86j3 z5sKM5DQIK3_WC{!}3qsE|%F!*~7BFjp$r(IvCK>>p0kTChLRq z`F+hUZ>5E~8Y{#-f~mOqkY;I~Hey4F#h7XE`QGLF#2A!KQBdI*atUG`4)l``K)7J| zB6iO1`b7A#F`bU)!^tQIQZ1xNO6S4IdnCASWFe+^EXcUT*zyyc%C7I0op;kaVOa0K z-7_s(X=M8KO!pUnM8Ujxo^%HA92VUGg3umtPT!c$tR1oxS*$QKnh zRmaVl8@H>nVbw>gx23AD5#7GmrQqEDSA&$pl(SjFYp3n>Z%&5~{vv;1V^$R$;3RXl zZ|sD;d8UD4f>c(wjOTqpvvI2ZW$!a44Kyq(ti|g<-5q2ynYia?D z^OguI5m|Gm*}!vc&q7N>c-)9DCJDr6EH&28>)=d;=D;pka1N1JBR$z_#Ei<+jy_ZN ze)!wR*YB#6f~s)SM4IKr$4317sGEg(3?;$?=ue)33>KSN(8{qijdl<{p!h}E(Arf> z$ZV^EI2OFu{NBI6(93H7xEAbcbUV1$g3XPA1@8F3)UAR(6CW7vDVB*3rqw*GeudJK z;q3cqKa9OomnP7* zM47fxY1_8#N`7hEcBO6Gwr$(CZB|-cxBKPZ(dXg(hdsvHu~tOP$+!3zR%IKH8%apB zb6Nqfhdn{SfGg!Xc6>;U`8&^cyQKF)f$5CM>dN!!%BMnFWF}t+46bV0c(IDeT6Ut> z0;fB9TwD@~hhq|`|7Sp=e;n*}LOUc2*jFyMIH9MK=+mnR0i5~Ct2HcC=1RL7Q69i!3eVtl5U_#10k`6PW9JaElJ$UDkfUtWC$eN^268txG-XHDQD z=2#?sdyk^gxv>^TTvGsvH55nhEBO&z+|=l}SZ|L9Wk*F@wY)mLfn>aUw;Kj&p4`JU1L zSYq=1P4Dc`te^XHcOZ7Z#z3&+IU_9YTyYdo6@D8U1hl$wsAZL3zS#XBGtPvq;QH7| z{JcKa`t~AlovKOsta`m}&i+{Qf3~mPMsE51QWG#a7GZf$J>WJzv2@xhePdfx1MpqC z2~6al#VN|cMFuJi4Jjy2dQMe**f+|=n0UTN7uKi@QKH6C7Cas9`u+@_Gu>24BT*S6 zxz4UzFyW;IKmr7IOOFJZ+GSCUhV%z;tl57P|Na=SC=Ioes$HnF{@(bpu3HBu2|zUS z-A%hcfmAVrS;1b@*TQ{nTVO)2cP+8WQ5q~oQ_ z9cR|kwaBQKQMCGzn?^FaN5i12Zn|e>hMrgd(MV8b3f0bQcYz0Cxfloou3I>IM8r~1 zHMxC13SH@tx6d|+Gx1woSIWOnhknsed|6Z7L5 z{gSDw~1I_y~No0p!Gu!FSS;FbJ(i)KQ&PcBDXbfWGPf8VcsqIibsT)L|| z2^}ly!ILHQ+QOQvWicr+DX2?FNosx+eKS(~p8Sc<{7tSuJLoZdw-K~IezyF3yd~QW zIERH(E25vL>dU;SV4+Ri_>O3x)_0W}V+cuyg8;#v$;Q{*99 zxBG@C`v>D`3$~y1G?n(y<2X{Bg;t9C2;nD0n|lc&cM@US&TY?BeCcYlfV^HR*G^|; zE(Pvr4T>_B^F{lIySNstm(-I?)3d+&FCSjYegufVnz8O#5iDaj>Dm{73pR%f2gr?^t8itMU{kAy(lS{OUPTus^3Gh!!ekoK== z7v%lxh@HY5$fNSSE^I$Ll>oxL@5RAsUm@~tJ%-d|@wFz2lnx*E>&MZJ0{iz#y z3?JzjFO}sbL{DKOQt*!+cFJO*AnX8+8_}|&$u83Eee~u-vdau@+UZ}q#*Xi_nU}-t zko;kXm>i5pm;uf5C9l+kE>~7$TVGfzK!yBcOO|OETagQ^Kbt8~Yg{2pWA%-tiTz#K zQRk-Ck5h-6%SC~nHmFLcB`L$p z_o0&_j%fg?W(Pmw*`7D~XWQrI#eW%}+js15ioV=n`4U2h9$ars9@|vOJJL?POWy=TW;aCBm-(z)f9IN>7)-=IsiYJ0nW{8ET z8KXtC2?c=%$7Q5gwam&oLPvcdWwPuxcSBK!yo((*RtrgI}Ys8y>C0$U^ScA$u|s@z=DVl56b#%lqNA`nv;8sEY$bODoUV#3C&IRqw!35el#>mX3>O=^@zI-bVri`L7Nkwp@vcuh@vJH+74ARhiD z5%s8OLSNHVXDmuh43X`rH}l@4SS8cR)e6k=T{vf(?oDSk-U5K5*SOMJKr!n>&YWu+ z<`eMS5WF9%L6^iAYyg7G?4Ed85c4EZDsU4T(}uc=t4KU)eZ;Ba__gYy6o#=8M%00t z;EA@GLm2Zh+wrFbc@F(^v@zPaNR+$()-bi9ZC*i2hK?MA-KQjFB4Uer|oQNhmSAF zEx`nvtPv2A_aI)#Jdvv=r^qkZlJEX{A_$$*7S`>pI03k+)4PHD5yyrwnSYb)8&_gI!3$DV=Xg)x@E7dntSJveCc4#!Q75%M0iQqI)o1K$u)}i zB}AuOcWMU2)2;P)B6;Q?3Q&-?Keq(W7{yUcIZFQUG6J2b`*!DvB>8xv@+g#EAx9v+ z32ZJ7E69r0ij!kP=qy@sOO`7Xm21d|%hPo3zz8)q^2G%C&n@uT*KIJ!$S^_OVL>q_ zy_-{=o3}M}9$@x71oRim4Lk)Bu@gSl+tqcY`aP43!a!(RaNV6g0$QvE=^cF7vBOGb z2+jh5%6w6vFl#&P&^_FO(X`l()nPHiCLHXl!@({~?F+YDW%fKEPTTD#C&ZD+h6HX$ zqoYZ+-RzysAR7b66sMhp&2z@z= zOfuAnn1eq6TwRXim`9$~p6933d`II5nMQx{exo>mS%#N?@b_KDm7K2#;8|1NO092w zcY#b#aYC0KV3(9=~8Iw<2IW-oO@ z>j+a<%WaYLfz#;kp#Nnh>tZ$8WqjA}<@Xe=t+Qw241W!f7C`n$+Xp9K$1>?A^&<7u2*0=w7s@69*7HTBy1-d@4YWj&7op+f! z`!6V=cu3`fXLC00o!3Z2%b$Iu68r{RGJ)CHEG<*h4=%!)9k;Z@3z!iPy%m_A8tJqK zsm(S5uHb5YN(j6WWTD<5|u-J{UmBpp^s;Ln-N zDr4<6gXQ%*-22g*4&}VK&K`r=>en_Ud|!bl6~?pdh(t``@qrBE?VUZ_R9bh*p009S zs&1%;sSglPa!sS~_~+#9Hz<;OEB1f-%>H-1v~2(PGrO&>Ww$8#k1VQZKy*Eka>w|B zh4HJr(+^CzPA~;y0g}T3Rm2culZr6^`0>$El?M)DH}k zpHuo z^8N>m`h_xj-geuV`xtfj`J%CbPJJR^w!ry|c#!o69*JsVZ zRIE@i7N(Y6E3c;Em7>Zo>yO-t!piaCIJW{`C zE)B&pRZzafvd3W!}-KPGJD&zB5pbkhOJPmT$M>q^pc zO&^UTBz}t9;eN~nSruE@GucK4Wl@WEz3ipQ)|Cn@5+Auwj`5|ofqLif##rw2*6ny~ zSwh+)$pdQ=8MEAlV2os{pksM;Z;_1^hR3QI46zOp4d;NmjanHMY0=lVeYV{zehux; z%IQ(B2s;=`dct8O-%cPZe*`ON+yGS5*wa=KvWEDr$N+s*tOYVA4+FI4>Q7U=y z8V$SZOgVti2evVag0+YF@OYDXj?pQq9YdTKi7mKIr&-|nXauzH@hV$Mhj<_>VzHwe zlWCu3rcWyu4|Zs0PA9=EzVUMC5bCt+nKEM6Jf!0VS+x$4vuVp$J}ik9S`riivN2#^ z3~vsQTbr_)ZHA3aeKDCA)4La2iqk0K{>n9{vt`2A;}0}~Wl~$G+EHWJK8ow6T{Jb_ z;GmFJHP-AMQz8TquB%-xRI-LW^WhuDVG&@gZ-tH!WgAl%wz~<77wO&YkI&_h$e;yg z{?aWWZ%2`?ooSk+ptPS@r_6uG?%z8aOz;-Bhi%jIL=HZ8r=)LLHhVH%zCx0d(_kRm zv1A+GfEM!jthY(kWsSQhIBB@opxu|0k>rILksL)DV5)pjPGtS^h(uGaoIxak80mn76akOy#oxjOHz zH?V+Wg{-USjO1>k|KziL3K@$IwuiMUIvaSrv$2h~M3S&y!il5uw{1(tO)xHdaDJsLR*g#_*lKph8eRos&a)lL?d-sUc~qN8(bcl#c#oPOu5M8N&*{uSvkM7lXLk>N90cV-*SZswrN zx=wsa1<>G*Rr3HglYBYbJ1lucE3E{)fg4^>%91>`@6nH_`f8X~&(~?K+v+&`nIbCm z7KHX`Su<1}gIZB|bMo6QRCL!)AoReFzM;CYH3odd%=q@MDxE>4ssF9&h-J_-N^{j# zD9`?)>mSQBTKYFbt!;@mSn~1v`j6mr$Jp(^Vy2e~r@8j|Y-tzZ!O|^%8L$1de(3_B_tfcbA`9ywb5_K^b>n$*yIFD1 zGe^LT!N_)sB#3m?y|J^{Fhf#qsC;y-6fl z|DiQZo}xc<_Zu`(SxD?Z4WR$7ke8i{`G31Ew*TF<{zXIoZBvjoLM>q<_sa*FK#Js) zitMw0IeZ*E1y&W?0Bc$l7Pibc^>zBa40U|_7LiD;RiMv71<5phWYF2ATe#hgJZ`nS3d7Mr z{8X+pi=Nl(7Q-api$WvQqVq+{L zblR}K;eeL**V_HFm@=T@tn|{Bgbu2}{_qEU&Z)GWtcX$0FvFTIm@?I0C~A{oUUh#A z`?wpdOanx`Cb;+3$(clyHDRq)*asTQSy*!fT`X}Cbtf) z`2L-oHe<0{W5@%y<^lE`70PU)Px3Xs2?w?@HHitMu0&Kg|~da`rTU$?9&X z7A}bpflP0G)vUyIBo@m7t5CQk1qa66{tDi;-dLOA6uQ&4nbX2P#X5r|eP6%O| zeV3JqK+{uqo&PM!-(KiVj791F6Ki|Ne6K7YHm-bBYTH31-DSD4m$OukV=ba6i)Z(x zz_cZyHNBQ-7~NXd52cpv%VPW8w;uv7M*`=VONv_K)m9N;wbm*IT;%jH#SG(Iaq)c6 z>(chQ9!iQ~@&QE=^hEaVtCf8Cr(kySTn}%ZF?3ODTxBRBr&OqWXkWq&NnBs*WNtEp z#)!Y+6ElB2`{&-%DIc&4^csiLXF7|p>+H`|k}5sbOnfy~N^&zxXk4PM6hp(nkY(*I zjZ!1R(>WtpMw#%W|2PM8Cdv=sMBJ(gD~MWr9yRlUoH`B}172 z7{&@G3L`QM_VNd6*dajqteGWG_iL14Qc2<`#GVK>M?`rG3rXT8OnNMoJi;`hm~MJ_ z?qh+?Zyn9rEgW{K)sIY12-uHL&t0pQavnuN(bM8>s4Aa55_Msh3X9*WG;&}Hh1t-! zx@8HnyKk-$;9DT0Z5aHECYo2|dRcE_m6ZsGO%FJ`rdUeZ7RUa!G;+9Xy|a5?)0IN+ z#=sI-rmbkXn(-i~;IkvDK^zt4lK?&Tr&3Nwz`(usA8Cb-8MM}STZhT!`=xqk=&m$q z{Wy70aSB~sXnA&eUHGWTQYmcJhYqk70LKaB>HV_&&1CisjZxUPcTh`PtxHz>;2)-| zsZ|csAKjM828b8S(9BbNVuG~@|M2rRl?JEWW|s8TI$0wiYazYLQgOe1eVlHC^=qoD zhPozH@66Thc55CMT5RPi>r836A=Ue(Hl5}IW*52RDAv5n21|N~k3wp~bSJ4=sfi8< zpp2T_#)I@({W_XSFV z;K}&^A94T61n5*3r`R4k4VqB z;%4lwd6wtwvEJ8;B|9aTc9~73zXZ#2jaWbsF^CR^wnXO>J_4dE7ChZO7ayucfZ}WG z%-_A$!DI67`0y2*B1D=7a&cC4ylWs!9F`fc_Hbkv-D94I?8|nUJ#p&^gFTF&eJpHc z8Ky6iwZ7XNJYOnX;TQ8}f>ot$Kk79#xt3-di;;T2WCm>*WXt3}en)?A;1nobe-Kt! zUT1HrlJj?%()^~NvTEt{7BFz(;Wlru-o;k@3rQ4%wZ>+$?aPi~`Hg#B3e7zsmMt)L z`TD*ili{x|9t=P4Jof0&2l_IBM8;pVsY6B&DTpgZ+8|gBJY%Yd^VNmw^45CCqbOp@ zeC=@U>aDe6x4NSbW;Dc^>DcYsYO%ted^R1>oO#lYs4+dA2x?7}&46j4jGURKWGJGK!+&_Dwtks8%o><{(f!67K4TXM`sIOzPLy-F)u0wM#6khqR5^O-QdWKGKR1URo7MR>D49d15ws$L z!XQK?n6$Fe{;Xh}#IdX{AwZ;qypMNzIs(Ns&i)P>7m6pB{ALrXK_6i`KE3iu%J9GU zX2*BpeETK)$snvHERtt!w9W&eukGJQ2_x9fDlAmi(r1${V$EuJV~D2@Q)=qwQI4Ty zW6sEkuCz>5)0Ng?qv?jD&|)nPorTaWA>0}&0yFIa2@3YEe(ZWrgvztdSd{$W!^7^0 z=p=vZjErrCPx~n>^uf{A&tU-A*u@cx*Sl$|U z&!q+}?tsRJ=|s6-6w*S`DSx}i^OfnjKzEP#zbHbK!Dt39Vt{0$+qo7~B=9pdM-_eq zbD{?W8k*E-l*gK;^A^0`8mB^lUN$OWh}@EW#&Dg4+6Fo$26@Q- z-=R>$)$o@;8m>G~bO;65H5R*(bV=;%8RLK6j)kcbcLy3PVE6wy6q>J&BqKd`-6}$8 zkXZQL8IwLpFq~3M{7b^g%Azd$}ckNi$Y6f-mQz^ zkWCwyg_z8ugA)lSxr~s}Bv3ae<3rR=sRcU!L~FTvM5$Y=yj~0aj?SiepFO1o{_=a* z3p8o+t=KmiD z*MHU9!@|hH_`e6&ztp7DKX~asOZ*vSX$aIk#7WDzbp?B>3Uv<|mp!THluo##q=ji$ zFaNeVkXKk!ae0ys8Op4D(@b=hKSqWtk!M{vcO}5rkNkm%7*_XJW6ji^pOsk;)C#rInT4l(G{gMk>^G zhh0c`ZLJM0D)O$_KzVtGO>|pKJJjURirdr`)H;v!-?R8Il`5uo`O^K;3NQ+Udo(ex zZsUN}-1tiSnw!aE_13YvIpS9M9QAXPfGz{#T&HZpQR!syZ0?QoE?WEYGzieVdK(w* zqqHMg(`qPOkp(r*lYWSs{WVDSnFmTYPEHhT_OlD4}wRZ z;JA?TDIff0BSR{Ek6$Z3bI0sez9lIlpv0Pl*`N&WS&$es3qB6!zG|ZBJByVr05#-t>yeml0$GXey ziSh>DGzD4O8U;9T>)t>O1GBlvZ?B6A2Da`XlEcA>V<$i8{nzLXGQ393DA|={;Bf@V zEpKS`KG=(*n6G_jU2%}XDoIJf1{MAAJ}$8X*t0znZbFCM%WV_R`{LS8VpuyY5TGHh zT*h1V++2D0CGTECDRHt!9s#v7Wx_Cwy;jgeqNV;6OT+^3^n9-U50wPCd?{<+8dpm3 zC8hkp=z0CQKyWn})p3>QsMa^7nLDb9`q&~|Jp`A9)v*lWjD&mZN`p@`T)&L-DVPE+ z)0zWdUvxxSO2>%xDveXr8rxO|oxbSW>7L)4!Ouo=pXD1R0!oPG^nb7E^A<)=+!9(F z6|pDU`y}`37~qHam(qvs4Z`bz7WQ1WWRY!;7&u&~^ujPQob(8C&OGAnC?(v`rSh#j z5}mRvvY!j~eiIuLC#Tjm19hIszZUg9YhmA|t0d~8EM9m!$`c|w!>ip$<U zvLeyw54)ohhi9)FBaD=s2Oo=y46hp0xO$}>IN$TfYm3i=2o5XE&xTqaqFecZ}rmlCFvq-Hc)T8A{ARZY^~}wJ8bpKHT)F10!P@Z%5Fe)WzxzNKNXME4IKd_!?3 zJ~DfSXku?^#{En2HyPzO7ge1h5e#jL0U;N-2boBli*^g)0U|0SpR6OCOS_pmV-V7K zfqu1eZkB`oI{LKE`Ve8gfu7|ShNj|#4<%K=BQgR*(xXkbk{W#_;+8SB(^zZ79<(j` zuw;jKbIW{np|}zj;&Yg@mg?hXE=gthaRI}O%@UT%40|Havk%NQ4rD%kby^!R z(TbVL4bXsbi%*<@cw1sj^#_?pwmhRusIa2ygtn<3VahT7>Q8?-Ec|9H^enR2n?N%j zSi*j$P!I(#9VKK)rTu68+6%fwQx%C6T-5&ck-rJk(0V2FVnj_Kvj#N*a7l((Geo$# zA3<}=3wBcMX zX_ySVS7};tw6PR^I$_!h&m>a}n|6a?_&(e?o-&f(dd@;6^%O$xY= zQnACy!`DF`4b)1!F}ae)l7u^Yo^_WB#T{87l6|;@2+MTHbqZC%srOW&Y-Sg$5foPd zHe^|;NzR}&MuA8kI$~d*?C3~yEr06##Up&7#np@U8L_}jbUS$>053|Pk83^g7Co#% zD<5mwD6<}E%DsDb6n1|7+HW!T^tbGy`v_fTEcaRx>%yCfwih$m{DgTH3$R-@0D}(> zD8;0&%cG-_h-dY0bc~Qq9H<4$EBnw{75$e2O5Kw(N1uoykX*O7zDu1G=uLypZvQ4M z=LA2jiMU#O6_3|}8P5W!Ick@uQycB17y;J=OEr7Be8+Gy#mSt!T(?UV|1l88&c<{q z7;Dh0BG61>0QQkx6Rz?(1W`;xdCbJxzuw$!ONugk7Ee$r*(1uni%cKbfTV1YwRI>! z+<%xU25aByQPD9^L}QiS$8bDhP7s-GN0Gh!>rm{B2Nan3NH%pXFe0xKmQ|luC>dnRGo9Y;5BKy!ao$s_3ih2N&$_vq&+Q&F z?3S<3wzpA&Z%D3&@23BxBAEWG0y!3DmjAQ?)yRw6K3=|Z-Tt96&`@?pc3K6#uD7>! zrPGsBN!Y&sF7B4!hn{%Z(yytm>s{PPcMJTZGa57wUTf>zh{iwptl0S;wW%Xm9WH#d zP3Ur&wm(>*N3r;{u8JGq(!1!TmcIL%=zWmEWOv&LymOi4Jn5u4x8!=Yo`SO|B^CrnkX*7&)-|y-Q=ch&Vz{3N*a_{6_$`xI4R5~%Z%z}Y+0s`7keAavVUu0b` zsVzURcD>%CZrQGxnn#71lttS+OCKS(4$5NJ@zEkR^ssd zwkk;!hb?Etww(4~tSx523(hdj@^kQa-=cgopoAIC)xeTHfj93y zd&h)$&Av=l+8Y<~;y{qnwvqd&A7Uhot2$Fh#=xovyO-aGwdtmi+zAH{GP?Bl|1X+*`RrH28?!zY76x#5XPDg zz{jwgz^0(HAN-*zc`)1oKI$&xd&;_?_n5*(GnNhF=avY5&Q{?uTM-5AYT5a$d2O}) zC_PnUN(dkLofRhi%G7*kv{u-y7onsR(~sYzuenjq2SnHmX&hQYMK~dZ3p$%%rn9?) z@Ks%XW`)-QoY5rfP1&y=+m)&#~_?a3J`m8;Yf>nJ1i|#jltlQN}!uPrnNmXPP?$xJ4~e1EAa zs;aQ2O1Z%Uv*tluI~~dGK_?8>gVLNnMtZ-PL(Q!c?K5*i&V%Ie|6@;_h4TzR{AxcR z2I;H6Ahd_adD%`XdUYwYn%Y(k#!T3EMx@d^E1jo#ZHS0j zv=OFm!Kxf$rxfzycE$ou{EQ3jG$Ee7aTku}S;CL}huyn?Q8t>1BuF1=KBL$v!~?}& zSf0^}a&A~Ke>v!WudN35R4uhT7HbY`uzJIOXz#l!o&n4rAydH><;^j%`%j+57nA;> z#(bndnAVdfRR@}uQ;@0sd;V8XR>5eRi6GEUp4(0s0IUswm(9DtL=^xr9(kBQD%uM!a zr;8+ag58@jd6z70*KF3yfxw9@H3V*&5hYQB)CGj0+L?3Y`5EXus>0 zwG((y+D$TgEhTI_NaSY3enJ20Fq}tG?rPA3!8yoB5~P{-+LUTNz+?|7iY+eXL`Sx| zrEe_?Ju2S|2DfioDAOa6?`Z;tCVKRwMg)F$^y6o` zZ+TbYXf3XqzXzqkAm{dB;`T|u%TcPH5f{TPw+M-I{B*ScbX>f58cBW!gvSO9J>;+CrU9Nxi6)=PZk0APqF97B^e4 zyCt9;JVnqZ^UHfgQTXAD$ggm;IHbE`^L}YATAP?apg4X_uqA`lRF*c|txe{)i&|oZ zbreaHdimW}F{XDFwX;AzE0=NZ?}Hg|jAsr{xrA;9sh2!}3~XzkDk3^ohfZIy{(#`Y ztrEqP%Q+K@m`xq#k(}k>(ID6s!tp}!_n}0L+Tf`^4ybK>WkE*dt3xR`op76KMypZ zOG<;~6a{}Ryk4LwL_rTqVUZlUMEFv%2E(U<0@SPFw14#~7>^W}E49@$yqh^Gf!`_u zRLpL7?YboDwMe8CW_7L=l22OWH&Xur1P7<=`=7`JwRW5x$Fl0+rD7QBM>2m4abydq zFnY+CYMl9DntvY707LwagMD#J_~6Y`07Gzp2fP$gV|k_krs!SYsL44wue_@eByD^~ z1QxNY36KY}F|ZiC4V#m4RLQ0VyYWNG-66eX9pJQ#a3e){b@#@rVFUN8S!9rKWIa`K zC^t_hgU}?hNvQ89748S>2Y(+pFGWK)-C~NuDgSYVf-lnY5rnQDh2hEpcJS>QRH6wv z$NhUJ^ADX;!2x|Qf)!%6t-Pvs`Zcy#_qefg+90RLD-GFG?T)9_keKCC*n<$aJeanc ztjskD`5++9!@#M-AY>G20K&sUMZhwPMJS3Ggapo&a_!J-ksjwmxi%CvG)ow@BpqbQ zpgU4EAE^fRO$^2Fo!!TgGKXR~ye5iI2t3>Iept*KoH_~Xt!i_*4>WrjdQKAmVDSb! zQ-xsS53OB;d`!JUkTXPj>?C0E!#m+TP#LaG^WGuf4A2_WAxYt`hD_g} z%nq%=H~Uspl@dc3Qtsb}G8+m$f;u4Pl>nWah&mudQ1F4WXn8CPshzL$V3Ca0lGuVF zJAsj^)Z=x0+m~SlH|=_eFoHP}noP*H(Ijh;Mp**LwLeZoB1jNC-l8c|OVQw4e$uoo zKvb88j9cl+3f3doILUG?k0|$l^Rt-etElDJpQ$+7VWrHUgFVpLn?*DA?Dich9CXZ? z7!>n6*n6(b!FK+dGIKD0DkQ>g_{+x|dv^53au!56v1O0(gv&h~hoQ(6V5iLwTa}K+ zfI?o^JTP7JFggMH-2f&FkoSJRMw!6PXhNZW#A!zAUKrhjzTangN5WQht(^;9AsK@t zd0K`3%f-i{rvNWb{Y1XHWi*dw&mTP20ukLCnzggUb9$&uUA>xT`{6?P3|@?`WVB3!-`I0V*kB{v)uEd^0wpD23ff{|D-yXG4!R<><-PcJfoX6w zpf(&+I5XMMx$CnpC3ayf8bg5X0rcri`}8hJa_cE#uh=(pG`)FP)~W6$OqIb<0wwCb zC^Kk)iS9%o3I_>JN@r@{n`wOGE;3wY=PV6}+M8hvHYy3R2I}s_QKlDIVTFvkf)L`X z1qA$#zh85L9?lfwmG^Do?h%n;kl@zM_iOqG7|B&i?mx<$|E^+^gY*B$oPS&E*#GZX z@|x7)AY7|cyeggWAM)txPEf)F*p?hZCJd{d-GHO^_B05b#arA zBy2q?j~JZf_;FeqDtvz3d-;zm_IY_9i!+WkFFd%#3DME9B1|bl$%?UnGFbGn*2|05 zwYAcDlAAQ{iO9mzXfyNe#<^sBHabh4T&@zN)ad`i#4%ouk8mAmxaobyx9J}@)K^gd zV)wq4b!VO@a^+I>Ti$j8Ml{~=kM%ndN2ijgdAjTm8v9bt#m;R3cWkF+NC`LlPjyHM zyba*x$+2P#qndyb${_b4Yf(XIK&9;ju1-Oc6z)1;-h2sMi&*>>>99t3bE`h zz{;cj=vV7?oz+afkz#N~6KWk6rIWc+tJK|vo2m2UToo<>lo&-hrwt55rL!ubjx`f$ ztJl#{JKK4;!XGL&Bzuc39vk_IJyZIn+eG+B?NjMz>?TJMW|Lr;`(s?qm4?y)xvBiU zz4`JYHO~hf!hgxupPH8Sdbjt3gtiUZOx=E3kQY_u{Jzo76Bjw=ZZlBHFUWKkuB?_o zS5McC?KAC~VfwA|HgfXt7JWtmon+>(>sdGZnJhf#A(<6c7wN=SEQo%@eVY)=v;tQ# zOq}!T`%~w0Sf|L?zZ7HV^<}?68(*K@Rx5#LGuc@}#_!us_|OTf@;P%7>gM=wkd3}a z(EU`Ad<*l(s=hG5iRI(h#7#P$Tr?1e=HXrTAU4TTOx>Gi?tY#tp#)XyZ0aMzOPWr< zIWd5X#Wc>8`D99Z0ZC}Ndt*`Y+dDeQ%Qm8KTPYzS0!yho4MEp?+gk+rqK|^^TRIIa zt-SI!sF)zra_0$Zu(EE+3Dz|hwC5$4I0k-yfjj^EbVEf-T;^N(m=26P&%iWB(m|;K zx|vV-7h?GgUcyn(sE8v(?4xPDQFx5&AtpBmLFi-C;X$r2B9{>#F&83U++&vSIzU7R zOry~;CB>c{;Ug|n4H@U0{^I1hNE|3_$XdxB5Rh~Xhq>&Ls};wxcEQ;p;Ai?W++^>H z8i7fK5(y&lc?=`|Igta7li&Jc2SCt<^J+d+X+_jRnRvq8gS?ZXNy22hgP{V_mFC~j z1A7EH+C_9>3{z&i_rR}?Dpc#isR_6{W0ru752i7fV0xm~_6PuCb_9(pVrreft9>f6 zY84TAn?Rs5*O}nqprlnK>ogG{L^nD_c7DoMkT~J6PV#}DN75d?BPQf_cO49)zlQtW zT2D_^rx4&mUe*rMd7?HWcqKF!|Zw1teQx|bX92U7I+ZJ$Pw22|t}0ajN$X&KQv*>Ohi4ZD^isDD=476|z7=KKe#M(;pa# z^Ey#)h-1L;8?xz?&$fFuCm84g@J?@MXr~D(nsvN(i1MN=UzO_qxfwTh4^%=aNfDF7|Olb3|0)46!$L1fj^p_ z;YL4QXp{uqLd??6vI{YkoYdda^4RY^4j1V;3sy@nUBo9aig-7@MvFW?_C|{=Y}I5R zKrh)^J@sk2ihZms{S|J;5==%k88O77+Zt;zRgOdXc!>e>Zkez+0-_VIkuL^c0dKwt z(C<04KqnN}nP!eWgkN;iodt4LM2b*|%Kx4ysf93}kmg17Y*8p;?WzmdRfivX>xVQ?)QLbaf&M>7KHIIH@(B2xD8@rGRrNN5t;R?c`nR5N)9|nTBMR;iqpvP^(n{#t9;p4aqJGOmY1Xw5J$YtxC#4z7<;Go%%ZN{ zHhE&(wrxA9imi%m+qP}nw(V3@v29yB-@5j}`quRxya)3yjM4j;_ubkISCE$0B*zGC zu$Xc7C-orFiWhKsEe&GPaeL((?U-LyIhLuG$THgLpUH)lKoP6ePLQ4ar#^~jx^|fJ zI&*GEx8GR_2gE^Q8)&~a((Hy=WHXCZYM|(ruxmZ;A~rI0V2)$~2Dfh34$r?CtxeH` z`1?TB3wOg5&E}VWweF=*n8FGX?QgO$|nj$UO z##{9ZhsO24aQosRXE^dqF=xiT9yEG`;FFT;3w(%~cxtudsWPKqZ)lEyy)crv9UPAdBi$S6R*t6=!wq zOUfP{n?lQ2E-EO(*%`DB?Pf5Ib94Pc@1?(I#Rk((W(i%?1mc9wsC4?=bDPSgqa0@8%rFhw@H# z-Wn2(q|Z;WEEP^A--CJ6RD~(`og_j=Q!xHw8`@rao45N~_2(SA2^5c-ymS&0U$!2~h`OSx z4;)n%(Ac8`bqurxYwep9^&JzQ1KSB(ybm@um zq)O(~tP#gNvWe*^QEJj9>*Mo#e0;$G(nTpnm*l$J-Af#g`)iq=@g3bBCfqO6%uo0G z(f4UrfjgO;dSaTp=}-H_bs2hfqRXSNn|oDA_vgt^T@EcflPJGh`^V2wU$3@xD54f) z$Gm=B{;x!EUyIq}mj3#Uuj(s?rZ*AK)_s@G-ki##n9R$ayeq&;Hf`E;F^JCoC~^$1 zGApNw?zy*n0hCWoYpnA!JA4wDd|iI)rTrVMzVCBkR(vr_3RJhgMoOn8{F1#d_4^h< z&aL2p#xzIg?M?mV46qm1-?CmE`qB>Wzg75OKp@5BO`R3JIUyad!V9B3WUYs%nn)ea za+AyWgoq5xZOwI=cy$75S8ELvS4h&Bi!ywRhvi>#T#G|Sh(gc7Z56G9*BcPH3`$qb zM|#J|pwz$(2C8WA4}1Yh>_1mAd#?Y*>53>FKIR%~tUGxc_)8J#@tsz{A2Rrjo?ORVcJEeM-p2K8}h&nvY-y&&(C>pk@oi1wF zsCvw*O%6B@a6*Jg%$b`r2@-jC%7$O&LK*%%qtWW94PD^Kh*c-tTD=zzuU;(-l1hzS zn1u#CLe~RA-28dK>X+CNjtdplZQh6~mwZ9tWghe+`};){kbelbq{*lXI#OZ1j#okN zrFHepNFnA=l~MHW{4&soS8{!3vL>Y-EDwG`Axi0Rxr0ZV#!SL}U2E3mR=+{B~&jiQ8BU&hhEHRab=cI4$qTPd1YTTg79yhFbMi zhr<~h)ko=JA$;w7#(u-IL9mjI$MYt_5^IFPnt20<4}tC6bE2eYLEU%;T@$+kdgkNo zKq=OA;(+F z^F<$3$dc&!3;gH~RCLx(Z}OXk5qSVq8I}UK9A~^@aq8fSuDya?8Vt@0A`eElaL2lk zd_TBQO7^xDNX_<9D#8j26+)pW*j2B5=lXNG`Pntur;&fY3*YQZ9^b5=$LV3OjbBQF zaO;n1RfDOKeOWK`Ip_G;r;pi(qSUaE+7n1YQskc;E)1}J;=k`*QXzh94kJ|UgCuTb zUCZudcwGsUtdck!=sHlYF-8Cv;-IdCKNj6@s1b)*vnRQ{$%4oJ0`XqM2M^}R%g%ON zY7sY3o3_K%7Q&2^#?sc*&=xlyE)9%euT$^jcm_lSN3}+cScdk3YH`2=*U1|}#YWOY zOf?=c_`jT;z5rZ#lo3?JhK|-aO?Kwciuz@b8BeM|y-;eUH|P&+@@SLJ+DUy4dXs}t z#od*$v7aZ-a`~JiF{@C!LM6m*XY@nFn=(2DR^Z_#kbr|lM)PUuR~79{S7c72*>&bI!6EC{PS@Uahnz&xRrgyUm9 z3*&bWR-Fi2!Dy6=22ZQ7L+UHZ`YJt&cYZ!dGBYHL(s=A^jybhy(ooT{DQ(yMq4O%^%Xg;tK@6ad1JJRy>>Pm+NqLV2Fb6J@->BQ3?0};#wkw+ngt^t zBt9G@Kn5>RO>Ea|tht{83CB_ceV5 zn(Cgq9TEYWV?SkvZ?MVkPI?q1A`xSJe>(|=K8u4wDTO~sum0ikt;VX(Y-Sjj&QUL$ zKX@wHRwE#uq?Qe^^hASOqNv;p^ET?)Ke3^k7SdXiZa3!+@gfnD82#?HyYnej9ZPR- zKc()C$n;Ip^@m2OEs`%HxRT$98_Hg@-8c!bznL(AT`s-*Samn1T~u~yoCSYb=e20u z1(T&5V%Eo;J+h~0!`%f)d8{$G5_-`p zCZO+@k)6S@29`hUwM#+7Hvf7wkX(odvleGy?~ijUMmszl48-(-x?(T=07@q&RPsC2 ze4|v1t!L+g>w_X{uZgJ*G`&uThxw(iISFWhJ#RMIjxz`9=OulpTw4Ke2PmQdJf2QE z?M;^^rqzF#t~Sr(L)_-*ajX;_{AhSjVw}%CYtBwy;j_os=N&>aC&a~rkZQ23uOmuY zGfD$n!LfU)a~IC=mRo-+in)}6b20>kF>**DT}sb5v(|lX@~<%i^q1a2dQRtKaab|m zMd9;k@VvB71D-&Saia0HEN;sW$V`qX!c{9nL?omf|zLlqEiMVkr-P~h66dL%UMh9z zd7h036?OYWT$@s0Wx|1{y-5}hHy4Vdwo8z_cWa!^r-8e>vI9;S2CDF@KTH91oVbqF z${=jZsSKU%$|*zdM=M0h(YJ~Z0@*&>ziP$*{=u(LDyz*c6n-;*%EHCid9cZ*7mcTD z@OIK!-C?=b=KJ8{a3%&1PjIm#ZN>AeDQUv8nCkO`cash4t`MINYh5-K(EqtOLIaGDtis%Ildi+&B%?u zzPrGK`~<^DowT7%WcU#T?vL{bX`x;ef3fy3_M=JQsTsaIFPSWheYIey{vDsId@&X5 zB0R9oUoLTn1{+URXjhC?u-V3_@0Ue8p)j5lLN zdz;vtIsNM`XE0LK?O<9!n&u(20-xUc5 z2;a|!*N_8ePdT0E&$i7f_WdU=WG!&B&ezX&QrP(%TM7(3N}hsR zCrbEXr{e45^q%>~=;V_Ui}Xbg%k}OUBIN$rukd&;^Vm!*tf9@Pq6Jw%R+)m1iBhrF zA4UXsgDKInbbOX7>^J1Trp_UUIg10gcm+aJ3>Qrf8#vWPwDG&Gvn{_Ev_QRs;C`Lc z)+2}OxnX%jCU<}O;I|oS2+wOERM8y-jW<@@^rRoGZXid{EJrKcp*F#y(h~_()v6u` zrcWr#Er!i;-LRFNE2*U$?9tI;Gzk$I5EK|!B=}0`a0;reo*9G)e~hfiF)1CkOk12! z!Cs<`Jq^b9?iq3#MpM21lhuL9O%&RMc-0N?W`VOtf6@tC2&Vs8fnbrK106|Hg!=(* zGvln;{;|2cR1wmzjYmLgiL| zF>kK1DkP(OX;%0jqPD^>;!Z!_uFj&5c|X=P=xY-dLjNocj4aMr_qbKeFugH~r~?)3 zc)brXQG+K@aohpnNq!e;eliGfmto*@oLy@S$~oULn8C&p-ka8cFZD-IM6J0dD4)7>(la}n#wE? zbls&Qys1&kx$-a-<$rv!2z6~E(?kJsnmuTVjE1s|;nIxZ7SL%ya{zKAY6)E7S84J^ zDcZ;%Cpn6MYd(stIBRYx*b$>Z+=!w#c}l=VnTl<6@qk32qtji~43GwG-PVD>HM2uD z7FUs>?ZH|oKZ;1ME0MN96W_&_9OW_`xL*l{+G0QVBNyicA{G0`w43r@CEf}Y-U^T; zCP-uQPmwud=B}KZJ`e;b=xE-sJ`jOp{Un33*b1&kx^msO6xPxnutuGGI%jZipFQfhhlU9@Z&Sfj6b~>oxvGF9FX7I`TL;z~;rrWlcAN zpQqNdw)*MH(`9N8UrlJ8L+3!VFGVlcd=j0{Y&pI>iNc#`N^6E&nV&uUxd-Ww#hSqFcbmAN}@VzMljbESvp zF!dO#eQlW2?xPjkq`JMCUkiKlj+vah@&MA+r<#dbTwtJp0WN*L2oWsI^cHT2#sO>~ zp$#U7Yy$~zG7UNix8l)sGNX*7e)=Lsnqf4XM$n(;(Oaam7UWrB^1~f6l>Cq*@`1p( z-HvN^rX)y2dko37Pa@G&dXqGlEb3pBglvZCy&FS2_jW5b2$WH!@`nv|$%2LtQa-k> zqtFmEHHns5Q56D2kZZ1g)DlJ!QTydKsn%8wIyPkTmIKy?bHqAo}GQYO25*U>^n>d)ZRSo=Q_=QLxXjoQk?g&YRES0`2l~u?N5YQZX1Du(1oB#wox>&z1n11R=s` zkCSg@pNRhvv>xZCYyEn_r6wXx9W0r$wMb9wV3T*aaX%sMMyxGf>{loJM`}MZ{v67m zAzBi#-iWT8Cas&?j4TgZCcT2FrnhFiN3?r>q_W57EC6codfs&tgy9~7@kPy`i6Z8x zlSG!(IN2rWZC%tJkSdtNIVk0o{qAnx;FgTBj#%w95~(k*r*#C@i450wSNSM>FToDc z?IrA`yNFT*BHY|Qaug>h

    cPAP-a`=~n2*{#Va?R}MM_aU{>|;i&{lkC7Kk@A23f zCf(`P{AvY5k!-}15uUyzNfqE*x4mfaIe*#d)2ONURYQRPOoQ+4KKG2HHdPeh{9v|&LPMj%Q{Z&5V0K?H<>#v5dCph&D7ilf1eycAPLotd z{_Lpfzv-2XTsDq34kr6eY%5f4z#GUxKVT5bBYiPq-eu$|UnML*39s;USwlkrfG)E> z7S!1z=xQ5h0RWmiwDoOAr3^6HUDxl%aa>J{6x>#}F}@&+>d;c*zjY|gS<%x|#$-4L z4A2L?tquoWuD0$ofNfMCgRU@8_NM0#}1Z(q3(`0T-JT3t*kqQr7$@hJDiq~3k6zT z2za7-e}OqqCtt)3fmh`zdrbps1K6?O*_6&n@%jDiOiBl4`o6Rx2_3%-r1ZuqIfVvs z^8)KmTHXwi06;sD#pfrpWUAJjX}`v9LxFGZT4E%+PY7nev|D+&n*|`!JkM<8D;l6C zvzJnclq8O;*6++GXuL-Tn}W|o1a zS+m&PLfa=5H^mn`v64r(p2KJM)sH8o&mWWzHp&V1z;x2BISwLw(mMc`kjWqybIu0A zglHk!h>LTSl)%j#5qix}@u#){xm%cQIUOM5>HZpMpDu!qiS0!~l9%9gGbtbZV~3R! zTE9+rEK3QG|2|!FnLCMvHp@Px5+^7KT3{i*DMp9c=XfXch@AFMnJsjX2no8#hw_LV zs+c%7{4?yqz$*CLRhw4or(7v*oNWpF9l(tzg6lF$MkA-H3+s}^m>Hm_exK#R^`%!H zWN=R~d2)~{k5od3pl%`cjMGMp#SGycVK4t}!kO6k3hGAR$0K!8^b{AqY<;q65xY)n zG~M@%+dc@By0{~@4E{_NA}0=ejIoCwtVLl`3u_!pq?(J1<8nWj&QY}!kq^k+jFk>qWOy6;0z} zK1bouW*;00*`O*~7MPKCND+SCL1JM)#)nqECXqkaYu}3^>%*pxw}=K8aWg%*M+(;c4_7#*hy z*zHxn%XIN8EHtiVN!KJj5U%|V`dAAJo^v}%qQHvb*F7jN1s%zQW6955wKZr5n`8s= z?S@qJSPf*;v0=}bYU7Gu!8VJzM1gb6=eQ$FCHAb( zDRsMf*dLFQZTP`wE%l%ki_0)+IsP5E^MrI6_>hRR5LMv3#|7A1@8!iB8P}=aA5A6e zarZRXhFCw#haZ-(b~;E;vL?|Qq>L{3^HnvaOqN<}m4de_PJ5WK7aw*Rt7goJzwOCV zmqbMtTC4$|nJsk1sqR{!&hC`P*q>9ZUFJXm_-)tO;5X5|RhSAd@b=93;=zx=%-5Xx zSdqf`_poc7_^kHRdNf?2%IV_-e>>@DO3QW4;h1R0n0IPi(rg4N zYMmBxkFx*R%>*^KDu}!pO+fb75r8)5;ruF#!==bqA&9_X^Lt;?eh-RY^|V9us{tR% zouov2iFYZy9rpIi*o4e!+6&tYT0C%lf%HfJ2G3oPq;;LfxS7P;M6CFj$L|y|f&JlP z1I>X#G|erj0iwvVGf#{c^d$N6Y*7I?4)IP@E$q|x9%|3Sb^f4d+1R!mw0NAc;v0l> zhj%LvrJI7wO~&zwl5XNWCnu@xxTm}ePdTWk%mY8*Z(lNC&veWm>%Rar|At#xX* z_`!WOH2gDliEVK)Tr^ivFg$ELVXs_-xL5ms;T|XzBa_}qMJ3qmhm;7k1QB_6x4$0l z8a#(Bkrn~5;=^)x}cpn|t>#>~<%n%h24JAcbsdVe2P~_4_Mxj1s2&|v5{*6B)(neT78<5a% zWnglF0iP+t6713IQ#%DgtBD|z8%P73Gx`=J$f9~&&O>->{VH{G*pLngyfw_JQG0xr zx%MDoGRGHdBo(4#(q;f3Vc86+Gjk?5hzYMnqz%1#GRtGEuN1Ol1TpI8px9D~fKQ?q zUd!V5113s1!a|JmhoY~AqyrH`b;b8O`Dh{^IWkVVH3riOThi}22vvYve)-r{eL`u6 zVEbX|(O+Euh(S2N>C-xR4=N-*`t*t95pU3yM#(jMYXFR};x-b`Gl|O;G7rSn!y3Z0 z4_aQm42f>cWe0XZhTjM9b z)IFelx_LT0zy(B%{on7S#>5(t1;~*S zEqIQ&^Vmzqpc0UcDL0rtvE)l1TcL193k^Q^|xD_cN!rJt+pA5`bCdH&>PB4Y#X z&P&-&IJR|zLVuf(x8n^CA^0du%Nb8l>Nf7uH*nBtAIFcwqJyh z!s2XFgFFqm$M^utAaf~{LmK*8BnYdR1wR>DQ=RBtGNd9Rk|TdYNWY-M)g#T2+|?Xl z>B?`I{KTuTqR$o8m(~BQuw+XQzPO^n$IM61ewR|GC*uo0eXQ*OMkbFKzISRwl?czE~*1my1giIrc~{x9aRa^mO3fe*zq~~Bp(awI*0Z+ zrQ0k`9%&#!m45n;6JJeuKF;FE5Ws8aS-5pd9cSByMFh@9Bg)1cgX#Ld^BuQ5V=k~^ zfGBC4ue{DG;SrSM=Su>PTfWvO6uumiIXUC#mi*%m?!^bFjl^RO--KppBGWy|@9u_# zJY4cC6LJ!B_$GxX|E@@XHTt6fG!UgVBF4#0<6*&3M)rA`f*)T~|EV^^Xjmu7D6K(U zy`2-Ycsh3{j1y~oR*6p=iWO%l%#mxp}7a5QLd-lF8w_?m5P)ncuP4GF5M zy@idpa#V$azoJ0YPG}k)lNB8<#}=EB0#9}qmhUqfa>FLhl}7|3m$8EjKd>|p$QyX% z{b?b8YjcjO?OrP&3;9KIj;h{D#kBzmQhHpe;ic>HtsxggmdkyaD!z@Eyn{cbuhhuT z&dTW@PlCRIMtN3?I_4|XBLAGmcv;Sf$j>Bf4*z=5?TmOJ$X8QlKR%>rFD9HbemWf` z1iC!+$Guj}&ppCxMLbmKs!JStNrton8z9q(Y>sIR#}@5xXP}W!9$OEdpW+XH+^N2$ z#R2~CCmI;4xoyUjk|S0jzoKm#?Ue@(JtOOv*GNU$vl$|1?p$wPU6Pt5BK~PGd%iGe z8%$msIdF_v)qaSIix*>6bNV!9!gyA~DAs<1-SMhE@%DCA-680YF2#gz3O7KO+Vz|@ zt&I*H6?%`_mD*-yG8PjLyw5DqPTvtXK|oc$Rg>v=fo%|ZU+mE}_ZgUr=M{XY=9ZdN z(R=>D)2#?Vz!Io1O|dn9ijgRheiS074wEj!A%@`q*Eid7r+cwT<9F3%aQn#!MyxE* zv)h-~{=d0$m&8J)DloAkMw1i>OptgQn==u{Q6;bMm<0Sw0uz1?_UJa?Aw;TnUr*cf zBd?~V5x&C_axDn}=Nh3tF$V_0r8G^DV37p*8@9K`EdD1@aH4Qe=|HOOBUJs2qjX+AS^DMCPMPPs)iq8!4_RCrt&T~M&u-K2&-!RvbnBJXrMDH(&0b}YAxSx=B z|MI<;?&mYRD`2Q9crdJOuaygjNOzff+oI%Q%MFh?>o6{+cE!SDwBYBi8|0=^`F?47 zIk)|SVWR|I`HySHf5k*+=49pif7XouKgf>>8Mo3GG09OpPM1jg7Z`n<*n9FIul}Hg zxnYrJd?B6hptUqYY$74^N&*>_5A!#w82b6`l3EdmfbCGoVD1X%&z@o8yY}(rbN`9p zK*CAmM#TOc8a>7#TrYf_`F>`*9y@wxUlFQZlC;)=&?#-%{ds?^ZF2EM@aTi>>f8Ih zAPzHF)xgN^QoiR$F)w<8Oux8rHA&@${Z7Z$x|4z?hCf1uum#q%yN?+ zL%JofX2T}bQG&xhd1FU#k=+NU^erj+cyzSomLDiOR>YAyv}lWzgU~GQp7q_u;&+7} zb1RI>Yr3g-(us^v9lbQH0UVoCb$P9Bk?-6iO0{aiXK}YfI$jm}KbN2WaxtkF7amp7 zr)2W-VLopwN;7yXU&_njatXmn<5ygh=}bEH0}ot9S_ay1!3~$Ac;POo}6_J6>#lk~cxl<-i=AC3V=3sDh(mu2rUZm_EY%K9# zS7@2?u%LAl)5$uD^A^KKNd6{P?^K0lXS3RmX$cUj6jqD-@^Z(({fbcCbV>nclS$FL zxALx!e=p`>VE$6|#l}|lRNpcW9%Dz)qEK7hpTm2VTFstZ2!pZgZOEvxy*pHl<{5#} zQ_9FUe52}N@56T-Q&#l4J_#@nZsU^3poisvfEin-tAYpRRR!aX7&0iRe;#J-iV5LJr_)qPmBK zdPnxN>>~9KG7=9MUOdOA6-AO+T=28Z)|bNAn(`kT&;zWJht74;lS<%GPJu~tK?{z8 zI{xB3d_qXN$?R*&gD@!X{enD@ytU5W6!Q%*k!eTS-qz;5x&n*c*8}g{=&m*@J_O!fJ%Z=>a0U=GMxrMLm%Ams3+ zCK+dEBI*^I_V{`C^TD8UgTBH?yZYdw?1GU(rZC<@iT?b#E$=P35*|ZpDqPCxw(m`a z|F&TtIp^p`bhvnTXi$YAOZckWhA<2de7)M|<iL{=OJOQ<8DRb=V;?y9SunpG}&CatQ(MYtoWUKw3nl4!1tdrrPe%*88ms$3361 zPCmu`2SE^HqpQN&tXT(x9NgA`rsL3x&^iC&EGMQ^C3- zytulXdDepIZ8TeGw|16dQ!U4#N;0V4Q5QwBV6k$|Ht~WAa2%L4qz`|YjIf zfhFrl=ppDm>{u|eA!B~OSn0grqdGiwG!;pGbd_GIz-5tF(aiKfekv{OvTD(u;6G2z z>*mUYT<;m_aa!$$4b70y^J__pU*P^&=+h_2bm0Z({3}g!;pW+X{`OyHQvsII&l}zTCn@Zs=Qlv93Z&y@@&C~j7lEzr&08BCLIl5;YR0QzO4@E*zCNWUh+jZSltRu6@~A|VVtts0oGR)~iI z!GGm-7{f4vMfL)$vAbTsZvHq^*-;waKkq=|AJEDknRU1UvVQf;X9z-uetk{RusojC5O5)#_&y3KF2xir-Jx$5;=`pn@|K$#iSbBWD=+$}id!QUCoc2v!7R z>g9GH--45p8J^SeDl?es3JpVU#H2=39_>6{!aOr=Cc|3Dshze!S{&7JhZqp%-1o3fs>6LV7xJgz*Sx)C?tIzP zHY8$Z&@D}2aKFknt@j}`jM}$l(NO|&nTqx<1b;ZxBdq@lSmoO6?(pITb&P50)_=uN z!#AG}BEB)n3c2^;UWjRvkl6N`TqZirc#S%R6R3?Fslfm%l$vEvW$eA?(Pf)^mF(rV zQd{bM7nBobi`6ep2_J zHo&MjF#~CG<@>TL28>@`OxFUJ%Sa9hXaLaDdn=5U&t@20sIP(2ua{Yl&V{4e*38;M=yq9D=lA>0AS%11l=noLBfep*kqo%<6 zc(1WZO#$G520~fIg4(E&#le`s;H^NDR%`$~ZH;n1T|g}6KLdQ@)xCDBT6SoNsr}Di zn~4?4Xrdkhb$6SLe`1LwHD5cb+wg|oa+bN**_h8uCr$_uThCjji-S7?)jsXF4I{Q! zu}d{iR!I>o)?LJjVjEleCyqJ!qVM`e1WlwZvaFv!P$XI3JV#gpI78p9=;N(#r?c~I zhEoO%X-WHTfMp#wHm=H)dXpM6pL%&UL5eDMUim=lDEzV=jEcm|)SYu|zEp`bVz}da z+e8nRi^{dCwmR%e6($C;Gh(XcK+Eznt$KdoKmtc9;pc=s+8DWIFn9>m;t(E`pyCsUQy3LMywYZ9g|j$Kk;+?cUEPt+UFdn zXcN}0Sea)lAGP>h){f(-X+jmrG3d%Bd514Znf)>ht62ur9vv_vG&KLPY&qrSiw0cK z#iXwge*P+d%vY-kcy0F|c~}U0owbIuI2mSdWBU<}pqlB3$S`D)kR_JX##7`#2%D3? zWI@P&g+ap~Z!whreT47qxxJk%j2Hod+QW95N*$o;AYlaO8MmhlpTET+n}Kxd!&MK= z+TEdnMWJ@(p-M9XoQxYk@ySBo)^mA1(2s%Yr(bLyz}-+-tY3WM%$JE-@6EIxOSYqJ z6N(87^KS7BPgoa*dLKpihbjw$Q_NZ}9+m*Yw209KFJ9!6(79so{Ka2wfKo>{Z6xop-Vf1`} z0AjtN3_3b*IEtYLv&|HSisED)laiverpSjoEKi;5Ua;m)uqL~Ps2a6CI4N2j)6uMh zNCD#nO?!T=g0wrG2r&*XWRwPxQH?Y;+vIQD4Am0Q6Jywu{ndQCKHyFLxycl1v*v;^ zGGF9&Gn(a1+6%%C4fW4%9H2fhUrh#jOq3z8X)=3%_!Mj>d51ngu{}My9W<$0y`_pC zV_gvB9ylPcM^Z1hs)rhb1r_2!>vv&*w*{3Vb}|^Q!Q(wEHOyI5%O^6nZ>%D@(G#dq z3wDy6RALFfH=n9Zq(#S)rl~FbR>W))jOV_Nq6AIap5+;&MbKH>i7MQrp~JUdr7{TD zcq7P+&gV?^{W+w%#9gYlcR;mAs6E%e%ygg`J0gP2^drEuGz81wHjN3mO)n(%gL3_^ zr1QUGj;CV-$952a8*j*-Tdw&WV$q?a2!&N#G+8WFx5Na=(3n!#iM50feX4^<%Rg8s zW~RzxTY}$n%eeAPIXnIgIp)_7wE>RE%s0p(GIsP2yb#BvqOLkey1a@yBf;ZaUiIh+ z;d{c`IJNurV|%m-XWV}s(iJoMvZ)TPDw#kD_S`Oyi7o)T%8Z2p(pSXrr7r$1D|o_0 z83h9dm+TOG2GYQArCv~97ZmrpG2$6m^oC@5M7bLP8X%A4*m=p{=7*W`sA0bk*W+F? zFDxr&4eog)1+w?rqa3ZJ?wt}oz`QUek+D(qMt#&C`Q#DG89J)fP4Dr{=ZNvBh5Z5V zsxYX?jJeIroP;EcQ%8FKkq$wB%48}Ilw)p6LRh9~FB^pORdSRm38x<>%2klC5=<9C zW*0u|T}+YO+2@bR0RmQ@?5L}u9o6q961l;9mj=%Nej!Tjhz*=n&(5D$Q;Z-;mjmNl zX_F}~b=S((raDXgB1z6UQxYrhCO+X^t)fh2xi{s|6qT;3c8S18Y+zaf` zjXlX+I%Pb+_kRD2P#gS@W*!`7k*-6SKC}snF-KOYktq2*tHT;y8tao^s6W+Uh*sW! z!o!O5Gto550Y$Qc+z&}#RDKqH6Lmp&RCXrByTRJyUV0Sx zKg!zx>sw;3n8DZ4zVS5aFfv#YXplA7mSWl;xD4=6SOKV5tI{%d1X6HtFdCfl%`nD@ zD;4G&Ob+U9xy;VK)`i)^q)M6rx8BE!Dn*lq%1PDNwR&r0x-jq&e*Az42u%wHF8qj` zaOl*)6oP8b9Rwi{Ql)jS0c-o6IEW}{SspZ7qus@=i(*wq08loIyLuANFL z5hY(77zQ*k@F-zi2%g?OCY+IUe`ATV4QScCv}P$O0^|#{r_;avYY_S>Esf@!4Q{M} zHqDE`!3keB4y%XLLai;@esZM4WT--=35D0!K&+g8CRLu;raB(zs~!uznjIn*^*#r& zkE*+UY{Ju)*9bpDwo%AY01(1y9eV%ySr4WD)nhBG(wi39ChQzVTI$htPKltwAJSAG z0>0}rhYL-v6S8}EY$wdCL5Rs9a36qzhbZZh=v$kHi=j8ll`A$eA`8{ z`D^5iM$PW#C2e|6?Ac~He`S())tnYJLY7LOe-gPEIO;^8(NO#L+2R=+nzri8*sJAm zL{5c~uNZjevp&QFN}ol$xutNyJ#JIqM}F@PE!ecoV|2{$Q)PT_5W$+?GKpt=<0rWX^jX(3kTv0`T>SUcnV8(UFqy7_#SfatZ3dsK@*8=E3UpE?`%t1$eC ze>(t+0;E6sB~rUBVLLPl`x8TwlTNC)>cw1HDl+o{M^!l?J8`+ z`W|fpZuab)thaTB*e4VV@&Ly<=fS zC9Y-WD|iUZTuE}GIJG555?TS9`kmXkT7YLB>B~pGNIL}(p#F+`c?Q-bAm+i1@qP+U z3R&VB>6*3iFEf5@O+`X+9LiHL0BjtPf~bTB^E(NU?FP-7oCW+OJ;DFz!;{Q|eu-b0 z{aX;1ZjUI-$7!{13V89xbj8QK8b}$@sB)H1J~Vz|RPR4ap#s5h;?&^l_6=CpD#SoeNt$|p315gf^3Hdw>GtOle6~Mg zn1q{H%|G&*@d5@{UO_Qa-0-PtK?j37xmoOIWPDCZH)hu4)fM70rzXQhRUBsWypUkS zxE6Oe20gzP-!IQaocTR;_qiO@+9R7}mPZT2$bg`)WLIaQ=Ewp!ZuX=Hc&YP_YS=jr z8E3h0reC6ZX~si5^m&`>DUrLwC6gtm8MHem0&Br9x+HYUMIcRry`SJccJ0`ok4Jrq zL+JH78z6yxBW^~Id90-mCKL%^QXYZLaCJG69T>YoC1K2xRLzFa_j3}@zuw}7lMf8N znf5NT@luNBXu-T1-s(|$ecY6OgFsx>)&HmMkmbL!CNXoe{I9gv@c&?ANB$@6bpu%v zblYW`mxU`;K}oe5-jp0!1R@)mnezYL$+S);7z624={xUdjg+k3UT zWJ}Xha6|A13;ugy>8S1PeEO`@)oYlN%B)|NqZ6%>hWr=N<(bJl*So&%)}u=2OfX{l z&(T_(v??c1>sZ{VTOqSu-MjVSO_olqX{L^|jZ|P)xZQ0?LmnQNu|MFRl{^`sPQIxn z0$MZN7^||m=&g-^wtaqt{=`B}gY*5`bNbe>s;s}1-sY6t7{GWn-2LMN&4S6VJo-G@-puu>34g7*=J)L zjN+60rmZDW!-HKd=ht^LL}z81c@tr%uzu$NWw{R_wrJKQUB#BQ%r%N~B%`A~lN^i{ z0GsKrX}-Pr&cRv9QVKTJ*4AT#rTkSdku7AsIbhW(jI^0(33UB|j+f)_VA0Sm0Q^h z#xd9&@B;4FiT)TX{KZi+Ip)gPHs{s_v`M3Y7W4rBfjhr^Ds;*#PwazrRAxg47reBk ztijjWSljc>0K7YDe{!weT-MLFs_(W1Kl_B@>6*S1E*u(;Ta9|Evo2&Kxdq$zKaxyfjcl<0fhMlh* zLzJX^VC;!c%s+mfj6@lV0V|kdvlqm&1~oB@KJ3C~w>U7bt7B~EKMM1cI;&u6{g=eJ zp)vxIZmdSAJ#AV!3AIbPNz>$QHw8TS=@kBAt1aLWJiHYKc$n&{XIN;R&pTD^{uKz5 zoD92&*0*bDTVMePe=kj>Mz=Hr=pSGp*c{%!7Rlp+d`nd!A?v0=odh54=xD2S@H-S& z%!pZ464^uOWQ*_ZU^*Z;cHdI8FZ+*(p##~Nf*&p)^=sv-Z-+?%c&=Kcvsp}<2(&ZI zw6Q9Ed5@bo)D4B7w*-z*)Pz1VHv`cL`lmNtf>jD6jk!PAay&#{baf0Tpoq&B9 zs$y$}BHX2#Ld4Rd9+TxpmUsG}m_UoWuU*W9zThN;TM%n)c#49AYJlg=r zU-z{W0`OL~x{wPSgzbEli2;h8POs4Ex&2%-(A(?w(S6oSuFosMxv#70&xg}F)AEGk zQ1h4r!59I2^cmmMs}<%W$^W=JGC*-wV+$jY;T>~Bs?Vz|ls$2Kg2bnv9exr^3&e&a z&(4VRAy-MroXPJjSBy||iyZ%ajpnSc=(%&6*?YgS;ZkC47Y>++N4;HsCJzuWQ1Gz5 zzbYm9jV#NlxT@`vJ_EQ!VuEy)gWUtMaF>LfYaUNw&4P-xuN{b zHultNY%K~Qn2^X-iQ1?Ow?0iAH3Ko|&2YQ}yqSpfoR8c=jq2uf+U% z_QlCr)Fv~@MEG0!X#VIFnIf5v3ULe$S-AE-jyP?o!TDFr?s7>FdLG9UbMZ47BYuJe zC`%gDEm)TeGk4ii(?s#<*WA}EmO*o3ou<$kWbDQS3_dIj+?siY7J_;iN6Aq9>vSo z4;7$$?~eGc+*GcU-s5uwz(ICyr<@9z6M^*Ybk)D9j@gdQ+iB5j+${ikB$9;BTKg4gSPbc23GC`TP`D4Vb(V^TO zAMF%4O8i-xROjnLi>5TZ*E3!koPc%bf1Dd@thk*8ABWcI)S}de_d3i}Q4}BOmrDgP z+bztL@1)`YSx3U|2Z^a&nMc%tf;i(pYE0_IcLHI0DRdDiPA4jyTdtrF;wVga9s|JW zSuB{(xI~gFE|+?9aC#uuT9v6@5=>DI;XEHS2?IXSvQ?F}qV(OrwhF0+uG*p|YsIIJi z=A~~W52T_=u4L&UlCiq;GM%#VF4H3)sf$ht;fGcCE%;9W0g|D1P+7vf0UW9X;TmyO zLSr0`dAPLat!+KXA03N2rBu2o3{!x0+jjHXa_c-il?MI6mI#C3z0(DwrX+Y;%Tk&q zOc*=Wumu++Hasgq?Rq{L60~G6!&|3qT&>L;vYJSz#XHP`7?(GA*kJ2WkKdxRt`&!H znaksF_0`4*qiRt4_~*^rxma!e0(GciM=GfQkJQY4_<^F*v-_Yp&X+C(vEc+pb!| z1W86GXk=+r8MJ#*YE&%Sgy1X}H(>gM2)1!8<9w4!+~s$&MCr7JW3soC5RwrLe{|LS)z^E_xGb-;yy7l%MAMe*=3trEFZx!}q zUOe@b=VhM%I^g#Mda}FKNg2zJn3*t6x}x^4l6XGT*pG8lE8*wQ7~8u2=g(2r*U(m0 z-}h6fw~UVW3Dn@)AL#WsukX2upH|Et%L5=yCyC^GHKCEtK6sCUI>6FL3BWqTAVfUF znAAYsekGc^R79l&T7<;&jaaoP8ZO}_kS>MQGjvN=2M#5KMdHD*t+M*bo5;{)VnyCT zq>f=E*2E$mV;~DrX5G+Fs+;6pgy&RmzZY|qX!GTEL?lRrRgPRnp03BO`0#0QH;VhnIBQ%+3C(VWWW;y(uA-be~Qw0JXDk}M-)1TgJCQ%zTt^-m80Hq38)OyM2f?v-3t-L7@-TdFOD zC~EEa$;?sc8LUD1q37et-BPN<*WF_lpB;ITI0cwq)`HsJ_uYrV7{=D>_W;k=d6!>% z7$02O(tMU#@3#~eZ^uGiSlFMHt?%dMCwOHWy3`Bwy+-GA9d(m2s$$4CtMA>pY#T*# zVm1gP!?JD;R^LQ%GKD}&_H)|VEw}%;a1EQVWhRn5ir#YFu5HgceaBcxL;yqe~J1mbOyh~@(91f`F|{sFWS zPhp0_4OI4F`bIL`cM0iGMH3%_TNMzQ?8btHGb3l2#0SDgTZO_F>0w45ZpGOd5yXK%2^o1dw@pe%0 zg`y`djxZGvB0=DvRL2AG6(RY0-rMbR2W#n!mUui9{*62Gb%~ukXjlULWo4)G>OQBQ zx0Bb>P!p-cflOv{?CYW6PK23(s`_lMW9Ql0j3@M?*sbrEwPS-0UJ1k!E$RVqk9o6U zR@!Xz^fWKKAoetaQfKoG_&F_*72;U|ZBWx|(Ah`{SCoX>_lF^(Snpm+U$AvZJu8Hx zYzXZeF@5wjdybt%Z~O(qa@MfygR-ZVT-y`Z)ZMR-}kxMyh*CA-G)ZI>*^1xo3ld}>MkBDc>6#;NjyI*FQ;J||K#P^ zHSn6BiN59_qjJB&HiL@|_2h1S*sQf97R?he-bq{kTB=&jj(u1-`*q`J$=xk4_atF} zkgjv)S%f-Z;v8Ksb!@n;2_5Z5Z|?_K*A?M0Ah7_?MqbVP)-UuA?%q#@pQ=gG0&!0Nb;At_`Sn#9fdd#amwyH3{;fLvYH zdc|f^1s?Wa7P*An>6=)%v2`++%AShN1R@TJ)V+W>hstMGe#ecKzIJNz=SG%)s*;=A z?}4L-W-V-p@M+_C6!BXs;&b(g}dLHQF$O~(7Q^Nu- zC9G)k%#q_%qJO1mBx88xVv8q#IfA}TA{xyio2rLLTZLTQ4QOw@jrpZS!2+p48-?oq zM8H>p08V>Zb{FH_6}1-@jQo?Xt&Ne0EHZ9}-=4S@VB$e7=nmKb1*SoXZ}rc4-(MQ{ z+|t#a)@ny*v(tf&w@~X^$jIsI=y%s3b4r8=s7l!hhCs=9)V49j$8dm4dI>^W6-?Ar zt*1m>#eY(=(Ys?xYk(48)#$9|8gnqgP6_M~;z}^U5bXqE2tA*=7f8V-yyk2NO>E0r zzl83)&t{J8wgB&2v*jtPACw-9MAIJwPAHQuuNQdJ+LPtT;W=`h83)$!2A_>=Gbe;s zRdK*H1vMgHavCucW_0NUIG$@fm~LWOVZu&ZuE7uis8;!&O~d~jG|)ghlKg125gbfB z?o11>RIy^^5-7Y?)m7kUrmD0Be@()X`6tueG|thENJbu!cmyL}bj=3c`*$4# zY_cS0Y;}-fibME47@I6FiD0xu2Ddwna##X&a8z!O%*1Q07oh!g!%&*NnN4@j{iTU- zUg?|Gi!gHF`f=|@oT34N4+JJtbp(Z9_pcFdxnFs$D;hV)3_~bzHiZZ<04vg55nYBD z@L^7&6r{E#5S_-#3J^s%A;7^|tB`w}J3G2N2U3E?GjDDc=Gf}7T?dg0gcuCc%dU5D z^@4}9VH9pg3%<8yZ|mY5{+n?7>)-;5hp{@5JLb3@xnUG#a8;*rii-m2yPS@)itum0 zuEep=3uzgK4@u#r_vvhx!-R%zLUJGscjTS=+%_CpXM1hDgbG7-mU&`L6O665-Ve8J5c%AfFLmmG&a1>_Hzm{fl*U8$3bnkbPvp^a)T1UpTrq;CcqYE4>Q~s3;GD3}R0J;-h8Y0XcQ+ zZKBRI99b%i##kaw4&jFm?ChHmZIXof`}>)NrfxdC4A+VKG{5@sjjrdA z)|PsDW1~jz-SjeW^`xdwxueSXY#t8o4q{yH>AG?nkq{AG0b@QDwi8AP_91E{N_{sD z84xr}uGDMIj>+jFwddTdM+FtM@2eG}nY5X*p!XxgPM9(>8pRkg1kkatM;*8UMQ&ML zD&A!3Bt4T^s8JqtZesYODh=G7?deQYujC@!hGS`9hF4KKM)s14i6V&pZ-o9Hr3Aus zON>hJ$W%@nmYq=hI2#+!8Qi!{Q(sjs2Z?B$?fR*sG`n<#!(QNkLyNy)^Swc@9}9R4 zfr8^>!6;1M5>>qMlNu|k#mZm){?ta!?PK04#?`s+P;%2@r{TRDf|ip1;+7pv6UFv= zhNNw)i~@jbzGIRu?H^l_NjNoGe|l#cQfyQ~PExA9>8utRLLsL%HH=|_>JyR!)XC}N z<_v8b5Zof?NzN(6Bx)H#$rEa%?e}+IW9gkS0u1hQ@Vetl6s5ZUWA(XCDQefWbU6Tw z-VGhXdhDMGOucTGzmc}>-c9^RasYSxux0?b=v?L5k1PSEk_p^Bf@h5@7S9~pxhA*n zm46p2)73IzQhd-1o3#-SMFCP%wC8Rpur!jXygg8>yRPGAI$R)tLv=1^z6ub2@FOH> zwQIVa$5*QH@F&ZYGyb*n1AvW=YW^IRLV#^Cx{t`SiL~7x$|_8<5onQ6^7w2JS^-dSwq^PT$DcB z#Xi|@g&u{cy+i3Mo%7m!Hjwz@P+>_5+FtjWriRM>U^1_v%RBVtci3)~7`Ulw9Bb26 zi!fa#OrIjiTL8*1f2>PHJv<3ks>WbqpdSelUrlmlxvC0rx9aVEabZuFtaP(>`f~wq zGBBX-k8FCZJgmI<_j}99VrE3O*j)4Jp6X3$N-TDyocBuQe^(P5(DA-W@ol6T7_b#mh*rHMYLphH|n^ z#;?5qi*py$QSG6=`&{Axgz;7)>yQQ#j&<5B9U`mV$kY0S?}fGIu7-C>%nMhqlZqIT zuHV}&1d58x52w?SUf=WcdgQX{bE~F{Y}q|>!zY?zYr+eP;=Q`tLL+%kgSAmYe12s+ zVkCi6FMejwIsAhW|t zv*qo*N#A8qXj`)5?fvEUe9+;=@mdyEgHXtLi`S|+d2u=iuT@g@`_lFJbe9+Bwas-ty18`e;D$R|;er9-M8){rjBGsr4HHlZyI4$xmMv99mVq1Cp^ztSQKld&|UtslOYTEH`uga!M{m9`O=1YjV1TAC1=53jtO~#Bv_pjS) z5K|L#l5jlsW6^e7Ne)~g>2r3vn~A(!=;-u zyOW@r1R7WFVe~Zx0(by(K-&wWhe+U~8f!TKc#?;99k6c~>{ms)he$6%0h&JUZ$;A! zthatKe=TbS2QIk+%kJic45TkxmF#y93Km4-{RbB^xHPkuYdx=PPXa$bh_?4>>}NSA z>?o}oSbX`C`gcArPi*QAS)@|QWkv@Ag*;^uxTSX|h|(*L z0H0r8295smYPE_3H-!jqDd1|8EI(+V0D>>iQAlm<#ypY6OpSIKEOah2RV@FMGE2@_ zk`~eA*%^^0K`+ojpp_s&(#rm6(8usxKKF2(IV9hsdL%;T2viv4x#$j`TVl0gv%ESz zg1Si-KT8xofP9ytnGFq51=3o|q1Y&8zE+u5H$-PjF}y@)if-HDt5T%lpCnc$xp3U`LY$V(QdPye-4Pk}=q$2W9vt15?*g(hGPtP#UAkrh zle%aT5OdHhH5O}Z3cW+okN)<%5s>x4p$IfjnmldRzNkrT`n#X^ZzhBsLBHNOvhmrR z=m8emn+2m!Ed}y0bZK8GKt#w*zS*k(-nSkkhC`sVp*=<(3@#)PDq)}r4)zp1Nbdww zc4z({6J#g?Ga`V?oL;CAAjSk5({^d`h@R z-$f1`{(SQd>~TvM)J8P7LgO_c$Z~tA(?$qDA~Y9miN7Ami1voC+N)SpfDLinT)fSb za8O7{9(4r7!|Lce3gQMLNP?QUT@#L`iLhfz1}`0Eo~TG;8nvmh@J3VrTD}8JXpn+5Ms`QO5b~c8#8^RUL19#FZTf*9qD>75I zTfq(O>WRt^FGJ3=n1u8-ax2SufRU3;)pGD01RsToV*#>OqsXQor`=gWjw{$HEmxhB z?!uvN0D6a8og|@FnHTh&ACK+A_%R`N_~GMm%)%jSX=&fDA=y#MRzO2$O{RNfE)B^k zYzd&de?u8rU|8Xk5pu172e9bHPr-&ab@BCX>q6#h_zi0ozmKq_PdsAj%H82nEwTGW zmRSJ+Kue%Cp8MQ#-3@D5LI|5bkyLuQ^_EG+Q0Z0KQk2ZTtZ3*|xkSEeRi&n2)o5h(w6dy4I>n`l zRH8x&LygtM&U!n`d8g5OvhEgWEz``Sa$&ZjfZn z4fHxYSTJ&Db@Y-hi|qQ%sx%v>c(s`E(zuy-+k3Vd43^#$7wmshdTTW`?lYkY(QdG3 z;0BLth0b$-c@V)nV9~d9tJAqKSENAcfOVIKyuZyTBRYbI8WX9nWLcuZFs2lBLEF!= zz%5x3<&ROLJeg_x)V9L2LZ81=kdkJ%8>o-?5XP0&7Jyqb0OknlWhWJjgRDq3;+VS; zPL)exg}S}BVNVLEF#vXjAqjh&Bh#HR6!SVO8t*n}c9j$3Tq5j#L2#uO=cD zLdV{L*^SVpK~z|5FI8pM?-4C)Wobea^nv=x2n5cU3H;r;y} zeG32-n&ii0j&57>DDNHp??B_}h!!`}jadI)9#W6<=rB#>$hHK;II38(b#yqh$*MNf z{^#cJU*_Ka>Dk91laTRss2^h#WB=bZxaXlbn4R8%Q(6cMZWdsHtSU{`Vwt;kO?{eV zHNHOqh_LE14yam$I&be$N$0c_bx(6=7iM#@Oiq@LS=K?AC^jsz{EG1n91kCzjBoPW9^j-w(6S%6g!Lxhyo7@k8zz>X%sN>@l_)EwC%*gRr@ zYmx(aw3%{J+o;Ke@a*}((j2vjJpvYD-4$1%8n9DaE)JJ)=EmnjmqE(xlGVm;2zg}&x zXE6R#q+jbk=TcBt8IQirM4wZ#=-@rD#nEeD6Diha&5@4cD4N0CFFzaR_M}mHFxXnK zjHfZT4C_mAlO3p)NL1v^gn*d;NSPh>*jZa1jElRK$Zq3y;TpdPzvQuAfIwu9Dw_OB zE>n}z!{d`t9Ls)a1YZaTyfH+5|5M3){ZRL&Tw!)V>zr>B9+(3ayEIzHXC@)rEhcur zT|9tV&K2ip_*nk|P;HqGT@!y`3-E4o+BD|P zCdT>#*Gi$-OKrY}xIgAA;9Lw#yIrwwx4{qVZ>`d0=oIge?<vfQy*N~*4TZUBj{5Qk}HZ1m&V6g@hyj;o;a@^dt<6N(d9f^z(yC%I zey`RZ>9?-Zl7S^qM9UKs1-<=0Ic4`h1X7rI>JX+WMypB%@vY5@;~eB+01I8*Zevg) z=7H7a!1zmkMS$FBZF6`5Ae(<=dFwb~LTmB2Il%lpRaR2duv!b(>w7|c|9p4EiSe0Y zFnxqT?5y0=XAj-~l}h->?^x`)6u^R}{VH^dYU%9ohJZ7Q@t(Rgh$|g3^8$%kSux;# zM*>&x?^7^*OvhV$85hv%K|WoMV=P%7DhapSpzd)(5;wX|EX! zppd(WiI(6=dw^5K%e$h*HI|Pz7$s+oVZ)bSUHdCv;QYRR90LiHs*;>+FjHwPifL1+ zhQ6aq?Fq+ge~?;UwR^dl*U0P{@n{FfBAN9YRG}CHxn;@y4oq4!$wInRyYoyC3{9_r zRH~zt;*e&xZ{`Rv#WRuU^=0^DK_OwbZn^f*+PhT}?D-(bMd!tx-^d3q7AbHOy-wIx zRw2t%0GG|h1rN}*>OI5l{?oi_k@ z>~7HXdeWc=H1-9kZ*I^B>4FUfK1X&w!b%n&PRhFasEZS)IY8}>mg;_g4!W|mN|qb9 z>MZWc`hJtZ_HbRhhH%F`-`8gD#N~eN+dEQxJ3Kd^Ke5kK%i1s0ZdD{cT#Fs6fFA|L zH2b8O$fU8xt^yrs!*j0D%H6xTd7dm2IGz6R@gvTbcy+NAd9?o9lQh8csJqQhp8hEj^jT4qUv_HcjAJeA*=s+I z`bzn3;==yKxP~1B6NPbgipZLCQF*#^3Olw9T8);31sDz@B-reYxcw<}^YMNC(>tBE zV+pFv_9@3Mv9I~`KEH(DC_FTii}vx-CM1KP2toR{T%^i|4Thd?{O{4dHw>HTqWR9P z+FOKipt>!akcv40y@`$HqrDtVGqV6AFTtLg+$Y*{t_C8hBPWkDIjMm^1IirkJCee= zD@?OQNO3s*(fZyH#kJaZ{0Yv3HrBMPg;QsO>pN!OQhQkDRkPV{+$S-ts-||`0Gupu z@fur~PT#I`neS%?3UIoqK>9=|A5zp7@WV^AE476Y@P_j?iu(JxK~k=;41kD%%4Mvm z7Zpd7sxH0F;R9Sr39$LTYu1;T+h)GgK$!b7)>C1Xgp~cPHhoF6k#yMkJtnQym|BXY{=n1|t2uV|%0t(u zv#Ti6z>c&=f&_sWX-H?N1bpmdIb@vXy_H9ErU#ql`Un3e6T+?80n6R&2jq{4@uK)a}tVlz@0&Sa8JkeSB6}RC;Iz|A9)_UaLfn4 zq1j-_#N5CU7joF<1B!menC^?|`Oq?3La>@+(#8(u)(h&T2SaASG!oG!@3YVa+HUkc}~E=-xOB zK!jWQ1pB+hEDc=~fo#j#VhlMA`o<@`v-Dxq15`&pqG^t`#r)L%JN$;Dn|o`EI}ne2oUrZ5(m`*fi1$NR5B1v!mgQ459Lukp!z0?y^XK z{WCvbtOJ||A@4ldZ#ZGh0){V{a0sN6rGs?cSVTP*`N(86#%w7ElhP^TgIX*uMfEXz zp$T2S>Bb?z#=e7}$MEe7R?sJHv@z*=M^bef=ZKyy1{7rlsP|M1NfCJI=2xO)T{c1^ z{`UM{03Acva=DTGGs}G@k<%GJ(dLN-8{f$mswdrTVgor{aVpoR*(wo&a{*jY?NqVx zUUEX^+)4;`_f4{&D|3Q$Wk!Q*DSGl8zXk?x)-4QP&DSa$^eE{kBp=qV_~ZN`$3*{u zL>27E=`0K3eitWUc4X+|pE6}L1gIskPe12R7M7vPz&9XoWiH>5VpKDjuybfy$KedMy!RIK;#zLnYYuKsg!&}&XT4x={U)VA_FIpL5kDRzklB(^bS5v zKzUaTA)UAxpE!sn6L%kk`P^ zMaa%DSdO}6;6OHb`yKsdRJGfW{?O~%IcgnqM*12qC70rSX0#GuD4FCd_Sowc=0!sW z4gWg{c=rh5U2TfBJ|m~uJ_f|g$POE;7#!S7IKtp3u3YuNmcKWutEzY-x-#%HoeANc zACiX$CnPsCXmJQ~fiW>3tOCI0;>wmrnVZfwE3NR+6a>PURS<~3lwd@?bz*|jes(xRy!n9uCEP^0JuA^i`FjMw(eNdvAkv(oRg z^V+2CCP|{F*__bS9zA2Yom5%c)X+4-a)#?Zkq<*&gOXXva#WPMDp_4*5rE8cY^!0H zpiJ#LEHFHzXhzCfRymywPM6Aay);JN>{=!jM3~Y)259~L2pA+LZ2V0JG4XN46)X%U z(?tS6!@XWk37St5DCeaCfaMJ6)av-lcLup)R-rX+WTT z=o$z-9=UZNTA@EDr`dIn#wxIsJk1MHKCj^z+%*({i)u^ZyI^f{PxY0!=F|s*!rNU` zV#NuqJItwdqp;Zzq^d(_qgY6W=GZyoxunKU+Uy7Y+0ch1Xo&^*hygtY>r*UiQG=6D z+UmE_*g`|i_0BHRP&Qv)d7QrDE(5rl6z>_Z57Z(zMn=;?0RR{8IO4GxQGEeGmgJe9 zYGMVxvAG4al>@t_+55F7)F;<`Ml@nD9H){;dcG^%AY*_D|M9@srxg4`#Ki>OHi?9&9d;YiIQPS73I}|3-Wk9YC3#5JqTvS z@VkOih=CzQD5+*f97CiH5W^>NTP3L$HD-9*IJGDVN2~2U_Z^n}jJWsq#Kx)GJ%Kvg z`XaNWXhKMO)Tk@K+xm0fg^!=p%WvX0z?PrSX$he?@HYmhSn02ea&K2A}FM$MRf0UV6ac+87dT-Vt-r@ z%x-sd@qMFKx^8G7v!yGhWOqAEh?8bo!94$*ONrWW?SKGu^wTMi6(T^%)RfmMlJjO( z>-xm4y+jjK50yc>rLoKYBoMq^Icl=Ysq)co2_lxr;H&6x@Cn)?;^kBL?ZPbSn{Ek8 z7Wd&978%dvTlhRrEbB(kh^G9zu0~E6=25516FmN|UJ{u@f|Ee?-@HHZo+$>~f6v3$ zY!9EO5(>z%&w1Ka^+LmO@6e>Z&G)$&y6lRG{e-%tGo&x5fC!`9^! z1XvPCbp_~u6bay!b>yHhBI)|h)pn2tT{L-NW54;;)cswnANrdbCzKwNGr8HN`5#q* zAQ+nh#jbJ3zHY?7^8s07*3&38OE^cQsC7Eom07)_=#&=8|W-pF*})6N%D>moknuBtf){$w9zf@-sf@6l7m00 zP0`+U%esE@G+JOFT9(-p#RwE^o^l?tq#QnWEe0kyKXzTNCdxlaLv-o&cE0Lz+404f z8CKB9%BTVHr&>$Mjmui1y39s4`708P&obN3mCeQd@AplybFkiS$kbI3`5H6^7U!sc zQs1DYk_Yq_qW!)7To$IjsHw@AXX2-aUv-8|Cot>&H@ z58+0IfC{oYV@a;#Z+qa_?=7o)kt?kMZ#x9~w_q(+`^Dq)zsyHI#$)R8;)<+PJNeJdKAL>sn(1noV8{ z2H%?2%i7YaqtNGm$gO!Swy<51gXT>u8RKK@`A*4FiQ6^rgYuUX<(2!F3>%^D8UQ`1 zDfQ^e74&$JwLAj&eM{tMo}-u9su`-kv|?42!GgqJNA8Meeb;?dPWc*)XwQysiJXMM z@as7+nc^OC#+25SML?(b4AXHY%hzpD7pcBbNo`j@-d7Rc+e85*DeY=!gppk4v!(p4H<5X1*z;)c^p;(_NhVL_nqPMomb8+ly6!Z^^5e-9Kl7qp;3f%ln81(X1R+#Kc*ZE_MFH1$WY1^! z4QR-SSNcZ@$FPw6ksQys>>piPxTRdRoe+bGxxN;D!jihLV*HT0C+yDJO6S$oJ~493 zofv=oj^9KrP4s0Mj!~V8nQNE(3r9G~5kLc2f=!+|S3Np&BN96BT`O6G+L`b$&CO}D zzS;szphmz_=3UYuO007Kw)K7BD+F>lAz{(K$y0pKUgJD>ZLYJ_dwU?=4Xu+BcCGeI zCxnz?H+;J^z5nq<$@AhE{MU@nginueXJ`q<%}pn2VeM?oMene zf$ErQd$^Sb%M)R< zg`XR3<+C?$^UW%e{(ajuzFLR{{jj=#g!I;DmPIrPk~Oh+AlXPS=y^D*ebv6Rfl+!G zV;PHfu_6LnIelmSh<^^l3oY=ve$IyRWn*DeVETjVSgVO)0zggQydLqMEFhQ-K&O+o z8uamdIK+T$(OK8~0-#ebJlmlQlc@ZHXsOVfEd^*k7ESo*dr%p@SyX+ggjk;pei%6y zW*|^P$qh~n!K=>|s(>q}4$yuu`PVtQp?+fX`N`ee-9+j*vH_1Tb7a7na~cMmH;dm1 ztYCg5^y12TVcE(Ge7XNLRx<4)kltLEaArT`gE5p@D5DL6Pk;EV?n?(Xny>C}XI`Q) z2or0(q#)~ZDf_R4millm|7;p{h9&M~`K5wGKbaO9ELy1BDUjoNxVSbYCNpZvFw zg?gee`5T6*J)x$_?>52}Q52Yf^nEzRNZH64T?g@;G6mYBu6%aZY4sfnngYNdaf6Mr zgbX&DV4aPC3sepj>=wY zjaAy{#QIyw=}CHT1dDCmgk#BIS`Sh9E93F*uJoJ7$y~CIl3T+7kHc#c>Of6r6P|OP z7kZ9%OulAAuSN*E*&tBD@w)o_;cg0+E_L?V;Ano1d#bY*fMqC@BWGZO`Y3OaI}lS2-4+=-Ka4ySzKeQ_g$LGTYZwKHE5% zYeCKb`|Oj3%=|hi0UWYLkw;9<5HY5ggT6Guy)n?d1vR9$sm}MFWd_rq(^uO_D=Z~L zt)_w` z%d0@?E{Yb5k1!j}&{6JwS~!s{U*2QFpeZ9N)86jCro^U6*)+!$*dK!6H5q9|ws6=W zds@K?K~vLFj4NNWP*@YYL0vQ;uRL>SYvEY0`W`!Ww9Pgzd#{|v)fNKky*eF4iQtDT z(1JU90eI2*&B&3Y9yZLwX5gF0e@9quRj#+1TYy(s24&ytfg3Tr0N^lOEhlmh41$9^ zC>4v&uP*DzZ?Adm zT$t%rG(t?M(L30k@|CRm5zxu0!ayVBv6V{59(nr(fq1He_ZSW$kr*n!K_BXffR~L6>&==M$;+N{c;aA?&oh)l=CVnt06Wnsc z*#~KTq@^`$i0*(?%8>^*1DL#{YCI4xV(M(jFM=vYnL}khZdp%b%f-NY%gvA%8m8A} zm2z9_N2HX%+nk{;^p%1-Dr>X@Bl`ja9Bn7rF}oopn7)lla?6Yr2zlhIpfVxM-+s0( z3gzSiV=>xYTq1tU@UxPmT};~Hj-e{7 ztAux7E67#&BekMD2IvNsn4EwA#BX#z0&sG_K1(g-gk}#i=QyL=nyTn*YVbqTcP+uv zF0JX?aT^Fao>trVZ_m_R^R9P%1?FXk#QZ>`FAP)K9m0mtBgrF3f8CcBXjG1M@2`7v zu*!Meir=)><-xD4J`1Ze7{~_sIj(ke^$6ZZlTd8!k{UD;lVajaU7#dDiW%^(0cmo& zEa}lF?a2l6aF?XFg>#7yt7W=L%f@*v6WUNkNJc;p1A@tE`%m~Ax+l!_-_WwaQm*s9@`&a^7g(+(&Uon_JaM#-#u_i|6uf|)Q7E3r z8FHyn24?0Gvhu!$$I#tb-oZbbNufMAXiR=-1a&y90#Ikn!hxm1rS;n>>Nr)m_SjXP zNVK0I3OlK&fy1k>e~%CG6Lj;jxdYH;bgQJwNY9>XI9FiYEx=)SgvQ)# z>A5ekYd%PMMCnfF;`6=dbvtZ_sAeZ*oYVlzD@7j;D&N)@g>Sq)!5aif~WtkhUWXbA0aU+Z_tSY}Mru z*$*PUmhIfjTa0z?w}9*?KLjarQKY)EAOZ#OHhA0L4JPYK7%IwTpYlwR^D|Sw0FYzw z?K!00?SN%x5aXa2dQ73wGx+x8GYwWLOzLYa&DZ1TRX<0E#&_bQP|=(ks-527d*!#W z5|lN7WPkKpT#faUt)In%7pp*sd41L8IeMY)Y=gy#myh4OpXTTMB-omo+}m3@dX>Za zGK@uNrU{Xl+ zspAG&nV*`XHUvAqH+eNdjOw$0lK%ED-W3)(XjV8bZJCJ9efCq=;w;yTTc-Is0>eK0 z;-x#k_|eFn2j>pY!rZ_w&MAfcuw1(x+y;7Ukb=*(#gGUQw zid=WC{OBBU`}~U$&QJXL?)D2ls@T`_U%d$1|KdfMIN1J=7a7)){D&Yx{pUsM93ja_ zTjsep*hgb@q&OXQloA4ufWbgQ>m&_8{FIWu-n&+70fExMI4c}Uk3px!=^dmrGWol=y`Gh<-6wP|-cGK41{+~hr^>A#U0> zFLhSb#wFRythSyO;J-+WCZYMvPG0P9rHGV$$G&BV*?Ah!*|{zEPWBz@(>q)D7XGdH z@Ync8!~pG?V7tvsfoPo4faBpxL9(gM#IseTll>6hSu9(JXD;4-T9)Qr7E7sDsU&!b zq3BrT5v=%nw5`mRkr3hn9dJb+aGpp!K|GaSBTay|kuK(*Ua(fMQ^w~HRsGirNHTHO zV4hb#;;GiK1aFA!BE#z>C@k3UjbZFeUTL6NW)6;7$t#k6IqkUPirz|>EE($SC$72B zh=MLocfRnjmH_L3mF_O522^@N!#Ng^G;M~(u2?**2l;#JL}IEiRmPT2-m$OlY|L^v z5F{LU41h_Yb}O>rkRpXwB$nbRynw`#-fn+HVMzJr0$Dl*#f{Fm1^kj)_z6*(@U_Ou zVmax(-g3s(mIvSHAwK(ho7q12rfCExp5sr$uqWS^2h=4-)jGs`8bWDn$|h_ZOUI2d za0|?j(@zT;5{EAU2#7@%@88M)pxl4LWHIhBo|*%WMLuM485lHydz-ItXb7l ziVVkD^R6*(idcm$-+31NbV>f|EQ-fYcE^)STSb{h#?j=cyx3)G;5Ytn6P`u{LLdRA zxe}Ad>n?mA;1rwlZOj6N-GEd>LN7&j&D3l64wyf_YqF&U{E)dLGP=2XB?c9jrIlRa&0#~6^{V^bzZsX z%Zvgteg;!`M>zi21G~6k;7ajM%eX=V5aav8D&>?TGgskCg;5hx4y^)EbTrb+(hB*y zeG%0vM*SEvEU#ft4DpM%h}Gr|aG!)PA<2$+L-sLld$Di5C#&39 zuiS0$UTs{ZE`#kbFbfe!_-+PL9@?y@F)6tdK(ib$f^vdlHKs^2mlfRkyiU=r1B)Q9 z{^6LuZzZ2w&&T0r@Vgp^*hxGyCT_Nvk6IGcaTtcAW4qp~I z^@_ZAy5Hc|vi)1Zh=3w~0lILIs5y{^-PlDk?kUC9YTx&r(=B+3TVebHbF=K+DLIaxG7sBZ% zOu{27F5Qz@g~L1TXT1!#Q}+F@IQmFQAV7W(C1EgRr8Qy*v)6RB$nf7pRFWS25wVF`mp#KoPt`TBUxB9^(!*a~9s)HR%Wre;e z?OpG{2#mjJD80g!`*vaM9^4VAdfk}P*@7ibB0m;HS-HTEvG2lJpD?^PzN0@+3~0~* z3R~P{Mc)S;1n*M)pz(UK%^Rd+(tmm3>_^BI0p#J!*PEh(a{o2>5+b3m4k`d$zoBcf z)2d!r{C`m83at?WB#~MFQm`&ISD+Bkn~bcbt0TkQqhcg5WU0>%+(|Pq7&9>V8)g+4 z05Av9o6=&~(_+jHaZy23Eaiqng_x-A!hlKr(GP&KjClJQMIu zR<}~Xl4^?N;eRZ%Au3IiFe^eL!TP5kNQK(@Izd1PzohYTdiIc0aiY} za9!8yqiSKA!1HEHlf}Qn{1&JHFK)$ZL)C{m<+K@S`_qMyGb#b+hC1b^LLrH)6)7NbnHcmTQj-p4@`rvx9KOa7lApv>&a3h_1NjAj(x1Y0j>b! zIr`2FDPVIMtVZp6b+nuDifQH=UDWiV_K8f*?fGvi*@tWvQT6!gn5eYRqS|Z z#-8S6ZVnQf&YJr(6-*Y&!WWzE*M!8m<} z`hnP8fBRAhcZu|E(RDiWc@e#uhvB8fbk3kpqc$zpv{7oc+XKHFl$Xby zS{`b@(LxxizuaW__iZCz{HW|yvM}x0B5VG5W~Gf3g_41(UCTybq4>_2d3q|mdV?XM zk@lQgysRGKfcvMb&GGzTqFuk;S6|0tn5tSR6}L)ypcZbs*FIFsGw>a~qyTj>kK$=? z|7i5)LvH+>W<_z$1d#`A~$W7&Q%Q`^dGNa#1BBv?5 z^kmI*I=NW`AA3t8OLuy;NpSOe*f;6227lJ3u`tz8e)dsWIvDR`oS${+wEWxsT+Zfg z+X)$L2v-Hjbxs}qgx3a#Oh9d@@%@k@L|(MCq#zNsQ4w>eRv0?79NOGvs{lV!d6frm z1Gc&(;e#u5`VFVlt>CtJ|Ic(=r1tYqep4n#9xUz7UIXjKSUD|a9MjYW2Y2mc^lAZ1 zal5CP@?^+11%rX@(Ncy&Dq?*|4{R_m?{^DT@#^QkJ%++8zsq-MtKv^WV+EVw4=I3= z1_aq#`ke_!l4&t+rF+t9&2^{~_KC_BMy6FG3H%W8rA^MM5T$mrX+cZ_DFShyDib8w zu|isie?fTT4qk=>O*8?lQw3DDy|(MpIWgQ*I@kl64n}{0UAuIElphE&NBx;1ignx_ zHtAb7c5_?IZzk`>jPc*K#souP08X;L%|rp3)9s=)~+J)3w34JE@O6_xLXm6HNTd&#Rm`2Stuu!8&?<{`szKK$Q zsl86FU;1OZ0tacJh6ZX$|SSnjzNxZB=B*_m|xCX*B>l z?E9!SPTwfzlZj(a8ZJH)}Ih&f1U&4hap{&d2O> z);tJS^I8WmmPg$M+c}leOhgWUEnoA`7m$J%`cLUzUN>QRXF?+;>kYtS^*EF>Eav2K ziJ@0cF;yKD-k@K%FxVMrSfQ<1!9-XfEtuR2PL>LYy zN-U2*`>^5YEZ+)Xxt>Peub(>&Je(MRpt!pP9ITNjQab9+B^e9o+#`#@)EPl7fo32T zK(evS)AG*VxodCt3>yvlb=zMhZWHf@N+jle@9zUUN8l;Q;ncQ5b7t_W%aN}RnR1}J zSxk7`0L~6T()JPtOSA^nfC;1K!HS^_f*zl|>k&9B@~a^CaXItU;ygTSPCY$!wa?NgwrD zn7YrvLHTRWcfiua&z)wo={CA3`17oSu!Q+7dG|dq;&ha}3`RWl` zqLhaelZyM%tBd>D?L4rMiJf^{&#DNJ9b#wk>2zU(`(bo@uB3_N+oc_?FNp1bq7Zw7 z+BTL{jeh;r01}b+JV_|5jf#1?7}+y97@?Zdgf+G=M^1#;;{?rEl;9_D9=Z)j1BcHF z;C)!sJu~CZ^4nE36Yh=tW1F&>HUUu%p+Gsiz@VHWdZLls<%Nz`P}+u3&Q)^87c7Fa zCM`9_>is5>@K8RibTgk|8lsXt>-#>kN=sc;2#*)|G16BLKiejBIF180BzW6R@R~b5 zhyo~~vX>k6Qwx&8`ZkTi3d#+@4%@Q|#+?^-J8Q!^Ih3w8U;f(?WwZBENMGD^yn3sK zuP%d4aG9&7)-VAT#e&m_aF3@BzzgTXv4W%KtNX1WA)+mO23(WjQ2Ye|1PgUEg7H{f z!BW&`-PE$k*uRBIR-liq9F~Du`Y8BmbT{H2G`mYXP70)=L_sTrQ6zc-p3lV$Y3YX* zI2)p+BM7NSmPhh0@4B(y^cb_`$E>xc2zn$=_Mp6_M9=`XaYXX|sm&=&y^k|if#xU0 z8m75&C#z$XGE^nNfmEymOvIhtqP9Y1O`8HGjAgG4;FU-S8#Fr8!&l^Au1bXO=wLi7 z&3&0BZOwCC>3kN%DrCX^GXRi3`LRBm9rY; zH3pIwZRzx$+F{LC!hLO?pR#fjJ@$7C`HV5=szq2RULQ zQ=u6mKaRj&hxz85P%}GF_N;#0(oXQ+N1`3Z_3eS!6*48#N==6@Uw#Cg-kVw6oA54u z3da`-JjfpE08z|>-_3#Fmsg?mI}Zl%#hGq)&;$Z+V)uY_e63EICgGEZ5_jm4FG+%_ z3fnwawRvi^5F@`dkgI(_xk?g)LMSpqT)BNL;;tOIHC1n94R3QN_d{Wmcj4?OwQO+x zkEhtmp)-=%WdN{RJ?X8OQlKlhy1EnoU8|9#5TR+vg!W82@cxCO0WgOPr*gMObkR2` zoe6D{?Oe!W1rZ5taWgCe-l};5QQCS`>SxF4B7S62R6L} z)$jCPYAT)|5!$G0jg(1^Z`F6mF+`(`*A}F6C}Jqlsg&gwtb&(6c=r@KVBN^ z<0XL(a}sKZ5Iq|G?G6}BXik+I4j51>g6(KcTl#KB`~D#umVO@nR+ZK7m%D2}3wY3Y$Pl?^3`!tPl22}0|0Q|R3?BWIy)cn}ayJ9*)( zN%ecqF2ymV0%(MFodRNzx1NrQsBvVw6BZ1}Fx!tUD<|)f6|$|aD=Fs?1}H_sa#pt2 zYT!CIcT=>O*^#MVW|~3S8yMN=O++2QT&%)s!j+=0ttRHjv(%tVxax==z@~kQ_Z{B> z52=>XJ%QpFr|nyZQDK>J4k#w_i;Tthw}(gFUiN(H?R^RNdZUfm%9qn%wLP*`}-T@6;fZRpVwt4i`oCyQdTcSS@IA2p+Mu?Yn{^ z#kjl4t(cdlsJKX%U}&Hr&hR3b{#t5-R30kV`t9Zki_S;Exdk6%H+yl8-$JQHm$&t+ zx~t>ne9#DHOi+oJcBxeQMC(QDvsP8T4NB482*8!8uYb`+9is zp<>wVND^@g)ZqOmXV@_tw`466JT)>ysw3~w+1H3o({e3g3Tq$PlQsDxwur$p6)6&9 zWL;@x)3rCSpJ=fTfvp2=N))`%=LYHF<|1d=axEsFDOZv^t9*Py9L7`VCCHCGnm~i2 z>o>d9C8w{GTDxYEA8M-sY_e0Gt20l?ETmn(Ej{smEAsvr9@OEYJ(n_LRsoks^E8kA zzGbqWKq-0iBW9`s;tTt>J`EKBp8b|RVDij2n%j;)?a3L2;#-gIrlyQ@;nGyLU4Sk8ipSwz5;O%**lmF&BS(*MP-^s+x z@t?V~X)W!4z7zEy6_eouVXQA>KU-yvhr|MjL}HP~^<#+=Dw=k->@vP9C42m7^%VzC zD#d!@aGk`aJ}{X^>8M?w&+^5P%oOJ*JU#Jl)NFEeJ(aytzBit^UvtKZu~Tz4C>L_r z@!E{Nve!&%^PS(eCs&d*-3e-Eq*VXw?WXfxh%y=VIl{K*``*s^QT6d{ZOOg15x>G! zTK;!y3Vp$Ba?n_Fws`Wza9OnVO6YV78W*j%8`e12$2jBGAl9_ z4U~|PWeHVU9b z{Oz$i(8j2?3#iU&Xi_AGfV-Ej@WWJ993trUc@RntO|?lX)`EYzDUX?eUjdP+@9z~A zAO}Ea)9+deyYxs&2?g|+X5Q}tyqb+`&_$ccDi;>|km$5fHQDYY>3VG0GQmjiRF+@= z$V`^#fi~KVAK+z7Uo_UCRM3N`mQWCn&B0Kx+`O3t8ZFB`n_eoK-HG65hw*?sKPW6H zKo1mlBACGa*}H3*Rw&|_t2*zX=EtefZ7Q`X0o5n>jn|m zk{Bt*bSwfz$k6YPM@w;_)+;4`*FL8JfiQtpHcE3r;_@1$u3(q#~-db z)B9IlLn7xse9u~`R-zUZLXqooEdGEku}f4+0`SRi0r05~wG;|05xEh3IC(RdQY8{s zEvT}dX?s}xP)}A#F%V0Wo(RAca;^$}+Cuu9lq<{Sk^|T)a*F zo{0YTH<*#`foIls;a$R`q$`V#I*LbHJW_+%bF!+j&?_XJN)%p2Rml~kSSIxE2xtae z(m*?839ycoT}&*QEVyx=*y24>MaI`^W{h{ga~ppn&Z4#)lbkd~+k*iouP@RN**ogj z{?L}*WN!O_^HlSfAR)TDw8J0&v^dik96^>snm_oJ0(!Lp#{4{bvCKQ#=f3Mc|E}tphL9r~`3{=;!fJ>xCKx#4uogm=N7d$P zGch>VRL?yqzRsb({%(-G@P`=xp^q)#2K_fW7 z(~fmf2790CHAlDXr}20FK8rnwON=7G6E(Ng_%V&S@6FaNGyw>rKZ-A7MP*>hleJ<+@6Pz1q+KzGG}9ZTyIl3upA@^>!bC zQ26Vdx{LdH8T8-**yLS8n8FzZ)fYfjS3uPff3gQRkz~YMyn+cq8K4OsT9K%KgE#@s z@m3P5TBS)gM=Yx`?|dn^>njskITGbzY=^QSi~BX;i=ozs0sxE2lNq!bKp+cu&LAb+ zg(EPuUBO^Ox_lW_7Ze|Zu94t>`a@psG5qB)5B!%abkIYmbHv6>2iyNFNz1QE;49(^ zo}@OOx(U|1Yhl2RBv?TD6Xddp{GCUTtxa&Jz>4b3-V^710z_oGqC~`a|GT3;A6_0377MMaN>XlFDaxxt_><%kTSKtuBt0Yw10U}kmqn;++J=!E_j-V4kw`2NE z+2*Pj1c$Bw)dNK?n(F7Ub6Zwg4iov8B@@+N(yRo1#7dcw>ph^L?;P8h8MmhRp7_LA&sjW`0VZGCyF9E_uc~Vib*Q> zpGj61S;IwvKkY-$J8lKXW^{QT&VXI-9x*{SRCzG^!npTs#PS>vaAM&7_Z7veY8a0L zx^F9imxo~9TmAUDTOPt|`sS#ET&&Tt6{>uyB}Nq~OrJpLoZ)b91PG+CbWpuQ-E(pK zHRgHdheNEo;c6Hh>JT$GC;_1x`{ONTu1_b6z}fACgB?~+Z)FYEiKY4mQQnwem|U8- z2FNp{9Hz9KLh#Nz*Rid664qmI`=$K0JQEO{O+yvZ6@Sgc$UaQTJ09$26vFBU@KDnEOPKMIuN=d8zcXDhX`o#R1KDmQcz^s(8iSKOn+O9XtyY^Pap%V! zE41h2bj;ak&20d3Jq+vkBpAB;ZXwUUj>?i&gFPi&zRzt?rF7Y=z{|?*`>XG{6myT( z_K(V?rXr-1)0}MAjt9VW$EEq_#8QX1$=b_Tr#xL=;#HaY-AzCANYu&&GGoYD56dE| zw@@%h2&g+7xvrX+d4Dk!o(a&ovS7P`NR_s(X*eqH6sPCgwLG6RoCh$mN|=6ROvox| z8jwzCJ`<>LMmhLl>^@JJpvVR>rzj8WzM!L=d>=Ri>ry=UT>o-MG#nuciqE96jQ+s(zQ~9Ld)>uv&Re5z zqo)EYEX5+aK6@FyC|B!Kg6S+;&t(yXaEW@;!FRd9fjwUfE)*O8ySE| z-rfr_F^;&l#>g}Ru|Jx(?%XqZXMC~%i)ucqzpNmbx$UdyBwY=Vpv*p>K@bPc%vZ$) zpL0?4(v#hIV|{Xs{{tMaum1gC-45&j;&zzWnEy|*tyxnuc5@8TXSNmrp)VhxGS&Ou z{$J}Gmqf5m;|joIO_Km+Im3`9TuTw_@580Cc;Z!x#H@SZFiam`WoJcY4_DKh3n4n? z*SKiS9>4C==dk__+OD?>bb166?eT$aXWX!mrDBGWL+d-|`%gVr&bCGSf)@FE=kWwa z;#ZwsjdjY`=<=!U`{ed6x|mk{IgI%so{b~c_f4UQ5~YIJK&8*}L{dRq$jS*3GFo~0 z5&q5lqf)8l-;F+pcFCPwJi5Pb8kXsOoGeQ?cUFnL9f91etZsaC(#bk-&+QiQKDsVz zcU%11@AbhYGHltsDnm9M8j@{+E6$m|yj(m2=S2gtl6WCb2G*Ced*v@j>Ub$s@;U8` zw(pyB!G_B@v+AHZ^2%d~)_ao=(K7DD$+a3{J!6grWcZeJ^v+!|q7jVPL)!ARmSy*krJ*W-uy!Ype zlbhsrwpXXQ)p?cH&#Vd8`T zm6x{iw>%WHwAXNQ-#d4@?By-LaNlBeY2M*9B8_%G+hqu4M==0olD#n}j$-hgcm&_o z{xMi)_2poB0H+53u?JnG1NzBBz6<4D;U+LFDPYlJ^@q z?nB9!e1$*lIslDIT8Aa(U||C4Tp9am%=PD~;Jm47Z%JOfdg zC}H!MMFupu>wB*^dej-0fl4lyfQVgY2`dsR{!ZS_+G+~6qWoj=UGWUcvR*{R*>p;o z0G4^edO#IC_1Vb&HDex1wk(nfS1!PW^#u-}$l#DR1u3q8Yk_NlUI`boYfefF#R@o- z4%qQ+!<~>LFq8};!y<~8Ar2D7mJ2RsZ!8Kw7xc#E46G#z6`OcpI3RGzOLfbpmuXxjqdwh4J>P-i!C3~lW*m9RU(2JHiY8(}>}|PER+^mpP&5j1ntjT3 z2R+84#l<#qI^K=HdNHD4F~)dE?78>yOd$LnAQ5ENA10J+jwM7Xs@{?5V_zKHG8_aA z63hC#zzI?I>Q8VTx;Tt$sUoULQaTy4q?Iy0{_SZY7sLIhZpl$K8ix1bLjux1!{gN^ ziGWSwzSvE6t!>5q09%iaUZ$*z-P{}#wh;jKdUc+`H`@ak>x2=@lo#uS5bFdH%aq+b z4fNLLFTW7ohVm9O>Z=LsK`xzhQLVYzw1>C=l!&T;3MTdt<)#@4@304zX!)ZyF{Vs@ z8gnpEQw@cfa^K=OW9F6izs`|@!6%Xda8m}L2Si=`7mUGW7QhWEy`@09CmTgy{dlOL z%YBf7%lZvdTW!+3@)9bavlfhJwesBMbO>J8#{CwpK#`z(QvFQ{PRyPUT#=!1WMi(R zLy=K8^w=X7%%y!&Gh;Tyh^>4lWI~NG#I-y&;dmEXF=kPbzx9L&M(~UzHY;*f>0a_* zX&m{9hWjE)-6SIRZXm9X*dV5qZ0b?>T><`Tcpes_=J&wh-_msSV}?s5`h zK}nV}&%sB3eg{)6eMx@9HMumoy?%3%{P3g!R1zpa^<0muW1nZ0uOophODO8F*o-aw z*cUe))=K(F=dX8}u$)tgfxR}{0V(8qI7PV39;kvuWR5CW7>vLNWAaI2?MiE*K@5=f zzH&3CJ(O_!@+%4DD!(8%TioonJ1IBz1_(S;@v1b`Z}#=HJ7~5hsSaaII+1(cE-w#|X zYu;-+d2c_;2?Ls_VljMnUGkjwz@eAHordp9)~Y_hjEH?GRrXB3Dw?pCZFQ=}WJdev z{~FN8+*|l)LCR!6&BdoC0R%SZ)14Zd0tcGl_4nhhy7V#f&@ysv>sIv4CBJ9b;h_EPFeamYTLc76}8+`^lKe45c94Uyg~~ zcrtR-G(|%(lQav0xm7c;h(G~X3mVpKQ%A8?F>HuKClVzW*9HHmg^R82i{97$<%6R@ zcGl=Xe)!%V;y$Tk@Ue=TA*^o&=qCCF2FF+!9Z=f8w7YVt9GLtTr44hH2LU1!}u7H9>26}b#d zumDGRAL%v*{qTN{Kqb?z2dO!$0N=(mT~0AC)Yt} z><O=%( zLaa58|Fp^G=p^uub_QM9jyMo{etygxbv&W^R zKtBryGEhq_*<3>D^cy#u9!vB;$Nmz)%-NpMyNE0a`@CF4kEk!3G)N*qS0 z^a$~ps_})gm1&}oy{H)vbwdSQV@gX#!%WYb2*zkpL@`ZGkhlQ+7q(==mbmi zZPEIC4gLZ|Gp|GYla(R~@pZ`{-;LvE>}~}=D>bMdBh3+uLGHzjp7p*=E@{_NS7tVX zJa4CbPsN5RrAlYd#Og(%@&oJ;F2-(KY7`(`$9qTCvk^3t<4hH$DRB)Z0XYJ08n_Dt@*xdkzbU85NEF_PzpgGdR zcGq|Z{6%HP{2*<6%hnUJ!wS~THCrk(&6({DvKCE9H2c}z-@qd})Am}S_G^_zuFdnBxCI*q+D(UpLGmL*7ZvB~flLlPAt_G*k4?0T(y#n=Nebcyq)PMyk6d7{~ zYCT5XkF4!lIKyA+*H81@W4<(@(@XPc3W9lPWDl);(mg|P8dUv zMvi7$N1$yrc+=z)i+rvsbQ*jfH_F}o>18=ejHEn4h1-fBJ5i-QE)y$i^8A;q&n<0v zltrR5C~LHS#pFeC257Ygt&Q!@hGvjtM+aL$51hzoG}OyP#CpB^8p})?LP$=->1uHV zaTG{X(bR-i`}q2$T~cwf<$5 zcD#fi0{ny+$4Mc_s^?k4uBzT) zaC@3o)(L?FXllt)?c}j%jT;!WM^nZA@MLBo&L~T+sWj9-a>UmNweP#d2@gsqlsSlc z##r+=vJRHm*-HL7+*)ax*MbFYp!#W0(ggr6=kf5cvVdwQ6JKqEu=jecvFVpn2ZCH1WM7AqZuMw-$Xco0HN$Uv*MS&_5g4_3tcQzriw^8Qi;c0@ z**wo;=Lgr*oa<{F>4|(rm2|B#zR%XXA6e1l!TIi0INur03)Mmk`rav=&Y^M8nFy)u zdI25BzEbid;ev%Z#~F1(SJO>|?DIkDQgOa{nIt|^{u}|ifY`R>$CYEZhkGOt!Gi*+b_LxnGL5w8wlc z(R(ZGmr4lEdl4m|^!PXthaxt!XL80t&vZchsB}rGH@;9aRQEL3alhP9tZqTKwL*-H zO#rakU(^Zuaq8gn;ITWhb8O=Jgjb~Sa6YhIzy3)p=<6vI{tu@Q$JW#?^8-!|V&+%m zv_RL6tcFI9Ssvft@K0+EIs%L(^#^;yHv;(uMx5B)BYyWmEQ|^%`hi;OFcX_IQcJFd zsAGeE53*!(9j=pf%@QGt4nfBiFt$Q?&{kGPkTew3Gi|^$o_aocYwa)l7FH!?Bo+Y> zq8WRBEcJusR`^$1p>|YzsZ&^pyg~3fdNHqx4`uz$i==WxxML7xZegcm#0vPh3F7F5 zpvpq@fIhM8`a?F!o&L%Q?4dDGC1b!l2HX}IB9;M@TOXK9(jYEb99GwcB@Vu)%tAiV z$ndY*2)%R(S;xc5AVTA54hN|LwvC`Pc)Ea($|mE)GhKZ0&ZZ{9H$M@>FFz+tif# z7>*u3;lEu|`ITttwqAt!^X!ddl4*k%q3wR{G zdL>(#28L0|!IvQN&w;?v@j$idb=|P5W)KOx>nr|MDyJSfJ_wv| z_$zGSTxYTIwh9(obLfnSGq5%NaV`x>SqVaL+2n>Ecefa5<>IengqN~Ip@tQ~M6E~{ z@DEWhtVnh@{Hl1)Z#vNDlhilQnH({Us^ZPZDm8ngI$p9l5-xkld2{JXFu1c6V^XAq z+W%|WN33qG*#8HyiF$UTxTMpqOs|IJ+r9ha+3pwg=KqZ5YJirfzbZ}km9<|XHo&+9t%9GJo8WP%ZXU9Z3 z3M3I0$@tLF-S?S-Dj&UZRXE?H3Cg$3TDH;U+uiD(Z@KC}bQN6*m2REMH0nx`6G@eB zoA?dvpC3GI--B9K+3o7^R>m?fr=y|Gv<<#2nGWu6_uKgDVp@u4Kr16|P32{;o3|u% z$%7MZcU)6iR>V@`%GnfqvHiy?FCSifUe@yRb?J@k^_Z`?EG8|-F|ux6a~>~iIT!WU za%&b1^@sfqyY|LsANBWkI2(pXYOThc)c&P9(!k&>B!aM+Etwzpb9VuT+Q~NHz7gr3 zD-N)6x>j0;v`~rC^ddD4`Mf#sJ>BJ@C#$Zb%pvuBHkUq=!anq>rai#1Wm`{S9y!gx z@OmL5@`0>ghxU6eW~FJhJa3rZ!lUDYjSlKys)`uA5<<;Wo<(%1`VhZ=Uo*&3P8kF^?E_4 zDfVDa>`@%Y^f)=*jaDByagc|9V&=3z=ea);H^R5TdhS|H2iL80Qpy#CCLSu#jFZ%% zubja!`+!EsilI(}D4+gxp5L#Y7G+-wL1|WS&Se-5B}%6A-Wq}ui9x!KdH)bNTC6iH zc>&O2L0p);xTYd070fh$8C3zGL;?)2NQc@jW{>ruCG>5vZ;d{xxL(+jh!6JLtW;2l zvU2mKCuC+MuqpHS4DwpX?9u0BC@;2R|J+kj$JY?)enMa9IorFJCM-G)l3hbyW299~ zb>!adf}I7+1E)~*mlN8lw?}r_IMSPW1KdYXXnG}PYM(Gm&y1uxSb4#1&-c0w9=zeX z6J(&N=PI$m$*iN>D`_Nl;~t_pgWa}}y>!`x$nNqzG$Y`*K_+Vgm=1hoAx?m8?znt2 z7XLrS&Z#}Ka9!51ZQI5d+qSKaZQD*dwrx8d+qTiMt=)T{?6t0I9?ah`4#xdfJyoR# zPN5PiMe6LV)weD=XtJFPu?wpBAlK-Z5TF*wr#H(di@Vlvh@h}Oyycu?2U7;j2!?04 z8DYKk4rLkev zivPH=6_Lp4b!UV83x5*8UPOm|R%3E8!wH`JlDO|%?N365vY|G|nvQo>^0fSj0SxrG zlqJUsM^B5RAIUTib)H$9q#=z}UJ0}RttTMXg9$7*;!U|9NPZxtghEJ?NVCZKJQL4SuL~G_?-ry-41$8b3VwE`TPmGRWxD=bsZD zCYKk30k4?|hhs>>zFKZvLknxy`ieH*N=g9s3j}h6OxYuhEmSW=sl;vlqWBLu7mUg_ zOinWPRsyTv_1xnhu(1L#i-Tsz?Vq8>C1hngIN(Dddee_`w^GL6%qQzdqvVtA7~|pqN97yNz#~ZpZwVGrug5jqkHU2cHMm zvOB~AQi+uUHD>v$tQTz=?eF*??>@!_%-<$h@IvDF?v{^YCoAmPw-+nE z%$wvOnrJX99T-8w8Nf9I@}jrYPWIdD+XNVFxSJLFbXcYO(m!&?es{KRt+DvvD%?z@ z8rvb3*}?VtI=9Q3FZOsdlVe!77=1&KvS8#*=VP!Qs3XESqG;NxH_5u@rVy~6^Vuk$?EvN&q$-!lnIHOG4yPp>;wiyr6p& zO=Uy41@Q~y7NB8uYm%wUEtm?C$pmuW!mS^s(#OxC^L28Y~-bSuBE{QSvJ8j zO&BOY_bYhQo^q0@Ghu4Z-C{e4%p*J;zH~$;xTAPCr4{HDwKT_^6-Pa=+?|bzMk&fi zj7tgk2dnaE@X1YXJ7k&Swr*+bCue9MVswm-=5R+jp=sOwWw|!(GU=jRg-79U)qnGQ z6xPf;Qd~3v<$4(Usp0noQ(Qq0fb|ablSm#h9iN(TJR;m_jvEXhAA*B5`qo&f|8;1i8?IH!VW%I8UlqIFtc zyRUSg*!H1Xyoz7e1Rbd-r)RwG4#|j%P!-YG70oS7M7>^?8!(P~rWlbtzkYevV$4Hb zmzzn`VY0DY3MQ8;o7AS``R}-kbSlbrzYcV(1sbJk=u#LXTi{^NJe@bJyZR>S(v;cr z5>HB1s|vc|G{05u#JV?19+PMG1y+po`u6E4h?<#SRJm#E zZXCS1rInPwloZ~Py@eSI9E!|fMos=tRoEs>%5*&XBBpcbv zX4K=Z>xm#%S=nH%zQcAkTro|k+1m@P%qI?YMz?+5{Ph<$<}y?&Evj!XD&SHA&T>xr zFV|PI#|tie@eT6{$#3PEvV*m~`{Pk_nmLJ=LQGR%{G8V^8??f*bli~GdJBozYnRt_ z?%e4>vfjcap;oi&a<~|I-<}CWX|WiuKQL=#GKqp76GI+RMGDbx-YgJo10x{U%Ld>- zawXoCFyXHdevg=l5`@V&g^^2?aWB7jpJ9k6E#~H{CB#l~?D zv>_r*Gl2Z1GvO`hHZY9kQOJaV4~G?>F)FVg$xz~wix_4ZUZCPiXtvSHjfE`HsxIx2$$6zK&V*gCfk)IU48(YY;^!nR}4ki z7`Q$VzPwdtqq*3gRzO8xD1r6-)aq@A#oSl^?(75Xej1|mu(9}Ynbsma6j zpFykU4W_@J=I3jYrh~fY$=kucW&d{29%e8U0dFdRBU|s*Y})}4*kzO!tByV+TgZy`|*3TeJ77m+GzcSw1W=UJ|^uk z?Wo$?r_ttIX2JR@phFLFjXX7+a>Ijjpx>2nc86n>{)&)iC7iF;+otP%4Tafh9U<}P z)tCFyEu6N5OT_=M;yBfjK_7kIT z2QR;!7CE#@=E$Fm9Q8>rcdNp`A5GU8(lHlH_cDuYzFl#`{I1rjft6JIL>(!HDaiNi zZ*C%8{m!D?isi>9dp4?lHvp{iAZ8@5z{Tt{=~t2}B@6qeOjDVgL%5V#rW7}+3`K~4 zW~ZAjIcdYOZB8ZN@USwjR!AfIg%^H0OnVd*{_wg1GF_?tuQZkl_C-+zpfcx5xuBYwbv+gxTB@ZY~#hZQ#v0GLC@#Ic;(_C0bfPEWn7 z8g|UE*wu{9EsrPFd(q-BG7syBGf&3zpNWjZ$%cMo|SF0a^#fS-hdz_rhuUB{t zO!4855+f!!{3|i6#f%6^)>* zDQhSsmCXW$Z?ABQC&JIPYe>+4`STV~Tlbq4w+IK_+#K0=`o8th^03&yqYW8muHlVh zSrfR4%~1FoIBXSuTjXL$*IOt%EB?^$jK9B&h6_~h!i3^Jf8zxb2bGxGOUVm~rg6*j zns1zUP%&v?r}@nGmU>|P^@5u$RL>JnA#Wt7dTls+vBjk9w!uBJ82|z~xRCWfH}`J^6g&5^y#ioF|OTHN7Go{iVC#IOlHjw z+rkU`%|uSMT0Ym71q>)t1W6|U3)B`x7p4w|Jl6><>Jax%slS^QBX~DK#q|5Wa<~JE57mjOs5{_vVhG3~vCmL>ZC(M)&xx|h5 z-%vdVV_{+0(~d`yE`X>h{Y=p*TLX?DrdilXb-e6g`ADDkxKl$O7(%R`3MALyE4>rM z3$Ye-6U|7i2v(UMgce`k7$?{)(%2ZtJCZLrktzA(mewOOQyd4LP_H!6ZX8kGwCv}f z0>-8@L?{a;6azt6lt8=ROQiapp4=gmq{vgcYB0cdW{q)S2)O9l?MOf(l$qP-vM98l zZ4%7Dl!6uPa)gC}{T6fL;S(8E#VH*tF>65UB)@k=ioOGxLfB)5x?E73;G%7>wG=Y6;tyzCxsVOxYEG_KNlFRaLVN-Ryy<)>#I z|h-)!1 zr@e0*1oEK2>6{SqZpy%pA=f0|faPF2fWpdnF%^M0Pdk8SN_6*944D}f<;7OGa*n}Y zX(wSFFmT*1bMHY;=_?rHV%7-#yF-b2g2qg;Ij+|qr3%2IunklB^N1(g#S>oF{iEWSCMW`l1fo6+V#dFz{g#R_^ zOZVf_b+d$BCCUp9Zm}IyyGM4hAXgSpFoli)TxiZ6T>?g$fr!lh#}0b)qaoU z4T7PuU;^23dXZU>^QN|+_^@B!6Cu2GF5Ffk@f!ta1KD^wKcUqPA=HNaX^ZK{zG1Ee zu%zWrkzR!*`7tq#H0Rk1N3Flcp^=$&e{9GkCJfBOq(v8*iTh6$T_iV{vt=t%G=NO_ z(E4&~oB~Ph+aG@qNe^Yx{vEZdw0k>kc&#}S!woz1%4(6a`ViDQTjj<19pOK;JVdWsg@aM`H=v6~nvDXbStGQxuVN?Iic5m>pa0Ea{rOWFge_Eo)pSvsei zoFI1QHeQLEcCOc}{AWJMQ(L0P88AcN7FIf$6j5mK&s7w zC^pv_4wd4|NZC3EtI(PK3(K0ZT^M%n{T|Ksv$hzSX!-WYUt~V9+Df64Q5u}|Ek?0i zb1`9V?8mlkOL-d@w(>ePiQ;ytmDi1TW~epikJ4}V%@LjYOBoD=X!ueHh@Ss#wa&-|7Z$h?x>WCk5?2pCF8OaQJmhQJIT%1ouhtxT zc?l_Td%FdBUfH?h#MK+rQ)BsB#_Qlj5!>y^@_H8D}KQ~hq-!p9y9D+cxF_Xi&L)rKAx{_C;cVdi%j6&*Jo8CurES+rE?(Hv}xybSRRNB0}V6wx6|&IMCB*IJZ|bt# zI2RYC_gYa#G!H*cSzrym3swrBQ&E~P;6hG}lW`ddf4Q(TT4Ft>gpd-)IQ)~V?zv`^ z*irsDh-=PD0H#@^m7s?{BuRjaA}-<`l$)&LhpM3 zCUL^iyjMr|YP}`dj0I23>V?@DCRtk_r3Cmi$VcdiMaV<|qMT5C2!sa1(~_$c80Wl~ z0%|M?w!`De0)s%WXLU$O6jv4@t&w?%*s6RAUNdgv>05;W-0^1{%B6C7>VknMAgEb+ zJh@MBEczu9;xi-#n*{`RW+uCbFHBZr;!YryjBAWUgy^ZBfU!jILx{k8s0uFWYRNg0 zkZD#*{-K(ZjM5KFAGq+=4zd6GFw14n-=tpCJ_~ApCV2K`mAXH2Wt@vTjl3wt%bp)v zUOk>sS&0bh{=mxyWpg>!CJjNcK1&ai7f+Pk{i_qovl@xRk)PmmlJFanVdQM;KSDUi ze+A(jEX@B?cdyabN!t8>sm?jlwicu@z8O&_!GkRUAIQh^wiHdrS5kHP0e_zsuG*d5y50{Wji9C=Ok>wSI*~r) zXtXZ9ox6Thy}N1gWtCkzv?VMr&vrE}Gv9Y-cD6RpyH?KUH+~&Io6@j@)s6KWy+tv% zP1e&~O`#z|{Z0j62OqGPn<89Ae!|l+VZC7<`=g? zUa7utq2e*G%urvfcadK&-hgAg6Pb4|Rp0c#gi>>*--wuAO}`GcIs2Qb4D-{OVBI<` zC?UyHrvSIPu*g8mUNG1j>4@wDqEZ5*Oa*n#4@vQQzI0tO9_;CP<~rhmE!jRaid2># ziwHi%o-6F(uyI4}kn#%8e=R#i!5z-FG&Y%*Lxg%@Db6b*f6J8WHamizHQH4&mOTM@ zVROgfSt$_hm-(P=H&7#m&+M6EoC>)^av?@r1ro<$LQWYVB3LZvU8NfLMDc}{KK>Os zLGoMp|C<2v4W~sJN-4XQ{h_#I0h@vyMt5BrSA};_FK5P&0zUcHj62D9m%#B& zWxFp)aSJwaFZ~nSub;2$;xe5}PndD}vN}t*`Dislne_ufz zcgxm*-PM1HI#haY<76vu!{p0*n|BV3yqIw+f5Gz*{yC}q?ua_6AQ5H`n~`3;g?1Kl!i9gB2<5aLe_CjS*azwL;AUsE-xQr>i-uHD)s%=ZVBa@EUDDFkV2_0gd2- zLesiu5E>uOT>DsR%)i@7$j*2@AJ$K3Z9jqYSfr&m8;Q%g`!%(c-~7ylaSU;i?Iax0 z>l&&?4S@o6r0++&kxCtbcZp%3H31@y{mnm(84aBfoh*phS-pMeB7~+9NYI8SzEX7y za1RX`P5#wV7at!^!>ej{E^;;9H7BC*@s7m)kP@nZuTA*jsG><0a0+@PEZL(+-xx_b z^ijE)gDBJ}Fk{5TFZVXD^xoz>TzipFt^7tLKo~R8RC``UI`IycZNdctvKEg|QlCX) zmkAb!jo(yUaCLZ=EWvmbs20N8JBR04Km-=>N5gk8OWD-Na5d+hu{8sw%e`fp{MjmaBdJ`BEjsNC@`DgIRu|XqPh!F2~h74 zaS5{QQNxTMPa5PbR;67chV{5^L6TD@b5ILiKB9wLAQmSH#Leu}e)IFU!-=W*p64K+ zyk5Rwg7jmZDYU~(tI47e>Q{+?nkLA|R8s$|3I^so4ewPB6l$J$PHaYw=Uw2CjjB_epa1lD0 z@QN|MDHP)Q*;ZU{%CtLhU32-=@sU7W4AT$Sp`xoBrHu{~$PZz=ki3Y2L?M)uOmbUd zhf)s?&#qBjb7ohsP{+~I4+Jy%*wp}aZO4ul|+_z&2{ z@zhOjqOFNr0)N`{2-%*-;j5$$Anz~snpdLj&V z{w*#wKl7@>S*penw#U;c6@i~a*=)NV2!G$lTiqs%q93+`Z$AbDqL>rsw4V?7LpLlT z{Bud7oE9$x%ZpbXD*oqFI2dB42p)lN)h}PMZg5fsGVQVQDQdSLrV|)_RF7#E4B;J> zSHn#Nxhlw#^b3OZaA)DK@4;%G${(xv8x1Pwymxdlxg3@PR_(qwZTv|GGJ7PbkRmg2 zv?M3V4!AbDwt4qRsRz^0u``f3hE%#RU(KaXCzcnr(1U$O{d-Z`~eOe40u7( z-a;engyHuy%k(_*R~Q6qHQv!%*fpx(eepk0xjNQ^i)#l%bgjJ_j>A{_;N>71=j61< zZB~<|Sw^fn=?Nc-&Q8i$zkuYKM@@5Bm7nuZd zA@-_NMaK<6i^|4v~_YTyiQ*8bK_ z7aI5R>WUT|nQ^5t?$YsKyYH$f-;SYsJXe`JW8SNrS^@yOm{Fk$)z9_6vXHy4{k&?)R1JSrIYO@M(n`JAc)Ul)-gf)1O7Id>LHwdbJUkAXQ znsidEVDCkPo|lb~TUm8yuhdOqI)pG=IVHv(_~OA~YTZEd#!ck&Uu3nLaTR-h$U@8|7Kq&y%yjL7q_NXo+v@wk2%Dvy(G_ZNcr8zR&2`YPHOa_Z9 zt@xI^;|A)p9v-K}n>P1lkbmVK0e;eB%7;MuS4u6HR=d+%Dx+&KPwv40bGIB7th1ci znrxs|+nTTrxf^@fz$mNkOMRy)I#XzDPAxkCe3cElL5^TyCQk2~=fG4EXqGyOL;*Z3 z=3~Zb`VPc|!p%#r9Dv=3iAPy*lKV`ro+BFPI2aE8>roMmv0YJSBo?p9zn>`}U|(kw zzKMxCob?UgxF>cMg@uLe%)UjKW+EACUo8sbH;`D^jQq%qe3%(?&~G)_lVNl!dgEBY zl+)X?Vo~~xK^RVMS6wj9a55c*BB|OdP-HOI$=(*r$q~};{Rz9riWEi=x$B#|g(~O3 z(Mq`lQ;Sw}+l)W{8{oSdZ-sxeJ9u-Gd%*O&}-8~k)I7fLV?AUXTW*)<6k4smWOpEMC zCrLPk!Y2#KgYi@gr5fKyKb8f49tE^gzIy%>=yLpb)7UKk8+3dAKj;=MH6U$4x2I(Q zDs6CBVX1L=`zt5|9Cb*#seSXi9xbZQuk&Ly2v)vQx^I*72 zGQ+YlpRFz;?QrTBbjDE_!^`wtfkD6c=0ZU;x%AzeX5Ain%_-`3Ugvbf6{&4TPgTST z^s!veW=+@0gX5KDt&o{mp*WH)Y9a0({k}i~e{8J3H$5kL%*HTI@>H__>ECDbII6gI z9%mt8m>uvI57NHHKqu-hVvLeVCGKufb?ford%G61Nfvm!$X|4HKXWeAb9THL*7vN* zeI1A6@0gLbjrrHN(mYg<>ME*Qnt#Z95A6O3Fa z>46FCTuDqR8U!)2x9sU4UvRN`(N&%N)m(UPSEYV`tUrB(DE4Do;sHN99fIZ znp?f`t!>a@%k77^$Ng0{9_5HdnDCHs^s5<0-E}=I#B{HM#Ju9hL${a1qkpQCwO6`S zP}LF57xSZ(u^i`(;FD9(IgBGtALxg`jg~{(`)EO=X{3_IHy4tXwrgO0sGDQRHBf-4 zWs4K;3z>ih%NW zu#&h#*@f`^r=L@P7Ir>ncisTB%Bi5lHU(>dJsk;a~df({85s&u; zUHD=dL4@b+C+hYJv~(Tf_)N-~_ajiU*JI9k@4B@_>-iaAng;#)?BsrTF0M5@@A?;t zD?em9{nME$N!SO;16^VZFrBENY?F`J8_5N&1N@J@W)8Ykd272 z=XAWa@*_YkJspkN$JLbtcKO4D&kOcg1nP`21qq?Q!8vdhy8lqr^ec!jt!|S#jZwbE zWc(5AFaUa9?;SK#{}8U8KPV3!PF|YC1<>vVLOR9V!Hw9L)D}Xt=NIHeSdZ){nXuwmB8$a`E(4E%`OC-9 z4r~`V%@%}%?$Z!njLpJka#FE>3UWe}Kerl+Z*3FCGD^u2o2ZHN=GEDJ%zc zfo|sAR&LZ#;PkIDxN7e`Uph!a29nX~Q#IU1eCgm+=re7ihPzxoMeb%TKebJkBY^sce zs`oNWKG+s%kEuFHPYH*@gP?|aA8b|^fo7cBY4ePez1#zR;k|MWXG={TK%s{=6 z-T?BCV*aTceoR;8HB0tb8^Bn(``JXF0BS{_TmySj4f_+IK;@Xc#Fa;A0&<^?LUtf) zx?z&AEOiI+#5`7$@x}Ijhz5{n{c;4NwX#DUbQS;Jd5=z?B}($ z^Wle^=A7x5%0|aQUtLYM3jp>OJL^kFr-Gr4Y~U>qVr5s*Qw67MMy~|H%X1`D()Pdn zy#mY>f_fqgqrX(`1xzgnSKY~~EOY@hPF~|I2sNW@l}#!-wz=d`;MhP{;HGqSnYp9% zX*s;7nt77BmfCE!;;tRk9vQR%M)ppTR_u_Ig(-=G*|~JoF+-rU>JT#jkxu8N@>b88 z0)-JX_^Tqv+OQ%$CFndHQN>{0b#S7*5O(gjEj2d(6o9x@Dx1^?>DAi^f&KxPNo^ZfFf4V0 z2t#r7c=$~3veYi?Y5lz8hFin=xf?lz)zl)EI#^)N`f{yyRHVuB zronm+;jkg56=lJQ%b?M+KlSI5nS_4?p;+*8QpYxy5fw6_C`t~&()1T>_%#d=qzZVn zLD*~Q#nH#;_ldZ61D*m>U*5*GNQO|riwxZL`Q#_@P-yPhU(1nAL@Iw`L*-NoXp^S1 z!)=#L!Vq=K1sIwU4m!+*kF`~K|IMe;U4@?71FjBO??vyg{+BJ`wj|`Z)ow$Lu#5Ft zCPG}Dm?O>=DU~G3(!)$U&b#WflY6dJ=#kQ_ku2~w2Mhk34PqOZj)9X1j~IjcQGJ^+ zBQXs8+r^5Vj$TKV8PxU*khhkCO%7fjr$=g8Oj|$XN7K`!Gc&9?PqMZG9xFi{!cMPK z+@h6jxILS{FNdmp@Qu$^T-I58QKQeVdwD505MaetYgzsyE_W^;a99;+j(s_ zjkD5e%Se2P%c0UbJmQxq(f2vrJ&R6hv9IcWE$}~jwsk*(f~KbL9#=&~w*emD6&`)v z>Eo~xS~vP0%pJnQE2f9!A$8iZWNTF5Q6-_Gd89;-wJM-O{E?DQCfo4qw+Su~aG!6t zUSjtjbpEjBJHE|P;jT%%YJbZ3LGIH1&A|n)o)iu7elpr&o5N3>Z@`k@_dFu@AGgOnnD^D0w>IR^pBrYL8I|{y zhRPkK@YxnS#2|sH$fO=G*1EwOIT7F|E2xp8E42@B$eaN4Zi!rYIv<375h3 z!Vw>Reg1nbtmPY$l6RiyEbBb&}6cGJ@Ag@<(jHNMX1Y%h$zO86pbZ_&e%{rgK@hV<;p_X7aY1nj=+ldbJ z*zo=N?n;e2#q7log*Sko|EeO4rSmamBE#LcD<(KE(XMFO^z0)cdwbUw>4=>$Y5;6x zSl!QT_@ejIe$D)SFh6qZOiM-k=jUHOR4r91=084e{;N%3W&qd!Qt_8HZQ~ckk-m2f zj4Dvp(Dl3R^?533@O6cCppkT!7()a~WR<>He)s~4H^=D@; zSesa%cf8l4_Yl2<`u>b<5_D5q-`quca0*){8{79hI2;&7DW`f|e8&E`EU+k{hTvTDao4b)yyc$KV2W9t5=ikRbz$osf{To8ct1e|74 zlg{Ch;V2&&qrpTO*CUToHFgReWh;>)McD0;B{;9LtJz93Wp;5eUvvqOGYQIOP2In6PqbC_IvCH$-xd~ znAbd3750*2Loq`{4wcTyIviWbrySOq3bfcsM)@WN?TV9J%#Sy9xb^RZ!bt~6{IMDI zzt^4uszDk{6Y`nzqV z?{yS$KNZHM9~9_?CE=tl4YgVU%V>@rzz7PJg=T#+etlnaW?N6uf(tpxWiuc>M;)em zKjck=ry2uq#|8-0OG`DU`!~EU-us#%P>r`@ zCSiGEotT1Z`0nw&c#+#!8&!Bhd^YVO&mb39X;wYh+uyT6pI@i< z`l^^Y)Og@bVT2}P-n^<>sjIM&qX&NF1u@)#Z|jw>tl{Z-u61f-1qER~yCsu!Yh%FSYe6yspeA4<@=yylVK($x`Fly+hkJNFp^ho!y;=*mmN&u`z|gC|^D#qTO<% zW{dQp!@Q;s>(b;0w>c@JkClXk4(tbIW83jh3dAREaUh#>$McQ|Z7xN+*D66Yc;UHS z8MFj+{t?p#idoeoL$`)mRL1LXXte%hROR;HRQvv;X%irnO93oBkV~2&E=Yf%0AA*a zgwoGgGTo!Udv!;@DqwSe5ONAo&v$!q9<3O2*Kn9rLo?ckm=Y8HI?pqcT=Z8eL6{~e zd+xBeZqZ6Lx25|$o{knB9Gl)SIuK8OZDm14Qz$bm9apa9rP%U8MVx|P>h(lsDt)5c#*)V z5a7ESF)0(Ny&4}(R`Rj2Eaf;gz0S<4br5gctTx_@D4JKNW#Ffxd`*MmI;fK z3e-KFP&YTFyf5_+6$4QzW!w=(7NFPhqs0;!&_0dW>^v$MJWFN2o4U;c#F%o0TP#ZcqILNDkYe zWh0kx`owk_^!)61UBx-)qRAa&`1}1Jw!Nx&^R~j*irxEe3v_PVZ(PNl74zcDHJQ?2 z(=Fr6pwH9oUW&@Q(9qp&LW1r><$j_fW}Z^|G~?eR(@}SR2o|}YPPAUYv4B9-q)0^k zve=#kE+?*H>`i&lVaZI?J;oKbwCZS$7lAkKDuNAl5E9L_b=&_7i>$eD{gr0?ZAu|z zel}FZ^5MOhUdv$O6G9PnhMmVD$s;pWw!n*UXbV%vRZBIG7Z=>1Y&ol-aV!&zLO|#4 z3>XyAxtb7}e_^IhCdv5y4bbKgPE;y%VpD$9*tk-Vi{#cV%L$@!X7=+a6;F*Wro+)4 zJDR~^wc^SN%nT{p*9>Io6S?+d){#nbifBkR93pbMNk{v(#Gk@L&~M>Ttw z9F%fq=8C4oaG>5QiGv+K7rE;%UftE&MX}vTQ}0kd{Qla!YY=awxt#|WRU8u>vun*K zr%p1E#J)l_F7W3*9BC%&T@*9r5k!}|p9gRh{X7w9gCQN+SdJpsSlQ31 z*nh^AASS3Se<^ajly&+$Fm}@-P)(vr+smTH+-nj}*_GGmpIEHrWY*LFj)3UK6x%u} zYg6NE*3-jlm*ztUX=Uu1o5eT!S$6Z z$FT-Y=t|QisI%)E#x$h`YyPH@sWB}2vR3S$P>81v*aFADC1aT^1hWxY@|>7wYKD{m z&AfTc0lq3&yQ~4}K_glLy13k)>|ye?x_|qcSO_g>a1Os|whq7NcF@BIn?7KHo1<_r z7cvgsw-6FMl4J@43&4z|8GY_62$$>|1m`kQ*jFxRbnBqd0N^H+Jz+ zhIeufHH3-~Hd~|-(l^{C0TL1p<1uk`ye~cA+_oV*D`E84ywnz zC^0jsWuH%k6r4R(PUk7@79Nw%*|_A)q{$BKa1R_6h+5=RBbHQZQt|`26fBx`@m(+x ze*hd3`|F;1_W8m zR0DWp48#3Qq7&_zU`;bx?f^fPxO>8Us%SF`pdS}Ax&k$2lP6G`M(~FULcI8fg8I6A zohAjH^#kKwx6$$+)+wJNG{WCIa3ATjpe(mGj|bmx9;*b#N0-cg^XvT;=`f*S`JKA+ zUG${25VQEVp$zPKpaIkRFin`HwkC_*vA7~EBu#1K87FBX(6Uq`7w4Y$O24oWW+4IAtcdqZ5vDYLa)GVFb#g5bt# z+!e$IVNS}p=81n4IKu0_!9`i7PwWtgF|0tUu3q(BNjuLuc%CzfhhyiGc+l z$)m7;6*D*6Rj#yB4_f6_Q%eO)8Z~QcGM0p9jug;#>w7SJs8`3#wL9DhfpR z$R5)+K$28q5~Ndmu7k2E6|A^7q)}fP&o(s1V>X0`_stf^^L;Lk5D@5RFbXvS(G^bi z-kvDp-BcR4g>9w3w8Xi5Xku1OrHuXV(4Jzj!P+y1fJf==yB)B#V7uv3NynCq23doO zQ7v>0BH{hTh_;>zlaDvfn&nz3Cqw~N>*LwrP8a1EKvqu1HG86H&EHWmARRk;e>q_X zhR3jkXMvHS{df_hgJG9g3*ZMD-nLQ+h!ZbGEN! zG@@LUiXPxw?)gE0MdJMni?oG9t16DZ^y0KHI$21j9P>?(nunX3$67rN1^|&|++1>;VU#S<$PVJ<5t@)q8XX9v;zsOr zU7~Sh+M`MC7y}pX65F%W-glJQDlNlz15_uHCu5)b4Z2$yM{2+L$=T@1D*qHEmiRIm zdEeBb^*LFrY~*FXYJiB@&+xV-R=ARh82l+CIZbtRsps_R)U=JZ(?dJ)*r7;yRJ=^b zktj?nR+^t_iU9&UL5gIrU$2?fyIc2f*KKT={k0Ce%G=6V9(oPMiZSbL_C@wM2KgZB zgG_DRtD3J^M5s*&!s}-dzU(dC+f1JCA6fg?kXqGRIr}4<1$XwI{mYhA6&3a@FT?o; zmL8*uPqjr{qO*~1CsU^aXca40FHny3QjW`o$FL^WR*c_)S5V^s9Y<|wy(&C=4qk6; z5~+o6H>UH+#Mm+_zP#>2ICD_aT&aArpR&e)Pc<#UFE_2dmR#s;Z+gh1!+1Lt%OM}) z(#2yyXxPC>KXZ4U7o|Wzfq9Dh)U*&@qJ%aju;3pz@C@V@D%XVsf1jHnD827Y=LYw} zrjE_z#KJE)%5xtmTx!RIyX2D9;op+ORSjUiYOkSu`ieb0+n-;EKj46SY~cThcmLHI zATt*y*Z;)3X)P`LBT*#3Q;k>4J4r|TylXd)18p#rG?e~9Gs0{~N)tC@bKBW4B0t{c zv{CsDRwFGC>EgR}HN8;{gOnt9Xep-8L{a6}(eZbRw*y|!wAy z-T4lRL}KkdZ&xWjFZU_w(8p97&;#jf;k9nlUget<))Tn@7FMXKor~+G8}DMj-BOe? z&Ru;2p;y0XCQTDlnYDz8$=~$XTI^gj>ZWmxlkre1(S8rB{;j8me8`mMIHsEaRuzXY z<=L*b$bAprsSA;uypr!)tZH>eM9iv}U`J0=>PPP99q%I))r>6DU$<$V^U`_tmDL%5 zVe;GeRd!qL!YzsgZ2T+uXsp;0@-_8~R2w7!ywBjrq%u<$nO#e@eSsxmaa*0;%9ys`Sp^(A1 z9xXyri)1tXGv-MT7~(-wAL_3SCGSVv=TFvFG)G>DYcwo-#5u?Z?accGCLk8vb}ne_ zG}+5<5!g>!e0^wV4hJR47oJdr3I`prI?IqDvj&I~ceK)9LJc(Gxu|n| zDY9E%z$Nzb2Pait(zw6NMc6vuTdCDAjlSU0V&RDbC;2?)ZgbEk5g*?a@vJxU#9}yu z8yCQ?X~vv&qz@zMqd^+_&Y$^3(2p<;2!k!MKPkFVpw|}32)j8EWWOKO1cLb@x&ev$ z8^J?GxTduvr0GGpqit0NVQ^V#A_Y`>%s;?<%BPv_5w1&Ztxv8 zH!MglF+t%yQ>?M{} zwAM%v^5(}RR1qs<(6Fs#g#r0j-P~wbsXX2Hkcy6sD)t7ZF6pVx77BVSJq*}YF|<7q zmK>6mMon|d%R>GJWlZ#g7ok7I0Nx@b&ybAB2qBUdM%bVq(t{}AJ@1bChykvl1M1FM zJR*+BE`x3WuyfW%R$5Bi-A*3cZ_u^IbtWK_Noii$Ek4f|4*v}y!mredisXxpQWsD? z8io}6H2E$;%OHQ$=rnMDs)3GSwmx%O$;AbkfbA{oIyn*|?K|C=lmhT901LUJDWi*G zAl$WG19*3NEHNCWgvx;NaJ|*i%?5Ove73T0pkq7WBF*ZqH^U)`Cn!1J0l0auz3@@? z#AUwW1s7Kc9{i)j{4eJx8wS`3mZqBT7ZCT1hhU7BV)uAL1O&@4TS*GSW75=^EK17U zbxjyrd-#V*px_$yU%k`0LZ?LM;%O_;Zloo=u+bOOhe`}5Tm|R|~U%MhN71{MkD7N^QJRtQjHqy59 zi9Y}Cz{{T!O?LG^hQQ(~VV!gFS$X$K+b8JORG?#OtPgR}n&92IUEsj5$D=;>eva#uneVcuO5-HOPa_E2hq6X!?)Krp(4slgGji#BQzA#6Ey#B?K;wZ7MLx5?L6s4ff z4*>VfNTD}Pn{m~5+ZNSvt)Cr}WFPIk&`bJ1jJ;!XCeXI79ox3eC$?>MY}>Y-j&0kv z?R0G0PKR&5yXsV(eQJGJe_(!_Rd?NEjO+3&hm<#AQ227Gk2Y61;^eokFA_GC2xZXh zWi_2sX%%eVe`ssM;$}|+8WmWdMs@S{0o*Tj41>T^7t>$=JTf5-QyeBS#fO?&+jQ92 zK+~(p=ea_$(nIC1OSyakA^tgy3dq_EFqM`u%0~*SdhthKzA;i4# z-U8o04bY@ku^z=^gd`E1(-_HPJO6D|s1YGDfAM$F!KjO?8HPVp4LKhjfk3DV+>ZuE z(wYtQTdW;DBJObHR6GD{i-uQZgK)!;IiG9eg2@2LcJb1k2Y$jD3Pq(hD`>Z|QdS!k z-vlK@Z2of;fmE&t*)%F!$Os$l9nJOSbBST->rF;U??2?u$$;MOWkGff zk&XJDia7=UwZXLoCH^%#_lMz`#@7f4v=D(W=H5-0V3|bh`>roW1TAt-3Uhxc@Wkz8_Q%Qx|v%`w|x7r$E+&<87y;AYXtklZF>P7 zy=j$M&qVvw-utg`Lf^wKubx_tHH?YAsh5FWU+p;+v&0cMU7HhG${gJ1tXDM3DFeG~ z?rU?YQ1UPs0d?nFy#v;BEiBn+Kt<|=f-|g4d8^pRi5!+b#nL3nZd}zU6jK%IC2!C zt6i%op>GoSleo+snnIVlCb646nI!G-^}(OD*3e*Xna+(}O`>@9zbE`pXKDrampamj zGCy6t(GwDEq?1oT6;|P7pNw^ivKh^)+hRgMT|+@PAW&a>6$aUWD2sy-FP`CjA#z@G zP=5JaXy9NoZkJii=uXYlEbqQDA;g4z^mMsN5N&?HL{zJCJb1@RZX&v>EXhzK@|W*dA{$!$IRCTMkZ z#Zk?r+A-unwH#+2>^#u4v5Q0j-f+{2QIRycZ?3K}*!?+(!tlnbCR zdwMs}VUlm^(Y0e+NgLmE+^T{*ZZBXg5Qv`Eoh8lsF}D$kg+3tAhjf0@fzheN?^z;Y z*<(|CihS@*G{wI117dp&2$SZj{@7y~Ag2WWevpfngFuR?!Q+&i$nBue z%qj2)?!2^Z8D^5ugQ8r+HaNGB;l$=CvLD>cA8K6h0hw;F6PVQ>!ms&^h3P3oTG}I7 z%0NTF`W1UGq1|=Go5em-NaZi4iaurW79ZL!)UnDiWx7w=?M}!t87;Q@J@FP8$?`d( z^hwl5<5%w$C(FcOA<|zDlS`r4-|7#TDd-}4qyo%Sf`CFV5c6QyIc6ZkD2;LIdB1KJ zI{Xva0xkJ#x@ltqa%+B)LEmEWi4CrbNznwc9&{uum>)w(!4eu7+qU0oa^jQ*#sZ*v z;s$11PU}$lA%YEy<{p_U#`hpqy>ZK)1+goTK+q9KSq!w=GMHEh({(Iz&%ouV@jz8o_)-@- zSVsqM2#>${$O4b9A~9w)Fm{dtNPAr0YYoF7mr7gRGF_SMkRM8*gtb`;Wb%a`eYB&M zjsEs`%12&)F0Sl5mCa<;A6Q~SIBxWd&DBgZl7fjd&*m!h#mpDTdVlTerk^Gf%_K)} zvYvV3Ff_Jm}_prE+O2*);P-ec9YmqJk zBL@@AX@1IU66#j{c&}JQY~e`5UvzJZ?x*-4I=o8#NHI`s$?dp`UGs;-F#d){Au;aI!y^j5z+Hy6^?hHlJG=bb7K&8?0# z^Mj`d_;8N^kc)t$$vHj1B=R9fp2|b96a&WLp z(98P2#**Weu3~$XM?|TdG;)2Mj;qJ!+OaPoQ0=D@<$B%X!0lvLYsNoNi1~MWinnF_ zZeir;SRgypK}B4_aYn|ApZDz=`p?v!+^2r`$)ihiA;Dgz=pJ8co2TLFH7=U_{y}0{ zB28*$AB{k%mD)hW4pQ|I@sD^ zKlZv64Y)>s7kLJ+`({3Xx$<^FiRP1NzVZeq8ffD2uMXVOABk>`Sqlu=PGu~eU8^oA zsyP*ZX0t&*!^i7(WbN^fk9S|l;Bu(qZnL7i%3Z0K4sEFs^V3GZM=1$%0BhZCmjs`H zPUu&U601Ju2XF5M)1Z5#@WHAsP&-XHw5G_6x-t%z)i}lBf%*V2uQI=-MHh7knRTa=aPZV(+{Ub30}kT zl}F^ry4_~X=ePP=B>u*P77yO_un9IK4>H$qU>>T7>?(w0Dcg~+AcO$sJ)>Cv?%lpj zcsoC_5H|DW;u`SobczQIPrR;~i0?iW&uy)lz~`aAqaUX4e@sIEoxbJ&sYOP#fJumvts@kH=JiS*4j1`Yut1gqNUGSKq*Tem z1dF=LKAtZj)PD39RDu0nO0YjMt7Z-_<~XWe1)9+5Bk1XLx3}ubHI?M60aaPowl9md zJ~)+jInJ{zUxqob#EpHsHO>`{`c*UYb$wf(w&dkxQMB>DR~;(0FFx|9qi6(~VP?mg zoD3ri26H|dyg7N*KG@2z$0s{5G&^<=Ff+caZ9Uc4!z+L8h@p~IuX!$#p8r4V4E-KDU;9mFcY_nB1E4Vap=csk0r(2dSlqg8&tCnc}c= zG0Fp+$n5z9lL&k-@vL#QBw$~BGhGT3`7u!JnXfHg-#gqnt+#!KR6-_FIeayy2`R2= zON&}->q>KT9+;S)7J9nu&;FAIcCUUla0^o|E=Q3Jsfz5AT3a3r5mD~LcM2V0DB@!t z&ZT5x1MtQ`{(4EFyuU(NB4oo}|3$;J%3YUd)J%+|-}IE5Gqn#B?~2z|wL5PiJpxx8 zvs@MBw44dxh?UP>ja99lPnOKaE#z*^?Ff4gXH@|RBA4p?n7>%%G&WVKcd;ce7pT*N zEa#+*4z9OKdFZ5XLWzarBHwXtpyZQT_m4#MZwWC(wY5yt8)JE2r{uP8EC|p^5b5 z299{kijzOu4qDGF%7P1*H;Q|rFXXG&f4W7X2goD5lWDf>)Oa7Vg~zzBoQXh0y9NTcCbT@u#uiSFpbf&vvCVQ;s3Y|UPS4A zn)_1ZJNeo_uc#Pf$?JS?xXMl1voo+a%JHcV)4hb50r{IB%6Fpn#{-_B85QbI{M2y> z)d@Z?R7JRwA}FqFRTVR;#b+=$(P&^KK*Jfa3u}o1qUZ@PW`?pNiBTL$)yhpp-+;6{ z67|9K>8x^OGgtJrLz_kTI{W@eM^PjDk%Mr-24}&+fxnP?;bkM@#HrZ)SbeEykj|WS zm}aNZHq&he$iE@CeYaGnSfX%tMwzb|21cVg0u!x%Fa~@Y7>df_bgvZV9KuG?$`c|N zo7uBl)TBqE(ki%%ls!;xpHai*-kG-n=fG z%UtD7-vOLb_#AcuRD(E_o1`UdWoo3wz>Pq(-K6nh=h^@55|A6lv-&KeG1Amm^j_0< zuz-E!&#p;TPQ@!%nt!bn$~Dr1gefctd=p>GGXl}qxJCd(snJq|T&$!IUM2IIFt!h59^@<31ijyOJrt^+eO zJ`LeWc>&poR|?gib-z=j`9((hVGDnEf&}gI-5cx$9N8eV4eH}%!W7K|_90a8JBwJj z&l(YaFe>J5ACUs+3X`HMB)nbb##wz?cQOHOLhR|wQvpOG+Z915)cdEyUWHvoyqP_% zFqNEcR-8zod#|ikEX}W~ZAbFDT@_GuowN^mJcUv-O&64wH0YZH8bziy0mhimJV0E* z9Y+aQsHz)A8DKloj&E4yPL7di57o;sOSP1`v&*Ik7H~o^fz~4ULojK#DaiLU*-4Ss zNq`WP{|E^yHC0abE1i}!nV=1JU1zcL52EZAVVhy?S;DOd4OFx$f_8s;p7=KtwohgZ z!Y3F;q*22ki&dE(sP<696cbdv0A);_p@BbX@w_XH)%oA-#$Q1xBkv;(iE%V9xoZ%m zM@+pA*Hk{D8ZVt4?PJg655fiHG^J2U6oaC}a()~KeBfB=w&h)rN62|rfz|V_MfF>V zwx@-8`~U3pk^Q)7Sk(0>q-W$8>r&zUCThOUV4j3%?XMj4Nf+0X`TFZFsvW*Bkb#q4 z$c!%Td9YfiXn>e?OvywrlrxGoUQfe09is^Hzx^@A@o7Q95vp^xphv3iYe~P9kJo@K zLN%>)2Rg~x_-}j{v!&_e$@)zCOWXOVV+-Rf5 zQKeJyv#I?sH-;o>KGCrXU8&Z4RV+oo^2UQ@5r?QN^S!bxmH09AB+D%KL+_rQ$qnbw z^bq)rMFUsO+(`ICBUpH}O$6%To!>6dptMgB-iMgs3qnaI@6`Vwne&;QSR`L2!d^%1 z@x*b-w-h-ont1-sMITvWPrILjg6xnqMq_{mPpl$Utq`dIgG&H$BmpB+<$o065?yX8 zeXn^5jplB5Y%a2Xb^H{duHdfP9-@0gfgm(42I|E%Rlqq8H?cO5BpwafQF~q759Ku! z=Wc9vHp{|}c8jh4Jj<_o7h!q3b;V-CGmPhkdVN$ZMwUTBAd81_l?xrBjokeR=UZMAq%|60Wzq-!$8i`V2|*AfsrnQJ;iotb zq1MND@Ejn<$mH=g9RU~3baQ-^;zx6!Wh_1%Q)<5LQ<}R)0J`7o#s5q*9?LiJXg#2_ z`YJnYAV_uIGe8odoSt3Hu*?V@`bb!%=M)FMPdn)plu~0_(^Dz0s!TV&kj7NR#of{^ zv1Bg=AhEjyC}Xs(OevMcJw{0iy1~ZDlM;xSa(Nm7k|;_aXSvTo%YPjEeLm)t4hOxl zRDWEAIqt{e7O`j3`VY#Ve^0x-=1zvwlwhG*AwvTH_|ujRjyBw`F*OHf^YJ9M!NX%U zPl^h0aN5G#VZ39A!*J7Ed|`tGcHwGIPb6(;uP=6#h(L6$G3*D!p`VJLQYj6bWQS^E zziVF-V`7e4R%vH*ym-79H{|Iwk24ab&?~K~8ckkz_k}ZX=QoXf6S!4*{EhfL7G0p{ zQe@gX?DOx9xXfbKL7fpRIL8G41?ls@Ym|Xx&|!uK%nRF zoNQM7TKSO2La9jQ<5WW3W0PXUkn^Os_eljgdS~8Aza3&L4<1R^5QqbsOn*OV7%CN4-cE-H6+}v>l$giwy7`%8JsuB!b*kT z5f-9JgNo*~|AuC#r0*BnTbB|!5$wElrQ7JGWc1r>3di@!=mGdrBM6vg%jCTf1@5~0 zsISbrj(R}43Ve4k_OWflA!?tExqowtkip*(7* z1MOWkjxw*RXf^P8-n1>aA#;OJj5f#aJRgFYY$WR(JgZLkhlN_U&92cEPm-?#E7b?v z8&9bZ%&(BTdoH^;3A@A){S({r*LL1uutW_Re??arGt`2HKiy)w zS?z1?&mJ54_G&+G|F)pphHj_+W9a|yEIC{N_WyepI`R)FxYhnYt8SJB5L-I;E*~;%zN(Q6wsrKi`m&05kSD$=gG2WB=~yYD>=LTZ{HX~ z{e9A4-|}uM7jNP?x(M~7@f9=^FnrvdyAI99$Z3<;x0n8Ta%R2{XY}2KVNy>~{C*b+ z^!UD-`Nu0$n5wHBp0@oIkLJBER@~OtB=)r)g8u$@@(F2}c;RE!*)yIrQR{U#Meu6? zPTlQ(({GKic{Yhdm#5{p;j1TGO9y$(59ekOXWZh`yC6i5mSdB)5;hQi#xD;(lY`4#< z(wM7x8z0)U)4u$EY9|7WRk3Z6p!pSCqN%u#{CMIQv#|kjJ!b8-bQ+DwvVRdX^+@X^ z>sV`3lU#y_NVh!RxpS1Xy7a*r5OppH1)gXoQwbX@mnhnbp)w- zMzRpWas4W92X4{kP^RY13nL^_*QBYkwrhWiOύVGhEmbU5q9VOZsrd6Iq6^~8f zKNn+%8+beQtCR2ghV%AFY;l2Qx6cRUpCa83_r>KA7wVpf%M%QFe(^dQ77CDn0Q9pZ zva@rKmcI-njxZyzV#D6?TI;UkXXAbfGcLPD@t5uK}W|HeJpyyN7NxefAmaHCp1q&xoN4b@VWN-pv;bZH|*x!m4*&wFFw0i%{1(q zC4v($@_glvw%#*)P+iT_qIGJifH1oO8|w>2tBV*mmbERQRgB13hGYYjHByxOfAV20}C{8tv{N_7-#4 z7=u%71jbtJ>cRB`OQuRQM={&&kmKk5AWzEr;bw{OLfjL~&t{C5^2A^Y$bfja$x3UI zu?>Ct3!IN9IG=+z2lp^2ty+q+cI3EU7A0pCim}#83NnT|U?bp*5nO5>$Qd<^L$qjN z9hT^}BJi+$JhLZjqr4h{?m%U9iBD+Y+_L~xF1{N2 zi1q%5-;u*M-a?b;mEQyF{2(e)!F%>90_%=0C2(~ihkiUShW749Fw7XP;N4XFdtzdH zVq6}9b3lx(klm%cgp?PYVk%=|5zZpk-e7_DW`zx5_Vj@-Q}#pR*`38Pxb}uX&tC(O z2*ySI%7v=h+}9Wrqy`u*L8}Z6B|vML6}~I8yY+y$5)qnWrhdQE2n}!GlmU1M3kR+J<^nCi z2XnxXF;S5<1@?l%cZL{%cFB%BiXq22`i8|4=;sgbY&pd>P=#Lc$X`Oxh?Cywb50G? z&H3DNnE@I`X-i4}B3UGr9G%g-g&kMwf-!wwSP#o0NAsXQp1ket=Qj{IwkK{%ZJ5qn z;T0H0@bQiwdzSe9hfGrBxB7K(=+24rX5PLL4p28YA|MsSG#aNDn1HZxn=s5QCOF5y zGFKP&KAYMVM<3T{Fq5YTRMad6w zX=!OIS}TGV zc)VQQPaT55>J^F%CRh_fB=J{=br*A{gEPX*uMip%%_6=*@$s2pMa|}r5oe_C1=`m4 znghm5NaZ)Gujfi*bEK<~_J<`H=2lijeiZ^rhsO6Ize5lh7F>n48C3u!OKH%#AAJ`U zCnMf#qDi4`Dn@1vz8q`gM43T_BAFSktL}vC&1Gjs&fiMxs)81_IfF=}O%&S>1vKss z=leM~JKf^w#u~Iu{!Km=&%KH9=nya5OOH}a%|1EAeK64**lSb|(d$fc8)khvEHpP7 zC{{n=aah8fQdV~nPi{6)Wm3?jAO0slu=d2j`G* zKh7ySBPOkMmizqINAeD+r&HKx>YfP#C3u2f4AG}9hw~V`PPJP~EvH%~f##Fl?d9p7 z_!@1a$)l~^?B!~!Hp#@!zRS;o^TZTN$n{q@nb*!2+2~fsB9MX4%o#PjyXZZt%zoHq zCoWiX8lO#dnEgqs&q>ka;UjIADA?nkAVnJv^fNGj`C?P}t~Ic;ZRu-Dh26d`CEIk# zNVn{27wT^ z!s?8?klwS|3M3ou9I5)bl| zr&Z5ecl1~G*4ruslW2{Lsf=j;;c?*+)n^F|aGtB#=?R zRnl?v4&#JnoQ7x8KeaZZ`bcM7imcWz#d}`sw`-9fy?NFHKp2iN6W6kAM-q_pQiFc) zS7~nDF$E@0NlXZL{xK!)p*MD3Ocl!Wyzizji|&&Zgp}zJ*%P+w0Dxq45^OXH3TRPc z>AQe|wjloVR`2LJl7>8yaPFwwWI!w!>Sm)sps7Rq8t#6Lb|q={&n^_!$+6h5DV%P4 zR|TPWc%Aq*UUJl%e>Wj)5qWXU4hAzHdppg(ihrQR)y%dK>3u_-oULhW&Im-1I5)f* zhn=D*6Y0^I7^ONYW`8`++z|S|AqIF>+5D%3&h_6}e%P7**PY`3cr5?N@-t7$)-;IX zPUN{!nkCP@c+-5}jA%z-0o}MJSuCwQ(b?Dg|L-SktOkH^?G~kahNjhTu2uj_-_@V@1?GGb6G~J zNe;I!1Bn!DUxz_5SEbKKo5L|9eZD#p$*BQnB`0o%I*lUX%Na%fhfE*hqN&JtppC5g+&V10DJuh1#$Zf$wLjW0~>(&+=q zEXq}VMU_X_?X<$>`x6~C`%Z^mjmVE?s6hALGm>`CBKPs?k|D+fVwg;{8hd|KoK3V> zshxpZTRi6Y>j2{wUC3b+)=nfqlA#H4^RBY?1+hYeo;>q49Ah&ABNIQ!>JfXHMx>nS zzKN@cW-ok%P5qKJ3iT|penum^X~QfCs?wVPN09;bse0>nPjjPsvm^ZO#JXcQd?5hB z$3k8eOO$C3i618TrQmw&pZPs@%r`P%V8U31Ac}%o-7K(NN3;+jxS;s#)Bq^>Kq=kt zv5}^$aV_nK7Rg(PPA5pVOqrU7D9l>H>Tu6GJdTbzlCiQAR>d^b0c@w0p?cC#wGEb$ zudLnYuyw?eP#_Xy1O4qd4aIV3?!s1jzvqvh(BT{vo*++t9NBgXi8$0+3bNdK%B*xH zfv77RsKw-8nf0!-Vz~OuI9{|vQbce>V?^+{o#+1B0QfYcTqoee+%z|RcS~v-5)J!2 zzGWp`l2g55y2AdhmgZ(V~S) zWSkoLLS!nbq6B78x(H09LM%h80~J2t>rU#!i7bHn%bgL`ub+{52}81}|O3H<*;T|h{Kly|ZuIB-jc06q!7b~cIy4YZ<0e>XEDlcDc=2>d>% ziO-pk)5`O{#|0Aon@e~WFIh!F$b`Nj&A>0($}+aN=Vdq@+@Vj^zoTR=LuNk31%K^Vb;jG z5h8Hch~u=lgCYkxmS=;4lMVTP&^L-u@M8%`(2ATt0*>RNTSDT_I8o&QT7GxJBotue<%5qq$21(F!ZY*|?+DzDcK6F`tN=9ebDUJp6w%%=FfjkJ zOs=)+HOsID))|np1pWp&aZZIo3Cct%{Tg^Nr5q%%nWy6&JB-H4N=>&#JlpwNMEUDS9v3Hsr=w`vjGT=(t8q5Md%J=aHg#^ofw|eSBEpxEX#)QNoGhd5 zk)c0&BZ3rU$IkNLlNAH_vDs1Pl%-?|Y_gatFNMB{$3D|mYZMbHp-zQq7M-L(9Wcdf znQ^w*+cQ?J;t6OEw4OU?)6wutuyRF}M$89~dfD`YgQG%MFNF73JF2xpdEtz$Ws~kM zK;F!&j)xk0`|fMd{X)ORTpPPN&XSLk9{g&XdCQuJyZ26Z91Y0{wz323a}>UO0%yWp z9oynGKMgKXwUPt0IF>oA%$@M~$Sw*nu$H0Iu4IiV*i7P@TDU;j--%PYkeOnS}YNa0=HtqTMs2p2@=^>ZA(Xvq(GO|vrty5 zt_YL9TBk@!d2#X=MG_mK9mRuIDs(rr^+Y_d1Xa-JI;gYGJhN2O(E?gtYf47m@-6r% zFTmK5bJCjCbQr%op&JG&DU9wKel4hisAEUqv=|g#1N1_uLz~=8$)SM%75xI9%YPw! zvE`%EnfZsNw`UO4wDwZz^NsP@rLO;LQ`T=anBg^JHsIU?;x|j)ULxXGNKoVqII*W2 zh~p6*zZjZt{XnD6K_v#aWns`K87gpwbPQ3bs)LOYyk_#av>v73`y1y**&`S5JH9WFZTU6~Bar(YT3PSHpCNm!;3hGk26|7h>Z zA&qzJvnA?@*2~#tZ_c0^nyEu(r0Rfh_Z9-ICs-ZZqKI8K#|9mTu3AnNhL)^Q*Bz*` zVXk5?t+49LToh7({pZ?a$Pi9!6 zqz$boC{|Au-f=Lz^z}0j%%N2Oxm1qIv4MR=APWnolYRJ-a@8hDw(vXf1BE!1BO2#RMHLPOScYfzrQGFCpkKRqB9 zG}AcMF<-Z`=po-~@I7C?j_r>$LzC+pHu|j-wLz@I%uJO8_n*D^X`J8&Zrk|nE)&*V$6w7E{miQpGVKScBeDONck0?*+*=N9srm`yHwGc@u zoZ2CI1;y#tf)mcG{thlIqxN!r>;Wiqj{{qT?Rl2Xmg0N)W&SDqCq8gxKA-OJSk}Ea zlLUJj_A|O$7ShFvt0|>nP&~b@_n~X^Jdv*^$tolk2OvzT)(uU^gd#j`b>}CHcU0_r z=)TK|uU9HwYWWW}S*MYK8n*f!n#6lTD)7uKqD@Gm#KdGc_I&B)>5E`Pg0}X9_ddH; z-Cs~L>|&@{mHx5xT>sE;KO7dcQL-VyJB;)%lfLdJN%~KRGY7Z+Zvx7JXQTfydj5B| z8CJIcRSviOyMsRbpK|z(H9iNP2AjQA(u#O>k9sSL(5C$ zP2S{dini-d7EO45tGuAKdd@@FG<+ki`o{p&vqh+~zg5@&kyHmG{mrJiZLcm`10|AK zwe0(R8za^Ief~X1J4rj!ZkGQE@h;oDZq>^=coCd-FPVZw^gJ))*G zek@fP^;JiQPidzx7-W8Ch3dMx=c{85Y{Hk0ec~Gpm=UMOlJ_+;i0lz~HfMX@g3SqN zA=AOHX~2bW09{A`l?~LMws3&p87#I*cdT!3%oi6-M6qNd7hLZ-p$!T%*9erRL*6hD z@{f+S^kkc0r=85DUfAN<(tQ`8rd5oRX1o3X(VlvydgOBkd^+Ej5!uJCq9lh%Z1W zA+5g8h<0Vg8Wt&#H1%kF`6>h0QD86ITr$ z_y9CK)djb-x1@$+9naHgD7(Zqeds3LfPf4B+JPZL$7b`G`z0wgtJ)-Qrzi-NGx32k z2h0?;*2u?xI9qe=2z0cho0cWFsxJ4>QzI8IRaIT_DurHWt z2^Gv!ga`IQObx6dmOV8-umk|8ytuh||GJ4Ek}_(w`5Zs}MVlwJD9#-&FNaj*g>%E8 zi|M886m>}+ZeS5bVi%qR9rbxtY$5^$U6G!J!XBw@&*ROk*w11uK}1nvp9RN=bt7m` zfmr}?Bpi9{_mU)w=NurEIjVVHTz~YZIfrI@(N|pn7274lwi0&1X;_!ABqO zgZ@w-F|b4KY8D~h=#Vt)QpmE*-`Rav!2%KqX2=o7ILsX@+kw43=-X3Ku$Gmni+wU= z`C_-gkEQep151tw2^7v?Dnf$)M_QnUjC5+Pgtx2!q^4hx`En3yr{59SL z%i~D}>WK5%?lUY(S;o_Q<(RLXKB?*c%&1a|@;6v$N`yaa#nPgvlx=Ho@)=QWa~7XQ z?I!R(`LAy?dXlq2{)ELK(&#5p3m5dQ zFoH3j0%%%HhEKOfjTQo-)ZXP~6?9mX!sGOprLC*fiB}ZDTkTG_4QmjvjY%lO*p~?l zFo7gbnteaQ1&qDHIhV@aPPqY=hPmd8rjX%ZC>9brtE16e3U?jjQrw}^bcLUV5eMUUz1_zLbm?PiBw?=kCSY@P zDKNtDc-g)T;lx``SZkxsSZmzd^%*y0DA(HM5u7Tt_QTnmApNHhdiiEv564F>R*v)k z*is`;TM9ba%qZ0SJcW+a5SzU$5@=pbCjAaLRg4S66zn}3-hoC`FYm0fft=uLLJ{kn zRDpHtH2GyYy{tQhEOme3rZuMf7Zs}cLA&I`m8QHC={X@~&v83tXN^I%-+c-3MJl!t zMuScDLsiHbp~H>5F(%5ir>Hz%TDPwh?n6uAB^3ALC&xe!6Bbb)Yt(17@*i6*`y$fG zYON(G_VbvNGqWYPTmK{$ynH{llGiFZ`tf_Spg9bvH+y94Pe?UHdpKyqL)0ES^W@6i z5DFtE?_jT?QgApYKH(q%}00r>Oi{XB2d8hYTztqC@2 z>#Cll1eWo*k-0w<--c8?Id9VV5m;iu;uR#X`-4M%+O?Op^(nxQ*BfwgUhhQ}ffWR* z=SY8$F|tUV>H$&=cgX^$Y0)9peL!zxX8<{pdY_jg49+~WwYG+j4q6VuOUR*-8B+}= z{|D=Dhrag@!f(XY>yFC*nD728kqIXo>;FCbZ&96c$^xKmztT2aIcP(H?5nHUmgZP; zK^NR`cpfN16L<+AD?dj-Hs@D&lMEi(xay9WboR_W+R2i+T z&euS~51}nY@RnzG-C%x{w*jb@Y3ocR3-hz5g!HEs1yAHdKz;^GA5H^V4o6+l3__!~ zTPpO>%2Jo;1W zUb|#l4=|HqWmOKQO8z$TCt@a>_-Pr{-lw^f*_*BG4Qc|N&eu553pnM`JngOaYS!vl ztEX_A6_X9}UQGsF!uR?TwHOB0cDDhcw^Ra-@msFuk4uWc&yn0xiO1adbmHo5sLO*y zwr6H0e`!pBA&y>Zdp8=Q|Cv5Fh5vVHEGt~g-tiD#Y zbDp4!D1QFEX3G`rCCXZlz=WIbCK^qg^32J=#+*@VIQFUQEnk#2&>A`SJRWCinO;d| z8^cTp6_&EDQL9CebCm}Z>~7B6>>6{GEpgCepl#_#%`mkAGpL#TTj#f^%PjA0v_J^L z1{Jn9);Jqw@u&J?Ok#t?;30t}rsJ8Y&*0Tlm=}blVjfJxy>=V`pyui|E$pN{tus% z3GiRR*O}S=H-u_NOU8an9HsZRE( z)w5~v7)GU7qoZ?6&-7RPbJ>)CH59p|G>m;#l{q29>?&6YYt=>#&)fcx!p)v-+oo#` zm)UyUv%_s|@8t>?b<>Pr*(O`Ux`o8o4Ig_FI-o6s8?os~wg82NXZ5wu{^?7@-FCTO zG0_zBxxH>Wbbkg{VA2M7gk}r{TKf7j%^k_YOZ_>{ z4~u^hlon}VxXz<&tjli3u~kk^irh%~O~Ua02AQ1@!7%EJ)O#L=%24|^cipC8^~Ud6 z`%eDbXElF1fb}!`F6%O&*leg!R9ISIMR7OC3ZiYi()IF>@9y);p4D;4P_W^?t9G2Ky_#Q^4wpnB9BmyW$Cc37iA{HvxckvfQ}y*{Xib>d%l^RR z?sxYIZ&jvObRtpUb8<7QL7?@pyiY;P(5NPh3o<%MC=6s}*OC?%2_2pHuDD3CxG@Mi ziAIw=d?^y~eqfdEa~1H{z?#U8E~0Lc#Mk*Vw|U9|CbV-H*_+9|u#*C0Q=!zG z)C76|-NndoX2s*dYygD-q{T`=l0Xa!{t9;9zK>KzfJ4bz+aGFGAE7ch7wKLK4Bs#f z1u0b$3`f`JTO^N*7Ys5wsh5=yLO!1d5XOU~WT+OhrC?#(yX2gdh)#=93_$5F3wM>T#G;)Uj|)T;4pi zESwhc>>#cLoy=>@%ZZv>rPM3qExnH}B$AQuJ7_?pxV+BBxE(QwP47A4M6Rpt(*0qe zK}vvBJ?#eKeYUd77I*2Wh7@0U_2K zivk^?IW_$^>ky%)Dbj#l3ltkocSCWLE;lgpViE%zvcfTz+&7B(>naeg_>W8h6WM-1 ziNV?LELGnXTAZ_e;>2UPSiG%+LS<;~X?lpYJV?h{JAV&0&V%UwJnAu;GsW2&FFg(Z zJ(@BP0!X;)~>Rh%Y zf`pFDhww*SD3xlwdKq!bLk+8&uKQy$oceW#w%*5_f%ga>>^J|Ul1x1`4yQj}3)gqcMmbEi7}>i~v2DlNG?=+1F4D?65bl*r#)gN$M<#?&8rn zRckDnks=iU3kkOt2^VR2mmm0m)j!gt|74~!PSFg-7|2i~_NUPRsSOVKd~MBH3e9K) zGm-8>NOIUn9E!Ocgq$)5jhAsj8C&@zfEgouY6-zWJF2fkX%u{CV(O;?n81CstJb#g zBGZJmsCD#RhR)$gEnh*UN6t&O016N|F~+(22?qJG4%S?`o;O;7Iw>H3tpg$co)=26 z-E4MQ>%U;u++2r5HCwo^#H=X=b?OqWwt6(2L>5g?SoQXM>syc&6I#8ZNKQEnR8Zm} zwy?9dmPm5e`%ee88jL;$`rxbTUcPl=c4pRmjXVHQCiF`rvpLVyAy_~O2RO(B`;|A7 z0sjI9?V~J5Untq9{%9Mo<-QySwJUG*R#{a_-aaZzWc3;iJNpHrCuop3l`>dfR%;w< zOsIeW7z~M-p3Ud0scn;F@*Ko3jRp!h?DWDKc1RKW-troV6hycRM_Skc41w+AShu}l zF$LUCGX$Q9v$6=!k}9iuYR&nmz3S5^C5xEh|6}YOn=}p9w#%|@+rG=TZQE5{?6Pg! zt}ffQZQHih)6Y8*Gw&0zKkVOdWn7uL@;KMA)lv;>@8cFE7L&Zw=sgQ>gHWHem{IzX zD&O(mZw$tyd;;lGYEz0tE&Nn&Crd~ID3cPt%5ZFp4k=&e#)NRVJF(dOaafLwAlvfP zG*$*)k_Fd1-_3O9fsz71=eiQ?ny0Yj_dl1Zd%Xn1^oN5R`N@aHqF7TUC2cLg?8rg7 zT2CjjN(T@t0NcGBqu_v7RR#*GHCJX;gh}e7Y$B2^fo$1i&;xHZJ=|#&VFfUu(tR49 zG;PC=)qJ`NN4#FI%)pG`=Tvp?1h9Dazp|%hT7>wlNKcb^0R1QlstNp3T;pcXu$Ae{ zOb^eAy`hMVw_;3(@itV&Ko4w7r}U_>p0lmA$J=E7y|R_m&;kR?D701c-Vpo z_R@yw>o$eIv1h%q+_CGl%Lbd37%Vg9d9V~CHS*4}zIty8q%36Q$p;zfV=kgTgGDxC z=eBz`|9p|rFwN+-7k^lzRl(II-@(TOkNl}i`A*ix%om@P!3biLs5IRqzO3Q3pZZ%V zpJ+v4qz=EB=>TTdWRxVQf3NH~7>0Rwk=^;auaDX zVF1_0BWx+g$4w$2l}o^$k08Zy^nE5wWq-7JGrTyeUbJl7 zf_IlB)!VQAV|Dij)*PWw^FJOT|2xGsGuQuWiyzjM`RBGk>Uq_;Q&p*sKw{)SQn{2e zUyz|h-8LqqLjIrN2%U0$vcWDma6AzFyW^R&4Wbap+IP=3B5Ys3iGL85uR}b_TTIY0 z!t%W1S`>CoGc~*JPmBJAKzS+NV68Ir1M?+0({w0LD*uwiqw;U*yV~ zoNdM*7_1Yj0_e3=CrjbaTI48`k)Q~Q=ABs>TzyV%%Ki5L6%qs%@C6qoDmN= zZ^KxIXgRY6;!4>k{BHdAtP&oHYdaU%4j1RFyI#r=qysIS?N4caERT0}@SJm{m1ywBQ zG)c`J=yS6ZV%1`iA*DC2rXXW%bXvTg8`#(X^ zrAfhweE6ftD+&J&w+UrBhxFw|@BCJ8dTfuwFbfAg3m>7HPLI{1UZFuirli~Auw7P* z7ji$GgFOmMMG*bh1u1HBz~&G+Grtt>u?hi|5N?C-|9n?`GHYhIGHp~!F?s>e*!P^X zr?izK7s4LcSa`>Gok>h?K~JcvrHsUTN#wD~gi72*zby=hjAh!5y8-9#?v-iOm)Kp6 zP@WdJnJh$2(03sLQBl&WUOgbXV8C$~HcSQi7>fU>TTi_hmaldFc0}fdfIG%6=~wAn zfHO;$B*HT5Gq&(KxL9O=!|_(y^sk&vCcy#)RS9&@w8E%UWenMc4VZiz*OpO65Q_i` zzE>&a??xa_8Xxn5>h;C6K()X*wH#C0^>Qi_cG|p}tys1vZ!oG1?oUi>rxjnXLX43= zM%t}WQkeGms-x|Rs+Xx1k)eVZR*s`t8m!gC7@#;5wvEbxWL>j@3?4gtVc3eaTN)o{ z-Lzd46NtQ4;sn!jcfnzWJ%(zrZAHj70Q3#gy3J37q{8_?6ldd+tdBQVGUedq`_yO5OFb$f^GAXhd=fy8@Mc(6 z$le-N+2|IaOz=DsCWmq)9i{89Fy@+(TJjEed7mhmrCgf8|mgs+BENmyGHrx z?w&|JS^uwEAl;(BX<%mq&&O$gzzO#j|EW6w!1UhOq36$3?&^Ie)c8gW1CYepO{>&AB~pc0!b;tO8+*aZLUF&0G_|Ssm0Bj z#qE&V6X;Na`ytQTc6{vooPM=m3#A}a_}$SiU}M=*kbOk5xpgZb%8S0K@anh4G!w3j z*E6!bdb`uRJ(B%cR`&X`k9hlIN9enY7bh1pOY)(zo^y49IL&UZ)r1?{vBQl1e6n=A zt4Nj#WJ`u0r)r##6b&PCskeA}vrOCS*KgerQBFerukGPGX=g;3e7>m0Md#*f(x}YM z2O4huc360c?4KoBz6}52S#>Fndq+)dHH509&!%DvQbEkZ%J~DkciC2{UpRAcpuWx+ zhuzT3z*p9?1Gl1Q34eVgBY8fn;rgS~mJSs;rJE0C$xNP`^?E*AzG#36Ws#NAYGyA0 zm8N{(u(q=YUyxshP&Ma|k`r?UgkAJj9fUV8dbiI8x;b?e0Ui0LGLGGTGM%;Wz~9Sm zzAKq^fs~u50V~lD93y68W?UEdrEitS6xNNfrctLvSsjU$NN#7kQZU}R8@kIH#tVFc zN|8|*c~yP_9+?ktF=5mKJdsj*8Gt*hd#mnQJ>)G~V$e2Cw}_0S5h9F32})wgy6ppq ziEdl9<&&uRU++L5Ca~BsLhhmR1!7?>@!xf?Tm|_CFhVG~o!w%U)tr{gOIppI1k;gz zjw8G1`DsYDnUVv+Uk2d zWv$zDEewaMjD1*b^*^%&>|r{^|Z4pHwekLnm-bc)2>c`)4Tcv@UP zDnk(!v!cKbJb&*Dh~~lf zJD8hdBlEg!-c}8PU_7z}$aUu<qFw(vk1VaYGvi^5AH3b>!9lFqt{`{8Z<#d(8$PQf^N?O7@fSDGpYk z0(REbb`)!K737or(?*|S9(;Vb^00?cZTkft8w+mEbZ4;pUPF!mL}=6WUSMVGU$qRJ zfb`b5$tQ%sunfm#EQE^6Jw7~Fpo+wW+(U#Gw2&12$>cCdY(!8h$tpZG(DpTVfgr75 zVU#((-p0M;142BlK8M2kbJgD^LUlKs4eT)1~jqT&!IDKzg zl&El{N)YI1oJi|i2N}Eo0``TM?u&-IomG2z!1>{H;g=OeI~Ow!^7cGxTlW+IKq8Rc zjJ8b>RZ0=~b;wUd{)MGsP1DHwC;Lwi6&gco98P2Whs&p>B2(EomLPN*x{%giK|S>4 zJ!1X#Sod0T08^^!()on|trh@Wl;_5Z;K!_Z{aI*KnGD$`kfoqZWe)*pw>-FS#@xvh zLQ7m1hDjg~3-0sl?3PiY@|lLpT6zs^Dj=KswnPYeq=qD8qFWFqQl?+$p}i^CJH(^z zsDh2TkgU6me}pri$+7b(-M)rv!K1Y!x)y!NuGA^Xk%$}N?Ls6liDv;HpV z#?{se=JXh2_9V3T+}HAw!BW{0t9UD(%rU+PKTsVAUItoL7I$(m8%G2Oq%r`d^jf3K zj33j-m$1qc1qMYYw+)AQP7gZc<7$OAwk&vFG6(*Y|a z5WGCGDC$kuX?JxzxEU6^9@rZC2!6SGD72H4+XNd-P|EX~&J$Lnl1pq?|rZ?9=$1 zm$X;N$LY!~S$D1DadGEt4v}9J(_)brP|pcsyi^`$k=7y^k@-e8gKP`~jo;Td@Z{P9 zz1-#m+JirX29AIw#%bRoq=o3ti?S8n1mK_iT`spDGw1@QUMlqB32`K#M-@EDb z36UCEKkS;Wj1)h-s$e>+=lG`G0DpqRv$?4-HwU`SV3VzI-k1~O$6 zvzw@h9i)ACrPe_+a<%<)oF*|&Ps_tF)Q|=BoqfK?DA!|~mR`Omu z+*AuZx}g`(D9oy zao>?~<}!h&*KlHNN?#p|-NJe7T(Lo>V9V|= zO3B@5@<5dFBWxfXsW$oE5nSd?WA^=D{dj#elQjtW$8h?(7hxj!%-bEphZeJi)-Lsa z_moK5tEZsQ2l`!}J`>^DNNetS=C=#N!c-2*=ciu0?cmNz zEf~U*ive}KF)uMbw>Z(~!CtK{iq=^xK38?&L&l3sam!IYpiK*Kw)dPn3MvuRx+fY= zix=VE9|9yDX{O5UMN9z7Z1u(2fMDL`Kdbn(v7iXH}a1|J( z5SqZWWT_YSB~UoN@AZJl#K!Wgn&c?3Cqw(Thc|~eTcdX*$Oi7>L=y-6@Tyb$&?o-o_sA2&4NYQ4Y_;4XepH+EvbF*ws1H^d z)gy;}nr|XIJb5(D9vvK$k)X{p*iN$?Hix}Cr-*WiXFg7H^r2B|c^oK;z1k*TJ>8jd z1k#a*01-%L40jxr@g4&SdkzCuo7FWyd=80e!v-sx6zu@Q=5M8qKV2{fVq_BO<5UG` zf6D7#YBD!{Yb()70fvZJj_#g^eIJ8{DQVqyjEo}vF^czxi=Ey2=!$((6ToG?r9gaM ztYVzxi2ZOGNl;GQHe$pkQkfu@K=^18L=W-PTEe_ZydfmYD#86g_jfK{y>9tw#4^!D z0qf&?s-aka^c@URwPp(j!cEsb3Lv-IticW5;0!W^W#fwm-(AEDtUX4$xIcwjFH723 zR_$mgI&@`wFKg^8*qu=jFeSo?{cFyH#*5*g0VVls+#Tnx+)#3%rWCU@JY!X0g^oII z9+y`quh$EvS)WV-j!272%)fl14Z=pB8g{mveo8Y4%=-b#P^h zN}Nax)8VUsuI`?cakq2o_mWQwfQkb1UHPV>on77g0xD^CHHitf7MsqrRchALUkANl z3FgF0)5K>WSll1DaJZk7LLvpXx$Bj&Z8_RHrIAD==)APhU>juNu96U{o=f)dd|HTrcdZ{e!W(ke{M0zT~6}D zI|+5*cqv&{0rA73xm?FPfMc|X%*ml<5Z^w)nQ`A%V23>mJXf8K`x7HXnJeBSvHYbw z04@Siqi#weBb$ENMW>esii5Y(;-a-eEBQ70!n{O|QUTV)3#e1SINN;9gR;D~H{SF@ z?c2>r=-Eo~Cw{D->&IYJ6d(Boc!r+U1mT$KLdsmNvq14Oz(0Kv!sNB_`Mm@|`L`!k zagde(F_G3Q>IS}w^`{PHpcx0!$wcBB`3tv|CEldWgo*k`Ew$8`_o#FEhCxTpiuR?Y zB8z1p-fSTz*V+86mMR) z4<)oKJ{cT`jqNU?5D5VHRbR)jDo72{^=Dsz~JuJI{Jeh+tUP-M~4 z)$AKN1A7CZ%Q`8dBUyZCFi4`W1C@pyPVBcY?vLwEKOmaB^8ZvR1_1nbnrT+%|J6Cs zt-Tw!$&TXN+dH5D*{)fCU|(V1e)&go9>Q&`g;9#2spV=}Efr5{#x>yU9zT&p?pk@{ znSu&MG*Jv8jAeJqTg2?yDntYOtN&k|!@gw$PyKI)zR%yxDu>Vqy3xwZZJ0{*5-JO8 zmu{atMdB60T0ebc>G)(c^GgGR|Iw`EC`%_5u5V=J?fjVA|7;T=*cRPtJ;*E*Ue^k= zTqc*9I&mjYXO5XNDfjxtJR4(IRj0{s(@;+)3`|u$*U$+Cn~qm@*!#U1Wm5{LG^$0C zqaE*!K!9J}cJ!@LY762q=!I z*?KdIM2s|)hL}OT`rAVpNCLAG>^BRp_>`sK$}u)-FZNsbuI*Q?lsdGczI;{KFS-7EU7ht2l=XPhbvQ5?VCvv_wXWnC`JylxL7hrvgL|?X<}I6UN+iNpTQlt>hIMB(nA( zBeyMmlpFOs%AGSKbrYEF#cc0^UsfngcKHu&@Ns^^S7qe)i4~ z3mcL!_6~*#G^`^Dxz{)UdRyV60$0i~mXg+?^1Lma~7#NdPF)95e&>p%kI1Io&`ryUROq{vdGTiel1Y{@<0IoUzi59;<^Q=}rp z(-}3JRJZ;GQMs=hgX5bqZbSz8HWpqvCQ_^ndBG0jB^xM9*hWGjS2#5YIvgyNu+#(T z8Oep_^Nv>lW42&>Br`9{fx8fIaVCl35nFmgVzheRtwA#THpO^=GtI(SF{xI|+vfSco9Z;K?l0gczFBDrXGSb4~&|jubGg zLj`~^N5OHa&P@!F{RYM*#gxjfW9FKiK%3)|FX@)v6mxQRg-Foaf6RO&8*^6Ca1gE6 zhQq0F&dpD%^GN3_WhO85v)4U@`>Li8^i~}mx4}11zCXs1hn243noWlNu{^6R*O)yI zt0AUw){}mT#kdIjgCVG6wgEiF0+uUcTP*aeI79;?J#Q6E`kwH^V7ftSCb3heEXZ7P zzh+R8AU4Ps$@iyVEtVT`{so>ES@p>Hkjo9b)+(832H!H0vmGgsKVg$dusAOMqAL!o zPO~IB)M&OL8l32R0JX1kvnB3?SvpYt8^~wO2H%2f0>HyVabbaVz|QB2^vIXIB)h)3 zg@m>3HsZuEO+0v53Ktn9xSn&|9|Lo_#+oI9|9E6l5Az5&uM0M}^pNFR_Yj5M9C4(e zs_alBh?ZzQSDXiHO-F1v1n}FyN(b9(0I$X>v>x~fv8nZRls7mV6T?L5dn zEW!BKM==z1&e&$hXq>L5NbjSzkR!3(i7M+w-&u1#=iZVavQBA}XdA;1mtL+E~VAH}a1hAe}f6Bsjs^h+Bp}yEam}4{?>BjfI+VIi9 zLoizn@*rO>1+wL~Qx8DNH%|xJGW?Y(0*EY3CUetc8$z^W#(Na!J%UagvUP=2+o@84 zpZS>sk_6p!;%jkN4ETN?Z1|>5?0FCv{K4wX_SmVPn88?q<%Yfdye@Bq#C0$Lfi%ht z(v-HO_{cS_z$h-wPD;B^tJExoGYxh>xGpCG6A0Nmj8iCrtG=(kT!L|q*pNzAK;1Ai zMLy8Z@Ww-~mJ%pp;$9)$xNA#JYj4BAW@XhC6I`Sy(Gr0BJKhzr{i|oE_T5j^NC>#b*~0b zUT@K$y>R`Lp4m%~1LLBi<~qv>cv0tO!q{OKCDQSxrutIdWUnSJceo^SP@jz$gn*4; z)DKe)t)pFOnuEt{h%2p^S#-?|T2`*tb~rjRh-Ih!31mBA;(KBq6{0US|KV35ypumGbOgdoT)gzH(-)gcC>0EQJ7jiO6VAzj&DaewnLLtq~6 z>;KDBNV*7v*(0_8v0bpT_`vb}dK`5i{>0;VyJwnjC-qB?6$Z8m zomwph_9^f8v1bBwhA-1(jb2yp7hqqMXq;@U#VK9&=6bSqC~|;k9cJc3344`_ax2E? z(b4KfPfKGM!Lj&VbyHZVEDgL6C_1TZDnyM<-HF;NvY*aFKkN&{D2$rP-xha4WRuiaVQX`|6%tF=9J6krV~vzx@#G`qZ}r}1Nx zQ{i#;(5^LEImMCM%39jKuD+%)$1)2?#endvM~LA7@07l(=?Tjb53bP@$!>r9}nD$e&hKn5|>aG%KO$JyC3rCOf+x*(;H(tJB z!xiNgd>l=TjZ=hmUx=nR#&Qi0sZmE80*x4r1H(n7%SWp|+~S>xZTM4dSIs|1_ZGQG zuA$xbmF_iJKd7d0}SzyYTJW>H0(@y??l zOH*S1b=uC5ph}OU(yVV{%Q=N2Vs@j?%o?0gg{@eqc{Zt8XwbGpq@7H&lWhe6R!HN^ zw4c;Fmtq?-gjJuTUad1w&rQ?RHqn@?9qY70oOTV%aTfBoyrFn&0hm4-K- zanSUrIMcz#d2E}O($LY;BsOZr>z44|(i?}ovf5SQyJ)z0^ca}ZNdQpXrqK{)r;R&d zbzL3jJf+Fu#4oR1DcL8*h~FDoUXSTjwMD)`x?sEVm6r!+N)Y_; zX53K^YB-HvQ^otxP=`+72jH3Qx59HClRJ~ujO`v+ zlPiA`rmGrF@QdpU%lmjd0I!_YXQ}42^HBEFPY$hwzkM#^^V^2>qxVFHvl4C+9Y9$- z?+IqoNOmSjNBo>u8pKoe+Nm(_Ac;!~E@`-MTFE3W=jPhFE4lfxID}9FfuCy?+ z#&-#6d6h8xGHqM-)1Qk^%bZQ3eF?SYXQpYg#5rr_@sqTAA**0!V32!h?F<7|hdcKQ zfLIgN;o3cpH!U;Cz{hTO`Aipey;Ak{eLbT3Qvnd9VlCKJ}i75-#IW+yxL* z)Z6*@8Wulyv**MGb_5i4C&lR6S-$Dcp)O9F(Slx28P4u3vQB3&v&Qy7EW3p~#s!JE zheZFph)5uhhxTT!YB*Gu9WVZM2ZTcuz0MT|iFdxAf51u8untx#2?q}hlvKF|I=DY_ zAKU4)xSjI{+pD`Y!)i~YdKz+s*DRFtcN_^{QhQ%{r5e{n4Rw%pJ`!`J>MupD{x@Tt zA6utktuxxFYiZra{h*j=Za=XBloqMVm1kW1%#Ud!6^vCKlh!b<8=jQ; zD&NtAQunRcVF`yuN_Jg-=R9vPj)+DEWGLaYp=_rBIOhFST z)+(H5xz3Zt$g?E+SqU^4#8T=d0;35F#WEZm)=}g9(%<@Hw()J%bm=!MskFW9Z^P2l zi-t#n?KhAP1383U_7_K?_ z9e_$pw@^x-^+o~myT8+=!7M?+OfD-N;I0>0fxNF-AOb}-yq2)?env=jLbyFlce7t1 z`%XDo{JeYH=ze%XdvTucS4xZp4z)dJ3GYu;uhV7^n;L(CE;&B_lW_n5_^))d0Cp~> z|9gjR*3?nh5=ZmBt*u*v>{8~t-?CLzD+Jz9r7kmDnY76y1Zp+%G+D4{Y>;4tug zDi1f$JL&ZZMj;~)sa?JpA71X%5~O}kGPWY{ZGST)*h$Tj(<-w#>7A|QY4p^d0YP~` zw@X52A^Fyp@o|bxX+UzOT^1@LHv~j7Ep{+Wa9760UH=4>7hoDjfc+Vv`ol``BTuX8 z&wrlAQ#b29{%HUc3WmIrWv#cua1TaGohg?kD)n8VYPidtbklN?^YK1W#vn}__Hryr zoaktJjCU%gUpsOA&z$CjmSA4GQ#{O1wJc?(uPQ3!k$SR9Y`(rwHDGQc?UU7xH$o;Z z`;g{tqYT?XDasrzDf=o3hjkL}1d>q*F)vRn`>DOakW;+JhN&wgZ{N-pmYF! zwxG`|FbLe3t|cqJk(A0=IJ|%bD>8Tqmpl=wQL7Iez`rxQHy*0O{P*x()=fzJ)a-s- zEnaT7jzRwQ!%L&|OyZYG`x|AJ<5ek*f^Mcll)%Wv0V*qe@4IuRCvPVg@nB(UTdW^B zm^5AzPp(~3`NH@Fr4z^j5MXkt5OzRxOk=lXQi3r>;R@WQZ!gA>bRz1K~c`G zH(lz`rv#<_`@C~7CrSY)mGE>8p{^JOFz%V*%&}SuCI^F*|DF+U--rs!B$2poD7QEa z6D0}}slVj|%3oZ1>n9jK@eqP;d4oQF3P`{?MN4}28c-bX&C>Z0^O+~G-tH+*Op!I{ zRAzcTuyeWHDyUCV@#caV0V`gt_HCml+dN?)D^V)Nu)jchn%=TQSXft&i&f-W8|RCV z#8g(-%AaE@n%}KbjwbDDwqGV9Gh%F1mOnSw)N z#MxuOL${aU>R`wDxRJ1*J9R_bbzTooE`+?GFu zW$q2#RxjB1_(H3bYZrTxiAH96m0$9fnw)HORaO7ETTXJ)%aJqt{AI?6V?vET5~?Gd z2~=G8D$&C9NUFQf-^1mvql2fT*~Pu<&!kG)qRX#`1zw~PVHD*EKjvu&>;Yr~50LNs zKhr373t(itun&b5NhH%#2TEDPCRs5>4P%*{>nR@v*-xk=`GtWSa`(&}I%#G3V4AE> z9!s1{35N+f5)qrsRp#XRa8#yY>t-!_`q^46SZ8q~0XZ!u^{cU%Dg9r!ldJ0qzB)W* zgON28>f+yPMEvsc9vkS#!H$C9;X{n_D`Bv>WFTv(VGnmy4eX}pG_`IK+MH)CGEVGpq}_GB zm)x6M`b6k6uyVvnGj>*nJNRc(|4kd=Sd{BXjdadlAxEIB+NMsQmt`hvhx zS6D>!lJ{as5aWaaiJaWQvX4j!FVPu%Cu+8!$(T6|tH+Sy#D2r;OXE(`O$DuEPgU&v>%729SH&YB0_shQKkt8@xo(v5-U-x33nWNj@!fDn+K87 zEU^KssO4jl{p?ZuTa1YK`&!TK<|xF;Ua@Q_vJ9~G6AoE(SN44@(hMc{aYgC2?}ud! zQ!}y|+P_!a-2%?$f`^4JNuStcQk z8#6`fssxRC4tc@Uk!Yk!Ag40HDi1dr-AH8mVYbRpP8SN#1GRfB+X=}NjCG#3Q7!Zp zpZOQqDA@N=*HS?;)sGEJxUadN?Y4TU&w&$f1>H}9Yg0%GB!95hh>=WY6f_>MQH8js zswcZ_Q8}S0#in^7VT~fFi<}aJ5teq5sKJj35-(tKG*fr9I66Vku|Ut2}6*X>Y3$y?hnJ+ewI6q zTkoLd?cAQn*7h;dZ!dtXIAH8oq@+Gb_DWc}U~ghE34iG4dKCZEyRGb)$31eCq)G_~ z<&c9n*oX&5v_^~qTbjEx4uLkvl0x2XZ`ZTaeNs`v{asAAW7)_Vf_kU zVziJ!9CbMoG}+&Ny4I00QDw>+WIWi#WU~%-=NJ^h(?5nxMgYCwz5DE;v6K>HfYDpd z!>1>6AhP2;+`;&0{${%aZ|~Vsw9m-)paG%90fixhjYDl|i%?v{9x_iHu6eMkFtCB9 z3EaP@k~{~{%<_eA?;k^KY^U}f0VPBUl}H#awF~WnGPc%&W3IAO{L569<^Q;UUiPDo ztBMv^JJHgEHv#XFX(fkzcCo5Ar$Dp_SMszhj!RC{4J`$lHt@SDPK)H4k7Un!rw zfWpg6qDzZLD3}9o`ffkOQrTswE0OtYlpwp${ej_KE>@M;bkn~gtP0fr!Z|gv>wtZr z!NO~-Pgb~NJntP_2gwi2hjBY8QRrC z3eu^zG|^Htf_&R`<@3;#7WqKNbu1wxf2q{7i7j(Inf&^^=Bhk*hzCro1F}*YbC%?_ib#6 zDya-#+jtLU9hu~%)xgyO3PittR$f8u-jp>us8{S98vQ$_JEy`5)JpNBu8es}QOP^h0co(4bmu?sCmWL7Xk(ILAETJoWnU7BbUYZz*%quJ4i@*WrSY z@)^R&^MlM~x%>^;!0(`0h$;vir!uh~zzOo0}zxI$R1 z;E7wLFE9neT`)}1g6OHs!pqtAacqk~!Y@@tw#qp5c-+=lh%I;O8b%UPHj zxB6tYwP^yqKKn22KA#`l9v&=I&hLxQ)0=LqK^T>9%UQ?Ilb3FTV5N~#{r3jmu_0GU ziCQBD;GA;@ccpb=BSqyTz^;Ec2-xZ^Dt<93E32SPonQWKn9q4a3#y{_qEw__`)4t< z>3`5{6*^Kq^6OsDp7^~z^342C%;F0Q!Mv3D9}fxtm3R-p#{9po!PEbLL~p5p`(IlW zSbWyzP=@P8LE14BLqtgjh2&Hh#&3p3aNDyu$l9`-uu0b*EPc zu0^_S^+!834Zgt1I9P8vvWW~QnuD={Ta+S0l#p-| zew)^r0-N*iJ09_UjXKo@`?n72O$JwnK`7Y$UYJocF&0#^ZZ^P;b}v1l-9Hc8d%BGO}@co^<5C@ssBGUS-*p*`BsF6zo zrxr69bio&c1RtGGTTrzitJ}#ulf;xd0*};K`Aq4 zu1W|zkByY&fkIG(~DTpsGw8>2AYN6@v8qnUR5i_MZXn~9QV%#vgx@pmX0f!m(n z$Qx)sa3Twc(-pLbD!9er1cmey`FP?hJ&lZ)BiPz5j?Bb!ztPfi<+je=KMuQ^bd{_0 zKzp=ZHV3*a6&fdrDo4!wlx=nv#;PdN;&@^IeY!LWq}*4$C7+JgV1gh_v+$%j;;ni> ztn1-9b!=!qdLn-=M(xBx$fNQ03V*!O$tsT(v6q!n3Sp<8jOtlwL}U)E5?2A%7>P?2 zxWXP1%f`vKCBK~h8#W0I6;S|}nxjyH0y5fHFDe?Af6RExKhmrxQeb{M%9D#Xk;no%495OY>T4<0td3Tc_|N#sfw;FLa0 z=DbWCAOKzP>CtNN*0P>e~i3-S9xUpR8?4tKHo z(eM$$D{5GDKwh(b?Tk5*z&Dj@N3H8VIkjtjw(}axQ-vR?Tu8oxjE}3CP^co%1z|c? zTb7XFSG|a(I9ghhoz7MkI+E<%F{RlSpl6$N9rK_Q z1gE}_v%)^gFg8tzNS1x}N02=_idqKL9cKF&312?DJWT$>r=AZoyZ>?D_^*Us0G9ua zPpALk)5HIRPw!A0{ybl8F?Ln8(5qTEcZZiT_612%^pn?@U)L31#NA@=qEH?ptyOCW z1e=)maGiReKF9?MfT9?_5eF3BMFpMzoA5&E>MaKDA2SpQ9OotCCW6DR2^zoR{<`7! zsIoyGj;>eCkpP_XejPJJhQR%;Tdat-qZEMnKetMo)-Y=2ULQXxJTwSXNIbVnW4m~Y zE`6_i-sU*9Op9@p8AaYM=}MOa{p8bA`iVYXydhCwxXMous3YrHq-K@v`!D>c1e?uDLzm`5TDa~^F-nywCdB_WC$a2ElpIt}c4-8kAHsG2F*;d z+L&C}wvleIFv1T*>ni0ifR$5tU!NKrJ#)wvs=;??G;p@8bM#nUhaO+tnIy|<9vnIU zAI8q1OSB*X(q-Fr)hpY!ZQHhO+qP}nwr$&b^JZ4l=k%f%_b=RxjEwl=$;k*|jhjC? z0_&LUkri2u4WZt5V?bk<9XS#LH~8O)NL{C`RlXWRvxf!Gi58bNe>Q3B8STzsPMt|0 z(>1ErIy^?q6;>1?2yR;0G>WYrBfb|0=lQJ53@a9zA;8Xu7WFd8imAey0}NwL^wl*r zY}~OMQH>FIO#vrh#N2F!=J$tJJ~FJp#_=9hzPgQOBM1{YqTrM;fj}dIs0@ZVwwZfo z9^D^9@n>B~R~N#RzQ}n>%4p}UH5<)>=OS*-Wp~acF9yV+isDI03=pS{m-_8r1E{m5XFolBAs> z6H;M)?Zk37UJu?Q`YTf(_xl&Qo+*$rZBVUa_yVz=V0dz1nf8Z&!(JXt=V>=?K>xbQ zs1eWT5}!}s0{-o7>Cz_-gkuZwBsiBQK3AOxT5@8QWnvpBqan0gayW$Lgo9b<_y)yg z(;+Kin;78QwAy2emrj9?9H`$$(@RyAIJh)D2r(x3>%LY$i>G~5f9neTw!<|4IUivB z&M{k%82MgsE1b1hN1W4iOoB_{>THaiv}3gsuNexuEi;l|*efsmIsOiW*deucF9`)1 zKGExlW1>cxZ%Bn^b-*m!DC(Sj81N*Ii-E|hEcaIeg7rnevnorv7bih$vAhmBm?s5H zChFDWxn^-A! z2dN5X^#u3MayQj>B$XvqbX=GQB+^2$M$li+7n3|WczTocx3ni2OVwslv1Il9cssco z=|gu{=;!N>2l+*hT5)|iyBcA`p8!HHr=;v|@73CO44|k~?`YTEGgeMKIlIC~`+x6V zJEpHYacXH(*@~GfJDae*e;@K}?{)fiUUM*;uIXZSJ2u{a82^~Ga$2jjkuYLkSL}HY zpEd&BvZ|dOq-Lv>4^QvD=w7V!Zotay`Fz#vu@JVaAFC4yROtBn)O{22>Iy>`275fR zRVsa%f+jm;?BI5$aBSZh9_f&ZW~ceCwf=6%*FKgm3GLJC4A`w&(1 zV8MOSPIC&lTuMb+N`p|EoWwo7(Q?ctx-mtHBi`QLZG!@j55cj{(4~IUx**oYmlJK+ z)VN#%ArR37!V+{5nWYl|#j+nM zIgyCcR%fOkxx`0t)K_es^0m0U2UmY5>-8}wLXjr&D4A|s=Nx1CT2Z+#UT1r32du{&G6RPQMlSFuu zeE+eLDx@6E&1&gv+8E#jIBJ3;z(itron92z<3C!P=F2{T>=N%J9nO{fPF3d7b5ynN zaDb;^`oqgW#|s5DYKO$zOUd_v^l{RgNYOr%ek6GcGcrne{!uP#DF3hU`i#q{C4h^! zl$By1aYoD>%H;lGN<kIW+6iaX+w2S7hWT5!B8noNV$92 zs}dyV!=^^xQ~M^0muR*(CW`0lt*y%Z#Byim)iaR?qk@oX{p)?5Dh~$pA|##b%<=i@VZ4FhXEv%ruj59qeb3s zZqrx|g{7Sh@8y=Ukdzp?^zluzI{0CFHu+CZT}F(H)fqXhvH$O1lkP%Wc;cTYkDoaq zK7{D1c%;8tf4CM5iQu7Y1)j`q=yWioV(ClFypWTk3f%MRzpRDhb8NC1kQ!jQ)~J{a zW6Vp{ej_OWaYLd_5-eoG?{N_jnVA67Hp}fwWkAhMb@Z5-cTSBzZ0`(|OJ1C(49xhd zu+&*;r<_d6OHm1?hij&dCv0MzEs_zlCze_B%(kzIV59W&@ z_s!-B;rH}|W_UvKF_d4#fe+Pl`?cD^Y8vA~rJHx}E?FTl=;H;Ny?0*m zTxKvw5n9HD#alq{aU<(ooVH3EyvOwsZLMJVs-3+D_QID2>Lvvs>96J|JGayy`h!I{ z_UnwGRbRha9-SaDU=n4067e$nR%&AN!IBQUErxZZ-Hstm6$fRAyMd}?~@d* zkFtD;jZ6AgSJU96eYo{& zff=T@J0$gy+%j&9qKy;*6NzGmkDS4*vYJwokYybCedh@)Hnt4K@(KijK;AFBDX{dm39gPxEq3=V90z%2;r`{*>|R&~GQ$rp* z(^&^Uqt!>HQ|&H60(;fhYn2*^>htpO@kE|1E(hI|0ah_+9Z#^sGflVjA?kllhWC7b z3*Sbq(QtdT96s8I^`Kbg+j)2EbM3kaY8itMApWtu2Ro_fT>=%EV8rgqjPiFho`p{ zI5O~hu+qllI~c)$bxj^&DDdjnxH3+PH_Gj9nW6cMjriKi)DoB{wig zi=8j$5dcIAqfug=;QdSLl`iD(s^h5CYP(qU4dXn zV!?l3)T+RwMJGKwGp%m3fo9)v<$L{cDf=-8>U%>&MCDU|@xEgAJEE9;`hof8xWX=U zjtglrm`~s#r~&B{-Pe;uNtE}u!0DN*cwyRSHc^SBtb!syx6MkJkG4|JR!8pZY`0R*PwtSj?e0X z1R(5(4to`#WG&pAld~Rf_$q+W5=@!Uh|y#wPC!K2?0vvaNzGgVHRzCxQ{pf40F}MK zH6U_eL3CY2iWa60s z{P0OpQ@M=b`T@gsbuXW5yDMDf^^fA=vEq(e*DhLgTMUWU2ztm{a(5)3!O97Wp_~@0 zugY05!sPpIX~@i}D)c}j;lUx7RoMzpR~A=nus(x|BUdI$L*k2X*N6mF=h>4=Q}tLR zhKFpMRDECxTxTb1Rydl~b{SiVjK)mPDhoqV5YHz=WOEj1{9z9 zFc8juSnbEcNimwDNC=)!?#nwkK&cP<36ThpPo`H~S~6tI=tP;Fz*RRlDFVp!g_s9G z;HvIA9?{dFU@8xdN+9(jZa}Zv7Z?-zVTdHf3Iy60J>L%*;XlW+lBE=7w)LnDa5%(f z0s`zSZ$d7G!eEj(MZZZ{*mI4+gabc+SU}A;g96prn>GB4jko_kE^-cXV<5OUdHO$5 z5nAY{x5TMqjKr206KW0RbORoA7N2l*)*>m3t%ist<2)8bZFP*B#_~I|IrLf6zye4} zTFoIc0>Uxbs^95s*Kgs)cD4KN&pOnR`LT-%SI|Cs?1L6uW|BFPqyy=1Qz0hV6WB76 z+6K-cvRO$`@I|!OUoyn1~z z`XlpNA4L;JIUo4;DvLlY37y~in7IkpezluNG#{c+Y5WDt_N4?21WGGy7Fgog1PCY} zTj}%018ot2<-#IE2+NB{g{?j~L#A~NpmeXj{s=xx%%b-MO-mph*GTQJeyI6Ioo{Z+ zHqUn2ppdg#MX%=AuYu5b1KgFgPp~+^x&>W+k?Xq864NmV#~3n0bAdhPXBE-0Fc;R* z-WDN`ET@{%SU%x*8wNGGUq6h>kNSemkKz*Lwh+reR0(JCMCw`_Ln}n)TV{CTmkZng z(6&YkP5-O?646g#4I-=VH!evVj-(j+CgJ{0%gExr2yb^>9Mgf4=lUScHdBCGMW<>h zFTkNN5a%%~7@_)Dae|18ooUo3ZcnZ2<~Ec9jeg|8u*e=a76=aiFRL8sFZa}fqiNvW zU%G2DK^KO^Zo-@W$D~nhv-J_EsgNW1hF%+#U{t;v%6fdF`|~#C1(Jhn%HRazYQ^T9 zpuO@1EVv%WSLkSt&8w2Zg%L|Xx?zApeUw44{U{?NGlFZnO!@N3`V3?f!`)$w_j^I<;Yv_XWU6(!6v(1QnD<&fGq_iNCC<9Y)l@}Af>R{4c3jta2E#b&d<_mGV zB*0KmZQRVd@(BXPQYj^#LPnC>!8}-*qR?$9wwZ7cH>iat!cE)tnowbfL?Y%Zk2gul z7D=ZfF^4~-fZ8M+lMI6R47BlNaqTZn9Tkm?tlIkq>G_E1Gg3wdLE|y}=29<}y{Hy1tO{p=j{P?NU77fVVcnLVDsOFmEo=gaTc=SWf#28`${8zgxA?Skyz=FX#lobK zhc~H%w>lR)uP)Od5BHgJ4LKQNOv;%gQ~vam2@Hs509JV?DGv+WyhW$|0ZM7oT|0C)R(}s{a!q zk%^i4KRm4xO`Eu)e=)aQJp&5GL2_uZKA~7igdd{#@$wV~kXMTK# z9$}Fs2%lztZu1hxk9YcR{nqUVlBkjISz~*DE{5LR8W4ymvv763Kg#^(N7`;KmRa5Z z#pJGjGerBW?hJFqww@|1Z{5*gLoKH@QjfdWha1Hm$zUJ8gg~8`(zjJkbNLL`=|dWMB7a@D$W0}W&9yHf z{q?#?Q%z)C=)gg*t(PHC;8fjk7K!ICUEQUa@tdR9LU;~6>LqrW(0>cvwef7NE)-WIMVMew9hq# zEw;@~6@LUO<&4xq5%uz{jZ=f6muXyH@O5(O(k4|zOKa{D>7jm(so!s4KCirV6=C<72}zR$aN-SdONN7MtxHs8Ef4h zvC;%yxl{(XO(*1Yu@h2;nj9>~a2MTiU$Tia9+;wl)Fw`9!y;AUWR}!5HjobE!Y+np zUOm`mImdR*ro9A=fg?HvKDJ5XaG3w~EaY#37oW`yY=(a^vQcFLA_uSvhx|HG(qQX> zCE4oS%8fH&gPvgBPxj}{h478;-UmJ|@oSfw#*zjaPN)x+RF-W&(z%$HvUEsjEKXI$ za#x{)$_p?6F3gbpD@h+}eHz_$ZLyJSpQx1(YVs^yVcqupmR4_P^_`9Upew8F9y|k z;ms>kkO9tgdL$fPBKm!K9SDwwm?Ir%cG@mVkUAkG=`?n`t#MkO)hwVU8Zx|!o;)?? z2zlBJHO&7oU6t(=Kc|?tR$aZolwB}{T~G_BK-B>x{+M?|cLZ?}yJ+NMGPE^YFbnr- zvZv7;YJ)s)OvOb=`y}2^r&=$jfb8_Z#XR+|5w%GLOP{h{re0m`&&FsQshrf4@Pw93CMhLI0{0r+IK*YP0bKH<%> z&SH0z4UIT$j`?$3((+9WPUe`cjVw0 z!8FkwG8Qm_ReR`1{X%cy!mYRP(x}1^ISgWvy@Ty#oY_&+X@ivEbG@~B`;DupDZQ~& z0>@W}zww|Md8JM2dfd)&e{IbySQ2JTWV!Eg0(PK`I|!Shg*U6i3&E3n!I=FEDb;2V(9w_+CS$?#MjAo76X0ip3=thoP0-(!x+l) z7qm_o%NghmNdIQ*TR+WlvpbG;b&jzBG9NmRl$HLxO(9?F)Ku0h2J}``=y7)n`KapQ z6z)fk1V~bEAKdCDO&m%ub(`{%QFwX6zLx;QrR*}9R1D}A#% zl|8wI;w=}A3V<6KSkQq=mxuWuDjV!uqkFXME&Ee)Q`$u$C`lh=s=;A2&X5@;%sxh$>sBG$$!?cS`n~0l-TZdk8M{gd^zVG zV5*O579ZzRWc-=|xYAldL1>1Ek6F&D5~LINf@Yoyy_x=g1hD##*4-b-6nMiD`A! z^fJxwy#5)R!t?7Rf*3!cl!$_3@67uf)(a2ObFIn~nvto^T;u);wU={Z_`QZ?0X_^Y zVLu%kg@pQKiWv-kLUKA&OrZA3m1^6Os1mnak9L7YXiAkBugbh8a^Tk$+ZFYfxm}Tt z%^3pY*b~XmOhEmQ7<_qL;1QIb*XqSx@(-K1*9_}z*#)IOYq@B^0Z^UYYe0bd@F^Gd z8#G02x5@(}`WFG#VWMjtMOauV0@bbYp3Xd(`VTNW)ax`oR!)-omLO_t@X8>@)TA#~ zqceaQpyvaI^5Z9+>Bd1{DdhcQzi$u-^~mK4HIy;r6^gAIH!_2PiA@Zrvy9Tpw5G4Au z6YG`M%*8hFahE5^?)9qpBUPtLGRIjG~Cs3?Lj$jOq$G7>FZzp6TBiG|u# zI~tj!jyLuav+|LT>Y3-X5h(k$Vhb<1B$ksz>w*xN#ten>2_>fl`@_E7bMoxJroi=jGk^iGyu6XP4nL(2ZbgMD@IKGzPutep4GX{!590b>MrX1 zexG1rCb=AuGa(jA$jf@9wf*TnCf&EHob_jOFZT8=qLxT%0D-H#WBcnQUNMl-V0bB+ zy_N>EM$=~mUY|Mq;T_pfwL?#y;)M*uUq_O2xYROMxXsU5I^C2&6oIr|6&5WV*9`cR z)NTa?T;?j?h zs?$+Gl>Qb09x*)G|2o&;&CcPROoBOPgGL%yE3d#AEp=J*BdS;2hNdhvO#C;CUwF$$ zGAkQ)KH^!{88)!8={xz;30pMtWC>+TrauCWbmfbNuEL9R_m~B?Tff@TpSz2?Jddi9 z(!E0nYlPuo`n1n}Pl%)IbvE079MLE@ms=)?HEy6O7(WSQw3vzOLL04g`g9ePRIhTk!7iaYyye zH`g_AsJP0#&c*~Tr3XQD113J8OTiqE{o!~R5XVK!MfB7ld^UtEX@b46yk^1@JVE2? zu(?O#^==>HqeA70+3dKu7=eisWk&4QO2iMx{NV|07Vi3cgU`3!_jA$J=J%KO_jRld zpLagd@8cA_bDvViBQx?@uJsmHgd=iK*^q0~$B(>#JZ3C4FC~b_pfxk%^RoTzd%$#t zw3XOM+M8$RFPz{Je_Ed^UC+{=uJRrSbbVl*6EuJJ`OYp56{42HP$%HgH7>@}m9f|D z>s%U|zMH)y*-_kz3iVIR^(0}uZYVLVR}tW_5o_q5F=W?f-gv`=1b@jLh`^i3t5yQrd3+za=HYX8s~jqFiwW zJ6VT*UBfqTm&4p9n%hkp`$yWfRS_zV#MRipK4$DiDa{L_a{ffu->`d8dX69!_ z#JKps5`R?h_uN#q&bmULW-=U$=@j`=W(|+VhZ6$CT@I;N|GMh!nYz_fnCT*b*m^TQ zHLu>Dyi7wAzo|7@W^MSP@v&=$5Rn2Rm3=q%o1f zh89a|xaP_Wm{0sZr@cjebg?~EvF&axjl8AV@dKcC-u30_<@7$x?&Z+Uo}r)pUPFfvOcfs{B1G%dv;knQ^iPizLfmtp_8Je)LPw;EEtvvpZtZaCZd`Z z>*lMZy0aDz{B$q2rPo6=>83K}wYl|gC)z_u(_hgeqsW@tNrQXwyr7bgnYo*_%6g4H zE${pf)f)4AhVLrsPpS$Rk}1hlCFK_NSq>;( zD;ijtkt>a+F1JBMQ>E#~h1t~V@@))-%#Mz%5^9%j`R{c0Nk>)H)u6Q=V~c@?rBfbT zXpAAR$yV2(^C?v&IMTKAfwyzBI5H+Xe5|Zb0g}D-h1J1T|Hi8lg?z{)MfTfl97<|Y zd^nIX5LXGBgZ0X{i3D#(noL#-74P@RR0*{1GP7>W1qm(dHA6*l|E1mKF|r0oTYyWC zToI3}_v5;gXyO>*#4aX$ktM3@&f~H9)2#^ z%^T?i@3OJSkLM2EbVrUe2 zj=PZ|xfLnFD=cKsp4@I^4sQ2HZHi(n41|wb8Q3>i&BBlSeiaK z)B=>@c#6-!_RGh(;NiK*D zNUPxp2<1f^f$yN(j$B4508HKspAKYD0r1#Y7DT@44f~7`F?R+EhIVfZX-VlpCl<2}0ta1Dj@OAH{NIWw8&Okn-&R@IQI z(%L1R>7Ne?cI7kgg|}=~8Kj zGRJ~!1JA(~aqakdhrA_-3}5_4yfsG*FhUL-rq^~p3Vpd}o%Y~hv7%LM8egYs?_J2p zp#jl<$)IU=K1N1Pu09N-L-r}bTfKZ3{Ql;adJ$lL_CEgf|8?c?;#i=i+3C~M`F+vZ zOAR#w-OHn$6{o?_)28kAo2C0*$m0Q2x40;~jYY_mX|3+dd7Jav{UpEp)!0YimSwtH4=1_{j_xa5kKdd}6%`quQ=gr^8p|sG6S-+*$A(S0OWp_F`?>W#lfW z%2KTwa&ga;=b5m5ZhT}D9wPG_jFR&O2!(suTb&-}%AM^nid^LFez5m|zH{IIR(}MU z++af1`b*#YeCiVW7mK^RrGX7 zj9T^MzC}r?PtBueGvFnihsV?zzH5BeI2q)9ktl$_B7nTg{TouZSAiKU|nNgUUCldx_6bEu<=fkuzXVI5{xqmr`Ea`fl1`gI?-7uy~iSnBqlecad zGT6%?2{0B>tCBrLk7=XO0>E=lwn#BFC=`2xt!p;-J>|jpjDv20O;MDRAo%6D`>+S4 z>&s(k(X9J>I+Iq21_@Jct%=x^6){~Uz2Jm+B4)K3Wvq_)JkW6EQ!>%Q&f!A>T@RvBqGP4jElR&3*ae`9i;(B zY@6O%p5>%VzIW8FPU?Nzq(@u*~z`xtr1??NmvD4o7d&mz^@&+aoXS{UQD(`5IMK`jKdh9n^SQKzDL3juiixFc(X=+i z8KOxE+Q#$7&d3hcF8DORC=4@UD>%KQrL{Xc-`#&~_x5v2uZOj_zs=}&pF;(A_nO0g zcB5Wj&vZYu1{&IU@GfmeoVnB05qYeL924dANo+byEFxRqUFld%36n=#zU=)evPW0R zk*&BlGD{nK7J6GzUxwOywu*b4h*( zO2&_6s?5W<(o5%N%VMOV6r zxJJlx_ii6qk1hDxt_29#CYah^$qL=nW-i2HSh6K(4PKF}a#G4DmgelW_$Y)>53naF zwhJgZmFHO3q1TQ+C67mQ7O4lN{2cUJM8(5U5?9<4;Y9A)FLDZKARVOv1~`kd zzvQ`xOcmPnwEC!Znm8;~k3gMi5zdJl2p$aGQP~Pa%rf@5o+Uqh1%ByQ6CbVFTm^UV zU^8@ zBvtl`om|!iiVd6_b1Zn=#xN+q?5j4JCu7QR{>f2bbdogHorumoidIp92oj1Kf5;?S z*DyO3RccsHW@^Xw`f?RAqYXFRxSP+I>9TYtv&GSimBN5Q!PG}zAvxQI>5HxUY_*O; ze2$mKz!%5Mw8+C?PQR}RR#@x$pw#X4P)YW8BIcyr&78aOdIt*O*H78cm4fexo$^^y z4QF*lYIbAT?%?|S=o#j>`gvs`TZn&Yv8Sf$8s2AeJ@e?RJKickQ}rz57Z*ya>80hC zmsxNJ2aQUOsF-abzoO5w?c62lwD$6A%Mz4D%=7h)><)1p=Hc0~d|j4TEm$@jur%x6 zn0uwSrutBdT{g%M?)!NJP0wg+6*wD{=lA;AtBH*-X4ohdEpA)w)v^uQ^t?57ZbTxU zE8yr64njb`h8Ye_AK!3Z?+)};qJh`4Ao3hlf<$GuoCr~?ubmt4YWXkIkP1(E=YoHA zvFhvE^UPbfRsEu5>FKA=zOC_Z*aC32LFN2=o6v3njphEZ)ou&V;j`f4_C6ubL?X|ZN{xv<=!F{bu;}$lgatf>m zBX1kN$BR{3<|dRFY|}iD2E{6l)fwbrY7wy`pZN4cP`;by=N-E%lGG)>?Q1r+8utSm zaTf1KU4Br9E)>h^fT>vy0Iwrh7=BdF%#am~iHB6ck2DNnRyD?~l!rG??!_e&M?GDRbck(;x$10A#I z2exjMx#U^ZqbIMq^0U_rXZG%dP-LA5cm#e5YDh zibQ6;yu7hWF(>WIslLIh^3mg%Gco9%NHW5P>!SqcRVnfY2EZH)ct!_`Cm-;6*l`@;6W+$2Qf|{_#>sFYH9@= z!9XDQziS``@P{K^!zoqf$V+4ud;p!|AtHZua5K5pgr(r=vJxNf;-4u5(wsO3bc4wX z0ZcO7X)7L+nzVf|YvVN%l(QSJ!q96KrKmIBbezI^iCFL|R!){@A zkzIF8!+^^3{yDE&OPMhaFX2>qz!pM=F3--0Oc*>@#v)m+0J~&Z5i&FU1F{8EcpN-aad&xBVFipG7*5F85rYA6 zCHTt_-eAD?>n+|uzl9Clyla}OP9Z>EvN`TZ7*q0CkWF*+ ztAdK0h*4(S`^xq{my{MvYXHwyE?J;OQZKrD8<46O787t4Yky>oq#w5vT=n|^W__kv zmTWb;^p!`p`^-9$Y(t`Yn>FpH&^l>=Do9lb0pB!%-pucbCKgP^vVJFDUS?%0ylqsY z1@@ZXLTz3gx~$d~S>RW#FT`tz0qMVYqOqeG3bzE+HGu(RNq1hhK)azEmqIgjZ$nBr zR0ggU{+YvXLc|JyhE*BAt-q?1p)s!pMxFeV*;t^#3z6hGd1-JNzLNByu{l#7Rmkgy z@0+&O8WlFaLWS~Kxk-uZ<&~M0>C*-{-FBUgJgNggDL~?7o+^SYCXQa$lQolADC0~Y z&hY+<4VH%aE`dH!wfWc6s!0MkW+ZwmM_M}o>uN5SEXyMXN9yu(9+#eBr&A){4%7?A zUolu}79Y3`fPu55W9@fwH5{&h>EDORYuvkAp%pel*3WsOw461cK3$FK#0cZBhd6mYO($8DLp<7^x6_LdbQ zX_F|G%?g{v$z0W5$ED)01=)0;ViSrfiC=Ha0q!4ffneZn%7_ z-D;DLFiInv8e}6}=#<4QcuM2@0l&)q8T_xh@_*vpGBPu;{Qs!GbF&*vaxVvfE4x*D2 z2{SG*C~Wq`LQ^weuBWWHmD4oX9g_PvTjrp@6Q%6dzwT`xpIog4kQ0f~wzs!z%scY3 zj0v{4u60FxH%~@(n>N!NanCobXoA9ier+)&k-m%~dp3K!KQ6@OB#~6{F?$D^TV;BF zVhYMYi3;}IJ*ZL9#meh$eHQqkK^1M;q6Ac@n!+AEL(rH%URe+1bzn<7yRkqg+DpdB zO0Y;BDa+ko6V{|Lk-pw;2B=aJg)im%eovevaTJN&^ORs(L2@MbXlCecAG-ty+|ZU7cKyG z6Z+BN(AaXwGO6#WE*ohcD!*qQKZ@VGXKS{Y!O9SYO7~LUY7}3mc`|CvCx|Ie38R7u zr-rY2rTCkj&=%z63W;;gFrJ)ctd=`kKfHH#^E}GW&1?c=iTjNjtQ@Pv@`AftKf58t z(6YnNk0kBYl-+^$wwJYbVS}6`QG>DB3J^QbltchZjGTnFzL=9^HOc&%`Vdk@yEL0@ z1u7`&C#XJvJMLMZK1|O7=*Je4ya!>$=*bYy0~f}A5m!oZyZZNn!Yv+9oq<5FifcBoz;zj38CnJA zo2$-aHZWgH`jrDK`eE04@DUrJ0VWzi{*8$0o&)^iZW-K|7zpB+6N;`aWfhRi-7K@v zr%+mvxSU;m?iLNhY5jjfq>A0?ioRMoKw1D@Rp=Zfd>z3d&wr|V{qs(ld_D2lUa}5C z@A^%FHyAtC$2$ek1D=}!RQ!#vaxlhMxeg3RxG3briTHX05ugo{%~?~Z!@kdGmJ%YW z$o4j1klZ*Fr-`lIx}iuYKol)kz6V&fu~Tp0I{7Cq8DJ%Wud(|{!%Bep%hT` z5q*=qbZ@Xni0w-+@oM4+o1;gH`E|f^!YDW7KGULfBVCGch(Xp25DZ7zvg1`PUfXK- zJC^e&87C}CZZYudF`jM@v~M|jXKxk5qobkGuId*^041>6sI9E$x11QCggc{B5(2-h zE*?k2@)HF(#i3t@OOpZufWfHWw3fL-Eh` z6}+yR?NJ|$o$bl18yNC$NxDATZ*UCg^FlV2C1YXl(`FXh)3s$SaFH$7oIjgZHzEWg zRP_&;8VL3crsKYu0?P5Z!~3G^+*~bWVgaqt;3Cx{(y#P1b zK0eHHe|xPI{Q zB`!#=W-u+VP|;8JT^D85>RmwXU$#Wg)krUpL@9^HKbQdDT6CZ~zYr|7K3;HC9oDIQ zpXo;=XtrQ^*8KSlHo1jG&G>>N9DvW~L>Zq*s z+KcZE`Hbn$<<>X6i`E5_90YDYXEUfnb5^D5`LH+`Ei0Xb?{EikYpE4WqOq{0=gqQ& zhhP6D=t%AKR6(ZX%1aN6Pj4I8AB5b{TH8v(f0s-+(%Hh{H>W)M5CmT+1!kd^EXEun z#d4ADu3j)N{(a`}qQXKJBQ}3G*Rz`x+)L0gdZ5q73emTkZ0W*E=nM$lyJDQ@=vjmO zOx}}E0@x!6$(boHWeWTh?!1~p7PCmMrTYCaa1Ttp^09tgVY;Y*5P_|9(W)aAzs$ow z^JWhs+>)%IVZ-u;K3z?h?z|P$PYU%{Vd=8xFm3ap^gutq+Q$AFYOEq34lA&;6!lkj zp)f z5k`rqxJrCj4CG9Kw7)Dp7}Z;cd=qYDpjL%AAd0c;>4ig@A{% z2jy)dgLB@3va!iOxYki6io50&(|vy5hio<`6;eu2}v;>}0OK<(`Q z9?Y=ISxnDStu5Sd`jeh*ey%z#0liHa{w#`%Em>5+`TSD;6>0GCD@hB0IzsM1AI3TRf z#Wl^)i!<7HqpA{=o^;~UYZb$kNIJO_R*h@LJbx|RYfT2nX-hqd)0|HwX)FVSf0^v1 znp33uT%5-1oPObPINFROFTd|Y*TB9tZL&RHzy%C54p95}ok87y<=#*wel?$$Qxs}Z z;+%V{BByFUhDPb_+4??m`wP52pL+FQW!wJ-QD&iM{{Lm$j`}~uBrC#iuO6XwKba9K zRd0kcJ&Jfz%auIH`ZXYMrms8-Cz_>HEeRbf{d3#hJCTNCIWy?04+c&!9ob#3*RA_8 z$2-P8K`1;NNI)O^INQLK$o)4eq8$gpJd0Su3*<5nDws9@W&TqXgPi zaa}ZtQi&om=3Oc>yXjhO6jIF0Y*!)dafH?LgB6>;3RN|#u;xYqb8OYyRX>UTuDI$y z|EeshSk#O68=|3?*xag#@DfY3F9;#EQk$@`URK&@yIEB$csSr1mD*m9V)tC`5j+qI z6HyK(v%fUwi>KK5++_@rAZfRkXw+0&n+<;G0~-GesXH}Lt!~O{VM_G3h%S~6K$shA zK%B3=uyg|-WuR(i6tU^j_~&q~xDbUmN&n;8ss2I@|B~fZBV|G0xkFV0UDGVkBz{Mt zUA>i-MN>y@hJuYHViao_PGhy~GhbU+f8bl^{J>tVoCs-xmF_p7pKmlZ309&71L^!f+1l>K5p$!FR90{wpdLw1k1_v>KtD#cIGhmD& zAl)fifcFl92;&a-*!yV`aCe_>=t#q&$JIzK^O-ryhy=pbmlfJA#t{<&$5J!it|^YA z!*g`>%JVdIdBG;#9{nxZftO%042?XTaeeV@$`qqf9ZM-^MV^XwEAMsP6q>wD&cu0` zO(+{8?XUGm7o6QPlb#uZFCzIyd13dW4xFCO-)I!Nei>tw?>n9LHm=#oM)Rf(8_vzH zRxUVK^I_3XS%P{R*(2Po-T;<(A9vx6ea}+9**Rl#^JMWob$svwP4KXkqxPR|>zka0#xMgn?k`G8Cf!{jRf71+zQm0DI~ zEipI9RMi%2mKx_*W|Z{HKFzmaz-H;Tc66h&-377;O%s}JTdcdjA3ugEDQ-RKd^Szh zRWTwj=LhhvOK-wLAKBV&D|0pLe|0|Sjtm&H)N2amtNnUxLX<{Xm{RV=owWcB*8WaWia;Z@n4A~2DKB#$U6h_< zB}#Fd9#)dW>u*+L3e>n4)B_KSgEZcPODG6+TE1qvX{BerelUeOlx;SzWZyxgBE&bY zKR+nK25}nAcqRCA!Y5Ak=j#M@oz~8R@}Vsj$OB?KfpUl` zdd4tqHt-7lc;0cQn$0xm-#ie%US{}!2kHI)Q=jR0f$kY9*~4a^gmGdC?> zxr8<${p?92y=j?lZeCrwysW#C43Sn&LYZAw!BoL0DKnNbyVDznyRBFFKFl1 zK#i*ZT#i)k5&d?p%N}0TJG636*Dkf<-IB~ z=jL=gClH#b>O*3eYq;N}){m>g1STtew&vJIdUn~2HsFsY3r8dn4Aa`(+=8iZyyWm` z`E3R#QO`blmI>uQQ0CK^^a)--$aR@M5Nw!}MvU7> zgp-gHA)m*?FwSmW%uK$I<5X8t&CwyyHZ1b;Zs|UC9klMieNQJU``cG2ZB6(jEL0;X zaSMM^I{0c&16CU&R?7)R1>o~R^1bxlNnwKn(jlHj5`DjvV&d#~v*)8RDo6m(s)?&+ zTJlR*p!lmICgC-T~)YhR0u~8OL7=b(6BqW43dhXuHqGi z;ycgx^yix9HGMJm`Ls;DXSJIUgfJX3($=ug5?e-ABP}b*xviT^Z0hiw znem)oZgY+a9 zla{()gxfO-;L$#jLwo}?>+j?vpT|r!r%;7H5D7`vYT2` zRvbj~v~^URf+`@$WJcl>{5rwaEf-5Xo`~3O-P~Th8?XQu6WU9zxq^e<3{>Dy_ye!I z&#OI2L4~Dv82D>kvO|n>eZ5_~-I^rB;giaA`y5c)6+(g#aDaX_Vy}-=bSAH!sHz0R zBarXlBPE#u8&UujQ(~}MOe4?_Bi3;;?rUO^A8&+L zFw5TmXn*cIEtd31#w*WXiA_n3i4!P>V8rOk^!4>NWb&6N{kVz{kPQjK?h}aNE$utI!8Jd;@^@3IUAAimhDE76ME-!XT zSC#BK2lFo1O$H12S>~MAa2Y}Xd=c$oKgN++U2NYBz-pG;KA8t|+muaz_E=C;Ms=zg zo7L#OF3LDQK{~*m^Rg~32fBgWLl$SPDhmvU>pLPmc^1@A4i(RJX3TC&w;&(BgjyJg z5ifH9`4^rNuc8122cG2d1_DqBMpuMaLQg&oh$t7VpoJcQtP8fGjt-UCU4Ot4cQ06! zcR7GR`!qw*K$+<7avUuO&ns1(@JZ*kreWb2GN8-sG zvnMFfZu1Mdf#PnTncil${|j;?m(JYkXTf8!dGP8wtiIl;z}qTq@_Ky=BKuqnr@iUn zUnHL$w=1F?vCe`7o`)w7<~d7HZciIc^BV{7*_Yk=-o+Kj{MCdk@{j9t@8I?Ox%z4| z8)4(i>+`nwQ|tG3|Ni=ta@R;gn)*b|=jwew?}vzKQSu+V_3`s%qsE3Dvoo>#zsa>wxrHe|Y7uv7llG@94lw~3U=3l#&&g^&^ zTg@u5GG~Y!eNsdNBFS_?q$V^gG`+JCO|~hhcy@!k!j+l9t;co^v||%TuB^4O!&grQ zn`WQ%k&>U}Em!#Kxq<3+5K~NY2GM9{fHDXta7fh^k3-STsW!J=KE0D;6T4%#%UMIE zn(L@8bX&n=KJ*eVUNJXXqCywSX{viytbD}ulgb-#%WYU6q8`FaCxx}l4M1}`26@e-!(Tr8NEIZ zFB4pp;Dh9*rwZ6G@qqGvUn*YI8Kw#~6(zTGw_IB;-)@E|#~aI{y2$;hYjbXCg4wg6 zL&8~?0)*KmT`Jy_D(vk~o^gg(=B;l#?8%4TqU0jwN^q{oJasW&b`0`|tvYAl9NkH+%Bd66+n$%qeTndS{1m(-6NO3Zg?}G?JMua|+ zHQv{(?uWaKcSK&c8~@B29DCSkfF@PZG+hk5z{AA!^nvU1U+t;lwfa~OJ3t9*2r>`D zD1g|fH!irR8djdhuy(Q=-8Ws|H)KtP;$Yu0<*!F-$G1PK=&lkbFKx7K^>pW4R+W}d zdYfG5q0h+J>MrrXLGI7FemGau;N=a0`1lkVd{*To?za1FC!=Ep>YHE#mA@IzTlf@h zwZVmahJgVls&*U(tTQJv>0QPPaobeQ#nRxoYy5dBZGdZR&)Mm%v2;hkYbyuI8;vr; z95l6;zc9oyrO}5?wxQx=i;8EASZLk-TRy+J_Wy4Q3Ll{O(CRUcoPD9Cu&Yb zn#ugvxm}?hUNFlBBEo?^1)A*(o}3p!aKP2NWowsN=S9oAl{`fHp!=JjJTzS&T^uo0 z#|H-Nx{5mK*FgL#O7Mdz2>*khTM9A=oa~LkOdi0)W50E8&`~9Wym2#3fCQyB1(Vfe z>uChZQH00>QE@rKb^9u|5&(%{9T#Fuq7)o;cp<^uDUqmnnj_ufGcM!`sB;K%t0O7VxZz@=qmCrxxNw#2PH|^)_{p$S6uF zL}nF=$BRGNyPEde>0X{G2@}Eii5F9Rjm$eDe>aEkbeAFiU#4#12o(`0(Lbhc(a5#Q z*9%=wUE?;5LG*|vuN3>~eH~kq@c7$bYmIBO)u=pTS&&5OK-*8a#bF+w$6Oaw@;e+v z>%w5{Vo0|}wfi3nrzYA&na(YnsA`~@lg#<-y_kta$)Z7ftCQ6Lc5IHUBU2sZ4lEIgdOu1Y_LUIsA*u@ z1@Q1@ow6{;?#eL92Q!; zIK@Hx@a2r?H*RDiSvL<)C1Z&U+s1#pONhXVZW04r#q#kA$zNT?7|bD3ZYz-9@!}Bg zoV*ZV^JY4NOLAnGfR0;d2*j-|h|4+DMBdG^q|xjbzu@knKo|he-1?S;hF&DCsJj-& zsBszwNkVhCh0X{)RI z_2kJzFcO&-QZibQf5g~sqKDG}v@|mgdsqVyfs8!eyI(Jl{qgGdNCl1vGS<{jX5BPA zH&0~ou~#S$yI8lY-5WhA(pEy}KLi-Amug+u8{nWJu!kNw(gjg~YV*I}OYOG~$%Ibh zy1F?BjObk>%Rnf3kIUV2id-{~jW&NOseP@J^u4YDLHpdk>Bn{Sn|+!W^V(L5{7Bjsi#i8v&! z>7`EWKB-tqrVq;-rZ=8>zG=k`Y|dfQHP~}Z5hEO)^Cu$}8v~(%d(n|V2CXqup{>BP zB2=SnmflrkweD$@E(WaXam}?$hu6BX5le<-CZ6niR{i?H5jS`UPV8b0Aa%`fP^E9` z-%>1YG2z%z{_^C!Di@C`oEIb4nwMTEZX4r(Y=%mV?w<|uFIo-xioQ{-=~Tyd$#bKK zOnGSPYdOemM3lhAS>2vRgXe^6D!#B3QXh)SVmjt$$M8U67;oQ(E-kxAZ@n04yJYz9 zE9@ZWtd_q9d?8?!O#`akF$GE|4=Y6x&;o%VrZpjur!2Z#AzXy)LCX=Fc#AXd z7BYNZTwujTgL*mxtNGW8LK=r zwHNQ41);>-dZKtQ&m-O&x_zC${GfJpBUi{+o8tM16fn0%pPNt3y#HLg{Gs;|!-39b z;2_7wnfcKPfCAusp##_b+qGZsAzLEBQI2MI&wuwIOX82guaVYW-1zWqgq$o$`jz{ zT`3;P8G13a4gvv$ZJT4<5L?$vHCd&nW}GsF-}o=r?4)YO_j&Ad`PJ?$@+e~hR%4s5 zI$Req6|+|Db@LT+(fRxFTTeB4UYZij?r>S{_UFenhiNqNpxy=C&+`@D?XGj@_7WKH z@u*J4%UR8@e3f!};-r}#-l{TjHumEin=zNOMA#%VQ)N=76td0fyBUpy@;=W{i}ify zy#BoMBOWi(=Nvp^GB0YHp?C5jdkwG`t)as_7t);yHV)T*+Okcy15M(y`?np?h!jejFKV~tf@>&cg-NG`EgM&n%~3KY53rld-H-a%jWl}(dyI~?>x&p2 z0c-AvR)il7E3It4wbWBbW36r#FG5oDk@cj2%8a?4T-SV`ZP(d&g`r8%Axp;?g&B<^ z%ghLE>FAFac^8qORxj;n8Hs&|b!>Y=IQx#>9OrKl&?yRB94RX_t&6k%sU1QbL)6EE7GLS^|8=m zrXpcIhG3DRZn4-mb`;?vwhTfYEUANn-T{Q31rD$Xwiz0tT4rFtYeY#uU}lKKV_`35 ziq9jS%z+@y4NrSymUU%($H6Ic&Um6jKtH-+2>|JI9a46In}y?b$i4XRs%tPO;X_Pu zK$R!I4P$O_zP!@1)pWFlkM`h`L1V?2g!^U4&186!#m>Xpmp(ZYYe`b(!k~pzMFin; zI6C=eWcS}M<=bv7uf5yTVD2N^Xz*Oi*c0aIh`)C5f4#imC>e|apNXKaDp@U2A&`*b zNpH4?`8RG{npxoHGnBvCpMk5h@_{-VIrzzVxjUi5IaC^|e$E@2wSnQS@ctqx6zcmf zj)9vtmB(UK^S$L84KnPvdQ-@D*)nxyy)0@%AlxaBE<;`lAh8=+f0Dj3upRNyD_uP5 zW0TL?TTjEzUm2#y8DboA-O#LDr)RQ9K{t~&0t_cedE!FA9py|+9pzB@w4A({sL_B` z;DArG9qP5p!`w^D^8}O%y>sX!heGcO6V@X5T*2JQChsmH`gbxa$@+Wxew8$5bK`Zv zBo~=(5UVqultWrsM3h69pvD7J<&^kQY|1EU2={bF#bgb6Q6)upWLub!%O9d-mA?Fa z)NmJ0SkVjxXC%d&T#3Pa>O7+UUlR=-D~&@ zPJ`EZ5XA*<{Ldpi7#`e`%M1|qg=LvXtd7k8s?^fL+CN{Tw1#{`2{38z%-CFkmy4S? zw2dx4TPA)Z<_$smfsMEVL~~R;z>!V3q$Eo{VizSjm9K!sjHrd z>G4rRR2KNw3p0xXVl$~{&^bF*-ryc_%Bx*{lLNnZTQTa~8-tw|MXND(vA zuH2%jSWY@6Q6vCnG|_Fw9d}${T?xC=Uk|qX7!jGTA_|P;?YyYZJWMiDQT3Yt1RGyy z<~9MR2x3NjG5Jej35}D@@g|*V;k5X$*O?m4)g8rVL zPasFj89icqa6XcDv}(fa#2$AFGn2_Kgj>de>0rLEy{n6CBoE71fs};^WH^HpV^jr= znE-TGtE-S*q>`0@mi|Gsg~vFfX83JO|#^tsr5A1K~-eAQL{igli-@-_Sc81A*1}R;*_{ z=*58l7PxWMhC!-15!i`+(i$**)A2{VRyep%lqut#zc`{H_p)OPA@g|FH&kcq77x2! zBc&lk&C5}Cy_v~dupd+Vo#XY)48$}Y1c(MHd$`-ZniLnN@#rCDpFYE0q^LCKLi?zM zw?Mm{PkSD;S2wUlO!VS+IeEw?+E{&vQ!BX$6O!j*26W>mdGmEeObAAj{Ld@e=Ltk? z3{3$-*@N|+pbFs{jVJM>f#qd>EOfNzMcf7(9EtvKl{ofp=hi6fuyOLZ~kK zG0PP2Y25*yEE5$S7+WwSh5aao;G97Y_x9g(aNJI}Y=h%?Ek_Tdf)jI`owNfH8I+Ra zd~i=46lj3ac^fW>f9sRSHF(X&Wgo3t9&hLDRw5{)glfQRf@X1YIH zP+r8V&0Z>N@fDhE#)!KtSY64x^V&z6 z*)aq3niI$@27Gw2t+bifj%kpuOz-m6OaO{?z$g7tv0S^}nN-OEo(i&qKZ1{<=BztG zk^`IG>#46k$=R>k^$#%t*&It#9>3#;RU!Htgsbeu5XB~{Gp)9z@;WHlYGG*}a=8WtT5jWVuVid(9XeaTlU{z2E=R8*{7w6(Lx(8X?y{5@R6q zpIsD`7!jP<$^Cd*@%kX*nkRu?vXhjp7kNZFVIQlu^=nm8vOS<12U$X!S`fBC@)aWx z1pz&6V+?SjMMN3D`Y;VGOm2k%1=l6e%8IXv9Ep_}I=Vn)9B!al-q<*^R?J5^81bIRQwORif*FW!&w28pRTIMTsWz8{3p zC3x|s6%BWXlbD%ZnjYV5ng1n7(wBU%2{O3Jz-;r`$%=8A#EX49(s(}#;MdSGbj(I7 zgJ1XNQao?`u^pBoK#K%Fmuz?y=`AtjyLmc!b3-j1C1;`}G9(v0b>Q@^h?|ajGKW!# zFs^qn83RzCe`WMjQ1L1|izFZgWIm8#mrQZb;*mUq#ooI`J0|-;dU?v~r)%aDZp5kFQIfREMVZK%mMFmfRcwuP z<3MHb8hBiSGHok9aLRP&KJ@#oMgAvoR!VpvUK(8g=N2JEV=?f=AAUjDf9zn}_EdWW znAinhvg1c$&25BLO6lbrEqq1JiV!*9Yh+Bv1O2)H84fdIlh(_6^q{&gZWJJW9-6yZ zagBy6>nDM$udAj0F9o@t*ZOSXuV~dR)2t@tn?N)9yk|u^8NZJP#jk9bp4`YR?A|z2 zpy=(lM>aP$+#DOFMe}Y$x^Lf1V#T+TrF7|o#Ya<>LKLkZSR{PTM7`K#G$fawLgs1j zN)FrNsS)rbDBQ}{*K$vA%Twa|@(|TrzWdT`Zsq(9WiC}7lBfwe>dj&u;xp$jWKApG z8|*INtTt9+kp30ht3@Bz=kNJqkQB7TXi1pr?%u+i!mvl$?2y)}c4mlbM$@p%Z-DW? za#SO>zk`Qn2p>wTt%cSl`st`50Q$q`Z?X6pYIoT$fMwlAD~GeD=hbVsRw0QU7q|9{nxDhKQWIBB$zw<`G{Fh!^~5;i~C#c|GRA6lIP>a_IcvPc!>I#a@y226WxWGHcide zrS;45dneDAn|WwRS(3f^8daib`4jg!qL}qwH*>K>>)Y}9DeW*5%~H?mOPm8!wChd( z7?NhOqUdqb4(0TVWELwvmzsfDMTJ+o#luo^3}UwPx!#!f+N)cWS!)$HLWKhqZu5oz?>6z5%cE(_cgI2Hx%tzRd{~F4F8;xW=P)B>My;b_E}UNO1ukvl zoOdtS4hWYH#`b$$5QY(4kzI=WcbB*{aH@SobSLQFgS@LG1o%Z>6Ub{ZJ;2buQ3<&IW4cI}t zgwu>wR@q8;{$vEQ2<%k4C@t(#jyOG3658fIQVVbC4W!}d&DQ2~0#kR)VVo0??7_PV zwTOm#stHfq*9B2ePYd*NKyD7Qzx_$ThQ+Rm|2+J8r#em>!x}HvsVqzdr5VCg<`%Q4 zi<1Amex!!D$g0NfNcyQ@u>(^|=;@$xe>WF}v;~i))aO*Q%%|Y&;b3XM)~HiNqwZ*^GtAg~>UPzsPi9m8cL$B3V<_G9iZof+I1FY}eK< zQUhEhxOP^%bh;|b7>r>KcaD#MD~(OHOjyi%{N=kgr!O>{I|J$%9=_&qurrr(HjKVI zFzW>LP7=e=iy69sGbZRb$J!S=a9C+MnTraq1H!6Yhbc~Ke6qAtH8bDKgxPH8?KIO~ z>N5k@Y_9+pd^Fg@$O*T-Ops74N&_ei%U9?0dyR# zfbkru8#b14!-WIvtZw~a!R%Fv@uu4(w6}6QP1^ujDTjbx`02mKfyL36N8~g)>C)v` z+jjt`IPmacZY&E%xc8hrJUvMKR0zhQP7*tp$NtKBA@E_TZsfc{!}IjVr-H#ig$VLK zN=q{SF`VoJ%GAw8zccZo!BQX{sHiN~?BSM-26j1t#1>Fq5I!3ms!z$;fa)jp8hXeD zQC%}Lu2*2yoaM6(y_U@FXQ~>mx(+($L0$*f=2!>!-f?A22Ar4VTUZC4Njtq?|Jc@7 z8Upr|f>faFt1E=PGqeg>=U{Vo` zk$&U3&|3=E~y)cj^p=BZu1uZ&1)N~CW zb4U!IDCx7D2K|8EO|$7tgTn;P_1V z^|ZZxH5E;HczxwDD!?x*G3`9SCC;-sgusqhZ}L57`(p88RAC5=ob$|rI7qVy@&vQ(OBb(>K?wM6lDC7%qM9s+1v?qV$w-lGYG;N$!sk`K8tlBKY}#Cu1}s*0bB4++VQsX+XXn=CZa?fM2poJb zd6G(2{-Wq zpM*7_58$R^$|GLQge8S!&xENCzaEzCijir|Q_PA3Op<+e-T%Q)h&ExrIA+vjxgx_R z5r`BYY_#r1ARr+RT%Eo{BoH8Ra+d0d#GX*kBb@V~k2kB09swq;bAXgyAWi{lb+>4{ znRAxb&!@lwH|S`Jg9MOyL-4&l6mO_|X<#1d4%m@)>@EqPies2Q%(q6RjBP@33@RGg zP&0a91gT)JY%*g*u2qpRg-mG{>{8Yb1x2>k6-A}*0M6jr2BiSNUFHp={(MU%TrlJ! zB-+RW+N3m_ig;DTq7+UzgQ6@r$Ver$FHRvfv^!=LwR3Ulx;>Yi`Qy)1o#$Hi#&OjP zn-LXX1OQ1UY6Kx?F`>*0!QR5kKAzpzfM)6uPD`j1jVeODAiC){rj0x%pK75Jhz_X2k9k6%=iKSmz-RQ*AELxZ6qVZt)8G2*n2qE{X+ux`AwlLO2f zax5V7gVC@GQ~|KtUYFOrUKDn*+3ej{do%2ff|z1fv8+22NGZ}I{)SR9-`WHO6hmN2 zPxC8~RsMPUn_@B=3Fo6xlSM493=yu49Q+fO9-n6ViAE7hEs_qKtdN@ zNx?A=9XH%WWIeBeIDB`1&Mc!bq!1O7`GOhQuQa*_hH#h+UCHchxkbQ zt%~qKZ3TsBMKNtAt0JpfGbLl1KVDo;?gDk8{!?>%8#l9RlY@oMgi)d>fr2EO)H12( zQeUyc4l+?lUz;7)|6*9$4ns3bd@=Bq;t`*eiiM7YQx{LH|MMiLFZw8*fSWR0^cOD1 zqn?GH<-^8jYjw;$;0)M7X&^4$muEg1M7}crbvrBd=O*h(VfEk{%6e5^z<2eJ-)BjB zaPZba+&Di8$pgph<>6@rR(j$gD|+ZE<*z&t{f++(PFAdM#o?JpbDYs(E6HqbcL^|F zm<98aZ~{LJ9WS{IAgPjeFI8L8-5NL*;gLcLb+V>?a-y2&Mku472g=*?6-CO-;OiSE z>Ls;X4=%ifO8fJ3r29@z02_RUyJcE16)C8Is$P7ok=cwv`VWFM(2ua+1I^qhFDJ}v zl_3an*hZs+%d}$#WE_UmA7e)*YQZ8YC(knpsqW^H8E3}bvWwzVji^nv{Z^6jC?9c& z`#D-4ggVRn%ZL5e!1P1f1CKC8wFW$-s$^j(@9$H?CP?J-UUJ_mygjNvwcz~=#c`CW zC%GD2P^E3ylP!wxScM;M%DZJW)1$FZ9-L^3V{2?-yKvWpC-K*0B|#2*NEWWa&EfTr zzHBnZ|3Z{!RxV)M4hV>v+p5HR`(lvlYb*U-z7}_#JjDtQl&N6`LwYM*T#BmEaal3; z`eL!`RIeRyqj`FXa8&+ykOxo?r@E7}c6U&e&^GLNo021Gm&0~b>WS$8>VcC8;*#K9 zK0T4B61&KEqx!PDfeUpSR;M-_QdJp$kE2~I$j7t})7&84LlU`0eP;OfR zT9ab*)e{&u|KLwCgO@*DMen%^-y4M|4DP$-#Y)7IbcUM${OfF6=`oWYrnPLeBf&_S z79mO##sg3Q3Bw_-uC8<`q95P}-0A**)Pet1$^sKR2gm>G z{TtELO4@8i^}Vf|)2fgSMsVx*IU})H;9Qg_eSVpE0j4#eB}3{Uq~zMv+jX)Bh}2fn z>^N_3;u1m_zTWC{%3r3Z?xos~tNW(|9b0&6dwaEf-gDIN6Wz_!lK z9=c+s%YRP0x?q%PO~|H(*D8G79&NkgWRc~o^82)Zkk1&qjl%|;`kKhT`s!k>KYI1wHH9v$3700 zuKO|*D#)(ZJ&clQZlCe0@r$V4Mq5$KrrHN1cW(%(FF*%9tEW8&|AxWWL-NEel{8VE zWxbzDY*+tmp!-<$O2!$QxzG`Q0C zGu(2O&LMLT%;hxnO6)q(wC4k&P-Bv?SLme7vZD!p>Y9>TrVEnj&XN$NF04uDU941J z@*<=f>T?Ap$D~QBlsuNGt@xd2uqQ%2(BmGU*?Nt*x|(Drro**5R=Uz`yW)qDzGoLF z-wOin6&XtwFFu>|J450}*7Ow_xEh`lyd4Hm+2bm`TC>GDmOC;yi`+>aHSzU|=(mM# zkWUMFczAGsG;w-ciihVad{IeW{ARi3>VJ+5_=UD)9L;a zdzTN1p%{f@S004960F#Q&`~QN0BKxs;e3Rvl0?>3-Ke|J>y!SQSQXKE7t_!0`me)& za;_Vr^Y`xyZJEE8wKWGIO`8K_JAhS&PWfrsIE>?waj00stHeES3*YABt~!^NXUg@# zevV6-yX^BiTO7@u)J16$lc>i{TMBj2y}L{)XMk##1gSi|wcEi1=5V?zvh=Tc?Bc=E zMqU$NyabaN);&*eW+Wn#MtGpG)+5$f*BCT?$oFssqf2pW$-ckkeL%?XFU0T?ZK;(F z)mLEKw{L&?u5*G?Z)dyYYaHPC`ulS}=e#$FX7%?Ib5te^qzt->AjAFH2#~zNEmI96 zbcS8SV`8dZU&1~hM$fe1GdYx33;WQU=%P3bNV%;Gb<>q3>y}eyS!Sd`qJ}*r>YBqa zvA-WC^Ayk>xOoC%0?u=12laL_UmU}89=1^E?v^9BVtQuCm&wU5^=TBK<53cvwr03y zRHX3cD5@7rJDgt>U0qxZ2h(xK`2ZLPzplTi4>CH6!=K|cJnVoq_d!DP1#S~` zu9X#!0~7yJX7<%QX_5KjR^=1B1-MvI^45#@Z;*~F015nO+^1CFUlNQN0VIs7#~QqeB0+)>pPbQ$JO@&9MziKNA$;Mf3c;ES zV@9UcRu(kpqO-V6Q{Np4om?tJY^c)LFP3TENY zyysd9LKw(M4^ckA+z5d!rxEPqM4ObKU2O73E25ZBWZ zjMId5?b~rw0HkeF2e6IQ7{_Xu(Xff!a^9H!Lp>pPZYccj$1;0+y#t zOty-q-Le1{+2n`QOvN)N2Fn61{ou6IHTZ6<1 z?hmkwc1~*WSRPayU&4-JJrV))FUP=SB&2pY2KKos5Rr-tyKtb51tgSzm>_%9UpYZ= z-zndDnlLy(2I;p`BJjNQD-ci;ZYo63IN6wSYi2M|?d{@Vu96)pON9N!5+tw#v~Lf2 zqzz(-sWp7JX!(aI?G=f{>&|qdeU63pUf*5iggPloTz*hhLslmxs-6Jr2`4918X?!C zt!v0X#ig--D;Bk5`7t*)p|%t*`r@U8X8WIywKbtV{-n81uj7O>_#Vm{MPjw#Iz}VI z&8=@mhaD*wB|XPKF9CC^+tKaAt1;C)C0+FcE%>}Dsar7wk4U3#6|r7KKg?AqD2xTc z!lua@MCDzYwi$P&6P3@SgryG^eh3NnoOvMby+fwe%0ndRykmxBNxhVDIB9O{y6v^0 z6I z8_b+n4{iyb-}i_lm9{P@zr%C_$oJ9O_{s9FbMQ`7;DinnDKTwM!C>37O=^i9kMXjYgH)A{$e&m3vOcW0}MMGEUmRW)C; zfd;0EZQF`K9aX?LEn?|E#(W{hT%kK6{w_(}Ak(|tBFA}A0HW&`C zvsInf&BHd3;!>qxSD1Jgz709@HNb5p5s;hvCYbaJdmcfu_c5b@*3Jg$%Q~ar0zb7y z4sR06Im8uWMr7~k#8twZbqFW*S;mD&yb)a0qn-GX@RPQzOwDNWvTzX@8tAu-aye(m z73D7Z6Ms#Usg>SS?H7sknbjqc*bv-XQ(&A-Df>aoY62D;8a+Q-2Gqc%-J`oP&aQ@$ zcW4~^vyJX~CAYNsS%LZ+kJ*y-J0`5T3T^TXJ^I5Xx`Sv-AK0iaMHBl5s0&SMUaD!B zV<;7cInf`rCYo8~%)5rUA$&%8#BkX`2PFBZX=%qEjas0m3dx^7I2`p(K-L1f1h5>F zZ-lW{WMr*QS0L(~tb$|HlZKMadE)ZXBX1W{l34}iMB>6Kfs6kPM?t&ui1|q8I@)a? zaX`Po^~YlJNO|<18O-;#^freV4%%N_f>l0V~Ii5L87C7xfy zh!{<~yF|c>{CkIH02piYZ?EJsQ{Ag3Oew_{)_#1<=WGE>Su}PA<+Wbp_-_S)^w>}i z{<&*t3?Y8<@S@6V71|{^76G^ps3lFq$rO}#M3rGtDYWLl+F@!Opp?dp1t0$EAqLSg zo-VfKcAcPF9X9e1xgZ@q`>d)~GC-{5Bg@&moa`)IiTs^9ERvkiu6P4eP|l(xa`C!M zw;fS31*ara&&E5qCqot(9V?5}tyq;@#%jnBT81ik+&Sg z9|4(%B$#*Znuq>5JTcNA(4xfG@pVOi?Ch=iXY6>fht)bhBWbcL(}GKGXmqnZp;9@% zU0&Ta^8Ht*W?4`(Ps4u5j$~ACtX!%uA%4}5m=S0f+w$c18DGMGH8gs1{HWk)eO=Oq z%&mMwx81EVQiIrz-y{C}-hn`bd~F{m=O6y395Yo81<+b%f-*K|&ypK%-}0=EXk##7 zEKF#;Wx|rXQ)0Q=d*oc8-^s^Y6C8M^8y`7e49WJh79KYQnkrUx=~u#mwna&xMlzG9 za?~S!lBL*6$6FC8Af%m=)_BqIpcO98iaZgfuSe_q+wB)DR=kDkKVHrMD}+8XBjf*K zvd(B~Ic@#V)qJg6!6F<%EpYOQP$mh}%~R^|JgRzDzAJg!H7!}9R>$n?&U7aGK@WX0Xm2%~g-m>diovq%l!~dYO&anITH8aa9#+eGC zz}P_NmDAJez|N@Y6Fb{hU)2=Jj(d0Z<#J$XwOvx5;?yXok}S1${hHT=WLw0?F_@J?;4#i??j6dhNcuTAhaeg_#Z2^Q8%GckWEy?7Np|Qe(K) zBj*G8BiJ7YOA`O|ob%rov(Wbb2*@@VMM5NSVSM=fAI9FXNfc<=vMt-TcG)&}*|u%l zwr$(CZQHi(s<&^v=#IV-=fn9ED^}*5IR;moh@)S9yh}6$!MN}PdR7aPI9C^o-eC3n z7R)j)C+7b7iWKgsuTYSaLb41&D14Ls+g|GQ3Qy&?Y0YDY`_$L~Vk zcY_1ffmqjcObA+{DP7}bWiBu0-f!d;e{vGFDo)AA#|i*eEridx6HPx1lfnj=1}P9t zRvpC$E!>!ry`2l-#z5N076~C$>dh#m-}O5-|}yY9^Ay<)t02 z8QS<*H3bDX<*5JJm2wHj%;CVw|Gs?kCgi^-73Y0>i`L+s)jSYF< zW8QBdjZ;F1`XW1fvrGDMTUEV{+36l+g6#4?cP0gTQdwdXX!~r5ypK828_S9v!j7`$ z7#S+sN5CpJy~w2cx7XBXX!g{LBxR&CY2g5kwS>-T-aq`U$mg+ss%O6^=_VTDlw{hd)653BILY2$#x7PsP+DP;X#iXutRiMhFEyt4O0cxV6Si!Z3JsC#B~pOKag%*@cZFq$bfOGlE7`LjYY-JGjs?AbweS~a%(Ag+2Rj^)GavzJKs1|lyr{*Tu#6vLRviDq_2Rs za8M`+*u}5h%Qmsz?$Rxo;5d-x;oe6`@IO`}5UVrlTx3M~kB?ZIMG5$*lUi5Odw$|{_ zXigSxULXn+3?f$C_4owQrY}S}U>(zR{N}B#w)J>#r#%Yu!R4vwTXjFu{Vz2_wiy@{ z<{$LQG_*+vc0|HR&#R5l8t$T&-?1YHR)4OX$Wok=*zr}yd4mpmWIZ`X8p}UkE(+K* z?Vyed{YxuAFlFlXL>Z?01T8`RT$%%W*);lcT^->ZjuXuLJ7G2b`6;8{aR(^;N6GX+ z?SGKT@TgJe$Q7L~k~ZXEhEe_>32Z%VBSbrkuK&+MivMK@ayMm$u1y9x#=%t9oYKUqkD9%815AZX_OK z4fD|adk-A3^bn{Iu>7!O7b2Paq(+>}!N}$F)A(WYKy-jt89e^}6t>^~c7TMn9v4Mr zm|{ku2qQuTsM#iht&ZI{Z~P57g%$YmQuUMD(s?#gKlNhkbg?YhzJOstGqloq_XmuN zI(8f}fKZ;|r}nGDC02Gey#Nos>A<;up?pMkcEedkVUjgxb^^;QAPFKaTnZE#06^5Tv7 zDSO;s>w55yn8i~6y6bi&ine9_hfK*8XVDw;wv0%k$@{*Scy#lcG4X#dt!Myz-}K%M zk*hMuPs@bg5n*B+Q{vH#iJl~?)UIO7kGgc36WQ(|D7e$=SzpgE_IyfYDQX8@1y&YG z;ZA{9w!(mNr0xRa>z!I#Hwp$2D(r_@CaSy8>Q2*gq}F}+%9qe(`IZYf?ERiFEp_Cq z-H&kh2s^Ny6|fKgn)Pd*GXPZ%BO;Xj%oTfPuE-jbQ`mYlfN@CoqX?T=ZHIj4p<0Rz z=Q3VWM>&qPXF`QRcRTIsOs|z7N@}N8$qxddg}1*bK2NK(0u>WcD(m9wRFccCkUQD- z3cWA6u+8?e>@(lG%kM=3Eo2pN3!9~z;km`j@2U!fyyVtp+lN`0mm}zw@^Z)G%hM9k zrLF0+o9c|n>{a#Ihk#DdIyV{^Ak#-dS!nqEg9Sv#Y?Q>5`t&{@B*Dkr_6|&YienK; zLflq!w>S}CVf!0$Db+cVyhZu0xD5}%N_9lJ2E&%LR-1$*+#we68d>*lBy>QZJgG@l4iO@NSoTGdYM`V|g>- zr2Cm&mzhbYC61!0xIn+VRr;P=fC)5qDjI#`iGY~m(p%?A+@_ov-^wF+n zm(JFDZ&?X{fno#1VnN-Q7ufnAXo@saXLYsL zGjS+CyGlT}Q+b%s8zzR#x>H-tHOEosuN}&P!jdd&=E8WzQPm-iTg4HObI;W({MYPm zjgjQx9H14iE9ys(;v}z#6_A&~G~D%#aaUFVW^mIfwSwLsF2@9bPbRnOc|}Nq6yDGz z?${*uNF@fri_g_eSNiwAiaqaj@tC39fU~IPV8P_uIHa)-62wP0pVP9L_<_YU@un*bB8gtl?dq8#!^IdJL5o zhy2^Ghlg7o$yB7&98$b5y-QP~8*!V2bI8QlZJrUd!LvIi+4~TN+}1oI>ZOg5A|RrZ z;)MX?LdXAvp>TM4$5=BCB6u=vW1bxts8Q;A-Kd z<#t-XsEmzh=!=}bi%TfW48GHmY$syhOYGHQfth&I8+Bud*oDb;vHh2wleKft6tn>o z4Hi=+$u>jojP%Lb5m|O;8f>dEuASaR|Ak!1VP#k=QVuE064)vS~p;PE#0+9k`2;vBwI8*lSm7j?HqqU+<<-{JTprf z9%U0^i?VSOe79rUL?$u66&tceE?{6EUlo)s((MqfSF0B9ghXH}6h$ZqHAeQ{5N7=W zrig-2#dC=iFg@2ejf(_|mf+B_^hwhD6*C<>%QKowPmAPRR1>QCll+$$VsM1Ut5K=W zqfJn1aPWhJfVCXzK#yJtFx&86Nn}EWX+hTb$&C_NT+lrdbPAA1)k?xGAvNUbLkS@4 zaM(=?wtH_1c2*F4D0`~#9oDOY$+e5CMHg12`kfBLJ(wV3uI|S;rYY=irgl#qb^n`} z;mFOIYp4gtmwv#afxUaor@H%1u*eELE)rc2wzOc!>$JgXg9901>~Y2y{dN?2aVk?A zfd}B^2=b)q5xy!%pQsd1h|EYb#HS03ngiI3%5)W2)^%*}J6*}0I>djPIoSRy4+Ikf z)Bi#N6#qZ9Fc}L_WLcm~!HL_3Nqgmk@$pMw(IOEkVh1S&uAC%aFDx?vVwOCS%q5#- zcH%IwkNf9USR0>z69?SyS&7~q-|m%6CfzMtuJGZ`tHlVk6$Tz7sJMn2o?G9BjX z#m(v`K5G<{0t(Jfi)-)O`RVO#OV(qR6;;>UO{wp}uJ)yhI zHkWTw`MLh+CVSEKhV>@SZA(C@P~g#eI?{8@V4 zaxjyK8*gSt(eePwIEj=P2}7_)G1}*1HeN;x4)&VL`X+X)%CeyZIch-IK;}bigY*Ry zG3CXm6Z~(*by6qdYHP8u3~{NCz(X~t|G>r3-!x)SWqT4Tk-<^3KOF{tY9JK#OEzJQ zzRt||??R{>vLA!mJnrJQj1DIgyR&z|mJzT8+%|%=%nIDac{X((VDG&K{GDS7Z* z&8KMcw@{V?0+eOxz9NV>F-Kz9UY=eXZm)PZO3G-&bwMzEjJlO2-W!H760Qvz&CI@@ zx}4%>o$!u0hTS*m`hDtX^Rgt^6{Ex5e9duzlb7A7#^(WWk-vi>Adn7M>k*{mbKp(P z->9l9m4R=0DEKJ|T@vKQ59R&#A!RCjqD(l zCM0B`%@b&f3%?M4`uI`=(P>Z7+X=F|ZoeAGh8uh?t#)=)Y-)F3e^7RlQ2K-3>6P9< zZifakVwI{})Q=9&z|B{AnA%QO(Ymr;;wyNT#yzFWvytcQR=J^-OB|xNmAFYb!NjH? zFwEN9S)?e|(o4-(&XxCj8_3jm^1!b=vQOg4k)_4W2x=2@Rru1m9^Ql6y5_m%)`NLv zIVq@t4mt8y$wJVBCedQVc(pwmmK}R=!2HbtbeDIygC7ZBnu`AJz;p3Fr2hW#wm8{Z z035U4g6-v7I)f;6SaqcUNKP30I|S3v3uYHJwuj!|-}SL)adp>PQC-Rks>{xF5)vDI_H+Sq~>Q*ulcBc>fc~4NxDCMW*hR8V06ni|^Tt^>dO2PG3mW zJwEKA{7i!+L{q!wjMNAn6j~(Os*0`2r)5YH%cFSi=L0)&cA)&<=b^ik8ptm4@Z&w= zjBi;6xhZ)t;;WAioJ-0!zB=gXq~OtFv&vX zW>OVh#v%bYh~+n^iMX-}!n?&%V$aZUQ+j*mE)%*c0ag$it-{oDyDxfNF;S4z?56VF zttJg&7(q$=ZMI}v{!`l?TpWVDth-m5_ZXP{h-sAU5F;WRB33zCH9g#fZD%QEb^8YKwGf8WAx6bJptz>@cd!^D= z1_50Vp`m4cfQ@IU0En70-r$eN-!Aa1vGfv9fe!rEpU((Ngo07NsQv9;$nPRB*9vci zvff)KawuO!8`HaRVSjZlTN89hj^jEjIOzaG(Bp3G;~_tFIlebbZal7l7(!Boya#>`G&zTZ zn8rjraL%-xwv?jIz-gx`p@bvhRnzt953mu+fsf>R{cb3xN*TsgTAtXt5RYg`C#!a{ zGMlnL6RXQ=sJNi4!xVpjW)0j**DdcMb9pykm!r)f(lq?mKX2dFqVU#dVw?}%Qc;{w zmU;{@6QCp7;*_jUkPaf|{5w#!n+~NUEk)g-<*YlV+}+Q4uqJMc@YnWC`ovw!$%~egj)xjs>jP#WNQ&zbJbEq5D8XF#u39R_j4J`aaFiG?S@6JMaFiA2^tAv^0tpjYYc+FONh>-=^Xn<1HC@|Y#_^z$D*waeUt*WmM zhcrLFAY37`q})=4BE5Ng;(ahFZC9Z;rWCWW57W*g2%@d+O6q+SP9|ByP`|Ie-0OJ1 z!!7cdf%TD}3=(mXb|^uPtnpcO;iYT)AS5qw{t}iTYup&Pg8Q$%!h4JSx2IwGAm<_- zikke7u5kRTf~FgZHOWJ!qE!FVvP9%MGNGtz3N`&PAx@vDZ-(z*Zxl_Zp8NAcd2+4$aw0pT@Rl^|CjPX?TcQUEyUb#%!J4JXM!J~MBC<7&@a?NWM$&8Z zV^$bUP+rcg*uvtcaSZ)A7~Z55Il@@@J={^bD}=9i8%}%%m3r>Sn(xZx zXx5fUz!rBY$}mChaJ8Z8ijY~QLuli8%?hfMd{1HXxbH)EkH?gxxe?t;r=2(KxvG;9v&NdmXWy0DM|soBj)tm%z^6s6$dxaQzIvuu4u59|OWX zlY-}0ACG~S*$r2I);!>|5DVX2#NeF^i@~4)ofp;%K-?~{zO4>%n9s4m^?WBG`#E|L zGtlU#`6JMk#fFNio2A1xUAoV1OI&%Xiel)0sd=&cnbh`H(6uEtpEBVnuH_BR26>*> zLM$u#h8~UK4_~#vnP*~4-B;A3ylp}_lfVqGGmR!)ztg9a`8jSH%6097cl4F)m`lWpL<{&6>kg-hOudHg%X$}6VPlF4Fh@K zVU@WQWh-<3i6)6=`=3@4AxlDthONaQG`z6F(SEzv>0fJJt0U47Ux!4>w@9|m!;{X< z=~ce6=qO>lQwPV-y7+Ywi}*|{N6ntdpC`4fkc!TAi|WFs>**B?NEFQV z(G|Lp+jedzp)KpmTLXskwqaJqdaiSzJKsS?0b+N)dhW~C*l)0i-OBEiQO!4PQ!hQj zXvcj82Km@6ZN+pC|Bo;UByimKNY4MYd_3Y*DgDQi`pKi9LR zi}^JYNDf%vZ+oo|$S&53D}vjsLT=oD5Kr@B*sl9v*-x;oFbSeOD{3sWN$#xX!aR0S zz_%7^&4Q&^s^4yMmq$B11`_K4%g=7F{J!uv{qmT6EKWy6#Bf{2A1)w)^>FEZNU!no&cWYn+w$O9Qy)8)c- zD|rw@TR9cIf}{cy3MdUM&D@U+B;aSc2QJay9A+KWH0`FOZ$b)Os2({zrqB2dg{p9b zKP$>RJWlDyhyJE}k$#3cHexRuxU;H_HS)KSltl_p=e<}X8{|$wJkwfnto*_%SXR+* z#CVBN3F^c(GcZNV#2K^3xFrFWK_gNdvg=*IqLb(u;h}~KMrJ@iseXr%fleChN7mMVy)q^+D zdi0NP!fSm*YCngx_VU4Rsdw&*hA@GmMfK{{*rCBXwXtL%oHmPtx>1Z$b04l$Lc&Y& zXKqX3AGM>_Hy5T@A=j;JV#_HmEo>3pA=tTI19J5}vg^;8A@~9cD|6;wf|8{|r>BQ^ z*$2iq577o=pv}!mMG&Xz!zx3=Cabdw0+pt>tq&va+joV9$L59qHC>nDkO4>db0B~x zO2V%5BK;<`l0AxCnS-qa6PH{T9|c~UbUv1j2~QJ2;<_l%8IxaFuCzA)2C?h!cRnx& zm{t3st%}@~?^R4PRn#718_X7pb2Urah|HzpkLAOT4sIu)jL)eHq{XU(vqM^0H>aQI z76qHZ2(eo~rocoCE(M>%7g&N>7!`4DR4V8qIFKF>7rW7}jB^G~kas5G<1nujJHuqc zW!#eoSN^Y%9m6tN@ZrX(#M^f7kz71KBU|Q!TTybvst6YSf)wl^`nv_cJU?ymj^0$c z%~rPj1qY19I(it!&wNLt79E_3XuP%}Km@x+>`9T;4`IYJTUTklwaFAb0EhnlK-qU2 z@n@mr$F9arpKe(=tHE}Iwu+Y%)t*TA&=#Oh_knezgwPf_q({wPdS(y2@AfbnREukg zmVN_>AF}vr%De^~msK2Hq^>eja1N$u?0bt%AQ373euxK#ywkMRXbz1wN?m(e_DyJx z;P9xKYI!=}X5fkVZ|wXi*{c7Xvo}SdP?nAu5O`|sfe4ttAs)b|90DYW(TfM|g}*ov zKK)-60Q$uB@@K^&Ya><>*HI4)+I+~M3;au@s3bD&Ox;;v5Tvy`0{{8`2w?ekkmpHV z)Ok`D%=rUSKPnu2exi(X;S}I^@N<>Tc7kqlj@>>%I}l&}Ic{UUM7LL-DO)Zj7YPq` z-M*#c9Hmsx-;dVZU5DFT4x&meA4gZ$^*gE?PL(mdi3D;Ir*jux$i7J6lJ>pBlNW(( zKY&3QFXX=bT>5v$1^sNs2}3H@em3UMomPs|Kr{|?tGJ{3{bNWJMON6$ek{}?mOiUN z%&h#qU>`cpxG01wDXEBF$25#t94UxzM#O*eg&@A3sxc3fDv^*+U3W6YbKSTf$V3Gu3>mTf{OIVF{lFmi(LbXL*n5pocK2 z_k&bB0rk^pQ8Y0``S(E*u;M(JWg%Hr-g|)Pru`bFH6Ln*0!I?Fo~EK|c=qq}#W5qn z_%*Wf20}`$*^)H?%oz_YMv)wpRd^l`D!-I~%ls-9KL!VrQ#> zrfH6paw!?y8B34d6V!Bv$V1ZQ8%vnVt@(p)<$Utz1Is0oChk#1m2v(`6Sg+s<>AXW z#zCdJ7P|6FK$(gnAji|k@44Jka=s}sndlV+fdbuJ3GBni03$iR8ta$dWOqbCInlsl zxu7l#NOx3qN?klNk9mtLE5uh=l~59?{V2tu5(gdr%7Qwzq$C(D9kd#E4kCU1i?JA` zhj%Xncy^hVZm)SGo#g!0VO%xk@B=d0d08{!s;YS zLQB_|BcU;n%^7>!?245jZk|biH!g6Pe}7V;o?Y33Ag6*Po|o=BB6?G3HA8pf^=KAB z`_~?okhA)SewX%_gfn1}h@K-*U>^uGDJF;KO)U;+SWD6TCc@;)YS38(5;0MjG={8%DV^{d85Lr6pkl8*QP0(sc#n{ zI%O?D)2a8b(!YpUJgZ7$33)ZLqcP8{vH*1s7U(;X`rdf^Gc+3Lh!$3)io*;EQ%$k> zW%tET3ZEst7(dh|jDuFnqO?e&LQ%#l_;sEC!^vaY^`*;@S#XlUL>9lB$gEx*6P0;a zJdQs&#<7Gyo{b;>j|y%K*?_5%TaM8{JIA`5KUl7}`6-zQY7cd+vgRz(L zCAw8E?+s^4-yQsKY~*L7s;f@D7T%g4Znu-()2hTjd0?N+wzNV>pB`FYoRCdIrJX`O z8s7G{GHd)D5qUfqy;Y9Z52+ehEJ75u)J(B~SzD)p74tGO>rxPAyUsuV+kzTY_NFTN z{;=&z_iR@EQ$@K= zAAa4<#_q-ODX`0z8o&tul|cH2mRfafjnZfG89jcl>BEs62`LJmOypfIdYhTu;$tT} z)pq_ekwbrc0Jsiv`%oUM;Y?f2JcW1Nv0b-iYz)wZlYQwuGD;;{JoF5^Q@6Gx7Xz|H32Wtp>HkS!3QW{egwl&#TpunMqrnIi zfLxnsRb|SzvHSrbm_Oc~11oh^tds}%S{QMDQY)wRpRYTYS9c##sUjb)-SngUTI*jkTlu)F90`R~@LQMOE;oG@4`;Xc=Wy$38hx7v z!##c%svT__r{CvrR=11_HCaqWP+?N0jg{3%w-5M!D&OZ=@$FR>4>!3zH=|*zAKOki zJ@a>LFMs4-ZCBcp7(FqzB6NM}Ohe;K;Uav2JJRylzB@Vm(dJt~a9CL{I8tTwL&nH&?3Hdh z5B%Kp1#L{8>dP@(#sma@=HTuBSXA70_=+%Rm-UO=NtMFOzR|$U28H8T(LcSrlIg1k zLOp|DI$yru@Kov`m!==7bK^zS^N|*rc#s>GJXS4d%RFITs9~9&1+9fLU)L(k3SKGm zHWNdBF^IKSX?fl(Uw7F;kx=TN`)mfv5BMW3H$uX`y@$llJkS@Pq3ylnIUCZlSd%v#n2yTau93?;`; zKe-gcuc5y2IYVkJU(b)%t_7;~wN_B8@VCQFZ(iDfjUPPLY{NsyH;_qAWeIB$2Ow7- zt=LEr)z>0Mde??uX%Erm^w1<6aRgG*;KdL4gTwDeZyW3v0RQFM7i+^*7avc%a_03q;MjjhoOZzhHN%t!h=yhkbnnoa z8K4xh3dO*LT2YxO@H{h}Ab*khQ{1|?#!ocxVD%0uL{3_KcBs1I(zWcRrt1VUYp zSQVraiAf9pBc;yf0tHG+YnwB%h>jtcMIasrEZ8~o&}0`jx)f0v!1vN{AuUK@59{Qn zfhX(by2M$mW(p5*zkl}Rlz8eCfsS?trU4>_=PE&G3yrfQPp^POWUnaOVJv6rNDrt@ zgKRaph>RLKZ!sNaZyKes@1np#|LBN3u#O#X@tsI1B)6WYcv!sa14tNF2Z5-qq6?WA)g6GzI^fk|Y@Ng=u6^mO z9n~#B))4v6+!jM1-2H?O&Z81xEe8neOh7bnlCxy%p3%%^2p*@N41+LQAp1K^+*l^#sBVASI2jm+gN3?G3ohJVP zbK~HI2WK9GzP_;Ux-INT|!DX7uPFITKCA)xSJb zdAwt>&j5NicFOgy zP>v&Fo#zd1!6+*(8wya|i*3xgoTk8C|1#PY*%N`7rw4RsI#m%O?-x^2WBEP`z7%diy-mw3)IIMu6v8Lva1a0)2)l(hP z!5j#Q_KV$8)(lTF5~svoUSvY^g+!#?5T@3RwQ9;tv6NLRRPZ#|B^qC%6J@y0x743E zYOTGaSdrE5Wm^9oK@wGKPAh4nY#0uYiCHM_AXfP8Gr91qiweEv>B1h2x<`? zNwPVTpyiMc8e+z$ls8Uv`3RM4wsM}=NRWkq(}Er=6LHKn@%!r5uNU-y;_S^&cmDY$ znur77(SxImZxnZVo}URztrzMvh3}hqTMNZDt$2{?>9-LP2G?Dk=}q+~%>4pN%jG*P zl!f`%=_i_COf+aScNA(R)%RT~xB?t6)42GqZ^RP``5~*3D00chl<{W=#ZX3(K;;kh zVq{a@LB(Wd7LQL9yD?ws_6-aVuX%|_#D#&-qgrl)50ZkFzz$3n=`yiycxk>N71lr@ zl2!O1wj~ob17wk+(db%9Q0R9dc@GB_|;l$q4LcHucjh6mg!A6g0lT4?& ztMxaxg=?KN{{xAhBKFWZ=%8+>M1JMpiRwYhKMt(;)l{fC_AWN;C#z8s68u_T2P8Ml zZFrUIQ)7X&f;N7k2F_tvtS=GZ$=NOs+m2D~--#ViiG!%g4Tb!~h{$UUCJ%KIcfjTi zRBqn471!r;6)6J)mB_!U1Yi<7ETb4Z96wejk!-kWW7|{vRwrqqvJNDjZj^$tYEou8 zR@y9Ytm*FRo0^6A5bL+>ym zkP^GZvznD~blveOZ}W%pI==1yLhC1H)})7oP*m74M+{kCr3TWAPTx}W9icbDWEwxj z&NyugMjxZ_AOu8AjaV#@94?T{LThAqlH$$W%?d1KSI|qPt^2i@4XB^rx>g^u#d092 z%b4b#dM+i@2$dCV>hZ!VSUz4v7-k2tXbogt=f}Z53(gzcs7!7zOCCR<$|2wFEJW9_ ztG$tePc5tW%r{TcXov0Qn<&)T()kh_B;&w1>3cGduw3~;j}&09-+7geK6bkbg1LU> zt9Gm$RzOV_oBr(BpOeK+&EH9^~autB# z+gwo&_;3@BNhFXdv$NFF(4`~49^wms*QODfuUo~Ib-_z-dFw_%#yTjL@^jjnm2>(_ zIXIHH@wUFWWr?2|s|3`o1u-y)YHPD*^~XYsI5u-!6vn!&(Ipg_cr*4hB&XX`^=AU2 zv*Y`v(&;-{R^rjsN6t9Cy@bF^3G`Yny_@>v6Me#EK$~QCVqtQ0H5gUV47Ub&QJpas zUr6dmPp31jx}fEEzEhE!%GWCNBr;!%r9I|%m!HF?-l*_bH?I^+jf58TLn8jHBJ!-F z_ycSaD?r0J_RL6rB=c+4kR;ABu)Q4sWT~wakl5IVP0n3;Fy4+$ZoCiXtT=;v8x}#8 z8GwMwhE`s;o$jC9bFb62()Z`4H^X$h?>|j2?EjS$j**d_?f<feP?-zA}h=55x=6{&3{j{^HbG9GBa6t1E9Am*}2aWeWUhhn}!YHeDQt}R6$Z~XAD z8SH3ma%*Z7vX7shjN)@=RiESS$@6)En~fMnsTIHeJQy{Gsb6;B;L_bS-s4%prnx-p zIHIPaGwnFz{xbN@jV}Dss9_cQzWv;5ngyX$2V{21Bc*bdbOY5{96p zbeiTt@{Bo5<6^lyv#+mdn_0tCDiRS}$)M&yo{_X4s5h2kp za0*%xcK;%{Um)RstN?PtrN@|?@|L8lYZp#mKiBqNV~PK{eFTyRO55w^&6z{VfC9vgBmqc;ow8`0fFwXq{vt@I(YwinSo30ts3G(AQh0Y; z`bdqs@h;rGah;LwtGFP@PH)zRTtzM~5$Hwh}cqYevh$FAWyKZzrQ^^~Lk|n^7EkBX~Yakqh7{DIS1!f`o)c zwxfBQ+H&`gwkI5JTo5~f7L9XGTnvsO}lnAUN=b%|A39aAJqm*Zfh&rj?wg zWGhSotRM*u&j4fr4uh#oX*WV0UVd4*LxsGEcwSGUk8JE$4(_=;@$*`Me3s%V>XI)b z^Y$qSC`=w@(CBp0DR~6NL6YtTbnlAy6cEavsCR$1#koT@eROsaA9jb3obK?%jlw(W*7+Ru+5)>^QHS!; z?1pf5Q{>XDtJQV{^?)SWPpi6~@W;l~D)Y>0bf$BE(OY|jVvypXWAim@)=HCsZ&G~N zTSG!h#o(Z(b6O3Bx9`4f4ytZ6lP}Pa@GKRW`-NE-Hd~KlZf>OnZfno5KUHyr-uVxbYQ))! zIu}`2S&j*+uQLaa-HF{*tkal6TH(S=Ty7G;wt26YO@Z8}+b@t02yT%ewwMLoq)NOB zJyK6yNQ$ag_Rl3d-)Po5XKFOQ>qYSoz%EWO(jA-X|N1x7mE7E0(!n#_ybTMnxwy^m z6n0<&L>eQfAaP)@Jp6D@a%md3W3D?fU8GJOC%ET7Z^@L*;UxP_19KBTO4MmUt*i zo?6fvw#!Jv{u3Mtps*PUlb^OemejeL9A4J4N3UUm^ zX*=M}B|W+nX7Y7Y3DwTwb=aUJZ-a6V@p8kt*N~=Zvh#D^d5-HKol%7D^hMrmbdl7; zNI;PBwKFP!v^qf|Kda@G;DWFZrgp-z4kV)@Bc>OnvgBzHqlcj(>6o}96-bEan|yzjncTBIVpLF^veI#6#QPaA@(zAXi#K0|oy6oJh~c{bL~RRQ z+-QRp9`#o0&$AhxUI8&ngP&PW{%Xjk8Tz9`-F?fEc1c84g#Ni9J#tCmO=BvM3n0)C zMnS1GB2ZCgT@x^pUMvy_zO+FVO3&^J@^>Q^j1Ejg1<9Lp##30-V7u&^#=H548r&K( zaS4cWoOr_E&C_(KEpp)a>I2QwX;@$toC@pHHV$u^rqm&J7xT8H9WR^!ePY*;Y1Mm7 z>`3N}QT4=glre8POO}y78T?1XWRwMH@Mzu0fM*RY*Jlh%5=+t_wynwNyN_mzLEM|y zUcF%B-h8siPpQzBqU!J|FVSvIuRwRyFp@Pnzc-n#(`mo?Fy|u1_l_?{I~;S=kFDKA z`4dc0?6zdxadSbYG-Gu6Z`ZeIF_kXV4BtHXiYy6MH&F>3EdBF zntzYHBtPhMb=^j&qHs>6q-K|nTYmvV6wyhJ(;`Q+^1YyaDT7O#`gsovIhT8;8P=JC z32LMyRRSg+9YQg?@~J8OI8B`LLra0CkF&3kg<5$B1}sy>geZsPed*KJTAo`S%xs$o za3u$jL&NDfCP+Mbk5E>r#&`L(uaFoL!2o2B7wVM%8^y2bH~Lk! zCl_`ECo-_oiop0F_J=VT6Xv+5G7^Y`FqG^#i24R-*KIeO*B`MgY-qS0K~rbyxpRRB zD30z$b*i-Zh5xkyOB-T)?{aZ1hhixOYIZ zc`sF#nZIu0z;wbk&U>9?-{-`EPb*82W}@hiJ$JXR4Yobx?4LmZQ6F@SjOnBnYyVB z7Vn2PUU~DjADPK@ zlh5ySxVAy+Ia?K#bypHBQx3;yzp%TmvG_K6K74x*Bh;JwIlR@WrT5RUo$BU>seD`Q z#yxK`v*ddz$_lh<%J!`X+wX0>*B^%$Yj~W$!%-%G($QS%BXswM5M5jN^=;tUYtg2g zg!#72dbX}&uJ0grS){j^TXTcIjT*M8-iBBwStX^Xt+Eju%~ow{d0XquFjCW#_ucrV z^ug5`fE8kQ{igK3;eH!;nmrSeD%gSJX;t!Yv^)#U3%F!F19%w85@5#$DyJ*+n4Vg( z!CYzOlD5SJ4{v_fZaQHfFY?ulE!Py849#T`ILH%d?gZEvB?}ES zSbnIuA!~Yh;R98dzyH8dl%imJe4^=co5aeQn_wTRddfdqOg0@O`wA7Nlv<~1Vy5L+ z@^AINrqE-&Fb(?DId&>dqe3pmaG+l3hvVVleU^D7b1Ju*CKUiEi3TJ zqp5v!7&F*WBeO@?lp)EGg`<>?3f-HWrr43K#l2pBZ5rNg=T?CrbKlL=v|qns&jAmk zu0y&d=#kx>t=L)_kX35jAG@-tBt#E(rj*!ptfH!p+CjPPzX93?u&-q6F7>{SmSW1N zY>y`LO|F6BtuWyMaV5b?ZJl70q{$7)vg3c3cSzf?fG$)9GF&xelm_XGY^I-le>?~K zh}VDBJAZ^(nDJYxl+o{uZh@9A-n=qDpqE~g=SSxrss-0XnE2o~1CRKv8=SKoO;c^$ zoHX8pqbJI9h>uE5WA&TLJZ-u}Z>^hbM;TLk6ph1I?PPC$!@;i_e|Mq6 z9I$z#1~wyyE{vR4FBI!p{NsP4J=y*W#FJU>Dl||Q#4Wb)%s1%2KZe0!<#q+SWa5+F zFHAbiP5{nlQ~{f2e*lQXRMIh9wcamX-PlR5v*#Y*-MHQ&CON4OWI$CNa^^xMVRD4q z7+bV=IcJt#1OQ>UNdV@I&wuSH@p`p&?t(Fh4G{z5c;&eYvgPoX%RXHKGbn;Z)g2(% zwplCeqQvMEK{`r-#B#^o1$2-P8z~*LcyJagg<*;D`k~79=){ourC-!MG|4MlMp zha`+eWu(c|eKYFa@-Q9_itTO-4>7X&i8PL6m?a>SB;Eli*@yXg;Qu+4wqP+nwUr`&j{i(IR-V zS7!w}3^qaH9Za_3+VMq(@kicK5EM))q%1G~z22sf4G@Brj4M4c!33o}6#xw?%QPXK zqT9^p!)K$*p(jv=y_t0*yZpDmmB(2Xus|2{e3ezGUj}hiAt@T98cQ?U*=I$CtVRS# z5@Uah4yME2IH0O$j0kXX<+wWT4c@&`{PWk*S5p`GVhRV?XxG^HUe zRL+QujWv?`?#bI=5z02dMy|e=L>#teCTm0D)4JVcu;d0}-zIkd!DrY8QFbyX9EJ5R ziM6ZB0nUqG=(vIuN7;DM?vh0MezKkor;&mgVvd9}%1^x{>nR@CrQ?Zk)ekwid1nTZ7{u7y=4GfC@aUm)>0v1#1&_;gzeOg-UzlXmFBWARE zJziYX{QRS}f(Ljw*ntlqfs~#0f_H1~g_m@9SR^E;nVSj9TZU50HM+Q6*T%seA>>;F?LQpq6FHyZQIsr+qP}nwzb-}ZLhX%+qP}nefzxJ zoRjQ_{SPXsRO*`=15SL#$l@Xxq|ks8jnyyPc8$WcKlXXg0KWa!^#*`bjU=ogA)r=m zf8$3+(p{y59Oa3G9@E)TNQf97`_Ru~Js(==aXu)Oe{v-BnO!jl-~dkeH5NL9{D6RU zYij|={2Ggy+;*0ddI_wn65l!PxJ)US8D2uspO~6LLWYFI4|9aKLMT9m^YWg!*kDYJ z%UWZKLxygA4z{ou$@O53^yerc7&bdXlKggd9xoLHTRLD%Oky-Nb&ja}US4An27fl0 z)N(?ZlB8bQbdK> zpG;h@pM7|2pE6~uoh!DeSlI&@9Q=;0mM}En{d|wDvg3n~&i6>WvYoZky-%KObYr9z^)KqCz_XT1-`c?s;ey|@<#&tAdP0~!TXmNKmTK1*n(3{n3L_Aglg2~b7J3vn zP6$MoF3)57vGRw+t+Zj_T)f08vVisTctjk1y>EsfYlvVeYubB`qKscE@PN4?4?XVMI4r14|$53r8l}X7q)F~7EyKx&%i!|l?8s6%(bG{RAz=4GL0t^ zz*a`A{-fJBECn29u>MIKCO=xGSj+yd5V(Bm;mR>iSD3Nu=E!&T+DmHeX#fhlAF=It zB^VQ$)m9NZRL8IsUS$R9Uija9eFgAzfg6y0ppuv=p+=W@J<48%E4<)PZ^VXmHdSzF z*?35ix2P)16|@W^R7^)+|KmLUQ$bB(Af6T%5rdOx~>T@7lc5? zdwOMInWLLGb#hA^Go7;(yL{G}`QZjhK>8_y?h$=w`Zb?+{3(U0QS)KN*nx;i;RggF z_*+I7S-=YXWz&9ro$2n=@1o*AMg~J#!pXnUeK1I!v`vPlU@cq-CfK`fP)-zDMj>>R3W_Zh5c?AsVGjLo!BpCDQ_iI#d?`nbSlUtnHL z$*A;Ie&SwikKi6E_kO+n-)Er(=tDWksR&J!$^2%VTdlaR+c^Oh%n>YpkY?di44H=! zAd@zF?PCtVFEO#vp{V5CqTP1hS?8N=;pqp3A|0BxV0id>!TOIEv0R0BJsL=ur9%1h z-ci>X<*tf=etD8o)6CWT`_t@JJX`P7`_6*UifEMbLrIko8`%|J@65`y*7S7ez9=yI zF^jFDSU?~Zpg${Gt{KQOSe&h}%FBo#ye`zTaAzQ(*@;?FI|#S-9#pgvQJ*wmQdFv#3y8qTv9wra~Ou7@}pQSHk; zkR}6uj?&XOtBOAVMJ9Ey`+Tq9rBXA>N~BLA$3ILX41MRL?}h{p%ifmUxwT);r~F$& z=v7Z&O)1}%9|Hrnay;a{iKP)&_Qac^vw@|WM9UkATgM^?kI;iQ$z*#L-9Bn01seUzXASW?ZMQoT8iG)>3p-HAYQ{7S;qA6iV zJ{)2QW64zEEvAaH2B}Xm-$*6Ya_lByO5Y(eX-S~#IK3rZ%~eVc*#@Z8a+Lw0y_B2v zB|X!kyPqdUAzG{q0+ko)$X09JewqvwX0Z4`LH&8!>vKy@cd{;0M&T<1>X%n*+=$6~ zgvWRfSls(z>LTMM7t#<+6*>t89ie|uw#pthcyS?{d2!zxa>aVFb2q0zh#Wf!A_42~ zEFI3i!Lg(v+BV`gIJ2}pv!W*K0gxr9`q$Z}{oA!{;X=e$J_6Kt|1fb|6R;JLsXfT( zO<9fIwd*KSxHb$VtX@M0dK*y4ukjgI2r3#PYnW6c8uWd5b6wWPvLD-}8nLvevtZ(o zJAY#*15iLh4~wxm0^2s=A;zMpHo3+e*H|5ykASGr_IHWvE-J3f$d+8F&GG0AQt=&vIsjSS$V zP^U&omL$2gaD3<fTBEOSXy60^ik&8kTG zv!!E6GxOD~<7|EDB$H1p!pgJ|aQ!uAvJG1Ye!wcZA&QC(vL=GLde08cE_bv2X6NDz zOn5wDQJ7ky)$^d+7OqNGTZP(B-pnKifM8_YcEv8~$|M&BH*R)LAbL=-&x_r49 z_qkdI-?*|QYqK#AOgH3C$0;stCIBNepve7|K|N?o@@uB+EnG*~e3`3dc+P!0BYTIZF}h>%h$0E6M8Z(B8(9qh1CAmm<@XvG1yJITGdAkZX151j$iuXG%rQ#-bVJfzbr0$y51zJ>e8npAt@hD=SBLmm&}pg)+r4 z;R2T%5>EY>iOnDpEvv{dX$@>h1@Eo~_I^BVG+7UJ8cDG~Y1dn*a5J}QbZ_vMBz!K& zel}BK^d5P5Nk32ooGvpfh;p8Id(H5dF==EFRIIO0YL~?UOvKZ>)z3xwzL#$7Uj?bLWR zqO0#}Wrti{?s&_sZol%ucBM8$2%;%S4{I-3KpoFtNB5)RHr}SeTD3_}BBrxE<@b#l z6rb)uyGtUbhPAze9?EqR4Qjt+@hLTzG_-2%+u_=it^0#q8`^ zt0JZ>gcW*;kDY=SK`>8+8%US#Ce~4|bs>bQ4l(L+?pjJ$^w4@`$=%GjdxAn6zgfO>lTfM+D!JX|#g_8Ko%HuYLYR>K2O4F@fr!LQsz>SIpIQs8&I_uZNvPIf5(e2~eak8N^b|khkN3S;#;jO?Wxm-LMK`SH<#dr3`ouBWany zF?n;a;LiKjmt8j2O?4Z!4dqT^A`ZMKrEu1d4dAE=9W2*{NylH0E=IB92|$ezH51h( zD90pZ-?d3}=?q0!&z-KKxa+OP=@LT406DuRM67a#6^+=_UQ}*j_MxQYn7-Y0A_P(f!+Vn6?@?!%o#@Y}!0W5IPJ}2% zW9qYmmcv)G>%^r@jMdwH`svL&_CLO+NJaR67u#Xw!r$oBRb>^~SUkrNI+;WJDQe_& zEhfP(o~;#*4?@%dSnLLHLLSH4cYCja^+{8i)+?3mv-W7O#M&|nOadrKF9ZC{TWmYn z_cdIVZa>t8l^@IK@Gy79Wz25wYaM~$HUBXY8#oHPd1*|zE}5ydT`!P`Gz zS8wDa5m(}OM1wW!9l{|nXPGjwvO(5dDq8W$4`fp+x$(@ahwev_R=t0sCl{T*Jhqu; zl5PdKOGB3}@|nVz%9Q>?SAg0RY3_?-B#zZV$Q${ih(lkn8DATj-$6yfWrbzf*!$UU ztQ;c=OmgcZ2d@-7i-pc+59$4B0Rww`#Pi(g<;MRs#;l`^r+hUTMR1v%PsUFm(&A2Y zWZ*+@|Ka>JtL}-Bd=jJ$i-~Kd!FqG``DX!)5R@9iVyEw&vtF=1YMmvGD3@;WQ z&l6(=b|A@#ihK(FslTq6;fKwGA+h%vDxW`s;M%L*=N=K@(p@Ov8NoDjKM6>HG?6J; zF8(jM?9Q9%6?d9E_U^jMy-;fJRu(_%hpnU2KDRjUKMImflW8lUJa(le4W2CQQq)Oi z6-msX6_^?rk;_)Q75n~Wwh}%a8`frP^FhW?`=c&{LBtKMIy8-$jRE%# z+N?YWowW#(ZIxb{cU!|%SDjs3!vqYHeT%E3ZvH3@sZw*FvWi(d^!yooXp{It=eKKO zoWtacOiGggMn%2%S&%@}R6Dszn@?m6zGOYXLZ2g0*!dsZIql3IYbbQ$VD||I9Y2t0 z`-JZ4VH`<~_m#j;GB>$q4^o}sK|;*=QQm9Y+Ms*uq!>zGz6dI=CyOE*t_LEmc5zH) zZ>^p$2mTU5H{GW%fBbbZ8%0VJUoXk3z;3UI4)o(WBZDa=J;*9QLvef7>c41BxC8Bvn1Y#PyJD+1A!{ez~i^FPMB zS}{^+>Sn7P?%%wzdHvI?88%2VzCdhvO8!LCRCKh;ur0_5;a^6#u~q4?y{C(-R)X8k z-m{bt$Oo8QTr+HdspMot>YvhxdfK!TWI~C*8Xf%)eF9~k3>VFUaC3_v0;F#)l)c5f zJR(ra&IIWG8m$u4IW@Lu6tC<=IQtC5ZlHYG=d6w`T2T%~r)_VMnY1JQK8F+y2AUAy z5X-|g@zd(k3dYl{U!FoEXuK>|_9gRnN(0nu+55zfdTC#TSZ+__Xh)p(XhwoI+ZdJB z?j8nbqi=QZ&iIn|OcMVr!)!PZxbsofjA0fkk7IouH0^OMYX7}|C>%^!VnM=Ay8YPo zwS+SqXR?_xu+Cr3&VKdwAUW3el@43SPvJkMV2=OFgwDv!{(o+uhcq@~ep9gbjM`~D zP^Ip3@>Yicz(@xij$4-m_nLR@S8u!~5h+p`2}P_~e5{;`9=W3J^r(1NFW6wdrp}TJ zhfBG~-9-Scx!zlL*d|aH*4~|KpAt|t zZd|{PNkj}dMn&f;$W2IK=9Jkrb~bFcR7bik&+U3(doswg=u{i=BbR4j3!L%W4>Ti?hi=IeR3CrTX^*XNFQY=c)#hLQ+6 zD72^?Dz=H4&cE9p2s$|tn5$wLwNT6WJ}7JLl%6LhQ}rL^JA24el0OdA8{L|@&nB6T zfGa_InZXe#3eW490!9Ty0UAG{a^dye59?9-{3mN=73UqwX-dP83y8v;8+M6eB|#Bk zfY(XkRcXXt5OFUYs86OxIt2QtOV$Ze52nS1vnLQP*yI4540pdQV}6YAJ}5F2xOg1X zbts_QwKF~VdV97&lWqy5;O#^N2rIgnR|nCa7p4nwO(Lm82M2#_kb~c zz=P6=MQ346O{EUJWT!k9de z5PBD<(p3its6r-X@6*>U2bbV2Y+a%LNP@8&EW}42CVoIrWB(@2#1ZV(t&=1)Q1Bctj7+$6FX7gkb$Tj z)z#Nuy%r+R9=WIWCZDS2K>Z0&;&Cm#)2&m+&g%iq6#k~;8q_I{d|L-COrO}NxD1{b zA{u4cz`SHZcd=qE0U@(w$HPd$49*%8N*feIJ4YTSZ@=%;dmdcUITAro^mMiEG z#Fkku1jD7WHSLSI{L(tqMHLd`(l~U zskusyj6H=53F=Iu{3H}=lAiOkbuU!T>O%9&5#A9hzN_jz(MWuYW$LGb$u4Yje^Om= z=U$wx!h!ad*$UK$8%3{CYP=(f{{6>#2dNjD*acvO%)bRgMRn)gg^4Dg{ou2RVP=&F zAyS!aAUtp1x`H%4MB2~purNVKHn!D3zMt$aXtIB3?!kKn2C?v%==5R%2G}0y;dN`+ z7XGN+CXNMy#!MqHWTD}Q(jrf;4$PIdqjar-INd)DtI)@VmZ@&j3`9me21Ld^pcqF0 zc>Ova8gCk8Y9UV$05LhylEchL4e;nEDqMCd7s}<2!NLlLK2}irkt7h~%Ck~WfMv5# zFR*2Ozo5?O<(Act;Z?qhDP1a9xk#6&^A|z~0k_39;^&o6SJ0F9n}s+|jwB9WF;CZZV;#}b2R-SKc+ay@-DX%apjF-eG&-X(C(|yczLgEvN}N7!+4J#ssCc&sHM8A znbpO`Pxt$jQd{y(hu6cAF5qF27eBNgc2+|a&K)Ie5 z%SoyQ>lAXQ zH#7ATPTyY4jG@PSvs056AhGL1fOGELOk5O#&D=?e-e+R4ne(1L@Xih)5GTOEuy0L< zy&)LM$itp{2?mVg8Xh3|A%|o11fovsIuiRlj~Efaz}8Lv1VU^l zZzUpE^JE!b5%g_zX>n1f(X+em@ee$r)9+KNj+VFRg5j7H-%;R~gj};_prNR0>cr3o z1Sa1R@x2ZTi>KAm2f@8Cs%0XU?8nYKbGFy7derhRWu^n_+CI9Of{jn>JO}_=7C2o$ zPhIU|Cyq=r_!c@bBLED{enL%E3^>?1Fs=Np+FynHn?4=Kwj2t=&P1bO&bVpf6FO{y ziGkUgZpZnBgI0rLa)fm2R&6FnZYIY*O#%jT6`?(kFc+K?Fn4(FA*=>-ivnTraWS@R z#YW2tb}-?MT+QHR6ZleX*>_SV^*p)=a0~rlf=Dj*qCZu3Q!XPvL1kcC!N3%YZX|FL z$$+xFxdk3Y#O1PZQ1vn}wO`Zo!N%E^`S(9YzyHe2%*esQ^1mCPU79k98^efQCu+Az zKuX6L53r+TBXt!?>Iuj;34w*cDTA~I@q-xvf16ak@2+#`U`G2Aq=#tBB8chJ&d%Jw z-d&8$dL~b)Lw%i#F+XR_Cax}P*cxhl^_emf8R^b0k8MRGF^>vShAvH?2tI6ecpjg8 zx_7h8-j}=xf=0KurqLBm_*N#mGkx3NKBVO(P}Jzzcn73xt9`zJhsqq&Fv)aZ6`&Oo z0-%_ly>$jQHH~*{+n<-HUa}%!$IYP2_XKQl)jJ4?GC>Uj+LquuRK6HW4Ap8B8z4m- zMYdK+Su_AMPi%WbO`6uIU7u2Y>Z(3mxb*0=t9ZRZeE`6@m0w&eVaLhygV|1BTG(?Y z(@6J-Oj3zWD8A_%X5)S8;Va&+q2N&A%=>yRSQ-hoUo}IX} zh5CCxk=Vn_ImD7w^da0pW5TOa5(-!)fjBA2?r~zhpFHQ=t^dKuOj8C*Hs@m`B+PQJ zvuNjap%jr#OJM46eL5a#!xRa=yCKx>k*XH=pqx6|}-6=d@}DC(P29wwr^7eCy5em=qKq4^-Tq;L$)BU<$7 z=;5=rf-ajrZn8Y#f6H|rYp`@G?EqlmfNf&BMJ&99du@`O8opP;p#@P(-%{bdv}CSJ z5WaVu{985gedZ!52n<5Vjw=DBh~l#xt6}EII|;!UfU41Danh?Lhj+5GYm#!czRjrq z#U82*##{03A)+_|Y{`yz4#7*8wRdOBa@5m-S3+G9BymiwcCzm|`GWvh**bZf3OA&+ zN*eCRNSMan@k47tKzutd_RaR(y4B|BRJ}jhmZFcl^3UndD0v$(crnWMrrw7OkH4CV zCEMv-kdY%ToW=zF#>$sL?Awe#TJO7cJZD`PZ9&#w(gbM20G=th6Q3+0`Bm-iN_vJk z=j9;g;-@sN+@D4;yI-ku*iC_q^D4!N9=l=9WMERlFi2^_dDus)@lhHvoO zkl+`&NEP}ozcVy}81qdg8Ohi#5C$#OueUKbY;bF>_plrAOLBbFqr=ki}uP$$3{nNHSG$`d_<#gF4Z4?BPDeW)z7d<>6D*Ph#Ktc(!% zHTZVEoh5&{HVlW+D?VB%$42qq>^jacEKxWV>pzOkEs>sSlw1+}~=~Y?7P0_6gV*E~O7ZLKyj` zIAhTtgH$n@G}SJ%?}dh2%Qm=<=v-3?b0Fo%aDGPKXVOpts8F<%e(7vt-za==lOT?C z2zh{GKMGFIy-r5+7t=aiWq81=l7@x6{m#5)_e|oNi&2azZsq*LPv$A3i z#$F*V4h>Kb`kqVYM-mS0bZ8giXd7Tpz*rX>%U&ubpqjZCF;R0y= zK9avlN$b3WI+p&deDB^4kOt)Mx665|>Vh-Q4bsd1moh~13cN+w|JE4V4GidDEXWv0 zE?^#KR3Z_Sd_bHKiJlM!bUH^4QrW@p135a&aQ_bt`p(6};{J&LYPpObc|lPoUi;$0 zFi9dKE+-e3F8w{3OB2Y;8NOLli`CpJ+xSn0P{Lv=q#j&rG?x`t>WrnP;+mk&a39rvp*S*<^};=Cak3bQ@Kmt1VMaRU84&Ve|Ka#4*Rc@_!;hL zP00w&2@=uY6UMr@kV*DTKMQJ@q6YsG0TcUI3?tUCv(kZu65QqSca|TpK?5%FEWEoy zi2)(yJZyrjgC>BUQ#LyfYS_DC<%|}Fosjus#@-ULoJz4huVGMl18%$<-%YQP!x9WC zgNv-c@wDAL6b3e55xdWN*6JpM8k&tX2;x~*MV>J60{9;YRPPwPYu7A0&N96oKlDDi z7H@MVb4_nNs&j-|F{6ou`mL%sJJ8s}=_?JUQi=;pX>Rft?|n=j^E%8oRAyhDN_+K` z0g3neovG0no&(2iH0Ax}S6_vUc3H-3h7jFd@W0u9p}xUbxVwceeU3#m_gM@FXaz<0 z;^18qfnBy$P+)zSNK7 zxxy%Cy8-|~$Pf2Bn6(M-10YXsqhmKugPm6WAXt;EHJ2F1E&T?|gpdiK+L1&ZeV=A% z7{q;pOxk178=1LF+XA&JpoYv9q{R-N*ffahm~@E8b_2pzL{!~Z`9U)J(a=2P1bjmi z2dtH1KBpWb{xBt1mLZh5Yr_akp^1g?vz!hZ$_9~ZNvuoQbQ;PI5i~nQAK0WZGABV? zOdo=YRbg@fwTwTg)S^wd_0C(9n}?n2EALvVXSoHsDC9P0r&7UGrY!K{8VjnRMzX zaDzmQaLB%(Q#htBxzIe99@iXMl9QwmyRO&%)b@eR{If;vzR29Drt2uZ5ye!d5$IP5 z^~6hSqRQ5B2SZa??u{4S}R6rlc)}fv&E;a0z({XwFLP z)26ti8G-{(P|*-^xu224#i^-F{^>wT1{L%5I9mP?(1%>>G*A4CSFqclke`q zZf|vOt)r5*YxyyZ?uq$gBD=Jq{rLQR^(55Bkv7v=xs;s_r4oTlqGoMMFcFcwam2r$ zYYHOK2vtxQI`u*GCzpki>{hHPpNcrO*)0U8agqG-%W6qEE0s7 z`?(6f9o&E_p81iORgaJ$6zf8KK%0_?sD8TH-Q0=!L#@P?xyRGeW^39abW^~lF_uvz zea-Q8pO|jQPN}VM;-#U6uji%o_>sBB_w$IIvr#VfA0z#LC)s6XXZYWdeo6EHcXKK7 zff}Z|6S~|TU03{pYuNnB#saUvV+Ju9sNyvf>Uny7yvpB26&JGRV32_QVZ&Cg&lglm zWKqqYE+VQKU&Yio0)N&loz%bHET8UKwC18tr5Bc#rXtX&#>3Hu&MiL(_B1Q`biQ1M z*ooYy_iQ@f&$m9hq#%~vR>5~j}NS*%jX z0x?-kn8`pFDwNF?@yr-&>Xbt4KmH!wrX@BmV%2mrUOutLv;XY>@Y3deDCAVZ#J}XwX=|_!JG<&nk`b zX6iVWfA2E|G}1_$$U5AmQ!?9X1c!;aXs2M%MR1y4BRs@PK?}It;GY&9Wfgp!B2vy*eWrJqvE>`KWBj=PS`Wj z5*z(Aa@t)N6~JNLY**8+^{*S@V0*rMs=1c!N84)F@k418*^Ftr?k_%#eav|0!WY;* zAtOd6r>W=H4V2i1@DesKAv~?5VPFvw2zVYmvefv@?v;^|V;p1uz{^G{(=qG0gy6Sz zTzJe7K~N`7-CLJqz$@0-!*u;|Ke0PQ_;DyGD7Y!a^I~8&(C+~y72q(xYe0DhXD_@; z&)GTAu-@wLf$xMG^eFvrwUVmDP&OPs`5BlxVFCzO*sm20j$9Eso|EMv<`!3@zw%`L z(6cyD?P^DGnYdyDS>F{|RXz#3upzR?@#c(&tu(=77c>2@G(P9#q0ly~ zy{)N2#QNW0yaYyX==*F8?l*qDBW1)~&n5M=A9c5U92enY{h$T@Y*dsdA!KrCZiiD& z(9*vxhs^P*BnIF4MCoscOMd;VnIY-h&5i%Tn;MaMlCLB1X}W!8JQwIsu;6;Ao{3FX zRE2^PL(Uu%xSB)-Uh-j-uxH$DksL(cUXam7;qVvHuOvPfgd00GR)v&vEy^ryJkW8e zGjsPuzB|+UpWS<&iW;GrlOsEelGFQatsCr9hM_rV(Ce_2V#up5o`5mA@f& zwgDX}gN#UlE}+S%o)+Ta|4H3q&7j~XHHn``21$`*Jw3f5;Kx=H91>2?vB9RwL)gC2 z>U<~B%$8&^C@7)lD0(B#b12|HbTe$hTe()>P$9w}tu-;SXR*WUc$aro*hfQ|?`fSy z#hCMlR`?ivQ=Dwn_pB!jmlG%9Bd^(AdqZA|D};*I&IJ4~jK--K@jJlMElm(8j<4{J~uEOua2X%L5wU`Gs< zy4k8VqHT=&v+*+f%e8d2(aS(vYrn*qO z&-S!G@d=rZxj&V6etm#EG-E!9>Hd1pq+px!VAOf!QoV~PGgvJz_gLN5ik*>vLVX_k~*JdG_gL<^y@ zE7=u`F9;l{W$Z!U|MSrx_Vk=L&$OXCSyLSI6OR*;WhX zBcO{ZqxKb5u0h97HAvvyyYA?Ef}bRjs64balSnwJ-wMJiC+gU`MeD^mP%HHm{gZ>@ znMvOm4?zVH_A*3J$_MyC_7O~g1b~tL8G6*0<|{t`^+V{o0`=^rVv}d-v{6IZUk>j; z=9~Q#0C{3U6F^()P~ok7Rc|)yi4ILouk(t$%67;<%VuJubHS+IkX}p%gV7>0y-okY zNVkcJ5(ksE?a!4RZQzrH)T@5y+EBH9x!VROVPuw^>-vm}r?XMlq~yDP`AvljGdJ@s zcH6%cf@yiE&{z)Bmx(F5gO@2M?E702tIJz|it#)IsqCb%I21fce3pa52h?#-D&-g8 zQ5C6#LrvL=B4|TNv|U}V^$jX7JGouF{>P=7lJYfu&|WBuQH-0U0r@{Mf%!b0w%8^> zZ#?IJu`H*xc|ywsM>=?5y}MjeK)KL@B4Mr)A=S9RW`Ufe*^T@r)U^Q-4~@WweAh60 z%(V=E?kt~PcD}&HeVg+BV}SjyRJ05n|5pojq_Guy(2VGNqqo;R)*G?MR_56us#heK+^rsd@1~#+@b9&OQ@!dp372`WT zx!@MBCgR|HVCy_H)>(vp++I}mFFaL&TF|c_aB0gn(W_%dF56<6!iZYoX8Bi0`*!D( z4VC_B9Z{`gcjKe(Kp1C?WW4cLopke(4KExuSfCy?>$yTPhd`!P>*Je=6y`APk9EG= z{odJD$1NkCRj?X`!Y!+l-PPp4ob!iAwqo*S|N9sPh$vP=-mHvtfv{qEZQdw+=p#uu zQv6=9NH`A|7clriGNzPFz&n^FU%GNJL3C?dGBX9c`xsVC9eW2lJdCo%qVbw-eA;y=?7JEYU3Adnc$F{V@ z005yTuFnY8#HiPv8n;BBwB~0$4kFdwRR^5Ky%-v}aM~h}d+bH;bGXahlI=YY=|-|7 z;Z_qo(6S6R-Jox?^@`^h%jH*s2#x@#K^V5N!5pnM$P<$eIN%ODUELW zF9O-7#(9;3FB{Ipz-8v0B{(~f{4DPH7Lkf9{Xbd8uEJ>F5u~-EEn4=!ARmgFk$;K}2 zkR(%t5k^LVg4&21*w48!zOQIA6gZQuq`SjI7~K{dNc-*AwhyP11?0=SL$QCY0Cs9F z>bt>Oa({Gh1DA1};59TFeJpFQ2QkxSqR)FE?a$ZZrWtK-N@7oWAGWa$h~7SgwBQ-E zX-96o7hMpJn6165-zys_$ytJl7{!kb*HPssk!#KXm48E2`gv2~q30+j#>jqDYMbsfo&$>YDwvpTKc5r(Z=Qhht)3#x$17Q7O(e|?`*6oxjo zzcEYp#r1+7&IH~qMS4zF(EnVmV2;bu8OSmiuli?qI$(r}10<9+usr}kJJj49Hv=O) z6xZD6_nY$9jj-lo2$)iWHP2hF_4%(M-HCCyNfQJRlh~Pft;)dnv*Jx3}+Bg#;Pu+cTg#vAbngs&*%%^%Didm3-k;h4-vM zIF{~My*&&AXRK?SE0N|tuK8fLv(Cc!N;!VuL8eh+z~D!ah8O<=Ei+4=k%u+N-H#5J z{!e?{KC+bTODvW?^m>AzFRoa~BDd-9k?&@F6f1^*jmYT~@fg*-!T$W*&Yonn(x$ZB zcI*yC)eG#>~u(_~f)K;`9P;r!Lyz9Lt{?ZWz-DE5yA6 z)fT{YFomW+TGECipr;mg89#v%38p3O@FD2uQS?7s(5XfkK- zD=W?wJ#@ZJ&kZzI<@LmR=1Wk7dIn4@g_xR!&%7RMagKF%?`r}$jQOH*UHxPJu%`Ol45CFi?vl($KZo}?Y z#ZCrX5h(iGv`y1dYUi|jicewTMi{hhSd08;vQh<=^;Z(|gXIjM6oyE>7gl@}4kz?b z$UOHX2H%lg&H7MPn)yTDlHeM0;2PNfn9j@_f}@(C(T8J~ZlY7d0oB zUnnwp?a59jWXieEEpDVrdEO@1qn{d2@t#gcScfy8QKgT28`m!_nLezz!uwMO=ebH> zB(4aR8FxfCt9x)z6rR8!ZBUJSw3O+*Zf%{H^n8Mw2!g!)hkrUF{eP!=q^JKsbLOF6 zPS?gLs?SZ0{7xxr*3o9D?xVrR7ELob5cPgDd^q$hk_mFWaB$(iOFZ5VlbS9!5r=?3 zp{RKLKswXOefABGbMb`w!*e0`atUw4 zMOL|)1MmDGW7L|y!RLi3n>HJnI-c-|(u_ngExoDvshVT?Egu(m!=~E;{$;8T3roF! zy4S298VqPBaIS+kvnb7T6@gCaSWf$+kBz~ckbVy`O{*-i;}jaW6h%tQAm!h<|SS=N=o%j z&@2+uigF-~w`?ju9VVPmp#s-DvbpVv$I91`AWY2OFSEpBo(ShHjh~M|IteSX3!sdq zv1CES{n*w7-fbQmKq#1$xi|1`oBd0tgA`>iD8lo4kjJ~IUOVh~a7c7c6(k5~^E7@F z-saPS-0R5BNctE2ikD9ooI*?efPn#Np+|PQw zD(Y%Xdz+9hLqM3nc$BgZL4rI#+QtHB6W~?PcciHA=t#3J=Z`3}!hWv5TE9lf4E75g zynm405sR~qtvSGoZ)TQjyA2j zduFVf9Scelln0D#e^QtNv=n1E*p#eChn1EB_9pQd-oeO$%zV^OCo8VWGz5!f>~Z*7 zhKzKA0zAj#E$T8bb&T z;to@d>#o&oSNSx(S;s(O;QTfjd&eWzAUZANT-0D~&|NTMYVYeC(eiZC+Q1#bC=(~w zGJT*s>Ea6g$g#I}2Ts){27%ugT0d;jN0?D6-_EqJw%XsuYz;~~$d$!=@d(iTg_ZVR zZ}`?5ze$?^_;oTI%Ib94ur49&{Eo!pB1Oh~Y_^9~ELp1WhhwB*^Unk@Zen2LPUTi6yKbKt*=i+b>>~qNkD|IBjBrG}Z1LvpD zkE`WoMzdyxV;o2G4YVUmlST3H7dwPf5~AdIrSgh-8?gr%KO5)R4rK2z4D z0|>3v z`ZM8m`h^^StQ?*3)C2qca(ym(TNl(EU@qq}cCemf$v%3mQW?{Lq}*H-|Fl!ZMIXzl zfBMN0fdA<^x?4EQubpJ}(eAQz@p@{w(}1~CA(BYwx6%dN3j#Wn1Sl&&7xF*#!XKn| z?P-4oMj1X&R&a2jj3AJTpQwYz^&gvj(Hp8eAq;fKM5{qwD;?;4?tY7v=}>)np=Exw zoqVE{HIo$P=r#lmE{to?=^~U9Y)?BL0|A6%zj%c_?7!wnc{XOeO5S826X~!IhEm#$ z)k>p(LBFH?{tL(C;Wmviu^liX+CV4@;(79}&d0~$EqnsHnB+5HSMX@9NQh%FWYiFP zRAvtpXmt6Ho&b=JM7MviE%e;@=hC+@PVX8KXqu95_RI43P#vWL_k zfjS37ZF+y}GqFyYS0Lq%talR^%dl`!`BHG*CY=~@d<)SL>9EQz*k0p3<>FgaauleS zZDuJBBIH2P2RzZnEVn#E?hbEjkB+$i$JjXpc@l72zHGD0wr$(CZQHiHY}>ZYF5AYx zTwTWWi

    YEEwcB2OL`LWX3W=I4SC% zB80A&UAqZ7@dg`Vv$HDmL~1ix$Xa!2w$^ z$Qnd(T7hDI=DeJ%JbSKP-FY__3X$Fb9T-9t%u#&*1QgxmFdmb_24>Sy-&nY4o!@(^ zv-F5xSv-|ACQ=z^uqQ9%JdBX1KG}_l|g{mya6h*X%cjIGaXR;CGvT0 zOCA3)-Bz}n=iLXaulz{h1@dFY^)=X&g&>$g;q$dATB1Drvubc(lt<@WyH;!G>`kXM zc%8>?4ex@CZ+cuNPDb7ry;xl8`p`=NBPepWBB>Sy-Y&_<8@{O+M8<$i6O*=o>+JwH z>w+5M-ey*+?~=9V3Iz7TlY_B{*Rgbwa(U zNo%LTg%!%P$(A-(f{&ayt*V3UDPj}J>obDyq4B}bHH|m1z7YWJCN&E0;JW6=3 zc{ykQIiJus@5!H2V4;<&k^LUtAkh#OSHP_MB=bX~4n6>;0M|9>{kk*B^THoZ!e#I) z%*}z7KLAS^NBRr&ZtWEoX-pUdb{K zVc-Jouj1`G0abgDfX&%(M~J+1i497@?0Ik&r29zzGWEj{!)3=C&Q$p{H@|H6v1@im z#eJ{&+$*Fk_AZe}>X$`dFkibeT8$WT|^`l$U4X=htNS69$sTe^rqG zi5CT6X8Vuq!=Z-ckAsQ!e`#$s7)FYE`zA2X23e&Br~ozx&u~YB%UT%$V%3BQyaN6% zJB+zPo;uQDNkuR=+6a6fyZ5c3gX*S9=={)YDr~&aq>7*r?(2CH8 z635h>yuLY(M5Y9CzOs}B5>gQI>+Sp{dbKKG&BFJ*d_XJdNDr{{IL z@9hj{nqsORO`3l##Z1;X7bvR3&_e{9(6b(u>U2m%9VyNaAOC8)ndqWR`z5%)Rb8+J zch2&8<0z0r?2wY6Ko4!~U(=sYGM%iXz{c*OJ?9i#oDErN>w|Id-9nN{Kw;Bf^HrK< z7LsR93{y}EbDruhXwvN3LlBVPD-n-5Ml|g0{=GArndHNr4>2UQua;@l{5)(37h;Ys zRO59%&ns_(Wy(LnIpjf%W!X}A0p*L_LG@qQ!9(T+4wrh{!h*uu14oUGm-rttRnr&rM))o9X2zyvo8;k=U_=YFf=Lc; zUVM=##Ns^1l5DuzX=5z-4IK_A$A2TGFTZFzd#FtXhgf_30-?mUxLL0K)6jP~BsNHB ziS$>JENak&W#*Br_RdA>?V+b7)*AVGx(o#Vd^gO}rTlWr81izne@;*g`1UyZLj3`t z44;gY#Iib4akmN5Iwuuk;akt6{V(oz<^^n`xND^ms>wX}GHw=^tx@g*+fy3o)&l^H3JFdg+5*P3{46&_ z7RBgJ7Hjs4x=*tELoAQ=Gc0Y=^E%0uoVVX?!}!FbBR7#otLb=J8*{*enOT4etXO0($mGFTCP_H;U$|%BwPSbjdPH$r6p?B$puhN=wJyC-pXf_0%%xkOpK5Cw4lCe)1a{USIibRLDx}s|k zF6#3DO7yxQw2)CM9MWW8t#<*8N{Ryf{?Ns+z-xWIxL9br$Z>9`364ClHL-~vZAMXi ztu6BeE(HLvJTGw0jv-h(A|zlo*ork!gU4MCkY;DYEgxJNR%T7Q^dl`5ygI985nVU2 znl?ymG-=dGzcA9o)YTD=0GFw|aKddwH#Rh;A)lWNWKaC~Zu!gOVf@)v4y6iWNK8^5 zc2^!oCxf`b^HK0F_QbuO-cnzATFqS($({67S+?1L(3Cp(d#ycmWG43?PBx?e#P;@p z4*7t2SK4$zQlRTX&L3Nz6(0C#A3m%6B9*B2A-R>V0RC!mzjI1LH`WsD&-KotE+79ZVfK_@&tTXt^y!asxF~ zK~tS(in(F%QE!>DhU&#A8l#V0%XuIUkE@Y=BU{6GGj3JTiLW137zf=tsIH>E`4JQT zX?ujKzbA+o^j^3ZPH*-DvX#9+{ju6;=V~B z@Pbj+nIk$N=xOW0HWo$GvdhL3Z0}0bSW>M=lACLxL3f~t!iO?%vm;tQ*@~I|jFq{6;qYPAb0w${1ne)wp@&e9RAKzr3`d!_ZlP`J9qD+GHCY`3-pUzrx zl#@3noL=bG`#&xp<(cKc5@h;7jzoV@Ti$O8@I}Wms3P`&ad&@~UDqq(_j>D$c6WNp z=^N#MTca!el>Ss!F`XOie3_Q#K3djH(K1z%>k^kAIXM$z6c$5YVL(P?ef4M@scA*S z{$YG+QIP~mdc>$ zD&&a2{|-aNAje7S`3;-6QJJ8irl4ZJyInR1WANR=cV&06Cn;GW@Q*T}FmPRW)7ht; zYV;-ocu{nY^Q7!kCCM2dl%E+llj3qhT~>XoJv^Ee=3hs(23Rjx2nU;e=W@fcBW>bn zO&;__K(A(8Lr+rS0Tvf#?_uPHyA;VxhPk5}S^1wdSNSXCE7+I@dg6Kie6)BF2}&wT zDG|_YQq6fj01J|-M0ALnNn`n$wr}&P-DE-!3^fvPq$k8uxrzD@J9kawnb<1BxD&zX zLKcN@jZ%WRt<#-Toe9)1B-d`smaprm44q~eVb6vi+@u0_a`KS7njLtNvFzZ4f~ zP5hlA3j>EOFD?e{aN%137wv@qY!;_Vuc_P zF_h_GBeKq>Nf3Ho8xJWl8RGDaao+ky$XV%9SA3Nz8i=Exf7L6Grr8R0mceMJZJzeCE|S4N`mqJf0foA9S2~r#CyHN1JQOB-YhKso>_2VK}bQ^tsgs-2KPhw z+GL_Iuryw5CIZ&^q+;sYuER}iaXEZZ2?}u!mYFamnE{J|kg2Bu!8ql^7AI)rEJ+Bp zL!tX)8b(%El!aON1pqMY!g-Kf_MjaJH@3ep7?Dn^W{tLO;c?=evTp&r65IZ%+vGI0 zy_T{2Q};<6(SLl?-Emwv<3Z2??$z_Fc$uruHWdEAKXDGNtF2$(bjK=Y1b*~rXcpt` z7^Ny1kXd*IjJ;p040&~aIhH0f>93NjVC%#G%t_X(li)+jx z^H*(Gw^Bl4F_T5* z0v@o75#ElBfV}HhfZmQQ5WN$(2`gU>G08H7S@ZplKuP2n{Z4Wr^0I+NvQL_*I%|}e zbDqet1cbW$$PnKTZI3Ah@D==`s04^%(v&GA<&=9yec>PlmiMO$z6T#Kj;p^wz({~4 z|EpyGZxwBOuk#Dw>o}oISE72 zx_4Qz-(pxwMH5%c-G}I@k=xhbe-*{zk>KRcH@kgbmfuBtvBuABZ7})0Uz&Bjwy#~i zOO{Q(oVfYcHwoTE1x>m|5>&-M#94JOe-QdeXaUYS#m*Vc; z=kk)?J&ym=L^GkfTf-~cBS9|>?*#GfczAC*eUjWFLqZX6@%{IlPBoo#HtXoiIEND! z@_M?c)1K3bFjoQ|RDr)#fUKZ!6JI#-I>vR+KRM$INkqN@ZK!c{`KP2=YQ<7XOd^1~ zstOR0FXc`Wa^!9UfPe9Fz78A;Jd6~a zGhV*ZUy`$5)@In{(4~v*O~Hmb@3XXvoLRAP#cAibLysGHEBO8YG4@VDq6F&`=h(K* zGq!Epwr$TD+qP}nwr$(yo`1w{#NLSeaG(3Jy6em8%KW8?D$rjwf@Y3ZUCfWvxSzx{ zg>Z})eg>^L-e5Lx-VBaNnoQJwf0Cl%^gl<(B~FPD8kEyr^%u1^xlDpTc`(M`gcX2s15TxK`?Wc^ z5&6wnv%sGRHUJ}K_^uS|i5i5}J(+E}01hIKu#l-4xF)E`yl1>KBg}(Ao&iZI(dO{~ z%o?<38SOtaP<+m_Tjos$GvP*Ez?~G|A*Xb8kO5*A%;D4IyJkq>sY)nIV5Mp%g=4`B zl3{I~k-sUNOp8^w6c;0uxqQ~+ZiZHSedq1=Y^3ro`1ec(Z$}u~ohFN>A|>zX zFzH*js+xo776#VBI#>8?x)q|nT07a&W9nN(1I@0GbT(gbom#G8jkLH;y#6@jvIk7j z9y?b6C=|JwzBYKxrGrc*)D;w9_N9+w2t*|BxdyXK>whf!aP|S{cFcG5m>peRp#1}h zF-82P&)qMiN$0cy7K-MP(8I0jbNd~f>7Iw+6Zy8>w?m!=TN za<}%&HWK7X%$HE}86s(L%CZ3LD1Q$DB`t%qmG)F1;*O3P#{-yChD@MHTJ4P2b0q%u z+lDY1MMO=E;kuQTG#}V=7%>zy@*7zVT2ZlCs4w>S3I&&wuGoo?l*L4q#w2m2qPNrZ z4<~6D6cGqc;W<=78wute2i|ff@W?*wKM-6>A!mXh#!LSF+W)mMhINN0*0nX zbxk`@T!vMz9C{~=1}R#r%5dFujb&;~L%Fb&HLDd;Qk5sNcI^nvfQ`PMa#j;8RLcK# zvDz*y>x(;!-6!MRpxL%~a@r2KRcAVD<=#>%eFmV6@!`43Uo`iZT>(N33z3D*o)xb< z>?NRYvTl7TIL?Od)_`|Sw4lsr*cqT06aMi{Tz~?=PQ57Nn{Fb<6PGDTz^o$1va%gt zYP+M1K2XDb4-P#sJPCEqu%u495?Ann1v+7`W>^bh=*1EdKL)lCh1Ku9=JGNFf%GgZ zd!0dJOI1J@kb(Z1G;qG?bN^{@xm?*ze?|{<^vsq1_o;+hjhPfv9@Z}??pXd9dVM1q~mU9WA)+z>IkmV{-U(-Alt zT1(O?5Tc@VZj8AAub%2`rhBYv8%}*?AOLh{3fPf3Oln&Y`n1;KZ_=~LD#-Lt9rN&Y zS!dpJZDNj$T#k@G;f(vI%1Ok~FMSp*J9WHduJBG@&6#hYFd-V;*zImItYaRIx)ff6 z_f6*OtlxY`V%Kc1eSKzQ4_}TJNeG|MdORe^T!CfIq@z4O;3l3`4f7j_;a4G$K&=4` zkHhT8=3Z_yft+4%9!Y~mgVd0L0&W?;bRIG8T6^(V7ZjMx?DRd;6jP^)Qzi=xZ#Y9L zUzzWmez4+?jb)!`9Us9qvlr;+1iC34&^YZTSA)IuMPb<+Exj&iE$6wVcnEBnfmda- z3ozLWU4=Gkh9TYbeEp#jzJdwL#*>95oyudW6$K3VQ5Hi{nFAzFu@{{{FVj54q|ql! z5Vlg#Ee$3G_P7kh>f5Fw%I_Mg=PNm9NX-LRv7LtjT*6B+v`(ZlKrlUxI-o784Bq7b z7hz!&U#Z^WAU$mOyhqy~z)MVREi^tl$!(>N8rbk22)TtDeeVInGvrqgj z7`TH-w>?!Pj}8c0{r-3WlRr$NrH~+9Vo|YkR86nvM{y^LKH`&=n)TMOyxNHN3|3^5szs-R>|^#C}{QH3O)M~oWaCK|J>@KBV;HZ?_%X5 zYwu@ukaNBJd|-0$>glk{(Ph!uar!xL1?|KcypoXj&W5u|IKOc7y75X5EIO4xl8+95 z-IwK^4&gs+R|?4GoX)DTW%F^&(BYU-I#WKCdh#eJq|Lt5$iMD?&xYKLeqOEie!)xS z`MLf#Rl@kcAvrkM|07d9t+5%iDT?GXs|EpqAU{?%-P71Dr&|jy?vJtdtpB)o4=i>O z4*>;MGZm&$&shmh~9busWHHK;-4eNu54(lS1{@EYtbr z{P-v+FM*;)4+xhu(big9LwPYNz+DQ+|6H*_FWV>IgndvEjveSV(sp^l?yOj57 zMw9W;a^S%m(GxCPB2gov%xQ%)^dTPs@C#=WeJvXuN~^EJ{~oUXY!#9oj~bUX88~PX z(@B-l@(3S?S1c8)_NHy@Rys2|*e6DZWNQDK2_@r@`3AP(IOyDvZHY z03&r#*&_!`2lIA#EqPT^Xng=TE>WAl9&j-`5kE>I6F35n?vVt{DgH=euu z4e}v@0)&jpt=SfQHQR4MIb=23rgFsgPGDdp*(`VSLjHPkgwNRpX^113lelk#yA)kS zgYK-W0MBdjJ@iAb?IZR!Ys22p^KO+ht)(2d5c0k+h#+IJ@!K+vm|(AMARS>{yHF{o z5T(zH^}h0%O$=IlEEq<7gTLfX!gLwY?CNTTm6qgw*+(8TR89lZ_rtrQ(-MLRX9?_j ztobGO$3X4oRt$QtYl8d+q=gfK;}Ry2llesZM&!6uNJ=X;Ry|5So`?Clg%TdTl~&aB zx`y|f?FW0vR?Frf)zKYtosJ%j?Wjrgn~P6loy)pLO2o<8Sko5k`x zn_V1Dt zdXe#mHds^!?|_6)|1Nsq7Nk4CV8jaVH{RVz_~JcMc3^?C&VVOT$KtS%9}gVcTW&dA zAj_2UhcRUbCS0+p#VC0K?H_u=DT$j&(mO3~@H9r;EiXQD&pw&{A7$2zLrl2o=2rg> zX0nm#(dt?Y^ZwV%O=|dNml%{ze>C%uwka68m+wujR=9a3kz&N}wZ^ieI&%50QHA%L z%Z-jSXED(@4nF1W@*#9OoZa_xzJE9-gd?p|(6G|OP4{M*!wu{<8Q>H}5OtWGoBRIb zY-18eB6qs889aJ^Wm7fZl%V_@**_^6T`JsndNIZG>q3ja}v>jiqb&FuG484xMW3*f(V%8 z!SE}dUtR01F0nW)u~|9~YXBHRRSI*b`mJO!u1u+n$|Q>_lIdh6yVbFzMR{^*oCcWq z6V)>1Ng4EL==Z;NyXqQs)Eaa8$HifN6sM9InAzvkOCsCoA&w;pfZa@2T^$upGzWBA z1>4O4*Z7Vn^Lv2^T z%ktt(e@+Z-vO0Z~M0}J~;B-_tnpBS2o>YF0in6S#md@y(B}A3v#BJj#Eab5L9VEOm zf=jm}5{C3g=?i*}wXL3MMkXeslF>1tO}Z&cxVy71s~1KVNc8iDZ!~V;U8?rVe|Zao zE=n~ukjmzE%^yR#S{_;4-5TFs|9OUP$Dc_5s~Gs704t2l^bG&`i()tSum#cgR?px` zLR3{dfr#|NpLdI;`z7GTpLw%uh%&FaSr@S7Xfd|C+bX`7hY3e9rOWvW6po|HJR$?r zH|yOrM8jJ%3^eq2h$!(cmTu*9xU+Nk+N&KQ>-b-jduM1cJ#>7XcKY!4NvgP+_xt5G zJaoEviV385bfX>L&yxWrxdamGa|oEc-SENL1x`FRxNG1r07%W}mW(WQymkZ@)w&vW~AG0VKnYMq7$#NGN8MiQJ%BwXi4%M2I$gAIKPt*c*HrV@ z$WkaeD&P)G)HA%gYy}+^Q)2wlF3BL`#%PLkC&s)19T<&FVZsaO0#x^Tm0C@=ui%CB z66Sv9VIy2+=7B!{*qJ&(dNa;c5Cg~73Y@PrQupiqLrZ?AT=sYlpda5%E>N8E*8{G| zOivlz%ps(kk)VR>lCJvBNW<*UAY|e4rDFylSDra7^DVTM_lLxlmPe5uhHD#&Oc&i- z`RvuC6zv<7t)B7WerpeEsDIu-LT`8tFqJrMc@G4ksm_&XJLF$10Cv*tsqe`()4J+6 zW_y`$5ZsdlSS0u4gwBQoQ!FjZh1%IH4(S|p5RPatj4$PmuZtR!a-z`tKn?0A-n ziUsmG%oMgcijpZ2Gxa0gEDqGH=Y(?=FN@19JBcGODjm3e;#%lc2eg^9HVD3!UyIw=Zz%N%1oeBJP zu&3I{iFyoj^$Br7H9d1aQLLZKG9iP`y@{fH;O281slz4Ia~Y`=&*C_mKke-Vk$S$8 zJyafJcGDJJ?HIep4D^Q$ieJ@4d16w}n_jj(nO*0~I0}HI^hb08kXP)=8F|6R`n4Je zV{S|jsVBwG{fx8#`OHEcGd7~jA4rFZ4)V?o$1LQ}xv(x#6d(UAmM%09P6^^nkSwp~+uUg_P$cQw)bXdd?DX%f-H+lBM_tL36io_C;Td9tCuh7Qlq zK^3K^htBnWQITr%MZN22DKCZ^3zieD9Dk1+ zMZB#wJ^wE=&KPL8fhegOSr$qK82-_yrFqU2X5|>w3`W#ihCV{RXt} zSTv&U1LfOY5BL4WHhVX+83m6EZH&}uZ43|%D!qoZ?fxO#Bg_Ua2SUS6WJWe(CySYb z#``JMP~_6AtUVT&aB|ITeg#TX`ptrbH-!*7^tUJoy{5Gp*Z(u?DdmUQ-X=rk8BI8O&h;b%jh4x#d16ko*u+t&lD%IkiGeH$* z9geL>sZGdb1v7)`eDV^RJ}zt}ChI}zE-(#kwFpU}EIkfkbqj&C{&45!J3H(b(1iZ$ zqd*(oF=3)8c6rI@@5t>Pn?fvTX zu8@QxJW5v{gy^L9&V|3{bzEVMvvk~&)T!TS_35Jt-z(0~Lv{(*{)-=FhRcJ3(asb;fTpF7Qd$e9h=Kvi^fHFn2_g9%%u zwAZ(+((@LI`2d&YiBVf;pJU11fzYUj2hEVduDo_jNQDv3lbzUUHOFSwAuE^wy?L7* zeRr_#m^p5PvR?YUm?hTvkY8F}-;+!3HM}rH{<%xLj|H9ZT=3RS*trVpfRYkPhLzEu zF4Ee~{=tlb-M6JDIXDGANrZ2Eh7O9Hq1B1Y?rqxXSbQI}K+Viy7M>HDJPfORjm>d=rCn*;f@C-*ue*r@2{S=aj7FT0#OkzkfMGV!|n{}*b_|7ZUgL;Pp%hTu@R4>RSHxG{vk)Q5G42Lys~3`g=ORzRvpqD)L0 zb@l(gF2ATaF>>&33A1+gnJ`lt;qCLN&PIS?IGxW5HqGL1nMnOh-TiR#C9z( ziB<8-qqNb$33sL4$T2@YjU<1GPTc<%V_BBB#Kx9ql117d(x~;=m_i_vHR(`?ZJb&5 zlCbW6Q<33%2~B{oQMi>VP~jp%eNKUp@%b8=bmcB4AFM8luU|5)2O5MHLgPgJtf1Yn zGxk`36KiARop&~?lSE_DIle~c@)aDsx1eu}APx781v;qEapGoWf3B~16;GIN(IyvM z?JF#gFEBvLb(^;}ulvh$k&s&xJI^voy)Z!B*!*H66WqLn&6^FSTiBJ z7LcL8g}y|>CLu!|oq=b)xDyYF2fu7?7M7PH2NVG4J(yO;p28xzvI{z$ivbb-yZ&`k z52Y#JPDsbj`iUUKULoyXVx{_;p6LF%AOJ#IU*CLQIot5L^Px3%iibjNL zm_Gx&)#YP>%Y6mxi3m59eC<;2o*Pe*qnjuZ_KZYg(o%yA95Vk0yr2k@v$ z!u9K?R81YykQJ^1Qp}wAP571loa!gA6v^UMNU?CjNcps$ z)gOT>p_GI?$uY$?HVr5>xReIn8oA%F^TqG}O2)DymGcPXSTd2^FR-ctCoUS=qgy2F zt@*?+T_{(#yu8NIFmTXN*g5VY|NKX;v|W5C)8%Iy7c!!?`S`On|2hlVQ=|9fvQr}k zcxOgYg=LU1VLXoE)4If9Z*FE>Tz4dPOOxVJ3wpOd}>2 zXdoi!w7J}OCQ5O50I(_(Wu$Lu@4z!m(t|kv`R1*OLNk(%xDYeO)iD#yud664vAxh; z*QY1RzsZVYZ;wR+;_Am4C8r~V21L^ObaNWiS^da@xWLBW0ll8twy8adc=`)*y*RvZD*DQ{R2>g2ftD$6Mjt-m1oE#oSRVJBEpJ#tg-J zmMBki6h%TS4f&!5n)yZba$KO02#!0H;)BajX0;4fH4(0U9LXpO{%Tu9=(FstV&C2$ zq^?H9f4M0V`=nby7P3I??UR*itmdzGfXJ+drkU)aA3z8du}(dHRMVJ&w3sr90f5p@ z5fNb$^R0Z*4;Y`TF1WB%|0V}y2M5jYu-GA69=nI60UF}veeOM-n7%%OcI5mqR?Xi&FzN zxte8;#K(kGm|+EasxGg|(;u+#(PRXBenL@%4L9C$=Ma+|&!{j-L$n8uj{#~g zN{aO~X}h9a3Rnhs1_i`oRpSCxR^%v>2U`i>PflIxjA2}qf3(o5MK5etkAroaYQTxk z+u_%@5K&<>Nz;A3aUx6%w#2!?N)Dh$P@eowQBD_c7Ddz?bKFcX}q*mpk9uhfhs%cZ$XsLJ!Q(;7lHtMD9*!(gj{Ms3tHmLe^}@kLC^; zj=jxJ&odm<+gsow5)+0)*#9-PN5U3YygXHAz?@zR+#m^VoD4hm2RB|t)SR(bp*3jS zsCo+9_A(38@y5sL#>WBMG2huaKgqy!#Ql#PI0&b&AxOpy;+b-C1f5kdOMRUqme*Mv zty*VWr=$m5;RRI`XKN82bvZDGN^g`xaR{x#BwMCDEF!B&IY}s6zSzZ&Dchj}t025@6gxb!f>F(>`6W zx6bmSCx@r@^RzM9&rI;AI6aKY}!fv^w-ERtUYWRM=I~c?b$_SZ4QdMvz{9> z&W(VnJ~FVJJGZ8uEW8vkfv2!JIRbCC|5nA$fWm7H9N=$3=dhk9Y7dwlyHPS+XtS~I zpum)ZD_*6r9wgN-fGG?;z3&3a57thT!^Q&3Wc zsPc`!t8_1{Z`BL>?`2@zFXBdH0H@c{ZWI6(v1l1YDd9zFk%sLb^w>8kh56*|N1KWX zfMz%UjmjG~Pc1P&hm3$!Ph!`n;6ctu0Vt9g7+O*j@9Ow>E7-I!8j#8W?CktX0^0~W zE(2H~=-vAdTcfob)xr&(nJj`bwbl7>2P&;YuXWa<54zXL-rw`yPLA-F|0b=N{x`N3 z2it$-=B72Z{x65_yIV_Nhwc%HvP0>5?N4hJ0w>hkqM>)dO%Y=WT}Qf_unF?{$kint z&peSjA`yxPX(SQ4`|eJQPZ`S_eFxFc$DIK3Q#kL;@o{YE>?tdXAp%9o-SNgga1XI4 zUhnSg;Dl)}F`|av8w)`ipM;XLlH23``18zOlmsT>YXsig{k{n|6LH)y_M8UlXM8;2 z`(ecZCxIi)Hpz^SjHx_gDGm{1*e{w-5FfC+;jXeKb~nLmc*D(eY7>XTLE?5}ISPt8 zEZL4d6Y)h>$;f}iFsLzv>E^ccA>EH)@P)6Hk3hsOwW6YFDq(w1Yl$x9qXBlC;GMD| zH7qtc%1Ofpeab0HZJ0IaFPdi5dwEjJ^?4cG{C6)Qr#nQ7E2mOCmU=7qdrN+AeJ4-G zV$$y%l~U6F`VphVCC_f~h!t3mUJ%08CGRjh&+jb%r4NMyNt_*p??eAV9BDnEoWY%^ zgb1i1_M+YlEy`FJV?CJNw!~q6npmB2bVb)VofNLs6Xr61bX3O}SHYlrOh25z<`y{} z&pS#q3@^ZzKBGUO0G#W?HF2v7Sj-M3$`>g57CC~m1}$EEM;~M0AoFa zNDkj}79Y)$;p+(u3j|_YMsbV0+$?lXT>k#(ej~2|S}Y&xJmSs$+Ui!tJ#i+%w#b(9 zD6Ki-ls8^;v^@BQB>J`|I!K+ex%fVO^cX6WcW(}E2<(W?%%_FIuKt-l`gWfdI~fg+ zMY2r9JqYUO%THxyORg)Kfp$1Q>bW{@g=Un>hU>~5*Ajg_5Gw)xM#z)W&YV zr|i=ydz!IxGlZMIQ-tf1tXF~@qLJH03~Z5zZc#3iIk%)ZlIXRM?V@1@S5J93KI%9h zO-uPHIELFA_{uR#gq;ljykaoRU~8t|=jF%;os0LM5Dyrh;h8?HEo0c4qwk_lEBu7> zj@u(#uqJ|caMHH{t4A`ge|5Y9l%cx$JIdf5od+imT7&3x&7EnpQe&n60B<^b)uu;b z5%;f9?U}KD)bIoNZ800RrgUXoGB>C>=392Qp4UjYBLJvm4tMbUy}c>azt%SK*fKt4 zHpk;T2%G>#sB9o$1Ds4i5lDfMTt1J?=r!r=EoK@^Bv1C5*vL+TEM%yz9d@jqTf$Ve zr+b9{vWeolYFCb&^MQRIFemC80VQOAAEAdY69l78KoL?hNSRtyaIIYsWtgEP;X$3K zioI}112&q%$Y-b&jh4SQVQas+mrUT@LT8RcmF!}2%&#%vJ*~za zZzU@k;mu%bbAF!eQ3k|A(H~_m)m0;(sT&3m-h5H#%(vHdKtq-6$K$Rw>bze@=>Wz| z%rTftC+|;<4&BSAWqee8AF&e*{rD0&Ww%O(Q35)jJ?Hj{(`x6J-E&C@L*}N&w+ZBE zL)FQODR_Vbouv$-UFup`fLazX9igSr7R^^n_{RcA+RrK`{iI~9 z>lFFXrcoIEepA#<4NW>^5r=MRyiXw4^(eeCdh2@oNCPI3_)EoDl%%V4A0c9C53z;0 zlG>!qWy^TX^OD=i?Yst;Q27h`jis zjd(bD7I&Tbly&Q!jRYGB5W}GQ#;%!)cgE_5b9*##npNf43EN`wILd%Y*r7lz@wVCQ#f_VwFw9cP8Xj=Q5NluiHzdNly3RNqeoGAk&T78Mll8 z?3*_@p1tx&G>1yt%~0J2kG|o8__r*a)Xm@trbHZh_hkU*;xEhYIISc(VAi0aSO_>U z%)J}%?9l?$%g+zwW1QD)U3&g zV7a4NLW8?)YRJF^T6Lzpzb&N{^9y$wJec6smTbfpyg13NE_ z(nN1!`h_H6yj=dGV}X-QYsY7*vhfy+bJ%=Q$*Mvcj@{z5QO|1Vg{`~a&^yx!tN(TK z|8K-LX14!mr&<12FYx~o+qB9HwywsBJtQ+R%n?B-^#5J5A!uq!2~#EzmamC^9&$B; z4<}Qu@&gwI!#KHda6L}fGc`u>icuHb87YkH$BJeOJuSLC9YlylB?O>Rcl1Q7<1q+8 zrHid@!r#w+HekE-N(Lb?9MY+UCo%f^aaXyc?N%YZ)qWa0-+!!%Gm0q22LNo9F&e1q zX)_#&{pE3#<5nSpPGGVy_tQfqqP;BieP6hSM3|>Az_dmRX|u+OhLWcmKyhoR6jHkk zv>kD*+8|rMuq{@v%A}$G3&b6J*|Ppu_D|$$Qn_ofxps_Hg9cexS`ty@pL%X`#@WK4 zQxci#?VU4&MK#`zsq{Tpq$8eL4Dsdd+T_zJXms-x-J}&el z0_EIzT2www^u{oBuUM3SfjFLkR@h)$F^O^D^rjw_d>BvAgwF$I+=|L}r; zy6i`$V6Hbmk$5O6O6)TWxe&-B34> zN;6;PaBa3=_;TW1yLXfW8L(sts|bp$uL{{fg$baCye7hhFw%^Z>7i`Bbl|HKRXE&p ztK4AwI%r03w=eq{u3R`Ss^gq-1Z_2bU8=@o*q3>2HV%wFbSbvC8h;Y@x*(Y?xCy;{8sXI(iuCfNbX zb`R=vFL4BY4zFPuYA0xG{B3ze;c>3}%NMf!uFd8sJf)Fo;O&7}I?~))UviGWc zcvw}RhgWCSqs0?jP0eYj>EH;|Y2S^N{F zX-(|LL2_0>?HDr>lEVF@$KI3Ts^cag8%y!UZk`V9Q-B;gD7X8PX~g`PQd9!Z$9sVK z;L*-?^rF)&Qv>LxAp^_o?d4WdezZx6O7}XL?YF;;Z|bZ!#T%#gl%Yosx#k4v&=BgJ z_oJT#?g$Cg#~GXx;uRbp9(#*JM| zp-z~zUt5N=<ftpdW(&ohYD8I*BuH#eKG-;In(;sOTFk(qw5>KS9yU#Ax-& z(@XTU3?mGL%TNRmFjBKN&>5KUYHHlEfThHB>VM{6*ajT}OEx!ON^!C%Fx6%3iJ)#@ z40d0P47EM;r~gRndUPlRaZ?ZOgg5~40nUhXl;raeP1PY{ej#ko@==?i97h!iV{v`i z2X8;suj>cAwHo>d7(18Nt0P^bK^@t!G zsShn6ToqHi+5K%+kk^F@v;%md##9hh#?sc*d+j9NLR1YHCN5cm(Tp**TAXke<8z_D za8&dtl8^f%BB_4i@@rKe=jb`k{B?DscJ!{X0EM(b>)Ae?aku6o=BQ6 zE@8TH;rDp1-`7CCuX^0@qhI<$d%3f|0TI}Jj>-9YKH@uIacOC^D@a7oqIi;KEr$$o zh${@1G&f(x|GQ{+rC%`dl>zm-ff1nM{e4z(!ExvoEDyZ}w|dy=!-8r>thU+zg)Q=} z4`|JzY;NHxN5X*4*I0fJU=uXkV;EG5B$y~Wqjv>rFjlhCfJ6PO^9<^7F(OO#+Ew8y zwtBahRYwhtg+B6YJOMVcd3n})`vXQwck1&)xm4@K??Mc_Azsf1F(0i+1ocDus_PuNQl& zYLm3wa;yrJQ%oy|Dw^s>8h!neFQ1jVum9)=I29q3Pm$by33(6~l~?+*LmonkN7KxF z9HOtGxl(S*`EHu3*+|3)siY2}#Z*BLTHCEGeZF+#T^5MP=TZJ1Kq8x%lq>Qdn&-{4G|rAZu)l#W@5- zZm`d?lXVD_G+5X|DP=zKO&O^Y7hqRhgY#m*6l6gWSVWyaKuicgkadfyxyjC6Y2dO{8rZ899v884hM z>5V`Mm{KUM?2nDnDd`NDKsCU-{H>(5(4zRQWqKR-Gg;zA@%r!9(bl!7V-pdEbFQef zg!BNArK9YdYeW^C4(y1gE(6Wp0Ge*#8JGy9*niu0m7sK1#Yax(P-d_wB`hZ8+~xTC zeG&CaqXqoLg*x6S++HG9>I?0kzkL6Z-$)0cR75YI7oMa37TMW0{u#J(3BZ~q5u(xO z0`ArjYzh^_?5cJznP5z4Do!-^>mYdPP0R9t&FRYglw(wpU$NJj-!uFVF^w#E(N~p! zk#DvCQv$VZ6(H#Am8{jp=S5F-AOh~Dw--vT-V69OsqCyLbmig8n5y&&y+HZ5hx7@za$>-TevOnWA&3GNtunx*TSEG{F$n=%Z%j2}HfIeprGjK*7833a_Vt}S9iwGLy<36bM@tGdn zXabxtsqEKcp_o}L!Xx{a_iOQQR10C1qj5n`Q2{I5m@*Dy|Cc|{6(Vl~Fz6-tMxLHoI zoJ5<_u+yP9;Ja9Sz~9%ujvqi}2zYOz70O{2{Z^1{9SQ&+o}y)gI&*lUUh)9vi~&>T z{@ti$5-qAeEvlDD)VG&VUomsgWfGK3F&pH8NvpwTQttc;+;dT{@n`eF#?FW}a0oKp zMhb%nK=2Xn8h}`nCH%uic*&hRXED(^UTg2-^^t{O?z63F0tS2;SSkcHq@bR*M!OSY zn{`0-$S4?I`4QI2*Su;@hseq-K9AGmp8*gv?S(aaIsg|%Ze{Z>FcaK@4yG6A9}vUo z#B;J1rSMaYRYn9bGy2G`G6u*pmht-jfjnZE5L~HD2r;sjVNJ9CIbR@#JB8#|m#C-` zw248Gysc3=Bb}yfC{UAKD{%@SYR^ zLbD8Kf%9toxtYn=^+rM8I6Tkwtp~T1FM)pnKM5%+J>&+&Mq3m5L3XqaP6#A|N@-&l zc!8iA)9eNrX?*~Xp^4_m5;iEb6&c}Dh24z~Cor`G>LIl~2L<03z-+Zg`StjNY4_|2 zVvtZ>9y5193C>pClTQXWS~~pBXbw}Le1IZ%QB92(fvs!*#gJuL-div zYJexyfbc9thxK{8i@9>ai(4}%&?kXaOM_`D*(U$i1vEwvkCS_%-61lxRht6oS7E0Cl6QfpA}eA6qG|6 z_9NDeQVI^Pjm*=>3_SvftFn6##t67Vzc8+>>eB9mZ@5hy>KKZ4f6XB@Q>uzP1*eUXgFJ! zU%TISRBn0t`etz){B{DdtuNk%&~X=z3hlb!?!Cvvczuv-WONxW62Ez+jR=<3m?`u+!q3D`ChxfEg7!t#Sh1P8a^-Nj>3W8+IjFZEYOSX7M3AFRTvXo zTG#^ZQ+|NnhafR`IWRM=fjNidob!qHocgAiq2uF!1fstt-4DfQe1cn!R2UOL`9tgJ zH;WNEC2)52PvrIfobWAos0jTxIm-OM(fm06lO{j?f8pU4q<`UIdilJ#K-595;iq!) zQb5hUBKGlvuB#IPD<-Rd#@veq)4z|0TtbR1SMr^*h}IFX)*2*cA^5%R_6=`7{b(pZ zYXkOgV(69I2YRcKsdjGx3Wnt-k(aU1s?`5TJ!p}a&oVEbN;h7sv`&P=BX5-^w8c|9 zaGj)V>)VW>a;vVB@T+?;-izPzMU0yfYKUq@anuH?z4D+rF0_ zYPAPQ3@qZ}1#KEfQ+PsD#9c8Gw^Cxm|N+!(S$5*cDtf3AvZ3gDC9aA~<*PpAc`iTk3 z@_5Xr`UeL0lr2>V!UF?YQi@@So5`E6DoUwZ?83y2uPS^=ZwC;sh@7<{ZvnIGbI-9ICybV?F7{ld>(M&Q)$MLA&gTCeJCkN6VEp7(a?1=B6iB2_4 zso*q_M*B(Cc&o}1z)*&f@k!5hosS=h1HuB*grWvIYx>(y4x^O&g2)orCJUq(ibLff zUt!@_e9PZpY!QEgZ~}5zfDg+ER(@&pny{z4}z*1;{e%`mcY3bxg(TH zm_2W`^Je8XYd8?ZW|7Sj7ib{=HA;kdUfWV8Hfxm@NywC$9vTz{X%LOvXWBUZ?nBWx zlWnHH(qbZ@04|;#j)c?E-!N>JG!*Eljo0Oco6MRlq14^Hw)i12NL4Y&X}m7aIQ_Yj zm|AO0PnNO`Qz&!;ecOT6LU$w*=K1|L-AwXv_vYJj;SpZ%>8fl&6=uxlAy^T-)2K?X z*Bx&K%_ z7p=XO%*&OhydN1yhop4PqAHjOV(rlQdc=?UPaS5d7hgsu10{x_Ob`9x6g8T_wt zhIG!DwfcDd`AE=IURI>sH&`SnVPDvW!9im1ERot_9dsdhMc*W|N?N}D!dO7VKYU2d znNS&@qlk1n5a&V|aOnE6F=B?FEEVNv&x!MrkOe=)2p?07N8Cux?3LC#x zQ^CI`##=DbPYVsR@S7yZ$|}nhAio*9uBJRg&DsR^8u$s}gYmLf_wK`NE(GT{L|eI% zT4V55sI+eb)wUJbqnm5BUewlUgR0$h7^p439%2aYaPgt9r2c!C#4PBsBH6*7^SQh2 zuLy(ni{WGo+oyd61i1WhsYXWdgOWASshpo)QI((jL#ahkeqHcmXuU@~x<66KSzO*; z1Vgi}9JB=NA)C*H)Laz2AkOJo^b3Jm%{jA6Mm{h0AdqZ@k9C&dZuR@Pa)XBPWWDbI z5frUeJ5hsR%4`rRaPGSX;%gpS2YI_f3aXFj?Ydkpm@?UB!X_#GuRDb9JyWSO~2%@C(2JFOKQMW z%`roxko31d^rn`CWyKXGYET}F zn0pJCfFK?<9%p8 zaaHcmP;$1CTdXx32RcPxz<#NrvjrbD-F+p}aXkXqdNA2(OP!(t6;XFk1^!0Vv@d-2 zR^FuB<-Z=eBzuShO|z(N#3fex%!uR_y<2O`G&9(UkVm*ysJmfU0!kT${#mSQ0F8tr zDQ+WT5TzL9_@{scGz&DjNnexyoVYB*N=B1?XTW!Q<*3Lbr2HxVBt1>JpPcqX+$cWK zsm#cTfnBW8X&lC!%va&V{EA7A5oOS(N&aO@Y=8y9>a55+OiuE$Ry@v{Z2bRAl2jvLA#_%+Q0fO2vWADU&xP%#Xw@JWt1NS-oy?tta z=pkO2t!EViR03~6U1|Byk4W4Hj%iDLm{>>5Uh-#l|BqoskBS)^$wubtBJ>(Z+M6w! zG{s6A;_gW=hW)_oYUHo)EBXv{E|DPKHL0&&@K4L#xdAFkl zlhYb^#nelJlfT(Q%%8?1LA$BX_X|!!0#%2zrIGdjVeFr}L<_bqN;GZT_D5v;Z~j2&cpc;E5@1;WA=`XL(nLlJ>hyy{`Q9uG6Y@%C73U3l5GrL zb!>=K211l$TEd}8I!qQqh+}1JX`d5Sa(Y|)D@k57UJ+)ySuVHh7ax(rFg#zN@j4J& z>-!RV@?@f<`aHRiJK=JX+g)agxpd~$!mt!o(dej5M;mS&;@@JN4XeeNLoCyJAVLuk zdwO$m<}HAj$Sr_@?D}LMML{U;5N~u)eKDavJ+IAjGv4m8($impV3aU$#XS}#m{9NM z;-_-`>M7lAE6rs_T9S$(ss__iv32|<9k!SvF-0vJXGhWs5*=cB zWrG~dq^c)oqc0-qag@vQ#}r6(z6NxGVmnhl{1HAq3tR=UNK%90$8(9!a%PbNn*1X}(i8EdspCign4&4qrdC)Tbo|t5WAR!< z3UP|DM&*6HG8vI9uH>1IXuCoMHyRwUXJG;58SuCkE&6V(e9OA!VxBr@FahuosCA(y zAlBIb-xCS8DMv$?CzwBXsX1Qj@I>s8Nk`5g-i9NafXXfo+t~pFABY4<7?O+?8lpZL zB!wbWQqlyGL4oElpi>zjo-?CehH=1s(jaDlUBXx*#yF(VJ|hx_YC~07hxv=#u>Y7`PPPMWvtyMN7+nvzT;%{1lG_x z`BjT?%b&}@=OpfXskZhf74)pc66>~qL7$e~@8%&dyq0_O#N74c|qIz}qaD=l~m?{Tw1t#V*9>?ftb#k&*_3bFq>w$f^{ z@I@skAu2zoJ^K1!-SJFQEv;P2eN`bU~|**39PcB(WnMIoVZQ zOgO{R|E-)Xt#7|9jg1n-Zvb}`CFQ!Tir6qY^gXCVQ@YdJ=eGfJMb+1|v%b^Jj6K*y z_cPDM1yMpMdlTbH$|n47)4PVvQEPqVmg(}jO_Kj4m0{u|!p+4Uu*wp_ew65W6$wx9 zT#|lsm&eHjA1Z1ni>j=gMw@#>gQ`rR#z>2iglg!WR*t0TM!|a|J}bpIP|f> z>U=7Dk;dLz5OP8d?tvZB72v?31M|f$_sf4^!KLN8(>-svRpnw(_vhhvpX97+)6Lvjp90-qeK<4Uzo_8gNhW2b16 z&XEy;fEMWSEn>W(#WXet7<>88YL6lMt@OXHE=4++?}`rQ9!U@Px^8cDU z|0`eeKkQ}yH*X#=qxhVtDhmph6WDmUrjV}+q-)NkrX zNtUj*aj9)cg3mpGsw5=YVpgYb->CP?w_?3%JuU{Az=A5I@h3}tdrG(Yk&qwrpo zFPxd2sHZ?c9mEbXoTyug-2%7AU&Kys7KaQ%?OxC8pXm=F29x7zJ^AM*mR~CVOv_b!qgdHKKyv7d>nWSqbq5cK^3{p474G|rTy-ns;PTsPb}BAm z5=F5SCc%@u%^aMqEa6^i(2c%?19$s(<<6YVSg++#DSjgYQT`Dzj|AqZHOj+{{WO1j zI*^3)a>hY9<(`Wer~Y5m=Xb;M^p5W3hs$H5xO>JrI$i=hQGeKqw}s1lb8ppLM-nrc zJRuO^`JrT7P~I_FXUJ@EhX*vPLGqVgSpk5x*d$wSpJ70Qp>yrR2F7JS;Gpl09Wgci zO+yldKfB6|iEPk;+)`^B;AraAo*R}ZiuGgxhLCce!eoX}3jHATdsT13h~E)C(u_$A zKPhCD$Ct$pP|TFKPvcrsHFi%IByuXdP*&lCRWc0a{SRSfUlLy?2SS!#t(M56r}gc| z#g2AWC&&VKCTOCe@L?iMv1*zxO`82BDQL@`JC-Mdz%4Q19dv@VG{$jnsk201PPO`R zrgB0o@(o#Xp(F+Gs#XLN`kHhKm4d49J-wCdFu8NEOy&CL+OpV3ag*+3E<^TE6IPK1 zrL>cOMT2sr^~zrlmPutW6hC-|>qOZXAx2{%f$_k}Y@2nVEsSvQad|+?V#3((ck>Lb z<`8wD^+pU&SBubhtuU>7U`cgSA|J20wQ*w^d)7xR^FzY=D=>2 zm1EUY6mb4H@6CeuVLUsVpm5}>j8j(Ot4KGn^v_xgmODUMF(cm9uDpe?=7T6kB7!MI zqNzm7XM2k*U+T_4Ib9>yw3tVAoG+BBOths?5jjMFt$u23tutLU9$bg&8zg=482Xdw z!{l&x0y3Js@(fS@B#yjs@~`E=yz-Zj_)$M>Fk9xfqfsVsSH5lBe;CakfN*TBW37ua zz3N}sx7}Z*DEKL2B5E*^duJRTw}}eCW7@Ke&6CMAeb+OgILnvt&8ee0sZG%HQ6y5< zr@0rFmI)r>s4>_t37v;9``?@jUgq=lT}SMImUErTh1t_I*#f74UYM}O3IalSjs-E~ z@MQrsOb2+x&RI#3O$_X1mA7ZJvE6p;Zm?fwX=H*9;@g}tV_R=IxZ35&_5w-8mrqndJG(!Wd=}2ac803R~K5DzCeC*bnkCCmmy(^U}gDTbg)q z7|v>5D&yrV_Up17HUVaxv0jYxAe?NOWd@rYmlZf#fqXslEPqBnUpKBF6GdcnaM9Vf`_V>z6+=;$Prsd6N zp_VRVr(E#9PF582Fts3UI^yXn-nBt@BMr!F!}{{>$6l3>MX?-u1)qc(U4y~5 z8lpK@6XN%Dg6f6sXwYNrbhHWtCP)LE(%Ovq?t@(oFKbDr3ol)`l5bgAD*?!9RhCIY zjCRd@Y^;NrbUDskWv8XH=g!+xlJSfsa%^ci1Sb?d6;o4S;8l=Cb;=CKOh236Ha??e zHsCc*gVJhsUFn=YvQH#y)Tx^z?j$r%ZLe@Jb>S&19l7zo9CBg=A+S`_lShw$&dQrd z^R$6$i0}_Q*uAO2UkA&Fwm)G3cXz9Qz0T>fLKU9=*Tnvx@RAHH4F8eXzfNe|ga029 z8sb!>zXqe5^4hv1)*zCVzuuhA9xh^%M9_LH`A|>uam1D4T)_Q|eXXPyEf_d7Wh{Mf zl5J;_{hfyhF$6vQcUZ(h-8k)tJiX+Jh7iTFMAF_ACW(X)$}pW9dS^tVlB%Kg3H!zM zQ-YOVEv%g2^N~;*QcqVlX?pp7M{0JK|0>%5S>pYuHUBE1t+R`mBO||-l_6E^SEOVp z6(|ZhCEG+X_quL#$2YiIKxJoJX>2RK7Hs)EXS}6I1vDxl^rhbevw5DtDT)|b%gr;| zF=J?GDJb@-Bj?Yw+znakTdP}4*a<#?rHRHLtH^DU1okyOlWB|mOv4b*|CnV5R9tTo z!B+sPBCuALKW|u8j)K_svCpUbLMIjBT=(4Kd5(HwNnDj{roI?!E~|KKbufJW&LHCU z<3Yk%_Y|OM2n-#wA?_&qyc`lXzv5@rWo#a&_Gv5EY<10vwp$w0%luX)pb|qCJqFwH zYa7e^E(k1pe;ysyJ3!@gR#SYG!Y}UY}Q}rOLnsF2@I_Q zgkzij9RxTCM^3X{waX^KkhPPXB+*hqq?peseVKXEXZi!A;z+Eu%35ryblT%r_nOE^ zG|Y-lk828CYsi;gqtd#|Qs~#I`SOAwyB+$5`r|U{TVQiB@w*O47y(QP4x6(q9~Glq z$c>i@38G>wEN(}$V>t(t|m=-r0b%( zGvKgs@zymvyTks{X8`=_T-oO>Uy}V{h3+)&-K$BOK7mRH2tDABx3FTIOc=GK;V%aR864fJGRv04LpwEvhHy=P1PTE0_Cs^ zZ9kl|g#H*6tPse=kH*0-qwldFNY+(rk3V6Py8+G=cWO`N<gheJBRw)>Ep~Mm-}`c z%D3K|=ZCU-^>Tx6C4%i4+g@)KVl8BVj1#%4EYf95;CXo(z+q)S)ADBf9Av-I(V_oQ z^W#6m%;wxMRoUMv^c4N^-2T&ieGR6*P(Hkw`qb?lJ4ODwxsD&V&fp{dV64#Xa(I)l zF;?H1W-AjnXs0K*Vk0mj|b~vN~kKCWIofM@1<&PY?JTY=GqEZHsST1W4c(5L`RM=%lL&B9D~$) zyq`Onzyy&x-lV#Gd>2~Jp(@JPhSDwGH!<0i= z#x(pMl_HWzoAoR6Nq~k-5C$5>Dg$p7T@{A6w7Q^vIw|H*z6>juv6q&yDeN42NhpoF z!)IQ7GW`IQd6Jfmmoxa-BcHl0DrCW;s2&|-#qr0~0h=LbkCyS>o~!qz&<$Vm1j>X+ z9FW~eN%U)TGD=eSK7DzFfuhXMx9zE|P6dA>Hff0B$!ZI@j*esl0zECe82y1g8%o z`HKHyQxQ808R!heYQbY<^EeEJ3HOs`z52}pxtcq?t#b=IEQn0~HdD}N;|ONFw*tX4 z8?P$!--GaQK}if35mGV%F6i1|VE^)|3><|2h4W!sPllIa!D)6;zJiGhfuO1po1YYK zkL&u{#A4h^iuQFoxzwZ6>njU7&Dk`RNw?VA3rz#!ht5FRr2abo()=j@CpSHgiv&I^ z&ZUNPM1YUi^IE!-x>a)-XRemhU6~QOZX&D05eI*pRJrI;hxH?f`Xo-PSGDR4HUX&1 zOZ!zaVy)5+X!>wH=SLF9_Nb$?CbBhXMpUH3D9NF0t+ebdU8EdzFVXRDEyie!#2+|d z3q(I6IuSq$F4TvXEle|~bgT8@)mji`c)I&4fBW4PZvu5jsV)T^JtsmVUz=)~5X5k+0S>A7jkL^PFHD9ZCxiU?lkx)?< zCo+ZuOPHfY6U#`NYde@mcp0XGy}mA|kbg)RP52Pmym5{vj`xA`6rkSB!A}Sq&tYcS zV_@9`8jhRHk4z8XR+FS*>r@j?f$@4qo?b+7NRM&+C@{*gKi$s2$Ak9n==oG|_ln`~ckZ>Ye| zV9D9wi?O8;U7J2l=|tERM)v6>A_SH=K@PNVqHut{bVjf7_Jf;bdEXMI7IG=-*kp1c zKpUu+@<2u5Kq1>NJvU(xd#4>2F4euI zVqberXBQ>{v6uxP`DN$H7LY)U*<;6(e{+JW_5~(C-CR)?(e0eHXb8u_dIHOCK?xXZ z!WJ<{mT-u7`#np>FZ8nPB2Db-vp4egY*8tLXA`>q1u!!t_?8#bY{K+j87cz}bH)JzJ{f4|kCYmhbAB4V^EmCicBxs03&a%4 zNgt}b(0ZNqP90kZs>$8H4OAebt9e3RVI2CSqR+@ys6(lATJ08KD~G(3KH0f;;KtMm zWkL~w9?BIW1wM7rPq>QOU&qfoCNVEsa%;=owKfG=fX0~&j1W<1(Flfpn`2)eStQbA zy*|paZ9yLhH+XOuYXH>kRQ*w1`M|HLgDq9?kw%5n10QepLi3?eQgV$yAHR&bH#Eox z=np_`R1rIOCy&SiM>9j9&F{3k{^eiHcBcA|8yrq4u|aPE)D0bKmtcxNuYI?8Sc@6X zhYNAQ?$_M&Z-dp4ecEpfL(d>e%(t{YHY1g$=8lsKr=8403Ph)~m6IDSwR9y!Qf91- zQz=Ocl1p?-LcpOjt8d)~cI`;%s0Q8Zi(dO_x9AUWF3wVo>dw0<&GUntimk2;%jnvI z!!0RAlGxje@z%)9gkCalpIpcpYv?pV=dR@z%|N_*KMjil=g&@Wp>w%S$J5SoH?v(T z3cCN?f%d#AAn^D2k#lcaq(5ms>S6DMuKOEd>GU*dhtvwbB$vrg*3Z+>v#Y;(S_zDE zu-U9`JNJ>Tu-W5@v}1Yxl);-yJI%&k@s`jL`;dul*5jGj6XWv=##!mcA>Yp{o&L7X z>VM7S|Bb-M!TKMy^Dd1o+h4HDZ|$5gj}8UF=Gk)$#l3YxI|4-{g4N~&p%g%di4ib- zQ9=0<L};_017mqF4Y zqhV=j1$E-Dbext+W#z_9`1tAj#FFk`EjxoKKiz|^Twb5|I@w?ZiMh@8pi=7o~ zB`g1=__5M-}7;gCEMC~Vtm zHZRVK-jx|$JJw`bitJ{Cr{NNJW*d1y7fm|_rC_9O7~9)&Jg`54=1#^VC~2npBT%Gq)P?UK@>4$);}twW+DebjF<=H@t%^n$Hxoz@1>*1{$){AbTVXL`<}BlGee|2 zf~THnn*(xvLrST=@Sh^Xac#RAI;xc)Rue?)dH~OTsM3!7T zqRwa_rC%AO;E+)2Q4alANfQ8h{U>$nB`N4NYD!7Z&}i@$Jdm3KC0HRO4Jm=7aDWV6 zuD#Z}#SsG{cEr;GRhj(7RYjEs zqTp~SfIy=`kl=x02(}2q6`KD{xuyi*N*x8-wdJbh^!(e#HB2+?k32=|3x#<`K^ABQM}3DyVG6W+kqV}CuU8LFzK{_>5U6h;^{LUsI3MPfKDGpms?KFxS;)rQ zFO?upJEJ16B)3KCyRzP=;&q0o(WuxBR6qMWTG07c$n~C1sd~RzF*qc;NNe{^4fVT_ z+fqUJSNWu`-rnkt6JOF^CTr*Vo$Zy4>JCrCtzqOCwiwC@PzLH;ke#6~L)T%lI4ulZ z>Th!NI2!uRt(7!ZtBw=i8cHP^c?;HZ*T?mi9h()O9rYF8GS@&I5IL8p<7qNq*E8nb zex9M2xl;+h9$iyAA9UpKBa#)l6cQ0NGexWJ1@%q;{Hl<1c@4getCl6;PomP(vBxZO zQ@F|Z=gy~*L0npLE!|D$NbbzV1vKZA#PBBp9ycZ4mp<;b{P)<hR zbXi!%8q|2k+}7D-RDttEh&niZ7JJIqCOC+1nDMcrUDx95CxAX|Iv%aG)|j9vMQ`+Y?rm=()3*r|g(m!BsOE(2W8dhB6{`TAlIvesKxlB>e}* z1K=#duHZrL=Q?sf1=)YnQA}+{1P@?Y1C$^)v&H-Rz1WQ&K6kr{GqH^gv})AT?b5x7 zGwII7ikW>vYokKy>}{*thLh+R4?FO(o54^sd1-U>KI^W|O3QyOavSNB-65Rke@Ip& zN)l{W;pp_>(5(EcgoI$<(l^|W+p3+#PgJNuF|ta-;(#_uKo7X5Hpx9{_Wf=0{O8_4 zrX)?_bNTm$21w*@v@_60mF(?;HTD^Z4ee==-~uAj>{Nj4svE%2D@S$~9vJVSGZNlO zj4}{Owj_0F;A_)~ml8{IE)VEhr(~m2xM;FlR&DRbr54BHw7~`|_KI>yi7^<8b0%|i9+{eMBC45-rpCTnqY#x(CK>aOE zlc3v*BW0Op^k>0=!7FrC&mt=wOZ^SD2wLEE?T4ao7_WQrq1}}e+i3ROgL|PuJZftd z69jxRpT9Q&xA=x^M;jWHFHTg#5diR1swo8tF49I@>H=vpNP}92ffQJU_gL6la1bhn} z;cuP@d&yAm%A;KlxLP-vPx@LAkt5M~&e1uTEFMIBUjWPb$F?#Hs^7Q78mNi>TV4Xsh=JKQ-Z}7 znrbtLHf^SV4|M>>*K3!yB1~gpB-|XH>?S=hnSbf;W$@aB)9`|kSNYl2(B&HsE6O=W zJVY3omyU4O09I63Mq5Jc!>WH zAaA|u?>zGs@mrSqyfxY8*#6dO!mYm2u9qR>wU-z=o^ui}7U7}RbFPCT;^u&R`J6Cl z$HNuU@#HqME8IFGSRxlD#O6`^p9^N?1#h18uG z;V#@qxi>;(ecT~-*Bsj(CXqk-`ZwNT+;bMRgvjBIj}$AEQ> zi-jMLkeq#h%IDoF3`yNbnnaquy~rG$4Gp^iPEL*@=X#xz0spJ}R-=&#Cj5K&h?}fi z``7np;0Mr~H21&SzgYe!Vj}}92jhPb8~@)TAH7~&XxN@gQG02PrQdaa@46nHGd@bD zJ;-VT@t8H#<;cx#i8x&Hs&*(^y;b~)*U5MMn71Gj%+LR+lt;!aQa^pNwRGl!{!i6O zveNQ@D&?|Wsx}>8$(_yQ51p3CD25cIcZ+!Y>4lfjt$^`IllVT}Etkld6<@L}h@=J_ zl(c9;#E*+3REB%{Ft+)II;sOu#h{HQTm0YVer1Ph?I#*5*dRNSG8txkUHlsCgfibH zdU_uB&_wV~QY_mYjxt#oW2wFxbG&qUAR{#~#D=qaOt)mjXudz?^(}mi>5HUu8=|Z6UtJPm+ER8f{ z3o9Enm>LrxpwHSv>fR@*((8m`NlH5la8DX^40}yFGfTd*pX*d)(nPeuy0?&$Zx5gZ zgVbB8*tm%l5C)(x*x$ZxhWdDGBGO3ybrf$%)GlCEiP_J4b-`uxL~@y$FYZm&8U>PyaM_BneVpG4VCQ(bq4J=Xn*qCoOb9iU$5xdaJHGVUUQT?;Jk}UTAlKKo6jHD$gal-T!Bkkb6zeZ|W{k?y$W8m`R7fCTWDYWoLMp{V z1>iRerW{ur2N+7o-;9R_M-74cC()kK8N!W(VPHFJ6gP_}5+{slV(n~{&K!qBT7SWRn1L%Hu`fw5 ztARLS`|NwW?WHf?-+w$~Wa9R=vJ~dpP`7P{atrG&tFI5`lnlMEw8!5p58q5T|D16) zpSmi&kQ#nwzEq6Y6HSUxmX$!myi~kZ#{_R349sA8bGyB^-8%Cb^ZA2B^O#TM5A8S@;de(UCD*wbOg>%;U&x>@UTq`lLcwd#B;SxRwWkFba z)TDX4diwGok@qtT1^PUIKMM_fBlNPSHES4^gY8ih`gGwoJ+ z$rNVCBh^|`ABcWcs1AN>Ni-No0pv%D$oDrI$}>FO2;x_x^LOQ zg&5E$JZB$l+gSPEe6!a4X$eKtM107>Uc<&6iQ8g)to9w}lmsMmdI5Du*>v69Bb#T0 zTt-_s%{l5kqu!mRJ@VUuea3oT@&FFnjZ8P?1QUvu*q;!cBTg(qEK(#OJtVpNncb?W zekSXa(@(~C@->4^ENZ)F!o*{(ZpLHS@oP{|ZDqSSms(1PV$n6B2n{g&^jepb3CiP6 z2#-?A=;d{qoT~dkWs`AgO+zHm9|1H}O2p zo{tjPC~z8Q(VvIbga%L-{}UHUWL?elghj1@qAArXABS#l0>;9BkBmD+i6j`E-X7n1 zm;P6GkRm&e;xf(B=vN^0x$~|ZwzZ2YAJON{P9_n>j`o^ZN%ZBRT0IGQZF5dS;S$-U z@lhDaaiXqa_IK^tHs#4xz9oy0_P- zlY|Enyu=L+TKoeqH_lJ=cC={^p!Al6^k7Kp@PztlK2%sEhbjPv&{*G|1pd^6Q$$NNXyEYF5ee)zX9<5f4jV5{ol}e zEUfvHeQxo|&n@>nUt< z<9&WCQZ*uhv)lJ2p@tm}?2fChWJU~||NF3)H8!lW*m?T`^+;)K&6>$6qm$tM#RG+MMvY}3^b-oZoa^_i%%Z>2lTgzBJli*VR+KcyY z+7P@egzDsm&z&COtbia*qD(eqKo|}MKjD@6)if}kkaCsr;MmAd+vxIXhYRSoaeosa z?PdKgsM{Vnuc@kd6TKT8>>#osUks;MS)M~cYY#Cghykq@KWkUf_WrA;r3*d8IZv+$ z00*i&v$%P|ebC(sHUt3ktQcjTVg(ugm7#95g*3ACt$+rMFA{bO!42mP`-$9aWF6NPXa4p?+bsPoD zrZvVqS?4+1+$ckjm$g|eY?XTi-Rd5B<-KZr$dY~-2m-&$F+zL0GNGMhSl*gpK|F4t3{z0WQO--nST zFSgtL8Ds{3_^#8+1gA&40c)G;Zt-O6LfW1GH$4(Ex}}LnPHdI{pDO#((>?y>(ihp%aYw4m3De;;?C`?WhcF7 zH!ggMbx7S0nR4&F{<(4HGI;0jYq*1_`F0wh!R;Ig!ooGqFM#a`0 z8?QwsD^+q0+-A)bd}yuL8Jio%#;-M|7gbD{Gat}((uTX$_tbT>$NIxUGsZrzRHM{7 z?>{E|T21>sSW02R9fV|hs^{}f6 zf5tXU=J0!j;uT3kBMyeOQ5c8nA74; z9~g+Zh#`zMg&RZKp9@qwEG3eP!)nr}DhUqL2RqLjK^3or5_>)6=ZD|VD`Cj~B#8vQ zcqkc79jPmW_XEA#4su)-Nv7h++wvc^#b95SXU2X+g%XpUnIX4gxsx3<*iVq(|7{&Ad!&E-4C;s zb;byZ3Y81kaUvKRK+x=t^cZ17q#gmI%7B&AqDJ3k3ZADNsYp?PPzt+jH*>ow;X zMj5m1va$V-h7%|4vmQTb1UT(?KBMzN`CwdxevoIZ270svNO-Dtj5{U^Ng-l^bmLQpq=zfXI*&jMI zxOzTny*CrvbKcBw^G>i9n7v^F2-KIb&qQ>>5T`=~u~!9vYDYbk{S>NJYcNj9TlHs? z(P3kdKSAl|OD^gqeoDdW$5ZbOGz4TM+VBkvcOA2VnNhG}>7rRNU7w~(GnG%%9*(wn zyxLYJTk6m1&5TpsR2HsdCdQivh5+=bXvZ`LHXYU3xK4FK2lsOdYl(#5(~KlZS#S{y zWUROeh*Wl-Wprz+MLpautnMvh{^g#E@Pb`CSFDx|t!~341R~)AjNX*NG7^M)oca%I zYOtml4Y%wFGzbmX2)+5#ta4jaWmUW450_POjgg=Ev}_;4?D(%)5Oc?HwG)P7+29YP zb1({ma8N2AhkB<{>|48$!D9Bp#fJ| zdsYn&AG*>iIzg8*y=N@gXAF)akU$*MS3-mE-sAYHny{wrhfD*^s~xMd%opMNQX_6A zS9@tQ`!`$r>KI|aFX;~=yT$;I%m>zFFdtf`COZbPy?b=|#WQ~0@a$f^yB^D{!1p@K z+9d-5?BPL4IbHj?mE*5!=ki-AxMn|cm);8)N^w8>`*sGpCn-N8W0p(ivZkV|DUn0fpqog=agRI{F0nWg6@}V%Un$<}|CI_C3{V#vxEF+*>BlH9o=w;@$ z&BLjf;Cf_@@>4=wcHlMo#HZ|gg!c@B%_Zk9ahi+V2S`>J^?|*iZ;J; zh-uJnpYC}B{DKr&wm_fv?D{4Da-VWBcwlm8MiAbH3U*%(a~y@^>wtgl-9e{1bBQ&I zcm`qQXKBTcm|a4c1Xg;f85@QnwX^9h(+Ys0dZ`j03?eP*56^iFoRu9r2@_e)5-jIf zTauDXGd4Uep@hJrX3o*+&!Q8 z*^B;*8dz!lI8KGXaYa1grrs#j`Fxz{dD{QD_PW;4ioDHzvYYGRbLt2?(r3vw?l4qm zr>d#lQ9wZpv_ipEr;Mi%mkmyM3dE`C?v8R^+1^a69aP+74>J>0oJMtD$cCAFSLTl| z7X8wRQQCpaOV`_TqqFb3oA_5d^3kw;a}ASgG!%+Pa@?lBD0?zMo1cH_&B%dMP*>z! zxrR3`@Q(2iMK23mZ@`IMBc~V_L>3ZvNfcjy+oih_Fx%+{C`Bd?L#U6!;$q&Ruwk4= zn_7}0)}D=u9ftwZ=HpF1Ea9-y6lthXm?Ht5`O z7gJf>KX9?ug@Ae;X;Xuh^D&DJd>G>o|hp2(WdMDO$V#F^c@*$F?N!Uw1Aqle)MnXnTi@!E*r0Xeg3lg z_P7!UmI5y#kV6tUNz9p4Kb~~viNN7#HSnwC1qczaY^SnEtrr5RbPyuxosTK6w5lko z@L|821wPaH0i3jwo<&&y_^Nh&NLs%L(1)vxYRvnd;>8Ze5$9NCpooaTKPOyf?DWzU zx-oA4^(a~<_^j{J%MR7J9p_s zr8p_Lq4q8QU52ZG`BPAn>`{0r=ZKuIb7guc1~dYq&(8Os;RLa#ZSkAi= zPl|MMPOIH{*Rl>IVpe-m!v@+*_*a8$=0 zO@&us!ad59$WqkS%{^Z>eDO-}rZhtH0{U4>R>X9PK_U`sY-*+?%c{t_Em`D)!@b-3 z2VJoK5#cmjd(&QWcFUiej7e~wuT~zVVx(O==Jeoqe!7|wLQ_dhb%y-AMD8OrqQNJ* zppB=sroH%4TJCr-;ch12AeTOuw1#RtPSel*>PAXpSX1RTfoxo~JG4U~2Pa?8pB&m( zN)f#$&FtA$k_MG=aO6WP@+Sw9Ij^SA7gI_%+9;f$lcFZDAvNyhw1u4oE(r8+c#K*_ zoOVZ`Ta0!Ib@Yy1U4$HAO5R_N$`2*hVX;y_XiT4yAQMzMQfCr5HMPX*h;xomgyj{O zh@!ZJ$>dw$sPQtl$k&^e(0Jloq4d7^a-=V$fr_k9lH`!kxFfhMeg@SGvFxL(r*=B+ zs>2?p|90T`gh zqM@)C7~PTtpc9cEmtYWL_{&8<0O|ZV+ETn>V1)gqrtF4%;N19r8}jW^le~Jbgl4jTROGguK_h05$DDvPUO7HKZ1)da`yDQ z#j4G^$#|ZOh~3^!v;AJG+XmWe-slK3ereCE;FL{u zY*Vuw_Gitlo;OdV`qw$G7AN1m12RRCnpNw*u}nLfKeYI?`1MbLKn|30^CO6&sgub! zKRq5&CZbF?&bUVASR1T>F$^BI0Qp)a=?BNaGW}c0OKi)q7nNjbr)NEof7iTiO@B}N2oTVt5r9@i)ZBV zbqgsf53)4PgSqGp{6CESQ*fv8^2H0sp5PbTHYT=hXW~q3V`AI3ZQHhO+t$fGZ=I_5 zU$rmx{d43t7G@vYffW1k9Ha3l&sL|OZ2k(h4Z5Qlo;_mh zqv}IBlom<9wE9?gu)7!|lb|eQBwLmk!wBblQW5+SElKR!tTv2(9z}=fM}eUN<&fJC zPR_fqsjrXsbTnnPDNv5b_Dw_#f*}cu#Muk%l|eAz*i`Qb-L+6szaKu4jhb!Xmz2v6Jhq0^^OYZdP=fKO@g#WG`CN;H(3X{8F0$^tp^B) z$e-V91L~qM_u$aj;QbeUKCQa1*JH-b=;Vi>*x|GN(ka~sZT8r8k6(5I8Ff+H`7%cJq zMl{t~)dtf|i-l&svl|Jn^jOE6TmWQwEm5{@c*~&R3XT5LRuaD3n12*Bb?mu}ixRr> zu1J^6cR1$zR|-jvRX>Kv0wIcOw|YU>zp)qOf9kQ(^{a>k(oSj;L?lIv=bR(AgpyVpeFj0n~B~^{Dhg4zKBwB&##zLh%PasGT?rmNj>W+?yKTe0z^j6Ngi0>{;)qi-6M$m=kdT` z*!IJUSqXmh2NLppDmq!pmQX1M`LIG%%2m1Y8|!joa)CG3$;V6-0FXn>@x@d>`;HO- zM-#%aG7-}4nLtSrGlgP=tsFwTkO|CD{CPd-9kK~^5w8AuA?DNWb{^*yd1T6Rykd!u zusituRMRfblVjK;dGzawnEPgtPaKiZ=8plA;0TTZ9<f(R=w0d8`tf(3Ai`n zH=*a@&mdLa>%WdK?I9!2Y&qU4EzQRzc(|c;0t;$lQ4PO1EOu2%?%VF@fzGrse!PuT z&sNWlH99C(HxXdu@Pl`#Km5g4*Rs^s(A}P2Pc{Y@Dpd_?twWe;gPwn%7vHG=V59SN zBj^Mv{$B10k2lPkSS)Lo;~mAqTArzui4IC{D{rqB8;@hX(MSG#9sj0%3H|+F>+ksEu1UcoKu$3pqP9`ualWs^U*4SdmP(i@!04CiPU<)r+2COGkunYO2axPZwk7hZe72S2 z2eny|J-ESm^1hl7d#{jN%|IaoELW6;7BA0>>TX$y=syuU=yo5=%9jtPc=ulUsC#jN zKQ3!%Aw5X%+g5wZ^b>CEw0^CRzGIN&BK>}#DPVWrdM|W}*;IZ$l>avLET>ZiCujd| zKGSr8R(S9ufF_a0Mg&t2jb<-^=$LCd%rwy5rJ8g>q=0V)=TDkw=K0orhd8;K4|MFZhiW8k%$HzUiFa*7}SGU-`|`%j5^G z_$MPd8VicSBsCGYenLqS6Uejx#cmw*9^+=kF#dvNG?u@#*AWt7jHa-jp^%i9l zTUz)$HL)(uK>U%sq!Jt`h%LALt>5}4?a!JzC1s>MdLyd|6$*c6EfC0P#zPL^*s~R3 z?0U^w7vd1V*$N*|=oHcLG-aZXBLR2#Y0FR=GeKj9X&58r5+^~b?}(Hra^_>i1L z`w6Y@o%qN}-x})YXMdHu^b%fJK+2f%i1>=4jkaq!NqMS3P~`3V^DCIdA!VBReq=eg z60Ur#69}uNXF(|K&k?@Rl2INhZ|}_3p`;3w?uzUJH1^)QmK+#Yf}aQa9}cRJ^uVEu z7AGCQi@gWN$KbI0%G=W6%);&uK{5Eee+V4+3SqM9?A;MbAtq)IWecLV^o#@F3gOT@ z>t8^6tcIS%CfIt@<64j>c9PtZhs&;kB=fuKoS-C$<1Z8DJ{xiHVK`Q}q>VVmhOFc< zQ+kkbX`ME)s#5GXqr%@%hMw-;bHW+zd(%v)c=jzK2*dgFs{5BS-bS}mtkjp4moj4lqLv*E+Ejdgks#LQx?K{wLR}rlC zBa5Fbcdlq+IEvc=FNm}k?M69e=mjOsxuUS|Gc)zmSu~4Dw&f~(U4Q(=0754+wK7R% z1@5bpEb(T*-1T`ol)A?fJ1Uk;e06Y9pdpXisXx$LuZLBTI`}j$9Z&q>&h)EoxVS?d z1P**ek3%uMi1AJ&6_Besp^wZR%e@$!sms}nEPbDmrdw=z05?V`wNfIx#_kwQ<*6A7 ztU{E3_uN$Wf%*8{-j!*d^M^NKi%g0;@83o{LXDC@>5)vMgv9>6Z&q)BVCN==E*jAP1q*#}JXukanO(LQGOY0Ud^1#cDG)SWfK9aVEmEJ`P{&q2nxz_TK zb-OjhGwF>NFv^ZK*y!}~D*pBd0!s;t$bW6|{~OqegYo|y&j$aK9R2@dA}~%wV1?nf z3qT%bihjl5DYC3;W%w^8b%Gd;&gQQ^EW1#|xvwNFx2v;=>nWgc+)w&5_pkmqh&1$H z#8kujygSx#RJ%8;bh`7Y{S^F=>)JLeLv)aW099(u>(jIA?++`+k1`V&;ZU9q$PQEa z2%Eb>WhYl;LE9D9)?FK4t$V@*qa+Lr*nz5_7w0YmGyVKq^3k7VDdayFwCYbD3sxsD z%loo__d}O^O46>V$l&Yh-5sx*&DM)>9EIYFdoRU@tiquHVQ43dI}u4Ag%_3dGuw-` ziL#v6wZca1Wz>=C{4y)~5EUABK*qxi^kTH2NtAA8qqa6{5M=b)`$Q%B&n!XY+q!OB zac>`wZvz%OMa(J2@6X%?#Y5WZXP0cSmx{GRMeW?y zMhWoMpzMs|WQSYwKc!inGnDgRKpuG16BEL+)G$I2AXOL;-doyoin6r!*0gTawjWpn*%W%|D@@_1k*MIf=PPf~E_6 zoOq{uZO^-#_-1!D=+V4x zk%N7%P4fkYbQ5Q*%;eHUu(r2>&fhh9uvce#wC^W4Im{uK_v5a$g(*|#Rf`~uotQ*K z{^i9q|MpJ6hY@#zNUbABLufe`=@cCS9S8C`ojxy_*PqLo}u}K7kvA ze5On^1nD|th@i3hgtKS06kJ%b(We}OO#w}my8U^{3yQr=NSEOQ=SU^A_)Qb2)Hj$q zBxpQ?NVt$#7OFwSzmyvOa5ZL>!nuPu;jd#zL^Vzrf*DQOGayTt#4RS|Y^)Y6U1Ur+ zPY@W4m7fg96=@U#zxxy_Yj|>8=@FC(5f$p*HBSThGXgh7>@pF+6md&>Xa+O8>`-+EO9?_?-<$lx4%rV2PX;ZC!4;~?0BvH3R&9N) z?dc#cP<<0`^TrRyybkAj!^Bp%k~&uSJPBk}DqdH8-utI%&vq{9>z$BZ2IKrs-Ul1= z&pNaIG^(~Aei0%Yf5=cbM%5|ZYMCvmzlthsEaqeBWiD>AzAB%IN{@$jenG;wKS<~e zk%*kEhy@W0b(a3AHmJerp?}#+Uirt}C(IL!ti9dCfYJ&DNqg$RrBrfseb%snfx5Z= z97*Xlp=UB7)QSOTPDT##J3EZq;v%@AWUMpOlIK(-#uxJ@c!E7%BZ2oIQi37Q@A*O1 zCi2#4K_!#;mDUEA45$V?B}l&A^y|6vb({EpMwS<&r>heiB%jP?ZKw zn#3)Gj5vbyccb0F$KAWzS8BTkj$f16960<)WjVp7V*+E2KpX;P&?(}wE_=I*7;fVI zz7Jy0PEaqGy*E}41yPg`W#e`rUV(v}8^t$Gx_(^QSrC8!RXEXM6q<~whl}6_@I1RS z9mj5T1+5mOyR;#!ZK5MOIDWSX++~8MV}J!aa&L^DKqCCJ3xy($UrAs^1QgAEKQa!a zAdXPIF`9)o9EetZu}ouRTDU2UPTy17X+sgxyE~EtgTaqt@cSK`3E$pBG-aBcViM7M z0Hy_mr;sw8x1^zaq=zyN17w^X6U`=2qInOkmXpg2({jc$Th?urh7(E`l1tmGHXa@g za-@JmhFF(WtU8an&cZ6G!S6rS6{b%leFN^EW0#Dku8UX#CU8ugw85_>LH@XyN*{0~ zn`v#=mOkTd$p5ippcN0E`~9yQ4A%Cu;z{FLB_iD-mwqEITr>DhhrggN-aRw zTt-0@u|Kz^czCBe3c_NJQ=&MM3etzEk?z$us-}MCl5gzM-oje%3`=cA4sN|k4bhTO z-oHp+3H`Zt>yQ!!(@4lSN8M=hp#9TdxzRkwn6Ul5Xw%F?c z!7YYUO`gM9H%FhrJ%?U=3$l?umCP+5D69=vjeO|hE_AG(%+0muNop^>E^Pj$CAnnn z91q_JTBWbPXeLbr<$zMAKP#4-abv*K(|@;&cfH9quWqZjyXU;u&)u6B|HZ0pDCsvy zOMv<2bAFQDa3UStAEPbSp2x(4wBC065wP35;wC}B!SMUMqotdUahVv`0(yDUM%!F%l#qL|41#B z1ZY*`TjP-l5Y}Z_S8|}@)-J<45m z0}TB=>oq#jf0q8_X4sC0%L^kZl{dz)T>9v?Yds4wni6D$J{+CZ;y+Avc2tIUed|dW z=8z!{M}>U$X6&BIWzs#0vK5j8F~RG4Uk>gnk@$d(#u!BnL^N{o^vf^}IP3zu}FSN|W3@>AB0id49XQ)m#T{;KGu3E-C%$!HQpHBUIJXz}Z z=j*&R!dQc^T*@eW zSeq$^DVAZx;jEuhS+m~ML4pj+`!j~2NCJx`=><(0YA?-`SQc&H7gBC()Li`=Y)Fq# z%jRLrcIlU^SpqNccZ?BB;PTVw4hnVnkeRy)@sv=_HI)eiLx4!M9ei$*+XGGR6A($u z#2@)|5pN2q&F6I?ZN9clS@f^w_B<9aZ$=w{^p%U6a#6JP^xAS9r86f4$X}4dofeA# z#!v#Jc^*S?io^hV9U+6B9ku+6_Oq{E(w}#4gI6sN%io+<;~^J}^jFzc=NK%A{L)Fw zPVXU-WJEhEECqvyc=fQD7$VW@vNT5jCLm?>eIf$vFzz!FlN`)WB0)qzxDPYnAt}U| zuD>H2>B=zS$LYagpp&9!5a7f1k6Sr2(#jQE^LfLivbLvsaR`sO_DBx>iA3gIESty6 z0g^yl*dGielwX$TEjXMD#11_X`GZpFf`S6fBZ3CJ%u&$E)e#t7Y7GU4B>m)Tf~h8p zz2uQy)}g?7*I0YW)o0wlhGB3nz*1w=piioqgN$BDPUg;D7v*amGw!A<#tH=^rhc1p zbASr{Kx`zVe$1(`vAo6Rtm{{!6y0)FFopxXU$omD5D}IUR`!5wiCt(7Nq(FHpJ<%D z_l~joC_;=V`{=xsV-p(qUwXucj0`1Bow{X(S};G1R+7bQ82t2p7w8ta zy9hn+lmI1zV;_H8k`MuGZdxE+9qy3W9bq=UNYYmGE18?Q2Yf>$U;Zv8>s4%5nH~DK zLLXPd1Gzr7wLYO(W)X`tXiM1XT8mwmL3-*SrB2?%3eqvu!C`bCIolB}Tdk(f6-&0Y0^FF|T?kpIc&ANBtj^1Bc0pAgysazex90^BhQ&9YyZS73{V~;hMNP3YG zCXy={gpa<;b+1!KWw;z6L_AC8(x{8`acf34wJOztjTj>iyOS3Fai@<~c^31NMkuV* zL|kh6Sq}~eYU0YB0m~_>b%kMA@s>kW)1iWHl4gcm(Wz+&*_6Q{(R<4E4b7cj+`^bl z;dUxbDC!`;POCiX3O{0AH%(5&xUm12i;qT>l-|)ZCAxvG=^q(kK!aUL&|cM&tjPRI zUybi1*aez%MUVAMbeu{TAwo~b(% zttI-91}bOLp(U}E2i}oE$nR9T7v_N2u-Arx-eUb2_9;*)-pUmgCnKpArIhff)Due< zst~AG15!z1<96=`$nJJoUb2vMq&uZP24HodzwofozFq#bz=`U(&1VNxuN?LoCh$iQ zZT>Uf>(pH2ap|Z9>8J+2WCYkz5PZ?ZlLS~NBz7=O2apU00r2muUWoTPAfPDT3V+ox z>XSfd#W0blf3r^&Lj+^edU+Paz{JpDXQZ5fZ?SeUnX)^_823)~kXX`UW-y$+sls=5 zXEOvMk7D6u!NNG)3?b$n<~o!%GNK|(tfqEgok7StTfMeQ6oSS`rlYD-3@fWXtJB`pCCiN))Q^&dPA*_9S7#*bI>W^c0IT!;f|D? zca;df4)%!+zmx?TfKI67qLx(nA~MdJHrpF7;V1I!T`jrxk&OEd4XhU~sGAx{!B8e; z>1fY2llw!CT?4Op`xqxH`-hP*yFxMr3F6>o~k@T*4)8>6}gvI~%d0FDrUHHQLLq*N5o1 zrP3j7qU2%(831`Vuv^|+)9kX1_@hI_gr-4e7^XR({NMPcz2Wy!U;=I_JJcqgDN8JL@(m8(uLX{Z}!Q({KN8Xp{Mj^A)JzJL;^TCBWp#D94AVo#Kj_3^12;Aw* zb*ih!4*W$MiY`Pr#+U^zr;qR6M+*~3)Q1RQ4m`7wsjkjz-?r#sLFTS>4)P$eEX6B< z7cX(SM##h^h_Yl`wZPa{a9dCGo~H4RWX6IOMEx-=84&E3*<=*kw_6zt7vO)MM@HvR zyX?v~Ctd}$T-10LBa{z$L@B6?+K0k~4vW|X|-uY# zFl?j-<(q;6O|&4DsL?P5919#&r@u1tV5gl=IVed0$ANJk)O`6?GyfQ|*Kmz9?N6J$ z+%2s+eyQJ3{PJ3nC5IWnu&_yAsO!;u*;ZEl)tF9x#D9QjqBmR?)X;md#7Tujk+WaU zvqWC@=sB&*aM*)2Ni}1-d-KX3mT>v#vq1EH*YN9U^`DT z1go!c?bCX{c~6orA=v8r$#h0E$d9NBSOgpz`>&g+66lW(TlSZB7WCnua#EUwFnczSe-ljHe0AvJ4?Zk_CK*lyb2sEnd zww0*=QSg2qd#d%B;D7`$qa7yt-a!Q-eLKY}kOIY%X%B?PMP7|jPx>JA<3~mNUo8!Y z&LZRQ(sv=Pbh!PEE3+2q@@&t)QnR<>REi#YgDW(W*FnmL#4l9RF@6NSr;Rx~6)Aoo z9oj%5Ix*Dzz}U_pFg0cZ`c~~F%v6+AH7Pg})4+i!IXtJ0{QA?N2^Bp(Ag+BeE_PeK z)sv-c-Z0^KnA0fWGgA0$i*qFvk^1DPIXxO{0F_(JBu zclIZJEdn~lzbnUoi$e~s1juY_IzedZBN$8^94a;XBQ_7=D&&-w1s641+n(JmDN9{? z{ZY~0Rt@);2*Tclfn+^%JEWeVN3c5qF0gm{g$%>NQJcO7Xf%yN8ElpS_wj6H;n-kD zh%&!5RTF3t9;*#-rVTGTFB@c~3BAe*cmwP()CSzK&-Gndd!<<+x;xwL9_IZ~UN6J1 zWbfh_7Rw0z_Dv0CBHs_4>H1W@dRmV?OE)!x*%ttgmixGW2xhBt`-y5?{MS?L<|mn* z&JlHGC?;Kmm?ZjDSNcIKYitCsv&v9mgTT4=XP}4XE&%4ZXSg%m5#HOGYY&kLXTM0S zCHEUbiM2IVvrb5y0qt|eJ4;}OY;*p4J3}h5-J!O%p>{lfWMo-FF%+pGLl_=a*Q5~x zmr7KF=M+%^`p{f)cw3Eno3IW1sla_z*9n4e`p(klLWSl!N@l)k3p#r^m!1>^d3sia z^tCozvgSMw!0o88`}7AL^$K$KO&mQDsF6$?t-HI*Kp=wA2Rzkz1!x8DA1%l)4)U5qRY|0kB`2b&o`FN)Z8tacJ4ovXhU zw<8QvAg-WH%HCSRG4fPVNgySPpr`bDd+H`$ej7CzM)5bY5^H z&EL~xj}ZrrpxULd)|?9k4j~qxPw1E-A5_}QPmvcgFG57(WFB8d@1A%vQcTq4-a4Ye zy?`Bgl{r5ysNZnQJBt)z3b8~eWeJz|cx_H7-hnBnJSBoDK&k)ZGr>4rByttTfrhu1 zF(CV+X`ztljq$i{R7oHCs+1}wf(sAmhbo?fovU{?0Yt~PTsx|_Nc{)64z|4@@HuAv%{P3W_-cRY@l|v_zqC_4hI0hJj8Y__f6~O$;=68%a!APXR zx{J^^eC5;=QCZ$tl}o=qmO}^5VRu!4%WrTK(V9;pde?f!YUQ>t`mdF8#qvw!QAo>$ zP>x*yCu|htWSvm`Mo%N8_A+s~_hRswQ(6s1R>{Po8`>N!znQkYo5Q@2nA3}Bggo=U z?-y_k0UV`4U^eIbr%q$`m@H4-^X04UA;=*UK9{b7)2?f*21KA7>Ki^0^(YO0wQ3?0_a*{k^6f1G{SuEp-2!8}?!Lpt9 z1%&?qHHRS#dL&NhR-)-gptNz8d^jT#`eDYx6So500mH5HwmR?ct&7@bv5*H&F-qE< z6$aoP7b)?Tw;7MYx^*o)=l(kg5rh<3af;5}DnljfP+gA^wDxdd8cin5q(sT=Sabs) zE)#3O;yW)8 zuaj4fQo!nKnXV{mXpU z#z|CnuvQi()3CtyOlf62gKkj9ac$ke5RVRhNrcTs6>mhk(G2wv0QcB7U!K=h z8?ODTfZwfymtN<5B-z}%=5dfpn3eg+VBOlZoNinb?o{ix-F!2=^%U8D74BtxJv&;J zc_!96>$|tp>IY(~YNz7-DPCG$#K9TtG>Yk13{1dF<#*{cubhbYo9<-kn{v(=f+>4Z z&AhI?jhP$n?3RT5x3IU-of701@XXX!_}_IzU(ei%svkda!iv^U71xIVyCWEF+=?3qH9h%y zdvuES>jnkry~OYxt6ut<5&OxtHwo9~)s#PX~qK98YJ9zTqk3K7f+WKc$$0uwy+v zP(;NlUtJ!LSGlnjad(Xl!KtxUZGg_|(7IMTSw-RGuZ2xr&D6L`<7ghu*}^^nghj~7 z&ziDqbmzYJDl(nb<`I%Qhw|QPgInd2z!z}<+{Iu7Sm!p%6*3Z?&3=zb05LFRFd#2M zJe=T;BYBPvh%v8%jU86v>_MvC{_1M;eu0O)uSyb++hoZw?nV2}>8>@NUT6H;a}zdc ztZFKHqqBIU)Ba6(PZe_A3i%~H9N$my=kE)V#ODo+CkQ&R)$epp)bAsJet?0Iy1jWj zyqoLfDi!fp5s=n+UfPprm)RpY%dl5-KA&uw!PXX(tS+A;S7KaPrm)|>muMpe!)%eC z%$Tvxo>a(YAQK~vKAJ#RI`>{)OY>A=S=4KJz_fnd9W72H9xI*ipjN~BGbUwQB8DXo zpH%Q1Bc~o#axvMmdEkxdJb#;lf5i*(SV*#Q6unmL&tP7a8KE(7(TNy6d7Y!6{;!2Z zlEF<*-Q<0??RqLV-66w|z4(k4Xy00CqLx1bm*Jk<8HQt2)-BE*z=8(|2*y&TQQy8Ke&)j{qbfug_*i2TrdMSqj?aysGjQ@79Gm&rAz{o_;um#C6}&Cw!J~? z`bK&(&ysx*$|dz!n(z~uOqd^L3(X1wTh}QP21+;-~CC0xx?W63iskpLZ3Jk&~iT4c=T*kX*FnBMZ?$b zJ4vuYnoG9|&sD74HLh=Q>_3t{Md!KVFVLtxy}E~(7*6*V z%)^0)5NOXJ33rAgxfr8dudOy>jLT>a*DD}V0=798Pd*=E+ZC#!;}Yne>tqcIx;J8| zy!siRDhd{ynbB$gAvyki=#3J?DeC1wd}%)}EZ6e%pH)8)M0x}_-pF6@Kn7kL{9Du@ z)+eVI_%@yhl`(b;=N7JRL2mJh(a>-tk6#l`6iK65e~+ZaD9@+KFpIXbjVGqrKwXT2 zRvOUJq#KUTP%5m`*B|{G?T>tO8^!B?zJa`C06?`%M+q>jFWFW@kQ@ryDPZ~w$;fXmnO=OT7FReB)cH{rbCM)9N z`Uco*bmRN#a2(fw0wkvUn=g(q<`c6z^KwFEdOS73y1kzHc*P*J{#ya(_@8hiOpGl5 zXYaN6pG@qQ|J=YB5OWfJk%+fSA96=@6fX>7^U}@U5#@j*Dtw;aSJ zlZ?!VvYcU2n0?GrxtFj1xHi0)37|uN%my0YWYa9Y52`hXFJG_tk&(zKwzYgV&ifra|MGD8j<8K@IOUd*h~50M|K8m)xV-44o7jRjiy-1) zE7x6`#K=7R)-pX#I$G7PDk2GonzYR3R$mn^q@{eA&i0jn0h2*v zP!_tkVXccExy`a92>_PPcyZdoJFf!{Rm5yu$3drh>qsCPbN+GOR`a@X{u3wv8^E}K z`Z0bT(~lc>;w6MfL>RieX7lpyfD(oXF5430)o=b=EN{P7M-t1b3=OB(Rhj-T;BPt+ zwZC&*knJL4w=XetG+y%{mS>Yw5G9sLHO+`RlJ!B1LnGhCUA9mM7aJNtR8Oly3dWD<&l{A!)XE@i?4%pH=Jqcfc9`?RQuiQk5)AOI zL2xnrI7}g8y%$q9-cvL2GWY@i1eN`I|B$rxXs@bAkRmJ8X}$@Wg8_llpaq6)Cu?J}N`KMQ} z)vfPT1VvJ9j#!i(0pr95X&9Rv`}@(uo1@cD_nTE?-159Q*Xd2B(N@m77h!1r2jiK8 z*r4n@2ZUeB#h`j0Z)apPtStnlx2Y`%8iVNHX6E@5UIy6W_-m<6(H zgm2lsM7?o7*nTQnNcj&WDv{!Y@--+YSVF$Zijx}NaEc5Fhu_T5zYRuUDd<&SG;I3;2zUh$i`Z zd1&Wt15S^D1*MAC)Gl(m$wNI?{Gk5VL!&$;_v(98KAwq>HGAmpf@am%PnE**5MvN8JD z8#peNTF;$36k!w(eiGiju0&x5@P+D>JZFg}H(=xCjI^Ol26JeTq2u*iPFwc!+Hdk? zE;@(8n!a4Xq`#Afcz5RZ+yQ3<0yQSsh%ux?RuhK`j*_#e#(m%)yL z*3CH*J+#%?J-C^HmQ2w{}yvhhM@pPVe&$pWE@W4rH{!naaYGJG~S< zGkOx&Xg;w;GTSL}3WFL+c0k?X(CN?>IO}f6+^-P8d2WHyD)NkZG`C=GKuk&m&_N2} zBOo|6QI0`AH?9yj#X!U7ZPa@n8ZHaB;v#|=Yy|BCd%F#gYjoZg+o}d+!>ibKUACGJ z{|;>u(J^VnC+#&u(Jh#zvsgFCG&~h2jFI&AI+v@gAIhZ-`XWc&@A);YvvcQuRs&g^ z$;RyK(sqpiqe`(aX*$Byr%f?1nG1Q>*3<6Z5*vvsEB`vehVMPWhyJ=h*Ng#_bK<#p z)Y7*EDsz(MmALp`;Z+YtERXbQ6^;zG!OY0a+xJT6UKxLg;9@&gK(@ACRb+-c=+Qi$ zIr=fX@9CrGdVys>JVs2tJsB(GjPx91$^gfYqZXXOhlOQ@%jYm3z$o-eTb zsz^eB=av2e?934I2Sn+)Y^Q3NT9WVjga7l9>z8L$Ph6-rM}87ahug*i%81OHt&~AW zr4r7Unf=J8g1EK;k_);Ch%A4q0ejhf;-uEDI!6ZfI(2+Twij!$cPhePT94|rHf@#{ z_PY-{;LB2W5gH~hS{#dE>Gb-O$u3oBI~qjp-;-`n%KVQIK_Az3G=r|?#Yasqa``Ju2$h2=xCW4m}BsTH5r0c{Y1r-_+ zctC7#(S3cSdxJ*J&1wGEhsys5tYKjI|3A?EOqw?9Ka=LO8sbPU31Zdrr>&eB0N)*I zM)hRy&Nsn?1d< zPM3Uj@z*4jCY3ME;-_#;{~ps-^$^v;rke z9I>&1>A&-2wm?5Wn({Cb>R_i11xcQ0J=?yb8JqzS+4u5vJ$^2?A(CV_ZYjgdU<$zW z5RP#M%o82{C!c#{Z0n-dnm}!*QIjq!^WDwO=3Ap3U+P(9kp$TgEWk)Zf>KeF!v()7 z`dwucCF0<6>d3!;{GN`{d$mJ(+_SU2OI9D&Z1;3tl(ZO2zwn>I*ZHl;SBbECT$-B7jjn@9=`RvA(MVUf@ z-1e5Mc{P_xGh?mu@Jl(P7w-BFOQ1q$hq@dz)co0b3RLj=!)@) zR=-tjU?ZPsqalBG%hI(EN=AZ0R2j)tFNFWP=%yoG#=&mz0y35wY-Vl;>cOA!Xz~Oi z5{o>!haU-g^{+hb(y#Gsr_I{U;6v-pV)dx#aiy|4oY}0vr^${igT8e4th=G$gC=o~ z`UJGLgQeoDtIkbtmTl!|r?GMn(Q7j&6e17M0VSy5F76t$EWCd;aP!YQY8G?EC<@@o z&bK6PsEjgm%=qIl%;G~0uGyAVgmw5?H6;a=i_AdV&}owviHUF$gwv3koX9i0bDlgn z1Mwz$1Oq7?-DeU{bNsf99-bP_$qH%)bKo(7dHyPM)v<=%(sf-Qqi0GBHqn$tB!@#` zV#ol##$RgW3U+#yLOLR-sh=0otNC1OXSQJZ`Gs4js<@68_fFsHjgMM^)Xx?S9a$+% zggHULCiS`;+F(p%i%bkA5?**pRhg?3(AgM$ND79am4tbsZ(bmegSiHT1e;OpQahb{ zqi71*3q>$ND3DfVV)e+;x%?Sn_z*WG03SFM3*}JQ$HI8|oRYR+g29hqAwFhaqSufE zAOT%_CYRU@96@|B2VHVz=rmvANmJ!Kt7f;18hozr-MU%zw&rB@OYIj!=7st}&YZkNnxPghFTS zXow$?6Qu$xTOJVpSW@_$U-%MifkER%hTv&Mgk`Y_0<+H81`lMgifOk52Z{&r2ESGg zSZ)p-#;7;wOE>}Ew~KP|QDqRquX#Arrv^RcienBB>eXimumf+IeVZMc)@4@fzr!N; z@rv9q@zBc880${bAMZ)tKa0PCWxk$e{%dXhpI9@DZ0!H1w*E&5xgq?YplbEKLF&Qz zR(IntSBeG!0eNVE>*-VPDm%86j>m0a5!CHE2eY9EPr6;5uV5kt*KO4FA=fkVCt562 zKSC%;pe~M;^DLX%Y`6m!QUuEqNn2ZFNZ3#4W%}(BQmMagmv* z29|^IVV^AXa_Iz+Or`IdpJ^|Oo8uCWWmul8gb?hC+ai(9H*#3$>L=zU6y&t+keelf$w=DR|pW&^}DOLwVY zkR*-5C}b-g1$n>*iN#3!SU!#XMu~g>fu5k45%Pd`Os&f(T|{chP~87bK!4Q3pyWN9 zJ<#4(9?B|>YH#1b6?F+R^u%@~g%eKUme7hqQgCl+<7F5vv*NfLPqQ{K;S0BpF|*mP zr>h_O+&*|GvyrJOvP;Hf=vm#xMnzw=C2pszE90rJ10n*Wgvtk-A@x%yypVzNB8S1j ziW$@gXUyYx#vy_pWB|<&gIhk2Sp$*aCVoUN+i zD6!ex=esL%zDBKVmtV~En0a~!PAM9CW$Cev8D}7qGiTARll1MxrwCMqKBnoihwm*0@@ZcpmJz}1 zva4wpVe7z|pcW?1h!a34wlE|f_!u3FDOs6c%WcyFuC{shS}COhhhiA8*U4 zQ0bb)L!LKzJq3eXkre=T?(9euA5c`-$Du7S#Kz{#)z2^?m7#X{CO6uP_)s;;h_ zyzAGZI~F_?&3M~#u8p~hA^UL#z~h48G51p}3)b?hM+vh98Fa2Ezw&etDZ_<@xRcsu zI1#c^`tlR@kDKJc3y8=a$b@r_;n^B0wcq&nm$b z&qjY8@&)1%VFx9X7DBvn120c!+z&GC_aP8w?_v9F|UwhF! zIO72PP7a752r=&#lcAX4F1@=eoSe=$d%5}P&z=0INw~-QvJT9{Uz_{ zBD=Hwb^(#VA?**nyV10G?`W?dz7=SvKC%Q4VW_+=v1Za!N~;-PI)P4RJE5djF==M* z1;d<_Mt&8A;|Pd{xEV3s$@(=|!F=b*zXDtP`D_>I+H=$5TxW#GyX&ESF(iDIU1dTMuGoRt?X(IC9R+5 zy@tRzGSyi&6~r{y^ZzjR58up`^~lH7~>rS6ZOr5}}L*+z&>&9+QW2y+*RpYhJY(=@^r0qVl*t*1W*8 zQ=E3&ds>(ERXEi^R-s#9w3}2*+p$hkSI@hj{uFMb z&SMRwyi0YQ0*Ii8~H~oKZsxL?M`i(=+@?BknKm)Xkhjl*; zYkLI}ukxAko#y9yD}?xHk?Q6BZ4bEd3AX^%GWl#jZV5(<)Ytm~7mm>xq zY=-TX^??VkHp~1xTSu{RDN8}1VhB&Cn2{Ng6iuex6WsqyJXD&WjB1_SkX+Coe@FV9m4< zbixI_1(LXt_i$^)&pb%!(d?`KD~d(*Hgr&S;cFSRtUOfqb$q4>NqT=eIt~N*6Z=sF>6Qe8+Veg`&#$2shuVR7}SfdgLN)EzMQ&*6AquL zbQnuh1wsVuG6@Gxs4R)V0gfJe2IBPKQd&42rfJ7TU3TBpG%;(1C#u!L9RM3<5p~ke2blcgMe`P$Lh=B4*-L)!%c$_eaGLzkv=#g3V zA0F;c5gudj=HUJkw)vMvteY6sHu^Q8>4NfPxswCk$ZY`_0VGlshVegp)g8f~HuBjP zdA~x>+~!hSSk;~(EQY&9&BOQ!$@Lv=D51j!0m1lp+fo$~VHgR(<&NzpgGD#VCRm_6 z!uK(4i-Zy7<^u7e|LLf(Bc-}2uC^GFol-NzX#-zXg)F?NdMHou+rC1}m8|GUj z2(S?Q#WP?myQp4Dt(e@TyXZbDOb-KU_Pi@!!gZ*da*HJ8Qtn=47ZJk(&@I+}`x>8(r+paZIX-|YYiX4>65ahrTbhcH_aQSrh#e`NQR7YX> zH%V|YV({i>e{;3LHSaVw7(xUY0_cd+oD-YXx{h{b&9!|}*pQW&XJ27{2kgw;MlqlgwCY`6cP< zO$NqL3ooL>=ow$vVX4d&#dBIEz}fWxcxauodzv=$xRD%RqWEFe$g4pifsdk?o&wzE zX!Z<()=;o$m=Tvo6?DPgCH7YQbx1u?51hK#FEfUW=1>ggisq$yMPWz3czO&2-)J*5 zXQM~TF;>M1F3OK1>4o<|vPgNyoIUMk2V3M?px1!?JSEy>0v)r`0 zmwA?noULV!cv4o3IkFHnyCBb_Z%rC5!3~lG{CxvP<<_r0WJa`#2Hk)&kvnEE-BCCc z7KA3lh$Dk{@65t%!$CO>A*Lx9ro_(5Wvc2$zLbLJ)gP;E4&ae6l^hu`z=REKLFs~d zGl76$@TD5wzRm{`NCbak??Ya5lYYzA@w7o7vW2Tzfo9tD*96krZuNGz!2VXkA04Ji zMO6QE;Tc#gknR8)u>OKQL}$yyFUH6_A9ZHen^d)Z?^zho$DU-UM6We0p^tg5%?Mke zqq=>IM|e$krrk%)EV-8tddaJfO9*>>Q~wo@ZFYypZ)mV4bIa8e$IUm`lyeeq0rBX$ z{J<5$!~>FymU!_9f-` z!P;=!o7uKDD{(S^+^P)@YLr@st$MHnq3xKGqLbwEU?mVpL9hUVUWUONgv!DFO>phe z;rj>rKFTzgP0Zp#xJ^P@yyv693&lTFls+j ze@|w?!~Dx4?elG*XLmTj?SIbC{~Ioc`Tu{fCu4i?|IW|TJVyAr&+paj<}I1JUtrEw zV+uRi$X`U1=EHG^7MfpR4l&74V%eaiJaMRXaJri((*yg#VN4(~y0`f6_}n*YlKCw{ zJ5FIHK*z8Wcks%A&w>wzUKx9OCq)sRwyE)vCNB`D0F~QVdQr{cn_?VRYo}iMo`O^D zd1u>E-LO_!f8qWrTfO-_53xvA$f}0j=*(0|Vx2z!j8`*7_tacbKOs2)HSf=&`(5<; zPcssjYn)6(HI)jxJ902l^CVUjmyT~NV{`FB$TH@~8cnX<#k^bZyJEc-@`v)NJHL4F zA`xpl0~psP;e*t|8{=*mpfZWGBWe+=_goRsJ*;bJ+l2dMzB#*?>QcU#9wa9lCn6Tb z=>eDKiA(OS)!<=AMHWtN$Musd0WE=3Eg?SG#?aON zzB}V1kL63*o{53JE%iXl;u9 ze{BL?MO}3Flokk?j00RoJ~x$fusC>Dhg~w7)eIxR@$*i?J{#}WxDW4Abu)CIC+?Y~ zM6qXz@7`@|Bj$u+VN8h9RRU$o@RKn#yjJ>r<3$|R6egLAyet?yLU_!!~{jcs#;zOBhaD*!0{6qQ(qb4vc?&U#- zt*;Pg1oZvLh4hwjaY|;!br^Z#M23?_;lp|8K$=7B@gnWz_&wNSgFTT*K`@0=8NESe zVwIBN@?zEH$0%-SeSLKxAB6y3PjJ?ZYe|ozbrg)14UN5tgO|S36W!Qof3fe`aveH2 z&0mLc>q1zS4T2Kq00X+G^tz{fJ5WmOMwTav%jrH*I;JNqG!tEnE&lAQ({TkbXd?m< zmkeCf5n48{@N+D>j}uWiuLon7B>vfzdBF#DgG&oi@%WK^nZ2tclEp`}-j*HWDf8kC zq9+H3hwYpCStJsHMcEFFl{#_3pj!uGJ!-&-XB5}NbrP?u1^o*W++`w&r#w3VjzL|bRbc8OHev(;uuMM9E4!5TI=wuG$9FprQ%-W2U zP@Sl!j6mVuIF2#5=Y<*iR9kC1 zGt*0^w&luDt`#V&S{{lsSeLk}C17 ze!<6C2R)q~*J?|nJ;Ju+yqtw|tp>&O=;iP#!uj$5G3eHp%tu7t6RR#HE z{qlZ#dryh{j|p(M*IOZRyh^8wY#A5yVcDJGn$k6ldC%s?c1!QMMmOZk3K!-;Ts{d! zxUVI3!z*ED zAgx&>PacwhpL~He9$1`2C?0@+Jl219OE#Pw5qm$DIm9lbx{9?1zf4lvht&tG=l1NY z+~_T@>gxSOnV9`>AcO%EoNLIFj5rMnm)uWls~Q-vUr}9;M6sw@0^S~xFaY>T= zcM2Z+KuC(J9)fG3#rsZoA`hVa%;#loORS?6l%?M1SYltjP~Z9!XkeWe3OaU9d7%_)kKkNOGFNep zLtq3+LQ=>+?T=Kk=RMl9aUNP6^>p@nZ_9=kHmRmFnI>-y3w;ewDV8XF9k-1s_;0vw zcP8xj<;p*zKs$5(B5zv2Wo4b{#Cwjhc7P;skbai6*#EZm2sz;xjFSvXPa(AOWdXk= z;%JpSk%`oKu}%mN^_(dqQ^0*G4T#eB@-REKa{$w9EB5+&Yl^E`Gst>Oy0Lo`cb4Ca zYN!ab*q$cx+J6aI6idmB!oU!`@v7i+rHMOnDv9IeqSzA=a6Q?a2MkS}TH;lLfk`PP ze}~hWO#XFrH_#l{`E{o6T2WBlPKLJ9(*W5QiH2;=)xK!1gmjnFgaDmvXH2$>_S1qNR~=*tMZ^)6nVMyn69y zofFao=Wv!AyEHcoPSnlh4jz+8sOY$|F$6uJ++pQO8R#RnM-kQ=EQ+oPN~w_J9T-0P zMKVCM(mWjn^-XZF-qIV~>9jBFH-5Jl=)M3HE>Gdg2WI^v%gIp=x>o^&7i{@k)KToI zA7t39Odc2A8<*&Yp8+|WC*Nz)kEvD;m0$(?hcpAW z>?kmbViw%!0|XXBc|QdRTtF~}y-pU5bw%MVJP&AgNjyOEeG;BYFB_(KNy#mLwe`8G zmd@|uVG_}_hH*-Cr3Sl-*a?4{SXZPbB~|nKtVW<@UIghrW|7gR==BF=N}4CN2@hkN zSB69^1?0l{Jyno=1Qpqo)L4nZNk=1PR->3gEI2?RV@tdd=GBl1J2T{q#Lvg`6c!6g zW!7_N(}N1gUHf81dS}CJlh)Zh4g?(qLv!x7@j;TEWE^lSF|sfFn{0!DUjcbrs$D4F zp%Wm3B#Eso>wysN8ZnZH1PWlo20SzYjn|U|wSf-C)`GAWKJ~bV^#$&L#7)|skSiRh zi72|cp!|ohSf(sFv-yAX2`b( z_Yz0rY76P*-+J4&S0}6OeTR&xE&tE7+4iVOO(ZTFC#9i0yiq$Ag@jv^ZPR#M#R#$) zIC!9u1Ywy&CfnMWJU(*=u+XVJS}y>He#z+%tk3|i2od^<0G9;*oQ$>wsvf+jgZ{T4 zBcf80E`G(TtEY{&pV|T;oBYl<4GA=ciR)=*uGWYArzWO}ajf}QLdL`qb4m!jNGgho zx8~CFdye-~7`i3-S^|ey>f8+gJf>b>Srz@WRkb}xPfhdQS@lH=?-X}S{!VzoQ{MA? z5?;^T)09`kE$?g`oAE~w25RCH^Tey+&-HH(Bg6-g_0li-f6ki!8?b|o;lFlmU1}Tg z8^Z8jCsdEY%1!B$UWK>F;>rGyW&YHigL#scGwVQ_jPaQy6ujBl5k_NN_nZWI^(YsN z=htVvUhN+FJ%otA+$}k6`rJC#g4)>M{D#xjV6yuJ6aycs!k`1nIt7nvX zl-HGuWWR0g1GyWevK}-PGYX=uOCsd?;-SPS@xwB6NzN)(QOYFyY%3De`$A33ay#yE zR-IVbMZyGQsY%YCn=~i~MS}S82t5Pu&v04bh;$x8N3Ik^;(l(SjHU;K5D>)J5VZMD zYR$_@Hj#@4n%=ehs%KSiWmi6$AEl-K)dZ>d(@_!dDT^X`>YD!;f5j_%@RvP+nNJgJ zB`dgguXko6%^Nh_?JHmeW+63-n^Ygr57PTzKfpAnEu}2MWSMTbV80?opDCg=GCA2j zk|&!&sv)=)>na{I-p2|c%dUK$!E6xSY|>FEghPEBQtTgE*J08;&*}|hrE3_@5Z5_3 z?4SG&A*H6gEIZ#Y_-)^6j#E8wbR*@Q$s=v}&ewdsb!l|sCfc=&Tw(cfhi%PgZ`;7< z<-3HS%txq?L>NldP`xuW?*r$5SX-MZRoxCRQ=JtK{Hkyl9R?f0+9Ckl=T`g}f5nfS z5NFYR&^o?c61|ZA8uUUd%P8709J2~=+-~<$B3+ODa+k#68IEvS7&82g%-h5=1@#Re z;iW*eEF<+p0h|JcN684SWMp?4KO&da<_}M*2tudbLiG4C26qty7DsdKKjnVQ!oZU= zg#V z+O0A@QV)}KKzwn7u0oJvVq&oKbnH@7{ZVo`tae1Apryg2 z>Y@1RAkA?7C6V(!V5B@c_adDv~~kadCJ{%u9#VVoPk2!6@^jraC#QvT+57 zi7T2pOoBM&$*ftsv{R*AZ@W)am3`b$6TF%xX|j6yX#N#>*zU4=?4GO2nF)@$mF600 z{Y5?VttS<~j#78;_>Sd{TJssV`D>ka#7eNOv9zBy;xR$}z^DJ^(ofFn=#jhp+tl&U z;h!HONPuscI3~7_A8fP!&blfg*hh?Z;wz~9Jk1_lvuY!Q9vIoOE(%|5gG71ovUjb8 zFYV!*Ii(MJ6>IdHFsw?tGMuqJMhl$t=qk-DQP8IzJ}Gam1go z0N5)d<9;+B!fkYv16k{=itPvWIp^L_@l9Rvq(Xn^>&3LbaD#D8bgpn+a96*51(#ha zD1$mROK-bvebJuAu}NPbu@ep=cCO&_KHF#2oKJ^J5ClZAeq+;C&ZEAN%WQV}?)lE+ zY6MbGOXw#-pi6v;?nb1C{g(2yK7zc;gf0xQS@)I`lZRP+tZj`5R8JVubX9`P?{h&5 zeV;b&DZd94-|VbvT`qG^iS&86B=DNx*N?YWjN9{i!QMjJ7#X)>X)l1*m@>Hcx4 zrI(9EHjsN@CN((n24hpyG{N27)L6zgWDj>Ove%Qr!NCaTDXfK^hyB9Ofod=N+K6M{ z4Dko@Vzj?@%!u!vU{eI8Pc{z<1{#C!L+$|mMS z_4%J+!9P4|WW=yp+>Kpds3t;Fp|P6+uXetG=y~;;jPWD<97`Ur(w~F01f1u~xbU>^ z(ohN4@+9b7obFz@ekUGN&B!~Zq;82)c~ z3Pz6q%31xV4e0+RPM-dS0KtIG*$1MT6>}h;1+b3%?Q82~U2(CLs-`Z1_*I$m$k*m+ zuacr}$mj{Ug^vJ7kaC<$8J~ko6 z{Q)sSBBYrTV69(pYSuLtwomhaR!u@oHMw%%(yei{sFEQ^qokfPAkSn=jxA8z7Ds@3 z)gl3A13zbA27I2BGsQHtKWIf=v~zB99(2<3JIT(|+YM(*KXDUmE!5f&eSRuw+gQ4& zPqm(<5G}r0e$qe2yS%y9p!ws&xLGaG%m37&;s}3??J0a{eu0*1vf>%M(dE zMo@G2ID138)@aHN7TPt<)jBgXjt0=l#h>7)GBQC!(;hV`>9!N=S@CwU_kxN;Q}{?F zXT@6EH5b}cwxBwIWYL#qX?ERi6${3Auj+5ciwT&*RC`Je2#$AxcKVKP>;g9l@US~h>19+(3Iodop zaYmCMqFo#rkpbfH!HmA60&LXS^>=4yxm2(lAI0t}g`W7QHC~Cx@Zpf$hVO-+YBX?~ zAx8WfH-A86q#+9C`FKzort(s}&KZ$X&LjCRr|W)(E>Kqz&C#`6de_BVX|q#u{qQPD!{eH|1;I_2YT6?So~1lE)ye19cXlN>6%I!mquTPk-`8n^^`K_6nQSF%M?@;Iw7(v289=hipOK!PPSo7N(dqZZ!SZ{wax!+H6SdNJG8Q&Av^6rOlQy<7 zbuzVfY3k|{XQ8kn>V=w7U93UN_Zig5L?C$LfK<&drSHhIu8?EWS0nc47@zV%X_S)p z>P(*vAhoqYIj1C6DUc_(&27+oCGM7i9x2G;VyAR+`P@ypLVmGSfPjzl5P z@+9#C4y7y!e`Ly09eRnE%*N&wORLt$c$!ola{oj{VbiA;%ffn^5g19X80Zh>Cw}bAxIzndu#umfdB$apXqY; zRwfiI0;t9pG|n0jh7ju|=)k8|Bb4V-HwtP=fH;sSrDzCNyaFW#7h~7#7Nl9$a5OHD z=CL$huUkUl%z_4yZW)S8!vln2`+CwrBbhVwGAx4NJf8F0Vz&Q%UU5Gam4*zS#bThi zSz+<~ zBv{wS0?1VYJ^X7%Me%mI>In{&6ghL}<9%t?;GZd2{Bs#^l?<`D02D`F6-o9Rh)Ucq zxtz*J%#Zc9$ZuiR(2>?us@x^Pj2^^UH7XhZ08AJ$#Tcgy4=N)1X_xto3A4gq=7}~d zX(4PRm6a&_Zy;enOR%~G0QCNoTu2cmVc{GtD`Z>=^U$IY+dN9gc4JN{KBp(bTF86V zW8v~OV=6)$v@V85HV^G99Kw;2;Rd(NpLk5j7##+v$##I(Yoxv^<3$#>d_9D>Hmb0p zQ7s9_3OLUkmXxcIig79|w>&SvPhPY>9-iGVuzLb`i~TH>Cdg(}Ia71C%(5D$uFg7E zY_1o#B%cGvj*mJPW+lT?6k#l8h;?PnlZ$Fwp_H*6L?oQ~@MC_!Hif2sAT||8=g(}Y zQ<0iZ=8#EzWVU8DfryP=E^oMNbKAvuaAD#w2dYPi4ju%2Wwnsmbe1a|&b`Q%h@!}M zT<#^(aL#+fPW>YGuiIQ=F+@B&PABjy+}37FWg0n6CkQ%BB@Z z1~#9&f-rBSln_5)AE;1;tKsYX8TAoYA;cRWX zwQr5=;B9|@zVEgC`|G?Q&yct>OVe{eU{jMcG-aJyrC+({t=}{ZM#_`HK zOxUKo{>UGpt8zr`%s5j$;*nUJbICcPdGqw`bWB0>)xdo4KG2MJ_-o?h<{_D;=Z^;G z$-^rjzf#k<#&8OjYhn&A1?z>m96P7Af1C_LE2I5q|Ax_+rl=WbswJ5XEP?}UiP$gU zcZ_snNnlBh;_8)6Osif5->}T`9$>-S%p`KNL+CF06AiNsSQ4S}3qclrp{ZuXvb3Il zR1VA%I_7n5@$r&X;hMzQDxsp+rSsNqZ!vd7YOBI!DP2R5Ca{vQM%%K{+W?PDp(;c5 zH51=Je}Ba_BuaxK6J-3Rz0e|w7FOpWJ!B7OqF*MGo}}u^AZt3%?4^ z9H|!k)>ImO!X>S|v4dTW(A@&YkSC$$cc8GGY1?8l2Xq1{sk@+zls-yeT``&1I9)iH z5xMRHPi^vV3xH`kkX?+{Osd|bRGSG}(b3u#glYI8iHq}^;muiV^t10Mk-fmG|7Yjg zE$@KsVtA`layU>tDxn%{nu0xY)G8wtcf;jC*LPBQQ2hnhmRwkgows?Nl`bI$wqh60 zXS(C{3~?$>FYAtTl=dQeb5RwzrfN=_grJIVYrT%;f#X2Ym}Sv});;`)LRXHm zytf8}nGdN;+Mf-KQm7d1Or7s0W0xH6hhaO*swvU!{PrDKCM$OR>>px1CIv683HN6= zX10+TYb#N~-)4QqOsRF6^$Fe(SCF)g+AAvUYYjX0%iRkR@s9bgK2?l?y#MpD^nU^i z{Z9G+=K88jC2TUocRx^h5@r+reN4ud-9vy3hXhe?t;OzSTGs}P;i==f4Bj7Ei2s}y zeh{ZbZqnqcFQ#c~@A+=m%;=O6_umU44)3RvUEVmXs5o4cN{5eh$V@mqXC>eyfIiY9 zQ_a{>3cEXxsrV1p_dgvxF3&?1D?2s6o&t?UEWX$4r5f*B=Y}oTCY*=Ik@}6dHQRI* zQRnt;TbZtW%B!vN8J+s0WefsjhT??C6LF;L=lm6_52n!td0ePL{Y-?g+Ucy%mzIE1 za9I)fzwYuql^zX<#9d6*R_ev@X~JByITwvK=asDgM0CHK@)=p=^fCXQ-bC?G&Meg5 zeD2mH!J8{wMfuokLj$o*0}S&unyjST&| zI(_2 ziypJC03_ay+%^`1(+UEIRVZX?R{xLFDliT!e+bO1zSLhz8PB#@rPL5uRs2el$#+hGL<(tj2HXI$s@G+D?nn zc;F8GWY2d-UerXr`JRtgDFe^39_u0Xj!D4WEhAMR0!cBw-8AL2HZ=9UGYH51*!tiO zH%er$SBCmbL)hMcR1CSGRYn#9JW%9;LHgD3hxhpZ z@GKm%(nqvyM+l3)1L!-+asGfnAiJelkkie@ibGS*Cs2-?5>`hg?{eSwjZ^p8r?pppGZ_nRBG}x)C7~sdgCVJ(smlD=mqwHlBIk$Grs{3ssjnEE=4L`G0G|0o zo>@vuSYa4ckaDO{_acy%tH`@xuTa8!Fk(B-U;8HRfw$=l*U)i0=(=8pH#4o}f4;V! z8)}(Im;&Na@T44R?<7BMAKMC$jtMUJm;mcJd{Xb`4eO z)m0}Jc%SL}hwXR{j&0aQT4bkD+leZayi$y6SPCeVLFUXjxiCTpS)+?;MRy!~v6bdI zX#}XbN{xAD0~&EqzzS=3c8q<V)yh33e30^a^b!b zk#997evUKNJ%2hkRKDIUOIzK@HrC3q^A~{254F^hWFl4z$;rgNl281b5hRI8Me&s@ z>A#hR&e91b;ONMHn0vDG?|Ty3*c_s+TFi72UtA2NZto@%3t>(*L>WB$P?ne{#}w$2pF82ly68s4_VX= zm${<4#eBaJ94Dj|8V2l=YO%LFP9+J1lxw6Z^B(SK-E0nGt1T6Cwcv}2PZuo9>Z*`m zGI}V&W59v?uQ@i37D4r5&}po=%u4xnH%#&qTe4aS5>4`TGi^FpE>waNEAN!9yMo|O z^VG9l%h%K{%!})w8~QBg)@W8GGzjjQgJHRY=JNm`V{slG5~nx?+wz~ec?3I2Qc8{_ z#-LbJCDJU$zPff`Y(cnz$dD$)$F5Wm1s8;H?!O^hcvY53Q?95|>)#1O-t&$2t4*FZ zrXgIG=-MT7pE4i@u1@D@b5dmJU1I!~zP=`LmzyY^UD{3I+pH=}&}{Q|@ELf_7+=53 ztv#dfvG0FFR{y>PbD3;kigmE)*mU-lz#&QRjdeRHZa#6C{R}p?d63#$<;a}cGtK{1 z-MyRzzPb_`@w1C-Bg*mDlbaqAK>`)e=a`)Ixg=454ig)l!ss>IM%1Sl9OugTbxI7I zdAEk7o?!=}UA)DgZ&Vyw`?pT2{4N6OAPK;3NAXBY08UzYh`Fx(~BK$wp{^$MR|0E+a(lh_p<9>iMZl*cpG9%;i0*(BMo%Jct7B4?h)an_m=?O zKRV`<$z()Ok_W+%rjc^I^L%srnL2OZgVQk-+Kbd!M#IdA+u7=Z1u)-2qiq)=n0NOL zp2n#j%XVzM13lN`uZpWxD|^X9uO>@g)Byz6d$%rYo3`24>ekQI71y^qTtf6FU?QB< z(L{BIfwwO>idjK=>q(5qjzyDfdx8{AFGpvpujQ)mJ5J>wR@RzzZ3{WOG-Hj@N&p>j zB(`X(Er%j~+4j>P)}|$gz8%F;JHHsHZG^LR+Il+nO|XyyW2XHYop-Dfs&|Z!@-?=r zKUHgfj&MuaHgO#t;%umT$ng?Kdn1e$*6iOMAK#q?vBpZ?S}M$lfvY|Aj(T)SazA^@r0Um~=^{Nm5RG za;%k`kL+$xg-HOCj5`Qu=#xdm2syIlVaw_bD0K)m;DZDGRuTek@)U8x#`j&YPkvrM1Y z1I-{aZwvJs{H^>#c<5Z#}Y%efai*bd-n;A+} zK6?H5!Jk8)q1od)ZJ*&H~2y~>=@FI$J$tepK&fLz9!u@4=diRqxGVUek7i?D6K*s;y z9R$3PWx*nA8R&$;+8vF&CNoNmJtZevA@gaB_`pAKkAVjWjJ{8CiB6kYa=$9m_((eZ zR%3z*%^C6}!y`TVg$6L%aRMz!vkzdR>zs8vjHC^o9J?z9HM9+1GUcex&JD{@DDFaF zSlPqi7L@uP`({ecwt^r!z0u*$U)`n#6#hpTz)Q4)+Tf(!DQ>sIeCaB9hy^GE1~$Tf zJ`wgj0x8wsH=DNd>)Ftm{rY0>>mxBgFi6xuz+u)yo~J$Q1LB+nlF0cxDfYZ#LuRwT z+OUriBE%nv89`g|UWy%1Ha(>;`o_!=#S6;0^3Z$e`a;jn?EYmy?TIK#BoopaB1#6c zKJZrM846z)KN)n~^$l~-noUN!mna~Xn=2i&#y7}F6-Zzk^7-TD8*}cSSRHvB*Fz%N z+Do_(ZLoXcO>W8+67qI32ZiP>oO6Z6$Gk`Qk?Tu+&i1lGxJNV8d#2zt#dMBN+!Lz~ zafdM6wheX1fTVjbKHU_3QWA@9S(1wtb#FRz7G#&%(Gq=Wk+^$H-O~|gB1GWyOj##; zVbT<&MQhypThL~JfvOE=1$cmVyo8_)M>J=4d7H6hJGUx{ZBl3{SQ&bY{jm6tbP_a6 zKeMBZ_5tS&3Qgi)Q8yfT8w3J!bH%x{$Fj`OnH(Y@4p29|R|^vFS_OIHvmLKe1=63l zf#SrsvaS3YZ;7B|PVs9_Pi7L}y;5~cmt7=dtw$0uUDW-fL}?SFYkpE<#Nf8rW>Dl6 z4*fvd0$kaTI@ht>rlP>PS=*1KqVH9{OxRw{+9`JV=hD(&_3S1?@rZn3+I&!}WfpFP zN^x@aHfcIuN8`uX*;%uNfgI9+=o&5NZP~!80 zXBV>mX1Z$cmq8=i9w1Lv;}IqIw-($+H^h*0G~iblHA45aVj9OugtLACuCOd9@38II zi?&biX#lG;0x)L8)gRU}r#TsGz$F)rou)J3>omG0sR^w;x<^NEAeEvHw$jnEuX*V| zOIOLdA-OlfjDly_ba|;SEM2{;D|IQps*zq6dBhe5UDS1XBm`GK(gm|Z_dsB!@&G$X5b{&6BHwb(sd~V%W!Ga8ST5x)0sS?_|pIUB#0vU`4JR2 zsy*V2)g5v6ZF%2yTI-#vVfR8%|LGC-?E5%#bVcb*TBeQ`B3aJyRvBpII)Pe$5PGmn z7biaS2{caVe!Khk^QQnJi2r|GBpCm1sw@-3f2p!lY8y7c*#)l~RdDUxxCoRKRqc2K zKi33g8dM27+IRUE0T*O3Uuw?yOquomo$Wo5`b6>YhOLlwK;iI#G$tm~V5dy35O(zL zK?w3sebY9VVy2TV5NB{vgy>MF4tw!a_+Ua@&V~yu~lYV$5n(ewV`Q=t%cc&anz3 z!k{*Z2+`MIBmy3jkgjoXw^i{99^EDK~4-El{?^j=t8=< z{j-EX1X=A#9Wy|kd9tJ0B=p#~B&4}$L?h)%LY_(9V>B^yTgOcilqh$lhowV{%ng~K z?;Wu&Dd^m$3~usTb0CU*Dmr-^HE66_kYSyKF+(hOr(8c$LTr2fj$@bQq!zC-1vChA zEvTcqTfmY5u$X_wiwAI>8D=*l{jNU(mZJdbpD0|Sof;b7XH}OX_~=w}PZcDikjJ;v zTTwB>KwXz?+FtFBij6>=%ao8Tqh#r z(Duaarifw}p5dvs0m4C$rFpb73r#h%z;BsPL#FKFq!$kj(&u|})icKC>fR>#J&EvE zNn;%ieqm#*KZIA|?fK>DN3n>8r=J9W-Kb+?u0WTc0b(Jv4*>7e+PtQ>f`D_#vU4|~ zolpGB?83ZWWr)9MZ@|OzM+FkoI#~^H3KIPpMtz7xfsn|6RMm6BSee{sPcyRo0YB&E z?g%lx(J_gJKYC*cn9qF~1RyRQ;bj5Z?sRdmV-TQ5UkK*p`FLx`b~!jW7(`85B+^p# z4UlY1%s~q)eHmSv+M5FUKXYdd$t}Mk*)lE}rc_N>yV~DfZP3nR$?oPK`8LC(0t%KF zQ`bi8rP0!|wno;PMgKOTjCWmEr&BmabSGU>j>r%-lMNQI?g4?|k>t_g7J9J5c zEC2RwT!^Axtcv#W{vtsPy{(e8nI2sDyAv{AOdd`A7zn0P^?=-#m;z^Iv5p0GXVzOM z{Z|?o|J4{LC#zUDdTP-bnV5(r`;^Zp^yJ|u0+OJ&Oa$o7rEe%D>J>vQo_9F>MC1>d z$AZ0snqMjDPKlkGoqjlnzesx*`A@ zs?JVeD2-24yMl#?sC>XOoO50VQ;n$Nzz|NW+C=6|W=_vLnyAG9>HqxA{-5@_3@ra` zerZy(w%ibh|Mu(UUO(OC%HHHtnV)~F7XDd+m`2bE+PlCI(Pm?~aI zn2->>Vh9VV0lHeIeo3qhzxVfZT~O1JG(A5IQ6K%&%|%8hxQK?SygA&ZnbQ>8yc z`T-P7szCY0F->!9bd-yt690MbPL?aI$-g{px$0C@MP?tv_ z&6{!Vn|aL$nFGG0j;pffw59~O{DP20_rzOh(W48@T5vW{}t~OQPxwoSx+g{{5S7 zeB_K>8x^mEh-1~39kaZG`jb_%O{|*ALbjk%(yl9TCW=lO1G22+)f#&bt@Q>n7s8jQ z{X{;=B+QPj)fIqSf4h|R_3XE%`K^_bm;?-wuuxk(n!wQlHIx__C%V-CRu~t>j^&CG zA3@}$ZB4sJv1j5=alg-R_roZgrCcut4u9>nr|80sPbqgmSdv8#gu7(gU$oXC+;fk_ z_D?^QV*qf6vFUF{k{WS$5vQst%Y;r)nbfwrnlvl}gAW z$p)dFPq@VH{B9Iqiy5|UjEFk&y)g}thLHf(A)S(q%8IgH+pR6xWd+(W2*I<`!(TJp zHlr2~-JsvHZ#Uf<2NMIEmAe+v4~?y4k8vOR$;J|aBu(bh@824f#x~C*mj?`59IZDb zoP1N+|AGDX)(~(e4z>IW>@|H(J7Y~Ykow$eaRJ8=p~1Ag< z*tYFt#kOtRwr$(CZQHhOXT|2qy4mMkoL%+Rt^FTnb^ThWYxpZl+cJmL-ZFK5EwxQ)5S4JcU_LhC5*)!iHJEsg%Toy4Q&;YN75<8 z@D_%FP?UG3g8`T$-5=I_)hyOL38Y%uZKwzs#4JoFZsxPdg{NUwZD7BF zw{}!#PHEQlgajO>dzSpZw~H?fsbzjQ??~bX;MLAJ+27hme&o+e##D{=R9{W*2|4IY zk^g)ks^Ic=ImQg;>g&+GLi^+o#i7f>t3jBVj+XPVAayP5*yFA|Z_iklyQ8rMYV5rV zun}2*e$KQk*%4rL`o+Yj+)39+w=aYiV3rv1URh@31RWWBB2w>BQWYpKXIYJq$p|nK zt+UgNEA_F|Y4=Abc$CFFI8)quvNL?F{#;W*qk&7asIGdD_wBmRORmjjSZt*XH?c63 z5Xi{;mxncQJa?uIIij8NC!a#1|E)-9lHvMrcIfp_U2M%uQgR&Yy4`G~t<2%rB9|IJ z?X)Zgf7kT}+K-^`zQS`a{j75R)D#3}H18Fl?ntu-WEHAc4QeO+1s{_ZU(1iBmJ+nx z{_&?KspnUg&XxdedRkA2RCvszbC_XY-L3Tu_xl0TF|U7;&TRy_#LAmrw%dMw*(-e` zqS6(=bp_<3{;STAx}Q`uHV=}VX@b3fd>+UP3e+ecDwGE|il8qo%BRPr5vCV8IWnPv8Bzj)2B>8J7b@b_S1Ag5_SdP{xS_Y_*MO+5>YpdK0 zF%x|9mYFG#|CN<-NrH;#Dq3SHB4&Zls}t%MU_X?mZThaOGgYu^{NG{|-0KenI$ka5rUZ*;7kA3D|+D~j)4-TV>( zFya)~NUwY@)#BEc4KW}&ug;bPD*(m4rNH7-4gtL#FxUfiG zVUoeSIN``a{8-hk^E8vE--)6i#4#)pscwi8#Dnpt7R}mvBS?=UGY_xfjFHKP^;^6= zey`tcB7+!FO@`NCeZ8Mku)E1yHX7>;aev1zbG$xUwMm#`)IMt{(UeDIsGnCz8z$+` zTPu<4NDr_|g4;T61pp$XUjL4gP&>X12cbK^87j?KGvM>iUQI}?8_5jor|?Uc z3K&7%`H8wJs4_K9S+0V+vz&?8WHyL!nlBh>xD=ocRWqg%4T>itgpfET^mr& zTBA{YdjV=TQO()1osy;J>Oz=Mn8^B(8v*{V!5I;V1=F^EIeosAorKVHHy(Nz0H9}& zd2|7f?rz}wyIwXt5ao!5uF+H%jh*IZD+TNYT#Gatzt|o0Tg*xVml331RAlqlBcn`f z<8S=!X&w_*CEVo_3`5E1O6|MAP4=+Nhv%d zMAO2h*4axkI#q$LbWxo3(O=zFlQm235KTE7^juMan~KrrO^X#51X;TIO8`Zcttle* zV;batY}1TwN5(?@H`kA?(AB9R6Bor&n>p(k4per6aq>|h4~tS%Sd(5;A%YN(C?!K~ z(AY|f<}$|p=Yl=Qx33Ao0a9%V@gYsb_3?!+^CNKyflY#=0Rj^?iy%QK{3)QUj>BPg zGd)#KxU5F*56!M0qVPbot5_|v%fupM2qwLaRaql({X(GOVi8V_9^+SJCD34q1=7oe zf24vU%Fje(?Tx5z|FSvXYsLtQPyN#X+5MZA%shlf<6 zP{}2#B@=dYIvsaT+sTS|p4e31KPqiZV{|!x-GCX9Jb!$nI0flMBl(3w3QF6~$DD7w z*p|AJj8__Fi%uqorA>~v`^59h&ddjUOEz=Jcz(1KGY64)@S$P(kxp8%9G4N`qZSd^7wV39!h zsLB(4rCT-`#(4ziIQgxf#aSL+dplG`P;jm_ye1NH5DW)^LyII#`~89AfE>sMmn7FX z`_FK&I2e8YQ$igNzpdKc={IUp=7U}q&)Pia)j7X88CKUOt9FK`5ch5LTnGT*+;cfk zwPHT7*z1t63yX|X9`vtx6HOd*b11zPHYKHL0VTA-?Qvq6gF?#QDls5pNS!+pgAp8$ zzHp|mWTslxcea9C3)jihj^5zu&{(LX+l)YEV#4EPOLmPR)uLoPGhd)JS(in9_A1nj zGGW;jCW?fCopb68JwR0W@LLYs#h?5?;ptzrL%***#-m~jRQr3`jdBZ~y3JeMYq7!2 zmed)eyc6SUY&K<4rcryp|-+G_3wYhL}Tq&O8nLs&tlQxR@Rd(cfPe&@MJ$ z>;KdRnEoSBJ_9QU>;L4>)@b~nE`ZP)HmN@HKuhIwxe9GM${gB)>uxG&I|qiazh-zzRnZR#FB!?m8VR9Z|ISeq6Ven$pakGFSrsM>NVv>N}_fQWZPD^i{`^7u$5I#+vWzL z0Z>tLoOC8zttg5W8&EemTbGtRBu=wOA%ENSWmrfdZxA9}OK9BUrAY(F`U!~8#Cuw? zZ6|eRtAi4PEg8w~WjD=ajF(o;PWfX>h3wY-mMd8u;&^)UG)b!k>fs+>;__hWQ9o-J zaMZ@Gkta8YA}QefUz?!TdqdPl%QUoDuU<_x(?3!$2G#?I10s;GKw`?`wn{p1wtd(d zThFXe3UPalZIhb1_Zt9zcCe9<-5q|80S9_=@c@uZ!K+PvPkSxqBCs!Zqm5yCCRZe$ z+^!m0+>b^miI9=Rk}}RJfTeQZ2G_u>q3i3~dA9K_h9q%;Mk(p-q~(rf!G`vrZ2p>X zK55p8oaLi0iR&iqUkw& z*I0@5nn^NU#ja}2TlysS#qQ!Hu%#+g;jm!=UA$U_XX)Va;V2Qxz1iE*3>VQ1Oy=q+ zK7%q6^movMwL$uj5+zrejF%z=z_!VvT4+L6=@B< zde?BUUxt#Z=)=#Bh+yZPe;c^CUs$X+>z>I$acDB3&Le&0$k_GCFXDRo@Xc4pgEaAysJbT2_# z=cyq$XV{r=$>K|hd~&VpwVd~OuF-}_Knp2z%qxC3EpeE<9DnRAb#U&q(*)6KWN(tq zA;PP;pFdwrZJ&;8WamtHWwzazJ)q%d!^fS~kiR$0X+b_&mtITobD=wLzieiqnS0S~ zf9d$~>qn2_cL4{!Upzkf>$?rS{=%1Ba&Plo(wQgmM|O2xNB3F8ep?2Hxy}J70(nqi za)Khq%yBi_85rP=mV@;6mK5(&0{Xh)Xl_+vh1Gnnln|5!IIx?T+YZwgFPD7(L~t9p z|K?>g%=~5ymYMZC%^lhaZ--7cQJX*#@Q|J+F#HX61Ga)L!to$NEG!((c&71(inT+t zA*D%AG-|LuZxSMdf)SmaH6v;J=cRmns0Id>4^pad-XbFR*u}N zwxb&9sq)=u#qp&`>i&+9NY0~*XA_@)5coYuHUn|!s%kyjMG-H&2B*)-&qW= zc8{m{%>ejE8r~O!8tGY4HCa07xn>8k>qo?DW%C;ZQ(%Mei{%c}au7jYHW->2nPzu14k& zLtPt}tl*#IU#g>J4L&m)E^FO7-L^|Qes^4EyYVf)?BgOS7ITEk1S>!H9$l;aearjg zLt_{hcYQ`~@DYzD?u`4j;~LIQhWA(5AiK11%JjCbaL?}zpLf&}_8$R=H|_|h4xCv06~ z;R-+xHROjiSg#Jt8)KD3Bg)sj3--vJE~93QrXu(6z7gaO64ruL-!g>Rk(&526|b)-85d< zVwFAfiN)^#o$&<+wL@A_ATf~_w}3|Mg-v41RsM9=bRi&Mrl-I=`*f)a7{EX>up1Xl zwN3@~0s( z=j=;KsbC%Ht_zhD-IF$2_r<*gY(`k!fn11~?U~#`BiP|+&_jLB83Z~J>Z_}3G0&m` z_Gz*=F{y+M(FZCk$Y1n~y|!1o%-zShu{4a^$^?t@VVxL7^sUg_lb;Q>?(0tm37`S+ zawK3JWicW?>P+)5;m9cWi~k{XP>Zoo{UIAGw-bWuNIzbDJ;-FVu5gIK7rvKYqo=So z?i*kpNKYcLCn-$yHM)I^seM_2?B`I`5`#X$O& zY$PGV+!?!5&?s|vexgL_fWcb&BOLm~j#>S;Pio5G?j3NTl1Hk~YVMmrpA_C2^e<2C zg>n@ep#qQu)vL{J925v`3Vc+gpDpgDW$3^k2#8||dP7D;z{00! zs6r)9O(5dL@V%bw6B^f^!_TAZu0Ghhu@mdV5u{Os^qGu!+rgnE$T@sFeWC+Ktgtf& zweRV1SR7ZT7sV9KQL1UhKqHEJKSZ`sV+e@jJAXBcf@R)HsXZ~2wM^Z5d zN1cs03<5WOjR5qI(H?hRwVfVXnOXUWMqkU!#a=?c(1!qxY>kbvhQ{4Z_C7@U4D1zk zZdFw$X$L5%VWzJ;Gg|jG*6Y|rw$dJ5RGM8epSIvlFks`2P|Dy#gL+{mit%7`JY1pc z7b^?#T@~6#7B|?}9jzS8Rc_`dFeeo`uj6T_I?dafq6Msx2p8YBZ*t$d#=1Cmqksmc zVdUO|De8A{)$U#ZXX#jVp>~`;<8Ko!4QwvKvvgp_12BsHy*v#;09cIaPhD4>XJLhK z*Ej>a;^m)7pDTUExxtEWIim?X3Hq1-!_p3B0S3brf4f1kR-ZVQ+=6sZiQ<8GApq71 zmHZ($Zf$o`#id^V_zUekfJe&#UDaEm0%Y(uvLk;!6|=SIF1OU_H4hA+zX3uLRrq@l zfgtI(3H4;uDqzsCp3JfMS3eI1yK z+TQ_%_D@VMMW9gyBmuNfj3iOt_J-u!HQ6GoD@=F71LBG^Boubv*cFowTT_Vsd!~Zx zqw|FZ5ijfz0yQll(xMXsS|VHm!&giKXwcU^ZP#S_CoUmjOXrsM7$GPggajI*ME|ue ziY$&KxUHuacp3--1GNiSBZX^RCdEv~_vm}v@>RQTS}Ax&=lfU{k0$whzVjR|OXZ6S za;k|_H}!Q(#y1b$w1t67T|F5VOA)PD2z1m9#Q;;8L7sp{0_X`TAyUgY508nsl$Y-| z_O5_X8)1SuclliMtg6ahX;-%{%LYY?OpqQPb5LbDM{Vd4l2kC#pPqK-z&8!=#&8;p zYS%`~B#ZO)Kma+K=j|8+5g+g4*B!G87cku0-5nf!4nQ#k$z7^HQuoRSsWAU_+z_f9 zI}`?~Vs}Xy2#};M1dfycazlTFhyCzhSe%@QvlaAD0yd7)bjWQAwzT)vVyD)Dr&Xe_ zZd=W)y-#P{dpKN^-)CKoI|M5bB%z)@RwWQZTp?bkKZo2mmyRbzJp42$?}H5HkIgLE zYeVS7LZFBjwnc;_+tw58uA1EXB?QVPI~gtb0QtTfc9gacVtE9y)>Y1ZRjz1+$gZoM zVhU&u4#B4~5AwZhZNwgRs-ZZ0L*xq8pqD(hmoRcjKtQ5u)p0<#h5fGz^!R@i#7Pd4 z=OBT|fuJ`H5SF6^^htKS*6~3&mk8Z8^btU9dv>p?pVw3%AOFm_?!K5H2+^WiXA7j6 zJXS8APMAQ7hx4rdUevKr<_)r`XP$?!I=b!OECSZULs!g|hYqW|C zSJ)WFpY&=AQ^Ic! z)brzH42g!RE98r7R;TVB2xlPWJQ34jNz8>PWWJhzF?P%zyeB}us=)xACv=>q=sSLH z)ZD7%E(7x$ChHmL7J*hg7mUKM?6#;HtYut!=~CI6xD~@BxtYACP_qqkNz-W{2CTiB zCEBCDwT@qJmZZd^ZTvlfTlZj-vbJ-s&jn=#g{x9kQR=T>$G9{E1!<_3aKjiB{M#05 z5Z*6!B;(UqDqo}G@iaO;@z;5dbfZWVw-hnC~E|z3tOobZUAX&zVwQV6yy< z(M2H>^E_kLy@T)Lu6d$CL}g`|%QbTo<&63a2J3_OI(-m6fSMspfAW^EGY-Jro`ajO zxI|qR1TJvb?1tV`bH6$Te9r^Amg(6G`wB!dPZmCy<&lzEuZCwCSV(~3pVAk{xSqLZ zAXE#8ui=7+bW^L@&yk^U!Oqm7g|Uv$AcR0-5`BTo9%dXa@W&Bg6 zX8zAm>8vdOR;g$H-y%iJq}tGfe1*rwip!b;$a>~w@o4~k1TkMcm!!_60l#l3iblZz zr);ad|kCbHKjxeI|E-dNU=HbZX;qaFXgeb?Xgri5!zfiA^wMkPm zVakR*Z|?6_f|w$b4DLUi3YYuuw0~jK)1F6lzP#_ly51@}dTcD6W|rJc+MML{*rK9; zJNNYc`VFdL@iXtePsK38u*P26&?i0OSPa(ELYL8Vrqlbl2UN~B{uieS_wCe@C^PP6%?i3;u)lvSVL<5C%D{TBD-w%p}t zow-0s7*M!V@)8b(Q8%LSO2VN(dzM301pj4mwnkA|j{4kF~70gHF66h&O& z1YG;q7X$}x0%eRbZ4hk7VDhjj@gUrYlX*ry&`s09;U~s=Hh=WEl0Kw>HVn2*E!rt^ zh;+E9Bz$@wDC2fke?&j&x^Zw=`-+%tocxfsAc<%okn$v=5^WY@Bt;?+y|^U;zbV5_ znefNKHIdmxuWlC19fPT}IIDL!*ry}OBq73RO`foaXn(T&H)3m?dGtv(kbVNer0_X! z0OnxAetq{*y^R8TO+!odB;D#cnN~*K=y%mskqIujls*aJ30I@`e2--ts}@t@3t1q_ z>jvKW$5MSu^-Iz;%?&v<31Kc*I0nV%SvW&_qGT{>hm@5yF9osCsc=IF<1a)tgMK-I z#lN89frK;#IC4w}N30z6X-2}$KlkH50{y^FLknhE0p=i-vRsI0`#-;Fc4Ex-7ngiU{`u z1$&qi^lMo~)NC(J^sK+=TIZ)jlgxabFfl!-954-vE<}R}p6D(N)p*A{rlNF6hhC$M}LM z{Vvy%o{a=93eKI8p*Ol*5#K|b1+GTQg~Zms+0RucRfM67$(*{xP4Z$P6JYG5Xw4VN zv5zbWQ$smDdmzluw|@t~mj%k15MwXW$UJpE9@@s>oo+i2ayosdmlNe>CP!X@!J6%n z2J@R0ujOZa>^}hN$&x9qmGvTj0*kcZe%>cI>wfQMW{M7>Q4W5GH^NC)*odkk%2fGyzlGcfA}$>ohrOUioa?+xl+eDtqebvv@%T zfgU4iNhxPsTVAI7)M>U^>Xa%sY&aB>$zmbt|E_1c*B$QU2apMsZ)*TIvT;k}AZ~a9 zKuTX|Xdb;10z3MB6>2CNLrBa z@*_Oe6ZCPrNP08`d#e_CV?%ZrJNhcJI9`9&vT%eX0vjPGPU@{KHWi~Lp*4)aNUs$u zJff0?;l99&W_)78&y- zD7%b3OW$esoF?*|A&WN-k5DKd1`$_7IQ<4?GEM}=(=Jc;vf7vb+$xr$OwJ`A0CBFk z{ir=52bO$Q{`WXAIrzMtoX$3=g;~+^jJB@9;L$j#HWHq`pHs%y%T8a05BNVx2-%tc zGgvv>zXyK*H5~iFFn#yx5$5ZW&=|hUHeiD_>i{+5N7lfC!MK34vm#r$Sg$3fwXDbO z-HSvP%eyYR53Qm!5G1+5HDC2~NtUNFUw4gTDN9vKbu5^PEIf zCHje@dA8}O_$xj-V}(ZD*weHqvj5UnN7e|eLe=KHoQJy^$b)rSO4-B4Hej%|*AP~dyEv;~` zYgbbr;nPiW?(0f3Q7!Q?Y8KycrS7U9%6PQY=e6v)ycO~z0a1nNkOi_2F}IuQtN}SJ zxPSj@1qeW~c`-EV&{HdkiAZN?Q^y1I!)^kLQ;wp=MR25oTRaF$S~E2{?g<@gi5FE{V>)|b=g{rA<% zg%$n@Hq7# zWp}U6sUOisBr9m2-Ygw&b}%t(4FFyx|AjjJ0=|g#pl4gsSY276s+uXaTSz`TdQjQ2iV-L@6%X1HoaV=sYy`> z>~fYh$|#5ul9L5Xmuk&acwIICs45KpH2M)VF$zf*(N0PP4|S24mIiV*zEM{mGHj;C zWiE^dUJo#&GV=(b%p3ywm+I2km49o=SAD!%Hq3Rs0vEffu-mMHhRcZmhHjdQiZ0EJ z+qa9x=Uh!kGictD!1HEblq!301KeM)3;i6VvCT))Sg$X`Rx9Hu*@RpZP^q;76c$~u zY+<7W#r2QC7my{A5bNzIestXfAX5avn}Z3>fxe?jfbLtyFy}J`k2yEcNd!VXK=5Z~ zki9j7F5+%_WA$;59dED&kfdMy5;>i78FiwLWe91iL{tgAd{g<8n>D5{!+zlg=Xw+R z6PO(|H4*A1+WD$;b<;8wiy@XGrb^|XZ6{E@VQy+R6SQF*VCbBKOZn#lfl+XBTI8lx zJB_nF;EVV41n}vK_BWl!JbSv=`IeLZjB1+xruQkB^e<7Q)}7lfw$Kc-YC;0i3h45* zEZ{eF7gVOvFScD=)E8SpxcKLfxi#Gc@-O$kI*#}!dISUJQA|+CuU?Gx4X@V|{YF`O zNA-{k;Z7S;=V9dlJjHJc6{MQCB9LvdJCC#-UP1M9K*L2Sul=7Z3H0)3(nM4)bf-o- zJe+vzb~C0NIUA*zLs+#auMSz75HD-M-7qH{-5r#dA{~+V`k|4kq&&uM*FIv)`2e{x zX;X7A-wl(=ce1!P4Wo$u>QqAX3Y&zkG-nuySjJ;!3Tx-xGTd`q}i#MX{PaUo|mT zP?cdAEu?P*_gRcV0&$5~-KvE|0=RwNGRvwlkIPkhc7Z5gm{o)Wpr-p;TlC$c594hO zFikZwvO+enZe9Bs5(12(D26kzj+6u>Cf|u=zw%k&8bOs`h`VtAK(9zdg;(Ym06YBP zW6Ed3z3oxygzPZ3$Uv|qbGsm%9MOsTL|V}e2exUs+ZPD2q8Fjcf)MTvkepn#!#g6O zVPX>ofBUUKS$w4QHkTch_yj0_lE?XVHTzlf9p@F?^lcy%^n{LIcsx9^`2pWSta$z7 z!|i{dvi?6bEOvIL|CxQ*(a`u8ui+e(W(%G+7~;1ZHL9F1@9JR1 zu|YlcW4g#qq^D6%F6}72biuht{v@4D!Kj_rOQ@M1rm^L`Jq76zrX(0!!)!`)WiF4) zb5$+HfyA6KQX-JVDAW^aCT%TEq{;C~B2O2Aq}|@_4dqZA;xLdaQi55j%0!3xUZvo) z31Lk6yr@VIX5an2M1fG$9+gb%arH=D9{d58S;k#%LrzQ^hl0cY59{#Hj1l1h zLd*}h*+}njvQiaZzNX1snmwJCv==fiT%OpGff>dyBTx^S{Muk}QsC7|csmLmNOf(2 z2m#bk2I>M>BTtwtj4b_52F)X$m~v3!vbL}_e1S$tk>VKA_R%8hsi`ENhL> zRi84o#eiN*C$wE2NIe;^ZpRzV82p8>kcA9th`<=n82L+tq$!pJMS(=gKCxJIA)S<{ z)17Hny_vR5rh$epR67ip^PvVCO3r4x%b>y*R(wR71gsWd5HxmKJ>J|h4~^6tey&yp zRS*v7%RV#ar|X1K%26GVeI3SDFA^#D}MiZ*jZYGW5u zV>!2psNO9i?aJ3i=S(N_aOtgp<@b`kk84e}AfV<9qV*i4WHtKf8}mDyL454X{RuXNef_fEMNC9x%J; z**!GnWrYX~<}V_}2H&b=#ltwz^7O!G0QEB+#93-4ns~KLhu?RoB;ts|?m;2MDZN6mU6j2>nmeh)mbQwNh6Xv_nBlgupli(oVU+-o?~k?!C3J za08G~>F-( znx{7BlcwzkLv_~K6&`|%ptb$_lfNxDax=#$L2Rd(^)&3|Jxn~%d!W_v1#Lz;2|aRuea%Ww~UDR zfyPH;my4TvXi^l4DpC6*dZY`HH+3e3wH0)?=2RSfj8ZZ0%UpKaKlA$Cf?aP>R+CIy z5(L85#F7S0o@-1Csgf3*gD7&4F}6U0!4oi*BW(vg-ns?!JHI$;Sa1NYbVkd)08VT!!cg4#^D-~>T1+R}iSL7VBpxPn?im2o8gIN>xFjR@Z2nE9%&dIjkU013M4Ld{)Ej zrex%c+&4p`x*-N16Y8yUM<7`1srx|l8|z8et>n&S0H0yZe$Cw%Ok9v_pt%_zi{SnR zm+s$k)kj^F`me2SuSmLI&}nxQ1*F^(`2xnre%-<7z^Qk~_o;VU1{c#vVZvQ5o^w=R z4ub{`>^RxK)y7{U8w@BCJTJ^>d=k--UT%{8;5+?z3E%?skwlQqt$| zzX5h%13DZhvO`m42-W(|7z#ETZEVfdpX#atTs8p$^caErr*taBQD{r0MSESz_HTBt zuL=CE+@6qX=k0IJU(S6VkcKc(9=f`9E-r0FdKzpin_sL;M2M5^e}jGto|NQ}576Yt zG-|=NO{RBQj0Q#TI$e#7GxTb9qwAmC5vFJ)Qw@II3v^CM%Q zIKY>c1p51E>?G~mE!pcOgOpuFRcG($lBA!YA4x@)SarSiROaJ@WzsiEQ9?;Jr-o@n z^XJ4{JAtuB*W`}!)8P5$_gSz(ER-ey@Uvk+gYU(hYAUzSr(sjV(ERf)4Iw8glN_Tq5NRc4dD=7??~btJK4G=+T3Zp0EOo3> z1utuVNSeh`>>ZPwTYhnYyfkGp5F`-;4u*f03MvtRO{oGs zLfw);EF0K?3)WH!(lAJyrFU;-nNW{Hr6?&iRI-y9_q<}%(j@#wOC$6AV`kXPa57=$ z5=l`ce}$gklG}CU;nTKlrl)o1%ljk7)O;|xdqoi2@#@|8>HNBilT9zzb?DWgtOYB` z=Y=(&R9^!4=OJq-YX!UcFb>LP`Z-QYaWmI9@voLk3Ksv8emO!kp^QLi2<;!p;GJec zTkpBsSgx6C@a%0>Wa;w(4LCecoWR`S4H9A^)G%d(;>R=8H$qNTl)KexV zP=B*xpe$69yLr;>04#?_FMmk2da;oa2(KIX0Yw6C2Ogo9q27&Z@r0WdxxyI;X#R3c z@TQOXXs@nC-JPo!YNEx3NfARx45s;^h-We7JBjZQ!|q8C38t${+>Dc`$aWn1o6no> zEj|5Nb|mLfFNW7Mw4L4G*MJzmi*!~>R|2=8?kS*Dd^-=K}Dx(nxo{(DeheU8! z8ev?xU4)7x6{O_=Z*s$S9?dSJu8zgrY5KJ8bV=9!-3`5TgIEC9S&V5dW(-sao3v38vQEWk;( zB4W*!EfqM#fUPqPf`0(gWKX1JBM7Y^Cn>X<5b+7}xwf-#!#$WzkJ4W1MAZ8unnz{j->N)D!aW`BtQz>d5VvO< z8%}^CHO$_^;NeE`P?k{6IxR42iZP>Etp=TVO#dX{_lY4f89`ztvM32$t2~g+HiK{z zJqlplaERWZS(eqwHl-vTUsXAo~g9UB+?mjo%P)%sBv-4T@*%(z;?pbzp z`~fMl8T%2<`@lXzQ-TUJSoIy5inxv_I2r^E6pJmo;43>u5mH>}L&TSDR zbkT5UAow_v)KL$lM+_UI@h?}@e&LUherAL?cuG2*p*-mKJ&BwSN>-)Q)7Tcb=N-AT zNABnv-OgL{^zOBOBm2mvF2)9j6MJ{u%YuAc2Oo4#+B*@mj~!pSGba9(GU)IlYiIY^ z#>DDqI0*2uAkR3xyQM-zFv8QC>kjE1mA z9^Tlv(hrdGw|_~6hp1r$17uO1`~Eh~EXuad%i-pVfL0@*JG(w2UUNRA-_eKtthC3% zLi9lT7ut0S9qc+kkx-fA1R>!f%<&98j%t5BAqHr!-w$XzB0MK$HTm$F4u}3S52hz% z>L0fjeKAW)19M;$vSz(bq{?)_s7_`&*PnJsKaJIOdzvLf-hnD`lh}seoLd@?Q)C~3h>=QlP`*4nP5f%MzN-lGUwM$hm=bQap%(cm$sH%l!rHy?GaH(MZje@e@OaS-gM1w zF|K^aX(~Y^Shx@gF%gC0^@D@Fj{^GeE@3PblaD*FLgpLdQL@MJVofepwN_Lf7MP#i zUO^9}5glh6ND;&S<~;t7%=w zPV8%#JT_S0%o8Zbq+3UiWIx3=L7Z%VcOlxC5$#4W4Vq7$-qCQym}$U7@FAT3CYyn~ zlw8U%Uqxi%ZXF`ldr}hWjd*J8o5z^kuRG_E!8Mlc!U>F z`n|OVyt~{ZwF62N+Mp1A#;1i9BNx;v_zfrG8|zP) zFmDv6Z1UpY#J_;|rFFZv(7>m=mLjIsB%&@lHo05PV_Uu zE6q0B2C+bKNOG8`()GnDJM24AgnF=29;G>0b;dxqnBag=0q;MxTtLc>!*L#XYE^6B zqWn%HfH9HdZQn9iF|kEbj@lUCCqkcBa|J`=00yoEJ>VFlLbL>a*~pZ<_fvW=$(mdm zs4fUAe!wG?8-RE(7*mWZSTa6a_m6I!8$jTUpVUUvc@GmYtZ(Y48IW^D;9A$YOGesJ zi*|0MMis-TI_vU>Ohn>nX78=CVs&W>f-vyFLwBDzJo(8UU)s`(@qcBM@>73lw+{tF znZPB@3t7|mGGE?8<2v$^DTr83 z8ouzf^TI*9q9;V$Ss@#v0ZQzQq9jMHfrtqCgGF!WLA=~1c*ZzCG^C3wcX8_FlCi~- zyIU3X{7wN=^Njvkt0%g^5wqII9-<=Zc*c8V_>&$9INfo(0rTWR0%BuUz+AA-?6ZD> zYP+RW6Iy*Br_?U1_k`B(F1YV)kzJtarR=JTU!@5n#4hU-LL7mZ^E`8FS!!?+E4XxY zx+H^g3$T&DNe7z|{NwufAT8rhS-RTsL_LzUtbc6c)T+)_t?ft3Cos{tfViHsc9w>e ziuVNv9fq$t$~DjRB3H~=frndhqWH{F6Lps_0-WuM=?X{8tn7(T`BAP*e9ktVherLloBq5 z>wC~6Di4)w$LARc21qu|aB~a*)!V)_RW}P`wT=l%*yb_H$ZViAOD{|M_If-@<1s$u$4cP zH4G05Mdzt;1E_K2xiW=xY!Qs|$DeZ`#CWl&%O##k6eV6NI%H?s>mfhU^<$a-P7qdn z8=COU^7hN>b{9epR0yF?+~y@ImWB{QrAyj6rSyMF^KnENO$|tFjM3 z=J8R99hOFCgg~F4oS&D0j+Z0OPcT1LVKkt$SKgL>r^~`%)6L&bAln*4nN*&fg50iU zu_%yyW5GT5fKVMIQ`}aMs2UNR(*rpnxwmQx9)Ve zj(V5tgr${@c0`U$AOjTm%`I)I9gbO#_n^aXtM2NUcBkKxlp+wCtXrTN!{Cx1n(Rao zXoUa-tON~%02dLh_|8K(v|wMDLZ?aoQ_U)y~s*kz5)e8>e`N^pf`QN zpXjaNEGMvZ%OLv!ml-k<&WNk!mMK&z<&x@e!JPiHg_qG8F!4r}j7{)(LVQYx7thm? z@~h^A@f`$|!Rp4~z)q|1-&7Tvnpc~i-^)EFL;s7ha|+IM=^A!y+qRuNv2Al=+qP}n zns{PNY}>XoG3U>F^!>YPAMDfn;O?rf>R#1rt?OEJV&MC$6iY>s0TjiXJu7^brPvXx zDMp-@t)23=Y68HUg)_L#6JQ2m5X%Y;%c2DbXwef&i|I`WRFkyGOn0}j<1-r4ZX8W4968?(4*?vDKQ-s>~A2N`c)pUE3Y>P`hI9EC!Nhn z&w5lD4yGC1c~2($T?8ydDCKs7rgY=cNC+Yt@E1BmoqzUlOpj$_&=Imbce-s1W5aeQ zGN3X>QHRGCmNKDm(T*D9cfzhh25+&nSw780<(UzJ>L0@}`J;4;-KVui+1)wU_{p>1-+*iX&WeRwYJvFXasdVfLa`()!L}Ju~$~Vl? z&2TGH1g>Vn1G6nO`tj|$IOnwD%gEZvIE^mMlTF1uYpd-%V1K6FS&@6+v#_<{oCa`F z?cCp&ZT(s})gJ9?+o*Qs!D+=Yt+BAY4&$>>N=r@PdMnvQU+Lt`q}xqsTt@DU z_m89^%Mmg`67D9od78~#l~%r2117wjuQ5r4{|y5*$P}5g3>w=@+V{E8@nlp@-NjM$ zF3uwk)GZ*m(SJ58vf?D8&1Qu&hm4@I1#w?uD7J?m=`%1XZi~nYut5-t)Y3jROx3fm zY_3;%n?L;Pc9N)+lT}BzOk<^rK0eQndnY2hCo5EnDzkr{=Y~uiLh_ z+r%0RDI3eP^E*?qsVFC-P%S>YzwPR(ydM{LjI_hpb6Eo$9?zYGf4>Gq`T+VG;WdOG zuOt31eT4DvpLYSq4PVv^xgT3M@rdB87gL`4gajEsp5xBLXqr5HAeWjVzgNud!!CDD~fA)6gl6(niaFpOca zNo1&y#6pwg95v}q8+!%|!NUd7@CE;g5_ceD}uj!uZ za3*IT@tR|=3&*phj%<(`{M1R)FpHE@!=BKtZlbGiDqgALIZ zIF;$ngajC6A&NA6D`Uf!R8j&YnzcHXbvRqwNAtuHV>1tbN%NZl5*Ov$bLTjlMK?_9 zc1&M`(0V6@x5@UTwnoy0BJF0?-hXnJ5-W?AU-|PBe{##@p$Z*rS2IY!CSfVydLg#X zobY?lzEP3=Y*|z7+?w%7uDMV+u{vqe@t@4Z25&BLrKUD#N=t1>=TBZ{WO{Kkd5} zc%=1Rv0ZK^^z%zV37YZrP<{0KC3Npwy>7J-4E;CBmCFjfg!+xWpBk-g^gzb|)OFF# zcVCJt?^d}syEh9KG*0YUa3%~mAvUnvIO8Z}oP4fV*_#n(b*P~?g&Eevqx!0&M!|Lq z{Br%(+mEmePm6jIa!eAHJQz`EBMv4exe)`Y#-AHN3LtO*k%Z6B#&QvS6J`)>j9uiCpN3Qu4xQ6@9%ccfsw&A{J+_m45|G`i{kUMkze5I}xS%HV9 z_X=mZ-T{WP&1dPEk^xOpxMeW&0JsIzwjfv0+1uh9x0&}gSGbDOR!4qF?BClYL^q_`MI&nsy6+yomIs+Ff?(cub|8tXRn+Q%E~(yx zbEQgG#NSr^*tk|Tk+Y{>`md>*LrthYSE z5c!{MU~s|Hs~sMOl!1#Db%bqKAeB-L{nHT21@KGEdLR`6h2X@C42VTfBoY17B!45! zHVekq85fsTv+FcR7dS6gTEeha#EI3yiCP>eg}HpNil`ZhbIvP;XJO04B=@jKc!=Jf zU`1(@nlNZ|j|o6Cj{x~%Gg}-MGg{wSRJQV)-WC$Evt7jilWHV2+gbNr8 z%+)>U&x9jcDdjAk81x`&Blv8pFKE%mwcJj{661XoQ-E+jYC$b^p=rqI-%MIsxhfv~ z8cN9{Y>gSv`5Fc38%w52RXX_H;&~Hm&Bx zJv6E1MVGutsh-(E2i9p!;$Ci%x63K$0glV%5k?x}xJToY+zS73$7Gi)%5Q2U)Y5pN z!1)!OI7*K|YFsr#UY!A8~?cxGj@YsyLp5P zuqb0{{?f}Rro6BgmUGEZ->TnFK?%tK^PBaQFTfikiy66*rLqM-)=pOA}k8BALUgF3e1BWazu@7Z2P=K#ts>i3cu*we177n64 z8a!6k>#gHq6M9EViZ)P@gX4MeP;OV%q)*@_Fd4LXj}sjluH1B$HD)b?7~E2`J-}uD z_#6Z3E#o-;k+n}cn`Av9I90sVZBeK4PI=-Kz)P~;cIs=q<6V0aD_{N)x*(Uzp=Kct zfs{jCtiJ=3X%}o2@=nni+s;uuOUgswMqCnYaC<=X<{9rvvKXdC$(qoj0(zU?#Ue%% z)Zt7M6UvC$6lbklZbLlPCwMsIiDq-4J;*8{Y;a#0;^%x6r;wPa!l_8G%k#?B*Wt~t zRB-5qptAR?O(EZ$4Gg}Rl3$?Jz4x#9n2vWiv1kQPwz+6TjPDd4CpAJ~l#-Hze zB!L7dSZ}o|JxIq~*i-?o15T2?oVH@^NHydGguaj?itS1-_to;n#K4+7dF{5{_6MnM*Y&9NKpjX0 zO}MxOS8GOy;&ZR5X9i%J854j){~%9Yo)iwrfIsDosl!;S!+CtNF8vXb>4XAP)hB;r z3;}o`GdLsZ#ZRytD}Ur&)Y(up`m;Fbq#mliW0N(T^w0^T&M}TxX(ng!es)%~W_Phl zZTq&v0J)~LK$Io7P$*grAYm>5C?)KR#XzUK~(79mPd0R9E*_udDG1 zDE7__x!;7CQ;5QB23g3NEA51_2i?G%8alW4La{)C+8jV8hDm;763Q6X8AP=Ov}jku zCOzXRkrh|2_xh}Zlc2S-9xKEji0q*3p@B(`So&*L1L-@{jO^g6a`_!*r}>3gQ{_Ip z0TPfp&)OHX%95Fl?xQ$-hH1Z$~masHJ47!8AmT#IY5&)KIMxR(_p z%U~Tk)1WD2)M^#8$gkqLQV~Q8+NdT~p|Is;F|EqM%Y2iF=)D~)B2_W&C3x+}A}TP7 za8nsP0wKiYBXoz=Vcam_ye3nY-4KO(Xtsaf^Gvw_x8&v)UvQytvVc&%>=cN28_pLG z3!cqbGE7xW>b1~lZ({Mu&>oiXXG-pH(evqqQOQN!+qk2mv@>yOVRO}{3Q#*IVZ1Dt zkyEAdxSN%oW*5RYY2#JuuG1442{)fyRbqWG0tI@mz$bZ5b-Z{Vu36BM7Y22d5~%9O zw>M^zyfWb6mj{u8Qk*x=L7%C}%*|0^H8#pFwUS8j#Yi0XMdpUF?jzInw>X&yY&~YX z){b-9b{O^AI*sSDK4y#4=CP{ukEQm>W}F3T#vLxxcddQ?>TP4-Ck-BQ4o>R#x*GGo zjjp3T&zB!jG}^sV6xdx6lwGi#!psVnzw33O0X}*o?^2&d`E9d+d4kfz%9ABfMR*i} zy9WhtV~EM3amO@y<#IaHU}G5>m)P^iyPw2o{4$?F!~cECA2{ab>0gb39RJZ3^-oM- z>i^PB>g^F&J><6Xa*23eR0(EtGF!pwW$w_UNu*=%FVFb=WLg~EEtt_oqa;OR#3u)n zBbmg-g#WYEk}65>Axa!ky!qhzen@|}O2#>(Y}Jw`iG>vAn9p6E-@LSj8*Nm(B{B^g z3EN|Q*Fe6ETeW7{dUVKce_M493AFx}$bllu1OqoKBI|$h`;eaW!b;<;rVLi?cTPdJ zGyTnrnQdFzk&P=5dIf5P2c0DjEoDg3gv#%$O%?3UGTHc3ZK_ zp8jjGJWz41Yu#Nv@q^P<>FjIB6<);mpyzyz!C==gpdSg@1j4lRO;}^A5T;Hg`_oo+ z3sZasaz#sZDe(nJ*)!Q=Y}tLKN>xweSBIA;_(ZXlzOYwv>UxzIxWF6mgJj=bjMMzZtFrK=f`*E$QHEsv zZK(~E;6kg@vQX$$GxwRn--VKXYFPkYXEf0m5t$QMByx&!`%JLuW~!Jg)aVRPV6+3* zYbEe7Bk1wqDHy4kZawG(-a#)EYB*UTWkGLPOl(~ z;1{nm?MKI8NM)l2ZN-ubfxjPi^_iAuyf5*U(|HZGqMW4wnnu}AcktzzTR!$= zr{ekewlCL(x5uGL5JhjP%r_mN0F)`=gtpU8B%FxMvZD|sk0zu<<-{qD_oH@I9gT+0 zEx(n|X`>5MSzi=NeYC zlU^qW36#t8BOhMqz5%L(*X9d3bJlt?&B!PhT@+cc=~|7#W@4XuA!VMj*pmy84Uh}v zK_~ubLWh%8HQEtF)CGFt0=>oS>h+d}RtX9OlZ5HQngd5Tg<3UWUJcBLu&!d#RRu;929IZZ4i`&=H1szvn= z=yK{D*XHs<6rMs_nkkWs`664(U$Zt%hXo<+JGT`wa2H2iuP@-NM1!&q!IW}-SSX_M zx241HHBy)<>Htu0?jX1{ytj4t-?_0asB#n-B&46m1;M4m>sfBMHy=Y}Qu<8qSyt}v zERSL?zyZ9yEvwL>m|UG)0uQ_!_q_Lc=KC*X&^Ml^8N4%tiGWPba;!rkMOJ`E-T^#1MxP%Lqk`RjQ4-9RL76j9|F<#;s zi_yZ_VW)9PxRVi`M@*xY#avf5n_u?4jzk)XG1n`>b~NO7%UKP~ZFv~8jdjInJoqW{ zL8J=>S3fOh747be(Op$W*-HIqYY1_#5Vz9YZq;VQEb}L00^S;$%ok;?%`RqN9Em62 z_vK?}LD-JCL}GsDmfGay_Fd;RX|d@HOb zUR598mVVXaVcxAz47k!ZDah3I3`H1EO^CJSC`=l=`qdMZk(mH7p4VVwx^LlaDzS_B zSY%DIFUj4f5>J@?r5x~j)z6u&hByumd}i)yYFHUixoyq=0-v#?0sXfm6vuzlI5iV6!jHKagOUb{wIf^c@ffBO&rCgr zS|_Q)%eOxxG5^!p-nM*x*XP~q%)yQ6>as$0K5maST3>qfYSxEqJ--$j^*inLe>DZA zz4~;rOvP0BuzL9ZiPB_(TgB*rq5@y3AoJ-ZLF-HRQHPScf6j<#Sr1Sk|5L5OI`zkv zb%$=_c%8@OpnLZx5scI@ghFex?^0%D19pLO!QfTRTCJT~&|%qq88XjL(Nc=-hYdH| z!fNg#RV2}rhqR074jay^;{`8=>z#xH&Ng9kb?ln)#BX zB+|-CQ%tE+U69UBV$_(!?Cr)eUy8ux9lC0@ZuZZG@=73($`7;-G7=W1clT5$i3a~o zfYGJ+c?u(m5;bTc)ln4^c|Uph3t4{(fhoV!6yPu_2jf_z!_o$F5f2_^Udd=b*o5+x zOj7!8sXux`jJksEs#**oj8RtLCQYQ~Mmk6#U6iYY+9M7P`jN>#T>W+g4k!35jN61w z!LDvra*SpFvcaiO2^&swBQ>-mP`<>b8zI(m;Y~a(C>0G^NFaT!C}db|p6Yz1wFNPX z4Ual8?ISTw2vHk?zS-Y+jc4c6t-Che%n_KdIcF7{EGQAx9ioMt2k30lY=hm*P+-i* z**?2bulefLP5PjFll0eyCJN`dm_6Awrdv*j|n`5 zb#(Lgvgh2l>?T&{VQIY1Zo`g!lfpqGP>Y6q)~+4N{3wK&LQ)qxM8)C(AOvl_nO3D`3iQ(`}gM=rhpo&L@p8pkb>|Kc{bnMl9 z!rt`E9ScZ=kH4v02gv%l?A>`S8#WzC9BN-W2DVsw!5$O5A8DOB5PGoJ$-L*GxkUiK z_K$F4=t+3_fZvHiID0lXzTzKs{Ht98K4R$$Ux%j@I7#9tGEh8HIti@L#`fwfPh^_< zK+091F_GqV&@x6WB;1M;vUyTQ0rhHEK4rYb7-Pj4)gkv74d>7T-VvTsv@_~LL2Bsg za?zjVBqu3BD&^%l*q1x4_A!!D!{n%iDDUy3iIT+w4CtxQ?3|(3M|OfMFb##qnl4EJ z5~v$#4$-T>^4qWYm@42Y;(!DS|I#ptlN?Q<0HLb{e65J)wI_o=rO`M+m*J!ze0xqg zLgA-`l^$2+3(_~TKt3kCE*M( zwqmoAcipVRa^N!;JzMzFfST9qWOvje-c8~SGs6O3hYd89CdAEXmQ9F>6jrP_)i%@G z;~GpyXJ_9%uj7sm8F@97pg|#J*|4!`sC&&6V|`5211xbQ`^B%#7}_Fi_fK$?$cch4a0~I#wHk_?-R+$OJ=K zt0ec+wrK)K$WL>Po--wRX|5kEIBXEZo2no`*FsIF&)fDCt|-zdz$>nNRq{BF$qhEq zeU0l*MjE6)1xxr(Vb$N#9BEXNiE^h`HiRI^L)j@w_4v-^9AUmEnR0rPJ+kzjXt>S_ z*v^v%u;7=~gPu(x!o5zPG!$ZXyk7eU<$0cV^W#Gglc{JE;a9!2RC%)oHq_-t`t%Rg znrxm3Xt>t|Llj0sGb@e@@%r}BqlYRZ!5Kp+QEN3KhJ8@>l^CD>5+=E^vdg@aw((>-GNMBuLDFe>lo>HRS%+fYtr1;owCL zKqYyBI5S>2o)zKFojXK164a?5ij%A&xmx^u+yWQOiV>2!8$=CU+`k&=*&3pGr8I;N z^`~RT`?7FaA^UBY^i1g4PepAxmNezt9~A8{p2G6^ zuxhed(yE2!i#;8dPLEUAMF#ON_Ey%?#$7kt)Sr%>je-~( z8rH^rmmQ6o2kbleUZvWOO}Z(iHj7C(@TRAOoSEmErj=c!bpK&nH$yTk*lL;Qj6hjzy4qhs17ng99zetq~m5FfF;>g;o2_Eq8Cerd4=p7B{}K1bMv z3NcSV6mMP}1SH24vlu=$5m}De9n6sCp{JuVe0xSDj+kM#TZh+F+K9$AembPw*sMQT z^t}wni;*Ci$waDGy@alL;Om}1r%JS~4GJYJ$tg!?I!u>^B`P#^gy_c-zPQJYp3lb0 zZNUeEbnC{dfwD!>oek6WA}O($y0f&)w*~UWelSJDQd5x7#$jRY-|aIw9cE{W#+xR{&!g0d zE@0V3$M^Kkx#43Ml?6iLOdnene}eVIiW3&_6e2P@#fOM;Tuv-^z(2Qh-EM% z%^5N!C3?3B5gQeMsS<+d3FShFUJu|@%Eby7mwaUBD@hPo7A0GvZ3lLr{qtb}$K0KO zbbFsAH}*Vj@0lp1%$^QRm}d*7l?0(-`9VK%>VO20Dv3}^>4Qw=YJFlasH#7r&&wJev<>K z=Noq6vy6_|Qz3J!%uf40`$ zvf`htvBNZizW$8;yN$k8Q^K}w+N`7d!z;^(2%cOyBbjUC{L3nzlJnh4H*67U%9Uu~ zInGPz&H7+1bq%<=h>pL2?b-EUaKqH&J;2}T*gJv~vW;B1QLv~N zNV4Y^B(_m1WX}QAE?Cl#hAHsfV~i9fXDxJ|_9NttYo5a;nxIY0;$SmqW@M`$iaNQpEz5X;u^J5=3=;MCBmxizC10My^)d(^;q7Mx$Zoa3xIWqGrORoP%p1gaJ1 zMbredik`|hRmRD`P-0~UG+}@Y-V3k}gkv%cixcHwVeftDPE&dk;%A-#{JKEc%p;I^ z6A`n9C~}&0v4_}ZXckyWL5q@ydig?|t8E>Dv}Br16Bj;oQS&K^^xXw3xI_C@KeK-h zDne%XjK+yUj4vC<#1dDzYiH+-R&^TT#4@EI$;~rRgc5fp!`~mb* zI0b;BMB3RKP`9p{k8E^3rAjjes53ycyN%jS6t(Y=KtKVNzIf>`dBURf7enh3a!3!= zWI0&xmkEz1)Ae*b<4%k-{;7Lj+opflbGO}s3z|`)mR6Jlarb$eIU4qLRl)x}>69-c zvN{#?SoI#o(a4P+*yOdPyqb_ zZBEfNI3??Rfg+Clnor7bjHF+F3iDGg{T6tw!P3oI5#wh;K6s-_RE>cZ)|^udQ=iKp9F=(U@?>{oeXSy~3%a-cUG za$pwjWB(@;95=0hdTDbuTiUA(tRbB`-N^M+?IdF~MMi(Zg9k#H^pFbtD3xPN|L zhZp~`QoOvBg;guRP?&A(>d++tV?wz}D^SVmP%uP;>QT0a-ophy%|()v2DP1QPqxZ+ zCeOt33)D_ny(GS1j1)qj%D&s~O6jcW;6p|8T>=Uph2no-&U%ds=WG8&`#k<#ir z75gC8W1D{FsTx+!$HFU2b{RKbC@*wQ-x~dw!mpgH_B54fY>SXa(~&|Y#gxNHb!8?%>{APbq!08g_(DVQ1Gp(DyD~H!yGQUk% z;(QVXQSidS?b{z7d$u$d!yVrKZJsn62&Y%-rpCQ?>|PsS*ANy*!fryc5Da+jj6Qw7 z`2r9AfXw;Vu=XGALIBSHU$ZdueIlh(fP7f%k@yDN1if|mAs+$Jz~h8`&vVEm{1-1qi)^qvHpwLD1%f89BUR9 ze0pku^QK`rJ;)uga*ndqXb&$#1Ewva_c`Lv+yhyb6|43yP?*Yae2d4@g%EAl96BDDxDG zjWb|@P!|Yvt@wJY7Um*HaXn}HZda~nY4jvU{jjwc5t3mdi)Au=Ln`kVXRO6t1qv_O z8reBz#OvWzmz&!lT;=O@SL)LDEUeQf_4P9Ny57+ZgUT646}?4^Ck`sF94qj%Ard|n zjrrg10wFs=ko-vjCoWP~5W9gfu7zhBL&oZyU(E>xHZ~e^1w7D)4mYDecTgbW5a#fJ zrVjCxfH=~LOZE@JB?*p%BpkBenUD}3z_E+8)emHTqf}nRNWYnDp#n-(e~YQyMF2 zWe+^$1xruXMhnJwth}K+jw=Hg(oi49K8Z1qQ-$OJKSa)az6gOLf+#Z(M`*u@{(bAm z;}M0D?S=&mxu?%_ZDp&e{T!ZOod#R1fDn6sxEE6x(3p#BX-n{qn%Ih^7RKMrs@U(! zQSs$E;Y2Or3kvKVxlG*;4;0DVl-}V+09U~4w-muc3LY$&)ln`M^Hf!bV}xN1jv2Zk z6wUNrkp0O<9o;zM)~3?km+2~mwIp=JQ-4x_jVVVs0VHb70M7~pNGvobo`uKc<>^9xt?1(laftljUIYe5LHinB?%~s_HeTQjr9jSQpAc;s7zjoA z)egomkTyBf?#C~)`cX}Xx<^*4gpm z^vi4_&cKE2n{?m1&fITsjTm~I3OClWK#<~+Z9+B%bZI<*K+%64m;-#s>MK~Q=;4H8 zHNeH>H2CQ5?4uxE2UUg~1jO$) zY}4!t{v^mUEsBO_V-v*wDX`jIch>o;D6qMzGF#}OOsu0>LOSj_=llm|<}T;L*pzb* z7O_B}k{^H!GP2FAG&&&KXM>edy>%O#`^YLRk_He`oej*)u;|f0VsqnrMB-h8uQrph zQa)WsrUawLwUdE^$T5uN8i3d1ico}Y=Dw^ z+(RdcUSCUu0~)65sBrGgmb>^^io-oqXaeheO38?ZntrG5dZeQFuorRMt1)O<;<=#q z>@Z|o`x)cdO0^htoD|PsXBBnmuoDy%5-aFfPSP1RDg(74C?Ow7ekg2Is0Y@brb&fC zJskPS*{OZQg?l^|eT!n{?4d2DU(52^xYD=&pv9q|nHQ6J(XC-3G5t*SAVc$;=~LII zornQ{@2~GX$6oe8Xv{&{14--TALQb{0u@Kk7pLiUU%;$-xP1Q_O#hp+h=uhZLWHaT zlg$=`iNe{Fl=j%3vAAFbq2K3q@Q<>nz}Ay1Bqh84_B%;Pu_bS;DHy}~DFPBv5{EGJ z_$~?Q4?$OOI|4Gbmk%+-{bGor`{O=9DQPYSylEq#6d08(*^)`e2MWD>Ze(o+7&FI$ ze%D&}^Xs_PU5PFP>fUM(LSXCT8bagIOHYFHM{;ihG&w{qVR7Qlh9?r0)RN9$BeU4iy2zcxNO11x=nrP+0!K zZ#hsM82SN34cBI>&Uu{DWCsjr3_tNsO$&a62b$_wxU zw-!v75ZnzPNVZsRx|sO;i&nkH+HDn84mXzJmLAg{oh%6A#3DG7=1y4{po-6kI%@SZ zFIK)CaOYjL)d~&PLmfZsojbAe>AIrP3MQ&_2ibedcU60C_7d~TYRk_C^5pZX%fm55 zkY%FXY%vIR)uDu`iuf3&M`x_s~-||p1WzW5V z$8Lgof2fbAtG)edl;(2LdxF9Py0GCqSO^YA@&ZD584nCbceAnW13nRP=(QKZ$3YUI zf;Pp2n7xH|#?3C9m>6gNyDh-Eqp9Y5vx|e+NwM<_K{6wx39^7i1`1Psg9i;{t&tDK zr8MKYP1jx>LLMtOR~sarqG&Jw3}qt_-wfCZP(q6POF)GZJ; zQvjTT|Ysndv_|)5TuPjHRtN>VQ+}^o#MZ|ZA_7j;33AoDeZtn9$NxnDU zM@a>~{UxP%E(yNoPOiNhoY>T;-kJBhKG8pLs7u!-(MpeL{kML28f<$GJs)lnmVcUW zu_MkV709HMWt-C5Y3^*+4~vT zi<=?zF}aioLrA4*XvT+f1Q7`^Dz5n3Gn@cZGCt})Jk$M5@J#|n)FUZl696xv6Tq(G zlNIc?k0M908bDNd)Ur~^6CPGFc-upcrznFR<+0STd*arqmK{oJtzPY(YTUu#z$>Vt z;K+tX4!*d#_ev>%y-MY7QI|RA6~h=X~w=g<;b>%YN#An11$n)`&>Z0`bYi>Vx#i+v%%j{m*m!Ff3p>AKpHIR4J2+R4R@w)GD#KC^5>c{@Vn zz6BGvmRu5wz~9bCF6#C>%}?dt_W?#%j&SLJ+jOq~#K*Jz!+WkmrOKqr1SBj1?o3L= zq9{4726YGm#AXf__^&JcH^PyN^B;=7-0zmNO;Mztds^`vUX<&$d^=LXASf~<%+YO4 zgdYkwF_9yAt9(*vAD&fjdkya1X>uuQHqXV|k7`Rc+qS1=0sby3EHAViQ;zowQ^!k; zHX^Xf=;&LUoAzKQqK?glIjX|;c5eQrQFm86oWJ{|Its}RRbhBDVQIGJbX7%F_NJA4 zrb><0E=2g2W7!W}+G(ILqxP0SuAzj<;oYHpU97Y3mCfqHdzdM|kBJm;5Cn=WvYr}i zq~zg>-$e9e94HcX<5qja)vR}r8&n9POe+g;0t7qyGtMVg+~^UqbfmI{JntM(b4^KR zIFyb?|Z??>&_)5u4(LJylDXE1jNXVmud_WJe9`UMwvSQfmFKg;% z%WveIO|sc;g{Fodq@}Lm|4d(-1xE>PHJz^drcnB*eGst8hCJQ8Hv+8pP&{xg9n;t= zR9$XXT6KP}KYa;b<&jiBzt3G-TYvoNbiNw<wr270ukcju$kQCCt) zz+o>L^)H2_m4Um{B-y6RXAHhccF6@-(5%OSL-(9V!*0GjZfCabLsv8vs2KW1dF62kQ5bExS(NB z3M52z7L!}=ArEakkh~sKezgy;psDJfpvvb{Hr>YOFWT=WZ0-aqbA$YfY^*l_*zv9xxg$XH4w6miB zp8ka?fo6PZ0^z$W)NO@HaC&U>wqn#0sxHuYWFUav*3G1S0eMhXJ3N7Pcop@`z#y9q zDGPuaT_>L~-bnkO`0q`i7U zZrhpWd_>@7k#TI;|Cm(x5$5%@%?^4H0+~dvNq;_mvdC15QHUc{Lsy`XK&$GVWtIK` z-v&WvM1@eB9N?l0ew2E+1&{Sg==Jc46aA+NF=k>K2TfgdMYO?nA=CGJNTfKGHpY>! z@K`90f_Oh>7>*2l20*rh-2JGS>dgxJ-%$S=>kCbd zIi<{so3?s~P+OFS>gtlr*!5ZyIQqdzT9#jSQW-vp7KlB2c z&XBw;^K`Cg1Jfc2D8aL4c#y%^lMzHD;C6>HgDP7>;&}&y{3X*?^5&DVOZ!AJBtz1s z8`CY>as9dA^Q&yc>ts{M)PB7Odh?w)mLG03HD4*9Jz{J3lM9c}7Od!3ALi7ot3`0F z#ti7_Pw8Izd?aRzu9h!HwrIl2W6RLM4bgU(gO?^H_&Ki(be#>tNv4AfS0!wh0@cg(VyOt@V@{)QAT#j zQf>`G^?hdCqr|zv>*^aICS$Z?3mfkjtx=3J1mkWBL3V;EvJFv>A5|4YjIb@=4^fP) z0RcT5glGW)27aFz%or3AcpcszI?Wz~AgoMAg4VxUX1cXs?=Rn`nE$;+ZGGPE%4Y;> zmxUut=WMoi!}Gt6AoAA-3T++e(*5h+ioM^`-I|YIot(K-rlKy63^eqd%cQ2KjOgLV zGF_rq2736eo^FFC(+7GUf*X0-<`$BDUk9G8CR>$6VOxk&SUP2YpH&^~n#;S5vX7z7 z#;E*uzEJP(v`gso-2g3r`YOHJG|=H!qR6(YSTC#iJbZGX3p;PGss`Tic8=Gt?z7(= znfc3QUtqP~vDIDU)Z^oTVn9MkM1zM^M#m$Uy-t`c%5s2SuSMNrgS!itw%PY4PG3FH zz#!Bm68KTdF&#pbIsJ*_)~VHUIj%3SreU|WHQRAf$+%Tu(ciLrtmz`s3|JCNH&Jpd zGC*}H3E&@!NFbXr&EO0`M&D}r9%glmM@>V^PfJCNmPm0QQzTAL zrtI`xB}*eFcErvzg_*=3<2cSmri#+5ROT|}7SA&A7~h*~hP$)(RCb%YA4 znBu7q=O_;7Z{?LYO%whadwjWM1E6x4RoR^FdZ*MlGd5ZR5(HpqNBuSmesFcEg(*>g16m{U$FBR50J89l@hd`Q>#-E<4{ps3{ zf<{He;|qQ|3Id~W5>#AZRH(Gv#*i05__6^wwGq}_3)Xm865d=BD7NmnorN$%AFwZ6 zMyxHSYZ18-`C$mR5dyi-H5xNZ$Q9_CqV=_iP@0eJfN!-SRD4Yw&}HOMOoBlP{Lvmb zMZ_hINeL1dw0E=OF0L73xC4MeK$M+8BmOnDwar4T!^9r>m0lWcFg6cP*f|d_A#X&d z)bSI%oYfU3J?qw{RuNfwQ>|iDso9bfPIpjv=!)eeM4ErfvBsI3?uWAWZot?pX9+RX zhdB8}>csf~Ze~pB7?e}=nv*Emc%lr{H?DUM7KASK@#aY0djMZ2NCISbejQQ-bz-0abFxmW`?ul(kb@ez0Ng3&= zsWt=N^HKyB#PE|Z!fOX|-+j{FR*6(0kk!m)JFe&_?fDaJ4hd()S!(r(`>S)I6osk& zn~-+P(aKLe55{GH^Y3#7JXCG|6qN8JwoQIy!9}`?v23b|awuO$T^?OX4k&k4hgNLM7|KQfOT{9!_5 ztd0m`6BgqIHf8(jp4B_yx#A&DwV_GE4%Htkv3zi$d^~U~xGZ9B9;O)iuYN^9Y#GAu z_<+pn^A70O*&-Y%MC5BSRPI9!AeonkS$epK)-xus1Q#S|2!2(giEg37oQWGm)RTHY zDiN!e5jqRS6u;sXZ1I5J*Wt45@a8&05(q;CC_AOaJ2e1n;8u~4G?;= z>@^3lYm$Gq@JyI>8#G;etR`g6MjA8&IvAj%5Ej;2+@RG#y;e0rpa@>IuWcM6zV}Au zgvJY%GpubiSA4%L>zJ$o#WAbwlj6o`XP z8Zc?%<|=1174GZ-AjO*FcRM(Ph=|JNCRikIeOtvAZ+9IGhWF`y3e*n^PBi$r&#eup!)-~d(a*WMW?c1 zjWxmeiiJr?FyM+g%di=13FBa=5{Jyiqj*L`-m`aNO5O1nwh>RUZYo>KIg|Pkkk#{J z8i9-|-1^m6vQoI12gj-5eUP0jpmhpSSqMkjzUmWFNlRK&aH5E{zE~L%O?GuROQUWzT z-Uo8iz5I&^W(8EwwQlusTyyM{30Uf;>m4-3niyP-n*JYd9RCh%ZyZ+3Xu_Pbn-r36>KR-7D0ad3eXy5q zj|tSL%LHtvTx`uG_=9tkcacG_w3&S4D-G*L#LT4)PZCR4$N15JsN#U7b`Sdm82q%5 zGJ#cnLoFl*u1SRplUSLu9O`(^Wiz<7-FfSV+8KiYCx<5Fl{ztI$J8>b<j=d~heC;mNc$Ckv&?gHsts`oN}=0QUtgyAzjKPWO%Tb z{+wM^I%jz2@2^!1X?GABLkX#T7Xj zPa*=CS49;ZCUb#*oUG++sGFr?%!PKhD8(I)n5n(4Q>gGFf*n(P2>17uqV}C&m-9ib zyTbhQWeasV;-PaOJ%GyQeRVx zgo!-I74gt@h5F(5^92Y5k_jVB~um_oL2kwBm6PAld@>0Cnk(^}U*- z)*JH`r}soo`wpnLi8|rI0}pZFP!SR`+hsntm(S&Owt#pUkihI)rD_Fb$aVbJ%PsPh2Ed~1%Jv)unNdu$aSm;e|(ek z13OtD%#JvlXL^8S!t25q+i;KSXH%?2#N-=kzj@0nGUgrOY-Vcg(t4&1yoJvnU?eJo zv=b=wt$a`Z7pgjH5Og)>L+E=yKR7L0)CbyDcxoUpp@IUNygv~7K_Y+@`u(@R3hw`j zFlFIl`;YC`vi4RopcUEwMt?wBza%bn7uSHtw;s1k`h2v(*K*_VzJGBZ!#XlW{QPk0 zG5!VwR=ETr#bZ%m=>V5eO!!sv^82|BmVyv9P4RUMWoR#+V(QoZCC%GCxB?bA^)D@_ zCk8_f!=RD{3XQhDzu(=Ht-pG+8AFg*DS8JX__j=CJ$}#n_q;PC$|2Lk!Cm`bF)n*!7tLf({_bq0N$#m)U@msuzRY)q)mDQNARwro$+{jHwYar}Fx+Pb=Drnpy| zD6FHZhEKGxdhiRWcIqD1Mm=OAS*qHap1$1B0YK>?)!zttVE9h5%E@%QQW^L9OCLu$ zLmZo%oAlt4s9*CT@aA`H92znqX@#OK(O(2+sM;Y6{;!Oq7G0mz9APA3Z4#nJ=d8n7 zY%U&MPaF*{KPO7?R)du=J^2N>1UcaNsj2!Z6!)eon;odrt1quynj!rUDNWg~>V6R$ zm0+x>S9vq}M-wtpOd~Zq!E_HgpKGdylW#!)t!)NU7Wc`>=Bol<$VfUNDJBe#IXbRl z3Kr5Lp_X^kEp zeQ(p-`2So=2I>c=+Bdz-UoingPQR6Y-P#G7|GV}m%*xeq@vo<9q~mJZMWAaBwlu~k z*sTzz1uwVtrrHWa-@6*(oUDqRuE-S3w1|mbk0MWcJ`m>oM)}*cIAs6>)g(W$rBKEV zlx%6Ag=}ldq*n>K@&0Y{7+T;3LcxTIsU3coy+7Ai%i*bFbB`m4anxni78tvIa8hr+ z)7$&J!wxUDbz2kux`NRc5YFN%4Bcxo=d0CnJwTLkuZpl)ysmapur|PS7;T{lDwW~{ zRMgkk>z76^xCF4l4yB)#&MKoMq6%YJ5r@UPr0I%;K!-(>)yI-38*|*gw6F3-eL|== zG9zSOk`+31_cV7AO=k+h74Y@8zc=fnl}tB{GgM(YW9DWdQ;57wK!f<&i{LGf@IGWV z93KSlS?VlskEeH`w^;hHtw#gyEeUXV@>s>VoCwfj$LiAi8#Ws#5+kN)+f(Mb<-H(COsR9mc z5=vC_c6sL21tO~lRbU+J?q4kb5R_a=U9lK|4lB5+rfbSn*g)TI&J_vc+w9Nilh2$BIV0Q1@`tqid}8n3W20XTFen*!!BO&Ro~xnz{-ib$y`q-Pw1>~CFq z9+*~vM0@%!o5}8{n_*=nl9w3K1V04z0U6gmNzwb%p_*WHdyuMI+Url9=P65_njMV2qqKz=G&g}da!DX_N)wqXj8D$Dyi7j?S#R-IW zemc`pY$PQfM@DhfR5Va{V98|S+FUGY-iDWHN6hu`aR&NnnA)Y=E`CLqw_ou)(kLK8 zNeIlYWZ~hAkIj__{b9f&;5K+3OG=&Vp#X7v{OE3;>ok~GGa6r|e%-)<*=jfj+83Xl z#n*}~0q03G!CYJreVXRBIFZyYGm&p9CSapp(g7K>46w-6PCmRR=`_}`n z4Jgyf3orb7iJ$|0cU?*e_f=TqK4TwVB=Tq3Qn)DiXprEM_@Amnv$tVOEo14hYqapR z$D8gGy0cCc@7A*QBL|ZJ#7Jj3<+k>?d*@x*_L|ejE)~YF^wkpitz=(DGySQydgw@) zSd1BP(5rp6{?OI2W6EYEi%=5%OQ1aEGIDlBSeoUg53kMd8XJhdR(t-{-*575yQS00;^UcKADUU{{v27P==EYFQFh}!q zF~K`avLf;P_vb_MYw{7&TB1aI+KbNWxMEIDhx2U30g!y|9Ud38YvzWKrd$UW6K>n2 zdwN%@h<7n_`Ty} zd(onlpbY0Wk4%EmOp^`eV-7I?up{dnNMpzgyJ0PF(wSR{O;bMn!3<|8P%u>G{09t( z%uTQqX0jI16vrtnVQlw~_aAr`Z`CcVQ7U-2P{DqzbWfV~)j z*drsL{(MWVGq`@Z$xEKYq#8z$VCY_tNrTUmBC$w1IGj3>UIF3@G|Wc%>ML+YjpLA1YoT?tK7 z*H>Zf$|V_Pdh@AOeqC&Hm2Rbx7OSQ+a$QDw{ngsgh=QiI>QBRoa_m*~1r`e#(H+Mk zngs`=aPmYLEF%_5=WlD#3VKy+a4D|s{S`As903ehRiP?EtgZ4;nNh7A$@*R$RXyT1 z!P|NbaNLGcF&8$6IEsPL9lLJ{K$!swdh$ng%|d>-=dp2Ep;-s3J?VJ_Q*o2X>C&d% z{n$M!Eg`OfPRXt>t*zeN5CYO0PKXw<$CEKQMHH#(n95H2zsklqv6n*}PA4Z?r@S<@ z5EG5W?Vt(eY53!%Dlt*^Cjr;7B6;`f|_5pGg5p$wqDY=(>Qq;^(P> z{mIj=@KHVab4c>UMD9|uR_~sDWGIKpEf*f2v9mX|`*-&rU;t#t$$y=&|0iIcg^T?^ zl=d~+TFC$ol>YSiIf`!yvq$j0=hvNhy3$as^HUzc zIp>}FrlYvyi%09;k5rC1itF0|Uh`Lt3DC@P?>)QRq)8cXB9;XF;owz1(9xqbUfuH5 zF6$<0TeTcKP`UJ)a?MD7nboc_gZM^L+UFZ+ z@`uLoMeK?ObzUd&nencxut9uk%itB)Z~68QW7dbD|25 zvB2DoRI)a;Zxw2l!?U!=TjQabMlhB}8srwGZ*yGGH4Df_7*(}F-9AfS93e)M9_10?486ZOG;NoQ;jDNGe0vxgKUAf$UAfX!+Z^rNO13V6Jc3kg+7YanIBvY0C+ zKO^><+WZWPZi!fiNs?5p1Xm;qu(eoZKM@_WB~<#py%8Cy_Fb~u1lX`%cw+trd9g)? z!abnd(lrNDN` zT-7_)h7;lFdh@6850p4NCcDcEGNKn{z0h(ZJVDJMwzO*cI267vgpCmVoE{4(q_*9& z>-WIJi(MSW(I*a{Qx1f#>v7M6mce?nv_YPoh!JRAssuc{oCn9TPN z{6`+2*ge#QF_}VwPwXLel6`_t^dWZAO@dGSAtad~iD%p)cv5~sx7a<*gf*Fl)Hcx@ z_Jj^uAJH57gnfAu`c@^idu3FbQtEO=wat1n&M2hCzr5cI0TCa`f&cHRM58%K!i=QaK^@2+vvi7)Z zC9}2~O@MhSB#s~*AF6aVUl%qZLA!b)=+vYs|2Kb5*WYrCoS?38lf!gM-zf*yD%*f3 zQ>~>pnrfEx(9UU@oIVK^=pqg=Iln+g(aShU<>b!hG({LC?omIAke3QLeXfffXBlWX~flxVZabhvV<)H#hIzEiy4@XC^0d1 za7{X>!Bq(!85|-2a<+e|03$mM%>1*NEF{f$Kq>VD;F>_lA!U^W%jdG>ajH_jjiKx0 zFAo8Sk_753rvS4Df*s+^f|O4kTz+CA6hwgFiAbh(p!niZqX1(}h6J=^xg2qejWM$-E3a(5E*_RfK!9odv(8GgiUBb`$c91$2jf#Z8n3 zS{xY4Ttkyx00TxgNFh)f1cqYaywZYxh0(#?CDo1!qF!1dK&u2?skhMMmflt#v=o!H zmVrzWQ|xy8m{ifbWOV*VYzQ3e&#m-TLA`@V>!c4qKxiAm^@v}+Sx@>^E44=O7x%mt zSI&MBNbIDNq{(J}k|cwbNjT*C$1g>(po}#8!gd1!Pfb z7mtqx|N2(3#p!V#nW?-R)g2{Dc2(K1-d0UCc@{8^rd3@i@r?D-Ui7fW-&W$5OPOrF}vM_CwbwygT}+A-OS zODPj$;lIrt*7yX!pL=D2e4tFg!*JhRbC5eV z7Q|5ws&v~Tf3lk)8Vv@WpK(YU7aSEp%JM=v-iiOHb4wT)g8ao)zL%gvppDD1ndlnJ z?ylr~I-VwOzvu~Y*4r01_Q0gl2f70B_$rb&TVkTT_d|nAQ6hV+_jM? zuU-XKB{4^GQ;t-(?&zBm-ovRNxI3Xr&KB~yk~-H*X85M41Dd^n+Ur8BquWp15mG0O zLiI(|+*vbbZ@awot~smSa$4D2K8j=a%BqnJnQkFG3<14Y9_6HU_PlmfO~N}&5A5FF zvrP4O4nU4&MU0}%g|mejPG2?Ozi;9Tws?Vxb^X$|K3=Jew?-tf$3U4oAQ3_~|IET{ z4l~i-DrDKgBcA$Aa@rej@kb#}UCiGza~K{>To8My&OF;LGI0qpZxy41{ib3{a|o`taC3QQB<^PI+4c{S|M3bx8S3wB6gxjX6R}1DK2wS)m;z z&OdE`r}p7j1~2eBXy0vKDD|(HEc%py+=0hdfo&EB1QnGRx@&P`wq7bV7T;MA(dD*) zG0Y`~@BF?igA|0pCRtKbxvgKJq~Y5-ry_sZ>DR$I^K=8HI`I)OlZeVHYr}b)ShCuwU~z%{lKQI}btog9M3m`j2<6dN)^VJJV3?dG=8Am4U7n zCTxGNzCD$FJ(e-jjHadpK6bN4e%YN|4OH)@NSTPJ63QWvH}cRVdM*rXly&PgCxRW? z#o&~oNq*3ml%#**4Q@TbZz@*@HaFj(y@T~^m{dO4{Z-Wf13|uYXpvC+*J}WFQRj=t z`Apj_|9aBpPTjg8ND>&?w>>>Hij9gBZw0yAVB5Fri<5xp48G@`T-T|Ko-m`YOtAd) z4M#ut<~1Q%KT6$c@z6hC>H$zgcS=CPW0yhQ5f*wD$g{r6?Ur^QvCL-+Xce5NWe;6 z!T+9(JeCL1tW28o^)?Vy3_;1wnOcd!uc&DCaKXh#kGHc5VGE)uDupJQ4zB!-6ffyJ z9R8f>Ym>iLcctT6qfiTlyyYwh3Ax3L2vt!`C! zwNPtgW`9|u2iW```?lnCvxe2#$n~|S)d7rNUqO1C3vPISXkhyP{yyk~6Z0OL+y%9dyA3?fZS)*@;$$QEG0l2ma0I_{9Sd*iRq4Om7 zTzFi4!TW78Wr(7{JP=VNl{e)4HZ!t*gFP+tD#<#%Tlbga@=G#pK1tP7yea$R z-#*Yu89I5(<|p;1z8WzZUmg5}ul%!1jX0!#y>Pq#v;F;LdN#8liK=$bVzVg2t?5Sa z{=pg6j;fH2R!kfY-OjS3%)0g1x*^TFWyQLwc5{V=HUN@liv%FYdnm+`sBwYFmEbA( zdLp=bWCZ!krZQdU8@E+=v#S6-F>FW$nLd^G#B4Rj!L{A7Nw7KAm60Xi?dcIAoTo2b z<;&2Ccvu-_NG@TVYk8}cKt1VLXRS=Gcl~XZmH2nPilcHC4c;w-xF|3<4#v`zp~lW$ zq?;9o-BUd0zmG<)T39z8jUkCr*D8cp8a46G0A^RU$+K+QY1BtO?ypLsLV~QV#&Tb( zNS7A0xteo9{7u!>y9Hs$AM~0%qX6(~GUC}GFC7kq#9-`j1i`jd<_=;ZiQ#LD2JpF- z5y{m%?B6*!kT@3kU3oA`BUB+aUba>SV{6yJS#NybMX8WePo1K-(Kch1ZQd~<%|z{w zmr+>>SHz)p9T0@{1j3iW9jo-32_&g1)jyq1EPdZGJ&u7QnEpmwnRWFw0AGUO8?3CU z(fE6)e8b(Q<-C66k28T@9{I+ z`1IYopkB+6n16ESdZf}0nMO39-yz0X%&`Uzq3t03v)8tq%PNcRBP-i!sxB)BTIW7k z59^;&nj*}#DfOe=Y}IUgI(B?jYAJ* zgiMMv=cLrSYE$%GT9^ra?hnnwK%Sm&jQ-G!?L!N8pm!e|l#NrA)3yz7A3_KAzzI6~ zTR0Qu%?*MZi&V&WvIG|6gJnfmLk(qg-EZNIc@;`8Xlx}JXbonf&$H)e_BTb6&>T?L zfw?%o4rJBUjeQaA@l|OF8r_jAI$xLmo_M0!!69fhxQa~Eum^O+r%3FnEC1cYTDzV= ze!));LVFFrv)<8I1wYdS$X+O?BOz{W3%(n;5zgzqxq<1H_Wh+sSmuV=@)zPa?Q z4Tt7Iq3yVvSP@ojuFz_8n3^>%H_J2p>j-N(oI}p{wydRx8A&g^6>!ilYe5B} z6y6{)6)uSti)w%PMX?^^snZ{NPk z6FVYi8niuKLAAZoMuDgtQ_AJBt>yze7S$oufkvduUp-W7r1)t76dVH=1TNm$3ce@EPe&@ADJBOw ziyp=h&bUo37%nZf;{ffCHGU5C|E;3g0SvS%_zmFudER?xQ*V7Sp;Ym-P>t$Q$>4xW zJY#duqs!teLR9EExMNP$p+xhiW0va_2Qf{Wv*qcw9TC%`106(RLFJxs{J4f9tPvo8 z4`2|u|FRhF)JVzg$E(~Ko56~LDZdW)yOCrZ#;htltXXRrOca~m8;^jA?Aki%qocDmOnEIp>cg~8m@`9+#h+bK_Vv&I(IIAe;!Q_av{C{iMV&m9ifC9 zXpki7H=fx=5cJT4Z;$DlLzg}S?iQY~AkD`SLjY#(S{LQXNr?bq%>TG544w1D=yni+ z62{OwPAITqOUX4;S2|VNRS*heq`$2}(PS1;xN;1T(o-TtQTFv6r*n196?Bl8=~lA9 zp9C@AE6M^Ef1yawGr`EfRy(zCZk~akJo#k|^4g#bL z;Ow=+#%;C<0S?QJjh0V#bm@l8adi#Kv1lmlSsbvI61aP*>6)p?XfJz`TCD@ zKXz>_F5Gn}O-LJ1Q7{I#pWER9cal}%^YH+R5|L|Ljrgux;{cGu$0YVia)U%MDFu09 zZl+|B3S$^5tJzbh zbEH|$4e>RbVioW;8n?~3{eMBCDXieVnO6EoD>O}vn}RuPStQEfO%sgq0<(x%8J&<) z*m4jBa^eOOxhYof$TVRV1{$-aG7(Lus5tp`gWN_-Y)!VMQ3yg%+C_I>Io(8hP0a~V zhE&#>ZDtBpnk!BCa`uqljl8Kw8+;}s+R?;E2eQKr~lN z(M7tcwg+`*_Slg|S4^KMB|oMQgMmZb71~!-PMP+TKU@z$P^BiPa}{}nO)cBq4^=j; zvHos?9zX32lFy9c7x!qjLxb#ec#E;Jw>|_AElgGJGl{g&GBIa1eN@D%(Esj^i)7^f zq=YOm6ok+(Men*6q@mfk49=K=YdVN!DCPgSI{_IkxF&IJohkIc8$84@ZRo*?(a9FYth0Tf~MAN4b*5SkKu99cTI`&rc1l z28Y;4J0*Ab6zTP>V!=V7=Y^scEr76u&!e-$)Qwh^oVgo!S(nrwO;28d|b*u_ll$t#T#aPYhZD3yh^CK=V27Vq@B1j|RS&19V_G_(aDZ0&bR%SZMI>D^G`1H!aB^(@Ojy z@l9s9@Mnjs#?n1vyb$(&8~^Hq7Om6&a#&Vy>N9p4T1Xh)ovy!jEk)$h@p966d;wmX znK#%Qg?N__$Ge_2bPuo++}zB%TiKoaY&&lh$G9ZBh` z{s$Q;w!^>?vi}C}0ylTtS6Fu2x5A}9%WFZ8lgpjXAQPbxFgSM*q2@5~X$t+2m({o7 z=&io5bumv^RcM%j|AV+vTzOrJbbLhD0M81fJasrUt+KdLlm6kB%sD+~huZJR{m_H? zGN|y{&?>6~B(XC4R%^4dT4zkL*M^VOtgAnNIGVX`v zX05A(_Sb!fgAmkt{iM2m5~wqAeRb(AXHry4Ktkx5GlaI@BJJ6B7vLd@GERD^h9&yL?puI}rO?6D`rFzz@j?j*m{ zM2Iqi#y&U4NWWL;XIw-JYi${by%;IcBE`o;`EF?EC4AF3SYSAn zzZkn6X{cd~ycj$<@^??5eI4azB9Mm=ic)B}v$DFTw~YBy&u(c;&Shn+7Bz742&L)D{&kkM|KU7#a1Z0GS1wqf7Kbd@a z55bjBmgst=B=_}Q<2e+sLN%Y;0PBK3_xcH*wEwL~kelg$ z(u1+EGX2L!`btYW9x#snuSf7y3RwNuRkZUx88Z_%8Pui_f*s)+3c#ocgPrWC!Fk+% z*1JWqMD@~)mz5iwV@|c9YWuqNWuAro0`+Y$O?_jPtXOFMx!KiI$QA?AFd!D;D9 zir*mjp8kYfo78>!;u@|{bozeZP7B!j;_0FOxIM1??$&o!dE66U4C^!03O7~9%WnTN z?AdFr;JYH+u5OUa(IRR7jVzOCUd)@n5{0e?@P|dzMQF#s5H=J)y#ttw5fy0^DQe7-(#%P{eDUp@E*M^4&F>q*+uQ zT=zn+QqsN?ehFC1S1OV3>1qfJm`U3z^5QSe)L}KTFsr+9Z~wDVO_14|0C?YG)MDg1 zi9Ji5Ww<&KLjqBR&jf?yh1g7^=xM;$@I&WY-tp%tBDGqT$h$f(E)Gtdx2~%7G^^q< zZ3lws2(pI?g`xcdbK8fbThHZ%n*hDuxciIJMckm@aE>wFEOZe?aMEraQ`rH|B%aEr zun3G=%BoRM=3645+NUN^@hC((nWjNW1OA;4q8FJ`fm=&g8I{z~;uQyXWMEIuGZa{R z!9daEdRQyQKfrAP0V?wZ1Nt5-1iRX;r&XY9D59%Be??J4>RB1?LjFiX9?Ie=q7tLV zBc}x_JBWJ-9Zt_J!Ts4U!;qZpDs{;Xlv*-|1TuoIQ-e5PcFvIORasLL}5HRR2zYrw&PVn%zP$88;NnqWMk;U0Fn( z3z~`JHZf#sjJymu_l^hjdya(Sh$su?Xj4tB02XALS!@D#=nGsq+@*>upJcdY&mF0g zo6voavop!16Dy%!g0ONQFh)V}z!dcnS8@EXi1WO!X4Z}sItHIix5t=H5OcRRa*k>Y za~*+piEaIxGO=FpwL`EO@0dt|C6Dg;<4M9Yy~J2t>vaBG=gR1vkgH#IssTbVGea1$_<_&DAU_hgiND0*EImcMpxvCoUn!ZPi~LMO537Uw>pBM=Uu8q(p2N0JS`!M7-A|!oyCV zxVjhw-Q2Px1di4)uY9Q|NUH14;6WGCH{hURB-bAAfL-*J)o3n8n(C zy!wS?K72;vVv6-j<$Yr$lmZso6z4bxMB4qVvP0~B^;`|-59*hkrNgwS5-*M33Uzns z0##1iNC-$`eHXD-xCHC1OZSQ&utzJZs7M#ApxV8zQp2MLJ&_5%`g}mn98? z|6*W#YkfovjPVsXgo3B)5ecw0isHuC2#g?Echb~9%WmC(=HjM`$&b+hvm;ZM5f~QB zP_#a5f<1V~uE8p4MvLM1Otfxpl;oXSJ{P&H36>)D+>{#^A>EA8ExN6DQ^Gme+0B!7 z`1tTs3!8&P3#)M)ip2O_YMArTR*WqT&R9WRk(&||dU@)rsQgwH%)el?1}E_7*KG1D z0lDbKEN@D!Miqm%(wf}6;IVQMxUM0E_W<4RB>$mdOF@$aV zQ&%j?&q>h8{O^qqFd>F>wk;)+ryKwgeufhsiR^)c6(NPj+2lAGVo=0+p~NjDhSq;_ z)7xoIm4rN&wfW4ZmkLP3)vou{`M8$V&&tdJFhPku;1HKe8%HB!fmA<&_|SpM*0c7b zFm^geBs)~aRJWbYQOa>#;A^9lt_MMdZa^EUMp-I-Rt;=Tp=J$_PgvJS_K03W&LYlE zU%^o=f2VytzQDb6-~o@+Png_vaA)dHrheKUo8XSt*Js9&Bp;i1avBQTJ@^Fpq}xPO z7;osss$$#B@P28490t~TN_whI>?^C?nsG=QS%caf7FF*~ji~c2aBB~aOcY8g@4tja&x%Sq#)9bRH{pX(B z?=t*FgZV5JGYV;M&@B?YzQZE@?|zV8F^ZglYJzeZL6n;DLi=|429SO0d601h<2ow~V2B4hNS zk5WAl7i(S@ED*G(=LNR_W7bF@9XE1Mt+20G{HP=n?q-s<^$izsSV_#N@Xr}{0RjSv z8&VX*S4k4_J;Au+>eFybm&YIpFw$W7$g&gUd1S+J2mD`{_C^!8hg**)5&vHqPK)>Z zYMfb`7ih^nw0@(Lug|jsi;6!JC_D6SSJ6)|1y`5SKBQ z4ez3~G5H>Z!9Uhb@LH8{I7dK8KVP zcT+K82dus{h_{H8n!j(4pUWZ%O8Vd}g!}k#EZ*QVs>^%-I-Up7VXXK1Sw2N5iWBrz zfDI^8mG=&rp9MO`a?`o7PSn*P{IC|813xa4O@m0y=@O|>a+WS!P%QT$cyDsCZj`6t zrmg8H?u<+)eGgMs2Q3@logA|x7g&X}@OKq5*AYmkgF;~T@e?nNP?VIv<~3kaGhqQK z1dO4F;QjYbcLo)u#DD~Np^A-;*HQtn#6Jv@p;Z13pBuoEIGQ*v`T9M&RPDG1_0B3kVPU?0 zK-k(1#~4CeY*!rKkL6$|eXunI-aLiNWL*RBEfS=`vV6_W){yx0hSsVb;dI zb7+O}$Rqtk#&)b0?v#%|^ZB_}*lG2^#64Dni=Ra_4FhEjbf4FY>8B|X{@GX%Zmqda zSx~8quePc|PY7!z3uQdFFLatRgTxUpXbMa_^m&i(GH{YH&&$uG3zWgg^In^$pk_cy zg+}$El4}bItFSDZ*hT$twOX_3vo_4Li?M)S#8p90l^?qE&Q*%GXcq(;<=2lluNFt~ z1|-r-u`I;vgR^Z#p~5O`E+`GxCPgDJyz^wG!>XL#+08UScMaQfvAXL<>e~tgZ6F-< zd`ZWdr(PMtDq&>>OtkR{L%(6pB?k7C!&V194|^ zW9TEWB2-0ydaUG(`4ovwtjlZMIZH+e7{trsPI^E_KOaNxQ0=Bdz0EYyE240m`@*sK zI|eEQvKqD%x^ZAAEIyN4Px+jPSUpiL9o^$d69pBy`rRM8hew->aYAija$y`NycyUnBtEh2)5L22fI(>N;U~C?IVwGsod`*0`R_mgF>hVYN#UHkyx@YHWt{fD83S@HhPtm}wro)^?UMCS=X7;ncj|*J zaCpdL7+lI2tofec+~5${B=c>3{Tv(SV4d{^Z&VD#)CCt{ zl++pD1tw`Oli%K{u)If3^kJ#dMoa}0u}+S48e04hvf0PiC`pMvhRzO3HTO)GqH>5= zO|>icxqPinWPW5%_Enjd*^wsV+9}h-4(N9pmY!$ETZtW3>OEm%9PXRd>7!=K%X<8Q z=O6F1e#y^ZW7Tq$-tEr)-%#1h^&3fx-z zj@7}Iv+|I`k}Z<%sjpDXL;^0a1}2=76$|`#fxYe{kOcHL8a^eL(ecB-eM0as2-9P& zAJlw$vF^A%E%u%7&qhw(*u0*m1;4a6;Qs5A_diMhm^oPgqcG#@U;A6J1d`v4e&7-& z9e(!L1jFjEGT=h`N~g4&-IvG%m2^D;)G7V3?uL#IY!2sgI8H$=m5SuT^cY}o)|=V# zGD1oaMz}8x)3+wuy3M${Jz{>297BSKeDgj-I!OvAuIss4-S?@#dM8>ME#8my0R7Pp z#dTuV5`n78i0QBYv*$>nI8K(qQ5O=kRE?SMxntMQEMYjjODqy~>t)|qumEZN48GzY zXhddmN*p8I^Ri&7MkHN|>5^T0S+$DEV79Ao%qp6i~7%P6YHBLa4-eeGE5_mNiCaQ3uwQ_9i0 z3}tBC6kFGiB{EdeCtd;C&VsUk0Kd$;rJ6T1)v=VpIk*rk@A@;!MckQ~FXkHzt)wIE>OESZE_+uECHL=lUn%NHLPpdV{%PDWJ{ zW5Zcao2zE2oV^3|3;AL3|1ow>-I=w`+K%1P9ou%twvCRHj&0i=+qP}nw$-t1e|gu& z8tWb3v+?|Zxm$JBth0{eqF>ZTkE3di``c0l0mwQD>iH~NMN(CX-QxYV2K`6hHYddC zcgygGp@^|u*HS5Eamcew;)T0D3A93BO!e-qdwYHSU*%P)DU z#&&lKq6Qv04OYdNef88N)C?F;RpZFl?KyL+tkXT#_0wqlX4{E@Ym1~drRA?x;-#zg z=9Vw{W7H0Lv!hVM1*s7!HbcJ&rFzn7EY%-(Q4xQ^6s9%|)iuAmUUB~#UqYh*;` z`CZiJNtmP1PQHc>jq=ZeT~cFROB;4Oexf&ANzaT(pjf?ZD>WQERh#y&($47O`N0J1 zVcfSMYVWecNv$xzy8~&|tQ(iaoJtxL%dj@J&KkY^9iTuMazQ8qOFUyn?^6p|Esx?h z`ei2!eU_Yay=Qq)CnvB&Tnwt2BuPjXY}6W$i$&xwp<9J%?44>oFJl?DMImr0i1a5! ziBWK8!m=k^h-nZbrO({(w9hPDfDB+)Qn{Msd9rYvHHI_2XrD~&R;Pr^YDzJX_>Jh> z_6M(H^zT9l#Yy>TbJ4%bph1dLlNM3@dGiZayoLX=t*5i z?LoJ2hC7wcG0AkDZEm8lC$LU{@8^f>a1O9g(7EKq5;Kq=o{H+pctx$u)p8Su!f3FA zKqoR+Zs3e|8?@CC1JGvgstZ(ta`I90P;_m4II*i*8pwhS}qHrQ00Lq znM7Yq{1iBi(R-RvjyPNjfMQBy)fpkQlJ0V2qH>e+6> zkcb?>yw}v6<2+ik$E$ylq^3R|{wY&QF@qL@TcK5iOSHN^PQnG)#BXN&+xp6*;W_w} z=Ez?xl5>>FNSIZsljd4$NKAB8TsB)yd%AbAJhB=l*QQd*vHe`2N}aI|x92#-Wdo+1 zB!_*WdQv>Nily=e6x{L)o>tGAN~s6K(R3$lR%@OXVt>ho()4bN&;qGjmK83)Tpj9} z*;Qh9|XnLsX02LRYb(BB+P>U4!*zgOBhAH!b z&J<+nUzk_tkHu8Zo{Bo%jcH(_q>O@wJDqO&@RuglHxgZo{|7%+(I>pBp&`-sgvQVrP%L(2%O|_c6RO~R%*?(FOYQ{89 zwT(c@M^_&F+l#auVB{oTMOLp69F-HoZM>jmpy1I2uJ1 z;I&j|zX7+Ik&IfPb$gQ5RrUMfr5K6WI-mD*vhIfRnNwq}Mb`T_j_dO>-8^lMhSJ%hK2tG4zy;TTSVj+}Ct zf_P&zjeL-)`ioNr{9rWu$iYChuL`aI)LRX;pDJ693zLaGYe1ZdQ2^z$<>PI5;h9l# zhZ2a1`!S{(3jmqPD2(a{E+ibmsQclaL#iM5S(Wp%z-h^kOhM+0sV8kv&kSVze6?ik z!P%$>VXcF7AhptJMJ4lW+CY3~`qSDEr4N{pAYvJoEZ9l9FEwqHhS1 zjG?Qz^KHx>D5~hS4t}q3vs@^M3eLc3c=_%Ftc4!J;bDPs7~T@X73lOMn~6e1=eaI4 z6JP3Oo)|my?JKwV4L1K&){fk;z*a{fnSrbiuAhfPZtHdj&B$4NmMi5*bEc_22Q_*}689z_(PtUFO-W%)3tZn5_ll(a}J z5Z80@crd)mSv7S$+h*Nb3Idt9$P`(c74dj5NTiBJ!FU#L`>mj znrt}i5}?B`51|{wvO#avOi;F(Y*O8nFAZ@XOv{&j3f&=%|fT=sF#LvO0sqHd7+3o z20X_Yh9-{*a=2k@jym8;=rfa1n`OQkx^&W3ZJt}dKHaZ4<@fmR-Ot-+FGFWnU5~Gt z2yv0kOj61*9LvNm12~r`Jza~0iK4tryqdvIfS{T6l`1=}seCGP4JghCna^e5il_4< zA^m!GF|WX;0C$7&EB?>O8Z)`R!ApZs@pwm_uz%sBEJ!xYe;}&LIm^6>g?XaeP(oLP zE`Ub$Q63Xfz=*%Z$naw_ia|8=KkF@=1nPj6Ei)GN|42)Vsp;7sVY;DS7@jd&g z8`=hhFl}LG-){Sktmj?-%3oMDC?q9RcJI0JyNb3r4r`?~el69372DXV3=l3xaaM3! zE3k&e-*Ez26WOv#La|E`c&vcmxgl1`G_r1vS*BT^{832JsQDc7+G-J6y~2BEd5W$m zqfFegrW;(-JmmY8Y<$3%w7o#%!#A?{OG)I&CyoGE0coK#*z~<8u3Q%|VjqCot?WW>@GD$ruBjxQOWI|e2d~%gnfqqD-tTv)=vCs}rEpMKd zKMZWR@5Ubq4)13D<|X1g0?~zM#RKWCR+yP(%tf$3QA-da9AU%8M)FsJT+`{MlcJ}+ zbigrkpWwPBJ9SZR3%%MRuVANOgr(o#DkId03-UKUVAw7cn;dJzZVD`*U6B_m7J+{X z=y3LwlZqknc+9e9KpQN{>Qq(TuMwnz74wX49PP#2^JhR#%Rq+U?NO1&EN+_g#Q<=U zS)H3wPz^940c@4I6p2x<$LCOKOF*mO`Wwsq9$$9Bvhm8;N&h$%xhKfL0(qU&dHP%l zVP?Y_{SHtLI<@B^ zsD4j%S@)w78!(c0ce5#vR_*52-0H9T1E*SD-X>*T)R4VLqZsWe-kl}l0D%{KL)C>K zB>h-oobB*m?5(hhiR)?zg#{hzAvd3Z*I7%dxK-Z_Lt@VzBB!qY)wb zihP%$7851BVnO;zC=v0f_Uhpg=OM&WOvtrU#9fCz_ZjP!vFBSxVO)<%K|_7goKowOP$@G!TosL}mh9)S0Oyq1iM;*HRojr-qu8$Kt8-F-1~N0)QQ?OTV^4 zg+$>PMO1PcUMT9`wm-Ap?)FbY+tVx8A-A_=K5vS@fK$t6!2j_9@$YEpOdS6;?{=#F zuMRg(s00%*#K!-&-*l53Ji&Z(um8fY^zFl?sUu;L;Ci{yMkJ7-%Bd(R9mb2#^KFi{ zL4Vsht_~5#@D?wic;BV)3G?m>ovJnyW{|X#%u5drISye+u*co3u-?;MQeRASk7XFr z@1sM5KHA`|tjEb>3vW-~CXxkT+VGmC{9 z+hbczKj^zk+S{b`)5Ikl3tVr7TFpUm9ihNX>eQyIx7HJc67zRx(F+Nwd2mr*X-Nt( zwGX?Yw!yJ*H93fk$2{wKP|@)o>Oz6?-T5^jvRAdbq%EVJ%yL?D4GZ&YaR>+4!CS^M zMUUXh9~4RvF$89S;;d)eXH;ep?SOTi|CtichiXmR7@rv(9nTQCH7O0`hnA(6MsoY) z7`U|(Hz!I||G-f7KHvazH}C-#U3svE-7j1s zBN0elK%p#XTPYCw_m`8~S8?so9c$nKl%j1Gx8mNGwPw?&lh6o_h}Qj3B`j^53o(F7 zCsnqVRhlPJoch9Lx<#osmT=*1o@)T(Xt-QP2_7$j5TOl7EjYqKnB$?zWj#?{zpvRC zRd5ekPr_YK@HdPO$pftQ-P}vX)Z}I=Yy_1DGoc|gN$owhiCNuMj$6n9#u*I-+bjm~ zcIXEF*b+B>f<)0V!uoMTgk0TvE*U-CY+4agUkV%&hwvURYkZHP8kVdX7|<$|Z73yl z@9J1w8KYK4@{$N)l9r?TBUBO&vBwkKo3-nQ-<7gHjP-8703H91M;OXJtHhpXukD6` zGTn?#H995e(-EuLW{|72(yz}BK3h{G7p`RFeKtxzaF}nn=t>>~9Y(aVg%;Hc%9rDH z`Tmy9*yVJQ2iVI`41YC3q6gvZ@>jbj!zNhK-6p#@L(TNK#E`F=Im7f#3emw1rr@6h zi%{jf3O=|{ve(D#m>odHh4Lv)C&{Yb7n$9(9S@#UcHd?j+TGU!w*uo8F3ip{q1$}@s?LK|#F|ub z`@!)e>JsoZuik=ME1x`C9n!iu6ouHe-9awa7P7;KGFqn}I&@0;&G6R|R*Rs|L`0F8 zmEs5!?b9wB)m8!b7UYScV@{qnNA17bWx(QMI9D2@1ob)j5W|pE468yb;h(PSdG7UC z4F;c%aV|^ClOfXP7dU!Mh^FCim-o7PahdRW@F$LBYFU0-f#7Uc-8}0FkhnhO8E7OY zM@>w&;j1+rN}Y+Jxd?6qm$6P(m5mLZ|6mQ$22HHG7>c(!D%cX-S@zLEe_7k~2f=rF zI;i>)Ev>X~XoLr|F6zAfLtmD>9#n%%$^kd^9LG6gfr{qATM5Q&PLfBGeVY;VS~U$g z2QVna)0S!Izy)FIZ!!!tLaBeu_32YI&jFNzbZuY5+;=VF)Dm;y!kKqPVP%3w750~# zX90hE90JxV?4E&^9^IrDqkdpc6<~R~cGRmiRMh4G1~5K5V-BBg#V&BY)Y2K=y#KpW ze6w$x$$g{J8!JaFa!@kN$$qtyY{KI?k#mH;TEZfrvAO?9M9sIo^Toby#l<{wA%ESD<(ZdxGXz7Rq#i*vKJE!_QePp?L9t@Mwj^RW) znmlWJ*E0vvcg3Ofv~th3vLi_@x-~D2?uIn_vl3EEjpbHIa`D zw-qS(lOiW@O1=49Z>1J>^D1Q82}7MYy>r1TkeK;+reFwB&VN{; zVHA=EP6{OG;{hQrnoQSUM0IKejtB(0oB1+tb5d#~l)(^dc`6nYlyfc0y(zm6Sz_C#S2ZU zDMVU2wJVR9%AfXAYeZ+sXb(@yFbWYOGBZR!VH@b>sy5rCm3B~VIBfK>aW=>oAYAqF zichq{z~;VPs)1CHK+0D_cy-ODRXw2CI!U203TgLszt5#c;MY%-CBU@n+f`LnU0tjo zCn&o7{R5Ryu=UHmg_OJwKtP{o=wP+)3vff0W{eYF0q^t7=6{djKWFz_0n}f`LtOz* zCN>g9jGUo{fN+2gT8q|*QxPdt+=*7(U3AjIgCf~wUA0o*rm7=cz`yFurQ3BXPnYhW z2$(kOYg}@?9aAScqwF~U82pvLf4V{w>AIF;0A>$sl$J9mxWIRC09{IbL$~-ozcKC8 zulDlT_2IJ%sfq>m>g4faQz{Q@du`$VpI(2@snzB!I#QG*OHGLC%$a@bS&pP zh6ZHC=SPc~bVFr9a8UWZkSype2_p<%0ibF&NNP@9G`?}&HMSflemreF8K z{ymsZB|WD1yjhSrpiiNCQ{*gHxRQ0AH^-skf`RKkfxmUyL#_)NRoNN(rKjtClv#)c z!Y>$25=;}xdReOy1P;p9r^&(0Rt2G1t`;&KZhf&)xQWpC_3o)qJ>GR@5w0mWxGZQB zTvUo}6U3?IK==g9s2p;sci?zsQ&$NxbuHh+6^%se*f@mw)%97 z)Sm}!F@I{mh30hpE1cC!PNUl3oC4C1DQ1ZR(^cusNK4 zJqA_?k?=&52eu5Iwy{Gk)TD>fez}D>@Ju0p(Ui3e!;YW32Ey+9+pUIvfW?oxPWV_N ztkEAiUyZn%8zf>5@$?3vMV=vawjzE7hw)mErSzcD+a%=Jty+(qE}5<#n@JE&S=O;mJ_ufnnC}b$v-l~$m+F(e&&@VjQX7gQLYe#-|Rd!KV$oQ=tHE= zB?AqNPi$U5VHuMW#~Szii~2go{OudGX);Z`IVmLIJ-cgXXi|z1ecmN2?$;t8&sl2{ z5ezKcF@iHKz&hCN6j8i~WF8+KjCmT3I}aEL@4H=fxXTjIX|rQvSmKG5z)v_S{A{)D zkcKpNgTj1>%kLP-DPxzcQ>C}4td-Y%kY8h7ZYO-e(H4Kp_IZZfGoa-9r;^X~ zuVAB$Y#jgP7P|P>t*?vzN4JhhAurG0vid|fAD>Rf??HjMa-8c7-ykdnW++Kmx<>iB z$Mu#c;U*#>qkk{Y4zzr4@BEm)%oe||B!~>hN1}l8xnt;^{qC69;VlR7SBP?m)7m5z zCJ)TbINLY3%k0udUH`s7$26cJJ)fl6%SdmQVGMq{INw{Wh9(D*DB^E;5oXfc?(&w4 zAc6Cb+@LuhbB$u&alUFFc5A&TlhLl&ff}42FIz`F6nQ(0OlF#cC&yGE__I1qubRH; zzLQ{4UKkH@mghWOXU6)=CCmD4I(ND9qA z5O@%>OK{$%W}_;?%7z9CR(CP1`nNx=cwJw8XaEoqyVOhC)mbN`r_-pa&`A=Pfuj`e z1%OMIsnu4wbC3^Y89K#r`q@sor$zv!W{deJgy3-+z~tFq?muYJzqEJW!MnI@qUCD-(`S^uId*jd{5QsNSl-WGgQ++p zaUS&{&lK&lnMZ9?X0_xuR3rv;lm`-MK*~7=ce5r-`ldZ9V31OgNjaV`ZxM;I>~X`K zM36XFumhD5`Zsha#kpMzo=PYj$aD1`l^a!U$Y@?a(9jLo7zr0}ajxPEqrj3vg~s&8 z6bW2S4UW6ee#gWDTN<`5N{FIrzfA`>Ijn1B4!2iFs>t0pnNetEy z4j6|I@1&pNDGvSod_z^tvbu7dgU87YQa&HSbsAM|DPEXDW%S&9mLRxMP$*zXsCo0T zts)N?m0^fn+;WIUbX4vUL;Lalbg70PO}#QhzmY2yWLH9-wV9=^lii2J*BasZ05mm- zCsz=|`kmOyz;+lz(3S-2BR#*r=s->?>)W&h)31x6eVLqn@zBo7E+qq&m}EUM*+sIh zkaQX0u~rQ7X22t(uzaJ=A_mJQ9fz2{3!c5`pF-b`!3Drj!GsE^PWs1~ko)_%mp6*N(1zF75apXmh=lSAN_L(qsN3Z66a zq{yF})k-1IOqSK_j;h;$_+ax+XUzMhNQVu2J^zMvcL3{MUgR$LLhF&)pS(a^txj)H`d&i-V`4t@3o*C%ocIx*pp)YTai{#__gJ|R*1OZ z1xNbjfg)}59@b(hzqBm-UXjtQgtJWpyKZfSW4QI;rzG(4);IV5Nw8fEgQ7=J`&XMra6aq1(pn8iWU&}<(KOAB{~?x&J*!i=qB z0`=Y94|nwkB;Pq~h_y|_0~_bbdCDB+_CTX@=yw5}c1`j`c9~Ud3m#2Ree6N#QM0jZ zV2Ti;*-&dlJ{99vI$vrOXn65|A&$MkPHh|Uy>l}7WcS7J>juBQtbg4-jlOt%ZKuk1 zj!!$+ETKjZL)?Jn#oTY~2Whi#hOqqrVYm?LceONrm^r!W<&GFQ)H5D>Gy>FmC-GWO zALr=uu?znNJ>ug<0u;**46K6I0uTN%KI(V*0&1B`5dOzT`mdORj4c11Je>SrCoN*r zfA(6pvSl8U%S9vdU@NB=dQSK#skPuEb>yQmoae(=@&(MJg_#)IvxEWz;`=Vv+l144 z_a?$b-+fdO#oI2yCNKH!_ysi*N|aJog1I|9BnnE1a(UMCg*Qohig&^%iXvZ}5~BQK zeLUS|xjv8)&17-z$JWOCAq1ZlTe_9eFt@iRGuPAOqH~fw?$KLhsj>2)Rq*S3n3^7j zq2{avJ?ReRTp*YFLz(7)_y#LbQ44yR@cSDLIOq$pv9aICeYAedz8F&XEC(GB84bbdlj z@reso2qA}QlI_&q%Ua7b&7^h{y(W57-c9+cYop>{vhIw(h`fX$u-p*K%O zYL)AV1pVStvzpdn&Oc;bIvk?SHAxfIjjV2F>&5~Nkr73hA1Fi?vCi^U*gd5QrQa9k zm?Hu6RrOS0liZX!a zhihwEmJ@25QfO=KPMV|*7M;Ywm)Li+X1;++Qp45lvkM7I!WKZx!yuUVkBD^8{1Q3a zLP_*kbe;%AcZT%K?B5>*0az#XA_j;p@F&ds&4`y}!G*J9s0hF0P%u%5JNaGnJ7FtS z?Rxw@8mM@Sis!$?#Q1x0S8z%L7e9v8uk=V_FvQibZyc|2^88wro^C6MWJC#;NVuz5 zdB+q}ZAxag@RsfN#WmJUc%itG3wfC-@sjtTFBYYcX@G&NTqe_AOW2ulrBp~YM$9cQ7_H93v?FdVx$y;bv8Kr08gLUZwq=l`~V3l8a4CSGQ0KonLV30gbCP zjUHnvRP~XTdDXBTXNtbKzg|SkIDNfv*$`>jx%$q&Ks0QuR7|fi{k4K7ZRrP}SS^&d zt7%IJeugFe=y+W)T0B6ddzh$mqH62?=7WJ62@IN!Y@VOpsb{Sn@K)?7M;8152`_8u zG~cVhZiM$xi}m6P%(sGR@9?n%&FS)2P3;C%V4mKOJBarU zg=4-dZBMv=c7;EEw#96n>&bFiWRLgCyq@N^g5^@^*PDO>ZDcj5-agj|wCGajyWv-C zei|e7=FuU*GubYk2W-Qmo6f%7{emiXvV}qKhO_?5vwD1O&ao%rOWDwsMphCGI*%+6X>W=?BP0R)q_mm4S|1|m%w{1GZm^ge}wzBXRB z3g4SJ9MBH$+>&2riZEMa%jkDm z9Rr&NI<}`cN#rP_>(dGT{E@a_J8#o;QBuVfD^Y!}K9k(;6vG1&?b&U= z_%s#ArpNi<0$ACUVJ7s`=#!n2V~qmi{7tl9z!`Lfg5(h;4x|759j^iVBV_Wy!W*>* zW_`8&x~?}AEh&=oxRhKkaUd~Br#zpk2KwyT2*}lC z{SdX}gj^3FMyj>rm%-=}&w12*uxFP%913{Q^ji|!VCx=FZWhGD?{j`kMrkwr(7ZjN zB{|kKJuT&&6V{Db-_9{nB#3vPdq_$fxO(7zJ!tmTW?xcK(D zuCxAU=KB842Js6n8#y&2&RVe`80~`2eRWbGv9$?C%$c+`9Yw^)Bes`o^UdPw(AYqMn%MOFcI2uUl8sBR z2VS4%_2a|U`b$(+)*w3)iVl7z*Vt8b>phjst0kjYl;1*ink4?W&!ZO?Y|Y`a!l!OR zjK~>cAxy<~D@l>f3NTo66qrqo4?4lpl29g4f(gDR!ZCZSJRD~6DJJo*-04-$Zn@;= zAdFfyVhz+XNJ(Ws&s(&&Pu^tIWz@;oE9%wNCq&gd#@Qm_{bP~CY(;m~2Oi{ZmI(0Teh7PZ{%Vu2L z3CO2C4wrn?XhI=B9Xd=ah@(^uHR|5|UlV<*X=1WHb+^d*KP9k~$gMfn~A*$(s)`lu_lPjxKQE@B#(6PQ)y zmIMw$?AK1VRHeMap{wtiNFqV|l;$9bNTlQoow__dfJG8UU6ZRF#SOz^6FNK$ z=6Id|cnwcrkDtP|L*WY~D88ip%8bykd77ND?%|CaRK=$PePQ+Sp-KpZ0TVg4sdtCV z_>BUPB~?sSE$ik6`$gCHYA zEyIl~wz;b}pDW^iAeeccGCx?<;sCR}BcJuOH`39sLm>~H6G^V#^jjAzwDEltht;(& z)<-nvQu&6E6D%#KS^I=*knZu-Y=*o z)UauD%F~=e*E-}ur20Um9O*K-kgQ^Pz28RmSr5Q0hzhZTIk3|+;NtrJI2Xw%F}_I~`X}|wI7+ru#cO1~B#_fg z3ZMprg09fZ$7c(3w#vy%m$j`t>cMd(fgh9$qh5v2(h#fwnh6XJ6V|E6!~{VVxBRoj zcrpzu0h1Tc#&iTKBDj=~S$g&1Xdw_>9oU&~xWsZR5Zns;jdmK^R2erseb#SDf03$HMB=-ylT>!c7md*Bjb{wMt$*P)~MBT>ni&XTkjPL3^{A(6=8bYcWs(ONBeW0kIaUWKDUmb1bjvY-_4>GO(+!OfqVe6vRRpgF{59 zP>l9Pp<~uo13?2C96HrKSRf3RMuIcjy77jCALRw^L>EwtkbQNFdc~I|G*|OhXmXcl z(@RR&s7^OQZes&9LVn{lUobJ^OL>_m`$U4p6Xv?)t(%^ruGW0pL8r}%f5=$`oX8lR z6QplUll^iWDI&IRI-Oz0!zJv-qjoKQYB8}`0{phORsf=aBS5C&5)NF4us!dp5u9#j zNW1=73*y@^VP#Dw38!_h!i2_OoM07-$Vaa^x#(Up+{_h zR({(IKJZIbkD`!VbVI2m*cX(rKwBnZ_%|#w2XVa$uvMYq2CLrMSb!{0y0n`+cX`I7 z0KHKEa18V{)q_G^4n4?m2gF~Wtz7ZlbHvUe++<=#{7%dXi7liH{xQa5cA%3H7aF;@ zEWvc5)4NTucp0Ei-2|j=PugnseaNI87iUT4cwV5+ zSx`c$K{CzrbbG7C`HT_+)Q=CX5A$Wqpbfzn6@Y$a%Fm#v7W>;1HHL%$jxq~uZ&ids zo#~bRlQbtHkKLF-;|VV_GdqfCNG&Dl=lb)>Il?-7RnmCbf)!rZbb8{2mu4hUTHyQx z6SWvKyyi~}VTlOjGXD_j1Vn2xeEK?tfgqT(3U%~KD^(*qP}$fpL;{r{B2?Y5P5dmDK#$W(kBX}=SKzlWCPJQ`u+AFkZPQI< z4@2DOBZ&K>Rlqx%Pt96w_^g1fgxn{N7WD{O{{or%bkaY$x&azZ01qk|_W1GCFZ7j< z>tBbO!pbsS07v825bOxd%;$p(%Ka9y#+UpDs*iWiNBQ5R#qF&u;VU^G9^CaQkv0vZ zkMFUOkG`HOWzIc|0}%%-fDv0!i(&-S2YHIhO3&a3h)wl7wXkRVfr0wMWW$Ak3}U_0 zd`MAe-7A4k@ez;NbutqjAN#pJLAt@vu47m@sQ>3e%U-*$wk}AcJPxlH>lo}9v3S

    z>RIqxyp*l)I(IEQ)LZOJoQQ~~1u1Bc0;-19j~5pIyY(ctsTgW1 z0O8jkM%7whq7di~C`hvi4?*9}(>2E6E0*EG%i5crLlPLI7%R=gfhLn~4w!_jm`o0< zt2)QMTJqaqNM1R9eW(#bI3?jmwm*1f($jR$3GxXf?gdHgYSu=*%R&oY;LGjLLtrbU z?&^N*^PUJiEBEIh703hZ&p`^%>m--gOX}@ahaLY0{P*&# zlLcDt_gRT|-4K@AFDsMUW*P;uQoJ@GF$@^Kw5*| zf?Vu`IWCrTlD%@7?k4{y#wh$uHh-XeRR+rrT#^0S@p1#{nna~lcsIe;9VTNGlns6U zXoy>f|IP^`N%d%1g9AUW-zc768s(lj#|aa^i6YqhW9yR@1#5D|41~Ob7^S0v%ydQR zi$``Ps$iN0eYmG!HT?Avq-k2$t-Yqw07_}HhQO7)U--AU)^^N}*!2jW@8NH($xX$L zZQ9Y9Q%xC?GY8%RT7P7!3{&=t`8HO)%R?k#zA!tx4?>N_pK18nR6aSXvD8A0rFQuNv52R@}(pl%r2>k zs})qMgGzl9kp#TYT?%1a5cz+u>;wi-grJLM+4=fVac&4jiruk2@%;2wqp-zrDu^TQm_i}O;2@QbyZ8y~?_?bvEKt{{pkjPTZu-T0X%q(~v-@4!QuqT^m@9Q5 z*M)QE%5!H(KdI+k@j!H{YHxB;f}&78a;$rlQ#B0W^EW%6nl)+_`sxg)$8hya;*XnO zJ)X^F1wPw`9}JgHG_)*bi9302IC^mb35tB1oMqbX9n$$9=Ez$YvcWO*!}uhz&)_t# zLTCpUdTR%p7wdHqlu8Il52tw8JmvgsZ1W3pk+LH!2a0*6^}ULj_1Qb{HebTd-a$HJ zbpJ5vBDA=&DZ)vopT?i&SHqpnv)7YYZhN>sM^gG2+>^xnfW}W?{C~jS8>q|E& zl-V?k{j&0L3ZVArMUwP~>HekEHGG zSqVB((bfVkKxHCHL6{EWlrvC1ZoKMakQ0$;*`nq_f__*C^L1T#oRRpDkn~;)#bxx- z%Z{z@KXALxnxgPN1Woq^sC1ry3_Q4k`BOOfgNhdaa?5a@&}w z-svKLC(LLdmmX0^8$4cjJ6Ddnm-dm?uOIvhI+cY_u=~{d&Pc>+>SK@%njpr3_ zZah!-eHo~GWz2H3I887L0}^0S8K{BfO`5@3itvx1?y}mN)1$8oQHV(?F^FP}=M=23 zE{#(cb4M%ER<$FV18s?kuC1k;txj2snBv8u@s8V!E%YZSL^zW&}@%q4IG^?$qlPFWCIh)R=r$gjoXK$> zkiE5CYTGJRthZ!`NM%#x=RQf~nS?13rb zslEynB;X&*yCry$dwaWkU8ldq6t#aW+J=OrjAAg7b%DO`B@GDZ(GHf7cD^ZZY*or| z-4nBdBoGVSDJZoyh*%}xr{-{f+}z%t+oNHOFvel+lZX5<#V)xGFsIF}GX!1LIghv> zg$nRK2tx{Zl__GT%2Lkv>Xs`-VQ$-!DuG1R4-x3+7Ri4n!B+@DuSD=fnHT4-6b0~x zmF<_EjB@foTF&yn@?yD>ce)=erc_(n0h9|GUlv~CZ%WU)H&}|mFW4%f9T_rPrpM+s z(%Puc-;creNbF7EhcWl}|c%UKe&$CS`?Rh%|mN%ha2_ z^LK?laZ~(NgrB^t$Hy_S!b$iex&>GhICsFP{z*@|)Jr)h={dery5$JiOg0+`dM;xz zfFs<)uv<@i{GYIbOOrJlsOc@cX?cmQup8f*e8Ok&%a}`w=lQOYH2A@GQG=Q%AOuxPpROO-cf@Dxgn=|x6sD4tj>fj)#Jnl zG0KnZw$T(6NISc$5x9Q!E~&sPHTO^6#{u&5;(A@W{aaxB?73pGfEqn`*cAt2biG*O z-YhxXpuqFoF4y*(o30>d#(bt9ofHNd&+9Om#rT3;wY?}BW9tIoIWZ@#?ObNn9ZvEC zj6{~)N;v%>L($qVFT83I#bV@6L*!X(T>5`@_p&M(UT>wjBpRb&d#uT0VkcZiOu zSOp`>HBa1Vq$>zufzSFDI7x_6zsBLYF9~XBuRqj_aW1dX#IP9s*cF(b{o9hK(h9=? zqH|Rb4;>}wTj1U52qQxA#u@^*SFiMPj+zo~!F@NTr5 ztT&Y4M7*5EKc2y^hw}c5` z5ke{#w~V$Dy-i3tS|n5~yYxc{MEKXS!^hNt!K0Wc)AyQ3>3hxdtFk^hd3BzRnHU4p zQry`s6Dbqv58U$V!L2qOhfYWLJ7azXQ6YxsdMA&Ehg}y1hJo8EO@BXvjn5B+>a~Y9 ztBs%2K4ot*u5WGHD9T5R&Q|H*DldNvdA)=(nBdwnPxa>%Z3CEhbe4k}2?TH6&zo$r zd9b_5pJayA1-=;*FZ2~d#IdS43bJBn&69IFdVSdK(h~nk;11P0Nu~&Dq~7$jkG0lQ zwddK>jd_}due)m_TxADhSdL+*D+<*Jgq0~wDCDm$Gr9AD$j!|bqu3E@VZ|5^We0vK z2`}U!#vLyD>s^^|(qIJPymoYW)H9%*m;Y(A+KP@-r{W{bRf%CB;}D09P!b_pa@*AyfASMd)wr@r}`#E#Dp?J_#{$>qHF{5)G)+S*#ezB=Ey zUS{Pf&$bUBaO&G_E0!D)Lg;aNRaOekWEoK8j(#V=mY3FIZg|kL*ty>!1Sgy_^1d&W zecqYYwACnj)I_;+=PJB2CU5V0Ak$z>2DU)w)`mt&SFWQQZIbhzvc_?U1A3?!#(_98 zk3lhF*ul}1dLh3D2EX~FA>QUA~Rvh#SJG^B!ttT!q!`4=GfZO(NY zo8TOm+b*+!N$@>H9IW6wV@+qHn(0@dR@U`DAa8%kOMc*=4vF-3+v-6PFMbtw!utdu zUDr^y=TLv2nm{H>K4O7&U#?K z6P8eB$qGUAFpm=YQ;x!|6~zuC0z`|IAQTQ1j}90dA0U18vV~&?ev_|DmFF1<7h=q> z1tVNIA@fvS$@XNcf>E%Ks3F(mfb*6KR)truTd7#qzTx!YTYs8?x>91%3u_*vYLw%w40W!SR zZ67M_#>=E)3Q@Qww(iVx){@SaH*QZ4C#NLQh(95{&#mnQLo@k!?(N_TFh0_V-RuxP zS&-Ux2GG8|u&BrG5b=%`Jz|<;a`ntO07;&ag=9*lQ6GQ`73Ge;0wVDE-Q91wu_0Bn zeOon7j_8;>AoGzg{Do_&0z^qKwumn;i|z^N&{%KjbBFJ({KE+Jrn4ZdE0_4n47*m)|QM{`XOk@ zM8xaJZ-1E}#T$0IQG^zffCnaMgNS|UAvwFP80dTaGd)xid_9vHJQGPgfwI4Wmra`_ zU~n@pl-z8@XAf+yFyfG&&+i05W^j8iw}{W*`>q?%E4gp@;0M}TVMe+R4tp@@OG(eF zoD-k41g0uBfmu~vzQQK!-mWIFfORm~K^dneh=o_2FkywgyX*xcMqe6B^;H(U|H4%M z5M6Z7TI7%%8YQ?C}<$;w3pXG(eZDr}JG*ItKBS{Q~!Mz)tb_lzAQ2hT1W51+do zw&HNrqa$K!AmTSWuA9zOd>X}Cz+Tht)}N~YRP^+^Iu8p+X}sSJFjKN?H49sRSVlX~ zc8&_dPb{pWBBG8UC#;OiZ_omd==rke^y%gsuP&|3Uh7C&^MSTgHSb-#{KW&qgKx?t z-^$B;r?2Siv%6ogmz}Ss{;`w&D{ur8!+$3hzL}HN>!QeA)71nCu;3}Uk6X+TpzNv7 z3>aXcA2B%Zo;d|g!oozTbUME8&&oC^rOXfejJxwa5Yn-mi;F6{UXAQ8JiQX|KDI>A z@00NtlrNWrFOQ@WwozdnJ)`~YVC7&+$_$Cz=UWBa_+t*$>rSGSGK^kbQy2z^R+`p3 zUd`Tb*V%!3QDBJ#YnDiG>&@F;1EPxX{|Wz9jH&sd7&~8BR0=d0o`f4LbNgIAg_iQV z#pyv~mu}i#OBqxB6vntIMtG3rJ4{)0M~@!@8v}o|C{JMsO`v)AXIp29rPN|wXFZDu zaV*~E{n_;Uq;=zL1vrf8yAFMNTNU?ZiA+Yp`kD5|MaYvdHc|Unx^KEU1b9J86cUQosC0VIhN4;K1bGn$q za9w*2+s)+PNld)J)6&DehBa89RxG{MRc~QGfw5huqNDEGn%T6rEn7s*^8j(!Ly;cq z_eDq~K0;nZ&EW$dUXR?}D_@?K;X8jy-A#3V+LqvmZ=98dn+1@H2JH)E&cBq%wO#H& z*d}K3VjnQ`=Uy7T>h;C+*jMcu+gkigk`hh?5>g1vOeN=3kc^OJ^*k$bS>ZXI>OMvI z`@@AK6Bk;L5#bl5ure(?!5uYT=IA-);r>noSq||4-1Bffq#Dg3MN|z8B&O~8*iwoC zWO|EqGvwV*IdV&fLQw(2-$D`GRSL{d;(kb!&ooe|$b`a--DVTK{7C&aNmTK(T4$tK-&x3vv z5J2U7Kegv>rFpysSq@R4+;G!m++~A7gv232I=q+t!Y4+qP}nwr$(C?PMoA*3Exz;hevWAvx@ zZ;3uJKVkZUD~YlIbi$7chC5UCLHtnENcM+x(i38^rJ9cs#b&;=?mnv_Fu{|8IP?rE z&B2$ab);|y^ecY3i?2;maxP0v+RC5Ae% z2jUxSXE8ZN@+DEMnMKJZ2fx`&eG9YPz&;8cD-r(t%7{E#SzeFbE@p}?*N?;t@~AV__Y-Elu0YcA;%iy79}9nr-Q z!>iYKRF_cLCv|8_qkZ%4rWmGUu>dU1wYv=z%vFR{=8c;HUQ;^dvP$`3(NJK=%3qHM zbxWl-xW45|^WbvG&<~9eauxCCiZDWwh^<>ZdzWb_-lXe#AAa#9nap}7HXk?_ z6UX5l9WBgX3IA$(cdC-qa>bWc;5n0xPrPca31@N>B|yMPZB%+njTv3$>6tMFvRV=X z5s*c8hDPNupvL#!*yaz_BMSeqrxpH-IOHO>0|I>H$<7?3$a45gt#m;b9y4mL13BZ# zA;D9>cNhjldD4BM2Yz{~Uilf76&)LLR8p4Gc~Q#ad$Q*=k5Nil=9fDlRQ7}4_lt1o^Z#=G*frh-+%gMk`tN z&+8aeY(sc4b>&papB|at==vVBUGk0V5fCBR3yJ1>B9fyx)A4rF)7z*`v}~YegWK9s zj9tkyhY zTn24^cg+Kz9RK}tL7(^ucpJ}8^cKle^8gwa!I#5;P;wJOM+zn;M`gNqh5<=X=Sj+3 z9w?Ii38&+aiB(g>08*nd`u@%J*p#I@2nOWZJeOI)FwI9Z4w|zgVr(CVCULVm(PHpy z2D(3lim1yEjRnx{5T+x^BS^?8vjR|V;-UHS{fi!6xx3N}KB^$>X{B#{(n}~iA;bI|{4@)ns>9e^Z|I@g&yH}JB6*zKO-X+^1p#zJB zA$OnNvG6-VNE=9sG8LwpAb%mnO(u@6q=aKFwG#`p@~v9>Cgl$L;L6I5lRm4-0Oo8# z<)X7{Fr|t9S?=uHHy&?F2m)naOgu&8tW=b>eKLX;HUGVo--G>i&E3-lfJIYK(A$ES5kt+cDq z(4$k|4@eDN7wmt!9x(qaqYegE`u`#Ww*Obqxb;7cu1vZ2y@KoIT(NbQ4ZJe0Ql>=H zdJ56F1Qg2qH5W07vcuUB#vB|vQeTpA_WSFM7^o^BB>hJ`zx>N+zt^u1CroZn5#Rv% z0A!@B9B^Vd2qDPWz{TNFIR{Q&u1}V{|FpVY);BUSrnRGphSXCl(5)}8FM*oazbcjM zSuJsU#w(+L6zk|etH;yLWS!V@C`+oxb*dFroOoiRjs-iP^yGO?&GR48 z3Vd#nc}h&?^YNbdkLd+|NI?+9^V3>sm;y0InLtvz^=R!b^ZOD%zLk_63=#%mz*@Df ztXBo(Pg|RZe75?#Nd4(=%ud&*p@#!=x^$t{Q7gVni4POBNu^bL6e+mbH|mWny?usu z**-yXn0^P_W8$~;1z(rvYLU-9Uhxcclnxz4ejcOV$CRiw~Q~?Kh`e4j5{%vTFj_6yIC-b z4WCV6GjqUH0mUSw)a;P`FvJCm6|(?TNc$@~g^*lLF{T2Z;nu<351{nlYiDY0bqLGM;ElQL>-I-8{m!@TS?UD&(HtJO} z$3ZfQUgqN$4;WPV>qiRQ$)2(NGDk_LMcr9zn^nYsVLJQ=GGl7GC|A#X_4 zg;u?>?t6l-8M~(i(`NwK2C{DuR?J`)K8qyM2Y@KXLYf}w$>&vnPVmxNeEtd<`ikJCU6~KIteH0E#S46GI%m6jtG>q&fv`i|2_|FG?_t${ zYHr|XHfOSu+@OlLFFIgtRX4{>oV+WUy4;u&b^J3fn5v%1QSRM=q_%*{ifKZN%!d3q zM?gW?MuWjb7hS^qDD#X?Umsjgww;sR_m|S{s3;q4(pcZB7h~`bKV261UNnfU)igb1 z0fFde1_Q2!SCEL#TNdb2r1AoE)hs?a6s@M2*ZdULb+tQsJ&frI7<7vT~+}tO2x;GQe}4eG`AI>Amk$uiQCkX`w}^682WH@eYQm% zSlAuN*F{+5@M*8?qRSk8q1ygwR-Nm0&UhMtFZ1ue(*bM?oYW@hoLT4`fBV4acaU}L zq*#jcnmXXw0mD29du+#ofWv*9%Uat^TiP~|M{uq6wo_Bq!hs?7{{eP`bj)SEPpq<;TWL`62^QD+jc0 zE}Lv?%ns++Gb?ELyWdCKj2gR;^Kp~&$@ykiMebWcOkx*UJn>2<7lc=XPz(pd`3w*949v5_-S=>6qr|fI9DYc7^Pn(30)^|Q{ zqwZQ9*x%T1ib>Vjnx!Yrn@^4sm=~4Co!IOSp4CbSzZ_;%Sxj&m0+4_zdngLq&)tj zr`=UBWRe8Uav(^juJ@Z)+@nN*{SzQ0Xh%l{t+C&tDOdu2jY*~a4Z!|Eenu3e#8j^R zmlU?(+rdhb7=Bv8D2Ue0lhBH{gWgY~2!tg@R&y;P`Ph|{uxdzbdXvSC5e5@Tee#`O zluleq(%HGwVd#O@ELx75XR1_U?slV)!E1U)Ydt(HtBxG$mz9UY47ct)JkF~ug|09e zfrBFOp}+c)GP2=!tN7R@6@t%%h!glkIgvG#5pvvr$d z2{?d#4F4{+Uzpf|KQb6k&;m(AIBc{HAKg z+M&DJ5uQ5{yEY^nAyut;R4u&66aBt-pVf#8a2DOk^#O?AKYIShU-DlO=8WwBcXqBw zu0*f&qoxr8btJ-PloOv(hByKOU^WHu|EF(Y`FB7gJHvm?=Zn>TCuaTtji;(*4uZ=1 z16}D`_jQWN69lo{A{_W>&0!>QfYsgOxw6mP2pce$&B&#wAUr%g+q%Bn(@Hc&5O zY#IIE!zH}dJ)N6gpBdI>0#f>CCpSJs>|_y@u*XAT4vwoI@e~BDzB`{F2~I*R`btnq zQ=rK*%xED=O6=;CE$vFw?>)DoTsolRunCSWWr0h!*DBT7T1L~y9FMpGw)74KNjD?RgpP2_aDq*=qe89 zISYkZajX`=C6OeS7a*787$LJLg5VsKxi2DAF{>MsA9{B@I7PudV2ms z!DV$(m75o7bzUA1@q>R-lO}+&yWfFcg6rM!kxnXM8~N5_VB~DnK2%{GCy@MtqSCIr z3O%QCE07FA>2YKFo9YTMUoG&L0S+aL8TI6pu?f0&gyp0@KXoA z+WAZnZEuow4Xes?O%f2@oMx|X3b$LTsnNXOa|;eIl($04qM#YZzre<_Rp^-6@4%Ue-#v@Tz}O zekWsISCBDZQ!ooh-d@2^5qOy%U!dBgKtmxJ)<`+{a(e|o<%-f0Frv*Zq?tXQ zGhv=tuc`Vw(SR0CP6_%1NmLL2PlIizh1=ifz-qd|HQu(icd?k^t!;MLR1XL9Kt5Sz zU+=E`%_w72`s<&yw@Jiwp4kl03s0?fGt}=E99dD z;eclFW@&Ezw9&YO@gfdW%1PFT4Uk>2tvvt)A+;gMhzP0dzwY2|5FLzaRhrHCa|i8D zCZGnCGPvc0U9l^_8*JuT;B7db$;*6d)xs?w4bKIs)ux@uM$mkqU0N?Q zf9VM64|9b?aQ3aUZ!hU^)>@-lX1ZG+Iw^SVtData7r4DwM>E)P)R0FE(Aa)Bcx&gl zen!Af4}1~)g>L496!OL~8E`5SQoY}Oe89*!gLVxu;RRj;xRJ%p3kNqVp!?W(1(;>O zwW#Wa54A1WmzW)1o@TL^C7pD_-J5yjMt#x1seFuW2^={%Q~$#z-k4u)nCTz1@p?(8sROX+ zPta#(SOq}axp!?oY3_nS_Kl56HKq0qOv(3d_OslnQ^os<0x@p-8x5>=9r{pTy?GwS zgUBM6QaRoZy7S0SF!=7$Bz_ZR{2cRXUr&@fO5DG=Ag!8H$*&n&Kj_o_xoMAmhRUDv zoI2A^us(z)*Cs-Z)DK;Et<>#YElkhD0aqR{wYbUwgZr}j%Ay{WZ-uCQwpoGXcD(@x z2QcGOH%&u(g1S0uGj5O2G;95Ll#>bq^;doS>jfula6STNxGNg;;rUr>E#a8Hq!uCO zR8K6h1`EkFV^or38t=xP{N3E5e6vmHn?qHIlSW^cG&(BI>d=LyLER(i)2T}qZ>PU; zq&cXXz6J&x1>2;f__3%>+lzzRzSh98#&bEk(fg!_EMT_w)mWE8@bbFt;j@}K3<{ax zBpU3j#SPR}9iV0#B8aPabIBYp#Y4jngT7GebFl!6lg?+bR>-qXd+sivKW8dyrG10TOe9VP@ z=uL>Xd1EbpeIqKqg^xBmLl7r~@BrITX+G{=(dEN8;NxYy*GWj@qwMc7c{d0WEKIlb zkWN8#F%x6%F*eocU(@VmCXd%CcBxJ3H~8iFd2{>S?I?>I+RhW|>c%2wNSI21mLgh8=lJF% z8_^4`BKM*nynpvQaytLzsm1M21X@%=#!6LNH(eS{8h&%r@b%NP!f)?~)9YDKv@CR@ zJ?pOb`^U^&8%hGmUVr)n+WNB2eR8~6@%+59km0zX}{4mQyQ%q3uy zMVx)SgV5TjGplIqL|08UEz72m6emG1nk-BFu^YKQ`CKo?ZsMYZPIK z#AVe?(vT=@ij<2_#LXq#I|SO_WVArL60mUS2MwrDcw*5-Y@dx}(d38KJq2urU0y<5 zJA1!mL6_eSM7J$wo-lXVnO?!Ge=$MB3Pe!3HYh2%r31whlvLa=kVZum#ppS*avP71 zjd&3REL5lmbm494i)a=xuO30;y@N5v1Lx|xG4exgnWkD93?Ko@LrOFqOA%f z6!I}+E7}OcvX%zsOl?MRc}MI5NA{3bN2b$dP3Psp|K@#>{&f1#EVd9>=2%%nXjG_d zrdt*Q=t2r~q}KvZCJ>rrAi$$l9_WvaS{jAp zRE)o*uL5pr|KJAO%+u_4Fv?*ShKS91}w4j0t4)TnBRdy#Rqln&hr_xrAo}v^9DV8< zLo;Kyu6uQglw7LeRk47^Y4y#a?*!8x%30g3szD3wP}SoM%QS!FV$7)QO8Oa@>ey&1 z`5w!Bdwt8TkWuL_z5;9CWH{Lu=Iq$6vwa~wrm63*g=_6Mwi$Gl+zy|xPzw0#(H<&c z@x$}Dn0jTWR|W5dnqsJnw>JIK!=7zw&dDlTXxRaip(DER&dc$_qCYTg&meu~r5m?H*zY=51d+kcr5G%&<*B2E?d6xHm8EwaC8@t9^{N)u? zqDg+{;W=Diti7b5eZS#@2S-_@LtN@HzRHBahy#QdWc$~C%gbZrHvoDIsnI`HrGJG~ zGBU9;{@>1WS^Wp8WJl_`t)+h=2DXOVEpo_|AO)rdi@YkaJ;z>RO-fQ9+4%Sy@}r_SQs51@k>7DgP3ydaVDr_<0e!>LfxxVK1ZdEK60O z`X3vc<=O@ zfpS!iOkK_U91B66u8?9N@{J^E zdVQ47Y&nme1<$@bRT$$k+PArU1HmRE-!IJ2 zst=ECwG$P)e4D$}mob;H%jp!A;8JbtZ>n(4w_NsP`DC>*mF1%ss(shC`mH0$$08?j?u`0EYEocm%3HTECcjxnz ze=oXK4L4Y&9EkR#)d0+VAP{c>%av?%I{<+TRRslk$#y=W_lZbl~99DXdC|BF*X(U)NBnb+%AK&e3xl&S$%i^%} z%NYwwx!U4tsQ~y}CV&}=`SI|%Hkmzm1M!f_TWGZL2!n!go`yo?A}I9D1W5MoVAb6G zRJwxD{K$bSK0gnh4x1*!T7Bq-VG)xEihn7G+K5dNCQ}h66MdGvAnT)_VM48l=;67} zpU)Uy*aZa7i!rGEVrclm*JnYwGXrBt1V#~64=~Tz3ykD^(44LUwifRDN)yX}BS!%q zy}HUguB`D?b?dK*wY|5U9qJV#?ElT+z&vMIsi38Vuvyo$SLZlQDfLEtq)7~O=m^su z)y8Ik8(}{K%yJm>ViuFC_wOhxt?mno@z!x4q1-q{2M3y!3wO$iMMC()xTTRDuacfGaRWFf@v0`yJ;;k-nNOz!3qoe zh4;jZ+0=KHwoO?cs{#uJ9K=$ElXZ;qJ>g`miBp|9YP|55(Kl)YJh-T)#t~Nk6~#0T zfTV9sTQc%XTb=_G5%MN3?i-Ax7`DIMh!b7_PM+aq3p#l{Rr`3^4F^&q&MIV&5y9Py z#i6M5WW17IWDWsw%Iaitb}Ci@Hi(4a)Tg2l1B2CzKVv;Ju>4)P<&cOFTod`y6eKLh z%MvVcuY}W1Bf>U)#jn+?zjX$FGbxZm)v?fDkB(DqBg-Mtcl@l`zg^lGa(*{dYpP+x z%Xz4;AMsJ_drD;SFOqH$Z4yw7*uFiY4%2mhMPyF}pDfg8_c96idL(8ItRvC2d_IQ~Z_z;5lcm7(rZ>HVT*uKjcP98kvLYgpi5y>CwgYs5W+Qi$-xi7mNVIoKv%L#Q(|KcI4eEdHKU zC^nIG%)T&K?|Ib)SEKL!vj{dewg-H@71&H`Bt<$cI*V7yDEc}C^&y}DL((#(N{mh% zZC+>mWKt5jOSPK=Fk)Q4ePq=Xenpm3EMA*dKRlqfTB9Yv0>Y$$`n7)zWm!cgFL`8W zD$s{{H%x7$Cqe$h!S61(U$aX2Bl}S6Xp3t3#ze&3d~ySbth;!U+29nKM`Ugp092xw zr>zc^d8RWU?LLS6y4x?8ZI04&*b}D>?9L;-3oM~!gW=avwo=DwlN_^wxVhNO z>&!%`2v`fg2B-PF%0v}4_Q~9b6@38j1{VUT1Au?f6E#)B=hwyx&7Sbn+5${Rz-mwC zMtTTiB+(pFN@>E$T+V8vYdkUbPbprLlO?SRuF5O1g= zLceM5FunmwBfR&3S~Z-@x;W62cCX^i%1|`jo>hi(qkb-}K0ojRkI!&ql?|(37w0wr z96gZiLn4<$cK=&oCSH`3JF5-gE5|$A_vlfr&I;2(yIh2waGa(}r+Owu*9n<`uLjiG z8uiGG=h$SA3=(&SK}Ucg2|>`qgD0?8amBkXwTDu^&b2^`BhZ;=j64ecuuZ>aw6@4s~ z&KNWs0*Wl@hD2g>&pM^{kZP7*I#hOUsm#b20DiDyV-V4Tq^?KRhbO|KvC6tnv0RvEO%4m&vs2pS{c$ho5x4u@FPVnC`9WNm6VL8oov^Uo=YaFoTJ+ zhVpMcYRn&hxM;Li(+&;i0TU>;S(zVO8izNZq7oBl?HLox-wi z)>kQN94rff(zBb(G)=2~qtog12XG>%A6D38yl+37pf^T6@OZES#tel}*kXIzIcuWc zM&Qu@P!ErWs$`X6F};&tV*2ZQ`;7F@&a#VM)Kt2)3GfM>e;kF(i19vAm#~bkIE|b} z&GaTzjk7SLA5?L7*in*GABKyN0541uMiFc49^aHKYH|%*d9X=GMz!a`fcF$fCN^e{ zXxj(C)P9V=$`kT%A||Y*ArTjWtkF*tas6&yeQyql`!;i5T#8{X-!oqba+a-L#FNc1 zXqmgUnI5Q2orsCV4Kgz@O!WwyJ_M|DiaibTwC9LBc{r!O_`bj4zV-ReYvwLJWC@=J zv`w8l!M3i?g;VC{lKKV~d^~+$?)`ew)$GRc`==Wi>%SwGSy=vSF7RV&;rRbeE$+l! zq(E%r+S_FoBr?a_h?>zh!8HP?U5FP5%8PFPj=BQIp-==iT#+u~ay~_oLu{d;?)r58 z;GZDqU*dV>ABTGNus&(vwL9~EdPxUKAP>s?34ZiR_rz&*wSwb`XC_~Y{1_sV3~rlM zIlfulu?9c5@~_{|cZZ|8+k+zQ+bO~BC;OpYJ+76u6XYclZEM!fi1NQ!RW2%BhsX!> zHp^nTXc%PW1>2TI*bBl$>f@NTl0;zdlOSqM;GGLwZzhLHD=)FA5CakX*Q+VN5IX-v*Pto;>>e4CETtRn;>8ZP-1VmC9`x;_BnbuG7VZ#T`k^-yJpWpf>W31>N# z0&bhvE}T@C7?VpG#Bn`+e~2K2GGpk5Oj}hQ)dtdp&KSFQ8K`NkZ@l88d9<2lr`^7s z`(WTc@tEFj*0;G%`i-2hV2S%>;WCXI5w>49{>47raap%LDB2fDE{v=%1@}iGra)%e z5aAh1l~;d+rXJ1Zn9CASRRk8Kd6m+p&(Lk5`MnNu&r#9g=IDU6jUR5GQM3K5BW z-;;!m*ETxAKL$&8E35T0hpUzmtGPSxax8OMSRh(lDU;`$-F>E#OLJNpXxaNKjHvi; zIylK*K?R)K*S#R}u(p7uF{e@m4K>Gj_VkyOIN(c1hPgmV)z&FUK_f_*M5y`W;L}P< zV|48fqhC>vlP{mQ4Urc}p37URNAfjm^r3tUsti`LWaf`0YHQk6Lw4RM@*2=t1g@T{qKCPJ}>IWZmq2czC2{rNf@;cw!QW9w8$M z)Nm;zps3pkIl>F-!zeaWcg6Tx7B&DxB5*L_&{!8zVH_cfD^^P1s)Cvh#T zv168J5;+l(ewNuA1agZxdE^t$>kRV7FbJ6ye=H5K)xFo@%^B`o#XUTfUoEQr!%o zWSU#yTbI$-LW2tW0L>Uem^f)J=II5%>sl8%{EX?;0kyuf|>8u{#Omu5oEV9H{fR z(mm`Ctzyk95R9FYUKHa?1`EEgwXvYM9>`wX6q^#6Z%ED66N!H!jRrxwuTBJ&pOGC<3ykjt6ICW zu#IBeS>>QVG)mx5xr|Hcm#-AYD;+daB_4rGPnTo)yQh>1ln^>M$|W~Kre z(<4U&^4eN>Koh4=EP8YlI?yK=cJ9ms>h`>2;XvI5{$pkNmoP5Nf35$Q)ue3?SrNLQ zRnJf%)$Cs>63!{sw*fR!psiNVNM;1;lhvw;%xN&rQ9u9SL?lsjBxSqt%?$`7%^gi0 z+P$1a2h9Em(Y(a*DL(e}{vc@01gxqu>MOEsxbiwUbEmVxN%1@y~ zL-NHM%(%alP+wHV*qHQ!WI-g=flOtbL#|$*T~ZlT>CszQjciw?Sr$Rqp7u;%43pMo zbWzXDZdV{8VGjupFq*_$H8cU1(j+WRqYb`l5fE?@yJm{V(O0VapvI=j<%3{*Y}bcGN@^P)%Vdy}C`yAfm_T4Lq<`4fJr`=8 zx!~1a8zToVTsV%Bu6J*vH^qgX5Hi3eEP5EDkqL=Jz5{9nk|({I7&{G6$Q>~u#LnjQ7@~60O#)~-;UpPWx#{r;0{9OioH^j%ziyo8s>Ff4g$nl}3R8>Sth*a|nXuzp7bnhFv3J*b;W@++x=-J+ z99Q0?M3@?IeRf3LGsN|wb+6Y{8nFbzuPKHSn%&$67;(+}I|J=h9&6GbN=ppKV;ZI~ zhl@22P3lGt(yp--UQ2EP_VYBJXAEGC)D7u2ol|GS$SLlw2o&H4Xd;M{`Dm&kWslrf z!weW0Z{IZ`!`iMtrE=WTkk~3!@WxE!s!p6Yx3^v*$p}G^-X`*(4EX66PkKQ}r9Sz> z3#bCxl%SLM4rx~v66IwRQJc=ej$jVZRd~e4-LomZ}3fs-{mzD84_PxN`b7F3Mu=r2}r1E4TPpFF}ycwJ!Dpe zn3Q4rUOdFw?I0M%W*|enSqF1xnu_b@@HVR|S|A&;Ig&F(P^}ofC4+r#9)$%_5^q~B z8RfkA?GJ$zI?NZ`wHFcX@E&}9V5{D^jk2=|i53dI55SyheZm72B0P)Vo}2xr5w5Wt z(rRo{ZbhmPu8IZBc(=ZosMX zcER}?9vOppW=P)x2z;hTgiQ5udO#S>6n&el=|~`-WosKkyb5*{Di*~_JjBC!Rj)@5 z6c>ywInVBaphk@gs?Lio)6H4{u~b{f7+(2dcxSDA0wN_}b^Z5xffZbrm%hjM^q7B@ z(P1i$^EoUpAS!-9EV~Vg_bP^)CuSUb5m7ov$qHgUK<%&MsTML*ePgMafB23E1B^L8l>G+kZn_-#$Akahp|(sM z^#6CLJN>^cg$bo0pj;n+FBgn#^*TD34GF^dh?=TFiPv9x#|b@@b- zVJzf8rCk&z+!XO{tiVdTUZ zl^n--zQ4r+f)-WU3fZC&RVw7~ZiyfM6#j6xm>H&P6hR!;;_Y2s{z-gwoMe3%gJ;x?|OrsEfy>`N*r=)T2MDn;lX(hM15K$K&+$W$i9 z<#2P7jX5w_z>UB2e*Dil{iYC}lztauPob;{UN{+bqubdDX8;rf;KLx+2OA>EIMU-( ziHKhX%82?HfdpETY(r;U2wY|mHpwlA>Da|ipP=H~x;||%gLWV}& zi^N+2>iZxB^jYV_xk$kWVcmcTA&d+`K3{fma&RB~z$>jxSE{}Gp0H6u+! z!ownryQ1tHS}Jrp78+(S`=&0-sGxZ_6&2!RESnJwAIvj$UzU}ilPrUcs1UL~9fc@X zB$Nq9w&={8kS;Sw6?hK1&{!hp4N9dNqUR~@9QQfXu;b}wv+Eci%#)&QYkV6A?gkKH zz)oSNR*5vq$l3&}@iEV6e^xEY)HGFG#Phn_x8LNL9CN*{Z-LEN$&RA9D`~HH<@V_~ z+$IFtMo%pXvtv8o3ITM;-jp2CM%nw9TN()UDEttxEJ$78HevYq5PiGrs}M%l3TAyyN@W{|#2n7JzVjCeh?Ho*Xq6&F%a&*3>Mv;WdvqArtKQOf?bkf24OQYUE6>ok(VNS5UjJJX z*J_e2FHc1mL)*2Rrz2{4{_o6k#1OVzn+9K^)fQPOJky^GR5i3d(DpELiOPm_HPRVUOWK2tsCLcwJRR2VH+&<6*dcrokR}qit;FA*gT4K&p&YRM_RDPy$ zz~?5Ucgjv}0-<_|vc{Urhe$fzq8S5SC7Si(rYFZ_W0Sgatou(i^McDWuP&Mp4b2Z} zFL%?XP8_8F?h5g;dsZ8dd8^ibC}V>q@obsD!JwlcGGGbI0=pfGzr6Y1!AX`OQt zTvV)vKr#lv+tu3XQnA$G4hlB&5f0fh_AA+#3T5q; z^YtqnBqf94Wa-U;Wz6 zq5#GUYxdg#lhk5h3A`b6RH-&r)bgV6Ylf6)38`O>ea73!9pwvA=^!aB$nropKuj}r zNK-1U(@d*>jUSIO-|{?O?Ul8jPlqe`QZl8N%SjS02v^9AQK*WwKTk$Gtey3U14KDc zli>T3&W8e+Jjok-B!jYy*x4NL(QN&=Rf?3C*&FJ+xJLyiv>lK=X>j1gwgS&$J%h07QJ4K`ZhyVql3E|lpMEEF>1G(qtC)GP#gmeoL)<=E}*;li; zIcdu+T4bvhL*0yRsHvPzk38{l8cD7PP6H1#<3Z2{9=bt0+|nYrLDpFAnROLj*x9D-pb#4|YtlnN+-+O%X}lG=_+ z*=@MkiV2shxf0z@fCeqjGMtEF3F+5xG>z&-Rk|WAbF&cG4+eGSoa*(dNWJ8Z)?%yA zDO#7<&K^>pCA^ub`kR}S6049A|AAJ#>5SKXQ1P%8Ne%pm-hJ8ygWGQ+hq!p)p6Mf| zh#p5mA3I^dNeha|ow?m=Cy{zwbOF^`=RDnF5!D?qWM$pc8kwoFyDMEZ8`n^ zTTK}~fxJF(!9Y+Jl%YMP)L1z^Qt3dD3uV`f3{DQrm44~X`+DD@2u`HpbDg3X(FN1h z(jkV&_XXMAz;Vkzy)$h8inU^8|8LYPUE6kp9wp@VnaYbzOhe`qV|44fah*Kr7}2?*~y)NVrrQUE1VV3aB(q1^btpA zlRb}U<2a%qPBY&|yM7zN=dz3t2cT+T$$D8~p>xD{cuyKpJml)$QZ~&>p_mS^KXI^v zpTxwC`Pt^1_7X{A8p&$DkWqJz4{lbNae%uvp4+bjUQ1-&jq6iYiMnwFu@GgJM{ON9 zGxD_TbN)@$;^{>`r-4UE8A~XM3@X?tCM=CFEUg=s!Ov*nktpw|AS%LEaDa#4eGx^f z6Ao#F^OH$Kx1GH4U=E}%#P!ZjH_g8?JHtC8#S~|iforsw)%JZgnO)Wy+c+m>@k_v{ zu`~9;gel7T=aXp>hB&iZjSYC+Hbdu%O&b4QdNJ~|gu}jfJ=61T@rEr?Lj-@F`@KU# z6&^aQ+KE{aEI`v$3lKTx%k=l4dpjAH+#k---}sQG8`f z-#~Iy!M${Axs7$lZ{mYjZ(>l~S|9q4fuozNu4;2?fz3%hMS!g3Y}Y0k{z#eZXv=FX zPtXC%GN071PIc-EgZB9Dt)ym1SBtE>N6b0OOvyObRd6Rd?ONcb4=q@&PBVE=n&tkM z9Z%$6u4O}TO214?SVbmFE?R~Dp0C@!FPqQ(<3IjiAsq}1%>O0WX#U@!j>>b(nVLjI-o znPpEHXN07e-HtLf>*IwF2MSy^NG(>Gpel}hW6ifdy13&6O7v>)2a7U$X>$!m_+4G5 zrgJM}($*R2XCQ-QN+Rz!#=XEde>4Rj4#2SRRx9H#hpl_Nv7Z)zk1Y=&MlVPamJpze zP>~>xvVGC}VGJd3PYNl)G9W44)Im%aUPnBC0+l70wipS+B0!8}l-znbrRa{KqBr!n zmBhUUUXb}fNq}3xBgk!X*2K)plfA{8E!?j}7~$Y+kyL~UhAD_aJp~Ge!Ae6$-)XO!O-?t?(%k7KbU2Y8ir09 zo@$sQ%it{=k(0NSKGW+Ld)}NFszXWq!UYb;@1Ye~Q#tL<-vRQ%XVUHpt;gYH_euOl z_`A<@&>|q~1Yv^mvytxx7<-j}hFUN1c2oYExf0|cnspOPN{+1j0qdV#tEMZ**{yN9 z7fr4Gt))9X`kNEAINBCrhHb3BA*~jZCNAf9t^s0y@_F z#d9&&iV{VM99`C4+YDu|6n*)?hL-|A>P0E}_p5&h6V6cK?`BiJCrIVj3iACi62hjq z<&`E@^_^b^PLhV*Y~y}RZJ5%XtaZtqg2_z@1S-iH9^jtJIYpS>J+dZ9<>t@uaw%y- zNv>RDMH9JDV^OmtR}aI}+@1AfKb7Rm`gXNVp=D&~u^TqZs|83b_ppRR-Lhi@X5YJ4 zLcS!4kd>uNmSP4|S#kXb@dE0oJ#xeP^eWu_V!b;1@`t>=*uHU>D)l=lo?YP3UYKbO z-YmzRyk5236dXnRN-91TK@@%<1IWN9>2IpH3SR>4+lhMMCggaL zl@NPbLwj{$erNDdu??V1Fh~JKgyNJXRyKGwpk#JD(R`0cSWXe#lwzwuZq<-CmtZ(Y z?sfVz(qt`0%3cjc58Y@NtU$nZ1AE>MQXNp;J-*T#VD#lk*NpCmfbN>U(lQk8PGjX^ zZX?Js+wQo=B^pYLr?90zpOp@E$*FM*0f{|{;cJQ|>mB+w-P6SowLI)hUZufOgnn4L z8Zg;>La4O^x6E*%pIhPI)6c|HU8mdqgkNd~j`_#a>tA6^49rabb$ShJ?Ecs@Blzs< z=C_XXPe=5YcR5=#IgvwEjpwBBl<|@vn*1&|rlWb9y%m>)x*ls;SZ6fAXZGgYaoxpn zU!ZuyoG0(+!!!@cCC;EJ(5)$4O{Fe?lt@exU2R2VK|Ch@McNUs zak%XAG+kN=pGa}aJtKJ+sLS`c4{lpITtIoPHiQ@X)<4@*NvddauMq)=JC;6zH?VccVg}*2cS;tk||~+jesDm0Rw^K4(AdKQJHX7`=~HYvcWw z2njI9BJ+aB4W5p4DT22NkXGV8-iT+K!bB+is%N(4@8Z&W4S==xDu$Q+F$xWR zV2xsbBF@k8odJHr`w*z*kBkISaqYcX=$3(U`C%WHhP z-$&=MP0+NVEzgV(UI5geil`E!yW>W`=N(q&?e33D@NT6#8m1j8b8cWmE6M`ckreys zS31$0T3atIU`T}uP>u=hEa8#0PS-7PWIqR;#7(){3!KkKqx$xj!bumoZm)pzWx1N` zhxWE(SDk595tZdB`k3vEu5(`M8!W~irkcmuctg!6pR~q#^T`$e$>Y5QbLOM0Fq)jyd!e6SAz4^ogj$Lziho z`lf>lEFqWivSIG~LVfz~Ky2DdqtlzWIrIep*H7F5)iMrj(yiJt+dOt->KA79IrWk`xv@kT;u942bvT5PEMuY#77`jiLoPH4F6 z*0Dr$e>O8;BZX4t;Kg#6pXIk6=wxx5YujDqM}u+3q`qYj3uF|=yfw(R?F+kRtzTO& zN?_BOG+Fn@R1j=_UN2v~v$zL)k3Lv3vuNAwp38GncuoL`)Gs21A&yQ}V?Tk40KiKO z*?ow!3W=*+5|jtR5~a9wMEE5E%kdK?SBAozOm*PUh97MmN8xXLK*K)AY)b-#K^7Z` z=4<+eo=k|;Yc}ECqs}xVd%dv_o-Uin=R;wGsKzYb;an7KM}pCsT!}0>#(9Q*$LEko z6|3-S&FIWtY7ty6wA9ARe@Mz2?)cR|k&VDEz2p1HD(^#2zjRBM)6>0In9^ypY1pEm zZxzz1#X@6e>mXLMSa0@o}YIqWO4`k^cGu zxcgC;pR`*wNM3kQ4J=W} zUj)p{;UiDMX>&cLxVdP0u=o3wmiH0IvfV6@Bf_S2&9XuLvqJspH>8iVM-kHV+lBmH ztZ+x^>4oj{6D!OiqLI0G`pnx;)sJE#Ez%P9ayP}u_td`i+kcGF_)FI@qV2G_ly+=| zZTuw)A~s#9U)Ojkwnalp*Qr9BAxgv`+7CIGH9WW znlDo*bkRs0;W+J)o9KX^T%Fi3=d{@-aKj!*3~Q10W()00!7o4|b-0?&`K=Q1=x)sF zMQGcX$8Wyrt=O%H2WO(+`%h*q6&*Kwy{+eo3P@Ed)lnA|w|A$cca36b85V!dcny5P z073xuDH-7j-EydMkpu91i!DdSg74M{;U>edI3v?KtF<}<7TK!YI~|EwL9(nOoR;F^ zDc%ldwQw{7lxM`8HBtu`5&!id>IlF2V4Ep$@i3qXz(sM#>%HY zpRPu_^WnF%MYhuBNv|tB6b}^_+f{Z0caVK#-nV61!)(3Q7!2C+sGletsY8@6&C6_6Tut8TGu242`J^Zc*Z8-w4BE|qkMh**1B(OaRn3fA4uZnx3 zAN|kxxz}XBMZ$bRqEuL`Z+F-j2Cfdm=;#$2Ldf2eXdl)lv|daJn-#y?cN@YHQlihq z&__(HZ&(K@j085psnfv^Rj=FA<_!n9JNl0bTQSu=pCN92wyD(4gOidKHRkAFj{aHb zP(Rvm#Gw;$lu5WD0B$uey3zjq-<~z0gCX;T@}L6O(4VB$YUyxg1|p+vd%b(8*J{|! zXLS75`pB6a$d~*oNzU=xyoM+i0oDeMS5`WK@R&u_EZ%4=^(5*1o$R~YlLA+>#u7XN zXZ1B}30UfhS0XLhh&by5aAyf)=vO%G+n7fAx(a<5N`qCNSqDKgk&rAJ^!ddq={H)E zSYnC8K{g<@nCXalUQ!N{;YFds?T^=PYq5eB`S4=%qSBS~Bz*?O)N&O-X2ymgxMV^u zuxE6<3mh|;_e0*AS5SC*I_5+815 z;+vf-CajP7S0VEcQa3Egi^E}c3uFJPktgr1foEjj^PJ{xbhpWi zyz9E`NjEX*!>=-5txJp9Jj2W6NvO3TaFu;I2EB}@(EA#Rz@@2iXI=|!7>JSdcygYl zf{lVFL^3NbHH^dB{D&u=j-EWevcBI=`Y$TgYYb4h;P~-okLH%UuxR(UGNXxc zM5zw$hW29tKqABBKK@s|4|Ey>79Yl9=JRZT6@qO=CDke`m{Bb59&`%~Rpp$(cxgcB zeWacb(ZLIFd^K+X_#51tI*cUpx^Wo>Og>~rN>Um~K__l|*;F~sdUZA3w9QG!+frIi z!Ly?v?E2Hx*SAx~nH&_O$9H}Mrvjs-6!ank@c9JIz7+6k52L^lqy+!dj7AK5)LayLFr|rvei)pL&ubAu8FNYUI1|AZKdJ&v_2sdZC*J zGriR3#9(;U$9rS(T}!SdmHt(9_$I9`ohS8myywB|NbkLiO0~*a-~nmCUZzGIrh0hB z`>O@tSyXDNOHsFj{raH#qc!6k6IpGseOcQm^-<6YZ7Y7H;9jiZKB~VN)oEy0di8NPkOuemYRnYdmFbOP z0?0K{ZXMFL67G4DAxvN74T-tSV>sRI-hE~!>Gpg@R?d)rQJ{B?=KLE%AIe9(vhJ<#@_G7*( zo;lRIiA(~NgollspZ82(h}3wVs_RJ3w5N0=$n@K74t4L+4RyQZZd?r$*iWKLo1Twf zm*;(UwYlIuNonQ9R%8XLjKuWPx#tI0qF{|*$M-~JakQ}pRO8**0(x!DvO{Kx!kqQh zlpMWp6Fc9(51)dxt>{h8FK?(1N9$YH83)+aoM^wk03dz_y zS>ivwH0Lff7;)pzw}f=>?x+8T$%!m?KBdwIOs@{d))b8ejj2?F`}{;x@l$2O7{Lnp z&p514W4WT`ii1s1Y!wA_M$1+PrVBQNJ1Q=~p{` zluKl}T=pjl9_9xWv!nNFniLaB0f|*i``NR~Y;Yn5b;}UZi4seLqgeQjJySQ!D#h!eeLM^qNN8D6L@CKvNiMWW}6A? zkbHu_*!ABy>-KTfN%;dZ1D*(#)O_MMqLZS>=mVw9CV7F}JRjTqA7E&>AAsUo)PbsI z9bVIbkD>k7g7hsC6G`A3tdQn^;&s5E&wv)mXDChYKu}f(QxpqO_|39O=F8keFj=PD zAOBr%+;l?+j7TQ}GG&F^ZN+Oe?Z($;R6>oIR{fZshS$cFrZYlPK}c?q>i$VxydL5yTep*fGU>+NvR$Oy;! znD}=8^3Eysug9rqexp64b}DRbbIneVl}Z^f2d0z-Ro=3tO%$&Mjd8ZO*sa!X_3-nK z3eog~fHaG=zeep0VN~sGj!bTg%5tUj6%hm`Bs?Y!gW!dY5ZxIH|2uv6mklAg4yQyx zBE4afeF8^7V?zD8$z!~SOK#sF_ZV+HorJS^!Ta`K2ji56WMO_wMjxBoZpsgTDb0D| z^@uQGs*hu4o7unm;NQvV)ol(0bKvy>?d$_>MP3y&G>Ftr!aWrM%%pFcgm5mthY&=D zw&x`lK;^*|Lr^0U(FwtEUssPHD%KV`l!72_j*}l(mmXq*qyuJE^<_y$3C0FJk%Rzh z*t$N5vAGdm5`{$RKt8P`5HT_E;r&Xmqmc+4Cb@(45_nyI7zq4H2}-E=ZZuyHK;}>U zUNc5js4V zc7vQWSHye9C<+j>n%R^jDhy&;2AZo4WmaaYL%Y7_ZJ@NSp{D3-ID$+R5k3|}jzW~jU^IF#5@^mkzFT!k zW@r!`5CONh3BohWSh_j;?q4tqKIajne)WyNyO#MlIY=U1*ePW4S-N2g zLWUBev{pz&xca4SZr8^!zr`0^1vVl&c1aI$ET8LART)} zo@S4WtHdQV>l?t0HX&Z9S5)ivl~;Y5rB+|Iv>+wFB-1ObB719s(OB0~AA`Tmv`>+* z0?n<*sH2E-g=xku%))Fj^j}RYZ40y}J3y{diQuzs?F%g1M4Y2t)7hTk5)}NEc6DaV zE+L@F31Qk-+RWV8hhAYilb*d-~C(QPV-!Ti729 zHyD$R_EkeL>-pZE3=NyAPKj|gPs46Pv&|c{CF9vU#`n66-L6+%kF`Tz?YHISH1@0) zQ1zKoM2f}FYz!vKu&RYIe;{>z%c2yylkE^Xg1UE? zQ6i(1*T^C52&n?t8Tn{BDnqrhOm1u|kx<+J<|?xl$8!}eUMo)mvRkV>qRm(f)oqmdf<-WDaYz&f1^iK6yUPAEHio0;~z>yJxX3f>({%V(B4|Up8!8;Ywg&9cq z^!F9q`+?&VTCgkbd4kP})-wSt2?N{IzNl6PKP7SUX-(V0PbGb5w#0q!edOaUfel3CgnD`Sx( zN+a5v4rb_l2?hR2bPV@;@y$lR6i&eLZ0lj5D(#Bshib*HA~L@kVYQu$NLqBk2w$Nu zT=+A%d`9#f(p2;WmpZU*l?(r_HGtlXTwG(dV$iCbQJ~OogI=UIJ%cmkGw(~qs6)WU zLT7bdX)t>&bTGSqu}W~o8!QD#>c}JE8Lx|TIpAPDrKw-jQR#`xp^c$c-@V%LG8^yU zC26YFS^z&ExWh3*Up^7cz`ZFZ&gFzhvdJxEd*bO^!>=3 zxsrH=lg5jso$p)x5wiQ}|9WZqpBQaM7WV&Fj(h9>mgastdW5a;2_2D$l;_l|Qi?_J zz|Bor;MQdy{2S4<(y7`JwwXV^Vz^HNVzCJ{0t`hIl=tqRTQ{*Ig*mlwF5a(&vXi@i zZ)jSkmnJ!XdU4K^7UjyBI~>gSXZ?$K984=`u0LW{DK%ue2q3h_>FXZ4X)HD5dM15c zIbbDFg!5FR#0)m0bNwJfxeOG<)yHw-N=foN6T0LZRF&wB^FNNIeYc{#d0C@~tsKN5 zfd}zSNQw;_o0I-E8&n1CBcfq2zR=n-xXo zs(Zw_1h=NPd=br9qVO$5{zgx-BGv(Nl6+f2x71j_@QU6X@)uZUjd&=s!ZcMh>T{hn zcfEsoc=|}2T%1In%k2Qiv5h zxy8u~k>&2g0|4#vUPkdzO+QH+0M`+Q$*l0?WU8cOk{aUwEPag#Z>1tfUG#0j9AD=I zrHPBqL|h}Dl`7cb!kPYseePjSaqXMTWliU1`E1kI+WT;ZH*k};SbHs`g z-)#wN;c#Hgrfl1KYU%%a*deb!So6Lf6!sy2L^|o<|)sms}b6-E=V!Z#&a4qceb}^u8bA|aKaS)zNtmS7+ z4QXOOxpmPd2i&IoG!&vS8OHE69H-!aWP9-k<)7p=0TB`@}IJ8qeUYNGpFZE+{bx$>nn2o}fh8@ZBq;1Vs5cFrHI zmoyvNFDb3D@0->CmZC!IC`0Vzw{v12i!CZrKaaajhKO;VI4ZHMBpMjrqsS3=6yyIk zxZ=Pgj?@ZWC}Wt3UO(53$`FKP;w@03k!E&bO+msZU4Bz0;8i~QZO5<%1W2nVWg2M ziU@hI3Xp6pBf8+UsO`x%wakhX$e(qI-!6DC74!eh8?Mnz z_F{xlCc|+8n-Qo6suYB1M=YwCnVh6HOPAdksU|J+l0+ac)y;jDAnXqj1Aj^;9~7;+ zY+M)0NBjLV%;%D^9f3;(yvLFa);glDL}RHJ6lU`camnYWR=hx911+%v1#d1tDuIB)%VKtmIv<6|st$q6~8phoN1X9BE3#9So!XZrD#z zDnm#Wb&^*b0l=a$VJIV?o{zlb8sA++R58BeQwna;Yn#KC^sZI)x{9d-6Z%4{uJKfb zYaxU}FP65hO9i32zTd8IsK+T3Bl|2~9<%VjpT0Z?FsR2p(QUt<2YLpk^s)x>%eVf} ze=E3*+&*rYcICIP=E61WDycl?o~zkK7=;G371;yp5q=Ap5;2>6SYR2bh$&WO>iKcR%Yq1J|?mz?ih8!X9P6Q!2 zynFrY=MdU7!^x{m42K6x{|$8G&f5iA4n*9Fy(SPlV;K!XMlD>(bhFF}w@cP{WSOK3 zY{Mq&%ar10Nh3+}tK?!qdnFwK-4BHJwWvKV34t^eHl<}n?~5cNTf5oO+)r%^Zb@|yX`)bu9VcI|IBAsk(*&by4u4yO`9w-B z5Vy>!UzCP|3J52|M^-*`0!h(8Q1(tJKdh7qLG8~zl3~pX!dlWdk68Cg1S+a*>6?!FH&~;Jok`6omcS^E1g|jTTmi z1KiyF8M&yta{84yzRu<<#IA}`6s@w5Y2S^Gk@?qZ5^S6x$yf>(WrVx(c-f%1W8P;I z**YV!QB#Ws!vHS-!N10BGyPjQOk(IcTlrhbGj-5eHW75yZ<89799}699v0r-@Y`}G zB+KDGVlwydn(987G8j@S9afy7C7sEdgsQr#u}_pCS2RCFKzHljdz)O zNOWd@ophkw0A{SX1F;}j+D?f`Yiq9AtScSJKOH_HX^D2}x}2+uk@ibMO{Qd!piNnW zed6&L9*syK$}WZi;YbyH1^xy%!bbyGV8x^%@=KiUV)o*=j_xeP%u|aBz%W9b6IOW) z2P$5rON*d%0yW%m#z)X%-B#yCaeAxpHiZNnQsUG$G%y*_k(%P{$yT%i{xQ-T+!g5) zO|kn_E6D!x@a<<>=^{z#>|d?c*k8)9OROmHJ5T808e zzdp@BA-=O$d8*R!J1xx{%}a9`oPFH6L2j2r{l-wgKRC@I)xU%weHpV`LpaRU<`fJ zkU-rMCg7ix$C#G9)@-($`#5U9vfSr)3xPMw{EDyvA7g3H z^2HV8EE$R)i3Df_)a={U+GfS$r46_n#w-bSy;<4WQufy21rGW8$@ySA>Cem$XMGBP zrj9Z8-+u4tf2j|ZaGq;+t(~cS{%s=bVcJpz*Wxiq;fTCx{0vq0juK9E0VLd3+Rf8E zt0*5-(d}!G!R-cQls^tBMpbWCR3orMX=-o)H9~Rz2vJSINRM4=K0lqyG?Le%X1&2A zU}=1YejDpX!Cq#&=s?kZi}R{+DmvGVkRURvTeb+p#u`+}B#b)6FO?9q@CGwImEQ3; z_lQz?2o${1CHtW}+7sN&T*-t8p-%$pc-HyhiW)p&VKS}`#gIty0I3%k7iOM2ZJKe^ z?qBIcnt*sYZ&G>kfkqn8=%3WUmMisy@l6?=eYdh1@H5cZFu|3nYS=KlmO^Ok7?1}i{4*W8Z5e}l0NpQFl&CB( z2&dY~0)gVwJFa(#Htp(=8iOHvNI? zT9v(bHkPmZ!@NqLoa7zN*nv;`^R=UKIhyCUIp^h1Ax3=KTv)+*8}@~k_)J1VQ-#i6 z!DBkBxV{*Skx87b4GjR{WIEd+#_5|)GAYrN(W%rOx6}8usqW+*Y>Sbk_`pMD8Zb5S zHYZJDoac*bc#NURSB zuBb2%$b9#RKlk_S@OsRPg0&;{^6oPk>3|-!-{?XL<%%ST#n5>LX{@Wax;P7c+%bH~ z1F(0NeWn>O^SO9r{uycocTmx3M!5FK-bt{9T!qUCN=J^XU`pqAsg&mp82trd^6nS; zoPipUMv{Fc3pi^<*6$&@lOuNuGFuFx7u*JWe$)oujma1ctbko;Z_Vf<3s^$$%vx-Q zL;+@_rK3N_ph(J&*!MEiMX0ykOhN4|cL4A>n(l^d<#`2ath`NhG>7s& zTZNisDqhIP`Mj}dfwUR8!|uci>4A2fy+MxT>kAQWrih+DE8>1mWZZ6p13JuN>rQ7&S1_bOkqtRfSmnSdlw8F2W7X{8 zFsMX-n)OK$z+V!#1Ly13@_zF78-C>5?dQK2oT1# zu;F3XdtbgP(Na$ZhyX#_>l;Ki+*>Wbntk56sXsB~&LBZaF;Nj7K43n%&tX0>yciZt z1@{|;V)%Th8d`rhGX2xjk9NN~8Wqo~rAhG*!GRb{v+=Odr!A75m0k>va8UHo`%qr; zYJ#ZNo%Nl?%R*sL`|oRSGvSNI;x%uNAS^n3IvWqJ$kFU5ETWCYh})fK(%t!|HXfl5 zD})Os91S?Aef&T0W7naJtb_rEri(7DFOV<)E*5g@K(&K9Wlu(*_TTV54E4VfV?e@?q8e{DT^Pn0UUCR z4d{%20zFewBeuUdEpGMg-uL|Rz4o5*-yOuVw!nA=Z2@TGf(%$7KpQPG`DF+Jn?{`A z5xdJeRCAw~ZjI6DEAk)f^01}xW>r1nn+8elIwFvr%Y6wT9doc@s>}z*SE|;}iX*^) z<#1XJ5U!bQYFh&8W@#szC?{JLRUgD(pOYo48pTE^{y@g5YbBmpnBe|1G*KG9Bgs2S*SDXI#rP+8+zYeoW77KsU{m+CT&(V|kR)cGRe1wFP)jzXgg#MB0Y;T=Y;%{i2A?1YuE5 zg(MA#Hpx{!Qy4$sXC6~&=TdBf=!JhFcJN+rrvzPj{#M{FO$F6gwgs3?a8b;Xp%{9- z!S{guUQqWP87VfAj!XyFL1-aB5suLj(L4N=B+9a<7 z!_ukSa;to9+C6&!&qP4>G$vU4TTzRtsjD)&n2Q#UK)CGUxb3h(@I2t^JLJC>fuOlFL>(qu2A{ zksvR5;N9Yi&e!F8L#La%VbjLELi62J_G0@q;+POmql??@*+Rf%OS4p3YyNWzQVIka zT^LN6Y+yQLNmYGyjB>3M+@{kNsdiMOOOk!d;l_7SIW#bmG$NXca>{)#Oh6-^j1a15 zd8Qu<(T_p_VHhX*SSr*FSV9`d*QrT?h3{HfLg9ulgoB++g7g@m^3%C7@!=KH^@wF% z0XkCOtOpr-(E88HqC=D?BESYjl+rAB@Wl^H;aQ!p+*~%#GUS}2$+Lx2!fZycGbV;{)}B8rk0iU9?n@4D(Fm(fEgTIeT7ce`87e{2 zJ<@#KUko9$a)c+*&R?t#5wHjI*1VHkT1Jp&YTvs0V&655-2}B@kTUU~%QE)rK|HB= z0&&KeYh~Odf{ZAl+=e)%9nRP=$YdJmt~@4@Eaka!j+Tz59ta-{b4&+7#{{;UU~!g^ ziM@p)PzI5xCNW6h25=0H6p}yyBWd+-g+Mop!jy=JZ$z*UqN zFN;&9Dvj8t8}TlUdu!7oNKg?DXJVU`w0NtM35(Nq4DUM~PEDUk|7Fa@UFJ*)897{P=fxMdPKU+Mg zLYU~~09_XdQ_MOv^=UgQ+dzm!B0~FCBq#$UVQ=h?yzY1{!(<6GB5_&7e{8|+`|FzJ z*4KiMm_;H>`xyRPY~k4Pd|WKK1LisGB0f$%{v0LK?+CL=Z)iwj>wt$t{j2QFZHkPA zrqmz^ZEn<}bQfSKHi*z%brBUQ3DBL-?Z_4p{+6Y9{z2=|#P@E)(OFo;>+i=BRnWeH`fx%7X z(Hd0?kDl*>CKcR!UmIF#8*~ci6sMks{EZ*mg~bTI9K>BaHR=6 zW(DQo1Qwgm6>lCxP?8aiY>1u#IE3L3iyk_O8=NuaAMsbl;3Cj2&!oN9C%Fxxf7VwR z^Q}Iqknr!;tQ~h1XLm+#L}CK~<6@ea9%FAv+I0tpXBc~{N*+z;u?3`P0m*^fzNZd! ztMk~C_Xz^?nwmJ$dvonMgRMPnO(k-i?bZ&s%9Jy09iz!KWIyqCME$6|4s<4#BQQ#4 zl1&>_$ngA^^%Oxk&IQYd2RWZ00gBp{kXJe-_z74fP{F{w`c2cq=Z-63)%JHcPQjjR z0w4RHocz`3VA_Pm7Y(R*txmN&u;z@XrfON7-zu&x@lW;B!%a9X#aIefBkK{i-2HOD zT+P=$)g>O_O}eMMpmML$w0bYVV;P_<11A@0A7;G}r96nDdiF`A+TF&BU258O{K;)P zpIhDczCl;Zdjok}gjDuk0<7#?b%(RYvP3ywNC=6%fJDEUhm2ltE`1!JxL^%7;H>1v zT7*|m-@coO)96$`Fj>Nx#dyOM#qkt0M710BmMj;w-$k94l~Ug2<9Zh$)#vGxxmOIT z=y_H59^r;G`#MNcBhsopiT)u?#gaji8ZrcZNRFX8D6(2n*TTBR^RGILJ15d2XB(6} zTfVNj>ID@mZy2DiT|yEO2RpB-a-LUR?aO^{aO0$f>y-%NHmcdfB~ic=ENJBQV&Oho zCs=`>A3yLYkK+69Qj4}ROO2z_K!d$-$-E`T0gVav`J^cZ0y(0`pF|0m4<7lHZ@&c93j*SO7w(EXwY!HMFC&FGyZ zDQA%haFs8TB|^W3B5!;>9HQz-(sl;)YvoEzq*+U*wQC57VO7I}?|C!jfEUFlMlx_u z5La+Npy-M6?TpOrDnaa{7@~}*u_Y=X?w22Tac=U(?)i+j(Nd~K8djHneNgG=jMGy! zG0I%(sMI5p1xb_+)TE{(b&&hpMWzZ3R;+3^FGb2Dl4(!=QP91$mEkxfzR6Y>unpfB>3DnSkMx=AF?&PPmuWNPm0&) z3t>z$LG>#Wk?GiBxS+MPf=pKxME~;GBG&GqFO!U}UGr556}Z@ZJh6}Xr@^|84jVZH zDhA}X*oH(BC{mHzoQyas;Eud+#uDATA6#W)?(E5;MbUz+snfV@Bw{LjL>6A3Qf=p# z{$~N(RE;_Nk&QWf2%^**&?WGzTvoy9F1pN-+Kn3IQaz_ZN;2^{zHusiC&(<3=pe_p zA9a*h7SC@Mq>l46p&SPr(o%Wz-xFO}ofafc*6cSDkp%}&V}6m6YitineIMM3cW@Hf0{fay zd`Ym;?_AAm5Z=4i*stM)5bB`<99tcgT%kQPNZg0QIGLJ31A(8#vwh|IFcVpU5h+cP zQiK41{?LdQa#?|aTiT`eW9qhHsNA`#PCiRnmPyim(aLx=qC!Lw2YrDq0Lt^o+hFDR z8U7CM+SO2NOUwyai=wQBNjT0^BM^;?LOBL7qdRFgV!*gPi2o;&agk-Y?G3_*xi?G% zLlvqCx*xLn;6#4RNSP=+(!UVo#Hs8avE2UfI_Xag+%b$F5-?bOIA2>bUjb%8q;%|< zi*@QkDeVsrfMgB`sKs>fEIG)Aer{h9A670l1r9U-th=j5J%(b1>F2Y2WF8LwN7Xi( zMlLSSI=PBP?qo2sY_(3BSki(AQ2_=C0TubFHV!C*yiJ-OUJ!x(=isW@Tbd|8+O_O+ z=}*azM6St&Cl1TD+EuCLv|4r>jT@zOX@e8AGq<`N{4x$XLH-!<{o^3D?~Raco}gu! zKJg5Xt#z;h2+yNCAX2csdNZrL7_RcwW~;)GDHeBZ_u9XXNnZ0*7<#o2Jn)i(IBuom z61zK{up#$O>XlNXZ9Pq@xI51WQ%a!K2Vtd#+Htgb)KJH(;afsf&*%}_I~5CGatFs|q{H*VE>$tu`_ z9E9lY=kb~_(>%;ZfiU-k9e5dggW1^y!1sA$LrwAbvl80F{+hqRm;3iGRAOZ;Iz>@lupA( z=W;5jm+uL3y7vf0Kq;v5iah1hl4h@srxo#=k(Io~jg3@Qz7Npolm;Jsbk;#iEM z*+0vV>*|Q~_&xBo(gP73gG4=H44LEz_B=#%MJlQ=c5M?B1owDFql9%Iq9p?ygSONGYUoj+NfNVIf{6!I$fB8|FHA? z?*(0?(Mvc0N*H2`J!IEct%_1U0S7p__Zk;x*0RgRP|ZJH@Bo?Wt$j`4E@@}(6ng10VEQw6 z@&klJ1Uhq=rj{KY*$k?_d0vs&CvQ}w`{wi1+`<|BGA^L+`}{iL4Z|z$X4nB+o6UXZ zIv05BVgIDa=aQYtX1dmr1Sek0PCNfhv+l)7L#CcQi-`}_%wF;AQ&*r&Fun{(f@GMD zo;ikge8Fk^G1<2)VoAYw0p2Ki_0Z~EqkiYLHa%7K*qG;MH$4ggaIbR0HA9P%yv1UU zd{}3#IdDIX-y$HX0e0s34-omlxJU=B>PnTlz<1^O!v#2&0&N&h`ROE+dY6}|p#rAW zBK5W%&te-@@lhx-D3rRpjj&-&FIHK`sEg%7FfmOwn@U(?pb^%m{{8S%uPoKHb>6sE zaCm0Vbjdj`6#mSs4g;Dr{h88ICrIK=yT0xr>9Mpf+q#9i+(+jt=2wBO?_dUV2CWnI6qa1=H#?NnVej?INEg1P*ECRSOl` z27xhFcT=tpN!nc*?PI~kZ_%+1_B^3AUmI*WUyB|c7Nb~l%?wlO;0m>q*(UN7H7KBT z2=TE`p)v62$8REaziU^q>x;*2to4Brl-=)ck&bLq0>lK78~a}GB!Yj~gW(A$w|!oh zi*{0i=JtBYEk8)1@^5z^gB$+ENvn+C?H@fVJ(Q$gNkAlL20jE|HO5HxXjt0PlQlJ< zGn8cMm4ZUv@R3dhP6{#~1<%F}-|kq8D%nwHao=!&w;s_{&unZR`9a zS;gmR!%8qq#WA?tK$$lWthQjXkaOQlpANz*$IJ)iD?8&pa#`jE?nG!=01y;k5cA3y zW`&wtHVOgT11DfCPijbLuT0{qK+dDYRpKR`y(=e5dg{&Q-Q=!bX#$}@{Cu@YRxVcA zO7giuo7b6_P*Y;A(tm=`V=gUKn@wADs&#1Wv; z<18U5p#{Lr2>bG}Rk%{${NC1mJl*Dxp`1yeX#w;$mfG)AqZbwM#^f2{Xe_lzim{w` zc`)8nUDv50r`>G>%!#`$Hv-mepP+X0*kb19&>BQyOhN$mzt_#Okh?o{Y_jo8CNe6G zs=1*pJi+s)8lY&eL^qw?bMadyhmS>l(XWhTRPs+2O7&szxV!5QXpwO!EbJu_!i2Z` ze0hh>&=JO!L8%XO5EARLY6lW(v=7lhDF*^Y4hp zQP`$`>*slP zF^s>9V|P8YVLSHYriWx5Q~NbW6aLM5Ud;wks)HCX)6l>?vQ^1O>ZNtWl9M&;Boty- z=E28bg$L$`msi?8xmoG|tIF!4Ik36<7Qw;wl{tR}@AX^PSI*v^ldg28|H?X|Yh!K8 zK47G;p;l>rm`6mx$;FkJP1JWvQEd3v=hV6Slk2m9*@ZtE94_6Jfq7$kFCd)5lYr^T zfx@|hY8s61@MHcf>^1C=4;+E)c}{}!q>G;TE>zm&Qn@!D^hIy|TW{jWL<0}U9AI*v z^9zj}>x)f)Z-HmmFYYgox2AL#muEy;~CSgR4S*UNMLV>@O2MlscI@U zx9~$_vymn^nNGuShV`xdO8b4qKfOU^-MtDB$&~2ee~AygS)~47-?uraVD~jCgW6X*i;j02Iig_flrS zCHrPb!iOz}7s5#(k+KK;35jxVtr78=2Ms-$c$;69^Jpe$cr_gJ=qi7HH{&fI>j3B` zYL}IrQOQztoI7swe?}#@$30JJX$ZrkjM$D^?QzlIMM$@d=KjGW4}fbCudU~DIM&i- zw%1+bPM+-DKz&H)Y8Z+sx$zpJT|mfNy9B=ZL72D&!DFGD0Pbv54{q<-T2a$6v{_x#;#0 zrrh2dab7w-74Y%3sG6Q&t7_rxP7*#ktXx*caBjcf532__=w|&iTwwXU-_`v;jJ;!% zX3@5-o2*2oQEBT<+cqj~+qP}nwr$(CZQH!H?~OQd_Ko#n{e>|jdK;t9)}FSe?x6pN zfCLbY?C}i?e$0fAKXRz~F4&_Sgyv~-Y`!aGjya{~>03~W5% zs4w$eM(w$At=+q1z2uEvL*bR8P*m7oIf8g$fGuk=&0w(y2nd6>udlrPvJ*QuXzyO7 z!$fS0m?|lPtg$&Ui+J+<;&4W}&2V{WN`?N(z;UR(dEU#DNHzUl)8=dC9r|7>+qBm( zQX(l0dCuhUyQlH1`2*G&Bc{yC=L@cMRF+#BDY*!Jw8_SuAmix3@WBL%j0}oSK9oe; z?`F13IazQf*djN8jm8$;qBdq>Hvd2;>xR>YqEbQk=F^F`6v#B4gc3Rcao_HMljA|L zqy2@st6oHjdq*m19S0DeN`F>(7-XQentnWEicR5 zR57E$liWr$V7mTx-#&AbrKsN1I-4S`r3*uwS2YI)zyn=glind}`$x*F;c9u`3)_S@ zLew%AgygYx1G`cBQB_(~6P;$q2A+O~Zfc+!n`*zd;hk?egOTz4u=eJ>U?zxgXQqEk zdb#?>FUfhlxxmQ00T=m`;V-g0Jh`Xk@^YN5lMtys#Lw^OLskThkIr&S=|dIQQ~0qg zYW9c00$a%AG{U)eN0YVAEzVJkk7B&%p&Vn?^)Y2bc5=N4@Mj!#AjZM2I#v*J4K#@j zW;$F;e4`&g%M3 zJ8G#S9+7xB7!f1XV{yk?h4h$M>9jCOuwyX_r4K;<-kjHLQ@_oQH{5x-#Vp)*fAMyw zz{lZ=bqRMS^)CXh668HbL~ek5(ziGkZ&U|{ZZM+w!kkadhqSGSZlpUn)h7s5YdJlC zHcA7^xqpczX`Oen*Id&3^g}$>^o={^Q@2=ao5lu~cuUGQ3LP<+#~SM4nc;a>Z?rYx zw+5Kg1E~uZ+ zTf8ONhY|mAlK*!^B373Fg%Dg)llq_fm4A@@+eJP`Qhyl`M`>&1mb1ca@yloZqu$Zl zq4a!|u<#3MA5SzO@i+#ti77IYHaOoLwu55RL$)O&zt>YfcLXg zlPbB$>(8lHx7u4vO-e$l8Pf)hB)cB8()9U+f_WC=t(DeDRElb$s=}UU*BhrsC3FKj zPc`qJR->lwm?DZo5c2dEgo5H>2K1){scahBg7}x-{1@FEo74g%b~-{dTT!h%2tssOA-tdDoTZxeWrNV-kM4pvIu;4};Glj&h+e|MDxgHQ&Jbpk zu!GsIS=;0VSA!uG)^f?u1F7|*aup^wAs@LtWVf6Sp{y3=ehgxDXikPl0$f>0@Q(nJ z`H^xC7U)|A7za7a1PiDKn^>0T_GhQ|JSDkbny%BCrYa@HpyX&EaWztrvZu##IRUZb(SYF^=^zQ1a0^8iAsFZThtkxuxiE@Q~OSWE{ znhWOolq8hjVgxr%Z)dcOaVS&evFy3%!x^TBvT>RUi9wMJ;pA4+R>sup&~T}SV7pgV zYL7FK4aR;mm$9gRO$blrloKh?7$Grv_G)gq4N!k)H+$iutgk5juaAqs;6|<>Vj7L?x*q33 z!NHT!xVI-XKiXPQ2WG9d8*7f9d@ai2r~865L9OUa)4dVlN}U@716=N9dXQ3lJYV z2o!|qS>#F~5{Fqhb#!Z5N9135*wEz9@EMmCbG3u62S~^#H$Zj<#H(Lw&n@;)!b)m?(8q@di83mk6zNaIUS% z=s{JduUg*w^e=&;R%M`k-z_VLw!tTN4+}IB%N;9aqt=nbNIEHf3Ct`x{Dvs#xQq9|eE@$)88gnc*0O@>>Qw2aE)znQxF3Iog}u68CF zMcSwi<~I$MzK4b=4Yge|^t6?uy=~O1y?c8+hzUO&kfiJcTw{d$MQ0l_3TgCVUm090 zx5^AUrRajfR)M2}5Ki^2JteCrotmjBct1}vbSV{+{Wj(@=WExuHOMW^R%=yk#L3V`ondJlHQfcu zcU=!Dk`bFy*b&6>5zvt43zMgh26u99o$cavwATh|IA*=bojc2voE}XYh7Xn8DWjv4 zXX6rh0~Qa{qAFDzONbx)TFRH6-_UZ?x%bW=jA!maPvRWnv2PDg_@aYz6EfH3RX2US zM@<)+0{I*h;vt*$O)rcm?fsN}0bz!RIT-2Jy&S`5To7AQ75c*a8mryh&1QSC&?4J` zfP?m}x9T!ksC3d^Q}n_jlFh8OZs>-ZxYI89i=D-__gFdymzfpG%KfPt;ul;*B(AdA zbvi3(2yxz9dBAijXYp!R$ap3)0*7qX7efxl3Uqz{4B*7AY3ec}!0_hHvyIxks(#F- z6V>HMIpM_J>O^fKRWMV=E}m(CDRN%AHi(1iV0J7$SdBef$BiD-gBG|Jp{McafeXf$ zizkqRzXN1ZN=<12Ve1$!t(}VC%5h*}q`GTBl2|$Lh2!IAPyMt`g8<6G-}O=XbnVtD zYH2jO|0M$b`-Yvi0vA?;aaC&>2_{!+?o6mbBtVLcC)JWJ6$NvN=6eUvnKyk;4wN*6 zyXY{;)dqBtN?(-$jGCxF)i;67O=igj^R2D8?h+B4@URg zqR~p$wcnRyA^R3vdW>hG7d_$JW-(98iq#46MQeT&yeJj6iwp1=b0O>|tGx}!>f;-W(G5oJb&(;4~Y2GTElL~~g#%kb7mt?Uluw-jn;sKzV z*TxG47TDOkBx@z;gwx9o9i5W9JEvKz%1j(2%)-|i)-vgnyDP_snHnM%@R0sLw3CM> zA1;EyG>mli5kNQQn$#~-BfeiwRF@a z35Zdo%R6h++T^iNaj_=zmKhJ%6j;8zQ%S_~rjW3`P{XdghTnrw;Z;)@R3W+Fs}w{ zCgH1Lhjqj~MKQbyx?W$5T|}U+23l2#ie9YA%wqA@veAKp z!@hGXpCpcB0KvS4h&I8An0selM3Z% zB6q53Vc4}}8t=o?^6#+JA@Xw>sl}CjVq)|z}TP%4D6x~Ug zlF;#K+`u9g)8q(d0AokU+57bB3D>gToiW9(cjgXT1S-Sz^~^;b@$`1-`6o)qm?#ck zz{~MNfygNE)wq^3x%=&V=4`W|hY{R^b9%u@`$N=XvyfkQ6M8~aHPGc* zY>*8{FD62iYA?ylGmxc(*7OkFj_)I{zXl1I){_t+hZ-&`0iwTdVyc6O{sAF1$Vb&5 z?4>px1`Y)>?iC<-G&*~t{pR-GU*U@3*mXWIWQnkN$b7%WT;1-`nNdv{o?FG$FMXW^ zTlqK)JTj*ae{)Zh%`F>2@NsQa}QR!;a}1T^4CZA+N|sECSq)v z)Ka(b;PfySl|4A!rC_D!UVAgA6tf)7V;h>ogd!5?kP8}^^63)RZhHFuvMFEYg4vgZ zhoEY7X%c zF2!RXM-D_SkzhA@z->~_cOuUzFH6}7`C;;TR+4wUq1DC~hi;DD86=rMyuIz(+Kk0Y z73;AHNkow*8e<>Kw}OLdP|n-&XMFhUcOfZr9-ds%#mn|L^!dcpQF+e9 zO+^U1*yESOjS3_9hMnN`V#}emsA5uOhrx zto~_0v)aSsWr?Sn3R>MJ#>&~Rf0ia+!(PzEL8~yxjn~w#I}Z<->0rn8%Bd*w4YnEo zT{&h#^_hzb>dYL!h-eaEygIZi&o8UuvaW1kx;yTU_O6xQOyis95U%quk<9rKDx%P3 zg`i*V;BX!I9d2R26$65eQ$U4G&aRy58nN%!f6Nn>za!Ua=;R-7_ahP82lQoX(u-C3 z>d5~c+gZPL!oRJIS#q)2eS57>@!rhcten`2w@qXD`ts`Tn#G{`JbpHR3mmiB67p)k z<0;-mezSbahLg5S1*#RR@qwAiycb+$zKc(A{!!E^`pw7~S3HCR`3=FNAg-2Byk1T9 zpPr6Vs)K#qH;mBfGb>6*(PdeMz``a?5}4IVnTdj94gJ6%Y}6Cq=nc=mfl> z7u-c)5HT)7Tv3}tPSuNIe^W;~eF{habq#ZaMsw0|>0R$Vo;r>o$=&Bl)1}YC$GBXb5V=Y!mE8U*75UKeDrhpe*27QYtUD>V+A<1v|6+2#huSfPQr7ce$p`TB`S`5BBrb9)_%z+U?5d7PS< zd+3x|OISEevHAW*#vgw7A2s&B0wmEh{%?TdmdcL8zs@%A8=but3Px3vujcEh4tv%s z$5b;~FG4PKQG#w#yV|V&EuEdDB6O@oKEQ0UUtfJ}KGsVPc8h5TWpX8>FL& z(*ZX3moO3HK8`tJ%o)OXkwCqv1ye3=LHY5yx7Uu8)lM203_L0%wsq&nRHss`=U~o5BEvr2Hdc&G=l~gS!gr09l`m<0r9KUR6z2-VWTsFPlUGEg8@66J zFB7^tXxDq=VB3PLpgTAmZ$DXv97sE~$R|!2ElmogM`~kD>5xklMk|5ld$-9(F#1>J zNBNih;-YnP<{OdF4`dNvNatZCni>xhSXwM~xovqfWy5%eI>%JnAE3kxa=3Oeq&bPH zUeNFeN$DLL0jj=IB!+2EDn)GG<8bw>- zqs~72s;4ZhIT?h6tvbswofo4v>domoUjj+%baS1fN~A{7^=XIFwZI8xuK`8 zq5)|~tb1S8_|%c--IPK1I*LyenCM#nM159CDY@Vu1M1rS=BilLaK{TFCGGfcDU4gl zb_`*>leqS$(Hto5K`KW;%X<|r2g*7Yshg0nAefM80`oBS=z7MZ#_4fk^J+)#N=Ag5 z8uf*)R-sjWN6?-{s_kjSYQeQ$6!=E{<|O4o9Lv!Bq9{u|jMhxVkTWA*A-SiMqg`Nz zMqV{daHl8gX$dec#@?q$5m; zUQ;)t)(Tzxi=dj0vGP296W zJy1g_eqRwH{kg-8w6fAM%iQg5sWCP~7L(2&_0cNJss_O-mCRIht9TY}a4Y%CyDnGf zal2^JolL#09w>Jv^zTO&`K(GSOn()-P^ex}pHXQBlbvSACp5$|+6Yhb!Yo7|<7_7O zu-!eFj=&_Tj2?4PmnOWb)o&-6Ut}?VcYYviKDzX1#jNo4vaY+L0=XwsQY2T^=r@25 ze^P5dy4;%nWn<88GxD5!SZgZ5XJ=BC(BV9<$;-245DxV&>jzeswqTuW1!sn9l2u7O zduy&>cEXo&k0<_`Q#Y>Ih#@?CJVg52GDLfS?Acrr%aQ!Y8T;SyRQ`XS`z3Xan1%n> zb6@)|FRBio-4Vhn!Jl6qOQGC}fGfbzK|jtx;M}VCb;s>ccW@VtY@(uwkI;N@m-gW0 zaJ(6OsNkP~{kA>`S0g_NzG8>)(3In6z2TOqb9aWF$=KM9|)W;|nzlQYpSOOD>v zN>#WVjcPkNd~v0CIln@A<^G1Rt37EI#_)yWUwZLH5#~nLuJ6vprtPcPj$e;vl2_P5 z5~>C)!e%DFerWXl#jbT?#&tt|-`e<9oP|X6zCyuJ!Djb*J=IbsFyhYEYX#;z?wzf0 zu|$z>LE+cAfJResgZLEbc&E%an3i#2ur#C3hv^9mm#i*Wg|JEaBOQ3{)vl}Ra9AR~ z(xA{ymykmB{TV^P=r7vARxycA*d04e(A9IP7y-40TD*tQdi z(n$udZDGGbyopH_?3RvJ5WPz2AIsz)O&Wgsy5b0dWgn z2*Qart$HZw6!I!{qDKqa_p@e2LImFMSD^>{C>U17Q#%mqRoA^tzvrBAibCV*~ z?FtIFpmVXvTU$&%dNbwT(WdJ^16bjCC#&sVylUmW2ji@N1V_?*n)Aj@9gtX$5MJ7a zm$6`hYr+JkO8a%;#~BYbm!z0HfOMo+jr1l&g1f3+MBY&L9nbh|x~HI_z2PzurFI%^ z{thhL*V)sqJoTK6DhCk1$1 zPA-rHwuXwt;^QC>{#67S1ZtD@BbX5^!PGzDE^)Un-Y0gwEmy3Y=rhT*b?6Ac?=6zD zpxw_i5TGZ9y1}~S3Wes4hjnBcbUTgD{LPLpD@d1s2CO)C+`yGNU$uHv}|I)g(47Wh8SmaIuQ0v%one61%fq5wZ2_Pz z*SPA|oMgy+Uwcx?&8@Wl8okPz*lJ0t5wVoW*$@e^P_r9UO)XiB;Jktc{W=4B0y^;( zSNW^;Au?~hLJ6<>KEK(b^)Ib#*RpY1Ql|vDZXi5ce;Al00ga2~c<^0JR$@g!T`=zt z<4Ww=8+c+*y*GAKyStj9aBsHIuE)kpU*mwVW3+vczL~>Ab*y1>6wclurkqAkrgzWE z73RHGknGdS?_I9u|EJ^vVJwp|g8V8`@ox;L9& zd+tq%-a8n zYy*;|9H)(s(^I0Wo33U}Y4IMApZH~C4qo{-U26~>$+)tz+fieov#hkp)yERY#67J& z>eFTAewQ7!aTFFn0bm)EV-;h>nCUoNY0lU~+bk}aEG}rKyb%%5#!kawgz*ih;oga9 z9Qa)+ofCr~m&r?rEGGY!g;@Daq%=BLKP`aHo5iS?fP<(y1MQT~?QrF>jIh+jkjJ@2 zYEU}KFYki;t5if6s<0IL?jvq=|!j*yo(6(PY?KWb!UJ}cX41x)3$|+Nn9T)MYm-K zt`m8@BgIu4F450hn|I={{P0#{?F!eK@6e$ zrbgCItqmGBy+mZQU!Zw4KNo+kYmlAoo(+-YuSh&=;QolsOk|8PF@er-+-cTLY?)Hot+;uJa5Y73&NF|NuLyDtdFw`{XYn2WE)N6CdBs^ zL{CHHS2{Sms)YT4Xtn6#lapEwK1tQ*8EU;y4?WW+QxW+;geidixR8E?4Hp4_Ei~O| zA#At4FMeJdVaBhB7wg`2ID$^|ydb0@BoAN$K=kECDuF+w9~$`G0|u-Yb)?8-51TlW zl9I67nLna`D}GGp{tAu0#Hzca|vNz+pPux3)Z%5s6jP7&s8p!jyaccL*ULLd?0!7){-QT6na zm8_=UTHB8r$y4ZvemEOAjhr7HL2}Dc69N8^x0afW8i?rTkHsI*tcI#`?QX|B>#SkS zRk&J^)H%MdZqwX9Zm|^?!dc%{W;L4eB(tGSc}d4jcVkTyS}ML?;toh{h8Wolh%a3% z#u{w=Y+VqSj!F+tr7*qQZ})BNd2R#v0x%$a`8{o2;>cA!aPShJPVQa?4Zie9t@EqH zhcIMtym}KW}pCz6nYpUTP?(_$V#FjE+K^v&2ZLXgx?}DCh^Wn zxx~1mLW%G;I8_F;>QoCBS%?A3-XA_?bOzE0b*1Fkrzl4AzBf#5wk$YxkUPc74=gb;u!edD0-Ufky<*FvFDb zg>&s(YO)8La;ozT6G2X>p5{cL5;~M|en6I$<-XXwTc}$7XnjW-u@vSy^%wnqJY4*I zr%G;q7CwsNCK_N1_puT4Pp3DWtqU2t*xwFJmaTNA5MQ67D^ZwHL$!8We_?bJuS`!& zvI|>hu{Am^ek(YqxyzyeB2bgAS%@2|iWEAiH$Jgh_H)>3x;b@UVwga)mTc?9^8*+_FK zHt$3mt$n&{g`%ByU!9ud zr{d(<^*fc+`0#!nou=U~b|M?z} z;&DgmEqsCgNM8Mjc9y4o-a6LZX-sdtCLl$i$X0vem9de%sFAMl@NM(#>sG7 z6m!^@u&5sN7I6Z^hokk4-p32mX%W-;O&(rh?RSMT9(UE54|j!4go#0{ph0Sg01Kgp zBMKqvOW11af*sy(sbtr}AP$+;3+kfb;2Fq#Wf;t5#-htnw|FICv+yf62~}fWS@ps)%ZRtGZEICmjwp6LX=Q8MB=4SdfcVXxz`(+w(EuAlnUcb&gi zRqOotxGkma>k(rVPa&k+xMlWWuc#XBR^Ntp7)Am{5-3RuGO{P&{>A@X6TRi1nkOk! zNMT+)lE#-6g8KlrhMX88_c`PZi=BmFybB7Fz9t7rOL5i zjxUx7D;7t2bm*QBIBv+f1xmH07&Zd(L1mobt_MM2Jn($pAnJr&;Qyl}{Z}Xv270>x z6$5Kh+lo18M)bMS(R<8`^J66P{+m+5G?fSI4|Ya(%d>AQ9QQiIb$;%A@jRkY!6S%^w-bAka5rJ#lZfBizUB8d4r2u(FnrBMFAMMWZI|cL#G% zX}f+tu70*{hRgW_tw;jSf#z=Rbabo=$$pPtp0)xcUAqSrP6AgMlB@0*CxE|UvHkYM zHwTa{+^9-uCSk?O4GmOP2~*A+gbF5?Ll}irB=Vl@Aw*eHRZ>l)9N-7^(kMmS>sSt_ z6U8(XwxrbYFGfC8m;GbFq~59S8wFn5H|YjV!mO9$CWRn3!cj5{%~22XaZEDVnVHby zVe;!AWKxHM@Gsu73m7#>BG4eTpL)W8Z5k>MsnKOhxLs zVozl&+t0c(>EpRvvYi4d@nQ5aS>sB(&|6FO`?M#oKFiLgU?+4Hc`hT3Y}%tHaFjz^m;_7DoO{>AIE;yd_SyOkp?WK0}XSD#sYx0m;2sC+n@;1{^+ z7vQk({zZlJYTVGUq{{)gDgqL>d+x|j1l9N+TSWSFlg<2S7qMSRG=NZ&!xF#?i^p~{NE|GU!rm^woBf{1 z49hl{sg>z=jk}r$J9s^|{|OW`^3c)NM zi?CAClfxvDsRWcvfII7k^Du}!m;y61(p5B;#}FK^@DtP-8CJegrF7m2j=Ft*gKj|n zHsP1|N&kw3vwU(#>(d0wd*sfS{BuWXqXfTsJH}zNatxQWVV@2VondTqt4jCAY>>ZR zO*5j-<1_VNXW|jdczHi-!18b`hyR|oT<5am$hd;{S{mk# zrFWQ-ZW3a-|M5k!HZUFVj3N{HyD=WJJLeE?M)uM7iEXq;LG<+$35`$+sK^* za7&bB|F^+&8`yTh%p04tE^7`<9-)*%-e094DX8UIvtuTJDaX8Hpiym9=T!@k4Hyn8 zS=@1Nk4>|$M5a7aa2{EsDj}Y7!NuJ2=J`3iCArR)E1!`AQl)vdEFyA5Wm8sTzq7x zqBoQ{+Bjc5Wge^R&=QH4uvhNWm^pDbXbRe)mU$oNM)T_P=b2; zCX<<8CQb@rBNDIhyJpH%AjK1h6?Vx zB9gL=fP(<+`tTd9v8(nD{EZuMPO0o!O^B5qDZUS(=_n@1UKje6W0#NRWnbb;#_H~~ z20~mWGRd~Fc!t#r$pxye#zMhlcSM(-?{un7t>0B62Fd3Xh1$m%li2)As_*C0M!(9i zpYo$A_yoVChlIXux-i(J-r^a!#GDbmID~d?gt-e!6QFEj z7l=_WC)bhnDSdxUKF7%h-hT$Cuda#h2HJbaB=i1Bulx`%PSkRe-mo%>9UPvz+yP2z zDY7uRG1LArdpF?Jy*3LjB+5itDh;ld-CR-AW{rB#^Iq1S-o;Et=H7K^;C-xFL55)x zwdcdxc_seUxRFxNXmjhpSrdeC)`DDBm@)n(|glfs5H#(54DMaR>GXh~+VksAcvoGe&Axl^rgey=0k;f8yMj%aKx@%)!`Xf(M ztdBIkULdib&{5nJffO0Cy$}VaW3#usumE>Q<9487Y__(RT4N!wuBrq*Qx2u;R#UEw zbv7Xl#iO1Ov)GK9(Z}fD4=6AsA<4^dr(iPP&#hh5wvRB>!o$B#vQmi;;Cf41yy66s z@(S9-ErTVYrW!7ui`e(x=u#}6Lkw(Yp>ZP~3Mrqv>p*WH8o94*?d0#I`0h*IfK9eX z``tmj@u0o^EuZK3uC{1sN;P{K2}d^knw84ty2i9A;iJnj_ExLIc%&Hy(Lpw~ zUzWDZpk5>XZNN$5#o1(b4%>|M@*>Y8-cfMJa>F$A_SYi#lPxR74-#|}=VkxglTe6g z=%;=Sa{!xn-8lwC-f*uZw}L>;=co4dNahEa&K-mIKVCxqJNgV8`~PzEO#L56k7+T4 zLK;F}0?_;!!9NnbczPO(HLVkTqmYIqiF{ru+w|kVoFcx|Xs*sbA3g)9Dws=;*NuOI z3^GICZHy#w(2pyFhEz75barPxvVYugx+I(osgM+;V0y*a-e(MPg6sRqUIvsAiul;B z)x$-@3m#lCxdGK!McYQF_fN(~XQ@g>JA+4dCnc-J%Y`?$RGEbFhLW6AnWXyPr!h+X zRJ~m*)e@YPM2kX5m(FyB4tkz5uZIy;$=v0|km2`+wo%*_)Hyhs~(PwR$S zi{n=DUcc)JCisic2|7C|il1(S=3y9DI_-}bNC%3hAEdp529A`E?Y2>r0n0KQA{Yo! z^4$e8HCm1D?OC~UnCQ-mfD8Y-C|64bc-YV1p&(PG?5 zV_69=o9RzB&8!dgy4AlgtU`P(>YodfaM5c%81@*lF1*d*Uqm9=RncqwOWhHZ%BtO; z@kyM^619~Ct9C2WRfg25rce=(g`LT!t%O4~$v|A#8BJp(RxkbLrodL3apm4c74c^9 z1C7-k4@GR6!%snUHphf{qN_^qIW~N;lXc)n$v~Y)42GzlG*OBPIK-+ypaiB5M=|nK z&4S|l2H6G@h1ou)jSP+IkBgYU~;6M-r@hiIGVVj+SnIx#c2Zb_l)Ma^`I{K zo8{On`70GLgjqy1u7gmh1ih9cf$2}EkP1izf|Azpc?s-^a<&NV{t+F%f5}z( z4KUbt$)XXX7gx2AHD8xPkswnAL@dc^*W}?W*@x+afb=msDiFx+f?GT=4G>g+ zzAxLY&lkq;cqG!F7;>gMdVV!22V2tR#|NJhWumuW_NkPjMfMKOTI|>Fgw03M^LGcu zgRn#d9(AQk>j^Ddk9T5zu|iqdC9V1)xHzocE&dt2pgw~CK#|Ua7$H1W(Doivxj51d zUUh=vH<~Tu;)8YdxuuZ@Y3HgVUzee2^R`o8=k$jgyN=!h(G{VJ#%N{gLd3^FDKd#Z za2VMYMuP=oDrtf%*aO*hgP$b}@24hX1sb*aRm<4leegO@?}`c`MuP^Z8F*mBrSoInOC+j~-m;4J3i^DO0@>d?5ijv7TvuZvm6!@Qx55UNx?!RS+Js4ZYH z8a}*3=h{1qJI!@b|5Otd6&5IXBH1oZ{hI0{joq22*AhEJqmTu`kPj+b!IshlBXn(U-D z*{R%#DIc!)IyFeABzz(P+gw<85te8`&tVG9(@Il2T^!#a+*OCH{wqu2>~mJ42rLro zqIlKyQLI?VX9Z!YTi{aQgAq99YcM zgjQS^+oE@T`SiG7r0icCgG?lms6Y_k^<4eKsAw03LhZDr8drEbdLiXn+v;(pWrqc0 zvf9m9<-`!JRsHvTae0NKVSSJY5Hd$?%M?I5IuDlQ`rg;$4+jX>RKeD7dNdy|2&cBp z*9wNS@m;=y(X7|(PuDVHXX+&0+ppYTA;Uw^W#98)!Vu`E%ca{GLA2xF;#w~beqm@U zV6V7FGpytuJSvxO%epnUww@c@p$i7cUIg6Pmszhb(*N3EEY4P9vT@;195a2QX5S}z z4n)tpmP`Xc9wK)?;cyl;M$WSiZXI@V#mu0hpIkw;;E*hTENU=gEl?P1Wr;stw02O- z_M0@k?I-*+wp)*?G@MCF&;=*((APsz5q%jrr8m3DJ!L;BeqNjvy`~YtzB#4h2L(gArZPFQ9F@J|b z`=Er046q3>G%>j}O&XrUn&hMQl`AUBaKfR-A*zDJ;u>YCl8&{fBO9n8m^=Rf)rQR9 zmb_lxeo=|oftYD(s!4J|#Kq269##C6xo2)$Rob1mAFt?tvkg^yhx@Hn-${^LQ4l3Q z&oYejYV0Mkx^*~C$du(XO z_se9Xm3SPo*(1b3AbMS7pe_tIrc|anFP%VtYPbizniWv!$7Aw{Wz0JD>9m=Y9ipM9 z<0JVnQ3k6AYhe+2CeX>sU?V{?dg*{C=i$*9m4F)EbgI%VXd6Sp>mxi7be~0LQRf9e z+Lp9#RBFe@+Z&Hp3>MV;}_>8WuV#NH zHK?`NPDz1F8)5h0_oCbXo*PGX#J!~TYk)PZJJC3Lmbb) zt{;pS3l^4n$^mnYoM3>cGs-n#z5UZD3pVs9tDo(GR5eIxI^ripxd>*3y7b* z#n|aVcdC6}i^-tQ-vzhe4FZ=+;8${$GsMz+u?tymlHpptrS;Q38YKZGK*X)uGt`wk z-x@;eO_odf05UOnci{tgX5~=I4rAN%_V63(_Nm?$Qy1JM>m$Fp{t+Ts&K8`INzS)zhiO zO0m@IIjB4?6rt2XFgt<;(*e3pGx7?m{7d^zx0xv2V200+Q9Nn zS#cUxD|c+U69%uZ@y2Z4af~kooW>W98)c2`BM=R(b-PvWbWhm=8qQp*XU}C9IN^4c z<{$^0*!}!s<8)w(;@iBJ4n;e44i-*gi%-(WGF3kIxYZ7Embm*>?ps05I~f6H%|aeT zCQ>q%F>|!lj=Ln2kY5k96qYJ`pj1lDC}R44IWCJ!G&xx4Hkk+4NP9cg-(~jFis8lR z-qn>3TXfLa8%UVOfK*0Dh5)rF#V5M~{XoI(vZ~$AsNFVV@#1=bi*|iik&=d(FH5sD zI7VjC9!lve4mU*0Ee`xG3*1})bngx}nhK)W7SOuzMHbS+GI(J13G|BFD_ixKsvD8+ z@fvhc!1s5=oiH8qIr^bKZ6$WQqiHtEKm`jOv?)5%=l}YraCe=3*q#^6b^kCa2kqn4Eo&ckG{}CYQ^cQ zuODMA%|{++a6$>=V@Mx^bHa`l*Mp*9;lVPRKlW3!~=>v9hMH zWnQL856l6n047sb*S$KN+g(MY(-44{eBw}_J%#~D3f^}zyT2avaC8*1WXTAK1(eg+Nq6i?_?sD!h~vO zVw+AZe+#}b1S+M2K`fh9M8%RR2oUwIAnUy9WW^#I?q6(ecLtG~gqE*%ibYXeXJip7 z1BTPg-o`+jm~GPjf((Pfb;6AMlUuXIgaEVjNIK<62(A0zz-z^)py{B zQL65|Cm}126*?SjskT#R;;r>WVS24R-aKEa=mt-BIZ2%40et}M)e(~XNWuAL;zo`{ z<_5N}EAc)y2Q7XN|7xEsa7n7(Qf+Iv{O?#ld_&6nSzD$0xK;%G!$6=sTgX=L)s09& z7Hj4Qi-FTx4Evs(?yYb4Syz?oKx=wfEwuY%3ObdGW|>v^Ki4diqvCUtxQJ8xK8RDr z284;y*E17m{oDswG`Si@WRbf@rVQ;yYv(lY3fLG=gd6u~iEjWj-~gi~Hl4o|F{)UZ zomT|1t@_(vkF@y{o%{bu{Tcr|m=M$d4yg{QTK!K0*mt*1o=gRpV&p50Q?GBMMKGMO zZ{BtZDIQ8jGx%sc<=7d><;V>nKAd=bj#EA(NllxEio0DQnpn zch=2wk-1J+y~^pT`Zxj^Luj3l|NM8qlxjImIJ@30Bwl!PMBVq~71@JjOQ_nZlq2#J zG#??VF34&SyE9S~!hRqRv|HT9({%M;>Jf=>s5$3pp{tDi^Gx=r_L&!tBK}1z1C6M0 zepUUU*TPbnkWQ}T+x=m-F;eO2!#xMEcz#`LFm;!zmT8?x!~;vh*BqS!bTTT?JV%h$ zrn`BnnyLHYlS_R4J$ldQqoE{p6Vb^&d^j|G1XXkyA{|WrLNHYRNJwT0v}K|&+i-$- zkhwvAW++T7UEGs--xZ+gNrp*4sz?C;UYavbADb>Mn8dtWy;oQnOH!QLwX`~oc+F`B zbq=xb(!0AYnSmJ6cOmD^x$n}?5}yM{2=n9qb;mZ#pY|= z(^!_3gmneMX;Qh`gwukh7^&8VrN2iu(g;wt^3t{DoXm}$+t**~7^h#P-#>j#Olg&Md5zo}_fhP^uktzq*pV40 z38?Hd9Wga>l40f|*FLng6SYaO`&K#nAl;GT%Z?FWqmc&;j9RMTGpJibzyn7rJ3yS@ z3D9_+gNhOBOdjbjf_HK8*ygfFZoH8tiUg8=OLZ}smDlO?%2@{cw(oz+#v&M`)dP=bvuR-5XikT#?6xIcSKeWDf z6gowg>(q|ek}$%%RHCk6(Nyd`ITN^h@QkK1vFZo+=x0MRi*;rgMZ@f<$TB9n$(*Gy-EZCM_nHv6O^TD`Etj=I``4QgO{-ijnrl3vZzk07=sc zG3n!u#J~p|DIBWAnG+t4ArM5uHiEz^;|6=7-Z|=lGtn=k${Q z4`c5XoLRU=>&CWi{IQLWZKq>*Y}6;bsf{J(B>BqTA zNItYxaJ$I+AM<{@i0Ygggv?AR!k(9z{It9Le>ujyHrXJ-SCF&&fW@cYBBM|FnkV0I zK>h0{UyuOO3p&+Jp19@_$b@$9+DS$B`SWSdwG7Gbn(6$I!HD9wg*^DbO?-uz#<^{I zOio!CIGjO0ea(EtGLIX4%1>B=T&>uC4h4!8G~+ z>%g5cSyJ^oTVw)w;)}yCr)JZKGU#|gSTaBf-c6n_M3IpZgM{jZG>ia6x|CkFEFn}? z1hvKF_uX&>pdjxsO)Cdmx!oa!53di<**I20sUd@B`=NbJ*X2GSSXt+^s{N|>FJ8jy z7pjbzZm9>m56js$vWh35!>#u2lH}#S#1~kXLG$&${{H_r+6+7Mf82^UHAk!0+0izi zX&TQGXTo-6s5+tqB1i<{Lv7CJ(X@OpETm)TO5kT=uMczm*$;``&HYG#jVTv?oW;io zoiY4kWPLaP*A$|MH_0&@`F?VWi-R2HkePVmgB?#x0(Zz8d4<_C%%DElOy?>&h7}3z zn_QTA|6-ziJ??!s{5g$G2_i|+Td7Nr&hq{C0FS#a!!;yvgvNgWAl;~}`h~aVTxYup zYxqNg*bfkgGBRAMuJGAJ)(`=N&-v`ePBvGiw`+t}!UTjR1TL=8C1gtqM5qP<8W_za zN6>a9?0|8VDJJT5NF=nc5YO51{mIj%;TW(n!bTK^RFjlq?sz$_`L_A+*iEt+QCd86 zHE&x>G2a5ie5D;QFwceCe4l8+KmsMfFB>P^Bkr$d z5{){Dshdd5HIvTQhW}z#I4_nvzsvhmAs6EZCm_X!Md+{bEr<& zHJA~>y=g_(&8m-OGU`;Ek`6c3L15*&d7CBs(w-t#6AdPd@+xym99=LAs)~vf6|kb@ zbk;p_q!B}udhiy0&=EwH3W$dE*a1Viy=|iSmD}FsNlQYDSg0m z=%tI!-$=@*8`X0RFR36#%~_wzEz*%C3IU@fP|FVbsSd>PyPBY}l_eHgD@90jYA_OP z9%+CwnnaJppQ8Y#5hT%w@^zN$_-elNiboM>1ri>THR=v+&KL`6)_Hv%kgSbJZ+9~1 zE8(PKEEgw#mnl*87)DZYNR(m71a%QP{-R7-ql5NR(^NaUd7zUdsVK1G>>CDy|iq4Eaays}mg+jml!(;st zuun|Nmc!E|VZ{69#V2>Gdv(QMNipPA#s9>l@_cgIsGfQqLjI_Xq-4Mr`g4#N_IbdeB2&1?I3W@=MNQTSV3RW>||Jvm81rs(Qk%AQ}1

    Ky%b&vZA3I7O!GcyD6}2?4B<1{fx&pJa_gB0l%Nt&E{NF_+|>gcEcX+N z4uq;DA)2zljNKgVFJ*x{-0uP2%p=!$e*yVz27u!Zr2sKg_fIa#^)9(jef~FL9T6L7 z4zmJB;^d{mR0ad3P(CuLvEB7K=)Z?usYIZ2&d=P{m8(jD?T+``29+q(P+%cm`kc|( zs;`9Gc#s2R+cVX0KRQ0N2Qo!ZNGn?&3NAlf(!&u95hPHmy5am8LnAIp0ZHhN{(^__ z!pMd&@)T=;qS|)&bK|#<0U?7Yw!I7SHpmb#dFN5W5Y{P}8l$(h&{G}4AJ28Fc$8h* z9>2y^ki=1jyJsT0Or0BYR>+hylpeXo54UrHcx-NelX)lpA9&g&OlJR8X7yEO$5ruP z@D_&2Yjv7&e%(i(ajplCJu6c`Qr_}qJPM!kCuIhUx2YpYpUtTcuS}hILho-r7YHoX zU4emRO5$(py^}_UkffS-v>Jx&l+BS<8QX33%eO!x54cC4MZBe}gxVT{N_0nj zSB|jF>ebZ_VYex;u8)(iZJ(`lY@M6EKad_ad2O&Zmm=&<9YHqyXos419Sn)6V8lu-S#1$QheybO3y7`^!SjX|AAOsbDFA%v}c4-y=oy$~|DQjNmFiiVUpA#uEiDYUs z9xR<}yo-aU@rI$KcTJORLaq%dFK-}Ey?5U5^I*!1jRI3a%r%sD>xWpG>E8E9UCgs#U?os*l@M4 z1|i-hBtkEnou}B>>@CTlB*x0?Y;2>O|3*R)hLGXtkKFwx9a$r(Ld?~_(Hv&J!-g0J zQ_SQX+KayuYX*}#u<3zYsHZ+I`duXZH9Zk`VuZ*Z?u>Ldm(ZfrGz~7oaN0YCZL~YN zR#&g$YOclEeOJYxTO_fj}-*z&?*2{ zjunXekT10aO@IRCMj#)hj=u&UeAL2yibzXbB#OBqhxa9&ziS*zNc1W-&?r3QyS&|_ z>TozS?jdba1^2yKvn2YnO7W3`VZM0zXr)CTs^Mj3ikzq++;=?fH;MP`N(n4<`^hSg zk9Eaw;GH!({j6jcmBptfk3YN226}2&SW#GpZwjFw{#?!OmE%Pe6u&tm_pTl)E@6G0 zB(R>uW99T!PopjSkgv#-%JNr!SF~}kDJhT}lw{ouY4=3^w%!aEaJ^-Tu>@}U_ku?F zH6TsIHNHZwOSAc`H$Umk)CwA1@B^W_P`d8h$&=Q77E%jhc$kkTkA@jCV6Sp^XMIKDt+!A8i0!yE2(nj zZYI%y+O;tluDS1MZ$@~1xnHk^)cgC)p)vq9%y<}imE3=vD&9`C5cxJZ6g6Z1_tS^H z{Vf0m4$BJ-izh4_H}Myzynm2hHbsxhlQ0P+aaL)*bvIog%YWnrmlUr262cb{Aik>sNty)kFvrWeNlhZM{dn$u{@z=$b zi?OfhCI^67=bFE~j0&5zTn^>G4`gxutUUKZ{RQa0)EwSyk@I7EgGE*D-Y= zf#*Z0r{nhx|q;gY~GVCF{+zT)Pbw z+gI~{?==5n-FDx9-XVn!;ngp1Wr9(K*XKZ34rE&ER?#^cGdOyM=`)CUfD8x^%u05c zQ!AMUm;vT0$`wn<7dpxT)Uy9lI<+-HnBT>7O>!J`VA7pt)~g)S%E~UzZ3edL5WPjX1y2y1I82qVo%V? z-nFFGj3>EHCR)3_l^2pgmC;?eiJ?nNp3dvYgEz(bf;2-Ef(VZS;cL&R1wK98J4g=u zN2Z>$pw|s~hBY_Sm;`?4-gP(f&}sg}0?mF(n3`a}KhigoKm|{c=r`Q|oM%Q1RZqKs?@NUk zTq;(y$k4xDjS$7iCQvW*8oJTOw)Vh=O$Tx)tf z2+D{#FqMQCJqXz*N|BcK=#{Ma19^Zg-hgE?5}v=i1J8uFQ)fE8Q@iIGe9?^x*w>I1 z_)lH!cwt8rOP`jNx;eL9@plxQEN0yIAYaH*jaCA3dFpvr4G$QoyCz&n@$u;ea-eoA zGxlj?B`c}+9R7NUc!K{Y$>CMJSJ}DdUt1ae%V~TbuPa^81}gsSK?H>G7#GC}OJ3SZ zB~P8i_(DogKAlt03-r!{^#zcn!?8%f-V;UCJKVWwRIkxy{+ul%X+XH+NHYB0$Y7D3 z`j1J?p>fr1F+S)yv&zX)tIG1a3rO*7(WYFhrsWTW|24*^-xPK4=MNEMDfWiXmeCSF zUeri*uCT$HiO#~;s#Mt5ki}dKlJXm-j9s)Gb_}kqr=o`d=by~DyP`pC*-#v(PqD*Q?)Udu04kUQbG+;D^%82@6^ z8?&b{R-wb9ly}yu!klZ!eyaNj*1MYW=*^p%DO9=m)Te4z;JQX4|^O~9az;1beQw&61zATSJ=t6#Dh?et~n z*o?5W-u?r}Q7H5ciTfEMF?=x+$cjb<=JPDXH5WY(vAjcatfvBx$cyk2vL%RdQwPYY zlKW`PsE4R1PvKF*jZ-DaHnxRwf%URIeDDKC!-ha=jwuswu&H11LNT*az$v}C?C0Dt z%vPz+=|+*3!*wfSgIu;D&S;~DK)?1kYHEB1v1x&0hb*?w{F55&TVR~UK45{f5<*4b ztheHw1ZK!>-jG9cu5>E5{}J4IeSd;dF?=Ipetqe2O%U92Y=6MBX~(ht*D~_Ip<6hZ z|D%jF{Tyiu#E`zW^m`0HcJH2d}ER%hS#Q# zv#~0TFHZLv!{u*Dxs4tyO4Mzg@OhJ7Lj;3ULM=xR$XIherkqI;O`^Iwe*3>f~#bH35B94|yK zZXMcwsZeUtJ+k+Pq3es6W?4%+_ogUx4R}i1_tX%lLU%sCPjMVm#x(_;6a7!V2lkOS6CfCSuBl>E{;+ z@;cZj1R)}~vT&Ap(Wsw57&Oi=ftWW9nQgJ-vv46}E8Tc7uvB3tyy1ejgT9J1he?uo ztPY$yQIJcbusywX_%e4{-j~b3I(<2BT`4!*20bIs*0d~kYhd&I^|hQ_d@)i#*ZF;Z zrK+{tFv_78r&&_uKGa=pY1g(1659F^7bG&mA9LA1#VOPg0Oo&zKa)NMRyZT%g`W!- z%9em!-A>x3>>=c~p&n~ZgFuh=JL@d`ZU_rikfiC4{+Z!;Z)oFmTUNAna7fw#)L|tp z0FU_XXp?7(DnPL>q)$)vCt2YeJs<*#D?U!!XeXUb9!X5zOikPnmFDV9)Ai6xk##Xn zde)2HI!hB?Sme6cyKSyGS*pvy9u*n7fM3=DlSS07MCG5Vk7k z_>z{vKH874h1%EE_X2^yIqTZo=;-b>Y!>4SCbOrvCP5HVlL!>}fnd!YfGb;tfM%aY zwW#St|3cXO3DR@Azig-eM_c>U&E@KY8RzF*KTmpfMMl%LmEwkqt@D^tJ>K0l_YaD! zqyYA&^i6qu_VK&+_uFbYK?Ad|+g~%W4pJBCU)B{Jr>+pj1wCk`KO$+k&uDn7pmZ$a zlevI4F4oKx$0e@C({enWpms#eTB;=gz>FQf@wIk8JsCJL6#1d-9NAlwdjluR!_Ew- zktc6Kq+b#ys(YXIxcfjxX-5PiY#!SWA@+8P+nE#PtMvgfp5wDH)-ZV~HnD(U&?EsY zwm~XNm_LKTA(H_z147-2%%rO43}>fn+3*1*X{z1Z>?xxxZsb z8Q_-GH{Z(+B8E&j-Bf%jT>tMj?Da4Jcc!72^*J&&B{E1@d>XFQ*P&?RAyP2hOeawW z(E~!W2uGecaTlMN!eEZHGNTxh=U}#y1l$J}dANUeVF!!1^kiixa&7AYGxN;_0K{^8 zUzzZwH>AxXO+ewz_3M;pU0WofJJegc&TzaOPO8g)Dl9S9aR^UO>JEh=30G$tF3rlp z#LIR6^R~Z7@HG9;e=UOl8(W8so%8>lr7nLG(tl1>KHD`j>&8Tek`eiZ7gVxZ`u&Xh zvb8Ckh!GPjzpbef51g^z_FYSbnG>YR3K1li*hc35=H#`59#G=%L4o>4Kw zC}A;Frgy7H1_jf+kVu;Cl1JHPr^Vvz8}~G2hLJHPm@HZx9{OlC%F_}7sao-qZjIR8 z#MgF9K=gK(HtX6-kyz#SpfzEZkf|_R&Q4wjVoEWvXQNQR0J9f6#s-Y|(V>#%QR#yz zMyza=Ra;ebbX%OwE9d-{fK3(>GmP<8`RuOZd9dnHF9fye@!;%9^4TFQmsHY-HuM~6tAmav8nK|UP7MN zfKGt!P-wI03L`$62+4iw3$8C(y69e`+8-+)vTR|HUUWu+_XRV8aqg7`tDD>UR=v1t zE_d9G9EKf2a>$l5Y=t}bDWD5Op%*G=kbL=M)}~K}Ef69|A{p1%nOl_{ghVe|S34N+ zdA&8eK!_5GN*zK%O=d(4dHKu4dlmw6ZF8eEMQo^W{F}6rJSNb%%Qqx_d#~^Kh({n< zNIrtl9`zd&E9bEJ&`}|LS@;n0uy+8D0#!W#^J#9@7}76SZ#W58WL=CS$up=CPQ5$` zxBzLC*(&$+s=Q~@QGKKQiy+4^dR{;uP9>5{D^c+_${PJo#r=u~wAiipI{PKnSaz@1 zCNP6$UPw37@?N69>(>?OmOzD={L};GybZ-?nM%JGRrAcg60+{k)6X!p8&OOR4mI1K z#4O@8oz&TI7tfjM)8yciMoFZtWqbOTh?m|yx)JmrxCC0J!n#VRkZ2DMLvfC>@Dx)2 z0(v_TsXd`)K{zXJIT++!R;*guY5Ik!9WvG<1D7;oULMa>^%v7+Vl;{RA2U}xqs{QZ zVLwS^zp2fFNdTXLM)H~{-0ploI+R+-Y#_}9-z3c9Z|tKc8`ar$$kgMe8n`r|n8OgJ z`=Q{%80c(2_HZW?jfLVLjJvq1-DsaYgbs{XgPNOb!KU~1AkbI-hG`^?WRlEq0*U`p z0+%{GI7dE9=>D6(emencolGc|?+7N@&QEX?f3+>Ey1Hx~i)*lCjTYwo=w2D#Y>IiJ zW=Q-rE94>}g%vl2lzz0Lb5za|9vHsHGtN0tPb3BGw|-~tLP4eK3B4)mn~PpbyYOo} z7!-wymnaxwi?(Ds@7N$POrDk05CcTi49Rq}&VG79s%=ax9fQu3=TTOWQymCy4h+-Y z&AUfYauW1p8ejW>TddM+Qqc^wm3~d_9>+4}NZWNp)1A5O5R@tLT}l9_noB_Vo-~kJUuk%m&VOWQ6W3p$a4;7u?O3_|r^>!Cgqz^H zvItySVmNu1akgJ$GO$Om7LFxAU7GPT!GKgI=fQ&A;}P_-o6bMw79&%Gy+f@_OVzQ` zwlTP5VlRCf$7PO;9MNW0l>r_T&%)xfsVvz|{NIr&qDWxTj>h*%MApZLx;7cG_-{;tBGahMcL zTRF9zRz5J$oTlmvrP!EBfe2-pOx?%(6?QW&{r®gHeZwpNIGN=*bg;mhUX%ss9U zYizzn07p`XnwRO0ZOptjH-RFa9W6JJ18RQc1ggbhvv#~e#ImA4V(TFMhOXL_^^e^; zry82ahbtw=KLpsXG9S*=)ct&w*QIf!pz9@ACibgP0iT# z5oDj~8loiu8M+CV?M;B_@PkBfGlv9mvu)GE>-M)mvUvv@T(bRYS zw3gy?%-~#J-|mUtcZ`s7Ff!67tOG3^^T#iQ5g3JNa(_!~1#%s8!ROFhww4RAFa zvf$K+AAOh-O6#H;ntc|)2OHiHX$Jh*>@anomW_J+ZZ>nf=Y8}ZVwAk|z7q6!>Y>Md zYP%-g`?+iT<8h5B3QmY`j(MPgj~NOEg*PDqZ*b$~QQRb)h}r8jyZf9l{o1q;ET3FW zy-ZHD+>tC$Tguz0HMbs2I0iZKVz!uD_1#H&o{?6N0ESRGruKpJrWXs!c<_F?qZ(T{ zewfxiOvpBPu^m3L_=F@*f%)G^WFZX+RVes68gvYR(C@^jhh19cWveo=J)ssDWoe1Z z5XQWyKOmMMt(oYp1QVnAk58$MtkMXIJvF_g6oHl6+lkd16#Mkb zSethMok`e!FNSjqpf$<8;S{)U^D>VOcfPrn<{3()bfV|#thz>h(dK!v8^hhG>CFWA z#C9!-R-~7IM1K~$Cl71GP~*N9pX{V%Xj|p-lBubcBe2tZza~cqg!%DniNB)rhY=`r z(37gF=UYdJ6So3R2EM5;YsC4klmXdddWm0fCiDf{7onk%N9w8ROhzh5suRLy4UTKh zH|V2v33}v{xp|+Tr zp8(JOvR^Y5qo>SD1qeWN@(pH-vAV7YL0#Ky>nc2l@|Ofjp~TaUiLr01In$AX2cPw0 zS~CR?|5HX{?I)C|ONlfK8in`!9A)TBb9sudd@FM~!B}FK(wyoqhO|PP#K9Gp^^Noz zkpgmkE0`xHy!1Dv5 z>&Zp?QEmSqOi`}Ep5!S|jc8J_3CHSa`SZ>oDIP9%by z@dLs4IDuN`mL#0QfvoBvcyR#7AA{jZWtr|nvwJ2E7?;Y968$-3-QjhRtHD7GB0hi2 zcCvhX$56uNEp6OUBBl=I+e+`Uk1E&s>`>?MqGl^3^v`>$HQj1^R&{XwOMZBho8ZT96yunjSp{AyAf;y_1;G^|+Ux`#3f>Hj zT8vU~Y}6{QyiTtjt*9V~UdI1`d>#eRIbLBcjjTv{3&R_8%iRJQrXI7n>ZbaDd^=X= z<gaL20s8S!0W*EDl(E>1Tcd81X|OZ_*4&yD%LE<2SPBuaXE7%sRN(~>E;*CHfS zL@_N+jixVE`z$^e7W7(zcpWV+6i)K4WMEKR zW31R9&*J_BMI5;f8%|W3IZ!UhxuBt8-)#U{X6nN)#QtNJ84GF1^?^bPGx0@*Y}9If zZ=Z33IL?DxjFMg36wic%rvx>~JQ(_Xcn~1z)Ng=9*?CJZrHtAtJ02NIgo1#gS$XIr zqtn`J9oVLIWPkPNsoT7)s7rE=ozDK|>U1Tg`?hGZneQ-ej`bO%2o&(5jvIztu?;^Q z9hL6fJvQC2|B*DkkB{js9m|J56in+46;$k(&CDLA%oa|DKVP&(2lPipv42#fBpdQH zq01{&qc6{X_3CZGl^4a0rIJypM-*;vuVZeHd|S1B*p;dYKJS^_l*-OeTmj9+?8tNZ z;FR@zz8)*O0jR>M6MdLsqCXLQIOujlKF@|TF0OrF5P`p~wf<|X@V}9Em^qmLVEm5`rCq=r*tSUHVJk;*Wk z$}pKEIL-TMJtM5zNY0IHgP08x!{CBGo=4xIp_w^R6)wWSMz7nWhH&GvMo=#8(zYe7 zqdT0x4_0kXwy~zg=AnRRCZp-~o;zZ-y$Eda00#N27>gi-E*Pm}!_8}gW`cm~;|>QG zfaFhXwurE=R5J3M{`C^18g*!&mrnMF(KgTd{{IwVWbe38_<6hu#3X-|H4Dwn6Ife38-x4UAxR-U4Sr=k#4dS9XU9s~e)x|8m zKN1w+z6V|9p+mG~F0d>bc5R%PiGag_p0GX_H5hX3$%_v$OS5ft6D`DK^zr0Pa7yu@ zM@Pbns%}Zfihm=(<}$e=I|PYwjCQW8flo_PYu%o^U6dWm#Ch5>yt~uOcGMG=Pb96* zR3Oiv;|t9H$_P03cbLo9`z|y?3AF~~VS=DvWBU>D2;iiZ>;yQ=dj^3yEJX__w1lDF zH$@OO8|jtePmYbs*7^Tf|kUBgobfss39Bl-LYAff!8}QF?kW;Y!jZ$PC5tSrRvgg-0b|<1}~jq~&qtuN_`x{Z~$f zfti{`MDEdWoR%}wV?aOQQQ3jbXW=>_h1phIE+~SFj%yPPM@0<8XFU}3X2yTvgbLS% zM#`kHN|cHuCdLF2Uinzu54UGw%X499>Rrj}8>&CoJlu7UBW-StG7%k?H6=Ueb?tCS zZ@I}An_9hb$bWus(lXwj`wJ+Nom$(FO438xI`R_w(#4Lg$Qz|UyO!??ary3O_Dvg<=gGwwG1weON8!qHe=0Lq^n@}n_I=4Wlv`1+wWu<+XjOgk(;o2v^*UP15K^YpMN^XH}yB(pkQO`7s=v_RC;2W10By&ocl$A-wIpxs?tUPrWxvWaZm zt3xR!1Z0i}ndU|nfNXefIVeoizf+=!Yr*-UQdaV=En3q{O%|N|5c)G!RLNlv#H}=z zAHEA@9>t;$7q3!)v8_jy)4aQ zIVA!aE$k0pLIMx}&OScIpF`q_ZU+^w7bT}9LJT1awp%Otm8dIh;t66JSJ0@>X3akV zp9KvtgMN-iDKOpcX9B{;Fx~-s@G=V!LXaEnWZ4ZM9{yTv?!n^rw{!NSXaPPRIAzg} zO0R~^2Fj#f?mTo`AfEnx$p+<`i8MP$HggRzP`J zT~$wYTI`wx#o$FeKd8?a&-!`Rm1B0f=8p*Dn4MUDMn_m7vH@V<+^ON+kzBd+>-=c= zCw(L#sCW77w1K1NqxPp!s_5KG8+^9)VT(MT^x0mpm{hMBztYd{{S9UAoMw z`S|;6x#mU1S?0&dlP=0MtsvF9)HE#!=2bVT^&V|TKP)juD};sG)y32i$$lMagYTGD znZ$OshTpQDe?Im+=GO;)Wu|yhh^`6@@vNiJAd*({DpwX?@x>3wuoo#!9jP9p zr%f%Cpg`>f{Gk>_Gh~hE;8|Ml2GbKRc1Q{jAE;+3J_;39#oz&z-(I0vslmjRaa(^R zzGNyuF@RA3HWYEw2Zzs<@Vj>dlL}Lfw^b#(3jFg!%o*^>je`LhL=JXh%jgElD--Ks z-)s6M^xJnwP~8ewVi_q_BR2^#fxnILj`U+DxTvbxhL!F2Fcon{MsH5Nx+Z@RZ!z`( zyj*A8zZh@L3?+S}8$=v@(*_lW_V?o8=Uzrs3A}()u6q`VL1MMby5{zDBgF37Agu&H z@xef9fhIZHv2@r6)SKb-B|qyb&2*gE_xmLr?e40K=9RSauyEtB+ll+%q=g#CpE&ws z6$M?^kzXrI!6ubjMej@l!eC1pDCe`-AOTRy%mRfl(({H;vfO{$p-dy@STl@MQI@xP z5ZjH4kbzzBx2D|SvlSVe%P-hV0~P)hiNuMh%~IU~LEZ{{03_CFB^61y28jHt=EUj9 z5`Wh?Cg2TaQE_1u4ZswKfSBf7y6(hk>y%v?fO*X_lz`q z;PaF9lVE&+E$}=5`0VK$;J9Z)>2bDs=;dzsG^JC-Y1p8*P5^_H@jUJPFrM2I2P#L3 zPJGWAxp-pr&~m6@47Y6Z`w@C7s2`Bn#e`s$?nNYL?2J4_9QTu|J95`{o}!F35< zrcIX7QPP`I3y+dTy+c=SJhf;SGm-?! zYr(}yg;rw)L=VO#Y5}i*vpn{K80AvA<)}o0->O=%+jt8Jx^oXmdRjr9*9e7}M+@0> zXzt0>ln%H4D#*&i>KJKh;G5!u$n^cl8C(O*lXHVSC&~IloD#t2{Abf@

    8;h;iq zxpw{R)+Hax86)cwjRypv5anG_VCMgcUKk@F%*%n)%Tg*zeaPKeyJ?3G^_lIrJMd5l ziue!ZM6s5vgN?|V;AH<8`*(N5+8lpUx4hVyiVU~#)5+~84hsdLb0h=7?3W3q9|;6R z;$Wl5F$+~AR(8+|qxoutUbfHKHTkNQt6?F=na*p+xp|H8DH1CKOX8f5@Q9#PN;pI^ zr9>ncdJj!>lv)L6h~UiYtex&QlU=HdEuu=AP5N}~P(l)6$R8q32dB<{=i`RN>g+=7 z3h)-D0?LT30}251((~oZZLGl)(=lcwZ%@bU|K7`KQtdjqsOpSkfp>`H+uju*(L+7n2ocLXqiwTFDGy zW##yq|C^6sr*C+?r1H!ZT_Ds}xnPN<8fsR!8mG3c5O?%kZhV4b$@Zo8-n+aS@3)Ik z?x8{Nl8QsLY@$80a|S_^r<^3GkJrd9dos7>8zuk=7nvI3%J(ttr+#)i0rrI<)sx|p zs)PO<5B2gbjkwCN6#_O=XjzasO1PD*_Je1)aiLPvv)RdtRz$F`%PTas=ixUnty7(a zHA5Rb+mIj?Ns}#g9^vN9Dc!c+v(K2FhAf)!!Bpmi+gtecZyJBpmghK(jp^vfVsNle z_b_3XOft7(G?p0ONW=j4dYol*@Diz#@S*Y zX8nY=%Qw7RjnCWYNXx2;Zv^rpSX z5|FMIJs{hqJYVj^`hinpoBj%E;?0>34fj5_%+$-P6<9Lc2INnKt1%<-$USrix&B^|8X zutNn!uW`_Cglr$OVsOENkC->% zW_N>3ILj~Jjuf=HgIWt5!b$!~YP|zG|8=Bktoi6V%|Bk}3uhYetb#o7%_LX>%lU41 zab-Ou>o8-qQ^ZLJ*BmY&^11qmdJHg}3MKMscf~=|3`!!i{fn zK8Uq?2HUj!rlHE><9~s(6{F2JW>*ZAU$IDu`p!gH)H=wOkeVgdDQTN|iHVYPV(RLh zs_Q1aD_vo2_4Uj5iNTx$Q}(|$E&m%AiIed^M0cB-|G(YGRZDGufJh_UsoaJ94X?VgBOT3-D(hLVEM#QNtKiO_wQ1#egRKQ zgP+uh>MwzA`($8RT0eL}4LW3H*!2r-rbmf)AD<>6szc6p15JiwDC_Rd7`j?(n|H3A2hhf?pud`{4 zX>ng!porUZ8@?S5F)I^Ei-F4Cjg9QX`FO0af>bt}FYbn677s!m_Ee^W!AGaA z_3*>5X)kT+%hBa@9bZDHA5P)y0iR^TO;vtY|2&G zXJG)kWZ!0Ydqp=Q5b3^r1xiTstAvm3E$>7?GC~Qy0~4RIGXxNtnGnwz`ccY;$;;1| zPKDFKy{io9iVh6%W<$GzBFR_3bF?=y+90`RZwKr!Pj$I*C}~0gChG-~@hRaUf;07m zRR^8-=JAaDh@AmUF>y5+JdIlt0%tnH{4O3fK-O>7BNNlzoKre>@S;Y|I>3>!`+la%QJdH!lRZo)f1Pg{IQVLyuYW!CJ#EVSx`n_{ZzvvN06 z+h~2%Dz;2d*-PLmw!0U2DaurTUtx-e!OTitAdRX^SEIh*GWX7YRs&2#00EH2!-_0K zw)65M)-csLin8CHX9ZLE;ZzieI|w{;CtrBC0983z@vQRz8we6I>QG%;a8)O{X-e{} z{ljbw?x|dlO=pJ58*kiJ9g)_Qc#Lx>2bGnTk1x=ThHy!@GnukoJ-+X+jrNSQ83~bEpmCcN=8neYdZl!c2cq%%{uu*941XCxA4rO*ed18ftQc7#N(E@mtlmElmKlX+itzW!wZQHhOyIr+y z+qP}nw(V8hwz+Dzr~l_kPR>sDi=EuxVCK%a<~7Io4Wq!-Ri?7bZtMQTXW7DGLYuF+ z3=z<-cbHEW+>i6H&MYdd{Fx+f(xBb0s2oo=72iu+KA*J}AM8sYX%hBPX575#9BFv7 zzTJexy;Z_5Pz#Fr*#jGy{TpB+;WI=M=t-QtJwD)T2(H5L2KKs~B@F#-->b}U3KUJ@ zZO5(LK4aT&!&v$d-G3oDeAeiR_lDhKQ<{cm)4R;|jQg&;{iRotDc2HZA3Bge4!5Lz z-fTn7djhxwhSJxvf&B{H+z<jdSaw`3?Mw-x7M=xk8owb6*1CHBGF_ z=5gEP@rfE~A7xzm;Ow4j&?A^KktU9A)$V|XJgO~?Uo04j1SCYSs%y8m_thXlUh1$= zH!I4o_dBiQwRhb%OH-%mwXAY8ql-RMROsH_Wi9n7FxaU`@7Hv+u3KE$@ zY=%Zv&pdx2$Br9;G(%VU-d!I$5`i_G$;)R4>R4E3u|go|1jTYSGOW~uxhQxvs^7R3P9-Q%F~8~&E-5vQc0viSkoM; z*~~M;1n9T|xx0_{SQ7&nKXrJtbY@cVgS2Eq{@YwKSB5*OBgwsYEG6Xu zCGMJH#8#E@g8^Vg+1&<8BK%W&GqnH6+gPz>$WE~!EWrfEz7m-VBiCv%l7jC@u?3ih za;dWu z$B320?{jr(&Ta$$0_V8Oaim(S64`tRF7C|&3mQF>ja6mZ5S|65WE1Z-c?%6mmus0kBL^R?D`JRFpaJhd z;f@UG;SML(q!??1u9k#GX+|rr$rxz(AUcY?^YE?XiAuQF$g?Q*b}f_eC%muy*7MJt zWT{riaOnGA$Uc_aT(hfGk>X!~*_upwJYn95qdEF<&K<}K zZ0yT1Z&z^CDXF%zV5e7eZh(HZy8&_wF_=Te{IXs=%Z9q+%mvEby>kOI4)lRn&Vgy zK)iG?Z`uA!P8=ydqCN&JqvUOgVFt31A~!Qy>cR>pkxnRMtUj+nbKcnSMOaYf=dx#j#( z*OxW-lPz!40Hl3!3ll?t{Zd-lyny;`0zhj9+_GVq@AOBA zau4p&L`i6|g2Cc+FQ6`@eyW#-OJ| zBGL1`FoG>O0}%p_uo|;bYclRHNg1_ICakS<73s3x6tLy%H4dV4Fl2`mkEMw}?lszCGJ(=f>aXJg{X1zi<0svftm{@li_eN=dKuB#ER<|woIDXy0m0faGQv-RVd_A+;`j*J&|&JcL_JFgN}tLf3^!8FeRpSQRF(Ns#&KW)G`*_dA;=!=oioxFq^}S-82x|m4J)rWha#s-I_eE2E*Tq6Z zHIOb^2S#O;V%9rc_j2+@y3S$e@dW3|matR+9~Dghxy=bS;+=wZl|S`(93X^$?hr5 zuTu5wOpsv%TZ-M16bei=WRpT(*!``4a%$c)Y5#95* zaY(jl>)bc9a#3ZiE$(HpN)a9_Du&ahxBMC0C)IPyFzMgf-9am-^;O1e3g1JkQ>TvB z4bF|t@lh(KkRa4MmR}N?FQ;c@L+25}yOKX?15j+iT zGE>wah48CW{uF!xE-QpFxf898E;6!BZw9INhtoA9CFVev3ryJ*`iX_~*G-w#$C2s5 zk)9{G4MYRmM7Q$Q5-h!y;|=ndir>DKfXZ%i0SXt-Zi_hP#x~2wamj9KTd6#K7pN3& z1i|FT3VAq{l`(sMNgVNdF7^XCNGm!w&6)QaQ1rqWv!H_KGWHw!b$+?cq=CRS1kWAb za!9+@W7U!<>LglgF3n8LX5M8jx}A*xuW&tSrGJyNCje!iK#d4}|E`+us^EOKtiNM2 zxY%_{Fjzht2>gh!vs1rp&VrI99}6b`*&i@3x>tPG(=MI=cpaCSY-TV?9q7SjHDZ6= zvZxHLw!-v*z%*-LcQy4=kLQp1<{k-%jWW^G7v=rj`Kg{d{`;@v&Hske;$ZoYjKW{_ zKmSK6>3vayxFJ+Vux-E9*qt~C+gDrv~P0%%B8UnbS}I*FzxBL44_<)rnS9?pWl?} zw36wGrYu1;U7bv4MC+-U7-5-=W9O&GIFXPCw5(~DU*h%o!qcLKq-fzf)TJ`TqMXXU zqF1rXyu6h4H56_PZwSVhCwFgR%t63~MhwI-*dAETuZo$hgsnKlF%ab%*U>CjSTwP9>w<#?n#97sS2fk7k?$Hf#pi`BT3rlF;5LOwPU7)_M>7-+GmJefX55f$}R zeT;O+*V>e7D1@kFX?P(=dxkdrHKyxkub{BZ^0%y}A8KB-WBiNpn(SJ~ zrbn-5GAv$}rXPctmb=BI0Twp~au7r=j!vqsx6(pXEP{($`N*+oGMVu#+w<2(2XAQT7_tPIu#_S_6=&Y5P1 zvhid(GMEF4+jFe=44>QS#^i48f2wmYG{PsDgT@Kyp#D|pC6(>muBiJ zn`44IQ>Q+6CgYgKgUM|EHGZ~AGK9-+WVBKDEBxK`8!>*`DI>e-VN+MuO~5olM&hFN zN02EH&|e~dA(O{+$+oYxwbGkyKP5#mE2(4?P<+CsRFNMOlzj%gRsrDi8@TE76}DNQ z(sVSJ>b$2F$l{HyHJgQ{$}qwcaP)^r8H^#tGtYptLA#um9#1=yV74)V7)3Pvek0e_ zFoqa=Y^Xk2+vuCLAOiCgRX465E3fc2826~+BG0C#e_{*DO}R8K@yK-Y$+^}Mix&*I zrqad*$+S`8sfpH=ME40o@epDycf_Hrjd80rt)f==9S*_ygcpl-ibElpSp7*T6kaPd z?c0(_MxrU8r$>*$#wzujn?JZXR0^O${?39p!^U?ownzr4jFHHrJFX`KhtZW^$ zR?|!&l$_rGCRCP`>h&+LygMO@l=&k7`_GJbbA_du^C|b#wAv?kGN`|lft#@X^QL?o z?iMa9pV=+WK^Ll9N)WKzh8xM3iAM|mz!9HgVAP)-`t(&~>Msfg;h1l|l^RLshGDk* zASI461O+y$0%w6n8TzXOp4osh3eSxqfdS=Pt6rzFMBo|arKd}w`MCEjv0SJhjLx}V zt=E-}=NJ9>5Re&ei5XEkumEAeK$WB9MH#5d{(*!*2To)RPdV{*ypMRmx{P?RyV(4~ zjaG~-YQ4MZG%QLK@6&2qy!IV_d+T0(NXaH(or>>U(3eBNC`FEiEJ;MIC^}|5X3A88 zqm|^~mU?S$bO16bcnX%s8I8b6@Rc5KV{y+Uo5CzyWcf1Btfu2}>VRt*l?2tqaOXKJ z5*ue|;Z<~-l)`dcU4SYXiGg9|3xdWu9D0R0+%wEIzi@?I7Wu;`I6uxz#TH-f4@ibSlPB<^vPj%B38G4TEY}zTX!@F( z@zXi{p=WQ-L+bvbfM#8%j+oGDjf~C61p{s^_tcQi3lgs!DE+B>Oh7q;yr#QY*joaMlZjjgp9o{>ai)WC$F*FeA-Mzn(u6I<2X%_1Acv<_5hnZ>T9O6 zUfYYx%TpBUl+MrTl;nuZMjkT8j(_SNF^maY&h{w%(AGyw5XPqqSz$uSzsnib16&be zZtz9J0)Y16Vv@l52C>o90vJR`=i~Y|H{TqNYnNC*{C_yrbDH4hli8O%XI#*oGiKVW z7)vq?#=UevwPolZxw&q5^<$-byIiw*r##j(HzlVWw=ov0J68V~>%t6g^)O-o^0|(m zKZ+lj{@Amo`-w<{+RMIM)A!84^#zNmUo6^olCq_#^yoZklOs9F8oxt`f+`2 z2hazt@1`wl-(SOk0=Y)SIc9rTHBR!j!9@M==P!6X&k7uC8T0AyNuS8Ma!0h&2G28m zO=I-U_W(+Ut@^L}`#+Mx*#DCh_Wx!C5$@;41%~gb5`8XL zT+bL#))KEvZh|bCBjmLlO)xF|zg}?@3+d=g%GS9!!YvZH(r&j>yk#W<_l1!p_uG`yOGUde*l3{XNyXbdydUTAV8=A{k zeD5Z^_`eQLJ-ceCyH3vSj(tzv^p>NdE1g}|GA#v7Hn=KhcM&FGfbAx^ptYH56Nt9% zh;S5!mxz!#W!yy9ttWWrl8JnNObawT%T;YO)bP0it*fDBnTQl-(u+{=p3(ol5}8RT zu3Nl}^QglKm0lLoc3vV!w~J`T-@G?@nt@WVF%AY25Ix+O0&WEzyuG3who2G&CVS+h zMPbki2>s(3f455Mm>pp$(?=4G2dczGr6BKM*LJ$3>6h5xLh&#Y^naj_GHu{Y|B6Cq zd$XA*EPk5#W{(N;E}mJ9U%U}SAI$oSsb#7$Mf-BWzzwcd%F5===wrCg*QZJ^oGrtwe)cX%fJu7WjGlkjZ`w#T^G#HL4SxY)VzGVSX^5dip`@Ws(e%63Q=sO`Ii_S)&N8kxV?p>v?dv>V&DUU z;n-Zq>G=0+th=gjiiGQQ)W_b8dF`fj5?B5cP%hgX6q^nDQMlp)6Fp>~nBboSLqZ6N zKeqW4{X)coC^UQcg$=!l5tIPq#Zogc`$tjd6AZ{~Z)r(Jjaa~0#2&6w9~tG(;wI(B3!;mb?R4S1O9^_sA0j0tHdrOJzOb?w*+Om( z*PWSLLF%)WcEx<6L!bVcdzh1+3D>2&A`jIRV?l~n7;Utf+~nS62$E&_I)lYhvc9)p z6))|f>PFW`fJ@FA6B8GglfP)73aFTkp!dAv#`F*w*^xk;&ZYZqt_8QlTz*>Bi@dgF zzDPXXqE>!3>14k)s|(4ajoq?{pF=uAxJ&YPD1&44b4K|`BI~_? z^_e2)+*fa|E$z*er|J>dyyD7+xVUay$X1eHnz&a_xPKJnXZT&Z?@-3xFS$k3%fHw+NwDV!e zZdvKmi`Qe087H@)KA18}B%862U^ph_W88McESLk%Tqb_0KmlDxpiUZNe_O&^r4?N5 z=sC_}tM2Av$kgVN@OH83!vLDc+5ASLeZjWx<+#Sk*bXISms!T>GH*MQy&DC2EY=76 zYcFhG-3}xNV!mM0Mu%BH%b$le;}mILoPp$_7dWcT5ksn~tYsyMTlIQuZL5yqT{fT)}=k(O9)Ngia4tsiDLsW-BL~K2? z#xITGr&NeAVCc&%?>D?3W?oD&+<_-Fvlzm-9Z8?8Wg;vsy{Cqe9xuW6^&V1)VWOne zGA#@PL9xOx8g*_(9Vd<^hauFy#UCqW^iwmL@A--c*EG<({KEMqn=d6|Nyu{sK3{pe#|wo?pAB8> z%>k*=d|vOg`<&8wjY)?7#Th3K`eobPH1*Xsy5*URF;F>3HZIGEDT`rHbxf#k*1i3v z(D~178;qlmgY{@rvmZW%Hy=CoytTe~4@L3=Q3+OP=#%Srdp|^?QDB5(rcBgZjz|@Q zH(PGIHivp_(V~xp;jtxh)uvZ?!awt(5|5W}@;|Dm>E)#b53D6gB#c!RdC$E1sJNg= zCGG*PUn(Uf3qc1BB)z`qdk{!=VI(b(3}!wRlM`D|NO_?9$>NdVv|6e@nmM9TXlKFI zo_wqZmY3z*V9zASyk*;eW#gMj6$pyN9uGWqBjsb}O5dfvhW(@n%UO!AEIiE;ByYo? z!k*|n&Duq8mu-2@mC_=xPzZE-r$3X_L^L;93X_J^;Jjd6U1y2_WuTT_)^PJISvnMv z7|_B*MW2_sLW3@0Q1G9<8mz2yS(xzZ;|Y9*n689KlzyVtws{v~`>37l?!QH$<5lPY zC#zFev%b2-G9{=61z3v@$3etW(WB@f*)HhzK$^3tlj2t%B_@)L%*+Ln*k+M{V#U++ zM8bge;Z(7s`g|roO?l7_srBEr_@DIVJU|&`W5uQ+^M!R}fn*0NU8ahNc_$f7A~Ib@ zO1k*u`wYo6nJgA+YIzT_mpLHq(`d_CDA>J zu0fnp_e>7pL5k6vVYig0V7H^DHbNa8{*TsACd?|(yxP_K4_YnR6W4n0MNmXo+qaJY zNSUFO(r(aqmS>tW2u4~j4s$aFqN;-onBI9}WJzdAc7?hYUI6&?7@-j#uW2$DNs@5` zxFv}wNBz$EI+O?kWnRe;H!m`EG6+GFa&Z5Q355(j7O2Fe`Nkh>q$WWq9!bI4Aj1fZ zdZDI!yUtzbryY)Ei8uGid(Qhc4K5Hu2v-Tr{NQNWQDo9#Ns!=0`g91b74~sytVyj# zMUBQxMMN6h2X`6|Iyv-s4e_YXDG)6RgBnZxmGpnMEV|mkP{U$}JqO8&V5h#FRv*oy z0BE(P2d(j_?vf99?q+uW01xaXV+DumQwx!e0#dk`%yWlKKh`*^s2+!o+~$oU*%`0K zs&=LperxHU_G!`lv5^VLdALD@_qH3tO)~Gmc@sHKHgoy%j_#J^^cs(eHRvaK;>yD|xXnl-!jx1Ild6Y<5L_j- zb0?`|@qD20hDhUw?w#@~ zS1khpo>u1hyzz^3q?%F+Ya746=#CSk-N>sRUKRpOs+yYGpO=^0ep;TOZo|VPQUt7rG5Rz6kYgtvNt% zvr3UdZqv_P9ZV(Rb+@mRWw%YL370p&N~W`_PHXOe>$Q@Z;t`U!{sNhuT`#vmD<$WvWU&q1d*fK; zH*4H`Vati)Rc~9)@xsx3>CnZG_EqTxt?HJ93&Q|z}WlUV{&k-t+ z(?vocpcKB9Iy^-WYVo~6eC7ZhSqz92@c~A6 zYyMjeUTS=wz-+X@GQOqOWyx5dFO%9F-dS6++h5>ug0V@7a)9d5cP?<{Algr3-aYn)A$=~`e3?-$AJz8-_r4ILNyuMP*Q`sm>AM*-`8_v^(@njmc+$kKy4C66!)D#f zpEQ{lP=EW35gMleD2UcCN+`@3DEo{*08|JHY-f`fmYl25Q=OgThOMAt$_aIXJ^;*u zfsd|b7CjIeV9i1jFLMxf*p1^P2Y8pxNUrQrtn!BiNa0gm(hN`9|J zOV1~QyOd%`FB&`BQ(Rd+ldZGQ@jeo&h0D z2S)&}+o?9i4G)H461A^E?xv@Jga!IHlfdw(o(zqc(1huv>9pGB ze=_Cs>BpF0RwG4#NBj~vN@;Qby0(0EHEL`ASV+1yJ&!}Kuo5a1E>3!{r{?{cEUn2isQb<9M1n3oQw)M(@$hmqg_ zrV`NU>NDma8riG!&IXz;Sa+H(jdKW!MOOo5KEGtn+KFwRk=~V!4#E3#;f}JJStp6| zZ)*<7;NvSTu;pD?BpSAXBcccX7)J(B-tm_%t4W&$mCp1?RcZ69(Ob>4N@)dgB?Xc6 z_0_DwsR$kTjEP8sb43g4yk(_Ljr_Z5e{#H*1#g2lB~*J?Ki;D~HP?H}tnUZ@C}am3-|kE9(6*rpN~F>=+gOL7F3oIHiO#;dH39UjTP+l<1esS!-2gwjE$)^!Lz3y70G7?YO&;(BH&)8Kj|23WmhvtL9hooL2 z29Hp=!xe_Np}$>b@AvhxRa;;$$xRr7X1uCna-kBfF#2IQroVwS)R2h-6A3;O%tR)0 zD{#RRLaY5NFUK=7iXceV3<1^H_})%#Uq74<;O9X}46vH7H-I^gCoPBGt#Fc;QjL}O zz@md1jR`@lkNAFO#D3|GsS(MsBLZi3wl)&k{>)V%SGJk!yaL(92OlD2yf5PlMP5)q z&`Q>rpCXWT`@bHtS^=z(0vv8lccoO(O+<_uRTVuPgk8V8b`y!G`sL|xd3+fodvYuS2XQO_R{VRU(*WLBQO_e zOD!=tQR1>^lVQW*@FB5RINyh##nlW&dHV(BX2=BA1Z|)W$;D;4w=<^?NXDKIe9D9` zWbjdAkD6$9U+yQ`*1NO+9)=C&nkwazMZrdcZJk;Kc% zBCMeGjG$L6PGIk;K!t{o>Uc9M(c(d&-!Kd3m!S9RHt~X|E(HEP6M2|-YIvA}l5I^@ zMuBPIMB=Ul=<1%J);(1dT~~|2PRxXHb3_Fg3vdv*QX=)9^%2}3ellBa*ckI$%^XNq zy270@lp`=$R(|=XPh5Vx?t+Fq=6_oLc4e9H^UeoxaEk}i!aU>1_9LN_$*oDv=MVF+p*Fs+!q+dTI4Jn9&ZOHq`2)8~Qh&mcK|8vcQ z>%n_PXE%S8?Js1WLK7a#S4+CzB-*ktXH=#(Aa?P1#|{*=cNt?}MlMMpP^-bS3%BP5 zj$$T!hK0R_Ps&J>dvB>>!^O6S3`XVUSUU*+@Nn}s1i_lWtos-S&KciVLg88(j3XvW zaslchiOsEca$6(-?sb-wkP5>eHgx-6x9@^b!~ z0Z*;29m*9FQtVEfc#$!2spFrzGfNw<+x>zC#+@JiuLA!+A@rD-8UIt@HUA`SvLW^U zR{hc{r-bam&hf1ycTs6o3`>@}!mGmJL|{4mK{83aU;E+P29QX=vKM2H$k}L|Bp^h1 zor|l(h9$>GPL+QhLK@nqmr3n9ns&MW;?8A|V#;hd^2}k#Vi07qNV;4Od$df#-zdzT z4nd$yqBnD*H1SmVZP&~Aa`?IxVG?bgW1xjwU1{IxC{8|$9ugL#NxB)uUuBRfU2s)e z0_D44xy5s3u3bEArG?)doc{O4%_{WkkJAvMFtM!_=2fDpfqS)6XfqLbc;ujpe?Sf zR|eCU18UM}tNF8llU5!tW9{ceNLp=~$hiiobjK?u0P!c8?W6}J9HdE}$Q$AD94-1%Nt381GZSBWSUX=@(i;3u)EQaC z3K^_A(gm&-A*BFJ)OC)#VM)}h`sHurFpTkxfsN59lWplW2<@<(UX9TMX z!5yP{(rl~P{F&;HovD*MV2_l{Je1mZMU8hByUei|&15%hk>l=FR2K!KxnT6Uh}!mN zoxn29;R157snK8JQtw+e3cfTMtsA?qti_5&Gxw*Uc|Akf0a#F+0rEBA*2WM~!#x&a zsPgfkO_a?PwVN1pU1P~d@=cr1`sp;=97q?5{HK}Et!|Y)=j3h#CY_a#B#!6ffo*|< zo3yUxlH2`IAKur9*3j7+TIExfjuh!UCc1j7*#NL0h115*gU*?~67 zASRtajhPb~STEbyu%XtgXPrcs00FyLn=#o9GAi97f(_?rR*Sp*6I~@8 z0eU;YU1uI}LzU-7cUi(~gg8Widr}`7zhXsL1*$AOe^8p&#ae3x(AwE?^o>H1*f{e0 zeh8mRC$+TeWcB15)ogwARK!a9cstX#4v3{<2s~Gi$8lT9Ij;ttB3ASBAxdj+HO`9a zi6``31%s&v$0T@sLg9!A7bL^v2 z!GGpT-SXS=9&kzUrYF<(kr_36xo-gsew*ZU@@IXrr%}_+&8(H*w~2J7(3%(m@NyOi zKu@^{wO=vT;*iXAOF?NC;XmF+^LUy}MnqEz6ll7eVgYb2F8U83n84zmi9onQ{R2Go zJv|XYeyk59Fhqln|KS*;%%X*KOQYN)DX{PcBjdQh$NB*`X7-N|=yfV{ z2=jiOKFQJK2mOmTd4|!syR+*r_0Qa^_r=fhkay?@6SYR(lQkt6vn!tnX#RF+!qdmp zXdS)h>_h=(W0Y%65Pkn{)7xS0W7KBzW>1T+8)(FlrcVyj?YS@F(tPBu3*1j$YomU) z8H=vJRnkohS`|)1bB9ue`^OswDb`U-^|MR_f=GVP)68C=6Y7e(LDYOnxp0gUMJl&C zM&xtt&~rzv{dNMr+x;}%CF`CojAl6dde+>A9lmK`H@Qs3GZb1Tz&r<3dXtv^i1C=B zXAeY{w9+vFVXAYrVn+39i#cjSIi{$4^zlx#TQ-Qf-A{rbEFHrz*l4EyVbxc}?hqg$ zN`t+5^lM#>0hmIy#)ZbTw=|L){+EB94QUrUD#T@aqvz|z2iX4xpp=W4U6E2F{{5sH zdgd{{p=YwVGmI~&Pq*FU!xxPI4nKlf!6Z@$p)GU~CDVtle#gM%(_>S~M~z!hP!#Np zT;q&P*VQ!Z&_`A8-3UK=+_YXCI;8A}5R+OApq-}S=a29v&hd`(tLkh;f&LVo%YA&^ z`^JFlQRPUa1OE}=Gp=ScNf$jVd>Jfsv zav%X8z8z13?>7g8=3PPp;BQS;`;#Z-ub5bR zCfc-qK>F^QE8Wyz=QF5zp@tS->=EG6KK;uvRgc@hqe=(A;j}O>2}g#3K9}zik$<#X zf;s{6O!ut(st7}#M5Pk;LrSb}>l+hh+g(=m8T1qIuxX@5pd6==2Cj)wIWdMs%&6Sm zhcq_pw@2e%OJ(;}o6Q!GE1!dMluN)PtA3_t?46k?d!OkN1mH=a82L zH~hlwv_U@{L!x2^8k&XQ8T4<^p)P+H7?E7By`MTNH@lJ1Wt|VL7A8N#S1$N~~}f_51m13@kh z4jZb6WbbccA6EUoAg$SQjsM$7#qqzu~3->sbtDZidv>Pjj!)Ek#DB(ohY(*Bm45p{*x=5rzyY+<2&29(BTjCx`5Pr4< zP@hKQI=Nq`)Q(O(h#AGKW487+QZ~xw5X5A2$V2!kvWF*>Y`TWbZy%?G$gEYQPZ`_TC?j_SF{BgNTE)`J&lDzIrw!_ zdj&75$M%$Q_m_v(OWeYagV#BCRqL`mpv{b2tl@l8MnPrPcJ?r`skwZjrpqVFOo#y_ z`OzBV;{sHNDj4*kbJ(fWr`zS`-FR(5#pG&M-LpZFg;hKK=e+Lkcfo>LE?ABSf^fD( zK0$n8?4XRMMSKo2*d%s%TVqoj&llW{+R12cFr#6%46IL5>XYf|^G>l_=gZ|eV%CZL z$70idxiwkg_RY`3jnGsev9R(S2;v20?XNR35CpVf#O55{@9TImg*YlKtzNJdW~Xsu zB>!65Kma#1_{Dh&K`^>MDzLa_CyOJ2r{}w3t$F$s!-hB#vY^|pAHI=oZOJMjuCzdk+HzkZglHprX7niE z&^`gmG&{}$EEylx6`vgp59`R4vZ*X?dlhGQ?>Cl5XOYbBg%rcc7h{2B7&oUV;>>N zd^*CzBB~B)-`M0xlzYw6;7y8PdxVQ4Z>kTkvMq`v1Tm)3y2@u#x?0LJNlDI0ykphX zp15@?tcE?!0{ajk60jT;!JS8~9WekP08%sC9#tGfI#a=S12ZT{OYbVyImdM`$! zf3mBv=woD{@y^F{!NG(aK_3~3*T5;RcO!U-im{S3 zs=kD^-WYBPx#@QgTyLVPl%dNa1M{tk0Z5H>I;g@;(f30186ADdJb^8}~Rs_Q&S zOEZ>P!2r=2q2W$r-h-VH>G%QVlT`lb$X11#_1Em5+!5^ z)}l>#Py{pghU|a3^mo!0K}`3AHNt4Nwl3!&=La-hbWzxv_-_aHOpF&* zOcY{Lfl~&yaTo)^Y41VgQSfTTH_@nxUf&2>Z4ArTwBe-{Kpq9k4i#IpZM+b-1${#{ zC*rCjcUFiCi>iG)fb;f`NLc9ATQWQV+lib|p1rjnJqLl~uc?X|hU!DfsGaVI(;HEERS zC=X&~V6hb46mLMkzryg%BDxq<2Yigx9zg-#ApkbCZoO0DIACHh8%6fmNS7apGQr%# zIS$}lwNwP-GseA~%dC%jSydLopEIbY{fR( zrGqiQ%5=rg^l_JO*AQ`HK!R%IKqBOvkdzN+L%fBHsQ*ie<;vFeY9X;8AL$yVHKc?d z;s%g6;7FeB(%Bh}4FURHZFJ4h4CR4$wj<6dY)r8k*Kpz9&v3mwL7^x-gi@}P$6uT8 zkWPuw4Rx@*B!^sQ>CMy$^X}As(sZ>efZX}veIi)f9yJkR5!+ZGri+s78 z=!9$4<};?lYtXfzfB7u41}zzCTIB_lJo!G$3?hjMZE_c`+|C|6GR&@P z;B=A$hx|Y|_EmK339rI67fbI>(BoM0eDW*mOvzNRIP_pv>8l_G zeg5QEU3gQuf588Sy-hAb_^)Hn|3=9A9AAjVK6DVvgy#mTAkNmynkj;s$6)f=>SW-Tv2yd^J|aeval^Qh9L2~C(P?WscBs^%2ibbX&Cx$* z(y@CWK>O25HQcy`TXl0dDj*+|Q5?m}ETF(4)zx{qN^_N^9ZEeYZG6LT5{pu1@HSVA zqQwUOxw@^6Db6XbhNVb>_KWstv@(Kh0(xBnj{9^QF(QOGB)eNv^N=F2EP8Xnv8}50 zT}$&>JfWZzjIKAh^g+I&l2br5T3k8wU0j{!^O6%pK{YUPx|MvUwoRR-woQ|XZ3ozl zu1l6Jok9Ds4YfeSJjb8h$(vLCYS?x&v(=|a&<;Vzuk<;FqjG!dqsFoBdGD=70VPwY z;bzw}wX=XGqBB=gl!?x$bn3Bdq(aR^3E{0$G&P9ol&!&8ni#b_PMj`Br6JJx&}eZa zLJlieCGn7~iI!K@u2F-FEhCHk%baLvcAF2Iu#~Mt!~SXcSF;|;N4G&53CgR`@JFM^ zcv~6SSFo&)o!#bHB_B5su)NI=e}%}(QMy!MEv|8QwX2#ypy9K-&Rz$>QU$4EQGXfN z?aLEQj#Na{Bgg&J+@Hu}5GfHhC4?k8uy#O!wdhn_ z#tkq)H}Uyd0Q58VL%~Fj1U@m0RE8!Aw(Y5!bbdFy6Am2e%f_8JogTk`;>$i` zC~V8Nr=gDP>;_Pc7Ub9Qo$Z$co|pg3$()psWAYku8HHW+fs%mO!_&kl^RHS-!l(OC z$9K6>%YAEP*f&K;Q--p+Be8e@>nFWbTb`^;)Vu6lx!qo!!ZgFE{WLUso$tWfu3dfi z#@Th${I*rTmrJ)*ZHnC}F4^KmGzw`xS<}O=8t!|Si->wVnR~SwT17U4v^rZ zrVni+{A`?1UY;XlfOc8)08B{53Jfu4njzd1Yo1YKDz7rUvXOY=yM{|nK!>B{935(N z5)x<`ClsL^|3wiFFY%N%r%OfqJd$MW=x9ZVtBp50~D#+Ytx)fRY-RXXPm-BDs}q);t5r6Ddb2Yp3>qX#~N~ z8a|l)O0JrJfOYa@_nWppoXFfmVDz~T(Jax29oI_g2`TEvg`_JLvUn)lV>)004@bxb zn=(^oH5JD=-XPs`7%xFWiRlj(Ucz+YSUr(LP55pW2RvD5&lmZjF`P!)Q7j$|G-S3 z_%m&2-&~Y0`EUgf_B@JaryJ4BzT+XF)W!JGce4)HQ3_-6u(V`^M&mLyov#jJ;EEW>LGY9lK*Y={V`QW7{@5w)4ieZQHhO+qP}z z&)R?0uDzwT=}+VjLm zr(f{o!{9ni{8Pi~$7aKmw9TSEmC~!KU&j=!*E3(Kin^MEB5HeYCqs1yyQ6g2t;$6vh|v82Ebd*j`!|-SX(k8$JeWHYiHe;V!1O$E2(s_oH9AVm+9HN2mbe*A3Nf zzv{hCV4YY$a^IY2oL@O@O9Tl^ThHJXCrKE#r4kqcSW%f<3B=zB$*=j{lX^!S$W%@> zwbw0EPnpNMH-(0x*;}^r+141_=(-r_bqmLV%(mKP=oa8(2{EF)kwp#JYk$7lUIxE0 zi0tlmH+;kDl4^+a#=hDsl@*usyxL9u5M=C#-*oF#s0op4RDJsGJAl}BiK^8ZOw>z} z{Axk36_OsCIF#NmXJRmZSP}I!i-TBiVJS*Fst3LkAqFpmk34?l<3z`$LNkpee;5%z zzNurk;fu-pI0@ugCwGmw2kHr~AiTsvD*0F}kK(}@XhKH)aM2G8`SnuLe>sMU6?W0h zeLiuGLr)`RdcF3011J4^`;R+Ow*QVz%EDc_q|6@RqRW~BC*thj;%c2E)&{1~oKKcPst^A^L~`(4)iw%NGZ!rXmw&O2dqtNLrEf-!IIQP1QIE!OP1!0S0prg^GH zC4@fKQ0gbjTR&&Hl=`+ywCkHIyKvK|W2dQ3|5P+q{pf3Mt_k}5dq?o#^p{J@n04hA zB6AaQ7{}5{aI@+|XGU}4;V8ro{tTsn;aQ_v9|HL&jJik6-L2i0F+pEmEsfO+t?9cF zM>=A&)J}G^S(~bOpX0CuVmo2#eH((xD=grBb%men76{TwB@Ds=Tqh2`30HpTR+0H6H1^MydXG#xjgr*Wi9jyfRhP zbWGc6b+($#uh9PHCS~~@uO5kkYe!L!U*#zOj@^0x*G0s#b?;bUY-D#)PD z3TwvRA&`z2^$J##h+m}S+&Os5Mw8XklCunH(XtJXy?qlAhe?;|=l**x^j}chlr^C+eknsiI zUlv7H=}S5+>nWdVl0vJx>fa4Ic5v%LAUy(vL8xby&%1iXN=MG2EB%xO=QC5|Eg=u zi~)VW=Mmdjh`4oBw3#3x)!@^DSGM5j$@I=amBhsyRnn!UupK%)8~|7-WU<(nF3u%H zY1=xlxa%0tWMqo;1uHl4)zv#nYBLv95+yY?(t#5&L)Q@mH!Gg%sY~Uq^$Mtd7OG3q ziyOR|{b)=qW@6!K^VOi1aPoatBxAhD^1*tV6*Xr3FTo41-t}Q^OG{DmZm;6 z%q%_iH5Ps)y4@CB^CmUZu#lwe%mfVOxHjoqS_{V3_!A(jdWQ6O;3H@C2B{gUuJ8xu zHR#xiwM?Igvqn8QC+ZeU!Zs{j4@NAH16+?)<8HsY2-6Bb1sfoNRV**alkE|ug50** zbu?eeUe>(!WyIgjE&&*ouPzk1y=#0U;u=ARw9E&q_0CaKnBRvpskQ_O08XoP796MX zv^F;wtw5*&0EY!$S0;=0DW)I7G-FLs=X#;p`(72yZ5zDMm{7Vn4=e;6LqG~?vR}dA zQS#8}PaE;st&lRH1oXy}2L7lQ*$c-iNf7SY_*gxJlVunL+vVY8$cCqdCNhpckMESf ziW6U>mIeJXQ6gLTkfz!P3ShdWgHL_*;LjfA#-*}w#E^c%J|H;VxdgvEw zvFEXSBOR^JRX0tGuwx1dvChyEFh)KN=4kBdM{!7=Y>{$7>-(TuT3uA0EXmmLUVwfd zW7V#kOhK|oC_8aR)R?g2_&(~HLxflXJ5OmLh*N5PY7#B8zJ>$|c&pTSq@7foPC0`kjovC_>@ETadXQujlAdVHFk#$PT zL0I_|RxI3dC_-_w=>dT__O?}x%?fz9M&Ib`Qxjf$686T6!17n}tmigIFaPDFl~2c@ z%*C{bv{a%O6{7$z3RPqh;Gln@oDg+Cs^mBXH(C!&*ARMJ`-@^Az`i04+Ui)fmYq;g zEgKXuidzXT&L;Cbw(GDB9@82H2s*2h%ZP{c6ssomA}lmnizA-O8 z1(DhHxM3ly?HnASJ#DpP&_Dd5qnAcI)Ee=)h*Go?WJ&Q!JS? zVs-R1kqz3OPXF7Nx5ojE{mNDyn21C-1MYHql zm;l{7onb;=ToSQ7IT<;th))EZEpLBObwkwLkr3vnl~CwUUF|Vj zPM;PqcGfc>N)M+!E;2(Dsb6n5BLogz(AJo$xt-(!IC~_l-I>J<9Ojvg_#i$kj4B6? zJipoL@8u4h^k@Mx!&?Kc z_SmbA_5h)j?f03A1y5gfP(tzo;AvFSCmwNVloI4Ev+L(zuV1N;yN$5fZ{mdoFqbUR zOWywm)l%j!93_z1;LWMPlLc{9$&BVYY%FLH>U0Ah;+mj6&-QJDh~7_ zRdx9FI6le*@~i=RB!CfU&-p9m%m`l+Wn!0lDVvQ zccRRIeop(GXnJ0ixx{by)6~P&1|e6zKR#6;KrVY-Pnr<7|2}*iZv-R3NqY*V4A%=3 zia?i40#M35jWD_Hu1?l|CojnFR%!$2Q_)WOHV6bH%*`G496i||Bp{v z+_!=a0@bP2xBkH;>*l;(aT@#J>dbnXUMT3tXLKtVHn83>$^N_y>y(sBv@S^s0p&M% zCf}G{8qr4F)2>P3FLg4eSSTfWHw9$TI{P2up=c<&Ry^tmT&nwH+}dl_P6y#;jM6>` zBiJ4m?18)>V!yCVp17`T`V1{rX!de?A$(8cp}Qmx&89P-J)Yv%peH2HxuHPs24fKu z%28>MIH7#pIc|qSkp(W<8tcd=(4xV5rdexGe;$k^!lZ(8tGFWN9yqt%PnODi{ceep0HZ7W&LGVXJCZnF;lRJ zZPA!-(?LaR%8ZXMWRDjTi;h$HNeDD zbgo}ye4~(%%D3w18cS7sr8Xs~59Dw+|KF!_f1&G7<9cZhkQ`DBikgIyl05+??cm`_ zF3^8nbEB$}xz9y2E8-4$m%Fnxj$M1Wo9Pl}$hC8aZP;&6bue1M;N883Z+Bbi036uq7Kh^j@4@ZZVV{JDcII?*$QmA`Up~q>$~6LRZUhZOjo|o=Dg% z``UVFKANX%piO@P8eVlvz!n?pEBV{WD86tn6bFY-nq?O~b)Hs=15v=W8S62bx!Zsn z@j5eun1?V#cGhpa+B_7sTV%V5ZshWKp)pFtvH-3yjl=s@RQP<6&vDW_BxSG<0ck7ui% zwFEymUBgNDv$5(L=lkz8rkH@mJ_I@u+33r65Oi^d0L==Sv;nErb6HOur35MYD2 z#a%Fi4ZQjjT9TO(aI{iL0NTL9_M`}W9o?3eb@r?W)^c6Nd9mh-Xx$Y4$?tp{{K{~8!GH4Lc#r_Q&x-;o|Fl9?b+ zC=vp!yw=Yxm=^r$)hU8lV6omS96GM z{XQJLRqsPNXDjN7)#i5UG6Dg)0Sl&O?&`_H&>aij=;p9)Mt8b*MMP|t3(x&THGlzH+n z-=+naABD5#7@sa^pEpUu%%rYq^C#vg@_6zx_PP1xkB%9KmbbTO(@6Uf6ob1K9`A3T z!Or0U0DO$awLf02-_Ff1rCXP0Fw4YWlB*Y+>)GeReGVOGPDL8@Xw6CHeI>+chw{Ys zd8IW2)mLyH@wF{%8~DxZtX7xadaz#K{hB;_+-M~GjKpRVe@a!mQz5(Uh<}fVOt~b$ z;jn5qnoEwe#L(eP`*F$6KU5(d|POq0ibOP`DW(ASABV zyzcEYxP@Rqia<9-JQrbGm8M!7E0}W5m-Acw_Hp&T@zaA%03i@5NtvL`M>45jErwo_ z^P7aS(jf_QB+9FY4Yao%TmJ}Yb$cH)>qk}i?>cy&X-BYf+ISnwmyA;t6XrsjC1R2SGhvUp(gz95Cj%RgucNB(QjSX>^7}zi~EU? zfPjjXR|;JuOj*LZb*|uizILW6KItIB`P6`zbTc?a-l|&5Cz5k2a^QwUj#0~-0I?Vd z^v}kNjYW2{EFF6w@zUy>ZYEP$vtjP#?IG|<5b;#L)Xfy@IawrXN%P?!0w^->!GEYl z7r{N$n2pvSZ$a?+H6Z~Tj3`tGh^u2u7kl6R zk;$w2-_YnSgj|Woeikx4if$L_mus^fz5DnAhA3GkLVOyS?YoCW!7q5I7OkjFYH6O_ zK;5nRFGpQ`Qmobgz+piKc#Sbbpf=biko(l$p~s-e_S`>WZ^KE?5L6|V@Mu-W12rp> zVby~2fRCiX1L5}Jt@@jwA!7^}qwtw6!*!lbK2OkjA5A_l#7UI+^rebZ?bu(UjkKSH zR0iL6mY(k`ii8BzZ#`5#DSwM_d-o*cx378LXi1=|#8#+&wi*no2@?P8`sATDBX|po zF<7S+77kgIqtQq~!UP1*p#4ph9{=jPHI?DJ_MvxlJqH>|y;tjzNJon2dGp#Lj z1aC53^4b#89`+pjFmvuP!UZ43B93tNw_L(^^qu?JQ`wz>{Y=MDQul45EEs7;vtTZi+{onD$EH$9yZV@xJsd|d7>~T_ z{3@iNrh4)F)hRN`T!7(rg+C6;eMTo-u|ZyN-vds0rP_BrZFzmzxLDQccl#bPuuRbb z$(Q!GJ{5qX>99K@yZUR=G6$zj<;XJo*P_u-7Y44sSGI+z|Kh;)_Hw1`KNlt*imZS} z+kQso7xK`7rVth(g9WDOx*dG8R&yM zhm;{%^CzvSV2Iuie{i`i1UML6NW%P~^A>822LumgRa4M|P6%?>P)RErasg3*ZOg^R z0wIpDBlFWlFAstrm7k#F2`*SmjMu`*^rUDFylY*kv!;kNmrO(GNY4wF;0FoIF8~HD zy#@uAYVq~v`FV4A#;}*eH^aa;^E(F>4nddzqHmnS{A~rhZ(4}t;SvqoKw(v|8OTgu+OArt*r^eN9FNcY7*t=t=0{h*Hbkx zwfw{^c6+1CVNny;^S_$W9AUI^J#HABbly36WV8pv`q|tIp>{qX^-(;m5-1M1m^)$m z?|C^|-n+wd`sR2L)!EHiSGaM1F#-&1BXmjF1{K$!xnNrEk3OS3j&xJZ_8N4dr5PC< z>c&&F(u+DO!<<^4IXc_rJEBpo2O==W_`~cSeE)7R2MGlRu^bL}>|asN$am?oR0$5S z6DA;FL7_$*#I#~U2%I9m4b z*MyS*!tHZN%!P!Ae{Q-N`hC18J^B+LE{QRvg0b}ccqhx=%AGCltoq1MziLBwZ?a`n z-bd-4 zS|dui($NlbO$@77xkK&EffOp4h#m4G9Kv+KXdDHAHiW^g#{*EIqOGpVuoQ>FzR{L?x83%k_-JB&K<|*_H?#6@wMvHYrND&H4 zjqds~0fAC?{lNPSly^f`3ChgB6buAy36n$zVMco2CM`CSmK zP9tZmJT3VuoF;)18gl`G*%b zAd}EX3sEdiA|f!~3l3V?>v}u)`%$1MRvR)6I4TVP{kt3-tn6WPK=+*Un1Z8HT%O38 z*PP5L`Iv>vsr>7Y{`2GQx*u(f!hv6FKOGCZ-+bFK1-GElTQvmx(2B^Q6vg)h{g0^{ z^Eq+s4eEkcP-G5cGlPE+%~PVieTLgkS^>>JfHb^dgKhQl)^;Uv(2e082uB1m0kc3w zjNU@j@d||B8GXbRf$BczZiZwk)ew<*%wM+=Yu}^ROFwvO@=*Z2Iy?6QZYMCU)!}th zq7#aaymX?fzq}v}tPAR;84QDg|x@lSl7_b0tVFDKx*V=pRz+zsm zbb|0WbM;yWinVHoSN!pyjPSRDK=LAa zllFnCOwG|`K?R~|s0+;X8;b}$#^fu!{=)P!jsx#T*#>gu=Pz1yI1{gL=kRye_^r$_ zG^bmLeW8nKA!ADKu@^+N4vSn~VF!!9F}*Z6F|N9s(VEqk%cts~^)g3lv{CaQi7q3j z?#|NO6q>L{UYyVw4_~)7=B*+MvaD+N{T~u4pfl4-;}X;0I!4(dG&47fIH+96hq?C;cTg!a74>OUf>xHC!{5m&V6Y{g!n!#j+t zjd=Zue%cl`?O9$KZ-b09Jb{C5Z7J&fJy_G6d^jm~!%hP<2-#oAMn|ii-+9ByR`g&3 zA^moE_gR))`gZQ!oV>BxiN{RP#3jRm+kFT(>5&B6(}aEZ+A}KrVv2zHCgX}rx3hta zgbRl66$@B#gf-4reXGr}NiL^X!0lzq^t(CB|9y%U{J$b_GbBBlqYUo65=U7Z2(mI`}Q- zlNbJG@Vo*3 z$oi7|T?;IWa#ZBP3ioAWdX}z7{#<>y22aTNYUv%M?s)l!_qg*zwP1b&@L7yKY5CB( zSDZHe9MAiG#hcuNb^ad*pZ|)0`!o3b?_&1g(KdbY}sV23oY`SPmV`Fh(LS>lv~+S%)N z+4=h>yj$tVX1n%R^E-o8wENwlQ9MM$Mix@hIz+2E>I}iArjsVH{c=&B!Nul(uT4j>_|{2#=qXq);l{PDAwYuVLFr-q9d(Xkme!s~m6; zc+MhZZ%HA18KhjiJJ$?fR3y0+UWEhc^c_snJb9`<%JLQ{Qa>aVL4gCRTn-=&6{`qh zWvJrJk>ND~MOUAW253p>KI8-uq@$MZ)==#TG-L%xeF}5IU8oggg)ny<`l0lx^1M>F zd?beaTbAbN%}F2wduX?!@jDw8`{+(w`nlmg7@7iA7+b z5S5FmV6Q~XFAWeP!GhFEW;!w;16t_337(!JBgh9|f9qA|(M_@1pPYjv7+wC}FohBxG}|fh*y5lwbiUzRH9GV*ksp|I!M}P$isV8z ziy~)t7GjBw*-CQ_zLpi0E8-IBa8DV*|joNSz4N$vx;*vbyf>VMJOJK zm3^5)smrTVrr0FI=TJD3Xmh_#9(7P@g!o3zb(z+OaHL0IX!I~&VVXUwpWBp3yO)h0 z`GGM82K4raBNQ=T_(@!JJ@bl{wH#%LC7f zX)95q#%SCdl?6Hl#^str_cN7&Q=e3R<(U(0KjLaEYQ!xoh0BLM>Tj;OrAH@NT%ROz zQv1h*6yC+z6H(Ht&RU!@hS+&Gt6)thE0{5#7o;A$4UvU`+A)u_KWdAjQC@yTM@{8UChLDj2>A6K)*oL@R5)^q z|9Aob&%4cVbnp|?-5xrs!7luN5S8siv1WI1N0B_g9A|3H>4`rKAL@JdtcxJ{$$e9A z<=3$*!J(M#Je8^p0(@!#@!p-^gY#PS=H9ZA(ESRmR$w+;tN5=m&Y?T&TRwb_bQ&G! z;*UO;WES^FT^62CM;osLDX2T&`w6h@OZvP{bIs54H1vBN{ojXD_+-d>(!tiS=(8D7 z!^Etda@dlK95$a#-W&UQptNg4T}?qJ$I-5(4S0hKmp8a}pxTY_(UmiJL?-s1>$73d zzoj1IVk!6C%zw|5F=!*wSDu6v(Wtd^a@(STtpk2sDC!RsV1tLI z(m*ML=@iU%b-@N5O_G7T*P*y}XYs4l0x%p$p$$pUffhMAdxO!gGWV?S$>q40GBf*8 zK#4q$mr*7`!LR?GzPcQvxA>Fx%JsvP2n5Bjd(>XsqDA3b4%7xHWRHOpfS@8ri1rLL zjrvRCf4ad-!BwAImhZk^rz<*Z&#pncf9pXde> zNSX(Rkm)Jj>jh|?sx`YzRo;@Cz&>gWKjT)!K6KQi`E{=`LWT_&9bq2|Ybs<;QDf!2 zyR5rC1yaB9n69u|ZMWXR(6rSEx#qdJ@~p%`nRU6^GKfr}W%QkUO3YC}U^czjLm5&F zmBmy#BL;fkRiN5c(2Ubm(43c$`28N!s7XD;b6X;BX)$<9POm!kih$^PIXl<|?Cw{U zJ;CPiyN<89`X;W)Xr@t!1{?05UJcjoIa%ukJGg(l#%U5N?%h)dUQgiEy{MVgS z%Q2id@pt+a;<+msfnJWNEHuF{ZyoPx_+fqeExbUIF+^vkQ2?mB3Gi2)IGf&io>{Fn zzwl1u@si%T@Dni&PbUakY5rG|S#4QHbl7M+L z1FLsaK~v%S3heb()5B~4esLaUWknZ`l~iF+e^K>O+3wL%SOxQIL_+>0ST+6gteUla z`T8_Wx1g4+JiQ&QROJW%U%oi`WN`bG%M($glN?d&cXRGI%1*cCbg3Kkc%0r{$%Z7x z2(5oGg?PNOc2*z2ZjA4%1>xh4w^g(Z2vZtRSkrX#i5%i?#Z&l)ih6@WJ@ zdrl}%ra={ETc{esxLa5Wz)?I)pw3Q0t3Ffx_fo#j=5qf)7D5?%Bqk3G8YK3Cy71{% zwpXmb3}=8lJ&@lzLH}tEU~J8lO^YApOnLBThfM&n(?cr|LwRMy@qqm6zlutX2Ced& zy?z$FKGRw~d!13a5sSZ`vYejmTlej4u`s%UB0UeF`{}K zMG|Pm+Ok$&JiwPuVoZK8G5$Mu6Zo;dPK=ev~wyup0q<5d2&AQQgD`yRBH1C|#7e%t;OktljI5N1!d zH`@aQy?$Q;WFk$_(UuKK!eG3+$=g6&L6#?Jg9ZzQ|JBUtryL!6zVZGVFGw0-rl43E)a&?q6pK<=@(kHt3{rgiwmM<8uoX~$_WUivotHB;nd*9tQ z)Orz``0Mh5t!?JC3%3(#|NRjsDfL)YM&!#7Tx_!a-Ak{})kNt0Xifh*PUTVpB}rSJ z<9p(56(olQ3dej5J@Wmidx4!^WElkD{i>QgsvMYe8f$`lT4o`$reAR1UtZEHvu>w| zmB|~aE2+GU%UNVqta?yQQQB?!mB~1YxE}Nq`c>&cHH)PWv82jiny92W^s)Ww+c7FB z=XQS3>j>beyCPq1V=JrmhSg7&i_MH!dm1#h~ z`5V>seseqQNEP&i(IhswVUVAb6D|+(}4|~P6_xjLO+@?~B4|PW?Ro*08 zoGGPhfWi^F#hKoOdJ6V#&o8|^wZnU*_wg0g^jYiAFr5syA4}O51k#>dKyJWoapTsP zAwfJf+5iQhX6~|UGs1EC3%($ELfknW@1n?}|4!N4Iiiq(P_){fo`Bkz0_pQNMc@vw z1T(V0sq|?!N&*$m=K?8(B(XFS=C17lEE_hTFTO#Dq%`Ipl_aM9%EZGfv0oUfy@HWI zv{a3)KyQ>3N?BsMU8Ii$l>y@B$jWZL+FX#lZ~@El!mN<3Ye7_UG&=vQ@_9CrjU9*v zXm%3>+8gst8ht*3uPjOniSTG&1MMFPWU^OR6!ZXK2QTax1qoT#X8*0I_pV1Z*gv7b zzFB@*6WdGRmd&gE4n%>)1qmqMhC2jYnL-|+^u0D&lbBEK+KQa$y>v=kU&tkre4N^b zyjw*RBfo^$jHc=(N})5wubXfbIVN7lLORlJR)yEv#4G!Jc03s8EfR|0S1?kklW+WC z(01J!{kUDXK!CxJB)VpTf8YBYFYW85BMNy8gwFK7%m*I(siNU-lLI20FcmfUs(dJ1 zItXf82*@c!{YeARdd&LciS{Sa1o=^w1r~afLxV!n0EW#7MAzP>_)d{{TV2wnL?o0g zP7I>Z*^AbMZqYi+uDwQ0r$NEiJ*Z&O-l?K5li1&ZXi5$8g}TKtS}ixZ zURmfUnf@R>$;D>>nzS?~-x>Us6q3mHuq<`I!JlgGxAV8?H$6|E>vJevkPgZN^4<#a z47z3QNllO)^4}t?McX;5$xsR9UOSY=*UPZb7Z%_=MDUFFlTA;zJE>i=R;u62#HpuS zZMoj9F#(|>oF-p<>(13vC0`cR@7DaT@`&bR*CkvBqLbnGV5tjT>;b&5#o$wX=#&K? zQ3bnl|L6fpOv%*vmcG!mDf)_!uud^*LZRNn@S=M0FnOggdWyj{t+kvH4a)UH=0xvm z(eE&jS;S_jMP{f%yj#xi5CDnX9H#&dw)(H(s%AO4l^gP8>mBw5XRlm=_cQb%%Wc6k z+iF-xE9k}ajIr`tyJp&)PBA0r2adl+S91F9h4$SNRF_ad*5>(V4Il}&X0(*oCra^p z7)db$Sg~gw_PnSIkbK#7#w7B5ibBPIuH6EP?txx61%#mvBfL~{;6}%W5ethevSm8; z#)txWG|o%!tFYQqnW==acX?W5EB^rRQ@&rXS9az~H94inL3r_-FfCK+rKPwMWLGVV z7^ zhPLuaw{r~K#ECk+%|t#C7k9~E1R|P}c)LgBlA05SZAmP9d_=ki&>b%<{P-BV9_3l9etnr1X9uoN!zl=66 ze=DTVe)06JPKuO&ib}6Zf+fOC3G0M2@k!SKTy9g(_hywRTUZ<{A;{Vd&O@?T*_ml#dX=W(1O_6%3-Ay(w$H~(gJJZ1&6);BLdd} zELZ&kKiD;Mq9B?djw3As{`4~#WvEn7Ddda39Uzk{pNTHHkN}n{knq!H}5;=%IT+QqrsL zhuw-wA^!`~2uE z;?eFNgoSC@mxlIUN1fZ4eWp4Vkhtvy9gvdIRaZ(|bv5-L%x(frIGbm!G0*5C9|g6$ z8?S7E$*;<=iF)jM06=(WPqY*5zouC{Ft;W8hMPT~V`%x&kdik}F;70=LyiNwJX*DY zj$pPBWYTDb?j6fwg2O`7>xZBHZ2M&hwk3&=AWj^ni$^j_HZrm4>OOr~;x-6?b^+m$ zJA#ofJJZ?MmHTDcfb1)Xl%t)f_={ZZ^W7(;>kgNe`#AmD75_5f`eLmFi>W@N-!viI zE(Bfvet0jY`aHwUv3_>mF@p!8??&|R;LBtUGsjiZDa;tV@V%Pc)VzG7Gv@WDNl~Gv zVbOuqJY+?@csjQXwGQaTvDatF%@h)k7g1OyUETja4^_WGu#@v1&<2u$=PmfS>R4fuZb0*`!`G@-$Ig89xTYM?UP}4&6UX_;A+f@awHw@JMlV6NlRt%^3%N_EDiW zmyIuM?u&ba;`GBX0KU9kw-z)}UT~YaWBbR=%f5h|IC7Sc8WY!O!lm}>RpN-4M4;!Z z-KdfSOP-*aqN=8qABXikzp7-C5S|3Z+UkwLmcvS!bG>TY!jD-i zUJvYyhTI(`j6$w$xs_(kdQf0pGn9>#E9jRWWy!$qo8%CTQ9PavG)o=tSxf zJ4K*_{}BBh{?EE4Hpi1mCgC6_n;6wNy)_ygff9ll3Gw9A{5~Q1p`ezKX1t2JOzEjH zZ%!Td;24dk7(F(bMgZ%#1QhvPnm>f%0D*aGO$!=*@O}$82?-pa)Z2Y0NeM0v_{ z@A?@0V;;(5j69Pt$R@2p{SpJBFrG5G*NLsCwRT%8kmK-j~O@vxd7oQgLREr(OrLnX_$2#B_mxr>TCOf^WLqA59J9Ngl<>J z@D5!k=gmJ$FbOdRyw-o~|6}Z&x-*NmXdCB?ZQFLmwv&o&+pO40#kP}*ZQHhO8#lMz zmwQ?}59c53m%Z0md(Pg+4lE`lLkR=|dCRVshu9$9y^T?*Jj}CuEdHPJ%R9^c_$ssn zkhw6b$|>r&I9TiBDPrNacvx!;<|h4&squv$0+sNPZbP=UWk@HRyxHC@u3=h-oE>C< zTt{N5xJKqE;lV4lw25X=lzJYGvm%=)5F70oG^Z&^#2sIt{oxT)=se=jFehTqgyHU0>JnE_ zs}u6ET0_QBwc8;hDpC{UVEzt3R0)|=++a%wyGLC~m6t_$HP`V&1${-}0A85a_JfW< zV;msh{lVc_#8tx-Z~V5PmkVIK>BeB=z5fB3<(9?D0*fcLNG<@P43ZnM0v80CO5w0> za>!lp))`)R)z6;3_|(y%iPP#J$#&fpmS)T9zVw6|UR`a30*#j*(}qnu2Ov6D4aVX8 zks-Eru}6cX;sF-SR!cOC2nQ^~b~IXjo~pV97aT9{J;U7IA2ZU535NnQ=p`uE_tQDT z5x~G`*7(T@)8?Wm^9`D<2Bk5nW%q9pzo~4mrsvNf7c9$v>aZmR?dxvKve&)ve0sU& zGCXajGA&4#2DU!VPr6r3`vo{uVL@%uesHpP*8~nfT+xoF^OKb7hflTY>g!jx>NC9| z?2=N(pMy!%D?u=ADr;L;{NEK{UPIkwX^wSgsZBfml2+uD^&_?4AvS?tYf=wZ>YE8H zFu<&3LcJwn%xkx+0OM;2#?Relmd@VkPtup4SdOK=EN}{A#$JY8nO<}YKahp%=P*iR z^PE#L0GMYx8(?#N_$s4_;riYru%718)r5P!oHN7@wFv*52dC<;XMGtQ9JVEtJV-Q- zoxed!6h;9&Wy)awtdNxx$CLU7Xfsels?rW1|0@HRGu#yLz>F%Y^OSBAo9cp$OKDiG+%l=C&OQx>&Po(tAjtb z7tB8|!MU;pCkaYMgJCofe@rxltNAmuont~NUA8@u0G6FjUWhez$7icEia3j?yL|kW zH!CjSXb2)Od#kCEzdbSptqQsAABfCbKnH*Z5rup%Xijh*2i_QzSv3Gm@RHtM^V{HhPPlef%r zBaJDGO>iTY$q59m)?Ypbqy%UEwUnP`o#IY*R{3J8DUb87f%9L;m8fGAM5G;zRYU@5 ztcfZKUWphG3qmU^@8E9No0`{vi;q{8v!&1tI$e;~M4+~}#2xB0EF95Tem^fG12;j0 zJ`EW|iTWY>0|J*4J7|vB-D+HGTx+{;c3@y?{*y26#_7-|?0}S3=8b#=@AsCM(~NK6 zcQW7qMx-z?{ZGzd7DlH3KWwNfjLP*hB6i-RIXRPFcuHFntVRfwB3p6-hq61UN=I)F zjsEE#ZiE3@o$E;RxHtWS!kBx?q`>0?y$RGzN1Kd`Nfv?)aS5LaK_2!Od+iI4O-wE4 zlEuC^T!~mUr+}m4Q91bMin9L>g0E%=z7cEy_=+O)bhuT|f6nXEF0jR~tZorf{ymsU zmEQ_X3pXocdfRxP^{-}uE&Yl89$os?Z6G~<&73f?PWvyK*|pMo-&b>-f`|j~OA5Y@ z-)u8MBGkI9S+yWN`gy;~TmkQ-ZNsNauoeB^_M1JviO?^CX2JD_9HAyor-qb{`@yTe zFu%6l9RxiSKQZuK*(`s;%Bgw0dWA4ssrLa#@#Ar{*w-+FO!oCay1Xjfre;zazJ?pm zN4T<8ufhM8@R63j&!n@)x7$bQ}3hWKgax$_+PcMWdMTE`VCXYo#lWL=Ov zBr;F^RgsC<+^Ut_L*s>NZr}~7x7LpH<5v0CkMwgw(*S~$l-MHnvQgp4 zzl}TiSLzcp-rpz z#5m<`r;2IN44rrz0w$NjmRuwPVX#7L?|PM5*Kxn~%!y^0=+(32o>GyiFp=~dBf#IChub`Y(u9nKBbT8WvUp)1%WSO|TXAv)&()r)RRRY!KBf6rSTy=W2_bU% zfQ`Y4IdY$RztEf+N%(}t=}oxOf04E6izM$`HG+njn$J$HqxgDc^gM3$o`4Ud>0Z^D zHHdF7KbPE0WamKgKiXc~DgbG!X)&a8SH4QJT_yWd?R>6NL^jJedEjQ-M=5ht zz=NEInqMdZE+m=ZD}RI`et|HLrjbXH@NBC=HrG;Ypr=myM!YZ1`%=WF&a5}cZmkSk zmh!i?TF?LiLGxW*#W25?wPq?qAMdLyOilBzb`f0e`mm@EA@tP#T8H#!-5OSc20(4( zA@>~8axeL>ciCo;I>YTcTlA{c!Q6D*`fp!yDGajB86#SX!QZ>aR4RnZei^j0+qJ*d z+Qx6e*X9x`ohHuT7tViMZS1gj56^$Hp0NbfN-+nxR-EyDF-DjUT8{j;ASgR1F494Ytb1xggabn9T=!WDd*t-;sCN$XuWUJwE*gNQSsY* zTQ^JAW{qadhf`1=H{gCU?fyBxYO-{>q=zsS`>bKVRMNoXz&Z<8=Q zss_QuqMuAlEk5wsn`Gm*5Z*y!Cx|T8ZdE=jHSW)OmjU4M!+k|S=(-_S=K?_8v|?;N zun7_g!6lMEbX_5s-|%ra|KeX;!F%Dw&{iu!5n>}dr@FpGnEKuTSp{oW98$|qjuzuZ z+}l+!9ECD$2m<|2l$GD{^U@snNxxnOCO?l?ehpqA3+2r@;%lhs1LSb1o~3>hagnZC zhX_(dp+KpPh_zK+0%3y}LVVk9Ci^{a0r*Z8fZJ0vP3hD-`Z2QGpRlI?;dr;Wab$J3 zoR9U|ON>i@9tq&0Uo$|O-BC1){8jy2ENU1ZpR}@-($egiRgl;_ri7?H-pY=P|JW7g z;a4+i0`Fk^*98<6jASd))q}jo?EGD&**ca&Pt#O%&;4 zG9tB?P>N|DXed~wlFA^FCmxbDAynkGj8pt5CzVv<(UQ4QY`;>BmTN+tNy-7%F=A-_ zKq|W!;l?>abm~R8!7=hTrJ({uMAmcw<*dl$l1um zb>E2EGlCP|@+M&VUH@eHdz>&SOz_HRaWTorCX*7w7r~##tQ9x=H$GkF{wyi&UY!Ge zIBS*;)KK^lF}PFOM3t|$R^{Jy|#WeRm zhkZb9>4pw>(^K$3_4|iAr&X|-mO`6=z|}e5KD@+N$tHt2M6$@~6I1ihv&82|0(LBU z&Oh3Y53#&e;UZRjr!A_h%`wSrN_OEzdK`k+^%vUn|1@$BYHPto5G?FgIF5oCO9Nh6 zNkY0p&)(UdagfsKS^DYUT_(j=8${v?9kjjd$w;`@lf_xzWjhP-h}B zI1tRI5H4B>Dl3*aTi?F05A^7^pU#hTkSBoDuqI=s&ataJlPyi)*TwEZs;~erz(^hR zfMQhaFEI$5#nf}nrirvD!ooj~3qTLG?GKKt36k%7k8{`ZvZ4(5y^=T$y{(~}=&0F~w?|b7P~|L~@lW(EI$|i$#7WR%q+2wi|FXA$@25SZ ztJe}X2b*hsTO^?$ZZWD$Nivp^*GW1`MIP6g=5)P^?bd!HitVMPLWP!lrC$6~BbOK# z*|c~T3erDVjGaCBlqVmfo)&^T1L$$U;g-zp6*U413P}uBmeJVxwh|P`WGP9)`EY}g+V7udkRh9SeO7#XUz8j02*R=_|gJggIMs9^LjuO;YlU05w z7U7q-!knXJPp!g9Z~YAKGD*eDD-Bv|d_9AqbT^~r6^3L_&v-|wQ~;zljS6WOF3^QB z!BdFYO0d>Bm9V2!b2AZ_o^Ky$ZJr*bnxld$GJdy1mrKT+%Sr_1_$-6}=9md|n~;U| z6p!8uXBoNQ<=!&<2ue(owBKuxl<`ueo+upyp-eK&w69vfI2#$Vp^ncAq|CDehe=^Jr)9oP?g9-sb1s`t(GXFR3+B0GjCL5pdyATagzQZJvugb$Md`_ zK)_f2(t}lrDt*1Z51XGZvGMXyvW_ppD3d#O*_F?udbSDGTQxyP14qf^&2CU^P=^E1 z2^+RwX=glopXW~mQ2SBllRu2K*ZtFGb48R>Hu~ex_Q&TX!`D&ur0@2EJHy;{`PI&L zm+fyXmeaQuhI6!ei)+_O%*6r54C6jz;o$X;P|xQB-_Nt?Oy(h0ByCdC=`yWng(_0n zWuJLhgI5{&s_@iHH9q~Z&q1f$Xm5bk4h(Ug>i>JWh z9IBfs4tGk(#S=jvIiGG`gk9JR{`ut4V3xSAw>r58+{z)xQe(fY~E)Wem`^u`mTdh~7N)fOC zqGci;j8OQj*JM|PoS}OIN_N)Ey}&u5_K$C{F!2ig2f+B@uhJBUBy2;%p#Hd-c;ko` zvM!4tmXIFzOGV)jB`xRQ7!$noaTvlQ0V*Lbw>4UTkZ%i|lXGS3puR8I} zAtQh1sq85feOFn0_FcrQq;BWKw(_7It3-&mdk)nJ7lp>{WOy4(Vva7d*5mq3g!s`; zL|7_cPyE?h>gU77YsLgb54@YWOA&6bcaR_qtMH#~lle zO2zMWOdYr)F<575f>0)6eZ^m%XHX)?z_ z>^zko_L0Ddd&Gj6)DQ)7GxzB{&FN4#%#Ka%JVyx$?OPaX{=sFkLoJCwG2OC{-ZJkU zHy;tllw{m&=U6(Gpe9XFh{!iqApL=9U{*eG6Oj?&rY5Cn5R}n4TpW1lB%ODOj={ST zI$4DErjri(ozu^E_jFctPlzwtQs%sWEVB4avO(OS5{a>fthcoCm2(b~uM@WdluU`~ z)!i`_(EzIIl}I7^BFOx0ZxmJ9E4H5-m8VUs3c_;LY6@>I%=1Xk4t+*1LY0NTRVzPG zm-wXnP9ANZ_tG@2i32Fn^i&7^ejHyGr^f~qDu0phwV7$zhafxK-q{_;8yX=E4Bvql z8H)?C`<)$~L^q9=HOOesbBbW5`6KN9*ufB7bC|AYTXA{?!-Ed*Y%oh_j6u($Er5`;i4!hu zDtD-ynhrNTlXoWZP6yC0e>FvKurk9+K?Nnn>nRW&6=eS%{jhMCV3+=OM22(;7MPUs zE~~ZA86X3y$1Lz8Z1-gkZU_HxXfK}pGzO2sBa*~D>!21}tVuG1bpF6@)hvV7B@3rY z4xJFxJ0AJ=(54O;I@cG+_yJz)y(GtGhebSm~ z&ki0uTzO%v+Z=fpW!MW1Bs8mlGhQ_kRa_+jy9~UDC8T+?fxZwY!~P~Ct4kMX^FhFS zrh6c>%rLITNkWn%iaa5^++>|WN||pC3T{xI6WX(^-UYLogQ6VYD(}7FpZTD&1(R?> z|FlN-wr2rc3x2`@IIx(_r@f z%QeGWDoo)wMQqLA;3iz=3a~w?GGl}s#(W^tsA|{I_JfiULD)d}R8VVY7@O2{<>^Ko zQ069u-jXu%(PBTU`1q(eoiG?!)z92CtcJM;-_)zjwa!QI(L$hW}Q( zh1PYF#scZY`b_I@hv^F)h#a|6rvm9%_3NU`0C+4EkHv0P6REz}S@Bx$nM@#VazX4v zt<3d-d{tbQQ$*EIG@)9=FiVi-i)M(G5J5TKgFxi!o*qoY?VwNOq*=p6HhLh;grrtT z!9Jo$z)O)8<);KGS$=#|sEpt~X`F#eshU`1zEyDhL#w4poD$3NQUBJ!3Y=I*!8VRC zSpEc0*@(D&&48jID2R+b7-5Mq)|8OOPa4bujUJJtdXN#oH!abjR;|%Jn}-|zLu8S8 ze_MHriMc)9l5ywvx6+0Si=1#dhMX2Fm!W6tlaaGOlg#SVogjf$%*_fkMm$EcYGfe~ z;+*=K>|+ojj%nakajp|=(Xk!J2cm^sj!%cO=Wa+sLKHK@?@piJoZzm>6wW@8{jhWk z(Z=z2MV{a`SOhFK9r{G4lD%)la+Dk*>#IRJ( z#Qhj>rNt%XgKhliy8Pdt^^#=*B@k6<`WJ+&D}5xZAU0m6%W*$ISlv zw9irVHa;zJB8-Y7XaGsgz-sYvL6%FYk!}J|7`)sfPQUm2fb2dQYIrdZkhW1T$-NKZ z`GxIYaX3haRElu*;$WN51V-3lO^_(wll(E>Ep>zd=9Y6AFW(?Qxt3J}*u)(7tq4kg z47vFWsa#`6Bz7?ciC#d&P$CrA`T`MB!axBm)@O_$jEvbwgGz*n>J{{X3QUlBhR9Mv z9jNnXU~LMG0mU5cRUU`a$`w7@Du&>vV&ybRyuTD-SE**WV}?y#n(g5H8tv*L!1bLXx=p53cBv;BSYdIP}tKX<#i-kF^KYgYc>Y=|su|IzvO?`NTH zzv=%Pg=Pw1D_i!mq}G9C*F|S@DdX`D$R-1qmR6*!M`=d6(~hQ}adnNyaxVlGF7)YU zJG^;PuDuKEr?DobUc^}@cd93vN-i==EB;Bm%bCpv-v8!%SpeperO6#^_RNU|9LpL9I7g=? z?a`n9-^=X~{H~ly6X(F#;~l;()swYcY@0z0Z&z1TsZtUsHr;+=64WLT@VdD&Vy-(2 zh`MQ^Av+DkDzm|4zAopP>@tTb4t*SHeru=`Kq^*Azf4dDp$`Ar4Ud<2;T)hL@ica$ zC1B(qh&UyqA-1V(F>$B-V(0FfG9AW?XAhDk66cL49InAt0qC}U|HntTzX2JU4Dc}}V?v0#K@nlR zTAl%&wmKCQ!=JgtI`6P~mY)7n82O>O(-G-D^+$+yX1UZ^H-8#J?m^-mZ1v3X&>prp z79|C+%wIc~nEvar$I{JNYh6xuK5pKR^3zpb5w}s~5ot7(y1Qc!NR;qs!c=KsY|)dq zudy!yq$=|C11(3kK}C4ts+Z<4qTojCBhs$I`NkgWm+AG=H121Ne<_~fuE6<;UiCdI zA;>sqmL%8V3(WZ*I5AHwQ}=XzPoSBYd&8=PAXZ z0hEfaRMq`9Gycw6fm9wAmQQl$u`q6Hq@nVHgiHg_0A%^OHma&(Ktn`*3UrVcB z%1XfPkk;Y{$<)mk(au}2lF*Rc*i=WSHgWl&Tqx>LQ^TH-GA1Nb=*VqiL5V`piL4@m zBfQJXw1BL@vA--PSCF}5I*O16>YR=n`j1o{u{}@72V$AD36~e3UZN+eDs<%uJAZfl z)58Rj(rpY$pNfchR92SIH@Dmn_e+}A`xT1r>rI|~Ni_7ol;;*u!>}4OwMX=K?`JO7 zE)Q;SJvSC2-%ZIFXdt*yZW>DJD@a|8F9yrk5G@1HtZfS&@raYF77qssDL2Cekz;U` z+5k)hA%umwsds?&cT5uC4FOZ2{qB18wtzg> zr@OcNBP{-G{z|~dFLYzC?zg@){M4OSz?*x+jH_VFuAnKKtFNPd6B-?&8I!Rh=ku#q zAXW+q`QmUU*1}+*M>=oJ%Ym^fj7aiTW=t0hZjuuYQPdToG$x)IA-K@kVxIxI0f;tv z*64GevmXEKl9iw@d1l8vR~Yf}YeTKtoSZ3Pii8)T+^vdkrxi>a)kkY_M(BKtW z-hcL}k_>!jb7|P9UK(0T>P3da{K_`Rl{3P^6{VF!MzRzh>*IDxCJt0+s7oxU9?lkY z#QqIpTc}Aw3S(U&z9a;D=vW68TjV^{)z5(vtZ>b4f){Vy0ef?QrKFKFlc?8~h}9MD zcbP5UB#4JA;odOoEG4jhC)49_c5)Cb3mDB!^U%3Rr!b+ zmDA2D=Znijl@PoG&%q@zR(CdbycO0A9}(fX?eV~5*(N~%U(m8qw;fZl;{6{?-WB9` zlYJK?=bJ}F2J)N6%ckM+s@2x3e|A~$zr%$hL{HT$`> zhd3QZSWn`|cceHF_fFE|lGE6Cwmgp?;{M&Nl-?`HazL#7Yg}AjfLnKmGy<5`=q8RaHexr=O}`Ut2!zi;c{G zQ~5Rwmfh8GV)8{$gxMO@7^~AprqPq46UKzgaQ{9gJr9<1fOYXLvhlH{5J&Bir3T_; zpH>ErrQp1wQYd;x967N(kf#CC&O!Ch8o!!agZ`z@3JFUxgEeIa9`v`2x!-OKmeJe4 z&NOOl3tP16#IV}pxN+qMoYeZ}j>JlUt!qp2AK{IUp;gp4Wd-pkxqrA4V+k)RyY zqP*A%OHpBUr41|2(1Fb3UO%Sd;XZ`D`|NT&C3$@`mz?A^rElnAEV&PWMBi1nSxsZ0 zB3@;f&~;ON_Jk3eCO4mcYSeEgydQd-`Vl^x^*LD*OdY~BP9H>o1;k}mZ(l(R$+@fV zDRYw{80m*aZ1t(9jM*cXwuBuus3GZLFECexB)FMiqL#d(-b`wlCB`v4h(+!)kUq5_ zf;(s`ts4cqXMlr8H)*wiGVV#ep(dPoHZ-Q(bL36vRC-$2RJSe{Hu6TFH8c$Ak^L@W z(=C9;)?3^C^~vTTp#M7fexR`hP&y4x*e8(q-T&I;e-Ax%t$to*VQOY1p>95jUaLsz z=6xPYCyfZ@Yr@9Z$S>HVWv16p+U=>ASiAk1OV{~yel$1~2Rj-JB*JR?(=Y!j9R$do zpK-_+~0e|c`_2EV>Q6OBI?)L60gFC8TNeDmAzhGbWg*>Ewt@2%; ze@HonJ(BkizL+9Sa%j8yLmG zb{ErO;?ZriD$SF#^_55GLfe&>&jVX`PuG2BU9K;iur3CW#y23IV4nNBHFeIStE4Zt zfWO|Bt9faxE5TPlq)AKH`{ux_frj{>jwgGv)KPfQPPo(V}l{?oKwdPd(wM?!gQuzu7p zZu3O<{?iYE1~`6A3(nuN+-H#~64hY8EG}=pYOSaw`f0VZ|V!dr$Gv60ZEDYT{g;KxD)Z=fO z?0xmz#dmIV!4#X zyYFl;ct&0Kx!>%K(Z780y(SWpJErka1Q3T2?mMCisgQ??_*XM~_}0l^#pjSfiAoIA zD3%*j_D{9et05u()aS)gQQETz+A1sDupuc!zo^P&K{KH>*lVR_6ki)g8TQ2yJ5NxP zBU-eE-Th(%qgBD^*lG}OA5ts`kQGs{j~?Z2db9CZw`|9uIEG>ZDf5s(TwnPOZAbyu z7HvXHWV!x3gBWPEyUeCiJRbx$tkzHYnr$J>o!%hMQbQd8Y%2M{jklg)ntLp2fB?0j z9SjCP$|;@W*2cyKQNbEXl?-(Q)S+JQb?F|>i4tf`O^MHq0?KtCwdv|Tq-~MrK0l1v zZ3W?boDAQ3DbG}O|5w_k>nNEyD2Z7TikVEYhc@_zy@-YXzMMI7d`rv#IE9kD!|Uy6E{fe44iFxqaT5S zfm$miiSN**PmwAyV^;C=V(FY=($&cG9jGYak4kC=*h3IvF|(9K2YO7u-i;@)C13r5 z>6ZcQOr$ZgkT*2*RixuwsE?Vd2LQ~3u{lPdGtYfX@Prq4M{N&g3O&G2SdFcg^v~ zcR5#M%kEriB+oE9#h5n7gNb6q;wiX@9mLnQw;9c~`Xk;Ja$R+nE)c!Atu9$KJaCVbVGd*%37W;g{LZh<}p zA1C=iL-bZ<=)(CtY;engl1zX=PQMA9Z`qVDRz0wwaSd<;dxUSe6)GN-d5dg9^!$;a3t z)7i<2X*I?e$&vXc>lR1gBYmj<&X#|KZ#C|7@#b1t!6?OMoZO4|uU6$>UHW{_7Q__7FPTrOAWZxK6=0sJqjJ$riz*h@&^mSD`+%!&#y5O{iXv zLr@2)dS+R`F@1)8?ZQ8u;j-^=*5an1(@mhIL~&M~;D9#|HtG^(Oum?CMw5)d58v zXl@<{iw%(xJX-nATCoE!mtKfHkpgabti$_MEK4?5yoDkJXjE3DqHr%W^LnxV`qR7a zp7V>otIbpGoLEuTjf~a0^=X7AWCtVzJQG_K(`8sM0NBBXp3?c@@T-OCUtKGU6Vknf z(WbUHWgB60n$*j6IlJ#yfdcu8Xy)4xGHLwlfGox|bqDAN3ZQvfwWKqJ?ePos$eAS^ z)X4mfr9(wNE#HWDwN(*s!RX4AMP+IV;A+0qT{UpLF}S!0;USx=Gaw>&mOMU2N@~b* za2E5vr8DeQ8^k$Qzyi;WWrWHQ0Sdb;6Fl=-kOvUeJU34OWg-!(+Y(irEL9R>nkUb; z>I?^wGl-=gh7?T!@?>rDc4wKO_?PcnJINyPw$%c=f2v#?eHY~rgW5XEipPXk?1S~w z9fC64MT~&u@@tWf*|#Sm@9pmgar^4(^oLA{>D}QcYO~Yn?E@GtSy`eZRSJaV4)KD_F+yqb}XD2^pzVTXxDm_rt$pD|U} z-3pVvT#3<6t459xF-rHKE~rxDQ6I4_y|w9y!MD%iBMX)qyc`SY#R#Rn-Lf51Hrt** zLG42_2c(MGIOz4(-BX;+(%nq$v2ofVmG)lhAye%6DD2h&a($pf-ik60(-l^Uh6P_x zAb3l5ZM(m&QEJbnOXsB<3tayUC_QHgE{GFX-`#NBl?Y4)jLoP%7t89FN)eY=csr!O zUh53Mz#^y;<6{sa2m3Jf#L{j#txRp~=g{ECgs?8Cf)zw3ikTtL7`{T&BPZiDmKlzN z8t#Xo-@?_BY>_15)<>o}r%tk(T#AFOd%twd#s#W}_X{xDc(E(9oqjmxt87`oy`*Ih zg@N3LL>KHZwE4~HxP2ur&eWlrhr^p!vi*XYLHQr|+}EyuV|;|Q_Wm5WvYxq~hr^7} zxgc8c3xXPgYO=T|F@Dev>jU$p@WR`PuaVDqgNi4 zP4>e~3KicP41)Hm4d$$lhjsa7zjXk0_#SlAkht^E48D;TpbyLqCT6m$ZL-w7+{cRWi%YKlQr7vF|0JQSn>F6-QLv*Oq19U)H(2@6TSFPaE*1UZsxsp)x zUYT-PY_XJ@Pupr73_AJ zX>@TCRFgs87ayM{(mzpJmh@;Ai?$@lx^iN*JSmCX{gE4(ILNz_T0xAc^;~ugGpLN6 z=6e=i^|}H$QWbO;gSgb3nI{=km#GEY4l9tyP8pW483O@`f@n&tXOlctLAR;Qm>A2p zxwfB-N1(H-lef5Gn9uDWw&QVXKEY+I8z_LhEQN+M1S9B}gmwL0v3Km$O^(h# zROzEpli8y=ADv7o%9U_kWtO-V|KEzL$u|4bNm~x0M3F0iHCE$2va%*1J<=(lJOD7d zW$5Rxl{|exkh!cT2g0Z^02+ZbDz?+FVg5CTlv)G|Ms?ESJZG)O{7p~K-uY4o!yHf^ZS+7wQM3ho681b%dKLxfYKdE zmlrQ=r?EE4s^*M_UvR?2>c}A7JvR%SUAbVm3#jIOsoY#cEVNM=`WRKqYiH%XsUBnT zr||O?QIsOMZLik;4mI2p(Am<;h3F* zxvZ}fsXSsw2y07mIy2^s|RIxAlXRiu@anLx0i z`hD7FQ{*06g+$aCNo+JL_^yiQNeqN3f_N&_34YVC*l5;!sQ}dy8HQ&}JT_t!vzT)i z?;Nc*{Y(HcOAlK-tvNZ8gmZKVDN}!s@;88O^nTA~HUSbB-qA!38c*}ve6K~KZLaut zN7I?KTE?wm(Sb3nfUg7mzGWV}byQrPcwUB6kDw0z*>-tnLSbW$kt3CVO>cZxgc)YK z8EHZaj-+Fsk2vh(0RC)?u$KH5#&DswS&)!ws!5L1Bb?Awa~i2s*(UOM=_O{UR389T zf)ts4*`6u=)VHI4;$E&zZE0u~s+srR78flmZgUsHgliH4zqV~Y2&#wws)*p-*{ID^4;4Gpc z!i%CpBN`}{5}_d2N1|bu^psRB*Os|tyg=y|jsg#31DHq^qG)&t0RLpuT@QLGja*M2 zF|^r8CWXhx)l#*`Phe090gyF6z9(T1x3D+lv!o~0jZ8ozndUVWr^I>Wd1t((kc2h& zPJgCO-w{)AG|V<`wL}G&iwy~KUel`Tbl|694NT6VR1PWn@vkN?Xu$|!4vwSaGpo&Z zYl{%q_>g%duZO&FEA?t zQ7d2#u0#f2UTRf=ln+c!O%z9=Rl{-LlNz`Po8f>~&8PUMt$0X2=>G zyEC{C64iM3z&%!Da*eF*P^9yycHxIyw))d5$OQS4PjVX8MNiT-ozpC28)i@l-CEZK zxDO9OaE^qY!r93tW`}}{0F-Lt=ov)nVo!U7dtmR8*xO6v3_rcynf6-3skU_%jj|zjCCMf?u)CSf`L4UN6XF69@<4 zv$NA_wQI+QO0<~Ux!OKA^&74Eq%QT`xhi#DbxSxuE9(6+rtH=w-n2o!pZg$_C*A4e zAmN(LPT3YeCaHIC5AUjuz93w7wP)FI2G;8;EukgYeW!!4m&v<&c60b!j6$%NH}M(u zM2_7?y1#&dh1eQ8k@6&GexXvpU_;d)Z{+PAamwzc^LCoaR1iO{df$th%m{JnI>o(3 z$d4)^FU{}$qO8W=Ez;;eFmyMMzgMk|+7+74CcOPyyRf)c`$2RA_W1eO`Y;-Ckdtf< zBQo;Q1LwfLw{)774j};-w4b`HTZ{emM`KHD&9~?}*<#$;$uU~ouX@v1^s=}5`5Ge13ff!jIf1(MiAw^g%3G}H$ zM#`I{0VghMpTWe=4m&1_!`0@v#VfmE()X+oz5X|2`SF=u{5LDKa*UrAVFVX=yWM_0 zjclEaHapquMLrU#F<^T=b*r5>eYSqgdmm2k#9Tg8stg47Y>0g9TQ(3|Z?}hzTU^c7 z9Gv4SHVdb@e^O^%pkH$-I&Ezi{@zBd9$D`+cHU9@B zI?LJIe@&nNn+leN^FLIulN#Gj`%ORI6}>$1vmue21Rw@^+d1c|N$u*!d5rZRq*+Ub zOiEmdk0yb?3&uZ40H5;Ilzv&xmN*{b&*tFOvyb`|-_!_fzn?KV)klB*py|```l=iM zELJb&Fjv|p-(*-iQix-fY4doyh#{X}%jbF&b3~!>O_PV`=hx9Dk4Y4nXrnWRpU-z> z`-?&Qsx^(%WJ1ok>2dZ~OIC>rS>&gfniF-x($w3g`~Yo;fla;hT6O##E>+*9=5_Nw z+pVt4Aq1Jh`b3FDCR4~RD+4IOgu2tA2zy#Gfb!z1o~^4DTyle`mTiS|nVXX!vJTy@ zqBW5a+Fpy_`@B>$jn44zUHi1h{p6j`HuaUV$?s%xFvPmHY?w^cQ1Yh4gD^9n%xXg` zfOyMX z7t`S{|1#B;LwdB}t_4vHLtcxvu(owp&eyf7_36G~PZUgs5xU$JEZ9FqAHFJ0L%_p;A7;V516Iq5`mT?{84Sy zJOff|^$Un&2l4X5J?vgiCkz=AM`wm{{MX`$bMqIA%cn`w+v4mf% z9YV$c$T^oWg2v}c%GPZa#Fh?Y0`W7}Bbm>VxvaXAvHoU+Tzlx4uT&xV}131mlsK9VHh(U$WVV36LiRkU6=22*$J;ncGRk&rCp%i37rQ3yL z6P4NROFgK&7D9&WWaTlcd;HUn2QQEYcEIi`X0H@*;@^mehNB41NED8Biv}t<5A~VJ ztZAp@JVv0}0qGEh7$r_lD~xSqxd@!L=_KTmOB<(rPy=Jaa4RAPDu<$)C%ce|lAVYHvx3ark>7qJC+F zxeL8@+Iv>5{k8xvS#NSSN6pYp+cOXpKWJRD%Ws36qIHMW5bhxbTR}04;bY=b1sA6B z-{q8x84_1LNj0=y&UZlcyFvxP9Oyy~?k0!9?p8xK>yuWwYVYJ+77R?F1r|LV_Di>f6QJ)2CRo0#RW9Pa zlzV`nMCpYV(;0Z=4AbEsBk&@JABvCDpOT%Wmuahx@}20k1!gm9%5ZkRDj!YA+H5a6 zKj@kW29oVuh673AbjmD!Gk}R(hionh3d}MXKiB!-5dhLSu+YRDf+`)G4_F+EkcDD| z5E{+NOz%IMooLe;W=u7acx85H0sr%%B8ijft z6q7z)=N7kd^`UjO`c13&AG*kP;5+Yp>+)RC|?Xnw*iJhXef z!(*#dA&EM_uV{^hsBw=me4y-v`8E`zAIE|jeOttd?s<7!DT*qfCe90!S1)*gU`x9d zZ#mr0BTnOLI=ciAK^$CPusl127vI&+LUn6w|C@1T;4a(F-@R9rr>}MK0E5t%NDp&V zM*cQfC;+l*wc30i&P9H_+~P-!xgt;Ne{rh<(q`P+MvBezf}X-1;!K{J$prJjuCc^~ z0Mx$Lrrpq~5#m;QSACc5_KT+Ab{q+=%PV`u1Ag~*8)C06LD}T(E$^aZcI|P!dUVsFZ5dxomw^_=dg#Q$OJ9fCxQmM+Y)?Yd>#wq140wr$(C zZQHhO+qPZR_wVRIzlb+@vok&sd*|AjE59{Vjxo0Sus%jQk&yeWnCU~m4+LnOZh<}RHjZXo*)CU_S->;`XqpiU;uFz~ z-}l-8URX(IONlNCmpGp-3OnBG6JTLmrrKPW?;xYS+XLp@O$yLr)LKqIQ+oHZZ*%60Vk#zB1 zKyT4~|84kW1|yt*4>g8>uRWH|Q;QL@27ZrI@gXAimz(#P zW~Jyd*n37$h^)oPf8L4ih9k(0Sc@%N`^l^uw?j)}$AT+pDdnZE8FlS+_vm!bsbEbBiVx zuREDY8V!}lg=Z~hh$t{oWbYdN#8?_94OKN+wN@ae0#@ZcWg=cbL!n*Jb6R%uqFlho zB|xPJLl#NvL{<{X;QM$XM3RsI_s10>069br2iL~~JB;ST&=bXq6ts2H|LYe#2=Dgy z2z)568REMrdUIN(c=g%O3eo1(O*+E4WYPmKGxTmLea9Tj0$4BY-@nkLE0F8M=D-Rv zPMzkYhWALeSzv7f9;O5$CpFDyHxlMYYvlBC+vD@g)XOy`do|&fFi1rHT!{Ml&RlsuZ=xdOjY-~5)vFm$JsihO<*ADj-`Lx1?=}E zk6$9YrJU(2M?nx_)pI@`&<-ZW(D@yp5zHF@`4*2DHKY?GXQ+A3C-+B{d2<=hMH3nv za)4PT97jkn1HT`eWTi)gKsEqC^BanXXtV4?-}C5Srd!-5SOi#Ot^njJN&v;XNkQ3U z4hj7+QwByRkn_1LYUf$$rKW6Li3o^@8K%dJw0A1qe$q-tfDuV+ObFR_=fN8^KhnCKsUVDtX2`V0rYFm;?OGqr^AdBakxypRhcHdKYYQS! zc>ve0iFlF|K;@NHSXWPgf&n+=b0sol-Bjil?;scN!bcz~Sz-csIDq#@ZXo#a(@?CM zX4>6^XICpdCXiC`xbD$}37Un3u+pT){L_zuq~_$$YC^2&&uVLZPQvX{yqdnZ_!o7l zGNl+G&)Ck|J}&)15Xep+1v;< zDKnRkMSor}(966j8rx^KA?Rn}bLdgOpLm;W>$5D4NTaUr-^b^y3kOZdOXUosbM(DX zoy&rM;_W2~D?pJX_Y}r#1G2vkRV*ml)`72kC=Zeiv@L$;?G$ob{2;J(`dpTHfzHFg zPDrWnxNtVE2hG-ZwY5;Dkl|M;jPb`}zO81wDO`M%<(;GEeb}?Rk9Oa0v$>Uc+5 zq!f#M-QSptTjNs30E<@9bMfJ8N`@b|tB>4%oZJUZg`AlsszP-#ZT+Y@y^i%pJoJzb zEy;xZz%9VF2<0{W%eyz4eOc`i_lLrO+Ox5>Tnd_`Bh$A>FX=7n7#Y%f|FI^nvu1Ak zPLyWydMBp7=cObHm9`v&^>L^0eJQ=b;-WQv4ams4tHp3$AZqXqX%8x6gjA z$J&uDKkY6B?sLMcL)cHDOPDu~KxmoU^G%dATlE_R)?YK>9izNaN2Fp^|L| zr$8HQozw#?X6xqR$A12tEJa2LO8VE11|MF;;~fTDZ)-S;hIr*(VS7WlsS4DV_I1 z<>?K}=^;k^8!w3(Lu*5rC6Y!s+;C=Kk2$F{RYU6&4nZO=38kCaX<9qun?sVcz+Q`X zb5N@4+a8H`v0PCz#S-aDmC@Y!S&&0Q9C^B#Tw@|UQl0$qM8Z0uFlVhqmYotrk)&_p z?9WXEJo>zHk-*)P)<2uwS-D;9_-m=tCBd+W<@##X*aT(%r**o~REG?&BU2PIMO@Az znPs?lqt_V$B}nn4+c%dhx1vLmvU_UtV5Y4|=zu8%;&Q-5y0f;WG7jtxyL3BJHY>p6 z@Ta9!V4XP--}oodq_rc*K1|_U*SJs>lu+7iMTNoEylpnVdA48 z+oMdqO=QP~qL5&@eFd#eBp5F-vCdhAP4ln5fgxRn7itvJUsMGs&sB}Os6+NNBSA#@ zpKdRFUKEcglwUos~>dBSAr? zh%|&a*$Dd47efTwejYm;Yy)7PFMW`a83|!VACwku5v2%3i`iyS(#Y9~lAC(6lF0#U z@m7xYp-QkP%fM?%I>CiB{_-;~ihvluiNbTDC|;9Cxs}8?kYHj}-H8l)5Z_&tnpu=(q<}HyuPt2mu#-!5 z(L6NFIvtKiz#9zxMOU!5EGWkPz{jU|e+CpZmJP))==W^t-sPXK495mCKHLV!V!(>!=gz;~HA)??D+ZFXvgUH78GO3RbHj zO1QVQePHl)lnmSyP{d@d9Ln1^>H;v3M*;Pn?XEzDxCQdC76r_9nG%2=X?l3U)dJka@;2DxjTDy&N>O%oJh>n zIXSQJ3>V&KrU&1@DMFqXA+s+M2j}1ic})V4zrPBB3(_^TdF zpJei>J?7Vcy+t}yE4(%&2~r9s@!)tRjL~*!4(4XzN(gf(;Me4fa-;6Y91LORZ0#SS|%CxLG7-Hqh5z zK&g=?gZ%5{By_E=P+R)1tBX+=O4+6{7_%t?>38JZmec$MI*R&kAda_Pf zKlL0)29g8dKldsDn^7jPKU5K+*1~$BeyBKsV9IZaaKB#m#5Ydx$#dm!lL$!tAqpy1 zXiq-Yx$*2#;)kE2>8$|ni9d)kg4J_tD6q1wFOtcl&dVY$M{KUjXw&f*H3eb`{~sh> zo%vcg^jc~S@n@sCth0+6EypHPuatC+cYYK|PZ9_1Vs9(P5-y&896`}BNZSik05^_C zfn52mY3~L;vc6sYHSBs*Ud?~tYlsxbtZk&$TPR&^@$SmaPLDG$EhfOxZAGYriuj}a z)LREMkZFr>dDT{%JK!Kp*nBo|FvQ?Y6{#{W-%*pz>l^a=An(yccTK~_^KEY9(2+Qh zX?ED$O!GprGr}k(xP|`X#~ix8(Co$M_Oi`;U}*B53`j>gsXtNT>cbYJ2#>CSujd_p z;g-?$zZTQ~4UNk2pUZC78d9-`tVlh#wRhIWdP8><35km~xcn~-YI-k8GXjQ{ohs0zO_5vhp?)DP-%QXlhS-(&G-O>R%U?;LY#mLahIyRYVouLfJYGPi}8nb-kq6 zK!~DQ*1J5n5Sj^K%xhS0Uv|-Tc~(p7Ic%jy)C7h$t^Z}K{J8M0YEnkZ4!(rC{;t^( z$_-N@So;vxH@Wt{sT4U##V}Mb2m6ag*nM6BlYZ6FfKtF6n?vJyZ(=&%yf(T+zBSKb z1u@j~eOJ$z=VOFdY$V;+=UxhRhN>IJQ!=qt05Km>{XrE8l7_V8i+NiGZO+l8WFC3gv6x)sba8H`K#)YB%log=CEloDzU`Md!uVIW<{_KpoU>cSCWF?Dr@j zoMS*)uFa<3csPlT)=!U-R_iF*(vC{CEH9OkKMQ!n-0E{CI(B4M7p(H%>Aq!=r4NqW zKX&45n%Q*Q?dGsCci-|MdHp?;GjL@kKg?bF@7&eWawSL$G8TqHn{g(;Ex z)3g&sHG;aIm%wU{^ul4O_Y+WG3VzjaFX2;~_EMH}l_!bk?Bzb&^rZG!5v|%c+SwN< zVmM53N0rFfLn6ceJ+`33iPsjtaZOq9C61#oCI6x>FoI@}vRoMsu|y$j4JHq=z>sQ@ zecsgQbO*N?39@Hc;e3@P0IYL-J5P^3P%8Rc zGTLXp-cfE80;SJq<%Qq#!NjuT0qz_E;Nyb|Q?ZTLX6n1zT&Hw-XC_8Q+X@)$D+JeC zQG+DPkw$iGX8KdkOusqYfVsx&g7^Pn7*?qk2Amp{bn#}3I!)bPyUJepnJ;I!--V0$ zrZ-^$>Q*6KvtbvJT?Yhh?&SpO+i}o}%KZz6!a;k0kQJ~PJ^OrCQXgpCaeU+QeZQtT zbkol|1BhV-zWg|L5w?WygN=>z6x$vS9qtyU>taI8$26g*IS?p&JuB+4$T5CvZIG5Y zL-10rhdO(G%)&BYr6q_DXLl(8F@2XqcW z$seTaef{>fda{*jkNZpzi@b5NTeEJ~XR7u#dg@|Y@?j;MdB)5i!_+3i zo%3n<7tsw!l>n_*jYoFI>9fW2p{Qn$fN{2Xbq_0IioKQ2n{_@&tTOW3ko{`R5e+Zw z;jRxlZz*XJho6BcimY5H6V_UMyzc1MkgZ>StXEdnwDSpXrwudrqVy^WvW{2vpqJ%T zDa92YjG{B?am$i`U!NGGy|BkWLnVS3u}C7@_zEb$4rkl?wK>FU#e|ZcaY~=Jn=sK~ zjVyDckcmwQ^gSc*@h+0(G6d}L`o${Qc63;$%l$LNwmGn)E?H! zMu&&3_UUA~M4?QpnBO#*ZX{-9-_c(XLXqE*3b|rjPeSmRdE+ias*D_Fy&Dp>8%>gc zBs~05GHoOY&TVT&e#ER_I;R`t>aL1hN|H)MX0p%cHknYfieoEyje~de(#flz(b302s3v;#0`P{(fGCtUFNe4_;!$FwmOm zq4{$oK;cAO$w!pJNKUa=r*o1a3v=(%=wiNmrXla9oU-IJ%!3^EB_39w*5W5}(!V)2 zc^hVUKnMIwopT_!y2`}LAce9Y#G`6wZnrC5C;mx3e(J+M712b~;gWO$Vx#M$#nxhM zBE|`rfCfsSZn&ERVa|5qH8G)dzmx|Fq2${h@z)tHw=_~6RuDW9fn>XI5!f6fhvW6K zUloFJ<4DeeU&A5fK@qh_sC1jLJ5pG;OR6?g)IQZ}lt=y4Va}9^IL5!X!Jc0CI#T`f z_0^JJozhgnv^oI6J~cS0ULu~jzt#z``nbEe2~=+Ah%r@YKQg`=_@sJWt23qAZaX^6 zLb2a+qD~dygsdFMj1PW<~U)Xl_Lj zr`CA6{)<^pLW?}nvo=<(>C(J^t*BqR2;vtgk6~BMz+)J=99>W`ax`K~^8JUEmNvu^ zM>0AYsyDTUoiighAYpW@N5WMzr94k;!QKl&!F(zVgwD}6%!NZ*W6}pj8aJLE^I&rK zYh0}9XN9zs<2dmw0sJL$roSadu+UGg?!(?q&bHw{XnpPAv}7diR&G}YBnbxAMdn8r zUD2y9(tNU{+Qfrks9> z+iTMf6&XeyhOvKr8D7(GnZ9oSMWKoK4Rah8f5P)GK7R`F0_Vs1k6kK) znKJ-XXEV{0qW|cHFnyAWn29=$pfM}|88&PSydt{}UL-U$sv}@JJsK?xUhORf}IN|6C@w7MQ#e^x5CenDRXN2QA z7c%m3_1NW`;V9&O7~XcPO8}55!59{5$ZeK!TWVd$wnh+H!gr6>lu_2}(dMzX_X{rX zYVrHO33}%Li9XE8!TcY#plXfneBjE}z@?x`~GY*mYAB~?kv$dZ)l_>6R4Zh== zMaHblB@rpuJNkZK8wiBO32aJoj;G;+P`jXiK5Lpkn-8myd>K|o4E{PeH)?lxYIXmF z*Q%+nEi^12Uq_^)A_pg%IJdvcswA6y?@s#GwC#x~L#{&QuK8bxsu1z$C`JeQLh0U*;+e zsi=$3sEVjFwpsueb$*ystF7$i%JANN^@w8|M@aSq>Kk%V$Fm)X_v}8q@48S#2%?c3 zGDXyWQF7=OL+dDud2D_VMQk5E`{>pRAnPVfsel?fn&55J2o3w6yvXpdvbU&bC-A2R z)1N?s_KVPG_rF^zn>aswNuo6{Ha^~aAe-Jdl(l_0(hf?n?XZ+PI;dX=nsra~6Q?_9 zj(Eh1d6|tI9p4FxUr#%^c7j16m8}{^bd^DAOZKwo)6ut?J`F>Gib{Y)IM*c4?7TJ# zZJ(9kW~d6o9v8K1^D*bb$@nh9Fe~1Ei-r0uY9&j*z&6NLRKXe$Cl9gENpjiC??#1Y zT%oas3!0xdpV~UzE`dMz>1I@&|G68B*BPOECAUmOT7C$?v{$m42-OR(PFZRT+CgunXZEQ!L<>*E9(yYl`fR_E%UaSFkjs1nSJ~o#{)1XIr!frWT#6kH zs8iYgaFsY=sD&1gZ3Yh`h=Of$y4u)>2t3M=cr;2SjSb4V(2r5m-|08~?@-*Q1&o1F zD@(Q`n8AX07|-;I;BL_htGOfTSGV|#3z~^QL;XBOFpefHR|-2h6@$2sfbWCeV#c8us;#kyMfaPhw(k&fIu=74dPRg zxb^VbS6X+QckO$Ex4Eddb9e+|v41ebgwAbVC;AN1`zC#fq!vJ72ai$oXa9JwJ_+~c zDoK19kD0?F~QsFC=PnZ^;;Nwvv*G<>P=}CxHd+bVG64DXViV zQZDOlbj3*F9*fR>}?2yJs#rW&!+J2GRtL1sj*PT9ii&_Q|Va56bwilVFO&nyRp z()@@_a9X}Jji_T&=gD1Cip?r+eky(xfm6ww8P2kbD5V5gRNinRonrVo$m^rT46=md zw@-w;_`*hOtpm=2(lNkPSUwxf#6(G$Z$;x<>)oBq>C>0Kda&o5gS~oIw6TR|GMH4} zbR;%sqB(Ij$tCom0@9D|e9|nMdy*?}cndY_%}B!NQBqEL)en|Hg@P{k%~gVlD#hoM zb&AyydY!xaJfkJ|=8i3YL+%4!fq-!%c&^9ap4so>gd|#%`7=Wy8ar)!H!xC4v!u`3 zwe{X=m~te8-gjZCM55BBB`JJm5_&^&G;)e67?Ywi$wlwYfYAW#W-;|I<_aMK?__5V zCfXo!$_qV-LNb4fM)^=e_xZ^ZHW zm@5n4wp7lY<{W$n-jJIDX+rn}jDp@)785{qfZx?OPYAdm7JRZ_s_Jgs2s*F>&H$-}uwX=zS z#51X8r03ZX>!leuK6&+uLkdINunjB&86#4k9!X+Q4+5`Ji(fWU?7&ZDj|d9E&EJfUCJ&Z`v=2xX1Bo{RZ@pp5%w7O{ zvGwJHG4jzN1;kqpO;i!rq3GWmXQJU}hSvpRQ!v0)A_n$OZP%xIQ&%Nbyqc(!URsJ@YdEnx2)+|$Fx_0ybm z+a>9#1)RD;6Z@RX<>I+JUy3DQ>{gU_Lfr9 z4m}EVk7ZrRP1#MDASiob@8IDaPGmcDI;*x3e4O>P4N}Lrn9yaRp$vAw^GBah;PZG4 z$G98$)DQ@LqG;{E_mn?A{!lc(^ZBE6#|UZLO&I$Wpc1;vvj#gw>~B+4f5YTjwcliN zJOHkR^IvoUz%<~R@Lneu73B&XY(9R3EzLrkYYu|J0o||>Au+f?_b`Xt)MW_jWrfZP zs;&${Y^M?XH;qByi-ncH(;;-EZmr2TVfqV;bkLbVWa|r=_DKL+>VL@VTqh1MUO~{>Y#D zUq}kyfzA>_$VxU$7zc<;$o6^6K$9EJ9P(RY+S@IF9``^~meQ7`>AO9>Kn{kYT_T0B ztvTw^4c`?QIl{zVFK!~}dilD9?EB9u!pK$|0NYIpXZHeJ*5lFldoXyXM~wqauR9bL7OCq!dFh<`;j+{=InA$JOG#06gUfdQ&kFqd4RHHtQg&+A2u$jSz(u3-)w#Q z>i34_oRgA?72~0LT^A1eNPO$E=3`@iuy{CUm(+=Mf4fvBHOtIub3cSUI!yJHMN+YL z#rnhK-Ru)$&%H|in*FvFveScu=TbT#j&y>0{oJMHxnGn^igGcuh4b?6%vB;hjciKV z)I)s?AYWkluxXpxwxW&egW%VA#{eNFT1f;Bm}k`A1x?F+?mW># z@NG6`>aO%;5 zd(QUNhDqJ>&IFf+YTkHJW18wR8?1m~(R7=u_l-4%TL%EaVvR{-_0;U+q-JN8O;L=z zdSmRQr?;b`usP?&deiy6`<5289Z91pd2zZu=TTdGb+_0-c?J_r>|{QcQEQ=N+Zkt> zJim&di|8C3s;(&i3B@qex-1aQgA3-!FL?I@7#ZzZAOGw7BlQ=!Q`%MhziRmZDb0d` zp5s6A%BI!iZU5QGe0FOQ>Ov)j#va^=NkBFItknEr2mPFV*5qCVqR&Lrt=bbJNcw!f z$m1J`G9$8?;h;d{sBwBbKi}?Sr0*#F{L-NV(lYtbv}gkHO#3g{xB)~JQv~TXLE=FC zm{BF@CwGJSv`sHnRuKh;5RTl1gAn$OwM`LY2RlhU_&!+>@XG~_^EwF_q&{0~clW%t z0wCq|%=v{SkrBGDxviW&DF_oH=`U>-x-?9F%@Q!tU0paQ*>4R=k_uTqUp^;WZRvhnaEE9%LQB;CaZt7#D3Szy<_{6WD2VlL#03H- ziE1|t%CRyhxT&$TA_4n^$x1?<%y+FEw&3Dz#!{+=_XsMV2V(4oI8xb6x`e1BOK`kB zoiDAnX7Ru#Z(RsNCZ$+p$tm~SRATo(UUhvu{RXSic%{t=>RTVX%vOwDiX9hJfT4LT zwHBCVZWdi;Thxv}Qj{Wt?~TOn$B6+uA^S>=I24j1*V#{Q|{`pXHQ!9bm)di`UNof}lo! zZXhoXrO(vJWTTA@FkTYVAqaYBu0L#lk3Dk|mS~UcoUVB8165YmbpJ@D zXj`N2%P4Q6P9&c<-Iq}*IoDWT9HM|GbGs<*`}78v6H?_m^YXCBGukF9XF+zc*9b_1 z&8|B|`gO~G;sE~5{zBN(5t9oOd|z-~PxW}N@5X(29W6sz{8`XDd>;dlk?!6^nF3!w zk0Lz$OxRycuwSB$Xdu3vU@ov(eS;7@Mz0({-B{)Tjk1>$vxwvq(fqnxR!QyA>x)@Z z8Oc@FtShWWyd;u&T(tD?ZDHchE?Ev|p_wi}5|=qtWR4ay-?$NDaM?V*9`R&zL!3Cj zZlMpVKU!DqTStj?kTRsk<=u=%1JCiXe_I(5Xgy%)q&lz41;Mo|C9k#aH!85H_A5K@Sxl zIwg*`mAE2&ghnvSBBf((^?3-ReO9O?%n70~@7&Dh>Q`5}_jj%)2ltYLfzXxE8m3y&Z9esy}Ae-LdVXMipSoyZz%Vf+-@&@Yam;ee=z?yNwc6@4RmHJ*>O) zJE{BiUbl<)$8&nsw{laA@8f&FB+sLp+9r;4OXg>U=i{VWx|tC| zu~85M`E^Ff%`}fgENM{bzF4ubn%7_;(;_o7K`Q9jeS(v%SU@tvXafHDUQOdWH_~wZ zOX=#ud)wQ?Q4zvsCHB}m8Cf_?RIn0sW09(v41Ec2787M!10!i@;0rG)tNy+P%+>r- z2pRUeD?~mj?Wht6I~n4&kYZCYJnEp|+O!Ld?iGXE_ST2i(z1%wsv1H6DM954s(LI- z1B{_?5E}1Fx>Fm_9+H%I2_f2HTUqRMNbT>R1%x4dAYZ!V#ql3kDWB@^=8!AvyZt9O zU+UK77Kp#);hIUVlD8A4vNbNrLcHBK5i>vTFIaNwotl1GAn+5{&#PMds3EU(2$_g= z%RoBhVT@tW`u$k;b=}^N-}#jrw!PCbVb^qVMz~wHcol}ARHRngtv|Mob-wQ%uxRT` zE`ZA`vApV^$ukB&&o_I&HZjWU!Q~UA;%Gv`h2j^yZ~AmLAnK{J93&Lf6az!s`)8%z z9%XDQUbfD>^huIF3O2sn&D!tos;H+tzEd3tS`l}Zb;{1F*8>MJ%C4NO);27l$QTO{ zIP7cM?Ut2S0T6^8vF=Wab~A<7>UBKCW~QEPt}Uy;n}cU_FVt%}BrT?iEo>+ZQ)nAH z89T=vp$$^XO*ixI+LKw><~WV6XDvH?H&q&f?(uGdMf739$8sx^=_p|oEO!os2qJ&x z#24xgeOfVHz!bc`_phV%5rQ(|5>`s-88YEQjZ#jx9#H&`-WDQ2fw`?JN*x2N94Cp@ z1lnGAUPg1TTvXIKlnAVq+~y5Y_fYgu#wxqo{(Lpjx&n^>OTQY~_?UCL>$AZ+LQFO3 zQ!?s?29T&1j))LgX?YZa3-~&8wT2F|SM6A*{It?!PxZVH8c6(;cawSm5TK^%%+b`? zQZj~c9^~CM&Pgd25U3Ew7;hyJ$Lq3%h!nC*O8c;Vzay_Dx-x^bhnz!5RsYla9PQvL z8K*GSHexje5EIF({7r@zz&!l%z77(B31(a`rXbu84;=<@sMC4nB}qu=ti(`B02k{^ z>-y}1-KxJC7}e!#$=~i14%bYBZ!998+W3{(*>T zW~N9OB?8R!p)X1o#KgoV9C6qveLWEXJevUgNgsWo&tA}vz(B=yfZ&sVDSO)(2Djav z05(pFmL^WF`)cqMue)LW9AMs#m{FYtRiP-f%Qf{`5k_L;^KnOzqAzGVW1^J2V)~CS8*_BTRtz8b*S`8F(G%4EnPeFXkj0|!3k6dEv4Ifq_dO40rJhRWY5=w_o=!HyiWNC`M~ z4f`ekz%pAbfCg@b2-dC-YGIqTG!d`|S*XalS;%`zJ=-)sCDJ& z4M8#uQV4A8R7f(6KB((*s$%=&?J!4I`5=nA)gnaYute-XEAziZYgX3Wix!W>QKLS9 zTri@*bku%&!ib{&!lcJw$BQQDrot5Bqpkn|Q-f850GVzE@E|?dg=~Ur5lyz&PP=XN z(mRafcp-vERJ-$kbm94&wMHh3lC=YlUJ)5C&d>}(3g!zD_P?N9jv>1!6t|bTIOjGG zauWKbZm23jzORV2_CiqTdOTG&KK z^oPatgAEzDTKA-yWX`?XPW$DGXVOB|TQ8qJwk8WIAe;1Y^I$9X8mR_lf>?LyjOvtF z$U`r=x%zv7O%DMIo&vCpp>O2%froS#B6(3W%N}830MCYIPK6_DUkvM(t$9xYmI`pIGAEtT$}4pc ze-Q2HD~=KUKKq!N-NV6Yv)BC9I7Tyjq)O~;I)FH`XK_Ge_W+_!k58Gu5^vRC3 zFFLRv*?HCADNG|qf;m`gR^uriL!u$4F;xG=68&?yfKyYF&${VQPzVc<^P&97Yt#ZO z*(U*l(<0DYyD?qw(?m0~Hg*u{k>ykCa9J=zu7j+Lm^9r@Qk`WWtHDuht~tD|i90|M z4x-XglKDLjqJa@Wj#f(nkHX43uGv0X;mol!Q4>h}K1~l34iT1G78iv>sfo8f?irwL zH-$Ya5ztKYx-3lhx&@eFiQ1pCu*UPKEs1~`q25N>c#1$M^E4@ArjBmx?aQ|Y`(P@2 zy`5J3chBIK4}I-r6j4242AR~ZnJ^T;;YoveIT08F12T%KGgA&czSxQU#T3{@jn1EX z5}aiIEzCUY4|%?7ZoZY)roNV%h?OtXn?oR(7;R6!{;c~JZ(pNY?@=LS#NryA_8cNw zoWi-+>Y`6Dzr+H!hp)W`xl938)-1wp&gb&;d*6vbF7(Y;VMP`z51;`7VbiQjKB!)5 zNowcF*K!;;<)8d5OvfL*6sHgZx}n0+d40>U;cyQ)N_SLMH$?daFb|lEEXP6PDzFoX zE}A<>N6u&-q}6Hf6pJubf*>y1Va0C2Xd|QV$UhG-6ayxjPUg8IA!MkePF?KUwtd%B zt1gY5Mq(3%p291oC&%s8-u=%R??uNHMi2(}XJ44HioZKpW|!e%&+sWZ92=W%Z>F|e z74|;MXxR+-3MdSS82mowAJZ#Hk%HMW+H8b0*&(IFkU{Ot=ZJIytybB^+c_Yv>rOSF zX&hS|xqeVQwjg$uYkb;vIZnp}IB(&?*zoN~ofKTq4&LbTqH_)}%bd>&G5w2Gs7>Lq zopD^-dYE9hq#J+%04tT^N8k5Od*Ph3$e=!^ zwk;f0?e5Kw{LV7VNT>M_qd9A3JmIGsi9lV6q;Nyms@U%tB19v?PI9`?+oz?*C?vWe z_Tky+8|}cm>)0#e-Vy%CTMEwng2#lGy@ZCG~$^j=Lw z^0XH+b751GsBTs6_irjS%=4E!%>Y}6wD0+E;nxh`9o9&+6f}8=oDIOGqtlS_T5zPl z!44+a*pzWy{Cw6J6{=Ii2oW1EI&S2*uNc_~7<3gL{xMhGcBW9>Gqu))&*a;x`MD4M z1^NhV0r;=l{C}g>voib#t^S`jk3IZ=eIx4Pp`@U zN38c__9>ufc4Z@+3}b{r3pr9+3-$G^pY?f@7v-kNSE?0Hk^fw&xqx@B?@n~mKKOOX z%my6wXI8!r7Y@Ms8{86Re9WT_HR)Am0(atVihTa zp~B-}bZM=MCe%*kij_Y9yx23e>9w8wU5{IF!a{*yNPPH3Jg>Y0!)!4X+ zD*z{#!UU?ChfSn{MNgCb5}9u`7xYGJ=b=)+VyV9K5Jj zu3IHgWVsE?)>^egSv}RZOgH$W8BH$)u`s&Tk7=WhZci%bo+BIjZ_$2a5OYvv-lK(` zQZ=6mp;_aWy9td&#ALc2Gs2&co>heRA%qw@T}_#MfbV;|vdX^RYi>}6;y5X}MlyQj z{Uk(A#{RRJsO79<`{j)Zg!suc`1`FB5Sc@0_UJ$3MSUXfcH<{~B!LjB z$g?V7*Pz&#K4*KYkao8>8r6fcvAj1YOHX&m`pg3R{kKK;wa=ro-tUj|M8em*9dBb7 zBN&9rLDb|BOk2S{4*9lo*9s=7D1H>es`a0*^?0mgqUN%P1Jc>}2{0Vnhavz)%gvh4 zgKb|hsb1P0c*xg#vP*D2w`1k}H~wx7&vmx3wVy@ZBpXz^XZq5hvc8pmxRmSl{O17F zJZ70NciJL4sZK3fW&*Wuf2`g-2q(p> zbOH)uWwc+s6W~E7?_UqMDYyrHMAIBkCMom|(%-Fu?7^eM%@E`mqCIs20)`$Jgio>6 zBn-;xWxdt~R+A$S8mL-?mJJ2~=kE3C_X=xS1%%Q_K?-2J?u-sV@5}kSysD6|eB@&d zi;A}(5<=Nu3wTAcpa&kxSMHU4z0EH>nm_N^NQ=R3+}B)<(`$HH_%U!m?^qK3Hbd&i zd{&JL_YO3o^^bP;=6MOog3xagbwr-px-(I5Psq(WlhX96vI)(j#X{htFi$0pap+1&z6Hw$VM z1CFE2hKV+LWVg}tv>E-=fhzh~2#(%qN!W-vHNUjMQu?=`SajeCg0X<^Y;+Y8__s@& zdQ6-n2wW;2xStC`wo^LcYs#GcjRt1)5i4Y+7usnK@2SSV>pD-GpK8%{S`O^aHiT3K zjQ0ovP4LyUVs~y`Pz8kn+ZDu_RO)M_5EygU2|=#`9PO3tm=$I&AJ(tr`!PWcm!$tlyh8I}( zK?ors*ZJW&ezySZ?7YugUl&xn?j+J(k9+rz469+R;UUm(7HsN=rbkF*2yj)e{Zdo% zxy8r)Oy8M51+y=E#yb&`MU6__-=|om`p=pI=Sr-3Wt&fT8?IuBlD!gC!>zZD~PMT3L)VIkU5)Q*`VwRA!*4k3*(f zFeoo|Rm1n~e#lA$q$Qpy1Vm5H*&HT*IT%EWm{BB z?L!p7{?%sAU*7);ssMzmy)Q`s3_6lZFEva9Jh|U`!BrS28DDQ%>AhdB61wf(6|(*(>w~Am?_I8{3iB*b+`tO1`I8 zr5N*4&@2T&=!mHgcFQU*pu>{0St6cIn*$jrpxeo_TJ!4-x)39~gl9oV;&@_t%BU4# zyw(t#IwssZ?xPX2b7WgsOQB*cx%tf0BD8vR(VJU2W^Aao#byHnxro*D^1bzuVcC-+ zCL(BjWv>Jycr9Fu?$i%m(;0UGBQR+l=tB)UQJscR*8vflom#FR%EUWXp04?7G0)Ba zxSAxWre~ojrmPK_>k8PFGz&aODJCoAHL-I<$XGY(p_t)xVwh+xYX><+D^;%=&6<+o z-tVB&jWE1+5ITtCAGP5aPh|sxFkDa$V3%tK z-Qnc1BA1f(eL~4m9{$l=;zw~VvUeLP7+*o;9VTFiW|~ZnkQgDpcZe6XyDL;#eu3iG zSebHg*e{N`)nr$*o}{~d@UL9~^JAjgBPjH;KU=eRSDs92nQsN=g~{xZ-f`T*9s5Tv zuf-akHl{t3pqwE`tLc3lT1R%exONAl$&--RX22FzyB9Slg@a7O*=51Z zw;e$F%Ahv)YksRpy;)amnzA87J`|A{`M{&UqA6?%aLKCnqGX-?S*tdJ3>)Ft{b(QB zLuFc@L-aoKasxQc;KtbNd-a96<}+Y|oQn&0uC(0m+NMxnI18c3|88=2V^dSRN+l>7 z3bRuUxkK%+Lk%4w9WW~DvvYTM-6qdYkujt%T^bxT_lVW{IC+)d4yu#;XFQfub*-SM~wI9%};rvwE z`xUXek$ySZ#329>Y0N>mwj<&U*ep|WM%M6`i=|-Z{z)`ngJ^;GbEUR~DS8{+{`_+< z?%p5DO%js>OnpWOx3bvo!khK6Mj4;>M4*B%GrWiUCoEm+UTZ1K;qtinFIrTiF!s~a zopTPazfL_*5Hit^qPLdpVG&>o2MrKVr6kw}+9Jn6JQ~FSMl#u7mmuPI0nww2$E(vu zZ<&J9LPzCw&FYyO>4Fi=;tVmOsm2kDT4iTCv5EO0jP;O_4;WnluCLY8uzrT740z44E%}(f+;Q~R&zmCnHXZgO-QI{53{+sw@`QM2B4DA0gsQSOCq)k?|e^E*F zbDvWDx@LgBi^C=ATQ%slyWya+>gg$7^*(BM2K`Jb69)A=KVzh@~_^2C`!hMUE6<9lT_ zAgfgf#|9))Dt6~#@Umz#cIp2QWAE6ViMB=S25(rYpkmv$om7lBPQ|vJif!ArZB>$r zZQHhUvTnQQw7pwfANG%!vk&y~bj!A;=4|+;^(8!2r5WBSwe;Q#v$keqjmGFZJ)CnB zt_^&)r+X2d%J(z1F0bOE71-R=J@ej~1n!HbCW4)<#|au@J=nY`4Z$>MQMwew9dSgA z>M^fwB_75}#=0tR>!HEx4n42AXjWUQn1t!loz0_X+6 z#(DYFwio?Q?+9YZc;WU&7s}+ybtab#sVg=-6=}cV>$}%4Hzu{hKH(N-1zU;QBD`)r zUs0xt^z{t>$pf$r6S;M>7NUP{5UKHL(wWr}n4cISg=8pL9|FhIwK|`;-qkmW;~T(% zvh`Ng$l?I)7b^g1(&l-u)>u?z3{{#>O~>)ekf8aF$YcHwb?O0J(H_2i-SYX+ zxbdc9jS?+qh=~6%#86UPZ}s98YS?y!b6mYDPa>RtdI#+qy@esg&8!b{E79E6-jqHG z@evzp9+Y0-sWJ|wTkl9YNr0z<%vy+k%DFefJ0b^MCVF5H9>KXuWT}NTxa(KkXT= ziT(}`x#*C*kif+h^KB#t6qOQ=<))ZITuO1l840P85#MkoJLB><6_820=s)VQ!J4~1 zkl6-#sdgYs1@#r)*p2YBLin5=Lh_U|@+dDXH9nXSXwrGU5U0wTI<#th)M(B0@~%JB zhH^=_qns2_P>ip34@pVB(rQ|>%+?9R&7Fr+M-G?AlqsauaU-1;`PyK=JCyy3*|J>4 z#mhF09XU%eWITV)@5C(o*yb$i6wlR&A*@}~bnfTbO@tU_MxwX1$IFx+u}zBzEL@dW zMA}aJR@6^J0qdKJ8;?SBfVmeLbL$xcK2L?Uo2u`|h!!$#%fL6- zo5(cYVSLcl1Uy5b+1+MQnNiRlF(xu`tExidSIX!ka=8`hsIDqqRkh zutMc1R0u0pA>0_Bwn!5?l8K9FzKs!{hcgLdF`*I

    `bY=Hh1x?}< z33b3_yIXec1VN6SD&e(P=bE!8x9KE893Z?_wfaCiC0v=Gf{l?ZcIlPATi}8nTCR`du|GqpvCsn2-&rvA2O~J zbSM`o79z>lXE{pMqg>EAoOSD5U1&*0@57%rx?mG{zfww20WW}-Z%1z8-rN=e1a7Zk zOjIy{cnvIy^FH_QnNs5Ik7`|6yPVoM8ne_w;(}Z_Qc+UDBhP>omLUMNJf8my6bs+% z-wnQ&8+H{R+g%Ewm%`_}E}%SRfU=8(;CJ3P5!k>|`B?%r{?KdY~|- zBfH%{b<6L&3s2QExpTRh`~A{f91{xzoBXmWi&-s~CY+$xZ4|%H-3p}}yci(tU2b%N zf+c1Nk6Qe0Cug)34X{=t>$Ez;1gFxH>&|ousj3FMPYtH|E9D5AB0A(3GG$F&nHj?W zX@&@RPiL=9qKc2HVXQYhiamPYx1J$rS#k|(2gNJgFbC`7Ms$7xbO!cFrT2znMb83V z5Uu@R3KBL6V|d)S9%r?POq14WqyHYb1hL0&4AkNp%jWX#&WgAu*>d}SXzdtv6zhRU zbc|(?iNRb&%Y7W`gV0KFJFFZ(c6lXF+6NoMu7HZ`Z)lI2s(z#OguMG}WwF`Zmq_en>g&t1a zw+pf0?5Q6|41IadkaurBDmACH;jtn71$;hj8u~*7kkor za%<>xR!L9y!ZIRXnY=o7!u`h9Rnl4*p7U&NWfRg%``uj@}mx1%a+4pHry zF3Hs#vq`vX(j^i2X~fiP6{A_t(@y0x?UGES)_(TPF2b;eU#F=VwngmGh1X~MPCpB_ zAGQ^CpEoRpYv=DJF9LIa*x)jvFj~{GhpC(TV5%C?bCpDdDX zk5W%vo=fpw_Za`x;Fx~3i7QIvFQ9@6wZLZ8vXNS`}5Qs=l)+Sn*WLE z&dB!P_ptl_kKlAQr@&0;#}2x=#>RQKFgP224o=&PhMcA(K~>89MR4K~kA*d*w%Y9? z%Su5*e|@T1dPkG=k`VXX#+R^%<>ye}B;V8~q1TxW&@HGX8y>I{QWC^v@m;qiEM(Xx!);K!UoqM;_S zXiI#jq-tso5o>!@MVfmeQf&BL{_(eBKY8DV1(?1Rj_2*bA*4Wpx@*zy#%d-i!DX52 zY4iQ#`4Jcs5k^Gvs~$uo=08TrERuotX~BpasO_1HgR^BV-OEe-(1XYC8?TAT(0b4u zOUSzPY97yNYKV;e7ed8pL{vSXu-!%%DxEJ*R?eQwbD|JO2RxpN53hY*Q<<3%wDpm_ zTi);-zxO6UX@Z>0SDI>9g>6^Xf{gUrq{T&0zgImVv?mgj!uWYmiPLiMK)W|0(VN1j zbCghXUy7)12x1uTzEk9TiHBYJT%wZUI4PPqsSnUF1orFEKYB`|PgCG4p;}om(%|J?nf7CTi(4gn(qLySgcDLk z68D&~w?Jn59oJxenUt#!#~5?>BF}>4Kg5EtiLrZo*>RG_c)MqRU}ez6nddPS=Gn=} zma$@~ztSS27N;j>Fk=4|?gyX?A7AxcL}yPN4$D0=Y(GVBBAIqnT}w?t(%>}Zv+hTC zaVt9utWKiO^Xi3U_^`BACzcG2hx3%!8#XJZH`rX z=zs;eHsWb`s**ugg?9t*H}{gvA?8*vgH93IPW_Jg^7{+M zmcBfTfmHbOGJj(Cic24I3dPNR*L6L2M~@rUc*vz4ne*N2KrH*!Ur z&8(Ij#Wd%uowagnOv;a|g+899CntJeK$l7|7+za8Z}GZaMX6}hYP{0jwq;f9OOaC^ z*aP&V@-1+NORHaWS2Cr+Yfm+_iwm)p>_BJ6&J5ve9F+uY#mAbVbDf5WUPG}UrK9vf z=F!2>t!W;}Uj(sP<9hf_MGy1WRUVg166cf>-L!eqntCL)Jh5R?yf5=^)JFJtmUcGn zB`|`TskqW=->OXSfIc7-vHkRW^f81m^^+bi)E6%E1v54I!vZ}FT;p5ig>ll*JNgq1 z3cBusLkLCsTsyL>hpD9zku?6jQ%||i>Gw^h;r9$*F(7ZfF!bw_0Ucvj>b+{{2PotN zWbxM-hPtNSaVt$dhgO8yR-_O(_KRp8DcpUvQjoBikk4HAoM9Q=_)h?euDz1^QPB!- z&y$jjyXu*XI?*MWhvmUD=}yjq8DO3`WU8o35`Ey9xnAr-hFo zfq?RM_5y(e6I$gGmT2n?GHPHI06Gu+KDVf{yNpRIR1b;k>595BC&NF8Bm8=n1BeN*+a z$$N?2fd-!72Xs>EfZo)aKOw~PRCjR`ce&D9h0_Z%zU6ofPvju1a%nhzn6fB2d!wb# zF>Vx^m0B$WWIdfJ=hgy#oX_3kirJv2$i#}u&eIXZu%*3~g~k!O+8kp5qm)L?hNYjU zA2g?t`*$3yK%K_UP<)>@tG;CJ_XQC}sj-`9xm-zK^;N0m<52fKK;JWR0uE}+vkNS; zx&6@gS9*Qyj}vC5l2*6V!3C%8D^_T{@apJ?dC{9))o$=>K(pPyir4>!gl1s(kh)1%@?9{mJE7K7<~t$yi#z;Hom zm5q)5_}O`;|Ix=eu7qdWYuim6DpHPm6iW&+Xkx z;Q{HcotrE6y-sUfrTm>HEtr9wcBciKq_LQc(rukywc~Ac&Q`!gn+->s(%L>2$rQ3u zMD4~v{cHCpz4Sr0bq!?ZLL#NniL8g-Ad>osp^w;(DxkKP8p({$S|o(jN{rz+472(p z)(XPGic@WY^e+H4^0j&I?30fLUvo1gfN5T8xta%BPf>xW*Wv?MC$2!ZgW%#-Tn7t- zo_1vtsuEF<@EuW&zG3;&IX#aZk`i%=80o4`537S1TJa1p&|}O)Y_@Q!%#y|NS?jc~ z>ZI-Ewcbho_p&gIKVL=n@MVS zUFeIeJhHH$=S4v@AL0(V@jRs;B7P{?aiO`l>aM{eQ!Dg#Wv%gi+Eq)afoTZ#XRK9m zGV(0Z#$U-K&hQr$E`A&ZiG=!O@7nVtgD`p3grfhUb2;kqKsU7U!ULg#CejSKcF987ZX zkE+Q@x>@n%0ce^ongoD!7>?(;4to69Li}4*nV)Q6;gJ>1ZKYMm+M15YPQ6Lqm5cAu z;fBmlkRn@pQLP#<38y*OQZ4q%ZjFTIhxG35s)uxqZcVqm7qJrLLW2b@+%Vg0m+sfT z!*jY$a^?dR{KNLaD(c4^E^F9PFGV#xcIEXV%G>n5L>JX*t;`=+86+45EM3kErH%lw zH>$tGrN_==UkC4qDos^Z#jrsnuo{sh=jnMJmmfHEN{-U&?VhcJlDM#Dlp%RLp&`aW zAr*2O-q-z|ru%ZvFJ@>rAohdQ#0e7+~xgt}RadUrP=zT@b^A~wH&+zQKH3wJU>Sb*G{kw^i zzs-Rs>(?-5ilF^jAR*FpwfQc096y&7#v&Q?7Z!l4_$#VP#`=5$EHN04oi$h(l9eV? z#FzQ&+>6~xKk7)?dmg2cHoXQE&Yc>zbG{W~Cl5ju|Ks{%H!)fvNg|KXC0dO;=vAcH z=LZ=CBIXG}cCkOtqHkLLg6YH|_3A|1+kBl#<5>f=gx9QcLBUtl<0gpqTJrY>hzB-x z++VAr;^YCcI`kuXv^O$fr4g zxr%AnTHdVTYX~KZg)(Pvr!}0iZJM7!=x|YBh`{Ome?Dz(zTK7+*GBU>+!znR1!w58 zXgB%0pv+jJnB+2?Dl5vBI5Qf^pZM+nPDIg`fd7s)SBa012JP#N=OTuBBnqovSlq1| zKKt-ZCT|L*^<(r2%+{#Z#}u=Bon?M1u<%xEN%#s5{4lSJNO@gEvFWMg;;*5Piqy^+&U&N1r?NsFs(FiEh5I343|%Q$7n``li_f*AOLRMvxB1 zAS>8o%pzWkBN_*U7O+fP`fn|I7D$xQ=Kf>>_pQ8Wj$GQ{cE@0hXwaY?q!JaR{CSZm zPpfggt0V>IfzdS%5)$jTT^O^0A@qVB=*Bi7IxiW``}phba;|GPVEWRZVUz9tBLCU5 zPh2^U5n)Ga=Bi=#arEdsXNsL|UHE|nB+^-Y2%;<%KLVlp5oqpIu1)}Fib%Ujv>*-#8S2p@81S$Td}~{n4ar(!=APt5-AGY!_6=<%EwhySTKu*l9RJYX7(L;*a>;V+!O_ZGP0~S z#RVUY9LAOY=b5L~Et-K0Y(~NM7PP9e%U`~WTbW0(jBVKU@uTY~2N*gw4xLQ#DF<*8 zI)VjJd`7(So7)J7yD8|cih)rC$v`~t3A_aFzlXt7AljJ)eLyl6K{7c-(23J%%ag+z zBZZaM4%#l=;qT@)gA#j`hu68D-zQz{`U*g|fNe0IO7Y3JA*a{z;Rh#h51bQIE1p_l zFdRXaOA@eSXWN{Gyt+oRQ=Trkygx;XQlq-SFng-O;sTgpQ>^o7*ZS!7&Ri{!wM4ri zy6kRH{Di4LbN2GGxpK<3FF9z4d0ufDv&Da2$FO{o3PQ)3;k|(TQRMspL6!!{v&>AR zGqdz~pS6+-Q)Sf&`Xnnb%T$@%dfDB`h_r%^$0Cl_&&q-e`Vo-{<(GJ zmYwXka~v_g+e=+N;&eZ$C+0_dZ03JQXhY6-{kMXG?SJDLvv6?!Cu(tDO~WStC(74+ zf2)!paJd!SO==}_j;~^F@I)#D%3RL!7Z}~v#m|%I%hYce8NId5<^^Rdi9KHux9&a88l4}43kv~;5eISa4kdw^0LF+b7R>^}w#%x=Vkub|rU4<+ zB5;fo!6uC?+Vn?P!}RXXUms*&l6Zn&_!1!u<@gsNNdba2N!X9=`dPUNw)Kz3p)iW& zvXz3ueScPyPc2+r^-y25p)Dg7Yqzxc?{ARBw)1y&tJZ_4f=xFU3zD|9F!NCPPq=hOQB}^rF zP+Tu{7NElZW{3lmCcV`L$LjaHdJ0k(4j8O%tkw_D|U= zSMI~LjoDd?R?UsTA*M3_L)Qa+_ZMqQ*L*x10mHf#a zGuCdV$t=WOWXuxT7l9sM@fbwE!%)m|0xTAR1Q_g?A@XQ}Bo0@0%io1wSnz#JBtrmj z_Hknb6QZAe6K+|mMZ95G=(xTeYtaHkvXHtvlYkr)0-BekcUA4@{%OWBIVt3=_|*`P zJbekI#IY5z5Pmk~SifAQuwH>`&m~W~@TS{gALG=bPObZRb^{co(6|H{kdIDtRhin^7GB;B%MCA;^)AK|^cbt`Y58vTw2pm`AZX4f>jEc@ z{rJDoad`-R*k%&)LdP0}iJBST(}j5qe4TWjd#Mw_C<)JKN|#Md?5Ltph<$&Xe6W=2 zI63Xg@Je%}wN+++TZc0l5UO4%y`%_^1qebjDCHwP`f%z6%MoW;?_cz|OF;>fs2Divhl&<3;?d!uCe1d=!PIUF>7VpWq1q!~=OXnp}TVEP^YfoPRAqk`2K)*tA9=X3IyhkdM_bHD? zVvZ+Odn~?E9`UK}RsrDWyD0C*rfh5iG-5nK_3Uh{I=f@Y%2gu}y@C1p$zSm-k`fi% zs(Z)t!PD^dBqf%xg7itzu^zmd2(}ZiW)0Ptb1nUjs}K5OmO1HY7;ZU;CY-;f-)5IX zhgP*S<07}*C8a;lvF6*l&c;#*rvb=0A)b7WYYv7vCDw+BSn8A0= ztay|h`eUQ$nOqtE}_|8gCkt4rB@F?hc~_g84J6zs1X zg})`!3QU0j)AI-Y*B)_;aA?s|66L?5-X13S1rlzgQl=3F0EF(1e0l~}m|}iqB*d^1gKJQ#X45PKp2k$*=}zh{-Hi3p z^6)k)17h*5iw~jV&+}*IXnP~Inqj0neq8ewkr_8j%2Mm_1SPV2RkExJiWVsN|_@ zyXSP`DVIh{WGVU;^8pMtXr4sP)AM&Uo#G<&#JKVzMX*K;$Y?~mFPo_Ef@^@Qw`b1E_@^K6NS1RN|h zM@A$tN`Yu?p+N?@#mGmUZQGNLPc;`QH!h^s3VZ^^9OLl8R;0pyLP^OH?^=ljIq+6t#yb&HFrkWC$PxI2br~M z)vhluULd=nwm7yN0^2kF4G^svHyc$Fy#t0+L3@Ip4xtP~*r%@#vul)aBeP{gA+)n)3VoJ8AldaKhtN4Ma{b%i)xfejSHl z>X{6kL0`^xymqD($ZKkN9=l-i<01&X=8U7_TG|pMr*2<YYs0FPj^|3^O3gIZJo zba2!+)}snzj0$ZuE91t}vN3on4z1)y&)L*LUXYqL5B5>a65i(bU9N>?eE%eL55-@# z1k+OCdUWJD4|qeF##&K^7lTNQqz&9RAbkTNQyXb3uBFP)$+he~x#vdbAEj&gx%krS z;w%Xe>v~|h?F?~kLEsfbFBjxQ8*wAecXHCc@fS%*}yuP!}VMw@Kq}9eZ6fPwIBcGPVnJu+%(wF?uMhKSS`{ zyf5MbatAZeRGA(OV6*8#r7w&>JO`(-!lpC3`lIBcnn4eaY|DBc@X_Q`AE9{3mzkrE zqizu0;qLJ{VU}l6Ln;Zo49=@qS7;MgWGZ$GO$NHVu5hl?W{UZM%v$dM&!Szw(yE(aU{%2T(u5=p^G-W?LFJI(Jt zN%t8x2ooS9kJKF{F9r?Ttro0;N*u0xOy@~xGZeuB^MjjX;Vat#ojPrT7jhafgWibz zG=^A=V+I)^RPQL{J6IA#E<(M<h{DCq&EK=_6itKs~orBd;m@b*3&%R6Y#i*-tRO%vO}6-km={TOD4!T&;S+dl-c$O|+u)Q6?Q1QD!L&1ICb1^*+w%>NK)!AS!=jJ;GwQ7!Dv- zI?wbr49qCI%N_iuLYQCVT7R{q>rWQjb~Jn-n0^wp#O|87k=a`U&4_d7$l-u6a2z9& zTdCUh?PHuK|GFs6#YoHZ$f-tab(R7&P%;J8dN0z@>784@VN>acXy^6QgtR~g|Gm`y zg+dxqYHf)8K}B~e1cW_NOGuoax{YtFMhbs;K{>sxl#o@o^Zu;Sxa!)=i!HW~t`L^1eHbGv$;E0)V>PNOt(Za*cT zVFt+UR&r&08q}^(e8lq-CkVcdNSeCxaRAjo=md{k%xRkN8p?W6X~nOUl?a6v%=PX^ zQ%>x)P?+!ZU3@(z3CM13q|1eJL5c;_3DB4F@%&&n4ABmKr3|rQrN4Eo@l#w}6!k(s z;^t0EtWXHZe$2k%-i&NW`{ZLHk;kGM&|x>(AvcTKDbc9{8iJ3is_CslcEF(LwXcLf zh7~Akox)EzOv9x^lTJVsyZ{Qe7U=lwR*T&z7A?ftNFN( zG5cEJW?It;9Mp`>_=a&5@1mHYuE8);kOicEaDs3p8bbhu@S_dFx&Ym+EF`3VJosXA zDc7oS!@~omTws*3{Gom>V_hR8LJ?R(IUUXci~R{v3Z%)L%MzUYm5_WTzuBL)AGXd2mhzSc5qWI;6- z`Pf!pg#+W7t4!3{8=s%l=-$X2{)$HsC`v3@zoZU%P&WX>Hqm?A8S#y3}oq+wTEAy8OW+aW7OrU@y|w@C7nB?GsX+rx7?P6i*Pl$o1A$QbQL6zbM22s)#ptlOR;p9-lfWMIWId7ym z)=oO80A${+9p$@v!6=C7Nn_7br~m%VU;i&1l}QvvUO$&0nR zjmo!V_0^jV2|IPPY96|@LGq0kIyJpo>UHPl^>}KnTzwHnUtb#ruJr!JA`$)M?S_Ch z(12gBX_`Ub#dWrHGc&E^GcLZ* zOgfS-T?7}{G4tLK0Ho-qM^wijgJrgYzo|MeK6@g?WrOx=&UN#f(eVCJ<1jwIn4s_b zlaYX&bc1BD22j0_vmK>s9at~4i*#-rUU9lN_8XN=+q%hwsfyhn00^U9*3Y&fTdp$8 zrQxULeQ#=Yg_8_kXk1@wGgHPEnwQqECFQXsh9~c9x9axo+u z@7e75IB*y_`m&Y*7d@^w#*fz&hATf`3{wzf_S4g&<&+q$_aR=h2H?+zpx>zR`H>Nq0BMp8Dg!oRM-{ha z>4Zm>CW1e)0TIDmff8Ijz8e2nY(w17iBPY<582)IIs4spV0A45G4{y>;Hrk4@@e9hfu+h>8Vp0O9^ zv@cnCWqEwTf>~EjyX6o<}Z`4%vE|{M}re$as5J0d^+OuDN#r6@Z^qT6Bg(h2nF%0z(OVe>b!T7rP_~Wnu0p(v8W4SJ z(Pi1VeZeW)!XrR_E2WfeThoiK?-zSE2n8}CpKJe>dA#QwG#fhGLYG?;bRsqoR_*Ml zP}@S+ACmP^V_mj9or=C{>V~Tv4friB0=|c+!5FBW^DUj+l>0`8NCXBDb|;mT-|x#% zSaY3ny|jE`Al^pxr+cY*1={VmC}33_=)6s2;FdhVos@lIL~skENTbE(}A3Yf-zjR0`! z`Ji0b&Kq@P`=0*R$&|j(6OQ|}fT(+@1dlUXx5BXSFkzLwi*nsKJhN6 zmTqCLg=zsJe|oy<)ALIlPiS}FFPQV2Wz9l?hRCJICodvwzs!7Lb=%cQ}G zCNNSLFAYnIkAt2FZz`dFi5tHfp94yfPz;o#w5sCmfWXwE*^qow8Rx?&DXY@Oe-;a0 z^I5w03$W^%m^R$3e!@CvJVz-NO-X`j{KFj*mQAq8O{l(FS&`7)RhAsp$QRZ#k@Y!p zo3MICE(k@}FvZS(AKhT;Zw>F%?^k38INb16ya&=q*>Vb}c0_RRX2#ESZJ{8a$tL|m z)d)ojG@kQ3MscR>o`99bW-#Of3>LZTGf!R&!k;K;cT$bV1Y)%D?uEx8VuO}tIbU1( zVxC*EeRcQ|=GuBh83+|b#OxBzfUlPVsuCOX8QrQ68=d}Bg9qlX^mP8UKtz8ofgoeC zJsQP528zG7O8**pSyoT~S_r;RQh{^t-wXU(e2Ewszi{9}SC@u)dj0YW@WgE6jOjKn zD}JDOao>7fJ9loXQl0uidw|zTIWd?S<4Jm?Dngjr$i8ZqzSg^5u>GR0*51OR8k@yl z+kN-o_CS9?VwH^tKn6vO5lIvjQ1$7L8hME_3h z4yy@H<*m#H#sD=6Z;mVKlX!RR9)xLyYS-_AfL49E-W{P#!3SntQBPSF&wS ze37H}zEA-$Y6o{X?Y$I9pOPI99W6OJh$sW^^mzV#gH^u7nFuOSu_-$ZeF4baKzLWRa!^ z7hdU6R!{nEcE6&}%N1Mws|@^aj4>9L|MH5AtNz~!9wNn*yjjZzxyvFudn5ucimBe+ zk9`3t>eTO|R9{$H!T)cBC+@b-5e*jj-L@5LVmCe2#w6YaMuOojRz%_H@349Dn|-{d z=Kt?>948~B`X}=vF8%)WZeOeRQl@?AAE#q-_?OdByV0sPhpF=t&BoeGiUWzlgtMe6 zTRd<5Vt}a0@3xll|)3qoFfifL30#@lOgiNQ&Qw5;FQ?g{{a3IIwgCn<_JKz{6p z0P)RSTFzChS})sEB>2 zHC?w*uO3ZYX8`K3imJg2Sf$Bhzh{P~8iLu8b|I80A&TsSl*@5Hne$~ya30>6g=7Wy zb+X{sX7d(9dteq)`8ur5 z6!E9Z9n4r;tr#Cp6JV4@)L>$1BP3i^mV?#Pp01EiT?`Fh{KGLW{J0;7IIWdW^EW#mCM+IK34X?PyJ4wsqsy-1V4b+_D| zFPXf*Z$v0Sl}uY%Ei9jV;ycgV>wRW$bKGgvoY8y9QUwo!P{hEUG&iZ2p8}7Q!^skvV%Ni2d6(i0Ykl~KEUVUNL+q*h?5-BK|UG)R}x^d zr>TfTP%8EAADzeK18+mVUi+Aq96jwfO|S(`Y)#K6+ZZYKoZ0Mb!aqy_deU8i_&#B+ zK4n<1v300w(7*IZ9) zQC%eN$_aT+#Rh$JvFi{n;T9jiRoHtMEX2odeRecUt;-*`C7mMW+IFpInjaM#2w|M* zcXIM?YuugEs-mX@{P1uN`uEQ@?Z2AycVL{n%q;PheyNDXkS%l$#zMjyNp7`W7mehpri|AU&{TAmm3!`_pfOkj%OA^u1{O z4+s+e?{xqA-TzMrx38+7^*^ir0W}T9HMV~?`Bx+euFPuFS}HFIY!c*|vc|tmb$p=e zsnv=HH{3g63}1GCJE~XX8mdv4K|y{~=R2Hj^*9tC*7@hVj}ZYr4Gh0gJ#TZkJx7uK zlkp@GMgJp?Jb-ZgcF)x=uCH!+`Faw@2!(QB%Yys$<xcfE~zvt6Bf|q4g zRoY6F+ly4I_VY6P*DTD9Yg04T{ipH@XDR(=ZSG0L5e|?pKEfga`NA=?NOTpAU479} zG_i7&-Z%+nMDL^QY1Z(fFcayx*KFiHBx~YKZi+CNi^52pDT`nvAeld0Fc(DyG{#H) zLdD1j9ta_hNwhQlbTzyC2gze^8{`rs=xd2{0U`a}C$=VRsiv=H%q>lFiOl!=mx*4% zdVlq_Ro%%*5gio}xpNF$wu0rZ^}44L#|)$j@}&A|(x0d6mX!#x7WWI2cZBBnWmefL zqel;jLXh)^iUAU(LJ=FctX%2c#}adY+;> z4XBv&eLB{+@~a~2HZOd}DG_2&%H4fGW?EBQQvhhnO4OSqiqp5;7aror}I zr$%dcu^}@t8iNr|61MMc?Du^c`h6DlArk(GgZAO|5ip~%@?10=z7$!Uv#a7+pu=k! zxD!lQa&1&}GSa?H!?h5%=hN_k5Qf2w5`ee(+gIIM8+{QQ?vPzepb$=#)r=eSj0E$K zFv7cjVGxt7LJl)7J(`N&xcb zlzH}>e`3Mk;~DG%G{#h2wRP^x_*$Yvtqc_mVIj+TZ@Tt)Z)PqCy3Jq8mV;Y$`AHCJADot{L{e!?>=|1B2p_2FJ-GvYS|lxoWM3V9x1 z;{oeQc{7AB<=)|&67EgA$}Nyxi_lx_TWa8PW1odva<}HLuE!W-OY=iT8ExQN7>Wj(2d)S{|dg@o+lQh~DLcWAjc!fwoKBju8?RNV7v z+$QtQ3}qRH-1cDEnM12R^an*FY05d*D}~s_{#Xo*t8@e~G$+CAW2#8>cSa(9r(|0>nCH0WwlEa3j3t>u@p|6O=;NT!@z za|4U#T%lM0n?LwzOK-XUwO##1*zL$usP&Bq4a$tbVsog}x*HK*KhkTNT(32Fvkf}g zBVln5Qc+Bv{ns5OzO9JP0lTs9JeN#?15UJ#MUjj z5Qx>S%!ifUx(IOK8;}m`U;!gk<*_AXisOeV5{u*GC*&|kFiZji5x!?^&qscKtI+cW zTu1v*Y^i!C?n`@K>1;L1=Ps$x+}_Bg@k>lQyV*~VNr;i*n(TBJWQEi6JaOiA ze1yl7fZU!`4jP`8*|ebjq(EgT>v+)B)!n_t%MZ}?pIMmyDh2-&F^G|wlj%RDpi}K@ ziSiF!_-l!R5FZ?}FBdza(bU)zl-q-7KyQb~k{&w0tU^U81AZ618H-{xTxdx>9tLQl z0sd{jpv?Lq~!Vl2Rt2RWxjkSuPT$~TYe&0fTTKX(KvP7kKd2u-1;1HEx~`%vV55Sn`hrfB|Ed`iU($ zew#qLk^{a4_{IhphA2Y45>+`l9LnqT=Z0X4YKF1}*?e=|f`=d{F$)%ISP0DYl6*Lm zH(Cb$&})N_AzTKC7cm(1G3r~NOYkY5rYbnJof3`NF6M1|5XV2m`cfW5$0Vc{`esXMu9*@amxtD6${cZD>@*1P9E;$L{*+ij+8Ud9&L6L+d_T{a1F`||n{{?l7 z*y$s;7cRsS4|Rkvo2mz4hC`}E6xV9`A+tDI=4u*d?;<;*t&Y%!5W}Pe6}lr({nws^ zEiXptB(Rl?L*z7+?$Yl;P=mso_AJDQF{ak@YQt-y86kZ`AKx5%sMIYNDjT&w8j%cQ znn4H5+UnNZDejN<-Pr}jqZ4P0@b7SX<4pPQcbR@_H3=BL=)%4xfAqFO8^A7u-djR8 zKR=3Zi#rkh!xvn-$&s9J2a0oS-;n0WGQ~46imr%OmtGE z>wgT_$Gs@pbp$l z+q}JcA6vCh3w_+c+WPE1E$Y&7@$|;7-ag$yYmJ+_$b2Q$2Jf`&=J(^$gK!Sob-LuO zr4)8I(haBpoZZgp%3zkbv?rB8W{bMeD?SRfmY#e7Zi+nai&aa>szR$}6l$n^5Dee? z3uYtvXjkDA%HL6ZL};QQb^FT3(Wr76EoZmbsKWs+4$izaRqp8aM7D{`J1WD-V(8+o zH)=m83Wb?`TkwJ2F=HWXgmNmcu1*HTnJ2>TML|>&ad92Y_s9511SlzTv~^I-dQ zm))IX(PEObg)u3a0tC^!=wJrj1*}sxjw&};x3ds}iB*!|-l;1$vH@*`@)Rrj}tNm192dN>>Ze}$sS?@dlWd1;}xwamo21l z86i)VU|0!ZM!fkNRxl$}h}O=T=~kL=kE-!Mz@t}_L;vmH=J=mr8;qQ+EdTj$kE=_3 z!8TC7JXc3bLjnW#sKaYB4V1r7Kv$%H5AWsFax$A+4#(~d`+Yp|(Zz`d-x$V_eP;?W zO!a!b=`22T`pE?MDNaWDwr$xt>eVvT>sF=(eM8CeX@H2Xh{ zy;E>!YZvVuchpJ#aXL0Twr$(CZQHihv2EM7jgIY;eNKH})vnqX@8z>@*Qzz=eCGI# zp{#fmQ1JSppr59ubhR(lc_{oXQ^FVg zWPv=%ZpKbMYgg(GgRBCBVrRf=BO&A3NKa%1M?nPe_ddb`_>T06{}AAD|CDcB<|YeX zHx~t%5cd(ksAeEi_0O_2Kdha(S&YtiTykYhX=YS0VB#hSoPTG2+WMpWI4Eqd4kHvm zeXr>u$s~(5Q=7@-N_YdK()|0Na4=;k3Xuoc$m59SvLZDHDkH+7iDc|zLG0*SSxw!V zL57vr*$?&`9q2Z&UUSzo+*_o?3W(z!8TD*}i6jsdDedwX#BTLvGZ9*LLn$w$xml81 z4_@}Iwxv%ssEe1L+4&(ZlZ!xIje@u1LqK6$qU@DFnR8|F3r2L zyDE9QNwvWfS(FLNlC=93G2_NYS)fV;A}5IP-cb0W=QFQ_X&WOU7koFnMrj(ZdxJvw z!VxiUds$XLqQj|W_N-OkM0Rc@ZiWT!Ft9t20uz-mHd|#o=Il8C7IA(F6U!F|Q1e=6 z2UE35sDbMV%B+!dP~k9KW@ey8M00>h4~2z2B6P2FpkgATLsO%}=3w=+;k4Xf?PVFn zu+p!lD+4s&8(Vv9Y_jsg!eO{?lW{?V=Dat~0aZ7Ls6_$Bab8pl=z|6n?Z3nb)jjvf zVns$a4I)qK~Z3tPsV4%U-zIP=@a9E08OD`o2CN@kGq-Fw6R*dA!8PEcr96!yiEMy(gsExhY1_jKDm@ z(P(Tc-h;__#2rw&XbD0r#~t*|?0hv1s83`8=CCVyq`3b9<9ak9rljv0rLmLPDExOY z)hZB+y)8?7lZ-HksaIyu5qF86yxWx*m|kQW?(j_?YgG@PBh_`*s!I|4u8P|DbFGus zMR~au!ia?E?YeV&t=l0YusZ^BHahcCz-kcG8EbMnxR&aui~$}K5WVewNyE5heVFl- zA`B(cz}4@g+kjO6K;7@WR^uTdb$s#OGWf&MJoltC!$-}Ll-0y}+^VTG*tPhBTSG2e zw+c>=W-jx$uC6tb3(^NzssX68v5#{BFBK~^=;#C8_tW9uJ$?>$Jr(6ec?SvMa6vC3 z!=DDStBLZxK3$OS_E`g@mybxBDJOc5&W?jhS&Zlh@cZUVeMghP@$)WXLorx;k`!MY zCVzU$P;A!bsY>xoMDbU$?N2z{BJGcT8oU-W`mXBBtnQ7u9bD(M zN%QC=E9Y;yaO5^o$s+nK>4H_g$ivRXA}=~>_$C}2P~ z%olysm_F679{u)Vg?sLzd=&IvWs!0>=3Rm7YVw*HSo21^XbEEHa{;0y=qGKB!OuN& zrH|sVMQ49!BxHiM`;Jfx#Mch5hqlN~I6Rnao~q8*-pbSlD8V$W9>DC|UabWkVp~Os zPPvKk>~9x?h|7vour4or6Y9<)(M%oDSjWeIZ(_oce)V}k3q$5NWWHS??JWKf=;Wan z`3tY=c1P17mF(-j7~-)$7+D{o5j=i4Xtfgj8Deo9V%cA5dTPZQL?GF<63iUrAoA}RYo)oA(%p&B;$z0t6AlvFoen^@{gdV5!*3m zCk{lCTpD-G>cvrUAd(-nvah*|p#0Gv8yCDW1?eB9=Ie0EM(X9Gj?8#xQ_-*U6;_qQ;Kms> zi>8ae+F|C}Fd?*LE*w_gEQ`EWQXknv+qTS;_|(;HkTLg96D5E^8&rbJUk8mdRECfo@xVKpU5Buv+JFn>yXk}@|1;V zM~6ei!cj?4z4Tf!zC^pS^eaOglYmhiLm<9q7fS5E@png~56(l50-huUi)%j8%>_<9 zIGyA;nG;)$jB^BdO;ET@l(Z{vyJyhCDdI&7p^vXXl?ZU0)5s{Gx1Y;4ZKX6|P8#CW zCj=uL{{%MdnU;WT^r^eUHx8Bat*y77L|ZL|=24MUF7=jwKu-SASZ|!3VN~1>KRxZC zVA3G^blE65iT)t(YfXXHel!#E%bj8bbF|Xu3Xdp-?8(-Z*nmYy6?W8Qa>yo$BCxB zPW+Sh9~3sH_SfL?^2ZNc>L2E(6hx|U%FIL7ek9gLxiL;+6^lY+42gtuM)OU`0rw_3 z^1YJS!WtB)6C>Iiai`L&7^NPm%7ecqWYVkW@mGocY~HR`4>@hK9==Rn+B0tf z8peY}t%jhvN+xdmV~(cKU_B4$wRjQ_`@pcFrW~+3C79pMz88I!%1Atl$9?t6j6Y=@ zq+EIb04IUR`_F&C|HSgsF|+(j>e{Kg9{qhw^N&o&trScV_Ns8M*eU_}cQ}w$lb706 zKt+*1tQ1({40jZY|9fhakIO-3Y4lZ|q-f@wzs(phJO-|&3IXV6foid}t`* zoJwR`ad3J<7Nk`S1Y}`E`EIyK5)=yBsv@+U|;pkMX zuQ5cz(nXdRw#!Ch$#LTWKNo81_BH!n`Z7_AP|1VWMu6dnUzjI+S(8&bi7nsEH?Hzg z?P+;y1f!1VvaWnxWnp91M~gi}e)BAN?_UlU@%^CMT1n}Q&Soa{rzIsFmtHv%6u{y| zUBFYX)54#{TobjtzROVEnUFto!&W7rOt^P@na?zx$XvXz#H0H9iBRG}#4ukauaF>+ zl^mTCE;XSvy(H;RGS~ZR&YWyACR6%!O=%JHt#t9QcaW?hyk^l%U4EBRm1nP8+a(Q%H!}Hrc z#c0HvY7(AcN{wk`eeDQN7?-h?UwTY6dpZp4x{-Hi6Mn2WhXMRU^5pnt_5?86DV*+t z41yL{J~Lh$Us$R`qeXwr5@@Qy$@KlPz+J%HfgqMG>yk_?L{cJi#;vz4*JX(^@u(rt zT_(9#R`rbVJuj;KPX%c`oZ5o-=1M(DMVJZGP8~%BM<0Ui2GS6Rz)1_oejm6F>sWX97((D%`M3zQ6LWw+1Uo zHin1xfh;LD0!IdZI_|88{s*>g@aANP?J7BIY5LV3vGVCgwIg&t%3)9FY45O$T%`(A zN9)^-w#msMTCuh|C|cFA@Vp}+I{kdesT6u)!$8(tKm`2OtI`l-Djb+w66yqmAf%rI z(^lU3BdC`E?vgv`h(-3{RQ2?wR{D(#IcEe8sD8_G{6}?ZQt4IAggi3Fo*tsnSN6yr zgI?hDhA?L4AEivb6j%e4X^o%~&X)f8h*Tub<%G@5N!k*wsYN&Kt$_G5ro>LPo=+0< zrH)|wTQSwe$e512+B9bz012U|RBIK=YW+gPLZ1~(-ge3UPRktVdX^sARC#T9k10QxQq zkOBt|IQ_sM)GUoSn^wIk3N9KLu}xT;R;{44fx=Lj7GbR#!d%gR7lS%Q`(EV~%Gb5o zF*5PeV9o=+;M1j7A*PRPA@V?bvyl#*Q`PR3+kds29z@~{0k^wRJHnN z_wd>E55PeJk20IVAoGDGVhoO56D}6dFGS+Z<^)k$Yn=1ffL65KDQ)9C zlv*EvN8aPDS5gvtwK3A&zI5~(sRB7doR}|JJue3x8$!WSzH|k3^O}j6AQF@?Oid6z zfvClJ)k5Kd&RhGC@v(6- z4};AN8NQxA)&`jma>a(KG&?RyyhprrB(+YZOR}MeXEsVGTBEQ)`YOMd#{M8-AhU`j zDyWpNd*+#>UTe~LuDM3qN@iLfDL|2ew)Vy>Dliq;sCTlRy~CLI)Fk zG#kcndk-ynO#9nGAe36*nuk<%)38w{&8~XI;;tl24r^R_eB=6n{L{&vi;e@U&%x z=2Lab8VGu%GxtoOfRA!vzy+HK z42=_F07zl%MvyQ#TEstMOR(O7og-A>2_gTN#H;4b*y2w@Jq4AWL`I!dOu(mgWFVYc=EGw@XlsrNT}QVe{FghwC?Dv{z8&mFMG zJT7An!j0d;)YS4Y^qq%TQX%TqO?TEI0X-0ow3KA(<5hNX7(&f)0t|B%0rzqa4hlud zR+5tA$V5{gMIK6h=E!+={72eCD@#|UDmKpG3#BfnfdwySfOOKFK~GSB4J#> zAAkY9`bfVdQ0ykUaR5SXAQPw|4@0rU#Ux7t@%s&%%R=2<#nc>%tKlrmR?AS+7~{BB z^F1i7_SUp?3|(^e6svD(AeQV55;x0rm0Z&4N6PCMubRUg-OE_Q`N6Xa1p3`CnAeCd z@Ds@uF1z6`NxV-QxGowNLSINnETMxtd;&@Sb(4M@1j?-K#qs%Uy&bvNgQ%RBb%McA zhMR8nv*lBrNec8olOjAQTRaU2{MS#6?}xK+%^p5?yOZH-E^ma)Xh%g8&H$WU{;kQ` z-)Kc{(3sk_o6W$}xI_GEwmH-oUZP-#1?ban%0^AP2 z$^GFJ`#BbCbtOO{3hqYCOrk771&Kok4qP#HpKUQ|JAOP34#9QhG@}Y)x^B-47;L;5 z+Aa(jOz%7|v~It2$91McbbH;=g#O$}|IbqLzai+%wEyB5{_!Ts{D0mgrFz5+X>Yt+ znM2kJN^+DONo6bW0~{9f`YS-^D@s0|)0(=#(^V`|@}*^ngJ8H*haB6j6N0$^3`hds z0}@Sim32YN@$8+#FF+)HX55JbAC*;7Xd_x@Phd&}7-N68WQl7h0&7)7**qTy z5TeXmjGU;)KdazuH9zLQD8l>(hMZ1Cgj= z2V!k0EUAQVldP-L^*2$Rm<*GG>((N4nAmNYYy-*}FRdL%EQDgQ2r_^s8E%nh`0&z4%bSLPX3@<|E zMnl5DRzH4ir$&)Jy?ajqSI-58{(yujV10<)ZuW|&NI`bCh)yF3%Ia+dqb zm{-ea)z9J|`x(vTu;CtCT&`IM(u2gD@&S#;F_=_Od%wMeG@Ia%n!;(oe|9p)*>;M< z9+HwixGPgNt|Ln43eW--a~XzbhP+X*_MP%vu*Q0)KXA30YV~Wp+C7wf(J=t`d5MXk zZ>7P{1Ka-%sCUO(Nr4X$Hj~=?9as~Q(A;6q<06@o*u$LcExnEM_C`$@I@#o#@J4Cn z;@jZ}$VS;DVWEK=JGMI{n3DpnFNdc`z?^WVdb3;Rs+jCJ=i5P|pdA>c{cE|FyEkDf zof(G!N;Wpf2KpC>$^!(MubL=`FVX9@skI_Yq7t{z>9}I!U`TI;XioKNRahzfq^8!( z4>*H%g++AfD#!Y#PiKy0P00Af0{75?!~;0N1BLK4k}^g?wA2%P~jwd$>Y!a7R&Rz zrGrcLcBnewR6#Bb=0*7oDrMeRUuJ3%V%5OJ-cK&ZIhXyvJ>gDJ8Vr-Z-&GWDiVNB# zJ$s%*%P42(j9X^7t;2wC3b4N@yE7k(=(T-njv)^(;JJ<#&5t9l`d(L@|G^$s8>CKB zMal0)ook;fOcUctBRf+n&%UMYd^k}f7rEL_8qarBquazD0qTeYUQRNYpe6~H9||y) zi|41tz&X4fNt(-Q?Q+f3duw+oj)?SsQZa7P3SP=HYmJIQ%bUf&fH<}XAuYWiv2ia> zBX;GKC~72-g;vI~F}VZH-`U5WRV4@dcr(P_($LG)^T1k__G{Pj%t`O7d7bGmNJEV{ zo&GR7!qix&J5f^Hp+)S)f(EqnRpTjqF-_-rF|j^c5=3mNnWdD zk_FczKwMEfu$_P`7-AjRqtSG~<-Fv+8|QH7cSZNOty67-J(e=Cx4cxE@EIQDkjvp$ zpVR&@&)sam7Hyxy>62X+lsUUVSS z_@mMAT=EvdwSwkC=ElR_+>12fis}SL9#L9Ut(li)XVqQq4^-UL*ZICYuJ};zzfsFK z_s-u2Q?}#5sb$p?UG2KnbQ^n+lO%s%F5}j9bDevcz>R0hr|Wq)Phc3VzV-9bgiUO% z9m+gy)1V)T$^z$Kpo$f~y&g8Nh*R*^BxMXMu~EkLO;mogo2i7DZ!1Z8xu7}M<}nQt z3?nwlHNOv1FqK!a9lRO5VKGNe91|l_rRSeJiIeq)B4R9Mj!sM#Pu;Hz=S$Rd_vmTB zU`nbEiu8fY#|JAlx=l_l{gvGOLj)Zzh^)FuZkCESnBRa_f52K_R1^pZ62*{-mOl;# z4=j%1`f0SBw%KLj2Nh|owanX{CKPU6ihQQMKb4vcK7l+xf@Y-6yX`Ixo)Fcc6+(H$(v!GWG=8pm4b?XEyr z-72##TN9RtJ^^{?cm-KV9HU#tMu~NvF4M-2w3h10G7tpA-SzIJw=9q%{v99+F&=J_ z3?)belR*dziz8(?Dn%=Zk%*FlsmgwIuiJ|+(g3gB0vCnYT&ucVa`5964e`6p9ajPBGi96h4NG}NeA zEC3xEFO7*cTQ2iM7yd!LaR?jf?SzQ%C0k!^(ub-%37)kC~#Qz{9?ctGBh zMrR!`Jg_5v977Q65Q`CG-`;D$X>>^21GJ|(xnYwT9EZx)&WF*cTT%0{E*KHU(~EpA zpBANR8W?u?G2==6&}8-W;#l_4DrJ>_9D?JPf2G;FX++hq@*#4e|5b?SYm~0w;>+<; z%j*SxeLh*MtS?c0^&L!XhqA9dxCEFT6Sne}rZ-zm?H*p9(c`wk`b)DFxFcek*y$md z7>Ugu)Rl}rcjW{(8E{L#hS6wGc*Fy5Zu~6~+5jUOx;~NcRl;eXniaXP;CkTQSwB*s zHa|;=E@aAKC`iJg3^dySs{T@YA4+e$(Qs2)PP|r-VE8ad!SWJeYxGb3x+Vb<13*U8 z%@{~sZVB{sl0lP~ndjO}6})dFM~cqh7>Fp|hLT}+RBJ}&fv=s5YmfqpO~ z*Pw-)a+gn~ApWK*i;Gid+?SqUi^;y%xVCeIEzqi{zf4ltcG$k7FYFGnvtykgJqXRNCbhZ1ULZYA!Ws*%RVLi>@pA1^F2n_=>$ z?$o!jWP6!G9r4)!`GF=uh8PyQe6I#Sc08gvNa-cJsh;nRY>Q@un~UB~vg&4IG>|^( zD=ih*pIk0IVkj3JhE6e5g8B0UzrU^)&d;N6vSw`1A7MoOo~|tV=?oDqjf0}&*oNa( zbL-qS8)GgRXFv}izmP5Tt~}@-xfIcVQ_S)~gF`zyW0-2M~)LmH>m|y+f z(FMsEe>ayE=hcFzqC45_<<{cv> z=J?&;eyuL2eH@2`__(nLVo*qtCYxO(2NBWx>rT)l+cnFR5rv^6ks^>>Z9V#JUnx(& z=Bm)uX8|Uk@QO`Ogd^rM4>3CVd-5B|p=Ay4AbWzrawFSdD#$-ix6^#62D>q`KbnUH zez4a`@QKOhjj1Vz1u7APirmo=d&-@r!_^6DeCU(d;y>DhOxs7Gw+Mv{Kr+Zq#Brj7 z-x;cnyvTkW*Ygi5$nI{3FG`Ule(LIQ8A?GSt$RFW3=6?ghNJs(QrTafD+1dW^WfaJ*F2Q6yG*~TruEV&4AhMT&w@NgN{lV(%> zq9>qs9M+#H;QQ4iA_2EHAYD~kc`L7gZ3DG`Y8&6o+(Nlrc^JmDZ^z0Nttc89{)ze$ z4B*34uIt4zbXsE@F+Yb(GV8b4&mk1s7XuFOm89uM-_oHyYhYaNthXcSFv^EZ+7vW?=o+yCBzd16{m!&{T|7*BCtN;rIjo<1Y48o-MGo|FjXWK4G zI9BwUF=|1VB$PMP^Z;U$G2?5J?*lEA`b!qwt)uH&1O}i+I~1AEnMHD3&7$3{#PLJScsk{d%Srm=5PFD+)Ezq3y>qDwPX2?#<2A={4E|M5somQO*LC}_~fIbgAgdk`ZnTJty58sbYulr@u3*T=J z$|_KMFBzn1`*WK+XsXX;Y~uxQ4Saip=JTca3s~ji{J*4t^tAsQ!_P$fuiUN4@7Z@> z5ZU`!MKxl8-IR;t2_vOAs1q`f0yrqe7&mjk>}Oa)V^%VOH>U|Fj!S0byki)G)nd!# zbLQ2?^zn&;AOY+)kvy`uEu)Uewzg39_I#*r;$EVl%6RBWC~cxWw$|?|1EGh5{Y7}d z|Al$X9G)f*X|`n$hg36@U_5SiZ&f^QHjO*C5|7e{c~Bpgw!GTYh!ltKHrZ)N6$hm# zA09mP6ZK}S6iKBe`V9=vPhz0RSRVgp3JXUa!Kl!F&^ULaO8Q!>ZAQ7jrWlwR9z{vXu1k(mtvjV}sF@+Sl zIo$Tq@eX?VdZil`O7FOdiQ%G;Msph@qZuZ4q0;0bAu^){;k-7p%~8>fg(YleEb)PE zjAp}fEo~jmz#6vd>zc-Z$lPCghgf$mF*bNH;(^2%4qLLB{HgPoWYAC&g@ryU~KdLhXjPszM~7 zD~d6+^WZ3(b@e&1w4S8m6Hqmf%fefK6Tp6vp+Grt5@ zE6@%UA@BjiPazMe<-|89`0bFf=rMd1-g+mRRb8Oc_S3S*oBaZRXlC)APR8ej315$K zjZ=II-MK<COh_$DKzASVtj>lU&Tz-{Gsj&6OFe z|EA0K|LJV=X2>~q>MV_>mRlM>%G*H*(zK64oJx(iAUzZ)skD!7aGrfG8#~XHgiwZI zfjQfph#qA}Mg~qHh>Z&2NV~4PnN98-+d-tO_`xB{W!!R)c>ZPC0{crkB)I=JiM_pj zqw>z!Eaa3C&JBiHaB^PcMS{Ub z=DAPt@d^^7h0=oF58mIc^3e5==$)C52SBQ8`aIGXIYO;uM@Paq1L^X)4c15Lp^a7F z%u@veu;<17T9AZP^qVrpH979HGp7d~*KDZ)0iIYR` zk7eJAx>=i02`gki7;5t8hAC!HK+hn~;iQK7n*1m`x*0@y`a)m2pGlJ&CC8D57x_W;g69^OfMF^Q`g9pX#a^!B~!3r7h$vO5P3HYg`(S>vX%6svKe+bxEyOI)$oL z=&~fN`K6RiZ|j`zO=2D>Y!iO@9TpN0egnYuit-c-fE5VYD7Hi937HZ zrv;47b(#=u{QmTUlXi7KMzpEW$*B5{etA!S+2 zgR*$0zOm3wF7MBqH;&6E0$_ka9|W^t9>#CnXE|jyqL~UroIah;u{9bm$~Qr>aQ5&_ z>-~s&+exTil=YZyB;}tVh;H+A&t6B*ZR&4*Neq~1ehdHX5z1uU=V?Tl zVrXO`-fN?ZordGN5J4L4enuUG0mk;hV{?c43h+)3v=Wj52C;l-C@pnmkB}&fL8sSf z4eYBD6r{9mHGzxuWiDhl2#kF*zjC1omW?I*JOipi%|@Tp)p>pN2+opjrIc#BbLW z7I2)brJIMK-H=e17b`$KCCX@vkJXasr=oDQi>F?i2OvJtSFi?S82DFe-0D z%T_Nn8hK2Fv4-+PQCDZT^V0M#G=J)i0*D8+3ir-0eY*KbQ84?7J)W~F(;tuFZjZmZ zVN97!3KWW&tCjKjU?DLrZA`$@gi3jY4yt;S2QzLv!wiK)sbruGS9hbFWT^-fp_)sc zJE)wqk~TIEv$(o1t6G{1ik@p|Fsmh{AE7XM$!JY2P!abwgjNW%G!e=gHP#lDw_3rN2N)=;P}vyb{4f}~npr2zwqsgo<6NmN zk|MYD#3B$RiPdAPy`JLyO`Ep5HYpNJ=)OV0@TVw8+gdtJ3CK%6eQIbKAaqZ(0Y$ud zuh13Nc`rtNdO~$DV1sGjEO>N?ble5}LpM0`oCW-G+eAlOy&;h8XjS@9wjYgpHwq$k z#Xy(7!c1r{3i!v!ih|@Q#@3?Q1oA~X#55!B2S2f2fxaNd1tYnuJ{h;@pr9o2 zkcb%E?nhd`JbO@`2T;rAu8fN*m45aLVJ+g6ROdT07%k-;IIG9Qk1Dl74dK5p;Px@s zZf1;gs1RwQoMV;RL_8T`&gIQk4-_Z{Mu+CjkDGD2dBvY+lG*v6vm?dqw{a84*3nC|sGV#zV z>Q#iUoF+ZJE}#hCo0=h8+SK(GB=tlT1(>?a!1pSF=VyGlI;Ktl8XhK4wVfo5vd7sW@JFTvjVS#7QI zbH-Dpp5m#-W+}9w7D%6QN`CjM^yUk|x~1XkolJ}B))}f5(`KlWgHOhN`x?vcrGK~G z%NQnH-h7$FZB|2!EOIW=+m2_=yB)JcC(0#-vZFX|SehobSu%$P1i&t`R98JL z)L5!W3vX7(K02FA8!4BiIvWcJbke0Z*hS9v)=o)0W!Ot8LmMx<6l^ zF88K0+S@17tE3*rZ+E-i9%(X8C4qRMsY_L#AD>Z8X=vIGY?8wP`o0%-4Enl_#Z$d^F*vSM7uQ`**3|@+exF!F{{C ztsm(%o4238G@00>hd8%uG>pqE2-ds*?dsB*M4OayxvGOXH>PrCIMw=X)e|&yEcC5E z9Ln0XU7k;i*qi7fQ?fvNi7uR)@po_}y79<-|HpAtL6{iVP%XrvYJ~FQ(hC9Dx-n1U z{ra)dn_txiKBJcMJ5;x-&To-n;Cad==~3@knk-_uwg5UpK=F8I>-nL11&WzP%)u}J zM3VO->(!>o$p~$dwiu^7w~2cMa}FX*4jgFep?$D?WwdqUE#^)*JqV&xvH71!`dyOh zg|8UF9BrygSwLbT2#_*pPLSMyIoFZ@BYXzn59Y!Cy}~E;1Mv%^f1HR63WR z#E#N0I<%Y#O3FV}u2|OFJCl~hyx9BGU;L>)W4yL9SfR!JY1D z)7#sa<=_-pTgyAED&;%dsXxS`e!jt)VMhV;eK=Y4mYdBeZ5uR`k?BY@Pv>;U6?k7~ zSwG)Q9_$w~!(rTGz(`zV<=qED3v#s*o+7Macd1Ef%Xo7TAV>a&Os(V+01K59HdW(@ z_MI8^@5wZQGL)1?SEG!kRprQajKvp_0+8-;2)0Gc z{=es4@oBFV851a)-PUo)evjxzDKs!e{^2{pSaPeFP~9Ci5mnc0BtSNUAo4XQVZPrn zmfrlBt>lhBVIhJomq6i6$CbP)s}5}*bFctG$26dVE?fW)w@Z-!w<=Ncrv#+n4ua8+ z&j>(=12xQ+M?`k5?oxn2Kg_j-hAnu2+9Vgm-w1Y8t5+5 zB6@ERVV)bQk1kTDLOa8ijlVmNK_;w=v8|Mg0eZ2I;e!|e^k9H7B0O=2RM!)N$NOau z)`k~p9196dg#d{c!wU=p20el=&I`gI2qpS`2JM`{2*n%E&A$c*HA3J7#iqj0v{O(d zht%uMb+zRL#iznRs6H( zi1zawh{tC$OtVD<6|o5c9Kzb@eGGiP$eO zpeN*>`aIQ75K?%{5l@T?L6jgOmf#4I0(KZ*E(Z(A}~A>g2Fh8Qqx6a5f&2%I2HRI%5BU|0jRBC^`7rt#@lnN;U`7(&}!AB?SXcWrc`qA(xpP9=_O~?Avm(yaP+*xO^wQ?O_jx|7X|!y+Sk$v<-45Eiq6;{`eD!Y6N&t;{`>iLo3t&_mMNZV`p43U? z+AO+^(K$MJ>K{)r2+_SZ)Jr(aQ(h?I`B7hOI471`ewJs(GuK#Ib-a0e^+omv`98ot z|4Z0$dnB*N)(v%+PP$F3(tQx!dVWw1Nd$AK-%6l8pGPKeb%`hcZ+&@9iY1bMO?|!H z0KwYc&6x!i|DC>1i|^y{?c&Xu>85Ko-+dLcr&M6@i71UiqJzidzDe1IH&Asnayz;j zAMo(k=GDdG{ezfx{Q>otSkBF^R=NQM7NE;icxI*=H-M=NscBX676gxK|lfSv-aP4x7`ejI>7!a9pq@j-01ytKL`u_c$cO zG;WT$1uDFYR^+}|kvQY5R;nP_9DcXR7>7_C{;oLwS!5h7oH=EK&{dF|w!Fm=12Z)) z%U~q}jRm1@UPt)0^2v+V;Xc*3yl@XXb^{9*tmrq}BiEeO<{FJ{Miu^aCkKWl)T~;& zw>z2f+9BHW;C?R~J!Y^gEg#(rZ}0WUU!p%|y0U_XqdL*C>l#=nZke>!)ECzXf-=Qh zAI!>x7OB=Iot?LT9<8g)vtk{&vm~<+XgnxTzM&3f&zQn{lg(Fst;+H>m=1R=A*#_f z(I*a5oOWE{TiIkd%_pgqA9gF;vD90uExZKV=?SJ-|axc{XxTMEreO$!y6W^(q;(HGJp}@N)xrWkSj@9?wIC?<;s6^2xFX zWJWJyM>BHMxT=N7@$&cUewDoBf8B|)K$bk9ydt9AqY%t7^VEfsR&IMg@q~S4DgI|m z`#-tFurdFuqdip7`W9*-E)P#r&4Bp-<+-A2`x~=s4S`BIMags47m?~Jx#5WtA z#BBc&EX|i-bB@U84M7j9)WpHbe(T*onT8|?=lQ-iqWM*cTX2;;TTY1zOw2Zkuf8P| zE7T)KU1!?b8r|(f_E=e(km!IDph;AUK;W&lEY#=tzCgq>j!Os}PgaGnMm>wwR$N`x zLm&s%)N+cD6rO2_*S3NySzk5orE%F55u|Zgn=x%xWLxkWm&0AkPkM z6Nj6g~I0jb(iLK9!D#pk1<{^BC9?%(81G1lh)FmwzN}GR%+W$TCXazGHe%D4%;t% zm+zS%#{mqzSq;%%m<_zv;q;R%9%peFsqg$a1VCrKpW8?S^i2SB#|R+7Lb1mRhAXNsh~1C~ z1h`I%b-O-4xkBoo$d9NwP+I3R9uSa}}D7K;7Yu>)Dp&6Xc-LE|#0rXtns6Z7b) zp%OeIzO|eu{iG?ffxL(4CBI^ko|5@LjGa?=C<_;5W81cE+sTP-+jdTD+qRPv+qP}{ z#7;V2KlJE3#(lWIpx$a#?Y-BWXYUUdJLLXl(lW^JfX(zQ)pU%Tg&wp?JpV?S=N8I0(ttJ1k|haSa<>Apmmjg+734W;6(Y z&qFaLX)@oOcP~Ot>5ZgHzbUQlU!4n!{1pem2jbC7RVq75uNL3xPR+TUz_Bc{7Vz;>rMvw zQPi+x`{c;^ehr(xhjL^QV>Z!&S%?BjWtvuyWzul;#ucA5y+iNopX?q&N|eUj<=Dr- z{tKN(9Mja47VRDsouutN<4?O?>^nw*G(s1BHm!LG$+0bP|0nG|Xflt7iW>Ff?BkPC zQb2?)KVld&+LIR~{|#RAQN`(ayJdCO+w^Zwm&w#rsw}59mZ7YYvA$fEzo1zlPf$`* zl4_)?YJEJ1SwD=ByJZGVnZT(Fbb3X8K%WkLpyzu zvWO-f?&`-FoAy1M=FAn@vZRO<@S*wfyCA|=2`u;#`Z-;;t0-u+VIS0qe^NuC+Q?kv zR#k^AhAu7wjGEjroLDHPs+4A&rsITBUKEliN-9(vfuDgu1Eg7o47V^2^a+d?ZS7cg zOMNL;PJdN9`JSDVmEs%VmdYk(VZK^R-4Tu!BW0nql^ zSHIF1aDb)AhP#QiP;zA^so4g(2^M8LGaI&?Ods$#0(X?-@Blp>IY#S>DAx2l3k2H(#o3Ldy# zwE7DPnsQ*<56Cs?0z>yTir;s%&B9IDq#zR}qPpw&tWxjxE_XAU&%yhEG1HH8e?l@u z5FyWtE9%*+X7-!zLJ8oz$c8XHk|kH8Y6sBCpvP1;K4GO6hML9|_c5A%raI1mxncR^ndiu#If?u?sre!s)kT%Y62P{I$(yS-d>{lvsDv^5;so)BdEv zVIB(}EM7tiYg}Cf359eoGL^QZvc^`7!ZU!zqsVJzZcyY_xAO6)pA0sahb*!%2Ie}~ z4>USo=@op`^dpgc%|j-5`JRNZ$DGk65#sg*qpOSB<2wT&7YhfyPzTFZPgvG7vqReqgQIkNDLxI zNWUmcF3Jq&jlma7vYh2WC^_d4!;vy>u1(NM$*)K0kHE~dgyU#9-9JT68N@mPj>2zA z=?_TN3pDjumi^JDFpG#xmf&MGj>2>1Y0Xy%8gc4>Dq^K?VUa-fC|NvVtqrZiB4lRs z3q4Ea;yStGTBS#wb$oJDLHQVfQ>-*EFqo=MN%Y7m4o+2Y0x4)q;4O1e&%R$~iQ&34 zU0iEJ`M!6pc>zAoA4hkId&_9QD8zOU>Cq8R5B{n8;F|iGmSev2v#DzN1aqh!&;bftbWm@eVP z*qrr9H0U(5%zopJuS7ymiskIhGpG@hEO-*ZpEZ{pEOqJ=?`3H)AJ$;k?EG`i)o~tp zUts+krMaWx+)|<3OQQHzgL8qfs7vG3sA)&^7Q#oic5}VHh;xU{lmRTb4A-?KL-*V! z3grP-J+H+s7kX+nX;ePvD3_8Y5gQOY?Wlw$+crZ0UCnLWr~aOs=aL%17~iHLJ7x>h zFePAP5K=~b4c@bpXA^QeZFquR#}Qxw<&0b}*l@M)b5hPws6+r^TnA6$(Uh;hvmNmG zlgM!x+p{E&iS0lLlB6%qph7_5<)&;xR!j%WwB%$1Cd3$E?74XXst|h7;nc$8_`LPv zm@a0N0lxY!6=E(#C=L&%bQ|NPyc#_^|HhpDvT$K0fA!>x_Mz818OPRSv+jfJi zS2$|m;JYVp5w>I|@#5ecXLK*xG9|lB0d(hB??~v8hzw|-D5op2BsXu`_@=AoxkanV zy#*Z4YuPI9Loq>a&S@?Xwn)6^lh+97P?v)L$Z13bcO9RmXOgssJnf<-x`XeJhU7r> z!2QYx%&k03x2$T8vW7q6wCuHEc#lLIt!5L3b`Z_GT0=ASy8-79U9m@E^VRrYWBR{= z30VFa(^o&YM?ZfCzjtb93wfkzY718ROfI-C1Av5iE(y;9X_)K5w4_KmtwKIua1#n> zIF&DnJTMVh%1AT#cvfz>L+4JyL@>VMB@|x<6zU_p^~CJ>X2bN0>WJp<$cQvVFcf(r zQ!XminYv#ZKS&Frh$t~X)~j^AJ3l<)8HV>eH9JCc`M&n>ewVp*v@^}{d{tZDY@WY+ z#?R8wJ#p*MmPK(>KTd%g!VTCrb8_95l4$2g*?TP?ZHE!m+qQ#x^E}vHZM1Yj@Gay0 z;3FwaCcj*hTevJbN~&z%r;wFEMM;voWOjlFiz#Fleh+lwP>FY^Cm+DKvp-!FRA%PU zxWv%ZDs8j0AwDCZkRm93Xg6todel}5g_1Z#VDN49rmyzfjuAE|5l<&=z3R4zDs8)% z=)mq3<=eL_tJ`+E8XA&|W_faROCSKgA}S^@4TkTyQ?Y}LgC$NZn=rPPb?QMNo@gZw zW2RZIbhM-Q4HG56bQX}L>31H`bjRH2oFWUhE#$8rPCXJ80rw62cEOEaOT4j?Gjs2u zQF<3tMJesF%(5fjE|@aokBaTEwqHTBu`2}RmM*ptA33zlT^p#iWP8o8q!o#B(%yw@ zlCWad$fBVN0AdEPmP)pay$42iI>P^Kvt4TnqzDr2~4~PH-T+-BT zXji2W=|?0^Q|R7X3W6Z)w_2C&EBOwNb;?dLW%>Dcl)?90<)2S?uue*+?3x_q;{kt#2#D4uDJl8?9&-eTe}B`RF~ zYTB71>Atai?h>_q*Y5zAH$*A6aC8bB$PpWUAccEa`j($gSkXQM5HB}SN&}I( zdimSQJl)TGj{P{XdJN&yehnG2vIA@_j55$Wy zV$hFrdLS|=@gW>Wf|MvQ)&{u3II9Dm*%)XTFzi^1qNYi!nmW7c*KRAC@>Gi;FUTT} z0-z{?L~}Yc7$qu%Q|-h~W;?7Cf@r!pR@YLV1Ud*h9IEtb98UYnm#G+;=}8oqKFHv0 z**mTDI-vFj8f%#pn`ITvkmBFINqa%2o`$X380UO($XBGRPB-FQ>vO7y-#nJDU;=Xss5cMieOl9IF(DoQ$dl`oBB9+k3`)p=68PO}dz) zG2cK*j%Mi5%}z3PihDdjOOvJAPEcN;Qo$|1OYbXS85xX-d)x2^wgNL1BKrnX?n6Vo zrJise#=B!K%}jNHwwA*QC50pwFQS~kqEN<@$NY$1%SN)ZlLpHrC3Bc5!<7;fcvvaJ zkrR=kNTMQF6wX|fGcc1eruUm_&SjtJugRb*-Syf!NY#NW{``7n+vH{lj!EYTtDEg8 zVS*;M29RQgk&pt5fL58qAR2J@mSxNVAHn$}EVBx&&3u4lDj~&V3uWCB0&Wy@vwK^3 z?1#?^E>b6+mD@@Q<4Fopll8#Kd}Z?VAi-A}F__ zBqXpG-uJD`b26G2WzDB`#YlTgj(zs6UP072=T?!?fniXC^}=nN8T686m8O9B9ZwZ} z+*YuA!Z*7b1-(emRc30>lN3btK~o9KeX)GX_CaB;eUJ=-i1Che>Q=ifSw#@fmE?Qw z;OybTsEQF&Lmry)sOMFb)by%%SXIkIjTMT4?e}1`{z>I+Ve~?RM|D9nY_h%^=R^y9 zB(jJD^zE1qScM{j|GUJjhsM_PN{cuSYZ#<^RawzU=4bQJco3B?jdXvVO(z$N5we?` zjs;s65>R`oDuTHku+E~`2O*y9sF<)CfkUYHupkskt8p>d-${FCu^vYYh&B|a(DoZa zob^kJu~8kcTm@v7zkZ|ilAv~?)E^67GHm**Axa`9J-T6eqP=J@G^}p_XR(j3(t;8xp?KfOaOzV$H$Its^Qqe#LdTZ-*T(Y0-6G$9bp?z-KV}0vO-)9 z%!QoDtKk-4U>~fyjIBKD$DUhe*hsQ5eP++FLNj9E3U<$8`qKg<=di z4`h6El6mlwJ9UXkQeabe%ouc}t%+>Yxt$?E`G&g&)f=_r+;*r^BtclW5jtoN((+le z@rvtAKyHM;gqjL}@iO9u6&X>lt}dVVUOCifND+4|+;^d*vin*gH&xv-5)(@xq7jS_rhN>yx&t79 z{Lyo*g*Hb`jBJ8L|8T-?Lv!=7wJQ$hmy*uIfUv?S&Vhl9%MXWUkzHx@O@Ar6sLmNm z5WkKg@4_%B_N<}l6iyIPPbfddl^spPheIc>lMwov!Zc%;>!foJ6-Em`;9Ys29Lb)= zwL4e`d+KL?3ZOC!$STsoYiNSmHD>oRrVnSHWoxcuX~^d8@WJOT(6Dps~gT%Ia> z&dj_bEa~lRsA?v*ei>#;S3BJxz2c%VHS5K_`f6fHfA@L8nCHgfb8e=mP1?vOF>BSd zjis+#PHk)nXJ!5;MfgYm_hWAV;ff)g2~!emUViTLy(*&r zaK!{SyVZZo7d1^K5ur-j8ve-tH0ach$A9S{wUpVc0(E8aI+;#SUYh1IB^bPrr5F4S zY&hfL?ik)f(p?aHO;SSskjLQt^(k=T6nKmMt@(dW*;`;)UqzxC_ScLGV6L^k1g=i@DfNrpX1 z>m-yq*}4fWnBd)*vkh=sSW|$0a8!s}n24h1-SF#pjU6xG0nZWRl7!PjJ=Y;cvY(i9 zWJqV!EJQE}@fP;3VPsx&Ze;lZUbDsLsW&|Y=rU;?oCEp3RoqSFT>b2s|Ll%7Qfd{3 z?vo$^mSo?b0Dsg2B^QsCV;tgFPtawQ8%NdfkJxyBm>Rsx^Fxwgyg<=l<5Vi#4-nJc z0Q)6_ulHt1<-g{L>itYX?M`GCu*CWO{VUm%2^v&!NK|BQ`0e;zU4%cJt}%AOEzktw z>d85RiPwTZe83@q+|e0+K*dpLNd|+gk&A3;ih1~7C^;lj5goqYtmWhB;2atOhYoxm zn~C+B1Qo(2&V$XyRW~+@2tf9cpNvXj=6@1_@*o(Ip<+0zq#a@yl%EiqgLKSj?3c!E zb0r}a3-=jZV+TU#vDl%;nSyb4!vDI)yKS$G85!|wTmUjf*zKw zCq%3*HZmZZv#5Yl98kyJu)7=I=s zCayE8JH+C8u_`^nK(;mOp7XWG;VF4S0P~dEwNx(vLL6@1pEeq^isOmIzU=d-xj8qr zP?Hp;3OXuL3y@nX^Mg>)eS}s6%J>uFEh8pvKBy8leBx!!az^8hBr1W5}L~8=W&p%tE8S@X@#J*r)f5jKg(|O~k=Mvr58P$7| zLs}=q1fQ99A4niBG=o^{7sCzj{+B{>*Ua{78~eJr{0w+9783d2In^rMpudfFA^>Dn zaCb6~-cH^w!s!9+;~th2PUfDogK*}A5M~x>w%dFtB~b=B9%)Gfjr|(n3ky#$vW8{{ ze`LLNE@#?T2X-S2I!We^wK%=CRFktG{ROs}#|(8hib8(hcy@U)9y+H^481uRd=}!D z7=YMB3(7e9w8QTX+Gx;tPyIa>=|CHq2+%EorE%_;GhK^w*I#5E#b9p~p7GnaM+ol} zH{6xyz1PnY*T7e5Wxf!c6Y&*hLloWJB##v#*2S8#fRYgkhzCOMRhRQW5r!(lmG~_U zk=-Zj7dJCQ$qiO~n%}t^dZ$iB4=37IopE9gEY0bMC}vePHAi3)iog{Tz}bv`Y5a;& zW%QvAnUky2DJ9oB%ab(Mo%;TGQ~hYRvS7Jn{njQO-CE_d$H$38G(I5m08p5g>1xUS zOXJ`VJ8CkeQH2{oXATXmh+_H2aT7iSdLnn`A8HaNnoc%|gf5iP?vX9ZN0&dUy?t)X zzF+TkIBo`$JFxR2l$&NlIhd%7eJNz(K77d_>ziT z34mfy_q>^>yQY1HTu&C3fA^$U2_=7VxQl`h!Cs6CkK#q3bdsMfkme)3J{EW6d6ku3 z>-#1Kv>b%c@g0ITk^&a{6(lldUkIr)#SQb8H(nU4XjR*O&vb1w>JkUL7rbXS{>=wOUclZME zDYDxAYl{4*&O0MJ%Rkn`TN?i_MJQ*bg4@>K>9$H6qy15A{Mp3x_IYMej2e<9f{XTB zPe9ZKc{zX5 z5pfa0kZOysRI*3j+$`8+u1uscHWS=AVmeKu*KV{^++_TSn(&EbK@y|`bQ*LSP56C& zi$-C>s7BAVYN6hPSoB}5gI0Qn@%s;->bJJn-VId15=0njDNJwj7?*y?SA|yi?NM9zX-3ZmRPf%Q^f^G%> zk{;bwb)e}+LHqRs55PC7K$rvWK%cgrd+UjgbhdHIsFmlyQzjrSj}CnZIX>{00|(B9 z0pa6@!ZV4@+$bi9wB!wB@h{g~56y$rB$cR~9$?x!6!gMCq#={d3Cl0ptrYOtVN3g%jdUYP4&~;+#Q`bt`i2<>9O>i?FibdoVLHqW#l_cNZjg zG2?y!|5j-#|L3Mnj7;9=Hc8!UDm%M|yVFp7!ClqVlKuUq2Ezo%pDN^BI54c@En;Aee!ZzUnQA9dEEl>7ZrM-qNf?@d-QV&V*8T)Vv-F6Ac zWfFj>g<|R+*(Y$s^vg0!g~HQ?2Yjpbh)1}!H{(9jz{{;Tv)YJEY%tH6RgV5;4Ifv* z$dVfmbnqG}yCm1nGgX;;5wlB@?eG; zevNyZCkij5M^kdq2pO%^c}nfqm^jc$c|ja#$%|EU1S9 zI}h)IILHe>n@04qX@n1bsdcq^V1yXP3K}DS8>I)Ah4#$G?hQcthjrQOTgDp0QR1`6 z3YvfeSjGdYGw2xy*w96)d~t0jTba$HD@1d|D8xj$q#Kv+>igl`)&tct7LKP6Sx8Wa zEqEht_Wj@{?!e=P6;ttOi#5dNwJ|6^1Qnt3hbYypF9T?9E3U;S>xeK%dx-v`IkL=TkIO`wCm0~AIaP=!gfJ@Sw^J` z;~E1;y-b)|bnwzM7FY>!3e>-ynv{`7X_(8sv9qEve!6y+iyWTh)y>eC#VqG%rxcC$ zxqoWESTv>s=_AU-I`P#q*_vQ=d(W9ByLTBE|K^L~p#wxwYs0YoG4Weu?6=%>B(np| zOTFVGamGkcIbuRymnU}}Xej8PiI%!+EIVx|AmS&bTHKyRkdFaga4sNu{q7GIdNvb^ z0aD7LAxx8FRrq$4=L4nv;A#9TEKY9F3nU>QRZ+rIXpO||I{S^q6@vx^(%WN^xxc4e z46`(M0y31SIXXIbMgYjJ9P9oRtfnI1WOIN)N2?YC>Z?aa0I}TBS44PB9!(sfLEPVQ z{^oTZU6GeKM}3@@=IfXy*aj=Ne0(MUt%~BWIqT`rwCF6GjHP%wH0Sq8Xcid3fiOqI zNmh`IO7E^{1O{Hnh0P6jm*+cSnG_uE92;1^pk5aK34AJBt;Cu`BCu(hB)wf2v@?PL zOQbC4Bq(<*BmmXHVLf^47M%+#zV31TtrsrMXY%Cff&2M3#BUUN^{?T`{GZy{Oe{?Q z_{I7;WNnqlfsz6?mga3P)ndqt&XOxp;v%I;Ls!_1f&DFCO*Q?y-o*& zkoS|gDxo4(F<`)X>gc(~1H%VGlYcQ1oZQO=dnJ1@!1Q(-0v3~$QbMD_2TB2vj#DP< zb9{_tKpWf7oyY~I;|Mnb+!@}w&)m2WB?*FPa6Cfe-|lpZWM48>N^VWrqZe&(=|Ep1 z+LuhbVJp%8%VABsbW^h!=Q5}vjg$ixFD=<$bhOl{v6YPnIgTlbgo+@Q&g;%5%0wnT zL2wR_8Rr&&cBcZY=_@P(cO3JX zQ3vfplHZ}99#V6Cc$1__WXH^LG@%g+^YK}3;UJ|;eq6%4=9 ze7jT%IoVm`*^JG?;GCZi3v)3vn7fZ*iW00b88Ik|v9*naX8Gwb*y65zwOLf9`!}x% zKh#cSIGSTG|9ZZ~K7;rbnekje7{}EWr(iNAQ92$aYBg2kU8!S?Wff%M?XU9VwPy1M zm)l&4&s0NRjg2s=gADK}Gd5P;3QXow!IcEJ3u7{?Lv*rbk{N z$;zSCqN$4)R%!soPiwx5m)F?$24>@%wj@sSsU&`3mN--K(kS~hO&k|@Ci5B*Wv%bm zyil(u386%g%0Jk&4a0twRQmhgl=+x>mjH|%8jwQtB+Xd4yUkf0unVoB>g9R>K8P2GB&8nc{awJB3Vj6KC`p#8!jo> zmu5)YLvcDC5+S0xOT15NI&0vYJ2u%}UdMIprZGbp83B5g>%N`UGP*3?w)#4fCgx1f zq%)JqVQ;6aE6hdVD%ow;fu)H*<1PZ_*Yx#ib<7( z1%?gV6}>FZP8y{#awLiQ=?(Y}rjdCj)MdrEpmWBRz)lZ7xYhmq_9}JgA#6~BO(o#(^VodG0}|ho zP<6)pA(&1MDMvXTd=AXFf;&ua)*Zkx5AqW5#HiYdJcd!Z>Jx+Bm$&*yf{HRAa-@d_ z6QO(*MR3mS6h~91H3mLx8Kw*=K%e5(wCvPs9;Jy$C?(T*VrZgf`G7KYz+ENKfe&G_ z56O@_%=p%4t7xr)yMewQ$GcFAk!QF(NlJ&5QjL>@LaB32dy*{N#nY=YCG$jH&KiFX zlbSVJ^cj{4h%cR^0SXwA+_dwo+B)8Y6#ZAtYW2xw`}^@JHQn|ZtxCZ8C04qXE>D8X zAwe_1N}iA-Oy;Fyp+riyXaZlsMWUCkIp6a1H=m_lx5aN8=EXs~mGf>6IWQqB@|bZ+ zuSN?J8|o8+l-OvVmB!7}fESQ22LyrU`shQVQL+O`V7Z@LuReD*GEl>*a4wR{qy!GSSEEx2q`yy=PaVx{&L8D?|k zerh`ThCi$3aiCBT^gnD142FGN>ePP&ll!tL5p8c#EvtOCxiQ@6bHsF$qsQE~oG(wK zj{UBc=NfBfPMn+s4^41c=Pqbr2s@(7BXO?Ac}1mnC_5Xs^;<`{nw&zjLsx zurMpS6zs5!OFD3?3z=1wXn!4V5(cvGOlokX;WL~X1^OKsmNB>phud0q9tA)Lm)^%Q(gMB_afq`WGe0(}R z0VA}5g1c$Gd6GOf6&o^nq3W1XJ6_uAN1i+Q1&YN=MS~bZs*hU)u$A>V5b$pr&9L%v8iLF$?B@b8aaqs>_?w% z5`#4w8o^J#qcEhFJhJ-T!L5dS@kn^FuTh;hhWH>*3E0WqHR*Y zv-J+e)Sf*TVMJW|GNE*S2f5)i@-$wbya!sR!xc@J+7}9dz-d7Af-;ISEMs0wBm)|5 zfVO$rqI}-G+-LJQ^Ig=3By1l}oCSc#`z*{ROFtIO7q@PLQ$PGRhs~!A6=x|I45kxY z2~wh%Oz=27NhPOtM<)$hoRGh#3xq|N?fUWD#>O`F#C^dG`1tr^A6}`YIerjvEclT}g87e~UT~o0DfGxLP7O0gfblC$s;!4%@=)oJf z4I-i`+YlARC(|WDCw1-oK!Wjp7j*z=ab(WU_mv);(EaP*h8xWPjhVpC{*Ob{DfM4Y zKalbt(O%s(q4Kau7&+w0;o$89V`8(B%>O>$K!0WZbU77W{Am}LT4Y{(b+m7}^{%lwY#-2JDVj{&*m6sbD zTXq(OQf8-$=$DEdk*xa5`LB8%8n-zq*2=QEifPq`aAfKbL&*3rC>#QzHdM}A3vv(y zGQmdQt4sFEU9-a75+(a(9}L8p_#_Jie|QF8oa42n8+<((U!HrT0U-dkI}&Tdu&WBH z=tW5pL&|{`lO-&dO+Is9X90%{IKO>6f~`Yrn_~Tn>8tbRin`HhS&tMTx+m`kUw0NA zEt%;7X#$`=g54bVSgjT}G%9s{{)}LaABn`vP1Y+T*~8t|d!_O)lzeV)G$arhKlYPE zE3g!%yb6v-t23Rh^0P?^mQT=I!H*9JXn2cOhwhTf!$8k1?_>?4@%|d1q3?JB%C6{z zG^x97xWstyuT1KNMHGb*7__0XtKQZj^j{Pi^%ny)ql$*+wpM%mhWu`fJo0SzNwcno z7VOawlFJVpeyn5~Ld4Ss(9=zF)D-!d{rE{yR={|=FuZ(91W6LF@^}f!GJ*uWTY)5F z_&o2lK)$oME}toFwQQHj57!gjBjPh8(pGW1;CB+N=6SpzO8|zF{B`SdOQn;FCJG`d zY5UWHUX1TBcRpmUjoOOh*S zRYb*?W=@uku$vb7P!sZ7-Bu-AABuP3Z1`IcA5Wk}|4w$bvQHTQ;+jrzn1u+Bk7s~c zAE{Uh;~nt;c2__>d2b!V4kbd@7tau z0ksz@T{S+_jm7(PBv3lzo+bsipb3_rZI4p{W7=uHO)JxUZ+w}`Xrn|@WLJZ^0vy6| z5IAfAAQ&YuM1%#24TmwPDxd-T}~JzQz?<|DfvP!hyjQMa&92rCjDd3tz1KIH z|K>gGCaQhooQWCQF3@yV_PqqUYj&|u_2{S%l6Wo)PwExI@gUizoS}xsTN-^;g^`TM z`8K5j#UO=e&Yilra8ii<^^dZRikBHm*(nA;6f*V{4{jfiWTwOOVA$A$M%?!ai=aU} z*@44@6uU;YowTUWIL2FDQH+2+1+Q1lV*A!IX5}F(Y>G)+!Hi7OJ2?$vpJU0BsP{u8es8gS)_A#I$ z_E#=?WgD02mg){GYm3XN-(P24<~iI0?Is$RmyxarjD}*zosa(DmVHq}x3_dQ{D5hi zPV-2ssYQ;5ZtUcbt&{WnSa1?va$-b+39(F1=*%(>NGZweu%L!x3z67KLVs#Si`kqR z{%nlvM*GgocVz06+uLm}Cu4eWY~3FT1{P2dURq!VfEUs!b0KJGvU1%tb9c`{6x;@Z z1f|QB_&iQ;h@nsWsMyqw>;ADcay}ufIChN)mRynPv@#LuY2e3+x5lthnS*9; zt$dV0)ZI-2FKqTFDg3Oxb*7ye}{TX7RCjItOOc&OmZRm=7+z1q&(-gdMNO zR*-Y)OnVTm%wTW-@|xEYmmSI!PPlQ~HN63D_45plJ~i#nA3Zdw?3#+~!(%dumAjek zoLn2uWAuIz#}vmEL-uSOI^NnF&u5(!o9e^+8GX7QPgm)eFQS`#r6+ryEi}tMoE753 zx2rY$EnT}bEo5?&2Jb1c?AG&Ld=}NU1kk6gOD(QAsrb-b({rlUPD@{VfQ3hv#SJ0b ziuqc5f_-GFT+ztnyCmsWe=rNLHA`%W7j2l;)oZELy!g^hL?5bY`RuMhpR#%`dk)>{ z4%QN>0v_7}$1my2<^KRr zL?Rsg*Wmn57z9REcIN-zPZ4E;QM11KQxGojM#e?PeoB*aamNn~!;Wo~X3K;nvy64(`q9sm>3Z?pvaW;$vja8MCW3Ojd6$ z?0@U!xgi%3XOW-vvN(DJd;Pxq-P3;R|E01sY&`w`etXU(hcu#*jZC-tczAd!5tLPjL@n{&Y zxByKZksv0GkUxp{UXZ6E?_9TU-Xy-2O#W%E9Y>GcmLX)Nh zVia**flyWfB83FS#rUVD)mdwrrTmT|k)9)`_J;H1;pH2xj8TA!hG-Ih(i z5(%TOS?U7E12?J+Bgu~edc}%l5Vz8jDj|Z{_qROZZHdR%QU?9&%=zW?=)7AS>MycU z=Xpb%WjKnJjn{b`X6gtjgUtKf41X*~(@eW-@2jo{&~o&G@D#8|^gDwMLj1BXNWmf~ z;|=dxhfF(0nM{Pr)&<&zypoC)IYKDO)C5g+gQJhy>TdLDkA-o_>PVxG>VEh*7O$PI zOi~p4(4ymC8wORTaspMVG_tt(Dzj}531~BkIW%wf7{6$tS8%R=XR+|yhbuicd$Sfn z`1vrWElIhFb?BK0jfMG|)ONOqdHF2DT{7voGH86ABusN+97sA(1=Ac<4NgQ7S@c)_ zbeqWp>h}iAFPe;+Mu>e0)KiwlgCDt0R){|f0`#jIh%vu5{k>)S@ek;d8*?T94+qX93f3d z6_u%9fUWp+05Az3jDkNYFpA1pox%=V?gwjygcq>Jv9cb-T?8csSb2`D&yB)*FIouZ zLQ84{=ZS9*LM0PrV0rHrhR66^0A9?pn6%Z&3t?F1_9n#>kvC8%af>Fp!W}>qYB-1E zN5pn1fx;=Me8-3(?(>vC)b>5yy+;UffO2+BQ0Zo=G@S`7AhzG`*wnx+5Ty7z6K+rk zZ}X>udkpb_oRc;W5C#*RdBey*)&hZ-M;$$Mlcw^{BYwG(iA2RH2y%<_32|WImm$Ic zVaY80gluK{MK*3(zPtc|wVJmV7)l(uKlau3VjVpR$T`-Q<|Cs-eaV@4D~_?!`E(%wHh`cL#*_ZZe2@A&Zc$-aJL8G*fiI$i4kK z#i$h&&@Io(GYhblOn7DEa zLj`R~Eb`T>8W<5SaYBBLDM$j8wIG{%hF$r-CvQ3n%OUA2w5(zhXCA|2Ji4d0GT+ zwdkgt9tKO$hb3tt06s)GA#k%YO?r^%O5l3Bu9ZX8lXuyN?dL66_K9-aj=JQtddRGcQicFh&ocC~onl8#Z_4*;Jl_Feh&f_-Hj#5_b}W z5}N!BP?z>Abdr8*B2f6qr!BDQeYG*~WWW461C`CmP$b^IK6PpJHT3X4hu{?PK~>!o z&hmQQ}(h&E2N9fWLq@W5&6&{UBmXqpa|CZT?l5uP8y-5@Z z+f2r&l9BfN!Z##(tFW?y#B2sd3sGa2o3kbzybxvau@x(Qk6mDgGW~JQxN*EpM|BF* zP5-uV&F=%s<7AE-4x|(wCmfWG8W9CXBIQGkSi%e^*;W*07gOD!FH+jO&{C-5(wQ`7 zVE)S1_CxOE^w*fX-vz0ot7nVYM6xXA>pLG>zUlm-X*GkOz7aX^obo~TU#sv+#_cxk zp_J}nu?r0D73B0rcEA+Tbb}bxkexFoty_2n_1HYIYx_YK>k$xC)8X>SWBUO!?1YOd zDHx;Q9z`AZw$eUe!Bt@CP@g)hN1xqVM(*}^W)u18Pr@f7E}TAoHWz7_co}d(#rjvx zpG|#$Qj)*oS_>xd$lt0nYdZ?y0K!B_{oLe!r(UVU;4?wPE!5GU&;qK9P8E0qy8jrV$XR0S7_m=905s03eM$nH7tgdrFSKdqazQIHbJ&n)bwsov| zi|gIS>Bkfje6o0*6_Cfnj*S8)Ibxh13li!4!uiT+Hr(06@Fn41d*{3aIh_(>~XHkfXjE zg@(j);o$P21HKh0+Iy35Fmottc3z7n$ z;Q}bJN31GQVshuVe25p0^<+*9GK_aBbEnjZMJ(*MJ~>6%rmVIOhSdQEs?ft5#%F08_>2Z~SdnG!kfT;?-(IYN7-x)LepslSATZ_M+UA@kF6kHj>yoHc2`GJGILOVUgytQYkBOf8KI8Y z_&P?Tr864GO+dgKybV};_~YFSF$R3Yw@GK?%fr0>n_q@|D2C21F1|qaOfhun@2p{} z#X@Az4|3#Li?_6xO7&kX2-kxOpPc-xiwcnaU2(GtZ7#hNcBC<Gcj~3{vt0H- zl^ummA1ZUoR1oh^v<2l$LC~LAqCVc#qCOv86z2x!=ZnF=nRP5cvX`(=r3?ohl0O?D zeA=ggEZ9jK+=l27=R9lbRN@Bc@=W`6eB7g`W*C~{@|7k4^iJ1=?T12;JTzeK}KQV48^^TwKTKo%%82kx@JW`$YF+qIr}#3LcqRJuRj)sC1Lxu+}`m;gSht+?R|dND=t zT(Y{~{*HodzZxztXBU^L_h?82s$)Es@vKBRBg%jOorbEl1{<04*wvOVpFeic{j3g$ z1K4D+h_I6#;gsndrd7xM06?QcpRabuLE^xOia|$L3M6PI!zp%B?pN=pU@^HCHN*oz zT#6&M07~%t^3y4YNS*Z;qJ--mKdqf_Ff8V{+4@J0h=I4liz??QH_O+p3)YAhfLD1+ zsjA*wNVTbsI;$E-^OW$!cieliG`lI)7OP11g#B5jk|Wm$p3{8WjbGr&y+^h^AZ6a+ zHqfGhbAOR80F(}YwoF5cKj}L9J}8MNL>skaI7>0pEs>KXM>4u2HE+-a(fdiO;BlEh zwT}Soiz6BkspgGTOCpe;r(XX!VVCNRVcf22>V|} zmZg1_iXm#JAa;AQ#l8hVzSb0W{cNL7|H>Z#9SoE^urKoMuu~eMK;h(HG12G&Y+Kh! z&xUi9ZT(%vq}x<&r}afA9ssy73Fc$V7?^svA9~N5PEWqd6x@c`wB_QI5AG4d{_K;Ybyirpp z@UP#$z;USfKfIAoPd)nmsFv$Mlm1X?3x}8-zYsx0bI?v8g>syW2p<+LP5z#~yj;k< zp@IM2X={EKZ<-P%y@YtA4;mJRnQjIk4=#4A176EtG8VAC&uSlQ~kca#We4;0C+ zsFo$IX9Op-A6!E*&hxOXYltkLq-CjVSIxgg`}Gz24Xo;YLiTT;fh_-tOToy(`j27# zlKRdM3LoM3No`#ONR0B$)y*Rs9Hl)iP`;FXaB2y>?H`*dPT6T!j)<3o^rn@X7M=e? z+B*e@60YsGv28ntWO|Gm=d$ZmTGwlmwzYD3p|C2Zzns>zZ_Jr?d|0WK_4P*-=GQx}D^u-=nI@PpB zBWIWAhyT|DXXEAO`+F}MgBVdwjw>|1d_OH(-fbFnY$ZCs9=Pt^-_+j56jJ8s*w$te zQ^jHFx6nR1T8mt$B-{~=RI4EAeqn{UCX~FWes?3GV4MmJ&QL`@% zgLshh_u`x6_FN8V>Y|9Ac@RZW87#k{XI{OFiV$gNq8wO|n`EyWR{+y!qO_jh(4T-V zWDplcgrJ5If|POz`R=-3Up_^^gA7`B6P)>oZ6so3Q@0}@XBN#?KiLD(TW2t;)^Ok)_ zGn8AJid|i7&HI9T)=p-;PQ|tw8DJwiz;>9O^#wbIc_H(-^f~Ce_foni1brTyy;zFB zUS=#%({yAZ9A*&?!}id{F|U4%fYy9B-@h0ufi0T^?6uI$7_U49OutNlsSS1^Lu>Mq zaQQ=y>L57CM4@f@^nCTg<$r$?ATGBm)0Q>bY~&+e@2yKQNt`zRX5CXN*Z69G(1FJS ztW=rL<;^_Zn39QiTMJ(LE0GTZiBNdkfFt6dAJYs$&INK;_ax+01_hokh$gxM&}Ke0R0enUGc%U`T0X42he%@(TgJ>8}s)1p>rAO zQf{Pss_$z^@8an=bL#Y@o2n)`#|;D7gJJmaNJa+RL0WmQMW5W&hNz|H@Q58RY^f5&Z%JtRpagZlgkZjKMEopuCRl@P!>HI- zL9tjvE*!L!#5fFs1bjhbeLtOm+TFXc>Yskg)^;sjmy&Eq!k`g|{q>o=NLPVnj!!xR zPS!AKZ%u0&oSMEdJ;FYyvkMhatbS_`Z&|yZcYTP-bJ@EbY7jf?!4IhTFuBhi`M;cdh3XQ);2*K1P33j*$X|o~47*>y^-*bNb)~g=yL< zP~4eP*9V>LOgUJ!(=x48nb$<{aL`b3Dyz?~Udhv|B8`kW!vV5ka$@@y)2_`u0Za8_ zC2;y|NBo&siI2Ig`*xA(Ed7b9IIJ{GQ?Y0oBg`T?>7Z1QGsTbK?5xKR~s_y%0VHhEtjDh=0*Lf%l4 zB=$_ZzMZdU!bfBV;e(m@gWG~~+l39Z99{ciatiZ-`DZAGsC0smW^=DMRKInVum#*E zZHR!3UE_{qBtOhJ88;r|z1F;V<4E&@fVHC-l!M2|Ko2aa>RjeLg%0X)6GnZ$&H`T6 zu!gg)88Xd@umbsHCSX&d{;hMdQCQbEgl@4QmCH<|0b!Wq)6py=HvUu1eagWVp>}4F z#)#Vj3wSSZ^Qv1WJmv&%*0VaY`<{#1F`Y%={*9h6KH8B9j)Knce7!DTd*qs}u2mP_ ze+oR}#nznxc)#)udO|2_=*gGG=k>Y$PtFxtKn^W`a2&5bKIW|v{ zwiq&cNGBUHC?LbNA68bt{#AVGyson(_`5 zsxebX9;yC-qqaRqi=IHjXjFC&2lcP>w3PUPu%QUa zofKL+X5htUS#wZ}Nt)|CFAb}#{b;=sI?_`$QZyK4pRVxK*+J1-xiTnRo3UBv&|%yP zJRR&UJV+1m%vxFJ-i;fiAM81w|6Ml(yZ>}MR$Hv67Hg<1C5g;h38nsu)qXarZ6A() z*9&2bE91)UrIAuGP0*?Hgg1xA;2j)cUWS(D&OEDML0^y1)cvEx=O7W0XxL&o>0uIz z@dK$Pux^qH7d-$9#2Fy;)Y(pkaT=ePqa+gyPdknme{p7q zRMJuF|72{Z;wl*scVIqFin+?(cSfa@Vb*ZkkVOW92~8x&cO-tiJMIz7{`Z}(mJ*0D z*P?uUkJnSN*OaefZkYpmEnL}dejb}&Zvj{4BIlL=hj+c7OMktM_l*poG-^mugh)iqi{C;wT|VL2lxYL_yY-)@;9hH*(?*B_LgF_h&xf zq44a>2_w$6S?rTAa%kS=nZ8X(+k1A>EE0kkSZHgb>FOa2@zzqE;B)lBdallPEceXt zIZ$IkS{HC@md+Ih>%;{5HX4rF&n1j+dMG^!?z>cl1ozs(BpLz}ez|2S+X&p&bmEd^ ztP}+`G#wB~OBz(raiptR0$EB*g2V5bmjYkOq8TT{MXy4k48JghkHb%6jG5m0BT@D+p8zqj}G}!=&j${MffG!n+pWs0-RQEkTJC zE?M7H2VjEyl_GBX@?j4x=y59ls3te>z;!GiUENxq3%L#jw z2Hzh|U36d$aEMWetu0hk*jwx?+73(}=N{tgKv6nNB`Mf^WIpU+bxT*3ftD%0?+m>z zj%Fd5J<2Fy_d{$%;mux(%Ki@W$Ej5{dW%-1Sv;Hn0|52GqXU0Y>Zo?0E6SlW!smS# zv)gM#Q<$G5|EMgTgE5Gz4y!GQWR1Mum2Vmah3FKE${#^l89zZEmWPU&7y*l4o3v20 zu`FCCq8p%41ctMovssJY`Pike%NeGZ1@wX@Z&wzsiGgml{!r@mqY!ktbeXusGrBvh z8L5r7Lsa|w&Y-VBYdc5z#M1!P--tq`udHakI?DePxLKMWjU`~Zg@?_ON~+@A$~Qx2 z3$7BWyr5ac18w zZ8|-<8+LHmP)QunZT1e8synqx2dA3~1S+hn`hjEeY9+2JTD)lKfy9;DjR*sdJWum& z!Z$4tT758Ys1#Z>j5HnT#Fdlv=1(<%=zpEOC^2rehEoVVxHt$d=KlleW^rcx=0l*5 zxfV(%|A8^Ji1H@+FmRcBw_-;XZ zm)Z9t#scRf-o#wG-9S$et)V_ZC{psomAkoY%G}4M^xf}K>*pPU!r6M%=wnZP5Zwp_ zfD_(pC@PBzdE`zMG-aa&p1gO~Zab}oJt(~hlAa7_ZrY&>5=dKf07Ed4@0-9uNJlyaqk#6u>P!db5{V-N#@SpE4A(=vU57fSi z-Andu@QaZWB0t2SrZW8><>s$~E}ViC6As0CwdfVoOt3KKO#m?tqb)<`{V`>+TDG94 zbijB|T&Fh|;gg`ge=!dqH@9jCtcRXrx2qBTN}XOMUKvN}{XRL3JiGoG8~6ih{z?Sa zr(~1BX?p`G_8mR3(5qw5>xK{W>}V40aeu*VNdeG83E>K2J@5px-vEA&7dH^5VMWOx zdV}kIHrH@uu?L?G^qRUVlmkGHYxxuev91K1rRQ!i6m;eHe?m2wlJ{cDpk=%Ig#}iT zCmY|mtXd?2f^W@rf-o4&)MYA}b-QL+8|M+|t0Q?|7nq)k_>pz~$@N=>;cPLZf^=fu zFxA)*?s(0gE;skM@m|`X$-E3%!)_v$U04`ABMB9t4hw$v6uo|1yqJgu1M&ZWouXmE zs>*`;XD{wx_Ac)uW%fFEjqS{3OwfsK6P1)54W^x~R`GI&Js7*N@$3FHNLc02{}kOI z`14N4fJdh3#}YSITX`JIqG@9{fqvVu+F}!AknMj1RI41{PjVpcZte0Z)hVEO!4645 zIJ3El2sTdeAzn;hZG`5fP4Mb*_CeRzet;Pq-u`8G{w8s6az(jIH95rWu~&DuNIQi= zFdF%Lb&La3S|GhX;l?@8opk$Ff~7!&vPw%xYNhue@v`1a*U~lATw`TC>qCd1o ztlw1Ly*G<30zN;0no@eI>2w$s6=Rf)FhAx%#lm2Zjow%bFsmhCwMy(F{+9Ri==Ufb zZSkLGAeR3MXTZqJ{=cv@Ga5TdTdjzGH+lmO_<}R)^mnkHrSP(uR!e7p$)27{dU)rN zu48M3Cy7#`w)}d#)Z>XvPGwz_N{!}lAgf)`Kkl}4=s)7`s{Q@An}EL2H!QP!e3E)P zkud4hHIlizI;PsE+Ko#bH)h^%I#f*W;$93@E_HnMK2+gpP;+z|qj&GPy71M9;MWgIua826UnBwBeW7{u4k;b`@}iiEcTmKxUHwqCcY^a(=36BJNSdHW&ZY6pcq=?D7Wd@cI1 zD`yE9Z00c9AeqK1{`Km!aRBbVbi~h)6S_2iKCWkI5PpyVp|>Md&dE;y&K!LN*1l;R$rAwE&-@^0!Y zgK_o1cSDo?+k3&~d8K9e9Q%sg*QTQ9hT)q#ILBx-Km~NKEWf(PO+bO}0nN9}=?8B* z3_72@+V=DXT#2CSvD?g3gMSQgRk?Fr*`v3#+PMpyHY4T<9SQgg#0s*rYlO#C!Z?k~ zsE_PGN)!>Fk)&;+q2?G3igmC^>Y4Es&nHDnRU|Ah;0`pML6ai2`QE{us12M}Q*(Tm z(xA5pBk=l?`(Z#j!}J;=!DsBh4dPt3rLB5~>;D@vLseX#D zUuLxEDWFo=Mw%gMRrH6EkHk%_&y*-aj4LR_^ws9bVg*GOM9hg$_wLGvOBGmyrU48t z#ITZ`tmQW!Hu3+v42cu!P7gH*!jDcBH_&;mr0Z%Ms36C_!SRO4ubOEA2q1$cXET_a zj9CEFDwqa0v&qu4>hq7y4WSi_`*}>B6>mtc0&(4FT|IZrt-(bN!QV9&*@yh7-?3TC z-70P;^yW};8>(j4U}>!@<_`Zj2DmMp0_IPlrQku~9E^Xnm71Eu$9qS|WK7@)P1{YKTa%r%vCEAl6FacVpIVtgj}$iNOiA#A#Tm4Yu=}0q%m34{S{W?}?_1Cw&vo893?#5k z9wm9UPIu93oZ~gi+SwhD7_+b12gn#RC`)pRqZWvGOea)TbecN=JX`{`$WN!=TmdNuMAwK7 zF3blRm{Y+XN18-a4m7nN`SQKGKXGW_HG)4;X{@8N>YSzI%4Qb~Wn{$l;@pLj1&3i*qV_ahCdpo%r5)>npZJS zk^}B*j)c? zr!?~Jp3JZ!*f;ljD0fVeZETTrb^}s}x%mS02ZuZ7FmQQc!85Y#R#c{ykXxjZmb5z< z&k-ijEMPeofTCUoxB|>i8=}|~uDJZIiC=S_Zg@e?tg+q!3I!5lCDyW>8nizP*xP@$ zJN~)d5f0CP7BPkDxP(A6mA)aff?c=2L*=cTo5Wc=H(YwCoO`gG6S!#EZr~X*y4223 zGB_$DL%5=VhH>tKMzXs{yfTMh;Rz(Nk`6>+`pVwteb4_C*_0_-7&J*pp%V$@`Ka0sZ?6;Re;mc2zf**8-``1nNn3es0p7f zZYFJPMiu9-KR8e`%JmY?`eBaYtIj=%fAuD}9ecPs3z~^AFG_qY&KQ)7!hSixKDuaZ zPW0Aq4;u+zOb52VO0JLa7YtClNmge{5VT!B6G?B>0Fo@;soGzZy>kI{QFT!0f21}G z)Q3wLt9e^Hq$TuuFR^=^3JFFA3Ml$_?_1f%Ez6$5fF;G}^&@pYQ`8|UN95J%p&dXE zuP=4q4RKrHZKe=LPb#s!I=`VG3w|iPc#f#;Kx-~eAB{%&`|$kz9hCR{vr5a{Ow-dB z+!qo)=?h)2?``T9B6x^6zPDd9m<~nk0I}&v-sVtbql${Dis7{e0herWg+RxOBuElO zTZfU*Wtq3&C@FFwj2^pk_Hya?XBn;w8m7QcR_L=YyZ7P+VRA~39E11fv~P66@8tm> z>+$une@xC$Wb(KWp(q=Z7&)*J{woX#BQxv&wwr4FcEDJXdT;6wE`wJ5vrax3`tceAz}I^)elIeN9Oj)Y zOp>0(t;MsKB!0e8)aNTRty>x(UK;ECPUMx9>ecV(R16=<4bg*qshDs-7OftW->ykL zT_>1D!wO@KSs&3G(U6D5Gq$aKCwshTAHCLUR)oT{(<_!VCDVMVd2l8@6kRKFY(L}w zQv(A|{K6K^r2n|qoF1tSF$r$4ronBH4lQZ((Bft3ORZ`-WHkF0JGQe8LnKB4uj}i{ z`OXjCt+gLNn)AlhtHxH=u?WD-gTRrAlwF#Lg5+rMSqW0w2Sc~f5f<<5F*E0F({KCzd7ZcUbN)UQrWTauwt`Y5H$r#p zsrMM?a)&Z^Wr;Pb+jXw@JapNoEAoKR;?G7#rlssfq^L`9|DmSTYysU%9|e=!<$%xw zC-{Z!+~Mkh5N7BG7F$dt3Flr+=hT%gGSg*svXK4D)M68bX|adUj~We$XU~2WU*P^x ze^hb%QCxuscojVc{q`=OdSbg80<6kZQBn5L;lbG~kIdK` z(ZXQFY7XgO+~14L>c07m9^a$8qD)k^5L?$*R;xvs5|VffVzj{aFE+gkiBq`OU!yT` z1UG5j9@S=pNfejK1sUEA)2(g zCcsescIr5DI0XL2Ik(~H#&2=2vMp5?gwGfuzGT%+zDXr<}s<&dN zn9ui4CcRe`77AhCdVTN`^bQKj;$$=_dhEl|YnKKoTg_ zZRAZZ6fuZ#or$2Io_|r zIL=OppsDZ7CwW&<;74jMWM=@`@VHAgBQzQ;(}iI`DHP%OmRrn-a>)oWM#-~l*_ zmf#7C&2;T|!zn`_Uep=?CyZV_WG!%(zXm_ywL{oqO)-Dvpx}fs zNLBuMg{OPA#pobx(1tEGh|7-3mi+yJ9r*2n;J{9gI~xK3`tg0=-q9kF$ZI+%5F>!( zelFxIP;Cu`T!9*tip{A9@wIEY*PfwZK*d&@xy8!Z9&IA(=})s(VhV{F&@6W;-}2&l z!82kKqX;C?w*I7#K235-h@;5*_*7galfY?ywblzB><-dhnz_1 zzDV0kc|V0eZL|e(scE)5bgfO2(uA59Hj=dTyyF-H=mz(SDP1*YloT7u>P$G+o2q06 z?09E8a|LjAiK&ATl04QIVIXMyVI?eon+kEr^TL2i!;`GDIif)L?O;^eXNRE_M#zc= z_9(D0g7CGd|>=1QgBJv{V081mj^;ZW4@#&!khkTBam41qu#o7FDq5kU-I$NQnG&bCVd< z#JU1LI5kc+Pz3^nsF6>HE@qBjt${xnwxS(KN5DyKNb7onCAb)tD|nG@oU@hETSyj> zzMA`C6FH3G*Kn)GR=?T-c%N#1v%IB&^6Hjt#o03}CdDkGZD=EXefUxR=#54DiOO=% zM)F5_b@;yBK$0RYZ(YCY=3SFN=ey*=DAMi7DKOQJzQA_L0S2aMaTTC&wbOkg7IE2o zL${Io!znAC&$ae?~x1U{4)`ZDyBN zee#%@aJ_QSsE&g^=!nlOET3FTMOh+)yff!i`dQj}Naz|BG0wEHZPXPsF`s*4;Mc&y zcnzJidhpPfm81%g^730?D- zncMZ@=PSaEGe)uUr6}2#$MNPq)mKU55W|7L6pev-z`G8_#EtI?=vj%RjqiT|HNNy? ztGNLr(?yL%EbyE@Are;Nz+}wgR|JVgpMtB6{|l#AJmD2EgsNa87+vmo@& z6;$an5qSbywG?p?cRGeyjO}Ec2I;RHDuUJF>h)i6RP^t+IHes&D!anf5!~Z+JLaSL zrT>G-3{~q_{8_;tm(fqc)1_Hh8uqY%a$`e6f1iQdr!)akTbDr64yfG-5iH-4jG(JZ zUj7%wtJuN)H@t?PGpYtBM0(}xXa4=4(1lOKMdJD-CP*d6;Oa4KT=6f#(fA-zY`WGR zVn{0Y<%jmO#4gN@OI&H$&*h0Y7E2tpc2xTHm9Og`bY91&&ejE6Uy4l=UvKSWS{JiJ z8_$e&nSt2Y)C|*03O_A5>5&+9V-t-^Y|60P;1);(wa*SpO@Y4#WTBBAe0pH4ccP z`R?fnw8Izpn{&Qkn&vHPqtT#^pt-u?7jn>QGzj zlUq1nKjhp*C(1!ek$*M}+rO4gI3|7Cr+EM5{)tYEHl^<9lu4IKC&*}?SeXf17U%kK ze^MF*{WA*j+Uoc6G?&IVdmOB>khytmXY;!;BUB8`_E)$_9SxZu?u}>=%iEA?n^4A zSG^b|4}%s5Js@gWysCKw=bS zlQ*hkf@1+Fn?&1rYjznscqW5zno%9pAQE>B;;2bHZN;?972yi4k5?FG_%m-*`sa<| zC=+6H%v$4W(iLLEjqcmtrG>6MYOAudUk&}sGiPng?uzfd$nUdx%ctXX==0p|W!_Bx zYO>4qX)iYT)U_d4f~fd}JQh)i#@!l1g~&RX;PtO%u5PCsml~}OaM%+6e58q%vWYI= zr3j>;KoPo#KsZqbt}#NWVx}w<)SLa=e6wv3-EQ?m=^IAzTb&dU4Hh=-tnKhddcD>w&IN&Rn%VG zap{toYfg3kKa)$6h9SHEewU5W<|W*oJ$OGJXGxjPo@TYAF>?`r_9gh!JniK!YLP?f zQUEAqlGaAv3;z9KSaK0fzU*<*Q+=zoi1P9SOOX&#zVD>@ocKMZV;VZUadHW$7OI+L?Y!pp(fEWuqjq1%^OkcC*umivoF-%vqth{s;Bsf*aImB{U(UB zU5wKphyce$jMh-Wcj<QG){F?uK_>M5+Rr&DzCHvQs;21L#3Y4hHldSX!sC7Posc!o{&7BrL zDd@Q`V1F**<;Am#$@&-5#r9AkUKHm2TlY1jxdHBQOobcqOfB0${kqP;w`g9>XbLCj zi5kcLuot1 zjRGUxZZ&lN=8b<4gz(p5WS)in&}tws5xnODgSsuXKtS0ZAVtIi3RbHI+x0=aYi|a_ zDb+V!xlzTm3Ce#S1t!+G*0P6y@_Z0}aKW`VeY$HFh6t)hRgYcf|2Sjp`OGK;ln*sz z0gDgiB1Ul1Wyhg>(Rq7Rt{2pj`X%-~oK5#s=P+?j#E)!J#<8y?E+0ny1H zUSxf10~&N>2D|&%?$saGLlXhQ!hnz101BUi#{9Wu{^jZgN%Gry5hBKEJ4 z`}FgRn$lHuy83j1IzKKuM{mKprd4*|C6j{*dj1-8{-I-L=nW1{eCIO~(41g%;4{sq zq+{Wa;2*&tpNP@qrZG`^+JwZ_Gb7`~0VQz8VGC@&?l+ma)uR`I4i@ZOtQ%bA(bchjh&m@>VVsRBbXfX638_=vcOCV$mo9Kxkw>04Odcf`Ef>q z$W?Vanccc5uZ68s@~1wbGZZ<3igrz{L3nxP4N9%;Z9tkV`3gqG`VpkXkb8OaZ!Lw_ z4G>ctD?bf5w9JtPxoUg+vSyLsb zxf1Zf8=u6hc7G&(FzzCQJ2*$>w{x5dK!;m?K-!UIwO-qzIcXoj_IE_RiVz)T+RJ~W z^YiqIG7|%Z44Tk&2NC;Wx+?cXp@_cX)a{Cm(mYewvpJrxrdg!l@Lw4r&rD>^w(fSk z-hlO<>u9mh#M}B&FL{wE-`9I&@ftYLVt^MVA;iiv- zL5H)+m)coo6QgN3h!#5Z#Gon!GoCkGf5;ETWF5r1F?~HIf8`NS(0|V+D4XA(B`*8U z<d;e`LC*c?zbRwuH$j^8LbV6j_@81bp_ZO&dJy*`#q1m z*C93>N9SO@bK4e&>_6_4v;LPL7MB0@bMNZc z2)O-!Kr9dp^Ok^7h->J+Vek`+p_*JXz&t3B z-BuAezD#@F?6SNh>=Ot0vLpdN9*vrR`11bL$w>q{6+6WwJ!FAYfhZMcNY2*LEw;Ih zv@*>Q6(yId_i7kNH#|;zuV>6mHb+f8>>-76ASnkLcL_0G<@WN9sLI1R)~r|Sr7*;x znA%?5xR`CS*$uu!MsrWp2g5GYaO;r&LI^ew2`miw)IFQFsyiEZQBuOzTt`kkyT-#M zFC3c)7_VZ3%sJ6yFb_fe0SG4Qllr99o}L-3X2L{9A*JwBqw1BS-6Ug~RRk7HWbLK9 zSCn2>)l09gDZ`J?f_}!q&yZ7?q8W(ve;69|tg6PxK*>$6cjivkwF4du<}0 zI?E_dZ9l{Gv|GP*%<_0_r&JVF;=UJpe2g>2`ffY5Ptr3-uhE9CW!8PnHto&X`YXRO zRTeVQL@LH$J|jpm3n0Kx0<)86sivrYoZyD=`(F=hifr zcHDz#m&${XhEd=py>UhU5xktAQJDS#HR3r zT6FnH=h$vPX`Jgln;=p@igw3QD3R zl-rnKyelJqIP+PwJtC5bn9eg{OJEmgF^lG0zDTu|mBHzXYCeU^q+zH%^!Can3tlpo zz6AV@00yd;44HSA2j#+sWzy_!_mHBZ!yErSven8Pn%;)p{he}5UcNnEvQLxta0fi# zH8pq(YNQO+5-0$HeN&CR&zgG6W*p*FXuyUrC#VESQZ4ikfe22Rygtg;27PR*)Ir=D zhVGsHdo%gw13397WTZ{THhR1xN>~WRcUyZbH|_MspML5<4D@=z1N0oyF=d=9g@zjk zC`GuVfdg~<_LL1cA6k^Prp7JQ=K-dgCbzz(E>AUqafAW_V{0etPr9v9>!{ISH60s1 zm(A3+Yl06L#oP~O8Q_uOp42*F@u?BYN7{&0y|M3d$aFkbu6-Qn32M0 zp!sm~Pmc}IDc_*0n3~M2PH4}u*!=khB$g$0gs;KTK%(3SiP;GZ6d{^FvTXLHBglle zJBWqH{1Dukgdo6#+TFnj_Po-(gu>iH5Ndxh1>05UO!WaO$f*4Vb3v=DlR-gu@;0qf zAYxi1gJ<)qSqz21x%Vg#XZo6zHoHK;YsC(HOrzm1k}7M${Lvl&eb9NZrx%$Tfop6E zw)w5aiW?lJ6h(VbC@O{mp~Vs7(@Lc2;)YzB+F2MnwDSo;y}hE14932}oN(%(!r@eW z(a^p!OD}dF2KD-HXoo_4R_%>IesHG-u;JWz7%VdTnjU&;*0vhY!Lk3jLK$bebW~Km zKi@It=QUAWTk~G)5R5jG3wYEGb>7M}JhT;TY7t*; z_S%I?;!n6L^4o2A*)nwSQ(s=v_PAlXu8c?p0$hmmc2Khav-{9cS@6Kg7uoCOa*lJ= zxEcjDC`HBX^zRAXn)GQm9!WsR+VslxwJbW^ubLmifM+7FBWSpPxu{ubqGfZv#5B@~ z3uU^amTPHFOJkU_-5vStp2|@VNm#4EjSm($8E8mz3(P`t9la^Yz8gBqpRF!h9t;%<0Sf#V>Dm?4fZ;Akq4sMkZ(fr%tfyJk6@j^QZMQiG3v&9i-@P}yP(fH5YqSWWC?xgq*J%k60|XCWJtOL?fJ~c1m*6ff zOY4H%;}m0O&FVYPE(lSm&#cjp-@ET_dNH&$K3Nv8Aa6yPmrkm5%Ke$qb?TrBwx~r z2f$hQyODN-Bl?0EtN0p5EV1v0RpYwAwzi;VCmyVnT!I-}Ye!s7B&{&2?A+svFO^Hn ztL=x6C>fuOvdikG*VE;1Oa$AZ8fgG8N>zs&os=d*r7 zrNh-aBl@A{{(~xzV3?sMYR3YxvP`%cO&qIL^U_ABnNA>@?pM4D9eeaq^lK=|M~9SB z@ow6;=;lkc`dD)bPe=?Wm-{=4ajF!LE|#8@s+OcC6OM)$?sT2U2nQukgpnZ2paW(S zXvRs*gEB)V9`;17!R(1nVjTBPi1Nr?f=To%tELYQdH6gY^LAT5?{wn2LN0-EAOi2z z8*LkL?Gk4xLQqfKH^g9`M#y7c(j@%t zjoIf2#vJCUx-ABxy~|zqIjz8?NR=(^W2r?+Ot5`GE;HO9%?Ult<$#h zsFK2$iAK(jFJp^jm!rO(mLH;Y?I895@_D51vwabb{I6Eoh{^(vlT#5dJZ?8u)|UhH zgmAFMhA7aLFAk;8IMvn9GRB!O+S*8tiShMuN!NKLqsZ8&2M`Uv0HOvodZt`h@4))_ z6yp_Mb38zOGK11#JIG^zrEIZv3=RswxkhN&yyUo@zHWq;g{6q`?AU2%Asw?8J5D1nSg-{PZ=>%G{?SHjFKxGDq_!y5j^!&kv=(l>$} z5oat)o;?ux1?_RKw4_g3+XjjG=7|dwVq)Ch&c>c57+^gZ_tG^#3 z$I>fO3C)shO8`gz>gdUJLgRX9dB1%iByU_dVFgCEXmS4APL9kxnC;8YfLc*Ji8nG1z>A55 zqg(D-{h9GL%}klyTP7vI2%Y`I&ZX-B>gmWI_(p02Miwz8MgJet2 z0Pteeup+E1LjGI<&{50kPx7SvHl}jlFHE#-z!(@~1OTghJ#^*}OP9vBiG~+DG|Z4w zEzJD;gKVXomjLNF;r!YD(=`^#Egu)3ZB_|2P2|Y}aP&U8C!LLs+bBJoKakf%(i`kD z-zEzvZ>)D+$@+|g>HQM=j(Dr$rb^Gu9CG@}3%d~c)|4at_jQ$AUDk!{ww7iVZPkg~ z-+c}4y*%d{x2(oP^6x<}BG^QJe+S@FLxp1E1h0~XiOX>JTEIP7sQap~_&(&H+> z{lx-h#!@G75N5)WEs02AgwNwo@e4xP0$7tP!XN4UWAcYh4~G8oAKI_O+5oy^N6Ef2 zVoZK5_V&GvV6sOK=hHOtQW{eC?w-14cgzqOpxci+wpKyT38e(>A8a53h zQO&nv;~3ZYg;M)Pez1hwe2MSB?nfz#=>m&j-T5B3<0pX4Xd;Ukz@3 z@}BW*X~m^2U949p4rt0LmO@Fw_2aCBp7m*Mpmtoq9}u`Caxfy{;Z4E0aqjNP@22ka=u% zDQ%13MiBI6VYd_CL*?WSI)~IitsWlVF6|KEL+DB7rzN=wn}_Drb@kxeCOw>pNhG_? zo;hpB1ouD~mf}DtmM`oJ%H#R@AfY}sM&L)kzYsnBelIi(`y=pB?>ghPcry~jj{+Ma z{a$HMAg}srdRy=mRXd&(HdQ4))yemL^Am<_oIP6i(~DnVYNOPnt8!Cjn~79-!vJ1L zu*YaCC7~?mv*6(NO-L|{Auh;Ae%~3vRWD^X!)c__1?9d54@yg~xfvRrYuf=MD7rx* zn8Io+Tw98j+ezBmf?VDgq#wm3>VKSb{wv%M0~`DQ#{K+4S(il-epivo^C=ffs|6nL z-b|6$|MII$)@rN6-CtMN5J-tG0+qhroq0f7U~X6`2Ix<6t}|$;rQGa zMtaTrla=-NP2~QPRKh+svb%p`gm!>(00mW=6n$&$%x>-YD!)rbltQL~TgT)#3DEA_ zx-c#JSjmdw`@czmlc1w@9&PoanQG z#%ikmHyjEGI+A|u1!DIfm96t`lvk%tVS6{4c$9;jxV-<6 zJ*s2p8HDEB>yRe_g6a~tV=T_)UDqzO)v48X>&v93NoOY&IQ_7@2?!P3YMGjz!A&Ew z4Z1A}6~j=fZ)B(J0;R}1i!12TvAbcvj9+oG2={B{11-DQU_r0#w<@=`qN22FtHXM& z{RkEAmB9kMv&3_T&VpTzMpx5`nPuM)&hsqy}4JKco|{FnDw8%|r>sxJax z863*{X&~){@o^qw=S$#RRQ0seSQtm zPJci`{bf?)gWgrvubde%eLq=b8juEpeeinXf~n$y{BafY=hc)S~pdW;7C5c0w_Uyw()UVofaz2ru~)M zrf6*dm5BP4Z+k};wFy&|LOHvB4&-cByHnbQbtW&P2FKQx+sSD5QYNNAP=*L9wWHV> z)5O3?2LF&Fs6k5dPfOEtCV(0ED8A;P6ZZ%Lxw$har?>MYc+iou21$lq&6~@La-QVA za~u#wJc2t|kguOdo`EvqL?F`<>UQoyqBW*a`}-v-)=T@`@gseqEG;gIYHS70T3vyLdi@Kz>^sy(B$YC4y17c973Rk zalsry)ex~EhDOs^0=6(8K#mV9Kx`*Sk?wcm)!TxbRO)F&6 zF}tJ14CSMS&Mcan@mN-KR;TvXipC~uDJP-VyV>pH+o@`tr2v||v_fLHdsp;o;nB$47(SelK|$+rgI3rrV-60$N3xpEgiUum+tH`% z1ErK6^?5Iz>YdIyWQ*zp1gqU4=6>h`A4b6zv%rmJgw3Y>zvDTEXeQJ6&HBkQ&ZYob zLM|{mt9mL-QMxR_j{B9Fpu782K_4Zbd=qWC!FW8qo8Ul(1j%{Dw&)W->g;Sf>~wN& zyrWwz+OO9LF;Of%=+W*uq#C;JD) z8s+|*(90Q9r$BQCc7m{|?7Z{`Y_IMien%kncuTR>{|Pf{4@6n=+Y?O0EvffS1uUNQ zwiZJfxY$1c#f86r99GIx9n62_tGI$zBJS_NHBkg@7e! ze$dZ1Vlx_@lQeQc>dg-MhqWvr7;LZ?4e*B)$?)aRp-;X{IXyQux zFtal<{r`D+P1-s&8^cKdi~_`aMa9ylz3ud|1uGN`_$bs+g^&FMkVg0!B%H_;sqwhE z&)0u1*x$~@A$vnmZRd2J2A41MXWDIsQ{r%c*8;518H|gq{h60&2ZMU>DXByZSErxG zd~+c#st~PBf$p(J(}|WB0Xj?zQ5$%JgN=?ngC6Z_&J(RQ-u6BN|L+o<&!VlXb%+t- z51p->tqp?pqo_<<-&M7#q%+&v4!;lO7^xb}rNLU`I%IGrRZZ=$Jw1c2mkA1h^FK-t zOw!3>HEj!l(}gos2>+9y2BT-oQ_4gE^v!L!h1}EJ4K>9{NeUzpdPS>)0Ug=YHbJ?0 zY%ujuG~!>z&(R5$4Y>$6HUCxkorB=9^S&vzrEoG8Ewl9b%AJ&)gG7t3S@$ECBYghl zf#KNk;jiY65!4%+G@8N~?MlH=)$LwCc`y|H4%0ReVAGfE@w4f>Yu59|z~66U?Jr@7 zp*1vQsB=0(Y1##@bNV205nm{ zgg?Z?mOKyt@+$PC8lULaNr$|O4f80J%_*wR{c3v}eziI^eY8o&Od)9N48Fj>$8mLS z#aL*(2oc>NO(YioMq1B;!HMQ^|Bk`0L?BIhda~~sf^*AF#hdJ#DM94{hbFU~FFqQM zSTu?xQ(^BRjVF(cySK*i&oxqcU$B+-2M__=rpE=#k}@`BJOAh+ggZwgFZ^Ly8?n|A zY7}Ok=lnCdKwVVJu+&qbq#X~a6BKD=YO$r0)Fs&R7zT0?`x>{~LKqu>=`Y2~+@9Mj zDL9~|qI1e%?C8uWqNObGId3U}3ccv}&VDdC5@Y2hgNsEb4?_2#PXHb%9^GDp4U(X? zbU&?-;HWp^5^5TaL}#Wv)O}~>9qvSbnQRy-Cukq=E)^jBvi=zBx-S1}*3~!z0+WdL z`JH{0e6LJclc=$tBjb@~rJIL;?LslX0PB)QNh*#M0e{5stO*Cr`irlH2e+w;#M)KRyj1QXZ8*FrC7~EzE&dwJ>t!i9yLLG$I1=$zC)!?IM!X}3_7Ycwh8nAY z-3fPSp>Y>jR%Il~9Lpz)=vVkgxfeb=gCoXXnWZR*9S0#TC%x0b2(iu@+yD%atQrof@9s^3UE z*IL~c&&~CCfqgcjIHmZ%FGgPHea{e=9R*XGCpsYTr(?o--tj#V*h4u%7iDGzl|%Iq zd;7iT08m)Yn$DNL5EB z_*71XBc>N`*0SP2fP@#cxG)_PaXgcn^kf(Xbr5787YPQAZ+PtyJA!DzP5z{y$U>*Z zGilt9rUD7en;dmK0oql+%_jHK{sG1%HrqxyT&au$Lb{X(-5LkySjRnbaRcT;)al2F z1+=44#f`*i+`@$TriX{XBzw!J@de7-K@gE;DyGW_Ee=U3 zeT}gE&u9F`R`U!rQXdXF>~_Qv)F1FWrRKxtiEz(mdDSC0v(A~CaPn_Wl+-Auk}@>0 zdhQY~t7jU|pS49*o65XXC{V05CWvMj3iyYNyGd#@EDkD9gSGGv zbUwjHC?w|AgV z(`SbOtTHQGQERwNFjEU7g2eL4#a_1^XV;BaTnNfJC9QZ)?HlUdM`1e$HQwiev!fpP z7Z`2h!ALcEUBiz^)j|(Vy(rsj5~RC9%eeWT^}e!Q6IhKlhtu-j8w;>Ts^@|QR0g&qCTH9;Zy{{y&Ei61(I!lf?P-^J= zWC{4E?!`g|8)y~!)kq=^yIJzRZ5iam5?n5vlQ89Fmg@49>N}yK9xX%(O$}&Ne~h14d0uNp;!0~WA=vZ{wGg4C)mbuGT(!BL(V5Bm72Sa*xy&z z8ntx1QB&X1wPzg#l{h+&y~%ca+7Cg}Tc=XVWz=8GRN>*6MN1l+;itSUd}Aq+ebkwq z@_&t;(I_bOQ5{-5xrL%(2jotavB!tILcBO?=|lmU&+2!v9d$!uY=Tz?3po+EQ8&9& zUh`_b1`_GsK^R1zy~8H%o2f-%a4<}FH%1E(4$tYMo@P8F$fzzO*`(g!63IP4r#c=p z!E%e9fdIw$Jp)Wu;`3)d=sb9D33qaFDrm^-^=LExZrry|e4FaCD#7i`3wnS8Lp2z$ z9c^xLUg^mE*shG~XrXgZ{&JfKBRD>4>>9_-lak@MA?9tOT_lh6V zY$l4mm{1)j+>i=Q+zlJFPZ*$4nLP7K?4&75(LA_6o~aBHnNTg=j^t92%R+k?2q>?y zSm3#?K0GIHh+C=cie(LJ(s*<+)c!YaDF#6aU{{;>7=)fZ(8$^Dt>?+mkPPjcrH?H9 zTaNxbr}M}j8FLCHi%*^cnM{ss&>BMggqy3NIWET`E+Vi{?X;;WL#gIg7wCc1Y zpcQZ=yQT+@Op>CGi~fGiWx>#I6scOaw82@nWCd`g-}syW_Vy2g=qNwUUEwSVt6%lGM92M96*f#hER!??WYHx5 zgJb22UQ^B2dStC~0&O_S`_R@l-Yj3L{Ve_pp@q&@^C9`2%Te=YDx173-L$DZy~vdb zQesB&ps8^}8C`l5*)k;OZ5SsS{1g6IGyS>u4j0mOI@L@N??o3%ap}49L2>yy4mG(v zH714bxfpb=F*UW4Dxp;UWXG5_EPu|NCSyO=i%rK&_!?guAu`|so!^_~&uvg}((RFp z?eE)c^mTzHP89qWJ@0GMOeDJC*FmEgEIDQyNU@mX=MsV$n_-timxuO0Xc?IhWEIO- z1a5F8A=bwl%_AQ!9Z@luRuKNJWX>SG@}vmA94eZluLelxcmZ!$`JH&I>O8m;hbm25 z?Q6h(E>Voqk)sTpSq&(8x3Y-UB>ZD*wCjeY`Zp*fA1eK$iKS z66_>#pawLYD-Z|3-J1A^(iBxc&DH8DQh)IQzCe2aG9$2LWR)jj3{cw+cbYXE_^y$a zqZ&e#JdVA?xW+x`aw?qdbv%TG#1nirriflB&zF2v@`W=Q`KNQ#FP2Yq>>}4$K}pDD zAdBrK{qQ{@53C(&3M)z3P)>-O9Mzj&|Ngmx^!x)$kL(WwPCbqh!Ky*<> zroc(U6!}jR_UhdSO`S?plgiys>a#!w^0eSO^}d}QQ8_VKgurHP?Ikf?{gN?M}+h=fdN`e@_yTm95s8qS6{)utkkOc$_-E!J&9$<~lNTjRY1 z?)CFJ`sSms*Mkf)G){#0KZrB05hBM^H{jkqz8~!77Mvo1XhaCY{BC5+)N5#laQjpNCLt>1B(woao+o>fzPgGa$&7@MmQAWb9P&`{rT>nY_ODDihB-mbY z^{ukz`Jwyum2P0~2WQYvf%#x9uRR^=c49N+JJiSTASp-d<1G<0tD>?i{0$=V^||5?-|RJ~ zs2nJLJoq94Si2wHpuSS--8{uAw3sX=jbRul%{)zdpOyNODiffFn@cW~Nl9UegJ%tt z@j8}eQ+AccMUEs1c^W^a=2&-N|3&b*cT%HHvm9?(^ZHGv>6-+yd<5LUe;u@Ttha<`hs9_bD%D?@9O8J@!Q@dqC2;5b3)_KOtMeqegpXkA zJ%y_rd%n(i!4(1E(9go-bG*9V93q#Un1H>-p#vRw=~6_gYFU26&)|S-xdYT5Gl{a2 zF~jzcu{@gWj`q`#^SqrF>h@H#?-$K&sCV@n78?U-dMtv~85!c|==%oT7ZotUusG8B z7XcOCE6regq`TUpUV1TGsA}|iUXU}~g3)29a1|uSOt`UX}1b71SKQ+tlhzY#bd9j-g zeUaosNrs#UcJgKqQjKp74&B_gx|%SP>JvC7Jux7J#sjADR1*>t*mM6YXr<{G!|F54 zl!cUCbPCbMO#35@j4zL7|SKA?qiN^r}QfVk^^K=}<}GTX*L4ovW6GUZO{TSm-B6UiW2lp7H{c=x0jkj>N!WLD%2?duIR< z0&r3xdA<4gp@#@&9rn~4Ui$ME{rA;eAf&qdYx_+$)yZ4i>KxgMmZBS+;;Z0;m@0BY zM>{J6O`?UK+Uy5$Tl3JBY2^0n_LSMqE znf`LYV=Ga-)fvzVF<(nx4e6+^kI!E)&|4|(MckDiv z|JxB=_3v!wKpgpBriF-5P?$(v!N8Q`#128hJ!lB5<6ww?&?~GX zAu1&se+|+c=xM0B45A^}8-~|2B_)`D19u9{q;@7W@xs375{MEru*Z24UM` zboNwDr1a5!OLiWHu47?JK#kK=O&-6$ZgmKvl#;{dZi&K=TW}A@hp)G~8!2ng_WW2)bOgc<<9M;ew>h;gWtqg<`!bTb;rDcYbt^sL8J zPX)W!;=H#W?G;s1aRRP3^J$*_R5RbZcl7#54@$o3Iqc@r5s4)2hP>oCk5It-B7LBO7c(Ui zR+TDrxuc$9zKzM(dYr|u$Dl&8I-coX_BW(7MYKO#q;DgpUP5U~FSSQp_1Qujspi0O zv;%)=wXu;`{#H*@PC6EP6lBK-02t91-<=JirB(?~NJx`0s=>$@`-BtRKy& zk_VWJq*Ru7!&!)kh$K4V=eicOIttQQ-qg9V_O#rKi|)JawHut&QL#JY!grm5Iy8~I z>X|N_RhD1un{Co~W$>K}lfT9qjBFxCr>8z3*8cQvLw6Nyv0rVAI~^||T%zf`o+2?& zt;?O*=RD{sHmlN>hp=`DLQ!S6LOZTz`WY@!5nGV1EU;cUgR4lzCK0^ITtmZ09kSa> zvKV%5A`p3}F@P%tzCLT#gm=2-3X-;pGN!7?oLHiUi>R$DjyvNoghY+2rSCuMFbY{Rj1L)epOINa3v*|vAWReE- z{>=J_B*`u$n{6R+A)$BraVn>)p~4739NEr#9-;>TycqYpIV+_t0?4fe#5iFh8#ZsI zibJ^djL7$ht>paw!J{iugecE6?w~UvZbh|f2T@53Vv)Iff zW0U(F_OQ7e_s3svsfKz%uF(s#BLsgcbf+Rz123ItcK>QxC7@pD^1q3XV!=&v22Y|) zf;uB2Q?2|}>YZ=}{V8QM#?IhAxryK*(ElYFVD0XR@fI-swN200|NDg~yVau{=&m$W z?H&>`_YPhu0c!Wlb#jO9Pa|*0%Az#4v|9^*B4G+9)Yle*Kzm@`&QPWqZWeq*oJ_`4 z@uasJbB)Y#>X@lvnh>Ct>YA>QSFnBme2R7yLlfv1Qf5Z2kYBAEq2rp%%N+T4i(^0_QkkXIn(xhB>^d?A^9$P48fMzb1)pyAUzHW$ z%gAKOGiLs-cykH+6isRJ^&cmCE|s-0l>FXvL1P7M;r*$&83jinLDHaf0Fprzo!@&a zja9yXl#St+kFmMO0zltO1~4;58%}8HKxohHvcqF>flgBYAluXf@qn$WP4^+b9orMs z%JW~FC>ehQnW`a@P*5omJG$0BVpBL@>@eh88CfF}VHB{Vk~9*43E|*Pj<9$$6UfUS z4`5{>_y@l^#vC7D!5j}1aXkp(@SN_7Js7d1@v-E2&-vs>18a|5o#3zO13Qovc*6pe z*lk#7JQ`=hJ;z^**nd}y83SL%#}L1(EX40-0^+wEo_S^k{|3GnH)6JnVJy?GHBa%2 z6HP@*O2DZ-qG<(X{z_iD7PefvGU4^u#Z~{;$OMsA%bK%6`|0$621K-fe~LqS7`?ak z+#e=B-|MCm(&BkcfS7RG&L(z)4Xnw)n*yZNn8i=9c#L$%C-y1089X<#UWJ-17n%7) zy-iw7O0YfwV=Llz>gj_c0y;keg~LX(C;-J>U28Oy2v;j%i^#~;fSdLG`vn90G+4J} zFlj_jYse(kDhW<*7f^KPASH6liZD|Dq(DNG7>qGXRau8mSer`Q&hN?!)b?qRJ$#v1 z3Z2K1hH;wsVEEQlVDf_pP*Sz6y$-Tlj@w3YnBs=LoYS@^F6sj5$h3X)Quk z2Y(KHGJC$h_EH7arNFuTb`Gy8Tx>BVu_Soxv|^|)Uf7-4s25(AH6n<+bCL^^ww_+y zWRBIY?g!E9q& zBa8K@bcUru5=n6bl^`}3E=z@zaulqi_-O!><0E%Qsy~ z__2{9)061jL=0N|{tW|B>J`;3XGI*&k8-{2;Z(^pTel2C|+yKE}1}rsmA6tFcz>@0f)PsPEUer)e*B#Hi zDs;@5`f~GT<7A=RRvl36`|BUT7JUjGhxuz{{I;=F!R%!(*g#SKh;%H=S~GDY)xE@g zK_h&429Ogm5JnyGvP0aAIn|&WMzv92k(*s8&{(%bI`KEr?;QTP5^G}Nv^>Tl>6Y;+ zC?v>C_s#1|X0C(nW$9re>TJ;?Z#S`|=)yLtoxWw2{mf>mr*#fl+w4NzpKc@A1{~|R z?j_ofM})MDCxp9`GU}D|{GxWrO(F3~CJ2F3L&K`Kp;IDKaj!h}g6dkPUgU-LO`kZH zUY5CRMD(-qU=P1G7lK3wW_#J9JA$(r0v$6qCNDkz5i?52^x%)e8@djhIb-q;`5oHL ze&+GpVh7{xKFzr7$s64^o7=#^G@X~FbWd}^S_^DVE zvl(;JM5eaK^uL)KYK}l45c!h*i$7h?DxK#1T;sw{=LB8h6zx}slHEvjX|r>(6BmBp z{?aH{i1EfF&0wxzupkKp4Q{jL#5k%fQ1htrY>_c)@~&{ z@eUXcDT=HtY&wktXF>2D_sRwwKK}-DIBmX&C>;$BtZ;v&@oW(<3#7(peYa5@vQO`Z zBe`E#0k(YT9LO%LeWZ(&E!(X&SvRsYz;2YXgCu|tx6#bQwe1(-F$P#vy`RpJ@tBia zG1*HT&6Tj4%9EN>jenmHekfm#5`B`JIOLPiw&+tibD<@(ED!J3hW9YJJyi};K&;ae zcz!s%h&glODzW66QRRppp#=%P9&+j?{RuAI@#PrgE+a$=4Kr|WAj*%ndv-H7@i_vl z)F5Wkfwo;6pIzbjzq;t~1wcD;a0reh_w$`9o7hK~lL+ICwtywfCL1(sihN`rnl`&B z*&{13>Fw_GChqg8d9B+SM8L8rD7qs9n3f*B3mT`PADnH7k&I!m>~IM}FHfF|aT%y_ z>OC;Q9+-oZ@gPw7y_cdv5Du5%3-e}7Vi(xW?xt<7b3&91mjx$+lN@NO*_)iIIuIhb zQYD&#UOaY)Psdt{#D=*Q(o7CD%jTxE5ZUa6kvn0_8%SGGCg$y3VNGd_jr*EbaeFHj z3$O|fn3#MxwqSa5>~g>C33ms&?#_DHh7USm@Y@v@Cf$Xr+WB<909ejv6`Z6x}DKX?_YDRQal163RpG-YaMzc>O-*2Cw+g zk%oqLoHk@Wr1~DjcZ3J`%bNocfl!>0V;e(I7rb4Q&EBR&Jf(bVeI6le$&a{QV)xAS z%9W=)Q0g762l}EQITr%sF?RdIm_QnYv9MO$6}}q?3(?%VHMmti94Mp|&`>*$Vc&=I z>&GG>=q;v`*66iSTC?0VP$I4cr_Y2?nTxnmdM6G|pRaQdQCP#@Ivbvcn9mrbfv%G2 zt}UU7s<#t+Ar-U)+*UcsVAz;9`8ACi*vAx@!P!ySCA__Snri$VI#(cLTmlf(S#X+J z;dS7y)DPd5@_+-$lie{Mw2j2{SCgEJw8u0C*VtV$Mr|kc$v$C=AL%JbMc7vYLYxmd zy6MmwIj}ieV8lZ2`rU2L$h-HWsvNQj0#_QuIybBRvYiu93tN7)+qiO#46De;okg3w zOH>I`XL-OBwZb4R#|VXR_pWTGc#3g3?yBPYJ)6N=Tw-^%g}-~a&hx8pV~z{n%j~p_ z84y%98q-R30?Y}!?T6-$3Xz=U*|6JiNrBq*3+bEiwVj{$muT;viJmQ@|6S_Lt)gxE zb!9w_yWpR+3!tH`iUiQ3dMpXq<3>_t^-b8@5;7<|Z?H{u%E&Efkq28} zJUuNQv@$_X$;J>3$k2*>;aalmlZ>}KhN*fdCS$R9(d9#Ka0bX}f^I_&G%S(DEAvaE z%|A7+Lr`JuXe*h$w_coky~n$f&Pr>CuqC*b06q(pnF)wZx#$ZotWlDr8LLyRoA6!X zYJ8Il=09OOF(P2M9>EWpz#H7Yv{QYh(AmtNk~VP*~vtaB1EJ4q-qZvL1ja2cSYgAPnYq&`CW{cf>6T; z9;&D`D!vllm^PLz1Lh2b zG<3W-;lqX`WzIGvxQ}W>TEYVydoR=YIa zeic28zp@GBEy8jTxLveru4$nz_gY--?K$R31tj$mHo#;Poe^N`2#ZW83EOscr`T~N z1zR>N)*^Sj43i<=_ffWHvOr(DIp#&^vOUR!l{TXXd!70(NLkz07o3;0mw zgXH%aG6S^n8G_o4#K&6;%&y26u!zBD}SNtRJ~6x(Ko)a3hbd zFefxb;KuZQ@7@itjz=))_J(lf{2FMB=w(kZfZ!5R{u{9RTQ(DI(w%?ufJ3%Mx55cw z=OTT2pbTu>`^5`?K|y}Kr{hVWZ6x?N*wp)wpQj{01&9}vf<8(Ct0@j+(jgE`e$>uJ(xyTlB}0EEyngv)F=f zfyIrdJ~MZw(NAm!nlZ07Ggk-~9{gVkrHvtg7+>;&Ca|#-ny~}x8)Pq$5qkmbn{LLj z>ocQztGb(LWO#6C^SXct-93Dqz2t@Gllx`G3j%uEXIS<|Lv|C?37{lAFW_q+61gte z754P2`$GPM);+5!;Ir?<&^cWA*AtvC`$cpnlfOwQGeQL7I3`v)&|SO;{VW8m`o~ zY1G#pU-)0sv3zsh1-*PtRQ%o)TD<$s?uSGR^#5(X9YD_-__tL>i2fHj(C<2c5tov8 zX>Q%3&(Qj}RkcEI$wr7&U%NlJGWZ|!uqmMB?mC-b`^PL3nkcDo{k1R8?=_sjM~493 zEz~5_$Dmol|E0q_(>b|P;g=3wn>;tg(-IF;F1J}5k*;~P>hU1s*|9cR>=t0zJ(HR~ z*+Kt$qIsZBTE80kSYp#3>W55YVu^WlhP<2#%A|`>my+Q(mJY-TDT;SuE`bZdu}1G6 znShQ!f{^TZBe}FRCS?EOgT~FTnie@j$!Lf_{n0(blgK+(hxSWXG> zH{|$0u=VlS<+4u}zT2?pZ;eLeBPhq&=v~b=(;zUku%5MZG7=*Q1ej5qqw|iR-iC?B zvRYj@?FzG(fqMyvLt~A>FDewwqRcD&Px9 zCX$;wT~PMA3h#HCtUPg+H8DssG^)=-d_Jjs0Jvl=evfs6c z-znk0XZLcL+ktL1r~6T=hSmh~Y@6^IOo)|(yxe|-*Sy&({wES$jF<&!-%m3FA-1Bg zz$#b0)%lp{)kGLoP8cF8BIqpQj7J>s8$dq3YNMNNY+heCT~)jse%Q)*A3gb3ks3tp|25^E~U`7O_# zH=8t9tG1lY!fW;OLWCPX&z4E>(%NCvAI#v~vIZq-j9AUdZ2jo^hF=La)zK=HP_mDG z-yZ}yDmNxBg0<3XzxtOg#DEMrG&ERC(?AgKUS#h{B%KA^o8fx)MzIKwy+^T#j9rbP zg^(o!vHP6Rj`)K>fQ~f%nTff0a2R7jqX*Y1DYR~O%~ZG#&~m!AOM#Lw`857r&#aX) z9WarmRHuzy#8410;?JNN#TDn@y$*VkyvT{#$m-tdFzz-K-hi+Yk}U<*p`Y4%F_fY2ljbTKuh#BZLiG^B7!VA&exoMml=ngtHKcl9~O>%}{aM ztS2Pa&8H%pj6d_tuFDNo*3`*8=mTXTz0r;m--YH93NnF2&$ie31v8%&Cw237w zq7T;TM|xCkydlz`0uf0CzLF;)T0)qm9Ax;UiTY5qv;n#-g}H4DyuYz-W54l+Hy&gg z8&p>gg1npVxhkg*%p89j6n<{xbx^k2@ZTQ=d3GuNz>9nrbQiOkzyh z5G$LK_JB+}yU}G>^-&m-uhC{$<>*0~4?yE(1&)sBPC%NyEp>;I&SKO;xB!go2wgn_+R%1~O1k{gc14mzgp4m_if5d7!KH7dUdZoF4qAu*o%S$OTRWzW&om(;Y^ItpL(S)WHFNX?eoLOL3h zY+zPd9xJvs*cU|w7pxgWNLZgA#`18WJaEqlqNb-c()KHHy6r)^N{g_(L=Mj7(wXvQQj#!{w20h^eC>%E?5jz78uYC>yIeebt(dkj$BM= zJ-od;huy!u6NihqO1POnXM%D!1t4DiE4XpVg$egk$`7>WI%1?MnP2K+lH3~B3oIio zl;CE%Af~(eYNi2lG?fQl{(LF6&1c@j?8KDM|6*8G8tRb8=mai;)dWfi2AGZIT?A^a zJ5Kus+u^Y+r0f!VNW3a&vIw-0?rWxI7I@7A3SYrSC4Y%}TuhwwS{dq8LN&w|*%QLvp&Ic~@y*?u!e)Yj!q3?b zhc?kMCGl4fSk7aj6I0go(uuvu#T{Y4vnQ+#<-2%}DNz=sSRi<28_xc;Tro`wzRUft zcWZE(i)DMAsMbAz;n|tzLY2uSd-?AFQB?I;UeC)C={S ze(`3)!wm;hWu|G}GO;Kber=;>Xs?wZCs|&zEQFSI$*fvZM6^k$}eb;;oK zR8jTC@A25|;@4=Kua1|+2hloe&)qbE{v_LKpq+3dUsJ&(sAQ0b=rFzZak9(HEN2Zz z_Q5Qt!PA%LN&-K^kk{!?=s?S;o(6=(PNy!$R19&O)6|CrH8CeR&nT9dHyPoIU2=8w zajVj&xBpT}MBcj1w)<%NOV#2=7c1p>UtIqZbR(EDn3fbudTf6XzV?{Us69 z>wvC?Fo)1^dcYRx7#3C8J7$E-?ger z8Gl>$7c$eNl03L0I|mrX^Wy;)S0I*7oaXh_1cvZFa-#Pd%-a@_N&(->Q z>R@D8<1rgh5&*82pLOe{8=Aln>OQ3D<=|9TSy4!1Q^tE_&$C9WrjkPw>1m|2;3l(l zN8B2Bgz`Bd6VfDI_~Um=+QnuSwX!9UH6E&AOsD;Y2>jBq`0}>L&;zJ7QAROd9LNgy zm5jq#t1jG3wz(7xlIamvz8ElbEaD+nWJ549ObV(QsZOOS=^8loyVqxKs#C>Fj{-tj zlA{}lPQhRC&*QB-#^qj+#|$QtSE*je`w>{DGk;tamcg#*z&IlnCchTfPAO1F z+CB0w%i(Chw=i|>-TzD;j$H8>PqOAQs*WHQ^-LH>nSMVlADeeHP0CX2_m7Y2ClX=y z`7J*Co zJK?V?v2_Zb*cHW+hF%w2rYE$ekGl5?TQ}w7x=3kN*;eqIO_uI;CoJU#eK1!Tuw*om zr}ZCL%f~*-;6hJ>Xt@L|p`eKL3Bz#~oTZll9x?dTaf;pt7tI$~peO)I9Fckg5+Ff% zu+L`*oY>j&Tp`V^Xv3rc9dt&(CYVN|O}RH8@LPK!KA#H2VgVZ}zNHviJ6ThRi_yx6 z_=S(M2+Ku@A~a^gIguek?P+Lh-pFS}xDdBT?IuMU zWFYX2)R2D!h4#i4o**~^h-b*y_#ZV%Nr1br>v|G2d?5TDAvH};!_SFgXT}7&|MH=z zrc2d-jryluI~`AS`2)?x+|DIvQ&y3qsd_?AyJ^=?rS-Y6X=!_m+**(RVv2n0T~kY$ zPoZDF4=WTZI`=BIrk-exndd@*j|Cq3m7ErDS3lvCbZ_5F652?OfNLDW^eklh;KbfB zYE{B{kf4nzEbj_ozd=-46zm(pS19fgFUHhKQ8Tq(Ze;qjfAYXvWBuqPh26Em-UA1e zye(!+yJ!<5W4_s}$4bK)nq4Bqm0B$lYcOENw zCRBD0rxzpf)F;by01Nwz#~K9(n=OB}y1ou9TpG&fy1wL$;=^OpEVVn*xb&?+=f+9= zhrbLXH<&qP!x*1|euR!b_fyL3WaZ*{KX_H0#43IpO2c9TOB%MJA;YhFWc6kZiFSXZ zhPt!srhpPLZ_&lU2vuoOW-h$fe;Ki6sp;-Wx;GqKE+BK^#1O65A2$2?;kgD~?nH3B z^jynn9FNort;Y?IA0S2+;hz8WY;*lr=vZb}mj6SL8~QgdA2k2(ynL@XDmWS8!R%nw zp!1g!1eL{(fZ1zyH4DqgZj5GZO@5AG$3;>)tuaO78I01sHjOIs%FtE0`+?? z)%-TSx;cC)?^@&EE{G-zIa|BE-CtX&p%9>Hr2f)jfJ`^_zVgvi{lB3%hl6tjft|0$ zZO7^4%FVavo_`aj|J}*CW2tl}`q)m?@u`M?ie(YZk zywup*LB&1GuMCcjcFtxoHNPKUPZ?M&c@3QM$o)+|{ga-(Z?CPxy}d-&O~lM7LI`Gp zwFITYGU%BU2U|+8MCq{bi%z~J%8q6!2m*4s@lP2~Id}t=C`j=Eo7#rIV<#&5_IJec z63F)4Um6Oz;vY%BspZ^9zvfH&wZN9^$;DT-lZx-L`>7n)tuA#|*XK=jyhzN&v{Ggy zS2^`>pWxD?{st7nX{Je^LlOBS*=LXk#MOFr&j91uu?&Q=+4h1Pp5HCLM;AWkO{YQk0cQ8yIiO<4E!L#%4W{DfmRy4UHif%KxH%2u+iIdyZddo zDdVO1tYos0I!}n;<$ZC968rbD*|fvpy2qLGU#X&sATe;?FA4T!i*Xob>z@@lse^1iM;`*K_v>Rd4Vso#~osluTf# z$y(BSl1&G6vXeug)@XgEf%yo` z--OsWqGXQ5!LN@vwK#7Wh+Hw`<*B^KNOMvcN~*1ERoKn>=&kZVzW-Qk7%PpitZ+CJt{d=pqPh~0d6;Of=_x!!CGDM1OR3xNKBo4&&o8j-F%ytDQQnjFa)(6~$vhQ|ZcVCoQ2prC|%B5ElCPu-*T3>aiF zVRz>+&j)A6D9=%;Du5iMe==2{O8MK3Ycxg*UoSJnGYqwJBD=Zz_L^pS;tk$G+kj|a zEXP4UR%ggZ?`_BgPr7P>-4^BZ&%|K_NiO*d!=5{1yb7rqa)Q8ffKlJMH@1UNPi6a2 zJ@k|!g%IptN8dQ+A^6X7M{5xOmVdxI%1)t&AwZ3tzU0?BA48g~ycDj*acjT-xg zuWvWI3=#M7I);dUY%wH~vsB4h5e8Fte*OmjHTuVX%^mUlMSW-=`4j-N$K!Gpg4l-l zVOfLSAZhPKw~OWdGgX$1^6u;Af_G_0jPv92@Q)a2G93_km~bS{eXy?_zCQ(zc1utTU>Cz-fD=#BDB7i zK#=tr^bv0)9GKf-xZ(7S=}_zb%zEl^n-LtvU-^#8TjPP z=H_~%&vYMZWb%uNs57&LMQ67=75Du1uDd6qJGw_AGTqER8sLRTojK9eB8*tw|=T>8lLN|ub^fqqg4n8>_BN6O~8qP!rNV0#UjoFK=i(TZ#dwBpyiLnf$ZX?EcsP__rX23 z*txu|O4H&QvEZL+wFVrj3BHb?64_=PeOyfXPr_XR6H8~m0KkNVTp%+?<7dP?NJHg( zzj*mBvsp<78j^I*G=#1tM#Pu84Sh|p@+pd4prB+f{K7iVq@_d_!8R~r1KX5b#nz{7 zdZ!kNP+ojjZw-mm35!L`HYg(bGDbWHUt{prILRDbJbccJ>47FY3i-Gk^Ag976TM!P zbDmeNN{u{V4dUG3j~wys+nzPn{!-=Q5$Og8ZTcR&#k%)zu%sfVOqAzMwo=V#!5HsX zw+r;x>2(ok55<-sCrT93zaz7a1F2p-j|;~>uex<%MV!gr9LA|HBQ|TE*h_F=RdoVN zu`BSl9^u+&7stLI-K(h|Ml3HzJjz!Z*ADo1cB2elj}F%F4^{1v z@Op;(A2D&Rr!+gj`3f`m@SXp3nw$n2nqh`Bx(Tqd=Yg{Rpbc zZbj|~Nfn~9V7s4=OzISR-EOlpU~^fJp(4v%kulaS8a1QI=)OiNNKN7$Q1_5 zgbLr_`cL#updTOamqi?{3|C*dNemH@4 zb~JXHGtO`k@8Rt)6UBmn7m@MZkfSxu++e%Ldz>)-cYZaa+}9P?#Al%gZ8*&m z4%MGp{xOpO9Qv`m`*X(!c$5eDU$fl*L<44KWMTRL0t|}(ZrdKV{YUkwUj%;&K%MLS9%w*a?_&I)I4AS-K4T{?*)U8pV-SccqByv3cfyYUc<~TX zjr2OInlY%`uyLjK)28A5gREOmGLx89ZF8eWqsfSP%A~n%_0#yRuZ9!S&>0hiU|F)O zE2cQ{lzV(?xNbG^{oc#oTSKB`PsJiXLfm945xRu$NuA|K}=Q)bh; z@&r&V{xZLLR$BrVgC!Jj+8Xk-p*F)o>eh8^cag)_zdZ~Z^C8GzUStY|SqhJ95c|8e z8YXvGo{lMFWQy6t*NV-}sy-bP60H&Eyrh0iiTN<~gA^^Vya;N{)LsRX`h>Ua{W9$I ztwWt8dl1r*`(ZwA2gbU!j6q|{v9#`%-$cT~IE&=6<|_7y-&zYHHxk-nE-|UwLZIJ} zHv1j6(;(0L3QB61eh2+yxNy>`YPpPbu)b^`nB%^H`BZIh`~d}}X)6`hVYcz<&Iw`y zH6|($p=}woV3U4AWk~QO6-NU}itZYmktjrcHx2fmR}x**%km&x^Gd@eR+@xtXXc7* zFL1uGrBrF{b7+T`m~P&5uF_Qa!JD8d3c3reFdDRP$1+-wMRlPLn(0hG&(Ty>Y3vy=9j?;mGvS9T({SiGUq-RtBp4(Ja_l-+RGcK9tpU z?&FI0NPA*grFEQtfQ$3M_4RVoL%kxa!q_kiY4r-JFM$MVcU8bI>Y-Tj9K72{OxE?# z)tjytE>pP1n4;01mktrIH{q8H1-wb#&#_?N#%HK{;czi{26*6hT(5nMBKz2*7uyME zSCP2L<(S^ilurP{HprEp@7%q=2aE_X29~_Din%6kl@Vqd`CZ7`?VanY6CtMV^1l9X@PZJPI+&kabae|lA z;!%93Q1iCw2u*#;yY0T*>n}?(k8CjyI+T33wp!bZaP7z8zP#G;^YgpyTz?n0v_5j? zN}pwcTr8sKxWI)1rUu;o--%N~u<*aeBo?4>I0SB{M3`qz1v0P-#lQu|MB$vh5Zfqq zadZ&qXio#dF5+!GGtS>#c7W)d+^Mt(%?-iRF%8kFLIpfC?TZ_`x|J7s4H`5LRu(T` zHGfvx1jqoZLJU`FXwwED+vSV6>5xwM3X>ibOz`>RyJ&!yZKW|_Xt5MkHS-w%{^@da z&QCN(d({UqxUgX6pmJV+iIJVpl7D;;U0O}Xz0t%b7vZ#nt&)AJ=D_KAo>QUVJf!_- zIF~~4Eov6sHTRfCQj|>_*=dh4yb6#$YznQRk){*ICoWwWI%0w0L9e5;}`r{!n`E@3rIo}MHr&M_bI~RU0#iT}Z*cKR(G%Rt@+*|g+w5O?2Vp_v> zKoz*WkZ#*UsDErq9;fMk(vM572g&;guR+CJK3iT+q`|dE;GPXMR+73W%ViIQJnH|R z`e0wE+7Pci{(k@0zkf-LS(rb3`}a&TYK`219suQG{sbl8>#hM%>7slTBln<`1D@Dl zo()uN{IPWe7D+LmpC5YsUg~@LN?tZlT|HgU%Z%f$IQs2MI)_A!(y@|d*}xBe9qG^u zX|p0v=>(&%0s0X%0UV9GIv0`y!|Z%6mGywuv`NMd@58~8DFCFog1KGcKrAyQ2Y$4G zI!svuiLnrPD_DpFJv7!cN?(Egal_4&U}b|eG-4?TJWw3aqqdtET8x;>b>y+Q!t$?i z!Y1jZjKXRgJ=922;&fFDz?N|bD3j@pC=q#xJ`MG|zMlxJP2Lfp0izQpvB0FV3ixY7+!S9c>IW{^zyl2RGK zk3pGDEOuv{mh7-H-Xu#eO-3?rEKsVcQ%xCGCyZ-nQokU0Q0zKJqXKIod>H5b9735E zKS1ig)&}28XjTlMw1g^_D2J&suHkLlgRpP3_$j( zGWGfql1pk|dhvBW4ot^;f+v3K$>1C)@abjN&-@`S6c!d6KvX$c!}@D)#^5}IYTQ_B zDBXXK=5_=mL`rlkicQ{J89{WC@IzwP=8>=8^in5kJ!rNxn0FjWpA*|>g{yKv;$>^4D0tQc>?Lps{bt$ z9R7&Rt%@S;$z=6mcQ7QVKVr=-ye~;I+@_hO@TVT@CCld2=t*W4O5e%^b+a>KDl*DX zLau_LQsx%nTS)WCb9Vip3g*7)UO7f>wQlz`VL69N+$<{EjW-1h4RX)lp{B?;5~ylw@Qum>>nN#i(|hQYFh zBV0pTW_^DP|8z<=P}`1?C@pz(T_1`2Oa6tOzVSMErP9369sRqeemXA2_TY591hnyo z)(Q10FNdo zp|zkpRxjV+j0QS};i#+6YK#j3YPxW_kg;HKU^ZX^=V)59`;b6&vyVP1zVGUfo!86P z&0>X4Iyd6dUt}kO(*jaiK~yKMJU$uZRxnYQS`+G~Z91(=}&ARX_MC?m(LX zE+IVQscw?6axB*sYd5?;6`qsGfe1?D?r~Ttne!5h-#0GPWy9x$dfx0r<;7?5vZ5@_ zOddxRcYb4p97X^`wTSLqh;P?iW9o7AlPOvC#;PB7jqhDRoTk!MJyk|IBalr*!vt0U z*jsWPNEa1qzBS)@__5)MmvV(UP`(MI>(HS;t`=RRSF`6r^PngKf#pWFiA(GDT@;j} zS1}FEl_D?;s@H*`tJDkQ`tyfI?jBhTQn4gu{6N$&>%(lGEyL_~M>P(Q!bGwJiE#$| zdjd?u-!_^Yob6?{JOGImN{!n#@N839qm!czoUgS5U}%)sA$J_6=f)9(CIt%2`bUiq zNzCrXO~&+ueHV)b150G0PyI&vy|rKvwFTCUam=#J2)114w}$2e@yxWDEww(@nZ7#f z&%Lh8@;aRN+Fwj-c9#?XATWJL8j#U&X*o+j44dDM&JTjkeqi>G95VROUA0wKi06H` zy@S4J zBb%XPJgHbgr}0|sE+HjlLjMxm0wH`La8T0tEsoFWfE=6+5YEtDKOp%XI{2dT-Jtv3 zXAlU7sC(AoFK3`n!;f-811)QoH<%}yJa={%EC^|cGkE*tyb|8jmJG3&1?6}OR>${s z7#6PbxPfXqEx5EoqrFsYnS@A#Lz~{1laOZ#?dc5?HzS5A!c96L?3iM3Dx(7edihKu z34slRe7`^bwZH`Y`p8=)85}*)<@x>}Jm+$>yI$3h00{ZO`0D)*WOv*39UQtrGYat7 zVfunfwQxOTL~o1-)kTMxH$9e$g~o0_9-3m(<#JA*X`crz*V1Bz#Zg1WF+j`T8fAUh z^w{B;28?|e_;$B{P4mrErwWAF$P|WW!_8gJ6mmJT!_rIF&!^<)6v|6M6u>M24q05j z3OW@P@eoK1|YK^N5h`JAF+EbP7Yv0lm zU+6sp>b|~j0yHa4nw!BkDWn#$1Q?DpDgSGADB#0eqw>yfKB_-Z1Nth07|JR>uzDE& zyC817d$+LC!GLYMZ>=is8@9R>v|pW_G$Bp_Q&{fz|B5%i^A{Gbm!RiYA_9N`I4u?0 z+9_0_?J1ixT;wV|$Sm1EmCl2ywqIW;9~q0Alctqs$GI~r>?hTlt&F}zX5wzsqL(P_uT8!%!yNGO{(XVI2B08|7QXu6szggPLX&Lo!_z9g|l5>E6BPgdgG z$s}KNSDaNkYbz^P44BX)I3*odCJ4PdGe|I|+LEmbJ>0hFSr)+2#O~xoXCh8{AO(UR zTw?!m#SteQx`+@*KV>%4lnSwn#zhfMb;6dIryHgu+ss}w3vd?5*V{~1u+1fNm*$h5 zuGn-9)0I+$C!&G4GyBEE9D5}JnksgT^-^V2#JXQZwkw50-=-t#7qNEJnf@ahsS3LD zoKufDXeu4`L`b^t(!MjNylnscoRZi~PLskn$qsv?F*E%jAxc=DQc)FQ;nNwd2GefkUr6=>)?oznIsWkb^8wc@^KVUa5Nk;sN14#loAA z*Sn%rjdLDz7fbDW+NSBrT~E`r`GzX)vg<6Ym{fN|1{mH1@@mv7MKNt1 z(pJ5zyQ#PBVQmyvZ?m7=`7b5D$r-q%iKTXrW&En_5788V)#?VV`Krmjv#makO&fy5 zM4*oJOM_VzecGR^?30vWt$?YgZwnw-#t1{6E54ASv05AqP{J9p)sAI&W@AW{6I=^5 z0|C%u`)4}?PoTzY5Q7JyCE3s7&VS&edWF0T3#P(PQ9fq-1}`>lR#)b}=&OF25c-Fn5WYT&IcQfcW-_Ph)2Tb9+9}p)5nx|LfQK zf8s|oF>(H%=IrtRzd6hH+ni-hbyZZ#i7y zO|cnB6bbZO;YcVSbo`oeJ)`l_t^*C`v(o4IERLLBJg~hSe!2Y*jc6f>cBK=v5t>Y# z>e`_DEAF#yR<@Zsm6}j^U~1cev{?FPyVlfotIgug{wwzX2P5KV>d|L;kn8oW4KYwl zP%KaaM5nBmes3;yC|Cbo>9_9bkF9c<-Xtz2A!lla7NmTj_n9{EWPtX_9Inu8aaQ?u zo4P27f>g;eqxQ__R&O~FBv;ti>bvm2+J0**e>mVMt+@b2?<8pD=twgX2-g#8X1+}s zeMsb9QMeCL=Ze$4{e4~KJKnYMsJj^LnVSf;Ci_idZ_Yk_)(L-HA$~1(*8j}Q%@p?n z5B73R6*Q|!2O4xRkz#ohgB-fm8RxWv&TcbDo9ND0CU3N*q%{fI6}*~e|AYzT?!1rdro zjn#pdqZX=ENKgQ7=1}{pKtqtmms=$=Id04iqTCS|mg~bpRLl}eo(x3oei=H(*Wq5!n@K7rdfPLVK-Lz5c1@#BP4RLZn-pCE&N- zNVQ!lkz;{^JyCE46VBC7b0}ypDDR}_U8-=s-gh@Y)++SB$seMy|5do2nPl8i`#tuqn8ulb zt{018K8kL?mMd8wJuSgdT+!;}-dD&%Hd`F2y4pDk%VHFC1pI8|$7PT(T{GzGB!Sq( z_nftQvICEJM|5|X(Z9zp_5}BiM8kx_MYJ7nLv%y%!>u9Av&0Sec3LQ%kV^-4cCO7V zaci@0{qtwy1kOWq1J2F66GsY?ZFvXftn@-34ymUgh_-5}P%>M0pmK@<*85qsX6vvD zeCq^%n-XkmXy}y_!rT|(@l+IWTa}qJut%L|yKEPi3GDM2mII@~=$>FF9-yO>yzCxK7;=yC zc(4=w4K%9#Zm^{-QEl22QB3bwrV{8rIcPRv`h<+Om$_Y(o6C|%ocWd>C`lBBdyNN; zRadZ|g8o)RM9H#mL%V_)yw56+G+P%XD^|_Qojq}&e6m;IhhImQ>=4w!cT?j~SouI6 zHGw-H7VGU+zDerr9uo@VA!spj2Fc6!jByPvWwtjRM`_nOp89sU<62)@5D|iDQJ%|R z`vl2bw8CtPTVUus=+(bYK~a2Vm4X4Pj{*28Nnokug+;VS?F456psm8LxxG|Oz|K9< zN-4NH>%hm*$7b)R+=txR<34VibcVep%FWB^f-QsHx<8z?d87vr$m8E&{VzxpO-GCy z&IY}qkMEfn*GoqRK^^o$Ukz7zA=>6TP2Emju9SnJC&amhIHXi}9>!byzF)6@sm*Mo z0>UwG^P6)?6tITUce0ZiopT4ZJg7%d!q1v&Q|;X>l|uxPKaaJUIOgAt)Uy*;TLm#i zA*FzLK^tack`egfnnQ7$^bQZtD|NCL_(_{xdNaDp{gM{0mNqxW+NVrf^t}b}`87Rn z^JT9H147FiT1zN=L=2GbS@s$8V7;!Va;6 zF3sL|f{hT(jJnZkEje&pyeweZHuCxzg~j6|uFh_FFcbox$%|r+0AoL9b3UL`d!0nl zPI8N^47V*LW~aiVP^3VBAtHQ8?06CLFjLcTuB4CT)!|>QxfIN5Vd_qgyEy;S*aADB z-*r$3cHUfd`D<3oEGDmQQi)LR4yX8vjMf+OiUo2)T z0BN(5Syo%uq+3iPw@BlC@D!r8@EVEe-Bg|R)jj2Ex*0R1cjmebeXuQVbfTYCAr&Xa z)d$91F>A6e?x#`60XZof>_jqqwwoW@w8hymf<8>bAH!Sb9OjeE<#;c8~ioi9F|_;HhFHHkFJX7)9MUmoTn2b$13-J_i+ zQzh>hQ~U{ncc;C8NHgv^p*Ihn9X=ie3^yTv0Ufb&|M_?}Pwk~W1iIR#@4tC)Y*JIh zH}>^q)V&_kS^0~H-#l150zJbyA=oGx;(P{jmJTX2aAbXUBlF7E-!VwU5}cG4xUe@T zKJ839wSALZ+AyWYfCIB~Y_-2fRy~D683I8rwK-v9C}Kmk8_3HgVw(M7{(xD|!ttFz zAI)verDhyxZ!b8B)S>6tDk@~~163d4=VXxsPyw}6Ky92VyJwy=yGw(|1K$bS^>XW# z=AL`SfZpclDHRo;@?--2G|Ns{y`h|{Ze`)kMk3p&_&7AxwU}jIEKi!(Cz~3>gV`i( zXGFfiDhZLwXm+u?;iVHd8_>#x(9Ox)QsqhRJFQ%;@j8#VQ61`$rB%FXQ$VW@_0yN|&L`GBILyB7EN#ir>>xu|&TWfc?2o&+>oQB~eb9dWy;l^sl5%3D6v)=x#0m5LEm zuC7!Wr{qP4NEV*ynDCTfHBcM@+#=#H3ur6?Ae${^#t@G=(&Cs#5;noF2@FeLhRZK- z5|XT?5h(%7-eqVjROyS@RZoR7_(}Ac!p~$|=O4j%0HwQT{-7765=ks`c+lpFk~)yo zM(RYkvBl^RH!$zN+r!>zjs__K?0qK>+>}J$*J#UQy+pLlu~P@l={E73gdu*v1j(@c zV+KqX=G|O)loxAFhDy@)ms$l*EHVO;hM@;aOgfO%gTnf&2Na*$f>sE#@V(I;OcLkS z&~6e9xSC>xfCLr518tem1+apFNFUPNLY-kl_?3K7{mxUttJtM$2Z%y=i3(rLj)m)T zX1b+8Ef=co-o`FXDm5`E`?DV+bSCTyD8##v$6)1T#TeiQkx^L|D8a`D^p})pj%gj( z`ts(Pu;|T7GwJGD(}m4QJ1mIkHDQ)52+Ct;mqDx!Fv%nHj0UC%6jhIe|8HG(=J0Pg zgLsyvWYdh><28ggM%~6#BC!i2iS-KE7yLFC-`bU7ySOl~UQ^8XzW}^4h?4BRC_OU( ziih@l{82Tfk!olVqZ$98EMvR(uo-Lj@?S;oqH;*0dAr!hjZRm+b(k&IfIOJ;NS&96S{GaFRa zd^0=;5OJ+=olm|d8izNZKZLF}-n(+;}V<{jwQSoL}ha z>fF+wM|q2HC2$9pU<_Gy9`G0vp$w=bLe#8iroUL znm$LHDik7*bOS*eUm%CajI%KHJ@+hESx_o<0x8$A@wM>8Bu!TY|6DY?b>XAOoqI1l z%RC`EnyCqT7V;z5Oge#cy@ftqvtSMHgybQ>YMhh5c{5Azqw8n_Pd-hnK>#c-u54EJ zqXiSm2v9?1{soD zqL1bHAs0rN^@i~Z_65UiPt{Z5+F7`GxC~~Zr#`%6jl=|V&R~@3?CW?K&>vIpYxEbC z`~7OU#q1zOA@77!nNvPpyFprga*O4FSQBChGhO(3>xt(yP~ox-ivt+`SnW+M>ht6I z1OE?b9!7x*&DlIN^X}X{#oel@Bky&(2DIvdzd7v6Y%ulaIm0U9PgEKO;VpBVWU`q`-@zm-AG;0^17kI z0^_Nse*NnhG*AK&VOlRr!nb5yNoi;=yjP4z^!6;_KJM!68DEuV=QYRru2Xo0%zVr< zc*g_}Tn_|XHM(I5v#E`_%bRvhSu3~#)|Bm=nq zzM~??*WVQ{muj;GloRol`^=K&aX6U0Q>Eg~aZ@E=0B$*Soj^Ec+s@~N2YcD?(4APp zY*H96q%+$~SzS;IAyam-b^nm7C=9n$QcF=HSav~ zgT-3`Q>?kXldGYqKirIl`AXf-Y5M^svt?-DB^0H~&|a{t%KT5rL-;atQ+O%>Fx|d} zy!oEpd_!yo9h%QyXZ4~S23dhF5r?_CN=U}#m^2}toj>=L)A^-km#79bvGYs&eSo4C zuQ!IbG~o^J7y-fCLfm9FFi3V7@foKqwF zW(|aH0+?eh`kIN<_14XU8un|4VT{SJ4y|A9$vX7IX8)4qBCW3WSKXd4!8nR|i!R0Z z)+T)}GBre?7PSkiShZWs??2_$>h-n0?FA|E?@%2l!c;_iBV^1+jW!O zRA3E~e$`^fLaeYFkehw6>4eQ+>iYFs7=T2i$+)9O9#&f!>#Q~dwXc2U7Io<4Z5q%S zEcW@CZu*NQEiN(XIDN>N2sO>aag7Wa`?aTM@YxEw;xNU&%e%LdHRo~f0uaP%*&Ae3 z6hyAgk{u^+Ni2Egapu-i7HwxubnivH{XhdQi(QaJX(<%(bN#b?ofj1)d_XxpG%z-7 z`UYLaW&JQ|JR(0myvg&0yr z$v=KhD(n*K>B8rDQhRtEK>q6aC!F$2A>y+%&HatP4M-u7{?}L! zN-S>xR+DWA@N$M#B#2X~w5KRC3#JCFbYyM^DTXm3-T$@RC6iGp{D|A;V|B8z)DMV8 zm!Uj*@6zjJ5cw0Mv|Z4 zWgHxYFo06V3*=C11Y+e)HxsaHy{Mhv>JD|Z6}zhmZ~GCU10O5Ixsh5O(my$C%cIZM z?pOp{h`jUkA4Pb_eiF*vPy*jv#BOA7VVvWdJ7S=uD|n8ODcIGit0kz(i%a=B;xko9 znhE^4)GoODxo>vY<1P`s_wG^gkJ7&#&JL&L`n7(77t({SF}Bj2=_Z~hBm-2lymj-E zc?r4~h?4m?v|>Zd;kf98Uc||hVanjS3H_;v4F}Qo_}z4yZBT2L|zS2FI>lHsC$ZT(bI6z*h|6zXY=KA$O313uvVhHZ$1! z0H$1DwXu6GEiDQ)Dv`Q$9Z8zJuK6=ay}pLuw{>T{`)YdHs${asqC%*m66>fN5coC1 zs@$AgVn+oQoYBH^tu{Av?UKPpSMo5sQ9eRQPWSgm+g5rFnnFFTGOL>T-v|IR!xhMS z$k-NoX!q9-7|8e(ZY6){-Q|vaBp>$FqpJ)%B$CvsZcbLeFj&f&6I0mbcxP(uz`9O;RL!DL>xwvHrcj1wK6 zeM!9mr@+9nwIRZqTB{~FoE6e^qroMuE6tGAXz81%&QmuOOW@SkgKAdEygGQGzkUoConxr~IXk7#rTaV&NUpC%n_ zB^Pu`wJFBz*Msp=%DscV@cyV$pfpinfL7mV$V=&4-9g#)U{-TBN#QWBD!I4}IqHh@ zEe2NGPKIVkxM_h22FSs6jxB@B)~%QqmvPaJDDA+&7Bh|?0TNLUus4w0NVh&z#UPAS z?fcZ3>$9Ojz6+4sN`h6SduP_HxO-1~b1XjDeVFvDA;bg-J3$g7awcCd38);dP{Qya*m$cXG`Zvxvfu-RvCq7E0vqKB6AGLo}3_WT6WTMVgdXq=HmjvQVB z%&7GEsc!qEzn}y9y3x{<>?X*(C(&ZgCDJ7_ZYlJC9stdFYI2KLqlg8TX$(7_j{tXx zC}wk#rmvAVQPvYHd^g@q_VMS?cdsg<-5t7N9LL;M{o(_XKom~2Cm5_spo+hV3@}Q7 z()AdnXI_kI4i_!UV6xCagge2y3VMdWghBwn`#*(-_EVqt#+!M4H zX@q6b1QW+;8`T3*W&1t!qk3)Me)si&4gR@#WU|=8#SnPFQJ_aTr}3vGv8W@a%zIQC zQTjJU4Bt*tYkoEb|EYL9mfu9>mXgT$@>)xGbGf36BzW^yNcL}=wd(Sts_;bJI?=Yb zRD_DplD%k$@8#jO&p;Qm3kc#XWzO=kdJh-Lrr@h-Ie`!v(afFn6x%q+Q6nF`A9}oF zZ^wvk8WRJ@1Xi|O5%C?;tb#}mlVa4wuL6jY@s|(}i&Q!7LMsx~oSjLXy{6UUK=Mxh zyXS=-5M(qBzzTy;w}fOIOYL;+`8m_%ub1Xf_R#yf{412<+7->ZR9>@R41U}(u|>ps znRJKTgdq3QVfWQL*y%LvSSz3utqDUDNAP?S&wosHWOe?c9=cZNL4XQ_HnamEzSt`F5pu%+;p#dB37}5RF^-ufgDdBQY~_{GS!E-(c|n zYAUqy^8Fl`)EwHp9Sl0xi0tA#HqkfXwaiHnY?p^ zJr$00yX~;(_-IxF`?0hRa6eAjHOyG!bPK* zS+lWXyxYWB07ZiODeVM2sYs`RL^=a{Mv9HNn{}b0>kmd$L`v>3W!q?<}UQKugtlYht9=&V|2pJF$biobkQ1vW<&m%o)#upWVXRTo0b|aj^>q zuIHHZaO6@>VF!aey)%=lP~J?IU}|b2zVw_RA*io0!8BLaK;7A6<%w1}?ms?Nct6YN zkzqIS38YkeDBS0g@gdSHoNpNFGhChgs9am=(J5^_l2Dj3rmc>J!~|r#S;;%OYA#K$NI!M@kM}j~L&v zAr=k1GqCPQhF$kJFdv#{!H@k1`fKrukG?rgz?Lp-ZXi%Cr+M5L_U_-0^WDE)=&sLI zF#4Zf;M&M8zRcPAL8gI70(YKGhYQ`^L}S1nBKZc&l@w%!2&gz-nr`ZDr~)t{LmQC< z8Ec+v7j9*I9XVi2>e1$j#sK+hGRA$g?z+ko5(G}lG>Sd2RoK&sD9Rg@bjp zhtCul0I-%Y`@k@aob2K*aE%vUsam+VT}CFXx#;D!G!u6p<^2_ot3?X6>s!sxd_XNuP6B}Czk$K9y zMCGy#rE<2vS2haHU2jbBPyHo8y~lk^A3D#Z-d{h5$^Aqw^!f~tBx~83$2m{e4};=` zbDy}O2__;(0nG$gfWnOFyqLss@MVv8WUghpo5=#qOQq6ylD;g)8;547Aq0FfC%LXo z*>M5V+UF*rEP`22%1XGO4Yd=5|W9T*)#@G4;9l)G!n;j>I_H zMDXhXrQCV-_TK6Y!Bs%d$9OMFWGx$Mh3KLkl#PPM?bKCXR9`faWqjtOm1mS=aY-h~!5l2O8)RU{HyHg2kva&_Cq zFB-8Xi0ca;?^%n;*EW{yhXkEe1#q!9&DcVhU|xH!@|NQWzBJZ0h`wSwErP4AaWr*` zL0wig&T6iQjFadA1bHb1q>F-#--MC>+#D_#;=Z{mshkQf7=+3?TVs`e8uA&f5E4Y$d4x z$_Dqqq*`w!`Hs?e%UN(e@wQe}Y`4S8CM(F4WeI*S)ZJ^6jp_GSSymN-2x?JT z$A`$dZU(VQv6hZIUzbE{cMfO~Kwk_8zLgsuL`{n+qPo2_RoC0qHFkRrj8r(^f=?H9 z#$hRq?oy=tO?UR@(N@9hRVDllIV=XxRW`_~r6J~FAPSwZ=+Gb`+#y8X^Fe)WNJj!b z;p&{!%_M5BvA4{?QW0*<|L(Zk+AA}VFMrvaX%C5}FpNdhb!$p{Fq;<5K2y`?5s7pL zY^DKQP^ka@r{vCYBg3wIk(i>dkex z*X`U_OW(?Fkk6-aBiY&lI@MLmSDww9!qL@s%3Fj^|_={5NO|f=`V`ZLEDc$YZofJm24n)m6S%2OKQXpoPPue}ZkH4zX4w zR$l&|M}cSGOwQ786FL;IR1uOe<1p`4waKpwkilremwQ1r*Vuvk1gYZ>-m5S$J38-G3*9fNh@%dc1~80%ADjnY&j*Bz_V&A;`s5W_SI}f{Z>%DeK>PtcN?xj z?Wf->q70g^dP#OMV5)EASjAhpqIt>>Z0>rd0L7zk#3S1;*{LXndqu=kqqWBQa;xi) zGnf7^B)xpKYgPgZua7d1=b2}V?DM6z1#-K>zT9^`T^gT{zo#`yRTz-}EzvOkZ~S8> zhX0djwl$<;H#<;wUequ&P_PILUQx!+D`G)pTt!S$jq>AJ4Y$`4h{v<1dT%*NNTu*5 zo=Ljf_~QXeC@y$-b4JBxE={t)u)z%sWxE zo5YwLg2=6>Xfvs;@uDpqtvp19jK&79aLLKIURT7uC3Yo;+N@VpAmLcHdh^9q65XF- zZ`pb@y0)!OnY! zMv$@>IaV{M&gc$lIDU*7#Tn#dQZtx_T)id|M@YEVHswG0qqZjsYA*|d3zQ+;s%<6; z(^_}!m$qVaTw2*cS{P)39i+A`lOYjbMGl$y7Bp<0TIV6Y#wt6(IA|v@e{~;dnrg@~ zj|)}CrY-(S0mMWcrJZaC76PoQ5{>jRQd#a{J1Mkzg?0zXPMTXfJSiS--ps%Q&C5@> zRCn-&364TKaAwF-N@YkVqSxnr_5SaQ9PI#i3HR_1(pCC0#?_T#osxLgWImjT*2H9f z4aD?guspi3k~`s&k_7E|6(siYaWh1iJcc%^Xg1Qi(a(J}IAX~u!N3qu7+8y7K+GL7xS??lJ$`Y#__NP4?PBDq2A9Zcr1k8@|(1DaQ_jXIhq&`4@m8x-agPVnflStNwIL75>MxW>q`Z?rLK)%Q>6Or5mKr3Hk^6B~pp2${(|B z7KoEX-?if>q9!Mk?{%OAnYN%8$vOlTUw?4q1_h{`B))gH*c+1NpoPkdWo2#clj>Dh zWkBpJ6Pzpt#-4SyCqvAXSt2Z5u)+3CxYp<_#et^mlPEd(vJNuymK$(nu|BmsFrPmk z_J6P>*&6B^rsHQ2?jYKXuDU`9W$abr!JS`p!gFbT zuQbn~1`E2dIf^*O!G@ozioGRV%z6)yLd;*qa~Z%KugKEy>;6tV+LRa@Md;ehK%JOO zXw-S(f<8b82sl-(*zZ}O7|H(mY?FTsFSu%^;V672`e1mJrq@82ETII!wGKal6k1cC z5e)C^arw~x@-^a?`kFLjCirEmBR@(Curk0U7M%nf#;KZ1~FG9pf}!M+vvNno&5 zVsCoI?pun;8xJd>MwwPrag1<8#XITs0~6gsd_fY*%XDZ?}ZA zMy%f(XQb%0NH8Qo${^?vG5v!aF$kuVteLo1UOJTj27&Y0EqVD`@YPi(Yn@ zsq1*vvJc%0VenIb^;Oi0Itgy{$R~6!nh5;t7ne8lqh3V8eeR_O)&^oRFayqkqeI#x z^@Q97KNRWSxcB!BEetr;e@08IclgZDjVG%IhYf+elrU)aVexjummyjeKLOeOBC5-3 z?GO5X|7-bb3|1+>a(*8ys_$W-&Uk(c`ddErS5)Qg-KKTl+b@T(vgU>9^L}p*E>iQS zvxW=Z>fXYzLE_KYCffXLZeh1lAEoL=y`RBd8KJU*!uK9M`_dx@y2P1O@Si4O3~KCW0Iq=|{i!a>}9X#zB-s3&LRkuGe_;z~m4? z3X|O_Ox9Bn)XoGF>+C9{x8_z4Z_}M?gAg~H$ks$UcOne$cM1KpTdA=xbK0%tg54cK z2WBRg1Ps5U$3EO2A?nF~A4)1F-c6gJO^BS2(oyDL8mx}3?{Dydg9L*gX@uoM+cQW3Fktt zRf^kh&n7ut=-n6?G!g?2kLW=X5`9O`lwAGz>e0V4zhTPp6`FtB_a(-<-fH^G9hp4> zQnaeMQem~33>OqUvhEKgt4uL+lUU(MKa3`xK*C7$$zD$|@wglY?i8G;qeOUufoxO< zZ-o-akgv+Ix$Da%q2s~h zjR)?mLUn%ReLK6c-AV0c4d&Na%Ga9kCGh?sDZq|g9^%uQb7P_s1umv1DsoBqFBac4 zscGBC`?7oMG}c&}V#g>t`r@S(AsBXJM>O69lLvw=5bIV8qH%Pyx#t4@PXa68<2gsX zDtvuAO2*`-zlNg(%0ADP=Lo=ZR>^j?dPTx^=&S-btcQrNZP(O;(tJRl7(i@W)&z2}| z7j7z`n+y0sZ^~(m;+pCop!ZLl_tgMfU-Y~DX^N4bu)JD&6kHmV1JH{bMF$G5EgcOf z6b4{>+_^eR`@D9{3b?XtWn2~_D*%|mznLie@BrOEPVE=s1?g_vU}F@(?z9)s%_Cvs zv}Zrs_5M0!L$g7iDAzBpmA*gcy=))aME^DA{BI~+4kp(B?>hMOU+vh-7DVsc+B+qE z;MJ&C8B#gx1r*8%0Ff5&^XtHs64&Li1jF$clfds+I6hK$iP|h{zXP4V234Za!F1+R znC^G;U^URsL28LT-};ST_>`Br_dTt~K2WkqxEg#Ysw%a#!uZmK{?BYPioru|Xm1q+ zskkJRZDyzM>v!lao2KM>hsDdy!R+qOwzk(cZmhOt&H8(-v#*0|?>U=h!Aj?(LMt}W zY9Q`Yr0u!W1#LePrD9D>l`s@Dx7wyI-bX$jUEt12sP$&B+S}BHAc4dX6e_4o?fL9e zUMvH5>gA&QU}W=-UDwVk_k#lL##j03i5#D{ljW@?-|H4>5|Q+s1-97FSF8!*JE<|0 zLYV){L1SnmW*fIn^HXxVW7$k#yRxM(Jdfej8C`WZ{R-bm{qUAh1d(9BP+A@mG!okAqE$<$U+dNDJ}ppg@#f`2;xjM7Bdvs68Y%?ye&HpbO6FrFzld9r=Vz<-w2gSQC<&E%m`W0sB{gaR zXcaOv1Pl6wcH?Zi7$;H$Jp(*_YwT8&93@HezvtxEXWJXGCd5;qd6LZOS^?O!dP;ZuUg4{$^t(qJ8M{E~K2St=aq(37$nvM%B z_s?aQU+FYD6Vk{JAG>81HDrzSVit<}yn-_F$JpX8Fx9F{ms($! zRKv4JP9&-2BCBFD;;_*?jUjgF_j<@Vs(t^Iae$`o50@~)>Dm^NaReWCQ=t{q{c@`J z1YK(g)W??IeawDQ`2`8o0X;RCGJt5nl0$K?cr4gGBGv7A3Kv$wenP{|4v8C>`U@iA z1To&iEP@{vk{fbrwv5zhgLXmS<-kRa{Pj2W@i#{!5h)1kZ8$cZ94DkS3Wkj_?^#MQ zKYB4!TKgc)Gc>~+(Al)aaz)uu#hDtYp|*(shp}_$5-r-6blSFU+qP}{q;1=_ZR4bE z+qP|I)_G%8qh5{MxQ+b>c4y8NGvbTm$DV`3yKo|AYOx45d>MiVu!G-TRL4Qx?KQni z%zztU#_p^VMVE(dJ<>vvkOSscu8g_C7TYuegeyBqbgEqa0CS5N8UY?8^2C&;5A5yR zndk8~UMa)Wv;kvz;v(Q+BK4AxY3ZnFBla3 zL|dS;V2+T8$Y(eZGQ>-CH)dT|0~o}ry+T=|@*@_ZB<#;e<}s=Ci*=vn<(Z*-r$(lr z4!Qv*m!eiUtMq;>$v=I0iI$4m@f3#qjgNaw$c?&E~M?oGkVOI79z((SdUY8ly*OWpXMsU_)(<%ed4YI15 zlr79UZS2jV3+_PuZ;q3nFH?aG3DDHUo@x@WF$YOC-|;dA%E=RoakimXM?cQjapg6< za8Idf?Xp-J;=Cwa^*=t`EuX+&L#-0@<1{)D_2r)|hfMf~ld~npUiVc0d1n`XXaf8J zchgNi=Z?1|&pWrq9oI|9x||JNhfgoHWAK@dpJj6_Dj5~@Eo-Yo3GfbjI@$JO@R0K) z?nISM*XSsyN=~|q>YAXYokP}eR;>nCNdf2hax%4UzpqRAR&LBg-nP^OPSFsVKIS7+Mt8aL%4mIAPMT`dk=gy%2JOcgvSim z+URY8%-e_FoG9ZCxevkqS|owt zyhic4-OM;O%P+iC!20vs@Sj=61;PmiC-;_ME5Ty5p&SEA%GVNASqMSE$~m-CuXsa9z}E^hcX6HvbstJRXQqGOLIi47GR6ByY_p1xtH$K0kt~ zQ3<55=yc6mSDjE~IXgU|#t*93kX%Bst)62G1HSPFt94biV;&~T43fYhK$`7mIES9G z$?v7ZNsimImVp!<01eqIkh}Zxz#2kLuqHdWDgZu%PZ}s?(1LFS;yHVq!61ti@29fh6v`Y1HHQpfW*CMoXlX;c`&N_X?$?qyULO}Ngc9=dbx%0>V=C_9Mr zFGWdhfbvy<9Z?km>FmAQeQ(m|i%l)lJ{(HzT!x02;LPHNl>8(jsYX`i9OiGCn9YhBsGR zD$ai={11_4$e-f9I+k@{l(mbe>ee07=Hhssx5$8j$d=&6e=cD_iq|8-^jBhq_aOmn zn~-(H5!?b){^(Pz0~x^0i=d>4bS{8;F8MDC0B0_@7hTJJx$t<+3`OU0d*N5!vlwHr zx?;GdYi}<;2USAnXF&83cM)m4i?4bUJ~5hKB|_$R_1Kvi#M8YxP*mcYd0;$dZH^rj z(3AkqP9xCX={lN|Q-+mmRw@+IamrLz( z7q1Q&%oXljvfXXD`!b)Jyqiiu15kxIk^bU_a$&Ic>++4VzU|+q`j5@qALs|l*Yf|k zQ2$qmVWlUrD2hy0PM}3xCm0pGY^KpMQ+%Og-ML^S!Foea< z?<*r_oQy^`VT^L?=wEWVx~6m6cs1?2R{bU`f-t%}(fxL@@Xcu~+U{kd8x~vyU^;Pt2qXett<> znXRy$VuL_3f`lAA@zGr&UVcS!$bv7yVZ_0Ds?;vfojJ4~XI$GAEtzPHP&hD7v3#Ny zK5`0i-m7OdF)YwM5b;EP`eN0v1)FPOcI=e;@FU)576P_ z`!|WO`z$N}TOu}n$hJaE2-!xByjDm(EjqOWOC&S}Nql`tb$PIsuUPu~Bui zQe%yj$CvWcW$rF9@EA8wtDmVEa$ML+gplT%3nU__?4G^~xi;DK2uc+>(|Cx`f0V5` zav_OKDrEG#xQt1JK<~QHEmdoKX<{cJWvW@f3IQBYGRe~==4`SBx&xq3{A++w(QDB< zNy=v-LP(X6FOhiUol};jFo+@E4dyzb!J^AzYOyi9EWLu%(WG7umvWAg1DOT^ED@3r z!F((J^G&^BU9GaS+a+%ENe+G zqMN}BksW~|H6?w6MHC5%ktq4o9ZCYE5Sogh=*^U!k|>_mI;xR~xZx>M@{waRJi=hf!Z!*2}5W+|}h) zEw>&AIh@(E`Iv4Y8`p}?ac$+nPs{1ma+xhlL~!2-?~?&9BIXDJ))c6H+NUS3iL0&9P1D zC}~B$_km%Zj=%015Jt3M zzH~1in;d~tfG1v49Q?c!hzHXki)RFe%BO}~DM=Wb>VrA6ZwTUK5miT=Z&Olmgme6w zETu$$Lcv%4@;9QnxMvg$4$-et^Skzv9NCK(Dwt@qE_%eytjgt~!MydWWLYk5-9Y=# zw4@(6fxW9wwUYV0E1(zw)%0Zv6*>kzbsc8)?HssCm-#c{FaZ#sEelDpTC~DT`GmYvVH5d8MROm6 z!7F)m7_GxeP_|}Vn;t*Eet@Gx*(Uv0z;lCkNhF9kyN1b34#^{>E>x17g&OGUI4`X4 zv@i~<)-9&T@DzAvn4q^?$u7#Q@}Ev%17;?fc})o2LJv-0g?Zq~(w%ue+ybz{HjF{l z7Gd!=e;OG`?{7P$T*AJ=ZPRy!_Lu8Jaz%N`!=YZ{Mur)$#J%Ek;Vu)ck^_FWpDw0s zjhSZ$8Q}P8W#F{)GJ>LA_arlqH&*mE2a4Crw#AnF%S|vR+}Svj^Y4}VXIdyc`G;j0 zM#h%3Gyh@?u|)ZZZh=xKd9&#BRQt{`YxJt-P)Rc^{T@wDA~|uPD?PnMC)`aLaK`32 zEn`_b2EFRj`_&s@C&9q)y5;bi7C2~b3TUy~6zV{b%IaS0B4pHM*8U~K_7N)hu1EGh zu9<0D7Z;!K1NiHYUOoGTDGWx-3v%5Dqs937ScVzKRz~|wNva~AsVSD&* zlB;lsA{6aS+=dRQ!~<}(-nfySZ3@iO%|u@1qp1SM@n%|}Umf)!smTj=+$!4J;&u`} zB^#E%U0Nrf^k%>og#@s4xkVASRi4VVc`vg_uiZIBd`W@fbWR@wVh_x>b-w8IX(H#p zw^3tbVY$O871gMFRXM=x;?t@9)Vbo*MtNn?Xb3bCWLCQkPt&Y--j;Fgdfh_HT?DaD z;ybUO#nZdGOkk3e*1T{`zna^8AHr1462e5TC+efk?((n^^+YcU3abk{+#y=N2=1qG zk&`hLbG&$dFoQ(X>DB_E>+c5K?MlS%DxSgT#HzY%UP-@#RZl8wQXlYS9(Ac1*#9-6 zV!GJVG^xK*@(k?;qQ+Mfv%98Gj#&All@@1OmzrBSsKso6Rx{RJddMjd{-qUB&w*8~t+QhzUEry&(ikY)r`-de*QI08L##TL#xMtx!ZPRb& z|MI}MC*|4kPZ>{nCaO|!zYZ6BulIDjw^vYOMW4LZZ?3jqpLxtI{%+YtSE-Y5FlflqT;-ng&g?usm@Vvpkd$!Mk|6_V0O zLZ;f5nzl`%S9fjEKI_cNZOd4a)xE7U?O9)Iznr*Ej&n=?#)o=dnY@zP-QEzMA(V?Ej&rYP7Gz)ep8{skGUXyZQje=h+l=#&nI+%rWpPr8kE5anWz{1?3x)7LbIRGiW zr#g&)KG{W0^#(t;$n@dOJL?W|b2ZWNfrJF^Qzu9S-F6S;+K3~sHZf)kT#zA+g?jC~ zIJ~_$^JRbQ&Pa-xkl5k&v*E8OO#K*4;;+G7MQh(&_gSd5!7FqU%7DmXVq>RE6^`O) za-Fa=x(Q-4Ly?*0#nx+mBTM6i%9i$t%Fs z&nzyPV&hh^E{Nj~u_=5ms$?V-DScnM8HwW4n2vZuzEYya_3*%Fp)T7o+~XvGyMt8V zeUc~`^y_=c*$eCnXX*k)o_~|l7m5VLfCYTR4dLz80l`vsMfs$3r!G>)#i$Zk5)?N@ zmFjzq&b8BP{u+u8ryEhAadr8jo3On<7vaLGV-C67l(H;^Nv8uVZG!pPRAhKihbE>< zhF5u(*N2I?$Kgry=eDgf8g(^0!O3-SIwWhvEy$%*_$Oayat*TO^^t%w;FnQbuoLnT zN3DDnEfA3K(@&RwOe2Y>H$__8D)3E~nD*0E&-GOucPl>z3#2jC2>?>bQ#!Q3@oxqS z52@CfKE$j7)~Uj>2uI3iCG!CIErPglpJ~R~Vg_uRv&%xTep#ZF@kChQx`i@%1%Byd6tXt4oiJnNVj^&(`1FrdQ>DO3|@Y)yg~j z+oVnm8^#t;u=oWgN{E>P4dZ(Ctk`3jP8`w&*vc2;c_xeNxS&yLeF!in+$sGcf^z$Gos4X~{!#n;gtR}HI=N;X>Q`-ir z&Z14URRgVNFgWozjPm^8k{&9Od#MAy3tx`YM-w}`SzBO16-NNF*tkgF^o;@(C$X)A zV)O~iCN$*9m>LFIBC-6BrQ^8p{ire%KMtOGmyBL`4RH*_OC9RYcFCRWA1BmX?El1ax~n!=NxDZ4C4;*znTP)cy?tfiQL* z7r-WPLX=5Z$&C)6t3IaniLniVujumt-ZzgWL(X|C2z5cFM48V4E$R9isb@#3qiCOi zNF1Z~BqeZCu>=9H;_(b>)KL_~rhlnTD`^IBr@Ae*GxOSP@ zpXhac^z+sB%T&MJ(fE`?;KGU##LDn0a@!ZJ>}xjHe+F`kg=3c z+@I-6CI&jR6lpK)Y)sjj`K`%=?d%8@qy(#plrEYvvCdd}c|6Zh{#YW`T$R_Sv6lad z^G8Q)CN`t@c7MRiS^HIE4_Ll

    gk;QM+ zH5!pH-<95*GXZaVSqJoE)P_xzyb!@G#-x?!yImcW^zF4#O|JEjA`4GeA>pL@I-%Lf zPS3p1Nco+>9HMn!$Qe&+ zEB{=L5(_mjzJ0+g13;BDQ5?dEFuNt+@Xbf76-M3|KV6J z=Hra{g(kGHPw?r~<0MzBrcYOW()rZ`QBy6rjE9w^^uRAY(J+C|Tl0QM{|mkjM2z(x zx3&Kg_|5qLU3ewq4%<-w2~uw;YXVu*J{g>**anVL@j`TqP70kWssn8_aU^c)tPh8e zc z#PKs^hYxgdT(iY&NQu)V`O+|pAk467m%M+p-{4tkjFmsj^IKEmxcF_rZ|*;z;Tv$8uK08-I$yUQd9_y0%@*W^ z{TPRRv&MGYeUUH6r{>)yDvL&|IDGT}H13<}_NGD{r%D)jV7y7=6_F=83_&&%>44n$ zY$Tf*B~oZOW`)JHYv*-NxP|HARRz>}YSHY8s2JW~{N)Wy9Cs{e^; ztb8f!_`T^w5|mVNRD=MX2}qR4dArY}f=f_78CmsN8d*3{0-V*s;Yj*mly+G4E|dw( zM5maaGm#7~{yUOtAr{=QMzGK(v6Q@=uN*Rt>TSLrsW4H>t=g1h`xp<3Dc3F@arD4* z4YVGOD7|dj_zv25Zkl=SbzZ`bjNNyRk$m2PDps zQrKH9bwN5a@vevYi>R2tt)pu~6^@AX^%74l@UICfuq>gSv0Hr?Tc3scOW`mp&Ad!* zhMJNR-#{RG^g8RagO2t=bjDj-@5*Br)!17janQc78_@IH zLHEZGYDu*a#R59J7-+&2UEe{VpF;4-+rAYu4{8aKxVtm4|6y0e__FP)>+AGB13WnH9{m|MCSeGF^XlyWC*eNKCrRG^c0iJ@jF+g~p@%0IzI|{)D z5~NaAMHzXScQwtm2pWJXLfN%QzF1{Rv-QZEQ9#z z{Z0C%r-bCU?6*>2Q8UCig0*o0zoK=igT~FegN}ZFuf>2ebFThFVMh} z*GEc7Lo;3rk=QM#*wTH6*fe-CQxqn{iThZcZpgx$rl?7Wlhs#Z+*O}i_ITQ)aDGOo zD=i2sCty4*mDO4WLj9a)p_M17fN~1Hn32kJDVN{${E}dzO>A`oK?k+*7CZ- zGEKWZJr~p^+-sW-e~gB)IC=Y!ZA6E|u~{R{JAbb&tCnlaj72hH;AUa@TQrZZG8rVQ zTClPf>XBYJXn67x>yaKX9yo!G;!ZG<<*Up{?FQLwRIo#l&{HEEa{iXT_-F=U7_R6& zG{UK*={`0h6gkAL8y^GwJi~$@5TK7AeOyUx&N1HWg$ThLBe~{;dr^jtI-A6nzlB&Z zbQf7nT`p^eO5lP4tc2yskc#%3Jt}B{5Sb6Vh#@=kFZ;%=X8=*I66n@ZyuBg$>N&yw zk&2pQw~gr5q%F0_65)dH5JQmwQIwa+0HO|`KEoZzcP0D?4wfW+?_y)6DhXb*SKKTP znA4s;fQZO6COemgAW6>^Mvfw+>e75jEDy{0D7jhyj3w>hwWg6D!ws&#;01+M*)VY< zMkOD^Zt8i|yIRZd(_=U2hrpmIz>$`t|J!Sw{Pf&h@0Mq&N01VT+?>`5M+Ku$I88J7 z+HeCGk14GD$JpTN3dW3+NLw2&g@f^?6*Tpf0H0$B@l_gnP0_!eM!jTBqP8tam^)bP z;cCAkJ5l?Hz)M^zcA@BEs?NzfRzAreG6Nj0ZHHgP?Lq*y0^_p?!G8R?qV9Gcn(0Ee zAowOQJ)25D94v{HN1ak%nQ5FmSm{~1n;VvJED)#V`U1r$q#k~W?g)Dh>KXZ~d}H6+ zR3$$VVlY+4jJiE48Z+_^n2PWzygPFw9&7~`5Qb&0p%`MLzty^Mjx`vna3`c#BAN~U zV%bw?_gbz2<%qYlukghkfvg8GzYmg=lKk#(eu1^g+awX=R5zd-tJC<*ck0#XaRzXx zw}4(0LZp9CtX3rK(;*+_aM%k5kFI)1Fyv51oj1=CLp};Hp_8CJV4TMksi0fHiv_5nI!c)y%FCjzxr+?-XU{IT-Q{8btb`r~J@Ce0tviS$g$}{cF!!Kdh_^R992Ks{ z;cwo)GwjEwaGl3*o9~b!{MfQjEvo$4yVmY zwfoiL`5Wdvrre?fCb`Ob&3U^Bp31kg^Jnd{G z_S$O~Ti(`K^cMv0gc9N9odMq$UtU!`K<1= zI2-FUGY92EIE@QNYIvbOI0ki8gD?uy98HkVJH>4LA>=7z?bq^+s>51?YB+genis9> zK|BRo+`OnLPFuc5bEbvJpbu&O7#u3Jtfj7w239Wj!3{q)FD=#qkYqkze6g4e@ii}P zCX3K=c}7Q8{*>Jn!w1!3WL<^y3dkr6QCVp8@jluJ@wLHEeORoAhUu8BO+-O~ zms2b|*&`)0#U@|+FlAA}1pZa_R`^!<4smi6Gf@buf0vxbA|jO-0h}LUlBIr*_V34q zGRXvcpq{u}L>ZIr09-bq`vm(Sv6%)#mj&Km_xH&on7bplSBx8q5A)XIAjRY9^X?>oDXPSjUgIU7%kyi2!ZmK7h^J6Y9YNhdLE|$WV3d zq-yR#ATHa)NTxGw{mVf^O?a@vUQ5lh8D&9|01$A2`1n8L?9y1UlZx~B~ z(X9B!jgS#vA6!!9rdbpHf#ZGnw~h)t&J~IX2y)rLrAYH1MHb(M8xrKImV`w z&J2Hx&*(G$aNgY{bwJMP09BeF<+3B#hlCrHR)tkvZQ**|8(;^2JIIeh#0H z$5X=?oG1^~gr|=)xx!^BleQs#^cWzrol7j16p^W<{^G?&m0W@D@6 zM&F5po$=Zd^JgHAjUXtydrIAsL9~?tAKKnE=qlChq#JO%bJIze5<=QXkmGHkPu!FG zhNSc9DZAx1r-j;kH!|cs0V$)>2Nvfk@~y{CiWb+((8 zA&0lO_4V~6_EjCSy;Q+aS*L=eB`I+M zvZT9-Qf=;~Qi#t~-OVyNcUMA2h)~8OJxbkSg%}V>S)pjGv8<2btVqmAMmHxJvp`U& zl=CSweX^crkw6fWp&zA>S(RVP=RA*u?mV62jaZZ`4P8vqdi@9%#^bmYFpKS^GS*QG zZP*O&{RCl-NJ)Q?B7YL6zya=W6Oz^Ayzr)`(X8xo-;#jg? zAq0-x5l|wWF4_^!O9zR6|9!SAco?|IB#Eiy+D8~@;y40!_c$sBihi>&ki&@b+JhT8 zWy=@gHK>~i+VG}&tdObU!{_1;m=ymgZI)#Fn$->=(@3s1*G*UY3J{n<-Q<=&B-J zYJ({2TvC^Z3DA-Nquj#_K}O7F&oV*dD$6OS9giJU=rt9{Zc7FNTj?-T`tS!{Rr+RT zyy_F78%bSsodnpoaEVm3qwDE1ybK}QrV*Bp&1Cj98Y#qK zfQbNvy?$<8F48k~|4D_iek#e+4qkfxDl-i+am-_MveeT(f0c$#bZ1{g-BT4rln#Un zR6myAB`&P8D{2+=KjFX;qe%A%!A;v&-fCJWO#Fq?cALZm*Zy#@L4v*_MZ&*u2&T6% z-fgmnN?X}g0{xWKwARU<(4!|X!2~rw1xU6QTVS$GVGq?+HsrP0mDKLpYt%xm{+4Rn zNBKiCsQz3yXadePbdk)@KFG<{V{O3J)4JXKjJ~+hNy3R;a;$p^ zKJRdJ-?W6d?&L_47EMh{9neO-^$NCOKF|B zr{2=fVVyY$MxVytkIlBPE`G1GpS`vqDIyNA$@j1|72TiL@QzZhgP2YGo&_SoCmxT}zvBZjEcM zuDwa!`pp%zvXX7Zhp9t3Z$A~TOdLz27oJ#mVQXwYk@z)&-pHx3%N2FXUW`)Z^NZa| zfyRmd0)O1`OhpTHI2XPWh{c)a!(Bv;1CDX5aH$s$>8 zPa8L3rB=)v$)K;$okhf)Ta4Y`&Z97AWP;gFNct7kdiZsx9k?Gbi!2OGJgPyP`%3Vu z(wn;+0d(O83%zeCFy(Cpii#A4%`a4_iY1*b(v>OHN~tHMS``7LjyaZ?<*Bl&lOWUO zXw?E$td*uBB5;b$5)V$5CB^y2mfL~I=A6oOH;5@&yg>^hC?Bbg8D>=}R((oKHpfbW zP#Vn7tG?xQ!el@g$a2rJi9SXqYYfPw{g*K){XB^)hVx3nCknp+oG4?Iy8TC>X&??8$l%;1VlZ1Bpao3PX_U+>xTbF<{{~ z*~*HI7{uqyCHU^1XAQQ^w1akk0%tVx^lqZZjxiPsF8O-(E*J0w4HbIF1@`hvlP$p_)0*)>C%d3GtP9+ z?ZSk=fskzDVCW)H%@TCXk%`HSS<~m&nZ^$$PKgBG88KQ0gUP4ir}?pg`GsPs4DH6Y z>=sF&g4A@og_z~mChq(0=QFWyWo2e@SG?_cz$0K?n(Wh|AuzxF<^8gESmT3A_RRLt}PG z9x#r*L>gIWxg?+DT#$*SSYL!Q6WicvF+p5Z^)$vELJLV|Gb+?FT+Wdp!E{U633=9q z(o+DcVtui!8LmVv>Od#XnbSbNohv~&f|)Zx6o3HMXAZNN9#=UF^9Ux#9pmTWa+wIj zGP;{f?c9i7HYgCcd0^PdTjC3Nx#m;a@D#49g4z`A3;ife4=!r6CA$JJEIrHFrfCKo zBMN|4b*gVe@oR<-G?elE6vc>;hd4cyN{BF~eGK-&t}`PQM2wn`moQw44oG1SS)db- zYOe2ASKW*Y5o=GDGL0Rv--bya8W;YLlP~YeUI)8;=M}Q0i{#T02`-y)_h# zyi6HoY5&(O4-00HC%osI4hMEm9!Djhx{V2NLNI|54Bo*se!aXrdHNP#Gt<&r0z!KX ztb&n0SUL6JtgVxlQWF{(aA{UtHjk1(yy}Ar`ktf4t3vLr>Up^cYW{24kAZjLHD(C(pp2l34HkP2Iab*Oo=yxiCWhGoI5Sf)g=>k(3Dbnivj+EnPF&tz zHQ$XlNEm~k(c42~*ih!ZeTMHjW0^O5^ z`$lNu$NK4C>)w+l>T_xKCVHL+$zzD&1$WH=XEt=>SLiq*;&<41D`l8fe=pQ>9$d`Fg zR5&65*taK4;I)v6S44>=Rdmh=+5H&?P8O4BLUE9X{v3j97q{+N|5VrXnqQ7i3|RFk z>~iek5NC=*_Ow|A${3?P`ehX*z1y({t9qSQa7|GJQ`t`dhi>_nQ{$Vs1_q)`xF~%1 z7)d-|?kS~EbMaUkI+rQe=l3rk(;XDDgnn$%%QOKAA3XDkE#)AMtv^-sZ(-h4tD)p} z8O&RO#(dZAteAKszTVM>-CT_ss#$lI#j@qJLC)P)pWeK#Mt#O;BA|03`$I=fZZAw0 zypWVuWp_d=K{5U_JHJGSB0;f+W5%$@lVPGvI36h6-u#))f=2OZ77LJZgXx4 zliD>+R!TEki!p?0HoC5C?D9+jeIAF}f3sd?9pUD?y*exGUJ$9Sd#m5@(|;Dc@oap{ zFCjsO0AOgI8FikP_fzsnki=CxOG;M%RH(u1jMM;|iO+?q$p2n|jDEs~%k6~|Cilc@ zhD!LmCkoeONn}j!H1ApLnCe`vCj>x4(jL&URmxbY!xiL`^11GMeFK24U+X}2jOUDp zrb7kuPs)v;oZ!O=08y>$-9*6La@bN=lScS8eQxDUD0pd zADpXPzLm#YZ^Ie%6vz|geWR>mB*}hzXVFLIVB1clV>w_H<5$}ylODhMGj1k4dUuz6 zPR;mHiiar>x~BUv)5(s8!!eEvSJ$U~1 zG<^-tzhn9B8s%N22|x&d`jl33|RmiQ~c&5L^6|1Lo}sY!3-lH6*Hx!EDxJZsj|%rrb)n;K#+ zV|uD@ijz@mI}cnJVAXeOwYNBptn%Zpznt=%CuoPa-KHNq)Br$J*1#5Xl_=w~O23mE)Z(WgxAPRM>-)uUTh?m|(t0^C5P%)7$$M#gE}&FwiOPR#4_(o@>e!+ z=RWDAysm(aP#x|U6{n=FZOcM??>FQ@-sS}B*Z$6daO#3u){Iu zDg-DkKkb8S9c@U)8OP%DMw8{g89)SqfVg~{6@E1@gBB|Y=$poFT>oAmeiFV?k!+=> z_-(u(MLUxIWX4vi^qFdzF*fCxM~9Q}lZD^D^#b5$6W6!DclErgr*UBu-@a>XaW?4u z?#qvN3&u7O3-+s9$tqd!5{Jx1zmE)ecTFm}<^$87P=52Ry*xYqmr&?>#A zjIDA);eKDIpVPa(uXZP+1!e!~UBdidbtEvdGI0LCdGupVS-VXRgznoqggIf8e4}?t zDNdSrvm{aUZM4m{vJUXkQe@zk3JJ%C_g8Kd%FRZ~VOJcGH3C41d89u(S^HD*FnB=! zghS$h;=8z@d7ig5cs`v)e}m+MWRP!3fkc0Xg%=#atTHP@f7hizB7XYX3{(%He;MWUu6zcammy5ZmKD$%%!`f9Upd)a6Pn8uj1 z@>HaI6w+Yz#@Zj;nWhY?nb~b}Yh~?`gnXv(a1lo1W$+*db*FFXXCgt5Fd+9Pl$QH9RJNjkH{rYq?lG}`s#rG9_oT&>!HW*LM7-8^W#&_0w<;l4VXb~mGG z3h3kNne5EljMZZSu{HzM${+fD*{WE9&6_N~^T}Is&P;8+EK3QxQbaeYiaEq|=DMHK zV88kOI?lCqd-Sw5SM_`Sn!2lI)&2B+&UdTl=KjfuHl7y1(M^*CIOkW4R7*iVq54{f zVSB8P-u%<=h?&Tg{cv5AaMfx)FeYge8KyRYbTAB^n%!jveqm10{f(P=#dxWM>#5L~ zAKxD(jie%za;Ld4e?lGrBOr#c726vOiq3~Fo^NF0M%O8or$dt-2hB@k2qw6{J-|ah zO3>D;f_EhV^bF6$DBD)|*Z<4{!1TwF{NOCEMEUEN{M5f=NsV!568djfvk%SV-;C$ey#}P zKBn8oTiV1HDNtb7|Ls#(3Z|B2SWSZCaXMun@nid?d&%O|4QN!fG1U~~y77I2Vq!!ay;u0_v=)%CjEn8!QC z0)KEbJofvGM92NMsq*UD=D0D>Q8ydsT;++P-h_LT$nEK17HGZcxsl)CQ1AHpH*(hW zuCWS-)%!gVp~}@WY>|oK;KHZI6-)p^6SmF&U;k5!a%_Q3P|cKvHj0YPF~k^qnQ++1 zRFD2_jyCcbSA(Rx0JLi>8T%sRTD&Bl9xQ{QrAjTm0@f<;+IG&`Y^@h0^TSnCSH>m+ z@-t|>6Vj|Viy$NEP4jC{MD*Wc#<&Qt+zJh+%5Y_^ZT9zM>HXy#$tq^V*&!mqbejr_ z4HX&{`S?4-3N+%y`#`YKh!AJ|sj!p4OT?#Pny#AK?qm;yd=15ujUP*~QM2?-Zk9z& zG*<|to)%)_Zh!gIqQ)No@c#R(5?PPBD^%^;$m8m#4hYwt{;ik|2~)DC%t6URBKAc` z&EbP?@1qkv`ak*PF-fdEkMYM;*e4U;CIoXFuu+9bdB0|paiOqsbT&~fO@LiE;oY+K*E(U}Xg zx#p$E_7Ke9gkri=gre=c3P+(qNEK8!(0z3-JlJwD@uH1iWfhd(y*uWZeO})lyK!ei z-6rsDWW_2^Etj)%q#k9lcD&*Q_ucNyP9iZLu%gv)PK1$NeKSN09}2a;qeFL7nN?YA zA3bvT49rvba*KIO6ks39%*)D(yD^9AKKl84zrp|JXZ}Y-8}olhqi11d|9^+Y_Wy`j zZT}-;y`hZtrBA*Z+j_vp;{btJkc4gXnp=0!R?~WsdT`+$joRH4W;!a{dVxiO^ux?0 z%cv!&4%hWidEGw-(lC4xLyPY7>s7-??ef$1e2Soh5C_3(^4Oq@&_f7^UJfswd|tqJ zez2_Bwi`vOiun8wkA8XgdiKv|txfOO{W(3f97v)}fJv(m<;lO17{MWkam3Y7<**Wo zT@3l^^y`UZ{d;em&A$%z4?G_TIwkMDvCa{3oJ1j-{ZRf!Jcgxq?GVl^%BKt=!V<%L zX-g^b?9I34N^yRIWl?Z=R0p7F~Q#x?+tc2yGqDaS!}Gk4f}2nV(wXIDdC8!u|HIfhb%zqH?KZY;+qP}nwr$(C ztrgqOik+<3ww;`uyZw!^FZMUarxkqAuem(DDH^wZ+lA{LdQKi0lT%?$O|Zt8{$o?lw5su2FA=$Sh# z`!>GRP_>8Oe2zluC1A(iy&s%!|Iq)uXvFdJ6{W`aez4O(rX0AhSlCfy_*7d(2{3Im zz=sOHInrL5+g!rQYiB0k*1D(NYv*%An>1|FyzQe{z4_(lqP0XCdl*EL{5F%0@O{+I z+M(ThmyR5Ttq7%Ln$hgSSDyu0fOWoYS_D)yEnl(76cEBxez_HtoGHeT9JORBdr>tqB219&RrZ~zB$&k4&a|Mb3!5z|$(XC1 zKEyYUvyATEfNNLa#MB~=04BiJZ;%!zHV=z>atx8KTt!` zhbXxMyIhUUhPTd=n4&}@Q@Z02<|SJLHED=u9ax5~@bVid^ZOIjTBO^I);8@fln8Xg znmU{zl5QK@4B}2{^M^qGK@8}|2)@8PoFfx9KsEdWw;bdDVqvtZwD6tw9q))7_Zk7&jMM)%*$C?BUfXm zF4wNX7Y#P!!v3TUuE>s_y{L9t3qOR4>%$FKw$VFJ7JB1>?xEt^ zL4jMXs4}fmBM-R#37|k9%RUB|Y2OM-w=O6t*k$FJHbhKN7{Y6S1E!F~tmDQDdQI1D za$9%1M(jEiFja`%Q(I#!8jNP-oNZB*h!rBnGZR|bNp zSr>|>ECvGf3ooBSr}yFwW>(-+DrWK+M(RE!05lFy4*WaxkKKLOK9fv{LDDH*2n>h% zC;|iCAY{RW~8jPpk2e-^E6JLmd_kQfKz5#D2N)cN} znniH;r-&UXIy5Xyg~zLHEkH5b)ga2$84JK4pvz$9?_Rv~v&m)l<@kwR`b^S(v3hTZ zDw3dSTr%tPv`oi%VCE_11;!{4Cnw+17<(0cV#8vWN}+y0SSm{+29=}ZbM7pH+y!cHUp{!z1@b1ko2@a7;A4fcrBfw|iM$OXYuSDA#Zhe_ zKo@kV{>U?400$XmspQ^!JJj-1^>iEG__UzSSniOw^< zEGKQSIRUZ-*xG%TqB!LRo1vY~STnbBtZLmOC$=#XGJnmhO(&zxX^WvwLv;5G3(G^$ zT~KB~z3{1XugixiJSe0Q6oUs zlycj_)^RQvUCw|!j?rRlViV40F*j-m0s8@LAFH^2qVjlMETz z&gxn9pGHSQD!S5ttNXT0c9^3jVj&lj1GfmH7$w&g6p~z{J-bE7Vqj6%OjPv5T;OGe z_$0nmH+Y=mgo*tIaYT>~Vnu0f74V@TGD(uh9PqxUD+1r-60dmMq<(r?fctTXifhjv ze$U34&hLCaS)3?JF~v+Eah@=X#s^4ZSFdCj#cxmBA|@sE3;=86^y7vadHf} zXPL;LffyJxGns{}1}aMiODz)2%a+Z30m-P8KSTe*zmJ4*ea`ilzm_}eizBBlmAI!F zo>=MlM&QJ^L`8oMO(f{_zOIQrqU<2=qt;T}OWiS3OI!*G4`T|rb|~3s1aj@fV7(5Y zx7F{uuSw`i+3}m1b&n7$@l<#XBM*1hE$kBQ1e$fveUk&uyK%B4{`lphULlVw@7kBA zH;zhT;P2WrMRf;}z#x(j9NyDs+0tPe{k{!HkEDqS=Ztm)w;@>Bnd`sM&`8gEJqK@C zB}r6zCwGgm0c_-LQhhm^Qo)JR4eRhLnPfKK;$(}g4c_{pJz+^2c>SL+(u9JOjBvB` zUAhRzzEnxv@~1KyF%#N*i*SjkuUVs%oG=#)G>G~!%a*o=)C;{k1FIiHco$1p4kKaj zA>(rGgKNJtF^Q;<;~k|mCdDsjx&;`90B}QLiZpSoOW)e7p^o>gR{67Xb_bGs0>q>k zSxOoN1-Rv`3FOo9rWa`rJuFvtA^c4l#mP3y-gsSMfG547XnV(4Z^vi9wT_z{+y zEAJq^@vM_O@r3Z1t&;nkP+SRNXXO2~COD&T~lm-hQPTOYt0 zuJ_`LcRWwg)^(AXMI&6}Aw+0K8sqqXQh6(`MaZ?qika%*ei)2E8)Ah!~< zs$)fgqn&;?%37p5HaqCiH`VfJ2QjaF;dL!8o~~aTgL^p}iix{Jb?W}RLzT(O$jVy6ks`NPHAzyS{v9syy=HuL7bXUl)r2}L6J7aB% zN58nWiK+PPswv#ky|Y!b9)|OtNH0pr7n(s1EbhxJjByMMa51B+ zJg(vxff@iZPl(P{!J9u?MX2T;-;{JG?K&CC1V|tv06q|Vf~3CM0%IN-pzmwmsB->r z<$xY+@yT5|5(BU^!3?XK8XmI=O1X}--7=)vWK8n_NdH{m)6j-B@C zpBN4$Q&b*g<^c+EW|!9abp2Q-$dB{sesUOh3~5O05PG>dzJXWb$ge62f^EV~{A4xn z#7sqrdp;!J#)#RyejDnJla#L+t=De7+0>c>>}hmq~QFR&fXF_ z2;pU&XBV$%TP;pEVc;sVt75Ys^`KRs17LYqVYk|nT^S8*_e@K za_#O?>}m#7RaG_jXq4^D9GRqeX4%cy;ky`nBena@1U~?)=5+?mWDA`XCSw{BRDW;p z*w4BFuNiTKk-)zkS%qjOMh)_~^TI{`ZU^a>%F`hhmx;dTYP|$#=?k>J(|4u~Z4w#6 zcdm$ZGXeHZojcu@v7gB1eA<~aB9mpzZ=pp79U_KG9m^r(Ir6SQFh`d}^Kah5l5Oc` zxrzYzR*M!Kkjh6hQMbYG@E3TX+b-L*f#_S@UQebyv^Dz3425?P{#_wyI^bF?+iVEDyF{+C{x^;ixQ^jJUx8 zIg{Rb}-o|V_p^M667TFo2%w|^hY|HvO_`9CM2xtg}|8|{eS+xmnB_;O%I zd9QM%qJbr{3C)&p9ohx>ouE~zhq|n3N2!N4XfG%Kf6Bfh`BEoAR3`Fpih0Phv}i0s z4Dz!$(d;%|#1prtH`32%k|-;IMbgrxDH`NN#1U0dPRXz+dw-{4#pxkGyKhJeOHmdh z6-eCkO=@J{UGt@W&58CPTXy2$(oWyaoG8el5Cch)NJB))_|r~E z{pFxI;%6P_{{EkQgkutbhkOhr5e9ao?6|FYiXYb?ee5LLMfEWQ0!#`Zh@inpu8n>5 zhca|_rexr2-BRqcD!9dEz4iG*a-uR5%lxoIL6}O^JzL?vf*naLv`E2$uv&Wbr>hW2 zs-N*s!c&|)TfyJBG2c|~#M=)0v^D4=)$?&4j%lC`KQAgkeaNVTDSLwKKL(aQ54)L{ zSzorQkK$Ob45bSg^HfQEd)@-ylPP;v%LAQW`~DO#}rv?nUN zEDT}Js|z!qR^}u)h5GMSiu^GWg}~QAWpN)w&SFZu7UZ*V^*oaM#{o?H6c?RfPe>=K zE9pZu_&#eAh~^*2ScX|aa3A1(lV6+a`fM^|rRDEyd_49rW6laf!#D1JJ^G1HzMA;n zFA8tU3P>>IuyBPlP}Z+dvjBdsIjEud?fJD+*}?vx3`YRSt(RGB8eD>ri}~|72&EDF z{n)_bFA933?c15)DA2cuA4%ASI9YznXK4McoF?#n75Eo8!{n9b}_3wpeJQ3xFf5Fht%uesi_y&dd z@@n!q*@ytr$V5t(9w_nC3;O3`vV8XBg_H+fJrMAcc#4w&xi|}cUpjqZa@a*{m|K2` zc;sT`#5@EQGaCOep>a2tj3m<#D&St)zMnwoYV}of!w@ROmH`(IkW}DKGHw}?89-}=)0M`jYRKXCq0u4& z&~3Ot$HQH&4+Gap?4>1;L%rLDGxO6y77|Lulq;Cab7(sk+*m;Z;8F|&9hj@Yh}L$~ zUQGGJvOHBG^o&kfG5}VT*$Z0tQ2k!$x>@qSf{H(;H)j(_yHNuyCmB*q*%SqKTTzqn zyJUhQhe}ni7OeL4;wV9xf@NGj8+@EL2v`BzdjCjSUk85~s8K{2zBsWC3M@-b4Ehw% zrx8O@MGy+*aLI^4cbXC0X*9c-_GuG^hQedyXOZ=>Vw(d2DSLfAa`Ydh*9gcHNocQB zs{xeanl`2E|LI?L)A%L~1^a{CnBTA#&#e7t7Y7g8q7j!0i_qiK%~-<*8b(9IZ~FY8 z*XQi*L4X|rZc+2JT~wBDaF03AjVv=neHTx8wS8;Tj)#|3{*%&#Z_p={pAPyT)A4$a z;~M_Y=k+rEO)Gnyp1;QdN8j7yz@40535}!h42inZL!U;LyXF_p@qUqf9dNPX9V~<>6Y;d*1}RxhSZ;7rR~FD{WAL6$;#d0|z>r&$ zU9Fy6H5DTQISVMuM18Wfc54^;{_m^eH(La1Ss`zCNFtX3#}Mua2kHPqI?O6Rb^-SO zeh=*N^nn3v(R_epci1hodlE_zC_Cll=zf)Xp=%~IVg(^I=sf{KSAqNTlLwg33i;7< zg-1Z>?|7(mLgB6OXS%;CNR3gt^RIs@;oomeUR1r40DQea^$>VO%ycfh?rXi;Q)Mew zDX`NguMc>@*(?cVHUc4u@dg^t6r3e>EZ2F~Fuv|=p{yTvkPN5^hi?V|GXUxPZ_S3d z=T#k-C```;Nvz>VXajRB6cPdf+^ZGsX;68-A>f!y^!o~#n!ggkw#A0rH72lQQ=y-C zG|+%gEm+LaunN()Ko6_hzq1f0Ls&4R(f7i>C1)yr1F8i4eB5uKt7?8e#_-EM8LjW3 z*|^@ba7Z{y9M9(_l`{a(kqGLY-PN*qsL3m+GlYR&Q+l%o@3x!KRrJ=}V+ZHE{@y%2 zB(CbnuV7m2A0LkjM;=P>cJ>s-<&DQgvz{8;_7@Wb5P%T4!{mjqtmzU!TG)o0z)#3zFgLJ3jJzuBSdw z$z?#Y$AM&v7#Ajs)NV)s;GR+Rt83}uJA9X(IquM{<+!i31I>L>RsbEmo~}m_&C{0vTeAiZ%0f|B6w1_()f`rR3;oF_phkmkz6I*&i_YFQ}<}Gtx zjb?4v_SgFur)1QCE|hQA+=!hjNDu4T7VPXs2(wo*7Vt?hN9$=FxCWudjK?gEYp!wfXX>{G$zoBb;eJ zMN*?~{ose+2gn0Q&ErsCK*#1sY5Zq3zH%7#>K?!ICbywoO)T*FzxICAm5v_%YasgH zQ01)b9RIl)oYvfM+GIoW-KpE%P*TMUX;1QTX?*6=j%=c%_KZ|UwF)Di=O!{uA{Kpn zzk>Ei7PKr<(V?u2!YF`b!77(`51ucV_zgtk6souRA{!T{7Z0b^t5ivmf0K2@PCg{e z5|@bBHC=i?IOUYxpC{k^iAqx?lws|SZzkJr`gk`i{u~r-J09%V`yY<7Pd~XT8*dEn zsBXc&d{=XBRM2eW)lI(3lsd{c*`>&cmfc$zJ0(gEC9kqPFI#shP@~FiNRUL5R37ge zdzzVcU-dj1A!|V;i)AZz{!TS!4)<-V>AE_$kLfe@nw7dOhl^x6y~tnpRKHW(wH%qw zU$<|uf6`d_rRB#hUuCj7I#OKNjxWBLu0A-lyzr`qr7w9Qi?Ryu#PU8<~&Zo<1j zC0v8j62U&F0?V_s251a`K*f{H$~6f9$FOK_fhD`S;`u}e+j(NIi+E6} zR_Do-2Z6S0_jKogX1q^1MQ)1S3H>BW=1v<4(wP)UFJk1%YNFzGJ07}jc|rNV!#C(} zdR(qdgUn&0O}Jjp^-;G_@lv8b_V*RSTBASrx?i&gLb&zPo{Eg?I?PP~KLrUS#L;%; z$N+6TkqkN))JUkZxhaEIB!)5uN6m)~N}hio(Q>i|cKXp5D?Ci|e{8PcO}iVo@QC{k zryA~;-A8UJ=pWU*&|q*{T{?$o1v%P#IC;%-Eeak%z2;XXigdH6<3~Po6)XWbks*&n zFFo+N1>+*uo01A!86Y?VX3+M~mm+{Bk%Y-GL7_vr04Aw9UTW?{p%XL{M?`nf6t~jF zgC-_CJ3}4<@RWd{l{wTzrerLg_sUrkna~NERYabZ#y!Mnfn>}}CEGMp1$H=QF<^4^ z)G&-RJ_B>NBH*~O_yqTR?4y~$n=gBppa(cx@hv%UAwm{;-Z!Iad*1zBvPm-Au!#ZP z*xWB;D;MBFv14}9)o*Q->H#O%1NJ$|L30f*z(`w7e;caLrLUm?`9O0l4(&(*gDLk( zfD1_8mRg`vU=n~V;UK6Aky!C&ow{BFt~wpNP7822a-NZ6VD^03azAJyMviDPYmOB} zAcM6BunoX6HG#eW77*+U^5)l;TB6uN-${}{TXNYBGtloik3{5nry|>vn|R83wGCGb z4J7{bI%%rtrQ~y6$0>6WjK?r|gqzVYC~SXx+w~XVvfwlR`v`!}+t-FMx40#ff*S<1 zsT12=HP4L89x4>Xy@t@R`m0voz|(yNpbJ_>gr^vi(l2JP6(?@ikr1R}p5v>MeQfEm z?br*-S@?3$b@~+?`{_njKfO9GNN9tfNUK5z?zfA-bvJqvXe+N653+KqW92~A1@l+y z7$+f^vJe!iLAW)n_fL=gfe>}rL~0vM#N~wDhMJyf9sUsv0mxj}b$j%T0pG!BHrXVI z$SA0fnI@i@$0HqI+jI-N=#{a+3y?V2F7=r+U&2-@hqUhdck3qJMy-)L7(NiqyxzlW zIbwnpEJiXMQwgy4KXt(I1w=KaLz$Ab$hSh2N*t+R#^PMhL_K9JF$qgswdHz9iz>MV z;2`&Ak1{&A4+IRy$O^wNCPWC8M8nUGVOAwp&Qzd!e5>_66 z00lr?Uz#=(vq zYrqrV$A_^%(=_Lz_L!6x1jaOMY>2WEZt9O(&vZ-^cEF--WbsF7!!+@L1Ih^6oXg_0 zSxyhRil+~*kU{hCi6rP}Nycy5gy!~HGYV${=i*`1M~$Jbf~bjmp+*B`YqjFaFh*pd z;%H|I{%xAC*^E4UQ1qmE>&?jdg!U9#<$lC?4q?E6v-0@k0 z4DL{|IsHP{^TZ2%t~%HV)z6ebfbx<4wX9XkCAb58KY59uo2dHf)r~`d z&Y-vKL5u1JX@2+#otic@T2Fwq7W^>-YHF4HLkgj_TD@;}Ew$ zxl>WoPrv>eD;rq20LtEe;s9J?CcgXmJiK7^G-?w|Ep)b~;+&y*RwvszMI7^>f3rC; zW@_NgIvR967eY@qz;Zx}aOGvomoSCIZYpMy?ul25hePJKlDQ1da6|O3-w*0q?~)P6 zMqnZvPXukJ3Rz$}I0Fq%z+m~jNSnV%5@PAE~{~NQLk@NoyL-lA# zJ8y6x_1@GeTp31HH8KoG12|8bC1q_*T$@nkbqsUPk=QU2M?y)Oj(%LUVZ$nv0CU#* zrs|490bs}a`Fyde<*WOo4&m!#0{*;JZP$G}{Ss$lHSTg!J;&8o-Kp)=bsCk{mR%nR zy<7go6<@4kQ<{!mML&sArhaL_YU3!aJ*`jFbZ&JRe%-y>Q;)Dxmjue*8XL#pe|^J> zXL8yEa@*`z#ZqM+P1GHwIg({)+Pe@o>TeW+7S@N)ukCPq+}BvzJJp_B*>nNRy0}03 zti3F29j^@q^r=33bK6;#xev|zU!Et5jmG8G`F|fBZMX~egaY0#hhfjjd-Z%rd8cw! z!x{d`t4rlP;L2$||7bbZd`du~V!`33=>{TpibDz=$CLO>KkGM5T;^!_1NRa~)-!|d zx?5y2dRrmN+p53IZF)a-wYiNun!+bK9?~iuYLQKZ-A30EAEjM@?Y2vvcXcbAi@VA- z+xZ+2nDkFNxXl@pe`dYQq3V%MiBU7^x7kL-RJu_q~%nv2*e8Ln#(?1u*79fR>0PpghnMhHIi3u1?I5j zw%Ds(VZY8)NIo5}02xm>=hp^t^M7NWu*ih|fO=l;`cKn`U`jHyai#?7lMx)(%s3Yr zFlaM}Cempkq>1SU_Hgt`YYQ`mTT9FVz4e{?m}0bD!=Ni6`k>Ns=*%!LmF<`jq9WS*fW|^#qFzF7%6VT!af0~SaN;mB*GQBYdeOAK@z_6Vu z;!u|LfB?&&@`F7i_sJcC_Hgvg1 z_tg&%{WGL-%pmgJ6%7!Wn=oM5uTT42!pUMhn5SMsm0JdQuNB01p?_#j{!UQX@MR$AP!Az7JBCKf8 z?Skr9KjDB)o(${?Ft_C;BUbf*vT&%r>}9X|$4nAcDudAM{`;0-A&ZbhB_DYmmJ^x+ zjCX98c0OjgHEP__M8xRLrO-&k{g`PAY_)`cAw0+`8_{i0*&p-PaR8F#VGRIvFBis@ zhk0N})&fa2Ghj?FZ4dm@6ATP$saUix>LyOl@F30|qlc{1^A8ieEVlt8U)_MGID>3= z#`1<}VZZ1P|Nc$$=mtm|7i?S^BjOz-Gcf2Ku?5G+^q7%!qb|G;kwc*K)i>8c!dVTw zz-Txlgn&^RjXZ)^sh^*d<%|oBd2qE?m4KZAKlpj9>3t2h_ApN|GqUzgM{%`b@3zZF0W549J`pSl4EPNLveq^#-~As(WL#3IY)D3)-ye@ot6bM5{hEy;A{xx7ah^-VB8Y!rdI`op@8vBjCBx09kR8~p@}Y{PQKoV; zJ3$IwL0C}c0yKdYr?wHsx9ArK=6PAZlURoE8-@-xfwwBC9kcD+kcaagc~{~hJe9S~ zO(D-rU}W@n9?wJ0$fvmKCPj&gz&ewf6^G$yNN2sR%B$=22|HKZL>DQReql6Y8swS| zNl};r0Gbg#>~Ti;l1R$TTaIMWvx9LSUU-KN1qxat}OG z!Z7k?1?Ml+=muUxGc-p17(N}Rk%#o*2q~f}+wzk1eBW34wTYrmi8$wm`mBBaX&>`e z3l9@6g{N^x-hYyJ`LReVWbzEj<<3II8i~UZH2+}aI6ecBuJyAslgjkKv~JrA;c~ej zM%h1d1km>!DhDwO7N}~Z+tdpcwMqUedgUVYk zA%pZxx6R!=^c}Tp&aq4Ztf&Q`k68qzm^o^T#DX5(PpgZvzwIf9j(F>HV|6|(qG<-I z%;M$zKumdW{_a~SN?l-qIuE{WMR8=xFQ@-@LR|ns?tc=uc=LYUTlegp5NAFi`%Hc8 z+6LSyNNs|&)1N#cgYLF=SMgwk9Mqh%lkg6zl?o9Q;IXcc18H0UYAYU(yHXt{e8}w+ zJ(cf+OK>!&TP3>!wDFv7{auTO*vk#TyP5pr#M_bc>fX350eR!b8X4L7_&4#3HgdJ0 zxZK|A*0i&Hu!L9b>)%SbF6ujrA!qa55iyl)po;~6zR|`)XqY)(26P^KD07!gz1dcC zL<(#rW%D?+)%nF_IJ?B2Q2Gm_XnwjSL{RUDz3up8$mLEbb&APPXbGv2T{}tOv$e%f z66!_Smz8bfo)(uj?Xl&>Z&>YH=yv3_JBXAZv0+;*uvEWF z=#<{#YYqHy=JDv7BK}@x?k=AWI{BpR<_JRC%A?EfS>`59U#&Y;n4h~;#9Mkj+p6U@ z_UaS<2-J8@G;<$U=dS&;DCx9H7uTk*i}j4hb9;7wJxIz7Mx@@+wpIJ>p3bO}l#A}| zh5a#h{>A;SvZ^esRjaSg%ecqqk7FvNGcV_=sCTIhSNlr7pTGk{#++Dj@$VD~Q<|fw z87uc^;_+2q@ZlJzaIBv1NmVc!968aK{ZQhH^2Xun2<$WoOUftFllWX|n+(Yi+^2=bp%q{%*4tKFKF+YOIh9a5!$co7tzy%;oSv)-zs+BwWZvR%3s9d zgwY-+9Uo|Dlx7uAgE=7)q;!%=fg=P`A`L4%5+iV;G9C#r3$hf9i3GZBgbqownS;?V z>wzUx5^vb4)QricZ_*lWqBlFKLzDaa4qDsW+1#Qq=2A_hX3nj+1!*p>x7j#FC`6Jo zW9NOoXoA*+M~&D`)6}vo?(zuT&7?kqR?u}4)m&A2Z_UTP)WcIP1Q*$GYQ{yR^hh(4 zykd%;ii##KJSd1|e(|K(#(qRM$`hI%s3}?$>86ef;j96Ch3ABU_4xIJ9X@TPa&QS( z2hLQ`$bxl_#C|;JPU`NS-XualpqCC~sc*{T3rW`o#q7QSCH<2(OrQibD0MTQ798GF z)?yuhcVE%S$J15exc5)L=H(BNwgKh>{pkz@?(A8`j=6zZhsm*@Jp5KKr;V^VhC%WLYP7N6z#-1LBv?4i1|ADH_}P(!+rWL0WP&}3 z_xw8&lQL71PoEt$$7ZL%r3^k>Ih%~YI9@zpG}VZ1ca&u}(4SBbP~KAHz}}@aWip{> z6$ID@i5%XREy=Vgew-jg=(se=CxN$?@=;*c1Qpd9QGn;2HZc5G|tqR@Ogh4hp)PpvTdue? zHk6ZL@9RFV;joLceE|SrEb3e{UEQ1eP`5_Hef%1insY-9v|RCmSKp0gJJ1y|(7;D} z@-fYq6Nw>3Ic4KK)^HW{H^Sf&6%0(CHSK1%7mZyJWCLw6&mC=()dWLCrcz$ixdg8p z(JX*z*n5_Aou~x$Q{1k8nUejaJgCLgq0wu@vfv6^tf|1%GZ|Ms!PHM9$bi_@R#kizUJJ7QCdeW)P%{Pk8^rJTA^ix#)Uz69{7oQON}_QE3t}k%KWf z!Gbl}%eQei3!bk}H=#T^Y-(nZx0HAltQ&l0Fu_pu^PVi|HYAuC#E}?eoM#wvQsXuuC zq!~f3>P!(F5bsG2nqlH>S}#7Raf=M?uMCz zhYNLg)?|weOPXw4h#V!!F&;D$TPX>Rsv zm3U*vAW|`WVWXhNNM| zesThne%ESGB||`?y8Oi&auHbWG|pwP%m?4uRF{1bO~lmVv9kt;`Bv!91C+^K(Lhrw zI9u8iSc2xSTtKaJstdl>Cc(suaUIsY(nDut%uV^t%BgMaGblW*2YO3}Id;w$Mz>r< zKnNvk7qxt7K-|`O{pw`JGFrZTL0sKBRdc1wUI?H+YW23blS9h;KRKymCaFe+HO z1L!kKnz!k;+ChJqT+FuwxxysM+M!lGJa#BWBA@4}e+j#M8&hC0pK<^-8_yZEcU|$g zXGn{HIRZs{z64%-lgZ~gS({AUt!-l=&KfCOC=j3pBvYq0M5_LfrV~Gb!q5u9745cc z(6mS;tQzPW5EswgtHPu@=&QL9w!d3eF;leq6$~2WxvT$ zf;~h4imcDJ_c?{*QD28>0hj1x4!0?z=|c62k(a2jD{ao@x*VP~_B+cK?j&5?Qn(3w zwSi=F2vNQ$E>%^ycmkLq#~2ftZRE{`;D-4+vurA*mYj9=+%Mj%caUe8g{~dJ0y}N( zUN6c{$bcWuY2?UZnIW<4wkBk9Gk&hzcK>IKaqB&xT^eWa(d^C7}06wR2dj2uRWyP|71gJa&~c;gff-sc96M zIjyb78I%iO73qQeq55_rDcEAX14k9R_#=YUNUghTBRAH)y@_lb9yGcLzEAoM4}+f9 zOC}8TGorT*!kil-Hz;)(!ChG|&o3J&^S3Z1|Rn8&q|WvZbxp!2enkNeO{|2v&!*Hz%5 zD=03~vzey%k0&~RZ|Qgm_`EC~Ng4k-*BpRKnu&R&$nD(VRF8G0LOP1%L>kYkKpX2CCZ3JN z26J=GR8Q4#DanDXF|v3NG5UaQoLuoM0wZDW+$0%jq^0_3Qk()d^ak<(8F;H7CI`qe zU2~)A5>mj4FQfp(({uC$!$e(P`;dwwC2or)Yjl#nQXHqQ^(Zs3g~1N*&t|BQ`eXj7 z&;Y4jCsWmZyeJFU+~EpECc1Y5N+W)7k`PE;&(k z_4(U(+#H0h|5)8IGrvx}JaO%mMT=Tk?&03-$+A=<&8ed^cm+F&LO?HfkAp>9^&mTC z8%OO%&Hl{aG0|MMD>fGds#fLw=kzzEyd3_lyqNj$6f4{5SQje&%bxM2+-0%)D#`_5 zSU^~u$zKN)=Y$bWGb5YwE)fL(Hv^G&cgQX&#w97j^SZpT^M$SbCJ6Ok!z(iZ1A)Df z6%-E-y_ltqi>VX6*e@8tRK(QS-o%t%#?;Q-#e#s5h3)@b_l{`j{z3#%ey@8GI>RRf zM((qf*kL5vP_7hEPOUCUXM*?V8o0FONIP_+zFu{cl8C5OY|ufYz*1=xU-CW%oa0e^ zqa;H1@FP(|`Eh95<|jQLKT%^L#4u+hSoB3nVj+Yv<$ufUqMsjJeYP&F(ip~!lKN9f zGoGJZb*sln@h43wBX7%Mt4)({`H18|l4bpoo*I=?dcNOL7}*#)81Ry9RC}0GkZsod z7O-fj@w05d&4TD>PEL`q;t&dtgf;M$D>nI^mUe5sf4_TSTTZ zg{nrkfst6d6@;fF=JcqIPqFYCsyLFgE8%2>HAn<}VUFfyAn%ph13g*HAa7hM2x3c_ z>7bE93}VVcjuaxP6yK1N2qHG=kdolBWNl?eME&k8Qy3#nwvpOyo7hH$qgMz34TtK` zbm3c4?&hxQcrP-EZW|#?BM?dp0+G!6YV@WA!NJ5`BB^&%_Rf$zuTC_#oF9Myq-!D_c zwd-Vh9NQW@_zfzRePTzg;$6lyTN zPe>h$uuOuYL$O-;=q}}h)LVFMx~ikKR!1Fr?)6chOHY`ofw$jx<1N3GHIn7aS6Zf{!3b;Ekn!^zJyD)iCOd?**uLUprmCkpi zrOu-=D=y7U0nOEa)jrDM$)W|mOU0z7B*Ih|ZspC?vp>^qZP^3g5ABhFoC-&%u86Ch zZy+w>o|iyj%7E!@Z~R;xvqMHJ53yrXA_J!YC-9cz4=@N z6<7=JU@QGy8W9bL^V$FPDpr%I2!XAx=ae{F?%uR9XJG{~7ph!?S%7;lxrr*HuJch5 zBDoJ`K(OW;QC#f+!mH&Y%#Y;$lLdlD7)c3kYJeEaZyj$RIAUc=zZ7q&7T`&p}Q>`Pi0@ zR&B7lPSWyUIZ9@blG^){NJ?g{GVh$mh9M<(FB@JSw>&5>i49p;32NVF9a))6lh&D+ z;)=Nu)lJu6l(RwnYt6V^E+%hMU?w+x+{JFsoivbE?yqnoC{@M}_WNb03;-d6QBB?B z{|!oa=f%CX#C4(h0qxTt07%>FGA(UW4if-|B8A61Crke0W3egxw;4UBdiR9|Axh;D zpDGKm05Niqn!2>Nk!w$y{0C8=3tUzmUH_?&J`bdv|Jb=)(}6F3`{$A0_$t2hzperQ z8%UOuh2cLdKP?(t@f#ut{wH-2!@zJ=Z6CH>1SLSUpsK06aC%vMuSh#1gAKt~n~o9u zd6~H_vop3{l_IX?|Mcoky#1J)qWjQ{2KMA>kRX428n$VB`*e8xY0-n4V$6*kJ$n$& zgecO^TpT+*@kuH5{n|fG2~$lZi*~JbeBZA3PfTl4qVBzf+4*}ua_#&q+`7s}y>WYJ zyLkV6|D!R^6uTIztw?8z^b&u1vksi%xD{Ku>nB~oln!<4-e&ck@A24snH4#T)*zXp zI%3nagWfHbb=gu;4VJl{cn3>&Swd6YPM6)Xo%9WtW}DbB{3z5r=<2SzK3ndz+%VeW zA1Y^=sP@~yv1@JastpuQRR> zVi>g5Vh_)ZG^3)PX=ljOSxa<$v2_L&xjC~8$H!lJ{cY=G>YnK8HwQy5r{tN5Ntlb7 z#u9gCNkuloIFU3_?47dFhi_mP(J9}?J$0!`_l?XzNTyW=&P7Qh79m6b$pi%~cheG8 zT@>)ZtQ-LI=THd7V1Lpd;w~U{8 zqJC*^%Euf-l5z=HDA!P@(~}5$DzpD-J7q+a51U1$xOigqy(+TVpB1eUwQYKFY)T_xc7t(GDtA7Vm=4YIKU6_^;#pB`&0m0pt z#5?;-MfWm4r2O5bet=*OVkFIw91fDC|Ef62Au8!;jrQ1Fp^J^clVog*{R<-<^Elc7 z@_7|2>_A$CH$Xn$3lt#uE#Te0gf+jOV;qMtbq1nfSl{308If~{3>*kT7Re_jC%{?w zMI%CshC>vdjfoQWho#ttKs%OKUV$i_KcNp$OQ{}FR!oO03a0F+K-|BNJg9I}K_(um zjz~y6z0*~H69tb3RJS**;4Z;Im(`P>2VyjwU0^C4>89>3JvWdu|265s7G~up=Zw8^1vAL+fl?!DwE3LPdwyP?{POpF4|uNHIqB z1=Ed*?HrEu%6(G@P{=HNrp}-^V0Cj6>M9hy50Vv1C~)MFV217od6{ZIeiGEeJh{*V zNEkd2OV9-_P_|1jUwSgJt4nA$U|%E~_?e*{31%BbhdfEMY&<4^h6VU*9Ad)Vw2yRM zH~%Fs*1EQy7UWpA$C1^G3d3_XiufkWMhZlS%MPwI2Mprme$f{j&H%QQOxo=3yCbL!R()m8K-y)F=iJ;ikQJTrUi9y&@dy(H(OMHAAgE+g;osD^GBY=WZ* zb2KP7J&aRHLS3|hC80py@8kGrB>VOL=*3CzVYak<}twL|6v^F3^L3M>fcVcE6AVV2WQ~+e-?ksEp1aDW&unA|VX`KQ*h5 zGb29RdD+W(7zOZ>@ushqsb7(g1vG9$E~_QFs9>JArt9=6^GBi^@!uRk1&{4;FXfu{ zIoAeAMPST!Tv^1LkgU4~gkE@nS8xg(2DX9Ij2)CcMTmDk-hdOy$mJi>I~Cs~+Cb|7 z6t{KF_Y|G{@uYae;rJOX1!ZpAr#1zxR@oLo?XL0HkV?bL72`M`zt}Q6Z#27Bz|wXk z<_xZb!{DF~^O~?seCIneiX}G+)^?9@z)bhYdOK)}GVGtQa~7M~3j!SyO63DWu+{_! zjelZcauhVoYXP>#!fA@aVRn1xf(j0+h3Ap(XQJGM!AJm4fZ?eqNE+9X^2kQ zRsbHpOTcb{mnIHfl&;$TeFNds7fBVTWx;7U$%5BxHoJ5l#(=%?)Z|-;g#-nqtvw*5 z3m-7F%5M~r&6tRt(Cr?;fL4>Tii3)rj6!eCJx$=YdV=0hmt9V3gNyGNY@~?6MyzkA z>fTMQ-mruY2;m(e3Dr!C;qUcO1C2-OG43g}xJ^Nb~Z8m{zC6GCPK58ry}oM~D~0lz#doxcSQ; z`2t_zCCZwEciLThKIwb(NG{(%+MG+~C0y7l;=bLvvoej3VM_-W(0{dX8Zq;GP*lIU z&W$=c@ zMT--{6cLlleb!vt7hbpzb#rsJwbhCv$8dLNVugtzKjT)8QT$L_(~TeukO&dpGl|2~ zmzJ5+pN_-hO9R;NKo)%b+pc4E+x_9n01>h>8#_C{TpP+&SW_lfF^2u@i>t(g2zz8F znEFTTcilvVFv80d@o?^RcY*!`=W z;E~7n5MvaOoHa2;qa>}1vFCtPvxEv6YLZn}5&jN0{6Yy!QYwp_B7uVe+*q>rtZy!7 z%(f`W;H@x`=pKGtTKs&qr;DR7aZuuDmdHbRLzf^W9*&U zLkX0%+t{{k+qP}nnXzr#b~0nzwr$&Xa^}7}>wDJ4`U8E}T~%H6juAaf(w$A3{rKjx zf@T&q`lvZ^aMdciGjnswFP;rSk^w}1!e5!ZwjG6SWMgD+$V2j79&DYA^k-I&^>W)- zZyF<_6U~Mi&wP1;M&#>KCMao|&W@hGTaYm{`ro`)H&#^w)JK}re>5vMa0q2d#?#l^ z7|$8`od=Cxs&G%~1VUtgsyL=4#2^L&tzi*dAJvipiF68Qxv#fTxKkxWmn;;R9kG_d z)Y~9ChDI7s=GWp2kwJvwumQg0v&I#4Ly(nj6b_$2e?SHv7m?31azbd-kRE~n5kk?l z%VN0rl8=&D!Ae7-B(;{re|+6Q*{Z9lE(|}X0N?iYljzo28ps!@aZoe1ZPad!Wx)vb z%z_Og(23Nk{BKR`!<&d(jfm*Hgg<`1a(4NWgNcLLOFwZOJ<(?WBOO<_oiY>c>aQh~+GqfYmwN!5Xaok6J2F zvWrFDCKwt^jC!Z(O&M!C{Xcby6_>mgP9C}8My>qDX9IQieaj@*t+}Q!;wG)Tx`S@@ zgw?e~p}1M4EqrW+EsvmD{%6RYCgF;x9mX0g)t|f(0Rj{Yo#|P69{%-%K5z(VKFj+{ z{>IU3vmu8h2V)$_3Nn$_@Xao-)6kjLILxk)^5^0i*Utvp-v?;}lHOGqoTb;E^$`gg zv%$9sNo&Xb|F)+1=fAb zm21Yj#cV;%X5mhTgba1d@rGuAi(0$+4vWhn-L5eVoGstf7GB6BFw|{WH*?ZM|Fmi@ z2mLnrfwY0A%fh>KK+mpQD867zPdL4d*ePz{#uqphUdcrcF+mPI}Fp z&TBh2Sh^2g-{Bc83t-%y2+_c?Q=J|~T$qZH#KR7tEQTcSzr5vH{go2qpDFY>qs%P@ z?K1a;c?3vNs58X{M!yc~{;ga$b}{4Iijw{EPXzKCm#^G}zPeH@NV-_X02qaSLTY)B z5bYrODxQZfw{EDnK7W*0%XcSlgS+2p@DU1DFMT)rWd4H3Vr^2@o>1-!cxmc>tJw8| zDz49j`k5d%kfO7u0rI>3QPy{skl7cMo<6<(L8FR0!$FreP26@G%yg8z{LAQk^$loG zQ&3(GO5Xg0{4jR%GeUj2xh$s?FEhLr`YtI7UA7Nzg#CcYf8*fuVGO|OX)k&WwwE*?w>V*;8dr*~6w zQ^KH2{*tf-2HyBk-5u9oEi5hK-v|~Q9{t&(*4-~)s=8X8|MpF0`=980Obq{d2sf>% z9k9ctwYn-XfVLiqMo}`58YRG*W77YcrW}BxgR4zbmX%ObT1= zfYx6q0kFvA;$DN_>ty!gAZCW~laNt-hd+zfxxUKYh+caZZBSfC)R?s#eZ)KvfAD@~ z_D+|;nbX_*{u<2`S!{CG;^F!H^6|`L8cjOvdycl-{k=}xQ|{VnWw*lPq09#U`m|}4 zyTGG~bvWDmK zxU8NdFy9I~t3;$YlAh8;nJK%0=BB-Ujk`8YswCqK_M_L!(gQNgtx8zPTc)N?5FP&%k+<8Sp zqIPTa*!2ge0f;+n_(=`I{Gr~#8AWW$hs8Gw+7NkbY*?~-)3|$;?2}PaN*OMF;PzE) z*$58wWv(q}9)?hbAfnqXD{MO_LasTcydMH7Jtr|x7_nEcJt)dYh6{LC@ix-YZOw{e zv!zZG<2AeZ2S5Pw@XAxYg)Wv-8R%HYh0tMGktVGKQQZbM-QaQnOh*otqsV1;f~+)4 zNuq+MLc3!L{1B{Lf1t=hX#r=ew4?Qw9cw_lb20O9pv~8KNnH;ARanuwk)S(%eN^#U zVgxbyyv>=LU!nM@4|aLm&qkAW!(yfpW*@*rwMkD9!^=Atw8^J_QL!FLA#f2fA9f#m zAdUkZ<1}2c?6S2(bLqH$3?4z&7~#6_hy1d7WE&IB^=cqFQWqCH>&w2m3Wg&?Jj%+A z;=-{v77J=@$mup3{)5mebD8~dy*@4t&ZP3H-;XQi%V?k}s{t=P++n8oW>ApX1xg4am~}2`DjP-URmSiU{WGZhP6NAgi=u_a7Jk z-QW$K_R>%3Au+&A0u}(sWOAgCIxzq93C2I%=vg#Y8!B3Qb zA)$qH9LV$%KxDTpzy@?SRw)j8h%w|KEnNCzy#pEV3y~P#pE;oY3(;J!Nnf4Z6`}jW z4cssLD5TQV!*b-YJ9h)W`@7w` ztmQ#RmRWPh`YJbH%bp>v;I=%|>4I`z{MlWZdi>Yu5Ae0bl0q9=9siSzIw=7pzaXu! z-i73JA3n=mIkdoh+2d|!ZmKX7X5=DGRp@2hA&!~J zfJavw{-^xZ)6RRXZ-!Zqe1#$=CbKsfjySA$3X>kvD0ns#i2zCxFu&8qIYB_~U>u`Q zczL5Rp@U+}rd9@7=hgZpa~Lyw0`6vt!57N5W^`aPFr&|7{;dus#twRH=@yueRztfc zW>VLqrRTljmU(lgPOYf z0T_?w92b9KO4UL#N^`lg4UHjm z20M<2B5l~;5j|ZleqjKl0pr|;!+uN-T=6>U_Ci@Rhr$9qIb;~trJdiTK1D+Uh;b%gl9HM5B3mp0jDaC(^p$|Y zh#`u-2hbYffPWrqHm}a|*66;@O#PIf(D+YSXu6~WEH?tQ$E-w6@tf$mx3Ps1+suX{SSP))H)&pAvm5ndiY| zl^O`hN+(29f>$J~3Qd?qD{1BzByUM8@x0APOz}~SMU3SMW-JGt>{^h!mBb*bB5E@X zhd6M|^W}e?thCAce9Q8YPdeV-L55={zdiO@d;B>XrY^fxSq@xz_voT=z3-Vj-s<2B z7xBiF?vQ^Jk379-d)4h)i<_ za<3EdAhM6|5H=tfLnbPRxPOMjpd!4Gdt_dCk}CHkBgP~_7qpV&d##X^`?Hg_znARC zw5!Ts+F}QG;st<&z0?4C3}a6{VSCa3>mzP&bufwFdcUaNZQlWfa-fSkP8>rKbRd{{ zh zlA=lCM#jJ;2b6w9HiHtFf^X=IMw?7@z2U0a$W-PxpSZI&7QRQ4l zo?-u=1is0k4mVMZ&4Dr~MXP0crcr5y2G^tI$)A7ON+=b0DIy?FgbEEdA4tdCNLu=gi7^ z%Nj9r3l}CaL1mo{bO4S{z{u;zV+n}f8QaRy1VJQ0#Df;}pk;!Z)Dmj1Xo7Xx!7)fY zDNZ9PSO5`#{cr<===cv=)$|F}pU%^waKO?s)5MZn-7f|ajn8^wh;&WKO|{b?whY9D zUQ6JdlCT6vSO38$4797o!*)3r*e3T3?}~dK=ou@KRsKm&h|&p79hSgQ*FNL0caP>k zOw%EH=t&C)u13g@?W3|A$qpcttVQDiR~c+b#Jy_C>C>5d!-SUz;8Z8=QaKcb2!`I6 zz<>sTwM^(m^S&u&=rejVBaO5xJ(GqvyEGtTp9)84|=K{dzggF<0NvWJ#_* z0IhIWj%PDuRah{k=55$Fx1pgm{e=UYO=crymBn+|dq$?87MvZi>X)W*ZeUGQ?u`j; z{n9=M4u+dT+}xelqrETLhogD1@bYm%_xp?L;wvBXS?bdxSBwQ~J4{f2AqMZvS2M

    5Y?grYGy?MDT}_qVcWb}&Zo9QFzfS*QeAhpD>da>R zvDUoicC9Q(s2jz3@hTgyTF=1kR|`3}e2>`#-=T%yY}ZF1F=_pzw3+RkxM=ZBO}9NQmpU>;8lz-lSR6QF$;X~oMj^>xFD z3^<#82(;a#{G8vHHUk#r$;du=K3K}5NQn^iizQ>hLgxPQ9>v$U}F&7KP<+%Vo^2fU*P z*z9&#G*j3xPXvhwZ~FY<$NZ}r^cSW_;OZvM>dGCdsRz31kdXxq`usIWdHsq;byagJ z6TqnTreWZ<8wT|>JNmX)Z_;Spm&-B`$7m&!B&q*~N|2YC1d~jaS>Nnw_`j|%#Nt1c zZtL-;kR`-tLX0It2o0lfGwLHzSnzH5$(uq2Yd+XzQ6h-C>X5Hk8jA->XvB)a6jI7w zA&ugBI<4^?IN;Dt6wchdYSs&2-LC;KW#C>x^K8U>Mtx;6Mf4pedLM&qcJr;rSuUDv z>KdCrZ1`@KN|#kqZf71Zz{N{YD4A{|Wtec@IHSJQn!9&~z^SXYKjZbE(}Le;7itRy zBau7c&5)Au?BlI)N{9~pt*L>JeY ziMI;%dbnDssOQ?ON@|&D2@+oDmxseOQ02V%vsI>@CGO#1t}bw7+Xyi~n~LFAF1%_Z zVs9T0VzgN1cJr_aCMW|2SfN(+MG4=|3W>+2-vy6%*3^#S*8XN<$;tPFbXIZLzwh?L zxP8OcePTP;1!aNd!Nc)Wlfd;V;7GSE2_p=e*Lwa*!)0>!Ty-f7zD*Tnd{)WYQfakT z1Lt~z;~Kr`x*X~A`*_*tR$KJG9u?)(`T4#H-O27V!qF_;51JA^ukT$<;Vd;6bj+ob zD%&$`6{%G-xJ74*LgUcWw7x%*yMHZDe#zs!TdH%cP!G_p%(KiZPrs|facN9Zq%h>k z>5KcPVFVk_^`=#^J@Vp{7YC|YxQH3Na0G_iv8S^q|LT?Bf56$RQ>MGsU93e|f~yRy zDqae&+`){(TCB78_q(VW9_5JzH`>Vdmg|m^9*w%wVv6u{khV;xgaiMv{j^5~3r=sgTzZI)drl}(!csH)_@2r7l##Lor?X+v z7K;nzKS^n(3GI`a^uW|&hC zJ5J^KN~aK}zn}N47WI4w9NmK4j8g^ZJ=i~%N(*9L^Oq z-nHO=q@tYSzERlo!SDFK(#uLd4gR+ojQxLP4YK{mF0NZsI__Uk=pRTQCR>;zVBM@& z@)&_40+w71P7rOp{}R}()I1C!4CkKEGN`YYcUgDaJ36zG2?<2YV%&_s$J6KET<+Cd z)Cu!5pJR5HbPbobjgRNL>pkkqLM*B_w>@Yn{)l^AjPQQ5|7QF!>g0hd(<;w-3OT)d zrA#RD;Ip209WR0R!YMydw(<0thxgNftb#PmierR+snaoU*Hh#=3lm#MUTmmF1(m40 zf3lFxAhgbx5=n|*xu2c8AMae}RfZ}+5w|wZ`({HRbF?!Bd<6~$yq=&#W6gSA|kO* zjx(*daHNoy^Q{Y~x;gZc94&!a$7g3t^&PxB(n1kF_ikM`09V%1ImBj|&7k|G&auaM zIvmSDmnu~pD50Ru71LY6RmQj&_lzJ~Au;o2EinwcfZaR8H1O!1#w6HAvo+Pa{pij( zox5mqR{a}UY!iDn_Pd6T!1HYJ!ER?n4rYheI4PDnt7;CQ01J`LPBONnNsdA zn6i?nNok9r>V;>P+y-wFWrW~Bnp#B63GA)Jy3y#}p94Ht^c{!tP5 zwMb5u%)ez6iRF8g%g0*kVO9cz8k!Bo%|N{3A&T*%WO8eL(t-vP>h9)bk%cEHOan(d zYzoG8(1nrtqwujJg_<9`hx0D^*q~9I& zd?5I&pTZdNqUCaCSExby4stL_=svqI&1;~!WH#60S6Hx6-hq6RW8=K${Xsz&LGEV!eL=N<>74 zcHVrKSF$e_(6m+Vo$`P>WSACgw0}r+-eKdg9watGTf$V#@LWcGO5+f^k0iElb`9nu z*_wG1B0U0IG&WUwDJU+#T$y;P7w40tOwQ@k7vPVlQuswdB_TmTBL%R-oj0}V@5s`(D%{*5S6te<u#^#M}5niis>iIXz2B32>`#UaQs15SY{?z_VhukJJ1W2aYXD))ivU7ry z!J9KpnFI@`U&d4>h#Ku(>n!8N-~jfsvz}W8zVc87en`^2{}-RIXKO@>Ef^tvMEXK< ziZ{drOf_83;cQ}Pin}en>FIgveTlyQOWGEdX0H7Fg}aJ!JK*?R6* zM!j7QPV57)!qnU56xN}<^RDiyr;kd|xEx(3UMM^zF=&(#QemW^Hb2WBJ#I7>PhVho z8Blz>tY17>-!apCR7L^fY%&nL%aPw{aB2>wdu3LTk{`9xX@7`>3_6M$Bw;u*7I}e@ zBhIyCyU_DuQ@ZPI1w>~W-}&#R?@%J27K4?=N8ne7|W)(U8@dXv=FqkH|YHk}fL^68nT7I!k09FwOYlXa0W{^W7mx;JhVOPCmm z#`j*A)@5Jf+d{f;-`Z@HePdy_8sMw!HNHu|O1ilSbi1pc4VJ$ymc&n53;x|QYTiqK zK_6rz*^UPsdN$E6bZh}ZV92%bHW$NO+tPeXlpt(;L_S44G>Xdese*?Do$lsdWSoUK zm}U5*(TN6ON@rFb2Vra+wZ9Eu-SzayHBi`(ER8S_;v6gp5BQ6UvYPHuYkJp0`Svb@ z3a`pYn1%3Alqj~{d-tvdJG1+|>wZi!u77%Sjq&FPSo}#}EV?-?2Qp z*zw~M-deX^4I8}eDrR2l=1F)gdxXnkq?zs#rc}-TE}_ zwy`72o&v%m%$`v3=g%MwiWhc(D`lWDTvl2YvXbH;yR6d418V%fsoO(M|N*N%*Uk(l5uW71g50vORKKu<^7Mh+O!ze zwzZpN-OA*3~ZfoTp&%0&r?^6?T^R0vC+;d zGy-!lVY)|v)4WZ)n{)Ab_FpO<+Vyk&Zv?iF_uHLAty{=4R~Ra;kaJ`Lz{lRm%Bj4s z>%kkl-Vb=YAydcy+9CZ<@Igj4#{UNqqiMJG?{~sKFI{$+ML;+jy&}`bzjGyW$}ND1 zR-f?`!JT8ztM|)G^(cR(i?ZVp7`?8a zVHn@Pk%d&x>F?^AjqHv5YEk|}KOYKXj)K9pTIFSF&fYHmnBEX4pfrMvX4ksZets6N zQU1tahdkEFcuv1T-V8yXEc|231KwK`N-O1wSpumQGbW8%>3J_b{!AjoQ0R)m?Wlef zPU|e&pu3oy_DM8$%QN039(-fgq@p0Cl18A0)Rr6rI+0D_gW@w5x=h!d>p6Lh)hXys z_WC?6XH~CLNoAK!Y=yJQS2(Q?ZkCPEDxOJ`2I+WYp z;xI&K3RFfAVF@YW**4^m2SoLHHw5(wo5Gd^iqS#c4~D+go}SVB8&Y{7Yf#uU8I(4n zsSin3>rZ#-3VdZYs@L2DXkj}4E?e`bh5BVz2vJijwD?jhMpid3F~XY2%~oOGBjQYI zzO*WYZMzlCJm634FMzMv#z@U}m%^O7$%gp5hdK~~5$KY#gd-uqQ4m5UOa@%;C4sSz zN(l0xPV~($;x8gjuBJkusiErT=bga29Gn)RSL1@^m7YbIXH&kmX zZ0~QSqE!d!Vf=%zn`-q*7D4^L zr2F8x+0sNoTp^ujJi}SQIK$khgP}778jfF|3U!+lh1rou2UzfmLDOWX)u*`M#dBPj z;reI6iD6Mj&j(JiUheWUBYQcocBTwQhR}x}|J~uCjeY?g#Vm^-1kV_P9EG4l4M|28 zoSw2y+A81s>6{c5@|oOxtubPRHE>%4#569K4~^Zm$fy0FvzQ zyQv>M^GNbkW0Offd%4+iU$Uki(_aC}zV=herps(3k+EgU>7vgU6D0s?VHy3)>$1Rv z^FDHS&**^hDEvgx$LR zrdCnl)0EY@Q)5k8*&(62E0obcj&CP_RUpaD;s74Q@K5)>eB=IoQDF_>T$uS>S)_)# zgHnPOa>=Y1;9Q0a`mmn16t2ZO#b%%BgLa;YJ&WH!yvmptReq~uB`^bAhj$olaTJ|o z+oB3DNPKJRv9OHD=#_T1T5T9s@!4Yd5?{xWhc&OBPXETxe~qhO`GvFgg<){mk~zit zO>X#0m6Id*>t_rHVlSrE8pYzslHcf=#DFr|_%q8QqoDE`dcL+ARw*#BnO9eI5pGLR zdhKqQOPnR+rr~%fcOFpER!`wOfV+ue=Q{7+CBWU2VG z=zJHwmUVr~Ph-ONFMjv?iM)Ur{lkB)N&g$RjGgKKnc8>%&k*2yt8Z8gpAsNJ{)03Q z;4@Z&-n80@CW`JOc_Y};ZmmmeNj#p#I`>s&K_apNnx6j>+Z)ZDS@BgJ<$Ioj`hnar4q@cbvo zaVCjB^&2nD-LX}ThLRn8vDUBs(_uJb42sMU@vB~CA=dXbA%6-dwGVZ{L2bgN6r$B> z*A0GjgT-1bu>gEMk=(R#5Io__xY{sbaQ^9b$0NX~!m&px0wiKe%8I==vzcJr_0GwB zvxsW)`0rlt1Q}Tznx-BC|0${i(E3l8`$pSNIm1o^icim7 z*ZLUb0cN5zKTmsmArfkmSMlSe-p#{I5ptJx7B&QnT$LE?&yLy_cNni%u4t$31BOMa zn(Tu+(dD?o=R*gEP6n(;p-X_GNY!t51_T1(h){XA6U0}uOk9}Z7jcSNsBqKQ%hom; zS+>#s>NR}!@=a!CB4nJ`sXo`CnV)4Fa5o^~OTN}pY^hFbFAQ0J=Qk*Ae9u#0_cN-+ zseUlb?g&{Iq&?IkZL*WedY(5;$CFo&Q29SQk6ft99|IU!c17%2PjEIOclo@bR3dwXu2DKL8+&bUblQ@`_n2)u8M8T2o^R= zUdo0?C^Q~G+5*||w&=}Z>KPGxkzl+Nfu0IF9{++LU$nj31Wz%gY53L@Bx(NxqGGWm(Ti=yQU{XY^$gIIhse z`E!R-Y*|i9B)lAie3E+r3=n=5w8eDX4^3zTO3LiZ9BM0VtrvV1kwU)1`hZ-r`u*+Y z&vMX0Dtv!Nc+|i5nytM582DrE%`Fn_sP>^}oJUVy*N1TC5vopVx&K8I zn1Es=gY;LcX=ATJnrUNfGs0XYlJYf*l1PQD7JiUUQ5)Z#rf6@2z(8%VO-?8B!z0HD zFeD87Get)hEiWBHB_}8%v7P5z0no>L-4DVIiRuR67oq}!7XmZow4dPO12Cb1OJf>5 zA9uI*`>@i@6L@Ysfd~i<0;9P_^%+{Nw|TCTdWw(o5KLq%v-sB$;FBhBkAia?)$lk>G!r~h#LmCZQ==NG}tg|E18 z&3bjecP;b=_>W$Dg@78z2KSET=-G=v+~=qno-kT7jNn({`qMO@^zW7sr9I4tbML~$ z(i~?^Eqq}$1_Q#MnJB<Vp(ms}CDURKoxB*8@SQ0UqUjakj^% z=0<*x7fyU+2X=4=wz(VIyJS3X`rJjNUzhpE4|o=$n1N!!NpXrGWEX~#B}vBbUwCwc z?9U`r=Gy{#rQOhBAV*z)tpddwmQuU{$P$L%gF8j*2tRxEr?(IQV~&fH9~^;|o?a&- z{#EvlFwY7t6bkQEMy7*9~6@J&9stwQ_ID32p4i?&A1X$MW(nQz`G>Irkn*PdgvZ04{V=$wr@od% zzula)=4L@p`>kgmg;6nR;UU|FECwu-!3MNjWCJ1KRZxNeqjWC`8ldZRt=jcqKV?s4 zo%8ye8lvwtQjm0wfdF7XAF$0KP#bj?_^(B!Cd8MvR+u~4DUtaV?uc|Y5%RETX8_U4 zy@yRCdi{GpTkjTUnT$nQ!JM?Dm~iz}538B5e&fhAUcwhsL7yrk)I@*2G`jLY?5^5h zi3EB|A&glT!`4!6+%f3jCRhZBi=FDG>W+Fq@j5{E*PUy`$Zo5@GWfR>TE=o(4g5T5 z7<{KMZ(W_k0f7^m$}8;cZ|ye^vK2wJ$an8SJ`2f!fq_}xPg+O3N)3DBtJLK7N%bSA?mEH*WfrlMPzqLqcJWP@U~T% zWrxGwCr|oPxjgNpD1sI4GewVvi0HX@8*5%gO#p}vnNHW-?Wi}Zg%!q=ZsiH3&K|0V znfy5PHMdk!(9~5-bG>!7Ii{l$0^8C?{(WlY=tgjY zU}Fj{#Q($qW0O;k#2boYeS{jT$&jSj!v3D6WA0{&yHWAymbl95)ut$SE8#$jzw^Y-#kI{ z{T1W;OZd1~L&}yE)9lB%gWNx8Y`(xO+#-AoHm=VQG4=1ssvpEtv@I#8+I*LR$mKe6 zwvXhSJbNf`Q!VgqMO7ijRufFDa@ikSkGNL~cyQI$Z=336|6(TPbTV{Q`gsz_oo$o7Maygi5(9s#xYKh@M8C=>fi+>0wE| z)T$E=uji5hd2cUEWLt!a)b$wpTJ{wdZo21?_c(%tQa5Wyc;l?27)ny$es|Hl%O8>mlUIaSmTMlNYG5)>d>@5SgXuo8#u9no794N(ZfFD(@jf{fr;+T5Gf z0k_mE`natjFrL_FbgmJQX#%)Gdl~gpJ;!zAZ42o zg(;np>%oygG~DK09n##^a6C2G5Qn3**auurK|aO0zgyQ9HMQ`CX(J_pI*IO26+HLX%cG=_iC~c288ZcYG-OtmFPApE?4RKLI{N=URK^QCS=Nbk51w92Y3Y&Bk&dlR(_Cu4rI+8GWX(+f|9?OrTZL0Q;6Ua%+6m=TSZPF^4^!yZ> zq~#NG$_b|L=8r`CeoI9N_syK1?)M+g>0pFnJhrxX=SN`nTie~u{%g|rjTmm8Z-d3? zwBige=Hf1bq}NQ^Kg^o*iITTnmu}jP>C4KeIgDati)}@&XD^NYMdoe>r`KTkt9+ro zhb9eeEzQiHQr|Jqo-VYrm&bMVZ4wr_%=ms^+bhP{GW7X~kxXl*;)|X*ouBbLwtYZC zY^){~lGcBeyDIO$0MJ_W7XmRXuJb9!MnEKr3sD6U0HI~x8Qfmt%@Qq{n$2_~6;3lG zWlItRa65e&%8iOMMl4XHE4&RKU^&o0F*^$w>BRPpa9~0&#dxr2YQP)wItLT7NXtAU zONJs7p%9QqFgtrTSHdj#NNJPdTrWA>aIfNr&l0nlW&)enM{$@$MO}c1r;~}`M+){U z+Yp9;sEz1R%A_v*ed2|;v6t-gVO(J=JdFSP#Yvu_kEWN(sH_ogmN!58V3SrBGnuFL zIWOjEP*R0ir77Xy3PD16WifN6!}4*th!k4H&r?q1`CgM4wkk?WSOCsxK``g#n7Cgpsw^25+6TRq1W=}73T;9WamT`&#r^lpP@%iDa;Rs z&UB+2?eM6&mBk?f1&+)URDfb zy|hKar7WL$Et;OD!D_&(DT5pd(TTtAtH{=4Q%feOEH79-~ zQ1i{SOh^-LX~PREHMR^&9&_#Xc+?^90AI5k%%<|S6k0>(l5G_0S^ST3on_y5ce{5a z7O#74i>F)?F}bxHdl$wW*Csyi#NXAA7w+_8&0iJ3+r=G>4$i%QQZ9_8;LjGS=gYVG zUA!~vq5`L*pi8TBSoPi})zkd}eP;E*_g~+x|B1H4%*g(qrcEtbr++H-?o;(M33W|~ zdr^QSWwvH*Nh|7%r4FjFX*>=jTW0D6D9QE1@8@$dU<69xRI;!onG6C*pct{&%T?Iw zpT>hqq@Vu-MfU30zEs}gsrCK}R=JPsoWEV{JCqcgq*STtFqK_h7=Ah#R&{RO2-2y!UKvSG$l#;&13KE`OTw_>`xsr1a5Cf2C?-_ZVdNynjyS z&_tQJTV}0xHnUWm;on#6#QRyJ-cX*x9~{DEGE( zn!SoS`L%09Yd>8C?X+dSl91{u)AY(de4d$=&nspevE=wudN{|h z#zC%l`gBmg)70r|WmsfU+#mMWck5yJY$<`im z_FLkWOv2cQU74joxtHIcL*I4(r+K&^v*y94S7VSC^FM7{zU$GN@_QiJfW^;Ee_cX__C@<8r*Vj^9i?L_B zg&+gO?TSrs-P%0E37YwzXEv}oBj1#=5UDsBJsE(F-hn|a)w=+qd^#*rp{mIc>KFQU#Nc$Ozb*bnLSvew;c4=<{Cf;ozTs zw^w=7jrf_k*B>nZfHaC7bxp!$`-n5#g$bIHMJiw};&8Pd5L*Qi=ZWN@1-E~l4Y}KQ zc$Kxs7h0QEXP9P+q1F19qApL^2?NU+Ke#^oPIWw4W8+oyOC5?x_39H+Rvz^^eVb(_ zID&3(Gz&qgp-2rOKN!LX(oEp)t4*n%%Jyns&gri7bn=1ALX2{al21xa2pwND1aV3* zSr2+xq+B^WI^n^NdELjqY7`r|Bp_Ti;UiA7C_vTeQ%+dZnr)9%QP9?YiL3G@k@Q*z zPu|hYW^3de^ZqQSJUSR=U9&0>Vr(}<#+7QcsW}Q)0~(M-tTW{G7u491GODc9I@B{P zpHc*X*Zu0y9@OEDdPm<38OmmT+rkAvkdCg97f_&=7ze}hgdmVA*4X0c)HOeesZgbp z|0>gGQI-{G+;cNOu>)+{C2JTo-%U=;5FmD?m~wb{pj@BFDh~llPz1OVBkmb)JT@4T zEIM_KCTiLt`-7Jde+wz`oz5elmQ#6|a}EpB{{^UrnpR%w=~3WsQC$qfwL}mH?VmBW zO72Ojn^fe}d1Y~BAYsr_W+oHAjYgtchWOO`VwT;;+im{H~ zm+tYJ!3hA(_GRW-gXw{{@wfpBZKK45&WN%}QHI2JD4T#OiSYzH7huK-C#+BG06`}# zta*`$6M=zLUi-6mP65qN_0^X1?u5eIfFn_#dO5x>9M#N>sc z4N(Z~zH#$iCAAlr#msdWr}o(cohfp1gU`r@84z*YQ(7XM52xkl7h<-hLW3M-CB3he z57mmPCS5RPl9BQ6@$OC{o3g97WjYIV)6ji4D77vvGwW1}jVKBNG_EcmYv5Uh4j;c| zz?wU=P5!(rX8;4z;Itz#uctEU0i3~QZvIiAF4dZVhjE6X*pvJ@<+3C8cZ(oAITn;`l}UStjDw19KtL{1rRd5ud!jRNTn{+)Co`5yro=YAw zfUV@Xwlo%&q1qJTw0s@5mlf?L?;S*-G&8}%VT{;r_D0`n(?f}J;0vQ&GY~|@-p5D` z^VFS1E8q4I=gdI@NMYG*g=(uUYO&5~Nrg3c2*fdi}1#=ssmoj&1VmAO?gW|40Tl5FtiQYHKK>MQMfiDP&4ui3hHM z@gh8dTwMrV*Dyt>dZA&uSWsO#SS&6?mOtPMfVYX-Ti5$WEOIJ&GF%wuoAa($F$!J0 z{PF2T;qZn((ow^QgKflKN@=3gYJ4GySdgq-u-KhKfb$5to)zQLe;LQs?)I}SY`SrDvyi-DXL+>9TL8V@pv2zx2?nhjEO9tXmOkVw&@ z3;>O3qQCziWA7B4X}Cq}#>X)vnsBYF(_0 z_v*X;s>YmijAyV}vL#_fQwS}(6^Jiz3F~t|fp%z(Q$pXSUlZvGn!1Ct+8D#-KSbE_ z9t;(FDDGerDEh*Gq2qi)V$wjJPF&W|&WmWWK*t+$I@y2I_hqZvzZiZe2TA-v0K>}x z4u(v^%}2QYcI9OiZZy?qB;_M=c?mpoEWW3=B|LMo1qROD-5FZzMOW6V4A-P;( zrdUBEA;k&!&z*L}3l6sPjEVTjS8wlT^RcJbvww2PlP>a(V+atZp}f2`jHDSSL=P(u zILjYXMw!(3bfIx?bRE+ZyM1x}mOv5J4k zBjztU6mTGm;jT1S=6K?jqRj~Q0fVIt@o&z9;p?B7^g<=e(^<-W%~0Z{#DaN-&Dbfn zP&oNJ7L-i7`EaDNbi!$GjwB(0rKHcf@{6RkxN1xfAgz~K*zZm~x=gFEUcB7x(>s`b z;o1Zq)5Cffxp0)^YE($(YN%Tw0^&ydB6WcjQw)hsX^i7q_819B%4PK9s7OhXc-zA5 zQ>RUATny~=&qBm0$rlXIXz@B4u$HvXZ-PTJtzAk3VW;b-Yd^K$^5NR{R{SUrbCt`O zaS%V)-r`j?9JFatkT zgd6vC10ztqY$sgGKYN{A-uL}+_|k{|>@J_r{9rV78S`njE9TO``P=R^i3F`hJ#NB^ ztASLr&p6{B9feIec&hqDe#3lk0$74}BWdnRWYGZs@4C0q>o53kNGh5CI<5RqTsSs% z?*9mPWNXPJ?zj9Ozv_updkV`f#cmd7EZ3o`bz%}V^*S_DC~iGj0^85aY1J=a$6pW$ z>DlQO4iyPBh(N#H^IDzEZBC#{AMth)*jJRC%f`o{(fuWK{Vrr<=wW8~C}J(AE?Z^A z)Zo=|Rnzd(a(J&p2u2kHB`~J&TIlOxpEFh2+^w}Rv)A_nc@wxz9OoPUO!qFymt*-* z`^kx|wv-iDvmVKo`BCAe%c+r~ru#Zv+P!`xePde{_a$#?&@y29h=t{uuWWK$V}75av!tSa@Dly8BAnr{B+g@TlSRM7^n zPN!M0!5a&O;#t+i%n%8I!Z!drh;+C)Q(~cI(4{X)x^*C8X$nnVtryH* zyZS{mo9a2-r!Z8{QI$kh<-2Arn8`>PZf5-?8WF*!xey@XL>&kXb-6x2FRo0Rw#{)R zo@k0i*2P1-<_&}PlLlg^p~j_Su`l4JBi+YmJ+<8*7hjpUuL{x7E-I=vulyJQixC&Pk(j+ zwv|FjLZ-xveS)0Gf8+K~4`NuzC>-Ig87Sylg1M`Jo=G2ywf1<@0liJWjp;8M*i7}|)?inbj05OR*T4xfPp)e(3+8Ru$ z0e^{1a<@W3Hx1~8|7Zi|eB*O0$J!Ys2{<E4SLACRYB?rF~I|BM`3+NSdhavfwg7+pX`@| zzCN};!xNy^B1}xOzF>D5#x8E*p;5QP2W9xFHPDWA>7gXQpzZ}|X)0=W5}9zA3qMZc zgWfTiD(P%;JNz77x7$F`yyjF=8h@uch&!z)Oto~2-p&=aRY^x;Y@`?tnfl=MCQ7z} zFi-wGi-|mk1m#8)u>Wq~Y$pNDOB4b)zGzuhB%1}2LDoYT2}++{j7pLP@ADMol*YTJ ztB?t@yDdMWCyXihVM-#$32?va9pt#W4el_4){-Vu)r+v06x^0#JA7G^yColE8bG_r z|0ylt-GdHlUWPZ$hr+{#34oB@YmjC67x~;K8YIktGFlq%%ft3XVp$Ag=wnc5`?T1{ z;dX9&sL%R%OW7Dr=Wq?^x!^qs1lY@%bE&l{kWQ(pu58K<-SD zJx*LuMbqJoqiUBdK7;VQ8{+a&0# z!Kja)D8|jsJBo}w7H~fXIVCyEDUmHs{xdv|?$g%sa;^3S?L5>_KWdl==zU29O* zXylZ!N1&o_>^#LgQz%|q#oOhS26c1=QGPu|VR?^34+6+xwZZ~Y*V}4@gf8#tf3>To8l$&8oTw{1y7qUWKZ=C0 z-gWZ>ebKMDI)&4zqHH=}G?si0&!$cb!rF|-jKH<|k;SL4L5;HNKBs-{@goRhufUKt zWB%bVUZunM{W>=+x8vrki6}urJ66fP@5Nlew-Wcu=nT zQ56XhZh)?JyUkF$`^8X_T>N@ZI2QhyGJ(WgJWJ?*13wP3k#IJM+*9k2kyzKT*?11@ ziY3rkdkWXxMj<7?a5FUnZRYC_R=(+3z)*w&SAUX!zRf8rpuibK5Ymi92S`ww8bt`r zY~%r7xjUhE%OU2L?I@8C%i->OgTNu5di#hL;3?Ag@02H1qqv3GdW6ZOpz-+PP#Zs6 z#;AR^zhAl@&*YobdG)ZI12bw5WMIf?nIs%(?yqVPS;8!iDNi3h&CsqTm}#u%;0L1Z}cSBZe|NT75b!B=Y} zsvxAp8CdA69J(_vc%N2n?P6-6B?noo_PipsH%d%9vr~u&Bzz@oJ#&4r8kaVHNh6tP z5&_!h5x-Eb=Ov(0G@htz=NQc)Tki(wRJtVc1I(xJzSDjmVvd4n8%}VHdgiJ}SP8bG zIhFQ^0bUv-svDQr5yvbRWZyqmn+^Z;8)>dNYVW{_Bl&aO9Bms7_Q!d*q#~&e!uhF; z2T2)JnJJ#fYkOlL9ZS?tFCb@?~L?;6m0ba>DF6M6RA3O4O8fBYenl`pyCbXrY zZFE%}pG-RjhEK#NIT1Kp9Bv-3)5~HxkT&0);tZrt$*e7oVu6^vblj|)MPtDmfAV}N zQ$WE(4=YhRW5@-UIkuTi%9`@PjNt-e#&Vz>79MKZR@#$?H|oSFXVOBFmC~;IF{E$;`V?IEY*r0gJi!p-@&@;>_}g^_+Rr%$ zhTkg8uv_vDQUll554+WV?{R3M(X0)%_0dZ!j9w%7$#1)7e6q}NaiH?TJ&#OHLY5&k z6tT&}{G2L1(&p!q-B-h;N zTGYp+MNqkuAZwdCt=gr;BX-NvfKRS05~Z~xXW zTsN*>r+zXQqwa87F^kt(Ta0%nEmRbri)^g2h=lYAAQ1F|ea1iu+`Fl(7S8AcY$9}9 zqu?S_Rs>eE{Q6aEX3Lf!@yR8{E~6-;qr{ZT?eqpQiZ4D~mu zghoo+ePBduog-Y$!*ZisO|SZ)hg?zOU+-dYLAw|4CWStUK|LULPG zWx?Od8hawa(vFbmn2r$Dr5YoUGv~Gv*P>-e`$DE0p9RQiDeR+;dlDRES5ym0gcN!l z+*|OltP&47-<4;+(lu+>bPsR2v)5746zou-o#eNCkFTya6Y4<{)qB?|Q8+BXZE`M_ z+L;B?1UsCuRgjJw8PI>(Zl9^+TG>_5?=$O(XNgUEKA6pVVo$((zobuYMts)*B=N3Z z_ymohjMpQ(f)_q3=)wlX-+;qv`|A(NR~b=HU&Mlz0^DUrV^Sy}DR~Qp+&iqJI(Rw0 zhVcB^*uL7hzDx~2d`aN?UsNEKX&ChE7&0Ol zeG*nn5+p&m2yK)U9x@@B#;&=Fa=t94gv^ZaVPT5&>AR(g4iWQoD_iT<$HbTVLsZ84 zqLK1xhnK>D*#6)x0{jcVHO+>40%aGAC76h8Sg#y+Mus3qY|bxe41S1D&T}zKw3Vp9 zKCeVWq8J)O1wJ31&haTofK1PXpOFp$_#L)ltJ+V=|H1-zAvlk&!r*iTr6^ROO3E}E z*LKr!h19zrl|_vdw8T;?mFq6X&xMcxYffyikb{t#ehtD|aQtV~7Z9!PE@9|X23Tli zmTaM}OxJgn%g}%Ye)-U02b?xocGBk_v(PlOC*|(&eOv>f`Ptt~d-g#Asg6(}h-6EY zGpOJOlM6fsA=-;pyA^ZKYX*oixOXe=8Mv?{7*CGrg97$I`HWW;&}LJBcE?jk8FR)#CKvO;~5|q0CpxeXHy0jui5P3!0jleFsWKFkRw!?rrjU~j}6t) z$%b3M$zB@Rt_f*d(kdi$0U=6$rnOmifhpnP{mlB}0_h(e z7Eu0cSy$#RZdv*Knq~YOh1L>4_$)tCA3r!I5s5_GJ35=+tdRzbJRj}f!Q#d2<*K1q zb9);iHe`o<)eI@h-GWDC>I6oajxMWnbh(sSLeeem#11+*!>o4u_xaU&U>Jr6ZDa9U=A;It%7BelH#b3(VybTlwB%?|+0)-BiM`Wi(@my5D zh5}=pr)o~hzC$_Y>*|L%(&~)8AvbRMejtcbV4r(|#^{tlfeFH+-nCq)-NG&Vq6?RfMq`hIcj`(Vp%%#jYw#nCtEazpnH5OGa_i zaIP3i`1bf;kSdB+49R50WkCSNxyf~wix#n1>+)l*@=p*DXWiVz2d59b8ElF`n5{Fq zI_6!m{y^|II9TKR| z6CaCA8g$X5-U#@qr3$39&cD0}d*I;lKNz+)Hm1GA6YDYg^Cf@|TXQ$F1tU%mSB$<& zUN0QpyuMhPP|GuZK&Q@^*T+YH*iW{X+tp|0Bd!^&TE{4RgKlq^&b-}+DF>BK&y8Ha zW)Knsh1ABwNj8EwoG>_HS_aF(=;08rqv~az?vG$v^gx3Rkb%m~^-2#1#8?l9-ki0l zam^xvQS!u2zs4KX!P(k_BFWv-kYR}HB(y)3t>#hxs&X5D8I7Cd8s#2WfAuDDE_XM# zSPr>R zXqePrmXl7>){L~Fm!e{h$V*la`Ea3FnWhXwi8 z>JcV3F~{_;#-nMNi6rCq*e>wnh^uf>=wG|_!2jQFeOj^cuid)y?X6n#HfeR?Zt-$6 z@|d0}UG4SE{awYlO7k1|z9}u$ADwW+IoS;juW_=U4c-if9ciy_HE0xVw+<+;g zacN~L}3^OY);Rq7U3rSXA<^7LE=2s-jEHJWnoTaK4*}LJkmsbcn56x z6x}-V6J$tYOfV|Vnt2ENZMg{`j_9FCF+sA)x_JHmD&Z&ZIAEB1m3=Z$q+Q$}#B*JJ z)IqB_xu$Mro2yjK(z4gUXQ7VK75ytWZi8d@lIp=!Hf z&eg~^G`?GI53>&nV?f9C%o$7PIJkHZdg$cw++EHSqWyj2(pddoLC{ImC1T@};W4w< zP`=Eqb^f6LSj}BkJ!jM9AaCD8TOQ5r25tmPg~F>TXIX6S$h`LDg{$ zV`A@cd&lzMgxy242B#?4WR$Jj>0yx@S7T`PfyHJ2(Kz{Kv`m=ExEW+vb;itOY8BLg zia>M@M-;gtKk(WHdqg-wv`2R4xpPqt3*~4Jl*VmWz*WIZ#1o~^8T#Un8p8;?vi|*s zREszBEL8{{{W>ARA-MdYR{z+FRbIC?XR4F}@`*9irYH%YIAA!iD}8ZNZrTnreMfs( z;bchqd)Eo4(ifvl1xhPq>%}_n@z3=5J*11`*c{Vt@Iyahj%|0s&J1l)S9_TL#A*QZ z>OrVrDQybwSSSG)?f|kwmzdt2>(TX}A_$V?GmB#m=4=f%fniQ6A2OKkKM7gj*p5rY z9!ko_>5Ki%1E&SklmUiv(~oo=SSm+w)Kh7g{esVe7~0BkL7@6#@d0r>&7X682{EvOdXg={0OP#z6|sb^Dbm7juc|V=+cs_`Z2AX zwCg!_NCI*RkyOW~H`YCg(|A9Z7LtNqccnZmTk^)CHMaJR<7Oc4er>QiX0@Gn`eM|$ z^fx7A(@(@SrIAm8X_l1C82^kdiPtE?i(+xh| z=9<01>Bn_1h~-E*4D?J00hSS2M%tL<9;TXB_|^!=Mexygeal>M*Ku^;&c9RMI?meB zVCQpFMCLl@qcs03**hVBhoBC7pAe&96%z6R%YeU#I)O2l0 zDOl9kqM8@GH62bMh~ZunDp*SIim3W?SIC#Qg(-%8@hQ$fjHfy=AFgykW(8#b*yvkt zAvZnEn`zX2zfz@U^MT*C1=D^_UbrL|Bt4lFd7<9-=+|E9b>)}e+3wW4@8C==O$gGk z?}Ipj`$UQLeI$A}P0O6EvF~GXGk+UgO<#$(Qs?#+&^Uu*=Gd#k(LI`~lpxZzyp~zb z#b#e$#xLlfyD?QldC0>K4no1;Mz6nZM*#_WQqi)W`y-A|qgcl@f-!!=a_@&XAx87!APe&yV#pw$`g4hDnAKKNN?n9LsW&N-MeEda3n7(O97t3SfW(o;pcuKSY*mZ% zMLDEr?vkJSow%}-uIMyQIZ)_5QLz0sJvCT^^ni$pt10y>^NLP^N1!aG^H%~18(3>@ z@Zh;8IMm8T(35-YG53mM-X(Yvs@2?XwhzvL{$D8S7N($vXPQaWea&&8yQ!5?^O<72 zx~jBx;A#b9XQ9K7XLhw&v#qdz<~=)@1W`ucH|OUdoAUDVU;1(Q@ivU^cXB@zWm_!S zIuMM1uJY!H+{i@KE#K$ZR%ql}pj?a=g{@WNcnA09oD%f!HlT1}_Df<6@cdB&$v72P zLZaSCbumy_8uYCBw?_}7R!kW%1U(1vN&opAX?!n5&P!Sseor6EWhc$Cj^O`XUtiq* zx*?Y1Wzhbws_uV6rUF>GdH!EyYP0tLJ%5$~3zX^c9DZjeHXc^n(mAc(QV4niccf+` zU?r@7T2sGY&u@af%nEB)S1JS4C`3SP*?X?OI`S7sF%4K>_A6!kgmmoUDuslqdVHDH zvx*_ig+|0?oxy83~NLw*IQ1*uet~;j&OBcmFMalw$DS^WlN>8 zDw9~{0a;5K)Q66JGw-1Ax0nwa#?83UU7!g(ooqfSaDYr;RATE?&*i^D#63D5H=C*7 zSlj%A)lw5C7o7y^I%&YCU6Xb!t-Dpm=M8A9Ls9MYBeGlw&v)g;&Xot{zLc`n3$tq~ zBBZ7A>v`?UqNt|qn<%?%==o4fbk4LlI_pPeuWoTqK$a+ zmVbSdu=7n{N0DEq`bBFr$lW??0Igl0jy(x;Vz@dsP^}(GJ%d-�SBkl_8aE}2a zh#Gn8wsaE+@41Sj>(c5H$==Ax+5w7Sd<~8(-q_6ORl6pf(%6h_h`2nrm1e`gnLC_! zs%*_GDK;ZaeYXLH#{IL!Fj1%s^>NWMnn;39rG&Pho;4pwdl}B!=uODgolivL>(<|^ z?f=MAJm+xnxT{S4av7LL)I^D`hbr4k$Dm|cg;x1*F2j^r>opzhhuOg)wgyUNXgizKM`uqFC?fyvsyy3rE zbN*M*_-?6n>go^)VPZU<_}1grw%0`2uY+>_f?hsn1#ib7cvRR=Y~_4UpSpu~C_Ik> z+&=`N^y;9w{gIZ2H9*2Ko>IMoHiPD+;AaT}-Yt}o-(Ygp)%Ne?rkK4Zo-&-csz%UI-W>aywj{L_?+!XxYFsHgm}8R z*HHq%k~2f?_yxh%K9jad(uPjztdJac;^Ls;7IT-_F(0iyItv-`9l^KTQ2XJ6IP~X! zkts+}VTU;;mj-~A)iEkeA9MSI8(dzLH;Pzmvqd~$6g(k<_Mz=QX6uNn{$#QRDHoei ztB+6=Ufc00YKqQdyf*_*f~~g&SmpPt-F6yT-$BY6X+y)p+uGh(|BHsZ`qP>7qJ~D!WDvm1|0px<>Es~tEi92pjqE>WR5b1 zn543xdu6H+%i|$)1xi%N$roiP6lEBYF4pPrE;ashPD%Q16YE z?4D_T?(tw}1^cdQyzr|fF~>MxoFMB#sshCU)8SoUZtsGR%nPu#*~bk^pWyxb2oj7m zQ7Tt(qI~7(Q2+gmTp3rXiYo=FKlXuv-M0@%0zOa`J4+FWby8lg|Jn6MtKMuJIY#R? z8KZ+Ec}K`5+C$N~aa`tzh>v|gr=>ksTZd$Fho8iC2bx_PrU%(OS$daj7bwDm5<};1Mzu zjKqF6W&rfV>33L17+2B=^T91K2W-Ob<`1)ohLxPpf=!V@_s2?GkT=zN?!bW$gK1kn z`gn9hRukN@-D1XSY)+RP%^9|s3gy@}7R%y6o__OIHRp^`cc;}a#4cC7lS8pz} zG1$s?9grZHenEN*k7bd>WhN7FyKsd2uXH?^wa6Btg2C5;V`1wrdCI^|Cqa*&uML)R zs2_rqb^Cnn4sHXd3Y-E!L<6MP6wBv+vDCT@X})orDzyeI>aObNfH%Lw)lM|0<-?Z# z3S0C zHfej(-H6bEG?$-wqOzFn1C3;uqGC{}rn+Av<*5gb&_I+I`g!H@F*OZzq3%FdQ+lLq zbdI^GIv|k6EM#)y0jW?Tnm1frV-Z7vBmhl0ysTQ_^tXPOBFcFz|uuzzYb*|`~ba>O^p zlEhCwlo7*O0D9hhZTN5nH?P^7smI#@Ss0ym!I8O|pWCQ8$SBbmKFwJ6^y5BKeR3lZQ3M<<;p>{L36nWSl0-q7CCrejMafT!Pr~$NN$mH_1y`q$j^=S2sr+Gc<+v4lZ$ayv1-(O-h{JyTnF2#=wRP9FLeK(B zp5Wul;_DsA=X*cA?0mv`ry5cM3D8odKZRjl**U`C5QU1(Q8=`uZ2AuTH70BPts{yh zcQQJfiV8;d$GDjuxPakO=i|jnccja1cyMJL^Q|{AMC+0ivru_Wk` z_Buab1y=KjAhO^jd$c>A{X38;!_Mcaczrr1qe4yl-9!jIb{}CVr^CMfI|>^V>Oxd& z(+w9q8apyAiZd$dxquCyUUxr^p8q*L`|sG0e6x|ib!%?|%K&u%E)+I^uekTcYQ74{ zL&zJBv8chnuxEktm)NB%W@*V2YDm|(9_~ftN_T;{Fb5=Hzu2=4t4*0hdpAj4+@y_k z{&j#^B7jGM=QYz3%ZCBlgU-;GboF}F5d@*=7L%U;WV|i{gkHm=n%moO=s5k=O**PM zr(Bg^ZLsv}&mP_ove#u@6vC3|hV`Cif5j|J%Bcn^gn!={;|xf;IcJJMYxvyaWlM0( zHkHX(&8wF1q9&^;o`QCE6&X_aM0mjUCMvpZXzMQ9zpdB=N zmvPk?v+?a#*w-N*F$`!@63zh8O!kF0zqi3}kdqJTuKzl`{7+zRHg2B(SV>?08(#iV zOa6H`%Z|j=wAi;Gx=Q7il#-k-!ry(a51}{#+G_$uC%=EPft3)W%bg=SD~hKM%BJ^yDTR6NX%uc*LBE2 z{jYxc5Je&Pm_*J;z4@z+Gm&y%8@^lr=a%$qW40Li7$i22lQc1C=XBQbYPU3l+aAUz zFCE*B+MZvhrhQ834=!5i?#-_wNPfQEFLnuVW(~vpq9}=Iv{>}xDkTTTttd&wS>^eq z+Ca?@43W}0$NIq#RwR-w`D_jQbKUyAA8YwHP{|8OzM9hM2aBNUl$Pe7G-a`wnryS2 z3>FR=d;J*og%qcTBh8_>VBkh07>0yJWknZRO;?WVkL^CnM{19&0yTF}J(im&H-3cL zq5gmRkuyauyB}u(HzrgvxQD6z4wNvUnPyupA(xX$WWL4AcZR7@*|cNl-fGQL2ZWbe_E<$M&d0J_j7v#3`Up+(pBXI;3G;%2W(B` z(P_~^@BbCHZlKVe8KY;)l_iz2XyHnL3?Ust13z}26zan+oi_f&D^jfhyM@alQF6lN0%aQu>>YiHu2{FL zDaHS7gC>~q)5iXj;;!{gy8#P$M+p2#4Too^1M&^hS){=GPXG1n zI{`L!BloS%i?!mS7!pq)-4El@p9#6Kslfu*e|6Cn@4OV*keo6z9Ka^nFIc2f(-LgY zSOncjDjEl`ODLh4f@C(EPN}LNsI|6ERXh1SAQwco#v~=0PY4io)I)p_-qy zOy#e&VItwf`yWK?k5alGR9`pX#znVagzL(jB*ATQs4cE|2q3LEIe>`HY5IZ%n3EN! zr(;lkcwkYz>iXWLLbY=V`e>K)Ym~L|o>o&^n_(9R^)0wM0^8R$ATf-6W7ldpLnTB( z6{`z_Xh335170N&JXukNIm6!$r8omh$@-JKY`1Snn*pWy#Z=sn zybN65Og>*Rjf_)f8M$1FLqku17>Fj;OjRRjrZscL<4tETS29N9-R2O0LUMHR7k?7> z`E{avT-Dc~8Qhid2ci$s5Lo6-eOP1XUSk&3h2WxKaPjoz)HReZEmG|FuZb9z1;!K6 z8PFFXRy}AWL!;YronGn2y@GIBOIVtWFdPezZyGt6on&H4w4w`%w7{rageR^6BwHJe zT;w~t7Q3sNA&>76oip%Y^xNf{pk8#W9rX-X8T+p`1;n6i*(C*TFCo`+QyKChg>z~u zgl)PQo0ZYvni|Omlvp>hu}3F}%~U1-k^(S%)`^@LnyF4;C8RTw8RfU1>q?&C0r_Wp zuUTjkc!;1J=%^i&zI)(^6OCizlx9ZD7zu%aeI}4#;xk%IPciTiv)Gl*Y36mFOufd* zoUF~YLpQQ=Qan!Y-;tOq>3DC5KX1{|;!#`ONdzZlVKYCBDe`Qi+_sx?dnu52sQC@! zZw-_|slF7zb7ljgOM%=#z>GF9ds$NF9MEJl*-+UK)o7J{7APxLjpl||WW;l;^D!YT z!h!bTgCH^Q`a|VMuuJDmr;bjdnu`XCISa53bHbcd>A3nZZ}9oa zhNc9tije$I&d42t4nDbN>4+@Wlj@sV(3F8^^Z(G~F)dDY=bJNyFjI!3)fh?O%k~Vo z>%MT*jCo0jx4TDeE172ONdr(zE|ru=;#>lYj8$l5oyICmy9-BUoQjC0ocrGDc86&D z=+&fzfOOqWjwwt|31_#=R*jx#&hKM2pq8g%MVQ?`vj~iiy;0fUv4m)Rm{Tzt7`aQsJ;d8K?KYh=Ok|sgMkXDw zq&+fp)HNyFHT|jl5g;?7 zp6Nn7-0-#vrNjpYnWIM~ljT{Vs63v5*3x)M$e8N*2$+E$)i|m^sYPn)1WqXyjVo4~ zXU<_gdjT)Dq*Pr2b}KVC|9b%tNx4yy*iOU7G%%l z*T&J&L8Zfv_Rk|j7{G~C5tZBrtW#xZz}jdjDDY-B?Vpr>sBZ)}*jTY9kH6O6Lhd(s^>u9HM5Pd=% zE#Ws(gC>_@p-5_&D;y%&sWpUY{5QE>53r&U;4dbwIi~xkbhCjYXtkFE8H5e)dP)L2 zO%l)7YyJ!MLJM^yJ_>t(MBZa0w~o$xEI&CCYF|ckox7?xA@6#e4PtN&!qadAXu2*s z>XeC-p-GtPmuI+Z5hZdzvpdLf4;^(+dLHWhk2z5fsN6W?z)_$}(7Qpz8)%v6xga6& z@TpwfIM>E~Y1;&w^f#%>dTE!vuB%sHXM!)d$XcKkl0G~X>x@h%6a>G5h7#U81*GuU zyi~S`H=5g|%U-cZQ~r=-pJz3qZ$%;Hisn?7<%{FV%Wsr|(U{rPGRAq_fO&~_*N^7W ztWmG!o$2@+9kUSk^aixvIIic)em{hNgD@cnPy82M&d&0`bpWsf{sXX5t)=yU2oQcV zwTiF5YT#JgM0gce$9Y#(FV#8st97Tr8UK=BC>Es@T{s=ilm_8h9fc2i;{-V%a%Qi_308bN2yFjCsRuULBGBI3$JE@WScin{`exxTV{Jne12JMO!E3C7qy z8>38C#KT53velBCXw6yxFR*VDtZmm_6P|yTOLhLXj-rhM>ybHl$ac7Wa_(z@?1mAY z%HLUAc?*(xm3fom+_~S+W&Y&`EVEADN^b z)=1&WORej;V;Z4qxvmiY+2iHxkqSReWpHn>Rx_nyoRoz_j$J`XIE|t%ZsmV26*<{* zepCm0@$x(S+2h6aNp2WjE#&7d=OyKe>Zp{%MSuvx(4YiYw#f%h(OtsjP(R?W#|G9L z($%(yz*+(}2GG^XBu=N(ouWH#Y|^`TZnZ?rZ|hYR>qE|>^DK%_Z=dsJ4JGvnurnS| z+Q;wLc=cX0%E+QT!RjeuSsv6wO+%uf*at~QBrf4Xk=sB9O;6-YlNw~UoC-Okh=+1v z)4a~r3?Ro`RjB@qe1~st*1$*95OqBFvPItUC$j1ELm-Qok76i<(THnVJ!t8!^;v%$ zk7AZCFlC1@OrL@7w8wEW%WmsLSxW}LCLMy>&$2{pfR$!n#34}N^O$`_&?HjYqKU|+ znSFL!B9_1csvM%nINTFae%vlnrk`&bE>2@Be`$~ghP)hT z?*ge5z@@r!P>{04Js+*;%Ot#MwefV`yW!ORtPG7`96ieqSRL`>>dH^mUsPRrrnolge&CD~|aFlmMxb z(8?7Gg>&0cQ#)KfW4>%s4xq5?(nG%>Tn3V4eFgCj>{oX9<|ISIz73K|1DZ-C4I%n!NSCn|KN_HaW!2YC1EVc5JGNh{db<} z-ZEwX&R|wjs0%F(L=nQcF_z_tBC<%Z0u1V!$WXaT{y=MM)G~8j--d`c53PExyJrdv%$|s zu!oZqodEvyMO0T}xjPcTzCyJA0J(|Bd$4mQlvYaO3$>mw-^_YD+MST+JDpC!1wTjAk%jdzlV$6b1&N-O`R^BXzB}F9+1=W@KdEVnK1p3@Y@WR-}meH4NSS%<^ z+;MX_B8xtBUV07gc>rO3EPr&4YRH9=Q-3?2;o_DtuA)5_+N^p9U`aQS!7r-!RzC^W zXgwLyw>oB@sM3Sqj~wDWchz5FpBOnKPL^!RD)XLCQDhE5VG~#bS-~=hGaroRp=uUG z;?WHm_IKEAX?KVJU4)3T=$RU$dJWn_Cz!ravA?_0tPc-Wk)@TVR~On_HEl%43*ZUE z#b;Q9aotm1ugPZ|_V)I1k9fjOYh%1QqsEJs64RqAal?@`9yQLrWm>Z~&DlmsPi4GD ze$Y`K#aY-D{Tz?9z#)-09+R#2^$DVFH&n#EIh>_+k~yXb2pe&9A^0c0df?4~nbES~ z&1gcE9ur)SyR*BPGQ#7MrK(NkzMI@7m$~prq2{#5f}cX0K?|l}S)86}V0h>;NUquNyKNyMKZ}71dDET%jX9OPkS;4&v%-M9z_lO~>QP~x7ZW`FCE#CF zQ4k|Z8l0n_BK4*KG#@SQ8?ogh{{}aMN1JC)o8_KUcJ8rJKrR>q^`ywBsR}%<4*#;w z3+)jniW@ns0=wFxFkB84pGrY+kwDgQ8AafnHRs+#dBKm7H2n>@H`!ml=0Uan?cYwS z>8_kNE?6=|B&7ix{m0g{zOlDJFq>{1xW2D9FZwHkhhjDYg(Z2AFnj5`ES;|6u(`h^ zYTg?|ApDVlzK7j4hCJ}Kss>rPj8qXS3r1~T)jT1rS`aFks6+6<)*TBPe8Xw%&t2HV z-(^E6#5l&+^>gK$RqDc>;a>)gVcL*y7OT8_xd41!JDic9>2BiN( zQ-^OReQWQI8W8x6a6iJliA8HN<|#6jl&5{)KH#!YH%>hqp_-Qd)iXRW?|r)GG>%5e z*GDAuN&YgD3}&73@mG-MY02H0Pqnz*(bGOz9wX>(CwzKb+X^3_vLdB0C%QDp@O9o2 zhmC>OS^xhSd#7%}qGefk+O}=mwrv|VZQHhO+pKBZwr%6q!)@*Cea?DVZ{rt?jGhr0 zAITu_jVG1YymW7m=J#9HFHouRYSMp{asL&lfQf~Z;eTdB{-K=y|I_$#Z^)ELg9E{M zojkUP97n1ahn1$8{zG8#0g37oiHx|MoUae(B0xTtIg62X$7vNv06~_{`S0h|y^B>; z{o%V&^$P!A_ZHsTAIGMT5AKEo#>vC%I@=p{9&Lwl$CMgdSAKEJ+SR{XU&f@x29{L& zHaI??H>0!H0O-`rH)wXwLu8|IoqFew!AsPY!nQH`BwY>W@mJ4 z(Kx}f2J8pENB3@R^7?{&%Mvpq9(fJ|^ab>^Q~;QrsEJPY_J^J3{*wN;DCSKFdoxnd z@|=2>NwYsyD6bJplA{hy(!0Rw^Br!z8$5jxp(NDxHyAKA9pJ`^(Y^h>NXXxS91!N?P1Zty+B+3nwC?spiswz;jXMdRqoTRG^31n@tyD^Q`>v-u7&m@N*yr zG`PY7EW9HIk7%Ow4;Y}}g7Ua!sKyQN(t;<-xzSWb@se`G{!q;sKPkrrWO#8T?YQ;% z{Q2`P(L_%_)w&OG9&YO-%^MI}9|pw5VeW6RQ)t3P1Y_d~Q<~4Wo_ny^k0EN#6*ZHc z)X;)j*uSO=G43)@Jf#P4{M7-H6zD}lFT)Uc?7>HhiE1S+4pbGHEm>Pv!tY<5{ke@B zNok*rsMBseSy-4*M9E;6-*z;hSbzg;FU7js*9+2Z)g5*z$^nrefTkQ}%m?C=40+6G zQ|<;PU(41tS16?o;y{6`1rvRx_;re}+nuCFv>N}O&u_+;Ku%W^aKl!E7|?&8w}M%& z3tRdL>Oh1xU$F*`in^z24EMJ@-#a95_MBaR(pF{$M>r3;%;DnJ>h0C+kP!dDD3Qk7 zpkFnfXE|4A_0D2Vj_?~8tdyIU3+(-i@#xD<*{wI798huqX$GC)k-l%0O@f_6TIC^l z+*weQQMuza^1M0CGL5-^SosG@FCN$pg^&fJCcAGwh8kZ!C4j4p{tkqFC!B&NoEyiw zU%c~5;23Cr+A(!R!kHBLzEB8>5pmm1)(&To_9i?Uj`vv?uS?AKx^J@Fx|^V3w`-u( zS#J~8>qy<~RLY;b3sFWOCTl%YA3Pt$H_%v(VQ_P?xOFmtECVat2uA zS{CBlAt|E<-ag3>>O8?8Y32u?tF1n$8;%3nbZ4&L3Qkl08!hePqcF$R%pBpS6W0<` z>ira@$e6H%9p{Y+{X@0$FZ-sMe%h}nG=zMzsBiAC@Pm7{5Gi|OP3eYi=_%LqBh4U? zBtys6YF~oH4v9OF&Kx#n;x(-ea1_TThsLqwl#;foZ2g5ST5CEhNCve>Lsf7eL2hMn z+{r!Q7;~ua8Yzo(i@EG;FNhTlkrE88=4hkP)c{35r~{)AWRC!(Zw(HgG^4r2ysmh_ zZ@U!8*r{WMh+gNh0?mv!Le889UY5`cc-u+Q@W#oRX^vC!%rad)G{e>WwV-HO>w4R8 zL(yxsG5pG4zH3HbaP9zSJ2RMHpfg%j2!9JO$0>SWcAGI_d|YO+9I{Pal>JsJ?7K4} z0>OT^RjSE2wFUOWlMF9&@GVfL}2%6@0V4Q2qoA23Z*Ism-O-{m+&c*(NXPK*J0pbF(R zgO(QE&j8Lb{&v zVd?;_LG+HtHd4vq0tsD!g0I27ULnoBui%6)Qi|frw^FnzY?y$=!JKN^dvCom2e&0kJGHegb7b214Mv5 zOdPIX-(w*8fTV0uU)wG9b!<^f9TFUjWC_B5=Lm{;lD$QR>-s=qOq8?_)TheVVW!zD z(okiaXJ4K;)8ng$px17&^v5hYDhznKra~B^C-wmZyA<7%VUjUlkP(L-` z@dqug%k!3(a8<~p)@9j*nryP%w1w&|$;S(&0B>b7%i{0(%X1gC*#jl!s7(V=Ex1&7Nz_60>YXR-g7T zq{L|jZAG6TqK%?k3aS+F&EuKt-LX#h+V1PC#({vX)xYNy(iS}GbJ}IUKW+d1Dtd#i zhdQBt{J=F-ZboYh=%{sP%>Y%?Ah7y?D0y@jcl3g`Wc0s?gGyT)v+Q54Pa$tF?&}Zg zS5#`4Qk<=mjLT#z6+w#9(IX@{H%NEd#Z|FSF;YS*iNmJ2t~K4x*uc&~RF}8AMXZmP z1C-A|9h_5y!y&cyT*ZtoQAJ}$7qsP8dyCHlI3Fd`3VOHtBE*=hZRpmpnd!3tH!Q3y zHZZ*SQ6f)i zHtSGRG+tOWf@khb7NvIfI$a0YWa+cR?qPc-v#)-I90P^<@V+bLEY|!=SXLJo^FGOx zK6>8@X?dsk24@|>@Q!PCc51&r{|t8H*|?AYr~v;vEC|E@MpbQVYTIp2{KJCO89XXo z5Nr+hB!PX*fx*Qeu#5@nW%a9(ng}e3H)i{X8xR> zVrQ0mVjWO~^5aMZ`6*HK2>H#18f*e%wlu};;Q;RG ztBign7s2SAJ;EGBaBnrJ0Ma&Gl&`FAh7Tg>6>lIszj6PTx+ zd3V5ejF*$2+n49<;OA7&l!p2nUiy~To<=KGxK+VI7F!I!dACR)cy+dR zok4lcusnhB5yN3PgjjeQw8qOIu z#1XQUEv267H@d+%VGxRc+ONfercB38lp%yF>rpEXMX>!{gI^{j!L>+DP>xemo1AaT zfnB=s<>8ocRBL|8@}+6%dUb87kHYJBX~y>ttof}t9s_`mmm#3*QRL@+9R48;fkL{@76iC+KAcIK>Q{E(37#05pJ0PW`NOvpPgZ zp%|@qo4nHR@9VqOJb}a7N<1vlN@E-vKKg=%N>!&K9Y8XIPfs;>RMbOk1%3JOa^P4g z-4F<24FSmg)mm>k{*-4;uDtiH%L1}3lKy+O(P{g9jUR2$qaxe+Tvq7Bja%jKb@QjK zSU8Rmki60nXUk~w%zD)>p1k0RKwzI-rNfg*2OEu~LT`*R++*m~fc^o-0bXnMcI!E6!^ z%2!D}$a3pxz`*GKtV5li_xS0jrN=L~h(|vOBmLE)sI#uq4tsVlmV#hhMK|tyPV>Q8 z)2u1~tY57OyfWC>X)_GuOG0UGT5m1&oR3Mr6j1~l%7dIRm^kvjvUzLfh=~WU1}GZw z&|0(BHt)!M0CIJ5IL%|3P7jmwZsI_lzvuI9fBAYuV)=<=r5lZ7_T-Vr*X3VT95zSY z?^euE=bS)Ezy%b&f?>)AYtkC-z=6j6EUHJj!1f^e=7y06y~I ziAe#6{GZ)`MuO;F1g2j^XPR04@9XbT_*J`|9-mjUT3#4MFydr1Sl&jN0&%kV9?KKy zxU5UxKeqw%7muK3s-sFlUSP7dX$O<5qoZQ@c#*fROn0DHDnC=0W}99$mS_IhdJ1#4 zFtEr#s=JPbYGM#<6A%UahDt)j@lfI-3h(}{eI$c=259@41s+^kqK=5{Nt*qV;ZP)w zyAeICto%ZKJG~!VY6_ActFAvm|Ds~w&Mtud?lfTy%=d;PJ0*opE)a(>^>;lvIpYjd zCjAJ3JK1Hu`9+i^a%8|0i2FvWfpS8m9<_U>bL=NuZkXzRUr(R*u%bqhBR-qJTrgin zyNSZ{K7csFjf@i=b=`UFlBuQ+8hirGZgn|q9f1XsK0#!<>v3pRtzO;vvjo`*l7{{b z1faog{d8;oz<^#Hfu%q-?tgh2WQzi?9X(e}8h$*42u{LoKTlyAlO~>JpI8G67zSB9 z!#U!~jFBLa(-Q&F@zJCKAi!tpisI&H1M-d`T8pPDY`v_Pp|~aToiov9LK1r;$IRR= zRo+mtqtHA6hDQwC`)hzAjVAQYkm>0y2t=*_%<=OQpJ^{Y$Iqi*B{I0n^&Dt+-D&AD zthX?e@9}{<;ci$lr)#3T^){nK6uo4g5XI z&%6MER9-H(g=+I6-?n@f#UxP;q_>0CvCQ({?iC^S4qi` zh+BZ2@|K6qH|{()SEadf+2C47wQCZ^LJE3zcJePK?$PRAE% z|B83tgw-Mk^t(6k)ciU$eI9vr5u+Wmla{BiBhOF`DNa3Ilz-aQI(ELCALCF>Q7DJ^ zR$X5<-B#_`FpaHsSxWG~uD9WR?^a*zEwH&yF56l-Kh|$IWW}C6y|`4SLn~cw)xJ-> z7`M5KLF)Oumx9^d(SRsRn=C0R({&9H*W~JQMPAQ(bcl>gDpr{wF#pm zw9i+GS}4Z|vGo|23wAb!H+i!O8z|Dksd#H65>E*-i*%4MAciDvcDx~-V-OEL5MGF^ zzktRZ8bG`6VvD)(t z1A)$NVPg#90hF0LwpTxy{xuj>R&CChyw)gtWo!_RNhdbx9+J_Di1n|5WzgV9y}QqXvgC8+tBX{7Z|WuWNaXf(7IhER~wVaZlVY-EUN#xYeB-ARcCji5(H z97&FijkET9hAZ>X-D}n_3$81dM)ss2kY@|I#f%XC{mN8(`EcXt9#pqm z84O2#mItXudI$*^ww8Um@9$A|)-^|XaNJal2c%q@w(}-BJ07D6IfWx9FpVR3wC{R> zvVAS$GB{8);_!&3k|GO|nENwdUH(26l|BdjK!y>b1{1u{AVLK{3a%adMcRy^qj3QC z2Lzy}I~)LkQUJpqJ3(m>y8K*F?76>Gk{(lSX&WT z6!XGng@XuXY|bTBva%M7x=t1+_NT<~L8-ZQjOub32>FW7PQ|T>APhniiuXwvU6wi( zv$)s|AdH2Lks&A6{-u@nUt}A`W1wpAUEFHjE~r=bEqnt}=eVeNeZ6Ie2|C7_v`qK+ zZs@6MyFdN0{A(2%#GeySrv``w!OzF(4L&Qg+Ygj0tLY8yoi*nTmFOAIH!<+wXD93L zK-0aT4iQuZ0@)x3)l*(eYlo*ylY{7yDyy_}RIF?id z#p`o@BWE~x`6J2P#*{SnxwD$jXdtWdNgf)xmXZcUCI`;JXP2w-ZE0b=uR(4~)iJki zBUo5|=Fz;$9uTmB4R5a1LM$KnVnMqwtJLv(Pu`8G$l{%+Az&yXo)GZHPT7D7jxBV2 zOSrXd9F+3FnWtmX(-j7M`lHrjYUh5f7+JI)hPMrGO<7o=tm&*%1Sk;Xt-hetoy4

    Nd$W?`XSU}x4d@=0dYhI!dT>?oE0D3D8ZvVa)cZDve`~K zOleU8nB21^J{5uvErV`JW=pcfDg+}6rCN3&-vFcOlLCxBkY?l9D4&SI%)@t{m^r`3 zA0sgUy+BDm2bbH)byqd-(&kybof|L1mY9-!Dq&d9rqZD9gwTFJ>aSaJLr}AF<2@6( zbmakpoX%Uf2`0{cffQ{J0Zw9Pgs`|ecRJs0YZ!uA)>^Z_$HmYHq&`5l(<+Z7uq(_d zMsoP_6g{sCM7?SNx$|T@*z?sbZS}y%FL+WTSgyR%j(XV$PL+)hw7t@~Lo=5BhLFE| zWw^+UwRlm$YnKTWI3oeqpfa;q{*acp7T(f066Sq>)6bi*v5;D8&2{C!%19$_Ip2*- z$yzUJ{1h)yP0n}eqc%5Yg83%T%O2#?)qZ*XPp(gmEz**FOaNrRbd0y+czuakf*k_| znE}jy2u20BluLo0IsEtv{yq8!a61Fj%p}sJ0Amrw?-y76U`1L}jS~p*>WPUrn@{Jx z6ahdU_t2)Ei{{-nG}bF4$w1*AyH`r_@r7(M+;AUQ5?h_2V7Ci^28MIT{)OauOO|XY z3d~y2LL(MabSgkYH~lQCWNII4R#||}3sTTEt$@iL>mPLgO}9mV$~pVuKlkI!pUQcm z6$)}E*Q^L2#kY<-iS-?KUYRF^@>L+ZLO=GD zZrtt~<&T8@I$nKX@NI$^L4YY@M{9XqS-(hlEDA$9PsMkE83Xj`!aZY1Fk^vR9w}Rn zFzDRhsnM!dRMYlu#v6H1;CF9sxq8`e~g1W$gyR!RgaVVSh~3 zM$0-~I1{NH8JkU#HvL~yg7y9sQ5CDg=-cTYo+~~R=dlq-SOhay!~(kvs6#tF=-TmT z#eS`^!7LS0B$@IqqV)gOyinU^wK?T!){1@+5*i>s71CkgB03v76Typ-Q&b;YR&76b zt39j?H^*n_vAXR%*t2UDJ!FNM?fUb(XU-dB*}OLQ8Hmc)(Nsks(4M)|Mr_FORN90? zJbmIpoo_K>R)-Cu4fk>obv!S&PVuK+z3NCo-_J4Ci*N@?HdmXKoF7x*y6>SWeYSu6 z_z~^q(fG%SUv2GWtp4#9?>Wg3P9|wQssZnSJMrc5^-!a(TlmW$PRF^#%?`g>-MVYR zeOHbB*H8XT`0J7=-BAh`tD?V1=OeL?5=j`>wm}H6CEqY$Y)@bBDMB3am6PB}Dr#r2 zR;Opm2bY2@5AZsN9%=aFuj*=O#*F^=Dgbw;PcQQxvU4u|F)wDqp7DEkx8J&3B@QLl zd-E3}gILm$o34Z-IHX?AVuo&U(-Fkq_?bl};`e?G6t3j^s747f7Sq41;)5>Y61fI9 z=ZuNMr#2rRdk)6Rxhcza|29Nli@yK_jk6~IQT_c_updUY|Em>9L)LCn>>o=@9f4EP zzhmFm!EIYPb17^a5_TeFrghQN4oui{ex?YAsG;;jN?1#>$heAE*#tgHBW%$B7 zm2qSt%CjQtLGZO{GfN*Sl#{9)VA3o^VS>-cBOs;#=L)My)1BHFN^hUA!B6`2w6UkI%JJN`cIv@V17mh;p>1Te zpeoDjb|ES0L^2fgO{9k2kH+~hwu7q6w=4LT4v~{d{iZn1hW(Hu=aumgg;=b^ugUs^ z(F%k(P_kZ){xqdQovUhH@i9aQhUhpom-BDhbu>g@+!(Fz$$dEfR&tIXm$T_2{iNXR zG_Q2n3a@^hT9b9Ne__E;B*9b^2{8&|pqp@o4uu~sS}F@d%B8IF0aLPHS9*3h!A~Lt z7uzm%yCIi}u+G-#!9-E%cyT^J8>^3uvW;m&Y z7rd-W-#p`!d}<|)L%+K3L?$$w3Ci{hVX%h4wSjq?q3Qc59^L7;)V>j+lT{Ocz7tnN zClmxaf0uwf9BH4YB*M_VmJB1azx4agT;D8Z-`Ai3M30k;Y`)*AO~=Yd4XPJh&pjC ze;UZ+f{|HZdwNF4JjBgl0>Smzi6yH`WQE-ilf>cU?uJoBI@c@0E1Dl$-ayiwqKWlb z%|`7t5cgPHKITafh@>AC^`DI*D&ER?z7vm|Hq!e!qX`6+sPQ=}N3Ld+dxQL&9Qxyj zd3OaY+%1s%;;t%<01>>Q$1M!3qB7&wR^lMCp*aCPv+tP28oCqk3K&F2N?+YP7; z`fJl)7o3s2Nkf6*(1{LU-LS>wCJZql0#vSSbb2Fh1B$n7-kPzNx=uAH*%aDsUJ6ni zW6jyTt=bl+!`kbwO+nr1MT^M(17z!iaE1?7XCx#=tOyR_WYi(CY$2?Zj&pDlqjwC) zlYt%^G@Ig`rDcUS*>#&zl4b!={7+#t6uTDU3?3i1o^$Z;JE0&owMGHiRXX?8UX+a)bE5cYh+Vn$!Asj27k1t)0P#4LK631E`zdlML7&zI8*WFQ8!9%3|m&>KQp6%<-s&* zXf0c`pBGV`U@0!u++4A*u>M)2y*{a}V1AChBbVJCkYfyqT(MLdvq^Zp?PyA;CgyEu z7s%ooIktiiDzq;M3_+)hY4O1%km3^tBPbD{~5vN&~>ced&$(TbLWdS6Nk9yL)gMV3u27bCYkn^k zzyaaG*6XS;?AI&l`?;@grUyLp|4uDN4#xlCYp8hGo6^f0{ZV$dp_e0IVql;bvvhQF zCSYP@VEp%K?QH5uFJ^7%Y${@EY-eIhFJo$J?rcH8$jSJ>Dp9U=CM&nZ5VlXLKj3ZE zRr&k3M3G>2GDy1OMIp$l)(~!p^75Si97OL!74%=Enk9yurV5HLKXd7B(@JJ0BLuMw z$5DYoXCj3l(V#=|7H<%whi-W^94iphx1wb}9FP={>&aNqbaO2e9Hg0lrQdy63nn7= zahw13xe<)q{d<=vAu=x5No-FY6I+g?q9ZOV$cm_Fr9dsx9Byb%gatEZD@Yx$RkjqA zN*CV=R?`lm1UG>%F*na0x>*Dg)uSxcuM(^TYjy_(h7weAB+UE~3ei3b<>GwapGmwY zekm4w5^qE%q%ENo!2l_#3qB<^j;JO)5i7x1d=PG8-*xFfU(pd8tl+#cZ}=xxjp8_7 z6srWSalx-gV(jK#PiZWI@SZCIh0 zh*d%RC}(sc6=Hk)kr+s}#-HF#;!wp*Cii)va|u8RP)lHtVmvA)5F{|oX~e){saStT zR&F8EK2VXqU@dM$E#Z>Q1T@BGi(CSyFf@D2*dZQy3E@zfGa?`ZaKa?$6pM+5uDpX1 z0(}q=!{alNMH?YREre;YhQ)}AXHljA+E@n0 z+&dP`@5qPff&*~&5Qt%}2tWlQ=hTvGS48Mo8*>t&p*zrsnp3QCxE_!QOZ`xB0C!4? zP&nc7nGKVJmARyq1(EI9FU9(i$H>uQ3#p1bi%?_&2uKDHumz`)LaP(BpbX2ggG-Ub z7Ak9y#cVBUyu;^Kf`eF2edxiWPMl<6+xgAEx;GZr+C-^M$GbuH3JZD-0tSYuI$Q5(l-6Am-s7smgZ49K_Qi;Vo6ah0 z%j4_4gV%t+9)y>-lhi_wAaO`wa5#wyro1I$pr%8Lh*)@hT>Rwc|9&|POUujK@%w!_ zFN62%;pzE2T;1jOc6)!kKA!E;&&~U*x$yNarXRas`OcN8ZoH=W7?^r#;JWzwk*a^D zjWuP??%i_Y*P?UVbM&%JqkDI%;4|vss(j*|G1s*`{V#mUdV6xMI$NvxH}8b?Gj)Vj z=yCakbeh=8O)0cSZ5c`Qw$x*MDWn=ZV^ewrzWxcsqeV};OLb03rq1k}IdgrBMQK+e z^zZWyFr|gS{9nh5_#hof8qqyKtP0i7+Dv`Uv2ky#iojjRSX~ViRGiB+e^Z{kejn!u;ji}x$4l&mDp{u0)hV6`I z6TA(d?Uu{V{6Yxn`rvIiUfZM3VdHu1=Bq0HtR_v(?Kj-E4L#z_R~hp* zzoyO2!(L)1AU`9Blu~ml)RA zwEg!o^|@6?m=PxJ+pU9-6b;y{ks%vVH{8Ch@ z)8ry^R)MUV-8HzG0@~ebspv_U^Y^}z&>vRnHaS#O4P?BaC|kny!2<^%tkCpuEQIO2 z)}R?2Lh)#&r8zc6j~n=-8VP#nNA#>l4(#f0J*!^ugZqL>mfBfkQ@WoCNR}3RQXQRU zsbMObcikrr(nzl_=2I$rg>VFlN27BD((l90YlaJt80QUs#HYQtvL3Q_42cZyk&loB zppvn*S{)t9QFlON(@x-{Bcb*Wa)@q8IjmTtfp0V`G}Hhu3L6Q@V(FA>hN?W#z39pr5@KhTFzPwL-;ksyi&?m%3hC4BXwzmTr8rVc@!s(u8x7e^1wj`2p>@^{wBNYaG zMa)o^OH);Nk6h~&G-RN`?>iO3JBH+tuse1PFiH1kLjt7~=>e7noC^umBt`=!7s`Wp z@;FCjXJYA?VqA*Nj}V&97V}rX1$TW5l(0ReT@4!{%F)UQy)o{4 zlm#Tln=pCsblE?+;?~WHu$c77`Z}q}inu1#UXk&bw022Rla6SClUyL_mUIjT6w|FMns}dgKioPO+A1%VA|&_L zdXwj>4Uu4QxwL6XxQO{R_9dGs>;OeqcKQF zh@1HXltm+rqX@IvcqFaXekQJfhlZ2Yk<;A1Fn0p&;f@eI?$%`jXK5>x75vx;aF31glHx`g)5()n(S0#G;xc(RT)y4LHdwF=HRa@BDIc( zhKhp|X8u?8j8o6l65}{qbvvHbh9j9+vO7`AC^nx+S39~xq1v&o zW?!#PNk3jM)ccD7nd zh;Y3sA~oM!*_33a3=COQY66Pxu0wFps&AC5*4QYr8oyx0p$R7Hi9A&Sm*OLYN(6ox zvs*f{TY1@^vMSAZ?AfRl*N(V!3h9FMNwOf9T6Ls>o*e?_9ohwZZ4HHOS(Hpz$~!S- zc27TdE@oR;a8SP17+7z9MH6KUzj{L|PiH zZ&#wFd!Eu*&*ojKj6*Wy95nap<k6|_B8?P2QVXeT0|v(XK%}5{5Alg z0D#7dgB?yP>`Smwt4Rj;^;+rYGY3yj}ETByd8;{z&u?It2Us>tEz6p&y=zJ zu%X7&IDH1ZgHo=JqC z|4OavtMJ z$CNq$1P=@5#kS!qV0Xef@-BTy_q`6y!n_jadp*N5=RAi%X`|!6r{DM+!bhvc*5c#; zX5`HMBIO?rN``HIzBxX;g*p)A^0neo(sioqL@`i)3jf`WsU7BEV}9dfcy8U=k7=RO zXt%YJm9)o0r`eb}MNU8R(4{m1SaZk$#JzwQwrwZGX7j`M`v3=!zUlo>6PfA1ObRe? z{Lg!mVJ#cG%`wEE9eqNbfIzNbuPt>t-93O+*&8jC=@!Nfcu776BvZr!NnFWwRR{jw zrn&2<&b490xYj_jPA9FLO>L$tqicSJ#c?g_|mlW0|+!+Eyo{N04m*#$(@cL%Ob zeU1T?ROvcfwY%i(n~v;i-%KURWbN%*rO^#XvfC;)9{RA8aczFO3{wgDoDynwV=$Lp z{N0Gk4U{QB4*lqq)CjZCysv``awUru!TuZ#5{Lyl@}J-IyFK5h&%1t}IXhopFDKW# zwRZaY-*1b)Zw}R=h^)``!Zyzkhqu)n)vfUXJUvXK6thP}q(CH0wD-EI{i%+rI_$!3 zE~fg%%CwE5kxmLj-SyO?H5&~%m>SW?;RtQt>WrE|ko#mT+qykeSx<=~5sIPj5h9G_ z4%n(th+*2rjM@2iv(Z4b_P^esw`LG#o-_A%n8xZLkQZXI`K!nU){x;O1Q*=;zytClYxQ0 zRSh>Aag5#&#K=P`=s}ce`AN%9@Odc}RY5tUz-s}I=C%i|*kW^Gr{kTT$HgEE4WaH!OtaCe13Qv zjtRyDm_!{;6}uB>kR~tp!s|;`#>Lw&3>cqjF+D}}-IIMe9i)uM6zDe+3FEr#+uyZ- zAb3?Rkc?gwE?(wDSBp%le2uheA|&uGtH1NXM+%y2%E%^4tT_)Q;wYPvk)Q(Z|BA~R za)Xn~vl4+2>3X;L%vaJmtf$B@N!&92hRbp+Ti~pTh$82TDZ^Mn9AJK8m2yUHr-$@q zG^IIY;*=})0|8GLU=7hBKTxlk*aBu721lhe05edD+LgM_m2)9;#j8H>{6e+f&EaYm z1I&37w&llLn}(Cp)rg>ktcQGI=tVT71QOG{&HuhQt>0;o`j1H{max3OJ@vFSn+H}rM%o%mPsg~tyKiotVh0WLB#%jT`8F?ji8ceSXy)aZnZ6xLIPRrHWv*7 z%!hwaMS#gP!m&K2ge+RJ`D9nvpg4!cxw8iQ%Hg8#3ar@~?FTqH?)`Zd6q28bglgNa zDh&d12kR{75JW|m7H45pP=aqTefY9iGOt5wqDJI2BB6oGgOV!G2q%~w+$J}55Fl|Z zJb;V<2P4qX(EIMdQuFCiPDv`eFv+bHp5}}G_GSGy));&-o|fBhwcXgUMnq8Eo;o%u ze6C)f0=Ofjo{O02uoSiLTPxg4IwzJbbbTz%RuFPDfgak7R8rvdO_DHQ;y z{hE?RNY(DVuF5gy?Nxzjm$yk>1{vrbvk?tSy}EFwg%xICx+gA-0>kZF7^4QXj-_&5 zRva-MT#l8+3>Z~nCt^KfkS2G>f24?uGHp?NQVOS9T2JO&7 zCdqE?q;v`U$xtk)aOJy!a&dYFMo6X`DWmx|)d7NIbzV2w4r=O9K&gU>>%_bU3jy;# z{?wCt!0;ESy~MPh?v>fqVtr)?m=Xvv4gP$lC3=~+$KISXA+q5cy(a*uJB(T~plEkO z1=ZTXq3MZNh1CSdwd1M{kUWOtuWCq;^k~Yfu84(dp_^**xg@Nwu!rmy3uKlpN2)uj z=Lr&V7Kz< zfr0TQ!)=djQC>&enuEoZ(8gqdWmQj|5R_~lH{*w09!qYMM=S$ zbH3mx=wB_3HuaE#v4kNgz_*#|1J#^^FFRA?AS=XO3Q`gg0%8DEt396>WV*h~c*pBl z#J+^A#7G1}_L_imGW#G9t{;U9s4hwa8$De1`f4~b7!?(2XY!%11Z(oXYCGn`HH_I? z$o|znKf{B`-0tzD0s>3KAu2?=1ctSLV+ zN+7+Rk+ZCPwQpB1vte>v6-f)3Ls)y2#Je=Z1;qp^pDul)>*?_@u(Q0T9nXMXm&p{) znJHDUv}Da|VRr9%ayeX@`Iq#e$XU5Ay|}E!KWH7yCKM!><%2roU(5@HId;v!zBhf7#An4=(&@1K%v&SR zRN{m&1=z2%L;ro-{skz-L$v*mdhNgS_L*7P|EFG?*7%e^6hrvw@e4^&8%Vet`FtQI zCq%?sZ5H4p&4vS1l5Iq&@;x#-1*q`zHt(?_hl>rk+-`wNTs3n&$y&GLyWM!RHW&=W zXVU@lYh{dx>0dj;MF!p+YxA*=zJt&)DVvoYgT^?>+ zVx5Z{1X~Pa$g`{(7ct4eI<4?6rPEB`5-$WW1BQrX7)6D!X5Q_V7!Wu0LJus-d`>W{xQ{KJDW1scu9P7_BU)Q(t} zJ4S6PW)d9@ADP)Qd?G^IDj#2$)XjFdM{hVCm2lPWf; zV|+Q4)~3jDe%9rcVSU=Eo&U@M^7NPgD|gKMnv_B^CAkG_GebHVup|Ai_BDzsDdNM+K^fzN@cgiVJM1gqf0q#&Ut%y zr;;o$IwKW#ljniw8EQ_14}7D`<$3Lj4v`4#W^b{6VQ^fudF`dETb&8v3Vvm4YK^40X{lb3wgSsaI1vyyqg$dRZB2$&@v1DhG5r zDXcon?GZMUocCE#FJNn3sH_mPOtFGSBYSp8rUs?7h@DQfZaR^N&MM1DMx*Q+b?0r= zur5`5`(@6aX1UO!$Hm5`y`RIMvRGS!_AU-=-;1T~N7!;FiDsb>8SuAGxN5O)RjJ|f zJ2?TYuNd0tze?&|iW=|G3;DjC@)_W=w<`?aJ!KVuvifNCf6LeeyoSLn>UseiH%olK>_S|49bj$LHyg0%z&)B-s#)sB3!up*+8);S zCWK*LuqOzlZiVNZtEP*>5@3t#yqsG-yj90(NZqGS!j;rk->#QQ`b0L=WY9fo_36GG z8sg&dwZtMHK9pf_)=xe9f!{gJsNpfXeR+QH@AD-CA-WNKb`yY2kiUXFE7TU8-ZLt% zNHqD4z%nYUs$G{2YC?{2iu-&j>W@BA(cs+ieLuiMhj8uw<4^g&TWhm2|1WoX`~R%9 zA?K9*JJvtxQ1b;Y#=;{NflxPXt+_r7owr$(CZQHhO+qS*W=GnH*IWx&5 z-_6`f?jPuM(n;0oTJ^k7)R{0+Fl5X}Hcjtbk*eK~k)L0(U2^Dq?&oDo1$=w9tdlym zd0RY^Bdt|*_?By5_LYbW$h=Wa7we*Y3!vM98e3|MjiS+402x_I-RW!5sf5mw+kgS2Pk<6m<%RSP)gD* z5IPHzj~b zbqdWd%_@Bm{0T9wKgls7!(J%NAc&(Lurg{q`sTA6XrlQDJq$BScsM#LQ#u&NaNy?` z`sbtnxHh$o3ULjVoS)rw^V6c;9ll~Yf*oh5&J++OATuPHP?y0odqXoF3?qnI`wRE% z`15+4HGo2)PX{!SW1yRJZR_e`g)X+7KHl3ihLhN` zU2%)F!mybS5Sn!fW~e8qLQbiRS}t*{yCAm&59C`}R$HySL4qT!PzYIaaDpf zyxJq})1E!fT{8nsEZxkHe-u5bTfCrZMusl@1K%B0WIeAn84Wi2nTHu(+*S6n=nrYa zGly2cGs+@DMxt0|mZkVOPB1=ta8boU4{2fN@xJT!U_w;(-Y-c0Ic?F6f60 z7Gq1dSEc;8fU{ylMu9GwzPlv+&HFQVuQXId{R^FQ1_!pU94f|%u=lwZ4BBE`wvBTB z_EtZWNdL!z8|-F25szMG^k)xXVaphf4yFAQnz@ElW${~J0uO;}ML%c#<+(RdP*6Bo zE%_769_!68FmzUbY1qwGTD`M`{=mnxH;#ZY_ZH9vT;nww9LOVT;lMVY<;5ui(HIt% zzx=YJ{r68X*j0axW@@-3RC2X*vE7vCWeD$2gOgN!>&)^hm1|!_0~oeSuX^6@3K-o% zwMBMHJ#^>hAKX`p4a@h#v4=QTI|)h{m>ei-SgzXE`0`B&_^2P-6q-wSX6#41F`}V9 zXad4iwY1&_o8I>u`bPYjr~leY{wMo6BO5cz|9QUe)zDTxWJCE!Zrzp8%Y|EzYWA7t z6F_Tg*=Y-zYwZtmK;5sf+l1?yeH?nbK)W>rnr^_sAU3(ox%WA{)^JB_VE9EGE5D7Z z@RjxLNL1p(ZMR)OlJY@WSjcKb01cJY zf%eNEG)mjl)w?V#AtD|HYhod0KApD~(W_$oHtOr!`Z1AQA-v|jqT7TgRN|OQ` zATc|hLAT+AS?;(*_8zO`2vWUBhRzv0;Op`i1sNQIb7?n3RKQ`(+3x>x(wWc+&nPzV z-*eR^H32p*Tjm?k+zhg&?meQ`cTyouyW&M#w|=xA%yvz!c4<1QDjg6}n^ICb=}I11 zTA@$-p%I|6yGoA*Huls1>WpAqYw#4t0TT*wA-Z;;a0y3N$y-uXYsAk%62n-@f>+Vk~rQm!paV z!=q-ITf3H>5OHjdQ=%2bK8)~COjq|Rj>SX>uhD*i^FEA5n60o;RNT?W#2mu2^-e+T z)=M|dx(jsyU9Kz09+w?07F(1RtozWJSV1!TX!A_VIC}1KjU~v(a;V-72*5KHsC@)Q ze>o*+6~}rU03fD0M?NY3XPNx>TF6*25>BD_G97P?Hv`F=WU=H_5;!rg0TpD%LHAzb zqGFgk4}2DQVsYa??A%*JU{Xa9xEj?-6;|6n?G)6?diEEE&8joH7w%C9sk)CRc07)h z&Bx);+M54n+9}vrqbDw^E3sN}etWsUAL|mK^~625t&q7x5(BFg1f_9i{Wp2Iw|N!N z9mzS$#Q<@*xqf^h!cy2QoV6Y-+`M?YvGrrVEI~B*i2^G!Q9=il$z#54%1~^;3L?0n zkEhJ06E0qrh+hLNRx-j_PfNrbZBeyB~v*9~S~_b}W3rGxmVikI-(N6d{Tw zvs%z2#QwLiLfwa~1ToFK_#)G&U_dbbae0yaekxk89yqnuxb#4ZJ1UZX+SRcYOY$Ph zn~Kt!QKLXvi(Ix(lU}Mmv#U&#`8YF0B;b|2iZ%`oxjx!nru2!>c#mCiRV2O}NqR?S z)if7eos!*m3m!rYFe>AUno`4mFt`xXR1<9<4MZyEwnU8X7C)eCTaqt)$wL{3!{|LG z3wMwI%w-p8Vs^K|=#q`Kd=%Pwm~HgYFL^JTm(=+%I&dRCnPHm@2NYD1dd{$~$5J;* zEc+NMIAlnRPWw^mb>Cl7MYgg!reHIAD%B}lWXA)5>oy7M+hgpS8JbVufmuQOgDo#F zME%uN77Y2fZXh3h@9v`QxO>bY#R>_%DwJQY^jvDgZX65H#NU2Hb5A6Ub6Gv=0}%RGHE6H| zO9*{VOFJ%nzm>anu9p6SI$AE&snV)oCe#sj&h;CI)t65=3|h0(;&d*5{8S#eTvfAO ztI|Vhwd$hX+1tg_!7Iv7(7W4T=l1$1Hg0Y{Oq)#RwC*!4%+plf{dG=0p6=vRi`HTl z)*GZsTuZLqHp#tJG9KK~ET7Eivw2_X6v`1#35OgB7GcE~@eU^ygmi&BB zlpkPiT6YvMU-3M>fV$+Jc>}@fj932re3`IN_`?&a`ucqg>OUC#WyH!XeP2)bmbwG) z|E*Io|4;5|Mi!?32o#>x_;+*2hVav;PxzLsqXMH(It2>EQQ6xmk-Xx@4I|56!Io^1 zK)RmPUb+##r;8%(d73SZ1M?e!tnfBCXL6DglUvN^`v0^m z=03Lw7YJd(^f`}@P2S$vlTfV|-mwhnA-S!?obGQ9MN1ZC&(G<%+~G(8KInlay?^wt zc>G6=<(hF4fe=o7xCD}(T(8rqqGL6z=je`3E3aVZR@WR;O3M@e(6vmFj%vIlTVztT zo9VVaR(S}~Kr99Fn8OxWpi;m&_pX%|G+*(lXNn^LX#IdQ5niBe(yW1|A+8)s=|-JFzQq6fTZ(y!5*@pI`Jg%N~VfBJFL=fR9-sbv@1d zQ6f2en4vX90{#yy+WlYml#zEG<<3?+Z{ySKVMPi^=O332d;+vHoggGaLU*%RLYpuo z^CKSyrq(e4cmy!aM+n#idU&J1Q`au?V(8}h`q<~3u!R3uB{T&sWT<37tG`wjfAz4ow$-Bq}a9sryP=ucFkER>kmvP|vRQg=_ z^zC5pP24}nJ)eE2y|^&m<%iLK?OA`OZyZ)0pSl-4I5>VgF-;7PA#gnVb1cpCR^j`& zon2+rc2$i5N}u&Px`cc2NLr30A{3@s#FWxZ`>}wOFe+~9Lds%@Fq6!sEp%VJlV3@0 z^meQVr%gV_V9vj|IJ~>-XL!S%!%anNEm;6$forWMaGpVjGH&LeAV)&KEJhV8peUec7V4A?3B~vzu9+dv>XbGUkS^jqie3n9 z%*hyL45X>^eB3xLkbQqf8wPN+eKl~-=0*@6WgFe=84M9@SVNs12X>OX<;t~s+)~C$ zfBi~X4z*Qfk>C*=r>cjYd9ul^%9eeRhNrhtmIBWH|X%~ntK|2N6itg zKO*4nJd4mH24-&`gl28@gMz#Ifx>Ez6pAF%t&g65vMM^o@JYjR6?JH&-5-24uy)L* zOCG4=?PE|q;*=h>Y0)%2aR+y<{+v)2g1q}(Q{goK3F=^d^ojL6V=gIcvREDnom}wK zInJ!t7=S{+;;>a&>|)C}AYzBl+5iP92tlW{OGA*dZO19J(~*^K_KI2sJP~dtUS*eh zQ|;9#27#J5U!!Ow5CK|OGzv2-m2v5k%&R>ZvUOyHKG|XbiCD_IUuV#cR^ISM9AKX zq}tllWyR9-FxwM#LVGmLy}lt}7v1fq;i z5fE}64ig~ntdYL0u8pqHd!uzyjzT&G)&JFZ#J?c(rF+Izy8-j>Z0+#vbPs?;X_{>6 z4{NJ3*q`!l59O+^)HtStG%n~O(+@m_M@eR6Qfb#c?GZC0EV;#JZ*gb#DpmFQ&#kIy zl$hEw6>gMl#@@ri*Rh0Iv@08dq~X@At(iqHaH0ei*JB$IE4{r66Fp8$O#*YAlRn8eDL|ozkJ}@xs%4NGrdn$e{1O;;$B8CiPxJhoO%)o=gc%x{uMd9_)I3PV1oU0hL4^|`1BSMm7?RTYd$w7)^;+t^&!Vu8}JBisuzE;sfW_u>1*`$>(psJ#Y#v2g3D}duj0IGQ zbc!6ATo)px$CMJW9s@@@jglj^r7Q?{@PV|sffDtU%FambV^z`9*c$&jEN5ddQ1!E7MD_W_l=jYvr5X z*dYxlGLly{M<#U&GN zF0<;XP#~IfY0Q=PYdY#bIJjuC!-DY`(d5Wnt~95=lMK-pbp}y_mWn!`Rg#^Kz*Q#Q zT@zT?Xrw4jH4wMWCveltEGjx+=I)yp`OojcvkEuS^O~x5w#L+I0PcjraG=+@nn-BGBxTz6xh zH_)&{YMc=Xf2t2LdI;`DK^c31ir#P1^w9kEbLi>PAECtqY3mCy^=8x3@ptL_vevq` zH`gj9=}l3Sr2t9ilqST=w^s01dL@E&g5eN^@Dqj;t~hafakD$fxBmsu*DDC(Co7#-lH0&Yv=V|Fk=J z$RWFCF|VMjw&k}_nQ<`%m*{GOJL3c_Flijk=7sp+z2UU5+f0!1f}7qKfv2kAlKX~|y#ql489B9GJYH@N0ciZKrG@(rGmAXfC!~kc z@+AWiqo=k=TKKvj9p>Kt9`CdJGt2{tC!T9bga*wiqGPHW9|?X(DEDW0#g|y6j*gqp zD+gX+XQf4dS6%+aaoPskYrzu0TlAqJ$^N>7M#n{fUgZx6GYcY5;VO4dq@k@6xSu2U zD}Qj*oRjIQiQi9vugA9O4~d~#iA#j$UkTXNqQ>_4r^{sEeN$c>D;;O?#$7pBauIM8 z8dqa_tULT+i-HZq^NZqrMrn(IpPt!qTR-p9)ubVp1js$5dXm~NwSJC$I3stTIC*Zc zvRpc$cp)x{dEujoB!VT;rre#oP=yTblkT)y?*f%jeo#%Vw@rw?RR)%GKi7UtSk8*o zhm^+3+}aI8c8oJzFGlH$A-){6zAbU zcYIQVomv&U`)Ii`c{AtaM>_?7*jaNT>^9ArjrzafnNh(n)NEljQWut6`OOP+weDczCU4lkqA@ zkjqV&6g&Td4`yY>tI{9I_bd}*>voPbUa?d!cpk?;CIIS^-$)mg$+~hJ+1Vw&2+|r; zGdVKM<#!s~14;_uyj$!6h;F=w)Fp*{Ibor)SN%2%aNw0~4qe8&(9S>fc(ce00l-Iv z@QI>f2NP@|Dy(D+^>BN2fX<4$2e_Pifh^6su#?MpBI$;HHFyOvDLojr5aXacvp_bz za@(5$M=#Ht5b z97sq3O-ANbX#}BnZmDr$rHon048_Xyor%3ig2dWY(kup%iOE3Q zr;=$`jBe1$;2|9(AAWW!6%duRUaOwQtv_$K`3$}`qi&oWX^1Gla{jv26F4+)UFF<# z=$UuFh;^X8Lke)ef4gS)0}mD3Zv8L==Da&SEaUqDyZ326{MXk1zlj@JnEqq(xT;|* zzb%3EkUoU}N)+TLbl2nWx6k2qJ_39=1tjv-jtno3cScdj=H!Fv@i)0 zR4~YB#(8JEA8q!z-2i0peNV^y*f|fy@;^opTsHOOna8$?sJ?c#!amsm=5RvTFru|r zQ<1%H6jD)`{)}w*rt2z@bL@R8$M`!?6R|h~B7M_PMA#vtW+rH!bwm+@zjfKupQ|(i zX{niu-i`BxknMszceq;dAibOCiBKVs4RIl&kl{cNpmSKKzf9=t4;(C_Y{YC@)JFH8 zPS_X+{#n7<)gl9(WQ4>8X%3q%Ng$12D$s|81)qxd%&^i~6kS%p z*g$xso!x1J?j#%o#9&@bxpqM<=C?&95ze9fs-XKcK;k!jj1DSpWpupJA&FXGe>hq{ zl}%AT-L&VB3>6Occg13s*bP%!B)vmwGBpXbRHTLQwaLn3pg;}L9idVT+G0}y%yX+n zO|LpNBMT|E&u|V+x}9N2aY3Alli5P%RD z?L398))3{3^QM>z+7_uzYd_h`KHB+a(d?_N_e(mKEtS`Wo-VXpg}D0WXJ;4^_XXlk zJXz;hxK?Y*6#5gp6&TXM=bc>CNlhu&T zPbKzXELH&iu#T(NPi^ zc4d^eI60&cV%1Hr06bw#nl4CU`6dm%H}C1s*B<>qs_BCZl}<>ZP#||v1_(nLtq{0BrO-`v z*1*H*s0mL5F8MtI?q8zjMDA}FMuH6?k^hJ;N-zfjK=3?JEkwgZ$wLh$2!`{#4jhY~v^L--?N$gk#!%ko?5 z)cG*Zkh0Z9jr-fmzWryl6vupd?L5=9nkvdHBjrYs)4NWcGQ%Vlhh6mf>VY|EBV5Op zEsR9r*xVgDg&icp=9xM2S+Hd~KjktmF1kmuxkqp76oB#)QrOO8d#2|3Cvvn0)S72A z;^=a4>c(7_L0a2oWm5z$xE8TL!9X~WIAcQT1i3?`u7Y$ye^j9m1trU|tY~cq3N><} zRLJ;FD@^%^V(-rtMiYygPYg) z`PaTh-i~TO4{?J>OS?OW+G>8HI81>A60E1la2#D7x6lIb3>U;!3AblK?N2rxbCaeT zo9^E7yAs^eE?uT3l?Si1aKm=r8jO`SRSdYhrK?B!k7tJl-NLZbd&rsGx^FZfqqFx( zcrrQKFq`kU1y#kzk939Oez`n05S;b!FMqt3_11(q77p2+M{GH|sB}bCaQ1XLpklv$ z^^Z5(c~mhqh^i@?$a&Ej9zPm=l!96TcxyL=EiPjQXtJ6Jb8gVV$!vlZrau< zPxDqDO4C|Wt-5ZSsUoW!49=IE*9##>F9)V>uAZK*wm^-#*SH(C7yF{*c(W@X3j-*6 z4REySP6uwEHD#@6%5fsix}zRYC;w}REo~Y#pbBpN?v1nMZI4B}9$0r%wEBZ#rt0<5 zgC&hLcAKR&dMB|Nf8=*xIzOHGtFdHMlf zre5rv*!X%ee7*9;Y4kEZ_$Pt>r@LlfzXx2(^>=QZ944zOFF|GAb)YM^XZCZi?2Gne zF@1i4!JIfc`?&cv5a6KU26I=*ec7BBxg;Z+S_u%e&rmMyC@G*V<^WDkQ!_cwF zuW9Q=e|$fV&adD1D}4F-FW1}0y;I1*NISk$iL>bXHnxr?sFiT_IG`I4`L|m9_{ka> z0FX%~S3xwwaKTn3)sS#)zf}umK7DY38S&}`aY)~F<_>j!8DR%Lz*=gU1VG(kQG+Ic3BZXEI>&*L&mzvSOh-o2e3LBx$3-MrTCQBbIo@A&f1uau7z!G@s9Hj2-Lz?&ao(pZE6Z z-}m_D`g}274hz?N16%UN)*Lr}H@?^UFI~nQ9QjUAq;+wB5I7;uHp0pRrEBEMm%Ymj zktRe`iu`a)M`KE94^&_(-qcO9mK1o7sI#IMxr{Tjq%o7dzXfI=nj;Jbq8+uI7&)+! zr+PRcyZl~&^UJV1%Se>f+BU96O;;b1)H{LLTun5>*fbkuz_?5BKBiMkUI(ZQ6QitXA!;(!)C>JGd?+PLd6NZ}*{B2h=Q-pKja)V_a|C`6u>{)&)r~Bh z#HjD^wLlf3iBa(>Nzw<{+Ab#JUPD^cOe4`U9E~yFA5UZi)RYf0UhklGr_2TGmzX zAs1^fdB63|QQiO0#JV~S)jBNW@8R9Pmxm{kc-&h#lDVb(ZGDJzRZ8U^PCPvm-D7QN z2SG$_af}c32&7#d=JX4-EfK`AV@rD%a^HH%^;-Q(^}k2jt^R5c6V~fjGk84vdThBI zY43|lu|Mw`OZ%&T#(TIU93#)H#W5R%cj5HRvum3gkVeh( zL*N#_zhai#a z*h9nglU>%bd|j8kGMZn*_9?*{a_-V4AEy3tNbe7*5rQZBUkl3rq?%%6z0$vmKB+L6gAwP?S4hf|e_;U6ESh|j;C}rYK;>v$-GdRVf9vIcqaJc8> z>m)mq^&^M^>Th^a#-M$~1Fu)RSo%85VnT_b)S_3kMGysfrNly4$MCJY=5n`Qq{fsYfl`u!p$R*OHI^$y z3{a_vL?qCiToS7rd8>OA{^dD_`RWaTka>&#~cuPi1-0ZD6E~E z{MtR3J5@d5W^s}-G{!Oq@2id$_z=lmJ5*N9p5;ny;Of0vxG91Op&?`LrslJJEVB03 z&;5%TBk)9&kE$*B23PmqRMlNU2h|E2c2!@t&xOYr3=$+J3B7?oua#lIKbSx@pBka1 zPL8lx3E+HW#+cO)1&M+!{se~Z__+@d3bnrRoS$%c{kvZ>sZ$> zaPCSYZF0GvVmHyL%%d{j@qlJ5@)3hPE{3~sF#O+F0FgwVT4X0F%DCeQ(?nJp5{`Qr zSEp&Mr*etr+iDy?HKqq;E|9_mWQ-Op|DYFd>e2!{^IRMLy2M4Z@9v|8hey`bZSU3Y zQA;*9zr2tM4*vD{T)@B1&y<*erPTnLh}Cs*&A!f_8f9>ytMjt1|E9Yn4@&V=>x9rj zGJzB`jacU{U$64B*x7&2QVo7s0PsnR11fdvRS(~NvR9z!<=IbsQ@GJBuO1j>8b+Gf zYSGziunMr$_>w9BGrP_a+ z3zO5hv(q)(OC1=NHw=S4rb!6PtM_wSSg*Zy>hofs zB^*IABj(T&&}>vmsV1ky11&rtI0#v%2_u+6AVk%m*TX1XAwz^Ox|bRsKvWfh{)HxP zzhl^Ze~-#k@VE5h0@CiDYnz_pB$Bp}q{P?;UC&Dt5pott9@6v$r0p>iDFpI_26h1` zJ0U8V%7+a!Bjzk3VqQZg$>V5bCw6R;)NtRJ!r z_su%TA;a(y?6df0)wA}fEKaNpUmlL;gk!zLd?1O@?=uBe^c-t_+#f>J>1JpLE__?- z>A2K=T>^t!t947uT@WbOj4j~>B75bKGHezhR<*)v$6P?kmywv%1jCDdWY4@N<;q0I z1^rJeFLNgDU~&k=*~xNXE#6MlLdm)HdNAEt&vqA}6Hv0DvOiCzW}sU|N^u@8Wx_v- zFSk8$SktvIcwYw~na_wm8(B;Hp!?Evs&V*tmwja3>K^lm@+%%WJ|J@vY$zAo@s9iz z3C9TnG)rx?Me(EuQ6y?P_MxU|@XRg>7EV0>9|8>+TfF>V>)ihlJof*eEyl#i_MZs! zKcUJt8=BvqKA{JG6(x~ckEDtg%H7x;Q8bIJ@hwm^2Ygf5iv>5aENQGR@b^7$cnZf- z2-cRRJ31s2is=1z|6?MgAEX7sFg{iZ%+Hu$Bjk@8rq5#*C<~cp&f@+9Spii+j)@Rx z`gD9@(fz^lF+b24rlc~Q{^8YmcQku+gfrgB>Jr?~&rQDDUDdA51=Ki^k9M0jx3?NS zQQ44D`{HU)siC>s_X(@0A>)MD;vxYl5~iYxhURSTd&F{swPCZ$laMmzk9A@o)Mc)n ze%}>)im~Ig6oF^^(zW&d$stmbyV-g?KZt!75= zdO@0uqC!kil~1uRkdi3J{0FYyQ`}QzVNwZ`Z&QWDh-Jh-qGIY|jXcXq5{az5>GC83 zj)pj;@dtQg>H%k!aVZ6q8tp zK|&kMEhE&ti#E$?E7kRwN$HJA=_xBv&EgvIpFRQ-*QuaF_IaDOAk78%dB0Ix0Jal? zhxPPtu?@n~Y6jfB3|B#|({A&D;yl$tJZ#?eJuw{i&UIE*EBubsmSE|vuapVqWKN`b zYQ)Sb1e%Bd2XO>`=*sZz$&;}Hp-|_9c+lkCY-~G^vclne+{sNb(v_(tm-1H>Mfv!t z*x01tz4Ig)@EeUt_^I_`YOPg z8{x>ZM-E|>kg7(!wl%Duu!G$N>&9@>onQUg$Wus?3d}t#*}ApDBsz^C$=cT&NTgzo!aHUSAZs3Ek}-mu5i)oM4LUfEJ~p~FH3pBZxjl^D@V+1DJAj?e zdqUU)$b&~kvoQp*V784$NBuCTHgO$_08&26a(-x|;!q*qQ3?CZ2s7E!JD_O@Y4U~i zke$AyC zeI&m;O5{17O#VV*0N&COfj-TQSwMtQ5(aO|W5doZo2@$J9rTB|7AsqdO-0#P*>c=m zMm}|eT`eskt0;`~8vb`voB#Uesp)2ahyHoqI2ZAY_n>u1Z_nPsd#}846b_cf3rW17 z0MJ{A)IL2Jb0H(k1K6R7o~N=dpbKZy>RfXt(F^n=J{+V2948{?L+=zD%VBA+V&y8tBIdej(>yz`Sp6}SWbnDd?{~Jfj{*T zTd~*?$OTYo%>^+M3J1At9Hcl+euG-cPOV{Nx zJk-b;F@T_4k}GZ?bZzai{Icz5Sx#ypxROWW)g&ohq(oS&u7?eH4_l|dIt}Z-Z%KMj zFQOh!ulEY!}j?1^J))Yu62NZ~V2C_h&7CCZU3;0DH0-wZv}v=27>^ zbSntDyW)7_{O?_9e5T@O6z#A}inF7Cc>ly+)SNak)IGNW5h6l1cf0Kj7z_JVKwvlyx0)!gMf=LnKM)H{@9mUKI>fF#-tO(uF~tB?t=ak!v9 z(F-7M;VsPgfFAA2b}KcG!!g03nL4V)woJT?P6Ksq`gOy#NQXF>iQmi{vTfQx(stvj zUMA$KJ_N*YFRdytNTCbTM-|`MpZM{|uXUVg1NqRmK~I$?7oXElnY(3>_wENeHD<)eWJI?pL7U*1NAYpNzz2j zYz$wwpDC!`ulsM&k%Qe3r-o`@3+`UR=!mfZY;;rACwiP@M)`rWTL7bkpg)n_IMDdw z>s{UJU09kwovuIv;2;H2Qw`6v7Ets2GJJNq3M8n?mt_tdBk;%zAY(eh4p`maA9Qs&ur9HjekP8 zf5^aIJ;DdWgy?9LJ0-nnH>-gAaFnUH%=jXMfP_U3xJ2K1C*9a{FgDkimJV5a8h z3)i^HEO=`GFp2cuH9g(-i9k8eWJAc#%2k&ZWqX7?I${uppH&l&;3+B zq$?tv#vJVP>Nfm1_huE=>l-)L%=k??=pY7|+Uy!xRnBWy*C zNTA{E*6{7Sw{Qvmq5mi0Vj+BW~ZHyK?D)ZKl4;jC!RCM zn8!#xtLyEupsdKrx@Zv+P9Rr2GGGwM^utsz#0U~4NQPQp)_;WRgro-oy}AxF;jW%q z;9c$g!#((Epi~(0J72jx7-1y>OT<&%&ea+S+RJ>OOP2|@xTu+LyV4oYGn^{89hq=M z2Cxvv4i!JZlnOIUC+DLlmX#{#054>3i^`NmLfLyO*ADzZAA7W36(k>CD; zcb}PoJ?Bz=E>s$>vs&Gs%$`yp0XU`5m~ie@`R%TP^~fzVo+LN3PtGls8e{kR<^Vqe z$=;ZkNT{-pY-Ndv&drag=LOgMvaO1}EnGAMe5zW|M`IdedY?M#UiXm%Ak#vgZnokK5iQNxUt63no zg7(l(Q;3HNv9(c7belz(dqHkqxeM>M%JROR_t84<`m{ ztx#L98z?zjSAV3!*Gm&o&;gFFUTVY1AW(G0>S>kO9xC;;(;wUr775@)`_J*Be8iQ! z=_FyBY0Q!JlHt88rn$yZTYLPixp83{SA9IlKdlc`6O9W=AWvOVf^&?{zZuC978H&H zfPi%YJ?7+F3OKC<^#AsDUatJ?a`Ff(M>Ru(X$v2i2tcfHkOXJ`hI>$-u}-JA6TVEN z-*)NU?!HM&FTjCCuzL!r4GE@4Gmb}g^Z@PP@py#^sv4_?uFWKkc=k(pSMWP@1DRtb2=c_1V(=^EU=zEH$GeBUSyNpXNAAiVFCW3TE~ zCGG`^%wfpz%b~gpD&I=9xgf9S&_RmJCsvP+38XZ{sCN!B?z*sNFNIf95r2{)RljWI+Lc_@5= zZ3ACzQGpc-7pOQWfjI9ZB}j1#FsP7Rf@=jI&hGN|w}Qo& zdwV?Cs}#nO2sq0xH!O5=3BBD4Z#4bgnB+(TPE2@(tK&Y18Dto$p-TPouM#1@z;qY8JrZG zj5J$r24qb>uG3|AIn14k${7%0^bEt=-_a-+ln`tfXD}+_ZYkS#WDJDH&No%4?y3yPEuqMYa0p{p`wlsXb3@;nsDi1bCPzDxY@4KLZ}jZGTVsFF|7{G!R1Rfb_yZwd|`M!|Q3 zeX_p*eIKxn2_R@ERYq}8D=++&36#<0Cx~}9H*Mt3LFqp9xKp@^i~52q)s{jO#xss4 ztQ=`ieQHCq6}Bq55wK!Y9eNnt6x*_%LLHszF4B3gk4iElC##PBL@Epx-j-{{7baqB zj|zsR9`x^;fJ~n67xwF7(;-wPmAraBd-CJt zIQPBM!?!7h_x{AEpI>DBda^qn-Wqk8emR9MzAuh$hCfrj-BuxHt8B5CuPKz<{{?T4 zp1Hv@T$Jf9Xl%PSM2P@P^`HQN5HgPkwq!AQ(bGEFse^3N_Lg8tFdEc|Y{_y9gCMTz z&oLGDJ2Xlg%(Pn=D`>rMOp=wEA_^&%fYebRje(xuy>Y=oWAet@b58z)uyQdUoQiNx zO;9J?Q6c^J52KqQ-@=Qo$}fduA(`D!^yldaMgKTH*#ZODqBVw#$qUoE@Ll7o+}`RI z!PBNw9X-GR66)Xf#T5HX0fVP zQXr|+nQkAdnej?V>>MYKg`^^5(0x4v_;-rD(p2Va0qRb&&PHsaE9=vKZ-lv1=VU@8 zqBWI*rXYG{%gFU~B|VE@#%Vkp07!89l~i&%8tm_L1&=%5`E68>YisZ`y`IoIfS2HB zKR1#9uV~Lq7Tf!#+twt|^;^`}=VOdfH`S>$0lm7w`TCIQf4h^@Wx{uA-af6sm{*G3 z@ADfHm0Js%HE_T$iKNDT9{bazwVsV)+=0t!3Fa+A{PnRiCCCR& zGokokkS-MmqY88Uq^lZ|6BLM^d0E1VLy1+k1jtb0+t-R=s-7kDjP^!zp)AAM_rDnB zlMaMgSzy{THB1PMC?SJob&%P}>J7l>pT9D`NIBXCJMR+r+fF^O3e%Gpb}sB~tDl;IJd{ zm=Y%FCTi9yeH<>r`r}go7j|VeR0%8K&z+5~>an%GTL`g%e4mLjy^&=NdOVheO~2}` zg(eOlNwLApVOz2$qpPM*58mf(;^j`J6%yxDo7=D!Ss>pcM{M+uu{q8_i zMvJsc$IPQo?(E$4OL(++4U8AmfJ1MgS8l5xy{PEQ4*i;xU9jQcKFr?V50MTHrs^xn>`llXD?7vHm`_k|)FDGJi0ASP$}b-SF8&2u(}rU?u-=&Sq* z3!-y3EaA(o;+Tf6iMiibWWjTTz394vvUtx{pD%ekJ~MWH00Xo1BRNwRUGRZE-!fK0 z>uf+AapW^|iB5ZgeveACqnmlO;~k7va=gVhcA3tdgUvHfJ0eOD8qGAaQmtys30<}Xg#>>dmxpI;T0zvxi9 z($_BiajsO%jd)A-<9Jf19;<|UBWRozDz0XCZ(lCal07YgrJ_MGAll%e+;K%Mxa#UXZdDv zHTzlS#K%jgFp+b(zo>R*Gs+N*zB{ue7770qq}h!K5nmuDc@V+Q9S{=yqPxOfeA18h zb6Ab90FU=~c4nIY4l}WLZ7UwX4niD4GD6OF{F72$EuyQ6t`a?$X~D)cXVV#sb(S() zUeI`$_7oNH9n?{x=RO$xxi*|Q#hQ7_X$u}BRIBk8zn_N($Fj<8cl#6GjfC4T)G_qM ziif*bjKgpA7H@=m75tY6r#4D&I3%_HyfdmVf0@gJL#u5Z*J$ z&&i3Bh*u-C!R*f=ENd}kP(0etRLa*$^U)&`&AoJt5P*CGZn78thjHYZsNg{Pc%dbR z15;rz@mdPKN&Z=YVIwpP%T{%CXP0u&?CXfn2?ef=GG@N*#3&JEE4H)eX_-MCFx1=> z?R_2_O`aB`3-ZO6HY^zjDxC&zxUB$b%*%DC{Pf|B?CT;8V-+G6)A#T1U^!uAk5S@p zFyVz0iW0huJZF7FD_yc3A~+LM_q}f%z@8AH30Xd}QnW(PMWiGvi)Uz$D2P@AcfGDv zWkVS!>#k>tNi?KPY{BLtd>tJ$T(UPg?*J6aiV@-ot&Epjq^>pPeW4A9OUzFpsDJ?9 z(?v)d)CgGvP*k#I2)XcaYs=A9K6`o*o&Zq{Woyn~xWB-%eD8z>ts<~GzcquvG^&8v z)~sRD3B!2Xwu2|Y56lIm;#}*3$9i`Lgh}E?>G&F3-MiQ%G>3_jFS_XAfui!#_JP7E z6P{Rkxk2klhsU1YBBv6L3Ux-53Oc__TF{25TdquBHDKuwW`rSfIuERL(wCZvxpqQU zY$$BEWmh>+9FnO>Nt|YRJMno{4CY!p{TYB?5r;=KDr}~m-8Rb%f}jyEu4E^e9aBPS z8r6}32BSjno-!9TcSff-h|7IJdJQ!7Q$&4SHAyx0#GMP(2F$j@xG3jLeS4KZm(KB6 zvMucGc+7;)v8d)fYMF+2a{!#Yby!Haf;S_A*uFT00p;6qQ3#NsDu-r|30?Zs1A^|v zL^wE8ObVD1p$P%cuP>w!+A@LWhvgnsKi|foq9U3_FJ#M)WvKFqZ2gdJhDOa{alJV_S=~kD9@V5r8H3aTh zu;GWeAREHT>kB9Kn1Nxy13=g(O6B&y^9uE5B|hLG8| z0ZzT!``$+jFXTfm7n|K*8!)mw>Rik(gAM9+iV4Jcyuef(f0+yDq{&Jq8^#*0%7z<@ zdA}4t+FTM~shkBP7PHm?TC#B9`mt3m55fP$@X*?kz4Mb`=rx<2tz z2i<41BH>l;Z{GaxXFnf=f3-%9c&Ks{SF#W3MJQ$oB@!h#w#V&NA=+O(=MXK4Rp{Iw z*FK90mC4njQkgSU+Voxdf?>L`z7)TFbv!FHbBa266fSf#D2kOOjx|j-Lj{y*Qu5Li zq~pY!^?R*32x@QzN4ZWgf#cMM4%k&J8k*xXTM(`{Bp$hk9!_Wk@6Sk|83czMj1DKm zBfuy*3bokj&|jS=-?%O9TL&Hp&^Pa?ope`w2eHq)0rdSqhFt=O*DX;DFTQY6DwnQ2 z(&#!L`>2u-K6`qJjGmnBHV5TTqCG^aaXF=L8Rkz$4*4mpJvUdak1aqg>(?AT+2wZ2 zP$cZZ52Fwg%_Osh^u>0a!i!v?eS%Ro+iu@`5qp zZVVnCln!RBqDjmiC!fztj)j@2GFQ<+$qJQp#x?UeXM+c)*2-J*evv<(hw;Va#pdmI ztr3!PCy8pKG{h~yaNouhKJtLxfe6iKa1jlwP4+o>WJ=gauQs^HoJL!9 z_sq6&rD>KH5o>SzuWY^zBG3_Qci*20#lT|sg2*mhwDppIT-cq@)u6~z-8@%FQ7wt} z``#Gq@gb8l>vI;DPaA+2AW==emqB5-bS6Ch5DBv`QOCE!J1E zf5&zO^1F=1Jq`5E&^x>sto_J5F%>48&NrMJDK-{Lq3v=?+0Z;IATb&7}rl_9(=oy|@lTH_+bPo9&XZ z(;JRY(H-RTxYjug)1ZE#o^#>E6TSH&JgcL!-EKQ!U|cl?fEVlI&H2lFnhSDAC3b9f)J@K?ZppC|JY3sSxo)T95@ctBDBO-XHKLY?W+dlQ`|+@~k`~R#*>y&?D_J&Ny(o+AZ+q>XcvkRraBt++ANK5i&)ts^vuY$ zbs*UVA9>##G^)eC_U~K~EG)9VOI&7TDpue|N{0P_4nE88bKj3(Ag1y^M)CiOdBphJ zH2dGp)ng4CyF=Fh**p?F0|duZulG(7K9t9o$*F?xw(f96C(r!KUz09WP3=nT%EGxB z-MtfOIg*!MK%;>RgI!@}!G$x!o#7S&#REpte-jG~9>9ZB&Dy&(xjP1hg%CxOLZY?< zP6P`k7+=(H|E7?J%=1?NX3CE)BsRFS;_-5APnRPcQBO~?;(8lBhIh5swP97M80G$? zwQF&G$+AS6XV$)Et<0VywvJf|PXsAZ2187PNM)QjZ9Q2}LpRh%69b6?Fp!Q`_R33h zleO39BMO&76!scdF;Sa(Xvh#|K-F*hjuv{Zqj^x-xv-OP*JG*9p=*q3AZq0Ks{5P! zO$@hsq12-&3*`F*7OEI%Gf_QvK7+lRTZlo_?|~377(qXBl4VoSCuXy9qJmky%tG3w zj4UwFY}XnLA&=PE=G~)K=Xwp|p%@>qy%$e}XVX?E29>-(GDQ75~C(bv*_)kY82L z-T>V%d}`05tCCd>sG{PU&iJ@&Q#J>=QVHk;w}~_4KLTRC&LzslX>|(=#4WoI>mwn?7z(B9wXMv9*fuyyKoQIe^aDaftA0cv}hrYVMy#BB` z+2}WYCAny~OPlKI&haxd?Zf27$Ct;Gk<*)%L$}-WasSpYkk!1I4unlc@u$zQz}p-7+!=2|Ev^Csp$@HR<9KK>$%gE0>TJoQu7@c0E-9 znFYQ8<9Yt`W6dYY!bX8P`m&k6#M*44VXWbN0x=&taGpMC&X|oV^UgoH0P5oH2Lv+v zGJ~Y-dHLn$6UJ;r83Asoq0CAblnx(eZK3xztmE)9p&HW^FKQ$T!(iMN(-pf1uDcG+ zO}qBpObi16VBYD{ir~c*_KIfGdx>(a&iw|sGmmN*2kE*J zb4V8ySg_^|AStInFe1-fc7c53o%jGD68dUAfo*(eYLbG(IGLnf^~F9HuDhoiZL3p@ zNlqzc+w|rPtB2;s4^iyTGZtB-^P0exTcZ%h~BprC+<*I^i-oE%u$H+Idk?UGQG1G*2|S0^-k~A zU(VXu^g-l2Nj9x6&DD>8RbB+NTncRsL27N0y!&*8(@4m`Olt zCy_cF-!vH`AxL=g_m|3_S@0kW?;FMF1r(jh@mL#SjM%Y8c4SmfS|^xg@1~pOJ@Hy- znnl+r(#oIa^2*8ilYje|N*R;~9T0bbUf41!%-8kwhrZ@Ba21k%lVRQ1Y}gKooF8X$ zNv=L1i(%ue25A#_gIIWZsk< zCGrUx=!d=_6DH|lg7W0^;cux`6W z2|7-hJFGW8Dx2ld!AI)J40v_s5Qudgzs6e>H?E^bOI5ONTdsU8WfC*6pH3JNC|ytEqk-P{!NGuj1)T<^p=128+0z@I)}A6 zSj@lc74Su-Em8ojY@K-5QX$P-Y<{>Z4`9h?N-)wKbMDus_VIQQjy)207>~O#OeA4Qu&wg zb$f970vE#aFdw^B2FDK7MSt$Tpb9t_@xcIBKryAH_`V7;Bsi%3rLLL1;Cl1~>OA$80`cVQ@ds)f;M1q{TdxENRt4!Ht>en$RfiCTKl@>ZZ7!dDz&Vg8CF+D`$PQW3h6p5#; zGJqv@-3~(QhPtzg%t%$R=pcF9?`!}YOdmp`@=uqbtx&JARu>N;kD-PEG zQ+pr&O(Toq2)}8B@E|GZ!bIuRhH ztHs1UA%aHO{nZpxBh#!kX&$My;68lT5YG3)xHZfBv-QJKvK$5ph0OYqHG{!;Fl6F{ zu_G%Vd@fz1OVyt;4PTwJwH6p7_AR zOtLDQ&0+D9d?Z!j!I(sKStO`zg&fI77OAYe0tfX*NlTPVHMY*oR1!>O$QPPSj>+>D z?{wv|C)NXTxulM)2Tl_#gI0*NB$5+1FuT2SB*$>=w zm=#emVnnSMoxz$@hBHSaAus{Y0_jbh)i6@o0Zd3eedOuLlR`*YH)m791m1pBOnrjD z;d~8+pA&ozEf+O0si*>fkCMWbJXQ~zXv7f=Dn8Fm8yJSn=B&T=Sbyp28Z?gU;lB)# zWUIJ|gV+uJ0;8gsv&-N;SF-^ml9PbH6O}wdpii52(>gvu><1w4N4QLg4|Q%&blqJC zf;}^e@zOvVD5QahW&1+d`zhO~a&B&V7F|=m8X`*(!qGrP3aDJhPBA)h86UIWGF*p; zFVio#pb9iBsUda&&}Sm8=gsP{ixQW1MWyn+)Fofs8Rd#II3h^X_A9d^GN^DpPzgT4 z&(Q6pop-G(+$ye=;9vc@vDXzB#N162W^jM>Cx!wA!GKSW_=A0#7(a20q>MDQ;l1G$ zp_lyVo!Wd-H+Yz)(1Jxt_xmcIC<+gObgjhdR%+t9OS{@-FYGS{zg82iIQO{3TJ(1} zC#`eKF(4Q!MNp8G2;{>tJqDZjJ^|GH11Hwkx@vv0w{f{+PDT!KDCdpJIzN<5UDLtQ z(J{1zlD5DAUF4aAuJ&F5bmP21PNVvIKs_wVMWuB;h2krk5~>*w$({P6eP$Dl3yfEv zV|3P23G49eZY=0e-lMAptcICO)-0=t>LwdnU%^#nyNzb|g*4^qOd{9A=Dz^B#>%dF z5+t%w;xh=FwRf7}sur!&vj?alrbofr+PW&L?kU@Bnn&;YIhJs=R$vIMZfKs{6%WX_ zspqYm9RcU#NFx7!KBvR0UT(O2JxaEJ*U@OH2K=~VQ&3cibPtEx-) zx}jFu(mrZyL6IUO49I+AOTjkzKY;ay_u|n)J%AZ!!_pde#N@?{7&!Hal0UO|{jXf! z;>h`$`4h7vhySIVdQ=n8WW05BacsCJ)Yu{qi_lqJbJU*Xq=S4Xl zLa5upSl%&yr0+N{DAHt?G)yyNfw$WnNWzvhg@BS4hJ*EV%`vg+|@ z$$vPlDD`m*$(Zt;N7ulTl6w2n8*8~Kh?eoS!8gnbTF^hIG({_s@?wp>3dGd&2+W~NQ7z>-vD*1Hy z$BpP{&&t8l2rlhnYZ|Z4Rw2pxI(Zm_@4L8G`*<-xE_KK4y0vzZ&zpa3}N!jolo~s$2$V31m~R z^MFx-<)EkKjN}e^m|HZ)RdQN2Fw5EKUPQbf>DD+P+pTmgvI}Yzn>(mOd*h_W88GKE z{_#)VYudc#etJIJ&+xmbjyWk^fbw>K{udH7w;!*8k*iiUClf#~TE(TZrrWw+&oJ=& z54qf}G7G%1Vl~R&ObSAUP$lwFK*w0H=X#7&X0yK+O~?u!lq0kMC>ed^wI`>*V0lO6 zQNGc)IVART33pKer-{W%W=8Sy7C(3Po$|{h|D#y@_^@T{AZ7V>R|f@UTDxMD zbzdiMFAd1fUAl=>^|I%Rw-^Hv$2s-=?4;0vywJ{?{r5SEJsqd@mm9H6kVK(yezvd` z60r@r_||}U=HNH#5x4wdqYT9Cb6=&{a=2Q_j;X6}ND+yE+5x{$PV)Dsek2a4tZ&GJ z(U1&Ys)FGLr8MS<-kE!IZBDm9>-9FJ7zAr-tTW9liO=^Pp3+Rv@jssV{}uL(k(KrT zSXG8Kwc1Hj2T!<{g_6m<($(oEz zvvkt)i9wNR%eVVuGRRJ(F=D{N>+`V~_PUwwgnMjbLHGT+xO+XE*YVY3b+0MxR~;7Q z^UtR>CL=QPu*b5MI!aXNxzi0LgQO2zV-z_}-Mp}zzN@D;w6GT5XuH{Nr%lC>*1jRa zLR4{P`ZUaYtNFbr^7UOEzf8y5z6#CKQq);8hu4P%_rsMRQHA+sbV7F--nJyWR+_~? z<3bg;B~diiBpjBU5b2!vg-}H(ye^+uWy0q}na#u?{PoQalW+!Ag2D;{sWQC!ce=OYSje7-NvSd)_e`H}fwTM7KQ=!+ zqq+y{Y*4WR8M1OfeSxd`8TdZeIZVgTm@6ZzrV9UFk7bkdvWy8}PgSrfftFiR!a0iFquevoQ*s4j^lYh^pwBLq zD1P3kj!({%C}G#C^~hDs$x0*WCOo`p+k}pg>80&Gl>O)u)$?cp&5%uL>%FEvPLugw zmv22CW&{=?&(I8Us|HT>k7?wb!p|V4*-vvU#)`L^-l9=U2U;X`lEXL& z=8riV?EVFqyO6u&;bVU!_83q!@Z24q;S;ZshfEPAF9UCq63~Rw3b+Z;=r> zpu|Hx)VxaanRKT~mEeOKgonfk2MyVp4u+EeXp-4Gk2pP1v`HEj=%cAc$7sh`)*F%t zy}014m0XADy$Bl+fiO8bHE8(T(!n(QKTe?&}eTrkdvX?KCh;LiqsNe zghILI-meg=6vlI_>kpRr&wUhmfG}DAYfENOF=*=RY(cJp#unWibcwh4q+cPh4$uvN$j+# z$9X2KSuikVNO>6(JF+MSb$>goPMf^>gbSebu3dpbh9NDx^Z;Kp8Hvbq0s# zN6Lx=?@Lpa4UyTR9nXgKrK#g$oq$lu*plN~T_{<52WpNKl=69(l=O1sL0v%4R!+gi zoH?9-NG1g(vUo?QK5KAO2;{Np1f~S(Ee(Q4(O8e(P*&v#W`6h06-cGyuFFY%Y-B06 zEP#8&2r<4JC+b*Qgb&t7K!!l<`qsYv`pi}8m2uTKG(&h6H!W$c8ip|+H3VGlkNo!Av0>b>I8p&^1OD22AJ0x$S0dmQ!`}9 zdv%MgW3veqAJANdjjZJeN)=(t8?n6>|4|}1o!k~vPRs8j(?zmZNdd1O;VyieW+WsS z?o^!%Xnapp9|9p2{6ih|+N99nlsD#oPz!qhXz6~ZdAhk$lr1Trpe@inAA0YokzV0E zfu!68sV5`Ab#QGLw2|B>nnj0g+*tHx{p9jsy@SL==INOf`=j4(T}%(5APobcvaD$+ z4qGyCU47oIHf#~d-#QHRy*6W$F~To~eyOXZ^UIQW)5PINp~o$i^&zXC|Q(GETpdXE)V!+KNb+qZW~mxV?hvn{wOFJ_({l$WQ5 z3+O4=Dcs^dJw#Wyk_hEp*60w`yh1W9(v!98Y(IYjYv;tC17iV_3+e5x@BW3Xe+!fO zLoy|=GbE-%0%l6KN-7m~fI?(Pp;^e#HPNiulBWxI-uN*mYKw>%VJY6D|DU z*-*_`aD?qxaF|e~W_Kx-Nt!!G^6SF_6x{o`63a8Q{UGeD`j1;56cbT}mr|YLWMz*X zCcM+(qUu1hvU)D$g?H*YcAuPQ@vzuQ;>w{zeuDGI9T`o@m}+eov($foiRm87Wb3w zsKs-;F#`>>R4c0bF1UPsTZCNOY4}?v#MG5{9^nZoa8C_P?ZH1|Zd@F64B9&)19qWz z*^mjhT@aM&oXeb=y0{_o_?IfsYIHC+O+PP-xMe=fEyjtsF~J@_vlFEFz7@G`0XL!L ztu_rusiVkW!^*BA*}c>lH`gOv6*>TnsTa;Bk0*4%=&5vPwX~O>P342Vn;rth?+(Z| ztj2%#N)C|UeR`TO5anZ0jxm1BK06foP39)o zGpiHlY4GdBuJ?n^q1Qa_KStL77S~7rzaP#1e`KY9kY9^JRO?cDRFrOotkY>)8=iSF zA%%~e#)PJlsv)*x;z?jo{%7zI`DLA{4~(I0pF}yqt^n9<|-6#c5jHU@g%L_9#>h#@qU6H#p+1!7u z+pT3ZO>NOi>mIJ(fa_CI$Dmlcj;uI7U2aQd*L^%zIeZ-w`7*fnwYgVoUso1dW;OXE z?qagIT7oS&{vZOTE`RPp$8`zb`-6Y#jwq^u(6e!E)!8_`7h#O;m8CSlmQp+^^X3l6 z+7)$2BVg@kWO_2(ulVlzi-2+caPAKdE)-Si0AnsPQBhlhMAq`P zPc!YMwH};SnTkYyIw5G%{wDO==-hGHpntSSF=KMFl_>M!Vv<+10m6C!`m&W;fTE54 z)FldlMK4SXq|vhftQ=f$7(a-=-HpR1B755;2o4fR(M+FX{1hY@Es!gC6v^V~cL<{L8f`lig( zlym+bhz42j0pt4zeKj~MvNWwNy%10yl=bXn^?*jG!%`$C1_e&&&&Y*PA`jWTM3qyJ zO5PV$wmU&#R-I5hIC|fWf3D19&$jo!%KSdPBkcIVCYW5insR6^%VBj~Zh;r<5odVM z_OpQo-suMYnZeq&6JBY#hhHf2DB7aCfU%oujNXfOM4ZG>>zp>Glg2S=Fa(^?yb zuNRkdG%bg_F6?kHaE9JwDY@Mv`WJ9a3ha4hZTLHiMn`BqJg?^ktFSk_wJ70g{QV$tNnY zD9X~C^{qGjl;q2eYaomlK6X1~R7=s~2l71qmH|HCZ4M8zxCpo=|ytG%c`4(Q)N#8FDeYg`IzZR25kNSLnc5-Qc#4mA$pB2l)1P54y zPwkpPR}nu3irbT8%BKpL&Vo%`dyFHU?-iY0M&QI9QXU;-{}UV@-d`YlwTJp~43l38 zlQ^N7&FhEEh1AYpFyN+~@|!@BNG)U3g8v@*7i}(HCJ%~|{f}8FF9ED|NTTUJo@&P< zR_Qcn4ahs#_}^wdd`oeZ;YE>dd0e~%_C2h_YO?&EJJjc7vRe=GTT%UrPYephEa<%$ zx6-TyC?d3g@pZ!&8g~2$4o8xq`ngBSP@;FFas9`hfM{v29dHpc~q*1V6e2=j7gmq@NXh% z1?^5=eD5#c(qKk)iWHOHhMs?>a;#4RWdv1;u*8d`HVe6}G!L)ZAliEii6zbVL$Kto z5+#ai1${@=Kip0^`m;@E7xnpdADtSTH&jYv>T0JtuU#69^ zm5Y~oM6cc=v%RdIpy_g=;Ri0;b!`_yw}!=VFm=tac!wL*Fuv57BuJF4Mp zSFRm8p6)0{0xv&IDlg^z~A zA3d!LVIn#U($&qw`8l@^v$NnrA#^9R;R!elkWzbIgl=ILQ3KinJ+p8O@RrUgRemaF z#sQ98Nti2!YF)|cGk@r1+z2u23@1IkXo+_aazGX!Rqh09b1mE8E+aZVGGaQX6T;ug zvvS?@uxe;~mHyl=h=++RcZwTdEql|L8>63m$6&;jy^gp#Xl8N||csv7daXT3yC>>AgN*%HOiW(quI`v1=GIBulNE4uFoG!dCP6_iV zl5(z9tOY?H@gLAl`r zAH2NQQ#qR{Tsz%56q$5TV^~pTR{n(mzueFP|JYF_ZTWXb=FQjhK^or|y71#5!GFqb zZ2uLikCB1t|5z5f)g_z`S=P1V_-9M@tR%hFcSq0^jrQZH;JP0kQ;AxE!U*p_QVV<^5el*bGS$uCiTfgiryb(b~e zR4>dr6WH%gEf&URK%S*bsS9%PlN$plJXV^Nz~uAj^IpN);GuW($lhgZ6nOJ$8#PO9 zRQN1hz!J*EhSH-+3%&U#i4fe-f#iH>mi~fBVDN(pUTCta&TvxQmgU@upNWymz;PlZ zkVj4vW=Lfr3u^_52jdz8vO^^di`=@hSUUUUS?D{&t7>h%Ecpm{-)EeKF|^n+O^G$? zPn?PKw=fvZPD1tp_wmtBGTC^BK$+WN>o-qs0+SDCyDzZ;=}y?~BNO~}KxpfOJ{|YW zDNvK()ez-I5eB&@&()|`;ctbsbzXfKDJo1Z_vXPQf>1nDDr&7xY8YQ$0h5M+6Tln^ zhPuoUL`d?h3>Q53Ul(XZE1kMue#&rG z^D}bH0`%|Ulf4mbg~%|K$mKgXeQpC>SK3fmB zN=9D5B>6kp-SUsH-Irh3Jc@cAb>h?wf=KNcp5IZ!?HZnpO=a;{6`YQatOqg()Y)f3 zkYg6(o0*ze{Y*8HOV8_1?)fwcErx*RLZMZ7M z83D(ulA|clOJf47QmnfP`;z61#c5NMY{4^4k|)U=I>o|LFpd4ZaSFZV$Wt89g9IlR zprS5bP>2VlLXHrzSEPle43+=&p#BXRvJ43PdyCRv`XOab2~LD2*md+=cqwzdZkWEw z7Q>kXTv?DodTm*>a_F_Z0std9#W&Lks`A&9og2yik!6V|7xz|f$#UMm^AVfK>{$sP zje%|{%^vrHRp{KBCm~?|lnm~3dotH)=T_Y^>UsnUeNt^vy`g0uYk13kQ@PcqimtIK zIoNG2e1uoM@QNEVmLFhk8xEEs7yy+YTEy>7fV7urmO!3J zWB5m?c8$eGg?LPPsj5(teS%br!2~xuyWa{+b~o=|5*AlK;IwpW_!`bJd%5eitDAo< z7+^%8JxYaI&MBHvWcFqdiR51mAm?-tWhtH?qJC$K*tlu9o?9{@rn~Zmrgsp|+*yzn zNI37s8mzCvbR=%AkLQ|+#|s4}3h!y$4tN&>)(RYD;HyM-cTvigc)z>KZB9LoUaojL z#N!#FrDpJLzCP9QeBfbOhIF7?4)#2*)fxDIvWyS2W*dAXfM#gYTx;TckXA+tjvbr00PS3;isJmYMXnPqd|u$c2CS;hj58nB+qp%N#)N975%_N#RR$j*Z~|MKvh}_PLlx5-au!;XY-mY1Kc=|qF_DLo62n&*G?&YyRpHtJJL~t8Gc$7Hdfv%BIj2VQ8rue-sHpZThcC{6A57Bo!(`{W zv71$v1(%&NyREH>ovqo)$@BK|^l=dF>1_MXe~e;0>M`>CW(k$D@o;l_x&L^aTt2@z zxOf;c{d(o=#G|A0<Aoot^`f{6IbOdOPq#vk^;TKn&90gGcJcLb z3?{7y_~T7#8WqvNtvLgB_Giz2AZ(Jq^y|hpwx!uOWN8si!R8s&A6Jf zezsJQt%_92p1IiKva$|p>Wpl2iL7*q@6&V))-cqSy%%5yTXMY?Gh~&B~_!U#HB6R zzs8h`-Yl$~vwwN@j#(#SlQ&P=f){(qH4Celkek|gvO#4eTTi8bn;Xc`WVM}Xr5jk6 zAMs(4w4dChec~8j^R9f2LR%f>eu8h<_+hccU{}9-VK}IM06f9fB>gPqk(?c^C zVxGeMKH)bOSwQ|{H2JTfpNuTb|3_usjX55>Irf}ei|;K?K1f}!ipEnG!5~Ts!I;sO z5Ooc#McK?Qlz^3Z(GuY8y;BuJxLKkL!*y49V6GN+`d7gOqQIacy?s@!Ryml8(Va)hIz_ea(t;m8Z5rM5@S&ngsF;G`<)9x z8F2urKZ2Z@iq_#fd1}s7BUxB1$*6!N6SDm=ID1W*BwZ@xMsM2;yoCGWfiZ2+2c8h? z1%EwlZzu|G;bFAWYLG>9B~Yc#qI=htb( z3u5M<)l8RZ8g{JD^DxHDc_X0Jy~|ABT>)Iyb&x~AHk15^XGyku7g(Q za{i?hpM(7{)qAN+fSCAxRAC4*dmgi0QMcU0Z!b@;5LQzgV+&P-AR-(776h*Ut${`( zmrC|JUF8OAp%oVgOnTZcSai-uQBY#Qi4J`w6bZ^g%AtYkvuE>RZePv;V{Jb z=;)4!#GDdYq$_sF(42|jHFCKSN`$9Pjl^kDY=$UZrgv6dcVWRIYmc5J?5-N+sfh>v zcmxd8MK;Mgi5CCk47g(YSakj|Q#R2yEg`UHGPienxV16FqXLZ;ZP?V}t!*M*Lh6(@ zq&(e6a4fwnJ}STKPnAIvabgUnxewY=L9F>E?eugJdcJ)3Q2q^-E| z+<#W(i`|KAl#CJ}o#%h!poqlUz5$rQ2diI~eer}9oG)OEY39NCLZ&^xpa~)PmvE1R z9EjgRL|#_F@5&-mpR)X_@Cs9yUUs&@tz{HMp;CQq$H#{{kYI?hEmlZ=xcWBQf#7b` z^sIER%&>p<&zjhu!srCLJ$_bRILSL)n}==BSvA8OW^ZRCUh_C0PvA=VKR2$OOCBIX zBmKS5Ix~%9KN|Tz1H}8){iM8L5<3zOmMS^w!zT3;9_SxmnChYx;;jDC;J$g6B8qQj zY?)*#18QsZOmOXYO3j$t3ud!EAqO4R3?hW?k_mcPx-3_1mXE9 zGRqr+POgn!Yb#lZ^a9Jn!f>_PB{OZVI=n!;&S65U9oIj7JKKU;mE9bm&n8XO5vqx`-o&Q`HE?w!M#%eIZh z7JMoEeHML~kTsT@9?_+{D%gjvHk{C%&FC#}z1L=2QV2afYy}S@Wj>gq_+xfG;Rnx{ zCadgIJ*EEtDp3p(J*#Q%0!uq->FqQG;%QKzPbA6Ss^LdRaH0_cOKo8T zj7cV+(pK7l19Y|F39|b)q^fsaz6|WyM||3>K& zH})pGy*O9ELSm$n$-Xr`pki2;v5~6*>&0jYeP$4H^xAjcZS6e$ zjGjRiTJ9IpIEfNwCyGX~YND+~ikG0R)||mn$nAGMr~7@fJ7yq*44U*pm>KVPmj*Fx zoFx@QG4y9b1I(SstfF>yz=roMfC&Z41nbHq=_)1`_dz<8RNd}^13W{G^@0?hY=KQZ zS}n9*O_^NJ(y2*ybR8wzbW>OTpv$7{GcVsQ+>4!f!CDJ!iy{^9&%53#Q+tRdqbhi| zL^nO4Pzn4@xoY#HayMj|*^MEvStc1Jao-_hgRJPK??Cx9kIsyvXLDe5H*y&FfVEz} zHvK7(vFx!&?uS__hi}j@&}}-e40FGldBdVY`j$1y&g%5xS-T8zD5SXRHL{;=gH8`D z_n{ha9{7LnsGZOfh5R#Od6vrlcrj(iu+r&RA}0UahorunP@Cblf^YDZb*l5;8@PRi zEO4^ZRtKufG73UaF4$U&TzK3>;5sAO3|>h+x>|3lyYu)y*}I-=aRVA?(;j)-I0fY4?on68 zvtqEFBn8O;V|^GO)=!so?P0_jg%UW>-blFDUv{LuREbBclNXgW8Fqu++9L&u#3N82 zA_X=npVh{+zcWK`xs{FV@*syr+3>yTle5HA-hv9PmA2LX@*2?jCuE?>s zAF{(K>iNc*9h7fmjPzn|a-E#TtW>Dw>*NpF2r~riJaT7b4&X~mA&R8Zd?O7($T)*@ zc5txCqr*Z}#zF)pKC%IZ92LhN1ID9|NM!TTDbwA3J&&&fuQzT0J}Wptm2PZS<89@z zcR>!Kkvt!d+c=^P3&hqsRIX2l;TWEZ3EH^nk)89z@^OHPDDYhZ|KLdbIo*tci5-5l zQkiSYUW0|aGMr3I^4{|%ri-OAWw}2E@k_ilz0c~rrT#z0-lvVF>_b{X7s>ULdsJ+l6zn_a9vQ<@AD7yI zLk0S>rWc+n)H5!{Df9$WijboiIupezs3V@)OAmXNH-pJ1R!r!Ur=>R^?@un+IC=>M zOoLOHDBYj(V1_zy7`nn|#3h(hIxhQVdQi`#m7X|h*%TqUJZKj0=$>azAc0Rlusq)djSAqI{ zn}B$u)3%1Ir2BW`Ofn0F6jP6Z`NVcBe&$2_6*ygoS}Kr2ni-0* zj`(cw3JzY|$=ux3#g+u##EtCZQT@=b?W))pMToZ&&cvGVU&eTcUZr0egT=6=-k%LM zNv7f;bT}+WW_c*0B73s*7O)pZ#`5evc;nvlibMJ4>CxDFeWkalI_ZTF-(A-4xolP; zc+Koek_v~Cbi^;oX6Fefw51*AYr+mlOr?(!#K1dK;W=nZs>INw%8r^0v4w7nFRTm& zQPR>9KHOMm6`OPSMLd9%yB=$VXmvrV)Nx0aD+!~uL@djkKn_P(SjaxRMca)Us!#fX zloPNfzHRetl;`rH`J%QqJ6h^MjxPi5iC#D=SQ9w7FdOtu#TgKEQ((SiZFupp=yd

    2Y5pdPmO&i72s49Uk` z1KUxW^6uB<4w;qOgCwNnAw;W#gVjKtUiz8l;j+S03W0-fl&x$~Rj##=Vlk`b@ z#7(w(bLh-R&BDQ|JcyRSS0P(dj^EygLFn^L_z5-N$@43Lc1bwX(j}HnkQLaHO5eES z?od>cs~(orLByRR`1g1*iUGw_s0r zB~~M(bj$|Xnpv?^4!BhYRaY9GOD2btB`YkA&6Tc5;rE^3Dl7zHUAwmJK72eH){H`& zp5{HY=ioz&G30g++rYylr&7aG&`@7kG01lGQw|9xo`X&4!?TVuRx zBHl=?x|7A7i84;%7h6x?SWbFMTy^k!tU9a3g-t~n+Pz0WR4CD!80bnlt$uLri=j%j zL{%s))1}~|X7#!b4^O69p$Hr6uWL&&*Nsk%{hieJlWU6~{!zr8sOIS?M~-*RHp)?e zCtRGcFQ1_ND1V8o9@l40_3JeG^=x8ZM{XsDlmuX$X44=xWXl)?by=j(!M7H{3|-au zWv5j4Pje}VZVp2~ZMXO7?rR-F(qZ}TKQ$GNrkBoM>E38w!jYVa0jKPYu%0t-4HU-A8Q*gV7!+4=_*Y0vW-@S z&;;ck&B6HFXabeLUYX$paiQI`$8!)Nd61GNwB(w`Q4GJ_wmWmE9C_i65|0mo0`P4K zoz98j>h=Vuoqi~@C}7#;M3<5ix`0<0x4|UBSq?$4sSQmr4nYphU5>g!hb`fg zEB`de_+fwMKX-`rNpb83zN)xkH{B!y4KhWVh^+ySk{tEAuE+eAK!S_ew_e6eYv`RW zB-(kV)eLaxp59yZWWEN<*^}1om`k*ZQ&F1HK4cf*6@WG2;ZNWjEroz@l%Kwkima#SUYg-!O{%VnZWBsrC@Y-7I~Uq^eXb|KXBV z1n5G&S<7nDRg7?Oj&P}d!nI6_&<3@&9yA30gULvEQFiMTz7>6K8JHK-73#1nSwvl*0i?e<}V|EIjGxE>RGY z#f~N^_rZdndEa=&(+??{va0@J5t9y&T+k(vUa3_~#KeX#mzjGr=L!#XEQ93$&m1r? z_&bSLf|;Wui_epbxI-$me)i}`Jz8yM#y2u*AfP5lGHYGGv zJF-wqs%PUq#B9)g^Kyyq;Xd>}@_3+wi0t$mk&?0(!+*Vn8$pn=t??m-r0QG>b0l}T zp4G!2=E}?tOY3rBVTsxTn-$OiA5h%81m%3Lk8UEiBiL}<_(hKRFU%?j5vY!|eMQ6V zFp`)lyyOQ747Kc;wCpp(6o@$Ggm;ukWEom?CZ)vSO`6G2TY8?Gngml;&W=oBQ z3aKObPO?q~)h^j`k?Uiu&DgEGHQC2SmPDkIyxAZg*oqR`g-~(=dzcz|iDX)rh|2LuxGLhwsX7W8&1nRF5kcO#uqLO#U#?i;tx1wGskXLQmafqMa)D;ijy*Vd8RKLAYe}Hp~H2HoKd8=9eKL<#u_GbLy2$J8d2IMEAOn=36F9*^QQT%nkxMBbL zeadJc7qUf!esrps75hX;AD^0@tv>5E$@&O=I9>FWjN5XhN_p#>8vq0A>kx)!FQ9Gh z3f*9ff&Z^It>?%C?P<(sIk*Q5y;j}Uf&b@Wvc*EJf7f4kq7uUuX-_$>>1znk=G!*uNByPLG2x_LkJ1^#Nwjp|1ztx#LU z(+I4n_^hF^JvTAH57+UgNBr3F`RVAGquXTiuKo;%*RDuc9)C|{9~+gvH?1}O46i4r z8IPR%TZz?N<{E|IuYKlK^quRT=xLKb8q%Tb(X7U6rHBkN(>!&om^eEvZNu=0X8>H% zUFHRz5Dg$PWMdkZ{8`sBd^@$yZP(c)`s&)^pB)M-f3X01B|b2)RI*~95+Eki2^>EY z^lCiHGgYal{J|a0eZ6eYyIyBh@Eat$7W3ji7n3%`Bvvn?>Jn&-(oZwzJC9-w>I9gv z97XcLeRkg|Ru-Je?QRXX0$eVtPC&g*?mJ`GLB9p7V0C8_$y%(9nzztaFPcl&-A`mi^eCgm#cA!7`{ypWQnJTT5ho7XE`wV117nEJb znOJzFkMqury{kN<-aRO_2#sIeYQ*XQ46y(U9b6b|zJo^#@1OG}+jzCjCj__hMwY+U zL*~RPh&Zd;(kv#AL$o+g+JPzGg|XRgbS#=B%Pa`FH{W8A679Rtwbf}{@~6oW(>T#QD3$FNwO|%VAtAGjDx^+xL|!7an{`geCBw z?!GT7`*ZIkfQ8OtA!JNLwm*EHUAuVDb7zWN&4a|=Dt$GMsStl({G*BmdOF)$#{fFH zIX;s*HmR}|Kva9d$KRb`?; z5Fg&hL(ZZ=j);P~Hs+sqJD-lPi+YA^1Vz=%@m4l#iJ1S_Gv1X{t@$ z5a91K5FAdl`&&w8iE#Wgx6nYx=ZeOLV(_+AUp>tOA=`ZcsStSfWavtLE_aSuRmJ&3ESJ%V7Sj2? zIcTIN>maQ%iHHt@mlO9x4%N;Cm*lV~mpN2Ey>bn173%O|l!2alxbluV{Th>sR&53X z!fq)2G5EP6J?DA%Zm(`_A)yXGx}FqW-o6^$UwMK6m%m;Z;N!Bwa@<5b;cpQVFwi&^ zX-H3F$iST4{4`eZggmbw`NfN7S+MEB<0IxEFbhGAzTv8>PaPm}`6%RxA&31SC{lqu z{_~fGB_m_r49W7NJ3;Hry{NGDJyLgQ1u!?VMU{|IL@OHic9*oE=V+D1WX zSdSYBKzd+n^V7kN4?&9|Mqh%29u6yZoGR^I!N)Ao7LUz!N|3 z?!-anP06i6{E>UoyYJk%D4bDFgkrghIejD8$phEXkqi{=C2`0R*Pu7o44_)6dVIUkIh=XXc zjEIWi9cGeifQ)Fg4c7#V&StmVbb2E0zXP+Zf=%N{vAaw3pQHe#Trwndm(V$ z#gaf0vSUqB7~(G(_G#ZEEBr=7=W!7GiU0;{5>Iqt6eUOkxhPT=OG@`HMcXh90#s|k z#1gM9yjfqQU1w!Xp38UC81Mzv6(U!?_l-~}u^N(CIFB5TX=BGuG@I_(^L+Cz3Yo-~ z!4ottK!dV!VoS(uhT;l@?Ya>@FK3IHDe{T+opL(en%I&;Hs1aSM7h%N;pRP>ThBHi zDqBOa(s;R~N=48apO+h^8X3AEIZ*hk6{I75gl<+%D+Q_@3QrAoi;mIA2*n#pmLcOE zP8*T4mBqbEMF+}j(Z!VkWbc%JWFnlO{kZ(&4}|kPK`<)+p5ywWm)CA|ninreER9=p zDyYg-SyvRI;hB#D2yDFm>KJs``1r@ju-pM7{W9GHrelHb6g2Qvs%Xhg98#=_F(;W9 z@x~IL%Cva*Z?Y$SN6w^9Au(um)|EkFzcL{Y(_6b|S9oLCy~s=qn97GCCXS==>Vrqb zgG`)_lnAhPUuvS3!Zd^qrj(Rp)9{KdTZjSxuFC2YwYo}#yM`N?-{NB?ZX4Lu=I&NY z1RI?asNa!y_E}<@;ZVh1IzUHBFtyA=Qk)DA(FTs<*$%+ujSmqKZaw7U)WHu6D)w7w zGRpQ*lWh}~Wjt$!TrvOifzy{HXkRm<=WCR$4LPaEoh(SG!ML zb=jX}NMtQ^Hf%O?Eio{gifPouTy{wkKi)SVI6j=&ra-|EwC+RA0JLt=Kjwp849H?I zPY&(%la5u#X)tCI-(VXK6__Z;pLTQr_>UZp18zkXM-cwU@+dC`wm;)iY*8L5gEV=$ zW$II~*)OWtK5Dfi(Ihd_Uy2QXpR1tfs$*Dy5!&ow*s#q%;uxks#=UE8Kvo`9v(ssW#hnc`H)k->b{FCv+`qz^qdI&64O?e*b^6VgWP&Bf2sWyKpwfP z{(a~q(JUw#z73HGWO_Kh4N^bl>G{^VraX#bzgK>&u?-WU58;{}U;Bi!fW>U%6tV~` zeJ0~JCDX1}r91oPIxu!af%4)8{18$5OS+~xr|XLQgPctV$^;?OPsG!@OpQ@z`BiTz zqG>J9YAyjTO~_w7m)AspJ+ku`xFkNjSyQapM$ZB8qCEsfb~Ge7F!zn;>`;K^#f8bk zP>9Gn7swY|M3T8PgbRk5EaJ#XG9%fygL{*cN)O1m+Y+a_1w|Ba6AhNA_GHWCsoBu@ zAT4+`L&O0r11;*A0%(HW0KLCDKlth6H)?rDUVqXc9I&Uz@+;%|Ddz7v{mbr1Zi9(Z z=bCW}Bs61)cET!V;d^$lXHA+BT=47*>G9ZZh9h3L*`$M4GkadAIaw(Vb;n$a3wBLu zc2p^iF&FmtP=SKt#s~OPX%-dxJDb$vP*&jY!v$FgTs;Ma!bCem z+K)~u#bg!?`-nMV{a6k6>~ z3Umc<5yPD9%PeXpItpA-7=NGV<(En=Q*Hn#Z`urSj?LegCPlRd-b<+YLmE-cLJhVV zdjC%T1#TBTL->!0=D!kkvoNzT{omW2(tll>%`v#%Q;jq9D(mIVTZxwz`Sr@91~sZ# zx)e}}BHmas=k%gKJb(EGIo63w?WK31l5|!;e4u7w zbij=ffhyX!O&T&0Yh!pV`@O}dOY`+*8({mfhH)@T^@X^GADqfe8p7qSA#04YhrnPZ z8ts~>warje$zSX9mu7Zj(TzgoFc*pNSq%t7gnO-J<99THmO6n2!23Wwf2z_+A~Tt) z@QqPYSu}894@H&^TTXER4rdF9wFcg&C8ro*zi{GSfMp~PE09}Z`@oGY1eO`3j~aTM z0&$oM$-#YE$p2h<++U@7zF)Yjzp1j(#|g|dsG`H_y>6zy7;C_efuGbYA!x<~&8zm! zj|HBJ$wRHh-d$kk?jwyj_-yObO^>2C)%E_vE{r4mYVzM-mv*55ukq9p3D_|M0idquq3VusR%o2WK%ODvJ9!|E1l zeL<4*@cGwE+m547i(bO7aw^=hx{=Zek+-i_d-uWo4L@X0xMxncLt^%~A*xoYem;no zoT62vS2unyo{0n07d5-fZyx{R7{8eD_{t(`A@FOpz+VPBU)v7*3YJ6x&34^&*ejMf zdfUEIJnf_#XQ3X=SY3C{TL@r_{eAVHL@lD zS&!;WA^x-mE}Pi?1*75SKe5;B=Kn@q5MMW4t7th4-^lov05)H+42_eg$AKZ&)Z{ib zAQ!|-*nmH%9nR$^VgP*LIg0&zNzelc)l}jL3$?K8z;$*ia2!4r8>vfJ+!TZzOU1gB z>0Yx!GGGJ@q!QObblTsMMaV#Itm}c|9XE)bjtotfru{g5Ize4pTb!mQV!3V2hJrOO zw(udT7e&^+%XnqCZ9?{`vRkp4GB+TjDvF~;88R7_i~z4npD_;9{rSoAmqdB^=T&bL z+DLFj=irar^JDwX6V-3;x@}1s1550WG z>u6u-o$HikPrIfU+;GE4ryRM`$}YbgbBWU91$?<)L!<}YRw0BrZ6V@Wul8F-CBE85 z`sC6gWP$ye84@E>dy@ucI)nZ~v_7o58iNC^d@;r5n5$KqInroixdARO#ZvpeviyLJ znYgr{HSKvEmXAhEV@I4s%*u#JqfqTntouv(j6}w2{p^7Lpfn9IWpNWSC_EU+w(!rU zMX2N;(==`~{ZxGP)c1FSMnN{wk1Mb9{s$x8pmqO z57Rd#ZApP3Fd6F~3kO|^AlHw(l|m#WzT(i3s~_h*?|WlF0mQ5vl{yMk+{^b9(ipgy zZaxs#g6KZ7VFlthC)M6ng@H*axX2b;qn~>yPFZj3p;PA(9t8~x7Ge*4hS2tT+gTxr z-i&nc;q%-F{WeYeQ-|~9&qHn|v0UVuw$yNcAD5NvV+L;%E@I$&f`(nb&mjyfl5waF ziNovp(IA{Q&8Ff+%guba`a`{wtjr8oS-VQDSL7dC&RNS@HthKCKIV}uO@GNCwTqW^X&^ROe% z`jeB@iH3st`Y9)l<=NTV&PaH|0^ZT1m?ky2s9OrpbO|*y9d%_=;6y!+VpJd5iCNJ& z=01Sd;QS7x&&UrPTj&)Ho|HM@1`%_ALbMT3nRRI%8^!t!uA|58kiZFxNrG=cZX5+*-V^$Rl+T)RX}3+Vqr_bHUIpdxocPacTTq#4vt_&KB8jhd8gmURY{iAO zDeJg>UV5J#vrhX&%Djw?fnu4DIl({>D~u6)Kp8dMp5T&_Zx1pTJzAzf-zMnCKYjCU zKKyd_&XIe$X4Ma$_WR$y2^U#C#h3dUY5$CKFeDOvWEL=BgwM+BWGCkz73(!94;tjb z3|Dj!9dJJ8>i`2&`4|T7S^nGY&hlPHEyM`IZ=yknQf=^*3Bi%_6{{TqZa&n96@`Vp z>XOFzr0K*oovaM@L0=3Oij>_Yhw-nYzC;Hs_kt1canlm)gmt==&RF#pxiPT&wv(Q8 z^oSgUvLBDR{<#Ib3+)q@agr4EZ^>a3K-M%uIx@D`)R@}jmS76sR@#C03OHb0b~E=v zZ~0w6Qqz(|J59+LE2xmRHHF+Q8cY&i!e*i8CQJH4WKJOdFIH&IiE}1CRK`56 zvCi3MRJJK`!a4F#tiU^2%{38*SqX4x(9V^UajDY4-J8VhkkR>80rVzEF@@PTT!d<) z0x!NKzd!{hK1>Kv1I`-$MPRiCx9{TgdrFXuWrBI}w(+trPkn}Vn9&tZSx?wGj{N1} z{LNxBq9n+$F63B5N6bI@KmfvkcqJQ+JM5^z7ov_-(@ z22<>1hvL8>SlRgezWW-pD1tXlaXmH<&$<@m%~L`Qb6I&?fyCC7dfy?C+`#(kpmxr* zw3ow7aiwg3Z9ps(Xn6?QG7sAVyq}ij?e{{iuM){|-qC zNeOrL@7QjB_V7yu(eA`g8v%iKRxJsFtRnId34e{47t{ENc9wn&1RBpGZV?KuSN~qn zR#WDxg?=FX*`+IJ;GS^mHw3UpivH-^NMbaDUCClrW^C-~wi^MduD}Zf{+j}=&YY<7 zNdla7?i=^?(^^Rx0$f|5px#J{Ug9xN6Enve^Bqjy;UQ()vsLlK#_1TfDL%^iVdKvO z_e(@+>}JOYb_6Hz2HXn#qtwq@q8xA#aeS7}-lS{Nap`0S)1D~7j6eL~R|jl;enf)* z9LStk{B3TeE>1|al(GRMPmIXOoGF5_vUs2|r}!i&_xX6F6r2P9{zV2xd4pLW9JWxH z(@prV4WaWXm;fAlC(Ox|ZC8RG#TkZsN2hOy!{>QGp{Qa`UvJyG8sIZqZ=|!)uOuyV zkJGb!ly^9$z3KAu`d!go^OzdXT2qsu<2U`61a`E6=g&bL04iwpj_cDpLi?C3_Z;MK z^gwFt78fCTjikp!Nc@=|bwEg3b@4F`sg5v#V5kh0G5$HGcv#%Xzng{P7 zdskJL_wl+oziUm-#~D%BV`8JjQis2RHkD75p6WhIFOJ*I2uI-EH5k|HvZJ(Q&iT<3{G_GHy=7mN-7*~|q2X8$ZOSsb01NY+T6)p{-L>tXq$^-yR_Aru2fM5i>k zuiJ-Ze*YOvuly#05e?XNZQNn-_to_Mn@(pb9ook+nw7xdpo&RG-5n%QD*#_v8+|l?3{EI)`x{bVA1g~9M z%xSRU7tz#Gl!RE*(-sHmvZ%wP zQk5EG6fUSq(24r7_@|*3LB^|eWO5TKskY+E=NkUn+C|;S;6J)-3QPyWh?UN-QFUw; zo`JWR3gL^u9t%ubrpb;c?*zs*kOL(YpAb;WHaNs-1tn#xeFVRmmMMIpSKc&jKK(5z zav1ZXqZz|$c0A#8^ z+zw;0NRc%5=Zze&7GY`l@$Ntf`0nl>e^QyLE{h>(_NW!~`!!m1T3u3pS|sEIx*ogy z-b05$wig|~@-t1zlw>=><sdFih)!MZ()dhon0^J3_w*E4wezLr+w*4tFKK1y1eRV9(>& z91=G(EnbY2jlphs30(SajGS)2)&6#Nlqm0@p_3Z=l*qN+*El)@KHe`dQr^acVa0rA z?_iP7FNaqoISX&(k5y;%^@bPgm81%kP2Jr3-UY62mhQV^=$!J5A}>K|*aDmL`>KOJ z=z5iL@|OqXJAuPg~Rbg&q6RoQq~?PfU& zbhqTwPXmq590j*wo;Ls8uuG}I)l>)VpAXA`bbB+bj4+VJGLGYHBy>@T!UFf4@NHmL z1akO(aTN4HVoxK@7X2LOK%`;RKs&p!pR;~72b&nmP2zujqj#t?l+a3KM=mJdOhK#Y zuta_eiU~t(AUxn&@q3Iw4e~WNpp|nv&4+7Tk$Q?O+E;BsL$LKH+0`%6l9*y2oo->8 zB{|~rh&GWk`;6iFoTAWU4{}uK@z{7GhQ!*ojIE*8L6AUC`tFInXHI%5PbLr~=);SM zL+nDHU||5of+If&gp6_pmH7P7c$7&8lNi;r)5_03as6q(537vRKu3Gzj5g{)irf+r zBd(V(Gm3cu`XRsVAJ=6>iBK-1LgQv3aCoM9dZy!bFat9aWG{Kj$3Iu*)U^8;xI`F* z|3)7uBoJLPEcM;g;;=>KPecA*91jrHIJAfhmD7J0bsp*+Y9?_f%HO2UAiZYtLIVI& zb$F(-Hlc=gPk=o)xn9#OC06AnaL!8}zx1cvWQD>!ulBjr=rtv`#$ zKRUs3@TCGUQV*pAA2N_^hf`}~clJh^LgJ$4m{5gnth1Eq771?+ajU9^xLTGFn$7A^ z;QQ6Me7mZTF0qofq@F?9JyvTx_`T7J`k%E2Tn&W64?Oai>tv(UQE2`O=hGgLzd5TP_FMc43IQp%=ZHN^ei z=egXRA)!OP@_7H4J8MiV-Zm%EGny=_?f~A})j6zs;IgL1S;D_8hVd1-`q<12XMEJ= zh^R}elIPsFs7=5GShNR=H_^I+r-*qARu1&W9l_&1^5D;c6Z$xHfgm%Ob&_hx;yj*% z!)z?!F#Fm1Y`TMbk)$4t(q8ap;!F!b%#6jriOHmUf+$peLF5PTlo3bf11nYjz(X3jLH41FLeYu+1=PFl}`SIE(6Z{S~jZmB`M!dM%_Liabx| zQLIe3dCwd3zg9?yr756yFO4j)eR4W7flB`uWAD%=N}z4orfpk0ZQHhObEj?Fwr$(C zZQFKc?Ngn1>wTwje?YXNGh@bFV}t32z1?}e z)lxHR*j3{n#776EJP1Ds&PeGZ#pis+kZ8it{6z=Z^S}HYoLZyqT0isIRynfugPpU((i!G5O-7lgpb? z94?x9D0y&!yy0O)Pw9$HpY)tlx0Rx0&~i|K`4Bk&JOQ6C{9_3={=&GwdTn%mlf#O&psVI%H8EO=V^4E@n)bZaziGqg$RQuZ1&M8f zvE=yq&{}MjatPY5=_(ZNZRYi=WunL@+KGYNyAbo26bc2;e@Yf^YEM+MX6 z%o=%(%H&d3iKV6K+p>-gKy^GU(rk7>pv(V^-Yz@!!T_J$Jq((!reFjuh4$3Tk+;5{z4fPGL4Z4U}_QVTBFs^I-heV%5o=i}mlI zl6*kJ#u_MR2-q*cfn2-m94w7-tRua1YBrA;>g}*=d!xl>j{GxSD;nS((E2YzfQS&< zA9o1y5(DJQXV5hR^X+$j>k1OpvZB_q6Z*}1MF2q|yO-3(TBz7@9hT^;U;xQqhA9ZB zg&N7o%il|XXh#Y*GqM#>GM(evC@JnQGQV`iqrb12N=i2}Kp}@ZmlmgSoPwjr3%^HH zznL$lQ^#9&qofqV0p%#aFLiJ4a=)OFHb!^}EFAx{>HkO7irpMT{MYnD zcox7^PWvQ6AH`80OoIWU`A2Ira>yfz70|>pO1Lw2`tquL8!FjYjtJC^z?H6F-FSFE zt2|frRGm?V{$C$RYOTxZaxP!ZPPZ9VMj|8K`NiR31RB+Z1VzO1=yz{JZp^Yt)#r1F zV-Cafp~s(~F&|#%LHXy|OJCowP07B|CjB~kAAU!H>ATKXB3+lmQfpxeD9Wj$!SikupFhFNd#^UHjjRcSLL7FJwp6XO5; zrmLkLH8nfEwi~FwsKkZfTB|n-4%Az%8nfh5gcWMt>D#L*AMuC{9GIYw!%q;jl9c5B zvmE4^-YMc=4c1#yd>o`udsN>Dj`dlAi`VV$lAYXmoAu+1feO#Aa&gs= z;=aOioyG}F2SF43IY99sbe+V6ce%tW7_Y7HIt?(XG)MXcuk6;KgmxUB=n7nUge3vY5^<&MYvsl`OEyri}ctyn9v!cV)H|Ysi6T!=&|I=%yVAZL#h&VyKb^>AWaTr5kLJn}3mDa87^T={S`0VJwRw10) z({kj`P#G$Zw`p}a!j`v3K-vbTK46`JNjxkUvL;+85?5u`7y+XwtBp$W)c`>*!%IN( zX}-7wV%9_b<*Y=h@%(%CnzeHcIR2kK80|I;`|w(s3#|bV*1;5x0b3A3r634*EJSlS zuRM82ar$|KKC*l)_Cnex*YXe%OW$P6h57-gx?Jj0j9bRO>eefR-_xBe%k3edD>H;D1Uyge) zX-g+G!Fa(VSNMv6v2va-<_EFIt$J+Nn3>1aW;QUdJ;c$=PeqfF6DL<4fj}y)iMgTA0 zV6`$!y59M!?njL)NHfke?cyF~%6xzK4QaX|yt05+Jhj;Htdqb@rWhZ3e8$SnVZTwQ z9HjfZcS~gR`SS?_;8qR`{IYTdG2k=EN!Ba3!-AJbvA$7GhJhH**;?O|gMZQ-PO zv>XdBKtS9$bZ77YDX#e{^Gtl75;q~s^Oj|`zd_)?UsitJx7Br0`le9&?rx?PKn-Gk z)44)M06s0L7R}VtUN^<-c$uRalj!Gw=0tbOn6T+n3Q8wcqfHI*V^@;+Y|sIKd;Z?i zvkZU@A%E6_ztpph;Sq;aV1*KPpc5Us8ldT0ME9jy_PF`c7unEGV_h+!f zmwtjCfYj(3`c2QR7bkd>KXBfZYq7ycPY7K?w31!)Me7hge2nss#2y$H?BLg6t54g# zOVkz_n@*$JOB%m#8rqm`vd{45SwlQRk1{>IaHv-Rh=`Kxz(!5FyUPD`{N|>nhsAmu zOS`(&hX7N1*UYYQ_8=jcQQmom0Cbe(p#qEDUI)D|X8byN)U2rDq!zMDnoaEvT;RBz zJ_qUv$PL=K4W>kNc#gUs$bdcrs7%S%b~-wKBwn;`9|MW}B3RWpjQy*B@2&&!OG=DWt{IFGSxIT(%;jZ&^QdGVW?Llje|V-GNqi!vd8)*P6_f=iNMsQy#jHE2pc3j zG%&aXsFniKGkRhk0A$8;S*@hp?yRG9nIAmEh-7epvtoPzU0|O*{txgWw2zoW$4E_l( z5GVlwWSaRX5u6xV=e2_*=a;CgPZ5h{?Wn156LD_4yhz;0?7|fgx?SLB5hAZKWM>-f z*kHj1S=Mt7dGVPw7Mc)xOEkDd z%dscxf=PX;%*LoYHyNs;#;^oWFPkovFyM%qQV2;47#xz&wGyr0LS70fF`~@<;D(f( zjYCx)kqzF?%}R-hn~qG~Ed@~N#6z8(9}}s9rncmc!Av|+$KPqtHW1GW5DX!Dn>a#? zF66DF6p^4TXp&=cH%Z+X>aQA-?i$eHbkB}1d}fJfAdgvb1Do@%Yd2<}ZCpgeK;_G1 z^G)txXS6RS;6C=Q|0eVGG3P*q={)_0ju>B6Bb(c}Vkm<)vSHd_K|=a+fKjH^-tKzr z%YC3$^?S9;+Hru6F`qZ~)vq=>b!T`vN4rV@3KpemSyga@3=qLh&277sUO{(BD0CB3 z-R*HFoX#5#hw`b1e=hV*;Lpa*<&iZ>mQM$GMK86snrxSC{*w|v&xAXbry|(M{IB|& zAQ)U$AdqbwM85=7jC#JFR9DGl_N9K8z~&FwPu9$L7==VK8d4$Vr)giwP%~zNF9N?m zyDXdFqW9P}!$TM)=X}~b#UhbISZY^VpG|%>pffb=bf$Qh5dqOwn%Bq_m0mJW{uwGG zB)QOAK)X&!;zL)X>&<#zk|Z$STnWZDO9M@K&G*0QuKrEaD_3j-uw_P((5co(f} z{w5mRYfiy*xG6W3@`1P#k3=cZiXqUVu7@t3@cWd#GVe_XyY;w`+f~A3;}ps7jeSv0X<){heMYO_mINl5039fI98ixavOI zIdHD^_|x=YrQ9vST+`x2?^7k(=g&_jg3$%q-9mc3w7(DGe?bq4e_8))9R6Pk${Cqh znE#(RtnqL7()OP?T;@*{9bh1sJ@a;QV=y=!B9%g7 z>gf8$a$rx?(!2fb{ijG@Q_2lD)c51=w%7U}YnHqg-sy1_{x?69k4szXE8xk4ybYev-zi_9z<4}_UZt^A}3Nxo|`0<)Ho}03TC_2Xd+kD-nv^d=7M{}(d z&lg2uXMWkon=@HtJy-Xvy$aqW{`H05iurrKW!A)Om&5+nSK+Z5s#qPWl{%(9QCn4x z3>xaiU60lIbXOy7R6M2R+?1^+u{FhbIeIrS2{Tc0@PznqLdNp?)N!4&S{UaUR@dFB zuA9aKYw~kPRnA+icP@&(V$3r1VV|T4FlU&0x!hG!L*?{y_ zoLx%!M9+F-?*TG#4>?2eFKXG!idH z*wowm-^+o4e@xwi6aShWa+B|{*>oo87`1n@C_*W@?e@OXKfLGT#-C|q!Hz|GRn1Kk z?Y!z=^)28bHByD&KZET9EI0c)>aEu$YVwC}`IKvzrwP^Tx7`#8?G!GOOb|#mX<^eu zP1;w9s(_K7tE3t%&>C1*sg$y*{0hNbq`(BED=)7ATZ+7F_j~zg^Vni(S8>2Cu43n8_H?WByLWa2R&_oU};~Q zv5#hXxF`CbW_fZzst8yTH9Ew@Kk_Z8z!iw1clT)El9!_Lt}nLVmQ&ko} z)*ZcdIQOp#EC_$Rx&#P8vc2M?)8`I=hD>j4H*RG~PHomW-ZzgQG8HF+8s14$1aTG40}@`t`{*P>KLRj0ZR96L;%-h^*Im0x4lk*+~mZPDEza& zge@784u7D-y(oL^Huc1~>!5F5&?q8WI5{=IlkZ}Xvloie>R$sgaG>Fl+B>N5;)SEN zk1{~q89?c^YHBPtTTx=0vH)xvk_aQ0#VLisede*5j(1D?28D=YsprkEFDc-+&C9ZN zaqcX)FUfj^4W2zB%E#IGe;gf`7lu;eH*yyb&{#{!?I7^Ty6t%Q2C-(BP^WN0r1wXg zuRS0!yDAEeYcwR}2HZ{gH)Nm!3r%|m*pAUUvuYlQqys z!QQp)E;I(hrrkkNn72J0!Sl=c`=>lN*;?<&J(`G?Ck)*O`P(#sSPC4{zUc?mVTcW= zNA=1Z%0#}QS9FoQpiwjJIhisdI~^g^_)Jji>P+veS;7hOsws_2u%qlM`Tm`WmF-@- zl~&Shk0-jtAsp@xH#7`G@_cBKB~t{f^2`~dZyv<$a)Sishx_Yu+N}8o(!YfWZsxdZ z=)5F-{pxt)k?2~J;(iw2gW6at)S_>}?Sy1@z>(E~Gyd+d8RN&57oz943A~Z=+x(Qa zI9&QQ?;jxMs&3;(fe&0$3K)80hdYl;>gg0Z54la@BEH%_+|5?q+Azt?{Fz#N2Q%oHz=y^uDOY{Y9FCtxjg- zb{IJ@&H_1Hn*0!dVPGmDu>PTYq&2haYOEafqpOI@9%m0mg%aAV~u2tp>|vLM%ABF>R6{1xlkil4kh2x|z6-%hvE*OZ{UYVVSt}_4qx7e! z>WNwYKAEBR?A$oGw8g#3x2hMJDJRA)V9mLXMnD_v+v-*f{|pKt9bJteIWozFC^ML! z{+GmT0LDI<&z1_xoDpJ62V?#JkBk z@3M0TJD-V zeW3{$18310x1VmmdP(hIV}i7uI|=va*Zl$Yi5OgvsX@k_G1OuZ6_iq!{S{md+aQYO z()`S&0%acU)W_QEzLKzcdN3vw(O=FjHR7mPnMsqO!U>aWm0q;_^2)GXlzXeG+zd2= zwMJq9<}@tZqaBnxw@V=2XTaMqSD8mOU_1|p>gQ`ebkb~4?uiUp2>ox0z5CLxLIoH% zFFYW;QB@#ahVr2!+zXFy%nPZxYcQzt4uw4Zn4Tza&32vBjHV;>mB!@5Y5>$&CJGdcZUQ}LnHacE`S~P8JHv!Iyj_3EAdrKF$>sdkI z1;s(6!kwP@ez%`F!(--M;&lk?8odkE4U)Th$%JwCRb|k@GDK<{OfaWz2^)Q$V!Cyi zO&H@qf^TJ)-_gcR>?{}3s{<`e<^rFYuFc_q)%bZYuJ|g1^|WFmgakRP3u7(AMymvW z0+T=VU;b-a?0@o%O9Ep=&V^ALP3uWW>9ZF-3umy}x6e-XO?f1uOfqztdBQ za7X1>y&4RAYfBj+UcdhS?a1-L_H;_S^>k{p0%*=#{V~5+D#pH_?!9a*7cPYYxIcjS zj9CA=ADjILW%<7GZJb(t{;$dFf9EBpXZe37$IJf%C_@ZxCE67sox4Clp@>2rFr`Hb zkEO*`SViORygvT4`g%t>A+^!iX&zw+PL*CT=E%3pv2^kcW-Iv?%7*IS>(Iz&{o~U5 zej?V;Poh{nklERaP0f}@G<m4PVbEEageL6Oxy>*V(To3owZzx9uD@&a zZkSR)(3j|T<7JpXCt_%HosWwy(uCpZ>02(LCp|+|R;4303^$*TE@H;>Z6a=65Vdh@ zSAN`6)1SBvPf?#VbkJ^zhj#}N6rza3$$#uUD#$vuxHc}ga5s_X?D!=X>>>H~o^fm9 zoB{wBHobYCg;Hh~64Ua)nS{ejOJ!;D<9h0mX97*9>e-~}_?c^|K{IZ{B9=)L2r*a2 z>`2>w_Sq|e%!C?Wi7rOUZ(drL{A-z{C~fgyMSjs#M;NDB_rnlRPHtkK*-KQ3fgtm@ zs&1#F@c*SywlGK)>m0VURPm%ddQg;rEIE3?_#}h9ws(_9$B8!%p#TOZIVeM#51&hj zn*^SmT6E5-c_f-?r5zDCNQG!rD zsW65i3=_J|MczS-EXcA29D*~G`~jorSNJ0SGYAE;1RNNJP7q%5oj1OUBlL6&?pghM zd%B`dK2>qO_Sw!0gh~HyLS>OplOAq}b>YJJn(Ud0?#Xjrj(5Rx)ajD7@vZj^jQZmJ zkFjFgWIHk+GoVzcCgxD2Dg;Qo!}`puRUy8=pyOD_mwC8`QOihu5RhgCDZprPr!KE7 z;mpJd068(s*bhBcryZv*K7w)Ko(!QhTlkv z*=1o2_sTpCa|fgeyK|Ya>5LyzS1K%S&Q&8Uu+8#^krENuyN$a-t@icyVw6}sZ?89C z$N_jGddn|Y>Dxw17%W9!xP8~yiz8ip3BO-3ZBOKJbUiQ8fU$f(PI?&!@i@31NoO@M zA%OtckWrwCn2KhI`bHfxevv<@JN|~f1%8zHQZZjr+Xg<~9B=c6;rI!lOqjq8FLS${ z74FGqQY1c}4qdGt!hpb6S4ThI#qzQ+`tRxEo?tP_&0Nf>$A(oi_j-J}?%StyQ9~c& zH4X(?(q16%t4~?1V}jb44C+W~d5%ue2k3;C(m)zR4z@(CDa2#286f`kx!do zm2&ISU`>VCkJ_@36NW0qbJK54Y0E7R3MSsE60+wmqQg;YnKWU*dNUM+4OLYG34#)J zi9vH40E(W7<`#nluVLgkbW4JrHn=GMM(4*;6lPMBvg0-(q$=bXTT9QApnO9xKa9ci zo=ww1Gc(&C*1^H)xhlL8u!ViUXF-r3{2y$+@s7mdDFp08xA0FFb;;R|J+WTZU3-j2{b=e+wpi z3tM{^`|wl9zMBWM&||VXwG$1ad7E^7Aa12{S}6b6K*+V@^W^Jnr@GMu-AJ4c+9w63 zjmw6Ap#b&LLRh0sjGzI4fCpc1D=lW#WA3!Nh$fIxu<=;agAniu>vajcs8TBg1#+iGeVen;iZ1d}vb4rtUf`5~LnPi9pIT$^22{l1iy)%LWIe&oRT?AeeY%c}9 zC!Z?~f_~%lRb)Yx!+2c2rnyW49H6gj>vVx_Lq45OdHZK%Ws3DR)T82hZf$n3=l#Mb zGV6Q5R8X1f^P6`40C-rLS-#oMMN1z*Sp9gHyE#@4kKaILX;fh~rRZsB6aSpHkXZkZ zPrgqMZ!j1@JP6%EK*PLS&d$|)IqWlXTvM%>m#7zrC*{;BMB2BqbPgyD!C zKmi%=jclbNWp+hLQj&o9`HO{i+omNwZwEizUuQ6T#)EP#=q-E#b_}%=co~o-L1P+o z2Wz1^NX?I=k2R;3%tECQE3Ym~wJ}N)Crg8tLZ8hdTmFNB0I+IrxJuNc<4O->5&@F- zs>GC@>r{N8;y>`I=}c4_gep1((w_-8I~O~3(IrdFteGED zeI>$*%4`$Lh=%{D{N}+E#mvjjIwFSd=d5*bJsxXMI8-`D=>~CmaI+ubA>|(zN|ho! z9>f%o-+SL%Fm!SF{mDh-j>(I%5d74aIR}f?mU}G4!_5;wPwMW_AJ3&(l)elVIMy0N z4JL?SV&uSk-;NUnm-T@u9emV@^+spBuVEmCDp-3_#~ynhK}eIsf~lOp2N-bsbCS&e zj)hNB(}P1Bo8)XN1}jR+X)6xQ8QgzoezIm?GR6;()M@z=W2X}6Q|Z4XWrd3@tbBJjH;m&n&cs5&F*O7Q4oi3kJ3Lfudd>vgyWcQ4PgaGkfN$fx+`=9x7*;5>%0*^;cj?1kB?UenCG6 z)L%`cXZ+bWSY|t#R$D!{!z|!1OW5JMmt;FDBordpX_7H%08{z^+0qX+);Mi_N#bjb zqAg@psIE7Y7dOl%aNu-Sd6yyr#?OSKp`-5=dEq(Xe7+X*ujR;TeEa624%i#9$RUOW z*!`1l=v$HeEJjQrLfez;I4gKBOb6mP$YDd3PPXS%vA>f*UC)}qTFoDQLX-!Z5!qhM zhpXw=D!F!>jLmB%nxQvW-!GiU#9Q$H!cP!Hx78Lol^=1s3K{VtIY3hL5(byvb7XQM z5%}Alzp+-kzFsMJ3U1c!&E%{Oaq1Vt-^BbR`gL4(f*Oc8NRd&4M=P#R)EH>`MM ze;lIcZ0|+Z28K=e;1Um&W}O_c->0ceA18P)VPL~E z{Pz&TNBTQNig#LR8YUuxQ3%(nC+?Z7s9*qlW0yKn76^J7PR3Mx-TP_j$ihkV5RwXM{EuiT%jD z!7uo~ClREd#m$Drlow@Rco)L2$fvi(s84Hf*AM;6 zsD_w8h%=YV>14|g8!rbT)9>hm|~gC5We0dL!dYInOuzx9p9_qD7H8^-VHIUIEHib*=-zr(QQ z1(}T72a+MP^cVHv8(QTXAUILq7S6IA;?Ofr;1?avhM@e&5ojNL)YCp~n_pk4zX0Ky zXnX(dlY!-bsmo>f|1l`H6SGDTeP{Iqj>DzG5g*6n*u-KKCADiDwuk9B`RuOF;39)j z>k?*aCU$df-t`Swu5_w~C^|u)h2-SqUTb}~9mhk1NIAa55(D~w-4$;Wd$)+`^csUs zil(G8wz{OsWXZ{j=fyWcI|Yc&$+`C;vw%#gh@+I?Q59xtnUF}Z5U;fiKDE-b-}>QXZj%_gMQOdeUR z)W{}#QEwGM(2hb3U625?B2b(>kH}})y%cby{XwFlmYz2u(d7EgJz+_Y0)5bGmW4{722$LVfN-mVxrkBc6b%uacJY8%t$EgVcq3k8d}yt z@)wCJpvuy`qH|^FMM-{OQh)E5*VKFo#+t`;kKk?#CcRO^sW6B@6Ot}WSSJ)cYpekv zGfCLb<&t9BW>Mzr<<=);d6G!ZwgxI0&V0fW-5HxgLIKRA?Dt|tqaL7h#8gnq{CE7V ztyk#Y8+)5vR2iaivoeiZhCO$=Mj_#QG|CA1Wxtl~-z$OueR)fw*GNDzlnjJxkbZ$w z%BstnmfJYud?y3~Wry2F8XaE{`QsY-m$O&hYJc=Bfg_E=ZM=V@(MNAP^Q-{XAYk^> zie@6mOd~z8`|MG=vd?yS92Z@XDW zzrdV@#w0x22jK*<>B~yUIkX(eIgwgC==HmYxp@q3g-pR&;4eW=6*MyjcY?op3MMd5lr)#x7ZEb z{#nu)YMag}#WpXq7jQ>(HBcH_GBWK004kZyt6b)r69~#itv2Nj?zpsv>zPpv&IxiE zU4Jem^N{Y|)i8zoTuOz7u zcA}ravvJ5SJ9C{)MaYIVT4+Q`0LDmfB&dwU-lNDkQEG@3nIKN1wnhL2 z#$_q$s^)xS$(#9MUc8oj$gG^$?(5V`uW8hQf+fhW0|mGbIP^(Ig{w*fUIAYxW(%pU_g1ACfh;qHDl!C|1@5f*XKd6ho_a z&dJ#qCLW;arUB!gle)&@l>7?z;xWpHLakRlte!t^fo(D9^?NjPls=f(`1?ipp5 z#u&;H6@na-S{Z&ii@KUt;R2K;I>+MZ{$>G*4ql7=%rtOiz<2Jev}97A-lG4E3)N0isrP8=5&j4$+D3A z%@wce6G4U=Np+tyb2DG?GccuBBK0CRT7|R<6rjO1t zV2n`i3I{5X(V0c5mt1uAQqX!(Ut~tK@A;1^Cqjt{rv{WN%c5w_OtU&z?$Ui6SmPxl zb)HWdPG)7PTOf!;@*H9e^g*Vpk2Ua$QH{5WUS8+M!CX|ojw8|Rgm`YUM$fVwV$@ta zuUkw38K;6;_T)9e_F9t-pdSze?^}`v>`gNb(mqxzsz@oMY4*n}sbrG6#DGiYY%|AO zIzv*(BGR?YHkS~r_a)vMrH|E5l)yHHN_$N&Aigz)vS1I6)g=mEGT>Sgn@W#0Wd?A4 zW+t$@dpWnacd@%AbS2POYI;RUGl(c~Zsechkfj12HuZVpx2sJxM`O2Kp=7=Oit7kD z3<{2*Bz4minXnMa|cPxj5P??yfct4%dn_%i44AikW~=ipEt;WDYV2~JR6o_K$%2HL{o4{ zaX9Gf$flqX(yKbb$j_X!(q1QmwV9uXbw?RrQ%?qay#;>_<|E8{FUX-PhSOjRfck2J zb(K)<4AmGm13)K>YS}FXEJ<_D4yQ%D&(zi?=U0OGq0z9aF#Sm_OT2UOJ{WEWqsG!J zpJ=1o%z0Gg%ra%x%Kx^?bP!!vbXT9`dDOq7)VTacb(&qM#k3d6(+-x=SO$RedO5c9 z)<6$Db@**E0>UIaZG+75mbI;5%OK@ZzF(oE|7%|RPR!P$0;D@)9F>X7in4L{JtnAL z%*ryh^pVXV{$U5xJVnjS*14LhmF$j{E|>81ZTdKKJBKkKZI)@VjO*JGC9`F1xoPG5 zYJfJ65sZM$@p?Aeb;|{j@Cpo9%}yHm@UZc%rRGiYdO!;)`bKnaHHlQKeqAhLbbiUm zT+&?xuFx0k;T(m+P#27=9q$r;+T12`n8QO<^_U>x57Y(hxMxFbvz3W|q&7Y=vqB$0x@~ z*x>$6rV;aK2TXs>6$}^G+v~t>Y_4<`uj7J-I1x$GogG6#2^hXM)wqtx%^K;L%pvypd z&s;@ZdC4rnG}oYvmAjl|`-I_&rLDI7lfE%EW7$pV7w7ov$^AK7Q<58H3JNHSjxlFP z=W`;LqIZG7j>mA`PPG7DiXRj+1%Zyq)k?DohoxgvO@Li#IP}Ix79b=unQ|jo)iHE% zqWNRI?0T9cbO>+f+(~}qh`b8Yp5pay;iEW?Pz$}~2@JZGMgy|x!FQ4hisUGgy_L&VE z^cwaV$Xi1_CceQqix?1wCf89J>Oy3x>PLk+Fc7PPu% zbASn$Q>XezgJP(&hqMS#N^0uKNt8}`y3wp3Yw17yNhA#E0V z`D?w36GVLS2BY=&s`D>b+bW-I$xI)+QAMrZsw=$N(YowjN6Jq;mtZAjX|rC<%n8jJ zR0?IhtBT1#Hg|P9cifxF5`5wXfSl%0C|g=_#&`||?ue>CZIv5FjIC@yF#=GmkJ60w zu>Fw=O6bOUMNBO`3co0E3?^Z7STj+Gl*&kB1P>f;ZB(&n z^Nx_KC9K8y(LzAyY4E$G@nQ%xCkh+wzNH0bo|F>ov7R^mm^VqJZiN^iFg|I2H(j!? zx~*7&Au_PV#Y%a8fK@huNwl9%7t3p|;PxfNnelFKu6npv z4aOI-n5ixspAm6d`L~GFKazo=Tx+X7S+B9dp0`1!1Eo_VGnM%9)DUe!%IAd{U04u< zX$hWckN3Ii$ndWbi)n~kpqUUIG?-tFr_Xa@G;ZG^J?Q%J6{Tm#2|Ybw+L!1J!wR`7s2?1Z^Z|%` zsorU{1@jdHMRm+6isVrH(1x~D_iC_^5G`vNO~#*fI>(#wLc16PvN`Y^oR+3=1H2d^ znNJ6mQ!BF@i&Lw%QJrkYmcj}BlpL=nNCGxa)oM|w!%Petu?5w)O%^3Vk~CPay9vJR z{b6p9oEF_0jo6I`YC||Q zc`tRjp8n1Lq1Ywg43%hT6NxfNBD?X6JMpc=}Lh9ebO*64PPW(jI|G@m0i4 z_grMCY3sA<8ov51#k>CwANiykRjt%lU%UdyxxjEhcBY_xi8J*a0Pm&@fU`SP4Ef>> zM75#sWOd7DGC_skhG_Nj3i)Zizh${ zhv^WT^wr@ajSX~~P00q}r4FUNe8ZM+u5=DY)41bH*zczxkDR@%K}}iz{Os09Kk3hD z66Et|Y(Bod*=JIUBTk+8VgnVVO*XX=Xu>|n@JIrx6l7nM6bfl$0W=>EeGdrc1xK5c zTxwd8fG2#xkKa|xh1V7OZLi|AgiL*d^KQ!(J^Bar*f=)=@Wd89eLN0uWtiW%8_eeD9rdmE+e<~1B%x{)%>-&As;8F-))KgF zw{Ae+@9b-)=;^;$V*vNp8=@w{^ z15_CHYN_D@_Rpw8)++!P=aq8>khtM5(G+bN1SgM*IKUW27w;-k(cohI*y}tWeY~o$ zc_69Go;4vt3kO+ah$oXq=A)j{S5Msc3;mr(r$nR>x+(%2p!nbH_`ZQ(w)mMBt$r%} zk%Y&`IC6DD2LZHoNWk8*6-4*i)FBDXcB;ccBa9i}gU?FjWR^2_acL9gWoD!~%uh(u zH82+6n;5GYMu}}F9PkXIj_y`q(+C@*^KFkgdHv9lwk#ke8ExN+gMc%Y_8+BPo8n}6 zMXAU{)`MFOJToqj+=VDmek5sjC#+y;%1kO(&(b|kq!K|G|0u<=vd*kE2e{wR$n91 z=Q0jcQV#KSPD{`P46JF(bx)Qe35G@ffW6l3dN8OSk(a~NhWQ#gWw9A!lSS6%i@4dO zhZqyE)@YSGP5``bHDkYlk-fcI-s*_q%paKCu+~IumC-;hwr$$DfOF*WNqRQRm3nG? zrMgSleZF=S)Il-?4ka!R=C!tAgmba{oELAReSr5fGZMa7din9FhuG_vD-aL{VAYR9 zScLr<0oyHLgNe`_ts!*NfI)g(!Pr_kM2kBu(>1@0Zut%{q1!bNw)uS)e!A91Y`P#m zvkWL(Yc-E+s(-XYA&GvXvbeS18v^KvIk8_Js@$|*Wc{cjY$kVH0<)pbzyB~ivk8os zvj~OKakj;a|5j5;-DqW9*aL^cK2eQAUHJ+=?;L{kZ6spn6M%;3C3%X4P)*eR>4AU= zl>ORK8?A@|%5u1K_q~k;%=NV&s<`ra5c`TnVE$}*(GHa*JnMXMdumjQ|5gSRQg^c! zH2Svxkv1tM@*w7HL<|_5-H9y2%WRQ4WDc(2eNk$Lwntacm%Qz<#?|W-UcuR6rWmn@ zpMmJdUXcUtM5psq8`-x+JmClZC;ylojsH68`_%m=0|0+VSWYzn^{U68q!$XN<4jHZ zV2;hdeHV+geHBXh`3n67ya?R?{;!Sg|4z5c$iVVHvuv}b&VQ^y-v0qE6l3XEg`r4D zcuQp#$skfA7=JAN#~L(6UQZ*I;Oe53*V}#ikkE7_AG0V@9~m#L@YVLZ<;YjIJWEwS zaVJ*=75=+!*{JvZZty(J=0MWWG(lPK;ienzK=RO}czj{-IV)^DvGskqe@m4<*+lNp zB|ELx^Si&<>6~*a;l1`St+)FdX#2Bp{krXcqw=7`h133Ad1FH}Y3#Vc7RseTT!{M| zX}jcf)0}HkUD1RxG1F|7Gx}VAv+Y?sJqLGV!sD%hUanDH?~;G*8M^e`v8J05Y^`6n zCeA3;*k$J(f~ZyX$wh;7rHq;W_aAX4Wht}%+{jUxlcvb&mXEiC_Wf^t`NGDlxMAQN zh7auR4TGaW-HyjlHYIWxz$($ZU8#!VtF9MXJKnYL-A(i4!FO_ z%h$pf54)Td>Vdq)mx&|uB#>)shVd6$ftPoTJ+uQ9ogu{8ss~krH<%0LB8p;&CIF{? zWg$m*kL4VHOMud0YlJD2L(dO!;brWGqou3hWIaDVK|s?%*qh+%!p5#hY#e*jO;`Is zMhQ79B^v3iJlSWlFi}z}pr1WkKyal{QJPjvKUuW*4iT2E45ROO6fZTdTZw#nLw63=trIPBw_e zGD@uAp{sx-l}9FTbIdG8$x$WaQ+iHe_8$ZTNjp)%jbPY>x^35bF2@ToIx3VgzWHn{ zv!zV>IS6k~26gsufCOAU+)c<1&`J~Pu`jb7`8%^6X`a{E^_ZJ_+hSHIw=)%Zj9lz1 zb3{%E>uu|aFNd$Na<71}axB$e>11*T%nNZqPW1t3NC~f%pX#^YzPX!2tv%h|Vc<&_ zxZ_MvLR2z>WoAn=Z!schhLT{#x1`*VRRC~Ygc6##7K+B^jL?r)#ify&p9k5)C@%ty3&Wc({0T;WFz*vXC2>xThU)4Wm4Wt&)k{J)85;KqZi? zV6##sUXj0>$A$yx_qLKvRWh*Y@Zm&tWha?+OGJ~AOX4&Zy#BJ5))OkB6*CcU(L1dB zwdA%Rwf6`0@f6=r{vIN*MJR(}HQI#00{cMEn5y5g zhG{NE!Hn3PXytv?++s^=jnSjEs~bBY<$v=gY7?|oHDPNSv#a6)*!0U(G5COO`pcZE z5;$i5S>qxFwA7F{1|%!&y31Y;r&2W|c+IPN^vaCcS8ok1i-9eHOkYz$F!b7geSFy< z#A!mt@eA>HebUsr*Jz1u;2P2$o| z&WlLTI?#aRJadeS#%b}{U};KPu%Kb|P$(g+57{3PRT*P+!f4?;_Y7L1FW zPksBEs(e*A9L>J1t7ZH9F(^1!MfI#@e;hj3*(BVAs+JLgwauO{4n-i78#@cTyM8Q0jbehs~>k$ z*iYV)W~UJykKA0aj86GQR&R6_<^c5yC>qL-!R(dr(_3tn?{)Xf(D$I!;YM!u%3uJn z7R{vNTj_vY8q>PtRy8;Cwl%exU#(KoTw=N@4gX52=UZ1o1XH+<+1Mah%}cdI-b;R}Tn8lMyt4(GVix-xt8v(Rgi8 z<@qS{8L&6n4a8K@E?Tr{vowwKjPSbVXoL^ZyW=_F@ zq{+;wjN$aWT*k^j_rn1bz9lB$Rgzidwd^m_vwCut_iu#44Q*?RmgWxiZABjQTeGln z^AdrYFxPA^As1I@jRp~=naaUs2CPA9V)UEI2}yMmY~6STLxZ5ps6MnJo0Hq4>DwN0IRjYgxLpK)ce zGXDYWuH$c&>o$83EM`UfKa8EzmLR~kWz)88+qP}nwr$%+rES}`Gb?S|tj^p0(szvW zaDHM(tcbPetn~KYyIil&#OXF}T6#USeqGdrU9f*hZGCKUJ)KiGlN*o>M@Ig6- z^1*b+yxz&jAdpGN^w~n(fMZwfk=v9JUQ{+7RgK!_Y$y5JKq|j4; zMs1q%fy&Q_bL9n}B^;|;6^vT?Vt)%?=&TdDN6zOoyZ(*6X1sX>4X_@x1eKODO(JEb ziKtv$I)ptCxBk}Xx8d46NY`CAWgp@eSAvR@nFijTFf)M*UxB$!BZy+y9E4xXqL-tS zMqNj!fAl+2ok7-ALyjkTII@SeNU(C0VB1`%G1#k8t+HKbvtwQLn~nD7V{Ep}y<=G& znO8m));K2XlIhLWo?t#4Os{s(nTt(3$38LVc?bpKAq>!g>WoW zR32TGR%R+>EMSH}mqkIBbH&({y=eZGKmCHVuR@LQ|rYU}&jlKkyxAFehq`P#PA;Y%y)Je-)p zGBc;cSvp+4b*4jtQ4@yKgYe7x9cSaK+CHw{_%$?47`X)*;w+WRi;1L)NHw*W@+LT( zV)3gGYELROm-|AOqlGPb&TvZ|r**LxK`(C(*hej!$D!Grl?6R>M%oAH_~6SyY@n=) z?r9309})o}c%I3x{tsQHwu`_qM1}oW$)K(4kD4K1gr_D4S`;86Nxd$64)*OTAY?bJ zyU8}L{isDE7^^O{n8T4_@YS^MMv6?qasz)CO`?VT>b#J_nEt#t+F50uO#{~Y{-Cs2R zX$bvXotmog%av}Xlmx6wq&4Fv7dzxQ&c6$*Paxr>&BGnO>ZkM_Poh>@Idcn3X6M$0 zGWs59|lvU14Nn#X>3#z|!+=;3{J|UuOLlLvE z3h;hCp^>1M*WvOzp?hy`O1#`FWVgJ$*Jh|_Ir!B**0120OGPa zTm5c;sSzI0d!1Y9F5SsMiYidvK}N{NWeNEG2EO)d#bhma*c=u)C}9+@*T3heDMz81 z@{>`6gbMY;SN}Kq&N+9{{}^ljI~gh~Bg6k6YjU+@;}6>rdrs9coFidk+7H-Mdq~H@ zAcFv+ueG_rV`=5BSJS$aws@2E`&3CpCG8ep;5q@7kwnv?RO|FmJKk-D*+IV+V$JUK zZQROc^z+&HzlPbG2}~6iXO;|wXTqG6pqf1Y{$u~#ly=3t^viahWiI_`oC!tP;E&s8 zQ2B1V{+IXDf_TTo3IjHZZb8`G^F1VQ#A(ClIwdLzgWCGom%V=#c5`V3ztoO?{2*Ep z`S*wbDfJ~c&Bl2|_N94+>as1#Y$fjvT^*kYhVoZ>6-&=5qjGVz<-VDdX`_Bi-_v8h zXUN*Q+Hn!?^}8mVc79cIQI)F<(7m;G+KYFAmLIdS?sC0{=MtWACPPUywHQ6``=M0S z-sKn(Ifc65bK!l~m3*DzJOP1RvIfv1U$t&Rx=`{^2VbNblUvIrYF<>#FzEgdqDm@M zJ$CjbU3bYZu2xi1gcAP?Ps(J#SHI6}ZevOMaD{uORVU(H)0qqZGI`Cp$DQk^*_7%t z%+@rWx%4h5I3Sr4kM0_7jlwD}M|$vCs>UL?f!;7hfejPMb4P4!Da_(5MOg#9)Mm|? zIYu&?j?6etMgla^Dk~xACM2o;j1%3Zak6w|ipbDI3PDTevUx}pNV?{5iX@^mc|*3S zw}-_J&pmU#)u|g3&m3x66^iD!Jdw+Fx~2h7bPa^z+8^BHCJ|?^BJ104*9i~fHKWj{u>TN#8O>7^9{uPG|XVUw6gC-yFJRdjp6H zf(j~G#}1}&#eLgEfGWOFBhc@8m76xiZU<0TUIt(islXE>a^N;D8#(;aev8%Wh zWxvg|miY9)QWz)8)kF5Oobn$~%5o^d^-;~kz?~GsUr2*cBsEWOGsI3B9!Q3EV68zw zOEL}wq?&32( zElorSOq;z$s0||})KMTt^<`5q!XJCtmM{$T+I1}~4x}itXw>+Kkbh0S1*}mT5scHq z?##is*?a^0b+x|42AAwWGRg=-p>l|>o!B~u+;mGE5HTnthj_W^M|oJ2N6!+%Le8@Z ztQqqbx<>_(_vrwR7$s}i({Cfh7ybD%2yPQ*hAonXYNUz=g``V>ss%JHz)W3*A?Fzu zA@GLt_W?s$fuVv{VAKJ&-5D(aJFit_0%T19(QzYo zy1W&~YU&?0m!=Gn*$*bv*(wnhSSQh^K>w|i0$>aCc8Ue92zgMS8CR<%CDjeV#d%ly zjZhet6>S{z%;5toLJ5@ogXjy+u#6)5gbx^Hd0=5?xG?s0?#v17Qs@*5A+7rPTsmok z6~MxH-Yf+vTL98K_*ENU=ChTM01d;s$7SoY@ppac)$l=QFcgop=F@GlgqOPlHOs2W z^1tI%6;On&NKWM&8>iH7kqs{|ZJ7B0SkWR0G%FYI&d`|`LaCEs(^>wN8la0l7yt=; zR1Gq4{#uyfn8}&6C-8=^NPMN14c50cMLgw!x)XTJtiOLM4E7!lym^ZWj**yjuUZcFd+u`nD1F2^)kGM-n%w^jOm;`tqtO@n51!ab* zmg|ZWW8y}3UhGh1WLM?_4CE!aqFoC}3@EQ%RLG8Jbfn%d@yFPA6ev@(5D0))&LQaS zA%fEg8+kj*xLfw4_+m4>U;UwnE=<+%CVRUl&XW}Oif;{R>ie58&xM&KoB%H^D^vP4 z8SpUq&|m=41SW=91<0XZ+jn!p>=*ff*|f-K945BqZ;;@5q&oOIOHzS2oPl&Dg`Itq zyO##|Fn6L&nLQjw>ZDq_P}b2T+0{<)w-&2A!Jgh#e=caO87zco_!zr?;OI#emBzxA z$M4bEwfE)k`ec<-9wGHDPI+g@jDrRPGKb#^j1@9!AwGixfa6FSL7b6z2^a>_@pmeMlW2!wdja=~v2*3Oss1hf zb+6N<(b~ig&oVEMt(HbEcL zIQldDtKf9~rD(G?R45gPYhPhwDyLWN4kj!B#Xi@m3VrDTA;oJBKmj0eV(L<2Azk(Q z)W)QbA8kx;rq!_ou1V9wLq;rjKxUi?abgB;OIoakoq7}8a2-CuoZn9UTWh1E&*wGD zlj^7w`@eut{oO{!b%4;{0Tyn8#W5v%MFi719#2oNhTc|vJ$As%b;(^4Y9Tw`(BO$% z75ztQW(qPl4y4EoN}OYj(GGj!D-d@0M@JQ-KP(a0p}asf9mv#uAVW7>I$12NFRa96 zQr`N*>lp2WsML=DZ&Rs0fgl(X;O}*XGpY@IVBK}s*<=j2sWByu+y^r>aTSGIvjYb( zps3S$WJ{ZHU0=4)%J0f^~z||FeXzF64AJow;kID*-skcQgpr~ugN2^k@ z)E7P|num2W+!aQ~Iglcy2qrM)C<&6Dl=tDNkSA9zc@0S7AHeU$D4|RoMbN#t=%Y6^ zQm-nFtMWoWwNz3aobU;RX*xciMFCF1e8x<`18~u&Yaa=9>Og8!Ve^=;vqpGy4b#o) zaCI1C`P915!ddU7a32+}pJ^R6aJ+(Ky$~rVd7Bn!RaSu2HU2D~P_j%6yhvKE7FXKo z>+Tm=D_77nG$=)a&Pyc|Vk2$6MZT+u^=sc>^aW~Q1}uxm>L}g7;sh3H1u%3)*$HKh zpmj>2buh?6SboqRGF^_0(r2(n>jP?rTB`=j2e*U}bn#6dTk93Hv#0tTJrw_C2%%HF z1W_U-s>f==7Us|$^tIt}z-bVRN2L;8%==Z3E&m;NZCTB=1ANyFi!@!G>qncPsCX%3 zTx>DJej7eQ8{)*V*<|G#YxefV073J^VcS!{e%yI=wP15b<&HGHvKmTn;Qrm!`J2MT zw{^zw5qlU5FMc*DS}ELO9ndLfFryhUKA39hQC>=S@apq-v1S})yr=<7qpUq{<(?Kz zb}+Gj*f1nhbH~8j2T>z}+w4MySoaD63W&sauQ{L8@Cy-1ZAV8-5S39%ml4uEX2BE@ zsPO7W<5`;GBQI7RRMt6Ltbc4N^QP0+Jbi!^&I@I~dW*?KAuE^4Uecps-0mJM`vAgq zxL8|Wdt)-c?(9- zI9en(bup8Z+3LM#S|YkyW8dmUV|bWbHX7J_HrigLHfc#$%-vQI6Pp`+^3$PX($Ar~ z&CKUsKZ)9)th4)X!=qS_2dm?vtg_J{m`Rd508!}E>zK9Q&7^2_GBkB?TF#vlA4N!* zHu)^%MS$R|tt9Qnp}!m${RgK9^m?i$x=8j*B?Bw! z%K%X+^1gwan%-<}7x9--jHD+D>jPps5KV!TE7gtIh^~+t^=)MyVlM~mZQH5e&(dwR z3px9LN`GwsmHw59gPraFPk%lCBTE|nA7)Iw6HwJK;|XuF3S1O!SyE$ad$9_f7Jfa6 z$RH6Q7C@8MzYmu=V0f#3T}issRuKdY8TnTi|8H0LUt!WOMA6@+1oP{->e}*ojlIgg z_ZOmwoUPsI^=KzL6Xj$Ss@b#AGh^|)f`7{XPls_fViiYkY?EHU=V#1oh;uH=>y-ZI z=Ys#|VDrSq%BmY}176kr#l6pZ72B-w`dDSvy0mF$=40m7h{_we#3qC^42t|R!v4ZW z8)pqWv8kGy?cS8rR}*V6R5y{Q?4~CxMA7*fB~h!IZK%Gh+A|z^saj%YlEqLduE{Q5 zbghKUEJwk*6uHh`Mj94TDt?KpM8G-~b+cuf`7PeebWQbjjEPiMxv)7`qRNWCrXoIm zM^09kE@MKeH>-R7S@in2gv3#}*#udV-oVSMsgomBQN>>(N-4>rB#&MyU{{h?9V*|PFrC{9wI^!lHxlATm{PE^;-92ttFs`eu))=WZ~F+lr1 z?+^iCeQ0JS>(&AnCXLw0TN;7&yP&DQeQ#R9L760V&4&=~f86xL;VHBryeee_qlI{8gH7g{_W zcb?JHdW0q*Z55q;qXyylc_H*y4Q?y$gx-m1=WQ+oVi>9eZh*o&RSCT|?ZnF506_8G z+{|D3Kj||tzME6}0*X7M2}1{=qJ(S@!ROyRUd5c(pTTF?CuPnf0CVS$Z4J}H77rf@ zI(BpY$+N?CUTf(qwe_L! zy^BSXVjF*#v#1XxAu#pP)bS&EV8|dirrYPPQ^CXbykiQIo{Qbrx(DhoCK}p>4$vey z$S8u(7$$poiXTG9glL7UpNfIOHrYA5sqQ?kLprk@)omMx$^K|3vf=q4bLKTjtRcywQ(kn@>(lS6{iQ`lK99pjh zAQS)xm@189+QiJKO3DW06N1%_vGQE%nl^YNN~wU}AKnm|jFku#n$j^umbpl7@2d84 zYSXh=6lj*{)cMXkb-8A~)SG>>J)t#>Gbe5+m1nT0APFN`;m<3Rg>qauMI6#;nC00e zC#GnHNSxFVe^$Xw(q#ZBSpfi3byRyh@CHC#b9a(Zi$+sKx>dU<3JmoQJ z41}h|w1xyXVj<^+Q^;eu##Lp3km5c87M+vQR>Y~?5e96zPwdJ~stl2Kxm1gwzHvD< zKQZ;(GBYp2S&vk0a&KgY@a7jEjQ?F_5LGG5u8mqw6F$g+TQ&{U9MAc+7&}i{i=d{& zCA{885-bXMiF*P}grt>;1(B60Oz`5@VN%4F1ZKN+Z56%&D&-;(wnrF0u9-OX$B~3X zj^WQ?O>Khz(`|0lgwN|v*I-PGe@i(z@vNwYx{w-j`gzZNXV+k9q3o< z*(5nY`}%j12pAZYH1}I7x2=KKeY4^8)28q~qIuW6G3do81~$+195zRB**3-La^7PETFF#2Tt=S6#c5a~idv^s=bX7VHK??mmZ^ATxjCQ`bTF0&~P(mHsl+boiZ2 zr8xw?$Iuca9M!$W7_Ln?r z#!9BNcfgp!*zMxwV2}?-iDT9L`tdz_Ss@hk=0J)l{(4QgGX+@5!dfiZTqPn5Ml|jF z>h6wiYb{Y3bPXr4NQBt<^H@`_6s7KC3OM@Y(EIuBPPLydVnMYYZ-D$zDU-wqQae?f zl`9ZhymHh1s^hcQv+{vC5sZ}}XxudzmE73d5t@eF;!c(X+WqNRq&a`IEkL+BF$&t@ zJ`|QXu`W+YT=soM_+Oi~w_Es#&WTa{R%hpIK8G7Lt(--;GE8V(Bx%SNBg)lD_|w80 zvF^9(9|)9dVSCIOxU|@^eor^JS>W13s}KhvaQUz%YI7=&gqv3=>2j&Sgo0=ds8XEw zBZpcLp?>E}QM+Ocm6r$PDKV9_j=7P1KM1KS02b*-qYYrlewjd6jjLmfE8y(sT3fk> z{S$veBC`|OBHQ(mhKvlGeiL}6 zT-nhr1o$k)Ii$97bl72?aG5+<4Os&&_`mo62_mj6{>MA`e~Uv8uS zt-j%tq<4hp7uiZ%s|B3;Qxx}Buj#FzHM6y@%|zmnEE@Qe{Vj~-LQ;C;(ouy3zy^yb z-02~EALh-)VN?ypmofFwKEJLlTvgw8U9bO?dQ4JMnvLr}zmcmbNF}MR&fQ+>pWdpt z;LDp;p@^W%zO9;)lo9yP*4wI^#61Nt)+nxbgn*}$)s4KH>5~<8bz1z*31nnH`-zWWRL-m>2#`^A* zkhEjZ_n+gtv-rk2TOyW32F5mMypO+P)&m#|i`AJS{nbOM>(4z%;Lg1=Zo3|8NoAGor3vp+x-h(L(B{`;LWhzOR_JQE%j`UDQw)lAv>J2i?YrNq2J36>o69x^W+g6gi416Scu^~8VFlw!A6PluV+0_Q(Lp`w|13*12* zZd9{2MMyn1Dhm~_FNQ$Z$KSLM95CIB_`8 zQPttuS5){;0C{QS@hAjKg3o|jx#dS&XWHim?1liP7?(zt{}hmaiHuG9y(p5 zURrZ*P#B3ba?t2hraWm9f;0mR zQ%$MYB8*dKn91pZ!bgG*QdL<_CmN|tjGC_vE%3|fN&PXDjvNA+i_mM0^jjLrFa0@<$;Jft)Gj<)EC8H;_=crh{q0 z@1-OIVW+e

    jQMD0p5jXDiP zROfHO?9zV;9t)(cW?W~Rh@L0>=Tg`jb2+5oTbi@ewdPoD`#jgd9*iKW%%N zrxi8j_@a;AMpMH8J}Qs5eC*pwwJai!50fR_1zFSIcnXzIu;A#onAFUp;Mab$it z7g;elUuD^`KnC#&TLGs`px%$|o_mqAfB39a+0#NObZUpAix;>lV)Q-@RZ)Rm?wl0i z@n@R)X+vqOf~;M$ZIrgrJ?TyfpCNOSvU@0dQ9=!2KRf>dv6fMn&JxLzI`%st8$8@B zS%pwcl?8u-&Wj-M;8b>KA@8h=vT4PaWye+~#r|3z4csu9^8022^ zqYv-eVR(gsn@$_0=;8~(lBb69BbES!?gqeP*2q_nF>3@KhGU!VFH*;ApJW|#!mKMh zJ5hli9#X`({M{%NEE^6{=mPdgepEHdbmv9l5S#5{6RM9#)Wyd=VppW*Ht3CvsUIB2NV%{=1hOFj6$K@;CkNvc-9k!+6j%aV&U^k) zBb{%v(2`0q|Hf;8+9VagQ8qI(sg=HIP2{ZH>CJ+3UNSL~%_}$fd#`%WP+~PR6n0(7 zhL9x+3idRf33>SFxLg=RhOss#Vb64ctC4%|=S7MQheSMj_~wOx?sncd5Lr-6V0U(< zxTp4*#FUdh9HX_5M+s}P)p7*a_Uyv_xnRV3;d;i--wfs9&*`04jj1hg5(lNC-Hy3& zb36lOYRfIL{Vu(^Hct-h;m1|lK+;7O$?qm_P{8+w;$IdRpgTm3!SN(cf*^MAqNq)> zjW8jdu^R(NJLPuQX6H_*p>Cq&TwQoHhl1$n_hSTSCao};E<|YxmvpB|t#U_;>Gua+ z;45%8%XKFi1VrL)mcwq#YQW40IdjKZgXw3sAtfLGjy({4)=Ur`a`iC&omwk>rlx015W6 zHW`?bCtQi!$=?v|LJf=spWEXRBghTj%w+^vUGf(cUGdxWz^8ndWQA)Bu-E|lkEjAr zo3ThSTd6Qu4lF0srGFiIUoBV!OzKeX%?RIkAJ7lCTBFjmKveK}2MN4RB@SwD^Ip;u z2(#eDuKPHi*~Rj_#5~zP_s9Gn?t-Q`_cZ%kWjHyVpr%jjJ1E^o2b3TfBNb#3&i&~~ zADabjr>G&u<=ru%6WC^DW2fvOVA)z_0D>DxF@8RFprWd})Nu9wq^9Q>Z3XU;fQov% zg(m03G9uzmDN_&pmh?|zRJH9UUPUPIhd=cs^;WdyeXFWZ4S^BX9+CsDj#RU8}-y!W9^6sjzpdb30(l1g4XKqOFD|}!`+Wf zl-w?jgE(bU+Xv(dL0!oIWJnC;T2VI_9w)zAI)oZpB5r&{pUpa8*v;h8nybX$Nuja95w*>Q^ygwO6h4%geA=_GPN<5JV)w%-)u?bgIy3-5ZxV6%tNN~ zcKHuELLV?2&DI;*q7C*)kMI62bH+*+`&ObpniOY4V~BL7JW-!9Qxb6o5cQGAuNTJl zu|^JlIvVISz?GPzfwtPz(rE{Gh8O*GobymI*^nqe%WmfY{I zv^7^_M0vOx+KRs+S^?K$G$l>I9C}5vH)M8J>^aF%78Pe6S;Zk|m`Js3SK%Fd9c?{- zeK1h1!-v`ey4h@Jnx;>e#ST zO|L_j@ly?l)}!(z>jAU^O%e;)zJG1mK)M9t5rj?45d@`LOhrGDKrR8D)VNwVV93m` zYUAenouxEGo_u^>J-;PgDn=ksgo9c2ncTL^BTZFP_gF`_;ki8U74lyNBh&17-rXVc z#R{v)vUhRC%-Ww;QbjZSV}<@U*uQ&8bVT`NKq=HQ+W4tTbq}zYHW_o}8t()_qsIHN zOOdE9cPQ$B^`tve9Yuz6J7uj`^vs3ffbde;uNwYTkXf@!Ed@wzS9h=cV*>dDr)qkF6Sq^}mhZ?Ef1GoQdN< zZDrN}4+P$T-X5lQFN-*KHK}y7VMaf2LMx<(`nm{Oc2nK3?$WkGelB15pGK z{Oo&=qv4ZkP$9~X9SP*uf?0dGkGgOzokWmQQZZ%>S|vm!gi;a%Dow=f{V?aQb4NO9 z(gKF*qxt|wB;BN>?PIi!sV-WtD2yXX8OXRvDAC#s8MRFO7M5q%^6b8GRAbEB{x zmh0tK>_oCVW7@n;!Tfd4#l&@X^3z8GI25CQQiObl0aYXA=1eU#3?W99o&qDa*2*Sk zynSlw=1P{(ftMt2DmnI~ZRbgzgdLEvxB?4jzRedS7CAM-AhG{rXagnLvAyuPnoj%r zS-}*SHV>!XUuTu&k+4uqg?bl7q_rS&HK;Cq8@8Pcme|AzapA?B%6IFYFV666Akko5 zXI`l`NdXfe)0J&39doQzs>h*_rfBTrXqP}y+p2`ulU&+4>V68;djsv3QRud?M@p2n zGlO0lhtcIEND|;IlI%Kv{Q5xvnbwO+A1?qG_LxYQ3B3||QIB}zOP(}(lAxzPPD!k8 zV4OZ`y<&jif3d^M9PHA^LU&*-No0JNHM%tpkj<8^>Lw8pqx;U~qG$?sj!~WbOt(~5 zOJsWq1y+ysWf{2|n6Y6P`#bm6%DGCM0rK-#+3du9#Cf(x3Nv~<5m$(4sJ!)+Z2dc7 zHH82I7B>dDA*%_`8ChXuF}o30z`^gDQUHCNgk&$cxInO(;&G;tz$NLfp_iYdQ0MIn zWE~k#u9T77$CDs>e|PZ>hPXbQ>-rqFj)~3(9XZHDJ$f!9;9CF$2Bg@;7^&T?QS9xl z^gRTGZE%gNQsfFhde%E1!!$W|eY( zZK$$TkRWIRvPMgqgut`$sbZ9}1BKUi>+9fs7ZqG;UbHYV4Qd7d+w=SPHl9*$)6hv9z?0l8TVo}fR1ie7m zbaMLPsF$fEARpL&o~~QH8Y`W+a^>d1>PNyQev!@$ci3Vn>SH`y?)PIO-@hIfZ}E4i zXR4}T08mNj`)fNoa(Bp5a? z3?$K-n#<3ijX28Tu^R477XyHqB!^aGtxYxPD~!ApY>{`70~!zM`7&2Jza4Ho-nD&7 zOPlsEjTCt=1aj#u)gBoqMZK?~jbsn9jWAIp_8mw*bM;ci$E!xaCrCPl?vyS*_<+yt zs2ngF6EO^Vd+5Jk!J>k*<-m9qP!@a<-tjMOlF-M`!*thzX!AiAvN7k@%%t+8I?NXd z)74#f8=0us9{(&su_bmwVu$sYxb$wS6w|^KM7$jUKF;Ae`_#<69xMK{NWMeRxxhsX zHQivXJa0Z-UE#EbDJ>1Kj4q6=QT2&*Se{KDQXu$Yw>RP*bIKLsEm4ity*k-2 z=+CVUznja=Cp|8m>LfQ5YE!w((L*jPIeP%NJk60QA<2)0EP-5+O48aB))wLEarJ0W<<3{p0(otfXRJne*M>L`+ovhGyVtsNQqpTUYQ<1 zPzcnKn1E4Ud`1Q02nc}L6vY3(p76i1PMKI4|064|{{QJR;wm(VT@q`5OtX2464=Yr zGY^4N2gId?70Jr8Gmd6UvEd`K08O3j+g&O_0`z+4VrxBJdT-WZ2KZX2*uP3UJGQ^i z?O#Xfyhh0xmg=?-7iFOYn&!C3!s3r_?(ZD`I@JFj-_zM8T&oGNDEol&?lr-md+ zcQj_*I2OCV6mx9eza*0gTEytiYtuq05-_=D)op@%x)nEsrrI}D>-yewZs?SVo0C$= z8-&o`1bcC_5PK0vS~Wc{J!Si{uhrva)P826r^AAmBtA#ZdT)LN8o#WXbiHktY!2>^ z!^x>!!(CWid{_D^kj?HN&WCd(c+*P3UJbfza_NA3zRa%9<9%IR=3HKpA_$u+{81J} zDCy$RsXr+htFZ5CA?M(gF13Ivk(W}U*GLew$O}>KN|MO5mrY9A*J1&|(_Su!+e#ug z0u&^3I}3my{Y!nk}uxgzyigw ziG^DB2{)!?X?oghb5{{)_QVUM-!G9bQrA&<1|${Ml($!vFqte>L}IkZK^F1mbs?7d zL?^2@e)~u#Q5J<}K}NSfQAlu+E&309KcVNJKKD7F>P^w$0|2iN1oTmkzcF!2yj9k9 z{&9Jf`x(h*yy`S+2c#{`n7(}KGqjy#+!wHP7kh|nMQn>lJ}j+cWWCIidWmWDn8hGy zjeHamDO8#zzl-$bjPEF3J+J36PI{_{9G<-A(pXw#jE-o34Tna0+h>i$>`$~zts}_T zBd$IabpJTWyjFqh`+j75sfe4HfJRUn;s3N5*+zn2LYx3s4?Gtca>5F8eV;=jb^|ybwiq z@LWY6Cz5>dwNs&9R5;2P8-gA$GiHSc<_7@EgGh_|Ke#Z*l6?!pnY)?aY<@;o7N`-l zH0`F*fa$U`r+x*0|BUx>ca(iu6Z1*#sR`$?tVmp?rs5Q4-XAF1Bxqor>BO3+Y+W!X zP{|qByF(dduP+KUd%JN9z-{_Pe*F=8aE#I-AfLUrgjoPu!M547sd+$4_+EhCXF0&d z_q!)}+VjC%zL$Uz!Itnls4ygW8eefvBH|M2#buZ@`XRaQ%6V8FxGwfL?G`1xmc)(Oc;V6mGgg)btCCjT&13|-ioX%Q*;nm`A(E&JJc{x(hr-30f7DV4f=X&)t45AwFR|D-lL7QD;10?1-NZrfc;uXSTOigO6R%V^ zgm1J5^pJ0xgQE+&uw#Itci4g7&rspt2t$`jx?=f`Gwc-S8+j@`+Lev5@q5>G4(?iG zG~Us6!Dm9=pniajF_3nq6VHq!cpj&e6Gn2YGtCchK3HSsj&X;Z95%-h;Na>en?kw< zyY1#Q5unTx@`FC^Gp3fz@dJPTXjAPr^}takEV7xif}q7;4b1OG^5(?i+2SzYP^36K z6Y>;o9E1*^`mtFR$21NIVZ9&x3)9B~kLT*1AKkbFm zfN-D3;Q}vt?(#-K$fiv65WnbE9{bEbYFg^DKDWr@V=;>O3PrClV1lbQr%*v+ny2rZ zqC+pk@uqz9)rccUdlUi{v-?}_kkT$F+&TF>%xN~=5ShJqS~J|X!gRy>fmMJ z34&Y0TY`KLPJL-EThH`?Xg6s(x@=_lO(SRSc{hv^jg6G^Hz-p8b$|2pR38;wJH9$F z!4?c-otEU7^H)ebY0)A{p5b>I;g^nQQGGJg0Ja(BpyVGDzW`7lIAD9TwW97JJT{pE zCx-t+{cE*w>paF)lWP&uq~xz{(DHDc_$i($oV)@umWW|%(R$SH8kg)3f9kXAY_fX~ z(BPSv0(k$id$V9?{%t0N>(z4z+c_5_@^T~r;s^vt-*qG-qG-zpc4xfDp ztvrZg5uB+GEdt4CTlPC%b~0j^33G&G(}gsQXXHV1XF?S?BrPTKh#oofbcFt~u(_Wo z6#@u4PoBc7_jW*U$uJIr&beIFg4bH2))>OyRf8i93IfvpT`+)`Q5~hlTyJK>0nr3V zSp3FHwpFyEZSOb@Xckqw;)C<;P5TW=rj$p}4)$Vl(%Y|9k$`}>#)@nEAe0P>ri0WKw#1gZ1IrpLg`i$zr5j7{9d zx@w0^RB`)|JN#M*gB{feB>}J2N#-R21_Y2x@4#pfP6cx2JwRv0u_X?t z3*PT}&=rZN6)zc}u+<_8;NWMExzJ}WT9Y*--b(+bhx|G;^HlY8t9Q4pP?3rdLN|A` zYnOW!N0D3gbgX|T9BtJ2cE9@+N295m>{(`gf5zVKRI!bu6jPZJ9jVKGt7u9Wd>8|d6M{wHiM9rdQ4xXJ`o=*6680#m;w zO;L-^fNH%A6JhlO^v0(%lr)=L!qhDuDRjcL;;({)pdF+8*@b>zY_!sN{kjS+ynm~w zqVi_)Ht{UWF(CP(X_a-BB{-fFYR?X+V9|yLzM;-(dR_Ztmep$+341^72$PzKzO!D( zdN%;6yE~fP(Riq2<5A7Vt(!73aqeZ$4?m~G_G1@CaS)dAFSjixvisk+Vm$UxCSAZ52{dl`y%n{sP(6@c0=hm>WUUZ##UE=&?0a$WiHrTP1z(?!o_m6!xb{yD! zoMwJ8=qcD==El0pP7AIkGsT(qqaMreeAa&3tiVB6F~&bc#0r~ziG)Cf;DZcvfw~WO z9Xp>A56AJ=X$#|n+QYePN2nD`#LJ!el@mg<@O(@7w<}mi)45-ni2KNV-kQ&WseXd; zNd!PiePqa30+a0V7GN|q!AM|L{pUv}+G#`hq?7{e852QFU+3`svIg|T!HNB*qG1Br zd@oY$2`2;Pcd!{!DazaVcxp)hDAb73b^8jN!VI$GSy|Q{pJh3Yg>`;1{r+Qi{x>xj zm$5P&Z?IB7jzCvuB?RNrrjNv8tVI|s9)y8`NUn8s4#rbpvMP7ZzV zhdyPu>j6h$j&})!!)1HcJb>fLzYVz625@#*YLeH;#_e?ERMP|Iw~_(X&95$d79l}Db31Y)I(=*j@f|niIG>N(y zINZE5W`#FZUU7@ab(lzu<;R3UjK1Tmp%EJDQ?n(YsKk2JnC3SIF~+R$?`S#@*VN%C zvR`K@W_V@Lo0c3$7qEI~Ok$joQ%OJkl+mveff|hc38kN^CJ(DDsj8@YU?AcIO#JVK z&V_1&>l!NesRAkB<|J%7U-}Bst_WiUpcLz$%CBFc!Q;*6pgD+hKxCp>A=&*7;bBHL z6Nnh=?IwLcM+eW^%gIkxhI5-gJth%)YBS}&QK>Tbt1o$Q(t@n+-1v*`Hl6jad%neI zM1)|d2K8A&u2lR~HHrf5vKH2?ytmFuqPs5J4M62Pweowy(5i`0@Eq;T>sGej3<>H3p zmQV?Xqr6#hJ6SW*rSM0UI@3_;*QLrW_;iX)r9G?B0+dj{sr=Ltlu2g2c-U*cE=LLW zWCz~3vARY!d}s^Q`{Kb-=@&1WfMQAQoiu?_L=SyBt~{rd2n)&IhV9-t_CD!&5dj&L zO#+2rMHvtBpkGOdQq{=xWS;JzH#2?T{RLX3iN2%nLOabW;}>ce^UkuSIR2j6Sl7Q- zHyu3|3y7UH@j(l-TAq;JI`LMgw*b*-+t$~kb$(&ilkd=0Vu_*LNc2p3_6ZGxiRqgX z;++uj=X`sz*XQ@;dADY_2bJx&-JfYxnPxs)4%I5^VuTXH+9RhpTWQt)0)c1L;+mgD zT9hR!iPsdCqIU@=(r!*QPWaB5b@B0%2nu7gf%`EJ;e5r{3CnOv&E}0j2 zwrb1aE8nGP`GZ>2bc8GDyQn)XPLwzj9P23c~oY>0c}nS%?M7Oh;i@CX$`cZ*f9)2GD*E zN{sCAsyQb80+bw)pelr5C`QZ9H;Ew1C*i8uj*X~2;W`R}D0B^|99(pb6j>~Abi$3P z#{Mwq%y`5@Jo(K#fbS62VjucYi%7shnQmXr7Zq`L^aUmu2g8YnVGD7YiX{Fdu+p4b z89aGjLP5(5yJY;A*e-fC18J(i-?6rC`Q#2$8o&pWRJrG|boTB&t$DSgJq2_$nhUlkJj0@5du?TuyWIh! z!S@g_*F_>25&%w3i!3W~zG&ioEu-FShI|4TWlzYm??M`PtqO_gOBZPZr0?_-C!#A} zBsA=NY64T=+YZ9&biHaq;DnUy@T}M&94Gpm)j`#+$g?IZ=sNs0GQ7an=qGt_yR9Ch zrOE3}y97CE(uxa1dnesyrw>p9x8^Acr>{Q!x#E#A2yTtufCze<(%R^pnr7Aj zR+rPwCIXBqB}J~<9|=j&WygS-z#z_Uj4tEP|zY zSq_8_T z0OOXCZjCpEhH&CEXE0J1csD(md5LV+`6mM-B7YtG;X`7yqkY zBLudDuSFi=z zKUIDzm)3taV>&nh$^63o=M-^-slRms&Olix7+~pGIhfNR_{6>Ch_4&oSknok^H^ec zww6<}Hk-p8j_*dQMMLewPSriYO5BD>%v3$*&K3J+K%bid=d|-@NDd~r{{4^$a+<6w zU1Om^#E>euZ zpU+RkhZY5+mBg35-1d9Kvd(uN(BoLaOy(^r(MaZajk5Yt<3%Y&8-uPM_3ul$UtnF` zw95bX`@r$PF=^RZ{zJgsR+F;bVnyhARfXVa(jYK+Lp#nqB;$`PFxM|kT?2O)xrLfH zEEG$C{W$!Gtkh}O@(e_ym0zo)h`@p~?RjTsnjZ}l#_$nOQhXbp?}*XS6{+1>2-8d2 zj}lgOMN~l4CqJa@pxhZn-}GWTvq`2OF^HJ`3wg@zqxrW(cU$Wl$DSz82&pJzIRc97 z^MZy!kbaDrDA8PHfT;+g)pE9TTJ6$gSe*NbfbZCT2gQWofbTD6_8Mpl$@n8dNlHxoQ$$y#rY5vzN(z@PY$;G0RAM0jiT zglr1o{)(H!)ETYZ)?*KmMK?=4bFEV<%EN9?wbp2NmLp^2g}^Al4$7;-oi` z%a)yLq_|a9J%u&nGX-%g!D8X8q7^SnC0{NJ{0&LHB$GcI)s&xvB!T2b$|vZ}t^&u( zAw?c}n=ZS7h|vMbj=*M-_{*$=b;z$=`2;wSXyOW>Cje@at&6c8x~|7I)_~>mlw*u$IN*JGi-T({A($BSLKxF^EI9y)8WgVC+YP%L@OMDc zzW|v*M6x1&*aLurh^AgK({Nf$!KV6GX0gmoH(4Wm0$_Pz50Dr_Y!`={fT(p(I=*x* z*MR{XFpH)4V4~_^3Ip{12#U~-xuNS)g#BcU)R)@D{%4_ELx0UGQS|srsfuQ_`$(t@ z?`hPg3ljRh^Lk-AD4h0ls@|t)>UA!+5tafVhfI2Dm&Kv1XLi)Az}}Pll8eWRmca{? zc6?a{7F>cCX+yE8?_1(w?4gH0$;-UiUt;bB^jl$d-Gm4v$&^ryOIPjsuY{oN0k}M~ zR{i)H{v`srLJb)aET+L!uP(nSu3U`S2lF8KncL#q4Mg|4@I79+>%;vU3={KY*DMp& z+iiO=O#Q!UG6OkNkLfi+pGwP~6Z>68aEt4u`4I+sI{Rl^Y#O?oTPw0Bx0ky0uL}u* z&_nBruC|R9JvhE0;x0Zr>lw9V>-OzB1zoi_+gbEe^bo=^(*rEmJU^h@aMy6CI>H8q z!r|R@G+aG!I?ZI*!{QtSv%HNT6D86AupcN|p87pj*qSar9+vFNw9AY4q9|m{FyqA~ z(-SZaqb(^kXF6o7jvFSR(!(LblS~>f?4{s5e6g01)SVmM)u#{iLX3lW8ggh$8K>bO z3@(Q6UY6ic%-F+HOG$hYB${Nbiu;vE}Hr1i(_MfiC?-*w=NZ?Zl z5X#7eY^K%?p>Pby@~!ep0gP>Vslx*?Urtioeg(J+qTP4gwS2GO(j{2S0_F|c*r96- zubQOswvn}qpeMLM7)H0&&P)S)i1MY70Uc1pdF6dtExzv^#_sCv`S}T?(0%?1PM2@- zV4mD|SF}pp_MoMoX8RF0QJ`-wW)z9aPT34tad;^GX?l1vMDgb|*|OT^mBD^MO@cQ9 zv*bI9o*n1-3&8IqE-7L&Iau)J!F_*<6CQ;>`6=^yIfv4n38m?mmTl~k0P0u197L+S z^ymhs2=dxIut)Ywqlp2~$61PK>aNn9o47(i@t*gZ_wUg|=+h%)Ijy9d$~ou(V1nA} zsO;MvfFeqd7^dOwpz=>--x@PG?}uxNUu1QyKF><)izC``F3DfaV8g}$dj7XkhT=H1 zke-OuO7S)X22)D=9a z-jay~znTz}8qKSJ1BF<87f>uALkNHjAQL#~)L6-sbc>u>8zCR9c=5N*7WW1dyKd4dosg#v z%X@ACK{2cBrto{a@Ory^bs1D0{UN5ka3e`2PKLne{9(1 zECa`X7`4OdQjSOeZ@7JmVqZC({+@_`_o$hzxjYGEuCn4kG%gS*t~itUTd%;nYF^$3%qF{qA?c3p+; zf-DrlS{v5ZaFh3s!|C0>QA`CWp{@2W7onH%mr0H}Nz)^+KOcj9TYK7_o6WE>A`h<} zyPf|OynpdE>b*5w(m*v`BC6p9@E0k<7igNO>l7WejnI{$1+t3c{p7)Vn(h?}s z$|TAJM;rWI*K6D`#c&DV@v=3n-wCVOI_{V)6R<`2?!|}md6?LeM@>ic-iYnk_v#Q+ z3F*irXu)70ZHECU?{->7V#QOP)ESu2n)7c*hYuV&2$}%kn@MYY?Pv-?_x;?8+tqS; z^#D&s8?{%rVu{6$U42(}n~Ci8Az>x5a0C72Z;gc_96V1h`ZrxvrC`efBl-u`OJ$RR ze$eCAvPGqB&w2e_f$cOj3Mz*IP+(+7L4D)Pt{Xl1TTr@2YVx_AQCCrr#NWvg91KO8 zZ~zd_TPn{}V71&y19L8JVk?-kvNL7*bSr6HKIY>&7X}q55q6L&SJzvR6bx_olqOGX zM+7^>`-DK6K&j7s?BkTqvmA=?CN~$dS;s9kWN1(bgN#s9x@fVQh*P#J=u9DFkJdy` zUE6-UqXO5vlqEPunfscosIO)-_C$sTKbgg^B z7&(j>VP^_nQ2L6$O7dYaYt#+gz%Vg)y$B!WHbmnvL8X1)b=I%*T?6(kDz&Tlg7J zjS4UydLHS~0^YI=ped_N%2{NCM8pwFc{~CQTmDB-dLuF{YEl&OUY8%yOf5H4(-ktTC0QkL*YMN8njBf zEV3=<9V?|<>=II-M59*TPiL`e_&^%+ypdx|)p(EmywL~#g7^oUatgKg@MQASzX27d*H%6>0RvguQ* zS^51<7Z2z(Q~I0<&j^wy7|cdLK!8>NnKXnX5U{oslVuj+WQTT&b8dRBUD%1Mls#$v~YGk}G7($*TVT9{9&=xPt07;4v5>yya=;=4;we~D?( z(K=z}&2*TwWyA3jZ&OttBGYM~MHI;(NrKhYvJ@~d+@yUKyiw;3^Ia`7e&*7hlw9K$ zH)>eDE#%ZzM!eQXP#RCmt~d7*<)Wr?qp4*jdD>jfUsMkx>JLejXdOzIdaUs;Dz-{a zQ&!{)72F%1ta{6RjXeIkL*pS)QoDTivh{oo&;VM!L}K z{2)R_fVP$3j6A>xE^M!`wL0qhCnsR*!e>*sc1McU zUm>V>xpOx(B9sP)2wLOu=<3vBwtoj%)8d!43>e*j0GWu?uAi^MQspbl|Edn=IGr)u zX_c6&z~>M_>XtH^jw2Nts*?cLUIzU6`Ffg%-kUt0Kd`7r(g3LbUM=PzZikV6IQ7k+ zoMP~}3IagNC;v9;;L>WiF4PIso9q`3vOj+~=B%NM2U2tMqAp=N5UMB&NOV7uI|=Nz zI@lQ})I2OmRN7E^)yu5Gfm`XWl+~^ZK}fp|5_+fDwfkeLiJ@#E=#NzD7WMo%%R;vzzwiO) zolkaMBG}o8Gb0NzuwAb4nw(#i+2L*n|6c06@HwTrES_?If)|+BW8?)I4CY43J-5 zrr`vqeedxeTc}G)v5&%c<3{^w#L*l!NnE>d=L9=v>LZ3z@VSsTKpe*mi9+8iT>E(IdGFcL3AXfIjk3Wczy!wAMgktg^% zak}VjKHPj?po?(LZ5}RU!_^>dMt1-~Cw&kh2Tp$o%KUSJz15FXq8gZ1D4Q(Zr1tqF zD6ZDW4LIK;q7!KT@2gFu;q2N4&$VPU>r~jxF$_<1todpEa9vNhAy(EvF5kdXXM<1$ zfWdDNB;UoaRYI$^D)ZAM`($G1$Kpmd`T@sjoL5wqOh8z~;&j2ck? zCb9pX#qMsE&(ESSfQ9!TqW?PG{7*Ph1`dw@XuX+M+qC(oFnHgpLYxaV`wd61#Y_4D zos;r^%xOmT3<(fen%4qUHz78=z&;&vk%&E53^r#2$v}atClG}){ogCiOTs+9A4?X| z-^*RzI{tb(-dd|B=%{!?Dl=1yRDnDpLE+@khS6- zT~GP`1V}300Tp$uXHf8cTvJ^H9T6;sPnD>rlZTfK%zC@WE7@GkR|&Ksoxi%y<{lmd z^SUP}fL6BaI`=RLq{`Ti&Q*L~+rV@B7z*JZMXbysm3KE5t|z1^5~SJ>2*-Uc>Nc-O z%j~LH%b&_H-B7XV;s1q>J_o?iC^EtLAY}fe(jtRT9Zx6|BqfXz3TkghpT=4VTF%rz0qoF!(W0*E3|7jjog=vlqFQy0Pg|DZX;oTP^bgwQXz3sbaRA62SlPJ zpl1;g7m^N_7ywM>1KaeWGNP=p`q|I9h$558;I+=Wnu+T5sGXwoFPN5L&ck{!F(ZUZ zd-XAsN4;q)#Pk|-+Vj^sl1rDyDBOu2|78U1#;)MrOMYJFIH_IToixk)eL%GWOR&@W z7D)R^N8NOJZ@7QX8d%gd|GFhA3-vg|Oo28A08KnN37ID>0Y#eH>pqRVd_|Z%W@+ea zifsf$(qnzYhpg~`8PmET)6-r5*1MHe_IResaKTUX!Qi2Wj7-{JOs1uG8}_^S6($iB zXD1u(1~_@f->DIruJ`0cdeArCo;}XcCgxAX#E> z!+yAF&7T%dZRexD0vOipRIi&M~^UsW&ybWnu$F1TN-eKU|AuO=>1C5aO> zUQp13UWQBYAPmt_k{sbW|C=uK@_WUJN_KG`%%-ZtnSW0XoPT-XnqH}x+xl0c5v_EH z<)iox!R116-gf^)8KJ^--H(N?3?LaJbfN?j!%day;-%5mmtLM&`Ft_aH zWQMhQwH@{%0Px+4U$}!d%QTXh58+R7hoa2w|c1L+-oW0+klo+ck!#XH2$6{>o^g=HHEyp}R z%QK4{MPQq(YT8e~CGmK^MZCvL;eB0;-eN$imC$YjEt7WG4AD6Wn} z!5a}SXh049=EEz2k+pV{3(&%1BCHFJiFSoq$1ufsvzm_1G`qDK4Vh0g-x7OEMvB}$ zlFkIN=gUe}{f1u5ZIXuY?WNg|90g+W8}qCJz=?sQcF}!UX-t z8Qlx|HK)8j7fQ8kA+6v)INDi2$qHrb~;Er(w zdJe$q1J_|kfFf!xMyds!VPL0t-f%SdUv^@*3TOOJcWdX(3OX^3;&VbX@IzWv+Rna= zs2{mgQ_hd^fP+2&5b?nwPT#13U{&kc)byd3LgcvZTyA0fv%Q1yN@Pd&sQSK{87{y2 zF7XCeyDd5`;S~o&B&YI{bd7@PbogzigM63&k#@+a;j>FR&o?tmI^njlnbh#jY8J0s zQ|G`@%;D6R=)S`u2O`DH_7Splx7DuttlRPHqGN^lvj5=c@shI`<+RF60_;=DEAgAv z1(0qA<^$QOGMgu|jo;XxR zQH;ZzaPGIQb+^qQ2iw>CsZBj@>o(=l0s)(#$VQ`0I#`@{Q*&3(9xtu-@_0Ue6?vNq z>>?+gF>MLbB>D49XyF&!U*gX{q;JkC*=#e?PQie!+Nacv^NyRAvnD6~q&lauO7_)+;m zn8-U2Yk*6P71|Fp&%AIbu!Qu(7aQ|MX~BySPdX9XA z1gT_T{m&k}ZZ%EYOmP&SU0we!_+iB~M%6xTkqNSM8&&HB>n!i`PyYKM(T0A|E7pad zHy+1+FxRU#&2mW*zVNY@KB+oAjp@ISiBe> zX@vm;Tkh|@Q4%~KoZn+aNqH0nH_h$twsv1881iBt4e9A&d^Y%#g9a_yNkMID0vh zk48aZxiEkt5+HpL(ll&Lp;S)6xV!;qgnX0DTGznO`FFC~%mz+dqwRm2iPrLjy?xJn z(&wk4to#0d5&h;!qV`n@u#jk8mZ<{23h0rJR-M{4#2d#VW!l${hNq}UTU`Mmb(dc9 zH^9*>7s%)$^(a*v(gqf|rzeOKsSL*vW~AbIY%1%#n6c51sb?30)uoTgW{Xr1Kxm*I zH>VswNu(^z<+$5Ax^ZByL_gbdQdO8%cT^`w8!r0$cyIzcKj&=;j`p{or{4^|PF_y7 zB7`8$U)!A5Z??mKNo`LAApgMOJqA1f40Y@Rb$Y$pabQunslwmh)cik;y;E?d@$!Zn zdt%!Y+qUgwVrOF8nb@{%bH%o8+xE%7PSvTitMxtx&$C^?zrFRVvVl=7 zvY}d&{EJ+ta=k$QLv?N9kM1pP&BJ&k==UD40DqtGZ5EGHw$-q}{mY+*D>f1tNHr`q zV7vgfUlB&A76A?-Mvjf=HR0kt41-A6jNg2=OX&`e=EnaX9D*Di!E$ATsC4HM-E>q1 zK)s&-CPR)r}z z@xqTV7v{lQ;ZIDjZ<;cW;O!EM83a89fFm5vptg5?Z^ow14HpR0A0@u)7syxv$?+i^ z5Avlam`Y`&I8|-0!!%UV2b^Rt2jpM1vgQC;Dm)-^UU2A@II>P*^QHcC+VkBzpmUPT z+60Yh2HvDc-l4!d`28pg9XfExx@1*si3|`O>|BW7w{j5?MZ3|&dUt~l0>J`OYEAfL*#CmKK` zF&|9}mTUumV%}BLln{YphY0-His;I*n&nO+r^RyuAn`ZZmqb?C;&jyayBsQ%o=g{r zsIRR0w-(G4Hh212sM$)LSjdO9ShF7};kk}YF{uuD22_sq>6nnhy`O6pQ45^17qumr zYPL0l26W|FCi{T6f=k$&5JB07i_+WUi$DyUts83>iFPtXMbFOBqCnt4jL>>{)oKZk zKy@uM2%zPOOQEe$z}(IPMkFflESGsnMZoM&K*24fMcQqS+CfBdg?v*La^;Gr9%dJ< zn&k?M$wpj3v>$~|rW*C=adrGw*zHGnPE0ksPdAyd_9j?5P5&T>Zo{WC1R2dT4~VkP zH;{stEEFrHYNA%rWeJhq4&iNg%)GR>C+L(wRho zN)5e;^S_=P5_xXhq*-auB%l!+4bw1)RopN6BZ1n|=3Wu<_^!eL)9@$UYxe>uH-=<5 zt(q5b`Ge}KG0swL%a)FoCkh_BHfg9S{ph*FSi9RR-O#P5^^nXlO(J%O!^N zx*i&6$!b)wEu01nkD9|IA(HRxYmGBQqfUPk41cgrbHIiEV8Q6gC-EKv7KLkD5eSdd z5<;{;@WF}DuP?5Ze^UMR$FY+Ek8~qXBIpx%C>UC0-e$ThBVV5}DXOvu!{N+WVWnWI z>9wyO_FEUGFxEq2VI26kw>3viAr*QCz?~~+6ofqJ-`A7lMT9VWZ~8PGWH*K%(xSoF z@N#q<{t!;Lx(1aZa}H*c>~^@`JdOw z2Ex_fGMeOqG%RyA{`f9d0c^SDEhr0hVGPiD@UhB$VdP#Iy_X73q`^YwK|U106M{9v zTie|qkQalR`v0|#{ZB+gMrOAEnA=~f|9`u4${8s?(R)foPsdC!b9tN2Q?m2GdTCE^ z^P;GMDC^u2+v^)5_oh5OYl8#*m0F54TzLK|uY1`CGGe4)0^~zfAN$4)5!>V0TS#oA zNEq!{a~~`uETmub2s^UXQ8$d#P)w`@EbfPQMTOq4E045$PFBwx_yaWYZ=^@W3RJV5sO8vNE9qNG9^Jd zjYNX37X1oEUE<}p2-jb0ifJI0147+0lmkOe1yc`MWxoTjbq_JKR-#)GtEWV$I5O%& zZYsI4{iJ0rlmP>r0l!>NlTo~A6JZ@chnw4K)e-edd{O+Qm-SY!tZ#Q1m&i%Q1g*d% z0#=v2X3+NQFRBzAlm!*y=sz91>csJ&gm&9u+?_mJyOgGXHx^@2KU*#msgQR*nAI_b zcQjeQkqpqG@_09Hr9Uk zOVB+|ZSt<)TC8KnpVCKfyf*`s@+P5vhf3e3o?l>9^B=r+RT0KgCSaBd$td0bL*kVt zbo1uWh%T@{ZJYA5=I7Ra{cMHlf2YSlejkbsND7q-#!OBC6ksYQl9i2|2q-M;6sfjT zHBCwY-zK5Lef&vR>AFc?{aie)PsfHvQuPPJh`|V?QGi2ygsYVZc=Y=-f68G!9YTo< zW)6bk1u`t@+O%FuZa})!Nm5v^$%*^L#E{6UustHb2khfv7-j@+xZ1Pon?lr&N+T zS(SE4?H5f(2Ez1O?pT0ONHo9&>cG|CI5!*oF4wOkq1`0mScW?ZFX+UW8!RMK)oUAz z51se79hV1oW3OAou}FTo65cMYSTRse)Hh zH4MVwM=tA@a!L9sKE&J&bbDI}VxRfOaxtyV6ZR#-UgY!yul!xpigM-Ths{0Bj`{U0 z7YNfulX9DKUC%&fYD-?S5^!_Nk-*N1KLcVC$v%%egDrYnW%Z8q$0h~i1-1)XBZ3^T zeD=qcY9`my!2LC2v=!^U;4^1WW$Wws?%WW_#HRx@H}vMwaNKg43!8GBE=@Lc@pU6I ztT3Y!nAxakq#4Ntql*e>>HHMpHZeKVTbVvQ@0Xhwt=o?#j$S|769Xpums8hMZ^8ra z2lVZv!{bZ^p5vg#9+rL$LtHppK?NT|Avr&N%%Jo`Oo}#J+Z>_c`=;qeXYQH4`b~kL z@+)=vrC|J#!mM-u?3wV7^P|jew&R+~SA@;X@0?C|7hf2FUCR?vkeZ?V!2r6-K4;>t zIF4SfWbkUt{ELz{AjY{ zTY3hCdd7r%VTBTkn)?2i)=%k%9harFFIB+O6XT z)AP%A0X)q2vDu$o1r19IVcr&e{@imU~h2W9EBYW(8i zzwhsF~#oVocus8m`aXCsZ0Y zuANxTG#50>w!L#r8^E5}{tWx1a7>2fmu*Infsr5A#nSwBQoV5UN||x05VRxD&*7hN z#J{XCQD0i5m!l%UPMk1IM;dKII~J*wM)Zpqw5v<3RpMf{Ctwhqk;wQ?t}PkKm*O83 z3r8Ug0a5vpKu$vKmws*XH2#telNhAAN~wBiU$N!x7^ix|(cbfUbU|~S)O}VSE8i&z zs4mnLYE{}%7Ictew3_UE^QskzzY^uSpYCifD;? z>)U;%q#N^&#}t!*flvED$Q=w-U`vw~(j+1nv5DyzTwVY?;E2mmJ){|9XP>V?FU~!4 zBr+=B<{Zaq6^YH3>jJ?fBB!~vr^F_`y_e|3gkRPY;`z*^&BrC;7Swx>8i(Z)`;UvF znu+suO0a_Unf&!yi9-iWTA!cJLDvM``DWmtoDP;DVZjs&$7q4Gp1AlQV`LWzJq(`E zmgmeCZ++yqcfPQrk)1c(5LL^1gp;GZmuFpr~0Pea;6 znBfpLsXTezgpsOiD?a$Ssd{@@?hp-ls>Bya)_v_17R0}?5g{lRjeS4Q#b3;pz#|;h z%O}bZMd6fecV)tWK_q43wIu6x{#NfrgY6}rV%uUq=J~K(0KF!o-;iMaZ$4m!Q=IdcK9>*OO7I&K6?d$A|iC?k1iD9<0 zdW-^*)8BoUsxHh@Cuyf#?0_HXRzlz7fl&9IUzGa-rV7pyzBY@utRZq^J@cu18*!%*)=Ko#Bx zEG+$9q&eKco6Zdk+5@6KdH#{mx_DypT1&|fPjF?h zGkBLyR*`WqIOkLKkIFDS)qkLNV&sfXU23R|Y+eX&6HEx#@~6_%;5X~iZ_i^Tev;xm zKTIF7O1p~a?d4`%;?~9ePWKT)eN4Y{a;({hOp&o>$mqE(n=W2!Iqi$JC4Kd@R0-Wq zZ4iF?>oc#8p3$xkF@yyHFGWkJHS<84k0RwZt*O<5^`Wj_A?!j8JT`0K>8|OJ)8n~> z65TK?AP_zVPjSp6u75Y7g`NM3tb6;)LdN~CA^zqHR6-u6sF?6qAj*X+`J2!AG^STi zs&!Y-1oy`PXf$)*4`_20*u{fN0yo;x+tj)JRH~9YUTy&oe&Kfp444X+=-sX05xDpU zscOHU9R?yFQfzit0&StXY=O=4fMIDVrS$HrJ_@`6#<~?(?komGkO7p( zJKh1pYyrv#m&;#Tcu#eK*@fx0>r0zhDNhV`nY&^S0JgaV;W4LFA0`4AH92{{?uJ_6<%nRrjyO$G>DTdFrcpIH}BqC+A zmlGN63X_`HofQ)$p)6g|2qupjwglF~%rWcOrMY?jM|sy;rPzp$Y+Q63nyy2Sfz>zR z8#az+`ISWNYD3^Jdw<(zXVN>4UMJNssOL`UH~*nY%5o!nsmNBVnf&B>KO+GZ9^1SZ z+^DXq)kdG-#!XkNx~i>~_o+<2I_`+BW)$j8PHQLL1>c(5J1A$Tx^mH59!`nVG=Os* z`-lAZW_pDJ+ey8XIRbckQ>%r4vEjFa-yDe(UtRiiU-qlE-(L3b^OuXy-Q8dNlb3t+ z{GG3EpI5w^+TTWkd^+EsZ!Y%sVO%|Z1T|X$*W1|J-ItqkC;uE(#elTL*${lMYP=7)`>tBCaS9Qq!{1qx%5pV8gr@qQb_AS&|_=y1_B zby77Am(WDnjN90rt`iBbo{rCF2qtkhq86qqBzF-9F&t-@`F`I?A87V&I4G7p`ny82-Kk;?oS4r~ z^oh~*RM`pG-a&}T1#M`A^Eg?7!3fXwXybh7N={K`>|*(PBPU5Yu9ogiYEvjMx_dNy z+PD4sb!`%n@!$Fz#{Z4V#L4s@+3ibB+5gLKcm8CzPeox>B45bj_`oC*FzpmkC5;}C z-w7?-bb+-jXzh2wPGYVVNKGtc2VF8+c~NQGk!63GZA}2u3<@%!#3?@l3o?7UEmW@Z zbEXSYN=W-C<9~piujGBieW;S;`S*_{FO$tHmWx%$QWi3E393JECix1j$BOZLJ>p=_ zF>?r|NgKi2+P6DY93sk}{5DEAwE;5pL~tiT5=a?mgx<2Zr^8;?cyW25Vu0gIEIfhL zW^!6H9Fo|^X^3eRozet$6TGAmmK5{FlNyl$$nFB{dtpc5-|(#V59oyh;w_A2DpECt z0p{<;=Vg1U35%zM^VeU?5${@Wk8Wc3i@gH&lepFs+Hi<3gVnyVWP`(ChC5%% z3L#W6!f6Yt9e<);+JAAVNTh1e2fhHcra3A`tp(6J`_Sg3!rVV)70qoYU4GivC8E*p$+4p@V_2a&o#sV4rNUyUG8U0h#AL)Opzwin;oOF&Wd&R|Sc&|laSho> zO@ZYCO^NT%)K1&Uy9+}_B@C|{2D&YEXOn!AtmXE{bIa*en z|9mTuze>`RW8{8B>)Oh1&qB>R@xG@mbzu$HSeFi|XAEjkup|4$75*)oin)Q+B_DNk z@0n|`KCNhdK4iidQj@C$9p_HgV{^}`q+f0o!kR6eEfs5*3u`?pzM9Z`Cp<*R*u+G~ zGnf-$cB!Cl$pJ)3m+J>24d-L|`rmBXhI&K_A-sgS8gX#(Q&!G<2$O_G<^8P;1KH`} z3NTD;l0c5(Z-APL`Z@il-1tGTOwq#G@sh#zzty~?n1bJXgjmK{}>xUNb0Lp(9(MaHyF+`FE|2%*1eGQ&@^372c!6 z@D&ZeSoWm$2Y15aojD*+i+W&VNcAz=3x-TVfOEWFu1oKxs^48^<=X7-7i$aWYOybW z^wDM>LKtfDfRo;fK4~s?lo=L?B?q51mpFg@XJ0JVly|>Uk}X3bJJRPFw11MSc_)?F z9HTE>*?(@f6E@u_+JO%J7Qrdpw42zuWGjURk1I`t6?%uck0Gg|!au)_UL;L8E6G+o(X2+`wpTI0iMl6@WX& zMjsFl!t}&u*d_qtksUOKYH%{(l0asVa&}_$(5owBBF>Ix0spQ6BSLidD#F~5f#|u; zBFEC5^?AmD4MEI!9n<4dWJ?3@Y1tnP@)wfp#-1S04wTA+f*Ou$hd zQkVMgda8HjgTV>L`|!lR*>KjyCKy8_i_ab9NBa546-<9)h+~V^vj=|r%snD}rr2%E zwYx(4-l>;WBW^oW(~}PTP-uzU(jma7a!c$I&bLL)n(I{XG@E^53hp=}*MmuXAMW;K z${0`&k3fFJn1Jx0szJ!P^k|1xViAlf^2QR}|4ki4D}EV>@%Fk*|8V_wVe6dd`};P{ zHX{V*$GQ8p^vD~it9SD~_1I|<5Y!fxCFAwIz3n^w?rCv-ZFXQ>b4?Vwl(g^d#;-Ta z0#O}^8ogLl^FiSA0!t(%_WfTg`Tqp!Vr1m}k4irHvk_fq``L)rAU=@-qm6SH0Zc5I ztuVu@?VtCK1mjXgQfb}e0c`y~AMliOaZGPaR*rFm`B4RquTz&s`P;- z4tU-zp}KnWKPOoGnIaMIp~gQaSjU=;rOEa~<_;Y%jQNqoMVJ8Vu1+u4d*OJdp}qXF zq5kJ<$=WeWS?|E{{$vuaTC0QX=9*wG+nlQ%T-e$%u4{FM3MX}Z< z=O(H*{6q@;?rWzq>dnM8FLbd_JNsRhTMI-EsW72<#)>@@a<3xgO=s)lLNg-A@YDmk zW_2QOWJ$`b9$nT%lHNl`)-mXZ_KJ1uoMda|Md4qu;3}q=CaGEFcezwkNN8s&s-Abk zOhBq>B6*pJ)URUCChE44t2%V%6c|Qa7%^+mVOTC;l0<;p5?Nx2N?|#raMI@haTIDq zlLM?Qd>DwoVN%#F&qt%$Y?tnnl@R+O_yg!20R#1p74RXwi~d* z=eip!>`e))np#btm^$f)5`GbsJu*R$4Sst^3xiK%Ua?Q2Lpi@P9Ji|<-L#sDi}*^Y zKRrQYi`5H)^QhCiD0D=`ZX9`eqDu_DBE>ShO7MvVB**d=WzxmMzS;1d?Czschns zblta5$l9;-w}&wKnW5E#hGQYKWbAsH;j%C=arxVuMhe<85zKuyQ~vg!2sqCDNmo-B zh15cpP&^uefd5!yFeUlPDmS8*_My79A1^75h)<$(v>cL!XcWmy9ZwiJAP^7v4AzV1 z#M}#hJP>q9$v%b)L?%HbgPm=M)xEZP$WVEh?fZfuEYx8uzUN0o^d;?;W~4EJH;fdM zA67P+H-P%XV#{l>mpOaPdLH2(oZ@*q8n8ecxdUB0vfxGPDK$_rEN`)8H*~NRxf>2) z6QxAy?U(U#h-Q|?&3VQPhj0$waJ)~dmAHnsBnJ&}sfm(HCHBwe`Lf~qCGYZXpfHA1 zY^@Fi<-SGIhGPg;iA@GUs&UhWC_@pXUP&s_%?2QvXN>Hvuf%>wfh-hkyhkV-N?(m+10S`fNtRY(5|r`}vfkYx|Ju|4F6KCbVy1xE z*`LSvdM{c)-!^1**^%Y7qFsKDf<#pI=Qx6FCFhT_%>K9rZoA$F{r=8Yr%>*KOjhrZ zKCjCHW0!5%?t%ek1+m4Lo!WMlY`&Do@ebi%p_V%I&jN@iiX zd1{Mkva%2ol{QFHrvZFDuWrOjeB1#ItZ#O93eBn#LkwtARb}Dn>FL+o<0N@EIce`r z%uk&n$h3+c%@{tYXkj73w5XK4YnA3Ol3+?h3}#Uu-G3@kVNCw~c;S_Z4?+z^?yWMO z3bV`ST$Vt(GNv4LAhLMNvz2wfpnK;q)K=<1_}x}0aZYR{kU*O5q(*7A#@_w)&HT2cH2^FH*Qy~cWr`w-w7?=G$jiNuIbgj&{@ zZ%)?UH3=pe^@(tiJv%}gPa3YSlk8YNU!OfMgO;xXIcxeEG2eb_)}*8|LLB<^UjOXD zp38B(^UO6~2GX!G-p2gr`$7BB^BWbs;?3#m(`Y_;`*_P2^k0V~9#A7SxFnw)5e0|?ulP%o&k2*>%@e3`YJwd#{Tyb;S~x?>0Q^pnhURXKk!eTU`@r`W%6 zc-yCTvk+ppGqE;(CSpVaVRvl$P#^LnyLtFp(c+j#^hrtx1&7%X>%h3kwD=6 zKR_=?9FaXaorX%&G}%X+wvvKCx~{{h;1s1evO}-19M91b2b)kjc;Txb%O3$P6yuyL z@N{ZYyNT85_L{f_q!DM;lqzXFhmdt}G2>F$KSE1yzPrS|s0NZ>Ob>AO`4G#vE0Gq3 z29|P^dvh&A2$Qqe3fjMgkNNS(BhgPIyoplU8>tns=g!Qj6VdeTFPC$3={oq-oVBx^ zLxt}DWqbR|6HCmWd@tu}COlX_I@v_=|BL6BU_g4KShbh@E)ICu63G*JRNQ*S3 zA8dnM`C%OfCYf|Tt~OQqxDMGITP5YP7Dx5BVD7`tMmIrG&IXIz^ssf>6F#ZBa{yk@ z%>Q-V_wv7+p0L5|_e%qLGI~;Ikmk00{;I7*R<|$?ArK)nW8e)VFw791$7-<}$BoH{ z?x$jhbcDM)@P^px1fv1;)tW50=on4++fY*%!Hvn;AY_YF-n9d3o&0$DfK3}$ubS)* z89|&iGG`BlhfN$~{rYxiY^nxg|4x*w1^U7{gUN5FVZ(7A@Mo?gj!nJjBYXfAZt1CJ z@IsloA{jg`zIJV|LyQ-uQ_7bK&#f%3kwJTLrPo)V{m!Adx%!Jt%2s?i{@2H;0mNfL zNJ&5$><$>X!P>@0+hQO%7)(dS?_gc#-zx?1%{HMG9Z7m&*9N=ONZMQu+tx$xd=wwi6@3pvYrlSr6Q3*$tOE%#S^%0HC z^<;Mm)6CvLB1uBEu-K|`6S;Y~de?fEe1sO45Z;|%!#NDD1Y^$Jj|gClh~jyA#Fhi0 z0L9=-)KS;$XHQurwhC!CXiUb29jL>kE{ekyw&=R^-0I-^MPEd~KV+=j6J;9;SK^9G3=Wnh zm*tqaiSLpJ@pQ0CM*?Jt9TPo~Rq-xY+&`fux^!R`2NC`!Qaogws%YMNHKhXX;=pZ` zSkiBC@B|(Ma`4)~87yoUrXjrWSM(#zpZ(KUOLn((AA+rd8LF&lu2divA?q2GbY_1E z6*xDp&I$5Acq}!2_-vSeMFj#9ns<>)0y!5m*!eq%?T>i?Mt;y?KeF18AV4SFg#Z%`vso_G* zt3JD`I90@BTY{b8vx#|^Te1~$GIDmkA9jO>S8+!>UsFVOz7W`N9OU`kx?bOiUdAaidVB`KM;R z73l|}c2l4&66qEvVx3ceTD+3Kl0ULqB1_<8oShm<#u*RzJp}T3nY9~Re;{m@WgSOY zO!1c^bDVvfA!8b+Yjg);I}zl|G^2Ra>$}$dQ_jk5sJwD7Bc$ZlG7g<)(Zi9!vvhvZ z+SmK;H4YItwKTNe{zXR4)_1FHQKIDLrTI-uj!$v#dYAP({4mvP2wn`!`?604OcqPY zlG7hW@`QwRn79V71oQyae-8N>fn_0${IbLIjj|QxQqh5zt$(IWMqxDF$g&~1v5--8 zd;D%QJC+HUs=2tY%rr$6V=JA`=IsM!#WQIn72ZPsW_1o&k)4$hVBZUsnEn`mTNfy; z6&AYi>Be?p;xWORSwoQ%nxu4+CW9(;8-1=%`xXobKE1vP+p{-0;uz4Tr6oR?7B&na9u8*1 zrD-1Bb2zxe*Co9Rmm?c4I~Vc7H!77Alrr0`uglkWs-(grl^rX|CWBz4h@-Vx%KXQ7(VGzgXgn8J^=D6XO8sKbRkM!vB`uEP;CGr5+#R* zUS;LCa~igc?i3{H#yld0-Cqek2~mQ6y6-7{V4{StFdth?LVC??aQ-K8Gea|Tsq#?t zazoA9mEPzCM-D6f0;FQn`L?@p9pVHGi!$w3dLx5f-~94=rJ#9GxX@GwKm5NCl|G^5 z4TcU+6W4!9E6$#s<}k7jWV3|gSz|+|w1Yq(2vi)fN5iSyoBd$pq8fFh+u`7Fxg z!~Q0*@RbmvQAy>}kSZ)Ri9+`@O%T$?6V!oJ5SO`fN9^hD8aekGyMaThvtU2-25&Lv z*Np*#ZqSH9M-gI@n4xG6)k}FPBMMQWQU?uw;=XwniRs~CM?B)hp32-Spb%3P#s^X_ zmd6j?QmWRs4kx3Tr|OYeCNWkmmTzUw`$%w)xDHcIne#HYw`~OqJT+;RcD14V#FQ}I zTj(YZEMIfXHN#Eq!hte^Tm3>zJIuecpSp<&l2U|fX#m49NKI@jv1f4eJke3uU$I4G z=D9;E)E-#fsuAG3a))n*ZN;WBAheWWSqH9~$*Gt*%h%Kb!c^B2haWXYA}sH{&ui6b zM2A+RsC(iY&Ry&ic0SepyeVQ7HkjD`&m;bZ(72+)FXB;b5eN;Z5g4{^D;ont zk*Y?vc7X+SB9st9n2Nid3z2o#U-sh{faW&4%tjkIgZcx#i0IPt;Jlnjo0c5ndMjp{ zCQV(Ng||stX>Bd_m&CDTOE`yur^t0h?gwRwVGE4jl-#4Renx&md%%6q?i^b^Tkv&x zHdK^g$7ur{K9B5HK+%&b#~MgOHo4ph#D`^w9|=Mqo{_;bM+#@q0|;zu zQugFJXmSY_HWWh6A9og+!V!RL9PInR4rQF!>+N^wwW!S6f0CFK+mJbB>ZVE zpeIlqOB-URp$1Dl{KyD66GF>=E(A%PWfzz(6~2r?Qz&5W5TIbZkN7J}0V*Xqc`CgF zE}htSoI>%hK{_!$>CXQbJ$4Vp{i`uoJp&B>N5#*Mtoj&U=mX1677+Gh6LrQ-0anUQ zLj0DdHt4JhEmUMkRdCP8P68i)C2-PMp?y%|2&Us-K%}8**LFX)zK-iAN(3cF6>q~0 zHUIjRTFrFA9xfd{B%MDd+~7_+)_i@oBm#Z}17DsD`463TN8WOHmJc6pl5bGDR!wF) z>!ok8$8NlX3NpFOPsx{v%Cd8IsOvE!#)V4}%loj5wY5~CA|vINWgmFNP7`>Yk8=c^ zEZ<(S=k*u|Uw|$!xqa415^uz4zGVh$$=~akC_P>AzWHQ%4V{7mgsMxtoz49PkMz~{|sc;@7eMX7?w2_$W*JbiV z?Fx~_t23-Ba1-4kS_paz=R?K`qgz|6d&B0zJN3rEpoDvf{B5~lDRt%sgd%R$&KlNeHS3t zE~;nZYPYuOnER!cIdAS=MI<;!Z`0|yYx%bqu*jei5AM{!XRU8{W10{A-Vu*nv2zPJ zViCTuK>|v2dirZvV*e0 ztrdG~{(K*sTL)`A-r?KaD2$r2be%a>WRLw2VI2q~*w#i`{*35NbeHho{8yyBS*2Z z{f84KN<-GM@MrsYtggVxSe7e_98cIXsn$%@W>vJ*!T~ukf*%hIfVyx#oG$r8%Mf{} zlcED58TG>nb#BS@l5~sjN05*7+vc%oKUl6f*c6Yu$y9Y8OsH57N`X$Pq#8Rodr^Pe zRoRwz;W1VkQ@PQD*HlD3J+^3cK8E+z`;0@?W~61kh`1|K@p;-5Z`)+~Q&^vGNJbC1 zkQa1t1u)6{rkQTTXyel4&?RJE(XrQKJ0i8JF*F3 z^jhAYHmJUeAw4(?my~|<;ZOp8mf|1YO1TX0~)bg!a;J-U}UT%VMd8#(#ZY;6)(+ZYca@pzeuHK`_ zT0O^!YRz95dTfHtge_zMBRBJ#_FKDT-S1gxawsrVJ>frvQVKM1udgE&XsCcJJowb# zP|WI3_?7S8tL(1@suw}wLshGD8)8n5dEItq3@un09+<>-Yi35Cu^g|p zq00(x?Bz8@;8{qisZw3cJe{EMRHv;$u1FrnFN}1TiJ53rPt=DM+yen0^a2dI=v^5r zrjLPj?m_`0Nc=i(I5(2H6tn2KxPRFFuaB0pW-t>w!0%@BVZ-_m(*5%lT2Nh4JIj8D zbN;IFZvDh+%K3h_!9C);=%{2BUIz9z(k6A&Cg>T{MsZ&yn%64IIT~fgI-ZRsW?!GT z_gGx=J(nQ2E41#Rm2U(iXMc2ir~`#o8TW-3m^%d(icA(d6HIfw1dggfsPYDT_YFoO zMPt9Hgo-0?jOLqzykm9P9k&`@;vx?E&1g3?8S#sve$9_~9Sqp=lVR4&@59tg3R$8d zA`=Eu!>&AtF`_=-PfOA7Dg9rgk23>TlhN`MUkFvg*VmOYTq?O)8+x2}bG>e`g|~sf zS1=*`8DDvtLS)Jw>r<|w=hJ`_4Xi0Df+r39js}q<;;p2v$_@y$g}lHjDJsm=jX1D) zlf?FR52qbXriIFz!J&_`{N)UH`coKk_WB%5E)Wio__{2s^;;e9dWxR5c}!`*9x)|D zj-I4dzM;}x%Q0(NDphhN7(+6bd>q~r=DJRDW60f4|eeyz)6uE2@KQvWGiKgd+ zV9?ww%TgXjlGfbXKbRza_fc0Wk(hll>LmrU@Z-~WiuxeaV0tX)*4N<-pxda|@CGSb zRv<&%LCPOk)v|i9Mgk#W1Wr=}5lOW;o;r}#gX0v!V!dC&1lzoTG@?Y8al-6Y%+jjQ zA@L0LnKFkU(DkyK^{>keH&p=>l%uv;Sa7^@4hkEW(;%%LkoYD`oU?)8nfl0VK@6R( zddzfKtEYUMWr0gxn*G>VPj=k_a9!yJ5nEoa<|M>QCL9{jPy+eO^p4)X2qluiIr28! zRbV=1>VYK+)J2^9Tv8P3*cxRsYXKO-fl_bv899w1H1rRMPTd%J7I+QKU_N-=DWM|% zj&o4EvYlWM%0vy2FeYINHfcgv9G2r=#R4D#QR|d8QwQt1r!wj>G14B_{WP4;dV9O4 zBn@nXY{$VNzHAp~X85{JqDy~0=O&XKBkrtvH1^eVi3PMEV_}OG84_RHW9Cjz2&2=_ za5#7nmE~P3_coBK<6llcT^tw0ZJ-gFurl{C27f>Nx{$W-cd*u;2h(t zboR~<>x^HUL);GqEZC~X%ZAXqdp1B2(w?B|+WMT_P-$HqvXWuPBDC`1%^Urc?cj4ik3#pm2Z4w_~8^N4>U6}&n3Q~8z%MeY?WvDuT z$8yi=O#M3te)4l7xwgIC#`O<&124(;NEKcUIpONiW;CZw6&HBDq*s`HUF`qxhlspCYptWMl+GfHALue}qne|IM=s?WIh8$HeE9Cu zwChuEiJFtb02HOe*83!T|B3YfNzHa8kYA(=_7Fc?qpEEs{$HtCGXjztQZa=Q)!Nlp zBpO;qcXPK$5Hcwlxb^+R<>h9GtPo|?y~nZ5*7nz~&DLqZ;PO%SV7J=kEbphJEpqqEY4sq6FoS#0VIzdcoR*&$rEBll`#ZBo>GKX%Fv@DcKY&Q_CXGa@4?(qVjmlQlZ&? z#5-GJLqrgcrK|q9uRzCCk>cxq^a6OAR((D=#K-o&N%yBnX`U{~9RJg=TRKnFp>|Ps zaa3F!-wV+DYmIYo$UrVnnFe-3x*)O#qBdpif7e^O6{v`H{z*3CB6hwiaW$YC}3gP z%NGWx02PVcQ;PA}@h^7*Z=G9Ud{88FWa0z>J##tO2r=k;=Sq2#$gkbLI@X@0w5s7LE1^3L05C8&xnQ` zsRQL_?8XZOZBFKv&Wpsc6$M4sr?UP4@Lc3ot@2!hZ)NFY5TRl&s*1dN+@M?~*i7i= zWP39|&9?#&dH;p^R^o51xK#VO8iu4K^jxdLR*|f6}D3=!$F@q_x z>JeYevfAn0yFmpCg=9%V$K7dKnwrlCA+oJyld#`)5{f+z4aJw0cR&Al|4Ff2bE99{gYwBriE zcWK@*Z3gwJSBDZ(NU{BUM^=r8swqxl3Wq)j94($>zST%a?m1wG7mC&cF+fFVA*TWG zzFX~4norh~GtqJ5uf<3=QlC#_d3Y<^n#5}Ju*1!8{ggYy=~0L=0DoR1-eYJe30As zrX=LNfuOFRRg#h@4!v7=m>kmo-Z%a|nC?>J$gFhT7l)-*$v;nB)9M(Zx{|e=dc7;{ zn=)PkrF6Ejs|DUUX4L>Hpz7SEN1Gq;DDm*iVX;EHvH&B;rj@M-UGxfIh?5LLG-MFx{EEN;rnUnVLhrA&TtCnqC(J}60dlciwiacSA)-$US7ToLX?yQxCR1LGF4u#hP=U-aO412TgEFR%&pkIsZNtg?Br^0R zCeBKeY9f^EInlg;A|!$J`eR%UK2!428vn4oJ6!x~e?lOr#T0$;1O_}*HQ`@YLUg+q z-=vjHFC&=2QQK!-j7HD|?85A?k^UK*b@~v8h>mYhi?sz^F3WbT9B>*^kOC+AWI+2z z{g$Nzt%3@A(DNSKAD{WfM$cVqs{2zKsbb6`rfdLP3b@Ml)bUlsFL#{Jr%hkHDzcIP zT3G%!>J0-M=l@@fmZUZs|9}6E-l;j1P>7<~5GN+H?FhW=If}jRUUKOUsEC1*{*7He zeE^hUQOivMBJ_SEUTLom1uvbs;Qjm98rU=!+W17)D*q678dp&Rk^Z)oHnA$ zxE*?9F&NIyYxs!A0ON;#U}&N-`KiCGQz3dW{HOtHtw*do9hAqRHS?OFR2xzn&U-Wp@0-2~c5OR{x;*}~S zBHQ(M2qvD7JSV*LrGy%4Ui-mc_k}fdqv4T2{+5V3WZQyULq1ABd4%0x{o2joATZ`= zCLZ@T%QUD!w#riW@ws2AexWG>l3Qb#LC%4blE>F2i>jWg!4(3>sPU!=AiKX-lN-mSLQwjOHr5}ZEpytkr0QWt3H@8 z9E#=AS@|8ffnaLXNmKp!HZi~(K)CjU+_Fy0bs{G2pFJnows}rP2+)Sayz|X zzMD9vygNXRki24++6g8@(=`cU{dU@my2GHT#)YGBlyQ=lmJRcPE(jk%4iYPYoX@{8 zHJ@hyBva)U_&xFuN8b5VhE}C#9u@L47d4j1 z9vK&f<(aytV)aHI;H=A>9Cd7tBi8PgzZ9)274iLmKV|`DUxN+S3au31*UqCN{5rPM zIfX#!mBA0ApxP7F0k)-7S|PVgv`ou4LRV|auIoof_>srAeCcd0?8P->Q|_=H9rT|w zRThGtO_d!@dCOX3cPmz$UjAWWYSH)AmRQL&W>!os_a^5m4B+p{H;~HaDs&KOfS@~n zRWLmUhR?cEjac1fsh8q6V*Y`30+dTOx-z?DHXw}gCFl~1Ju@w3FBZ0N-v{C92($HR zRuKb*cZ3WE-P3Lw#on)NWNWtb8hLzPk@bNNU)}uYqMKF`aEtGG=06NkomneU&ROC=n^xPR zSkp__wq1XIBu`4XTSFZ+KCNFac#cyAfUWijTc4Lz9k0cUXW6J_;`(3$p4@WIMK(K&_`n1a;nd4$_F3no=Q4PQ{;9mDhVAc!f)NcZN5zVKN6wrV0pN z{l77pD_;kUG;Qmy(&S^w;!A1nZMP)81jHA#a1 zAI9FXN3>`O*KOOjZLPL#+qSvdwr$(C?Otu$wt4y_H@Rmg`@{YTGjpbD%u#PWPfr3s zl;ppypY6<+nabA|i?6&16uFP335rqP~q6tGZzgkQsfG zJo9&oW(kxrE?T^e+UdbQXcor%Gxbo|-@&ye0Hu)=z5M0Y7+rOkYAo*4o2g%P@Cm#L zeA@@ol8+Er4h7K@Of%QQ=tK1d#=)Y&^@aLd944}#)UV7G+8U-|4^LXDK7jE&05o_$ z4raBK4xG2doOT4;*$YdW*n2VE1Utjxp@803$TTDTTb{DGS?{kUb>#ixpgZnj5u7V# zL}>Zo_9!iD2v2-)IUMICvd-9|FuL~c$0y!S2+9W84w^gq?Hvw|f*tDxyG)^;%pMzs zRCRMXy&i*}-(y2-L3t$3{kQ^p;9xtS*sK@u1fz@1xP1h6oW0(FG1S6tKZ<&=&Mz7$ z!!I&tK3qQck}JD;{cod#dP5q&TLpHdYUvlm>a3}$mqZG!`jv7=FvJW-x%f(RcbiI9IZ7;QOA11>&q{)f?M zX$w528-1H|jOifQ0Jvtq&PnfDKQ>W3B10K7eoP6Sbf}whQtOBgPJW{L8k<&YOV<-M zO|u~9nRQWr&oEGCqzlxZK-#N9W``aWjZFBl0Xkdjj7pDjmcU#2FUb-Cfo2#j&<*DM zj>!F(K2aFHL)kS_Lq4r9Ah+VIs`)B`aV8wWKy`yXIK*c^S+I{k=wLXh?Q4dnV~Q-> zhLA0XDpl*=*p@+Syi`d_RKbVyPYGEe;@$kHeu|`jH4CZYX}qL%88g)$t`sR<14r^L zq#`6AeF0z*hPkoGe$Yfof)m1K_kvF#Tc#x?B2*W;kS~?DwaWs%`!Qs^Wf}QCd_BEt zPJB{GviAXU4Z1sY^Ahl&jfyvP1SpM>8S%pd$}y!xX#RPN&9gvqm&eo5w%(qPV0uRo z^AuOYq!_y|${Nbpc;DB*?io}9epjlNotPTP1)SjqQw3)^kF3f3^nL}3yS27xkWCKiLbyX$w5!H}POm1MWA zkJ)kkiush*g+2-rKGIU8NtWwhq_81ldqc6k38)_VQ-d!N7s+f}sr>EDG^^MsGHTFbqY6kgS!W)w%Pr28-hOpas7XvoXUIC5< zdJSTKAUF1&gDx84uCpg?Y_Djdfc#~T)+22B*n>q zSV3il!u|phzw9r@0l^PAuQWxXaqKbCto79`>#SyRPA#+&t}=++m0_CE0E7pPqcQgc@cJ~MlYmlBA+FQpU zH><6v!8{buO$qhoMT8~iafs=fbq?`@YJ3zqyhAB@a~gY)gLviGeM`6eM`KK4^rOkb z{J0&GSo|d+a7y9gufQ+xXU= zby3@Qo%QG4^y$FN7YLe=d-T6H-v5aN!opnjUQzTKTCA^drY_&Vlb zKM%tmy}z!{{ZM#o0Vl;nP#tb=+AVlIr{K1Th!w0e1|#Bw?L<9NqqrPud{ z5=n^F0J6fLL~LUC`8qOQABLC;-m6Edx;#vAT`o;8l(~Si(=D5qQg#AHA;BL5gR+bL zN7v<|h4=X>Kb)q~J;nE4=}`PF>agHe>(}`#kqZ6^JW!unBi2rJXiNHFVuD{%JPesA zp!uglEW%{1h}9%QeDG^=u$(W)gQamlM#ouJTK21ye#4{N(4&2L`qfcuU58YD3s)7B zdD2Dad1)m6UhzfirQ@2%;ku>r^J{OM=e5uh{#)WA=Mvr~*^s0VbTy1pzYj9mc}kww zq)f_@BrJ{zV~&zZc(`FFr5oEHCtb6rBeM=LrgNg_&h3lPD~%*oQpmjNl*1@4?ClTeoGD5s6JUMGEO92-9UC2KQfD@{F!kZ~_3m2M)=>tAH}!5OKkC>;#He?>p7-d;&lA6Vf{O zErRj5(N4=~ZueT`2#B~53QZo+CESh)*j(#X;O6CS^jjTSa(?FF#k1W^X6nm`1qZUi z1rF4Vth#t0KD=jEh_uG5y;nhZ`xp2062wNGy5|V)L=;A4#ObMM=V`%r56ep1%&YSf z$!gL*i3bMMs0E}I)vt0HGEo6Y6@&LyN4JWE{r$WiBKCfxGa|Z(0tYpG8imI^Ivh0K zxC{++P-|6r_Yo%ZziL(R4cMFVe;Pi`d&hA|5))at!DK8jNuQ*t*Y%{0-&)E0{oZ2uj(O z7CR<*@*;c)6vcmQ?wiiAE{L{?g^ODYo3~v#w|L z(2dPpOm8&;ivQ~^+Cb6DES3rJGQz7K@Wi1~5@cHdbLWQ#mJQGoJt zt$yZ8VJX8=JVz2N;uA+gXFLxiiLU5AVMuf6m+{C9s2WDK0(~1c6DOH^@x0J_OG9yAq1}f(*%7c*7O@b&8=FV*6CU9|eY0)DBo&pJD z1%~0jk%Ls0=pAZTR$^ChVTPHkjAkj#auVP^Y}Va1M3AJJx|o^zG_pL zIa(CZ@dHTghh&J50UOQ|#eROp?HkS{!HRUd*&ICb1MJ?FPbhV_!po50KrF=Ob@|-w z2mnmpz;UQ{EP^y7Z8^fNNuEMH(rp-`&>oqh=u2kC95f*%tUPw@iz!q0tiw1&GKi0F zK1w{vr8|LVA>dWpLrGxXr?uoU2MCHB%tkTxVQLtKEWQV%?KTAvyY zw2kDz9VfS-J!~xm#7`)4#ZEDjiNh{8l$e|ZDTj=Nb}5gWepg22&-JQ-c?t?!1lXd$ zjhu5vIvi)k#VcFb9l)S8fx7mC<|olT zLjw{jA6NEJ+|Gv z1`)Yo0@cxD+1_TW4YyY3JA7{mXi4lT<#Hq(*Ql}L8G;}Tbf?HBOQAOeG;7RO?I%3- zpbc~m=E{7CzvKCEepEkclMhmgfB|2=kwQ=91S@vcultnOW)>`jEsj1C?B=Y@XHvU2 z&pNSO8WB^AhHVApVaqtShbpASVq!Kw8Zw&>K&TG zf$o4oFD{&PAf7likCm`az^9o3O!(0OpKZWEB~zB;%;go1OPnSpc=AAplH1AMLE74K z^ta)fmC%qb5Fh8`-GZyB33YpMGpEVh zEQK$Nr~pmEFwK0rTy)YAGYC2;FJVm%R z#Bmq4)Qz#Sc%S)h;-beSYz^^?pLpgT){IYY_?NOX^LM@+d9l-3f`+Ho=oh8T)N?pL zy4j_&xjty`4L6&@)@&TH;%Y*ZFg}HkuLRJ0dd&Hwd|w6#tDLArdp+OORjx<*_^vvH zK93?ZevYI%jG%VIL`dx6G{Tnv+Kx`{i6|us4r0N0Wqh>`>9^3ir}jMDX>uzUS(OEj z(Cg2Ab5HjSbDG>FIsnW^7E*trX@Du-n&^ES+o`#rmp%}c6D^Tkv$A^sO64Fo0$~(> z>nT202k8CWlh1Cwbp6+Z@BfBaV&wP_#L~3JR_q2Vl5cOXU@R*_<0sjY=laEHeyGr# z;md3&3%qW6=F(CMYl@cz+{@?=OlSfreX@%`8AJo1MZ~_B<1t&|z78Q2+>h`c$>&`G zCyH+;ba*cZQhO>`=j%`#SgZA7Y;sozL{25KWze z#CsDeHu6I;vmTA5c0{(H!tl_HW%B8jBkiYi^?IebgqF8M=`_k*0H-LIx}f*a$_jQpR;)PH#j&Tj+24I(Gf7AG zm!_S$oDU491&*RWUWAs>!eqx1`xFAJF=mt!Lj8>WAho{!oJj)HT|4kX8uT$Mh6mV7?2 zC-5_*T*VazYJH9b@jHiXm5FIeO8Z<^ik(%B@Wv|UQm4e-5R02SAdoepZIhm)+4-D~ zkkhNS4;WolMi00tZtlX-Ss?q z#HfZgyE(5}$8$4yfhvyxQP>r5>nPo5OL1Ky=YdOcIP>Pai#eS{x{qctG>t-OlZHZN zw-~t52*)AO@!bPoU#HeyaXfCz7B>GUfd*R>2v>Hnq<;}jJ-H;qsulqIDbBNwZ!y{j zdoc8k-UO>{=?71#@&~;^ckgHS+cpX+(vZHr*97nWk)%dsL*I3~SM0!Mh5u7Xlgm2u zYQvB9S%2uS%(s%;)7LjJPw!|li{2RX0O7S4$FaFj^q%D8l>N!Km;i91yAaGCX^h6O z(QBkob8Tptv=)BID2MKzBNq8dm+hF^AN>Z!8DKG07`I>y0JSPiWPvcusSi;367EE! zWdgB-9GvKnSdNSg<5RJiq^IaNm*6WAr z+K~bshm2y}U@?v3-WM-{-W8a^veqo(T-$J=!!`~28kh%TR?-FOV7IU#S^@@Dd;{7N z3WLYDBKun+vnu%_AIh=7wtovnLeAaXvM-e03iV^${4qiVd#-kQ@j9kTG=z)70su)f z3%vvhUvx?15=)UXfP|7>EH0D`ZiIYw{Mq8| zm2|S&3#s@v_o+YZL{uKQkkL~Zq+l8KKnrEQ<6Wa@kcRkBoe~WCVbAuGS(9cyzy=R# zHnn1~(XTm;sx$t4W0w5gCAR~a^6@|u>S&RSkgk?ON_)KOIdvM@2Q+avEMXimMIixa z!x#7PGo~b7Bde)2XGSeauS_p(#7dF^P{9=>|BQk53$;3Bb!+yafQ1!Zg@ans?%C6t zzYVdVLc@jKMzKxgmV$PQo}fqJJ|hHWQPJ_-THLg4Xpwo1bp1-q{WgNqH@}=(1K@ZR z3egJENVS(cWYrxg!fXnpSs5}oF0=psFosk`j-B^_mzNu701h@90Rz1So+k%CcNqBd z&9B5#sUABASP>8SGD4-GWi3W%tU`YOBMkcKRgXeWnhSZ46 zbeaQplqSIyC+B$&A%pihfwdDsE7Cq+pEA>p&_aFBbo+~@jkBs~8a;NLJ<)4+@gnlE zIXond02J8enn=-)n$NW8AKW<2$r}rVgkYA_T(Fn35??}9aFBiVrASV8eFPvQP(pa9 zk4Gm*nazaR82r(L*&D>>xJlwTJ?y50i9q;0M+bAzby>{Ure4k|(~QMQ9JHCJH|8uH z7s2%c0oP6F#q9PEmw$B?MnE*E(?{ID4e3e)sUQCUTiNZ?5{sQl)mdqF9vgFl^>Lrk z{V1*nF^}w#909|;L_n7iDub#T9^A^svr#Y1mGk4)rh9&3)bErY#Im6RUB5Oz>esNs zluq{7e)VKCg#2cmt(=)$A~cpd1yX)VHfp3=#URB-IaYv6>N+v}Out*=&+n$%%8poA zw%2Szda$`XBH>JX*N_cB*0d-@r<&Y^?w9b>5MNR&1sy z%I`YZE~3<=@pWofu?2DSxlrZh1}prksgW{vOGxyQ?+!CM13R#5!4P)2Bnkt}N!Bln zfh+NFCx`^&J5E^PH8OFD?(L1&{V9eFgg6jZ;u;^h0C^y8kF#BmugH$=O-bt#9n*-W z`0$D7AglCd!#n;aV>t9<2U!**K{`OYQ`c!fr^iFA3Ij&5dbUa{*&&c+&-Uu00H8gh z)UHM5>)qv57B0G9LKMYoY!f`Q&e)hzbl0oS9I~XClmRUQ4jn z*us1Jm0F8ST_e;=iG$p{N_wj|QdCtb)HNuk5eg%=W7?@LrXzLUi9-Bp%{usOgVBj=Vx=|7anJ(AE&_6(fKr=&?E6lNHX*FrFW9Fc>oA+J z*_IwO&Evq&(fmy1Q;IERe_OoD4o!wEJU8H(al0{&Y(RNBS+F7Q!gzi3@X{{WyCNJ& z(q8a8lur*uh^YQY9-l-mUNNAXBL9E=qZ>@{v3NY_O*iMR3$3rr$9eu%^B2_w5LP}F z35&CgLc`r6Hd)7jR>xnwyhj@+6lZ{qV{wnK-6E7YqS9`#?%q}Rxaz<#c!9Ux>GZ7% zZ&>E#B|O75nPt_Op?E{V7)!LX2qzW{Ir=`L5aj%MBhj6&Nr&qZ8#HoCv z;iWLd+YNHp$_`OkEeXilfS=`UTel;Mu^pglpT>Vyg?uja;9_Yq{G$8piK0IfAZ4HS zjuMwL6j-}c+`VsSma$k#3f7-S{#77=6MScg@0Rf95#wnOzw5j4kT7&ax%<2PO(%|)=;Pp8xV=h zia6AemOEtVXqcXG59PTsGjkatgVAc<)#B9KJ@tawdqRcu3!kp#@YeH8mXYRi^aVrA z4RtN9lD`ebv){rD*or-l{`HZ~=p@Xf9%8@_=2BMZTs&?IQuH_*(jMsQn~rtXmo*q* z{cMC3{eUcKUYIlhJaEtMAD$O{J^6cK5fT~>7{|K`&^ppLjQ=$)!#comIm)hB+9D97 z5uawqw(e(BwQesS%v*~WKmDG~r6t*~N(~kx@JRGL)P@s4* ze4j|o6J3g8vhk|6*OY~fD?525#Pz5B0=0A(gDKj1kx3jm2rdjJyAF*AYU+<;Qn7pU zGi?!Ng-aS*)^8w&tG?CUO73!t!x6P6)rOQmQ0`9?^2lE1_8ANTu9aI8a!HBQ$3YGSlr$6WAbSAU@}W8DGiAk2v3sY1}^pNRxK6 z4p}%lCCg+fM%!n{*Y3HO0%&!!zv38X>VDH9csab@?(bhf4!?m?&5q2Q-?@ivPxZ=0 z2iCR7yV08M=7QN15M#FPvy~EUnj{zX(;YM?1#zCIe6%R7_@TOzflD?PFj10tZq54p zIP#A!D_c5A7*&>otzO%m7*H*UX@L91houD_1ZuLzNKrUUV$^%%Z@(J|qW0bO()r|N zH#iwyP z9_TV5z9jO?HY&sSy#*vV@A=Iz>=c-Yv^NO|!aO>e1_K$woIsN>r*Kkqw@vG(CRh-l z*=!Czphso_!=&nHsMU5c;Z=&Lb>$oT>dySLf=jOHF15EOw6F|`9Zv-?ycL#A_QRg< zai|Z2EC!N_CpG7EwV^T+L9e{0r}hcgg->1gsmdCmIz}i^KG3FY8?PJFcC-mZcA^2t zK6HpV>u0=+Gn(fl+wQNgZi*wIHRGklap$$Ep%rn;aIHSj5xYb9)C*ljuiS1zhMnBX zkL|!g0S31-%)OpX(P+{h;>yggnW z>2c&dzaC*}HL>C@zwswc{VRA>q2BDE&L66(RS#DHhAL674_>F3CX8Y=0}qqKOY-+p z3Di#cvWu7915*{b&}-`StUH-%H*%`M&olQ&ql&E(vlGla3|NC1Rk{OxV=00J`AlL1 z&;)&YK3beyi5wEVQ+t;?_74tf+W@~7s}*~rHpB+W0|`@ZzbnRSx~Y!pFjVpr-9=JB zJwfE-TWhsaBX92pr(j*&C%^@rV%q8SZCzE(;NH0*Vrz;7sCq?VbvF5IN_z%71K|P( z=CrpJ3H0EV&$d4WaUZgL6+WCoicsTpD?)VUU;aJ=xFkUwV_jGEK7Zn-R@+<$gRT=y z#!tEhvEDziu3)-mtkR=sbKJLt^!EMr0m@MBd-JQ`I#rv(u9~jijNEOdP%WK>x!a3h z6Lx1d?pHo#UFSL>)!B+heP$~+2L{Fmujf)_WDRq%(T$XcK z#p&Hz<8@Q=GCKye@uAhE_g^bW7<1`pfF8M9nvU8XV?SyMp{fZyAkPoi4$`w4zYlIy zQ7uostXe+!=A*k+EF0Kif&A+HK!vZK5SrvV)OFrz=(P3BV zsN2?qF?RDXJpV3j9a$rY(0J~l~?2{iP4Hb+lc#QQmX92{Ybi1~B zP<>9_myb*9kMpoz*ktX?<-U-4Y|DxO2u-0*Eo65i9eEC>^2A=v&DqH)+oz&bwPJG7 z6SdOua=N%31b5y_St0c^f5GMUb&|gH_DS=07U>K4@CkzRUkmmB#zy+{=RcCeSLzbK zg&O7muB31%2(a&ECQC!1X!t)bub-06_?L{JL5C}kD z#50a4Lj6PgRc3ZGbl0#B?tdN0L4pgABvPzg)3ZCt<@T6-2r_4+2Bpx9|CNB+wY`ZQ zBtlj$ims=Y3q2S8ATN2iXt}YhPUU;;6!V$$-g#1kE+wOO1Og?&%zzn?=$7o=**KvW z(5Af=2IHV#I3f7d$cGRi`P6_2Emh+7c5a7y-h5m#U5GjkY2HY;cVO1+UiMyE-kW{O z*8B0n{e3UiF>&m|#sU#Y{(C{|?b)j_Cs`UcRq8zO1(aBBYOZkhG2@{TOI}zf}>k@BnilXfG4@N*$ zC~ar#=h9bxKX`dXG@>kveXzs5i~dJlHXr58G#0WjgkcJsTfCNRNV?IY#squ9nH2z% z+)L6q1g2dOl1$J$K`Z<&^o#t=0kYUo8&sv3dv@3kw<|@xqdu+fD2aoFLnKiW!vPdZ zWlYwthvEwZkELeTgOC@w&##t_B}P;Lh^?SuU%NU~R@0S4iu)u5L4z1>Q+iSWb?1Z< z++*Uw*Os+ioSDmRq_fV}$b|ghX4=Y^deuL%vaMU_h~rc$c`Bs|lA`k|@@N@LM4I4P z5Oj&w>#mhrSHfx+$8zL8={g(5PWV=}_0fW$O$74yn9B6;8(X5S(86OdygHSxXNd1h zK+4r_?>%Q>2d`NwVx+i(UusQE7P7x-eAV>NJSHi`Fo2vwSRUg0*=HOynreQN} z2tBbyf*Qf%GHN~{H3cNHUE_`XH2khK@*gXnMel=>QI5uabQ@Q1t|9Kdx)m~+-UUVr zc7Py#z2@}FKvUj+=1~o#Jfp(1&!B;~k%#$Rs_A`y;VVDBKb>yp89K>1=oA5Men;0}apsuZESF}vi zE4#T?F5l*gOLX5=csHcAa6a~&Mf}!_65FYDTzQM`YcT7b>rVJ+4G|4LkQI$CnQLJb zBuNw%C9Z$$uGmt-RT=61hD_=l@VF92X|bRQbKWV-*4NP{tAnCOS5Jlu*T)nmucE! z3W;MCpx$w-CC$s4^o@Smb*srAm#=Na%F~~>OLJleF;^MGUw4U2DbJt{2pFEHGAnj5 zMNqk9zFlwrb=5pk%n)7e13{~qYK`tQ_GyOiZ`Y$hlew`jqtE#8U}pMD^gJ=KrE}b+ zf~&dZKwSNAUICTBVwYSBtTr1~Mc~s}8>|cuC!nUF3(XFc(Zl!mw)au^c4sF`JMrQB zt)D+k_cFavx6Hbt=0QkGa^XT97tOAV^m6r$v=}btYrJnJAns(Sq}w(wC^CKXXrBhc z8a!zfvF=RP!e3;(?;4_fPFpjZ9)U5ioIL)&7V@jPZ&D46KRUcj1)w zXsC=(8CfjQWp*%eo{DCm;MP0FGD-LIFkK8Md5gW%lbLgj6m@=2XWE7kf5{!+BUiGC zbDDUZ*wwtqw-k%q{zNSrI1hATxMv*T+kVZmjhrt3gC=oR@OU9l`0#I);i6~(v8l{bY_a`mAFp;hL0Tq#OFZ29aeWH&`gb_k8xrj2K>RrZvj9l zsh%aRmN$sfs4?~dA6O6)DPX|j>3R66ldUmK5$pJ9f<{-bmn{;%;;MyeDI=HLOMSfPHj(wzoSoKM(@w@y@TU0K04t~ZmocDe^L>jL2P=G6 znuSYRah!e4K%^n=_&<>a*6ziQnscKSI#m(cR2zjg1RZ6a&I?UyOjf8NcHB3^duC47 zCXK1faWl2?Iyj=NvOnCA6ZVFOQ(dS+ze!~R!5}Q?9qoVgdU`$0p25VZtY!|Jk0&Rs zyiXVxVSduCqAqp^x=%!2@Y471@AoQ?_pNWmkXW+MrD7vRBll+`x4t&goWp3JPtopg zraqdrX%%c=oCLd01YzNTZ%A72i;JpJ5%;}fBWBY?B!LOeotUBXsvLq8L_zDOElFG= zU=a&t`g@%PSB_8nvpZR~I2*^N6X#nxOE%VnHW6CHB5no`EI374^bBQ)qqwyYq7p>b z*x*0&iWnk^*F0UN6*rGYy>U%z{8kZx8R!fVpvCE z4^64d81VT&8mZp%7GTB`rB;0uvgunfU5rI(gjopWVSa=HX@Wo`LyFBAjv(-S+S5!} zuEob6u{})@*#^aYmkz-S)7T>|=f`eWBMncaENz4Y%A z-oo$layA$PxE>}y$|Ew$A&;G-I}LLj+Y|1i_C(w)$6#M_TB#vbwQL!%RLQxX?nC9m zrz4iT7`G3rheMq5W(zwigobZ?-M53d&na^&SZF9deD4D;nH_S1{wrblFP%DZnC$J2%-u%@IY1%C zDPgk;>31F?KjY%q=#~BbC~wWRFvT>YE;)Wg^E(fDs9_u~$==%fOt2@4Ge-K<^qda% z{P@(2$~MI@B5{HW#IYF2zRDb(0XeV$;ZT$$g)rK`S-v-0pv!RFNOo~?$L!fRT3Pi0SND9>2Txhc#8f#$!~nFQa$ZHZ+IlZWTbhT* zTDZ!f>Z+zT0_Von9?)aa`SU~u27?F%NfhwXVnss-mt}|ynoCgS=@cs=N-4r|CFI+Ag{64;<_W+n%blik57RBnY8D z7|M2GoYNJN4GQ$r`T_5nq{K!G`*)hDVqw^DB}zX!h=#-Z7Qt~0Z-Kq*oNQyH4+-Ze zDb#L)HG&UDrA{67f;9s$iJ;&Erj0%QRGEP8RUmCNQ9F-2^#efc%sAyP%1oFjUt;X9 z9G%)tt-{= zgu8(oFh*ezz6A8CCPrw_NpH3E7dow5E;D%GQg-IcrbZQX7kI4(B{yy=THAwITO_T_ zxuflZ(hcJz2JX{?R z#;_sj;ej}?8DEa^E79&$25S&Hvpu_P7gV;aBW8S2@c!}6eC-}^OWR|oS@DAba6IGV z+o;qC5tQg^JbLVsGX`ni4bl*&op^TDez(QsXRigds%yX{$nDXJ{r&mAUoj7X2BIk; zhvcPCO%X$ttM$vmDB9v(Idic5nNEn5Of5EHLFW0%BIH2mBcHo5c#R-7k#JOwui2)L zsuUYuuQk+l?HuS~x59h~^=O4_9wCc+*l*wB@dx#OJ4zWaA^`^>GwGES7w?@Aw+PDP zFzC*&)Yl5lAOECbObO1$XP`U)+6Mbq37?VtSoQ`!Igrf5S{#FSoAUUvfRfx)sWpY14Y+n6FlkSNh=?IB_f^$kk#<(BlOfzU?E~Xi-T@{7l#0@1t(|P;#)c2i&vuac zAgG|ht<$YLU$5^=WQ9p3CXG&kz2C2LY_C$CJFU@}jgL1fzV=U217AJx8@|4{!W!k~-GTk2he z+73EYO#e)D=k~5r9ECZZxhX%%{_9?FQtQ{0zL8g!`5`NdyvN~+{JZrybN2pql1CCw zdG_r3QD($N2*NnfW!mw}{Q?|vWY{bhJ#YgW<->j7kbMxY9P%X|9(Qv zhVFDwcR)@AIR?Lf$SiNJ+ZnCFa&Gwp=0($K21{W|@wI^wr>ox=MP)PqO7KnRdinHG zXxp-lcvgYy00&4Mu``Z*Ae|8inu?PQa3-YAKaakPR7c#0_63&}d_1CoL)Ycru7JX_ ziIwrZJXvzV{h=?CwqnE)AoLpxydQNv3_#pHz}V}XhXZ`(cjZ@>@~Z@EurZBi%oSkf zuJ>(vAv0K0NW~op+~j_hUlyY`@yg^En15OVhjk(b7XT3xE(1Y?58<;b$b&u0yd!~L zFg<3c#39(V_fJh0deM(0Vvo*uGuw@*2q^twGBa58DLFKdOQSvJjjLTuGw}(($7O1u z>_j&*Ewd>wgXz+{XS4-U(J%F*0K(J`=NZmPWegBgT2gQYy_UI^;MBH;o$8<%9Mkf(_lqP3bmFPQcfzV;0Rh^hHRdT#a-x!ogDb%jPG)$hjJ!= z)qF;UO5%M)Ze!CsFclKPO!T~J_0M%g<-={MKU%XhGdg{~6&W9Ixu!BCgg&JpmLss7TU7PcmBi%40yqbflE6Y0Y=_5^-+Nev~+Maf~(<#%!jFP^p`<>DkK9M_!jXOTz?0j zW79BtxWe2`ZLnZmw9F}iiOlu(jwca#X-1`xOPX!8pRek$9enKDj2frIHut=MDZqCR zj0*f7ga>9g5f<@{#<>&(QM)~RnVjy~pD69M$^(Bmr???O23fBGuoaGDMq=P*hC4o5HeUAj_S1b%9#Et<96GuwANu4t z;<^%<8Rm;03yQD?kwqhu;I3)xuM08omVcGBT0syH3%L{COQ*QjAxF*$HiGMLA*1uX zup%aATxbk2YLo~H2#fdcoWnKON_oz$fHem-1W_0{2NHcE7g1b+>KA^nVPhqoAy)FH zff7^h{1*a#{75Z`u)hPLs2Zytc zfD1p%i~_MEs4ahWX`snFg~cwuOv9AfHpC5LFFNwx=bJJJ{9~+aymVto$b5xuDH8*20Ts2Plh>k>7b^x&{T*V>m z?>k~6g&>i;ZN^~5@>v09`bngB6lL{Mz{faS?1U5&p?p$@FutVTC-7#bnHWNZ?9By( z8t*pLocIqA1iyit`$i9P_lEupzesoYM7DN=yLRn#sG)`2YjnnsT>`crs9MIKvbI?% zXjBn!z7*6M*I1ZPMT*Zhf%#@gm5uyAjQwMiC{Wgf3s%)B+d5_Qlx^F#ZQHhO+qP}n zwymjmB4+OGi2l$&Vn^y4n+XL#E}85EMGNk#xJA*_#9o&7rsYbj=@R%@RLx`Z!d|l(l>i%(={|5X_-H< z0P%O2>~^-~+;Bx#1$GFN^9dD2NfK4D)Had_K{-Zr4UGa$6@n#OxmK1eBB%<X*#UgX5Dkve#;yemDslOUft%K8Pzc$fz}$&-i^tV;Xr!;ODm0#r=7VF@4^Lu za(UI~kiJSomPjVY)c$TqhSdUVFVo5Pj@M-50ASEPIBk*Fslj@sQT^_JfS-47Z1H2h z9)D4Se_N@K|Lc$Uehrp7WM9d~LV)soAd}nXlh6h&%ZQF(F1UZag{Uk8Sg& z(axrkPFE2|pQwRUeTS3qcqDD1TiRBY_ju2iqD+?=8i)Z^$zc<2=Z%KKRr}D4%Z^bd zI8hpKcXIdP_!R1ZV;>U*gbPgtY_desip2-jLkLLHTSLLmIW;a+A7gy^B>eDTRp6EK zkUgJLciDQaE&&r-C|x#+-4Nv}|5)dG&8N23L5`BeXRoU>Eesq|DeOnp89UE4%kf$a za}x1aYi{j$&Mu&GAFlBYgtO9z9>Q8_r(e@mNjt+`rulIuEy@t=75I*4wX=-v`AW?IBr`%RAsS}Zi%dwjYRgph>3j1w&p*gt>*0xp9Snhk^d2pj+TTw4GiQ+})yMV+p5_`& z8elan(a`?%!*i>#qx>at?{5F)#oN}i`_>m3p!GhmFM$p>yhv#?4lE}Wvw7qM?fdIH zTSqfPyS=8REa`bDf{wgqX!kFPjka-OwphAo;krF0|m$q-xuzda2~2b6eC66 zM+m`4`xtloH+da}C%Q-9JIoPWb3>MdCC2;H5;jUv9(Jp46038N}7HLb=lwNv1 zbyDPZegTT^q19FM3vM8dPKlnrxZGl&4Gqh19>9xG1CM99=x?n0+ccyg--TsH(VyO) zVL%Di?Bzi#Ci2G|K0vuEBq&$*N&z}eQ1YHnT7oaH7>WyAg(EfIl(S)K+k}T?A8iPd{4ZoFz=pvQbFuc|aNE^y?A=+;_yu@~>EEaw zrTRX)dK(AE%NUO;|%z9N2NVpIb7Dgcs^GPOv6yn%Qs1XOx{K^Z*6Anl^U zWXxxI7HwWXLGl?LULdre{x3pI*@AA_sstb2`fLGuS3F2m+>r7JS7VmFwCs_F*D^Bd?2naSX8k*q3&94Q*}hak_K`!Hc}xOV{D;yz3KRrZl4=2*x*SDPf7_a(^icTfA7 zgRbMqV`9Y)BX^m+AW*gfvK+wv^pn{dI2;-=_n^h0tI855(2~xwgIFU-gcZ0(Rp=~J z!}mGSPu!21_RM!GZ4;j&Y3f_KI?w|Xf=#Ww>CFGKk|p?wQEEl`NF5AK>|X1%md8L9 zjzt3w`esI=>9vz|gvEi^y-7W&+c)Z_hc)*~Xk@7S7kipIi<0^9X>HKCp`PaCwEE0V zDf)p}B-;srkI~c-LNqdw%x-vw_+^IUwqJ-bXfI5veZP+PN2Q3foVJV)OPeRX>rT&8 z)w~>5rb8z< zLocAuKprQ?ACrF+031_qPVa4**eRuvyB7RDRXeGM!F(c3BSxwkBY88ZWxzmGCg%I+ zKUVEV8XdAOQusb?_$v9XW*Q5)>s~ILg?}%nPPm;m3Hy%whqXe0y zxY{g1j$$7d$Thz^=sqwi^hj(r75M>?8mv;N!`k{WH4{SP=69?&CL5(@C}B@L4D0-B zn_5|*FIiHTD7U0w@;%oWgT_e6aqGhDB=c?Ldt-Y=!Ytj_oWEvKkKmhz3T2j8IPi+n zUzrpa78F)po{^u|FdABVPr zkz^jt0Hf7%%;(B>*n1I?-iL08KmnGm;vQOoku67w+oEjhimIfGwFXENy9i32r^WOb zCx_d)e7t3~3cIL|%I1w--*iJ#oN~gHs0Jq}hdvn=wCYN>#-_O@E3xr!NQSldT? zlLT_M_E$|H(aon|c&x-hA@0f48JTU?yoHG_>?;OU>e;KxW*q-9> z^{bdRUM*;UuhN-emX636>YBx}DtDW8a*Mwn@avTYNcB~03WQ3MG{aP(IWA;HNu*|C zL$}HWO!!|Md<&~;P4-zW<%XkIU!2g)d*znu#lhJ6W+9eCmv{gCI?-JkITr)%lF6Iv zA;jp2RfzLqa_)*Z0LHR9;NF?(7K-qqDs^A*1`vDU+NOiW8J1Z7WN$p}o1gk{qFagF z-QwaQg^4OBMnK`*Zu6KAX>*!{gU+ssRAUnwJS%q>+$&Cd9+)JFSzq8S=A1`dpHv}x zb#eP7=di4kUFn`+NN+rQ*~kDxb1bv~J25^Vf1;ZM693yjh53Jj#Ie!;N4RC_H{7zw z{D0w=Q1!C$+^8@cF=%;WvZ8!`%Dk=Tpd);agEg@vv0zP9Q#l`x7@9kxJ~iVds47&Z z>Jc{Xlp9T?P8eJG0bE#lpr3u+F1T!MP`I1~fDzF_Ah47T029Ds(ORn3%}!W`rhVjVo@p9@n~XvLZcgtI7S5hn%VX5BHuL$|mEziF~fqEt4k-0=3rbmwNR$ z#!JSfkeRdBbMOafy=-6vB(ed?9VZYUrL8IgX;!M0j?S@_EK68p6R#$DpLESYg+K;q z8A!v+jg9uTlXoXnbqbvyJ3TZU%s?`4DwxVJ&rfTVz0|PVjEaiYP9Vxl<-w{_6w0*F zA%p`gG9aT&^k!x5x4rW~|Hn|-fv>lSlxHku;V=|~bUb0ROu!oCMMElk6axxAnsF?0 zs2p$C$I8rxJP!B@O2gqx5T3%Ap7OtQak|H7+hmV_@3i6-p3SNk>WfJ~cA z-UP37a~SJ5#{g%amO1(ADihzkaQ_9g0P2T{2Dte3uBZ1}hXb=Na>HZIreM2_?-IBk z-O;j=veKE7+LhN32lHJJUv!&I4L5Da0_c}9&(pGeSR4rkP_9;W(u*u|n3>M7(C=jS zAtGH>aNjlEXMIve^F50)M`<(7^_A#M^S1q=3SSmMOBQ1XD6nupD+mDD%wl&1%wfek z1VB9>rs_k_{tEyRV8Ir0!;OW!GasS|fIRSMdJ2AsmFDt~0Cag&PB1FCxfKw4JPNm+ zT!8Z!=}=qL4F03g(jsKZ5Tk+vmj)VvxprRVZ&_>g;jl;)F_|-t@@r@jnM4rRt@<8e zyRzx~>=?^9P-0-nr|`R}iKF00j)|k><>cwlGo)PhJlRRF2Gp~cnlmafWWiv%+!~e7#=~QmM5i!3{^L)uj7|iiHwW z>iyyoH8Zs@n01Nn<2VU?@mbapbe?Js29yXbfh;BOS}J^2-X0=mg+zXNv~!y=w*BzM z2_>Jv#KT{mG1gOm^Y-Ay)JU46;ab#yub!%q_VEN=d=PyVj59X-=9U z)Cj96_p1&in~|j*JCF5Jy})*1x{&izh+NywYYf1Y_;qBnqI>n*laR73?8xXY1FO!fimsyO_t=cW z=7o?k!AH#PlAEbkM-5m#oJfi!&Fx&XdsoocW$*EDWR2BxWu*sm=5altkj&ZdlToQw z2un%mObH}Vi2qs<1XSiYFxt++vBOO=?LgS@^Cu+3O1oM6j{s)hGyP9J9jIE(189{*_T+>#P!XLkKA{1@Zq&M%zjN3cLHZRsrxQnLOK zN)K(NaZJO5;R_oio78Ku1Wl)wOsZI#vpfxGv8fHtvck5T8m_P;jf(;g{uDt8hX*$SFGKBfxn9Ora+SVdvsSQ9MjR4OUzj%e3NBe?o|Tw088Km1n2#TQI3Q{QS8Lw+WD{KKAhE*nnhyc;gY9~zVP+C)T&+Lb3E!m1Fbw*! z>h@MBInDA7K0&UpP^t&G1wPDBx}{_oozR2fdA|tF?bgitI!Jd&avDcaO~E=!?E!$1 zXqbuJk}RBqu1PeU#x@#c+aR-4B4wQOyx|{mAqXRL+clEZ4+Duhk~9q>J<)2SeJvYL zL`sSe`^8KDmo6Qzkx`$BK&ULY;moz0C$T`;=v@gAo_S0>1~;PyKV^O32`tu~aEii4 z<23BD8FR4QB(GGUWbvrjW!dBT&03|><+;^O@m@i(=mgIvwdu?xkZxgA~8G)etdMpWKwzC`?xnqycHVCbws=s zHDG^a!w>xOMk`q;MjgJNl*Hkl%QY^BSGZ|nKW-Fqzz?JPP5#Qn=^93asd#u}?%X{=zMCK$xgZWT z%gsSf^N~``hEP9S42D;?XdwKZ+s?WD3N<&CPZ)3#(E-Nj&|4eX<${TcCk1k{L_Z`d zaXua!it{xED0zlq7xhM=b-b0DPBrT539%sqL_8vBE7G_qUlCI6@1;`ePy+n$R^!px z8@*dYqXUwwMj>11UZA-7&hL*wlnCiAV@s*XrTuzhn~{k-;ciUf#cTCkxkK-)d;46# z$oyy0@w&s>oyGL2q|5AS`0M=dPt`_N*@U(Rl^J|cnVxdn^%QQv<-7S!5p3yul~0TH zd370M-93?k3Q_?n&^^$~%sRnoT#*n#}~aZ^Kf@{NffiYxlZ^e?i0A%N6&FccKCh zB*aVxr?Jg4Ti;{kNZet`;njB9Ca8p4%0twhtW|lNh%@azo zsT$kYv{X+E+eVao{l=50!(O_$T8MwB5fL_>*(B9JrOjQ;v=LoZxi&^_E#Vvjf_i?T zkkZ~>-b9K9=`A54VOB2g()@>0t=uz|@Ivucw>JB>ek^V>9IBX=3$Kkfu-I+B(Qrg= zcOe=gkk&A34G!~!3f)2|`C9x8Ni@WWfxaZKjum{m#^2Zw9Uf@Mx()B_>o?3XlqGF? zTTeHCB|Eb0t_$DW94^Eu^IgAG6ItI}Y4TPVLkc_vGsdn8>vXGl-?wM7@QHfID|=bH zab)G?^XPgo9z;LzL+JC9FySj^FK}U)*=1TREeKvjo~Uy1h0|AG##edgB7R=1;o52b z4-P(LhZ??hA!A^>?`lTz;|6H@h(LHEp*2+TK7wq^f?s-m}dgjs2(Miy!B-|9S|+rb=aK^ELqc<3Nv%VYk`#8)%KEm zRY$dD&6Ye7(n0(@G?2xNxjdki?~J?kf;E+&G*nA!@m`Chq7SPmqC&XMcryd)N zjE>uP-FK^o7YZzR4)p%Tl)X%2O#}*Ka+qH9Jdnr5NPOxJbC`DtFXrspI)v{bNSBvg4v#=)4W*(UzOAVl_fq*(-ZTOiMgC81X`m%hV)xdEtiar{*L z-?{#xbVisWzqAbr#be(3*kvPK;*!-t+B{V25IAMo@4p~QygY6t-YMx$!KaxtTc!Mv#)^IYGwd+ z%+h%=raK=m<52xaTZ}1u;1QWK{?{g3RT>5i=lEH7(LjP>=nji)eGCP+VwJwI^uUT$ zaI#cpo*Lg!rVT^7BB%6umw^F)PvAs9-99HE8i??pkkSQaknRzdAQcV7CEcTAZOfTB z6!>!cV=hbkGhxAL$KZ2Z(9;34`4(cB;rPBy?GkYtTlbOfUevK-bPL!lEE8Ly=%Ffl zmBA`(gcl3Ea&5_MQlV_psgB^u2PtTZT>y-NG$Axt{>=Lp`OCQ^`2HycuktaTQJ6%4 zI(BS2B5^8VaCOw1fo&~cdwas`7`TAYT(zM#@-4ZjZ%)x+<-R9Pt)IL8EMr;SPvgaF z%0PPrqS<|=c>rt2$0(M;NEsL$rk_l!TJKG+_NzLqrSa6HvB!x%+sXn;|8T&UKOm)nBmYKx$X4= zHw3yp^j~H6f8t!xG5<;pH>883y^)?3r0aUs|6gWl>Hkk=5o+SwL-MxLs|Mh8D_Xc2 zy<~|rRuw6Pg(9G;~s}*NH6rN*ZeR_VA z!g^nBG~aBh67{6nMKtg{O(dd-by+yI7`o|qEiN#4m$Dau5U0gQC?*!>_FuG%R^l`V zs1?VL8Fs3^XJJqs2aeYs8q+G56ktobL_x`{d(W~qzBh2K*}wrw&n!wZ83@{e$YYR~ z@z+hH#x3yovzqf@d_40e>>LaxsR7Cexe9-^kKrLe+g}ikso`kmCD064FL;}@aAd51 z_mTtRlKz-U`$>!BzSV| zBF;PA&QAiBI$3c6s&)d>qRib7Egn630u_1w2eIlioI_xz8g@;yKM>(;D$}_Dy>a~R z)q_S^YlChw;HKJ^sJkfxO*VU(B+i4O`v`a`V>ag%>ahyu>O9t;xP{-bKnqm2U7s zKWV{u{asKA|C9a+gkxMz{0Q!xLv5n3piRa*(8(TyQbXTwR3{^gHWlmtXDe^5*9YF1 zhI0c-rcF_-K*V87sW~P%uDw`lqKhG0Smh$NMp#FwV@j~hU^1T5#R{+`WcsMFqjiFF z71aT;T};ip?!XqLaLicpGXdwK@AaKKIOatXB(;?=y$w6@P`^C*s<_-~QG&G?EfY6N z3ScxaW@5bJ2mFpqZJu!NcQh?hGwaaI;2lqx38mbJ_tic_1ViaABpvykb%0pkI}BsG2SuHs;#TE8M&YQaZ2$=8}d*f z7JAdM`_;7GHwvrEf%#M!67i)S2hZEWUvF3|UYFL~GmfYNZX99Oz|hPu9@}0g776dO zthiZJ-Vf3r7u&cb%j>OBX*W>Q{-$C_ubdeI#1>Rr5fBgd(s6zLX^BatOI16v4|IM5 zBFbWP#cNd17CeCQ+c}d0yPIyJug_KiHCBzb5NNK&p>yWRnAUZ_NiL}t=9J<6iQ@ZR z+rMC0(!2vva2+5oVTcrUoShUr=YKPqa}lN@as*naOjJTxrfKoL;#y6PJW(JKc^>~r zyNPVZPx}oFLhbfgJnu@^|uGH6fdu8ShQlFxtqW!j~t^?pLOW2sTVXE zES=^g@=!^Op*JpNykMjq%#2`9jiy#B~yFSc;#iAjk{vmhE zTGFaAhQ`ymIMVNIms3XVjdr08SNrn~!N&&bir(9OlckoBo-dF72)e6AC1R)N4J~RJ zGwZ*J7R&#LF{1sC+3>dx%#I*rhySoIik8Fq>B6$T+ z45(lB*R@j9476EUYgV};(2opC>{J)be7NnjQEEOzO_|UE`u~!Qw7Yl^205cxheeB# zQOU)@S!j3`p)f;q&=?^yW{kWHoVz_|N=6*QZ2A8L($Udx2m#ZJdqv-aB<-_F+{?M2atx5nd6F4xjJpq|JUXjHV7Y8h9$!?UgQF+lw9$Bcza6co9 zxsAgd4Ia))I71KHnq4g2pItj{yXBi9Z%T`s$|H z_=tlUpRDf>m@<@$>IJ~+QdTpL=kx>$i6)Au2;K6YDf(zCFZmIJV2j#D%3JmLI>XgMJ|d$tfrH+zx&;>HPK|`yz6k%LiNl!fd!OAih>PhE_e*Y z#bk*B0eOhH7i3-|`9)>;_;7_ZJ<(zAG%g6ch&P5MQ@XDdy%JQ~kIGN8V zV$ghDDP_1w#x=SyheS?2GQ=tGWpKnz!@yBmF-UNxOMxdCkuD`}`~;uH8bc+Q@ugx4 z!{uZNI6M}@dkTIgu~h)h;&Q;L*r3S#m(6SdPy|BK0@dA20C<%;XCoL|b4at&iPfJa z#|@X1>Q$Wn_}Ilq?jMNMZeU&vB7lBlh+TyRneg4X%;&^&IPBL|ymNQaguy3_E}$F8 zFW}`UF9#!umM;LUs<#^aShupuM3hxB7jrG=zaQY@NeLC@!Y{5Z#mIl3ERHTVOC@7> z2dq4)oKAW}p*1#2`*JE}zqbiNuVEVfJFVfYcQcop4B5?ZU8vQ-kb*2mFh`It>?)wD zyyh1v(x>pA?TqmJhb{31Q>y@7zcS5fy{hGy%ZQr={EiR%>Y`StM-d-ghjL{L2Ul6t zM#%Wmh2X2=gIlcDEWps2Gij3!_rD01s?@eqq`b~3M;-Lpu;DThJu>H)RVk-Pu4K1A zYQjgzur~(Lrj#>cmB29F5aI3?FW&=Fr~GAsj1hz9^Agbi!q&00LULQNdOF|WPqpPu zSH76qIR6C)7Ut&~GPi{JK$k4;F^g<4X9?4?L*E~rT z7b7vit=Flb3c;w5U0JI>zj9S_=GM^PCH{+NHHr;|S0pN6Db)We zMgJRph>h((=tKXvblhM@{arfJ-q*$kgdS-b?#wf*75>79(za40agZ~zl{8%_dK*Wg?9kF&g-sUc+i_J5R~iP44B`ryy2Q%L#dw znFk1U=+3nRRTXL^6!Ik_SP)|h7eYL9Mk%*C)t+z21hCN?NxNRyZTMA87-xYM;g&2i z1|vs`aOD&Rn&&&&j2=ugb(H^WachzZU+^cJ+COjflEk22MZ@|TAF}1zYX0bB&Z05&kPVQ6RCudVi!Us6}U z?fd7g&gllWT3d)GT#bibJyQH-g7qF*OuA0p4{WONnT;^hwtF(^IE|*!O38y&cJ1Os zf|9pRN#*K-MXoS4B#GsO5q>KgOM za_7)x0qkbt3Xock-QqUc$HU2V{k$unsSL|N5eXg;EmIXW{?a{7K3*)pQ2P)#^E@SQ zOU56lqui?Eoup<9?3VH&CKyI$mNgth=+MmJK%-h$Z3R>lmijNjy$&>Zx|3z8IX8~j zPEk83NP)-bXH{i_7W#t?R)W#LycG96M=bQLDlLtzMWYrQ`3ySR96FB2QcdwQjUJlf zrj5i9E3{Vd$E!dRA-^xmP8u%U?xOQTQJ~0hN1xJL)QY6%td}oJQ{qt6Sr&Lnu`Kp>M1crzw23vPph#RFkeD6hn+f({YWw zOL>4HJ{J$Z^rz>moo_^QW(-+vcy@qoqw3g_YWOa8rzWX(f283zH5J-|(EWu$Hq=e> z%}kPLrt_Q>)(ra%5<=*yK$s-j1U3L>`H8TOV|7r5K)E+xAMhee-T+Wt7Gj9-4qC1W z0L^=4mov9NpqR|A=X-_1tE_O;l0cL+lY@s1)cTmLu4bjfG#Nx~~+0XUW5iEOh+g(qryeNbQ72f8ESi7rmiIV)Oe&~JOp)a`h^ zF{E)5AkZn$!4r1dU8_VcMuGR-BmY2Xgu?Of7E=B6!B|^MH}L%8F$oR`f#91cS~NQ4 z)qF<0fYZVB&Q9!H7q12iTK4!_&z#XaT`js`EdaO9Z`FchHqMWinckMWMwX^;h=a9= z!=)Qxt@VPLy;5VJi>W4vKLZW~q7%W+&7ryJcs9&ctR{?$L4mIX+QXAg zB1Sk44zv8&SNlh~dG8Lv=B)(Jmj8+EBP0JXuBA4`T3W_iI)JhJ-|CgNTa;_9dGa%x zHK-*n{T8;+Z%A$+5gF(NH(V70WEV%Lk@)EuD2t(D0i)G9A5aH^bwWm@!ZrH9krs6f zH{Iz%b4AZgv|57}!o(?ZZ!8-(n3e(@|t!&pO2-?*Ll|hzd`Ya6K7R=Z4^a7VYCG&p35=7*H zX7IMces0yK%4OV;>1n>_DeYO!apE5INME1CS|he~of3Z?BL+F|>OA_EGriZa(3 z)2;K@4%X2w&uNI4xPalBu403hI|-mfibLTdpvnlT!;I_~e+yxmdKR&kfZ24}4aHK; z!RQ2MVC0cpmF6$%BzKepfEvOQF>xFIXXrx8T)^Zpc<(d}pyG+s9t9DzfeTCvz-qwo zORZ5>mcc3`PbeJY)6Z@!`zTCzIEZsjoF6PQoKZYHtsW&F-5QrlBNs^k3&BcuS8}oq zJ84;S5|EY{SXGAh{ts$Uh#9T(@3*u1aU!B+U%ifz}a?}*vw4@{UN1iGFiM%Lv6?`R-BxBk%7F^$4^B!TG)~jb9Z+N zX*{KfyR)+{DLFAtn(iJa{*sHkF{X5TMhR?&p*=w2?Y3#>qaRHiR#opGH@B|AoSx}^ z5ideAk|F>t^Ve=?=tQJGHb>;LL${9+W-Z;&Z%cvKNQg+XvTMS%MIbBDzNgggOeQ>5 z7@5=e2%e3?6dG^I^no~>?LWsRDiJx|@7SS=?UeuZQ}Dl$u9#_A|KFzSlB$NqCM&Y{ zj*ecvET=%Fy2^x`s;P^{X+5%de>bC-tubTRStM5zS4Qwv%uYeZ2&DbLS=3};0?PS0 zwwR2K($2kT@_?HmbJ66v~x#Ou-_9febx3=!04HqIV^H`8Y zWLzS2vIXi4k**x2F;QX>#tTB8C0#xTE}q@&9)nB{Fws1I>ERIPDF%;Z6t_u2EReWM zLe$5Y*p;n&mXs!&(X8MM z^hhe?Zjw^-_*#5UaofHH2>PDXTh@fV6!pci+3I6;A)IB79F}ZSthmyYrExudePIEh z;f9}qZksk)MZL>CSvO?UN2iOvO+-;F9Gg-<~(^Wl9RV1a4uz(H9XMV8_IwXc=h2d8v|S_C5RTBse4s^ z#lCa{bGKov#j@hu%>^Bsd+F+6s?7fQgvJpc5|p;$aok)1mSi?BaOV=uvzLB{`XP;>)8&$PL2Igz!XbLd$b3zUn z<{sB>HQJc}8aaZ8l+Ix91v+PfzEhn< zKKBRtT2*ThF)TiYIZfGNvfiSp40dBr8wiF$642`+POe>I5w-eiPr6MN`_D4+Cm&VW zE*U8|>QP`L-HtBN2(mNg60%+&$(9B*OlkEd)Eo1PW#pW<5qnAi4G(cJiFsA``X0gy zw>z>CJmB`0RijNmuo(X@)+5s4hF{JdExmVqVQSQWHy2TrqZ#`F9!fL{r_Wq4cE@3W z%oNn{iaaLwT7b|@HDO+2%z)na3dkM_Mt!_M{Bqk3*uyp5{qGYfU+QigSMaBS58z7C zJ8ptviwl&P$v96DxHHJo58P5s`+DJf$!0yl5a(r(lQ;M}$}I(XklC6+5RnMc%eVU0 zYOiC9Z>p>RAYFxJbiST!;n!ZdiVkeKT3Z;#_%Sj>n80+p$9&SXB)e+j6kJ^<0K7OI zXi8iEAe4098q#Wbn`dBETN^r$@Ji=nEwmM*0-Y`UlmIg~*VV)5QsCCj+tI@MA|f5! zxB3o}Ut^clPJqn0SCd1*-mp{t?G5D)(?GlNx{O8|p| z*a{(NRRo40%TDuFHBXyn>o;3{fsSUP=xwar~y-5={7yU0c-{JDOm~RAd zJ0;m4pTpN&J#HdH+dD)Q!}Ko+IJZ(??6@i;0yz;DQ!=O<}wBn@<1Y*JuU?`PUl zZ`Qv}r4lgW68F?oSgiN`U#1WC{VQY)6-g`|;TYyokNhluizNdQETfbkJyY`INjKqS zwOJ97BCUsa4rcDbL~#5P>S|o=Dp~4LmXR<#N}bpm1Wu*0)gP>^?-7y8yz9}~yei4C zpZvr5jCqVC1H2!&72_2r$vGr(E|nEN-i=}BAM=&0)dUW)sB7ggpB6LRK!H~}c=2+r zGGZ2%^OvgQb7@P29p`rwwn~e{C*5DZN8b{Y+cbo1X%~9#pL&Ufluh@QCOF5=^Sa^y zs16i?wX62=oKM!#AR_h>TLj_2(MWJd7*;IHSUT`x{f6_2n2&n3f&M%j31^bS4@jj$PSCkT2Q+dD?=^IK zU#7uOwV!|aD&i-JXd5)d{$T~V*_JK&M8OOSm?v9sik%dGvMI*1H-WX$Cq0@kc{!H7>NUUfAg+uU0% zT9Ss@37SV}L_|r)zYlWe)y!)kT{6-lygIU&2v8Y8QaYC@>IyV8E)2~!wz#|?SufDN z$Hg*_GS1x3AO#>k2O528W@9&CB_0A6D=)itWt>;rtyoY@1SXH4rb-?E6 zvzemjQ4nQ1 z)?GZ$x~4)eg{@-6L@z8Wytb}OeqMpr^m}Q-DoPipI%eJ>yptI+c={Lo+KKi+cl}e7 z!^3k%SGjz9<{6+s;ZMn#+f%I5NRwAmSH{DOKS!xS)T@#A3$-A&gg~uq0owdAymyLj zEZOZGWa65Ia$-a%-G}6wM=m=}8>`*)L6aV(p3^7yi=-K8mXv-?eD_dkKTE_oV7vpu zMatmtZG(p{m-nn(PH$0JSY5~?7tSWxmi$3s-aXoXE?d3wA&t{(6}9s9@F?E^xuxLI+=q*W#GS3*+0Pvq9sPj*&Lf z@blEoU;KR$jHH z0*ZrJpXnX)N6t84))t!y7}%tZgVKK+lPo&HlDmpm`tbBg0h98F^?ph!cyM8{PDcnd zir!{D%~#{@zv0994xG7=h!|u!k*t{B^F&g|S>2hmQM6aPHZv%$&#Wl@;nrHLnCqCNn)Tk{5+l_rA1cY;-uOmp zj*3<%er-W$YvyU7AEMz-1jsx7xB(UQ*MmFZAY@)0!QP*8x~D@}ZQdJ0B622ksZ~V- zQk+(;hbeB&Do?05gxk>iJ>VuH6t}Phq8r8bT;JVYsDwyY;tL3vS9#vv+3CNj;$V#w z=Q;m6y}eqhR?X3#dy_j7iNb9oS^043$wn7^BJ!;`&fGK7lg`VARp^%naZhh064Ij3 zD=pe%TN-}sAKZr#1PCFh=?Pr@SxztI7}^D7hwJK&K&(o9gJSRcDIy5zPuGmG5;)^` z)Jp&L`JHn!D$G~WSncBMt8q5GU~c>CJqZN4d1v%>Z?s9w%Z)r&W1B`bn$-)4P3}6~7SNsE1E@-_|nk1uVIC zU?se^W``C5+qoOzXv|>Z>uPzOIf)l~F!)1n^sHDmgAk+VqW#}w`}Z^-&=eRu24i`R zi#+wnAmZx*HijF9?xX05_Bdt0ex9RE{-U>*k(W(zow!T$ZZAQZ%aLh)Whg!3BI|#G z86i)TVP2P%AbV<9%dy~A#<+A7aV*IKZ*q3-+)^Q8G|-7+iflywfsxZodbiR@rV4t8 zowrS$su3Tt^)CNdKDn{v_7Tabe~owGqa1grGf7c4li2t`%c(=tvL!jI) zA$2301rmCuUIVL|+Cnjxh$bRc%jM}Fh#(u6Slh-UM-)U;7-;im7#KT0fUJRh4N!^i z-O+DatNC_mcz>f-+XG4x3R7Wup{!I+&5tizntJwnzA$h?cWjv^|BYkUtgsnSd9XOP zufJSuWb7zII}nuuv>SKrZ+3sZQ8ODt=9-5dACzY%iRu}ze9ytQ`+Tj}n9v~&QH&sR z=Q`tCHcxqc-IZoUJx`c$P5?m&aY8xSv<|6tEls6|T9&dbP4}2jCK7$&bha3%Zrsu|9)Woc+>7(z!SVSV(X7O1C&vUfDv^+nw)9 zXEHw4-Z7LsKe;?%G$FCq0!h5#z5{T9NcLAkbPO8J6V2F52e8uw5i$a|=kF^_OD{|2 zVJmAct#p4ek=sCFep(RmUi-025OZelGy{NeH3;qnLLd0!ms zw$!#%L11`Lg!9hV0d^r|243n>LOr#44+nldhuh!HAQ5oe_Dmm{W#iEf6wY_kZIJw- zy{4|NoSX95le7vV7P?h@W;hw@#(^zu>li>g31I@ry+0xGt6MjOD^h|3iUuX=sb2%- z(4R=sQ;5RXRCE%!v=kD=W#9v%u7T}$6c=HStGcyzXkw^@mM1iqjwP?JSw#RTFMCP= zQcQH~n}iI6!5;1uzI$D9Ll)F4yfUjNFQ-kIE{}G&ST;D_AjQ%CiE&g>RJ&^FH_$~` z|Lhf(N(4(y1t)e8KG`*~So3Vj2xKN-n7(YfA!%l!yj-($t$BKY>ApK1Hmn;*AKNwD z+WUo6VH6Es1L0U-=>6VRkj)>bp0o1+zV!!`GmO%#g5N>?bmbq|M7=&6VE_XH_l&vN zOrRvc|B9ahX#TUYa(Fr#RJ8_~;FvyOEJK;(D>Abul_U}NV5>o&K%} zWqxh)84qgLzaGa{zo!}Fb8`P5#@=B~5GY%>jmWTV+qP}nwr$(CZQHhO+s?3V?$fLL zRihf~8P>!<$5>n;hmV-dze42U%Q^>So3XjpwChza1<&Tp(fE=dHxr)Cz8Y$>^hZkl zc3*4t^Reyn`7QDoXv*VHnrXdk?Ff3w+rC;8#d(Q+hn`Gm=90$z{Oq$5=c=BDo>8Wq z?VwV_Uzemly>K7p4UjKfEHxVQo;H;fz@8uc8=ye&7nYL+Xp-9N=(ABm&6oq!kIjUA z-xLOqVW;eRsvPF8ow?pbJTuSsbT5`oz>sSO{z#W6`=;VACBrUH>lluDG&oBO{prE{ z1(1L3??f|@aB{|sCfDn%Gxcd@*Q_(>=~;-q8VR{!G`|+997SZ#x)Q2ELCkrOO4IBP zErbU^XE=6?HW>yv0z`qkNml?#><0{y=@P8&t?>fvy})R(TYaf*PPQmZN%JQv+6xPh z1H&tT5`Bg*QEcA2X_A1XUHl_tkbVd~(icZUFSuQ|K}LP7!fF_bF#j6hHavrQ7) zM*$|19p?_R{11rajK0pkK-reyK5u0Lc*HW!*IvuRpRG(nOCK8~IFx`k{|*@~|0eK{ zIZS`T&^)o=c71FOr58*t+bXX$&(AaQS3`+c25{ZQ9$^u4^v+~X=}Bml zZ5EQuI6_D~#t1W=*}LbVBX`w5EO+P<$sFcPYYVaVUDy)AhgZ-OCsGA5q6YuA_#RRy z%khjr?@(c`1rZiJ6D2|5(d;K>H_FGx9@5jLRPM7R*h_zSWWlxwcFWsfVi;4H@GG?<@hph)$#UACR@T$(b zrRI7iUyWB=@f#zKrhd|ycnGYGmev-LX`*Ft!iO(CvThaNX-2bNzgAs*%UnhjB9Ygo zHU0m(m4DodmxBvb&631~Yk8jYWm9$jdC+uqPCXMLmf+ zg}qmYk&Ku1!k29JF3xE?*;y|F5K7hA`=dyQwUsca{w8uG;j!VlF5`4J1HQY#CJ!|3 zjfp?Gb6xZ-PqY{_UH9yFgHIl4yd1{#eO(^#u4C&<-BS)2BU6v7cw{c=&_pwF|>^6y&-IklivP0H(SXH-r8JrV$Y%ZL7 zBmAO5Aj`!M79m-j5Ns}t^&LRyOEW<$Lu$}Dw^tGTl-I(4^MDcsBa$eX&emr9-I;+R zU;Lb!KAyt-0Inj5wEt@*^FQ$t8Q7TqBVfLwE@ijP3jfdgLA^aitIu#KRqPGE&+4#{ z55Bo+1LpwyNb4rUPi6CLo>cg+l1ZbcXm-oVCyzwe2q+AFdOOX+p!L<;7lHh}7leP4 z`Zp;$%*q;xqH64?m|Vi9vu%Z}!tM3?jPiPG-Mzb-*Q%)QG2E&aO}8!t<*$lxUODCQ(MPQ9o#rQC(cf+ z$CjAh)|i>~6@F;65=htoksnCwt96twxK{CUH~@KUpt&F%_+yf+DPgl#&8|!Nq}TBJ zN!F?q?HJgT;D^SLKrCW`**Z;3njB@a(E1!%Hq}DQ`Du8x`n$Z-vuEIY{Kz^|t<1ne zUjmNg2O4PsXc~aq5gZ2X5PLJLsKUigL>Moge0DuRiUE#5mA|fy;qD+gdfN^0OA+JC=~gzv zYcW6mkSO<9+#bQO%}4OlMM1^oZ1v7M_d^D2rNZ>zfxAP3xcDRjTzOMqo$4Yb#Ak#E z>v-3a%7V8uVRqRZSy|JyxZ(QBpor>M;~tWL*D?_$oLyxk5J5lL!>Mriu+uD%MT ze$1?i_UnVbB4egChDhS1|5id4p%}maczin9XcAw9Nh;(p0U35`#LoMNPy=5wk!%rC z0ki{Qsd?*h;xd>Di55(DqWz$L3k#gLN2`KW58b43k=wrXas}K@21<+)1h-W%;6b~) zuC;T~DrsDHa#ZIXtj`&-&bdt??|JJ}BAxQm^32U-01;aJ?lRPnZj(?^Rm&RDNHAkA zL`Ggm%Bo-HEbnEeuF8lmOxIU0n%YJ(2-6dEAMlCpuff@{MX-O9KLdP$?baG!u8wZE zw^CIa!WsVcwvl%YlEAFGY-5usgKig?0Mpf=aiz=6|Y z{58praJ^I; zo?%We?$w1(i;oa{S3R3#1*AzaY0N44%n-~{qe0+A!sUIpmN?tzpKZW%`D2m^WX=Jqnk`x?OeKrztPOf%@@;?~owtY&4B^ArgIUf_6c2zrI>Gmu() z->(v0=(}}Bt|uJx9}=by2^uziu81+$ts(9rV(H95tyFpOm%rx09IGj#WeL!QNeL75 zjGzM4_{OP?*=AzNFLgW*K8P-DjS8*T&JI6g^EME%dAZfa!ptZ}&Y}Q3dEU|jKa9^t zCzN8$XJcZN9~eX{)8?Q-ZnLBa-q3eSA3;xGKU{_%vMQ5-HRR8FM~ALv-}*V)ocN+U z1Oqr<@NVUw@fmBLx`N5JVk#6Z` zhqQ(JuGu~klBB?yS$=5wv^(&h_UzOIli>9{W(V13><-QZyyU7+WpCV z^&9Z=4vPFE{fnKEa(Lpf_FNVK@WFF6@}pDG^@?2~x4q$nOh>IWU(!N>sci!NC1ZFf4cNbO!#S^hyRwz`Pi!BVVXP^`AnPR3G*SzGk4;x(CWWe_HS@>@kVMq7e) z(`QA+>^q_k)=xUKbgcwdIogDTGMHFrtESk&NeC6Qz0W4=vw;UW1&ZU3O^IVcusdl8 z@1KBZAC5DjXUnPJHU{0=d!YxbShs=ux476k-fOI!hUB+Fn$c{!EdWSJVjZHKcxD2) z9e7Q)iK>CbvC@sOB)#@NByYv6{RYl!>928?hgeFXj<2#t~Gi{Y;NLyPO0(5Je!e4e;NBOCXvW>Ob9sC5E4SZmwn$ z35+GA;s!(7w+v%!d(>vw-Vo~W18`7?uzd>kHGyqc`=_yB)P)+!4gYv0>X`HbOc|h8 zJA21F1a@9KHG%}d2iLABk`xnXy-OY@s=w8KP{c~is0`yRpGqn18}gzEF-)*Q(WTOz zBV8(#;y{D$lM=RgiPmb|1YzA%ZL%>s8^Y45A1K|%fz7V5=eB#!Dhho21a7MEKu9I7 zAGWv0+Y!l=>`>;&3}u+tJ0U@|euk&5!9d!e2kwOzs31=Fq#P4I*O9tIq zv?TkAyJ#{ouqquX_t8IgPelvo27dgnf&+$`rPSaAtkN7D;7G!xslXzvrThu5m3G%k z30}*gNg_QU#L>G4SKpCis#W126`8Ykmv9|v1EDswpu4nOOVFunoz+C0`! z-h*HnqP590!5N-9m%baS?5YJ0bhqa3l@W^iuw8mqvQm8FdUVm5_dUbB9FLlewy^rz z$54X7NFyt0TtLbLh93dPCdj_x_ofV>r%296Sk`~mYDeNwor z-K@xH+f3+y`#f9412c288{XjHTt{_^eELBTnWjH>7H+QR;PS*N?9ekt&! zl(zel-EomQ3kk&t+OO!aA{(xjf_-)^PGXtJHhj#aDc^=xew7t391YrQ=F#2dErSYe z!x{9Ln6(#Iv{1}b}G>gzhjYzFNz5V?QWGr@GSy+NMH6ES3y!& zLDC1O27mAZ<1pu^lB;OWb{~SC&F$fDl~D<~#mphI(OV9t+ib5~c9$VsMz9j4E#ph+#cd$3srLx`d^Ckjj1BPkx(!b5}}NqWiWuQriMnb@*$6cUSKEC zm_|$k-jttw49<~KyGz5Yv=gSvIT+p@GuW_JDo43$SO@Meyg{~>A6{eTlqc>Pu00*; zUk3*LZ(p3RhowHG9iPkp_62bKPn;@77PkNJApYCN$8EJE{Osx({1qZ-Ly+@ED!DoE zZ+7F*Rsbe%yh$U*Yewx+wfcvU-TaPj$o{{40(xtOtD8fM@($HD6M;1c8if8xRXqb&q!tQNj zs@Lc9y2N>sO{SuCv_ID7H#U&hHB?|VqfYE+6G}AeyH}&6N}RPM&}LPdxN!S1gJl_P zg1;3m+mrnNZf_?)4wgjm#!9WKc&tl=A8Rq>QZmqOZMSKeKpIsfQ6@Or@_w6L?#43` zF(wTB{^^WUnJ+>|uQOm@B(nTi8+M#zBNaR7vH)X~PbTa+abII<^#+JcCUz`_J^FYH zUvPMDs(y5{3M4ym%Q_v(KF3VwZ@XGKaX)X@*;dMTN>!q)I`6*K+Iu8JPjRb@tPoi$ z5rq{YM^l1LJ9u8XY8F!KUWL%A)5ogA)9Rx#1mQ{3n}#cDp2MOeRo5DJgk>AEJ*!4o zsUnU`ybgLcEb5keZ12W)#OVEvxj9tzTgG=qB+L)^bhyd=1_bgr&z$Mp>eU)z`rQln z*JPjdSoY{&WW0W*sT5OtmZK|tC{Qwp;jj1UvgIXi9+5if?PY%cKwZkMcxqjYfU18}}=op#&f}hCu%`e*Xj+GC06_ML$Z@K+4TZ)9mpQSfIwwi5a!o6_Ea5$xO=Wiz_zI!zfhP!lbRfa%- zw~NslYnEl-FSK67bZ8QMzFo*dc+>eK0ppDFkuER>ODt#G<2u_>xz^FF2jI_M&aK-U zsJIhQ&%%)WGfZSjJ}9`oSU$T-Oi~hgSU9gRgP@oX@hJ&Dna#Cr2r;h}>y3HcJ@4Dc zwQ4(|#wndG=3RCsxGh85HbL^y5GZ|3g^OK4c+>Gv7zWB`4N;HK@`br9@h7D$1^)9# zKJfg2+OSEZ5pTY>FCS;KV1L9l6f#|yJ)P;#g0;--r1_({Our;xJ?eeUXa?xR`gH0x z0Zr}tKjZ*@cawG;R4XEV5L6!{R&ZSM_jtUz7q}_TmN#?m$12pFtncC}3bqBddnwL< ztDmHkP@HJ;4557l(hH2#Q0EHWxQrlo*<4Oap`G02*cn4-uxwhTEwk4JTVs zFoG%o(v$|Gkws|A)bV!~3;NBn?evImbiiVEj$IbrOT;QShr)CbVK;7eBd5PMM6L6y zoI9v7dXY9LZ0gz!W2WWS@wtQqB;_POFtBeI#xjewT_w(1^`kdL~SdE7WfsrI`jt^vVOyJzv0 z5jqTta=G=UDPE7WD0vYYXghc$;#XjkhP-!On9SZft@yon!}Ys@aYS}0K*OMyejN;G zR(uky-Aq0!|2P2w;Wuwm(n9*n0-{frL_je&W_v6H`Tb#F*l~!xOZFKJ3s+jUvP^ym zECTb{)S#y%t60%gWBcFJR*nL$8!PUbC7=joI>Aw&OEwipN5n;UFMh zoJ`Vk!8wY*Gni41p`O_vyRW0y!AB8fTL6K{NN${x1i*q9eaEhefH`P(EXrcrO!1aT70M+IU;8@GczK$+~cMW?vP__aq{{u`MFYcI#!dcPl%4!TLKvo# zp=jySpsyP$KgQ#co1Z14M9U}ryeH5T@qj7g{?b?=kKHTBROWJS%Tg3tkQ_&oYv}BA z5o>pDzl{<{Pl7rW!Er5}8ORB>r(x4|HgU$%V{>B00IsbYr5{R6>-uA3olR3hkhFnT zx1VzGPBtxa0Xevp2l9f^PGVTdnUUom*ZLWnKOX4eWro$keFZ zZ;ccKf97YSj@jSU0vvxAww+^dN~*)xP)oU?wlAxyK><<*bQU#2TUGd`Rs;o%uuT%V zHcg##uFGg9C0%9;kzZyjx|uIbj+8@8k6Jo`0fZx(1T+*#%d-m9H(^@eoB|;I^-`9{ zp6)TU#&&$eb=c?%DF2!rn`DeX3aVl~+%3e_bA7V4VWUTgU2`qLQ6- z17VI4EeSyVcpoK@oR-Pg%pZz`6Qd$rm?$*F$MWAf=ElrA6Yjnu{~PWQjHEWk<2V1^ z+})>3s~d1;_8{jMkfX5E{7&aR_f;QH@?f|S*4cxh{FAiZM_DGqDjCpK%);-rJ!Nh> zKHtJK2Z8pN8N`qqcsbZw_|*|sx~$|(#s%0?%dckeppR@Dx{OFWur_UuRpLaDb|pO; zaK0SPg;fzmdqFft|AfPGT8KLijft=OkS`L+;YZ~hmCLax?WMl;Tm6&a<+3yADy6No zbsEVFu?1iNbTY!9zw0aHg~`2&5OD9vGSfg;c6oWoX?&9<*M-No$71N0S)ls;!1cLp z?+Xj-?Unn#mX`k$G>wss{XY<>Et*<(N9`#8FE(HdgpkITp#0IiTX`N*uiLy9C=&Ed6etT_417g|dh_kF4-=cgr+ibR5Z z9rYxmyS|Xud;CzEQJh>JI3y$ho#bl!op`e;GrOvi$8r;|!guL=Uu8yYAtKyMn9SI9 z``TLJk6*HS6O~7Mc%g`xc~(VD?Oxqkd!xt&B@v9cv@dil$4Zh#oo4vm+@?5xrSq(q3m1eWu~Vi_pG@yr zCJr4=Y*^qcL4l0xu-bf3ds|KU(03!>CZovBLGdV_WMRlOL82g8$4D=n>J@l(>MW}n zHh<5)skd(-TZ6CtiJ|YZI{!f&Fuf>RCl3}U8aKw%x>t2uQ?<03uTMEeM}Z`j%#&KC zv~pd$o|5%iwk#S+PB|7+i(U?3h9ZDWVStjrez#)z!%>hE2BI@N-X&z{lI4tkug-)R zOgp~P2_4u2OezD7jj^>UgGBKdp%oP^qXPFyDNzUfwEUV0#r;t+^XC-=@b0a7K%Edx zAv_jQ?@xaAx%csbjUEeygriXL1fLaK1M!lpQn>ATY3kHBGvu3wQfE_{ho(@WU;na;{u zoeW1YLb?F}l863SsCL*({s_cPh<1D?Xc81FB@lk zfJVHgqB--QO$q7E8`-*>Tqr_11VLSVU{DuNG3lJ9S$hf*JmJ+0;ifQjumy3*FlfJu z4;!_-`9eHAB{L=UGQc72(4|~fjI}FDiyv*V+gtc9u=>Q%E*H?%7@%<7jOmfis!*r3 zzqe9~jnaYuY40KCC7n{u@OeS1p*)#Y(;Xrl+;&^6GA%fia#Qo2Ye1Q#u)#z79k0~Z zR@g35Zyz2&@?W{l%(VO@>8&FC*Q~)ce^QBOVvvyVSuI8Z9=wzPrhUA``ac*(CWb#$ z+gn4*uE}^*Z^IwwxeoUP2Ix<)uXi?>k%6AUG_RUNv0E5Ga$*e0p~|K+)iY$X#I8y;Q9J(`5$iDo`Fu? zK6?X?g{lR)z*XH7V_Lv3l7DN3>qjnJd-6GH^>xpEL8rjdy_l%|dB-`XcwSZVe_@}M zwoo%LQ1kW&b-`ms_kn=1hUU*8r|+K3c;&3FbcK@zL>;;}*dzS5yN!BA#138q!#lLL zS>)=WhajF(r_);kfgn?kk}JWZoU}w;g!3mxAiQt{QG_qGHLgiKR@(IBNkC9KjqDTv zN=>9Sz7phzK66`P#fI(<{{mY8`z8~h<*$UiI5JY|F^O+~feKvyv$n=s($>Qw~gxn_siu%T2G^^y+kl&iXVkpc!Z| zpBC`}DSOgCs_#|EW!UUSZm7&>qbqFDXLz!4O4r74F~nu&1eO)_5LDIX&Nc-^i;Z_7 zpJu_<<@v!xdVdRde*016NSx6Y3f+M+tOss5{AbpC+L)J>_aAcBqZ@DZs{<~I`szhx z>$8CM!ibwqUjA_|V`Hosn7Ix>&Q##kEIC~D>cgE=*@&A0jLaAOnswF!M*U-}zlqUuDkm!$F zjhn|Lp!M14M%$R>x>itXGl1@7ug#jO+ryyCC z8QSZgELctTWSu3fV;cx|@Ulwm}LkiU2^ilAf}+Cs$(?1~vIKay~9#Q0rGGY5N(x zrZ4NmYLqFf21uf^CF)dhyG_%bbkuzT4t!io(E0`_Y>FEv{W>qw5@0~FT00aTCPR{r%6 zceTkG2l8#Fs~tTWRO5Q-vFqD^s;IIt9VxLw7>tk8q(wU-Yz7@|YjqSiuFN1KJw5dt zoRo0b5laVXo_BJpu)gIn9{Q~4M5q_EBHx)uJh-IZT=EdQ92G;HiG+i}+hPzIVB#Qc zd;i#84#INupzFSzETz*SZvvuIz4ldDWERLw+rb;BAkEsJ3auD%R*I(p_t)dWh^_X% zU_?tqRV;r8+1g1%ghMMo4yFfTh2Wr3E*tBt@OH8=l|oDFk1o&8#dztI=ACIfbd;6O zj_dvun)2oL6P_kPp^qOO=@El`0|ppy*-rA0X>6xIo&uHkor$#5al))flS%Td5r<@D z+QjG9iYrsdwFH~eV{mHJ7uZ;ogT!}7N%m_D35%FoF@+7%&fIf&qAp_nG=z&|aQVK> z5b9rSQbnH}LmS|?H9*bRXs^_P%o8{iQeK+w(v{cL(aznm7DMk}aF8&kI;fZh?k{tx zMfI#I#aC>cdr=MAqkdHdLQ?ar!s9I5Ug;ypr>=uzaZUG00|ZEK@Mu<7B+08?xa(5$ z72l(_n7I2gkw~awuVn14)yryaViTCGZ-5*`YlR#HgZsrMG==lGSQD|Se3uDY)gStr z?Tu9)kmX?+TdiG}VROC4%++*o%H4yZ5ZvPA`an?R)PJ*ZDD8c-Dk0Bns%d_B+1KQP zTa`w8K|9dU9d-h@XX2YerHF7CPdRWWaznpM<1Ho--CW&-?zL-H=3SoQi|gZkNTVPq z@5lokPRaXxRE6{M`#k}LHF@Q1RX*#{+eQPM6}x_YkCiz~f4^F~yz_g53#tV#_^*}n z|HM6HWMTS`fbGryNsZbOde7AU(qQTrqfjUk-z=Rr41fl(36PExOb9F)%0bm8lH;{ALa>1ZO0D7LV;{M;YdEx+5i z@w(Bxh&+~=x|c5OxwuiRP5d~v-r%TBoU4A{h8cFaOeRmGUnfE)S&(k)-g$1Rnq8gM z38zp}xoPAwu{|7^-zg?E4g1=LHdy4{N09waXRvErvH`U;8_U2MiQUZSd^g*2Z{~K| zTCF*exje<$17kiqT}LI+h5;dCBoWK5qshg68g|{;uxxTh;qK;uD#uS4x;!Gg%366f z9a?-mAvqszHE(3Eu(%KrnK1%V)FQKS zDZ~&k@GW^zkI@zCm}XY1f~u1(gI)O!e64ysUie1s2EapLsm$D#V6dyFk9+|x%2%g| zapPr~it}mAfh|5UVdP8;T*-l<;s&M$(CS+pbRM-eUkt}PSlB+0%ITNTmZA)rCCWHg zT56S*#=e48OA@brz1M#{79VpV1q}tQyt#Au{PN^|-r?cD%3iP8)Z6rNxp_Q(Siw#E z4)>KrkMi|uyh&0bd%LA;eJ!F(n&T1X z^h3H&&i^@#>IaIN-1Y|XP#z_99uzk&<_pnvuYY+E)gyqH6$BncLt#+^4`xFB_e_Bo zO-50+K=Ir2NB{zK%>Xn-ry=}pqXLFbHeP~i`cQ$;vLmNR$^y$Glmzx1D9sIY7Gt!! zL4y(eO>f(McX>9;T&p2+b+q;9R7vSza#6&_>Yw1p_b?%N7?S!2K`k%P5NR)zm%!2K zVwim=h0zpYx?!RhdSFg@nd8WaIRw!R7~1!ro+dySHDzAfQBB!h)0BKh?6b4FuDp95 z<7lUKJkLW~&1G>J;#^Pp5b_S{dlpZ%;Ke0*yr3Tzl-Q=nDOFRIj!BFGEls#-#9vMH zzx|ChX=qVCbnv+Rk27fBZytlHPNm)*O#JfntrU~@qlUn79r3tg7c?va%j~d$U^Tlp z3fqoK+-_t4xyR+(Rd)3EiR4cENu(`QNgc{FmrB|k>Wl#*yl+xx2x_>viuHLboLb9g zYbh!}Q3^lE2IpQOzZns119dk3rsz#6`ur1^Al~}5XO9Npb_z|mqNAhL6VNH-BQ3OpGz);O%EJ(^A;0dJ zEH^I^9f%5>P|p1oPP6OvQxSyDEi_mr5AgmYp^-$f^_ui*+wt|9+qIzmr+p~&`PAfo z;9*72Nw@%;HX$NKp*Sls{1I|F^b{iS4%NU|)3_ti>Wm1x;~-nmfBftWL1USU_mpW7 zLQfBVioHlO>8s;)1P+Q|G(o>A zYzqLo&Pz;@jTq3J9Z90^6(a#C)3@sqJVD;1I)$l}vlr|F*P+HhT0i6#NNc<&^vWW^ z@}Lu(j^A#iteyMsuh0@q!3AHW^b6B5)V>16t{BU%dJy4g^hOFC={(*w1oc!80OtCr z5+JxTHGs-G=9RUj!o<=bNa+QB0%Y{FktT(x8kjoJj#O5X$ujv_MSkL@xI_rVwB zXE+F}GwVje{i~Fw;?DOG3?*i<5N|lz>G2d+z8wi@Jv6BhAkJh#`+UqlSuNFXrkuc6 zAxXVeHwA(9sLv|k3et3rgfOmtm;nd8I7MUBjoP8@V+h=PSA&Avv8jCm04(;;jX<5G4b6Gl-rXQnRgtm|F*qgpe27 zh+HaHNW9t44Gw$I`s}jd=>Vd}Z!&RqpW;UkpR-F%3_f}w_= zF@es!3)<8Zshq=v(Jx4nlf==08rPnJ*kFJP82HlC$zC&Hht6bk#B5dYz)^kJSv-%T zYBH`RvYp_iO@R?EnrG9}3b%y)bEaNiatpkg9Wjx%jJy+$Slnsc+0WWCtJ<^#ZXc}3 zVp=RHn1K@=gT+n3+{c!7fAnB|duYQvRwU{;MJkb$Np!als&TpB9=Gs$BB1_^fqa5?O!d7D~!5ef135f9M)S(&R?13@Yk?VUF4F?dbVF+wIJo#r&6w zk(K^`f{rq>|Nl?2{vFYa{@)RO;J6PvB)G<{qn`MYJ%1)=d6ZS+sAy2(EtsaJR<~ra zw4#f1-;b%QD}`dIbq5SA45eeoc21g^X|4umJDhrazaRBH_7BN`H;%U#iucpM1Xsip zvDv_iO@E_*i34rpzU70}o2!O3=hAc`vy9N}tZ4!~VfQtrQuWq`of;o-;DmY!#)y^Ya(d-IdbP{Z zS+h=4j@t{?b<^et2T8oak!Xd5c0a_RZ7u7o3-LSk?Zh$)>+##`n>Zm8s-H>NW z7EdG0nL}+*c^-CBEyYp35w0+G+>`dE*qtfH1SJU6)Mcyfs)*Vu3haG7zRQ)3*sH6W zd>>^M7pBE@<$dP@VOF75A%P}+@U+M}=8>_oQH*=GKmBpsNirtkX_z`z98;}eJg1{+A}4BgK!&3G$ZXrk*C}@w#Vsj| z;vc#^C32qtLAeViZ7NqJ^ibhI!T#XzfGm)5X!eK}Mc32!G{YW^jF;=_o1CsBI6JK+;VI0)KI@M%{92!{${_6fOHbAs6XFRe_-qcZf?T{k zZJ*ztnYgpr)IGoU?!u{8v|m@Fy_{d~hZpb30BOKcZe6s~I7eGTWG_p*lo8DM1Mjz; zk+P>YH9X#L#+K?oJdeH_S2vv-I654M9iVho2^VuOk_ivljB0(}+>tVqxj#P$ zV5R>+XPOm_d-5(bagfI&AL`M;+E}{Vay*qVsYJo&Xv&Rge`X9d6AGRZQAt^wV2h-} z6d4%vR66wMebkQx8$1PPX{S_KjN9h}AWD8o5djA0&;YIw zez~q81tDyRi)QazUZ^{$IB$*WprsHs*noM&wcGhf3FY`1Xc+kpi#>V5kTT5hX}0BI zQ-m1vyy{;^v@aWUS#dSx5(|4&x4S1IIFKA6XY7O{%*=rLs8o-GrkS+0Ah+|3prW-Y zJu;y((M|5|DG4&ck6&rDD#3=fxF0q>WLRM8Um;P&*vCq%oTfjw_3xKJ{sPI4G9b9J z{79Z5MdX&}3sFo$YS0%lrpzNKgEg&|;xEP(Jr^%#3xOIu8n^KD=nPOp@vo1vVXw>a zD*@JwK3}&Koy6xOo`Z*RjJcT@qg-~8nk4DxENhi**_bAVm^Lm*8ZC6i`lI2rbjW+n zA-qg+^(SbwhenZTWRqN!A8^8^=Q3+Z8jxTwMn-%SU^&p_iNty0a%)U~avmrU@mMMg zmJjGffwiOOi*hX=2WK8s^H}bmqFcH{k8>1uI`z!f$hujV| zo{MkkTDi5;F%xy5^>53Rm7; zBqyDO2w+4dQ-o%>0=g4*W@T$B3We>I+jA9L2U;Yv2_%z|*;=9f-7pgKJe~wS#kp~d2XXzhECJ1nrkeP(*KSy1eJe3wp|Q}5CjYR z*;5F7CU<`_+`Zkg8F4{SEeJJaem1 zEaLw2-8z5z&d_wGl|frP?3;Giib0y`*#n#jNdi&NO)+-i+|MbiCV&oW{r<~GCxZx7 z4<`F13d{!iY>vsppY#eB=3^PnsYsZIR&!Tb@v*Re+y+b>B4nrYa4V?MkefV#^df;eqaX2UW(7I6vG23sHSlxj zjpbw*#Pfq;DS49Pd;f~G9-a4ap=+m_!L3r=yXQg)(8GRN$}^f7&*48i@7>`dyu6bx zsqjX|&nE$^mcv;EA_j(F0m44P)=kyawZf zRQYP(5XhK9OW1uP(q3;0YU1j{?hx)XJ%P99$$+UePlEHc_K4QeCS5uxv*Ue5wh-A5 zsc+i)1pKqtNs5gH&QVu=0Krms3lqBtj&jT?!jt~?Oy(wfgL)^F$8=C-j>uc{hA$#C z&5WI~8Xtn6mv9&!HuG^25cQV&^Vf>2W>fyT@PEgVSNl0nr^hPxTRio(Digdyoh_F%MG|Qn9?y=*lUYm&#OVwk5rQnZrvx@%>YeSQz+Yvq>PNEms0c z4YHZ#Zl&X}w*MOiVj6Z)Jv|)Xc61557q3WO$fKk>Pch+ae8Bc5nX9hV4@X?!7;|X1 z#=Jk-W%qZ%Q67we|K0+M!>J|zsyAu`OL8tg`BY>J4&}DyArD}``T{#B4?OWld@9es zECbjUNL50g2_irDZ(Cq09o`96)$y@_12rQH=#uhei1!#+cOEAC7gNN7nQwE^Y%Xb0 zMWoVAnxjI@iki|J${te$IHm*?l&mC!QbN%c|eiNt5LopnHowV93vAb)wT&|?u5EDF{we&Sy zYm$X;8Kb`*PX6Q$KZQRg*5_Ri-}jB5oTuP_)55XR|8KlyHpc&u(a&i7tHN2~e|q%@ zob`&iVXdT#~CHTl$lfdgsq!SlV*W>mSl8q+{u+g-V3P7sSF5SIv zJI-RI@74T+(0>m25#R8@qFnBuxY;=g0AmwkSzu4w09F54UYSs))6@zOjUOF;toX?V z6cyh#d2@QYxO0S)7wIQbZx7Sl@U}<(O^;@oyk-WQn!WAi_KuUn%k3L9vaAJ-)mK#G zWb1RNLpyGk6}Y5^nHAGloOCdONQt4$su=TRv+jiVPT0fig##Bqf<8^h^;Mt|L^1E! zHWszV(oIY+nnr;mL2O4$d5!*5s51lA@|LXlBo8qfsE|fgAEdm$0c|_s@)Em^vVp}i z7&<_mwY|36RlCLv#Ldw~1Et&_|7jKGnxO2HLYts$Op4J^MjuhXR>#JNw+IP0+|LtK zuQwA^AtZ6ZdTA?dmuli7L%OSBWu~H}K_e$Qk`SgieDs*$e=U^g2anN1o&^kq?JIWP z&n>1}0&?Y^pg+qmeGF-w)r3jQ*Memq+G|Z{q&Uw#Pz3s_z zYFI}majZ005sn9p`f0!0KJ$4k&^KJ^v{MD0v_etQ!zINI)0Ke-aNVwywnU>8PJfe5 zLYLTyrDkLMtX7Pnw;ele(~SsTtkuG#rk1)(BGgbWy;lq*cqiXjkAF^YhN6>hjMmK3 zb;4YTou6;QJ_(s4MG=oojmV2^X7s9Ygm+o3Er)H2KZq%c@7hR~k>v*)GN8v&4(v7% z70Vw?&QdX1nMZ=F@buVKh?%Odj)aIakPMe?e4*7Nkl8$OBPJ5ZnPiM+{u`n-9uIlHBK7eoDXf)ABmYynpC?rCS zdU+*GeX9(2eiAyL6C2&UkV89T^XKZtbJn1Ypp6C>r9E^?Ol85U?4?7D{G1IZI3_BW z9-vqXXs}JTiPQaAO6rf-3_C z!y!{BJq*!XId~VrHzsr(IP$5)Fvtb=2ei~wK1)x_$t)_z#86dIMCm*QbtUs0@5dk3 z>J6gSZj8DEs$P(hkP^8S0WQIUnNv#s;Lh##T=yDA^HIP-+x7kc0$O#;_2hFq@7w=RPszmp;iWoS}q379qZWB1}N# zu1KolYwnrR#%e3Htv9Z)w%ID4B=hYn`!8uwxdcTa%07mZLUBB5zOMTChkEUFOC@6y zFUUhJh`Y8_x!U4h-Au-wsYJ?GRO;yu5cuA$RybajlkkcjkA|s2^_#F5ad=C8&Ajum zyrk!$O0g3GMI~_}e0jX~t9lLw1`X#dP56BMA*Hm3m)Nkn{H8kHj;jks8fhA=8K2$? zTvnB&R{W>vCf}Ma+!cb)7B4rRi$>q}fT2O%A-aH2G3aN5dip=or9M9Cy&Sw5KI~a+ zK_~Wl;HTHOC1m4gXhdgpt-yS!Wd=4@-P^Lho*uQxYhvt!ni73*lOEk7mlSC02DHrv zIkW#CWAE6U3AA z9FjFOt{qikkx(nP?&=$WT0GkZfncqsHrb{L^uU zC24{%8#Qvz5%>~T&#gipPju^7x?ILG)h}Nw%k%}ia zX+Fg7`U)dZM(J7gq!9^X+r18P6goSeH1r zsL}WN1+QvFG+&t3bv|20AqO>M^Ve>U((~Gxi!h=dWX*Y(2&;gH*PMnOgw(T# z*2MpY(|DdhvwhifR&9BDr;`nkaQLFL2bll|`1oxG65*D_q zFRhp4rg85b;z>5whNSd>lFQ1i&c9i!W!!THeYDpfZc8Gj<_DP9rTNyjVoalw)A zBJi;s50!=>3?>0D=Ftto1msryQF^Jq#-c)CrlYGrwX1Og4ySOsN0F{XiQET$*nquB zg{S@bL^)Z~} zSQ?FGvOv3znKHRJ;Dzk6qyyr9eJ4!v1|%}Dc;(Hy?>02&m}JHlhyNluPlA-q!JYbD zSbGX3$cNdSs9oI{U518;K=Y3`dIu%kVG>0<%c%cYITAu#Pb#3Y#zha_WTb3jQsu@2 zN=+DAob1+4N>0O!{c|4Pai6?d9`YZe7J0WcG4??3zJzj4!T=vgQ~HV zv)u#cDabH$qL3-JFa-Kj3Tin!XojqKuo+1tZ9bYJ6_`kZsDIrQ@Vr^4ZbW-@YE<*ogs+AAtn zYNAksKL)V50-~qJr%PxXer{ZA}dWhGSG`jv_!Zt=g(1U@6Qf%;;m#sCV>7J$G`Z=NyPRoe0i-F6ocIaVIfdq?kw*qCAvhR$9puMY29=G^@m*>gXDFGY=duCS?E6 zcl^m?JOKL$OhP#L))@d}L9?aX0N6Q9E*&v9fRUeV)a}pcsAlv*R035Rfl~ox_fR=PBa-j&6+qYPHSgBpY!2eI1bg@Q?{V`T>HakO^x^83~YDn0;KHY<_66y z(Kby1n>1MIapZQVd$cF|#Y|*k7;DyX2b(A_Y}1&nJvMqz_gnF4#X!TVxS;#)qtog6 z`lM^!THtKefVwpYMuG2=GC?FZN235E<6uaJevLS6?(a@YsWHXNI+D?R(NLz_=IQtR zNB>cdQ#&agDl_0;nL2`)Wti{(mVji*qAdvmFjZ@-ebNk764o7lcb2ab*1MH$MhD;K z*S4av8y);XT=9Gq!i`#&u-zD^3ueYW_fzRH3KscCtn4LC?Xm|d&mV#9!DqED>&sZ5 z$Q>@SlPr;mO5&M#N{Ra`RWi^2reex_e&MuZ%l@+}siuPS>of4giD2Fy>Vm=~>!hA_ zIo2mlhf?knT)!r3)w!XmM#^s~ITk@qejU!Dk?A?OTH|*luFt#=QG{R>EkCYFPhw_* z(Ph;N(34o@!;-61Px-1?A)CBGC7_obpIfD!T8eqsFVsj=>R`WJ*X8_f`~sTX8!78A zcRn;4WuBF003)8QX2I?+@`8i-rVcM(jZKtZD>p9=v5c9mUqg;N*G|TNX2!RgtXEti zK|Pxe-KDxMtYzP{Ok(79F=X>*UD6+Eu+5f3=ainDSkHlT?){E%J}~rQ{^pCRC*MkD zuYfPS{6z%Uddfq(^?H=pTajyRW7^KD>O;`y51Os_bK`y9H4giea?w*7BkzgvsSiKI zdgbo-dV73#)s^ zu7_Mq765Ix-7!_|)5nBIN4GbncGQ3a^{&nYHMp%Biy`;8O(!%pZt%plxvEbQ#j>l~ z)K~}zjG%u}fUAS_OPtXH-m12k{l1P|3-}0LoFzdGMr_ouMRTvzZ=_qmaP=wFqqrGo zF5=}u)hv$_J6q%D^ZUXX)7Q^r;A-8cJwd#W7vn*M*mveWI3vKPYG|cCIw+^{ED{q% zd7mF~dYa?^fY{E(F8Z&X(EkRuW@Kahe>c_$xdEI?U?cL0^nZ;$Tyu zwm&KBLJOnuCIGlP3%?tmN-!4<@$)u+3gM!XJ_T#GG!)iJXllBDo1Uh6<1AE!`L-y= z{E#miA$v2#>)|m+mX%CEXUVK1$`ofI2A?Z>y;IJX=IhG%<}|`0mNKo!-tFz^?o9vT z8IPDYHAnI5e$CMBv}Va}?PZSPSK3+c_F9`mPaTf<7G+^6JKDGR@}z}{lhe$EOIarW z3xrZlZ>lwqW#J|yWaA-!eq0x$Cz5>dv{&gP+fWGJgaK;IC7}MIPP`U zp=v|@s~C$$G7k02g=C=LugV?Js&%>L<9?ogCYM{`x>8|Shlbk>|o8*o^ zSDQE$cYkz=kD>1T{&jaSq#k>{X8NsCW?I#C65`cE*QV{Kb+hbe@$9BZhrWXHAbt!@ zc!DE{rhH9vG5ykez9tE4gW?jw`@*Hy5(|)AA_Mp~u<6TZv#n4Ga-!7B7W!3ik;^Hs z&~Z?Z>ikPkTDz4?n>FwM^gNMB0=i1OF@u)%0FJs@?X2Cp>HB<=W)J|s{8f)Z6h3)4 zn1tQv<8{jn2y@5z_`?5ugyLoEG#EpV;db&KGr(z9br1y#SK$a2^24R>!psyIs` z!imlK*0XblaovofQT;e8z7AOLIzDaH`U>mmsCM%Vusra!fBsw*f3oj-v%&ksaa1~D ziMl3EP%7jY(Seu-X|qGnlYFm?tu4f-osaPj&T}rF;!NmJwg>^5M>ITK{u3wY$TU2^ zRGyErHU|qErj^obNsg2=9nB0NH+KG3m` zph9?&dR$(>c;v9@BH3&&_-OaJBWRl-yjave$W)nx2y(D6sNQIiiO zBO0Z_5=_QXAHtJt)JcfNKZvC8ROuCtIA|@8HqQ>c+#~GMDn?Q4<~rkIZEwP}>AiZx>hr4vLoE0YcPR?pI_K2qwr$lMQujTUy5BDd{!35;!SI z%UQTBb0f)xK*Bt8agHW@>Bh={8rvp=!l%_{B(h*povu)jzHd}N%rsEd6%CN0Ld7RM z{xs%%-}=1kHHc~l&Bs&-U@SlTwx{?}%;-@JYIRl^$>QHwZj(jvaIZ~?f>82y#SFSD z!O)aNvCBndkd`x)l(~asatVP)!p(V|!hwsR;r_bpm@?K!xWjq zC?|sf$sv2}2$|j7et%xL#5V4@^t;F*hkO4g8(nZ zfL7DK-0Fo$hEj-FV72h%^xt7fdTs72h1E%Qjagcw7ctV%$9a>w(PP00#PxrFZdE?L=vL<`w=aOm=LKrC^4GPC2fXH zqutJ*GZ#tYhUAHA)jI}c)+XojBR3dBe#ACMwr}R&lp|Sp5PERD##P%P8gs+wh5(jI z_~9MnhG`nz3auVk~)(5GE+VrA){s06!snOpSYMjG*hZ5 zvGsBX1`$@^LEci{!-yTlFC$IltW@K>{N-|QP)vD>McdukJS!U;?iq`Mi&^{UYwQpm z2CQ3O)RX&JYp7(!NH#odh&#m?e=G*yx0*InBUB8TE2DgJ@D=Dt7&wYSD&3! zP_&~1T*Y8)KL#QVY9A?s3LHSpi^V9n`PEmn*|!s0O}UW>TqGVembZ%j+{r?m-wV52 z!ZqQ4Yg`!rH@-6~!~aR-DEa>xAo==7L_cQ?Dq5IJ0I2{X2U-u!wKN-kGn+f@aw?AG z&LzkX0>pbMQg4!;vN4=g3NMj)ZkmVr;b04d9_A$sBe7qr-$-$L z@MIXU0`e0Q)zYr(H{rYU6B6YSv_n8N;7WVtGx4zc3gX+TnTtqKb5fMASNEBj z2`g_Lr!z<{Vu+NA$nhqXlhQ+t^l+jjtvNIbG14SRwhY*D<~-|^)bJe;@)x@P|He& z5wSd5;S5~jn$@yz(PrINnfbF%C`38&l;c~uCEVxZi1_FXKtxAOmSX{x51cRkvFd#x zEpK16=y6~CPG(@>`a@0~+(g$s7lPUk-ZZNCuSOT}{MdtRFBT&^eQLG!GrL%ANP%S@4Mp?Gv-9nsNJMC9Qj`UW zYO5@z8jg0%DnW+RcTHUe{!GS9Fv?K{$&QH!ve~Nbe&)Xbp^{E`Q4tc3vl+u-?yruw zdDY4)cMlk7HP~niy4KsawtXpG(YS%&b=VrE6rq|2jpDU<*=rjk^63?Iw|8FTtAGnB zE++0rxswv1fM%@v{o}QiK7l1eCcMioW=NUfYDy%qM)5w&bnEn5_R!GGLn+5R0MYMk zCZO7F_CaYtp|kX;ne9i-Jy&%asuW1fVG$xC?3t|L9?zuBrzGqIJLQ@@fWAcwMDd-; zD*DR_D+#<#H7A)8K2W8tX#v^es<*)^+8lN_v1xlLsKH~OAT zM2M_J0KN|OY*Fp{41$AJjl}6D>V!sahWyVs4zbAHk`g0>a>Z;UyyO7KI97y`mW3{b z0{hjzqqCTaB}ZDfiV0M$Bm+{?0bNS-&88Rm4}~zRts%-0FCyA!4fWM5Co|SSgn^Sy z%Ly+M&D3%62z(Gcg6O+uMxYsIf_1xL(BWeE62v4ndfqWRdA9%Aa@}x?<5rc4o>@c{ z%9>icgT-KV$f|y0LxDG6hs_Y948;vvP01#+-cT&d)sQ+jDnmNWZolvx53yfBh5&Q1 zT6bV_oi$o8-f5fZpMt318E4ROP-vHcGa*eR5t%SC;p6h-3Y^1fGrRO^GKg35*jp9k zc(yRpTm(oj(&P-AZaorMHf>@@6IjjF#ekB#he?8q7&MoqyidJW* zB?3xhx;mzi-yH+R2aL;B>(lv}afG(&pKGOI+aYP&syZFS5|(Z-!`74i@FqS9#7(ma z=Iv_Ee5yj=_}+Vph_}&vAIhNvR6LPL_qT{vAZ&{OpnBn@_e@jOtiLR3DyWOovDs1+ zchya(B$CrJyMBYEuuA>ZsTl?YzTo}5VeYb_%=W(CwKBiv{h;7d#IS+5#G7YqM6;3@5tsg9eONo=> z>OLRw`9HsIvh;m>U%j*ZdOtr8XY9Wp96~pHX%6ar*i(JYa?U~=A~+7!>ke0EU{sK( zdEg1%HQ_QoCpH)vputy`x6Y0y&d7E1iSMNpf+DNmH(G7VO*Y2n8?oSV3(CT6yt$Xc z3F^bED%rWvX_|29IK|w}8M5paS?LaecilBV4PXQkSUpSLd(ZW*Q^}@*DY*azy8&~zQ?~2^0%(VuFf!2rh%q_DF1xglN>w0rMY!9?$2Xt}#ZYf(V zKx`y1XL^Fa(mgcWYAaF?_o!PZ*}x^Du{oHphPO7DY2TOljarUry~QOtKpyZlB@x!w z>%48O&wHM%V@MCWkf%-3W0X*~%8~MDM~0v{uUTy)oQ7OddMIl1H8=BAe#RD(jL^Eb zk+xf@y5=i8vcHb0H+r$AY?CaUi-nw8BEZ4AtGrU8q1sqVZG)^a?8vQDER+tuPDZ@g z{GqYcp|&;Y*=tKjii$4i?UFIZSwNWkMN3*JViUYR#0lNXpNa%h5L5nbjm3$q0DxVx z2u%czsvshy&usq4yq&GQk#$$WNfC^kw@$-0{>>t90(XY3-w70MyPPyF?%{unKZRnn z_r$QT>Ww!A@uy;(oFD*<^*f{VXoTABV)BVov!JoV3@La!uz@%hvn`?^(U75{3hw2& z=fhhu%wxeYw0lA1i{|)cUX{SYXGa8>#HNT7FZ!^K6vri+vA3;@) z-8yb?2_l>6E6fH9al|448vf&?+b!Y0YujzxnNYkRZoT*7afT*+diG&^t4|E#XY|VL zUv$6OoWYbV9c{HZAAe(X!g`8?-*^#U1NK{F~2H<``_iXfnbMC;l-Ygr)K$%k{Kwd@e4 zgqocdN$98kr{R&)ob>ov*<>c0x_`}kxZ0}+%DI8U7F-0V1m!u9 zDWKQHBfF3^+HXl~VNZ+1-(|+|x?;dauLME-MUlJCY(D!sd&M2GBg!GQj~`1C@NLmtrE3Ur9`HmZ?vHm^2`4(nVxDSGjJVdM9)qBr zGOeoT)ON-Hkwl*OEAb(0ZnXh!Pl##Cw6)Wy{lmh(PteiDs6qAdsI_i8A0&_rbP#Jz z%VxVEU=hj3iCVxd=@ZmX$)StCN07yu#Iza0Va!0>k;F{BEv(S~v@5y@u>)YYwB|Mb zQO5AhHB!46^r4goK&rmy=$55b&GyiI-j+~(yw*a4q&t#u-V>H@w(?X3{bLkq^3`6e z>H=ke=^Y!k?^U=^%27EHk(;(ByoFAIYsdzs8kI-rooeLnTVaeQ5)A1Z`%?lqPHmQF zI&wEiilek?Xq!TFgn(3F-)vY+LT)YZ``~vC;fFMUnPRaL|uJ2G~w^ZwtBZy)# zkspK(daluQ(4bk-w(U)M)Kprnl4ai_dYwK8O52C?3jWC9e{K|% z+h3)%*?m7I`1lG)|A}?t2pSadyf-7n0ir+jH(4hO{D*=7PC3QXJKGUf0xjd<^#NCy zc`n*E;(5^P0&;)lO7q!Flq%QgqR3kF6ylC&uh!bi_Q)1;+T`%y@5;FxrucwkWxthF zX$#RbY}Yg^ti>dvktce1i6~(VQUdY}0S-%zHo0xj(OTNuaVn!-!Hk>uW0(zo5dZQ5 z9~-;|cO0F^DX&1*&M){v6~P*AB5+h~&7nO`92d%88k-{hE zXQL*TQ7r&E!Zh4SDWZj3vsAVDHaylwPi;$sF4HsZL}S?>x4X7DkUUtT#=j&uhg*fC=7K-P4T=z9(- z{SaG`BmX1x?eE<@xFpC?4~>km=|a20Ihcp8)x*Fdss2xlG&TPgF(K4-$oHWF!OCLz&e|g z90Cxxn{vD-=xr@eiqtl(&|zE5yK-fuyGgTIw)$PsHPeak7A$y(wLb1y6y%dfDCq^M z(KuXhh?1(ncus*r+~5=!VmNkH%< z&)!^Q_-zvi$W*o_%HerD!gaSVYh3LDqEwSV)Ygjml?1llkq2hu$M1GW9}_obtt)R{ zw(oCleKxFpgFlCo-H3x8cUvTWBiu~C|0GWgO-3>1-FI90;}6fK;-5ZU&yyr`CPc{S zEpPsrkDaZ`8fbZd9>C&>aXq5@qg;EXXVKpvRWVGVR-snsg+fRb$96n zXzhlL(L|eM%BEN4;an|4G(VBX*sSXwGR?HvAbx##mGC?qqWy*j|Ege_-RR~ znN6a~TxQ=f%qYtBE+#`}P87^UQ7VVze;H}X?z?DSUl=N}Pjpny?L17wa@AFI9lC6V z&^k&!T*=I9zU}{;2K?ixM9yOui~|qmio^V@xrU8hyj)f6q^tUuo(;>r_rXu*7s7~D zep7Yx1q|#aHt}CS$p4L*&B*b8KFAeyZTn)j|9p^p6|hwY1~$$UwPNS3sFqcgS5_yK zC5Q-r0$bqf`;SULUN&)t`h!iDRNoayrQouso_+ZEaH{FiTX`OXYUb7Za#OBr5VbEZ z2ixkyjOa&K-OTsL2f;>I8e2E=p5!^}xEDC+2#23;I}Vkku4LDsdhK)iTKhE6n9^GX)BvV_o(HZMnq^)zd!U z_v#0Z7!7;dWGmS3A8-f-Gqe~`6t??4IGT5#(U|wK>{Of_fh?BDNHveMw`v}@M>bmo zC~LarkL3ET8ey*1P-q)!sLv2tmQdmq`J$fT6F8?uIYkf+gd0B9DNLJs#Gq40DukA+ zZIg!^P$WF!?yiMcj5!f4srUvLYKr!FowiSxJ+WbU4%j%3Eg_`h&-sRpq>R7Ds3<+D zuONI;8(jS@avmJf(>o>Whqu2rTv6BWOWbs#pNzdIykR{5O%BD(BfP8{h49%Uvs^fx zOb4OJNx+23H^r0{lv2Vq7@5({NTwbJkYh0pr#l6}8dS3Ivd}u|Tr$qd#X6OAQ^=}+6V6|;dT;NP}XDB%2=Tn%8aBNNV4AlV@tEN zLu09UCuZqU99L@ZcJA1k_^eQ)aP*|PsCgVIq=;2n0BErkhBs*7d*ko>YrId;!nDCy z8~X&RaZ^kD77&CO4~k7Mp8?=X<(FyMoV11@wb00rl0H4F?$UcOZu=jaqS2TZ2xO8Y zA|lp5po|HOVJeE5XJu0?+CpNXcG*>4I6)~;uZrcfR~hTXSVv1x5Jm1M0Suq)RmsVY zP1(xv+@E?wrShL@md8GdBi$PhkklG!WI=L5IY zp`Pp55zhdbNHR7ZpnFAw5r7+1o${_C9{HsVI2BV3USpQvJX>2P+hX|x>^Vd0(Nnu& zm6i&kdr%P`KO;7^)CLoZhat=6u@t_4EUoH5dyXxGJMYhNu<_)j^t?O}cVhzP7y}O? z?UiNBpXiT@(V+epG*3?WqtHi5`+p4(58ihK^sszFy3bm_z2Mg`So-NLfMVCR=Rx}P zqEBf8XuAccH32HZQM%V_s;{H|D3*G-T@Z7>-VV7TdX((%^v`9x7fks|7@`ODe0hrn zpzTabA)DhjFNTLiign-bUSPp{S?dOqEad_U`98yjbn+oS{r5a7klWR@@08^c? zzS-WLE0_qhq^u!<^O3$8DznI%_BvMr4z@3i(ZC86WmSp7yZcoFN~Lg&*ZnG%8P+@F zO)U}BRxse1n{*)de5Tl%l5Fw%uwRrAP@Yji+Otg@pkY`17o*l_o5EE_9q+`4+8@rk z`hb!DRo(x$GRO2kaiJO6{_in+PW%IUJ-E85h zy{3qAp^|7(ldDKnxKp7Ba!w83u&5dhU+(8`##xD6=aUb{jR0m*dYH zj+YLA-PUNV=tu3jJI8ycF3Ar}`Mt&tohB|O>FtBIWm0M0R+T&`RfIxGVc#Xk3ZBRb z8Gp^^{UGF9PDWO)DENfraNDQ8+I55UYUlDvkhVUPk?7M(44Rlnn}o^u)r4jCfsIShYyo>WWB$KHpYYH&7Jsj{H{6FYQ&| zf^53vMOtFRlgM3zDcwM4-w3?>#loIC=IG`G$yH0Q(4t89qDqa z@I6jA66D0fFx2%x1g-7Y=L14%!<*uC4@`qi_v8JVy(YziNKF?U_cS^q&KTJ^!*FE8 z=~cdR#4g`kz3$qdQ()C8Ky)t7l<_?{+j}W=}%-D&8m8*wptH>6nLY3By+KaRj&Ezu?`$b$eqKO&DSMI%uYj`{o*tL6#d$5aVyT>u>?mlZ?Z7-HCA^ z56kGCYa1XK&Ee9KGP^gQvd`^OmY=x4<&KvB~fXnJCIeiXw_*s@=_y|#ofF6U`($+ zm=HGcVq!)xi_49bcvPJp;B!qhMT>G>VwL(bf~pO1l|Lw6=X$?{Y9RsGdZp3LrXLk^ zU7aCI{Tt6jK^$pzAM17v4@%!CDgOR-ltaHcO&3VMESKkgeSg35eQ3@l%cAeAL&EZl z3PJLXt$zCi5r^&WK`rmbYH6{Z3r_Z{>O$Ca%Dfk#>k*g7>%Hyk+_F5xIc~{SGmW>j zT%G`^xpi5(z9@Ka)b-)j5#CdF$4%vBWN~T>LY;kQZ?LOn#0i?ABsYRHrg`l>A}J?b zejmj9C2Una2vHn2n|+;pYWkKPy0OKDw>XeeH0?l=LCLWvq2geW+0G6gkt}4Ihc7dT z!MXtuACzSnLLmzU>k4Bz<1+1mkwjfmHuz;DBAI|F-h_ymr3zZ^$8#rI)V)kN5fYfq zVBlMp@qui%V}7i%s`z4&%OnG$ud8$X$I&&XS$C0y+mF|^XU_rZ8eo!j>7b40CCoYw z_Y;CehUe4N&`e^3ZDOJwM&ist5*@ZsHb0Umn-7y zD$gXFm)5x;=cK9b*Y!`66l2z*8IQOUdKX<0YEx#Wv+ZIcGgVnZ-~@*7X- zm7dVY8U6EVh@a-~MEQUH#Qrw|EfeGa;cC@r*g7A!{zs8jaGR!(fg1bgaEjGANBTlK z8&PiS-sFUA5>l&>h7GNPxPs$+`=QMp16CmzeoM;Bcn%08V8rNo!yF^sC-YVl&d)m) z<|WR&3UIlVwQ=!mG-{kW#+e7OG2_W{oN!8+v0LRA_XD867hImeQks&yWW5Se{_?@> zY+Qf5*SGUcr>xZ^LXD5QZz5qYs@ru&Lk&_v>vU*Br!vPNr}MA3~^z zj5LeE#r)hBBT_TjH22nyzGm$ef%h+IW;6Z(a6{T!j6Q7ykZmRq{Lsa*(Yk1bv(fTPr zW?Eq(_-V>`wCR#34WgA$8u0tOw_QDzx#Bfw=@kh>hcQL+FGZ>G-Rf+uEyOt3?k6o zpHPNcz`}!}br^!r24lEwMgf9&n+u1F?07X(5|9VvOaXUtK@&6_XV|Qj^CrqEok}(c zX1|VsFhVIS;ljhSbAp%%2T`RbQLYizJ=lWoCmV*ON^jwue19tFq|<4Ytm3obm4Eyw zG3J#4F%#7FUrQo!+047xW`B7Eh)Ku}|M|c#w4*W6E!xZxKFs6DTa#tbRz)m!WN6#~ z-?~ih-z<~+1fEmAr6<7<+3tO|Ufj-}a34oUX}_SFm{O;TG8Xmc+uU&MwIGZ&Q^nOm zIb~0y$1)x_B#ldoDh21@Oq=M|SeR@QV#>qL%fXOZ>f&nO&lFtUyt57DLxpKucAy2+ z1c%g2jn`6pWuk#lulIw00ylZr8^}n8@&2k&SZTYASoIS?y{I^+a@9VtA$X|-9UfMQ ziy}npJkvfg-O;*b+c((L_~SPEzsk&-i@w5{vY@y`yVjJCCJ zi@_ZgMN`)BaMPr%jqbv%>Spi={YlWmyeTbmCsiQxz&KTy?kBm>#lh~mkj-z(C|GSB zsT<9GuwLsV9hpqb($r&V{?ZTIxzhfEA$D zeJ*bT53`A&e}Y<`n0(_JWc1^bFMDygvs}x`DoYCKLP!Zdp>|WJ>YUX|R_bU`eAf@8^9?rMh*3p0!O< zb}Lyk>C_>p6x4=Z?D!S@gc$1w`$5IhrU*oV)MM*VrN=8_X_Gs2EDMS*j(N(nauw#l zZH*hplD5Ke3RQDk2Zm2=mqXp9z^26WwsL4@XN+}IUra?BAcX~j(Sm46I*dA$c37Wt zsMD&Ll*j*XcoEst>FbBb)2n zAju@M2g3ZUhm=6)7X8% zSe&yzbr4kcaB0P{q8)FBWLkRtc)A+1?{$<9kHARWEUo}&@U-J}0+Tt{)Sm~XLsjDU zeoFX)m6-f9ijO8ZCK;TR0<(C@C>WyXo@7R*?ejAG{Z9G}`&TKkvG+r>m>0 z?YlpUDJ|%q_ch?SV7cNvk(_0Y^L+T{66@m)_1R;+7M8NoTl+Sk682)OymG9s2Q&*? zg|DA3Pkqt&_e#i{%ZAbW7P6qz48wd0B{|>9L@&!P9v}W!ty&nJj4Dr*=46Na zf%{W-DA)e>F5VbuRT<((%Yvg~i$3H^6nTlQ#xL%XCLc@L@7n7v#fT$I(pJGyGa*i4 zygfCbF=g2f1WDzIV!qly*HseD4;j@N`Z}9UK_e(AS>txOO;UL(ioWE)r6r{f7Z2w5 zvAi$XR@Vob|Jw2VPb5)BX6FBs=y&}8C;BahCHi-4WSJGUY-njd-M!adc*XAt{I{CNjKe_3`p$bw?SEYNV^fdcAyIVtD;gPBYa# zV@C9&*-Y_yZ;ds|483=)s0=4FH2)EwlWJi?Y-qV`OGkKwDh$2PMpSX>bs&nhLPs!t|`kf9B&1^Y1#3Q2WZtd3n0b3}PEaG~6!=#lAU!X8t2fDA`z5ME~6 zq926MXo(03Gf{O}IqlZT<}yC9;hL8F`kSoCi#6C;0{xnH3z?hOae`}6qCZutkLXA4 zd%NOgZJt3fAem$Fn(T%qUB#n9D~zA-T8T(VQa=%!fc`{)F7co94%(|th4-LRG>Sv+ zC(P?hAbkKtBrh2Vqfl<_goFUd*WrUgA7-tZ_0aDdQ(DEyV^9D-iAW}4>Vo1~x9U|l zrCKLiX!#OA@jJiMRr%_^yPwSXI~ksG*)g%x-mj}d`#1@xLlgpPmwcd?`7Fe}7=zFs z5aBQ#xvCxHAcG*S76@kMWeh}Mr(nblLGJF+p=Fl>fQrTx0Fo6`Y=_cb0f1}^VvIxD zpw2_k;b>*7B4Mmp0b;K8ACBm8b{yb3Irmt*&F2o;yH42&)}c;~=m-eG!t*JJouXZd zg)2s*ZL8nkwjvU&MSGS8uN;j;d{4RbK+XijdW^UDYu0iZGqbAfPp%!yNI{6!u!(Xl z$H$uTX8C&K$d?ew$8Ku+sR5>s`!QZV>4NtOtFQSFNmSn}z3!QVk4BfCeRfy@#^;v) zU1&`vV?Bs9AfpqLGgLU;lTIvHm1^j9tnl-u)bc#C*spE6K@ z0@_+uj5%*wR4_0fdG;pCODNCjSk)x~)t_)7C@HSJhm>E6E!Xv_whbZX& zz7Le$MIcg1zLT7J4@nK0+f=w;Pj};db$8assDcs@b{9nr%7#yHAYbk%cd0{v$}ie}M%_ufHXEAyp6ZyWru;J&qX9FYd@X{$8y)ITK`D+ROHC(A2Hl z>g9#DUs(mtN`HVm^`3Lkvyxc-#*Oc1{lbB^TO1$5uUAF@-YTGzG<@YM4=*nZ4<+3F zV*(Hw+X*k0}h9pDtBp9xa(H!bxdq`%J;>mpse-?O{1~~ zVf7y(NP=mX8daIy8Z0(#!lBgZC(o(k0&Zb=KcXmfkbWS#_QNOmo5L&;={l0|!U%2Q zZ^hV{`M*XUSfBNB?yjwQBiZ-i3r(6d!Qm&5e9~r@Br`zwZ ztkBg$O5!Q5+g<~!4E|!SX@rB}k+5yEobp|(huNx4bHtpJi4aLel|-%Jv#Fe&#H*T{ z6B2hyM5J+Drbrqw$aYqL=Y*m$I#HDyRLkf9jZ2FDcHSw040{+>VWdHYLHwopUls1{np)Bv7=P<9ck%aHeo1)2v;ZPMSq@i~A%UC?v@+(3AMWScU%XZH`?$ z$BjMrexvELj-kLE*hKNS%Y=jQlJgs$O^W|*H=G*r@mc}W6h)#m7Z27#ma2=YYR&Qr zjb^g2^8QW1yyi12#;bfylL0&)lvcl{&1LXr?bT>B(ZaTGkx^I5a6_DATX&`*-8ulZ zz=lmwv%j(7;4kh3b=VZ|=J5!X4#QQ0VGqYc34%}CSspWjEhau_*-+})zl%uNVQ`U< z$*_TP!W{nH%O)xfwrm5Up@v8z!68B^h*4nJNf})hm zSsummUc;B;D0(%%Z`6Qmwjiqq&n)4*`r-RCs>;SUg!&*s)n^65jNm?&8N@oEXd`v= ztI$?hTjxyl$8u+n&fwmp9$#~VOu~ZDXB^c@5i=#u_))GwpPk&LG-(vfZda3jIOUKOasx>zujfUrrocO2ZN*8NDExT!tn>?+kF9rhR3eM3zM%c?* zp0DF!>;#y1s@_3ep{m+DrQQ8?+N#7VG!n;zp3Nfl;bP|i9NA{~cudxJHnu!O`hkX` zD;P{vHE@T^;piF;rn;5Bin4)yFCAi5iEs~rR4h1 zYz%yx@}Giz0h2#%3rZ~OI75jea?<@87NSL68L7KZts6tcXd=kJiV2cDv=mo+a{Xa| z&C5MMgVD(y@&7>nG3Z8{Ynm>3IxMAnFRr{Tt_?E5x+Vhf?kmtVQU8C8ol}z_P_k~z zUAAr8>auOywr$(CZQHihW!tV>=j~3!Jj{RCu`?qxzqJH}<7oniti%NFcR>a@&qVHz z)>yvZyCV;1wT=1f6rOYDhYu#P{vto~Z0SMR25}qjUWWOvGI=i7HPuIDk~HJN{p7^1 zzTne)->$zVS|-E+=?h@j9SKL84O-ZijS;Q=H753>J7N7wqS#|wns&YmwB-6+$+5#I1na4fAH92akXI1!=j`lwG0YD&WYEz87j-cmU?8i8&UbT0wk{`g$xHN%uT`mcZI|AtdyV*QUC!vD8(x+exi8ssYPakgY~ zLJzREe_43!w@Xq}qb^S2uI=;rgcX-Z)z(m9Jk+<-V|d@|I{WSU(w_g)l~@7}jfjd%Sv@4y87YDxQ3w zq4DYXK1Jna&6HNmWRdkP-yr*~cchc$GOC@@>ZVG?*~=d8!ch#+EzxINn&a;N%zG;< zoekR7m8CTn=WMp`+Wv#=Bq>sKw#nMYZEuH9YelTZ=pCEmo_J>xHvwfHk) z8!nqtyG>Id;;ETwG|KqmkiD+mms#1N4UMSo8ZeRX=Bw>TUoGoH*aXN#;odS=AzK}M zC0cRVXZi4~Un7AnRW~u(W-i;if~!N^V;Dv;D3FX}@CZZaPMgPWgn14XFCfBD8d}-oo1$$a42Zpt9`1OZK3C9%dQ(K{IdX%ao zdu=)hUc(4#5KsYY_^}KafOSduLGG^zNKz%B-HUXfol*jXKBdr(aqi94~WmQb@KX{$e#KjG(xn2x3C!Z-IR7UXyj2Q;X zN$wsCI-i>NttP})jm+W(j*(<}=Q*xbR1uSe5zgen5eI`XW?eIhDE3W3hq;>XaJw7} zS`P63>n!vz5zS@0h|YI~C?@eU+rrt#O(c5LLk5GX2n_r_qf}(vUZw(u$u*QqVk(C} zDuH21NQxl~SA(B#fQl|7+(SpK^#V_UMA1F+-xD2HL}Gs>O2UyyNamt_u)j;DAXAsbFhny5w7b0h4RSIQaJinwyai zJhs?9Qy}}+VKkq&4$ki4Mj{EAyms=`I-E%7H6d5FA^l${^;%@Ca*wVm)xjI51rRMn z(5!!C-7*Qluco%5>YEW&0t?o@I@ADS8e@yLeV<@N`h+FKUEctdZ*ops&>$U|3<;_= z`Ggp?<0Y~ND%s10`wi_bHmJ5)PV7iL0vE0G-#0laQDPTHvV4Z0h!Cw=*X zfeq|ky#D;Wx7P(enYcW2Ask^BcYKoMv)`Qj?7+IpA zlmlJ{nL%~)2h{h$^!5e9EEzL=)z})B{mUo*^Le}X6Iqk$zy8br6XJ(~p=!0GeXau|BhQrN2Z2a6tk1@&p7$=V;gB+VVX z&c0v#_Z(epuFLvM-YJR_ ziUGQ&9EQ|i^v@j@A(xBWwh)8Z5R`p27<7^rH$5J)(dj@{n7{KlN>fPjsmnFpr@FI? zK{eN_i&Y;~%?<@(4qAQ8=D{aYBIAyW`~I4o)vG=BcPL&i=pgVR@Q0Wu5ANqH0RLS^ z9M_H6-AN2B{HZTDOPqpX;$RX+og&Ty_Gmg1^eW=7snH(GDMrSxhRW<&sz?ZieiLh3 zEvw_lDGe=x<}i!Gi{5F>jZl*>5e8<*31Y;$S`O5(3ih&X`z}AqVllBhm$rSpPC##wT^twho@|E> zq-ud){~K`Z+sV?6{WjVtemH{Jor|mE4#$@goZ2g(4z!42p=rpmw9Tg$y&4}nq0(6( z1;B=Z5ga5AmXed-U3^7ur|l;uR^!1!cU?XW#}qTOz_2@eSjpPhL3t>N13$Q5&#bfr z=Oof$XAp#UsIu>?uR4>T+d-v<>cV>nBjh}Jp;4AEyT2?+MP$IFpY8OmIIh#Rlk6Kq z4vR_ZFX1ingzp1?8l zC;%p^ej}6vfL!ywi;atAo;HFgGX;ke5PqPsiqG7Jb3fZhex{;gmEt_D3OqD_?bDN; zRqK0xUlk}X(aKtb=90X%n%aZ|(e>=vlPnz|Q1OD`Q&AxyFeHksPc^4ZZ|Z?0avzgC zvR#;%SrvXG>3f?tCsMPUq6daF$7zpPGC%Ckt9Kxewv57I&)qZu9+Mo9?o=;rYv{z* zPsbWRB&3V;9}E!#o0)&cP;^)LfBBz<6dm-4$b*exILv9YnEyFlfq6JX`EG)$uAymH zGDdTjvXwnJf*ImOOUj)uidah_0Ry+Bau6LmVc9wWszEM5KR;ml_Z(Ku-NOH=2kAxG^@XQT9i z`f<~RGfc8AQufm!{3|k#A1O;b|AN+VOhDe5kefPN5QINa<6P+VZHPJn8hJyeIG1^5 zOzb93N8o?5!$M(jDz}Qi$5V+cnGAC+@CIl27gzMEX8Htyeb0Q=*4ehnubs<`*K3$2 z?yf4$u7}hfxr=Fk9iv+T*y@|OPQyuOu%A={gSlvOSuCH{h=WV}=7m%w{koz*d(D<3 z_}*Y{i@_GRq*%|-sOo)Qg88A3T$gPPn0#@%{>I-f4=egwWc8iw=`>`;2gmTArh*Fu z$eXmV2U~grhG8yiP4`=wHo#=r&y>R=s%n|i3`Ab$;42FxWD;05)8)Lq(q_Bi;?rHM zsnH#(*YI=WKu^7l?ny?4%{EY>?pP3k;uS44ca01GfrA(%>TQxB#7Mf*N^We&_L{56 zV0E`|lhu}8;Bjd!r#@Kc2M%iM|IAf2(_!h#p_Iq8)lhB z^|_X22qn*x8tb)T6X>?o(cmq$A9uv)Fgi$2k<>Fs_;C>$nZ98H^w&R ziO4h&0M*Mn3E1csH1+Xfp+)B)r?EGefy}Bp8x5I)dqX9vTkf-L|JdKMc8Npjvc!OX z?u$5yd8-mnY{dc`l@38=R#YKWAWF*gDAjFuiX|GBL!am%@Qtt&vaix5{TnYcQ(d z2d6I!(-Ve`E02JR!yT2POe8JJE7y9n3f zX1~FB7dYp}a_Iw`g6;%IVsU#BqL3#b8`&o{wkNsNk1y35kAI%nmDMViL(+dQtMZ}{ z%UEco`3a`7{RlFWxW`5==#KV0cr7adYRMnD* z3=&)n0^Mui%76j?!@MZ~L}y?U{Z3}Je=rdI>LqnVk#*~Q_FpEH2G;<*_K~~d#w)(xJDNT(r@}zq zIwW;~ypIbB6zqCeaVkcriN?*P9U`-JZFYKgcEfR0(XvkJudgD@etwJrKkASnzH=LK z8JY+3_vS55=HrDpOk(V$F{YT_!P|rOxphml>I)84`#=k5^+msdDa6SLYR~%phRE|O&K2}Ec+m=+0D5Cg< z7Wup!O1L(3)+V1ESOu@)+Yk4(eA;0Uq}1tLMEt_95HHdWPHJKaXBytV?<_(TCnze@cUluW8}&reQLT9kuCNRC?b{HqdOu~ z6jBd+_@}=sl6@Ts8G>oSgv3|f_S57ZQ;lPJ*=}W}H6{>HZ2;Vp5S`tFi^j_*u`y8I zR_molhpgB8g%0a)K;3^U4b1-&v4Vk(;Xl;k|KFtO_d1zx=$=x+d$Pr8jowMk^0Ih5 z&|tBiUekfZUE1&a6(<6jrab8adDD-8ziMu2uifW_D~d;ic;Hr$P<#(fw9@L00afwdBi?T2;KjQ7!Mm|d^Bd8gP;NpY z&hnXxqGMUrHVh$}^w_ws1Ksls04z7-PNq!tVqPdrlz+-1;1Q|3nt1!0O| zC$sVFoYtgzUksRFx2?J|K2m{m28CnP!BgGfWYOOhE$K6bM&Re9csbrCb4ABHBh^#H z`}Y1WT`xoibq>LjbgcB9X}!#@H);ECixxniyN*;OM1!eE3BT5PPIK~5eJ zyTw(m;B+GuoFcm}sd$Ma&X+0(+jT4LO=OKX9&yv4|;5Vyr)A4Y61xI z6!@9jq5Lmh6avWi*9j3Qt|kyIb~ZJW0xK?op7y2*nLwKuX%2sL&c|5bV$hOM%UEQ2 z7iC)k?O>hAuA4e4-mXyK$RG&m9{%pz8Hj;yDf(!VLIlrY9Y&qnLCrx0{>;ytS7_D48K{3o7FZhqG;T`pAQP+pOa$mELnoW#Sk(Ng4`1^f7uF8q%26v z>9n*u=nWR7?Lu#@ixM~Thn9-WUHLhh`txqJU@oxWZ%Mib;-?%bkS4&*)&=OLwZqZu zX;3SCHYa#H6jqtbIR=V}E=PwOK8ElB(PRv~Oui>rW*TO>2Y6dL&`={{?4D!{Dob2}`L3InEgNKU3?X$R+?1kuq_xuv;l z#8*iz`DFeZjk)JdP7n|eIEjwS)7vsG_}pSY5Qc-lbiWf8lL6G-ywUHnOl55+a`&7& zO=S1dO+#&gXM3OtkZME=zQ`d<|=m`9&OAKN-)YOL!WC4l4 zvKv=bEYo*(^ceioBj_ZN3ts&G?^Vv*)qvo(&TS2#0od22k=8qBakY9jPzAwya?E6S z>YyI$d~4_h=CW&5%A=mSh~-)RXnm^rOX#|Yv_XKZTY#INQ$!pS_Ml95Io9OWk)i9x`7mBMrIvcBk~IX#zKaUju}G7jrpY4jGB;tr=Gjk zU5j88N>q2XC@dukc0HZMe9EnYnNai7i-emSJ{;}*q!OwjP0jk%f1}O4G)T>x4?pm zAw4%GQvQRA$FKJ%>4u~~22-E!+K6i9VzEhdS7CToA;$~hFJU#Vm|)GU=DDybz964} zhU6Gf#tz#N6u4c3Kn&soBz_*j$7j;T$gqP99My=A!C6c?gmKXyEGWOOIOpu)^mv+ttYv)d zugvPRZJ~Urys=fW{g;R`BNvb2=Iq!y;1EnfnWnXE#Y@77b}`H5tBW8Zm!r65z0>n? zduMx*q>xeOae@2&zQ=pL7i!XLYw<9Z;H$LV-~CmuUMfU-RJZz+aVTzE-s2q$(+KT` zwPL=T&;TSpMO};MtlF}iUz_p%OLeVD?^~xF=0Hr^_}%$`&8=i>hhby|_OAjNFJy}@ z=YZs9tK(Xcz?QY$W<0TpAPw2F2M*;ttMD}S`?k4C}<;6-qhy5NFE?5yFjE^n~wy;=4u)qzyc|AEFk(c#-7j{e%e3=A5IT-@&ijQ(Q>LLpi}ZEEKsy1S(Wq^ zj}*NABj+MLw!M$? zM;oPNV0+4u%9BSp7SShXragCK`rpFyLJ{CUXs;;OlTbp&YkmddeiJ~(N@?^0j7Tm= zva%MwYiBl708XT!f?0<=Fl|-!;w~F{?E1HD;+zj-dw_Kco?DRgCw*3pth}_=dPD4) z>mG?-=9N5`PD4Fs&Z~pI-~>Md-cC7E#}sZrf7ZgcA*IM8YhkuX$+<^2>LzbIKXjx} z^Z`c87(gx2)Ic7i%b@K<(Q$|bvi)?kN5J2tr-I<2Y&3=y*#-pOQF2q3e%^k6(cN+W z?F)1~YQ~|WTO%Le^3tI$Gur|OexbY11hq#L1MMZ_G6f#*Ujt>{R1btO=n4G6FP`$2 zk~OTc$bcUp=M~R6iK3d#{soMUMJ3~%t$$1m0t|t;{-oBz@w2mq1B`Ln{r)Vs!YXsN z9w7TqA5eVSy*OZJKme;abaQE`N00{iRD7;@JoY7r!E>&5^&2*g39$h+dJoVtFX%!A zi+H4WJx8Tsrt zB9T0P3R>zAB=U8J3my?rkKo}CiHHQ$SXI(c9v*yJBgKkt(jp7zcHKqc0wghncXiuC z9pE(5sb>ktx3;Hkr(i^4kKw`BOV9jKWyG54U50R{)BAG(0un$9R>GogP9V8Gu5~(wKhf#Dj1XH&xoN zcJFgY39Q}Vklu;)lbC60%%5;*ZEaW{PD>>w?g>%3)BBOiW_k}(%$(L2*=fbwMBW=rd7`kzu*L(Zab}4QMEKxzT(=sz1FEc0iWckjxqa^h|WaR5FWm zbL5FR7Xe1J?yR@TT zADcDr(yo%sI`tqcXeP?BCzDze#`cXp`rO9t)#v1ft)?9a0qOSckv@ylom11w$VU*C z3vlA^9=aG9yfycOGzNeI^ne~pU{uFu9U;0G7wU_RtQFjj)z?|>I)hfteQ$`}(Qrk5 zpktwGP6XF;iNp$YblAb@A-%X=#SYO#0!6`x~6KxPostta!j z7M6R=Sh=r1rmeLE{U9ijc2^;&FFMY)pcQt7n0-5P0J7pOR53iV@}~d|NKRIwAwrgb z@TCM>A>s{Z4VD{hDlZ~yWV$>hUh=zm>foAe+03vtc07roL6^b1^_w$h1wQN_@R`~! zeF8%Q+y#IVB+mv*Y|Pj3Ga5iM85r-zKS8u#Ebz407S`LV&xpu7XJnpAZVj-Qo&J;g z9Qphss#6{f*eHi*G%ri-6_Vm?Sz}uZ>nAl^UB+A66iBB`@T;t!Ygmo0UNu2Wmd4B|=2@)pn! zOM6+Tdv?&KNpC1JEOFqsfC~B#)(`|bN|sH15?JY99(cmz;x6O~aPAS5HC_eP*O?x@ z8LNH_GD11I*LVw=k_FA_9UGp2+y+7_{vQ$B*Y4)-F2Is2p4}3qA*Anz3s5$4S}^A~ zE_->_{v|&x&|nB5rl4S;YWk!((WFtE1oKz=_w&o~Fjre@y8FMVKRhl6S~>!X zAa$dtcsT6=^H{Ij;h^qds6nzEV1|^nP^ukOhRtAmpJw{~)By}%O!NXXG14IL0T@{xOWJNshe zlp$GK%@3*aX<(B|9o6H;+>b|a8MxDR%v`}~dtvnU(6Qcq*nKIr0nk?V=Lv77z$qhA zfyT?Z%JgNCij3so_n6uzY^bCD3Ek`&d3x)Q16N!_#1RJ^=+n|ds0e7^`HS)~IMdwP z%9K{xcK5t2AVQo?(M2^((q(E}hgwH_z04YXcQ70h^i1Hp?E z65Rp>*x^7)p!^2n8_CV8o&7(LJw?xIDvz7e67Y=T21!|mA3y6AuIK_Vb%I!2-6g`@ z!iGJ(*I*$E!UBkms3{>;Uki>E9GfRzAW}ac7t+sk}dn{Vw9+?T#gb7Q{bep zP-E88Ywk2m+YlneJQqhwpR)hUbOMUXa$D%`1?u6F;a!SDQm3m*Av;|sMmjy2<)qIz zo|lL!*s3jr*+cW5kSSGjhmBWB+`>aW7*H+c(uZe%-Y{S;SwVj+v@wYQC5b#mYryp_4iNIBKQwykd|F~;>a19mI3_oE_$pDR0 zA9*&%W-KQj)rGD8Y8X_!m@9Qmh4NFQaOapgQ6$X7xcnD~u&0%&R3NTQ zKLig3M`U|`-@)SUh8Eg+TY;&ao=}-9F@uyh-{GDOnuoyaW3WamRXfV{r_wkYO+vPb z*@Z)uFsDCweTlymac#zk7Ax*&R=1u=uyTqyo-D6BNj2Y`fJp6E|B>euqbMuOvyMLSa<=FXQG}Qk>aSO*=fsUwtI`D2m}p?)EMp7oM;H z3dAtg#V#X;v)};$Ss$)EdThC@PKkZI9pV_DvaG}Q4+q=Fp}FfJq{Nbp9qpUeWjk^* zjQMP?M>p{@PtOP2|5&4#5=yXL4lXk*ERSsYR{{b{uu zm`NfWJ3nVD{*6x0<%aNFXSQ8zR`@(_rnrzMfX7`>Q)(o>lst&6KiQ|i=NJ9eraw!` zzy9c&j@)VbR^s4QHXBIhT{N!;H53BzurfwWuP&1Jfj%olj@S68w*6g+Ah5$7rn{^* ziOxwAL!6rMaxSWwr@^{KJ z+Upm`X*r>+cGj_vfS)Ycvi$)bhf;s?a!?TDKO{ymOkR4M&lsf5AnMPsQo1R2#30Lx zHgD$2{Utr3G%6nrx0BpApb@MhcMeBlU~S)`adSSgH1Mb)CU4o%D&-;ixF0#w;X8l0 z_yJLAceN!5T?kL8e`sB|_1B+yu$_A$AS?TneILxKRf=QiE2j1AyYiO?waViN1@64M!HOQ^zEyOyDT`W8^eLl-2>JUngh?e6nJHnh)0am2q6z~q0GjRPjCFm~6ZmQnOl{afaY{E2gs!@>2e z^w_yw!5tvfmwd}dFAB0~c?19+5>syx>(_PFCkHYU@1+EpS%lC=2l?yF&cBgyIW`17_O^F>*)%PSn||&f#F}AIP?Tc| zNi1Bqkq38Y*_Cu|uYNtK<9_On-pLykIzyz~2*p4dd}(Rb09zW-V}7tWcV+mnMC1y- z3q zK`Dz#HcXR!qj{R)5Viu;36OKJGG1>#CY78NMQ-3M{Z;JL*7-m_K%nWhpxVDhjLO>R zdkbr~!~*CyY>RQO`Zm~)A3Q_*1W=}#Gjq5woD2&Yf|OaRl7&-WPe(ci9-|OL$T}V*Tf|pUoln&Er{{~UgydgENwEf}VK2QZ&-xg;gGQ?UW;0M=p<`}w1 zDf@cIO_$4+clWS5C|3SJFK82E7T`Pfl=+rj^bxAi9h|_6*z!oL?=-c3^yxQWsWluP z2U&Tl-*raU1)hFvNGpXj-tE0H^X4)e?~ZbaVmSe>79>2d!IAf*NE+v}!Dh50yj zsF1up$!ByBbUjGYPBhj>_7=9X@ADg)Gb2v_BJ+eo^>ZAkpK_>p9qCI?X&%uq>v`Ff z!~2O)Hnae2P51@O(762sRX1B$NT&A3!71~$l`dG)_+PZD4H8bVs|EEVq85h=zfwng zF5cJju(vZ7rQuqi{E4CKNV_~pH(m~SxoSr2Sub^QzYAtiH(E)~q5bo-W|z(3<0XKo;) zRhj25R9fiV3!Jto=4pl1KeIO_I;$i5RtPZ=mCzEBXj}C5N&mx*S0wO^A@J#Y17s^e zDUdn$eB?GG*keC*-I5_{9W!e<)70YlVuAYQ$Swt4_8c^NKp-XU_B#J@ZJ@@)N|j-Y zvm$3~-!@6Q=53NZOs+5FV1^hWTr2rN&po32fN3ph{J7CXBeYfgzzkuw#?z_XGtBsT zkim7!0w3KmwaM7hy<&~ncy>m=_3>@<5PS0t)#S;0`(OK(|Bd9sO#dIb_H1=&$AdP6 z?i1BAuL4pk=pG0u8*!Hk)>I|RnrZ#+Uy6^l3bBHq0@K0Q(QbF*Gyg zc5SC_U?v?_Oa5)FwFB(WnThYl=am$skDmg4H!#uhEYi#f$=OXUQ(;Y%*wOpdLlb+9)F6nXl&`L4 zLaLZl#F&K1OCKt=XO9rHl;m6lA=ZBTBD)T`hj`}nbN<8S>{ENtUxu#HU z<=7aOcq{gN!YMdZn)9VM4s3}!`o;0U^(`aqe>N!76V?0b_7c|hhD(UnpxkDJO>X}% zCR(gFes`q%jv{S``tNWQ{uySseOsh#LYRUME+}UJe<~Fk++_ev18?XrAn@ehZM*;9z#uDWsJ>v-LK z^5JqJcwRIMwA6*p+)2Ie(Qkva44^dLAb6U&>PXP(k#0Co^2E73Gf!#3u`VqgaCO#L zn{yRq^qj5r05CJ4Q-aDp(cj{x(ShyarM|Py0q%A&R`BA&8*q<5<%~w-(P{!Rs(eyq$Gq z#zLCLk~`AdNR9xUxWu=9s5`wivk~Gg(@^_rB{c-}mLoZL#vm1tME;Z_(}Z+3t@m)? zN|Gz8#BlmAO$W0 zZdrx^f18&fcGzdok(L66HH8(R+Od9c-2POt($}dPg$F9iL{fBVijEqO8qs`CHeRxk z`!S8~5^2xAvV*!YW1b?I)3DS6AKEYET!_6rIUbZ$!y8kaiJH(f0Yw*|!*cVluD&pP zXs`Qvhap16>?~gA{H2IB4*qnYSRmol=Ggjv~%G696nR*!Tc$5_NLO{R{On z3L}gIQ^<|*S`=Th0fnq&)Y)iBr zkTknN-Qc6aaRg(=yK=cW;6XpVJr?Ef8I4GKv4nrOy3RIKSMKJW7;v8$Kzh?$^x5!@!ga0))3?87Jx!b}<*?hAdDI1S;wMQxSTlO_^3Q(eJyj|+oA);vBk%8_sH6D{ z0Y^t3|C-xGsISZ23E0IPzjIGh%E!4sW4mky%uRmt8k+)hI3!ilYQjPj#M_lx}paA^Jnk)*P`IN?Kpfr|fS#d9=^FPlyR*<;N6}ig*DCXcBdG*TQT#(xF_1 zsdv)3t$s;)Ca&5@^N75cLzK$JbUf{ZQLqWJ!#ix~;)MYD(J<%jFk0IWj&pgCXm&fc zXCKrh?C~ZZxlac#K)mEmcZ`x#*rjef?eiXEJ<4B_0Q)tzF1xa$uqdgwqvpV1Ee`#I ze6AeMV{E6=cJUL}*yE0|s_H#ig;TJ+R&5Bx!LMA~2iN*oEpM;tvb zx_0}iOShsErG3w|g;03WqCMzzQhVCexp>!Gtg}yc zDK(e9Ai7%b{MEzka*2zxf`9@N6YJ>=Ii9`i+FmL=!&CEfqD#M?9j(|K1opM((T{20 z?|ZHWLQUlV+OGXi7^2_x-hbTZ4y#K#Zi@WhdXMi+s3M5r`0v5xu>B=XDI%A;rECct zJcN8%96)ravGrA~>?{<>At1?>4F!p^J~*_8M@MfhUf`i*KqB9|Mkr(1fL znIsO#Oh9R9d~Ox_uN=w$zb~?(n9>Opix1$tN5T;Q8<1|EP*i^*~F!MdB4Nv z*}YYYLm$d>FS7BWB{2EHByq*t^|aH`wYS1{TTe4}c?G6(L)+2Syb}yJyE^4~mh$eH z@hySA2&H7)dZ0)kA^=v2pdj(<4y>NdWqkC|)wCu2Is@OoSo!bZK*hI%qH3`2;jkvd zI>kX4Q%+GD{#7X)6PW|VSTUhELjIQc*V*6)n~O;V$pGYFGT~IcH{@|x%_zcwKF4>` z(ae^Dovx`x!;*!w3xKA_tQtN#Fy8iXVCM!Q_oYqWtF;}pnBCyddNzZo1z?U|p2LXT zNSVEHTk&=_hps~ad;Ew7qWQjl8%52>#MKk0?nibtD$3eC+~fuQd*|vuZLzd~!H0+O zhh-r>PWKQTxj%I|_ZNwJkI%~&lj_LTsM?9Okq0(-_3w#t%?%eH;|z9Rw}G0Ufvsm9 z*O@JC;N+A&qZ(JH8qV8$iDA^p&4{N1r& z9rJRrC|0uUoI~GqECB(5BF&LLW3cH<5x8ihfe=AnG!?`jI*vaw$NUJ2n??Uf zf(Ceh#6pH`d8-cz>Is|DkVZ_J??rTbLCg<|2(inB(l);DxsGrd^CwOLF3)x|pJ1uD zCA`F?op=O0&Y{>WBdjT5Vq58x1b6kZxiD3}J~u^x2Zf$-^|9xProk|n8}9h>ns)U@ zSd8a`FYc$7fgz3t7b zs)kJ=`5vXRfzqZZxT3iiDCk`iU9+kTO2`lZ613@a?d55xEK>r03TesRzJSFNtqto= zOTXe2KBwxagObq?2@}SmdZ>l**Kanc7)_u|F(-A$flxOJv9Tv{3Ae3&*u%SnC3|wD z2`*D*r&vQzt1BtL^aOU|M0dxjaqqS|k8WUdu3+8b6TWzKSnFFt5 zcS6VXH=`!TQJOtbza%oz7MGxG7b?^qd+dOl)oxTjux`_LfsROPi(caq=&ITwzGu! z5lY@6=4Hol+Blj`#d3uuBTk7UIPJVkb3Ku3t>8>C!YwUOw&DS4ld!HN7jZRdM?aVc zHf1TYa-X?XbTyv(jop$W-yg@_*y5ni4r=*X3`JkZz8zkD2y7>44srZ!$B>Z+;Lp?T zsf7aU5g{K`2>lxEG0>mS9Hyq&6U1ktzC}kWTZMSb4M2f5 z`XkymPz!z}Hxw-lpZsF$yt(jh?wqQi0p7y(7uSbf4w8Zy1CwY}8`I#)bJ;F7BX)D%f%Bu5C-Tre+&-?iV2MPitU~jSJkmNA2;K-4 zR6jN$)`Z0+HWZH$sik3wS4az{^{LdYfzMaAPWlBW!N5s9=b1-~kA+zc6a~nP-013o z3c}Ktn-4C>g-JbGnH!!G$td|N7c}DzZ{&drfs%6RAsH+gk(6*d0SJJDvZH}wzaEdr z7kp~ZZ>>^C>u=@7YEf(|Q-Ve;Iv4@O)EgB;h8B8qQ)mE!ZbaS__{S{(MnTq|`L-t= z)_)qZg%D{P!~n72J^D>v5S@mAR@@k9+eX=S&_W#OvFc>Zq zMM*M&5{oPvhi%|H$rQM{e_z6AxV6lhCCZm()GAwLB-gHX9pk~FU z1B#*ialQsm@XuACcG*E`LUsT#7Gfe~j<4Cm7^pn{7krpM!WerK)WFs)}{F{O>$Mee_(%spNXwCgt&3sCG4z4Y1O;KHY=NmUd zAJ`7>{yr__zo=U)@t{@%nZ6Qvr}lP>GhZ*%MV_SiDv)`CuM@&}6ob5{ev^*hOa0iF zB+}wfv02L25 zdDp_*-sh#Jk!?#l9AaARgAgHhW8L4E@^B#RWdA99vHy1jGA_>l^;PymYlvI_p*1|K zVYQ0tszkq_6!D=+&VflP651F&Bu)y^ICP5IjHVn|<39|$y(E$`9J&OeX$&N@;!Szq zAMIU(>yq9eGJpki8!Osk*8Gmbv>OGXpp#WX&2U<-!s#pXb z_nw4~E>}mH6&R{b2*XluZQ< zj*)X4`+4cd)#WASB zjRp@O6G|)6;p-dQn7XM`V@e!yrTK^YEK{ZH9jX6Vi)q-;qPXe;tGKYP6gVDxa}jhW zk%z(b|3W!gyW&vYa#1~!Cwfrf;^U3NVUdbNyN7Rgx+6AbOOWlXS}$T6QNEuw+~3oi zQ&A&@lsf2^$^MON1X8qruF~AL;%P-(`z5R;vBKu{h_n2Zy$ZGX|{kB1P;yP)-9%yzaW^?kE$^_<^ zgiw`5%dqZ|V-{Ln_(%Ib<#98TG-)n%Hixe&aj2MAzRE_l9n`tJ_0azodKDm7>x6BegEF>VH;?zleY9}~o zt_Hn?_)WSY5i-jvtFWr^mPo$q{L*c)b$iX&R40sPyyw_vQw#{Dc2Su-DE!1$4>!-1 zx6P+4V}l2{O`#SPe^2DRFaX{ZK6GFv#he9<^K>XW?q%S~-rgTbWC+=P25E^s-q{ol z^#yQcgBgETTXu0K^r%TfZfXQX0sV{F*8^?`x%G)H6|oC(Sh7OW=!Y$#B|Y&v7kMD7 zpSo5io6PL{7po7V$>qmnClM`NmtCyT+og!e3VSv-eD@pU-?(Tq`SZ$Se<$}F{7?3Z za9R4hD9_2sji8 zDzQvL6Pbm$CG0R_wNY>zNho8$6CCBvU8a;BgdZ*tConNwTjRR}sl~3)`Np~f zsiX+{_z*oXAL3iY)#7d|C@4%)Fqnysl2UU)y<9VeKMh4S1*pV4g2v@;vrSIURhJOh zx_Hc2M8w#o3SL4?Cmel$H3qN3JC3hEU+Z;#^hcz~A?-s&0$&i%AZzjARiM5?*99>V z%Xv;KSOqsw9dMAF4Y5NG`k;zX|6uajI`19_6o16SOb`Yu&?UpQ(dh6y2BaM4`p=Bxx)kUJUE~mCmD-%F`_OQU@n2#ZTZGreMr$UD{pB9B_9FESnlRBIwuU zc2P>XH#sW;8R}bGOb%Yd3mH}wE9w0@Or5rbi){%=xoXl_o)hRO6NvLP6kfx3o}k!^ zZ*z84v}7tBN^70n<<;E-&E!hK*MjvQm7hw<2++Q%@KBT3-O2FL%;l?Y4qQ9P%-E8t zGtwHlCWHBsIfz7)V>~JZx!nc3gJmxQM|L;Z+}byI)^4cIUfgZao^!P`U`(!}C7@xa z7nA8W1R4iAsHvddIXUWPv_)?h+}fVj=9}(^%r1d)k*!?p zy*p62SG$Pk7U#v)PuD+G7F+TFzJ3dX&F||yWCgdlp@X^ zuFo125;g>JiM`sNo|`SlPxYiDQW@hh-geLdQS_axHYFgZ`!IFppOoB>?(l~Xlrmpi zZSVgkvZW1a@JUe-x)(ycRD8pl`AT9rtyUkOfp*7gG&3pMmj3-zO6Jj^`SI27H>8!F z_aCFce+SfK{C{fFYBo{(>_|WU3xg&FYxUCy`g6*V^DSEouB$cj%d|;f#-@5EPFG8w zWdPpuI*mrXm0gOgW{dD>{qKX>iIa>BGxAwG&4(#QL_vl-hOG6I0WY%3|VizG$r?51yK6X;6*`8@x*T73_U$y%u^r#?t}MR%A)3Q zZubo7r<5eIA_xnno@G%~#t6-bL6Xwz?AWZ{?e2^s;8ML6YzPBkj4(r<9Q>2^TCQo~ zCc^r6ZYx4aDq`EbUYQU2!y$M)>co^7A;3`pp>Z0LBtp~qqFAxn~p%MaeqHCWC z5D)+qBN)G_jNQ?)A=!-83De6Ju|h9EDko&iSYd&gR7?6B6l9oG!1N%d#nu$Y@>*JD zAjt~$_^~1CmfObH@AQfCK;+~gKg>1>*4v!^tzI{3vEl}ou_sgz1PKYDpvcg7LxyFS z_zkWiizDH|aUFe6e`r925`#ymC!byttbQp>!Z-*?FT?{Uz}l`2bf~hg!`SOu4S%*oKPdei z7ybg9H|cBr_H4`wlkvE4MWhGHxQ(m1BI4Xy^D)6i1 zTtNU?0qPXowO0u%GZ2+?DTEz-!cqt9$3Q3Bp5^kgFJ8p9MGw17@es$hegBrPq=;|(1=XxIuO}`sY zgt?JLeeON~S-03q@0{bMV|sSVFdA2cTTn4pz?kM{B9AKi@v}KyW+T&_WEq~NOYicl z*~IBW@C&b?WQb*eUNs{RTV*6U+Kj=&5Jr_;L+Rg0UetTVpPNTH$alN|u(I(rl;6sf zQ-{zTFQeGJIZ}dIS?O&}Q5lHGwQRe~t!h=(^}3i>Cfm_j8QT^J{Rh?S)~?0d8uiUJ z4Zqu~3d{ZpC_+lmkinH33$2c07s5g;EYxT39ZujdubDil4ZII{9=V2Kd&VZ89+ModyFAQe`hkpqr+NR!^W(n)zcDj0{jZir z%+FI|e+c;p{021=qDi}c!C{f-8jU51M1t!Tk4H2*A>p!oUQuKEI2>66^D?aVyXV{RA77QNt=jen;qMN8RmI!I%gZbl7uMQVnF4d0|o3`Yt%21Qs zSl5l2j0V?zA?-U~Jk3-(S-3n+yYkLcQc2Z=04~U&`;*H|rG%Ec0XOO_yp5A2kxCkV z^2FO6Arj5Bl_1UjN8*Wz+s`G++r2_Yflx*b_cJvilYliHmN`vXSP>^cX5Fd1OL+-9 zp38K=qq2b9mlD1n^?w)mau8ALDfKf9N0`AoZ>&VEtEXN6*!XP%1oN1jyV^dGCR5U`riBTfH#-rQR za_O(9Uy`4oS;_!Y{O{q{x2X)}`WUwL|u(dhDySI*5)zz($)1uOV6!vz%0sC~d|SqZ4iFQRJc-xJg^ z^Zqzo|IX%dEzygf)@SAOVT-^w8ZU{!ns!Yuw<{Y8x@ByZU&7?WJPT(LbVD)nFf|2W zy1U)z*#M)MTnsc&G_AGLm&76vL1WfVvMeustm~BymBdl-6VPD#Wyv58@eJU=z4Ef1 zR_%OvNPUMyAGCCI?rU?50=onEt%EA=2xd~ln(Sr!_HjIw2oVM_|1+ z%=o1FW>5o1ane3Amk$=V7)gxtMc;78&nXPu1EH!;CvnsrT5cF&`a zM(MyMeyPhrK;vWk%s%s3mP^wS@i^B9Q{FHLV2KKI#^OIVy5Bk0PxI$qn62Xh!F;>H zfHqj;Eszzb7D}WhxG2xrFhdbtrfwWOsXIhYvvRw9sZx`srzJ|KJ_Jz=4sk}fHJd{9_>z`T0iPAk&*5fbB5E5u-4P@lCLgxdkg@x+v^a?(8kQQNr2zYJ%$W+yPenxCXdca;y(8ej(I zSfyBbiGaa}%>84?XX`B%gZa_w!d*;C^DpA@wVk2vz1S-B?PUv}2BXeT;GqQba250y zp-Gg?eKfA?B$b~e2!dL63QLnGbydKx>R$Z;T~~{Z*~C$5Jn!om1p_G>qfG$fJI=WHQX--R+DVJTGv~CW_y$?Fli?KrjjQtEySJ64y|>^uZM{m>44eJT=y4re{XL zw39PuK9jYVPK0(f{PY%$2(O~J%ROf;E1+NS3B(uGUAA?|0uY-7Q55(T z$B}}U^cLzj7Xk5MI1lX@Ca=0}KcCido$=iJ)E&ip6w%qTHsX&b$nk^%HPIIVrJK=Xm08LY`N(VqE8LkKmRVTn z4%XMID@Rczm6vl5@dZJ<;yELGCz0g`8!b~mo~d`DGgS|5@2#7%UmEZuT%Enw2@9lQ z@s=xaTB^>8iNPqHn&AvK7QrgMV4!LQPIq!gShgvUsOl zx=hfxI@$k@S)5sI7eiAhY?5Xl?^TCLD$VsE53wD=UGoCM>|5IQ|u;&EFh4 z92Lnb9aA!JYqBmS&jRXc%&o`f%p!^)%ner5-D4JC5OriPfi|0;ebbkF=7(VF-;zWA zUB4`eYO~QrmcCX^GRCfdX>L>Mb~&Fm(A57F9vCxQcNdErFVh(>mHzzULBqP=#E-h~ zQ26uRN?U<_H|%;0cXu~QPdIy2;`Op`ocoICx)bI8zJ7VO?e~g$#0?GeA9KimMFM1I`~SwtN$dYNhtxVk zw~)mihx7_^QzfLVsSxuVPD-7FV)P`|O6i08(~Q2}pXTNQ1H@4tqm=}5vH)%)q=9b<|v)dI{0pim+al4gUn2dztL3n*uJXlKDKpEQ+@CG0n#?`No5*LQz7dI1yyHV z*1PrqiC69;Mdjy9ZVbhSVIh1zQ=62{%ke2Y4pop+!2#2M*zDdRcNACd6vI9Z+Z!(Fnecw@Y^ zvipRj#~M$fc~Q?kF4Qz7k8pE}w+$C7-_75MK+Kh{xHh zR@{%}&!%U3X)1I~zQQwY$-JC1uO-DWTupltfd*R}wd|$+hkLDwdV?2$&+N8?=_#_| zVCCwYRZd?%T+V4Ix$Cv$5p&eZ5yqG)1&EvcsU7qEB7z6O&moq*Ai^W=bhu(WR=uHB zxk)5S8F4008F?60F;r(h!OCtUXX=@6vT=nfM_|T(4>OWyDUTicRf@qT4&)kXZ8JWd!Q`qO(zDjcz*;4TC45_l!9J ztvZZs)Gi$a#RkDR*Q4Zk&*CTTitmsV_yMGi?%Cf&4g7qfm!s_T%u`V~|5`#)Vgtqk zmZ)~Or95Yj1{d0lXo?fjQ%$IRrTGqL;5wB(Ja0#2nH8c;1sp593qqkXQ&n@)sC_-q z**O!w>-Lu7fr(>;4Y$dSs(%K&a=8knl0*$5QgDhqFW|1HP8mgaA}KBWW~0lM3pG7 zO5F>D!nL9--Asa-)TuEkw8zRk2R|q+33k(YOl-);$`q$tPg@c2hwyQyzY8#mG!oI; ze+e;QBg<-cAl8`1ku$fqQrY^9ZihLNFeu-XCni!3z#`@u;7v&3WD$p zZV@kCprw;<-c_QF@3J45J@RL1$y^Y9(%_SVvCe?AGTp`ZcMP&heiaw-LAoX2f}J(C zmc1l3Kd0X~U}Ky#G|krGt4CK9YN|({*22IgsKDePT91dccw3zaq8uhv3)V(U_C9`f zP+{8DMvu|a(~xRfBQN>Gt^T0G8_($=M7YWRaaBgiCY#C>JG~y*e3&PmSigO`?wf$K2jqG<8{d(K)68tG zUF`QcjIXNUlqZeLU1Pv9+p^Z-l#&pr`Iibp6eny#MSH;PD@-p3FBJ5AKXR?5DXYEJ zA)D1i6!KuIvi^mb3$A_c)95i69I}!`V4+OzsjKP>{ZRh^&%rI)z- zh$}e|U*H!Qxi7z&{XrOx!#pD8-7MGc0^3q41{EN(dhMMc9|rMM;GZ?BE?)=(yE@MF z#|VSs=s6<8ZDEA?HPnCA+ii~c^8wM%1Q(rOeZjF-|B&?Jn^}KA8JUCv*(vusMO^!v z`}8Y&SY2qAFASBi$BM4^ip#{Zipj&xL+h2f@(&X=(MFsu ziZ=Va*5K}IZE`%?q{4pJK+Po*JW2Oc;AWUenu1u)OyzmNA5(g0^hJg)Dp>1N3@emq3UldEjtI=|5Mz)|A~*5!S=gE@?4 zwyT-6_1X^^d}YWMh{P~Ayvf`*x}6*p5`-&Fp%Q*uAy8G>7?N$hS;Z{$MKc`SHVt%f zq^fZFPU`dyQGgP{Ta?*oP_hUr^bcXoDIIbj4R!^1(aH~$I;5>2ErvP7@k3S80(#%9 z=%-j$iw{!bve@LxG1d^@TO`+8)s&JKAkd^UUAo{}IhO*DXafo};i9bQ@z$P`k8Yu8h7}|Ht%d>aIS0G96HD|A0D6`XDMjjpuSlHl5;Q8~ZH> z+`Z{C`L*(1^V8VB?6%bY()^2NkNG;GWylY4CSXy+6QRtKiiHQ+=Uiqh-2-RwX8kWW zGr2o?<#V{gLYI488EB7&Z;!}-b|v7HMEh{J_kf)pptrv+(kqNqK+h8%lDY( zjI`>!oA4fpu%Jpj0AUcrabBHC%A0PXx-c-fYMMJeoFutK4p# zA(NFm=B-D*(k`GhfuJq$Z=Bowc(sZK@7KHf8QY2t+7WZ6^l%9cL?+d+_@N!r&>^Z& zNvY5hZQ8eR^1ycNsy`BRh-t#GoB$%7K{YeT;5h9D4^~>*M%X{LJBAIeEq{)c`Syg> zhK|G>e1Gm$TPe1cla1o85>r1QF7k?{N49;K7~s6Ed{;oN%|~f4bqno>s58{L(Q*Mw zIfN@i%Ea2fJ?C2!h(%^VXvKn5Dlw*GIe^Gv2vRd_n~i-ft9MaW8=wiRdw$uX4LVMC zYuWWH7Z*c~OW-zHmyFX4+ox#tuV^4mg*G&P?221XISo;heru`_H4d-xUki=;N;~C} z3S;^`?zWOmTy}HQs~9D-D>@q~b|8i}ODFC3Ffs|d_4)mCTFy_D=!!E)95AHj>zXwE z7Vza&fhN{5d;}d>)RuzCETZ}Sot(DpbzMfb!GqQ^7gksJ+$+5#12tzBjc+e!+@wd< z6cu{|r}4erF6`l|j{&>HHUGuYlg<{79;OZ4Dd`jN7zD)ZOu)aLHI?R@8xCjqZU^1I zq0cP7-ql$*G!4CN_I(9EW{^ge^3~o6Hd3(-fs?<5;UZTs@F;)@_Ggq{FzF(1G=2Ro z%A5JQz;%O05FMArsRUzP|0~7WmV!_~3lQ;^kOy)=!N?nApNX5i;hGIre7z!(`cw;V z^V~v$(O(*J0O9V191NYQ4$)Waj#nB=v15VgiM=&Dx~8(SjZ&XVLPKC!m&-3K(OG8K zm$$j@8O;SzAd{DZZV2vLT03?1lk?P~bfV#iF7*#Kd{7 zRk(>Ks1Z=eI1j{%VB_c^V^3F2Wnuf|8%;^iW$}F;Q_dSWcmcMfrHSN4j(k@rI%wc( zY~fet_1hKI@bj(@?CvW_{s{RaVb&|mW>kQl5MW}YguS%m@Sb0Dtjjz0=bLpBrT$#i zX%Fd!JhT*i8f8vpm(s_~4&`UQ?5eC&g%i?*ZAnO~K{Ygjc5$ZmIjB8}$lx?${(=|S zTic$cL-~7c0dMa0kUB$MMD=@mye5Jp2pihc0C(gk2Ub^5VEt=X19UJ^18RX_S<2El zaRVQsk+}Ok@zsgXrW`GjkplYz_R0dVM;}=xJ$lr}j4$AEG4=M@dQIX#NbR zFg=CmlOR7v_=w}@Jjw7?cV5+v7x%@>i^6Velm8aJ^`4;asAw}dq>u+r1QUq#Nh4ir zr_~-Vwe(g=iH=dx%pct`LD2&@_sfQ`mN>SyJ>pYLlK?XZ=t^V6;%$*y_p$)6v8Ml? zW0ZBq6*+HDaSM`o480i6&)E>X{R3qaTrkHTX}Kyq$<^K$ogmN}Ky6f$Z+XqCcFbBV zUTfR8RTtAiCX+-Vr61FdRuBF~#3HQKbb;b&mCtEZsJcmj)YePJNTd+mFW&zBmxXnK zC@$&|ns8E>qPPCieTR3(l&3rx(oDLbS;@aNL9}6Ef`%+o8;grab#F#+WCNk4l|nzs z8~qbuE(>)vFm|zXoxpX=v!wA7LK(1qXUc5kY|H5iDBdw$-fBYtS?((F!mKG%PK|f9 zKzCc*{s-7=jMz=ofl7;CWyJ13?CR>gpK>tF{juCRtB?57<-IMCl%KsV1Ox$(Bt%4Q z*wb939khzbS3N`*R8|HoC(LHDh-<0eq??Kn;Rmiqs6RL(s<8W0J3kKN!(y(SXglF% zp6nbTi1By7nM^U1L`%0s7+bNuS$Ed29|%hGQLq&`<6q3sWZ`0Gll{rEgkp+nehJunw|lgQaeZoQHmE)dsLOA z6utxg>~yUR2hb|LNHaiw~Xk4;B)_;Cc(kDqKY4k+}++mtxf+w}`VBy6cma zc-&^JD{-+*QI@cbNw5$vp>w}$Z-(7s#_IvCqcuqicRy(Kh@Gf$akxT!mi&{A*Slp( zN%c1_SHQf1&KaRr(RS$x5FZugCz&pEmnZv{!4`?hN=e4@Mh0W5ABUVe!o6y=4&XXP(v$5p04K+c+pveIzR132avCk@0Z4?s zorf7SL+LbTrrOpei*0wTAzk%d0xMB4Lqf&45O60|)ZQoKVR#sZ9}OUB>|8VE13WDS zwKrmv;d-+<4{Y0ZoP^P`?{=2r=IUM(BolId6RTz)R{X6&<2$?v;fmPe(>Q<`J6>P0 zj@pA=D&1^kfTyR9Ua7n0o`R*^S^7!683##=_T4nynFdKao)@`o81xg-T5(wV&8*>- zG9#!cy;>vf94!tixEODyndUPMP|uwIGvd^+(2Cj;>z1Z^NPNU@2?#!IK& zDh1H&LL3o~bLGsTn#y%6zHyM}m3fj+)5STX==f8kt;L@Pq~P0kB_{~Yrv()}@wbUaAeKGR!7?-VYZu1B-IKgGrzQfA96 zMvAY>9|aeLlmev7QSG3+|4J33`WF!ob^7M(?Y#WEX82GEUTvtaIFS4|jt%KSrlUG3 zs!C9U@%=VV5YzM^`5(jjf5kXvVdnf_>X$*y_1K@mv(K~|)U60>lxmjGb!?vZDttCr z>}5_56tC}&WHz=T)i3fQeEFR?dDU%6%gi|}b)MR~e(8$#^0u>uGD~`2-5D|9@7WO3 z8^1brJ4`)o27aG$j7GwyT4x8J=6q8juDU+jY7PPV7)3P!oo}CBP7+P07dHOSk1RJm zy(-S*@%qh|sBWKoJHOjQ+xE?W?sTc&mG7N?Z;Mx!gAoxnLuC)sz-oS5Xn!B5(fSD~uGC+3N)C6e zAu&KS4>-ny6xFSLos_?3O{=)PrIpS8k zx_#MUAEcr_?zABhtGjLqRy+KQ&J^x3M-}hx(u@$MKM%?yU_F-)K1o6fyK90@ zGZ8RPXW~prmc&WLs^m-XBvTjqtDw&#w*zTgnbhI9XE*b^ka66m)iutI%Osh6t+sZK zMAOC1dZsQ~+=M@fs#KV%{mgc`;9=>mPfwxW%gfuek;ZpfJ-&ZD8T}J?}-(l(`CAc^WF;3am zRThllsRH0kCrkMkEU~-F*-@lFJhqOn&oSm`8zBRf+HA?1PJ7$4>$<>#)l3L_Z}MOV zl|?}WZQ&uoOuuQG5so$|^#TFVuMd8kvv2NWAyAr24luv3BhTCWKqzqJw-zL{hah_m z3qgdgl|E2=;`03<(_7nH9f&P3Hn2TY6MdFsNW51Zj)e&vz(=!vH+HK#%9*hzV*%T2 z@Ch;@1(1Y`nhU-s+}71h6#tF@Jtw7G69UAF@h3KM9i#I>fsd<$6loL`NC1i&Vy$ZP zvu`VRR81!8U~bquRf{HFVwn3i=&}-0sa*}6)>WW5=wBJMI&ekmYNn@Zpnm`EJ~=qP zC)gXv(Gvdje?cY#%xwB3X0CFCkt$N6mL99HlsjN~bczna*)lS?`aui;74bhDz$7@|T0%P* zA}HA-wr=Qwd@JF`nA8)b-qBPVSIW4o3*~w7Gsj^S2{Yi)M``RzyEmdGo(H%$I_5`y z&eEDsWQM`Qm4rNYIx*Us^%*aK+`g8gvC{X zavb}WGi%X-01ZlccK{;Zg4YXQuoFN7gjU4s27w|BO>tyNhOXrs#WWp-b+1Xg&1X}? zsk2pxp4v_hYZBrlJvb=%%PArYWHTZ+cxR8QTvW5oRlRjsmE|6HLd`X~hEayYCGNrG zer+99QR5bgK=+@{I`3;;u0dbOy86l`(D+pbNryK(t^#A~ti$7%h1WTjVbY`xTqTnD zSJCtoL>eken*4NQ_-n;Q;0e;iNIx%*x*$|Pg}Hr0$K$STP}@lG7{B&nmEU8y2b>L( z_|?aG@Z;Al3rlYUXTNqV$YyIJrizg(+JQ^DN9VnjTYIsC22}25tVKh*Xf-jkqApph zTIpHEMj{G6iRL|virRz_5*QgcKR5i?YP@MTaO8;xEzZaJFb5-g%~DvIov&U>*2q$w z_v1UvUv1_!d7KkvAU!D!h1hEjKb<5P7rYlU%Zum)cscb_|%^!08EUPp4B97IA9x2tqJJo|Gaz-bBBcoa+QkFghTe{bneu5SG zvWLA-?VKBh1w+}d2O+6|hv}W|_opH{%?YN@(q&z36BwL<7OIP9OTd^3PFUy8ybus< z6Uadh>yaBz0v0&4fDAPEaauio1S4kd9DiBIweX(C0Q{&f6rFK1tStDmTB>gvksHd2 zi~P3aBsC3ocNonos^O(UB%)OI4IB+e8LiAg(=E!u!C}Tc2ptI@+jZ~fvm2)tz>&A} zw=iEax)0%oBx<-vmWtq+m3o51JlExP7E8^&5)sis^;z>xSJqVH2LFbOiURAcJnAJS z#C(N;{8eA1atfx~+!P#`%$YSZ%iV=1>=TB;WNjkleD&qEY~1I{j=z9PM15oVvF?7M zSuDxR^fHq;(4bt{@1mj0oXbE;-P#|xxep?J-p-t8*G3ILR)+^2nip_}z$Yt7GM)#5 ziF#*Jn~y&SF)R$}*h#~Xfj|cwAaHh)g1bt)@#_mEP(s5f5nFtdLCX{`kkZv9>XfsW;Spw3Dx z$ULPRyS~~AAEWN^O~x3?3_!IyIk`UF?aiX>D2W~-*LrMBUHTLnVcIwx@epnyOUK6!T8hq;@2_{CvLj}pA^%nV5KPV3b`y`zolv1v7s!X zl?N1OBIvWA0{;hZgj$NY40NB1w*P720@L8mINVJ4aV3+MX>{Fxl1#4Uc0dkeKU%_P z8p}Hg`q3=qr3Q1ps)S`4Bv~+D$yb1s&Z<36`!MHikwya#T&3)E`tKP)t2^DAuybY2 z)TXEwN1lg5b*33PZ4bbQ@V!rdOhX?GqNFzEPH=Z#-MVbE!LDFpzZ5sLZfyvW_;##5 z4@9?ED^^&DtsL@(WR}mgFhuv#UsBC`4oWbAY+`jYHlT=yaGZ8w8tlROPM-pn)tRsW zTm;?r_X3s^vDo=QI$hVF08CYu?|FfKlWfrONF^9O*EQ?z^~?QSzEem05Mu-z)!5Ck zn{MEf)t$zYFxtYBuYPr;qs!I`sYV5?5T{MHrU;JC+)-;w&xmz4P+b@eRm;A8PTrxD zMeclsupH_T#zK&tsk5yRvFSED(fT%s=u5ph9wq^@%7tM`=TVdEA{uHn7j@vUs zVP47P+na$5La~@!$@sUUchfCjZ+6HSY>x)GXY z>%IE=b@rsqm$?SgHtU4IZ|>-~vkF#}sk^EoN}s8)@VF9)usX!z2d#*q`+CeOZ3i zGl_sw0ii-0GM$X#4eF@ks-vWU(m=QBZvfam>ova*~0 zaHDnysTnqdvMxQ^T;+RQ`a3j!mPOgRRRyk@w9{L4`UU)5WyVPe&_HC`ep@xm4ptUM zB}rG3>rM0e7VFypm`kE*#&t_VrIzfj1FJ7<>4J|dAJP&`WiWVO{@uth+QQYJ_SVI| z9@&z<24QHY%2Z(DU+p#hc30c!Lda$Tpk^DBVeo}bdw+?LjqidOK4M|klY#n%5|=C@ z^*8YG@eO_RwqL!}J{UH#q|7CL<4ss)J0bOCIWy;;Zx)y`oNf}0A5lb{WH|Vsz40JV zKWt<@)b&C)MpN&|e|gpoeK^?zYRMUj*-X2r5Yoy@m&AMoFxk&vBx8}Cz3EfPR>|#LwYLdv|%9U)} zFfTLm+O+#lAVQ+um@yS~5#46f)uF3(^KqMjng}XFiWd&ky6|>}XSllRDmLnX6i>U> zr|xHCHR5n_4nr^!`mx}TBJ%vi+eT?^H*#XInC{A=wW zsZ#jK^>P?mEO?jsdIx>0G_GMzM4bPwK{$?kGIBx~-nz1KX4s$g{dCV}nBSh5p7-Yx ze&prz^hU<-58KuDiGcbO}KP1+S|8ow}bb#!ix#Gx*lq)n^#uwomqcH!C?I z==8pk{MWLuKE?#H$>7eUo(Rr{Q0HhC(Af_JdC_sVq;*;k`= z6mYF#O3&}$S`rA#U0mb|>&%6kN{cL%*jBJo3ih8hVjb)exMFF^Ax;+E&AixNE)zW{ zi562cz1nV5H^~-HHWaJ^tQUKz)k1l!&);E^PEi7AmC1UeR)UC=qwo_y-5LZ4ydvcP0Ca z-_|ec)TiSyf-l8)e3zQl2J)inRUJYO-`jQ^ZAFDc}sx zrqD&mX#&K670JV5)%&Rw_vX@%ptu0Z+_=*^HaYA>sX#Bi52N|F7OHlBL~qfr z6yp;z(SaiKnr7iL@?l}p3=2!jrYn3Bhk`e$sN$)lB%cC-*{6RKFh6`Yg^SI=s!;Th zy9z{w^gaY456&s2mNY#&T{Fg|P`wz8D63060zIVZ2mOMF>F*HK3da5S;H@!$yF{~z zSci(~?$i;-;ef2$yMc~W#{&NsGux_WIAOmx=0zG?0)z5b8*nTs(jGb<_8E%L)6ZclA9XZz=3`gRB*>(2% z!t9SDSBtU(g%m5&nxXdgt9(Krk+Eu;St3vc7_as$N)3)jJNhnzIADt}_~t-?VEO&> zYu;2N>)Tn`doDLU>iDNR7u|6%MMqBD!uuI(fhI~Ciu zRk59lZQFM8#I|kQwr$(C^Vj#c-ZRE&oX&3T)^4md*V^;Gt~Lo{k=iwpM+-2N9rAXh zW`pF^O4T27tD)MEVg`~@s?eGvf(j1uaWlT(vV?3we`8zIRd4uf!%WUJl~I-OaeU3s zm+FRDKmO%xGP_A5x6l^;T~K0l_$$#8zj=~ zMeL45cK^P&d?F|JU|{j8w0ORZhtm#P3A*qp%OTSH?$qA%TNH>>R+8iTksI=uh#=ai z{sUJw1dC;KEGX|AGI(2pGDGp^i@6krT$vxnu|`xEj1&ev73j6n-jQ)BXS(|zGI>{@ z3ckB7O`Z@tKDqS+ia~Z6w0bBwiB_iv4UH0z)zHVuFD-@uy*F4BkO5Sk-D{OrNLQn%nrSJSH zV~)M-dLRn`teK=vJ(5h&8~9Uk9g4ilKkwXF40{)Gr5d!;3IObL?qCH23xeCjiL396 zqKw@U?9Ibm_vxtsS7bV~U9wJpn||U}^M&ArS{WQEj+Oo!TV0Q;O;oo_c)RX(-z^!U zE>%LJ%_?j_2T7vLY(c&i*7atEpG2pSX2R25Khz?GQZtJ)n40|>R4^Op~?tQkADJF`c4UX)2 zV9&e)x@U-YKi97Et&xtMei^qBxPXjN>T6Rg7u{U@_9}50_P>SN)%8V0Rf|nT)|agF z25kn?YF7~~7f%x!BY%Ef7-sut{N>oUC+W_8=Qtp~OXBRdV(Lz>?fk{CO=pru|NGym zN7u(<;3o0OaMkF<{w8=RCQnyB(O+o4h2ig)QEOpRFN>;#2zk}CT0RJ)b80Y7sGM2OXhc(t)XZr5=T1i6xkJ^d(HT9{{?H? zA4J`s{xmn{YP_oZiV;tVorC?mkkO9s7Up|;NQ{@B!`PSgMFsj{D$8$hhwGGkc2ecf z;zaC2fgZMHf(1OjBJXaK6Ko@e%{u43ux|_;ZUF1+&YQs z4uO`ukseI@Li?8zY}mPkF?vhH6svr237;x(`|*-7m~pLb&h};f+HZCl_P_pxSqih! zTPPIEAN+d_hlf9j!0S;DD<&omr@L0lbhIFroUQ}s_vD3j49FtG8l1{TgG)rjn@dy) zo}IRF!}6wsW~I4l4VU5KCZD2HdiC3!AyVQ0mKJgUKiEGiU$M*drZbO|5z69VHOsEf-7`A8Gc3{|J1zL-j?VqVt3GiSySR}@@zgL7A?XawBdc)zepfd z$1hQZ9i^tVOjuPFtwrV=i7y4VEniz_>nVa^9)qknD#kH0U{1oHMq|L4ssuVLIO&{S9FC63*&rQ9SQJ5VS9{|wVi7i<2IwV~CqHgY>I{Iv*Nleu z#`Hxt-Ih_j7wn&L|?wF#X5ku8Yyrt`gEcSuW zU9^|mk1#mD2iIkiLe+I3Vv-40B?gS%H}ysm0s4bY<#EJ423Z-|tmI)kJ%Q zR4>Gh^yZID>Su5E28om=?~9#CT--y>k|x`95HDIt{=zApNyXqm7ty%>4lK@>dgs+1 z=7ElkXzYS}T@5BAs+B2KNlSICTLpq_!8|qQl$27Ph3(|GtWBdopmzWZIZDW8l7TeI zWPQFHj1<g#}(B<(~62VUsexpNDv28QVC-}yK>qEi6tA;P%K4#X_6gvsMn3lqMzj;&;T zs^_8N7GIZr`_&r9v9-hP_MS}{YJkMDWj?UO73nQSls3x zO6pRJ^*PtdB^Frtq$gFczW0(hpt$mFH_T^xo^v2(f*|gVKY;(F!OggigB*x_E%#42 z^u7hSgc+0^b&K4H#5BBvr(kK+wzR9!R3Rmjixab=p7%5-M?fwX6W8E_PLJ=Sz$gg? zVoT?bOU9s^*IQg@;b~=V<{QgJHa^GQN0Eg8cF%av ze%in;gAM(N^3z#Ug>Q)Vd9MMSe3y70MSt$wV+y$Atnl?J=eB#55h)m?l!0ub6Jt+b zXw!3JizOct%Br`}ikpI1bNe-C@zVpGzV05f$ktqP;a$oIGyBHI5&U$`d+HY&eSONG zfts~}PD)NK?0k`7ZET1A1X?$;3h#X4Pwhc#u=gHW<_gU3!xcMmj~UdL_LIG?L=;KC z8M1RKNA7DqH7gS=@1N9gjooKW)3tDcx$3BNlUg6BAFLv)_cvWorz3#KSB@(bp3t7$ z!6jAOhesBi`LK9l#e91N^j&Q99C#JP%9Qr?^*)~_ezewl_y6mf_CL{~8ChAG|L>`| zOKrnpK^)P0r)IW5I#2(ad0Z1Rk4h6IXcs_5hY-#atzDre8o$=NVml)eeiZ3o+#;?o zg7tKE#(CnzJ@yhrg7FvY4sZbEQ%>R;+3*ehB3z_c^7-M_$U%cS=q{P}%f;`~h?}8}kb_I9LmyI4 zhUprl%&!B}mSh<|`5^Z3A)B3GpK?%qOy5Z57}}YxqnA?<9v!b3(bf)edL87AwA!Nr zYjT#7P-tj$kiW+ps70X!y(J0K;^!YI1LhqXy8JM|QW0o3+sy=f1r7#c+d+(WQj4Vy zGPWn#+KvCBGoQLdb%`xl=<~U+_Y>huz-mySiI-O6vcWS2k3uS>1B^v*fhw#!)|$Vu z=3V)fdDvO+0c5ojX03FZbYI@=)InSME+w0k-(y&6rn zbI?zHw#gBbi=TMJiXcf5L8v$trK)O%#(M9lRE72R`{lkTxYkN)t^BH<5m1Qz%6AwF zz#j6zqeH80JF%-enx3kUToySFrNEV-l7uZoQqEdhTaAnT2bWZK-IrgQCrh2Ukdy0 z_=n`IzCP}|&R;A-FqOaj=FwJV3OrdVdpY@P_^%CKH}2&TJ&QrUYf-+9hcavhaAhZY zp5H}gu=6qyhYa?@5e)AKibJ7Wu* z;c`5!pdw*CcV|W5F8FWoXPjZ?Q>CEy&rm*fU;umtLc!?l znFM*pJk7e*!K3!ZPv2{DvHH*y0!PK!HVP6W)$|@J168>H!TiFRsKr7n!kT_)_*OZ} z-xWg6eXT3ZyQNz_FAE3qCY)^r7Ng?Lj!RJ!ayBe7Ls<#d@dq#Vfj6~a4tyg>#+uKN ziCLfKD9Wt@q-60hVOy@2c+kLh7cFFJ$m?IOdMUfR`ld-ge_YF%S2mn4Of?aecWo0} zInUMYEG2Q=mT5oJhYi#<&+Byv1M{6hvmT=;t**vRv4%&~oiVk@4dtCBNBNtt>O*aU zm?+ZPXG9@?^N{z*25dOeOUV;S(_J?EujvGJpCldk<|8{EtA6BqNt?|C)>H=GuvD!D z@ts{!0kyY`Nx!6Y>3~L`cl_S9hl-SAV-aIgeTnbIB|5TEiR6bo<>Q%H-uS(aC^111 z>H@xcH=rrc|J@bxD+nzTE)F9$^uEu33yS5Y<)~g(QS_)#2qW&rFiHCM|e^?}u+PV7I~m%P9f?@#k|GTv;vu5r3nmTN38MEREWT-NtVtaY+1A{_ve^N6PYdh?ZQbrU{vN(J9 zIGdQfe3Un*9dgRc=UfvlT#S*&$uQRg{d&d78BaqRP(%*OF0yov_(v3Ksvh`Hz1lcS zjBgsDwmcCgf`ZM^bv~(CvZUweU7?BFer_y@>wEUm2>xlhVJfnK@Nv~KS9Qja z!mO1FgkYSOg6rq3BT^v(K~5>N{NIrk7zRwj_|{dc@#@MK5mX``Rg$O19oq@nz${5D zbj!~jhx;w%M@Ax|DP<>odom~)%2jhwCD8)hOCw>sxf`Xqj?)r9ZhP?j8D_&hC>c0W zi?c0M(a-0+xsY--ORv$YF7D(@S?>cDC_(mJ@N}BqT1BjuqwnTC?7x zk{2qWA1UUOBfo*X^`)q0YHjxvtMKV7xGW^R8~roN%_QZy)sPLW$sIb?5gTaq$_D4S ze2h~2G!SP_{5sz(`7*wwih3$;a{1}BC}2eQSt^}XyG4r`d#?HeVZ@mjwF%o27Yq0SBuH5dPM6gGs6s|CjY<{YZ0wcwc`X~>|am8|5mTh%L9-e;TswOsOl z^0zhp>B{_^$TMZsWA4?jW>-6#IIEi)$TK4J=Fqrt;r|6cLs{|Rx!Atg3Q`hWk9EX% zeJk`{V`E{}RF*|q_@-r-^@1ks7tz>ulzMqGd_mmcKQp3jISw@|O-b>gw&x~dIFP)c z!1)OzCzI>J6S6B9A|%LU6^u|b)E%ceHU8Ci(@aZh%lyVjN9U15RY)tF5s7?uHFuMYNId)w) zGS4SPdH8#!7t7nbNe7na&NsW22bA#voCJ(*QwUp0WRxKjoY&TEy_xWUsB!{quB{7NPAHd+1imX#D2&;>Aw1hNvF;22t`azoeh?tBnimYIOiv`7S=*3i84{v}_X15+8+4`SEHp>TPco}%hzjN4I5OJifa3`TwJx_a*!FAK zy;fcnV?)(ZY#+31!yDO3(dzjQYIROqAX=(p^*f5#B1W~y%H;?uxF_CWb1$a4U+7mS zTjkZ6If5u#YGgn$Quk>8hz2M1x?)nUx-n+vxDzC!?-)sj8lo5ItQ$~dR{NW@Srl-A=hwJHZ&1G(_9g+R-K8=G# z27b!8zwo$$@|c4pqh2)1!l5`C!3)Want|E+hi52Q{A7d^3~qr`6CV*a8w+3VJE%FM z#vOz)RAdfoBBJ)8WMlXu$&%wuf?jdA;-|x_)ipB!4t&GrsO3J2 z0|Pqu=UPNt`yWvsZsapv0QM_h8iLFr{z0ZzFQ0K%WNM1^H{~k6y!<*B*u*ytpdY)! zQqg1={885PV+d_L6(xg&j{pYs180IxS8B~1rzA#IamX z43dL9{|3p#5_>r89A;Z_iJY97K4~HZbqFf&%M99+-!3j~8P6j%F}$a;VTK>;yZ7Vf zDJrMOe-i3nkA6F*IL%Uvykp6FZCxd2s`*`=_Z0gZA?y2L1x0KCDzmnj+D;Z$9XcIl zXi{JplC-y=*Pk?E$}W(+n^=L!N7=;%_TzylB;0drNk)F;v=F-8&;|mU`9KT@OdVPk zoNi{HJE}R#E>POIH~{ZaF;RxfYn5VM{ws@!m#@YB_oYxNfjYwXa5I+4A#hi6VAnk{ zmD+|07Q56!pW=$MJnzNqEY6(P7ku%8J~0Bt1^6HQ{VKneoz0+k21t{hqp}Y5Z$I$kKJ3lu$TR(ME~0QcMcMb9?-0l;^O-O~L-y zMFX0v2-s;??_9k5Kx{@FDDAIW9$Rg5)nAwJg zx?Nx@MIw}ow2Oul2_*Q|>c?OEbi!`ck&)vm&Pa7CJMO1pm+BSsVWL=2Q&U^eHaKU9 zcI7t}*c4)vQe-%8ylZS%A)+rhz%}h3^mmAQepq781rs9v(7DDr1oE&3`vq<|?{-qgRO- zQ;B_6a&2A0$dQ(=9Ql4afM3NQMT#?aAGqJM^zjLVk&zL%y?*y$Mh4ARO^cF6Wd%h_ zAw?rE?ruRFfsKo?LZrM2S-?Z$mTcgca&Cr-PD`s83BHGgH57R1iCsk!7MZhU3XQF; z3m|SMFlX4T9c)3n{kZ?wXtF?DqSAQNYcfFiCWI^(k?lS8q|ib6T|jIi{lTIZ(qk?X z>JRN_(YJu$D#tz4y1EU_+VT~7(xXotIGdvD`FF+6j6n5z-$X&P5P@EhDLytMX}~z< zUFli~44@kiftuvdm)0hc=b^YOKkIejFi$?X4MeZ^!f?NdY?u*onudJYwX9G}HXsfZ zh%GXIeI}9-_jR57hh5pLmk5>!nrY#Ammn0G_aQO}fS5Qs!V-8+StBF<)pvkJh*}NH zK(l$?WfN}UZdxA$Y`JaD*Rgk3g042F_jS{E<+NvGn9DpFmisokVl6@diVa~%*!pD- z+88o2&1<+h)b6N_ru;^&5K^;6SQU*zXy%q01;PHjFV!KYXn?^20nyTX{#Rg5U)1Y$ zsWzI|vT+7!Z5=rRtk03A?Djx)Yw;S7u#{~qum8F4Bmf|QA^En5Ocux{`0)`(zGDA6 z4)@ZYRlCaN;?+ZWyR5@vePW{{ZEo&+!Px4R zW*c~qk{+@{=wF{zhSSp#?(@F!1B6}8LjK=!E9d{j0A^ouaxRsj?9)9a@)4?d=F_NZ>yOomiiVhKr^!VX0UTM3KO2?4y4SG%wD$MkKe3F;_PwVbbz(l9g(7w-?&~uB7GsgL~4Q0_} z(CfZUS>ky2Rr<5+D(pXJ!_Ny~pNoAS$jYmPqOGGtDe|ZorIz9$fcoY3LJUY>iOuS~ zy4V;M9sZR0J9Z7vb@t0c^Txu>q(1Kl)+PyD*O%Ax12Ikm8T3^`47X#s%cLP@s`ied z0u^L)cKN%tU-hfTqRS@OWJg6aKahGiB%orl%|!_`a+gIfD#^~Rt9-?+zLCoFYikTnsd)enhm@I!%*~s?cw51eEIGGw1$Op^44svoy^^y?hTC za*AZ>CdNflXh)ThtMvWvSv})e<7;cEZIJN3SsL;MuLP9j(WImArE2$ep!?{yEJGU@ zmjy9c@(?tp6{1-kp7^zRz6^B_Q$4d?#$>NTN0uV3&`zOrZ8b8XE-Qd=9#`0@|u)(TIs1ZDx}%2!-q z>I4@Gej6qF3Bk~v4G!bnPMf3cm{1Z4DV=V8WhhReFib7dGC^%+9?(n@zEJ&(RIjjl zW$W9td!Vn>O;h{>>dm(6h|$y2zb;hg%J~Wu{lb$~K3pQQH4MbpUs$(r%v*(|{C1ON zp*=g_7(pb~b7>vM4r>NgsAo6$%VBKX7Dr<{g%C*xHwERi0uqoe$&3gCiWh-N0MVxa zUL|eSsSgfA$Fgwh@L|V3B!h_ z+IhC~dQd7QkE@GK)9YXS5oHStu^_Lw7wx*vQ7eV4TNRy^w_r?8i}C~Yu3`xA3m7d4 z|EeiAs&8TlYjt7>q7>s$%rv3u0P)+glrfH9aoP|AZmqLJ<##kA*lh-i zV$!7n+ek2ad!#xE)x)3W`DJCVFwldO7pUSe-n0Ouzel#=?Xr+AvdTeYZLuxo;RgOA zaYQ3)@xqoIWZhwkuoG!;HEbP$4-zOWDHm8@k{8iBCB`rg(3P9Y)|#%q#fv31ffQBK zZ!CmslW93o!B2VTSSZ$#KH(?zi#3Tkw2s>M=FJ0ynpDMS(;FRv2BJ`DD8Gi|Fk3$b zpt1oMWUr>1tYXmyoT~nHJ1nt2f>@H|JStWXWpZ>bd^N^hHCq!VHgEb9{`=K=$ z&K&y!k49w(#EsSfenZA4e5v_UFe*7#iZ|Kaj!QO!;jewP(2PefD@VC8`m>yJrilj(! z@`tc)1?VTkLmU`Pw9U;m%dE7!I_La)JP&7I8VO#83LYa2Lp`P501X3L4Na92l4c!W z+?>IQI_hpQMGHgPb5_<;<~ip5q_2cJRum0@*|K;1kOYFuws_#RSdASIuO_esr^9po zM5-G1L_L|l{5W82Q9sEwPM^%J$8Gd{^Mbpz<7zo#sTFhObUp$zIW`>XeVLw@eWrs! zz+~g({kwOdiPkzYLQ(PG`oET9M9vfKUznD&>$y1BgM7ytT7V@RB<)S1#9Hmk$(Bhi z%}Xj9v*iO3Prnw1Md3fbt06L0CYJ#VsdqgWwKe|-<@Bh}CM8~AGT5y(P_qc;@NQY_ z2az33VOCUKKJ>U6zrQpkNLU^v*zBPs+olqGR|uiZ9G~qqOSU71`!nKu-pD!R9RSL_ z&Ul$n4Ph4ho^Q!d4cG04xqcH{l(+zzqgI14(Hxtz7k-d-4etVz^_G|9DAn$VP&zPO z>n#qtn2Xuud&+$tS#RA!3$lJyW*7>XZvRfpjvuUe9y^kJ-8Wnc#9+k1G_J4V-3@Lh z#-A>Jg0g#F^st9Pz)XoTiaaOrD;yahB6Ts{F8P(gVu2I2#aTi39F+MF_!BE8)VHR& zgO!hhn5|sl?*x=HB04SqH8Hp16DJ7o@cVdUP=pTJLY=&U98RJ@jFBwLfz8}YF2wh2 z;<0eVzf%07RFMAN2vu7}bB9DxF=XqNSN#CWXRem3q!ILp<-92f#EK^gaMA)@&p@6u zD?s{)ngpa3iK?oU4>_r>Jd(W+lFKxU8Ug)^r4dbtc<_j-88A=TQr;;#G|DJ5 z%iTcPNm&np1s9EVB$XGgrOs>*#_M{@kVJ|)OO&|RcxllCdgEY69$;CnI#O*rI%M_F zX%$ zvQffQ2#xKuO@NZ3Wl%#msoguA3`T9<9*#|98r6b`3R(rS-#<>Y5+8%QycYLT-EAvwQYdReQj->k( zRoT8gA(_s3^8~LnEXbO zW4=>n^P7ttzkkN8;@5|EwcIFmC;L&D(ci)EldJs)H2tSp zdj@3>o#G>93V}@Bcqe@>fWcMI?fYn*SgN2=GU`ndx-5hJWW>x~C))!D8?HTmsM-L% zkS#TR`hF8rVeSBzY)_iQ+&obuIcMw#Z(`Z-Q%$DpV~#(VX*}-MHs%`>Na$O-%GR&) z5Q0vq2x`H!`=1$j*Or#+tFRLYry>?BDvmK-u6hRy3kX@JScy$D*>QZ_&lsixp(+i< z0mZiu^csH^bCQUY+sOTSYCl6UE@L)W@0MkHZ@p6av?8Z0(Bn&jQ5*d zFV4bXyLmw{j=J+v4VX1t8FzGmUM1;mwj<>t@2*Z5ALsFkf|E|?acnO1Gs>E#=V1aQ zsiv{WmRkV7{)uVl(V0|$F5^K{9X(1&XSiH&=j&G5dk*G<&sOl89y?3LLG!tR4>qi^ z>R)S)Z@Ll7>u938ZtU_`Z!D|uti08VhqIeu|93=Bwl7|mRJs(QUVkPG#10kb!;<(c z4eqkM=8N^1kabDZy>KDxgWz?^DTJoJ^8L~UgeJHS>(Z)%-$QxL^Ninp_w(}D7LHH- z7f;MKH!PA)%+}PVrt3s2kw4ug>$cT!HB!vwqQ0Jmy3^G??YdqsA-=yrj~!3`>!Ia; zqLnkTvH#~^Ty;&yjaF2jo0?q?gd!#~H1+`g^nc$;cKxc+oXw?VLH*_z?HpP|d?{&} z+t$SQbM`Mk5(**vVgy`MB18}b_~|3=9sl?o4A(#Ui5M1Y z4&EsYSquV^i(^mcAxhZYuXpcqQ0SQ`0KXRd=l!oG*9d9Ixa5u`?9aWgoz2~sDVL2) zJDLT)m96b59kz(b3n%wgl@2ia`EALsW88r$ipwZX(*e3P7GY-dm;FozB1md9^=h~G z=M;yI9VOgQ+WW>f#~l21j}}ChtBWn3>Cwl0>j{9~nc<1+?>#~Q2`7DgB&sl!{!5z# zyE1~O9n?TZeQ6PUFzdZ-sL>l_51A@iVT6fj^ z_gzuK)(5(oSJjr8#yPsF9%y5n=TJ|b#k)sDu${+pfx>`vEzr#4*;qjJ`Ax9>nu^b* z-1U)ndh!nIRrBT6LiKiQ-`a&P{fuvym!r$4ie6^R%GgX8i70d29}-Ty{zC~92O{Vs zs}jsB6Sgts`!1NNw3S4DOg*r2$b!v{KCI~qpZ?aq_!4;5>w_ie0B1$I3guHPQ?0uizax>V@AU$gI9mWMvoo% zrLNPT;lEH+-NPJB!tCy9y#cCN#g_9(4X~;0s<9F)xm_Ez7e;6lsz!+t6bgNy^&^(IsoF=}BjBErBlQ3! zxx6HK@}tCSxsQ}CRs+k2VD{7PpB;!wW^-8@#}aJYqI{w$MhQSOa)$a_R}pRL zhkew9d{wC|Ymk1woGxjnd~sfz&WE(?u3TTH@yBTZTGwg>Fa?y?lQg-hL@U~6g(tE` z1pVzrIPk4jRF0@zphxM-B6S;STx}YR8!q0T{ldbzx0~21^bVIOi(yMuu9KPr=C=SE zZEy2cx@?}lKADY5gAoy6FcXx2#rl48Ngj%La8;tlX+*U_bO&Ks3XH_pPR~`nPxEvj z_w`zoRt5)@T+BN*X-*84Tb$sv9F;qO*lf8QB(q1J8Zb~L%4eXjIi8tu6cRt!BH<$e z!7DgMsIjm=SKM4PFeWWzqK_i{wUt&)61__M<%NL@o)>pkb_$BXF^HmR}iC zwCp034v^Ox=Lb{5X+JT4XJnbI65PZ$jnyLc8q?EC0bY za(#3U)NiRYi}XkN0boaBttUD0(2)59y{Tb&U^?x6SUqK=AbMk!#o2eZ@m|0iAV*-Zw(&oHG z9H0}9#9ZGJ(i~0B3ZWR40{&bM)Ph;H)LZI2&@o^WmS@VUPYM3oOVFCfpDH{`pt3vM z-0f^MUDx`jOGiwx-7j08;aDO9M%Jw_W|Q|gIcm8336kib6G)*dZACZjx(mYVD9~b* zk&wY*aRrniFY#-JF*C{*0U`jN9rBPkMlcY@IC#46rqPsjY^49+d7fuK4@zB5gocG# zg4M{ok^sngG{iNyK0;-9t2hClTrKXR?g;Ml7!ADvj^%Ko*O^av2n=Tb)atTohCihP z52NgbH9v>NG5NtJPbAz~NdbOh%R4*@FVil^VB87H>kBl)s2`CG{Ly8_DxR69g{3J9 z)2^MZ*xn{|9KvrS#hQKp@(&OIY^?LT zVT79tqF>Qmp~9%I0QOiPeH_rW;|Sx^s*!TlU2zk#EG)#!gapiv?oRxccN@F*YEfy=z5rn+nqHvkCwXyCD}?%s8Vl5>(&{uLU9?PR_@ zKOvux;2j1AA-`ra{bEoqRJ|TZ{x?QcutyyoBo?32M;Q(bqoXCF9+`Q5snk}N$pC(2 zw7S5&-*n}|x02f1+Hf@8_u_+={$`^2v*3yIDG0Ul7MTNYMi$4&v8+OS(IIw0sD3-w zy??sR9}XO?({{0+XC+z}27DVC*&ekn4*s+jF^C=Dh7AIJXyO-bauWwr-qckF)I?sJ zuACeI61YT;mF1o_8x)NKzIP{l7I#3@>3j=^lt?d}JUc7&{I>3Nl(5mv)Qpgwevnr_ z8NNDq6bM;9ff1T!tzv|wW}S_;`ix*RAX?a$8LFcNNrNfk##AALD`tjy`!cPYvlpeM zZA0)WYXf3^BJ5ne?WCill>6YQ>J4N-gz$Tfi2!@=yLk%R*X*ZnY?Uhra97_<>&E@b z28yX)yo|aqTbp~=pc@0 zpKR^ZmX{}cEe1@I(trD&0VgQC06ZIsc83h%@JIx~U%MM*%QG)FX_J3Q&PsKg5~{w7?e@-)BgexPmX zme$9LK=AQt6rwqJ{@10Pnktt<0?9?B*7CDo8JXCran(3r?(q;F)=jfFv31Y<=q55> z9e&A>CZXWPz}zh0dWIN$d*ydgI0J7;zVZ#w4I*VQ13DM&#>c^q>BB*_ZznFVv!IO? zhV-jJO9U1YkaGa$A1x(3Ctm<;b>ZJlC=FOoxuQLHXb>>N&21*^qYS0mp;Hvqr3^F& zpH@BftoJa`d?NgdvxLj^lc-rRBokTK^SZEl{5xL7$@j_93^#c!ve)QfIASoEs*A(q zzdyeg<*ueFeFd&!=O;NX{>8zMolo?gY53az8eIP;O$H+y!+%t&r_?rVHbfDF;(uRLgooHXd{BA3C5Yp9X~x8zoRQ;Lh+s|sL{%@_&dnHiUpRM!Vj70d zu{Wx8>igLr^V4+Gg{u2}QN072{vcd#{T@G$k~EQpt2 zh;m=+T+)M_nYF2GY1$~24i*l$=W@~;ufs}G+Sn4cb>7-widgygHjIDGM=V&7N$Nyi za*Mn61)9*BDQwsIR+;iiWhr*g-1*B#dDC#8t#=yt6r&8`y0FJ)D`=1mI0#_?xC}fI z`%oCx;K(UPa=x9{0vMDKBuy*qAtCrTQ)V1&W?T(hPQZx6q>%?`ODY*9872fiY4?ad zrpUXY&1M^d@2ZD@0-2}65`C(;e2M*|o#7TrGtHn3++aySV8`pjkQz|Ybq;?B%%CH z>y~%PRz8+aVl&s&h_dEoi+0Wmz~!c#5bct}B6H8F@KTJ=ATkGxmVNi6;Hb_|SW89J zou5(>BiwfplLX5j6L+i&yUQs;Wdp-wLX`|5$BTI%gqpI%KPLmxk91W2)`lxrK5juW zCk>v$>G0QKY5a3&s$?Lvwo=v?fQY@j6@4no(?f#7@N2H8ow}mmO&(s?n$4#7Y!bX~ z8=Lc@OC9J}x}m=?fj12Fh$b@uq9=V^M~GPHKaE+Dt8{aqw~0qXtba)$EREG9rmL5= zt4kH@g-}zo7CblaZMIqn#lrywvQ;v<5zfs8VTk>&C=>?^EOQ3ASrG(ppA7Wo*mQZ5 z+`%#PHwHn*1Cq(!#2o1~rQALDR3^%t941b@tOw-cGdDaTCp;mbZhMkzLX_gUR7Gz< zzXgRkGoE0y>9CMlZYtA#TU@wzpZL?Pa8a#f2pT&kq;_Fmj-p^m(Tj$wwwLm;vlo=X z$}nouv}_2;n4XTpj?*6_mX3{uHniIW+( zOn9%02!uv-1`AdnyMQxfjx@Zb`*EfK7gp{pNTCAwA<062#@)(hr#%bb>vj-ty~|r& zJ^*wHRY#1NOl%xh-jk6qGA_Ji3j}|D2=tF^s5RMF!idA19j98%#Ly5b3&EZ#q!DX8#OwU>@(XcHGS)as$Fxzmz@N}{_xRV#N1xvQTMViALCj9c!@opsgt@ZhW(x9dg0c`;Oo6GN%kLei*N?rw5 zoHASF;yyvM$KqhELP2-7I6{QOH$KS+^tGKF{huGm4%0WKOkGdiEjOw>Bv?#!_Kb4u zh#R49`(R$3{O`&7`zC4=OY}rut&YtwX#}JfzXSWeIYacpkJ{ASoDXsQIbAJ&bgT!v zwuuN%A`Iqdgr~@${*g(9L=bnTDC1@-vDVflrvt}T1mAc1f%6vC8hrjGQ%eKErWiSb z!z)sVy(G<9^MsG@(Y7R*s+O-I<$wNF-(MKleG>n5FZ$n92}~@k|F^NYrLG>cIgI2p zQ-g6jgrjNIK#%7GncH+E9Gu7T4C*s_oENgtv49kk8Jnpcv-kh3O~*w?>%a9t1qcK# ztGmxX%Pkt;W`b>hzYegc`Spwy|FO1l$(ZRu!_KZHqI@-RZP|MZmQpG8YT*849*1fA zTDi`MiVZMM3tABOetHgJ-%yjpOnc`K?CJc1fa|uBEh!$Z3-5N`N-Nc6-B3IH>(066 zL0w<^(&F>ol*xztKx8Udl%a-7b28rZG?CN7D5r$9CA!nSZEZ-)0&82K%5vDU;r~w_ zXy1`#mNQ3S)qN-R=+N$_&RoRGK%mywUy&D_ID6<1DMZ=3DyC2Qm@e~mxF2p@v-z8+u!Q=VE_X_9`lV*x6> zy;u*-UK~NfS&YEhDWG*W;v|d`_-vi7ENBvcKX)>I&y)s{4ry()%o$#IeEdyT?y*$I z^0BwE-qAImm-CuQ+x;=l_(39*`w^3#hJb1R#$ZqR_BuQ04(q@(c=ECHr^CUOoknSG z{IdE4)6$;`Biky!pPSQ~8dzIv^;7`_TJVa7fX>qUe11<|Ke_JoxKHQ?{qh<>O`t+G z!kw-s2_a`H4xh~Nmjbm*3^#KHturbP(E={GnPqHY3ajQ&WpI5`xi4+Ga_Rx42jc^L zAlKL-8Nk|_WL|$)Mf};DD5kq=yXkL=_>=19Su7xKpcr;KomlPA)qp!in9rEQ(;7G= zUCJR$I9bDTy@#GXroi3mRF6%r!!TV3TotSH%aEj(^;$-Ct(*y7tSOl({-`uu5N_+EMRJ~2H%I(pjsDyQoroa7ad_FlaN%jmeU z9q7|Y=Aj0=YS5;S6|xaO@(HOGcJh~o7r35NT%RbIX>}dgwPeBaZc8A707a0~BcBm1 z5&TFvpid3Jgn+#u^*kC$KxuQ)71x4}IduENGkJ?xDXd+nk*&omod7arukoq^KF%zC zu?8G}8sl4CYBCeA0WCNhuOVcPmK`XG0dt@(Me=&rg(gaHBKR4p#EHIZ?Mqb?ijhz) z=7v9;2M{kGE%yCkbD4^u?7O9nmkyQ5`E3y}22^gbi4Dw3(WN8%4Hl=DtlT_xT_N=5g&p5QN+@u1Hc2ZuOm{n>(7hHSh@ssf&XDU0e(9WA=#Qavl7AS@LC}S)WS%q$u20dfdq45gF;%1^`)9c zxwB?=-Y@s{x`VZc0yNj0@%>?(IQ=M`&pW?4My;{t_$0tsi{?5qskg8Tk~7g>hGLo} zMGikGm0xReq}u(BOo{SL9(htag)B}eu-I$VLHp!6i8S7oOkUcJ79LNqS;#c9NP*i{+4VcVL;1`C9L{_YJ7uVf~^gSBE zTOu32w6i+B08DZ?F#Pbl9a66s-A{=kP>5PE5WGCJF)!%VZxm4^pea6W8KZR4wb;?# zqo%_dOhJ(N$e!h>y~h4JkU5AkZf=Kg>6p($L)@N0IkUS$F9cV?Q{>yxl3rr((5fXm zs6=#tMvXRsQ{qd>;jeohIh2V6E6G=202s@W15!S20O+l%Ach82BJc*KFTK2cxL?4T zUjTpFeFC4KM9MWog)Deop4i3HN&`Z)@;9M&WE8gMg_|L8Q)=)uN{0(>yR(H?$nr~t z<>*u>?Ch}tdSnx%NS7F6P-Nbl&r)-7cgyPm&GX2Fwr|1s_kf2HfOanzomB8BvbyKG zY*$3R8yfTcg@72FyKbaF3~DFpePnw2J;29{5BmeTu&q~9?yWEn7wF{0MWdI#xr?W& z-6MVgfq-i~@6OL|*<;Q973ZxMz%@Cs z6OOZZVL4qZ+oSn9fKGv+af)kB%fjHbmPHJ#(q6k9RJoI0)~``W@7rp=^Hm>C_ZtRF z!CM6Q%xe(qk^YvKrkg-z!nFc8UC_(qW=T8ZLovDRC3bf=c5crHzleZ3S${?k$h3Y} zv4KdLsiHkOF0H{RfZxmJuL~VvYJ=0DawQkgg$+$_Vn~cZrM#r25G}%Bhg3w?)5I;d zgq)HX0?>D1EOathEO(T|M$ix49mav;AGYU(8%A-`4x&f?+DyTSACH!|j~pMcEUGxp z{}P7S8U8osKO@I~F#rF5e`V|c^H*ZD34;%7+~ujdFoa}H5~za;1hB*kaX~cGwg8ey zYYMN|`o7;5BYvBAxHfmp5k-j9m%l34sb%D_TO{<=tS4f9*H3+S{(p>}Lzf`Xx@6Nv zrES}`ZQIUD+qP}nwr$(C?d<9|>euTI?(F=8Sl@{q`+eWwaoen0K||B5d4n69tzv^b zai!(o>nGETyM1yiYBQUGbpB&@GrO7f{dDa`ONW&Gp*IwdP4(Eq07@O}RM}Z}DSNu1 zsf>mBqDe6Y3{Mu8+BEWrLCGb{^v3Bg-O>Ko?(FsBq<9nJ%l9(9Gbe1@Z7O7^`$160 z?gb$Siy2$1CvJPw^pEB6zDZBl6ot8b`cdK`$JDikDcu&XD@XhMwZL$AvjS?B;l7n( z@;_TqQ1-lJi3N=oeSLNsD{E?fI%fT7q=^_*N6QaPm2XFlJbZD;ATOgcB9ffG@ULeQ3Or2J;I zjA#XNc14;MdE&u*Z<|v{P{67>e2j{S0Or}hyRF|$Hu2{}&)~R!KL&?r5aD{Z?_e@r zre2p|>AR)R>U;=iq>q4Cf;tlmYElRE7sS*2yvDgi5qz$gkvw0@Gds745^Kel%QGx02hZ?zJ@>w>jx7rnpLLnUph% zQm1-PHu)lY<&nQ-^MDBS<)`Y9EZ}DX*n~6lD+TFhetCl$kd9QaljB1u7~Z9Ty6J7a zFO6i>~$vx1I>PKc#)a&&&Phap%aQvnc*SPa9Y zM#j!?aXjK!$-f=;7>#O{vR0aaMv#!cqlboXghJlbZ5jBL*EUrERgb}FQiWNN!sJ)Z zW`Gc1pF#X(++Ai0O*2}q&d{yl@<4Ic6im~64j6xLTGALn{?wp-Y! zx-=A9n#%|hkTkX-raloRMbF-_$Z<1g7wj>h>{D62f4g$MC-@UihgLE@$YtK={BtDs zVQ`Y)vg=9*K6kX8Ie*SzZ)}!E_iw4S;hPXrG71s%f!tr#n%DI8q|itp=g0DXJey=w zy_Or9H-dE+7@^>Teu7Z!r=hM)5;asEM3f-HXi$e1r|Nr&MITGaGVNX15>*%R$dn~g zz7i<W>-wJUdc_2-Qy3R zd#t|L-A93#@CV{!PI`4{Pk&J$7O@HYf#VQXoLWDuwUga3#x)bRi!(91tUuutzIT01 z6x5P^Se`Eb97!3G$%`jVE045?gEi?D1z6WK6&Uw5{gf?PWh6Afp9;`h5t@rs4WRT3 zE3PhS=@$SHKeVte0QXNjDf2kAEg<(`h^=NeS^-l)JaRbgs$DUC8o{lJ3JkLG_^;ubwph(GBnUQM3?o4r1Fui8 zx%2t6dy9lkg~x0XPW$R!VSA?=u})`VZ3{!Y?(3(_QI0|qR&F>9v7U>3K!6axxER45 zE+8l&5;SqDX+1rGzE-7dg5Eyf&ZjRUmvN=1 zbha6xseDc|Heca}t#(R4_GDPA93}O`w{oKj%UuyJ$K2el0o`8Hvg!{ap0eos$?2>1 z5luZR_ihx2O?JzAfD<7x;Sn0srgglLeWCzxSZ3A;SRFto$_>^KBP2Rru9s9*hC0;* zBXq?6MC=!wQ8mp&%3nLtZ2jj04^AD<-8PLmv?ILt*Kz$uH>fJM@2(!N$5xBjFF9HtU;wu5HPJvkiCMzd}k6jLXGvu>w{(CHVpj71Aoj z1<3*mN8|MdM}Rg;N<(9f^YC(eCpdCz2Hzt?BO1VLD+@l)%T02u3&l=xC+K1cAj{CbmnEKOY%4ieMxk`&tA0gu&7O5BWOAp!Qm5L6x4Sm!G zIp2rfQ;AaYu*3uT*|gb2G2s-G+U0@GMuWh(GveT42rkS(4qP`ia!`5iwTH7Hts<*k z>B~$m=j*Sl0=Twz;5`e!2(Za2S?Z=gJ5vFbP`Pf^OI4=4f&QM`{2JAB@$lJ}rif_3 zDWLnP9c|rJGA{1hC+-IuGh`JS?Z~9~x!72v&9sMBI&H*78;xB>M!j~A52l@$om=e` z5CIY?1HlYda9v66=*v)({TO|i3fTrGl+{ioIms8w#bhGhX7W@kpoBHSQc(Mjq8*#1D83 zN<;I5t2^2A<(wMlbNb#=h;YPHK0<6UHNG}8u)74}$jU%!^6TLT-M&%UqJkS%o_BH& z@62#?v!!SCfU6Tyz3^~G_G%T6(gy4hq`@;{qaB=h#fbvPTk3ioqo+Rd9I1;vA_=uF zVQcy|qHm)mT2wGn&ZM!G^6J;Gt-mH)1Dz!$dT17u)UofFu#8?FYhRb} zzu;KgDSrPk()?G;=!`5J|BFaX*7zHH*n;r0qi1lG=*50N#HP@J3YtK=T0|azyiSPM zA(Efm-qO%=B>wOh74)UmHAHA4L58lTZ7{rqdylInqt!X$F8fd79>R)17gp}dadu*d#E#Iv2=xt zP+;%Rn;hm>F&B0R>L}&AClj{C%cf0s1Yx-x_-0M8glMZ3Wss>y@<~8)yMtCQ*9&a5 z_^XUnsH+XZEC>}p6QVD7?Ydu(Wz}lkYmBO-Pd8N3ANK{EZh4ArQ;M~5mR@8}bFj_Q z*=f_QZmrTT>dAN2mseBiOfh+zKD^Eg<|tIJxYKv9b#)$ggLN7TpTG77gPoPxH%v7z zp1u&6vF97SaV{Hb-t@7m@q1G3-i_PwYeLJmnW!>dacfOjQWf#a#c4r{1m%I*PO%?+ zu#=}Qt9u^mKMs=@RycQ8-2#I4DW@ZozBifkU=mM;wCDAg@XKdLU;&znm4P@A+}+!1Mrn9l9=M)dF;);KXkRo55g0IGdPB603O+R8&vYt3A2}U_}r5XN6&Im^{cVIF@Gj6N4W@NR^jVTfMaAH zK62Ae8(Rw$-^;$5X!|UE%k}`+l_NvXV}>{JqGxky4<1X~=_IgX-bsW)fc`4lwlYVh zCIJTN2iTLYmd}8eBpNlACemXfQymwjDU8n&L9D^C!5oJiCv?3#Ge>YNit2#XGmr1J zL|y=WfB{d~ef2XhuN+nUxm0=}LGsjMZLXX# z>JSEYoLbl!L=9422$4H9K|ofzbQs)mQ4SZNVSjJXBVwz>ZgKAQ+X=+t-Tfac7Hk|us*R~{`4ER!d7zv={*;WHp@p#z>KBH6pDxAges zP(9kE4&7t&#*2+Tj6M2KBTC^sgrOBc7KZ8TJi8nY%jv z_6C?!^D#^*SGeCWc^4$Tz4u0N4W4pPMZG{wh^xsLZxLz?#%zi7$Xl8^I*9s!n2BSV zj1$=;olvX`iL5*E!Qr-muxpGGk?G1)M8$o5rNL!?y5M1zWIwMsfb*am1=V|ZwrvxE z@+K0@8>DQ|*O9vi{8hHcf}tw4x%7#iFL!&8Vc{R$b28U7N9!_DFs29nv%|Im4z95m zhPh(hv9eGQYUu}&uj`LC#gD@93aw)_<~X}oI6}q@RWS_oiFMR#stZ6gP{Zeq-}(*) ztQBHFSod&^QkzW4X$2s-}jjyookG z*=eo_Qm>iwPO-tls1g*0{i&36;sz;=i^wFL5dWdNOp!mmLcn>UBsU+llwrj&Zw<## zSES+PnP|#!WI+T3xNRhX%@t{FD*2^5sum_6r@f;n?TQCx>t!f`8G)Xdo1Zx$EhKWR z&+)SDlb4=dDV1wf!w?q|=&?Om+k+EZLdR}P6gY^3cCcd%9@dB@jKkaz1-2_b2wuFBR13N^Y*WhW22|F39CGsAG0(UBrwT!=u*+LS~J=ogF6n$Pz4~{GZL`h zp8#Chf}xECa*50J`yeeHOBckL26N*er88P#%0_`W8R$v zC0;Qi)$#hXVfe&3{~V%zS2;?Zq$o&T{xQJ9PfylWy(Qf$9xqRm2a}<>;#lOuFX$Jg zmtP;74rjrhtM67f2iL|*Z0SCcPfyjRIX4+-W%^eqTbqw+nFd*Cysxyf2sEM|6oNcu zE{9qn>Ypx0J>`$8scvCsNfD0hXSn6O#W#J(3LrGK60IgU+T+@5)+1YsSdC5ynTUSq zHea?q{y?QxxR187HTlPrWQWI2)6T#o zBw84fMa@}+HV9GmxY7o3$Ag1Sm09OL>odjMwTlA1l7=?YMJhppo_hm*Pj}DVvud|O7}Z{NA{a*z=832ra7Q?WV)wOw{UgFGC!i% zx;!BO*gaRI2?*fh?gi*9-&+k7j&UX=OW5ovM>$>D8wL>UEK9Cm&v?nbU@4N3(2CDB zGsLvYGHZud#5bsSZdb1ywEczG3W(D=nXK{Ib|Y*ZHYqfGg$@IfyYjwKg*=_4SsBcd(94%si+IjFwh92pz+du=QCVi}v$%NF2E%V?DNi z4DFn5%{`1pR-kogZ{M^vZi%OyaBgYe{N{Q)%x8!FH@F~KjvvEkBUJ5tC#1%*$qsur zJ?rYbV{TC(Ok&4+GybroAS4IpjBBFUnR>m`{rS?E0~t*epCLmWB35p=jx0d5iu^O0X+wPR4il@t}Vf~Fzl+G0gEN*NKHllA3Q2b;}< z-Ies+P7zvR!YQu?A_=&XennWng^7Xu%*sqyc8&V8TTL0~2Q)714^K`48(}(nkfHNj zyperRPI9nk9xBuc+poq|tGijb48ZQ3^_*F_l4>Firaf5!<10)plP^2P#atC(= zQakLz>SE z4B1i3i?Hpz>=}QLjj?;)rSmCoVJ|f)P6HZsb6H0@u7(|PW5M6FBEq)AOw`6q^34yg zA@wd^f>QY^XD8@{eJH=Iuv>B1H2df|s8ry}RVo zn#Sl^cy@~l9Svp~t|@6d)H>C$A&I(1yYkVB`Y@0Q5ZWJqSwcU0WieA68emE;G@8%4 zwZ0DEa3`{gMr?DD-P~B+v`H=e8Rn1LYt1IKxa*nR^=R_D4?$W*WGRKT?wD??%Zwn3 zKLB0_7XF}!_`w?&&F4f!q6d%QikXK5++`cb`rtucg~P49yJ}_RgwXs7~D(BRFYeF zL4bf|y~6Ss%rEUB{DrR}k+Dckhv>9%--DJ5EZ)sRPxA>vGLuh=Oyf>0waF4mq__~D zP&BY|ZmmLXjdhOGdgzdp_is}MkShd1_>@Orh6@Js${k9ULsdCBTA@O9WtBdAIJ2QG zdeyiF*pcFt95PB3*E+t%h2jTU%ha5mn9CT-2zsKmnpMKcR?{Ol6Zt;-uPyG_a8|2mr+-=pN|SY!wyTb| zuVDE5i6xDpbf>kE0NpINUeXL4mc9%buWD5&8@ z#HMUsQ@(?;IdxL$EPMrG}02^(}MHFGPmwuDJxJ#@64`5T+JMB++OK zu4B9~f6YCQM$SMU^p`dXdBZxE*JGS?lsz(81Reb^%^T~4IyJz*LkjDYO6|I-8VQXhs zCdVs~KBial$y(NHui`d}e4Nx$&vaj}BFoPanXYd!e5_&v!)D%!Y%c+`jW8keL;H>@|jdQOW87|%w zYc|{dNgk0p6EAauTi*5k_?qoaX!Lm--R*fL|3sqsajvY~-|MW?t(0=0ND(#NO|U$+ zSHDCE^=|{BmK;s3wTol~skXRLQ0ajb%0qHy<51vthY`>@8w4O%e5FwmWww9vFDt}& z6|@YU=Fb`k%^3`p0#7$jO;O5?(E*wv!48kYU+|TW$CyHmrLXysk0i+ij^_gv2sCr(huY4I_HJB#o8b4hvD|L#^-ydZ3uC zV#j-L+t{hByIY{$Gfzl~Cf14hV~=VQnQnyfd85S^aNI@o8LsX{+gCkjcDp*Br$;te z+Bv=J`^rbuMS%IAf&#;TwI|HTz{>vr7LKab|Hf{P!Tvi)5oq%%!%=3R$k3(AStKHJ zAh&m#!ka6+2Cm@NE{`P;jh}A&>N$+XlhnSjMuK(vi7_p~gnGTjDc_O&5diWf93%cB z>p%JPbxiv9(+wkxh$cZ0kg0?Jz+cuj=Wf^d?V5)6e!<7a2c|gAK8f5F-Du0}^HCR( zq-d~iZE@Ec+qIuZ-Yy$6N(Y~RyTH(E%m$5K zAnv-f=2(NnGiJY<3=yr)M9BYkptRDpK36;A8^o6q*l3vZc4uEn+2w{EUF1J}SkdVm zM)K9_57V=wY%2ATGX0}CJOP1TrjA~E)RWay_&{A$T_v)4BBK8CmKoaFQnUSYio3KB z?i66xFXMheGr7V7sWy#z4PTKeble4kWqbFx?JfJ5W^$(CO=r=?MJiJnR)*7Yaml}{ z!^9p4cxqL}XnPv52NB~3RrL=X~v7XWcJN0i@db?PdE@kB`#=$;{@tU}yIC?fhEW%I7ql9NRgc!c-(w3_5A2VR*?ilLGL4bxvcZRVVgX8(!RNuWj#VF50ADDyD zH;B`{dTUV|^5t9;!oyKfv6y-njTS46>1ZZ;4#L< z$7Q(EZxbAupkG$CTH>s?-{O|v;gB@yS*-u?#u&4z^kP*#ZsAJzE4et`0DI;{8#y=W zN@8A-k=y&nw0N4dp0XEfk_bYkHcx~Jje{`f54PqJ8}?sK=5rpNs&Jxaa>2cUj*C#s zK-2-27$0JL73l(uV4bdlKWiR`X`bPC#KNU_sjuh_g9|8%2&WT;sYqZ*fcwad;bDt} zx$76EdK@1!gE{Z!N(7)BIRM2RU-tx#=ZIvZd4+6~!}^LMSsu=`l$jhvL*wfHR~t8V zPIP^8@fN5K7*g&nz$zg%S)_m3M*PPAAWFlWfEIkx$K~~swkvS>)?sb))=1xJA^AB% zo=lXa8!4hdRDdv6fhf*g)P&9PRy($c&PPOs@|3t`P(R$!xdYAS2~ubbLgaIW9LUcZ3x?9NU+1JU4(KTx@9yf{m_rM}u9ijvfHu zZIkSw+4a)cUV?jM_yOZdz25O}A`ETx)Y@3>fDnbWI=;h-S@&@%0+X(>YcP78LP=1f zG32EvEbw95sEG#s?GBPQF-$axjdPcIq@*%shJTqoBPMns*6p!ApUgqAyRk z_@gwEK@7|culm>G&Hda%gj3;toPXS~+S>z^-PWq&hgb|6W~8y4c?@)!SSh|De+yp7 zA$kHutz?13`;Fsva|0Z*NQI!3L6D@7HU(nXjqdOR0ZOz&`?bY&l5^Ap*vg!2f?nUE zloO(}L-AA?l=MDWZomW@Ofr9siGEY7iUG|&?t*>s!lHK$wtKDW${F{N({tXa!B10= z_m;s3m!s;BSE-?sKz~fYt`_;*xM!UgbtRnSF?n#%Lrqad?vP!u=!|UeE4}m^4~act z1Wb3eYgaK_V56hIZrBzTdUFL^mbMdLp{X^@=E|uV(@1~G%9X>s>tVmPFqkplH6xG z;LOB?B$x8V%~Fhai#d&%nxB~EDP5d;?6Amdht{E{7yG3C;Z5d(2ca7I#yv38#2;c76%>K}Iorn!8vd#?Z_tP{lXIa!Jm zWj38x6d>K^h4|QvlenLUO#W5)o5(tVhOu-Tn|bJ0^{rHlnY04Jaw49n7ax4AW`z&; zLmNc9)@W2c8i{n=@7V`G9t3r8V32}N?HdqwD>$lb_XBkOo2ufF;nZBDI zzL}rFdzL$w+Ljv4D7jZi+~F=#9mL=QEwnnqgcZk&*cigrKBIZym`UON>~vnldr4)| zee7fG=5gIGFI}w%LpgmiYhbSLDOmlJK$bmT(qz->Be7}8P2tjzrf(V8n2{gcPeOvS zV!Tdf#bAhO5%&8Q*{Akcd8Royd#b|c(9CJQaNR<;Ma;`vW|YdLmzjo}!xxpkrg^?h zJfSJti4Wwk?@Md!sGxudcl%zC%+Qh zL&`Qp%3!#!@*B~y->JI~XTn%N8wvw|+H`#dUv!f_sK%`2zOUUO_zU z3LVL*j@cN8!l)Xfs30hkD}D$6wWe2=A$cJc&=EwW`A{s7P6>ZkHqukAz#-NI{F&xq zxqm0|e!wLoo9X^ze)+Gq!x`zB|5tuVR^R?dog@4^bo7VgNqS1+0s?)F$>427Elxg@ zCc^VPDL(tB;71yT7>iHH-qhaGx(LK0COeMg%sbStf!68q^?e>d(gpDC7bE@<**>m+ zo=$w8H$Mp@pD56FEzcmOlO52jrMGVUtok<7ZS*^>3Sf`+B+=CZ7bpGJP+eN3fBdTm zE!XBCa!Mb7I2~qD&(ge>uHGx#|GA`2(#?CIN1BkV`ECJK5t3igQi5OgPnqy_S7XTp zFKVV+Syfdz0<9y@cUN6zrh$yboLWU(x(cYcx;N6p{^+-M_oy0R57!9QCy~?PNYihm z<5YBR*7dcHjOJjVIH9VZR#I6BNsTa`r=eT8;L|YKY`V019SvpX`o@7tqTh_gzB+R;=G$nqrJy)%+B3CI?$2k_teMz0RnxoYRvt@s=}^JFYYP zw6xTd#Gy=XB(v2#J<9_EW_*-!Zfv>&AtXJN_(xuZ$WZ8g!}=)gqdmKf6H3cCI@{PO zxnxdIYXUcGkS92u>}C4+ zO`~qJn!^csqMIYtohXwoqQ74zzj1*u$t>obRT9}`jePj5?Xus@AiN3>C9*GAkP}p& zGJJxM2R{)BB%yG#8w$k9u(+qrkID;U+Oc1v|vY zl|`&t80e}S9Iz+C~@fxky9hdSABE{ z%7mL&y!jO@w`{ydkXY=;G|qWDhEq9hLQOaEQXX><3)W_@2#$^v4p_E79Cu`;eROJy ze|NQeg6CPM;xtWhw(S6PwOt3ccMoot17$n|-x_P3a8UAHT-tOX&&2dHi4`u2Q*-C# zLab>rr6XnYYiCLfck^;#9a}u`SDl5B~lj20)04c z#Q=G}+)L*{3-^NfUKB%{J|oXC<86g!3;^6FvhxDV+rWvWr~KS%jV<((Xa1Ofas$O= z83}UT*!SJJG3QhCOg!Ofpa#;6ejV&OINr}J5R{S-H9BZ?Q%|C!MM+L8%7v; zD0GfAOh8^PnpOls8eOW1d?guq06&Q4LmtJ?(b^?(y%5^da81$wkxW+Gy2fvzN!qM? znRRT}Mh#B%+sr!dmbc5j6UwL4`?GeL&M44p8s}^+YUQU?isx=O#_c&4UigRi+#ef~ zN%-~N{^*W8TP7M(eNl`34eWl6g^9|pAmh~NNW49 z(8Tbbw4fghwZlFfAb3fE_4$I}o4WuF035=(#I%Ye;n4SvLo$@3TFD_vv0a*jk1s%6 zT=4r>$paW*z9@vzHPCYEV84q1NG4H@(nnak`~<2Zag2K?;c(1d9qxUMbEIih5D2O6 zDm=BG?RrK3(qTHSy}V%p`~3R^iqkud2{r910mV@)<}%3cUg&j7NSx-sLZE4ltI8*yOm+Q1SG!ivr!f_P!f=oXD6hraA#ku+YZ-F1Nt(m8$1Dck9R z4VZL3&dp?XcewfLj30X--&he3;j?-M*-i1wgn$wkFdAwlKQ>GBCYf7#n`_RRcoi%< zaagium^1FKiJl$7DA$=|{EEbD=bNPqP?z;>qlzu9%L;yA`O@pB5qik%MbJkVQbi>F zRoT-Og9N}vn!kT?AX4-D1iSmxCS-yPd8=UuIAG?DQfB^nnD?1jP=hXAKqEI~<9+kB zrMG+X6*Qt3!#`#_f09lGu_mUT*ZEU;u@`=J7zg0?40b=td~ zqC(%RXIQ*qGJ-j3NQzvpGa)xlw=YMJzL)PR=Ii-6vRuO1(BZ+frDTC04=(90BQ~s( zm=Lqjs0HcOu#@fiO^Y@@EpPg?q8gwZ^w|@n+TETZD*%u zXhm{ft_aDE(>{4`XQ#C7@apjW`B0Cre@FzpA%1+2w0%Z_Q-(|w8}>}G>In4-X%`9G z*1wQbBpN>6PxJuMxMv&zTkW4WU2kjE;{OmyBCTeEh` z3X&V&ko3CQ^zz2*8casZwp5E*{(1y<)u8rit(Dm-^E)ziJ*%*6M};TbyIZ&SUy+2< z@yqQhQ&p_mV~wpk`N(qf3KsCy45gt?M7hMCkkO4cQb_>S{nLWPME!bHlIBiLOf-ZZHn@YD68q8%D&Epfbs!s%?Vz*+@ zK9+Ug!f-02a)h-_-j%e6x4O@z;;*t66{msh0AQ5(R%PaOp*`XjcfhGt*X!8{Z1B0$ zKpR3m^cn!)drk8_uRCo89867bv@4x(20Cpk`#%?O)`rC;Jif*y8ShwG;Q0#uY0@MeOSO8+)r)?$rrmXPzR_lLQ$v|#7u1^W%PB7EJVdVTBsybdk^ zsB<1n2C2blO)~1g@szUhl(R=LL?Lb{#oYdJT?{vYnX37^{fUIM!aYe_qV-~L+_AxS z9zX;evPeX-aCnJ_ez;<_#ZrU(mVR4JcTBctNpV~gB5{NQ@@6{zkP!VT7GY2$p~~fib0dx)tzEW<(uL;^H>ue@0JpS*fxC#fVKP zx`&FNkt5#TV7J|#ot~E$!7=%~AMejEJTi2=y*}=SYOZ0()OW_K z4rc3Tdxm}&>E7N?dS86Ae7!z!-iBeh3|HHpBN2{XnF_kPA#VbiX`x92Lh)$;N712F zjqP(x`VCr=(E8FKUiv@x#N@_7nibLqION5r8nz(pwh^~9^-W95-NBB*047fp(f@qs zd7DofW0)yngit;V1EkVBg?g~?`&IO#DHnkF=!EG?=gH}Y;lk%YkZ2cMWnIyJg@v<3 z6qa-%)h~aqtwo5;C!+3=3^AQT7aB!KCIT7S)&;iA%QTllb|n~Y7XmalP>Yr76D0Ic ztA3YQ7%!|1PT*5eABjqx@Dv`T$ihzG;>A8yUwtIu;Apr}2I{DL6}>u%VLfI^I9Bp< zt_XRrz}` zwQw>2Wl>o&bzRXACW&Ms_%&mxDsLWKl^~MUO@rAK)nM>DVaFz;`~^?0r#qu|m~~4! zT}qWS$BQh6CG?o69che6nvEc4F$D#Y?%7lEVP#A3AggYW61WxpQp~c_A=?$#DaFSQ z)xjOgV`x0a^P;HC5wxdvEc>0hyy_$d)sI$BH4!cZNwV8p?gtA~17( z*%o%4vxFy7fD17uV33(aXnWDROOdlS(4E+nWhlK1T0l&3!2fNOK?+>pUoeiy;^fqv zkHKo|WXKq{4snH(ytOuxBa51`t6Qq^1H19L`g1zooZo~n+^~Iy&%w!Ah*E){S$1!B?VZc^w|pQ-L#b z9wyP;CW*pVW5B|mWpi6mDAQHFeNhG0<~OHd*zlM72J>nTiorHv5h=V*jVOF(f+m5T zPKWFppk-9-o%)}uvmrsE4>a(hW<$Ak?xCOb!!TW455xrwROUH^7Sorh(8R!iyE4rZ zVXf6NJs#{`(`*f5!YC!oy-Oap4&q|}-jBe|im-0;^T7x1FQ)7C(f++QG)02j|*+fdf;Ssj)D99pgbc62|!n2G;{Kc#tb8=O9BO>HG$*`wWRNEo$Bi zcnopM!4o)~mSua#DmWqJ5o-NefBD|vS2PLUv7Pq(9-6M05oF-XR&b$}Ni@WNKjRL~i0xp+Q8HkeftqF9`q1 z7|m>ZuWWB&LX$``Jq4h!@HsHyLI>U5$CiE7ypsE3YaIZ8jhol2cXn%Pc*9WS)YFr^ zoI7>y4TqIfCk&mnzNtRmb#KKM^+qf*LL=?c63K1#m~-L25JIsN~}V^naeybSfA;A+P@sm z`I(+BMg+Z+gVyeT?#E|X}hjJvT?6j75auJOJ~u1k_|NZbIbh? zkjT=x=0ADXOru(x(fG0~k4Z-&m`Ii>Q8A>D_`KsAj>a)!Ey3*G*@n6|!r z+~6LLV6z+$8W5fube{;KKs7U2EUiov9}Q9Pqh_Ti%u%T89;u#PcLVl{FO;$L#x61S zUT*i)8?SL>;j@RYFX_a1MN%n^)qSozD{LwFnM?_HSSes4sFl-aOs zIui5!wPQ`3{Jp;Ly)>={^ zTHAa|Ig8`OPzoQcXrpt!c-uzm?>jh(@rI*dmz5>!QrkD@y6hGXi%on+#%|gB zhjqWCd9l*_7?c3ngL?+^kY~qE`&tHiY$SMOgnXQxtfVB5e$`R@G-4d=l|CgEJ9?h7 zUoEft2=#yh*o_sqkr+4cB7qA?V0tanvlbP#0>IoG(Oq52d|kT zjpZJ+FtA5!%@Z>JO!pS2;M$#D$E<7K(qiszm)qmh$9W?(G+w#f!O1zFoLZxJr-#S) z%lXH3uoldPYJY06Q5tIfW*C{4b!^<6x8SApuIatcg}=%8gEZ}wTv>?RO+sPkoExCX z+m?=^F8dTv6bQT@BaZjk5vVaD%W~8Dc$Vp67K#!FG(V;KC@2U;FoB=2&bJHt2vRhr z3|4^U5{|YAg8PJUJ-6DFykH5l0>An}5`KSW$!auYsx^C&_WS2-CB_odt{q#6`!mdzRNDvK zmJ&g^y3_z6G`ZaQF99M9HwXzOz)$&?eRyWaE;DJB@l3-5c0Nte!8;?x61UKFQKms5 z18T!rI*BAX%`nUhDJThEm*5}Tz?n6cl2z0_GVF&FwkkM&i!gbEq~a3Su-GuY%N9&? zP7ksKmyZ4}wa_t+7_)4R#2oIuKQbE1l?at@}J8*L}SA*p>ut>D6YLr(SI^{Eb>+JWK z*vF{c&seG6I4E5n$H%=bIV~mCp&@L5Prq~~uy=iopYMK!;p(KY2nCU-D$T#$M!&&X@d2SB&SMrD4i^}O;A3%^8K(H=`Na*+LaQ&Ov}U}70w6#O6i4*z=o z^e{>e9xh?hc1Yc8AC#4=u9>%rNijTa%n- zVD%!4x;{N+8Z$0ujTG=q3BTUL)$w1l`&xWT?dQx!C7C>OYR)lS-PGG?O#uBP$kk6X zVLc*WR6;>j>L69C9wDakXSA4Fj)y9ZC(!EU^s|G3KxE&Py431PL9Q~|OEoj9v59?^ z6n&M^#NpjeX~05369{4#vjP*{#R9U=8~x1RM#)M`GH#n^C+X#>E`91ZF)+mqPcpTq z!*4m9({o>`aTFTeRJIeO*tJ^+(@kIYEV~SVT#GhmOVneoFLJI}lCT4&m?CzBBLk_l zRwg{HAE~nd7UR$!Rh;}DntJgNMR8wXq+DGvn%ZFq zX%V29rKDj`jdUKi0Nwy0r1_5%gLd6tE=#l)IH)Wg1HarF`T;`+Ytwo2;nu|nK>luy zCnc{CK@u}1nM_$Q!k;5!KSMdvH@oC|LcVghXY?p1@)!}_A3FdNCjF0WJK8jAo~QC{ zq72Usq2>((=8gix_tnki-QOp^sn%qZ{}^xnt2tjL2A2OtDrIYG)nc_G{G0RrGZ$I| zWi_~|o5qbSi-~5DDV4bh{Rf;pcF3`*uBq~>#;_CgVUuf+fTBhkCl{5Knl^QEa*AzN z`)pZ`s>kpyv=$T4ciqxc+uNu0<0x6(Ue&VX{o=-8coQYHSoQkC=2a*^UH#YXbu>Bd zpTZqd&**m2w&&NfJ6;jBWLM!3e)lUHQx9hJaLz~z#rLKJ>G{V;-Bwu3dRA<+Rzzva zW<^fdUOTFPqwR^bszIT{y4}GFQXxXIhE0Vg!Zu`Gmfk=KA8KqW`C0{_Rucmdr=luP`?t^c0yCKHCXLZ6?L#}hkO`H zi0_p?wCoTYi^Q2>1DtEa$I2dp?xg?sruz5ECqt|;yWEqjZ)}l!esN}|gli2aI*8^| zt~1<&v@^Ri-xpBM8Cq_|wo|gT8l6gG*^TD=u~W{#Nd=8=driiz6EOZUqLV>DD}t$( z#@d^$hDy~BTOcIDf^4w;67QaduE&>e`Xvns%htd&|Lfz}L+P=i%`szsKdcORI%40S z^Rzp?{M1+$j>x5m&9v#M0MGQI{q`e!GdMF39?36k>wVzj{M{w2le8ZPs?H+vvvDzi zHU?}t>{NM93M-Gz)03Si3!Z!+?~l%!1?y|5%|;?KWh^*OllwnOeGglr5>AvG{@EFj zpP^VfZFpK!)-@D_QOmJ<4p31SAIuZdwVw|h*#Z?IMt8T}-A=K{(AiHh3(!g_j?rQjM z_(QuQ`&#+8-Jj>nRC7t!wNW0|zRA|@eg5hl&0Vvvk8Nq#P&DjFB-q2u;5qTtSJ`FM zp}*liTdn-O;DovR)55c{KkMI@@0SIrVpgH~tt6J!l)SB`MLVtAU8O7YDSRIF6~Tby z`m)0MS`!&A&wI)Vi~d!Tu+~x|2O#0-=~ciuEjV_>c}L72-8rpIB5v!hTAprr;G)e$ zWmjB791&En#}99rY2)!k|X&VajL36e`d@GSqkePiY!ZSDKTQV{{!wE*)?6G^x z!}-e9K;ayz^A2l6&<;S^xA*}4qTFb1^^+yW1)6cepjx7Gg_h~N&4_*<@GjfTa(NX3 zzZnG=Cr1U8!7+$@ubW!r2_41;*d4Sw?yicJ13gTmi~YRy(vt!nvl^m+w&4J(4UA|J zOEbXCGkk)cG3q*dr6?xNe~{g3w_Ny{RMuHN^1}+(6Mh^&5%&s)IxIkeed_nZBU>mxi{F^8SxjJQVNbYlWC zyF(9!NYAo^e{?I+iu(9NfcmZT3^x$Vx%ACbCNw^RC7T~aU!MzGZYRJS*?E}(uAk^F zR~V*U>T6oeOCu+cuhLfI9qBJkFbm+{X4|0quxDtqn#RNu`MCy3`n^slUxtbpBB73R?=Xvd|uC$Pq$el=B|mMPD(3Nl?wNi7Rt*jqLDU?p&_5{=|X<;><3|fUOc>Z=2G~OEP%^z=O0=pn0Y1 zOPA9x4o`-k%#IJjUDxw?VJmpEL?e0Ul`eN&1lNWuiS^;PD9EyHkrI^*19TZs)IlAT zaQOkdGx|nc(M8W$7=oaIple ze`sMHt>A_7JaBv_;p*Af&yFK50V+A@4Lxo$#~SHTkk|#l!wxbWp$(MAX%GB&2!UZ7 zO3S4-Xp>sf!a;umG6ND@h4@^MZ85>~eIRLUi7WQ?li^_K-NJHaY_T~+w1MOcTo|(B zxf`T|s{Ez+rF)86WKEgHE~^)Ma;RV03jugT*>Sh}A;g$;<}yqO`3;t66~u=<$3M*$ zQemTJnN-!Ps*)`JxUkuk-Zb>3*o&^<_}~keGIvhLg%KiE=?sJibO6@l6bWppm3L^6aM<6?H-EdZJCKOt8;4J@B8WbkjW;G*x?p$;v22gH&H{FA_ZIY($#$K5xPTAVO+t>rY?Q zz~d0V-1aMA=L8H%NfH)T4SWr2&=l*6=dka-c|1rLY2En_U`{Zz^5ryiWElNj)F3S-TM#S!a4G zP=mybRQCL3EY{A}ChFxq07c+T=12FCP1PTjf$0nwr16v*Us*fSTHBRem0fiRDNb{FDMk5qaOz zDqQ~9q~YC^XNc?Sm%I#aLtM)0cenQ*c^=H}yYMOa&~Hu6G)|6&dZ)fuxuHl$-2rKT zrZYl2$r_0Pc%>sm`pM#ow=Q{;%nA1oi$66>RpuURzSE>QxcIV$tRl$!I ze2^3JX&iYfzsBG)^CYGuIPTf(#w5XPz8fqLUG-w1Wl=J$2fxoE{pSgQ;<+2WGRE4f zw8ZeS@<}_J68UUOLj2vCp=(XOLIdh8b;p+d?{i_L;=fk5XVvarWs9aY2otSK?NX;A z_sQhmiNugOAb>XGY-8=pvxM;!wX|HkhFgf;{|4w#qOH{K z-O>*579Ki%X0H8uH^f+8$a@15M6W%TgLrPN-RVWae;-Uar% z5cT$G`V&FZTINfCAcZNBF+8GXK*%X`bVr)&(gA5p6?ELIk*>-o5Uo}`6qk55iEv4HID z^DqY+3iMK?;T3sU@!n?j>A}dd8&{4|qV}*H1#kLyn^|bIq85hf-pbs$+s)VSr3w(U z6%FMsRk*DctB3%XvdlQQS917KC-ej%i9qq!N^JiG;_wSmG}}iLI4#G6CFfWtT1&KJ zCw)wvN&tS4wtUkj8^|DegQX%|p&%LJd>oxsF;z_ zqb!$+FukZ(Ln_nxvo_{_Kr+$fJ?dzDd<=g%KC7OZlIU^1qo=qbkbZGx{4-3$s}|I5O~Q@H7O-3`kxS;1=de; zdU`<&SpS1y2=|P=6Tt-Ak4{W0DrKV^`m@XX2D_RDr-XozyZ+6p^85jcY~g4?;WqGR zFBkTqip)Q0W!?I!Eg|X3&__CZIE9w}OX3V4|dE z$jAndvelZo1KcEfO1oHf=2_8*ALk?O6(|8vQNZNjtV$EbV6E`!fWK5t6-J5?(!_BO zS2RFnkXQy3jiHkTJ_^an^wIWz@jc(D(D|=4O(oWvX$v?~R7K4*-N8AcH5|VTZ zY^}bOa0;)K5F3lhc`w{i6oY885^G>FLPm2}mAEkPG*> zFAR|tEgSPq7JwB*=t4rIE3xmk(Pr4_s{x>A0(| zRmF6LgJ*enJ~~_MoWC0E3fr^i3J)6f)n&~Q@p-s{o=E!8&!IVi0cJe6O9{RfA8b@< zW~UbOUEm-YhaWrYy0*~|%S5%3t}GFa{(S8p38zzfAa7m%Ch$_fFo_D z+k2fcfM7yBpX>@7{#+p6{!RTRnB*f1k&|pT5=T~-S%JWd?Wr(hd!}F3nnrJ=?r@0a zHef#gs5wwi>wn7$>&3i^wB$b6QS7tR%=(yyQ&+=MUJj~Z1xTlWMXv8h5Byl;hO_ZG z+cZ6LdPeTblLpOC5#EuER}Akbp8K1;U&>qNZ4jy+Ry5lY9BsxN)CC5JBPQPfj67$W z(`sS+=!K1KCWF``SQb6GiaCg;;-j>4y<^)ZaV1<0^8WrZCYS3d3Gq$=g&jX@!i!%E zEA;#-wu4mQ3zZFx$rL#h~=p=L?dUy)&3ASo;5{*D1% zA2dP&o9c-+?-Zgm*F@vA?O0~^w;48a%TB+Cgv+6wEEp7u`(q|~hk7MBg$qVgMI*HG zz{EijER~~DbXqw`X%yvPD>77bgSOjpM!X!3^MUw>ooFFe0OH{qE9S zu-2|k0q7QmIABD1{+hkAnxnlTZQHcPiiy!p_>$jm=qb^}@|;?sJt2f;joOtY`TQ!p zDqcFoC9I>(DceX zG5>BzOpKXCBAz5$z$0E2m37^3D_|XB`ZL{QByjo{em10~0a{zUVNNPaV4$m6jWm*g z;FHlV5o|{H?(}U4lVdalrL%3b4%+LaQ-gJ@I}E{49CWbkKJ?Qx(NLQt=R;kwR@*uW zc2`U7BXmWLgFlle{>ZKD=;--bQSOnl1&FSBBkecar}1MalI(EC?v@sJ1RoMU?P%?( zrb?fQlEWA~J|7*WV0^#7yZ{>;hGs);6(Jxwb^-w;(;7s%Ol4T?e441?)oLsC`KuIk z(;l2&Hf%0Ka~JqVwKW;LHF&2eU*h+-Uy_eA+=1Jjm3j?pFF{{yUg(RdJP{I{3V(DJ zh@jAz;+%w-=G+~#dM=tj%3=;mp}_B#OO|^)(lY({YrApMMIA7MD8_YXsR@AlGXVe> z`*>X@o__0|>Sx@*##5y+8p%3-TEpJieCriAFJ`D7(zG0h38S>D~hysWPk z^+tO4GVZ;oQB59C(ck48ACgV8>obsz{6n^V8-8%n-H0t{1xiwg zRHFD}-1eT9$qnUmlDPBS>^dZKuUJK^+jFFlYHG`E17_07M_%xWV>@oQn$HlSd#a~B z0xg=xNg}Za=}YXyksRv+w~Wg#%}XZvp_WQQ6`VSUZN!~yyd;4Zcd|iUW-+$>hZ8=x zcA>Q)Fq{>eMRQSE4NZ;PaYO)dyqUhibgWRZ&l>;nF>*HVQB)2bi|;2d1H6= z;@3NV#f+LLP{)C(Mywq>+D4$=JJHqyNkp&Mok%P>d!uUqdgHf``q{Oz{afu%un;~R zm)!O)4?Vb--(qFL8K%77d7-)Vts%MW?1)pdo;cq0+|kC-j*c! zb7Q{8l})n$R%+vvQfOpayY_u_e$0F=hUc}H8rz$SELgG4{q`Fi8ZhnQ5dUoD{eXXB+kO4lO#Q!E z=UM(UQ;%raI2DZ}{^aTvI8vfHlQc|Y0sl1Hol=$2dZCTE=^c9a18pfIoB>>Ks%ZUO zpXcHtj0chAv7z3oG6WWsm3^LI~l zVMLiqzcoagrk(e7v&TRB>HXM@g1)x=xnte+c|FfNeJnv3l$uNi{TKeI$wNUUAJyajNZE758x>4V9wfSn?e{+E5(z9WK_mynng|=kh2fga7t_ z%)kSgp59vKkg&BUIrr(1%8nwxree@~x#h|290BKzTao=jOV+W8at1s!lE6Amc-Z7x zPrx{4bBDc;O(_=*g>9ZIw6A}mD>9T2+ z5YV!{dB{q2euL+o#I2^ObgbS;v^s|dGX+p%5*fUvTBB!qsw|eB2(uBvwZ6XxZbvp- zsOi>O=Wz27YO~d+dod82;|x1h$td~prYO0aJwbe}#3Zw)>ylf|BGhWnCMm9K2V+UW z3)wFBINniy#`Nw|*7h{f-RJip3r|AE{C&T;5K?J%QK9yexL}owtm;U?jrE4Hj{@d- z?2sq+x={>t;zK!Wv)z;+`@XOgda&4`x^3K~o~u0}qcscE0M5I&Z_bi3;-F1g(^(Ls zhxoKPoUutN`PSj0ql)bAF6nw9VQMJVnrLxQX|cJs%hd0Y=Id-Tzedn*U@*u8#8>K) zHmP&s4{_j=9zus07$NCtt*Ck~wHXhRA`RgA3!y1$Q9$TkWRc{U@@`HK*Cj?=flh2( z)!o3ye++9GbL3*EFJ@Pkp)wZ_$4x`URYMsSW-Gkbikw5#&WS(@Ap~MW-g9a5`GmSH zpzlJaDF9yADx!#7J-7EI9mM>ZUB?Lhxs8OIzUL-T-ZnA&7-v`JE=FnN;W}*Lz&%3U zpGp{g%{3Mu8Qp~%eJJ36)*ofSLGNKK4acTwtia`1iz5(RIWF1c4bR9Q0$>jGEWTrj z58oskqhk2Ho=T6y5XemhRLlm_F;&c8Mj(s~=^yV#1LV5a-6Z{}FJOQBw4f*)e?-rQ zeOwam($zaV)!fkZ*IX5b{LppvwTCH9qe;@5*ylE}wgZpKVlN25IULL%Xt$F>mhH29 zOrcFL^cIwU=qil@R6WRgN+2C-MtYyqzjuy+S15e0Tbv=f`N1~>+TOe;kRNE)R?cFu z>`wp=IfODaVKZ(19zNbd5v=9q z)uugKEkvf-GbddDcs!>9C?OPjb*oDZGoUr+a`LDspyEb6`~$ed!eV1Cgm+01;`Ppn ziNvLTiEtX@ry#I+m@N7zf_!7pb5Tx#SQePHTP{rw$*lgMp0=q_?^*xS`_Kp#AiJSm zfrC4!FZxqud=_TXQORqCV+2gfoCX?_uyUL11cUJwZGYz>P*XnEq&A?9=(L~)YyovH z|N9Q6L?mD)mVK!JV=8fj|3_tq){is5ymIP~<{yoq=4gu2k}3m+@duoL{9z{IiL@w- z#i;Q!eZ7WP{QaHj(yB&dYamu<8j3xgPkxrf*2IKp)w4MhlHHYYW?<|6!!mN@w<=lW|5^vW$MVHptt zRDq+>T!`S=D~F53;re)Z%u?im{QKB`S5OCOO*uf@2n!0o+rE>VJb$#%7iW+lFJ$B% z!Y{@ur$mEy-g4@Gzzadh9xft6nh*Sb;3Aj_dP)|IWMy%UHP3T!b31(n{ouzZ-Og&I( zL*N>tn*nu_HrN^ZbD&$&5*zUt-VM$Pit|G`;#L;Z&(h1_fSfyat2J3t7TSrD>oXQL z-NpG8=7~4+HH#Q5-0F7|JT^SCNz#P?mYISI+sC=m12;3g^4NAxP5s@gCnij``Ym60 zxOc>6cOMkq#{LK#f7a0XStf$0YO{Irt-`aJrqbuf(Vbp_eUSoO6&CP&UAYn1e{=@? zjHYzN`2$$88x>Z&oLs$YK?8g7EUARd?+rq*GHR0%XieoaX9iLUzMJ?np~6%*h_;_> zwpTO|-r+e%Ao}KHn^-&)k+(OdD_n%0Abu*U4x39TqKBQ|_2ASOYeR657W4y>--XT? zHyqx);$-c!yYnMDmNK$@w75Q5CH#!1GXph2V<*=*tJTReyD3Y#beZ&vZ&O)e9QrEQ zzHuo26VZfdxy;4Z4o3$Ek;`V9R-O%cc z5BFAzY3&1gA~Ld=tBYq{RZ`iF9U$WaaEzHLBJ-+qB!3wR)WgQ3t#Xh&M||wM!@2o# z9O==fYs#{P?jZsF&qqNw&BMv;>gh?aZw$DlGj`TW+0CN>&y``NjSq+lXU(6W(_@0F z99?W{=ASgv%a59zjlc8OhoGiGI*s=FtuM2X_XLn~*gpbSVuYOf?QOq$Lkq`+nqw!na0SCeaxdvJ-nAe8{QfP5g8kVnBmkJWbO*gPSXgTCz-GsJLNkeSuxbTzXF zx8rxf)=+vHL-G-@e<@xjmU_&us>HEhZLAvJs9@0^o_f9~M}j}A{y-O)AYL5nwV*?< zN7QI1EU;jy*3vD>_*w0kZ{VlPC-Bq}MWF=<$@GsVBNnZT`!y8i8}LsRaad&B;6}TW zo*=lr-QSacj~JSn_YApap^@ zE)#qc4s8N|57tTgpjsY2QqG4(=Pf63!(EMeqR+bt!u4p{;w?~6!qm@KXQk%8l$;D| z=u(_T68eCha`L%{ZL9Iz^2xGn5uAee@d*4P@jPBj$oY9C zDzyJzTXg%tf!!dD$|y457~zA-1ngQd{#_U4b~P8DM|OZA#SROzSk2aiX2?H*tO?Vb z)-7>CzbMnxBa7L}-&ff2yJr_{2`WP?UV%?*^7}gPD@bbH{ckyu>3J-P$`P)?D?-`9yv1q`jk5Iz3^V^+z-ppZQ_GQrW2@&M?Rr-dCREoWun06@ zh(<4>$TZ~P&4kVM!9|D|%7-KY^~D3Y1H#Db~qM}9DtMxVDl{-8IqCX6s?e`h+Zs?X#1y$ zk}XQF=ftQs8DG*on4Z*htEtC~!7h?|&bHNUZrcml0#zuv(tNjXeZ@8_9XpbMy`SGV z#b%3882&H5r8N9T5kjeaCIUKnu#!cpuewId8BvCSj?L{=IkOaZt>tI;T&A^}f2ZcF zq|!Rsha}8^#{*@K9QC&a>TGK3<1cNM0{($Eyp~k#3m{U?AV^e9oy3rg@JEIwvrK zpwT5p;MsEsn?tM^YqFkbP*u2koiYaCDXRAdY(=V7nFeq8*#41S`OW?=w=Wa-yaB|| zntLfLjk}@c46*8mJuKxZDAi@#p+Z_``hOyLxse&cD#LV4#@bAFZLTbPpgaR(w|JXd zq&JZ-t|7(reeQZeDkCDdd|I2oN`R5|Ra9*j(97nRT9QUAQB&JSDw~wRaz~{AL$rv1 z$b+(X!~Y;<9o`CUnBQPqw@}*lNZE@97_UDog^-fE@3$ivoVRI~c&fS>ft#F~J~-~g z!NNGjR2+8-HgyCGmk?xn%^e!dIVM|T_1Zj}n3?Sw4(`;$;6geRA{;qh9hk+E%2zHw zng1(b{p+!j;!;wi#`g-IR}5{>nP$b=<0VwsxGI|4A5P)Ex;$^c;mVS#t*59gI^ zpr_mB3hBk8qF5UPliEF_lm4vIDH^?n<1z|Gul02z7&_O5<>$t!?>D`~oG0NHX81I7 zO_wTB`+lwh6sNjLn2lLm>UFZcoD`p=4V9J#uqYI-!12-H}Md8wWH9 z7z(8jO zyqDONFx^!v#*qnmG`cMQ!pohtK6Wri2qlm$NCn>;?Gob-$0h$U_avk&|9&1)+&(>H zS&&>9*UIKq|E#qu0R}KqHLM*Ljs+#wYo-D=l%NS?ujtchrd6@|Zpf5*MLg2?fi!t@ zjtMh|EP8yiB`u9p0L(TVLk4>jD8#I{eR}ymEv5Q2evebeaGy-dTV> zTB5ilhr$lZ=rO<%Z6qg;g%qn3iaN$&a1N!~!Du}3Lj$d_*LI7+S`k-((Ik;`o2)6x zMS+zXR$EYW7j0$XeT5)d5|KyT6&x-(UhhG4lF|lP#Xe$!oDTa0G&GqbMZs~xrL;I? zAP8C`P9iV;BIF3oaDtC#aqk$GB1PeiB}USgqg_|dLdd0sG` zC8>NvQXw~IRL6h}ISD=AeEmY`64C;Dx4Aa)Z);+KfS5weIDkyxb?9q>DJ~9tk z=?n8xRgkSnMuH4rve#X1S?6@dUqNvq89=O{uu!d}i!P4W)0-x_yV`DZwX%I39*A3J zL~@BTny1eyGWTEUgPdF{Antad3Q>GGK0f*=_JwzAdrm($H z&cU~VhGDn#*LOIqoZf4@uAKxF4`+Q3NYIq=b4^E)&_qhFi z4gkMC_j0LvA2BUK9_1d_WY6^QMNA~!g@@SFNxe!|2Dt0elJ2oI)4)wL;+9MY1vsI0 zWAMZb{B6YuzPDbVjiKA>5>-gSaHu*p1fv# zVY%bId;vR}^xSm#Wnur)4*ZNkx;sFjkN0xm?2GZmam<3i2n`ICvFv0#xW$n1me3i@k zU6%Nflw$a{h5NoA>P3Y&r~TLT@jtoqnOHfP{{MxW63wmHqjp4}Ikh(h(M`-<3KK;9 zBxA00{RZ)PxQF-&AWW?r)z#MSL~fp>u=f|`2Jy(n$rtNDTYhE@!+S+;m&)@02c(Xv zsrLUH{l-=8@zv~dN1~c}Oi1>6Zq~Us95T|WGeq9>${&jQR>;^u9eDY*=fM6S2c+XYsJi5 zdOV@CnrLk0s3D2dBttf>f^F+aSgi2!tgsj^`%pqyt7vERu=wUw-qC!#@~BYLJrVq) zTYFwH=d?C|Wz}X$Smmi%ZYhy;+`()xvBy-awX8}bD_GARc_OPnlrkOCYU`>Q?%-NT z-S~ZMe@CLuOgTVaVa9Sw5WraflHhMdPoA$zjP&7)L)Ir4fdyL#LXmVWQaW!Zm!)K<%XPH}r9W z@wV!E-ZhwXC<>U1{QAPjg#!lHWP2Mx`A5l(#sE;wRyY`Bd7&*YzijAKB>1S~_@eZD zd^_A9QcD}E-tMgKMjrx-{=G%OU17DehI}3*nMK13V>S)&s+~XBw$s-gK>d`FYk38( zKeM>?y5rwB#Ce6w`-jvSRoYlQDVA^l8IYWXV_bS<%NQ3;5Va4- zHn^Uhwn~Suu`(Q2H8>aiPfHc@0%8W8Il0a(>v#yrewUR9PXD&E_%x|qr9U^eDzH`S z5W1kSR>%HFjD%m$k0TFWrboyQF!^jkE~TTw(Cd4tgxAK3Z!Nt{CeeB|W87569hqK1f`nP?RvkES)!3Xh!+Md>B?=PzWqfU4M$12>+RCE*7 z4X$|g?RQuSAoYDZ27$i!Uj~0Y>dVckiJE3=bioP1Hqqm1c{gt>ly#y`*6WCDU3xfr za@hE1ct-MaSI-H4{`+I;7H5#snRT(Ku9pj4nsLLeDTC7*Np$@wZ_nZG620sSMkX$2 zeMSc{uMgPJovTdW@n?|N=@a%xt z9>*k>vBv^90r`+B>7!_KCC#O8L{F=)3t@^z$&VTeY1>ZtkQd6aRU!;1YTc5IreqK!||qkYd`NwW2`WW5QTV z1tEe*!BDlna`5|h?-z98U{Sf%e|C~~L?>9r@Y*Vzo`AfNwi3d1q~$jgtwAFaeHhY= zzlQB0RES`kv~I)%wv=POkt4n!f5d$2Qf7MpO>@8_v1`i;kN&9R&zV+(FLrXV0^h?x zf>iu8*USM+aE6MTj!4(0%gU*XFaq`ju~K#r$&HL&l0Ar;%w6b{UFJ`qiMCoxvhhoa z+cEN)pTaM(m7Zb}?@L$Oliq{Y{Q@*o$X@;(bFQTL%Dm5tPr=^{C}Ee8i{^27SxU|= zw!TLjGG7$Inn-0nVY{yJ8IKG`BWp1KIrhr^X<7Mo*_Em zQ`;Y4PH5M18Wi6M1=M|afY0lf+Y@}}bq4%&t-#UzJY!g@@XieLGKpu%6QOWT&?{_z zn}ZXej~ghSlTPzsC^{JJQj<>@N;GY}H(<%qF0_LcEdh%+|5gn*H78Ihx`iGtJ+wI% ztAJhh4fSX;m2#Y`uqV0MTDJ0IL17vh+Xy(s&C8OE3p^m}pc6oRX^{9GJnhb-=TAF& zPS#>^G8!|;MVJDp8S@MYvXaN}>G7Q`F)2zRgYx_+2dFk+^GpUUSuWS?QU@BmmZk6P z0Zh(EL9OdQ>>0Nw0kelWS&0soQLVcfj2`uZil;?_U(Irp=C(NX3Z}{9BJE06nO-Y) z|8xLtC{X6zhzp1#CkOeM(T9@IfL2v*b(k_wbiPTYmC{q692c^-h7?4{n3E8)q!uIW zB&whftF4e9#2Gsx%qRE4^*Z;wynFc=m5z2KoipFrx@Rc=M3QspT2DcHhflxFUYnJ} z=<8$|28JA}L`%(G3}Vh93kBIAD{_A!l5rxW#O}Hx;iblkGOVVtKG-%K)82INz1Q+g z2q@%UlCn~U$H<_F#=;)6$r<}vdJFkCIlMjU01PFHOG2=UaMrzcQ%}$p#7|||o&rK7 z`AhnlmuFxrFOB(L4FoJrAK#L}toed=w`KMA95uC$)fZFZnE|!%VHTr2NYinE zYuySd3`b;<`{sQoXcVKf%JDW7wPZl-G0W7XUD<*>m36{b)yp9p>0&94l4&!|+Rh7a z&AHn$xT&h8;}vMu8bGsMMXif$@|2UxwsvH|l;-wONgx23szcdML9r-X?^1?=5{4GG z5fU08S_?bpJ7-Zd!7e?9yiY2p*Z z$SePuMXF`c7yX_g3dJy^Q@Ankl4wHHw5tS$4WkJn(gc>M1ePX-zrz0}$UsiV=kG&M zen0B?f8K1l{j76Eb<)$Knu{JGEr2RN3z&^cYfB4CtZ5Q25<}Xf#VSQsP^1_bfz4&;AjaC(K@RrK z^f$`uffI##p?1f%cS8G%sU0cEULgqJRH=)x24e~{bq2<=>0-m^I^P)CREL|hy7-L< zfD6NcL`@*NYY`IQHBK6t{xO)t*3^~EGqE%UkMUu{j2oO#UhaGLrH_Jg2Fq6H;amj) zojHJB+Os)U8DrgJ@UOL#Y>CrvJOHCF09isHP<7`>n+3Jyjuh%na%%X1tmQyg5-KBe z^wzUAIe1y1&|!tkUvOA!)I9)b>8CMZw33KUSb_X?@dV&Rq-?|??MNa{&;>}pnci-I zX0EKsy(Omw7r8yDulgYHASY8COj;+=d&b8mw$Kbq$~b|w=T8-X$^rWS0=8zgQ?I>c zh&bMHgUd6}s&E>kqH2N`RgT-G$ktNtmj(L+z`h=BenK4A?FiUAV@sCc@#JU8lj0*l zfVmu{_+!+8B+rQlVhe_QZ7AX@8qC(}0etB!*>!Qc3w8UMo2ijCO@$xJk>(ThV+?sW zx-paavCPK<3l?(f>ZixgIAroTjcxKw_(FhCsra$AD*&16!tnKZdxhl1&tF0HLDo{A zSQ8;XG>CRnW}RFQ%rv~EOf<@x$q5Ym;qYTc4@ipR!>`0ON1_xk<5c8mYY8Ov6(l}v zqB5M^*dWesrj30PNv^Q~B_xxYji>=3#_1hyhXSZb_u@0E@tOcnB-FY+VPNUd(>hn7 zyEoFOfg+C-*+%(0=P#Pn$2I`nYJ+(+QLad2ds?Qb{Vbry%yaC1OyaUNm zwN+9RjEj;4Ns|+g{sx-a4VZVz_>)8b!ytsf;Ct<6e+xm;P;-@ z$gB6osGrdbx7kU7YE_JPOJ{K_-SP5`9>g^+0D|SEB^VD9Y!A3|n73eq)-TkUXCowqCYXihfVp%ENljE(P8H^1eFq~> z{}$R$r$!^mTd)FAMNYJeYHplX>25r-`+Ha%Ffc+li9IMkSPBUSiWf8f`5*knKT?KGU=Sz#v0<^Rm^(Gfn47+#6->z?c-&DsG@EM~0QMi?s z=(xOJINF^n{jd7(Jzr@S0hYz@v-#ulAFh1!G4b?Y53T=G5eE|o{eK)(Ob+aHlukI~b1hnCVF(2oLf9bqIg0n% zd)+m+VXlx7u3eMJjM}TVv29}bJ**@4G{HQfnBH`&)grFkKzmA>$~aMtL%Ms|{e16j zU+0u$m4c4%oW5=M=-8d)`t9Bpz?chKtNPeh6BjF4_R)NBQ(Mv6w6)BdKuK8U`?WzJ zvSsU9<&k*dUiDh9XuG!4#I=yAGN#8HIq+KTJeF4oEY z9pfcjxf?$3+vFRiu5|w=e;0nE!^VXg{;7z^yBhqB!$hz%C?{X>ef znajQ`&2o)LY0NX#D`h#N#kBEY!S_KpP*@?%_(qsj^NctJ%yz_G<1Xye!;#1q!N|SXpl0WcGBOQEARu;rMw6IDH zYcM#USe1Bj{H=wJb_W$6yj@eUW{SAQFMROe#h@&m*#16B=e#PT|1dM~hJbl-4?uJO zQ$+Wcv1lz`>h$x+V*zb~6&s&{5A2qTBM&qn zMRg8vE0Q}eH<#dHlGpVKYqiY3mZpxtg2FrcwY4kw=c$(t>l0F@7b{b) zw62l}XUu@j>mm;xqCICk!pkKZ&?J8d;8`Xm3H&CCI9hZzWr4g3uJ@a{R4^ku0 z%Mj`$T}UB;XGzct{)#tB+oXh-fz3=xyq@N}GjUbFbWmO^q{mp)F?4|aYB6+#BsQzp z;o+OgvP$Tp3rH1ZotrND$~-o6IfiPby`4_FAR;j5Xz3%G}m1ZsEY4{X)sqUfH4IlA&{fnGxSysk% zR0ATC8bHgh{c=-1+pbQ7z&wl~#7^XrnKNfMTRmMk93oyDS%QqpjD zE9&z~0Ilip1q?qx+zN9XbtTh<0;|6vnY|>w)15qNTCc~kmzZK9;=Q*UgL_K9Nn4$* zG+Aw2RBPLRNScnSrZ`dK* zt)32rR6IE+rKJE9^{4@E49^BeP6|~T)PX=fpWm_CVz!o#1{Nn(i^cQJ5`~}F>mv6(d6e5%(%1LASXujq}aoON3b(ARt(ej@c&7|xr=Hv!~ zmLV66vd1C+@i&}@G>|Sk-^6hsHhQonG4HI-+NV zD@YOpDL>CWFI{q%Q}9|(qT_N+53FMO6SkSBFmPwLh?`k3KF>Xr8zSvoS{uN}A64HF zQJ7jtCZbqgxosAB7Ot+rlusz{G@=pg@jfD*rI~8yNh79Kmq6Oa>Z#pDNTFe2qNjYo?d*S_)2-uM{IBC_^4e3)_ zPSjW*&>C4U9f2UFI4FMy(knJ-@GB)|O2*uxqvX+YTgL5ASm;U5X}Tc>grgW`g_|Jp zz)Zj1)&}FkVRr?k58|;Cjair!K938~c5I*FsjssR*FcLhTFsR$y8j0mbfsS^MTDWD z6$spdWoUU*_&%P2l^id>i_rDH!N&CaQFx=u7JuDwBn)169`{3NF%upV>PRS1SD?4W zbirTH8O77^h|KtL#;FIyN&52Y%(m=Q{>Z+*i9k?)?G^7e#IEax*v(!sC=n!O~ks{9Y0IBf} ziSZkEL4R!JA7J`6S6I&wJ5S7dEdUn@JU$Qy;MfYzktNFyM@c#N9%9TMmf26E3S$Km zyor$#7le7kVcOe$$IS8rW-z$%DZlUXM{-v_tul;;`-PR5*_!aNVfG$tVUhMi9@ea4 zX3bFFm8z79Wc|bt z7u)l3^W!R7?fsnYp<_HiPF(Dao5@^Nx$&hps4P}lg_Zj3aqoHrldgLY>;Dgd8) zRUC-XfQ*7eEpSM5vmxF&g&Asnk>V@grq_q1Lm&aTI1;kN;+Fj;=JW?a+R>2k0%|6d#eQ)1%K%i! zw>JZ)h)F&lDm2C@#jtt<9zHbmt#4L+$}VOVY|3MN4wJYCh4^gRH~Vsi9~pD)`?LM44+ke>ma2oHFC7G42_sj}BQNV*nA5NPPOv)epIzFeU@<=B;p z%TQcG7YLURtry4P9|jc{eifsV8>pS6EUkHteb`_r^(Ep?sz+Ka@ss<3Ai{?fZK>Rc-eDEN2R6**%Fp;&^0( zP?2^96|r68>~Nt(f_$SMPgr7YA<)+nqfXuC2pc%hr_%4$-VDbL{xt0}L656hKdw9N zPDh$(RS-BpSMvJf`jPCtwG`-8^xEen5=9(&J%yoDo6ika?0Tv*3A4Ve%+=o1V!iVU?(I{g1wj7Az7{>7=CFwK|=R5XR z-7#cYzvsoqi75>rI_O`uTm@F3lo7Too{sDU{T-M!F&@0v{DrU}RSH8a`B)xY8AlM` z7Wc*vks#4qUuwG~fSLmfPWanivKrZ^^B(oODF;zbNJP7K5RHIPn*oO;EwEu`NAGbR z@MW@KI-ehTNK9Uf5V-FvwNa>-hPD759!DJb4vJY;Hm^V+j8gpML(wX-PX?|ri~=?w z$!_Mcj%4sx&6CPq%>JBDbZTw}_NR3PuNV1AEO9%w=ju$G zS>0&YIp9{m$O0!lj){4h02?HgD0)fp#Yxx#*b>6-B>!4nNmQ0Dl${|xxwLID$D&Sb z>|9pPJ@n;ILa;jLy6EbFN~J5y^us%RX!!ABxkk^v5+u)PdadCinbdI z8%%go6-iSMpVmNUil{`AXMyTM7H3KodqrNxGlOrSvjD=}j32_QMNd;QzsSfX z`0C)~^kQl8>Oa0e#n)c8CtWa=kYg{|W6fyDc-WV5m0mal_&za&7X<^iSgsyS!?x91!%dp_zma+UIW4@9CpMK?G1Ga)2T!SMiamvB6A zA^5VBUuA^eyr8E7&N&I(29;lzBb4*g;6P6qc|ktjfBP`c{*EO7Ck$u#KWVO*8Q56= z=j`~ul578F$GvCjZxr^MI1h#DY~ed5ZQ$56V33QPCCCD{3p-LK6T}-wc?OJqys9)w zX*?-66GZD%Mc4?miX%q6y&rR_DF!eYEghzjUK)w6HI)#o0)u(wI#ptkqxhY71WzLA=qI;;v-BjVm1}rCAy}V2qGWWyfYUy#u<%lcQOW>zcV@s z|H3fezGBS_WBQxuhXoCgef3hi7Tma4$3{Xxnj-xBXm+tZSgHT#m+`h($5RJxH=}~qL&rar|GJyQ#3ZQNb$BK zgTiacx@Xhnd-aXCTPQ4DdkC2Bs!_9Lr?x#cqs!4GBYc?H z31?F?To4{Dm&3e>f^1gKm}70`g$;G~!mV$ckU9 z;DyiFKYe(lmQ!OkW;}3-7VvW5-_3!)jiu1;Vz%^dG%@82K(Yc$92Y!`@5AR*+WlBy zEWL9<@NXn^8rlYW2Yk?^Lu>s`-t%XG_e)BbLqtQl@jhO6>B?M5azhIU9f`EEBOW6# z1*942yY5=t1r_(VvzuDvGR*^8JozoySv1Gx9sLSXeZ&iIC2#K7ceI#4lo z*^&%mAf$O;iW_`=rt-Npjph;Sn@fO7g4imQo>b0f;Vq6ixOBZp*+)GKrMYRzhD$Im zp#}k}MBeI)!HArLNp0BqVnm({m>>Q_rVDi4)R2Lu<1kM9C^9q$CKC;?TJrEi%oG{t zl#dazOp}ZbcBZ++P7Wm~04R1`$=pISDIMp%3Z5M$$<4(^#p+<>8w7LODsM9+d<^Zdx!_qElc0ds7A2e4 zP=t?rYDqx$`?`1lKIlb4EbYM;WbzE`NUGyZJuR>HqHLKaGC_9Tu+Tac#^2P3&~~E! zNh8K6YAIA^08)*lt`zfF5N?!hYlJ+4FGp9%JcrC#J;^x^rh}Byt6n{D_EIOZ;-f#_ zAL(Lhs{S4#X7^-wPFgPV=(nKK@S=Ep8%w55Jkx`)cY`) zB=nMpN*vt8*;AhJg8o>tZ?{^jK4;ocJ+G(mF&{fhk}SVrd3NE(2^!4{ftJ5a#nd8Ul`&d z*A;eEgek^RgBIy#z9*(Fi$k5oAqxJe$0!Jk*62(D34qe$d^zTJlV%XBqXzo>nNC_K z?+Qh;LXr1{Cd1Sz;;QePtF*jE1rI}IC1o28GhL{0#?eykR0-phdHl6 z7DNy5K(ReNE~+m%AGHU+wmtNU*LiXC*PR&QMPG1yjZfa~f1DMLLBH6%h zWk__ec#GwDLc3XI(`WKc5E*+>0q$!I%^w>m&p4r9YEZvF8$2%fE`64rM;|5E!o!PS z(&aakR&fX^XygIibXjY-Serj&t-E^AY69WHF7z9y`#%bSm|K59`WIo`PXR+G;R z8e_{)DqqJ1g8m^K`_y|=kV%gfG9|Qc#_J5$F0{H8bLC{Zj3pw^7^(8YYdEj34fd~m zbdj1e5V(N`nh;l0*hriXGb*LzoMx72-{pS~BBt8w)C# zf}rkQo;_enYZ6k;6m%;Dpt)$A9V(?Q8D#EZi&P^-pdwuyRjm^yO-9POB9PaZf3I_b z-j$H^d_8av8rFtLm5Spu6sMohqjEZxL~pTyIP6+#o2|!A0EnzM?^)W4FVE=U*322Pd5Kadv|z(aQtLV zx$3W0*6`&=rcIGw#h*c(z{z!X$tz3dr6Ux~xJr&hj-W0v6U4E?K44C_8uf+F(*eD2 zD6VucnK+Cd2SN2AvyYcGd2cY0nwaC~PGEuxlR)(M+?StKN$_w~S&@<8m$dQA{eoWY zILO$+lWY+j!$9uR8O-}IyZy4#8agBgdzF~R4dIQ|O8z;v@j>CU^Z=deK_$s1NHW^Y z>DYYdn&pyoaz0Vlb#3km0Y28F+ zqQbIb(Lxsv%NP@np@rFZKsoSfM&?3^BV>Cqu;x8Stb;X%x!=`As`8uy?{3ytjksP+ zlI}=yFa-Raj)Llb2id(T9G;x&4F8Pcs*E4++zM z1c?8WXO5Yjk^O%H#EO=5@^~) zanheur+IsM_D;wkVh3{^b+|MYECi4T3m5-ySKw@T>;}pGx^)wzAJXg{!>6&&8TY$m zF%ri_6eH)~cEoqFf3n>7Q@`K%bNRUw$Lf#l8YQZvM_5$9+pAYGGsNEavu}NNtqcxT z%IDZU0r}R~E_a|VseMfDUAdap&Isp1TWv~XQ2&>i)nca3x@=!iVH2{CLhGzX{L8Xe z*q+Y@>#Bxp{-rB-S@k&A&*txUF;YeFB}F1E&-D?nq!~36hT6uX9e(xZkk$_tR(3z< z+)>d{Xv$A);-WHzx}u1Z$qrp!g?w@HG+wpw@@9G$l`yeMk!qz8T^^D_7Y;27fDk59O9UKDTc`zCWg}#N#E_##>Wr=QMOCfT1jDgVRLwl1RLHSz*%iz^Mk5 zEZvXcbD}g*Lqq-tXqkJ1!5PJP~Vp9=h3kqsg@ zy^uHQdx}0yvMre-el(wt3bLinr6`_Q(5`gjC8v=b6FehBbYm6vReoi_Kfga_)JqVu z>f}V1cohS^ewAYvRdM7dD{Q7u8zBgUa5O?#9fm z!kh-E{^A13u3UGt{*gk1q+b-~1Ip7G70V9w`BJSqsXSoxY$u#Y!s?DU8z-WFsJ#V$ zlPUw7ae{A;hqqK|^{ylZ4#0B3P*Hu=S;-wevIL=?Zi)DLlt_IO6c|>z;BYPdhWeQT zY29lR!f2?;1MucA!l~3Qr*gt6J*iO22A;SW&X-w|CEo|tl{6wv3wkR4MBB-avDz+D zsip<~7?0_ljK(DOag{`NA=J^R6;E8(^3q%ciJOV!|5IXMd1-M0_b@{2zvU#l#+IL6 zcM3|2fG)#ChePLwuO*FG28RNd%i8H{%bFhGR#gzsL+zvEJ#e8(PHV!F6E{{``&vM$ zb)u%6qF~KT)u_P*>w%n?Fz;n5)M`#mUMPrJ$vdfTV&illR{~k`D6y{vh+Tw*A5$KQ z`eg290DJ%^xva1wxb`j0%itGD65Emh&1#$?J}C60FuSclMkbgU;y{T=;Qc^FC+VQI z5kzN6?tm3(Ryob%hS2^X46QKVUmF?4Z3BJVxjlf@?jNmk&rOW#XS@(F$%2T?y3)T& zE`T%6lvc0TDp(ERBlT=u1%|p1dW7BY9}S5B!0*1(Pzy%oF4z%-uQpL^BrXl-E7gc0 zHKl>RqyfJ$<=i8j>p^xm*FNFMA7~t6A)L56mx1?H-+nut372orn(6&R6yXf>n#+r@K$WWO~d82_SNL$hs z>v?b#enj*Py7KR4{d4Ym^F)%iat2Ilwm5~>=UP6T>`R4(PTPd(7oMK6-pcDSPOyV# zt7G?1uk{yHYqHjQN1;nZ{Z;XbBOM5Q08Q8toNU@{%x(_Y)u;vyU!!De&%72^(XY9CkAAucpZs{`sAK@6W3Yco-4D%e4L#5)o&2A)% zIout+g@y2!jJ+#}pOB9v0r&ycPPg>nza4Y@b>R2r(Cb#2#%||a#DM@3-BR!j?5B+& z<%5JtfV=lzPzfEa$77^mjVlVWh8<}{LVrW)JB4|*%EI7J?ABgz)Fs{C?xCZJqfDvu ztLAiUT_eO01`so3NE_6o`H#g!ove^GiS+-hW42cJ*fajl zto^MBz!+Ctf;ZHqz}fsJl+ZNF&0b5=x6J7X{o-2|rg$e!=SA5F3D-`_>n9CrS64R^ z_#*4sj~C6-n-@SNPhVuzvedupmLLOWnoMAWdGWp)F=Wq30J4SEo)M9(^01O{G+ zBM+-h)08-akYV6a){C+eb&pvyDdd)+D}bMV$a9QN_zl}QyHJ$`zA3Mn!LmS{g$>@Y zW_(#!*2C!EV?1>plFw~|@xX-PRZ5QzAiPTSzd>O@IY{G<2G0T%h|XlGo>eg+V;d1E zTu5eJ-!@5C+9ZoFnL1M<5{I@=!V`@o*Mr7Rl-}#uWktAcp_2x@OtqFyiJt!OO~w9~ zsa&`gW=&>CmW5d&L|#U;6nd2}5?qwAAKU_EX?EBMkNzYDPwfc z>p+&R`|tEU5m|KxiZ^hc0Zot%qXegR)!e?P^M?U?EuvB+{gFYVHtM*ZTvB+444@Q- z1g#oaUzpAH1zC)!TBT-kO?}CFhZ)V1Yq07WwY`VqzE%L|2Tc_mshF>$1cqCBxSQXo z2~^r@(Uwb4;RX3D487RqF23CTts1Pj9t4*`5VyQIp=!irfC7sdtnorbF$PuEppgrJ z`BcNdQJ)vtyLXcPkHY8ya zXT}yojdT3jxg&2L?3J0-(j{Hf>)N=fHdJe3@y*7eTySmY4rm|j$OuA`Y|585qY%oq zxp}Wii^k%N={ss#oS;9~60T7R;)IlAQOhI#Voe71C;H3BIZga{&>#msfbM{u{Rxp1 zKcR1E={Eo8=V(W^@Q*jlJuB|0Fe|Bj;b9qZ5=}qcRd5)jVo9Xyp*v=Do!rjd?!7&0 z0A>uFdJy>~$z_*=6fyA7qPkf-8W=@&oAkijAm>`q{4a75C4>&ekzbfT8&~;&kMBdLO5g$jKKj4Qm4oq|jpSGiq%G+k@IVDKYIRo;`C2UKflx#fuF!0gFmXL2sd znqQVwH3zkf1?MO3D4rl4ja=f?iI|}m$vm+@3{Z|10xNbi5$(V2>I4k6v`&wX(JDv` zzIyy(@bvC*TH?NiK5$b0X>m5eqYw_Jxw>S{OVS!3Zm5y!jDNQAY}9p@TMLKcNcy#8 z`76$)Arx0C2CGD`_tqB0z>#swM|;VgH8@V$Ya?hQa#{44YZJIhH68y_Hryw$CA$3# zvX}SAQ@VB#{gHbCp$em<9J!*%UrQbV7&2HuiKgdDU$+j)GmDo@h8AhMTKlFgWGFFc zd*_$;2l8&(aMZM9Q@a(!@L_#(?iS}X3txW~gP=f!1VgmF*{Lq6J)tF^DXp}6>K zlukd(w+IiW~btqs%IFze5F0s);(L1-xe^tAxPMM<;Z>|9pN`*hfrdwDBS zzFQ5Yj3WkD&_D* zE3dgOpH*fZICPKN%k$k+i6>SC?C{A8Ydq7M3bS(_aF}rmnUB5-NRAXR>^z{{ftA0j9bnSW8t&lcd2?#J41Rv(8rt9u zZnWeAnM)7MqfHA!de%MC7f#VjDhLoT@q``eaw=k)6F^hTIBjsC=$h3E{J>1#uMK|> zgF&Q|#iA>fK~muuDUlY0XL~`inP??|@T@nxc~naBTC48W@1jnr*+X5lyY)~XS0XO| zlMV0+G|zFe0GR!J_~wW@cAaW;bitHM2U-$gQJnie--Ak>OziuDD zY0aenFhtlJ*R$+0Zcw@fO_2}TCUgxzYy?GbioM3d@G1eEM)QD@dy@1h zAQ1G#Z0T~?ttcE{%thw>moByoDY(TgzHkx_aIQ+5ym5QVxcfHPKyc9$sh$$pxlH<= zVbSMbu$%hxUNI^H*`1l_->CYm{>U-35D=SnO_t+@DD;Jy@@D!Y=+;Ug;1DKy4(<#J zoie%}d#p;&yxYw;m-*9McZHxxEiQ_atW)2lmDSTm>_~!p_YW4XaLKidq%{q##P2 zl8`7vV(#l@$DYHyU1DTM&V4O}SKycS6!F)m?|tj;2YP>U>ia*!?Egu2%FN9EzdCeN zwX~DBTK}sH|X)*Y_>&36DD^6MyCreD8N;|^_ahpzWWk;Y?C#^~+Pt!w{1NZL%L zw|(b}oQX&C=kMzsG$H5|6QsTI)m7WwE{!pzsme9G%Trrh-~7zq8N0RX2R%`K)tx}C z-%T3hMDeSm+HHDKv=_JKI{#x1O(5r^0}F69JkE4E~p^`@>=T!I>X1$`2-@v3JKjl!-4QtqW4s68;K%$ z)!zVjBC0M|z{N0pX)6umvG5|=Ro@M_IV( z%@?capF$hU*l*zm_(;U&5=?of`A8F<6TdfChfmIPTZ|vOiL?eeCj~+){<%M=>-Yk_ zuXv%s>N-Llwpwc?+-klJl{?7IUAx}DMtdNC=?C_Y3Eo?2f=Wp_j)J=6Xqxqhn$r)L zx(Zf`WzK}tje6+ddv>JIP+f2Sim;1%%g_EHJ`V{VVVcmad=|;uC3HV_%)X>Mn7qW- z7G(EzsKK%S=Np>5kL$F-YHX%!e_Dq~E8gVNPddLs;(+a}e9fjSM>PH`-qZWYhY&CG zQ#F5{X+VaHf~m$90e8&g0tpMWo_zYxtTKoO-ac6j@TCNxzk$(u3~JNkUjO1}X|k;5 z>j~Qi0i;iyLv}F%VsID0m_%N1+kh?aK*la}5$@s}mim5S*?aV}0FnCC8)i^w z`DPxN)uzvO%2l8L(D)QVJ3!jLe-FRBL8E5#(O7k!$;hx#5Wy|NcWH^*b|cl-o;1Er z)1@DqA7yy`l%qPZwHlc$#gQ9N2T-N_&u^+NvWr3FLppz(Woo1|N5AxG8ZaGnn%V^Iu`??f=P}z4Gu)?S zG(@0b=oi$MnYBO{v!|f5lg-)6OkZ=SJK{?TMhCp?23taKf(zgvk{+Oy zey03@yFntfJcavw_pT$6(O6$RwEZfpzM;oIybIi6vtkanmz+Nx@)ALhh{Fp}@b}Ly z)-Wj;tYAPnI$60#M3(`lin@xRXA%O(k>}$71fx24yMIP27Zzc6(`udlJ!_KIFr=yr zrECYCWV}Au(l>uJzk!xIkX1;^woIF9B4KZ5JTGAKH8r+$X{zeqIeQ%u4?x;hhkNkM z*uOYk%dCvW3~t8i7jZ1Z?9N`00jlQi=?%11U1PpNH$WTh_W5S^T9Aq6sRvEx1H8<# zfibaD*MNb!l_FKEX1quBQ)Sf{y~=)dH1n_s^6hj8Tf~L?r0h2xAO5 z$@7_mA*&Z-Z)G7(I$z&tEZ9eLZvee_R=;6{*g7TR$py%TTiSpHDFYGxaEKz6BhBd> zVGrB6o7vh$7HanhhKHSED3Z#;svq+glC4JV|0Am^B2uwuu-o!mIcH>TM z0)&1Y_nuKw;xnQnUr;hdM>7zOMs6_`Of~QjxMj-2m8MU)8HaRAYKqbk$#>`;T*IIt z8*pV)F%P4Rk8@r5_uPoXWItzI7BoaTn6;8aN>#94@xyW{AN~R^nTVB5M)ITrqjx}U z=TDw@I7x1l19C8{iow1mM!xc0stJr3U-(`{h^ zJ8!gBu#z(pFm#%Cs61e{*QU}Q87NeQCA2-ukO>25q3>q0&wz_ITb(Fhnv>RWu$rD+ z=YgY>LEi^b~2tVyfKP_ zarC|bo1YWcon>fPRyi!|zCByx5_Oeq+=EJ)8*xS4^3MP&$M1Ni6F$JpVF+V111l*6`hFXX7(Npe0+mY_5b4e4>h-(jNd0 zt%?3=Xp-V837-wMR0&(t4~bNqF8Fpm`H5^6A|p-U80NstR#Rp#l=*sm?_}h>R8$XS zcB1*6pO0&~ViSY}#Kp#CorOQvb++zAuTGLrD7AkvB%$66wwtAYeZzBgC=?RZNNWK+ zsuZcpJxJdKaZo&hY-V%g^8kZK(~$NtJjeDt`UShK{=m!&8{WG(N~!(ckTa;)Y2{vD#(jTuk43!7an>fl z$fW=4vI3Ar=kt~GzPMFUotBrs;6-vC$B+gWM+#%`F^+um4r*t_(LqJ!?n4q-{Wf^i z5ALR+sx0YbiK=Dk?G?_SW@}v`e8|TiKvrD|OugH_N~=3HnOj0m=RQ1|eEd-1$Pe$` z7`s(exznE(DU=M3Y(rB%vuYo;ppG%IOaegwd7<5@Mm*eRnv0BK^pt|Rj;`}Qc9d@W z{1&QOgqyo$92+4s7Pps1myWX!E8j&4BC|-&TP#2CNuemstC`-bv9|Aa;i2o*Sc_sL z`hD)RwAypu7ly{Aw^X$>Jz&qn65{$oG{v0BuR`B8(r~+jWhwa4%-J<yyxoX2o7?6okxhb_u$Y98 zX;)`XOPTew_!Yu%76_@-hsApqKwvNHL2|_s??FD?eeNx{bD7IX0hz~ILT8Wuwut`J z0&Fgy_k@%7HoEKN33x}ec0Pd7i=u8>gRlw1i!1TISqIjGaO@Py7u?zP3^9z| zM_xzC&j$OQlU1X$G9*gvCz`oX?8Gi`OunkpKAP>#F-ijI6H|;Sws2ok9ZA@7%BEK; z`5}ex0vZTLA@VsM)?R@7y|{?%8xUL2E)NLd;fbEogf48ZnZ%-u$G61PztL;rq$0Wo za=lBLkn$;%WUGa<2dR;mGSf#e2vCac2fC+;38{A4&k1-5#pRzUVwv8hk&B6Uz4ol&Tg7ORVjKY;?{X^b4 zLlF1k$!0i*%~c2VUE4Hqe~z7OWY3LY&S@l~ zeqBF)#GIMyGzy)Vr*Gk_s1Av=yas7>GoB%a^!2UzA(VmRp_?%I(OHUH`I(;F|X=M$M3Ly+g8ds%cLVo_zsiZ}G9 zt4pkfqX4$gV6Z<5L$U10_E2WOs0RBmRl&+Rrf=E;vP?%w03;}OczNd%f#B#r5G=)` zukc3w&UqmH z-hNNo3(mb}LZ(f%gR3==IxbDZOHEcAN{t*L^(~pN=2)U){QTg&z(zn|+goOn;_my7 zsxDQBFElhgn6JCsw2Hk@V`HtV{gvJM5GDqFXyb|5fon$b*i0Y^V6jR&GZJg>#HC8Y zwlv(aZd94Co`i)OrRCju-Z7MyH5c9gTS>XatusAX#9c38fLwVRs5gk0tC3ny&)?RB zz*Y}V?(k}0gi7;R_F<}gBc6puvtv^O4P7tL~A$oU5-VkIKiRBjw&aQ0<`H~ zZmfo)I)m!12xb^EuH%PCTJC_76(Bh>EQRB!ji)Hki9pkcveoSqWAXU~@6-K-o>Om?M4|x9 z1W+B7ibYVN;T{EPTf}VREr#%U7}$DP1t;!jr5XrgcBJbE`vnNJspW`3`!f;eWG(u@ zQi-63R#kyKly*(ATg9U?6$_t$HXmTSuX+Gb_2i+MSQQVg!;((7N70B?q5hP z!1TDIpnv2<0NfIY+x`vaZsX+|DCgH?9IGFr%1q>(f^bj#_Lj#P|FXe~I*mNa^hRif zN!F4tE6vK;bP5YxH=|fANMK`j@y1$p$FM*5+Fkf&qA0_H$;_0bF!-l2R-Cb!XgUo% zKkDEtWK5X2FdFCyG<{C;b4&_P`AL{&UTHQ1{IQIJbZls{&J7=%;PUFB9ZT{uqEYg2 ziK;Wy_*YA*k|MsL%g6Jc{DY&@xCB4w|7-=wzj;oA>k93F2NwX$i5pr7d{acDL=%(_2R|T< zU$!t*ipT@YQW_Sf2Kkh@UJDzh=`{IITu@tqq!Bpo z83{;gH(~}iu64j8(^K>DI2ouBy=opa3JXFCU7t`_J6X7^fD9T;Mle4S|HsUXV+3A+ z4q)vmvruY_a-{uGxmAN@EZeRP{0)a4#}HyT<1I8N`whX7zxia=79U6vJSecmcTEP^ z!4pUC)pui8MLdKNcLjI!+pzexQ5kJB2oW~v@0+jEBf`;T88JF?@Zi`l&1_*_w(z$b z&+E3`Zm$7*N~T4drC@*sBEE%22BQFq&7SfHDQYbQ z=xDP?Ae>3E3>0zM3w*yR5baM|T9|0q8X=Inzz-(n_C-llS$OFdHNj~kCf8-=Jm8-G z(kF3Dwzo|}GBMc`(97BgF+kcrX1)iCR$$teRXUCtq*nt98sO9ugkL@b_*`YwCPDef=_?N!Y@n!ft{wu%^3y_1^TfO5CGXh4M0Se5hN%+fE?2go zf1y9E=12)rOV-zc#8OB!DPcH8Bj$w0+vXk$@XR!XKE`JzjG3I8Hc0Hh^OX9II!Bdb zK?3M&v+SJ3DcXJg^Je|D=ULueUa=)|of(%>e{%`Y?a>)pPMKwFg};HZ@<`k$Gg^RH zc6cO{W(x1VmzWd@mT4P}*8!1+1$8V;^G{q(kVOVh6kzL=`G~~j3*^QftxlLQNxZdn z(*gJf6S+UWTQ0lyiwXY;owoJ7O*Fk#Fipz0R*3r}iyKWSX%+D;Cb~*-?C8rsmDAe> zcIW1x0ik3SPmr~QLu#_t@9HYX-lw?y+SXE_q{9qjZMsB;w#=eWLDOWj2rG(dymE@uGdb?vf* z+jdXkUkyoTuTK`h)1{nz)PuvF^cR%vE|6l({`>iFO*uu!ORN1!33S z9nDIKQ17w7f9fd1<&{qEE(yI zbsJ!rST%B8jR+vTy?w!5n&KWK zRMR|*a8h1iCI%h#2S4$&P;PNM5n;a0F5+KU`<%4_%L`)S8fbc+Z>OW`qiQYrP(99fu9Cv6hrus7*i@eh&7fJw2OxVq-0`&i z>L#+K$##wDzY9{3K1H?MkWcJ*Ih~ScOuZJ6x#$bmLHWM-%PRX`J^%ODowlpHUEkL_6C#Z+ zhJ(N3vGL4M5#Xon(0ygr#%2d_DTmW2AD~io8Yw-v zEo}pvLk#+kYX_V0Y|eCq#4!53Rth2%p2{t$)D`Kn-`1hAw7P9wgFS909)*a}MVgF)q;n^zA~Gs|4l6JdXGGZf7{f?) z)Le3+u+Y4_N*y2r%W<=eJ*Jx7`pIN<<8l*I>EqC0OlqDyW;Dl0o(%#oJihM_d{ZyU z?qwmSpy~AE75gJnO&*ExXa&}0v-FVSl6UWP!T!8@T0`&rT|A#>`ajT~+q0Md5jdF% z7zpf*te|*!=*28;Tuhzl#cT{+OhrtM?M+PSWlZhNT`UNgSveT~XKwW$aK<0~H*i8V zCv35*cb~UXM%gUcB@)Okm__lqd=#{BGF#b9Bp%C|QCEnXPOi+{@=KDgeDtyF z*QBTwQLuE!Hre;RzfQe~S?4a_#DV*NpX&3x6>;NqqK%QgcVfo<`(C>qMbk!JT$?U6 zQ6{97Sn@8$REiS9Lsx%%HP|<`G@C9ri!elf6iN5+Ih@u}Qu(g~jlVAgajp0sh_}#t zo3_r`QpWB)pX)L3-F`mxJT2BLKX=Oxn#okA%F=nKTG<_tISUY#d zB(h|URzw{WOrmI5h5vqb(T_=Q8h!jXM=A$8r!+`K>730eE}x;? zWqtEW)yag?q=SXu(p3&th&7r8574|SDN$6+vOAw5o%JDb{k`6)omi87EO}Cj&@gTy z)h7P8)s(Egwx`GvWhq2O>~a}tx0Wf>$;;tq;thJ6jJB&YRM=P*UO5K4X}T=tln8pK z2V!9ljnpItb>;XjHgwvNhOi$yE+bb*N!lOS&+e4kt$oGv{>lIQ>ZY4{3>K#=&{*#H zXbDSL&mGJ27ZeAUY^-J~u1<6vk!M zE?}vf3k2fg0fcvzD2F<@4~mbH*fs&Lmsq`o&_!p1se}l3vort3~ra%Rs@d zi9ViZZk^kF((^P9wYz^?cX>PDiTS^a{=#tNF(kW(L@|9MhM{gazFffc2~Dalw%xlEKyHpP@RK}Q7HJ}nXSe$lP=`ey+w>myT*Px6Hj$Re)B;w^{e$L`=EXy-&R6 zZWRxNkTe}X6mA?+;(Ls=;?cx!#-V!v4>B6dV0b_eh0fs4H6RZVa3oF-&L$%hVyc6W zqd1*pUcBPnBRzTwt*+M*2Oiu1;dKcrqdIJqHm>v`~OkfKiRu1qKZ9PY61)hUfKE5M83JtH z)Kmo-2nm(q3ef-Y9=nK0o8_5E2DI36Bc^w4Nanw;kKty~dFUThc<9flVl`*(Er6t3 zZr;n!!h@p5ts@5rFO!m+^>;XRr}Me58JxOO_`D%pm-8`-1oN9DmXpVH=;gNk-VVn0 zpmap!AZ7e`)S+t*rv@eT4G743-9hJ`MS@hm`+Eqo}ob}{Pjh-5fCj0GWfYsHQFdc_V%s;SOBbyxhubYSBfy*;2Ye&qjQ_y@``AkzSYt++8xs01Y@}M5yH5v5(lfCD)`Ca zS?c?hwP>d*mllTa#l7zM<9l%AUP^5@z;J<#AFq*nqea33pE#AvMNSiaXTTh~OS)D5 z=_SpZ5?va`%W@>aYMv(ivRRaQG>=-t;1urY%FU&i+YwncFxCU~@Xx zWlp%LunP8<oh`VwUjq5u5pbM-7^d73) zjAH=ox{5^qabof%*})3@ywK9Rk4zqKA;8LIh{||g163I&0JK~x&)28kwp$(050mIk zoFp0gPfs#W?Z%9yei%(iPuCqp;GKYQ2N^7**R(*jW(!9bY-ntvhlb3-y1z#~IRdmw z-B+T@q%e@m{c&mlE!mi0p z-2mO!1HNxOlhi4#N*^jGnxZp*446R)0j)M6Q-RX<H$N%<9@w;)-BQ%%K8h&W(%o;PH-fdgE)3cm}r@DMWd*y?V!WM92ipJ z-YRZ3Wv%bbxr#LL!-NCw-k~oohnjY8uwIeGm)90R0|23i3UBkbM{)VnNpq-n<^kaqLY7HtDkG;<7y+qP{RUDIbSCgw!!i+%I{gf}wRTA2?P8$JJZ$C4Su$ zAZ0R+8+f9bH4C#~PMiIu8pnwli^7dR3AdH+)($+0e5IF|J?*26TWkIFH|PQ`-uMSk zEzZczn-#tyG=yB}O8X@H-IZo1J=p4{^Dri%skNM>1eTTsxiv10e9yxB($~Baeo;N> z6FdAJIG?mXK59APE^qv};#3n&ac<8z*(g^dm9vmdWZJSUC1!r^a_3l6C&1$vv^#Xd z_6B($A4b}i>n5*ICsYyDz(WUwOWEByYzHxcUu6|0r}i1hE-4LODhol4sIawmz7O%fvrav?2U7Iv z2<*|y%-vK;{kEmx)BE~vH|TL>xQQ7TU|ZY09qjKW%&t9-yG@`F9m-_>68IEM%ISJ{ z04TAWhlYV80@@tW)`~;3={WnDz}a&Ds76E3G=-INW+HiKznqTB*+@kd`0|ODX;%64 z8+DR|VA7K4$_mb!Ug?7i;7tNAE=P%4tklrv9uTIjNJR}t%dGj|?TIE88cOr{q11>K zusTXFw^A=9JCTh4T1r&lwa(=(YqfWjGQR%IRmQNoo5Iut(h_9B&nmd1xT*1%7R+w2 zzjuDDlM4CR7rEa8HNq-C!W6a1lvpu}-`?He+=?ZTh*LNLwSY0q!GyhuOk9!8s_Y@< zBoi!3Km&cQSEfIhT^767%hsTR$ge6NYg3Mdp_6ng>Z7UwR74iHZxnGf=0-+_WpTKM zMFR|}DNh+LHIB>7Qk-t+Ct-x`b#Zlf2mme)o3AW=2h(svZ!F!v9i9O_!l?i+5g;eB5H@n4e}j&w~U-uS5;> zPnW=52TegL+?u zT9u>vKG&|Q+CZ@XB+O>lqZTO8Kd&wrzL21Pc}P8iS~nabl#=l2wA{LX>))F39SvX& z(9gfrpqgL-T4r?@Xjt=gl6h~qIy(n!-fkv}XB1(-rAv1h2c&hpsE#i{CC66weJBK) zD5yMEWZX`(bwp#7z6F2fy|fa)alx}nTwzYf61>BqYrXfjE7_pxHDV1zb;CmC@E6=; z0Penbc4ETdao{%0d-0}bTMnUT(7!g%7nqtLcSPwpwPah9B8e~EZ63x zJtW&sk`OtRUQ`XJzO5oDKvVh4bDG1gmtD)hmf#rs!V~izVJ)7?bQuHkWWhJH-fDkG zUTNl(L$is6rQ;QY*KIJAhPwa}>asAgUonQFBHd{q89CWz{5kSu?93AI| z5={0WQJ3xIc?(0%CPKRln((vme2;rt5$7kgWfehy1s-{Qo^A7 z50!;D?D1g=#_f6Ve@rB~nri?5Ei&cp*6?`}tv05bXiBck`b?owRg7Y!R%Pq7OX|h1 z2ur$L#i@2FT&jE~n`}7B^VzORk-3|8W7Df)%z!C^tBTo8R{UI-N#8O4Lt%WP$E)0_ zvwgFQV=`$R6@^>Tv+==WUx9z-#?Hsh+`KuzxUHFSWY&8jX7>Qz=|NjHp++q8%cgF| zMDe<%j%JZAwls#qrF|p%iOwL5QDz6v@&JO3CNZb8c4itngL2_$2??h(s3>B;V54IU z3v3LM{rkXIHZJH!nS~TpgUUb}0`#}>jfT70t!$lLNn^2#ZCKa{!%bwbkV{3_XP(Ey z9)#GS%_@9pkD&@IdwKWQ-Eogw3I>&rax=qzxnLysth(K3$9Cae2N@MRWip_cu!-j1 zeod^!oStja1Bx8Dgt*hLNqJx+P=x4E`V1UJ@=Ti%#V_)AGP5oF{1d3A>;jyS&nmsZW^>lcwLmvtA>g}8 zT0Rd#+v;{3p3GPKR6~))3`4~r6}srjiF`(cDo9+|8jiZEp1}8DT0m;W1v3kkyc%-Wv>qG zFg_^+fAl-8VI1ggP{P&awxypGQkYqTERR`+J&-R-x@%0Z6Mzb)O;%pA1?k$zO&jW z^Cs6~TaMiG67BeuTaNwhFL(CErn0H6SVt;FlXby)R#22iBFIf-e#q$0NHI`o_9k}; za6F$r5EU*-zF*tpz`dO_zs3VUA7~vyjeJhJKCQH$ckwWZ*9NFk%*9YELN}-s$7{{I zhYm&DO9QOrj=#e194BMm<p<%T7ecr=0b8oRpMz$aK02n_dJIzBom^XGaO?ZG2zc~BujmEERufeXwCA7 zfNe;zKrH^sJJ?R@BlB)?G#IoN>1WeAOO6zx6+6Fvc@^%uHLF!kbc?$;7#SjCz_y(B zxFzrI1^*+3?Wy6>t>wreoGwav(|38wf^>VIhtO;BA^^cFCC5y+<}!l^M}x^BoGqF` zzx(l6Q-?DHvEaajzYX(b@b;3NHN>%F3C9{8K#7qO;ufg90ZReG zC@AF!(4i9>#v|ATB^VI0U1!I?c^?nu$6P)So1pZ|Fr-Qz<7-co)V)RefgR?O zo^ox#RUM*C8qTLOoBRzY0R)J2t>b2!`J%633H>x}_llJAXYR-}F8n^=2l1+e;;*!8 za_0gD(SqVkbKbanE<_6qZeCwPs2GHHGlfL&t}%a8DLHd@y%}p9x$$E!`$SOo5Eohk z*h$SBVQtKpGI?+yg+}#Sk}niIq2HYW%b&z7H?ODpCU)H`op72Ww>LVo=+})w8F=W8 z%!0^ky`eJ~t(vAA7{^0QN6d%VG#d6u~clxPzMEzT+d28jbK0>O|j&-To z!kf+;GbqkaTo`!0_Z9R`D(U%vfO^6ABf|I*!;k<>)8{G{```3N()CKC{X&$q+TbU+ zjQ1#fDn2gG1xk(?L_*-&R4o5^jf#zy-I=X4^1}EKW%`o!QxkLr*kgp|kgH3G?O22c z&cZ6$-Pr&pLsl};-$|jjY3Xo7S5A{pCxsNt_EqxM&1#BB9H~qgK7?DO$&=5}u=e_? zoF5_bYfMfC6I`jIhc!DP=~*!4sTouO8f74+%l*bIMt|SMWcjgX>TaJQ8Vv|E2&Y~6 zRMIDUyc72lQ(kq1oaJBleCur?isN(pDgQOS8A+?-Xhd$6BA^_%JVZ*8v#lT=P*(OK zNr(ortPp_^x`;H&$W)vvL;7AOaltd=;$mM%s7eYwPR9}X@Oe6gFP&s^7BSh3|h{{fh7t=dR=71wFA4ES(j|C-X9Y&WqG z;U(Ly)zg~>UshlEG#4R6fSLWm&ZGU()ca^=o^9qK)F8O*uJ_cfDG+9T(ZoMSqhS<0 zHu~-g@pgd)qd<#(P0rV{Mk(hwi{+qcy>hk~?MmC#SYU%|Cwn1~N47KgF4+$@&%l_C zWGNJm+B@Rrdy&X@`@VviC5s zws*x085T0%6xRx`YNHrapQXIyfKvWN zW%X?!mD39i6(JOyx}2GgrT@}Fc=^l{YP(gfTlpfy1dknUniSSvm3#SKop}9G!bvNH1$Y>j+G2)P})S32Zn`knn;gs z5+O=Sh>z)x^tPo*o>2fDgn_7huK2Z{j4Iakyf>)4wD9;FO^`iXzU*j3P;DdrEscHQRacTcC7J6kW*VQa>Z$cGjVDWeia#Xh%z|cV6KRiO?zF zx?^HoE{#SnJ%OHvPEKVT(`?T@+e2PKA^*A``$q5A zYGl|a)wX+fJl%tj`E1%ULdITRI@7>t5tes`V-->dl3#on=LratPK6ousJD40q(qiJvafMT^m<6+X1r$x`aPw)bV4O{Ifny+ zM^GQ=0Nf4%->C^#|FH`BoAG*(P)hPhe4fn#rzoV_S)AyA@8Ep1-fVd>Uze*pkdre*ucY z8ddzPc6|r*zVlhN1a+lA30;L1kt9_5k-tx@VBUrE@?Z&2uWEhsLbJXcY@4uhsz^Xk?(whHbg*ziP=}s6;11NeOe&*V zRh=QC`IDZ}p}_au6r*vP_&L4&>~B2SDnA(Ls-j~J6K&iN7*ssZqqiL{m?C3f0*Dsv z>1ke_;9RTKotpQefR}R}AwMRAE(LR(jS-xT0cgNu)7102A)c5dlf71oK@(Cymu z5#DY$-52f!sNizhut*J+U-$O+@obrc%~YQR0zpM$>BIGj1Do?)3(dVw}JW zV(()ZuE1Xq=2=reh7&qx@5CupR>p zUqh4=zHIIx37X7YVkLS1#7b&pu}+D6hwts+6{oH{6qtoK}Z=4n*3*-N4nYq@mvD+N`AEzbo#+wYF z3H=>J8itCb#2tQ+ zj@8k*d(}|iMkT32f2}s1*>TOfso}<(F~JVgnR2}U;koWSjn$p}n}@A~s^bAg(m3M= z`_p+>#bk57Ohet3ZBiHR_jy1$Ec*dHe+e830lxu%b5&aLWR{GPscDDJbM^@@VGJGn ziK|dL4OcgCNhW8*10%CJEJ#ro1BH&LMs}tQdz^5xs5heuGy>hEWvs9w+TUV~?WgsU zbQxjXzh)p$E^Y#qxopo}!XF|cR(e}I*8Y^~_v^r{#umv?j5jwEH4JZQ|7OaY z7b~OrK(#VCJ8&8z2GN@+IEeL?j;sNgx=1LoR+(0su-4gZ;eosTrcO|w$rAA@TwUVC zDV^*FBt1}ZteFtiJ(Ps7O(CTSZIc+acpC7WCSjr6U=cgQJO}IkC|+ZA_huRa^xA39 z;UP~@FwpsWuC*}HJjg6GgK0_8Vbh@ldb{YCS(165XL2IAVv+R;KiStcJE_B(t)8z( zb|OBVUJq{F7L$b#5G8=8pRThR@2Vk4+cKY;puR-*7#p(4kV%qA8AA+VJoixkU?zw^ z^$KL9v8rmG5Ea~|tFzQLu+w<_gA14G<1zi3(#-hSWPp}SXxQIvw&nuXs8j=LFrIYg zJo(rQU4JB;OPg=bvS1^ya@#Sc&vqC5aq@MJ^j7g@1MAufN}cDx%0;gV4Fc z{>utHacSH02ppRLSX5CQlWrD_NpYueV)~t=G9b+QhFuKwq=|!S0aB*vbHvif92EY)Rv6*+>ay z7>9CrYDgduYZj?qNtVR-syFcoez&6cdcTYJvHM^~DV4()Tt7_*9I|D68)TyMWa z!MXjZEX{Id>yj(YLdGjv^KggfpqgiL-~$e;H-3<;|A=Tk7R zG?^*JNw5=lTpd@qe0h!iFq&ngfWn?NrvTBM*&7~?O*K2RSk3N`nSz3yH!a+(hdCum zoSwyX;g-O4fp4Ia@jSbDv3edc3a_bdFi|oxxI*cz{OW4aPArxjdgi;}_q^CeB|E_y zQt})q?xT|cY-;L!N4@qMGLjhE6Ydko-U#;rBL~G~mwl25!|nY0MfifS-t@ndyac6IRRY6k=z|?sJuR4YY&)pLRriUfgv9S69RE#Q z&2za9&tRo|vb}!TkKGHC)&{cusak;gAYGf?q|XWokj)7lav0sj)KWo3-VM9_9-C{3+q!_32!ubjAf|2EJri~l#Y~ZHTE~q1m z%02vIPXPl$ZgB#VY5Tp83gd+|G7w?BW61hfhFS*LV@%92(=Vkthv)6IR8$#_TU&_p zPf?y4Dc6xDHtlcFaUwMAL0{iIuuuyGBngu=*qb^A+8azMzYNHBuA6j+z}i&gD{%*> zL>A*;bGt8|I=a_<%nAUAxS7;2(sr*To|#VuevF+PicVv+PllbhexQL*_2skWbWC~Q zS)!+%yZsR}Rj1No&ar#-@9>zfVp_3o+*Cj`Nu>h#zZ)Mmb@<=TrZfYo7tgozNO0wt z-yRiiFy;99(VyhKsE85Pz1|;ZdECy(1$|iDT%QWoaQ9KpP8>d_z46;78%ukivdsp} z4@i|hF>l3s@sWU8~IE>GQx-_w#pg&N~NK6bC`Fh*l}ZChJ?$JxOi z%SVuW4=HMm3Fiu;?RL69OVJ*NP3{5d&kR(ozh(htGuH}!ye%T5oS-t0P&eEptAVxHj| zx+R>#)^?JJ;-ecs8<*a;HkSI*2DP{s7iXJzIG7Il={8&VWGSxk2y)Ncxytsd4_k7x zxQaGh@btUb{66S*{+cxYCz;5~_}|IIe_u5(z{%Os#J~pNzA>$#VYfAgg1Ylj8|<|fETSw+pq zW$L0dMP1}huBs}y*SvYXMpvh%r#+q;DMTVUeEIlVvMoj4pm6)*;iR_T&F#Eq`eLzJ zkt+V-{an)u?@RskxV#D2_kHsif%>;JW+mp#2u}n(^XGI(UlB1o7J{x@7eS48G-mk0G zHE1K^B~dTztQK8PNO&aK4;F;pw_hmlRsZ;|33DR_Oy2v)Iy?Tx!GI3d-`{PenW0$~ z!C9|atlT=IvV$X2wY7X#tyoYj@S52P0{?QmQ8<4+eL7NU&r&@rrqZd-t<7VelQBFN zY3FI3DfWFl=CN=g<2?P+?CyTwzHP(?_$0kgDrL^w)4^p$$LUfd@)IK?htoS7yTDjg z;kN;!^>44_f!t<({%TdZUUgJ5%ktSi`VoXS?lMV22lun4o{h=9!woo4KU@z0Z9OMm zl?)}mNJas>HIxd}LoA9E5L?P8@puntwwp^EpNCj#U8O|ElfM)ZlfHgCUSRE{#Uh_be6_#%&UQl6Kk*kUcHdD40#DVj{48 zU@rHG`2En&B6ZAxOio&OKwIQ1ZQ;6*%3YAJ+{DGfOd(gd@&co&{?fBbXkPZg8{9>F zdTbgG|He*8rKm}CYi=|4o{}D+7h)XwGs&1r3mw8dYI3DqTK>wR0myzYXq_4A+io7YhI^Ixb?>B*K&#e?_`C*TXX^nRm;}dI*K6x` zK3vStNOC-6CzEv@>XgPTJyIb4H*m#DH}4)`b|`JH%Z!$r9Z$TFnVhAQqaz~d_f*s*+p2Mje~JJriu$asL;FB3 zNOYCX$NmIbNFv@r3J@N}S@1|pxGR{f@bBKSKur1Fx>llI@ia_NIRlIkRi=XU{a;yCr>%N`c z?f!&u^K*ZEsXo=0sn1QP_#&GBN2=pcr>sTW(sm+gU$-y%i(zP> z$Ww4?b`Wy=4-TO7+R5}>hynt}&ANi}?e5-#$vdbr9vHw2pEsPe-xw`eNj3&S%JR-i zw}1_Yd3E8r`@r0Z4~tATUmw_dUTE~isZK(xBaC4mN`*d}9SNheLnJ z`!^ex!w=g-jwA9J6VN>zL?>60ABm5M6$1p2BGe?S=?sRXK+Pb^NA-q`NBLGV(6dnOGPyn$fEoGNq0@U>lT%=S)LB4pqpa=&{ ze;IDplZUvJswm>M5QzU0DnRWa2Xli5xJxojbYm7oH;#7p^lm`Nt~>%riVY7*rXlP+Q}j^A3+*$HDNc19_L5JB zSVD6hoAcgqm3wxKp?aW#gsvl0=@PDu`vl$deEdPQ9wkrqfegH-ai%06uQ;Q%Ov^Ko z;@EKMYH!7IH@CUVQm*v(+xSvK9&Bp!)u@ool-=IQ>8}cKl0j=3&C7%h*$N0|>#tYd zAFV;50gr(-Sj;#{7A0T`5y25a6hTu9qEoLxbd_);u)@8leK;$ zv%WH!c3`pt@7%C8B>hs%MT1^QfvhuOOL@!Kp^L7maigLBA#2gmpYv+(b53yyV?8`i zsx{|c+HDJuMsqJjtJmfJS{D&LpeOw48A@#hM`&xGc4C0Y)yVlUE^Exoo0T*H`7jcL zv{Mm3T595GpM~cLk3qwH5yeJ2D2pjnJYNwrQw@VrBD}#t-o!6K&p)qE4Pg3MkO{)0 z;YzvVKHc(ESe6Vigr_~H{MFi8;ZRRzq@c7|=`8&77f&;rcBOL#+3;2dtC1Ww?nRk5Ot9sndK5Upi>CU%HoCy6Ii zLGKNt<3kYt+8!hd%WDv<6dCZRk`np0W1y-r?;;3+yln$h9_{DFFTeZ;$|hc}pa|sR zJoLX{c{vt&!#u1!ls=YaAP)ndg?E%2uPS=uqtyF9A61p)&RX6nsBCI@f7+rXsxGsA zLxZ^%91mI|rmqfb#@IYI)2=!O=wd$x=)mjo?7z4wD?uP!B5?&4-FchN>`(fTgA&zytw0fXTH^+IHrHR7c6oAUXFV z6$;iHb3F+l;(dNLk9s}+P`Gj2dH<8x`w1ApnuT{*BDH-|ezRMb^MYcWKgJMGhS?CY zGY~c>VRJ%1w^e&ccZSN1AAu4YHQ5RILGx85sXjLsdA318Nb5Qk%Uvt!F{kFY7q@p; z2ZwKA>cjWsXpo_Q=KrB@xH?~OgXeOY(KD!NOV6gf73#g z8KsfI8|z>1EA@0~)FjIZYgw1x7At!d4=uX4SI}Bq?v&G7cI<4LlO^Wb zRn!zo4X7H2CCv<|nzX*YD$ETMqk}FBY08`Js=MZ9LFBUY?G)9zUMDj| zhbHXk&m<9FN5jA!mU6P$rWsxs6rj*!Ac=SX%V+ox7JejFk82L zH?A6_lybO4VmC_P!HfrKmI|<)chPBndF>8yH>9(l=);JlUUf!-$+KSHu!1#3A7gu2 z9?=yRRC8srxnd52l3iOlpIf<)sP^00M7L@4%wYTR70=tv@qQ~p%uPO+h z#AYI7XkjnM9ThO)bLHNG4Z9?jCf+`c`h(Pe)Butk(Z$nx*5Q@*bl@IOaahb(J5MGW zs&FtHB@YlSjsH$13v60x_qlYmJjBH1d)|NXuM$xQ>Qv|m6xDhErt1$XJBPQIB?ZZE2Wygs$;B~* zyt_lE`1L*wV&X(!o~@(zlUeg0BU#U|;;YY=|3nscH{dh{A%>-pr$$f`nLxInz*!)* zWuml}OAWB_0_SaI|9UJu;N`fq0c^>ncYa;R=ZO6kmGW}8s(SQIvy{2JGV0m>M|MZ) ztO46IN(M3*xm!psqy6a8FNUuu914Y=;ip(_d%utN>gn{j>g+k~;nM{(o4w53of=NW zhGsVZaSxt}k2P+9`a^8>QY5M3E!ZrVX4<(pa$7ccv ze_Sx4vu=Fbs-dT1^jhc5A?1GfR$P3g;@J zTp_RL;HL_Y%(Y)hIqVX@54FG|3C9YNn;b77^Y7_lz2^1+zSy`EBki9-8tWW8xI zVlm8sr5K+^4bm)<8D+_0@( zi`&_&+zddud8NK@EJ^B$+WWohH)RVv?cOveT;U z*}c;ak}UOi<+BkiEF6M`*0?nZ`<2{ly?SSlHC~jeN7h}EP2%pIvW?w4$PpvW?zT-n z-)bc*${+GqBO4K-=;AATf&YSkQE}^Q`mH~(QP^KdzS2lesW77R#Dn}OK}=53cRyHB z>?u?;az=a|qp$`uRQM15X@^M1;o#cvMw&KPTv#pID1;Ha7w64@ytnlm;8`Ggzo5HP zd}Gx&XAEyz&byvTaSjDv@BB_`ZpuPz5cN8IGw?!eO;Z7tMHKPC@!eL6)_{q)MA=7+ z1PI6Y03tWJ>FLJ7NE${KnE5)+6JK|^n3{>2!N3qlPs&YsS-Y_emFF#YNzle^qk zMn=4kwU0XU$0qlAe>qTu zbm$0yr!F35-k;2;mA&C4wFCbVJ=kdS-aTb8bJS&6h2U1-d@(0}1D|ya0OdKp(@YD% zi}e$wM0WPJc9I+}IJe`D)o%Tz!H{lJNKdkP4~z`6A2Formj7<$!i) zLJjOfLtiyZq~_;$&!+ilbiY4!2(eemPOO6C)m|&UCzWZBr2JRas4O0f5-c(w|H(G1 z#MTzSr=T_F8mKG($>^6sv&HqEwE)lkI_f2dnXOSivqTuZy8!1IVdlC57n2XG(s!6m z`XYzQCW=T7e;=laqoAfm?pp^)_sHb4Ztg6GScS#E6OVj~FK>^TTAO7b&HH7ATa?96 z&JyQxSebusuWq}PX7$%?W(VB|1TG{>bgDK?sXEN!7=XU-p8n6bOZ|#Kcj*;pJ8E@P z`Fk2|?j<353Azb1A~@LQF~PN@8h~=PRyJyMvg62kH!bWX6#&oOKX#OReni|>QF~sk zk3-V#{_p|a{q^uL{GLa|?boL~X!dsHeg8=C7a>j6zT-biRQCT$qOvgluX$$k|66+# zz4gcsTTJ^9r8xt%adyGeK-?spEI)~QKrt;$>QltCiVxbrzc#rV8>JE+BwLhl4TFz* zre;358#A|L-$+CKybHmOt^BY4%EO?=UGhk_?s=o}c{2QWEN6@ZQ$va=4Je~vJ!w)ZB0ZJH2-ua3 z2s0g<6e!iI#8W|+uAB+3OXI5&Wnm%1GWhS00?ma)Pm$TlLYFMsOTer52wsVW)Elfg zN{}w|nT7^DzGuSdPCUIg$zWi6tBHzp$uB<&L1U%4<~uI@nnFSq_zT%BY*AhoJ)FXh zvdWdM8|mhJCsYY2rp}hCn)Bu>^9gHBr&iXOO|7>yon~e=2DKE8hJ3h&>_6r3SOUC^ z1D`OjTUVKeD9GkjldaUPWLVI@)u*}*BTX~!&NzjohNP)_;lCvVvQ@U*n=RW^0jb3q zT2{6}UH8#{w7pPPglmOt4q+f10jb@t1>X8H(;CEEy7+~;^uM|9?E;JwgS3E-NjH|# ziEm1XLCLlAokF`rn9faXg0@Db|C|S~+J1aBdV`Z-g(E3@0Ji>o98)2fV^^0BPcq|4 z5=EBtD)6cm=zldodn;EOA>bj)Fpb%ORWS6=wr2W6iRl z^qs&qc#nYpsf~IS+xnH#&ZQ5H1nz88bC3xFqqkvb^@UglZG!BeTve7iaMw^`4N)u7 zw&5S(`9;Efa{Gm)kU-l!T*NNl#Pd${H*SKj3Is5?D5Bdz}=Z)7nWu@5W zsB3;P{-eLC&M=NW9{FwM{#1pl?ZJLfUP{ zN<8w{XODAx*dm5*iwpr7vJ-Sp=Eb!~-H~CNGx4j8NL$^uzY=Ns;~F!{$Bt>!VrVcj z(!`GW(Bh050XS582>%%YVV62y{@Czlj2h-^r3bIv$yoJ~yCL#)sxq@Nl@5fLuqYCM zY(c}t=zVyw*ReeJ0^)Gd7_jIKr{UOW^kfZ)^H4Kxdn+92ginRV;FqL7N zg&(8(Rrc#?F2}mcL=~*p{0{*Z?)RGnR^sXSUOw9^`EK6mclq@#Rp8gRaC{gs?tu#M zbkYo{KMQ%=2L#ejCj#HM380=+tgE6hZ^G4pHLH*@nE`2_#k94`?ABVwp9bz1?p_NI z5R; z9OGI$zhA%cmfA?%C^p79un2Is;utY**WhV?7$1)W1Xohc`tOdF1L}QGbYsu0MnZhe z`NdZn3Td%fgISQgwMO;QW9+#u@llS`2wpOHcH#V(E}E=i+o=3$@B43~PKr60e34=n zzut^MsjYoKkw$OP(Kju513=vlrih2qDSR|ApyF&35upqP`;6r(bD)(P`_?-OqZ3_@ zkg6oW=2|TDc{ZbfVY9GGdlM5yFfb+WL&)H+q#zNv#cKLN%M6xI452mvQeW$QibW3l zXx(}BYY~>cucQSXq1^^#Ssg1R ziU+7iC>M!ZLmBjJpfUFGOoIta3X+lHZl4&WjIWl*PX-`ZFukCV=~20+-e{J3XY6jHU|gHOMNX zfz!cY2>AKtbDqS2f!imZG%zMRSXVKQaSqMArSs23Z!j-ZOXtN8k2gd7n(uRSuQ|O5 z|F<8rNoI+y{Q*rhxM@W9dZvK+5w{N#_M4}w_q#uOCLiP@J6iCsz5GjIAMnijFE3qG z`UJS{3ubEad$hFd<2filJTd2d-15fjcWG2>N!|P=Btq#}de{YOAauQ1d%r-VHHidR znp+e0@MNr6Wbwa-M?WpmRJL?>KrQ?zG0^)_pCC`oEY80Rv~5H7FCUmf>&xkFD9@Ez zH_UV-N9%@7N``A3yrkUlf4vVf1#<<7{V>SHWN3}%KNBGFgphcuN4-J1HW_%^|r7x^-v6Tsy^4{?KSm$H`~sA%6JcCvlL*0C?PJ!$D}f-I!`+Zu2h}C)nEblXn4kG&reJuxWgX#Hw56 zuhCfO82H(9uxfFBK$5qQSnjpE2(1kh{JUM)*?iZcg^8UAC6qz$)|y`{gvfx7S)&$# z4ERFvBy(d%q}t9kY~;x2hVt>%$GY+3tq&83_>G%5!X@|*)r1jmY6PgXqPTJH4X68* z>ioUE*nH{Ps}vu!7*v2xk!9 z@LJl277-rDcmLk;DU_i6{!bE-?Y{zeGcq&(FJwWphF9FbDdtaaUSK;2%PhNX8yzpL zfYIpv9}G-ar_vUFALzcMG8Ev*WQmCil;pf_rcSBI)SA#*#8za}9$E@bZnSxjZ zzcLiYw@a?a=Ev`;_m4=9CGvU#C9@W1^CNj#LnMyIVJ)_j`FFa;Jlqj1Xd(DghnM%u z%}b{^ryH_iK?Gm#Zv-B9g_>290Hgh$iHn%r?*i^u^`n{A%O-ZSf=!AFJ-z$=W&9$d z2=yy>VlpJOi<*}QwMMrgvPTJ2hOjqYmCY6C#Bcvrk(=&+K#RDw?Ui%ExC!E)e6e-K zA6DuuQg1hSZ5$2#=J{SOQVrY3kdlq!WlrkEk-2HhELfUw0gr)u&zX(M-D(gp(!0ZM zAQKZ3$Pz>vTm>&va*PCjNH52uEfioUGwQ)=1uxY<7fqu=0>S#RkZkhhv&Mu53&s?8`t%?nnB1}ABrx>kr}(It>lnv3)bcDIjJwohV>lGxq3%i9m8Nq%FI zVL?U`&vT!#`-T?ECvm~@s}&Vatm*ke_x9bk3vjV*9XMtmMIMT5rb?sL8)~>$ zS>(-FDN>b8!FzwS)5|g(!Tz0aoPvlv&STNwo(~$jtA~Nsjc>xe*GPdg zt@B}<)y0Ic#(Ne-E#|4)F;17;H^BQ zn~n;U9v^X>*a+zN>I31R>$=pFl!!$O?hu5u$~osafMSjYdWE$BeAAJdbi4 z=*6Z=5A@7!04>8#_=c3W3>vE z#8;UVY(Decx2vuDPUA!;@<>Mgj0l0%FvZ2%j^|gO=beu}&mUGQc^$`eR9B7M%iske zT=WM4o}NC7s!EHL9US4}$63Mckj^l-=cF_6$R(;~(HN+R@VJkFy{Qw(bSX@?AKOlK zYJgadnJJZ(-Qvd4h<{@GV!~@QT>M49Zf{{JxWwF4J>@+AuyEv_!+al>VPzDKpA9@? zRqPG22y_Q&C(UEmkWlB&RnFs`kdFl<&`e-@oa2S?he2@t+5Hm=qQNY$;Dl}g$YsfO zC={{*f%5gH5u0>y4xs>n(shnkv?PJ+-U>1Dh#G1fCM3H&wiq;QVD0mht5NFYH>(wc zzW(Q%^RUaE2EPHKHEI^3s%Rw|x+VIkZO)0l^1uGKSlF^CwD^bUpdK+bIcmIiY^2Q` z=9dEfkhn{N2YMbuARxvBc0(Xiqn0yeBzR)hSUBz25sk3VfKVz+kwMk7Hp0oG!J=e| z=CeNdtYXBHIHNkVk3qjLbv?dlblc$naoprAIR$5ZQu&e&7G#+CJ6QB*`}xnye9P1oS<2 zYN^_k2*1t;vJj)(4__=*Ml6u}*Fph_aTqRmP^4F=Qs=7ryH)NJRU0835HjfQeu^*V zfUu;&3|+wZ2Y(#u@6XaOVd3ZiM-}-7DOKOUb$R;@{ZIejjTVW?KVMt@U^aLWg_g^7 zK6pvF?dtYB81^wk$cHBwt7b0wD*8G8doRX_z5ag2$bo*Cm>=`@`f^x}>0k*46bc}$ zNemzE=w>LBsqyv57gz$M809huGZ{nxh0wUj12zG-fttPj?SMq}i@JHJ3NA~7&%%mo zRrXu-nbb!Kg8HN{{SM{h>${%qS5%IzdgakDQTc%M(NpAad=PehV9 zF1TWeHvz5}a2&Xe1U?7gx}~!z9xY_OqZ-5yN(h*t{vn-Ud}D5m3Ht!I%nXK#XnKsb zIsh8UNB;MEUBsAp>TnG9|hF7s}06CrrPL%mx$6YQl20<2rU$H zf}q4R7>!;NhA2#*1q!;%0xDbCzDY$ViS=feOQX;gU2LQIvwJd)j%bT1nzu+q+Sx)A zNdDD@{<4{{neVq@%x1wx(Q|W3P#W~&@DsssrDZn@8SlX?R-VFu5b{QpVT_One;21J+YWxI>}1;* zxtJLQzB6U6b;t*Z(!+bAnF>g$u~-Oi4yL(X^i(DSd#r$8cTgU1^0mBCuJocwCeh+!y*5`!;0?ql1#pNn@_JlwX>Bl zAA2#lx>~<sGQQ@ssouC(Yuv3TN)4^Eu*}{8GsVm3<9zxAj<&nF z#{be2@51fVQ)^>lvy)xwN|h3twd^5S`pr)Fy1>ZAOf;cFP#W1uIo!>(z2PTb;DIkn ztgTp;J|F_l5nCq!avx12`LR_rB05-Va9<oapt6zj5Doju1ynJ_jRGN%<~ZJJ5o) zD~?5a$B#n8(Ah);=7M{DvqepljkP=59Epw?stXs`Z8}R6bq)XSb=3{88)~~*%O5Tz z?h~zHz!Z~n0JRK=1R-}%Q6MOHvBn3sWdN&;2XsIYxv0M0fOM0JiKHB$K10D2nSjs< zb}0qHAyrS5Re3Y&sr#s^oQLOX*^hrNv-}70iBJd_G0-`52J!3DvBdoOx~xX8-U?xt zVBVkgo;}q1)jMVFC$42!keNkc%>78d^tz=^S+nVtdC=_NFW?9bDhjsq(L43jK+BEx ziCI86fakO4MsNf*jGzUxZ`f2WVDRD#@i!(ik`3#_7f_%2ak_(&0yq75QFz&Q(30Kq zG16C=S{E2>4i+b4Bx6rTk5OTc6uV&TZFgT)66$_-%h>^(=WdKbs-C}@na@5=a(kn~ z5WEFoxwG13)7id$f&aJa{S4o1rOTqcad|ZlKvnryr-A7T+e_|Y*~Emg!jvF}UOf{I z`!8NHJcny2J*ESPqOVtQLZ{*2%C@jYKc}4^)Bp+tf*WAzWptYAy(EY?=yx~5cPK~9 zju6KrB)%~lgr!C_Vm1omLm< zw`9(WvThwZ;yOgNQan2s8A}+2<3vsq5~ypXZo>SLg)K^Rs0*4E-C7DX8XrVN|^r ze(GElghvm32R~BP03DZu>}6x0&P!R6)DgM6U)Ne3q49%BC2q2X{n4eVgNoiJXHgROLWQ#13&5F(H6dzlg8qE;MfQWjNq|hf9}hkc=`Aa2nJ@> znMu6m9FezCJ}`RkDE)O+@2efo0Ck=asxV5R7Zb3nNQ3gRzt&a6Y=pvu7D{meR9Gdj zFKhhlCQJ`*q+?cnN#lH zML&6#Z1^Uw>m-sZPf4j<1d{H0skCRjTHrl;5JGYm8BrUz1%{scNE9@iyd!pU#<)z> zm_IsWcg_UKk7CVVeV>EwyGGOo8Q?%}kXA^uc@b|2eKPa}y?vcA5x2LT+a9}wf7@c- zJT5bce;f+`36NAEGb?9J9od53NDIPCy|Cu24P9CRo-B&M|DCc52$!8IW9aV775K4@ ziBkn$3Z>CbJqpd+d{7d3F?Kcu3Y=+@_}lMo1X&>f&m*1yfx~kniHd z$XdN|0F#?o3Z6#Q+xWR)yO7fxs6vO~W5d(3u_zZNtLGM3e7yU;cBYAJ-;`G55E^QQb*UWjADBJ!g9oO{~5?|bhB$_rhoTZ zJ+gba`h;0YI&zzh`)5b>Ieq(v*%vQt$^pZG5gzzX2qUe4Y+NJ{CPL3BicPzhFpr#) zrM59I%S|y0?Y)xivmzKp52;l7Ol(M|r5Fn*$H{Jt1+gDSf9#IN;*}?uNj4Zt%3z79 z;2#v#M2+poxPQ;_!%L(VB0OS!wD-^208|6r^b8+{`G**S*Yc$1wY zwp*S5sJpS!03Ck5MWIsYXf{3P&cb{qXqt`R!yjND(*3H6E_jWEb}@*-(|i3O^6vOa zEh@?Zk_gd!Kv z$C=a=O6`v!*}L7oFZd|r)<6F>w){^9O-4q}|M0j>YgpTFvY~wU>KB3mQjw!gmgCWd z(O6&e8Z>Wb`9^&XG#rm;*mSgZlLi#*@+GAwJx`Gk44jax{4-8@-w?V=41bs*LQmow zd8+&vSvNNNbvN$FRERP_ISABbr;7SSGoU!^c53cy0RG!uX7AHVQ9SaL*{Rj4=lA(B z-D4QJdUt~ykjMWC*wbxZ7tuy__U`1nDtPu~aj3ATkIQ!8F37{RUSda9letdl7fUwA6%Z7!C)20e^@cc(;oB%O^$y!j1(jiMe zPS16CK87>II|!--KnymiFZwpa1J1wx*kQ;Lo6koO%5OOALI`^LSjH5Ir*-)TP>g>n z&n7*7F3}{dm!V8SfIP}nl8{}e-5SZl?36(&>49V#yN33R)R)|*G5){{a>cP*m?!7Z z6dk=r!h~&`hM^o8D=z8_yGprJkOS{j49k%2lnH!the(@Wb#bxoKlxlDz{DkLinm^XIcx?Y%v&;LkSv*(bvdFX^vt^T^aQ>b1L z4l*6-gi#-*Md^qtvLWKb09s&d->V&rI3RHdcS)+aCB*FQW!S%aPK`RszsUtar7L0o z90tDtq~HP2cr3hjylW&|e{Ib7`Lb|vZ1m~1tet@17#EWhnM>MS&U$Ih2^404XK^#K zQJ0cMUZ!JczWi(F6eXGvOY-u3urj#jNjSmjc3@(I`dB0Bw^-t^Fw!QKF0nf@JEi_$WXw z?-C4Wo#OpAvls@`TbwIm1|=o^sEK6(orK3CrxX+}lc#hp{O4Gw^=va_iy}od#k~?5 z*OPRvPJiJ_v4fg(aFM&@L~`do@o0M_Y*oj^Co)>h>1Ir^J*Bwc1e|&!isv`KJ)-C; zXN?QAwWHR>Oj@sBG^QH_k*9acVw@E5@KIW(rCS7PDj(F@kbQB{r~FNnEQE;3)|jW3 zA+MF8PC8~Rqv165jp)iFmihCJ?Isp1XZ-B{`A_YX^tER(H?A{3hM{qIAX215~`?-{3oq4IG<(|vD251#T zLt3kmf&*EO+robYq^`c{7+d}PNWSXosoHEx9~JeekoXgIb4&c}pV$|hw-gt5e}fT^ z#cG7KMQizlDY7bEg|_`xfgz}%QO2lI3%v-MZekt0FUufbkn!TV6An{5 zB!L1oDejJ;6l`cU%d2L#UP-nFtg4uihk+F8LIP~26UMkGot3xIe znT|IV_1wrh6jpP|X8ft(9zaCh2q5}Ef+-0=+~=DPzn&yTF2_v|X%tyD!~1&2C&Bs4 z@ps@(IwxZA-(4;B>GYDPpA>FTVt)|FB6Rp)I75lMwagj*_FeiU)9mHESqx`N-g}>! zj?dm1>3FfauamvQlj>O==t`+l zmvj|`_844|Ot#icRt*m+Rfo51OK~xEhVk7G7g#a`U!rt0VzO`s%}Gif7v(q>O(108 z8TY1tU>``hbiu#6vWt(D10F8L&&$rs5vlJP?N1K~-K3iRYU-PJqQ;#=iFTGZ&U?t` zn13G!cnB(-I0mZ>#pNu>IQLh(o3s;i<^(I5lZ!_aGP%U# zO$l#~&loqg&BmW$@MEsm%WY=GY-V4~sC9{-`i?(pJ{4K+lZ}J86(KK6NwyYxCPy&~ z{|T&Ki^oS<^xgO`dqk66?g~vdr^|N(+O|_(yC?_f1J1YGP9=R`w-a-TA~S(}Sj0;K zhlSb!>{sFr5C+Pu)T{9mxj6~AlL4bjq|$LoUJ)JSgW{n%i*v(%ecs_ncF>)@pZRNR zSs=t>j%PLY)WNk4W38LNfKcIU3J)rjOokAL!g6D!rq1j8ejmK5Bzr&4rxL!ZXExcW zpLMNQ4sTew7S#3o(y0m_ySE1L=OwU;Bogivzr4fVM;aPK<6yuNN4a4LE@aSxP6#!M z30VlL3;@u0amI}zTT&cyAldDo){ugT-I}z(0`kbW{#Z=|n>tp9&m6x$u4o(s>l#FY zKf- z%@-<+O7QALE4gSx=?YEE&S(A`2v#6K3kQFlTHR19cLJO*(HoLHkM1qpy-iZHLYfea4Iv?^r;PE_NXha z@kWqkrKb@}9&tD~Y^;5N;J}iB0);8^2^$5K*kO2@YhYM4Ek%p4y^^j5PC0?>qDWXx z7#b6)fMV-Sd*-?_kRq~EqOmi?h>$BmEIH3yHalIi%}Hh%4cZHb5HB%Y7%JkSy-5+< z^yD1|Ic-^?*W!#Su_C4V>ZmH~iZ9kDjF=*0h|MWpMX)@eANkPp_LVJ1TEy@@q)D1^Jp}i5~?<$JX_znTbC0^gBcQ_J=yB=G#mFiT>*!aTI zehFJu^+a{AQZ%v+@te+U_tc~y!R0uckw}2CF2`<_LJ}<0 zg`{fRbcA8quG)#K8I%i#z)F)}=n9()%}MD`x86~i(D}Za|4TC?Ce!B8L`%$04TZ~> zTX7^_f;~`lQBuOH7^M{qJ2Sj3Hj8*n_)@dNnX=AZ9jo(p`ZBi0S>MOD&EIW&CsnQF zkCm0v#)~_q7H*7pKXIVaWu=3ykIB-Ykdnt!&nB6TrC__hxifq@-T@uuUjB_0m$gg4 zWdgf7v=!4Z3NlA^=HAM*iSWTRnK|Y0GO*Th&&2f?xjoXhT-tEY@n`PY>1L*`m(PSD zUZhZQO&Rd)lGW$q3#dUT5~X=CtZ|_tHZgyx+9ab?R&sK-N8!p3w{r?#;~mxb7S~mQ z#&<1g+bF0r+U)cNo!BcDLIScPk1o)p#!kz!A*YD8X%}_X&~KE|U@O+5%VYu(qxMKV zY5ssC1yGOXd=T``Zniz<(V}vRFAPzL(AW$EVEP@o+}+*}bW#&Yw*UH?{ZC#DMmE;} zAngomX#bx8@3&izpjMC?9CfUk!et=fh0WCr+G^r0`BAVYQzMwBBPpjEef*NJ9j3%o9C> zj_xRTe)au+i)e}>Id0IF$Ls6<;+4iQa!{nVHei4I^C$Rp+G=^pYwD2Qw5_#?K1)-m z$)i`Z(o4*A3%gQY53v>|*shlAUJEI&IL4v)GW6oaw&P~9%aOD*P?VS7Y?lUg5CDo{5kmVqgk!|1LTeb9{Z|Wt3FkiR6dSe&B-w-nGS7^6{DJL zqeupXd1`NamC9L23Xx2Q_OnKGx#OaiuNpm@7cdrx7?N_^b87{gAt)x2<%wFLNLPsb zmK5T2cR{kNwiY{yHTRUkzbcOUtA#)Bu5;Cp?Tc$?63_&OJYFCYgK^a z=>PSn>A~&#cTEnv>-@9@mhqB4gW~cJeKeH|#30AQ(4kt&Q3fI>>aMwn5Xj&bH06+2 z!)FIwbpcFZ35OX2iVS0#P+iHM&_rTC+qk}84t27DL2rm8UViF#*&Ooreo7OjSE~(M zYH(m(ccT&v+giDm_9bgC>*W%EN`Gcae3JZSCP5<dLRRo@$b- zL%Q}`tuEcLM)Z>l5Q=0|Gn1Ng*baz!V&e^0UdpqsEMT|t7&(|mMn1obFC!>eU>-Z` z39Y37Fn6ys;NgHEHpbdlZG!_{vO1|j!@eoLbc4%--!`(=y8Z$L!j?CMkLkG)%5BU8 z&#VP&u$g@GU}1s%vxE#1Q6$NP(hIpB(_th$ZoxxN4BQxhK=hdSh70QH9#`o7;Xr-$ zKLn4L6kWc$a|Q^%0&mlfb%vtkWW)|l_f>Q>ZFJE-MmHDK37-v>gUCTVgw}x!PCrj9 zDTa^+5~ha#lEUNZj;J@tS$6%7kLqY~-O_QH=Yge(2m0$$kp$$d4@`1}SAkq)ioR>@ieioHY^$d^dF(HNuWluRZ#ux>^~UTfHpawwNGpxMqLJ zwq@D!0*h9I#oq@i3xnFMnlRgDW_c>I99&WG83?wg<0m`5A!^9g06r}kx?eCth2wz% ztYlkjq*hS{jf~D?#1XEMyM=@*Up>8uK?LHga53B_f;JvTrJ@?!x|ciL87NtwRoCVM zTXQuiKpd&(GMkI#=i6T5*av>ciJ^bQUDBjcTdjy{#;wDX4e(Psa932tBNgWn3)Yg~ z$Mfa%ar|Ts0QJ}lE`pDG<9VFt98P24O+|kH{l2Ox#2~VA-h_}Y8N$dTfG{D+1xnev z_+4rvV@`K?YG-N`pzYj-!gv+v9lgxsmf-u;`Fq<_6TQ>phy2t_FgN5Cl;y8KYMA}i zc09dMq&)cGvgvY^Y0Krr$%4xOTH4T-Og-&;UGmXRcTvZpPqo)VuRc+C-}RN}#;jE| zT}v+OcF|F~$vOk*O`%M05Ls&D71@EF_crJl&h+I97({fuJAzs1_)7SYdR&H%SALMG zv;tkOx(f3m|Jqb9h3s4h{ zjfw>2i(saA7SF%0v3AICVY<|O{>sH{#?Ab>9I!vH4s4;}QkqWF>%lr{d1Y~_-fZ1E z@D!9LsFVOq{8C!f@gaV0#CRKwgBLcm5FRVPtnf`3F~%~-SN_U>_qE!4+X(x436_&q zGo%j(Sm)CAFIM*tjRa|h9=AGHy&gTV<;6uLL%=7RI=>xzK8?!%0s)~q@Bh~a?0vHbHpti4J;8m_uVW^@4MBA8p_|sl;f+odfM=Ld-`J7y4NV>h{e1*dppXM znoNSOX?glZ_`yma$9uC*nNVc#ebSYxRL0M4(ra2a$ewTK%b7HjNXsH2cK1l9eIC7D zm4YKR1u56LeOz*+BzqIxJr&n%c4;riM5zvPcl5}097v2un7djM15;odj8f*2&;#EmO22nHXA_uu;KKVN z++vo3>CD_Blk`seF(%!vmj9)JxTllF2;!aO^=;P1M|vRd8mO&+EWlb>F* zyXh|4b+JEAfUaH5Z`G4kd2mtF+osk5H0lxtb$VxHCq4vgx*!sa1fa#cmdz!O-83gC z*cx&Wy%9VSkX7yDfx1FqhAKsS?n`Mha16VvJQa2)IhULK zottAdOb}N-0(QL&sD}!`&(Oq^Hb6!|ggXpq&#Zg=DoO?Wr(wJP%Ea?5n9il|w<78Tak$zm)}wjTX9K`RKqY+fBAw zcQfR0Vsnv8`a#Z-o}e*j#cQTJ#IBjYWqzp`k4{PE7gNmh9_>_UYn&K9a;>BzyBVWK zlt`NXGN^D_mTQaUlK~|$0{vQ=Z0`C_ zGd4^9AUHu;y=uRCpS*g8P~76@?{lPhw_R?wAct+YW+`vmJ^&o2JR>nE+k5>kPuAJn zI^Mx=lN=0N^A^wINLr93IH4`#%zBXZcDj;=UlJ&M*`DFgVsKn72Zr{*6~-mAp|6C{ zKuSQyLK;G%h1s*dR@Z=rMh*DUeKv2Es;=)3^>Vl(C;Gf0N?8GF?u3^}?Vx41zMrXu zoCT8rs5Zyc*FA&Z+ZX)y6x* z%~)@x4*YogH)Z6&FnY<5TO3(fn1#$U`ozzP7J}z2ok*THh*ORv)b*!g`;!0z6ib3G z6U-LAaJI~FqBRlD?u#D!xaLhcr)|B@PuDAchXkrH-Wch-=v8yCUTWIR-a87-viE`@ z-lfhA(-3f58~1`!-~0Ss;wuXx@u5O2q-v`B1!oowk;Fw=Gi`<=voczO-{oH!28>CB zI-AmC?aj8xo`7$+x%w38-XCwX)n0l<3%DUWAiy=dKiaP3&-;ki*q+1T@xw4 zk3&mD=s#6)SH;9c1f~r)G^~2IT?bke-G}qehYHH~jt{L_NGGJ$|4A=|2A&V6DQO5_tXxxlxyKxEHIr&!fdp=8H^bY^ z{WHJ`H@ly50|K#>zpV(;?_jfRXA8*if!p3}~eselZJD^c_)* z_ZSXML=i=5L28z}=r4AlF5o14*~E_IZ=!2)M9Spv`_D{tnhV_i09^B_dBY_ zx>98xvbfiN{94yY`ws_RdMOOlPH?DO;*5kry3U)e^@(AW!~tA`hd zx?p+x5#wU*I}cxit{-l=%l$2PKh4FeLiP!E{T0A}v**eGwaYge%!eOWIYChX8a1|n zOKbR?wx1c<2gK?bMC;3PcxA+N`t>Ht6du3-WvXwJ9sW4}w|i58q}bRR>-QK+{tu-2 zBg(sfF&XormFVS5&FJ)H2{qi1?)>{Dogc^m1&|ra5-%Q4XVsZyA;>kkJconn{&-h= zgv5k+NBvHZ@8?bV(NQ#4;(F2L|>VpVD$L!oi)?i0}g@9-~fS#AO4nywS zFN|pijRFZ=B0P2IC{p=z{;isy=eA$K4La^`3bj6F#osndb>MacMccYIMD}VUYzZ#*KO5_hY~Ja8Sh~i zrVUm7-qLnWFz>?^%QaF|(DBL!@1A#^%tH-#+x31WEt1=ddzFK~cNeMprj7wN$x5;) zr*bL?p_XYGy|-TMHQ?P3CKdLEicPLf_(@JKkKunVxPPl>NB`hn)Va!!d>Cv6H>kbI z`agW`QRCNbne;q9M0WV_Oh%L}R6lrJS(hg+`P7Xz@07~&?oIddz!FQKa~ff-NCMO$a(fbk&3Np;6G2@mJ}D=5vJ? zL{21T1T|9ld6STJkCrZHk5#o$+JBmDBu0&axC3ef>X0g(N?x6w^9BAqp{V5-TyClS z_MIptNoov*1ACktZ%!3dH4$C7-dgryTehs(+|0ORq3+*aH{Pdb0u}w8Zuxa}#|rnd zPV3@cw@kCS-F#3`7c6580oppfvGsu5jgze0Z`Kr%s*fQePg1Uj`J6fKRF9FU{aSGU z-01BX?Kg!!4d4KK)@MwOG2Mo{3H5rCFz|&5`dPA@4v&div5{n%_;#a27Wt&`HIIR| zV|hnep+Z}MLw#vOa1yn{ANiWZ|r7m z{HCCemv?({uCaikQ|yRHd*~xWqf!-3@oL7~z~%SSTwTgI6*)UCIcB!>^@xx` zx|;@7<8ed)+nLB$rq8cL|Kh*7ltB)Iv^}|mNr;mW;28G7agO*v8Me%_*TH!6jQUY) zE4xa6eEZSZ$;tZT{&>5qhl&HIW2pCaM!J8wZ@h}Rs0-VEqn8FPpm0~VkwEjQ^C;in6Ey?pIza->h-4E4ni51{kyiJp{ETeXx z?F0o!Lb#D|3LkF49!5a$9Egdm`{b^%Hanw;pp3N;#<`j(w8+_)Q~R%6fish7y?$-& zm65DzUu{;3YO;rxENJ)>b$8a9j_d#{@k1~IC&N^|63VAM6_lN`ggLwLcRYu~Vvs|B zjedPADS<;lD^?tXc*yE^?eQ?iZ7{UOXmyLsPgtNX8@aPtmlJOtz6DE>pq%7D5ZJF~ zYa=V>!CU4$j(oxaXoGu~S6Fq^xSqDL<R9B8C>!u^p&GKYxRaiMdUt?e zgQf2PrVyQ%8K>+Y%Hd(tse$Z=&=BYJs7lP5?0Lz*6(O1aKGs^s(`syIAq;C=+dBoV z+--@>me`xr;P9zWGP$7$<1NQI32Cin>Uml7ip&&iPo)H5l7W+8D4T9(&q&(+xs^-Gv~tC*?|-ULE?AmHIK zQa~osXepOo%_=@NihdV)0m7r?EGjzO@(5uWA=Ehuiam4;IE~Pr^(n@oxaRxUvYHO3 zts^+&HOSgyC^*S)mYy|?MBBomGWqm;GJVsZvV|t#2E`1%5sasg#K6LT{$aPUhxI3mm)Qx3mRj=ub*3OCe94z6dGiBB4bY3CTMk&LN?n zDvSkp5CtEN(NnRYUr}e!)J*us3DdGBR-S1tXP8URbDO~fU)fCcX#iNJtVb)dP^fQP9 zm=(&2Hf0T@rc^@Q6EHgQR1NJ%-bNC}Tq7pRn<7b4!saM>OND&3CI1`=KiIN+ah8ov zY=l$p_B8}Gt2%Fd3^JJVghOT0Em`7p78PQ)x_2(tUZ8V-K(X@#r}Wg?WW#~6)9Gx-+CL1ODeI2(ryD!v(!A8Cha{v^x6&`6*sVnR9Hc3^n3VizHeM*A4U{U&)!jin?;PU*@W|+X^|c zP1{}Ws1RH5m_rVfRU`PEIJ{lZknMwea~K$Z)lX(;?*zQe#QQR9%kZ`@L9?^}ti+7a zQ~GSm0jR0D+9x*Q+0LSpw`e2e!+CoEd6@evxqfTj*w1k;zfU6@2{#XGCFFp&_XYbF z5sn3%96iN&yA6$FGy(uGs9AU-DuQtlbYy&lj8p?~2T*W%aqXl#`V|AFuQ4Sg)YlMl zq%)6_@L>Q3+mdlAm*A^0At5S<-c1#97$%QgAvVY12L|pTch^QvGfBLA;mNn-4RYws zPH&qwMlA~|T#?tj6eR(HT_!Yip0$B~IVpp{_%L49KPSZ768R&>3d(W#V*SoP1@_-e zm_>Nwr%C=(5lT!TF&|45rb46F0`KfQNKP=cAl5wzckU@$im;drD(PSJYk|JY1xHJS zaLb%(I#q0b1PtcE+4+UunDpZ;al#RxfNKM!q#hzP9)UP=-Xq3%Qqsiiw`xzC@pjv9 z>uif@bNnl?>COE4)+>C=hg0Ufm9PGAWEn0m#2^9;nMNV>#G9Ucv&pyp4QBnlbqbfh z+d+v!55JP`IBS7wnh)e(Om6DhPIOgdOSaGDgfrI(BO9w#p(#)8mfGT>r}@ybOt%Y zPlEeH%heX;NKEBm!X-3KR;}U@v}A=wPtv-h&ycQiY`($S6`~^g{i01dev13#<~vOF zxN3`u0ND`-K`tdhXtLLQzZ;~9GLX6CX=7{Ej=(ANMr{rH9ga}^kX?z8S5#VFC;^yO zlIbzlDI&!Pe}+?P$ly-sf&;xOalXk#Q6fcbp}8-B`T&E8$Lg7AQ*xWz|28|LIcR1R zB!(l?LtO}qrKodXn)`IgRTD6hpaT-=zY!I_jsy29J5AILvL_KMmpxjp^p=?r~>jJaPTBWn&-fee zd^y;x`}&n9q4ntLa{qDS^_afOF4`pGghIag>2#VjSx`rrF z`C#zrfwl)#Lu!RA-}VDP038(Lhh7g?8X$lG-eGdlTJX2AQN>NPRYTqco&1Fy8A<=%$XbdfS zBm$8ick6c$Dx=@~;YYc|T+9&<_SIrF}Eo{Tr|jwK0a3Em7g5v+Cjl9xb3Kw_41XZ z#b!t;Ct^_WKIXWFok+dHn{1y16WNsTCi`2$@T?#1MT^tn@*o&7XsrP+_;;m#ytPZw zPW`85u*P07nV-m zP+q-$x0iA2QP5ou_vQ50>OWkzPYZxM8qv@G#q{%X{lL+bAt0Se%u(s|wEH#IA^2sT z8s+hy`FsiGt}EIw^|)-qEz0bO^8M8zO}pmrPFpM5RXHcN$%Y&xMKikL6g+gySkfQ$ zTcIomsRc_eNGvI8u|I>DR`4s(=6GiYQ{O*7lx}+7&{;zjVBm<}5E7X1Rm<0NT}QXS z$-|m6 z4ExR7I3FYJ<8mlX&8H;N-y+Ulusd?(90dY`l8R||lFT@rEiI2z77;CHrJrim&QB_n z1T^!_B&gG~29~q~VBTo>L^5E=I4rKU3vN%#4dTg{GqV<9c4x^wzDszjR=E`~W?p?! zf^}BENytk&gBbm3G{8^BMFiay2xevKTfLnjESi!UWCnOJ7G5lkfZipedJ0w;$C*jV zOy`t$H3wa_IRah$E;DB4QS7KWB+udNGDEKu@U?TBvq4u!elfr_K6ki1_Z*?wP65uW!cFaw3OWVh+{cB~&8p4!u`a*Ya6FY6kW#qMm&8^jXS2nj{zq39F zH+9t-2?T(mOkc2E?q|e2L*fcpvf+;)yUoBFfl@ni8JlVdNy3fiGOJ^FLWLqqfWAR+ z15FzG`F8}YbzZ#_A7y(ExQ&iQ%opwv(%%y{mi*0I`wK!qeZY65ePj>nJ{dPmPrx56 zff~=$^F<^2rzQsC5KbGd&{?qXg)lU;j8Gar3HJ<3YT%@KjubCEMtP-rj$w}=+Fx4* zN4pW3Ek)PurlSui4oSf`)4uH|EkVl(MpRZn6^TzXz4akfE+L-@q%`1M12hMPpy815 z!nuWsB4`-1aOPyG!XTu47)E5MLx76@{FZABZc)=ObI*NX1Uakd%ds{6~ zpa3nD(!CWIb6KwF<%*koxo!mYPzS|>_$LV+!1!Cv&o6~4bL$C$yd^zfAZ1#cwg*!S zeG2BVBv+P`h5@HY)z2Q?fFw{Ma>bv@>c2=QX4Ce3G|Dcpg62^6TLmfny3ts1u4#Es zDEZ5N2QMM2kI=E|*#@2_A+nm^A=7(2ihY<5pn!z+^e(!?DAzry)vOM%iVV)#Mz_g# z=NW&~TT2Vba!W7;{>Hkt?*r>8$w=)G8Gy-3?#swVv_KMZhD&((`1r}t5WH#`8*TH$ zlX0c&7e^1ujb@{YOO7=7p}ft7=RSpVZr+vKSZ4-6|Q*Zw3g3C#dO+VQO&37X3XhrVRcB z?$wlx$8w-;bdel_o_e}M0Z8>_3*}B=1u~-#jHR#LbHKHk5WmDO1A5qa_K6tZDeNiV zp-0WYzymXpX;A73U_NP2n}#;OSUEH@%}l&~j6)+3-msfs9j#EoEL5v(nK2=)O?Fem zJiS)iLcZrKknN@JLENBmIwW_&qkv7=mI;7;dYkADAba;G9GLpOZT3TcC72Az`~Osa za2G&$=E}-JKT{LZnL`B5Wl-{8v9t90U(om5GDZJ2U;J-ST@FT;|Nq(IHrBe`R_Ak% zKBIi7j!5?b-7yg8!qE;9x@`cFoqiI}81s`xi&&P`z0%R4HynB_OBqg=yeOivh~m-y zI=k6pJ?ys0UA!GjaGy;Rug#B3$NRZ@Yau4(pCCKBdiMXfvqtBxpA=LXZJ*v}i(xKe z4cF!PvRyulPp>rNsl>+3{`Oej*ER6@;$VS|6MaOl>hIEozY(2sJnqJmaT0WH(x9*i z!1jOpY5n|qoA&(QROl9_Zh+%VR_dhE;f<80i{$h`KozfyYF^e7GMNtTg1HrOZ|l$x;3AUdcgt z3YPpnvVJ{do(pasK8Y^Z%WLql=ZOq?fXg@MXMqE*9nZxt8@#u4B{CCrRP|QLJL+Bg zBY~ZExLqIYH$7N967Zc{+p4^F59G}^oG)Z#(sU?>N}jB~YDu7o1d?rcy-;T;aUN8_ogc)@+53mLpvFicxtFsJ4;9hUdkKS1c)>$`9y15no? zkzHYK6xQrd7q#TiBgA_(Ww={G!;ax->0D0kcDA;4-%=)Vp?Gl}e{vW;t1PR`Zoh-c zLR1d|~xE)9G49#cIu`lcL{0t@4ukC3J!&}?BnE$Xs+>flq z2m9QA(8(tZ8N!SCXQ;?|PF=Va@><1@T%kD#9M^@iwRnU~wv5P_0yCaRU@tEeV0*CD ze>h#ra1yHhYO$Y=2jZpr>TJH439MGzZa4|8M8nF%>4#)Fr{KuZE0d@^{gv6gkr^zB zOn4L#>`+0bP%-UGVQ4&JygV?>xhU@L*Hotyv^*4n)v}JN?yBAY36-A_z=b`r*Wm3b zSnOJVHqQ`htX{SB;8!q$>9jab2Iyb@&qNKTs}h%N0hik+Y<>QThpWtU8nuCS9Uc~i%cv~?eoEydmA^k zy`g=ODN;KMLPwa)L=t*5rFb_vw1T4;g=R^cG`q~86??PW8+(sYD}X%QF&U5LUU%NP zLVSCGsX=kqQxiLzRh6nEj+_WC?V(wgJc%&1C7F>$*rKR>m?D8&Wa9lSA1rQDJOM1t z3hSv4jguR~7&;*el7^!Uj_)6MySYiR6hPBJo|fb|nCc;kGU`KvgPuw)0Utwl3VrX# zHWK-)yWN&7pej>9N8S^OCzoOHW22(1GC6W(G)F)?jsgo51qf_k7R>(Xq`Ayp--*9y zk*AD+({bz{GeB*I^Tok=Y;T_viZj_0xnGGO-)Eg__5+obPwWYIDXZcJbHHDhIT^=D z6wxa|3SxT-#7HaC6D?U=IW&bMz zxAYv$Z1hD5Z~5!dK4=I%6RISWR10bLZ>Pjk4g+@Zs|VV~u}h6)7I-%PMkc#{&6&V= zK-fnp`M|yPYbXA$46jH60_p$;MAq{{=soDVeA}&MFEm1`)u2`ZQHhO+qP}nwr&1r+y2j< zKeL*S=tW0VL~U!AH!E+Ri)SPtfV=^6(mzZr`YVUo6e$Q;mWHD%<|9~=piszoyS^c? ziqxFa;9y2^*VS9wCRmrjQ$*Ndr8|9$j}8hF;l)z!K(;n(r0aX+nHe->RYlpKz9__+ zoti8C7El;cvb+}c7S@>*n>~y|H#eiW-g90P$4h@`0ce=IBue<~b05sbu|(M86TcQ_ zbGxYzcx#?d)G^e7$Cypdh@N^1Gow$p;0GN#;fl(tk~k|gO!Y|KkAl=$UZGT&C(4Q{ zWYB)55!{R;B-YHlcA^2#mfljCPF-XtrERHVdlvXSMuWE8hSI5j0KhR&351phOwQjn z78Mi(RsBn^rU3EHWiD-dK7REJY1;t<*-q}8`C-I`H|-`0*GDa2F9s21Ab3yR;RQwx znNs<35={h%ot=G+S5n z>Ya8DcQi9N8FaF_G}izpn*A4`oyb4bzPiS1>j&q}yaW^pox}p4R7|p{%mPb(mJ%I- z`kBbem*Kmu+UDljr}SjPJH8fF|6b;~p}j*vElOD(D*dM0?Ws0bA+*!B4~#Z{x#j@~ zNvMwcTYmH8N&l>Qwu@sc#(8rC#3$RKtz$qgI+RW=RumOM&yuA+22CqqyJVuSGPpeC zNL?-ws4B6b-93X`gtdae#)@Mz4C@d-e1b4c_TI-NUK0SNNm+h8;1;}1r*^gJEz?3` z(oFK~3JFbgkdsn_QJVb7tir&f zDoCk}nY`S>9sdu`I})3jh+JU(rTVS11zLmiHfHvY6u5xdV1goV;#;bO&{NAF?ruX5 zk&|?_rSMAI5ma(e{kB-WlG#oTie>=v<#_SE^h=v`l(t~`x`pYFwLhEzZvRpX`%(B^ zaNStSr71sG+ze=iw{c^1BQlxc46KjD2>y6)tGadnfUGKqd(drmAMk}gKE7lOT%&Oy zW0hqf8o0kAI5N*&^bW@nqIZS^1p5Ji03yD+okE1l)s35RbND$Z)~M8|NDFXl1QB{8 z$+oS~l=Vi6im_VH?7FWYxZ??|E~k7EVw6~P1Bq24vms>V)EEJB=c^tEUjUqH=`1&M ztvN00mGAGPNbZliw}!rMI?s9Y8e{~VcaRO>52Q=v7ICz_IbH?jMyx;35I zgqtaloV-uYPwIHcPWAc`Q`su>=Os8PGsk%QcV7&Thx|q*2af2T<0J0Nh9Q>fU%``< zSf2ULUzm-6J^CeTea;BHp*>7%E&r&Y^kf%F3-`oK#|kza5v_(rE&}v%Re0Xn0S|f} zIAyOXm?9&2gmja?nrXt%Ckt(oKH3CL-J|NHIwHsIF7-KVnVs3dlwY=-kDzQjrU483 z)va+PP&E*x(vNty_++r==N(0b6);=QDYrrNRE>)B8AHo`R0N<;`o8ILrnaV=0+*`ZJpU+RSmv&bQ;FBheZ667QV#8x-rltgbD)BA~ zQA9Uk4yWTfL)vMA@Ostp27JHoE6e3M0mdk1r{x=nLfwRRKsO9m!rn%r7`uZiJoM&lhX<9=@41$u?_+dJQ zz(cArJFzPwNNI*#h3-N?xIp8hQjYAGfX0e#cgSh-Py>CZT&lk(GjjU7n#bIll^iUb zJvHmO18dc$=N>!^{yMh&cawda^O<*IC%wF1$L{B)`xl_Mg66;f()~}|UuGs&w*Oy6 zk817MA9W!5-{~8+(91QhK4c%FQ8cJ;7piXyN5d|JPxDcO|`fFp0vSdHXTXT&|(&GroDBkW>(y{j<2d`c`nDgQL`@G> zI=S|KT7I{OUvjK|uZT%?q8K!lRn_NQv7JMG|p_^!0czrl{q z;uy*dN+bHMu?eSfxEl&D#6|u6hwA)OgYNvA!adXk}mB!6kvYQCVF`2p@j-u+RUENtr%@{e6GCY&#AXgX$OjBP2IZ>(P56 zSPo4r-Fpk)PFV7U1@Xr`g1on{y6xb?Av_<>tYx z%Z1PrCYfLU%f3yv-}Z|COvT)$a2rR1^DJn*qnO(zyUwy1PY-Q%6h_0f+h*iZNaA5N zqMa$yLq$xYI>EM;EfTyqqPz{r8j5`IE&QH^CxFncg8cvmWLtM<4fhg9zi82s^Xg{X zVagycl(s1vX)^p z@1C*(S52tqz!=N=ty#3@04zWIVXa`4+Hf^LTNl^8t#*$kCyp@x#gO?#$p`ftxFgUQ zi1@thDL@a289}<}?WL`rKX^6(8Q)h)C!$YDpo(cexW1NOA5hvgJDy)NVsf%)&KGNL zv^|&xU%mq&3<2v;l_&<1;1v5C!;1Y^(yF~qGct6E?birAcx!$2%Pd=iI{cvAy{S6> zcz6ORF11P}lKDVO8He`XtE;GkkRwc7)ik69AtvR|3YAL2kkQLHO!S#-(4l8#0dPnK z(yh=}AWYq|J|d3?mK7|#RPd+tfdoGIFDH6OY=DoIidN}7RFX^( zNvJyt2^&b{-bUMxDg@G1Fo-(Oe!!l$w%5J;>DvTKiW^WKw8bm18ZFtXD==M{O2$)a zj3|OAysz%3@0M`8HPJXs{KJFPOj7K3pF#aiB|b%ASEd#)N?U3;T*o5|p1iRKYDL)_ z5WA}<4>6RPkuCNZo-@x%iB&)3`|L)LV`he-$L5|A>%^KMEMV?P{vqMd{(&nGLdOcW zi*6IsA}fxt0%m-n6&o)49Nfh2+ytJwFKbXZ^QgA0Cz>8Xm0x&>jR=B=PzuCWw_n5= zQQ&wr0TC3OrRV(}lcA{BFi5QkR8AG0i*us?6iInsH0}XlTq>XPcGzJgCg`KYrwd@a zbFA1={VG-UwC1;SeI~RTZ0pJFPSJ@I(>hFnG0~PlxRL|el1kVnn?YpmyuuH*=GwWm zPAZnqa9=F72a9PKHIIPdvFQ^8o|UV}%($rN(~0d7b#^Q%k8=%jsFs1UAu$$%`RwS( z7zsTu3~`A4%3aW*lx7O4eM7>y!D=3(^6vUyyc3}Jd>mv~8GK&&pXX>x7w5qtiX4O}Qk<{5r7JB68< zy+l-S$TCmndprEb(;#%|bLKk|Q5(b3(^-2wy5-ES2-1!Yl?KvyP$Sa!%bog#V*fx* zJ!Vv3>4M4I{z-j%MwV}L%i~msCco0=xU6n(ZFu2jK2L6vQVDxrQz+VG$APAQamw=> z@EK@fKcI{iuJ&&(76lb9pvEf&*D`EV4B<3|6qVUwQV_N}^Ewbse$Wr}i+xxgwgrE=(bmo-D;CJbf z*%8r%aT!7+F1@YQeA1dg+u347>-dZ(sS`p-W8r8MPs_9WR^O&ipF}UCD+*c7t?MW{ z6D)4dpi%;|Ec5`h_WAG`CJ>YG&-LW|GJ}nzr5IVcV}Q0_IcHV!6UPU~l-Cc@__2fS zO9&S(^AKU7ZCKwTSm7npNWkJdo>cPZO%DO$JOKN!9rhd{Wj<1Qsi7rD_;8==)Z(Sa zz}Km9)3WGlKJqtY)Nf*2>~nM%CzghIaxkto)9^nlFu1yzVz{E_>o<$Uw;pWM4yG6$ zv_jvSKhCDp!p3G+JiDfh%NY~ZqRW}sY^6t z`q1P@TyyP!0p78%BE!zxqBhX_VCUKFtcSZ^(xfP>2#AMgIzokFmZnH&oX_6}Ah1+~ zgoSH-559IE!syBS`uDN09_Z~pl`rFMWs00#(ryk@096$c%>2Qj)D~1>(4O@wm=~d1 z1U`YL?iRPaW8h?X_*oh6j%UKCT;Nyj)dif4t(>lH#bHy&=VV5i3_i_1S$|GE|0I%~ zlG!L`FT}AJV_3m#2{))AhTjBO?1W;IrFN=(+T+Zj*kE1WRMW;nz-bDSsQgIYtrRIr zVO1~fZ&Brl?g6g?QG;>vigd64Ixt*sEBe-LD&yg$FMQr}VmUt>RHlxmz;?Ymj)Xj> z;5VnvPYtv0IrmVTHjL`i9t7kY_EAD#)N}KP5D-hsEntfpR}gPttRSgtoCJayA=eMF!}+KCJPiJ$c-de~r)q;Wz5=QUIXtgj#p zG$4Cr7wXIeg~A0Kesg(ZuI_o1#teN;1v-Mj3XkO{2^ZtwAzQM*!4S%;(5e#h2z5Q< zFZZDgx`V2ukBilS^gHOYTYjYTZ&sWmE=C`dhs5my$N-V!3=W%_j5OFm&fC^0i-AQm zq3NCZc%aKABa+3*-p(81{g_)@_n^OHrmP7@wpuXuF2W{+`WD9MGeZVw*$s;J)ba$Z zhU)HkjH5(`D*pos_lEG-#(_hsQ!#FG|LI?(glF>RD9fMAPu<0GiduZJ`Qge8Is-4(f7CAW++m zBSeNQgnt+W7+-AAa&1{24r50}_CS2POSRJm{RfHc(vJEc`*jc&q(w>P{t<-)!rqux zb=$-TyzMT~*l*J0N71(uf^uh3&}@O+{KG=+Fz^5n2}YDagi;RnE!VX;vo7FWoCB+u zX|d2gpmYddCRAGT=Y0{7BF6>l8~EcA*;-Y?blYNqOgqlTAcNl9qcil^rNO-$)2~f! z3Cs8qtc1WIPN4*?Lp>OjpuWX+ zLiLmVNLhA~=ajsx)>w#8`t+*QsJa728;rZGGc|xJcw`wJUDuuzuD2Tec|x9$Hxo2{ z58w$%I0f&O;f|6b~m}Y#wQ}xvGFXAAf?!XoPs5s4@Bz-2xsxQop zWN2_%gk=HQSd>A`fL|Q89hZxSLAnEv%NLje|2Ws&UTq`VaX$Tgzl$10ClWio(1}Cx zs4%``Y5#RsH~ucgWS`vuvzOhU76z@A>-~J9dot(vShb{gl3Wy`H;eqm7L6XYLI2{Z zw%GUiIcnO|Uu>hWrBUG5Wxt^VxrkpVv8ltavU@}<7(7K9$)ENhvQos? zn=_(# zC?2{qhr@T{j!@6fF1j&JV#>oH`)lxuQZ%!ox8*Ib$i&R5IVxDG1+1A)vXJjQf^L@s zFe&GfxXsDX{3A@R@28WS04IlA#6L9SuMWVqmV)czmw~aECI{6f{)m^mm&CRqAl4xe znetfJuEiFMwjKnEB(gj+z%kmf$UCE%yn~TRbDRr&a+ldGy&b{3>~4V^%bs0r{^o32 z)pVzY;axo-AX8^#gUC;)6KQ9VHQ6QI9t;7NLcKV6i~610xRYXD=aM#W?gWU+25DwU z8}lD|ZHd&5PApsCT{B2wWF(4>LbSgg9VEdTr4*35&%xL7_e)*-Q~!%AN$*P4E)=wo z3S5w}a*BexyS4}(U={v#*sHp&R#tv7P!@QA>Iuaq^Y|S z?=J4^ZqU+yGE5BS3xPZs4F$XB(lK!fV#2WX4|Fbk8+rGc*?cq#A8bRl?MfvBE_JkL zXhD~peg}_?k%UOfmveJ~ksuoY9uHrVxIyeaYpk=0Qllko`1lDfZEcUK_PcM!pEC3a zo;4zz*@R<}dI!Wxrbran(7xQ^tQ{b{zqT+|U207N(!P(86AChzNgzD%ZOmq~@= zd#cS(s3kWcG6`anGt9gHtSF}^^8ub(4J!$ceJd=H(wytxtnBkWsf;uIT?`ddiRC84 z0%E&#YdDq@GJm|7U+L5mW((*#7Ikv2_~!5>)W+$lHz-#oWE%h&>noGk#{mPjNu>WC z9gX0T4)Zc^M~l%7iiKNN|FpNJZYXK;@0tV8yfW>)Uh_wa`~{ zRgNbOMatmx^swWxhy+o{1iVE&F z?(Pz8GgidiVyeg~lKUb73hHFCege*p^^GhHPm;a^#C}R|VJ|bfybpRoHeq_OcQ*ur zTvT-3g>JS$1zg-wW)YhPGP1o_i%DNxrYC&H<|VGR%+>%?hgonTq&K~1?O*}XJ>36O zVuO@5%*8kvrBZ2tPHFOuF>}fzKe$YwNChF6g70XUrElAc_~U`3w9(cYFMAW&|{zTr_?zsD1~?MH`NVgfDV)3iuJN2h6rv{$%Ynq6q9s7 zm5k%#xz8>O8Z)t$m?3q^7l5*mv)+(|CDMKMFF@_*5B+DPR3# z?si(48Hprss%2$0feniFCJyM*w>H?@8v$duU>`V>4|#3#18}XhXo335-#omkK6m)X z3sio|e|>zeXNsy`0f58R?$ijiq%axUOX6K6m>#f`B?f?#6yxor&9tMoqk+~OL0MCw zryp$*9omaQ#a2&o(fsddl%C}SDXMSU!(-G>=6W5XaU*+HXt5VHbFYbVU3|$Mb{fXS4A1$Uj`5bvLQEA`$C_I1}kxaeaV( zdQgh{SXU6wYtoiP@}SvD#q^NXn~l5*6Bxn-m=zdy+w$>%hCWD@)I;|PBdO8CSqL6a zexh_7J`Qr1fYH8m)f~7g#e8H^6tfKbY^j9oSiP#+iU9FbHx*-c$w7lj%$O zCZGi+R1`Tp->}O{J4iM-QHI+^Y`HtSFiT!!mvafS8z}iyZjBr$azmK`M<>^Ji=0B;1#CRQQ7||D)wfI9>m6nK6QZDn{=g>^@s zP23O6S%)IoU(3D`TO~fsr3nuTADrfiv?Uns<$$o-#!m$=B&QSK zW9PhI%&H^u$2MnUBE9K4^JgD!ripze1&yPntgEQU3%&VwjY8ccvB%cn-ZI5M$2cIl zlO|uF+b^Vj#}U2fQVRaE?AiK@sVY;Vr@E3~za4)zlSL9e<(ZBpix}pT9R@I=*m^{w z9Mpkfn}FAJNDy>xNI-X5%bB{jo6<*=j?Ik%6C*TM`&hJl5X{l;>OP?EZW+29+z)Pa z|6zz0p!Dx<7qVoTjztFNagfYB!=I|B8w8b?Le;Mqn#;k5$oPqEq9PfJs%hkJaUg>H zny76&IY4OZfo$>;U2QPCn8)s7sN1k)&hL`pn@bgGA}HW9P}F}gg=tM9`?r;`*`z*X zqz3UzQh0iD5jlH;&o=ejiN~C2I&oi~T-gF)Dbzj|`;RGp50_wFJp>D(_Ztq?VLJXZss55G;&Nx7mNvj4s6u|P z40EM;VkVy%;!=GkOuXw936QITnyJQHm?x}X>66Mh^p7s2ycXWEQSL-zvlogmLRWYZ zwnYcg*3Ib0-FP~pZSAZcfTqp}?DIZU&1n^qBw9w@WWrfOViYc$=ExtoV^zxe;_u$= zV5RJ1Z!-X=-6foi`uMCgp@#g0zQ#(utc36rrD8s?8t1J~1HL)HD4#toIq?lBkEsVN zhDN7xW{f(4+-2-OA8Q(j9{POD3$ss#@*GlhVsT5$bvQmLp=C+=yl$1`4kqJQrnzP2 zk8Qr@Y%T!OAkSxxzAnfFM!E-!r;X|~n%Z2~F_6LBH0R6!qxL zkfd8EFX#B8S>lo31Reh*aPU4ogz!0~sgE*;1pUmpI@H)xT(!M;y%>yN3T$Xm^DMYb zapyYJ{nwK4&fb3A4qw<6lphJ~Mn*=^5Mh%}opqY$E^=y{y3`2=7)i!A-@M`f>TQM(5_+OKk40Jvv<%&uBHA`~nN2>KQ^7_|@mQMDBp%7ApSL_{N@=#- z%y73T5Cl=B@UxFx=kpbQb*I#Ue4P`hpX3#@{*MQ<=kIwdQe;K4Qk|XcdXvT^t&}p2 z9UFczeqI&%;+wU`RW7AVFI;TnBK}v`ZZ*#k>U=xDekLZ=%((zIKjo?nAsYugq7z_d&Y z$ivgm{O4^0$1LcDMj8<^=EHlel%CqLI)B$sbTGFqMLfwZdprp*19OAcE!kKhEq3jP zqZc*5Yfr&A=lnPv>%fGgu)n$79gbc9J-+soWHE zXX>VStdG;gu>|az9q@T~*H$mGNf3zkH)40UehIyd4km$SIMCcnuXGEx*NdZ}>fL_Y z`3seC$H<2-`Yw0*x^}nH$*c#vNC9%aVwt zgkVta%+e7THy)oSzWTb&m%#uNZgnpXudDxE;dH|yJ5M&gSr4{NVLwAb82B_iMwiP_ zh1ZPut6w)4U-K$X&&fVL)~vv7Dx782rQ7?U=)LALf{Oc0(IM9XYSPLVC!ZSCsNXpV zV$CwW-NwztE8|l~jXrIL_-;z+lG$b8m$ks)W-jOwLO`%Yq}~}Gu+<6-2+SERu%Dr8 zhkzCs`iJ9n9FU){UOA`cM#2)5oYfnj=EEmhxo?Lv15i}}tC@{*`sYsqeSMcVP z$zSTF+{A?2o;1vw2aGe55+*ZOH3SGI8u@G4A;SNFL<_qJBw z6&*vho5n1KTP>PAm`!vi<`Q7b^Q4Wma{@#t5HP@^#0>HY%9Q z&0tT@{Jq6kl(*5Ru;_zUlT#of-B1Aqp)eg;v*4aQ8A8og!}I3o z(Y1?wPgo#LLKD5v1vJFb#Ja?V5KTuMP{lo_0>-$1<%&i0M(|J&ZUV5=!m=qmA6huJmB*gVbgw}0HF!Uy>d4d4DUtf4Dm zQ9sau-==GKj4%~7l%hxc3xP&{Ae}dvpOy$a;x~~v`!6I5XJAh8-93X%g9$B|geh`)|Bn`+?-S{f2gZPLAObiNp zGFx5U{vCGg6-FG&$B{Z{BD@chUYHoO9HGHPzinZ5jaG2YO}xD|_07ZbO9DyWCLio9 z!GmMIr($h`SSCFSP1BIEJ^=pi zDkPg%t+m0HT65L*a{+huYX0vl{s5?>E_MG^hy73VbS4hA|3C@1YHr0Hu_5{H)ibcc zQ-d3e^+YPYP^M3sp>@s}c{Rdk0#vtMv@x_DOZ;_VPl(^6LX(u{bFn72N>XLg|M7aB z4^0TdBtEdd{=O`Cw@;&{G*xTIw)#3M_g6m3zI8a)vZ=lfH{(#cYu|AqowD)eT6d$A zVe8WDe~UXZ;;f04t{G2cH%7Cs@wN(sCrD=C|2$2hT|{KceHU%#!J{4?B+OG4j;>5L_!j zPTnZ%9gGxpyT(?E+gXs3{XCCS9fhJBih8Njq&IZv)vq(S`t*KVwNUWfqd&lGhrngp za)0x1#-oXys;hMWCZuek5wPl?qeiKm;G+NHm6G49xL~K&OpAF0f)i(|>->Cq>=<6z zZDT*WeOz`5GhU((2auMb=RkJ6O14~+?cd!xZV5G<3ef})IvESR+B979BKag&fSB=^ z-d3TmW1-%64#`RknOS?r3cucGelxIvVqRjP`FYgy2@p1Wmt)IIG*tYN9O-kN!F&VhG+h!fEWeIcUk88=itcyf#x^N_Cz4m z*OpzWSWXD=t0D13SwX=d8u_(AB(K*$e-q`y3wgwJvXeuZi{Q7OL@UAd6tB^E>*h7t z*{K%@4&wSUZxd2Afiu`y$&?W^V+juU83ku#zRqp#c8ZC68Q%f+3V&yCsJ=FQ>}CBW zBYbbG50kbxZU~8^z}(wv4P*3+=co?vqI#1M63f@!7whY3?m1nRrP$|GqWyW3xMJ(i zUEwbA$V6n|;43@hGTiky6C`7JZt6rP;=Gu~(6Hm63Mv2dXndy!WWEfJ4wQG0C9aum zx7!Na=dy}YBaax6K>q2a(n10N9qCftx{lK*=#nUe7ewK43AF%pJDzE*2Za(xvPj-tl16L0q&Fv{q&EpNN#XAOj@Q>G zC-8zza$+Bjc5~dTd)1|)K%17VT_tgeq@NPiakAFTCosNJLXii@Att~fO z#*mW;uoer=NazasfW5KneJ6$`^NAxJx${fHwR#Vt3`2Vev-P@Oj%UP!jbc`QGW_tT zfb;_g{zu^%7<_>IfGsxGahCye$q-qvH(b2SJey{744G#>V1G9gG#!89q;4uLG0ik!7oD!jklz7sWQ348)AJB-; zqpqSLIh4hxJzP(9kt!%T^h`k3Z*}wu2$I16gv&bgW|MW{YUBe+gp14SAb%2imZo54 z&?iZiMnBrX&Hz|Br+}NC%N;$ie5eC|&ut(@ErUrWjo>KZq`Sz-pGu^7o z7lbDwNsAA_OYWQ%d=YgNu#U(Cbx$I$y8wtzXu;%*Q{p@mNR{$vXfjS#%LjMCn^8v@ zhsGOE_7nhws5JKs0)>+`MAu1%Y&ilDcj5V4iuCvXMnj{zN^5U;SG2bh5$;R z5LJA+&x5QzTQ;;b5R)}nAjJQrJ-`6VY{vyVBwo<`6lMTT?#yBYOZa^?AruM5|3iP= zlF*QO&SgE03Y+2F?7m$OLyF+V(YcJLZ7klu!+MypIec+$jqokO3sIHAB|A!#=%<$k zfT$+Y6%*Nsuz}rw+d=#n0*U3QQcPPUPU~;v0aQRip7KOa_3i_>rl+#H#ii^&M?u2p zS_vq6GNkgl{y#4Km|a$3->&xWNvRNO#{kve-7~xdGfxt@=O4F=2Ed_h?+u|vqQ(Nm z8H#V9BFx8WiSt*!z2eA39AEQ=w46ayMheaa);yC~(&`9yNokWfKc92Mgz* z`{}Fh4~K2;rg|1nZB+n0`H`AWAX*|stH$XhA_z{?kx{-p&QN{lgTKwq zBepCb{=d{AEF z_pZCIG-6dWn10teqLy0I?H~w1R2RSbgzv#tVv;%IQJF*>CaSWG{fy&PZnt&1vMDrm z-tHh?c(zER)1>YNWEj2yS64?$*wsa#cd+Bn$nLW&aYg58K_kQvahMxUW!=5aSRaE^ z9Z&@O(GP1vY!dqs=)JV2ZfGO93vB`bX!7z9`If=cX(_9|)xD6)&9Z@m@R<(}egp)z z;L+>CJye3H(WzJmH)xWRf>IlEo@eLzf8HMDtMPYxyt8W(vC)5e#c+t$@aOcdlBuhR zH0EyVBGr*nU7{p!81gCZAf;Q@1u62?yXiDD69jN) zNc04;oKK{*8>9!mf@{(VH+z}kf z?(L&)D!_#(8ALwOz)$Eds-{49*WuS^8^!JKer{4Ax@0m_nsw!+OXnBf*7qb)5~^*i zy((^9Hnsf%IQpe#q1qqJOkeu#PnP;9+-B+TIcxrT{x-?3*X@EtB;97|hj#haJpX{Y z=vzdX^eVyC2zKki?+QBwBXbpxO1;qV8+6wgAKex1b@N1?BEYzRyQa_}wY~ZP3h#Jv!qrF}li|Jv(_G7#C z-n4=_|MuqcEeLQUtoFt>}jmyYl#`_rAW zWPYH4@npZQSduvgi2iOg8rR$M?HW$+txH~mw#)mqp>$82M+bs7`?HNtpd_pZkz;em zgYXiNzJ{P=PWZU+Y9T83VXSC*}_@g%| zo!g=#|umrp1CvuP$?+td(6vq8-hwVuUJY}L3XYg&QuY@xhis5$i<5W(L9&0V% zwa&`b!l@+~Ir-gfFEFO%_O(zqr5FeZ<)AA#!ri zz;wF@%z@fqphra}Z@i@BIH3>Ca#+{3WP!Thp6q@GnCIKf+BJhwQ@G0%rNzfuJl*(r;R6+8! z!rH%%4xo2TD0)|H9pL0O6mnE>7ac3u?8?br3&On4Acc+ zK)E(L4UEU=JG7fqAx%r33!A=u%@-z$hI6aAvXlre^$ewNFz5`Zp0vl65fgVJBJvx5 zNOy82E4xB<+E(bA^$0vBdniV$|gHV|{{$`sK4k|2~ho3Lw3U4=8 z*bjd+0>#m1lYo!JnuKO_e1#mVCM5B9r~qiR;#bM>!)rx1J$~7xx>D$tfufOPzE0Qo z(l5vM8r{$YB94}r?eg*SJRmkQivpb;m9SU^52m6aXF zfp`%XR6T?@SZu1fv;AS2;J3MMa9~rnhTSf}#WyQkhQs9@rr|{S6Lwc?+8gHA2`vPh zN7Jh)jMI(EC!ttUUJTyiA{F;N9#oIp4mB}m^+z8N7%3C#`lvm(7t~r4Cx!?r0bh%# z7ZwX>QXnSDF-bTfFB})6NG5UG(G=(JL5jo4E6x%`>WSmo_I?6t4C`r$5+vg|$VIGM zS?#v>m4X^4 zl#dbQb?_)J|11C)Z_fCW6Iu<&0UK`DL-MG#;JWgPNgip8Aq7BG^Pg(AMfj_}L8yHPO&{5YXGu^kE1bi50EWC`do)J1}~2l^ldzr%7ifs!?lj(k=CZLzuRIvB^iFkvuS z$;=-x(|C*Ecwk#4X>7COZCo|Xs0fz|9wac|^r?{$@i?}+HJtQ7Cn@Y? z8u%7Q)1q?O2A#6xpZAsV&==VLi@f=2KYgrkd?tP`NJPF_!Qi&g;xKJXDTuF0m1pc4 z^V#}?DMX-#spiijmKFfvl$XP+vi2m|rxE?3Mda#r!a{#R`M5^=^PavM%KRuV7xg^T z>k9orVY+n|Wu8vnd^b(I$qb(OjJj!imi)N_7HYYfpqmNy(M0=8@xHG&7u^L#@7LP$ zt3k{R6tRh&Ok!u|al_+v0f!KP7kZrj+;H8T&!0t}pDODeHRw+VcPh)HkP4pGSD>IsLO+T7@0Kq5j&HVFqnCw8fm z@p5l329OFsQCrS7>8c?Eh?!!1egB={(QZ(EhPR_=p#gsF8n$SDeR{rcDH@JxTxTCg z-}ZgCLDSn5U7dRWi5wJlem(zQ1f^q9!UNmu@58Nj`?@rxshaJ&%7-=k{_-*X&DpXY zBW=^Yk9j_5;L8WSb)(7XZHWtUD|`Q{I+l60;p1dq=Bvc^+n+L}t>VVo$4vQpU~%urvtulds_KzG1@ejuSH0y5mk{9y;busWfIb9;d~K znX2Sex#z>EZA*ptDa`UvKh5Xry4{;AH*8V*Q&InK1yc2?N20o?zD+gVULbBqvTkl0 zbq)^?>Dav{nzOO6b~jyFuvQ!U`ZO(5epSm*i}Y@b0sJm6{XkYoVEds>A7VJw+QwlM z-PWrrJ`9_S^rO$M?q#zM#{wt!L{|w5IQiSHV+$honO>PlE-J^$kPPGxCC1zFw9p-l>PwX^o_BZ7nWSE+%vPvMM?L&t6<=yghEsKCaK?pz@7D_99S4rBf zobEw3zVg8ofAqBnb0FtcYPsg_0y<*&j9e$ zi7VN<%C=>vN1uuqQbC@*+{?N7@V5gnU#@GdZ$qD6x{F7a_~7L9%lll}R=*2Hjy1_` zhJz_!--|?Mq;#q5kX~*pDZcql5CekcMYcdV={s51g7cfgfxCu7(h>W5QBl=8k(IO` zq?d;?NU3h~bcpwB7sbCgYM;XDyxkK-_?(HST;50M#?4N>b&8?&`>PW*SS-031<3_j zh8cqpL4YNvEu0yv1(G<=3&oCB%#EQVA_xK|AVbBlPnDV}6S^P~4G02|Y1G`Qeyz6f zuNH$0j?h%+Nz7NY-_SG(RnR;sp#8!1vC+3YB6kdvM;;< zdh*=sDZoTSCVT;9WX%8rm&UJ&_r?PMHg3?z@k}Bk6p|s%PDBj!!pmOk;I}ZL!C(6) zhDh;Ys{5jqLna#S zoq?C-WI8DmfbJ87WQR6ztbvnmk4p>3v6$g_PjTw9hx7ujf-2JwyG{fQXDTrZ4S{ou z&*7jSgE6p1+?R_{KgYVdsNrWBLUS%57zmS6`TJz0^v)L92Z(xp_}~+O;*O#sM_*P5 z$eA%gET0*sg#XkF1PA-U8KAMpRNJ=7!Iq6-%I3nzcgAYHA9M@4Jip+qdxKX z5qa;XzFxQjU!*F!HbbNLFAt3emm)J1y68nvhJJ1_Cy7fvIVQ2Ig4 z2qZijk?g*(jYIg~S1X=XN)3DOdLvQ)e=DGC9F&?uT1P=g} zpK~5HZwpOelp9G*^LlFQT0%%_OX+NeaqXq+#u9Q-YQd=}GzmHkW=th;Y`4k^TkQC! zA#v59KB{(f>2PR0l8Ya>t9FJ(;`2+M!t5&~&-yLyd(lGghd~Z?mFHzrgi=~QeNVg2 zIS;-opQ>}fi%P`eDK}dx%oCJLvqL^{M~qR5wUwVZVt?xDdb^ zCs@ag@Ez`Px~ir25rrPF=ILNc?5bp@{wY&l$TpEeUeKS7Lg{n z1i3HRp*+f1CpnfNdo@r{%L~QAw@QAl2;`^mN;>4B@z{)nC2%gP5h5oQS`0L;^yNny ziN=)axxzWErY-Na61uwwF0#O2H{oE66~Vi;4kYdup^MnOH(A)?#XvJwVN{hdfnRY`RYV>i zy_$%9K(nOOv$rJZdIzx7eBQM#8ph-6mo@}BZay4>5fB3VKa9O&b0uK6wHsr_wvA4* zl5}j_wrwXJchs?Mc5K_WZQD-X-lytR?OpYJc>csa$35m8<6^Qf-t?7|9EQIQz@J*d zLdhY~RfeSY!JU~>fCKeqWIPs`6*KCUP-qCQc|cBP|* z1az#5PF96El(^AB21Q_B$Fz&?fDC2S;qp>MX=r;yL<}D$%5GEk7W*GDrsrgb8sVJ( z6W3myp6i%uW0f`+8=1qz}mF6jsN%l)+YhLF_7 zPXx8GUa{bquAhtz%vScX5<`Ez*jO;iBtjQX<>Y5o(3QoyAhfcq1zYnTg2 z8Td&nkRH&21_@(oR$6e*x{M-=J=$~V>;ML7XXx??jS@SAKp&!A%lR#EdHdvMgd#CQ z2VXhc%`}vG95Rfi}Abh0lIgI)n1P3!C$CvMGLAGVZ zSG14hsmNPA`;wO^-k@!8DLM%{bJ(BpyhXl9tNpNnbX3R4`0|gh)tFMC`G80C-lSbZ z>Kj~S{0ze0TA&(kUB-1te1y2e%2tOGL{B5i+jDUuYrHn3W=>}4-LnLC`H_(jlDDx+ zju1UKSo~$}jv+G<*Y0x?Bc!o)Nben~IuC5i@e(-a+wFP4U5z~o@9lZ0IK-;@L)!Ss zgQu)@ZVM?Z_ph%>gmKpow?l6|u<$~1n~D)=2WV0x13i%Sa-Vw%_RFSxF|;xige_(x z>=^>2pc^%XRq%I5>(hPmfKXJg56zj0Wu4*bZ98xDKErWajs14v&o6+}dtI-~{E&;Y z7b`#{4(WHMw*$+hC5iJNLG(RU4repsT+6^2)pFtGWkK}p2Q5DsnhHF`nOaT6C|T|X zC`rSi;Ah3$u4q~vCdG5H98p)lGt2OwCV{*@h^7RvL{&tDWgZZdLrZ+le@pL3ee-T7 zj+OS)_kZ)F8Nk;KAsiMNU<`xvzU)$ZlfcL_261;=kG|ZZ5nCv$#@EhL3CwVR!c4sC z+MZHzapCZz^}xhp{A6B|;UE%LybKd>y+KJNmQE?9renpwJc+4QEwzIl3 zC2OAp=P~45PwE7)c7-s&izR%H3?GNm{VZHIZC;}H!O;z4z-kQ?3e~*4u4?kl`X%23 zin%4?vgW7m^)Qpns35jjVA(cln0m1ajI;)Hg>X>!v8fm2J6dMaBrcQ&hv0^RZI3{E znWI(o^Vlvc9Yxg<6J~GX<^J@L6jzxC1FazbJ(H{Ulkcu-`#PgDlj6Dt%eajLdy6`a zj0gQMG?6Hy&Ss-lV=4+md*hNLU?O($A?+plZ)1k z-LcK!enWysf2FE4GzU3=F*Y$G(A3=5(`iO^vC`_^)XFh0Hk06XTYFvyLx1Pb!}Zvk zfzr8>1EEmgD4;$u)V%Pa@N@%NZ4z`&Ap4@_E{{p2B+2n(Gz&ur!biR-X znZ|Hqd3(#Di20{scXhcUO1&=nP9DA8vk`1@gcSdSYQ3aoO5pd{$vI!4(iG$flh;)F z0vEu5kHOegG=3b0iTsxp4yUG>s~|27)zv`S)Ea{)7a$r7;lAn8%@lRgX^19>C1jz9V6tsr}T?Lg~l}R7e7Kd*Z z3fRhq)J{Ap;lZ?FczPa$66>31f>ysAhrVHPFjy(d=ex1QJP~pbmh$TMR)}&?q6j)_ z4^~HCU<5D5=u5Ehi%m{!L}qCXJQe4#769?DT@29S1ei)dhV5*-?~cR5TsYuCakTra zR*}kWe9)dKci~JTnB6gHwot$yw zw727ue>mEv+gin^6Q9QP2yp<6pXnD>+y#9_$7FfC4ab{*7}j-?9W)1 zC92kQ(`|*g;4WUwMOnN}bl0AzN<%D=FyIaN)-VMTKx_F4eUkLp-*hXty2RJEC77ES z(>GkX|Y=76f1yXvJLZ)BwCx)&9QP%z+2tuU{8eox~SQJ4if$$Mo8=* zIauGeVSvTJz3&bQqPc8#+0Da+5?F!7!2k;B2oxOUv65?D04`=i&wPQYqG@F_n+=4r z*#Z$kMpmP!nkX|v8DWZiDxuz`uFgeLtau2nzgpmsujDrl!}yp941NKp8HH`V5shx2Cf5C1Eh{)PJBZUeIQT7^nR;#+!W-jPef2)8?QLt97P=yt zCzBfpwW1oHzwyHBFaEyT!bb{vjvtm9xiE8XXO@wf3uuL9H?yu)t*OXrQXwERDb~pE zldyRJZ>J#1x1}L-lJi@yYx5de&dcx_dgx3fWOIb!M)MCwh?2S zU_77h^&`q935CWh32tFNkhMRY;+BBC1ue1?i+$W!tmA-u_{Wg7t>rr2oH0S(G-SEZ zZRBb}n^%Oyme7ASk%gBCr#h{3sB~A-2;20d_M^*xB?jS!_W6VVcouKCn18(NDt&)? zJip20VU+H%PD8q~Ma3o_7v+^_7PtDzfRY?%ta8c~anG^q>jw~Ox6tMHZwF9=JRJ@d zE-j;S$XtMV`x?HIcXN-PjBp-qV4x6a6R(%3z1eV8tjjjio`2LfF~R(q5?f=GKTTwU zLHL3{6^`DGMZY-IjBa&eSSdCbWLcQR=*qRDb{-0ukZz$T%$ zz{;$PM@!8K@T$yhj7_n?NcB~PdP`&Af*X*yg@wE3W`S3a&J9TM=hhvIU9EW{Th=j516LftRxb;%n!)o31SDq zn$;K^g^QWakuDa@UhtL!?(i(-!5At8ia7f;J*cLG8U+s z{aF~x^n`K-MY0(Bc(o574%(jR#=9!td^jsEk}A8MniuGulWOMKuu>W;a~GCBL~(F^ zz&Ns_i>LDsulW+2c1}A1!t?Me9B$W{#nhi2@o}(|l;V*pgLdp|}Mkn>Ffa(&R{i1?y{eP27UIpUW?V+1#TA z2zyK2;T z=AZ5BJ6(-zL!5_cnBkLP+}}gK^^=Wh=?||YA&>8lL?+G#1UNxS8R7R*_9)8=OPZp$U0 zbit&d`hsZ!^7 zZKAi&yla2$WUg%Ysmsx zBGeG&KF<4?B|)b^i^Eb^pNIkYLGNY(pk&dnkLlb=5iumOv_WOfWz$cS=ZDgZoXfMX zt=U~=u2S;s(_{T$Y(=S{he$qWKtogp;~ct7ZuK(b*wN2>fBcwa)o-00Ar4z@ z=q*BF9t?^|FWeZ}_H#@h;ntF|DOAQY*+rL=R1ejqr{&w^0%Xrm6;IDK@83>eMho-q z1Gv8>WywW)7jUop5wl`hQRHI3TAFbI5)&M|l3Y?90@9xIPnRSTp=QYYUVHuXSy7aS zv&QQeLOM#K3qQ|HS7kc!g}PVJwX3&EJ)Ns3>O30Uo5J9?}`dvblgE2W_yYxyyT5!;~F5TCb^I%eVaCnYqLtuaMx}MS5dS z+6z9bM8c#nQiTS`1i#bCoq~=3&H{rRqDd%g8KyYI#00@pbbq4=Qtjc&^0KKe=GyU9 zqR3=@bwqT`6hZP(!lJog8dG9+`U2N$fpkY~NFjF!eCGI(jNBUOARS}dhXx_M=`%O< zzc%(Avz*X;d)kJxh@KBAtIG-!*18rRWi$9O)atz3AxC)!W+KrDYPQu)Yeh{haFRNI?d)rf zQCA}dck0~OOi?*JrK;Xdc1oAQ z)VKo8G1Vr<_K3E?s9ccRo0*x~KRYXg0e_&RGNnD3l?nSWSE@>Z(Xq11+@QrhBsh5r z!g?UlRV)3j`YkVwOXB`ae<2!K%{~&wetA%%Uy`es3lG9K8F_#jb$tHVzAVq@*4JG( z`WR;nz>qCKl8up}fxO~uqdh=ZZcpVNYByBX7{fME;pF^ByE>?I#`B=n)yS7TpnWA$$`!U;1eRc=Ao^TQaQUGC<&98_m|L!M4@|#2Tde3k(+dzR|P(% zJ>So+2Nm@U;)3N3+Yy%u_e#R!fY5PW@4&RZ`mU`-f8F}8Y=k$o`pAsRwvnC`cVH-P z_WBW$s-w`aTpOCzM}!~?!<0^pbF(m(U+!ayP#ks_*3YqJW3*LB?a(gr-Wb@~fEYiW z&rt>4oAO+X%(()`?SY#Pn!UKYD{Ofe!^KLovt&6|Vpw7WiArHN&}@LzSt^s=dG0jd z_t{chlaucYd!eY^vJQo$5Kf7X?`IlW$uV;HFNu=i#b^E?2#8I?Zsr;UY4N1R5tTOg z=4SThYrmIw_hzCkEn69iLN8>SEgWH6Mu!6I=7r$PVx~qbJwsHq*%(tlCcJp1S@aKh~%7-4godbmO217rq0b$F^2ZQFB5FsO^~`;RQ4qqPg3W zOca5a!N-xZ9>z0q_i=5P39^t@XWa9g(9QxEe`Q%fJ-YqrA=}kc!{0pYVeTOYwvuBf z-zL-NPjEh?#Q8h5&FQ%o@E%%ogunQw3BY>;R-9Yx4WM9;0nzQBGsE^{??HeB=AvlA zEC|70ROuF{)+zjKe0pFu6e`wQ(MwiZ;He{dIoKv4V1QV;AO(TUiC=}WXy|{(X)RDH zP*TlU5;mIT%}k)I*ngH`GTaI;zE!&p$<}f~b?B&lYsx~ol;pO``Z&LD^Jq*^lo%R3 z1jEPEVfVz3B~)-%ThO@u9HY=Jk99se!f}~-oKx1U-3ih=i6FUiwIA-5% z02Gn)0tY0UBsoTVKoY=?l74?ayDlHAF1}t3f3-!I@U{hncG_%28XH!Cg(Pcz`Xv{_ zW+k%bWJ|A4Y7Xs^N-!l{B}C|@!b54oSRp|EHe=E0(6-Jz&J^I`j_Cmrb7I~K?$Y={ zgP{B87v8rLJ{EwZm-32jh9zQFrI;}a@?}2jTOPgc((6|oH?e7{-knxl?^->sG{%0L zvL6Bz2^F(p$-3Qzz4iqzx$!iiPF^vEWMTHS_9wMwY6u&HFCDkKFD#q0vywcmo?O4Hl6t~VZ98^pN(AFfEFSDf`q8A1pHel65_ERtaS79SGXxmDv*h1 zIjZylA_7u!*aKGzIZjq8HUgB%3uTHiQYZOa`4vU_gw!L1io);=T`=|*Ur?lY>Hy5a zkWE}R5;p!cO>O(jYoxsH`O2(hh$Id@PMFiRmKZL&5gjTidrAffijn22snNdcK}>84 zknI+)1p7yO#gm&phLo0Ju>`SC&%f^2cR>4NN4dUg&9bz=!_HU`{%WkCgVFjgKtps& zOFgV9pnY+6r;7UXWIcPmXqP!oF&}y}@-(DVg8d@0{zNjy$9P)2|0j(Kc4SHNWf- zRd1;M;UpCHy$4R(*m>RaFArEW?$7`DF=l57<~;%)!_Xe-V-GzF2lStJLpXk4W1eA- z{rC$O%1Ajyi%0FqxIoEHRA&Mcwe#S1iTW#E#Egsb(q&@f)#wxsn@eVd z5r3DWKXR;4A&O?fo1J-_uq4Sby=XboJGqPicv?!V_`?!|pDw=}3!f_Yx8@3@A_sxd zxv)N`_##dZT^4(2vv3w{d%CF*a^8;K7*H){U>f_f%F5VYKFdw2+Dhn%oSFczHf zU~nHAagiloofIQ}O_SvHwzP{{X+3jx4bcrqnlX9B)%8}^*7EioUh&U&r4!xd*HaB$ zB)V4D-=4+j9WfAAdzPomR}UiTe?0SjH@+>=^~ASn-eMX8NNrcMXWs7->26k((rzT= zTz%K={eQmeRGK$b{nhbAUq6t?5t1tG-@C%y|^@;B*siUr!!B zZS%m?o4bXhMSIIe4c@lZUM#}X$&~dZ;Gl6;`iUcdn#5RQYtk3;H>{A8lQ@5x8I&cAg4QDz!BH-GQc!nF4X`g z9Z6O^7(|1ShE%I z`%HW!P&3FT|F~@g8I~Af1=`Lw2m|gX_9loK#QGyGsP9vgkfEIhY^J=?ogpmJ(yr|< z4Yrxk@6r7JW{e#b2Kl2FByL^uU1{!qbYZrDY+v_hD$n@i2 zkn41Z(0RoU)!%6axpN~j6aEN}AoGX$s{~cHAnKn_AJXQDNOq~Lv0p7W(2{OmQt8?| zA*qOD*nzkw`cYB{WvtKx(A(;kS z!?p*m;~cG61{RHy5dT5$6PZw72Q+4k>F5zDLMsP;=gf5ZNz(xs=pj@f z>#?y6Yi;3OaB;ZZ{WQa3Q28+8BU8}BfKGVKpdP^mdPHws%&zvZOnsyLp(T-(@YM); z!lZ6?5~U@RiKv*$iF!Q(5IHy&yLdH3X#i!HA=Tm*taNU^5;Z%2^uPj&BZm?@tYc%T9#LU>0G>!~H4|R7UN( zZ)?bs=LgQ+p!J50Q$L$^@&)NfW$g+9dl`C%bDogUpi*g>dB<)?s3Vb~{uzajbi%>l zKP&aOuw)m0TyHitewpwzyp}~-IE1BQN^M|C&7YAGmcCy|N(OY8$++(H&Xu*n~cV$1_Y2Ilu>= z;*%dU$x=;`^m2-HoZ<(g=cv^#KpZPnGEU`b{osW5=V;=t$^>u!?UJF;!Ay(sOOczgP~{BzYv@N3~+A7okp&`7wvbn z9(m3R%Iuk~g)A7{#7!Ok*`A5rRFPTletR|VsIUH5!w)U^Hje^z!KN=@NUlmM#qrqD z5GRrUYsa6nX&sEoSbKnbm_bs8a?lX`9v@H(J8T>n(f;;&&>rC+d+JvR2j55L4V%sC zuVMvq7!+z1ZNvrJ|FS9(q$jivK^{C+=r2@Kp7M4M!P;R3|GQ(I1x8=}(AQ7S8?Z%Y z6S6#mU?JZ%v}lmMyk*7z+49ueJuobk8V1M$cFjE|Gl z_m=L>%0K#A4B}6=Pk!P3L1pFd-(??c=Iuz(tTZaaVz(!Tggp2eLsiRI@T2ggPJ}Of z53Gon9%ZBWqYgQ-A5)+i1IWR*G1k34s;4}L-qQ;RG1Dxc12&J46N{O*mT1=X0*JsG?L6YS68o!X}8`X1- z(!BjfeiSq6)pfonD?W4oBB?y5K+u_!1fw*o6&~LWseNVdV9x-HMm)+%7}}fhBTV(C zo3byz4camm@&~*(2JQHBRWEk6>wn(6e}hNRE(-le&GlcAwt$@M?El-uY}DLL$Y4YE zyVma|>w*QmiFrz|6(-10eYQ0r*%C1=t&(HwL^|I-A(97tJI31nW^e8tcPH-wD%JM&Uh4WMfG8Jgpl(!s0WdHk{OtT-U??P{ z01HQ#=Sbb1`XY&QOh44^Za+h}H}}@9+AF2%&30p6eUG<%)qjx22dx^Gk3+^88n=oC zISl-kKrV!+ukd5jpXb^<6I&J_gMdzUtwf;OQAjH9&}o*5F>RY-dPdev~ z&3(NfN3j+E5COo(76yW0%nKWXz!NH6Tlwueg*Z@Q{ip{NCvMzXg>3=4RT)vsI3b`>5k?gPY`d0S zU2>{F%;I4cJQlEHCpr325JfNHJ<%#*w2R7y$3 zaPk9vEN;&~KIWl;o^AMy-V^Ag73&5oCVFh}up~tNM=Fga6(=A#9U3A!)NpV-JfI>D z8-pKL^y+{fe>cRb=62HQyW*I3MVMP`3ZEdxd%cI3L@)|kOLo&XJ0)a7MeK|cZU`p8T z8rWo*%ANtDO9Wxme3WwRTK_L1xTdy7bkAM9G$t?Y{(%*7B72!B_N9(V0 zVO@lIEH_CQiIM-R7Vf9u5e+bZc&y-Y55P7ME8GQj;~iiFlCcdEIQ=5@=sqdt+ml`E zCEt_WBDS7uwhDhWQ-2N_%`iN!I?c5O!b+st!n;KEv({7hIX47>wBWwvI34>Tdrf_l zKe5JK$te|Gh!U90NeA>2^U`_y7;F>`ZsFnNvKkpz^Rp4ja0S)YQj_`+dQ5RnHcAh{ zLQX(x3hpREIa)*wnW^NSH#i_Y=2_@x82s$k#RrDJ-vI58dvN4rY$X}MoO|Gn{vA*V zm{THb4gt21O$AF|m0D`G9!q&0-Yxw8HG?;4Z@$Q=w+n$wnESI{vwLzc{ecNfN`&t> zPenX-LB+-umFT99zEvG<-nL-maUd)gqp3aq+3I#Gw9H$W*4kAP$&=udhnDM)D1XeE z5pa9T@#QU+ik*n%DN0AaOS)qyS5P)?Nza!v50hx-B`T-f>CaaZ5X)9l+cIfc<3NRB zu#vQ`Y~6$O-jpUQ%W}4*?!LusdRBe1*Qn*&u<3VXzeG$zWt7hjGv44#muY4h?c}0A z$7b#bh2hKULHpP#=##K|r>iQE+h2NZi?skXHphd%$>nMY)YU(?D{rA zCMmcpv^bU;%%nSvq{DG(y(?S7vC2hOcBfryMT6jUPgi$M$Fh5<)RNtVcIW6}T<>t~ z3JFyPBjij%X0{+=;7EcutIC4(a(yUsH6jIZiKeW0_N?bb5b`dH6f(t(328>nuOO2A zK&TXLdpg4=n=RO>qb*=&?06IOelB*<3~g#*s%@$HWsI~Knm!&e!ad$s3c60B z=U-$0jk4wj^;dCgv)QeuupS@Xlt6@cH9>yPVPo~M4xdGHcT~jwFJzjc6N^e6Wam5I zF;~zTKoTyoaU7V%TT?n%EBUxYsL+lEc_e{MF@;|(NL0px^*27)KDt`()o9?ORZJ+g zr5mt$ffshtpeK4|;+q?*lWr`qkMXQrjVEBf-XRk~U47(5#Bd|(yJrm#b;QA6rraKX z%reAb{96xHYC6);B68vNUb&F^6QFyGzfU)WCx7rBsW^c@Zyq^uq`_wm?`qihyb)K3 zJyC5BKM|q!#=wg%YeFlW#D?N>xxSD?!_=eOH(c4XzP^)U{{>xm*s}T`1;Bp=2?BDk z{2xeAr>5k;;3|68vpO=hf`TYVS{6%Jk+eUi#k}YV#aKYG7$#ntiX?47z}HKcrbOJ` zNF5q`7)nBY$Kx-&tdE3Ph<^U~19V>pr7gEwONn>5Cq$;vA>ux7W(_W_TL8uao(yGGWNmAl9Cu&04j6Ueh&{u&K5CRvl>f zacTNCSNWqr*Er?%FWZjJ{&_RX0S@tT_zcYMhIr8vCP!gTxGh9yjhcpi*7ebf`>2MJ zeXF!$G6gzEyFKem=;vK6TWJ;aT=!Rlq-Z)N?|VZ7VQBCvkHn*zimT3lxE8s?o=9m^ zgfw`{HDcIytRoWG{XXuj@;urgaB4Gqp)p0?%(_SZO37-QL>mk-i3SGjU>*$z!+@T$rveO^-JVcx5H6#T&9>~9 zQP(_8YK!>!HDj)eq+_ohflbLwL`|5Qjay7Uv_{Fz8`MktxuVtyYePw2%~KEaU1Q%? zw}QuLO=JS5Lc-u7QhIlvL^_?jsGL||4Knwc2JEwXDirK1{Fw}rdBunqc@LCM& zlHUcHiPw|5SdV-t_>!<$L@L6vg(aLxH2w>)Ioc;@gk(<1E z)WBTIs@z=%nJw82UB>c;#=QBsZ7&lmB~LaeSQ*(6f68fti`KIE*4EfPoCmCRMuJ%M zoXz)3WKR4s9{)btEu#S0?I&LHRJ}MDBF<7Hs<;?xic-7zg^PK`BU>Kz?PE)J!*Jx= zN23uf+yAo+Tigr3J0Bz%Rw6t?ImMxubuYf(V50%(gcB-LQIp-e;QsD-d%)ov>WHI* zPx&wIwXq5Zbysse&&>01`zOKRC(6=e{7!j(5MfJ1F|YrqL7uO6Q2g^OvmGM$@HkhW zq=~+V#cm*L_cL%VHKghuX8%ty?tFa=X(!GwTNDEn8Ge`-kuK>o-%=B+MgxMiT!b;M}ixh zb^ps2rS$}Zt4Z`9_M#~MwCb*i<83vFWOS4jNynf!7FRquMzuSNZ2|1I7K;N%-iSnm zax)V_SzF$lI^aR|m>EirAPX34P|~0!=pVA7 z3;q;57QDBLO8Lh#lBd|DPLc?-19XD$0V+~oif0rr@-N)h2+Tl0yfZ8BQ@cpyKRk-t zQ#L6F9%hM5vUd4t-hG@hd+o^XS3zD0q)@9(d-FHmxf_NOlP@tO9iD>KS_a3rmpRg& zV$^~p(fgPgqFgSxzlZ%LnWXSM;1zEz(rxn9LT=PSZQ`?{~+7& z?UYsF8(410km6ESXxhq_u~!3E=cCcHatMXc4GUAfFG;kfLObxVKWbbDm!Y!m@e1W7 zQ%B{JG>=>=>W)AHmO4cs5D&{kgPDZaPgf54zWNH%S=)au?qTHb0; zwsP@E-R$EqXYnKU7>Wv)iM(qGn;Zt6GIphvg+8=Au>~4geJNI+gxoE-fF5SFkOifG z#GUOv$xZCN44dA)tAB&uZk)>erti2s?nv%!Fg$u4)x z2I%A2K2hX`nze{5@E?`rO{k^u<>Xeg-&>jtk_l5|Zjr?dMgy#^nZxWc_93%GD1ZL# zIpXqfeiyv5d2vSQdCQXpDuyegP9~$wq8L&ia;5)Z*iSq?eP4}1F-4~t+_80kzStam zWi^Z()U3V1;_rAL)bF5eUaxal=JCx~=JtDb<&^y!ef(ZYQ>-%B6!*6GYcJ7o=2C?! zD>z-!)imjNB*H+(9*cwMXu#B1nAUTwdRkf#^ghgI!s-)ebC5tBL`9a^F z&EKBhBy=!hS{$3tER^V(^;sLoASD5PM-hZNnjkWd z_DJRY(ja3Fqm$&EOAhn$aHyFrr2j0 zW-M7k3djH1q6d90ewzvi(l>_wXo#0s%0V9B9W+r!?J7)$!lJEcykO%7K-@r0Kl z;26$aKU!DOl!g#a#VV@e0vQq*JPpgL#K-UfXY4(gV|!Lt?TJ(7xqY-ma*40_4~fEv z2?c)y`4I2V`tRhkkT(Mw+`mC;9Xy4od?WptDx2MHbu7q4D!k<+{^=Z#1KkbPu2zaT z-!h`XO0J9U^0!AhMOMqLw*dMV@6R#^NQik170*vR)|*%l#Gjj>Z|V}!AR(uyZ|=?x zndEyFTAaR!QbAH(p8MCwhDTD=aWf=CAE7j`u;gH)U77*ct-4f)TUSqRGD%>BawF~u z%6{X#z}2Qjd5Huly=`Ps`MMthQHjdm`QOGulwYJUh$zUyltVW+@4Io}9$Mfe1msQu z#i&4;7#WBdB-Vr3$yzc&5}90;VzR`q;M@(onAs1sJIBgE z_PqetzXJI0=)uP|dNxl#G$)HA2cVl}V^e0yfijy>D=#-f6cvDUf*rUhbSF5X zKX3M`Br~zTwuW8#+>e(@LSaL*ip_B((x5(t3F-n{SyuL{DK9iud{|5o>l;ujD=P^r@5Y^P8AjvLX6MM{@1A zuBqQ;J_T~RXA4p06*eas1$?rXFAc+36KxtF{VvZlvia@0YEq@P{>j>PgUcSK;kFI&#YR`q!1q?KecW9ly93q}E^A zwlA>sSUU1hF!v8<+NlXhx3*|4ihIHwo{;HqVwJb8?Ne|~^8J-;XbD`{k{A}_q?XZ# zYOC^X8j;kva2V#Oy40~|oPR$Sp$IUQF{E><_scstYtL3QG|G<=L_n`B_+@s;=6`r`pPMBY_xw6nqtI5Qh*hK%P^nFB<#_rdSah`y({?K z_?qYRi7XQO?m$;?pIBj5VY4^QAWi}2p|I3;BHGi4)TCnBO}@T&w-C@|)?aJSN6#yrL;u*;?^au_af^hWla;`=RMKjBR7$zW(s8|&cDEP8GA0)ToW@m|==}pA#qayMAyISj=c0|~ zH;Uasf(|Za3v8XCzUks!-q8KB-oP*dPgsTTeF*Vc?bS^eH3*qe|F6z;n9!}2`eYg$ z#{9kS(vvV8qPWba_EMBIbz%w$TFk*3^oGFJ{6cUt1C!Vwf$~%ZbJF(m<)8W5Y<`Qr zbs#Khq#3dZ(^}m#4Ea+`-z#gQET-PhiyJA%@w)Wtyns_G@#Z53%3Brmj%pDkj9 z?vsx`QHeGZB0}8Y^lGyvL|{ltZtfMxC|VhCnK=UH5LB~H%{iQvArEMY1z&1K%hd$@ z^H}63z*BXXH{VySKFGFzwfC+6QWEP}^oolISQNQ1{!~HdvcL6Me&bN!I-ecp5|(5; z&v+#8@^M%Qkd-z&(2KsM1lcdXS~Ae48ES9}P=oCaXEB`y5Nl=@#$z(V5KF+sC-rpU zdovK%BNqf>94$I&GCFLP#A#1eM5P`f>DEYfUI9xRkv@+|CI~27Xl487giP1u$67(& zTkC@U7}}*oD2=Mt3XLl-f#cl=@Q7EiW4d5k{@gEMnrNIIhA$#lF5)WZ6P#>9p%#Eq zBD&6Kg?7Fsn#D8pVL3zUn=-D~c}rWhr6{#wRgn9r)^Xb~yDpJ4`_V+vdW36Kzfll} zH0~*@Q)Z_8S4LqMWHyv$;!LHk2{L!Cq~4Y14mX(boDjZ-z{nkcs|&cgG5_c)FHLaC zYZJHQ&@q@)wdL~IL^&T^B9AgjqO@OmTLITO>MpUHL=Oa&8!lag0YE z5Yjc|VpzOB+Wa5Hb%dP_V{q>+q8;2Zh6vLX#IrLTk;?u3n2-BB+93*F@OcZ9J^?+Z z@Rs`QBxhC8D%_A1LR}U58<2gozK$aicPcwwa+JX0kXV-z3ja2?qgi44o}XB|fM0c< z6ox%I(`*dX(LI^7MNG0S=yFP=L7!x10f8hkD(6OSVpe>H=@CydIISU5(98p=0^%2t zk`sd|jM-DPL|{&0yeozFd>(+s@fhV2q2=NUy&`THkz=8?FyL0Gd^5Lxgwl_&;C$kz z>ui*L0*DD*Dv~x2pvhlIhH0Lfm=@LD8TWq?N(rY`Fr794k>`y+ps^htw!>m+y{k$B zKMC}tUP^#sIITKd6+;4zdryM+Z(^^;V6=e#{+;cb(2XU0j$}?zSz!PsJ^ZU;J7x01Z;?|wE35LQe zU&SJ~i(}SB@1waIrOoDFYfPP%63bi(ETciK9m?Maz_Oo9;B;T^$%`Q~CJYuhu z#a$@g6ogQv;Z=RSs#%2}*vQJ%xtS+KxS9dxqY*W~{-=n>j&VZ!T@P(Ulf7COte6#R zm{8iuMIyx?sUw&qySi!zp}xWr@X_CdJpKZAe!Tgz)R4Z+g?|j9Ll-AfK=_w=Fl`PV zvlWTji>npk2(oaH=1jW=Z{J;ic8mW>-T1g@vQ`gD-f1v_&1hrQ%5RMdc`v_OlU?vz zWO$i3F?@wXPJv3qxOoQzr5X8=xbm--b>Gq-QlkMT3Q*a6_ z+6%JI#1?Wh*Jo&w;*TDFP!By|EZ*bY$6DS`gT33(@rf5xsk8Swoc+>Zx*(j!yZ=wfX3>? z0bV;jwHkWI-c3hoZfkBBW}fYSz0l#PFd+~e3S#n1;Nd>3?G~}0jO}JmrI@uHGH?BM zjGFDBpj0%c^qFi34ZjAHLjrw1CCc%==VRx2e^@VhX>!*{_rYQza(sZ|(Fqye7im)< z$P7E)?d`t7?_|^>*}uh<8#gx&sQ183k2Xj*&*kZi3e6cfT>nOj+t!u${oL!`I@7%V zj}!gB>H!C`1OHEyc~V2$ew_{7ce@(-sYX(8ARKE`$v|MO*gAya+{~U)l@LAS59~-h z)u=2F#OozDy5zXiU!5g80#pH3R}Z`GR>i3tL^rUPemR*Peg`w@FTSFM$?;aL509sIt&XbX@v=ng zqb{sTsed^)o*eQko6dtGaiiwTmM)Koq8bnr>DjKhy?S(tRGRmEITyjhKf&SP zkCGQOaXmM-X_9jg<6z^ujnU=0Gx>ucNBx1V9Shv{Xiqa zg_CtwU6|~|*bfR6jl+4FX|g9^kUCUI)LP9uVhat(ORlBl2g?N&knflrwkGd3HIvs` z!xW;3gfoDw-$MzZF!f16l^Td~>}vzMXfrRPRg8fp1GyU@&mb6xvhMX0La2|Qvf2XZ zBN)g~Sx*@f(AWHw5paN~CZ=^%eno7ii9$jZ3g^DRvTT`@uy8dw41j*62;T(S_irk#5_$EdCrrNO=I5 zS6XZ?qDxK=fVn{Uh=Nh#T004`?pnNa$vS8rBz{{}%CT*$p22^y_t(JAovCuT0#)VR zVC50W2?=PLV#Q4@A5<6J zm%zAK!fGQ3PL)?>or|Y1fsz%t62W2CS|^N)3sG3}Y~}1OT!nNxk4715Xf$@&&;Dy) z-bAl=>xN6u{^mM4-BJxIQ;&VUqh`h8^`r$A8{a~eMav|WN@XoJ?-=X04-yCkaeH)0 zcEec#_Mwp!ksWdlk5bb!M;^dRy><_@V9h2$FUqZqk&y_3koJ)IJ4gncL@}eZ`cDBE zixjJ&>XZ=>ekK)lW>s8+^fde4DQGWL0t_s<1~srXdrt`oM?E3b3T7F^lKVW7*a0C$ z|50{WlmKP@G|D^-RsL}^_@uAmzPL&TdUBYTxBCE~g~TTVdh!CmcW`t0Bx~?OL}q%) zwD_Hs%lc06LU*nRlrD>;Na6J`j@`!u)rqZ9Zzvkr0=KYWTBk43-95%tPme+$CX_JZ zOhecEKK7LPpVswRQb23 z1xu9%rf3$C9raN@L4_t7|8%yM!+mf(*7w9r?{=Wi)@b{+5X_`H_c>T5w;8%s06lSn zG>^p(#vx^%#7shY{?E860&Vp%S1tgY8mRfEkh?rSue_I@*_P{`#5s7$?aOS!KaZ}% zFvMg`sW!#MoS)a*Zf?lUU71_!WJY~>HP4DhWzum`6X`4c&>gJNIQWRyqvzws7k=*5 z0T?@yxwjZU55-8{+D(y`KF#vI9bkXZ8%0P>J!!<$-jjIT40K;%8@SZU%~E+j(&lb6 zP;#DQPM$9YFi)LUtG3wB1)o&+{2l z0*^E^0n`ctZYAehR5JA2X*KH`5{{a8lA|?@%u?-e$c(?}Jl0Pf37$^9hxdP!TgDz8 z0EA|i+=DKa=X>@<6&E{?JFqyXP(J(6peMVw%21QM7*=D(*hFg|ba9+hCg_+iy4p0) z=4RBWa#krX4X%jBby=^D%W-av?Yp>f*J^~84jMP{iGJCkP-$u>szRo)j%L{sW zXit5WXaM=;r%#8Ej$V4^wcz-d-#BnA(A(#ECnu;gKQ&g2HIhvxsSh<)OxKAfghOc`|c%ER%iLy(3X2irL>=|8rzfbJY8!!t0 zlj<@5S0r9W2G;)-Xbx*^$8NPC{<~)sox zX+d@2!&~I{ZOUG}#(6T@2V&zOAWSOyB(pa?pY3;}P6p1;TFL&6Zubg4lW*5nxAzb` z#Y{!Fe){@5BpI8mK{6$C^Tg+2TgWGCx=kh+0rJ$Yr96r8eRJ(aOPA#BWbj&#HKAM@ z8n){`QKK2+JYTezpl}|1!H%|Mn~}f^V{@7T&ag4Z5`; z?C+Q*K`XYx(~gfksjH!-CVO-@p-VG`+))DZNsPD0Jl%3q-V zjf7R7p>T7I$Jv-=wX8di59C@ylHi%YUH=YgYj)ah{&jU$y`yJMG}65Vl*SDRnQe;> z`Tki{HE7A*Iu%0kB5-0-iIBPz_%0|bjHp`T)yG7Uj9WVI|4i^CxN`bn%;&wCo7+nDL1$xDX>}%Pj4Lx}PDQB4P zZUjcgCA|SBBIOFu`kz|x<%+&8I=N_^bV03+4_A;-H{2{Y3hjXhD~FRjG*z7BGxRbKii4L%MIES6iLB|N?~pF^{=3em64?f^lEh#0pm z;sQCenB3BYR2h!ZrZmSc45m3(1FNepK>;A{=zH^T`&i{@5LH0&eTzc|Z;y6^Kr1Qy z0x@A&yWOL#4Qf8}ZhlU{)8LE>%>;O#>P>3xs@A;lnK89Z@<0a9ScihA*9+(R)T%I` z46Sq?Di6i$&H?c3(#;-X098kUy_uVSk6m-!Vbh`QOgJv%VM112oN4;`Y>wQ7V?(|s z!JU29^sq5~ssj13UH$Egio3s|OS!U!J9tsKW&&FG-wP{&>(5>V4-S`;eR8>IBAF+H z0Q4$L(+#+oPqBeNWA<^tx0@6TbuvV1V-c0bvw5J1tB9RMUVeOjz)$mVr9!zgzVzt~O00P8zKqvbMg-1j7Ca7+9rm;1{mQ$)Q zwm;Neni_=askM8A%g$mSlP0)kY>O85g z*eAhti&}_#-aq*{8Enn9k{)_|?pD{!Gmb#7gmg%C2FohRE4kgP9Vs5zcFnMuKI=ax zbk+JQ4F9`6(aoLTY0UW8ZPs9yVOoUG;*E?p+1cHUHeqQ{i;t!T-^N!vTw!KdPFm;6 zoyt#Qhvi?>2kaB#t9^Et%V!JdtiRP}uzQoEB@-Kk$96SR@9`~LE3d^d?a#4D>pmYi zbFQaDU`z5f{mS?K#)@SEitNzS1M(K?uuA23Q9>xJsn-kU9`=(6-dB0+Ap8C3S(^JC z-TpG#8ok3|VzU2tzdL#u+|4=WSq%BGy!~0_hfmRdJc_fUwKcQ%_Xgcy{p{sGx|jco zCCtFg_P?MK*XsZ9W5OuDr)ug4!{ry{rziE1K~2RpmY|?ZeUl~djWfnZ_E$@IZrDSy zr&GhST~oT`)*b?#38RPO?cS$c=v*Qb_wKs1|<_bU9oNcD1%#`rm;TVzE2IS27II=XlT`6@n5wR3s#gA-EBX1FT4Ir^=S3-+ zB`HkwlTns z*;bn_P6oXnLzsm07ehQ*gKGB|B2v|&x)fS=T^;C*SGkVM*JTb;tF%>PQKUkNAQKLy z=a*Cm4I&5;?+|wv7AS*n0G& zUx7fQLq{0}Ck7t9a4ldLmGBG7#iNMRU>BxSDeM3p%`5uQNe>=Y29V^A)@qzzan)lb zbn*C0jvowKFA;&mAZiNHZAqy!zQF;?i*$K-gwVTAxK|CeFvL!3+dPQR(R|1eR8;xW zVVU`v_il;Ih>${oOSm@H0gnZd9`rchH_G2n9m_-L-+-V8BuooS+S-svdRNWnHT1w( zgt|gxrn|QzTJ|NQizUGkOr(EMs!Cz{?{bJy{3r}1__zBiX>p}#BYgqRlke?$8I3Ys zN5W49|26yKv%+R;wqoa64pp#P2LUO;Q9rDX9VuZugjm#&66ZC7sc(#cEm{Gl(TK%3 zO)GNhM7AbbD_xmYPWFO$@M-L_odFXirW_K(4R&DX*k30rKPlQ(Whc+q9`HFL>w~Hh zwD}L4%hX15@vxs{*nS5vzPk3OI*4&M!j0 zL45B_q0)hY>|{o$p|sW&bo^smz1*lqXVy1{q3|@8Ra6*ff3QC=DO6%oauQ6m4g*Hr zn*2x`$CN!6l+|0)sg=o1v0nft9LB*v_s>NA6jWF7ai5S=np?`?0Z>;7>yz!K3@|R3 z(*+=i7s7H#(a7>9rc2$SO!T+D9bE9olh0$0WhfTB&{yfRUd^tDn~j4ghOUoi#sK7j z9x%(yT&z$2c`$HMm}WzJc^ENcOEq>VOc(1-+p;0MlZ=+2*`C&#kuJ|wH=E<@SEgq8 zynoC@MiftLD&i5PVtxzE-6!$DBQZtpJfGL67~7&{4!53sZFag66kptc!VKb$sXw)C zj+9pp36wN4`my;L3NOB(2mTxv@<&CvQ{`SRgDa_5e|6}8Qt$yhaK9SA@j-0GnnphB7*z(8k?l`%}lZIy86OofakVbHGzdqi(KYNI% za(u-n7u?b5*~C`%?o{=BhS!Mapn3?Xvbp_FAKCCWK-f4zA}`ttYUb+7jSrC|8Q6p*D@28Yj!~vf=QHrURmX)-+2(OS zaF@mCk6y8GKkLbw#df=n*6U@GR022dls!LKyD=npd+6tkwc|kU_NM6}MPquNwkh{% z&Uxk8d62O-MDG!&@UbXE7&(n~fPa4MVZYSQN#HMe^&bl|Vwn;I9nR z5*@$L_)&g2)|{o$3XzYFVGlfzjX z>?JTf3|`pKGEtU~^3n(O6?igNwB>XnUj?sIwL8p9=0j$CC!Pwz?M$$vwirYesIUbB zetZ=OZm>caoh&v*f14xocK5j>%wo%A#T*BGP(I$&(a()1qoJv2fgmn(+{AFjR1U_8Aox{^`SuBrapjuskt`rzrn7;FKf9|wTop1S zNYR`2VI4N29`qkVjg10J{7u4T0@5dpZ91qf`4Vm3-WL`9-k!I>^;?-3G7^8r&wgk3 zlG0AEe3-q}!RkL;-uO-FZV7|OhP1`5g_~wT;+a;#ga+GDknx{~)ZvCKAKOBjOfN29 zXW|;|rhVD9JKtk}HPPdwIx4!Vr~i1-s;2}L9?v*!xk;nBeotq_AA!CF^>^t8WSJ$& zqRMO*MX#p{J%=5LJ|+rI2Svqt;3^&LtWGrwVNA~?ZM!nqEOJk3)M10zFjvn-$v;?X z62g!y7?ynIW?Gg_Y@CBG30G%`X5X1)djsR!jweN9khmXTg^%VZ>Vwu4a%eHK6WKRr z144?LJDNKjjCbQmeZCKOYjo_57@W^wT+&Z*0>ea~hcZl^sPLnw%M%W_w*I#8*5MY= z0#GzT+&m~RHxu(tfEQ;oC4YIJo>cb7ehb3J2f4>ER;1;!jZxd`Xr$HW}YSKPRmZ*#^TY~4VTIsRlSPB4P1I!@Gy z`Sub3d6%YQ_008)#le$3g~NNN8!@HT<-v|P+83gV=F>A2NtLWo$JP@tiUfB2MqvWb zn9P#*t&Dm>gKmOp11q2KlJ@}?n-z9DNlliK5tLhDQVQ!l4+5bPIWDQ8kES6!_v_$y z3vQOl%@G|EUja++CoQL!uSBdilYzSX>}60>$V5vz*<h&h{n&OP_2YPe4ena1x_>L2J|L&EPIZDeY5Bt8Nx z{LORWKk~UN#FoWso}4}f*OK3xoCC`f2h532kI?k%-*PL#vCACHx7H2*1igr_zEp#G~azej5~i5DevInu$o5dje! znCplNz4~S;;?fr3b^~mxg;S^?Ntz4BT7tz%H>iv%!Onb#EGH0k85Jw>e$6Od{M7;D z1=C+ml~WG7NS~f+niVEF1HuD(rv@teVBhqZO}OKZkeKHv5=lKKi<+jOt=%hDQRACv z@lAFLM$t6+4RpV-l9s)00EYNbl(+~-<#_{;A4-5#V`>Q{Aj%io>_~y#hbnYRj5FI{ zj;gvh|Fm>xct#wJeS7I>wN(kZI4biI5QfMYP#h$h(cE*bmi~Ff|iD-f}go z9wrEPZOaz3QiGdyXgIUvi1=3@|6lv4!>|VU7&8nMf`3*)rckzxCL$@0$OuTOO!TP%f_%iwFRzOPS9?ixtxa1WunqECHF(+R z^08rquzz%v#vEq48=d^GfJ0S=k|&267z#C7l^)!+10cG%qV#3uLF328BN|$7x=qId zOV%ld$(Ds39(&`Q%M2(8T_*w5I7V=Ng|uU`L$`L)ZX4ue{dYtd?TQ%zChCJ*y0icm zicz3fBC=^qT3p&gN?@oH3kCWpJ*UV8$(}#?PbgP%2M%wzzx9lMVvsQ>&R6}7a@6)x zX4ar83!RF~GydvveO{&CJ;PVjI8NR5bbl9n;qAs89u^LL=EYx79_hT+)j>sz!X&v5 z9=oPx%n{bi{&*(GGim{fZvgJAPtfD>$DQ4AxtYnMb4w2^FC=>=@1|b8y<_T}AcB`R z-)07o`811{YMa{~m|UIRPUq@NKASzt)66wy?z+3a!9WQ3h3B?Gy{bgXJv>DePnMSw zI%|VpIN3LjKX?%C8mG~oC&`Xz*)=Dxoh8*#~jdg)>yFi zEm2(ewO`PJ=cCk+jlSI*KTh#~!1=#e3jU+_`LEcD4D<~D%lmYz{hQNc|DQQM0>ixG z2Gl_*HGHTe$9R!UL$;k^G=+cBwFKyxq9N6G3;DyQRCtl0WCJmqjRA1cak||NCTtrh zi2gevLEb}TzcU;hnZBJgU_bc)B48pFzaT$Gg!{h|i4%syjkfd;NRk2yh_s`c+^gKI zEKVu|SfY0ct)1+zLh7I)FWtk%%>JgcM_~>gYK)W+dv|8!Rz4uL)lxTu7V32Zxp2~F z-!UQ-WUYyh*L54nBZTAVa~ZgfS~dg8iQsf_dSnUiaLmWjLLEvU!o9V+o!8nLJ6ezNg@&ia_c*2FhTM;@iObQtgL-wzx@h8QZ;a?qJZIwBt(b+7$s|UT5 zXpcqzs0Ir&-;bZfTLd0uVN`>|OFRaBlnL|X11vcWZ zkk{M>*?+c@0;`;E>Q#BIKNulX0@m@nt*T$sI!g(T;TZdkfmrmr(nde*CnF83>} z7e$U+KUOO?vCKzIybN5u&Rf8BUuP{8WcDT7S(D}$DL-v5?>sd_IXy~)?d4)l<^n9! z)g79ZuUDd{qMjzw=+Pgg>g64ID-S0F4}a-XEey@4a%J3gl}}JQl&9@kfsYk&m0Zl# zu5n28+&GzLpMivdJIV!GI(E$YL$8=867TzJ3{$<)^_i=TkSa~8f-!AMQSrgpu$W<5 z?iA?$`JLgr?fcHa!`|iEUsZwD3{`6?Kzz=3F3aMpLdSJEwkq`Ba@XNI``tO`3&*nf zFEvWS%)z(sPgkckwN_vkoQgwpk!u0E0X}Bw*O4O42K(hiD}D}AmxXRZ9Cc>i= z6#KSZnn<S0=TE5_{vYL7F)!3JFmvcpu8sG@%CMW@;Ic z$2Cv`@4d1lsoNqM+NK8sM@-4#{wl`Hzw6m>8$$*lzU8iZKqAOI8|XaE$7B=n9`T*+ zZL$+jO3kF$rJkx77zsrq@E#O6v3*t?yk0?L)!+Su%|Qcm4pd4E15K`yjzzWF_P^s71ixK9gC`S5#Cjsqi$V;j zDlIN&j1E_(me3CPhUv8dV~OOmBEXl?TV8P$*(7Gr5Hv&?yx7*U(Q~pBIY?&3V!lwsRgvrhcVHzAb5@k^Nj{y*Vtb;AJoLbG(Z!H;K znZ-Y!`dD>A6Tn{dG1_wD%}5j&>BVh=$tP(602&GG6)%pmW^r8e>BJrz9-W~s%W3=P zIE&1PoDtj6mii1@agDD?snc6h7PJNIZm)QZHENeYZx)!!DeoVpl0Qq!^SMpPTJu28 z;(?0}kdxDlAU<8z`oKRq)@}_X0%Zx}=22Mm!Al7_WY>hI{!N!!`tjhMiz`>|ml<8i zl|&dDh4rBo>yH8~cdo10R`W4zZ(Pu8RTM#wvikm$d()&!DX_cL)hwek52nXCyeV9R zTrJ1hK9jv{Bnj>PY#XMdwf_4W#b?r~M(geh##0$Odz{cKR;Ph)Q*x5V@vn&pjkXC0 z%)B)@^hQXUWc?U|#x(5YH286D_6Fkm>UnHre+aZW*bPw<)lzMATF36Nw$IaT$taUu zcqZu}Ll!v`&dm;mwZJz!aObp+-l!27Rc2I+CT8T7(|y(HFyqHcnkc;nBV%lKuhy;| z26n=YZc)WvhT$5?5wrIPD`$`EE2rrL2GgYs#W|9*35Ph#V8u&NE1FNHnho@>;aRy; zzI!Zl4$9$@M0M<06x+8-rro=PoV*t~T(CGV^9r%0KfbXN4R+ma1M73$bs7i~{A{)c zzt%h4-Wm_(0%~LELYd@#KMgS_$SL-+-Tc0OCbfRga%)v@J-&(kjx@$TJKNNZiDY@w zx}F5*18>e&0^Ml8oyj^83WsKOOO<~8i=ZfFMd$R!lA>F)oQf5-3xXmv*6?vuT)}RM zl!%pEtaSw64Pr`D1pjQr_omTFD9}cHb&+-3T$AkKm5Ea2%02q$`!jlh=$}#OljNn+ z)Z-n{UGD++z>#B5xpIeG_3T4;LN#!(cJFsRwCi%h(Oy3LC{Ab(wc`zEr7|HirYdnf zr)NpnV_^g^11QZ#ZfNIEjpWO>uRonsK9QRjJ5a)E}@(ejy1Q~jd zu6Ht}5A^^)n|X65DbS%4TvNR7!B1YlZv_|;>}yqzY&!lXM^&sCVbsX`TNM_fPXzHv z3iq$?93g-D)oE9`Qv7L8YkN(d^j@S;vz=rsZMI^`?R<6-=&OXe@R2hZk}zC5dx}*t zyR$RPi-0H zN#|z-8IEm8;}xtLzIbyB;}8nIoNOrZ{VO?W&`i-@v|px7H**8$eKd{zUy%lEVC&c# z?k{q-3s_C`(b5K{Rm;}yP`w-1GsM#R5TpTX@vB8-50`yS2Z0b!%m|kZaOlY(E^r{* zQoL{(h;#zwYU^m6^nN{-G`_AHmzVp5&@6bGXPr;Er2J1IJb1AP5<}M`M+|~+ujUA2 z+d0A%&|}(ze8ZK@W>EBcpiC|K_NgI7Bxu~ndVYOU&*%G9@LgI6a@X98lT&bneob6# z8dVQt({LW*Qm94n*Th}fZL37^_SQTzOxFI4a~TD5blvl_?HzWh2o{;4Od^s`Ia<+Q z_%kiAz;y+adp3-#fc2fwS*#NQJ+;o9rzSM1XxcL9mdBr94|;sDkNu8@EXt*-SQ(dz zdC>QDyiUhUlpqSghmR81_chM%ZDq05yw%WvQ4T2gD2;w_V0hDJ%uKoLNSKUz3c-UQ zGxn%+&7;W%81iO!4Wj;KMPPeX7E|;@MO_DRbt| zq;IH4ULaWKzmUJNugRG>>ibUL&OU79pIey{jN zFcU=oQ5F9y+z%rI3&a1birfF`UvTdh@$;VDCuB)TZM=lt;6<@=CyyYSedgLVcw#VA0P~}s;P{#>@WlVN$Mktk z5TllwtTLWIb{UEY3vWsiac=iPPgS(r(fi>!2q^WS-LuN_c{#bRlpzWVtF)C0?CpLJ z2Alo-?zy$6K3tu4&s)d;lo^O@g-{Qn~xrK6^iaaIR|zSTs5WzC1RroRE=d)|deM>j`_uGwM$ggC@{U=7x{f zh>KP0+YGql zIq-<5`fw5Sw9Wtjd^r4ge|ug2>wUnVo3hFAahB-u|4CTJ@*od0zYOW z9%gWuQw~6PazJtyT7g{t6#JZj-YkYHL>g{0-c zY-A*mllaRL+ybSc%9=MWh%fCa8^1yH>(}9?j+95f8J}%tsLPbCz>ILlN=*-A{kz55M$ev$z*exnx z4|g1o$U0E^u=3_!=zC#(Lkj(2T=?0BZ3OQ;k5U z2)S$H-Z|?X1uj`tlIkHFJ7~o}Zl27!m7b!PE%{1k<-iY5Z#5w8@+DFf0(jXG3&dB< z+2t=`&y4Wu7Y6#%8k&rHUL`-$UuD+1j9C(lfW;$R7p;e3Desk+4rQ`#0O5L~AT+Q4pT zAI8}rIQO6`L+R-g3XlN0Hi?79pwrIZb-4!C#~fht1t*SP58Cj`V&iXYO5hYNU@Ljv z6*tpOg#=qMeuQxA(z@DBP80$_8Ea~6{0vujXv0<3&g|`w0{X;fc+TyD=!-h9LecwX z^W#oDIL~PJ`fbkD06n^LV*2+?ISQu@JS!u!)Kq4?p?poyoW9{I4PuXgW!A7mVqCg& zJ%x~}Qt?6p@)v$1Ky^|Qk97QRzj1IyW}MPtTIFia0Ppq_EFd)}aKXZ?g$U+gS zT$X(0Jw2_TzmC=C3Edj^*LDGvkxjG1J9EbWBWR)HC4`1jNxIXx6!YG9`>o2`-L zneR&+xGcx)Z$K(L>bl(LsiqMy;d@4?f+`EtsxWyn9t4GAb(3BMxXC+<5kV6Scn|YZ zYIcK5_K4-;zy1sMLpTNnQhgYk+UA($VOxTdlzkj9eWLQpsUOc+DP1NE;>L);MJoz@ zlvBzzrJLqA&ravEwNe1LQJWCn+IZrpWgB{>ZouX@=C8Cpbixnod!6WW0eeRf83#av zLaHMleEE$*K|y{(fPv0ZQey2XLg<^@xR9^BxdFtM`dI@11~o|=TdlR+uyjOB zhue+vXV5fj8(-s*(@9rp0kFE(2fq<}WSu9_KB@nd1hZa=b~yz)K=S&VQj$mwAeu7u zP!8xJ8|nuo1R|rlD>Nbr!id9<{;bSqMKY+XS&Cdjk){%Y?K892=;7X-AW&`{*;bOd zNu6NF>KBMJC((6bxT|_%dmD|_LFKjGUA}hndDAbWNm*eTX32LD4q4YaLGAr{hIyZY z4bxq?#?{#ZyhIq&I6p^Ll$K=Z5pQW!Q>9dK;(L&n%578#E&F2(c5|5Wu^QMT>{ibb@&bM6_hUz({eDAH|TYG2tN_4uYbEwY9Ol zDI@5MZyJcfw0v-Z1lp~<);{&CwtX@j;_mA)_Xn0lWL4}x+LiwfPQ=0SzaH`b(_q>9 zzY!?H0k~BQW{8@?1R5xk8L<1lZD-hgsx;maW=yppu?)%d25rR8OU_`VXak2RR+ESU zu#iINk(=!=iaFdbv&L=0>*{!BEVn@tN|XNhGpm8e00@O~jYDpDc+I2{PtYv=vnO^;Kr9VaL7VQ53xR*l7|O4vK?W&BAM&V98dk z`p2p*u9v}nuok&$WNIoc2MxmMEiQBHUH4}@hFb4?+H{kuFeRv$gQELa;ocN?mKHKC zB)aTX>Le97_zntlZvXqe82Cr3D?MDFy&9asQE7|HYH0iC3hdNi50j5xv&=2o%icu4 z_156D(OSVnE%xJH>srgU?MWm@f=u(aVV3%Q%{EW}LZ-{6b&kJ9<_12*zOmo!Ee!Sj zW}2_g&G*N%&U&&{7+Y-R)f5b0{hV)yY!6ui3J3DI50R5ZQh>XWG_vZLF{Hj1_+$s1D~Eg6WdqyyrT%F?RiNy${)bQdOIV;qWeJ0aZ@3j?E`wl}QpeMqj zxuZyk;hBQv=^0gz$_2b zI402*tScHGgX~(PE5K7TW`w)-cQ6|t5@uC?cB}8GdFn@^p-MMD&)@xRkOPW^WT>)# zw%Wtx{rp2qc}$q!4^bpnW@2>xJrvS0=8K{Snd9^K?~k6qP2k1Icb1+zO9}bc#&6nb zYLMa!E`Lt4$O-ak=jB0WEX-g|fc~0-Q94K?v;ip}=AL4{$w$r2zlnDvc6lXO@HX3{ znaC+DB8fJb?ScIDG*puYz>SzIFqJ^lsY%uPY33t?eNf(AH+jsSF4yVho-USp9wu9C zhz~v>_U$W|r5S0e0Y_dI<~N8Hi#yK|+*djfnNSn62^kM1BT#-e@1M&81o;lCG$uX4 zB7+S1Q_a^NUiVfVIuI%R*SkJNrjOX%7rk?lCFLRlc6+St46qL9;k~$vTQG2W-{1v= z_J|T1*{0@fy392P4}l=4%=j{oh%9lA#u*bOSQQPfY<>}26`W^<(&zOQ7du1tyt+ni zKg3Y<^u0F#SQWKvaPyy@;k49EbA|xgz>vi3%6lSu2bU@9xIykXk|#dIVTWDnD=z2I zvJDuY^3gNxhc59?SMdD-mz)=`EQ#q2ENrt5AsbJ&AgmiO;-iZ8Xds28D9pK?uW8Xi z&od);kf0if=lvEJ@VD#hL|F#xU=4T>TUl-?zGw^vsnt0VURuW+CL73<;E-s!bvH0K z3Z{s7NNk>wI8j*|7nBhocKQU;!jM};TQ}Nu0S=^Lo%r-O}1Dz+`Dd&3ja&N zL)BNZC|mg-hOmsZbPy4AaC|)#1oj$LL8A&6R;rW~8XRKlFPqnPQZY$?-QE%Nsq^y2 zzkk=$puXi&Q( zAC*jgkCss~FP(xH&&D+7r%Wy=G{+fJ`|BBjsi%f|wM>s3ro$*V78YK7K)Vbe z{fXH>XPmQX{Nq@zS#2?+M)flQJ7_1p5Lfv_jtckYnE;60|5z>ovAZ!_=2iD}*i2vr z0>--(f4&78jXBC$gzjW)D5iX#Lt`HwtlMI7$`Jh=?+;Hin>AWdR3I zMO_W@$*EPIk%|bufSYB16MDvdp6v_kwog|PVNwR@f!dG6XUdCs#!|L~dLHV&1<{m1 zLc_|^xA~c11NX+~HkIQrz=uNXlmO>hw$@J1F!Smd-II&EN<;2(W+J%{lv75E!kqk0 zyFS-z1DD$qKEy-5fJ+)QW;R|v1Whcg{KJ)TCkud6kU5<9Xk8NNY@YOBa<1+k8pDNc z@sQk5iG%4%2cXK`z*{ljWqU#83?Rm3cZxcnT;^ZQ#jVu(?oTDBKj+DQN9~|jTNR|U*fEzF?QUP;T`(< z==1}eDESEaPkw;)zXK<+GjjaDzc2o8EGYVaW5I(^dC|5LUGAg;e|QcD19tK17XC`! zxq}HqsdzYvb%%fByz7x@$H}n;KE$$7EwO3@(?w0bdp~`O?UhLfxx2n-+Ybc zu^4#!Knh6);4eB&X|ylwE2iA#OQTMF?PL^m2BA#r3;_^{?2eIMnV33whCoh&*mY2@ zxfAn5dh9(hi^Bxf*`^&0!VW;Vo-ftsnMKk@bOE0Fw4qI85+yL%I+%qarC`kfpx|Pp z2H4?BF&Gjs=A#R1MV5DJvo;P<5G%iAB_l-v0vxW)Otd-&#)LqEn6z@j_lXMyoC=IU z3b{nNMJ=*;T?roC03G}N9v14W<1!s) z)Jyw(V6%eaUuvG69*CSIKiMH|TFBj5_C%hSrNnR>$ATUpC1YJ4W0Q>DD$)a{rn4?Z zpkm#oTA;PE(6D6zMNED^sLCcgAxyq+Jm@r?_5sxp{O%W!PdglUU=YM62up^t+@*cW z=}rBzT5TSn?Kw#q-&u=17KZn1rkxKtK!Kf8Rv+AmMM$S!2HY0_bWosHJqq9zMc!Cm z?a|Xg5!@ZrJe?$7(oCiu{nkK>MFYfb<_VM<*A>MjKtY%%>;MYdg=W=}_|JK6 zJ6;eTnr9m;(t;{|jHq*1+yvEPk|1BjR8_>n6$JRwRk2O(E2D+Eukm4F(0R&POOb7N zRT&~2L_C05@ueI?I76M3&eky8bvK}ODBxjN%@7=2 zQeP{+C?K512Z9!pw?23Ozm?64^PK3Xa6B?keu(E#7}&MBU8gIpmuYkCPPz1VF;~Yf ziQ4`A(vi8JqrgS;xiZHT+^KY-{ zH)qIUopk+CRp(1=p6u23wU4$Stu>Odz0)#b7W^4(A5RYR{`KklwC3~Bh-nLi&-P_8a%}$FdjJb_|ndT z<^~+w6Hxa029?_^ORjb6c`tkLH zS31sXb6M+&Wi4}IF^Xh3yob=QI<#{t96}@{4F^xfiiLI^9}ID=hDSA?SFYC9x@0ha zU`&?etkOJGF#J%!jx=Cma>S=2H~yWBPaCfs4ezpUzS2IcFK2cv10LBD)cia{P;EOc9FT#nfbadiz!WzAr)lethTcCoc7FE+A(-xK0b|#v`^od6mu5 z(M#5tY>)ViSev?D{jAOhOr~`EZyEp~l(8QCKZ@;t1%zUxXZc@6+GdT-m`zb6pMUs> z6}lwE1)t+#NFeF1Lz2!JShNQC6nyh?v4adEOkHkFeLmmHjtmqI3lCFP26IWM}tBy77NftQ81gI6%lI;x* zdcN&&&GG_jI2Bz(^>7anIVCoiDIr2C88w9t^NWvZw-)wh9}WiF_|aMm{;@s^xM$Uu zn_X<7T%MO!o;yb-7CI)C2&~i31EuiqH^k%1D#pXkNnu0bj#Qnnk_|QbZLm37l?GN1 zK0o?^lzu%s?jwKCy8cnb}+IAzyn|qy=t-HaQm3BMY zu}*y2|A(=23eGIr!fk9j9j9a4M#r{o+v)g^JGO1xwmPpSTGiR|g#&imng^q6*0oSy67<$f+& zdXaOWP*2LBwf6B|N~x`NN(?dr4`NLS8{j`Cp46Tun*d)1XS9d^OC({nvG!Wx^DUK= z&5*IpkS!^QIeX~drZmxnf?1JATS2n}E;JfLrfR))M97?+rj4fa?MNnf!7~WfQ}oQ) zl{6|^Enab8*s$!$e6p=#YP(c!7&WRrk=}P=UNVw7@5X+kfb*sogh&OG?X~~Kb)+uW zv*~+(v}#?74p!#CbWY8lYh+R#-p63eOV^QYKwGCb10YJ^Qj zEZ{&$DI<5^nlPAiM2`-aboFJZuGYt&vHQv;MoGyiNZTqTsdHGprAe-$)@LquTLQuy z$YWoBe0??%g3A{5L_5(YnweLYV@CF9?N@Nd*1S&h=Xk7vp zK0-D)x9n!{r=wx4;5Cnorxv>r^sJhGPNEu#Ee$pFBlLUkbr_1 zV>17`Z7DtR(5?s%wB#BeaH1-6Eh4&xLR{+A3#>-KgVesN_u939m!Ttjp#dMD7`F}H zyuka@e5IW@49H6mlggOlYl7vf>E#@SKJozS@&h@<&B63Y^wsZD|GMS;y+l0cwYboiAG! ztp>aE<)NCI&Oa@ng>rEwN}HEWd_XWz*OQL8Q)zJMzXiEV5d*_S*}XWM!t^cCc9s6V zgCwtw>*a~F1k?7Xkz%81Q)SMX@H)S(cUNO&C<4^=5c5;@{H%%NRu`&K2-{b{v%z?Y zUJr<70xSgyhqh0Cut<)v^aPL+K)T)Ewyf$H%8(rmap{t@@naR|8?B%hHhi|1CfZCp zi2ju?4r&-%jy`AFO&*nAiw<5ZsaAR}H5RPE|3^qEw9gjlK<_IZM`mP70}PuE8PAZJ z_os*Vc2!jR?Qt0wq<##ITIeTpe_@5%{I;K-0h#g$TkfIm_+q|#kHDAT>I|Z18&$&p zgOQU~N)(|zj9iWj$+Lh3oD1!wW)YYT;AR18Cg-XZAFF=#%RPNXS<)49$$TT!uf6z` z_hpW?{h6J2g+z_Wm0e(EelG^wUjz-Wdm2KpLFRk)EbQCE7>nI5pWZENar14(`-f=A zBWv0zgIr@St{wf3qa~~to3(j=co3NBwSJom;FR(=N9YNHgrvlKhUK5o-4&vfG5=?O zm)zfNNZ%6|Vuk`1<4xp@;1Iu;-%OY1@Ax?7;Gn}_GHOOGE%;xu|2WoJ2pIA47^dT0 z(Q6|sr&5|!_6qa}d}kr(1XB%$it*2}j-ZmEaOIwfgJ_lHJkJ-STv)|iVarCx;JWAt z1zX(6W!uF>4p;v@=F#@`lfH%5DeDkyfW%{nXbWm!3~WR6zI(?f=35OVmvN7|YCXDX z{Ob^NBe&~v{bKq&wf7U5ID@?Dzt$7~6OM|7ne#uJ`C1#!2W_Z+vl_S5`MMNXoM5|$ zR*dP3_T-((Rf(xu8lfe`nYa1%s0gmOGE16Wj{oPu z>`pDqh^97&jmO<6(f2V!kDW(n3-b!!r^?pN*22xY+AlS20{0FrrF5iaYmSU*&p?d5 z<(C6dy>t>}CY8u0Yh<0quq3Mmq+^j{kL5IXg=f7h+4JU1rDuE9twm8i`-|T;g5NU; zKF%wH!7U8Fz#O@q9F`zBH8L0z<8H5&?N1erU?ScqjFWKVbW=Y{zq0e`Q5d5LP8pQAWPn3^$t8}9b%y3$y&B(vnm-MYB+e@L zXBZ`M`v*x4+DBx~-)B85$1VhV0FsH2Tny5wQ?h{vafG&y+v)srim!*Co!o?=*v?s? zPz~~_7x(s+jaUJ353bb0A;x5|K#n*f5riJ*Xl7BCU)=klY>HyiQoQ#TcKO2#wXJ^d z*V(z0B_+&cBBcFk*|#W&2nD{n?{if^#Hx*nmvpRW~S^dugH$bZS+Y7tV2<1-^Tke3C64A!S&4GDudr<4+H*TSWE z8*YtQ`%V!c&v_fU1eM`>!gf`VnrzxS;VjX9L*iUBq(PZ>J&38beDZyS+kwF3Yc0rn)+5l2GlU08oi?Vz(-p;#ZS&j zlH+BL-zp-_T(8cg-(KP8@VC0OIYprNWP<}y*X4DC6w$5kcm$`|OMkz#c;^j*!R5$^Ote zSv)lAoLi+T%8E~idU0Umcp~+UM>)zfd4*YEREn@?{0uMI9sx(BlZ`bTN|kod1Tkj# zY$&ZVW2hQb*_j z$=Pzhm%|={wXDbAHjHopw&v*q7#T=rvz5X*_F_0wV6W_Qh{$iP5T!{pDgSksQ>HSi z`}7M5NUl-brs^QVe0Bq|i$x<7tkRZ>urj;ixT1Y8^F^M%Hm>>p)FGTm+3aQQBBpco zSIIFhhq<2w#i!wYj6jN<4k@-7X3$l5p{Sdr>0%gFkPM?hBpivfIj_Hg&Jp&W`Ekyq z`ofI8&*BJBoueHqrDI^kmhKuSk+`aGN{5eOxGDjoUissUmu?T9utQ|9XxsQd#$El& zn)1JbUee`P`t5vho&f!NfIqM8ObM4Y3alSuwG8D#af{Pn&svyd-7;Kie1^o3rohNx?f|h|7#o1smz0IF1gR%iGlkfxR7K6*KqUA>#QWok z8yl9B$*i5Q=5XGh2jGq5cjlT2?lhz7w3(t$wFv)X>_J#$gj?=+1_#QC>y(-}2=K#L zBTA+Lxzlzmb?v9@>n%&QR&(s?M91Bwl!S=!nIPZDZ*2I)zz#6zQnUjxg$X6$#Ya0& zqex$u)sBmp>Kpv`uwsN!o$JQPQW^yj`nSd`bQtmMWOwp!9&0U(a8w}Hq+WZCpaH!tP*Uiv zLGEe(SZ{4~YYIN3*fT0qZA(q3`>+%)h{T%hKsEnoKTo|~g@Yz2yPzJuEes4+Y7UIt zr9F_+M9tyAocWUOfivCi8UP^IC^tQ^jg<7nW~IodyyNtQjVb=UE^a67j|2&?pQ5Lc zGlm{~ZrrH+Jt%jdy7K{@7b8^n-)b1n{|PR}&ix-m&EbDC)D0$-?q^!hBG9P4@FJ|8 zbqdgVm8h5FV`52HSs@*=3aPIi(MaoT5qm~)c)T!Kq@Cz(k$bTK#}5#xe~njVj>Ewm z-K`M_u1PN>)8Axqs3>%)xN92FZ+EJX>d2XrFv16(tr0~@j}M0Ha#_l)4|U&SWK=2P z5cON>x`77W9gxt&sB54SGHPTlDS?m8oQ%cS)o1GkBZTEe&m;1oIyfGk0r%#7@}!ce zzg`YJMimRUyTF*J=b7Y+C2X{j+rvtgDTG6`S@%(J=Zq2Ap`hyWVzH<_b-^*1(NO>m z7A6Y4ffxx#?QqQo+>&I%pu+~^ChHCurP)^4DZi~k=#HsF26ZkI;H?$bo1?5EAkIsr zT8jx!l8s?>RCKIXDwme{GPq~(V#|$as$Y+rmU=8O9+HNYNiKo{!FH<7I8fD9NBWZ* zwP#3J*n}$|HRF}|@jLVH{2Z%Uf*I^SdA>!tKTtXEX*T*c4~Wj7Qp}zIdf%H7euLGZ z$&y8FFWKm@l?;Ky8N3XiFV_Gi(Nh>B-A8k8zw+tMGpgV8ieeiOxQFP_c)M7+&Ra_r{{Ud8QApZ zhJ8|rA>8Ca@cRhFF_{LpZ0q%_#}gJv*Fef_V8 z@_%B+{3j+rg-Vr4l?g;d6w>7!*pQaS}gCW&7Rb$0bFU#DHh&Ud=pYI+!1Q z9vLx)5M4@veTy<~`7ow#BMYJ-1E`QpF6lW53o&46_+*u)NFCb0c1N=q1Q>pYWv>pR zp-!c*<1$SFmji~W24ru@T~Qr{KU%dKW-6|6M3Z0(Vngc$#j=z;iT3&<0;I2dX`tlOud_F$QgF#gxiO}em=x#0x|HU zz|o)|C;kRviwYH8e9MkZ82$xhabvUdBQ=)v`HR}oeA}r2QP>)nxXME7|C0lK`bz~ zQ&0W(2jOOrDpA6_5;9kw`o0U&TSD8)rpWibIfe< zP`R+l2dZMYyjXxZRU~mVeH6+dX{(-Czz=*I99Izt`cATDKbolDav>gIo`|03h<_9`>)ndon37E1s#=mKbS&uwVqpU9ywXw%^$ znBgL%rhs>G@(>z->zBSqIl$p1=}I<3o~RDm#n5WCvl5s!B?~L0PK`^qMm*6;WmZ*4{QSkXOD|ASrFKY_ z3l=)$EA)yi?W4}#kqP?Ac4X;G9^~w@=*)ErV`HOiH!nujHsgW~2YXn3OOv+K0@QVi z|2u;*_lrsj%wF=b7bqL5ympiBZ4P!}@BVC-%(?L?aWRFVVKRVf6|v`BQ=;g$UqqQp zZsTtCE>@_9>q3U9aZ$jAegN$7r8A#waLA*UPg6bNq9R)uhJCoTb&@uer#_BCFO+P{ zn$G-#YSA@FR#>2sqnt|FG&MPauK5!y_20aqvEsgo8}K&=A!|DKm(8 zT+i)tVif*7LD(nOTqzJTm@9%rgQ%ivrUKwncbXqG;faQc(`?2yvg*W#43~G%B26jW zudSTR`2~T&hGbV8B_h}yENM%byb4hIJ@qq>di+Q*5Zr+}Z{kTxfAN?9C^XXm(@5B= z;@B$1uwM(ILiV&6ql4ES2vtYfs4@q?bV$HLdI+qOz52N!PkLP){UdH=uVuZg%O7^Z zowQyWnK$9m80Ji+Co^7ko6f4g5iF$gq@aalVe))*^Oq`#!j*ro@E=oupUZ2fX>9mS zyIw$HcPmo9-}%rErMgf1m-v!2<3H?${I#82r_s!QY1K{xE{mGU+Zaf&U*QNDAD2OS zf~-a$({vJmO$I9|Eqf)(F`?U&xYSD=Xu!#uh#7M`mpbmqZTd?;LA!jPZ_#`ec8-9w zVzecU^@o~3`uVs(7-b1DHFm(#l(Hy>6c_+6ry`_r$)sS_lZFAn9_0v|)>lStZpKYx zZNeO$JM-o-kIK-uv!Q$R`pkxP%9!T4tPXDy(xnHX_wEgEcyXV8Y za;F#j5VNbl;od}Tqd9A7J+_&efVEZI^aPTH-?-dv6}-lcgF#Psdqcc`?v`4F&uf*z z2>lm}UYFd;L+i>c=d32(9;eamyL2v~op<1G#HbvkBmA3DSKrTr{*=YUR?4LQ=UXacMDzxHwRDB+coTukqRbd16eI3t?8xBHqgj3 zGN-N5?Ud22b*jrA(2&$3fo@QRO?TKju;tdRncRhYQZUDR6+nW%TMPt$+hHzf9K`-` z@Zd`CXMtPAACszHRgN5M)$?=nC#}?qt%bq4CWz2&RfQhD9o-ZGL(fFj?cd!g&;ZJw z(coI%7L0NqZ4_L72$k&u`e$mm;QA0K`T3QHNid3$eh|Z1z-PZj%(*Um2>QRQyn8q} zFq}rIzQjkG`=h{Uf4bfc0ykboLh7IVXEkE-_24`0Koi0hvq}c{eG8DkB}jXJ^T+4b zFxoTJ2+BLLpa4c^Bf2C_`o>BHC&xG?U4UN)!@w(|N$1ERc#IzX1QoI{XMBveH|4xU z=v~iC5A9d!i!~8zBEIaNB%v*h2XP#!8#@2Txyah2+-SwjN4Ii2P{lTOC{kI=pFOJ8n0%oR3Q9TbTrXAXUf7TY9#hW^(IWJ`$ozPbaE}EcF*GDsw=(W|)(?6t&%U76vn0y?xb67scocS7PI&-Cm{E=yc5N0n@^;u44TTe6=- zukd>LoN2qSw)8-iplM;e&H$8DdxNZp zjRuJk?u?AZR-i&{OiX&}ilN?+swuh^PgvDE>2}dHQv)hm9d^(t`{Tq0A{O_5oE32k zN_UDcxd+f^*^i5G`GhO`+T7dks3sOjN&_YApN5kbV)H|ZDi*Jw(yhw-i!q99QD1qC zOBheaLH7ExiSM5-pI@+iO0rqJ;ml>TXE~{slGH^7r8g;JjfxaDti+_}z)b8`4y)-o z5h}qs^N#Ld?Rm{Mai)*6%Jn~`wY5A{x`gB~te{h3NKhL1(jwED)ISP38hhX=VEenA zP0iI~t)@B(+474mCZNT*SOE=ZF9FZGw)l(Q<9(1CyB`btH=Sx`O1<)l7T=t zWuw#2j9T6tPkXKK9h7}+dR<;fn2@EgeEQ93>JN8Qz7%q`zPqB) z;XkKbmC_zEj#V0?qkCveGw-k0lMv7*#v=bU5KzxSBbCX=zwi`fp=iWs!H?p=(9b(J zRx89KiFvCR+Q*|8h+Tc~EZZk?s^~j-5w($XDpe&1YN~iN{Mb4UGP{z1XAgYQwtOlX zUa36<74ztYMWXJ4U@Qsm<7%3o1M+<>fqz z_OY#(X>upLdO#A1;M(D;g8`SDCD&a>pvPdi9Mh?brWUar^G%zSvvdvp#pO~yVuR>a zDW&moEd{SDF9aE!Oum=Z*hLtc${%j+!p)gr=c5ZZno z{K7_0ST@}^WZ53BCxH@^8;PR~*b7w&wgrrvdDM#3v(G+rZr&>9lDnXEY5#`aV zyQAyZwQH~7dHMvgT|_dvm2)-&hHx-uL=24t+w@O#B;!9ILZXX3-~XvS4gzMuWd{&;85iz?N64(7J22i%nOT=mTt-0=4!1$w$lIyW(l>K zRUY9}T7IfhR}4=LbvS#KK1j1k_lnF|JXiJdfTNzd{k2dSFlO3yB<1HG%Nx7OgMhZh zF2j`~l;-e0J&EWm#4Sv!^-MkwgEXwZ<(sI)#Xk_x8M{(t;92+%^#tJJC;hOe$%qUp zU6}3x&waYv_X$@w;`~g)NV^dLu&%lJ;PU~gJ%Nmueo+cA2K$s`*3O@Vp*ch{Cz?wb zu$#McXVXbrAfwrJI7KSD5dLUn-<%9H`nv^w4dfezKtx0Vl0>D+Ww-9-=3x)(RO|Cj zl^@N1Og6vyyDo|943wOhXb=|LCgGO!WUFa0+c-`#ywx4E@Ab3GIb|FGjQP*$M2PM| zPPf)){P(93L;`{{i)+qEnG}`Z{a#1~KK_(0vw0*V^hLubeldPl1Z0Hb*GzeXt59rY z8&&}^A4Q|oGu|z-J)I2(K?xHx4TaSM{lm|ZDskYH*D(nO4mZE_9ouM84 zIt&J=n4qoWioDTpJ!QKLtA{qwBTBpA@-clc2&x7dS2V1$aPnuw$E{Vr`9>>ino&snrAgH3M z<7&zqz;jELWU6YC--8s2?o@@2?v{eQ;P0Pwaq~(I8r9_yVBele=4Pj8V?;D^aJ7~H zfn}4<_egVP4^I(nZ$a6+iYf7P#RDJ8W-!! zIcXyom*HepW5(1vH@`p-mI-v=6lRp+@MB}t=!A$fzg8wu9kiE|3zB05aAz38B| zBeTQ*exGratUgqnp`XLzAdV;qJM7}0ow66Od!Yyx>|qA`YMj2Vd))vYzk3)DvZ|Xx z?&$8=wQV_$!X4kYu?LC zW(j_}iba1H))hlXZMP*P_b{ZL-M!S`QefqbnS%SIs;>R}xH*^PgjLy|9i0Y%H;572 zKb2`(Hj44QS=|xh=RgbJ=l!#OQh4F^?iQ>Nm$ZE7aH) zdKs4kgV%5s+!>NgZCQJ_Na7v$FVWT<6KV_ChpZcrAT zPPc<^C|O^?_2-iFhO>8sMJa_fQ6@uE@t??6n@^#GuvTB3%P}ztd`pd;>SC_RO?08qp2^Z8R{LZ1NZ%MqkrYT(Y?Xd<7J;5by}%BnAOOCF#XO6yYg2cGlNT zG1nR<3oJ^;4ThB|*>m?_Qpt3_{>n5D+i;>lY+XAcq39wfq*KM)-9NS09oLNh8CqHW zGeYm5wkpnU%LauE(1etSo3{|t((8vcLmy{P+kf5SJvNQN>PkekN<#Fwz^LKrK-;I3 zf?)$fIL7r_cM=s8j~6I3w5M5A;ty-DyR}!hl59i75=tO~+;oSl*mtDW zvhK!FYngOeQ_W275faVmkr<@Z{BcJItM23(t0{u_<2YNMMp8HcTrl+|AioiFN7pe( z@*HFN`gdZGVM0AyX#r)E53(%$^_7^dAYnt*X(w8c+d{S~(`zMYQPD2qNFWvIWemT> zxrrBC8b^r_9yla61(%$l%2vhDN53%CnCGUmg#Gn+{z3>$+SUdVp2Jg{{WFnWl4MXB z>Cq2`eo?T;J)o?WC3oFw2R;gjTH}|>#xQ1G^tplk_D1j|S|Y)qN<>@XM(Pbe6q*ZC ze~CT}iFZiA&u2T3hE53vrnsoL%{-WkPq8$Q{0=Kx@FVNp&-x~{Oynuwpt-tMb{+PU z6OF~_(CEAtGs6ww7^s;_Y^XlHvOWT5E)^Bt%YqzQ;a}qTj2x9TcLRxP=oKXJ<(9Mw zL##H%8(R@ab;ehIumo*(rHJ>*062edH6^#!Q3WVugobwV&NT-%%|A;r+@%=e++>kN zhnf2Cr1+?!#S%(yexmcM0^@J{N@eg`I_!dQ7eR|U=Dbw6aL-ULxj>6L z*;e{k>o$a-%fYqYHD35UodWpWkA^TY=y4R9sthS%izSW!@q%n zncA&RA85NPpw=B5J5mt`D7?*CoKlXwuZg$fjKk#kG zi{=Lc8BGc6Du)f7r$JMf0vClHMU3{|Eg0xO7P+)Fo)j#E(MU;Y6&0Zh`b0sbf*?ku zpuo;Gx3B%&UvIyxa4x|4KiZ(>@0eXh^4?T&?fSd(J|5s5lRAPfZy-MkaYt5aP0~4C z_(|xOAP$@Cv%=S@ee{MytV-Mzzi@b+;MS%<@um(#Yz3DFYaC+BN~{3JegFq`Qjz=G zPIJa=$Pd$kJHS1T!w5+f%n%+NMgeRd)@WgW zoH^cGlXmbZy|X}PLk-3QpCykO=UWm!!9eS{hUS z4rPfsiQ5Rdl!MK%GL23$NrifO$kd1(%~Y5z&V7=RsFtr{El5j+ZX)DfpvSInmzw%} z_L)Bwa@Woa>)8K`s}2+hZ~=iKW&``V?xxQv7X=boWs2kbWQT8x$aaTZYA|R4 z9Bdy(RMdYd8`BSmi?R!=o9z3GVX8u&LeAvryii;AOF}YHp&@AY+~yg_`ix|Ip{{Qg zh=A4KAAzC*-g;3vr)ftrfkghvv&Yk1#8Re`<7TPXE#;x-bFB>w{>BI&v@&3PYqEx| z!Uy9pXlPj2)dYyaJUP-0TWbt}5o1nz&Q3qri_vYO?bBo5S{}(=_@FDPn~|sY+B`n}x?Q`=PK0gc`@Q-g zormpW7WL%GwD zpUpU;lWE#K_p7IyIYiGdcY4Bdbvsb%^Ub99gO)n@6<>KZ)i7Y7eq8c%Gvn>H&_MQS zq<$%FCCE<(5S%X-7J2@4vSy6+aiVW-O}vMAovuj!4@bZU{pOh|sGzZLgzgv%pA^xyqJ<{U1TUZN zSD?Z-DE^fL{eLZO|0n(uGZ)u?@Rx?Q?EdLJP`+kr>p~!qco^T0o3TlXf?LX9F#kgR zQ*76r*fLdj~vcCQb0AsFvAVrGJkp-t~`kfVaBTTzJe0$ zd6`D^w{-6;;V>cm)^+#cd@s@>WBU^|D8B-qG2C7J24po(GupM&qy$e5kx4?o_H1r- zNB`-x16m*LQ=;|byC;rV#BFYibH_92?2(R3S~3j6BxSxtuZYavJ>qluI9L1myky@0 z1_3($X9oQ5-CosjzTq$6CLe^7q#|eOKVWXhSjf`(f}y!1=*)1_exwWg z5F%hWaZ`QO{#+I&M`L-2npsX0OF~SVj1eum{Pe)yAB0JpgZZUGDFI@HZ^Q!Pd_)xl zchy?Ma|MF@16C}Qj;P3ayQ-7^6mjxl3g4F}`6H0!m?WGz8Y1-JQ-u$`BH54cZ!6kM}5)T6Ps=U0#2|us5SvWj1FLjzmtQd`j`;#xa zvFw=XGbBf1%x)L~)M<&T?rzeEfGN~+TwT^^vp;r-6e;z1=$&ZvzZM1LIb>PYip}$G zP1-;0$QIGMb}b2C5%Dg^XLL`lfZR;G_h{!kp-8HCV^!JdnYaM2DS^ z7&0DE<_wzDAGnuzQMv)B)3af;@cqdmrVSLl;x_)$fCUUd?TCj#=pTjpfUF38y5*Cd z9$)WIQ?Jj@Sp@5DEvLZU zR;3OBX{M;TpniyiSrPV_q&zG)|E<~!90Vz@5o>q1<(tVf5ssWdWw+oO{qZit^fC~?Rcs&aT*QzlC6 zoc6z&|!xa}uyqVnT7Ah0MTy# z-bITWzO$5dIW||}I!9@+N2eU-)Vr|wmuGiu3}??ibJozn73;lu)-l_nY1`}MZ<$YG z1zXvi>oA?UYqc@SYSd}o9}CeZ37PbU*$*GBOYhQ{%REPh*~;toG43gtRX>@2nIaIK zq;PogaJ_dn?C``+Jg{1|DP?5aa@e6G-uth5_Qp(`eX;r2=IY&sRKg!~=)#V9}mjZt-Yd-RX{F%4{TVT-Gc~F>_=i_lrEDU z%3riAsuV&meG>JCldtuL^!rcfJU{?-Hz*>74t#BrbeZGyV4{&Yw&-lz<$_oU14a#D zeU)#ZMp8WmH2 zz-v?NqlxPq>`RJo6_HfK=vVyV8Os~6u@}_PYA*A?UeNy&afpST?LRi1mb9h*Y>Z*{ zoM^znpeP2L%UwmeWRRH{1_=kGTaiJxBHNZP8iy6ElbLlUe!O@!J0?b1k4qv2B1XyF zE$Q^Mrf3kUn}+ToYf;1fzO#1G{5m@;^5kjo%^?vdW++*=+<7h-ZTi_M4ilV zTx2n)C_R~HyUaA^+SP{wZf?Fi_QiQ85V-&y6S{)(^g96J6)1NDy?c*pmYd@px zIOSe9lSkjCGhZ-sor5&Em2Pn#CXt70ZT>Zg944RIPdRKV8vXpKIHsAAImK0MJI0pV z6@y5mEe{(gmqv<>JCc-&nqp}=h1kUZz>%>G*qc{qQ!+&v=uq&X!qW<&=S&S7EHh%xyP#2W&xcSnJkFXCU#1 z?pJMWI5MXhn7zMDL>(|jwLl_*;c%G!U9uATE}^VmkwhL&va=ZMRu3 ze{<Q}Thr)mf=Z2d{FdBNdJ2%M=jzKola}9X>;BHP0 zM20eHg(ri&&aSqRmpVl=^im8NEcz>R3?(Wpg4G>=n$DR}*`*Zdw?qYL`zLT>IjquD zaTku7VWHxDZ!n(387jB$$6b}xCy$NvPb0C-qd(U_Q)US5Tw&kTH_XwV<_N6)!YgDz$pBvB1o0tdu7k>zZr+kne)cfWJ|d2 zKo@nxS4`h(_l%@38Debs2H7yAc4c>O65dE@DOf$y1vy)qrzKM51+OM&g4{Vcx_&>q z+i7CK4?dS$vfYH@cbk$XqlkM0KlV<2Dhs4vy8@Cbp@NrZOBozGBW{R9W*P*3U+ET~ zM#VzW1b#s}F$!QUjfY7Hw7;HYsw|`sT`96p$w{)YP@tY2hk~2Z3&gmNj{b&P*W*#Z ziNHw*bi!*Zw1m$=ptvXB=VdD$H{4TcDH0A3M(KOqo=P7bVJPP5!37-8h|THE<)t0g zGO~H9YYhR>*?zC^Wh1rdvnIINg)fPBBgTDpidG%`rsExQK9#4THiCdRQPbgh7`nsgVcF2$QFA+E0JH^&PHANtiZj029xopkJ}_8AIGZHO!D`1in=rIWDxxQFD|kg8}+-4!WPb9`oxCBNz}8;z-=FfQ({^BOeLPi_2=O4&CS0n2gQiE z&`+D08r5SRWo{F_Tm#w@LJR|!NUhR9U66c62B!!bH18Rn8wrv}uHG!}`1qWpP1qSH z{hit=Yh(czsilPmxwv+wE><99Ivu$`vk1B0ivRK=edQ#U=5045kVC3l@jW9Ci35Jp_i+D0ByVH&T-u?r%&8yt z^msXB*(;?^iUJJxwd*25A`{rIZ>qD!V8{h7Ct%$u>G9e=+w47fr zE37Vc;)qk1^2wR*Mn|)QBzz8$DmEuc9HT1Dh^bCWZ4qAZEvJzb<{geD6eYqNl$AI! zpW=3cqchX~Pk|6jc%TZ;rc$tLiU<*n?Lv#mtAo^jesE&ghOoqhHgkjh_FGzwjlqRIyy{C%;iB8+^*G*` zv9HSc2wfBUG#3@B^6e|l?=jYI16JHa`jB>F3?z4hh+Nh03WTdml%Iv>JXcAYUFhF)EF#cSIrzir)811R;A8m#!=_(>26ouRi4;*yBCHEnIt~|(9 z5a)is3Tznmti7IVCLS02<6vH0Yz35#{$Z}Y{(PZ^<+rD^0WD75gM37|W%7JC=ibTX zC8JAnFPJPtJ;_4tiMziAZd=sJQAYOpV9whefd(rO!_)q6TMmC3vAO?S<;eX%v8h;9veAb6z1=nLa!G7kaMbIqPO`I^zhY31_dSHYu_5k#j?rA$)J)w8m* ztw#qE&tl5EAkT*i5)?Ho;QyZY+;5@}@tv0H^b*x&ec|VEl>Obuj}s@rFUy@Mr> zd*s|J^7ti^6MkgZ?EsZ=WQi`>|6%N$+AD#!Z5!LRom6bwSg~!asA8*PClx!X*tTuk zwkyW1bDz%nzWuO&#q4wRFp-_?x}B96PrRKLV?PWd zY5=cR0ZzO9_>%x^W0@`w!C4;IoScaj_rf#!&o=S=-H2rqritHjaC#xyiDwG*YI?^D z+Wih4b6HDBe`TN8E2O*-&H+EIwaS|)XRC~jb!#+Yh}>GY4$e&KRK(}L$0K79iGld0t?VI{K8-Ou+h z*7Qz)nD(SH@>aqW_QT*`1!C%GF+5b%TRSEbUHTNyP(Z`)#Z|D4y#%UCDEY0^h9xi2 zXgT z3$|MpcUMJXpFNRPz`aqdJZsQ@LO{wqc~yll65srrq3@e5-^THQ@VD81Jcr7)VrroG2e|bOa3gDB0lg}(U=}scIbelpLkp<;u;+~NUMoO*^VpuzKF6G z6ja8O^XBu9m?`6t(2=NkskJ12Xb`PIHuM59WVGA_MVy!9{K_H>go8fw@u~&QNaj7e zV$z*!*k93be}$R&rn4O zpILZ0^X!RV>qJwV=g$tkNDAWZxa7V6xEeb*tS0Z4VF&8lKs&?UcIpe>9#fw+2$wx5=;<`S#)ru1q=de z|IKdaqgbwQq4V$qgc5Z*mTv!;p5fn(DfcD~bTN5AQag^ncOK@UDl{!vhPEooTUb+MpSp_F7?QfArXAr+ zNRC+ES8PM{jR*YZig{>YtoewinsN00A0cbaNhMb8$m4#aYLuQ|^Ya ziEiKX4fz#4m|f%_Eig*7PTLj0rFJ0l^qddzLUkxEGlm?Ku%I~pjLxIIT>{n+HBu*? zzy3OTM@rkrFd8_Bj z5u3NfXCyXCxBY?idQx5bhMsM>I`w%u_0#8dKZk%Wi zVFtfQPLb@yx!smVrMJw-d22DT&Oy;@?b*}Rcq2(2%~;85Eaq2HJTJR=>GeEh>U(pu zGmr7{LhW7eCnA|Z>q_h3LiT=BC`9Ls)L(z(1jE6zd@C%e-`-{&dejM^0B#PiH5yay z#sp@HJr^PA&pi7ue!aetq<3Dy^gwN@x0A4vTOPETQT&F7&S2r`S&?oJpo@2n-O;1ObSwUV&T=b+#>obfQIot?u7L zBVJR6;$=ZH*(ksI)QrjM5+>XVUkNYcesPiF^{toK%Rar4`@k&D@c}i8Z+!U=p};*j zQe;LA$DSfkh-V$t!Mz_|@eLD@-7_(;wj*kPgeBAi6<&ICqY&-|QU>-=2h-Gk2}wU| z1?~i(b+C>-#qu6Gr5VZLJ`V-uWuVXC&0^LpV>_Dog7zE@%KQEU2qpU6Mn$k9WKAZA zF$X4(+$5pJ1?#f^`hY6PVTd%1&1TNf&!&rzIFa4Lq3n)mX{C4LsWZ6P4Eu% z?v-`xf#wY6EU%gy6Rp)CKT;|%FNO4hD>lZWJ1)_DBlw!!u*ZPHtKi&XVAA0fc{w)f z^Zrrp>xG}s;*2EYz>^S!E#ue}Z@faum&3l1z{!jUh4HO=Yl%^1H+oiPy&@H3l`?EL zGExXFK3~8x!`pbX5Hn;nrlSgv^0r86C?GuVfa=tmC$hESp37A*3Q?4N&q%z4!g5Vh znc4D!69?m%=eH8@vbJAXSKvV=s24Ef%2&Sc==s1-0&V5|k1_GTqpERp{+|YLN=Gi~ zUrhWrU_4EB)T2uAK%XA#(AEUn<0~DpJ_VASNJi7DP|*shydNwe24L_&ab(claGPsJ zfQ!Uj*WiC19v_6-v%W}iW%Pa9HEcQfb#H$>h61f5&7|{yL|_6s7pCmw=7Bsrhb0RYM!Xj32s^#A|t5z>id8C5dETaMGkh7%Ox1 zHtd<8Y1!yY5!R17JgKQM_(dGWBeq8M2hVS6tH$6_Y%WCtS zBda7Dk%ZzvEH=qbw@oB()jAE&P=wl}vln3=8%9f0j7n0X)l{zJj~`e1PL*L8BuPM) zB6na5(|*6I1x(T_I&$leH%vE7RQasJ6u1=hLJ_$vfQ+U1`@!DqT6Y}Ua-=lf4624W zt$?#9O|zyvHF0&3Y~(w4jcBmb5q6Rb|GJW<3Y7#QwgC#2q<%uFxvChfonku0uwlAk zkKL7VsZK48!>U8Yp4P6Ye?%a;CW}E@keJlo+d0wbvm-ug?6CiOwJqQG>NX^rvtmDt z3DsR#O&GllI{ra8Y{5~f%SN)bcUUpCO$S&!oZV^Hpsof1~Ar`DD;iI*?x*@y_F*&-_X73tO7zXMW=Z z(YIx&doa(ksP@CQi`!o#u(gCH@;@aXDXc8-G*+RmJRL(ts#T^u?vLp#BUDMVfIS%R zVnAilbWhj>^zS1IVus&W>f`r=PhT^|gdaITcTfhdNJ7>)I>H}y!0@H!y2u$wB&}-GD&5~UAB_nS~*Ew%V9%`>a=p$oEij9J5mZ1HAX8TnMM0GUM zVU(>`-MC_}%eV7?YkwAr0JePuR4&O>bMce=$-fG1;=y+F#pQ*8ywt30@L_~eR34pj z!YS3GKS+^YU;*}Xo9>L+y9{lATfoT7SI;Ifi2J#o)fYfcTd6h`MsD`GvSr}Dv<+RB z(y7voqS8PupfV0lEuH(B9eXu2S__nbK5EDSF6@uh~inCD|7rd;T|eZTJdbiJE8 zo0g@nR$O-!?{tRto0Lr5=i*^J2duzHiW^5IOeb(Sc1bgPD@+CvC}hd4xE#xRt90H; zU0-LbPq%~1DLk6NizMp6|4mS$V=rb-+;UhUrwxW_KtmStXQK0ecEG=o@K*Ih!`7To<0jBo8lVV>`{IDVD#yqkh^n@9ODx}9#wGT_0H82hmf;kwTQxA@2<7#?4Hba zT&(-9BNIXtjDQq5np)ZC^xNWz+E9`HK!rEuA&2rfEA#1w+4MowqiJD%i+0aCwh6Si zzOX^2RZm}57wSartOi5K=bPy%`N4lqv-Zss89(yOS>;3LaPwo^*^q};))^+fVbBv% zBXq6gO9Y#kt&h7r%TY2nik_K4z~=P$Y6bA->v_XnR55D}C-V|lKMDhDm&>0^NoI8r znmOz20{8g`SUWVYGz|0GwD=zS=%SrNaVqj;ER;yJU0(FTF2O(O!CYMQP?I6zg?UoJ z-1*^n+|kHBYAX0Skil?9*)+sN9SozyUb~ab7v(!o5Y<@>=Nai_OI-~{gaV`EtPx0ch347%O~K`}-Qm5pMf?o- z9>^x}GK7BFM;HF)GBH?`^0qk`a~;*3D;x|*-4}}V&=yz$0c#?(OHM-xkp9XOYRmf_ z1mE|g`+jnT1NFk&GDL|mPDq39pzTDgebsynU22o|w}K60RmD~)Cmq~ShujoJR3@8V z9HsZE|2rO&!M+V*Z>%q=5V`Q2tbgmt4=OXoXckM-L&vFK8d2w;^Nes--skcB1y|l1 zTL1Pk-)ge&{GtHO)!+bcSB|;E`GEG*XVBZ~Qtu9vZuS++Jrg4?(K|@J2EI|Eq8<7B ziCgVI31Z8fHjWJMBUm@!CRu2bYh1org6j>C3&+mOWxBW^y@K3MdxPJ`??6qS8ISIx z?=)`%3k%%2hiPNAsQ3Xq&$18{_%kaOt%yNy!w@>B>4*_23)POx(}wKw;ptzGRd~hf z^Q%n3{&;fIHz%9b`;7e696M!)gUo)~a*Wh#A)7mIbu%=Z%vL$xxB_b1`dMuy9PL2uLx8X!gBEf@IOe??x+03L^`4y7F4=CJ6;7i zbAQDQ)AYydWt>_ldB`ByYC{-Hh!&RQ8E<%det6iAS5ac=6ZJ%omfGG_UB=cD?nX*KfXoKRnT)1_e`=d4%2?8BR7@Z*!nS!T@WbyO9xH)-V>q}TE;`XO4PO*pkowAD}#Znz>7#~-p_Lc2BP zvG=BNTO~WswP~u?+Jc_lF*Gp;!IZYc^ zsv(3V1af24s;_iX6C3|()k#YS?3j8;^q*)=)MNV&J|N9XjpTi7nq%@)b_q2Qb?ik@ zX*UGCxtw-eay0qZxKY6tS$M=B%&j)7uoTg>2f#H6S8cT4zsw3~7$Y7BT8*O_$o8*t@7L`%$3(;)K zJ5h#*{j2{HPFB)EBkyfVNJlc;_F{Wu{XS)&X>*q;d}UK3^s>ewxxDdzB|cS}p!tuX z`@cgEvUB{OTkj=p?YIqYG{1i`;5=eUBprggS&sMQwQO9oI+$ANnFVfSoAfQL^%Mdb z#r3gA{~bE4vH^wXz_qoZg5dalWd^K^m-5b+#@#5GuNN}RTPB_4j-fcss2hJQc%nM~ z@z?!xi@pZPR0hqpeVb3+cQMi<1G`EA(jc4NRA7ZrTfJNK$kNYpp^N*^v zs|>t%x);l(E9=LbDOQYs1)p2HK_vSr;?j-(zZMC?@?b8Xk5Y|iqLtP1)5Y-eNq6h> zHh7DyWK(v?B!N*hr(RsP!5Fi#T`SDCtIAEiW@WGW{LLH(9#gMUBW3hsJh4HI;>nq~ z>!fy6->*sB#HqIoby3;|gAijubD!@=6wb`cnDLm41daHh8RM=_&=J4Wh}R1m*mX98 zD3zI=gMUtq$F402=K(`9tQ@*|QTqMn?7QRY0D6BEM|NmQw7H{RB!v~y3uzG3OBy7< zHC8~WFTs6yL&(TeH}=kDhD&oO8zy~65eZRE8SPAGyZoj%^RN%Q2y3ZE<8eitEJ9q) z8YHry=OKgQR#12TMxniO&8eLnqBZVQ20mZimWrjJ8jvgZf=eUAt0G&*B_+(m4e`|S zjsy=mmBsPQ<#}F;%(%@3qxutrEJr|sRE^A(CnMdA|JcI#m7mh|^_Jft<5p0%H0e1V zRaKtSNAa@Qx~y=Fp1DS$R($gJ%l<~rlBP{$nE7ZSH*4JbTHSPP)vkk*X>QgS zGPxmf493A|iIlCNfX;&}4v%RhK{8X43%oI-Q&U+0S3)p0WH4K{?SUGHZ)K)VhcTdp z{AmG%khz++BGXiTXFdollYbS{d?SRidK&|%{M7zO!L}>1wY;L+=2C{nBbQY2Hd4mV zX7lGwxfb4^>1a-gn^nr;%WSX1efYP8P>)ltUVAA;;v79@#>y{T(Wfyp#$dQYh3d*K zk+5iZ-rX;ELRVyOzLi-jy@Ll0r}6zhOo10ye$2Dd6uNOc42W}cRd-)+n)mAv^aHT0 z=5o(}qVU}VczwYc3N3a=nJ?{@Tgi^;ar!tdh+#Gkt$j#4=$&ScX*j{Rf)3LeaScmJ zdO&ohm_qU6`%nu?+tSsIV%gq#`>J*iBA&TxXIB%i{nke^Erqsylm;K(5^$@v1|2U& z)_5wCrh?v7nm2Bew7l?_Gm6i9cmTb* z)Xdqps5wooP^QXT%?gKWT&lxQy9sHq!6?H)ciz4CaXN0tG7~2<^}{EEB;@Pg_McG* z-{9zM=&l8%KPxJ#R(|G%?So75ht+yOh2qXkp8GE7POxv!q0=9Xw#_`{`MUgqs5t^b z4TUXQ26frc@bX3Dm73w=BM%NJgyL$9<{89%so`(b|EnG5T|*yDy4cPa9D{V4qn#bJ zQEcM2=6?FMu*n<&tdiSumGCZ_iIF_O);1&Hh~3o4O`wP^#%MFTrx5OAZQ1nT(PKrn z6-yF2{d>Ikr?1WKOMR(b+uM1gx0Y=HU(V zQ$~CW>*gxOUeO*1GSaYVSxh@nSU8`n^rMyAo?1fnnNpjN8mLsKQ$> zz8215Ul_QX=7Xn&Z|^M+9%8H}fmVBzt;|bMaY^9VUU3da-t}sCO{3@XGDXXKFqpp} zekix(&^fIkq853ec>=G8s17lyaa(D!!Li7ge6 z_{-0N9%O6X*k#XymnjNb@&bb66CXs^UnayvdGLi6mw^a(R+5PQ%Iv#I<8hA|?$0lX zlrMMll-DimQmlax-lar2M@rp6JteD|^YzjCZ!r0l3y(b2Uj$`qtRda-+5S|x;|;9h zx0#v2*x^7=LjdbSV_4Uogc;M1U72U;m?xQ;r7#G>Nq=(Lh}la zd46rFf1o}qJ-0dorgf2`GY)p`Fs8Omc zv=lG_62D_s9OpP<((;%R?-6DChm(7K=>p9JoFs56p&l~dbYjJs3r%KYQ?Ee z80^_xrvcJ!II7S?54$VZAg8ZZ>8HRA<&I_jB@=0vA#&JL2Pok1+f&v8MmwVn%aOF< z9c6kNem_W^jOBRU6x6K3=8j{AtPOx2yJ*)Hhgf3GjVAp`{ zRrY0k?G~O)SUorkwf+GH&DT!E9Y%0o>ISMM*|d*0=!tomP=+hYJLA-Dla8L<1bmxY zs00~|2pFPdi3xTf%=)o!v7kH=f`~}~!Tl~$$S;g_!RiuF+ZS*kJfQm0-H%UWM7SW{ znG)1QMK9#y7L}l2Vt^S1hva`SQZya1!iPr<7EHeH^W=n|Hi7EXx%q8Mn~}l ztg#!%<}BfWk4Ls?#qVG#mD}yT2>K zPqgH?q2JQ~)O-VLPw}4~sh_v877*ky9Ano{xU_8j@yF(FE${K)k7|Tc3l4C@T8e8I z3Vl2?-@tOh&JU00xM=i1iX@U{#g)X?7NJgZ4LGQL4GUCDOufQHN3K*>@q|qb(fLm3 zz@hFNq#@=f*LRo;+5~@(mN^EYrj5Gm^*9mcO!}yXAe#8etU-sO7sK$OCuYgysJt7K z?S2FVj1&s__ijEN%yKG9WtbxIENjl7!>w*+-y2C^r%eo5nRn0)TeF?IXyVk|Qwt??2jTcH};4W^6Ht#wMZ9d$l+V zZXJP&s!#t#IfINeGKHe|sZT0vwOEMNM&V>wt}5@BC2bSFZZJ(az!=cKv~&-Hn5X0(n-{>r@?zUyh;VkLGU#K~Go8@5uTiuVKDbZe?nJfy;CLa02MCNdWh zt6caD2aJZYC?2OSF<66gKcsS4R2tV;W?9vLf7XGPqZA#Bw(r3w~~??DgysCx!d=t@ND_N6XN+ zx~k!7;zT)?SV!F8!VPNd!qTG0=B%O<02Wzj{o9U?ptQ;lhl)f0{0<9vFUOsXY?1LK1jB_wwr*nH zVhdL%t6W5Uk+KI9mW(Gu1-W@JT|%}vnYuOl{91~&78Fb`!mXSznR~MY1`qT0p`%-V zN|P{E5Z;1dBEr}W{8)tqYp=(FHZo5|u`6`BUReIAb>~ z1{Z8!fC;SFz3Pq$Nnf}q2qgmJH+%?eeRXRX_(81JLfVs)kE}gTd*E0U$mfc9J&(_p z9(ZCWdbr?kIuxaz!k$dyjg{DYrOU+P)jtkqU*-#a#bIpK&b)jB#3D@ZK$i$`L$99@ zAds?h=7JiGiJRUnx+i63ec&JHX5!hXfqd_PFjiUPK0WyNsG5)mbC2h%3Hdm}r6+tlzJCM|d0!eWL z?Ge;n+IO?EkjT7(zrd(;HDn`O(TS4rw@jnePWs=)fA3q=7g_-UPT1R3tpqdH5?e${ z02gkoWlT#Lfg<*Vcp%;INAm-y)>4(F>EN*+7mg4?d9Vxp0%|c_l9C8zvuIu3rDME+5;+LcmYZ4wf%?HIlKc*&=2Y9ZTV5 zD5HRngKvh^jWF^^g1lhO+zKPP#+dw&(7eUf1)FGOfwE$F%;rWR zbYz8W)TI@Iu$wyNVZ9Jr+Q=1CtDHxIbq%evtx6O2s-H!iq7@h^RA0K1-d&1>Ez29d z`X?pJZ;#tno3>W3&1_L|#77T!L2>%YuQhh+S?F=`3N4ipc_CvLXecz%4w;xWBO89R zWGO#z=Y`(GKOjP4XaS7)QCYzs0**}TjOEq+JLnNANpQ_d?iY9wtvXkOPB_u$71}|W z!;GIvuT#L6A(2th{W$UKudY`kC%Q&H>~s0li~MSC74*yMEZ*6(&Pynhn59mW)O82I z+2}v|Q+OX+#!-v6yoXTqnRsY8<<4Roi^AAzCs*YLTa)Y&zJy+CsuWor=@Dg{s4i$a z>|kem(OUH#1CUI1MmueMW4dbzDGt~}HdR8yVM6vei?$c~IC zcu1=8kDafz^1$)ghS@{1{=CsBrDDpLo)9uT`g<8aa{YDEWyr`oJoh_s+BWsBvh;eP zdLUqN#t;Q1?^jgNaji1^2`qkz2PSVG*6A6^5xl`QDPp0$lu>GOelqe)&( z=O6e&^!0VMb~1E?Aw!E2Mw&AnIll0iD);1M82G!?E5^^J;fw!nwg#kIG61Ie!e2FeW+o1{?>~#GZmSx5;qik@; zcxG{(rtw+tHDx?^({5x1U+WD0_XhO8V$Pvkj$Vp{lfk1)t?m6I2K%$n@V?|-0ia1K zAem3ry8<5vROke8SpnQ!+#R-lIZnI=nAY-U!LJ5_EApK(_8^oT)Rj#!eqr+b%Dn=( z!^;coK9$ z{Wk92T4^FWTCyzNyN1!$TqL~ds&jo z7`S6(IOKRui`y3tzu_z@XU zw=py-B#isj8h^8Fh7eSY9QwA=SW@p)ywzc!x+`?GRpzZ$s6iu#TH5)AyZ&+Y_fGx1 zZ}|o-7qHX+j~VR0;t;d&aQ~kv+tB|I6~!_9{#Dz`76s-v*dB0y%#G5J8bOIN1Zk!@ zu~rik4nvtgJf^Q@>kq5#!cv%BY8%%k+Wb!VDh}g9C~&^WBMNSjsV5Zf|Ek{)!DpaE zBXCl*d8MLcql6-?j4fSdE=sq1c>neNXZDa~(YlgkGVK1cPhc6I@9acG-s%3};pea5 z%q(}A;s4CHYBqk%v`J9TW^~8bWh|A|?YY2a3g<%@Si3&06rwzUvhM%XW~x}`H1u1W z$_ZSjqRQ?7#FSQFX7>F6$1qxKRd1hih>O0f_{V5;MNrr7q04v(wu-x2ftI3kk z3rGyN*ZF&WniEapXp^?y=&HOe;Z7kfN056MtcG4!(zK6+ z+*{7UwxtJX_qlEHOb@8KD~o6P^tfaoPslSPrmRDuf+928!DW;G<>K*W^Z zmnteJ2=Z0ktO8pNfCusEE%Lq`OWO~J-FgLHa&jW2$FIBG_+kVzUiQK(KZCuuN)=(H zgD8REZ8g76ty@fVI&IJ=bhqg-0vFW&ZrC$n1vdrwLtmI`4TCUvX9vr5VGq>X|H{&m zAp^;PP{w);eT?Qo%L|{Nz%K^U5yvTqS%lzG@FTz!xzrB0uCG4nGoQKQEnqrEUl5H< ztEp!LT=7sGK`5xN|322+iE^|z1@ABLierdH!iS^6lA^h^Ro?jAIhUT!D&JMV1Pb|U zHApUe&R#<4<}g|dRnia$*>f@(HQ2fr0fkg}v3okX0XQV#Y2 zP%!_$z=;G9z~EKcNDb@(wv6KUInO`=IyiSJg`Xe z#fL8wmL~vwx2%ac^CPPd3sb&q5S3X()K^&z>3Rl#x0DNy9Z? z+5TI$I3+)ATuD)=USaG;=ELRHw<Wt!9QNWiRGNY0OD%t3g}IMmm|PO1dfOR*Xe(EG3aS;6bB%yJj;q%?mdA(PWP;bl~;V1 z+=Z<{Hxj{->)f>uxvPO_P5IV(ett@C;7vaxUTrNxPjhtzFaPu+Wq_cu*GLQUh7)xk zGT90OM9E*Ri!4Y&Z7jtI7r*Uo@SP7E%`!a~`L~&apX=fWU<7(&I=$znD;8BM zW^!;h@1I<{Lpeh^3jT{iFA)!hmDzoiPGFHIS0VMH81G(s`ee@E@DZb5EW($KU6E*0 zc$&v?VKx)F?n{RGi=_z~q9c5WEFT6r>+Jy;w}i|5(g{C4W63DEI{RWUC=LNz=E+LN zdM85yhcw3=GNlihW#8oKJ@M1T3-|6bb+8WMy&Cw^lNRc>`>i5AU% zao2qidh?>;I^~y_;I1TCRajVT#6a#7L#(y);C=5w%!?J)bA*f@`}Ch=CCM#}d0DBf zd1bC=KDTk<`Hv9idE1yCRDyVR{~P`bT&sksg8&1 zy=x$c$_?PAXkF8_MYU7gDG3F%yG~!#lh`w+EhzI_Cv#)eP;Q6l;FOPrHHAoYb!y=< z0%e0=7V5;CmG&LFOW4?hVk01W=XEP(?#+$c z8n5jy^m>0S^YfAQeVL7Md+z!J27-Zte-V$M&xz)_DilaivwMsOWu!M6SmrfXItn2H{6wodZ+ra(oKjovYb_3mb5cXsm6H+R)vRWoL$ zYy3jaV|nHX?ON)p*_r_b=3yxG!IR!Z!Cu@sw4yU7i>W)L?76W>62~&T6)NADl8TGhhXsZ!y!6Y%> z=we#53X?v`MTReG5*@h;StTOEKXhbPyloES`PMT7!;B^Mpz5Mi@XsOF{RsGd+*k}u z>_Kn8Ut0)4!maAn>fP2+Rv-Wd)B^-40_6^H3* zi^OL$>g1A9X0~`ESrZ>SVSEmhKU>fLvUO}94E7&qwIXV7!N|;3mNs#MNmfoObC^M> zZ`q7yiPRqxZmI53xC3Xr8^=+_(?+5TuG@$3qo=9y^N}UU)G{(8SLP__Y&MZF2qQ#q zAAZGV?KN2X+M0$1cVk7O$+{yti2Q@m;xHq*d>PUK)NHGZ*DjBFaRBR%o@cfmry#pf zl4KPpi> ztP&B-IHmYezREmT9iqlV-B#XiXDa>>hCkl04b1yA5QEN(lk=B}L-R>q4)V-<2&efU zvDjlg*AODxrYC&IrW?}?<=_o@m_yBjURWn*je#jL)PL_3k!z92{-rojk{C?plGxOv zJyi`wLP(L&6;$)o9N7Z_qY!Su79wAS$nf=VKgbQj$tQG zV|t27tv&BFVjjRo%*#_(dF*u3pCd=#$(1vPV))ZOT^u;WQJgGYp6>&hXuZr@+EGbe zHm-nSoL3BRHZU#aTkRX{6G;t_1KariHIH=|8zK-y5)M{a?E3bvh_I3k%LcXfK(Kyc z*`6uITe2*VyLebkju+HIplKX^2F^)daEpmTx9G7J1q@pO+A8{_^@^Sw5Fi?8`zZ+; z*D&P1_nq|Bs8zr-OE77nK=FQgHI#E@u4nAdm0!>7I&xR~#7V-buB(ST(feRw^N^Xr z2xe}n*{nE|=@Mzb8DsK6iK~&$I9TLvgvpFVazqj6SUtO`x^ycSW)z#BV1H_WV@HqM zza4YAE|WYp{f+e1cN5t1Yk5F|i&oI_*-G895EbsDCrGsq5TYVA8XL4Ajs;<=`Dn1p zSl@#8)R9yud?^*{Ho_xBbKx$o_FAmcgwAsdJW0zZv5!G+`q-w?(# z9iBPCG!sDT*8oDJI!F|=$B4pXUo-l;2FU=2VWI4RLDs28%&@RfsAp)CG0xx4sa*PP zs}A=b^e_T+g>Ug5>F&H?iZZA?PH)poRHrNx=b-(>QH$#%8dd9xo;!HE3ss=`Xst*B zkBm&fN~^t3c%@uzR2JX>-uU*29Mpni#p1zios>rnH(MY3O{y^|ig(&$lrtX$p64wxzzJf{2~V!i5o_)}rv4xL9RH%! zSQ2VebHXGRwx;*?Zh|VM&y>Xi@LROu@2dmWx|baOsq_nX{SK1Vil66McIO0f0iBh! zRTWcNuRUNd3(C}h8bF8=nl3ZT|G{3)29oW#$JAcT(9P4b?!sI@f>gM`;{I*3$lCwj z3ADwIk79L~NXH$`uh*5@P_&81&}!`F0%{W-!^qa;VuKG)|^9%Z7{27kJv$AE{N1ORVdxc?`xPN zKC+CmjC1XaJDE$*k00X{LF9AltG6H7?}wBNVg;SBGyN0Mq^A0kUz0~sW%Eri#5tKW z%*l`w2?YBchx5~0Vl+g9Is+Klx30JJGeDloG-cGh%jpdqMLWC`sKLd2Z;LZ?A!yIexHoqqsbk z`Y3UgO+R>jbXWPO0q7q=_P_FGvln|geV6nuw2Q^W9QUQWYxZWle17CSB>WqHm-aHZn4$?=g-@w!8!ljrs6o~q@CF1hydHg{nr-P^8|&X zYrpH$&%|ty`2EMJK$*3h%O18?r|$C@ka0Bwd{Gqak)7}lbCVYj^(MZa5mw^HKwqjy zW(S|cw;$>)PlrRrtL=tuSvVEo$Rm4O`uCV{9djX+aj=?>f>4>VqcGv~W_&s(e%47J zDL%4-pL;u<77|(iF%tY&!UYyij{kEYIi>Z_C(eoDd!q@n`ah9?ep{UORBqlP3IiBm zveiB4IlJEYLoJ0fF`E6#&nJvaLT@4U#~Z+-uE5Ic_}1}wQhKfgMvB(Qkpkx9&zv)M zSGv>+7ezlU-8`7ogKNkGjH+5Ke@2bqKSa0%@rjT`2pR>%FT;wpl^chhDKuGYJx+SI zm%C2~i(B80jiwm9hL@A_9%% zy3dB1bo9f|WcFES$GySz2}XgAij|a=3IaOLzDWvPGpt3D;eZPdtb%ZqMWJ{!Uy&HUVM`X>J zM8y>PHGybaq29si&A;y*N6nX$3Tr?Hq!>hRmZC~V5}K(?n6;xVllZy*eIFP{*g#|)Cy0BHhPPoJuvSxT5X zA>sygzGUKLF5G{bPAHJ8g*;G9`|Gq5p_v<{^8&weTn%o*g?|>okBo!}#*CAz=|ZEQ zR=IEg-_&bgkTg!=f;1+fRZ5-@~nk6*G$)qfIPm)iF4c|J~*lbLXpA=PYgLr&0UG7O!e* zJk$@#)%8kIwcQfTpCr8a=!%j?A?I3DZcCne>!{*pIC(XjanYSh8bbpoUI+iA{~BiB zuIHN_$Q#3jzbDcaQhb@PKLUQGbU7ls>Lz;xJ@mbx?ircrd<)%IOD zZEzOt&|tDciWkybyQ*h3L={-1u6-JgHseej{jz9EY=bAFB|v8;?oJR3krC@=kYTqf z-!p{%aXx{})etnOF(w$g4*ShaJxt_uRe?*DWbvLBU-k)u?YYyeSOoqQpvF+o2KfUX zgWW19ZHNAqJN>#l$!Se(u?<8Wh_$B^u~PB1qtJS0%G=Lq6D!?%_Q%etSb$9mqSRxDaQb+X_0BBtaRVt_C7S>x_ZS$l zdw0_iG;H3LYlS3KeJMqbR2an5OdRwlv1nlckW7G%0aY@6FQq=t6aaQXxnNmsN_s?G zBOH=6;b?D0jyT)?CP%zKo^_sGcEUWjeC!za3+>2bGt}=`-S?00i$UtUS8d`_SO82Q z+scl3$S@to2BUHsynOH{JEjPG1_Cq6(^+>%-E1(KdoC7l`jVhPD4ww&p`7|CmlFH5zWGM1KbbIy zf;_9k6gA6vwVd-MQTdy(GN85yDxUNDe$wqi+f$byOLR@=nfN$4&(jSq;dqz0P0jc4tfV_&p%Uderm%rw5GXzvGg#vhn=yKW)?h{AvHcF$e`fQVjBw^%>V|4w@?g zA3HW?b)#F$FOSkD^_Msu#ZuG8$4ge5a*-R2_0K@;6dI(NtPA&UwyaNnayEqTQF-N; zfrcgfr{|5emYUOOqvXBl{}BciScc?BU#wldnci>tcHcx=m@plyNs4 zq)=H^4gE8v7hlBuy_Tm1j47OCYU#P5?WNL^Ei1Ip}t z$XZ+~=06MwGtnBu21UxaM{VA3f(@tme~g_|b11;lwPV}1cWm3XZQHh;?AW$#+qUf; zJ73=K?o^$N^9!bGE~eLXuYT4es6KI@5~EAbKl=(gH5ka9r;vsUw~&3ab&wv&P?Qto zSFrIiZ(GC6%-2X+@ghRLgK*QVGU5ylIMaR@-k3yA%B~;GRevZ)WlRA-{+@EnQYz-O z`kQ1JmtLrFNZ|K*COMSj?V&suuqS9tD!}IHiQ!c5)?G9kxsG+nHOLC?hm#&j@U2ep zC1w7JZOdE1o#F6-4BjW(dbo?H-VHBs;q_LG0C91dttEF}*aX&2NTJ!cwi5t(_ zl7Dl{Wu{j9$J(ZJ)n*IxnW3L1`md?}FI+@++K5kj1|fYIK!~NKL9I=~w|5y=(sLRK z>l>I6D5@vGSG{*I&Sm*KNG7=RxrEl{ap)=<1@iSK6Tsb++FWCJ5VLx60|JIRk?~l_~uU*bXk*r#!QQzkkPJ zw1^`wiLf(&2|$^TTbK*jAp&;0ukBr-WhoOw1DxCuYtB?r%TzoD z&jNb7sdKiotP&9Q)upDy(mvLIi*jX2ITCRYJ&txLf&6%S+dxg3%+>WKAFcNK(`eq{ z+S5tWzW_>*xGc9`tSpxy>>abU3_i8A4BkyvemBx$tD16&-1KDpJ>5&KBf`rHggykn zpSRGxPrBe3P&hUx%m<1jSj-?7@E-^8$6j5Jc5Q$UT7ZvHVf`(eKJS}Oo}bfUN*7h8 z|JSt;oPn=>MmoZ}UMA62*oK2UzHK#}jFR%Vt;RL{_hm~J6!V5t({X`j=@Z#@vKHOw zQQ|t2UUg)5rsUNvtKL?@di*EbWpXd*jLDYmW~f_#->r{d z5bJ%5JH6=B*UjTd9`MNa=Z;~<$9Hc*`S$noXIV^}<++{AlS;n-V?^o8@^D;juh+}T z_NIc;wEmXS0i?`RiCqQxIoG^`z$T1ogH@ACLM&$v7Dm7~^|-m^t9%VCLvVl}VA^1$ ziW?4r`PI^QxZS@bszq3Y5jhSGkUR$2t6V7h&Pp2Q8mXXAKwG((M65Qm6B|c5HeQsS zqSVcno9cwcl`XMl!DR4HE@iyLC>Logb$=7TJ1i0IA}{A}b0XXBf8)88*AJaUWNJZN zUY?()e>hN{xq018;{`He86kRrlt|;(5;wNMw{n^EIo?v87neGnS;AH<90rDt4l6xG zk^OidC{v~n*W4q-EJkO17=z5^V;;p^@G_>xx*c?EAFp1AU`x)wbynG$ecb-q6^fyP zVAOEi-m~|Qa>=6hxg&sD64gg5bMSeX5xpWLb-Z$MIJJO7uvLYp=1kBhI#)*p85u~D z{Nw=l*2S-CdPz)PP&_1paf^43zv=#9jakwXwBg+)Wl#L zl@d<}tTH+Zh(QbcW#yd6WMR!R%uhw&`$|gJIGsP8CaoLwSQ|jBsrasG)=YXKJ*F;am}{;x9Ve_~kwA~OH8wXZ1^w<-F6R!f2g^a+T~ zD>o(%j)?9t!&QFzr0t+l@Yo?tMB;=<@pU|sk6oo@c;2Iv=)G+gYjv6m4V~MH+Kq8L zNEydhA>`>jyPT?*aro8oNjBE-C0@)!%jX9Qv8?6`Y-s z(%K!}udWI9Q;T)$tphtdKbI){&95FCdzuBmrR{#6uW}uesiMop9!pi}(qD@8J?!wH zBRh87%m8INMR@)|&Xdw|b=*^a?dD16?WdOEgnf>&GV*Zy_Ku3r3Qq^qgxvae{kGX9 zDo!^|-1l{R8wW8;tYhHyB)E6uh5uz%$ydv7t4S>KChU1;F;Ph~giH}c(I>MSedZ|C zzW=kQBO;+7+P+X!arAGIMaWNbW>43)3PZ;Nf>Lm*t-wA(#GxNb(bk8Gg~^cuW&$hs z9|$Ixrb)=ZOGq)3uv1WIM?H;I1uN)9smb;xIZ3)qKC*X2xD+zMP_>C^y~fF?B z+7;gU;mL)b4T4AKvkD#3I@a=c@G?OH-B=S8GO|nhSw8Kq$=RKd5W>KGvfI-+;m^7+ zD%v=JDKGO*frq>jy*u@)qrvn)0>uILlV}?fgN*SluurPKxVlxR9u;SSs52qcS zv%vInh>lN26{ztlDyII(CGzWc^?f&^bO5j_f}03v@lKC%Ifi*!On!ePGB5-|7_hSg zw7Fn3?+a&j-6~N2+l<9WPP}kUL>}XnW|zK_%gb+NmhROYz)L8WhoK!xyT@uwws?7U z+8j8gsf7C|N8ZFn$C@Q?RyPYFBVTw&&HWW8J8rb`K6V@Yh-B$Tdi}v ztWMI;-ywU%bq@ho?zpT#KGE7!W*RdnCgX00HBPGsV$ z4`h!2?W0XHs7yW^Ou~;BvnSa$uqh)Pt0m6Yjs(m-2k?F)OO;;bRRk(0 zkLtF?>fwfZCxh1YBrn>HC=!#oftnk%2e2gG;UfL06aQ0=>oMA%+D94{bIM{KM7ZHN z$pt#!3R|Ul;w)s%h-W&qRff8@l(>L(z`GwU>CK?GPEN;#bVd7Y{@(Eoaff?E&->cj z9xGPHhM{SK#ung|y+fG!Q0b`7X8QsJA0B^gji*gz%}qSr%!smPhfb23yC*cEY66Df zIAS3}Iv205AJt2k&N6J9aS19-GBm)Ma*t|mfLY1#thNqq2bYP?!++d7)%1^C#DlSUN6_?hDm z6H*3NnBq@^hs6hLMwN2$6kv3pb%{WN2gdyrZPwdur_caFjMmmusX=5eU>PS13qXKz zX_>Y6D_)@6Hw5LHDbCn3*uk*+uS>6009euOMMUjb@uFSar(_6TVg06FdDf~yyGAnp zB?t05YV#C9V=9~|@jraC;?Z&we@pHV52X-k&(w^pN+#$r#zSZD^Xk=V=(42|#)_Oi zU29w)4@sLZfp(1aR4%O*s|XqnG*4BlYKPHC+;KC`-S}iXc=m2BIYWSCbd8$5x%q1p zEtWaHB28LT3oY(6e}f8o>dS%aO?lLwd-W+0Sc+7a0p70kR- zd2>+k$a!Y_&47aw90kbd)6**fD71@l{xxj7ZOvBOG$?^OaDaVAXC|DdFpSJRNEM=b z0oAMyHu3{7_?8Dk%hZ5t2B~%-fO1KOys;jQjNHRU`BMY+EpPq7qyVE^`%32@R_a-V zQ0@)>6e#xW>XFM1vMb?qE-(>(g#^i*2RL>F&Of59FFCkArisN0gH}qYbmWQVrQ4l+u!e; zZ!`hE0MS1T^P%EU+pPdUDs^k*bI)giF>R40iXA?p9cd=)h=u3Z#s1i=Hw*^`ADFob4wEstwYHnYNPpa+bSbp5sP-ikjoQ{ctTxwz z{k5Kt{}JLfCI1PB=7^Pwna2Q~5(yYz>|C4&l28NsOX8tB#lRleid5K#o?fF_;cN8L z;!`8jM#7<|YXWBG#KzRq;-4%wl{mX>W6h0e@*}lESM%qe?q4O~d>d~agPA9GgWy15 z$zcNC4;wU5VU6vLdA?a6laSEoZNB>CBq zx!M`iGwZtTFC}*=6Gnhaa43^eDE#wWcZg zm47?B#E#+w*^Q~4p}}Y0t5852fhGB2@sle;xTBZ(p(N-9|Kb`V^x~y?P%RC*Yiy$O z7lU$*f?RJhL%eWV#AOYan7RxSE7GQ2#C*isPm<^MzyHO7W_U}(((AYB} zw%}HNJ6luvEqg^-9L$r3gb3wXM+63woWf^#%QACut=f*R_u@gTDYJ9qBs(%12+2fY_V!%qx zu&*Gm(Glo+YKb%<^eX&gd!WX&wj8z>z`5D}VC`cjS^Vk;WUX{G`sc>tj%o`E?D97! zP_uV9C-06)v2#=NXz8`JUS&j1K0;cobjDt@DkLk#n9q9^Y+xz#v8g2}+R)P`FPpFn zGs~`ztA}GfrK}6y#fxN36~#9kIBI=O)M~f%a!6K+pakZ1rkYDZ5Q} zgkRw}mjFejN+QCOr4@A~j{7*YdHq$oc9n2aI$`L@QqB3n`9=5E?}Szj93ct{ove$s3Jf6yBhM zK`If5S40u;+VqV?5`36k3}Ceu#oV|=5n+^th5`pVBVkB~kAEabswb2|7=Ew`8Yo363m(Y!$8+kk^vf(cDD;*h`@YG*JLe};ON zloG-(-N60A;IR7CzwOf{S27gp!ZOfE ziCoN{A94Ej$?|@B+X+59TIvlsh&j!zhwd0S^vq?R!^R=EZ?g!U6h{XfM?Tfq#nlK& z%1$SW-4xeAE<3<2;EpypZ{~Xb02wv(aNH>lxE2YQNGn1NWx_7EZUTer&>xv?9s2S`k$ae&DCHrh9baqG zxVTIqmmm4?hmPB0Crb01*@ECwi9|eMT4W$TwMsq)M;3r#-w7bJ3!qLd=&Ddn1<%L8 zSTTznLr&NKUp9H~1-H}Rag35tOHLIsy{ajJs1lU!a<0V$_s}X{n;8y9C?PyzdChh$ zA8Qu1^6`9Jr-nO{Y>P^>W(k^?sm>h!8pHW0#qR9L%xTh4VmiRSSNds>A@S2hu56MQ zRR0Z?8;0kC-EuH60Gh}HbAIod^|O!O5}@ug^@1pwVFsPUlzR~zOI#ZQNUi+B)RtXn zShQk`NU-HAOOBoFb=ClX!F?Rjp|sOEo!Ah@kwN6zCwTBNRE}s7!A1#P8N8u{+94Y< znkn@ANsX<{roXOP$%|RV=+{fF0IGYzN>MJgu3@^dR-?Vf$FcNM<=MqSZzW|u487xJ z9nRXDE5{PME3vQ#nbF9ecdQ7FCqw$d%>fEr0K`lX2AK?GTip>p;GdPt+ADP+PQ?6- z>V8|kjRLijY6_d8^R3`oH>h5+?#4sX% zRO!Qd?a%(prp{blGeu>FnJ3jQ?tm@{E#@a@to)D(%q0GG$ViKAOm)C0s(WcNU{67T z%nYWbelz9oA7LJC1Yy#$p-Pa_&$820!k zR3y^z<^Hh|pb$`0eAS%g^?NzZG?Au^Y2a)P(%bzq0jJBHE-8OX6S14LwKCIVnM^C1 zw``@nAWcxPlh5rL(NqU&Xg*t$ibxlvG!T(C=uM3j)@c5d!{Y?tT;bIa zUN0P|_&_SVmC^2l!7!6WNKqE51$5z$wnpu(;#}FX^=zU9Umzjgr1EZJRBfGEv53uI z@ZC|zr7(bv_$1P46UDpe?<&yPa{F*mP^7Y|0xBCL5Nj0N`4~xobjz$#$Eu~c%04meNf5$!$XZG5F+L}4Eo*^w{c$>~Pnvy;v>aK>-RyK)aY3auz z*pG}t$q$6IMiR)#A)@!JR$SSVqJ-I_o(+Jwnp`Gr0BN-$I`9_5s09mQT7I1@`3SOc zDCJ9+eu$t+=m~_*(9R)&I27?Dj^UXAk*t7}=UbK>cSQYN^}f)5Mg=(V7tp1|++rOr zN?OeX!RVXRpG0^M*~AiEIij$HnqvX{0)^=e#I(8vU16BMoaz%AK#1gA0xBzy+iFf=px z+5YWn{;Qm_IA`CUQN8H`CF*#h&LFBWjo2`sn#F1`-(;MHc0-Aw%~x<}te#L=|E1oZ z$})Iq)=L!3x94Zzkr8vugvj(73}M)Pt|c4}z}8?)62nukRr@)|L!F*j*wq>nAhjz_7qGms*8ZDjD9 zOGcs6xF2||cG$2wthSogK7JCb zL;UFS_?hH}^{=9vndx04h|0pQM3IHSng(2_AR|K zSGuIru!J`(iEY8$W7dN;^=S-%LIFw4pJOIS zECecj=wcQse*`a~&9D4rg3*f>9VvHpt?TRrfmdf{;e2LAgY#{2y<$EGR+jX1ELxhk zF>v^^=u%OwjtOjnkW;8Bb)09!)YeGfA~=%gI)5VLJ6d?BP5EFf$etk$eUPjkGgS^2 zyVK{8EG?}0>0SUC0LxT%k3fhgQA&nt5pVb69=Wt=qHgMzjwdXDkQfS>uDj3vox`9T;$+mL)F5rofv0BhWe1kfO7p zx0%o+gWZDL>Wjw%mee=Yp6$vF<3tQU=!}+3U2VKi3J)6-f}Rkyx(<1zESYq+p{>)O zXB!xiAD_%in{UPdS2gVeC6#EN)SNr;7Vnr$V%gQh$arEXp^eFuu+JW4E|*nX*jyK`BtkyQ|-$jF5ZoUfZvP*3CD<3uCE`n0!DXvsjd&!lCN; zdJqqQ9Dz99l>XO>tF?OEA5#U!Wl)EK2j}vel|@_X=*BWYoMdsZ5)@3iBFfE8#fp5d zajzVLa40=(n-1p>oZvNi@|*euq?o0KS|=l$r@mDS-rAqe5^WC9u+7+RE?R;{qw-%b zBwhfqq~Kqn5={0LO;@6-eVyq@CLNZaGb-Q*%d*_r z8T8(tJ3jnO8ngde*8eB2Dg*m}y34NBrR;vode4g*#JI?%X!L7h+2hi0+U|gP!pIrv zjDW5~w`K9NXyRd8Z;ue%ljE5V7o;PVH9ramky%grn`v8rm_Hc9=RASQ9X|La=j$=I zyYB=LRuc7$xqT00859M1x_rOKKU(kh>6dO>HN;bHinEWR?3j_h30)3_8UnU}WQvBpKts(MsH$lCsr$c3jzh(D2`C*a1R|B8{ii zNy9;&E-ge4ej5&o5{AS0uwwhLJsje>wPP9 z?1@Hye?ADSa3RQ(J)s@1*16SovKullEbq;;F*2>dU_Fx@dUB?ezBG7bs{Ee7hY$}_ zf6lI%%_n#mUL+T3H-QXP<3zZMYu+TpX4M>L<*h>`%+pzdBw;Rof0Z?4ZVaw^D_y(7 zzKYIp;;Dmt?z5ix6Ij{SZbCK=4FL7+5!g58FLwn2PhOtAp4;&1ib}# zdZ=s&e=|*m?dFI}<@87?sxw#?{N{7Kswxc%3N*Yukv~q>bIX2=y<1!Z5_cxf48#O- zf#I>>JXFsz?XX`>hiSCPew4`Po-w@5J(TyHm?$wp{3i0Q!N1Ss-ArA#Fk&5;gqwMQ z&${6nQW05hoPqx(#Eq3*Di}ysKv!>b%Q`>y!QBT zT}FJ)!}Nv>=8!tmIN60=z_>svSM^;?Z!W9R3fHirf06o+48Rik$E<$^L>0+{X>sSy zt=6_ni$+3=#{Li6pEz^Xn^Pup#AMF0aOAfFTTmX)9vYb@Q;l$(m{=wzDjZd9@pGMg zXzc*{N`a;ho%Dmq2$(=Jw7d~urY4@5w51jzSlY7{mIG5nAU{fD;0ijcn1@SKwPaBo zdzS!XrZFnGe>SZb-b;Y1aA;>G~7V1oZO?+xlj8PxG^GDFpxu~#HJN+hjVzHc-M*kwR4wWiCb|T_w zOpc&eHEq~O8m$o;PT^s@&CF=gD?JEp>(_lZiH&v4c;8-f1MC=6Y=qoAo7`U6X9(nJ zU1F^rG*smk;#;{4<#Ur;bPR!9{x&3mF`Qdx!sT9VY0^N7K*x?n_is0t%r)>#P-emY zaf-$4lh|fOn#s`yJ>ZU+RQ@3c7bbx5Kzp?;bpA~#=*U*#L#XdZfgOfJ5l`}{SaA}| z=pmQMlh0u7OLB??Y>gZ&hh8R;i7TQdWmF1Na_fotR(2i95XS6a>g5ya=%5`CVWK`( zF&TUv>4F14!Gc{%X>N3_Ae0c2Vy%np{7BXGlO4USxo)n&V_o@3zC z+mH{}aiGiDzE|s>o(gi5p#^Mst{s-ml-SaC>iN8v zfysPjXn2}qF*zC?UU;PmGDV&|=cyROc~i(CeVL_6yRDMmIO$;j^>98D z{~LJhktO@T7UKVjwaCQC^dErpW=$KXUlPx^Z?7P-AH;Tq{6V(#t?h`-HZxl~vy69c z#jj0n!;m-vN@Cc-@9Wx7AU-*NdGYLdMzux_M9o_udV#JK{^N{J!o*$={t=X>b zbkDcIl>5Xz^J!ycCg!ZEc7wJ_W92fPgze&kUhOv%vLd||sdr2@x*cB^Z>|(&l3{B> zrkdT46x;6drcL*t*Wa%44W4FSz1&%m6l(ZQM>ksQg?5G0K&_MrZ&tNm%A#XXZ%;rC zQb(24>iH%9qdKoa`o81HLUQL#Zq#)CEk!IB76#{Im7O;miw2z;Bl4iT9*aqRMr+tt z59Q`_<=PmlSymia%|==t$D{~r^d^e~gU8ImR;;KOVv=H`bSzp7qv+}sCi*8G4D0A} z%JiwF8&|KEn$G%7l!>-(I%D>CF^B4L$;QB1CC7Eo66R!d#x$V4w$iA~vg^DBDpR1> zXE#9bQ97`mvE|yUGR5w)jQ8TwrpG2rUB}uQrkO^cYyCQbveRn=7c*BDrA*`+nAIT2 zt;h!3a*O#5;PqC{NYOZ8*NUGbQe69lPpVFH1eFjIU|KP++ohuzQqb^LQrDzs=Weo& zgxs}3I|%hI4r}IzUDv+GU{f>la;;U??SBd}DBfj+%nlJhbgS0B-@ zxA<_GPefJE`R^gvE12r-4ti(X-$9=mFBzR5)f}rF>cYABtn<3v zzxcdUy_K0Z_4yxMC7Fi;+CppvU<7y z;Jv|VK2gj74UXD<77P)(Bw^UWZSP5-kvXrm7J5jp4~tlSVVISc8qNxkZDVOLl2qIN z?FBOamqf>w$RbrK)Xm7pfl%V@^d|DOTlkcz*|W`vYB&z_Lb7v)@dE4E0xi{u}V+)Lf3;Llp;1g6>OScv8+vk{}DqvG@+NBXz6soqJ zjG5L^#h03$4s^Aqxu!7h8|%32+;G9b5C9sW^y_GvC{yD?lcvuG&rU-DQ04vq%va?w z9SZ|fR;r_7Z~9EyE-QqWZ{M5UT$YkB$bx9t1HL%%B54eIr7cAbrSi(BPU0eISYD<0 zb%n12Y1y7kg-{so&V*$PG1umk^m)}N&6UiMp(``loztg1U2iVpj%h8~IFQNY4Mj+D z$SN~xY_7e*2F#(@-HD5Ptr{^Crgn~Qyq`eK4GpC zgrBCBGk^>euyCaJA#hC`M(W6g{_VP-Ad#7<-bd(edd>Fe%~7;V)*M(d0M#XlP(#|# zj~eKQmjTOYSOx;S92Ec_;s$C1Q#Mt@|JXxTmLUp>liGkB3{|zWsi>P_$BeNz2IyP7 zC;*izBm;yaZ~YjY<3pbg-T0K=(~=>+0x*;En3fxO6)O7gYt0+kCk%i_!#t#!(dl)Cg`Zf_C0CMr%oy7m{A{^B63DN_)BjL~sp zV3H2ky?4QkhM#=K=hmDr0f_uiCr> z-ye+oo%CKx%7=hch`HuVzNcAh)ni6}*!}mrGQ5_+7 zAcoIz zu5)wN5S$ChzC|VV-nqR*2ioND*Zl}RVOw2i=Gq6ylsJW=Cx(NXFH)qc?0FILx#;b^*2cW7+6;c7!9gUqXyrM<}+TM6Mwty z%rfiZkLa3%%s?N?w0D+gnn=L+gA=Dj96`&a(6A8UQ-YGH5;ntv9ovp=KLsUpo19^n zZ1)NFzZtN~3gNAraE=Sax++GF%knal9P)B~tnP7%&kx#;Sr`KB)a=6iEDNpL34#E6 zKICW{xQ1!g@7?FS9DYKx?g)aNbV-6yxNj?r{pAXmNcLXgz z%$?QF7RDmISEfx@Ns6}HjZdx|Y_KlZ#)u<_@q2$f1OR290{w75T%dV;$peBS(eEJA zZ24WF7Du-HQ-dO^8}!?Eq(mQz02(meGpGa1G?@7dgcz$Sd!k();x2C>HV2)W>|D<) zHFJK9VPz&aoPohm|8rr0NI8wqKaJ|b=0lrH`l9Q!cpbT19gJmCUJ9i)uuSe1{fbrR z5NmstwL|nq75&b2dRsJtutqxjZcLRTL`~#Xl|u_Hw3K%2ryV%RT~_PCU5xh|F*i?q zW)WdqSfse#;cO59;%Uj1n^9D+299rZMFi<02JG&q&R2GGaWlU|_}r zx#X}*OK1hn5uz9O(8LZobjp+6N>{Lw+rUqxOm8b^EMzLpN_6-|vQFu4s0;{}9Vby2 z0?B&(xtM=*@MIVcSdBrt^3Qwn(cqvt&Q1=lj8Lg{^dso3i4zT6LvJ(WGG4xKP(f8F zM!kq&bkW~0kQ%%amQ{uq=Y0&cz(d{9?XFSLm?WX1BtQXM2;Vv01Agh0&=f^%*r`}$ zEp?2dk3~Ss?1!5p)YlpYd1~(yGAOvQAx%Z&lsHznfn4l^o-;i`Y>L&r#&5J}BAxld zc?lXYZque*Pyy!Hb-1pDPQ`vJ97VLKP0qB=>vv|ikCFL?(%DDd=JUo#Rverxhp>rV z?p+SzXxbMkZ{O+O*LDY_-^Tuu@$ALjPyqTG@r6XBwfb=7@i+y}7#l5j88eGM&XiZ5 z*-~0|3pI<62I<`G?ed1l#RDOqo9*NB@7gW@#qi(7!B;DKEv?YxM-&G0QI!M$ z2yU?k3cYd#HN|sdFdqnyexC9H!`nEaL}uN$(S%TkkKeVr29dv3z$plIb4I@MbZVv+ zf&IeKoEEKaT7@>}KmQFWW+|gueKDUQ zmxi8d9?3egsvcEzpjba%sP!7Y++Z7z6%5}p=eGzjf?M6ovV#Je9K0xrf1F&u16{>V9W-?z>SC+L2HWsrT`**ql3W%u>2DMk>LDkHR<|6H|G~ZGel&k_!#RB6m36 zYDDdq@R7bAN=OXuV;6_~BopX?)};Z*b?B`l;5 z-f(pNou-*p+net{uReOQKqz^uA(hDMZL`|C`9y!kLZ+Ky!;<)+sR^V=hye=}CxHPy zOZjzE{FZlgceRPZ<4*B;`buc0+isN%5QhD5(i?}DuV+Ve$$iYq??LB!uzn%QF zE0~;7%0By9vup_bC<X+oK$Lbl!Oelzj#80@Lw{6z$p`I+zK}){S&G9TZ#?hA<&TlmiW7z5fbCf}em|k2PzN zrX;(cEsTIj3)uAcmB{2JEy(MO817pTO zTH>9oyFzcRyIg|*K}v>6h~HhI#gMeOn?ORw8Xun%M@6#K=P*?ct=)vkGVMTNg_W z={<(eB9Q0=&mFk@3(>e>PmXz~-XYRrL)A(pc_-~#IjP-=?c{C_Me7GY*F!t85+{s6 zqS70pa;C)jY!$;xl#2ypAa&#{6vGRLmY9|NRcU8CxkW}BXBMc>IP`BX%^??o;s9Ce zSmW>shaL@oOhe=w;W}81bILQr#{Fxhryw_rby3GASP(% zJOJVZmwUGQyG+$45l?vY6T%I$G6PzCjd3m+mwJpX9|yl4pINiUKLq59up$BoBnyOk zN+Qmnv4{X(GxX>H%n`DbdIZBVuK2mb%#MxWw-G>t{iNlK${>)+-0cehOvcFkxW|_V zOFwk@sv4q)!%fg*9KfEBuAN;G&I6bEH?$?*;*#_}#nV5m3)Hioi)(?vdN^F857^cV zzPM*;4`iUEAN?g>_m@x0!;{0qQEY0xF09fF&OrxWH$U6M&1OHZ%z(S^{+(KAn;dHX zC*azEd~4`8i-G`^ijLNmi&b@g2dFPt5C)g06kIy|26>!zHv1vAPs7{srEA`F32L1_ zfRsy*T;Gh7n1;cyklTd{1cdKME!7Rp==8~o#JoVCs&3$c&}Fv3stj>YA8fWr#X@#X zS&G0mW>a}=IaUm)S5_3cjpFAo<_uiMa^08!oO++`*|mgq=;~N{>>`=x!0oSu*>An2 z*ZR{npayeaX`6>zE+`D3wfPqqzc(jj)r8}imH(HKSE`aEZ0FTMy|^$1-v3P_1Wbk} zhY9N<6!>TW4*&y_Zoe*HYVof1X5^{8$j~+mm5*e^t5-blEzeqU@zf2Bk}?1E;d-)# zM1-VRr)9X1FxFWpYa=$qP-pdd%BX}rRi&MFYp73~jwqvz5;jZUTPb_eW`&tH;78$7 zyS9@Fk{kLo<~i$tNnoE(8&8^B%k%xpK-Tp=oH26ftjI-BV-curyNh*9D{OILyn?+l zG;Kva3s!Pf#AS2nO`l2+3d|UiOYK@D{u)h24C1~0) zZ6>YXR(?OwCHXsRcu#AOF)(RTuYN^D6f8NrCC#hywdOHvs};Le!kf-GoUSmHT9Mk& zV#EPa$jxTT)DO@SyC@(&v z0&xTcz-$H*@Lx~(pD<30EDZlq<+?Rx;x@++yHC{+)}Ti*UDkHD$1U9UL6I;Z&~i3! z@Ys=#35g<%67Sa_?st`jzY)sMQ<%pM4F-vdR9)PbE7fWxX?f9`%J$%Cn1gy%>UYrj zxKaGxB2b%%S{j<%*U$o;3fibB$W_x03?8H`Sb9IM_wnlz(Ug%zi~Iim5jbvgCZ%Rj zmbOZ7(~=neC3lC`ukTj3r5wj?8(@4KdRli5j>i*dQ-p?A7?S=OX!?f+(QQcF)o7bD zx^JA21ZBHV!zdEnJa1U{mS4$sy`S{6aBy-*+LnEALj>;@nwqUgesWnx6nGJ+jGC=_ z(`P(^cQ^#0S#>b5QJeUnk^*7xr2SweGF&5(UKnc5!L|yw2T?px|4{3r6n9gP`(=@f4)m7M;V+248C@ zC06F9t3rxAZ8s!iwYmZsWGfgRfg`U^kKB!%gh}+zJ*b-?8WnD=$Nlf71iC6IaaV!w zTl;C6ikbr@T1c`z1?S8&H7lYM|u}8feo&5?z*?sfOIp1)6v0(5zfa zd8iIy?Z^UF_}h)$`cAf67uebL`fjN$8T<|-T$8_E?$N+p`%&|btO$6q$@{T9U{>hi ztxY|lh%~}t|M_-10lmllN8Xz@TwWEO&L3BbDpr~{VyRMlsPX5Fa94{FVl#~)EGCF!}-Sx{?97$8ed59^VzloiPeRh{T0aisJw2oEpV!IxX z2_hb)jh&#ReD!RR{Pf7R*N)YOhm{tns;bp!@uLhdOsWE1!KyyoKDJ&qsePUmG1iz& ztDs1|0rY)p4SNhocIeEd!Jnq8JDZx{)jpw^KfgvPuOvRpGzCGhK^$H1-Wf=eI_2?T z02J6CSW@R9s4)kwW0>pF(jT@^nH-KTx$DU{m}) zQYM@dTKJL%ud{Dddx?D~o8A`(UYxIt-k^Zzi*{)-c+i3vrCtf&ooAyRoKcLXSF=S9 z`3nx~o$7tp)PNJa{Vw;5jQ-a~rHj#|Ep%-Q)&Amg$=8y9gPf%Z6-s@+Jd0i~?jQ^> zhNR;kWnA5mCoAQ?w2(HXGNv{!G9u0R3u;m|yh>Dl3F^VrH}p_ALr9tUi1-WDa5 zH}n+5nfkzx?!_3`y|fd>>w8#G=JZ4wp7(l4spWyUI%UuUFG(z7X%H$?RkX0tVO}1}CJC<55a?VVtoJ>1O#3VR*eU6jl1?m|pH0)`D5NS!Tcb?a~xuCcO4vZHIy z+us9_{^I~JZwJ0_2$9GZZw;p1v<>XVWs2OG%5?+-w0jPJ`2nw!CmIiWFwCkxk(OjD z5=-;JoP=U>Z>YiN+3*59YvouSEu~cVpS8%(M+#Tn&dItJA95rxVpPC%Wi;St`$S8u zR|>rfFTcPK*IMJ&UOHP_Z%~oUci(P(&BM&Zi6G6P@lS_ZK?;zlFk_2s2LU#f08^!h zgLKxRJe`H8O(t(n?uxTd$c|+z0rDb zL1QW8r~}6_(uLV$rTP&)`=j63!6qa$%sA@XH&C3SLO!WPMVSNwhqPf4nz9f@_n4^w zk)IWK|DZN|s%p|zj=V&TBB{=pX8KNIWrwu#z$tmj$^GtZ@rI<+B`zaiWq#d$XMwbn zunIpgv+1cDL=VlpbgD3_fL4<6Pb<0bCij2C3pCfRelf3LFe1k+f;2xB^jvPYB2Hxk zzm{B=CdS?hfOl9h+&s~4k19~4p_jPUo~un_MvyQFgCyCR!vc1Z@!xTBZ>Q{HB3o zqUKRPX{J}E^xSmKS1Bi%x8^t;%LehYh$8i1uUVC8ge+h}`+SUZ#==32xbc&3IVa4C z;rU_FAU7Q>@AWVpY+sY&a$gGbcxkb91C~Ji7YSKPqQ?GZx+Qa0Vv(iwyLrjjh;P@` zqTXF1)zgK9Aaa%C*DW=J*F-8x8|Jc0?w1D^fJGi&DwK1If$ZTenA>2y1`|Q?fQ7Qe zE-!!S7Z%EP@xAD<%bqCp0yeiFDeY9}SpC@!oZ6g;i0Km>Fr?l{xdM0#Qv*|Ax01ny zvPEZrV4Em9Fk~QwA+4z!nDy-j1q;yEe&+#<70CAeKpO;390BsTzHg8a5`ro7?AWiU zRoe^|rIZaJrCR)oOV%G@sXjPw&f&`SCT6CWfzbG!gh1E~ArM(f)J{lT5uQI2!i{+n zvelRFTX=KU|6=BGj1?*ei5g3bN=>!Ca zUq#N|o=?i1X8I2}r2C?P;lhrZIIy>zQ}Z!=@X$xt!71MtdbKd^#eda?{~OPXo%KJA z)W;e&za0>S?;btEsy?z-#6LX|#?R#vNd`iz1>tNkWgh}EXToVT9En@Zo4%j1MHG{O zCgdV~Bp672$<(;FHy$^`qi3803Q&IRNFd*fXWp2&GKHz7zeF#^@_~70JOfOFNR*`c z#{;1%kWBBaZ!AQ~cm$LkRyVzFo)42mdC9}BF8iq5-R~Q;(Pc-Czoyd%Y$A=0ZhC4- z!DFx9-Al*8;cd-|dO3!T8c<%D)yTb411O1U>)jAS7>L4Tkh9|6_oR9?XdQs%fuqY? zJ~^@|F)lkbRyMZu?$#=oC6pBn=d2qI3^7R5@}lM2`_4ob+RJxjz?A=wv3KecEKIs? z)3$A+(zb2ewr!)*wr$(CZQJHoeRtk7`lA2C9%DbTBG#O?LBLMQ!_%J44UuYp}pZh51beIelWS^)0>wiaYr66{&4E*d1hQ}T z^70Jz>ExGry!3O$G2+D``(lZv>c3AGJ6JIG61e8j>9e@NaVT076m)j_Hxg z*^11wz)Y4ynF*i}J>@bnX?TqJ0+dNd)5s8wE`EfO!(Rhq;aKq+qdd@g0NsrHz zO}sU=J3dMvP=@{LH1^xtE2Me4EjlJG%R7^+jRZs(15jSb&gpbh=N-pksf;%@YVLxl zwtxOGmKRY3G24?f+UX$M8|753KyNa}y(Lyx37~=|d0)9*F*ZZ$pj(hHo^cA&1aaCU z8@S8ZLu!@8wK5^n?xP9CnSXFaozZyWTe|FVnh7tt~$O%>q2ckf?xX5CQn*G}qjEu(TwI2xd$NlR&UBmD8PY&szo%Cw+ zRnI$PW;6>wcChFL^pl~_qkXL?**0_dj0Z%1JkaDvAa_*kZZ{7!#$2vE!QmkydeQP}y-CboUoEWkSYGcAN57|9w6)!p;l>1)vmH1S>Q zFEL9lH`D!L!3iEKYe%#kE1PTDg8 z_-4;49}`ox>g&qMPFKYiqaT#8pA+MAF2+dkL;24Tp_^c=ZOchKv3)Tpf2V;iB`(rzjBSKJ0rK0u8W4P z7YPJVRD-wX{&U}7SANHXwkK*o`C2)$BoW^b!#|!YzDPUp3z!8o#H#eInZl5RcTDM@ z9G+}Ke4RF$-Oh=RMiAL8y1829Yh1O^Uh%7~`G`F7+tMBmbVvr|PhFZdks-3Cl%~+v z!aj9Q?=BXgzAzj!@CVyvyOU|?`~4vRZqJXm1=`hGy*hpEG(tuA<6n2Fm^^2jd-f|+ z3Ow%19k}5#6zKP6I(`{Q-DnX@O4h4yvP7IcaK~&l2T8>?kh8;HBgpk=50JnbV>yD$EZQ&>n0JAaMhpVEc)KhNImCYQ`W|G z%UpZDnF>r#e|iKjM&nG;g!_KXe=?s5K2F({Et&tk{Q<@zAT9rIKV;_riBHDF#Pojv zo5TOYn!~pLgf$prgfIHjsFc1IFGo@TJzB;8Uku^VW`X08Hs_H z%Zopy&!t8l=Q5q^CmubfUx%iX9D2Wp-Ivpl*zX^U?dKma9ha3(jqmUOJQ1>>@$G>D zbwPrVn;+k1h%pVv8luMWgF*t#$1mHD&Ar;6v`?lP55}Rp)25|RL`j zl*;r|PNE*TxWSGE!iZDekK1z|*x7vK(jn016`UKi#7XnzT1YJVIfFeG?Hh`awOqhG z$u>$Xwc9U9mumDxEZFw(%vqlw%gp|q%-TBNmUjm5QplFy4T$R>(Xgi*EvYirG&*tG zbNP*LKxM}Iv)(QKLK@3zTs0B30cOFT*1vo!{PSE)?k4KMqacOJ; zAb=r={BZ?qJs!L%ZQm48h;7mSA*yve-Ln}6jQdxFIZu$%#CV{9VTD;6WUb&zuD1}j z@4c&E-=qyDuXsD?3Uqbo3*32~7qf9Cu4q8^)C6nL&Eig@w1p|hqr|F-9I=76H@WiQ zxX$%KoqevSc39xU#q>ZL4uJ!4Yqg#zglG4+1FEcVK*_7=!AxU8RVC7J+;3W;1 z+H(3w1v1eu9ar@xIaz7g6VWdE9RQEgpEf=0eO?`+Pm&;JZC0{k;KW)~o%`z;$vLQj zjt=-I$BqFVjRx!Umsy9vX(3VzA$KY|TnBsDwL0K~zOS5?+k5*Si8BHJE<}e}gW1Ji zDYydPafCVM0xFd?hK+<8u7;dE9OOpaaS>dV(PKwj;%jt)VQ$o4i zNcx22I3VkYX*-`9Cw$Y+%}gSBlDzde{E&?l93NHd?6H0^;i_XU^~57Qt-yWI9O0(C z2JGdL-Hv&7r71K(UC`u^v6i4xm=K(ye`(tSNde$(Z{)T+Ve(r-~T~*Xq z#`~`#`ULv9t>4%EY21qY!|BCu&-`hy8o=*^gT1V+O>m^^IV%C^w8>0Kf%nGd067@j z>%UWNW3C*7u_w_fAs7Yz_aAECglB5Bi==m4_m-?2fFVuYTrI6XDmjMU(5Pn*MjF~n zN9YaX3m-Fe=DU|GcS>!CkJ&jNc}=FZDX!EW_95HK0evkkbLSwV^i98g0kw)3yjDjW z0v`5oIFv-NG0f2rB2gDQL(g-OmB4OG9P&8TBG>gJc)H{>n@NqRF}}~4mjhF*qq@J& z#q$g(Ej-kNLvWxpoxMSd>HhrM9P8B??_`Y~UwSrH&=^T^JJzFSjAN3BV-9OYoZRmk zW-3A=e(LcJBz3Sky<(XyZ=XPb`}?z57;uctJ-)0c#GBZUJC0(Ebg&MadN0t7Vjnre zF*hysz$loDP`*|t)+@-`yxI+~LX?)m`fFfZ;A>N7)Dy+lDaBZTPco*o4of z<=eoj!)lwHWGuxb!<^DA8d1WRsXoa{sh}LL5>HwJel%_P(SKcgMdfC(0bCbc_@k+V z&k&{2NLr+2uoIL;$+BW?M;rlf$rPwGGX-qcar~U!z50Qk-j44dH4GcKCt1?7lc49Q zKG+VT$=VUOBb+4sJ>!xz+^)Z}p#1q_-~e+l07}@1iojV(<0_J3Of;#>N1+1<%*n zBK!B6AStG%!33cfH51jyRs83!xLWQ64A=ch|+Y`;CNhgWOy9zT>FA0ME;w|@?Q;e zUifFw@niO>M^9A%VD&(xHp(uZP7U{==&B0SeNg34I=s%v^ZbX)DLd^H4=X;q95x56 z`p2}?9e+;BR3>#kjr_djq_|^JR}*(vQ1)Dt)n-sWgRg7z4`Q<(F#6RAq@;|iv{XC3IEbP zpbSe(hnYY*aR;2GvZ$g7QAMwX;b6YfK0F-_WGwKuW_7EhI4!o$4=fa<$9F@Ld0pM# zANbkJ4({$N0Z{0(2m~ZIz%{3&lHn=FK|qehf#f-azt0HY3J3@PkZEs}+ODS=vTe^V zlrsA;U?xBA$Q=kJa>}|Msx+(JX&CP%cvKw!>S?+$qhL?AHAFsR;4hsci4<|RKhZn3 z8*Z|<9l=D-M(J}~SY2zmH92}e7V{lZwgYHexXxo&IKNq(C~4w7er_sBL)m%d?yL!$ zFQNgnmxKAFq7zdjhhf_89dAbefJYj1o`hfxdGF`q zjkO6GLi#o$(qj_zVr2M6FPau76m}StTee~%$i~f)p|=^X zLpH3kwL+R5^UgfI$(z#WsCe=lt<|lNy zeK6)ZXujYI%s$(L&BFm7cnhEhyaA*Lus9!dJ>cilfRu8{K~Iz1v!dOIPRk83X`=w) zr9EIs>>!-O-R#t#rDI_|JMO6Z@yHL0d*&;va)a@P{1U+hS_DBqY4L`Vh@5q8-@4{m z!)-Kj+CM8)vw`$xV)*LvaW0{{KfSpNUEQN*P`4y@l3qH8EUI2YTUPPwPqkcPZ3;U^ zJ;)S`fau<)Vv$>RCa`=Pv|&s3hhBmxUtSRUBsb5`0(<^(A0}qRSotiGdjI__56k9w`+jTs z_%~2NOADaz{MUi%elIzEgS>}mR zs^H-uZu|Zq!2X&xRD8VKk3jtJDM|Q_63tv7;7mN*dVb$&I^Sj@YM5Vzm0AB8sMc$H zIyAc7r&XDWMO5dOr)@=^BOMhXx;xf;WFobzcelM;4YT68Pw!ZHeclH%?N%vIxhdhb zxZW<|f1848|G^G<_S8vsSHI_Zze{vVrO7iFdpN5!a$roC(QA*LFO%l8%vGxt6%b@X z)-OkGX)P8GV!4=TUc0?K$Xe$}CWoMWpyZ z_=H2|qat$Wj>-GrRNTn3KKo6+>ZZJW%b`X#VisIbLNO}L=-uIFTxn9fQc(aWMyW{N zx4F)=0C{BKnL1|YiD1$t{4@zj+!`64B=r@*5vk&IkieA+o8rmN8rYW$nb1|)GPWM#JIsOYS^T6kf_lX|A?LKyr~A^!-O>kF6kS)oZTJ^P!0UFt)I0t2 z|7Iw{*1#eJ03s@;yV=21^Rot6WdQ{G-CUdDCpv8Ly$ChOVkbgjA4fA(f9U#bDUSkp z*PUc~vSZF%2B~OFRUAaqmva+KyUX{mX~1KE@l_7-=e6z%xIbeA+O?3&k7j?5G>~&Q zRX|;qAFVZ$Wv(mx#Qqs+D9#%%CQy!;9V3;LnkB8}Eiuv*AkC~lQr_0DQP_TQ@~P{s zMj{Avu5V__0@9;#lq?}Nx-xt_O{Y$pEbO{a%y1?j#ah* zzyH4I@E)G@1rwubs9UL7jd-OA>mfYTGgGZX-p*pbqoX7xj*vv9nPZeFN5Q%M3ExM(z6x7*jx73;KZoj>yGCz3=ew7rxQ$oX` za}oIaJ7@FzoVqwz{zx){+ceQQwq&P*RGHn-wEPsKk=xl3`O9O%Mkhe@cO^p@jlEf% zF{$v~1m4;ju`J{HEx@Od_T08=R+)7XgHh1_d2Z147;LCR3Fz4(KnYDiw*D5-txzuXgsvwKJviPuAV}!lek5> zcs&=U8YTLXCnfXH&bMEq8Z4|2DQy@uqztgf?C?G*BG7^@TZp1N$@)1x#RW)=0W8u? z8zS3PPeukhBImtLt5UbKEv%d@u}RzQZ5--md*`@KoGL~v75`|R7Gwmh3)w#RGVUl6 z)7*Vrv6shz3d<+%!Q5LzD0<^fiLY3|k+;e8l)E062OPm#LT1VfaI74P86b1xWWjYy zv9qzv^lJj067N|fdY1{(LH72s+kyeRuAq=rkVPwm*tB|RIj%N;npcoZ)bM2F*i>g3 zDIDNE&BFm7BVY?oOCA77P!eoziA!6CM%9II+FRrNNu!L)fY?kymo6d?L8|Y7_ld7= zMPbz67R!7>Q0o#~{xnhobOcxOFU>h0S^CvBp+6CESfR_Ljt1^^oHjKeI#A&=ik*x9 zM)4V5N#Liy`qzLmA;?HWzF|}8J-1v;Z!5WejJ4F%ACaO?mQjp~GDH_f#~UB?;h<4w zrFx1xH6WbG@kGkPn|s|*YHW6R%&!cia@Owq4t;6=28;B2e5+~M?)BgUgCc=e?)r4< z3bT8y0T*<-OBI}&vfHO*gqKs!%&TDy?hpL&j}|5C#G%4K41j`Z-HRb^^&bj3jwgRL z7GAuRQ3YvWCS%faRpH|>TC>-4aa-GOM0Ei>2F!G+PrY~yG#1pw4slAbpqm%s*&@y_ z8}>pl@N{y00gqOgPl+N6fdceGrv=DkgkMGLjSQKFg_ELMOngpdKc?3`T?=S$;R*dg z<;E(ErVdR5%Q13B6Y&NBS~&7p*wwN_(2nhjz^@B1^gZ+il2^iu)$zKza8##9Y%>}A z}i6JE#dlE zGg|H6-Tv&F8r$tmb$fAoyF|nor2cF6`pCsq;V5|ig+v08q`P?17i?lprZw5!q4E7K z_Y2Nc{rq3=9-03qR3Re^;Cu{YODAbYl{-(cV5D7+vBt5 z{TN|mE-7t!cCv3F^c?DF7`(%M^$+IeHYO*uevLHqo)Q7yDGX8nz2A&KLA-;qdAm`9 z-{HidY}5Gpbr<_LFTq$FkeEb2slg37zJ!Dc2QAc`>T0l;Z{2LyJAnz(ew>X&rrf8} zQudVa-A+ z3_gr;f*)yaUI&IGK0yWp#p6(&`v$3GU#aq^0Vrk%<$9dw{YuEVBdfE-Em{HHbzV<=s;PiOUB|1G zT|k>7!N42}uVBQcC-(kdff3||?RlWDo+fTOU&kPyDIxS*l!O05F-ynpq~7Y$C;oLX z<1GoPV*Pt4s)dq&8n(joFRzlY>66UIR|aofRmSNM2Lt;b35ydJ_WK@_5zK55+ax>D z25H(lo7q854=6I!IGycNqbdsoWTg-0l^lXUu&oTCs~7GSlf*+zb=ZztK3CsA-j40{ z*P%Op4ZCV@g1Vi%vO{XvH#TAI{rvncv#0S{zqaN^o5#w1o=NUGB1T+Efe>UXC}m_= z80Q{dn373LOtHO$dS)5M{phi6#ZG*08R{s<7HyJ&tQMV19LodhViZJyC{f^G`Q$nD z0%dzC!>@WyO`^a1Led#1Luvq!+S9-JG=(!(5Nw4h7ccEp51dyFm>pf`R#wNn7a~O2 zSL}b-rWLV&oca~83#};lS(oiytyf+Tcz@3-BW7P)tc4%Dl}TXxxw>++4P(jz9Ei>^ z26q->JW<}F$!c=oSBw#t=G12ExYV#fQwk|l!t?1M#-#9iK)ph;Rz@Hl2O8%ac=4-* zp^1r9QVm=E;YZnYD?IUCASh52t3QC*BF(4Ge*9-FzW0o_Tl;|#I~buI>Cj zVWlIwV@(;srcvddX%hPr5aHH%j1aImO8iLs$6fucX8vBU@Oc?}xA(2n8T}Onqm9T) zF8@L4_)D~5?cewb|8oJTp2XPKKX>I#*(pW>QH?uBxBLQ=JQ{&j> znXhx#=b)&`&vMnC#R29ZLI&n}p7@U}?oIGPBHNDkuYlF@vqxankt1!#JY3e8KfP~6 zOMLh+NpJUG=f`-dlhp+{5)4~XOC!)5OT$M0;8O2SI$BfAgFNsG*OEWUxSoRbKKukx zS1-p(zBS;lz@O?}a6RM}cjUXgF4qj2scC@P45AxcauWX6@f6q7Met~A2~nv)M9Uw_ibooeu! z>b!~m#Ei7fqaku65fKu?=xhPR1t=A+G=`e`7cNU{-4C#>BD+`53n)wry7cNN#Fr>3 zV5ACyzDQqr@|Yqb4x?UYs83QP$a9<4E6uJDg)I3~un?=hP=^ zxMr}Md#O_$8`RZiz?Y(jWRW=9EPnHH^DYCWB?8MK9{$lj^R!A?t(nSqU)#CtGX z=FYAB@t+Xppdo0eY=fW#k!Gz}YH(G8xb3?X%u|H%vdT#e&0vmk*%o&L(P0;2@r3Kh zQpxX(Of>^kEnZ9lHf>@$Vt#fF5fL}5yZMgSRM_7(#GxES)>7Js0);?dg0r}Eyu;^g zgM(&svkD99#s5oW{kD`Kz@bFlk+gU(vWI166b_^9Yt!h$JLhGOowEoTd|R6~(RE05 z*)~@!T@w3Z#@klff+}BjMfQP90PW?)zV-u`%Bz2vr~sN59QKtccIpeW*8;Oad)a{D zDaLu@1;i$K*z;Nvr6AsbnVotr%nufmr8D%coB64Pik=vEGROJ{&xy%N51xF7{W$)B z_F5_|nmHJfDO8@nN2#~B*nfMS*h{XTH6|S!Hzd;w_c+0%ifT0>L%gw@F;W&C);>}ZW43$FIt#}JTS z$v`;Si{t7ZT#4AX?lrQjCZ9+YKFb4)K&!%HA5u%gHl1CmZy|J?dWzL7P;69mF`c+d zc&)hP^?26IPgSj-%$|=bL|6yyv|lvaaFg+s(rv$NG@QYYFiVf$DQmVs%0Q83qtQsm zwYxK{4XjqGx-{qMx-w2q$rbe7{{rd=I2`e$o-Gty*5uE&IZ?60p1#IcaOM=A!p{ed zYk5#6c%Fv6v#0=_B_IL>)hYlW!EYS7P66;AXl#U}ySac_sck{^N(A4Te;%ElgI1%% zRbwsqtd0oqXpyhFKX-4pgCg&gg4DO>+dh^P@@_I_FX>fpYPOP;GDKH zw*M9pviwgpStds2|6f5yt8ugCKc4fsBhsW(1Tubq5IH=??ls)f8gd)CQg~jEJW}xk zVItIohvMFzPIUw#6M02W3-TNs1Q54?Zf~yuv|gGwqJZBwBJ?{tjVib(K5kmw9yI8j zIwH!q1B=Ez&weFU@osm`-q=WOIzP`31470A2kwwshnLsepL6pf_}mB#8y zKkU!`$yLj)Rc;e1S~MDow(lmpxa_$39dBkYEZdBix%SxM<5ByyH9sBKAxE1I6)m4S zY*wqR$-)X(k_KobB1E&FP6Yh%U}-UH+2;*za_tpAg$OA^X0HX4I}jMCA|9I(45K$RXKNUAsoE5Fp=m;o1_{SH34S&W@%T3V+Tn+r^-_BgIa+7)!M}up1OQ(P%2tu6&`g3)1Brlo zZjR=~vIMKz zH11+YIRm|$^v%X7qzO~wE>fW=`TE7q-~_Vj(3cl!t*LyEQzi1yjbpY0MJM2Zr7x4z zcs4?2GA*9#C*jL{8kD;)ISZ6n0G6fa%5e(S+_CQD1UkF-ClI~jVaoH*G+|uXsoo?= z@Q!`2sgl^o^&WXBALJ5o`llzabhnFAv?Lmj(Hr0{%W7bUVZN?I3C<(fUVS;Ca8?0O z-{)5whJwOZsvod~{KTQnmsac|mL{Ct%CyHwxLA~^N4D|3?A5gf;Uwb)Z>I}2H%x4X zb!(o$)J;}{2}PKYA%qHoC(E4#3Gp(7fatHvDpr@Ft`<5t z?mmJk5cWz8)ZhLBF5I40iISg>&Bm1k4PpK}mmO@x-A9~g&QA=!(qhPgMH3+eQfJnu zqlJ~rUe9`wl>=bc42R~)mx!m{P|*(LKH{-84|D6tH`Q<)gf(EVT1)z*$L+^l{m8&J zh2j56!6y2Ged#W-9&k&}i>a}Ac zHB}IAYW1N6Jq&`SnDG~ea(pmU`Cm5AA|F2dBo;XXsKiRe|5bR9V4=ybZSVMblMw`-5(r6nDp($c^2g9x#zqrJ3WkB0LBm-5 zG!V2ST(0`GP-F(mg{jGO_?MxjLJwIhB(|CnK`SIl+U$$5r6bMSe6Pu3)Wsw3LPWN* zxZLkZ`grlHnk&IWT?n#}tCuFdV-e~e7l~%U#&XzjMd19N1e;XaZ9Mjiw@hhG_9Wn- z2BZ%X1qhh>jk(|J*X^;MG1s~gL|;VQCdwEG6))4_rFxKiY%71rZ%9*J__u+dAWw8R zd6d|q>&Cof0|Bv;3J0cQ;J%`&S^@!mRk;s5f#|PI7%=$C`&Ai>$thImT4|*jpYwX{ zT=)mZYVb-;&S-l@X*x^xu=8{4&EI!zm+x0T#Gx*~=9-U^>It51XP^N1Zhrk2I=}Dx z`S=jSi+~LI$^eUFh(tV#n}1~C-9_`IuSLu%&>20_J>sC*W+rzG_n_IRh{S$k4$P|h zQja|KE50E-Qan!;!U$BE6zVXIv4Ss5D_$CHA~X2eB>h z8yV;#qk)S&T^6b5x*n%Aepa(<=E)O5w-GVY@jl3&x%c%m1Mb-l|3P;h!%4>JB}|<= zK*> zs*scHzs-mo&k{ATpv&Dn{jN{3T{;9^C_$sPY>D3X&iu7e$qny2?T8JjlB4!b_Spa914v7>?9kQah85-V*@-FB(wJaSYpy4e| z_Y9>aq(8Jl@j#NkazLA3YcgjxBj`qT0)JPnkY!!!_v-r?sWh!u6b*0jl<14cPgMXx zHQX9NlN`^%;qsQwq^16Ppg$#90kxSBR*vH3v$xj3FZWni{z%EMKpM}VzvB@J!}UFB zXI+;a0y3;M^+zHkWq+v3S+N4_uVjmgHH+MQ{jdnHTh~zar|K0RQzSdm3y)RC8y5Xp;B&wgY~rVo74HF~#1y_Kqydn<-0a9BrEy?$ z8T0V!DuoNLHzqOvw5)?|+^HzdRNCp-0FQbyPxwY#HDa+0O<}*{^KM|L3*u9tpRmjC zG!ty6-p#Hkc70krQQ*iWloV@wN>dZ<0%1yAnBOYqgRXXWGqt0($qHWY*4sa1;jQ3a znGA(i{1x)tGzDJ?a=_Jh)MV`$z!_1`K7vBxZVfv=U#-eT0$(UfnsHjLJL_(Iek z|3`Fn*=WFZv*#mh{PI;FW43Qc*M( zG2mT)qxwGkVk^H|?qkA6V|m-8NF!6mW8>9%w;(SC*HB@ZC)l^6uNcGSD5tO=D5V|= zD(9N4O9$q3s#G(9=CR&RX`f-5Y6xcU_6s=qwD@y<&}4f^Ed4{j2WRsZ(l+T!5GWsq zt1vBgZ$K?qO1h|XbQHm;s|0X8z**^Ie%-B>6XuUf>tK-Nl>S}UWrG_rH<-~7o?+t{ zc`C?DDS(3$vr9B|1ekJ*kCdKYP_Vj+pHOVXHwk4d)&H4*@mNk1w zkp-ZPjeTd@BEEh!A8ejZw60&&vgU$Y)fMk43P*{L&ImNB1nq&;n` z<~F|?J6yARO(eU>Z20Ak=rmK9d0Mlo`Q1R5>3MJec^$1JV4M*^gc4`g z?(wnDiE9<1L>dvO!Y~_AuvPVKiMSYi8m~Cvoj7IaFBsxSi4j{f*>Q#U40S84%rab2 z#rASC*s)v*Us*sWuEAC8Sd~Oi&s`FIq>PpR3f)SBO=kpiH>n}5ZmAOF!D$XM4WWYK z3!NZgYA|wldZTCu5D3`yhuY?TTYLNGZ4kJ}&tlt0dF8%F{ik)!{B!%OGxs2K6Ti0h z6s}lLZX2Asdk1Z@rG7GX+7&#*a7YtftMma+hFR^`eH{e^>9 z)&7J9r}qx)boZunN4F+(MYrl{^czgOk?@hNVi*@}^eL7&+iWpRECDX?#TI(XF>aY- z11_h3mV#9K&Imsui|YK3*b$>&{uda+gh=Kgs_uMF`GhA(KfycPPEn5c&!TnfOQi6nBEC4=F=D_0R02OP8fH`l<~6rJVSHzq-1d1+#1j*CkB0lwT9LMtmZFfh{8qN8=}Pr&On9~QE}GU4UXblJq)2Z6Z3>`ec%*) zK{IjFHu#*4x)B>;i6mmlQIQ}^O-3v%MBX8cay=xcv-e2>X|U`aqE3nk5B~P{Wbp#c50t0*Gy|>{ID3V}#00I@C07QQHL>Fc)BVga+)wOh7 zL~O53y9aYSgoAP2{)jsCM8ldoxSI((APHo^*h593-sDBx<)KcQNPxX$aVc%dvu$ZA z;W`2=6laI=#*MV~xWu3C?dqFXo9z%{=%kZH!S|9b#Hq@9EyKpjzl+$_Hmcoa9j0TY z56-+kFt)Jv!?&+Jx)xg#nze!p^f|`}vxEkb;``g)W@~o<7I92y*L4ceV@dkNuL9r4 zfH5H)#-dgx|Pi z-Z9Fi(M|T+ z{b`c_yjF>TfEf^??9s9b0+_e>+e_9N>F#=|YedFG9iMREuVM22IjU`S(ei7+;W&M1 zV9PCt{UtMVqVAEXXm!=+I9%dg0%HjjBRfDEI6|R{fYvCB zMkKA&`H23&m)>K!xxch)3Izd!;_KW3r;0U!n3x4na&=b|V23D@X%?06_&6-KC{e_@ za8K8!vA`aZg*}ZtS-5-wm%o}v7Rt(VNAR@S>@shwbtN2#>7yT7h)5$yubzcgHm+4= z6Tj&mmL{dCvC#4U`FH=owU0z+$J~IuZ&=^S*i|`b^uK|WpwZMrIl*vYNHr9l^A*r4 zQWK6!)>U&IRRaOi6oq2dk4=bXn9}$q$b5I8LgmmiOY(b;EbP^Ao;C@vt@OimG9^H6 z*BkwMnR$gIMJD}v!&3RH==8=~U8D0T!r6-AD44PF0x*Ipr%RaTc3oPnrI5euI21ZQic&vy z!NFO}9I`&LIU-QGeaeim z)GN&>o{o`v#zcxPOBWO?Lx&s=;-J51y@&BjJ`3ZBBt2bwDN|JA|4@;{-!8JSrAPZ&C^v6-;hhUhb^R+d!}yuoMy0Ae?j z_E^tUIA7q;40Hv%=x z&oEi)ZB}jB;Q9LcV%n=6DJ!`PrE+sy5`{XxP7$?o^ZK-m=Ix_&ldr~@NF#^*j^(B2 z^X=Rems|qr+*Rr?KHpC=)~-vK(5j)92>!*sc=xW`r8=5|3ul@u?W1{9<%r@@RopR^ zDk*hvL)7lgG^Z+MEEtnw;pY0f-A<{Kz+%#|U=7CUfbS~qXonRzn~MY4aJu^NqI4Xj zF#UHvo>=2BkFfI`#R_s)8DmG|02UU5p4g(T1zs2-8|+45Y7;LGwvk+lNTDc$?%+RU zvs-CAT6&4A%_9n@49y;?9FsYTbdl>4&JJL zU`^{vyu$Tz0u6H+hFtLHjm@k6N6${i99+46x#YIAXbZB%0Mwj04daQlTVv3*GFr1~ zU8IaMo=vW%PZ{-gU;B05vOjKvWWT5zmW*5>`}|*5StOQJVW@s6dE|%(_1Mq03%Jpa zddpZj8=g=&0{0oD{n?IH;Oi1CGg)s2>_13Kf1AF`ZKn7wh4f4X!`p4dUl=3sR>~ut zog8aDF|sOGGn@gkDNM%z1WlzK-ie@#s^oo7jAufi156vnvyA+pYKSFACbwh+>5fg5 zTV0gE8nHz$+;jn}bygQ)kXU111XNH+r9xg4PM<1}$UJ_!bo0}Dg{#*Y z`HO(;gUZrD$Ex|>ZIl(i73Y><*2a2eU~bAY>YPxb&7Ax%xs<1Yvpfg@*ek!T zj`D^eH4;hD?t@JrCMi4=H(1!z0%>K71N$2v1;wzMT^co%5*fgz{g)UhXlWCM|8(5S z?oeJZn8zqH+EbNYKnc`0j$tfCA4SVqOs~LT}T#*SNpQE_JokAWSR&yN8 zq~UJRUyLP~blK}|3NxVDqv)AGb*%pu7mLW*FXU$=}Ly9g=4iMBGULx2c>#Ner>uEll?#W=v93FV$w+?wCP zIJyRHe4GRSoM(V5M>$|lK=QHG2iP~0g~(fSdFHTW6pG@qJKL`8$^{LEK>qo&E=&=T zoF$R`6~=rp?G@miIEWGjsR)^Z4$ABwyddEFRxw{QxY?S|!hypXHsoeXK-GPc-T)Ap z45q`>}?aJjjqeNMv7hbY| zWMfT=fA${UbL{kIn1L>BY%wJMIs3Q)_hE_zyftuafO}qZ%pWe-+`bV6gR+D0B{3vl zfP?)Mj!)8A-a8wxTWO z;ySyRFeH&aIP)5s`l5w|nqKx^%Me~~#@Pzb0*nesHCK5utHw-2vA;`x?$ z15qCnMRAi8f+d)e_195_HUldAmw+!EoYUeJxFJePTfICAu#ohCWK#+2z<*g9lC#-> zi`^LkcXyP}>K29=`sSS?^W8WqWk-qZvCr1&kB%Zw8=%Q(v_uA#u$?a-6xKJpmZdML z&E@-`DWTB@wTz~my`VG3B`m*BY~6)t$Ft*BTuGN%1)Rj=ACu zr#k{L9a9`!fzCx@nKElsV?L3RhIIzlCc;Ns?z=+&qn0eq-AJ0%%UE#8=_Z&?tzM`D z&Xg>D8ZEjJM7<)7dZ7C9B6)hsJb7Y1A%w@zY#8_RbP_(2$SzU6+)ZJCX`AT-Gwhd7 z1lEf$6FQL6Lp4@AC8*H~b1&cM9U;J-BnM!m$C?D3@}#VUC;h8ez7v~|+xEu;n{{1! zEn~KX+wYi9`R$2x9KkuJ6RHAoIIv0|p7g=as;Xr+oy6Kx*sH)qc=#>hPpGTRL)yyy zULI7V1_K0o@t%=2w+{{UgyXcs^7hfvM4Msh4H^2VN3Rbjiz&75^kYx=>5vtE2x>7E zNYU;03K+wvQ1G2D=n_8*^CK<>!ZAN1#5|X8OD=OuE-mWi5ENLT+B7p+r6h!Y2{9I*b>gF~kx%RLzH^g|)2 zh&WF-&q`|vGGj)qR75kc2vS(5Ml$+cU+D3J%}GJr%D%d~_$0hCaE>q+yQ_frQw=Oi zN5!oO5@RR66h$UcJ^796_4n4YA|jxy3?8baqRl0wWFYHti%hMRl#-g66~H~+XeZeh6mCMx7D|#vM%e-qaJmy z$>2PdNrduba58i##n|!ghfUu|vg>CIZ`gYp#zUZ^5xK57hhLhU_}`Gm6=;h-?c?bHomJK9nlSicKoVkL~nj~XHQ>FCJY!L0IwUz`M>uh zO{wJsLo1-XcxHY8AQ?BAzq$Bvdb9CX!Ummr6?s=ACU*muXY@U<Oc40MB)&!FsJG^zjzSwvQqunQ*%{nO z8Y;`#OCYH3Q8+r%;$^#cb}m^B_K{Gb)#qEc-dM47rP|Z2N=-Shkm%stqd8_k>a3A& z;N0`+dgpQtugJPt)wCSWRCB#NoO-Zu&!J3-zT{&w63;Y{jE_R@t%4^Ofx382g7Jp$Pdx_wU;=vW{_?k-UH52(FgO zBum41BY#5&gcE+!1J!)d=dGr#DvM|rCNbS+%NiS*Wu^xXU{XfyRM~G8d7~HwQK`_H zZ$R*JHXxCOnTMk-!Nl32cIKd&hQvbPJ|sSDv{!rXs83%d-P1HkKP7FyKYmUt-)g=e zH>Wk2q3X%W*odD|AOFt4N+U7t+hlmqK%apzEnUGq zyrCY!CJ^S!!StukNE%kuSZAA5G$ETO*X8TjrkDMxlQE;ZztxB2!AZgmv8d$QH16N` z^IhC(hEOB`9{{V-8yF#0sNLXBBK@_Y?cqnGz@Zd-Zci}xG$5Ru;NE0%g4ORS8hMNi zi^L-Ub{=y9hRn<*?Y_}sU29-hzi9L-RE&Rq>nARsdXNpDm^3D4)aM){hR8&zOqxSg z=w7pR*XX+OR$g#K)>Qn!Q`p)a@;Ejp&37-JKuRn5&LR6TybOw9dLNRKrjaV}1m6=~ z_=Sryz{SAGe?@wQnYIyLFp#2q(v=2Pne4Oo9*0vXodW zmww`{e{l-^A&m6|;zR$+=YkO3psk}uSMceLGhNM9%KoLOVF4FF)u?89-?=lRrR;L`lIVoW|Y)Olt zF|qnWkPF-OP0~!cc4&}8(=0a}pVojGPA#ZPPoO<4uBxisw9VQDn5#ta-jY$Zw{0d3 z$eDXOFvjxF85_j?h@9>;vZM0HkMB+qK>bLRa4aj>HQfzwv|f_hB@dRg<^%MQ(gO~? z#VUA|MVe;5FDpuD0H(3y30sC2PCtoV=i{w z4h_gn0FoF(fp9`7A`~_FGLYh0N3?9Xx04qJ6%C>3j#CSiTMv6!<+~hwyM{&(Qo1v|KIk=(GIUhgH%y!|j1|o|9 zJM92tkx0zq;&RxsHIdbO*?wjdfg1-BuzN*@*G#_|Om;4ER!nWJc*<@)NpWFcp<5; zRhJ$^vlSS%bQqi8UiA+vC`3@tQd4?G;vT5LMDhjPBn0y6!@V|cVpTATjuIYywj+A* zAyz?CE7ZU^U4LzW(3&9&uktO7-?SAW~kmCp!UwVXnZn)kOML#LLE#rno|jg zAIfszBy9sPV;B(S*I?ptl?Qy>*9e_xjc$jWZNTyRw_?ZL0Gye!IJXuiK-O|iS^vP! z%S?}o7h$QT-Q%C>oy|*k{Vu`W2tsN<~!k^VvY7tLRPO$J^t4o9sf4^W;y;ZHn=SpY9TNXka zK-D-$QXY)=WUs<2%&gzLM4m4g%Y;g#jIzqdqCX58GL`NZA@|K8o zNewIx$)G@QV>7XmkX=o}t$k+shyFD5 z4q}GMhrpy>+)02jxoXn7Bb_NySP~*%O)Um_JSn;cm#F;lxiqkYu)AHB7F!Wyr0Z@ z%FzVA%AN>%C=3AUswhnO74Fme{xNtZghx#Kb*2f>&{1;wxG0x*ehjAp6>%*@&1N5q zV*MB|9P70NY(X*vHHJMEt~1i=PO7oJQ5eMa?q@I$!+&h?Ak~_4(_ulDGweBWW(qo~ ziMy(_Mye?K@(_J{Ea4b3jvLSgLFGf*qD7qeC_7=*(yiJA`0C~2F8eFwhP!T>()!SP zp1V_`qwu#4%Qs*e@EMwUe$(Y`LO3q-?=|4>x`CzhC`S)T#r>mew{!&R) z4J7ORD0{pa0D_!jW#>mi=uMD|x>#qPb5%3gO>jL>WFbcP{DPaCl(dh!Y>Jm(E-gCV zL0klCb9zz~w040C*ynLG6tsunsd6`YE8{WQUu9xN#rc5F3x*}dM?Tt%)69@85~4Tk zxi-xX%;YNy(~HxO(A4~*FWNdT4*RnM&L*%YqDKwTQ#=+>);TvZcwc;_+$N-!bKUsr zb%%?3MW>u}yB{e*@cH{a?~HVPtzTfJNPP1r->&-hCaD0&gLNccM6fy1hAi+zMJvKa zFCL=>W%-%L+8*G1BlJ!sr=J$_j@6#8#?Bh{kjypa3JP>Mvjx=qbk7U2GzeLPe@rZc z=Ql)SOt{bww)#f;5bP7ql>fv2$r`3xyx4;XpaUmT6%Mi#E{jzjGnICK0(oecf1se3CFh&Yd%mA23&YE(o++tk+O6bjZE+i)(BpH78)+ndzi1|;_1~#**A!xZe?}{Oz>*5(|R2{M>!}=+(SH}pwIDj1)y|=-G5#`Dn&YNVe>*Rm8SM3l zomeR_(@1uA;J+Td+Hu#ie+RR>2W3Ry!*3@w3FU(ZF z14nJyQj5q#_21^OElLsnYQaKzsKIath<5sJ}B_~zZXTW`M zdUo>lo~+)kdZFs)@16(wE?8>T`TX*Dd~GopB2E^;($&6J<gd8 z|Js)n?`uqcNjK^FxO%Lph)Q(GV&~?58F1xa?^CtbZh?zhdYdu!ZEVnOQN@X?ZYgOu zs}9mZ2ssNmPqmNTDvd1C!umImcTvZoc50KaTfDVj0lpTiXL4 z+W)0=IJHID<7oTdNml{MZFARdx3jb9Mt2(3>h)@QgLUhi5~yIB8qu3=#N#4;7?o6L zd)^-vEm~}#xhak_);zm`+*| zB_Fw6_k13}wrKHbywsxWwbw0C94gxRkJ_Bo%}&bXxI9(9KWnFK4QbYvCJ8y5#-SqtWD2oYGykf(LRQILEv1@4OL1Y>R*1Ugcsd%H=A2O|FS;c6?hST>~=M_hx0%ThU~RiJxPj|{r65Tv>%X; zak}TQew#~px}}BCNpN7nmq?ffjT*8iC3Nozn5_5S?rpNbbsw?+v6w6+37CIb!Ofa& z;4%_3_8KWz7cf%*b005pjy0cTabOL|ElobJn%y*iZLAJ^080gPreHsb>&b)sj?R$R zmWuby4Y-uZzegdpR2f!=f*8yM$(grqg7QLp5A@m6e-7G7pNQ*Z{t{9(om|iB(_k#N z0_i%5h5~}FE+T%=RlB&^;RSp8?@t#J4cf*`%$HF=u#-#k)N5yw7MhkJinqZ1JV)s* zG?}@dtkJc#upnkQ(41DzIE7uKJ_i!_=;vd8@B10wkH^p&Kt5$Aw;Z1!3xef^ML`4X zm1u}e2%1R?w6qHUT=c4Xu0D3)!s z_YWnwr^7G5K_a791rizvlXbw}vSXw^HiV0@qiOg1k;kLWkW&2V(kE3iY=*5{xq7m3 zg-7t{w4r-;nM#f74x|G^Br@BRQ%4bn%6*aw`483dhJ zEVF3Eyol6*d-R+gQo%G2tzqKgDXHjCgi&!in;Q6-MG#+nB^*o=2@Q%D%T6x@rP_^x z?~)Fdlo}LDobIs$$4Lq0U+rrp5nwfAvYtj}_thYyAn`I&GADPF7@4pJ%ne)NL1mrMt6(*e7cahwJo5N$z?=94+6TCt{)EWQoGw#!u#xl<7m>3}#{ zV&O8=Tp^ZlMRwKX6E@e6>(W9$!iOsFo}#~g4xc1}_MN0LEcbT)<(tWY+A;#h#gwW= z;knqcoBtLYz=iV`;b1U}{aTG{ zXn~4*Z6uxK0!tI&BOhsPW9@r^_EZ^V=rUqO;(ZLH^@+`HaoO*@me~{0^duWZCU7(Y zXPn8lW?|yofQ_T&BPe}#vAThrX>N#){*+KxIadJnewp-7R+IE!p6I1`1ZN200Dl@b zv}2c@9`VC)!i(}!fJ8j6Q*|W4inrkL3akZfIZChBaL?9ou&M^uN^Aa=z*3j}dHs(! z%Sdp2f71eK)8;-KnH-y_J`MD6Vgw2$sz6u4yl4X_r;SIS!i%RhovB6>tPQ!?kf=6TvcVy~^gZ%T~QXSLqgp5#dC64QFKoM6tIxLkSXt>Dy_$#bVGwg!SY}UxT^2HK|jdQmarmYWz7s#kslJZ`S z8`A&j;7idGbOpJ>Dj7#O;z+Ox3?O(ayFjQVDl9&%w)!(;)zL{Gg)%s=*X_=>7Z?`D z8hP>n3rE0>BV)4D)U@T!(P-qf0CzteByupv*n7!(F-UvETJ*`}3Q>=Qd>WGqz1pbF ziw>OHFNn;j=SYriy#d3T z-30GZGtm)f{y0aS3sz$8g~u;wExuWH5pOZc5_gN}cUETkpt3_XKb!BJoqo4f#*ld9 zVq=%O(q7xgW;@$83UJi8c;%oPgd$$cANj{&O0R`3{ zXgZ1}KX)-(wMRebz1y_>F;@rK5aXs0jFT-Q%Gl>-E?PeM-t2xl55z4dui(_2B-fvN#iMCU!<;0KeA83674JlAYX-=eD8AAfC7C-kFK0Kpr*61iaQnCE zJ#HH*_$CT+VVIe<_rp*}8bf_yW5p%Iwd|r-5!U*9(K((bXs-HkrjMX)Xfb+;U`I$9cPpHO|?zh57Sp4Wks3_Y$V{snuC4DOt#Po!=wn-^{Ds#~nI~clc5Z~)=LO4lES$Mcnap@Z_@!u`xp2hJL8v^#-+)ktvL;g$?8_I+t@j7Fw4-V5U^{a~qSwBjcBHfut zRQXPoY=4vsdYE7a`}S=G*|*HKEY{n8da-TBLu2S-d^S_ZfGNp!G&N4hWkobG22;Zn zYLbY#fB@m_@)qfItKMyD1bpSy@^rU0r6MgRgnW~G_zWTw&WI?~k}<$RbPPf~Ev!nR zU`Sv;qLK$gmFe|?lSlMg!JQ9*4apS6n@qNGU13@m*L}@8Vd*Ym*>K29%sjd@Gzg z>3bmgHILHd%hCbo4nJtw_blJfY>VBb@ok9U{NvYlC%>$+I{47*R10aN&U z{;1`b&@|IZ$+Z=}Wfej^OV#i_Ypo2^d+>RQ^qrLBAE~3ekKRzB-~O7@w$i#t`)mEI z!1Y3`E=acI)`KlURvy|-NAvrwPLNqQ=J#+NsN3K&{&8t0<7NW)P*^h6NICu;9KXEl z)HgPpYB>Y@#|cU&>%k!l;q}mMnyp-d!(~MRTbYBn^(gL*sp!iO``5HSg49pK!Wpl9 z)@hJqqendN2-&@t+~)ou{UByWaE3$PgWYmPsa>A?2s}nl{p78`C&&sIweeDpih%&2 zJZ{k==D==gSlLE2zc%6)#}-_KF=p?b7Qra;OgW#`w;VcGk{zrJw2Mc>r2gDF0=W|6 zCEqP<#VNY-X1VV-h3k%rO84wU_N+&%p>S;(5|C^xN%Ma#ni|e2rI1`z#8m>0}(@qTLS(RWi=g7ts zu1<1%nO4FJWyZ$sZ(FUp^L@te%15mKUw;|@Q~D7jJKKLmnO~~?@SoUVyPs80D2$0h zq9Z21oH*|Gx2-O`ZYPQlI7RO|16d9oYf${-Ke@Ti5 z?BPq01oLNBK8Xc4;18!{P_6?{?-Gw&Z- zj;q-{J4P3tWwstK?Uz(#vb@{AN%w?v10+^Qsb>GSEwST=Ek)?#bV%`uA8HYcv?h4J zW1*O+bg2hgj4im%xVr9*Fr(PVqd@nVT&X^5q67^pg((bDBB=NobTj8Fk2c;9i#-HT z4!xkDvT7;>^|5jqi`$)o`7#e@yt}Nh7W9cs>iJGuJJ||z!fE24H`Sr9?1qK0=@4ke z5@-%3N)#5tgXE}8eaT-+UwPjgHjUiL+ek~d6^G3VzUCKQKuFPJaVv`$1|v0-GJS z-i=wZo$#t2Ugms`3+FXSS2h|9r&=4E^L}~P($_9iAK$N*1uLmhsPjelv$gRBE>T4o zH*d$yjCCq#>R-ENB;Z{TxU2yQzh>LnFNfF4oiuF5%YVB(4fmg|^CXXG?|hm`p`_N) z1`026;@!-8j&blLB9r{`CgoErMd8y4nwlm+EDjt!eqaD6HH9HA1$A_NBaZ&Vwn||N zOXQCa@$oya<^ORD(BRglZf+`BlChkLgO@iK8I38j!9HxjnJq7Q#m>Ld)J*1{Sr> z_7$Cx0Cx@P_1>X=nWZxI)XbKM@&h-8;cTIq6_HOUa=imwJ0FPFWcC!{Qcig(f8nl# zkJ_6#EV_R~SqAJ{VBall^^pY&{MODZK>oDXQ~Lg@SoE?ZKl*Y)z@{+xFWr_UsLzWq zg}!C_x_sJvwVcbj#SDmmK|(E#0LPrU$vALiiyNaR{tH+J7u|J*%$g`_JP5MC?J*r{ z#B6Mex-G*)siw?ucsL}lmGqi0a6gLc+6tipAnQOm%>~e7O#<`I4 z1Ba`d~=^NAAlfbUnh?AdX_j^32uJPITG|9}_+0a&_Z1Sik7qf&yq;M2_sX_V99TQAP*M-FeAmc-`Jqm=7_;=f0?Cco^R zf`GV2_LcVk`oSs^CG01jsOmfI8Kz3e^%6Kzo!!SxKlK{Q?x<70ne`y_p7;69i=^R1 zzk_!h?hACPS)t+OX6}&FZ+hG^Lrig|Rv$VcYKTTtIu9|}wTr3=Ulp45L%NjLc?tZQ zfvmG+3J6101S*3E0vXE$3Zhp85*$S!bHftw5BeS1?g;`&4+e(N2w=R@36clqqZbl) zwuji8E@KtE~J1({o`rxm0Q##<;z;?dJ)AMSw zJeL9`hV{`GM{>g+vF!ZdgVxnSh%_yqeaNA~E2<`vnx9!_*3=f^I28ZBRD+ZUCLytB z>FDYGerg!6Ai1Bv);d7n;@dhP_p^hG;%sgqV2e|C+qZ73i zV~%|+z~4i=-J2vS0{_V;Bmwbx|nf9$D8KH*Oo>r$OyOq$Oe`?pici~5@OXw#N z+`XPn<3X8RjBkOU>r9v}{fsxU?f7e+x@)Nmj?R}Y=0;!=0 zwn=dVCK;US8&h7q7={w-@YCUw!L$8shSk3$+$q_%1iLWE%-Um7Yt8UJa^B@i_* z)Iy#;!%`q*jF74!Ld+ouvpeSRudnf!Q!h2MySj?k$b_ z+rcP6SQ7^YwJQYSO;31eniF((pG-7MuzOe%l;o9V@EJkips98L?GQA9?L=tTydJM& ztVgx>hk~-R57YIMFJRq{)OJ_PXK7{PGC_WFLA(`rUPZ zsO^Sll7bCLhOBl&xFG( zP_%NYP(sc5jrPxgq8qgtFk(M2Fifb6V*goGE9|apSfE)*j$`(}I$?WVdqzOJ+Gy^< zU}j8OQ}0anygGwR#SWKjz)XL%E3~*otzJ-Xd9$C3E4%1-Lk5*6gb&H3I}3QNfClqA z_w9woai9~yDoDr=A87tqZ1|3R+1D2X=88K*4>Y6MY6I2+)#O zmZd&ZN|AO1 zzL|Kb0P<_%HuVaawIo0-U+Hqj7kK+RM}qi48a8(mof;V2-RD(CA8~ zng)E9c*#V2S(A?)UZifF(!V>D48X=7CtnR8wpn{_(fSBu;cq_ez3?4GW15-^q9`UV zeBgT`Aa2Xn{OUc#q5~bF5VqqgtIbdrgn z%b}C0jgHs%ue{t}0n5N{hhEYa$9!WE3TnT7;e>`K%Vk@r5UT@6(f`L^NCChdUfkY!RW8)Bft5zzPS|a0fsk;vsEx6q6$(5*IJY^me<_r%6 zyhwsN7#y*EJ))`R3Mg+!!`YPj>McF8A6wB;EHVoGe4 z<32YQG+~npC3V__=-mr|j(j@m9Mo|rW7z>}F!o>APIk!PI;d{KU=f!g$5kl-@>kP8 zSev9Fy~u^eGJvy1D6?>ibRg?Hil8vjWwyz60?cqxLbap3U_#_{<8{}paOP~7%=WJ$ z)V|BPAUO)6M)*yLh(d6~oR}rO_<{@X-$m~g6SsXJI0g)Vo?MEtCJAb|k}yOoVv8upC>jKXt4x&;3L%*w|H)VYpK!K^ zJtoV3@+D{O#6gc07BmSyri-haG$28Qaf4YI&1_LJZ(U4X{MDpLAwjxBzO|Uo4`fz*~|cp_vslb;+6`>Q%o;+x*d{&gbq1& zJKF1J%a&8z3o4re=(4bftFL6dg5;ryu;_{YVfZzB(s()tS0)K;1(A#HFc37PV?@eG zxZ92UgFV2K5l<`0=&Zuo82*Z!b14l{pQolCn(2(y@e60(rOOA2eZqo9O)jR3z1tq$ zWLGYFJ*^8xCyrVb?nqfmklOv7+YA1*qr{sxW49N(Av)mpiv=-tJA2-2=ZZplkXW~K`~NNslx8}-OUG??sErMxjJ zZvoPH1&<5$XI07kGQ^h%YS;v&&iqyjsu_l1Z#?MQS*4|MMNLYmpG7nX4!Y!dEsvycMyPJBym^?J{d?TV?ykE5&Gn51Ib zslm<~5O=lvOF?)n&AZpmgMkdn*Z!Rx!@kg%8Ypm4-UHn$(1D?twnaT^PcaQuj7~;->;9;_l`@gKV5;eXx>5=a6lCfJpmgam@Urr zjZ~0JhfC6zXRrs5&owGYlh^s8%b#YuD6@Yk?N1-$(^H+rI zIy$c^HtU1Jo4wTy341Y=AJ359cpumG>Ry1IZ0Y}alKE{9Xdi|30DtPvMtzc6A#kSh zST{O#U<)-cmlwY>HLKuH6r;Be_kjz#Q)Ts(=y^Lt+xOLNa^mCO)%%PYm(<~F$#URK zku3~%tAsmk>HQP|>&?eAKK}jbDfw6veOa2Sqb!K4LT@1 zdUYLDH7bL2z9z}((mnbPbR()es={kBHl}KJJ`wzGj>`Yr2Z#NCBEfUA|HmS*N#!R7 zoei<;{}zFe)FG(+!bi!?YX%Vpa|T48LZ&4^MCByAg?&sYxPD=@7a2l5vn`6qjJ zM^hQ><9wzx1vex0fXdp3%8)At@`_O}zCIjt||7w`6VmT}+9Q{Fa_mNFLy3$k_qct)RkmX@&J)A^b}G|jGJ2U z?RY4alvzIpft)+!5|s0GF#n_<*YduYy*O-DdbB+}%>BAjP! zvhub@%t}1GmZFe4Ry2|=@DiguAH)kaa=B}Z6yXq%LV5q*m=B+;A`@P9IMdvZ;ae;v z4)`hZg~wfC&757<`{hv2ey?-gy^gj!dTx;!@_D_X%cTSu|A8wCKZcFNi^pk1Z<)}s zPpp9>(Q8^VUV%b94TUTX;h|0w9;!8h47hDqU?z20Hxb$wRDh3PaL^kD+6+qhuie2B zH)SPeUZOXBAY<)u8TFzn&%jf?wH`o%)xPUuv={CSLYO8p5~<^m87U=*`jr+*ih$>R zIgDC?60f6d17ALz06xxF*hf#E5#_m9OY?1OedU{y78z}i3*_HGRmy;)HdR)>)+|mu zJU9~BVGW1NeY}H)AYlHkoP_Tn@fyTJnq`T4zI*dB9zaR#z-_d_>;ZyS=EUNCk@*Bu ztp)!;DxF9ueVdf+#fz5;#5p@01#Q4^25D(e(aAf#Z;TtZ$RWV%u@s{dpY?aTCcaFe zpR&gZTcZ@sM+=#5>hD@8$&LWFfygw#5|1BJPr1KDKB#r`}-;tbM|3N z^~m|8Uvrka=W`E&bx-Nq`b?6Hv={GZGJs0T+MR`?~HFgN|ga zDsD`Fv^omHsnq+DxTzoL=F-Bh+q0zi#ke1|E%oUCoq_`x%b5Hz%@YqY!+Eq!GOMp= zOj1U*MqG2qnVppPd%8oY)L~@Zl;Z00X-pTfTvf+gdkE71;@pSX72oFYR^k?cwZZ%n z2slq80gQFlhmnVZ;|wBW=_j=fAdBD@x(qf&me^g7bX&hiKjB}x5!zcubH|Mwmp2$n z2|x;a7k@6S#c!U&>#fYeHlDxbRiz)L?OKJF5c(|HV`nLz1RH5N9uFmCA(qSkhGA>a z4u*H>tJ%NjNJ|!k>ihe-<_-#(EZa}{h9&!4m1br6QP!6^$&k8kd1hYKiOQ+f`^QY`@XjVwjB}+^N7h{ZaLhFVEM~~Ar)2a=~FG6HJ%FT^wn%ETTLsq<9 zuiqJl;EY4GF|zQFMlf|W4zhdk%Z3SpUAn?oEy`tZ6;5G>6F@jq4~%j zj}O2XmyaBZ{LYw30j68;en;P@Hpop531eNcU`iYr#F4q;nwXQNB+XrH6nxhH5_>Dg z9f0VqnPOoI1#40xij}Wai{n1b-mJAhm=51GZy)Ct*WT8@d<$nA>F)ZGJVl3=g^fhS zlz&nmjxX*QW(l5VBR!ni$_ZAOGJ`;VWtSHaF1c(PMbM-z6NaKU0X$R7p$#yh^3fEH z>mt>xXEUek%C-$cP-g)SF)$aZOwWCL0^lPr>yzp#vf2YY`b3&^q_ExG|4 z54k*(@WFYXqk%_}Y1#YC(URbemtWSR(o8kF?t*pcPe>7_Dj1v^Bl*@ouk^i)CdCV$ zR!K^o_;SRR<$?6l);ZNK<=M;XySnhWHsa#GD{ZRqRn@i^1C78}H|vY;JD4@pk9nl)i4y~}ABc5F@TV$USSNd5Q9;!uog zW}y~eX_cKcNau6P(%^1y`Gf$y+GfI7o6)Nl;871D)`Wa?JQyex*fuvnCx4~O2s&Ml z8yIDl55SuSIyShOQw*E~(tj5~x(uAX09j9CY+eexF-1Si@~Z)Ho!Y$zC;7GCcOJ z|1Y@$s{Jzo#qp&KVQ+A-V~f(98>TJ^g8VdSHbY+r$88!ip#$vEMicBwA2W^vhSDEl zmNRGR{)X5DkEY>!KBV+Nzu6rGWhwp*#s>h)*5n#n&eSbenunpuhEc*t4o-smP( zbE-RV4aloQON`Iwk**SbU-N$})*Sy6rIU$~iQ)eZ@;OwOirHsF?!K;Jcp`x$7WI-$ z=aiXGf2&?)`dFsw)lMYV>S&+!%tTktB&2DzD*FsZ+&Q z^-AjH@0JArkW)F-e_Xmen?NuaLP;j))ZMaC<d;6>0-g$7ow5Jh>Av!V+z zcm0jhYx^VnfT5}R0I=+!--Mc0B%5lz%A>Hqt1h?JTGG~CEYcnsJ}KQ`wZ?Z% zP>bi2jn)TfIg%S7Pz^2ZwYC(HiRiLAZ`KHQk`OW*^U_cn`Ak8?;eWtt}#$hU^J3C6sKJTJJwt z!xzlKDuQGZITknC0r->!wJ1$gWc+q)Q04{ZIxW#^NX$384HoR zUKr}!W>#^~#pIU0{GM!#E0Yxuqw{p_dT{k1=Byh2PnG(`V<|L;umv+j$oyp|dJ*ue zrbd&|-E5j(>7`ciBfv_9r?UJj?Gf$%9ErmiS-N_q=0xyanhRnege+A27EA>wXU;zs z)cdzgWAwb;(=EmK;onHvyZkSxOn4Zay*7<=c2}hn<1&=~*mWT2 zbLL@!d66Q6MRHN)c1&X&j!A=_wb-FV1FXVdg}9){c352q>jD&H_oifsls%C~9Of@( zO~^DjztRSdHlt62?V_rzL0eI%!mXCBfdUEXNqVUgaQ?nmuYqa-sHvw5nds$}`rX)~ z&GBk)a=jm*V3c@K}Sq=2W7eI3Pp?}Yo09m@wKTde9p(|xq?%t zq4?=GcAA9TPb9Bof}R>Ufrwqwu#WfJbH&CMfblYMvNQuOG52LC9>AJQ8oM?$^$KET zk@XDG=WI-(85~Rbs^h4i#X(0)tFCi6H(qGQ?`d7o`Q}26f^)D-AzUgiLHk{K4<}67 zLd{Smvv=`)fsFIC?bwuIWDocJIFERX_Gu6Er+sdCB-jo7jOlI!m}pqZ67Q+_tyfwX zJAM%bfhNp^6&<)qA2^+%9LOsPkX49E^GsxcQkz2uPhoar#2uxh$i(COakG-y+MVf1 ziliqifmq=}$1DXM8<%tbw!&B49*C~r!;LBlmXj0E^v&iuW1i?XUHTQRdD3!A6vTMC zL`=fVEhNi|>&iT3b6J>GK~^FFENvW%qC**?REinz$XM8!T^(up6q8_DhYPLBy^G^S zsLXwuzpkHomW5-A6wVShQS>$h6ZZG~S@8EU;>X#LkZ`&sPsXo?$uGA631}Wc=??#K za{zsoHMJ@F#p--RHExpNuNUwzLw+^-{2esjdZbX?%9nw@(kEWHRzz8?70c-c(H5TY zLZzazWNqck!0jzw8oj#F2FANEpgd;`Wd!Gi{NsS9g^1c66hS=7fBsF*|E8d=P?)l( zQ-2cjT6}OOb2%2VG(g}9i%|fvFNX#Jg?;<`GBO;j((1`{_e4rJ`jUFGLBLQ6ap^os zPnb?FujC&X{^QYNV(4uNA^aSi2^_q=dRLFeC3Irn483;eS4x~GDSYv;xY zl8#&cA-HBARRJty|3IEoviSBL}T9QXPFVUlnzsmGZsVtN|eMBoOGJ9M|S(JObXol zBD(?Fber%*l(b*w3G_7zYi8?+`%+?UaDy|P^2;%8n;zF>CtD9_l}w zG4}e-UVF}w@6aeTPHGiEE_*wR35Is%HWQo>xAs43rwp8~1kC7buc!U_^xG#+)QNxE z60wKdASSH%+i7X||I#*k8#Xe@L`>OgZ3j5lp1WHFV5LD$pB3GUD}AcO#59%k!Rwrc zBF@~&B+R^Cm;2_c)?GZl=6od-U}%*6&#v^Z=-tD-gk5D ze$vZpTQrpO=d)$Y98&$dVW1&};dOt4a$4U9k_9;k=sv`8+F{&UhfViXbi}O;7bZCn z=%tJY#vK^}_nICn!963GqBiv@x_PwZ<+88PYBy$?FVVOXbkYrSK;1fbw9<4x4J*0v zk4ZJuqZ;eo4vJnL`If5+TDYQk;s@=Y*{;g49EHO)6FE|p=MMJfS?IN^|Df%=TipG4 z`OC(&W&5m(rJiw4y0#et7*nQ&z1`U)DF6om$q?WfU_m(aR1zkUOj^H<*X-$Qm_G23 z&0p-&+eo#40C=7En5XQ=m30L zEhI1OprK`M%R1pEWdrzgdb;*Te2&x}+W8e!SRA9tIYcMGP}A(6Tmiq}F2Hx!^T*QT18!+5HIlv=gTIk3^* zTVev&9)mRhQkaCq*6ptD@JV>-a&!VTu{#0V%^@q;Wn`-m*%N(N^~7nM2A zcUYN9t^~wT44F?o-@gjezbp)Wf4Egr%V*(EtUp@iogw8A_Lf}43`b^v{sg(SvZ)XPf4Tj zfNdgeS}9bV9wphlbaR|~gb2YLham71LRY?{0gt7g0jFQ6A5foOKPC}r@C%o{1uYX{ z32C|+s#P2&kSbvPiG}qZ8K|{-VO5`OE6C=c#I?MOHoNK$53x;afoA?0112+4NFi0# zZ(q_VxD$`7)eGhX!7-v}o^-3EF)JwXVWE#BP21O~I{Nr{PfKAo-kfgoYYMl#I2>w} zvvi-)GIh?}rsQG$U+J3wez$f9x60}!ssW&bzugR>dO041Vl}Cw4;K7*ZpEJyX+OB7 zGHjujU``NLzMivnw3*O}ZzXs$4n??^+z7F1HA~{M8?3J~z#Lkyu!&E`^LvEG+vMVN z2Mx|uEwuoA2}Zt{rxDN68*K5Mm$PqxusJ|P&h3v)kHWV@*S6M#{(bbrSrc_(m-7P} zFv8AR5A^+O^D8r{6Ep42bTFW^egH;hf3tKLgfW1+V)TbrhS-s6H-zg}h5##vg5iI= zl84H&VJLk)Y>^WcMR<&W5pz@fR{r-Ut!w_(fSo$n2=g-;uo4aV5`PMclu#sh{-ED; z4{F+`$o6fTL&byd-!>N$q-82AkAF%~6@VV9s>o{wF)tzPAfYxTiZL)f`2%?YIAFG} z|Gf+jnSkepIQ1bq$>`K^tp)(kE(w8byxV@l<*GOK>cfZAksgO zs@pA!E;N?T#W!n|E3{xmmTDDT<&TGyLO&E$061;|R&BXmfGO823hR|Gj?~-A#$Ms# zS9>)^Rk&w9cm0MCwmNrf=HD}xux+hYK!jqUl2qiKQ;tV)B z7h}53+}(bEMLK&RkNVZGHu=f;&8Flro>tydGs1_K(FQ?dQmA3BX4&f2AFPXFm1gnX zvof9dcF`iIJMG)lHvCa!WlD&t9;too_A#aZ^Qb?E3n2Jk)5HIS*<<8j{15tWm4>v_ z?>6fHw(S=4Ooc#h#2uwFS`*~RvleaXCE@;wj#-l^9SuaUf4^S;KCs&ptJpBTL=ZsG zJ9d0O0226-k`-Q!!++C5!iCNKmg@au0Qo;8aa`$YHOK}?{9on6u>A9iM3VdWb z4o0!w4UUifsiO-~vLJ~EOH45S&No(=?wXd3_Wn8jD`R{^F_Vu6670*)sVX8|wv$@)1U6M<-OniU#_^V{ z&?5SjUI9r?8V><-a4pVIPg_n4VtUb5OCTebD{{qh<)r;BaCn=_GiYvA6kvIn;^g(# z*>bu?`uCg7wfCV73taH6Gp#n#{Cxo`96F=2 z)ImkWv*i^X*;BK1!#iw0yAQlblf1FdEI@vqIlg2P(55U9A|?(x+z!)h$CiBs5WNOQ zcO7Rh=!&(M$r)iO4o3}yGFkG7ubTTzt0LrT;@cYK;tdrf(8 z?wQTnBI>-Py*xSbLW&7M-r9^Ra&08A>RDc_eSbhNsd)fLKS1OeZN!Tp`UKs$uUnlz z2xi4dD20AzH3tQA1a^43F&YZ88^P`6yG0>$es6B==Y}V{;|K3p1fnSz*1O!^FZq_Y zYc?V5KneK>z#c3L0ve)Af3lo9{5L2g(t+t266hSjw<51q%e2#0bW?vu$=aQFhYy(G znHfszy0ANV!ZQ&}u;0xw?cgupuphk_Pq^OAjRsg$Fr0$^Y6@Ar5FcPUmeGxfjay7r z-myKIcOFGQtl1#tv))?OSq}YH*$lp3yu0$5Id!w>WY*p5L)=C)MHtcrulma?!;*fB zx5#O`rW2bUmSWfPf<5F{hFAVFt=hA4GqononF|>JY;68 z5S(1vx~rp*F_wXk*|ZSR800g}ki^DnnBXRFI+4$L0<7eZ4no<~kO8+MNeS~`;Dn6v z^0)CB4JKLp#4Md7YP*Q8^x`6eIrcr?93-gw$JcSb>7hZvwXCM`VR~p+F3RsRKBH{# zIBLF>?cHVT8tita6(Pd~5wA$vEGpXUe=3VtSw*qE8Wa{e9~JCd_{;aeFIL&r9-96M zVI}Hko-kd*FzU!5ZCosQ*GLsMkVoM3sKcG*1rH#DwL*FJ(7~+xwrnI0&F37Z+I>2B zYF6I+E(|So8#l1!10t{ZEZ}f!S%nl@7|%Zzc)xk=fT`@!HM*f$WsIN~0A&=t3IeqI zS(Jc>FVo{_mDxi;a0t#h-P0uQo|><5Qb>xkv=Aq@ruzfito5*limq3b6{Nf4=k7vz z=`(m{5dQ>r3fi_+pBHN&@wm)Ao)<$bINeWSg!m_tXoWjOdR;Q+ajJS;@=Um1$L2kT zm8o*>j8Gdb0!AYDW{dJdKo^ZH0(XHaoIF4Tz83{&9mc8WJY3l_TWXShmH5MjW&FBa z{PJO^P*Ny|BBjpqW)>DM;ao7ZI)!uGG{~-tbZ8$-aSP@1AITNHJL^Bx#l@uq{xB;F z2#}N#4prUDYEM!bbOD7nB%@=%AK9BeY#}y&1%w<-KAZ^h&amoeqvmuloL`?aP!LV- z(b;YIVx#wrYk%6K+UgBQpj}7f*ZH$}-{&0)(%X-bxUJ8h!m-}K!F8cD=wC(w`e4=^ z@4^-wDEQgfQS{s{soskNosBcaZIaFda4q`1ItN)KTaPHmR>DZLjhWoDdFNzZ=DF{- zC8M-cInfOUEFi0dg74PcReBzL%E$<|`S3iRP1x@f z&Mx9`Ruat_og~a6f`^OU_rzP~p0Q67j-MkA#P{J(gS=jKf|;E}fK#DkaKe*GKqQEA zp+;O~#lvHXjR%Hv%Q!_5<=%`srZJ7rR%Mt>%|*4%^LljXQs~nRG`U@X#Pwa=YVl0*OeQ}gvySjoFn8~&o|7Eo~^n{Y*8e`DTjx(NuN!`umqv!>1IVMIFryhk0H6x^F(A5QiY9XXv%*bf^}%Ja%8)>R(&0M zdnyI5S;THrR53~6Tj$7s{TBH&k5({w;d0MtD1n+vmV-nlSe8kimMFm#e`#kHl(9y7 zli)^|gSMvz0tusr3Tl*ptLEZakYVV?tZrw0ZngDvWUIu0gat7+`7OKDW_OQBXMc>} zHQdHl%Irb950FHxBrw09nU|?}@Ry-zb5a^+@Jh!j%4lB%C_RT&=J>!)FX z^JeRFUwD5Z=xn{_ENtuXEz`}vo5$laVUG)F2&>VXNO8+4*9}xr7?Ez&N&q6-fIern z9c}mdy5Fl&U8;1@=acYyTdi2RUBa8}C1@~Gr9ebojQSFus`?pj<~>C#KJc~zj3p=A z8`E|-O|G`z4l6AQ1w$6%cE;O(!fJOX5WV5B8o+=s;)X%SL7%NIQW=8X`@RC4wyf7x z!HVC2&8sru_ClEx3`IRDYMfabFvS&kyJ{247ix;$H{tb~8cOw$98`GFx@J3ulg-g-=j;+$l&N3x_5i!Sw*rSpYC6tZi4l(3HE+F)~eN?!RL zwNZkDg-q{of(e^J5G4!+mE6E6v!@BB7CZ=9ZXJ9%*|34T@P(iOgR2PW{%-HEP_ObO z=8y;Fl^_mxUfZ@ssQ}32QXKcabg_l?F#2gN2rJPo_-y?PoQp-LWC_f|RxQd1JgKrd zn>>WIo>{1mM1$5O;OQG}x$47!dScB-9)Xycjm92oDC^>m!0AjP5`t1*i0e1f^hgO| z8YHA^Nn$_GFi{xD_At4s78Aykq3}d!+ptj{Ti8*9l7e#P`!X)SimM@}3-lxl;*jF* z=3$@p__)95M?n@=$iqV-R^gB#8$_f8A&%qMija-bK%*c*^{PZk(PA_~QK%E=Iv#$1 z6H%fnr0}Wa8Yz>A7AWjBJVKvHDoqq9YnOWgr|1cWY`E|<_*QVG^D}s#mra^$3?3kG zP^e2k`uBFwt=@e}p&+QF?@AU`@ZBIxj{+zp_yMeIW;Mf-n{*JRB7nZAY`hl?~I>vK<7CPd8pDC0d5_L7n8*zVxK5~s_LqjBc~4VR#fm> z91n3MU)D5A%T$rII^-jHGBvY+3k8n!9%6)f)siyTn3^-KvxSs`Y{7lOaTC$%a?Dof4&j!iM{-I zCP3fhbC&o%KL|b#Y9c&_qDr@?hRAn3`|+q$F?h@Pzdpfae0<-qAQYMjlFq1xmz(V$ zCroKdbd!eSzMY+~3@|^dmyhPYI;~HQC-8KiEjr^kdbN=*i)12gnB;SIJ5Idh-ZgjU zOZjlsKF8|QN?R-acyGo>0UG7&SsD881{(k1ck_3<9v6@&m1L3#k6|TB+9G4+FYEU1 z%7eUh>=r*VuXJY8M&$b*ldwXG&3g%0jX8o@)_8m0_;xpqFr!ISGs)~e0y7@st{2m? zH=|%btynez4Kf;8-n|ZlJruS-wgcUk(ZaEU3LbiYTISc9M(9LD?GcoBq)c=}JoZ2* zpj;YcY?vEs28D3!}!VMWd@JFxeK!;+=aMs16q ztTsTFXh5XnKiSyz<#7;yW*^>7N>)l+_WRFH^5~o({=sDGoieUYzg&wAp_;n{v3y%6nL>Vq#TB>z*hhR{>OUW4RvBrfpYYrQAx1 z??t>5#2vk^s-%mr+_$4HO3a7_?P0t$)CNXXvM2G&EyQbp}MXgiA6 zlV;mFu%nY?KpcjY$DZqaH_ryv_G*U<(GKm53vU92-=H%Q(?-&)b#>UIUP4$yeH3 z5Qa^v^`e{pp^s{p#bS*UyVoxCxLwvz&xra*LE1)7W-zz zb%A>2_e4cgee4g{kYSx7YfYY&ngSU_PT(?a26_0+xHn%(F#~w``OQ*{aC!Q!i7-)~T(D zU$B0C!CjTxIhw}z-AZ02Szc8aRyxkJIyAZ2uO4&-XR{d<1$NNsz%Y?#p9q*iT?W_F z8g1B9n7&5tF$l+agMrSA%*MiVm}FW_mQ|&>cHfm5MzsMpIeaj!#s10Agl4+7CctM$ zeV}eI{M&?EncQJ#_HXgUy6qvafl^i-$q}DPHk`(tOldvz7|Kg((rAdkHeVm37X`g> z5n3d91#V5NC3L=GoLZ!%lXRM!w8=uFt*eldU|Wa`D5CZ9r6o!cS610u7h~b}N4uT) zQ1J>d1;hy|veZ8XOB(_f)LO)Ru-Dhh8!CwUR6Be=8G(d>xHAxO-=Hu=DPb8KS%#DG zfU-^TebwQk6(jF*&lzz*kAR_TTWr~Zj)TZsEeM#PSXIZJ00o*8fNB0 z{}cx1Fw@;84_QDcoIh52v^ri4G?5ozBScsb;i`LcYwO6I%!!d}%tJM75@;-pMr1BD z`L42ILp}SHfwaObWH0n?)axe{nn1RI`tw5Fxpi?UInCT_2Q}j>0T87RIVg*{>mKuT z3Ws05$4|&be#O+7;(AgbJ|=rEQD2)C-dA3Bk}9;S$x*MzzbmQak_C<*@yJl`W*tO3 z-1hopl{{x42*Sc@n7?suee@MnWdcpy{t8djTB3wV15S$|XJz|HB6~O^5%Q77Z6hsQ%IZhRuJo@#L->6R?%i9K zaX484wgJjBs1X-t!N<^Vm{Laf<6T!GjoLER%=k~sxD7^g@VXn;ia_4|`ydKV z(*Af;@6I^p67Jw&e8~z@-pyiyQfRVs7)d5)oTuOe437!nMxw67&(y82NY9a~@oSD8 z7YKkJH!!z(v0J)pxq2S$tBtnPv!Y=c#jT)WFp(YsdH!B}th8KPCuDf*7+C=0uAi7m z;v1PJF~eFpa9HLb?Qr4QLb9`b9H+x27ZSdmKv=zX{VlwdELM6Z@{0_bG3v9s*@D1r zqM9p-@|8UE9tlbv7> z9_}81Fu$gRA8UF(;lDOVJpb#+|DSj)OpF}=L4Ewy&c$rB|6kemtui4nVvKvjU?H!- zysbY9xM(EJyW=yDIcYVmO0tgbKE`Rx4Gew#;e3ajeuV5YlB}ccjyLn6?RQgN28iz| znei?CT4Lx_$;gy^&RPhW2x){Zo<1APj)Gj`=$YJq|?Ko3hrh8{tDC{(E ztDfdv?M2sX_Sj?d`}s8`DmT862NbhajnY=k?_I`W0)!;je|07zn1~bA^g8EB;rYp- zvg7&7tHrWNtv=iWY@$`QA{C6+Urk2zy@QTi$6S8|E=e|D2|ch`SX6th?!;#DULs|y z&qvwiE6*M*^>0eGn^p8k_eMR-yB>aoBD)#Rbb&+7l^XEnyqa9_^$^^1yLl!WYnTAD zf}LDxq1a7()j3jgMWt|#;{940^)JEa9|Tz@aUYyy0g@kP8sLk)B*nz$rF1%V?5b%bm+~{-s-7gG^#!&aTth+b+5H| zPJZ4Tmh-Qpr+Z-XwRCsGng-)i(jcYGKsgSz}^W1 zhd^i7r^5|9|6<3NIsV2pFUnLIN5{=flWpg&@4VdJ$(U@_)=8Ny*2iMkzu16d#g?tc zjgFxYBX7~X1m!PLc6Dwqr<|^)X-c18oZA~9%kNhV-0m43s# zxdPP#NMD1vg&)fGGsbK!gn4*TWMd>=8(bIw6`mt% zc&vD|b@%2g+Ctgsza`oLHnWdlQq611RB_?(hv)WmtgW5A)qxkK3@Bp>ES3)~VCvmo z-RSrBo8n=_7loTkx?3H0%PTKs9)CH(C4drTG0Ak#c)S^L5@&q9x_&_N07w2g6v)Cm zn)$jUBn35~R>!mDMMKbddhGgo(4$ANaxZh6?YIWw8 z(u2Krc}5Ll{%gh9LTXU98q;lVmyBLQdPO8@fsY^41&p+>~dUjo{j;gFF6htsEAGY)2SDyY7cWTwo=YVm}a>ivGZ zZ2GWdVu$wypA0E>ROkiLd2TSZ)|jd2XeQFj^vgBd$qohZpz^qgk+uAr1buFEy|dVX z?aLn}+;0sBRy> z?>uyv)56&kCkI0za>G>eboltL&wrCbq40ui?q2wyh)M`guqIVqB5~h$!3LD$bZmI$g z`@7g&J3_RZ+DAYN-!&YFi(fN?OWfbYaoI9$E^n6bOO74)Ts;Kn?6WUiB({;M*|!f| zr=3H1b>=W@UqSJ_!FHYQcwH62I;Fpt5q5PgiL=u5RV8gUXQj6aL1r9X8Bybo=iuB1 z`BK5g7#JFiiUto+8f$w`!>4eaj5rLFxT{2J`nH*MVW}N8 z?Ctoo7}!Ue2e+;ZBbs`>PNB3v#mw#W5O;5!$l^@ryFZ+}B>+t`k05tZtf2(u|L2H0? zC%&cAXOK;{RB*HWASG6BS= zKB1Xm;V4gN$+wHDG>9IH2E73-;|)7fj8RvP)rG-3EahT;6AWdlsREf#v^IVCq!(n7 z%PwjsL-AM@Ry;tK#2c|FNicECt$UaIKr`7d$AL^8t|92cE?lV87%ZRP{#L`e`&ubp zbjjIzQeUaRFbyI5_UBFE{GS$W>#4k zwBl}4vRL$QVK^|jXh46)bKf(t`r$QGvP6<_l}#>x_sOJep=)aet><6#E`xs-8!Qo5K5D}_UauI6Ur6*YCkQ9 zKFMrockCPAkB1HRizo!5iuQF_-_JL7_E)E#ofq6_ljoFWoXxG9kEamywdYp5cGj7O zIjJrCh zjm97TGa0WqDc(<7vhov}f{ml5ca1ZLUxV zxd1is-)t^SLlSW*+XlxI-(WGbH!_x>lHoK-IUi@;S?5hypPm~B47qpCY}eg|YBa2d z5nhxw>}&(bp1>~Vqz8w)vaR+?tq35M7bo}%)=gg;TdZdf6#WN>*ta~l0nHuUZkfe! z&G8E@?42rwxk!uE;Re$hONOWLYDzhJ@rZN>dr|x|(~rI^O{~`Yrk=BF=c0ljuwFmw z{}2q96ztv)+&QB4OOiv_9nq5Iyzs%F9LCMAM+7BBYS^V7Ds3lS%>|VM*4)QbpRb?V zQP%1v#SQ@a|I)4=+nHl^=!w8IS*MktPD2Yl*r)mlffOq!A(yX- zJ|A%A-EU%=^|NUOx<1jg#~){WfD)6M(XSQ5rap-Yt=H{SMx0P=uS0(}bzPJrGRYt< z6Vi)FkPwKCBR?)r*|=;*(IqZ~lg>y|5`DH)xEh$NzjR1fW(Io%vT!nT`#o_JRS_j-5=Pow@~e+RR4Y*}agG6(^VTTT zYBEs&v8L{n^1NeV&PH;(7vRj~huCUydx_Ti`|E7|z^mbFONwP9U8bT4GV)l{@>dXC z(#Ir!GOS7*%A;-#G2~tcPnD;!v7F=oWCo$Ha1f*%D+5S^-i21vQx+X2Y+8c**0K;f zPLuBvU4}8PWLB)`R#4?_cWpW|a?4kv8P^VhY`jCFiGo?)z0Y%N^L!I|-Oua>U! zfC$4*VO5Z|T|Bw6_hyczWh4uGM{654(80d=?er8GqH>F~^EHp(RX{Fws}*~S;W4nz zf2^K8D?#b1Q-|c_7;1zG8cMK(Z}kWKgT&rD74Fs>C-dv{(z))^o&v?=wo?Rx(m*W! zM349pa3)kzcP3%*=Xj$~X00H_h`UW7jrK!J|DVzDjWI&FIh9ohYDIn#B^RkJW~{ahPMc1<>D zMwT%#urDsr)38xyBph{LmsZ)2a&7PfxdwnYql+|uH>;;pz zRTs_P+?92Gx3x+kbhoVMxi86uJ%wb$`{tunQ%C`<4@L7!`c}vqL29!~00|XT1qU^{ zl-Q+As7!F`H==YL<`R4>a&w1*%dtiUu%S`)7oiY7iE6BSF%flx_vM+!CT4RF1*^}$ zsTBn~_TVfW925tcHfsV46k4}i&{!J)}zpcx@z zc)po33ojbj{G7~*rJ^dQXeN;jg_a9_U5}9c4LN)IW#}xA(>FnTfxTJP3|tRFr4%dc z7u-?zqSfO-6ESFrMIhoZzImdr2vz`RlBN3;U`d0x`3eyk3uC zEAz3GMK%HksvqLp5IVa&lzFGIqYdtR9*6H1H>0x{_-5Kmwn$ZQN_7_m&n3|rKIEi9 z?XJTDjsd@E6a^afc{ooYIkgu`@@$usU>$?zwGyIjDNUFHb?{iJKNL}Trm<$m^~&4J z%xIRET13FB`!bdezu&ajlY?3FpsWd_JM00C0&v?WJ@FU0@E?~;S<^S+;`(Hnes1rS8nJ>GL7;iDH92j z;Nz59I{S6pC58byR+>iAw|6A%;Rb}kY76B)HC0g;t$67IZI%2iw!~9a07)X* zgPiSc@SvNz&X7k@92NkC6d_h2ag0|qH1L}pXa=QXq1m&e8i+h^R~*P&_(g2NLFY7J zf+NZT!m^J@Z=vhD6cs$5_q1bd0&?=l9*IDmX>`CK+LKy9^v1=~T!JqpmTQl3&=eeu zOrX{hE5B~;g{-M^*Jwlw3{s3aRdl^9x@j$ zOP|6Ret>vL^3Q?n+M%6AIy>IGQOa_c56f%~UUfsJ+$^TTw`<9ujt0KQrJ$qSKZOU5 zJ+xQ==DJfONMRDT&i$8e3(*gP>x?=^lId|4;GEt&rkLxazP2m0GghylIe!%A*D+`7 zU0#@oG(Mj|GmW`N&Z za~|u|Uq6{w>6y_1rMlAIctNdlUKN80nLXn(>3()7GOF0zqqVqXki$*laJr?v07rZj zW|H?@p9mmbYr0qK0uZX_re=m%6!6C&&!ac145-W+P@}eX{mP2h)c7b9_(c&gAT;aS zv6M>~e*0h4UfYdU#<;Xi-x+r%EVv`z6otc4=1qMA@+c&kxgc?i9I(D&5UqlY5VoR7 zoflLC)dx6_#lD3wc^rVgGYtzTx86L4$U(zjg%lx0Ysx3%gK166ubQTs(dY1gT0hl_Sz?XSSMyqHt6qrPb9&oOZIEjD@geX%&h3m zAgywBu3q3bN+t@BrjuXcXE!oWJsA7mxu6FWhI=bI5$3gFd~hA)(8%X8poCV}bmyNt z`&hBpv3XRmE-q_ymI?`lL6q8_$a2a9))1l(0V!OC(#B8sx38-T+dUs8w&z(34NiDx z%SV(`!!-%%Gd$tQo%oy223PpjNz6s@Wsk~p6b@i)28j}=S|`Sd{7j(Tq@;K$lZj1EGlsc;rmcE@dan9L?f#g!=Sqo z4(M{*MtPU7W9khukkSFKhJ~eiIa8g|FB?y&2q^v)6K4-*i^?H3Y^SvEoJfr@y=;rc z55j0RPFTgY1lMU>P(E31U%pyKptETerZ^U&+5f;nMw-fXyip)X_rhw}4&a$bQ3O12 z=$E&v>yueK)f<=1G$jG2vS=Mq(a}#RovU1$P6FBnX`P{l@V~t zqKC0q%825%1M|EtzbIF1l4qV>WPI*l0}kX!*<0#EWB~*7EXE8d$!K(LSuiR31kEt= znOb$CL6$epl}20Z(lS}iH7K&R$B|vwoad66EN(k7)w6r~$QATzXB)Gox%+D7U8IYZ z5wKfloYk33Ewtrial_MD4OzppH&o+dHGrEL1|0ok1g!S7y^KN}RPwWf(B4V9%dmIL zp}o1C`Bglt6r&^1cS)q#-b&dD63*`WFPtP$rCB{TqvvK%mAt&6s&3~2UwHHWrT1a4e0ZZ@_k(!2vEkGD$YD=H=A3yn2&E9sgi z@$la~(6eJOf5`C~*DI2M(qt~uCJ52r&RA28PL97!7?-BnX7SGkH)ciY+4T{Sr}FZG&SSN})j z4cFpjqwa=Ya|0uoDu&ce;{FmQQtZ|{K(VR=){*TsyCrT^CxUdDO81c>i90ICa=#oC zaZ7E%WSscN^iTuKsl<0lacP%VFt4ik`|<&K5THOXn$a)O8qb`_`$-d3`>OC=&m{{l zM7;od>d+m7%l>%;9-n}Hkmdb$obmHmxn80-*8$FjFaO`+>@LQ)dbi3zY8QPD&|bz3 zUzQKg$EUB)_Y8hPawnWSUG* zkG3ev`tpK#*XR?EyS`U_*gs{Wc$m<#px)Q|jH^M@lQNumhS519&2g7U-I$~-f@_O$ zR62l3(M@Kd-BXCc3$S_6_lB-rZtx_!KOw0YH+&h(TCWvv?1Atlg$;fYo!Ch~3pwB5 zg2VN~|NlQhzk%d`qKo|olKk6xe7c2 zPhWQ$)FMKSug~h|?`HPOlkjk%6O1xWm3DA*bv@3oGj)C1h^U5oEufy-)vqguujtvX z?DiT{Ya}pHoL`!{ibzL2Dnv1LY4Ax%D$?rddb1efAl7oyi0a|<`?{!bndY1+cfA1j z^ZJtKf6e2@X-69&`tV}L`KsY}y~s?fH7z5civ;9^y8(>PK=9%|FBg;qu@K?;IIYvgaz?w~9+zhWbmrBI^4I%cCZ zOvlg-fwXIOE&Vvg#gR9AzH0g29XX#a{$nND$YOZ5qV7z0xluS&Mj6h4Bm?hMmhsw- zeZ_#8uFL*71;<<9%%%d)&ZOzYab4w9H$H4>je~&l&nAlhYW=t+0r#`qK|RV>bqQQ> z>8{o8{CtZq47(#YIMu3eJit6}pe@?x05R#8dP7xH zcvt!uqUFAQQ(b*s4Y)=$4DZ0~SQbtv9a|Q*d$d*zgRr<^DR99^*RWCj5-9xCZE^D% zG&hsT;KcJ}cpTc4sM+MkHZ0l7WYQ;upeJ_9bA=Os8z2ub^g3+f5-0$g$;F!9$3HS% zp_uo;U-=iHeOPv{R5QxVA;h2vKqbvUm)^7XYqt%!Xt%-Q;>*J7EAlJI*D62SThP!z zLD)FerXGHpD8q$G1mH($n7|Ua;_AhBb_)#EwK+UF5n6$g;Sb1CUv!5ptwl4glD31e zd0S9#u>SF2{jHRe6U@QsK%Hld;I2_*L*?^pwj6;@V;l*nJ=pAVHXu}t5E&#fm_u)U zU5#aAV=?Kg*A(9_9_}f~c!fud){ak)#XR6cde@XA&OE(#(SSJiyN`C4eGSZQ+uorhG^N#ok4RUt>B z;=@2~hdZ)B6)d_Owv}9y&qVXS3Ku@-Tvh!gETfp@%k0x1&>5k4}<^p*9zE zGB+=H74@YzqZ1wGHmuy}qsRK+brx^oADYVY_BCN$5NTh1Y&f>~EbGTQOv3Y^KbkA+45xQv4Z?%j=SKhE&H7;A-+T$Y|qftj^`0B5};P`XQNIKm_X3Jlc(#jJmbg@S4ABKejuU( zw$w`VFIXH}sEV-&$*ZFIU_3z*xA+ElL;&>%%qwhSfA?r~M{TUpO$x8m#nkw)d6cI- z>DMvx5DCl)+3$P+GkwAGdFL~IC1FlMn98m}Dh85pY;(skwS|W1OO$ecU%UBK3|I-poyK@@YyqzGeSA&C>EKFY+dar4Hy(L zPIHvE1E`h;m01Sk|C}cmrh3vAA|E4$DE+n+PB7{y23#{(gW{Erk`(fD@iIoQ4T&Q` z>HDMkV(n2X;kfl7NhHjae)a_VjrU=N$}xgyDp!r;;S~@bp``cSk%m254}fZC{-OHA zMQKtF=AU{6&ruF75vfr;rTzoSqFQOl3@0K#bfBEU>JQareZ?Pu*?3=}+oWppxVnjI z@eS?-5`)Up;xrtH?_j|}b)GX7b1xt5|B8qt=@DjrKM`+CTaoYme!`nfqxr5);orGn zx$3s~Jy?0v5y54@$Q3}Pf(%2YOXii~)fFDXW^gk}w=_n<`El5eQ_gZV{}rQ9Z4*L5 zk@bw#!L#u%>8qviQ5IL&YXL|--jkgTl|Ws5Iq`S5g6{=L6r;Pmf?30g`xi#YfR%xZ zpT4*@L=POZMSoj)4MKIx>{xuh%Dy7(oXp=3vA1iE^emc)U*G(5H1Cr-l|p~PjeKAL zJ4xMf>-7E}kTuYhE!8}1mTk1+Is5T?h}z(j2@!)gO$Y7G=6%Tc!MW6QEAj2^;PZB9 zB7pOrIvvqX#SC2iI=&!b7pr!ep-<=8+4b0!aLZs_IlRP)yUTT8WM4k%sRY!||F`Wk z7oEy$e`j%-r1`8 zbzkxWh+_c2`Ck*s|3o)rVr2UdU{=-d{mbV6)3jL?x7jrr%%G!GAUI(GRN8H%FlvOC z#6t<+MlDZrc9ygz;O`#5R7zgnG%le)@<&O*nSRQ^^nCe6@on4c z@}+m>G4;rN*t*(^Hshw#tghd(d7^xOQh7|kd=9sT;jl z$Sc(G5Ss=w$LmQTFJe`7Ta zV5Gzjmtzi-G4Q4lXXrO`(_5=)fX+x$NkheTcksDohQ#`gJnuTOK(wMf&LcW~foMsRv?ST$qW4zW*nhC6zkV4$ z)v_U_A6^XkfA;x3VsCd&2#O-ZbxU<J|aVm-_+%t{Gq#tBy3;Oqjo8~)JV7~HMt_hj+OV*^YOa6*lyFQkVj}|fB~@- zomcVlylvR#in2oc3B(@w!InAev`*JEOZ$0qI@%r9FGFEtRh-Tiw_KTXBKEx4*ov$V zgic1zJafz)bwk6WM&89Mg4_iLU%JKn(r9j$Rx!YP5DyB;8Ms%X3TB z1n^=tQeNZQApGSA5{8VfDbPcu$2GK@cF2vm|FK1*weow7cBI! zWx|SD=1XSo$iDSHtHZZ|2?WUF2-L8WzC78|??^y}JcF-MD3Cba(9mp92uXe)&n@ET zMx^3$$JDyW-n8J1{Yy6XF{h7y1jR7ETwre173%~7;7uYU^P8Ot-q%<_>7IgR?8+rO zR=61Q-dw*ym<37Cy^w>hBJab~8m#GIW<{?*hm&B}aAoLCwoO9IX6%tAi=bjDu^cM6UTDVqw?{%4p>>z8Oyv#x7XKz+YWP^xogp^f##yRBA%Z{9Uv zN&@LYJLFbT^qHDz#kB!V3vUO91a;oHFx7cCeFLxjG3uM0PyNx|aud%9N(?+xL}~dT zZ8}z#l2`IsB1Uo{6jo3|s>q%1OQU$pBD---ZuP-mmRw?hf^)f4o3d6eTm|`Jlc92B zpc6C{jwJ_mzl`ee1dwl7!N7>~mdBPT0T29^7LrY?O89J%;)zO5J$Ev%D7X`!bA0QI z1XTGqdf9)x?G|p>5#P$GX}o)EOwe2O9bbdboBA0Y=2BwYl!GyDC27a~ZA=H7i6kBV zlq~9%8^5pf=1-|lZTf7_XxEDh*gz+poi|RB@DhB`er}D3y<+qoQ=`oKTXFE;mQ0J-Gt?BJH&oWO5mO5-ZMQ*`9B*s0 z>wqP0Rx#&(KYQ-!Dd(dM>oeq-nK=&>Wt>=mCOS&*)NyzQLjCh}Tlpalss7xRy(hIrvXaPDWWP%LjwZv&HxNX9%K_pbn0OiKC4Fcvh#!Vo*p1n0k9?sj{#PWKQ$+f4(-*hZ!P9o{V&@n`Ur@YAZVwnP5?J(U!`Z)<*Vw{5xVabr*qSjpF2N_rVdZnbeGxK$@Y81ib9>XW(jo49Mcb z$WAL}h`eV%{00(A3ZjE#>K?t_t>nk=0!L+b=u)#F#mX37XfG%&|6Qr`G!0|4;isTX z(4F7aUuwI!9{^;xR0Tn*ZB>rulCiL{*rF;|=ug2orJtZ7bc8npfk{me@7Uji5tO32 z=@6O5Ii0=-jpsP!Cpnz?g90gd#?Cr^St1CRqeoEHVlVhqBIw;kGp`1oMjc66!F^Zc zD|=tq2CTZKx)JbLfQyyqLY*}Gl-a6$kY_->7eM|B`YwyH7U=*G!m3 z@{Sk4vE~l1jI7#SUT(tC&{*@=*~jt+$+Is%LJgxmA-$pkt4o-~2*ML14ZgsiR6zP~JF${S1_Kyw=7)#tAGr`k5s=&R>x zw|^%3(MauI>A|pGp7=FONiZOWw)ncrn+Z`l$v!WhYpPCsq&!=j`G z%EQM#KMdp(h976&qcT}TgfmF&(T#T7zJFU`5{V%yTxSA%yMDmnzBjXFbs~*WK9?TN za=v;tLL3kl4T$P=7B(3m||LoBNF+cr9g-af-5{nhFrN}2jjn?$){9M}u5#%Q2ZBDkl`7Kd1s zDPgypsk;Q`x|f&qJ6cAAsb3uzRUdNp%r}XD_M@~aDs{O$rJYoExSTR9XFXYqrI8R& zNT3l3loE_%JMYuy!g=(>eJ@8wwzBndP(zJaZcpng!1kI_PSFuGftzA>?~}+2ve><6 z$u(;N*kpFRKdQOnrlx?wjA7k|Q@yksixBH0vLmCfbZ-dDHA{C;SdzoZ6K!iXh*Ba6 z>9#^*1FJ2+&SG3R)xf$%nGy@+zyJB_^>Ng9vLFR^Cy75;8=Spt<$a6|oY_G2I{BP< z+lmATLSTHP)%?SdLOE@@7KLIJydhT#6Z>w)48-WFu|lI7=OC5M!{W)6@!So*c3`RE zA1$KB-r=j3038H>+{FO~a$+@uFLskwG#2bd`MGoz+sfh~O&~|J$mmGhz5R@0JU`hf zq#No7lDPaFaD9C;ewM~c2}h>MXt5RT%?rbrWG!*?7gX#Mgt-OFTkRz@-&Ysx8L;jP)2)w>tuj~H9^Dv%YfTs-}k$$FxOHJNcEY_&adkhT2Onth6| z#z8z-lING+VUqVzk6~L!VR&;CT08eX=z%W$r(UAIZVSs3Us=kS{t=odE27WuXEP-( zE#uC`fstu;0OUY;2+8kLvl^4r!{Ts*`TJi?L2iph#6E(v6XMmITkXes1{fq`?{N>N z;}o5tOcZ@GVc=o7rig^A3sq%&t~fz*Y^@$c-SQ%pi0ZNJ0uqLEGAeobCu?QsTnpNs zxASm63~5|19sS>hn0onzlBIu;2W80Z+J;9j#xqR&JBJYGEo77X7GpU3${t2jwY7Rm z;zxp{!z;)EnHg~_`pYWegKX%Fh0PC)XAwf68OJ$+wz<$ct}BGAwG0!8@p8+9@26-= zYA}uadH((1?bWg++cx!H{leG6<(REVeLlkhj37bL-So8$`Z~=~(~>3nA71{`aLVTpJi9Ktp*0D9!XW(S86;tX$0(%9kNDR z5B zt9cY#W-uWRvTiA#GhqhdoxivL?FjetmBR%kK$Fhtt<6L%Uq{a(SOsf~yX zRY&h40-VfKu>)7)BZG1WN}YY0Q40t7(s=@LvA>}{Dx35tVabnG`W6_Z*V{$soo%CU?%V*l$x~2ky*^qiE;=} zjLj8~i9){vXu&&erWyWvNO7l44jCm5(lYAg^~w8*&n($qWPw!~!3T*uz>Ayt6n%p4 z5lN`p^&k{zB7l1%8rjUrva{L7@ERezs_PGk96xZL7z$GdopA_93WggX`7KTbA*$^781=lF&;arx?5_)XySk-d$N$uslI123|IMKSI1^l5uaJ*v$!{pxc?X zKEc%CJiy4sfIZjL_#0HtI7qa2i-s^M@!EgEbIcB+a!XODUhgX~X+PGQt;tn@Orhhv z_#X4dTL9G__~H7|!`^})t}tKHQQR1GYf_C^D_sDtFV_yc1)wb6=-&E~DP36fK~R7m z{1}(&g{hCw=$-tLf%eKVD!$Hg6iY&do~Jc!HchYr^taMBtNsdrTWdl~8NTitx@yUY zTH)p3IOk84t9Bn(y;IU#U!#Gz17l}>vjoQ*@Qvg=t3yXqU|8u%gyTm)XTzY^G#R+I zHHU}}s6R79?-4Ac%UFq4rRZOLxTAszqmO?I9t*1Kj_G03+AREIvJ}RopJD;dLj*(wA~0!|;$f53fq{$b zvmvt|%yo1?){acOA6&JFlR%UeL5*thMnQuU`hiyZbKzRB%0&X6O!SJhAW@LSu zB{QQB9O;ny1)ER7<}jk@b(?4UkSh#HkG;Og5bQTpPGlDL{F<@J0bmje8YBW}NMZ_o z-WSumemk)>Kv@f4nS_C=_S`q0pX7U);LXX(j}suf#@m64Y(cvfsJDUg0B8b`dhe~2 z8L*jQWsh*-(cP}=yIFb}eSFKP3g7i{0a|&D0f8E`zZc%h_WD8`%Qi^Y&Km1Q*|^dm zF^1ZRDJHU*A#h9LvibzHyew2#lXot9&d(ba93gVFZi=Ie?wSD9?fz){HD!Lnu%}2A zG&qM;hoiyE!^glgnn* zIMxbzr1^RGX}qUb<=B}v`VGj<(hewnuT6RYOJ6}Qv8+ReF_P!o?*`BhS1n@pmC#Z= z1>eF1yUC)BeJXLCe(y1(@WZ7%{-O^=iCjlj!q`r) z9tQy7^uFfDscAW)POFqss~fYoX1s>K!J2XoOZ%r*D=mkfId1K9#fo+T5&Z%33~1F0 zvtlA5d`>05V0c8?8C`Ja!)($4XCZ?UloXqKBPbx>*TP7sP2PDtMOuavQL3!KNRw&Z zY8na{D8v=Vt;PRd)mXBwx=v(Yd^4$})D4H%9HS@xL%6O88~pF>%j}F3w5eY7W+GJ6 zo)_+ILhDxYY6fxus;BHL-<1pxDoOqc{8_(3{5n&+G_>9ddOB*P_{+r4?VlAmlE_l9 zZYi5=gR(Jc+Y%KcCI0q2(yOrp>6k?0rERicd-3*1^3o zl7c*;aXopJP-Lal!k`8uhO-i!&f3;qQ!6Knix?7q9idwi(6K9vvQmEkoaDhfmej?g zep63tMe~-rhw=RDmM8_ZHFCYmWErD=H``;eNO%P|u4j?})!vIdSGks&mi@K^+qrfo z4oHx@yQP>|qm9htC)_Q^i^qu+;Q$S3o5?3B>~RleSe9csX$CM69HAE_b4;A-=<yRB(wjDPto;OBZ zvMFq?x|jd1Z(@Zh?@KLev%}jHSUi*Wm&QJ1Sry_+7J|aR(XixKEMD%B%Avrn2sFfh zqYW zisoAtp=IPCq=bVM`+4&e_lc4=q7NYMw5;;!-Fw$rDT+Ha#eHIAUYjZ~p; zYRC2t=3{^UqtTmZW_mza_!n_SHb&F#dt!YnjTq8dKlmq@LHAF|Ga$UP%GDXSA#;EH z496Z$`=uJbQ%mewN+Hh<*PUdt zDh;~Uxf#7LkTdkwl&Ng(i_>A=QbfOlHPR_q44vycW zwX=yMov5{evx%^Yk)5##owSLqnX@@Q0|&={prEg`d1A5IpsyaN9^qsc(M0;%2qB=` zm=c@?BJk-INk9S7-rn5hto}ygfIHpFH+stM@#NU$kSiP#g%++U3kyM)6GJ2*1_!`> zOJO?Nz&k>Va0O#qo(#7Kn|85loihHRP(L0n1`Rh%@_-)$EO)$2ph(7VSCzypDigG1 z5LY48ge`~>7H-5(370323I-ppoe$e>NJk3V|ViigP;3BP4LLjDxgZ2={wy5G7QEZWkk@zq59b zE(}H_LKqW_&nGICpXb-tpr=J>4^=e(r%BwWE3A(si9}d;S`Zu-QGFU6mLXJMuY9Qx ztu0oKN)JV75Ag^;XIVyqH0M! zimEv++y{Wk2B!#9?Mhe`y3Ae~Vq-o2WkWA~LC-)8gSls3E&)yX7)HurULeLyt@*&; z=iTH?xEnv7kH3^hDO`lxv_OQJB^8Z3=Lo^0O4u+!lnjnuRVoXN{A4Yhgz6D3jQra! zP^_wSsu|YD>|rOoh}+>pm;oFqDooX{NL)aXfSo>A{A6g0$)3RjH?l|?((Pds0XPbh9!NE&P;5i~_kC{2h8 zp@1lS5TFbng=l~s79}dtm69K$9*aB?rVta!XHXk_K=?=a9372-ZoUmv!&a~+e*QsIYl@Na2cc~L&XT>6k7`{|-6U-dxxUtiUGL;^s<+&@Xk zfAQM|;0Dreef)q4NH!(<0AuOM1$h7hQ6*AwfmTV8qq_-MM#6jh0rXeM`7|4KK;Ojr za07Wbrutd*X~o2#+*weDrb9?n#f*Mj&%Y`rb391D88gc!oFQG1fjz(+e8?2i5QPCa zak&II5KZ6wVFc_|z%3bcCslIMAB1&%vVpo{e94+>BM-oD0_YslCD8OeN{c{a&M0b| zO9!z$D8L~4%R=S^d&2O(7$Y0{(!NrNLFwYNG-6gvY$;rRXL;rUeLH#Puc|;Yc=Jal zj{y7#CK2;MDb~NpnjEIkxg}B^dVR@sStEDmis^9N*=;d0zs^4Nc2EP z;xk2nft`|g3T6Y`3Qz|2to@4MgCXL0{$_bF?39Ut{%pY9!suNJ(x(?8I7m{DE`wmg z_i6rIz<9xgO>6qbgDDX#wvi|$BptSlx1s80j(eX7P|QjG0*XlhMw_Ea;6R~8>}7*( zed?!6BgiOX^yucq23J|Ie~CqKB2UD+ssa`w4;uRAz}W^)(|+H>X)p*JK@Nn!r+@nP zO_RcC={yW7Vd$VA1<3g_Z6@&kzk8mB$VY`JQS|C$`0l-_%+gl8pYI_&eHLUmKAvuo z`3~?Rzer)zc5&jWNMM}YpYip8`G<#v4`1HzyN6J@Uf%AXyQ>8{yzj5a$LrdipU>OD zqtTaCyc-`+pKn{K2bX`98FY>9(|eq?gUr5j4b44TTvf|%yOOnmzUhP2YrUEi%MGMH zE?GRaMl;+`{8MTyEB&pkw>#GE!(;ExXMSN1hv|X+7xH^fqs_*Rd7TB_>u*B^K_mwKP3;hSA*)#*{ ziHD{aP7u3ly1dqR!9vE?v!AN0FI{+=Nr$dmPQ2m@O(ME%*e^?(tO-L`u253c+4H`%I0uyc%dM_cATZI)IE zQ`h}`YASq{H}I+_WsMb`Ku&z4UZK%t-~UX9!vusK&(V@PXDQzEG&V@2<-(~xXE zca*S=GB@aWEk~^F$!;7}%p9)mCElm=?+&N89WAkF9P{g(!%Msi&pA#ZTWNy^87IR} zckd<5k%N0{XgPtJ-o20Z&snOsuy1abZj1|~ z)t{DxHu(O`) zf6bgZs~&^R_Hkb?hc;bOF3$?wUR@b$0@-Ld^tkLs+;d`barAG);yu}CoVVZTIIdy!1fA_ybZ&Aucao@S8&z{ z?1{QLHE2CljxssWS~nZGdKvazQb;4mU*7f>Zb~uSb5c;E?|yp! z9?(**cE0atF4+tn!C9dC@(lE-HqoikaxQmFcOb*WcLoe|tN$j;;{Yy3QKx)=V2$4H5F#OTEX&0Boc|X+MuMF>HKxZe;*}UP+N|`PMFHGVyX*cX|=9a_R^vUXRb} z_TECIRLi^`l)EGUCJ=AD$oX!7Q>dp%u*Xc)Zu5ROL>DJ1tf?};zFqN|->zJHU29@j zp02Fxnm@U;MvLHHjW$}e5=Mf$UA)+_OG@#xkH?Tv)KjWYql|gTwlRP7=jBO@@cF#& zf%*O|{@W1#KLuS|<)w*tnU9W%@X`=R)nzlOBYwO>9E*7lyVKGQi*`QvT%c{KpigVD z9Y7db$>ytMSz)Ifkl`~-C5>kz85pRD<1A859YoKHnp(Ip62xOg6AvjMI^&U9#r8O_ zDdAb2Qh3n>dOeobY@SRo?upyG$n#1J`9W$<)>J?@MVfz$`)nvpB*w`)19ME>RbOFl zECa&MHX6d`+WuN!^pE(F#EX{1Rab5raCR*mfDt#2)a`Si#G_I z{a3sD(olm5cVwppCe3If#(cW1e4Yi7ua_zK+Yn)wpRTWM zV+2!EZVB~iGp&^_42~o=aIN$iR;OqRDg+@O3UjB9>hLR8IpI)*Z(@tigDMfR>~F zwpmH{h^!{#zReL%63&cA_oYgP;P(X!bdpgX?l*X*-G>TM?tFH+GIIU#9XM03^o zFjO^?+ng(&F%hDpbYszOdo>&DSwPm(Q> z$%IQh-4*~1GZW2k6^b7tJnaW+`nPFxjzkXma}PL#-;jMzS*%+i+uO8|L@cCiBS*aP zeqoNVa1STV$lj!2$#N6R&IQ1}A6>_^h#vOuG$h3!yZQ>3Jho6KKbFK7^iry1r&|hT zp}xOfMyUc6x9;4$ZAFSfIwCf-ZfMTwDDeL62#yIW^j)yyt=bOy?wum-mp<$} zlK?_B4}t@h3!(0K{h&#XNPC?;2|o!yfJ{?;r-P0XG>=t^&9M}HheQ7i+l`~@UEkqq z%k+2(c;b`KR0gwb>^xY8(v3`fAn5%p>tu)S_^a*`cJ`nnGmW9$YePyDyq<$~6@#BB zLf`H#^?9|wc9p~Ez)Hwh))L`oOKbB}4E8GSs)jF37BN{`+z1id7T=b$yy`BKo zGpfnpEd(Wu}4q35)=XZoU2m}pyoUD%}1b~f~<HHRQ%?qQ+2s zbQ1tUsu!f&2K%D5jJ|=T7Gy*ffyuKxC{FXV;?P3(zQZzeCB*Df^tM$&}EvE;H z2wf&WJvgo^Z3&lKMhV^y%xcO622*o?x07O+fLO8LKYLL+;Ykwksu*4ODSm8-IhmhE zsw5PZ&d8xg#}=(koAL%`s%Lw6&#dF>NX|-(GGDCk-mjK_`*V6~E(U#-iaH?&y6(%^ zC&#(z%bq%m$sx=GKY-6XWuMo=*@XZx;cfi)v8{B9FLU`(zP?ZpUXyW{S(F6SVfG3w zJU55c_h-TP55h2I=>IkaF#cECJO}fCq%N;CWSkZ_k+&YGx(0Ll2h{LV7IEmE`=KBH z3b`f)UzCx+Z}dC3KkoEWtID+G3?}D*_@w26@vVq=q zQy9<84lu@nUt!WSXJC>fYR zJc04pbf)qXl8H^Dv25J716?*1a>0eYhscA#L54ViJ~s10g&3cCtHHTV`j0{eXix*{ zlExtvY!-M9=-m`E7UqDAI1wm=yiCwOySy-jIZ}|-f_Bq=jJVAh^ckFP@f+QD3Qeu_ z#LS#B*IZB#A}O|9J(ipURbg#al2idkN^%Kt@nZE~1wBpKnx-(h`&%6wM1R-ZzZR_$~W=DjUmxvlL-5@kDGKlQb8#bwtUVXYwgJqJ0$_Xvlv;en%0sxWdd99 z6Povz$O%TP8q3COa(q)ta5>F>S)!?dO2$?c9X>0NznMoaOW%Y8RhK~3+UkjP4JIGq zT3SoP>tfDA8R%^Jjjea1<6ROK~q`yOgpd}b^keP22!YFmCI-5a|MNhqw*DHy^J!r2Q zjV!s@OGI;}swHAIbI82qBRz*P)?+>xbUjztHnhF-AZ@}Igc3E{#mH!kB3D*Iwl}=d z3g_kM;P+tyy26>5K}Z*+YGiTw!2s)wO^RP3nX8h`A#^Omyg$P!^N6}0+R4(qr|CgZ zv9;vE0R?J;LoRXtr&vpT~>M9fJ;1suK;K z*bSaDp(0?|Qg1Jq6*F#unVsfAxUS?pQvA7#(oYsUEBWGfBwG{uQ=HLQ@qlUvD*-Z?|xA` zRfVKy`}m5_nJ=PHLt^PeonJR4NPv|XhM2|M(YQ_^JR&)20-XmIjWQ>R?_{#u zp6tq3y-_s|-ow+Nfb{*_Org4yTbt8WL=_O`jU?fuv&tgGZ5v#@>o=8CvbD0@ z>z$3#0s;1G{;5nNC&svtUFF9AmI?%*YyDI0-TE+Lx6x|VHg=VXSROxjI}VR9 zbd$>5(*2lf8+$POhH1-tpP(O-w%1=Vzg=?ExV1fUc>>8$?D0{U<{-?$1+iwvAH^6| zM*Jt8KOwO;81bN1>~S`3Gl}p1fZ1!_muB=f`#1vIA($6gO;APaR<%!&PyA~ZR6?M~ zD_|3j>46>vxMlvh(ny3G3>V{mNAmW>U}AK?V0}2t7@J`XH;Y)BDBuW9F2Q8=b+FYe zhW$hjf-MBu^KiH~^zyGL;RrtHoD78s>7;mXEliZ5OODQE3K;HpFw^;$=I!Bmu-csXx#UM24ZHogF3*Y2=j?*8RhewOaCyFE9q0Iz8y_=;S4UCOo$siLr zd6&CX9jFBB^;KJCf=P=uyw!AQT7uq=kY2FKvf6*+#6oD9rnso0XLOBNX#!>Dw35##|cIXUty;VEa~TFOFWQYdgiPNieUK)%*u`7OC9|s z_3sgr*~4HRQYFj9qKu-7vf@g}Fdm2_S&RcWA!pc%!{aO}%S8W#_pNpl2M7zE63ox~ z{k=bD>?l=IKi>|)NyDP?D=cZB$TT;EpCuKRqwZ}*CnpvXf(&|CDc2BTkLS0RU>D^^6jx|owMqMf%fu_ufac~dQ4HHQ+MF5!a4i( zrGGBdjmmzu*;cXjqk+)OWwMA*L;3-z3$a)G9WwMo(XT`_@g zpa^-cdv`WNWUqe>NTl9Se!gz2`9nJUz0MZe1(oBMBmZ9832YB#w?*3J^tRVqvtOr> zdUhb{1I9L$;&7nffw_cSkYIMl3gOsVYN5M%dD-9xEWeuo_I zY_%g8NySA`A6?1=wnYj?k<6lkF^>XDXdfe+dzSrz(l9w7mkxAFqrp@He@d7YQBE^qgjmMt!pvnXvqR$AIc{=m^T1q^shB4! zc7Z$}NUxW{rs9xzW1WqJK7x66pth?}lKUO4gl8n*$}r zAP*_Dwe9Sb?>3gZ|9Ricl@bd|F%tUDt|Yq)%z1jnNOc(n&YPA+R|r%w$;BSx0-u5d z)M>=;o8Bg`5LY&W&9ZON1QE#1V2XG}bmu`fJ?NCs<`=LWGMwN8c*JI0JLu<#m?|fG z8NnL~o1-*r3IKX9$$+SoHv>1A!et&4feu3ulPug!9Y??~8I#s#kJ#kHx!VZL!W7#6 zO^}qRM(;`G%?KD73{k6`w=msRWYc8nJYu-^K=-u(a7&X19W^*<1|OTSLs zgSP*1;=UrU_C*Y`mABg@;OGM#hKtg2dCG5`+nUgf%@uZ<#pC5tCM1x+QOpp80&n?| zL>Qu6+%2gsUh8qS6yA=yh79s;;aqIp;JV`R-r*DymvU_Ia9^cuF$g$XxWSd?KKJ@k z&ybJ#cfR(G_NOS$o2`}n*b$PRE$I>!0mFiHkvO$Y4@_x~kz zGE8@t^YwC^;q_9aI!h|kz5y?uobrH6RHZx?K5ku??*F(qicvIvf-dO#K@XcShuCVf7-Mb?>w$60>=uqF=6ONuAoQw%~gL{&6h5RC9k9=NDh zBRA4SAn3P}{*~iBQ{dsS7?(p{woyG}^VU!FIlHpEQ8d;Ue0 zlufKg1kkc7+H6Ff43%k|(LE7qR`Uo2K;pdA84KGto*AYLMyGpGf36F$;r53f{iGH4 z$^sF1V_IAMX|I|rx^H4xEPR~LwqlfcXoI04lAe&kiom`d%TURI-m&DOy=RY-fFkdk zPdPBf62^Z!di3yhaHZ|4PG$E$@3}LD>qi7io2# zda3C5qPncPb-pD<4Dp3{E%gGfdXE4X->dyijmjk1Era`5%BFKzWh0(@_|^^?m{$mO5N*p5{Ial)DL*H46fAWY=u{rJGAx%E^(%5^0%hJ~ zGW5#kVa;s-Ye|~LKZyI&_OBpg(sLs3lgu&_KVoY?qc-P=!e1Dg5oTM%4B_+xBv9?< zCSM^y_YW|n&uG6m8fpb*jy=6@MlAsQvEi}g>!p#wS^#%i(I88bPYv5HBbwVTqnSs1 z6jnhVuR`*Uj9nvmezj(4d57M`qIPrzuW>yqztALQq>>2Me2C~puH*_I$?(Z2wI>Ry6aW zYLFRNOk%R_%#ztSF)JCOWh5K`CV8Bs3ENQWe&u_%0|~*&TEr;HE)Y+<4jwwdb)6qv zxdtFFd%fCs3n}4znKL_vKD|@$Re`0X;qm+e9KU`ftuuEfl@-*;T%=-Bq!qtpb_j*v zmRBXM|E%++00Ll_zBNk44~XMQD})FI0u=lxtJ;P$x;PxmMas!j9x{A-#b0h;E}~;E zqWLpzOe1)@tL)=h&35U{CUX8wuN=>Jz&>b-GvF@U%Td4>@n#%5K=m)^K-f?$=+3?G zbBr01H1*o7AKztRlfFoZBdd`gZ$LhFCMzMHW}WEYwfFQhisB+m!j6abA90#Z01~D- zhCiQLH2krU-3=Wmj z_WK0`&47g&(RI~*|2>_!l7GbF8Br{OK9#9oC_#f@%yh2vb(>CVi@c%rg}i7}59-{Z-|I(4H_EOrQ1iidD;CisHrX-fv1A$X5q^JQCR4v2T@No&8{( z1v*_SM#!htIwQ>wk-+9NN1Rdpu_iY_LxC|f^RCdRkNebj#}KuxEQa%p>bnBsHb3L# zHsj0>uytFri9guOh!%%u>#UF;+Cr_&Btv!^ zP_$}UMk8w04vfqwGTsZyO89?+pz!8%;ULx{5F6dsIbj-=&hFYd`sJ|$C~{gdldF5+ z%w+WmLplE_23Kn6SNi6aM?AFknJ2d>C&8HmQiXK?V0E2*v8VQ+I7`f0@@j?QLP(OY zt-!K01d(dWA!ShF_QPXl(X49|)O5*gX6a9QpNaL&11?aPpx~abUG0;_z1Jll{p?Dn zLS?OWIa0yn?8yleAvRNB(#a=lgZ`qz&BNspBBeU;`PppXo7Uq>Qys*e)itSO51TXz zi5rAE$6Yya9QT3Zn3H^I>)8gcT1 zq_HZ>bpgC@fmDh62fzNs#Q`0hIy(>Fj{Q5eSj2KDycL6cd8Zo$;iqb{<*N62SaD}$ zr1$Qh_nK^61vOOebuH z$T|3Cr4;^BGfw*s5T?N5q`w688q;M1`GlI8X0CVj405VE*D+xiZ_mH2Ppv$W0dwxv zH#y}Tc~uz|qn37tSo~=iTgTV;#{HCf${?~YCO0igjvv91!>xzhQJIfCohvsA;^g^jvxd7C`^5h z=$~wb23omfD&=dS(RuKY89b=vGwY$GY0*isXK91?Drt`z9|st6!#1Iwv#EPB}RW3{vHC3?%O_nd>xI)xN=b>J;V{f!H&xtt3># z7rMV);*w6&biHacvwaeF!WI@TNMmTcT+wOWa&djAaeWy6+mjb2zfWz+RYz=v8W6OO zPcXO+d23C~fyn3z6~6*6XoOsfNR1elu*x}AUh8Nz9U0mWd)+vg@iSzRBBq*8#v7dg zEFl{wq<=HN-(N>wFqo8(^P0m`2SM@+H3_MR%Is5XY3N;~V zhYVge%k{856-L%TKS0c%1i^H&H9!`^FZ~x=c(BQ^kp{)Ddg5_gp{9kirDA+9eno&n z6vAX7jHMN{HY!NRD$w)}*5_TRlY+|4GFFt~rr0w#(GVCh`zY5-yiSO%kW#X?lqKS0 zRca!kIqxy2BUDKp<-a&Zooe&?ulYxT>@X-9eSf4kVY}KQD z-9#yEh&>e4bUunG{c)QPy52|o&(t#Bqh2w?g!!sQAO|=_$M(hWxWj>_`vIiq4NWd- zVk#0+Q0RS~jb$MueX9~dV1-wX)l@z$xAxs*3b#&2yu5li z4OF(`hPyw`#aX#%FyjjcbNYsOQDKstLS*vAukF~$fNL+iU}&#H0$l!UW{pTP?5}E- zV_6+>WNTp27C88Y-ao6kyb@8ulwKkHd3nQr+-=njwzD3PoYK-S2mj>6+?EZJh;UzI z{Xhd#b@c?mkKp}lS^#m5s|YZYf5DJElYJ*uvw;;^cu?KA_YSul5@yx}>2l5(<)GR-_ z*&%M0hZTKwHfniL^F9L4gWD&11`$gnR?3dYV`xIybX1i~Ab_UP!L81%PGcy{bY)|* zB*tCqdf5BYiqGaaML0wla$Un~uTv{-cBG-4Rh+pRPr`Y#N z$0*QvTDyj+U;zhS6|b=Pnj*j`yx0Gnur;6#@Go|}uBfc}Nby>{Y1wRG*a@*?KhY*x z*l&IgN|%&QydW!^y?-%qDq>Xgx+Eo*fC;XomZ32X7Sc=gR%7=haIv2oDvuBI*EV+= z4Y~d5iP<3TOMV{l*Dw)nzcjGwZ_>WO0zd0)t{7QXVHMcH)^VO1Y}t9D{(N1}MFz9I zGs-0c;ktI8cq+lS#ov&#>9XH1QpSi^T`%ek`sYim!3so)CXvD6mPLo;RR{i&$eZC* zK;qT$drBGTcNkc=>bKR|qh%CE-{4(i&ZfUhCX`zfiF;=`U>rz~mP(9>9bYN{K`MWA z@^p0ft(h>~;_(x0-X59`H(D!;jhn^@Un;`G5noVd{Y>!tBK7j-UOaliSeFth$8lU1Z|H!REaA~y zX&q*wE;33C=)bc!@4VA_7O|bsc-W{s3U?XV4iYbsd-)bz*(AyrdD-{wtYX(9m>45F z^b%Lwyi$7)E_EH&y8WT8CcB}&q~Ski;n2Q{)B43O6{V3R zY&`RW?Adj`=!Chjlf#MA2BMfYy42yj)FA>nYUerLsWt7>SPS`8NdUleIB55hyV`bA z%}<+Shfjp_3TuO6cmimJ7XQ?KE1BxIp+d&j!3l<)evEz36- zst^f}SEJnDbQ&E6-Zy4!< z6UHGzEw}BA@#YZ!~~*J9v2RRmo01Endr2hUjmDAi#D< zI-?Mx?8cDEDfaH#%nA>CNx+uv>7Hi1HMLjy#Ywr>L;uzVF!Zd7grP*BvuP)#HAFr& zt@Jbsf_Ym?2EDUFIyK5=_HUXn%^gk4^p5wc%l>(yPh z5vlMR+_t!7_c~&@U;KFd82Fn_PjhmOcMpwDb6q65pgBAMLJ?6mgrsoR4CKtl_SrcqTuwKS%% zlA11K)~t^@UaH*ArDX=Xzc!0EuLNO(jXXk)JGo7rQD^0%u}0P#~O(; zK+vVO^mD1mL}rl?8M7&^ejEh6^+Fig!EM9fUoYexva8^aLYN^M%_`tLQhAkATI-$<6 zs8!r0A0$_GVTn2ZylysGb_~8zv3W>2o{)-Tkf90Id)!B^J4AlFG4h?M;e>^GyvB_h4=BSvpz(4tQ*d)Y8VPexx#j@ zH+9=JoX-TWvYFTEdR(9E>-wm-;l;?4IS~H)TCWm#cH7dbERIMjk$JO=q+!fN$CR^2 z;}znf6bG}H;S^&iz$6=KZg;XfOZLe9i4`>9YT`qg+QQblLs!Zdm4V zy>MN7V^P88X6ZU3^B8#Dz^=U6b`j&S#}9!L{%HF{q5l^S`WP}G7}*2dV<2_q8aOt` z72R}FU;|}V?yOzoObLuBJD_YT$P+uAii~2gG10p%^9)e~(#v0cK>UL~%+=iGa)VgtVK&K%TU2CiO z@BLmc{x)y}e(j*fa&xE6w(Ta%&3%vEE3}i29bV-N!;ms66!An+PelHRYE&cfg~XNs z9A^NjsYio7q3=Wb3DG2P7*kp8_s#&me0dm7pl6(mTOJZ=|{ z31>$Dkl|Sr)v38g-Mz{cflR?vFK>WCL1o?wl4z{eITc1-npOGA|CMlWj z!@7d%Rz;`*AHMf1(2OKu$|Z<3Zz2ux<{S^H zWT>7MgW11lM0)%4c=?dSi6yu?&=L*hc;69dY-eQNa3eSH-IWh_*yQ8td;~r7il{w} zx_zlT-T~YG?6-Z#fZ5Pl_oIRBX{Q$BK^NWE(<`?>fBZhUo4jgodXAcoWy)^v0IW{{ z-C?v{CWGn!WSPB&qR*t!Eq%J@V$nCu#zKsS(vCNG#YV(L z427aAT0dYS!!R3vzA6o8ihRiKcj)%^_H{@tj;?R3LVwvGedNCygrD}@Ui!!wy{)u0 zQr~5jlrrJjtx?UH+a{wN1z7rNr>$IWQGFRU$h6y(qrZDQ#LZ{UV>?N*w99hU zS(ffxW3}>I@M9MMvm$Yw{myZm8^XX!0X+m}FY>DeA4ne|%{}$)A zJRz9g3Ptxi_Z32Uh=Zym1cN~on64bv($PMD>P&W3EzaljQfs+c(#&aPD?A2CsDJ_| z`dcRn644#yeLy6fT^A8n-i&t_V`gi#tcj!39L!S*+AtGOBaCASjE6A7Rxrvnl;}S8 z!3e_%Je1A@-XM^EG8+Q(m-Vf+Ce^Ja6A(Ps&RS7JVF&e7Eu<)t(=epf6e0CnN2f-$ z4haG&IF_gcHm#q_C|v4xUI>%IXAPf%p3FPh)<EU`>P9oy zK7ivjH=h8tjaC41ZlZnNy&&1d|4?-mraSNY_PcX$I~-2k?lNQnvUZusI7WEcgpW;i zOe5A~DH_Nlc;r!y`ANQC>4}YC*Gg%t7BT;~_srM}e2LqcM%E^%oaq^7> z`Bb(RZ#^xHsgHaLxh+GGm2sBBNmhi1*rD>n<}z1@TTqdzbI!(&>)D`^T!Kv|-aSK^}RR|?OxL^O}dQj^GIP~ZJJ@Z0~fC|mt?v7=VUD% ziNKq3q+9X5@px+nPKTVDJ2Ero&;%Q7@aChrTphl}b}G05ul{_kB%JS|2L4O6q4YF@ zgnOye+%iN6Q+Ln$nBw-+%Vgi^hj67@N_X~%7H^LeMCEkiTt!iO zv`i(4vvy04BT}g&^7zsWK|A>wJf-^8=i1t@&qm3OG z)b#TJ+^lQh`G)*+mff0^@gd#wO6NlBlCXc3UJ1Q}9nbE+2n2e~qVIApPHaqykDLzJ zH;MNJRAGeQc8fGF`w$VjnI8M?`5__VHbwN!<*HH8 z$^#Wj`XHNabp}`n2h`)&3xEhRd*2M+0SGBe-ud5EE~LD&wXDg59TR`4ktJ|R1wE{P z!rv}uceA&$0Mhf%{?4N3#qb6=A|x2Wy?=VWiTZmW-r}`K%KN>4pB`rTWbs;fnpKn% z!~~xhL7^J^V7upDJ2$xUi6*bFJNdrwVbCh1a;7Gk<8rI99)Z(-zwC2%Uo}ua0I!F{ zg*9do3gwyGwVJ_jRKczLR@DZ!8VzOOjF^ud)*E-Yf%KRmoD4`OR31@C05PBkv%g&9 z3EWYi^@1c{gEp!AHuw?p!8M_Jdht(<`PQCb^m!D(=OCB=8keD$V( z<&o&8N}OaN`7ZA#I5r2jD5-7MxQbjhD_4Iakuw?&9(n8!fu09Bka!@@nGap39exwQ zKf@F77{o+~rZ3TKwmTXQn0>3>aqv83^WA#S0r-;#5kXN*s>Dsnpy{dUuk_mjPzVFE zv-@QrGQdM|W)gob^#Uo(DSr8(W;z1h8KZr_Ec268a-9FiI`ZG?0HJwi@6x1UFR;g!2Mr}DxIci$h+Z~KDpD3UqpLR|FC?tK* z=EKXyM(?E?0~*BFlz{qmuiv2a?a=A^%%Fo1!?J2<`|cpH6vSB2rnOzoYvkuo{_L?# z<20fvI{0Qf%{Ie#lcs7M?XYp(oQVBAPTSN&!#P6`4G7beW=MT`?#zoQhzJPTkB47$ ztVtl+lKYWfuHNw6U7f!9_Ug4HLDxMJDGX%f{(dQVND|?RP#WTS9c`$d{FGgO_n^rg z1yyRhW3E-c0!dVPhh(Qj0!0eJp&*e&2yEL65SyWxo!I6QjSe(5xNynD87`X}%xXNHJfw>1HH6}j_rclv`1P)+9 zb~-6@XBe9j#nO5)hsH#gRyy+R!H1E|ymk8D{Y4zaj{Y z5NB9-;_62cNRpcVRAuB!F8$X%L^6n^W;2o0Z3e~tQnq@9gA;buAqynOG0+ig_s1Rq zX|u7xCnR+K)l<*zgXKYdjwO&WB=^nNA0~od3};ROat%NumTsSP98KkJd7@ok0MVL# z&N-~WRewpEBSdFB`UyfmF$c=U1_8Wt z$j&ogRQ;}v6+c&R8|@~)!lRzu?bR@vDsN0lI>?jcwnoN427fp~P8P31mcBHs{BdM=ML4_~_jwt4+-)dYqGh0AOTKLMl z-rug`RVWKO%eKGzTnlP) z3|!!xdiU;BnQEiT^0ccE*Fv?^Zh-Zr3B&4I_q$geTGB--Ym#;Re)*UxcM^Ia%UP8M z;$Ncx5KxssWUVjCUr(8rkG#6zXmbpj{nfB6%iRj~t6!?8M2Rmt=;^os@qWBcOt>2N zmu$H37M|cdcT97Z1cGs7SULI8W1Fe^Fs39$gmcY_C9|I+;Ku?@lJD%OmEF+~2E#2| z-cN+k$TBq7y8c*r+InzlW^YifOX}p?-rFxDVBVjZjc7fM!Sb?iSQash%S-L8;5cm+ zRpBMm;fFw$I;)g=|*I%NPxhtsbt|Cvn-}Kn86!ea(gj8yUK7AHk*wu zR%qh`Cga*!%{#F4v~F^d!HA9a3#aa&wZ%5Y*jnXX@iC@G@}bnwKE{H0U*ZK0e~ z+csDX8|j~0aJrU#vo&raSbKs)Q#+pc^1Y+JuwkvT$r@}8Qv?s>?j;vwG^%u~5f>SL8gm6*X&!fG}n z%_3k##@ac(7$^BsB|x+`Fu7K0h;hVhECK5JY+5KNt1_0vTimM(M~P%~?!y%DWx2F* z&zBmr?-No~tTKw0(=}iaPl|(FK$*p-GdRg6eo>$WF@-TMIzgkaQCp|Dv~%g@~HBsNxt z8#RegDAU1{7I0rLlMI8sr+fW$bbzqGLqWoU$xV->-xUlW9|_HgFl{9)AjX1mMxBE{ zsn(utF-;LdJi?MrFj!u9k+N5&|M1~H29=~rk~p{xfzwR7nHxqjLYR42kT~*PI=`~B zpzWB=d?>W(DG|p}ED;DUqCXp>ZiepQQt}mw=2c z?u-#Y*Imp(S{O zUkxU~_(>2^eCr>#&d8Qeyw}P^h=yS!$b`(`z%mw4&$>=N6rfWhMt>f zLj~ABOt$f4UGvWeR5U5T=}->+$RZi$YO>;t0m($;#)&SIGg+#bqYzmnK{1JU9-dkB zEw0QHAjjuXm=3^zz#DKHr3T?ah9qzI0(4{LY2JeJ-3!ns^@wm~&H&;-9isK+-wnvW z>yocL5x~qKp&#bj$^s{-IbNV@7bRE~nKNco{KN!ETzN0=n^sITHwQbSfYZQgFn-#t0fC|3fdnSP!W2 z?AUf45IRT)9h@Lrg#@FvvWG{Npvt>6QPjM!Im--9nNwY9sQQ@}wa`twD!3Q_94-=EAz()V$5C|-{9|4%?%A@IjH`w@ zIFSi&Yq-H#m<_hQxx5vK`UYilMfFe_5+i90Rc_n4IB!8i20oxWQY=8?+IHaoF$RCYD1SFb z?tVsC)QFFXU}LNo3l9b&`sZ8^%oYQ&heO#u%yTHKw~w4|)-OjMFWQ?E)8fRv+#(t6 zW#w7ib>H`IY?Jn`N)2{z|EG>Gv4(%%aNJfuVQ+oFF5V(($e$os?78F5hL)^YGH}U> z{C4}Jjl<_8bEiH;=IRs55|YgO{Dm^Q0yB@}sLi%(lUx>ma(+Qg6>P{0-_RZh^`x*G z1sq8x8f}JRg`$0F$;J98+G7&upn81mA7-YxqtC66Er`(=oY?N|FE8^PAI$7%49Qy^ zilimi*pkjm13YQ#GeMawzRQUer!lyuljcD0+^qi!fo6>UkKQBld zhV#ePI-b{ATY~q_x26(d;6jS*XjhC&*An3@I7&Ju6t&-&o&U5;g*$H-3cE+m_&(T* zkdQ{-hGC72B8!@X!FnUuG1H!#ct=|8+gUXr@BSgm`3|K55FA14JN`xSu@zAq;z*3M z8M>5!#|Z!gK7xv`*d!L%@ga>NB@UJaAf9h*a<2CfjNyxT#bVj5;4rCwxuZH2P0R*2 zqY0w|X3Nj){E)BZFfIbQ+u%j~tO^Sq^2mH%IYZgJ-Hr@7_P*_tMwvATwg~CjY#za$ zNW-?Z&?PS?cF>O5hNwVT?4-luPBGwMzRkt8xW^@);84G{%5hB{VaVadOT;2^8jxX+PelB7yP*Sm#yvnXM>UXCbv{&Im7gBs@beiHJy$MpF=5N~0;p zMuAO0nDmV1>4~GmojYwY?Ej5324@(yH$4LR>TPvGo-;L7eQ}H58cdMe)PEe9x{}d? zCK+wp7M{CVcUN!WQjvEKE3w0oHgG|b@5AR|sI5l?FY>!mF-Vf7&} z;c7WABUenuUNZzlBMu&nzvmu|uLpEu#@N?dO`r(4qq}xc_fr!X>qn??uce$;IA@3BWi>H?4=T|nr4}y9*45&3t}e3~wJAQj z1*h`r_;cqvdd*ZE*njaxt&7zQ0Pr(<;pg4|X`1-;yxGg4ZvG#!6)gXimWz>vne%^_ zzHN<7+kdI4&#gMdjc{}IaJU;K1ypejEQ>iJ3+n^Yso?tGZXj1u)rAh$xwzZA5>^{a zb~$AbO6xurR-BoC4<6+^ala%SKSu(H@1t?MtZ$c0u1-A2Y1x!?wze*Ln*@U>DRtuH z^5&DZj!V%6I_6&%(ywl|N{#y0GJ$)TL{oOXR%#bi zqg9HP>Fi_*bajo@Ml({ujBa3djc%p!+(WCX>{J(Vgu1CS-fSEn!FzDSuDfZ_S5z*c zJREX?7-lmMEf<#;-(tf&N)aTl_j&!KD+$WxCPf7oTbNx-hBf*Nj3@?hu%lu+ma8k+Ig*F705g__)0Q`Fi&(hld2lQ1ZL_Sk1vcDp zjiZ!Je1J>)lv16d6xt9zLs~tnJ^)ARfeJwdF+x*wY4WP;ug;t?8x zO+XDbcw+m)d{!yFgm%TbaR_MZ=0fZM|^ zZmCY}333EPMTs($fi4uTc0Oo97sM(?3iM1i3mSxkGdLFN=th(73 z8T}(H;h~&6uD5*KIHAZuXj8yI!992E;2q0bqvnv&l=z z3n%6$ekR>4w_RfEoV3XlkwVCf6u-qYp%mMj9(G_=PxAVI{3x0h4Fs0q@0N)@KQH_& zs%Wv>^ab=L>8L*&bw7<6+H#!y@OEsf_~0mTZxEB>D2)c3{MN)0NDSch!+g&6)0BPX z+s>LmFts)sd8(Y8GHg zaMjs$CAbkY!Nls0-UUZBCndHzd=;9x1u5d1prD*Q`~cs*-~Q z#}3Im5Q3w4WpmMQR}-hu4sdCTq1xOKw_%kg|0D-wO3KOU*&qT`jz^|12Bi}E<@KZf z_kLGTyuTT$Fd7+?;cmGqJELZ4Z)aK{!l7C-fEDLiCiDsL9m-NPZ2SCZc)j+N;0Jnp+R*Qh6{>q*$yKCme4qqiZ*Q7Ua#!eA`k1&5?q~(-M)N-^&DCFDl90#VI0vW`7x%pu=gj+TM3{?Tg%q9#KfaX|gk(I8=&~N5mlW1zP`K+v ziB_uUZ!ZF2oOC2dso=9W6yfa8uaK^HbiCghQ-XkT0L7p<3U`^@mR22Qer-DQa7^1XX%-pk$!_pUW^e;qEH7+=%EW4bKGnn5hPJ7+_XX z82$GUy+FZuRc{D zpovqBSqUZ^?Qy_wt4s}3D@X4p51Z=00Kr8A|8Yl|<$vJ}|NjsRnVA32#p(6` z7r=dx03r@nQlJh3u%{6UCmF_crjfu`OsxSKk0%|u0=^u&Q7APeFGMiYP=moh5@j5< z`|zaA-uu3WhwX>CCl1iRG&H~3-r(jb$LS~U1-n0b#SP&ZQ0&*U>utS(AmeOJ``uF% zNl1YmczU?H_#g&HGxF1-pB$f7%AXt;|EaB1>UH|{*|DCwus{uFd1<`%rr4H5ZpxtbV1F1B(CaU>ef;E^ zTpaN3q0mxAc~?rwz*4BVXsW&ly9G~u3BJVHw$@U`?yYI`K0PYmD0YF?+~{#ADT@!c z0x27xS*InFF{xfKA!z@-F&JBv)HKK{6tnCBvZ~+ntx@izk7$~%e4v0x(s;A+E36Ay zw7DSNSARX>%pMQ5e|n&*M%QZ|Xj02zv#oF@A^PgF-e{s&sB=P#Qx?PKnyEk{I-Inz zfxRT!Sz5tdW*G~C!?P~{QWPQXV=4UMng$B}R@JSjW8NyL-tXXqM>?^al)-Ly+CD(x zn0wNIetRxLMM=6Gy~`zOF-qCvM8--I(Dy6fRM>305(TmkuUe9?xspbRN+*6VSt+2u zcPOAyNm_m{0bWc|C+UX}_fFGrIW_JJhmUpD&(Ng~`ON~OrEMuHp?EQRsXmr8g=%x( z8hkRlSP-w@w%y>OPotxSkz%?T6;|CO_6C9k-gEcE_t;kgh7DIRoF!mafFUM323R_$ z>k^i_EwXHNDM$Rf>zZi54Gr z@8lDDYN$8F~Qtj&*VfvMv=j`u&rWRRG!U#qG>mYG{D28 z?6vzmEFlo({_z8nNYrBX;8oOJ$?MLxnGhEz5Ejsj%)>CeISpI+|W{8r5y{%$0WO7vl1Ec;AG{(2!6ZXb?@lb1HceVM6(JCyYiwBQsBFk>}TG zNUN0Hh7~sdKTG8x&N7%tFK*>lpLHIQEfW~~zi<{YBp7JF6c#4GNh{dVa_QHE+hKc*2~B8=&%NG-GHqK|^qVgL7~- zuTujuLxF8VWHOR}AB&d(eA!-ozxV0iHcEs3)71~_e+6t|WM*ag-~I1D^7#M28~%~U z5%?1P+tkwQr_o z4zn`saKG^qAO`u7B%%J_(FA%atTV{P6c|REs^1~>g%rGB8qD_92{vxU8i;Vo~;8 zAK&qZJ2cO4j)tP@>J_7j1x=EXBA7<1`c%8jOtYg=s?01lar<* zND04_19xbo5KRVbxw*LcWt9X)zs|3erS1~a5|N(?QjI`AFo^;+`t|t2VE&zhb$*q6 z)}Z54hij4a@RzmE71?ehXn1~KoPWjph%k{ge{QORUxy}JFcB=P***G60u z?XLze9vHMN)2zd5B&#CoH1p#PGl$`269?kNz#tAB+$<8=^$X4>JA??i>s#YD8hgyI zWxRSXE~*{YZ4XlkKRFA%{kKZ~nA>Nm?>P%#&mzo(?`nl6OBNg7uxrN(#qW@+40l}j zHC`H_$CtD%?;AS}^%;J}SmRN1!xaW8S)@b!vVTw{w<)pZIJ>X*!ALMOr7ip<4o6Gu2UXsGe-_M+=R_9zZEJq0ji*VRN@ad zOeIdO7igA+3!{PLt9cK(Ik8#Cpbt_cnK)9Fi>hi4C5s-?uYy%qTn|LPx09SXFl@$T zWv%D7oR!Zb(G-a42WI-E5&EEb$?NQ){pavP1M`t!?5(!_M&pBo4%&m=tDaDmfPGRH z0+%VYufq_NnSeZ+!PDU>M)g_wE~%DLQAGpiMcacL*L}$hlor1FFq!90IUabbq`8q+ z_T9i=+Dt9c@58Y@WJ;&5rX*lXRimJM$0 z6oG)&dF7(_M)eE1fw!5f<$6Wu2Jk0L;>ZHnLlw^D$9(9?2tMWM2Wxuz`)*m7g}y8RF{14-fw*(V))pVuhdA;ueM~r`LC>Ef>fO_9d_zhKmv($_rz} z76E(|N0?~#6^(%uia?Zn`$mtW4i!lg4Qs6%b1k(-05vONdOSD525?9hYyHYbtcCTO z!#qtu!<)HMhDMYk)nxful=ansq;pUL((nz{Kt>1ssLy-)AzkA3Iiw#pm<=gRcU9JxO0W@=FRWk|O_H+sa&3rE}P z#h!e4?}lVIl>0uYEop5shitS2gpPt!c}AJZ<;f&hf`P~Gb6E>P)E7hX2pmx~vcP(} z+n$H`hdk0Rj^g2))W~zW+v2@ONxYliSRJfd4$ie%E7u|s2?`^uF_|maOlhQq2U&$H zmvWQ`Sq(QTI800D91Wr{L`b!&*{i{Nv2bXNuPsfjw&~FHrxv!T&{NTBDJFkB(J|>1#WbM`9GV_M#I^2YWu(~GI_GgK%MrsjoP$u#Vso1j-#!IC+()!Wbomaj4^DJwEugA3W-5q_eSEVlpBL*K-kxI2{<0y`@s(A~c}#<{BQ7nw-6Ig>4$saX z#-jhZjkk7Nl-K)xaa3g(d8pV9?T4@RgAcmx{O+;ZPCu=^*hetUbE^!z@OIkDaurpz z{VtEAk4Op?Y)jIKR)W$cl5I3K>jj3iI4AIj;06O3d0~8jC-#p+? z_buyWs|M^R#kgTXfL|n_=_CmE>5%Y@lZYtOpNT1hnc(Rj2+oLMrIU(0owX%nrz?yt z0uM^z7oH;!E2*{K?tw4Bu?4ewAxtL>#=q#X^5Jl?Rg@yeQHAX2y1Al>l)NYOztrIc z5p?m|e)gIp0*E{wtl?%ubhzaylu@Ydgi9Lj4-U8>XXBMk|?XiNOW*mfCoK9G2pPjfulkYg{g%iEdSTtx^C}SU-odQxUQ;s znS~?0XHBX?x;A5zf7?J2PwxGVlQNghW{L+EytnHNLRMg<41)*^$CBN036cfez%NDe z*Tp$zHibJIl#2H*KcQ9fNAF((TKV>pCy73Cg&2bq0r~kDY_GJ8Wv+^N+{wgjw1*oG zr$VCrDU~V&8O;OV>|~M5DMXlOq4Pq)WIjg?NLFw#P%d>L!a8TF0R$L2v_)6A0h`bY?1gpHC=mZo^6KA`?4}-wx$9Uf;c2F zx2igS74ZBQv2l#LOrRr}j&V~RH53EbZZmY6MtU3GGY4?Nwx!I^rqXtIoJe>(P znJKmsyao z@R@ah2Ew&c+g#VEj13c3&aw&Cyv~54S_nhs=toq^#!q~}6wACchNNm40UvMDN|z!| zB9?pt%G@)Fl^WyB^8(aKqrSd}AEFFM-zxxQM;6!)=2Dyv#E=4L*@GtmW1Hlte(X;- z21E>(rIRvuP|b%(B&J)j|gr4iq$P!6*gA{+5}jIu&BHBs+ia}{yC(g?FX9?_$lfVbf3WC zWfbRgnM^V1TzY_HHSy^+X#<(FnI3{~1-;!FWA>Td0ZDJ$8O0t-wZG+c*afBg;zWgj zG9r-uqr?P~mSUfk?dV*EJ7;gvEYO$UU2xwU81H(BYT(2^Y!tOJimJLuvJK0s0Qv2I zqu+$(5d`4D~tU+r5 z40k-mD~=B<{9VInu(0Y}F3&5Ly))czj1pa>X!|@xQ9g?yDos$kq;u#^=!b%VUEEr3 z&e&!u=^$UH%}sTZf}@R?*l(Rgc`70_NP4RASy-%WOfs<|VhkP~%bAVacNN5YKR2IiPM{L_Zk8tA%GZ)}ehkTCLazG(ze}rI z)u`9|jt&`xDexbE0RB6M3*-MCO|I6^j5}mQ^4--Ve3CvA)k37a$mF?Z)RbX>L?}jo ztlI(qW4O6BmMETF+UfS|U7=A7r?ou}5XF{>qDpf4cA<2~sV@lQM>EFxb&$^m>gNN| z^PLM$6Fbpn+&^eU;Eq@il$uzEB6_FrOKr?3&Gzg21}LG~_YmHwLU69u$5*@^$wZZ2 zH^j4Py%-(#YtCh4{L5s6qDaIPi+!k{b(F9-bsfHTkqfF<7nXu}_;>qJR}DKiY;>AU z(!K1DH-81-dKbmsYrkK8wAOARO??2Z!O_{e_*PP}3ztv4c=zWpl$aB`970RrNn!frhdGrn9^%ERhuf~yj z>=cXo;X*C8(BnYPzPCbXZc)wP^8|}!dnAVE#r$+_t%@hsL!i*hjXXKn&v5b))iAga z{#ys3b|kTq?z`s9b1XnoWCP$_%Mu<>MD+DzRaj!yKCSh>HhSKBsNlv<5Jz=9yW=2C#hVtE1mX##yB@_ z%WWf?cUS5_&`K=NXSHA-<=61caQupP6FHK2JkWJz$J8vhkfpRPvUb8wTNHt;1*H0} zV)l$k_Jf^0vs`{y47dFi$C}Q-(Lkg=YmVkF9<+*b#sObHn;5keE~p3QwQeh+Ly|$YrFlL+NmfBViR1`Izro4+-g!uCEDK6=Wa7NAH!dpMM-&Tic}v)Hbs-i@W=cF zWIEa#NIiwP(X%f>d$q?@oh?MGi92QhOitUDe!TQfNZ=B?rv1+3P72>d0MO2JzIwB& zGLYO!)!rV_hRVm*IVu8>QIKg6yP-RMa*7x=B=(Us#SD1CO*Lm6lxNwYz>*b z-GlR*oiYf>x*2Ux@r2SXi#v=nmn;Ecd=rnu^rc;>2d>G4ksX4EQ}VnY8%Rp2ETC0W zDgO^g`QIrs%YG!gRxbkNemVXR>92Zr2;Ap2I+pKI2i8&KwfeA{!NYgNLVSDMY$**K zaULDK*M2~Wm1b8~_r$t6XL3>cxnmewJW{H|$q`W}5Y_5VWRw_GUR@ZJ0Flb=_8AeH zFD*ANk0#$G40HSDKvk;HXa7^KIzHUz^qY2AdlG;DAA7|Op`5S}(9i;|#ss_*FBn34 zl^wTqV2g~Ki7TByn493mGs)Htq&$h=YtH?918$Yn>nt}<6_;MB1*66=P$!kzpq*If zg)&7KsK1-neEDGgYnwbRh~_t6fd+WRR_7KacKta$y+IzPRx~n`ZQd!&pmnCoxIMyy za3956A4_{0l`GCM>I5^#f3_56PsM~<=iXn?myR-r=EW$R2$v@P3MG_^#93kzYXfk;#lYZKeHf zGE>Lc^KwpFWe|x@qagMbv4WgN3=8Tyu%Df`zxDjs?Gw_sqT%q1HiX)rR1X#v4Zt-a zum!Ko6?<00CeM_+`YgqvnEd6B5LTWO7BRvFYs*&T3qy5)yD-TUWM2g+>3{MYLsh zM-G#)Im|2Id2RQ?UPyrgNwNspaWEdgYVwRk~W^qz6X z6Jj<7Mw4gQ*GeM#6d$D-V%P)_kX7w$;Y3qZr1>;e2c_XIX4ItPmx;OO^^hG&79T&e zbi!Os^gui|+Ub4FsP?`5B8houx&!Uo#5%lJp?-rIFYuS()Z!SX2iUAwec1%`AN7T` zAE%`+r+oc#Lc|1y2Q9o2|Ca;HCLh_ZiE-CU|6oo{cnrrx? zLOJolKY!~@2Z&S_%JQ7Cqv-pyXvb+MEB~MR6Sn_~3Btt6@PAgPn*YcqZMGqHpQ@js zl}`*H>4Dg9k+@Ej50%r(%VpqDL^2l&CooB_=kgx4mSPhSnuB3Dlv+;GMHTjmxfOjr zUzVursXM3i<98^*{Fqigw0$gYUzEaIi!vKB39GxoQ&*@bBNIPe*#6$KPM58Ho!;0{ zk69>+}h%F`u<_@5~~VB^j3cQG{_LzYeCk`pZBQx2qEIX zxx8_gHjRnun{q6edcEEK#q(`++&yTG%lm!rJOeh|Eu7(xytkh`-n$Vt@##@G+ZH>% z^d+VYey80x(!08>zu73%BVa>jrg$P{D_H$uCf7VScM!xHkxHG2sgvz z!L}X%Ntgf}Ev?x`n?6^#+Oz1Wq01l`;AM7)=#jL=@6g+|vo&|U;C9y5B;+$S{2pzw z-CFKUf6hd%8NRwNTUS9CIcq95Z}WK&INpR2ApQEBJAlkS*oX?psv;;T!UnVg|E(#QsB>I4vD%KxfJ5AcK6K13(oc zU-zfNMH${mreQ21xlvw%1uLU?sO-}J>)rJYwX?t~A7Q8oMyPJhF9Hn7I`#BXP@!S{ zL`Fy=2)T93|CzBq5V7Xu4d>Db6;*~1YN`o>X(;ltQdtjHdD(5>jJ+OT0^T1@#l#0* zrf4Y3(8sYrW005=0kmy&#pTj>u$nw(ooN~~E!dH*^sngr{T!MD^4^@r3>{fpx(en{ zVXooA4@x~$eyRQa;{w%9HP!_s^L{F8o)S(E#|HIfh1$P>3UH>23 zHYT<`vF&7H+qP}n$;7s8+qP}Zm$$yFQ*|!RbJ>?qS9P!5d+pzH?AF666sIyE?n~Sr zE^t-(qNHLbPoEsHD)0yyJ2`BNg+C(@#%Y4>RN>K`gyGujOO4^D!y+P&5{7f zqAWp92uqWK)$*9WwiIxVAh3XXM$(&y<96lJL!*c+!geMOH1j}k4CjzjxZME@la3AI z#;7O>P@~cFBpGQ0w=?G~;w_t4DRA^(4;O;vA&P+hlxWCQt1?uEJmVgC2d{ACG>^nL z0m{__LHe6Wq~OBlxOFBS^mjChc3jVxm;$z$fYNMW>4YpD2z3LDU3bZg9ay)!ef_-9nS1f8QdeiC zSoM{h1Y;74rZL2Q{O;esf^4j_=&a=hu$%{*`?2v3wjz29PSZDH7*lkJ?Ho3pQUm~p zR2H5OChOp+QFngLP=vE|?wAg-Y<(L=8Pq~89|jkKoIgk;B`R@(Bn|YEewXQ2<86zR zQ4gk}%-Y7g-*4+CE zzs?X(k(hmhVj}o8ohS-^DVw<{yKIaANU;#^qb^uma!u$)SdirODj6OM2Nvu@+g<0D zv6-1Uvei0)lll^ASMrnp(c&M-z&u{)2bu&=Q?SY)>NV}^LkUC%wSj2~0#oPP0@Fd& z9p!^UL~Xe{X^LJY>+2$|b|ho5MA%48Ruj~9q0Zu-aXtY(AhAn|1c81V4KkewHX(Ln zF9)J%<$U;9IPJ*bgBK6^QwIN;SBn+tv5lh!J4!7Ki0kaC7^2hze74nIWeN;AI4dx6 zy%3SH`@o-!y9ZD^9=;JrDRApalBmI(&^wc|(BUhdyg6v;K9Zg2gld`z0p(9tJc5jy z1bGY+-Iy%cgr{^z;T=Rnh4dL&`k4=%vU|f1X~@fMN6fXEVrM=gX#09Oqn3!+AtDuj zC#*r{gmy)W%gUqb&x}T16jkst3XU}r5Hx>)wla?QY0at~!!W?s_B@b_uk@k{UmY$;#ruUNRGK zcE-rgmV4H&DlqfOIke3NydxPqf1BM0hnD$h0v6@-Q!T$gE@lQiWNXqUvK{4+G_2l? zn<8+wNxC{qPTV$SO=M8kuEkxYbVwz@NC!#11!6iJVDPep;L53w@W~oIjBSk&`Fe-xS6KW?@b{A=gZ$Gg zj2_>lt?K&euE_ocDLOO8PR%BR8YZ!mA84}$iwtmh6M=>_5;iSnFDU6#EpHDBU586) zKBDr6a9{}*YX+GTb@)v9VQ?Kx!qz@bcc?gw)mXuSAxz% z{|R)%#POe&%_WT=>hSRYQHLQpIk5E>uU`iE;cK zB=iu#WYVI?XS+$+v8fo4C%93Ksv}L_*{tF?ndrG{@2-iVcjf#2>D{+yTtErgOphoX zrrrk`^-J;(Qvmy! zlq^j$Bn;NjwtM~nTLmR6WQEx}&@!mvMWy^I8FDbMvl#u;LGvF?L#rCu0tSP$odT`_ z@yt_L8G_5bW|NnFymAB=UG}Bwx2o;U0Yi}hGGvxI1GOZ^plB@5BD9f4I!Y*|Or!8b z=0V5XjrDIUJ^ae9_to+nn=V_}=V7;xz0NPl&{qR{bC-&mGeM*hd#kUDzB7fFuT+H~ z!QQeB)IW@LNMMs#+z-wtD5E+RI zDzNhE!xpuC7`vdJ81TIfC-^cQJp|xBWzBU$|Ffc3f0)+Xe zplFyJZpm=E;ljWjOwjkHinm_Hrn)_BG%_nT9W5ufb>E#A3PJ`6hsT`Gs0lu$5lLPLO{GME)PE(A#g<$D zEI>HQf7n%i#C`DW&W;gZQNvg2*$HSD=$E8*!_z0N2k*9q+F)ahP7ht?)_}92goQKq zt9Mm{v4zYT{xXgWfnr@6EO%4T`T_GcUEyL{bt`iiSKu>KF@9xD zPd%{Cw8cP~UDlUb9vqsN)?PK;jzciyOKpdf*GGCJ-J0Fnc9J@1^hO-QYNOfxI$OMR z?d7h2yS{t~HC%C#XY}+lp5QxL1pQp#0pB_>R3%XyJNB*atn_5>>6tu+rBId_jHLD~ zDridJ{V1K-AKSf6;+;0LmR%8vgzcus^C}fTb}Zh^wI7`S7tF=WY55oots({Ck`))y0 zlLwN*^@i0e-FjWCIstagpjbHBToo@u#_~=KW-wB$W3h_eI&;rN0i}a0m~0ffHT21~ zMnMvzN{$yKdQ?7kvkZXj?M151qwZ%(AYTpc<=SLb`B<(pe z)w!Z3ZN2I6zN+C8`*y4g#_BatCS6p5*jV}lHM{fiiw**!QuqQ=YtA9FG={#dm7*An z6jAQ0;*8g*Z<;Vg*51mSQNuaEuP}ahAqXdLCLuP=%hy}oOC8YTNAqScK;fuejur|N zw)C4Pz86~Dqh9l~_La_+=4Z^F`g(+shPW8$D=wv~m;UGG8n%a4FRLj*8bvDOa&$9% z2>9i2yRp)K2fXl65n59t>l##3A3zS$eqJX}#31#_-Wj3f)onM^24uTGzK?REN zgTc7sf2%HlY&nh0$}mX;ptHuBm-Z7Ckdqdam|^ipzW7nfTT6J756T?!RoJArj7i8z zvG$(?EWcS|%UhjoGfx)my>dqAHd@1{zqvJWfMBArBEF?ezkb3gEb zS}`0~7YE7Xmj%pPR_{gQlq}wmbm$_=r!ykZ*Ikt6zn8JC<_vD36e{(Kyo7WCpP(^ISxwysFLmu9HQ_`?JHP24RwO13pcOVwosSG zZjszgqJu!!QbMDiG?z?E>o_xbrt}{!_B`)3_!;`jp7wMIsqowe8>pOAXnPiOscB>8 z&7GmdG2^lU!L2OWU}T=h#x5j(G4kjfU#M_eAp5YYneuLHhob*Tl69KKpAMk{l)5mI zdUbAygV`blTsSm<4OhDE*0K-G{ z>yjh@keR-)ZSO)_JQBI3^ei6HzO5g(a#@crft0_}Lk65jt|j~X-mWwzA9p>t23F1* zrJI2>r|tQqy-b=*hDHo}V}Lei7(?qM2&n8i*S*r07X$gRAYORt)G@IW%$!TQ&7|)R z!caPpy~`X%m%1D@LQgm~j~K~01hlD&C>!a(lvNl=W}AC_zE#l39gVVD{dn{rME?yD^j-dSHKQPaEm$w9wG?k-BFxQDNZ9 z)%*oVAGvnfZv2-Rws~tjLs>dwDiq?O#kM<@x|^e{XdO{9-M#z<{+iL}8S}uZ0dA%X z{Z5xkfIBi{t=t?GhaNaF3yWswAQ<40VYD@i=swu=ZaqN<~Sz zHHqOV6>umK(f$kyNY#(?IxyEskEpn!d0moiRXYg_>0j~O-ejdzzd=~004DS*bOw@? zFniUq((%kBtHV8<#8WOAnf9^~W25U4g0H0w1{uUjW1b17SCISB6dE}WA`&DzR1BbT zr9_WBmGQjNW0}Xb1ygo2IDLgbJ!U+M=8JJFbrGk7Gq3 zR;j!MqTPv-RIGEGj*QN+-j1W>%s?NiOl%qBZ^T7E1RE1}R{{b1gcY^GO3*F|+nl_l zR(xuIN?eR`vto0G`>S>n8`=fUYN}Ck2jf7j9Uu4R_FA${IP^LeZN5D`n`W70M~aB7 z9*wtvr1tJp-Abx_&<3r2*3C7{A-7ds`+6x}GAP}I@M!JndAeaVg+;!P)#ocnsvYP* z=m;e~sfo=7!a?mlmhho2w&tJfQ*si+hD^~C$gz<4CoBwsos??$sfM}cweC;tu$o9n z{R0;yhMtg}Top-G75jdC9JDLnDRUSjll3mPqS>C72iuL)cLhuR6Dm{s&?xw{(o>r< z2=poHCayz;jkbHi`E!0unukiK225_#B#@A;LN8@_iGx_Q`r1QOY(bfvfp{Q$)G2|h z$OdSdVex%g)JHwGT|pj0Dl)=X*=LkzHb@p+Pan@QOlvJ4izdiO9S|;K!lLE#CH@FE z8$vLQhcKB_y0xz^XixR8C6Vv-t8#qZ4KFzuQLbe00Ku}Fv4I^zgbot<$}H)vN~(Tm zXU3Z7ivCYy&MIYM3tdE`amgTTDrfL404jZ9^`!?{s<5GYD7!Rp|CJ-D9RJdv^>X>A z)u(cZIgRnwe-8zN$#PUDoN>NdM-^U2%m_1iS{>LMZ!FJB$Yk~HA=B|gD)l5sTHXSUNJuNXeOEn0Nld}PDsUs_cU3?rK4@rc#;}J7=@Zw7PFj18O&Gf zDSAhcWh967qg)_eT4yGF37jia%Rs~1#&HlHVX1q_s=#VgLMR*vs|rh4G$GzuEo1qa z$5Gd<$VhDcSI0z&8Iow8UXFmB!XY9M1-CeIl=Up+@<&Z$wzOGEymWhqtY2KKl35th zRXxch-AA*(V4BL&gYk&~F4Zu|<*o{4hCVb0=+A7{3Yupzd`QX;l5P z;=;2ITZ8BGLp^i4unvx%zlU6h%@xoYz0t*ri@&QGG)4!8#GXkjI?V4HgQFmt3YOhZ z7>U5{{HxW3Yh1nmEA7Reb@QK*zrD?7zEDcEC0EgmO}!TaU`CjG9lpGg74f6T#O88* zm7po*S^G3IzqW2gnAGVcp=yEia%0Me1`3Wv8-cOi=_zlb*ECsu{n9Pm@+Y7PcK}6| z__v6pCx71zxNLeGHfAIpGQz>!YavxU7PPZB{?#JiP*^n}Ke7Qyxw@s&IXiDYO(F5B zKS8APyHb}k7QUKj>l_Bi0J!?gEl}m#<>}8ZqXh28Un3T1g=zv{Jr9W(s*^No#gg zbD<$#G0E0UvP?@uT?{2yNtNUAi$BxQnS};amyO+i((f9G_GoLX>g2Pb5_o$s`rS}P zxbf0QAifqA-R$nP5oYDN5hfxgT)ETHjKHL$KW^~iG!~f<3VWLAH-%b;a{k8GRHl5b zY}!AsR~u69##9>*|B-+SgNzG~d<*fv-!*XLJv`zl7?zPxi6?biO&`rWZQzd;1K_Ls z&baIW7B@nzEF(NlTWxbRyLzbYulKY_%E3sLWe_Y2*AAjoeY`l@{-Si#4`!flGC{=t zTeEUo+sS0VG6Fv};jaPJ4XF;@y>9x?6i?k7x9C4MhvLH?nK_(3%91@tkGrBd}< z_#6uij1leB{&(ha-Q{vLtkUaKnGugzHj7WDpE0`$+qtvhq zrP;7+yOwBpdH45Ii*ale88Ka2bpA2+TMsNNilUoW_tMMox*OSixGlSV*qfrhVL%$P zuR8SH##WYoVH00>qYJ`YgRt?Dn69T1-ldzWD)MipP7LRVbgFtd*vKm9n-usJU35KI z`g{`&m**lmuqc;f$HQ6>teEQwgnmfORZH+Fdai~@VdR7ZMcC^p3``-m*zg4vo!co= zs1Q73h~tcuHMb40jr<7KGC}=G$4j|EO*}-S^c!^eezW??F_NLBEyB9>2<^ZN;qge_ z?}D^zJ?E@Ra=^MbbllCf1vXKS343m>TK^3^Y#}NZD_^$kZD=z*{{lQf00E#@gTQrg z{kw{2TF2Ht|Dd!R|jD#mfRGY`D2{&0`?YFY04Dc5wJhpH_CTk_W;oeuucPTvsL^5h$pB znJiv|VwmZ*1GYf87$5M;3_$lXLKjTqB`zsN^c-sm%R88&9OX>f)YrCJ!<9Tk!#cc8 z2eojp?4gf)f-*(`p47F{zSx0KGbKbDD};a-YTPsn>WmA3%?Lc4rIkepJoK7t1NQ z60&TxvprqRBqCDq#-_YVT=uYu{eC@Na-=>jEHg{K3`rHIpxyc2b`&b#J@YO+pEoTYkb?^HUxW9 z%k&u-ef&+7H%4~65D&~3^wp^x3`%PQBdaT}E%~%!LZxID1B|em4)7)9K1<6g8In^X zSzxuuM6B4x!}6S1bmvruu9~B!##rZ=2xi>9vzhc0y8A41Dy!3F*+jf`-%m1`nu|?> zEE#niJ;Ufm^#qu8YTLNE87H9B-Y$}U5VaYx$JG|>uA9=FV|`irx7I2(74N(jq(Z&u zh2bAEa~);uA}6paRvY!|+;K%Tp|*a%6#*E@HXfM8iS<#yeiEzT2LdWCzs=O0^$;Zz zot2g1ejoVo*fV_9(csyc(omv~CH<3Z87aH^tSDdYe<_m1c1t4#__}F4%HV)Bv-wr& zC)E3<^_7j@6KYNVPFn`;BsRuMV{sERlmP{PQc)_TBL-rAY`|x(x50bCl;=#yTce^PqG)y{-USkRwUTCz2%rFhM&emZ#73OQw1;r7!@A(hLlr_D}d zCY0t>R}yk^@Dz&$r(WmWfbnkZ0(1M*T8gUaM}2#q7#$Wt52Yf6S<~K-1HvdS<=uD{ zmB)!7U$Jtc&4?q_+Fki(37TcKb{PYQ9Me^$#ckRUc6))U&{BvMq)tYkCWxGNQ27sL zI1IG}2%u=YR`NeMKh;&|FT^9pHTS+}Ke(0_5{Ab&gl+iZOgY;^uTbYie(lAIf2 znmEv-Cl(3E+nWqRjG;W{#I|Pkn`BUN{AegtP&fyGFC@v$0qr?M zo;WXbjN%-TL5qvX>LyO`=bfts~@m%Xufd_*i464sJ^6NtZ2b2gc%n61dqm3WH z<=zu$3VtzgcbtL{I$oDSyG+4RLTud2%J{OpI06=PE`pGU{cmNt>my>5<9?AcHxF^g%OXJV_+ed&jopv7KI%Q#Z!)rOWmX6`Qfl?eIlBtFqQh%z6biF0+%}+ z!dd!;A?f9&&r%CHmAZUbL-B5G_=qM=U^2|JtmJR=Dl`o&3na%@wcagXm2ach0~=to z(Sr@P%J`psA_=LTZKGZ|2U}unxScE_B4LXvnJ+kp*OkNf=6ym&(M{_D=?UV_l|QEa zsX%G3JoSr~K}9Is1@m8mX^4?A;r0%cQ>h#4)n%&PECT*~#p9pvLt;xJy|FgJL;Zwm z!BX7oZjGhl2Lo;D74-Fn8&32$mk9}e{8$g?y~Mrtx$!gwZl1aWCDJagwJ$gK)Kxs< zUuRut%4*&E2S(=QPsg_VZw6xv<@SNnr)z zLC1~Ndn0f4H9Fu?M{YV5ISUT)n)E#sn1AT(5dh12bkx$NxUomo}rp$E^ zF$U^ykh64Vqqknzr!itmfpEHf(=Z-Boh)z7>e-9-q_Ju^!R%)F9Nx6Mb!eF9fp{1+eALrvR@Qsso)6&}Y0>^`Lq6VZXS2%&K`s#Jq-9?iS{&?BSiS}QDYVjOl>n`XST zL4?VSmbEwrdOz9{vBO646}cH<^+42j!*jaxx~t9&WQ9b+VUzod>K?>e4^L$k#=(bB z;o|L5>h9?EtWF>^@zD|p{&7V-V;6RTFf43--2$q8`G(1)c+=w_4wVd+@_Zyzy8XP` zffn(B2OxcWjc;+8j04OL3Qk(;DBxIP6dJRv!`mIF1o2SoWaAh%vu^?hrP^N3BvE(nyz)_&&TCDpR zD^Y5)y>_HJpY9qT`0>GuL}mOt2wW02!X`#Ak=}n#jwmeveM%B$Hh$W$%BHGq!s&WBPWC&OEf`n zEYjpKICyX~YNXs#YMs8vf|Ip86*;XuuMjLfN)u6D7xliUmJl-M4+CqQyx#@AUj&I@ z^7WIx8l385_4yX&NKk_0?{~Yd8ls=5+CJrhjfN)mNmbm(;+bKKcd3az;aeopud}|< z68kqxcv+dV$&X$Nq_QM|UfjQQ!qdG29Fz{{ceV!hUx&YDw34&z6g()ZNl*6%;0J1{ z8iY0wp3m=`HdPI^LNS36`rvY_tUI88MS9zRMx6(zAZFg%vp}3Q#jSgmA+x9D9&-vG zAl>SPmx55rI523%k+rw4R}S?{2*?*iToeicm^4RMMgVsGgc%74Mj<^t$c@Ch(nI}?A9Z^Itw z?Pop^5%!BJ6iSwd$XYc|+)H_ZTV9r~VR_1iZE0LMhrM%dP3a-P)tP0yCY|cXo#ph& zSxoeBgmDaNA2>E=&$eVQDttM`Km@ZYV5@*8){@4t8${@#?*`QH0*erbf8)m=4Q63-#=^pPk zqJUJtl7AT-Ui|pDQQ)0;emXHZ7)MpFVrYf=wOwjyXge?<4Q7DI`n~FYtQhJ~PVaPT zY{&gpdyn>qxm921n#3sbtBh<%xNZ-+3=wl+C4iVhr!XE~PyDF#?s?BOF@{YjAl;H{ zpKy#Wn4C#%^>1FHFMN0_Z{0XwbdGszL)}_OfgbuZYE2f==Idd~NU>sw z%6c+kAMCIV!Ah#qTqg|XY$`~&5&WiOC%*(>^`d>;A%(+>r3;$yXu!{_+w%Hg;b&rGtjJ_Bb(=v*dQFQq82D*EkyMyC$D-R zlaxQ3&;}_WL2iyC-32ro@RPJbSfg3)=zJ1Hy+-->lGSg%GO56 zw|6sZMW2w}sr9k;NbPyPT1bMMDR;&P5Bg(!f00qOn0grQMG6d}HKo?=i##8zn0~pr z!Ik%WS)a8)MvEQ8`@y|-5z^)od!yS{>vtgt>)uRPM$~M2hE;yEDyN>#2?~i$qt7~H%vTP_yQoRc(CR6= zcQKknh28HJIX--mDA-r2B|=1*NHFM8wb&RsiTFB?n@?le5ouGDb;wDXu9lQjX5duD z;>=cx>)LAD(tEnUtKcT?c8y+CwoH6!d1ksqq{$ScGLs#!Oe=7d9%htr13 z5-rgA6^N|2QCvGXaILz@T}qFe+rhSOYvhzNw=A7fTr(!jdr)fEVQ&33+vHgSsbmVt z^%U#zG1Ry8dOZ9fmc;0^ROegCtrk>8nI}2#kVA);eMrOo)J>`?f;JR@yR$S<#$8R& z@r)SkDT`{TWXjq;(1%LdwWgbCFSadzTN_FCN#u{ZF&XHH4Cz@3%}dr?+m%bUj|4&m zLUJX@qwxToq&cM7w5yn<11|&6;Yx12L-R*a=*j$Yabvi2&b7nW4(XV{9Fo#UUDx}g zKoXmZnk3H`0Tn(h17uGeD(Pb=sN=DNl}RcXdfAm{f9kjX*LDqbeev#ex_^m$4rEfi zme8>;L)+L@e+(d9=8j5**hUfmfPB>~k5{}kmMiU!0iz?bE5=R%qPx;U5eShPEC{OE zkvk}(j-TxagSEvs@jAm~ae_?lfaoo+*D-JWd6%LDOXP{(?d6WD9MkjXXvb(>WfXd)11zW_vXhOi-C~L zBdU$W#Ek}XKwl*DnD2Rig4`oe<|aGw`q9nCEl*>|*)+@g;_iz<8W;4Y?!skbdHEO5 z`$3r&fy*6@l~JE-H>2m; zL4euIt2e0XHhY?CFb++2Wf>NhB>81eY*bMy>1a%df6}prMzT z`3W(vIuUz5CRH~pjqSo(%<6*H0_oWf-~$qsb3-O=4kIQR zN$JLMWikCYbk_=_k525IHBBzjQsnz53#rT5m#U2|46}a`>MQm_*Vd00+{V6gNI6te zEMvJKFKL6!j~xGP2KDZhyE=*l^c78oGkmD@tN(P@VMG9xr1{SRBp2LG?GvB-_dkjU6WD)7yV zr9texN#8ApP_OHOq0gA<`jt!Cl4N4f<<^-H&gMWjElP8UodSuLHh-NHss^ z|5}9oPmE<|4yOMg8Z~K3B_1^YpJBh$D}1;qAe`NdJd^~jBug@RqRDgOus5E8*@-1d zwaCTQYt&YbU5A9#uV_s>Rht?L)c;zPuiNI4W}E)BAmHDrAoFXFMrAI#uXoGqPZ5@f zR#uTgx4lLGf1MBuee@f)e>&e+b!!OEb`ASk^y%;4CZs{?--aC*AIG;|54o=Yv>@Hm zvB6;uU>XaWaK5j_7`0u{N~(lqV9{*ux27V_j^MvpC$^T^wB3|scakzn!OE!4b}A0^7>{% zCvkFEB7qgeHE?6`T5}KQ(^{0IeBt#>5+LVhlTVYqCGTH=G7A@G!V?`UDRglq1%*8= zOz}}xnzyeN-=;VaXhD(md~T|&siei+ja~BLO|&d}7Q#v1lK!>GNa3HX_lC^77uU!a z7-Hor41&IBEDqt?5^PWq$wyG9UVo@$(dNjONL`0%yyNt8mj{lcZNr^y!ZqkIaR1+? z=Bairj~@HR>274y1w%iHKX+dAD6tQ_cS$bCVEDiDHF(*&{vmJ1X*^FUy@HGW=6SCX z0E%J5Rd=HlszyYM7cj`tBI1baqf3DCPZ+f$lUVLUM}1#!3-I=86cD=U94D@NWiA19 zlC@4msAe#z7J@?_3rXQpl>_4B((h1+qCnd>Rb^TzZ_EjC15VPe&G~6bIt=7MzA@$8 z+R0%&@hkt`=Qj~309ohdpE+ifq9G~f*t1d7%{`2t57rqOs>88Koc)>U=gdkTYfmw3 zp?rt$F=}{gI%J1k^~-%EyC?|{kMtrGazRo>O8%rH1+y}si|dyMJ5Y^<%jt!P!lS0k zlJb)SF`e@iYq!bl!;71ph`w?WVs7kU`00qbCH@s&5x&QCyI!|p1}{}IrB}(0F(Qr9 z+1~CJavUD&I>KK+wz2$*uU3cS5;)q_4qO6BFJQ7$*IS$U_Dtk95D{2roVT%Ft^jh7 zp58F8)Lp}(DhK+k2GW3wr2zfhhX47yWSr4!JUf`pBs&1b`5`+=G=L;l^1-D!f0JkYdb%T#Bb8Cbb#f*X!6^J%DO1zk19-xP8g-a=l4eh|tFSkh5Mja6Y zirerz&){BxaSw>1I4UB2foYuL5J~}l=Nh4E#GHDgCi6F>JndBrXB+?MGSpXN*Ur@- zNd5rm&7>@`WCvV#6I?!6p}{n8c`c7((==5GQD+2~yYJ<)*>mY=8vK1_KP8|RDl6ws z-|+g>fGwfT_MHgPs)HByxPd-Ql8jSevAUlw`50r9#}5XBZ*HnWi9L3vZ?CFls?W3Y zA?*&=D9GDLdAqWr66z39zkm1_?dq~f-Pm%2$X{ZfwHPs>({6<4ZG4Y^-m7nN(yFuZ z&H6kC>&XvBd-mJuLZ6ajW1(%!GXjWUH3Z4{&C??kf5uRj#;d`o==KN6%z1BZRyRK& zpu}(gd~_L3v&q6cIL*I$vxIVrVCMXC^&UOG!_>I7qqbql=x)tTlZVP64C(b+YtjBewy-liRNul$iqe^(p$QIbenJ903jc*uOV<`nciEgqVZ{ zU>q8JdQZmB!qo)AVr^hiDETPq1;*`5+T8?`DRSjS)S;hSUg_3bwOd-y&=C8Y>4Xgp zZ28|pQ49#I8`2X>$4LYa^9o5|7X7Gd2S*4#((v@UOwsjA+AfdR$PWWRzW9K!^xoW= zMRW>Hr3ryibGcg-wOy#ec{G@&4yEx5TqIQwk(RROU<^VVqs0q15ZGh~D;Gk0LxRNkOE3Q{Du_ffnN)7B< z^saaL+ALm9lo4rx1^~6h9oLeBGqcl;A);U-Y!*V7t_ zxI=kB&|}}q0iR^$aX}qqyKrxtdmfld{mpvCpF5es3aw;N6ZQ$sczerQF`vP zMkKf%My=lISohfXKymcK5Fq@qLMEe@;_ZDX#rYBzrN_`bt{7fMi7cr`6J3U z@n6`{3C9YFT==a9KX!y8%Jzgfk2;ovgcVhj5AUUE-0Y)azCRnrD}RF z3IS!#R3(mz;%?m9#q{FG%=`th_Z7y;_;>2GFi+3K?4}raPN8$Z0GXc@CsgvBfzxDO$iUU2hA;*SXGshQV*fA<3%{ihm9>&9tKY(J1jmc;IhJ!@i>gBO zh5tB${>IKi%&II!Et+*(g{`LpCyNV-@Ikwa^F%`t{_@P@@(DOsm;BokWD2lA6Fr8S zK_q@s)WAZ?k%saU7;tQbL-gq z{}_9x?o6Pq>o&HXif!ArZQHh=*tTukPAWDkww+XrulBh*yS07s{))B6oMZOxC2WI<5GmwMK4$HYpDmZgeIf=s@PZkQ;p%*S>Y|`k zgS47V)2v}LfQYX*5~BY8tW>7=9rG$oy}OxM-^X05>t^lF$5cJf=%1){70lLLRm!Q- zx_oH&!!`|KE_dxxw>&8fR%vRxlK`9&5YU_?p1u)EgQSxSya}GGz`@n7?_cO5Y{(L^ z4U)b=E3!RjCVwFsoqg1NA~&3pAu3jhs*0RwpIx^3sEr=|!)ByW!isC_rH#tfT=Xb= z^~i^ck5T&l4C%pjn+WzAq*~jV0y8Kt9{=KBX$^`qp`^P%8-XgP;E-~Sno|h5&!<12 zSFr;z%&F<xJLFj z{j+*BC77j?m-Eui12jAJYu;949Ty-N1#JpJGR`kU8sbv7UV{xRHJ}6f$-DmdeqP}* zb0ZY2X1!oI0Ch0OseJ{N!{sXe27s|s(5T*TAJ==BC}!RW`)#Cg;e6`sd>CbmH{~H# zFyniXV6^7{g2v&LNJBt*iAEWX*>6}MRW4rbKZZIcu~j56_Q|03v*3bieKL8z2U1_9 z`5Nr##rw+PQRh?k5P%e@!2W#mdIz-VuDd&MVqF z4wqy9wwLut8z6;>(fd0SPgHzz05q{cLi%^4)1WlV=txm+QnPWo`Q4q&UMH&C$w}yU z#Un!91aiMy0yec~Dfe9w3o)N{l%*4((8->q=`Fa{%j-LHFap8VO}yr1a# zvgzNMXWq<|Oh+5ElzjeD9-T`609$h1^wDPp4KdY z%XnUgYy2{z|4Xr&y=&G^sMX7VL3U=+YWm=#{q^*( z_#H70&Ifm4eab`6!XvB9)1MyS{@o5ldFKh242; zxMhwZdkbI}y3a5=k#)xUQ4^-*PiDKwHXl1BA5wEVezerwESm@oUew~gHn+CAI?CNQ zeEWWGn&=ZwX>_0lwmqo_FOLRGvM5Gex z#S!}Ut?7liSu4q`9N8OQ&IrXw551-+@qfBHUi(667*T&K@~=D|A)yS8fBA z&l+-z_5_`0bH;+b#*woeAz!ZV&*uYgv#in9%-67E)pOZcY!nIBj~P{aRW{v2+UtwaL$QOm=u5Wz9AkVO-GMDbT#d-XbMTXEC5b6LSejn?8nNqsfm&A3?+6Vc<%s?}a+G5t5Of+Nb z{0m3M*RH+Zq?=k$u7BPSKs8{U=%N^(u%hnTm>dBsu8=G)kk{66w6m^^CkA~2h#0=% zuZrAXoo#}G@B)`zupojV=6}*IKvlCM?ni9w{WpjMm6ZCMV%HljO&kFS^s5^`ZgZXT zJ~_Xon>AqTidGrn`IhoDin)9Tu0G=A#up1ygSz1}DMcd)3|xz{|K^>zh6GH8!z0>e zRp|ss*}2Yqud{_5mPn_*^MlQ1RmD{)&{nFBr+*Swo-O-c6*mt&^ zx3Fd!R7aHnEh5Wc6#{se@FoVtQr~N=%n~@flDGKgKoeM9b<#7iwZ$62@Y0tdq*DnV z&`h)Ms9p{lpFuBYG9&=&fT7JHV{BMI@(S57+ZR=x2C{-;R-xUyTHgT~c&ErY8Fpf2 zDV{xQ)lCm8%5Rm3h>Mv~T#+VESs1gY6D6!WENIwLMARj740t*lB9mMX?VDi`pHLVJ zxy44-p|$_SPc{kTveLDZdCz;OeeGWl&Rv(?8ZJ>?Xfj4cBu@MbB zj{ptxqNbEQodWx3D4(hZx=lV8_BT-do{@=rsUa;$4jZ{Hxl@XiEa)K>0QVxMvQ(BO z^=MJ%5FAl;91j?{lRMgSetbFolXl8W3}oIEJ@5px^%N_o#6};X{v_tFy~Qj=laoQQ zcNPF8ST&zP&W861)f=fwE>QT2h5dPSd6S}u1c4C1g?Ass7=&1z+|9T8F_%Gq!gyCUmemUct4r$6nh7q?D zbXf5*$88Sh3^-!Ywl*EaFg87Q@coY$2&1p=Xa-~_gL(`Xu!K=Qd3~{AoKi!GXNU4s zAbXx+@l+8rR1Q^rO^IQ{b$r|RT4ywjr$JWlzRwnkD$-q(&2t#x5>LFHK;W;eCjI(h zJ{R8F8X~z0@L|qT8&$(?Gg@OQ&k|t+BifXP_$t&Xsz(WFymBaKecAx!;|qQy>p@G# zVJsE5zZR^!DrWRyLOmVCKgR_C=P|TdXv4|c;v?l_ozw)#f9#q(guiX_TV#|37kEB& z&3cNr2RBTnvQf;)cpc^-o$mTX`cj}Kv3p3)h=)I(Nrnxu2Faa4e-#75MA82l*N5u( zO6c=KUOaCTG{8n@NWIXH#Hl0d>1m-dQzp5=7cv`dqG95XdaVLpqB-u1;Q zOue9VsnpigoCRU>`d2S0t*#LBe4wVTvuAlxdDPKBSn;Wx{hYery;5DYDp#gpT=2l_ zfDCbnH77MBJVWnvXX+8EZ`F6j>+-Q<(96w<(NjIZe;q}{ zR5O9UE|^>6ssi%g&c{ZVMLboe^~jdAou>sh_BdVROdcEm9d+ZkO-iBcB!Gat`gC3I zn4fG?>2rr~Si{?UGPPG^ zH4{%ATNYdPy9ra)zqmmIXNPA2~A1XNzsAXQMz>Dj`!PTy&MPUriUWd20PoZDriQA*DY~$`Y z#v2rKbt__4{VG&9i0x&2`~tG3k!9~ls;7^@pJ|z32t`38?>hrYj^ZQN9mGF+uts_$d{meRC35R>xw%APXvKu5zOuLdgFj?UhujKGqpTc# zFOjx0z5|8)I0k>0PUl^WQyzo4qxPY^_EYfbUXA_x06tfTe!V^yrbN@!o$C)ggxBX} zd3tX+DCT6Bi@G&HO;czS4OUAi_lnv3jQ^we0`s@yBN5s0WMP!+J>uAq_SZ64`SR^t z!W|*8`8wM7I7|FoJ+;UIn=MV-) z`vzFIuzQKAqj8gVegjm8q)6qS51Lk^6I_m++T_u@@u@Kdcr6qe9Nwf+DQX>g3sbQCgL#~ z6wy8~2|;C8f9JPTm=KiOU{Zgl+*dlYF=53Fq*|(N|9+1>H?&ZjbOnM8&I7eopGI)3wYx67%Gve;DHB~^&`Y)AxEp`e!bRMOO8J2~YlF`iUy|aT~0f zwqhp?!pJV?>Q6larQ)7Lz>7gh=Lg6C3T2%CCu0^17wdn8vQizL_{+BcgfhklWd_IT z2oGjIn|U<4C=j7p9d<-*o$l(9e|KH86IAbqJj2Sm;#&7GH~cOhhIieyLD-V zY)UxFYRi7E`0sW7t{*2r$tta1j|`YS3!8}HW4mzQqv4Ecx{)H_M$`80Ry}b?CnZ^` z%CpVN4-G2nwl*HAo8xvrSLKy1OOi5A#&KW4C7XRXE-Xyaq&m}2uY2RU`oWwZ->&}a zOrW5w+n`IE69IQOAeLqkj2`tuiPB46@E`tIS-Bt1$;h{*j{7B=%V@ zHBegIZQgk5Kr-mqX-UHNziH^C%s3^D(2xU}?}enGilK{F{l+RGjUkY1IcvJ|?q;uJ zS(dxN9}#bxP_)EM(XR`**v~w)!jXYss5j8=R3ia9>M)L5RZ%bm@n5Qhs@ zw}zfXpwBuSMxY-D!9L=qV^L61vYy$fxS4Iq|*Te$}Y|t9Z)jHL+Y}50T6qJ*nc)&?{KCxp4=oKelm3v}sP#+z7cm0J>3 zgw#-kb5Lhy7+|phy z1lMroz!$B_)I0)c|EeWJf2T6=*gy}BWFUE`ybNQQ({0rXI{|a2OlkT$fi7qVys~_u zn-C*tkN~x953e5ZkT)iwwxTzzZcQhuuC4TNKb)@Ncnn6I3umYN7Zz#gnQMgt6o_DX z5b1zO=e0-+wlzV=ox*3UBFl!6F)4NHL)2F_!~825$PuBFfPv#d)UFY7itsx7#P4xi z;eUmINpcYt0(T{*P{90WYq>;fdW=R{!yiLZR`iG+>1Bg51{7#pi?O^WNvA`8_-oem zB|_%9!Z$vnpbE*}3N$N8DSyj{l4OwDI2DllXz)Lm$aGkH-UAdKYK>{bRl-UtC{-jF zgjL5@w4Nn-OJR@#dnllH|F%2=Z2V7xzk~Jib;Z_tqxVat#kWfPr_(c8Nwv^tZW=Ur z6rJh+pitfjH&c^AMx-|^j$aEPrI+M#e9H+ZYMS_P`;fZOckr;{V-ivx+2o?JON`CD zJ#D-`pvklMc7bguT-Lc^`g;`qf^Ate!_bTcVa~<(23M>G`dmY1ILR!{36Kih{o`PZ zSW{_Fzzx<6l`+HZ2~!%GJ`mV#9Hd!K_a{@z3poLIJ+ql>dmu$&#}kmUFt%kZo^NeY zI}xQ-WYdDQ!c(mn=*AA<0p6T*=O+Y%D%&A?mKXWhq5Gak^ZItCfyLE9sv419#*4q? zq4ma5*v2AlEL`S`yGA7?y;)g*y~cjPrU>1VY&gUI%L;$JWM(}EqI-#k{gncqB3>h- zcHhqb$1hQD*sDMFzvD<>;8U8lxD&z;3ZlwNLE91CGgFvcdCqEY<*SAsUc`6iZD~WDh9n2H z_P$oAZWW`a(R%KMTjy5PZ6il}rtLnAiLkUW=<)p>{yB}KRby<@4xtoR**^1@c2|2s zjtuVT6~;(;p*e>se0fLroxymc_2`u}7-QqlKTb)PI$716=Iswts(2iY|^|oCz%=@Irt1>J#G^*zl%zxW<@8E-Q_mV zw2<(OK-dN6;y@Gf>GEBUR|9PzDqSS!5=Cl0)W>^UL6924y9B={fEw| zF50DkKU3`9w@{ox+a*M?LTDH<^nrk7r0bZ@u@dh&-Ndi@K|}UO2&h`ameASX9A+fT zgfC&odKbjB#F>NHzs!zETJRxx5}GhB7?L9C@nsPV$UW@btVV-q^|BO5uLD8hnsxeo zj(f*uNTu)y_5+O)gPfU~lv#|ak)-Oa$s-gJX6r2)5No_7-K&v4ItkrbrP*uo7)StZ z-2`f^uvn9}9;?EmcMw>u7?TQY>n7A@8wnB|s98gn*pPm%#DoEQZMfbujwlB;HXVxG zI5Vyip^2XA;xuL^*Prj#2f@qMdboOpqf3~oj?Xt*Zx}v%S}1^6OJjNfy5?B0{{+b& z(ffGvGOW{Vshpk04~WVw2JvocSm^S z^s(WjJRUkjO)i|I73F}YlkqdPbM6{^~S+gV2Y^&eJ_d_<$ z#Hah!Ki)NelIivA1EQ{p9h;HKMjcA3To-$x8GlG%O;-qBs+@XTvI!ywW@;9;b4m0N zMW(zq_WBoa&GK?N?-}jXk{HHfnWH9|L;rDpu#vDFW=ymN<`X4Gh51|wEjK@z-5*NI zIgJ4qP#)C3uyP*1lgiJUR&LxBT1~RXJVA5Za10ZK&3)w%^{S|=_!@&>1savQ{PIJP_w;AZkk}M1&pfe z^A(Z8&DH2MDsPxBnXX`eAO(|cLngQbQs(R?XvjN9^F03c;ET2h)F;i?!QtBBDH4to zFW~4mbTa>ZYJSV*nW`H3QVPKbiI&KO>TT6E#&TrxLD0_qX+vdSy(By-J_ERd&Ok94T;Lcq%HVuLi=@Q6eWgAMhJ^BTtDB^(6{;|$+_)ieykg+hD6E69H#-OP$KJLolp zzbHxiDxoFqQ>}MSG$TFCQ02LXR8%WeGELPJW|lYZsEDavX#Cg(XY5$NCzu^ZV*HLh z@45nC?BJHJ%ow9HZ8Ii=IpTg0uSgN(QqF=kg~`=MOVXMJdb#qG@Lr!L`LwD{C>~zX zut6AU^$v{#;toDiB3z3il-~5kl{^Voexy zY^^a8Ir%)+QRVB}_3attRCJPjs3CC- z^kLQ^4Eb7<)G!j_V|0GmpVP$6e{|i;Ob#{|C{}b2^ z3eQERvLlfWFoDSxDpfqP&P(Kc{hA&Jl07NN(WsJB=GNTb+dVL06-(eQ(8>?pnI}Tf z5WpJNw;lTR2&>y^`lR;>`j|n!~Z#N-!)gIET1QajVu4lB@ zO*VyF`2ImOJ}wHW!rC4UF3;CC8f;s`MqRG? zZ8L7!(iK>Yda%T7Gjb|bKM)9HIdP5K` zpocSQvE4@nK{dWCUXzCN#>;;1sew;ybQ4VB%p}hsWkb4ip|5)I$u-bryHkF^8e?e| zD9%M0VQC1#F(Y9)Qb&AP(}7!Xzfd2x+?0jzdu6q}7;M$FvfsN=PKCgYtqWY=Dz3K0 zO=dCK1oQ7E#Hc+AHp6u@ccpS2YFJJ&mJXYa=dV6l+X1)%pby;3ATD9z(EC z*oK?Q3>0k9j*3QB90hQyE@Zg;$Zl<9B#Vw3Y6Vwf?FoDi;Tw+=(Xf}sa#dNp?Yamz z2qd1Dxm(F9rFv0pQU~%JFZ1@HJ@>N=FB;R>%Cq~!Wpsxa5%(HnkD(D|rTNYIK=v^; z2u*GysG-uLqr|7F`DC^C?I~DI!vl%NDTAF$aX1Y^oOeQ`APzl{yd9F=c5WnqyupHa zZIf6oTW;Q!9>3BMydBQjVA_FVia4g&7n&D<>;rq2KmfG z4R@LYojoJye$lFMWda9~__Axlc+$~n3L zyJ~VnO!%LP?@~W6B#da$zmkGgpdI*J=F10X4}ASn_5Peger;3s{GnV+I4Yhn1_o3h9GR z5JpL_qF6AeYzwSA93;^PsxFH*mROspB=>AJ^^3R>+KmZ96uIUdj4?p})*MnDolkll5P*d&3ClBNs%C-mdefe&w;aqhW_kCO#Ns#V*ZJ~FJ zd2j%EleKPfH5sJA`|0~U#P5C{b=isZFM*^HVx`%)bnZ|mXo0KvZ>7e1nEs}0!Elkp zjey}jpoSSo9biXjalgCm@bLyXp5$y=^fa%3cO2zX?22}yvFk|^p-ssL9dZ+(qY{h; z^_D^D%keL$#DJ5qo|@c=fDKu8rzpng?aC5Q>4G32R9k?KB^ONR4S*Np)x4>7OLVm3 zhV}CxJi)*v>PK~vBXgZ2Zm)Xf&#{7;t9#!-@)JlIb@Q-prUXM5Yb>v%ZET*kX|8Lc zudXS7it})UwIo5*j!dMOdy8rdI7tI^dqF_WQ#TRO4;ins*su&YjEBevAoWKlfRwYD zNP3BFzlE8Bx-$TPE3`0!elTN^xOa`)Y@zlPZ`MZv_U54wkdwWwCAPj_T`26}e*ja^ zY3qPh)Tl>;eZe^;5U)fONk#0vuJBx6RbIm%mX79xKFU4MXJ>R%xLUWjzN`kvLkn`6 z=xool?C1x_b=2WG=hn80DgVa>RtmH8$Yj!mE90g)H#Ve8cj5bK4cSFgmJvS)EKhoK zGF0H8wg?)*(&>#xex>W`t_bx6QrgHl#*Il4L!cb1Za53BdDf50&tE8&OiR9BMcV{GzqvQEb!2yN zmF#Wut)T+l@@5{6pZCwXDi#xR9u*+x=PVd_gW)JuTq>;fWOw{oH6s@?IiqoABmH-G zGH8j`cErbrozc=wy6`D0B!m9q2flir5T6kl@%u!y2_*`@TRgXb5f*EM>Q;V6?C0qJZ8eRUH8`CK7C1U&yxQJ zK4$T`2Aea&HT1@K264q@p)EM&j^N|P^UakCQZm$IQ-v11q0L>>NpluJ=**v>fSJ!= z?w6QWrQZ%Nj~zGVlj~*@$X*^q%F#P-iyJdF%aES&Rc~U+Nk)-k_6R*bZkM2~f6}Ol z9RB@B^U5QdsNgZ>>7l8ii}`?$S?Ra6gNK>|s=7b0*t%JSfp^~&VnVswfc#kqFwkEa zf=EX7Nw~9ym)~-s)pvN=AkF3%d%ie%hnPx8j^!jlhW0)`Rw4@0t1PFRDYgACxMaES zt&X8Q$B#Y7)?CW<1;;aWgp`|vdXZEZ85f#N@GGw!Wdj@v=UcYA#%^ccbm*$ZaKAwY zl`$I)IDa^pt{A%GE!+jgrb`0RXCe*7s~>F?`d>Bc+$imzgeU0+_l`PW#&ftW#xg1~ z3?+YY%OK#T3baXhJOj}=A;ZBXW#%&s`K{f2#qbCWiu^@@XUbaxh3C!H(L<&?0%Ny5 ziF&dnZ%1#w<>`s zwv_Y(r{URX^v7HUa0~eM+PVmS4}Twq2$m$5g-|YF>V-NR2g?XQD7J^ESN&1Pq3~h# z6cojwLB_OLru|x6${ru45>w7qzfOZ;LY(fu#vCwP<`zIVfy7tC(ZssUmjt4aY_$Hh3JP0qOIOVxm@+*zIvD`b>B?uK6q^F#SrUig|N_rsvBRcB^W z*A51}d>pJ586q7w0gU*BBb(7aG)ne#8Lj4&(WW)a%UcOtNTAg0$g7^)<31NGuy2S) zJ3&HXQJ->}EQ^`|0@*p8kEabjhm}>jyf))DFw9A<<1W)^y21vtpR^Eb$98T-DxRJi zZgz+EK^sTuTLXZ|u_y>gk`{GR12J^UnWO1iTSH)ZL*0=E$3UXlItl9JIatu&tTDMe zRY4Hh{e&%bsA|2Q0@{zRHf%<4ox_`LMi%||D3r6vHpAE5 zxVyNtrb{kPw%KyKE(sho95iJ2i4G5?xw^vwbN9J`6E^u+rMiUBvo2PuS3DBCZ(we< zt75pR?}Wn1`kE4jCM(SaMI|Q9dnRptQ`m;gc9xZ2(*XX@WTemE%|$+(djEzL8}nQ+ zaGvS3XZ8lRP;GZN@x1*jG_zII&OHS@-Q6af`dqxrsnyq6;3WfS@Vs9Bm)Ckq1cxtd zjM4keu&K!#;-vp>s-_k$13b(W8G(|D73ssD!KeK?2clU`9Z7c7_`&G(ng3b4#oT{E zt&iqnBtORO#{Z-P9@k(5VA4|uP5VD)0)R}>I7NEX;V$dpBt@p=0Bw=M6i5>}^|JHkl8Kw|yVMqIKL>~{&MxZi!}>KQlTb( zc?Bp+lLhds*=2J$eEjf#`jzjQ*@M%@Fx;t13Vc2~Sa)3&=DRD#Y1MrmnfP_4o%YaN zM!9#WnPKj%{==*r{kZ{hb-FgF(ad0@&}){h5|oUS`IVWnqMrdad)Kt4m6UJw@?l!j{+G-x%ao6wCxv%?9dMDU&-?DA9*oby+r0q@79kN ziN5HP>T~bVXsM`^Mtgcr;^co_$PySrJFNYQR;oI=1dW9@eS$l^ltu#@dfG%7^Omms z$>raSZxovAkw>dL507tjSMJx7GH(J~cm@)aSPG|IiW(IH1$}JVMeGx$_CvohHLI>B zi%JQ4{D;u3Uit~n1It04)36)%+0VLGrSSD_>{oz)Q=V1!zI#L+pt<|SJPbOWK)BH8 z!#OYKq=!wU0jd{z#z6`*bDvh>?DO-2v{b| zXr*HEu3rN{wHR(1WV}{<@=zp3dAQrKHbIXD!*PTB@1=DSxtWa&S%IUwU3=NYs{f-~nWV*o_XI^pn zxng4+54GK3K~Vi96WA4GBR*)zD(zKrcS{f|%h0OWv0yGCtShRWWANlxh6iU?eQpw6 z63GS0T!c>wLP&TNeYJrx&mX_mXEF0}#&=k8l8YtON~zo~t5<-ri@k8G)W z{k6F|SXcH!`1f>ID!8~#1yF~`PS6fXubK8&rK_EWUR~6WR&gvPNktEl{@Hb%yQfvQ zDo-Z4f{Z!4fPrR1soiOs2RM-{W%GJ#;S1*8(%<)FDWPD8hR*I!(8Jkxg%bz#JxS|{ zJ_A)IdhcOA9ynU8D=JgY z9<*+dRwt3+G@w!wDH~oKJ0iic^}OnsGUBYwpsUsapBY!`Z_ndfiZl8ydjO#~mh#{p=c)2n5$~ew)Bw&)8DAUwx<8sGD#Q+LcoFgSl>rj2RyEm3u z){@T|Gl&+Lr4wdamEC(n4mucXF*F46vcz&UMKPNb4lWm)sF*W`Qk>%FOHqr7YI+3l zl@%C8VYp=iT`9~-L~r!8xreC{5qrfW0D>(lONp4fJxJ z*1dr852ba|5B%+de)wZ#`nyt)2y_eoudy7~r@qxuV(FKp7P!}lm&0H%yr-wBAA_Qy zj8bn(tc4snC1oBl5Ew`BW?Zv4R-m&LhRIAMC7$4E{GBK$2C~Tp(h7Tq@eYm7t(z`8 zmR&cB0vo}~UV&VcBw1J+A<67(@1QJ`g~a9qxyci=u!K7>+R<`+-gr!BSWDKOzj$Y@ zaF4=*Dqu6sKCI1$!m&o=s1|A1{dyU@#?uV;`DmGYKigkxGm@>ItP}x7qrK3n`M7@x z3^E>9fTWp^UsC{fe!SE_e%|yQzi?t1ysVs0cvwkr!UhQ*WW8Omg^9RUgq81KOEhH@ z{cI{6&fTf(^Ov&N?=*SWq^65UO+#J}metdYpQ11}M}6<+I(ZuX9m0)N8-4u}okD&S zcfm_bD5`Q+SdVfN&*TBq&xlas{pE!75fpHQ%L%bM^cJ2IAX*oD5c1Tc5LU+zwi4h* z#cgP|#c8?%afcNcO}ldS-oh$t<<{uz+Hvh+Y-{j(lTxP5vCBq1B0gCPGuqPYE6?PP#B?5B|d71EFJ5{qEi?LE3|5X~m*801Nz5f%0C7 zELdCql4|5^f|Do{elAjPG7R1=h{JS$0uzo8#WPreCFAZ^S_j^GM{ZNAG!YjA)_oL8 z^came2D>jvPN(;pjz`MrN+>#nnvkkk)&YsreI$>0&7#r$QF`wH>QC%fKR;@%o2bSB zvO^YA0CB|Rc>j(H#&0k=LngFNbsvS5YUnN$Rno7ss3CP%bwr#zBD~_{X|7cf;)hUW zKI7#0v2YFz@J2QJBl)^v0cZ8jA1;MZuD7Z284TFFC!{t$iIfIE?LGXhNQZ zH`TE4X6KNKXd|o)i~+3!vLrSMM4dw4GwY29mJ^FbEN~$-E#z_sbnqRsIrPn!|8X)f z>fuJJ&U9H$-XG)s=Tt{^f=%j6qT-)2r2eFDFD0de<0X`3!)}>okjPwmY-U+S68xBe z3Ir~2v3&}Od|Q9ewz2(`KxE>V112<8% zm;15bjmlO?5eSIHUer{gqIw7+9a35;tX0Ak`#NecP2HUYQQhV&R{ej+Le%a(!gI%5 z=*tFEOtc_)FV{4$F4|sH{q~Q`setHfto?e<-@XNI2Q_ts2J*Bc%+bz5j+puHW7IX5P-OH|eH-j+@`!D`fQ@o!4)5 zVY;DN>IT+>XaUVSD4-br+<{L4dzXYMQ)d`!WA3OyxqeVX=FvFI*rd2JsT{M)kF-*s zwM$I>%Ii$c`RCt;I*&v*8E>a(kkC?(MRH`q%|^9iWLN|`s+SVZx`^=1v>1sh*?bbh(c~P=DNGIB2}#`VBb~sv=5DvTV)LY&D)G-dXxv34`?!F z41fWy!qt_aQ2)-6rfM&m)TgVgCZ?s{rHA8c``;)e&yRc%(Edz@!z6GJ&A$rv!rzV0 zuHSfwkFnZ)CNoMVL$>7l+z4#1Zu|n8G3vA`x4PB@>F--`x@)}Zi7MRwfj^BBH@eGE zpIcZDmjJQlwDj2J)%h@;kduZ{^N;k%SNYjqP~_ENcma)PU3)Qlu|n>0z)u2xT`8`m zPmMt>BG5)kFXGq9M)Ye#bIJc&3*Q#_c?!t?D?9(czUEwvgp7m^#?~;rybR)2wytK* z4C1y%u4bZUCJv@%46Rq`1j;V*GpFNDlL|v ztWx<+r$UXXt=c-ybX*e{U-!BDa!H6*K67nSK^V{lQIx%;ko<2FZH|M z-}a+i2I|*i+n+ao4Yp>c?E7!EdoZU2*uMsQzY4o`n0j^dpWS@Mmz^7m{a>VI&FTRu zsf?m3MrO6$Uxj~GBsgaKvW`7xJ zgoj?KJQ&u(Bg=lU71)#2PB&zM_{UUR8FY=mPXXswwasN@J^&oCpWXu>2=>cEwejO- z2ieQrmiYI0nrpI+Y{&-v7N=VnMV0)wXQLo_5G$+;h1jL5xA)5Xb~@JNE_ZOCF9;R=Y`SXzS16ZS)uSk|iiAcK*6iKXFnd zg~o51r?>Evu=)qf3xUgeF4a^IZs4lD$Q$2Ud!U}CWkIinpg&QuoVRaVwL7sNBY6Op zv`RdJWe}Z0@Afq}(f=T6q7tP!TpETr+iP?n8nw%faTx*L5aqAS`WPxKFXgNmm6C|5 zw@V;E0~CqKcl&cnI|YogE(3h`^AJ`fROZAf3a&?Q3z4cXZl{2MX)$Sc?-qv9Tyy*|U(u zn&>eW1L-S-?o}Cv)i$YeEVG4(hQwMqwRx<>BlyW}_=AV}WNS zw$zl&KNd81kz%*BGj_gIAeg0PYOf*}Zg#283)P^Kg4X8u#HJyft{Eglzt(`&%^8fNDlJ)?{4oD7mKb^vvNNCoYM*b#5s9Pk0D#T>w~hOI)` ztIdRT$d$4ri#^F7Ork7H3{=1@#Gwo{ayeVY7jT7O4*}aTw-2_5$^$5J%kWx(L8hsV zbbU{=%znjTpq{OYmlfhjlaMDri4Q2mA+$9cw}haWMr{*YAZlJN;I9RT;jk2Oprs-7 zIz5f)i=~(^=p5k+(hRBY`AI--dlegHa<>1uq))y^>#*|!(2T18qqLa@zV#;UrUy*g#qmWo5`nka+tT5=VIpuIT#PQkQ01{^ z{emq}N&Dz%mzk>JoMdWF8I3eu5>boRg9y({Uh1&7pPQRc>w;YYmSy&8M^!;+Qkpm` zm?A0WFd-Q8J0r+GuH2xw_q<7g1K3cu_FTgj1g&w;_vfUgTEt=)$th1sH=xzJ`=1m# z3@F~AY|4smue*4g>Dfer)%(!yNC%d9QyU0$5YSX_9(HcnxdReTt$y6;vD<>!{Z2*3 z@)a=iDWJu|qoAcnnM(#f^QT$n^ejo)fTkFp7_YZ8=9@!pfjFwGFesbqEbLO!^_Gp zqug@!H?ko_=h&hDF;OMZIE}fkaU1!mE*v4PCzUVT@V4$+x~Ti14M+p5^MZQHhOt72Bn zif!Ar`NVd``tx@F@trYF<1}{b?(No`Ypr?BVia);vB0ZP)nwj67MR7P(@5D)>+gQ` z=jGIS;t*@Ui&N@1t2M5Fu2Mf&Hs)GHHcSwjQzuqT3B|4hY{`DLZLqeB2J#Sr2pad! zn}i?2&dK9G^93hm)%waT|urkSjyV6k;T4tNt$Z);?the z&$bBc=^rK|!CZUWBdjmQwU6TF%(xhMMA;HYi$JMe)!9gB$-_wG561uwk}?QPl+-R< zC6x~Y%!~HA@AF|PuVVZ9PTpk`{V%!eu;yuSzg&0Cdk;7J3x3GW);hAfa4`$dNgWsd z-JIA49y82U79{2KD8u@C&7h}mp9Igt>LnKm0dD%PZL8n4#-(j^l$77FM!^F8GIlbY z$%b!TdG$8qUp|Y)oDqnq;*Tjw8P>XXOR4~CTNYx9zdmguURHkN zbwuDy!hEmF!Oy7k&<#LSb+yLI_&$Ss+Kx110q7V`>;PxRfp?CGk5%aY)wq@uED_y=UgR|h<|jtI|E_!usU-IDtrbv$_9 zus7^oSlf*AsCq-VQ7m3mJiywbf)PsAu^v5&0dW+D`d*g!oeF*o-BT6Pz@K z&ft?BhG}eU1Y&o72dUCU$ z8Y3&L*b}i;&47_pr`f8S%)SlpF46% zg!4)M*vyXh#npY*9$5IdnH%wQzaZ*qx|D28D!NvieZQ-_JHGj_9O07WEhv+H8R zkA+?D;_UhH)qGNR{&8#pHBp7+2RFYS?5W!Etb^h{t&ksCB9u)n0RhIyY}?k^#6uwz zo`4jpg~}cmVI8`dR{BnU z(_9qR`zTk9YhGDQL}RpI2H6Hf2{kH3sg2x6xKPz~@%cL{%4)+$m6B%1^@@EBURMU1sWI!hYVRkF*fg{3_arKf zIy3A-Va&jZtjDvEf;Bz>w)_XmZf^i(dI^ub;;(?5P5>{v-6uK{@KC!n7I3<0R3M+w zw12hLr-KLfEM}`YQ`g%D!wD$dfk{J@ zKCy(_e@Z-0Qc1CCr~`zeJFgesiw&~e1zyCEs4GQ8qz7FLfAa^T$f5Hb9yWwiV$6aX z5v5YOFW+JLV&X}mnw(fZ?|~*&zFjdE;uFL_Rto$ab08?p-Nj2hi%#cd<1kJyYKSWR zEE7O$D(f!@YdfJXQ94`|58UZ8!S72HlU>pO^7E#1zLRE56-GIcc)2z_pqrfh0P_hE z_Ar%@6_P?kq>IdU;dtSUn5F-HF~r;bz=86)8EFIycocVu1u3s|@qgkFebK9a2F=fp z<#F@)?ys8j3FDMmUIPMpLjsU_9i&}{-?O2&&9_!q$or@-T^HVt{o5{)QmaI$E-~%G zKWpzj(XnoDXp%zc`TuuugVx!ZdkY%C-x z3d{hP=1muWsC1djR=ES;WkfDjH(m43IZQ^!biI?Q`fuA>*FV9giWvCjp?(-`L@w#7 z|6U96GsFl3!2&S{L_$@p2wPsz>s5P1ii?JLf9b{lYL>|mYVb+pt5jj9lNyk2ui%Af z$K5DXJ7U9PW`d}Iz70^ar71*-QPYw}(x5^hxxwBoT^A{V0QJ?VYiNV(5!x$=H4^jV zCafrUb+}5aWeoH{!2fXGUF~G5BH`pDjZX1hN{gDKfV!rQjVXOO!F+?T&L{ziUzj87 z*00#7J%W82A=vYxQ>?l5-WVc&KG)qQ2%$W60h!3R{<(lO8M~DIxe?3?PH*khbd-lc zr&yHffj+zW?a)BB+ceY=iLwmfVy7b&9wH2KwT?_9iut#fszMM(Bl*WZjZN>$=>{@M(H6+9 z!oW*S7FA+t&Bx;yRI}^DAXY<|b%z8lwA`_Yn2ei%w3m0*?3Fw2F@FIXBGu3(x{^% zS0LH-R7MnB7^F-Xd>@<;HtrSV_at1PcG;-?nHuKs50 z>U#g2?1-W`TNn%>=+Qog_4YPCTTk2Eym7ds76orXMDvSY9f zh#~3Sy(guwO^C~l3@(ka2dM`fy{@?<+Xb_t;xv>Ft%^PhjB9tU1{v}tDrwsdL;YWU zm_X<0XJmbp3I#9=b)G9mTyIa^Qw9kzU0t1Y946>#2i1{!?(GhC;4C%rC=-?#Ej+Z< z6)FO&XHS#1N^I#p7~;d;+R=*syF}CitHxNY$iAiz^BgQzZL*ims=eV6C*yQFj*b^- zki;`U;=6V9gkT!SiUckPd6RhE{j)c3=#K4eysl|s3lk$CSb}<%Z0&Bqe{a|D6SHh!PLSzXdcgoLDFsb8v zIB;HDHk?toy=6SUhQS{Y2|>`9F$Bn_f!Wyp8eN@TFY5ylDIQlpsw6dd1`T|R*Bg5% zhr2SR4MF_qTb6205kf2Su_{GUe}onBv06?}BsIi)0(+2pMxi)xm&dw#2dAqvrLIyd zqSRb5hMQ0(pgO)nFuq%A@En3{{@0wBZ6p`auD)Ph@Xqe63{r)Q;N9=Mzb5b5L)+B> zbJOzG=Fowv^+GaEYQQxnohgi33OopV7;r?z6S~jc{Jz#HX_D9SPCN}6^pgtJLljJj zzgEndHu0(IAFdOq5Mt|q@D0rTY?EY+g2#3QFxQ(gN+`cT{WAm+mTfc%S zRp7$6+9~9FnE>jx*!6EQxCXFBR>mbPq~pfg1&}>e9HZ%Cozb`)mbo+^c9EbodvY9~ z2&S=)xQPTjy)1Bk1ieb9^G75p%@kPt;DCe}zQ}%kdHlN()jH{KKTHr5#APbj15M~M zN)VW=?EkT+pz_y1M%vi~od_h(=8AEV>x|A+hyT}u5!{zl5Xl*^X3 zw$W>$pomAr`^_SvgJPDnvHtpe1|bQR0%T==OQA<*;Hf!p|ECxl7%A%U6M z-|JkzLEqD^=le>hGncfsurPcz7@P@yGz8PwruVHnmsFmW=kVQVn2lV`^?^qi@VPe{ zuuIEzBG#<)o)zHtQrqjbYTtT=a3gltbN2joCa{r3#xi_fSM9+eiy4CJCe=)e7On^L zlb^T0eOs*9LA+%lj@m1~vUxsF+x_9pMI|fOfm6wx`!DT$EAL8bSB3lg`nAy1K&iRb z!`&b%q-F_YsHJ5KG78HO$T9LRZ@Yk2YB`%l{nS9(n`%`#E_B>vy~n^vHTr@p_l)Vr=MdG0M!rYS&Sm0jkXc8G8$ZM;UbvdN7ZYA=6XvmI#8}u`#9MrC1-H%Iy`oaNV8s*Cw+q5 zevpkEH8+m_!ZnuC5vlNvaD*nBB{dLpA3{GKv^^jIJBUTDq^B`E7NnN=&@2MR}C- zkJ~$A@-z?+mcU~7lJp)vR~oQrWlTi9&S4%F?PlT1Iq*=robmWLK}3X{TqA6*`7nGqFosYA{e1P-SR-I))QyAR<3_b}^o@p* zzV2?`8V;mcM|Va7{-rE~_F?tysNHR*-JRk4!ToMC_y^K;NUlNEoSIRJ71r2KNj$R@;5`A)I_6f+GZ$6Y^QJvErYIgdmX%xFY*q zq>VHph+7um+`Z9}NctBXPe=7>y&vbBd2wg9&)wDE0C>%8+3${-fSWK$(vMo^NAcCU2ArIzo^dsku`|XOd^XE(Feiu7 z;EE|A{cGg_!badWT=~JJask(oo13dc8TlO$Db5wvQec;_>j$tl!HI1Pc*uwLaqTLlQy2){{uFCf6R5mO92CaN9VESn_|4{tU z7tZ{@{J9;J0kkO=j3WnGI`$a`^kGey0~=_L9+-zfBPCD=%)mNtvvps%C2hfP^9l`eCl|HG%JN`(bi9XKK?cf%+v@ z((B;OjmJ{glg;e$o*yFZRl(0|x3odIw8)l6)odEa;G?;PbmA(6@2-jdJxiIT5(ic{+Lj_c)eL8j}c8Vx!_Zo}nNOswG zgQhky4qfgba#zUjCdbKMBw6TuQ(0y>&`RxtaK2kty!Tjlg_lp z26reLI_(~)?5Y~M-<$m?E8~=DJr>QbNsWqcaa4%LYWVdzj-34^)F8?O^mYCaq1#Dm^{zLa!ED)Zb{`_}22 z`?-qA`AFVWX)~ShIYqojv}rfk2wI7(se@WS=aZCML3n!mY>{w$kf_P?df~G`>_0hD zm*9W|=GtaAuFA3azus1DNC`D~no_9urz~Nt=qDD+6?h_`O)ZC_Y5~IS6JQ{}dFeo8 zMi+P;j)o!Ej3Ik2@?Sf<9kOEA+*5nCaM$0y!2=eNsE4(7*X(-k+-`R_BL`R|^NNIc z7dgT|t|;?59;%nM49wpdx!*CU#65S}eiHM(|kQOE%0x2%ll5tX|l>}7yeD`6>-a@>eX=7}*;O1R&EL(fS z>+E>OddIyuk%I!`4YLv7WwmkiETI^>+5dEFUcEuqReST5gN_M|*N&H_kNW zfn^nQUbrp~btGMKs^6@>#sN}!-lM?t&Zuc_YXbcMR8l3u)ojA>(c5p`$=%~vj7Utl z*249-#C+4!`v`W^NA^SD?SzYcO4l$AHF7z{n1DaUamC<&dnK%}d71xh&!kfA@w5DG zNnqO0RPG}%+e57pNwedjmTKZ1FPgQ=Jv>>Ee&EI69Mdpy&rc+q*&|q{SkfhIPc;8J{niPT0Rov4A3haVmZw!+d(da6bXlKV@>m!Eift(@zklGj_2A*u9 z=|8qTr5u$6>Pc2ZYLf+c?&_jX)+e~A(Hc!X>=2Zg)XVm%03bg)WEs(oP6JsAICBvb z6vISh1d(`~=`1WV08YvLRw1Sj6I|G|Al#yn3GH6Dep8|6baQ?HWf`lc==sgC<*)qf zf26Hauu9SUHvEH+uc2Aw-JZO_ZzCf7GV-GkNHN+Dy2H&=n&_v;P!+ihmj=wfL3djF z=LjezK~<#E8LJ6Mj8It~j1VyuMdTPPDu%!Q=%=xS*j5f%zsfFLXBXkzG4}%hq`mb+ z(vZZ3XK4XuZvBL>Rc;_Q$On(~l5C4LL80(E#V+i43;C{1eHiye+d7a86;nyP$kLNc zU409M!nX8;g~TFw*b&qWj0o<+oScH1SLr*Wu0Pf-S&97^kMWD{PNR1EBUHK*l(%-F zq~%^UOGINegT4)p4R}=%DU4L*O6&dCS7L)WIBc$(py6Z>MY~St;)pabN5#VEcE3%5B(PyjlZxEQ7-F;_EAId}e7nb^D;`gb3M`?`dhTv7^$+TGez6xAVh0{8|S}E*c#oea!m{IO*ap> z)uryB@gKja>heX=MD*x~OUG|GzHkX=q)$-!o*2&S|||`UmrHxkXFZhGs5WD>^~i-1%^` z=$W(xgyZEWg!Z*3=d$tf>GUu->ng%n;V8x)uYjv; z4<&-mz!Cp$5Jiai=(R97_=ibd@pUzV?xgEww4QL(+tcgi@h%S+fgw3*VBi=$xV)jY zRaTJ{@byQdjC6}X6$-sP;7$>egBX2H?;gAP)Y5FJFEZ+}6@#T}z>XA?tzNHp1xe%A(Pdm)=Nqt_n zR4*@-($Z)&fj}E>hdn_VbqqOHv$}B%rUByBy*p3GxcEq@si>o<n_skr**lBPcDnNA)q`=;e*D9&F0JYz1YE`U^+6)CByCsVN7^~nq$a5==cx&S`fVg2ZS>P(KLQ)snQ%I{}+9VSSD`3oC@Go@p&}_O+5(a5W=`Z^%-K`SKDjMxm zojO}Esas{O>RB~hRN1uhXb%PcwWfk*`;X-bkcK3m+{t~`5i<5DD9R}$eV>{egX%;M zV-jF>*}Lj9h71$;ZfTq-;v2>mn{f#b6mI1@m~X*?5MO#rvR3x^Fr}n1Oa5u+taJ0Y z26x5f4XodBvFgsmW?BHA(Ntf>g{e#1|S5{Oi5!YQ|U;`3yX*G^eB?Z?#5LgP7h$PQ&Os_D=k11JRmsl#G z!bf^F%eil4?EtiX1%cfpL!}~^MAYwK1G)lZn$CK<=G1FIOV zZ=Gbb<2&o_v=Uxo!B3uaY`-7I6DvnLy0_H{By$j;rWvekOF0 zXSq^|ggOGq1BWnKoi_#q@qm+_Q7dMY&9}yYix8+iPYnohd;SA-}5RXSSLBA$ID9r*$Lyt_Y6UviBTIgZ;MTfO3lN zsWyX8D=LsfseO4ayWXBM;!Mny_(MZ5u66`|K$Z(`9e;Ib#>8Ta5PYI{L$Pu_>vcLi zV-|konpL67-sr*!;U9~nqePu|=0v^-YB=xQ58q!LrGObwQs5qRHFH7+$!s-|9mYXA zBijxO%&A4ck*{Ad0ib$MtKkQZ4^$&+>SU-!EeO%goZ;6L#Mi133YMue1f@2WDh3w&Nk!7=%*ki2|SeL0Af?L_(vBEK%to4=pk0`TmQt zm!%rWdV`Wehzu=%!DEoO)&|L6=rrm^gRO5#(1OSI0&hstN$@){H+>vOu0)CZ@#r`Q zsU7Wa{~8gyd$wW~33 zYMkz$qB@QIqkQ4+_!tK{ZgfEuy~GP6dVkESo6^zg8(bo@)D7QlL8XvTqu(K@;;0@1;qdZ3p|{;m2`mc#h^2N*#dCERIB|em7^DD zW{KO6)pH?a3A^dORg0y^(aUQ3xGhr8l?a~b0i2qe75C(egZzunXoCW)f1EA3MM=i= z#*Y;fWK?cm*Di91dc!6(q$fSo;8kbB(;N_;55s>mtrEJF*xS21O_xPUlRRrOr|!6B znq5-uSPkZ3lbLwC`#8?PRXOTw&7peMDUuKK^@$Us))Fe8?K%{z6%R*pNd_AJz#OMV zXlsu|eMeu}m82av5%Z;iVo~{s@jxX8w=rARhnL0+x{>6UWARq z{4K3ZTj;B@Cc^mGc>A#}?#$$S3*`NulHb2-21rbgCNbtccvGiq?pe8jU5GFC>Z~`X zAKB#1`S=$yeiS1mT5gwb8I3rE<>Hl_*%}L z6qX)vsn#lUr}8$CJWBZ)9iRx^2bPlw!T;6Y{Wq^Sv!=?HsKPyl?~Ft*CjV=pfdMii zkz%_~*lS71&-osJ+!sZ(u4|E3bBxwEGv|a~<0)BUJpZ1==4Ggac)?u-fup~^@>^zY zO0ghA`L{9sZcj9fP$DL@Ba~GVycNo)2l9f43NenE2eF)eXj5kY;+yP)7lv!KGKio^ zO>m|s;q*1p%fO-o1e?#Vvhq(p5vX&vRXOoyqB7-k1xJ$Gf-%G%iZZDeTNzPBteC2S zOZ+Q{)?geEaVqc9AjX%ji3qkm7fsY$c$;9+kC)4VOebGL8W1q*qsm+Patzjf9QwZEVa zt`SwRRhc3*S2a>60%2rhckqP70QdZg$dM8u>u(hk$4(G2wEi(I)ahH|;=YZDWdOtL zveXw1TDq}^)Ylwh5Vgy3^L_|j_)Ub-1*OJ(mH=CPkgJ@Xf7V&MyM7Z1-XEJAk(UJ-&fT+mhLu_%%hr}>*t*#M{Bf8P(Y&hAQ<4P@PErB$gEvstc$ksC;VY--q_9~rQz$~xX3zw&S=Ea}NY@(!+g zKVI%4I_XSkE8jN!Uq<73Y)~{VH-*~7S*Q?&HK@BE$ zys30*T*TTEn|WgYe#6s>HP)A(w|k%Bw2HRt7N)eX*&0C>vG!iOJTG}C^HMapX1%5~ z=hH8fRvObRFjMGuT3np;a5wQNhMrcP3A7&QX_<;3c4qz!hWXQYd!gW=KGWrZl4N?; z92_RK0{C9()T5i7)RjE)XS%6eui2INET-Zjn}(&{uI1O*rs`l< z?uGXELe;5JZKwD92>jWZ)1jKpz+B;p&um6&MVx>?zi}=m)09XA4Z!-s5~zelt7~!U zFhQ?;sv@mi9*=+hCTCIbZT|}b0%H8MzSBpqUuT4OHhqlT8{rV z{sFjo{`v1*nA-L|w&^JC!E$!sno0B1MuV=2sAEC_rJKH6A9zwKzVcKcv-8X0hzPxDyVm( zNCsO62*lDE8M4m6yD>`f!t_>oGW@mB18TtWnm|;yh>Voxbd8(7gs|Hn1jJls7$)b| zHMH{6;(m(I^j3jXye+m|C+nX-6jFmqZWxa26JakGLDVS{FQZ_# za1`~!I@Bhy8Cs~7>A|z{>zfDGBPeOc4R zuG>dqaygp56ZEQrYbcu$324p1TL4F2Cg~xZ&8oU75^-oa`lx%*AkAMFkizbeT`U)e zP2#u^FhPC2MKn@)H4^(YVDPoTAn4&dGw z=2wUPFNg@tt!RF^yDIQ4bKapRLyav^ln|=wrqf)}nNS07i^Lv#rl>+_a$xbR-&f+Wm2;pq712c4R z(9z{lrypiBO}>+Yy0G!Hp)kM-TxWfXG8R3OIpR#*vB?=KF-(&oMD*JrLIp;% z&}b4`Wn)3P6XWl&XB$XkZ7T+~2D2?biOnP#8~vzFg)8s_X3w1LETqXpK~`Zi#F`JK zG=s^05>w)Swn5^usy;-2P5U~#!HHXPOABX!9iM>}!K|tD&>7rP_`UiSfx;(!vqDL) zS>Bb3K#Y^$ze3L5SWFA(W_|tJ)0(S;3n6rxwdTh|65n?td4@3iwEdOh@PjRajokwp zp%Wr|b!+D%t5pckVoW?L(~h%-A+9}*Xpn7w2O{ytv*E?Hm9^4uxC?8mDE4IN0iY_4 z+*Aarlv54ThknCNF6b+~Dn0GEA0!@RM>UJJP>ZM=q}qg{g5HU(wjQuoCv~dROKOmc zo*g)#f9^dbjI+5Z-0DvqQV{o;Lvun26RZ`?61-dym#g=Pk6aUu6nIQJSPJv)bsevs zE%68&6{afk^S$B4XLGC-8NFa30aquT}}!Cvxh;@N&n zi;O$>9Jm{b#b}7yYAGFp>mhc=6g?#bTA^6eCFzN3$lJxaK*f#g(=86+9xQrwz<5MG zSXy*zM9u`irp6x_-g8z%YPmkjL-I&~W}Fydfu*>w^`R!Kf=?$EP3G3%ppIei_JR?v zDf!s>S#ss)&Cv)Ggn^1LRXXOI)u3xNk!!cFh$a`StG3%wK#sw5yc!BNUU|z-yBGCf z9b?$1>$G8~V&A-dAr(544`**Hdje5$=umx&*u@5{SL|3Z4&FuZobD_k?qM9uRyRzYC~eP4;F$$9#nNC3-r zvdn(|ZnzDHDZoDe8x=f`d>!6%7}HvGoFKnJ6W9O`A`s;^iNP?i9&H{p-Q=(nK*od^ z@>I5z_E5JSOch{4B-w|FBOf4ZBpItzrmcG44GeT^h#7BHB&SV>;Nz$@McyS`lRL8G zAO3Zq=(f%BMb^M@)kP@Z_-Somc~DdrhA6OxKIn(*OuZ>&<*tD6 z)Pbv;ynCQ|8!EuiL{;=+_wK3BVNRM4rG17g(hnCQ-CiR9K7s#7xYR;`(|MCqINTM4 zhVvgG$84yr|FWE2g!J6=wl`zPk!AxyNdeEaC2YqVTX+70Dg)x8G;f4nnaz;Pk>+o4 z7|R;P0R=%h zXk}{@h6l0l#*VAqo%5iLVJN04^y(Y(0M|j$Kx=;xln$FX%EfH`ky&{*f-f(mx^|7d zdL7{L#n5?NTAaKE;f{z!8eUz|e)mY_fR0JK!|aO`%|ybovLJ?08mk}hwafXZU`rg` zh?qVUqQ4!hyh~wslfh1H66lo+;>!19wTXD2$zeq$kGjG<-yDjx!E3He4l4b(V)uCNYh6zK*w#D~VYS!9p31+qBS8iyln()TFHT78&p9k zr$6d2Q0Bq4a+JJ2^n*EvHmEQnLhC2D)3DDwU=?qH-uyazG+n2cfRmvTYs(&My4hr< zO`c)TA0E%yZPbM(eaItVbV&u7XflxqcC7^uV@K9>MT^syh|e~ZHH!+1)o&DIG`KyV2o$? zHX8*IFev?GEg^CXOnG-Hc{jJN^Hj7DwJk0gu6D$G{O{&9R_-TL{#UX7lxve<o|M%fh|h7y-=$dJtN|kfEJEClFWQ`z$~ZlpyuL3VgQzN#L{pCj@9(dpmxU z9VMW*cc3jon1871g)FJNv`7wtDryjYTBik3JFByD<&SStw&_i6FLqKPRm43xJPsPP z;qOAuU6x+#tMgu(4(dHZJt~Or$>pay?>qCyE1H%KoLg;Ty+|iy^lWDI{52CduCWeKpwz0nU2r}yh|62+Lzej8by{2 z*zK%mB}J{+Be?sXuHcqLZJTf6uQ)nwHa)JnR#WIbKbMBs-Su+HNEjmxSG!%_S;U zmg)IM%5u0g9AwE=K4{}Qh)zaSy~^gM;9sBYs`kd6ESf2`iO2;KTvv9b!c*Tqi4Osi zs1Rz{>zPGlFSY*;NNpwWqu^9^johkLpngHl6o?CLC zD3NN&3Hl~5QJEr6{DcrPNC!>`uw^`cKy@P3{jzw#&qs4}Co4ISG4u8@1G};U`5wx# zcyT?I(Q!Nz4hY+23rzDAmcCNjI1@Zpg1=eP@m}rnVEpYFv$9a=;`?3Y_xgVkOQ{PT&Jnfz-=eiRq5W zVZHCi9w|d_ogLHj;6Bs@z}h!uAPYc9S5!Rm6Ma(cW6%H_k|R^6cO#qlpo~zuXPW37 zg>(1YR=X1gur66>l}1M1x17%c?8Y!fq+)W1mlA$I%}Dlf+5KoiN$?iUVtk#K=%%Jp zwiooW;V%-1?HFz|A{WuQ-4}L%-l9jfhHvbNgE+r>e@ zhHeeCnakRXYR1u|8OAw><|jiaEjBny#iTD|$GwZIUiK%m;HxM!eQ`$|rB)TXmA>JI zuFX|G$<#ea^2ibR2j2-exmzxEN+ipdgzph`Kz`;SSV@{wbxq&GJ_#AoFx8W^!C3;? zoTuN01)CHTn>gBi%}$;z`xH9U$&VDkWQM`C66R_iJoDV*n9n&3+X>xkv~S)44G|Y| z2LfM`hwtGw+tdR!QeB8Y--&^uK_%(k9DOFfAjyF_OUV-~B}vVlaWt=1U8tUn{unLS z2XT7vg{iJh@46$@$`X!|z28RjgJ-4CgO#3ezJ4$~WtXs6(QA>zP!v{ONdK~58H)GB za3%x5OC7CFrfQRQODEB&8uhjzB7>Nge+fe;*~r6%&(n&u1lFJXJ@kf2cE|=iUbm8& z7X3BKHB&)O^mg7o`Tja`V}Gdx^P|mCmSgw%yg!-*Uz#vx?z#Jf0V%ar6)ICzaRvn) zn+daJM`o6;kQUc?Dz)##Fsc}>icGEx0p~pQ`2l#X8*OqJnT9Kn``g_FJ& znZ)dGt;ycO=x)H%HLgdaj+B~uSzZ%vQSLk-^X{NtU)8sYU@fm&X3V(&Nd{pU6R>l| zan6SqS2TDvLW#&`BeUn`UI9y7>O}&H+~B=ff9iz@!S~cDc2T_qp{STgE8PH#AiM%I zGA=%~PZ1{q$yp3uH|@S|(%l|sKoQ$TnOl$7X{|gc;_}qaZbfy+1k_`&1gMo`(+)b*3hk*KDU^{UyLux7ZWY6M`NGD zOl6yf^xqI8vL_s?c9_JEWcy{L1=6|`s15u?)`3b=IJg536r!QWJuyAmY}7O9GY>u4 zkMxLWF?zn)Sk53qL^xhM(Duw+zZM5zH8I@J8cB+&_xU6b$Yb0|<+FWL!zV@f{H9ZQ z%OP(~m8Lnx)R_dPfQ9=A73Z@rrXkbx7f7?Y83J#PM(B6PtukDl%j1QLE(auHiGAlQ zMEW{E?4IAlm^e$MIqzA5=Tx9U>tG#T9|UMg3#gVUB1%Z3)T9P)dPf-q-Oza=GxCVL z$7eAr%G(I=6p7iG-tH$4=eAlc@5S){C`^UAer)B<9+5ydTt9Kt*4RGu?=k1H%jr{V zw20%9Luxc2%v{KdYOYE#fzv@{A#xbB=H^NSqWe#7cC^E|!@Up@83)jGQ}HQy_0O8* z&UDJf)Z)ni(C#2LLg53-P5t2ArtG zkmVCax>k@8opndlIEgmJaKyf+URR>?yG%m`7fSRZ@w2z-a%Cg9r!x#jkDBb_zn2hH z2Q*y`tOZ;QAM~J(c3)R#`v%QoQ}z^YMV@Uz@|)LboC9MDyy4FFx%-^^biPxN7BkCB z7PweLWMiiC(vJ_T3$dI=ty{d(ySkI-koXU6>TUG)2P@!qcC8aP8vRWl+DPUvUF;Rh zKk?5KdI&gulXR=f>b9W))HsEpY9!>?Ycd^{2BQh6k0@QNzTiUqRK;8&GDUulA+G7- zykg4|=dpBU9}^|OsbxEilAA~Yl_`>aPiX-rIV$tMp90{x#}NLjr2XG2+?kme|1YELzM`DSaw?NOBv z59fK|kxkxrM#qZ}ztN7M(Z&gwOfUB%=rw@TVePuTGI~ zLoY7QM~>|XjP$?x0ciSB-6*D|gYSr^ylreWjrXWUlwW}_qEeO#1X3N1hv6wWhvtE( zjkm`q{aXB?;UaFL``Mzcsf4zpXHk_rVy;pO7Wvw!o(k_Avh%#@>JL`d9o24u)r*LV zkAe5iV0+J~LNZji#-tCEyz!P`T`Bq3DWZM{nV>&CWi+m%#o+qRuAwrv{~ z+qPY?ZQI_p*1_C+?rR*3U(gTx+n$Cy%9-sugo*>vfN1=Qi}`&hLcb@-ZBUJ{|7o2p zN(@yw*ey=gc4^J4Fx5aWL~m^VZVGQkN;`MKuG~yc=9&WqWNw2(L$#jC7@nCT+#}Cf zc%TrIF9_wDI_Xpl7PmTatm{1cykd< zS1yBuR=`g2g^ik1s%(*RDoINeWdg+BltoC`3D(*>NlOTII0)dAMqbz^C$@UD)0$9^ zj3cASxa+xWT@J&jKE7!&{YVm0CpiWAGp%TG{0s&(j?RujttsqJX$^Jj0dsCAbi?<8 zE(WPz&=)Q^ySI!ZuK(V&gr?V652kQ4yKMI?{$bX+5k?e5`$|vS3wRW%ip4ry^vJKf zCJ!#;L@(;ch4n}Zi#T2VW#W40HyJiLMSusdfl#H+;P-=y4H(xsOyUxFPvZGT)3|qO z#}gu_?ng?i$ISm)ecnnN*1x@l>cT2hk`84_BucHh;m~cYWI$g6`nQpjYx_&np-Wm^ z9yp`&(DAyZ+Rzd%UC9BH=?=K62dJ_a)cp2nVb|ARivzt6c)L!bzxiDS6@%0W;ucg3 zh2+@n1dMTf_>_)6Z=z4s*EMv3aJCRVtYeBC%6%wuGseeCJihaf&DUTd?t}mp1yVts zw#5NCQS>e(2hE<`83>Air@{mzW0wpyWw?PLn})oOhMEM43K4n^2#t~k&V^Dn5w($Q z-=a&G~ldci`Xb z8Q$`(O(@N|Aw4xTy#7$1XE09qn<51;>hxj&>s7iC~T=NJZcq^*L)Um#aJYeR3CyB>y$AbbqYZ31+|UwJsbrFnWJs%xl zUIiq84Z7n774JYi8OnBqaM;qu5@WeCSTPi>^e;sVzw}+Q9MVi-c&gr1i`c;Iq$yi` znwq33U?ygn8$jaQFTp6l!M!9<6{%I0zX0|}sX|SRL6kphqanp#G=?XrU1l}?S-o{%}bWlM@jF=12U{$1G zs<20a)A;zLG5w3-@9TYI4jxfR9z*<)A*Q)x0!1t&$v#Ad1IaR`bjAGkxW5~>+g^?_ zsOIP1Z0twY<{fCpJiSGk9?5r|EygTMDus5KAOG)-aWuqGlwzUGaIhn}2^e7!8?yEw z)y#l23%pMb_lQ*vwXbw>o39)eWhg4wSwRN$ck;-heT^ZB{Z?Y0NuVM06i9i2Ky3l>U$d;o;0WuX`G7<2`GBz=*== z(Jiw5DJ*aCo!!B_r$opK1U=OsA&QEOex{n6ieMf=1`SeO*@#tc7>rfz=qSIcGSggZ zX|QnC->lA=U&8c*K5q+s1``tzo>F-gds3O8kHQs9{Odx>k#fF-%T~N?9Lv|FfX|AhcxO8 z0rQ|8?c-CXzG$z&w^kHlFIf&r)U$hJFDdtp&hqSUg|3hIro_X!sZ4%S)8{RE3QEa`pUnB8?s;|N5Hi8s4XVP&2BIj@KROk0dmoOM`o#d) zA2N1ywxIO$y9Ig7hr2S4IM1ou7NyY%X8F4!zbvg1XqtW0W2*9Bw<3 zFf|tIth5!iu;dX!hX6es3QMy`+Z}!{mj5z6UBm^*$-_07w)IE#&z@ne;%mbtGWzZh zuEG&sqrFy+8XaHiF;?xXaql6PUHZLE{s7G?(DnZ(MZ^4G@y}VmYO!Z$tD`=gg{NBe8mMh7qLx!uFmPJf}pixVU zPDaC5BTNzEsY940c30A0FLmH@m99QSUL>>&Yk5Uh0|&Z(y%ZJexpB7;+w#+k z&-fks51Fcd*Pr?I{5bp@E!fkqsgyU(8b|atFG%XRsHq)1M-MF(vHFyI)I^w z4k%EeRYPkUvWgI$YQeqq4>x1um#;5^A|~$i_Ec4C^)eUs+}7uUkCg#%FD^k%n~ysc6{I|649qhq`Y)vbrK&9FO5EHd9rr29b!UZ zYn{gyPTKicOITrovaL}I{i14F(fLR|m`@VO1tN5>GxA2@s%JO$gFYw(D7q^k0M<`Os zxF~qq*zjoSo2iBRH3T2KD4D<+3iQXpIeDC2@#A#TB}*pl#)ouL)+uB}8zl$R4+L@j zC=xDo11tLcK$uN}sy8PTlkRUU}6709AwcT%~CvxHW5db zaLIOweg*o$aFkgzB92&W%03%b4NOo`6!?kljXakno9asQ)LATQu>~9sH6%eD9rD0` zrdXF%XbXQ_80L@F1|Gt)+_P_^$8SOe-&4+~Qh7HF@nu!H?Y7%uaW!w_?v>bW8v$y! zeibkjI9-1i<&f!l@IOd~n6u_ZdlHFd(bK&5YiITpm0Y(jxjc`6kE6>+GpCDroO-5P zeof)OspLP$n#z%DSjplDqxld%G1=o>A%B(%@E@3zsKyohkj1sc%8r6aQ4|N(SSBUe zjMyM%Pkgcx<4Bga$#sUa8wbGqTy3~-XOn@`^1%rUn5o&6{pgCkB{BM%q$~!7be+mW zP`Drk_osBd#$beyY<5w&+mHQQ^X}hZN36bLbM`r@LKqaJxnquR4}WDR@`&Jy6Pa1G z4seR4G{eixpvhx{03qXLJ83pypfUgtnVg&LytvxW#7cX+Ia>+{6g6mo^@Edo&<&`R zmf%Mc+Y)P0*9mUMqRqWgGeF5B$==yogWq&ATZ6?~iK6m+%q3rDV7M+^g@UXG#Dq8^ z0Ez@?4T|JgU42>^G=l?CDJWq{P~FH=dHO#Y+uyLoNHl*+K>T-RGy3~`PUhC4+&heF zkKIA^ZGTJ$4t&}I622))xxgihx6MiD{z!L*?-AWF98BI>5XIPE$rD{q zFY3grg{QHLIQW9kJskAEBK~4O_F?rwDyB9&d7~Fmn;P#trKeKax5&>wR(C{ZMzQ7X z&OU~=9M_<7$QtU;p1mmUnrxy%>df(i8i6ubY5#V;rhH(=M;X~ZWa2SRB@Zi5=?WS| z+GTRepmDg`!l>ypT#X)lMHvHNMKUuX(;Ay3F@3MX>EC>EPpVy#PO9NGfavcnFPTlv zTb?oOGDz$C|AxVTaaZ4GIR8oQq=MFrp+|lMF->)|(BcJoVWL-oAP^j3ignb{5gtqlLM!x6(QNj{Nmd?Lq5Lfuw_H=iPGL;I_-B|vi1nYHR1>> z$x=$5MR;9MH)%5?q+@w%+O5au@3A=hF~-yA79F*X=K^nQI+ZuclyYXt4-_-|BK> zd(-u9#nshY!mY!xtJ=+<=`ke&UlRAA4^h@1eFSm{HMYM@o5!j5T~v|-h(4is%x=zt zqKh~n4PihQ5eBJo{^^MsgU%;Q|GxB@Fq9Eg7E(H?&Q$4K;EP44wg_mdbkr}#V-26P zRx)c#Ri7|CV56+dDHtKX)TradX0NGBtR{q{o&uN9wnNQo=~5TP#oxCdrpWcSB?^h? ztBz7wYge#jL+CTx&BW9~eH)#2SUh~`#I-~bk1qX+ETtk+VpVTb;C~Q3(1C5u(sHGV zBbW1|wG9{FI{;O2BJzD)y|NJC(Gq+r(Tr#U6H9-T9O;L*JfP@?I56nF?rh~YB+h1X ztYbq)N^fK2_1-vOcPAw=`KW>PY0JnC*;ga?a2rg{M^fP|Y0pljuG$dL8K}?>iluh+ z5I7Btnm95$ho)4i6x$#|GOxHmls%l%t_a~o70CFIYUd#Gg z0Eq~25D4T5ngq_Fzd#>my4-8sG~TrB;iBlT9phJTJI8T=&k+Wlq{u8ZFdsvHZn9f> zm|Mn2x*$l68^hXe^Uddite4OikrT(MCn;)!amNdzy+0N0*P{1B2U$TgUUdOVPA7{` zlTMG9YEG2Y!e|4~{@_-#4MG^l?s-x$HgpM-bYH<8T0`LvKJ5hUR>)n2vQtWDK2f-| zRK-KX@}C}kT^s6Q1UkPd42s!PwtC%73AB3Ccv*kjr_Fk>H&um#E0yPP=IRWt*=!su zPz^r0&<9;1o5Pc4e`OTna#RaUA=&NDw3}LEDUqHXWUa(qH7FR(kjel)k=VY&lpxg} z7{GtnMuiZLbiN>}!>FD;iJ99I(|253wLnR=JF;T%(AseI9lmah>&60#*{K!EtZ>+mcQXwAytbnG-fTH18*C zKFdrt^WoO`d4c0z_~y#7#ZgpY|(r6HPY!GW- z-}?(;Pa=|`MqO648Ctybw>_rSV72>&KnUr8<@xI?=@U<5)09Z#OAEGU&dA(1?_g$W5DjY%1DTY*BgUDsr~ zV^dC+zM`qME_~;En?m-Sfm1X5Qw{Wz*(;64H_0Pt$fjcsGkFdRqBJ2?h&nYKPC^K# z2ROqI3#!N?RP+1V@&oqCft3D_Z_ED<)yvBH>wjO%|EK!t6j3tqZ!bub>&UP)TPoYB zs~oS3&w=bO0)E6|V)9Csex4m0P$G^%VRO==47vmq7|z%0JFw06KfBtWzo#DLJ8Js7 z>Fq0P`b0kxo>4c^*>7Qhnv3N$I_sj zRC{$NDDUUlh2QKT;rl}Q&8?>G&wQ-;`Iqre9qN&*9~b*pP~FD(bjN`jE5gFH%CJ<; z=Ap}p@5iTf_aAB2;DG_&IK3;7GWxdF%l+H4_FR7yWt$CT?OaVU z%qa_Y#sxgwe9rdJeVP7+F0mgGTA3MHE30wCsE4UhR~flU+L1{ouB-UNFq4rnj}A|) zc>Jf)#q2*uOOcCdmt#oP=%`D9=X1%1q>oM(odZ3j;PO)>qHAhblQ* zPL!hKG?jwfWCxk2U+#YyAmJL9J*T}tfLPN+#X5xQh0=UaD{;s~(w7=5A1?>q>i0I3 z0YbLEU`H(*X8Ajt*HT917g$-;--#+$fs({}@$3|5EHagKA;PRJHyxf<2y8#3C=Us_ ztRVEXB~k>>E>YD)VE9;lV>-o0GFpsSiPd5S_f#snW*W6{Rk$VAoe$s|f0|ZfQBQ5_ zU9@ZDsfFOGG{=j*n`NyLT4gW|55L8(6H4HjT$cMMFf!r8LUheum#fNN=N zS>j}BGAvWTvff<8rg}Lulof0jlp_wQD`HcqGzVvu7VvKkIf2_vhJRp}XqJ->wxrdA zkIZs5<3N%`jYObbKU>U|ja!0ai0RSRb*SxH4A}_bZ)}Uc? zE$kd3odgc2@M{)>Y-7Q4Xw|4}1MO0&g7qPjKyt#k6Tmg}$^>(6ZU%As*Uv%Z_`>E2 z;(^kX-iT!WLH z!;K3gwBtBk#qe;EMj4Pt8IVTJki}UGZXmNyqs*;xt$PCzVKW&NSU_W`)$gXmp54iG z?ssMT`n~sXmg7VKf@389%-vVrYt~ea>k&3QH%10c!C9-T)g+we<&1jEe@Q!ogp(u>; zMwDoPf*s8SnYghkQ?&dMO~VAh1X33w8(YKC_~}_`vEAsfCjxUIoH$1+)xab*vjBt` z`%6T@8{;VfMFVuhrn0eqAW#fLQJQWI4ai}Rth#26Pw!WFJVGy?CHd)uR z3XHLe8`3LsXjh6xc0{$+qm#3iv7)bB zOX`rjWA~C~nC^x!tt{_;u!}3WC;Kl0F{Fz|`)=t;PCe7_igPZ^-Rz@Im>?+yvXT>a zDgL-6H4*Q5X}z2KXH^VG0nxXi z(r3So@)K_LB<%Oxy$r;;{1tUSAyG?T58(#r zh*(YKMd#Mehw>G_?oHM^UsGAtqq6`6v?4jA(9miz`X#H%ZX`E(LQ4KC#yV^HoP*V9 zy$=t^;>RN5qk@|t*=>VXLJ8m*f`2-~A!QmiSh2?U#ATo{d=*sSzGb)KK~YQyr1SPo z=p*zP8syIIW?7Z-Oxcjs0B)wq7~TJrRb~sO*7HFEKN`RHtX$Vd&YsssbpjaN_ta(j z=kw6-(ryi*x7cb|&O`!TaT^XlGqekktTD4{_ff5QTffD+jM&>W(;rP7Cc#udCB%>6U5jx7C)yC)Hw59x$ z@@YqQPzW+{a`aPLxcin8{vR{5(|r%Ac|?PrhW{BB18D%%ft})|?>8qPmNuOjQ)-g?4Jq{ zMOEp9=*1)q3Fs2OkNFial4Cr)3k!s3RYkgGmwuT9u9bQmJclV1hPc*ea^jO#Z|vg1 zOC)A8_I!|ZW%Vf>R>RnOKuph-D?y%s)4v+N%XM5@kh(dvue(jGKnVRwGJj!QiV4f_ z;2K^ERRJdC$tz2rL;nHw_0v^)>POWEXM&@2wV}wAdf$vWAz12q-NPZZ4J3IjLi0yk ziIMu+t1{USDS@N*%Y!(#rmhS3(FP$1v)A(#ah+B~-0$1X#FsznaE?4VXgtO$VmI<> z0U$(|Jd4U#LHr1jH4`ob_cJGtfP596@ zv6VYW0+?0TPm2SXnABF*&-SUt$ZORhYhds!ZrF?vGd3jfF=y^$^)6hbEyEO()H3XhHBU*#_zu}=JikIu6nONSnwnf+n;NEfRbRlxN z8b?(J@6HDa$RtQ;=xy+ArGPTpwij=fi-8;*|~r zhDC@$Xvlbr_t{)SWRof3eNOJnoVdRNopPws4<|i!Rk^$t+}(r3&tBtewg>qpPiF}> z5Qx2}IMYQ#=Bt@NJKAfKE|}OdctIyg9tF!zZBOGf;gY+U=IoN5%E6ueUeNm|1jHQL zUKhb%;%H*8Fc~%ZeQzomHEdag=;%LndZn+GENB*oxN(2E;*4&#u6g`@j^*;Ho>V1J zy|$4TdM!_7{e|xUbT#MLztvLr{a7-lb6W;OQRG>FyU{vM3JaB8d6bf>-2I{yzy?BE z&}3ej>SkW@u8&wFBBt89o;LH&x)cjS18_sNO7WzanhYs=x{YN}3E->yH(()sNO3{P z?6~zkds(WlVI5cR`b?7+VYyb>>d;1i@b>hFK&&2{b29UM)OmE|e6wDUSOfX;eD!nj z`m79$R2qOvT?I6^F?^?tZJl37XWB7h9(?OS@G0ABhDRDxAd%N|LqdR@0 zfU8n9PYMw(MSrdW?~2PSMJ~1LHH)ImRQtzrmhPj$JU*C0=Qt7eC zo+<(^Y5Pmv(ZOdG9!s0XkslOyQZgeeK9tA;V%MguxI!^qL#M$kj&9vWRsE!LxqJApU5$K`JV|O#|B?b$Tm;Ax)y6+=e#99{^ItclWuL zrT5Q@sftUB9)NXwV=Bp|?gyb6hWakPNJz)n<)f|H=oytlHP!f%V&LR z&mu|D#0o70HWsOSl|G?8FW&?Pc;Lr@0Yr)HZhFBLRgc+2$KURET<9}cTzQhDCb3Yw zk&|+2a!(Cl=;Ba>4~)^{c@LM0byu=689?i`&4aE@aWYxrT$3{>CfsEb-kY3C+;h50)0SZ&l>hL)SLa<_DS3?wksPj zAzpI`Umj}E&{9f{u%)UP^%8tOSHswI1UMYsxOkYLqiPu_bu~Zs#+96bB*m5Vj*0U5 zWswp_=jg_!!X~!|wkdx7+y@+)&{6IG>U~Glx|)voj}q*^0`ao4G5`NC1^*+#y#MH6 z$aF=#9u{4y6w`zypR^o+itkG`ktfctR^ zy0+42AVtHmChUE2cfgJYTb`UQ zq$5f`%(c_3f^)Z;p+uOK&D}E6)tR(od&~aA&|>7l6SU!~6Q3dLw@=7>*{9X@;m70% z!j^+(V#A`|#3BMPyllBHs~}t6(hq2r72B9ucBbbG{NJ_w7Z7#;;VLwDEC{`NprHOPZ!&_Pg=5wB~=@Aa+)l3KBI}{Y6;|nPEXkKI_R>zY}|=MP&Mq- z?3ucvXm00Np?q;5N4!9@A{Ri?Cf#!tbOeGDqnHBBdYW8Nc9;EEK@Wyyqa(cD-Xg67 zl^p>4E4dyIosUvUX_ic=->}v;rP933K56SY0vn|XVh#}!r0%#J92}IZ;G92;b~%)` zSf?SASP)*xfDm^u{t`~aF9LzZtwjvl-9HzUZp@yhHrk68K{Yf|3QDbjo9cuDfvIqyrFg_P>SD#h!HO$2kYf+R|r48CTn-N{CHPB4kdxE zOm43(C0{YK54Q#P+ry0sH-Ac+$I*vQ-x%@i7U1jv3WPa|$eWa=xNu-xh#7h|@m5N! z!vejAHCRn{#>HqXc$5(VI=^$BqXN{Zzf6DYm;BN|?w0>IUM|BDk2q#|*d^Ud(#K0b zGCqoS~9h!c-23k|N@_avdVBrRsiJ6fY-sp9_gM9$c zf{th++I~69&@}9eKzzI{NBSO^+}c8b7=g;N=mW7g!dV@(xbF47Rm?(cSDWMerey+C z{M*x9>D)<7Vya`Uskvh|g+dXsaN(b*pqii{-s($%A+FybWG)k=10~L9UV_cj!bu{D zo|!C!3}?aQ=&KkEkWV{U%-!jYHbedbwNdonr=vzJfugshQ|Es5q`68hd`V?ZzU>>H z-!vOc2{(8@R!M#6_MyQ!qOlw-vPfqd(WH1P;R-NsI@p6B^rlc=uVAW7-z#>Tx<8vI za3kpDiRFcl6&^6X5PIZUo(u?!phqir@ph1^vWu^1fe4Wn(S=lTl#=IZ_H2iN(wk)9w4HP zrMoeZB$n7umzy9mP$d@gypP{1&vr93jaud?GG^6*Y0q}%$d%bmQ^elqh>|WxjQI)G z;^8a70~Y~?){^KgfkQ~`#|lK%w1eYr;ri#t%|7RJ#~x-Csk4BOOrMhIO?lYxvg_ZZ z3H>t(r%oX`r+CQH)&zkVsH2!NqN9b#0~>j@YCwmVa;UG0S*z z>8s03|BWc9RYizc^iru2Rx)-$m;}3%3<3{6kY1JGym#R0KwX%M2q0CuC2NV-eX!Z0 zPSX&=(aI!$hnsfB?m%k!UV!s~lm5f`!~q&gxmz=knlmD^OP?T-9v!9s@)!b+C@E76 ziVj+SkV`kc$u92p13eikuOa0wS*=KXpmf6&Yf(UaBBoWmiQ+@eRZeV5lt|@Nh(QuI z?UgW?g6@GXf}mbM_G^A@KP`$eZM`ckFe%08jIWM%6bge*$AlV4+HSeqFY`2|6? zolCSP2GQ+m)`qf*VvX20v**E&RW9b}l?IC$KpyVFxeUkzW*Wp;y))&fJIQpIqO6K~ zi4uxDm}mMq<-F_ir*a7xe`b=)@T`Pmo)FwP+azG!luQNc|Aen&11dYeiZ2j;ZPEdG zfn%kZ*7484{hDxK$pRB+PxR@hs2zPSff@?M*zlLN%pR3;k>K_ds3EFVwWaG3R_ma< zTOVq*Z?(uJ2e7{@^*#1nFJE=Bx4-;d|5u9$Es(uWG)|e$*gP5Mb$Dt|^m+{{(1qvQ zueF7)n@Ww(sF4^qb{EUay+5Lt2$78rECy!apQZ-^TN*B~osPF^a*SJ7LD$w+8Xi@H zxV^B7Z-O~^kzIjH#a9fjfbN>8~Wlj03!OLD*K2LW)s~l zjESa%ZD!^cT@SO&&+*}ECEte-$JoQ86Hpr!;)>90+ft2R0c~yCf~L0~v^TTNHL^?i zTOGZnJ{ZxC308U}`h7?TV`h2vD&=Y%&N$|c8SGj{5-nC(MWXA6GG(ZfT`|1bN$+Yf z$PKy97=p8v43d9q9jQqA=e#;95WZWLs2GSdh3ThN%brIw)1E1MRcvz)_c^@vN~5W^ z_NEuaWTG>KxQz}J6`x@XLS~hNXM1V>k3+R^s0BBb^IT2ehH|&)1d#@G!66(3yxQ3| z=RxSnhGy;co2~v3{5?_fq0_$&X8X3{q^siv_K~g7W$S zwV`GjUmgPeZm{n6WupyXo+;LG+9IPBW_%j=h`FCoTAP|NzaV-9cBOj4a676!*{2%} zZ11=q4f`wwkdD@j$e@C$=v}S`%{Mve{>Y853hq!bn%4ngI$m$}9$RZjMC*Ld8lxss zE}>yriT>=$t11?PqT5e;`xA_MkBX2R07nt(aeiL_+ zjNu7Urfi$ebZTHSn!t+Va zw>XA@(%;Hnzs$dc(0M#9%_GC<7)Z9A4_D!@RstGlz7;$3>NB#17SKV%+gEDxKA4K} z`I?_MfFyKXuU@n0H;k-DuL_3j66DJ_DCt6nql zhfQ9}Syt{%gQKiQ*(x8t?ud2!?M?f2ZI_xhbK1hHB;oty_pS&Uz>-ti^C2{_v5ddl zQO!PY-L5r2hp-YPg9O|(DyVMaRVuUI8_Ms%9@#mCD=IX4|6E?*2P41h zcsiL*t1G|gF$92)HARXNfb8`GO5 zy>A(vqB1`8bpm76toiVLLBZ`{^j{D*N|?b)-64u?J|wa5%FDp)ppwJE2U~Xz6w;N~ zcQ`W|T7zhXXP!+h`>ITmvzUr?C~T?afI5Xi`Ii0H^>6K){%CKY0(1pI~w~Pxh%H2 zsWKruaW&e_C|Y>Kehc`yi9hcQmk-zjT5HJQ*J<)TzgsFG4NtXIz>)v&G1u)qOr4~m z%I@sS`R#6V;+b2Byp_{DP%z9}mbI)6-D0T|uc!=q>pyeu>sPOaPB>4|{)5*=pnKWc z;N=iMZ`Jo#+7Aep(>&3C(q=6G9f|qZFV_FBJ=XjWA-CD`e-Lu%6H#pp@G^K{W2e;h z-Q`6#>g4OE!xuDwuvJ|#*2DC$BH3^6jya$(ynsSh@})$uez81#H_*m6pTS?$p9i?4 zyM7&O_#A%iYu;Y;96Y9?TDQ~FU!fz2+`(buo)E$ajRSF~BW2t-c$%1*+l_>* z_)SmR#Ljis9$#7t*|YbXl|Nyz_Dr_MJavi$rcrV6JM9IzH;h*hTz?HMLt>=Rd{RoI zgAxwOi)lGmAh#Q~BUBJi;*F=XJ3{N5uwWB(x_S#7nF&h%c8oipN-)?}7?i2icJBhD zHayxYh?>*lv<+s+vo(?zuGiqL*Ob0|ox<;%CHu%IDoH{Bx>v_47gS{gNzADcS@TB2 zZHxD07*yxi3@h-#La&37uMfVLptL#d8COux58jbZBoD zMt!;gcfc2@livq6{ndt^#JYojYz}4o&B1a4ztA{^pnV~K8B}_8$U(RWMk$+p$AFTw zlUww!@mYQJ^lb1Cr=tco3I!8+9Vk#)jRsm?n{VmO4PXtmNnn%G5woa5m2~=erQDgk zcn*t3>V#x$^D4&Hi(?lukdjM>WG!f$Qx}__yd@MfTW9oWicRhXA`L>mAR;c zhIz%TOUPdcl0f= z>Awjk?WE`cuFU@4EG%@=52ipMrR0I7hm!V)T{4;V`xAf$H|{62>U>FJoi< zod*j~>~jTBG|y8mem!L+#ra2&*?9YhHP~87Dej`{CR37I<2EA$eE|+O*GR-3N~B8D z5&$my+vYv2Ca}bm5Cs_eb6&)iVlS|#;97e(=c=E0%R&_bVy_W%Y$?<%z9zU1ILe|H zT0Gn|1d_uU?{Em4i?!G37zzM}nVt*b;1SSB5x$Cab^o)DK{3jVQmrrJ55pccsbSi5 zj@rkC2;GN`aQcE#SB3{d3hZYBgH;~Yt}W}o@IutGPvfWwd)*}esgq|(peF!!N+N4F z5FAqBi8l!Z;SX5K_q=ti*iQW;1R#-hy(h)IsDo3(*>00y#yA6~Jw!{7NmBsrZhECk z4{((T%@43@FP92q8>^j{4C6GeC3;F*s!J_`@z*EFharLILl>R@kgz_je_pwGH*{78 zA`SUwge1qoEN$<@>6_+i3Xs?`XyeZFkSmt82SxOR#)t<)+x^fv9;K3*svzpS8RtX( z<4>i0rzqacPiyG=c8x|(b2L6ld0&3NRXg^3Cdv2>=_tpTO9AZRXD1_fK?pN6*vU&; zE<5t28!v2utB3Q0F&s73CQLhH#s=PLkw|s@tO$BD{wE~gPEQSEr7eU z_RilA8PKc^M;Qiv5`L-oZ;pP=H^B#d1bdHfx_lkkX9b>%j2d!B4XCe!0%U-wI43;M zEYT{5oPVu>%an?1#iZl5<)*N{zX)L>S85X+IiHAfHpZ<#04SpV31ukU7BhzL?rBhc zcT(@rdOV)9(ixs#b-46Y_c_>m8P#`Ttzlj5xd-n>7|B(d^H!G4HsDDlHP5pk-3aW2 zj&+jG{R^E9;HSvC%IFh0yeZD_3*PdKxwhUqJy_Z?H(A@K>Zhq0XZy>Bk#hlqL=^+* zA#mzM8Cs0JB$0pa3bEi&M@^!%E!L@?UMB|3w(8J4MeSGBvPw^ov2ar^Nb6sUr_GT` zyxBNv3V0s;Yn|&I@lKtq=)_!sWfR)wBm=Qfcc&$hb}yd^KIsaGTkRs3j2g<1U&p4xzA8z1_ts3?v! zQQ-S~K$dX%d>91k)bD)=m+r8VIrd@w*$!%owAkIhtZHCO%2TO1v@esTDK-4lkDDe& z;0~PEh+we1t0O2&K3{|vozT!?B+>~7?RP94UWyVBAuCNcTJMc9>x4-Hc|DEdHZ(8t zY))C5G2aTo9Cik-#%}rN4V7OE7pW(^qGoGog6-F1oNG#SxL&PWDVOJoR+3nc<}?ni z%fff>&hhb@$p)&X?TH;v>u^;ts z<&Z8z0wIEa3TmuAHT*aIv{`ApXbXz*8w^V0(if<%?Kc}(xD`O>NfO+>Za@iqajB&# zYFHcZ(t^~R%n|Ka$-3%t+}^VYS67Bs!4Cc;DRmpZl6{$LT-YI1C`R-qM{r&I^dJAipm!O+X8#MR5(BWldwbK?TG@ zbFr|_g%xP+&;bv6&E%0JYl7w{txhIZiN@;Oz_YIX z{Dw$-!2v-Sn|y0o9SzP-3iGcUv@c0ORB^c$Ja~aB7&ARS<3pA|WLjB*?(*7Rn1i@F zY{92zY@_(D?gX9ncToX3c}YOYPUQOakOtKT_64a-ZuFks1YEY>M zzqM5W>sVCW6p&bg+&HEwyK8BCM~@29$ug*W!3Bi>>p=`o9~1h$5+>I`wEoA(@qfiv zW@Y01U#z+6{}&tJ1g+W}2#rM4H%;w0TrPE#c)!iUWkB{f96{7d(yII5|7OP$So6iU zWj!Xzh#T}zM^|Fjyti*<5q|DsFm4%lF6Fa&eb+y4lU8rDRXv7(<>hj0+PL@ASaRec z{QULhS$|ML+|X4-%b?=7b5okQys_nvb#-6+K3U-BK;b(U12X*dKM8S~>=c47G4P?J zHEVP3C14O<;00y3ZSd*cf=@~&dpSbH|L89}_&xU2eZK>uCI?b+(_C#}SoKlEkv z&gr+j>`qM6Ev@gY{yM17{1a+5KL~EV2%>(Alv#`Ir?jm2vgO5%l zJ0NdIW@wq%=%+98t)_c2w{?h5D~(Bo1fw5d%w$mds3P@Jj`G>OHeb?C-zYZOhPyxp z0)u2Hib!bt0u47G3+>gt^Mh*$N$Qrg6L7CLyNN1tmTK=Y#2xt36P6m95X^+x!zSe{ zStQiEy5(P;UMgFYsrlMiB_7D9b`j?jeBqJQs_$<0*s2n%ItTinPpg-6L2(k=X4B#S zP$mLJ5HVqh%ZxQl$0X(~901s@iCj9v#ETsFMhR(Z3(Fl`c z3-oYLC(^uf20zK|u&eyGiN_Gt=Eo4RtyA!pb%D{9ClR9^eL(!_VjUTo%Cc_B5GE~z zR_2q4kM0CGQfjx?u8pty z@J39SsuHw44i*S@UALuSm!sd#LiONO4>M*%G6BOuRua7Pg_CdY00Pg&cj=%daQ^zH zYpdX`fi2kTLU6nSPoY5r+kw$DsG4||2o{+kZ*SHXa8y$XtS~d6^Xe1J?)bsthfM=( z{`hNcHW-y@dM=t3wB?l5x{>o|%$d zU+%RZyK?`?3A)J|)blx8LBe3?`k-H58P8^Qk1Y#v0AO^Xzq~#eK_M7@46l_8EPr$t zg!3WG_YQ*>cl+_bT2he>dyCj!ilM2~IaZu?#OE#b6}V_&J>qE5;*W=?_9f7D*iRk6 zMTg*-EAS0Z_fizwi(>uFw6ub!zUo&tHg~DK!M1Q0ul=^ z&LHy-33Os9?9T9X(PYxK--7mY^s+A6BuaW2i?Jl0L*9OfOS0Cgy&=1gSjp;OGVc>J zx?}=Mtf6{`h2H4Vz&OG={Tr|3FpcQFpwu$s4?afqv(G=M&qfuTiqp}RRQ&@eoq3_< z92~La1H}!G`%>PW`PS>-s-GuoD(17A_IKAhe!}tagg41?%LFP~z;rZe+LQ%@~`zrg50@LOwi+n&G@3WK%^gNxKF?&H#sr?%d z$c5lu*918aXciv~8|RYVaYMI5)mV$-p-Zhf3a_s@~)O?3VMx718L|;n~G=CArpQ~*1bd% zI5BKw764#+N$tL5H83WP3N;kL?)`A+DPl|tfOUq`$Tdv;*>HDq{$K_wgXx2RC1-rl ztWpdUl#O^k#{2XIpu~9aWP95cm-oizBIzo`P@92d(8@e733FuPBB)Y+M zNxMQd=sit{V}1Q9#x98xzO$;y@`4CzneMr(+xbQCxS%|y4U!&iv}TE)1Bz_{sgqg{ z8m^6qRPJA4(CtqiIDoK`8D5TO~Y-rL3XhW+B-j%W73MMvm9Cjg%&A8!Z67yfz zU+2)(aq{Q0Z?TXWF$1Qia-9~(-P8x}(q$79#yQJyrndhoI>^DN)f{$7e(*uC_ul74 z0FstDybajw2lnbJ&_uWKQopgzu41=+O!v9E!JEPrn@nV;X);_dj_`;Ua^xEtpWNi{ zF&`q)B>q#a6ioB~Fm{ejnm|jJEqB?rZQHhO+qP}1%eL8tr)=A{?Vf%oVj^ZH?uYv$ z&WYHWxz`Hkz;_{_yZ(s1tUhT63Q}?m>IO#+cokcw%J|QQZSlTW2(QTxlkakk6 z_0;2@5S!PCLBgNkH&&LiVDZxSg$I68_w^WPzCZ!+lH|6P&Z%@}$xUTL!tdvw@K@QJ`x zr1HQE@jM?}6l)lLb9P3WZ>K@=K=V=-7it=<7QZ=Irm)pHrVU`b(9RxO9=;d%TXMvK zb#C&39zm<2It0jY?#pOE_v1S4@OX~}S^aU6qf^yir7Jhqn_WOCc3I4~K{&DHd7*M| za_;Jb!YJK!T7mX1++4=HK)sUkD(-533AL9#E&X+g(RljzglJrK97F%#5<&(p=zpmliR_ zu8M}CnNFnWE(7)cKH&o3aGpU29GSh=hH0yb#>g5jVDGNufZVDDB)Nafk~2b|MZ1&` zV(8O?6@jWxrTL9(NdYr`JTcYVKaqchf9CdS&dJUh7{Pw%Y2vicuZcP#jR(TFbMBgRx)?~m?RX|wrv1>gsc7i_+DC)Rq98rdM~@w*;SEXF)_fqfU`dm*&i9I z@8eLZBW9G!QNco{lt%}dW*Ug0a5QqXgO$Ux>U`r`L&2>;EBW3LwLERifeaB2<(MOG z4W{v-9cGS0PXYZ4m0jzcRK@H$+E82aZsN@Rd6j&|fH17uOv~M@!C?UtBm1_=o9#?f zMQD_mcm0%2A`h5ZpfpuR4fS--p*PxN z|Aj2&%@K3j4Llowjgr91#~Ij?2LBgOOIJtRKXe<3mFJKEJf^(dX*4pgipbP?{Vzu% z!7v~wXWk?Ili8E`xF^V76%9xy7{SSFWP8p-L-wMCsXXuc>w~54k0f$8uyL)W&5Zj z;Irj@^`F366`*1KA43KEe?uf?VPX1zChk4jS_vfW|1)t%JoqIu6M3@CdqqKU4*>-N zIwGGKp$B?y)yiupv)!cK)bsvaNxXh#A~}8Kjdul7(NM;vTHCifHCSlYkK5k@>bj0at%3Q6hxNT)->=i^kd5@4 zzX`ssa{}H023?1ZHcqswe{DZf0zOvln~%-)^b*{<_r3j`n*D#Iu8LNfkn@TYK*>nxNYiP?0g&32#$y) zvOYS?)=fYwSCmtrrzc>y9jrvL6-L8#Ig3|lt)PX6j}*$#g`zb8j0o@BX2(h-ZCt3?3; z{phQ!c|6ti(J;7qo|SJn4@(j~FEJswtrzQ|QI}IxMz)G+&YxFY%?k(?ESq@kprWFO zg*;VWTXQvLx8u0N7O(nw3}Hd{+!)T223m@*O>T!)QF^1A=-hrK;Um89Z1d(pj8Z~O zPcP?b+tN^yg*Roj>I&{9J88ln$4i(Ho7goGrc)$J%prM!#Yn~+ZZ?cU%U85QrHta4 z5kj&TE?VrsBa3?7LNo)@(Z}<`A-f`z+6R-9P#4v)KnPu9Cuu7p#ezt96*KN_pO}dQ zA{n8o``>?6Bc@u^f*i*CHmX_5wcz@K)dCm}YXOI@LPWgxm6v8g*s9rrkbFXrE;vN7 z>Qs=S72CQW9}T;^8ltR4u_`shc2Lhr%EJbd=a1Id@ zlVt-Z#~X36GnNyMU)_}7F{?dUTX340#VVLOF z7o9`?#vTmT$DNuydl{%dm;0l)WbJcQ4i0ACADET@!o!llJ*fdAN)pcldC|(dgyn=} z%5Am+pym9d*!1=qe76uQYxR79L*|l#i^v?t^y_;b?ey1dzaU2X!=L^9`{VSw`>&t0Z!TC1 zPejo|z;5Q&kGs}CTNmi5BU^}_l-u{l>mvzYY^=G=g2Lb|JoLdY1NS_P&Zq7JUnV6{ zHy$!mX_}fVrtCRIkOPED+dL=c?!fQ~EFlPh9gXY0w<4VpqN#q#p+H5aU*2QU^jtGxJrh{OoUks;E10ZdH-gzBSrdz;qjhl zjGid&@}en9p%;>Qgx4mH>;p)B3nsv3nLO*FB1^ig{+W_4u+ji8S%xSngKXqg1NHi9 z2jci5|p6vD1qm0pERbU=f1IzB)&qT%4prN@IKx9xqUf{ySw#8??u=_pu>1r~9 zB_U$`FN_|d#Ma>Mx?GXtagr+Hv5~z1Us+@NJ{Tnt$!1AL zw(GxAc_|5-Sb<~mDh42K`k7-O@)x|2P)MBcF&lKb-p>ME&1o|8pY9pzS_kO#F{Y;Yik=yNJBoRz zb9Xc|6OK%>(Sl#749y)#5$EzVTQDW}@EoJTO2Mb3s1EGQu1t(b<;Rs|M7_|egh)gp=obj0yAjgo|5!utAQ5ogSXdrk@>^89RI}bP= zCMX%cr1U{eeSD;da={;Kjg|Mde&1+W+=dLD2tw?7pTufqZ@my) zi$LSWE~iG>v62-|&Y%xj3=X6j8q|}&!SQ4`*BasBzjSrW8-_V~EOsUqsxkZ1e39K| z4TN5`@oh}m3X&3pn=yTo^r^2FEn@WAHUPfC}0o0KabLn9FU8 z<*u9mMG`7JO8I*Xs3K@fsCVTl;W<7OtxeY3@dfg%%wKP{eK6dqHn>yhg=z)TB>~KM z09`?f7#fH=56nL+E;xqyulqi>uabY-gL(QS+*`%Gi@#0+;G@R{PBPmBDFb+M0oe&8 zMU=6hzoMe+?bi)A(9gaz7l$DB#oa&kPXrAr=LquoZwD;+fEl&p#%J-}Vi{81JOZd# zodaACWDxSVi5fTO;u>5ik?o%?&zV(xmVK;hacf~&G*RgrelzT3U<%Qie%?iF06J4n z25=2rtUHYrxq;vY^7+WlY7qcm{DSS0P0(15lfAwageENZq64`ve7A24+=)kf0cSMv!kMQ9exBxZScL?ObwWcXRsm-ssHn~hqF|w0+BXSgG724YSFW2N%qfuxj!A~JC z?pMKuwrz%S!Mzo5T4KrgQ5XV8!sA}v7Za3e;T*b+o0Cf9S-*xM&o?9xfokz0%Iqif zOut&B@Q<;CM+M%TQ)~}@an4F{yievh64PlMsnx!{Uzq~CGqZu}y$)0c_1ly3aPDK% zn%vuw!Z-=_fU%Ylthlj~_uhTg5XGkKXZo=6zGfno3H_dnQTBLPQZJ&}DO3>)LHO8} zg%S7GZ6I$c*JtE_;)9@`;)z)k@Jzpf=~bRwJA39na&d#(po7JGqQa;$q;|H3o`BIW znK1_AVnXXUG_4&a+1v#WXfpKKyj#@Z%h6u=uHG~*O}A}4YIBc7ercqi;hs>Sy5d=X zJU{j)c+p-DLc-9?gbiL#c%|X%9pJF5DT%@e?h;LWM>TMN)i!E zJyQO#Om2hb#g2M;l)VM;2yf=y;=J&Msb zp)>=0qI*%ySGsM`ZV1fN`(?mGnfOEU$Jcw-JEVpEK_!_E+>#dbniCU0_2pM#gt)S# z=Jn{U#Ykx2Uz(@uL#Efy2u+?rG;9W{eu^;YZ=)%06c%~(_iJYY;GfyP*x#5)xp#l| z0~SX&{-djn`M;AmGqZF4-=|8$+Byk`|C@Wu_@IoX$?`{vltUd39mx=Ib+0M48nr1^<>+un|U*WSn&NnrD~m=wLCJj`GU{W_VvfujVzTZ;P(? zJBtC6EF8P7!$+5~$1oVP62l`W07Jm;a&QedgN8^HP@OQDmfG~TSw|55@z(V_5dC5p@467TSy;;L`;Qp&OZug3PxqIoy)`di2t4Jla3N(t|PVbKaIt8JVaGyfAhB z7GczXT9_sj zmI`?{#PN0sDO$8D+9UTChmG!5+s%fNK*5dI{hAL+3tseBQz-arU;B2751fsBZ6=h6 zwAP1{6C6*Xaw@c%LVacLQmE5$faDj3v$>KzCzEhsZnmm1KPc^!VcG@)T@`t22eRpl zwDZQ5q&1oBfOM4B8rA<+P;%1 zJ?KcLd$tD^y_wiQ$k9lJ=I-wj2{C9b6&~G7EyBp-3(fH3R%}d*HLY+`_R$}}c)u*L zd^~;8~NEH z7{M~85vSgBUKknC0K}9$FlXwemYskGt&+Y0)-xCN_@At#&_$t70&jop@Rav>|Ez%; z;^uk$^D0+%66$syoN5w2%MwY2q=nz@sS`LhEm#RVS^-qhrrX*&mb7yZ;2V%*=FouC ze8cK7ja6~kW~2b(&L_n=y`Llg?9F2Hp01k4v{%==5|d_o z_RKV8B&e~0A+R8XdJ2wXizX{Qa78y1(OR(-1gk9; zQMFSgc>Fi>RE^|R^A9sr+>TItKiiAKEOZbf*CHOq!a|n}o7F^W{S0kQ;Av9AFTLB( zQ$k$ppLsq60#TLo{weXVVGEpjxnvo~s=(&F7`n<1sjI}em2ad!e+~V*Z`tGZ_b

    zYcltE7QBvfT71Z-|RXG@ZkU~gY++@B>?IsUKxROzE&IFlG9K7n1 zj;-lw3|RDgqpJd+j9@zHG$eQdO-B#o#7mr}#SG9}>d8s~0MnFs*MhHPN9K5&V#FbU zc@GFOhb^%%e$(BnQoqT0y0L%&Xq|AENC`ZXbGNF=NAOO}l z@8`mi6&2&0dgk-~D6u`XBWWZ6nLgVtg+-t#gt@yMdVdWM zueHj{E|3j0!}|zUn)H$2SOC+ zS+Mct?^-SzE%d02%(UA}tVY%`0n5%>f8O_0Z(hgUCHHiT^aCe^R{u!ixB%$562dzs z?lDO`I z;xOXqVd{sH+!BtXxjKKflbYTJiS?qfX=6)+j9Qm%j8M+hU z-5=qq#Yp@dA!Z@Mu;cN<$bA-Jw>`ka5n7xYY>+-$3zFYF1Ft}S0!!5kqXH&p@gxJd z*r)Wv=@@5Y;Z`tm!t2Tr|@pzOu$2JGzR6Sd3pTl;? z8PwSOL4!m3FdtN&@a?Gpm-iK!wi*;^*^_82q?cg(fw3Tfj8@xf@+bX223zwOQ>6tb;v6aD&zk$sDT%%4>489}E?sz&7~0iZl3b zy%gTPRpu=&8EkS^#n&K(1Qk zVow%QT76QOa^2r7_(0eKG{4f>KHmRTU z193zk;+PCu%YZbm4@>fg`{CgrGz~q3LM=HMRn(n8Kvp!fq&JhQ{n@M|rE64K>#Bj0 zGJF*Egu@J_qmPo;jtTUv=Hf@<-eE|xmr)RUZr@L~)&ciH<;mBtNu$ZuDH?w8nROMl z_&3yMe)ouR-y+`IGzMe@C|+i?!v;&+_Y!iztp6mu2uMX}BNL;b#t@>_2SQ2Hd z>1;HzxX5kj{tl=_zcXKkmQ4n&-L74{$s-=^crrL#FpGhR&+Sg!-sy*O<*yPx88#z6$P@Cj#`%l%3x-_B?sg{qXv+9>R5 zY2&K^`6^bqX+sFn_K1273ZmtH;*NoPhW|z#UtPosAXlCmup|i(a7{{}HaP3N9w|YU zqV;RE;QL~2g+7xX1F`o{3kRa4*<07I%}w49i3+#b0EeSlm*)}GetK7y8rF5JTaJet zjV-sx*i?ApLXt8^tMT6G*vAn@zmNi#jJ!=Zh$=#+X&ij@5VfH16l^)`X{fJM8n!VS zTb*62X;b}VQLnjdAafL&TP0H0A_t4B1EUuZk(2>~w~L?=+J7)u9rg=VM8XT0NWhd* zCvh`ff>nU*AG(x7kY*~7_t*(BgWTbYhi2AjN5E?aFpX{}B_GO_dtKI} z?0NkkcJb5bLea)q6(cjkU5`QbjgJ*l;R}g;>~}KO2j9(>9w$(Br@~?{)O2QA0zr)+ z5HOPvDDH_ir;l)e3n0FB%=p(c0|0-yW{KkXB*8dj|O7!-oBl3wB%2;HhP;3MCYR`n(;I*{d zs)o~WCU&M?>TY4ei;H=k?301Dwg9P@SU7XycfZWaXXvqeEB5ermw|rNv%f7L)7`V_ zdl9kq7}Ys@JzxEXuEV5HQntIfzv_=uYwi4eUSDGqf>v5W@(=IQcYD5H%*ac&*uDet zeqOfw&i1SJU9h}-)HeNHmNLcuacy0NY~R$Cwe}%CzZ|H4A7Hm^d84~;P>#{4`_(D0 zxtEjv(AKpi^S~v`zpGw551N{~E_uh~Z)?_cF6eV1<1cSZzgcd~&aJ$D zvBeH$q&{ykk?N`+5LN>rOMyVH{VwRKX}{PMwqtGK(Ms2zZmf(#_IrzZ>U%_XS6Z%4 zqq4~Pq}*ZIQM2Dv7H++HS&FxJP_UVs@%>Rjt(5(llWWn5IrdFlld*yhZ<>Y_KM|p? zZ3~BcwSzx88XMJqkL$HMyBo9X^cfU>m!`AQs3{5$;#Og;Im;h)v$C8rUfW&LNR9>9 zQ>_kCC=Crm)P0?Qo_Pc5L&6g6>sm-n|LdPuq8F_UsU~{p!fX5PhavCy2+X&B{mzxw zgB4cc8!Vl5z5Oh->+5m$Lcy|uwrrh=>V{bp{?cGgM>|}25Y@Wx#m$?D%-Xlekuw~Vy&3G z=dndLwn+&Pz&XEWv@An1tSe3E+S8c(PiK9>G6J+|=l+H5^nrk{-7dq^VmDc9;*YJJ z<#|T^J;NF#?Wr@+Hz(o|eXyufJqA7v8A$X)VH5vJ5rR-hZN7K`xQd3Y&FiJhgHttY zcz)vo84C$W`c{{{_}0N3#1PIFL?BjCQTBXU>NX!s`zbLfzK>wRZtFY7avGr6;=#3x zC4m*WgDi`=90u%Q2F0{(1nqh;eh`K{U$}|94Zv&CAztS>>L%t0O1y-JH*!Evt$=0K z9uKVXr_T8pIgqP@qQo1>o1sSl1db&RFr5FUZczN!)^j+|4OkWJ^tJQZ{bH_fQb_2g zZvQ_jvWLP;0iNh~D05A4h3QpBOw>I+W^1AybO{J|0y!Np zfkc3Y%2sp;#r{B>kf2*i+?vZ+gDTr(QS1Sir^RpK!+o%J#lXV=nsW&hf_4Y?1^oaZ z822gOh{N%Y^U=FwQ;6hG;WqGgcnm6zw*oz7NG%QSASWM-&u_;JrA7VRek=qk_aMqD zOaSggr7Mip*TI3^u036DOM!z1P)_(KS?1#xw}fe=YWA^5VdwD8HUZzSr@CERzYPXc zou2plM6gE697HDr(7jSNa*RcSxUBHF?6&M%<|iGah)pbVCjv7RLLzD;i=i(*SD!OF zLTPD?Q#Vi$gJ`>HuLLt!A*8vaY|6_NA*SoX*PO(en0UM;xEQ1>c6PN79(tUk_?JZ& z@en;tKx~QxBg2f^tFp7AFW9Gh(ie@U@=E-l%mm2LZ?8a^Us%IDkLC9m`@m9(Nm!kv zb0q3eMSJ5va;0u&fUO`@8CvByFF>qIQKHAQLm5C{D~@s>)-Qn?f}@hXB*mvjj7o#VfR+`5NC@OqL;Ax- zDUp1(hM=y|+Eq7hpSJQUZ3bEn(Ag{i(`Eegbl{7F5}HVDyacq9e_@g%Sm_&pfGeZ2 zd0L5yc<4N1SQ~~Js?sCQl?9V|$t~n7&SG^B<~Y$S&=$HF=*tf?J$)s`uxcl4^ zk3pfQZx4wu;-K^1nee^47Zjv%>#m1OxKTCBR1=MjjLw=?+cNHmf;~kn zrF>*BLybAB!*+N>bd3}N=<8#~OavW^v*A`yW1)j_+gA+Af3jl%y z7W;=+SBeEB2NpHxS5SW-%3sz!$zO=`-1H4Sv7-@5b^`PRIyvbePg2xqQd3Pq2Zf~8 zD6t|Y-=ElIl-*C?{bN<^{JZfWJPqgmH6J3l#VbA8atJQ7!t@qj;;KiqJWE02cWh)~ zPJsT9)>KLHE^)G%l?IDVFE#8W=jvu_>?(O4o4sL317>Hy3{dTOXPd?;gP$_p2q@_Tf3oeFoCHF zR93K!v6iR-7gmILxhUortzrYa2-^kA`)JEm&<=>AwJ z4!Ta%eISu!NG+Es@B`tI=vT8rzsQV7{fp4=trUMa|AKxob+km^9~@V>J948nk`6W! z|6UVdw8BN!vVTLK@BF%Pf^yeOr6_k*>yRz)-)$x(cE2!#XzN7r2Q3Q%`XkPe6lzh5 zL7B(u)A}@)+oiDR(hVWdy8;O-Y*(T;hZ zwVpo=l;tJetx)Z}9$lukZM_nRpni!|!k&O}T-MVf=ey^T^LfL#WmP_Td<@Eve;F#; zUt=07o|;7Z6abB;Bgl}A^g0y>tsM9Z1_E;*ws16FXZ;k?<3>6G3GjqQP_r-LVjBwR>0LsZ(W zjO55YB3$dzp^EVGkG#*vdNG7g7(GhN(j?SLt(oh^X>PEE=*()EVDa1^AdU7O?Fe)U zIZ&zNsXJ)hL%XLQL@vM%Rg0VH2cyd)P)|aBM>{kRr0%BqbuHa?fcW`p1w&3-zGKj> z8f`2J%U%QEw}u<{HkPPMp;~lj{B{pJ$hh;XMp0}muc#Vs3_V{LT(!=hwCP_e!c*Ak zm3$kzpQV5FV1qm}YAxLf27l}K_i;i0gKN;4_ihI65*+Wfz)F}Sj?B~XeFl9%{Tiw* z?^BmI*YZ0di;eppi;TLpYENZs)b@s{y5>RXHT{}hF*SoUuNelc=AoHmSF2qH2LwTv z%Y#rDyXBa*zfDH;_`c(I0NWM?OI1r)d**eK)PwtDUsY zxQ4Yt(m&W7C)=$0_}T=!9wn#xG#+WqBID#hXXrZ~$6E_bRc~b9oqc!>g3Y{WUJf`^ z`JVJ*d=IzbX;Ca&78s|nfRnKTSmCZ zO&5gVU3!B&VsMjiBp}sFK#;~0q0u$&+;56L;}h!-ovHlxF{5|cRZe#ecSa~zQ|a$; z5VopO8#UFKn#zr-ydDh+;RaF;5E?G+7F-`P%2~>DYxlH2JTB|x_ZCu2K&Z7cvtVX+ zKHXYz_Z`Kj>7h+%y5WFrqE@7pg6+9sNo1YB0{Cqh$nqX!Me1#=y7*kL?-kC}RVRLi zQw-886!w9mGop)}#t^F0Zf^N`j_BVL2bgNqSHz;Fjo6D^o@+^z&+(@FG8IWjX+_Q+ z3RLbAmCu2OV80^=K;x-bK0C_Dyl8yx%E>}wW~%OpT{I*zUz?%wb9MGcwwJeGtJI&} z1pk&4d4{Jr{ZKkoDa4@ZoxYtp?G|lzZ1~TL^659O3BiNz5;0zSc~U*wRdr-wkKizNbp$t3*U^y? z7T7`3({Lt_WAS|W-q}0ji*>%my8C=s-7_yUtqQ_bhrpVCZ9au)Z?yfvNuIcupLy3Y z$Wo|1Th<{-1+^Ib%y1R-#E_Fk&kERna3uttN71{OXsfOaCxJ2&dl_wjFedjW6#LrJ+9L|1Evu0l&e9;y&sHM4ni+{y!^ z+NR?;i=6gt+kqrR!hiGk7c&)pY_I-L529NJb*TRXG)v0L&i^wQ1HS7azD7h41@&aV zbW8nveq|=tTQp8Tk#ho#S|&{Dlf_Y9_LLf8B&X(yi7k$Z2>B*3vU!3dM@a4l54-ia zUZ+8aOxN|Svezn&MmkJy7nxZJ!%%P1RcfSmu_{^;DF@<$6xW*Y%)}H%;$Yu$voPnft+D7%Yp$p9NCi<2x2>{$4(8BZ z&XM0wm)cZM)!K)`%~L%KCyi-V%FyaMI~yq}mfQZ;)OsDx}`9Z{kv(M)VAi{WZ!B+s}1CgcuwTOO; zMwcc#o!?4)yQ_B3f#Tppg^@n^@@rpDfG}e!&SV!A+ZYisO|m>~#y?GHJnOj`7=VS^ z?5AtKD2YrXg}M?i|8>>R$_51O_l;?yWF^TcA-OIdX%-5J&pM+Xc&{9M3U7-5&i~h7SwLbZG)o3myFsC{pe9GDGvlVRn7d`*+q$*2 zI`Y=+I59-NV^M~FMTtain)WkIUkn<7*Ohu(Mpsmyy`{#S=|@C9HJtlVh{yqaOfrIz z$$V$Q+K8u0EG_P<*vy(lL01wng|0RKzwXk${>J%U@h+zLfZ`%uGjSl$8$-Ij zb&uvNB8D{-6G92zKQ^#F%?#v63U0zZdbvSjiHnk3yf;$cVqpeq=bmQEB96W^U0sL0 zjflN%bIms!cgRUjE+3dUgwLg#x0Ai`r#uKTItu|sslyTWl@{yfS&b zkc<)~?A=y~>lihacC)9FWFV8kb$qs2FySG(=kJh{uL4j&NPDo4bK+$X2|5QV>SzHe zRe1g}3PK&DIx#djecu%Gx{aPJPSc-yS&G{tLSIKBJ2O1NH23vx@UCn7n)Y-GYsGSc z=_G(zF-U`QHd8iH-j42FHa3vQq5q9Gwod||W$AuusIr4Kr;Bp1Cd;kHn3717Hy%Xp zM5I)zT|1m{yi1_l*4);9BC3;}hpTpb-cgr0jT%Vulz4H*2`SQn!kqMi%-6;ef-bts zJekcCqc^$aVH3Q)SrVv%P~I@r8+wxR1+caEWAE_g6(OG!7xNP0?7e5R<7e@yr-V^qV=B~~h z=Gxq_#z58(Qjb|2h=dn(&@PS!9C}w(c4Y&I0AuR3Z-QZW$B6GNU48 z0G4Tgz*+m|qnr|hR3-Px6jDY`ktjZr@a<=WfMAgxRk3?QkrNgkT)OX2Bop<0WPH$J zpge=gR3++o{w5JWUod`Z=5|3~2!n_fR)C3fXeA;7ytU!L$o&v%%#4gl;v%)U3>6iO z4UekgwlEC5Dl7`=J zbXUl~=BEbeR+M?18$4%v^MCdJd~vw--iLuCP_ZqL?ZlZvftkPH*`Gqnojqo57?u-&;q%g9c<5!p{u3Gj&%JE+S)MII%o zvx_7y%vMVbCK@OgqH!N9de56L?VIc7@;yjj_4MpFS7K9fP5*KTiN+&OV2CTsm}biN z^>+u(ZR`Th+MkPHH);eH@Aqfka5O|b{nktO=!SGXx z3Bi2BEsJ?JTD7uoWgpLXzOG&P8yGf8a^paxH2e3~n_o0)!;8+RsC7wx9ILw~-94UU zmm3wIEyIXrrs%#_hZ{lse+Wpt79mM-|pw91rp!?^O6+R>YYSV@qS7 z+d1HBGozHrcTlfdkBNAQZ0*f1or~Q#f)w!W9Zy3_;wQ37gPZPtNP1goW#bnb@Y3F7 zdaI;1$&pG45sRPzL)G}1Q{zmYB=ssOyqi^!3tYVxnmTydte18_a_DZv74n%qPrW0U zQ2oK4IcX6&x=5JTAXRw=yaG-h#oE=3)$v;MCvKq&p|}irlxC~p3v|P3bh>DT$Tx|u zVq}>|#jC~t#zviu#}t=UF2-?dVS20d$DhHJRAgAcIdzRZw_x>l{`QHC?fqR=8KM0l zT`^V9YpYC^D2zHNN_#>(-*u~W9V^6W;GZEsoicZ$0QhnA79-bm2T~6B(Dg2FU*7s?f zmP;Q6-}3O^d4I1_z9-FV>2OnP6uv$Q&|D`)8MruTlRX!$3lJMEQNt- zR8v$eoUm2f6`RlyP>&vZOK!3G$r}(Lw?XVt*o|gV-|mUh$Bz5j z5G4L%MT4f<=@O_-^3CY?CzbEsjzp1FvRTfO5I%Q$=-%)7uI|f%f@9ZWe9+9J_!CZq zaNPRCf{-$*ec!6Xtq$(DwsP3_=fRh7-9G9+{-6J^M7GQf%>V1+(X6@Yc*ut2y<01P zEKw7IaUkaR$+n)oKA}pLihHY+1+E!DD@&qCSniNeySoSg5f4Y<$<)lMG#uFn)-j*z zgr)o4VOWXtyC&)MHLJFHcyYP8takerajcP^YVG`4XJ|SsqAJ})p_hy=7QYX?n!lkq<{4O%MOd?zx4_t)HYu-M6Z<#i2k3rMjdb zc_v~REQ9g5*wkQ2+dVru3Y@eu31`buDG1S)kUgT>f>9BZ1`N7g;eCVFR9r?OV+w@~ z0^?=bkDgTTwlc?7e{Q=5@1n)wAAOG<-o~}+EZKLyDX^E*xdlJ^+<3`gsIIlV*bZY= zLpRD)-xf4B^u=dMfZ`hqRyzIIgJmJr2mRwQ1+C!~Tcl&|r8WAQzcsrTZ*!)kx`N3I z!FXqNy2cjobLj{uF;+LN*t^UaLr60vosH;2UJqXm{1a=p%mqJTr{7(5&o=Rx6WTDb zCnQ{yQq5t_`lOxBedNKBh_M>!P#zSiTau@OW$i|t{Vw|C9<+PSd02Yn$b7le`4fPj zYVt3Dy`n9SXH^TXJA8mvy;t|Y#)E4Gt!he!c&Y~F8pnKe?#Ye`n3SZoa*mu=xX&}8 z(Cy{@#^>eSx@8^ruY7Q7amgN#rHO&qb9fwSbAn0Z?@(_-BFIe*K>I>NCX zT&#^6{O92;A$L~A=+OjbDncLmkFUwI!_*~8+gMeqal|sT!>B0WWCnk6LO!nz+zWAg z3M^}Q!c(Q8eg0ipmHd_FJ|*+Ny+M{VTdYwwVW^xX^!hG@2*%c#>z0*lGLnJd>p~}f z&GXzR_HCDq-lrpR(_K3be{rRO|KF_G{kh!RR8=xc=MV!Q)c`o!fC4E^nLM1c)TZO~ zC=F_J&CunTba!IooPMmQrpdWWs9>>(4c^{(|( z$Bs1Ed15tuqMg%iqUsfCcJrvi?E>z-8F?k^bhv9`rXl(#RXIQ=pwjE>`&+EJ=rdyF z7-1;3WO{{)x!mlb`4=jz-+@x;ZjM?8+S`txl~xvMbhtgTpm>UP28E3Ls-cZCgQS4; z|7KkUv1H(x-&m`eS_OmqGegv6xYbTekWL6o-VsmeD|?JQkzm$G2?jtFsr ze4t50x!gDq^qoY$uEP&a^rFkE@7ne$fzTZ&vxFd|1Sm{VX%%I$P<%N?1+=0FBi!4` z^=9jMHP}@&pDTJ^ux4GABPb8PkxVn(6UjcGOFqRCNMpS68>LN{94TBy&}EpTOUtgy zGv!h|gmc96_V)0T9?0C04*H8~jE3~~_+-25_~bs(%|yBwr_?$mzL@<5%(3I^C!oPm z{yCkgQwQT^t$%Lk?)P`6@Z}u!{`oY#%{GkBT_*MsFSz-YAB5yO1ZX67y)x+1BUPW+ z<}FPX;$z;JGG{EA9mPhLj^k{7?0omaj9!3(6YuMHybQg&&(FFnKCUSt{{&1k8H|Aj z(;y&_$Z`!M6Z1&|)#DTU8{hq0lD=V_qxMezO=vJk3~x49xBlLlaa-)p`TbUt1ayG( z{k@WBok(F~y9N_VzQSPdXY=Nv#obPH1NM`~9r2q7W;uiRAKj`5(PRLOB#KhH2ysWX zbD5KDgcF6eZi@%0K?Pzl;um38gFIid6pxA5hjz?!PD;Ig;iM? zK7Q*}p?aYd`73P8n4>L1;SYz)4J82Pgy#S+2G1I=-oHKBR|94)?ar5{(mN$wo`p9Q&kB|8UZQO-YTGSb$Ld3 zL%Japfv?#84HnEwm6m0m$8w9cLc1>dlYa-~tTU@&p&hOJKvbdYU0tE4$-r)BjMD99 zz%LN0%1c#F)NsV|*M<^)gL5MRED)uO>*%lF9d6C+HuAO@IGEeO{{Y(a2E=&)3TK}D zibn_2nSBtSZu))g?9}+^m^4s4UqJ4n)^yl{IH!_m;oet>gfOM5g)Ve#cfGeTZbV)Cae5bRCypI)L7TQ>&i|og1 zvOL4>G(XOwUOz0-%PkF5bG;@+7w^Dww0Os1Y)rIqJ6{{A;l{QQS5ms2Win)55}{sx zr}9z9*mAkP&Np-=P1ZyOGxF@Hx3_ z5j!c?&v{kV-ei*WjicIo8k-N{mw|Ply_g;~;VtC7QAGTM>pjL@#We(I7JVh`dnW^3 z(xti8OJeSwAX;{BZ3s`FdMQ@90bZr5A}&)}uI>2VC7G$4->1}b{u$3Kl1;;)2eK@A z#kWJTIb8pEH8%6O_Q)$Q14ln0I%u|XNn)BLFMG`A!Y?})UbtkCLPk5KLa|(IDXHEF z0ayiP z7wiF_ZXpuvX1_B9eWSM{S#oruBQii{V7{ZxA=suR7E zrxnYHq8&shk`dFGyqGzq--|u*FoN)trbuKexh7itRrZN8SF2~ej3i};Hbx01Q9SOI z&m(a0@DQ85nMzh#WSi3vrmi)*)11i+q+Z{K?6Gl@HCSw{hi}jFLl|NdNVGwCZn(D>^5>1~`O3XZ zzmrHF6E{-0&L#<_jg}SC{OGlO3}`~kgkD7)*$=?-yWcjnHzj4ye7~Q)TcSBV=n^6ztjFwguU9!kru1f}Tj)kn|i5|4u1N8GO}~zu0KS zgi~p;J8cCb$|;P?3mM})1lf_1+11&2Cq6GFECo_Ga+5)HzvPVBJ_5)*%k0Mke3f%U zCps9hEN>tFdVh{f71e`wL>T^~x;$oo##u(aXO3o)v&)cB^wG@sDet*!S&0r2goO8z zOW+VLbm*(f-BJzntQf^VX-u>(s;&KNdzw`g21iXU231gDraRIsVdrE0>OQDIu3O{v z>{qg1u6GU|FqU$1RaF+5JFL*-X4dEIWUw7xiPW`9|0edIh-jX!R07iM!Lfm`$=>ZT~k}&L8@(b;9pDW1B%TGpyCAXv^|Li|k9xICYRTE0j593-SV0-zDZIjYLuA z*`*-95Yf$GejCPGUB{!=exV$vPEdYA{Y6?Wl+rboo;QKsxefGT=C`L8m*>OXAMjeW z1@ixx4*omYG9&x{+V)rft1NG|{7+?B`hBQ+q0cRFYFc8Q@-(5Xsnr^83v&vt+CBY9 zeCO-K%PkJ%&z?DHXA@}x2Ez8)=_+iEk5)bEFnwvQk39>XN%Cd10n z?TBP*GI7$$<--^L;oaBg;@0ayO$Y`1@72)eq=vWA{Viwb&yTy^(SJ<|T~pH0fg4b< zTSuzwzjVE5Wo@L?$I(}&D<$?BEEtPmp#Rbf|~;^CU2<#%o1{_&P$6$_EV)8pp%pmN%5@BtptR`fgp#K6M0vi6eBTd zjS?Du5ml{A+rRak__3#p`>Z_8E@qo6wu4H(aI0pmqpMj@X*7_bL8H%d&y4h3qD|76 zgmY%&k)@@h-O-wfQAt>tqc>?2|5j^N(r_KOy0I~%r=hH?!|!!H z)XRdKi&~dG)wovp_--0&EmpGhoS+oKf0NYXth&FGjZyo$NrP;1>0``jv|ep>+R`X9 z5<4x;7O*#+eaLUz+Xm#fv`E3O#vN8%9R}#MFO^n$)5x^b{qG)YSK3!gW*^KUa8)i~ zM8eGp{N?j*+xS{F)Tl}KwTD1so=td%fF(gP!!49rIpNYo`Y?)~=>7;H=U0Re^xV8a z$MA@j(9=DYpTAy8T^o&uf`e-GtT``+W}ChjMT9A2&(JZWaFCMXlk{@x1+Fv%)P|wa z%-~oXx!T6IRZr-rc+ArO~olj zV8fQRgGq9Qof4lv+6p6ffphZruR00JBT$07!|YSRnYs#48y4XNSnP(Ng#BI^#WV@9uwRAz?QLyu1|>hBT@XA$ zS2_3;L-ms2FnK4vCRS16JD(nO3Q#(V zR!{vmHP5nnhWBRp`To5Dh~?CcA0RerMUH79kY`ZBe;|Yinkp>L>O6WsNP(;3@*z#= z8YLymAQ0oap=tQ_KJA^jMl)BzNfa_grLg=9u!N!N)CX=(`@2|<%jU9XAE7u(5;R)n zgm)7zb01=A!;35df*D9@(WdYSBUA>bJmUZ#id}`n2_>c7%?@o&yAUkW(^530Mk2rX z3{EVYVs4l;4@=77Z+MSoLWC4|#L$s~1;tQI9jVEoZ)&ONk=t4(a6}Q>g~>NS9uhGxi=fS^96x2k!Vqk;{qxu@6x($o*w-!~4tHY>OhO*|V=H-Wuw$b?XO&k}aIn#PzOIFiVhnF9 z%LA%Dno!<6#-+9|3D^OBZn2r>>m((ap90#03X&3aQh-uYGs4n}x&RJUCPN~lK9m-Y z1qRImCqipzObCXDa<#p;Xz@+pO@mJx$lY=fYClv|4$ae+tG7YK0Yar~S)xKfnT+c?=~_S|Pv^4xZ<=Apq~4c#}aEtT3c zg97oa)r7WX*xquv+vafwn_O5^%gDo#uv@w_6l$-C3gIt4vXN{F^EPP|-QTk&`@+yc z-#}6HSAt|yiN8A#&JdB-BL+R+U2N2LJ7;}h8PhgPd*`8q*EyC{WAqp0$64FVsA)hp zI9}y*7(H}qxT0INzOTTf6idv7fkxX^5aH&!3Y(h+DKaOj_QuX+%0mI)Vb|)fW_WtI zr5YuBfa{k;O}O{;7$dTfZ-vG4YPrUno*jnYoj_N)_|I_FAe4cQ%`bCr_L`0h4oeX3 z=*n4{kHsq^`4>J@fVTD@|6>d!^U)xi)l{J%-&C@@7$j27_cyBbx4+)W3U>UsTMZha zUx~uvB5zHtKN*9CAUGHxXUulHXBwe#1T=)Nf(AOc=pR+7^t<ku5n|0c35j_*`3Ih?bw_^ZR z0xcjuKDn*3E>hVMegiT_%r@kn(!NPW(-?Vf{={#AU$JIvz(Z&A*SxKA^cliiN*B`mk@_U#<(Hs>$B&Sb|@A+u2}H#qV%J^ORJRiu%Da|JZ8ifl;(? zE|k^zmC^iTh*B8z2sTZTcWFak6}+--P|AMpxomGZ{|ck&!Gh140E-(GL%Ox?B)Jbg zq;U&Q!?rC$%_t=j88i{eyN-4eD`0h#zyg4N?2YM2>+R`?hGxnnBFdPBoFT8;)?ae@ zE1rf>q^N{H1uE6A4YwK6`AFBv0dWPI9Sq9`j9 zTC~Z9?M52W%yd4`xX1o}QjWQKH|o@9NT&m1KV>&$7vR;7O z&eGw0!Kve~{go{Bh&W>P7AkUX2H=Fjvwhg5RY@BBZ(KC7W7G;(tkRoeBB1}S{r59@ z&+S0L??)GW|K1wZyLGkxoOU}J=3;--XnwIQ$fBQBG8D22<{i}|@60f69vvd;FSBbO zpaoUvODS%j5CnB^7a)6Wf@2RLo~0xd2ltZZxW>XKiU%TF zP)6}}hwaCjv*)8NX+o?d5Qv$5AimKn@uvQL?)Mn`I>LZxu_%yF+*k??GGWKRIFc%noym@;0>r~q}e%bq#12l`w7`C&8k>J1Fd z4vvvCWSq!1Io2b+9~}5@qDDY@f*4s&rVX=0H|B)&IbX_!u&{?ace1$b)V~d9a#&%f zJg0Wc8=pGD$7f(m~`;F3$mo(96^Mls+m422g zGbb_m&qL}juqu6o;(y929RHQ&`CoT~nU4?3>93=Sfen<~#y`AL?BV~#D?wxiQtFE~ z?oJ;a>5TeE_lfO|j~@d6Il8h}Lo!j^*lvGoEv=|rCu!cs0)>mh6!21YR#`o)r23!0 zq5|k^ZNl+|UU}{Fd}90j?CLcf(M2QK(&4Gi*l9>aU#zpe+-qDV@A!SW4NpzyW*gQc0sa2XwchoYH-b-c8+fJ3rs5 zD2s`^gZ4Tk-+PUBu{!@fEOYru<*z4OmW4j?7aC*2vd!cRu=NeXHdZ#X?#xiKv`KD` zrWu-?8t4LM(8#@%rA9us>C{gNCv&b=4|GpeeS zd7-6|0R0)rR6ryXcV6Wr5%x@td4kjwnOuW!wdY`(ChNxKGgZ3qxL4t2I8eN;JFojX>9b|CzM3ToeQNB&pEvT^0&kc5vC;SRJyyYZ$KhabnUM$vJ^Jl= z#csMWMR?mO<|zl2L??9M9MLxLqUf(4J<_Gu3bsvl243K%>gyv`%fFnMVo7ijBc8@efL@+Gd1= zXqUw-_gfW38A{~NRQCCtVCIa;{@+m@ecr>56W^9?_|dPV9N`$=d-B(rLEmS75py4> zL6imqps5V|?ET|uS)tq9O`Gszv>8ySSIqGCKv@DwE{52Jv`g2r;G4tE?+Z9y7k&Vw z^i@wREZlL^80s=SH3}k*3Nl578$B2N`Uo~3*n&DVW#wCFWFXDa3;^spH;!?tM!%(h`19HF*vl(4{Aj=P+&~I-tqQbTVyPbbI^95i@4({RDFaLfO6R zI0mHTir*vjt~Ig;5PW>+;_kQ_f@EiGAN98{PkFw=q8NjsUW4ml_YB)~_Q*)l!nn2= zeJk@stw9+=mPhDiD#6MJ%4Uh?Q~m~sUsx;3&&UCe4s#L3k{&?)aILu&p*j<`&6L6( z+v1cu52b&eK}+^cpYlp67{!+lv1UU%+Ue7HSe&CU{L+YmTG=w*oUr#^>FvxyAj)n| z&8UJZW_x?c=s9G4%2Ne`Pp2YMRi}UTDt$1kA!OpeMcW*&wiWq)5$g;MCfANu6~oif zB}wDQTgoXNDBWRi*5&s}fVm(>#Iy$5qOTO~LnPd-9P)uQ?NMP6hU=K<+8+MUU2}(f zwQs@D(d|FNV-Vzyt8mDpMEN4}8XBf@2HDPLUN}g1^RA%m)Ms$iAu~I-GdLpha)3?y z#}r^O0c55}9O1={lDGmG#x~OsOl;Q($Kq~-@#~XWc4{NE@FNPa?^b^*BSJ(n!PS>W7q~~8&0C6mU&Pog^S{RPmybxT=235vZ z@C18CNuV{RY|`I&E7xS(x=JwBRk<)n3(kB8(9-t0ilDN08|b-(%^0d*4wGwVyTrVY zU>RP9pg0{AHj(G35QFGwdy*mPU;!01`*+WJG0!HZ^-EV!rZgzq1LWrUO_MfBQ*j%@ zfKVyL>*A0jCI8+qLS(oNF|W-KQ*JgC(kpM7ZIN<;>PgBw9ce_EYu z%K-L<88dHS@_M7Iq4(n{lqjOB!fZKOrMYYnJw48#`@ z6hL{dp{vDNpHA#oPD>2{ZAs4-mqXC-^2$2jxfPIjN1G&^f;ieeDzpnXAI1eU=#h;v zWo8R7+5N38z7nYs%(z^KC<=1;f#~fNu4^LP*&zOY4l-DbVzjeROX_ff5&{=VAD|_# zIOGiV*&bTGC<-KAc~m1*wQF{{Z;%!Ld~TREdnf~2_hCyt{laOm2N)=WVU37dw*{^g z&xGfl$vQ}1OwV|?<#!2AhH2h|L&rCYOe0U(u|6w=0-fi))o0gQj<)&ZT#oZPpmeHKv(DiKzRS7$5VfZDre)0>1xy? zsoJWPX2-k{YpuOWoEz#<(dQ?32ZSqb-jf*XT;Oh3iKm_JB4_fP{eCt7?f0bM>W$+z z+->K|Y};1y%RF+?C@*euw}T=IG&W&@Jnqc++ru5~^wPl4b#-pvJT=oxgs&>s&ZEV) zmK^m6ov*VMdFkj-hv)prj*-la9mas*+q{x5wf_;uQf)q-mw=~a6F4H&c{wXOEhK?c zRD2y)9WTU*lcch+k{qT?CN{JJW+ePgrr6u%6bw8VQ@M_?9GC(c7j1nwjy{I^iCwrc z$@H@u9@UBtvJNi%=V?opG7){nwPG^irATA#L>-PbRp%+D#>qv-NK-`^N#8wS5n zwdvO8@S7oUi5r3HXk=0r&?b#!3mne9<3i5;x=r%_jqM1bI#u*&F{ze_ev!~US3_`c zWnV5KZ)*jXb<~KWG*FF9QqD%p=-X>^2)ayRo9j=k!a&d(Q*d7ejO)Nt{5t8hDD=~k ze;m>#je|o)w8<;b0Uc#LdvR#=KJv54=q{;AFqOAMbli*zuoUxcP8SmByfg!VcQI|t z-6Pa$pcJtno{wPz1h#Dk`rKAf{5%-ARhC+?&YCi-DWS5f9r`V7y=I1x>xEDsU8?mL z4CG7tQa^hzc`~v>2a3bwYd)2@;FR?CXZ&$m)(HSlXML z(H%uV2-v7v1Hf?Dq>8wX+L$z~jiGz-n#jj8U;)S~%smZ$>KKA{o_~ zc1;BLC^;>_Y-g}X5;g?ixZCWs?##6m;5C@!%KQw&pdts?@a_4XAJrAmfn-M@PBwM1 z{(-DffRroQHZOQMKt@JaFxiJ7e78fX?5!3W+YKrH@xBDMEh+s7tFlD}>6mVOjxl(p z4;F#SO%Ls+aFS33K(Cb<4d0hZHk@d@+(iVENjr3LPEB7*Zb<|#_mcB@Z$h1>Tkbto z7F#;UTZ0@6xK#dv?2FBtaXyKdZ%+=*`3WjA45J@dc^AHsx}Ckbc-xwz){G<(Jw`$) zQM$5WpAW2;qR9ty_b6_o=fQMaqsw9!*LXGN0aAs>#UsXMkc@%Oq0^YleycL4WxVLY z4vmE-$Y&prvlvH!nQ{KJEnEK8ENK2pFI2)Kx~AW)-u44mW)Mn=2DnTH~JWQrNm{if6PRq^_yl2kfQneKT*w*ErN zqhM}rKjod7^g_8ZngS4-m;*(b|6$GZ;QO_PEC*+sl%pns0SMP%m3&11MUGS z7m`Bwe@CK*YX+K<$C1flW%$r+94Nrwx9?4hw;HyThkHKYqZ+dQ(vUYxw5a#PnMe{{ z49#Xx86a6$uPFj`s=Bo6vbnbTX`nHVZ;;7?v+ApLo{%L^+DLb?g-?D>J;P2cO%}vJ zsxXZ!otLKI$IwpDbk3u0#tEcj7tR%l|J>?5AAE35~ zZ_9*v2Ou=DvM#U`Pc|$c6(q1OQUA>RrcoEZKh!mFwRC_^FL_^};m;01j8V%WiplfT7I{9d zubX}Q$eo3&LjO2YD(Eu^zQ{5DSOc(!u4#TGEQ?d5maK~{I~`_6ogk^?G?wr0{f8P0 zct(Xfye&THloulP36v?y#y|S&w{(X2Z7_j@B?mN+rWo0=j(~*1EQD5&=Kp4C91EEY znQBPkB|guJh%%_ty5I^i>N0VvLg2ElK7pJ%1jlZJkZKC&9dHML5- zR7gYsA`m{Y7}PFucz>n=G_{2>QEA(FI&rQ8Te>lDy0G}#A7?>F{xvKo#gbG#vFSAO z_DuaxP~iS88i;LFT)W0fzP@P0I9<3b-OP>5yg^AK(XjmV%jcT&5A@vqzoLP6OCH^{ zzSV4`@RRfQ%RpM@c|Z1+kh=}-ARwg@qZ;jdbK12In$ zdJdZFhA+~5kzi5ez!cuJYpK#97GK`Ww|8*kl-gIMQ_KM#a0lfM57sqNla6b>Jquvv;$W`#PgtbH zzmtH+-VO?S+H)r1Je&6cOyRgI9|PPa$>A-rUkP7~D)OyJ3;W;_%e)7;skyDCIj2GG z`sh6t`7bpT-uvWa4OCBHXXjI%s4(bp7ZKg5eSP4rN!54zZ5;q$^1NPI9cMaCEb}#g z!CLZY5Mw72d|IIhX$a0U!^= z0G~0bEvjdy@mCjxJ8FX)_sb@}#1s@&vK@_U^2&MCS^~gy-5=WX=Ok+9$T975T-%?` zBon3MRX3HE4DceTYdg%U3uKo;Pim!}Avzps!WAyAN!++UKDPi}D8y@L()EURO}VxL zhE{3(Tz2B?J)BkcYZVXd$;-L+@`;t8}J za_fB zOM%5loXg$(h8!DVbN|G#dSNBQdT&Kddk=Fr%$+`7xBgXxv6)vut;S2VX1K?mCm@x*&;5h+^#Hb@!@}T{ zdSt3RpZ^k3<6>W#JOZb2QeuPcLLs{ifa7_iVB_T-A$(LW4IC%N_G2te04(WJ>cs2= z=4l)=9qAY7HglTrb-5bp8aZU#uG6Krw+UKokO(GCl9$IL0H-QJb?k25>(=~6`LH7i zU1nuHfn5K3olSV+3ALAdBD;0Fm8-yf<7%DR!RbHW#rxwCu}5ZJ_|0 zg<--5>jCDX636s~{Z{Im>SSZLIXQ()P`7jvN*axf$(6b1?nF6|mvvtu1UlU#sr!1Y z()kGa%y*6Xtbp*h{(@B|*hAWHimoUU&G;kA>L(|pdocue*yg97QK zz1Nck*FM=aH>F%Rhaf_hS34)_IT%OF-Fs?m_Er4g#EFof+0t?-7Fq|*7?ou(mcEQL zP8ElO$t`7-W7NkW7Clv0gQ6!@jGb!2YWU-z2B?LX#HgX$wswiIB?#GGQBJr6aIf}9 zBJ(}8=-0kRq6#W|P4YYAD1Tz6yb47mubu4B6XoG>IQdjEOA3L(@_~jmck?nw7ja~8 z)l7PLJQneJ!q|Z-Vdvh$#1nVr9=Ji5a}&bg*Y4dY2Hzo2-tGuwC`{=S-eU&ld}JuYWHQphtvk>w2}!L00iQKT%iXtq zYk<`b7anB8gK~&>l^o6TSX;dMYuUf9f6J4>K`_u=eHQ~d<9pnA0Iq`weh#cVVIhEH@bNI(?#95sjSBNjV9 zsO2GiIdEyg-r7yMDb7J~FsD*+p)!>Zz{p0!I`wxmAs-q`e`TLJyi}3nLue1gpUD?fvj9Z0(z!bE_&d>h)rNK8fnIt z?Xw#X-81@lT^Wy55}PhL1T5h3fA2ONRsXnK4bSP4X_e_VHeMh@d)x+DY;s@{k_wRkD~m_#J2;>a{`_#KYoR9#B6s6u_J8%q4S!&W$gj5@yU;o zzV58E{7EG}TRxGy8W76)Jg5H!?&-1rkA`=S|I+Zz{J#wE)0!HwTO)`*v$YsUq}sxZ zrn@q4l&MJI;ReE)*;|fkLq}cxXMq{Rp9Tgojwe9Y$ z`I$IBbN^(B|7PCkbgnJCUav8BMj{dY*~!avNCxb25rU~xr)T!OcE!I3{;fC2LagTO ziW&6%x>;^z*P3xxZQ*vkZ@vAwru*5#jn#=&T>K)^O%qxrSX_H!t`3 zR-9Vh2~lY&AP9l#TsdE2|3S?gYQUYN8HM`u67!?h2ko+u$Ag8cW%ZN=ie|r|=lJ)JO!n=wG?hK-5TK*zHuw z3zSPajUkgJVNp^$ikN)QSPnBCcCgU90wcklKO_w{SNa-*MnVttdSqHD9p7CssN9Ue zLM{g4@rlAHsGenS>-wxCD+&!Ij({9-6an_5G}NMfTIX(BA70z*YB|6D=hSa^_8XDs za{yn%#nVVVgpc#pBDBa$*(%}m>6h$(oELuxln|&GEX@_|Pl)98ZZj%yR*j^6 zXuBW=$c<#;1w0|FdpTSG*&=NcJY|jP(Dp&u0a{MCS_5N8%R%+kK%wdRmTa~QosvUO z%q~qZ`v2`GNgk^P{crR~CrQvj!TDne`{_5Met=p_@x{=8c6Y_o4Is1@oBhpiRi*7=(j5vc)-+O~ zL02`LvbGEaH5>~f2==yR@~nMB5Mk$Z!7OfUB&#!D`nNx$fYlJPw`xz}x<3yNS>_2OG^LnLhOPwfJkkA;W3*X`JV_#@_?F~TNR&GAMCAEMH>|E4C6kgYT;egS8-$rjQsV>8v}HI2 zPne8;Ug=2O?kI&}%pMa=N%K&y(z$`|*)_A8Q@YffP4WkKva76@H&MC8Di~okxxp%+ zt%g-9D)2(Uq}V;})Jk_El-f~Ss=~VX`T?yoqXb=7pY%WVXF|;A=bmI%QtLvywJ^}0 zSYa091pn6G0qZq#Dg~#lG~F2*S;0iP+I`$$Q0>nwNY}$%-C?xnD&}}_NjPvyDKa|J zH9RS^>d{AKC*6*xMU}!_03y3OR&&u20EL;UjKT15X(DQdRPS=duv zdLX5IS(=Y`MOc};7$w$(I_f+&C1TwsssV_gzB0U1sBw-GB29b-4@@;WVH2TvaQ z6tEF323OK7?<~#i69uOPtWkcw$7Uz{vVT+#0zKi<-KS$RAtML@J(1pBo!Ma8R67DE z@YdGWiOrA3+O3KfPeI;{mZ8B8?*;rVbSegVu*4ky)H14OFDkXhhJSJH@1K@jgKm!$ zwQ41fhgb>$i&oAeXR)aUr}gEL|cA` z-a0oIKK8Tn_#AFjpZPArx0(CecntJRRh)I9BYaD;T9Kig!2o>k0=rXnsln0EXPk!2 zY>f`|Ok`)~lutls?pSFI)+wn%xSsQHOp+Mh4elqss&?h!^ZBaY-c~X&4--Ltw43I9 z&GXK`#+fvjEcOrVOJvX#BS|wevk^a{B7eIk z1><`zwWmXK3ZI4ON{)r-{$hjKI>Ehx%i0^l#iRw7-W3E0YOxVbe`0no+XJJKN@Jn7 zl~L#6X}gvPzs@Ni8+iKKJ8G!zl4*I?!L*!RmBVWCgpL$@UxInz@^g{EKP$J|#za;! zfF=x`^K@ACp2nmAN1n4RKAup@!Bkw?Y}`@2j9nEx1c!9I>N;1Ac2hgL^a3EF%{_^R z0Yg#~c!?NzbI)}OW-_(~0Tt)K>z4o`;xYO-+m6U{2Z_j#_A@z5X4xaJ{8c1iNgUz_ zCDx2kPxiE-(mvY2LJ&Oy`J2nn5;}4&b8Il|Wg=?ScfZutC`Q=5FT}!r1oY9|9XCB2 z74kKOQBqOZIY1KJ`yA@+jyE!r^4**X&uMAxr2yHgS{~)jxj!%tiEhD}p415TW}zdS zCaCVvjV+JZn|4-%nj)y@i?M)OIl$(A-h!58MHQ;2HwZ+?apna_6!`nSU3e*PvWDeS z=Nt{yq9%?Wb!Vt1yurysC}>21Oky zj&qyYqKzzX0FE!-aTi%tUiAa!<5x@wn+`3GsQjCu@$0c*M&q`0X*XyQ8jaZ5xXIJz zLQD7aV+AFLhGQnCJN}_>tN2^e&_fuk3*Uoy`)xv*Gn#T`ORGs`FT!{`v~VhtCGdGr zD%k767lk+q**9GwgI)HbBHqhN*I-%c2#5f5&k_KJMoT;s>(B5nc9-ka1Bi=2+%Xkg zmZww@(5x_BPE%StPT|nw%#V=QH#m!i3y<4x*Sz9Q<=K@&!`HwIH(Y@eI-#POXAWX< zAUY^^b~MPO!^(2KDnQX~(1m~2Q8v}w@}^akIEIu-=4@}bcW9q7cLryU+tO0s2n>ga z1-FrcWXF!P>0)YujM{c)<092Z=8-%DrGX9HA1MbI%#mJTXa<6-S=3!^w_{`DC+NA2 zP0+VRQe;$)<)z<#ugyB|#_y7QuXi2}ByLu4CWn&4=}v6RS(G7oB%MLrj0IB$9wRG- zT}bS!M71VHILKCoB)dGyd_@4%+Q27A0J+6sFU~9{GE<}-V2TQG+!34@$NNUY!bCpD zLLhvaCL8QGiKOf?u2jE-1p(#vwD$L_HZ0{GuHDzuZ{|OYqpaA^E)P{^^A6j1TI~Z> zbgvEyEEDG9e;wVZvxRvPSiNtNW{-%TFu9r4KgYuLaf0o(%uVaC{f#TiH0pDu(Ff=i zK*zKg*-)^=%|W=(HM!Ky3X`%hIz--4)!E%#B=w@adD>HTIty}iSeX&nwnhKqE?&{C ztPzFcYS37qiGjbXFDz-MMyq_xmlnPin-XYzZZkJMC5ZhrwLD#FN2G}5A6up_dI5OZ3L`3^>nf~%QjCLz8mG&68y;n|arbgz z+Jz!)*uiZVF3BBYpXlFFqHU5l8F8PDZd9-wEXgTtIi<|;_b{==p4 z>(S}nN+{Hy_@~U;X&`TIM-r|XekuA7#sSF31Bc^U*Tz@eTLP3cE)|tOGPF?hXI?~Y z))~a{i7v>IJ(51V(LLw1vK=i$8$DI~ooDR66vJl$WGMHvoCo{O0=Hwla0#`cp(7U-BZEgaf z=6Q7z@598V660`dIRqQ#E_?s!0RRp|4b49agk*xhUiq^I!&(vMPcoek)A2Df=aVM} z?tC-!eB@Au-|QCj%tP7rzjMhfvqlV1j-CV?Xu&TNH_8*?peT@t=&$Fi{_mRz{ifB# z9SA=7O&k?nw!Ty^E{_aw?qizh4BXI3X~{Qc;SMI9=DL1L5hSbB-JH2_23)OG@T)gu z=f>IzJgQawJT{eD>-0{Vp=O$96mKfLb6ZnSU!2ohOb1KCDme_Z-keFQe$F9lhLv{d zg=U=v1Aqtx6a)XhBt^*nb5cnFa}2>&F2yVHg>kPamvEB%w%QP6X0Cs*Xaq&wKKQX< z=3wZ8#(^uKz1N`V{UCE>4a<`YIHL;pnfD!)6AJ*JHr@KRFMDH!-<8HnN91}&47WOc zB?aQ}E?8=OqU2ut0CZ0kOYdwk5HPo9N&Zx}@-!Bnf{w2u1oX4-`U|YoM-cEIZ!Z6p z^__{8;mNm6vFIy0OZfhAHNWe#7Zc|UnVKWLu74pV_yvsiGnwvWtxn*`$baBwqErtEvt-~TUDxS{_Jf1LvA_i#FY{p;TLaXa>}Fay(C-1PQf z$Qi7`n0uCl<%f`sb zS?_I+Vn+Ik{W{blidpB+w1i?9MMttqJb|=>VIRHbU;gn^r}rfJA%@KI-|A&wDHX<>EqIqGWRj}j zJq)6)j2^1kyzR+W%0!T?(4$1*iI+6ANP&kYQ!>PuN*=A|NUHYMf-wlhmz&BY{;-_u zZ~2^%qC`s2$mJ%>-tQyEl;?T@$uo=R;eH`^@WZY^Rvt^{?}h)v*f})`0&L5=ZQHi3 zX=B>9ZQHhO+qP}nwr$0e>`Ds`Y;HM zQ7&c9iOlm0<-|e~Ie);7qf$aZ3ULLixQs3SaIwGNDZRjrf?K*7n9?B>v*4BPt`gTa ze4HHHaRyEnraJgkz~3QTll61Zt5FM+X8PO&khnESc_{F^K-%EX?2vt$Vv*p);j_)U zNiYo&I;G@X;Do?0Gi=>0nX;7d1S6i@b1#yE=Ua-+-Q-_p9{okKM=sjd{OVc@8qnSm zBg_W81Jc>(~!@WH5s>rCoZA4I_xya^)GvGJ?Xg#ven&@!%wP|C>(X!DC8=i7@ zQEzVa_1hw|j1S5f8&gIKwUg;L)9I_!4>C}JmmSCHM?ACzJg#geg^+RM;WP{ZSxy8W zY6eI1^t}enr5%G}f?WFx{E*;NXUv^-c39r&3VM1}K3L!24)=5?LT_41CbsDO2hvT( z(IdL4{3_=7@Vd=$>cgheXup}WAd1;o%B>alrYj#EG=*bD46)t@W7MXX8l3mV_)(Yf zJhaB#>&A3=*J2MGk`Rg*ahX@R3a?TNSM};|2Eb{5hUKY$wDhtsNcMpIXW9deYQ1p9 zkCnM!wNC=t@(|@H?NWYfwMmUIrB+l7b=IYjd%(oeN{UY;`RBBwVvBxpw8iUmY7d_E z=ROE2Fz#2mFwp|}L2A`ssaYWJgmdUJBj$bSZ-@+mTr>+_QKdTfY53u-T98Wbc-ud( zdX~R)v}u?7JP6S^j~S&)uQ<|JI!YTa(x-dJEL=`AJBH61 zP1hu-$kLOByA6YGf{D2>kJ1QtL;LSuyvxh;z8<#PruHUfw&vFfkvVgqjuYseUJ|RM zj{C3dfyhujD(axLbPA`0{DK^h`^FfRWGoYNI*81oTefj{C^)~X>-rW6p72^_-G`${ z!SeC^#u~6_=Pyzl&s#x_{7c-Z^rEM_(*~FNxy*oi5C-zm6`ZkkS%x{uqo@N9KtI_G zE_4p5;dGGk6gs_}apo28UAC+3Szz443C3F;BMTm(hAFGN4aa))4PKKPcZ$lzuNWLUihwr1K9Ni z%9y#l7%xtPT0Zxm+>*ilh z;b6-^VkBAt_1q=iA7_a`FZmQNaf6?>kRUDm>$&PJPt@?+=Kq~NXTHiPoLy`FXjKj_ zibfSDz%c!;!Idm&1|4gICK_1ysQ7K z9P_K+kB-d75Sr(9&b%!hEo5TFh7J0jzaH04j1V+SXIo;IStCp~c1h$!3J{Zz)qDTe zJI{?+VuE@ID>hwZO`3<7s3rCx=C#UzyeG?`{Wn)7{VdR9c5!N9an)-BF-4Q^#*iPP zJ{nu)W~@1+2Hs-kpCEjsc>B;=>F%xcr&mQKmUA{fqBfttcv1VTte1LV#h@z8NH!#= z_nXrGV<2(z4l{Ab(pjl(7|-P!05f}GjNFWyPwuY|h`$-m05T!PXd;lDlJFeqMDjBb z%RztkhLg&~9&E$|tcbL{aYs~jStNIKMWGu$^cVSs(_!E56uB<7rxX{;um6#lwBQ^r; zSF76yDffhGrMu$!GyChR^pkUo>Kdbd)x!hNefIR(Zf@)A7et$BUnthF%tso>%Wf?| z9~K3Df7h;_Qk^kl`j=_sc4BFG$OlWI1KTQPk(L5{c4M5rbY#a?L$k!U*(c1hwC6S6 zY=a(PahwRgTGJ@HQdy^fWA8a>`{rVz+mj<&c{im!6$1i{4oCCJO7gmdaA|JX{Wdb+ zlFGB*a@UWsp|0@KDSZwK5w|Ie3e`T@VytVSfU^AwGJW#Rj9qvy4)b;V*ttE8wcy~w zA*jL)`Aqjx{1^sGgvI842DmMvgo`#}b04yoNahdOzF~(L+V4|)FlMF$?)0Hs2IF4A z`2hJ1EbQx2v$>3^=jo~xQ`kpG)HO#T2I@5eA;CW1uZmbZU_X_*`kT@}WoLHWtyi8=n3SIEAKD z&wm)6K1mHKRqy$FKCy)+1ZDm^aLMs?QVP#Ur>Zb9q=N17b}9Q?5bFB8FQ@uemC&1d z4IKT`u2UnNQxyxYN*gTB)q8RIYSHytv1?ommEw5(>S1P~2CQQ*9cs%v9}qi9BYE|6 zHXyj}mOsVNt=7-!cCuQgmd46cVM2Br>y)|lI+-l-I5eVy5;86r+zvm@bO;#+`Wv7` z5Rb$~St;GFV`6U5*%5xNYDdQZ+yqu(=F=K={60MWV!S#0GUia?>{~=?J%3#wfy9|; z?)&v|!yfvls<1LZooQXtX0zo5Og**55qqmpj5m4v=D+;Gi@E+8K)`6w8NeV@K-_1JmNThwUV=w4mzfEJ0lLN(`+k zrt0`~jn#SU46A<2=hs|YOL6qvZ0epL?g*n==hH{1J_m_J7Zg*>G){{)q9hp-e3sWe1?yc=H|DPPHQ7>^bm=-$bl>XGPddKvG1JFpb_84+?uoM zfxrBg6VchHG2G|B@Ea(O79Q>^T(RmoNvmd_jq1T&J;tx%P^L)D)~AJ;gE?ZTBeSEJ zzDeb$lhKNie{|gsRP91v+1Q=K@ooFfk8Vf!23@F6bJZLB8h(_R_oRt58BdIJQZjSH z8Dppv6A^sn*CvP4Zvn_;f`me+%Lle&3+c%>PQn*`xCtrQP=`+9tXIVfF7B;)A{NRR z?*agb%R!pfA~aX2-$wiAI82!_9Rgs)u+T z{neHB$h9hxL2{4NdA8#2%}$ItD!BF5)V)wo(@tW71$ahIKh7fVKSI_qW9b7Zu^UL- z+CZHEZzgwFraw5FXa~|oFa&e5@81x10a%Xy4>$m|Kr_6+=U+(B0;xCMgjk5fVv<_&Qtdx?83Hk%JNzrv0huVDatSlFQCGtjq|r%`kk%#a0@I$?&F-dxB+ zXsHc)m=sn)O)Wqu;3J`X`KN*!&?+dZ7wb`Ps0N7)Il~aZ=ZKD>!&Yy?heuOw_U(}7 zsamDQyOTA=xtSjLBt@jAq{n22e=q1oo@x9EzU)+08q16PqzuSp;8Vc!G8}RF<-W=;)quEOm1Qc=_lMU<76{1x`zhnwYd znHiI0TkM-$jqXFc+}k zv30TW-k(L6O+1w1xDg8MlzPeSS!FSJ0*B43{{#(b*US_3E%S6fI9{;n(Arz4jU93P z^Z-LWvOF7Kp#*CqTU_Al{vK-jzaB0)m{nTNeSX8U z$>aj?_D9XV;yw70D?Ea>^nk9#HmVM{k>WeXvcs%lo3(k z(5?%QJ`XYFM7UIx3REZvktA%GqU;sTmVzir>XIVPmy-|9nj7=wl_kdRq~!CpOe;?B zutKTJmHC~^E;HFPJ!hCeIT;11kmFroKr2?5tlM+ zJu5Fgw}&-Kh&66DH_!5#AlaFX3GLe_K?(~sL_c9+Ddlz1pOVAt!~f*=>p5bp?-`(7 z0N~p$+UFTejOgK`W2OjxCH?54%M023@IWDpdqTrT3w!rrLsU4t9GrsC}*y&0dY z#IjNwAY_aIO;4~1T2-~;4Krz87K!{WQ78v>T!wkZZv=Vwldp3;TMIyz0%=Iokpd8g zKjw6AV87Gl7Tmgf$j^iI?P*i*)qyemZzu>)$J8_s1@DD{DJ2PUs448uv_!55?Krr^ zf7UZS#K=2S%Mqn?-em%^Btp;HEFXAUd{2i8oZdnVj2e28nz-IP8J*7#fRI#i zrqXxJBDF%KTc@E;AznnfLbEzT4R_XWZ>VSmCeXE;cD32uxXs+ z1h(R4kOhlV&l^OSYYWvCXL&N~DDA_uszeTjuL;|heO8*4ynIn5rV4CZOk6usnr&5e zTqeo22y(dgJ{~~k+lXQl{C@UY682wRh zFGMLm_f5=C%6zC?8~4NR&F9~Dsn66#13OZOc23+2L@qi102uU#tXhu| zZ?LXGBX=qTy=yFAa=2!4C7@_gJ;DKTkXOnRKkdPeeiT|kssT>JW{BLlLRVWkN*L>L z7u!wkCx(!47Hnr5`&(%1g!}@4yDGMp^Uo>?@Yq^f8eetU ztr84ppMp_;HGGM0!)ALiNvhUx+LAl8LO!>q*4YO_^xp@Yt8}LKJCvJ9zTb}soIODL zBts^lvFsY^p2)ecgr&B%<6fsYexC>>Z_GXAFS>(YC=^*!?%5b_)>Qj?fc~SW4d}JA z6U=0u2D%ECD=PkQ>ofX7js+{wEyouJ2}@=tEkbXhix}KOy)77v7$O#s^>X_4o69m- zf?7wNtQAP#2L}jrb!D@ocj(%?RQMdyt!M4@brouG#N@G>iya@4M-?Bw?J-lQLBJpI z8KIKz$?1dBf4~CEv$nhcDvenQ7zk_)ETFi#>HnHrIT<_9|FzP0G8Q&Av^6rOmom07 zbuuGhW?^FapVD|(Lo;!+1@&L|bxyM!6T1I9fx8&5lsS8*$^HxN)Suek6;m=vLZOAd zx91dqK-j{6yLnrjJSPmKzAbCgwa3wK*;mC%WdA=gMnCh*FLfWAoy)F#_o#(K@}nxZ zHmXxKX#_GG%bnY`%a@-YENuU=0hhJ?_;klBsQB*Uhvwhluk?0*j!F#RGf(R4eF6VX zew@bs7h^Qn6Ca~S_N^+jf<0{Z+*9#q_p&p0$;*K-%*8^4!no)6{^Zr9TCEw^@OD@M zlvt*G`QHP%js;h%P*Bds{l_aGHh$8-vbWnUVaL7iNco{0iahB(S#^@nRW5wL!VNzU5)r#xaMEP+%TVHHeFz4 z=KvSEzG`^U{q#quDm}>O;jm!!hy}i-i0rYi`O`nqB@_2%R(bT%jVpHF@XHBC7s}!k zjC;3B>N?79e8K`9?1gUH!VqAEKN8#wunIIig0ji)(>_jDYeV%|U z+}xbGYYP@rDlft=8Y2>z9|lw|FNH#%URp#cF9u?wo)~x;#JxVR_lhk&dw4t6c^Bx& zq#NpbK>C5>#a-{I1UcHucd7$yQCK1~z+V+0wih%np2a2htNq^@d|u*Gq^X;B1o^>DQIY_HDfyqQakAdU9)Lb%*7WR_`t@6uc%( zBrBsoP!tdFV~zEeGEtj3NOcKSYRhWVqn9)L6G1h`|Dx|Sbc~mGu+wRowg!_gs}yfB z=iaiP1;E%Jy`$J0qu#E*z?*`{{iw3f=fVcvr01$UI@26JvrnuY7|1MD{#F^Gru!>|*qLyWV#6bI`W7Krfn9OAE54XVL~p zu-@sWT{?_@ZAj5GEf#dZILQKD{Z3CJq?}-mA;qz(it(V(4ND6(eyL|oF*(EjMsFs9 zyx{PD*v+foC52rcI%xE)D?H>%ifW)OyHKD`18v^~aTUW4R>))$Ck}&A%aHOZjg@Z;nCeC z9DdWV)mjE|dH-9fwOf|>4ip*YYZ_c{u3MZxXzs?C+vb*d4`Pb2OzTZ#Os**_5Tu8< z6PiJt07>!UXkTW*VT)9%GIgU4L{&D69f%^z+jHwS79u1!WNt17zx(UF%Flk%`b^Y zlox|ynFDhioIVcz*A4VbS46~*hwN%hlaO?Q*Ps)d6o4cnzx(pyUX6t!gDLVX9E(E& zSWuMAkNzE?%%Aol6~XGx%@l8X4$nm26+$d78v>D-apqJ%svBdpEu@#(5hIdzwgBTL zQK{Gg4O!#UuY2Cub;$+oh}<8R^HHI1S#dTWlYJ+P&7X1Q8~Ln{(9)6FZ473H6oH%* z+e=3DP>QiYD8V8*BQ(@B6<~s`Q7`iuSFPBOcXh}+tC(i&AzSI&y+h&%HOJ0;-V zx+jG}l5R9qkzpdMjxbW(P}}w)KJ~1W8SkV|3i(V6dM0qX1uw%E5KCMuLE+jm9LHdN zt(E<>9ozY z-Vg=DjlIe6vmO^;aB#ovrCi2_mSDH(O_fkSni8~E35*~#K&@b?AY|hzlQsau)qzUA zT&ZZtl;(W@w)B&Y%x4`$3#qRlHBndw2`Cg&Vi>_qO3KcSW6RBK3!N%QLrU=NQVxQR z3eZ6nKSK~>nbNWBlWgJyW5^EKB5B_kgc#14=L`|K7KC4d-oG2527#!ZWs*DLUdeRt zn0o=>ppmoiATA8u1hFqZ&6@>!g-kNtpDf~1y&c3!ckHUKD#^fCMFFJUKh5Rg5*tI@ z4>WYTFw~K{vK8H`e{~hP#frm(+(O*k8&c>&tbCs^OjJTXxapp~=w$=dQBb!02cJ@3 zYn4=s?$Me-p!lcBYf}LHRgIQHE;pp_c2fkypBsVJ4N$Ze_=^zpW}tR8!mo)3i&U?@)aZ4a13L; zap-p_Mr6A~jnZoV6HD~fa5#WI-l)rbTRyqW_`vcnNWB~0`BStCXm7k%3`W;2ZXFf< z?(aukgAkE$fH;y7O7sTu_M0ni5$LDdg$G%W&rn%yP6gA$sS|9$UF$nUo&8*W3!EE> z5O8_1{zbmouVZI&j;>pHw;eCBk)m*?*t#=5Va~_4_mbR0s*{8I)e$=+&`RGOJGN2c z3BCrxYsbfX$ga;rWk6N~(+QA#7U9|qZb|fNR7R+O+lSIOog|`2Nn|&lqYU;Xcds;k zF>ZHVrXl1(F;jJ?86UyV&(^U)2OH5YPHa*mJ`3FXXzrlKL7o^lV?#+f1p~?hHSuWP zlRP4HXO*36ED##p#$2t#N(bumRAz+;<<=x1&W(b3E%aDa0h_-?&(;!p7LICvh0M&=%9GhIA55V zlqBV9N?LL0dvihA3!P;cU{eM7zlc+>QQnVliJtuGf1fF5g3gr{k7?cwJu9` zKFd?T0b5y>H?}gi+Lz@A zLtI2Om_F1nSC!tcLRw8#2RLEM3BC+^>3*;X*7uG9oE&9gZycl2XX~~xr@&69WB?Yp6476Ac<_$NT-5E_$!a!fatwb_z}4XUWXJr7VQO#HYG-Y{<$RSd-9SPYCEs$T)ny_j}|#j=MCjGx{D}Y7U7iCCm=_QAD>7Yu1~6 z->u^%y_Q1@&TD2{aX^6G%cePsO4qpX@rbZQ8ii+T_k-ge?wviFCuzg*bz1mEwf|M4Z{HSjQS*#`43|5O_S%{%9C288G=F&|O zTa$6HZ#+ir9w&pbD>(Aj2QgTPr|)q*=pu8!?X^^i7XobsBw$2RB9$3Ai)X2d(k>a! zb`4x;$j;q)dC%!0wzQ{uluU~yhmJ>=?)IPwA~isTulkUO*9NekcQp;5cR=S~uNFsm zH7L5DzuP7=Ztase1dhH8qN`nD4ZkqXNt36Oe;=J|yI`ler^stuZnsPG`|F=GIi#Oq z?Z4J(|0nb|69@bMs?(}9{y%zK%U=*~hWkEKDkq^ywTNPYtkpf@F|YZ!5lPeGsXo=( z@8_RSiBjW5VW(R%eorN(Y~O3vHbmpABQFx?rx1F2@7JrIldh*jv&(%FjfI@8)yck9 zQ?4;DOHCimbrYXCqtferahnej%l(b7}fSOtW zwhIJ)t9qpS=cGETp#~&gg-$F-QM9b>He+xu^{xR`UHR2m6CM0*Sb0Ttv;kU}?l{zv zbl3oOyeouV_=Xg9$wc||7jLovd&A+b4L}^e9ZV!uU+2~> z+(2VFsi^7FAEW%evrGGxLvDInQu#6A4!Biu5sA84LCfyF$orA|Sz#6F5;*ko7TYP^ z58d~*|FOnlAY)S)rpz*S&Dvm@Nql9o4L8NR517mH-DCB==%c%IsC-VpG4igp7+CEt z(+K}b#c-s(BCb7om8r1ns-=0FcR(cOlV5+^}e-^;Xd+~0ZBdNG#sJe&&Ocgcd}9qBKp)`aE)zOfdZ|7jC!_0f~hNf#)zd;N}*;jO)zEXl71E3_0ckBaMzs+{x}zA`vc_*Aj)YRj z8M^_hY{AHw-q8@mNPO&_fTbV5CTA<@l!eux7l2_Ds}-G~G;WoNET*nM9IGozsiIJM z^|=7=@cysMeXkBh`kox+5)WP}=ffY`zQ-6-V@mDIpyJDzfiD5-Tz=o?;SAZCaIT0m~GD z^Ii^gOcV~MqJ;t8Ojh1hglFYihCqOU-twgC*&A@SYONp*A7-X zcbqE|gHI#0en3RRA)XB>p0$k|W zDu`1JYOeMVc~t2>+cXWc06B!I$3g!NfLyDnB8on}D&M{g^HV7ycQ?L0TyDP^idGC$ zic>pkDi<*Pc;mt{LL6203oQR-*Esq4TqB_p<5u%(OnP$FPa1dxg7;s601Ipezn zW8~&3Cg3PkpjCcNOtVHBVP4FM=Jes}36Go0(wY(j{`5SyDKa8#C4 z`uY8U5$8nUKDOu3M~Hi0g^SnFEUSUHCJwBNTmlEnhO90LE%T+?bc<2JgE+FL7&=O3B&Y`YF z5~V;##0l4u(2J?e)nWNBg$}gDH0X%7S>4dgbUNtyBcS{U9p~3|n3ZA_ZsJk`+M1`~ zzr*K5+xq{;rOVXONj!5!Ikuq_Hy89TUix-(9>-%&_ke1dK^VM&b9M}$5Gf~pl8R%IsmDr$f6(iNzBv{ z1NUVf`7{9-CIyE!JnQ8w`T-C=Mc2jO8CZ_Az-=9$+)+Gh5 z(?0;iHINY=s}}O?^Mp@6kb+satppefhfn{O>RD#UcH}tf#uZSI1#ex(&72{y#j-kd zd*OCOzWinH=S)(*7d(v@77^{NLpXWup@s+OZt~AIZD0Ta4wmA{l&iToB`-z>NWU`S z>c{Nyh6GBASvTi~vew2`To3$X_BNc&@AMm_wn;6Fk0chxR*z zE;;7yUX|RlCX=qUT?Q&4?cv&>g-ML_;Pgk3+II-h#Y_~yT}OINRtQ_;3{De69~a1U zpoo>oKS0b_hd|#JOPHF7cwi*2p9djlKZhIu4X(%*7n#e^(aTK^XDeR<-wm3f$jWuN zWGI|Fd0jR3XT5~85>^pf4qRnG4{_5*hTefc9uKl|jX^t%9KdH6Wfn@J&J4%bfc*(bM@cO`yaGS5xSXP?xz z@^z3S(%`}s@$Pd+{aT3KgyMD7ndKj2_$$vyh7529FV_7A$t|ff(YRHcD7u_$o5|NLIOH8+Emum-vmeif@nxo@@aU>+&)dt;&{G#k}A5lo)S#zQET==(2mL6kmVtp zmm8o&N@>+l882ZFumm!)l>RXk?39%q6(7*knLA|@$|7`fh~PW4Vwc@U0s6rf8{Vgh znysF$7DLa}oNhMHMF<-%9d%Ly!qk6XD~Q>w?bM>gpm7S=$l!0TW~L!KFrkuFNd-R^ zAD$od%}LaoJIGIGwCDnjt1dXiU&FJy_FG^A8?tJuhWI8h^7_%fGJ6MBW;Xfz!Fcz} z1H=k%7rAuBN3WB<#Hh{CaiEp8OUfuoFS#ifr<_En!DK?Z_T;) zcPFRp4=CW+Fmg}=R!2W4#*t&{FPyLjMqiC<&p(k2ki-3C%6Ypy~{o&_s;ku-0^0>d! z8!iQ~FP&M8SMIQw*>9bE-|);U0nYzLfip4upU}?CY>fX41vjj*YkTycJ$2psF-haS zp|IZZ7fK!yk;no8i`R2H_y>)ag(gJ-X3NW5phe0RfrAh8vt`-^D)dBugB@Q zOj+!X@;&@*GqB&vX_wxAD*I#;e=S61NF~MQ29JHoih^7v?cc_F=)t$6H%8{6^f)Jd z+Q*31gD_>agnuA9*N(u(m*5s(-DQWC= z52Wt+v8n=cGoiA`_9ZUlZ527qKb@dBvPvNy4phv6-dLyYOKdLB*9TIhBcn&Eg)xw( z1z~E7wBuzi_wmBg;{9q7)U0172XZaQI-ex#Lb?4p!?Ee(Yvx)9!3mtqz@3b4Z4@rY zO*3EbZWRMuRa6~O55IbPbd*G-v3RGQCb}S%q((X58Cz;|`TTeMn=vLStrtzW;!eAh z?`p&P&rVWmbs<%@KC2oI8KsqSg=Wv2IsST|5V!?z>d#j8>2&0;kbD z-sL4q`Y1cVeUVoQn~z{X{*Bq^GjAL{he&Tby%(c}EIK5RE3Dq~c-efSytiFAW)W+m zv0JG&7!b2qw(1PZ924t=H^=XMEkl93Y$?+kd?e_Sih_pKNYD9=L)5(c@$oZaQBk!! z)lznk5_xR`Igtvs6IZl{2Lx0NF(s+~oHwSCfoQ2EP|=7xKqV7Ml}DcFNd$}=)qzW{ z7202d2e$j$q*0Firl>P%C<-+(ny*TF;E_kj)@*=H(g6iIo~ZJpgc|-jRlWAV2{}AL zvD7c3n3g%NhAzF~sE9u@Gb;*DL+RL?oS+8V0XZ@gRn5Y+mOq#E1*NPZbO?Q?&0_aA z;`xYgV1h@m`6mJT$VSGB{H7(G3K}f9T}E9eNsnMuhK2LK-;angtfAUS)mw-3hjPN} z&-6c08YTHfEyi`8NM43iyJGBJ(auL?5*<2eH;o-q5&U3JBJ(+s3~8PiAYn^$m$YY30V@dt9fiu6D4fyz?& z-}Pr+i*d`gTPLVbL#38=cl`jwZ~gqqUeP06zG{^rgH}DIvY9)2@MpZ5(6>9@Ymgl2 zBAd#gPD7DIH^_ecQ|8#d04rAvz83=Fjrn5#UR6w;^+?PBysv%hlFncGmbBR5_ZKvp zBNxb?=$%^8n8knZKpq*LpWzR@F;qT`uZf(ZyaMF=ihtjN((D#cARTckBvHYZn2*BE zke{loV=s6*0;ctA5+Kf?`-JZU#UzS;vWD!sA|~@N&lb*B8&3ipXgE}kGUgm}0EVN? zg@tVuk^>4zypD+HWBX2agOxOpXo`clZ(9I_%qJ?k*g^&Cn6Gc^dlMiLG~ylg5&syT zTrvO1TnzB_J|cqP-&4`f>FbkHqiEnn@Z~)bAu1DZII(G9_eQrrH}s8Kl)+R!ZGefy zq$1j{-$lP$bNyR^^(q^*=&2WB)+NpJ}^2&eHiI_U(JBE$pAV{=kQ(ht{zAtLX*!vPusb zG{MX!@^?k?4EBE8mZ0M}q^Qk7k6Wkc*g@s7`Ahr$Mw%*}Qw0RZT6We&I@0aGWhMky z0!YnUX*Q{{ta8ZFB^55mI^OdGr%(T!+<D33O0lmM?=1Ga<b# zHD9*SQXDppn{IXZ!QA&2;UG;*2oS*5(6(4|0I#r*+0c$}70&+RIt?-0OJo?xq9S>5 zhsJQ~SVe>$>9ysi15X{Cy55>zS~Cxf(^Up9;z3=}+2~^`>S2bHt}LKEDb#k!9w@wM-%pUENBtId*DXbqwm=VUDqvWn!&B6BnR^> zs`9+oy|ls{2HHZs6lOx!qO8BhO3fDlgSi<(TN_ObY+C|yNH39teju!^|oS&cn2Hc|RcM z{VL8)Dhw4k@#-35kK3vAET|bis-%V?;f&?(f}@;q=@hiD-TUk=YhkarY*0aNdKeUM zN{H0$mhi)?=#>yA{2~FaMc_Ve38D_mGnD^IHxXEe45ifqTOm#L)q=EuKNoO{po|P( z)(yS*aotJ0_8-3n51TeaLw}~us5ZPGH=Hoto$!3+iO;>rTDf^c_hf>mn`z~kqf2fP ze;|<@s5k~T*)zq2@PdIz8j31ML3r3;udQLXRHT|PJ*o&^XQ5A!ex;pWJr>Fyx`w3=Y_Qsq^W9d%5Nq>+Gp;F~*h9q~zf1&U(-FOz z)a#y~teY?_9d;^Ce%WL|=oW)Ieyu9$;1fs~>TRzE2@_nwvq?BW z8lD^T53kH3O`KQ4Qhxl{QXD-^+EX^4Q}Q2_28XwBYN+8i0D(HmS~XBiBDSTPcJ!rf z8kwm-ff1Pkey4IKs?^-@!lHg1LVKJ{49c^ZUPQ`Fm+~l)+}W(0DgEe%a&c-zKfK-M zB81bjH&3--;;~1n*`fj_k;+D=&QpJ)Bii?&eEb0m8%(|R7-|VGsxBD~vHBw9C!=AV z!9-XT!hgLLVWSkKSKjR|k;632^SfmSjz?=Kd;f4jhlVr);Q59gq257l1~n|Kvk_KO z6;xDO3--*JS>QpAS)1zn3aF2W57)XNoZ==aFrH*0L`f6ORxe`FBd3G4$v&`(<$hG_ z#a2hHt>p6O9J&bKf@fCRV!I5SgoDJ5_DZ1={}jaQ%Z&T*oIli6wx%Cw5lJ3Q-uZe$ zBhE+l$biG7A(sG;IMH?a*@vyIh>@6^*OHn~yom(W4OLCS{MCQr64Y~@>H)l74j?s} z&uK?{Lb}GJS&w?rzYInkInVeaWRpMLA7wEJ5LAg zY| zE9*AQYw%+t#1(*nFlbUAsNkCbyKP@_yNoonLJ&KaU6wyizoOxCD*y9a_rgbB055xj z<2QZLcU?AdV|C~f6b~&&qkX8bK>ZT(;rGbyS3tNh!d0*X+ujZOQ?a2g$REboR=-aB zhoQEG$=_Fq>_wTxM{PoY#)JcX=`z8)n^wJ>L$K~ZtIX?~-nA#1{qf(ap7lyVZy$72 z)$6W2R>>xZNsheVm0hjqbJg;_Yz%_FH>~k9L{(j^naPz&PzYV@pK6XY_I{Skq3NQ) z8SYvOJ?w^gau%QN*0|q^Bi{xJdu=?~Q$q4Iqe1?$gx=o;Q(LbM6r;t7oRn$)!|mdOgp@UfVcvS}E7n>q*ce>@!D}B?HtoY6pNQ-U4DJtXNM4GIPZ7RgCmpYm zknud^=i6ENL8`F1H09y1hn{BAxE$-@^{mXQim&37JjmCv0P}NNd2Rpv`nk+*yB2X$ zGzQ(#v0GcFE-wS6ukzaIiaCwi`T72%OFe=)pD{RF|GA03`(xL7l4WY#=@{+%^QOD{ zChE%VLfazpa_hm-zH{5r$;!O`;#IZrr=)Ry=3^S0QQH$&MLjYAgX&5{sQG$Bd!4T{ zJm;opYT`ue9rDNts61SwTK`vRW4C1}HUnQCAsyQ{DYR;{w4@-ytmHe7T+2>udYE&+ z{bBIKf`i>~8_%wiZ1Z&+QB#DCm#ozisvzR-5DJ}g6w4@8P1GR)`XqE9<{HS@Lg8=t zf&PN`D!$?(qf8oI0L0CfQ=4R`Hu=NSQAE5JnqoPLDSD9jx#&0Q35vVQ?eAu7pV;i>&gy|LaDvgk#uJ;g+ zvNr~hrxWc}h%4D;0@(n}epa^`F@w}10h~iCT9z?9{A;Ywd$|AMzu(Ia3@#SR%7XjV zy4jJQUB*p(cbrr{VRne)<KXe{}lq z_h`k3X%Iq2pg2xKsIdeh<@srr%QYw!%e>YUiH8t^Uj}DsD+wW4op3^pAqXSJzDdsF z)v7Xtl`#Z?-Z?gdRB|`?tOw!7yygrkVM6d=syKKsVFcLXHQQ~q{)osaU@RgQF*rY| zg_I;XfrdZxGDQ6i;WdZuTK?ubmcp4l$lnci1fn_iqUUIRLJ7unp}p=Hg;5WlC{nPk?aHi*t!{GY(y`*42C++s;?G5Z zvTVfKtHmBF!U)wAvwp)(_uBJH_|uNjy%<@;(;pieJuIRB!)ix(xJ3>`)ohhNa)zetR_8vqW2*HR0Nc$DJ^+`0CLd^0Jsbb{_Y7N zxUS%*JRp#rcKwy6z1m1{s@WD}Xhz@2{`DTd?2nqQ10}e%Ri9LY&iXcwFNb<1Coz1cygtmZg#`CMCD?MSvSU!m7=HZaoc$SepF_UWN zP}eL$(UInxtEu`cg4q`KttxOFcul&^KW<1QGNz@Dm;O-`(%S$&fYAIiMl3k3n|^=6 zyqM?~jlitUT>oO~m2RW3eR#YLH`7Q5>4)MSX~b@?|N5wU26A&CZg3JR@{sU=uhkCT69DUr@=V73I2np=OVZ?bCJ zis8pm-~i@iQ_K}(IHK`Gl|HUSfQP^5(B*9BHu90+m4$Z5TNR-8mAtS{_~qNuPeU>g zY&|^@?5`Mv+g%F%e~i6Tb71CVWWbW>&RJ*k44uCRQ^7<-79NGOrOK3; z6Qz)4cw(T(jF+}i>P{1$F}_D=x!-x7Slf{g*63dcgz=#HXmZy*?kh`elTjKdSQ{Wq z7$b!o5{XyIiiwY!lX_JdM5a!1WyF3*lX0RF_g;}j0mYmxQlblTgdXzTzj=V@g%&Ow zMfWCbYExQIqZ6{{HkUJ&<#MzFVqa-9)DTqaPqygTyhfHI&R?N&#pvXS3hrJqdH(3T znc56Xx~NkuU@+6-SzJX{3l46*eL{QEg?IXFzS@t2>Is{T)~okb3uENt)@oOou`Zc- zf|L=)4jYcqoFFrG9472apksN^BBK-8mQC?H$FC=||Q5+;PurOQ@#1&)p z$W8;T!Q|uu>mP_v?U#d18{xHIbnAxY1!p7rEBnwYbHv#a5MbJ-)8*PNu_u$7$kCb1 zPe#JsH(2yr3J7}57Y`+1*W+}B%AP-;;ovf{O;wN6Y+%lSeYaSrK4^g={LHF{RfYdnQ&>SXi7e z0Tn}Yg7>g)H#YwPU#2J~M>Ol#A1U;c@n3F<{gPrw;vghf_ctgNvi zGe-`w2fig;gu!rU=|1FyHm_Uk5}H4Ux|Q>&J8INpzzd0*DWOC}UO8fQEdy8$tZ8Xc zW#?pUO9P-D*q6YKL~RQx+(5;zY=fz$pIUcXw1a`jBT3|GtoO_?#FV|TD(uz3P-sk} z1a@>I&^NEV%`hFnT#Z>@_SLKA4i)-P?s1&?OZK<-(yi$*~uBqcse6@g) zl87l3hAtbsk4Fb`-AL>fxH?x-eMzgQQXgqt11!W`t3gNtteDzf;1yA z{LVoiGQzlFe0n!+Ckz(hLG39Yb${rQs+gy_mh-uvC)>f>{-QL!8hE3%*gR9DwDuZy zNWN6sx=Be|Ac>heTSCC~qNV*lr-+UN=y!J_V%-6Xz(vjN;$`o9jlO}Ze)d4~RK3uT zLPB8maE(2FdSzma`2@8cO&w;IJ^Il@!(}?Ma91t7ieP9gOr?LlF z=hyt2a5|T|`|@X_oN1xbC|bX61%jF$6tLm1`7P28+1i$^J7>I#%ttk923_8NTg6Kl z;kCExa8l@aNwaB_U=dw|=VZUmfc;>(*g>fw)>XU8DpFQ9Z$hs`e)m;jvvu{-de{^7 z;4g&UJx`_rAiXFS@aID)BQ_w;-LG%oCj-!8IEiDi*q2@j)Md24(l~k07(|^>I#cIY z=Ou&a9_n4Qx7%}}y(^ucu(UmxNzn^Ulj*ef`Go5clldw8$=`ADxXmYSfr7!iF=(I z(usAA5+&lCZGB8@b(_!stoD!oS^*lq*`ZuGI=iV4pY*P33R5w+*?mMkyaN$#M*u;m zsHy$bdHctsEuTo?zng=2zRj1=Uo!JP=C$-Zw&gB%w9JwB!1Hph+PUPKooV4(T3uZJ zG#lJOCWG{Rp3(aOY-2WJ{@01+e*&O0aWeg%?xwEa?xv05|D=Zy=0oijtoqw#3hiLe zfkga?YVo1mfs<0qBg2KMNKD+ca(lW?CSk-#+(bKc(M5oy_DznpdmjEVcf8pMv6Fs^ zv1j!C9GSYUf1X_(cdS?oNf}B>vD@)km#)dnRx)I^e7Ft4ho18+e{H2W=`uWhZK*;i zd>*aB3jMl;zdoO9umS0n2J{WQ|E5HAOzd=_J(#pC7-{{-h4zPM@c_K%F;uDpJF^A^R(tO7fhS5ZA8$@!VJABq3Ms>98j?@GaTEltY*~OG$N#^ zTg<;Ckzm9eC836C81==Z*Cjz4#5=2ZK?=cNbvQ2-YPqw;sN+5TK1lx-9wials~I43 zCkct6R%UqF>kJeXP3_liR9yPey|&`sjk@rv%#F=G!~pdrYvbYA!#5?gku`X=Tn4MssCDg#eiD=0uJSt5=F&!;glPKLsQ`tvqQA8cQ#GW*~2w79!E!OA};<~Hf zVs7QcsHtLL2}8;LMEgp9OYf$TraZQkntsKA5tMS)A+8}xpOdC!2K=G83-mZ5$+CRNO!(gNg}R;I=7i~Z6y!i9fs#SikYr`#UAg6~ zvLI+(V|j}TCJRaQ4VvW3Rh%|dFZmz2m3{DH-Y*6R58Tf{H8drK4izz;rEmh6Jt2wU zHMPy}wmHq_vtL}ER4c^=U|(CKWxwceoEFN0(EZ4gH!W!aGDcVb5=PZ` z)0=$D_d8S_<6)FT0+~iLq2fgDDrhOks(wx$o%VbhvX+R(U2!%GDwz2YldID-3qU5> z7Fn2>ji7KyX_8=3GvQK{RMQpBgz|JCN}MQ$OXh=wq<=>vDDPz(`yROXCcpk_C4`M?N(kv=LeEp7bL<4Jo z<-4p1x(2Jc@bIr;z#DJ-V0`<*T&`#L_V?i(B1{MOvclBIOyldPi7KYr4Rlf&kR`N_ zV4ji!wV$Ux2Q)PN6(tG)U7D4;Z!)((0AK9m$ZEbR4MrACd-H>GAI_)8tzANE6jD1Q zb2%FmkIG$dQnOGnosfad*(5Cr)~QW8sW}^y6zQ}%;d@z@fq$u`nR1(oQ@0jXJ|`7{ zMu7R|3;IL=q>}Bq4A*shJzJm6go1#KZ=HRz&{Rai4FPm2HnR4hOq;hCMF+=I$0dUR z5tJgW{BaHISBIW+8(SS@q8sFbnLrjua*vB>ar}{Duby}ru~*2nE?|mzeMU6PM_g(r z#J2@EFDf?^IEzwRmvFDhNTzN!yD4Az2$%yYO?q0Bx-V~IsO#Nlbiln~7odm=+Ee}; zFE6x2BS%3?RI`EGJAzeuK7oqz?vt4PKOiyZq-%<%kb2EDdt>tP`r&q;D<4ElPy7`$ zt4TLKGfz<~29S5iqhDZ4=U$!4nH}CR%RRZeiPEdIyqy)C?EhP z&Zr7Hd|;UXUgza^CV5R5?#=1>k|x&9+doVr*{rlh!Xt*sdj-~PI9T}8P74t#5}7Jk zi>@8Y&X8s)5R`UWbs&?Bjuu1cC5M}~qYzo-+2+7Uov_+R6wa2BI5I%A`sq;(@gEY+-CP-C%A&Haofz9Cv^kpu7h)6_QuR$;b5u;qKI%x3%li$MI@Z ztA~GHsS!YD>=b$Dg@e%USyB&P1gAVAL`!h;`+JMj!iogCK&I8cL*~o$2sE5>sB~b- zpka!rP{E)LLx!X10T@0Wbd~(Yf@|%OcJ}A3vN^`4{~e zGw-QGnvSd)L2}zlK{j2%gYbeC#Zxy9D$pO6JQHBy*?7NNoCB{-rdu(z{Q~%lpyc4s|YXzl7J4<*0;lokt==mquee!JD%ko+!7-QuL&`Si0@*g*RlsplRRs$^W-(@oBu{Rg{NbN-m;Qj6VB;XtCrcVMN5j^Alk4V^wmB}gb zEXvRs*67U0dl3hnnG?sS7AzquPlMT1T1jdU5w2H%B&+xF87qxW}!T}OkS0qiWGx)WkGMg|BlTpf&3%ylAlAN z3=WYk@rzq_U8~XkP8N&Spc|i+UUO4MA+-0_WDVG1ky-4Y96(f^F&AEi`oL(w4yc_W zT#NvCLQ7+XI3Cr<+L0h4*PjLtF_D5r(;>6a>D!)Z4esP94Rxw3)Dr|x{=RkShtf3m zwQwP^Vq-L;^P|K)q!DrrOOx>VpA|iCxNnaH(~FkvbrB{Eqh#?U%*7AcFp&V2Cx)Ci z5+SC2eAi&AGX5<2`QAl2>|PzVJd9`NfQ{2 zSQ-8g3w-K7vc2^`vYp|+o(X}uGg3IGd82SOAEI{j(V`0;D;?9yKnhtRTV_4Krz;eF zEGe`;OR7Z#D2hbsaIek#ggaEzM?D@j#LqZc=`~jE$lKyNDfsg$HRz<^uE5lRfq0+6P+jHQciG6?yyE>j|vua6YWF+veVN=aVz1aqud#Z#X zI;;edGob?ZG5~^ID7wG&OqA1*2p*eC@xfe}0TTFgTyQOU1;}iuWHC#dAl$;eXa~JZ zO=#(@=NAer#EE-|!QRoBFbHunpyl_tFaq7(hz>NFs2nG1h|HqP4wM@+D# z|9tFY$tH+s=Dqq@BF3E#39P{r$254xV2}OWURV66wJBfK_i(Sz%|zkbAuAzT)&0inU z+6*cZG?a<>sYi(qLz6}1z|W+^3`EmmM*>kZLM{lK)k^k;^-7D%*X_p@t?o4@4Au8e ze6)(4Ia`T|DRI($|`8qM>2|2%~^tu(!j_1 z{%Oww7c^qKUJlZmS-=S-5yV_fQ<%j>2vcJsAS>`fAeq%PziVtZJ;Z*5+=4IN;$sDb zK43Jo4!y)g`S3@K4v?udwHQXmK(gFVM)t>#!)gjq=ct8ir7iT|-!+@s4kjxdQ&+l< zOK2iw0&`o2kQGLh@LBBaFMA~{Pq;$Lfkv>sYlFszr?cc1N;&f>9AjwY@o zE@Xo2R5Jybe5&_iWd#+*^!xBn7d+fPelytN`dcPZl(ZT!h|}QPZtu{ZgWe{$*-gcK zw4YDQd##{0P~~THew(nOkh6S|!t~)eM67?a)(tKmuIh~{AE~7jR1i<7Vjpay-72WX zIsgg+pPGj_~yj#LM7Uvo|%Y-HKF_{qLr2#}lr%{^+$ZrR_! z{|11cY9qb76s{SefRh1}xss6FIgW@B+~ApcwJ+43dx^VYC}>50b*hQs$9QN}q%x^+;h?{s9 z*?&>Y9R!Hd)0ZWb+22&${tR4kRJDNv7-m9n>ZG56VH7dD64?<>_QB{X@hOTmP+F)+ zVUfFMe0oK(swGXwbp`#!!nTNnNLyQKZ#UCX`%vC_%)hX=XE-L>PS&GtE0|c7G6it( zx{W*F6jF(-o(U6`?b)dqCrrRKcSaM^3<;!`FeCrRbV;8J6DsZCc^RWEFP4C}hpaJk zTl$5&h!})}txFe0(4-$i#@y*)Z}IW?Vlm9g<6mcAxw~^+S&PzCs*p5t;cz`&t>+nc z+4IeUCPXP+`SD^K6@Pu5X@Met-EqA}Hmkfkd#u;PeQ=k`bLjmdHeWf##B7u=<~c2p z>nv5Q)4S`%q6xWu-yE3PX0}eEnXNcR-IU_5_k=>x=<8EwzElC|o z_OsZNqp3kh4J_CM&7v#MwQLyLmd-#@yLo5ZBd zEU_NJsBSm^d0=euh=#-gsSYVM&A>79T0=(<}WO@?Sz>`@!M>Dk7^Kj4$3_5<{g3wdWfyf~42x5uYCxU=+G>-|nx z{gE^B6u61mGr97Ck*mtO@Lxa0tZLJ;POz=)G$wn5I-?uk8~tUG%i;!i+R5Sm?0QS0 zGl+91Z0{jTK>k=yaVwY^PR}Mvug3e z_ak;PaMoW5kVSyr-kfS@jE0-MY(Z|&+vzoDU49?Qf1D(DhT?4>R#tFx8ad#4r#Ly1 zPf`$Wq8$fG(EKg1jx;PS6};a8!NIQxwCEzyW$pKcH$aR{)1 z4lD`8gdo7U^bASq{aJm|&BUY5a4$Mz!J4aM`mxbVRt@%wgSYx<3Xv0pOT9$S%!eRo ze}mBe*>#JbRAXS<0?w1SkGs=fwH#=>pKWi%52oc0j^=dWZ4GdHjGN%c5<|Nj@^R)r zUaj|`eEwyU5-=sq4GRyhz(?B+V9vNIAsX;a>@9?e6GIP~OC!glPft$*M%*d@ z`&ytbS-7M5vgy#+3G}_iEktNeImWS5Yu7$Bxkx?>)A2a-H(>0oc`E|>a~F(y>({1k zgYM_o^LqSG{Wd|xWC;D{27QyZ)i~KP^5r5Y;s*cXYZj+EMR8m(&8{XzvTPqeQ)g!- zG_@jU=f^2;*W?;RI*R^w-u&k^(~at%D<_;*c?4(m=dQ0_O$LKzNkNl|Y2SFlhXF3M zQE>znS+EYxLG2zRH@e#-ms>^^{<*CVel-jIvVLmw&^e;rM80lb8B4HqNhwJfQ+Vl3 zy(BaA`yeB`7m7m7?G71xMQtStSNc;8C$qz{@CV<5s&hvkUIy#d=1o7?RHZ+1lvOrF zyY0uH^y@3z&io7W59My7fSkh>pJ|j^42?43etcUyyM(EKlcka&J^Six2lOElz#q^b zCGM-gL-cCCM$;1*t*ZIE>+;`}Tr@1-DRzCZo+;2K|NSfk~PGH3J0eIEMDs zKHc7Gh$DTq^B7+fQj7t2(t(W)&!az1p&_be9t$!GlMtNAub->c)%q@Y3MsVf-%--; zddXy+eB{FBs%;LlPTV~6K?^dsa=Pu*1`&DR()n(o#)Z(t%$hX8K{ixR#swKAo=%ma zt}7<6=#~2izBnXMG!)_orazh}Y^AE* zUQg4ByrOQ+@rg-%;mbex{m~ZzHy2_p*&Mc!EF*gwcAYWx#8G*4oZV%%i z-X%W~9Ho6a;9l}s8rO@0gKyC{GiLBA_KNMm-T?!d9Q%%BD<12+9@J~koa#w~N+cNg z9TjGa@mtI>Bv?c?jzBaftYHe>t_JQHGE0odlrdg+-a5sA5B-E)|3%FhBI^L64JcY$ zExrdYR=ohSo&$fep2B~CLiXK{RcFb)kxY~Ca$U%F8cIf&D@9GV(VJylv;Zssa6~(R zScZ=3#C}?=&Nb<bI z7(GS)J#TT(Dg{$Vx&-b9w}!ZRPysTcux_vo9K@u#z|~prmu5G5YIy9Vir@6CVgRSp z^kFI_4~p`8!H9PvF&8MqY>-q?{C@qH_Kc6q#-#zoDyD^ zi5QGiz>~e6X!r++qZ~JRKvC{sKHwztJTB`1$e_H;@_MiZ5^eldt~`4d?w9{j=~X27 zrz*!e+6-uTNU5NyxQNpH@y^gltuM33Si~6AVvThme+bD+Rb*g4AN$e8fcWfNzrZ>zz03?K)A zr=6fEFSV^}<;-=rkeEZ?-a?<3Suhukl`*;|gt%CmmIRVUfnYO&{~G*#<5sYeGm}|g zs*$UTex6nt+@rmPRVz`V&}&mR#YK*l(uRsC3zW#Klbd`qAkiUJo;s+^qm)nMn*0yr zoWv>AP!`UaU-KalZ?#yNUms~XK>2XnWW{wP^TF&$dK*y?ZU-Z3wNoPH>a+N#qmv4Z zJUPtknO&$5Zl4w!Usie3w^@!0%~15}9cW zU(pTYsx-E=e9ct-2qSj#c(p*LKZRL^qR`J^p`J<($=};5d0)M|xs2$Z?F&G<`^q6R z88=Zoy`(6HTqgtJnAQ}r&>v`C*iU*M4+9?UoRWXIx^&!GWF-7X0=B1Y4XeVKZc1ML zd2=!#wf4RRh@M}Pdw5-rT_d$?y6uv+HB5}9GhKv*g21^l1Aj*_L(2LMXm#8zjw4Qy zlXf3Yrt5i#ux>xFBv&GIDl||p!eyZae(PsLeO_8jlU-@d()YefjYy9@Qtpp+04234 z76@2lT&GAwQl$*NdJ3Zb3oa5Jn>6Him6`EKI9kunX%!Ggs&<{0%NTKR zkGj74+^nSm0E1Z4eO7Wn-lsm+V&0<&xE0i6FW=24nOCPPAB=Af8v<%%<$s(qyKrSq z?q0#;5E3gy6&j`EjA28K93u0OZyC*zmO2wY(N+V7uiz^Q+3v%TF9k!d)|sT_&BjdG zj-M9aAas|52@A%J)@=Z(5?XBb8QvDbv`y+tEG)E_7;s;EU;7I{JRS9sC&A7cl;Pwh zq-KIN&9@*>NIdM2a%_>AL$T=%+K|` zW91-zH3=Cs0Mn+(vP^L-2Ho~pndrikyDv?zO;b2(Bm0yDNK6drLas@>ya$P#iG2qC zrx;kFW>TdC;3&pG&z#UNoQc1D?muQsN%@vRn^#w;h2~0vckWW53AQzOk<131DNw z#z1y;zm3SuWsskfc}tE|XS&>YxvD(pQCoh->)rd9rf|3(MRJ{+{fF!$%>Nih3cs!y9MpNKcNUMf<{{KGCk#D-*s?!1_f-) zb6@-^#rMC$mN>M`{THUb@*q1qvs!t4BLT|5I!0e3;R^4@=72Ytf1ffeZ(+-|ISirU zByyuljOf0(r;*!YikOev{GaPZ2)y+v3*mBi{gYiZ^`HCwJl;)@3lqu+ zRFbA)H>^5Y;L6VzX_W{M7ynDGJ}}Eb?x3TF$7@;;s29Xtyu(1yv;sWlVKracS}B3ip!sR-2j2`+U1o^Z8NkxJBm7 zsYjg5Fq9^I8Ysm3wtM?DCQiCdQI|*MvScFTgc@5Q`jA?1v{nR)5yncAK=|jaU3x6x zHRAAbD)PrcZY6{6E)yN+5*~U%AUV&1)95HUQWstcbLwjJ2^Fun(nF5t(xl3#u+estng)k?2h;> zOLm|v{4Xzkn#A|vLlt>;h-{Z6q8p$1^vV>U1|NN&-R4<_5vY6;-|vM_QyHc6zs^hl z6P%feg_-mJ`t<+5^?9Mjp!OXdZ}EohT)ukl@AljbpQYKfaxtYVA` z%9xH~Fa36mtMZ*6iutZogVZ91!u80SM5i`jQOgLY$<%irC?eXB zyyg-Omqy)G&R>oH>BQ++S{2MSX5)T2k`dF(rgF zQj{MK+kY(VS0f~%) zyx06Q2`AX$rSc>*(ONROCY~wg+P*W?T`KR#GG!FQe2l4-{T(@;e;2X>@AtXMzccuS{uT` zU@p-Jm=LN8DG8?OA^gQ*I{<_Q>;Q>wdpZCZ>*Vkd`bdk~&mD*%sh3bg@!@@(`CQc?h6E;*&uS01ww%vz1evj1L9n60#`+ z3FF;xs0R*RK9m)&k-E=@F`JR4&ZOW$2de)dqcWshqE`5DH$VLrUMo(0;w@1GhEWFk zY=7|2CE5QO6Dw(wZ!~ucwLzW+(STO=Z{RsyyOaxxgV3WsC^G~~-Q9@5?S3dizDCi%{Qf!mf%hRY7h}saS)q2ocRL#kaJG~HKCHDJuer;cUQjTWSxUQ#m$De_{xWY^Uieq$IGeuN+Rc5I%+#A4omP9a^XeC=+UJ_xOU zCrEVn)zWXXdTZ2J4?pA8@WhvVqPrOm8pns0e0wA}I9Tmzwp|M+Wcbvq?ia1Ar5%9f!d*|uA2xlP%< z=kl5$BHG?6eh32HL#H?ZO88D+B#1$01_H6RcMJxk*O$9!RO`Hm;QI;d98M53x$&N$ zNbn)&(VYr0HTa;Q#3G1oMol&_?7-#~CJvtQX!_pNm6BiZBZWw5U-M|{xI>O2*fsDU zr_Io}4&AJS*4V4eTO4)sloJLH=~DH`UsAFxN?f|6bmSb(!QTcgQeT#)koM1lq$MgM8-GDqenV zq2=tOZ1Ssmo>6iPAco|0K>malm#rO$Pn5F6NQ?OLHVTX`ksk8B`!ID)K&iBA9|^}F z+w=hLG3Z=ls4qgu`8b|s4-{j8;k<+q0oZUFQTWUG4<6U6x()iDz)xCFbM1Z%-6JMR zMp4@9g|8wnWNhv@Q?15d{A03I>eAezrA)ku#qZPb7I;dGHUQ@+5%IHF83a|CNLq3e z%-316NU@+HuM#6SL(KFg|C3}YJd1{5!ld9K-){q@7kPD>?7ye@M&6%>74jN5=PR9y zQGcV)Xv;j3xMmSFbY|l!pzaQvo4ZW1);i>L7<14Z6VR^g99Ax*yLA1=O@ZUWsV=_{ z@7l)wwDdD(-B&{JZR#&17-G{m@BYyO*HXOc6rtTf7l2#qAa+NkBj*6=gVWS0+F3e( zn|0nb%-{j*FfvefxD;g132=XF05#stAoV|?nk;jkeJw43dr4QkE`m3oJOrWy_b|1f zW6@~u_3LkKK*I|6>BZXMZ)3hxyEW{*XP>yj4m=w<;I;%ft=Zl(|I2`HrqBhtTS#mn z%>e;HjK87X@Oj3HTIYw`#ynFY&boeU zyyqTcKOagtAD8XptcR#F{FXKZqK}WftM>cP=C7FnJ~klT;t;@J_cEGf#}U3Snp6GT zt2!MGqjGC#M>o$)YGR2lt5$JC%~P9AjJr*}F9FF(P$8LRB5=we@WzBr7QKuT`%GOl zD{;cZ-jLriE*1YpC2z`%iZyXr7;d&NSBse3&r{KMUcc^bN{R7e1jHZPCLzF$gEC%! z5#kSjOnwrs^3?WJU5CVaA?&)!XSRO7b$auBOS$}Iyh`KnTyF*!7s-r;hL_|=O0E0c z>R1KJaLn(lTQC_YLNRz!1vB}=IOkyG;Q&HjGZWxGeic)Cuszce%3~oNWzrK5MUw_ zYUhZgFS=%Oe7@Rp^ZVVC$-FEau9kLS%EkhAcRc-`T&PWsr4O_1%L9)bU;k-u?6`iT zZ_a=5+B!)Cew%`aAI%%_j*=Q-#-7Io@`&6P7^f-N+hYOIii#tUy>@ZYgwqzTL0_*O=hCO(zEo^pkj_TkA;A?R@UjP&az2o za^vSS52^&Se9n^^qvd^R51|@zBy}>*`f0Gjb_#uRU@oX`<+Bf7Hdl8!A6)Ds@2M9s z(z?(8%2Wz$8=}5XuyJtohUu*M-08GZo+-@;d#9YmE8U^QRDKnU-KCl_k(@w)pM8>(39$`uC%sLv=&WR7&<%G zVDIDkFary86oHtRLfXpnZ~6){q2Yl~-g8BFx?^u0ThMryT`wfLq|_25=r0EK~pid>;yK6I7yZROa5v($DKEi_DgTuFUiRiZa!SBza<%)2e~9 zVocJ(`5BAnn~71@*%+sb+_(rQY^4|waa>EmH5Qwj@KBHeni<#K$!Vv%;W318U`awV z)PmyJBXr}YaWCn`npe5ZjvS!Hf%B{280Jon#$9DJ=Pk#V}Hf3#)Z`e7D?3FjT)t9ukJKQ?~{J|W4|CIp1PhI5%!}%adxIb0Tw`N@qKL)8MXzlC zJP6NU+gUJ>1|YfI&vj5P0YCuOMs?GLd2<+T&mNBPHJ3rs!hcRiIR3In76mI|o=gQ3c zxRt9=bBcQnsMpRfjG5`##GvO|USS^`CeQ}IfI)tMcg#9z2FS6z5xA~}&}#6C)DxfU zdIe>7;5xfSnv`Wz3t%GEeO$CLQnVX{HXSPb^f6C_cE!>3@-U3k-lRZ{KH5C(^Rlie|N3YEk>fTDL_I=R3^=TaDmF|ha78Rf# ze(36>FHE3H#QTFu6QBHE@s9iU_M39xT>h%Rc^xHzO0;EgOAh8SpRNVt;kZmOVJ+i!T}-F?Cn)dKb z$${&o)gam6ljx?%ZhfklD7#F&&;J_w#J_eHFH-{zFq41pm5jrN%dcL$K$;7i0no1H zx$I(@DDAOxcs2AkYD45|%uyZ{x2JW|ICH`DTf2h`9E3-XalJhwym5n3>VP&#?++i7 zw>}gx+u8H>O@`=wQ$7@Mipd(&a7of2l|TqmN`DF!*md}USD^^sAahEHxBq_Olpb)I zut`M7=XA6baEn;NL)I2i=*46uW%27Ma_q)3Wr?ngNZCq7ckc6HSz@y1cZx9MzA(U z7eluY4j!@IGbaN@w&yZP35(Erh9k8nBU2jqr#%ESs}{k~JdkUsx`Tp4q-Xymd#l9( z5n9o51Z)>N*ugW1F&F2r+!p5~)lh(+H7yJ}+DTPTK&DR%9$Oqw8KV%Jj1Su^&r+a` z#lLiUeQHV=PE-5G8kIj@B7i7H99nTzrCTmwfo~)ZGEHzR*SQ zEwyN?IWqHS)&bMKVX08vHyYYZ`)lr#p>OrG6Jypf;ULYdqR8;FyQjCrB88yLDgG(do+Pte-WYF@$`f5%ue860l|^UvKHa>#tclK z;&jpw2RkZi!SvVlWI|=_8>}*`uiqK01(?1+Cwp{hw>>DoUOeC!`xEcxFdOV?pI(-( z$6iS&nzlso5uw5#Bp?(XZ8dQWRXF5hzFXj6XC`f38tM|Ww%UCT}G&o1~B zgihZ!v+{KKouYZyyk9BeU7x>CeASfM9Vl~bi04pV%v!sY5d^VOA67{<)Z~ll;y@2F zUEjAMtl-O2jiK!x+QDb~eI5D1Wz{_VH$~0#Kk{}N{*R*mEiy^mU_D#5>xs=Q7>Duvr0p6I+O52>B`Ur(x!X6Jt^nCcfl@fI-YU%0zSqX6vjR+XH zaQ~>e@qKsbIQZ=`ak5AM@qTIOc=ht)YJ&YOtGC(u)7J50-tt>u@^z%ls-Cg{m9IBszl7 zISM|lCD8!&1FdcL*h->k`Q!e9KrD`lDE%t-enKwBNW^m>EYDaEmgmOoVV0FlkOT`& z>R_TMLXw(`3Y&Ds|5ATLe?nC@;NA3|QQC?`(+d{8`D2>ga#Ju~P?-DKe1E8Ubf@4U zJF4T=vn7%Kr8=Z0k0MN0f$)hqI?QVR$I*|b<2poW-tIVF$(ET(8gVKxA8%s2s`}bH zX&3@pHVISRuQX%a)61js$0|C+fi|+zw!Pc>St}iUYK8+_rcnN(iUU=ELo%9ck6iZ$(3e(Ok?1+|>7WUZv#FKVoq zz&+qG^t>+|wSW#|E*R2t9Ww6y$A~qT4oeE6>r>9L}EloJe0Mmrq>v1^vVDq;)x3 zYrJHH>vV^1UZi?DWTyCPOJv295R<>k!0C7N%2ErA^QHAR#kdvyQ&`dC4_R;wJZaQ7 zeT7`TtYl-9O#$VeRdp{sORS>Q1CXCu%~g1hz8k`zHfJT{+K6VnM*gXqjZK5_Eho~4 zH?_qUx_(YdRzxO!%U4KtTYtlE{RiC(4@tfU^d536K<)UFszHYVECQR-rj9pm7s~nf zqo%SaY6z4vEEuEZfs`{k?y9gOEVj=vZjAv#2?z^FH7ra9>RDh{8-tkf z0Kg-#tpAf+E@GP;z$tGK)_c8AW9L9O2A*#!z2Lu-aI&WJTpb;M!l{t={{JxcPF;dP z%hqMuwr$(CZQHhO+qNogJ1cG5w*A%Z9;3T&kMnT;!hYH-BG#N*<@(s+mB&V)0x3q! z34;8ZIt-*y3yc6dqzmrL_kmls#Wxl(M~Ya_qZf~h9T%O9YkHcd^LrWYZi-V!kw|DM z7&0MSe`3q1Go-B}V9o#!Xc55T$6>W)HJKQ?GnQQ>uwldUKUY|lOl|*Z-a2eKI0|yhE=LyYA-MkF&3*dW_!Nb*Lh%i)g*)vUvnW`l17PX{I;HmXHU9wQ^KEy| z!1ao6$1B}MGrDv2b@iB0K&BKleF%SmMCD-pt_#P5nhq=vDtQ^B04Vo(Py*~(*}4{4 zfL-IQnBo;~^_&asx9V14HAAzL#U=a=UJ4M4LifO{;o{j@p6nuj=LiEgumNiou0DO%@ok0U z!}WW+i1|z(PS92I5N92{Ko5AG%agCOn-ZpTdK=Xws>mRr!oRZ}yzdM#FSHa;X*yD> zDANa^*wgM{dz3@9*kl+nqMNUbQb_C_&e9sU#4{SdJ3-iv+Es#DDYi+vckEdK-80e} zU>;`Q)Z!?g0UdYd6CIC#?&#C#W8xFVl1aQd7$@s(tqxz<^yp(6w~BZOLMfDzfGUWf ze5wIp7d8%4SKKxxsZ6&3YXS)v+19NA1w;)2I;I02Cq-UAMIc*^g&0=CV8<<@g#{JI zjrroda43Oz$BZR=D8yu8vm+J(oXf!4Z@fWf8akG>pbwV}jM2r#2hUlnkv&4E`t?fo;mygJk7VgU&z z>!OPPR3C7Fz#e?rVeksdTua62hu{PhMiSV!$94k!!zb zkTKB3$J>hQff&4TsgmoE*vrP}9{-&DIgl2*l@97LL~7Jc^(}wB?(eRjKXYwh>TX;Q z&1Woak_Ufek<#$&N$7Kp*H62~vTbCzO>qpx8W0$h6Gl&VP&g?i$5v>nG~$}xG7QEv zg)s$T03>|%8Lv%!h1tS-mj-mmWR z9rRb>kgW5k;ZqCCFuQIYJP=D|mb-2rA>jpg_p=j(yx=tqpKDbBTHDhyg#?|Ku zssLVfKYj80LhvKJtNW@ae!{iQ+qe{PZ`*;LUPsK{E}a@5I=o7)A8z=E0-=FZ-b)%# zN7c92=n;&OZZAaEwd+eH z)IGk_#W$dhe{<@DVv#7LtR!SYaoGJ6QYh^m$1;>6eSbtp`LRx}t1rQT@&}mS4f2Vg zR8dj_Ol>$GQfBd9m92q^+#W#zs`kCads64 zPgi*6M1QtLIXa6$=WmuJh@K42;e^9+%=DC`iz6Ld{gZKetz^F#-?O{$YE!_#G=Ln@Fu$AqR|1}BK+*fDDf`Z|Dy z3dtaE^LZyJPz+8v?Az zu)gktWFt$X5j3X|?>&k1ynVhUaeO~X;B@_w#C?WnCmE`vqqt6|%{R60?Q}PBH%Ljf z+Bi}_oj)?R@ zmbe$6)X*>j2SkdTX_7^S^Ehs4=Hgesy;CWuH~5HvFI3u^oVMC-ReZl6wZ8X#tnD_Z z7Zu>AmP0WC_WxbU|5Xl|IBpLd460&v3}!x<`-;cX-~iUJAR@<}1B!>1?KIVGKS1Vt zwOv&0)Bl>6?iwgT#wuv%Cm5+#K`2|C6END8ISp5KU|eYTrTyYrDeXHZ8u&?z3&CN^ zNxDQAldK(a@zCqn%s`j< z_3c0qM)h5F_14MNUEbpVbRyl2Ein+p_zOszZXdqtPjarqrpHKdv?Bfw27bSlYia*Z z2uu%YU@9tw)b%tA4@99GL+=8`mPc=5nJn*Cf3wz?w;vx<^J&PE_TPQ9w3^CIW&m(F zxzF0Q@)hOsumIg zFHIPn&QL~?RAd#!zR^>{CKRBrme|n!7%S3>8L`+4bl z5tCj*I+b44&MsN;2P{3Qp$e$$g7+=yKMsAp2wF}gHJ_<1$4A3PezM~rjH1D`lams` z8jP=!Y8J%3n5s^b~TM~;smgqFkWL=b%eiRz4PW{eX7c9!7~X5@ts``?9< zC<|MF`B*NS7d?K034t{|3ocI2vW9>)D?-if7 ztFm_t(|MnBAH>3Eys9S4PEwDe#rC(xNFza0fU9&R^L^Vn9^b#mr*X@V?jnxsQeY zBAB{}$9R6O-1tP^^j&_PHkKS|6=GQE3qF-XYgrtA2OtmkI-O;+RoYOfBzmmNK6SoB z^Uu)_>dP$om90v(C?gNL+NG*gJC2iW-U)?Rcmm>rrC$zMn?hTL6wIQFc8+fwbl*|m zpRPTRUq;wQmAjoOFY|rb#j94v=jY)Zy9;-sjId^y$k6x!Yu;}!9hu5^x3rd$Yt8~> zr{rya5?>B2&(KKJOR5#r5OF$nQ!g&nZubhpAjzZjW}!6laG$HxBq_fwIOXtMbzywH z7DeDK80sJZ>bvao50?k6c;xgXrUF&Ge_5x#*LN(nX3tubI)$uwoBO?s=9!0gtth4o zusZ_tqUEF*G-gke0q<9jceS61)$JeA7zygq2IU<(t5EAyvX9#E2ZkgZfU=@tHa5iS zw`ii!s|bZu+F;z|&&~d>x7?6b<06fS1t_!ZfjHj+|6n5C|3ke=D{?jvnpe-DI1~Ci0+I-S!O>e|ff*YtHM)Xn>&-+#}dfhq;g>fou2WN|_qc2g7VhP7o-@V$Yp{ts_aZNQ z3F4vi3z(nH7#YMO`%7nO!_3|aKigd{JZN%4B*?v?2PGp?*?%zS7)Sc<5ydlV!4Cog z$kI%m?F`;Yi3H%|tNBGChb+x;&=|CG6P2JCsj?#nPq|9H58(r4L7h!Bap|fs1_>4V z1-M>OF=$N&D8Uu1A%EYwy>nP?f)>D+nNFOq?8~$48{wyKB*pN3t^+QZZvV73tBN>rV)i(m6pFrvkltO~46eKshnk?l-4_V8?t%$!{x<%L^km4dC z?{LucOh+;(9Oe3fapu*RIr!EO$mejkFw*LGOve7yGv!+nHr4 z*-3MC;FXVK5*pJ>+G8=l4dPxui4@BM!n-bfodf%3&XWHiVY3POuq4Q!Wg)Cnk*(KE z2^h4pC6bc7tv#R$yE^nTai6aPlAc^@gN3cvg&&pv;N(icg|8tj-k|HL01K+P!Kd&^ z($=>u?Q-o11gGnE{6FpBoGtaO=n^$Bwjo<$A5FtFUpqizo9P5FN6G?}r#FB&$~fiUlQK)T|vm@BWVdU$(SS?}7vB9sB?K}d1>XOV@} zToFO+Afc*CW;nycZTCqyj37CBIVv+1=e>-%kA0tsFf9S)@5c!_cXjIAM0Pvu^?5`hjo9vi`ZFL#MH7eMzz(YJg#ykv@O>~-LLJ0+|Sp^>hju^O`2wP>;`EGBIu zhy1t}DD+W7Pl9%k^V&V*ckX~6wvjD1I}nKjs`c?jV^MAy5Mra;+rXd^!yRhN(O=>8mt*t z&qw^2GJ1ey1__bpgD8{E(6Aw1b@{2++mZ!p&h$eTic^eMs-_9F2X;DfaXt{r`i6;n)+rthjTJ*KOlMe*aa(R36S#ea)C2M zCak3ZoT&?*c&b?i&;_Fz;|EX`Upz&+_=5~exYi3NdQc}8az1l5jkwS=9IFki#Tz!x z_g~1FU{V%FDH?JtRs5-*J5;?lAC318lxdhYSiAAsv6}WRj-f+rPi zWh-DgMO$AndzTfi(cQdu>-Mmf$W zq?%2SLwW{D&p!VdH_Nzn=f41o;#fqE|gx}R*{IwuG27|`3oya#SE0rcWM_E|TRM@Z4gn1Z%; z(M3akPqCca^*7FbCdwPf@irK>P0VYl)s~3$u*Sv?PTrs8ARPClZfgDsvTHb*u;O}vO^Qv^z7V0i9Ex$~5OZT3~`LNsYH?NR%6b+b|qlPI& z$4O;q!-)S)&ov_BS-GL~l-FNUJksK>(*R<2#X`g2O@?EKq5 zt|J`8TF!4c`2O$TUG{b>Igdp*tv4r^xBf2d`p@CQyZb#9y|!b;-XEtwX46$h&Ri_p zu!|!m-rom*B*yf@6;}omqM*1}mSB{%;b&{};n|hYo`06!ZcRUWmPG!n5b&kGEXKX5 zJz_!)X5|0Xo##LDDvEL_^eKkt*vYtr8fKOGFcW6Zdr{ux4Jsj}#|!%ja4*Vm)3mIP zl92o!gN0L)r>)U3!x@iIDx{RK0k3e*ZA?<(nz|{(hwHe(Ag_U>PW?w6%+yGy7wN?G~QNF(`!?(e=oS} z(CwPN&_JRU#^&Z}Q^vuvZ@m#ifuBa6Sb}*=7EJDhjtwWPW}Bea0QXvE(-38Wg%*4` zsg)`MmC-_`i*0(@o+}oRkAArxo6csVNCUf;@5vuma6b&rCZuQUdF(6P&FAG{mz7F3 z^&0^-kSL@No60654uafua{i~~lF!~&#U^66CKS1^wJbt&?tvDasOJFSn)43!XS0oc zOzAw^H;jyG1@<25nv1B7fXM1u8ZLE`uF_Mj1<0w~^DEnS>$9!3a6@e7h@Q;R2ZBOV z2kpZnSFo`)?{bB%U*Df?tY8PI>|lfmXEebn&f5xVD{jm2>a%a1vAwyuQsHy9zk%At z&5u-;B041cCXcoj8I#=JCdrzaic>zLm3VFS<$;wO&rI}`93H86vebC7&(yU~Z62r2 zuog}+L5JcqQJfbigLJzt(t@Qfr;flBhrq@_Qf1_PYn!DVwLZ+s1Pc0RkKOHbtCiGw zf_7N|C=k5+@Vj~~hvX5LXrRbJ62ZzH1-4CGhcmuM@cV4Y1|+Jds!^teQe;$`=ts@T zdSU2*SA&Z~E*MFoK{)`(9|x+Q4_$T`5Q2c{YSJ()H?wv8r((YhD}fo{W*=TD1o=7t zQ^yiHMq{;zFeDq}*ujW&Wy7t}Lf1c6gk&)7fy9=cm}v=dZ}_APKFJlM?hXD)tq(7z z1LRupRLWTg`uCx(cM@1#RAo2^^lU*yO>oD?BtRR>{0It`s;GdY1 zrfas(#WlbBCE!0er2N(1D?MOlCBRW9-sNj0T36f5GywR9CwhkrdVfK}`@_UuYuwOp zwS+ja9qJays_OG|;o8Og=D}VE2QivApUVgQ7j{!q;-`wr_Ku3CX}Mj&Q` z8!~l!9f8bIOjTogK2N&5a4un?I)xeK8B#5Mn33mcZ{m+|-;qL0#5NHoWI_q7>g;6i z>F%qe_aG6Jz;Y+72OeXI*YuY^(Ios=S6%{TLMn<7@EJK2e3e1*G<}cu*ieV<`Yy*} zi{*Z%cjXV)yzb1f0^}mrl{CW!L>O4-E|9hW3{McHS9m6kA|f=5fB`|%-^Oasb!Oe& zH#f`(KVRmp9Gr~fU(UfLc99JEoOe0iO&Hn6yei7gey{vyyGNCX-)diCFX`9=Sw-@t zR4W;|lU^b+?^8f|ge@@NWRCuzEAlg?)}pcR)v+Aq*YONiqI1Ba-aI?$$FUy zJm&4ERdObaq;J`L3^m+nU1kUnZ;b1<)pG6qvr%6TJ)WHDd06Nu7ei*OO?i3cH}GC# zP2Fw9XC}3%G6`JijAzJ*>>y~^T}q?F9;h^BMu5*vI-FzbB2jYb+Ylea}B82nd-u!ViIq#!@jF#2EPIZ(>7J|Ub*Dd#D z(;~Kx?*`jaw933=V!cGY`e$}dn}#N&Md3lpr>&B3nPywn%z|s}=%rH70jPi7^+3m4 zF%PS(hfB@Cr195ruTS1VN42x3BEaR>_M404?{N%stHEz_E)m!vTK?&qWxTd71Ok*Q ze_BZJownQMfNF4ema3A>S8@dwmVx0}gf~$>UYaRN!P>g} zUh}~G^W5KZ-aW#YA5w~@zI)q{l`$C#8fkImgicK)!fnb^CTUiSf=Zd7WLs5IWsxi* za=Dd&IzPXGwmcMpa5Z>9Hz8GmWH_~n4ZzUMR!G&%*36Ov=$22*rb^Jjz*q;A)dkye zU5nq8Xg$3j&f=`EhXb%D1)14EKP721jqsojBmdsb%DZMyE*=yMf;m zYurJIf#CbiC?%mR`4?I@6VGIqWk_Wc1AWYKHV`j9VwO~U&|EuL-I3HEA41xB`_;cG z@6R9eE-r463r+-lTs7ZpA$0m3qjAjV`(*h)==U8!d#CDvS>NzY#eJ}a9Vo*ToZ@GN zJ02Sg`DKTeoj{XM&w~e=qospHAb&EBJ`ok`jdE;6=T~GdY8a^kVDkWN$Z!pqRq0}_ z6rV5LfFsiEVhsAEanOKdXyWYiyFLIG1O}CaZiS%@vbSw30<^}alV-0c>b8-5@>*7r z26H@m7^bL<68Tgu9wSW+@8TIqp>C>E1zspXLfTrJy39QIS+FJgeMJGPVZk6CjDkM%%CZ`wxmTjhYYuzIZ-s1Cj_e9$AzROr0 zrK?#PxdPRh14u?xtiu3N^E|KKlMWPWkm?oD$CjN<{(=QWt-tB+%DXx`nxxXog3(zU z_3zOAZX^1Q};`5IOEnCpbk0aN}* zovk$Zn7-QN%K%RkAM_Al0)Mk}!wNLUCu2)D!9Y+{3W)G<+=BVC-c#1Wcudy0CM6jO zDRT|9h)|m>4yk|$x1sO1e3LDwQ5oc5K*F>Nhix)Jj1G)M6f*x^lQ#yF1At`#CIxOy z&LnhH9M#2W>V2MwpdUfQrWuy{Vk%y=y>(FZ`7~b3f|#zrKybB)$3D0d5v>fi!xXc6 zYZWKY5LIwGLQ9LyZ(wb&w2l6py>w3!yXCdWL~9i0Hk2eoZgY{+l7s_$E2zKTL@Cet zfS08Ho@Mg!N&?A0Ry)smpBe%tv5=)s{fDE4f)_rdTwX@lz>5Ws>ug~#t9uUnv|$*h z$70_iH-cx;GoC^k8r?&;VnAYV*Kh~^`5j=L^!h}LWIf{g{uqN?o3HuSt9wDZaV$1I ze+`Vl$#^*m)|M3(&#ag)!MPt?RN03k@7iYbV@OdtO~i9667b^f!w{T@3X#@uVh_S@ zOmMUj?6El%wjUAJV{H20OT_K1xQy!x7pxINPe0K8J+a+{b`GZbLY9SNlq0RIGn}9v zf{>WZe2-LPfoy}OQvLhPxX(1KJm6I+pJ9oh@0Ly;PWaV|3()bY(K{31cp%}wE z@0Jd*DL9xtTr#PqO+p%-9b34{qEUHl2biJoYZF3Gpv&mYx!vmN8~K{j9$4PUp-gt> z?t9#cbY(oL)BFZLdT5__b%E>FW}!BI7bFXQGL=ok2U$^QVy2ecGCx@Y%7KA_#zDsD zOOt>D(a3A{yTPaBYypT#6VSC4R_?i2DmtpQy;!=LB6(B;GCd&)tDYok68F$=N&Hd&c1IJM0f#KxEU&NrNa}!nN(dey*xm<^uq7G+bB+zf| zTMMk$(WC=F0I)%ox8G^oeBpVG<(F+i6YysH8E_gnck`KB+Kfgr= zAptnk3fl-uXsn67BmeEGTzhm;6mg=t;o6ZZ2SEKqzn9#!Wg}^~MVp(y3Jm|d5C02F zguv4LpW-Ou$AZ@N zZ7G{d@g(mB|9mPvlX2M&-b_%mMT|+75$SuCWlqvRd^KxPgZ!;bI6r4r?mFLxcF)W1 zJ|h&Amg8#f@YH7NG6_l>%iBNc2b<*=o(|hy#32;zKc8O2r8GaT7N5NrdaHdq-`=GA zW@el)G3*Rh8TLOH+?=>>$(^<)k~GP^kM$>I9=>|^?Q}Zb(z3ToVP~j?DepJ1k-jI; zD+JBy^2$5sWhllMQ_2n6+}N1as`n|k3HjFe%Ra8YSv(V?U)84ivBqX(-}BU zM=JSM!-uRh&W(9_LdV^&@7LH0TktyL5e?|0oC9Qa7-!^*AtsR7j+#=q~kI(q9I5#NT~vYCO9gDmQW zI0o|@)zU&5mWpqN&I}e9wmss={Np@MMu)rn?|6Sa|Iq-6l+w+f9Y<&bgwp`vq+?90 ziJKvaq&Zu0)c9+9;T>{gr~Z&^QNUAAH0Kvg*a{$zBT4i@Oxja%#5vfsM}NHeROtF! zPJ$*oazrWhSTjAZnEX(L0+CZMDmFs9YcLQ`RibLM5p&=hV#O3|rqunS_S{=x1fik4ZT5;qq6wA5XRa;27;zQ@50; z6mtrLZQ0#+2a52$O)KS>?Lk2z(64P?gGD@aJPXeiAEPu`q>%Z!<<6qkWqOXIua`{H z5~l?>_2a>qXO=(dU(}BM`9EuOWxCYCz0+OKdptcKtCRwy4d+8 z=7Y-W;RG`o)!*u}dz7acH_>cC7p=J>uI73>Hx&X3 z)5&Ld)@Ad0N!%P6*s~QvLJDjT3(%7mrU&vFmhZMWBJO`;Hm<+f6Ub3KkAs=86{5HI zpEHQ)EF-G>dQZ)QVcHFUXQI>25e*Gv_epnk56p=Pa_!~c#BwePuaK>fEj^Mhb-|Z^ znEp{w#MNmE1BJT{;0N&j)kgcqd077o-Z}tL56*up{#7?UO2B-d*?dj&c(gJ^eh<7;aGS2wx5H%XRbYn7qOZ2ZxnsPh+z zUPdbmUeAhf9}BqTb2J1R4n#A4`iq?K>J)|GbzkK0mC=E23Rah&F!u~v<2MBym$|?2 zx+~-J5L4Y7cm{1Gu7y(2fG0Ty6~3H+7eoH=^W^H~52;kPG(YgZVo^4g76?6jUe>gt zfYQQug$77)g_F%}{i8BFqhjC%xA;C^jpJW0pk#q;vCsy0-S30+M)>GQ=~C!kMolFZ zsX+#!6G3-vAME7}3fud9tYRcRUiZ9@?xoNEZ`pZ+JPPTrWM}I7%c#NZSo6H_=uuItI+A;4IalAG+9sV}5 zT72#5nb5MI=AqBL!M43Dk7Jz&SZ$A#8NYDp&2w2zw zKW@4Cxt`B6r;DHa4j+!V{mGwvIz>g>=ClK-;9pa$G#Fj$>f3(EVt;G;fi`iD-C)4e z8yUueyZlsaVXSLWz+hB>D$+s_*%7i)VM`bAo#h}hf!*je&%1K6K*%I8%c*IC^~f7@ z&X`2m{XyDaFdI;KqLd|31J%z>xg$VHtsqkAnIN>?U;*jfR>Etsn0o)%uHu4%-V{QQ!z5R z`~jj4oBe4K>}6KrHo$23s5HIz0YFp!tcmTR+SL{Z1cYsXD*?v6*M0CYs#4THVe42z z7K@wsKv93cuZ*K1E0M2-6lt)uk-EYw%v4rM>36f^^fv$!A}@(~XRqsK6lrAd+K{m7 zF%&ZT;}#uRFpOYbTNEq3uj?7t+B2jv4>Bu+Gzyv5W>PUQ?G(mIFRqG&B_Jja=CrvqFU=K6FlB;d|7vA*4 zNn1~ZG^L^X-$#gQS1^+(DqB1}bL9)r(kII06Yh#7`k-Et z=y*mCK`z-9$r+TiRUy5=Sdl5yykQDfGV~IgwgfW$3yjh?y$zmgK||MLOn@O(Zjx&y zULG$nQ0Ho+BH(*$JXEc&V!*Q&BT=zH(I~}iN7+phgyy)=DJbf*p?_weUcRGw$3_!}0#elyGKxZHas>Sr?>R1z`gC zS0~{U1^$QYvJjv@q$;bOG)q)G>f!kLTRso5kR*s0Rm^r-KYIw`|hZbuzFjCjrS zFqag1nJE5%>Jwbh-(K=}ih-H(k7=x@1K(XdIYnjSLhxzcI*#JdV%Jg{^jJ`(jNFEJ zFhC1j-Q|2PdoubAA!;a!uN|O1zHofs_pIS}#hZhy5%QY%jihqp z#L)CAnw;BGvp0t-xO2tq-Pw6q`9ip!U!Hx3I1uQ;z_@d&DbCS}wiz1noY2=&A(WY* zq|vz3*kkCXBxL2@A%Du(3p2Y0xUK5&vpkp=9Z%o8Pp$KVn9#n5Zm?as&Z;w7N^w-4 zX+LbmiMORxIv!Whhk?;Sa_KF`@$ANEU1KaPHd|>7r?1iVKo$eCBB?ya2nR!(|SW5&? zm-nclq}S1`kquv;{HBD@Z)dJ{#B7jy>L{GW$*;LgXJeC&&d-GUa-=a$ZKN{(p>6 zA0mJ&CO0JW8|NgIVEh=B{+Z#>t?d6Y!`0q+BJCF3lVxiRv zk1SZzh5GKq`3`p9q}U0G@xqm>)yF}h)8evAr&OdKqEu$4x{W`f-AW8$t$|eUMo8ps z@(W=rj&x+oq1UliL&=DLtE!8xRAY|(s%{;7(nN`6_}T*xa9X3|H>A2b6oFGCm8O03 zg1{5}wZc9a6{g$B9TXlX@cvbGZ`;sv`C%{JrQxs5xxjqz-|9v``OKPDw`N>7)mN3* zRLwy0=U`lV7+P$w6bjG-AYy|F1qYhWLOS`+B4E`8mUjj0+(npU3$dzN>+MOWY1hW; zJ>sFrc#f*%&NhAz9#mb!XMI)e&*)acp!-U@s~RFIzFb7A4Ca2)eMdPJs_l|SS8ZP* zN61kDr_}8tdbpQY>^$Y7N+%fa<)PUV8HYrii!od$_O-e&W4hUJ#ZR*>Odn6C$CP8Z zQAKYz6QTTX+KWLMS81O8%c|;wlN7}19v(9}rsN2Nki{w4Pw3k0Ai-Bt^<83fF|eS( zu6rM{V4&|bO{|u3M6f76vDh$O53gJd$WIR=IMw+lH$`&ff#k-Eu)zqZ-h$HSm-!4V zA1~#hO8Ssm-vE2~{qV0&ux(Hr?--!-jo)t>JQwPa`H zR&0-pV~N}dCGr~Ly$jS26J_{RMn9ZNZ(*=N1|;ZMvNc-*v3r(mDNGcp8=GRu;7>I=8qXFQYAj9InR!Z_{)yC1bB2oiSBgQ$%PZna`Pi@b4b-iZn!B~Hi7+OF&?ST?J!1-Fn4rt) z2}3~mkD`PfB?C73@fIidAi!TB_83}SOvAvRnsDVr7ZF+sDqD?wA_pw6C3V-GFoFV6 z1bde19X%7ZKwTs4M1&21po}6zEaM^$H?_<=pE$?RLq&X>s}EyIKQ4WanLrDXASo=Y zlYSN9$VSM8Z$N}lF`B1&aMYv>j;5AH639NGZyj|2_;4?|h{(DK$OWA|Ys56fv$b0IgZ!D8*J^_-T1oHN%Kd{~MjrF2e3 zBP4s)WXLysJ;@P17bI_gBAkUF8MvnHulL*Q_-IM8QX(VM1-6*u?L5;Tv z9Hg6=>yLGbkl8jlkqiRJ#g+pGt}mlk{@!cOb_*?<)+I3Y?V(}DF9`9{el> zGOasgBC*AvNZTbKqFTjMhcpz(!JsUQYrn>^dQY9R-sSq9KZHq-@}|oe@LKa{gKm`p zxnTgJM37_$fJ`N$3mMKpP9D=x0YhH%npo$4DWwLN_W#?gg9ynwvBd`WHs*BY(Bl;r z@Gr&2D=SeUmm7fw^rODtssWUcNcX($`trh)+soDjk~p+j0jj5Ec8WE>0TunW6^RPP zCR)1^I;9cXWA$>OQ;A)l^8=mW13uQ=SKAdwgMs*?(Vv%kNOE?$da}l*vkXgnFx@9b zwV(96Spu*q)4)2ASp{{LR54)B<1?G4E$siahV5!@fIM9GEvstuktP2~DGdl6& zG;yMzs4HekWNEex(_PKOb8iSGAyx=z_xz2d1(AZbeN%6ZHL4b%-k*}h=zIO=@0LH2 zps>1O$;H82vgnHNh#9l-340!tuSD#n)^7(OpIUsRVz)!&5f{%rj$mnP0OuQ1fm1~X z<-_rlXcA>F#he!sJ&zMYd9q@)yx4D*(^K>Y_iA$3aCCv3NXZ#}__P|hp~Ua;EG`Jr z>$j)}oIU#O*!;q3KHvH)GL?T}cpB#sC>*_Z6w1ep0dU%9ou8?H&MZ7$u;^KFa6lm)f+zSu|KxqDPP)lEusLU(M zZZLcT1rWahJM55qmBW;aLwKTAmvGH!i;g>`q0 zfvYUKD{TZEp6Q)f4l$iGQN1Or)39JDmf{?1TsxA;(K@EM8#VgfTHK1nX^v@sOJCDYCVD{$DP1@_UaN`{7jxd^}>u24`boHPce7UXxd$a!hsO11cf}~KZ^c3*%Mg3 z!GEs`MQvx%Rx??S5tn;e6%J9e%wM&Aga-)rrq2~v{L1FJCQt<@tRC3(aFo8^=lxgJOKo_~C zM6|)b+^3=_>R~xCg=z-Q$%<|-|F9mdcc8j?7XVz1J>0Up>Hwa{!46dXCeo;YC`|fT z$%ThXP_M1+)_`}vg?41E>!I^y$OOWR-tuLaN~u%5JOl`ty+fDHTJQKM#aLyMxs#(q z7!H9lrzVgLdj3_#>ruvwAr}Nc@=;Vve)v;k5eW*fh&Fn7{BvSSC4 zwRw3a)DvfNwR1B1%t`bz5Pt@r)b$TZ=|=GhVS^Jpa=!F;aOA8rOR;Oo;ssfgLF{8#?e*>>rW zM8vYPHYWFo>}2vxV|1s8P>1E|%x;ar+&;}Dss zeGfi*2<3;lR=8sShZWLtgZRrp>fZhF$ANa~vQ|Nq`$~;UmwZ z-KkG3;rBSr&1(IRS}cif_OKaLXLddb0t~$gGUS|Yus1-0A;J`kU2k)Int*@$lscl4 z`^V>g;-{4kw+!@LQfRRQo?X>cPNd_njKUs~JXW`lecnORq|+lmsZQXz-1;FcGh21_ zG+Eb3+MmvAG7~WujTVZ@)}}EaWjLr$Mz99U3MOWKbOl6vpV;5Se|RoXwyuf)m?-}{ z$1po9!~gFB(*E%8|KPbGyfq;)o*Q?!`N-BFlL!RS4s%w#_avG}aHF0Qo~+?MHCT9P{ap$%zh=?0zYk{9qx1P1L8l|8X>@h;=qoh; zM=%^cd0jWzclEH@YoTsE^PW^0y{rY%@MXR1qPxTQ$FJ+_Q>Z__(vX4iC%`PL>xT7T z+3HLmS{erR##a4=b&7PvX|ZNyiYD7ld&N`Vpj^jIURVEW+=`aD>C2@}ld)&({k|jn zsXYF{pe_ly6pduEBKwD`_@JS8GrR%(^dKr@ie_bKk9Wpz^_hcT-_LCm^0VDCdMh6b z??ZRX8QCkU&fW94>tod2mwMwQn4i4`6A?-ch*9Z0ZQ_y^B5ra#D=6Ag)<+dp_f*?Y za2JZ6U3L>~`wzM%EK!$aWUy(HgJCdP>v3;IS7YV&Ts}RzK6*WUH99=>4CQzU=rTqT ztnO8zIKs^OoH8vRt)HX@_-T@f8ds^Aif8I4FWc&28FDsq0TtcQ&O@uNWam`AQkGFW z2rTgcMsxjS^|8MdIibDQ6vC(lLW8M;ILO&0`hF;T~5u z#0YO%!6~d8imnwdaMZ+sncp3DU$3wTC2fP+ z@FUu@Y@f6j8t^Y3JkE*S41^mwE4OeEmDc^Rw4v4$#&r+N1ss-cFZ`cwZZCof3PVM9 zy|w3bOys2tSaGjVUHv~nSt(>Gxcwu`%VVkgaCRAqz)$zW;vwTjADRmS5t#LR%u@H1 ztnh2iCG)hudy>8o9EEuD8K2`Z8bQd6)akF(0s{79Qx)R~ZNBDX7S3-s8~9S5$Bf0e zW^EPvSGbJSQz|7dQy~OWV&5j^aPeo^TpeM?Ba%M_B$EL;sZQ>REWZ(?OWZ=OirV0rHMgb); zH3q?_xTTY>N=U}x4I?t(0+Y3hm_%IX@|Yfxmi3B!*4f_f>UT~BFpnNy$q-NzT<$ZR z)G8yn<}_r@X!05%eAM9pGgchFNB~SkdN#i2Gh#IPt|la$90Gkkn})`A_;0o}Z`Jci z82&hb@8sPTy3L&dAUPr$;eDjBIV*|-%E3FD*Voet!W)#hMggQCBA5i=|D#``8L!d^ z1_Y*A^D8*kiGmrNlAis#2pCk6WCh7% z*#V31%{4(GsTShgZ6ExfHkaVMuU(^yR?EO|aN}QvW~KyCKTwPwx&I8+qN-n z+xB#S{k!qT7w6nK_l@(uQf`zr2He|MHE0dm>e4VS{W-T_{3r6 z$gEOG=t}(+agN2fP>>?$dvkr$>F?5pPQ=DQrE%rJ}zS7Fk z_ykto=L(JGP8U|}1#q9o-L@EhrfU?L?DnI?2sA^UeZ4pj@GLEyuz^?%8aD(&y zcx(rqUo^DkjZRs(>h9J6=q>td-c|UxlON#m zLM=nf0>ero##k49STj9Nk|@sbhUpO#LDjv~_CC9VQqkjOJ_vL1C~OCGzlESm@}i74 zB+6sReqsBbyj5>K)b&3x=Ol)lm$_@mb?ZU$AuKmvt#@AaGDFaR>hi%n7RHO~4%f1x zi&V?4&McaOL46T8&!LLDY?!YQJz!@smCA*kN}axloLNRe;ai#LsgHFLG0yEvU2%>L z>1}ReWZmJ|k}|C(ocrB0?;GZTVA^M&P~L|Qo3_Epn!I@4zdnQ5IWEk!Mq&M49Yl64 zj>yTL#yny!2;W0oe!#n){sU+Rf$tBR0tSgw_xcTlhk}l@Ya5g96L#z^GTw|0hW7-sPQPvp>U4UlcQm!Cbl;2`=F;pt1B<3wQp}}> z1rChmUEW9=HXgdI!C?|0o$c6J$M|4AqN8F2qU83FA^#=vF=PO4bYb#R;-o30DR~_*TMw`xq1m94oS-)7 zhJ0QP^dGNqa@w1)LS59%%+>2&yvd@S2XmkSsRHvYVBLkTPLNvC`v9^Sr~tAXeM^K| zI1+Qpy=)-b%JsRlh|qh9!Tu-RvvGhU3&22^K39-lq&|@SgJETOkUQ@dPWpG#h$qBe z7tee~^(+t9W*E-y7i`X!L`jc`Y@YlbLRzoYB8{H0xD%3Zl@EB>W`|GDr8tc*$xpLY zMS;P$PVHs6uIgx9N1z^Y<~0#^;t^?&>&^#qy}SXOLofu!cgw%hNPZ&w+~0hWSuAJX zKxqZR_2+x}lHoW|t_vMiDyTV%93;zYm?QGP3F_18tbOBz!nHBP`TWv}^sadgkgH86Lag2nn3U(H0B*{AwS zK2J85P6flyF=v6f)R<%}La*r2p>+wOoNMT_@Fnb6TAeyYLl!a|FB6LM@#Jd;Gak&H zwRrvaf04Hh%rRIWlnp9%aohb^cV1-oA>0=j;ab!m7Y7E7WpnsF+PWUe>jSSER^v;w z>0obsOM*&@8qNXh`dYOjUXR>EV0b$L%Y=mK{&+PO{k8VX`zdnRlBau~exu5Ykqm`l z-v4#MA6QR@QuRNfVAlVNvX_O8>Hp#!(2Cz5M)sSjLCVHNsI_izV0MU1hQ|Ygh{@?i zBoO$gPOV+!Pbq8n5$L;b9GsT9W-o(zSYI-KBI?DpB7d!@yn;A**&ntjA~eVa*d(tMF&JIdp#DbI|~T3N~H z$jhI?Z0>@a1(BxY>DXl5L7PYDkHdPrJta0G8JkiC+eL^pi?qUq#>CW~eA)V<2orA~ zv5}LUwdio33^~S8P^F@;7_(rLoK-OH|IujdhT2YeU z)IwcW)`*@Bq(6?hw@da$mS^ps?$wqw48aUy^yf1>ce>wJ^7iGVW-rqdHhxyg9p#d0 z_cMu_QegKe4KO+`a?pR|Qx-q&u3Cklx`4pYCTt}cUpl*$3NnG}H(K6#NP4g#ONR=D z=z`>K_dIR0u)`P;?`0O&JNmkS4cU1*$kBMZ--_|WIUFlwEGTd2a|7roR+<*jV(p)5 zY={jrZa-P}O3>%j4x8(2-j83&+H}OxN)sXGcv(c80~~t~{VRlEQdOj(Ig%*FbE zL$$oIYc@M$J#D_3I>;K8E#5u2;~44oWb2Jt9u|1n^|tLVVFk00S(DN8eZK1jrP1SQ z9a&Z(kg6%))(Kp()aDm!Kml{h+;W7Lq5rmn*QD)xAo=8P*2<)3U}C*VdUBH;+tfZS zx7=_&F|r6^1~n0~a$;O&l~s9e^=_&udE&#-b7XE?x^J&vO()Tb_j~)Ee&=Xqa&wjfSsz(zS!4AUIaGz3u?_*c zT-e>5UWKEhZ)zVBNY&;$X{OA@19yXwscXt5oo;^9VoZ&wk6)Uz1BGZP?ANyVCm$k< zOZPdfl^lqkq4KTTQU8i#v80&OMV;aU58{v|#wMLEAEmp`G>g?v*7m%_8@At$sZp=E zCJ|*2hYUUWHCvYxU)Z#O(?$^R;^ov|4tAdQhrKrfY9nIJToC5!ZO6>*3X!Tz8X2C~ zET*$k-YG)QI!x3?xQVcKozQKwBrB)c13W(|ZlER@u-eDDTeKXQjGpXNtGa{{RY`C6 z3-}Mq`>;dxDhDUN+)(TjT_l`PaFauJzYa@vuQ2{KGfpM?oY1UB!gTL1S3H?M(=ZXo z4?UKtGU#PIMX5k2W0O{B>YZLNK~pT1jVYj(KL4jpdXeEIZ!*_Wo8n$@+)tWf5@C-& zh-E1@H>a?U3fQEJWbw0f6+vw_Ep|M=_TZ0bZTkq~+0+ILGWoz@K{nV7`V z$EzF~aOV1D3Fn*^i$tP=maPwSTgEHKXC)6-Ju7tUmh##gk9s8%bV(!Gy59Q?vZ2J{ zM!qB^t7rw{DOr?Kl>>^U0oaGp*YwPT3qc(asR}!*=6RKBTZgCXc^m`^EVJ&qkbP@!X1Kud zw0;mo1?ILZGV%$D3KV}|;f}hqIFvNve6I{_t|1o4>F$Y{O5}VM>Dk)Dib@`h!n}kR z1m;MsM^2vy)`Ap}qHG$ZqX{!wyLriMR9(4BH482nz4s|!(N9jeZhAojrUZEMb!^if z?gadW+IqRK#0~G9SuuuAObTB#`g730;3$=HXW-{?Djb9$?1}BRerlXq2B zSQl~{^~w~Ettc8-74@&Zm3$_pPMh_{3NYNIVr|ReD?|5|Fd1&szQI7fMw_WvnXko4 zOzE%5M)VMTJY{kfE;S5#t`F{{%E(dRMOe^@S8sV~d53{iVp%$A1kV8>4f=}nTSR!K z8z*bM$Q9M09qwj@lGHvikCZ1BHohftdLGT4JY`*V774=fnZ=ll0doZ8+ZyG1S83ml zEw}gPyxz1Dl_VHdoRh1kJC$K7HA}BZy;zqPE4T9z^G;=g(w3{6)cSo^P%5^GWZV0O*t7X8uvLhf@bhh}FXQ{<61F=eJY;M07MuP+;vKS8Senz5S-T-M|7 z;ei<$PuB)9@rPBOF@}+7%f?*=M+3UkUM#mIjng*OKV#83^?QEy{Oy@<=fHIdsiEY$ zwA_@dxd1X=G!P7=88i>qh*><;{?RaK7ZxaaVIi-VvP+j!_ffdgCm=!KwBy0|r)n57 zz-Y`;n|1T$#*dD%kR_bYH5t(ybj;S9b4j-xqByw6ZId3mx}|{7xj{qW#9z(y86ioT zUbp^Vn~|f2q2({sD}9LeQ{hKkZI+YAA?1D*Y9l837i1&KzA&tC&bEXEw*I6U?YRhg z(c!=437SCf>MX$9>N>Ggk{B^4V&FRWWlSpZgVpb|nHZqE({k#CRe$E3AFzHo_q=(6 zdj-($3`9Ax0z2}7G%yaSdrQ6x;+6AvtyOJRbvHp`E;0+4mW0~z4+_bqFkN1YNs?+M zhd^w2q4OS-Qchb21CECp>sD|e=_vzk3#**M;KY)3cw|-qNUFwdYy+n20G>JO)7XwAyPBr1=$Fzgl1{9B48OK3sG&4 z%cAEzabi}t8&)tkLusWDgyj)9s*Ru`sOA$hhlN>*Pb6l>cflI<&^tt^-I>%(aI(>F zfLX7$&8NvW`%|DHToHX|RAO0ooois*X+%Is@HA!X|JC1pdr0h2`&X+o_c;|!=OJ~H zaCqAkCu~O$^Y4S6%@0R(1$&y3l3G}8R?^qnxvca1WSkL!Hx&7Uo;AJ2rn(OS6{n{wotn|P)xzE3-FyNZVP`}HOu z#Qv#N-&w-2zjPsuHY0<&&S+EKra*3Mj|B09W>Xk|yqBq-1=KqC@2N*(FYESx^DMk_ zW_H1#y&Kt5xW7%Mt%1j?o6tWMVQl390{Tt0>8K`%@f8*_ez`{e@Ig(8Lkwdly5JPy z?rvWe8-j>FfG#T8?iWV(w+92$b&~mY|8Etu0&rE`kW(8}=CTa~2qP1hL9b>nJc*q64JEKUZ1%`nV)AFNBo4+p-DqTetFS7{}&Z|{cqr;;WjOxO^X!_<&OX-xF zr`x;o6nyzTBc^+kg~zeStOd_ES>jb+M{!L~Fy5F`FWlYy9#aTycfOUwgzB?&P=+}z z3XCMKKM9$Kz{FHfv^Lk6CDWQ?lZ26)ap&1wr7bDzUd$_k^$raoOD?=4ntw9* zFqQk;Z@$9~!9>i5wy!-_$dByXb5)Lix!>(-9Ebpvk@B)fXfA=DB&*1kOt3tP_O0X# z>Gb)QxCe-Q9AWfafCPOrU62m%;h?-LaXkE|g|) zhbG|6@KmDbE`h#n4^*sWhrri3FF~oNVri#e|7_0S?s7x}E%GRMiLUw~?NRl~5C)y~ z_2m8q95`T4@*f`q|2wK~)_;5bCNxRNW`Gec^!gp$oFW`~sord4)yV|^f_>Dik|%_{ zIP}M9Qsb<@0GU%W0^IjoN4KYZuT*<7zZ5@yjk5MgS0e7^BSjZu{3g=iiZZ5|g=I}h z#vD4*4n zi<)9LPewk*TdU|Rxp+ulraWf5zna?{#fqafj>iZ~e%o}xY+(6dX{9w}CpYE#gB`G*=s`VrKE)xa)L`=; zN9VsI2ITzLKdMwHRT)(ofrLfCT}X(S6(y(DpbkKQSS`Q;|6>pT6;}-tC&#~S15|0+ zC1(G zUeqzh9UEXc7}8|baqiG2wJxPOB0Rq_!=sR2niI_Ym2|p3wC8vRzn86>?shFTBP!bS z;2ykp4Cg^-+%W3Rr?8u7|CCb3Ge!*62SJfh zK_s-oVkmIbFA$(& zFs)~=T&Nj+6snq4Qx69;Z&%QI*QV~EG8BEiqc8$IvV}@&7aTU+7NhlD;D)9$4YlU% zcV6-;BRZOFZ6yP`K20J|n6rHCnsHtRSXT1KE%V1KOdu+>t^Tc~kgau3w4m4Sl!F!v zU%^Z-`P7v0?oaNti(ux?*O=&tk_eFmYgs%oKl`(hyCauWvH<}Y8ySRjny7_$; zr_DO*zbp929uxX&f^`cHx`n;MR!*VF;xYg~(@(vf{S)Po&nTKcU@ws0<(b2*d^mIAaBHJan<1kcnWeUcL>+3nXP^SU{_ zmP2r;m>{<-JkiYU>lTE5HqcH}EOyL~QZiGcE(hPphSL7ayY`~d%2U=*+DeP%h+$QZ z~=#Nx{bgPF1(M_J;>Bx?186^Iye1)a`13j{VeC3r7Y zA@wFHhVxzBkJ)W-yyuU69^FHzJql4a1q+8rA>hw0{ZtGxL5AZvgU<0wY)8Ij< ziyzpRJ@)W}e$^|4z{)G*pyEp)nCwKICyb?(AoWw=%3VEj6*YwLUPy#iD5jR@6ID<7 zs;_@Y7llG$dSe4^{b{t6k}K4P)ON>C*38Xk74~yx)|L7dN&d=Xcepi`53=4LY0QYQ zY!Vl+h%nFT7VyZ+D3~H4l-Vq_zHfx)t7;BD+grbn<6%svS{q*%>rC91$vONwOCgbA(WSj zSetEvG+gjM&E5E{g7Ig)oCGm}%5^?b;hcdZkRc!?DfZ)Mqy&2rkfEP-FtI5yrKAby zQ$@STnog`A)}0XGvdxSISpFGog=gYYNHk6vm09(c-NBW*+Zk54N~xVI!`DC>c2KWW zPE2TU*f}W2`{(XBh}$e)eHYi_hvZ0Epmp6r`^xZpAO_gOcM$XGO|L!mH4KGmFZL!q zLf2itWe?>!XLqwnYxLp<^3+ON9{6>xY7)%oMN%a}5L1mM**hJ_yn%)@;&$Cf|URE&am-ismiLh*}xw0pRve=9(pd*<+CTTm-WTX&hLqZ4?( zr}Xl% zxn0+rJsC^DQi0lbJ9pCLL>MT5ACdpq0-JR3=7kpeiQBKBQHTsdMq-WqKB9yI*H40| zJ~Dpt5IUZIp7K7*ymZpMH_`(w!hn1Kvcj>BnBo!qo}fz@1x>k!rjM80kae<++0f(n zg17=j`5&uwvHe%X7p(ujI>)NWIjl3nbzN(mPy(}5C`|BQk>E3%3TbqN8?E$3rwm%! z7B{ckefc#Oqiya02g9cq5WbE|MDZdCaqUFeq{H*X@cJFL!+=`6!Wbm?#ENiZnPt;*2g8G>OD<@{(xWkSpfX$FQv zCAwR&CC6RTnAOzu@K9M*?7N8J$VmC<1vhIB)svS#*T~K0nm)MoEb|s68>sf$1D@&+ zZR?5ACy;rIMd^DCQW{^})ZOFp1k6mZiKM5u)ULUYwf+{DWo4xqAZiUyo%chLNHM;x zc1wZgeR0uV-z^g0@rfR4a7H^NB#CUZDHr>SAZD3$6`(XcU&5D%w-s84gWE|5dkJF} zV39_pA!6tvAn^wti@6uCk$UV{qX#%2>fY!-fH+2`e*tl-o{nY=3dYtdKkOLfiI^D~ z8N{ueU49TTak2mN(e{U#GlRIT(GN3GGZP0>GX_~Rdy5~IME^Ir^rg;v9PS9R?~KL+ z;f3mBaXYXGVjZA&G|#Y zQ9B%criF|T;oBg_{>Bj};9OHuMbLE?Y9_RcN;ZRGk75M76=Ki`fvXEyGqR)9SO@ev zp(Bt|hN}i2$#%&FrKVFA|H6ozr?n)D5-esfkklv>hgK|zMcHBn5d(8bq$Ku`N!&lN zj)R2+Ew?NJqg+4;0H{Uu1L%}=VgPh{xGQq=O2)8KV=1KYRP*Li*o_u(ps!TVPT2XB zzIgnS%Ohs6Wlv5Ka@LXi(r}(*cpB29!dJzO2~D$JA@n2tPN^dD!%pfV(<%GqMB{Mf zM2f38BWkd1&?8M`KgCYWq7!hs26g6&m96s!!S#uify2n9xzN%D%fggL!=i`+N6VyP zij!2(N!3hDRTIB|C~O<-%8mXbGf7@dk#?AkG8IJ$$S?zs5~vc*8ZLUv0sF{%?;t4cs0p6k}Vq59vF$^>5sY>jAB$Y#a}mJAoZY3 zn5rIOa!AZHKO@1AuVcXtkPrv;6|3>Xl900st&6z3*XH#A_6_y``&50n3&ehZBVPdM z9RE$hIY_P;@o$V;urk+QTSguvcVKLh{k@iwW_^x_r9(i-&~|+JEAq2i0ifp+P6l5HaEb+HMO@Nxx=81U%gxqkv%PD6eEHeQ1 zFQfKcEJq^+ARmhFYghqyUZ(wQc@)hg{1;H0_h2)?{2?}mgvnG>J0D3dD$?$OjtOjY zVldvi@R*hGx251g6LNbkjg16rQ8}x!s!Yo?^gMICEwq_qeIU$-*SN8K zTqAR@ZogeP!*9~EegZqQ4BD(c1+TrH!@XwafFR|u46e@{@2=spys7W(wIMcTLv%tu z(Smz$^<8pX4ys*&t8=5ohwEx)Dd3vm=?_{MkJ*J%)y5B%mwED-3G};rbb`&nJym$P#C0}{L zB@V|jH7`U*^2Po}0*{xvw>CN?*&Iul5?hOIw=zwgmB(S25581S3h@erpD!;H`zn<9 zC&ynOpD#BEpf^vqw=D|$u(BTq-kN~|yj|BWqpO!m=GSSh@P-ROW~hQ`Rsn8cwS-?G z!2X6l-0e;)4{83N`=`Dw+&@VDCMpchngRUimo6edvS6C50_>>wnBixef%j+y7in4- z^&vl~b$j5H3vILZl9+Pe2s7&C#I;L+o5v)bFo;gs1v4N<|CpNNe8A%@?64Qxsbtzj zWvAEYY-m{k-?{O+fi*Bgkh9y>!zjU%ga!A!1sKAAPdzih4C zvtQif3OrAPjxGSLf24B58)gBKHvl!uLRgv=H?%8r)xJC~`K{9Hx#-+FevbaURJUb^ zuif-LV}`H26pn2GQmZjsXrH`(d72pg)1ITfbZzoF`14Xs*zQ~3X6Y%d;JRD>p;f>S z@GRHHJ#H^a+@`H&m5Ntab$QvD0gAdt2j_(Oh8!H^U4k%7n%Of8Qg?lSyQRMZ}RX zO^FQJq~m9$e5yn`>74_(p^q6hn^F&x7iRDE&E8K6>u8)ykam@GEa+c9M zD`h;KmT&eL_C{>|Y!g(%Kbb$_`n5))dlCe~9r13{?l2Sp+2d5q@Jgv;Wdm`UJqK)? zE?GI;aUva8?kDA&*lz_2kv1$(upi1m|5YD)~l(WP^GDK z@**o2+8&#L7|U3#p0D55x_^RLOTi|u;YuqgT#i(2zTKeH$O&`Acv8OS6>SgG(kV63 zInS?tRLlvf@U!65Lslsxb84!?ZDE-ZhRYUNlDrX5LmZ9uKY7hH9ScC*k=#arGqS9$#DidZl$V%q|#mJ#Oo zgm6aqkS8)p-zE{hg`Yga<~#0%&sKe=n)0>tYgi>XJDl>fFxUmElCpZ(7UCUeXo|^G~JW4jzGMos^f~= zZPQNr%s$9z+QA+2MTdXwG+C;&QRX`ym6qROX3G3$EVxwpGHw2h@EExdw-8`Juu+6h zFv3@X+iqTt z&P4S=GxFv!%>$%JJpn2304_rVbj(E%ZICIF={_{?6S04u3R=ge#-@eh0w|nhS#hCP z4mJ7^ja^J3p54ma2r{JFrDX#_6?=?VBR`^5171NK>fhOt@So0<^hw0wtGy@T90Qz) zd35%c5-qM4eBuKsb}vj$SwQXxeU=h*7!)_N+C21S>2R@G55K4O=w%%vq()5N0LnxK z`+kXqIB_>D32;e~FG^h^a2XPpFkCl12vB6R<#AU|Z1kBhK%xC)q65L&foH~wEjU*# zeykrngGO2GsRXUsw!k|Qp|k1G=C_8U3$}t7;jy~=lOc!HKTa7<2-(08dG_e@}>KzMk7^>uzyLu5V0n=iWuFRAzm6q&kK9$GTwHGaK^GAv{=`9 z7!Q~Z1|Q|4&zjKcfcUS0An5|72~z1Q?e)RKSY6(5KFl7SpUgUjvg3`$EVL^4mW3}Y zi|cy+7U2!uUIY->b2Zv*fOv{)o$dC|0TZQ9A}O33kqxR0f$dRUSU&!=Cs^Lgh`@x^ zpp?(z+}T0VK@@Dv2zyg@N_?G16yUyDTsPta8=+ekaU=|fhpNV($w|;5X0{_vCpzCH z0}H>?7jaDQ*RhNkeGJ=nVlxNHM=xj(+lfGpClR~p5E7`E?v+D>lKUbBAypWJRCKDRZuc~ zGag`M!s#5c4Nr>`^%8Tz2=~Fb;^lFpMznD=q*3co$qMMjB_X)*iix~G;$-QQ4xVh# ze36UO3Qoy?sAOyjoHJBL%p*|w6%Jp7DauS978!1k&lQ9RB$$Ozfo;o%&(9{>e}Qa) zWD&PhLF99*$q8vL!P;B81K|^JkGzx~=pPqRS&P^YqNF0DlO1ZtlmiR?T3+b`ptFyk zmEf(;hD`H-CymGY9T>7As0*$<5}GJ&gDqsFNnRpJ(LGBM^2ixpY6E6CDXh&2r^PxC zn;Suef?ZHINP7_aY#saK$dRx**axA;sCh8fRC_?o-l>6PiYSQbJaLtdnbjBq;8SAR z>%r?uPcNg(iAg1#t4_KYC%S1Z3H)W)3?eYiChA`lx+big05Fek%@X5c{XjF>2p2Khv{IyCGK^{sNNgIC($8chrAq@5O#)%)!Cy$1FmnbXi8~*9dRMgITlGoV+#?#_fdh)KW4fYsgVR z=I)Vd+VH@+;F+L9iU8U&C{D-W3++ugC6&!1S+S93xHE8W=%Y}BlOjm;GBP4iN}{xg z`PZ7wr_Bcl2CG6eq&p!N5Ir!W%)!g7As8U}o=^o5PrM;LCR(enQq#_Oc86R^0W8x4 ze&`W5v!w7wv4S21K~()2EY(OMTwC)<`VB*c0-Pgmt=>`?@rcz+IewK_x8eneYJYj6 zMmj-P?DkrqjS?FsYh~67BPCOw6T^v=A2P#ELMHU?k&?*vd}^z&=dad_x}jI0!M#dB z^tSW3%gPE508nY+MS#)hZn*DQ@}yq!Xulr~toUG&?hF@w3qeDU!8H^ER&4$>@`5Ru z#_@{!kJPucjIHw=Y%uW}KxSi1i@Z`MqzV(UA_Bk)jsX$GDJ&8-NXdedI0enRx2wid=ed9o~JrP`&<3C>f6CL^z6Y8kfROh+gTZ2Hs)7mCtHL} z75AnKHR>E7Oy5yo2yRXdBkBrfpAaE6XmhV=A2_ysU+#awnSrpSi|)aQpvZDUKXJ`a zFSCLIoC>ib3ZW(DhTpi;dN=!?ll0@5smMz9QYozoW~K&_}t9-1y)-s&gVFLC3xuO{Z1HB34((Elj5frKbOODT}Xi~ zeuiJxA6SZeSZ0PJ{WGgXkxM77E@6by_mjeIF1S^_CBMvhHoDBCM+$9ROY<7kbUJFL zWw+O|hW3{o7j*{a>}ga?tA?`8!%8$z6W{h(5QSPdbZ~+?Pjp&%MW6n*@>O!Jtrk|{ z+uK}ZCFCgnx}S9P^*<{riOUSb3Yif3?lJMZ+s`<&=Vq$)^%7fK{_mJ4TZEnS09M~k zRpyaQuao6wL>R@)35+{UR=ZG#pS}eRxMF?gANoB#v^-twpU0vP0Y3#}zCA2*KGM}E z%c&gmSo#iI^oYpYa~Ji&_9vKejo$ftR`9i*ir;$7qZ7lVJ6ilY|Iev2Z=|iE&#QQ> zXL#cdi}pV~9rO&9^1cj@)~I|aw2q7kFtLd zPxB;NKqayL|4LCqQru}fvar6Dp2r#0=Zt$&5PN;!b`so)XOL=mkdJdlS-_M++=-n% z!<{K6cOA}VkWwopbUqijx(7DdwBq?&-8h)Kv#?rp8162?Lr1(82?XY^Sv@Tt`Jk?i zdl->t;QnAj&PQ@yi{=vjkBLN4H(R^d#2w{CpC{)H2=DgBK40L$$(O3rJjiX`aEbrp zbnE0l#uh+bJx&R7py50xa85R30|A@<2% zN_nPDa>}~m9$-~>jgENkT25Kse%xMMb=+;WEnQ}otlXkMpGvl`-MoRXu_>*l>sz6` zH{7f?Fqql04ELwm%D#22Bra0!W_w?Jlh(w%B8!5krQ35PEt6deoCRG*x?fcd&MS_q zS&H7oEu2@%_$N~o`VvQ3`l3?>E7Y3zKratOda1UPJE#|f=CCQM%xo_;1bz?}5x$pO zc$}2-1|60w5a(hFgqChgj6W79#8Fmp=ixl-)$s45p!l^^+>i!StlxIzK=bpAziV+z z(tp6Qss;krrvL}2P15}YX@6$)8K#3~r^24V4D?Ce=inT!#ptdXh%2VVi0QCF09zrT z)U4}utTMq#Wza^2cqylttf@7)9-vLf?9m=_pjU*2ptrw4rd3BJW%;Nq83$)ka|ZwF;333M8~F4TX@PF5;-!$Od)g2yM(<33Hk`JsRx9 z41o{&-QvRnbp>^Nl&~(wA!kL2z+Th`x$z5SnLa_01p}eN%54>IH{Zx#V#8(#G2B?2 zj~I*K4}=Yuv0@X^Q6Kds(twO2JcQHl@&TzE6v<%As9M$VHv(N5$4C-kZp}Kbg6il{ z)L=erz&Y}7WKIGwS}3jXNN>jhwsZ)4&c>5Icv%{uI^cw0-T{krETfBrUs*zFtuz7n zszQ?k#(Y8B{a}0`xOF?JB$WBlVmo~sab*~mSID}^LB;XEKm@@AgI(~A(;*56#v>we zNI0u?MCA~}MPz(1^yy5%4pDB%#%}Zu;H-98;+0nT;X(Jhc|AhDsg5Ozi0pYSwS$_r zfT*d$muQcOFWdU{-p4^VbK-<2nB?SM!l^GqI1Z+(l%BGAl3F$5=W z8{*2WHjr#W7)PD*C1cUD);_&MqGF8>$`+0BV?)x#y)Fiz_T6#SBhWHz(*g5_cZsBQ zC>A(jP#KI4JH|nynv~3BDAvCuszt@&vqw`=ufm0epkE?DoB-Tm?|Vhgj_wWBT=?^)$d?ytv5=l5fmK-zTJK(S(w0 zVsU#xgf_x`xJoY3o_m)P(?NNk6WfKi@RCBenDD}cCW9x9l6F`pk+!9<+KPm9LdwzR z5`dXv9L`#SWm1WO!$y;=)^MJe*&8FgvqBOI4Xrq33LpR}As9w6C_^ei0!kzOTKr*M zh%_cAw<-yiMdU?E*F9fXr3?n&JT`y){a)L_4Hljj-2Z{uJwDHA{vSMkA8&`p+fSMJ z+aE6zGd;V(HU1*b5s06k1Bm|Zf-l@5IYj!X-FtD{O!>LyM@;uKU$2gxR;q(cCPO1fg91d2Izb6S_5!mUfXU2qZy>kG{8^Ff^06gP@+jCo$wPv zE{g4g?VLiE4K;zx%?O)yS%E5rpE;u8Kj7rw2t8QL5IRZZx;6j8^rx-3qq=5dlXHDC zDk*>!RDXkx=WYa{R$D9levQZz3xoHoVt(jV3II=jz}#f5$}?$#8A$#)Qpm*7w_V6H z6G-&en#<-~&0~;RK8`4k@+hRSIPx-zCfnvU`rytjSyQF~H>n!IBN|ZSu(0#Z?&U zps_0$oqVY3*5F-J@?C?aA`C|SrYHf=c%~Zy){5NB#60LB3#E;`@nP6{i$G4qM`}e9q;7;;T{OKr<`5*Y5SCH{0Cixk zYs69m9bd7{c3%Im%}CQoa)XVpextW4HeUa`V@|LoN46K7kZVIe*42>N!$>U%P&c-0}x| zAQnuwkoV%18fiDb#1%?erHNLAQc0A{WgI<-QNs71&MWd3zGUaCD=c)jTbrjISO~Fn z<5A1>w`d7QKqUmm75#-!XxwwLtF!Xt%Y7XF$?MJK??*McRDi9k|AvBuGr!%LFG{_F zu$wUOe#UOQKeMt*Rn7M-@zxF}it_l5`bV6ZU8+fzPwf~a1@JL1i|%uXJah2-KSrng zyrULprDaNZf=+mgbM-y?{nyCm`YkiKKVPyF6$j`1WH0S zKk#0~(19v~xXk8Ndb~knqlH9#Sl6khKtS9x5@8SQ5qdEpBH>?;rn>M$8Mn9Q1Gv|z z^&~f-6F@crqz6(+9HQ^ht^vO1U0XAVs+gU#us;|G!Tgn>1by7Yv)q9At4{BVMVrP%^t}y zCd507&w&TACAA=}WbwBm9)ae!>Ye%S_H1Er={j9{`x7|awK^h)JjT~Mu878|c^z)N zfQ-&=Fc=nap-j*ng4%;08a4YXbM%TK5f?FKR$8j|C2UiZK z_q}&tG#3|C@8uXE62+W!KA$7(ecM>`2&BASUynbufsp&shiYLo>fOt`IY?Y4;(@sW zFDi+P)%`mUhzhRAA4K$9j!??>DKWMuGaVEqtpB}F*WQ>5leN+r_RnQAgt)z%TdiTp$0Lu-x_#E^_yx{X z?vQ6a&n~TUW~6s8C=%}LuJ+(sNa)?a%7{c2JPr&NBU8&&wEHe8-I(SlHL>J4Y4*KmrMM=Ar<}^m-s_3)aYV_twdKys~ELT zigVzQvVr&C1cGlm>eUh`S$ul?h)YKSp@8eDyYseu%6+QqX)hqp+lQ}c2dL%$gs{2( zg>~-#g|L|!Sy}#9gw4wQujgF<&#rYV{P(W)2P9o&5kapZd&49-mMNwwGHEPPR)(RM zd14P@{CH(G^*dVSn(DpwGSfDio!j(MbK{}zyL$N7`dwLA$j zNr|#h<5UvY+=BT(E#+^%nRm<1eJSltOliZ*G|ln#@O|?)Rbvhh9e-yQdq++_O+GDd zLv>;Nk{lRF0HJ*Ax(#2bR%^6ye|>b9YtnVk-dIp|uVv$IpU+&H|HAV; zh)mPfy&=X|9U+m~l&*HEp(zwR*o(mg7DRR#4}I$Lr8!f6XDh8VRBKR4Sl4J)26!l0 z&I9{|?>|!gdR_1uDX(abp=#qwwvt9rN|vEN1CeGQRmTUqk#B=yCabAk`H7dRoVMZ4 zX-3~BFy(JMsbz=MyD_6FUm3Pp7ACS)_scwe}ev9i=W6Uk)X2X}q`(+(0 zTAghjrRM&5#`udjggU0+s;-)7WdPVZT#1#3+2i)TT!OX|XrP6a%zdF5jz*HB^zC4^ z%-EwEcEwcN$m7Q}Ba(*Gf)#lDy*Z1U-ibPLXGD~`5%{2vO>Iznzjj*N*$n;y%+NE! zAVcLWYA4pyCAL0XuDAGyFfP9Q2)HjsDyuSDqSP4B@u`gNUI-66P3Ah^4`ySqEV-6cSP;O_431b6<)yHdMbU+ureE$&RsxjlWP z&pdtZbGyYwoM*2Twui1Nm0ITJys5%Bw3N;Ao&OL zMe`*BQhvwVIYIiVo7M~A22v<;ey84NLc-dX$#MZjVi;zE%}yU@0ZG9|S7Wg@W|{L0 zMdxW`b2errfg3lz{j&aRghPeSmT8~KN(Ihet?XBR+U)30(2+{v2##Cpq1pu&G{Wc~ ztex$pFKSuk)|>t?<7Mm|R!3F*jo5IBrAaVfGY%xoLTT#O5Hv2(urffhP0pmWF}~t> z%dD!xe&-wRHI`&J!%!9?#!*a*!HJpEoD)Q~N8nz*ZP-#QtxSzBT_N8H@_pJFo6_%j ze;Km-e0u?;TKXbBJ&);sK5o_Of850R?H#q&_PqJ>f_y(H1!D6JM(@|GEggr0E5VPa zQY>Vwz<_A*;qSzb1i!)0d53+5IC~C|wv-S>-hlP*%&E(#GuL&G#x25!u{~eB*AMN$ zI%$YF1m@POcz&NSbn;z-?O4?y^RFr?=5Rx`8ge+`IPkpkl?iJc+k&+Gxn1@9EGN}o2LS*4_E?u==xVK1s0pTE;EH{|i-H^fxUJr?ELTm&Y zT%4oa#`OTFoX$0XDRigZ1xsREB7)_~`ZdAo{%~df*un0#5yD|izjx2EYenUh|MV)> z<0waX@q=LYygvAzK-n{D)Ftfe*Jr-=hoGAb4cTr)(rC09NMr+I8_<16M;nE1)&8`H z{YW=d-rk0Un|&Tc>-zl)M*=Y|$Au0MkpZCc?_~6{v^-oiXhOKO8b|1L!eJo7T9&NjBsQHYRak(864K zsfe#S2`UcEl}9&=#~(vDcYQvS&cKa*DhT;eUza1g#30wq5@)BU!pKn0)Zwnw<%O2( z1KemOkr%7cH>8V`hZ7giZ_==z3q={+XI+?dyj@piTL;0 zQ%UVu+aF@B%7r>KRXQk})%*P!2`;q2E5O6+Y{lJM9l`!XL&;XsnQAF#+P)5q9bj6o zwXSa>`>DeXssuHQC6vw;BDruz%Rv(na10i%d#-*X>X@gmYa2>)VAy(NY#CuIUZ|6x zTg25AwJ|E&H8LY*3|#J{?5hf&OLR~Pc6c!)GUhSql5j9&2hj1IxJB;hmcyktt&zAmbkrQcV~S3sIbtK3?SQMfep#;DcyUDqzo2T ztbh$Kv>F|h>otW3x!zwaHGzr1!{xk2uCC2V5 zas139WfrjM0vZhIX$McNp|B~QhoIjN>^Og5bK@{Jp9{XcVGhPV$&xTs<6{{-v1)cb z$gJS3W1OJ?DKPF~UmLLV0wp&52)YlrIlO~Y5Ar%=Wg6}qMmUSD~CSg$AcW$NX_DwbL0h+kS9 zDe=+M`N*MbGx^w5##!b-uWwVr$7bJZoDkvh@LZ4mYB!rE&y843!fs8#-veg27b& zq1OjuAP;-hXpJSTZib)a%r29L3jMC^+)b=--_@ z5pFK$olUN}JcvWFgRunPYJ!|GkGmNB6&(hFZtVZrMAd&4=5g`Y4=FwqGrcN9J5ubL z!h|g#ePBL!kjSL5KfG~%E5AsMkwrd-bK#&+om<6HWb&{PETclrVhTwKw`5}i!&<8b zxME;Ls!bkWrqdB`y;o~}EqAI#wxvLw$zS#21FgLu&SCmYr=q8FEx7%u!B60cFATe8 zhCB^S;=pO|ExSBe?mt#cKlB3#sP(EWp6fQnILVaS?+{1kC!h!J?vYKb6~~|QmtkSx zodu{}!TP{*;#_k4b@@Fi`EYy%J#-K;E^=RbWEn zItVhPBCaC76|N_fGTObyp}T-a##Hl$I)f2MnY>oXSk$_AbA~s%7gMi7QK6#)Cz3I+jSZZ>AKH_)bF+iG^g z?IpqXFW@&D`+s@L?|*^cZ2v3#X5swr@Vj%8t`%^3i+&50Dy9S^jl_(x1tc&?p^!rh zAB09i6p0h&cl|>W5_lXI{p-ZF>{Bvl)L|a!v7gHae3yXEa#|-^%s4c{oN>LsjRP%1+*O&pRtz(Drk$(I=!`a!;%B2$jMkDg8GU^}`+TW+?0WiP6@kq>m#B}c zc|LU~C6(3bS<}Mu*-=FZMLftP)vl@ixM5d)ExY zA$AeGikumZj`kf1nb`QaWO%_-Vm(IN})G?GhEyV<6f7#K2?!Or8#f99%|Ec;1w#5R{4Y!4+-ScO%1tjNYnad4d_AJ-ZF}96%uQ)ck9-S@W zqjBECYy`AZt<^>9HZ*MbZ%qj+SexAOF`-ARHs2WFo3wm922A z*Er9fa(~o<4Y^HlUPmL4tBB+@N|`%!5`(o=bBzEH9FEKJ8X`eWtXxwjC)a4rKNAL@ zTFQ{UG>SFkFuR}r=L0LL8e4Q5R$unAaQ*waK~>CvaJazS^Il+tCV`YRdTdk{>|5dF)pl);>4?8 zZB9q)hi$t15wk|<*JpwZCtuQoKSOBNxw)wY=)`^yQZG^u;x{GR3q@rs$++i>Yg4o9 z+FRB(odg+F&9bp5|CTI3fd?ybR!Eb7@dz2y{VwdOx-eYai~v`uU6q1bQjZNNb^8bk z`#!!T(brrTAW zEirH&ru({E0w0q#@5Y+n0i1;EwwY|$qN2_dPlckOjB-ws=Q?o-?4u0kZmW_dn zD=6r9f84y*e!ktX+k*5nf(iOOE`7c~j=A|g5B2Qj>G!<70rx#aW)=LnxwR9xzPIa6 zHQK)te7i2yKwbk;0#RP$34etJ*#X3VfH-dbSx9@kd}E> zd!I!7J5{9RC4?T7xVk2&DNyJI3I??l7Gei}7=&1rL+D(m#1e}{UWHu%Fn6c(ij&b1 z%T`4(eOJgE2U9;v6knQ+Hv5QWQ9~At+uNQ0;p;)-OFU{d7XjP~n+% z48yTahSwnoIEI25mDF7l#*XOs0S^|Ky}Q<9^nlu zb{l~{%2zfny%|9VcQ@;)30_Ac#ktZ$1FDWd-h1=A5(X6>IZ)Z74S7!}G3{>YYX zJUWvq1{F;@#ex5lhL=d9va$>!47p$p4iQfFgFZ;AoXBE@y}f~*Z~A(b6kB*RD? zEo2QYhQ*st5?5krhA)*gfOxzzpE6gMDfGCTUr8|S)YblD-fMn~;CAvAPY&fP!HuUZ zdIbznPsRKsTYq8)&u`EkmJr=IMRC=Y(;kAzqu+lZsEZ`b7@Wp?8bl$7|JCiN0W|Qp zf%ad)#pd-XLk9l6VzX=}N72x7(bW+8WS(W9pM(i*2#kpxpzQqb;+n=Yese`VOI;BT z1E6D7I_g4pRZn@s^8@L8z#$^YxGG*CA;eQs0r3k|wl}Jb2xvgf4~8IWOY){W05TA8r4FpK$e%}}(F5v3RKoO@!OBIgRzR2` zM9zrI5~g`Lgr3mot#;;5w8onk$^G%Z*vkE8uqJ`rS=@&U)J7Yq9>GJFAZEHSZ}<0a zDtcP!P{p}2A=Mq*&V88U_7r-A;>gEe zDC?iV=qe%5gk~(fenI^$IqoN}8?T*^qT|5EBnCv+gW`JDPf#tnn%3Ez?)aQU)6(MP zk>;ZB{Ts0l@H*7(yS7IFm{EeZwf4aLCBjIrBu?VDgw#fr+4JON);sKWl1tZQM(YCW z;LaRcm{V8uzir2JwQ+iYlLAp1FU5qsw4~>wkZpJ;fln93mw%Ul2^ar_c)!w^v|gI^;KL+U3g8XB3m$p+7=fndU9vjoA)frko+dF2pE9r~NY)dQW*^ zJZ%gY|BmA{E0?GYKkTmku~`JZ(9k0~X!ySdLV z++?U`l8}F4zLf*8JWb%==1VZ1RI=QN|4FB)r3)_c>H^a@Zw5!c*ykAMc$=3{hq6U*K(arvC#;`~O?+ zW?}yycsrJ&6=mWb;~iRdF$hV>es?;8go_m)`=QUC6i1updg~S4ZpqyAC0G2`mUw|} zr4+~~8Mf7r z7FA#>SxX=6dxs+0h2Kw4xnvYMh{113V}+nVzaf$-S&dmF8vBJkS4$L^J^6IHrdmm` zLW}Qvbde_@S&Jk_D8qIB5cg5!l+*$67#pa>hlWas2#fnQDITn1kQH;D+5w=xgjqB# zBxWUry?|PTQKR^T;I^$7G?!0b()PP-TbR(ca;F^Aw=yz-&`*7!|Fz!<8{3|M9O0{$ zyCR=+FW*;KBVvR6&;yLq3UhOlHUOFfG-3JbUVG?r#!y*pfRL769`ot@^x-XY{x^}z zP%p_CrC(>qW9EErtGGE~7-gZn5VQW}*GC4;1LkpGr|ZhdFxav+QK(fAgc|y<881Vc z#vLIxe?sd)Ivxjlyw`OXf>7AdjZq!OU_iEwl+fp_?NH#WAMx?^Q7c0z8#6Tg0eOM3 zz^^emStlWBhuGm+Cxx@0*_37ZLHu$P|;7omnt{M`lB;jYPGuVQ7;?k`Z?>$n||#D7eM zxR3HoMacIpmG}Cv0bl;yBtbpMrB_>c^#S)eY@N4*ZVaWNX6#0fr1~xBVI!~u?8T*( z9d5M6gnRzjMoZxC*hecC{aBPV6?fiOGuCPjD;K}0ih6s;2n9?FV4)@Oj$Ob|?0}H+ zgB7@$B2B_*Kj|krn|L)$U~l?NAZ{c&fz5AL#RiE-Vp3&Ggl|O`*sM1S2^vNcA2ckk zsVRQfw^ixUR)`igGXX5YEEI4<@&K7HZ=3)c$a2wB6j}5loVaqT*5Nw4k6yhjD{iE>GkRqWoTn+xrfEw8JPIpF1W|Bl4!>`jAl#0a+Qn~~rlj;7% z{V?df;nP?U5wI|t+ z)+~z>rjgCUm9mQ%H1?&RmiA698!#2T=8vcqT`TlGJl?{%6ydU>{o82_P~ z_&x&}-2|V{2WJXB0>Cx^#ND94dX%;Qog1;8n|FWm zmVH=Pr;FU%4e-%5THCpM4Zh0ad>XdGRE-jK`n-jkzQ0%wM`{bi;IOFylturhVPdY7 zfyNy!sQia&^@~I#WIaTrS7~T--Qu) zFZ5H?xI3KR@k$2}n4HLd7YbXx~XV8l{d-Duoio2OWB zJ`+LgDu|1$qZNQ`Ik^sk!|1UxX{yKXu{(kWw3_)z{8Z)dRm~IgZqPnlN4&qb)w>Gv zUWQqJbQ~jHY{+OGzZ{&cbILsxryrc#|7la#T;ZT=Sc{`N|nL+DUeFV~DUjr5rhfH}Kz7ndIkauHB#C#<}7XNJRp#Lv_> zP6>|E1t~$s^53-Je*nnpyx!Kp9%^?X&5p|IJvjLg=g!|2=Qgrg|HOS3r&o{B2F5*q zcNzfMRDS7|_?zC1<5@gD%lhOwy)ppI_Le%*uPzm5!jDYeWJ|JH9sWW#*)lr2!8W;uki1IGV$EajEB zxqH`y-i&q0kS3c?>49C6mYzWUKkZvN|4M9aS7?Yw{F0b96>`D@;s$5tO8c5wB;sM| zs1)@_bqs3QnAnp@EQ5Pg>&IUwIaBmc4J_(aD5!8qj4_$p!I1#v%|*OfYMXvrut6FMCgqUKplYR&cM1LL*S+Vw92Z< z0i1`by&){3#e1}Fc^_kW+(-|#t=I{K@+fpzeMo@z0 zhiT&Iyyif4R{l|k4yX?E&{KUKe0a)VeL#AF`fQi5j${rsM*B=K`%aG^6s9uA*Mo|L z+rDWoV+7lfM-#z&ffd%euiW@&rKI+apc&~qMH8_(b(M+Bg#D==0m{fl+sWkuN6-qB zFc2pGK6O+&Y7$98}?>@bcpCr^S6(81}FIHLI3VPv!E zt!86(46g)Oe9pD!5XLLF8~GTXWWwDNe*OuOjA7j!xvKb5700FLo|&Y zWlb38pC%DUpAb)hznNiw8@~HjqBB>#WuM?Y4>AP*3T<=z->TdHJGq4Ee~?Q$WA}$q z?(Q+(f~w5~{QJ3C4q%`?0uh9@VH_`m*LX$!Y7saZTfLT<4Vzh$`bmSHBgaWI=0cmR zt!2Hqz-j6_EF+so>Um%+We#k-12UhWG8&>qocpht&4SJRVAn$B#+SodL^#k%W)g2Z}PP=ev}mYP({e@JrqyN zCXYHjdL)|Y4Qe8$E?z4>K>^HkEK_hWWd8==M>0Q*fymOv4U9aen6OOSi1QM6ybl6? z)*7{qeser2oSfx`ggAP!1Z7kA7MZ$NK)ITz2s-&XH&h{UwVe@171VsX7doka=r4m= z5oHLWzA6JyBIWfZgvx}N1cx1_i0rH%q}%}1@jM3^2*05un@#5k_wiV2sdQwVI(@t$ zD7rKpjjx)q5E0?9io1NmAjVLUlRgWr7M%yeA;5nLn>+0ePNm6+YhY}AfeXWc^3H=D zFW?6|BXw}kW~hn%Ez{h0y%qOz5A$eMqqZK!xx=>Yt@QE8WBH-W6F0wD*Z%BkZxta| zSO|Yatd(G-S`~+=|K?NYh|!IuC6#4Uh8}XB3wWE$uSML?Tl{{GuL%H2iS!EYz~vld z-cn8QBTmA-VN?uS9Tv24(BGP)b8bO>#){D6tOQj01fz4>NpVF*!&@ZN3n3^Yji8K4 zIY%Y?qYnw4*P*I`>rNAQ_Rd44rT01JIB<%hvmIOOx#sNgLCdk1ok1$WSaH-23+f(X zC{3495NgHHikt$pLtq7vA!DwegwXp=Cytgie4JK_kbPYv6xm`F+X5$XCtc6#s0$DD z>To%4G(*`G&k9?dBMh}e{qF?z92Y_2HWJ7 z$ATLX>n)5L4Rz{;esFCh^Z|t2dELIR2amuV3hwc6Kf`@~DF6v3Tc6(VH%C36 z@PfYYFSmBBIUwpEf7#sw0d{^dPQ0;i7ehp!*C=9GLc#vQS2aOT;KT2cb`GOg4g*iV z7EkDDA17O%zfC&yp+a=vSRr2#>PNwgeZ!)AY~u;M{6))X*i0=-Qzzq6c_0%Y<41(N zL4WH7jn6U!`6n%bQSC9?>%}oWO9|V7J>-j3OD`lQX$J)?g8|u~+O?1nyqulU6uX| zDQkl6MuiT+U|36?)SqF4>n-Qch>N^2D_mK2Vbl}|?-X7qj0vF> zYoe#wJ3sSPN6!rq32Q6lo+1EM$DT3M0x=NFd*>Op#^SCxV7A{|Cfct4MMADcWi(j) zLv&5L`mbui13IfN$OebQx*#}q9v-oG7B^yvRDH9G<|os>%26qZ)l0(3?8ZQ)#_<;* zkv+!762-qZWLTNDHn6cx&N(PY{h5DpK{f)c7=s39_G`JU7T_ACw4M>`F+Sk=oMNT& zT|3rq@r7wON@-mJpNVyIBUpNkIh-3$V9Q8%+tBxjOpBeP90e{%8k{i)Tj>3DVB_(-a38 zKlzso1l;|ovMN^yyHcVDk!5wj*C_5?#PjC+eC7Kg%{+aSsvXV#Uc>_DtDL|Deit3u zZ4GZwvZR!Ur+Au_qh088jl2bf1$%>o;|Fjy1kz_YWW6N3+!!(54&vy->UVw>tBXzM zMDr||^qG`kGizylTa0=3N4Yi#rjmdKc#ogE5T5uZHLbK*A;~jw9xXL=v@#)k-f%(c z)dksvU(W<+);)OQhtxERv%CvV`uP%YC_`Hd@7WoHVJ7iyu=|1!2BUzdw#SAI%s#Is19ZT{!6pd{KV#^~b<~@E2&Wahz;5BDXRg?8-r43}U^;2tL3Qj0DZpK4g_DKGG@s6vr#@ z32dHm<|?q}UY+u7EpQtRZvPOK&n1BDUR z@>^JkPF>=s^dl4*tuUDJWjE=pNsR{!bU`Ll58`RY%Pb*>W+{IY2PXHOy4%!Zvc2c75PD?Lys|3 z3JLsyGs2Cm;VFLyJ&+RD0^;a!ltWa>ay>M;CL>)?DwJ;EJbnJea9@Ur$HvNI{s8yy zcAc)T(;)tcO{0fiuWCUzg`)%DF%l5DWeh@1RE_+HWlt`6q-yOvxPdY;=q#NpOZaEm zrNHppvuK4xo{hHwCYOI^Px}ykn(RQ@Qq6r98!*qv3#_Csy-bAtwLUkm*+%2mu+IA- zb-CN(*5BZNCpSJ%ia$UIIvDz~=c1f>+xMKLK_*4Sxp#kmS-S73;}+ z<*zRC>w zS23ELZ(fjnoO@oQgur$~0_~ld&68~F}Jfeij8H)bNR14`A-e2A=+s34tWC;el2o?mHI|elY4)*`kKAEgc|BV*% zErHoChzU8w?K2WjMGYe~m@OzIS*RR)R)Qj-!uGd-ac`Zco{YaY><2yL|d$ zM5@I*(Y}_hiK*8a6TxNsbDMqf^1i61{`TuhJ zK*hz-`R|f`e`!0+qW=p)hm)1%zb(?8q6Mp~dax?E$K(_nZhkt`dxy|=W$5`$nU-@M zZ4Q0FLbz|52o%6RKhJegU{Se1@~Zmg+lew6KkwM*TzxpKv6Fs)+N zv2!cV;K^aqEB8_BbL!J0F1o(nz?dcDeRiToc9A~4&HP@Z)nZCo!_<~|rQf=begy81 zmIOW}TG%5hWINZeDOdk+WNyJ$^s>TB_k#XQu27Fe4B@ZkVPjomd@f#vyxsG+^}_A= zbS6QfEtnw(-a%gZELO8c@}Z;boFgsxL{8pp5 zMHSBvIygjx6@ndt!#1AfFnsg6Q#7SmQurSA?-U zQ|k7;2FXQQwXM^OkV~Aa7OvYV8&rg$ypO-4u}-%3tF?c|eYWCw z;GnV=6DJxF3#r`|JplO;OVA7D^q|Y}Si33R<=2#BfoJ1YJJlhOc0sxPW7%hsv+7FC zYjbnx!=Oj{o#&Ps%Y@56?HPG}dm_wx1mPF%=BpV7Vbz1}_l5CYX^`Sgj7l9?S2 zq^Y;zpncN$4B4HhGdy>@CPVC@k_Dv?;TNJVeN$ApUi0CZAqtAC04ZBZr>~-NvL`cS z0vAysAewpg-1bAg&2`XRhO&cC@dBsJ@N8)#XjlLpt2b<1Ji$=yP9;+;??64E+rVBk zYlI29c!DU1W+n*hhQ0MYW!wR$$~VptCrVz#$cB!FvZ&mB4G)+h#rx&5<{Iy+a@+#Q zOSd@2=swB;Es!>Bxc5UzSpdhXE>neBHxVZ5LIrJFM*U)z#`Ea##e4?BPN znI``!F-PR}7%ctZGcsimDH{_LfE-R8PAiqt7kmVb)&o8IX&l{kps(Fn#%2^Py%^w{ zJ{yY_H!^T_4P;0=l)gS(pty*IwyY86cpc4#*~gy2JsJ1DNn1(Tfi5O9*y%F+)QoPB zQKRb}lx*n*$?WiCbGooy#XVb(`LsdhxnS2i5spTu9h!@N=eM?+Ys%%-Z@i*J6mVBo z)185m3}9_!JiFf}Xh7||kg!;ObIMl>Vjz>N-RoHC_uj^619{ffa2l%Tgu@Dh%@5hW z!27j*go8awPucYp7v6uwKwmJ{Nl0lT7`fH@mtjN3ge#S&R3JMx8i%)ja-o^Ajo z*lO7(7;O6iQ#j#;a~JJu_zy0w$1gR8w&Z9bhNe(c5c?DDkxYbXjlq0CJ#*3ku@8q0 zC2Isg$-Ef~+}M7VbeVQP2nDyo0lfjs9%GxO;sb|Ig+BJjjY`ef0QW9LHyiVuP-|^< zRfUGAk+ZEbCXSCxNRd3o75!8IRM^XL1q=x+LTH=VtY1R~RG4XsO8p9AOaY_=^G-xT zV6p6CE-s6z_=_K!hWYSUu(0ssGA8z5)e_8O`#T8?oMvVc9|hcCo?tbJ1vtp~3@z>O z_a3DSN>LZDGAkB*5!^%>+EX|@h+#SI+?jZLag(^Ckx)xr{~}|~X{}h^FCL=yFX!B{ z%5&zBoc71+tPbPc}g2p z2{lb(5{>S}KZa|-_4GQy`1s{O!;rEN@lnd0q}1<|T+|vGcOBc)t+l4+@~4j-G5$cp zim(}*&+T?z_+}OqlH_wZF;hqnh)@_~9VW}CqR#H_9BLVF^AnZ63{_!(R87t!yH!V4lCl8ZVvgC_S z*5?NeAo=YjB*{KaRA(qIB9fZ2D!Zu{U&AZ^$4eW?1?U3kip>yjV`V_6)7=ko%k&7%9aZzIIitxJg%}XaaTyM9ZTm#BiPOD87PSkJ8-JLGBN{? z)K_6A-xJW~DFRr_n>!e|oAj4$wev71fzMZPP(7sA)UP&g6@NAwuel#b3LnEWm&YA^ zeCKwSLra#vluI;AL$~g?5VeDF|Jndc6Jm!jwZ4BuxQAcxI%^K477Z1UgD!89de|3A z`F>Ar6TAy|IyZ|WO8wQW4-h7LlW&K28RmbiyrA1#Yjm2da5p zk9rmk3U+O-b;oTpnK9Ykr>^4-lc&WEq{|0Vz&FFWFOE6FPE> z*()`x(1oU+^3*lpg4w#z6wGmnu#VAaGI-Qjha}(b2LD?0ex7CA<_XxfSnQ+pyCEbVk_ErqvlTe|LHdumis0|4}Ld!|BnmLKs`bI)$emzaq^y*D%H0 z_fgeL&vPOe_3uBB=|d?EUIuQK)<>ZbG_l^06i+oTD(zrv>wtqkgXy0nJAK%t;E8}~ zr=(N6%d2reH?U_6r-oJ}Q1#@k=mpP^gTM!CHsG-z@qtlWELc#QfhfFNxeL&{^hD7Fi)wQBymg!hgS&(4`TYitU z(QNjb$j}<*e35*n`2_l%IfA0^soj`MY0C%pBG}cvsOi}#mYVZ=Z+lhnvQI9#d`kF& zb|nHbU~r)>N(YtAHg!74{rC<3G-5r^AkKO94F`_?Q$!qV@-#80nS6|1yh%(J@4LPc z40)NKw|oXN7)dWcv7+TGnXtD58QUd%2-khwOGq>&Zv<5=)t*uu!*C)0YHF#;V0n@`BPTg!l63GE7eM{jU8Kv^bIXex zDBN}2tSmw4l+R86HiS3W@{*CD);Lbmt%a#m^Y^MET)twtZNg?pbVT$pC0ZT7W=F)R zGY9-;Uo444>E*b#iioo~QTIQD^55{qOKNAI!k6I4I_#- ztvHQVV5Mu|jueYHzSG;lCm6p?J{yzRz)mjvN_e#Xx)pcfy?j*cPTpr$vL9e^R^K&d zs-~vkTdG0mBNu;sRL$X)$BhaMH6g=T7ZX%~R45I!p}&2;)Zw>EmXlEJE11-|?wBvc zuPcx0%4+p7m?DH%X;DC5G(wA2-E}V0*A#h~;2~~hDI~mZno1xPkRY@wOdRuKPQGZjc^X5#C9aNy(Ku7;&9DsxGd~^{O_>PvP&!S9$_5SUF};ya){~s!L3sD0H8dPZzO03B z&ImQMFAK`nZg!6e$s8XKJ%=+=GliURZ)6b>Bnk{V5{9^!p@c)K@h$c2{M( zmqcr!QXpIN>#p8NyuonRHIumFpFL&5PuCW3Nfp=eciy67DHjMHINb0;$IYz(uQsCB zoQbemE*CIJCsCQqqnG6Gt5a{iw_uX9S?(-%Y}<}p;H@`;Hhw)n&b-IO-SHSCoyV>8 z6WIZa{3qf7k-O{-$1`r8u6`Qej4QM2_S2RRTMno- zA~L~av$7I-d{v4`n<1J?@-6l5VVVbdoGM(SIH1vjJvC=4#zmdwgcO5P2~2wt9wo5- zuB&Z!YSO3JeW*H+w7D!ou~SvWU2_It9oAjVM%Qi(u}RA5ib=B_W7g0eh^w6W7L0mX zd@|0zL%6=KEEj4l9$0|dW;tA;Rz#}<+wOpF;vBk9K4Ge+d0*0xW}X@6?SPw5ZlE=m zn)sxG_xOW9(!H)zN*_%tdm0_VHk;CsupXrZTK@f)Ff|FM_dZ5((ro zythiJj})a8PYY_Po8wt23ZBw{k(;hXx=8*yGGP76 zBm(oJ7T)?pA9I%It5$EWA$R+QkJN3 zeAmk0DSP)kaO_t~Rto5gcs%OQH;(c1#Pm<`wjvUnCNDBa$1N0t(9pA z-Jt!oc4T~}qS7Js-m^M=*+FDZjEgzF$TMZ5Y=m6jJ>uZao*_eQZpoI!Q{!s+qe>^3 zxl+8q0Qdx~_(tIRpP#^Oy!Gw2l#93p)zco81NVyn%McZTD^%z`rp#FG>*I_xfXQGFrcQhtPEJjcCqvYlG z^|FnG(R50>Y)K~|en})Cbu5rTrcF6muDVt%iQk-Y4s3;BZcKS<^&*Yy9#eDYz1+8#njEOsV*!yH3Ux)NHs1P1Iu#V{T<` z=;pQxTK{=9u<2>0F}&Y#?qyCAPcBTSPrC(17#S@sQRIl!DHE0-&mmOW75U(pMs5?A zZ(vKyJ(a7PtmUMUFVhJ3kyEV|PBBBfzH~ZSUy@4YvJd5o`;>sr=4h@Jt)10TiKs#_ zXlbo7){$5EHpgCBD+ijr$zZ5b!(=v~K9#It?rmR-`6G*8ZV2*;mj(KxK8-S&bb=g_ zeW#M@$L*p>Q&Lfy38VsMF*V!yite?to8Qu8ss`{+EoXf?Wm%%@3tzV|bkt6g-CV*d zMvIu&i<8&J^OAgag?XvlD>zP@E?{jtFOo&SMIsfCeM6{Ag7Zt12z6k1vx>#xDJbUS8`A>g++p#bq@X``Z< z;I$!>E>E?85uaN=vd}VXJT*o~Pj^_SfG7wqz~_rE@Y4fLx5XAR4d-<3cTUfpQlEtW zRQ|$+%q!nV@~6XPqWkx+EpSwIO(D4Bcq`9EyGHujcnRk`ccbK6}(U{<8;(OmqwjB(^w8mjZL48 zz_CbBSS|~CMQYDH?WiaKOvWN*qO88uF*>LplqfFRY$p~H=OR+O{6EIdu~!se*|vMx z#$L8<+qP}nwr$(CZQHhOKtw=Jq{Vv!}?v`_MU}A&R0$;@y{3jSc7Hh4yRJ1=Z`M%`)}LyPnM-`x>=-NbM3C=Z#L{N z{rnIkGH2*Zo@BgJ-A-74(y>gpY)QO2qew!((OC948;t38mn=F0eL^!AI`rBn6s4AO z%Tg0|CEcLr9HIh_)-e!fe|9DeGN(HP?Kmi742$^OS6D_IA+!JLn9vT$D&?gsE==Ot z!5wbRAsTYY7Qw8-lxyV1{%rP#w#d=9j_KcfaNjc_({=s5nOytgW_FMGO^IeuCT0L^ zWE$Jwj^kN0>Xb;#x9ka+MsHag8y%TZDgC3}F>r>5ekrAL&3&Vt@>TYRYuOxha_N>w zEhHC!R)=YHFVs=54f~Uc`qS2m>)~r|fA^=eeBeZ#woKOJ1E(wMA<~i?f3%s!rqZ4r zC7+|C5$~G;t~W7Pj3@hX^p2q= zCvCg+8LSNkz;R%_z-2nX&s(0joirPX$&i+#7P`AV9lMgOVHlNUkX^}22BVwz^u|VB zM;Ah+WM-v`nD-utBo^0wM&Tyu{%|=(rQlQk-Yiup71SE?Af&B#O*!g3EQb`dK?bCU zB16neE`3^>Que`&`(cW8UURL_mdSZh3zVeR*a2r8i9xnk`$MO#8q1?Umrue&!;_-2 zx~Lr7EDe)Dfq*N0V9m0gWfv%choJ(7K$RQB)7mf}}yZ~;E> z7kdn8wf5<=l=l6#+R7Xr?b$li4@sjXVJ}`b<}N#)h}AFoO&g3s3YHN57?ul)#2VIO zvIO1Y{ta`VIpTg32)O{fCr1+QvaTikfO8)-U}_Agw9J}AXZ+1w51XY;AE)Uy-b znhDrNvVU-AfiL~xGk-aV)QnC4@t=k%1`H|>sL#iyPz1J~>cVT-2Th8vio-IJRp4RI z^Hz&7oM;o8DF*b4n^**Tkp;fC@#i{FNnLppF%zlfp9L`dx++H1_(PK#zP1;75zA-C ztM`0F^w4)i_TmLY2M)fvE)m~q3QImg%<fh^0T-q@8-xZqj39r zzOz@DC5!OHv`@R#RS1)HBi3SP$;W3nN!=%9bMGyQ7&wV+&z;Ocv7?7{P|$-ui^YNz zqXPo9s^i&44=!%z&o|!koT>$nSbS57lN>Ga=||Jrd%-o>72TZm_}q$iQwniz!FBsG zQ_1CvgWxrWc#xNd*d6SX+5Bfqmp~laCWyjN$7GXcdWFutW?Gp=%{?4jlaKgVGqc1h zsh066a4Uf8;fNnIi5YI2Jh9RLWHm16XcBdt9KKWp5D>3tOlDZiubk@jWMfZQTz^2e zuryX&d6;gjM|y*P(~8glsQ)*`lZ6hC4$s!W0+NgC|08iSGSUC%N|d%jzfIu3oV!O9 zc9#s2gt`S80WoUuaKY8`rV5v$ekU zBumb1HMG!7j1jV<&(x6|KLx@=j>da#%=z)*2Q{wddocG z;d>ju@prA0W$&y!T4&BWA_z1nIGTO7bxuvIjD0}bv1@CfmPOSTHsfT|icI?6xxgGW zxP_%sBqMPcn5YsJJxlLkynQZXarq*Evy)w3`cN&6XT?oCg!)8>9{U3!$k^>s{qwpb z0?{sluYJ2DPwAj920|V|sV~I$G^Ab^w`O82{G8|8FsO>o7ZOv}`@zjZIOvlys+Jnk zQ=$QABXt9bb`b+X;FUx*!VN_K5dvskLTlx#_!(5%$nS~R0EO8 zO3GU22%;oaJtmY(Jb`k=QZlThdP`TQP#?r%sVp|P-ND=aBG}BcBizQ#MT6lUWGXzZD{m_N zL+CA^r|;_Z4gNk*=>C@P zzaO{Y=x^bXxu1P9*`qEvr=Oo7V}e_Opfz`{|IX)kGWKxxO~hC-blO#4!kTgCqheo9 zd?<8Ldv3UpCNHy5B3sUGC>cVQrdNWiAYG2U5L}n@F85LLok&TLvz4QICV56BF1{*j zEq5&gKo*550+kOe$6u2B2YB+fKx59r;Eyg6kuNN#UsAKcV$R9nlP)5WPb?>20$WnD zz+leK;P)1rE^1M1EN@@pvfyd<`$*Feqb@*Ilq@S=Vz6Lu4)_St5U(y!QM4rUw4iQ| z(U7&yV^PQ~n_fbl$X$?wNK#~-h#>PCu;^Uo?f9nXAokesc6nV~5k9bfViOsvGI4o6 zn=h;v6`k$j9({VcdCyyI(>d<``^xfCf9p7FQa-)h<}?`db9bo5*)Zf9sbFgSXyqkL$M;9X$oHIB&27=CMZ<+r8wR&=JoEQm=E-b( zpxnO^g@~l6nSfy*Zc<0ygPSw-kRVl{`9_HCWmBIkT*2*1x>Y#JkxG9vy|D9@1JPDYS$k!k+hf1{o)p!@tIB!H;hBm8(lrJ^Wg=$S8(wEmsCk6N`fR~jf^ zw7(>7HW$+sz-t8!iCaZK-gj-{btBAN6h$k;ZU1_y4b1;xHv)6^cld&MHrmIlbRSq1 zvRVB2$0p-V4;;kZ#Ylfavheo^vL7>cBlOpEr|sU<)(iUb2*-yr^Qy50fDtfq74EBc zi|dEXvcLCp zfu#&GM~C*LFsh|Bm!=}&&J5bY6w?jtGQ)46ug}lUwkF>&l13sm4#p*2Pi!8A4#tg3 z6J4vrP}J@&2D`XFIk~tvIjgR-%8k?l^J%FC^f@Jy1`=!>*9_V>lN-HjcAb(7kFE|c zFNRUT#>ApRrgkx&X+^L}0+c8GF|{@<8U&^+eF#}uVkNp(UKY06_mQ_V-VLReR)iE| zeoe$_!OXd7TYBh}kP|gH%rUah3_6eu{RKJka>Xo$t@cu>30f9amw%e08y_>_y5WEk zS&OL5a47=)tqi&LBhnK8;EWC&hB|-?{QUXQrD^l?}Ue8>$kmP%gnQBq83G*N^Idm zmH7RTjzY*(ZHbf2nh1FCfI8B2gubUNdARzi2sv~mO>um~$(n)gSXlTNg%c_;sU~BZ zAms+0O+({Mmyw3ckJN6ko|$LRxz=+$In~=7!gq zT6>Je6KQ~i4nOcbX8hueylEuL1YA`9bIS#cg;~(nPpJfHhfPdEiNr>uiA@h@yb9%{ z*;*fj^U=#My-|MQ|^3CR1+UFLp&r9F_oS^ozVy|=+|&5{-mm6~AMb~zj5 zH&+eODA)n&HwNT5vns>(iYI!9zAzD`;N`dst}>^6Y7=3lKSU*Wn>rM;*Q|ZRuBGjz zCZ>K4C&O8z*r0+Y?^RB>V;BpSD6p+asM_ONY*cvW((s`U#bXs>UR1{Co;k}{gTR(b zjo$Sd4^~UzbX5k6SK*?KneNXDePXZrPgo}i>C4h;mZm$w!=L)EC;D&el0j_ddVtlX z(f)xgtEw7q2tg(+s&smGwmAErIA->v_iJ_eBi+{g9mDkul<=QEDJXY0A<$LVWo&ap zF=n^)p;pevRME|!!>{K3;x)OisU5TDvo`SUp>QfRK3sXfPeM)HCX6{WzDJir_cGdx z+(Z};Iy!TTzyvp+fdXZ<1_am0VS+Ts#s<4w+4^Vkt=E?YDLsWm81n{I&qA>VcSeRf zJ7NEiD&ZAM`CandL^7xD|_X8vqgDIXP` z80ZG2bA)rZId$@cZ0ZRynLw*fEMXm@RIwu95dC>4bDRw8?7xZVNabPC`*<{9jvnkc zuCf@}#Q?-~@eyTc=wt~*$~d%> zy`L!x*fEr3@&93)XQ$A1MaF2Hp?4yqaTY>RX-RgRINM*sEk0`N z5l=yFv8XicEBP3Xyb`8x+HpWNXhlkW3m z`7zqDe2XDmIFk=TGuyFrnYop4Px&AJOL$PAGAt0Oy>|rW=Qw|VPU$9c0i=nT`*~qq zQjNUxhVe!8sX zRkwosj>zhPVnDhhPF*jRopT$?<^qhpj&mDewhF91jmb3g1&0P{UY9oBH`dV#fcM-; zn2lY+1v}~FW-OW98BPujQhy;d`tK91`~lm$8=*hmhpkDevw& z;4+w-LtJ_+RW#W&S^5sloezCI<%-vXyyow1*iFLyP1t*!E-EbC$!&CqX(g{(Fkn)~ zaquIXak#UR!KRbWogf{PK1Z-V^dVnS#Di99}vZZs+`Wz{; z2LR>DHlDR#2w02MERKqFWpV)+#TnpTkUhey7El#8?YjFtg|L4&{Xi)g(Rn9qtLgR^ z@a|_4SdS??TguY{*|9yl=YT{IlZh4gU-Hi5clKzC{ue5srv=ep*#csG)ZD8zn&;y9 z^eG+-dWA>sDoz;DZ6BdY>9cCgmQWn)`n8{X}Hxpbx=hhMl{7F*SkWvxGnfr3JqyUG;$j4oTeI4s zYQ>poB5d&oOaq@E0CA&ij>kYr8?RL{EN8g(ZCwx91^=Qm4o!(drKQ@MWU1n5iA5KZ z2^1`E$wH}jWpo(Qe~mk6yXQ(531pmLx)zoO0vC7o*_+5ojO5!#AhS>p&cza9qc2D6 z6|N2ILz?Wq|GAHW%%ECNxcIMOgh6iw@0y6l&Ug6e2wWz;D;3zj$EZnY)!GN1BQT+R zgU2YcC)y13hx>i)*vBVkuf1I9+UX9K3RZf1RXqC1KtWF<#lXvFKdFl&?*^Us#Fru~ z8=H>z$;uCn_r=XF)qW_XjhY8;`!=CJp}?s+F2*SIdPhd2pYw;G_SDYP1fZl{4%Y(h zj`e-Kb*tECD?d;i+&v(J{zqi^mc|;^%~jhp{SXL`f!(jIXq-IX!=~xnl9oeO|F=nF zd>x9HZ0PDBK0L+B&%wuoV5g%+xS&PLUpA9ZBHGaEsitc}Qu}Na)OTLmhOTK|Rdui8 zPhQoXnT%K-#2X?;&ouFe#Y@{1F7QkE`XKyS4Hj1VeP!F93k(Aa=D(}mSMcORzZ}{b zG?KYFA|_1&Mx@X)Miw}P7P+xC^|YslF}OO@?O(5M+@B6Xr`<5bvC0kR4Qk9S~CSTh5m`vHd zxN6gZvrwoU68kI0?(Xi0ACC|BkVfK-${9Gp7$DilZ=>BNEI$-H^9O=F(&o?)&G%Wu z9fh(5+fU(*QSV#D{-l^W<7)-6CBU;9Z>%h0I&Ax)b9hj-47cpYdJ}L0f>BgvFtRoU zUxS`(Zjtupqj7<)?~}Ws1u z?@O+AmkMu6t%NR8;&VvL59%T1juTjV4P#6Wvs`0_1DZ;g^&3R~GdSLdKH?<0{2g*N zj8CbVFTFmM_;DmROUGT1{z|39#IH|C*5DpC+sm>(ykEO5gjT5Kr4rUTEr}Cpv3Xk8Q~U&#sDrj79c4lQ3nN-Nhw%lQ;deTAhuI5f#7TYN z>WcrY<^?%3uKD*$J((WF1OPR-`e_Rbqt4{{vxuj4mWVI6DKA4?#jH=eX+26L9mWI! z!!Fnx|EQo1-8jA-4?GqoJ(QQg-sBaF;gI`7KV=q-fsq0lQC9vf=7=Ou$UfCmjXu3~ za`nUz-4OMYu-$od{4Y15XO}^!{8TfcgyNkBI)g?7uIp%m z+i$U(Beex_&$g0d!Y52mrryxt&q6cL@?{J(X`FWeZy!=Ulna02JyDYgNqEPf)d`nu zw;an-DznsLq^Ooof}ZT(^y)=Z?Gp)V1KMXTJJ(Spg*H~EXabt!x5_Z0)3s} zovykUSj2(n>jPhb4|13@pOq*qXRoLGta~-!;~>t^>ZUJwOy2-=rmsG&f=*u9K$pry27l-1Lg-9q|u!#{lRTkjr@wG` zGo|B7TQJo9!{ztr^g$f&?fhirHq8RgmD}6u+h@*ojO(_v_6^MT4VCey9a&zI;I2u- zpy4RD!iPU@0CbC;4iU8luKYKzTG7H+pTI` ztmXbw+HNb8TndW-dvr>2Qm%5kijH!GX#8-&-^UC+GNOdXx7!K^3I~k+G*Hmz`<}J3xY;aK(m*7C7b1+l_&cy( zc=7l5inpuoUv{eg{wc`y6ZESxgr(*pCAZAgFcDVRJ`XS3#@;rKXT%Yvcva{EkL^#q zXGsV)ymxDYrxq@pBRU$}*L>4-LH7C7Op0un|J2=T3k;#^LvMrc<#f)fsua7S5iAY% z@cMi0OCXSch81ZNE^jNO?fZ3jXM5kt@bx4seM(Cp8V#wYw4j`M8!=CW*0c^l7fcG# zAGONMZYts}?Nz+~a%RZ15fsAA?T%#>{}m{Z`mpXSvh@v^2M&6i=f8T(D+E-s=LBmq ze83-QG9LSZr2#S}qI+u106qq>XpY82lemp@Qb-_WV<;f0V{9)Cgw8HSqh6U_LWlay zxZ zD$sOqzhRXAYH)!vw;$yMjH)L*)c(!3w!d-4E(iGVeMaYw07(%+TGD4W)TC^?XA{Xw zpPmY2mE@IVRyJ9=PmBDmgaD<%z^F)h)DkHfs%sz+Tw2^L+6UfI8pFrLae9M*p|LeS zgtuql#Y}w<{b@M;**F2}%v5LMfR&2!VJoK3zLPfA%OzM4HvmFb(s_xTU))0!wg`EA zZl$Im7hJ>IplTJPT=%%8B%J6#SdkPap}%SHu?E4^ zie)-?;@Xd${1UE)r+}xhdeMX=4k9Ytf5;BqC65q~J~B=yn}-_82~==efAWPf$924F z<8ULkEK|w>0EhPdALD=T1_0H^gFZvkR@qeK+*Q6qeTk>Vn`6^|NMB86OqnJlK{Zf> zA3uq|q(lt_5?mj=ZWG^w?v�C^x_OSe#VWr5H@`h6aB!JkbFvvGM6xPG|u5q08|; zX{H22cFv=+GObxN$N+Wxpr4Qz>)OvVV;&>s_BS=T87>+OA2e~3U1+cy3`ER|P5_jN z;S5k4=ric*WyxmV>UE>w)hm5FVCmq6AGNaJg}T6n@&}WpwWsR=YM;Kec0?KTtW^V- zjLK#a6)b@uEltUc|vPJ>d7T}w2#WFMhE;xGpm#3Hw!KGGNyndM|^QW zVToPt&qq>{*2syvOKR7EX@7xfU|83Hp(g{T-`L~go5i;a)n&pfYxO+l0AINb-h+sX zRpP<8R}_nSA|$zs@@RgQ;tl~|K%-A)-47bFU`y$_A$f}P)Ucu(2>y$?p4;_?WL#F# zwLcceMsbLnpcX7V<3fVtoD+|5go#s;OLo&G$7EMkZ}GLI(AVczCe{8QP3h&%id)F- zIqAzh2#0OJ8tv^lB2uzpbEa@es*%Q`G~r98kbleCErjG6b)tRClH71x-l}I@W7xt^ zrE*DXN3kh}k;t-x;`8}Fn!8|}40D$m&&91x%J8Iai9MrhZwyX%q$J@!o-SIz`e(H8akISKpVJ@oBL-iNHJ zB*1&La5VCVtjx1;1!#ZaqEdUAj_2V+=^FQ*pn{0$B~f-^d~UT+9d z$f4POLmMPxoF=2${pgF><;icJ4V)%`tTc4EKp97&33W4bs*PEq0`n_6kEgHen9SB? zoP)i^6HGIYiaB&-5@CAYp&+gd>)af{cUB_#Gr}IY$eyBmx!`8nZ)1-G6ZKIb#_Gl5 z)0A6NBCtn+3|4KT`uWRLT!cs>LL7a1^mkMLMnNMs!@hT_4Uxo(!pR9+whwa;@~gm( zK84o?>k#HT7%nDCSGJoc=T{xDm_2n2ty!VJfdG)<6qU#(N{+odR-Koi8+N=JZlGI0 z*Lw3ywi$4a=yn>Km+jKkPl0G8b#zSyQ)+V0!&xEgZNF>`x=)8hy$7r~FraT&KXp;C)XU(Bn1z%2qR0kiY^e*A;#*OXR$~N zuoFaJ@47$Ge_o1Rm)KLQk#zduaQxM&-tE~Cr+9!qUD7MjmA0@u=ip&6goAcbMcW(o zwAJr!`beJX%>q2W$0xjpQ?{8!^H4JisbZv5fX#wR5wcZ2Q3~BjHX|^}eymOlZ*Rzg zrG*J?GF$;3iI92^Ne1sZ)s?7O(DUBrJ3@^rOh#aazm12^T79v@&5Ro1!Xp@vp2P#@ zC8PsZ=OEz0GW(h-igs@QWCe4KfMVZz@bbQ!bc{nf^LqZqfKQ*EHiqT*a@*0-h*9&*{A*Z>h$)WEFwBVgi{MN99k2bP2Xn{gG*RZZV1rkyQf-gX2nSQDCXfk zA#kGOq>kljsb-tX%+i#b0iVD^L*XlCuaHuZ;j;|wCg)AH)yF{-gN%Uwk~kyK!OdiM zQU!jDedHx{XgiY!3kU-Ts^m*3@KGVfBW32QC#fjFYhH^iEQy~tOc##~^N|eJL;ame z@lPDz?qVdN*uv~W6Xyi!VZTY4OGe>+0SF?a5fzNh*-XZ0QP4j zy6{SH)$nU`CF2?G>8*RNgVu0ay=A5&9cq<#O>3~}FZlkRGM9zivkUx%Nw^hNc{6+5;JpY0A9p{|w){uib#&`4WtC;wJ^W+{-; zWP}@NkB8GSFYc%%(FW03pIAo zRxKVLDo;4P;C>=;22NM$3#dRYA$USquZ z>o&qzqz4zmim6tOg_>Gh0-m zX<)E3Ka^3ZRuX zVQ#ob(*>*{+{4~>zwv7kNn9_f@qK=oh3oHL>pMH9e90>nvaQI5e zbjG%(a7C4`xqJxbE5YJ~?+$(A_QawUyrs@HjVg_!#nDEB&F>-I(89%pzd+diG1(z? z6|X#dK8}uD%^85Uv;t^_9TZ$fONX4gJf29D|QGFO)h|Re5q3*f_ z>Q1CTxGMlNXd8u|fAxb^I%f&(;GY2QuBG7#EL#;e^}R4?6fb%o8LCjWzo%&S z9A*h4pxbDpZAtZ4?eT5Tir=b+t&;OWk#0&!_~Dug`=U0>n7>GMJhN^DpGN69z%u9; zoO{5lcj?&eL!c1xfl^&)yA53Hctkm!wHpmsS#bQ`;zk{G1=)&BAMAJ+4hX)#)iNfX zGdrscH^dcS!g;YcP!p5gX)xPSTK-{y-S+S~hAbnUxD)e0jS?+n7hjWK)08LgBBCM| z+}aG{dYC8hVd$7PNkYD2r$p|BpN6#-yHoKFlKZ-7R>u#T8n#rT81`h-j_543FqR>8 zrLy!B5TN;LddZ0Uqne#t_r*j+>F6bXE4Z*^=B)sG#OEO5P|`QnIfMdvEBoVr(-0g= z_0L(r#*RR`yI%%}bW^*SF`y4d#-E7Hh+`@iT4AfGyq!0n z<9xP_M;$+_VG=;Fv}aZ`TA8I5DPIJ6QssKbyRKfo>t5V%FHn6rX4nboYa1E)OX zQjp@GA{tqKM?yVWNh_=Rtr?%7nZV#s5BEVmmF#m4kCH< zjh)34=Rihqv3|jDAPv&w2PRRu5j~q=>fZW?n}tx)4mL6I&puWUU)mw^0G6UJO$Dj> zC|*69s_RquU!Fd(hDaI0iag99wi==#dYsp-^B{EnBvhzfuy}K1x8yL@e5aMA{Dei8 z*#Zt(o=9ZwNMxBG1oB&=cvD-A$mA;d)kg=hykuj~5v5l#d86E@c|H5u-%S+1!(ZP4W zs!rKQ(<4Vwk-&uO55qTJ&{Vmaff2OCwMlZIR#mwogN+OEjdGOd~cfQL}A{vcqcrO77+<9|!cjw+V8Y%}r?JFGXLj!8c zma7EATYKA+t(uSI$6bR*A^7cCVU?=a)_Ecr2D+ktE&)2za;|ANEZ`p(EYZS}ndT8m zXKSCC9u)S8FJn1Va}q@@Agkq+0vETrM|KsMzspubM81Te&)=~VQ zk~I~rX(eTB{0T45b$}yU8DV&-g{5nLeX!t+fw{@R)NNvcYIo9Ba;elgcm`T3tD4B> z1zit>{;!o~{(tVh|Fc7kjgFD+Kiz!M9$;EXr@z0#dk!>83yNhvw|1=-)rBn<)tZ`i zOa7Yt@9*2zrF)>Pny1g zs$4p$ot`(0ySKBS2nfdiLdk>(Hk&C`eY%X6-#{j{v`Azbd>N@hD1*0YQ#Zf`$@SC3 z-c)J*8xcd)ej^Knk^{%$J=prZx_IZjuw-CucUuapgb7Hb01`>0v)RlSl0f|V5fp4? zY10oiH+NmKxC}?Y{sHr)GMEPKb9zIUJU?6hj2dqm>EQfq8XXPI+B@&L*utp?9cngq z88zgk-}X?ZPLkR@!lk2;J!gHt0E@P_PEFb;i-v_VO&NwB9`yZ5KYXzM!HLNhk-hqA z#+&0MQ#!$S)fHxKu zFJmQ3!H|N zS}wk1WC6*X>=BzG(k<)FCtYeH$5;+muD&F?WMu)%oSGpzU5Y9PRW7__aAA0XG!gDl zk|HNrZoK4hp=bfpoS-3GU7}USyrf})-JG+*XI;c1pIJ_wM0qUI{#+n5=pp**Gf&zwyWjKuVRNCm z^jhk(`O*BWySr<|xyj_L|g;y`r^}wURZ(22`5%;&quZ*U;BD zH`mwKFqe_h(10<6x-B9q{2Lq5GxzqGom(yEXBRHbdy$O|vkwoSd86XDeZ?H{REJR( zG=&%)!(TbK^7{^}NtcJ9I+sRi7NoO8X4Qn~kq@_4d-f$_X7v<+wi8anZ)g>x-gB1+ z70=d4PNWI|>l25V7bCy-^HQkud2Pip0@c-pfuH*u5YuO9#iG&k78Nr9ga@)DC8S^E zUm5ze(e!0tWcmAfNkivG_YwbZTo5ncbnP_gei+?3c5G95-?ekIRZMKXi|N~0f0S@U z3&as%u|8V}*D>IscH7}DPSuDdT(5@jvfPnME@Q^%(3qc94lzG|$gS97NB6yDH8jM) zIV_J?T^l%IU{i~>o|5whP{ZfAXY1y~O!!`_Xcp?GI$>{o|Irq7gcfFE)KO<4DC~m- zrrW7C=%s|AjKP+FY z1!9zJbVPsl$-9QhIcvLC=Q!NuE=?JOYs=vq=xK|OiKOFwCTH&K<6|C|sp%#M9lHwN zx~9pg!D9WS#{OD3tAcB}<9TCpn#~;glDdR~ob=Y&84NaZ*HSOyv>gVDDa=e_J-Ll) zBwO{tm$&ZGQHFSNA&3{@o2nw#zgr9Fl&Z>2U%(~n8hUUNeqroUN+nKIJuTwJ)2+z{3;qU#~G;ZW$14CZexXcO|*k1J-&Z(W>Crvq=&DZcCL&-IlXy;FAOS5sBZ~BB0Rb0Gmj0E@)M0)ia?u@M zKatsSaY7PpR2LJiL zNyztkk>m2_MIEuOAb$xiy1ac<_)(J(XDwSD-Sz^SD5g*4F5`eYy}bHHu}q>BHRwuc zHYgpH;=rT0I0X0wl2Vo8!h|TV=$i>h=s6&cV9DX@Vg-R}%LA5W;P>F+csgDBX%2j< zKOB`&3_Umfcsc@1kZO-rtLE&L`U?3R#5iy5sB?G->fUiE9m^9e@2c+}V&7jbD4zYL=*`H_pZLwEwWJxKtyy1!tow8&jJ#3>Rq(sDl3HOyj z2C&>kuExhqcghC}WREWacYLs;i>I<*4v%|1k<_9z{jJa!tS2Nb!`>#-Zoa0{RWoum zmHT+S?RY$uXJhjpjD1`09+OHqsMcENM+PxK5}kfp(JrAIJl2BzCD$b5hW(J+hMF%+ zS;31_(eJu?^f#?$iw3z8#XXMo14Ua)PahwZaX?e4quko=cdBk6!5^TK$~hIv@T%iwthSzc<5WRcLg(oe+DmO-?~@r>CYC0&>d1S0#<}A$Q4RRSN*j#$MrY?Gr}r zoFCmwIR^YigwTU`JmjxYh^*^3A{Ex(%;e%d9>&G1PUT2SQsz_kybU0B7=*SPvb=+G z7CR9eyW9CVfD@MI9YB58X6nQua@O}u4GugfwTIB>nF_bZTbfCVSj2y#FMz>TptcaV z1*e^|$$XkIXbQa%553*BC}RGo1E~U{r?0m!!+c7DJ4yU>IlA>chC=av`@sbfult)a zFg7-Zd!;COwOdOX*6r#f?eyEV>uBlmnd}33`wLSP*OHSk(wIB2Nu@!r|)Lw#{ zSKPFtl_97KbdImNfp!@BR5x9lr(&&WvZ$7r{8Ps0_hshrC*~Eid`96MytP?}?PvK~ zF?TBSq{#xHejJYpT{u+AR9y4vZ%l(5j?P7N;Gb86q`k$m#p7j%^fHL5Gh_ljJ0au&dMa~e ziK7XcpbRP*Qq^y`@mtq3?|n2MRex5D=`IUfVgRy=yT1@QE>s5z-Dh+-&T@0lso|)Try7 z%ja9s88AbUi0SAFNdazMsJFgXN5+$Wvn{HHubMkntHr zW^ZKQn~dDU8>>cpV&5ALqdnIs(%Jxt!|*8do$mrY&yfTY@&k9Zx^O~bA+shB2!y-6 z`Wx60{~C=l5}cHhTU1mX_B#*4^`Oj48kPalGzrI;gkeNGme?xt2_3c}&&QzI>W0hF z_>rw{8m0%Xgu%Yq{kkZrMP#PMKG7mkcWCPVKIXsCwF(*Z_FGzJRdp46#xpwIEYIWf zAwC-u2^Vba4}3|ViwT&}ZROK;!P-(& zA0n&z2Sv_=7hwvEVi~ zTHRPRTRl2vSa~yGkI(bQ-FFN&EY+SY^?=%j%vS9-=hv}xpisE#EcQj`Wfex4Z+)SX z%>s-5QONY5O{*`R;t@DNzodMyn_Zha)d1)OrFwC3dn1FFT0rdAD4KG-I}$M2o-a7e zCmwB{g%L#=zh*#*H`AsX$O|_zv6<*`DG4|b5PDO8_z8=%$u*uIUrfhd!gxA`FC z5@{1)&saZD3?X0LmZ{P0RdX!f2oX!bbxGq;839U1?{{pg;e9#{bg2*(0W&Y>&V&>$ zxPro>qiW?Mg18J3mcJV|_j(&n?k41iL67QG{Q6;qy|tOQ9rmLUuWvLjJEj75V^wKo5&+6gOQj}}KHT-G!z2b+w7TmI=x z*B}_7J3X%j(Y=36Taag@Vx=N0fJzXcKVSn?F@#;E%7%=b`T49;tA)MPI~kIEoI|$E znT~iIgcj#K7w6cn`V8$qmMzvn88-)&(nQ0Tfz$RkbN^-!ZxUNRBE3u z5`rU9e|5&N7~Uxnau^|BGv`wXkXy!qY0ASsJNM`9+3(uiD@@_$8P+|IOk4V=vxg#o zsXfiK_U;~F?iWaf{^N*QODU_e!0+Z?wb6;iD7$$sThnfcENs~#<3wcNE%1twJ|E8x z_;Yx(BSAjM#Of@UpXETfr#l0YFGxh@bHkJm)vQ6a|9oFm>K8U>lV8(&JT-3-6BAzq z4;G~)|F|UIR1hG`5cq6u5h7~~ZB+IU!h2Ga3n+CWDss=fzO=WioiM( zEn`I&Ua;0_{+gb-WB}h&Mkm*B##qG0jE5kOzoR12X`TyS-qz{04R=%QbSOQRI$PZ) z@}P^0NDhrB5l75iH1YH(>G$i z32d>}TaDa?PE=9iOHEpXN*En?>-we;6m#dU-t(Cz%M? z!mO!@yScAYO&bK(`Tg9}onO-&T`BaHYL$<9J2-`!L`hm=WU|T`HfR|hQVSI|2<`wV z1g{C2nz~X1jO|LsX+|jy!yslf%g@seRAYa#ixA}W^6|D$+ANCJVSE?bQJ;2JM1R`y!sG=Yn&#^< zioyqUWZpDiI#N<>Gmwedl~rAHZn*5jqFT9Pd8E zez|X`2DBzv1FdY;VT!9;v@+%&UYv{oKO@*c!pyy1mCxejUxD5KmvoUOafc{eAW;lm zw-6Ucqu#vmazgwI5TpIAA(u57L!b9?FpEK&8xlKe`rhqM8_906(SXHG)vNp4QP`p@e$r5FxE!$Af|`L`}ecveMiJr zj6smYs$BfQk_s(*10V|y)%{VitlP1g{K2NvikB1CXIw#*DwH&XneMT zsS-oA7;}LmCOa_a|^E-UKt#UC_aW%oCx+T>6gaeasKBAN!)o%J?lT)TU~E8cX$K&GXW|O_yECCRk3YE-fu#_q zP{d61%d}|eUC)pTF)41#Kpg_YMPz%Pr{XUsbsiR#ku=L-FuO4}rfk;RebpsZgEi~g zG3HDTkPEjk7na$YCP^TXJy`2ZeMT1l?arLlgjge_rpHYa@ZT-5y55yl7aDf=5LN_G z2V~&LBAZyUyf+ES`n!`~RwnvDyN@Y$QlP@G{yIn>LeI{%PpBgUOmS(=3>F++{x%Aj zG2|xVA=aJxAeq>7^&J*|fR_b0fg7`p`o$rxIfVgNOBM()gL$HHx)yADMGA3k))XHh zh>2-?lagC(_gooxfdHAz9puJ?!lvC{*y$Clg4Q5z`@n1)cX zRM7;I2^LiM^d@QBZ_nK~RJQNQ6(i;zy!logaRq;zfctoHTKhS%Uq(*)XuH_DtvJ*L zqy2*Sy+zTQzf``^>r9UG2YiCk^nu_*+Y|35UJgJ*T|1H5(7%+N9r|Qrh4y7)RCC^)6sAEs5v|JWS`b z`?cuQRq~?S2+@_yOjmc3y}8mT6$D>qSc}VN^E#a#o`Gbp)Hpb5kH|k8EvR~$PWAG1 z`b6K_=z3Y3L=*N96$%u>Qprz(iK*x4Yvbwlgv16%pVMwDy6Y8d`?;I%=?GP8JM)R| zMS&{UE8gYr!s`XkXQjE7$tCm^n7AWjwZz7uu1+zbqLqZqRQ%&PxG#Lfomaj-IunH|nnq1{&$U=KW} zLQKrRaSd~8_&Fj!Ky|tX1~8jGSyii@F6yBflIbqd5N!a6Ux&ln$fZyq{6}?O;^tvf z1)yCE2Xud#ZCi6!31i74Wlef5P`5ApYY};o3GS|A#Jcc#|0pJh7n=)#FDS(on#9- zxA-|ab~qTrmtE&iv2U03bO|E8*_`;uhu(S9OniKW>V56sbh{J*7!WJ0VjsA9xlHWT z*>s{@O0^X9AH*H7!-M9kD&*i0dtbH8a5kx)VJ^l`zvPhndlSX+BT1*MKVq-x>7$&E z>y&V|v!644JI;K&NYl%NMdbHB`*^wRLXBKUQnC(P=wGRYh0@hsT#_mdEd&1A*1;+? zecd1|z4N1#9^U@s^TY>SpZ*$K(dC^D?*ErTNN@@xzbB5c*tcE9(w6svhVM_vCC}3< zTbb!0;D)muSXgzRu;F{ZyFaR2q2rX#XtTQJ*+!F&KGk(BZFh1Uwl3&&y5#?bA6xGO zEA3<-bZB2)F?(=Rt?{tqF74X$C^qt}%~`)GYG=Ydk|F_5SGL^s2UXDiVh)$$dx2vy z@&_q~1#=wpvZHhNMKo7T@$v*Mf0CVQ>$H*fpea->cfPj&RsfH)*5A%BY}Fd zp7OPaq>2y|bEyH>5w|hrSCB^Voyi!axB1r&JrlS-l=(0vW@Oo$IrD{^*;=t-%p1+o z6F#}(5#KZSui>jeYf^*Td&N*uhjY`)eUskFki=wNudQ|6=e^SzaJ2(VKO_T>c~*;a z-}z?t^4BqDV=wc*8gRJeALMa+INog(hwQ|lo6xUzS=K1)aY?5IiVB2)s-U;Q(7$+e zk1ZsnA;Uyo$dR+MnHfD>cTnf&0FvR@`>rR0U!h7Ap`E%W_8=MNLTX})^$3=vR*bc_ zDN2M0ea4Kqi1UPOQg3D+Abf^}CCU{Av4fYfZD|=NqD=}MgGjVZxQ>(#1;NYt$ZS*D znfpuyw;lNG0=T|Ft)`>%s2{zC_(dm47}PhGPzw`b;NvaJGd7EnfWXWqe{uO zYdN=qW|Oq?nA2I!bWfEVXOj0*D2neCqV~7lK7Tatj1Vl2o_a_5ABzxlhWMh`0BL23 z0#4NWnb5vN+Kosr_;Iz53N~S=K=jBlgS~L^N-mk_N>E&1c%NnTt!2O-$07s#;Naf^ z-XYJ37z-+{u3G51!8<~%O={Vt{#7W(vfKyL4$o89v6q0vTU6~TikN*PLP}1?F@6RP zDM>71LUJztzXCS5Ap{Un38LeuK=}xLBB-LMj_!F=lk>| zizuo83YwZt75Z0)k0GHQX0v#(#7)AZy=ATzVY(<5RZDY8+D^T2hAgzwQs%~Z&s-p&x3iAE1<`Ev$jUA0xTd1+ zd{kI7UIKDC!M_=~XXU;0esbYE`qo;Wt=o5MB?x?LA07W-5K>PoNwudbdhDLF!`RZL zb8+_dN3Zbyi=|^(<6tj0QLeOI^%V>^Ns%m(FgAT6@we8nE*V@sojOdTTx8fi2ZG_L z$Mt*D!QxT=NFgK9skUEaun$Xma71SQfLfABTyz z#Jk;uOpfCC_a2Ia95QbM?{j@=NE9-al&B4mFWbNI0jm^gx}rx|e9psY0%Ly^>LD7@E?V znR{n1W|N7CMF;x=SOGFL*s?~FlYchTFxbspAN0J&e0DrTG1yIWzn=aT( zn1ni%)DFdXaOgG6qoU7465}!?Mnp!*5684=%(mOwErNZF`FwiYdu$6^-v-RSXY-_u zR@)iuw&hb9zhV{eTZR4ETtfT1c!A-96Ma9eUBKJl+=50{W%T!O@$fpWt~bld$~Z%T z`;S3`J*wXaXfi2s?QAn~@eJ|uVWA*mAYLGv>!BT9 zAYe(fM7u25BK1VNWN8c4lq$uGHwQNqwkU1XVo~zg-W>asZQnTJ&EWIs)^nFic9~;$68&Y1 z<9)!BYcaM1Lj3+O(+67+8YV=I@I-DxdhGogeyM!WgpM@mRYAGm6bGhRakvlS>WG?#M6(u&|tBFOTTxs!aXm0ZX;`cB6&1ts2p`M z_W}q$vx)pG?bz_-%@EfCZLulj#9M0XlI7li6sV_~FChsZ3xXfEB$`6bh-@MKT{Skm z5k`w$=RjI8I68V`q)MgWpOF5lb3c}j4Bsv_TdGbXTKroy5c|M~WN>y~W69L1hc6pr z_^)BeM{CH~X$H=1%HBnf&+yEr=1(OC>;dfX<11PLNW2(3=t zTTg87_|A55eIE)CMIiFOq4$BUbD=Un;9@yU+)|j|U?irZDP(5Q9{XwR78BhYJ!~T; zO8WCR8HZ5VOqbp|+Ao<%B0r&^)t~&>TfTSbV!28u!f+~qe4_D)XwnU-amae{5)Cg# zlfHYJ?VDjfECmq%a!}vc2^d4(k#h)a#seuq5UbGId~!2q?eji`7s%B$ZDi!NZDQ3m zi)t2`dA~4-uS%Vi!6s760z+l(iyrucNHB{wW)w&U!9npJ?H~BMKZ9S;i;I6=;cS@A zg>I@fd3WFzaA^K@_?_p(pPf>qii>}Ilv4M9B?%5@k-o71BzM5xusX9izjbi3RbyyzC`Ou3O9FPc8H*G@jmF+aZ^3_j zaj~y_;TUN4)2mfuPU%Fkq|(2hjr_isiNf0_L32pL65amn>Bw92;{mF!5^s?R(#VEu z$}@#ZXojK#hr?5#x|5g$+vNwwgTHWcn}p@*Ha_YSZSFlhwuCmRB_;k%^o}y$;5UdU zvH!T#jXrT53{ogDoisrpn^~^Bsppn1(MQ!gA#_(EnI;=WzBXZS_?F(T! zYqWu=4%<%B~jZ~oL|eGcvxsm=;fkf z;SvBRB()ei8|@d2pv6I&KUg3b zs2o>9gB0xwy60k_!7qed`J(HdmZeoWJULE?UExDU&2wPn z3RrHKv3rBb7zIhJayLS`rQA5%+TY*5y4s)L-&$LnpC5}KHLyOK$o7~6^QlVPSu~$9 zL-z-7!0^@)1V)D}ug7%woZ~-{SU{EqilItIck~#gou)(Wr((aAhbdrV!TOh{9O{IA zNB&^VW4R3P`bBLv37Qqg6OW!3WRBBrVNz)5D!9IaY5r?&7KVJ+)7t!+y=&d848+)K zx`BqgH?S9*t-llIH<|NZcMt`_qhI{L6-I)$jmVIQxlnJT7D`;Nw&+aq_*6{s3@=z- zQyE_%Hpe3EX8F9v2g)X-pk5eSuNbksNI*j$1y^)QUSC*U)D}gObCO9&F`h((v^ovh zFF6HeCH;r*rFSgvp*7_92<1}hXuA->z~h~v6y#KE4Wk`g{e?w6=ZwIZIIWwk_mJgF zCIdXQ&NHgO?0>s;lS8(9AoGVLNM!)B5O!pi3GU2UE0gVa#01QBk&&?-A{Ol^q1k_C z)+*MU%Mi_*QLnx(3YDF>1s&Op_KDiLw>a0^Zd2D4Vn>#v>)fB=z9YYx`lUVQckYv2 zNJrl(QXZ>>t##*^DZ`MO^%7$ol@gqt;F z8stRyqpY#Kmw46;qgNzY`o+lZOF`R0Nh6kY^~PdM&I)jY*`SWmD!Eb`iG+A4FwytE z(?BToRjBFWf9uNs{xvd&yEqK;0bC~(5;aG#xZ?`oE_1F*|1{xTLn5SxbiFz8PcV(9rE~h zU{fzbu^G3FuG#fj@YM8L^(UDjH0{*seFO8U7-_uUz%85uJm8u9YaxKaEsp>Z9H6M= z(#}eZ&RtKn8t5`VwUQH+tG8He*PDHVj#_mmp1|L-=0A5fmZyrqN6XkRZap1~Py5zz zcuuXUsLUW&0Y&_+F#M;jyn)=4J{#iRM`7op(jKDd?`Dx7YI&hndx!wQW2l?vkE~=T z|LboYe<4iY-=U49(X*=v65zr=ypl=;ps(ygkpBF>1@C60RDvl};B#Os1)Hma9#G{9 z)X*#1HN0)J?j*G!=a_^0?Yp6*8|=3B9BAqriyBLPf{rGpbv19J_Ogr&D+C6qFwaHf z2gI#i$t_4;nCe`>^Ocqar6Js*D?e~BkEU^keA}Zp%aN~O-q34F>n8tt-~4ctgz8*> z94$OLshAm0ZzcPes7&3}mY6|902y8+Tmh;4+$#QK`MHKBQG8j1?9e=>Hd-IPp>Cmh?aNV<UqL9A?zoPhaUldp4f{+z=jIOU!KO04y) z!DkDM{JTBM1pha+H*^g+n{BoI*cO}yOd<;RK-QPbI@mhYwhS4N6=T6Cp5QqNOIjTY z))KNzKT88_e~`4ome;0pqqY2sC`}G0z0z@M|h_0di>`tm;E?sPx<<-E>j~q}U0n`-Cc*$W(2E~{J z<3EMNc2(Mx8VI7|LPcb%xD{ZmDvY0stkL}+_-5p0q^d|Rz?!0K!4xS!auwG-mQX(+ z0Lu@nUeoV8Wnvd{V2R8SrV@dkhT|(d#y_Xpz2nkMgb6CmAHLQSd{gviKNR$g*b%*d z@$M@i-R2a)&awKPsRe&WZByK-a8h;g;IargJvou8P&rqu%P`3hr}?BXoT0qk@kw^f zI-EM@U$GVR)KOr{i=w%~`k+tTQs9Ih%%bq1REuUxU`L7kOF{&Du37KSB07xyl$_IT zl6^U!+%_L?pkGAUAx^vFZY#8kc402}LoI~}Xp@;t;I(E8Nmr4jPhJU>`cSd_E6h?W ze4t5?id%AJpHm>wx(E9XggNj>k@C?Lu=q57jtAB3T@H@yh0`8Ii`xflCtM7}f-Rfl zm|yG$0z8+w@g;EFS3Q5SwhejlA24@D4CsH-B>L%nzpb0RbwVv3i&)e)DEimAe_A@&9dYPG@G z78DW|XH5|Q(${r?S%oT1 zyUvJo7EJJE1sR{)YAN_y*qs-i|upzbY9M-r8{2u{wTj#be&Vj^`$&l=THp4&oxp{$t$p2}+ubLW zFD6ueSl#yr^ZwIb!9~YKid6$$IG?OFL!ld0iKX3_laZttysDCbTz>Zv7#TqzNPkG) zG#=*dB(-b_R_g+*8tq&XDjLZ(IdOi#xN!{qFQ`_&VonB0c37$rWCQz;#B3*m&elqX zo|{DB)gYO+4t9nWJf;EeF@=S)tA*A^O)sNA&!8VVC`#OAu*94Qj%~M#ADdIt4im4w z%#Rh~-vF|(kKx-N6UWF#CwN~t&qcE4SOY0kO*_kkJ0q*O{iD;OH{8C2x4{HgJ+HccHR) ze?CoOb?!fqDQZj_4l%k-ltim=5Lx-5kh#s_a>>; z`8AYVfu+%>2H4!*8;=f~A)`mD^3w89(cv*GqKX#F!lo=GzCSCC){WLxbZ4h@fLK1M z8~o8Jq?vv967m4_kknk13b{b8b-Y)L`xUUnw=7QU4m`Ls?=GxJ6I^-Kr>BNOT64!Z zj>OifP}WS}H!LZS{Kf-aJb_tZ=>E;&)%S&Vm|A(b9#Gm+>zS6^d5AD~Pk17==33nA z^HC{~XE@O<-n7T&c>*nJrF@^OkqTAqY1ut~ZLCkVkq|F9D^CRtJXrIl^?5S#@(>$; zdFP|kOvGA-CmPI{pD<|)@PQs!cgOaaq@B)A9BXY6oN=R3h|ztBK9cR9Q?1zx9r_@XJdU*U$)b0YoSuQfQ!BMseD~M@AgpC+8elW2MAj<=c6|%MS z)X??505gwtbOb)I{w8B9d{3@n&75>>R!Mz0?C2QIJV#~ zJ=z@JVIH^JfLuOa`j(#>=q@LH<}oi0uRCn-Sz;5(cesH}nHJ_q=-H0msFnUo2R(<2 zsjqSy;u|nxQp4E@eqf+_ki4yE@yQC=X?)@N2TY6)lo0d5V}sW6rsr;3qy^TJBvgh5p3z{_Fagt<*hk+dGAXv+Zjs>ZQwsx`djW zE8{EX+_oDQakzZ75Sb*s1nknM9j@jhwt_02i7eW(cL6Dyn&c%>R5B4D5~Y8SHB}l7 z!O;OFG+AV1D9Pd;GSU)0>EY$~={>7|+4wx4e!gT0z`bSo3$0N=2)2iFe{nHrKgmrAS$tFjo;+?;#T+`{ke!wVq-xc@(Ldj%5Zkz zAh8R`U14FpvL3Gh(jZ;?*W8k{jFsNB%yXsL;FcHQt&YnjH-kqUkHoWR9;A5E&Gpk_h z=W9*^NAMrwIam?rDa$2b9DIV?{*QZ44fU~Y=f0~N*k=>tcp1%L^L@=3^+G|=uvk>A z3=FH63yt|Sq9K`g!toVuic$LLsujjO2 z5vuE_>L}_g0`|^%{`dWtRr{S*)}FKW6olz@f4bbo!BfAmkt4h^yPRs;W8OL*AiJ)* z%4>G<1fR`hNzNKzzNj50Vu=$+q+$c20nK`kza+a^BIfv*@Z*9JwezxLkd_h%Xxy0t z@BT(yNaEax>wUbAKE1R(#B`i(*>C&H*;NN%V`LSq03xREw0(0jIxMtrsxw>5Dm*wI zX`|VD;53MMuLknWb#Su+moK6`0zs=ic?Btf5}2so_JTI8cSDg<%BRjyHB`!&6j0Ak zsw5HOBwU3^QxR>d#wGN^h>Mxymp=;>k;>MqU?A2i5yO^IGiHbT-Uv+w1D$D2P!A!R z<{Skaa!L6I2leS869&Q#>jcncSAWsg1XUbHxt$?p@t`NC>9a`zt8^p_0s)=>y8k56 zJOQj+`cqPeT$kODKWq&TKEvz;QRu*`lS4~!bs=^p22xus$%}onYrkOVEnUa z_t>YnBeYg)H*#gHz`s>)P#L+vTM}NIdmc7J`Mf_Pa$E|?03>+eXY*rJ<{d#h9p5R5 zrL6YPc}y0A;3+uaVt-t_35qI#)@1F$Z|I4D>+=gYd>jFvC(J!`BGtb*Dv|bOET_Y4 zEb59=IGZk!O7j(-9} z@|6`v3nQ>L>9Sj46vV(a?uMk%&cS0>;hBYZV|?{smDMo*SIolsAI$Rq;9yKF|BHhu zPW+poK7Bo(C^W;%@Psa=tCI0f?LnVgPs32fM2 zs>mgLWhw;Nh196e@3QDc32^MStJ6dYJR5a)ZBmA)HRf%$z8B&m1pM{#rH(jp@GTSm zcHmLjgCcR!b7=b$boyN5I^~>UU#7|~l)~t@yTK*b*xqkMJ%Y@K_+mklp_grFPlG+e zf?n-wFTe_7?tXnKlq(s9M7{;ZQq4s?!7)QvS&@~W@bg{mHB^qwUu~#~qD6Z0+`!Sy zvA;LG?{?zmS#NcAmtd#mCM(nS$YJko6LYrpgBJ|-N_|9WMYCZltE#=@A{*3L&ZDSg zJC5QhD$|EVln_mfBp!Fxa4TXMj!LPdZ&W{XfIJHU(2Ug$k7RTSvnjOUWf{}kGd}ZJ zR5|MAx6sZY`)^XPGyX@4|8L^O$;`?AKc#8*`0b@)`uq$7G9ZeO%)o*80w+=g2~j{q zK_Q!wra(;F^|DR2@R4;!%bO@UQxq2moL@-hm*&q>z5=dI6X`3OMEoXTl4e0q1TRO4;&czA}5L}TjVNfpVoQRaKY z_(K)xktX|PgCgos_FFs=-v;Na7P8Q1#HfA?o?)lzAqk#GM(N6_y@oqN_gw-_U0|97Y-Z~j0>4dtYfC7BjjVJ z2Yw_nTWFctIQeSb)-O*I?(Z8?c)#5Y4fg_0A2-3$Im4-sCo|R3vQk;BExl~Kv7YFMR%00V7y4MUG_jd&CWygEitA$(qJj zAuJPDVOEK2GHW(!G-^6(IBGszHpQo!5-*m9%Aym>t)PHX1$W7k+p;yWU>2fQ;smR3hbT97Ob$YMQz@Gf5C z?oP-rGjE5w9&TvU-EIbRK63un9(*_aMk1Sn#=_-kzhhP~P^k!}s-IpnhE! zzAmpUf#cWt>A+$N_*AG9G01qHY-%l`&-s>>FoAfIxQYtHJXJiJ3`)nJes^=Zy6l-* z<9EH-q>jDvxxD9j@|ymPguaaJX|lWQcZY6OS`SZ(jd@MCfHf#e&2wZ4~VX*n*q&pLOa%glnR4!NHf5RDSvTbiiC$~J%e zCb}pb1%%1bOHqU=k{!<~Lud_N30UH&K2vFndTub51*utEm#btdLRox&WL)rGg$`_O zNW2?LWD{$tas>AHYZC<$g@aUpnzvVqT_e__hgypCRp=;03y)VUPEhRxgwl>0r@aoQQ4f7j2zc9PlC`QNDa(XQF;2D znVnJEc%RUz$R_y~?Z4U$+#2b$+v%@81`m)pBFx&eg{xhe{C2kAtn3GPtmiBv>~pPY z=1o|W21Z#33B{Yh!_h?UNcuBirQM7*TqDVU#)028DKe6!YKeSICbZu5@4e@}=fey{ zGdOq<7vpT>RDKpyghjIt@plnCiZFw-MAcs@etvLe17gJ4-Arv&d=%Ey9X~}x`B(Q4 zSkO$Vhu#zp<>}^OmyXcL4R^)nEQe(}dBH#Q91r9G{52h!x0W^q#WH^7*fM^J-;w{w zM#n7ONF{(urPm!W9+h%&6Vke@z4QX-O>YvHY0zafGjV1={)*$lBxu=|4WPupeY!3b zpYW_#{^ECuC{J5aYk!V=R0-2ldR4e1@|4S0Edj83K z`}m8A_MFJRyEHK!k;5zt!7VEzGH`np%~i3;3mGkVX@Y_!l5d4FBz?ZTI99(!CV`cv#*MkoRZj| zuBw=-5UkLJa7SM}>xz!9sVT9C7<&bf>O+6TD5;Z}7u42Wq`c73@_LEz0xBvPa2;^A zXh~5if4q)MNv$4-^TO8c+g6exl!vqsh1z>{sR;e0a14mSoG-@;do zX>CPeA_5hxXemG5r8Se%l=a+@W&wU2Hl`G{c|{^bHXUh-DJ^QTU(sE6h){xsv*7gW zaK0np8*@j0f&Z|6+3z5H>kQ3?D0^`gv!CiO0v>5=F?pZHj7leqS_SP)omG>6Wl1&m z3&pngiaXMCPNBk;!LglHMoNH{v1sA)S_A!%c#Ipct@YttCajs5pp`W~j?=tTeiy_Z z!DTA~^^q2n76Zp+I?<70JrL#QbhHSRBnR+l7^x@4zse;J1(o;??+Ef2uK<$s;8NC5 zk4%s?GGJWD;7@VC6_yyod&g}0^VfC9sCDZt7q&IVUg9eRU-CWYUf~p#&t2mkgp((X zhG!uDxs(VS9A+;llGLHm7?Lro)!@^@nK+NhxU#gvfR@6XshknZAhX_Bi}-=oWUlQM zrm=Zq>*$zSNqI>-N{Y%CHs-{PSZ;#GWW9&;yPvN1*2eoL7b`XijS=R@rN!aC9a;4$ z!C_A!%7w27ueD@jq{vWqi%}D}lB~(XKK=L6JN}wkL{Dn*W0|S4P2N@6p@=3?jaxx(OQne$Tg4Se@|7GDw16i?(V$oTc_ zCy(X}49BTMx4KBQ%KRF-U)#%1ANz11GC;rlv(UwyM|l$>RUoC6{1QRe;tUZjS6tz|uBsPV|ekP1Is zoQx7uwVrC0=l^N=khuGk9|c#K`p#@(j;pn)wj!qM+z78!$+1X;GR>@Rl*521+YU~f z4p(6%8?J^XKeJS+#`+Y_oCR5fBvX$RRi_bq9&Z7m3kIU7ZWJGnnK!O%Ry+$YGLO7G zJLvd$NWQ$EFjtb|7dN{)=rRwLY)aQLa9sy04BM73tyNHq{sGs-eFjw1_6VgK*g=F_W7 z!}R+}x%OU$4&;~(le4gy|2M*6iuh->`lNQ5+GWEapNf(|HWm z*K)38wRfH`F8$giYCF?WD=umakis!DZl8BmacTtb>mpp>)f_}61nhPi8h#+8J=4~2 z>BQ}@$kfv+>uT3X>id3G!}3aSHm@+U!q8b2mK&|ZC33J2f)Wx!VgqK>{kMG&TViZk zj#!ygZ7z;c!=qry=@va~5m5>a1t7e#X=e$X;5hJ)gws&ygN7F|acdAFbnns1pQ62~ zKEoUTMDgj}3oe#v5u;cxG0FyXcIV}$M;vJYEGkW~sJ1%)I}0yit{#jfB#rs8u{K#g zflQ}ktf{wjETMkLXxXDgkD#+k;mIv2TZZ6~!tTu8U zT}mi^)2{l&9}~v5oe^p<>UjGK3v&=RGvXoJL9StyneQv}g=SM}qC!TZCCXN+7>}Vw zXQ(r%Q~nS}W5wArw0jO>#*%>4R&=&XEBkDBoBjA$_n~AacoqcP?vGv?0wl%t~wygky&ij~!UV}mS6 z!_F7MPZ|g+a6AqGO3y)K8go7YK*C40*L`eY3~o=LCW@3on>MF^p`N~EXsxnnj zj!Et$z-e;PRZfbXSn+%$BZLqvRFMp4$rz|Ct&Pn;Xh-(msFSqaM?1(C*?JdV9}&z| z>G;{|bpm^v^$XO+M=g31&<1=qZ7 zMuBKBSH2K-T29>cnb$*=pc>&U0C58ceF{QH$ChQI54{`s6j+H1${XE1TzGR*;y*^# z3%g=brze!{^$7gJe4)JNnCl&c7i<_g`SO13xdylv$Jw#pameYjsxuNbSllozf`i9# zIFqJ+Q$%l7xdIM|$yYw}(h}l-c)<)4*$azSieX?SRxspRpwi1vU4Xap01qRL)E6cM z=GX{B(-kkI`@D+{yaBqq`X0$a5oqB;wPf~1cJd!Hs39YJXW4zK@3Pu?hvzsArtb80 zykbGO7Ti!^8W)eH`M{n+o;~q}!`xp-5l@}+tN%*yJkSFD%KO#NbUIu5&m;7g>|K+< z>=Oa%bKR7Kr?jiAF!5?*b?S~cmV_s8?y#3$bs6o}47dQ`rKpR-Psci*O`iVnCt%Oh zCwcGnC}7)1`DS-d7+DC%RAbQ4f-25l-M>qx_f(4cKu)w9J-lPd zAgLp7xTby-%wlZ)AJ8d-B!pr_kWXma5V!(gl!o%9tVmz{}<*q{sl zZL~elZqFW+58m_&zW;fn=?QM}+EbyD^X|b#7tG(E+_!8aUPC??9I92gbVvjo<-8op z)pgm(M?XSdM3K|AW#bDH#`Sx#ElI4HfKLn?9UGaQP=xfm)yX$~`R>f@+M)<*6ZNz5 z`hHS6WB%k*L6gz0x>@80p~Jq8};jtODd3+OdN$?UWI;X zKgVJqN`JQ|E_%JKTo2Og?zHI&^K11#Am;7I@ik zW2vYl+9BW}VLuUMR|3}~GEYdqWEfIWM~Mn$VP`h*)AIEGhhC!k*+p6wJ)=(?SZ2wo zBU!Oge@HXgX1|Sc99`8BY@mlJax$( z1j5`vR53y^dbM&39U1rI0_JI95LySmQAWWVwfNqC$p~opHaSHzc8)4iDL1SD(t~h7 zgWqUoBN3#e)BS^U`s%k&*55Y46o}I?ovKCwEg4@nhm@XZta)f_cp z8x9RyWhB;#@j>p{8L{mri(vPS!{$NxT83syFt@>VPmp2%I7GLW%06JTuBvbs%NlZt24j59~NAoP+<1XnwT>9 z=O@vvW^o_y}hnE0e{-!_&0%&H17l&DY6tmz_l-}!SO7lbK^pgCzOCxa7S?`f-_gY@&+<;)z@+?wk2NQFBJ&uS8e0({R zd?bEFBA@MML$l9kk@xHQal2g2W0yd|dH3}h46MM=O zeW1q>IMPC|sS4rSQ)A3+kpv9SvR+4v+H^(p)8xqwc})vleZD`$oN`0|3@uDvYWv>i z#b@G3*&gK=r_Oazpv-dZpAZmq;Y)WmFf_AOnxGGUcu#g2g^d$*MVn6Rlc$c@kWeZ6m3wK^s22E|El{8ppVQd&za_XAO9gUryBkl9Z8rJec zIA$cM0+kK)9lRsdj8m4B4Mm)b!-wMuE~muXzBll#e72gc2|-p}N{O}TcfK@A#C_6p zTUNPEnZme3S5c5@TL$cG!mJ4TE0Ju_zvQ7C7_yTzQHcg8r`$kU)Bmi`a#f+;j{2DA zTMv%W4%RE7hR$8Qrb(ww6i+4@4g)c!M~MaYtvO-H+LjCR@Eki{+yVSmOXO;l4Z9Y{ zQpv|mHR7N^CiF}V5OMe|xP0~(?R$(II!xT0sE(irr^e`h37KsmUSGv+9I!kxR%RtMd7XkzGd|Mp&Z|0{>FZot<0)f}XF5|_}fxt{fy z1oLSZ)%L5%rS78g5mw5qR7|T(asG=q_*1>?FQYX%>~w^H`Ci@(6Ond zqjI8BPa-0lU~{+fzmapr300+au7uv1(jpHt#ZerXrRDVp@cx*>0|gA#fFKTQp+86= z>E+Bid2)jMX{y6Yfx}IhFOVVeCQX1tuuq8i?tjL-6vEdUZ2tCC`vZhsO14(hLwqk` ze?{f7N7%?Nq-KTQm#8vW(Y%TfgD6A}%kCS85$|LiDJihKStJy#V=KVrsb6Nx#Ndg%f*AY?lPlD4OQ?fj!u|0(zjXfC7ghLk#NLEjwg`hD^)g z2Km*nPkw7VqhBf;q^v#k6l}aX;m|^Bx5{P~KzB1|T1G*UukEuoyIkM&HoAkgWh({B z#n~vS2O_s}mrjLO_W$f1jPX4fYZ=aBENO7~SLJaau5{}_7YF&On3qleq}_-;;pW*> zTK2f&iv9~C z#>R#?@tU3fQp;F)$p#lCvycdQ@? z$$3w(tUbBC59a}*U%N2IP~)RUIZ!aIH1}?CL;DCy)^D*H9}(|cp-M$65pcv-MpTX& z1q^CA1(r0$jxlu<1)StR&JRTGfP7j%27RiUR%LFV?hT=QbLHN3NxjGc_rBhm>6)WG zK(m%Ei{|LOD@NEJzzDV|+O(hhZ_P(-gvQoLqGI&L=Xk#kpGS3&C;6UqXA83Jp~=XM zQm0VWGR@?UACM-U`uTr2`|990zNI^X#mvmi%*@Qp%#y{77Nez=)?#KRi`1EQ`OG(;^YhzJggUb0nFJ6;&cJy$ z^UoJEgNPo82)AD>p22Rz?twt=g|h9VS4`arrUy$7sZVmuAJT8dPFlKnk+qQ7q?d%?>j@9D#%d{N4Lxut)Ec5r%)yA?j_@?}Edv7|Z~ zt3khy$opL8lPLw>z#%&TyZnVg1g6BAEc?!O5pu1%Sb2V&R87lfD>8+lTh2cGEuiQ| zx@gGh92Id`fZzJNVSAi4YRA*ON1&!~Na5Rjeh^^ql2xsrT8()qnip8nUN^hRfviR( zHuVGFCz`c2h;VSbhk8^r)~@K&ZG?N&QYW^YSQ{{r$(tYokkNff>iiS=Bl!ER-H8}X z(>pxmN^Sj<;FB_%K+A^W)6VE?QM1!=Et@5r4|%K%~}YTH5;KN)QQoK?ZDwQNwnm$~?{+ z)7iRPM^0ABh)lkJ$&KKp6*Za@0JSpokH$RM2bWB5w9n}YhXX?DiZ?d}uZJk~4~8Pa zK<$4P4#$`dj_UHDBLf(sqy*2!UFkpQ(ZMyvi=rzldGvy)XSDX{?cF$6@iwUb&RAoU zZf*ZrRj7_AENpPIMB_FNypEHxzO{=miVF~m6y=&F>mU-OB|B$%qYfLHiN)~omhyh$ zx#!e{c1?hYs@*xyQjx z7ugb?ik9P<+iJ;rf@Dh@zpQPIg<+0idDMb|@h5prlQkjb=Q(iPQEyHG=;m_;B|>&W z+7`RZp(O(0%2p%gfL)$m-Xsm~5=DARzSX_0O3d8Y(69Slo0m5`FAaIdQt&bt zcPm_ol!MpxkR#QGV9y{q?2JBorI|w)#4u5vt9h_Z07R)kI(AEf>Yd*$f4EoAgvoqt zm1Eh{ie8cc0~A$w!sTu)nbvBbIfc+hz}aOOxh!ZcEOPiN!4qNghf@hD-W4S(MxMyLF>!{6h5vH$Q}Na%h2-N#sbeA#XxOq=m#diOr4y|tsR ztzvJ(pkgr>tV%bnpGij#J?q8nd*%t=Z3!_RMYaf2jtHMK!mr%L4&k#DA_y}bgY&u{ zc`?H9eRM@&BdV4s2Y9D0U0((AK5+?aa+}%!^>zEk&J&prrmZI;;KU@upUwl_6^t~( zvKDMZJkY#aJ__%gTWc3RbaGLXZ01gCP5hyYmaQ_dkU=%qvd2=aNXn6fEtx^AlO!QC zcDB8M_?{!8_Q0=ee-#Eo#8&6)cKKUTEtR_dy%F1Hz_8oK7y);>Ah*p2e4JhV~FsHO@)u#%X>TxDnn znZ9o^e{(qJ>#uv>QFb{iyDFD4F@Fp~O$tp*T)L)ViY=H(C2qL+Oh`xB(`JTZ+sO=r+VlJAYf>5nqWIUV>q<4 zo;&xg`L-z;abRzTQotwQ zEjZ+0K_op{m$%C&fQ$@pgIgZ8JV|cdQ{{-JmoHGYlM!=QTkSEP_P({Ck>M^V;wLGux?2q?Il=^U1zV{ovZs=fHQu-MFX@hZ_ z8x1Yos9O(uiM9mMUPX)u6&99-WuaMHd;-x0a!=Y%C0wSJ^J{TEIefVrNe1bBtBQab zzss#7rngD0jJS*%dO7rzPEKEnP&6e(i%e1_Q7b($y~&@T8kdf#T3s2GE7rSd(aSUW z1^BX(3OnvH9XQ@R-rnSq4zd;XB51uI@A>V%8ETZ zuGVcCx<4%1Pa;V0>WNpgH-PKe-qLyqmopk$9v!TCTz1%sVu42M>*DKS;MSm-~705~zBNN8c)4H64Sn*g?G;6Yj?bsqiM3A0a8> zpFrd{ax!7^k*zW)B@CT#%=!1lK}?5#QLXX{^C$mUhsx%c_0Ud@(nv?0Pveot3ri`v zXZW70*q|XB5lA7mcJtvDV_FI{(jiXshv`^QeVf_At@UhsrJG*kqg7<@_Q95)f!3H{ zNjBweyFGXiLE`9Vc#wa+tBPg&RRiH4|%>nL8E&!wAO{v@V?e0_Ad6eD#% zQv+~Spek;2Cmc6SYDwiRSeBXrAQvY3`b7Z^Tz?dxV|f_C|M2&<&#B6S3%J zEu*cZ@1uV?q+u`Wr2%CK>Chx&+-juafrS;ZrgJMyk(&t1g@h=5;Pf>xlZ*L`EZgk= zh>hM+ei)gma0?#qrsZRe*P{h53!F;#S|8F69oo+BZ>@US)%X+^YN6d0tMbUxH~SSK zC)GaWbJfbcwV%rTqr>VR^(oYOgzM!K1l3XD=09?wSpPQ{>c6L@v2y-fwZB1vg58&D zMflYVhU&!HitpvMeHFB^lZVZZ+~MRqpFXEsz_+e^sKNY>B($Txh*AHoY5WR zZQhQ!w_2V2JOpn3t~%Gd?p@*IZAu(Z_TzS8|F(IA^x?|9R@v(}t7^!&y+R^Y_BQ^H z24(->2K|30mvONDE4NGm;9#$&fjxZXVCTDfhHPerXX^WFpf0E=2*s)xG6RqcpMMAO zl>c~G&EUV@*6xnS%(U6o#oz2`=bKhtAQ6l#XWtZ#6w1RAI#7z-{UY)%ERBvT_&n;{ zuD9Uo$&u(f?RuB_$@6*anH^$AixIx>wa&LB77>rXVRCuuAJ{CRdkXvZ@c2p;Hz@TD zjWVI-xQY^zVQBni+%+Sw);7O5 zT%5bubwBkUkyX(=;}x5yFn&fZ2e_6Cl8k=2SwY*AJbSSQ?ZjO!}@1AZ6 z?RvkI4{1Lt5X~PAUOzizaWUaqp4hXVoJwV0g=vK@1dHA5i#)?Cwdq3k)t73pSi$q@x~-elI_q|X%5W&LpR zMlF_~^gSz+fsPojwMPBJ`Or3ps!B_UJ zz$F8ZsyKb#UEVD&Q%^J`&WaMs57(B0KSX|xO!8qiEOA* z$XN3jCMTIYH2WP_$%!>ENN&nPp91mIR;%)mF5kGoW9ta$rIP-_IE#WSUi1EJ1y?tv z=ShhjB!(?c4o}=mmPS z1RWp^u4O5^b>>B(41W~(Ug-hx9r;tWl`go1RPALzf!8UvgJkcwi$d^ju5kyFr`Bo? zG@(kBaAUyfc+7a&@5%`VExy##8kP!Y#p>`IG^dN|!)XMOTim$;!^D8If=^pr12^PG_QS;Ue%E<2fCTXVOn3RkkGDv@xTiASfrVIrzSnonTw&mT_{=a&;h(;va$lVvVe70r zX6L2X4U5k&vi=DQjuu61IQnb1Jwvf`WwT*g1|f%yISkrLKS-WMjeJdVn!`|_0<+l# z*DS`?NT=P#aJ|n~@0{Ub=`~+7=BVK9lIjCA6}Xo0AK~C%v}^u*d}U+)H?0~2!1NdG z7k=o<8yb8wT|+zz*XoG|x(k=hsS*TXd3^E-xrfldM;-uvu5w8)1hky1_kX`Nq9d4kZQ z2H|&M)AOYA49UnNf55M1=e{oGOAzM?kYJ`;d@9$FK|@3)vzvF7HNEUvKjWXVEQBeAKcSu;j$lpn;)pAs-C~Y#}rtN9b|&tOx;bn z9P#}2yY?eCbih|LzIh#Ff!N#l-R0$T?ki{4{j;+6)({0I zBf+cP6ReKw$>Y(%1M!I^vVvuSfQx?Fb3I>i*FW25<`MWe05o+Z@$EmFp6mYuiP?BK zS^gD@e`&+0t65(p#Te`Fwbr;JJ&iNSty$a#Q5K65jgU z{@l6>cxr!=68H92Aq80Xow@7vaaE_`pmx#N-yQMvR$m#8_3-ow1tKItt5NSd1Fi?C zf1ts|dpkd+o9{~sh^XXi`5P$Rc-T3)RqwaqUjU!({c!M($M~T17O$6U}hm__)zbh zO5Bu{-C|iyPmPQ~N6X5>B+~39^P^!W01|MCkWn&FE2QJ&V6+*MiXkiGWupj^889~fJ_{Kba91Z zOXc5X#$W0`@jgGly4U0nc>`iI%05H7@Yd#=@5T)50chflmEfW7L|w zL*7>lo6^e##4`Ln8UvK{C- zJH%tGS9|4_QecYIa^L`Iw%eUDGia5-$3X-5mJQlbWuO$?X zUg(vfDdt{K$$P`>y6z+g%n-@3N8ioGVrFTkpg0Us-bug3go!VV=)6>Ya*;&Aa0rs}QGWHPHMCMNH4`mrXO)mE89u#h(^mKZ%0#y#<1;f|-wCEllKSf_d2;XFIVC@{Ro^nKD6KR7#-v%J<} zo-Xwow=b_31)t9}kz0pZzq1lt`DB27{u}Zazk`OadG}LR@1NzIKdk@64j}pfUK-oQyX-(%gM#-Q4>vxk2#v0!}Fg zL`;ReMx0!51TuGFnq|l#TeSxO(R*w}uW(P3ZF$j#$czPs1e+J^W)z}y0)SDGE*6v_ zNmb9>^|F+mOWXHde$kkePdAAq0`J}lCSbR`w#Cb^5omLMaDp`1CX;~P2uXmrTgQQ@B|{Eg8+%Z?z4cJ*Viz|9>E z-~GoJ-3gv3;$Ng!!|}G0S_HY`JEb=6MlT0O^y2)x3#t-c#(wW&M>U~j zr{}{@P%PZ@s1&;Hq^ST!qly*x$S+A@QKMW~D2@YGIU^;$t!1Czvm_CsiZHU&iDwUI zo2NacaFY!D+6+}kl&%Fu5VUDBvbAdHc78wXdp}b9R@+4EK8Cuf$?f6O{9EIM)i7Y0zEkQ(M+odUNO#q>kIg=S2S%exPKI zd`DH;zP?_5p4yQ0mMiwwRV${bQ#X@uC}tPoa=m$nTLuhVXR_nX@wHG=S23@rp%lNO z73U8JNTJB*sS#tbJC}0=4C)jPMN463*ca;-G#;eR4iR_v#@f3qj*HmD&>fDSmSZNm z@W}Ac#A9W4E0RShzCWN~LLhZI13)9%V$WkxS?;FY0|r;WF<;ighqYBeE0y?z)kGS4 zM!j70eC8kGQu%CoZ_~V{HXzcp^>ESwpu3SJR@$`diCxj;Oe(_to z>bo9bsHJ?mI*wkkZeaP1~Oh`YwUY0vT)>*7MiPw#3Zz}R3??x|@eDQ6O-05aQa zhzV02oZ}4mJL3I#0X0$1S)Twj8R>-fC|XTeEbZWY6nQb~Y9~4wr1!p{Nj1Q7{fDt27->=xTN>Am11BP@orVa?U)^uygImO8m{GcVs zotSCT{>y6PUp=lMAwns^f*baWhnr}=H$11du66^XLMF%uBwUH1h|jCHXZfF z@*TUnR*l*zvkpqA%Z#n2`ZVlBO^`Q-nes*zXR8bs6#Z6WIO`lZpYeS7Yt1Mg`^}_> z@A?yKFiBv1?mP7+t9xG9sTs$nWw)By*kDtyDK>?!f2FJp(P=T>gWm~sB=m_9p4^9p zoIO^fy(GGH(a+GQpP(k01pCY%`G|$JRu|6Cx+2K?^7X*SR!y!wJi3hRVfAKPYi#w3 zXVLm{vQ5VIH{W}_RS$^0t0b)-$*(~XwS^{kyMCZXcaWF2Ipt&7Fh#2*CNU8I(lj<# zw-GMYFw(JO*Qi(nmIS@*E@?e^SudeY`sJplhr7+~xdt;~XOX5#2>a0LqrkrOe0j6NG48s| z($Ib%n)l82z2=IyEqoo)ckXFCoXxx7gEWm~`kfrp68fqxF3m&7v|JvbpR={Gwy-d^ zs{<~HsdQiKx0IEMb8n>lsZ9J4@?(c;GY&z8+&xV(&+G*HFN6833jKxe35gtJfMtw% zE7V-#em;^gEb~j9a$m?Oh;na3u{z_nWQKa`>qHMSyI*S&d8?Z&hk+qHiDt|OSh z#9UoyQBDDCvh;xUsEp@&zlfN*Wc?Ds_30NPJSd+NH|t&%#c3vW zUQA@gzx~-=O>~RbFx%iB{S>&Be~F*?j99Nux+dc9>Dnc^AXAA79cdnvzBI?6=^w8~ zAovB#x;3Xrt-7>v{ZaN)(U`XU-kHDjVeqw&+Wx_JCA|OrmsZt#QAzH%avW0B@fL+z zCf%wrKIiLNF!Y23CZ)xuLcpIfe0-NmQ2dSx)A>yd-*Zpy9(asiV+d$N#m7%GI_$V2 zV{hr!7XFvd@i3g^&vh+jzSf#A8KjtwWc{o#|0qPI9)3$fgm=g|DM4%c^r2mT{L%0~ z&X1oicXxP1U0vRXl@#+w*Mi!+;=dzIT^j2!9BV%-m^efXpKzTa)yHHBmSG?~R6OMH;g%^}&DAf_ zhQ`3Gt$VCuq}@9%z;rw|*}c5DsyCwZ6C!$K<@JJ5Iwmz4HqppwGPIH-m93^zc3eC> zstWJRi>if`r*I!OjBk}LhK6Lg{P+WpG|Z-(c!s!Uk^CiEbBJ>21hjF=lw|irgO7qN z>XIh7!)*Xh+iaUqu&|2UQb%7ZbScYK!NfwGJE_03%Fi8#25&P!a0W<;WlCxJTUI(5 zRJ@JH*de(L6kM2EJlb~~b0G;9nAO@kX;0h*-UzJv3O)HR@OeSWMfk;O0)E>Uabl%1 zb6f7q#NjGPg(G2*q#y7pUB6#dkrVtL6IN(q{jN2kYrJ%J7Jsd*``FgHy2s2%k9e*j zggTc)*yc{e3IAGn8+at;hp=jKobHNi62G2}n2?OuxQ!96Tk+6%kYt zkZ}-;qfsfff1U=Vk4|k4iQl}ARxhX#B{~v46)t#jeh6SkHooELd1CkXYay_ zPZ=nQw+?NF6IpK87yOz1^GHrQUIHylyrlFfd4&z;iv-rbo|!dd<}9M>*Zta*aE+&W(5`P=t+UVopgDu)4N<8;qrrxU?wtg0A9!WG9RM&`c`Ts_+y>A#(^rU7jqfd?O8sy$1=|9vx>I36uXs zcab~(hO!AU(%)F|+X|W6o^I0?`DBah*dvQT zF%FmgfCp5%t8?$-0yd&xMqn#!wFJYu2zS?sVV&Cs%PhcI^pKcB0_CuN5^WjGs-Ii8 zSd!d39W!CsT|_x5&`}Amfan?NH+ji|V{sW1VGgI??Q>o13RZjtf|iP-735(;F9TSY z_Ic-E?p{rZNZECA(JW={-V6Algq!VuG9Wke|3^ZEgXiBW(iMIhNvk>I4+eHSOj+2y z=gmsCzRzJvq|Hax4nzXN9lolY#F65>-Cd_D?%JG1niv1DK6UDDop#c~GyTAwvLZTT zxOKP^!N!<1V-mP;zws?aF!Fi9pW1ce#@3;SHoJh{!s!rTpFx2}K=OQANUD%XX1N#g z#EXp?X$g(9Oxk6^!=j&r&fB&+fAemey0SX!&=0Y>#;-TFmz(^t9XNRW^z`kSh6M*N z2DXr4PO;6`x5hn@u)8~DL)K|jo19-p)P!V=qEB>EJ^{*)d^){&!w`vGpW!_6u5D0*c!Mv2#8wJ%WR(QH12XnVqKp_KP@g*k<@+?Bm;nuMV6;W3?ECAR^iw;nJ8c9-DJy{8evw%2Fl=_|2H$g@YG9 zk=yM=G~yg$l>M%8{Vj_Dq{V2WR0@>OhT5aB6=Wf zh4DJQT^m+IpRS^bM?_$8%yg7>ZUl=ig zPoy=u7xDk(r!4=HxKsCbvS3m&wN-O-U{WMz;bvx%v~h8DBWB^^;rZJA?_}25Svmg= z1}^n=T=BS21GbG=9PO5q!~V(^sbZ`H_E%)^iCW)<)y&fHWPvhc&bQ~y?Vt%_h%mdp=RmG&JcL%CkX7B_R#D+^VBpLP5cePp{KeWvN-xvKgf0W zOP6P4BSGz`_nj7oC3WK9tg#zm24S3P;J9(^3pylp#H`hoxnV_1kp;Fu&n1s*k#t9A zsLSb8uog5R@fC;*!4`8N967APo=oX%?R$gjLZR~W=$Vli70ZSabPXgP2ezL zqs@mj;b%&AwoaVY)9iJvU-(z0<3N5a1%X-+JpRDeou`HmqNs%cfg~XAtsP2)s-2bz z@ju|k9ULTxm37L3fu;}{v1eAZ?j&gH<7xFyM@yy|O9OB#lF>yZreN-zs6ACp#9s_37 z2K^R-d5s?hQ#IoyqX>%RlcsD5$8ad{m2>aea2@O^On%}T z_mn6};=+GDO?@4VbV3MW`y%}YZuU3wO^vuriBQU9lUPLGTBMdHsz6vix3f>vHn{0T zE(kW4qscfMCK4(SQyTNo4GrH%q<4Ks#+BLk`UC=E2&Ol2A_yO&8ZIUx^=n0-A!zKs z6o6kxu2p0baY&6IfUvpw9_;Dq)-!Ohz$nO05SCSOIYW?niHHR?6kWqzYt@dDMy`58Y*7m4JY#}xe8vnxe~32o4E*-d=dd5 zYQk*d7h!HtC~;^#!^HGMHITh|QBmlp-`>FG@T6I0zVwCwtR*QY*b%NY`TPnara0eX zPEe#=lSsd5a~~V}L7bbdE#gp`Cb5PMZyA@ta0T&V(-Q~J5t40$G-KR=r03?|z@YSu z*G4GMfpF1Pfb^QSN#Yg2{U`y669a6Z(S(Ie6DJ4xLuN&kt$NEJFcYCtf=S7quYhv( zzyl$r3y2YkZN!X5%8=eFg2meTCSJUCHlR`Mg^f*j@EyMOU}1<<9?dHa&U-Yr7%Hw~ zd=Ex^94Og)A=0YyV&xegukX}9Hb9a3!@#&aQ}+sSqrd9DH=lex6_k=f~kr`(U@Ig@_hpc~&#qEpTq*U~t+1Bzhvhru}Hf&*y z%OMVYeIwXr1PXB`ugFgj87ZCBB2zV^{eflf8+-)t3|<%B%V><21(Y{v zf{Hq$ri(})2(F47`!h1jeCurMYwGNbyAO^0T};uITY7In#!tPK5E@H^CKlud{3#<} z+*zaCIboyc-Ew)cjq1`Q7-UEP3lC4)|uFn8hT<8 z|DW}9C$NK&BgUz8??1cH_rT_{+dF)dq#rE#*}|0kwNO0Jz8Ag0f2QRV%BxFYV&U_c znhHZIq4=vO9-plzuNlU-GrVUIhR87-%a5f(rGAOVY!@!Y;ASO#|B^_0@gH>gIRMxz=i+;dk5W$teoEkbP96OYC+>zhMfkt~DNz zzC*9SmAot52aPzaqwq@1 z*Es4#mm(XLeUu`J(AhJaP~#DM6*Xu<_Rr~1age*#PD8{M3A#9WKuqK7T}r*{)Mf8M zrEQ$p4=M=e`6whA6<=&ikP=%2vTHoP%yD+T_;o)#jEbfa&GZd1s4!1Y+p{~NY)B*; zyt&puYdF2owuoGf!A%~&E$q-$Vbf9GUtFtsSac%pB7%Of7_mL@LRr7D;Mw*VBywMP z4jP$q2E!=hUSwgW-%s#223>_NO_?qYjZUxz&1lru_zE9W9YpdkZ+oj+bV9D?R9X88 z!Xl;9N|>fz1q9MM=d(+RO@0mg@}#o<5ftJmaF%|NmNju4A+P}g3yaHgg>lPjd5h*< zYwKrj4uQHB?nWQ(NR9t;fikm~(s}`8#_~*D#Jz)__aTobI14-c6?V7oRp-VsnX$38 zQjO6`BG#L~3KF*&d*e$C6Sz~VerMMLa&^Qe-=MKh4F4+*GIogrPDb0W+qkDNGHA6z z78i{l^v%5l-9xjrH^MLG{|TrNLc~4{RN594;zw$_zinxMajEi#WOl5vpBGU6nLJtf zE-_#|p@0CiuMDjp8aWX7OH9Eu@B2|*J)aA^ykBNGr^3wO%{+}7v>(wO|B9CG zMx1{Zq5Btw_|I1)IL=yYP*UN`(^sz>@ulP66 z%J}jpgnS2o*rPY+zX}50e_uyMzoOpbkt}b-pIrU)xS}P1?r`$2TLPZ^C9ly|5C-h1 zfq>l0tMFI`o`0UX^rBy53v;8%c?q>dNXp*%qdjM9yVoZiD{OZ;K_cVKQ}U&Gr}ma@ zcC!#?%=yD2hcta7FW_uoL@8JKrg<>waPPurjnT1F$d{{~*Vq51>*WD+A`w+K-NuC4pP5srO(t)gUw87x)aD22isXxE$dx0?Y@ zk#Mxl0qZ=faJM}?IKKQ4T~bLH&*vS*Yr7-C%u-eoT{weYsnD!Qejih(6Cx@dW=W{1_ zInR|#dfai3(My+Kw}(Oj&M3mJ)l z(!R61#<1LLdDdF!z;I);Kl66?3xz|o=HsXPbc(cxObdMY!%TrFeoMFN0DHD1XWxhA{U?4@;CcET9~o4-(8mv$Mqlw{HQv#1A- z-rv5t>K!fv3uKPEu7BYx(7E53S|$w>mpB-@8$myq`waa2vmL@hi!^W?`1b{Swq+7* zv)!Bt4DgDMBmRLKh^>(Q+R5lFm!5`xLim=!vJ$9&S#lkvGY!(pfPN_e;CT+!I#Xe# z%IvUaQF$63a%lN8fCKZuvNw@zUBE5p!gn>qJ+1;N_}BntEE!<~z>L9e5#zTj+)hi| z){EMj)RGD)B^$DMs5OwfJzqKZIK0^GW0#vs04iuW!(9AMjgdP-fb_M=j#@Qn*`zdu zyeN)hbsQS)$ZL1yv%dFh(&(LLJ55L3bMvitsHilsvtX!9xo`K^qHj5+^H{$>>rg9K z_OS0X!|0p0-3K?b4lnccjjwKQAkvxZI;U6>GUin#wGXy?o~E?=WD2lNJ~2<3>QXtf z-?}_*6QR35x+Hb-YCj+EX7i+5my;YR7wg=h_wjF~kyFeIK%cHQs=7gVq`vXH*>mAE z$ZXWcJCuEnSY3Ucr2RZ4?Gnmj&^q^Zq?F^Xi5^Z`ThiUgs?_cCyS__e%J%=L@ip3h zSFzDO3TRJfw9-`;fb^tRGq8@0wLW|{5A2QjWSRbRhxeDUB`Uf+a;+tH}T)hesFM5 zyyIp6Ou?6CCwX;GzVaw(5%0#TT|aWrf^MmsY2bCT-eJ(L^v)#Cvr2n%D@Nll;vbTt z!9#dTMXWmrw~o&2iNWK&>K3X$F-!wxUc_DKNP}8?05AG3%0Mqr+NI z9S2n_2XysgJoh|r4BtpTIus=TTDr{sdG(r3;Yuj?18E`Ac&R3pDzBwjY!>4Gd-?&V zeO;Ca#a$HPIu^SJtO4EhY#m|b@#UCCZ0qRq zf^f^oGK&5^=qIQ{`b&8L5$W_N|NB+(L3wAY`{>JKo5AiKIEzjovq}YtAgi5(uXi|Y zGuFKer(MdWZPQso>v$E4KBupKldnE!@wi3z;qBA5|I^N_n)cPpU5Ghn$SC}->L~mq zLK;Wm{;qlW%kwA8!RMWE{Mh%DF<;<&i+yLhQO$?y*wp%B`Sl}yj&I|5{MfeE%tZd5 z1kd{PDa-j)7axC;YNqKP+WEoycVWeSSO*>Vv~71yz3C$>hlm}%P`qBJ?%``Ev!*7! za3LQ5x04L376E+nmiKc-5C9*juqGpqUKuzKA0jX4n?xEGPNugnbF)WORKtdKmBRbgpc#p4cE3{ zC`8V?TY}C9wB;y54Y?969TGscYf&6`MZu zo|!Mt<4{I^?&`($ZrgW+P@b z_&?-XcsN-8Ezcsb;qGNNya?&kS#KeeOd*FE!Z2E&;@LSdF=2Sm%J%gNNx|uyfLBas zUvR_wUb@?q$GPD*#b?zOI8|_Lr8Aes$L9HGgUyT?8@~JVJ3IGYxIk=s9OOD&xT2r` zH%PIzUSoFb2}tmXON77<#uq!Qj|c31m?5=TE7`3;sV$_g-*E6YH8I#U1}4xBSTgx; z$Di3DdH2#c=01Y(8u2ly)B?t(Ib?~Vr!ZpUXQY<0jsdzT@L7_PdMEzICoe)MbVW?? zA(YXDs<6h`PmPgrb41}f=Mr<&;Kte?iIG{X$l(fj;`l%j=8G!oL`9r2BX^W=v+fwa z(|+R?ZJ7ZH9K`-CIZ_-T3Nt^KPzMl&BYfJLeUJQZFY zBvl!M&)wS=HwE$tYxw`%1GWlJ`jV~!y@fjiNMXkOa%U+4_+z5EtCj%$G1A;cAqiO( zOz=zhOIigTFt_gnM=MO)C7C6~M;;*kkqZb6XDN(M{1jc2AQKq;GiGKcD zKcpVqtEfO)VN7wSikGyJx;-dv0`h}HrV!DB>DtKu!ks3J!ayt#-~;q$EYhmo*sWO$JF={I3@RicgcUz?=u#vrh@K56H|T~LOq z4kgx98B<1d0Ukg)=09|(HcG9q`%xjJ1k}sM9k`5U1(gG%DOYTtXG z!>c0L12uW!kumFU>Vd>jVfn!xT5J^~VrBNHX_pep(j$gA*U(Q#2x6oW=`b-MQ#(VNZDu(6FLk7r|4z9 z$sL7=Su<2YN5k5}r}NasZ=;&Uk5q3H^wo{b35!@09ph2cl*)n+BHEhhbJZno@2;Zg z3)Q7=e|w5!s@M|0bS8|L$|{ft=CALd$}*6Dsx@yE0oSBI443OHzVbsKH<=?YvSO+5 z6%v}txV=D5C3A`*7I{Mh!3t^xljt`cbB-b$`PNt2&hR<>V%QMzB~{%X^@rFIURkL<+Yv#ou@NA8V8fJs_7|8S>II1Q7}gCnIkIhHjl>7g%3K7>yE}RgbzOT z-vr0chYvr!%aK4-3-7sq00EEz^O)Z|qz|Yqu;oAJ8xOH9)T8`pTryd4Y06&VvvXrb zWP6BR5?L{6ST-3IRffol?xjdeXwVW=RftY;#>5NNeRU4#El^d{Pw(7+vO>@pxGDK& zvtrOd_^2C+r-cJ&+YSwL<)y|hLPsRV0P2&;b`>k9lPYy;(#GV;?>GW#D^D( zfC^x%bZh?b*)la8z(wjQZJ8z};dTQZfCn6u_I~gMWB@6oy(`K`7{*u&I|9WII4yWo z1*?c%BI?0tKGzsrQtDA@w$Em#1jcL&-|~mapJ?oiInV75!N+t{vvdhnmwNFH8E+%& zL67wPjjmJcQI2SR7T!baVUBp)w!LIm;a%bU16AZ#!Cbiv31TU%5Pkyu0;8@%TX&?s z#439E@9|K`EVw2LvPfls0?bMu!sKbH(03c%U#S1r*f5(RQFImQ?rfOUatt(;s|mGE z8L_vcpVqVpKipeLT$M)3Sdc|^K#~XcZqS9)2Ds0>y~Si&k{Q%mNDchb)i4P-oF+Z} z!k_M#3iNM~z5Oi#8%Gl&t{RhoJOiuHt*Zh+6p-`a}h9*zwrFD01q-T6%jbRTnL5 zrZR(C`p+0?Mu^%QB=jhqrj7 zhcuen-#^J!ezZwFZbw&+as+o!MkS$iReSnoU>)B)OR0a#@+Fg>s=_V-+M3vlfZ^_it9&~`lG-Og6UTZ$N#;8i~BdF=>L zl9DyhHY%f-i&8~e;`$!tR?Hss5K={IK#gGXp7O_`O%=EI)xS=fOV&&~@I6V|Q!r!LG{j!X*OaGvy9`DY%XOE zv8?et23?sKD4i!QBr8?OIgNFybQ-!a!O`Jn2TV{-o z&4(903&|!epaBQGQW=DsQHLbF-m(GefW6ZGO3hi$z&z>qh94tdW6XsCH)SK=#+(X2 zo;UzeKosfsO9g-oP^A{feVa9n6_;~8g;b5&%-Ho*m+KcRX45qxzy|1CJBUU)Pm^Rk zeo4X_!iv+>G5dx7YQ}aga^{#8wDyw^fs@7Z5mjQ^=7<)M_5u$a-x)0^?ccYs(xlQL z)+2XG?`T|&Gb*S5f{p2~SQ=vLNT)%qgKhq1$e)OCNc$6rsfO9tq;I5_tc=;)r1Nwq zM-yYRE~I3RV*z7df*3_#LLYWnUOi1mU1987Dy2Y2Q(@xUS~NmChP$#gC-7-Irn@3I zzn{zje5my|k~L?r0H3>#8Q~q1EaY*Isw%M;)s>GQ=2UJXuF4mjivw0kS5$5Pj;cqn zsdCfXl3)GV@TX1EA@4$5_w$@okET6=)3$kpbL@Mef*w_URy~wWj9YwXNIjN~-Mz|1 zA-?dMqW|TV1W#mxzYlzEh6}U}l^flP7*A{islk*ljTFFR-xVM_#!@KYtz=Gg$USFh zKwY2X0%qfQzU><10&DZ>rFTGl$UY~SL*o+Z0%@~-YWU84NIw^F8;PHn86hBJq!h0j zZQOjC?iA|+>QSR`zx^YBj%wc8y%&wPbj9|q#fXOA>1?y2HLL&MLUx*6iF2D{!FXr8lyaBh!k35c1 z`uY69{-dCPao})m&0Ee0#{Vem%)_B-;|5$(lqF*uBg8>wtQmx|WmaRG#gZ+hnR-!{ zi72#527|^s63IGaUoz#zWJyV5vb;@}R76>_WGUM#%QxTk{rUZUuIv1Bo^${1>weDl z96srz`9p;!9PEAze%)I;Dq$@{5WoFABzy>VdpoCfYP3M<{4Ewn-CT&4whSF=O2GYX zKWp7a=en0WO$*u!_^PM3vh=7~0r9WT5GK^LrKDdhFcwJjVH9kfRu>!dgH4LSUHGcNjN+l|$O?xJNgiVe`Z{McH6V=iV z#|hb=92RTl(&11p`ZoO-2&{d0=Kdj}>hrO#e$a0vZU}B|2`!PRI#bt&YGx{9YyUmd zfhkW~@%BV+3Ed@h>n`>-QEbNGh!FmfjL{u)h74Ox@M1Fg9!%2s7=91z*xwf(2W<^T!G3=ObCrk@>bvec$p!}))u7r0+!5w zux&f_SVOj|;OGIN^MBIZc72A#kxr^_ds#E!Oc(4eOny6u*^Ax94?UzZ4Y9kwSlH`A z+T1d6Vu`R%3EFniEI|9{jO|fyIdW$2C613)x+P8!5OcX@&(dWZ z<$AG&?tf^kJDlcLx)T4)HyJC%SGTB41C={KBrp9W3FRL#cDcys^c6nd!p9m^j(|vC zdix8AglUe=TM}4m6s_EN5^9!&ZnwPAjNQjqve20^`S<{?*lVf5Kr_R`3-09|2fL)wG6@cq5N0|5glX}r0@hvdlDw^;n)8iLA} zn*MM_H~_AW#Rk%_NBF)LU;E?yeE6{zwxjBTG|ryhTdv?hS1c!2LthpgG<2)?sNg7F9FT8xG@|_){m3bv>bra9J z%~7qnv$?)fJbycQg2>omJ_&OU(tzLQ9I45UM;#!py{yNtx5PtZ#=Y5}|D3~V_#R15 zmMol441Teokw}z&xw_jjc$|N_QMwa#pCsKLi5nUKF<*!IMSGI9CM|r;n}K4e&KS4W z@q+23maprmECgY>e@KGsp2p6-Gl%kf{g%-CYPA~*&!bA$9Ij1vD#%To`w9}`Um|Rq z>O+>D1mGDFi{{zXgAl{G`W*WvI(^BBQO>O7K}XPJvVQG>yp~SxF1E7o{D>0{fOLj& zbuLeYFGuda1?4>WB@cNgf!t}-({Fl)=-j*pq`>St(;o3;lR=O_ZD22)gMDXG4Db$m zjO^R***VFSCx0=}=G+ZHqw8ua^zlDZ3y|YAetu*f?E_JABkK!A9pfR@yTRt# zVhg=LQEPbW_(FB?$XOh$F|k>bh=ob5KUzet5%{mH{TfQPnbfepfz_owY^yIRk+!!U z5ce*)BT&)=-S(E#>Gjg2Ut^-$Fb(Le@< zX|triO`I@h@5vk3w04DVj}5aN=V5GHt5d6GFCM}7fg1rHR{#jl6|OlrVo(jn@0PsBL%Pz z<5Cd{;lztCAG@PEP}%!K0o{z#*;1jyyUC40)Km+cIuO|sp*^j@S-w?ta0~FQSpROr zKQ@N86yxU9voZ(q4_|(^F_dNLCp1jUGGr*0&GBuZgCviar`C$F_c*enGiMo2eBEg9 zidbVtKRv5;dRTOExh-h|f8upa zFEqn(SY&b1mqBD!FO8lAh&dd&QL#rM@hxo_!aj!_22Qgm@>vr(5M{rXRQjjcNrGqzowi*@G{ zHt35fZpA8zMsGBUPpBd`!T-yChmHAkR1ndneR^<`ltNW*eR|XN3jg{B^`>k&0(Q5y zd1r#llvr{fGOJLV1Y#q1b&2^@NNdR(Knm(P798io(wNkZeKM46TI3sFi#g2bWFA>s z_0baCqsp}w?#cw>n)ZMFaRTUpHjF>^b!Ayj8pfLV%Lblq68l;d0vN#7$9>BCsCxW; z8z*)ELC!Ck)}OX1&kN;Wdp7z{q`!ETamslkZACEn)bX@Y5YZ)8*867q;>8Z zBTZf|c0E|wepoNpx9k|b@+PshGuJ*P1SBl>ya)VXlUqCIda(T~x}k9|^Z1tE%0Q61w#cocG|3`zyKVGc-Z`B7j>gd> z$-<7Yqgh&TrflM^i+Q}`IFTI`_p6di*PUBejD+IvyU{Q=H-yE(HV*%IW|B-)-uZ5n zLN8$^?#3d?l5CMJ^IaJHArZ7w3PyGc3A1Z2$5>|amux?`KJ- zJVBNp*d5AGaVqJ*y<5r^dcWEDu3y8Ga;CTVqa7`HD)GqP7itPlrTwUv)pN6wIBU_n zT|)6+1<^`Ux{FNh)G_N?&tOuZvV!zDX*NtGvzFG)HboQ+Dl@J#r^HSFoer>J?-%Kb zJlc9&aOln&chG?K99>XZ(~<(cBJ;!K4B41%Ao4nhreF9RbIwhI!DdQp7h#;=K~+JI z`Uzx9ww#E`{iLdbh|}lt7UVpLT;M4(YfBerF6!Yb@8vv`_HvL91VjH5pND939tyS{gIkvbm$`Flk#@O6(!OBBfMLLF z7jM4dPu8PAMM6hqhS8AwFaK<=UoMrzjQ!RDPC+$gHqic$uMyE2OYbBZe$4mc$3hi` zogwiB+rbQLW}Wzfh_9S1xODsc6p+Al5Pvv0bT^LKCGPRw?5Zv0&|Rq*Vf1lAJ#BKB zP^X-{tD2LnQq*ntH1THNdA^hApG!$9h28dHjXOOU*j1U_g1%m3zOU#sQ_<2TJ8?|l z#*kzFCtmZykeb1fX&;$HxeydJqVfKEt|Udx=#WMpgfA;I7t)?T|B*5_hN9N{hM+z&xKl>dCmaQhhME?0=x3SaE!T--6fygx9-skw3RLkNFDyP_ zd-qYfCd6FVy}8cZ7WuGQpMiYgQi95)m#Zs0Lih%3x|kEA`~n`{4ZNOpu`vXqgYIc z{>Xba?_}zTA?hmweM0m<7T=yOp`}tK3jITAEW(2NZZP`K=(7fi%a7vaM?|CMS zK7rzkGX}Ekk06^|nIwV$WHYXqM9LMu5X8f@_O0{<0Ouej<%|L!X#QRAwY|Cn^bib)vNw z>m*wrSd9nFpp&4$8${MIwg~X^PjY{e8&b>GlXZeE3+x|2&EkK_KztophHPcvf_X}R zu^Wcmd4;jbRHo@~W(kXrGjh;bArM=h${WlEQlXJDFkgMaBO;h_VHKH!pVc7t<5)2E zUSJ5FY+7uJoVcdLm|~)7R=;S^3rx`ysFB_0EK}5k`$%woktt##J0!Cj)&shZ$vS@o zCxNtyb!Hi`wSoL?5=)h>3heIqvaH$GK#)5@sQeLjC3Q?J28SV+wCV_w1d!~!NZ<*~ z??E>EPnjXJhNsU?f3C+q0)H0?ouL!Y+q;^k(lO@@7)KsMq z`)EjFcf*M!$x=FIs+594Czc~Vf!0h6|XKb#TQVwyxgwp7RPAHFn z+q^S;Q}U#$3OrO@Z}x*D8K4+)(6f2hWGObBlDTWf*_=II z5_-u_h5E?BSsQ>P?7a2v{*Y3_L-pXc8o~#dBO~$~h5=zxc-*kF|PK}yuHp(lh z>XaPnqL4Imb!v{?g;nT5$0w*M;-LDRbKK}OVGx+xx9#^Ec7(B-xljkjpU{}oF_3^g z2AR!-zX$k=NL6m6QORY5sVSCxkaDVMnCt0}8@}@wn<~`)Q=sZ4ubWu10$b+2NZb`~=i&4pGJeH_cxm;M-baVL`KOUOaWGCARs8+%=8d{M zs?z%eq2c3Q)Va9yYbS^<0C&NM;mjn_LY@gHKrZ_EQVvg%?}bcPOu5X?MXXe{E?h3o z#jNm&jGs&Zx%iLb@aZPnkL@VbHKL)$W&wj|$fqFlKWIJ}Vd~L#CaZXAd^6-%9~dW# zs`}nF!pD&H#cpLzLzw-|LEG2sc{lm09ZomMk+-Sfx|PF7Y2t#0V!zp}%%n}gvICF^ zI}FmROy3rt1O;UJ&{Wt~=qi^O#s#Jh&CKT*HJ3;~6a1L=$+qM6nbN~37vk+Rea1jg z6i71w@gh05L`(C;W;PF!e6Y@#+h^tIaQbpiP2V*1V#m~uQ2gKA{WzNgpqQo|{gUV; z--3^z&!w15Fig6`W$vHYq>QwW>~SDV_=ES5x$j*2F1xA?1xBU3c|h%4Xd8N2eeItG z&stI}t)l7!7TmM_sV%HB0NkHCugq{V+M62wEnXpy*5-%{50q1KEX$?L{!i zI7$b2*D#>S4Hdhp#*oLEb(r7O3Mg^I2>$^Ll3*YBCKg0H12Y5JDuNu?{fMpSH`7yz zN0*BN7^b*=9km1UbtGlr=3+K2UZAu*Z7b(cYI=IBwpvL35?WiEO9v|O{)VR-LlP&^ zaqE-zx02_`ejmreDU)pL!G^k z^Sgm|530(rp0H#bXX|lvV%22}BM@u5`Rz`)D6-MlV;QI}%$nl%<6>qW&oEX?ws^&U zZRQ~mjteFG@8Y!{3&e)gBSx_JLl3rbQ4AHFExE1oon@Bb=&=6}q5%qWd;VxAjVbgP zps5lI;h)nI{6_JK_tinly2LcNd{Re@F!#THP&O}HZU;#~jvN(QKU(v>{m~e0zLFMq zL9wftjtUra5$^RaW9b9+4TmTqvLMLbe3{>&AjnEUDfz&pyyOB9?xM zG}F>5q)XcYVe+YDn9Sy49r?-=-TjM!D6f=U_BP6!G^lauDnpoj4ot|;UI=v@rsaO% zKKZBkvVEGjzX$LW_Sg~GR=STOL9LOeMX<^ujf0Ge|E4392GWd!qOxw%;~|$!(#R@r zEwaNEzdLn0( z>SIQo>V-?_`Z>qL==!15Pg&@nhl|%z2{Gwqe!l%_dO=b0^^QrOT97|)7p})TDzttngsLW5lKTWPea==h3X#GI_zT2N1PydW5;NyQPEYb3(&YJ?$sI_kG z+8%l!J)~0-U9WtS_vp=|b8d4b?rHbpYX^eN>TNu$13dK724>IIXLwd0cGtTyP;sXI zu6wnXyPng4E~o)5Lf5Z0gZ<^rb{p&If1i zujUlH->>Godt85`D|Tk`o6C2Io1XuP;}!bDZ|HhTLnbvBtU4Pr!@=KeI*aKTrGeSf z4|EjWQ)%ENEE87h@wIHgN%w6POUw48{&kA3kz-GHrDO|%uDgq&IF!?mWyZ1K32r+{ z{0V}Wxh?`tsVI|tXh_%1M^4@>vr6ryKT*QK*Urtqvv?3L`aKMt32S%|ZuMQhGh4V` zrcEj&-81JZe^K3~tN9dn%Nku*A|KbwW*-|();yIfKFU^cLTd(>@xCuq&xI+WNq)qnMQ=}HFN?bL5(vxlp76AnDUD+`+bXY)=5_*f@++43d^r6nH94y=Jz`>a_R^smO&@%dMe8-Wz75wr=-%J zcJw>#T)6$)W^q~3D&cGli_BDk2sggAEeEY|&aP{xvo#Vm>^VZnqVs5)d zez=a&fzBQtXHy-tFB~Q z>RYKT#6xh3iroV4W*Yw=14ca0I%?-|Q?%!V4Ap4pKZKeON?LQ>!RLA$bJ?Oe=QZJ( zX^)rqV((7u(d1^#7m2&YA+|=T@iMiz=ZEch*`q2LX D5x4Bi literal 0 HcmV?d00001 diff --git a/info/gcl.texi b/info/gcl.texi new file mode 100644 index 0000000..a8db004 --- /dev/null +++ b/info/gcl.texi @@ -0,0 +1,2077 @@ +\input texinfo +@c -*-texinfo-*- +@c %**start of header +@setfilename gcl.info +@settitle ANSI and GNU Common Lisp Document +@c %**end of header +@setchapternewpage odd + +@ifinfo +This is a Texinfo GNU Common Lisp Manual based on the draft ANSI standard +for Common Lisp. + +Copyright 1994 William F. Schelter + +@format +INFO-DIR-SECTION GNU Common Lisp +START-INFO-DIR-ENTRY +* gcl: (gcl.info). GNU Common Lisp Manual +END-INFO-DIR-ENTRY +@end format +@end ifinfo + +@titlepage +@sp 10 +@comment The title is printed in a large font. +@center @titlefont{GNU Common Lisp Manual} +@end titlepage + +@defcodeindex fu +@c function index +@defcodeindex IR +@c reference index +@defcodeindex IC +@c Code index +@defindex IT +@c Text index +@defindex IG +@c Glossary index +@defindex IE +@c Example index +@defcodeindex IP +@c Package index +@c @defcodeindex IK +@c Keyword Index + +@node Top, Introduction (Introduction), (dir), (dir) + +@menu +* Introduction (Introduction):: +* Syntax:: +* Evaluation and Compilation:: +* Types and Classes:: +* Data and Control Flow:: +* Iteration:: +* Objects:: +* Structures:: +* Conditions:: +* Symbols:: +* Packages:: +* Numbers (Numbers):: +* Characters:: +* Conses:: +* Arrays:: +* Strings:: +* Sequences:: +* Hash Tables:: +* Filenames:: +* Files:: +* Streams:: +* Printer:: +* Reader:: +* System Construction:: +* Environment:: +* Glossary (Glossary):: +* Appendix:: + + --- The Detailed Node Listing --- + +Introduction + +* Scope:: +* Organization of the Document:: +* Referenced Publications:: +* Definitions:: +* Conformance:: +* Language Extensions:: +* Language Subsets:: +* Deprecated Language Features:: +* Symbols in the COMMON-LISP Package:: + +Scope, Purpose, and History + +* Scope and Purpose:: +* History:: + +Definitions + +* Notational Conventions:: +* Error Terminology:: +* Sections Not Formally Part Of This Standard:: +* Interpreting Dictionary Entries:: + +Notational Conventions + +* Font Key:: +* Modified BNF Syntax:: +* Splicing in Modified BNF Syntax:: +* Indirection in Modified BNF Syntax:: +* Additional Uses for Indirect Definitions in Modified BNF Syntax:: +* Special Symbols:: +* Objects with Multiple Notations:: +* Case in Symbols:: +* Numbers (Objects with Multiple Notations):: +* Use of the Dot Character:: +* NIL:: +* Designators:: +* Nonsense Words:: + +Interpreting Dictionary Entries + +* The "Affected By" Section of a Dictionary Entry:: +* The "Arguments" Section of a Dictionary Entry:: +* The "Arguments and Values" Section of a Dictionary Entry:: +* The "Binding Types Affected" Section of a Dictionary Entry:: +* The "Class Precedence List" Section of a Dictionary Entry:: +* Dictionary Entries for Type Specifiers:: +* The "Compound Type Specifier Kind" Section of a Dictionary Entry:: +* The "Compound Type Specifier Syntax" Section of a Dictionary Entry:: +* The "Compound Type Specifier Arguments" Section of a Dictionary Entry:: +* The "Compound Type Specifier Description" Section of a Dictionary Entry:: +* The "Constant Value" Section of a Dictionary Entry:: +* The "Description" Section of a Dictionary Entry:: +* The "Examples" Section of a Dictionary Entry:: +* The "Exceptional Situations" Section of a Dictionary Entry:: +* The "Initial Value" Section of a Dictionary Entry:: +* The "Argument Precedence Order" Section of a Dictionary Entry:: +* The "Method Signature" Section of a Dictionary Entry:: +* The "Name" Section of a Dictionary Entry:: +* The "Notes" Section of a Dictionary Entry:: +* The "Pronunciation" Section of a Dictionary Entry:: +* The "See Also" Section of a Dictionary Entry:: +* The "Side Effects" Section of a Dictionary Entry:: +* The "Supertypes" Section of a Dictionary Entry:: +* The "Syntax" Section of a Dictionary Entry:: +* Special "Syntax" Notations for Overloaded Operators:: +* Naming Conventions for Rest Parameters:: +* Requiring Non-Null Rest Parameters in The "Syntax" Section:: +* Return values in The "Syntax" Section:: +* No Arguments or Values in The "Syntax" Section:: +* Unconditional Transfer of Control in The "Syntax" Section:: +* The "Valid Context" Section of a Dictionary Entry:: +* The "Value Type" Section of a Dictionary Entry:: + +Conformance + +* Conforming Implementations:: +* Conforming Programs:: + +Conforming Implementations + +* Required Language Features:: +* Documentation of Implementation-Dependent Features:: +* Documentation of Extensions:: +* Treatment of Exceptional Situations:: +* Resolution of Apparent Conflicts in Exceptional Situations:: +* Examples of Resolution of Apparent Conflict in Exceptional Situations:: +* Conformance Statement:: + +Conforming Programs + +* Use of Implementation-Defined Language Features:: +* Use of Read-Time Conditionals:: + +Deprecated Language Features + +* Deprecated Functions:: +* Deprecated Argument Conventions:: +* Deprecated Variables:: +* Deprecated Reader Syntax:: + +Syntax + +* Character Syntax:: +* Reader Algorithm:: +* Interpretation of Tokens:: +* Standard Macro Characters:: + +Character Syntax + +* Readtables:: +* Variables that affect the Lisp Reader:: +* Standard Characters:: +* Character Syntax Types:: + +Readtables + +* The Current Readtable:: +* The Standard Readtable:: +* The Initial Readtable:: + +Character Syntax Types + +* Constituent Characters:: +* Constituent Traits:: +* Invalid Characters:: +* Macro Characters:: +* Multiple Escape Characters:: +* Examples of Multiple Escape Characters:: +* Single Escape Character:: +* Examples of Single Escape Characters:: +* Whitespace Characters:: +* Examples of Whitespace Characters:: + +Interpretation of Tokens + +* Numbers as Tokens:: +* Constructing Numbers from Tokens:: +* The Consing Dot:: +* Symbols as Tokens:: +* Valid Patterns for Tokens:: +* Package System Consistency Rules:: + +Numbers as Tokens + +* Potential Numbers as Tokens:: +* Escape Characters and Potential Numbers:: +* Examples of Potential Numbers:: + +Constructing Numbers from Tokens + +* Syntax of a Rational:: +* Syntax of an Integer:: +* Syntax of a Ratio:: +* Syntax of a Float:: +* Syntax of a Complex:: + +Standard Macro Characters + +* Left-Parenthesis:: +* Right-Parenthesis:: +* Single-Quote:: +* Semicolon:: +* Double-Quote:: +* Backquote:: +* Comma:: +* Sharpsign:: +* Re-Reading Abbreviated Expressions:: + +Single-Quote + +* Examples of Single-Quote:: + +Semicolon + +* Examples of Semicolon:: +* Notes about Style for Semicolon:: +* Use of Single Semicolon:: +* Use of Double Semicolon:: +* Use of Triple Semicolon:: +* Use of Quadruple Semicolon:: +* Examples of Style for Semicolon:: + +Backquote + +* Notes about Backquote:: + +Sharpsign + +* Sharpsign Backslash:: +* Sharpsign Single-Quote:: +* Sharpsign Left-Parenthesis:: +* Sharpsign Asterisk:: +* Examples of Sharpsign Asterisk:: +* Sharpsign Colon:: +* Sharpsign Dot:: +* Sharpsign B:: +* Sharpsign O:: +* Sharpsign X:: +* Sharpsign R:: +* Sharpsign C:: +* Sharpsign A:: +* Sharpsign S:: +* Sharpsign P:: +* Sharpsign Equal-Sign:: +* Sharpsign Sharpsign:: +* Sharpsign Plus:: +* Sharpsign Minus:: +* Sharpsign Vertical-Bar:: +* Examples of Sharpsign Vertical-Bar:: +* Notes about Style for Sharpsign Vertical-Bar:: +* Sharpsign Less-Than-Sign:: +* Sharpsign Whitespace:: +* Sharpsign Right-Parenthesis:: + +Evaluation and Compilation + +* Evaluation:: +* Compilation:: +* Declarations:: +* Lambda Lists:: +* Error Checking in Function Calls:: +* Traversal Rules and Side Effects:: +* Destructive Operations:: +* Evaluation and Compilation Dictionary:: + +Evaluation + +* Introduction to Environments:: +* The Evaluation Model:: +* Lambda Expressions:: +* Closures and Lexical Binding:: +* Shadowing:: +* Extent:: +* Return Values:: + +Introduction to Environments + +* The Global Environment:: +* Dynamic Environments:: +* Lexical Environments:: +* The Null Lexical Environment:: +* Environment Objects:: + +The Evaluation Model + +* Form Evaluation:: +* Symbols as Forms:: +* Lexical Variables:: +* Dynamic Variables:: +* Constant Variables:: +* Symbols Naming Both Lexical and Dynamic Variables:: +* Conses as Forms:: +* Special Forms:: +* Macro Forms:: +* Function Forms:: +* Lambda Forms:: +* Self-Evaluating Objects:: +* Examples of Self-Evaluating Objects:: + +Compilation + +* Compiler Terminology:: +* Compilation Semantics:: +* File Compilation:: +* Literal Objects in Compiled Files:: +* Exceptional Situations in the Compiler:: + +Compilation Semantics + +* Compiler Macros:: +* Purpose of Compiler Macros:: +* Naming of Compiler Macros:: +* When Compiler Macros Are Used:: +* Notes about the Implementation of Compiler Macros:: +* Minimal Compilation:: +* Semantic Constraints:: + +File Compilation + +* Processing of Top Level Forms:: +* Processing of Defining Macros:: +* Constraints on Macros and Compiler Macros:: + +Literal Objects in Compiled Files + +* Externalizable Objects:: +* Similarity of Literal Objects:: +* Similarity of Aggregate Objects:: +* Definition of Similarity:: +* Extensions to Similarity Rules:: +* Additional Constraints on Externalizable Objects:: + +Declarations + +* Minimal Declaration Processing Requirements:: +* Declaration Specifiers:: +* Declaration Identifiers:: +* Declaration Scope:: + +Declaration Identifiers + +* Shorthand notation for Type Declarations:: + +Declaration Scope + +* Examples of Declaration Scope:: + +Lambda Lists + +* Ordinary Lambda Lists:: +* Generic Function Lambda Lists:: +* Specialized Lambda Lists:: +* Macro Lambda Lists:: +* Destructuring Lambda Lists:: +* Boa Lambda Lists:: +* Defsetf Lambda Lists:: +* Deftype Lambda Lists:: +* Define-modify-macro Lambda Lists:: +* Define-method-combination Arguments Lambda Lists:: +* Syntactic Interaction of Documentation Strings and Declarations:: + +Ordinary Lambda Lists + +* Specifiers for the required parameters:: +* Specifiers for optional parameters:: +* A specifier for a rest parameter:: +* Specifiers for keyword parameters:: +* Suppressing Keyword Argument Checking:: +* Examples of Suppressing Keyword Argument Checking:: +* Specifiers for @b{&aux} variables:: +* Examples of Ordinary Lambda Lists:: + +Macro Lambda Lists + +* Destructuring by Lambda Lists:: +* Data-directed Destructuring by Lambda Lists:: +* Examples of Data-directed Destructuring by Lambda Lists:: +* Lambda-list-directed Destructuring by Lambda Lists:: + +Error Checking in Function Calls + +* Argument Mismatch Detection:: + +Argument Mismatch Detection + +* Safe and Unsafe Calls:: +* Error Detection Time in Safe Calls:: +* Too Few Arguments:: +* Too Many Arguments:: +* Unrecognized Keyword Arguments:: +* Invalid Keyword Arguments:: +* Odd Number of Keyword Arguments:: +* Destructuring Mismatch:: +* Errors When Calling a Next Method:: + +Destructive Operations + +* Modification of Literal Objects:: +* Transfer of Control during a Destructive Operation:: + +Transfer of Control during a Destructive Operation + +* Examples of Transfer of Control during a Destructive Operation:: + +Evaluation and Compilation Dictionary + +* lambda (Symbol):: +* lambda:: +* compile:: +* eval:: +* eval-when:: +* load-time-value:: +* quote:: +* compiler-macro-function:: +* define-compiler-macro:: +* defmacro:: +* macro-function:: +* macroexpand:: +* define-symbol-macro:: +* symbol-macrolet:: +* *macroexpand-hook*:: +* proclaim:: +* declaim:: +* declare:: +* ignore:: +* dynamic-extent:: +* type:: +* inline:: +* ftype:: +* declaration:: +* optimize:: +* special:: +* locally:: +* the:: +* special-operator-p:: +* constantp:: + +Types and Classes + +* Introduction (Types and Classes):: +* Types:: +* Classes:: +* Types and Classes Dictionary:: + +Types + +* Data Type Definition:: +* Type Relationships:: +* Type Specifiers:: + +Classes + +* Introduction to Classes:: +* Defining Classes:: +* Creating Instances of Classes:: +* Inheritance:: +* Determining the Class Precedence List:: +* Redefining Classes:: +* Integrating Types and Classes:: + +Introduction to Classes + +* Standard Metaclasses:: + +Inheritance + +* Examples of Inheritance:: +* Inheritance of Class Options:: + +Determining the Class Precedence List + +* Topological Sorting:: +* Examples of Class Precedence List Determination:: + +Redefining Classes + +* Modifying the Structure of Instances:: +* Initializing Newly Added Local Slots (Redefining Classes):: +* Customizing Class Redefinition:: + +Types and Classes Dictionary + +* nil (Type):: +* boolean:: +* function (System Class):: +* compiled-function:: +* generic-function:: +* standard-generic-function:: +* class:: +* built-in-class:: +* structure-class:: +* standard-class:: +* method:: +* standard-method:: +* structure-object:: +* standard-object:: +* method-combination:: +* t (System Class):: +* satisfies:: +* member (Type Specifier):: +* not (Type Specifier):: +* and (Type Specifier):: +* or (Type Specifier):: +* values (Type Specifier):: +* eql (Type Specifier):: +* coerce:: +* deftype:: +* subtypep:: +* type-of:: +* typep:: +* type-error:: +* type-error-datum:: +* simple-type-error:: + +Data and Control Flow + +* Generalized Reference:: +* Transfer of Control to an Exit Point:: +* Data and Control Flow Dictionary:: + +Generalized Reference + +* Overview of Places and Generalized Reference:: +* Kinds of Places:: +* Treatment of Other Macros Based on SETF:: + +Overview of Places and Generalized Reference + +* Evaluation of Subforms to Places:: +* Examples of Evaluation of Subforms to Places:: +* Setf Expansions:: +* Examples of Setf Expansions:: + +Kinds of Places + +* Variable Names as Places:: +* Function Call Forms as Places:: +* VALUES Forms as Places:: +* THE Forms as Places:: +* APPLY Forms as Places:: +* Setf Expansions and Places:: +* Macro Forms as Places:: +* Symbol Macros as Places:: +* Other Compound Forms as Places:: + +Data and Control Flow Dictionary + +* apply:: +* defun:: +* fdefinition:: +* fboundp:: +* fmakunbound:: +* flet:: +* funcall:: +* function (Special Operator):: +* function-lambda-expression:: +* functionp:: +* compiled-function-p:: +* call-arguments-limit:: +* lambda-list-keywords:: +* lambda-parameters-limit:: +* defconstant:: +* defparameter:: +* destructuring-bind:: +* let:: +* progv:: +* setq:: +* psetq:: +* block:: +* catch:: +* go:: +* return-from:: +* return:: +* tagbody:: +* throw:: +* unwind-protect:: +* nil:: +* not:: +* t:: +* eq:: +* eql:: +* equal:: +* equalp:: +* identity:: +* complement:: +* constantly:: +* every:: +* and:: +* cond:: +* if:: +* or:: +* when:: +* case:: +* typecase:: +* multiple-value-bind:: +* multiple-value-call:: +* multiple-value-list:: +* multiple-value-prog1:: +* multiple-value-setq:: +* values:: +* values-list:: +* multiple-values-limit:: +* nth-value:: +* prog:: +* prog1:: +* progn:: +* define-modify-macro:: +* defsetf:: +* define-setf-expander:: +* get-setf-expansion:: +* setf:: +* shiftf:: +* rotatef:: +* control-error:: +* program-error:: +* undefined-function:: + +Iteration + +* The LOOP Facility:: +* Iteration Dictionary:: + +The LOOP Facility + +* Overview of the Loop Facility:: +* Variable Initialization and Stepping Clauses:: +* Value Accumulation Clauses:: +* Termination Test Clauses:: +* Unconditional Execution Clauses:: +* Conditional Execution Clauses:: +* Miscellaneous Clauses:: +* Examples of Miscellaneous Loop Features:: +* Notes about Loop:: + +Overview of the Loop Facility + +* Simple vs Extended Loop:: +* Simple Loop:: +* Extended Loop:: +* Loop Keywords:: +* Parsing Loop Clauses:: +* Expanding Loop Forms:: +* Summary of Loop Clauses:: +* Summary of Variable Initialization and Stepping Clauses:: +* Summary of Value Accumulation Clauses:: +* Summary of Termination Test Clauses:: +* Summary of Unconditional Execution Clauses:: +* Summary of Conditional Execution Clauses:: +* Summary of Miscellaneous Clauses:: +* Order of Execution:: +* Destructuring:: +* Restrictions on Side-Effects:: + +Variable Initialization and Stepping Clauses + +* Iteration Control:: +* The for-as-arithmetic subclause:: +* Examples of for-as-arithmetic subclause:: +* The for-as-in-list subclause:: +* Examples of for-as-in-list subclause:: +* The for-as-on-list subclause:: +* Examples of for-as-on-list subclause:: +* The for-as-equals-then subclause:: +* Examples of for-as-equals-then subclause:: +* The for-as-across subclause:: +* Examples of for-as-across subclause:: +* The for-as-hash subclause:: +* The for-as-package subclause:: +* Examples of for-as-package subclause:: +* Local Variable Initializations:: +* Examples of WITH clause:: + +Value Accumulation Clauses + +* Examples of COLLECT clause:: +* Examples of APPEND and NCONC clauses:: +* Examples of COUNT clause:: +* Examples of MAXIMIZE and MINIMIZE clauses:: +* Examples of SUM clause:: + +Termination Test Clauses + +* Examples of REPEAT clause:: +* Examples of ALWAYS:: +* Examples of WHILE and UNTIL clauses:: + +Unconditional Execution Clauses + +* Examples of unconditional execution:: + +Conditional Execution Clauses + +* Examples of WHEN clause:: + +Miscellaneous Clauses + +* Control Transfer Clauses:: +* Examples of NAMED clause:: +* Initial and Final Execution:: + +Examples of Miscellaneous Loop Features + +* Examples of clause grouping:: + +Iteration Dictionary + +* do:: +* dotimes:: +* dolist:: +* loop:: +* loop-finish:: + +Objects + +* Object Creation and Initialization:: +* Changing the Class of an Instance:: +* Reinitializing an Instance:: +* Meta-Objects:: +* Slots:: +* Generic Functions and Methods:: +* Objects Dictionary:: + +Object Creation and Initialization + +* Initialization Arguments:: +* Declaring the Validity of Initialization Arguments:: +* Defaulting of Initialization Arguments:: +* Rules for Initialization Arguments:: +* Shared-Initialize:: +* Initialize-Instance:: +* Definitions of Make-Instance and Initialize-Instance:: + +Changing the Class of an Instance + +* Modifying the Structure of the Instance:: +* Initializing Newly Added Local Slots (Changing the Class of an Instance):: +* Customizing the Change of Class of an Instance:: + +Reinitializing an Instance + +* Customizing Reinitialization:: + +Meta-Objects + +* Standard Meta-objects:: + +Slots + +* Introduction to Slots:: +* Accessing Slots:: +* Inheritance of Slots and Slot Options:: + +Generic Functions and Methods + +* Introduction to Generic Functions:: +* Introduction to Methods:: +* Agreement on Parameter Specializers and Qualifiers:: +* Congruent Lambda-lists for all Methods of a Generic Function:: +* Keyword Arguments in Generic Functions and Methods:: +* Method Selection and Combination:: +* Inheritance of Methods:: + +Keyword Arguments in Generic Functions and Methods + +* Examples of Keyword Arguments in Generic Functions and Methods:: + +Method Selection and Combination + +* Determining the Effective Method:: +* Selecting the Applicable Methods:: +* Sorting the Applicable Methods by Precedence Order:: +* Applying method combination to the sorted list of applicable methods:: +* Standard Method Combination:: +* Declarative Method Combination:: +* Built-in Method Combination Types:: + +Objects Dictionary + +* function-keywords:: +* ensure-generic-function:: +* allocate-instance:: +* reinitialize-instance:: +* shared-initialize:: +* update-instance-for-different-class:: +* update-instance-for-redefined-class:: +* change-class:: +* slot-boundp:: +* slot-exists-p:: +* slot-makunbound:: +* slot-missing:: +* slot-unbound:: +* slot-value:: +* method-qualifiers:: +* no-applicable-method:: +* no-next-method:: +* remove-method:: +* make-instance:: +* make-instances-obsolete:: +* make-load-form:: +* make-load-form-saving-slots:: +* with-accessors:: +* with-slots:: +* defclass:: +* defgeneric:: +* defmethod:: +* find-class:: +* next-method-p:: +* call-method:: +* call-next-method:: +* compute-applicable-methods:: +* define-method-combination:: +* find-method:: +* add-method:: +* initialize-instance:: +* class-name:: +* (setf class-name):: +* class-of:: +* unbound-slot:: +* unbound-slot-instance:: + +Structures + +* Structures Dictionary:: + +Structures Dictionary + +* defstruct:: +* copy-structure:: + +Conditions + +* Condition System Concepts:: +* Conditions Dictionary:: + +Condition System Concepts + +* Condition Types:: +* Creating Conditions:: +* Printing Conditions:: +* Signaling and Handling Conditions:: +* Assertions:: +* Notes about the Condition System`s Background:: + +Condition Types + +* Serious Conditions:: + +Creating Conditions + +* Condition Designators:: + +Printing Conditions + +* Recommended Style in Condition Reporting:: +* Capitalization and Punctuation in Condition Reports:: +* Leading and Trailing Newlines in Condition Reports:: +* Embedded Newlines in Condition Reports:: +* Note about Tabs in Condition Reports:: +* Mentioning Containing Function in Condition Reports:: + +Signaling and Handling Conditions + +* Signaling:: +* Resignaling a Condition:: +* Restarts:: +* Interactive Use of Restarts:: +* Interfaces to Restarts:: +* Restart Tests:: +* Associating a Restart with a Condition:: + +Conditions Dictionary + +* condition:: +* warning:: +* style-warning:: +* serious-condition:: +* error (Condition Type):: +* cell-error:: +* cell-error-name:: +* parse-error:: +* storage-condition:: +* assert:: +* error:: +* cerror:: +* check-type:: +* simple-error:: +* invalid-method-error:: +* method-combination-error:: +* signal:: +* simple-condition:: +* simple-condition-format-control:: +* warn:: +* simple-warning:: +* invoke-debugger:: +* break:: +* *debugger-hook*:: +* *break-on-signals*:: +* handler-bind:: +* handler-case:: +* ignore-errors:: +* define-condition:: +* make-condition:: +* restart:: +* compute-restarts:: +* find-restart:: +* invoke-restart:: +* invoke-restart-interactively:: +* restart-bind:: +* restart-case:: +* restart-name:: +* with-condition-restarts:: +* with-simple-restart:: +* abort (Restart):: +* continue:: +* muffle-warning:: +* store-value:: +* use-value:: +* abort (Function):: + +Symbols + +* Symbol Concepts:: +* Symbols Dictionary:: + +Symbols Dictionary + +* symbol:: +* keyword:: +* symbolp:: +* keywordp:: +* make-symbol:: +* copy-symbol:: +* gensym:: +* *gensym-counter*:: +* gentemp:: +* symbol-function:: +* symbol-name:: +* symbol-package:: +* symbol-plist:: +* symbol-value:: +* get:: +* remprop:: +* boundp:: +* makunbound:: +* set:: +* unbound-variable:: + +Packages + +* Package Concepts:: +* Packages Dictionary:: + +Package Concepts + +* Introduction to Packages:: +* Standardized Packages:: + +Introduction to Packages + +* Package Names and Nicknames:: +* Symbols in a Package:: +* Internal and External Symbols:: +* Package Inheritance:: +* Accessibility of Symbols in a Package:: +* Locating a Symbol in a Package:: +* Prevention of Name Conflicts in Packages:: + +Standardized Packages + +* The COMMON-LISP Package:: +* Constraints on the COMMON-LISP Package for Conforming Implementations:: +* Constraints on the COMMON-LISP Package for Conforming Programs:: +* Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs:: +* The COMMON-LISP-USER Package:: +* The KEYWORD Package:: +* Interning a Symbol in the KEYWORD Package:: +* Notes about The KEYWORD Package:: +* Implementation-Defined Packages:: + +Packages Dictionary + +* package:: +* export:: +* find-symbol:: +* find-package:: +* find-all-symbols:: +* import:: +* list-all-packages:: +* rename-package:: +* shadow:: +* shadowing-import:: +* delete-package:: +* make-package:: +* with-package-iterator:: +* unexport:: +* unintern:: +* in-package:: +* unuse-package:: +* use-package:: +* defpackage:: +* do-symbols:: +* intern:: +* package-name:: +* package-nicknames:: +* package-shadowing-symbols:: +* package-use-list:: +* package-used-by-list:: +* packagep:: +* *package*:: +* package-error:: +* package-error-package:: + +Numbers + +* Number Concepts:: +* Numbers Dictionary:: + +Number Concepts + +* Numeric Operations:: +* Implementation-Dependent Numeric Constants:: +* Rational Computations:: +* Floating-point Computations:: +* Complex Computations:: +* Interval Designators:: +* Random-State Operations:: + +Numeric Operations + +* Associativity and Commutativity in Numeric Operations:: +* Examples of Associativity and Commutativity in Numeric Operations:: +* Contagion in Numeric Operations:: +* Viewing Integers as Bits and Bytes:: +* Logical Operations on Integers:: +* Byte Operations on Integers:: + +Rational Computations + +* Rule of Unbounded Rational Precision:: +* Rule of Canonical Representation for Rationals:: +* Rule of Float Substitutability:: + +Floating-point Computations + +* Rule of Float and Rational Contagion:: +* Examples of Rule of Float and Rational Contagion:: +* Rule of Float Approximation:: +* Rule of Float Underflow and Overflow:: +* Rule of Float Precision Contagion:: + +Complex Computations + +* Rule of Complex Substitutability:: +* Rule of Complex Contagion:: +* Rule of Canonical Representation for Complex Rationals:: +* Examples of Rule of Canonical Representation for Complex Rationals:: +* Principal Values and Branch Cuts:: + +Numbers Dictionary + +* number:: +* complex (System Class):: +* real:: +* float (System Class):: +* short-float:: +* rational (System Class):: +* ratio:: +* integer:: +* signed-byte:: +* unsigned-byte:: +* mod (System Class):: +* bit (System Class):: +* fixnum:: +* bignum:: +* =:: +* max:: +* minusp:: +* zerop:: +* floor:: +* sin:: +* asin:: +* pi:: +* sinh:: +* *:: +* +:: +* -:: +* /:: +* 1+:: +* abs:: +* evenp:: +* exp:: +* gcd:: +* incf:: +* lcm:: +* log:: +* mod (Function):: +* signum:: +* sqrt:: +* random-state:: +* make-random-state:: +* random:: +* random-state-p:: +* *random-state*:: +* numberp:: +* cis:: +* complex:: +* complexp:: +* conjugate:: +* phase:: +* realpart:: +* upgraded-complex-part-type:: +* realp:: +* numerator:: +* rational (Function):: +* rationalp:: +* ash:: +* integer-length:: +* integerp:: +* parse-integer:: +* boole:: +* boole-1:: +* logand:: +* logbitp:: +* logcount:: +* logtest:: +* byte:: +* deposit-field:: +* dpb:: +* ldb:: +* ldb-test:: +* mask-field:: +* most-positive-fixnum:: +* decode-float:: +* float:: +* floatp:: +* most-positive-short-float:: +* short-float-epsilon:: +* arithmetic-error:: +* arithmetic-error-operands:: +* division-by-zero:: +* floating-point-invalid-operation:: +* floating-point-inexact:: +* floating-point-overflow:: +* floating-point-underflow:: + +Characters + +* Character Concepts:: +* Characters Dictionary:: + +Character Concepts + +* Introduction to Characters:: +* Introduction to Scripts and Repertoires:: +* Character Attributes:: +* Character Categories:: +* Identity of Characters:: +* Ordering of Characters:: +* Character Names:: +* Treatment of Newline during Input and Output:: +* Character Encodings:: +* Documentation of Implementation-Defined Scripts:: + +Introduction to Scripts and Repertoires + +* Character Scripts:: +* Character Repertoires:: + +Character Categories + +* Graphic Characters:: +* Alphabetic Characters:: +* Characters With Case:: +* Uppercase Characters:: +* Lowercase Characters:: +* Corresponding Characters in the Other Case:: +* Case of Implementation-Defined Characters:: +* Numeric Characters:: +* Alphanumeric Characters:: +* Digits in a Radix:: + +Characters Dictionary + +* character (System Class):: +* base-char:: +* standard-char:: +* extended-char:: +* char=:: +* character:: +* characterp:: +* alpha-char-p:: +* alphanumericp:: +* digit-char:: +* digit-char-p:: +* graphic-char-p:: +* standard-char-p:: +* char-upcase:: +* upper-case-p:: +* char-code:: +* char-int:: +* code-char:: +* char-code-limit:: +* char-name:: +* name-char:: + +Conses + +* Cons Concepts:: +* Conses Dictionary:: + +Cons Concepts + +* Conses as Trees:: +* Conses as Lists:: + +Conses as Trees + +* General Restrictions on Parameters that must be Trees:: + +Conses as Lists + +* Lists as Association Lists:: +* Lists as Sets:: +* General Restrictions on Parameters that must be Lists:: + +Conses Dictionary + +* list (System Class):: +* null (System Class):: +* cons (System Class):: +* atom (Type):: +* cons:: +* consp:: +* atom:: +* rplaca:: +* car:: +* copy-tree:: +* sublis:: +* subst:: +* tree-equal:: +* copy-list:: +* list (Function):: +* list-length:: +* listp:: +* make-list:: +* push:: +* pop:: +* first:: +* nth:: +* endp:: +* null:: +* nconc:: +* append:: +* revappend:: +* butlast:: +* last:: +* ldiff:: +* nthcdr:: +* rest:: +* member (Function):: +* mapc:: +* acons:: +* assoc:: +* copy-alist:: +* pairlis:: +* rassoc:: +* get-properties:: +* getf:: +* remf:: +* intersection:: +* adjoin:: +* pushnew:: +* set-difference:: +* set-exclusive-or:: +* subsetp:: +* union:: + +Arrays + +* Array Concepts:: +* Arrays Dictionary:: + +Array Concepts + +* Array Elements:: +* Specialized Arrays:: + +Array Elements + +* Array Indices:: +* Array Dimensions:: +* Implementation Limits on Individual Array Dimensions:: +* Array Rank:: +* Vectors:: +* Fill Pointers:: +* Multidimensional Arrays:: +* Storage Layout for Multidimensional Arrays:: +* Implementation Limits on Array Rank:: + +Specialized Arrays + +* Array Upgrading:: +* Required Kinds of Specialized Arrays:: + +Arrays Dictionary + +* array:: +* simple-array:: +* vector (System Class):: +* simple-vector:: +* bit-vector:: +* simple-bit-vector:: +* make-array:: +* adjust-array:: +* adjustable-array-p:: +* aref:: +* array-dimension:: +* array-dimensions:: +* array-element-type:: +* array-has-fill-pointer-p:: +* array-displacement:: +* array-in-bounds-p:: +* array-rank:: +* array-row-major-index:: +* array-total-size:: +* arrayp:: +* fill-pointer:: +* row-major-aref:: +* upgraded-array-element-type:: +* array-dimension-limit:: +* array-rank-limit:: +* array-total-size-limit:: +* simple-vector-p:: +* svref:: +* vector:: +* vector-pop:: +* vector-push:: +* vectorp:: +* bit (Array):: +* bit-and:: +* bit-vector-p:: +* simple-bit-vector-p:: + +Strings + +* String Concepts:: +* Strings Dictionary:: + +String Concepts + +* Implications of Strings Being Arrays:: +* Subtypes of STRING:: + +Strings Dictionary + +* string (System Class):: +* base-string:: +* simple-string:: +* simple-base-string:: +* simple-string-p:: +* char:: +* string:: +* string-upcase:: +* string-trim:: +* string=:: +* stringp:: +* make-string:: + +Sequences + +* Sequence Concepts:: +* Rules about Test Functions:: +* Sequences Dictionary:: + +Sequence Concepts + +* General Restrictions on Parameters that must be Sequences:: + +Rules about Test Functions + +* Satisfying a Two-Argument Test:: +* Satisfying a One-Argument Test:: + +Satisfying a Two-Argument Test + +* Examples of Satisfying a Two-Argument Test:: + +Satisfying a One-Argument Test + +* Examples of Satisfying a One-Argument Test:: + +Sequences Dictionary + +* sequence:: +* copy-seq:: +* elt:: +* fill:: +* make-sequence:: +* subseq:: +* map:: +* map-into:: +* reduce:: +* count:: +* length:: +* reverse:: +* sort:: +* find:: +* position:: +* search:: +* mismatch:: +* replace:: +* substitute:: +* concatenate:: +* merge:: +* remove:: +* remove-duplicates:: + +Hash Tables + +* Hash Table Concepts:: +* Hash Tables Dictionary:: + +Hash Table Concepts + +* Hash-Table Operations:: +* Modifying Hash Table Keys:: + +Modifying Hash Table Keys + +* Visible Modification of Objects with respect to EQ and EQL:: +* Visible Modification of Objects with respect to EQUAL:: +* Visible Modification of Conses with respect to EQUAL:: +* Visible Modification of Bit Vectors and Strings with respect to EQUAL:: +* Visible Modification of Objects with respect to EQUALP:: +* Visible Modification of Structures with respect to EQUALP:: +* Visible Modification of Arrays with respect to EQUALP:: +* Visible Modification of Hash Tables with respect to EQUALP:: +* Visible Modifications by Language Extensions:: + +Hash Tables Dictionary + +* hash-table:: +* make-hash-table:: +* hash-table-p:: +* hash-table-count:: +* hash-table-rehash-size:: +* hash-table-rehash-threshold:: +* hash-table-size:: +* hash-table-test:: +* gethash:: +* remhash:: +* maphash:: +* with-hash-table-iterator:: +* clrhash:: +* sxhash:: + +Filenames + +* Overview of Filenames:: +* Pathnames:: +* Logical Pathnames:: +* Filenames Dictionary:: + +Overview of Filenames + +* Namestrings as Filenames:: +* Pathnames as Filenames:: +* Parsing Namestrings Into Pathnames:: + +Pathnames + +* Pathname Components:: +* Interpreting Pathname Component Values:: +* Merging Pathnames:: + +Pathname Components + +* The Pathname Host Component:: +* The Pathname Device Component:: +* The Pathname Directory Component:: +* The Pathname Name Component:: +* The Pathname Type Component:: +* The Pathname Version Component:: + +Interpreting Pathname Component Values + +* Strings in Component Values:: +* Special Characters in Pathname Components:: +* Case in Pathname Components:: +* Local Case in Pathname Components:: +* Common Case in Pathname Components:: +* Special Pathname Component Values:: +* NIL as a Component Value:: +* ->WILD as a Component Value:: +* ->UNSPECIFIC as a Component Value:: +* Relation between component values NIL and ->UNSPECIFIC:: +* Restrictions on Wildcard Pathnames:: +* Restrictions on Examining Pathname Components:: +* Restrictions on Examining a Pathname Host Component:: +* Restrictions on Examining a Pathname Device Component:: +* Restrictions on Examining a Pathname Directory Component:: +* Directory Components in Non-Hierarchical File Systems:: +* Restrictions on Examining a Pathname Name Component:: +* Restrictions on Examining a Pathname Type Component:: +* Restrictions on Examining a Pathname Version Component:: +* Notes about the Pathname Version Component:: +* Restrictions on Constructing Pathnames:: + +Merging Pathnames + +* Examples of Merging Pathnames:: + +Logical Pathnames + +* Syntax of Logical Pathname Namestrings:: +* Logical Pathname Components:: + +Syntax of Logical Pathname Namestrings + +* Additional Information about Parsing Logical Pathname Namestrings:: +* The Host part of a Logical Pathname Namestring:: +* The Device part of a Logical Pathname Namestring:: +* The Directory part of a Logical Pathname Namestring:: +* The Type part of a Logical Pathname Namestring:: +* The Version part of a Logical Pathname Namestring:: +* Wildcard Words in a Logical Pathname Namestring:: +* Lowercase Letters in a Logical Pathname Namestring:: +* Other Syntax in a Logical Pathname Namestring:: + +Logical Pathname Components + +* Unspecific Components of a Logical Pathname:: +* Null Strings as Components of a Logical Pathname:: + +Filenames Dictionary + +* pathname (System Class):: +* logical-pathname (System Class):: +* pathname:: +* make-pathname:: +* pathnamep:: +* pathname-host:: +* load-logical-pathname-translations:: +* logical-pathname-translations:: +* logical-pathname:: +* *default-pathname-defaults*:: +* namestring:: +* parse-namestring:: +* wild-pathname-p:: +* pathname-match-p:: +* translate-logical-pathname:: +* translate-pathname:: +* merge-pathnames:: + +Files + +* File System Concepts:: +* Files Dictionary:: + +File System Concepts + +* Coercion of Streams to Pathnames:: +* File Operations on Open and Closed Streams:: +* Truenames:: + +Truenames + +* Examples of Truenames:: + +Files Dictionary + +* directory:: +* probe-file:: +* ensure-directories-exist:: +* truename:: +* file-author:: +* file-write-date:: +* rename-file:: +* delete-file:: +* file-error:: +* file-error-pathname:: + +Streams + +* Stream Concepts:: +* Streams Dictionary:: + +Stream Concepts + +* Introduction to Streams:: +* Stream Variables:: +* Stream Arguments to Standardized Functions:: +* Restrictions on Composite Streams:: + +Introduction to Streams + +* Abstract Classifications of Streams (Introduction to Streams):: +* Input:: +* Open and Closed Streams:: +* Interactive Streams:: +* Abstract Classifications of Streams:: +* File Streams:: +* Other Subclasses of Stream:: + +Streams Dictionary + +* stream:: +* broadcast-stream:: +* concatenated-stream:: +* echo-stream:: +* file-stream:: +* string-stream:: +* synonym-stream:: +* two-way-stream:: +* input-stream-p:: +* interactive-stream-p:: +* open-stream-p:: +* stream-element-type:: +* streamp:: +* read-byte:: +* write-byte:: +* peek-char:: +* read-char:: +* read-char-no-hang:: +* terpri:: +* unread-char:: +* write-char:: +* read-line:: +* write-string:: +* read-sequence:: +* write-sequence:: +* file-length:: +* file-position:: +* file-string-length:: +* open:: +* stream-external-format:: +* with-open-file:: +* close:: +* with-open-stream:: +* listen:: +* clear-input:: +* finish-output:: +* y-or-n-p:: +* make-synonym-stream:: +* synonym-stream-symbol:: +* broadcast-stream-streams:: +* make-broadcast-stream:: +* make-two-way-stream:: +* two-way-stream-input-stream:: +* echo-stream-input-stream:: +* make-echo-stream:: +* concatenated-stream-streams:: +* make-concatenated-stream:: +* get-output-stream-string:: +* make-string-input-stream:: +* make-string-output-stream:: +* with-input-from-string:: +* with-output-to-string:: +* *debug-io*:: +* *terminal-io*:: +* stream-error:: +* stream-error-stream:: +* end-of-file:: + +Printer + +* The Lisp Printer:: +* The Lisp Pretty Printer:: +* Formatted Output:: +* Printer Dictionary:: + +The Lisp Printer + +* Overview of The Lisp Printer:: +* Printer Dispatching:: +* Default Print-Object Methods:: +* Examples of Printer Behavior:: + +Overview of The Lisp Printer + +* Multiple Possible Textual Representations:: +* Printer Escaping:: + +Default Print-Object Methods + +* Printing Numbers:: +* Printing Integers:: +* Printing Ratios:: +* Printing Floats:: +* Printing Complexes:: +* Note about Printing Numbers:: +* Printing Characters:: +* Printing Symbols:: +* Package Prefixes for Symbols:: +* Effect of Readtable Case on the Lisp Printer:: +* Examples of Effect of Readtable Case on the Lisp Printer:: +* Printing Strings:: +* Printing Lists and Conses:: +* Printing Bit Vectors:: +* Printing Other Vectors:: +* Printing Other Arrays:: +* Examples of Printing Arrays:: +* Printing Random States:: +* Printing Pathnames:: +* Printing Structures:: +* Printing Other Objects:: + +The Lisp Pretty Printer + +* Pretty Printer Concepts:: +* Examples of using the Pretty Printer:: +* Notes about the Pretty Printer`s Background:: + +Pretty Printer Concepts + +* Dynamic Control of the Arrangement of Output:: +* Format Directive Interface:: +* Compiling Format Strings:: +* Pretty Print Dispatch Tables:: +* Pretty Printer Margins:: + +Formatted Output + +* FORMAT Basic Output:: +* FORMAT Radix Control:: +* FORMAT Floating-Point Printers:: +* FORMAT Printer Operations:: +* FORMAT Pretty Printer Operations:: +* FORMAT Layout Control:: +* FORMAT Control-Flow Operations:: +* FORMAT Miscellaneous Operations:: +* FORMAT Miscellaneous Pseudo-Operations:: +* Additional Information about FORMAT Operations:: +* Examples of FORMAT:: +* Notes about FORMAT:: + +FORMAT Basic Output + +* Tilde C-> Character:: +* Tilde Percent-> Newline:: +* Tilde Ampersand-> Fresh-Line:: +* Tilde Vertical-Bar-> Page:: +* Tilde Tilde-> Tilde:: + +FORMAT Radix Control + +* Tilde R-> Radix:: +* Tilde D-> Decimal:: +* Tilde B-> Binary:: +* Tilde O-> Octal:: +* Tilde X-> Hexadecimal:: + +FORMAT Floating-Point Printers + +* Tilde F-> Fixed-Format Floating-Point:: +* Tilde E-> Exponential Floating-Point:: +* Tilde G-> General Floating-Point:: +* Tilde Dollarsign-> Monetary Floating-Point:: + +FORMAT Printer Operations + +* Tilde A-> Aesthetic:: +* Tilde S-> Standard:: +* Tilde W-> Write:: + +FORMAT Pretty Printer Operations + +* Tilde Underscore-> Conditional Newline:: +* Tilde Less-Than-Sign-> Logical Block:: +* Tilde I-> Indent:: +* Tilde Slash-> Call Function:: + +FORMAT Layout Control + +* Tilde T-> Tabulate:: +* Tilde Less-Than-Sign-> Justification:: +* Tilde Greater-Than-Sign-> End of Justification:: + +FORMAT Control-Flow Operations + +* Tilde Asterisk-> Go-To:: +* Tilde Left-Bracket-> Conditional Expression:: +* Tilde Right-Bracket-> End of Conditional Expression:: +* Tilde Left-Brace-> Iteration:: +* Tilde Right-Brace-> End of Iteration:: +* Tilde Question-Mark-> Recursive Processing:: + +FORMAT Miscellaneous Operations + +* Tilde Left-Paren-> Case Conversion:: +* Tilde Right-Paren-> End of Case Conversion:: +* Tilde P-> Plural:: + +FORMAT Miscellaneous Pseudo-Operations + +* Tilde Semicolon-> Clause Separator:: +* Tilde Circumflex-> Escape Upward:: +* Tilde Newline-> Ignored Newline:: + +Additional Information about FORMAT Operations + +* Nesting of FORMAT Operations:: +* Missing and Additional FORMAT Arguments:: +* Additional FORMAT Parameters:: +* Undefined FORMAT Modifier Combinations:: + +Printer Dictionary + +* copy-pprint-dispatch:: +* formatter:: +* pprint-dispatch:: +* pprint-exit-if-list-exhausted:: +* pprint-fill:: +* pprint-indent:: +* pprint-logical-block:: +* pprint-newline:: +* pprint-pop:: +* pprint-tab:: +* print-object:: +* print-unreadable-object:: +* set-pprint-dispatch:: +* write:: +* write-to-string:: +* *print-array*:: +* *print-base*:: +* *print-case*:: +* *print-circle*:: +* *print-escape*:: +* *print-gensym*:: +* *print-level*:: +* *print-lines*:: +* *print-miser-width*:: +* *print-pprint-dispatch*:: +* *print-pretty*:: +* *print-readably*:: +* *print-right-margin*:: +* print-not-readable:: +* print-not-readable-object:: +* format:: + +Reader + +* Reader Concepts:: +* Reader Dictionary:: + +Reader Concepts + +* Dynamic Control of the Lisp Reader:: +* Effect of Readtable Case on the Lisp Reader:: +* Argument Conventions of Some Reader Functions:: + +Effect of Readtable Case on the Lisp Reader + +* Examples of Effect of Readtable Case on the Lisp Reader:: + +Argument Conventions of Some Reader Functions + +* The EOF-ERROR-P argument:: +* The RECURSIVE-P argument:: + +Reader Dictionary + +* readtable:: +* copy-readtable:: +* make-dispatch-macro-character:: +* read:: +* read-delimited-list:: +* read-from-string:: +* readtable-case:: +* readtablep:: +* set-dispatch-macro-character:: +* set-macro-character:: +* set-syntax-from-char:: +* with-standard-io-syntax:: +* *read-base*:: +* *read-default-float-format*:: +* *read-eval*:: +* *read-suppress*:: +* *readtable*:: +* reader-error:: + +System Construction + +* System Construction Concepts:: +* System Construction Dictionary:: + +System Construction Concepts + +* Loading:: +* Features:: + +Features + +* Feature Expressions:: +* Examples of Feature Expressions:: + +System Construction Dictionary + +* compile-file:: +* compile-file-pathname:: +* load:: +* with-compilation-unit:: +* *features*:: +* *compile-file-pathname*:: +* *load-pathname*:: +* *compile-print*:: +* *load-print*:: +* *modules*:: +* provide:: + +Environment + +* The External Environment:: +* Environment Dictionary:: + +The External Environment + +* Top level loop:: +* Debugging Utilities:: +* Environment Inquiry:: +* Time:: + +Time + +* Decoded Time:: +* Universal Time:: +* Internal Time:: +* Seconds:: + +Environment Dictionary + +* decode-universal-time:: +* encode-universal-time:: +* get-universal-time:: +* sleep:: +* apropos:: +* describe:: +* describe-object:: +* trace:: +* step:: +* time:: +* internal-time-units-per-second:: +* get-internal-real-time:: +* get-internal-run-time:: +* disassemble:: +* documentation:: +* room:: +* ed:: +* inspect:: +* dribble:: +* -:: +* +:: +* *:: +* /:: +* lisp-implementation-type:: +* short-site-name:: +* machine-instance:: +* machine-type:: +* machine-version:: +* software-type:: +* user-homedir-pathname:: + +Glossary + +* Glossary:: + +Appendix + +* Removed Language Features:: + +Removed Language Features + +* Requirements for removed and deprecated features:: +* Removed Types:: +* Removed Operators:: +* Removed Argument Conventions:: +* Removed Variables:: +* Removed Reader Syntax:: +* Packages No Longer Required:: +@end menu + +@c includes +@include chap-1.texi + +@include chap-2.texi + +@include chap-3.texi + +@include chap-4.texi + +@include chap-5.texi + +@include chap-6.texi + +@include chap-7.texi + +@include chap-8.texi + +@include chap-9.texi + +@include chap-10.texi + +@include chap-11.texi + +@include chap-12.texi + +@include chap-13.texi + +@include chap-14.texi + +@include chap-15.texi + +@include chap-16.texi + +@include chap-17.texi + +@include chap-18.texi + +@include chap-19.texi + +@include chap-20.texi + +@include chap-21.texi + +@include chap-22.texi + +@include chap-23.texi + +@include chap-24.texi + +@include chap-25.texi + +@include chap-26.texi + +@include chap-a.texi + +@bye diff --git a/info/gcl.texi.diff b/info/gcl.texi.diff new file mode 100644 index 0000000..0468fea --- /dev/null +++ b/info/gcl.texi.diff @@ -0,0 +1,11612 @@ +diff -uNr gcl-texi-orig/chap-10.texi gcl-texi/chap-10.texi +--- gcl-texi-orig/chap-10.texi 1994-07-16 18:03:13 +0400 ++++ gcl-texi/chap-10.texi 2002-10-17 20:53:05 +0400 +@@ -16,6 +16,7 @@ + Figure 10--1 lists some + @i{defined names} that are applicable to the @i{property lists} of @i{symbols}. + ++@format + @group + @noindent + @w{ get remprop symbol-plist } +@@ -24,10 +25,12 @@ + @w{ Figure 10--1: Property list defined names} + + @end group ++@end format + + Figure 10--2 lists some @i{defined names} that are applicable + to the creation of and inquiry about @i{symbols}. + ++@format + @group + @noindent + @w{ copy-symbol keywordp symbol-package } +@@ -38,6 +41,7 @@ + @w{ Figure 10--2: Symbol creation and inquiry defined names} + + @end group ++@end format + + @c end of including concept-symbols + +@@ -364,7 +368,7 @@ + @node copy-symbol, gensym, make-symbol, Symbols Dictionary + @subsection copy-symbol [Function] + +-@code{copy-symbol} @i{symbol {&optional} copy-properties} @result{} @i{new-symbol} ++@code{copy-symbol} @i{symbol @r{&optional} copy-properties} @result{} @i{new-symbol} + + @subsubheading Arguments and Values:: + +@@ -440,7 +444,7 @@ + @node gensym, *gensym-counter*, copy-symbol, Symbols Dictionary + @subsection gensym [Function] + +-@code{gensym} @i{{&optional} x} @result{} @i{new-symbol} ++@code{gensym} @i{@r{&optional} x} @result{} @i{new-symbol} + + @subsubheading Arguments and Values:: + +@@ -549,7 +553,7 @@ + @node gentemp, symbol-function, *gensym-counter*, Symbols Dictionary + @subsection gentemp [Function] + +-@code{gentemp} @i{{&optional} prefix package} @result{} @i{new-symbol} ++@code{gentemp} @i{@r{&optional} prefix package} @result{} @i{new-symbol} + + @subsubheading Arguments and Values:: + +@@ -958,9 +962,9 @@ + @node get, remprop, symbol-value, Symbols Dictionary + @subsection get [Accessor] + +-@code{get} @i{symbol indicator {&optional} default} @result{} @i{value} ++@code{get} @i{symbol indicator @r{&optional} default} @result{} @i{value} + +-(setf (@code{ get} @i{symbol indicator {&optional} default}) new-value)@* ++(setf (@code{ get} @i{symbol indicator @r{&optional} default}) new-value)@* + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/chap-11.texi gcl-texi/chap-11.texi +--- gcl-texi-orig/chap-11.texi 1994-07-16 18:03:12 +0400 ++++ gcl-texi/chap-11.texi 2002-10-17 20:53:05 +0400 +@@ -43,6 +43,7 @@ + a @i{package}. If a @i{symbol} is supplied, its name will be used + as the @i{package} name. + ++@format + @group + @noindent + @w{ *modules* import provide } +@@ -60,6 +61,7 @@ + @w{ Figure 11--1: Some Defined Names related to Packages } + + @end group ++@end format + + @menu + * Package Names and Nicknames:: +@@ -304,6 +306,7 @@ + @i{names} and @i{nicknames} of those @i{standardized} @i{packages} + is given in Figure 11--2. + ++@format + @group + @noindent + @w{ Name Nicknames } +@@ -315,6 +318,7 @@ + @w{ Figure 11--2: Standardized Package Names} + + @end group ++@end format + + @menu + * The COMMON-LISP Package:: +@@ -665,7 +669,7 @@ + @node export, find-symbol, package, Packages Dictionary + @subsection export [Function] + +-@code{export} @i{symbols {&optional} package} @result{} @i{@b{t}} ++@code{export} @i{symbols @r{&optional} package} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -770,7 +774,7 @@ + @node find-symbol, find-package, export, Packages Dictionary + @subsection find-symbol [Function] + +-@code{find-symbol} @i{string {&optional} package} @result{} @i{symbol, status} ++@code{find-symbol} @i{string @r{&optional} package} @result{} @i{symbol, status} + + @subsubheading Arguments and Values:: + +@@ -947,7 +951,7 @@ + @node import, list-all-packages, find-all-symbols, Packages Dictionary + @subsection import [Function] + +-@code{import} @i{symbols {&optional} package} @result{} @i{@b{t}} ++@code{import} @i{symbols @r{&optional} package} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1064,7 +1068,7 @@ + @node rename-package, shadow, list-all-packages, Packages Dictionary + @subsection rename-package [Function] + +-@code{rename-package} @i{package new-name {&optional} new-nicknames} @result{} @i{package-object} ++@code{rename-package} @i{package new-name @r{&optional} new-nicknames} @result{} @i{package-object} + + @subsubheading Arguments and Values:: + +@@ -1105,7 +1109,7 @@ + @node shadow, shadowing-import, rename-package, Packages Dictionary + @subsection shadow [Function] + +-@code{shadow} @i{symbol-names {&optional} package} @result{} @i{@b{t}} ++@code{shadow} @i{symbol-names @r{&optional} package} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1183,7 +1187,7 @@ + @node shadowing-import, delete-package, shadow, Packages Dictionary + @subsection shadowing-import [Function] + +-@code{shadowing-import} @i{symbols {&optional} package} @result{} @i{@b{t}} ++@code{shadowing-import} @i{symbols @r{&optional} package} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1391,7 +1395,7 @@ + @node make-package, with-package-iterator, delete-package, Packages Dictionary + @subsection make-package [Function] + +-@code{make-package} @i{package-name {&key} nicknames use} @result{} @i{package} ++@code{make-package} @i{package-name @r{&key} nicknames use} @result{} @i{package} + + @subsubheading Arguments and Values:: + +@@ -1460,9 +1464,9 @@ + @node with-package-iterator, unexport, make-package, Packages Dictionary + @subsection with-package-iterator [Macro] + +-@code{with-package-iterator} @i{@r{(}name package-list-form {&rest} {symbol-types}@r{)} +- @{@i{declaration}@}{*} @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{with-package-iterator} @i{@r{(}name package-list-form @r{&rest} @r{symbol-types}@r{)} ++ @{@i{declaration}@}* @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -1634,7 +1638,7 @@ + @node unexport, unintern, with-package-iterator, Packages Dictionary + @subsection unexport [Function] + +-@code{unexport} @i{symbols {&optional} package} @result{} @i{@b{t}} ++@code{unexport} @i{symbols @r{&optional} package} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1693,7 +1697,7 @@ + @node unintern, in-package, unexport, Packages Dictionary + @subsection unintern [Function] + +-@code{unintern} @i{symbol {&optional} package} @result{} @i{generalized-boolean} ++@code{unintern} @i{symbol @r{&optional} package} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -1795,7 +1799,7 @@ + @node unuse-package, use-package, in-package, Packages Dictionary + @subsection unuse-package [Function] + +-@code{unuse-package} @i{packages-to-unuse {&optional} package} @result{} @i{@b{t}} ++@code{unuse-package} @i{packages-to-unuse @r{&optional} package} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1846,7 +1850,7 @@ + @node use-package, defpackage, unuse-package, Packages Dictionary + @subsection use-package [Function] + +-@code{use-package} @i{packages-to-use {&optional} package} @result{} @i{@b{t}} ++@code{use-package} @i{packages-to-use @r{&optional} package} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1918,14 +1922,14 @@ + + @code{defpackage} @i{defined-package-name [[!@i{option}]]} @result{} @i{package} + +-@w{@i{option} ::=@{{(}@t{:nicknames} @{@i{nickname}@}{*}@r{)}@}{*} | } ++@w{@i{option} ::=@{@r{(}@t{:nicknames} @{@i{nickname}@}*@r{)}@}* | } + @w{ @r{(}@t{:documentation} @i{string}@r{)} | } +-@w{ @{{(}@t{:use} @{@i{package-name}@}{*}@r{)}@}{*} | } +-@w{ @{{(}@t{:shadow} @{!@i{symbol-name}@}{*}@r{)}@}{*} | } +-@w{ @{{(}@t{:shadowing-import-from} @i{package-name} @{!@i{symbol-name}@}{*}@r{)}@}{*} | } +-@w{ @{{(}@t{:import-from} @i{package-name} @{!@i{symbol-name}@}{*}@r{)}@}{*} | } +-@w{ @{{(}@t{:export} @{!@i{symbol-name}@}{*}@r{)}@}{*} | } +-@w{ @{{(}@t{:intern} @{!@i{symbol-name}@}{*}@r{)}@}{*} | } ++@w{ @{@r{(}@t{:use} @{@i{package-name}@}*@r{)}@}* | } ++@w{ @{@r{(}@t{:shadow} @{!@i{symbol-name}@}*@r{)}@}* | } ++@w{ @{@r{(}@t{:shadowing-import-from} @i{package-name} @{!@i{symbol-name}@}*@r{)}@}* | } ++@w{ @{@r{(}@t{:import-from} @i{package-name} @{!@i{symbol-name}@}*@r{)}@}* | } ++@w{ @{@r{(}@t{:export} @{!@i{symbol-name}@}*@r{)}@}* | } ++@w{ @{@r{(}@t{:intern} @{!@i{symbol-name}@}*@r{)}@}* | } + @w{ @r{(}@t{:size} @i{integer}@r{)}} + + @w{@i{symbol-name} ::=(@i{symbol} | @i{string})} +@@ -2058,7 +2062,7 @@ + particular, @i{shadowing symbols} and + @i{imported} @i{symbols} can be made external. + +-If a {defpackage} @i{form} appears as a @i{top level form}, ++If a @i{defpackage} @i{form} appears as a @i{top level form}, + all of the actions normally performed by this @i{macro} + at load time must also be performed at compile time. + +@@ -2122,7 +2126,7 @@ + + @subsubheading See Also:: + +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Package Concepts}, + @ref{Compilation} +@@ -2176,19 +2180,19 @@ + @subsection do-symbols, do-external-symbols, do-all-symbols [Macro] + + @code{do-symbols} @i{@r{(}var @r{[}package @r{[}result-form@r{]}@r{]}@r{)} +- @{@i{declaration}@}{*} +- @{tag | statement@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* ++ @{tag | statement@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @code{do-external-symbols} @i{@r{(}var @r{[}package @r{[}result-form@r{]}@r{]}@r{)} +- @{@i{declaration}@}{*} +- @{tag | statement@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* ++ @{tag | statement@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @code{do-all-symbols} @i{@r{(}var @r{[}result-form@r{]}@r{)} +- @{@i{declaration}@}{*} +- @{tag | statement@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* ++ @{tag | statement@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2296,7 +2300,7 @@ + @node intern, package-name, do-symbols, Packages Dictionary + @subsection intern [Function] + +-@code{intern} @i{string {&optional} package} @result{} @i{symbol, status} ++@code{intern} @i{string @r{&optional} package} @result{} @i{symbol, status} + + @subsubheading Arguments and Values:: + +@@ -2370,7 +2374,7 @@ + + @ref{find-symbol} + , +-@ref{read; read-preserving-whitespace} ++@ref{read} + , + @b{symbol}, + @ref{unintern} +diff -uNr gcl-texi-orig/chap-12.texi gcl-texi/chap-12.texi +--- gcl-texi-orig/chap-12.texi 1994-07-16 18:03:12 +0400 ++++ gcl-texi/chap-12.texi 2002-10-17 20:53:05 +0400 +@@ -33,6 +33,7 @@ + Figure 12--1 shows @i{operators} relating to + arithmetic operations. + ++@format + @group + @noindent + @w{ * 1+ gcd } +@@ -44,10 +45,12 @@ + @w{ Figure 12--1: Operators relating to Arithmetic.} + + @end group ++@end format + + Figure 12--2 shows @i{defined names} relating to + exponential, logarithmic, and trigonometric operations. + ++@format + @group + @noindent + @w{ abs cos signum } +@@ -63,10 +66,12 @@ + @w{ Figure 12--2: Defined names relating to Exponentials, Logarithms, and Trigonometry.} + + @end group ++@end format + + Figure 12--3 shows @i{operators} relating to + numeric comparison and predication. + ++@format + @group + @noindent + @w{ /= >= oddp } +@@ -79,10 +84,12 @@ + @w{ Figure 12--3: Operators for numeric comparison and predication.} + + @end group ++@end format + + Figure 12--4 shows @i{defined names} relating to + numeric type manipulation and coercion. + ++@format + @group + @noindent + @w{ ceiling float-radix rational } +@@ -99,6 +106,7 @@ + @w{ Figure 12--4: Defined names relating to numeric type manipulation and coercion.} + + @end group ++@end format + + @menu + * Associativity and Commutativity in Numeric Operations:: +@@ -187,6 +195,7 @@ + Figure 12--5 shows @i{defined names} relating to + logical operations on numbers. + ++@format + @group + @noindent + @w{ ash boole-ior logbitp } +@@ -205,6 +214,7 @@ + @w{ Figure 12--5: Defined names relating to logical operations on numbers.} + + @end group ++@end format + + @node Byte Operations on Integers, , Logical Operations on Integers, Numeric Operations + @subsubsection Byte Operations on Integers +@@ -220,6 +230,7 @@ + Figure 12--6 shows @i{defined names} relating to + manipulating @i{bytes} of @i{numbers}. + ++@format + @group + @noindent + @w{ byte deposit-field ldb-test } +@@ -230,6 +241,7 @@ + @w{ Figure 12--6: Defined names relating to byte manipulation.} + + @end group ++@end format + + @node Implementation-Dependent Numeric Constants, Rational Computations, Numeric Operations, Number Concepts + @subsection Implementation-Dependent Numeric Constants +@@ -237,6 +249,7 @@ + Figure 12--7 shows @i{defined names} relating to + @i{implementation-dependent} details about @i{numbers}. + ++@format + @group + @noindent + @w{ double-float-epsilon most-negative-fixnum } +@@ -257,6 +270,7 @@ + @w{ Figure 12--7: Defined names relating to implementation-dependent details about numbers.} + + @end group ++@end format + + @node Rational Computations, Floating-point Computations, Implementation-Dependent Numeric Constants, Number Concepts + @subsection Rational Computations +@@ -331,6 +345,7 @@ + (permissible only if the imaginary + part of the true mathematical result is zero) or @t{(complex single-float)}. + ++@format + @group + @noindent + @w{ Function Sample Results } +@@ -361,6 +376,7 @@ + @w{ Figure 12--8: Functions Affected by Rule of Float Substitutability} + + @end group ++@end format + + @node Floating-point Computations, Complex Computations, Rational Computations, Number Concepts + @subsection Floating-point Computations +@@ -525,7 +541,7 @@ + called branch cuts must be defined, which in turn + define the discontinuities in the range. + @r{Common Lisp} defines the branch cuts, @i{principal} @i{values}, and boundary +-conditions for the complex functions following ``{Principal Values and Branch Cuts in Complex APL}.'' The branch ++conditions for the complex functions following ``Principal Values and Branch Cuts in Complex APL.'' The branch + cut rules that apply to each function are located with the description of + that function. + +@@ -534,6 +550,7 @@ + throughout the applicable portion of the complex domain, even on + the branch cuts: + ++@format + @group + @noindent + @w{ sin i z = i sinh z sinh i z = i sin z arctan i z = i arctanh z } +@@ -544,6 +561,7 @@ + @w{ Figure 12--9: Trigonometric Identities for Complex Domain } + + @end group ++@end format + + The quadrant numbers referred to in the discussions of branch cuts are as illustrated + in Figure 12--10. +@@ -623,6 +641,7 @@ + + Figure 12--10 lists some @i{defined names} that are applicable to @i{random states}. + ++@format + @group + @noindent + @w{ *random-state* random } +@@ -632,6 +651,7 @@ + @w{ Figure 12--10: Random-state defined names} + + @end group ++@end format + + @c end of including concept-numbers + +@@ -646,13 +666,13 @@ + * real:: + * float (System Class):: + * short-float:: +-* rational:: ++* rational (System Class):: + * ratio:: + * integer:: + * signed-byte:: + * unsigned-byte:: +-* mod:: +-* bit:: ++* mod (System Class):: ++* bit (System Class):: + * fixnum:: + * bignum:: + * =:: +@@ -676,7 +696,7 @@ + * incf:: + * lcm:: + * log:: +-* mod:: ++* mod (Function):: + * signum:: + * sqrt:: + * random-state:: +@@ -694,7 +714,7 @@ + * upgraded-complex-part-type:: + * realp:: + * numerator:: +-* rational:: ++* rational (Function):: + * rationalp:: + * ash:: + * integer-length:: +@@ -882,14 +902,14 @@ + A @i{float} + is a mathematical rational (but @i{not} a @r{Common Lisp} @i{rational}) + of the form +-s\cdot f\cdot b^{e-p}, ++s\cdot f\cdot b^@r{e-p}, + where s is +1 or -1, the @i{sign}; + b is an @i{integer} + greater than~1, the @i{base} or @i{radix} of the representation; + p is a positive @i{integer}, + the @i{precision} (in base-b digits) of the @i{float}; + f is a positive @i{integer} +-between b^{p-1} and ++between b^@r{p-1} and + b^p-1 (inclusive), the significand; + and e is an @i{integer}, the exponent. + The value of p and the range of~e +@@ -937,7 +957,7 @@ + + @subsubheading See Also:: + +-{@i{Figure~2--9}}, ++@i{Figure~2--9}, + @ref{Constructing Numbers from Tokens}, + @ref{Printing Floats} + +@@ -950,7 +970,7 @@ + the @i{float} @t{1.0}, + or the @i{complex} @t{#C(1.0 0.0)}. + +-@node short-float, rational, float (System Class), Numbers Dictionary ++@node short-float, rational (System Class), float (System Class), Numbers Dictionary + @subsection short-float, single-float, double-float, long-float [Type] + + @subsubheading Supertypes:: +@@ -1005,6 +1025,7 @@ + as the values in Figure 12--11. + Each of the defined @i{subtypes} of @i{type} @b{float} might or might not have a minus zero. + ++@format + @group + @noindent + @w{ @b{Format} @b{Minimum Precision} @b{Minimum Exponent Size} } +@@ -1018,6 +1039,7 @@ + @w{ Figure 12--11: Recommended Minimum Floating-Point Precision and Exponent Size} + + @end group ++@end format + + There can be fewer than four internal + representations for @i{floats}. +@@ -1099,7 +1121,7 @@ + Each of these denotes the set of @i{floats} of the indicated @i{type} + that are on the interval specified by the @i{interval designators}. + +-@node rational, ratio, short-float, Numbers Dictionary ++@node rational (System Class), ratio, short-float, Numbers Dictionary + @subsection rational [System Class] + + @subsubheading Class Precedence List:: +@@ -1138,7 +1160,7 @@ + This denotes the @i{rationals} on the interval described by + @i{lower-limit} and @i{upper-limit}. + +-@node ratio, integer, rational, Numbers Dictionary ++@node ratio, integer, rational (System Class), Numbers Dictionary + @subsection ratio [System Class] + + @subsubheading Class Precedence List:: +@@ -1160,7 +1182,7 @@ + + @subsubheading See Also:: + +-{@i{Figure~2--9}}, ++@i{Figure~2--9}, + @ref{Constructing Numbers from Tokens}, + @ref{Printing Ratios} + +@@ -1205,7 +1227,7 @@ + + @subsubheading See Also:: + +-{@i{Figure~2--9}}, ++@i{Figure~2--9}, + @ref{Constructing Numbers from Tokens}, + @ref{Printing Integers} + +@@ -1255,11 +1277,11 @@ + + This denotes the set of @i{integers} that can be represented + in two's-complement form in a @i{byte} of @i{s} bits. This is +-equivalent to @t{(integer -2^{s-1} 2^{s-1}-1)}. The type ++equivalent to @t{(integer -2^@r{s-1} 2^@r{s-1}-1)}. The type + @b{signed-byte} or the type @t{(signed-byte *)} is the same + as the @i{type} @b{integer}. + +-@node unsigned-byte, mod, signed-byte, Numbers Dictionary ++@node unsigned-byte, mod (System Class), signed-byte, Numbers Dictionary + @subsection unsigned-byte [Type] + + @subsubheading Supertypes:: +@@ -1306,7 +1328,7 @@ + + The @i{type} @t{(unsigned-byte 1)} is also called @b{bit}. + +-@node mod, bit, unsigned-byte, Numbers Dictionary ++@node mod (System Class), bit (System Class), unsigned-byte, Numbers Dictionary + @subsection mod [Type Specifier] + + @subsubheading Compound Type Specifier Kind:: +@@ -1334,7 +1356,7 @@ + + The symbol @b{mod} is not valid as a @i{type specifier}. + +-@node bit, fixnum, mod, Numbers Dictionary ++@node bit (System Class), fixnum, mod (System Class), Numbers Dictionary + @subsection bit [Type] + + @subsubheading Supertypes:: +@@ -1355,7 +1377,7 @@ + The @i{type} @b{bit} is equivalent to the @i{type} @t{(integer 0 1)} + and @t{(unsigned-byte 1)}. + +-@node fixnum, bignum, bit, Numbers Dictionary ++@node fixnum, bignum, bit (System Class), Numbers Dictionary + @subsection fixnum [Type] + + @subsubheading Supertypes:: +@@ -1400,17 +1422,17 @@ + @node =, max, bignum, Numbers Dictionary + @subsection =, /=, <, >, <=, >= [Function] + +-@code{=} @i{{&rest} numbers^+} @result{} @i{generalized-boolean} ++@code{=} @i{@r{&rest} numbers^+} @result{} @i{generalized-boolean} + +-@code{/=} @i{{&rest} numbers^+} @result{} @i{generalized-boolean} ++@code{/=} @i{@r{&rest} numbers^+} @result{} @i{generalized-boolean} + +-@code{<} @i{{&rest} numbers^+} @result{} @i{generalized-boolean} ++@code{<} @i{@r{&rest} numbers^+} @result{} @i{generalized-boolean} + +-@code{>} @i{{&rest} numbers^+} @result{} @i{generalized-boolean} ++@code{>} @i{@r{&rest} numbers^+} @result{} @i{generalized-boolean} + +-@code{<=} @i{{&rest} numbers^+} @result{} @i{generalized-boolean} ++@code{<=} @i{@r{&rest} numbers^+} @result{} @i{generalized-boolean} + +-@code{>=} @i{{&rest} numbers^+} @result{} @i{generalized-boolean} ++@code{>=} @i{@r{&rest} numbers^+} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -1462,6 +1484,7 @@ + + The uses of these functions are illustrated in Figure 12--12. + ++@format + @group + @noindent + @w{ @t{(= 3 3)} is @i{true}. @t{(/= 3 3)} is @i{false}. } +@@ -1493,6 +1516,7 @@ + @w{ Figure 12--12: Uses of /=, =, <, >, <=, and >= } + + @end group ++@end format + + @subsubheading Exceptional Situations:: + +@@ -1509,9 +1533,9 @@ + @node max, minusp, =, Numbers Dictionary + @subsection max, min [Function] + +-@code{max} @i{{&rest} reals^+} @result{} @i{max-real} ++@code{max} @i{@r{&rest} reals^+} @result{} @i{max-real} + +-@code{min} @i{{&rest} reals^+} @result{} @i{min-real} ++@code{min} @i{@r{&rest} reals^+} @result{} @i{min-real} + + @subsubheading Arguments and Values:: + +@@ -1628,7 +1652,7 @@ + + @subsubheading Pronunciation:: + +-pronounced 'z\=e (, )r\=o{}(, )p\=e ++pronounced 'z\=e (, )r\=o@r{}(, )p\=e + + @subsubheading Arguments and Values:: + +@@ -1673,21 +1697,21 @@ + @i{[Function]} + @end flushright + +-@code{floor} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{floor} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + +-@code{ffloor} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{ffloor} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + +-@code{ceiling} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{ceiling} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + +-@code{fceiling} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{fceiling} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + +-@code{truncate} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{truncate} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + +-@code{ftruncate} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{ftruncate} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + +-@code{round} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{round} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + +-@code{fround} @i{number {&optional} divisor} @result{} @i{quotient, remainder} ++@code{fround} @i{number @r{&optional} divisor} @result{} @i{quotient, remainder} + + @subsubheading Arguments and Values:: + +@@ -1708,7 +1732,7 @@ + These functions divide @i{number} by @i{divisor}, + returning a @i{quotient} and @i{remainder}, such that + +- @i{quotient}{\cdot} @i{divisor}+@i{remainder}=@i{number} ++ @i{quotient}@r{\cdot} @i{divisor}+@i{remainder}=@i{number} + + The @i{quotient} always represents a mathematical integer. + When more than one mathematical integer might be possible +@@ -1853,7 +1877,7 @@ + + @subsubheading See Also:: + +-@ref{asin; acos; atan} ++@ref{asin} + , + @b{acos}, + @b{atan}, +@@ -1866,7 +1890,7 @@ + + @code{acos} @i{number} @result{} @i{radians} + +-@code{atan} @i{number1 {&optional} number2} @result{} @i{radians} ++@code{atan} @i{number1 @r{&optional} number2} @result{} @i{radians} + + @subsubheading Arguments and Values:: + +@@ -1888,17 +1912,19 @@ + functions can be defined mathematically for + @i{number} or @i{number1} specified as @i{x} as in Figure 12--13. + ++@format + @group + @noindent + @w{ Function Definition } +-@w{ Arc sine -i @t{log} (ix+ \sqrt{1-x^2} ) } ++@w{ Arc sine -i @t{log} (ix+ \sqrt@r{1-x^2} ) } + @w{ Arc cosine (\pi/2) - @t{arcsin} x } +-@w{ Arc tangent -i @t{log} ((1+ix) \sqrt{1/(1+x^2)} ) } ++@w{ Arc tangent -i @t{log} ((1+ix) \sqrt@r{1/(1+x^2)} ) } + + @noindent + @w{ Figure 12--13: Mathematical definition of arc sine, arc cosine, and arc tangent} + + @end group ++@end format + + These formulae are mathematically correct, assuming + completely accurate computation. They are not necessarily +@@ -1936,7 +1962,7 @@ + The following definition for arc sine determines the range and + branch cuts: + +-@center @t{arcsin} z = -i @t{log} (iz+\sqrt{1-z^2}\Bigr) ++@center @t{arcsin} z = -i @t{log} (iz+\sqrt@r{1-z^2}\Bigr) + + The branch cut for the arc sine function is in two pieces: + one along the negative real axis to the left of~-1 +@@ -1951,13 +1977,13 @@ + The following definition for arc cosine determines the range and + branch cuts: + +-@center @t{arccos} z = {\pi\over2}- @t{arcsin} z ++@center @t{arccos} z = \pi\over2 - @t{arcsin} z + + or, which are equivalent, + +-@center @t{arccos} z = -i @t{log} (z+i \sqrt{1-z^2}\Bigr) ++@center @t{arccos} z = -i @t{log} (z+i \sqrt@r{1-z^2}\Bigr) + +-@center @t{arccos} z = {{2 @t{log} (\sqrt{(1+z)/2} + i \sqrt{(1-z)/2})}\over{i}} ++@center @t{arccos} z = @t{2 @t{log} (\sqrt@r{(1+z)/2} + i \sqrt@r{(1-z)/2})}\over@r{i} + + The branch cut for the arc cosine function is in two pieces: + one along the negative real axis to the left of~-1 +@@ -1973,7 +1999,7 @@ + The following definition for (one-argument) arc tangent determines the + range and branch cuts: + +-@center @t{arctan} z = {{@t{log} (1+iz) - @t{log} (1-iz)}\over{2i}} ++@center @t{arctan} z = @i{@i{@t{log} (1+iz) - @t{log} (1-iz)}\over@i{2i}} + + Beware of simplifying this formula; ``obvious'' simplifications are likely + to alter the branch cuts or the values on the branch cuts incorrectly. +@@ -1998,31 +2024,33 @@ + The asterisk (*) indicates that the entry in the figure applies to + implementations that support minus zero. + ++@format + @group + @noindent +-@w{ to 1pc{}@i{y} Condition @i{x} Condition Cartesian locus Range of result } +-@w{ to 1pc{} y = 0 x > 0 Positive x-axis 0 } +-@w{ to 1pc{*} y = +0 x > 0 Positive x-axis +0 } +-@w{ to 1pc{*} y = -0 x > 0 Positive x-axis -0 } +-@w{ to 1pc{} y > 0 x > 0 Quadrant I 0 < result < \pi/2 } +-@w{ to 1pc{} y > 0 x = 0 Positive y-axis \pi/2 } +-@w{ to 1pc{} y > 0 x < 0 Quadrant II \pi/2 < result < \pi } +-@w{ to 1pc{} y = 0 x < 0 Negative x-axis \pi } +-@w{ to 1pc{*} y = +0 x < 0 Negative x-axis +\pi } +-@w{ to 1pc{*} y = -0 x < 0 Negative x-axis -\pi } +-@w{ to 1pc{} y < 0 x < 0 Quadrant III -\pi < result < -\pi/2 } +-@w{ to 1pc{} y < 0 x = 0 Negative y-axis -\pi/2 } +-@w{ to 1pc{} y < 0 x > 0 Quadrant IV -\pi/2 < result < 0 } +-@w{ to 1pc{} y = 0 x = 0 Origin undefined consequences } +-@w{ to 1pc{*} y = +0 x = +0 Origin +0 } +-@w{ to 1pc{*} y = -0 x = +0 Origin -0 } +-@w{ to 1pc{*} y = +0 x = -0 Origin +\pi } +-@w{ to 1pc{*} y = -0 x = -0 Origin -\pi } ++@w{ to 1pc@r{}@i{y} Condition @i{x} Condition Cartesian locus Range of result } ++@w{ to 1pc@r{} y = 0 x > 0 Positive x-axis 0 } ++@w{ to 1pc* y = +0 x > 0 Positive x-axis +0 } ++@w{ to 1pc* y = -0 x > 0 Positive x-axis -0 } ++@w{ to 1pc@r{} y > 0 x > 0 Quadrant I 0 < result < \pi/2 } ++@w{ to 1pc@r{} y > 0 x = 0 Positive y-axis \pi/2 } ++@w{ to 1pc@r{} y > 0 x < 0 Quadrant II \pi/2 < result < \pi } ++@w{ to 1pc@r{} y = 0 x < 0 Negative x-axis \pi } ++@w{ to 1pc* y = +0 x < 0 Negative x-axis +\pi } ++@w{ to 1pc* y = -0 x < 0 Negative x-axis -\pi } ++@w{ to 1pc@r{} y < 0 x < 0 Quadrant III -\pi < result < -\pi/2 } ++@w{ to 1pc@r{} y < 0 x = 0 Negative y-axis -\pi/2 } ++@w{ to 1pc@r{} y < 0 x > 0 Quadrant IV -\pi/2 < result < 0 } ++@w{ to 1pc@r{} y = 0 x = 0 Origin undefined consequences } ++@w{ to 1pc* y = +0 x = +0 Origin +0 } ++@w{ to 1pc* y = -0 x = +0 Origin -0 } ++@w{ to 1pc* y = +0 x = -0 Origin +\pi } ++@w{ to 1pc* y = -0 x = -0 Origin -\pi } + + @noindent + @w{ Figure 12--14: Quadrant information for arc tangent } + + @end group ++@end format + + @subsubheading Examples:: + +@@ -2047,7 +2075,7 @@ + + @ref{log} + , +-@ref{sqrt; isqrt} ++@ref{sqrt} + , + @ref{Rule of Float Substitutability} + +@@ -2119,25 +2147,27 @@ + which are mathematically defined for an argument @i{x} + as given in Figure 12--15. + ++@format + @group + @noindent + @w{ Function Definition } +-@w{ Hyperbolic sine (e^x-e^{-x})/2 } +-@w{ Hyperbolic cosine (e^x+e^{-x})/2 } +-@w{ Hyperbolic tangent (e^x-e^{-x})/(e^x+e^{-x}) } +-@w{ Hyperbolic arc sine @t{log} (x+\sqrt{1+x^2}) } +-@w{ Hyperbolic arc cosine 2 @t{log} (\sqrt{(x+1)/2} + \sqrt{(x-1)/2}) } ++@w{ Hyperbolic sine (e^x-e^@i{-x})/2 } ++@w{ Hyperbolic cosine (e^x+e^@i{-x})/2 } ++@w{ Hyperbolic tangent (e^x-e^@i{-x})/(e^x+e^@i{-x}) } ++@w{ Hyperbolic arc sine @t{log} (x+\sqrt@i{1+x^2}) } ++@w{ Hyperbolic arc cosine 2 @t{log} (\sqrt@i{(x+1)/2} + \sqrt@i{(x-1)/2}) } + @w{ Hyperbolic arc tangent (@t{log} (1+x) - @t{log} (1-x))/2 } + + @noindent + @w{ Figure 12--15: Mathematical definitions for hyperbolic functions } + + @end group ++@end format + + The following definition for the inverse hyperbolic cosine + determines the range and branch cuts: + +-@center @t{arccosh} z = 2 @t{log} (\sqrt{(z+1)/2} + \sqrt{(z-1)/2}\Bigr). ++@center @t{arccosh} z = 2 @t{log} (\sqrt@i{(z+1)/2} + \sqrt@i{(z-1)/2}\Bigr). + + The branch cut for the inverse hyperbolic cosine function + lies along the real axis to the left of~1 (inclusive), extending +@@ -2152,7 +2182,7 @@ + The following definition for the inverse hyperbolic sine determines + the range and branch cuts: + +-@center @t{arcsinh} z = @t{log} (z+\sqrt{1+z^2}\Bigr). ++@center @t{arcsinh} z = @t{log} (z+\sqrt@i{1+z^2}\Bigr). + + The branch cut for the inverse hyperbolic sine function is in two pieces: + one along the positive imaginary axis above i +@@ -2167,7 +2197,7 @@ + The following definition for the inverse hyperbolic tangent + determines the range and branch cuts: + +-@center @t{arctanh} z = {{@t{log} (1+z) - @t{log} (1-z)}\over{2}}. ++@center @t{arctanh} z = @i{@i{@t{log} (1+z) - @t{log} (1-z)}\over@r{2}}. + + Note that: + +@@ -2206,7 +2236,7 @@ + + @ref{log} + , +-@ref{sqrt; isqrt} ++@ref{sqrt} + , + @ref{Rule of Float Substitutability} + +@@ -2228,7 +2258,7 @@ + @node *, +, sinh, Numbers Dictionary + @subsection * [Function] + +-@code{*} @i{{&rest} numbers} @result{} @i{product} ++@code{*} @i{@r{&rest} numbers} @result{} @i{product} + + @subsubheading Arguments and Values:: + +@@ -2265,7 +2295,7 @@ + @node +, -, *, Numbers Dictionary + @subsection + [Function] + +-@code{+} @i{{&rest} numbers} @result{} @i{sum} ++@code{+} @i{@r{&rest} numbers} @result{} @i{sum} + + @subsubheading Arguments and Values:: + +@@ -2304,7 +2334,7 @@ + + @code{-} @i{number} @result{} @i{negation} + +-@code{-} @i{minuend {&rest} subtrahends^+} @result{} @i{difference} ++@code{-} @i{minuend @r{&rest} subtrahends^+} @result{} @i{difference} + + @subsubheading Arguments and Values:: + +@@ -2353,7 +2383,7 @@ + + @code{/} @i{number} @result{} @i{reciprocal} + +-@code{/} @i{numerator {&rest} denominators^+} @result{} @i{quotient} ++@code{/} @i{numerator @r{&rest} denominators^+} @result{} @i{quotient} + + @subsubheading Arguments and Values:: + +@@ -2406,16 +2436,16 @@ + + @subsubheading See Also:: + +-@ref{floor; ffloor; ceiling; fceiling; truncate; ftruncate; round; fround} ++@ref{floor} + , @b{ceiling}, @b{truncate}, @b{round} + + @node 1+, abs, /, Numbers Dictionary + @subsection 1+, 1- [Function] + + @code{1} @i{+} @result{} @i{number} +- {successor} ++ @r{successor} + @code{1} @i{-} @result{} @i{number} +- {predecessor} ++ @r{predecessor} + + @subsubheading Arguments and Values:: + +@@ -2444,7 +2474,7 @@ + + @subsubheading See Also:: + +-@ref{incf; decf} ++@ref{incf} + , @b{decf} + + @subsubheading Notes:: +@@ -2611,7 +2641,7 @@ + approximately equal to @t{#C(1.0 1.73205)}, not @t{-2}. + + @b{expt} is defined +-as @i{b^x = e^{x log b\/}}. ++as @i{b^x = e^@i{x log b\/}}. + This defines the @i{principal} @i{values} precisely. The range of + @b{expt} is the entire complex plane. Regarded + as a function of @i{x}, with @i{b} fixed, there is no branch cut. +@@ -2678,7 +2708,7 @@ + @node gcd, incf, exp, Numbers Dictionary + @subsection gcd [Function] + +-@code{gcd} @i{{&rest} integers} @result{} @i{greatest-common-denominator} ++@code{gcd} @i{@r{&rest} integers} @result{} @i{greatest-common-denominator} + + @subsubheading Arguments and Values:: + +@@ -2778,12 +2808,12 @@ + @b{+}, + @ref{-} + , @b{1+}, @b{1-}, +-@ref{setf; psetf} ++@ref{setf} + + @node lcm, log, incf, Numbers Dictionary + @subsection lcm [Function] + +-@code{lcm} @i{{&rest} integers} @result{} @i{least-common-multiple} ++@code{lcm} @i{@r{&rest} integers} @result{} @i{least-common-multiple} + + @subsubheading Arguments and Values:: + +@@ -2836,10 +2866,10 @@ + + @ref{gcd} + +-@node log, mod, lcm, Numbers Dictionary ++@node log, mod (Function), lcm, Numbers Dictionary + @subsection log [Function] + +-@code{log} @i{number {&optional} base} @result{} @i{logarithm} ++@code{log} @i{number @r{&optional} base} @result{} @i{logarithm} + + @subsubheading Arguments and Values:: + +@@ -2924,12 +2954,12 @@ + + @subsubheading See Also:: + +-@ref{exp; expt} ++@ref{exp} + , + @b{expt}, + @ref{Rule of Float Substitutability} + +-@node mod, signum, log, Numbers Dictionary ++@node mod (Function), signum, log, Numbers Dictionary + @subsection mod, rem [Function] + + @code{mod} @i{number divisor} @result{} @i{modulus} +@@ -2981,7 +3011,7 @@ + + @subsubheading See Also:: + +-@ref{floor; ffloor; ceiling; fceiling; truncate; ftruncate; round; fround} ++@ref{floor} + , @b{truncate} + + @subsubheading Notes:: +@@ -2992,7 +3022,7 @@ + + with the same sign as @i{divisor}. + +-@node signum, sqrt, mod, Numbers Dictionary ++@node signum, sqrt, mod (Function), Numbers Dictionary + @subsection signum [Function] + + @code{signum} @i{number} @result{} @i{signed-prototype} +@@ -3122,7 +3152,7 @@ + + @subsubheading See Also:: + +-@ref{exp; expt} ++@ref{exp} + , + @ref{log} + , +@@ -3166,7 +3196,7 @@ + @node make-random-state, random, random-state, Numbers Dictionary + @subsection make-random-state [Function] + +-@code{make-random-state} @i{{&optional} state} @result{} @i{new-state} ++@code{make-random-state} @i{@r{&optional} state} @result{} @i{new-state} + + @subsubheading Arguments and Values:: + +@@ -3230,7 +3260,7 @@ + @node random, random-state-p, make-random-state, Numbers Dictionary + @subsection random [Function] + +-@code{random} @i{limit {&optional} random-state} @result{} @i{random-number} ++@code{random} @i{limit @r{&optional} random-state} @result{} @i{random-number} + + @subsubheading Arguments and Values:: + +@@ -3420,7 +3450,7 @@ + + @subsubheading Description:: + +-@b{cis} returns the value of~@i{e}^{i\cdot @i{radians}}, ++@b{cis} returns the value of~@i{e}^@i{i\cdot @i{radians}}, + which is a @i{complex} in which the + real part is equal to the cosine of @i{radians}, and the + imaginary part is equal to the sine of @i{radians}. +@@ -3437,7 +3467,7 @@ + @node complex, complexp, cis, Numbers Dictionary + @subsection complex [Function] + +-@code{complex} @i{realpart {&optional} imagpart} @result{} @i{complex} ++@code{complex} @i{realpart @r{&optional} imagpart} @result{} @i{complex} + + @subsubheading Arguments and Values:: + +@@ -3490,7 +3520,7 @@ + + @subsubheading See Also:: + +-@ref{realpart; imagpart} ++@ref{realpart} + , @b{imagpart} + + @subsubheading Notes:: +@@ -3687,7 +3717,7 @@ + @node upgraded-complex-part-type, realp, realpart, Numbers Dictionary + @subsection upgraded-complex-part-type [Function] + +-@code{upgraded-complex-part-type} @i{typespec {&optional} environment} @result{} @i{upgraded-typespec} ++@code{upgraded-complex-part-type} @i{typespec @r{&optional} environment} @result{} @i{upgraded-typespec} + + @subsubheading Arguments and Values:: + +@@ -3749,7 +3779,7 @@ + (realp @i{object}) @equiv{} (typep @i{object} 'real) + @end example + +-@node numerator, rational, realp, Numbers Dictionary ++@node numerator, rational (Function), realp, Numbers Dictionary + @subsection numerator, denominator [Function] + + @code{numerator} @i{rational} @result{} @i{numerator} +@@ -3795,7 +3825,7 @@ + (gcd (numerator x) (denominator x)) @result{} 1 + @end example + +-@node rational, rationalp, numerator, Numbers Dictionary ++@node rational (Function), rationalp, numerator, Numbers Dictionary + @subsection rational, rationalize [Function] + + @code{rational} @i{number} @result{} @i{rational} +@@ -3868,7 +3898,7 @@ + to a @i{float} + of the same format produces the original @i{number}. + +-@node rationalp, ash, rational, Numbers Dictionary ++@node rationalp, ash, rational (Function), Numbers Dictionary + @subsection rationalp [Function] + + @code{rationalp} @i{object} @result{} @i{generalized-boolean} +@@ -3894,7 +3924,7 @@ + + @subsubheading See Also:: + +-@ref{rational} ++@ref{rational (Function)} + + @subsubheading Notes:: + @example +@@ -3926,7 +3956,7 @@ + as @i{integer} is returned. + + Mathematically speaking, @b{ash} performs the computation +-@t{floor}(@i{integer}{\cdot} 2^@i{count}). ++@t{floor}(@i{integer}\cdot 2^@i{count}). + Logically, @b{ash} + moves all of the bits in @i{integer} to the left, + adding zero-bits at the right, or moves them to the right, +@@ -4050,7 +4080,7 @@ + @node parse-integer, boole, integerp, Numbers Dictionary + @subsection parse-integer [Function] + +-@code{parse-integer} @i{string {&key} start end radix junk-allowed} @result{} @i{integer, pos} ++@code{parse-integer} @i{string @r{&key} start end radix junk-allowed} @result{} @i{integer, pos} + + @subsubheading Arguments and Values:: + +@@ -4140,8 +4170,9 @@ + @b{boole} returns the values + specified for any @i{op} in Figure 12--16. + +-{ + ++ ++@format + @group + @noindent + @w{ Op Result } +@@ -4166,8 +4197,9 @@ + @w{ Figure 12--16: Bit-Wise Logical Operations } + + @end group ++@end format ++ + +-} + + @subsubheading Examples:: + +@@ -4217,7 +4249,7 @@ + + @subsubheading See Also:: + +-@ref{logand; logandc1; logandc2; logeqv; logior; lognand; lognor; lognot; logorc1; logorc2; logxor} ++@ref{logand} + + @subsubheading Notes:: + +@@ -4292,15 +4324,15 @@ + @i{[Function]} + @end flushright + +-@code{logand} @i{{&rest} integers} @result{} @i{result-integer} ++@code{logand} @i{@r{&rest} integers} @result{} @i{result-integer} + + @code{logandc} @i{1} @result{} @i{integer-1 integer-2} +- {result-integer} ++ @r{result-integer} + @code{logandc} @i{2} @result{} @i{integer-1 integer-2} +- {result-integer} +-@code{logeqv} @i{{&rest} integers} @result{} @i{result-integer} ++ @r{result-integer} ++@code{logeqv} @i{@r{&rest} integers} @result{} @i{result-integer} + +-@code{logior} @i{{&rest} integers} @result{} @i{result-integer} ++@code{logior} @i{@r{&rest} integers} @result{} @i{result-integer} + + @code{lognand} @i{integer-1 integer-2} @result{} @i{result-integer} + +@@ -4309,10 +4341,10 @@ + @code{lognot} @i{integer} @result{} @i{result-integer} + + @code{logorc} @i{1} @result{} @i{integer-1 integer-2} +- {result-integer} ++ @r{result-integer} + @code{logorc} @i{2} @result{} @i{integer-1 integer-2} +- {result-integer} +-@code{logxor} @i{{&rest} integers} @result{} @i{result-integer} ++ @r{result-integer} ++@code{logxor} @i{@r{&rest} integers} @result{} @i{result-integer} + + @subsubheading Arguments and Values:: + +@@ -4347,6 +4379,7 @@ + Where an `identity' is shown, it indicates the @i{value} @i{yielded} + by the @i{function} when no @i{arguments} are supplied. + ++@format + @group + @noindent + @w{ Function Identity Operation performed } +@@ -4366,6 +4399,7 @@ + @w{ Figure 12--17: Bit-wise Logical Operations on Integers } + + @end group ++@end format + + Negative @i{integers} are treated as if they were in two's-complement notation. + +@@ -4594,7 +4628,7 @@ + + @b{byte} returns a @i{byte specifier} that indicates + a @i{byte} of width @i{size} and whose bits have weights +-2^{@i{position} + @i{size} - 1\/} through 2^@i{position}, ++2^@i{@i{position} + @i{size} - 1\/} through 2^@i{position}, + and whose representation is + @i{implementation-dependent}. + +@@ -4663,7 +4697,7 @@ + + @subsubheading See Also:: + +-@ref{byte; byte-size; byte-position} ++@ref{byte} + , + @ref{dpb} + +@@ -4723,7 +4757,7 @@ + + @subsubheading See Also:: + +-@ref{byte; byte-size; byte-position} ++@ref{byte} + , + @ref{deposit-field} + , +@@ -4776,8 +4810,8 @@ + specified by @i{bytespec}. + + @b{ldb} returns an @i{integer} in which the bits with weights +-2^{(@i{s}-1)} through 2^{0} are the same as those in +-@i{integer} with weights 2^{(@i{p}+@i{s}-1)} ++2^@i{(@i{s}-1)} through 2^0 are the same as those in ++@i{integer} with weights 2^@i{(@i{p}+@i{s}-1)} + through 2^@i{p}, and all other bits zero; @i{s} is + @t{(byte-size @i{bytespec})} + and @i{p} is @t{(byte-position @i{bytespec})}. +@@ -4807,7 +4841,7 @@ + + @subsubheading See Also:: + +-@ref{byte; byte-size; byte-position} ++@ref{byte} + , + @b{byte-position}, + @b{byte-size}, +@@ -4859,7 +4893,7 @@ + + @subsubheading See Also:: + +-@ref{byte; byte-size; byte-position} ++@ref{byte} + , + @ref{ldb} + , +@@ -4912,7 +4946,7 @@ + + @subsubheading See Also:: + +-@ref{byte; byte-size; byte-position} ++@ref{byte} + , + @ref{ldb} + +@@ -4937,13 +4971,13 @@ + @b{most-positive-fixnum} is that @i{fixnum} closest in value + to positive infinity provided by the implementation, + +-and greater than or equal to both 2^{15} - 1 and ++and greater than or equal to both 2^@r{15} - 1 and + @b{array-dimension-limit}. + + @b{most-negative-fixnum} is that @i{fixnum} closest in value + to negative infinity provided by the implementation, + +-and less than or equal to -2^{15}. ++and less than or equal to -2^@r{15}. + + @node decode-float, float, most-positive-fixnum, Numbers Dictionary + @subsection decode-float, scale-float, float-radix, float-sign, +@@ -4958,7 +4992,7 @@ + + @code{float-radix} @i{float} @result{} @i{float-radix} + +-@code{float-sign} @i{float-1 {&optional} float-2} @result{} @i{signed-float} ++@code{float-sign} @i{float-1 @r{&optional} float-2} @result{} @i{signed-float} + + @code{float-digits} @i{float} @result{} @i{digits1} + +@@ -5137,7 +5171,7 @@ + @node float, floatp, decode-float, Numbers Dictionary + @subsection float [Function] + +-@code{float} @i{number {&optional} prototype} @result{} @i{float} ++@code{float} @i{number @r{&optional} prototype} @result{} @i{float} + + @subsubheading Arguments and Values:: + +@@ -5184,7 +5218,7 @@ + @subsection floatp [Function] + + @code{floatp} @i{object} +- {generalized-boolean} ++ @r{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -5372,7 +5406,7 @@ + @subsubheading See Also:: + + @b{arithmetic-error-operation}, +-@ref{arithmetic-error-operands; arithmetic-error-operation} ++@ref{arithmetic-error-operands} + + @node arithmetic-error-operands, division-by-zero, arithmetic-error, Numbers Dictionary + @subsection arithmetic-error-operands, arithmetic-error-operation [Function] +@@ -5401,7 +5435,7 @@ + @subsubheading See Also:: + + @b{arithmetic-error}, +-{@ref{Conditions}} ++@ref{Conditions} + + @subsubheading Notes:: + +diff -uNr gcl-texi-orig/chap-13.texi gcl-texi/chap-13.texi +--- gcl-texi-orig/chap-13.texi 1994-07-16 18:03:11 +0400 ++++ gcl-texi/chap-13.texi 2002-10-17 20:53:05 +0400 +@@ -46,6 +46,7 @@ + Figure 13--1 lists some @i{defined names} relating to + @i{character} @i{attributes} and @i{character} @i{predicates}. + ++@format + @group + @noindent + @w{ alpha-char-p char-not-equal char> } +@@ -60,9 +61,11 @@ + @w{ Figure 13--1: Character defined names -- 1 } + + @end group ++@end format + + Figure 13--2 lists some @i{character} construction and conversion @i{defined names}. + ++@format + @group + @noindent + @w{ char-code char-name code-char } +@@ -73,6 +76,7 @@ + @w{ Figure 13--2: Character defined names -- 2} + + @end group ++@end format + + @node Introduction to Scripts and Repertoires, Character Attributes, Introduction to Characters, Character Concepts + @subsection Introduction to Scripts and Repertoires +@@ -671,29 +675,29 @@ + @i{[Function]} + @end flushright + +-@code{{char=}} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{@r{char=}} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{{char/=}} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{@r{char/=}} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{{char<}} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{@r{char<}} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{{char>}} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{@r{char>}} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{{char<=}} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{@r{char<=}} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{{char>=}} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{@r{char>=}} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{char-equal} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{char-equal} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{char-not-equal} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{char-not-equal} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{char-lessp} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{char-lessp} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{char-greaterp} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{char-greaterp} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{char-not-greaterp} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{char-not-greaterp} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + +-@code{char-not-lessp} @i{{&rest} characters^+} @result{} @i{generalized-boolean} ++@code{char-not-lessp} @i{@r{&rest} characters^+} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -1048,7 +1052,7 @@ + @node digit-char, digit-char-p, alphanumericp, Characters Dictionary + @subsection digit-char [Function] + +-@code{digit-char} @i{weight {&optional} radix} @result{} @i{char} ++@code{digit-char} @i{weight @r{&optional} radix} @result{} @i{char} + + @subsubheading Arguments and Values:: + +@@ -1096,7 +1100,7 @@ + @node digit-char-p, graphic-char-p, digit-char, Characters Dictionary + @subsection digit-char-p [Function] + +-@code{digit-char-p} @i{char {&optional} radix} @result{} @i{weight} ++@code{digit-char-p} @i{char @r{&optional} radix} @result{} @i{weight} + + @subsubheading Arguments and Values:: + +@@ -1182,7 +1186,7 @@ + + @subsubheading See Also:: + +-@ref{read; read-preserving-whitespace} ++@ref{read} + , + @ref{Character Syntax}, + @ref{Documentation of Implementation-Defined Scripts} +@@ -1275,7 +1279,7 @@ + + @subsubheading See Also:: + +-@ref{upper-case-p; lower-case-p; both-case-p} ++@ref{upper-case-p} + , + @ref{alpha-char-p} + , +@@ -1340,7 +1344,7 @@ + + @subsubheading See Also:: + +-@ref{char-upcase; char-downcase} ++@ref{char-upcase} + , + @b{char-downcase}, + @ref{Characters With Case}, +diff -uNr gcl-texi-orig/chap-14.texi gcl-texi/chap-14.texi +--- gcl-texi-orig/chap-14.texi 1994-07-16 18:03:10 +0400 ++++ gcl-texi/chap-14.texi 2002-10-17 20:53:05 +0400 +@@ -18,6 +18,7 @@ + is a compound data @i{object} + having two components called the @i{car} and the @i{cdr}. + ++@format + @group + @noindent + @w{ car cons rplacd } +@@ -27,6 +28,7 @@ + @w{ Figure 14--1: Some defined names relating to conses.} + + @end group ++@end format + + Depending on context, a group of connected @i{conses} can be viewed + in a variety of different ways. A variety of operations is provided to +@@ -52,6 +54,7 @@ + Typically, the @i{leaves} represent data while the branches + establish some relationship among that data. + ++@format + @group + @noindent + @w{ caaaar caddar cdar nsubst } +@@ -69,6 +72,7 @@ + @w{ Figure 14--2: Some defined names relating to trees.} + + @end group ++@end format + + @menu + * General Restrictions on Parameters that must be Trees:: +@@ -114,6 +118,7 @@ + is a chain of @i{conses} that has no termination + because some @i{cons} in the chain is the @i{cdr} of a later @i{cons}. + ++@format + @group + @noindent + @w{ append last nbutlast rest } +@@ -130,6 +135,7 @@ + @w{ Figure 14--3: Some defined names relating to lists.} + + @end group ++@end format + + @menu + * Lists as Association Lists:: +@@ -147,6 +153,7 @@ + where the @i{car} of each @i{cons} is the @i{key} + and the @i{cdr} is the @i{value} associated with that @i{key}. + ++@format + @group + @noindent + @w{ acons assoc-if pairlis rassoc-if } +@@ -156,6 +163,7 @@ + @w{ Figure 14--4: Some defined names related to assocation lists.} + + @end group ++@end format + + @node Lists as Sets, General Restrictions on Parameters that must be Lists, Lists as Association Lists, Conses as Lists + @subsubsection Lists as Sets +@@ -163,6 +171,7 @@ + @i{Lists} are sometimes viewed as sets by considering their elements + unordered and by assuming there is no duplication of elements. + ++@format + @group + @noindent + @w{ adjoin nset-difference set-difference union } +@@ -173,6 +182,7 @@ + @w{ Figure 14--5: Some defined names related to sets. } + + @end group ++@end format + + @node General Restrictions on Parameters that must be Lists, , Lists as Sets, Conses as Lists + @subsubsection General Restrictions on Parameters that must be Lists +@@ -196,7 +206,7 @@ + @c including dict-conses + + @menu +-* list:: ++* list (System Class):: + * null (System Class):: + * cons (System Class):: + * atom (Type):: +@@ -210,7 +220,7 @@ + * subst:: + * tree-equal:: + * copy-list:: +-* list:: ++* list (Function):: + * list-length:: + * listp:: + * make-list:: +@@ -228,7 +238,7 @@ + * ldiff:: + * nthcdr:: + * rest:: +-* member:: ++* member (Function):: + * mapc:: + * acons:: + * assoc:: +@@ -247,7 +257,7 @@ + * union:: + @end menu + +-@node list, null (System Class), Conses Dictionary, Conses Dictionary ++@node list (System Class), null (System Class), Conses Dictionary, Conses Dictionary + @subsection list [System Class] + + @subsubheading Class Precedence List:: +@@ -296,7 +306,7 @@ + @ref{Left-Parenthesis}, + @ref{Printing Lists and Conses} + +-@node null (System Class), cons (System Class), list, Conses Dictionary ++@node null (System Class), cons (System Class), list (System Class), Conses Dictionary + @subsection null [System Class] + + @subsubheading Class Precedence List:: +@@ -408,7 +418,7 @@ + + @subsubheading See Also:: + +-@ref{list} ++@ref{list (Function)} + + @subsubheading Notes:: + If @i{object-2} is a @i{list}, @b{cons} can be thought of as +@@ -677,6 +687,7 @@ + order in which the corresponding operations are performed. Figure 14--6 + defines the relationships precisely. + ++@format + @group + @noindent + @w{ This @i{place} ... Is equivalent to this @i{place} ... } +@@ -713,6 +724,7 @@ + @w{ Figure 14--6: CAR and CDR variants } + + @end group ++@end format + + @b{setf} can also be used with any of these functions to change an + existing component of @i{x}, but @b{setf} will not make new +@@ -749,9 +761,9 @@ + + @subsubheading See Also:: + +-@ref{rplaca; rplacd} ++@ref{rplaca} + , +-@ref{first; second; third; fourth; fifth; sixth; seventh; eighth; ninth; tenth} ++@ref{first} + , + @ref{rest} + +@@ -821,9 +833,9 @@ + @node sublis, subst, copy-tree, Conses Dictionary + @subsection sublis, nsublis [Function] + +-@code{sublis} @i{alist tree {&key} key test test-not} @result{} @i{new-tree} ++@code{sublis} @i{alist tree @r{&key} key test test-not} @result{} @i{new-tree} + +-@code{nsublis} @i{alist tree {&key} key test test-not} @result{} @i{new-tree} ++@code{nsublis} @i{alist tree @r{&key} key test test-not} @result{} @i{new-tree} + + @subsubheading Arguments and Values:: + +@@ -906,7 +918,7 @@ + + @subsubheading See Also:: + +-@ref{subst; subst-if; subst-if-not; nsubst; nsubst-if; nsubst-if-not} ++@ref{subst} + , + + @ref{Compiler Terminology}, +@@ -939,17 +951,17 @@ + @i{[Function]} + @end flushright + +-@code{subst} @i{new old tree {&key} key test test-not} @result{} @i{new-tree} ++@code{subst} @i{new old tree @r{&key} key test test-not} @result{} @i{new-tree} + +-@code{subst-if} @i{new predicate tree {&key} key} @result{} @i{new-tree} ++@code{subst-if} @i{new predicate tree @r{&key} key} @result{} @i{new-tree} + +-@code{subst-if-not} @i{new predicate tree {&key} key} @result{} @i{new-tree} ++@code{subst-if-not} @i{new predicate tree @r{&key} key} @result{} @i{new-tree} + +-@code{nsubst} @i{new old tree {&key} key test test-not} @result{} @i{new-tree} ++@code{nsubst} @i{new old tree @r{&key} key test test-not} @result{} @i{new-tree} + +-@code{nsubst-if} @i{new predicate tree {&key} key} @result{} @i{new-tree} ++@code{nsubst-if} @i{new predicate tree @r{&key} key} @result{} @i{new-tree} + +-@code{nsubst-if-not} @i{new predicate tree {&key} key} @result{} @i{new-tree} ++@code{nsubst-if-not} @i{new predicate tree @r{&key} key} @result{} @i{new-tree} + + @subsubheading Arguments and Values:: + +@@ -1048,7 +1060,7 @@ + + @subsubheading See Also:: + +-@ref{substitute; substitute-if; substitute-if-not; nsubstitute; nsubstitute-if; nsubstitute-if-not} ++@ref{substitute} + , + @b{nsubstitute}, + +@@ -1081,7 +1093,7 @@ + @node tree-equal, copy-list, subst, Conses Dictionary + @subsection tree-equal [Function] + +-@code{tree-equal} @i{tree-1 tree-2 {&key} test test-not} @result{} @i{generalized-boolean} ++@code{tree-equal} @i{tree-1 tree-2 @r{&key} test test-not} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -1148,7 +1160,7 @@ + + The @t{:test-not} parameter is deprecated. + +-@node copy-list, list, tree-equal, Conses Dictionary ++@node copy-list, list (Function), tree-equal, Conses Dictionary + @subsection copy-list [Function] + + @code{copy-list} @i{list} @result{} @i{copy} +@@ -1203,12 +1215,12 @@ + + The copy created is @b{equal} to @i{list}, but not @b{eq}. + +-@node list, list-length, copy-list, Conses Dictionary ++@node list (Function), list-length, copy-list, Conses Dictionary + @subsection list, list* [Function] + +-@code{list} @i{{&rest} objects} @result{} @i{list} ++@code{list} @i{@r{&rest} objects} @result{} @i{list} + +-@code{list*} @i{{&rest} objects^+} @result{} @i{result} ++@code{list*} @i{@r{&rest} objects^+} @result{} @i{result} + + @subsubheading Arguments and Values:: + +@@ -1266,7 +1278,7 @@ + (list* @i{x}) @equiv{} @i{x} + @end example + +-@node list-length, listp, list, Conses Dictionary ++@node list-length, listp, list (Function), Conses Dictionary + @subsection list-length [Function] + + @code{list-length} @i{list} @result{} @i{length} +@@ -1370,7 +1382,7 @@ + @node make-list, push, listp, Conses Dictionary + @subsection make-list [Function] + +-@code{make-list} @i{size {&key} initial-element} @result{} @i{list} ++@code{make-list} @i{size @r{&key} initial-element} @result{} @i{list} + + @subsubheading Arguments and Values:: + +@@ -1404,7 +1416,7 @@ + + @ref{cons} + , +-@ref{list} ++@ref{list (Function)} + + @node push, pop, make-list, Conses Dictionary + @subsection push [Macro] +@@ -1619,7 +1631,7 @@ + + @subsubheading See Also:: + +-@ref{car; cdr; caar; cadr; cdar; cddr; caaar; caadr; cadar; caddr; cdaar; cdadr; cddar; cdddr; caaaar; caaadr; caadar; caaddr; cadaar; cadadr; caddar; cadddr; cdaaar; cdaadr; cdadar; cdaddr; cddaar; cddadr; cdddar; cddddr} ++@ref{car} + , + @ref{nth} + +@@ -1690,7 +1702,7 @@ + + @ref{elt} + , +-@ref{first; second; third; fourth; fifth; sixth; seventh; eighth; ninth; tenth} ++@ref{first} + , + @ref{nthcdr} + +@@ -1787,7 +1799,7 @@ + @node nconc, append, null, Conses Dictionary + @subsection nconc [Function] + +-@code{nconc} @i{{&rest} lists} @result{} @i{concatenated-list} ++@code{nconc} @i{@r{&rest} lists} @result{} @i{concatenated-list} + + @subsubheading Arguments and Values:: + +@@ -1863,7 +1875,7 @@ + @node append, revappend, nconc, Conses Dictionary + @subsection append [Function] + +-@code{append} @i{{&rest} lists} @result{} @i{result} ++@code{append} @i{@r{&rest} lists} @result{} @i{result} + + @subsubheading Arguments and Values:: + +@@ -1975,7 +1987,7 @@ + + @subsubheading See Also:: + +-@ref{reverse; nreverse} ++@ref{reverse} + , + @b{nreverse}, + @ref{nconc} +@@ -1994,9 +2006,9 @@ + @node butlast, last, revappend, Conses Dictionary + @subsection butlast, nbutlast [Function] + +-@code{butlast} @i{list {&optional} n} @result{} @i{result-list} ++@code{butlast} @i{list @r{&optional} n} @result{} @i{result-list} + +-@code{nbutlast} @i{list {&optional} n} @result{} @i{result-list} ++@code{nbutlast} @i{list @r{&optional} n} @result{} @i{result-list} + + @subsubheading Arguments and Values:: + +@@ -2069,7 +2081,7 @@ + @node last, ldiff, butlast, Conses Dictionary + @subsection last [Function] + +-@code{last} @i{list {&optional} n} @result{} @i{tail} ++@code{last} @i{list @r{&optional} n} @result{} @i{tail} + + @subsubheading Arguments and Values:: + +@@ -2126,7 +2138,7 @@ + + @subsubheading See Also:: + +-@ref{butlast; nbutlast} ++@ref{butlast} + , + @ref{nth} + +@@ -2221,7 +2233,7 @@ + + @subsubheading See Also:: + +-@ref{set-difference; nset-difference} ++@ref{set-difference} + + @subsubheading Notes:: + +@@ -2307,7 +2319,7 @@ + , + @ref{rest} + +-@node rest, member, nthcdr, Conses Dictionary ++@node rest, member (Function), nthcdr, Conses Dictionary + @subsection rest [Accessor] + + @code{rest} @i{list} @result{} @i{tail} +@@ -2355,14 +2367,14 @@ + when the argument is to being subjectively viewed as a @i{list} + rather than as a @i{cons}. + +-@node member, mapc, rest, Conses Dictionary ++@node member (Function), mapc, rest, Conses Dictionary + @subsection member, member-if, member-if-not [Function] + +-@code{member} @i{item list {&key} key test test-not} @result{} @i{tail} ++@code{member} @i{item list @r{&key} key test test-not} @result{} @i{tail} + +-@code{member-if} @i{predicate list {&key} key} @result{} @i{tail} ++@code{member-if} @i{predicate list @r{&key} key} @result{} @i{tail} + +-@code{member-if-not} @i{predicate list {&key} key} @result{} @i{tail} ++@code{member-if-not} @i{predicate list @r{&key} key} @result{} @i{tail} + + @subsubheading Arguments and Values:: + +@@ -2422,9 +2434,9 @@ + + @subsubheading See Also:: + +-@ref{find; find-if; find-if-not} ++@ref{find} + , +-@ref{position; position-if; position-if-not} ++@ref{position} + , + + @ref{Traversal Rules and Side Effects} +@@ -2447,20 +2459,20 @@ + where @t{a} was found (assuming a check has been made that @b{member} + did not return @b{nil}). + +-@node mapc, acons, member, Conses Dictionary ++@node mapc, acons, member (Function), Conses Dictionary + @subsection mapc, mapcar, mapcan, mapl, maplist, mapcon [Function] + +-@code{mapc} @i{function {&rest} lists^+} @result{} @i{list-1} ++@code{mapc} @i{function @r{&rest} lists^+} @result{} @i{list-1} + +-@code{mapcar} @i{function {&rest} lists^+} @result{} @i{result-list} ++@code{mapcar} @i{function @r{&rest} lists^+} @result{} @i{result-list} + +-@code{mapcan} @i{function {&rest} lists^+} @result{} @i{concatenated-results} ++@code{mapcan} @i{function @r{&rest} lists^+} @result{} @i{concatenated-results} + +-@code{mapl} @i{function {&rest} lists^+} @result{} @i{list-1} ++@code{mapl} @i{function @r{&rest} lists^+} @result{} @i{list-1} + +-@code{maplist} @i{function {&rest} lists^+} @result{} @i{result-list} ++@code{maplist} @i{function @r{&rest} lists^+} @result{} @i{result-list} + +-@code{mapcon} @i{function {&rest} lists^+} @result{} @i{concatenated-results} ++@code{mapcon} @i{function @r{&rest} lists^+} @result{} @i{concatenated-results} + + @subsubheading Arguments and Values:: + +@@ -2627,7 +2639,7 @@ + + @subsubheading See Also:: + +-@ref{assoc; assoc-if; assoc-if-not} ++@ref{assoc} + , + @ref{pairlis} + +@@ -2640,11 +2652,11 @@ + @node assoc, copy-alist, acons, Conses Dictionary + @subsection assoc, assoc-if, assoc-if-not [Function] + +-@code{assoc} @i{item alist {&key} key test test-not} @result{} @i{entry} ++@code{assoc} @i{item alist @r{&key} key test test-not} @result{} @i{entry} + +-@code{assoc-if} @i{predicate alist {&key} key} @result{} @i{entry} ++@code{assoc-if} @i{predicate alist @r{&key} key} @result{} @i{entry} + +-@code{assoc-if-not} @i{predicate alist {&key} key} @result{} @i{entry} ++@code{assoc-if-not} @i{predicate alist @r{&key} key} @result{} @i{entry} + + @subsubheading Arguments and Values:: + +@@ -2711,13 +2723,13 @@ + + @subsubheading See Also:: + +-@ref{rassoc; rassoc-if; rassoc-if-not} ++@ref{rassoc} + , +-@ref{find; find-if; find-if-not} ++@ref{find} + , +-@ref{member; member-if; member-if-not} ++@ref{member (Function)} + , +-@ref{position; position-if; position-if-not} ++@ref{position} + , + + @ref{Traversal Rules and Side Effects} +@@ -2798,7 +2810,7 @@ + @node pairlis, rassoc, copy-alist, Conses Dictionary + @subsection pairlis [Function] + +-@code{pairlis} @i{keys data {&optional} alist} @result{} @i{new-alist} ++@code{pairlis} @i{keys data @r{&optional} alist} @result{} @i{new-alist} + + @subsubheading Arguments and Values:: + +@@ -2864,11 +2876,11 @@ + @node rassoc, get-properties, pairlis, Conses Dictionary + @subsection rassoc, rassoc-if, rassoc-if-not [Function] + +-@code{rassoc} @i{item alist {&key} key test test-not} @result{} @i{entry} ++@code{rassoc} @i{item alist @r{&key} key test test-not} @result{} @i{entry} + +-@code{rassoc-if} @i{predicate alist {&key} key} @result{} @i{entry} ++@code{rassoc-if} @i{predicate alist @r{&key} key} @result{} @i{entry} + +-@code{rassoc-if-not} @i{predicate alist {&key} key} @result{} @i{entry} ++@code{rassoc-if-not} @i{predicate alist @r{&key} key} @result{} @i{entry} + + @subsubheading Arguments and Values:: + +@@ -2919,7 +2931,7 @@ + + @subsubheading See Also:: + +-@ref{assoc; assoc-if; assoc-if-not} ++@ref{assoc} + , + + @ref{Traversal Rules and Side Effects} +@@ -3001,9 +3013,9 @@ + @node getf, remf, get-properties, Conses Dictionary + @subsection getf [Accessor] + +-@code{getf} @i{plist indicator {&optional} default} @result{} @i{value} ++@code{getf} @i{plist indicator @r{&optional} default} @result{} @i{value} + +-(setf (@code{ getf} @i{place indicator {&optional} default}) new-value)@* ++(setf (@code{ getf} @i{place indicator @r{&optional} default}) new-value)@* + + @subsubheading Arguments and Values:: + +@@ -3081,7 +3093,7 @@ + , + @ref{get-properties} + , +-@ref{setf; psetf} ++@ref{setf} + , + @ref{Function Call Forms as Places} + +@@ -3163,9 +3175,9 @@ + @node intersection, adjoin, remf, Conses Dictionary + @subsection intersection, nintersection [Function] + +-@code{intersection} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{intersection} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + +-@code{nintersection} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{nintersection} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + + @subsubheading Arguments and Values:: + +@@ -3266,7 +3278,7 @@ + + @subsubheading See Also:: + +-@ref{union; nunion} ++@ref{union} + , + + @ref{Compiler Terminology}, +@@ -3284,7 +3296,7 @@ + @node adjoin, pushnew, intersection, Conses Dictionary + @subsection adjoin [Function] + +-@code{adjoin} @i{item list {&key} key test test-not} @result{} @i{new-list} ++@code{adjoin} @i{item list @r{&key} key test test-not} @result{} @i{new-list} + + @subsubheading Arguments and Values:: + +@@ -3355,7 +3367,7 @@ + @node pushnew, set-difference, adjoin, Conses Dictionary + @subsection pushnew [Macro] + +-@code{pushnew} @i{item place {&key} key test test-not}@* ++@code{pushnew} @i{item place @r{&key} key test test-not}@* + @result{} @i{new-place-value} + + @subsubheading Arguments and Values:: +@@ -3455,9 +3467,9 @@ + @node set-difference, set-exclusive-or, pushnew, Conses Dictionary + @subsection set-difference, nset-difference [Function] + +-@code{set-difference} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{set-difference} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + +-@code{nset-difference} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{nset-difference} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + + @subsubheading Arguments and Values:: + +@@ -3564,9 +3576,9 @@ + @node set-exclusive-or, subsetp, set-difference, Conses Dictionary + @subsection set-exclusive-or, nset-exclusive-or [Function] + +-@code{set-exclusive-or} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{set-exclusive-or} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + +-@code{nset-exclusive-or} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{nset-exclusive-or} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + + @subsubheading Arguments and Values:: + +@@ -3660,7 +3672,7 @@ + @node subsetp, union, set-exclusive-or, Conses Dictionary + @subsection subsetp [Function] + +-@code{subsetp} @i{list-1 list-2 {&key} key test test-not} @result{} @i{generalized-boolean} ++@code{subsetp} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -3732,9 +3744,9 @@ + @node union, , subsetp, Conses Dictionary + @subsection union, nunion [Function] + +-@code{union} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{union} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + +-@code{nunion} @i{list-1 list-2 {&key} key test test-not} @result{} @i{result-list} ++@code{nunion} @i{list-1 list-2 @r{&key} key test test-not} @result{} @i{result-list} + + @subsubheading Arguments and Values:: + +@@ -3827,7 +3839,7 @@ + + @subsubheading See Also:: + +-@ref{intersection; nintersection} ++@ref{intersection} + , + + @ref{Compiler Terminology}, +diff -uNr gcl-texi-orig/chap-15.texi gcl-texi/chap-15.texi +--- gcl-texi-orig/chap-15.texi 1994-07-16 18:03:09 +0400 ++++ gcl-texi/chap-15.texi 2002-10-17 20:53:05 +0400 +@@ -148,6 +148,7 @@ + Figure 15--1 lists some @i{defined names} that are applicable to @i{array} + creation, @i{access}, and information operations. + ++@format + @group + @noindent + @w{ adjust-array array-in-bounds-p svref } +@@ -163,6 +164,7 @@ + @w{ Figure 15--1: General Purpose Array-Related Defined Names } + + @end group ++@end format + + @menu + * Array Upgrading:: +@@ -227,6 +229,7 @@ + most information about @i{strings} does not appear in this chapter; + see instead @ref{Strings}. + ++@format + @group + @noindent + @w{ char string-equal string-upcase } +@@ -243,6 +246,7 @@ + @w{ Figure 15--2: Operators that Manipulate Strings } + + @end group ++@end format + + @i{Vectors} whose @i{elements} are restricted to @i{type} + @b{bit} are called @i{bit vectors} +@@ -251,6 +255,7 @@ + @i{Bit vectors} are of @i{type} @b{bit-vector}. + Figure 15--3 lists some @i{defined names} for operations on @i{bit arrays}. + ++@format + @group + @noindent + @w{ bit bit-ior bit-orc2 } +@@ -263,6 +268,7 @@ + @w{ Figure 15--3: Operators that Manipulate Bit Arrays} + + @end group ++@end format + + @c end of including concept-arrays + +@@ -304,7 +310,7 @@ + * vector-pop:: + * vector-push:: + * vectorp:: +-* bit:: ++* bit (Array):: + * bit-and:: + * bit-vector-p:: + * simple-bit-vector-p:: +@@ -347,7 +353,7 @@ + + (@code{array}@{@i{@t{[}@{element-type | @b{*}@} @r{[}dimension-spec@r{]}@t{]}}@}) + +-@w{@i{dimension-spec} ::=rank | @b{*} | @r{(}@{dimension | @b{*}@}{*}@r{)}} ++@w{@i{dimension-spec} ::=rank | @b{*} | @r{(}@{dimension | @b{*}@}*@r{)}} + + @subsubheading Compound Type Specifier Arguments:: + +@@ -451,7 +457,7 @@ + + (@code{simple-array}@{@i{@t{[}@{element-type | @b{*}@} @r{[}dimension-spec@r{]}@t{]}}@}) + +-@w{@i{dimension-spec} ::=rank | @b{*} | @r{(}@{dimension | @b{*}@}{*}@r{)}} ++@w{@i{dimension-spec} ::=rank | @b{*} | @r{(}@{dimension | @b{*}@}*@r{)}} + + @subsubheading Compound Type Specifier Arguments:: + +@@ -506,7 +512,7 @@ + + @subsubheading Compound Type Specifier Syntax:: + +-(@code{vector}@{@i{@t{[}@{element-type | @b{*}@} @r{[}@{size | @b{*}@}{]}@t{]}}@}) ++(@code{vector}@{@i{@t{[}@{element-type | @b{*}@} @r{[}@{size | @b{*}@}@r{]}@t{]}}@}) + + @subsubheading Compound Type Specifier Arguments:: + +@@ -684,7 +690,7 @@ + @node make-array, adjust-array, simple-bit-vector, Arrays Dictionary + @subsection make-array [Function] + +-@code{make-array} @i{dimensions {&key} element-type ++@code{make-array} @i{dimensions @r{&key} element-type + initial-element + initial-contents + adjustable +@@ -946,7 +952,7 @@ + @node adjust-array, adjustable-array-p, make-array, Arrays Dictionary + @subsection adjust-array [Function] + +-@code{adjust-array} @i{array new-dimensions {&key} element-type ++@code{adjust-array} @i{array new-dimensions @r{&key} element-type + initial-element + initial-contents + fill-pointer +@@ -1240,9 +1246,9 @@ + @node aref, array-dimension, adjustable-array-p, Arrays Dictionary + @subsection aref [Accessor] + +-@code{aref} @i{array {&rest} subscripts} @result{} @i{element} ++@code{aref} @i{array @r{&rest} subscripts} @result{} @i{element} + +-(setf (@code{ aref} @i{array {&rest} subscripts}) new-element)@* ++(setf (@code{ aref} @i{array @r{&rest} subscripts}) new-element)@* + + @subsubheading Arguments and Values:: + +@@ -1288,9 +1294,9 @@ + + @subsubheading See Also:: + +-@ref{bit} ++@ref{bit (Array)} + , +-@ref{char; schar} ++@ref{char} + , + @ref{elt} + , +@@ -1529,7 +1535,7 @@ + @node array-in-bounds-p, array-rank, array-displacement, Arrays Dictionary + @subsection array-in-bounds-p [Function] + +-@code{array-in-bounds-p} @i{array {&rest} subscripts} @result{} @i{generalized-boolean} ++@code{array-in-bounds-p} @i{array @r{&rest} subscripts} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -1605,7 +1611,7 @@ + @node array-row-major-index, array-total-size, array-rank, Arrays Dictionary + @subsection array-row-major-index [Function] + +-@code{array-row-major-index} @i{array {&rest} subscripts} @result{} @i{index} ++@code{array-row-major-index} @i{array @r{&rest} subscripts} @result{} @i{index} + + @subsubheading Arguments and Values:: + +@@ -1832,7 +1838,7 @@ + @node upgraded-array-element-type, array-dimension-limit, row-major-aref, Arrays Dictionary + @subsection upgraded-array-element-type [Function] + +-@code{upgraded-array-element-type} @i{typespec {&optional} environment} @result{} @i{upgraded-typespec} ++@code{upgraded-array-element-type} @i{typespec @r{&optional} environment} @result{} @i{upgraded-typespec} + + @subsubheading Arguments and Values:: + +@@ -2042,7 +2048,7 @@ + @node vector, vector-pop, svref, Arrays Dictionary + @subsection vector [Function] + +-@code{vector} @i{{&rest} objects} @result{} @i{vector} ++@code{vector} @i{@r{&rest} objects} @result{} @i{vector} + + @subsubheading Arguments and Values:: + +@@ -2075,10 +2081,10 @@ + @b{vector} is analogous to @b{list}. + + @example +- (vector a{{}_1} a{{}_2} ... a{{}_n}) ++ (vector a_1 a_2 ... a_n) + @equiv{} (make-array (list @i{n}) :element-type t + :initial-contents +- (list a{{}_1} a{{}_2} ... a{{}_n})) ++ (list a_1 a_2 ... a_n)) + @end example + + @node vector-pop, vector-push, vector, Arrays Dictionary +@@ -2127,7 +2133,7 @@ + + @subsubheading See Also:: + +-@ref{vector-push; vector-push-extend} ++@ref{vector-push} + , @b{vector-push-extend}, + @ref{fill-pointer} + +@@ -2136,7 +2142,7 @@ + + @code{vector-push} @i{new-element vector} @result{} @i{new-index-p} + +-@code{vector-push-extend} @i{new-element vector {&optional} extension} @result{} @i{new-index} ++@code{vector-push-extend} @i{new-element vector @r{&optional} extension} @result{} @i{new-index} + + @subsubheading Arguments and Values:: + +@@ -2221,7 +2227,7 @@ + , + @ref{vector-pop} + +-@node vectorp, bit, vector-push, Arrays Dictionary ++@node vectorp, bit (Array), vector-push, Arrays Dictionary + @subsection vectorp [Function] + + @code{vectorp} @i{object} @result{} @i{generalized-boolean} +@@ -2252,14 +2258,14 @@ + (vectorp @i{object}) @equiv{} (typep @i{object} 'vector) + @end example + +-@node bit, bit-and, vectorp, Arrays Dictionary ++@node bit (Array), bit-and, vectorp, Arrays Dictionary + @subsection bit, sbit [Accessor] + +-@code{bit} @i{bit-array {&rest} subscripts} @result{} @i{bit} ++@code{bit} @i{bit-array @r{&rest} subscripts} @result{} @i{bit} + +-@code{sbit} @i{bit-array {&rest} subscripts} @result{} @i{bit} ++@code{sbit} @i{bit-array @r{&rest} subscripts} @result{} @i{bit} + +-(setf (@code{bit} @i{bit-array {&rest} subscripts}) new-bit)@*(setf (@code{sbit} @i{bit-array {&rest} subscripts}) new-bit)@* ++(setf (@code{bit} @i{bit-array @r{&rest} subscripts}) new-bit)@*(setf (@code{sbit} @i{bit-array @r{&rest} subscripts}) new-bit)@* + + @subsubheading Arguments and Values:: + +@@ -2308,34 +2314,34 @@ + @b{bit} and @b{sbit}, unlike @b{char} and @b{schar}, + allow the first argument to be an @i{array} of any @i{rank}. + +-@node bit-and, bit-vector-p, bit, Arrays Dictionary ++@node bit-and, bit-vector-p, bit (Array), Arrays Dictionary + @subsection bit-and, bit-andc1, bit-andc2, bit-eqv, + @subheading bit-ior, bit-nand, bit-nor, bit-not, bit-orc1, bit-orc2, bit-xor + @flushright + @i{[Function]} + @end flushright + +-@code{bit-and} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-and} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-andc1} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-andc1} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-andc2} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-andc2} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-eqv} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-eqv} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-ior} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-ior} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-nand} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-nand} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-nor} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-nor} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-orc1} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-orc1} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-orc2} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-orc2} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-xor} @i{bit-array1 bit-array2 {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-xor} @i{bit-array1 bit-array2 @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + +-@code{bit-not} @i{bit-array {&optional} opt-arg} @result{} @i{resulting-bit-array} ++@code{bit-not} @i{bit-array @r{&optional} opt-arg} @result{} @i{resulting-bit-array} + + @subsubheading Arguments and Values:: + +@@ -2374,6 +2380,7 @@ + performed by each of the @i{functions}. + + 2 ++@format + @group + @noindent + @w{@b{Function} @b{Operation} } +@@ -2393,6 +2400,7 @@ + @w{@w{ Figure 15--3: Bit-wise Logical Operations on Bit Arrays} + } + @end group ++@end format + + @subsubheading Examples:: + @example +@@ -2413,7 +2421,7 @@ + @subsubheading See Also:: + + @b{lognot}, +-@ref{logand; logandc1; logandc2; logeqv; logior; lognand; lognor; lognot; logorc1; logorc2; logxor} ++@ref{logand} + + @node bit-vector-p, simple-bit-vector-p, bit-and, Arrays Dictionary + @subsection bit-vector-p [Function] +diff -uNr gcl-texi-orig/chap-16.texi gcl-texi/chap-16.texi +--- gcl-texi-orig/chap-16.texi 1994-07-16 18:03:08 +0400 ++++ gcl-texi/chap-16.texi 2002-10-17 20:53:05 +0400 +@@ -378,17 +378,17 @@ + @i{[Function]} + @end flushright + +-@code{string-upcase} @i{string {&key} start end} @result{} @i{cased-string} ++@code{string-upcase} @i{string @r{&key} start end} @result{} @i{cased-string} + +-@code{string-downcase} @i{string {&key} start end} @result{} @i{cased-string} ++@code{string-downcase} @i{string @r{&key} start end} @result{} @i{cased-string} + +-@code{string-capitalize} @i{string {&key} start end} @result{} @i{cased-string} ++@code{string-capitalize} @i{string @r{&key} start end} @result{} @i{cased-string} + +-@code{nstring-upcase} @i{string {&key} start end} @result{} @i{string} ++@code{nstring-upcase} @i{string @r{&key} start end} @result{} @i{string} + +-@code{nstring-downcase} @i{string {&key} start end} @result{} @i{string} ++@code{nstring-downcase} @i{string @r{&key} start end} @result{} @i{string} + +-@code{nstring-capitalize} @i{string {&key} start end} @result{} @i{string} ++@code{nstring-capitalize} @i{string @r{&key} start end} @result{} @i{string} + + @subsubheading Arguments and Values:: + +@@ -480,7 +480,7 @@ + + @subsubheading See Also:: + +-@ref{char-upcase; char-downcase} ++@ref{char-upcase} + , @b{char-downcase} + + @subsubheading Notes:: +@@ -545,29 +545,29 @@ + @i{[Function]} + @end flushright + +-@code{string=} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{generalized-boolean} ++@code{string=} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{generalized-boolean} + +-@code{string/=} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string/=} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string<} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string<} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string>} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string>} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string<=} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string<=} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string>=} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string>=} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string-equal} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{generalized-boolean} ++@code{string-equal} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{generalized-boolean} + +-@code{string-not-equal} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string-not-equal} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string-lessp} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string-lessp} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string-greaterp} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string-greaterp} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string-not-greaterp} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string-not-greaterp} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + +-@code{string-not-lessp} @i{string1 string2 {&key} start1 end1 start2 end2} @result{} @i{mismatch-index} ++@code{string-not-lessp} @i{string1 string2 @r{&key} start1 end1 start2 end2} @result{} @i{mismatch-index} + + @subsubheading Arguments and Values:: + +@@ -684,7 +684,7 @@ + + @subsubheading See Also:: + +-@ref{char=; char/=; char<; char>; char<=; char>=; char-equal; char-not-equal; char-lessp; char-greaterp; char-not-greaterp; char-not-lessp} ++@ref{char=} + + @subsubheading Notes:: + +@@ -728,7 +728,7 @@ + @node make-string, , stringp, Strings Dictionary + @subsection make-string [Function] + +-@code{make-string} @i{size {&key} initial-element element-type} @result{} @i{string} ++@code{make-string} @i{size @r{&key} initial-element element-type} @result{} @i{string} + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/chap-17.texi gcl-texi/chap-17.texi +--- gcl-texi-orig/chap-17.texi 1994-07-16 18:03:08 +0400 ++++ gcl-texi/chap-17.texi 2002-10-17 20:53:05 +0400 +@@ -34,6 +34,7 @@ + a new @i{vector}, it always returns a @i{simple vector}. + Similarly, any @i{strings} constructed will be @i{simple strings}. + ++@format + @group + @noindent + @w{ concatenate length remove } +@@ -56,6 +57,7 @@ + @w{ Figure 17--1: Standardized Sequence Functions } + + @end group ++@end format + + @menu + * General Restrictions on Parameters that must be Sequences:: +@@ -91,6 +93,7 @@ + This control is offered on the basis of a @i{function} designated with + either a @t{:test} or @t{:test-not} @i{argument}. + ++@format + @group + @noindent + @w{ adjoin nset-exclusive-or search } +@@ -108,6 +111,7 @@ + @w{ Figure 17--2: Operators that have Two-Argument Tests to be Satisfied} + + @end group ++@end format + + The object O might not be compared directly to E_i. + If a @t{:key} @i{argument} is provided, +@@ -193,6 +197,7 @@ + as with the @i{functions} described in @ref{Satisfying a Two-Argument Test}, + but rather on the basis of a one @i{argument} @i{predicate}. + ++@format + @group + @noindent + @w{ assoc-if member-if rassoc-if } +@@ -208,6 +213,7 @@ + @w{ Figure 17--3: Operators that have One-Argument Tests to be Satisfied} + + @end group ++@end format + + The element E_i might not be considered directly. + If a @t{:key} @i{argument} is provided, +@@ -409,7 +415,7 @@ + @node fill, make-sequence, elt, Sequences Dictionary + @subsection fill [Function] + +-@code{fill} @i{sequence item {&key} start end} @result{} @i{sequence} ++@code{fill} @i{sequence item @r{&key} start end} @result{} @i{sequence} + + @subsubheading Arguments and Values:: + +@@ -464,7 +470,7 @@ + @node make-sequence, subseq, fill, Sequences Dictionary + @subsection make-sequence [Function] + +-@code{make-sequence} @i{result-type size {&key} initial-element} @result{} @i{sequence} ++@code{make-sequence} @i{result-type size @r{&key} initial-element} @result{} @i{sequence} + + @subsubheading Arguments and Values:: + +@@ -540,9 +546,9 @@ + @node subseq, map, make-sequence, Sequences Dictionary + @subsection subseq [Accessor] + +-@code{subseq} @i{sequence start {&optional} end} @result{} @i{subsequence} ++@code{subseq} @i{sequence start @r{&optional} end} @result{} @i{subsequence} + +-(setf (@code{ subseq} @i{sequence start {&optional} end}) new-subsequence)@* ++(setf (@code{ subseq} @i{sequence start @r{&optional} end}) new-subsequence)@* + + @subsubheading Arguments and Values:: + +@@ -610,7 +616,7 @@ + @node map, map-into, subseq, Sequences Dictionary + @subsection map [Function] + +-@code{map} @i{result-type function {&rest} sequences^+} @result{} @i{result} ++@code{map} @i{result-type function @r{&rest} sequences^+} @result{} @i{result} + + @subsubheading Arguments and Values:: + +@@ -698,7 +704,7 @@ + @node map-into, reduce, map, Sequences Dictionary + @subsection map-into [Function] + +-@code{map-into} @i{result-sequence function {&rest} sequences} @result{} @i{result-sequence} ++@code{map-into} @i{result-sequence function @r{&rest} sequences} @result{} @i{result-sequence} + + @subsubheading Arguments and Values:: + +@@ -778,7 +784,7 @@ + @node reduce, count, map-into, Sequences Dictionary + @subsection reduce [Function] + +-@code{reduce} @i{function sequence {&key} key from-end start end initial-value} @result{} @i{result} ++@code{reduce} @i{function sequence @r{&key} key from-end start end initial-value} @result{} @i{result} + + @subsubheading Arguments and Values:: + +@@ -871,11 +877,11 @@ + @node count, length, reduce, Sequences Dictionary + @subsection count, count-if, count-if-not [Function] + +-@code{count} @i{item sequence {&key} from-end start end key test test-not} @result{} @i{n} ++@code{count} @i{item sequence @r{&key} from-end start end key test test-not} @result{} @i{n} + +-@code{count-if} @i{predicate sequence {&key} from-end start end key} @result{} @i{n} ++@code{count-if} @i{predicate sequence @r{&key} from-end start end key} @result{} @i{n} + +-@code{count-if-not} @i{predicate sequence {&key} from-end start end key} @result{} @i{n} ++@code{count-if-not} @i{predicate sequence @r{&key} from-end start end key} @result{} @i{n} + + @subsubheading Arguments and Values:: + +@@ -1058,9 +1064,9 @@ + @node sort, find, reverse, Sequences Dictionary + @subsection sort, stable-sort [Function] + +-@code{sort} @i{sequence predicate {&key} key} @result{} @i{sorted-sequence} ++@code{sort} @i{sequence predicate @r{&key} key} @result{} @i{sorted-sequence} + +-@code{stable-sort} @i{sequence predicate {&key} key} @result{} @i{sorted-sequence} ++@code{stable-sort} @i{sequence predicate @r{&key} key} @result{} @i{sorted-sequence} + + @subsubheading Arguments and Values:: + +@@ -1198,11 +1204,11 @@ + @node find, position, sort, Sequences Dictionary + @subsection find, find-if, find-if-not [Function] + +-@code{find} @i{item sequence {&key} from-end test test-not start end key} @result{} @i{element} ++@code{find} @i{item sequence @r{&key} from-end test test-not start end key} @result{} @i{element} + +-@code{find-if} @i{predicate sequence {&key} from-end start end key} @result{} @i{element} ++@code{find-if} @i{predicate sequence @r{&key} from-end start end key} @result{} @i{element} + +-@code{find-if-not} @i{predicate sequence {&key} from-end start end key} @result{} @i{element} ++@code{find-if-not} @i{predicate sequence @r{&key} from-end start end key} @result{} @i{element} + + @subsubheading Arguments and Values:: + +@@ -1267,7 +1273,7 @@ + + @subsubheading See Also:: + +-@ref{position; position-if; position-if-not} ++@ref{position} + , + @ref{Rules about Test Functions}, + +@@ -1282,11 +1288,11 @@ + @node position, search, find, Sequences Dictionary + @subsection position, position-if, position-if-not [Function] + +-@code{position} @i{item sequence {&key} from-end test test-not start end key} @result{} @i{position} ++@code{position} @i{item sequence @r{&key} from-end test test-not start end key} @result{} @i{position} + +-@code{position-if} @i{predicate sequence {&key} from-end start end key} @result{} @i{position} ++@code{position-if} @i{predicate sequence @r{&key} from-end start end key} @result{} @i{position} + +-@code{position-if-not} @i{predicate sequence {&key} from-end start end key} @result{} @i{position} ++@code{position-if-not} @i{predicate sequence @r{&key} from-end start end key} @result{} @i{position} + + @subsubheading Arguments and Values:: + +@@ -1344,7 +1350,7 @@ + + @subsubheading See Also:: + +-@ref{find; find-if; find-if-not} ++@ref{find} + , + + @ref{Traversal Rules and Side Effects} +@@ -1359,7 +1365,7 @@ + @subsection search [Function] + + @code{search} @i{sequence-1 sequence-2 +- {&key} from-end test test-not ++ @r{&key} from-end test test-not + key start1 start2 + end1 end2}@* + @result{} @i{position} +@@ -1430,7 +1436,7 @@ + @subsection mismatch [Function] + + @code{mismatch} @i{sequence-1 sequence-2 +- {&key} from-end test test-not key start1 start2 end1 end2}@* ++ @r{&key} from-end test test-not key start1 start2 end1 end2}@* + @result{} @i{position} + + @subsubheading Arguments and Values:: +@@ -1506,7 +1512,7 @@ + @node replace, substitute, mismatch, Sequences Dictionary + @subsection replace [Function] + +-@code{replace} @i{sequence-1 sequence-2 {&key} start1 end1 start2 end2} @result{} @i{sequence-1} ++@code{replace} @i{sequence-1 sequence-2 @r{&key} start1 end1 start2 end2} @result{} @i{sequence-1} + + @subsubheading Arguments and Values:: + +@@ -1582,25 +1588,25 @@ + @end flushright + + @code{substitute} @i{newitem olditem sequence +- {&key} from-end test ++ @r{&key} from-end test + test-not start + end count key}@* + @result{} @i{result-sequence} + +-@code{substitute-if} @i{newitem predicate sequence {&key} from-end start end count key}@* ++@code{substitute-if} @i{newitem predicate sequence @r{&key} from-end start end count key}@* + @result{} @i{result-sequence} + +-@code{substitute-if-not} @i{newitem predicate sequence {&key} from-end start end count key}@* ++@code{substitute-if-not} @i{newitem predicate sequence @r{&key} from-end start end count key}@* + @result{} @i{result-sequence} + + @code{nsubstitute} @i{newitem olditem sequence +- {&key} from-end test test-not start end count key}@* ++ @r{&key} from-end test test-not start end count key}@* + @result{} @i{sequence} + +-@code{nsubstitute-if} @i{newitem predicate sequence {&key} from-end start end count key}@* ++@code{nsubstitute-if} @i{newitem predicate sequence @r{&key} from-end start end count key}@* + @result{} @i{sequence} + +-@code{nsubstitute-if-not} @i{newitem predicate sequence {&key} from-end start end count key}@* ++@code{nsubstitute-if-not} @i{newitem predicate sequence @r{&key} from-end start end count key}@* + @result{} @i{sequence} + + @subsubheading Arguments and Values:: +@@ -1734,7 +1740,7 @@ + + @subsubheading See Also:: + +-@ref{subst; subst-if; subst-if-not; nsubst; nsubst-if; nsubst-if-not} ++@ref{subst} + , + @b{nsubst}, + +@@ -1770,7 +1776,7 @@ + @node concatenate, merge, substitute, Sequences Dictionary + @subsection concatenate [Function] + +-@code{concatenate} @i{result-type {&rest} sequences} @result{} @i{result-sequence} ++@code{concatenate} @i{result-type @r{&rest} sequences} @result{} @i{result-sequence} + + @subsubheading Arguments and Values:: + +@@ -1841,7 +1847,7 @@ + @node merge, remove, concatenate, Sequences Dictionary + @subsection merge [Function] + +-@code{merge} @i{result-type sequence-1 sequence-2 predicate {&key} key} @result{} @i{result-sequence} ++@code{merge} @i{result-type sequence-1 sequence-2 predicate @r{&key} key} @result{} @i{result-sequence} + + @subsubheading Arguments and Values:: + +@@ -1949,7 +1955,7 @@ + + @subsubheading See Also:: + +-@ref{sort; stable-sort} ++@ref{sort} + , + @b{stable-sort}, + +@@ -1964,17 +1970,17 @@ + @i{[Function]} + @end flushright + +-@code{remove} @i{item sequence {&key} from-end test test-not start end count key} @result{} @i{result-sequence} ++@code{remove} @i{item sequence @r{&key} from-end test test-not start end count key} @result{} @i{result-sequence} + +-@code{remove-if} @i{test sequence {&key} from-end start end count key} @result{} @i{result-sequence} ++@code{remove-if} @i{test sequence @r{&key} from-end start end count key} @result{} @i{result-sequence} + +-@code{remove-if-not} @i{test sequence {&key} from-end start end count key} @result{} @i{result-sequence} ++@code{remove-if-not} @i{test sequence @r{&key} from-end start end count key} @result{} @i{result-sequence} + +-@code{delete} @i{item sequence {&key} from-end test test-not start end count key} @result{} @i{result-sequence} ++@code{delete} @i{item sequence @r{&key} from-end test test-not start end count key} @result{} @i{result-sequence} + +-@code{delete-if} @i{test sequence {&key} from-end start end count key} @result{} @i{result-sequence} ++@code{delete-if} @i{test sequence @r{&key} from-end start end count key} @result{} @i{result-sequence} + +-@code{delete-if-not} @i{test sequence {&key} from-end start end count key} @result{} @i{result-sequence} ++@code{delete-if-not} @i{test sequence @r{&key} from-end start end count key} @result{} @i{result-sequence} + + @subsubheading Arguments and Values:: + +@@ -2153,12 +2159,12 @@ + @node remove-duplicates, , remove, Sequences Dictionary + @subsection remove-duplicates, delete-duplicates [Function] + +-@code{remove-duplicates} @i{sequence {&key} ++@code{remove-duplicates} @i{sequence @r{&key} + from-end test test-not + start end key}@* + @result{} @i{result-sequence} + +-@code{delete-duplicates} @i{sequence {&key} ++@code{delete-duplicates} @i{sequence @r{&key} + from-end test test-not + start end key}@* + @result{} @i{result-sequence} +diff -uNr gcl-texi-orig/chap-18.texi gcl-texi/chap-18.texi +--- gcl-texi-orig/chap-18.texi 1994-07-16 18:03:08 +0400 ++++ gcl-texi/chap-18.texi 2002-10-17 20:53:05 +0400 +@@ -72,6 +72,7 @@ + from the @i{secondary value} returned by @b{gethash}. + @end table + ++@format + @group + @noindent + @w{ clrhash hash-table-p remhash } +@@ -82,6 +83,7 @@ + @w{ Figure 18--1: Hash-table defined names } + + @end group ++@end format + + @node Modifying Hash Table Keys, , Hash-Table Operations, Hash Table Concepts + @subsection Modifying Hash Table Keys +@@ -241,14 +243,14 @@ + @subsubheading Notes:: + + The intent is that this mapping be implemented by a hashing mechanism, +-such as that described in Section 6.4 ``Hashing'' of {The Art of Computer Programming, Volume 3} ++such as that described in Section 6.4 ``Hashing'' of @b{The Art of Computer Programming, Volume 3} + (pp506-549). In spite of this intent, no @i{conforming implementation} + is required to use any particular technique to implement the mapping. + + @node make-hash-table, hash-table-p, hash-table, Hash Tables Dictionary + @subsection make-hash-table [Function] + +-@code{make-hash-table} @i{{&key} test size rehash-size rehash-threshold} @result{} @i{hash-table} ++@code{make-hash-table} @i{@r{&key} test size rehash-size rehash-threshold} @result{} @i{hash-table} + + @subsubheading Arguments and Values:: + +@@ -571,9 +573,9 @@ + @node gethash, remhash, hash-table-test, Hash Tables Dictionary + @subsection gethash [Accessor] + +-@code{gethash} @i{key hash-table {&optional} default} @result{} @i{value, present-p} ++@code{gethash} @i{key hash-table @r{&optional} default} @result{} @i{value, present-p} + +-(setf (@code{ gethash} @i{key hash-table {&optional} default}) new-value)@* ++(setf (@code{ gethash} @i{key hash-table @r{&optional} default}) new-value)@* + + @subsubheading Arguments and Values:: + +@@ -737,7 +739,7 @@ + @subsection with-hash-table-iterator [Macro] + + @code{with-hash-table-iterator} @i{@r{(}name hash-table@r{)} +- @{@i{declaration}@}{*} @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/chap-19.texi gcl-texi/chap-19.texi +--- gcl-texi-orig/chap-19.texi 1994-07-16 18:06:18 +0400 ++++ gcl-texi/chap-19.texi 2002-10-17 20:59:17 +0400 +@@ -124,6 +124,7 @@ + + Figure 19--1 lists some @i{defined names} that are applicable to @i{pathnames}. + ++@format + @group + @noindent + @w{ *default-pathname-defaults* namestring pathname-name } +@@ -139,6 +140,7 @@ + @w{ Figure 19--1: Pathname Operations } + + @end group ++@end format + + @node Parsing Namestrings Into Pathnames, , Pathnames as Filenames, Overview of Filenames + @subsection Parsing Namestrings Into Pathnames +@@ -281,9 +283,9 @@ + For example, + + @example +- ;; In a TOPS-20 implementation, which uses {@t{^}}V to quote ++ ;; In a TOPS-20 implementation, which uses @t{^}V to quote + (NAMESTRING (MAKE-PATHNAME :HOST "OZ" :NAME "")) +-@result{} #P"OZ:PS:{@t{^}}V" ++@result{} #P"OZ:PS:@t{^}V" + @i{NOT}@result{} #P"OZ:PS:" + @end example + +@@ -298,6 +300,7 @@ + Figure 19--2 lists the functions + relating to @i{pathnames} that permit a @t{:case} argument: + ++@format + @group + @noindent + @w{ make-pathname pathname-directory pathname-name } +@@ -307,13 +310,14 @@ + @w{ Figure 19--2: Pathname functions using a :CASE argument} + + @end group ++@end format + + @node Local Case in Pathname Components, Common Case in Pathname Components, Case in Pathname Components, Interpreting Pathname Component Values + @subsubsection Local Case in Pathname Components + + For the functions in @i{Figure~19--2}, + a value of @t{:local} +-@IKindex{local} ++@c @IKindex{local} + for the @t{:case} argument + (the default for these functions) + indicates that the functions should receive and yield @i{strings} in component values +@@ -330,7 +334,7 @@ + + For the functions in @i{Figure~19--2}, + a value of @t{:common} +-@IKindex{common} ++@c @IKindex{common} + for the @t{:case} argument + that these @i{functions} should receive + and yield @i{strings} in component values according to the following conventions: +@@ -368,7 +372,7 @@ + @subsubsection :WILD as a Component Value + + If @t{:wild} +-@IKindex{wild} ++@c @IKindex{wild} + is the value of a @i{pathname} component, + that component is considered to be a wildcard, which matches anything. + +@@ -387,13 +391,13 @@ + @t{(:absolute :wild-inferiors)}, + or the same as @t{(:absolute :wild)} in a @i{file system} that does not support + @t{:wild-inferiors}. +-@IKindex{wild-inferiors} ++@c @IKindex{wild-inferiors} + + @node ->UNSPECIFIC as a Component Value, Relation between component values NIL and ->UNSPECIFIC, ->WILD as a Component Value, Interpreting Pathname Component Values + @subsubsection :UNSPECIFIC as a Component Value + + If @t{:unspecific} +-@IKindex{unspecific} ++@c @IKindex{unspecific} + is the value of a @i{pathname} component, + the component is considered to be ``absent'' + or to ``have no meaning'' +@@ -507,10 +511,10 @@ + The directory can be a @i{list} of @i{strings} and @i{symbols}. + + The @i{car} of the @i{list} is one of the symbols @t{:absolute} +-@IKindex{absolute} ++@c @IKindex{absolute} + or + @t{:relative} +-@IKindex{relative} ++@c @IKindex{relative} + , meaning: + + @table @asis +@@ -550,14 +554,15 @@ + signals an error of @i{type} @b{file-error}. + For example, Unix does not support @t{:wild-inferiors} in most implementations. + +-@IKindex{wild} ++@c @IKindex{wild} + +-@IKindex{wild-inferiors} ++@c @IKindex{wild-inferiors} + +-@IKindex{up} ++@c @IKindex{up} + +-@IKindex{back} ++@c @IKindex{back} + ++@format + @group + @noindent + @w{ Symbol Meaning } +@@ -570,6 +575,7 @@ + @w{ Figure 19--3: Special Markers In Directory Component } + + @end group ++@end format + + The following notes apply to the previous figure: + +@@ -782,7 +788,7 @@ + not a structural description of @i{objects}.) + + @w{@i{logical-pathname} ::=@r{[}!@i{host} @i{host-marker}@r{]} } +-@w{ @r{[}!@i{@i{relative-directory-marker}}@r{]} @{!@i{directory} @i{directory-marker}@}{*} } ++@w{ @r{[}!@i{@i{relative-directory-marker}}@r{]} @{!@i{directory} @i{directory-marker}@}* } + @w{ @r{[}!@i{name}@r{]} @r{[}@i{type-marker} !@i{type} @r{[}@i{version-marker} !@i{version}@r{]}@r{]}} + + @w{@i{host} ::=!@i{word}} +@@ -1061,7 +1067,7 @@ + @node make-pathname, pathnamep, pathname, Filenames Dictionary + @subsection make-pathname [Function] + +-@code{make-pathname} @i{{&key} host device directory name type version defaults case}@* ++@code{make-pathname} @i{@r{&key} host device directory name type version defaults case}@* + @result{} @i{pathname} + + @subsubheading Arguments and Values:: +@@ -1238,15 +1244,15 @@ + @i{[Function]} + @end flushright + +-@code{pathname-host} @i{pathname {&key} case} @result{} @i{host} ++@code{pathname-host} @i{pathname @r{&key} case} @result{} @i{host} + +-@code{pathname-device} @i{pathname {&key} case} @result{} @i{device} ++@code{pathname-device} @i{pathname @r{&key} case} @result{} @i{device} + +-@code{pathname-directory} @i{pathname {&key} case} @result{} @i{directory} ++@code{pathname-directory} @i{pathname @r{&key} case} @result{} @i{directory} + +-@code{pathname-name} @i{pathname {&key} case} @result{} @i{name} ++@code{pathname-name} @i{pathname @r{&key} case} @result{} @i{name} + +-@code{pathname-type} @i{pathname {&key} case} @result{} @i{type} ++@code{pathname-type} @i{pathname @r{&key} case} @result{} @i{type} + + @code{pathname-version} @i{pathname} @result{} @i{version} + +@@ -1704,7 +1710,7 @@ + + @code{host-namestring} @i{pathname} @result{} @i{namestring} + +-@code{enough-namestring} @i{pathname {&optional} defaults} @result{} @i{namestring} ++@code{enough-namestring} @i{pathname @r{&optional} defaults} @result{} @i{namestring} + + @subsubheading Arguments and Values:: + +@@ -1809,7 +1815,7 @@ + @node parse-namestring, wild-pathname-p, namestring, Filenames Dictionary + @subsection parse-namestring [Function] + +-@code{parse-namestring} @i{thing {&optional} host default-pathname {&key} start end junk-allowed}@* ++@code{parse-namestring} @i{thing @r{&optional} host default-pathname @r{&key} start end junk-allowed}@* + @result{} @i{pathname, position} + + @subsubheading Arguments and Values:: +@@ -1963,7 +1969,7 @@ + @node wild-pathname-p, pathname-match-p, parse-namestring, Filenames Dictionary + @subsection wild-pathname-p [Function] + +-@code{wild-pathname-p} @i{pathname {&optional} field-key} @result{} @i{generalized-boolean} ++@code{wild-pathname-p} @i{pathname @r{&optional} field-key} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -2069,7 +2075,7 @@ + @node translate-logical-pathname, translate-pathname, pathname-match-p, Filenames Dictionary + @subsection translate-logical-pathname [Function] + +-@code{translate-logical-pathname} @i{pathname {&key}} @result{} @i{physical-pathname} ++@code{translate-logical-pathname} @i{pathname @r{&key}} @result{} @i{physical-pathname} + + @subsubheading Arguments and Values:: + +@@ -2150,7 +2156,7 @@ + @node translate-pathname, merge-pathnames, translate-logical-pathname, Filenames Dictionary + @subsection translate-pathname [Function] + +-@code{translate-pathname} @i{source from-wildcard to-wildcard {&key}}@* ++@code{translate-pathname} @i{source from-wildcard to-wildcard @r{&key}}@* + @result{} @i{translated-pathname} + + @subsubheading Arguments and Values:: +@@ -2273,9 +2279,9 @@ + + @subsubheading See Also:: + +-@ref{namestring; file-namestring; directory-namestring; host-namestring; enough-namestring} ++@ref{namestring} + , +-@ref{pathname-host; pathname-device; pathname-directory; pathname-name; pathname-type; pathname-version} ++@ref{pathname-host} + , + + @b{pathname}, +@@ -2318,7 +2324,7 @@ + @node merge-pathnames, , translate-pathname, Filenames Dictionary + @subsection merge-pathnames [Function] + +-@code{merge-pathnames} @i{pathname {&optional} default-pathname default-version}@* ++@code{merge-pathnames} @i{pathname @r{&optional} default-pathname default-version}@* + @result{} @i{merged-pathname} + + @subsubheading Arguments and Values:: +diff -uNr gcl-texi-orig/chap-1.texi gcl-texi/chap-1.texi +--- gcl-texi-orig/chap-1.texi 1994-07-16 18:02:58 +0400 ++++ gcl-texi/chap-1.texi 2002-10-17 21:52:14 +0400 +@@ -49,7 +49,7 @@ + predominant dialects of Lisp, both arising from these early efforts: + MacLisp and Interlisp. + For further information about very early Lisp dialects, +-see {The Anatomy of Lisp} or {Lisp 1.5 Programmer's Manual}. ++see @b{The Anatomy of Lisp} or @b{Lisp 1.5 Programmer's Manual}. + + MacLisp improved on the Lisp~1.5 notion of special variables and error + handling. MacLisp also introduced the concept of functions that could take +@@ -58,14 +58,14 @@ + on execution speed. + By the end of the 1970's, MacLisp was in use at over 50 sites. + For further information about Maclisp, +-see {Maclisp Reference Manual, Revision~0} or {The Revised Maclisp Manual}. ++see @b{Maclisp Reference Manual, Revision~0} or @b{The Revised Maclisp Manual}. + + Interlisp introduced many ideas into Lisp programming environments and + methodology. One of the Interlisp ideas that influenced @r{Common Lisp} was an iteration + construct implemented by Warren Teitelman that inspired the @b{loop} + macro used both on the Lisp Machines and in MacLisp, and now in @r{Common Lisp}. + For further information about Interlisp, +-see {Interlisp Reference Manual}. ++see @b{Interlisp Reference Manual}. + + Although the first implementations of Lisp were on the IBM~704 and the + IBM~7090, later work focussed on the DEC +@@ -83,14 +83,14 @@ + that enabled fast function calling. + But the limitations of the PDP-10 were evident by 1973: it supported a + small number of researchers using Lisp, and the small, 18-bit address +-space (2^{18} = 262,144 words) limited the size of a single ++space (2^18 = 262,144 words) limited the size of a single + program. + One response to the address space problem was the Lisp Machine, a + special-purpose computer designed to run Lisp programs. The other + response was to use general-purpose computers with address spaces + larger than 18~bits, such as the DEC VAX and + the S-1~Mark~IIA. +-For further information about S-1 Common Lisp, see ``{S-1 Common Lisp Implementation}.'' ++For further information about S-1 Common Lisp, see @b{S-1 Common Lisp Implementation}. + + The Lisp machine concept was developed in the late 1960's. In the + early 1970's, Peter Deutsch, working with +@@ -107,7 +107,7 @@ + Machine Lisp became available on the early MIT Lisp Machines. + Commercial Lisp machines from Xerox, Lisp Machines (LMI), and + Symbolics were on the market by 1981. +-For further information about Lisp Machine Lisp, see {Lisp Machine Manual}. ++For further information about Lisp Machine Lisp, see @b{Lisp Machine Manual}. + + During the late 1970's, Lisp Machine Lisp began to expand towards a + much fuller language. Sophisticated lambda lists, +@@ -132,7 +132,7 @@ + to Lisp implementation. Eventually the S-1 and NIL groups + collaborated. + For further information about the NIL project, +-see ``{NIL---A Perspective}.'' ++see @b{NIL---A Perspective}. + + The first effort towards Lisp standardization was made in 1969, + when Anthony Hearn and Martin Griss at the University of Utah +@@ -142,7 +142,7 @@ + optimizing compiler for Standard Lisp, + and then an extended implementation known as Portable Standard Lisp (PSL). + By the mid 1980's, PSL ran on about a dozen kinds of computers. +-For further information about Standard Lisp, see ``{Standard LISP Report}.'' ++For further information about Standard Lisp, see @b{Standard LISP Report}. + + PSL and Franz Lisp---a MacLisp-like dialect for Unix machines---were + the first examples of widely available Lisp dialects on multiple +@@ -159,7 +159,8 @@ + closures, first-class continuations, and simplified syntax (no + separation of value cells and function cells). Some of these contributions made + a large impact on the design of @r{Common Lisp}. +-For further information about Scheme, see {IEEE Standard for the Scheme Programming Language} or ``{Revised^3 Report on the Algorithmic Language Scheme}.'' ++For further information about Scheme, see @b{IEEE Standard for the Scheme Programming Language} ++or @b{Revised^3 Report on the Algorithmic Language Scheme}. + + In the late 1970's object-oriented programming concepts started to + make a strong impact on Lisp. +@@ -170,12 +171,13 @@ + At Xerox, the experience with Smalltalk and + Knowledge Representation Language (KRL) led to the development of + Lisp Object Oriented Programming System (LOOPS) and later Common LOOPS. +-For further information on Smalltalk, see {Smalltalk-80: The Language and its Implementation}. +-For further information on Flavors, see {Flavors: A Non-Hierarchical Approach to Object-Oriented Programming}. ++For further information on Smalltalk, see @b{Smalltalk-80: The Language and its Implementation}. ++For further information on Flavors, see @b{Flavors: A Non-Hierarchical Approach to Object-Oriented Programming}. + + These systems influenced the design of the Common Lisp Object System (CLOS). + CLOS was developed specifically for this standardization effort, +-and was separately written up in ``Common Lisp Object System Specification.'' However, minor details ++and was separately written up in @b{Common Lisp Object System Specification}. ++However, minor details + of its design have changed slightly since that publication, and that paper + should not be taken as an authoritative reference to the semantics of the + object system as described in this document. +@@ -254,7 +256,7 @@ + For information about data types, see @ref{Types and Classes}. + Not all @i{types} and @i{classes} are defined in this chapter; + many are defined in chapter corresponding to their topic--for example, +-the numeric types are defined in @ref{Numbers}. ++the numeric types are defined in @ref{Numbers (Numbers)}. + For a complete list of @i{standardized} @i{types}, + see @i{Figure~4--2}. + +@@ -271,32 +273,32 @@ + @table @asis + + @item @t{*} +-{The Anatomy of Lisp}, ++@b{The Anatomy of Lisp}, + John Allen, McGraw-Hill, Inc., 1978. + + @item @t{*} +-{The Art of Computer Programming, Volume 3}, ++@b{The Art of Computer Programming, Volume 3}, + Donald E. Knuth, Addison-Wesley Company (Reading, MA), 1973. + + @item @t{*} +-{The Art of the Metaobject Protocol}, ++@b{The Art of the Metaobject Protocol}, + Kiczales et al., MIT Press (Cambridge, MA), 1991. + + @item @t{*} +-``Common Lisp Object System Specification,'' ++@b{Common Lisp Object System Specification}, + D. Bobrow, L. DiMichiel, R.P. Gabriel, S. Keene, G. Kiczales, D. Moon, + @i{SIGPLAN Notices} V23, September, 1988. + + @item @t{*} +-{Common Lisp: The Language}, ++@b{Common Lisp: The Language}, + Guy L. Steele Jr., Digital Press (Burlington, MA), 1984. + + @item @t{*} +-{Common Lisp: The Language, Second Edition}, ++@b{Common Lisp: The Language, Second Edition}, + Guy L. Steele Jr., Digital Press (Bedford, MA), 1990. + + @item @t{*} +-{Exceptional Situations in Lisp}, ++@b{Exceptional Situations in Lisp}, + Kent M. Pitman, + @i{Proceedings of the First European Conference + on the Practical Application of LISP\/} +@@ -305,21 +307,21 @@ + March 27-29, 1990. + + @item @t{*} +-{Flavors: A Non-Hierarchical Approach to Object-Oriented Programming}, ++@b{Flavors: A Non-Hierarchical Approach to Object-Oriented Programming}, + Howard I. Cannon, 1982. + + @item @t{*} +-{IEEE Standard for Binary Floating-Point Arithmetic}, ++@b{IEEE Standard for Binary Floating-Point Arithmetic}, + ANSI/IEEE Std 754-1985, + Institute of Electrical and Electronics Engineers, Inc. (New York), 1985. + + @item @t{*} +-{IEEE Standard for the Scheme Programming Language}, ++@b{IEEE Standard for the Scheme Programming Language}, + IEEE Std 1178-1990, + Institute of Electrical and Electronic Engineers, Inc. (New York), 1991. + + @item @t{*} +-{Interlisp Reference Manual}, Third Revision, ++@b{Interlisp Reference Manual}, Third Revision, + Teitelman, Warren, et al, + Xerox Palo Alto Research Center (Palo Alto, CA), 1978. + +@@ -331,66 +333,66 @@ + ISO, 1983. + + @item @t{*} +-{Lisp 1.5 Programmer's Manual}, ++@b{Lisp 1.5 Programmer's Manual}, + John McCarthy, MIT Press (Cambridge, MA), August, 1962. + + @item @t{*} +-{Lisp Machine Manual}, ++@b{Lisp Machine Manual}, + D.L. Weinreb and D.A. Moon, + Artificial Intelligence Laboratory, MIT (Cambridge, MA), July, 1981. + + @item @t{*} +-{Maclisp Reference Manual, Revision~0}, ++@b{Maclisp Reference Manual, Revision~0}, + David A. Moon, Project MAC (Laboratory for Computer Science), + MIT (Cambridge, MA), March, 1974. + + @item @t{*} +-``{NIL---A Perspective},'' ++@b{NIL---A Perspective}, + JonL White, @i{Macsyma User's Conference}, 1979. + + @item @t{*} +-{Performance and Evaluation of Lisp Programs}, ++@b{Performance and Evaluation of Lisp Programs}, + Richard P. Gabriel, MIT Press (Cambridge, MA), 1985. + + @item @t{*} +-``{Principal Values and Branch Cuts in Complex APL},'' ++@b{Principal Values and Branch Cuts in Complex APL}, + Paul Penfield Jr., @i{APL 81 Conference Proceedings}, + ACM SIGAPL (San Francisco, September 1981), 248-256. + Proceedings published as @i{APL Quote Quad 12}, 1 (September 1981). + + @item @t{*} +-{The Revised Maclisp Manual}, ++@b{The Revised Maclisp Manual}, + Kent M. Pitman, + Technical Report 295, + Laboratory for Computer Science, MIT (Cambridge, MA), May 1983. + + @item @t{*} +-``{Revised^3 Report on the Algorithmic Language Scheme},'' ++@b{Revised^3 Report on the Algorithmic Language Scheme}, + Jonathan Rees and William Clinger (editors), + @i{SIGPLAN Notices} V21, #12, December, 1986. + + @item @t{*} +-``S-1 Common Lisp Implementation,'' ++@b{S-1 Common Lisp Implementation}, + R.A. Brooks, R.P. Gabriel, and G.L. Steele, + @i{Conference Record of the 1982 ACM Symposium on Lisp and Functional Programming}, + 108-113, 1982. + + @item @t{*} +-@i{Smalltalk-80: The Language and its Implementation}, ++@b{Smalltalk-80: The Language and its Implementation}, + A. Goldberg and D. Robson, Addison-Wesley, 1983. + + @item @t{*} +-``{Standard LISP Report},'' ++@b{Standard LISP Report}, + J.B. Marti, A.C. Hearn, M.L. Griss, and C. Griss, + @i{SIGPLAN Notices} V14, #10, October, 1979. + + @item @t{*} +-{Webster's Third New International Dictionary ++@b{Webster's Third New International Dictionary + the English Language, Unabridged}, + Merriam Webster (Springfield, MA), 1986. + + @item @t{*} +-@i{XP: A Common Lisp Pretty Printing System}, ++@b{XP: A Common Lisp Pretty Printing System}, + R.C. Waters, + Memo 1102a, + Artificial Intelligence Laboratory, MIT (Cambridge, MA), September 1989. +@@ -638,15 +640,15 @@ + within the BNF, but might still be useful elsewhere. For example, consider the + following definitions: + +-@code{case} @i{keyform @{!@i{normal-clause}@}{*} @r{[}!@i{otherwise-clause}@r{]}} @result{} @i{@{@i{result}@}{*}} ++@code{case} @i{keyform @{!@i{normal-clause}@}* @r{[}!@i{otherwise-clause}@r{]}} @result{} @i{@{@i{result}@}*} + +-@code{ccase} @i{keyplace @{!@i{normal-clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{ccase} @i{keyplace @{!@i{normal-clause}@}*} @result{} @i{@{@i{result}@}*} + +-@code{ecase} @i{keyform @{!@i{normal-clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{ecase} @i{keyform @{!@i{normal-clause}@}*} @result{} @i{@{@i{result}@}*} + +-@w{@i{normal-clause} ::=@r{(}keys @{@i{form}@}{*}@r{)}} ++@w{@i{normal-clause} ::=@r{(}keys @{@i{form}@}*@r{)}} + +-@w{@i{otherwise-clause} ::=@r{(}@{otherwise | t@} @{@i{form}@}{*}@r{)}} ++@w{@i{otherwise-clause} ::=@r{(}@{otherwise | t@} @{@i{form}@}*@r{)}} + + @w{@i{clause} ::=normal-clause | otherwise-clause} + +@@ -697,7 +699,7 @@ + other indicator) before showing return values, while others do not. + + @item @i{OR}@result{} +-The notation ``{@i{OR}@result{}}'' is used to denote one of several possible ++The notation ``@i{OR}@result{}'' is used to denote one of several possible + alternate results. The example + + @example +@@ -722,7 +724,7 @@ + of the ways in which it is permitted for implementations to diverge. + + @item @i{NOT}@result{} +-The notation ``{@i{NOT}@result{}}'' is used to denote a result which is not possible. ++The notation ``@i{NOT}@result{}'' is used to denote a result which is not possible. + This might be used, for example, in order to emphasize a situation where + some anticipated misconception might lead the reader to falsely believe + that the result might be possible. For example, +@@ -750,7 +752,7 @@ + @t{(gcd (gcd x y) z)} for any + @t{x}, @t{y}, and @t{z}. + +-@item {@t{ |> }} ++@item @t{ |> } + @r{Common Lisp} specifies input and output with respect to a non-interactive stream model. + The specific details of how interactive input and output are mapped onto that + non-interactive model are @i{implementation-defined}. +@@ -765,7 +767,7 @@ + a buffer full of input without the command itself being visible on the program's + input stream. + +-In the examples in this document, the notation ``{@t{ |> }}'' precedes ++In the examples in this document, the notation ``@t{ |> }'' precedes + lines where interactive input and output occurs. Within such a scenario, + ``@b{|>>}@t{this notation}@b{<<|}'' notates user input. + +@@ -791,11 +793,11 @@ + Sometimes, the non-interactive stream model calls for a @i{newline}. + How that @i{newline} character is interactively entered is an + @i{implementation-defined} detail of the user interface, but in that +-case, either the notation ``<@i{Newline}>'' or ``{@i{[<--}~]}'' might be used. ++case, either the notation ``<@i{Newline}>'' or ``@i{[<--}~]'' might be used. + + @example + (progn (format t "~&Who? ") (read-line)) +-@t{ |> } Who? @b{|>>}@t{Fred, Mary, and Sally{@i{[<--}~]}}@b{<<|} ++@t{ |> } Who? @b{|>>}@t{Fred, Mary, and Sally @i{[<--}~]}@b{<<|} + @result{} "Fred, Mary, and Sally", @i{false} + @end example + +@@ -886,6 +888,7 @@ + By convention, the choice of notation offers a hint as to which of its many + roles it is playing. + ++@format + @group + @noindent + @w{ @b{For Evaluation?} @b{Notation} @b{Typically Implied Role} } +@@ -900,6 +903,7 @@ + @w{ Figure 1--1: Notations for NIL } + + @end group ++@end format + + Within this document only, @b{nil} is also sometimes notated as @i{false} to + emphasize its role as a @i{boolean}. +@@ -1263,42 +1267,42 @@ + dictionary entry. + + @menu +-* The ``Affected By'' Section of a Dictionary Entry:: +-* The ``Arguments'' Section of a Dictionary Entry:: +-* The ``Arguments and Values'' Section of a Dictionary Entry:: +-* The ``Binding Types Affected'' Section of a Dictionary Entry:: +-* The ``Class Precedence List'' Section of a Dictionary Entry:: ++* The "Affected By" Section of a Dictionary Entry:: ++* The "Arguments" Section of a Dictionary Entry:: ++* The "Arguments and Values" Section of a Dictionary Entry:: ++* The "Binding Types Affected" Section of a Dictionary Entry:: ++* The "Class Precedence List" Section of a Dictionary Entry:: + * Dictionary Entries for Type Specifiers:: +-* The ``Compound Type Specifier Kind'' Section of a Dictionary Entry:: +-* The ``Compound Type Specifier Syntax'' Section of a Dictionary Entry:: +-* The ``Compound Type Specifier Arguments'' Section of a Dictionary Entry:: +-* The ``Compound Type Specifier Description'' Section of a Dictionary Entry:: +-* The ``Constant Value'' Section of a Dictionary Entry:: +-* The ``Description'' Section of a Dictionary Entry:: +-* The ``Examples'' Section of a Dictionary Entry:: +-* The ``Exceptional Situations'' Section of a Dictionary Entry:: +-* The ``Initial Value'' Section of a Dictionary Entry:: +-* The ``Argument Precedence Order'' Section of a Dictionary Entry:: +-* The ``Method Signature'' Section of a Dictionary Entry:: +-* The ``Name'' Section of a Dictionary Entry:: +-* The ``Notes'' Section of a Dictionary Entry:: +-* The ``Pronunciation'' Section of a Dictionary Entry:: +-* The ``See Also'' Section of a Dictionary Entry:: +-* The ``Side Effects'' Section of a Dictionary Entry:: +-* The ``Supertypes'' Section of a Dictionary Entry:: +-* The ``Syntax'' Section of a Dictionary Entry:: +-* Special ``Syntax'' Notations for Overloaded Operators:: ++* The "Compound Type Specifier Kind" Section of a Dictionary Entry:: ++* The "Compound Type Specifier Syntax" Section of a Dictionary Entry:: ++* The "Compound Type Specifier Arguments" Section of a Dictionary Entry:: ++* The "Compound Type Specifier Description" Section of a Dictionary Entry:: ++* The "Constant Value" Section of a Dictionary Entry:: ++* The "Description" Section of a Dictionary Entry:: ++* The "Examples" Section of a Dictionary Entry:: ++* The "Exceptional Situations" Section of a Dictionary Entry:: ++* The "Initial Value" Section of a Dictionary Entry:: ++* The "Argument Precedence Order" Section of a Dictionary Entry:: ++* The "Method Signature" Section of a Dictionary Entry:: ++* The "Name" Section of a Dictionary Entry:: ++* The "Notes" Section of a Dictionary Entry:: ++* The "Pronunciation" Section of a Dictionary Entry:: ++* The "See Also" Section of a Dictionary Entry:: ++* The "Side Effects" Section of a Dictionary Entry:: ++* The "Supertypes" Section of a Dictionary Entry:: ++* The "Syntax" Section of a Dictionary Entry:: ++* Special "Syntax" Notations for Overloaded Operators:: + * Naming Conventions for Rest Parameters:: +-* Requiring Non-Null Rest Parameters in the ``Syntax'' Section:: +-* Return values in the ``Syntax'' Section:: +-* No Arguments or Values in the ``Syntax'' Section:: +-* Unconditional Transfer of Control in the ``Syntax'' Section:: +-* The ``Valid Context'' Section of a Dictionary Entry:: +-* The ``Value Type'' Section of a Dictionary Entry:: ++* Requiring Non-Null Rest Parameters in The "Syntax" Section:: ++* Return values in The "Syntax" Section:: ++* No Arguments or Values in The "Syntax" Section:: ++* Unconditional Transfer of Control in The "Syntax" Section:: ++* The "Valid Context" Section of a Dictionary Entry:: ++* The "Value Type" Section of a Dictionary Entry:: + @end menu + +-@node The ``Affected By'' Section of a Dictionary Entry, The ``Arguments'' Section of a Dictionary Entry, Interpreting Dictionary Entries, Interpreting Dictionary Entries +-@subsubsection The ``Affected By'' Section of a Dictionary Entry ++@node The "Affected By" Section of a Dictionary Entry, The "Arguments" Section of a Dictionary Entry, Interpreting Dictionary Entries, Interpreting Dictionary Entries ++@subsubsection The "Affected By" Section of a Dictionary Entry + + For an @i{operator}, anything that can affect the side effects of + or @i{values} returned by the @i{operator}. +@@ -1306,15 +1310,15 @@ + For a @i{variable}, anything that can affect the @i{value} of the @i{variable} + including @i{functions} that bind or assign it. + +-@node The ``Arguments'' Section of a Dictionary Entry, The ``Arguments and Values'' Section of a Dictionary Entry, The ``Affected By'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Arguments'' Section of a Dictionary Entry ++@node The "Arguments" Section of a Dictionary Entry, The "Arguments and Values" Section of a Dictionary Entry, The "Affected By" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Arguments" Section of a Dictionary Entry + + This information describes the syntax information of entries such as those for + @i{declarations} and special @i{expressions} which are never @i{evaluated} + as @i{forms}, and so do not return @i{values}. + +-@node The ``Arguments and Values'' Section of a Dictionary Entry, The ``Binding Types Affected'' Section of a Dictionary Entry, The ``Arguments'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Arguments and Values'' Section of a Dictionary Entry ++@node The "Arguments and Values" Section of a Dictionary Entry, The "Binding Types Affected" Section of a Dictionary Entry, The "Arguments" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Arguments and Values" Section of a Dictionary Entry + + An English language description of what @i{arguments} the @i{operator} accepts + and what @i{values} it returns, including information about defaults for @i{parameters} +@@ -1324,16 +1328,16 @@ + their @i{arguments} are not @i{evaluated} unless it is explicitly stated in their + descriptions that they are @i{evaluated}. + +-@node The ``Binding Types Affected'' Section of a Dictionary Entry, The ``Class Precedence List'' Section of a Dictionary Entry, The ``Arguments and Values'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Binding Types Affected'' Section of a Dictionary Entry ++@node The "Binding Types Affected" Section of a Dictionary Entry, The "Class Precedence List" Section of a Dictionary Entry, The "Arguments and Values" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Binding Types Affected" Section of a Dictionary Entry + + This information alerts the reader to the kinds of @i{bindings} that might + potentially be affected by a declaration. Whether in fact any particular such + @i{binding} is actually affected is dependent on additional factors as well. +-See the ``Description'' section of the declaration in question for details. ++See The "Description" Section of the declaration in question for details. + +-@node The ``Class Precedence List'' Section of a Dictionary Entry, Dictionary Entries for Type Specifiers, The ``Binding Types Affected'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Class Precedence List'' Section of a Dictionary Entry ++@node The "Class Precedence List" Section of a Dictionary Entry, Dictionary Entries for Type Specifiers, The "Binding Types Affected" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Class Precedence List" Section of a Dictionary Entry + + This appears in the dictionary entry for a @i{class}, + and contains an ordered list of the @i{classes} defined +@@ -1356,7 +1360,7 @@ + the @i{classes} listed in this section are also @i{supertypes} of + the @i{type} denoted by the @i{class}. + +-@node Dictionary Entries for Type Specifiers, The ``Compound Type Specifier Kind'' Section of a Dictionary Entry, The ``Class Precedence List'' Section of a Dictionary Entry, Interpreting Dictionary Entries ++@node Dictionary Entries for Type Specifiers, The "Compound Type Specifier Kind" Section of a Dictionary Entry, The "Class Precedence List" Section of a Dictionary Entry, Interpreting Dictionary Entries + @subsubsection Dictionary Entries for Type Specifiers + + The @i{atomic type specifiers} are those @i{defined names} +@@ -1366,7 +1370,7 @@ + A description of how to interpret + a @i{symbol} naming one of these @i{types} or @i{classes} + as an @i{atomic type specifier} +-is found in the ``Description'' section of such dictionary entries. ++is found in The "Description" Section of such dictionary entries. + + The @i{compound type specifiers} are those @i{defined names} + listed in @i{Figure~4--3}. +@@ -1381,8 +1385,8 @@ + and ``Compound Type Specifier Description'' + sections of such dictionary entries. + +-@node The ``Compound Type Specifier Kind'' Section of a Dictionary Entry, The ``Compound Type Specifier Syntax'' Section of a Dictionary Entry, Dictionary Entries for Type Specifiers, Interpreting Dictionary Entries +-@subsubsection The ``Compound Type Specifier Kind'' Section of a Dictionary Entry ++@node The "Compound Type Specifier Kind" Section of a Dictionary Entry, The "Compound Type Specifier Syntax" Section of a Dictionary Entry, Dictionary Entries for Type Specifiers, Interpreting Dictionary Entries ++@subsubsection The "Compound Type Specifier Kind" Section of a Dictionary Entry + + An ``abbreviating'' @i{type specifier} is one that describes a @i{subtype} + for which it is in principle possible to enumerate the @i{elements}, +@@ -1399,8 +1403,8 @@ + in a compositional way, using combining operations (such as ``and,'' ``or,'' and + ``not'') on other @i{types}. + +-@node The ``Compound Type Specifier Syntax'' Section of a Dictionary Entry, The ``Compound Type Specifier Arguments'' Section of a Dictionary Entry, The ``Compound Type Specifier Kind'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Compound Type Specifier Syntax'' Section of a Dictionary Entry ++@node The "Compound Type Specifier Syntax" Section of a Dictionary Entry, The "Compound Type Specifier Arguments" Section of a Dictionary Entry, The "Compound Type Specifier Kind" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Compound Type Specifier Syntax" Section of a Dictionary Entry + + This information about a @i{type} describes the syntax of a + @i{compound type specifier} for that @i{type}. +@@ -1408,40 +1412,40 @@ + Whether or not the @i{type} is acceptable as an @i{atomic type specifier} + is not represented here; see @ref{Dictionary Entries for Type Specifiers}. + +-@node The ``Compound Type Specifier Arguments'' Section of a Dictionary Entry, The ``Compound Type Specifier Description'' Section of a Dictionary Entry, The ``Compound Type Specifier Syntax'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Compound Type Specifier Arguments'' Section of a Dictionary Entry ++@node The "Compound Type Specifier Arguments" Section of a Dictionary Entry, The "Compound Type Specifier Description" Section of a Dictionary Entry, The "Compound Type Specifier Syntax" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Compound Type Specifier Arguments" Section of a Dictionary Entry + + This information describes @i{type} information for the structures defined in +-the ``Compound Type Specifier Syntax'' section. ++The "Compound Type Specifier Syntax" Section. + +-@node The ``Compound Type Specifier Description'' Section of a Dictionary Entry, The ``Constant Value'' Section of a Dictionary Entry, The ``Compound Type Specifier Arguments'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Compound Type Specifier Description'' Section of a Dictionary Entry ++@node The "Compound Type Specifier Description" Section of a Dictionary Entry, The "Constant Value" Section of a Dictionary Entry, The "Compound Type Specifier Arguments" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Compound Type Specifier Description" Section of a Dictionary Entry + + This information describes the meaning of the structures defined in +-the ``Compound Type Specifier Syntax'' section. ++The "Compound Type Specifier Syntax" Section. + +-@node The ``Constant Value'' Section of a Dictionary Entry, The ``Description'' Section of a Dictionary Entry, The ``Compound Type Specifier Description'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Constant Value'' Section of a Dictionary Entry ++@node The "Constant Value" Section of a Dictionary Entry, The "Description" Section of a Dictionary Entry, The "Compound Type Specifier Description" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Constant Value" Section of a Dictionary Entry + + This information describes the unchanging @i{type} and @i{value} of + a @i{constant variable}. + +-@node The ``Description'' Section of a Dictionary Entry, The ``Examples'' Section of a Dictionary Entry, The ``Constant Value'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Description'' Section of a Dictionary Entry ++@node The "Description" Section of a Dictionary Entry, The "Examples" Section of a Dictionary Entry, The "Constant Value" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Description" Section of a Dictionary Entry + + A summary of the @i{operator} and all intended aspects of the @i{operator}, + but does not necessarily include all the fields referenced below it + (``Side Effects,'' ``Exceptional Situations,'' @i{etc.}) + +-@node The ``Examples'' Section of a Dictionary Entry, The ``Exceptional Situations'' Section of a Dictionary Entry, The ``Description'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Examples'' Section of a Dictionary Entry ++@node The "Examples" Section of a Dictionary Entry, The "Exceptional Situations" Section of a Dictionary Entry, The "Description" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Examples" Section of a Dictionary Entry + + Examples of use of the @i{operator}. + These examples are not considered part of the standard; + see @ref{Sections Not Formally Part Of This Standard}. + +-@node The ``Exceptional Situations'' Section of a Dictionary Entry, The ``Initial Value'' Section of a Dictionary Entry, The ``Examples'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Exceptional Situations'' Section of a Dictionary Entry ++@node The "Exceptional Situations" Section of a Dictionary Entry, The "Initial Value" Section of a Dictionary Entry, The "Examples" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Exceptional Situations" Section of a Dictionary Entry + + Three kinds of information may appear here: + @table @asis +@@ -1459,20 +1463,20 @@ + as arguments or through dynamic variables, nor by executing subforms of this + operator if it is a @i{macro} or @i{special operator}. + +-@node The ``Initial Value'' Section of a Dictionary Entry, The ``Argument Precedence Order'' Section of a Dictionary Entry, The ``Exceptional Situations'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Initial Value'' Section of a Dictionary Entry ++@node The "Initial Value" Section of a Dictionary Entry, The "Argument Precedence Order" Section of a Dictionary Entry, The "Exceptional Situations" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Initial Value" Section of a Dictionary Entry + + This information describes the initial @i{value} of a @i{dynamic variable}. +-Since this variable might change, see @i{type} restrictions in the ``Value Type'' section. ++Since this variable might change, see @i{type} restrictions in The "Value Type" Section. + +-@node The ``Argument Precedence Order'' Section of a Dictionary Entry, The ``Method Signature'' Section of a Dictionary Entry, The ``Initial Value'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Argument Precedence Order'' Section of a Dictionary Entry ++@node The "Argument Precedence Order" Section of a Dictionary Entry, The "Method Signature" Section of a Dictionary Entry, The "Initial Value" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Argument Precedence Order" Section of a Dictionary Entry + + This information describes the argument precedence order. + If it is omitted, the argument precedence order is the default (left to right). + +-@node The ``Method Signature'' Section of a Dictionary Entry, The ``Name'' Section of a Dictionary Entry, The ``Argument Precedence Order'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Method Signature'' Section of a Dictionary Entry ++@node The "Method Signature" Section of a Dictionary Entry, The "Name" Section of a Dictionary Entry, The "Argument Precedence Order" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Method Signature" Section of a Dictionary Entry + + The description of a @i{generic function} includes descriptions of the + @i{methods} that are defined on that @i{generic function} by the standard. +@@ -1483,7 +1487,7 @@ + + @code{F} @i{@r{(}@i{x} @i{class}@r{)} + @r{(}@i{y} t@r{)} +- {&optional} @i{z} {&key} @i{k}} ++ @r{&optional} @i{z} @r{&key} @i{k}} + + @noindent + This @i{signature} indicates that this method on the @i{generic function} +@@ -1503,8 +1507,8 @@ + @i{implementation-defined} or user-defined @i{methods} in situations + where the definition of such @i{methods} is permitted). + +-@node The ``Name'' Section of a Dictionary Entry, The ``Notes'' Section of a Dictionary Entry, The ``Method Signature'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Name'' Section of a Dictionary Entry ++@node The "Name" Section of a Dictionary Entry, The "Notes" Section of a Dictionary Entry, The "Method Signature" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Name" Section of a Dictionary Entry + + This section introduces the dictionary entry. It is not explicitly labeled. + It appears preceded and followed by a horizontal bar. +@@ -1579,8 +1583,8 @@ + + @end table + +-@node The ``Notes'' Section of a Dictionary Entry, The ``Pronunciation'' Section of a Dictionary Entry, The ``Name'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Notes'' Section of a Dictionary Entry ++@node The "Notes" Section of a Dictionary Entry, The "Pronunciation" Section of a Dictionary Entry, The "Name" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Notes" Section of a Dictionary Entry + + Information not found elsewhere in this description + which pertains to this @i{operator}. +@@ -1594,32 +1598,32 @@ + any @i{conforming implementation} or @i{conforming program} + is permitted to ignore the presence of this information. + +-@node The ``Pronunciation'' Section of a Dictionary Entry, The ``See Also'' Section of a Dictionary Entry, The ``Notes'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Pronunciation'' Section of a Dictionary Entry ++@node The "Pronunciation" Section of a Dictionary Entry, The "See Also" Section of a Dictionary Entry, The "Notes" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Pronunciation" Section of a Dictionary Entry + + This offers a suggested pronunciation for @i{defined names} + so that people not in verbal communication with the original designers + can figure out how to pronounce words that are not in normal English usage. + This information is advisory only, and is not considered part of the standard. + For brevity, it is only provided for entries with names that are specific to +-@r{Common Lisp} and would not be found in {Webster's Third New International Dictionary ++@r{Common Lisp} and would not be found in @b{Webster's Third New International Dictionary + the English Language, Unabridged}. + +-@node The ``See Also'' Section of a Dictionary Entry, The ``Side Effects'' Section of a Dictionary Entry, The ``Pronunciation'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``See Also'' Section of a Dictionary Entry ++@node The "See Also" Section of a Dictionary Entry, The "Side Effects" Section of a Dictionary Entry, The "Pronunciation" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "See Also" Section of a Dictionary Entry + + List of references to other parts of this standard + that offer information relevant to this @i{operator}. + This list is not part of the standard. + +-@node The ``Side Effects'' Section of a Dictionary Entry, The ``Supertypes'' Section of a Dictionary Entry, The ``See Also'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Side Effects'' Section of a Dictionary Entry ++@node The "Side Effects" Section of a Dictionary Entry, The "Supertypes" Section of a Dictionary Entry, The "See Also" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Side Effects" Section of a Dictionary Entry + + Anything that is changed as a result of the + evaluation of the @i{form} containing this @i{operator}. + +-@node The ``Supertypes'' Section of a Dictionary Entry, The ``Syntax'' Section of a Dictionary Entry, The ``Side Effects'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Supertypes'' Section of a Dictionary Entry ++@node The "Supertypes" Section of a Dictionary Entry, The "Syntax" Section of a Dictionary Entry, The "Side Effects" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Supertypes" Section of a Dictionary Entry + + This appears in the dictionary entry for a @i{type}, + and contains a list of the @i{standardized} @i{types} +@@ -1629,15 +1633,15 @@ + the order of the @i{classes} in the @i{class precedence list} + is consistent with the order presented in this section. + +-@node The ``Syntax'' Section of a Dictionary Entry, Special ``Syntax'' Notations for Overloaded Operators, The ``Supertypes'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Syntax'' Section of a Dictionary Entry ++@node The "Syntax" Section of a Dictionary Entry, Special "Syntax" Notations for Overloaded Operators, The "Supertypes" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Syntax" Section of a Dictionary Entry + + This section describes how to use the @i{defined name} in code. +-The ``Syntax'' description for a @i{generic function} ++The "Syntax'' description for a @i{generic function} + describes the @i{lambda list} of the @i{generic function} itself, +-while the ``Method Signatures'' describe the @i{lambda lists} ++while The "Method Signatures'' describe the @i{lambda lists} + of the defined @i{methods}. +-The ``Syntax'' description for ++The "Syntax'' description for + an @i{ordinary function}, + a @i{macro}, + or a @i{special operator} +@@ -1645,7 +1649,7 @@ + + For example, an @i{operator} description might say: + +-@code{F} @i{x y {&optional} z {&key} k} ++@code{F} @i{x y @r{&optional} z @r{&key} k} + + @noindent + This description indicates that the function @b{F} +@@ -1658,8 +1662,8 @@ + In both cases, however, the outermost parentheses are omitted, + and default value information is omitted. + +-@node Special ``Syntax'' Notations for Overloaded Operators, Naming Conventions for Rest Parameters, The ``Syntax'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection Special ``Syntax'' Notations for Overloaded Operators ++@node Special "Syntax" Notations for Overloaded Operators, Naming Conventions for Rest Parameters, The "Syntax" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection Special "Syntax" Notations for Overloaded Operators + + If two descriptions exist for the same operation but with different numbers of + arguments, then the extra arguments are to be treated as optional. For example, +@@ -1672,7 +1676,7 @@ + @noindent + is operationally equivalent to this line: + +-@code{file-position} @i{stream {&optional} position-spec} @result{} @i{result} ++@code{file-position} @i{stream @r{&optional} position-spec} @result{} @i{result} + + @noindent + and differs only in that it provides on opportunity to introduce different +@@ -1682,7 +1686,7 @@ + depending on how many @i{arguments} are supplied (@i{e.g.}, for the @i{function} @b{/}) + or the return values are different in the two cases (@i{e.g.}, for the @i{function} @b{file-position}). + +-@node Naming Conventions for Rest Parameters, Requiring Non-Null Rest Parameters in the ``Syntax'' Section, Special ``Syntax'' Notations for Overloaded Operators, Interpreting Dictionary Entries ++@node Naming Conventions for Rest Parameters, Requiring Non-Null Rest Parameters in The "Syntax" Section, Special "Syntax" Notations for Overloaded Operators, Interpreting Dictionary Entries + @subsubsection Naming Conventions for Rest Parameters + + Within this specification, +@@ -1694,15 +1698,15 @@ + + For example, given a syntax description such as: + +-@code{F} @i{{&rest} @i{arguments}} ++@code{F} @i{@r{&rest} @i{arguments}} + + @noindent + it is appropriate to refer either to the @i{rest parameter} named + @i{arguments} by name, or to one of its elements by speaking of ``an @i{argument},'' + ``some @i{argument},'' ``each @i{argument}'' @i{etc.} + +-@node Requiring Non-Null Rest Parameters in the ``Syntax'' Section, Return values in the ``Syntax'' Section, Naming Conventions for Rest Parameters, Interpreting Dictionary Entries +-@subsubsection Requiring Non-Null Rest Parameters in the ``Syntax'' Section ++@node Requiring Non-Null Rest Parameters in The "Syntax" Section, Return values in The "Syntax" Section, Naming Conventions for Rest Parameters, Interpreting Dictionary Entries ++@subsubsection Requiring Non-Null Rest Parameters in The "Syntax" Section + + In some cases it is useful to refer to all arguments equally as a single + aggregation using a @i{rest parameter} while at the same time +@@ -1711,21 +1715,21 @@ + restriction, however they generally do not manifest themselves in a + @i{lambda list}. For descriptive purposes within this specification, + +-@code{F} @i{{&rest} arguments^+} ++@code{F} @i{@r{&rest} arguments^+} + + @noindent + means the same as + +-@code{F} @i{{&rest} arguments} ++@code{F} @i{@r{&rest} arguments} + + @noindent + but introduces the additional requirement that there be + at least one @i{argument}. + +-@node Return values in the ``Syntax'' Section, No Arguments or Values in the ``Syntax'' Section, Requiring Non-Null Rest Parameters in the ``Syntax'' Section, Interpreting Dictionary Entries +-@subsubsection Return values in the ``Syntax'' Section ++@node Return values in The "Syntax" Section, No Arguments or Values in The "Syntax" Section, Requiring Non-Null Rest Parameters in The "Syntax" Section, Interpreting Dictionary Entries ++@subsubsection Return values in The "Syntax" Section + +-An evaluation arrow ``{@result{} }'' precedes a list of @i{values} to be returned. ++An evaluation arrow ``@result{}'' precedes a list of @i{values} to be returned. + For example: + + @code{F} @i{a b c} @result{} @i{x} +@@ -1738,8 +1742,8 @@ + + @code{F} @i{a b c} @result{} @i{x, y, z} + +-@node No Arguments or Values in the ``Syntax'' Section, Unconditional Transfer of Control in the ``Syntax'' Section, Return values in the ``Syntax'' Section, Interpreting Dictionary Entries +-@subsubsection No Arguments or Values in the ``Syntax'' Section ++@node No Arguments or Values in The "Syntax" Section, Unconditional Transfer of Control in The "Syntax" Section, Return values in The "Syntax" Section, Interpreting Dictionary Entries ++@subsubsection No Arguments or Values in The "Syntax" Section + + If no @i{arguments} are permitted, or no @i{values} are returned, + a special notation is used to make this more visually apparent. For example, +@@ -1749,8 +1753,8 @@ + indicates that @t{F} is an operator that accepts no @i{arguments} and returns + no @i{values}. + +-@node Unconditional Transfer of Control in the ``Syntax'' Section, The ``Valid Context'' Section of a Dictionary Entry, No Arguments or Values in the ``Syntax'' Section, Interpreting Dictionary Entries +-@subsubsection Unconditional Transfer of Control in the ``Syntax'' Section ++@node Unconditional Transfer of Control in The "Syntax" Section, The "Valid Context" Section of a Dictionary Entry, No Arguments or Values in The "Syntax" Section, Interpreting Dictionary Entries ++@subsubsection Unconditional Transfer of Control in The "Syntax" Section + + Some @i{operators} perform an unconditional transfer of control, and + so never have any return values. Such @i{operators} are notated using +@@ -1759,8 +1763,8 @@ + @code{F} @i{a b c} + @result{} # + +-@node The ``Valid Context'' Section of a Dictionary Entry, The ``Value Type'' Section of a Dictionary Entry, Unconditional Transfer of Control in the ``Syntax'' Section, Interpreting Dictionary Entries +-@subsubsection The ``Valid Context'' Section of a Dictionary Entry ++@node The "Valid Context" Section of a Dictionary Entry, The "Value Type" Section of a Dictionary Entry, Unconditional Transfer of Control in The "Syntax" Section, Interpreting Dictionary Entries ++@subsubsection The "Valid Context" Section of a Dictionary Entry + + This information is used by dictionary entries such as ``Declarations'' + in order to restrict the context in which the declaration may appear. +@@ -1770,8 +1774,8 @@ + a @i{proclamation} (@i{i.e.}, a @b{declaim} or @b{proclaim} @i{form}), + or both. + +-@node The ``Value Type'' Section of a Dictionary Entry, , The ``Valid Context'' Section of a Dictionary Entry, Interpreting Dictionary Entries +-@subsubsection The ``Value Type'' Section of a Dictionary Entry ++@node The "Value Type" Section of a Dictionary Entry, , The "Valid Context" Section of a Dictionary Entry, Interpreting Dictionary Entries ++@subsubsection The "Value Type" Section of a Dictionary Entry + + This information describes any @i{type} restrictions on a @i{dynamic variable}. + +@@ -2103,6 +2107,7 @@ + @subsection Deprecated Functions + + The @i{functions} in Figure 1--2 are deprecated. ++@format + @group + @noindent + @w{ assoc-if-not nsubst-if-not require } +@@ -2116,6 +2121,7 @@ + @w{ Figure 1--2: Deprecated Functions } + + @end group ++@end format + + @node Deprecated Argument Conventions, Deprecated Variables, Deprecated Functions, Deprecated Language Features + @subsection Deprecated Argument Conventions +@@ -2124,6 +2130,7 @@ + + The @t{:test-not} @i{argument} to the @i{functions} in Figure 1--3 are deprecated. + ++@format + @group + @noindent + @w{ adjoin nset-difference search } +@@ -2141,6 +2148,7 @@ + @w{ Figure 1--3: Functions with Deprecated :TEST-NOT Arguments} + + @end group ++@end format + + The use of the situation names @b{compile}, @b{load}, and @b{eval} + in @b{eval-when} is deprecated. +@@ -2171,6 +2179,7 @@ + of the 978 @i{external} @i{symbols} in the @t{COMMON-LISP} @i{package}. + @IPindex{common-lisp} + ++@format + @group + @noindent + @w{ &allow-other-keys *print-miser-width* } +@@ -2216,9 +2225,11 @@ + @w{ Figure 1--4: Symbols in the COMMON-LISP package (part one of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ adjoin atom boundp } +@@ -2264,9 +2275,11 @@ + @w{ Figure 1--5: Symbols in the COMMON-LISP package (part two of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ cddadr clear-input copy-tree } +@@ -2312,9 +2325,11 @@ + @w{ Figure 1--6: Symbols in the COMMON-LISP package (part three of twelve). } + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ denominator eq } +@@ -2360,9 +2375,11 @@ + @w{ Figure 1--7: Symbols in the COMMON-LISP package (part four of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ find-symbol get-internal-run-time } +@@ -2408,9 +2425,11 @@ + @w{ Figure 1--8: Symbols in the COMMON-LISP package (part five of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ intern lisp-implementation-type } +@@ -2456,9 +2475,11 @@ + @w{ Figure 1--9: Symbols in the COMMON-LISP package (part six of twelve). } + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ machine-version mask-field } +@@ -2504,9 +2525,11 @@ + @w{ Figure 1--10: Symbols in the COMMON-LISP package (part seven of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ nintersection package-error } +@@ -2552,9 +2575,11 @@ + @w{ Figure 1--11: Symbols in the COMMON-LISP package (part eight of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ pprint-tab read-char } +@@ -2600,9 +2625,11 @@ + @w{ Figure 1--12: Symbols in the COMMON-LISP package (part nine of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ room simple-bit-vector } +@@ -2648,9 +2675,11 @@ + @w{ Figure 1--13: Symbols in the COMMON-LISP package (part ten of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ standard-class sublis } +@@ -2696,9 +2725,11 @@ + @w{ Figure 1--14: Symbols in the COMMON-LISP package (part eleven of twelve).} + + @end group ++@end format + + @page + ++@format + @group + @noindent + @w{ truncate values-list } +@@ -2739,6 +2770,7 @@ + @w{ Figure 1--15: Symbols in the COMMON-LISP package (part twelve of twelve).} + + @end group ++@end format + + @c end of including concept-cl-symbols + +diff -uNr gcl-texi-orig/chap-20.texi gcl-texi/chap-20.texi +--- gcl-texi-orig/chap-20.texi 1994-07-16 18:03:06 +0400 ++++ gcl-texi/chap-20.texi 2002-10-17 20:53:05 +0400 +@@ -32,6 +32,7 @@ + Figure 20--1 lists some @i{operators} + that are applicable to @i{files} and directories. + ++@format + @group + @noindent + @w{ compile-file file-length open } +@@ -43,6 +44,7 @@ + @w{ Figure 20--1: File and Directory Operations } + + @end group ++@end format + + @menu + * Coercion of Streams to Pathnames:: +@@ -82,6 +84,7 @@ + Of these, the @i{functions} in Figure 20--2 treat @i{open} and + @i{closed} @i{streams} differently. + ++@format + @group + @noindent + @w{ delete-file file-author probe-file } +@@ -91,6 +94,7 @@ + @w{ Figure 20--2: File Functions that Treat Open and Closed Streams Differently} + + @end group ++@end format + + Since treatment of @i{open} @i{streams} by the @i{file system} + may vary considerably between @i{implementations}, however, +@@ -103,6 +107,7 @@ + In general, any code that is intended to be portable should + use such @i{functions} carefully. + ++@format + @group + @noindent + @w{ directory probe-file truename } +@@ -111,6 +116,7 @@ + @w{ Figure 20--3: File Functions where Closed Streams Might Work Best} + + @end group ++@end format + + @node Truenames, , File Operations on Open and Closed Streams, File System Concepts + @subsection Truenames +@@ -194,7 +200,7 @@ + @node directory, probe-file, Files Dictionary, Files Dictionary + @subsection directory [Function] + +-@code{directory} @i{pathspec {&key}} @result{} @i{pathnames} ++@code{directory} @i{pathspec @r{&key}} @result{} @i{pathnames} + + @subsubheading Arguments and Values:: + +@@ -246,7 +252,7 @@ + If the @i{pathspec} is not @i{wild}, + the resulting list will contain either zero or one elements. + +-@r{Common Lisp} specifies ``{&key}'' in the argument list to @b{directory} ++@r{Common Lisp} specifies ``@r{&key}'' in the argument list to @b{directory} + even though no @i{standardized} keyword arguments to @b{directory} are defined. + ``@t{:allow-other-keys t}'' + may be used in @i{conforming programs} in order to quietly ignore any +@@ -308,7 +314,7 @@ + @node ensure-directories-exist, truename, probe-file, Files Dictionary + @subsection ensure-directories-exist [Function] + +-@code{ensure-directories-exist} @i{pathspec {&key} verbose} @result{} @i{pathspec, created} ++@code{ensure-directories-exist} @i{pathspec @r{&key} verbose} @result{} @i{pathspec, created} + + @subsubheading Arguments and Values:: + +@@ -687,7 +693,7 @@ + + @subsubheading See Also:: + +-{file-error-pathname}, ++@r{file-error-pathname}, + @ref{open} + , + @ref{probe-file} +diff -uNr gcl-texi-orig/chap-21.texi gcl-texi/chap-21.texi +--- gcl-texi-orig/chap-21.texi 1994-07-16 18:03:06 +0400 ++++ gcl-texi/chap-21.texi 2002-10-17 20:53:05 +0400 +@@ -43,6 +43,7 @@ + Figure 21--1 provides a list of @i{standardized} operations + that are potentially useful with any kind of @i{stream}. + ++@format + @group + @noindent + @w{ close stream-element-type } +@@ -54,6 +55,7 @@ + @w{ Figure 21--1: Some General-Purpose Stream Operations} + + @end group ++@end format + + Other operations are only meaningful on certain @i{stream} @i{types}. + For example, @b{read-char} is only defined for @i{character} @i{streams} +@@ -92,6 +94,7 @@ + Figure 21--2 shows @i{operators} relating to + @i{input} @i{streams}. + ++@format + @group + @noindent + @w{ clear-input read-byte read-from-string } +@@ -103,10 +106,12 @@ + @w{ Figure 21--2: Operators relating to Input Streams. } + + @end group ++@end format + + Figure 21--3 shows @i{operators} relating to + @i{output} @i{streams}. + ++@format + @group + @noindent + @w{ clear-output prin1 write } +@@ -120,6 +125,7 @@ + @w{ Figure 21--3: Operators relating to Output Streams.} + + @end group ++@end format + + A @i{stream} that is both an @i{input} @i{stream} and an @i{output} @i{stream} + is called a @i{bidirectional} +@@ -134,6 +140,7 @@ + shows a list of @i{operators} that relate specificaly to + @i{bidirectional} @i{streams}. + ++@format + @group + @noindent + @w{ y-or-n-p yes-or-no-p } +@@ -142,6 +149,7 @@ + @w{ Figure 21--4: Operators relating to Bidirectional Streams.} + + @end group ++@end format + + @node Open and Closed Streams, Interactive Streams, Input, Introduction to Streams + @subsubsection Open and Closed Streams +@@ -235,6 +243,7 @@ + by this specification. Figure 21--5 shows some information + about these subclasses. + ++@format + @group + @noindent + @w{ Class Related Operators } +@@ -260,6 +269,7 @@ + @w{ Figure 21--5: Defined Names related to Specialized Streams} + + @end group ++@end format + + @node Stream Variables, Stream Arguments to Standardized Functions, Introduction to Streams, Stream Concepts + @subsection Stream Variables +@@ -277,6 +287,7 @@ + The consequences are undefined if at any time + the @i{value} of any of these @i{variables} is not an @i{open} @i{stream}. + ++@format + @group + @noindent + @w{ Glossary Term Variable Name } +@@ -292,6 +303,7 @@ + @w{ Figure 21--6: Standardized Stream Variables} + + @end group ++@end format + + Note that, by convention, @i{standardized} @i{stream variables} have names + ending in ``@t{-input*}'' if they must be @i{input} @i{streams}, +@@ -307,6 +319,7 @@ + The @i{operators} in Figure 21--7 accept @i{stream} @i{arguments} that + might be either @i{open} or @i{closed} @i{streams}. + ++@format + @group + @noindent + @w{ broadcast-stream-streams file-author pathnamep } +@@ -327,10 +340,12 @@ + @w{ Figure 21--7: Operators that accept either Open or Closed Streams } + + @end group ++@end format + + The @i{operators} in Figure 21--8 accept @i{stream} @i{arguments} that + must be @i{open} @i{streams}. + ++@format + @group + @noindent + @w{ clear-input output-stream-p read-char-no-hang } +@@ -356,6 +371,7 @@ + @w{ Figure 21--8: Operators that accept Open Streams only } + + @end group ++@end format + + @node Restrictions on Composite Streams, , Stream Arguments to Standardized Functions, Stream Concepts + @subsection Restrictions on Composite Streams +@@ -453,8 +469,8 @@ + + @ref{Stream Concepts}, + @ref{Printing Other Objects}, +-{@ref{Printer}}, +-{@ref{Reader}} ++@ref{Printer}, ++@ref{Reader} + + @node broadcast-stream, concatenated-stream, stream, Streams Dictionary + @subsection broadcast-stream [System Class] +@@ -607,7 +623,7 @@ + + @subsubheading See Also:: + +-@ref{echo-stream-input-stream; echo-stream-output-stream} ++@ref{echo-stream-input-stream} + , + @b{echo-stream-output-stream}, + @ref{make-echo-stream} +@@ -710,7 +726,7 @@ + + @ref{make-two-way-stream} + , +-@ref{two-way-stream-input-stream; two-way-stream-output-stream} ++@ref{two-way-stream-input-stream} + , + @b{two-way-stream-output-stream} + +@@ -908,7 +924,7 @@ + @node read-byte, write-byte, streamp, Streams Dictionary + @subsection read-byte [Function] + +-@code{read-byte} @i{stream {&optional} eof-error-p eof-value} @result{} @i{byte} ++@code{read-byte} @i{stream @r{&optional} eof-error-p eof-value} @result{} @i{byte} + + @subsubheading Arguments and Values:: + +@@ -1022,7 +1038,7 @@ + @node peek-char, read-char, write-byte, Streams Dictionary + @subsection peek-char [Function] + +-@code{peek-char} @i{{&optional} peek-type input-stream eof-error-p ++@code{peek-char} @i{@r{&optional} peek-type input-stream eof-error-p + eof-value recursive-p} @result{} @i{char} + + @subsubheading Arguments and Values:: +@@ -1074,9 +1090,9 @@ + If an @i{end of file}_2 occurs and @i{eof-error-p} is @i{false}, + @i{eof-value} is returned. + +-{ }{If @i{recursive-p} is @i{true}, ++If @i{recursive-p} is @i{true}, + this call is expected to be embedded in a higher-level call to @b{read} +-or a similar @i{function} used by the @i{Lisp reader}.} ++or a similar @i{function} used by the @i{Lisp reader}. + + When @i{input-stream} is an @i{echo stream}, + characters that are only peeked at are not echoed. In the +@@ -1119,7 +1135,7 @@ + @node read-char, read-char-no-hang, peek-char, Streams Dictionary + @subsection read-char [Function] + +-@code{read-char} @i{{&optional} input-stream eof-error-p eof-value recursive-p} @result{} @i{char} ++@code{read-char} @i{@r{&optional} input-stream eof-error-p eof-value recursive-p} @result{} @i{char} + + @subsubheading Arguments and Values:: + +@@ -1150,9 +1166,9 @@ + and hence are assumed to have been echoed + already by a previous call to @b{read-char}. + +-{ }{If @i{recursive-p} is @i{true}, ++If @i{recursive-p} is @i{true}, + this call is expected to be embedded in a higher-level call to @b{read} +-or a similar @i{function} used by the @i{Lisp reader}.} ++or a similar @i{function} used by the @i{Lisp reader}. + + If an @i{end of file}_2 occurs and @i{eof-error-p} is @i{false}, + @i{eof-value} is returned. +@@ -1188,7 +1204,7 @@ + + @ref{write-char} + , +-@ref{read; read-preserving-whitespace} ++@ref{read} + + @subsubheading Notes:: + The corresponding output function is @b{write-char}. +@@ -1196,7 +1212,7 @@ + @node read-char-no-hang, terpri, read-char, Streams Dictionary + @subsection read-char-no-hang [Function] + +-@code{read-char-no-hang} @i{{&optional} input-stream eof-error-p ++@code{read-char-no-hang} @i{@r{&optional} input-stream eof-error-p + eof-value recursive-p} @result{} @i{char} + + @subsubheading Arguments and Values:: +@@ -1221,9 +1237,9 @@ + from @i{input-stream} if such a character is available. If no character + is available, @b{read-char-no-hang} returns @b{nil}. + +-{ }{If @i{recursive-p} is @i{true}, ++If @i{recursive-p} is @i{true}, + this call is expected to be embedded in a higher-level call to @b{read} +-or a similar @i{function} used by the @i{Lisp reader}.} ++or a similar @i{function} used by the @i{Lisp reader}. + + If an @i{end of file}_2 occurs and @i{eof-error-p} is @i{false}, + @i{eof-value} is returned. +@@ -1248,7 +1264,7 @@ + ;; interactive input on the console, and where that Newline remains + ;; on the input stream. + (test-it) +-@t{ |> } @b{|>>}@t{a{@i{[<--}~]}}@b{<<|} ++@t{ |> } @b{|>>}@t{a@r{@i{[<--}~]}}@b{<<|} + @result{} (#\a #\Newline NIL) + @end example + +@@ -1276,9 +1292,9 @@ + @node terpri, unread-char, read-char-no-hang, Streams Dictionary + @subsection terpri, fresh-line [Function] + +-@code{terpri} @i{{&optional} output-stream} @result{} @i{@b{nil}} ++@code{terpri} @i{@r{&optional} output-stream} @result{} @i{@b{nil}} + +-@code{fresh-line} @i{{&optional} output-stream} @result{} @i{generalized-boolean} ++@code{fresh-line} @i{@r{&optional} output-stream} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -1343,7 +1359,7 @@ + @node unread-char, write-char, terpri, Streams Dictionary + @subsection unread-char [Function] + +-@code{unread-char} @i{character {&optional} input-stream} @result{} @i{@b{nil}} ++@code{unread-char} @i{character @r{&optional} input-stream} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -1416,7 +1432,7 @@ + @node write-char, read-line, unread-char, Streams Dictionary + @subsection write-char [Function] + +-@code{write-char} @i{character {&optional} output-stream} @result{} @i{character} ++@code{write-char} @i{character @r{&optional} output-stream} @result{} @i{character} + + @subsubheading Arguments and Values:: + +@@ -1462,7 +1478,7 @@ + @node read-line, write-string, write-char, Streams Dictionary + @subsection read-line [Function] + +-@code{read-line} @i{{&optional} input-stream eof-error-p eof-value recursive-p}@* ++@code{read-line} @i{@r{&optional} input-stream eof-error-p eof-value recursive-p}@* + @result{} @i{line, missing-newline-p} + + @subsubheading Arguments and Values:: +@@ -1488,9 +1504,9 @@ + Reads from @i{input-stream} a line of text + that is terminated by a @i{newline} or @i{end of file}. + +-{ }{If @i{recursive-p} is @i{true}, ++If @i{recursive-p} is @i{true}, + this call is expected to be embedded in a higher-level call to @b{read} +-or a similar @i{function} used by the @i{Lisp reader}.} ++or a similar @i{function} used by the @i{Lisp reader}. + + The @i{primary value}, @i{line}, is the line that is read, + represented as a @i{string} (without the trailing @i{newline}, if any). +@@ -1533,7 +1549,7 @@ + + @subsubheading See Also:: + +-@ref{read; read-preserving-whitespace} ++@ref{read} + + @subsubheading Notes:: + +@@ -1542,9 +1558,9 @@ + @node write-string, read-sequence, read-line, Streams Dictionary + @subsection write-string, write-line [Function] + +-@code{write-string} @i{string {&optional} output-stream {&key} start end} @result{} @i{string} ++@code{write-string} @i{string @r{&optional} output-stream @r{&key} start end} @result{} @i{string} + +-@code{write-line} @i{string {&optional} output-stream {&key} start end} @result{} @i{string} ++@code{write-line} @i{string @r{&optional} output-stream @r{&key} start end} @result{} @i{string} + + @subsubheading Arguments and Values:: + +@@ -1609,7 +1625,7 @@ + @node read-sequence, write-sequence, write-string, Streams Dictionary + @subsection read-sequence [Function] + +-@code{read-sequence} @i{sequence stream {&key} start end} @result{} @i{position} ++@code{read-sequence} @i{sequence stream @r{&key} start end} @result{} @i{position} + + @i{sequence}---a @i{sequence}. + +@@ -1681,7 +1697,7 @@ + @node write-sequence, file-length, read-sequence, Streams Dictionary + @subsection write-sequence [Function] + +-@code{write-sequence} @i{sequence stream {&key} start end} @result{} @i{sequence} ++@code{write-sequence} @i{sequence stream @r{&key} start end} @result{} @i{sequence} + + @i{sequence}---a @i{sequence}. + +@@ -1726,7 +1742,7 @@ + @ref{Compiler Terminology}, + @ref{read-sequence} + , +-@ref{write-string; write-line} ++@ref{write-string} + , + @b{write-line} + +@@ -1922,7 +1938,7 @@ + @node open, stream-external-format, file-string-length, Streams Dictionary + @subsection open [Function] + +-@code{open} @i{filespec {&key} direction element-type ++@code{open} @i{filespec @r{&key} direction element-type + if-exists if-does-not-exist + external-format}@* + @result{} @i{stream} +@@ -2252,9 +2268,9 @@ + + @subsubheading Syntax:: + +-@code{with-open-file} @i{@r{(}stream filespec @{@i{options}@}{*}@r{)} +- @{@i{declaration}@}{*} +- @{@i{form}@}{*}}@* ++@code{with-open-file} @i{@r{(}stream filespec @{@i{options}@}*@r{)} ++ @{@i{declaration}@}* ++ @{@i{form}@}*}@* + @result{} @i{results} + + @subsubheading Arguments and Values:: +@@ -2367,7 +2383,7 @@ + @node close, with-open-stream, with-open-file, Streams Dictionary + @subsection close [Function] + +-@code{close} @i{stream {&key} abort} @result{} @i{result} ++@code{close} @i{stream @r{&key} abort} @result{} @i{result} + + @subsubheading Arguments and Values:: + +@@ -2440,9 +2456,9 @@ + @subsection with-open-stream [Macro] + + @code{with-open-stream} @i{@r{(}var stream@r{)} +- @{@i{declaration}@}{*} +- @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* ++ @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2492,7 +2508,7 @@ + @node listen, clear-input, with-open-stream, Streams Dictionary + @subsection listen [Function] + +-@code{listen} @i{{&optional} input-stream} @result{} @i{generalized-boolean} ++@code{listen} @i{@r{&optional} input-stream} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -2536,7 +2552,7 @@ + @node clear-input, finish-output, listen, Streams Dictionary + @subsection clear-input [Function] + +-@code{clear-input} @i{{&optional} input-stream} @result{} @i{@b{nil}} ++@code{clear-input} @i{@r{&optional} input-stream} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -2606,11 +2622,11 @@ + @node finish-output, y-or-n-p, clear-input, Streams Dictionary + @subsection finish-output, force-output, clear-output [Function] + +-@code{finish-output} @i{{&optional} output-stream} @result{} @i{@b{nil}} ++@code{finish-output} @i{@r{&optional} output-stream} @result{} @i{@b{nil}} + +-@code{force-output} @i{{&optional} output-stream} @result{} @i{@b{nil}} ++@code{force-output} @i{@r{&optional} output-stream} @result{} @i{@b{nil}} + +-@code{clear-output} @i{{&optional} output-stream} @result{} @i{@b{nil}} ++@code{clear-output} @i{@r{&optional} output-stream} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -2666,9 +2682,9 @@ + @node y-or-n-p, make-synonym-stream, finish-output, Streams Dictionary + @subsection y-or-n-p, yes-or-no-p [Function] + +-@code{y-or-n-p} @i{{&optional} control {&rest} arguments} @result{} @i{generalized-boolean} ++@code{y-or-n-p} @i{@r{&optional} control @r{&rest} arguments} @result{} @i{generalized-boolean} + +-@code{yes-or-no-p} @i{{&optional} control {&rest} arguments} @result{} @i{generalized-boolean} ++@code{yes-or-no-p} @i{@r{&optional} control @r{&rest} arguments} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -2823,7 +2839,7 @@ + @node make-broadcast-stream, make-two-way-stream, broadcast-stream-streams, Streams Dictionary + @subsection make-broadcast-stream [Function] + +-@code{make-broadcast-stream} @i{{&rest} streams} @result{} @i{broadcast-stream} ++@code{make-broadcast-stream} @i{@r{&rest} streams} @result{} @i{broadcast-stream} + + @subsubheading Arguments and Values:: + +@@ -2975,7 +2991,7 @@ + + @subsubheading See Also:: + +-@ref{echo-stream-input-stream; echo-stream-output-stream} ++@ref{echo-stream-input-stream} + , + @b{echo-stream-output-stream}, + @ref{make-two-way-stream} +@@ -3004,7 +3020,7 @@ + @node make-concatenated-stream, get-output-stream-string, concatenated-stream-streams, Streams Dictionary + @subsection make-concatenated-stream [Function] + +-@code{make-concatenated-stream} @i{{&rest} input-streams} @result{} @i{concatenated-stream} ++@code{make-concatenated-stream} @i{@r{&rest} input-streams} @result{} @i{concatenated-stream} + + @subsubheading Arguments and Values:: + +@@ -3083,7 +3099,7 @@ + @node make-string-input-stream, make-string-output-stream, get-output-stream-string, Streams Dictionary + @subsection make-string-input-stream [Function] + +-@code{make-string-input-stream} @i{string {&optional} start end} @result{} @i{string-stream} ++@code{make-string-input-stream} @i{string @r{&optional} start end} @result{} @i{string-stream} + + @subsubheading Arguments and Values:: + +@@ -3121,7 +3137,7 @@ + @node make-string-output-stream, with-input-from-string, make-string-input-stream, Streams Dictionary + @subsection make-string-output-stream [Function] + +-@code{make-string-output-stream} @i{{&key} element-type} @result{} @i{string-stream} ++@code{make-string-output-stream} @i{@r{&key} element-type} @result{} @i{string-stream} + + @subsubheading Arguments and Values:: + +@@ -3163,10 +3179,10 @@ + @node with-input-from-string, with-output-to-string, make-string-output-stream, Streams Dictionary + @subsection with-input-from-string [Macro] + +-@code{with-input-from-string} @i{@r{(}var string {&key} index start end@r{)} +- @{@i{declaration}@}{*} +- @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{with-input-from-string} @i{@r{(}var string @r{&key} index start end@r{)} ++ @{@i{declaration}@}* ++ @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -3252,10 +3268,10 @@ + @node with-output-to-string, *debug-io*, with-input-from-string, Streams Dictionary + @subsection with-output-to-string [Macro] + +-@code{with-output-to-string} @i{@r{(}var {&optional} string-form {&key} element-type@r{)} +- @{@i{declaration}@}{*} +- @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{with-output-to-string} @i{@r{(}var @r{&optional} string-form @r{&key} element-type@r{)} ++ @{@i{declaration}@}* ++ @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -3449,11 +3465,11 @@ + @b{synonym-stream}, + @ref{Time} + , +-@ref{trace; untrace} ++@ref{trace} + , +-{@ref{Conditions}}, +-{@ref{Reader}}, +-{@ref{Printer}} ++@ref{Conditions}, ++@ref{Reader}, ++@ref{Printer} + + @subsubheading Notes:: + +diff -uNr gcl-texi-orig/chap-22.texi gcl-texi/chap-22.texi +--- gcl-texi-orig/chap-22.texi 1994-07-16 18:03:05 +0400 ++++ gcl-texi/chap-22.texi 2002-10-17 22:10:07 +0400 +@@ -86,6 +86,7 @@ + Figure 22--1 shows the @i{standardized} @i{printer control variables}; + there might also be @i{implementation-defined} @i{printer control variables}. + ++@format + @group + @noindent + @w{ *print-array* *print-gensym* *print-pprint-dispatch* } +@@ -98,11 +99,13 @@ + @w{ Figure 22--1: Standardized Printer Control Variables } + + @end group ++@end format + + In addition to the @i{printer control variables}, + the following additional @i{defined names} + relate to or affect the behavior of the @i{Lisp printer}: + ++@format + @group + @noindent + @w{ *package* *read-eval* readtable-case } +@@ -112,6 +115,7 @@ + @w{ Figure 22--2: Additional Influences on the Lisp printer. } + + @end group ++@end format + + @node Printer Escaping, , Multiple Possible Textual Representations, Overview of The Lisp Printer + @subsubsection Printer Escaping +@@ -222,7 +226,7 @@ + + @IRindex{float} + +-If the magnitude of the @i{float} is either zero or between 10^{-3} (inclusive) ++If the magnitude of the @i{float} is either zero or between 10^@r{-3} (inclusive) + and 10^7 (exclusive), it is printed as the integer part of the number, + then a decimal point, + followed by the fractional part of the number; +@@ -238,7 +242,7 @@ + For example, the base of the natural logarithms as a @i{short float} + might be printed as @t{2.71828S0}. + +-For non-zero magnitudes outside of the range 10^{-3} to 10^7, ++For non-zero magnitudes outside of the range 10^@r{-3} to 10^7, + a @i{float} is printed in computerized scientific notation. + The representation of the number is scaled to be between + 1 (inclusive) and 10 (exclusive) and then printed, with one digit +@@ -815,7 +819,7 @@ + the default notation for structures is: + + @example +- #S(@i{structure-name} @{@i{slot-key} @i{slot-value}@}{*}) ++ #S(@i{structure-name} @{@i{slot-key} @i{slot-value}@}*) + @end example + + where @t{#S} indicates structure syntax, +@@ -918,7 +922,7 @@ + @menu + * Pretty Printer Concepts:: + * Examples of using the Pretty Printer:: +-* Notes about the Pretty Printer's Background:: ++* Notes about the Pretty Printer`s Background:: + @end menu + + @node Pretty Printer Concepts, Examples of using the Pretty Printer, The Lisp Pretty Printer, The Lisp Pretty Printer +@@ -1034,6 +1038,7 @@ + arrangement of output is provided through the functions and macros of the + pretty printer. Figure 22--3 shows the defined names related to @i{pretty printing}. + ++@format + @group + @noindent + @w{ *print-lines* pprint-dispatch pprint-pop } +@@ -1048,11 +1053,13 @@ + @w{ Figure 22--3: Defined names related to pretty printing. } + + @end group ++@end format + + Figure 22--4 identifies a set of @i{format directives} which serve + as an alternate interface to the same pretty printing operations in a + more textually compact form. + ++@format + @group + @noindent + @w{ @t{~I} @t{~W} @t{~<...~:>} } +@@ -1062,6 +1069,7 @@ + @w{ Figure 22--4: Format directives related to Pretty Printing} + + @end group ++@end format + + @node Compiling Format Strings, Pretty Print Dispatch Tables, Format Directive Interface, Pretty Printer Concepts + @subsubsection Compiling Format Strings +@@ -1127,7 +1135,7 @@ + the left margin is assumed to be zero. + The right margin is controlled by @b{*print-right-margin*}. + +-@node Examples of using the Pretty Printer, Notes about the Pretty Printer's Background, Pretty Printer Concepts, The Lisp Pretty Printer ++@node Examples of using the Pretty Printer, Notes about the Pretty Printer`s Background, Pretty Printer Concepts, The Lisp Pretty Printer + @subsection Examples of using the Pretty Printer + + As an example of the interaction of logical blocks, conditional newlines, +@@ -1347,7 +1355,7 @@ + (format T "~:<~W ~@@_~:I~W ~:_~W~1I ~_~W~:>" list)) + + (defun pprint-let (*standard-output* list) +- (format T "~:<~W~{@t{^}}~:<~@@@{~:<~@@@{~W~{@t{^}}~_~@}~:>~{@t{^}}~:_~@}~:>~1I~@@@{~{@t{^}}~_~W~@}~:>" list)) ++ (format T "~:<~W~@t{^}~:<~@@@{~:<~@@@{~W~@t{^}~_~@}~:>~@t{^}~:_~@}~:>~1I~@@@{~@t{^}~_~W~@}~:>" list)) + @end example + + In the following example, the first @i{form} restores +@@ -1459,8 +1467,8 @@ + its @b{print-object} @i{method} + is used instead. + +-@node Notes about the Pretty Printer's Background, , Examples of using the Pretty Printer, The Lisp Pretty Printer +-@subsection Notes about the Pretty Printer's Background ++@node Notes about the Pretty Printer`s Background, , Examples of using the Pretty Printer, The Lisp Pretty Printer ++@subsection Notes about the Pretty Printer`s Background + + For a background reference to the abstract concepts detailed in this + section, see @i{XP: A Common Lisp Pretty Printing System}. The details of that paper are not binding on +@@ -1535,6 +1543,7 @@ + + Examples of @i{format strings}: + ++@format + @group + @noindent + @w{ @t{"~S"} ;This is an S directive with no parameters or modifiers. } +@@ -1547,6 +1556,7 @@ + @w{ Figure 22--5: Examples of format control strings } + + @end group ++@end format + + @b{format} sends the output to @i{destination}. + If @i{destination} is @b{nil}, +@@ -1647,7 +1657,7 @@ + this fact is mentioned. For example, + + @example +- (format nil "~:@@C" #\Control-Partial) @result{} "Control-{\partial} (Top-F)" ++ (format nil "~:@@C" #\Control-Partial) @result{} "Control-\partial (Top-F)" + @end example + + This is the format used for telling the user about a key he is expected to type, +@@ -1902,7 +1912,7 @@ + If both @i{w} and @i{d} are omitted, then the effect is to print + the value using ordinary free-format output; @b{prin1} uses this format + for any number whose magnitude is either zero or between +-10^{-3} (inclusive) and 10^7 (exclusive). ++10^@r{-3} (inclusive) and 10^7 (exclusive). + + If @i{w} is omitted, then if the magnitude of @i{arg} is so large (or, if + @i{d} is also omitted, so small) that more than 100 digits would have to +@@ -2020,7 +2030,7 @@ + a similar + + format for any non-zero number whose magnitude +-is less than 10^{-3} or greater than or equal to 10^7. ++is less than 10^@r{-3} or greater than or equal to 10^7. + + The only difference is that the @t{~E} + directive always prints a plus or minus sign in front of the +@@ -2057,7 +2067,7 @@ + The full form is @t{~@i{w},@i{d},@i{e},@i{k},@i{overflowchar},@i{padchar},@i{exponentchar}G}. + The format in which to print @i{arg} depends on the magnitude (absolute + value) of the @i{arg}. Let @i{n} be an integer such that +-10^{{n}-1} \le |@i{arg}| < 10^@i{n}. ++10^@r{@r{n}-1} \le |@i{arg}| < 10^@i{n}. + Let @i{ee} equal @i{e}+2, or 4 if @i{e} is omitted. + Let @i{ww} equal @i{w}- @i{ee}, + or @b{nil} if @i{w} is omitted. If @i{d} is omitted, first let @i{q} +@@ -2263,7 +2273,7 @@ + Elements are extracted from this list using @b{pprint-pop}, + thereby providing automatic support for malformed lists, and the detection + of circularity, sharing, and length abbreviation. +-Within the body segment, @t{~{@t{^}}} acts like @b{pprint-exit-if-list-exhausted}. ++Within the body segment, @t{~@t{^}} acts like @b{pprint-exit-if-list-exhausted}. + + @t{~<...~:>} supports a feature not supported by @b{pprint-logical-block}. + If @t{~:@@>} is used to terminate the directive (@i{i.e.}, @t{~<...~:@@>}), +@@ -2599,7 +2609,7 @@ + @node Tilde Left-Brace-> Iteration, Tilde Right-Brace-> End of Iteration, Tilde Right-Bracket-> End of Conditional Expression, FORMAT Control-Flow Operations + @subsubsection Tilde Left-Brace: Iteration + +-@t{~@{{@i{str}}~@}} ++@t{~@{@i{str}~@}} + + This is an iteration construct. The argument should be a @i{list}, + which is used as a set of arguments +@@ -2837,7 +2847,7 @@ + @node Tilde Circumflex-> Escape Upward, Tilde Newline-> Ignored Newline, Tilde Semicolon-> Clause Separator, FORMAT Miscellaneous Pseudo-Operations + @subsubsection Tilde Circumflex: Escape Upward + +-{@t{~@t{^} }} ++@t{~@t{^} } + + This is an escape construct. If there are no more arguments remaining to + be processed, then the immediately +@@ -2851,16 +2861,16 @@ + construct. + + @example +- (setq donestr "Done.~{@t{^}} ~D warning~:P.~{@t{^}} ~D error~:P.") +-@result{} "Done.~{@t{^}} ~D warning~:P.~{@t{^}} ~D error~:P." ++ (setq donestr "Done.~@t{^} ~D warning~:P.~@t{^} ~D error~:P.") ++@result{} "Done.~@t{^} ~D warning~:P.~@t{^} ~D error~:P." + (format nil donestr) @result{} "Done." + (format nil donestr 3) @result{} "Done. 3 warnings." + (format nil donestr 1 5) @result{} "Done. 1 warning. 5 errors." + @end example + + If a prefix parameter is given, then termination occurs if the parameter +-is zero. (Hence @t{~{@t{^}}} is equivalent to +-@t{~#{@t{^}}}.) If two ++is zero. (Hence @t{~@t{^}} is equivalent to ++@t{~#@t{^}}.) If two + parameters are given, termination occurs if they are equal. + + [Reviewer Note by Barmar: Which equality predicate?] If three +@@ -2869,14 +2879,14 @@ + Of course, this is useless if all the prefix parameters are constants; at + least one of them should be a @t{#} or a @t{V} parameter. + +-If @t{~{@t{^}}} is used within a @t{~:@{ } ++If @t{~@t{^}} is used within a @t{~:@{ } + construct, then it terminates + the current iteration step because in the standard case it tests for + remaining arguments of the current step only; the next iteration step +-commences immediately. @t{~:{@t{^}}} is used to terminate ++commences immediately. @t{~:@t{^}} is used to terminate + the iteration process. + +-@t{~:{@t{^}}} ++@t{~:@t{^}} + may be used only if the command it would terminate is + @t{~:@{ } or @t{~:@@@{ }. + The entire iteration process is terminated if and only if the sublist that is +@@ -2884,8 +2894,8 @@ + the case of @t{~:@{ }, + or the last @b{format} + argument in the case of @t{~:@@@{ }. +-@t{~:{@t{^}}} is not +-equivalent to @t{~#:{@t{^}}}; ++@t{~:@t{^}} is not ++equivalent to @t{~#:@t{^}}; + the latter terminates the entire iteration if and only if no + arguments remain for the current iteration step. + For example: +@@ -2894,7 +2904,7 @@ + (format nil "~:@{ ~@@?~:@t{^} ...~@} " '(("a") ("b"))) @result{} "a...b" + @end example + +-If @t{~{@t{^}}} appears within a control string being processed ++If @t{~@t{^}} appears within a control string being processed + under the control of a @t{~?} directive, but not within + any @t{~@{ } or @t{~<} construct within that string, + then the string being +@@ -2903,9 +2913,9 @@ + continues within the string + containing the @t{~?} directive at the point following that directive. + +-If @t{~{@t{^}}} ++If @t{~@t{^}} + appears within a @t{~[} or @t{~(} construct, +-then all the commands up to the @t{~{@t{^}}} are properly selected ++then all the commands up to the @t{~@t{^}} are properly selected + or case-converted, + the @t{~[} or @t{~(} processing is terminated, + and the outward search continues +@@ -2913,22 +2923,22 @@ + to be terminated. For example: + + @example +- (setq tellstr "~@@(~@@[~R~]~{@t{^}} ~A!~)") +-@result{} "~@@(~@@[~R~]~{@t{^}} ~A!~)" ++ (setq tellstr "~@@(~@@[~R~]~@t{^} ~A!~)") ++@result{} "~@@(~@@[~R~]~@t{^} ~A!~)" + (format nil tellstr 23) @result{} "Twenty-three!" + (format nil tellstr nil "losers") @result{} " Losers!" + (format nil tellstr 23 "losers") @result{} "Twenty-three losers!" + @end example + +-Following are examples of the use of @t{~{@t{^}}} ++Following are examples of the use of @t{~@t{^}} + within a @t{~<} construct. + + @example +- (format nil "~15<~S~;~{@t{^}}~S~;~{@t{^}}~S~>" 'foo) ++ (format nil "~15<~S~;~@t{^}~S~;~@t{^}~S~>" 'foo) + @result{} " FOO" +- (format nil "~15<~S~;~{@t{^}}~S~;~{@t{^}}~S~>" 'foo 'bar) ++ (format nil "~15<~S~;~@t{^}~S~;~@t{^}~S~>" 'foo 'bar) + @result{} "FOO BAR" +- (format nil "~15<~S~;~{@t{^}}~S~;~{@t{^}}~S~>" 'foo 'bar 'baz) ++ (format nil "~15<~S~;~@t{^}~S~;~@t{^}~S~>" 'foo 'bar 'baz) + @result{} "FOO BAR BAZ" + @end example + +@@ -3149,7 +3159,7 @@ + Note that the meaning of @b{nil} and @b{t} as destinations to @b{format} + are different than those of @b{nil} and @b{t} as @i{stream designators}. + +-The @t{~{@t{^}}} should appear only at the beginning of a @t{~<} clause, ++The @t{~@t{^}} should appear only at the beginning of a @t{~<} clause, + because it aborts the entire clause in which it appears (as well as + all following clauses). + +@@ -3197,7 +3207,7 @@ + @node copy-pprint-dispatch, formatter, Printer Dictionary, Printer Dictionary + @subsection copy-pprint-dispatch [Function] + +-@code{copy-pprint-dispatch} @i{{&optional} table} @result{} @i{new-table} ++@code{copy-pprint-dispatch} @i{@r{&optional} table} @result{} @i{new-table} + + @subsubheading Arguments and Values:: + +@@ -3267,7 +3277,7 @@ + @node pprint-dispatch, pprint-exit-if-list-exhausted, formatter, Printer Dictionary + @subsection pprint-dispatch [Function] + +-@code{pprint-dispatch} @i{object {&optional} table} @result{} @i{function, found-p} ++@code{pprint-dispatch} @i{object @r{&optional} table} @result{} @i{function, found-p} + + @subsubheading Arguments and Values:: + +@@ -3361,11 +3371,11 @@ + @node pprint-fill, pprint-indent, pprint-exit-if-list-exhausted, Printer Dictionary + @subsection pprint-fill, pprint-linear, pprint-tabular [Function] + +-@code{pprint-fill} @i{stream object {&optional} colon-p at-sign-p} @result{} @i{@b{nil}} ++@code{pprint-fill} @i{stream object @r{&optional} colon-p at-sign-p} @result{} @i{@b{nil}} + +-@code{pprint-linear} @i{stream object {&optional} colon-p at-sign-p} @result{} @i{@b{nil}} ++@code{pprint-linear} @i{stream object @r{&optional} colon-p at-sign-p} @result{} @i{@b{nil}} + +-@code{pprint-tabular} @i{stream object {&optional} colon-p at-sign-p tabsize} @result{} @i{@b{nil}} ++@code{pprint-tabular} @i{stream object @r{&optional} colon-p at-sign-p tabsize} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -3467,7 +3477,7 @@ + @node pprint-indent, pprint-logical-block, pprint-fill, Printer Dictionary + @subsection pprint-indent [Function] + +-@code{pprint-indent} @i{relative-to n {&optional} stream} @result{} @i{@b{nil}} ++@code{pprint-indent} @i{relative-to n @r{&optional} stream} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -3521,8 +3531,8 @@ + @subsection pprint-logical-block [Macro] + + @code{pprint-logical-block} @i{@r{(}stream-symbol object +- {&key} prefix per-line-prefix suffix@r{)} +- @{@i{declaration}@}{*} @{@i{form}@}{*}}@* ++ @r{&key} prefix per-line-prefix suffix@r{)} ++ @{@i{declaration}@}* @{@i{form}@}*}@* + @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: +@@ -3663,7 +3673,7 @@ + @node pprint-newline, pprint-pop, pprint-logical-block, Printer Dictionary + @subsection pprint-newline [Function] + +-@code{pprint-newline} @i{kind {&optional} stream} @result{} @i{@b{nil}} ++@code{pprint-newline} @i{kind @r{&optional} stream} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -3888,7 +3898,7 @@ + @node pprint-tab, print-object, pprint-pop, Printer Dictionary + @subsection pprint-tab [Function] + +-@code{pprint-tab} @i{kind colnum colinc {&optional} stream} @result{} @i{@b{nil}} ++@code{pprint-tab} @i{kind colnum colinc @r{&optional} stream} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -4064,13 +4074,13 @@ + + @subsubheading See Also:: + +-@ref{pprint-fill; pprint-linear; pprint-tabular} ++@ref{pprint-fill} + , + @ref{pprint-logical-block} + , + @ref{pprint-pop} + , +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + , + @b{*print-readably*}, + @b{*print-escape*}, +@@ -4086,7 +4096,7 @@ + @node print-unreadable-object, set-pprint-dispatch, print-object, Printer Dictionary + @subsection print-unreadable-object [Macro] + +-@code{print-unreadable-object} @i{@r{(}object stream {&key} type identity@r{)} @{@i{form}@}{*}} @result{} @i{@b{nil}} ++@code{print-unreadable-object} @i{@r{(}object stream @r{&key} type identity@r{)} @{@i{form}@}*} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -4144,7 +4154,7 @@ + @node set-pprint-dispatch, write, print-unreadable-object, Printer Dictionary + @subsection set-pprint-dispatch [Function] + +-@code{set-pprint-dispatch} @i{type-specifier function {&optional} priority table} @result{} @i{@b{nil}} ++@code{set-pprint-dispatch} @i{type-specifier function @r{&optional} priority table} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -4208,16 +4218,16 @@ + @node write, write-to-string, set-pprint-dispatch, Printer Dictionary + @subsection write, prin1, print, pprint, princ [Function] + +-@code{write} @i{@i{object} {&key} \writekeys{stream}}@* ++@code{write} @i{@i{object} @r{&key} \writekeys@r{stream}}@* + @result{} @i{object} + +-@code{prin} @i{1} @result{} @i{object {&optional} output-stream} +- {object} +-@code{princ} @i{object {&optional} output-stream} @result{} @i{object} ++@code{prin} @i{1} @result{} @i{object @r{&optional} output-stream} ++ @r{object} ++@code{princ} @i{object @r{&optional} output-stream} @result{} @i{object} + +-@code{print} @i{object {&optional} output-stream} @result{} @i{object} ++@code{print} @i{object @r{&optional} output-stream} @result{} @i{object} + +-@code{pprint} @i{object {&optional} output-stream} @result{} @i{<@i{no @i{values}}>} ++@code{pprint} @i{object @r{&optional} output-stream} @result{} @i{<@i{no @i{values}}>} + + @subsubheading Arguments and Values:: + +@@ -4226,7 +4236,7 @@ + @i{output-stream}---an @i{output} @i{stream designator}. + The default is @i{standard output}. + +-\writekeydescriptions{@i{stream}---an @i{output} @i{stream designator}. ++\writekeydescriptions@r{@i{stream}---an @i{output} @i{stream designator}. + The default is @i{standard output}.} + + @subsubheading Description:: +@@ -4244,6 +4254,7 @@ + Once the appropriate @i{bindings} are @i{established}, + the @i{object} is output by the @i{Lisp printer}. + ++@format + @group + @noindent + @w{ Parameter Corresponding Dynamic Variable } +@@ -4267,6 +4278,7 @@ + @w{ Figure 22--6: Argument correspondences for the WRITE function.} + + @end group ++@end format + + @b{prin1}, @b{princ}, @b{print}, and @b{pprint} implicitly + @i{bind} certain print parameters to particular values. The remaining parameter +@@ -4364,11 +4376,11 @@ + @node write-to-string, *print-array*, write, Printer Dictionary + @subsection write-to-string, prin1-to-string, princ-to-string [Function] + +-@code{write-to-string} @i{object {&key} \writekeys{}}@* ++@code{write-to-string} @i{object @r{&key} \writekeys}@* + @result{} @i{string} + + @code{prin} @i{1} @result{} @i{-to-string} +- {object} {string} ++ @r{object} @r{string} + + @code{princ-to-string} @i{object} @result{} @i{string} + +@@ -4376,7 +4388,7 @@ + + @i{object}---an @i{object}. + +-\writekeydescriptions{} ++\writekeydescriptions + + @i{string}---a @i{string}. + +@@ -4433,14 +4445,14 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + + @subsubheading Notes:: + + @example +- (write-to-string @i{object} @{@i{key} @i{argument}@}{*}) ++ (write-to-string @i{object} @{@i{key} @i{argument}@}*) + @equiv{} (with-output-to-string (#1=#:string-stream) +- (write object :stream #1# @{@i{key} @i{argument}@}{*})) ++ (write object :stream #1# @{@i{key} @i{argument}@}*)) + + (princ-to-string @i{object}) + @equiv{} (with-output-to-string (string-stream) +@@ -4554,9 +4566,9 @@ + + @ref{format} + , +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + , +-@ref{write-to-string; prin1-to-string; princ-to-string} ++@ref{write-to-string} + + @node *print-case*, *print-circle*, *print-base*, Printer Dictionary + @subsection *print-case* [Variable] +@@ -4606,7 +4618,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + + @subsubheading Notes:: + +@@ -4685,7 +4697,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + + @subsubheading Notes:: + +@@ -4733,7 +4745,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + , + @ref{readtable-case} + +@@ -4771,7 +4783,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + , @b{*print-escape*} + + @node *print-level*, *print-lines*, *print-gensym*, Printer Dictionary +@@ -4862,7 +4874,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + + @node *print-lines*, *print-miser-width*, *print-level*, Printer Dictionary + @subsection *print-lines* [Variable] +@@ -5027,7 +5039,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + + @node *print-readably*, *print-right-margin*, *print-pretty*, Printer Dictionary + @subsection *print-readably* [Variable] +@@ -5129,7 +5141,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + , + @ref{print-unreadable-object} + +@@ -5217,7 +5229,7 @@ + @node format, , print-not-readable-object, Printer Dictionary + @subsection format [Function] + +-@code{format} @i{destination control-string {&rest} args} @result{} @i{result} ++@code{format} @i{destination control-string @r{&rest} args} @result{} @i{result} + + @subsubheading Arguments and Values:: + +@@ -5275,7 +5287,7 @@ + + @subsubheading See Also:: + +-@ref{write; prin1; print; pprint; princ} ++@ref{write} + , + @ref{Documentation of Implementation-Defined Scripts} + +diff -uNr gcl-texi-orig/chap-23.texi gcl-texi/chap-23.texi +--- gcl-texi-orig/chap-23.texi 1994-07-16 18:03:03 +0400 ++++ gcl-texi/chap-23.texi 2002-10-17 20:53:05 +0400 +@@ -263,7 +263,7 @@ + @node copy-readtable, make-dispatch-macro-character, readtable, Reader Dictionary + @subsection copy-readtable [Function] + +-@code{copy-readtable} @i{{&optional} from-readtable to-readtable} @result{} @i{readtable} ++@code{copy-readtable} @i{@r{&optional} from-readtable to-readtable} @result{} @i{readtable} + + @subsubheading Arguments and Values:: + +@@ -332,7 +332,7 @@ + @node make-dispatch-macro-character, read, copy-readtable, Reader Dictionary + @subsection make-dispatch-macro-character [Function] + +-@code{make-dispatch-macro-character} @i{char {&optional} non-terminating-p readtable} @result{} @i{@b{t}} ++@code{make-dispatch-macro-character} @i{char @r{&optional} non-terminating-p readtable} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -374,14 +374,14 @@ + + @ref{readtable} + , +-@ref{set-dispatch-macro-character; get-dispatch-macro-character} ++@ref{set-dispatch-macro-character} + + @node read, read-delimited-list, make-dispatch-macro-character, Reader Dictionary + @subsection read, read-preserving-whitespace [Function] + +-@code{read} @i{{&optional} input-stream eof-error-p eof-value recursive-p} @result{} @i{object} ++@code{read} @i{@r{&optional} input-stream eof-error-p eof-value recursive-p} @result{} @i{object} + +-@code{read-preserving-whitespace} @i{{&optional} input-stream eof-error-p ++@code{read-preserving-whitespace} @i{@r{&optional} input-stream eof-error-p + eof-value recursive-p}@* + @result{} @i{object} + +@@ -543,13 +543,13 @@ + , + @ref{parse-integer} + , +-{@ref{Syntax}}, +-{@ref{Reader Concepts}} ++@ref{Syntax}, ++@ref{Reader Concepts} + + @node read-delimited-list, read-from-string, read, Reader Dictionary + @subsection read-delimited-list [Function] + +-@code{read-delimited-list} @i{char {&optional} input-stream recursive-p} @result{} @i{list} ++@code{read-delimited-list} @i{char @r{&optional} input-stream recursive-p} @result{} @i{list} + + @subsubheading Arguments and Values:: + +@@ -596,11 +596,11 @@ + + @subsubheading Examples:: + @example +- (read-delimited-list #\{]}) 1 2 3 4 5 6 {]} ++ (read-delimited-list #\@r{]}) 1 2 3 4 5 6 @r{]} + @result{} (1 2 3 4 5 6) + @end example + +-Suppose you wanted @t{#@{{@i{a}} @i{b} @i{c} ... @i{z}@}} ++Suppose you wanted @t{#@{@i{a} @i{b} @i{c} ... @i{z}@}} + to read as a list of all pairs of the elements @i{a}, @i{b}, @i{c}, + ..., @i{z}, for example. + +@@ -659,7 +659,7 @@ + + @subsubheading See Also:: + +-@ref{read; read-preserving-whitespace} ++@ref{read} + , + @ref{peek-char} + , +@@ -680,8 +680,8 @@ + @node read-from-string, readtable-case, read-delimited-list, Reader Dictionary + @subsection read-from-string [Function] + +-@code{read-from-string} @i{string {&optional} eof-error-p eof-value +- {&key} start end preserve-whitespace}@* ++@code{read-from-string} @i{string @r{&optional} eof-error-p eof-value ++ @r{&key} start end preserve-whitespace}@* + @result{} @i{object, position} + + @subsubheading Arguments and Values:: +@@ -748,7 +748,7 @@ + + @subsubheading See Also:: + +-@ref{read; read-preserving-whitespace} ++@ref{read} + , + @b{read-preserving-whitespace} + +@@ -840,9 +840,9 @@ + @i{[Function]} + @end flushright + +-@code{get-dispatch-macro-character} @i{disp-char sub-char {&optional} readtable} @result{} @i{function} ++@code{get-dispatch-macro-character} @i{disp-char sub-char @r{&optional} readtable} @result{} @i{function} + +-@code{set-dispatch-macro-character} @i{disp-char sub-char new-function {&optional} readtable} @result{} @i{@b{t}} ++@code{set-dispatch-macro-character} @i{disp-char sub-char new-function @r{&optional} readtable} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -940,9 +940,9 @@ + @node set-macro-character, set-syntax-from-char, set-dispatch-macro-character, Reader Dictionary + @subsection set-macro-character, get-macro-character [Function] + +-@code{get-macro-character} @i{char {&optional} readtable} @result{} @i{function, non-terminating-p} ++@code{get-macro-character} @i{char @r{&optional} readtable} @result{} @i{function, non-terminating-p} + +-@code{set-macro-character} @i{char new-function {&optional} non-terminating-p readtable} @result{} @i{@b{t}} ++@code{set-macro-character} @i{char new-function @r{&optional} non-terminating-p readtable} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1022,7 +1022,7 @@ + @node set-syntax-from-char, with-standard-io-syntax, set-macro-character, Reader Dictionary + @subsection set-syntax-from-char [Function] + +-@code{set-syntax-from-char} @i{to-char from-char {&optional} to-readtable from-readtable} @result{} @i{@b{t}} ++@code{set-syntax-from-char} @i{to-char from-char @r{&optional} to-readtable from-readtable} @result{} @i{@b{t}} + + @subsubheading Arguments and Values:: + +@@ -1075,7 +1075,7 @@ + + @subsubheading See Also:: + +-@ref{set-macro-character; get-macro-character} ++@ref{set-macro-character} + , + @ref{make-dispatch-macro-character} + , +@@ -1093,7 +1093,7 @@ + @node with-standard-io-syntax, *read-base*, set-syntax-from-char, Reader Dictionary + @subsection with-standard-io-syntax [Macro] + +-@code{with-standard-io-syntax} @i{@{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{with-standard-io-syntax} @i{@{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -1111,6 +1111,7 @@ + + [Reviewer Note by Barrett: *print-pprint-dispatch* should probably be mentioned here, too.] + ++@format + @group + @noindent + @w{ Variable Value } +@@ -1140,6 +1141,7 @@ + @w{ Figure 23--1: Values of standard control variables } + + @end group ++@end format + + @subsubheading Examples:: + +@@ -1363,9 +1365,9 @@ + + @subsubheading See Also:: + +-@ref{read; read-preserving-whitespace} ++@ref{read} + , +-{@ref{Syntax}} ++@ref{Syntax} + + @subsubheading Notes:: + +@@ -1443,7 +1445,7 @@ + + @subsubheading See Also:: + +-@ref{read; read-preserving-whitespace} ++@ref{read} + , + @ref{stream-error-stream} + , +diff -uNr gcl-texi-orig/chap-24.texi gcl-texi/chap-24.texi +--- gcl-texi-orig/chap-24.texi 1994-07-16 18:03:03 +0400 ++++ gcl-texi/chap-24.texi 2002-10-17 20:53:05 +0400 +@@ -97,12 +97,12 @@ + if its argument @i{feature-conditional} fails; + otherwise, it succeeds. + +-@item @t{(and @{@i{feature-conditional}@}{*})} ++@item @t{(and @{@i{feature-conditional}@}*)} + An @b{and} @i{feature expression} succeeds + if all of its argument @i{feature-conditionals} succeed; + otherwise, it fails. + +-@item @t{(or @{@i{feature-conditional}@}{*})} ++@item @t{(or @{@i{feature-conditional}@}*)} + An @b{or} @i{feature expression} succeeds + if any of its argument @i{feature-conditionals} succeed; + otherwise, it fails. +@@ -124,6 +124,7 @@ + Figure 24--1 shows some sample @i{expressions}, and how they would be + @i{read}_2 in these @i{implementations}. + ++@format + @group + @noindent + @w{ @t{(cons #+spice "Spice" #-spice "Lispm" x)} } +@@ -151,6 +152,7 @@ + @w{ Figure 24--1: Features examples } + + @end group ++@end format + + @c end of including concept-systems + +@@ -176,7 +178,7 @@ + @node compile-file, compile-file-pathname, System Construction Dictionary, System Construction Dictionary + @subsection compile-file [Function] + +-@code{compile-file} @i{input-file {&key} output-file verbose ++@code{compile-file} @i{input-file @r{&key} output-file verbose + print external-format}@* + @result{} @i{output-truename, warnings-p, failure-p} + +@@ -320,7 +322,7 @@ + @node compile-file-pathname, load, compile-file, System Construction Dictionary + @subsection compile-file-pathname [Function] + +-@code{compile-file-pathname} @i{input-file {&key} output-file {&allow-other-keys}} @result{} @i{pathname} ++@code{compile-file-pathname} @i{input-file @r{&key} output-file @r{&allow-other-keys}} @result{} @i{pathname} + + @subsubheading Arguments and Values:: + +@@ -388,7 +390,7 @@ + @node load, with-compilation-unit, compile-file-pathname, System Construction Dictionary + @subsection load [Function] + +-@code{load} @i{filespec {&key} verbose print ++@code{load} @i{filespec @r{&key} verbose print + if-does-not-exist external-format}@* + @result{} @i{generalized-boolean} + +@@ -567,7 +569,7 @@ + @subsection with-compilation-unit [Macro] + + @code{with-compilation-unit} @i{@r{(}[[!@i{option}]]@r{)} +- @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++ @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @w{@i{option} ::=@t{:override} override} + +@@ -908,7 +910,7 @@ + + @subsubheading See Also:: + +-@ref{provide; require} ++@ref{provide} + , + @b{require} + +@@ -921,7 +923,7 @@ + + @code{provide} @i{module-name} @result{} @i{@i{implementation-dependent}} + +-@code{require} @i{module-name {&optional} pathname-list} @result{} @i{@i{implementation-dependent}} ++@code{require} @i{module-name @r{&optional} pathname-list} @result{} @i{@i{implementation-dependent}} + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/chap-25.texi gcl-texi/chap-25.texi +--- gcl-texi-orig/chap-25.texi 1994-07-16 18:03:02 +0400 ++++ gcl-texi/chap-25.texi 2002-10-17 20:53:05 +0400 +@@ -36,6 +36,7 @@ + @i{form}. + Figure 25--1 lists variables that are maintained by the @i{Lisp read-eval-print loop}. + ++@format + @group + @noindent + @w{ * + / - } +@@ -46,6 +47,7 @@ + @w{ Figure 25--1: Variables maintained by the Read-Eval-Print Loop} + + @end group ++@end format + + @node Debugging Utilities, Environment Inquiry, Top level loop, The External Environment + @subsection Debugging Utilities +@@ -53,6 +55,7 @@ + Figure 25--2 shows @i{defined names} relating to + debugging. + ++@format + @group + @noindent + @w{ *debugger-hook* documentation step } +@@ -65,6 +68,7 @@ + @w{ Figure 25--2: Defined names relating to debugging} + + @end group ++@end format + + @node Environment Inquiry, Time, Debugging Utilities, The External Environment + @subsection Environment Inquiry +@@ -75,6 +79,7 @@ + + Figure 25--3 shows @i{defined names} relating to environment inquiry. + ++@format + @group + @noindent + @w{ *features* machine-instance short-site-name } +@@ -86,6 +91,7 @@ + @w{ Figure 25--3: Defined names relating to environment inquiry. } + + @end group ++@end format + + @node Time, , Environment Inquiry, The External Environment + @subsection Time +@@ -110,6 +116,7 @@ + + Figure 25--4 shows @i{defined names} relating to @i{time}. + ++@format + @group + @noindent + @w{ decode-universal-time get-internal-run-time } +@@ -121,6 +128,7 @@ + @w{ Figure 25--4: Defined names involving Time. } + + @end group ++@end format + + @menu + * Decoded Time:: +@@ -183,6 +191,7 @@ + + Figure 25--5 shows @i{defined names} relating to @i{decoded time}. + ++@format + @group + @noindent + @w{ decode-universal-time get-decoded-time } +@@ -191,6 +200,7 @@ + @w{ Figure 25--5: Defined names involving time in Decoded Time.} + + @end group ++@end format + + @node Universal Time, Internal Time, Decoded Time, Time + @subsubsection Universal Time +@@ -211,6 +221,7 @@ + Because @i{universal time} must be a non-negative @i{integer}, + times before the base time of midnight, January 1, 1900 GMT cannot be processed by @r{Common Lisp}. + ++@format + @group + @noindent + @w{ decode-universal-time get-universal-time } +@@ -220,6 +231,7 @@ + @w{ Figure 25--6: Defined names involving time in Universal Time.} + + @end group ++@end format + + @node Internal Time, Seconds, Universal Time, Time + @subsubsection Internal Time +@@ -233,6 +245,7 @@ + + Figure 25--7 shows @i{defined names} related to @i{internal time}. + ++@format + @group + @noindent + @w{ get-internal-real-time internal-time-units-per-second } +@@ -242,6 +255,7 @@ + @w{ Figure 25--7: Defined names involving time in Internal Time.} + + @end group ++@end format + + @node Seconds, , Internal Time, Time + @subsubsection Seconds +@@ -253,6 +267,7 @@ + @b{sleep} can be any kind of non-negative @i{real}, in order to allow for + the possibility of fractional seconds. + ++@format + @group + @noindent + @w{ sleep } +@@ -261,6 +276,7 @@ + @w{ Figure 25--8: Defined names involving time in Seconds.} + + @end group ++@end format + + @c end of including concept-environment + +@@ -289,10 +305,10 @@ + * ed:: + * inspect:: + * dribble:: +-* -:: +-* +:: +-* *:: +-* /:: ++* - (Variable):: ++* + (Variable):: ++* * (Variable):: ++* / (Variable):: + * lisp-implementation-type:: + * short-site-name:: + * machine-instance:: +@@ -305,7 +321,7 @@ + @node decode-universal-time, encode-universal-time, Environment Dictionary, Environment Dictionary + @subsection decode-universal-time [Function] + +-@code{decode-universal-time} @i{universal-time {&optional} time-zone}@* ++@code{decode-universal-time} @i{universal-time @r{&optional} time-zone}@* + @result{} @i{second, minute, hour, date, month, year, day, daylight-p, zone} + + @subsubheading Arguments and Values:: +@@ -354,7 +370,7 @@ + + @ref{encode-universal-time} + , +-@ref{get-universal-time; get-decoded-time} ++@ref{get-universal-time} + , + @ref{Time} + +@@ -364,7 +380,7 @@ + @subsubheading Syntax:: + + @code{encode-universal-time} @i{second minute hour date month year +- {&optional} time-zone}@* ++ @r{&optional} time-zone}@* + @result{} @i{universal-time} + + @subsubheading Arguments and Values:: +@@ -511,9 +527,9 @@ + @node apropos, describe, sleep, Environment Dictionary + @subsection apropos, apropos-list [Function] + +-@code{apropos} @i{string {&optional} package} @result{} @i{<@i{no @i{values}}>} ++@code{apropos} @i{string @r{&optional} package} @result{} @i{<@i{no @i{values}}>} + +-@code{apropos-list} @i{string {&optional} package} @result{} @i{symbols} ++@code{apropos-list} @i{string @r{&optional} package} @result{} @i{symbols} + + @subsubheading Arguments and Values:: + +@@ -560,7 +576,7 @@ + @node describe, describe-object, apropos, Environment Dictionary + @subsection describe [Function] + +-@code{describe} @i{object {&optional} stream} @result{} @i{<@i{no @i{values}}>} ++@code{describe} @i{object @r{&optional} stream} @result{} @i{<@i{no @i{values}}>} + + @subsubheading Arguments and Values:: + +@@ -700,9 +716,9 @@ + @node trace, step, describe-object, Environment Dictionary + @subsection trace, untrace [Macro] + +-@code{trace} @i{@{@i{function-name}@}{*}} @result{} @i{trace-result} ++@code{trace} @i{@{@i{function-name}@}*} @result{} @i{trace-result} + +-@code{untrace} @i{@{@i{function-name}@}{*}} @result{} @i{untrace-result} ++@code{untrace} @i{@{@i{function-name}@}*} @result{} @i{untrace-result} + + @subsubheading Arguments and Values:: + +@@ -795,7 +811,7 @@ + @node step, time, trace, Environment Dictionary + @subsection step [Macro] + +-@code{step} @i{form} @result{} @i{@{@i{result}@}{*}} ++@code{step} @i{form} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -830,7 +846,7 @@ + + @subsubheading See Also:: + +-@ref{trace; untrace} ++@ref{trace} + + @subsubheading Notes:: + +@@ -841,7 +857,7 @@ + @node time, internal-time-units-per-second, step, Environment Dictionary + @subsection time [Macro] + +-@code{time} @i{form} @result{} @i{@{@i{result}@}{*}} ++@code{time} @i{form} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -895,7 +911,7 @@ + purposes. + + For useful background information on the complicated issues involved in +-interpreting timing results, see {Performance and Evaluation of Lisp Programs}. ++interpreting timing results, see @i{Performance and Evaluation of Lisp Programs}. + + @node internal-time-units-per-second, get-internal-real-time, time, Environment Dictionary + @subsection internal-time-units-per-second [Constant Variable] +@@ -1215,7 +1231,7 @@ + @node room, ed, documentation, Environment Dictionary + @subsection room [Function] + +-@code{room} @i{{&optional} x} @result{} @i{@i{implementation-dependent}} ++@code{room} @i{@r{&optional} x} @result{} @i{@i{implementation-dependent}} + + @subsubheading Arguments and Values:: + +@@ -1249,7 +1265,7 @@ + @node ed, inspect, room, Environment Dictionary + @subsection ed [Function] + +-@code{ed} @i{{&optional} x} @result{} @i{@i{implementation-dependent}} ++@code{ed} @i{@r{&optional} x} @result{} @i{@i{implementation-dependent}} + + @subsubheading Arguments and Values:: + +@@ -1337,10 +1353,10 @@ + of @t{?} or a ``help key'' by providing help, including a list + of commands. + +-@node dribble, -, inspect, Environment Dictionary ++@node dribble, - (Variable), inspect, Environment Dictionary + @subsection dribble [Function] + +-@code{dribble} @i{{&optional} pathname} @result{} @i{@i{implementation-dependent}} ++@code{dribble} @i{@r{&optional} pathname} @result{} @i{@i{implementation-dependent}} + + @subsubheading Arguments and Values:: + +@@ -1396,7 +1412,7 @@ + @b{dribble} is intended primarily for interactive debugging; + its effect cannot be relied upon when used in a program. + +-@node -, +, dribble, Environment Dictionary ++@node - (Variable), + (Variable), dribble, Environment Dictionary + @subsection - [Variable] + + @subsubheading Value Type:: +@@ -1432,7 +1448,7 @@ + (@i{variable}), + @ref{Top level loop} + +-@node +, *, -, Environment Dictionary ++@node + (Variable), * (Variable), - (Variable), Environment Dictionary + @subsection +, ++, +++ [Variable] + + @subsubheading Value Type:: +@@ -1479,7 +1495,7 @@ + (@i{variable}), + @ref{Top level loop} + +-@node *, /, +, Environment Dictionary ++@node * (Variable), / (Variable), + (Variable), Environment Dictionary + @subsection *, **, *** [Variable] + + @subsubheading Value Type:: +@@ -1543,7 +1559,7 @@ + *** @equiv{} (car ///) + @end example + +-@node /, lisp-implementation-type, *, Environment Dictionary ++@node / (Variable), lisp-implementation-type, * (Variable), Environment Dictionary + @subsection /, //, /// [Variable] + + @subsubheading Value Type:: +@@ -1588,7 +1604,7 @@ + @b{*} (@i{variable}), + @ref{Top level loop} + +-@node lisp-implementation-type, short-site-name, /, Environment Dictionary ++@node lisp-implementation-type, short-site-name, / (Variable), Environment Dictionary + @subsection lisp-implementation-type, + @subheading lisp-implementation-version + @flushright +@@ -1804,7 +1820,7 @@ + @node user-homedir-pathname, , software-type, Environment Dictionary + @subsection user-homedir-pathname [Function] + +-@code{user-homedir-pathname} @i{{&optional} host} @result{} @i{pathname} ++@code{user-homedir-pathname} @i{@r{&optional} host} @result{} @i{pathname} + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/chap-26.texi gcl-texi/chap-26.texi +--- gcl-texi-orig/chap-26.texi 1994-07-16 18:03:01 +0400 ++++ gcl-texi/chap-26.texi 2002-10-17 20:53:05 +0400 +@@ -25,7 +25,7 @@ + pronounced 'a ,list . The pronunciation key follows + @i{Webster's Third New International Dictionary + the English Language, Unabridged}, +- except that ``{e}'' is used to notate the schwa (upside-down ``e'') character. ++ except that ``e'' is used to notate the schwa (upside-down ``e'') character. + + @item @t{*} + the part or parts of speech, set in italics. If a term +@@ -48,7 +48,7 @@ + + @item -- + an optional discipline, set in italics, present if the term +-has a standard definition being repeated. For example, ``{Math.}'' ++has a standard definition being repeated. For example, ``Math.'' + + @item -- + an optional context, present if this definition is +@@ -59,7 +59,7 @@ + + @item -- + an optional example sentence. For example, +- {``This is an example of an example.''} ++ ``This is an example of an example.'' + + @item -- + optional cross references. +@@ -70,7 +70,7 @@ + + In addition, some terms have idiomatic usage in the Common Lisp + community which is not shared by other communities, or which is not +-technically correct. Definitions labeled ``{Idiom.}'' represent ++technically correct. Definitions labeled ``Idiom.'' represent + such idiomatic usage; these definitions are sometimes followed by an + explanatory note. + +@@ -272,7 +272,7 @@ + @item @b{alphanumeric} + @i{adj.} (of a @i{character}) + being either an @i{alphabetic}_1 @i{character} +- or a @i{numeric} {character}. ++ or a @i{numeric} @i{character}. + + @IGindex{ampersand} + @item @b{ampersand} +@@ -332,8 +332,8 @@ + @i{v.t.} (a @i{function} to a @i{list}) + to @i{call} the @i{function} with arguments that are the @i{elements} + of the @i{list}. +- {``Applying the function @b{+} to a list of integers returns +- the sum of the elements of that list.''} ++ ``Applying the function @b{+} to a list of integers returns ++ the sum of the elements of that list.'' + + @IGindex{argument} + @item @b{argument} +@@ -347,7 +347,7 @@ + @item @b{argument evaluation order} + @i{n.} + the order in which @i{arguments} are evaluated in a function call. +- {``The argument evaluation order for Common Lisp is left to right.''} ++ ``The argument evaluation order for Common Lisp is left to right.'' + See @ref{Evaluation}. + + @IGindex{argument precedence order} +@@ -418,13 +418,13 @@ + @item @b{atom} + @i{n.} + any @i{object} that is not a @i{cons}. +- {``A vector is an atom.''} ++ ``A vector is an atom.'' + + @IGindex{atomic} + @item @b{atomic} + @i{adj.} + being an @i{atom}. +- {``The number 3, the symbol @t{foo}, and @b{nil} are atomic.''} ++ ``The number 3, the symbol @t{foo}, and @b{nil} are atomic.'' + + @IGindex{atomic type specifier} + @item @b{atomic type specifier} +@@ -441,9 +441,9 @@ + is its @i{code}_2, but @i{implementations} are permitted to have + additional @i{implementation-defined} @i{attributes}. + See @ref{Character Attributes}. +- {``An implementation that support fonts ++ ``An implementation that support fonts + might make font information an attribute of a character, +- while others might represent font information separately from characters.''} ++ while others might represent font information separately from characters.'' + + @IGindex{aux variable} + @item @b{aux variable} +@@ -530,8 +530,8 @@ + @i{n.} + an association between a @i{name} and that which the @i{name} + denotes. +- {``A lexical binding is a lexical association between a +- name and its value.''} ++ ``A lexical binding is a lexical association between a ++ name and its value.'' + + @IGindex{bit} + @item @b{bit} +@@ -624,13 +624,13 @@ + @item @b{bound} + @i{adj.}, @i{v.t.} + 1. @i{adj.} having an associated denotation in a @i{binding}. +- {``The variables named by a @b{let} are bound within +- its body.''} ++ ``The variables named by a @b{let} are bound within ++ its body.'' + See @i{unbound}. + 2. @i{adj.} having a local @i{binding} which + @i{shadows}_2 another. +- {``The variable @b{*print-escape*} is bound while in +- the @b{princ} function.''} ++ ``The variable @b{*print-escape*} is bound while in ++ the @b{princ} function.'' + 3. @i{v.t.} the past tense of @i{bind}. + + @IGindex{bound declaration} +@@ -736,8 +736,8 @@ + @i{executed} in an @i{environment} where @i{bindings} for + the @i{values} of its @i{parameters} have been @i{established} + based on the @i{arguments}. +- {``Calling the function @b{+} with the arguments +- @t{5} and @t{1} yields a value of @t{6}.''} ++ ``Calling the function @b{+} with the arguments ++ @t{5} and @t{1} yields a value of @t{6}.'' + 2. @i{n.} a @i{situation} in which a @i{function} is called. + + @IGindex{captured initialization form} +@@ -746,9 +746,9 @@ + an @i{initialization form} along with the @i{lexical environment} + in which the @i{form} that defined the @i{initialization form} + was @i{evaluated}. +- {``Each newly added shared slot is set to the result of evaluating ++ ``Each newly added shared slot is set to the result of evaluating + the captured initialization form for the slot that was specified +- in the @b{defclass} form for the new class.''} ++ in the @b{defclass} form for the new class.'' + + @IGindex{car} + @item @b{car} +@@ -757,20 +757,20 @@ + the component of a @i{cons} corresponding to the first + @i{argument} to @b{cons}; the other component is the + @i{cdr}. +- {``The function @b{rplaca} modifies the car of a cons.''} ++ ``The function @b{rplaca} modifies the car of a cons.'' + b. (of a @i{list}) + the first @i{element} of the @i{list}, or @b{nil} if the + @i{list} is the @i{empty list}. + 2. the @i{object} that is held in the @i{car}_1. +- {``The function @b{car} returns the car of a cons.''} ++ ``The function @b{car} returns the car of a cons.'' + + @IGindex{case} + @item @b{case} + @i{n.} (of a @i{character}) + the property of being either @i{uppercase} or @i{lowercase}. + Not all @i{characters} have @i{case}. +- {``The characters @t{#\A} and @t{#\a} have case, +- but the character @t{#\$} has no case.''} ++ ``The characters @t{#\A} and @t{#\a} have case, ++ but the character @t{#\$} has no case.'' + See @ref{Characters With Case} and the @i{function} @b{both-case-p}. + + @IGindex{case sensitivity mode} +@@ -808,13 +808,13 @@ + 1. a. (of a @i{cons}) + the component of a @i{cons} corresponding to the second @i{argument} + to @b{cons}; the other component is the @i{car}. +- {``The function @b{rplacd} modifies the cdr of a cons.''} ++ ``The function @b{rplacd} modifies the cdr of a cons.'' + b. (of a @i{list} L_1) + either the @i{list} L_2 that contains + the @i{elements} of L_1 that follow after the first, + or else @b{nil} if L_1 is the @i{empty list}. + 2. the @i{object} that is held in the @i{cdr}_1. +- {``The function @b{cdr} returns the cdr of a cons.''} ++ ``The function @b{cdr} returns the cdr of a cons.'' + + @IGindex{cell} + @item @b{cell} +@@ -884,7 +884,7 @@ + other @i{objects} called its @i{indirect instances}, + and that acts as a @i{type specifier} for a set of objects + called its @i{generalized instances}. +- {``The class @b{integer} is a subclass of the class @b{number}.''} ++ ``The class @b{integer} is a subclass of the class @b{number}.'' + (Note that the phrase ``the @i{class} @t{foo}'' is often substituted for + the more precise phrase ``the @i{class} named @t{foo}''---in both + cases, a @i{class} @i{object} (not a @i{symbol}) is denoted.) +@@ -892,8 +892,8 @@ + the uniquely determined @i{class} of which the @i{object} is + a @i{direct instance}. + See the @i{function} @b{class-of}. +- {``The class of the object returned by @b{gensym} +- is @b{symbol}.''} ++ ``The class of the object returned by @b{gensym} ++ is @b{symbol}.'' + (Note that with this usage a phrase such as ``its @i{class} is @t{foo}'' + is often substituted for the more precise phrase + ``its @i{class} is the @i{class} named @t{foo}''---in both +@@ -929,7 +929,7 @@ + @IGindex{closed} + @item @b{closed} + @i{adj.} (of a @i{stream}) +- having been @i{closed} (see @i{@i}{close}). ++ having been @i{closed} (see @i{close}). + Some (but not all) operations that are valid on @i{open} @i{streams} + are not valid on @i{closed} @i{streams}. + See @ref{File Operations on Open and Closed Streams}. +@@ -1149,7 +1149,7 @@ + @item @b{composite stream} + @i{n.} + a @i{stream} that is composed of one or more other @i{streams}. +- {``@b{make-synonym-stream} creates a composite stream.''} ++ ``@b{make-synonym-stream} creates a composite stream.'' + + @IGindex{compound form} + @item @b{compound form} +@@ -1165,7 +1165,7 @@ + @i{n.} + a @i{type specifier} that is a @i{cons}; + @i{i.e.}, a @i{type specifier} that is not an @i{atomic type specifier}. +- {``@t{(vector single-float)} is a compound type specifier.''} ++ ``@t{(vector single-float)} is a compound type specifier.'' + + @IGindex{concatenated stream} + @item @b{concatenated stream} +@@ -1286,24 +1286,24 @@ + that neither affects nor is affected by the state of any @i{object} + except those @i{objects} that are @i{otherwise inaccessible parts} + of @i{objects} created by the @i{form} itself. +- {``A @b{car} form in which the argument is a +- @b{quote} form is a constant form.''} ++ ``A @b{car} form in which the argument is a ++ @b{quote} form is a constant form.'' + + @IGindex{constant object} + @item @b{constant object} + @i{n.} + an @i{object} that is constrained (@i{e.g.}, by its context in a @i{program} + or by the source from which it was obtained) to be @i{immutable}. +- {``A literal object that has been processed by @b{compile-file} +- is a constant object.''} ++ ``A literal object that has been processed by @b{compile-file} ++ is a constant object.'' + + @IGindex{constant variable} + @item @b{constant variable} + @i{n.} + a @i{variable}, the @i{value} of which can never change; + that is, a @i{keyword}_1 or a @i{named constant}. +- {``The symbols @b{t}, @b{nil}, @t{:direction}, and +- @b{most-positive-fixnum} are constant variables.''} ++ ``The symbols @b{t}, @b{nil}, @t{:direction}, and ++ @b{most-positive-fixnum} are constant variables.'' + + @IGindex{constituent} + @item @b{constituent} +@@ -1329,7 +1329,7 @@ + a @i{stream} whose source or sink is a Lisp @i{object}. + Note that since a @i{stream} is another Lisp @i{object}, + @i{composite streams} are considered @i{constructed streams}. +- {``A string stream is a constructed stream.''} ++ ``A string stream is a constructed stream.'' + + @IGindex{contagion} + @item @b{contagion} +@@ -1394,8 +1394,8 @@ + 1. (by a @i{restart} other than @b{abort} + that has been associated with the @i{error}) + capable of being corrected by invoking that @i{restart}. +- {``The function @b{cerror} signals an error +- that is correctable by the @b{continue} @i{restart}.''} ++ ``The function @b{cerror} signals an error ++ that is correctable by the @b{continue} @i{restart}.'' + + (Note that correctability is not a property of an + @i{error} @i{object}, but rather a property of the +@@ -1407,9 +1407,9 @@ + + 2. (when no specific @i{restart} is mentioned) + @i{correctable}_1 by at least one @i{restart}. +- {``@b{import} signals a correctable error of @i{type} @b{package-error} ++ ``@b{import} signals a correctable error of @i{type} @b{package-error} + if any of the imported symbols has the same name as +- some distinct symbol already accessible in the package.''} ++ some distinct symbol already accessible in the package.'' + + @IGindex{current input base} + @item @b{current input base} +@@ -1573,7 +1573,7 @@ + @item @b{defining form} + @i{n.} + a @i{form} that has the side-effect of @i{establishing} a definition. +- {``@b{defun} and @b{defparameter} are defining forms.''} ++ ``@b{defun} and @b{defparameter} are defining forms.'' + + @IGindex{defsetf lambda list} + @item @b{defsetf lambda list} +@@ -1595,7 +1595,7 @@ + @item @b{denormalized} + @i{adj.}, @i{ANSI}, @i{IEEE} (of a @i{float}) + conforming to the description of ``denormalized'' as described by +- {IEEE Standard for Binary Floating-Point Arithmetic}. ++ @i{IEEE Standard for Binary Floating-Point Arithmetic}. + For example, in an @i{implementation} where the minimum possible exponent + was @t{-7} but where @t{0.001} was a valid mantissa, the number @t{1.0e-10} + might be representable as @t{0.001e-7} internally even if the @i{normalized} +@@ -1646,8 +1646,8 @@ + @item @b{different} + @i{adj.} + not the @i{same} +- {``The strings @t{"FOO"} and @t{"foo"} are different under +- @b{equal} but not under @b{equalp}.''} ++ ``The strings @t{"FOO"} and @t{"foo"} are different under ++ @b{equal} but not under @b{equalp}.'' + + @IGindex{digit} + @item @b{digit} +@@ -1664,18 +1664,18 @@ + @i{objects} an @i{array} can hold along one axis. + If the @i{array} is a @i{vector} with a @i{fill pointer}, + the @i{fill pointer} is ignored. +- {``The second dimension of that array is 7.''} ++ ``The second dimension of that array is 7.'' + 2. an axis of an array. +- {``This array has six dimensions.''} ++ ``This array has six dimensions.'' + + @IGindex{direct instance} + @item @b{direct instance} + @i{n.} (of a @i{class} C) + an @i{object} whose @i{class} is C itself, + rather than some @i{subclass} of C. +- {``The function @b{make-instance} always returns a ++ ``The function @b{make-instance} always returns a + direct instance of the class which is (or is named by) +- its first argument.''} ++ its first argument.'' + + @IGindex{direct subclass} + @item @b{direct subclass} +@@ -1737,8 +1737,8 @@ + In some cases, the @i{documentation string} is saved in such a + way that it can later be obtained by supplying either an @i{object}, + or by supplying a @i{name} and a ``kind'' to the @i{function} @b{documentation}. +- {``The body of code in a @b{defmacro} form can be preceded +- by a documentation string of kind @b{function}.''} ++ ``The body of code in a @b{defmacro} form can be preceded ++ by a documentation string of kind @b{function}.'' + + @IGindex{dot} + @item @b{dot} +@@ -1801,7 +1801,7 @@ + an @i{extent} whose duration is bounded by points of + @i{establishment} and @i{disestablishment} within the execution + of a particular @i{form}. See @i{indefinite extent}. +- {``Dynamic variable bindings have dynamic extent.''} ++ ``Dynamic variable bindings have dynamic extent.'' + + @IGindex{dynamic scope} + @item @b{dynamic scope} +@@ -1907,7 +1907,7 @@ + @i{n.} + 1. a set of @i{bindings}. See @ref{Introduction to Environments}. + 2. an @i{environment object}. +- {``@b{macroexpand} takes an optional environment argument.''} ++ ``@b{macroexpand} takes an optional environment argument.'' + + @IGindex{environment object} + @item @b{environment object} +@@ -1915,7 +1915,7 @@ + an @i{object} representing a set of @i{lexical bindings}, + used in the processing of a @i{form} to provide meanings for + @i{names} within that @i{form}. +- {``@b{macroexpand} takes an optional environment argument.''} ++ ``@b{macroexpand} takes an optional environment argument.'' + (The @i{object} @b{nil} when used as an @i{environment object} + denotes the @i{null lexical environment}; + the @i{values} of @i{environment parameters} +@@ -1966,7 +1966,7 @@ + a @i{handler}, + a @i{restart}, + or an @i{environment}. +- {``@b{let} establishes lexical bindings.''} ++ ``@b{let} establishes lexical bindings.'' + + @IGindex{evaluate} + @item @b{evaluate} +@@ -2029,7 +2029,7 @@ + control and possibly @i{values} can be transferred both actively by using + another @i{control form} and passively through the normal control and + data flow of @i{evaluation}. +- {``@b{catch} and @b{block} establish bindings for ++ ``@b{catch} and @b{block} establish bindings for + exit points to which @b{throw} and @b{return-from}, + respectively, can transfer control and values; + @b{tagbody} establishes a binding for an exit point +@@ -2037,7 +2037,7 @@ + and @b{unwind-protect} establishes an exit point + through which control might be transferred by + operators such as @b{throw}, @b{return-from}, +- and @b{go}.''} ++ and @b{go}.'' + + @IGindex{explicit return} + @item @b{explicit return} +@@ -2062,9 +2062,10 @@ + The characters defined as @i{exponent markers} in the @i{standard readtable} + are shown in Figure 26--1. + For more information, see @ref{Character Syntax}. +- {``The exponent marker `d' in `3.0d7' indicates +- that this number is to be represented as a double float.''} ++ ``The exponent marker `d' in `3.0d7' indicates ++ that this number is to be represented as a double float.'' + ++@format + @group + @noindent + @w{ Marker Meaning } +@@ -2078,6 +2079,7 @@ + @w{ Figure 26--1: Exponent Markers } + + @end group ++@end format + + @IGindex{export} + @item @b{export} +@@ -2135,10 +2137,10 @@ + 1. an @i{object}, often used to emphasize the use + of the @i{object} to encode or represent information in a specialized + format, such as program text. +- {``The second expression in a @b{let} form is a list +- of bindings.''} ++ ``The second expression in a @b{let} form is a list ++ of bindings.'' + 2. the textual notation used to notate an @i{object} in a source file. +- {``The expression @t{'sample} is equivalent to @t{(quote sample)}.''} ++ ``The expression @t{'sample} is equivalent to @t{(quote sample)}.'' + + @IGindex{expressly adjustable} + @item @b{expressly adjustable} +@@ -2181,7 +2183,7 @@ + a list resembling an @i{ordinary lambda list} in form and purpose, but + offering additional syntax or functionality not available in an + @i{ordinary lambda list}. +- {``@b{defmacro} uses extended lambda lists.''} ++ ``@b{defmacro} uses extended lambda lists.'' + + @IGindex{extension} + @item @b{extension} +@@ -2282,7 +2284,7 @@ + or of the @i{environment}. + 2. a @i{symbol} that names a @i{feature}_1. + See @ref{Features}. +- {``The @t{:ansi-cl} feature is present in all conforming implementations.''} ++ ``The @t{:ansi-cl} feature is present in all conforming implementations.'' + + @IGindex{feature expression} + @item @b{feature expression} +@@ -2370,8 +2372,8 @@ + @item @b{finite} + @i{adj.} (of a @i{type}) + having a finite number of @i{elements}. +- {``The type specifier @t{(integer 0 5)} denotes a finite type, +- but the type specifiers @b{integer} and @t{(integer 0)} do not.''} ++ ``The type specifier @t{(integer 0 5)} denotes a finite type, ++ but the type specifiers @b{integer} and @t{(integer 0)} do not.'' + + @IGindex{fixnum} + @item @b{fixnum} +@@ -2398,7 +2400,7 @@ + or a @i{self-evaluating object}. + 3. (for an @i{operator}, as in ``<<@i{operator}>> @i{form}'') + a @i{compound form} having that @i{operator} as its first element. +- {``A @b{quote} form is a constant form.''} ++ ``A @b{quote} form is a constant form.'' + + @IGindex{formal argument} + @item @b{formal argument} +@@ -2439,12 +2441,12 @@ + to mean that some special operation should be performed, possibly + involving data supplied by the @i{format arguments} that + accompanied the @i{format string}. See the @i{function} @b{format}. +- {``In @t{"~D base 10 = ~8R"}, the character +- sequences `@t{~D}' and `@t{~8R}' are format directives.''} ++ ``In @t{"~D base 10 = ~8R"}, the character ++ sequences `@t{~D}' and `@t{~8R}' are format directives.'' + 2. the conceptual category of all @i{format directives}_1 + which use the same dispatch character. +- {``Both @t{"~3d"} and @t{"~3,'0D"} are valid uses of the +- `@t{~D}' format directive.''} ++ ``Both @t{"~3d"} and @t{"~3,'0D"} are valid uses of the ++ `@t{~D}' format directive.'' + + @IGindex{format string} + @item @b{format string} +@@ -2581,8 +2583,8 @@ + @i{n.} + @i{implementation-dependent} compilation beyond @i{minimal compilation}. + Further compilation is permitted to take place at @i{run time}. +- {``Block compilation and generation of machine-specific instructions +- are examples of further compilation.''} ++ ``Block compilation and generation of machine-specific instructions ++ are examples of further compilation.'' + + @end table + @subheading @b{G} +@@ -2673,7 +2675,7 @@ + @item @b{glyph} + @i{n.} + a visual representation. +- {``Graphic characters have associated glyphs.''} ++ ``Graphic characters have associated glyphs.'' + + @IGindex{go} + @item @b{go} +@@ -2749,6 +2751,7 @@ + that is defined by the @i{implementation} + to be an @i{I/O customization variable}. + ++@format + @group + @noindent + @w{ *debug-io* *error-io* query-io* } +@@ -2758,6 +2761,7 @@ + @w{ Figure 26--2: Standardized I/O Customization Variables} + + @end group ++@end format + + @IGindex{identical} + @item @b{identical} +@@ -2780,7 +2784,7 @@ + @i{implementations} are not required to detect attempts to modify + @i{immutable} @i{objects} or @i{cells}; the consequences of attempting + to make such modification are undefined. +- {``Numbers are immutable.''} ++ ``Numbers are immutable.'' + + @IGindex{implementation} + @item @b{implementation} +@@ -2861,7 +2865,7 @@ + @item @b{indefinite extent} + @i{n.} + an @i{extent} whose duration is unlimited. +- {``Most Common Lisp objects have indefinite extent.''} ++ ``Most Common Lisp objects have indefinite extent.'' + + @IGindex{indefinite scope} + @item @b{indefinite scope} +@@ -2878,7 +2882,7 @@ + @i{n.} (of a @i{class} C_1) + an @i{object} of @i{class} C_2, + where C_2 is a @i{subclass} of C_1. +- {``An integer is an indirect instance of the class @b{number}.''} ++ ``An integer is an indirect instance of the class @b{number}.'' + + @IGindex{inherit} + @item @b{inherit} +@@ -2912,8 +2916,8 @@ + @i{n.} + a @i{form} used to supply the initial @i{value} for a @i{slot} + or @i{variable}. +- {``The initialization form for a slot in a @b{defclass} form +- is introduced by the keyword @t{:initform}.''} ++ ``The initialization form for a slot in a @b{defclass} form ++ is introduced by the keyword @t{:initform}.'' + + @IGindex{input} + @item @b{input} +@@ -3028,6 +3032,7 @@ + or a @i{compound form} that has an @i{implementation-defined} @i{operator} + and that is defined by the @i{implementation} to be an @i{iteration form}. + ++@format + @group + @noindent + @w{ do do-external-symbols dotimes } +@@ -3038,6 +3043,7 @@ + @w{ Figure 26--3: Standardized Iteration Forms } + + @end group ++@end format + + @IGindex{iteration variable} + @item @b{iteration variable} +@@ -3199,7 +3205,7 @@ + @i{n.} + @i{scope} that is limited to a spatial or textual region within the + establishing @i{form}. +- {``The names of parameters to a function normally are lexically scoped.''} ++ ``The names of parameters to a function normally are lexically scoped.'' + + @IGindex{lexical variable} + @item @b{lexical variable} +@@ -3303,9 +3309,9 @@ + appearing as data in a @b{quote} @i{form}, + or, if the @i{object} is a @i{self-evaluating object}, + appearing as unquoted data. +- {``In the form @t{(cons "one" '("two"))}, ++ ``In the form @t{(cons "one" '("two"))}, + the expressions @t{"one"}, @t{("two")}, and @t{"two"} +- are literal objects.''} ++ are literal objects.'' + + @IGindex{load} + @item @b{load} +@@ -3544,7 +3550,7 @@ + but which deviates in syntax or functionality from the definition of an + @i{ordinary lambda list}. + See @i{ordinary lambda list}. +- {``@b{deftype} uses a modified lambda list.''} ++ ``@b{deftype} uses a modified lambda list.'' + + @IGindex{most recent} + @item @b{most recent} +@@ -3571,13 +3577,13 @@ + @item @b{multiple values} + @i{n.} + 1. more than one @i{value}. +- {``The function @b{truncate} returns multiple values.''} ++ ``The function @b{truncate} returns multiple values.'' + 2. a variable number of @i{values}, possibly including zero or one. +- {``The function @b{values} returns multiple values.''} ++ ``The function @b{values} returns multiple values.'' + 3. a fixed number of values other than one. +- {``The macro @b{multiple-value-bind} is among the few ++ ``The macro @b{multiple-value-bind} is among the few + operators in @r{Common Lisp} which can detect and manipulate +- multiple values.''} ++ multiple values.'' + + @end table + @subheading @b{N} +@@ -3592,8 +3598,8 @@ + 2. @i{v.t.} to give a @i{name} to. + 3. @i{n.} (of an @i{object} having a name component) + the @i{object} which is that component. +- {``The string which is a symbol's name is returned +- by @b{symbol-name}.''} ++ ``The string which is a symbol's name is returned ++ by @b{symbol-name}.'' + 4. @i{n.} (of a @i{pathname}) + a. the name component, returned by @b{pathname-name}. + b. the entire namestring, returned by @b{namestring}. +@@ -3612,16 +3618,16 @@ + by the @i{implementation}, + or by user code (see the @i{macro} @b{defconstant}) + to always @i{yield} the same @i{value} when @i{evaluated}. +- {``The value of a named constant may not be changed +- by assignment or by binding.''} ++ ``The value of a named constant may not be changed ++ by assignment or by binding.'' + + @IGindex{namespace} + @item @b{namespace} + @i{n.} + 1. @i{bindings} whose denotations are restricted to a particular kind. +- {``The bindings of names to tags is the tag namespace.''} ++ ``The bindings of names to tags is the tag namespace.'' + 2. any @i{mapping} whose domain is a set of @i{names}. +- {``A package defines a namespace.''} ++ ``A package defines a namespace.'' + + @IGindex{namestring} + @item @b{namestring} +@@ -3710,8 +3716,8 @@ + @i{n.} + a transfer of control (and sometimes @i{values}) to + an @i{exit point} for reasons other than a @i{normal return}. +- {``The operators @b{go}, @b{throw}, +- and @b{return-from} cause a non-local exit.''} ++ ``The operators @b{go}, @b{throw}, ++ and @b{return-from} cause a non-local exit.'' + + @IGindex{non-nil} + @item @b{non-nil} +@@ -3755,7 +3761,7 @@ + @IGindex{normalized} + @item @b{normalized} + @i{adj.}, @i{ANSI}, @i{IEEE} (of a @i{float}) +- conforming to the description of ``normalized'' as described by {IEEE Standard for Binary Floating-Point Arithmetic}. ++ conforming to the description of ``normalized'' as described by @i{IEEE Standard for Binary Floating-Point Arithmetic}. + See @i{denormalized}. + + @IGindex{null} +@@ -3803,24 +3809,24 @@ + @item @b{object} + @i{n.} + 1. any Lisp datum. +- {``The function @b{cons} creates an object which refers +- to two other objects.''} ++ ``The function @b{cons} creates an object which refers ++ to two other objects.'' + 2. (immediately following the name of a @i{type}) + an @i{object} which is of that @i{type}, used to emphasize that the + @i{object} is not just a @i{name} for an object of that @i{type} + but really an @i{element} of the @i{type} in cases where @i{objects} + of that @i{type} (such as @b{function} or @b{class}) are commonly + referred to by @i{name}. +- {``The function @b{symbol-function} takes a function name +- and returns a function object.''} ++ ``The function @b{symbol-function} takes a function name ++ and returns a function object.'' + + @IGindex{object-traversing} + @item @b{object-traversing} + @i{adj.} + operating in succession on components of an @i{object}. +- {``The operators @b{mapcar}, @b{maphash}, ++ ``The operators @b{mapcar}, @b{maphash}, + @b{with-package-iterator} and @b{count} +- perform object-traversing operations.''} ++ perform object-traversing operations.'' + + @IGindex{open} + @item @b{open} +@@ -3878,7 +3884,7 @@ + @i{n.} + the kind of @i{lambda list} used by @b{lambda}. + See @i{modified lambda list} and @i{extended lambda list}. +- {``@b{defun} uses an ordinary lambda list.''} ++ ``@b{defun} uses an ordinary lambda list.'' + + @IGindex{otherwise inaccessible part} + @item @b{otherwise inaccessible part} +@@ -3957,10 +3963,10 @@ + @item @b{pairwise} + @i{adv.} (of an adjective on a set) + applying individually to all possible pairings of elements of the set. +- {``The types A, B, and C are pairwise disjoint if ++ ``The types A, B, and C are pairwise disjoint if + A and B are disjoint, + B and C are disjoint, and +- A and C are disjoint.''} ++ A and C are disjoint.'' + + @IGindex{parallel} + @item @b{parallel} +@@ -3988,8 +3994,8 @@ + due to a prefix notation within the @i{format string} at the + @i{format directive}'s point of use. + See @ref{Formatted Output}. +- {``In @t{"~3,'0D"}, the number @t{3} and the character +- @t{#\0} are parameters to the @t{~D} format directive.''} ++ ``In @t{"~3,'0D"}, the number @t{3} and the character ++ @t{#\0} are parameters to the @t{~D} format directive.'' + + @IGindex{parameter specializer} + @item @b{parameter specializer} +@@ -4150,8 +4156,8 @@ + @i{n.} (of @i{values} resulting from the + @i{evaluation} of a @i{form}) + the first @i{value}, if any, or else @b{nil} if there are no @i{values}. +- {``The primary value returned by @b{truncate} is an +- integer quotient, truncated toward zero.''} ++ ``The primary value returned by @b{truncate} is an ++ integer quotient, truncated toward zero.'' + + @IGindex{principal} + @item @b{principal} +@@ -4501,8 +4507,8 @@ + 2. (of a @i{pathname}) + representing a position in a directory hierarchy by motion + from a position other than the root, which might therefore vary. +- {``The notation @t{#P"../foo.text"} denotes a relative +- pathname if the host file system is Unix.''} ++ ``The notation @t{#P"../foo.text"} denotes a relative ++ pathname if the host file system is Unix.'' + See @i{absolute}. + + @IGindex{repertoire} +@@ -4563,6 +4569,7 @@ + as the @i{restart} which it invokes. Figure 26--4 shows a list of the + @i{standardized} @i{restart functions}. + ++@format + @group + @noindent + @w{ abort muffle-warning use-value } +@@ -4572,6 +4579,7 @@ + @w{ Figure 26--4: Standardized Restart Functions} + + @end group ++@end format + + @IGindex{return} + @item @b{return} +@@ -4646,8 +4654,8 @@ + @i{adj.} + 1. (of @i{objects} under a specified @i{predicate}) + indistinguishable by that @i{predicate}. +- {``The symbol @t{car}, the string @t{"car"}, and the string @t{"CAR"} +- are the @t{same} under @b{string-equal}''}. ++ ``The symbol @t{car}, the string @t{"car"}, and the string @t{"CAR"} ++ are the @t{same} under @b{string-equal}''. + 2. (of @i{objects} if no predicate is implied by context) + indistinguishable by @b{eql}. + Note that @b{eq} might be capable of distinguishing some +@@ -4656,13 +4664,13 @@ + is @i{implementation-dependent}. + Since @b{eq} is used only rarely in this specification, + @b{eql} is the default predicate when none is mentioned explicitly. +- {``The conses returned by two successive calls to @b{cons} +- are never the same.''} ++ ``The conses returned by two successive calls to @b{cons} ++ are never the same.'' + 3. (of @i{types}) having the same set of @i{elements}; + that is, each @i{type} is a @i{subtype} of the others. +- {``The types specified by @t{(integer 0 1)}, ++ ``The types specified by @t{(integer 0 1)}, + @t{(unsigned-byte 1)}, +- and @t{bit} are the same.''} ++ and @t{bit} are the same.'' + + @IGindex{satisfy the test} + @item @b{satisfy the test} +@@ -4711,7 +4719,7 @@ + @i{evaluation} of a @i{form}) + the second @i{value}, if any, + or else @b{nil} if there are fewer than two @i{values}. +- {``The secondary value returned by @b{truncate} is a remainder.''} ++ ``The secondary value returned by @b{truncate} is a remainder.'' + + @IGindex{section} + @item @b{section} +@@ -4726,7 +4734,7 @@ + @i{cons}. + If a @i{self-evaluating object} is @i{evaluated}, + it @i{yields} itself as its only @i{value}. +- {``Strings are self-evaluating objects.''} ++ ``Strings are self-evaluating objects.'' + + @IGindex{semi-standard} + @item @b{semi-standard} +@@ -4822,13 +4830,13 @@ + @item @b{shadow} + @i{v.t.} + 1. to override the meaning of. +- {``That binding of @t{X} shadows an outer one.''} ++ ``That binding of @t{X} shadows an outer one.'' + 2. to hide the presence of. +- {``That @b{macrolet} of @t{F} shadows the +- outer @b{flet} of @t{F}.''} ++ ``That @b{macrolet} of @t{F} shadows the ++ outer @b{flet} of @t{F}.'' + 3. to replace. +- {``That package shadows the symbol @t{cl:car} with +- its own symbol @t{car}.''} ++ ``That package shadows the symbol @t{cl:car} with ++ its own symbol @t{car}.'' + + @IGindex{shadowing symbol} + @item @b{shadowing symbol} +@@ -4981,7 +4989,7 @@ + @item @b{singleton} + @i{adj.} (of a @i{sequence}) + having only one @i{element}. +- {``@t{(list 'hello)} returns a singleton list.''} ++ ``@t{(list 'hello)} returns a singleton list.'' + + @IGindex{situation} + @item @b{situation} +@@ -5067,8 +5075,8 @@ + having an @i{actual array element type} + that is a @i{proper subtype} of the @i{type} @b{t}; + see @ref{Array Elements}. +- {``@t{(make-array 5 :element-type 'bit)} makes an array of length +- five that is specialized for bits.''} ++ ``@t{(make-array 5 :element-type 'bit)} makes an array of length ++ five that is specialized for bits.'' + + @IGindex{specialized lambda list} + @item @b{specialized lambda list} +@@ -5086,8 +5094,8 @@ + whose last element is a @i{list} L2 of length m + (denoting a list L3 of length m+n-1 whose @i{elements} are + L1_i for i < n-1 followed by L2_j for j < m). +- {``The list (1 2 (3 4 5)) is a spreadable argument list designator for +- the list (1 2 3 4 5).''} ++ ``The list (1 2 (3 4 5)) is a spreadable argument list designator for ++ the list (1 2 3 4 5).'' + + @IGindex{stack allocate} + @item @b{stack allocate} +@@ -5190,8 +5198,8 @@ + @item @b{standardized} + @i{adj.} (of a @i{name}, @i{object}, or definition) + having been defined by @r{Common Lisp}. +- {``All standardized variables that are required to +- hold bidirectional streams have ``@t{-io*}'' in their name.''} ++ ``All standardized variables that are required to ++ hold bidirectional streams have ``@t{-io*}'' in their name.'' + + @IGindex{startup environment} + @item @b{startup environment} +@@ -5341,8 +5349,8 @@ + an @i{expression} that is a @i{subexpression} of the @i{form}, + and which by virtue of its position in that @i{form} is also a + @i{form}. +- {``@t{(f x)} and @t{x}, but not @t{exit}, are subforms of +- @t{(return-from exit (f x))}.''} ++ ``@t{(f x)} and @t{x}, but not @t{exit}, are subforms of ++ @t{(return-from exit (f x))}.'' + + @IGindex{subrepertoire} + @item @b{subrepertoire} +@@ -5465,15 +5473,15 @@ + an @i{object} that is the @i{same} as either some @i{cons} + which makes up that @i{list} or the @i{atom} (if any) which terminates + the @i{list}. +- {``The empty list is a tail of every proper list.''} ++ ``The empty list is a tail of every proper list.'' + + @IGindex{target} + @item @b{target} + @i{n.} + 1. (of a @i{constructed stream}) + a @i{constituent} of the @i{constructed stream}. +- {``The target of a synonym stream is +- the value of its synonym stream symbol.''} ++ ``The target of a synonym stream is ++ the value of its synonym stream symbol.'' + 2. (of a @i{displaced array}) + the @i{array} to which the @i{displaced array} is displaced. + (In the case of a chain of @i{constructed streams} or @i{displaced arrays}, +@@ -5611,7 +5619,7 @@ + @i{S_a} is a @i{subtype} of @i{S_b}.) + 2. (immediately following the name of a @i{type}) + a @i{subtype} of that @i{type}. +- {``The type @b{vector} is an array type.''} ++ ``The type @b{vector} is an array type.'' + + @IGindex{type declaration} + @item @b{type declaration} +@@ -5641,9 +5649,9 @@ + @item @b{type specifier} + @i{n.} + an @i{expression} that denotes a @i{type}. +- {``The symbol @t{random-state}, the list @t{(integer 3 5)}, ++ ``The symbol @t{random-state}, the list @t{(integer 3 5)}, + the list @t{(and list (not null))}, and the class named +- @t{standard-class} are type specifiers.''} ++ @t{standard-class} are type specifiers.'' + + @end table + @subheading @b{U} +@@ -5765,7 +5773,7 @@ + the @i{external symbols} of P_1 + become @i{internal symbols} of P_2 + unless they are explicitly @i{exported}.) +- {``The package @t{CL-USER} uses the package @t{CL}.''} ++ ``The package @t{CL-USER} uses the package @t{CL}.'' + + @IGindex{use list} + @item @b{use list} +@@ -5808,9 +5816,9 @@ + the phrase ``a @i{list} of @i{valid array indices}'' further implies + that the @i{length} of the @i{list} must be the same as the + @i{rank} of the @i{array}.) +- {``For a @t{2} by~@t{3} array, ++ ``For a @t{2} by~@t{3} array, + valid array indices for the first dimension are @t{0} and~@t{1}, and +- valid array indices for the second dimension are @t{0}, @t{1} and~@t{2}.''} ++ valid array indices for the second dimension are @t{0}, @t{1} and~@t{2}.'' + + @IGindex{valid array row-major index} + @item @b{valid array row-major index} +@@ -6018,7 +6026,7 @@ + @item @b{yield} + @i{v.t.} (@i{values}) + to produce the @i{values} as the result of @i{evaluation}. +- {``The form @t{(+ 2 3)} yields @t{5}.''} ++ ``The form @t{(+ 2 3)} yields @t{5}.'' + + @end table + +diff -uNr gcl-texi-orig/chap-2.texi gcl-texi/chap-2.texi +--- gcl-texi-orig/chap-2.texi 1994-07-16 18:03:22 +0400 ++++ gcl-texi/chap-2.texi 2002-10-17 20:53:05 +0400 +@@ -48,6 +48,7 @@ + Figure 2--1 lists some @i{defined names} that are applicable to + @i{readtables}. + ++@format + @group + @noindent + @w{ *readtable* readtable-case } +@@ -60,6 +61,7 @@ + @w{ Figure 2--1: Readtable defined names } + + @end group ++@end format + + @menu + * The Current Readtable:: +@@ -115,6 +117,7 @@ + but also by various @i{dynamic variables}. Figure 2--2 lists + the @i{variables} that influence the behavior of the @i{Lisp reader}. + ++@format + @group + @noindent + @w{ *package* *read-default-float-format* *readtable* } +@@ -124,6 +127,7 @@ + @w{ Figure 2--2: Variables that influence the Lisp reader. } + + @end group ++@end format + + @node Standard Characters, Character Syntax Types, Variables that affect the Lisp Reader, Character Syntax + @subsection Standard Characters +@@ -140,6 +144,7 @@ + and the following additional + ninety-four @i{graphic} @i{characters} or their equivalents: + ++@format + @group + @noindent + @w{ Graphic ID Glyph Description Graphic ID Glyph Description } +@@ -174,7 +179,9 @@ + @w{ Figure 2--3: Standard Character Subrepertoire (Part 1 of 3: Latin Characters)} + + @end group ++@end format + ++@format + @group + @noindent + @w{ Graphic ID Glyph Description Graphic ID Glyph Description } +@@ -188,7 +195,9 @@ + @w{ Figure 2--4: Standard Character Subrepertoire (Part 2 of 3: Numeric Characters)} + + @end group ++@end format + ++@format + @group + @noindent + @w{ Graphic ID Glyph Description } +@@ -229,9 +238,10 @@ + @w{ Figure 2--5: Standard Character Subrepertoire (Part 3 of 3: Special Characters)} + + @end group ++@end format + + The graphic IDs are not used within @r{Common Lisp}, +-but are provided for cross reference purposes with {@r{ISO 6937/2}}. ++but are provided for cross reference purposes with @r{ISO 6937/2}. + Note that the first letter of the graphic ID + categorizes the character as follows: + L---Latin, N---Numeric, S---Special. +@@ -256,6 +266,7 @@ + Every @i{character} that can appear in the @i{input} @i{stream} + is of one of the @i{syntax types} shown in @i{Figure~2--6}. + ++@format + @group + @noindent + @w{ @i{constituent} @i{macro character} @i{single escape} } +@@ -265,6 +276,7 @@ + @w{ Figure 2--6: Possible Character Syntax Types } + + @end group ++@end format + + The @i{syntax type} of a @i{character} in a @i{readtable} + determines how that character is interpreted by the @i{Lisp reader} +@@ -274,8 +286,9 @@ + @i{Figure~2--7} + lists the @i{syntax type} of each @i{character} in @i{standard syntax}. + +-{ + ++ ++@format + @group + @noindent + @w{ character syntax type character syntax type } +@@ -306,7 +319,8 @@ + @w{ Figure 2--7: Character Syntax Types in Standard Syntax } + + @end group +-} ++@end format ++ + + The characters marked with an asterisk (*) are initially @i{constituents}, + but they are not used in any standard @r{Common Lisp} notations. +@@ -381,6 +395,7 @@ + Any @i{character} quoted by a @i{single escape} + is treated as an @i{alphabetic}_2 constituent, regardless of its normal syntax. + ++@format + @group + @noindent + @w{ constituent traits constituent traits } +@@ -421,6 +436,7 @@ + @w{ @t{|} @i{alphabetic}_2* Rubout @i{invalid} } + @w{ @t{~} @i{alphabetic}_2 } + @end group ++@end format + + @w{ Figure 2--8: Constituent Traits of Standard Characters and Semi-Standard Characters} + +@@ -799,13 +815,14 @@ + The @i{token} is interpreted as a @i{number} if it satisfies + the syntax for numbers specified in Figure 2--9. + ++@format + @group + @noindent + @w{ @i{numeric-token} ::= !@i{integer} | !@i{ratio} | !@i{float} } + @w{ @i{integer} ::= @t{[}@i{sign}@t{]} @{@i{decimal-digit}@}^+ @i{decimal-point} | @t{[}@i{sign}@t{]} @{@i{digit}@}^+ } + @w{ @i{ratio} ::= @t{[}@i{sign}@t{]} @{@i{digit}@}^+ @i{slash} @{@i{digit}@}^+ } +-@w{ @i{float} ::= @t{[}@i{sign}@t{]} @{@i{decimal-digit}@}{*} @i{decimal-point} @{@i{decimal-digit}@}^+ @t{[}!@i{exponent}@t{]} } +-@w{ | @t{[}@i{sign}@t{]} @{@i{decimal-digit}@}^+ @t{[}@i{decimal-point} @{@i{decimal-digit}@}{*}@t{]} !@i{exponent} } ++@w{ @i{float} ::= @t{[}@i{sign}@t{]} @{@i{decimal-digit}@}* @i{decimal-point} @{@i{decimal-digit}@}^+ @t{[}!@i{exponent}@t{]} } ++@w{ | @t{[}@i{sign}@t{]} @{@i{decimal-digit}@}^+ @t{[}@i{decimal-point} @{@i{decimal-digit}@}*@t{]} !@i{exponent} } + @w{ @i{exponent} ::= @i{exponent-marker} @t{[}@i{sign}@t{]} @{@i{digit}@}^+ } + @w{ @i{sign}---a @i{sign}.} + @w{ @i{slash}---a @i{slash}} +@@ -814,6 +831,7 @@ + @w{ @i{decimal-digit}---a @i{digit} in @i{radix} @t{10}.} + @w{ @i{digit}---a @i{digit} in the @i{current input radix}.} + @end group ++@end format + + @w{ Figure 2--9: Syntax for Numeric Tokens} + +@@ -863,7 +881,7 @@ + The syntax involving a leading + @i{package marker} followed by a @i{potential number} is + not well-defined. The consequences of the use +-of notation such as @t{:1}, @t{:1/2}, and @t{:2{@t{^}}3} in a ++of notation such as @t{:1}, @t{:1/2}, and @t{:2^3} in a + position where an expression appropriate for @b{read} + is expected are unspecified. + +@@ -916,42 +934,48 @@ + a @i{conforming implementation} is permitted, but not required, + to define their meaning. + ++@format + @group + @noindent + @w{ @t{1b5000} @t{777777q} @t{1.7J} @t{-3/4+6.7J} @t{12/25/83} } +-@w{ @t{27{@t{^}}19} @t{3{@t{^}}4/5} @t{6//7} @t{3.1.2.6} @t{{@t{^}}-43@t{^}} } ++@w{ @t{27^19} @t{3^4/5} @t{6//7} @t{3.1.2.6} @t{@t{^}-43@t{^}} } + @w{ @t{3.141_592_653_589_793_238_4} @t{-3.7+2.6i-6.17j+19.6k} } + + @noindent + @w{ Figure 2--10: Examples of reserved tokens } + + @end group ++@end format + + The @i{tokens} in Figure 2--11 are not @i{potential numbers}; + they are always treated as @i{symbols}: + ++@format + @group + @noindent + @w{ @t{/} @t{/5} @t{+} @t{1+} @t{1-} } +-@w{ @t{foo+} @t{ab.cd} @t{_} @t{@t{^}} @t{{@t{^}}/-} } ++@w{ @t{foo+} @t{ab.cd} @t{_} @t{@t{^}} @t{@t{^}/-} } + + @noindent + @w{ Figure 2--11: Examples of symbols} + + @end group ++@end format + + The @i{tokens} in Figure 2--12 are @i{potential numbers} + if the @i{current input base} is @t{16}, + but they are always treated as @i{symbols} if the @i{current input base} is @t{10}. + ++@format + @group + @noindent +-@w{ @t{bad-face} @t{25-dec-83} @t{a/b} @t{fad_cafe} @t{f{@t{^}}} } ++@w{ @t{bad-face} @t{25-dec-83} @t{a/b} @t{fad_cafe} @t{f@t{^}} } + + @noindent + @w{ Figure 2--12: Examples of symbols or potential numbers} + + @end group ++@end format + + @node Constructing Numbers from Tokens, The Consing Dot, Numbers as Tokens, Interpretation of Tokens + @subsection Constructing Numbers from Tokens +@@ -1005,12 +1029,13 @@ + entirely of zeros. + Examples of @i{ratios} are in Figure 2--13. + ++@format + @group + @noindent + @w{ @t{2/3} ;This is in canonical form } + @w{ @t{4/6} ;A non-canonical form for 2/3 } + @w{ @t{-17/23} ;A ratio preceded by a sign } +-@w{ @t{-30517578125/32768} ;This is (-5/2)^{15} } ++@w{ @t{-30517578125/32768} ;This is (-5/2)^15 } + @w{ @t{10/5} ;The canonical form for this is @t{2} } + @w{ @t{#o-101/75} ;Octal notation for -65/61 } + @w{ @t{#3r120/21} ;Ternary notation for 15/7 } +@@ -1021,6 +1046,7 @@ + @w{ Figure 2--13: Examples of Ratios } + + @end group ++@end format + + [Reviewer Note by Barmar: #o, #3r, #X, and #x mentioned above + are not in the syntax rules defined just above that.] +@@ -1059,6 +1085,7 @@ + + Figure 2--14 contains examples of notations for @i{floats}: + ++@format + @group + @noindent + @w{ @t{0.0} ;Floating-point zero in default format } +@@ -1084,6 +1111,7 @@ + @w{ Figure 2--14: Examples of Floating-point numbers } + + @end group ++@end format + + For information on how @i{floats} are printed, + see @ref{Printing Floats}. +@@ -1140,6 +1168,7 @@ + these examples assume that + the @i{readtable case} of the @i{current readtable} is @t{:upcase}. + ++@format + @group + @noindent + @w{ @t{FROBBOZ} The @i{symbol} whose @i{name} is @t{FROBBOZ}. } +@@ -1163,30 +1192,33 @@ + @w{ Figure 2--15: Examples of the printed representation of symbols (Part 1 of 2)} + + @end group ++@end format + ++@format + @group + @noindent + @w{ @t{APL\\360} The @i{symbol} whose @i{name} is @t{APL\360}. } + @w{ @t{apl\\360} Also the @i{symbol} whose @i{name} is @t{APL\360}. } +-@w{ @t{\(b{@t{^}}2\)\ -\ 4*a@t{*c}} The @i{name} is @t{(B{@t{^}}2) - 4*A*C}. } ++@w{ @t{\(b@t{^}2\)\ -\ 4*a@t{*c}} The @i{name} is @t{(B@t{^}2) - 4*A*C}. } + @w{ Parentheses and two spaces in it. } +-@w{ @t{\(\b{@t{^}}2\)\ -\4*\a*\c} The @i{name} is @t{(b{@t{^}}2) - 4*a*c}. } ++@w{ @t{\(\b@t{^}2\)\ -\4*\a*\c} The @i{name} is @t{(b@t{^}2) - 4*a*c}. } + @w{ Letters explicitly lowercase. } + @w{ @t{|"|} The same as writing @t{\"}. } +-@w{ @t{|(b{@t{^}}2) - 4*a*c|} The @i{name} is @t{(b{@t{^}}2) - 4*a*c}. } ++@w{ @t{|(b@t{^}2) - 4*a*c|} The @i{name} is @t{(b@t{^}2) - 4*a*c}. } + @w{ @t{|frobboz|} The @i{name} is @t{frobboz}, not @t{FROBBOZ}. } + @w{ @t{|APL\360|} The @i{name} is @t{APL360}. } + @w{ @t{|APL\\360|} The @i{name} is @t{APL\360}. } + @w{ @t{|apl\\360|} The @i{name} is @t{apl\360}. } + @w{ @t{|\|\||} Same as @t{\|\|} ---the @i{name} is @t{||}. } +-@w{ @t{|(B{@t{^}}2) - 4*A*C|} The @i{name} is @t{(B{@t{^}}2) - 4*A*C}. } ++@w{ @t{|(B@t{^}2) - 4*A*C|} The @i{name} is @t{(B@t{^}2) - 4*A*C}. } + @w{ Parentheses and two spaces in it. } +-@w{ @t{|(b{@t{^}}2) - 4*a*c|} The @i{name} is @t{(b{@t{^}}2) - 4*a*c}. } ++@w{ @t{|(b@t{^}2) - 4*a*c|} The @i{name} is @t{(b@t{^}2) - 4*a*c}. } + + @noindent + @w{ Figure 2--16: Examples of the printed representation of symbols (Part 2 of 2)} + + @end group ++@end format + + In the process of parsing a @i{symbol}, + it is @i{implementation-dependent} which +@@ -1214,6 +1246,7 @@ + + The valid patterns for @i{tokens} are summarized in Figure 2--17. + ++@format + @group + @noindent + @w{ @t{@i{nnnnn}} a @i{number} } +@@ -1232,6 +1265,7 @@ + @w{ Figure 2--17: Valid patterns for tokens } + + @end group ++@end format + + Note that @i{nnnnn} has number syntax, + neither @i{xxxxx} nor @i{ppppp} has number syntax, +@@ -1591,6 +1625,7 @@ + + Examples of the use of the @i{double-quote} character are in Figure 2--18. + ++@format + @group + @noindent + @w{ @t{"Foo"} ;A string with three characters in it } +@@ -1602,6 +1637,7 @@ + @w{ Figure 2--18: Examples of the use of double-quote } + + @end group ++@end format + + Note that to place a single escape character or a @i{double-quote} into a string, + such a character must be preceded by a single escape character. +@@ -1670,7 +1706,7 @@ + may be interpreted to mean + + @example +- (append {[} x1{]} {[} x2{]} {[} x3{]} ... {[} xn{]} (quote atom)) ++ (append [ x1 ] [ x2 ] [ x3 ] ... [ xn ] (quote atom)) + @end example + + where the brackets are used to indicate +@@ -1699,7 +1735,7 @@ + @t{`(x1 x2 x3 ... xn . ,form)} may be interpreted to mean + + @example +- (append {[} x1{]} {[} x2{]} {[} x3{]} ... {[} xn{]} form) ++ (append [ x1 ] [ x2 ] [ x3 ] ... [ xn ] form) + @end example + + where the brackets indicate a transformation of an @t{xj} as described above. +@@ -1769,7 +1805,7 @@ + requirement. + + Implementors who have no particular reason to make one choice or another +-might wish to refer to {IEEE Standard for the Scheme Programming Language}, which identifies a popular choice of ++might wish to refer to @b{IEEE Standard for the Scheme Programming Language}, which identifies a popular choice of + representation for such expressions that might provide useful to be useful + compatibility for some user communities. There is no requirement, however, + that any @i{conforming implementation} use this particular representation. +@@ -1804,8 +1840,9 @@ + The @i{reader macros} associated with the @i{dispatching macro character} @t{#} + are described later in this section and summarized in Figure 2--19. + +-{ + ++ ++@format + @group + @noindent + @w{ dispatch char purpose dispatch char purpose } +@@ -1837,7 +1874,7 @@ + @w{ [ undefined* T, t undefined } + @w{ @t{\} character object U, u undefined } + @w{ ] undefined* V, v undefined } +-@w{ {@t{^}} undefined W, w undefined } ++@w{ @t{^} undefined W, w undefined } + @w{ @t{_} undefined X, x hexadecimal rational } + @w{ ` undefined Y, y undefined } + @w{ @t{|} balanced comment Z, z undefined } +@@ -1847,7 +1884,8 @@ + @w{ Figure 2--19: Standard # Dispatching Macro Character Syntax } + + @end group +-} ++@end format ++ + + The combinations marked by an asterisk (*) are explicitly reserved to the + user. No @i{conforming implementation} defines them. +@@ -2075,7 +2113,7 @@ + For example, + + @example +- #B1101 @equiv{} 13 ;1101{{}_2} ++ #B1101 @equiv{} 13 ;1101_2 + #b101/11 @equiv{} 5/3 + @end example + +@@ -2091,7 +2129,7 @@ + @example + #o37/15 @equiv{} 31/13 + #o777 @equiv{} 511 +- #o105 @equiv{} 69 ;105{{}_8} ++ #o105 @equiv{} 69 ;105_8 + @end example + + The consequences are undefined if the token immediately following +@@ -2106,7 +2144,7 @@ + + @example + #xF00 @equiv{} 3840 +- #x105 @equiv{} 261 ;105{{}_@{16@}} ++ #x105 @equiv{} 261 ;105_@t{16} + @end example + + The consequences are undefined if the token immediately following +@@ -2135,6 +2173,7 @@ + Figure 2--20 contains examples of the use of @t{#B}, + @t{#O}, @t{#X}, and @t{#R}. + ++@format + @group + @noindent + @w{ @t{#2r11010101} ;Another way of writing @t{213} decimal } +@@ -2152,6 +2191,7 @@ + @w{ Figure 2--20: Radix Indicator Example } + + @end group ++@end format + + The consequences are undefined if the token immediately following + the @t{#@i{n}R} does not have the syntax of a @i{rational} in radix @i{n}. +@@ -2176,6 +2216,7 @@ + + Figure 2--21 contains examples of the use of @t{#C}. + ++@format + @group + @noindent + @w{ @t{#C(3.0s1 2.0s-1)} ;A @i{complex} with @i{small float} parts. } +@@ -2187,6 +2228,7 @@ + @w{ Figure 2--21: Complex Number Example } + + @end group ++@end format + + For further information, + see @ref{Printing Complexes} and @ref{Syntax of a Complex}. +diff -uNr gcl-texi-orig/chap-3.texi gcl-texi/chap-3.texi +--- gcl-texi-orig/chap-3.texi 1994-07-16 18:03:21 +0400 ++++ gcl-texi/chap-3.texi 2002-10-17 20:58:11 +0400 +@@ -297,6 +297,7 @@ + Figure 3--1 lists some @i{defined names} that + are applicable to assigning, binding, and defining @i{variables}. + ++@format + @group + @noindent + @w{ boundp let progv } +@@ -309,6 +310,7 @@ + @w{ Figure 3--1: Some Defined Names Applicable to Variables} + + @end group ++@end format + + The following is a description of each kind of variable. + +@@ -469,6 +471,7 @@ + Figure 3--2 lists all of the @r{Common Lisp} @i{symbols} + that have definitions as @i{special operators}. + ++@format + @group + @noindent + @w{ block let* return-from } +@@ -485,6 +488,7 @@ + @w{ Figure 3--2: Common Lisp Special Operators } + + @end group ++@end format + + @node Macro Forms, Function Forms, Special Forms, The Evaluation Model + @subsubsection Macro Forms +@@ -526,6 +530,7 @@ + Figure 3--3 lists some @i{defined names} that are applicable + to @i{macros}. + ++@format + @group + @noindent + @w{ *macroexpand-hook* macro-function macroexpand-1 } +@@ -535,6 +540,7 @@ + @w{ Figure 3--3: Defined names applicable to macros } + + @end group ++@end format + + @node Function Forms, Lambda Forms, Macro Forms, The Evaluation Model + @subsubsection Function Forms +@@ -593,6 +599,7 @@ + + Figure 3--4 lists some @i{defined names} that are applicable to @i{functions}. + ++@format + @group + @noindent + @w{ apply fdefinition mapcan } +@@ -608,6 +615,7 @@ + @w{ Figure 3--4: Some function-related defined names } + + @end group ++@end format + + @node Lambda Forms, Self-Evaluating Objects, Function Forms, The Evaluation Model + @subsubsection Lambda Forms +@@ -837,15 +845,15 @@ + + @example + (contorted-example nil nil 2) +- (block here{{}_1} ...) +- (contorted-example nil #'(lambda () (return-from here{{}_1} 4)) 1) +- (block here{{}_2} ...) +- (contorted-example #'(lambda () (return-from here{{}_1} 4)) +- #'(lambda () (return-from here{{}_2} 4)) ++ (block here_1 ...) ++ (contorted-example nil #'(lambda () (return-from here_1 4)) 1) ++ (block here_2 ...) ++ (contorted-example #'(lambda () (return-from here_1 4)) ++ #'(lambda () (return-from here_2 4)) + 0) + (funcall f) +- where f @result{} #'(lambda () (return-from here{{}_1} 4)) +- (return-from here{{}_1} 4) ++ where f @result{} #'(lambda () (return-from here_1 4)) ++ (return-from here_1 4) + @end example + + At the time the @t{funcall} is executed +@@ -854,8 +862,8 @@ + The @b{return-from} @i{form} executed as a result of the @t{funcall} + operation + refers to the outer outstanding @i{exit point} +-(here{{}_1}), not the +-inner one (here{{}_2}). ++(here_1), not the ++inner one (here_2). + It + refers to that @i{exit point} textually visible at the point of + execution of @b{function} +@@ -867,8 +875,8 @@ + @t{(funcall g)}, then the value of the call @t{(contorted-example nil nil 2)} + would be @t{9}. The value would change because + @b{funcall} would cause the +-execution of @t{(return-from here{{}_2} 4)}, thereby causing +-a return from the inner @i{exit point} (here{{}_2}). ++execution of @t{(return-from here_2 4)}, thereby causing ++a return from the inner @i{exit point} (here_2). + When that occurs, the value @t{4} is returned from the + middle invocation of @t{contorted-example}, @t{5} is added to that + to get @t{9}, and that value is returned from the outer block +@@ -967,6 +975,7 @@ + one or more @i{forms} to @i{evaluate} + and where to put the @i{values} returned by those @i{forms}. + ++@format + @group + @noindent + @w{ multiple-value-bind multiple-value-prog1 return-from } +@@ -977,6 +986,7 @@ + @w{ Figure 3--5: Some operators applicable to receiving multiple values} + + @end group ++@end format + + The @i{function} @b{values} can produce @i{multiple values}_2. + @t{(values)} returns zero values; +@@ -1202,6 +1212,7 @@ + or else a form that can, at the discretion of the @i{code} doing the expansion, + be used in place of the original @i{form}. + ++@format + @group + @noindent + @w{ *macroexpand-hook* compiler-macro-function define-compiler-macro } +@@ -1210,6 +1221,7 @@ + @w{ Figure 3--6: Defined names applicable to compiler macros } + + @end group ++@end format + + @node Purpose of Compiler Macros, Naming of Compiler Macros, Compiler Macros, Compilation Semantics + @subsubsection Purpose of Compiler Macros +@@ -1573,6 +1585,7 @@ + + plus .5 fil + \offinterlineskip ++@format + @group + @noindent + @w{ @b{CT} @b{LT} @b{E} @b{Mode} @b{Action} @b{New Mode} } +@@ -1586,6 +1599,7 @@ + @w{ No No Yes NCT Discard --- } + @w{ No No No --- Discard --- } + @end group ++@end format + + @w{ Figure 3--7: EVAL-WHEN processing} + +@@ -1689,6 +1703,7 @@ + effects happen only when the defining macros appear at + top level. + ++@format + @group + @noindent + @w{ declaim define-modify-macro defsetf } +@@ -1701,6 +1716,7 @@ + @w{ Figure 3--8: Defining Macros That Affect the Compile-Time Environment} + + @end group ++@end format + + @node Constraints on Macros and Compiler Macros, , Processing of Defining Macros, File Compilation + @subsubsection Constraints on Macros and Compiler Macros +@@ -2225,6 +2241,7 @@ + + defined by this standard. + ++@format + @group + @noindent + @w{ declaration ignore special } +@@ -2236,6 +2253,7 @@ + @w{ Figure 3--9: Common Lisp Declaration Identifiers} + + @end group ++@end format + + An implementation is free to support other (@i{implementation-defined}) + @i{declaration identifiers} as well. +@@ -2254,8 +2272,8 @@ + @subsubsection Shorthand notation for Type Declarations + + A @i{type specifier} can be used as a @i{declaration identifier}. +-@t{(@i{type-specifier} @{@i{var}@}{*})} is taken as shorthand for +-@t{(type @i{type-specifier} @{@i{var}@}{*})}. ++@t{(@i{type-specifier} @{@i{var}@}*)} is taken as shorthand for ++@t{(type @i{type-specifier} @{@i{var}@}*)}. + + @node Declaration Scope, , Declaration Identifiers, Declarations + @subsection Declaration Scope +@@ -2424,6 +2442,7 @@ + + There are several kinds of @i{lambda lists}. + ++@format + @group + @noindent + @w{ Context Kind of Lambda List } +@@ -2452,10 +2471,12 @@ + @w{ Figure 3--10: What Kind of Lambda Lists to Use } + + @end group ++@end format + + Figure 3--11 lists some @i{defined names} that are applicable + to @i{lambda lists}. + ++@format + @group + @noindent + @w{ lambda-list-keywords lambda-parameters-limit } +@@ -2464,6 +2485,7 @@ + @w{ Figure 3--11: Defined names applicable to lambda lists} + + @end group ++@end format + + @menu + * Ordinary Lambda Lists:: +@@ -2489,6 +2511,7 @@ + The @i{defined names} in Figure 3--12 are those which use + @i{ordinary lambda lists}: + ++@format + @group + @noindent + @w{ define-method-combination handler-case restart-case } +@@ -2499,10 +2522,12 @@ + @w{ Figure 3--12: Standardized Operators that use Ordinary Lambda Lists} + + @end group ++@end format + + An @i{ordinary lambda list} can contain the @i{lambda list keywords} shown + in Figure 3--13. + ++@format + @group + @noindent + @w{ @b{&allow-other-keys} @b{&key} @b{&rest} } +@@ -2512,6 +2537,7 @@ + @w{ Figure 3--13: Lambda List Keywords used by Ordinary Lambda Lists} + + @end group ++@end format + + Each @i{element} of a @i{lambda list} is either a parameter specifier + or a @i{lambda list keyword}. +@@ -2521,15 +2547,15 @@ + + The syntax for @i{ordinary lambda lists} is as follows: + +-@w{@i{lambda-list} ::=@r{(}@{@i{var}@}{*}} +-@w{ @t{[}{&optional} @{@i{var} | +- @r{(}@i{var} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*}@t{]}} +-@w{ @t{[}{&rest} @i{var}@t{]}} +-@w{ @t{[}{&key} @{@i{var} | ++@w{@i{lambda-list} ::=@r{(}@{@i{var}@}*} ++@w{ @t{[}@r{&optional} @{@i{var} | ++ @r{(}@i{var} @r{[}init-form @r{[}supplied-p-parameter @r{]}@r{]}@r{)}@}*@t{]}} ++@w{ @t{[}@r{&rest} @i{var}@t{]}} ++@w{ @t{[}@r{&key} @{@i{var} | + @r{(}@{@i{var} | + @r{(}@i{keyword-name} @i{var}@r{)}@} +- @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*} pt @r{[}@t{&allow-other-keys}@r{]}@t{]}} +-@w{ @t{[}{&aux} @{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}{*}@t{]}@r{)}} ++ @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}* pt @r{[}@t{&allow-other-keys}@r{]}@t{]}} ++@w{ @t{[}@r{&aux} @{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}*@t{]}@r{)}} + @w{ } + + A @i{var} or @i{supplied-p-parameter} must be a @i{symbol} +@@ -2759,7 +2785,7 @@ + These are not really parameters. If the @i{lambda list keyword} + @b{&aux} is present, all specifiers after it are auxiliary variable + specifiers. After all parameter specifiers have been processed, the +-auxiliary variable specifiers (those following {&aux}) are processed ++auxiliary variable specifiers (those following @b{&aux}) are processed + from left to right. For each one, @i{init-form} is evaluated and + @i{var} is bound to that value (or to @b{nil} if no @i{init-form} + was specified). @b{&aux} variable processing is analogous to +@@ -2876,16 +2902,17 @@ + + A @i{generic function lambda list} has the following syntax: + +-@w{@i{lambda-list} ::=@r{(}@{@i{var}@}{*}} +-@w{ @t{[}{&optional} @{@i{var} | @r{(}@i{var}@r{)}@}{*}@t{]}} +-@w{ @t{[}{&rest} @i{var}@t{]}} +-@w{ @t{[}{&key} @{@i{var} | @r{(}@{@i{var} | +- @r{(}@i{keyword-name} @i{var}@r{)}@}{)}@}{*} pt @r{[}@t{&allow-other-keys}@r{]}@t{]}@r{)}} ++@w{@i{lambda-list} ::=@r{(}@{@i{var}@}*} ++@w{ @t{[}@r{&optional} @{@i{var} | @r{(}@i{var}@r{)}@}*@t{]}} ++@w{ @t{[}@r{&rest} @i{var}@t{]}} ++@w{ @t{[}@r{&key} @{@i{var} | @r{(}@{@i{var} | ++ @r{(}@i{keyword-name} @i{var}@r{)}@}@r{)}@}* pt @r{[}@t{&allow-other-keys}@r{]}@t{]}@r{)}} + @w{ } + + A @i{generic function lambda list} can contain the @i{lambda list keywords} shown + in Figure 3--14. + ++@format + @group + @noindent + @w{ @b{&allow-other-keys} @b{&optional} } +@@ -2895,6 +2922,7 @@ + @w{ Figure 3--14: Lambda List Keywords used by Generic Function Lambda Lists} + + @end group ++@end format + + A @i{generic function lambda list} differs from an @i{ordinary lambda list} + in the following ways: +@@ -2923,6 +2951,7 @@ + The @i{defined names} in Figure 3--15 use @i{specialized lambda lists} + in some way; see the dictionary entry for each for information about how. + ++@format + @group + @noindent + @w{ defmethod defgeneric } +@@ -2931,10 +2960,12 @@ + @w{ Figure 3--15: Standardized Operators that use Specialized Lambda Lists} + + @end group ++@end format + + A @i{specialized lambda list} can contain the @i{lambda list keywords} shown + in Figure 3--16. + ++@format + @group + @noindent + @w{ @b{&allow-other-keys} @b{&key} @b{&rest} } +@@ -2944,20 +2975,21 @@ + @w{ Figure 3--16: Lambda List Keywords used by Specialized Lambda Lists} + + @end group ++@end format + + A @i{specialized lambda list} is syntactically the same as an @i{ordinary lambda list} + except that each @i{required parameter} may optionally be associated with a @i{class} + or @i{object} for which that @i{parameter} is @i{specialized}. + +-@w{@i{lambda-list} ::=@r{(}@{@i{var} | @r{(}@i{var} @r{[}@i{specializer}@r{]}@r{)}@}{*}} +-@w{ @t{[}{&optional} @{@i{var} | +- @r{(}@i{var} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*}@t{]}} +-@w{ @t{[}{&rest} @i{var}@t{]}} +-@w{ @t{[}{&key} @{@i{var} | ++@w{@i{lambda-list} ::=@r{(}@{@i{var} | @r{(}@i{var} @r{[}@i{specializer}@r{]}@r{)}@}*} ++@w{ @t{[}@r{&optional} @{@i{var} | ++ @r{(}@i{var} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}*@t{]}} ++@w{ @t{[}@r{&rest} @i{var}@t{]}} ++@w{ @t{[}@r{&key} @{@i{var} | + @r{(}@{@i{var} | + @r{(}@i{keyword-name} @i{var}@r{)}@} +- @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*} @r{[}@t{&allow-other-keys}@r{]}@t{]}} +-@w{ @t{[}{&aux} @{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}{*}@t{]}@r{)}} ++ @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}* @r{[}@t{&allow-other-keys}@r{]}@t{]}} ++@w{ @t{[}@r{&aux} @{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}*@t{]}@r{)}} + @w{ } + + @node Macro Lambda Lists, Destructuring Lambda Lists, Specialized Lambda Lists, Lambda Lists +@@ -2968,6 +3000,7 @@ + is used in describing @i{macros} + defined by the @i{operators} in Figure 3--17. + ++@format + @group + @noindent + @w{ define-compiler-macro defmacro macrolet } +@@ -2977,32 +3010,33 @@ + @w{ Figure 3--17: Operators that use Macro Lambda Lists} + + @end group ++@end format + + With the additional restriction that + an @i{environment parameter} may appear only once + (at any of the positions indicated), + a @i{macro lambda list} has the following syntax: + +-{ +-@w{@i{reqvars} ::=@{@i{var} | !@i{pattern}@}{*}} + +-@w{@i{optvars} ::=@t{[}{&optional} @{@i{var} | +- @r{(}{@{@i{var} | !@i{pattern}@}} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*}@t{]}} ++@w{@i{reqvars} ::=@{@i{var} | !@i{pattern}@}*} + +-@w{@i{restvar} ::=@t{[}@{{@t{&rest}} | {&body}@} @i{@{@i{var} | !@i{pattern}@}}@t{]}} ++@w{@i{optvars} ::=@t{[}@r{&optional} @{@i{var} | ++ @r{(}@r{@{@i{var} | !@i{pattern}@}} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}*@t{]}} + +-@w{@i{keyvars} ::=@r{[}{&key} @{@i{var} | ++@w{@i{restvar} ::=@t{[}@{@t{&rest} | @r{&body}@} @i{@{@i{var} | !@i{pattern}@}}@t{]}} ++ ++@w{@i{keyvars} ::=@r{[}@r{&key} @{@i{var} | + @r{(}@{@i{var} | +- @r{(}@i{keyword-name} {@{@i{var} | !@i{pattern}@}}@r{)}@} +- @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*}} ++ @r{(}@i{keyword-name} @{@i{var} | !@i{pattern}@}@r{)}@} ++ @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}*} + @w{ @r{[}@t{&allow-other-keys}@r{]}@r{]}} + +-{ +-@w{@i{auxvars} ::=@t{[}{&aux} @{@i{var} | @r{(}{@i{var}} @r{[}@i{init-form}@r{]}@r{)}@}{*}@t{]}} +-} +-@w{@i{envvar} ::=@t{[}{&environment} @i{var}@t{]}} + +-@w{@i{wholevar} ::=@t{[}{&whole} @i{var}@t{]}} ++@w{@i{auxvars} ::=@t{[}@r{&aux} @{@i{var} | @r{(}@r{@i{var}} @r{[}@i{init-form}@r{]}@r{)}@}*@t{]}} ++ ++@w{@i{envvar} ::=@t{[}@r{&environment} @i{var}@t{]}} ++ ++@w{@i{wholevar} ::=@t{[}@r{&whole} @i{var}@t{]}} + + @w{@i{lambda-list} ::=@r{(}!@i{wholevar} !@i{envvar} !@i{reqvars} !@i{envvar} !@i{optvars} !@i{envvar}} + @w{ !@i{restvar} !@i{envvar} !@i{keyvars} !@i{envvar} !@i{auxvars} !@i{envvar}@r{)} |} +@@ -3011,11 +3045,12 @@ + @w{@i{pattern} ::=@r{(}!@i{wholevar} !@i{reqvars} !@i{optvars} !@i{restvar} !@i{keyvars} !@i{auxvars}@r{)} |} + @w{ @r{(}!@i{wholevar} !@i{reqvars} !@i{optvars} @t{.} @i{var}@r{)}} + +-} ++ + + A @i{macro lambda list} can contain + the @i{lambda list keywords} shown in Figure 3--18. + ++@format + @group + @noindent + @w{ @b{&allow-other-keys} @b{&environment} @b{&rest} } +@@ -3026,6 +3061,7 @@ + @w{ Figure 3--18: Lambda List Keywords used by Macro Lambda Lists} + + @end group ++@end format + + @i{Optional parameters} (introduced by @b{&optional}) and + @i{keyword parameters} (introduced by @b{&key}) +@@ -3287,31 +3323,30 @@ + + A @i{destructuring lambda list} has the following syntax: + +-{ +-@w{@i{reqvars} ::=@{@i{var} | !@i{lambda-list}@}{*}} + +-@w{@i{optvars} ::=@t{[}{&optional} @{@i{var} | +- @r{(}{@{@i{var} | !@i{lambda-list}@}} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*}@t{]}} ++@w{@i{reqvars} ::=@{@i{var} | !@i{lambda-list}@}*} + +-@w{@i{restvar} ::=@t{[}@{{@t{&rest}} | {&body}@} @i{@{@i{var} | !@i{lambda-list}@}}@t{]}} ++@w{@i{optvars} ::=@t{[}@r{&optional} @{@i{var} | ++ @r{(}@{@i{var} | !@i{lambda-list}@} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}*@t{]}} + +-@w{@i{keyvars} ::=@r{[}{&key} @{@i{var} | ++@w{@i{restvar} ::=@t{[}@{@t{&rest}} | @t{&body}@} @i{@{@i{var} | !@i{lambda-list}@}@t{]}} ++ ++@w{@i{keyvars} ::=@r{[}@r{&key} @{@i{var} | + @r{(}@{@i{var} | +- @r{(}@i{keyword-name} {@{@i{var} | !@i{lambda-list}@}}@r{)}@} +- @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*}} ++ @r{(}@i{keyword-name} @{@i{var} | !@i{lambda-list}@}@r{)}@} ++ @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}*} + @w{ @r{[}@t{&allow-other-keys}@r{]}@r{]}} + +-{ +-@w{@i{auxvars} ::=@t{[}{&aux} @{@i{var} | @r{(}{@i{var}} @r{[}@i{init-form}@r{]}@r{)}@}{*}@t{]}} +-} +-@w{@i{envvar} ::=@t{[}{&environment} @i{var}@t{]}} + +-@w{@i{wholevar} ::=@t{[}{&whole} @i{var}@t{]}} ++@w{@i{auxvars} ::=@t{[}@r{&aux} @{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}*@t{]}} ++ ++@w{@i{envvar} ::=@t{[}@r{&environment} @i{var}@t{]}} ++ ++@w{@i{wholevar} ::=@t{[}@r{&whole} @i{var}@t{]}} + + @w{@i{lambda-list} ::=@r{(}!@i{wholevar} !@i{reqvars} !@i{optvars} !@i{restvar} !@i{keyvars} !@i{auxvars}@r{)} |} + @w{ @r{(}!@i{wholevar} !@i{reqvars} !@i{optvars} @t{.} @i{var}@r{)}} + +-} + + @node Boa Lambda Lists, Defsetf Lambda Lists, Destructuring Lambda Lists, Lambda Lists + @subsection Boa Lambda Lists +@@ -3432,19 +3467,20 @@ + + A @i{defsetf lambda list} has the following syntax: + +-@w{@i{lambda-list} ::=@r{(}@{@i{var}@}{*}} +-@w{ @t{[}{&optional} @{@i{var} | +- @r{(}@i{var} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*}@t{]}} +-@w{ @t{[}{&rest} @i{var}@t{]}} +-@w{ @t{[}{&key} @{@i{var} | ++@w{@i{lambda-list} ::=@r{(}@{@i{var}@}*} ++@w{ @t{[}@r{&optional} @{@i{var} | ++ @r{(}@i{var} @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}*@t{]}} ++@w{ @t{[}@r{&rest} @i{var}@t{]}} ++@w{ @t{[}@r{&key} @{@i{var} | + @r{(}@{@i{var} | + @r{(}@i{keyword-name} @i{var}@r{)}@} +- @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}{*} pt @r{[}@t{&allow-other-keys}@r{]}@t{]}} +-@w{ @t{[}{&environment} @i{var}@t{]}} ++ @r{[}init-form @r{[}supplied-p-parameter@r{]}@r{]}@r{)}@}* pt @r{[}@t{&allow-other-keys}@r{]}@t{]}} ++@w{ @t{[}@r{&environment} @i{var}@t{]}} + + A @i{defsetf lambda list} can contain the @i{lambda list keywords} shown + in Figure 3--19. + ++@format + @group + @noindent + @w{ @b{&allow-other-keys} @b{&key} @b{&rest} } +@@ -3454,6 +3490,7 @@ + @w{ Figure 3--19: Lambda List Keywords used by Defsetf Lambda Lists} + + @end group ++@end format + + A @i{defsetf lambda list} differs from an @i{ordinary lambda list} + only in that it does not permit the use of @b{&aux}, +@@ -3486,6 +3523,7 @@ + A @i{define-modify-macro lambda list} can contain the + @i{lambda list keywords} shown in Figure 3--20. + ++@format + @group + @noindent + @w{ @b{&optional} @b{&rest} } +@@ -3494,6 +3532,7 @@ + @w{ Figure 3--20: Lambda List Keywords used by Define-modify-macro Lambda Lists} + + @end group ++@end format + + @i{Define-modify-macro lambda lists} are similar to + @i{ordinary lambda lists}, but do not support keyword arguments. +@@ -3513,6 +3552,7 @@ + A @i{define-method-combination arguments lambda list} can contain the + @i{lambda list keywords} shown in Figure 3--21. + ++@format + @group + @noindent + @w{ @b{&allow-other-keys} @b{&key} @b{&rest} } +@@ -3522,6 +3562,7 @@ + @w{ Figure 3--21: Lambda List Keywords used by Define-method-combination arguments Lambda Lists} + + @end group ++@end format + + @i{Define-method-combination arguments lambda lists} are similar to + @i{ordinary lambda lists}, but also permit the use of @b{&whole}. +@@ -3979,7 +4020,7 @@ + + @subsubheading Syntax:: + +-@code{lambda} @i{lambda-list {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}} ++@code{lambda} @i{lambda-list [[@{@i{declaration}@}* | @i{documentation}]] @{@i{form}@}*} + @subsubheading Arguments:: + + @i{lambda-list}---an @i{ordinary lambda list}. +@@ -4003,7 +4044,7 @@ + @subsubheading See Also:: + + @b{function}, +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Lambda Expressions}, + @ref{Lambda Forms}, +@@ -4026,7 +4067,7 @@ + @node lambda, compile, lambda (Symbol), Evaluation and Compilation Dictionary + @subsection lambda [Macro] + +-@code{lambda} @i{lambda-list {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}} @result{} @i{@i{function}} ++@code{lambda} @i{lambda-list [[@{@i{declaration}@}* | @i{documentation}]] @{@i{form}@}*} @result{} @i{@i{function}} + + @subsubheading Arguments and Values:: + +@@ -4046,9 +4087,9 @@ + involving a @i{lambda expression} such that: + + @example +- (lambda @i{lambda-list} {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}) +- @equiv{} (function (lambda @i{lambda-list} {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*})) +- @equiv{} #'(lambda @i{lambda-list} {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}) ++ (lambda @i{lambda-list} [[@{@i{declaration}@}* | @i{documentation}]] @{@i{form}@}*) ++ @equiv{} (function (lambda @i{lambda-list} [[@{@i{declaration}@}* | @i{documentation}]] @{@i{form}@}*)) ++ @equiv{} #'(lambda @i{lambda-list} [[@{@i{declaration}@}* | @i{documentation}]] @{@i{form}@}*) + @end example + + @subsubheading Examples:: +@@ -4074,7 +4115,7 @@ + @node compile, eval, lambda, Evaluation and Compilation Dictionary + @subsection compile [Function] + +-@code{compile} @i{name {&optional} definition} @result{} @i{function, warnings-p, failure-p} ++@code{compile} @i{name @r{&optional} definition} @result{} @i{function, warnings-p, failure-p} + + @subsubheading Arguments and Values:: + +@@ -4174,7 +4215,7 @@ + @node eval, eval-when, compile, Evaluation and Compilation Dictionary + @subsection eval [Function] + +-@code{eval} @i{form} @result{} @i{@{@i{result}@}{*}} ++@code{eval} @i{form} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -4242,19 +4283,19 @@ + @node eval-when, load-time-value, eval, Evaluation and Compilation Dictionary + @subsection eval-when [Special Operator] + +-@code{eval-when} @i{@r{(}@{@i{situation}@}{*}@r{)} @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{eval-when} @i{@r{(}@{@i{situation}@}*@r{)} @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + + @i{situation}---One of the @i{symbols} + @t{:compile-toplevel} +-@IKindex{compile-toplevel} ++@c @IKindex{compile-toplevel} + , + @t{:load-toplevel} +-@IKindex{load-toplevel} ++@c @IKindex{load-toplevel} + , + @t{:execute} +-@IKindex{execute} ++@c @IKindex{execute} + , + @b{compile} + @IRindex{compile} +@@ -4452,7 +4493,7 @@ + @node load-time-value, quote, eval-when, Evaluation and Compilation Dictionary + @subsection load-time-value [Special Operator] + +-@code{load-time-value} @i{form {&optional} read-only-p} @result{} @i{object} ++@code{load-time-value} @i{form @r{&optional} read-only-p} @result{} @i{object} + + @subsubheading Arguments and Values:: + +@@ -4653,9 +4694,9 @@ + @node compiler-macro-function, define-compiler-macro, quote, Evaluation and Compilation Dictionary + @subsection compiler-macro-function [Accessor] + +-@code{compiler-macro-function} @i{name {&optional} environment} @result{} @i{function} ++@code{compiler-macro-function} @i{name @r{&optional} environment} @result{} @i{function} + +-(setf (@code{ compiler-macro-function} @i{name {&optional} environment}) new-function)@* ++(setf (@code{ compiler-macro-function} @i{name @r{&optional} environment}) new-function)@* + + @subsubheading Arguments and Values:: + +@@ -4685,7 +4726,7 @@ + @node define-compiler-macro, defmacro, compiler-macro-function, Evaluation and Compilation Dictionary + @subsection define-compiler-macro [Macro] + +-@code{define-compiler-macro} @i{name lambda-list {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}}@* ++@code{define-compiler-macro} @i{name lambda-list [[@{@i{declaration}@}* | @i{documentation}]] @{@i{form}@}*}@* + @result{} @i{name} + + @subsubheading Arguments and Values:: +@@ -4849,7 +4890,7 @@ + , + @ref{defmacro} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Syntactic Interaction of Documentation Strings and Declarations} + +@@ -4867,7 +4908,7 @@ + @node defmacro, macro-function, define-compiler-macro, Evaluation and Compilation Dictionary + @subsection defmacro [Macro] + +-@code{defmacro} @i{name lambda-list {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}}@* ++@code{defmacro} @i{name lambda-list [[@{@i{declaration}@}* | @i{documentation}]] @{@i{form}@}*}@* + @result{} @i{name} + + @subsubheading Arguments and Values:: +@@ -5041,9 +5082,9 @@ + + @ref{destructuring-bind} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , +-@ref{macroexpand; macroexpand-1} ++@ref{macroexpand} + , + @b{*macroexpand-hook*}, + @b{macrolet}, +@@ -5056,9 +5097,9 @@ + @node macro-function, macroexpand, defmacro, Evaluation and Compilation Dictionary + @subsection macro-function [Accessor] + +-@code{macro-function} @i{symbol {&optional} environment} @result{} @i{function} ++@code{macro-function} @i{symbol @r{&optional} environment} @result{} @i{function} + +-(setf (@code{ macro-function} @i{symbol {&optional} environment}) new-function)@* ++(setf (@code{ macro-function} @i{symbol @r{&optional} environment}) new-function)@* + + @subsubheading Arguments and Values:: + +@@ -5139,10 +5180,10 @@ + @node macroexpand, define-symbol-macro, macro-function, Evaluation and Compilation Dictionary + @subsection macroexpand, macroexpand-1 [Function] + +-@code{macroexpand} @i{form {&optional} env} @result{} @i{expansion, expanded-p} ++@code{macroexpand} @i{form @r{&optional} env} @result{} @i{expansion, expanded-p} + +-@code{macroexpand-} @i{1} @result{} @i{form {&optional} env} +- {expansion, expanded-p} ++@code{macroexpand-} @i{1} @result{} @i{form @r{&optional} env} ++ @r{expansion, expanded-p} + + @subsubheading Arguments and Values:: + +@@ -5276,7 +5317,7 @@ + @b{*macroexpand-hook*}, + @ref{defmacro} + , +-@ref{setf; psetf} ++@ref{setf} + of + @ref{macro-function} + , +@@ -5372,15 +5413,15 @@ + + @ref{symbol-macrolet} + , +-@ref{macroexpand; macroexpand-1} ++@ref{macroexpand} + + @node symbol-macrolet, *macroexpand-hook*, define-symbol-macro, Evaluation and Compilation Dictionary + @subsection symbol-macrolet [Special Operator] + +-@code{symbol-macrolet} @i{@r{(}@{{(}symbol expansion@r{)}@}{*}@r{)} +- @{@i{declaration}@}{*} +- @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{symbol-macrolet} @i{@r{(}@{@r{(}symbol expansion @r{)}@}*@r{)} ++ @{@i{declaration}@}* ++ @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -5463,7 +5504,7 @@ + + @ref{with-slots} + , +-@ref{macroexpand; macroexpand-1} ++@ref{macroexpand} + + @subsubheading Notes:: + +@@ -5518,7 +5559,7 @@ + + @subsubheading See Also:: + +-@ref{macroexpand; macroexpand-1} ++@ref{macroexpand} + , @b{macroexpand-1}, + @ref{funcall} + , @ref{Evaluation} +@@ -5566,6 +5607,7 @@ + Figure 3--22 shows a list of @i{declaration identifiers} + that can be used with @b{proclaim}. + ++@format + @group + @noindent + @w{ declaration inline optimize type } +@@ -5575,6 +5617,7 @@ + @w{ Figure 3--22: Global Declaration Specifiers} + + @end group ++@end format + + An implementation is free to support other (@i{implementation-defined}) + @i{declaration identifiers} as well. +@@ -5628,7 +5671,7 @@ + @node declaim, declare, proclaim, Evaluation and Compilation Dictionary + @subsection declaim [Macro] + +-@code{declaim} @i{@{@i{declaration-specifier}@}{*}} @result{} @i{@i{implementation-dependent}} ++@code{declaim} @i{@{@i{declaration-specifier}@}*} @result{} @i{@i{implementation-dependent}} + + @subsubheading Arguments and Values:: + +@@ -5656,7 +5699,7 @@ + + @subsubheading Syntax:: + +-@code{declare} @i{@{@i{declaration-specifier}@}{*}} ++@code{declare} @i{@{@i{declaration-specifier}@}*} + @subsubheading Arguments:: + + @i{declaration-specifier}---a @i{declaration specifier}; not evaluated. +@@ -5671,6 +5714,7 @@ + A @b{declare} @i{expression} can occur in a @i{lambda expression} + or in any of the @i{forms} listed in Figure 3--23. + ++@format + @group + @noindent + @w{ defgeneric do-external-symbols prog } +@@ -5691,6 +5735,7 @@ + @w{ Figure 3--23: Standardized Forms In Which Declarations Can Occur } + + @end group ++@end format + + A @b{declare} @i{expression} can only occur + where specified by the syntax of these @i{forms}. +@@ -5708,6 +5753,7 @@ + Figure 3--24 shows a list of @i{declaration identifiers} + that can be used with @b{declare}. + ++@format + @group + @noindent + @w{ dynamic-extent ignore optimize } +@@ -5718,6 +5764,7 @@ + @w{ Figure 3--24: Local Declaration Specifiers} + + @end group ++@end format + + An implementation is free to support other (@i{implementation-defined}) + @i{declaration identifiers} as well. +@@ -5782,9 +5829,9 @@ + + @subsubheading Syntax:: + +-@t{@r{(}ignore @{@i{var} | @r{(}@b{function} @i{fn}@r{)}@}{*}@r{)}} ++@t{@r{(}ignore @{@i{var} | @r{(}@b{function} @i{fn}@r{)}@}*@r{)}} + +-@t{@r{(}ignorable @{@i{var} | @r{(}@b{function} @i{fn}@r{)}@}{*}@r{)}} ++@t{@r{(}ignorable @{@i{var} | @r{(}@b{function} @i{fn}@r{)}@}*@r{)}} + + @subsubheading Arguments:: + +@@ -5861,7 +5908,7 @@ + + @subsubheading Syntax:: + +-@t{(dynamic-extent [[@{@i{var}@}{*} | ++@t{(dynamic-extent [[@{@i{var}@}* | + @r{(}@b{function} @i{fn}@r{)}@r{*}]])} + + @subsubheading Arguments:: +@@ -6075,9 +6122,9 @@ + + @subsubheading Syntax:: + +-@t{(type @i{typespec} @{@i{var}@}{*})} ++@t{(type @i{typespec} @{@i{var}@}*)} + +-@t{(@i{typespec} @{@i{var}@}{*})} ++@t{(@i{typespec} @{@i{var}@}*)} + + @subsubheading Arguments:: + +@@ -6250,8 +6297,8 @@ + + @subsubheading Notes:: + +-@t{(@i{typespec} @{@i{var}@}{*})} +-is an abbreviation for @t{(type @i{typespec} @{@i{var}@}{*})}. ++@t{(@i{typespec} @{@i{var}@}*)} ++is an abbreviation for @t{(type @i{typespec} @{@i{var}@}*)}. + + A @b{type} declaration for the arguments to a function does not + necessarily imply anything about the type of the result. The following +@@ -6303,9 +6350,9 @@ + + @subsubheading Syntax:: + +-@t{(inline @{@i{function-name}@}{*})} ++@t{(inline @{@i{function-name}@}*)} + +-@t{(notinline @{@i{function-name}@}{*})} ++@t{(notinline @{@i{function-name}@}*)} + + @subsubheading Arguments:: + +@@ -6422,7 +6469,7 @@ + + @subsubheading Syntax:: + +-@t{(ftype @i{type} @{@i{function-name}@}{*})} ++@t{(ftype @i{type} @{@i{function-name}@}*)} + + @subsubheading Arguments:: + +@@ -6483,7 +6530,7 @@ + + @subsubheading Syntax:: + +-@t{(declaration @{@i{name}@}{*})} ++@t{(declaration @{@i{name}@}*)} + + @subsubheading Arguments:: + +@@ -6522,7 +6569,7 @@ + + @subsubheading Syntax:: + +-@t{(optimize @{@i{quality} | (@i{quality} @i{value})@}{*})} ++@t{(optimize @{@i{quality} | (@i{quality} @i{value})@}*)} + + @IRindex{compilation-speed} + +@@ -6552,6 +6599,7 @@ + the names and meanings of the standard @i{optimize qualities} are shown in + Figure 3--25. + ++@format + @group + @noindent + @w{ Name Meaning } +@@ -6565,6 +6613,7 @@ + @w{ Figure 3--25: Optimize qualities } + + @end group ++@end format + + There may be other, @i{implementation-defined} @i{optimize qualities}. + +@@ -6617,7 +6666,7 @@ + + @subsubheading Syntax:: + +-@t{(special @{@i{var}@}{*})} ++@t{(special @{@i{var}@}*)} + + @subsubheading Arguments:: + +@@ -6764,14 +6813,14 @@ + + @subsubheading See Also:: + +-@ref{defparameter; defvar} ++@ref{defparameter} + , + @b{defvar} + + @node locally, the, special, Evaluation and Compilation Dictionary + @subsection locally [Special Operator] + +-@code{locally} @i{@{@i{declaration}@}{*} @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{locally} @i{@{@i{declaration}@}* @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -6838,7 +6887,7 @@ + @node the, special-operator-p, locally, Evaluation and Compilation Dictionary + @subsection the [Special Operator] + +-@code{the} @i{value-type form} @result{} @i{@{@i{result}@}{*}} ++@code{the} @i{value-type form} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -6950,7 +6999,7 @@ + @node constantp, , special-operator-p, Evaluation and Compilation Dictionary + @subsection constantp [Function] + +-@code{constantp} @i{form {&optional} environment} @result{} @i{generalized-boolean} ++@code{constantp} @i{form @r{&optional} environment} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/chap-4.texi gcl-texi/chap-4.texi +--- gcl-texi-orig/chap-4.texi 1994-07-16 18:03:20 +0400 ++++ gcl-texi/chap-4.texi 2002-10-17 20:53:05 +0400 +@@ -88,6 +88,7 @@ + that are particularly relevant to the object system. + @i{Figure~9--1} lists the defined @i{condition} @i{types}. + ++@format + @group + @noindent + @w{ @b{Section} Data Type } +@@ -106,6 +107,7 @@ + @w{ Figure 4--1: Cross-References to Data Type Information } + + @end group ++@end format + + @node Type Relationships, Type Specifiers, Data Type Definition, Types + @subsection Type Relationships +@@ -182,6 +184,7 @@ + or + @b{deftype}. + ++@format + @group + @noindent + @w{ arithmetic-error function simple-condition } +@@ -222,6 +225,7 @@ + @w{ Figure 4--2: Standardized Atomic Type Specifiers } + + @end group ++@end format + + \indent + If a @i{type specifier} is a @i{list}, the @i{car} of the @i{list} +@@ -270,6 +274,7 @@ + and then to + @t{vector}. + ++@format + @group + @noindent + @w{ and long-float simple-base-string } +@@ -288,11 +293,13 @@ + @w{ Figure 4--3: Standardized Compound Type Specifier Names} + + @end group ++@end format + + Figure 4--4 show the @i{defined names} that can be used as + @i{compound type specifier} @i{names} + but that cannot be used as @i{atomic type specifiers}. + ++@format + @group + @noindent + @w{ and mod satisfies } +@@ -303,6 +310,7 @@ + @w{ Figure 4--4: Standardized Compound-Only Type Specifier Names} + + @end group ++@end format + + New @i{type specifiers} can come into existence in two ways. + @table @asis +@@ -327,6 +335,7 @@ + Figure 4--5 shows some @i{defined names} relating to + @i{types} and @i{declarations}. + ++@format + @group + @noindent + @w{ coerce defstruct subtypep } +@@ -339,12 +348,14 @@ + @w{ Figure 4--5: Defined names relating to types and declarations.} + + @end group ++@end format + + Figure 4--6 shows all @i{defined names} that are @i{type specifier} @i{names}, + whether for @i{atomic type specifiers} or @i{compound type specifiers}; + this list is the union of the lists in @i{Figure~4--2} + and @i{Figure~4--3}. + ++@format + @group + @noindent + @w{ and function simple-array } +@@ -387,6 +398,7 @@ + @w{ Figure 4--6: Standardized Type Specifier Names } + + @end group ++@end format + + @c end of including concept-types + +@@ -400,6 +412,7 @@ + @b{symbol}), Figure 4--7 contains a list of @i{classes} that are + especially relevant to understanding the object system. + ++@format + @group + @noindent + @w{ built-in-class method-combination standard-object } +@@ -411,6 +424,7 @@ + @w{ Figure 4--7: Object System Classes } + + @end group ++@end format + + @menu + * Introduction to Classes:: +@@ -744,7 +758,7 @@ + + Let S_C be the set of C and its @i{superclasses}. Let R be + +-@center R=\bigcup_@{c\in {S_C}@}R_c ++@center R=\bigcup_@{c\in S_C @}R_c + . + + [Reviewer Note by Barmar: ``Consistent'' needs to be defined, or maybe we should say +@@ -838,25 +852,25 @@ + (defclass food () ()) + @end example + +-The set S_@{pie@}~= @{{pie, apple, cinnamon, fruit, spice, food, +-standard-object, t}@}. The set R~= @{{(pie, apple), ++The set S_@{pie@}~= @{pie, apple, cinnamon, fruit, spice, food, ++standard-object, t @}. The set R~= @{ (pie, apple), + (apple, cinnamon), (apple, fruit), (cinnamon, spice), \break + (fruit, food), (spice, food), (food, standard-object), (standard-object, +-t)}@}. ++t) @}. + + The class @t{pie} is not preceded by anything, so it comes first; + the result so far is @t{(pie)}. Remove @t{pie} from S and pairs +-mentioning @t{pie} from R to get S~= @{{apple, cinnamon, +-fruit, spice, food, standard-object, t}@} and R~=~@{{(apple, cinnamon), (apple, fruit), (cinnamon, spice),\break (fruit, ++mentioning @t{pie} from R to get S~= @{apple, cinnamon, ++fruit, spice, food, standard-object, t @} and R~=~@{(apple, cinnamon), (apple, fruit), (cinnamon, spice),\break (fruit, + food), (spice, food), (food, standard-object), +-(standard-object, t)}@}. ++(standard-object, t) @}. + + The class @t{apple} is not preceded by anything, so it is next; the + result is @t{(pie apple)}. Removing @t{apple} and the relevant +-pairs results in S~= @{{cinnamon, fruit, spice, food, +-standard-object, t}@} and R~= @{{(cinnamon, spice), ++pairs results in S~= @{ cinnamon, fruit, spice, food, ++standard-object, t @} and R~= @{ (cinnamon, spice), + (fruit, food), (spice, food), (food, standard-object),\break +-(standard-object, t)}@}. ++(standard-object, t) @}. + + The classes @t{cinnamon} and @t{fruit} are not preceded by + anything, so the one with a direct @i{subclass} rightmost in the +@@ -865,14 +879,14 @@ + @i{subclass} of @t{cinnamon}. Because @t{apple} appears to the right + of @t{pie} in the @i{class precedence list}, + @t{fruit} goes next, and the +-result so far is @t{(pie apple fruit)}. S~= @{{cinnamon, +-spice, food, standard-object, t}@}; R~= @{{(cinnamon, ++result so far is @t{(pie apple fruit)}. S~= @{ cinnamon, ++spice, food, standard-object, t @}; R~= @{(cinnamon, + spice), (spice, food),\break (food, standard-object), +-(standard-object, t)}@}. ++(standard-object, t) @}. + +-The class @t{cinnamon} is next, giving the result so far as @t{(pie apple fruit cinnamon)}. At this point S~= @{{spice, +-food, standard-object, t}@}; R~= @{{(spice, food), (food, +-standard-object), (standard-object, t)}@}. ++The class @t{cinnamon} is next, giving the result so far as @t{(pie apple fruit cinnamon)}. At this point S~= @{ spice, ++food, standard-object, t @}; R~= @{ (spice, food), (food, ++standard-object), (standard-object, t) @}. + + The classes @t{spice}, @t{food}, @b{standard-object}, and + @b{t} are added in that order, and the @i{class precedence list} +@@ -1161,6 +1175,7 @@ + @i{Figure~4--8} lists the set of @i{classes} + that correspond to predefined @i{type specifiers}. + ++@format + @group + @noindent + @w{ arithmetic-error generic-function simple-error } +@@ -1193,6 +1208,7 @@ + @w{ Figure 4--8: Classes that correspond to pre-defined type specifiers } + + @end group ++@end format + + The @i{class precedence list} information specified in the entries for + each of these @i{classes} are those that are required by the object system. +@@ -1232,7 +1248,7 @@ + * method-combination:: + * t (System Class):: + * satisfies:: +-* member:: ++* member (Type Specifier):: + * not (Type Specifier):: + * and (Type Specifier):: + * or (Type Specifier):: +@@ -1330,10 +1346,10 @@ + + (@code{function}@{@i{@t{[}arg-typespec @r{[}value-typespec@r{]}@t{]}}@}) + +-@w{@i{arg-typespec} ::=@r{(}@{@i{typespec}@}{*} } +-@w{ @t{[}{&optional} @{@i{typespec}@}{*}@t{]} } +-@w{ @t{[}{&rest} @i{typespec}@t{]} } +-@w{ @t{[}{&key} @{{(}keyword typespec@r{)}@}{*}@t{]}@r{)}} ++@w{@i{arg-typespec} ::=@r{(}@{@i{typespec}@}* } ++@w{ @t{[}@r{&optional} @{@i{typespec}@}*@t{]} } ++@w{ @t{[}@r{&rest} @i{typespec}@t{]} } ++@w{ @t{[}@r{&key} @{@r{(}keyword typespec @r{)}@}*@t{]}@r{)}} + + @subsubheading Compound Type Specifier Arguments:: + +@@ -1728,7 +1744,7 @@ + The @i{type} @b{t} is a @i{supertype} of every @i{type}, + including itself. Every @i{object} is of @i{type} @b{t}. + +-@node satisfies, member, t (System Class), Types and Classes Dictionary ++@node satisfies, member (Type Specifier), t (System Class), Types and Classes Dictionary + @subsection satisfies [Type Specifier] + + @subsubheading Compound Type Specifier Kind:: +@@ -1762,7 +1778,7 @@ + + The symbol @b{satisfies} is not valid as a @i{type specifier}. + +-@node member, not (Type Specifier), satisfies, Types and Classes Dictionary ++@node member (Type Specifier), not (Type Specifier), satisfies, Types and Classes Dictionary + @subsection member [Type Specifier] + + @subsubheading Compound Type Specifier Kind:: +@@ -1771,7 +1787,7 @@ + + @subsubheading Compound Type Specifier Syntax:: + +-(@code{member}@{@i{@{@i{object}@}{*}}@}) ++(@code{member}@{@i{@{@i{object}@}*}@}) + + @subsubheading Compound Type Specifier Arguments:: + +@@ -1794,7 +1810,7 @@ + + the @i{type} @b{eql} + +-@node not (Type Specifier), and (Type Specifier), member, Types and Classes Dictionary ++@node not (Type Specifier), and (Type Specifier), member (Type Specifier), Types and Classes Dictionary + @subsection not [Type Specifier] + + @subsubheading Compound Type Specifier Kind:: +@@ -1826,7 +1842,7 @@ + + @subsubheading Compound Type Specifier Syntax:: + +-(@code{and}@{@i{@{@i{typespec}@}{*}}@}) ++(@code{and}@{@i{@{@i{typespec}@}*}@}) + + @subsubheading Compound Type Specifier Arguments:: + +@@ -1852,7 +1868,7 @@ + + @subsubheading Compound Type Specifier Syntax:: + +-(@code{or}@{@i{@{@i{typespec}@}{*}}@}) ++(@code{or}@{@i{@{@i{typespec}@}*}@}) + + @subsubheading Compound Type Specifier Arguments:: + +@@ -1885,7 +1901,7 @@ + + [Reviewer Note by Barmar: Missing @b{&key}] + +-@w{@i{value-typespec} ::=@{@i{typespec}@}{*} @t{[}{&optional} {@{@i{typespec}@}{*}}@t{]} @t{[}{&rest} typespec@t{]} @t{[}@b{&allow-other-keys}@t{]}} ++@w{@i{value-typespec} ::=@{@i{typespec}@}* @t{[}@r{&optional} @r{@{@i{typespec}@}*}@t{]} @t{[}@r{&rest} typespec @t{]} @t{[}@b{&allow-other-keys}@t{]}} + + @subsubheading Compound Type Specifier Arguments:: + +@@ -2075,9 +2091,9 @@ + + @subsubheading See Also:: + +-@ref{rational} ++@ref{rational (Function)} + , +-@ref{floor; ffloor; ceiling; fceiling; truncate; ftruncate; round; fround} ++@ref{floor} + , + @ref{char-code} + , +@@ -2096,7 +2112,7 @@ + @node deftype, subtypep, coerce, Types and Classes Dictionary + @subsection deftype [Macro] + +-@code{deftype} @i{name lambda-list {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}} @result{} @i{name} ++@code{deftype} @i{name lambda-list @r{[[@{@i{declaration}@}* | @i{documentation}]]} @{@i{form}@}*} @result{} @i{name} + + @subsubheading Arguments and Values:: + +@@ -2185,7 +2201,7 @@ + @b{declare}, + @ref{defmacro} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Type Specifiers}, + @ref{Syntactic Interaction of Documentation Strings and Declarations} +@@ -2193,7 +2209,7 @@ + @node subtypep, type-of, deftype, Types and Classes Dictionary + @subsection subtypep [Function] + +-@code{subtypep} @i{type-1 type-2 {&optional} environment} @result{} @i{subtype-p, valid-p} ++@code{subtypep} @i{type-1 type-2 @r{&optional} environment} @result{} @i{subtype-p, valid-p} + + @subsubheading Arguments and Values:: + +@@ -2228,6 +2244,7 @@ + Figure 4--9 summarizes the possible combinations of @i{values} + that might result. + ++@format + @group + @noindent + @w{ Value 1 Value 2 Meaning } +@@ -2240,6 +2257,7 @@ + @w{ Figure 4--9: Result possibilities for subtypep } + + @end group ++@end format + + @b{subtypep} is permitted to return the + @i{values} @i{false} and @i{false} only when at least +@@ -2541,7 +2559,7 @@ + , + @ref{defstruct} + , +-@ref{typecase; ctypecase; etypecase} ++@ref{typecase} + , + @ref{typep} + , +@@ -2556,7 +2574,7 @@ + @node typep, type-error, type-of, Types and Classes Dictionary + @subsection typep [Function] + +-@code{typep} @i{object type-specifier {&optional} environment} @result{} @i{generalized-boolean} ++@code{typep} @i{object type-specifier @r{&optional} environment} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -2625,26 +2643,26 @@ + (typep #c(0 0) '(complex (eql 0))) @result{} @i{false} + @end example + +-Let @t{A{{}_x}} and @t{A{{}_y}} be two @i{type specifiers} that ++Let @t{A_x} and @t{A_y} be two @i{type specifiers} that + denote different @i{types}, but for which + + @example +- (upgraded-array-element-type 'A{{}_x}) ++ (upgraded-array-element-type 'A_x) + @end example + + and + + @example +- (upgraded-array-element-type 'A{{}_y}) ++ (upgraded-array-element-type 'A_y) + @end example + + denote the same @i{type}. Notice that + + @example +- (typep (make-array 0 :element-type 'A{{}_x}) '(array A{{}_x})) @result{} @i{true} +- (typep (make-array 0 :element-type 'A{{}_y}) '(array A{{}_y})) @result{} @i{true} +- (typep (make-array 0 :element-type 'A{{}_x}) '(array A{{}_y})) @result{} @i{true} +- (typep (make-array 0 :element-type 'A{{}_y}) '(array A{{}_x})) @result{} @i{true} ++ (typep (make-array 0 :element-type 'A_x) '(array A_x)) @result{} @i{true} ++ (typep (make-array 0 :element-type 'A_y) '(array A_y)) @result{} @i{true} ++ (typep (make-array 0 :element-type 'A_x) '(array A_y)) @result{} @i{true} ++ (typep (make-array 0 :element-type 'A_y) '(array A_x)) @result{} @i{true} + @end example + + @subsubheading Exceptional Situations:: +@@ -2697,7 +2715,7 @@ + + @subsubheading See Also:: + +-@ref{type-error-datum; type-error-expected-type} ++@ref{type-error-datum} + , @b{type-error-expected-type} + + @node type-error-datum, simple-type-error, type-error, Types and Classes Dictionary +@@ -2773,11 +2791,11 @@ + + @b{simple-condition}, + +-@ref{simple-condition-format-control; simple-condition-format-arguments} ++@ref{simple-condition-format-control} + , + + @b{simple-condition-format-arguments}, +-@ref{type-error-datum; type-error-expected-type} ++@ref{type-error-datum} + , + @b{type-error-expected-type} + +diff -uNr gcl-texi-orig/chap-5.texi gcl-texi/chap-5.texi +--- gcl-texi-orig/chap-5.texi 1994-07-16 18:03:19 +0400 ++++ gcl-texi/chap-5.texi 2002-10-17 21:17:54 +0400 +@@ -50,6 +50,7 @@ + that the ultimate result of evaluating @b{setf} is the value + or values being stored. + ++@format + @group + @noindent + @w{ Access function Update Function Update using @b{setf} } +@@ -61,10 +62,12 @@ + @w{ Figure 5--1: Examples of setf } + + @end group ++@end format + + Figure 5--2 shows @i{operators} relating to + @i{places} and @i{generalized reference}. + ++@format + @group + @noindent + @w{ assert defsetf push } +@@ -78,6 +81,7 @@ + @w{ Figure 5--2: Operators relating to places and generalized reference.} + + @end group ++@end format + + Some of the @i{operators} above manipulate @i{places} + and some manipulate @i{setf expanders}. +@@ -281,6 +285,7 @@ + + For a variable @i{x}: + ++@format + @group + @noindent + @w{ @t{()} ;list of temporary variables } +@@ -293,9 +298,11 @@ + @w{ Figure 5--3: Sample Setf Expansion of a Variable} + + @end group ++@end format + + For @t{(car @i{exp})}: + ++@format + @group + @noindent + @w{ @t{(g0002)} ;list of temporary variables } +@@ -308,9 +315,11 @@ + @w{ Figure 5--4: Sample Setf Expansion of a CAR Form } + + @end group ++@end format + + For @t{(subseq @i{seq} @i{s} @i{e})}: + ++@format + @group + @noindent + @w{ @t{(g0004 g0005 g0006)} ;list of temporary variables } +@@ -324,12 +333,14 @@ + @w{ Figure 5--5: Sample Setf Expansion of a SUBSEQ Form } + + @end group ++@end format + + In some cases, if a @i{subform} of a @i{place} is itself + a @i{place}, it is necessary to expand the @i{subform} + in order to compute some of the values in the expansion of the outer + @i{place}. For @t{(ldb @i{bs} (car @i{exp}))}: + ++@format + @group + @noindent + @w{ @t{(g0001 g0002)} ;list of temporary variables } +@@ -343,6 +354,7 @@ + @w{ Figure 5--6: Sample Setf Expansion of a LDB Form } + + @end group ++@end format + + @node Kinds of Places, Treatment of Other Macros Based on SETF, Overview of Places and Generalized Reference, Generalized Reference + @subsection Kinds of Places +@@ -387,6 +399,7 @@ + search for these items and eliminate stray references to them as `accessors', + which they are not, but I will do that at some point.] + ++@format + @group + @noindent + @w{ aref cdadr get } +@@ -416,6 +429,7 @@ + @w{ Figure 5--7: Functions that setf can be used with---1 } + + @end group ++@end format + + In the case of @b{subseq}, the replacement value must be a @i{sequence} + whose elements might be contained by the sequence argument to @b{subseq}, +@@ -440,6 +454,7 @@ + in this case the new @i{place} has stored back into it the + result of applying the supplied ``update'' function. + ++@format + @group + @noindent + @w{ Function name Argument that is a @i{place} Update function used } +@@ -451,6 +466,7 @@ + @w{ Figure 5--8: Functions that setf can be used with---2 } + + @end group ++@end format + + During the @b{setf} expansion of these @i{forms}, it is necessary to call + +@@ -652,17 +668,17 @@ + + @item @t{*} + @t{(setf (apply #'aref @i{array} +- @{@i{subscript}@}{*} ++ @{@i{subscript}@}* + @i{more-subscripts}) + @i{new-element})} + @item @t{*} + @t{(setf (apply #'bit @i{array} +- @{@i{subscript}@}{*} ++ @{@i{subscript}@}* + @i{more-subscripts}) + @i{new-element})} + @item @t{*} + @t{(setf (apply #'sbit @i{array} +- @{@i{subscript}@}{*} ++ @{@i{subscript}@}* + @i{more-subscripts}) + @i{new-element})} + @end table +@@ -687,8 +703,8 @@ + to preserve proper left-to-right evaluation of argument @i{subforms}: + + @example +- (setf (apply #'@i{name} @{@i{arg}@}{*}) @i{val}) +- @equiv{} (apply #'(setf @i{name}) @i{val} @{@i{arg}@}{*}) ++ (setf (apply #'@i{name} @{@i{arg}@}*) @i{val}) ++ @equiv{} (apply #'(setf @i{name}) @i{val} @{@i{arg}@}*) + @end example + + @node Setf Expansions and Places, Macro Forms as Places, APPLY Forms as Places, Kinds of Places +@@ -772,7 +788,7 @@ + @i{form} with the following general syntax: + + @example +- (@i{operator} @{@i{preceding-form}@}{*} @i{place} @{@i{following-form}@}{*}) ++ (@i{operator} @{@i{preceding-form}@}* @i{place} @{@i{following-form}@}*) + @end example + + The evaluation of each such @i{form} proceeds like this: +@@ -795,6 +811,7 @@ + Store the new value into @i{place}. + @end table + ++@format + @group + @noindent + @w{ decf pop pushnew } +@@ -804,6 +821,7 @@ + @w{ Figure 5--9: Read-Modify-Write Macros} + + @end group ++@end format + + @c end of including concept-places + +@@ -944,7 +962,7 @@ + @node apply, defun, Data and Control Flow Dictionary, Data and Control Flow Dictionary + @subsection apply [Function] + +-@code{apply} @i{function {&rest} args^+} @result{} @i{@{@i{result}@}{*}} ++@code{apply} @i{function @r{&rest} args^+} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -1011,7 +1029,7 @@ + @node defun, fdefinition, apply, Data and Control Flow Dictionary + @subsection defun [Macro] + +-@code{defun} @i{function-name lambda-list {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}}@* ++@code{defun} @i{function-name lambda-list @r{[[@{@i{declaration}@}* | @i{documentation}]]} @{@i{form}@}*}@* + @result{} @i{function-name} + + @subsubheading Arguments and Values:: +@@ -1056,8 +1074,8 @@ + + @example + (lambda @i{lambda-list} +- {[[@{@i{declaration}@}{*} | @i{documentation}]]} +- (block @i{block-name} @{@i{form}@}{*})) ++ @r{[[@{@i{declaration}@}* | @i{documentation}]]} ++ (block @i{block-name} @{@i{form}@}*)) + @end example + + processed in the @i{lexical environment} in which @b{defun} was executed. +@@ -1106,7 +1124,7 @@ + + @subsubheading See Also:: + +-@ref{flet; labels; macrolet} ++@ref{flet} + , + @b{labels}, + @ref{block} +@@ -1114,7 +1132,7 @@ + @ref{return-from} + , + @b{declare}, +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Evaluation}, + @ref{Ordinary Lambda Lists}, +@@ -1313,29 +1331,29 @@ + @node flet, funcall, fmakunbound, Data and Control Flow Dictionary + @subsection flet, labels, macrolet [Special Operator] + +-@code{flet} @i{@r{(}@{{(}@i{function-name} ++@code{flet} @i{@r{(}@{@r{(}@i{function-name} + @i{lambda-list} +- {[[@{@i{local-declaration}@}{*} ++ @r{[[@{@i{local-declaration}@}* + | @i{local-documentation}]]} +- @{@i{local-form}@}{*}@r{)}@}{*}@r{)} +- @{@i{declaration}@}{*} @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{local-form}@}*@r{)}@}*@r{)} ++ @{@i{declaration}@}* @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + +-@code{labels} @i{@r{(}@{{(}@i{function-name} ++@code{labels} @i{@r{(}@{@r{(}@i{function-name} + @i{lambda-list} +- {[[@{@i{local-declaration}@}{*} ++ @r{[[@{@i{local-declaration}@}* + | @i{local-documentation}]]} +- @{@i{local-form}@}{*}@r{)}@}{*}@r{)} +- @{@i{declaration}@}{*} @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{local-form}@}*@r{)}@}*@r{)} ++ @{@i{declaration}@}* @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + +-@code{macrolet} @i{@r{(}@{{(}@i{name} ++@code{macrolet} @i{@r{(}@{@r{(}@i{name} + @i{lambda-list} +- {[[@{@i{local-declaration}@}{*} ++ @r{[[@{@i{local-declaration}@}* + | @i{local-documentation}]]} +- @{@i{local-form}@}{*}@r{)}@}{*}@r{)} +- @{@i{declaration}@}{*} @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{local-form}@}*@r{)}@}*@r{)} ++ @{@i{declaration}@}* @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -1556,9 +1574,9 @@ + , + @ref{defun} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , +-@ref{let; let*} ++@ref{let} + , + @ref{Evaluation}, + @ref{Syntactic Interaction of Documentation Strings and Declarations} +@@ -1575,7 +1593,7 @@ + @node funcall, function (Special Operator), flet, Data and Control Flow Dictionary + @subsection funcall [Function] + +-@code{funcall} @i{function {&rest} args} @result{} @i{@{@i{result}@}{*}} ++@code{funcall} @i{function @r{&rest} args} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -1693,7 +1711,7 @@ + , + @ref{fdefinition} + , +-@ref{flet; labels; macrolet} ++@ref{flet} + , + @b{labels}, + @ref{symbol-function} +@@ -1936,7 +1954,7 @@ + + @ref{defun} + , +-@ref{flet; labels; macrolet} ++@ref{flet} + , + @ref{defmacro} + , +@@ -2049,10 +2067,10 @@ + + @ref{declaim} + , +-@ref{defparameter; defvar} ++@ref{defparameter} + , + @b{defvar}, +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{proclaim} + , +@@ -2196,7 +2214,7 @@ + , + @ref{defconstant} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Compilation} + +@@ -2242,8 +2260,8 @@ + @node destructuring-bind, let, defparameter, Data and Control Flow Dictionary + @subsection destructuring-bind [Macro] + +-@code{destructuring-bind} @i{lambda-list expression @{@i{declaration}@}{*} @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{destructuring-bind} @i{lambda-list expression @{@i{declaration}@}* @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2287,9 +2305,9 @@ + @node let, progv, destructuring-bind, Data and Control Flow Dictionary + @subsection let, let* [Special Operator] + +-@code{let} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}{*}@r{)} @{@i{declaration}@}{*} @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{let} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}*@r{)} @{@i{declaration}@}* @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + +-@code{let*} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}{*}@r{)} @{@i{declaration}@}{*} @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{let*} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}*@r{)} @{@i{declaration}@}* @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2417,7 +2435,7 @@ + @node progv, setq, let, Data and Control Flow Dictionary + @subsection progv [Special Operator] + +-@code{progv} @i{@i{symbols} @i{values} @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{progv} @i{@i{symbols} @i{values} @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2462,7 +2480,7 @@ + + @subsubheading See Also:: + +-@ref{let; let*} ++@ref{let} + , @ref{Evaluation} + + @subsubheading Notes:: +@@ -2474,7 +2492,7 @@ + @node setq, psetq, progv, Data and Control Flow Dictionary + @subsection setq [Special Form] + +-@code{setq} @i{@{!@i{pair}@}{*}} @result{} @i{result} ++@code{setq} @i{@{!@i{pair}@}*} @result{} @i{result} + + @w{@i{pair} ::=var form} + +@@ -2541,18 +2559,19 @@ + , + @ref{set} + , +-@ref{setf; psetf} ++@ref{setf} + + @node psetq, block, setq, Data and Control Flow Dictionary + @subsection psetq [Macro] + +-@code{psetq} @i{@{!@i{pair}@}{*}} @result{} @i{@b{nil}} ++@code{psetq} @i{@{!@i{pair}@}*} @result{} @i{@b{nil}} + + @w{@i{pair} ::=var form} + + @subsubheading Pronunciation:: + +-@b{psetq}: pronounced {{{\vrule width 1pt height 2pt depth 2pt}\kern -1pt\raise 6pt{\vrule width 1pt height 2pt depth 2pt}}}p\=e'set ,ky\"u ++@b{psetq}: pronounced @tex p\=e'set ,ky\"u ++@end tex + + @subsubheading Arguments and Values:: + +@@ -2621,7 +2640,7 @@ + @node block, catch, psetq, Data and Control Flow Dictionary + @subsection block [Special Operator] + +-@code{block} @i{@i{name} @i{form}@r{*}} @result{} @i{@{@i{result}@}{*}} ++@code{block} @i{@i{name} @i{form}@r{*}} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2681,7 +2700,7 @@ + @node catch, go, block, Data and Control Flow Dictionary + @subsection catch [Special Operator] + +-@code{catch} @i{@i{tag} @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{catch} @i{@i{tag} @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2980,7 +2999,7 @@ + @node tagbody, throw, return, Data and Control Flow Dictionary + @subsection tagbody [Special Operator] + +-@code{tagbody} @i{@{@i{tag} | @i{statement}@}{*}} @result{} @i{@b{nil}} ++@code{tagbody} @i{@{@i{tag} | @i{statement}@}*} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -3060,6 +3079,7 @@ + + The @i{macros} in Figure 5--10 have @i{implicit tagbodies}. + ++@format + @group + @noindent + @w{ do do-external-symbols dotimes } +@@ -3070,6 +3090,7 @@ + @w{ Figure 5--10: Macros that have implicit tagbodies.} + + @end group ++@end format + + @node throw, unwind-protect, tagbody, Data and Control Flow Dictionary + @subsection throw [Special Operator] +@@ -3175,7 +3196,7 @@ + @node unwind-protect, nil, throw, Data and Control Flow Dictionary + @subsection unwind-protect [Special Operator] + +-@code{unwind-protect} @i{@i{protected-form} @{@i{cleanup-form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{unwind-protect} @i{@i{protected-form} @{@i{cleanup-form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -3519,7 +3540,7 @@ + , + @ref{equalp} + , +-@ref{=; /=; <; >; <=; >=} ++@ref{=} + , + @ref{Compilation} + +@@ -3544,6 +3565,7 @@ + rather than @b{eql} in a way that cannot be overridden by the + @i{code} which employs them: + ++@format + @group + @noindent + @w{ catch getf throw } +@@ -3554,6 +3576,7 @@ + @w{ Figure 5--11: Operators that always prefer EQ over EQL} + + @end group ++@end format + + @node eql, equal, eq, Data and Control Flow Dictionary + @subsection eql [Function] +@@ -3631,9 +3654,9 @@ + , + @ref{equalp} + , +-@ref{=; /=; <; >; <=; >=} ++@ref{=} + , +-@ref{char=; char/=; char<; char>; char<=; char>=; char-equal; char-not-equal; char-lessp; char-greaterp; char-not-greaterp; char-not-lessp} ++@ref{char=} + + @subsubheading Notes:: + +@@ -3731,6 +3754,7 @@ + with upper + entries taking priority over lower ones. + ++@format + @group + @noindent + @w{ Type Behavior } +@@ -3749,6 +3773,7 @@ + @w{ Figure 5--12: Summary and priorities of behavior of @b{equal}} + + @end group ++@end format + + Any two @i{objects} that are @b{eql} are also @b{equal}. + +@@ -3783,11 +3808,11 @@ + , + @ref{equalp} + , +-@ref{=; /=; <; >; <=; >=} ++@ref{=} + , +-@ref{string=; string/=; string<; string>; string<=; string>=; string-equal; string-not-equal; string-lessp; string-greaterp; string-not-greaterp; string-not-lessp} ++@ref{string=} + , @b{string-equal}, +-@ref{char=; char/=; char<; char>; char<=; char>=; char-equal; char-not-equal; char-lessp; char-greaterp; char-not-greaterp; char-not-lessp} ++@ref{char=} + , + @b{char-equal}, + @ref{tree-equal} +@@ -3869,6 +3894,7 @@ + with upper + entries taking priority over lower ones. + ++@format + @group + @noindent + @w{ Type Behavior } +@@ -3887,6 +3913,7 @@ + @w{ Figure 5--13: Summary and priorities of behavior of @b{equalp}} + + @end group ++@end format + + @subsubheading Examples:: + +@@ -3928,11 +3955,11 @@ + , + @ref{equal} + , +-@ref{=; /=; <; >; <=; >=} ++@ref{=} + , +-@ref{string=; string/=; string<; string>; string<=; string>=; string-equal; string-not-equal; string-lessp; string-greaterp; string-not-greaterp; string-not-lessp} ++@ref{string=} + , @b{string-equal}, +-@ref{char=; char/=; char<; char>; char<=; char>=; char-equal; char-not-equal; char-lessp; char-greaterp; char-not-greaterp; char-not-lessp} ++@ref{char=} + , + @b{char-equal} + +@@ -4089,13 +4116,13 @@ + @node every, and, constantly, Data and Control Flow Dictionary + @subsection every, some, notevery, notany [Function] + +-@code{every} @i{predicate {&rest} sequences^+} @result{} @i{generalized-boolean} ++@code{every} @i{predicate @r{&rest} sequences^+} @result{} @i{generalized-boolean} + +-@code{some} @i{predicate {&rest} sequences^+} @result{} @i{result} ++@code{some} @i{predicate @r{&rest} sequences^+} @result{} @i{result} + +-@code{notevery} @i{predicate {&rest} sequences^+} @result{} @i{generalized-boolean} ++@code{notevery} @i{predicate @r{&rest} sequences^+} @result{} @i{generalized-boolean} + +-@code{notany} @i{predicate {&rest} sequences^+} @result{} @i{generalized-boolean} ++@code{notany} @i{predicate @r{&rest} sequences^+} @result{} @i{generalized-boolean} + + @subsubheading Arguments and Values:: + +@@ -4178,14 +4205,14 @@ + @subsubheading Notes:: + + @example +- (notany @i{predicate} @{@i{sequence}@}{*}) @equiv{} (not (some @i{predicate} @{@i{sequence}@}{*})) +- (notevery @i{predicate} @{@i{sequence}@}{*}) @equiv{} (not (every @i{predicate} @{@i{sequence}@}{*})) ++ (notany @i{predicate} @{@i{sequence}@}*) @equiv{} (not (some @i{predicate} @{@i{sequence}@}*)) ++ (notevery @i{predicate} @{@i{sequence}@}*) @equiv{} (not (every @i{predicate} @{@i{sequence}@}*)) + @end example + + @node and, cond, every, Data and Control Flow Dictionary + @subsection and [Macro] + +-@code{and} @i{@{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{and} @i{@{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -4236,13 +4263,13 @@ + + @ref{cond} + , +-@ref{every; some; notevery; notany} ++@ref{every} + , + @ref{if} + , + @ref{or} + , +-@ref{when; unless} ++@ref{when} + + @subsubheading Notes:: + +@@ -4254,9 +4281,9 @@ + @node cond, if, and, Data and Control Flow Dictionary + @subsection cond [Macro] + +-@code{cond} @i{@{!@i{clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{cond} @i{@{!@i{clause}@}*} @result{} @i{@{@i{result}@}*} + +-@w{@i{clause} ::=@r{(}test-form @{@i{form}@}{*}@r{)}} ++@w{@i{clause} ::=@r{(}test-form @{@i{form}@}*@r{)}} + + @subsubheading Arguments and Values:: + +@@ -4312,13 +4339,13 @@ + + @ref{if} + , +-@ref{case; ccase; ecase} ++@ref{case} + . + + @node if, or, cond, Data and Control Flow Dictionary + @subsection if [Special Operator] + +-@code{if} @i{@i{test-form} @i{then-form} @r{[}@i{else-form}@r{]}} @result{} @i{@{@i{result}@}{*}} ++@code{if} @i{@i{test-form} @i{then-form} @r{[}@i{else-form}@r{]}} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -4365,7 +4392,7 @@ + @ref{cond} + , + @b{unless}, +-@ref{when; unless} ++@ref{when} + + @subsubheading Notes:: + +@@ -4377,7 +4404,7 @@ + @node or, when, if, Data and Control Flow Dictionary + @subsection or [Macro] + +-@code{or} @i{@{@i{form}@}{*}} @result{} @i{@{@i{results}@}{*}} ++@code{or} @i{@{@i{form}@}*} @result{} @i{@{@i{results}@}*} + + @subsubheading Arguments and Values:: + +@@ -4428,9 +4455,9 @@ + @node when, case, or, Data and Control Flow Dictionary + @subsection when, unless [Macro] + +-@code{when} @i{test-form @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{when} @i{test-form @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + +-@code{unless} @i{test-form @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{unless} @i{test-form @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -4520,15 +4547,15 @@ + @node case, typecase, when, Data and Control Flow Dictionary + @subsection case, ccase, ecase [Macro] + +-@code{case} @i{keyform @{!@i{normal-clause}@}{*} @r{[}!@i{otherwise-clause}@r{]}} @result{} @i{@{@i{result}@}{*}} ++@code{case} @i{keyform @{!@i{normal-clause}@}* @r{[}!@i{otherwise-clause}@r{]}} @result{} @i{@{@i{result}@}*} + +-@code{ccase} @i{keyplace @{!@i{normal-clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{ccase} @i{keyplace @{!@i{normal-clause}@}*} @result{} @i{@{@i{result}@}*} + +-@code{ecase} @i{keyform @{!@i{normal-clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{ecase} @i{keyform @{!@i{normal-clause}@}*} @result{} @i{@{@i{result}@}*} + +-@w{@i{normal-clause} ::=@r{(}keys @{@i{form}@}{*}@r{)}} ++@w{@i{normal-clause} ::=@r{(}keys @{@i{form}@}*@r{)}} + +-@w{@i{otherwise-clause} ::=@r{(}@{otherwise | t@} @{@i{form}@}{*}@r{)}} ++@w{@i{otherwise-clause} ::=@r{(}@{otherwise | t@} @{@i{form}@}*@r{)}} + + @w{@i{clause} ::=normal-clause | otherwise-clause} + +@@ -4668,9 +4695,9 @@ + + @ref{cond} + , +-@ref{typecase; ctypecase; etypecase} ++@ref{typecase} + , +-@ref{setf; psetf} ++@ref{setf} + , + @ref{Generalized Reference} + +@@ -4678,10 +4705,10 @@ + + @example + (case @i{test-key} +- @{((@{@i{key}@}{*}) @{@i{form}@}{*})@}{*}) ++ @{((@{@i{key}@}*) @{@i{form}@}*)@}*) + @equiv{} + (let ((#1=#:g0001 @i{test-key})) +- (cond @{((member #1# '(@{@i{key}@}{*})) @{@i{form}@}{*})@}{*})) ++ (cond @{((member #1# '(@{@i{key}@}*)) @{@i{form}@}*)@}*)) + @end example + + The specific error message used by @b{ecase} and @b{ccase} can vary +@@ -4693,15 +4720,15 @@ + @node typecase, multiple-value-bind, case, Data and Control Flow Dictionary + @subsection typecase, ctypecase, etypecase [Macro] + +-@code{typecase} @i{keyform @{!@i{normal-clause}@}{*} @r{[}!@i{otherwise-clause}@r{]}} @result{} @i{@{@i{result}@}{*}} ++@code{typecase} @i{keyform @{!@i{normal-clause}@}* @r{[}!@i{otherwise-clause}@r{]}} @result{} @i{@{@i{result}@}*} + +-@code{ctypecase} @i{keyplace @{!@i{normal-clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{ctypecase} @i{keyplace @{!@i{normal-clause}@}*} @result{} @i{@{@i{result}@}*} + +-@code{etypecase} @i{keyform @{!@i{normal-clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{etypecase} @i{keyform @{!@i{normal-clause}@}*} @result{} @i{@{@i{result}@}*} + +-@w{@i{normal-clause} ::=@r{(}type @{@i{form}@}{*}@r{)}} ++@w{@i{normal-clause} ::=@r{(}type @{@i{form}@}*@r{)}} + +-@w{@i{otherwise-clause} ::=@r{(}@{otherwise | t@} @{@i{form}@}{*}@r{)}} ++@w{@i{otherwise-clause} ::=@r{(}@{otherwise | t@} @{@i{form}@}*@r{)}} + + @w{@i{clause} ::=normal-clause | otherwise-clause} + +@@ -4846,11 +4873,11 @@ + + @subsubheading See Also:: + +-@ref{case; ccase; ecase} ++@ref{case} + , + @ref{cond} + , +-@ref{setf; psetf} ++@ref{setf} + , + @ref{Generalized Reference} + +@@ -4858,10 +4885,10 @@ + + @example + (typecase @i{test-key} +- @{(@i{type} @{@i{form}@}{*})@}{*}) ++ @{(@i{type} @{@i{form}@}*)@}*) + @equiv{} + (let ((#1=#:g0001 @i{test-key})) +- (cond @{((typep #1# '@i{type}) @{@i{form}@}{*})@}{*})) ++ (cond @{((typep #1# '@i{type}) @{@i{form}@}*)@}*)) + @end example + + The specific error message used by @b{etypecase} and @b{ctypecase} can vary +@@ -4873,11 +4900,11 @@ + @node multiple-value-bind, multiple-value-call, typecase, Data and Control Flow Dictionary + @subsection multiple-value-bind [Macro] + +-@code{multiple-value-bind} @i{@r{(}@{@i{var}@}{*}@r{)} ++@code{multiple-value-bind} @i{@r{(}@{@i{var}@}*@r{)} + @i{values-form} +- @{@i{declaration}@}{*} +- @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* ++ @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -4924,24 +4951,24 @@ + + @subsubheading See Also:: + +-@ref{let; let*} ++@ref{let} + , + @ref{multiple-value-call} + + @subsubheading Notes:: + + @example +- (multiple-value-bind (@{@i{var}@}{*}) @i{values-form} @{@i{form}@}{*}) +- @equiv{} (multiple-value-call #'(lambda (&optional @{@i{var}@}{*} &rest #1=#:ignore) ++ (multiple-value-bind (@{@i{var}@}*) @i{values-form} @{@i{form}@}*) ++ @equiv{} (multiple-value-call #'(lambda (&optional @{@i{var}@}* &rest #1=#:ignore) + (declare (ignore #1#)) +- @{@i{form}@}{*}) ++ @{@i{form}@}*) + @i{values-form}) + @end example + + @node multiple-value-call, multiple-value-list, multiple-value-bind, Data and Control Flow Dictionary + @subsection multiple-value-call [Special Operator] + +-@code{multiple-value-call} @i{@i{function-form} @i{form}@r{*}} @result{} @i{@{@i{result}@}{*}} ++@code{multiple-value-call} @i{@i{function-form} @i{form}@r{*}} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -5021,9 +5048,9 @@ + @node multiple-value-prog1, multiple-value-setq, multiple-value-list, Data and Control Flow Dictionary + @subsection multiple-value-prog1 [Special Operator] + +-@code{multiple-value-prog} @i{1} @result{} @i{first-form @{@i{form}@}{*}} ++@code{multiple-value-prog} @i{1} @result{} @i{first-form @{@i{form}@}*} + +- {first-form-results} ++ @r{first-form-results} + + @subsubheading Arguments and Values:: + +@@ -5052,7 +5079,7 @@ + + @subsubheading See Also:: + +-@ref{prog1; prog2} ++@ref{prog1} + + @node multiple-value-setq, values, multiple-value-prog1, Data and Control Flow Dictionary + @subsection multiple-value-setq [Macro] +@@ -5126,9 +5153,9 @@ + @node values, values-list, multiple-value-setq, Data and Control Flow Dictionary + @subsection values [Accessor] + +-@code{values} @i{{&rest} object} @result{} @i{@{@i{object}@}{*}} ++@code{values} @i{@r{&rest} object} @result{} @i{@{@i{object}@}*} + +-(setf (@code{ values} @i{{&rest} place}) new-values)@* ++(setf (@code{ values} @i{@r{&rest} place}) new-values)@* + + @subsubheading Arguments and Values:: + +@@ -5206,7 +5233,7 @@ + @node values-list, multiple-values-limit, values, Data and Control Flow Dictionary + @subsection values-list [Function] + +-@code{values-list} @i{list} @result{} @i{@{@i{element}@}{*}} ++@code{values-list} @i{list} @result{} @i{@{@i{element}@}*} + + @subsubheading Arguments and Values:: + +@@ -5331,16 +5358,16 @@ + @subsection prog, prog* [Macro] + + @code{prog} @i{@r{(}@{@i{var} | +- @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}{*}@r{)} +- @{@i{declaration}@}{*} +- @{@i{tag} | @i{statement}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}*@r{)} ++ @{@i{declaration}@}* ++ @{@i{tag} | @i{statement}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @code{prog*} @i{@r{(}@{@i{var} | +- @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}{*}@r{)} +- @{@i{declaration}@}{*} +- @{@i{tag} | @i{statement}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @r{(}@i{var} @r{[}@i{init-form}@r{]}@r{)}@}*@r{)} ++ @{@i{declaration}@}* ++ @{@i{tag} | @i{statement}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -5369,7 +5396,7 @@ + + @example + (prog (var1 var2 (var3 init-form-3) var4 (var5 init-form-5)) +- @{@i{declaration}@}{*} ++ @{@i{declaration}@}* + statement1 + tag1 + statement2 +@@ -5457,7 +5484,7 @@ + + @ref{block} + , +-@ref{let; let*} ++@ref{let} + , + @ref{tagbody} + , +@@ -5479,10 +5506,10 @@ + @node prog1, progn, prog, Data and Control Flow Dictionary + @subsection prog1, prog2 [Macro] + +-@code{prog} @i{1} @result{} @i{first-form @{@i{form}@}{*}} +- {result-1} +-@code{prog} @i{2} @result{} @i{first-form second-form @{@i{form}@}{*}} +- {result-2} ++@code{prog} @i{1} @result{} @i{first-form @{@i{form}@}*} ++ @r{result-1} ++@code{prog} @i{2} @result{} @i{first-form second-form @{@i{form}@}*} ++ @r{result-2} + + @subsubheading Arguments and Values:: + +@@ -5553,14 +5580,14 @@ + must be computed before some or all of the side effects happen. + + @example +- (prog1 @{@i{form}@}{*}) @equiv{} (values (multiple-value-prog1 @{@i{form}@}{*})) +- (prog2 @i{form1} @{@i{form}@}{*}) @equiv{} (let () @i{form1} (prog1 @{@i{form}@}{*})) ++ (prog1 @{@i{form}@}*) @equiv{} (values (multiple-value-prog1 @{@i{form}@}*)) ++ (prog2 @i{form1} @{@i{form}@}*) @equiv{} (let () @i{form1} (prog1 @{@i{form}@}*)) + @end example + + @node progn, define-modify-macro, prog1, Data and Control Flow Dictionary + @subsection progn [Special Operator] + +-@code{progn} @i{@{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{progn} @i{@{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -5593,7 +5620,7 @@ + + @subsubheading See Also:: + +-@ref{prog1; prog2} ++@ref{prog1} + , @b{prog2}, @ref{Evaluation} + + @subsubheading Notes:: +@@ -5690,7 +5717,7 @@ + @ref{define-setf-expander} + , + +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Syntactic Interaction of Documentation Strings and Declarations} + +@@ -5704,8 +5731,8 @@ + + The ``long form'': + +-@code{defsetf} @i{access-fn lambda-list @r{(}@{@i{store-variable}@}{*}@r{)} +- {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}}@* ++@code{defsetf} @i{access-fn lambda-list @r{(}@{@i{store-variable}@}*@r{)} ++ @r{[[@{@i{declaration}@}* | @i{documentation}]]} @{@i{form}@}*}@* + @result{} @i{access-fn} + + @subsubheading Arguments and Values:: +@@ -5870,9 +5897,9 @@ + + @subsubheading See Also:: + +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , +-@ref{setf; psetf} ++@ref{setf} + , + + @ref{define-setf-expander} +@@ -5913,7 +5940,7 @@ + @subsection define-setf-expander [Macro] + + @code{define-setf-expander} @i{access-fn lambda-list +- {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}}@* ++ @r{[[@{@i{declaration}@}* | @i{documentation}]]} @{@i{form}@}*}@* + @result{} @i{access-fn} + + @subsubheading Arguments and Values:: +@@ -6025,11 +6052,11 @@ + + @subsubheading See Also:: + +-@ref{setf; psetf} ++@ref{setf} + , + @ref{defsetf} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{get-setf-expansion} + , +@@ -6049,7 +6076,7 @@ + @node get-setf-expansion, setf, define-setf-expander, Data and Control Flow Dictionary + @subsection get-setf-expansion [Function] + +-@code{get-setf-expansion} @i{place {&optional} environment}@* ++@code{get-setf-expansion} @i{place @r{&optional} environment}@* + @result{} @i{vars, vals, store-vars, writer-form, reader-form} + + @subsubheading Arguments and Values:: +@@ -6102,7 +6129,7 @@ + , + @ref{define-setf-expander} + , +-@ref{setf; psetf} ++@ref{setf} + + @subsubheading Notes:: + +@@ -6113,9 +6140,9 @@ + @node setf, shiftf, get-setf-expansion, Data and Control Flow Dictionary + @subsection setf, psetf [Macro] + +-@code{setf} @i{@{!@i{pair}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{setf} @i{@{!@i{pair}@}*} @result{} @i{@{@i{result}@}*} + +-@code{psetf} @i{@{!@i{pair}@}{*}} @result{} @i{@b{nil}} ++@code{psetf} @i{@{!@i{pair}@}*} @result{} @i{@b{nil}} + + @w{@i{pair} ::=place newvalue} + +@@ -6276,7 +6303,7 @@ + + @subsubheading See Also:: + +-@ref{setf; psetf} ++@ref{setf} + , + @ref{rotatef} + , @ref{Generalized Reference} +@@ -6315,7 +6342,7 @@ + @node rotatef, control-error, shiftf, Data and Control Flow Dictionary + @subsection rotatef [Macro] + +-@code{rotatef} @i{@{@i{place}@}{*}} @result{} @i{@b{nil}} ++@code{rotatef} @i{@{@i{place}@}*} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -6358,7 +6385,7 @@ + , + @ref{defsetf} + , +-@ref{setf; psetf} ++@ref{setf} + , + @ref{shiftf} + , +diff -uNr gcl-texi-orig/chap-6.texi gcl-texi/chap-6.texi +--- gcl-texi-orig/chap-6.texi 1994-07-16 18:03:17 +0400 ++++ gcl-texi/chap-6.texi 2002-10-17 20:53:05 +0400 +@@ -889,7 +889,7 @@ + subsequent iterations. If @i{form2} is omitted, the construct + uses @i{form1} on the second and + subsequent iterations. +-The @i{loop keywords} {=} and @t{then} serve as valid prepositions ++The @i{loop keywords} @r{=} and @t{then} serve as valid prepositions + in this syntax. + This construct does not provide any termination tests. + +@@ -981,12 +981,12 @@ + In effect + + @t{being} +-@{{each} | @t{the}@} +-@{{hash-value} | ++@{@t{each} | @t{the}@} ++@{@t{hash-value} | + @t{hash-values} | + @t{hash-key} | + @t{hash-keys}@} +-@{{in} | @t{of}@} ++@{@t{in} | @t{of}@} + + is a compound preposition. + +@@ -1059,14 +1059,14 @@ + In effect + + @t{being} +-@{{each} | @t{the}@} +-@{{symbol} | ++@{@t{each} | @t{the}@} ++@{@t{symbol} | + @t{symbols} | + @t{present-symbol} | + @t{present-symbols} | + @t{external-symbol} | + @t{external-symbols}@} +-@{{in} | @t{of}@} ++@{@t{in} | @t{of}@} + + is a compound preposition. + +@@ -2099,15 +2099,15 @@ + @node do, dotimes, Iteration Dictionary, Iteration Dictionary + @subsection do, do* [Macro] + +-@code{do} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}init-form @r{[}step-form@r{]}@r{]}@r{)}@}{*}@r{)} +- @r{(}end-test-form @{@i{result-form}@}{*}@r{)} +- @{@i{declaration}@}{*} @{tag | statement@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} +- +-@code{do*} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}init-form @r{[}step-form@r{]}@r{]}@r{)}@}{*}@r{)} +- @r{(}end-test-form {@{@i{result-form}@}{*}}@r{)} +- @{@i{declaration}@}{*} @{tag | statement@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{do} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}init-form @r{[}step-form@r{]}@r{]}@r{)}@}*@r{)} ++ @r{(}end-test-form @{@i{result-form}@}*@r{)} ++ @{@i{declaration}@}* @{tag | statement@}*}@* ++ @result{} @i{@{@i{result}@}*} ++ ++@code{do*} @i{@r{(}@{@i{var} | @r{(}@i{var} @r{[}init-form @r{[}step-form@r{]}@r{]}@r{)}@}*@r{)} ++ @r{(}end-test-form @r{@{@i{result-form}@}*}@r{)} ++ @{@i{declaration}@}* @{tag | statement@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2337,7 +2337,7 @@ + @ref{return} + , + +-@ref{let; let*} ++@ref{let} + , and + @ref{setq} + ) +@@ -2377,9 +2377,9 @@ + @subsection dotimes [Macro] + + @code{dotimes} @i{@r{(}var count-form @r{[}result-form@r{]}@r{)} +- @{@i{declaration}@}{*} +- @{tag | statement@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* ++ @{tag | statement@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2481,7 +2481,7 @@ + + @subsubheading See Also:: + +-@ref{do; do*} ++@ref{do} + , + @ref{dolist} + , +@@ -2496,9 +2496,9 @@ + @subsection dolist [Macro] + + @code{dolist} @i{@r{(}var list-form @r{[}result-form@r{]}@r{)} +- @{@i{declaration}@}{*} +- @{tag | statement@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* ++ @{tag | statement@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2569,7 +2569,7 @@ + + @subsubheading See Also:: + +-@ref{do; do*} ++@ref{do} + , + @ref{dotimes} + , +@@ -2588,44 +2588,44 @@ + + The ``simple'' @b{loop} @i{form}: + +-@code{loop} @i{@{@i{compound-form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{loop} @i{@{@i{compound-form}@}*} @result{} @i{@{@i{result}@}*} + + The ``extended'' @b{loop} @i{form}: + + @code{loop} @i{@r{[}!@i{name-clause}@r{]} +- @{!@i{variable-clause}@}{*} +- @{!@i{main-clause}@}{*}} @result{} @i{@{@i{result}@}{*}} ++ @{!@i{variable-clause}@}* ++ @{!@i{main-clause}@}*} @result{} @i{@{@i{result}@}*} + + @w{@i{name-clause} ::=@t{named} @i{name}} + + @w{@i{variable-clause} ::=!@i{with-clause} | !@i{initial-final} | !@i{for-as-clause}} + +-@w{@i{with-clause} ::=@t{with} @i{var1} @r{[}@i{type-spec}@r{]} @r{[}= @i{form1}@r{]} @{{and} @i{var2} @r{[}@i{type-spec}@r{]} @r{[}= @i{form2}@r{]}@}{*}} ++@w{@i{with-clause} ::=@t{with} @i{var1} @r{[}@i{type-spec}@r{]} @r{[}= @i{form1}@r{]} @{@t{and} @i{var2} @r{[}@i{type-spec}@r{]} @r{[}= @i{form2}@r{]}@}*} + + @w{@i{main-clause} ::=!@i{unconditional} | !@i{accumulation} | !@i{conditional} | !@i{termination-test} | !@i{initial-final}} + + @w{@i{initial-final} ::=@t{initially} @{@i{compound-form}@}^+ | @t{finally} @{@i{compound-form}@}^+} + +-@w{@i{unconditional} ::=@{{do} | @t{doing}@} @{@i{compound-form}@}^+ | @t{return} @{@i{form} | @t{it}@}} ++@w{@i{unconditional} ::=@{@t{do} | @t{doing}@} @{@i{compound-form}@}^+ | @t{return} @{@i{form} | @t{it}@}} + + @w{@i{accumulation} ::=!@i{list-accumulation} | !@i{numeric-accumulation}} + +-@w{@i{list-accumulation} ::=@{{collect} | @t{collecting} | @t{append} | @t{appending} | @t{nconc} | @t{nconcing}@} @{@i{form} | @t{it}@} } ++@w{@i{list-accumulation} ::=@{@t{collect} | @t{collecting} | @t{append} | @t{appending} | @t{nconc} | @t{nconcing}@} @{@i{form} | @t{it}@} } + @w{ @r{[}@t{into} @i{simple-var}@r{]}} + +-@w{@i{numeric-accumulation} ::=@{{count} | @t{counting} | @t{sum} | @t{summing} | @} ++@w{@i{numeric-accumulation} ::=@{@t{count} | @t{counting} | @t{sum} | @t{summing} | @} + @w{ @t{maximize} | @t{maximizing} | @t{minimize} | @t{minimizing}} @{@i{form} | @t{it}@} } + @w{ @r{[}@t{into} @i{simple-var}@r{]} @r{[}@i{type-spec}@r{]}} + +-@w{@i{conditional} ::=@{{if} | @t{when} | @t{unless}@} @i{form} !@i{selectable-clause} @{{and} !@i{selectable-clause}@}{*} } +-@w{ @r{[}@t{else} !@i{selectable-clause} @{{and} !@i{selectable-clause}@}{*}@r{]} } ++@w{@i{conditional} ::=@{@t{if} | @t{when} | @t{unless}@} @i{form} !@i{selectable-clause} @{@t{and} !@i{selectable-clause}@}* } ++@w{ @r{[}@t{else} !@i{selectable-clause} @{@t{and} !@i{selectable-clause}@}*@r{]} } + @w{ @r{[}@t{end}@r{]}} + + @w{@i{selectable-clause} ::=!@i{unconditional} | !@i{accumulation} | !@i{conditional}} + + @w{@i{termination-test} ::=@t{while} @i{form} | @t{until} @i{form} | @t{repeat} @i{form} | @t{always} @i{form} | @t{never} @i{form} | @t{thereis} @i{form}} + +-@w{@i{for-as-clause} ::=@{{for} | @t{as}@} !@i{for-as-subclause} @{{and} !@i{for-as-subclause}@}{*}} ++@w{@i{for-as-clause} ::=@{@t{for} | @t{as}@} !@i{for-as-subclause} @{@t{and} !@i{for-as-subclause}@}*} + + @w{@i{for-as-subclause} ::=!@i{for-as-arithmetic} | !@i{for-as-in-list} | !@i{for-as-on-list} | !@i{for-as-equals-then} |} + @w{ !@i{for-as-across} | !@i{for-as-hash} | !@i{for-as-package}} +@@ -2634,11 +2634,11 @@ + + @w{@i{for-as-arithmetic-subclause} ::=!@i{arithmetic-up} | !@i{arithmetic-downto} | !@i{arithmetic-downfrom}} + +-@w{@i{arithmetic-up} ::=[[@{{from} | @t{upfrom}@} @i{form1} | @{{to} | @t{upto} | @t{below}@} @i{form2} | @t{by} @i{form3}]]^+} ++@w{@i{arithmetic-up} ::=[[@{@t{from} | @t{upfrom}@} @i{form1} | @{@t{to} | @t{upto} | @t{below}@} @i{form2} | @t{by} @i{form3}]]^+} + +-@w{@i{arithmetic-downto} ::=[[@{{from} @i{form1}@}^1 | @{@{{downto} | @t{above}@} @i{form2}@}^1 | @t{by} @i{form3}]]} ++@w{@i{arithmetic-downto} ::=[[@{@t{from} @i{form1}@}^1 | @{@{@t{downto} | @t{above}@} @i{form2}@}^1 | @t{by} @i{form3}]]} + +-@w{@i{arithmetic-downfrom} ::=[[@{{downfrom} @i{form1}@}^1 | @{{to} | @t{downto} | @t{above}@} @i{form2} | @t{by} @i{form3}]]} ++@w{@i{arithmetic-downfrom} ::=[[@{@t{downfrom} @i{form1}@}^1 | @{@t{to} | @t{downto} | @t{above}@} @i{form2} | @t{by} @i{form3}]]} + + @w{@i{for-as-in-list} ::=@i{var} @r{[}@i{type-spec}@r{]} @t{in} @i{form1} @r{[}@t{by} @i{step-fun}@r{]}} + +@@ -2648,17 +2648,17 @@ + + @w{@i{for-as-across} ::=@i{var} @r{[}@i{type-spec}@r{]} @t{across} @i{vector}} + +-@w{@i{for-as-hash} ::=@i{var} @r{[}@i{type-spec}@r{]} @t{being} @{{each} | @t{the}@} } +-@w{ @{@{{hash-key} | @t{hash-keys}@} @{{in} | @t{of}@} @i{hash-table} } ++@w{@i{for-as-hash} ::=@i{var} @r{[}@i{type-spec}@r{]} @t{being} @{@t{each} | @t{the}@} } ++@w{ @{@{@t{hash-key} | @t{hash-keys}@} @{@t{in} | @t{of}@} @i{hash-table} } + @w{ @r{[}@t{using} @r{(}@t{hash-value} @i{other-var}@r{)}@r{]} | } +-@w{ @{{hash-value} | @t{hash-values}@} @{{in} | @t{of}@} @i{hash-table} } ++@w{ @{@t{hash-value} | @t{hash-values}@} @{@t{in} | @t{of}@} @i{hash-table} } + @w{ @r{[}@t{using} @r{(}@t{hash-key} @i{other-var}@r{)}@r{]}@}} + +-@w{@i{for-as-package} ::=@i{var} @r{[}@i{type-spec}@r{]} @t{being} @{{each} | @t{the}@} } +-@w{ @{{symbol} | @t{symbols} |} ++@w{@i{for-as-package} ::=@i{var} @r{[}@i{type-spec}@r{]} @t{being} @{@t{each} | @t{the}@} } ++@w{ @{@t{symbol} | @t{symbols} |} + @w{ @t{present-symbol} | @t{present-symbols} |} + @w{ @t{external-symbol} | @t{external-symbols}@} } +-@w{ @r{[}@{{in} | @t{of}@} @i{package}@r{]}} ++@w{ @r{[}@{@t{in} | @t{of}@} @i{package}@r{]}} + + @w{@i{type-spec} ::=!@i{simple-type-spec} | !@i{destructured-type-spec}} + +@@ -2718,11 +2718,11 @@ + (format t "~&The square root of ~D is ~D.~ + @result{} SQRT-ADVISOR + (sqrt-advisor) +-@t{ |> } Number: @b{|>>}@t{5{@i{[<--}~]}}@b{<<|} ++@t{ |> } Number: @b{|>>}@t{5 @t{@i{[<--}~]}}@b{<<|} + @t{ |> } The square root of 5 is 2.236068. +-@t{ |> } Number: @b{|>>}@t{4{@i{[<--}~]}}@b{<<|} ++@t{ |> } Number: @b{|>>}@t{4 @t{@i{[<--}~]}}@b{<<|} + @t{ |> } The square root of 4 is 2. +-@t{ |> } Number: @b{|>>}@t{done{@i{[<--}~]}}@b{<<|} ++@t{ |> } Number: @b{|>>}@t{done @t{@i{[<--}~]}}@b{<<|} + @result{} NIL + + ;; An example of the extended form of LOOP. +@@ -2733,11 +2733,11 @@ + do (format t "~&The square of ~D is ~D.~ + @result{} SQUARE-ADVISOR + (square-advisor) +-@t{ |> } Number: @b{|>>}@t{4{@i{[<--}~]}}@b{<<|} ++@t{ |> } Number: @b{|>>}@t{4 @t{@i{[<--}~]}}@b{<<|} + @t{ |> } The square of 4 is 16. +-@t{ |> } Number: @b{|>>}@t{23{@i{[<--}~]}}@b{<<|} ++@t{ |> } Number: @b{|>>}@t{23 @t{@i{[<--}~]}}@b{<<|} + @t{ |> } The square of 23 is 529. +-@t{ |> } Number: @b{|>>}@t{done{@i{[<--}~]}}@b{<<|} ++@t{ |> } Number: @b{|>>}@t{done @t{@i{[<--}~]}}@b{<<|} + @result{} NIL + + ;; Another example of the extended form of LOOP. +@@ -2749,7 +2749,7 @@ + + @subsubheading See Also:: + +-@ref{do; do*} ++@ref{do} + , + @ref{dolist} + , +@@ -2770,7 +2770,7 @@ + in the following way: + + @example +- (loop @{@i{compound-form}@}{*}) @equiv{} (loop do @{@i{compound-form}@}{*}) ++ (loop @{@i{compound-form}@}*) @equiv{} (loop do @{@i{compound-form}@}*) + @end example + + @node loop-finish, , loop, Iteration Dictionary +diff -uNr gcl-texi-orig/chap-7.texi gcl-texi/chap-7.texi +--- gcl-texi-orig/chap-7.texi 1994-07-16 18:03:16 +0400 ++++ gcl-texi/chap-7.texi 2002-10-17 20:53:05 +0400 +@@ -187,7 +187,7 @@ + @i{lambda list} becomes an initialization argument for all @i{classes} + for which the @i{method} is applicable. + +-The presence of {&allow-other-keys} in the ++The presence of @t{&allow-other-keys} in the + @i{lambda list} of an applicable method disables validity checking of + initialization arguments. + +@@ -388,9 +388,10 @@ + + @center + @example ++@format + @group + @noindent +-@w{ {} Defaulted {} } ++@w{ @t{} Defaulted @t{} } + @w{ Form Initialization Argument List Contents of Slot X } + @w{ _____________________________________________________________________________} + @w{ @t{(make-instance 'r)} @t{(a 1 b 2)} @t{1} } +@@ -398,6 +399,7 @@ + @w{ @t{(make-instance 'r 'b 4)} @t{(b 4 a 1)} @t{4} } + @w{ @t{(make-instance 'r 'a 1 'a 2)} @t{(a 1 a 2 b 2)} @t{1} } + @end group ++@end format + + @end example + +@@ -607,10 +609,10 @@ + @c including concept-change-class + + The @i{function} @b{change-class} can be used to change the @i{class} +-of an @i{instance} from its current class, C_@{{from}@}, +-to a different class, C_@{{to}@}; it changes the ++of an @i{instance} from its current class, C_@{@r{from}@}, ++to a different class, C_@{@r{to}@}; it changes the + structure of the @i{instance} to conform to the definition of the class +-C_@{{to}@}. ++C_@{@r{to}@}. + + Note that changing the @i{class} of an @i{instance} may cause + @i{slots} to be added or deleted. Changing the @i{class} of an +@@ -634,14 +636,14 @@ + @node Modifying the Structure of the Instance, Initializing Newly Added Local Slots (Changing the Class of an Instance), Changing the Class of an Instance, Changing the Class of an Instance + @subsection Modifying the Structure of the Instance + +-In order to make the @i{instance} conform to the class C_@{{to}@}, @i{local slots} specified by the class C_@{{to}@} that are not specified by the class C_@{{from}@} are added, and @i{local slots} not specified by +-the class C_@{{to}@} that are specified by the +-class C_@{{from}@} are discarded. ++In order to make the @i{instance} conform to the class C_@{@r{to}@}, @i{local slots} specified by the class C_@{@r{to}@} that are not specified by the class C_@{@r{from}@} are added, and @i{local slots} not specified by ++the class C_@{@r{to}@} that are specified by the ++class C_@{@r{from}@} are discarded. + +-The values of @i{local slots} specified by both the class C_@{{to}@} and the class C_@{{from}@} are retained. If such a @i{local slot} was unbound, it remains ++The values of @i{local slots} specified by both the class C_@{@r{to}@} and the class C_@{@r{from}@} are retained. If such a @i{local slot} was unbound, it remains + unbound. + +-The values of @i{slots} specified as shared in the class C_@{{from}@} and as local in the class C_@{{to}@} are retained. ++The values of @i{slots} specified as shared in the class C_@{@r{from}@} and as local in the class C_@{@r{to}@} are retained. + + This first step of the update does not affect the values of any + @i{shared slots}. +@@ -659,10 +661,10 @@ + The generic function @b{update-instance-for-different-class} is + invoked on arguments computed by @b{change-class}. + The first argument passed is a copy of the @i{instance} being updated +-and is an @i{instance} of the class C_@{{from}@}; ++and is an @i{instance} of the class C_@{@r{from}@}; + this copy has @i{dynamic extent} within the generic function @b{change-class}. + The second argument is the @i{instance} as updated so far by @b{change-class} +-and is an @i{instance} of the class C_@{{to}@}. ++and is an @i{instance} of the class C_@{@r{to}@}. + The remaining arguments are an @i{initialization argument list}. + + There is a system-supplied primary @i{method} for +@@ -1156,6 +1158,7 @@ + their associated @i{forms} are called @i{method-defining forms}. + The @i{standardized} @i{method-defining operators} are listed in Figure 7--2. + ++@format + @group + @noindent + @w{ defgeneric defmethod defclass } +@@ -1165,6 +1168,7 @@ + @w{ Figure 7--2: Standardized Method-Defining Operators} + + @end group ++@end format + + Note that of the @i{standardized} @i{method-defining operators} + only @b{defgeneric} +@@ -1507,14 +1511,14 @@ + @table @asis + + @item 1. +-{Select the applicable methods.} ++@r{Select the applicable methods.} + + @item 2. +-{Sort the applicable methods by precedence order, putting ++@r{Sort the applicable methods by precedence order, putting + the most specific method first.} + + @item 3. +-{Apply method combination to the sorted list of ++@r{Apply method combination to the sorted list of + applicable methods, producing the effective method.} + + @end table +@@ -1773,6 +1777,7 @@ + + @IRindex{standard} + ++@format + @group + @noindent + @w{ + append max nconc progn } +@@ -1782,6 +1787,7 @@ + @w{ Figure 7--3: Built-in Method Combination Types} + + @end group ++@end format + + The semantics of the @b{standard} built-in method combination type is + described in @ref{Standard Method Combination}. The other +@@ -1999,7 +2005,7 @@ + @node ensure-generic-function, allocate-instance, function-keywords, Objects Dictionary + @subsection ensure-generic-function [Function] + +-@code{ensure-generic-function} @i{function-name {&key} ++@code{ensure-generic-function} @i{function-name @r{&key} + argument-precedence-order declare + documentation environment + generic-function-class lambda-list +@@ -2106,13 +2112,13 @@ + + @subsubheading Syntax:: + +-@code{allocate-instance} @i{class {&rest} initargs {&key} {&allow-other-keys}} @result{} @i{new-instance} ++@code{allocate-instance} @i{class @r{&rest} initargs @r{&key} @r{&allow-other-keys}} @result{} @i{new-instance} + + @subsubheading Method Signatures:: + +-@code{allocate-instance} @i{@r{(}@i{class} @b{standard-class}@r{)} {&rest} initargs} ++@code{allocate-instance} @i{@r{(}@i{class} @b{standard-class}@r{)} @r{&rest} initargs} + +-@code{allocate-instance} @i{@r{(}@i{class} @b{structure-class}@r{)} {&rest} initargs} ++@code{allocate-instance} @i{@r{(}@i{class} @b{structure-class}@r{)} @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +@@ -2159,11 +2165,11 @@ + + @subsubheading Syntax:: + +-@code{reinitialize-instance} @i{instance {&rest} initargs {&key} {&allow-other-keys}} @result{} @i{instance} ++@code{reinitialize-instance} @i{instance @r{&rest} initargs @r{&key} @r{&allow-other-keys}} @result{} @i{instance} + + @subsubheading Method Signatures:: + +-@code{reinitialize-instance} @i{@r{(}@i{instance} @b{standard-object}@r{)} {&rest} initargs} ++@code{reinitialize-instance} @i{@r{(}@i{instance} @b{standard-object}@r{)} @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +@@ -2232,11 +2238,11 @@ + + @subsubheading Syntax:: + +-@code{shared-initialize} @i{instance slot-names {&rest} initargs {&key} {&allow-other-keys}} @result{} @i{instance} ++@code{shared-initialize} @i{instance slot-names @r{&rest} initargs @r{&key} @r{&allow-other-keys}} @result{} @i{instance} + + @subsubheading Method Signatures:: + +-@code{shared-initialize} @i{@r{(}@i{instance} @b{standard-object}@r{)} slot-names {&rest} initargs} ++@code{shared-initialize} @i{@r{(}@i{instance} @b{standard-object}@r{)} slot-names @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +@@ -2356,14 +2362,14 @@ + @subsubheading Syntax:: + + @code{update-instance-for-different-class} @i{previous current +- {&rest} initargs +- {&key} {&allow-other-keys}} @result{} @i{@i{implementation-dependent}} ++ @r{&rest} initargs ++ @r{&key} @r{&allow-other-keys}} @result{} @i{@i{implementation-dependent}} + + @subsubheading Method Signatures:: + + @code{update-instance-for-different-class} @i{@r{(}@i{previous} @b{standard-object}@r{)} + @r{(}@i{current} @b{standard-object}@r{)} +- {&rest} initargs} ++ @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +@@ -2462,15 +2468,15 @@ + @code{update-instance-for-redefined-class} @i{instance + added-slots discarded-slots + property-list +- {&rest} initargs {&key} {&allow-other-keys}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @r{&rest} initargs @r{&key} @r{&allow-other-keys}}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Method Signatures:: + + @code{update-instance-for-redefined-class} @i{@r{(}@i{instance} @b{standard-object}@r{)} + added-slots discarded-slots + property-list +- {&rest} initargs} ++ @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +@@ -2610,17 +2616,17 @@ + + @subsubheading Syntax:: + +-@code{change-class} @i{instance new-class {&key} {&allow-other-keys}} @result{} @i{instance} ++@code{change-class} @i{instance new-class @r{&key} @r{&allow-other-keys}} @result{} @i{instance} + + @subsubheading Method Signatures:: + + @code{change-class} @i{@r{(}@i{instance} @b{standard-object}@r{)} + @r{(}@i{new-class} @b{standard-class}@r{)} +- {&rest} initargs} ++ @r{&rest} initargs} + + @code{change-class} @i{@r{(}@i{instance} @b{t}@r{)} + @r{(}@i{new-class} @b{symbol}@r{)} +- {&rest} initargs} ++ @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +@@ -2651,7 +2657,7 @@ + generic function @b{update-instance-for-different-class} can be used + to assign values to slots in the transformed instance. + +-See @ref{Initializing Newly Added Local Slots}. ++See @ref{Initializing Newly Added Local Slots (Changing the Class of an Instance)}. + + If the second of the above @i{methods} is selected, + that @i{method} invokes @b{change-class} +@@ -2868,13 +2874,13 @@ + + @subsubheading Syntax:: + +-@code{slot-missing} @i{class object slot-name operation {&optional} new-value} @result{} @i{@{@i{result}@}{*}} ++@code{slot-missing} @i{class object slot-name operation @r{&optional} new-value} @result{} @i{@{@i{result}@}*} + + @subsubheading Method Signatures:: + + @code{slot-missing} @i{@r{(}@i{class} @b{t}@r{)} + object slot-name +- operation {&optional} new-value} ++ operation @r{&optional} new-value} + + @subsubheading Arguments and Values:: + +@@ -2961,7 +2967,7 @@ + + @subsubheading Syntax:: + +-@code{slot-unbound} @i{class instance slot-name} @result{} @i{@{@i{result}@}{*}} ++@code{slot-unbound} @i{class instance slot-name} @result{} @i{@{@i{result}@}*} + + @subsubheading Method Signatures:: + +@@ -3153,12 +3159,12 @@ + + @subsubheading Syntax:: + +-@code{no-applicable-method} @i{generic-function {&rest} function-arguments} @result{} @i{@{@i{result}@}{*}} ++@code{no-applicable-method} @i{generic-function @r{&rest} function-arguments} @result{} @i{@{@i{result}@}*} + + @subsubheading Method Signatures:: + + @code{no-applicable-method} @i{@r{(}@i{generic-function} @b{t}@r{)} +- {&rest} function-arguments} ++ @r{&rest} function-arguments} + + @subsubheading Arguments and Values:: + +@@ -3191,13 +3197,13 @@ + + @subsubheading Syntax:: + +-@code{no-next-method} @i{generic-function method {&rest} args} @result{} @i{@{@i{result}@}{*}} ++@code{no-next-method} @i{generic-function method @r{&rest} args} @result{} @i{@{@i{result}@}*} + + @subsubheading Method Signatures:: + + @code{no-next-method} @i{@r{(}@i{generic-function} @b{standard-generic-function}@r{)} + @r{(}@i{method} @b{standard-method}@r{)} +- {&rest} args} ++ @r{&rest} args} + + @subsubheading Arguments and Values:: + +@@ -3263,13 +3269,13 @@ + + @subsubheading Syntax:: + +-@code{make-instance} @i{class {&rest} initargs {&key} {&allow-other-keys}} @result{} @i{instance} ++@code{make-instance} @i{class @r{&rest} initargs @r{&key} @r{&allow-other-keys}} @result{} @i{instance} + + @subsubheading Method Signatures:: + +-@code{make-instance} @i{@r{(}@i{class} @b{standard-class}@r{)} {&rest} initargs} ++@code{make-instance} @i{@r{(}@i{class} @b{standard-class}@r{)} @r{&rest} initargs} + +-@code{make-instance} @i{@r{(}@i{class} @b{symbol}@r{)} {&rest} initargs} ++@code{make-instance} @i{@r{(}@i{class} @b{symbol}@r{)} @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +@@ -3359,17 +3365,17 @@ + + @subsubheading Syntax:: + +-@code{make-load-form} @i{object {&optional} environment} @result{} @i{creation-form@r{[}, initialization-form@r{]}} ++@code{make-load-form} @i{object @r{&optional} environment} @result{} @i{creation-form @r{[}, initialization-form @r{]}} + + @subsubheading Method Signatures:: + +-@code{make-load-form} @i{@r{(}@i{object} @b{standard-object}@r{)} {&optional} environment} ++@code{make-load-form} @i{@r{(}@i{object} @b{standard-object}@r{)} @r{&optional} environment} + +-@code{make-load-form} @i{@r{(}@i{object} @b{structure-object}@r{)} {&optional} environment} ++@code{make-load-form} @i{@r{(}@i{object} @b{structure-object}@r{)} @r{&optional} environment} + +-@code{make-load-form} @i{@r{(}@i{object} @b{condition}@r{)} {&optional} environment} ++@code{make-load-form} @i{@r{(}@i{object} @b{condition}@r{)} @r{&optional} environment} + +-@code{make-load-form} @i{@r{(}@i{object} @b{class}@r{)} {&optional} environment} ++@code{make-load-form} @i{@r{(}@i{object} @b{class}@r{)} @r{&optional} environment} + + @subsubheading Arguments and Values:: + +@@ -3643,7 +3649,7 @@ + @node make-load-form-saving-slots, with-accessors, make-load-form, Objects Dictionary + @subsection make-load-form-saving-slots [Function] + +-@code{make-load-form-saving-slots} @i{object {&key} slot-names environment}@* ++@code{make-load-form-saving-slots} @i{object @r{&key} slot-names environment}@* + @result{} @i{creation-form, initialization-form} + + @subsubheading Arguments and Values:: +@@ -3687,7 +3693,7 @@ + , + @ref{make-instance} + , +-@ref{setf; psetf} ++@ref{setf} + , + @ref{slot-value} + , +@@ -3708,12 +3714,12 @@ + @node with-accessors, with-slots, make-load-form-saving-slots, Objects Dictionary + @subsection with-accessors [Macro] + +-@code{with-accessors} @i{{@r{(}@{@i{slot-entry}@}{*}@r{)}} ++@code{with-accessors} @i{@r{@r{(}@{@i{slot-entry}@}*@r{)}} + instance-form +- @{@i{declaration}@}{*} @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + +-@w{@i{slot-entry} ::=@r{(}variable-name accessor-name@r{)}} ++@w{@i{slot-entry} ::=@r{(}variable-name accessor-name @r{)}} + + @subsubheading Arguments and Values:: + +@@ -3794,7 +3800,7 @@ + @center + @example + +-@w{@t{(with-accessors} ({slot-entry}_1 ...{slot-entry}_n) @i{instance-form} {form}_1 ...{form}_k)}@* ++@w{@t{(with-accessors} (@r{slot-entry}_1 ...@r{slot-entry}_n) @i{instance-form} @r{form}_1 ...@r{form}_k)}@* + @end example + + @noindent +@@ -3804,26 +3810,26 @@ + @example + + @w{@t{(}@t{let ((}in @i{instance-form}@t{))}}@* +-@w{ @t{(symbol-macrolet (}{Q}_1... {Q}_n@t{)} {form}_1 ...{form}_k@t{))}}@* ++@w{ @t{(symbol-macrolet (}@r{Q}_1... @r{Q}_n@t{)} @r{form}_1 ...@r{form}_k@t{))}}@* + @end example + + @noindent +-where {Q}_i is ++where @r{Q}_i is + +-@center { ++@center + @example +-@t{(}{variable-name}_i () +-@t{({accessor-name}_i in))} ++@t{(}@r{variable-name}_i () ++@t{(@r{accessor-name}_i in))} + @end example +-} ++ + + @node with-slots, defclass, with-accessors, Objects Dictionary + @subsection with-slots [Macro] + +-@code{with-slots} @i{@r{(}@{@i{slot-entry}@}{*}@r{)} ++@code{with-slots} @i{@r{(}@{@i{slot-entry}@}*@r{)} + instance-form +- @{@i{declaration}@}{*} @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++ @{@i{declaration}@}* @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @w{@i{slot-entry} ::=slot-name | @r{(}variable-name slot-name@r{)}} + +@@ -3916,7 +3922,7 @@ + @center + @example + +-@w{@t{(with-slots} ({slot-entry}_1 ...{slot-entry}_n) @i{instance-form} {form}_1 ...{form}_k)}@* ++@w{@t{(with-slots} (@r{slot-entry}_1 ...@r{slot-entry}_n) @i{instance-form} @r{form}_1 ...@r{form}_k)}@* + @end example + + @noindent +@@ -3926,44 +3932,44 @@ + @example + + @w{@t{(}@t{let ((}in @i{instance-form}@t{))}}@* +-@w{ @t{(symbol-macrolet (}{Q}_1... {Q}_n@t{)} {form}_1 ...{form}_k@t{))}}@* ++@w{ @t{(symbol-macrolet (}@r{Q}_1... @r{Q}_n@t{)} @r{form}_1 ...@r{form}_k@t{))}}@* + @end example + + @noindent +-where {Q}_i is ++where @r{Q}_i is + + @center + @example +-@t{(}{slot-entry}_i () +-@t{(slot-value }in '{slot-entry}_i@t{))} ++@t{(}@r{slot-entry}_i () ++@t{(slot-value }in '@r{slot-entry}_i@t{))} + @end example + + @noindent +-if {slot-entry}_i is a @i{symbol} ++if @r{slot-entry}_i is a @i{symbol} + and is + +-@center { ++@center + @example +-@t{(}{variable-name}_i () +-@t{(slot-value }in '{slot-name}_i@t{))} ++@t{(}@r{variable-name}_i () ++@t{(slot-value }in '@r{slot-name}_i@t{))} + @end example +-} ++ + + @noindent +-if {slot-entry}_i ++if @r{slot-entry}_i + is of the form + + @center + @example +-@t{(}{variable-name}_i +-{slot-name}_i@t{)} ++@t{(}@r{variable-name}_i ++@r{slot-name}_i@t{)} + @end example + + @node defclass, defgeneric, with-slots, Objects Dictionary + @subsection defclass [Macro] + +-@code{defclass} @i{@i{class-name} @r{(}@{@i{superclass-name}@}{*}@r{)} +-@r{(}@{{@i{slot-specifier}}@}{*}@r{)} ++@code{defclass} @i{@i{class-name} @r{(}@{@i{superclass-name}@}*@r{)} ++@r{(}@{@i{slot-specifier}@}*@r{)} + [[!@i{class-option}]]}@* + @result{} @i{new-class} + +@@ -3971,14 +3977,14 @@ + + @w{ @i{slot-name}::= @i{symbol}}@* + +-@w{ slot-option::=@{{:reader} @i{reader-function-name}@}{*} |}@* +-@w{ @{{:writer} @i{writer-function-name}@}{*} |}@* +-@w{ @{{:accessor} @i{reader-function-name}@}{*} |}@* +-@w{ @{{:allocation} @i{allocation-type}@} |}@* +-@w{ @{{:initarg} @i{initarg-name}@}{*} |}@* +-@w{ @{{:initform} @i{form}@} |}@* +-@w{ @{{:type} @i{type-specifier}@} |}@* +-@w{ @{{:documentation} @i{string}@}}@* ++@w{ slot-option::=@{@t{:reader} @i{reader-function-name}@}* |}@* ++@w{ @{@t{:writer} @i{writer-function-name}@}* |}@* ++@w{ @{@t{:accessor} @i{reader-function-name}@}* |}@* ++@w{ @{@t{:allocation} @i{allocation-type}@} |}@* ++@w{ @{@t{:initarg} @i{initarg-name}@}* |}@* ++@w{ @{@t{:initform} @i{form}@} |}@* ++@w{ @{@t{:type} @i{type-specifier}@} |}@* ++@w{ @{@t{:documentation} @i{string}@}}@* + + @w{ @i{function-name}::= @{@i{symbol} | @t{(setf @i{symbol})}@}}@* + +@@ -4283,7 +4289,7 @@ + + @subsubheading See Also:: + +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Initialize-Instance} + , +@@ -4301,17 +4307,17 @@ + @subsection defgeneric [Macro] + + @code{defgeneric} @i{function-name gf-lambda-list +- [[!@i{option} | @{!@i{method-description}@}{*}]]}@* ++ [[!@i{option} | @{!@i{method-description}@}*]]}@* + @result{} @i{new-generic} + + @w{@i{option} ::=@r{(}@t{:argument-precedence-order} @{@i{parameter-name}@}^+@r{)} |} + @w{ @r{(}@b{declare} @{@i{gf-declaration}@}^+@r{)} |} + @w{ @r{(}@t{:documentation} @i{gf-documentation}@r{)} |} +-@w{ @r{(}@t{:method-combination} @i{method-combination} @{@i{method-combination-argument}@}{*}@r{)} |} ++@w{ @r{(}@t{:method-combination} @i{method-combination} @{@i{method-combination-argument}@}*@r{)} |} + @w{ @r{(}@t{:generic-function-class} @i{generic-function-class}@r{)} |} + @w{ @r{(}@t{:method-class} @i{method-class}@r{)}} + +-@w{@i{method-description} ::=@r{(}@t{:method} @{@i{method-qualifier}@}{*} @i{specialized-lambda-list} {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}@r{)}} ++@w{@i{method-description} ::=@r{(}@t{:method} @{@i{method-qualifier}@}* @i{specialized-lambda-list} @r{[[@{@i{declaration}@}* | @i{documentation}]]} @{@i{form}@}*@r{)}} + + @subsubheading Arguments and Values:: + +@@ -4560,7 +4566,7 @@ + + @ref{defmethod} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{ensure-generic-function} + , +@@ -4573,9 +4579,9 @@ + @subsection defmethod [Macro] + + @code{defmethod} @i{@i{function-name} +- @{{@i{method-qualifier}}@}{*} ++ @{@i{method-qualifier}@}* + @i{specialized-lambda-list} +- {[[@{@i{declaration}@}{*} | @i{documentation}]]} @{@i{form}@}{*}}@* ++ @r{[[@{@i{declaration}@}* | @i{documentation}]]} @{@i{form}@}*}@* + @result{} @i{new-method} + + @i{function-name}::= @{@i{symbol} +@@ -4583,12 +4589,12 @@ + + @i{method-qualifier}::= @i{non-list} + +-@w{ @i{specialized-lambda-list}::= (@{@i{var} | @r{(}{@i{var} @i{parameter-specializer-name}}@r{)}@}{*}}@* +-@w{ @t{[}{&optional} @{@i{var} | @r{(}var @t{[}@i{initform} {@r{[}@i{supplied-p-parameter}@r{]}} @t{]}@r{)}@}{*}@t{]}}@* ++@w{ @i{specialized-lambda-list}::= (@{@i{var} | @r{(}@r{@i{var} @i{parameter-specializer-name}}@r{)}@}*}@* ++@w{ @t{[}@r{&optional} @{@i{var} | @r{(}var @t{[}@i{initform} @r{@r{[}@i{supplied-p-parameter}@r{]}} @t{]}@r{)}@}*@t{]}}@* + @w{ @t{[}@t{&rest} @i{var}@t{]}}@* +-@w{ @t{{[}}{{&key}{}}@{@i{var} | @r{(}@{@i{var} | @r{(}@i{keyword}@i{var}@r{)}@} @t{[}@i{initform} @r{[}@i{supplied-p-parameter}@r{]} @t{]}@r{)}@}{*}}@* +-@w{ @r{[}@b{&allow-other-keys}@r{]} @t{{]}}}@* +-@w{ @t{[}@t{&aux} @{@i{var} | @r{(}@i{var} @r{[}@i{initform}@r{]} @r{)}@}{*}@t{]} @r{)}}@* ++@w{ @t{[}@r{@r{&key}}@{@i{var} | @r{(}@{@i{var} | @r{(}@i{keyword}@i{var}@r{)}@} @t{[}@i{initform} @r{[}@i{supplied-p-parameter}@r{]} @t{]}@r{)}@}*}@* ++@w{ @r{[}@b{&allow-other-keys}@r{]} @t{]}}@* ++@w{ @t{[}@t{&aux} @{@i{var} | @r{(}@i{var} @r{[}@i{initform}@r{]} @r{)}@}*@t{]} @r{)}}@* + + @w{ @i{parameter-specializer-name}::= @i{symbol} | @r{(}@t{eql} @i{eql-specializer-form}@r{)}}@* + +@@ -4747,7 +4753,7 @@ + + @ref{defgeneric} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{Introduction to Methods}, + @ref{Congruent Lambda-lists for all Methods of a Generic Function}, +@@ -4757,9 +4763,9 @@ + @node find-class, next-method-p, defmethod, Objects Dictionary + @subsection find-class [Accessor] + +-@code{find-class} @i{symbol {&optional} errorp environment} @result{} @i{class} ++@code{find-class} @i{symbol @r{&optional} errorp environment} @result{} @i{class} + +-(setf (@code{ find-class} @i{symbol {&optional} errorp environment}) new-class)@* ++(setf (@code{ find-class} @i{symbol @r{&optional} errorp environment}) new-class)@* + + @subsubheading Arguments and Values:: + +@@ -4857,14 +4863,14 @@ + , + @ref{defmethod} + , +-@ref{call-method; make-method} ++@ref{call-method} + + @node call-method, call-next-method, next-method-p, Objects Dictionary + @subsection call-method, make-method [Local Macro] + + @subsubheading Syntax:: + +-@code{call-method} @i{method {&optional} next-method-list} @result{} @i{@{@i{result}@}{*}} ++@code{call-method} @i{method @r{&optional} next-method-list} @result{} @i{@{@i{result}@}*} + + @code{make-method} @i{form} @result{} @i{method-object} + +@@ -4935,7 +4941,7 @@ + @b{call-next-method} function available to + @i{method} signals an error of @i{type} @b{control-error} + and the @b{next-method-p} function +-available to @i{method} returns {@b{nil}}. ++available to @i{method} returns @b{nil}. + + @subsubheading Examples:: + +@@ -4952,7 +4958,7 @@ + + @subsubheading Syntax:: + +-@code{call-next-method} @i{{&rest} args} @result{} @i{@{@i{result}@}{*}} ++@code{call-next-method} @i{@r{&rest} args} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -5034,7 +5040,7 @@ + , + @ref{no-next-method} + , +-@ref{call-method; make-method} ++@ref{call-method} + , + @ref{Method Selection and Combination}, + @ref{Standard Method Combination}, +@@ -5083,12 +5089,12 @@ + @result{} @i{name} + + @code{define-method-combination} @i{name lambda-list +- @r{(}@{@i{method-group-specifier}@}{*}@r{)} ++ @r{(}@{@i{method-group-specifier}@}*@r{)} + @r{[}@r{(}@t{:arguments} . args-lambda-list@r{)}@r{]} + @r{[}@r{(}@t{:generic-function} + generic-function-symbol@r{)}@r{]} +- [[@{@i{declaration}@}{*} | @i{documentation}]] +- @{@i{form}@}{*}}@* ++ [[@{@i{declaration}@}* | @i{documentation}]] ++ @{@i{form}@}*}@* + @result{} @i{name} + + @w{@i{short-form-option} ::=@t{:documentation} @i{documentation} | } +@@ -5159,7 +5165,7 @@ + when the second @i{subform} is a @i{non-nil} symbol or is not present. + When the short form is used, @i{name} is defined as a type of + method combination that produces a Lisp form +-@t{({@i{operator} @i{method-call} @i{method-call} ...})}. ++@t{(@r{@i{operator} @i{method-call} @i{method-call} ...})}. + The @i{operator} is a @i{symbol} that can be the @i{name} of a + @i{function}, @i{macro}, or @i{special operator}. + The @i{operator} can be supplied by a keyword option; +@@ -5620,11 +5626,11 @@ + + @subsubheading See Also:: + +-@ref{call-method; make-method} ++@ref{call-method} + , + @ref{call-next-method} + , +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{method-qualifiers} + , +@@ -5651,13 +5657,13 @@ + + @subsubheading Syntax:: + +-@code{find-method} @i{generic-function method-qualifiers specializers {&optional} errorp}@* ++@code{find-method} @i{generic-function method-qualifiers specializers @r{&optional} errorp}@* + @result{} @i{method} + + @subsubheading Method Signatures:: + + @code{find-method} @i{@r{(}@i{generic-function} @b{standard-generic-function}@r{)} +- method-qualifiers specializers {&optional} errorp} ++ method-qualifiers specializers @r{&optional} errorp} + + @subsubheading Arguments and Values:: + +@@ -5783,11 +5789,11 @@ + + @subsubheading Syntax:: + +-@code{initialize-instance} @i{instance {&rest} initargs {&key} {&allow-other-keys}} @result{} @i{instance} ++@code{initialize-instance} @i{instance @r{&rest} initargs @r{&key} @r{&allow-other-keys}} @result{} @i{instance} + + @subsubheading Method Signatures:: + +-@code{initialize-instance} @i{@r{(}@i{instance} @b{standard-object}@r{)} {&rest} initargs} ++@code{initialize-instance} @i{@r{(}@i{instance} @b{standard-object}@r{)} @r{&rest} initargs} + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/chap-8.texi gcl-texi/chap-8.texi +--- gcl-texi-orig/chap-8.texi 1994-07-16 18:03:14 +0400 ++++ gcl-texi/chap-8.texi 2002-10-17 20:53:05 +0400 +@@ -20,13 +20,13 @@ + @node defstruct, copy-structure, Structures Dictionary, Structures Dictionary + @subsection defstruct [Macro] + +-@code{defstruct} @i{name-and-options @r{[}documentation@r{]} @{!@i{slot-description}@}{*}}@* ++@code{defstruct} @i{name-and-options @r{[}documentation@r{]} @{!@i{slot-description}@}*}@* + @result{} @i{structure-name} + + @w{@i{name-and-options} ::=structure-name | @r{(}structure-name [[!@i{options}]]@r{)}} + + @w{@i{options} ::=!@i{conc-name-option} |} +-@w{ @{!@i{constructor-option}@}{*} |} ++@w{ @{!@i{constructor-option}@}* |} + @w{ !@i{copier-option} |} + @w{ !@i{include-option} |} + @w{ !@i{initial-offset-option} |} +@@ -46,7 +46,7 @@ + + @w{@i{predicate-option} ::=@t{:predicate} | @r{(}@t{:predicate}@r{)} | @r{(}@t{:predicate} @i{predicate-name}@r{)}} + +-@w{@i{include-option} ::=@r{(}@t{:include} @i{included-structure-name} @{!@i{slot-description}@}{*}@r{)}} ++@w{@i{include-option} ::=@r{(}@t{:include} @i{included-structure-name} @{!@i{slot-description}@}*@r{)}} + + @w{@i{printer-option} ::=!@i{print-object-option} | !@i{print-function-option}} + +@@ -461,7 +461,7 @@ + structure specifies, by giving the @t{:include} option as: + + @example +- (:include @i{included-structure-name} @{@i{slot-description}@}{*}) ++ (:include @i{included-structure-name} @{@i{slot-description}@}*) + @end example + + Each @i{slot-description} must have a @i{slot-name} +@@ -1106,11 +1106,11 @@ + + @subsubheading See Also:: + +-@ref{documentation; (setf documentation)} ++@ref{documentation} + , + @ref{print-object} + , +-@ref{setf; psetf} ++@ref{setf} + , + @ref{subtypep} + , +diff -uNr gcl-texi-orig/chap-9.texi gcl-texi/chap-9.texi +--- gcl-texi-orig/chap-9.texi 1994-07-16 18:03:14 +0400 ++++ gcl-texi/chap-9.texi 2002-10-17 22:06:25 +0400 +@@ -98,7 +98,7 @@ + * Printing Conditions:: + * Signaling and Handling Conditions:: + * Assertions:: +-* Notes about the Condition System's Background:: ++* Notes about the Condition System`s Background:: + @end menu + + @node Condition Types, Creating Conditions, Condition System Concepts, Condition System Concepts +@@ -107,6 +107,7 @@ + Figure 9--1 lists the @i{standardized} @i{condition} @i{types}. + Additional @i{condition} @i{types} can be defined by using @b{define-condition}. + ++@format + @group + @noindent + @w{ arithmetic-error floating-point-overflow simple-type-error } +@@ -124,6 +125,7 @@ + @w{ Figure 9--1: Standardized Condition Types } + + @end group ++@end format + + All @i{condition} types are @i{subtypes} of @i{type} @b{condition}. That is, + +@@ -147,6 +149,7 @@ + Figure 9--2 shows @i{operators} that + define @i{condition} @i{types} and creating @i{conditions}. + ++@format + @group + @noindent + @w{ define-condition make-condition } +@@ -155,10 +158,12 @@ + @w{ Figure 9--2: Operators that define and create conditions.} + + @end group ++@end format + + Figure 9--3 shows @i{operators} that @i{read} + the @i{value} of @i{condition} @i{slots}. + ++@format + @group + @noindent + @w{ arithmetic-error-operands simple-condition-format-arguments } +@@ -172,6 +177,7 @@ + @w{ Figure 9--3: Operators that read condition slots. } + + @end group ++@end format + + @menu + * Serious Conditions:: +@@ -210,7 +216,7 @@ + . + By convention, those arguments are notated as + +- @i{datum} {&rest} @i{arguments} ++ @i{datum} @r{&rest} @i{arguments} + + Taken together, the @i{datum} and the @i{arguments} are + ``@i{designators} for a @i{condition} of default type @i{default-type}.'' +@@ -218,7 +224,7 @@ + + @table @asis + +-@item {@t{*}} If the @i{datum} is a @i{symbol} ++@item @t{*} If the @i{datum} is a @i{symbol} + naming a @i{condition} @i{type} ... + The denoted @i{condition} is the result of + +@@ -226,7 +232,7 @@ + (apply #'make-condition @i{datum} @i{arguments}) + @end example + +-@item {@t{*}} If the @i{datum} is a @i{format control} ... ++@item @t{*} If the @i{datum} is a @i{format control} ... + + The denoted @i{condition} is the result of + +@@ -238,7 +244,7 @@ + + where the @i{defaulted-type} is a @i{subtype} of @i{default-type}. + +-@item {@t{*}} If the @i{datum} is a @i{condition} ... ++@item @t{*} If the @i{datum} is a @i{condition} ... + The denoted @i{condition} is the @i{datum} itself. + In this case, unless otherwise specified by the description of the + @i{operator} in question, the @i{arguments} must be @i{null}; +@@ -456,6 +462,7 @@ + Figure 9--4 shows @i{operators} relating to + the @i{handling} of @i{conditions}. + ++@format + @group + @noindent + @w{ handler-bind handler-case ignore-errors } +@@ -464,6 +471,7 @@ + @w{ Figure 9--4: Operators relating to handling conditions.} + + @end group ++@end format + + @menu + * Signaling:: +@@ -502,6 +510,7 @@ + Figure 9--5 shows @i{defined names} relating to + the @i{signaling} of @i{conditions}. + ++@format + @group + @noindent + @w{ *break-on-signals* error warn } +@@ -511,6 +520,7 @@ + @w{ Figure 9--5: Defined names relating to signaling conditions.} + + @end group ++@end format + + @node Resignaling a Condition, Restarts, Signaling, Signaling and Handling Conditions + @subsubsection Resignaling a Condition +@@ -642,6 +652,7 @@ + Figure 9--6 shows @i{defined names} relating to + @i{restarts}. + ++@format + @group + @noindent + @w{ abort invoke-restart-interactively store-value } +@@ -654,6 +665,7 @@ + @w{ Figure 9--6: Defined names relating to restarts. } + + @end group ++@end format + + @node Restart Tests, Associating a Restart with a Condition, Interfaces to Restarts, Signaling and Handling Conditions + @subsubsection Restart Tests +@@ -683,7 +695,7 @@ + @i{condition} by calling such a function without a @i{condition} @i{argument}, + or by supplying a value of @b{nil} for such an @i{argument}. + +-@node Assertions, Notes about the Condition System's Background, Signaling and Handling Conditions, Condition System Concepts ++@node Assertions, Notes about the Condition System`s Background, Signaling and Handling Conditions, Condition System Concepts + @subsection Assertions + + Conditional signaling of @i{conditions} +@@ -691,6 +703,7 @@ + and @i{type} are handled by assertion @i{operators}. + Figure 9--7 shows @i{operators} relating to assertions. + ++@format + @group + @noindent + @w{ assert check-type ecase } +@@ -700,9 +713,10 @@ + @w{ Figure 9--7: Operators relating to assertions.} + + @end group ++@end format + +-@node Notes about the Condition System's Background, , Assertions, Condition System Concepts +-@subsection Notes about the Condition System's Background ++@node Notes about the Condition System`s Background, , Assertions, Condition System Concepts ++@subsection Notes about the Condition System`s Background + + For a background reference to the abstract concepts detailed in this + section, see @i{Exceptional Situations in Lisp}. The details of that paper are not binding on +@@ -757,12 +771,12 @@ + * restart-name:: + * with-condition-restarts:: + * with-simple-restart:: +-* abort:: ++* abort (Restart):: + * continue:: + * muffle-warning:: + * store-value:: + * use-value:: +-* abort:: ++* abort (Function):: + @end menu + + @node condition, warning, Conditions Dictionary, Conditions Dictionary +@@ -1038,9 +1052,9 @@ + @node assert, error, storage-condition, Conditions Dictionary + @subsection assert [Macro] + +-@code{assert} @i{test-form @r{[}@r{(}@{@i{place}@}{*}@r{)} ++@code{assert} @i{test-form @r{[}@r{(}@{@i{place}@}*@r{)} + @r{[}datum-form +- @{@i{argument-form}@}{*}@r{]}@r{]}}@* ++ @{@i{argument-form}@}*@r{]}@r{]}}@* + @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: +@@ -1158,7 +1172,7 @@ + @node error, cerror, assert, Conditions Dictionary + @subsection error [Function] + +-@code{error} @i{datum {&rest} arguments} ++@code{error} @i{datum @r{&rest} arguments} + @result{} # + + @subsubheading Arguments and Values:: +@@ -1276,7 +1290,7 @@ + @node cerror, check-type, error, Conditions Dictionary + @subsection cerror [Function] + +-@code{cerror} @i{continue-format-control datum {&rest} arguments} @result{} @i{@b{nil}} ++@code{cerror} @i{continue-format-control datum @r{&rest} arguments} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -1441,7 +1455,7 @@ + @node check-type, simple-error, cerror, Conditions Dictionary + @subsection check-type [Macro] + +-@code{check-type} @i{place typespec {@r{[}@i{string}@r{]}}} @result{} @i{@b{nil}} ++@code{check-type} @i{place typespec @r{@r{[}@i{string}@r{]}}} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -1596,7 +1610,7 @@ + @node invalid-method-error, method-combination-error, simple-error, Conditions Dictionary + @subsection invalid-method-error [Function] + +-@code{invalid-method-error} @i{method format-control {&rest} args} @result{} @i{@i{implementation-dependent}} ++@code{invalid-method-error} @i{method format-control @r{&rest} args} @result{} @i{@i{implementation-dependent}} + + @subsubheading Arguments and Values:: + +@@ -1642,7 +1656,7 @@ + @node method-combination-error, signal, invalid-method-error, Conditions Dictionary + @subsection method-combination-error [Function] + +-@code{method-combination-error} @i{format-control {&rest} args} @result{} @i{@i{implementation-dependent}} ++@code{method-combination-error} @i{format-control @r{&rest} args} @result{} @i{@i{implementation-dependent}} + + @subsubheading Arguments and Values:: + +@@ -1679,7 +1693,7 @@ + @node signal, simple-condition, method-combination-error, Conditions Dictionary + @subsection signal [Function] + +-@code{signal} @i{datum {&rest} arguments} @result{} @i{@b{nil}} ++@code{signal} @i{datum @r{&rest} arguments} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -1779,7 +1793,7 @@ + + @subsubheading See Also:: + +-@ref{simple-condition-format-control; simple-condition-format-arguments} ++@ref{simple-condition-format-control} + , + + @b{simple-condition-format-arguments} +@@ -1831,7 +1845,7 @@ + @node warn, simple-warning, simple-condition-format-control, Conditions Dictionary + @subsection warn [Function] + +-@code{warn} @i{datum {&rest} arguments} @result{} @i{@b{nil}} ++@code{warn} @i{datum @r{&rest} arguments} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -1999,7 +2013,7 @@ + @node break, *debugger-hook*, invoke-debugger, Conditions Dictionary + @subsection break [Function] + +-@code{break} @i{{&optional} format-control {&rest} format-arguments} @result{} @i{@b{nil}} ++@code{break} @i{@r{&optional} format-control @r{&rest} format-arguments} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +@@ -2241,8 +2255,8 @@ + @node handler-bind, handler-case, *break-on-signals*, Conditions Dictionary + @subsection handler-bind [Macro] + +-@code{handler-bind} @i{@r{(}@{!@i{binding}@}{*}@r{)} +- @{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{handler-bind} @i{@r{(}@{!@i{binding}@}*@r{)} ++ @{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @w{@i{binding} ::=@r{(}type handler@r{)}} + +@@ -2325,13 +2339,13 @@ + @subsection handler-case [Macro] + + @code{handler-case} @i{@i{expression} +- [[@{!@i{error-clause}@}{*} | !@i{no-error-clause}]]} @result{} @i{@{@i{result}@}{*}} ++ [[@{!@i{error-clause}@}* | !@i{no-error-clause}]]} @result{} @i{@{@i{result}@}*} + + @w{@i{clause} ::=!@i{error-clause} | !@i{no-error-clause}} + +-@w{@i{error-clause} ::=@r{(}typespec @r{(}@t{[}var@t{]}@r{)} @{@i{declaration}@}{*} @{@i{form}@}{*}@r{)}} ++@w{@i{error-clause} ::=@r{(}typespec @r{(}@t{[}var@t{]}@r{)} @{@i{declaration}@}* @{@i{form}@}*@r{)}} + +-@w{@i{no-error-clause} ::=@r{(}@t{:no-error} @i{lambda-list} @{@i{declaration}@}{*} @{@i{form}@}{*}@r{)}} ++@w{@i{no-error-clause} ::=@r{(}@t{:no-error} @i{lambda-list} @{@i{declaration}@}* @{@i{form}@}*@r{)}} + + @subsubheading Arguments and Values:: + +@@ -2406,7 +2420,7 @@ + @i{expression} returns normally and a @i{no-error-clause} + does exist, the values returned are used as arguments to the function + described by constructing +- @t{(lambda @i{lambda-list} @{@i{form}@}{*})} ++ @t{(lambda @i{lambda-list} @{@i{form}@}*)} + from the @i{no-error-clause}, and the @i{values} of that function call are + returned by @b{handler-case}. + The handlers which were established around the @i{expression} are no longer active at the time of this call. +@@ -2490,7 +2504,7 @@ + @node ignore-errors, define-condition, handler-case, Conditions Dictionary + @subsection ignore-errors [Macro] + +-@code{ignore-errors} @i{@{@i{form}@}{*}} @result{} @i{@{@i{result}@}{*}} ++@code{ignore-errors} @i{@{@i{form}@}*} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -2561,20 +2575,20 @@ + + [Editorial Note by KMP: This syntax stuff is still very confused and needs lots of work.] + +-@code{define-condition} @i{name @r{(}@{@i{parent-type}@}{*}@r{)} +- @r{(}@{!@i{slot-spec}@}{*}@r{)} +- @{@i{option}@}{*}}@* ++@code{define-condition} @i{name @r{(}@{@i{parent-type}@}*@r{)} ++ @r{(}@{!@i{slot-spec}@}*@r{)} ++ @{@i{option}@}*}@* + @result{} @i{name} + + @w{@i{slot-spec} ::=slot-name | @r{(}slot-name !@i{slot-option}@r{)}} + +-@w{@i{slot-option} ::=[[ @{{:reader} @i{symbol}@}{*} | } +-@w{ @{{:writer} !@i{function-name}@}{*} | } +-@w{ @{{:accessor} @i{symbol}@}{*} | } +-@w{ @{{:allocation} !@i{allocation-type}@} | } +-@w{ @{{:initarg} @i{symbol}@}{*} | } +-@w{ @{{:initform} @i{form}@} | } +-@w{ @{{:type} @i{type-specifier}@} ]]} ++@w{@i{slot-option} ::=[[ @{@t{:reader} @i{symbol}@}* | } ++@w{ @{@t{:writer} !@i{function-name}@}* | } ++@w{ @{@t{:accessor} @i{symbol}@}* | } ++@w{ @{@t{:allocation} !@i{allocation-type}@} | } ++@w{ @{@t{:initarg} @i{symbol}@}* | } ++@w{ @{@t{:initform} @i{form}@} | } ++@w{ @{@t{:type} @i{type-specifier}@} ]]} + + @w{@i{option} ::=[[ @r{(}@t{:default-initargs} @t{.} @i{initarg-list}@r{)} | } + @w{ @r{(}@t{:documentation} @i{string}@r{)} | } +@@ -2897,7 +2911,7 @@ + @node make-condition, restart, define-condition, Conditions Dictionary + @subsection make-condition [Function] + +-@code{make-condition} @i{type {&rest} slot-initializations} @result{} @i{condition} ++@code{make-condition} @i{type @r{&rest} slot-initializations} @result{} @i{condition} + + @subsubheading Arguments and Values:: + +@@ -2963,7 +2977,7 @@ + @node compute-restarts, find-restart, restart, Conditions Dictionary + @subsection compute-restarts [Function] + +-@code{compute-restarts} @i{{&optional} condition} @result{} @i{restarts} ++@code{compute-restarts} @i{@r{&optional} condition} @result{} @i{restarts} + + @subsubheading Arguments and Values:: + +@@ -3051,8 +3065,8 @@ + @node find-restart, invoke-restart, compute-restarts, Conditions Dictionary + @subsection find-restart [Function] + +-@code{find-restart} @i{identifier {&optional} condition} +- {restart} ++@code{find-restart} @i{identifier @r{&optional} condition} ++ @r{restart} + + @subsubheading Arguments and Values:: + +@@ -3120,7 +3134,7 @@ + @node invoke-restart, invoke-restart-interactively, find-restart, Conditions Dictionary + @subsection invoke-restart [Function] + +-@code{invoke-restart} @i{restart {&rest} arguments} @result{} @i{@{@i{result}@}{*}} ++@code{invoke-restart} @i{restart @r{&rest} arguments} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -3185,7 +3199,7 @@ + @node invoke-restart-interactively, restart-bind, invoke-restart, Conditions Dictionary + @subsection invoke-restart-interactively [Function] + +-@code{invoke-restart-interactively} @i{restart} @result{} @i{@{@i{result}@}{*}} ++@code{invoke-restart-interactively} @i{restart} @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -3270,14 +3284,14 @@ + @node restart-bind, restart-case, invoke-restart-interactively, Conditions Dictionary + @subsection restart-bind [Macro] + +-@code{restart-bind} @i{@r{(}@{{(}name function +- @{!@i{key-val-pair}@}{*}@r{)}@}{)} +- @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} +- +-@w{@i{key-val-pair} ::=@t{:interactive-function} {interactive-function} | } +-@w{ @t{:report-function} {report-function} | } +-@w{ @t{:test-function} {test-function}} ++@code{restart-bind} @i{@r{(}@{@r{(}name function ++ @{!@i{key-val-pair}@}*@r{)}@}@r{)} ++ @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} ++ ++@w{@i{key-val-pair} ::=@t{:interactive-function} @r{interactive-function} | } ++@w{ @t{:report-function} @r{report-function} | } ++@w{ @t{:test-function} @r{test-function}} + + @subsubheading Arguments and Values:: + +@@ -3386,11 +3400,11 @@ + @node restart-case, restart-name, restart-bind, Conditions Dictionary + @subsection restart-case [Macro] + +-@code{restart-case} @i{restartable-form {@{!@i{clause}@}}} @result{} @i{@{@i{result}@}{*}} ++@code{restart-case} @i{restartable-form @r{@{!@i{clause}@}}} @result{} @i{@{@i{result}@}*} + + @w{@i{clause} ::=@r{(} case-name lambda-list } + @w{ [[@t{:interactive} interactive-expression | @t{:report} report-expression | @t{:test} test-expression]] } +-@w{ @{@i{declaration}@}{*} @{@i{form}@}{*}@r{)}} ++@w{ @{@i{declaration}@}* @{@i{form}@}*@r{)}} + + @subsubheading Arguments and Values:: + +@@ -3700,8 +3714,8 @@ + @node with-condition-restarts, with-simple-restart, restart-name, Conditions Dictionary + @subsection with-condition-restarts [Macro] + +-@code{with-condition-restarts} @i{condition-form restarts-form @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{with-condition-restarts} @i{condition-form restarts-form @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -3740,12 +3754,12 @@ + since @b{restart-case} handles most of the common cases + in a way that is syntactically more concise. + +-@node with-simple-restart, abort, with-condition-restarts, Conditions Dictionary ++@node with-simple-restart, abort (Restart), with-condition-restarts, Conditions Dictionary + @subsection with-simple-restart [Macro] + +-@code{with-simple-restart} @i{@r{(}name format-control @{@i{format-argument}@}{*}@r{)} +- @{@i{form}@}{*}}@* +- @result{} @i{@{@i{result}@}{*}} ++@code{with-simple-restart} @i{@r{(}name format-control @{@i{format-argument}@}*@r{)} ++ @{@i{form}@}*}@* ++ @result{} @i{@{@i{result}@}*} + + @subsubheading Arguments and Values:: + +@@ -3800,7 +3814,7 @@ + + @example + (defun compute-fixnum-power-of-2 (x) +- (with-simple-restart (nil "Give up on computing 2{@t{^}}~D." x) ++ (with-simple-restart (nil "Give up on computing 2@t{^}~D." x) + (let ((result 1)) + (dotimes (i x result) + (setq result (* 2 result)) +@@ -3815,7 +3829,7 @@ + (compute-power-of-2 10000) + @t{ |> } Error: Power of 2 is too large. + @t{ |> } To continue, type :CONTINUE followed by an option number. +-@t{ |> } 1: Give up on computing 2{@t{^}}10000. ++@t{ |> } 1: Give up on computing 2@t{^}10000. + @t{ |> } 2: Return to Lisp Toplevel + @t{ |> } Debug> @b{|>>}@t{:continue 1}@b{<<|} + @result{} SOMETHING-BIG +@@ -3848,7 +3862,7 @@ + in the normal case to be missing or @b{nil} so that the two situations + can be distinguished. + +-@node abort, continue, with-simple-restart, Conditions Dictionary ++@node abort (Restart), continue, with-simple-restart, Conditions Dictionary + @subsection abort [Restart] + + @subsubheading Data Arguments Required:: +@@ -3875,10 +3889,10 @@ + @ref{Interfaces to Restarts}, + @ref{invoke-restart} + , +-@ref{abort} ++@ref{abort (Function)} + (@i{function}) + +-@node continue, muffle-warning, abort, Conditions Dictionary ++@node continue, muffle-warning, abort (Restart), Conditions Dictionary + @subsection continue [Restart] + + @subsubheading Data Arguments Required:: +@@ -4020,7 +4034,7 @@ + @ref{use-value} + (@i{function} and @i{restart}) + +-@node use-value, abort, store-value, Conditions Dictionary ++@node use-value, abort (Function), store-value, Conditions Dictionary + @subsection use-value [Restart] + + @subsubheading Data Arguments Required:: +@@ -4044,7 +4058,7 @@ + @ref{store-value} + (@i{function} and @i{restart}) + +-@node abort, , use-value, Conditions Dictionary ++@node abort (Function), , use-value, Conditions Dictionary + @subsection abort, continue, muffle-warning, store-value, use-value [Function] + + @IRindex{abort} +@@ -4057,17 +4071,17 @@ + + @IRindex{use-value} + +-@code{abort} @i{{&optional} condition} ++@code{abort} @i{@r{&optional} condition} + @result{} # + +-@code{continue} @i{{&optional} condition} @result{} @i{@b{nil}} ++@code{continue} @i{@r{&optional} condition} @result{} @i{@b{nil}} + +-@code{muffle-warning} @i{{&optional} condition} ++@code{muffle-warning} @i{@r{&optional} condition} + @result{} # + +-@code{store-value} @i{value {&optional} condition} @result{} @i{@b{nil}} ++@code{store-value} @i{value @r{&optional} condition} @result{} @i{@b{nil}} + +-@code{use-value} @i{value {&optional} condition} @result{} @i{@b{nil}} ++@code{use-value} @i{value @r{&optional} condition} @result{} @i{@b{nil}} + + @subsubheading Arguments and Values:: + +diff -uNr gcl-texi-orig/gcl.texi gcl-texi/gcl.texi +--- gcl-texi-orig/gcl.texi 1994-07-16 18:03:23 +0400 ++++ gcl-texi/gcl.texi 2002-10-18 12:47:46 +0400 +@@ -5,11 +5,19 @@ + @settitle ANSI and GNU Common Lisp Document + @c %**end of header + @setchapternewpage odd ++ + @ifinfo + This is a Texinfo GNU Common Lisp Manual based on the draft ANSI standard + for Common Lisp. + + Copyright 1994 William F. Schelter ++ ++@format ++INFO-DIR-SECTION GNU Common Lisp ++START-INFO-DIR-ENTRY ++* gcl: (gcl.info). GNU Common Lisp Manual ++END-INFO-DIR-ENTRY ++@end format + @end ifinfo + + @titlepage +@@ -32,7 +40,7 @@ + @c Example index + @defcodeindex IP + @c Package index +-@defcodeindex IK ++@c @defcodeindex IK + @c Keyword Index + + @node Top, Introduction (Introduction), (dir), (dir) +@@ -110,38 +118,38 @@ + + Interpreting Dictionary Entries + +-* The ``Affected By'' Section of a Dictionary Entry:: +-* The ``Arguments'' Section of a Dictionary Entry:: +-* The ``Arguments and Values'' Section of a Dictionary Entry:: +-* The ``Binding Types Affected'' Section of a Dictionary Entry:: +-* The ``Class Precedence List'' Section of a Dictionary Entry:: ++* The "Affected By" Section of a Dictionary Entry:: ++* The "Arguments" Section of a Dictionary Entry:: ++* The "Arguments and Values" Section of a Dictionary Entry:: ++* The "Binding Types Affected" Section of a Dictionary Entry:: ++* The "Class Precedence List" Section of a Dictionary Entry:: + * Dictionary Entries for Type Specifiers:: +-* The ``Compound Type Specifier Kind'' Section of a Dictionary Entry:: +-* The ``Compound Type Specifier Syntax'' Section of a Dictionary Entry:: +-* The ``Compound Type Specifier Arguments'' Section of a Dictionary Entry:: +-* The ``Compound Type Specifier Description'' Section of a Dictionary Entry:: +-* The ``Constant Value'' Section of a Dictionary Entry:: +-* The ``Description'' Section of a Dictionary Entry:: +-* The ``Examples'' Section of a Dictionary Entry:: +-* The ``Exceptional Situations'' Section of a Dictionary Entry:: +-* The ``Initial Value'' Section of a Dictionary Entry:: +-* The ``Argument Precedence Order'' Section of a Dictionary Entry:: +-* The ``Method Signature'' Section of a Dictionary Entry:: +-* The ``Name'' Section of a Dictionary Entry:: +-* The ``Notes'' Section of a Dictionary Entry:: +-* The ``Pronunciation'' Section of a Dictionary Entry:: +-* The ``See Also'' Section of a Dictionary Entry:: +-* The ``Side Effects'' Section of a Dictionary Entry:: +-* The ``Supertypes'' Section of a Dictionary Entry:: +-* The ``Syntax'' Section of a Dictionary Entry:: +-* Special ``Syntax'' Notations for Overloaded Operators:: ++* The "Compound Type Specifier Kind" Section of a Dictionary Entry:: ++* The "Compound Type Specifier Syntax" Section of a Dictionary Entry:: ++* The "Compound Type Specifier Arguments" Section of a Dictionary Entry:: ++* The "Compound Type Specifier Description" Section of a Dictionary Entry:: ++* The "Constant Value" Section of a Dictionary Entry:: ++* The "Description" Section of a Dictionary Entry:: ++* The "Examples" Section of a Dictionary Entry:: ++* The "Exceptional Situations" Section of a Dictionary Entry:: ++* The "Initial Value" Section of a Dictionary Entry:: ++* The "Argument Precedence Order" Section of a Dictionary Entry:: ++* The "Method Signature" Section of a Dictionary Entry:: ++* The "Name" Section of a Dictionary Entry:: ++* The "Notes" Section of a Dictionary Entry:: ++* The "Pronunciation" Section of a Dictionary Entry:: ++* The "See Also" Section of a Dictionary Entry:: ++* The "Side Effects" Section of a Dictionary Entry:: ++* The "Supertypes" Section of a Dictionary Entry:: ++* The "Syntax" Section of a Dictionary Entry:: ++* Special "Syntax" Notations for Overloaded Operators:: + * Naming Conventions for Rest Parameters:: +-* Requiring Non-Null Rest Parameters in the ``Syntax'' Section:: +-* Return values in the ``Syntax'' Section:: +-* No Arguments or Values in the ``Syntax'' Section:: +-* Unconditional Transfer of Control in the ``Syntax'' Section:: +-* The ``Valid Context'' Section of a Dictionary Entry:: +-* The ``Value Type'' Section of a Dictionary Entry:: ++* Requiring Non-Null Rest Parameters in The "Syntax" Section:: ++* Return values in The "Syntax" Section:: ++* No Arguments or Values in The "Syntax" Section:: ++* Unconditional Transfer of Control in The "Syntax" Section:: ++* The "Valid Context" Section of a Dictionary Entry:: ++* The "Value Type" Section of a Dictionary Entry:: + + Conformance + +@@ -529,7 +537,7 @@ + * method-combination:: + * t (System Class):: + * satisfies:: +-* member:: ++* member (Type Specifier):: + * not (Type Specifier):: + * and (Type Specifier):: + * or (Type Specifier):: +@@ -871,7 +879,7 @@ + * Printing Conditions:: + * Signaling and Handling Conditions:: + * Assertions:: +-* Notes about the Condition System's Background:: ++* Notes about the Condition System`s Background:: + + Condition Types + +@@ -942,12 +950,12 @@ + * restart-name:: + * with-condition-restarts:: + * with-simple-restart:: +-* abort:: ++* abort (Restart):: + * continue:: + * muffle-warning:: + * store-value:: + * use-value:: +-* abort:: ++* abort (Function):: + + Symbols + +@@ -1095,13 +1103,13 @@ + * real:: + * float (System Class):: + * short-float:: +-* rational:: ++* rational (System Class):: + * ratio:: + * integer:: + * signed-byte:: + * unsigned-byte:: +-* mod:: +-* bit:: ++* mod (System Class):: ++* bit (System Class):: + * fixnum:: + * bignum:: + * =:: +@@ -1125,7 +1133,7 @@ + * incf:: + * lcm:: + * log:: +-* mod:: ++* mod (Function):: + * signum:: + * sqrt:: + * random-state:: +@@ -1143,7 +1151,7 @@ + * upgraded-complex-part-type:: + * realp:: + * numerator:: +-* rational:: ++* rational (Function):: + * rationalp:: + * ash:: + * integer-length:: +@@ -1257,7 +1265,7 @@ + + Conses Dictionary + +-* list:: ++* list (System Class):: + * null (System Class):: + * cons (System Class):: + * atom (Type):: +@@ -1271,7 +1279,7 @@ + * subst:: + * tree-equal:: + * copy-list:: +-* list:: ++* list (Function):: + * list-length:: + * listp:: + * make-list:: +@@ -1289,7 +1297,7 @@ + * ldiff:: + * nthcdr:: + * rest:: +-* member:: ++* member (Function):: + * mapc:: + * acons:: + * assoc:: +@@ -1368,7 +1376,7 @@ + * vector-pop:: + * vector-push:: + * vectorp:: +-* bit:: ++* bit (Array):: + * bit-and:: + * bit-vector-p:: + * simple-bit-vector-p:: +@@ -1741,7 +1749,7 @@ + + * Pretty Printer Concepts:: + * Examples of using the Pretty Printer:: +-* Notes about the Pretty Printer's Background:: ++* Notes about the Pretty Printer`s Background:: + + Pretty Printer Concepts + diff --git a/info/gcl/1_002b.html b/info/gcl/1_002b.html new file mode 100644 index 0000000..969dd53 --- /dev/null +++ b/info/gcl/1_002b.html @@ -0,0 +1,96 @@ + + + + + +1+ (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + + +
    +

    12.2.28 1+, 1- [Function]

    + +

    1 + ⇒ number + successor +1 - ⇒ number + predecessor +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    successor, predecessor—a number. +

    +

    Description::

    + +

    1+ returns a number that is one more than its argument number. +1- returns a number that is one less than its argument number. +

    +

    Examples::

    + +
    +
     (1+ 99) ⇒  100 
+ (1- 100) ⇒  99 
+ (1+ (complex 0.0)) ⇒  #C(1.0 0.0) 
+ (1- 5/3) ⇒  2/3 
+
    + +

    Exceptional Situations::

    + +

    Might signal type-error if its argument is not a number. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    incf +, decf +

    +

    Notes::

    + +
    +
     (1+ number) ≡ (+ number 1)
+ (1- number) ≡ (- number 1)
+
    + +

    Implementors are encouraged to make the performance of both the previous +expressions be the same. +

    + + + + + diff --git a/info/gcl/A-specifier-for-a-rest-parameter.html b/info/gcl/A-specifier-for-a-rest-parameter.html new file mode 100644 index 0000000..566756a --- /dev/null +++ b/info/gcl/A-specifier-for-a-rest-parameter.html @@ -0,0 +1,72 @@ + + + + + +A specifier for a rest parameter (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.3 A specifier for a rest parameter

    + + + +

    &rest, if present, must be followed by a single rest parameter +specifier, which in turn must be followed by another +lambda list keyword or the end of the lambda list. After all +optional parameter specifiers have been processed, then there may or +may not be a rest parameter. If there is a rest parameter, it is +bound to a list of all as-yet-unprocessed arguments. If +no unprocessed arguments remain, the rest parameter is bound to the +empty list. If there is no rest parameter and there are no +keyword parameters, then an error +should be signaled if +any unprocessed arguments remain; see Error Checking in Function Calls. +The value of a rest parameter +is permitted, but not required, to share structure with the +last argument to apply. +

    + + + + + + + + + diff --git a/info/gcl/APPLY-Forms-as-Places.html b/info/gcl/APPLY-Forms-as-Places.html new file mode 100644 index 0000000..5482955 --- /dev/null +++ b/info/gcl/APPLY-Forms-as-Places.html @@ -0,0 +1,98 @@ + + + + + +APPLY Forms as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.5 APPLY Forms as Places

    + +

    The following situations involving setf of apply must be supported: +

    +
    +
    *
    +

    (setf (apply #'aref array + {subscript}* + more-subscripts) + new-element) +

    +
    *
    +

    (setf (apply #'bit array + {subscript}* + more-subscripts) + new-element) +

    +
    *
    +

    (setf (apply #'sbit array + {subscript}* + more-subscripts) + new-element) +

    +
    + +

    In all three cases, the element of array designated +by the concatenation of subscripts and more-subscripts +(i.e., the same element which would be read by the call to + apply if it were not part of a setf form) +is changed to have the value given by new-element. +

    +

    For these usages, the function name (aref, bit, or sbit) +must refer to the global function definition, rather than a locally defined +function. +

    +

    No other standardized function is required to be supported, +but an implementation may define such support. +An implementation may also define support +for implementation-defined operators. +

    +

    If a user-defined function is used in this context, +the following equivalence is true, except that care is taken +to preserve proper left-to-right evaluation of argument subforms: +

    +
    +
     (setf (apply #'name {arg}*) val)
+ ≡ (apply #'(setf name) val {arg}*)
+
    + + + + + + diff --git a/info/gcl/Abstract-Classifications-of-Streams-_0028Introduction-to-Streams_0029.html b/info/gcl/Abstract-Classifications-of-Streams-_0028Introduction-to-Streams_0029.html new file mode 100644 index 0000000..d13b86e --- /dev/null +++ b/info/gcl/Abstract-Classifications-of-Streams-_0028Introduction-to-Streams_0029.html @@ -0,0 +1,51 @@ + + + + + +Abstract Classifications of Streams (Introduction to Streams) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Streams  

    +
    +
    +

    21.1.1.1 Abstract Classifications of Streams

    + + + + + + diff --git a/info/gcl/Abstract-Classifications-of-Streams.html b/info/gcl/Abstract-Classifications-of-Streams.html new file mode 100644 index 0000000..ef16f48 --- /dev/null +++ b/info/gcl/Abstract-Classifications-of-Streams.html @@ -0,0 +1,51 @@ + + + + + +Abstract Classifications of Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Streams  

    +
    +
    +

    21.1.1.5 Abstract Classifications of Streams

    + + + + + + diff --git a/info/gcl/Accessibility-of-Symbols-in-a-Package.html b/info/gcl/Accessibility-of-Symbols-in-a-Package.html new file mode 100644 index 0000000..b5ae838 --- /dev/null +++ b/info/gcl/Accessibility-of-Symbols-in-a-Package.html @@ -0,0 +1,93 @@ + + + + + +Accessibility of Symbols in a Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Packages  

    +
    +
    +

    11.1.1.5 Accessibility of Symbols in a Package

    + +

    A symbol becomes accessible + + in a package + if that is its home package when it is created, + or if it is imported into that package, + or by inheritance via use-package. +

    +

    If a symbol is accessible in a package, +it can be referred to when using the Lisp reader +without a package prefix when that package is the current package, +regardless of whether it is present or inherited. +

    +

    Symbols from one package can be made accessible +in another package in two ways. +

    +
    +
    –
    +

    Any individual symbol can be added to a package by use +of import. After the call to import the +symbol is present in the importing package. +The status of the symbol in the package +it came from (if any) is unchanged, and the home package for +this symbol is unchanged. +Once imported, a symbol is present in the +importing package +and can be removed only by calling unintern. +

    +

    A symbol is shadowed_3 by another symbol +in some package if the first symbol would be accessible +by inheritance if not for the presence of the second symbol. +See shadowing-import. +

    +
    +
    –
    +

    The second mechanism for making symbols from one package +accessible in another is provided by use-package. +All of the external symbols of the used package are inherited +by the using package. +The function unuse-package undoes the effects of a previous use-package. +

    +
    + + + + + + diff --git a/info/gcl/Accessing-Slots.html b/info/gcl/Accessing-Slots.html new file mode 100644 index 0000000..10b9a43 --- /dev/null +++ b/info/gcl/Accessing-Slots.html @@ -0,0 +1,107 @@ + + + + + +Accessing Slots (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Slots  

    +
    +
    +

    7.5.2 Accessing Slots

    + +

    Slots can be accessed in two ways: by use of the primitive function +slot-value and by use of generic functions generated by +the defclass form. +

    +

    The function slot-value can be used with any of the slot +names specified in the defclass form to access a specific +slot accessible in an instance of the given class. +

    +

    The macro defclass provides syntax for generating methods to +read and write slots. If a reader method is requested, +a method is automatically generated for reading the value of the +slot, but no method for storing a value into it is generated. +If a writer method is requested, a method is automatically +generated for storing a value into the slot, but no method +for reading its value is generated. If an accessor method is +requested, a method for reading the value of the slot and a +method for storing a value into the slot are automatically +generated. Reader and writer methods are implemented using +slot-value. +

    +

    When a reader or writer method is specified for a slot, the +name of the generic function to which the generated method +belongs is directly specified. If the name specified for the writer +method is the symbol name, the name of the +generic function for writing the slot is the symbol +name, and the generic function takes two arguments: the new +value and the instance, in that order. If the name specified +for the accessor method is the symbol name, the name of +the generic function for reading the slot is the symbol +name, and the name of the generic function for writing +the slot is the list (setf name). +

    +

    A generic function created or modified by supplying :reader, +:writer, or :accessor slot options can be treated exactly +as an ordinary generic function. +

    +

    Note that slot-value can be used to read or write the value of a +slot whether or not reader or writer methods exist for that +slot. When slot-value is used, no reader or writer +methods are invoked. +

    +

    The macro with-slots can be used to establish a +lexical environment in which specified slots are lexically +available as if they were variables. The macro with-slots +invokes the function slot-value to access the specified slots. +

    +

    The macro with-accessors can be used to establish a lexical +environment in which specified slots are lexically available through +their accessors as if they were variables. The macro with-accessors +invokes the appropriate accessors to access the specified slots. +

    +
    +
    +

    +Next: , Previous: , Up: Slots  

    +
    + + + + + diff --git a/info/gcl/Additional-Constraints-on-Externalizable-Objects.html b/info/gcl/Additional-Constraints-on-Externalizable-Objects.html new file mode 100644 index 0000000..ecb426f --- /dev/null +++ b/info/gcl/Additional-Constraints-on-Externalizable-Objects.html @@ -0,0 +1,187 @@ + + + + + +Additional Constraints on Externalizable Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Literal Objects in Compiled Files  

    +
    +
    +

    3.2.4.6 Additional Constraints on Externalizable Objects

    + +

    If two literal objects appearing in the source code for a single file +processed with +the file compiler +are the identical, +the corresponding objects in the compiled code +must also be the identical. +

    +

    With the exception of symbols and packages, any two +literal objects +in code being processed by +the file compiler +may be coalesced +if and only if they are similar; +if they are either both symbols or both packages, +they may only be coalesced if and only if they are identical. +

    +

    Objects containing circular references can +be externalizable objects. +The file compiler is required to preserve eqlness of +substructures within a file. +Preserving eqlness means that subobjects that are +the same +in the source code must +be +the same +in the corresponding compiled code. +

    +

    In addition, the following are constraints on the handling of +literal objects by the file compiler: +

    +
    +
    +

    array: If an array in the source code is a +simple array, then the corresponding array +in the compiled code will also be a simple array. If +an array in the source code is displaced, has a +fill pointer, or is actually adjustable, the corresponding +array in the compiled code might lack any or all of these +qualities. If an array in the source code has a fill +pointer, then the corresponding array in the compiled +code might be only the size implied by the fill pointer. +

    +
    +
    +

    packages: The loader is required to find the +corresponding package object as if by calling +find-package with the package name as an argument. +An error of type package-error is signaled if no +package of that name exists at load time. +

    +
    +
    +

    random-state: A constant random state +object cannot be used as the state argument +to the function random because random modifies this data structure. +

    +
    +
    +

    structure, standard-object: +Objects of type structure-object and standard-object +may appear in compiled constants if there is an +appropriate make-load-form method defined for that +type. +

    +

    The file compiler calls make-load-form on any object +that is referenced as a literal object if the object is a +generalized instance of standard-object, +structure-object, condition, or any of a +(possibly empty) implementation-dependent set of other classes. +The file compiler only calls make-load-form once for +any given object within a single file. +

    +
    +
    +

    symbol: In order to guarantee that compiled files can be loaded + correctly, users must ensure that the packages referenced in those files + are defined consistently at compile time and load time. Conforming programs + must satisfy the following requirements: +

    +
    +
    1.
    +

    The current package when a top level form in the file + is processed by compile-file must be the same as the current package + when the code corresponding to that top level form in the + compiled file is executed by load. In particular: +

    +
    +
    a.
    +

    Any top level form in a file that alters + the current package must change it to a package + of the same name both at compile time and at load time. +

    +
    +
    b.
    +

    If the first non-atomic top level form in the file + is not an in-package form, then the current package + at the time load is called must be a package with the + same name as the package that was the current package + at the time compile-file was called. +

    +
    + +
    +
    2.
    +

    For all symbols + appearing lexically within a top level form that + were accessible in the package that was the current package + during processing of that top level form at compile time, but + whose home package was another package, at load time there must + be a symbol with the same name that is accessible in both the + load-time current package and in the package + with the same name as the + compile-time home package. +

    +
    +
    3.
    +

    For all symbols represented in the compiled file + that were external symbols in + their home package at compile time, there must be a symbol with the + same name that is an external symbol in the package + with the same name at load time. +

    +
    + +

    If any of these conditions do not hold, the package in which the loader looks + for the affected symbols is unspecified. Implementations are permitted + to signal an error or to define this behavior. +

    +
    +
    + +
    +
    +

    +Previous: , Up: Literal Objects in Compiled Files  

    +
    + + + + + diff --git a/info/gcl/Additional-FORMAT-Parameters.html b/info/gcl/Additional-FORMAT-Parameters.html new file mode 100644 index 0000000..c10e705 --- /dev/null +++ b/info/gcl/Additional-FORMAT-Parameters.html @@ -0,0 +1,54 @@ + + + + + +Additional FORMAT Parameters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Additional Information about FORMAT Operations  

    +
    +
    +

    22.3.10.3 Additional FORMAT Parameters

    + +

    The consequences are undefined if a format directive is given more parameters +than it is described here as accepting. +

    + + + + + diff --git a/info/gcl/Additional-Information-about-FORMAT-Operations.html b/info/gcl/Additional-Information-about-FORMAT-Operations.html new file mode 100644 index 0000000..806abad --- /dev/null +++ b/info/gcl/Additional-Information-about-FORMAT-Operations.html @@ -0,0 +1,62 @@ + + + + + +Additional Information about FORMAT Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.10 Additional Information about FORMAT Operations

    + + + + + + +
    • Nesting of FORMAT Operations   +
    • Missing and Additional FORMAT Arguments   +
    • Additional FORMAT Parameters   +
    • Undefined FORMAT Modifier Combinations   +
    + + + + + + diff --git a/info/gcl/Additional-Information-about-Parsing-Logical-Pathname-Namestrings.html b/info/gcl/Additional-Information-about-Parsing-Logical-Pathname-Namestrings.html new file mode 100644 index 0000000..a318b4d --- /dev/null +++ b/info/gcl/Additional-Information-about-Parsing-Logical-Pathname-Namestrings.html @@ -0,0 +1,51 @@ + + + + + +Additional Information about Parsing Logical Pathname Namestrings (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.1 Additional Information about Parsing Logical Pathname Namestrings

    + + + + + + diff --git a/info/gcl/Additional-Uses-for-Indirect-Definitions-in-Modified-BNF-Syntax.html b/info/gcl/Additional-Uses-for-Indirect-Definitions-in-Modified-BNF-Syntax.html new file mode 100644 index 0000000..fdfd63a --- /dev/null +++ b/info/gcl/Additional-Uses-for-Indirect-Definitions-in-Modified-BNF-Syntax.html @@ -0,0 +1,73 @@ + + + + + +Additional Uses for Indirect Definitions in Modified BNF Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.5 Additional Uses for Indirect Definitions in Modified BNF Syntax

    + +

    In some cases, an auxiliary definition in the BNF might appear to be unused +within the BNF, but might still be useful elsewhere. For example, consider the +following definitions: +

    +

    case keyform {!normal-clause}* [!otherwise-clause] ⇒ {result}* +

    +

    ccase keyplace {!normal-clause}* ⇒ {result}* +

    +

    ecase keyform {!normal-clause}* ⇒ {result}* +

    +

    normal-clause ::=(keys {form}*) +

    +

    otherwise-clause ::=({otherwise | t} {form}*) +

    +

    clause ::=normal-clause | otherwise-clause +

    +

    Here the term “clause” might appear to be “dead” in that it +is not used in the BNF. However, the purpose of the BNF is not just to guide parsing, +but also to define useful terms for reference in the descriptive text which follows. +As such, the term “clause” might appear in text that follows, +as shorthand for “normal-clause or otherwise-clause.” +

    + + + + + diff --git a/info/gcl/Agreement-on-Parameter-Specializers-and-Qualifiers.html b/info/gcl/Agreement-on-Parameter-Specializers-and-Qualifiers.html new file mode 100644 index 0000000..c0068cd --- /dev/null +++ b/info/gcl/Agreement-on-Parameter-Specializers-and-Qualifiers.html @@ -0,0 +1,78 @@ + + + + + +Agreement on Parameter Specializers and Qualifiers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    +
    +

    7.6.3 Agreement on Parameter Specializers and Qualifiers

    + +

    Two methods are said to agree with each other on parameter specializers +and qualifiers if the following conditions hold: +

    +
    +
    1.
    +

    Both methods have the same number of required parameters. +Suppose the parameter specializers of the two methods are +P_{1,1}... P_{1,n} and P_{2,1}... P_{2,n}. +

    +
    +
    2.
    +

    For each 1<= i<= n, P_{1,i} agrees with P_{2,i}. +The parameter specializer P_{1,i} agrees with P_{2,i} if +P_{1,i} and P_{2,i} are the same class or if +P_{1,i}=(eql object_1), +P_{2,i}=(eql object_2), and +(eql object_1 object_2). +Otherwise P_{1,i} and P_{2,i} do not agree. +

    +
    +
    3.
    +

    The two lists of qualifiers are the same +under equal. +

    +
    +
    + + + + + + diff --git a/info/gcl/Alphabetic-Characters.html b/info/gcl/Alphabetic-Characters.html new file mode 100644 index 0000000..d7a17dc --- /dev/null +++ b/info/gcl/Alphabetic-Characters.html @@ -0,0 +1,66 @@ + + + + + +Alphabetic Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.2 Alphabetic Characters

    + +

    The alphabetic_1 characters are +a subset of the graphic characters. +Of the standard characters, only these are the alphabetic_1 characters: +

    +

    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 +

    +

    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 +

    +

    Any implementation-defined character that has case +must be alphabetic_1. +For each implementation-defined graphic character +that has no case, +it is implementation-defined whether +that character is alphabetic_1. +

    + + + + + diff --git a/info/gcl/Alphanumeric-Characters.html b/info/gcl/Alphanumeric-Characters.html new file mode 100644 index 0000000..9f43391 --- /dev/null +++ b/info/gcl/Alphanumeric-Characters.html @@ -0,0 +1,55 @@ + + + + + +Alphanumeric Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.9 Alphanumeric Characters

    + +

    The set of alphanumeric characters is the union of + the set of alphabetic_1 characters +and the set of numeric characters. +

    + + + + + diff --git a/info/gcl/Appendix.html b/info/gcl/Appendix.html new file mode 100644 index 0000000..713d298 --- /dev/null +++ b/info/gcl/Appendix.html @@ -0,0 +1,56 @@ + + + + + +Appendix (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Top  

    +
    +
    +

    27 Appendix

    + + + +
    • Removed Language Features   +
    + + + + + + diff --git a/info/gcl/Applying-method-combination-to-the-sorted-list-of-applicable-methods.html b/info/gcl/Applying-method-combination-to-the-sorted-list-of-applicable-methods.html new file mode 100644 index 0000000..d30ad2b --- /dev/null +++ b/info/gcl/Applying-method-combination-to-the-sorted-list-of-applicable-methods.html @@ -0,0 +1,95 @@ + + + + + +Applying method combination to the sorted list of applicable methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    +
    +

    7.6.6.4 Applying method combination to the sorted list of applicable methods

    + +

    In the simple case—if standard method combination is used and all +applicable methods are primary methods—the +effective method is the most specific method. +That method can call the next most specific +method by using the function call-next-method. The method that +call-next-method will call is referred to as the +next method + +. The predicate next-method-p tests whether a next +method exists. If call-next-method is called and there is no +next most specific method, the generic function no-next-method +is invoked. +

    +

    In general, the effective method is some combination of the applicable +methods. It is described by a form that contains calls to some or +all of the applicable methods, returns the value or values that will +be returned as the value or values of the generic function, and +optionally makes some of the methods accessible by means of +call-next-method. +

    +

    The role of each method in the effective method is determined by its +qualifiers and the specificity of the method. A qualifier +serves to mark a method, and the meaning of a qualifier is +determined by the way that these marks are used by this step +of the procedure. If an applicable method has an unrecognized +qualifier, this step signals an error and does not include that method +in the effective method. +

    +

    When standard method combination is used together with qualified methods, +the effective method is produced as described in Standard Method Combination. +

    +

    Another type of method combination can be specified by using the +:method-combination option of defgeneric or +of any of the other operators that specify generic function options. In +this way this step of the procedure can be customized. +

    +

    New types of method combination can be defined by using +the define-method-combination macro. +

    +
    +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    + + + + + diff --git a/info/gcl/Argument-Conventions-of-Some-Reader-Functions.html b/info/gcl/Argument-Conventions-of-Some-Reader-Functions.html new file mode 100644 index 0000000..acc17e8 --- /dev/null +++ b/info/gcl/Argument-Conventions-of-Some-Reader-Functions.html @@ -0,0 +1,58 @@ + + + + + +Argument Conventions of Some Reader Functions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Reader Concepts  

    +
    +
    +

    23.1.3 Argument Conventions of Some Reader Functions

    + + + + +
    • The EOF-ERROR-P argument   +
    • The RECURSIVE-P argument   +
    + + + + + + diff --git a/info/gcl/Argument-Mismatch-Detection.html b/info/gcl/Argument-Mismatch-Detection.html new file mode 100644 index 0000000..7ad34c4 --- /dev/null +++ b/info/gcl/Argument-Mismatch-Detection.html @@ -0,0 +1,72 @@ + + + + + +Argument Mismatch Detection (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Error Checking in Function Calls  

    +
    +
    +

    3.5.1 Argument Mismatch Detection

    + + + + + + + + + + + +
    • Safe and Unsafe Calls   +
    • Error Detection Time in Safe Calls   +
    • Too Few Arguments   +
    • Too Many Arguments   +
    • Unrecognized Keyword Arguments   +
    • Invalid Keyword Arguments   +
    • Odd Number of Keyword Arguments   +
    • Destructuring Mismatch   +
    • Errors When Calling a Next Method   +
    + + + + + + diff --git a/info/gcl/Array-Concepts.html b/info/gcl/Array-Concepts.html new file mode 100644 index 0000000..7a3283a --- /dev/null +++ b/info/gcl/Array-Concepts.html @@ -0,0 +1,59 @@ + + + + + +Array Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays  

    +
    +
    +

    15.1 Array Concepts

    + + + + + +
    • Array Elements   +
    • Specialized Arrays   +
    + + + + + + diff --git a/info/gcl/Array-Dimensions.html b/info/gcl/Array-Dimensions.html new file mode 100644 index 0000000..6a348d8 --- /dev/null +++ b/info/gcl/Array-Dimensions.html @@ -0,0 +1,66 @@ + + + + + +Array Dimensions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.2 Array Dimensions

    + +

    An axis of an array is called a dimension + +. +

    +

    Each dimension is a non-negative +

    +

    fixnum; +

    +

    if any dimension of an array is zero, the array has no elements. +It is permissible for a dimension to be zero, +in which case the array has no elements, +and any attempt to access an element +is an error. However, other properties of the array, +such as the dimensions themselves, may be used. +

    + + + + + diff --git a/info/gcl/Array-Elements.html b/info/gcl/Array-Elements.html new file mode 100644 index 0000000..a00d8c5 --- /dev/null +++ b/info/gcl/Array-Elements.html @@ -0,0 +1,75 @@ + + + + + +Array Elements (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Concepts  

    +
    +
    +

    15.1.1 Array Elements

    + +

    An array contains a set of objects called elements +that can be referenced individually according to a rectilinear coordinate system. +

    + + + + + + + + + + +
    • Array Indices   +
    • Array Dimensions   +
    • Implementation Limits on Individual Array Dimensions   +
    • Array Rank   +
    • Vectors   +
    • Fill Pointers   +
    • Multidimensional Arrays   +
    • Storage Layout for Multidimensional Arrays   +
    • Implementation Limits on Array Rank   +
    + + + + + + diff --git a/info/gcl/Array-Indices.html b/info/gcl/Array-Indices.html new file mode 100644 index 0000000..66f7114 --- /dev/null +++ b/info/gcl/Array-Indices.html @@ -0,0 +1,59 @@ + + + + + +Array Indices (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.1 Array Indices

    + +

    An array element is referred to by a (possibly empty) series of indices. +The length of the series must equal the rank of the array. +

    +

    Each index must be a non-negative fixnum +

    +

    less than the corresponding array dimension. +Array indexing is zero-origin. +

    + + + + + diff --git a/info/gcl/Array-Rank.html b/info/gcl/Array-Rank.html new file mode 100644 index 0000000..d61ad05 --- /dev/null +++ b/info/gcl/Array-Rank.html @@ -0,0 +1,60 @@ + + + + + +Array Rank (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.4 Array Rank

    + +

    An array can have any number of dimensions (including zero). +The number of dimensions is called the rank + +. +

    +

    If the rank of an array is zero then the array is said to have +no dimensions, and the product of the dimensions (see array-total-size) +is then 1; a zero-rank array therefore has a single element. +

    + + + + + diff --git a/info/gcl/Array-Upgrading.html b/info/gcl/Array-Upgrading.html new file mode 100644 index 0000000..e93c2c1 --- /dev/null +++ b/info/gcl/Array-Upgrading.html @@ -0,0 +1,87 @@ + + + + + +Array Upgrading (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Specialized Arrays  

    +
    +
    +

    15.1.2.1 Array Upgrading

    + +

    The upgraded array element type + + of a type T_1 +is a type T_2 that is a supertype of T_1 +and that is used instead of T_1 whenever T_1 +is used as an array element type +for object creation or type discrimination. +

    +

    During creation of an array, +the element type that was requested +is called the expressed array element type + +. +The upgraded array element type of the expressed array element type +becomes the actual array element type + + of the array that is created. +

    +

    Type upgrading implies a movement upwards in the type hierarchy lattice. +A type is always a subtype of its upgraded array element type. +Also, if a type T_x is a subtype of another type T_y, +then +the upgraded array element type of T_x +must be a subtype of +the upgraded array element type of T_y. +Two disjoint types can be upgraded to the same type. +

    +

    The upgraded array element type T_2 of a type T_1 +is a function only of T_1 itself; +that is, it is independent of any other property of the array +for which T_2 will be used, +such as rank, adjustability, fill pointers, or displacement. +The function upgraded-array-element-type +can be used by conforming programs to predict how the implementation +will upgrade a given type. +

    + + + + + diff --git a/info/gcl/Arrays-Dictionary.html b/info/gcl/Arrays-Dictionary.html new file mode 100644 index 0000000..14304e6 --- /dev/null +++ b/info/gcl/Arrays-Dictionary.html @@ -0,0 +1,132 @@ + + + + + +Arrays Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Arrays  

    +
    +
    +

    15.2 Arrays Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • array   +
    • simple-array   +
    • vector (System Class)   +
    • simple-vector   +
    • bit-vector   +
    • simple-bit-vector   +
    • make-array   +
    • adjust-array   +
    • adjustable-array-p   +
    • aref   +
    • array-dimension   +
    • array-dimensions   +
    • array-element-type   +
    • array-has-fill-pointer-p   +
    • array-displacement   +
    • array-in-bounds-p   +
    • array-rank   +
    • array-row-major-index   +
    • array-total-size   +
    • arrayp   +
    • fill-pointer   +
    • row-major-aref   +
    • upgraded-array-element-type   +
    • array-dimension-limit   +
    • array-rank-limit   +
    • array-total-size-limit   +
    • simple-vector-p   +
    • svref   +
    • vector   +
    • vector-pop   +
    • vector-push   +
    • vectorp   +
    • bit (Array)   +
    • bit-and   +
    • bit-vector-p   +
    • simple-bit-vector-p   +
    + +
    +
    +

    +Previous: , Up: Arrays  

    +
    + + + + + diff --git a/info/gcl/Arrays.html b/info/gcl/Arrays.html new file mode 100644 index 0000000..0d2032d --- /dev/null +++ b/info/gcl/Arrays.html @@ -0,0 +1,58 @@ + + + + + +Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    15 Arrays

    + + + + +
    • Array Concepts   +
    • Arrays Dictionary   +
    + + + + + + diff --git a/info/gcl/Assertions.html b/info/gcl/Assertions.html new file mode 100644 index 0000000..1fe5d6a --- /dev/null +++ b/info/gcl/Assertions.html @@ -0,0 +1,64 @@ + + + + + +Assertions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Condition System Concepts  

    +
    +
    +

    9.1.5 Assertions

    + +

    Conditional signaling of conditions +based on such things as key match, form evaluation, +and type are handled by assertion operators. +Figure 9–7 shows operators relating to assertions. +

    +
    +
      assert  check-type  ecase      
+  ccase   ctypecase   etypecase  
+
+  Figure 9–7: Operators relating to assertions.
+
+
    + + + + + + diff --git a/info/gcl/Associating-a-Restart-with-a-Condition.html b/info/gcl/Associating-a-Restart-with-a-Condition.html new file mode 100644 index 0000000..be869d6 --- /dev/null +++ b/info/gcl/Associating-a-Restart-with-a-Condition.html @@ -0,0 +1,67 @@ + + + + + +Associating a Restart with a Condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Signaling and Handling Conditions  

    +
    +
    +

    9.1.4.7 Associating a Restart with a Condition

    + +

    A restart can be “associated with” a condition explicitly +by with-condition-restarts, or implicitly by restart-case. +Such an assocation has dynamic extent. +

    +

    A single restart may be associated with several conditions +at the same time. +A single condition may have several associated restarts +at the same time. +

    +

    Active restarts associated with a particular condition can be detected +by calling a function such as find-restart, supplying +that condition as the condition argument. +Active restarts can also be detected without regard to any associated +condition by calling such a function without a condition argument, +or by supplying a value of nil for such an argument. +

    + + + + + diff --git a/info/gcl/Associativity-and-Commutativity-in-Numeric-Operations.html b/info/gcl/Associativity-and-Commutativity-in-Numeric-Operations.html new file mode 100644 index 0000000..5362964 --- /dev/null +++ b/info/gcl/Associativity-and-Commutativity-in-Numeric-Operations.html @@ -0,0 +1,64 @@ + + + + + +Associativity and Commutativity in Numeric Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numeric Operations  

    +
    +
    +

    12.1.1.1 Associativity and Commutativity in Numeric Operations

    + +

    For functions that are mathematically associative (and possibly commutative), +a conforming implementation may process the arguments in any manner +consistent with associative (and possibly commutative) rearrangement. This does not +affect the order in which the argument forms are evaluated; +for a discussion of evaluation order, see Function Forms. +What is unspecified is only the order in which the parameter values +are processed. This implies that implementations may differ in which +automatic coercions are applied; see Contagion in Numeric Operations. +

    +

    A conforming program can control the order of processing explicitly by +separating the operations into separate (possibly nested) function forms, +or by writing explicit calls to functions that perform coercions. +

    + + + + + diff --git a/info/gcl/Backquote.html b/info/gcl/Backquote.html new file mode 100644 index 0000000..7c0f8ac --- /dev/null +++ b/info/gcl/Backquote.html @@ -0,0 +1,207 @@ + + + + + +Backquote (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.6 Backquote

    + +

    The backquote introduces a template of a data structure to be built. +For example, writing +

    +
    +
     `(cond ((numberp ,x) ,@y) (t (print ,x) ,@y))
+
    + +

    is roughly equivalent to writing +

    +
    +
     (list 'cond 
+       (cons (list 'numberp x) y) 
+       (list* 't (list 'print x) y))
+
    + +

    Where a comma +occurs in the template, +the expression +following the comma is to be evaluated to produce an object to +be inserted at that point. Assume b has the value 3, for example, then +evaluating the form denoted by `(a b ,b ,(+ b 1) b) produces +the result (a b 3 4 b). +

    +

    If a comma is immediately followed by an at-sign, +then the form following the at-sign +is evaluated to produce a list of objects. +These objects are then “spliced” into place in the template. For +example, if x has the value (a b c), then +

    +
    +
     `(x ,x ,@x foo ,(cadr x) bar ,(cdr x) baz ,@(cdr x))
+⇒  (x (a b c) a b c foo b bar (b c) baz b c)
+
    + +

    The backquote syntax can be summarized formally as follows. +

    +
    +
    *
    +

    `basic is the same as 'basic, +that is, (quote basic), for any expression +basic that is not a list or a general vector. +

    +
    +
    *
    +

    `,form is the same as form, for any form, provided +that the representation of form does not begin with at-sign +or dot. (A similar caveat holds for all occurrences of a form after a comma.) +

    +
    +
    *
    +

    `,@form has undefined consequences. +

    +
    +
    *
    +

    `(x1 x2 x3 ... xn . atom) +may be interpreted to mean +

    +
    +
     (append [ x1 ] [ x2 ] [ x3 ] ... [ xn ] (quote atom))
+
    + +

    where the brackets are used to indicate +a transformation of an xj as follows: +

    +
    +
    –
    +

    [form] is interpreted as (list `form), +which contains a backquoted form that must then be further interpreted. +

    +
    +
    –
    +

    [,form] is interpreted as (list form). +

    +
    +
    –
    +

    [,@form] is interpreted as form. +

    +
    + +
    +
    *
    +

    `(x1 x2 x3 ... xn) may be interpreted to mean +the same as the backquoted form +`(x1 x2 x3 ... xn . nil), +thereby reducing it to the previous case. +

    +
    +
    *
    +

    `(x1 x2 x3 ... xn . ,form) may be interpreted to mean +

    +
    +
     (append [ x1 ] [ x2 ] [ x3 ] ... [ xn ] form)
+
    + +

    where the brackets indicate a transformation of an xj as described above. +

    +
    +
    *
    +

    `(x1 x2 x3 ... xn . ,@form) has undefined consequences. +

    +
    +
    *
    +

    `#(x1 x2 x3 ... xn) may be interpreted to mean +(apply #'vector `(x1 x2 x3 ... xn)). +

    +
    + +

    Anywhere “,@” may be used, the syntax “,.” may be used instead +to indicate that it is permissible to operate destructively on +the list structure produced by the form following the “,.” +(in effect, to use nconc instead of append). +

    +

    If the backquote syntax is nested, the innermost backquoted form +should be expanded first. This means that if several commas occur +in a row, the leftmost one belongs to the innermost backquote. +

    +

    An implementation is free to interpret a backquoted form F_1 +as any form F_2 that, when evaluated, will produce a result that is +the same under equal as the result implied by the above definition, +provided that the side-effect behavior of the substitute form F_2 +is also consistent with the description given above. +The constructed +copy of the template might or might not share list structure with the +template itself. As an example, the above definition implies that +

    +
    +
     `((,a b) ,c ,@d)
+
    + +

    will be interpreted as if it were +

    +
    +
     (append (list (append (list a) (list 'b) 'nil)) (list c) d 'nil)
+
    + +

    but it could also be legitimately interpreted to mean any of the following: +

    +
    +
     (append (list (append (list a) (list 'b))) (list c) d)
+ (append (list (append (list a) '(b))) (list c) d)
+ (list* (cons a '(b)) c d)
+ (list* (cons a (list 'b)) c d)
+ (append (list (cons a '(b))) (list c) d)
+ (list* (cons a '(b)) c (copy-list d))
+
    + + + +
    • Notes about Backquote   +
    + +
    +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    + + + + + diff --git a/info/gcl/Boa-Lambda-Lists.html b/info/gcl/Boa-Lambda-Lists.html new file mode 100644 index 0000000..2d93ba2 --- /dev/null +++ b/info/gcl/Boa-Lambda-Lists.html @@ -0,0 +1,163 @@ + + + + + +Boa Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.6 Boa Lambda Lists

    + +

    A boa lambda list + + is a lambda list that is syntactically +like an ordinary lambda list, but that is processed in +“by order of argument” style. +

    +

    A boa lambda list is used only in a defstruct form, +when explicitly specifying the lambda list +of a constructor function (sometimes called a “boa constructor”). +

    +

    The &optional, &rest, &aux, +

    +

    &key, and &allow-other-keys +

    +

    lambda list keywords are recognized in a boa lambda list. +The way these lambda list keywords differ from their +use in an ordinary lambda list follows. +

    +

    Consider this example, which describes how destruct processes +its :constructor option. +

    +
    +
     (:constructor create-foo
+         (a &optional b (c 'sea) &rest d &aux e (f 'eff)))
+
    + +

    This defines create-foo to be a constructor of one or more arguments. +The first argument is used to initialize the a slot. The second +argument is used to initialize the b slot. If there isn’t any +second argument, then the default value given in the body of the +defstruct (if given) is used instead. +The third argument is used to +initialize the c slot. If there isn’t any third argument, then the +symbol sea is used instead. Any arguments following the third +argument are collected into a list +and used to initialize the d +slot. If there are three or fewer arguments, then nil is placed in +the d slot. The e slot is not initialized; +its initial value is implementation-defined. +Finally, the f slot is initialized to contain the symbol eff. +

    +

    &key and &allow-other-keys arguments default +in a manner similar to that of &optional arguments: if no default +is supplied in the lambda list then the default value +given in the body of the defstruct (if given) is used instead. +For example: +

    +
    +
     (defstruct (foo (:constructor CREATE-FOO (a &optional b (c 'sea)
+                                             &key (d 2)
+                                             &aux e (f 'eff))))
+   (a 1) (b 2) (c 3) (d 4) (e 5) (f 6))
+
+ (create-foo 10) ⇒  #S(FOO A 10 B 2 C SEA D 2 E implemention-dependent F EFF)
+ (create-foo 10 'bee 'see :d 'dee) 
+⇒  #S(FOO A 10 B BEE C SEE D DEE E implemention-dependent F EFF)
+
    + +

    If keyword arguments of the form +((key var) [default [svar]]) +are specified, the slot name is matched with var +(not key). +

    +

    The actions taken in the b and e cases were carefully +chosen to allow the user to specify all possible behaviors. +The &aux variables can be used to completely override the default +initializations given in the body. +

    +

    If no default value is supplied for an aux variable variable, +the consequences are undefined if an attempt is later made to read +the corresponding slot’s value before a value is explicitly assigned. +If such a slot has a :type option specified, +this suppressed initialization does not imply a type mismatch situation; +the declared type is only required to apply when the slot is finally assigned. +

    +

    With this definition, the following can be written: +

    +
    +
     (create-foo 1 2)
+
    + +

    instead of +

    +
    +
     (make-foo :a 1 :b 2)
+
    + +

    and create-foo provides defaulting different +from that of make-foo. +

    +

    Additional arguments that do not correspond to slot names but +are merely present to supply values used in subsequent initialization +computations are allowed. +For example, in the definition +

    +
    +
     (defstruct (frob (:constructor create-frob
+                  (a &key (b 3 have-b) (c-token 'c) 
+                          (c (list c-token (if have-b 7 2))))))
+         a b c)
+
    + +

    the c-token argument is used merely to supply a value used in the +initialization of the c slot. The supplied-p parameters +associated with optional parameters and keyword parameters +might also be used this way. +

    +
    +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    + + + + + diff --git a/info/gcl/Built_002din-Method-Combination-Types.html b/info/gcl/Built_002din-Method-Combination-Types.html new file mode 100644 index 0000000..2057e9b --- /dev/null +++ b/info/gcl/Built_002din-Method-Combination-Types.html @@ -0,0 +1,190 @@ + + + + + +Built-in Method Combination Types (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Method Selection and Combination  

    +
    +
    +

    7.6.6.7 Built-in Method Combination Types

    + +

    The object system provides a set of built-in method combination types. To +specify that a generic function is to use one of these method +combination types, the name of the method combination type is given as +the argument to the :method-combination option to +defgeneric or to the :method-combination option to any of the +other operators that specify generic function options. +

    +

    The names of the built-in method combination types are listed in Figure 7–3. +

    + + + + + + + + + + + + + + + + + + + + +
    +
      +    append  max  nconc  progn     
+  and  list    min  or     standard  
+
+  Figure 7–3: Built-in Method Combination Types
+
+
    + +

    The semantics of the standard built-in method combination type is +described in Standard Method Combination. The other +built-in method combination types are called simple built-in method +combination types. +

    +

    The simple built-in method combination types act as though they were +defined by the short form of define-method-combination. +They recognize two roles for methods: +

    +
    +
    *
    +

    An around method has the keyword symbol +:around as its sole qualifier. The meaning of +:around methods is the same as in standard method combination. +Use of the functions call-next-method and next-method-p +is supported in around methods. +

    +
    +
    *
    +

    A primary method has the name of the method combination +type as its sole qualifier. For example, the built-in method +combination type and recognizes methods whose sole qualifier is +and; these are primary methods. Use of the functions +call-next-method and next-method-p is not supported +in primary methods. +

    +
    +
    + +

    The semantics of the simple built-in method combination types is as +follows: +

    +
    +
    *
    +

    If there are any around methods, the most specific around method +is called. It supplies the value or values of the generic function. +

    +
    +
    *
    +

    Inside the body of an around method, the function +call-next-method can be used to call the next method. +The generic function no-next-method is invoked if +call-next-method is used and there is no applicable method to call. +The function next-method-p may be used to determine whether a +next method exists. When the next method returns, +the around method can execute more code, +perhaps based on the returned value or values. +

    +
    +
    *
    +

    If an around method invokes call-next-method, +the next most specific around method is +called, if one is applicable. If there are no around methods +or if call-next-method is called by the least specific +around method, a Lisp form derived from the name of the built-in +method combination type and from the list of applicable primary +methods is evaluated to produce the value of the generic function. +Suppose the name of the method combination type is operator +and the call to the generic function is of the form +

    +
    (generic-function a_1... a_n) +
    +
    +
    +

    Let M_1,...,M_k be the applicable primary methods +in order; then the derived Lisp form is +

    +
    (operator < M_1 +

    a_1... a_n>...< +M_k a_1... a_n>) +

    +
    +
    +

    If the expression < M_i a_1... a_n> is +evaluated, the method M_i will be applied to the arguments +a_1... a_n. +For example, +if operator is or, +the expression < M_i a_1... a_n> is +evaluated only if < M_j a_1... a_n>, +1<= j<i, returned nil. +

    +
    +
    +

    The default order for the primary methods is +:most-specific-first. However, the order can be reversed by supplying +:most-specific-last as the second argument to the :method-combination option. +

    +
    + +

    The simple built-in method combination types require exactly one +qualifier per method. An error is signaled if there are applicable +methods with no qualifiers or with qualifiers that are not supported +by the method combination type. An error is signaled if there are +applicable around methods and no applicable primary +methods. +

    +
    +
    +

    +Previous: , Up: Method Selection and Combination  

    +
    + + + + + diff --git a/info/gcl/Byte-Operations-on-Integers.html b/info/gcl/Byte-Operations-on-Integers.html new file mode 100644 index 0000000..2410207 --- /dev/null +++ b/info/gcl/Byte-Operations-on-Integers.html @@ -0,0 +1,71 @@ + + + + + +Byte Operations on Integers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Numeric Operations  

    +
    +
    +

    12.1.1.6 Byte Operations on Integers

    + +

    The byte-manipulation functions use objects +called byte specifiers to designate the size and position +of a specific byte within an integer. +The representation of a byte specifier is implementation-dependent; +it might or might not be a number. +The function byte will construct a byte specifier, +which various other byte-manipulation functions will accept. +

    +

    Figure 12–6 shows defined names relating to +manipulating bytes of numbers. +

    +
    +
      byte           deposit-field  ldb-test    
+  byte-position  dpb            mask-field  
+  byte-size      ldb                        
+
+  Figure 12–6: Defined names relating to byte manipulation.
+
+
    + + + + + + diff --git a/info/gcl/Capitalization-and-Punctuation-in-Condition-Reports.html b/info/gcl/Capitalization-and-Punctuation-in-Condition-Reports.html new file mode 100644 index 0000000..f5b7933 --- /dev/null +++ b/info/gcl/Capitalization-and-Punctuation-in-Condition-Reports.html @@ -0,0 +1,63 @@ + + + + + +Capitalization and Punctuation in Condition Reports (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printing Conditions  

    +
    +
    +

    9.1.3.2 Capitalization and Punctuation in Condition Reports

    + +

    It is recommended that a report message be a complete sentences, in the +proper case and correctly punctuated. In English, for example, this +means the first letter should be uppercase, and there should be a +trailing period. +

    +
    +
     (error "This is a message")  ; Not recommended
+ (error "this is a message.") ; Not recommended
+
+ (error "This is a message.") ; Recommended instead
+
    + + + + + + diff --git a/info/gcl/Case-in-Pathname-Components.html b/info/gcl/Case-in-Pathname-Components.html new file mode 100644 index 0000000..7bf6cea --- /dev/null +++ b/info/gcl/Case-in-Pathname-Components.html @@ -0,0 +1,67 @@ + + + + + +Case in Pathname Components (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.3 Case in Pathname Components

    + +

    Namestrings always use local file system case conventions, +but Common Lisp functions that manipulate pathname components +allow the caller to select either of two conventions for representing +case in component values by supplying a value for the +:case keyword argument. +Figure 19–2 lists the functions +relating to pathnames that permit a :case argument: +

    +
    +
      make-pathname    pathname-directory  pathname-name  
+  pathname-device  pathname-host       pathname-type  
+
+  Figure 19–2: Pathname functions using a :CASE argument
+
+
    + + + + + + diff --git a/info/gcl/Case-in-Symbols.html b/info/gcl/Case-in-Symbols.html new file mode 100644 index 0000000..b5c1c3e --- /dev/null +++ b/info/gcl/Case-in-Symbols.html @@ -0,0 +1,74 @@ + + + + + +Case in Symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.8 Case in Symbols

    + + + +

    While case is significant in the process of interning a symbol, +the Lisp reader, by default, attempts to canonicalize the case of a +symbol prior to interning; see Effect of Readtable Case on the Lisp Reader. +As such, case in symbols is not, by default, significant. +Throughout this document, except as explicitly noted otherwise, +the case in which a symbol appears is not significant; +that is, HELLO, Hello, hElLo, and hello are +all equivalent ways to denote a symbol whose name is "HELLO". +

    +

    The characters backslash and vertical-bar are used to explicitly +quote the case and other parsing-related +aspects +of characters. As such, +the notations |hello| and \h\e\l\l\o are equivalent ways +to refer to a symbol whose name is "hello", and which is distinct from +any symbol whose name is "HELLO". +

    +

    The symbols that correspond to Common Lisp defined names +have uppercase names even though their names generally appear +in lowercase in this document. +

    + + + + + diff --git a/info/gcl/Case-of-Implementation_002dDefined-Characters.html b/info/gcl/Case-of-Implementation_002dDefined-Characters.html new file mode 100644 index 0000000..70416bb --- /dev/null +++ b/info/gcl/Case-of-Implementation_002dDefined-Characters.html @@ -0,0 +1,56 @@ + + + + + +Case of Implementation-Defined Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.7 Case of Implementation-Defined Characters

    + +

    An implementation may define that other implementation-defined +graphic characters have case. Such definitions must always +be done in pairs—one uppercase character in one-to-one +correspondence with one lowercase character. +

    + + + + + diff --git a/info/gcl/Changing-the-Class-of-an-Instance.html b/info/gcl/Changing-the-Class-of-an-Instance.html new file mode 100644 index 0000000..d09f1a8 --- /dev/null +++ b/info/gcl/Changing-the-Class-of-an-Instance.html @@ -0,0 +1,80 @@ + + + + + +Changing the Class of an Instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects  

    +
    +
    +

    7.2 Changing the Class of an Instance

    + + +

    The function change-class can be used to change the class +of an instance from its current class, C_{from}, +to a different class, C_{to}; it changes the +structure of the instance to conform to the definition of the class +C_{to}. +

    +

    Note that changing the class of an instance may cause +slots to be added or deleted. Changing the class of an +instance does not change its identity as defined by the +eq function. +

    +

    When change-class is invoked on an instance, a two-step +updating process takes place. The first step modifies the structure of +the instance by adding new local slots and discarding +local slots that are not specified in the new version of the instance. +The second step initializes the newly added local slots and performs +any other user-defined actions. These two steps are further described in the +two following sections. +

    + + + + +
    • Modifying the Structure of the Instance   +
    • Initializing Newly Added Local Slots (Changing the Class of an Instance)   +
    • Customizing the Change of Class of an Instance   +
    + + + + + + diff --git a/info/gcl/Character-Attributes.html b/info/gcl/Character-Attributes.html new file mode 100644 index 0000000..4a97a15 --- /dev/null +++ b/info/gcl/Character-Attributes.html @@ -0,0 +1,72 @@ + + + + + +Character Attributes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.3 Character Attributes

    + +

    Characters have only one standardized attribute: +a code. A character’s code is a non-negative integer. +This code is composed from a character script and a character label +in an implementation-dependent way. See the functions char-code and code-char. +

    +

    Additional, implementation-defined attributes of characters +are also permitted +so that, for example, +two characters with the same code may differ +in some other, implementation-defined way. +

    +

    For any implementation-defined attribute +there is a distinguished value +called the null + + value for that attribute. +A character for which each implementation-defined attribute +has the null value for that attribute is called a simple character. +If the implementation has no implementation-defined attributes, +then all characters are simple characters. +

    + + + + + diff --git a/info/gcl/Character-Categories.html b/info/gcl/Character-Categories.html new file mode 100644 index 0000000..98a2ab7 --- /dev/null +++ b/info/gcl/Character-Categories.html @@ -0,0 +1,93 @@ + + + + + +Character Categories (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.4 Character Categories

    + +

    There are several (overlapping) categories of characters that have no formally +associated type but that are nevertheless useful to name. +They include + graphic characters, + alphabetic_1 characters, + characters with case + (uppercase and lowercase characters), + numeric characters, + alphanumeric characters, + and digits (in a given radix). +

    +

    For each implementation-defined attribute of a character, +the documentation for that implementation must specify whether +characters that differ only in that attribute are permitted to differ +in whether are not they are members of one of the aforementioned categories. +

    +

    Note that these terms are defined independently of any special syntax +which might have been enabled in the current readtable. +

    + + + + + + + + + + + +
    • Graphic Characters   +
    • Alphabetic Characters   +
    • Characters With Case   +
    • Uppercase Characters   +
    • Lowercase Characters   +
    • Corresponding Characters in the Other Case   +
    • Case of Implementation-Defined Characters   +
    • Numeric Characters   +
    • Alphanumeric Characters   +
    • Digits in a Radix   +
    + + + + + + diff --git a/info/gcl/Character-Concepts.html b/info/gcl/Character-Concepts.html new file mode 100644 index 0000000..64da187 --- /dev/null +++ b/info/gcl/Character-Concepts.html @@ -0,0 +1,75 @@ + + + + + +Character Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters  

    +
    +
    +

    13.1 Character Concepts

    + + + + + + + + + + + + + +
    • Introduction to Characters   +
    • Introduction to Scripts and Repertoires   +
    • Character Attributes   +
    • Character Categories   +
    • Identity of Characters   +
    • Ordering of Characters   +
    • Character Names   +
    • Treatment of Newline during Input and Output   +
    • Character Encodings   +
    • Documentation of Implementation-Defined Scripts   +
    + + + + + + diff --git a/info/gcl/Character-Encodings.html b/info/gcl/Character-Encodings.html new file mode 100644 index 0000000..eb2f112 --- /dev/null +++ b/info/gcl/Character-Encodings.html @@ -0,0 +1,63 @@ + + + + + +Character Encodings (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.9 Character Encodings

    + +

    A character is sometimes represented merely by its code, and sometimes +by another integer value which is composed from the code and all +implementation-defined attributes +(in an implementation-defined way +that might vary between Lisp images even in the same implementation). +This integer, returned by the function char-int, is called the +character’s “encoding.” +There is no corresponding function +from a character’s encoding back to the character, +since its primary intended uses include things like hashing where an inverse operation +is not really called for. +

    + + + + + diff --git a/info/gcl/Character-Names.html b/info/gcl/Character-Names.html new file mode 100644 index 0000000..4d17e81 --- /dev/null +++ b/info/gcl/Character-Names.html @@ -0,0 +1,104 @@ + + + + + +Character Names (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.7 Character Names

    + +

    The following character names must be present in all +conforming implementations: +

    +
    +
    Newline
    +

    The character that represents the division between lines. +An implementation must translate between #\Newline, +a single-character representation, and whatever external representation(s) +may be used. +

    +
    +
    Space
    +

    The space or blank character. +

    +
    + +

    The following names are semi-standard; +if an implementation supports them, +they should be used for the described characters and no others. +

    +
    +
    Rubout
    +

    The rubout or delete character. +

    +
    +
    Page
    +

    The form-feed or page-separator character. +

    +
    +
    Tab
    +

    The tabulate character. +

    +
    +
    Backspace
    +

    The backspace character. +

    +
    +
    Return
    +

    The carriage return character. +

    +
    +
    Linefeed
    +

    The line-feed character. +

    +
    + +

    In some implementations, +one or more of these character names +might denote a standard character; +for example, +#\Linefeed and #\Newline might be the same character +in some implementations. +

    + + + + + diff --git a/info/gcl/Character-Repertoires.html b/info/gcl/Character-Repertoires.html new file mode 100644 index 0000000..396d949 --- /dev/null +++ b/info/gcl/Character-Repertoires.html @@ -0,0 +1,75 @@ + + + + + +Character Repertoires (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Introduction to Scripts and Repertoires  

    +
    +
    +

    13.1.2.2 Character Repertoires

    + +

    A repertoire + + is a type specifier for a subtype of type character. +

    +

    This term is generally used when describing a collection of characters +independent of their coding. +Characters in repertoires are only identified + by name, + by glyph, or + by character description. +

    +

    A repertoire can contain characters from several +scripts, and a character can appear in more than +one repertoire. +

    +

    For some examples of repertoires, see the coded character standards +ISO 8859/1, ISO 8859/2, and ISO 6937/2. +Note, however, that although +the term “repertoire” is chosen for +definitional +compatibility with ISO terminology, no conforming implementation +is required to use repertoires standardized by ISO or any other +standards organization. +

    + + + + + diff --git a/info/gcl/Character-Scripts.html b/info/gcl/Character-Scripts.html new file mode 100644 index 0000000..d2568dd --- /dev/null +++ b/info/gcl/Character-Scripts.html @@ -0,0 +1,70 @@ + + + + + +Character Scripts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Scripts and Repertoires  

    +
    +
    +

    13.1.2.1 Character Scripts

    + +

    A script is one of possibly several sets that form an exhaustive partition +of the type character. +

    +

    The number of such sets and boundaries between them is implementation-defined. +Common Lisp does not require these sets to be types, but an implementation +is permitted to define such types as an extension. Since no character +from one script can ever be a member of another script, it is generally +more useful to speak about character repertoires. +

    +

    Although +the term “script” is chosen for +definitional +compatibility with ISO terminology, no conforming implementation +is required to use any particular scripts standardized by ISO +or by any other standards organization. +

    +

    Whether and how the script or scripts used by any given +implementation are named is implementation-dependent. +

    + + + + + diff --git a/info/gcl/Character-Syntax-Types.html b/info/gcl/Character-Syntax-Types.html new file mode 100644 index 0000000..3d7cce6 --- /dev/null +++ b/info/gcl/Character-Syntax-Types.html @@ -0,0 +1,161 @@ + + + + + +Character Syntax Types (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Character Syntax  

    +
    +
    +

    2.1.4 Character Syntax Types

    + +

    The Lisp reader constructs an object +from the input text by interpreting each character +according to its syntax type. +The Lisp reader cannot accept as input +everything that the Lisp printer produces, +and the Lisp reader has features that are not used by the Lisp printer. +The Lisp reader can be used as a lexical analyzer +for a more general user-written parser. +

    +

    When the Lisp reader is invoked, it reads a single character from +the input stream and dispatches according to the +syntax type + + of that character. +Every character that can appear in the input stream +is of one of the syntax types shown in Figure~2–6. +

    +
    +
      constituent  macro character  single escape  
+  invalid      multiple escape  whitespace_2   
+
+  Figure 2–6: Possible Character Syntax Types 
+
+
    + +

    The syntax type of a character in a readtable +determines how that character is interpreted by the Lisp reader +while that readtable is the current readtable. +At any given time, every character has exactly one syntax type. +

    +

    Figure~2–7 +lists the syntax type of each character in standard syntax. +

    + + +
    +
      character  syntax type                 character  syntax type             
+  Backspace  constituent                 0–9       constituent             
+  Tab        whitespace_2                :          constituent             
+  Newline    whitespace_2                ;          terminating macro char  
+  Linefeed   whitespace_2                <          constituent             
+  Page       whitespace_2                =          constituent             
+  Return     whitespace_2                >          constituent             
+  Space      whitespace_2                ?          constituent*            
+  !          constituent*                @          constituent             
+  "          terminating macro char      A–Z       constituent             
+  #          non-terminating macro char  [          constituent*            
+  $         constituent                 \          single escape           
+  %          constituent                 ]          constituent*            
+  &          constituent                 ^          constituent             
+  ’          terminating macro char      _          constituent             
+  (          terminating macro char      ‘          terminating macro char  
+  )          terminating macro char      a–z       constituent             
+  *          constituent                 {          constituent*            
+  +          constituent                 |          multiple escape         
+  ,          terminating macro char      }          constituent*            
+  -          constituent                 ~          constituent             
+  .          constituent                 Rubout     constituent             
+  /          constituent                 
+
+            Figure 2–7: Character Syntax Types in Standard Syntax          
+
+
    + + +

    The characters marked with an asterisk (*) are initially constituents, +but they are not used in any standard Common Lisp notations. +These characters are explicitly reserved to the programmer. +~ is not used in Common Lisp, and reserved to implementors. +$ and % are alphabetic_2 characters, +but are not used in the names of any standard Common Lisp defined names. +

    +

    Whitespace_2 characters serve as separators but are otherwise +ignored. Constituent and escape characters are accumulated +to make a token, which is then interpreted as a number or symbol. +Macro characters trigger the invocation of functions (possibly +user-supplied) that can perform arbitrary parsing actions. +Macro characters are divided into two kinds, +terminating and non-terminating, +depending on whether or not they terminate a token. +The following are descriptions of each kind of syntax type. +

    + + + + + + + + + + + +
    • Constituent Characters   +
    • Constituent Traits   +
    • Invalid Characters   +
    • Macro Characters   +
    • Multiple Escape Characters   +
    • Examples of Multiple Escape Characters   +
    • Single Escape Character   +
    • Examples of Single Escape Characters   +
    • Whitespace Characters   +
    • Examples of Whitespace Characters   +
    + +
    +
    +

    +Previous: , Up: Character Syntax  

    +
    + + + + + diff --git a/info/gcl/Character-Syntax.html b/info/gcl/Character-Syntax.html new file mode 100644 index 0000000..3c3cacb --- /dev/null +++ b/info/gcl/Character-Syntax.html @@ -0,0 +1,76 @@ + + + + + +Character Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax  

    +
    +
    +

    2.1 Character Syntax

    + + +

    The Lisp reader takes characters from a stream, +interprets them as a printed representation of an object, +constructs that object, and returns it. +

    +

    The syntax described by this chapter is called the standard syntax + +. +Operations are provided by Common Lisp so that +various aspects of the syntax information represented by a readtable +can be modified under program control; see Reader. +Except as explicitly stated otherwise, +the syntax used throughout this document is standard syntax. +

    + + + + + +
    • Readtables   +
    • Variables that affect the Lisp Reader   +
    • Standard Characters   +
    • Character Syntax Types   +
    + + + + + + diff --git a/info/gcl/Characters-Dictionary.html b/info/gcl/Characters-Dictionary.html new file mode 100644 index 0000000..536917e --- /dev/null +++ b/info/gcl/Characters-Dictionary.html @@ -0,0 +1,97 @@ + + + + + +Characters Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Characters  

    +
    +
    +

    13.2 Characters Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + +
    • character (System Class)   +
    • base-char   +
    • standard-char   +
    • extended-char   +
    • char=   +
    • character   +
    • characterp   +
    • alpha-char-p   +
    • alphanumericp   +
    • digit-char   +
    • digit-char-p   +
    • graphic-char-p   +
    • standard-char-p   +
    • char-upcase   +
    • upper-case-p   +
    • char-code   +
    • char-int   +
    • code-char   +
    • char-code-limit   +
    • char-name   +
    • name-char   +
    + + + + + + diff --git a/info/gcl/Characters-With-Case.html b/info/gcl/Characters-With-Case.html new file mode 100644 index 0000000..48dbbc0 --- /dev/null +++ b/info/gcl/Characters-With-Case.html @@ -0,0 +1,58 @@ + + + + + +Characters With Case (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.3 Characters With Case

    + +

    The characters with case are +a subset of the alphabetic_1 characters. +A character with case has the property of being either +uppercase or lowercase. +Every character with case is in one-to-one correspondence +with some other character with the opposite case. +

    + + + + + diff --git a/info/gcl/Characters.html b/info/gcl/Characters.html new file mode 100644 index 0000000..df4290e --- /dev/null +++ b/info/gcl/Characters.html @@ -0,0 +1,58 @@ + + + + + +Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    13 Characters

    + + + + +
    • Character Concepts   +
    • Characters Dictionary   +
    + + + + + + diff --git a/info/gcl/Classes.html b/info/gcl/Classes.html new file mode 100644 index 0000000..771456f --- /dev/null +++ b/info/gcl/Classes.html @@ -0,0 +1,84 @@ + + + + + +Classes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes  

    +
    +
    +

    4.3 Classes

    + + +

    While the object system is general enough to describe all standardized classes +(including, for example, number, hash-table, and +symbol), Figure 4–7 contains a list of classes that are +especially relevant to understanding the object system. +

    +
    +
      built-in-class    method-combination         standard-object   
+  class             standard-class             structure-class   
+  generic-function  standard-generic-function  structure-object  
+  method            standard-method                              
+
+                Figure 4–7: Object System Classes               
+
+
    + + + + + + + + + +
    • Introduction to Classes   +
    • Defining Classes   +
    • Creating Instances of Classes   +
    • Inheritance   +
    • Determining the Class Precedence List   +
    • Redefining Classes   +
    • Integrating Types and Classes   +
    + + + + + + diff --git a/info/gcl/Closures-and-Lexical-Binding.html b/info/gcl/Closures-and-Lexical-Binding.html new file mode 100644 index 0000000..4898cbd --- /dev/null +++ b/info/gcl/Closures-and-Lexical-Binding.html @@ -0,0 +1,171 @@ + + + + + +Closures and Lexical Binding (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    +
    +

    3.1.4 Closures and Lexical Binding

    + +

    A lexical closure is a function that can refer to and alter +the values of lexical bindings established by binding forms +that textually include the function definition. +

    +

    Consider this code, where x is not declared special: +

    +
    +
     (defun two-funs (x)
+   (list (function (lambda () x))
+         (function (lambda (y) (setq x y)))))
+ (setq funs (two-funs 6))
+ (funcall (car funs)) ⇒  6
+ (funcall (cadr funs) 43) ⇒  43
+ (funcall (car funs)) ⇒  43
+
    + +

    The function special form coerces a +lambda expression into a closure in which the +lexical environment in effect when the special form is +evaluated is captured along with the lambda expression. +

    +

    The function two-funs returns a list of two +functions, each of which refers to the binding of the +variable x created on entry to the function two-funs when it +was called. +This variable has the value 6 +initially, but setq can alter this binding. +The lexical closure created for the first +lambda expression does not “snapshot” the value 6 for x +when the closure is created; rather it captures the binding of x. +The second function can be used to alter the value in the same (captured) +binding (to 43, in the example), and +this altered variable binding then affects the value returned by the first function. +

    +

    In situations where a closure of a +lambda expression over the same set of bindings may be +produced more than once, the various resulting closures may +or may not be identical, at the discretion of the implementation. +That is, two functions that are behaviorally +indistinguishable might or might not be identical. +Two functions that are behaviorally distinguishable are distinct. +For example: +

    +
    +
     (let ((x 5) (funs '()))
+   (dotimes (j 10)                          
+     (push #'(lambda (z)                        
+               (if (null z) (setq x 0) (+ x z)))
+           funs))
+   funs)
+
    + +

    The result of the above form is a list of ten closures. +Each requires only the binding of x. +It is the same binding in each case, +but the ten closure objects might or might not be identical. +On the other hand, the result of the form +

    +
    +
     (let ((funs '()))     
+   (dotimes (j 10)
+     (let ((x 5))
+       (push (function (lambda (z)
+                        (if (null z) (setq x 0) (+ x z))))
+             funs)))
+  funs)
+
    + +

    is also a list of ten closures. +However, in this case no two of the closure objects can +be identical because each closure is closed over a distinct +binding of x, and these bindings can be behaviorally +distinguished because of the use of setq. +

    +

    The result of the form +

    +
    +
     (let ((funs '()))
+   (dotimes (j 10)
+     (let ((x 5))
+       (push (function (lambda (z) (+ x z)))
+            funs)))
+   funs)
+
    + +

    is a list of ten closure objects that +might or might not be identical. +A different binding of x is involved for +each closure, but the bindings cannot be distinguished +because their values are the same and immutable (there being no occurrence +of setq on x). A compiler could internally +transform the form to +

    +
    +
     (let ((funs '()))
+   (dotimes (j 10)
+     (push (function (lambda (z) (+ 5 z)))
+           funs))
+  funs)
+
    + +

    where the closures may be identical. +

    +

    It is possible that a closure does not +close over any variable bindings. +In the code fragment +

    +
    +
     (mapcar (function (lambda (x) (+ x 2))) y)
+
    + +

    the function (lambda (x) (+ x 2)) contains no references to any outside +object. In this case, the same closure might be returned +for all evaluations of the function form. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    + + + + + diff --git a/info/gcl/Coercion-of-Streams-to-Pathnames.html b/info/gcl/Coercion-of-Streams-to-Pathnames.html new file mode 100644 index 0000000..9eac038 --- /dev/null +++ b/info/gcl/Coercion-of-Streams-to-Pathnames.html @@ -0,0 +1,70 @@ + + + + + +Coercion of Streams to Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: File System Concepts  

    +
    +
    +

    20.1.1 Coercion of Streams to Pathnames

    + +

    A stream associated with a file + + is either a file stream +or a synonym stream whose target is a stream associated with a file + +. +Such streams can be used as pathname designators. +

    +

    Normally, when a stream associated with a file is used as a +pathname designator, it denotes the pathname used to +open the file; this may be, but is not required to be, the +actual name of the file. +

    +

    Some functions, such as truename and delete-file, +coerce streams to pathnames in a different way that +involves referring to the actual file that is open, which might +or might not be the file whose name was opened originally. Such special +situations are always notated specifically and are not the default. +

    + + + + + diff --git a/info/gcl/Comma.html b/info/gcl/Comma.html new file mode 100644 index 0000000..8991ee1 --- /dev/null +++ b/info/gcl/Comma.html @@ -0,0 +1,55 @@ + + + + + +Comma (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.7 Comma

    + +

    The comma is part of the backquote syntax; see Backquote. +Comma is invalid if used other than inside the body of a +backquote expression as described above. +

    + + + + + diff --git a/info/gcl/Common-Case-in-Pathname-Components.html b/info/gcl/Common-Case-in-Pathname-Components.html new file mode 100644 index 0000000..ea849b3 --- /dev/null +++ b/info/gcl/Common-Case-in-Pathname-Components.html @@ -0,0 +1,72 @@ + + + + + +Common Case in Pathname Components (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.5 Common Case in Pathname Components

    + +

    For the functions in Figure~19–2, +a value of :common + for the :case argument +that these functions should receive +and yield strings in component values according to the following conventions: +

    +
    +
    *
    +

    All uppercase means to use a file system’s customary case. +

    +
    *
    +

    All lowercase means to use the opposite of the customary case. +

    +
    *
    +

    Mixed case represents itself. +

    +
    + +

    Note that these conventions have been chosen in such a way that translation +from :local to :common and back to :local is information-preserving. +

    + + + + + diff --git a/info/gcl/Compilation-Semantics.html b/info/gcl/Compilation-Semantics.html new file mode 100644 index 0000000..c498c28 --- /dev/null +++ b/info/gcl/Compilation-Semantics.html @@ -0,0 +1,74 @@ + + + + + +Compilation Semantics (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation  

    +
    +
    +

    3.2.2 Compilation Semantics

    + +

    Conceptually, compilation is a process that traverses code, performs +certain kinds of syntactic and semantic analyses using information +(such as proclamations and macro definitions) present in the +compilation environment, and produces equivalent, possibly +more efficient code. +

    + + + + + + + + +
    • Compiler Macros   +
    • Purpose of Compiler Macros   +
    • Naming of Compiler Macros   +
    • When Compiler Macros Are Used   +
    • Notes about the Implementation of Compiler Macros   +
    • Minimal Compilation   +
    • Semantic Constraints   +
    + + + + + + diff --git a/info/gcl/Compilation.html b/info/gcl/Compilation.html new file mode 100644 index 0000000..17a044f --- /dev/null +++ b/info/gcl/Compilation.html @@ -0,0 +1,65 @@ + + + + + +Compilation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.2 Compilation

    + + + + + + + + +
    • Compiler Terminology   +
    • Compilation Semantics   +
    • File Compilation   +
    • Literal Objects in Compiled Files   +
    • Exceptional Situations in the Compiler   +
    + + + + + + diff --git a/info/gcl/Compiler-Macros.html b/info/gcl/Compiler-Macros.html new file mode 100644 index 0000000..ec28260 --- /dev/null +++ b/info/gcl/Compiler-Macros.html @@ -0,0 +1,87 @@ + + + + + +Compiler Macros (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation Semantics  

    +
    +
    +

    3.2.2.1 Compiler Macros

    + +

    A compiler macro can be defined for a name +that also names a function or macro. +That is, it is possible for a +function name to name both a function and a compiler macro. +

    +

    A function name names a compiler macro if compiler-macro-function +is true of the function name in the lexical environment in which +it appears. Creating a lexical binding for the function name +not only creates a new local function or +macro definition, but also shadows_2 the compiler macro. +

    +

    The function returned by compiler-macro-function +is a function of two arguments, called the +expansion function. To expand a compiler macro, +the expansion function is invoked by calling the macroexpand hook with + the expansion function as its first argument, + the entire compiler macro form as its second argument, + and the current compilation environment + (or with the current lexical environment, + if the form is being processed by something + other than compile-file) + as its third argument. +The macroexpand hook, in turn, calls the expansion function with the +form as its first argument and the environment as its second argument. +The return value from the expansion function, which is passed through +by the macroexpand hook, might either be the same form, +or else a form that can, at the discretion of the code doing the expansion, +be used in place of the original form. +

    +
    +
      *macroexpand-hook*  compiler-macro-function  define-compiler-macro  
+
+        Figure 3–6: Defined names applicable to compiler macros      
+
+
    + + + + + + diff --git a/info/gcl/Compiler-Terminology.html b/info/gcl/Compiler-Terminology.html new file mode 100644 index 0000000..cdd8032 --- /dev/null +++ b/info/gcl/Compiler-Terminology.html @@ -0,0 +1,201 @@ + + + + + +Compiler Terminology (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation  

    +
    +
    +

    3.2.1 Compiler Terminology

    + +

    The following terminology is used in this section. +

    +

    The compiler + + is a utility that translates code into an +implementation-dependent form that might be represented or +executed efficiently. +The term compiler + + refers to both of the functions +compile and compile-file. +

    +

    The term compiled code + + refers to +objects representing compiled programs, such as objects constructed +by compile or by load when loading a compiled file. +

    +

    The term implicit compilation + + refers to compilation +performed during evaluation. +

    +

    The term literal object + + refers to + a quoted object + or a self-evaluating object + or an object that is a substructure of such an object. +A constant variable is not itself a literal object. +

    +

    The term coalesce + + is defined as follows. +Suppose A and B are two literal constants in the source code, +and that A' and B' are the corresponding objects in the compiled code. +If A' and B' are eql but +A and B are not eql, then it is said +that A and B have been coalesced by the compiler. +

    +

    The term minimal compilation + + refers to actions the compiler +must take at compile time. These actions are specified in +Compilation Semantics. +

    +

    The verb process + + refers to performing minimal compilation, +determining the time of evaluation for a form, +and possibly evaluating that form (if required). +

    +

    The term further compilation + + refers to +implementation-dependent compilation beyond minimal compilation. +That is, processing does not imply complete compilation. +Block compilation and generation of machine-specific instructions are +examples of further compilation. +Further compilation is permitted to take place at run time. +

    +

    Four different environments relevant to compilation are +distinguished: + the startup environment, + the compilation environment, + the evaluation environment, and + the run-time environment. +

    +

    The startup environment + + is +the environment of the Lisp image +from which the compiler was invoked. +

    +

    The compilation environment + + is maintained by the compiler +and is used to hold definitions and declarations to be used internally +by the compiler. Only those parts of a definition needed for correct +compilation are saved. The compilation environment is used +as the environment argument to macro expanders called by +the compiler. It is unspecified whether a definition available in the +compilation environment can be used in an evaluation +initiated in the startup environment or evaluation environment. +

    +

    The evaluation environment + + is a run-time environment +in which macro expanders and code specified by eval-when +to be evaluated are evaluated. All evaluations initiated by the +compiler take place in the evaluation environment. +

    +

    The run-time environment + + is the +environment in which the program being compiled will be executed. +

    +

    The compilation environment inherits from +the evaluation environment, +and the compilation environment and evaluation environment +might be identical. +The evaluation environment inherits from +the startup environment, +and the startup environment and evaluation environment +might be identical. +

    +

    The term compile time + + refers to the duration of time that +the compiler is processing source code. +At compile time, +only the compilation environment +and the evaluation environment +are available. +

    +

    The term compile-time definition + + refers to a definition in +the compilation environment. +For example, when compiling a file, +the definition of a function might be retained in the compilation environment +if it is declared inline. +This definition might not be available in the evaluation environment. +

    +

    The term run time + + refers to the duration of time that the +loader is loading compiled code or compiled code is being executed. +At run time, only the run-time environment is available. +

    +

    The term run-time definition + + refers to a definition in the +run-time environment. +

    +

    The term run-time compiler + + refers to the function compile +or implicit compilation, for which the compilation and run-time +environments are maintained in the same Lisp image. +Note that when the run-time compiler is used, +the run-time environment +and startup environment +are the same. +

    +
    +
    +

    +Next: , Previous: , Up: Compilation  

    +
    + + + + + diff --git a/info/gcl/Compiling-Format-Strings.html b/info/gcl/Compiling-Format-Strings.html new file mode 100644 index 0000000..ec63d6d --- /dev/null +++ b/info/gcl/Compiling-Format-Strings.html @@ -0,0 +1,61 @@ + + + + + +Compiling Format Strings (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pretty Printer Concepts  

    +
    +
    +

    22.2.1.3 Compiling Format Strings

    + +

    A format string is essentially a program in a special-purpose language +that performs printing, and that is interpreted by the function format. +The formatter macro provides the efficiency of using a compiled function +to do that same printing but without losing the textual compactness of format strings. +

    +

    A format control + + is either a format string or a function +that was returned by the the formatter macro. +

    + + + + + diff --git a/info/gcl/Complex-Computations.html b/info/gcl/Complex-Computations.html new file mode 100644 index 0000000..4baa645 --- /dev/null +++ b/info/gcl/Complex-Computations.html @@ -0,0 +1,66 @@ + + + + + +Complex Computations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    +
    +

    12.1.5 Complex Computations

    + +

    The following rules apply to complex computations: +

    + + + + + + +
    • Rule of Complex Substitutability   +
    • Rule of Complex Contagion   +
    • Rule of Canonical Representation for Complex Rationals   +
    • Examples of Rule of Canonical Representation for Complex Rationals   +
    • Principal Values and Branch Cuts   +
    + + + + + + diff --git a/info/gcl/Condition-Designators.html b/info/gcl/Condition-Designators.html new file mode 100644 index 0000000..3f06a68 --- /dev/null +++ b/info/gcl/Condition-Designators.html @@ -0,0 +1,111 @@ + + + + + +Condition Designators (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Creating Conditions  

    +
    +
    +

    9.1.2.1 Condition Designators

    + +

    A number of the functions in the condition system take arguments which +are identified as condition designators + +. +By convention, those arguments are notated as +

    +

    datum &rest arguments +

    +

    Taken together, the datum and the arguments are +“designators for a condition of default type default-type.” +How the denoted condition is computed depends on the type of the datum: +

    +
    +
    * If the datum is a symbol
    +

    naming a condition type ... +The denoted condition is the result of +

    +
    +
     (apply #'make-condition datum arguments)
+
    + +
    +
    * If the datum is a format control ...
    +
    +

    The denoted condition is the result of +

    +
    +
     (make-condition defaulted-type 
+                 :format-control datum
+                 :format-arguments arguments)
+
    + +

    where the defaulted-type is a subtype of default-type. +

    +
    +
    * If the datum is a condition ...
    +

    The denoted condition is the datum itself. +In this case, unless otherwise specified by the description of the +operator in question, the arguments must be null; +that is, the consequences are undefined if any arguments were supplied. +

    +
    +
    + +

    Note that the default-type gets used only in the case where +the datum string is supplied. In the other situations, +the resulting condition is not necessarily of type default-type. +

    +

    Here are some illustrations of how different condition designators +can denote equivalent condition objects: +

    +
    +
    (let ((c (make-condition 'arithmetic-error :operator '/ :operands '(7 0))))
+  (error c))
+≡ (error 'arithmetic-error :operator '/ :operands '(7 0))
+
+(error "Bad luck.")
+≡ (error 'simple-error :format-control "Bad luck." :format-arguments '())
+
    + + + + + + diff --git a/info/gcl/Condition-System-Concepts.html b/info/gcl/Condition-System-Concepts.html new file mode 100644 index 0000000..fb6d0ab --- /dev/null +++ b/info/gcl/Condition-System-Concepts.html @@ -0,0 +1,153 @@ + + + + + +Condition System Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions  

    +
    +
    +

    9.1 Condition System Concepts

    + + +

    Common Lisp constructs are described not only in terms of their +behavior in situations during which they are intended to be used (see +the “Description” part of each operator specification), +but in all other situations (see the “Exceptional Situations” +part of each operator specification). +

    +

    A situation is the evaluation of an expression in a specific context. +A condition is an object that +represents a specific situation that has been detected. +Conditions are generalized instances of the class condition. +A hierarchy of condition classes is defined in Common Lisp. +A condition has slots that contain data +relevant to the situation that the condition represents. +

    +

    An error is a situation in which normal program execution cannot +continue correctly without some form of intervention (either +interactively by the user or under program control). Not all errors +are detected. When an error goes undetected, the effects can be +implementation-dependent, implementation-defined, unspecified, or +undefined. See Definitions. All detected errors can +be represented by conditions, but not all +conditions represent errors. +

    +

    Signaling is the process by which a condition can alter +the flow of control in a program by raising the +condition which can then be handled. The functions +error, cerror, signal, and +warn are used to signal conditions. +

    +

    The process of signaling involves the selection and invocation of a +handler from a set of active handlers. +A handler is a function of one argument (the +condition) that is invoked to handle a condition. +Each handler is associated with a condition type, +and a handler will be invoked only on a condition of the +handler’s associated type. +

    +

    Active handlers are established dynamically +(see handler-bind or handler-case). +Handlers are invoked in a dynamic environment +equivalent to that of the signaler, +except that the set of active handlers +is bound in such a way as to include only those that were active +at the time the handler being invoked was established. +Signaling a condition has no side-effect on the condition, +and there is no dynamic state contained in a condition. +

    +

    If a handler is invoked, it can address the situation +in one of three ways: +

    +
    +
    Decline
    +

    It can decline to handle the condition. It does this by +simply returning rather than transferring control. +When this happens, any values returned by the handler are +ignored and the next most recently established handler is invoked. +If there is no such handler and the signaling function is error +or cerror, the debugger is entered in the +dynamic environment of the signaler. If there is no such +handler and the signaling function is either signal or +warn, the signaling function simply returns~nil. +

    +
    +
    Handle
    +

    It can handle the condition by performing a non-local +transfer of control. This can be done either primitively by using +go, return, throw or more +abstractly by using a function such as abort or +invoke-restart. +

    +
    +
    Defer
    +

    It can put off a decision about whether to handle or decline, +by any of a number of actions, but most commonly by + signaling another condition, + resignaling the same condition, + or forcing entry into the debugger. +

    +
    +
    + + + + + + + + +
    • Condition Types   +
    • Creating Conditions   +
    • Printing Conditions   +
    • Signaling and Handling Conditions   +
    • Assertions   +
    • Notes about the Condition System`s Background   +
    + +
    +
    +

    +Next: , Previous: , Up: Conditions  

    +
    + + + + + diff --git a/info/gcl/Condition-Types.html b/info/gcl/Condition-Types.html new file mode 100644 index 0000000..f93849a --- /dev/null +++ b/info/gcl/Condition-Types.html @@ -0,0 +1,119 @@ + + + + + +Condition Types (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Condition System Concepts  

    +
    +
    +

    9.1.1 Condition Types

    + +

    Figure 9–1 lists the standardized condition types. +Additional condition types can be defined by using define-condition. +

    +
    +
     arithmetic-error                 floating-point-overflow  simple-type-error  
+ cell-error                       floating-point-underflow simple-warning     
+ condition                        package-error            storage-condition  
+ control-error                    parse-error              stream-error       
+ division-by-zero                 print-not-readable       style-warning      
+ end-of-file                      program-error            type-error         
+ error                            reader-error             unbound-slot       
+ file-error                       serious-condition        unbound-variable   
+ floating-point-inexact           simple-condition         undefined-function 
+ floating-point-invalid-operation simple-error             warning            
+
+                    Figure 9–1: Standardized Condition Types                  
+
+
    + +

    All condition types are subtypes of type condition. That is, +

    +
    +
     (typep c 'condition) ⇒  true
+
    + +

    if and only if c is a condition. +

    +

    Implementations must define all specified subtype relationships. +Except where noted, all subtype relationships indicated in +this document are not mutually exclusive. +A condition inherits the structure of its supertypes. +

    +

    The metaclass of the class condition is not specified. +Names of condition types may be used to specify +supertype relationships in define-condition, +but the consequences are not specified if an attempt is made to use +a condition type as a superclass in a defclass form. +

    +

    Figure 9–2 shows operators that +define condition types and creating conditions. +

    +
    +
      define-condition  make-condition    
+
+  Figure 9–2: Operators that define and create conditions.
+
+
    + +

    Figure 9–3 shows operators that read +the value of condition slots. +

    +
    +
      arithmetic-error-operands   simple-condition-format-arguments  
+  arithmetic-error-operation  simple-condition-format-control    
+  cell-error-name             stream-error-stream                
+  file-error-pathname         type-error-datum                   
+  package-error-package       type-error-expected-type           
+  print-not-readable-object   unbound-slot-instance              
+
+         Figure 9–3: Operators that read condition slots.       
+
+
    + + + +
    • Serious Conditions   +
    + + + + + + diff --git a/info/gcl/Conditional-Execution-Clauses.html b/info/gcl/Conditional-Execution-Clauses.html new file mode 100644 index 0000000..c9e33e2 --- /dev/null +++ b/info/gcl/Conditional-Execution-Clauses.html @@ -0,0 +1,97 @@ + + + + + +Conditional Execution Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.6 Conditional Execution Clauses

    + +

    The if, when, and unless constructs +establish conditional control in a loop. If the test +passes, the succeeding loop clause is executed. If the test does +not pass, the succeeding clause is skipped, and program control +moves to the clause that follows the loop keyword +else. If the test does not pass and no else +clause is supplied, control is transferred to the clause or +construct following the entire conditional clause. +

    +

    If conditional clauses are nested, each else is paired +with the closest preceding conditional clause that has no +associated else or end. +

    +

    In the if and when clauses, which are +synonymous, the test passes if the value of form is +true. +

    +

    In the unless clause, +the test passes if the value of form is false. +

    +

    Clauses that follow the test expression can be grouped by using +the loop keyword and to produce a conditional block consisting of +a compound clause. +

    +

    The loop keyword it can be used to refer to the result +of the test expression in a clause. +Use the loop keyword it in place of the form in a +return clause or an accumulation clause that is +inside a conditional execution clause. +If multiple clauses are connected with and, the it +construct must be in the first clause in the block. +

    +

    The optional loop keyword end marks the end of the clause. If this +keyword is not supplied, the next loop keyword marks the end. The construct +end can be used to distinguish the scoping of compound clauses. +

    + + +
    • Examples of WHEN clause   +
    + +
    +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    + + + + + diff --git a/info/gcl/Conditions-Dictionary.html b/info/gcl/Conditions-Dictionary.html new file mode 100644 index 0000000..ef0cf42 --- /dev/null +++ b/info/gcl/Conditions-Dictionary.html @@ -0,0 +1,152 @@ + + + + + +Conditions Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conditions  

    +
    +
    +

    9.2 Conditions Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • condition   +
    • warning   +
    • style-warning   +
    • serious-condition   +
    • error (Condition Type)   +
    • cell-error   +
    • cell-error-name   +
    • parse-error   +
    • storage-condition   +
    • assert   +
    • error   +
    • cerror   +
    • check-type   +
    • simple-error   +
    • invalid-method-error   +
    • method-combination-error   +
    • signal   +
    • simple-condition   +
    • simple-condition-format-control   +
    • warn   +
    • simple-warning   +
    • invoke-debugger   +
    • break   +
    • *debugger-hook*   +
    • *break-on-signals*   +
    • handler-bind   +
    • handler-case   +
    • ignore-errors   +
    • define-condition   +
    • make-condition   +
    • restart   +
    • compute-restarts   +
    • find-restart   +
    • invoke-restart   +
    • invoke-restart-interactively   +
    • restart-bind   +
    • restart-case   +
    • restart-name   +
    • with-condition-restarts   +
    • with-simple-restart   +
    • abort (Restart)   +
    • continue   +
    • muffle-warning   +
    • store-value   +
    • use-value   +
    • abort (Function)   +
    + +
    +
    +

    +Previous: , Up: Conditions  

    +
    + + + + + diff --git a/info/gcl/Conditions.html b/info/gcl/Conditions.html new file mode 100644 index 0000000..d0b1e97 --- /dev/null +++ b/info/gcl/Conditions.html @@ -0,0 +1,58 @@ + + + + + +Conditions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    9 Conditions

    + + + + +
    • Condition System Concepts   +
    • Conditions Dictionary   +
    + + + + + + diff --git a/info/gcl/Conformance-Statement.html b/info/gcl/Conformance-Statement.html new file mode 100644 index 0000000..6da2af4 --- /dev/null +++ b/info/gcl/Conformance-Statement.html @@ -0,0 +1,76 @@ + + + + + +Conformance Statement (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conforming Implementations  

    +
    +
    +

    1.5.1.7 Conformance Statement

    + +

    A conforming implementation shall produce a conformance statement +as a consequence of using the implementation, or that statement +shall be included in the accompanying documentation. If the implementation +conforms in all respects with this standard, the conformance statement +shall be +

    +
    +
    +

    “<<Implementation>> conforms with the requirements + of ANSI <<standard number>>” +

    +
    + +

    If the implementation conforms with some but not all of the requirements of this +standard, then the conformance statement shall be +

    +
    +
    +

    “<<Implementation>> conforms with the requirements of + ANSI <<standard number>> with the following exceptions: + <<reference to or complete list of the requirements of + the standard with which the implementation does not conform>>.” +

    +
    + + + + + + diff --git a/info/gcl/Conformance.html b/info/gcl/Conformance.html new file mode 100644 index 0000000..77dcb9f --- /dev/null +++ b/info/gcl/Conformance.html @@ -0,0 +1,63 @@ + + + + + +Conformance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.5 Conformance

    + + +

    This standard presents the syntax and semantics to be implemented by a +conforming implementation (and its accompanying documentation). +In addition, it imposes requirements on conforming programs. +

    + + + +
    • Conforming Implementations   +
    • Conforming Programs   +
    + + + + + + diff --git a/info/gcl/Conforming-Implementations.html b/info/gcl/Conforming-Implementations.html new file mode 100644 index 0000000..a9b7414 --- /dev/null +++ b/info/gcl/Conforming-Implementations.html @@ -0,0 +1,73 @@ + + + + + +Conforming Implementations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conformance  

    +
    +
    +

    1.5.1 Conforming Implementations

    + +

    A conforming implementation + + shall adhere to the requirements outlined +in this section. +

    + + + + + + + + +
    • Required Language Features   +
    • Documentation of Implementation-Dependent Features   +
    • Documentation of Extensions   +
    • Treatment of Exceptional Situations   +
    • Resolution of Apparent Conflicts in Exceptional Situations   +
    • Examples of Resolution of Apparent Conflict in Exceptional Situations   +
    • Conformance Statement   +
    + + + + + + diff --git a/info/gcl/Conforming-Programs.html b/info/gcl/Conforming-Programs.html new file mode 100644 index 0000000..3e0a149 --- /dev/null +++ b/info/gcl/Conforming-Programs.html @@ -0,0 +1,95 @@ + + + + + +Conforming Programs (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conformance  

    +
    +
    +

    1.5.2 Conforming Programs

    + + + + + +

    Code conforming with the requirements of this standard shall adhere to the +following: +

    +
    +
    1.
    +

    Conforming code shall use only those features of the + language syntax and semantics that are + either specified in this standard + or defined using the extension mechanisms + specified in the standard. +

    +
    +
    2.
    +

    Conforming code shall not rely on any particular + interpretation of implementation-dependent features. +

    +
    +
    3.
    +

    Conforming code shall not depend on the consequences + of undefined or unspecified situations. +

    +
    +
    4.
    +

    Conforming code does not use any constructions + that are prohibited by the standard. +

    +
    +
    5.
    +

    Conforming code does not depend on extensions + included in an implementation. +

    +
    + + + + +
    • Use of Implementation-Defined Language Features   +
    • Use of Read-Time Conditionals   +
    + + + + + + diff --git a/info/gcl/Congruent-Lambda_002dlists-for-all-Methods-of-a-Generic-Function.html b/info/gcl/Congruent-Lambda_002dlists-for-all-Methods-of-a-Generic-Function.html new file mode 100644 index 0000000..86a939e --- /dev/null +++ b/info/gcl/Congruent-Lambda_002dlists-for-all-Methods-of-a-Generic-Function.html @@ -0,0 +1,109 @@ + + + + + +Congruent Lambda-lists for all Methods of a Generic Function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    +
    +

    7.6.4 Congruent Lambda-lists for all Methods of a Generic Function

    + +

    These rules define the congruence of a set of lambda lists, including the +lambda list of each method for a given generic function and the +lambda list specified for the generic function itself, if given. +

    +
    +
    1.
    +

    Each lambda list must have the same number of required +parameters. +

    +
    +
    2.
    +

    Each lambda list must have the same number of optional +parameters. Each method can supply its own default for an optional +parameter. +

    +
    +
    3.
    +

    If any lambda list mentions &rest or &key, each +lambda list must mention one or both of them. +

    +
    +
    4.
    +

    If the generic function lambda list +mentions &key, each +method must accept all of the keyword names mentioned after &key, +either by accepting them explicitly, by specifying &allow-other-keys, +or by specifying &rest but not &key. +Each method can accept additional keyword arguments of its own. The +checking of the validity of keyword names is done in the generic +function, not in each method. +A method is invoked as if the keyword +argument pair whose name is :allow-other-keys and whose value +is true were supplied, though no such argument pair will be passed. +

    +
    +
    5.
    +

    The use of &allow-other-keys need not be consistent +across lambda lists. If &allow-other-keys is mentioned in +the lambda list of any applicable method or of the generic function, +any keyword arguments may be mentioned in the call to the generic function. +

    +
    +
    6.
    +

    The use of &aux need not be consistent across methods. +

    +

    If a method-defining operator that cannot specify generic function options +creates a generic function, and if the lambda list for the method +mentions keyword arguments, the lambda list of the generic function +will mention &key (but no keyword arguments). +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    + + + + + diff --git a/info/gcl/Cons-Concepts.html b/info/gcl/Cons-Concepts.html new file mode 100644 index 0000000..766fdc0 --- /dev/null +++ b/info/gcl/Cons-Concepts.html @@ -0,0 +1,76 @@ + + + + + +Cons Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses  

    +
    +
    +

    14.1 Cons Concepts

    + + +

    A cons + + is a compound data object +having two components called the car and the cdr. +

    +
    +
      car  cons    rplacd  
+  cdr  rplaca          
+
+  Figure 14–1: Some defined names relating to conses.
+
+
    + +

    Depending on context, a group of connected conses can be viewed +in a variety of different ways. A variety of operations is provided to +support each of these various views. +

    + + + +
    • Conses as Trees   +
    • Conses as Lists   +
    + + + + + + diff --git a/info/gcl/Conses-Dictionary.html b/info/gcl/Conses-Dictionary.html new file mode 100644 index 0000000..75420e7 --- /dev/null +++ b/info/gcl/Conses-Dictionary.html @@ -0,0 +1,158 @@ + + + + + +Conses Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conses  

    +
    +
    +

    14.2 Conses Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • list (System Class)   +
    • null (System Class)   +
    • cons (System Class)   +
    • atom (Type)   +
    • cons   +
    • consp   +
    • atom   +
    • rplaca   +
    • car   +
    • copy-tree   +
    • sublis   +
    • subst   +
    • tree-equal   +
    • copy-list   +
    • list (Function)   +
    • list-length   +
    • listp   +
    • make-list   +
    • push   +
    • pop   +
    • first   +
    • nth   +
    • endp   +
    • null   +
    • nconc   +
    • append   +
    • revappend   +
    • butlast   +
    • last   +
    • ldiff   +
    • nthcdr   +
    • rest   +
    • member (Function)   +
    • mapc   +
    • acons   +
    • assoc   +
    • copy-alist   +
    • pairlis   +
    • rassoc   +
    • get-properties   +
    • getf   +
    • remf   +
    • intersection   +
    • adjoin   +
    • pushnew   +
    • set-difference   +
    • set-exclusive-or   +
    • subsetp   +
    • union   +
    + +
    +
    +

    +Previous: , Up: Conses  

    +
    + + + + + diff --git a/info/gcl/Conses-as-Forms.html b/info/gcl/Conses-as-Forms.html new file mode 100644 index 0000000..f6d5b99 --- /dev/null +++ b/info/gcl/Conses-as-Forms.html @@ -0,0 +1,70 @@ + + + + + +Conses as Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.7 Conses as Forms

    + +

    A cons that is used as a form is called a compound form. +

    +

    If the car of that compound form is a symbol, +that symbol is the name of an operator, +and the form is either a special form, a macro form, +or a function form, depending on the function binding +of the operator in the current lexical environment. +If the operator is neither a special operator +nor a macro name, it is assumed to be a function name +(even if there is no definition for such a function). +

    +

    If the car of the compound form is not a symbol, +then that car must be a lambda expression, +in which case the compound form is a lambda form. +

    +

    How a compound form is processed depends on whether it is +classified as a special form, a macro form, +a function form, or a lambda form. +

    + + + + + diff --git a/info/gcl/Conses-as-Lists.html b/info/gcl/Conses-as-Lists.html new file mode 100644 index 0000000..906945d --- /dev/null +++ b/info/gcl/Conses-as-Lists.html @@ -0,0 +1,103 @@ + + + + + +Conses as Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Cons Concepts  

    +
    +
    +

    14.1.2 Conses as Lists

    + +

    A list + + is a chain of conses in which the car of each +cons is an element of the list, +and the cdr of each cons is either the next +link in the chain or a terminating atom. +

    +

    A proper list + + is a list terminated by the empty list. +The empty list is a proper list, but is not a cons. +

    +

    An improper list + + is a list that is not a proper list; +that is, it is a circular list or a dotted list. +

    +

    A dotted list + + is a list that has a terminating atom +that is not the empty list. A non-nil atom by itself +is not considered to be a list of any kind—not even a dotted list. +

    +

    A circular list + + is a chain of conses that has no termination +because some cons in the chain is the cdr of a later cons. +

    +
    +
      append      last           nbutlast  rest       
+  butlast     ldiff          nconc     revappend  
+  copy-alist  list           ninth     second     
+  copy-list   list*          nreconc   seventh    
+  eighth      list-length    nth       sixth      
+  endp        make-list      nthcdr    tailp      
+  fifth       member         pop       tenth      
+  first       member-if      push      third      
+  fourth      member-if-not  pushnew              
+
+  Figure 14–3: Some defined names relating to lists.
+
+
    + + + + + +
    • Lists as Association Lists   +
    • Lists as Sets   +
    • General Restrictions on Parameters that must be Lists   +
    + + + + + + diff --git a/info/gcl/Conses-as-Trees.html b/info/gcl/Conses-as-Trees.html new file mode 100644 index 0000000..e0c7fea --- /dev/null +++ b/info/gcl/Conses-as-Trees.html @@ -0,0 +1,84 @@ + + + + + +Conses as Trees (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Cons Concepts  

    +
    +
    +

    14.1.1 Conses as Trees

    + +

    A tree + + is a binary recursive data structure made up of +conses and atoms: +the conses are themselves also trees +(sometimes called “subtrees” or “branches”), and the atoms +are terminal nodes (sometimes called leaves + +). +Typically, the leaves represent data while the branches +establish some relationship among that data. +

    +
    +
      caaaar  caddar  cdar       nsubst         
+  caaadr  cadddr  cddaar     nsubst-if      
+  caaar   caddr   cddadr     nsubst-if-not  
+  caadar  cadr    cddar      nthcdr         
+  caaddr  cdaaar  cdddar     sublis         
+  caadr   cdaadr  cddddr     subst          
+  caar    cdaar   cdddr      subst-if       
+  cadaar  cdadar  cddr       subst-if-not   
+  cadadr  cdaddr  copy-tree  tree-equal     
+  cadar   cdadr   nsublis                   
+
+  Figure 14–2: Some defined names relating to trees.
+
+
    + + + +
    • General Restrictions on Parameters that must be Trees   +
    + + + + + + diff --git a/info/gcl/Conses.html b/info/gcl/Conses.html new file mode 100644 index 0000000..20b8fb8 --- /dev/null +++ b/info/gcl/Conses.html @@ -0,0 +1,58 @@ + + + + + +Conses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    14 Conses

    + + + + +
    • Cons Concepts   +
    • Conses Dictionary   +
    + + + + + + diff --git a/info/gcl/Constant-Variables.html b/info/gcl/Constant-Variables.html new file mode 100644 index 0000000..ebcebce --- /dev/null +++ b/info/gcl/Constant-Variables.html @@ -0,0 +1,65 @@ + + + + + +Constant Variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.5 Constant Variables

    + +

    Certain variables, called constant variables, are reserved as “named constants.” +The consequences are undefined if an attempt is made to + assign a value to, + or create +a binding for a constant variable, +except that a ‘compatible’ redefinition of a constant variable +using defconstant is permitted; see the macro defconstant. +

    +

    Keywords, +symbols defined by Common Lisp or the implementation + as constant (such as nil, t, and pi), +and symbols declared as constant using defconstant +are constant variables. +

    + + + + + diff --git a/info/gcl/Constituent-Characters.html b/info/gcl/Constituent-Characters.html new file mode 100644 index 0000000..f547040 --- /dev/null +++ b/info/gcl/Constituent-Characters.html @@ -0,0 +1,63 @@ + + + + + +Constituent Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.1 Constituent Characters

    + +

    Constituent characters are used in tokens. +A token + + is a representation of a number or a symbol. +Examples of constituent characters are letters and digits. +

    +

    Letters in symbol names are sometimes converted to +letters in the opposite case when the name is read; +see Effect of Readtable Case on the Lisp Reader. +Case conversion can be suppressed by the use +of single escape or multiple escape characters. +

    + + + + + diff --git a/info/gcl/Constituent-Traits.html b/info/gcl/Constituent-Traits.html new file mode 100644 index 0000000..119bac1 --- /dev/null +++ b/info/gcl/Constituent-Traits.html @@ -0,0 +1,134 @@ + + + + + +Constituent Traits (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.2 Constituent Traits

    + +

    Every character has one or more constituent traits +that define how the character is to be interpreted by the Lisp reader +when the character is a constituent character. +These constituent traits are + alphabetic_2, + digit, + package marker, + plus sign, + minus sign, + dot, + decimal point, + ratio marker, + exponent marker, + and invalid. +Figure~2–8 shows the constituent traits +of the standard characters +and of certain semi-standard characters; +no mechanism is provided for changing the constituent trait of a character. +Any character with the alphadigit constituent trait +in that figure is a digit if the current input base is greater +than that character’s digit value, +otherwise the character is alphabetic_2. +Any character quoted by a single escape +is treated as an alphabetic_2 constituent, regardless of its normal syntax. +

    +
    +
     constituent traits         constituent traits                                   
+ character                  character   
+ ________________________________________________________________________________
+ Backspace   invalid        {           alphabetic_2                             
+ Tab         invalid*       }           alphabetic_2                             
+ Newline     invalid*       +           alphabetic_2, plus sign                  
+ Linefeed    invalid*       -           alphabetic_2, minus sign                 
+ Page        invalid*       .           alphabetic_2, dot, decimal point         
+ Return      invalid*       /           alphabetic_2, ratio marker               
+ Space       invalid*       A, a        alphadigit                               
+ !           alphabetic_2   B, b        alphadigit                               
+ "           alphabetic_2*  C, c        alphadigit                               
+ #           alphabetic_2*  D, d        alphadigit, double-float exponent marker 
+ $          alphabetic_2   E, e        alphadigit, float exponent marker        
+ %           alphabetic_2   F, f        alphadigit, single-float exponent marker 
+ &           alphabetic_2   G, g        alphadigit                               
+ ’           alphabetic_2*  H, h        alphadigit                               
+ (           alphabetic_2*  I, i        alphadigit                               
+ )           alphabetic_2*  J, j        alphadigit                               
+ *           alphabetic_2   K, k        alphadigit                               
+ ,           alphabetic_2*  L, l        alphadigit, long-float exponent marker   
+ 0-9         alphadigit     M, m        alphadigit                               
+ :           package marker N, n        alphadigit                               
+ ;           alphabetic_2*  O, o        alphadigit                               
+ <           alphabetic_2   P, p        alphadigit                               
+ =           alphabetic_2   Q, q        alphadigit                               
+ >           alphabetic_2   R, r        alphadigit                               
+ ?           alphabetic_2   S, s        alphadigit, short-float exponent marker  
+ @           alphabetic_2   T, t        alphadigit                               
+ [           alphabetic_2   U, u        alphadigit                               
+ \           alphabetic_2*  V, v        alphadigit                               
+ ]           alphabetic_2   W, w        alphadigit                               
+ ^           alphabetic_2   X, x        alphadigit                               
+ _           alphabetic_2   Y, y        alphadigit                               
+ ‘           alphabetic_2*  Z, z        alphadigit                               
+ |           alphabetic_2*  Rubout      invalid                                  
+ ~           alphabetic_2   
+
    + +

      Figure 2–8: Constituent Traits of Standard Characters and Semi-Standard Characters +

    +

    The interpretations in this table apply only to characters +whose syntax type is constituent. +Entries marked with an asterisk (*) are normally shadowed_2 +because the indicated characters are of syntax type +whitespace_2, +macro character, +single escape, +or multiple escape; +these constituent traits apply to them only if their syntax types +are changed to constituent. +

    +
    +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    + + + + + diff --git a/info/gcl/Constraints-on-Macros-and-Compiler-Macros.html b/info/gcl/Constraints-on-Macros-and-Compiler-Macros.html new file mode 100644 index 0000000..8a7cc76 --- /dev/null +++ b/info/gcl/Constraints-on-Macros-and-Compiler-Macros.html @@ -0,0 +1,64 @@ + + + + + +Constraints on Macros and Compiler Macros (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: File Compilation  

    +
    +
    +

    3.2.3.3 Constraints on Macros and Compiler Macros

    + +

    Except where explicitly stated otherwise, no macro defined in +the Common Lisp standard produces an expansion that could cause any of the +subforms of the macro form to be treated as +top level forms. If an implementation also provides a +special operator definition of a Common Lisp macro, +the special operator definition must be semantically equivalent +in this respect. +

    +

    Compiler macro expansions must also have the same +top level evaluation semantics as the form which they replace. +This is of concern both to conforming implementations and to +conforming programs. +

    + + + + + diff --git a/info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Implementations.html b/info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Implementations.html new file mode 100644 index 0000000..e745265 --- /dev/null +++ b/info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Implementations.html @@ -0,0 +1,81 @@ + + + + + +Constraints on the COMMON-LISP Package for Conforming Implementations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.2 Constraints on the COMMON-LISP Package for Conforming Implementations

    + +

    In a conforming implementation, +an external symbol of the COMMON-LISP package can have + a function, macro, or special operator definition, + a global variable definition + (or other status as a dynamic variable + due to a special proclamation), +or a type definition +only if explicitly permitted in this standard. +For example, + fboundp yields false + for any external symbol of the COMMON-LISP package + that is not the name of a standardized + function, macro or special operator, +and + boundp returns false + for any external symbol of the COMMON-LISP package + that is not the name of a standardized global variable. +It also follows that + conforming programs can use external symbols of the COMMON-LISP package + as the names of local lexical variables + with confidence that those names have not been proclaimed special + by the implementation + unless those symbols are + names of standardized global variables. +

    +

    A conforming implementation must not place any property on +an external symbol of the COMMON-LISP package using a property indicator +that is either an external symbol of any standardized package +or a symbol that is otherwise accessible in the COMMON-LISP-USER package. +

    + + + + + diff --git a/info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html b/info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html new file mode 100644 index 0000000..2eaa7ee --- /dev/null +++ b/info/gcl/Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html @@ -0,0 +1,178 @@ + + + + + +Constraints on the COMMON-LISP Package for Conforming Programs (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.3 Constraints on the COMMON-LISP Package for Conforming Programs

    + + + +

    Except where explicitly allowed, the consequences are undefined if any +of the following actions are performed on an external symbol +of the COMMON-LISP package: +

    +
    +
    1.
    +

    Binding or altering its value (lexically or dynamically). + (Some exceptions are noted below.) +

    +
    +
    2.
    +

    Defining, +

    +

    undefining, +

    +

    or binding it as a function. + (Some exceptions are noted below.) +

    +
    +
    3.
    +

    Defining, +

    +

    undefining, +

    +

    or binding it as a macro +

    +

    or compiler macro. +

    +

    (Some exceptions are noted below.) +

    +
    +
    4.
    +

    Defining it as a type specifier + (via defstruct, + defclass, + deftype, + define-condition). +

    +
    +
    5.
    +

    Defining it as a structure (via defstruct). +

    +
    +
    6.
    +

    Defining it as a declaration + with a declaration proclamation. +

    +
    +
    7.
    +

    Defining it as a symbol macro. +

    +
    +
    8.
    +

    Altering its home package. +

    +
    +
    9.
    +

    Tracing it (via trace). +

    +
    +
    10.
    +

    Declaring or proclaiming it + special + (via declare, +

    +

    declaim, +

    +

    or proclaim). +

    +
    +
    11.
    +

    Declaring or proclaiming its type or ftype + (via declare, +

    +

    declaim, +

    +

    or proclaim). + (Some exceptions are noted below.) +

    +
    +
    12.
    +

    Removing it from the COMMON-LISP package. +

    +
    +
    13.
    +

    Defining a setf expander for it + (via defsetf or define-setf-method). +

    +
    +
    14.
    +

    Defining, undefining, or binding its setf function name. +

    +
    +
    15.
    +

    Defining it as a method combination type + (via define-method-combination). +

    +
    +
    16.
    +

    Using it as the class-name argument + to setf of find-class. +

    +
    +
    17.
    +

    Binding it as a catch tag. +

    +
    +
    18.
    +

    Binding it as a restart name. +

    +
    +
    19.
    +

    Defining a method + for a standardized generic function + which is applicable when all of the arguments + are direct instances of standardized classes. +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    + + + + + diff --git a/info/gcl/Constructing-Numbers-from-Tokens.html b/info/gcl/Constructing-Numbers-from-Tokens.html new file mode 100644 index 0000000..cb00679 --- /dev/null +++ b/info/gcl/Constructing-Numbers-from-Tokens.html @@ -0,0 +1,79 @@ + + + + + +Constructing Numbers from Tokens (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpretation of Tokens  

    +
    +
    +

    2.3.2 Constructing Numbers from Tokens

    + +

    A real is constructed directly from a corresponding numeric token; +see Figure~2–9. +

    +

    A complex is notated as a #C (or #c) followed by a list +of two reals; see Sharpsign C. +

    +

    The reader macros #B, #O, #X, and #R may also be useful +in controlling the input radix in which rationals are parsed; + see Sharpsign B, + Sharpsign O, + Sharpsign X, + and Sharpsign R. +

    +

    This section summarizes the full syntax for numbers. +

    + + + + + + +
    • Syntax of a Rational   +
    • Syntax of an Integer   +
    • Syntax of a Ratio   +
    • Syntax of a Float   +
    • Syntax of a Complex   +
    + + + + + + diff --git a/info/gcl/Contagion-in-Numeric-Operations.html b/info/gcl/Contagion-in-Numeric-Operations.html new file mode 100644 index 0000000..4420edc --- /dev/null +++ b/info/gcl/Contagion-in-Numeric-Operations.html @@ -0,0 +1,57 @@ + + + + + +Contagion in Numeric Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numeric Operations  

    +
    +
    +

    12.1.1.3 Contagion in Numeric Operations

    + +

    For information about the contagion rules for implicit coercions of arguments +in numeric operations, see + Rule of Float Precision Contagion, + Rule of Float and Rational Contagion, + and Rule of Complex Contagion. +

    + + + + + diff --git a/info/gcl/Control-Transfer-Clauses.html b/info/gcl/Control-Transfer-Clauses.html new file mode 100644 index 0000000..07ee1f9 --- /dev/null +++ b/info/gcl/Control-Transfer-Clauses.html @@ -0,0 +1,74 @@ + + + + + +Control Transfer Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Miscellaneous Clauses  

    +
    +
    +

    6.1.7.1 Control Transfer Clauses

    + +

    The named construct +establishes a name for an implicit block surrounding the +

    +

    entire +

    +

    loop so that the return-from special operator can be used to return +values from or to exit loop. +Only one name per loop form can be assigned. +If used, the named construct must be the first clause in the loop expression. +

    +

    The return construct takes one form. + Any values returned by the form + are immediately returned by the loop form. +

    +

    This construct is similar to the return-from special operator and the return macro. +The return construct +

    +

    does not execute any finally clause that +

    +

    the loop form +

    +

    is given. +

    + + + + + diff --git a/info/gcl/Corresponding-Characters-in-the-Other-Case.html b/info/gcl/Corresponding-Characters-in-the-Other-Case.html new file mode 100644 index 0000000..4ffbaa8 --- /dev/null +++ b/info/gcl/Corresponding-Characters-in-the-Other-Case.html @@ -0,0 +1,57 @@ + + + + + +Corresponding Characters in the Other Case (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.6 Corresponding Characters in the Other Case

    + +

    The uppercase standard characters A through Z mentioned above +respectively correspond to +the lowercase standard characters a through z mentioned above. +For example, the uppercase character E +corresponds to the lowercase character e, and vice versa. +

    + + + + + diff --git a/info/gcl/Creating-Conditions.html b/info/gcl/Creating-Conditions.html new file mode 100644 index 0000000..5d284e0 --- /dev/null +++ b/info/gcl/Creating-Conditions.html @@ -0,0 +1,65 @@ + + + + + +Creating Conditions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Condition System Concepts  

    +
    +
    +

    9.1.2 Creating Conditions

    + +

    The function make-condition can be used to construct +a condition object explicitly. Functions such as error, +cerror, signal, and warn operate on +conditions and might create condition objects +implicitly. Macros such as ccase, ctypecase, +ecase, etypecase, check-type, and +assert might also implicitly create (and signal) +conditions. +

    + + +
    • Condition Designators   +
    + + + + + + diff --git a/info/gcl/Creating-Instances-of-Classes.html b/info/gcl/Creating-Instances-of-Classes.html new file mode 100644 index 0000000..c5feedf --- /dev/null +++ b/info/gcl/Creating-Instances-of-Classes.html @@ -0,0 +1,64 @@ + + + + + +Creating Instances of Classes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Classes  

    +
    +
    +

    4.3.3 Creating Instances of Classes

    + +

    The generic function make-instance creates and returns a new +instance of a class. +The object system provides several mechanisms for +specifying how a new instance is to be initialized. For example, it +is possible to specify the initial values for slots in newly created +instances +either by giving arguments to make-instance or by +providing default initial values. Further initialization activities +can be performed by methods written for generic functions +that are +part of the initialization protocol. The complete initialization +protocol is described in Object Creation and Initialization. +

    + + + + + diff --git a/info/gcl/Customizing-Class-Redefinition.html b/info/gcl/Customizing-Class-Redefinition.html new file mode 100644 index 0000000..01966ba --- /dev/null +++ b/info/gcl/Customizing-Class-Redefinition.html @@ -0,0 +1,68 @@ + + + + + +Customizing Class Redefinition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Redefining Classes  

    +
    +
    +

    4.3.6.3 Customizing Class Redefinition

    + +

    [Reviewer Note by Barmar: This description is hard to follow.] +

    +

    Methods for update-instance-for-redefined-class may be +defined to specify actions to be taken when an instance is updated. +If only after methods for update-instance-for-redefined-class are +defined, they will be run after the system-supplied primary method for +initialization and therefore will not interfere with the default +behavior of update-instance-for-redefined-class. Because no +initialization arguments are passed to update-instance-for-redefined-class +when it is called by the system, the +initialization forms for slots +that are filled by before methods for update-instance-for-redefined-class +will not be evaluated by shared-initialize. +

    +

    Methods for shared-initialize may be defined to customize +class redefinition. For more information, see Shared-Initialize. +

    + + + + + diff --git a/info/gcl/Customizing-Reinitialization.html b/info/gcl/Customizing-Reinitialization.html new file mode 100644 index 0000000..0f4fb49 --- /dev/null +++ b/info/gcl/Customizing-Reinitialization.html @@ -0,0 +1,62 @@ + + + + + +Customizing Reinitialization (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Reinitializing an Instance  

    +
    +
    +

    7.3.1 Customizing Reinitialization

    + +

    Methods for reinitialize-instance may be defined to specify +actions to be taken when an instance is updated. If only +after methods for reinitialize-instance are defined, +they will be run after the system-supplied primary method for +initialization and therefore will not interfere with the default behavior of +reinitialize-instance. +

    +

    Methods for shared-initialize may be defined to customize +class redefinition. For more information, see Shared-Initialize. +

    + + + + + + diff --git a/info/gcl/Customizing-the-Change-of-Class-of-an-Instance.html b/info/gcl/Customizing-the-Change-of-Class-of-an-Instance.html new file mode 100644 index 0000000..f8477d2 --- /dev/null +++ b/info/gcl/Customizing-the-Change-of-Class-of-an-Instance.html @@ -0,0 +1,63 @@ + + + + + +Customizing the Change of Class of an Instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Changing the Class of an Instance  

    +
    +
    +

    7.2.3 Customizing the Change of Class of an Instance

    + +

    Methods for update-instance-for-different-class may be defined +to specify actions to be taken when an instance is updated. If only +after methods for update-instance-for-different-class are +defined, they will be run after the system-supplied primary method for +initialization and will not interfere with the default behavior of +update-instance-for-different-class. +

    +

    Methods +for shared-initialize may be defined to customize class +redefinition. For more information, see Shared-Initialize. +

    + + + + + + diff --git a/info/gcl/Data-Type-Definition.html b/info/gcl/Data-Type-Definition.html new file mode 100644 index 0000000..a859bbe --- /dev/null +++ b/info/gcl/Data-Type-Definition.html @@ -0,0 +1,74 @@ + + + + + +Data Type Definition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types  

    +
    +
    +

    4.2.1 Data Type Definition

    + +

    Information about type usage is located in +the sections specified in Figure~4–1. +Figure~4–7 lists some classes +that are particularly relevant to the object system. +Figure~9–1 lists the defined condition types. +

    +
    +
      Section                                Data Type                         
+  _________________________________________________________________________
+  Classes                        Object System types               
+  Slots                          Object System types               
+  Objects                        Object System types               
+  Generic Functions and Methods  Object System types               
+  Condition System Concepts      Condition System types            
+  Types and Classes              Miscellaneous types               
+  Syntax                         All types—read and print syntax  
+  The Lisp Printer               All types—print syntax           
+  Compilation                    All types—compilation issues     
+
+           Figure 4–1: Cross-References to Data Type Information          
+
+
    + + + + + + diff --git a/info/gcl/Data-and-Control-Flow-Dictionary.html b/info/gcl/Data-and-Control-Flow-Dictionary.html new file mode 100644 index 0000000..cc1a565 --- /dev/null +++ b/info/gcl/Data-and-Control-Flow-Dictionary.html @@ -0,0 +1,198 @@ + + + + + +Data and Control Flow Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Data and Control Flow  

    +
    +
    +

    5.3 Data and Control Flow Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • apply   +
    • defun   +
    • fdefinition   +
    • fboundp   +
    • fmakunbound   +
    • flet   +
    • funcall   +
    • function (Special Operator)   +
    • function-lambda-expression   +
    • functionp   +
    • compiled-function-p   +
    • call-arguments-limit   +
    • lambda-list-keywords   +
    • lambda-parameters-limit   +
    • defconstant   +
    • defparameter   +
    • destructuring-bind   +
    • let   +
    • progv   +
    • setq   +
    • psetq   +
    • block   +
    • catch   +
    • go   +
    • return-from   +
    • return   +
    • tagbody   +
    • throw   +
    • unwind-protect   +
    • nil   +
    • not   +
    • t   +
    • eq   +
    • eql   +
    • equal   +
    • equalp   +
    • identity   +
    • complement   +
    • constantly   +
    • every   +
    • and   +
    • cond   +
    • if   +
    • or   +
    • when   +
    • case   +
    • typecase   +
    • multiple-value-bind   +
    • multiple-value-call   +
    • multiple-value-list   +
    • multiple-value-prog1   +
    • multiple-value-setq   +
    • values   +
    • values-list   +
    • multiple-values-limit   +
    • nth-value   +
    • prog   +
    • prog1   +
    • progn   +
    • define-modify-macro   +
    • defsetf   +
    • define-setf-expander   +
    • get-setf-expansion   +
    • setf   +
    • shiftf   +
    • rotatef   +
    • control-error   +
    • program-error   +
    • undefined-function   +
    + +
    +
    +

    +Previous: , Up: Data and Control Flow  

    +
    + + + + + diff --git a/info/gcl/Data-and-Control-Flow.html b/info/gcl/Data-and-Control-Flow.html new file mode 100644 index 0000000..8ceb123 --- /dev/null +++ b/info/gcl/Data-and-Control-Flow.html @@ -0,0 +1,60 @@ + + + + + +Data and Control Flow (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    5 Data and Control Flow

    + + + + + +
    • Generalized Reference   +
    • Transfer of Control to an Exit Point   +
    • Data and Control Flow Dictionary   +
    + + + + + + diff --git a/info/gcl/Data_002ddirected-Destructuring-by-Lambda-Lists.html b/info/gcl/Data_002ddirected-Destructuring-by-Lambda-Lists.html new file mode 100644 index 0000000..8873747 --- /dev/null +++ b/info/gcl/Data_002ddirected-Destructuring-by-Lambda-Lists.html @@ -0,0 +1,57 @@ + + + + + +Data-directed Destructuring by Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Macro Lambda Lists  

    +
    +
    +

    3.4.4.2 Data-directed Destructuring by Lambda Lists

    + +

    In data-directed destructuring, +the pattern is a sample object of the type to be decomposed. +Wherever a component is to be extracted, +a symbol appears in the pattern; +this symbol is the name of the variable whose value will be that component. +

    + + + + + diff --git a/info/gcl/Debugging-Utilities.html b/info/gcl/Debugging-Utilities.html new file mode 100644 index 0000000..39773e5 --- /dev/null +++ b/info/gcl/Debugging-Utilities.html @@ -0,0 +1,65 @@ + + + + + +Debugging Utilities (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The External Environment  

    +
    +
    +

    25.1.2 Debugging Utilities

    + +

    Figure 25–2 shows defined names relating to +debugging. +

    +
    +
      *debugger-hook*  documentation    step     
+  apropos          dribble          time     
+  apropos-list     ed               trace    
+  break            inspect          untrace  
+  describe         invoke-debugger           
+
+  Figure 25–2: Defined names relating to debugging
+
+
    + + + + + + diff --git a/info/gcl/Declaration-Identifiers.html b/info/gcl/Declaration-Identifiers.html new file mode 100644 index 0000000..96d004f --- /dev/null +++ b/info/gcl/Declaration-Identifiers.html @@ -0,0 +1,81 @@ + + + + + +Declaration Identifiers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Declarations  

    +
    +
    +

    3.3.3 Declaration Identifiers

    + +

    Figure 3–9 shows a list of all +declaration identifiers + +

    +

    defined by this standard. +

    +
    +
      declaration     ignore     special  
+  dynamic-extent  inline     type     
+  ftype           notinline           
+  ignorable       optimize            
+
+  Figure 3–9: Common Lisp Declaration Identifiers
+
+
    + +

    An implementation is free to support other (implementation-defined) +declaration identifiers as well. +A warning might be issued +if a declaration identifier +is not among those defined above, +is not defined by the implementation, +is not a type name, +and has not been declared in a declaration proclamation. +

    + + +
    • Shorthand notation for Type Declarations   +
    + + + + + + diff --git a/info/gcl/Declaration-Scope.html b/info/gcl/Declaration-Scope.html new file mode 100644 index 0000000..73da4b1 --- /dev/null +++ b/info/gcl/Declaration-Scope.html @@ -0,0 +1,123 @@ + + + + + +Declaration Scope (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Declarations  

    +
    +
    +

    3.3.4 Declaration Scope

    + +

    Declarations can be divided into two kinds: those that apply to the +bindings of variables or functions; and those that +do not apply to bindings. +

    +

    A declaration that appears at the head of a binding form +and applies to a variable or function binding +made by that form is called a bound declaration + +; +such a declaration affects both the binding and +any references within the scope of the declaration. +

    +

    Declarations that are not bound declarations are called +free declarations + +. +

    +

    A free declaration in a form F1 that applies to a binding +for a name N established by some form F2 +of which F1 is a subform +affects only references to N within F1; it does not to apply to +other references to N outside of F1, nor does it affect the manner +in which the binding of N by F2 is established. +

    +

    Declarations that do not apply to bindings can only appear +as free declarations. +

    +

    The scope of a bound declaration is the same as the +lexical scope +of the binding to which it applies; +for special variables, +this means the scope that the binding +would have had had it been a lexical binding. +

    +

    Unless explicitly stated otherwise, the scope of a +free declaration includes only the body subforms of +the form at whose head it appears, and no other subforms. +The scope of free declarations specifically does not +include initialization forms for bindings established +by the form containing the declarations. +

    +

    Some iteration forms include step, end-test, or result +subforms that are also included in the scope +of declarations that appear in the iteration form. +Specifically, the iteration forms and subforms involved +are: +

    +
    +
    *
    +

    do, do*: + step-forms, end-test-form, and result-forms. +

    +
    *
    +

    dolist, dotimes: + result-form +

    +
    *
    +

    do-all-symbols, do-external-symbols, do-symbols: + result-form +

    +
    + + + +
    • Examples of Declaration Scope   +
    + +
    +
    +

    +Previous: , Up: Declarations  

    +
    + + + + + diff --git a/info/gcl/Declaration-Specifiers.html b/info/gcl/Declaration-Specifiers.html new file mode 100644 index 0000000..d9f077b --- /dev/null +++ b/info/gcl/Declaration-Specifiers.html @@ -0,0 +1,60 @@ + + + + + +Declaration Specifiers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Declarations  

    +
    +
    +

    3.3.2 Declaration Specifiers

    + +

    A declaration specifier + + is an expression that can appear at +top level of a declare expression or a declaim form, or as +the argument to proclaim. +It is a list whose car is a declaration identifier, +and whose cdr is data interpreted according to rules specific to +the declaration identifier. +

    + + + + + diff --git a/info/gcl/Declarations.html b/info/gcl/Declarations.html new file mode 100644 index 0000000..6368778 --- /dev/null +++ b/info/gcl/Declarations.html @@ -0,0 +1,87 @@ + + + + + +Declarations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.3 Declarations

    + + +

    Declarations + + provide a way of specifying information for use by +program processors, such as the evaluator or the compiler. +

    +

    Local declarations + +

    +

    can be embedded in executable code using declare. +Global declarations + +, +or proclamations + +, +are established by proclaim or declaim. +

    +

    The the special form provides a shorthand notation for +making a local declaration about the type of the +value of a given form. +

    +

    The consequences are undefined if a program violates a declaration +or a proclamation. +

    + + + + + +
    • Minimal Declaration Processing Requirements   +
    • Declaration Specifiers   +
    • Declaration Identifiers   +
    • Declaration Scope   +
    + + + + + + diff --git a/info/gcl/Declarative-Method-Combination.html b/info/gcl/Declarative-Method-Combination.html new file mode 100644 index 0000000..f14889e --- /dev/null +++ b/info/gcl/Declarative-Method-Combination.html @@ -0,0 +1,63 @@ + + + + + +Declarative Method Combination (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    +
    +

    7.6.6.6 Declarative Method Combination

    + +

    The macro define-method-combination defines new forms of method +combination. It provides a mechanism for customizing the production +of the effective method. The default procedure for producing an +effective method is described in Determining the Effective Method. +There are two forms of +define-method-combination. The short form is a simple facility while +the long form is more powerful and more verbose. The long form +resembles defmacro in that the body is an expression that +computes a Lisp form; it provides mechanisms for implementing +arbitrary control structures within method combination and for +arbitrary processing of method qualifiers. +

    + + + + + diff --git a/info/gcl/Declaring-the-Validity-of-Initialization-Arguments.html b/info/gcl/Declaring-the-Validity-of-Initialization-Arguments.html new file mode 100644 index 0000000..96459de --- /dev/null +++ b/info/gcl/Declaring-the-Validity-of-Initialization-Arguments.html @@ -0,0 +1,140 @@ + + + + + +Declaring the Validity of Initialization Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    +
    +

    7.1.2 Declaring the Validity of Initialization Arguments

    + +

    Initialization arguments are checked for validity in each of the four +situations that use them. An initialization argument may be valid in +one situation and not another. For example, the system-supplied +primary method for make-instance defined for +the class standard-class checks the validity of its initialization arguments +and signals an error if an initialization argument is supplied that is +not declared as valid in that situation. +

    +

    There are two means for declaring initialization arguments valid. +

    +
    +
    *
    +

    Initialization arguments that fill slots are declared as valid +by the :initarg slot option to defclass. The +:initarg slot option is inherited from superclasses. Thus +the set of valid initialization arguments that fill slots for a +class is the union of the initialization arguments that fill +slots declared as valid by that class and its +superclasses. Initialization arguments that fill slots +are valid in all four contexts. +

    +
    +
    *
    +

    Initialization arguments that supply arguments to methods are +declared as valid by defining those methods. The keyword name of +each keyword parameter specified in the method’s +lambda list becomes an initialization argument for all classes +for which the method is applicable. +

    +

    The presence of &allow-other-keys in the +lambda list of an applicable method disables validity checking of +initialization arguments. +

    +

    Thus method inheritance +controls the set of valid initialization arguments that supply arguments +to methods. The generic functions for which method +definitions serve to declare initialization arguments valid are as +follows: +

    +
    –
    +

    Making an instance of a class: +allocate-instance, initialize-instance, and +shared-initialize. Initialization arguments declared as valid +by these methods are valid when making +an instance of a class. +

    +
    +
    –
    +

    Re-initializing an instance: +reinitialize-instance and shared-initialize. +Initialization arguments declared as valid by these methods are +valid when re-initializing an instance. +

    +
    +
    –
    +

    Updating an instance to conform to a redefined class: +update-instance-for-redefined-class and shared-initialize. +Initialization arguments declared as valid by these methods are +valid when updating an instance to conform to a redefined class. +

    +
    +
    –
    +

    Updating an instance to conform to the definition of a +different class: +update-instance-for-different-class and shared-initialize. +Initialization arguments declared as valid by these methods are +valid when updating an instance to conform to the definition +of a different class. +

    +
    +
    + +
    +
    + +

    The set of valid initialization arguments for a class is the set of +valid initialization arguments that either fill slots or supply +arguments to methods, along with the predefined initialization +argument :allow-other-keys. The default value for +:allow-other-keys is nil. +

    +

    Validity checking of initialization arguments is disabled if the value of +the initialization argument :allow-other-keys is true. +

    +
    +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    + + + + + diff --git a/info/gcl/Decoded-Time.html b/info/gcl/Decoded-Time.html new file mode 100644 index 0000000..f2cb5fa --- /dev/null +++ b/info/gcl/Decoded-Time.html @@ -0,0 +1,117 @@ + + + + + +Decoded Time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Time  

    +
    +
    +

    25.1.4.1 Decoded Time

    + +

    A decoded time + + is an ordered series of nine values that, taken together, +represent a point in calendar time (ignoring leap seconds): +

    +
    +
    Second
    +

    An integer between 0 and~59, inclusive. +

    +
    +
    Minute
    +

    An integer between 0 and~59, inclusive. +

    +
    +
    Hour
    +

    An integer between 0 and~23, inclusive. +

    +
    +
    Date
    +

    An integer between 1 and~31, inclusive (the upper limit actually +depends on the month and year, of course). +

    +
    +
    Month
    +

    An integer between 1 and 12, inclusive; +1~means January, 2~means February, and so on; 12~means December. +

    +
    +
    Year
    +

    An integer indicating the year A.D. However, if this +integer +is between 0 and 99, the “obvious” year is used; more precisely, +that year is assumed that is equal to the +integer modulo 100 and +within fifty years of the current year (inclusive backwards +and exclusive forwards). +Thus, in the year 1978, year 28 is 1928 +but year 27 is 2027. (Functions that return time in this format always return +a full year number.) +

    +
    +
    Day of week
    +

    An integer between~0 and~6, inclusive; +0~means Monday, 1~means Tuesday, and so on; 6~means Sunday. +

    +
    +
    Daylight saving time flag
    +

    A generalized boolean that, +if true, indicates that daylight saving time is in effect. +

    +
    +
    Time zone
    +

    A time zone. +

    +
    +
    + +

    Figure 25–5 shows defined names relating to decoded time. +

    +
    +
      decode-universal-time  get-decoded-time  
+
+  Figure 25–5: Defined names involving time in Decoded Time.
+
+
    + + + + + + diff --git a/info/gcl/Default-Print_002dObject-Methods.html b/info/gcl/Default-Print_002dObject-Methods.html new file mode 100644 index 0000000..2bab6ed --- /dev/null +++ b/info/gcl/Default-Print_002dObject-Methods.html @@ -0,0 +1,99 @@ + + + + + +Default Print-Object Methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Lisp Printer  

    +
    +
    +

    22.1.3 Default Print-Object Methods

    + +

    This section describes the default behavior of +print-object methods for the standardized types. +

    + + + + + + + + + + + + + + + + + + + + + + +
    • Printing Numbers   +
    • Printing Integers   +
    • Printing Ratios   +
    • Printing Floats   +
    • Printing Complexes   +
    • Note about Printing Numbers   +
    • Printing Characters   +
    • Printing Symbols   +
    • Package Prefixes for Symbols   +
    • Effect of Readtable Case on the Lisp Printer   +
    • Examples of Effect of Readtable Case on the Lisp Printer   +
    • Printing Strings   +
    • Printing Lists and Conses   +
    • Printing Bit Vectors   +
    • Printing Other Vectors   +
    • Printing Other Arrays   +
    • Examples of Printing Arrays   +
    • Printing Random States   +
    • Printing Pathnames   +
    • Printing Structures   +
    • Printing Other Objects   +
    + + + + + + diff --git a/info/gcl/Defaulting-of-Initialization-Arguments.html b/info/gcl/Defaulting-of-Initialization-Arguments.html new file mode 100644 index 0000000..380fa11 --- /dev/null +++ b/info/gcl/Defaulting-of-Initialization-Arguments.html @@ -0,0 +1,121 @@ + + + + + +Defaulting of Initialization Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    +
    +

    7.1.3 Defaulting of Initialization Arguments

    + +

    A default value form can be supplied for an initialization +argument by using the :default-initargs class option. If an +initialization argument is declared valid by some particular class, +its default value form might be specified by a different class. +In this case :default-initargs is used to supply a default value +for an inherited initialization argument. +

    +

    The :default-initargs option is used only to provide default +values for initialization arguments; it does not declare a symbol +as a valid initialization argument name. Furthermore, +the :default-initargs option is used only to provide default values for +initialization arguments when making an instance. +

    +

    The argument to the :default-initargs class +option is a list of +alternating initialization argument names and forms. +Each form is the +default value form for the corresponding initialization +argument. The default value form of an initialization +argument is used and evaluated only if that initialization argument +does not appear in the arguments to make-instance and is not +defaulted by a more specific class. The default value form is +evaluated in the lexical environment of the defclass form that +supplied it; the resulting value is used as the initialization +argument’s value. +

    +

    The initialization arguments supplied to make-instance are combined +with defaulted initialization arguments to produce a +defaulted initialization argument list. A +defaulted initialization argument list +is a list of alternating initialization argument names and +values in which unsupplied initialization arguments are defaulted and in +which the explicitly supplied initialization arguments appear earlier in +the list than the defaulted initialization arguments. Defaulted +initialization arguments are ordered according to the order in the +class precedence list of the classes that supplied the default values. +

    +

    There is a distinction between the purposes of the +:default-initargs and the :initform options with respect to the +initialization of slots. The :default-initargs +class option +provides a mechanism for the user to give a default value form +for an initialization argument without knowing whether the +initialization argument initializes a slot +or is passed to a method. +If that initialization argument is not explicitly supplied in a call +to make-instance, the default value form is used, just +as if it had been supplied in the call. In contrast, the +:initform slot option provides a mechanism for the user to give a +default initial value form for a slot. An :initform form is +used to initialize a slot only if no initialization argument +associated with that slot is given as an argument to +make-instance or is defaulted by :default-initargs. +

    + + + + +

    The order of evaluation of default value forms for initialization +arguments and the order of evaluation of :initform forms are +undefined. If the order of evaluation is important, +initialize-instance or shared-initialize methods +should be used +instead. +

    +
    +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    + + + + + diff --git a/info/gcl/Define_002dmethod_002dcombination-Arguments-Lambda-Lists.html b/info/gcl/Define_002dmethod_002dcombination-Arguments-Lambda-Lists.html new file mode 100644 index 0000000..5eef1b5 --- /dev/null +++ b/info/gcl/Define_002dmethod_002dcombination-Arguments-Lambda-Lists.html @@ -0,0 +1,70 @@ + + + + + +Define-method-combination Arguments Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.10 Define-method-combination Arguments Lambda Lists

    + +

    A define-method-combination arguments lambda list + + is used by +the :arguments option to define-method-combination. +

    +

    A define-method-combination arguments lambda list can contain the +lambda list keywords shown in Figure 3–21. +

    +
    +
      &allow-other-keys  &key       &rest   
+  &aux               &optional  &whole  
+
+  Figure 3–21: Lambda List Keywords used by Define-method-combination arguments Lambda Lists
+
+
    + +

    Define-method-combination arguments lambda lists are similar to +ordinary lambda lists, but also permit the use of &whole. +

    + + + + + diff --git a/info/gcl/Define_002dmodify_002dmacro-Lambda-Lists.html b/info/gcl/Define_002dmodify_002dmacro-Lambda-Lists.html new file mode 100644 index 0000000..0e1e6c7 --- /dev/null +++ b/info/gcl/Define_002dmodify_002dmacro-Lambda-Lists.html @@ -0,0 +1,73 @@ + + + + + +Define-modify-macro Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.9 Define-modify-macro Lambda Lists

    + +

    A define-modify-macro lambda list + + is used by +define-modify-macro. +

    +

    A define-modify-macro lambda list can contain the +lambda list keywords shown in Figure 3–20. +

    +
    +
      &optional  &rest  
+
+  Figure 3–20: Lambda List Keywords used by Define-modify-macro Lambda Lists
+
+
    + +

    Define-modify-macro lambda lists are similar to +ordinary lambda lists, but do not support keyword arguments. +define-modify-macro has no need match keyword arguments, and +a rest parameter is sufficient. Aux variables are also +not supported, since define-modify-macro has no body forms +which could refer to such bindings. See the macro define-modify-macro. +

    + + + + + diff --git a/info/gcl/Defining-Classes.html b/info/gcl/Defining-Classes.html new file mode 100644 index 0000000..abefb6d --- /dev/null +++ b/info/gcl/Defining-Classes.html @@ -0,0 +1,131 @@ + + + + + +Defining Classes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Classes  

    +
    +
    +

    4.3.2 Defining Classes

    + +

    The macro defclass is used to define a new named class. +

    +

    The definition of a class includes: +

    +
    +
    *
    +

    The name of the new class. + For newly-defined classes this name is a proper name. +

    +
    +
    *
    +

    The list of the direct superclasses of the new class. +

    +
    +
    *
    +

    A set of slot specifiers + +. + Each slot specifier includes the name of the slot + and zero or more slot options. A slot option pertains + only to a single slot. If a class definition contains + two slot specifiers with the same name, an error is signaled. +

    +
    +
    *
    +

    A set of class options. + Each class option pertains to the class as a whole. +

    +
    +
    + +

    The slot options and class options of +the defclass form provide mechanisms for the following: +

    +
    +
    *
    +

    Supplying a default initial value form +for a given slot. +

    +
    +
    *
    +

    Requesting that methods for generic functions +be automatically generated for reading or writing slots. +

    +
    +
    *
    +

    Controlling whether a given slot is shared by +all instances +of the class or whether each +instance of the class has its own slot. +

    +
    +
    *
    +

    Supplying a set of initialization arguments and initialization +argument defaults to be used in instance creation. +

    +
    +
    *
    +

    Indicating that the metaclass is to be other +than the default. The :metaclass option is reserved for future use; +an implementation can be extended to make use of the :metaclass +option. +

    +
    +
    *
    +

    Indicating the expected type for the value stored +in the slot. +

    +
    +
    *
    +

    Indicating the documentation string for the slot. +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Classes  

    +
    + + + + + diff --git a/info/gcl/Definition-of-Similarity.html b/info/gcl/Definition-of-Similarity.html new file mode 100644 index 0000000..2ec90e5 --- /dev/null +++ b/info/gcl/Definition-of-Similarity.html @@ -0,0 +1,204 @@ + + + + + +Definition of Similarity (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Literal Objects in Compiled Files  

    +
    +
    +

    3.2.4.4 Definition of Similarity

    + +

    Two objects S (in source code) and C (in compiled code) + are defined to be similar if and only if + they are both of one of the types listed here + (or defined by the implementation) + and they both satisfy all additional requirements of similarity + indicated for that type. +

    +
    +
    number
    +

    Two numbers S and C are similar if they are of the same type +and represent the same mathematical value. +

    +
    +
    character
    +

    Two simple characters S and C are similar +if they have similar code attributes. +

    +

    Implementations providing additional, implementation-defined +attributes must define whether and how non-simple characters +can be regarded as similar. +

    +
    +
    symbol
    +

    Two apparently uninterned symbols S and C are similar +if their +names +are similar. +

    +

    Two interned symbols S and C are similar +if their names are similar, +and if either S is accessible in the current package at compile time + and C is accessible in the current package at load time, + or C is accessible in the package that is similar to + the home package of S. +

    +

    (Note that similarity of +symbols is dependent +on neither the current readtable nor how the function read would +parse the characters in the name of the symbol.) +

    +
    +
    package
    +

    Two packages S and C are similar if their names are similar. +

    +

    Note that although a package object is an externalizable object, +the programmer is responsible for ensuring that the corresponding package is +already in existence when code referencing it as a literal object +is loaded. The loader finds the corresponding package object +as if by calling find-package with that name as an argument. +An error is signaled by the loader if no package exists at load time. +

    +
    +
    random-state
    +

    Two random states S and C are similar if S +would always produce the same sequence of pseudo-random numbers +as a copy_5 of C +when given as the random-state argument to the function random, +assuming equivalent limit arguments in each case. +

    +

    (Note that since C has been processed by the file compiler, +it cannot be used directly as an argument to random +because random would perform a side effect.) +

    +
    +
    cons
    +

    Two conses, S and C, are similar if + the car_2 of S is similar to the car_2 of C, +and the cdr_2 of S is similar to the cdr_2 of C. +

    +
    +
    array
    +

    Two one-dimensional arrays, S and C, are similar if + the length of S is similar to the length of C, + the actual array element type of S is similar to + the actual array element type of C, + and each active element of S is similar to + the corresponding element of C. +

    +

    Two arrays of rank other than one, S and C, are similar if + the rank of S is similar to the rank of C, + each dimension_1 of S is similar to + the corresponding dimension_1 of C, + the actual array element type of S is similar to + the actual array element type of C, + and each element of S is similar to + the corresponding element of C. +

    +

    In addition, +if S is a simple array, then C must also be a simple array. +If S is a displaced array, + has a fill pointer, + or is actually adjustable, +C is permitted to lack any or all of these qualities. +

    +
    +
    hash-table
    +

    Two hash tables S and C are similar if they meet the following +three requirements: +

    +
    +
    1.
    +

    They both have the same test + (e.g., they are both eql hash tables). +

    +
    +
    2.
    +

    There is a unique one-to-one correspondence between the keys of + the two hash tables, such that the corresponding keys are + similar. +

    +
    +
    3.
    +

    For all keys, the values associated with two corresponding keys + are similar. +

    +
    + +

    If there is more than one possible one-to-one correspondence between +the keys of S and C, the consequences are unspecified. +A conforming program cannot use a table such as S as an +externalizable constant. +

    +
    +
    pathname
    +

    Two pathnames S and C are similar if all corresponding +pathname components are similar. +

    +
    +
    function
    +
    +

    Functions are not externalizable objects. +

    +
    +
    structure-object and standard-object
    +
    +

    A general-purpose concept of similarity does not exist for structures +and standard objects. +However, a conforming program is permitted to define a make-load-form +method for any class K defined by that program that is +a subclass of either structure-object or standard-object. +The effect of such a method is to define that an object S of type K +in source code is similar to an object C of type K +in compiled code if C was constructed from code produced by +calling make-load-form on S. +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Literal Objects in Compiled Files  

    +
    + + + + + diff --git a/info/gcl/Definitions-of-Make_002dInstance-and-Initialize_002dInstance.html b/info/gcl/Definitions-of-Make_002dInstance-and-Initialize_002dInstance.html new file mode 100644 index 0000000..b1c03ad --- /dev/null +++ b/info/gcl/Definitions-of-Make_002dInstance-and-Initialize_002dInstance.html @@ -0,0 +1,103 @@ + + + + + +Definitions of Make-Instance and Initialize-Instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Object Creation and Initialization  

    +
    +
    +

    7.1.7 Definitions of Make-Instance and Initialize-Instance

    + +

    The generic function make-instance behaves as if it were defined as +follows, except that certain optimizations are permitted: +

    +
    +
     (defmethod make-instance ((class standard-class) &rest initargs)
+   ...
+   (let ((instance (apply #'allocate-instance class initargs)))
+     (apply #'initialize-instance instance initargs)
+     instance))
+
+ (defmethod make-instance ((class-name symbol) &rest initargs)
+   (apply #'make-instance (find-class class-name) initargs))
+
    + +

    The elided code in the definition of make-instance +augments the initargs with any defaulted initialization arguments and +checks the +resulting +initialization arguments to determine whether an initialization +argument was supplied that neither filled a slot nor supplied an argument +to an applicable method. +

    +

    The generic function initialize-instance behaves as if it were +defined as follows, except that certain optimizations are permitted: +

    +
    +
     (defmethod initialize-instance ((instance standard-object) &rest initargs)
+   (apply #'shared-initialize instance t initargs)))
+
    + +

    These procedures can be customized. +

    +

    Customizing at the Programmer Interface level includes using the +:initform, :initarg, and :default-initargs options to +defclass, as well as defining methods +for make-instance, +allocate-instance, +and initialize-instance. It is also possible to define +methods for shared-initialize, which would be invoked by the +generic functions reinitialize-instance, +update-instance-for-redefined-class, +update-instance-for-different-class, and +initialize-instance. +The meta-object level supports additional +customization. +

    +

    Implementations are permitted to make certain optimizations to +initialize-instance and shared-initialize. +The description of shared-initialize in Chapter~7 mentions the +possible optimizations. +

    + + + + + + diff --git a/info/gcl/Definitions.html b/info/gcl/Definitions.html new file mode 100644 index 0000000..ca9782f --- /dev/null +++ b/info/gcl/Definitions.html @@ -0,0 +1,66 @@ + + + + + +Definitions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.4 Definitions

    + + +

    This section contains notational conventions and definitions of terms +used in this manual. +

    + + + + + +
    • Notational Conventions   +
    • Error Terminology   +
    • Sections Not Formally Part Of This Standard   +
    • Interpreting Dictionary Entries   +
    + + + + + + diff --git a/info/gcl/Defsetf-Lambda-Lists.html b/info/gcl/Defsetf-Lambda-Lists.html new file mode 100644 index 0000000..1c23418 --- /dev/null +++ b/info/gcl/Defsetf-Lambda-Lists.html @@ -0,0 +1,79 @@ + + + + + +Defsetf Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.7 Defsetf Lambda Lists

    + +

    A defsetf lambda list + + is used by defsetf. +

    +

    A defsetf lambda list has the following syntax: +

    +

    lambda-list ::=({var}* +                [&optional {var |         (var [init-form [supplied-p-parameter]])}*] +                [&rest var] +                [&key {var |              ({var |          (keyword-name var)}    [init-form [supplied-p-parameter]])}* pt [&allow-other-keys]] +                [&environment var] +

    +

    A defsetf lambda list can contain the lambda list keywords shown +in Figure 3–19. +

    +
    +
      &allow-other-keys  &key       &rest  
+  &environment       &optional         
+
+  Figure 3–19: Lambda List Keywords used by Defsetf Lambda Lists
+
+
    + +

    A defsetf lambda list differs from an ordinary lambda list +only in that it does not permit the use of &aux, +and that it permits use of &environment, + which introduces an environment parameter. +

    + + + + + diff --git a/info/gcl/Deftype-Lambda-Lists.html b/info/gcl/Deftype-Lambda-Lists.html new file mode 100644 index 0000000..576f740 --- /dev/null +++ b/info/gcl/Deftype-Lambda-Lists.html @@ -0,0 +1,63 @@ + + + + + +Deftype Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.8 Deftype Lambda Lists

    + +

    A deftype lambda list + + is used by deftype. +

    +

    A deftype lambda list has the same syntax as a macro lambda list, +and can therefore contain the lambda list keywords as a macro lambda list. +

    +

    A deftype lambda list differs from a macro lambda list +only in that if no init-form is supplied for an optional parameter +or keyword parameter in the lambda-list, the default value +for that parameter is the symbol * (rather than nil). +

    + + + + + diff --git a/info/gcl/Deprecated-Argument-Conventions.html b/info/gcl/Deprecated-Argument-Conventions.html new file mode 100644 index 0000000..2f8efe6 --- /dev/null +++ b/info/gcl/Deprecated-Argument-Conventions.html @@ -0,0 +1,74 @@ + + + + + +Deprecated Argument Conventions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Deprecated Language Features  

    +
    +
    +

    1.8.2 Deprecated Argument Conventions

    + +

    The ability to pass a numeric argument to gensym has been deprecated. +

    +

    The :test-not argument to the functions in Figure 1–3 are deprecated. +

    +
    +
      adjoin             nset-difference    search            
+  assoc              nset-exclusive-or  set-difference    
+  count              nsublis            set-exclusive-or  
+  delete             nsubst             sublis            
+  delete-duplicates  nsubstitute        subsetp           
+  find               nunion             subst             
+  intersection       position           substitute        
+  member             rassoc             tree-equal        
+  mismatch           remove             union             
+  nintersection      remove-duplicates                    
+
+  Figure 1–3: Functions with Deprecated :TEST-NOT Arguments
+
+
    + +

    The use of the situation names compile, load, and eval +in eval-when is deprecated. +

    + + + + + diff --git a/info/gcl/Deprecated-Functions.html b/info/gcl/Deprecated-Functions.html new file mode 100644 index 0000000..bad752b --- /dev/null +++ b/info/gcl/Deprecated-Functions.html @@ -0,0 +1,64 @@ + + + + + +Deprecated Functions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Deprecated Language Features  

    +
    +
    +

    1.8.1 Deprecated Functions

    + +

    The functions in Figure 1–2 are deprecated. +

    +
      assoc-if-not   nsubst-if-not       require            
+  count-if-not   nsubstitute-if-not  set                
+  delete-if-not  position-if-not     subst-if-not       
+  find-if-not    provide             substitute-if-not  
+  gentemp        rassoc-if-not                          
+  member-if-not  remove-if-not                          
+
+            Figure 1–2: Deprecated Functions           
+
+
    + + + + + + diff --git a/info/gcl/Deprecated-Language-Features.html b/info/gcl/Deprecated-Language-Features.html new file mode 100644 index 0000000..cb3b474 --- /dev/null +++ b/info/gcl/Deprecated-Language-Features.html @@ -0,0 +1,73 @@ + + + + + +Deprecated Language Features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.8 Deprecated Language Features

    + + +

    Deprecated language features are not expected to appear in future Common Lisp +standards, but are required to be implemented for conformance with this +standard; see Required Language Features. +

    +

    Conforming programs can use deprecated features; +however, it is considered good programming style to avoid them. +It is permissible for the compiler to produce style warnings +about the use of such features at compile time, +but there should be no such warnings at program execution time. +

    + + + + + +
    • Deprecated Functions   +
    • Deprecated Argument Conventions   +
    • Deprecated Variables   +
    • Deprecated Reader Syntax   +
    + + + + + + diff --git a/info/gcl/Deprecated-Reader-Syntax.html b/info/gcl/Deprecated-Reader-Syntax.html new file mode 100644 index 0000000..3fc1188 --- /dev/null +++ b/info/gcl/Deprecated-Reader-Syntax.html @@ -0,0 +1,59 @@ + + + + + +Deprecated Reader Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Deprecated Language Features  

    +
    +
    +

    1.8.4 Deprecated Reader Syntax

    + +

    The #S reader macro forces keyword names into the KEYWORD package; +see Sharpsign S. +This feature is deprecated; +in the future, keyword names will be taken in the package they are read in, +so symbols that are actually in the KEYWORD package +should be used if that is what is desired. +

    + + + + + + diff --git a/info/gcl/Deprecated-Variables.html b/info/gcl/Deprecated-Variables.html new file mode 100644 index 0000000..1863a19 --- /dev/null +++ b/info/gcl/Deprecated-Variables.html @@ -0,0 +1,53 @@ + + + + + +Deprecated Variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Deprecated Language Features  

    +
    +
    +

    1.8.3 Deprecated Variables

    + +

    The variable *modules* is deprecated. +

    + + + + + diff --git a/info/gcl/Designators.html b/info/gcl/Designators.html new file mode 100644 index 0000000..9493abc --- /dev/null +++ b/info/gcl/Designators.html @@ -0,0 +1,108 @@ + + + + + +Designators (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.12 Designators

    + +

    A designator + + is an object that denotes another object. +

    +

    Where a parameter of an operator is described as a designator, +the description of the operator is written in a way that assumes that +the value of the parameter is the denoted object; +that is, that the parameter is already of the denoted type. +(The specific nature of the object denoted by + a “<<type>> designator” +or a “designator for a <<type>>” +can be found in the Glossary entry for “<<type>> designator.”) +

    +

    For example, “nil” and “the value of *standard-output*” are operationally +indistinguishable as stream designators. Similarly, +the symbol foo and the string "FOO" +are operationally indistinguishable as string designators. +

    +

    Except as otherwise noted, in a situation where the denoted object +might be used multiple times, it is implementation-dependent +whether the object is coerced only once or whether the coercion occurs +each time the object must be used. +

    +

    For example, mapcar receives a function designator as an argument, +and its description is written as if this were simply a function. In fact, it +is implementation-dependent whether the function designator is +coerced right away or whether it is carried around internally in the form that +it was given as an argument and re-coerced each time it is needed. In most +cases, conforming programs cannot detect the distinction, but there are some +pathological situations (particularly those involving self-redefining or +mutually-redefining functions) which do conform and which can detect this difference. +The following program is a conforming program, but might or might not have +portably correct results, depending on whether its correctness depends on one or +the other of the results: +

    +
    +
     (defun add-some (x) 
+   (defun add-some (x) (+ x 2))
+   (+ x 1)) ⇒  ADD-SOME
+ (mapcar 'add-some '(1 2 3 4))
+⇒  (2 3 4 5)
+OR⇒ (2 4 5 6)
+
    + +

    In a few rare situations, there may be a need in a dictionary entry +to refer to the object that was the original designator +for a parameter. +Since naming the parameter would refer to the denoted object, +the phrase “the <<parameter-name>> designator” +can be used to refer to the designator which was the argument +from which the value of <<parameter-name>> was computed. +

    +
    +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    + + + + + diff --git a/info/gcl/Destructive-Operations.html b/info/gcl/Destructive-Operations.html new file mode 100644 index 0000000..61535f4 --- /dev/null +++ b/info/gcl/Destructive-Operations.html @@ -0,0 +1,59 @@ + + + + + +Destructive Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.7 Destructive Operations

    + + + + + +
    • Modification of Literal Objects   +
    • Transfer of Control during a Destructive Operation   +
    + + + + + + diff --git a/info/gcl/Destructuring-Lambda-Lists.html b/info/gcl/Destructuring-Lambda-Lists.html new file mode 100644 index 0000000..3a92d96 --- /dev/null +++ b/info/gcl/Destructuring-Lambda-Lists.html @@ -0,0 +1,86 @@ + + + + + +Destructuring Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.5 Destructuring Lambda Lists

    + +

    A destructuring lambda list + + is used by destructuring-bind. +

    +

    Destructuring lambda lists are closely related to +macro lambda lists; see Macro Lambda Lists. +A destructuring lambda list can contain all of the +lambda list keywords listed for macro lambda lists +except for &environment, and supports destructuring in the +same way. Inner lambda lists nested within a macro lambda list +have the syntax of destructuring lambda lists. +

    +

    A destructuring lambda list has the following syntax: +

    + +

    reqvars ::={var | !lambda-list}* +

    +

    optvars ::=[&optional {var |         ({var | !lambda-list} [init-form [supplied-p-parameter]])}*] +

    +

    restvar ::=[{&rest | &body} {var | !lambda-list}] +

    +

    keyvars ::=[&key {var |              ({var |          (keyword-name {var | !lambda-list})}    [init-form [supplied-p-parameter]])}* +            [&allow-other-keys]] +

    + +

    auxvars ::=[&aux {var | (var [init-form])}*] +

    +

    envvar ::=[&environment var] +

    +

    wholevar ::=[&whole var] +

    +

    lambda-list ::=(!wholevar !reqvars !optvars !restvar !keyvars !auxvars) | +                (!wholevar !reqvars !optvars . var) +

    + + + + + + diff --git a/info/gcl/Destructuring-Mismatch.html b/info/gcl/Destructuring-Mismatch.html new file mode 100644 index 0000000..08540fe --- /dev/null +++ b/info/gcl/Destructuring-Mismatch.html @@ -0,0 +1,59 @@ + + + + + +Destructuring Mismatch (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.8 Destructuring Mismatch

    + +

    When matching a destructuring lambda list against a form, +the pattern and the form must have compatible tree structure, +as described in Macro Lambda Lists. +

    +

    Otherwise, in a safe call, +an error of type program-error must be signaled; +and in an unsafe call the situation has undefined consequences. +

    + + + + + diff --git a/info/gcl/Destructuring-by-Lambda-Lists.html b/info/gcl/Destructuring-by-Lambda-Lists.html new file mode 100644 index 0000000..23b7d68 --- /dev/null +++ b/info/gcl/Destructuring-by-Lambda-Lists.html @@ -0,0 +1,71 @@ + + + + + +Destructuring by Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Macro Lambda Lists  

    +
    +
    +

    3.4.4.1 Destructuring by Lambda Lists

    + +

    Anywhere in a macro lambda list where a parameter +name can appear, and where ordinary lambda list syntax +(as described in Ordinary Lambda Lists) does not +otherwise allow a list, a destructuring lambda list +can appear in place +of the parameter name. When this is done, then the argument +that would match the parameter is treated as a (possibly dotted) list, +to be used as an argument list for satisfying the +parameters in the embedded lambda list. +This is known as destructuring. +

    +

    Destructuring is the process of decomposing a compound object into +its component parts, using an abbreviated, declarative syntax, rather +than writing it out by hand using the primitive component-accessing +functions. Each component part is bound to a variable. +

    +

    A destructuring operation requires an object to be decomposed, +a pattern that specifies what components are to be extracted, and the names +of the variables whose values are to be the components. +

    + + + + + diff --git a/info/gcl/Destructuring.html b/info/gcl/Destructuring.html new file mode 100644 index 0000000..192ccab --- /dev/null +++ b/info/gcl/Destructuring.html @@ -0,0 +1,185 @@ + + + + + +Destructuring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.15 Destructuring

    + +

    The d-type-spec argument is used for destructuring. +If the +d-type-spec argument consists solely of the type fixnum, +float, t, or nil, the of-type keyword is optional. +The of-type construct is optional in these cases to provide backwards +compatibility; thus, the following two expressions are the same: +

    +
    +
    ;;; This expression uses the old syntax for type specifiers.
+ (loop for i fixnum upfrom 3 ...)
+
+;;; This expression uses the new syntax for type specifiers.
+ (loop for i of-type fixnum upfrom 3 ...)
+
+;; Declare X and Y to be of type VECTOR and FIXNUM respectively.
+ (loop for (x y) of-type (vector fixnum) 
+       in l do ...)
+
    + +

    A type specifier for a destructuring pattern is a tree of +type specifiers with the same shape as the tree of +variable names, with the following exceptions: +

    +
    +
    *
    +

    When aligning the trees, an atom in the +tree of type specifiers that matches a cons +in the variable tree declares the same type for each variable +in the subtree rooted at the cons. +

    +
    +
    *
    +

    A cons in the tree of type specifiers that +matches an atom in the tree of variable names +is a compound type specifer. +

    +
    +
    + +

    Destructuring allows binding of a set of variables to a corresponding +set of values anywhere that a value can normally be bound to a single +variable. During loop expansion, +each variable in the variable list +is matched with the values in the values list. If there are more variables +in the variable list than there are values in the values list, the +remaining variables are given a value of nil. If there are more +values than variables listed, the extra values are discarded. +

    +

    To assign values from a list to the variables a, +b, and c, the for clause could be used to +bind the variable numlist to the +car of the supplied form, +and then another for clause could be used to bind the variables +a, b, and c sequentially. +

    +
    +
    ;; Collect values by using FOR constructs.
+ (loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+       for a of-type integer = (first numlist)
+       and b of-type integer = (second numlist)
+       and c of-type float = (third numlist)
+       collect (list c b a))
+⇒  ((4.0 2 1) (8.3 6 5) (10.4 9 8))
+
    + +

    Destructuring makes this process easier by allowing the variables to +be bound in each loop iteration. +Types can be declared by using a +list of type-spec arguments. If +all the types +are the same, a shorthand destructuring syntax can be used, as the second +example illustrates. +

    +
    +
    ;; Destructuring simplifies the process.
+ (loop for (a b c) of-type (integer integer float) in
+       '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+       collect (list c b a))
+⇒  ((4.0 2 1) (8.3 6 5) (10.4 9 8))
+
+;; If all the types are the same, this way is even simpler.
+ (loop for (a b c) of-type float in
+       '((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4))
+       collect (list c b a))
+⇒  ((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0))
+
    + +

    If destructuring is used to declare or initialize a number of groups +of variables into types, the loop keyword and can be used +to simplify the process further. +

    +
    +
    ;; Initialize and declare variables in parallel by using the AND construct.\kern-7pt
+ (loop with (a b) of-type float = '(1.0 2.0)
+       and (c d) of-type integer = '(3 4)
+       and (e f)
+       return (list a b c d e f))
+⇒  (1.0 2.0 3 4 NIL NIL)
+
    + +

    If nil is used in a destructuring list, no variable is provided for +its place. +

    +
    +
     (loop for (a nil b) = '(1 2 3)
+       do (return (list a b)))
+⇒  (1 3)
+
    + +

    Note that +dotted lists +can specify destructuring. +

    +
    +
     (loop for (x . y) = '(1 . 2)
+       do (return y))
+⇒  2
+ (loop for ((a . b) (c . d)) of-type ((float . float) (integer . integer)) in
+       '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
+       collect (list a b c d))
+⇒  ((1.2 2.4 3 4) (3.4 4.6 5 6))
+
    + +

    An error of type program-error is signaled (at macro expansion time) +if the same variable is bound twice in any variable-binding +clause of a single loop expression. Such variables include +local variables, iteration control variables, and variables found by +destructuring. +

    +
    +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    + + + + + diff --git a/info/gcl/Determining-the-Class-Precedence-List.html b/info/gcl/Determining-the-Class-Precedence-List.html new file mode 100644 index 0000000..7e503e5 --- /dev/null +++ b/info/gcl/Determining-the-Class-Precedence-List.html @@ -0,0 +1,111 @@ + + + + + +Determining the Class Precedence List (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Classes  

    +
    +
    +

    4.3.5 Determining the Class Precedence List

    + +

    The defclass form for a class provides a total ordering +on that class and its direct superclasses. This ordering is +called the local precedence order + +. It is an ordered list of the +class and its direct superclasses. The +class precedence list + + for a class C is a total ordering on +C and its superclasses that is consistent with the +local precedence orders for each of C and its superclasses. +

    +

    A class precedes its direct superclasses, +and a direct superclass precedes all other +direct superclasses specified to its right +in the superclasses list of the defclass form. +For every class C, define +

    R_C={(C,C_1),(C_1,C_2),...,(C_{n-1},C_n)} +

    where C_1,...,C_n are +the direct superclasses of C in the order in which +they are mentioned in the defclass form. These ordered pairs +generate the total ordering on the class C and its direct +superclasses. +

    +

    Let S_C be the set of C and its superclasses. Let R be +

    +
    R=\bigcup_{c\in S_C }R_c +

    . +

    +

    [Reviewer Note by Barmar: “Consistent” needs to be defined, or maybe we should say +“logically consistent”?] +

    +

    The set R might or might not generate a partial ordering, depending on +whether the R_c, c\in S_C, are +consistent; it is assumed +that they are consistent and that R generates a partial ordering. +When the R_c are not consistent, it is said that R is inconsistent. +

    +

    To compute the class precedence list for~C, +topologically sort the elements of S_C with respect to the +partial ordering generated by R. When the topological +sort must select a class from a set of two or more +classes, none of +which are preceded by other classes with respect to~R, +the class selected is chosen deterministically, as described below. +

    +

    If R is inconsistent, an error is signaled. +

    + + + +
    • Topological Sorting   +
    • Examples of Class Precedence List Determination   +
    + +
    +
    +

    +Next: , Previous: , Up: Classes  

    +
    + + + + + diff --git a/info/gcl/Determining-the-Effective-Method.html b/info/gcl/Determining-the-Effective-Method.html new file mode 100644 index 0000000..28e9c65 --- /dev/null +++ b/info/gcl/Determining-the-Effective-Method.html @@ -0,0 +1,70 @@ + + + + + +Determining the Effective Method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    +
    +

    7.6.6.1 Determining the Effective Method

    + +

    The effective method is determined by the following three-step procedure: +

    +
    +
    1.
    +

    Select the applicable methods. +

    +
    +
    2.
    +

    Sort the applicable methods by precedence order, putting +the most specific method first. +

    +
    +
    3.
    +

    Apply method combination to the sorted list of +applicable methods, producing the effective method. +

    +
    +
    + + + + + + diff --git a/info/gcl/Dictionary-Entries-for-Type-Specifiers.html b/info/gcl/Dictionary-Entries-for-Type-Specifiers.html new file mode 100644 index 0000000..c89807a --- /dev/null +++ b/info/gcl/Dictionary-Entries-for-Type-Specifiers.html @@ -0,0 +1,73 @@ + + + + + +Dictionary Entries for Type Specifiers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.6 Dictionary Entries for Type Specifiers

    + +

    The atomic type specifiers are those defined names +listed in Figure~4–2. +Such dictionary entries are of kind +“Class,” “Condition Type,” “System Class,” or “Type.” +A description of how to interpret +a symbol naming one of these types or classes +as an atomic type specifier +is found in The "Description" Section of such dictionary entries. +

    +

    The compound type specifiers are those defined names +listed in Figure~4–3. +Such dictionary entries are of kind “Class,” “System Class,” +“Type,” or “Type Specifier.” +A description of how to interpret as a compound type specifier +a list whose car is such a symbol +is found in the + “Compound Type Specifier Kind,” + “Compound Type Specifier Syntax,” + “Compound Type Specifier Arguments,” + and “Compound Type Specifier Description” +sections of such dictionary entries. +

    + + + + + diff --git a/info/gcl/Digits-in-a-Radix.html b/info/gcl/Digits-in-a-Radix.html new file mode 100644 index 0000000..0c92b8e --- /dev/null +++ b/info/gcl/Digits-in-a-Radix.html @@ -0,0 +1,69 @@ + + + + + +Digits in a Radix (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.10 Digits in a Radix

    + +

    What qualifies as a digit depends on the radix +(an integer between 2 and 36, inclusive). +The potential digits are: +

    +

    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 +

    +

    Their respective weights are 0, 1, 2, ... 35. +In any given radix n, only the first n potential digits +are considered to be digits. +For example, +the digits in radix 2 are 0 and 1, +the digits in radix 10 are 0 through 9, and +the digits in radix 16 are 0 through F. +

    +

    Case is not significant in digits; +for example, in radix 16, both F and f +are digits with weight 15. +

    + + + + + diff --git a/info/gcl/Directory-Components-in-Non_002dHierarchical-File-Systems.html b/info/gcl/Directory-Components-in-Non_002dHierarchical-File-Systems.html new file mode 100644 index 0000000..a671cb1 --- /dev/null +++ b/info/gcl/Directory-Components-in-Non_002dHierarchical-File-Systems.html @@ -0,0 +1,58 @@ + + + + + +Directory Components in Non-Hierarchical File Systems (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.16 Directory Components in Non-Hierarchical File Systems

    + +

    In non-hierarchical file systems, +the only valid list values for the directory component of a pathname +are (:absolute string) and (:absolute :wild). +:relative directories and the keywords +:wild-inferiors, :up, and :back are not used +in non-hierarchical file systems. +

    + + + + + diff --git a/info/gcl/Documentation-of-Extensions.html b/info/gcl/Documentation-of-Extensions.html new file mode 100644 index 0000000..3f0d553 --- /dev/null +++ b/info/gcl/Documentation-of-Extensions.html @@ -0,0 +1,58 @@ + + + + + +Documentation of Extensions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conforming Implementations  

    +
    +
    +

    1.5.1.3 Documentation of Extensions

    + +

    A conforming implementation shall be accompanied by a +document that separately describes any features accepted by the +implementation that are not specified in this standard, but that do not +cause any ambiguity or contradiction when added to the language +standard. Such extensions shall be described as being “extensions to +Common Lisp as specified by ANSI <<standard number>>.” +

    + + + + + diff --git a/info/gcl/Documentation-of-Implementation_002dDefined-Scripts.html b/info/gcl/Documentation-of-Implementation_002dDefined-Scripts.html new file mode 100644 index 0000000..76dc024 --- /dev/null +++ b/info/gcl/Documentation-of-Implementation_002dDefined-Scripts.html @@ -0,0 +1,98 @@ + + + + + +Documentation of Implementation-Defined Scripts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.10 Documentation of Implementation-Defined Scripts

    + +

    An implementation must document the character scripts + it supports. For each character script supported, + the documentation must describe at least the following: +

    +
    *
    +

    Character labels, glyphs, and descriptions. + Character labels must be uniquely named using only Latin capital letters A–Z, + hyphen (-), and digits 0–9. +

    +
    *
    +

    Reader canonicalization. + Any mechanisms by which read treats + different characters as equivalent must be documented. +

    +
    *
    +

    The impact on char-upcase, + char-downcase, + and the case-sensitive format directives. + In particular, for each character with case, + whether it is uppercase or lowercase, + and which character is its equivalent in the opposite case. +

    +
    *
    +

    The behavior of the case-insensitive functions + char-equal, char-not-equal, + char-lessp, char-greaterp, + char-not-greaterp, and char-not-lessp. +

    +
    *
    +

    The behavior of any character predicates; + in particular, the effects of + alpha-char-p, + lower-case-p, + upper-case-p, + both-case-p, + graphic-char-p, + and + alphanumericp. +

    +
    *
    +

    The interaction with file I/O, in particular, + the supported coded character sets (for example, ISO8859/1-1987) + and external encoding schemes supported are documented. +

    +
    + + + + + + + diff --git a/info/gcl/Documentation-of-Implementation_002dDependent-Features.html b/info/gcl/Documentation-of-Implementation_002dDependent-Features.html new file mode 100644 index 0000000..2ba2696 --- /dev/null +++ b/info/gcl/Documentation-of-Implementation_002dDependent-Features.html @@ -0,0 +1,60 @@ + + + + + +Documentation of Implementation-Dependent Features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conforming Implementations  

    +
    +
    +

    1.5.1.2 Documentation of Implementation-Dependent Features

    + +

    A conforming implementation shall be accompanied by a document +that provides a definition of all implementation-defined +aspects of the language defined by this specification. +

    +

    In addition, a conforming implementation is encouraged (but not required) +to document items in this standard that are identified as +implementation-dependent, although in some cases +such documentation might simply identify the item as “undefined.” +

    + + + + + diff --git a/info/gcl/Double_002dQuote.html b/info/gcl/Double_002dQuote.html new file mode 100644 index 0000000..b329fec --- /dev/null +++ b/info/gcl/Double_002dQuote.html @@ -0,0 +1,87 @@ + + + + + +Double-Quote (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.5 Double-Quote

    + +

    Syntax: "<<text>>" +

    +

    The double-quote is used to begin and end a string. +When a double-quote is encountered, +characters are read from the input stream +and accumulated until another double-quote is encountered. +If a single escape character is seen, +the single escape character is discarded, +the next character is accumulated, and accumulation continues. +The accumulated characters +up to but not including the matching double-quote +are made into a simple string and returned. +

    +

    It is implementation-dependent +which attributes of the accumulated characters are removed in this process. +

    +

    Examples of the use of the double-quote character are in Figure 2–18. +

    +
    +
      "Foo"                      ;A string with three characters in it  
+  ""                         ;An empty string                       
+  "\"APL\\360?\" he cried."  ;A string with twenty characters       
+  "|x| = |-x|"               ;A ten-character string                
+
+          Figure 2–18: Examples of the use of double-quote         
+
+
    + +

    Note that to place a single escape character or a double-quote into a string, +such a character must be preceded by a single escape character. +Note, too, that a multiple escape character need not be quoted by a +single escape character within a string. +

    +

    For information on how the Lisp printer prints strings, +see Printing Strings. +

    + + + + + diff --git a/info/gcl/Dynamic-Control-of-the-Arrangement-of-Output.html b/info/gcl/Dynamic-Control-of-the-Arrangement-of-Output.html new file mode 100644 index 0000000..86778a5 --- /dev/null +++ b/info/gcl/Dynamic-Control-of-the-Arrangement-of-Output.html @@ -0,0 +1,120 @@ + + + + + +Dynamic Control of the Arrangement of Output (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pretty Printer Concepts  

    +
    +
    +

    22.2.1.1 Dynamic Control of the Arrangement of Output

    + +

    The actions of the pretty printer when a piece of output is too +large to fit in the space available can be precisely controlled. +Three concepts underlie +the way these operations work—logical blocks + +, + conditional newlines + +, + and sections + +. +Before proceeding further, it is important to define these terms. +

    +

    The first line of Figure 22–3 shows a schematic piece of output. Each of +the characters in the output is represented by “-”. The positions of +conditional newlines are indicated by digits. The beginnings and ends of +logical blocks are indicated by “<” and “>” respectively. +

    +

    The output as a whole is a logical block and the outermost section. This +section is indicated by the 0’s on the second line of Figure 1. Logical +blocks nested within the output are specified by the macro +pprint-logical-block. Conditional newline positions are specified +by calls to pprint-newline. Each conditional newline defines +two sections (one before it and one after it) and is associated with a +third (the section immediately containing it). +

    +

    The section after a conditional newline consists of: all the output up to, +but not including, (a) the next conditional newline immediately contained +in the same logical block; or if (a) is not applicable, (b) the next +newline that is at a lesser level of nesting in logical blocks; or if (b) +is not applicable, (c) the end of the output. +

    +

    The section before a conditional newline consists of: all the output back +to, but not including, (a) the previous conditional newline that is +immediately contained in the same logical block; or if (a) is not +applicable, (b) the beginning of the immediately containing logical block. +The last four lines in Figure 1 indicate the sections before and after the +four conditional newlines. +

    +

    The section immediately containing a conditional newline is the shortest +section that contains the conditional newline in question. In Figure 22–3, +the first conditional newline is immediately contained in the section +marked with 0’s, the second and third conditional newlines are immediately +contained in the section before the fourth conditional newline, and the +fourth conditional newline is immediately contained in the section after +the first conditional newline. +

    +
    +
     <-1---<--<--2---3->--4-->->
+ 000000000000000000000000000
+ 11 111111111111111111111111
+           22 222
+              333 3333
+        44444444444444 44444
+
    + +

      Figure 22–2: Example of Logical Blocks, Conditional Newlines, and Sections +

    +

    Whenever possible, the pretty printer displays the entire contents of a +section on a single line. However, if the section is too long to fit in +the space available, line breaks are inserted at conditional newline +positions within the section. +

    +
    +
    +

    +Next: , Previous: , Up: Pretty Printer Concepts  

    +
    + + + + + diff --git a/info/gcl/Dynamic-Control-of-the-Lisp-Reader.html b/info/gcl/Dynamic-Control-of-the-Lisp-Reader.html new file mode 100644 index 0000000..c20185a --- /dev/null +++ b/info/gcl/Dynamic-Control-of-the-Lisp-Reader.html @@ -0,0 +1,54 @@ + + + + + +Dynamic Control of the Lisp Reader (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Concepts  

    +
    +
    +

    23.1.1 Dynamic Control of the Lisp Reader

    + +

    Various aspects of the Lisp reader can be controlled dynamically. +See Readtables and Variables that affect the Lisp Reader. +

    + + + + + diff --git a/info/gcl/Dynamic-Environments.html b/info/gcl/Dynamic-Environments.html new file mode 100644 index 0000000..a1edae3 --- /dev/null +++ b/info/gcl/Dynamic-Environments.html @@ -0,0 +1,87 @@ + + + + + +Dynamic Environments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Environments  

    +
    +
    +

    3.1.1.2 Dynamic Environments

    + +

    A dynamic environment + + for evaluation is that part of an +environment that contains bindings whose duration +is bounded by points of establishment and disestablishment +within the execution of the form that +established the binding. +A dynamic environment contains, among other things, the following: +

    +
    +
    *
    +

    bindings for dynamic variables. +

    +
    *
    +

    information about active catch tags. +

    +
    *
    +

    information about exit points established by unwind-protect. +

    +
    *
    +

    information about active handlers and restarts. +

    +
    + +

    The dynamic environment that is active at any given point +in the execution of a program is referred to by +definite reference as “the current dynamic environment,” +or sometimes as just “the dynamic environment.” +

    +

    Within a given namespace, +a name is said to be bound +in a dynamic environment if there is a binding +associated with its name in the dynamic environment +or, if not, there is a binding +associated with its name in the global environment. +

    + + + + + diff --git a/info/gcl/Dynamic-Variables.html b/info/gcl/Dynamic-Variables.html new file mode 100644 index 0000000..fce6c82 --- /dev/null +++ b/info/gcl/Dynamic-Variables.html @@ -0,0 +1,100 @@ + + + + + +Dynamic Variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.4 Dynamic Variables

    + +

    A variable is a dynamic variable if one of the following +conditions hold: +

    +
    +
    *
    +

    It is locally declared or globally proclaimed special. +

    +
    +
    *
    +

    It occurs textually within a form that +creates a dynamic binding for a variable of the same name, +and the binding is not shadowed_2 by a form +that creates a lexical binding of the same variable name. +

    +
    +
    + +

    A dynamic variable can be referenced at any time in any program; +there is no textual limitation on references to dynamic variables. +At any given time, all dynamic variables with a given name refer to +exactly one binding, either in the dynamic environment +or in the global environment. +

    +

    The value part of the binding for a dynamic variable might +be empty; in this case, the dynamic variable is said to have no value, +or to be unbound. A dynamic variable can be made unbound +by using makunbound. +

    +

    The effect of binding a dynamic variable is to create +a new binding to which all references to that dynamic variable +in any program refer for the duration of the evaluation of the form +that creates the dynamic binding. +

    +

    A dynamic variable can be referenced outside the dynamic extent of +a form that binds it. Such a variable is sometimes called +a “global variable” but is still in all respects just a dynamic variable +whose binding happens to exist in the global environment rather than in some +dynamic environment. +

    +

    A dynamic variable is unbound +unless and until explicitly assigned a value, except for +those variables whose initial value is +defined in this specification or by an implementation. +

    +
    +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    + + + + + diff --git a/info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Printer.html b/info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Printer.html new file mode 100644 index 0000000..9b5f5cc --- /dev/null +++ b/info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Printer.html @@ -0,0 +1,118 @@ + + + + + +Effect of Readtable Case on the Lisp Printer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.10 Effect of Readtable Case on the Lisp Printer

    + +

    When +printer escaping is disabled, +or the characters under consideration are not already +quoted specifically by single escape or multiple escape +syntax, +

    +

    the readtable case of the current readtable +affects the way the Lisp printer writes symbols +in the following ways: +

    +
    +
    :upcase
    +

    When the readtable case is :upcase, + uppercase characters + are printed in the case specified by *print-case*, and + lowercase characters are printed in their own case. +

    +
    +
    :downcase
    +

    When the readtable case is :downcase, + uppercase characters are printed in their own case, and + lowercase characters + are printed in the case specified by *print-case*. +

    +
    +
    :preserve
    +

    When the readtable case is :preserve, + all alphabetic characters are printed in their own case. +

    +
    +
    :invert
    +

    When the readtable case is :invert, + the case of all alphabetic characters + in single case symbol names is inverted. + Mixed-case symbol names are printed as is. +

    +
    + +

    The rules for escaping alphabetic characters in symbol names are affected by +the readtable-case +

    +

    if printer escaping is enabled. +

    +

    Alphabetic characters are escaped as follows: +

    +
    :upcase
    +

    When the readtable case is :upcase, +all lowercase characters must be escaped. +

    +
    +
    :downcase
    +

    When the readtable case is :downcase, +all uppercase characters must be escaped. +

    +
    +
    :preserve
    +

    When the readtable case is :preserve, +no alphabetic characters need be escaped. +

    +
    +
    :invert
    +

    When the readtable case is :invert, +no alphabetic characters need be escaped. +

    +
    +
    + + + + + + diff --git a/info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Reader.html b/info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Reader.html new file mode 100644 index 0000000..09e0cbc --- /dev/null +++ b/info/gcl/Effect-of-Readtable-Case-on-the-Lisp-Reader.html @@ -0,0 +1,84 @@ + + + + + +Effect of Readtable Case on the Lisp Reader (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Concepts  

    +
    +
    +

    23.1.2 Effect of Readtable Case on the Lisp Reader

    + +

    The readtable case of the current readtable affects the Lisp reader +in the following ways: +

    +
    +
    :upcase
    +

    When the readtable case is :upcase, + unescaped constituent characters are converted to uppercase, + as specified in Reader Algorithm. +

    +
    +
    :downcase
    +

    When the readtable case is :downcase, + unescaped constituent characters are converted to lowercase. +

    +
    +
    :preserve
    +

    When the readtable case is :preserve, + the case of all characters remains unchanged. +

    +
    +
    :invert
    +

    When the readtable case is :invert, + then if all of the unescaped letters in the extended token are of the same case, + those (unescaped) letters are converted to the opposite case. +

    +
    +
    + + + +
    • Examples of Effect of Readtable Case on the Lisp Reader   +
    + + + + + + diff --git a/info/gcl/Embedded-Newlines-in-Condition-Reports.html b/info/gcl/Embedded-Newlines-in-Condition-Reports.html new file mode 100644 index 0000000..f35e197 --- /dev/null +++ b/info/gcl/Embedded-Newlines-in-Condition-Reports.html @@ -0,0 +1,81 @@ + + + + + +Embedded Newlines in Condition Reports (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printing Conditions  

    +
    +
    +

    9.1.3.4 Embedded Newlines in Condition Reports

    + +

    Especially if it is long, it is permissible and appropriate for +a report message to contain one or more embedded newlines. +

    +

    If the calling routine conventionally inserts some additional prefix +(such as “Error: ” or “;; Error: ”) on the first line of +the message, it must also assure that an appropriate prefix will be +added to each subsequent line of the output, so that the left edge of +the message output by the condition reporter will still be properly +aligned. +

    +
    +
     (defun test ()
+   (error "This is an error message.~%It has two lines."))
+
+ ;; Implementation A
+ (test)
+ This is an error message.
+ It has two lines.
+
+ ;; Implementation B
+ (test)
+ ;; Error: This is an error message.
+ ;;        It has two lines.
+
+ ;; Implementation C
+ (test)
+ >> Error: This is an error message. 
+           It has two lines.
+
    + + + + + + diff --git a/info/gcl/Environment-Dictionary.html b/info/gcl/Environment-Dictionary.html new file mode 100644 index 0000000..705858e --- /dev/null +++ b/info/gcl/Environment-Dictionary.html @@ -0,0 +1,115 @@ + + + + + +Environment Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Environment  

    +
    +
    +

    25.2 Environment Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • decode-universal-time   +
    • encode-universal-time   +
    • get-universal-time   +
    • sleep   +
    • apropos   +
    • describe   +
    • describe-object   +
    • trace   +
    • step   +
    • time   +
    • internal-time-units-per-second   +
    • get-internal-real-time   +
    • get-internal-run-time   +
    • disassemble   +
    • documentation   +
    • room   +
    • ed   +
    • inspect   +
    • dribble   +
    • - (Variable)   +
    • + (Variable)   +
    • * (Variable)   +
    • / (Variable)   +
    • lisp-implementation-type   +
    • short-site-name   +
    • machine-instance   +
    • machine-type   +
    • machine-version   +
    • software-type   +
    • user-homedir-pathname   +
    + + + + + + diff --git a/info/gcl/Environment-Inquiry.html b/info/gcl/Environment-Inquiry.html new file mode 100644 index 0000000..563cb91 --- /dev/null +++ b/info/gcl/Environment-Inquiry.html @@ -0,0 +1,67 @@ + + + + + +Environment Inquiry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The External Environment  

    +
    +
    +

    25.1.3 Environment Inquiry

    + +

    Environment inquiry defined names provide information about +the hardware and software configuration on which a Common Lisp program is +being executed. +

    +

    Figure 25–3 shows defined names relating to environment inquiry. +

    +
    +
      *features*                   machine-instance  short-site-name   
+  lisp-implementation-type     machine-type      software-type     
+  lisp-implementation-version  machine-version   software-version  
+  long-site-name               room                                
+
+    Figure 25–3: Defined names relating to environment inquiry.   
+
+
    + + + + + + diff --git a/info/gcl/Environment-Objects.html b/info/gcl/Environment-Objects.html new file mode 100644 index 0000000..c798b2c --- /dev/null +++ b/info/gcl/Environment-Objects.html @@ -0,0 +1,71 @@ + + + + + +Environment Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Introduction to Environments  

    +
    +
    +

    3.1.1.5 Environment Objects

    + +

    Some operators make use of an object, +called an environment object + +, +that represents the set of lexical bindings needed to perform +semantic analysis on a form in a given lexical environment. +The set of bindings in an environment object +may be a subset of the bindings that would be needed to actually +perform an evaluation; for example, values associated with +variable names and function names in the corresponding +lexical environment might not be available in an environment object. +

    +

    The type and nature of an environment object is implementation-dependent. +The values of environment parameters to macro functions +are examples of environment objects. +

    +

    The object nil when used as an environment object +denotes the null lexical environment; +see The Null Lexical Environment. +

    + + + + + diff --git a/info/gcl/Environment.html b/info/gcl/Environment.html new file mode 100644 index 0000000..7482ab8 --- /dev/null +++ b/info/gcl/Environment.html @@ -0,0 +1,58 @@ + + + + + +Environment (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    25 Environment

    + + + + +
    • The External Environment   +
    • Environment Dictionary   +
    + + + + + + diff --git a/info/gcl/Error-Checking-in-Function-Calls.html b/info/gcl/Error-Checking-in-Function-Calls.html new file mode 100644 index 0000000..8a2ed07 --- /dev/null +++ b/info/gcl/Error-Checking-in-Function-Calls.html @@ -0,0 +1,57 @@ + + + + + +Error Checking in Function Calls (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.5 Error Checking in Function Calls

    + + + + +
    • Argument Mismatch Detection   +
    + + + + + + diff --git a/info/gcl/Error-Detection-Time-in-Safe-Calls.html b/info/gcl/Error-Detection-Time-in-Safe-Calls.html new file mode 100644 index 0000000..ac9038a --- /dev/null +++ b/info/gcl/Error-Detection-Time-in-Safe-Calls.html @@ -0,0 +1,59 @@ + + + + + +Error Detection Time in Safe Calls (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.2 Error Detection Time in Safe Calls

    + +

    If an error is signaled in a safe call, +the exact point of the signal is implementation-dependent. +In particular, it might be signaled at compile time or at run time, +and if signaled at run time, +it might be prior to, during, or after executing the call. +However, it is always prior to the execution of the body of the function +being called. +

    + + + + + diff --git a/info/gcl/Error-Terminology.html b/info/gcl/Error-Terminology.html new file mode 100644 index 0000000..086c3d1 --- /dev/null +++ b/info/gcl/Error-Terminology.html @@ -0,0 +1,280 @@ + + + + + +Error Terminology (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Definitions  

    +
    +
    +

    1.4.2 Error Terminology

    + + + +

    Situations in which errors might, should, or must be signaled are described +in the standard. The wording used to describe such situations is intended +to have precise meaning. The following list is a glossary of those meanings. +

    +
    +
    Safe code
    +
    + + +

    This is code processed with the safety optimization +at its highest setting (3). safety is a lexical property +of code. The phrase “the function F should signal an error” +means that if F is invoked from code processed with the highest +safety optimization, an error is signaled. +It is implementation-dependent whether F or the calling +code signals the error. +

    +
    +
    Unsafe code
    +
    + + +

    This is code processed with lower safety levels. +

    +

    Unsafe code might do error checking. Implementations are permitted to +treat all code as safe code all the time. +

    +
    +
    An error is signaled
    +
    + + + + + + +

    This means that an error is signaled in both safe and unsafe code. +Conforming code may rely on the fact that the error is signaled +in both safe and unsafe code. Every implementation is required to +detect the error in both safe and unsafe code. For example, “an error +is signaled if unexport is given a symbol +not accessible in the current package.” +

    +

    If an explicit error type is not specified, the default is error. +

    +
    +
    An error should be signaled
    +
    + + + + +

    This means that an error is signaled in safe code, and an error +might be signaled in unsafe code. Conforming code may rely on the +fact that the error is signaled in safe code. Every +implementation is required to detect the error at least in safe code. +When the error is not signaled, the “consequences are undefined” +(see below). For example, “+ should signal an error of type type-error +if any argument is not of type number.” +

    +
    +
    Should be prepared to signal an error
    +
    + + + + +

    This is similar to “should be signaled” except that it does not +imply that ‘extra effort’ has to be taken on the part of an operator +to discover an erroneous situation if the normal action of that operator +can be performed successfully with only ‘lazy’ checking. +An implementation is always permitted to signal an error, +but even in safe code, it is only required to signal the error +when failing to signal it might lead to incorrect results. +In unsafe code, the consequences are undefined. +

    +

    For example, defining that + “find should be prepared to signal an error of type type-error + if its second argument is not a proper list” +does not imply that an error is always signaled. The form +

    +
    +
     (find 'a '(a b . c))
+
    + +

    must either signal an error of type type-error in safe code, +else return A. +In unsafe code, the consequences are undefined. +By contrast, +

    +
    +
     (find 'd '(a b . c))
+
    + +

    must signal an error of type type-error in safe code. +In unsafe code, the consequences are undefined. +Also, +

    +
    +
     (find 'd '#1=(a b . #1#))
+
    + +

    in safe code + might return nil (as an implementation-defined extension), + might never return, +or might signal an error of type type-error. +In unsafe code, the consequences are undefined. +

    +

    Typically, the “should be prepared to signal” terminology is used in +type checking situations where there are efficiency considerations that +make it impractical to detect errors that are not relevant to the +correct operation of the operator. +

    +
    +
    The consequences are unspecified
    +
    + + + + +

    This means that the consequences are unpredictable but harmless. +Implementations are permitted to specify the consequences of this +situation. No conforming code may depend on the results or effects of +this situation, and all conforming code is required to treat the +results and effects of this situation as unpredictable but harmless. +For example, “if the second argument to shared-initialize +specifies a name that does not correspond to any slots +accessible in the object, the results are unspecified.” +

    +
    +
    The consequences are undefined
    +
    + + + + +

    This means that the consequences are unpredictable. The consequences +may range from harmless to fatal. No conforming code may depend on +the results or effects. Conforming code must treat the consequences as +unpredictable. In places where the words “must,” “must not,” or +“may not” are used, then “the consequences are undefined” if the +stated requirement is not met and no specific consequence is +explicitly stated. An implementation is permitted to signal an error +in this case. +

    +

    For example: “Once a name has been declared by defconstant +to be constant, any further assignment or binding of that +variable has undefined consequences.” +

    +
    +
    An error might be signaled
    +
    + + + + +

    This means that the situation has undefined consequences; +however, if an error is signaled, it is of the specified type. +For example, “open might signal an error of type file-error.” +

    +
    +
    The return values are unspecified
    +
    + + +

    This means that only the number and nature of the return values of a +form are not specified. However, the issue of whether or not +any side-effects or transfer of control occurs is still well-specified. +

    +

    A program can be well-specified even if it uses a function whose +returns values are unspecified. For example, even if the return +values of some function F are unspecified, an expression such as +(length (list (F))) is still well-specified because it does not +rely on any particular aspect of the value or values returned by F. +

    +
    +
    Implementations may be extended to cover this situation
    +
    + + +

    This means that the situation has undefined consequences; +however, a conforming implementation is free to treat +the situation in a more specific way. +For example, an implementation might define + that an error is signaled, + or that an error should be signaled, + or even that a certain well-defined non-error behavior occurs. +

    +

    No conforming code may depend on the consequences of such a situation; +all conforming code must treat the consequences of the situation +as undefined. Implementations are required to document how the +situation is treated. +

    +

    For example, “implementations may be extended to define other type +specifiers to have a corresponding class.” +

    +
    +
    Implementations are free to extend the syntax
    +
    + + +

    This means that in this situation implementations are permitted to +define unambiguous extensions to the syntax of the form being +described. No conforming code may depend on this extension. +Implementations are required to document each such extension. All +conforming code is required to treat the syntax as meaningless. The +standard might disallow certain extensions while allowing others. For +example, “no implementation is free to extend the syntax of +defclass.” +

    +
    +
    A warning might be issued
    +
    + + +

    This means that implementations are encouraged to issue a warning +if the context is appropriate (e.g., when compiling). However, a +conforming implementation is not required to issue a warning. +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Definitions  

    +
    + + + + + diff --git a/info/gcl/Errors-When-Calling-a-Next-Method.html b/info/gcl/Errors-When-Calling-a-Next-Method.html new file mode 100644 index 0000000..9bad2ca --- /dev/null +++ b/info/gcl/Errors-When-Calling-a-Next-Method.html @@ -0,0 +1,69 @@ + + + + + +Errors When Calling a Next Method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.9 Errors When Calling a Next Method

    + +

    If call-next-method is called with arguments, the ordered +set of applicable methods for the changed set of arguments +for call-next-method must be the same as the ordered set of +applicable methods for the original arguments to the +generic function, or else an error should be signaled. +

    +

    The comparison between the set of methods applicable to the +new arguments and the set applicable to the original arguments is +insensitive to order differences among methods with the same +specializers. +

    +

    If call-next-method is called with arguments that specify +a different ordered set of applicable methods and there is no +next method available, the test for different methods and the +associated error signaling (when present) takes precedence over calling +no-next-method. +

    + + + + + + diff --git a/info/gcl/Escape-Characters-and-Potential-Numbers.html b/info/gcl/Escape-Characters-and-Potential-Numbers.html new file mode 100644 index 0000000..28edc41 --- /dev/null +++ b/info/gcl/Escape-Characters-and-Potential-Numbers.html @@ -0,0 +1,66 @@ + + + + + +Escape Characters and Potential Numbers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers as Tokens  

    +
    +
    +

    2.3.1.2 Escape Characters and Potential Numbers

    + +

    A potential number cannot contain any escape +characters. An escape character robs the following +character of all syntactic qualities, forcing it to be strictly +alphabetic_2 and therefore unsuitable for use in a +potential number. For example, all of the following +representations are interpreted as symbols, not numbers: +

    +
    +
     \256   25\64   1.0\E6   |100|   3\.14159   |3/4|   3\/4   5||
+
    + +

    In each case, removing the escape character (or characters) +would +cause the token to be a potential number. +

    + + + + + diff --git a/info/gcl/Evaluation-and-Compilation-Dictionary.html b/info/gcl/Evaluation-and-Compilation-Dictionary.html new file mode 100644 index 0000000..b4b6b54 --- /dev/null +++ b/info/gcl/Evaluation-and-Compilation-Dictionary.html @@ -0,0 +1,115 @@ + + + + + +Evaluation and Compilation Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.8 Evaluation and Compilation Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • lambda (Symbol)   +
    • lambda   +
    • compile   +
    • eval   +
    • eval-when   +
    • load-time-value   +
    • quote   +
    • compiler-macro-function   +
    • define-compiler-macro   +
    • defmacro   +
    • macro-function   +
    • macroexpand   +
    • define-symbol-macro   +
    • symbol-macrolet   +
    • *macroexpand-hook*   +
    • proclaim   +
    • declaim   +
    • declare   +
    • ignore   +
    • dynamic-extent   +
    • type   +
    • inline   +
    • ftype   +
    • declaration   +
    • optimize   +
    • special   +
    • locally   +
    • the   +
    • special-operator-p   +
    • constantp   +
    + + + + + + diff --git a/info/gcl/Evaluation-and-Compilation.html b/info/gcl/Evaluation-and-Compilation.html new file mode 100644 index 0000000..81a4a9f --- /dev/null +++ b/info/gcl/Evaluation-and-Compilation.html @@ -0,0 +1,70 @@ + + + + + +Evaluation and Compilation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    3 Evaluation and Compilation

    + + + + + + + + + + +
    • Evaluation   +
    • Compilation   +
    • Declarations   +
    • Lambda Lists   +
    • Error Checking in Function Calls   +
    • Traversal Rules and Side Effects   +
    • Destructive Operations   +
    • Evaluation and Compilation Dictionary   +
    + + + + + + diff --git a/info/gcl/Evaluation-of-Subforms-to-Places.html b/info/gcl/Evaluation-of-Subforms-to-Places.html new file mode 100644 index 0000000..b8484e3 --- /dev/null +++ b/info/gcl/Evaluation-of-Subforms-to-Places.html @@ -0,0 +1,153 @@ + + + + + +Evaluation of Subforms to Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of Places and Generalized Reference  

    +
    +
    +

    5.1.1.1 Evaluation of Subforms to Places

    + +

    The following rules apply to the evaluation of subforms in a +place: +

    +
    +
    1.
    +

    The evaluation ordering of subforms within a place +is determined by the order specified by the second value returned by +

    +

    get-setf-expansion. +

    +

    For all places defined by this specification +(e.g., getf, ldb, ...), +this order of evaluation is left-to-right. +

    + + + + +

    When a place is derived from a macro expansion, +this rule is applied after the macro is expanded to find the appropriate place. +

    +

    Places defined by using defmacro or +

    +

    define-setf-expander +

    +

    use the evaluation order defined by those definitions. +For example, consider the following: +

    +
    +
     (defmacro wrong-order (x y) `(getf ,y ,x))
+
    + +

    This following form evaluates place2 first and +then place1 because that is the order they are evaluated in +the macro expansion: +

    +
    +
     (push value (wrong-order place1 place2))
+
    + +
    +
    2.
    +
    +

    For the macros that manipulate places + (push, + pushnew, + remf, + incf, + decf, + shiftf, + rotatef, + psetf, + setf, + pop, and those defined by define-modify-macro) +the subforms of the macro call are evaluated exactly once +in left-to-right order, with the subforms of the places +evaluated in the order specified in (1). +

    +

    push, pushnew, remf, +incf, decf, shiftf, rotatef, +psetf, pop evaluate all subforms before modifying +any of the place locations. +setf (in the case when setf has more than two arguments) +performs its operation on each pair in sequence. For example, in +

    +
    +
     (setf place1 value1 place2 value2 ...)
+
    + +

    the subforms of place1 and value1 are evaluated, the location +specified by +place1 is modified to contain the value returned by +value1, and +then the rest of the setf form is processed in a like manner. +

    +
    +
    3.
    +

    For check-type, ctypecase, and ccase, +subforms of the place are evaluated once as in (1), +but might be evaluated again if the +type check fails in the case of check-type +or none of the cases hold in +ctypecase and ccase. +

    +
    +
    4.
    +

    For assert, the order of evaluation of the generalized +references is not specified. + +

    + + +
    +
    + +

    Rules 2, 3 and 4 cover all standardized macros that manipulate places. +

    +
    +
    +

    +Next: , Previous: , Up: Overview of Places and Generalized Reference  

    +
    + + + + + diff --git a/info/gcl/Evaluation.html b/info/gcl/Evaluation.html new file mode 100644 index 0000000..ce09df5 --- /dev/null +++ b/info/gcl/Evaluation.html @@ -0,0 +1,95 @@ + + + + + +Evaluation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.1 Evaluation

    + + +

    Execution of code can be accomplished by a variety of means ranging +from direct interpretation of a form representing a program +to invocation of compiled code produced by a compiler. +

    +

    Evaluation + + is the process by which a program is executed in Common Lisp. +The mechanism of evaluation is manifested + both implicitly through the effect of the Lisp read-eval-print loop, + and explicitly through the presence of the functions + eval, + compile, + compile-file, + and load. +Any of these facilities might share the same execution strategy, +or each might use a different one. +

    +

    The behavior of a conforming program processed by eval +and by compile-file might differ; see Semantic Constraints. +

    +

    Evaluation can be understood in terms of a model in which an +interpreter recursively traverses a form performing each +step of the computation as it goes. +This model, which describes the semantics of Common Lisp programs, +is described in The Evaluation Model. +

    + + + + + + + + +
    • Introduction to Environments   +
    • The Evaluation Model   +
    • Lambda Expressions   +
    • Closures and Lexical Binding   +
    • Shadowing   +
    • Extent   +
    • Return Values   +
    + + + + + + diff --git a/info/gcl/Examples-of-ALWAYS.html b/info/gcl/Examples-of-ALWAYS.html new file mode 100644 index 0000000..79ae5a0 --- /dev/null +++ b/info/gcl/Examples-of-ALWAYS.html @@ -0,0 +1,104 @@ + + + + + +Examples of ALWAYS (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Termination Test Clauses  

    +
    +
    +

    6.1.4.2 Examples of ALWAYS, NEVER, and THEREIS clauses

    + +
    +
    ;; Make sure I is always less than 11 (two ways).
+;; The FOR construct terminates these loops.
+ (loop for i from 0 to 10
+       always (< i 11))
+⇒  T
+ (loop for i from 0 to 10
+       never (> i 11))
+⇒  T
+
+;; If I exceeds 10 return I; otherwise, return NIL.
+;; The THEREIS construct terminates this loop.
+ (loop for i from 0
+       thereis (when (> i 10) i) )
+⇒  11
+
+;;; The FINALLY clause is not evaluated in these examples.
+ (loop for i from 0 to 10
+       always (< i 9)
+       finally (print "you won't see this"))
+⇒  NIL
+ (loop never t
+       finally (print "you won't see this"))
+⇒  NIL
+ (loop thereis "Here is my value"
+       finally (print "you won't see this"))
+⇒  "Here is my value"
+
+;; The FOR construct terminates this loop, so the FINALLY clause 
+;; is evaluated.
+ (loop for i from 1 to 10
+       thereis (> i 11)
+       finally (prin1 'got-here))
+ |>  GOT-HERE
+⇒  NIL
+
+;; If this code could be used to find a counterexample to Fermat's
+;; last theorem, it would still not return the value of the
+;; counterexample because all of the THEREIS clauses in this example
+;; only return T.  But if Fermat is right, that won't matter
+;; because this won't terminate.
+
+ (loop for z upfrom 2
+       thereis
+         (loop for n upfrom 3 below (log z 2)
+               thereis
+                 (loop for x below z
+                       thereis
+                         (loop for y below z
+                               thereis (= (+ (expt x n) (expt y n))
+                                          (expt z n))))))
+
    + + + + + + diff --git a/info/gcl/Examples-of-APPEND-and-NCONC-clauses.html b/info/gcl/Examples-of-APPEND-and-NCONC-clauses.html new file mode 100644 index 0000000..a982858 --- /dev/null +++ b/info/gcl/Examples-of-APPEND-and-NCONC-clauses.html @@ -0,0 +1,65 @@ + + + + + +Examples of APPEND and NCONC clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Value Accumulation Clauses  

    +
    +
    +

    6.1.3.2 Examples of APPEND and NCONC clauses

    + +
    +
    ;; Use APPEND to concatenate some sublists.
+  (loop for x in '((a) (b) ((c)))
+        append x)
+⇒  (A B (C))
+
+;; NCONC some sublists together.  Note that only lists made by the
+;; call to LIST are modified.
+  (loop for i upfrom 0 
+        as x in '(a b (c))
+        nconc (if (evenp i) (list x) nil))
+⇒  (A (C))
+
    + + + + + + diff --git a/info/gcl/Examples-of-Associativity-and-Commutativity-in-Numeric-Operations.html b/info/gcl/Examples-of-Associativity-and-Commutativity-in-Numeric-Operations.html new file mode 100644 index 0000000..a61e7ea --- /dev/null +++ b/info/gcl/Examples-of-Associativity-and-Commutativity-in-Numeric-Operations.html @@ -0,0 +1,86 @@ + + + + + +Examples of Associativity and Commutativity in Numeric Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numeric Operations  

    +
    +
    +

    12.1.1.2 Examples of Associativity and Commutativity in Numeric Operations

    + +

    Consider the following expression, in which we assume that 1.0 and +1.0e-15 both denote single floats: +

    +
    +
     (+ 1/3 2/3 1.0d0 1.0 1.0e-15)
+
    + +

    One conforming implementation might +process the arguments from left to right, +first adding 1/3 and 2/3 to get 1, +then converting that to a double float +for combination with 1.0d0, +then successively converting and adding 1.0 and 1.0e-15. +

    +

    Another conforming implementation might process the arguments from +right to left, first performing a single float addition of 1.0 and +1.0e-15 (perhaps losing accuracy in the process), then converting the sum to +a double float and adding 1.0d0, then converting 2/3 to a +double float and adding it, and then converting 1/3 and adding that. +

    +

    A third conforming implementation might first scan all the arguments, +process all the rationals first to keep that part of the computation exact, +then find an argument of the largest floating-point format among all the +arguments and add that, and then add in all other arguments, converting +each in turn (all in a perhaps misguided attempt to make the computation as accurate +as possible). +

    +

    In any case, all three strategies are legitimate. +

    +

    A conforming program could control the order by writing, for example, +

    +
    +
     (+ (+ 1/3 2/3) (+ 1.0d0 1.0e-15) 1.0)
+
    + + + + + + diff --git a/info/gcl/Examples-of-COLLECT-clause.html b/info/gcl/Examples-of-COLLECT-clause.html new file mode 100644 index 0000000..d16952c --- /dev/null +++ b/info/gcl/Examples-of-COLLECT-clause.html @@ -0,0 +1,70 @@ + + + + + +Examples of COLLECT clause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Value Accumulation Clauses  

    +
    +
    +

    6.1.3.1 Examples of COLLECT clause

    + +
    +
    ;; Collect all the symbols in a list.
+ (loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
+       when (symbolp i) collect i)
+⇒  (BIRD TURTLE HORSE CAT)
+
+;; Collect and return odd numbers.
+ (loop for i from 1 to 10
+       if (oddp i) collect i)
+⇒  (1 3 5 7 9)
+
+;; Collect items into local variable, but don't return them.
+ (loop for i in '(a b c d) by #'cddr
+       collect i into my-list
+       finally (print my-list))
+ |>  (A C) 
+⇒  NIL
+
    + + + + + + diff --git a/info/gcl/Examples-of-COUNT-clause.html b/info/gcl/Examples-of-COUNT-clause.html new file mode 100644 index 0000000..ce4039c --- /dev/null +++ b/info/gcl/Examples-of-COUNT-clause.html @@ -0,0 +1,57 @@ + + + + + +Examples of COUNT clause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Value Accumulation Clauses  

    +
    +
    +

    6.1.3.3 Examples of COUNT clause

    + +
    +
     (loop for i in '(a b nil c nil d e)
+       count i)
+⇒  5
+
    + + + + + + diff --git a/info/gcl/Examples-of-Class-Precedence-List-Determination.html b/info/gcl/Examples-of-Class-Precedence-List-Determination.html new file mode 100644 index 0000000..fd85776 --- /dev/null +++ b/info/gcl/Examples-of-Class-Precedence-List-Determination.html @@ -0,0 +1,153 @@ + + + + + +Examples of Class Precedence List Determination (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Determining the Class Precedence List  

    +
    +
    +

    4.3.5.2 Examples of Class Precedence List Determination

    + +

    This example determines a class precedence list for the +class pie. The following classes are defined: +

    +
    +
     (defclass pie (apple cinnamon) ())
+
+ (defclass apple (fruit) ())
+
+ (defclass cinnamon (spice) ())
+
+ (defclass fruit (food) ())
+
+ (defclass spice (food) ())
+
+ (defclass food () ())
+
    + +

    The set S_{pie}~= {pie, apple, cinnamon, fruit, spice, food, +standard-object, t }. The set R~= { (pie, apple), +(apple, cinnamon), (apple, fruit), (cinnamon, spice), \break +(fruit, food), (spice, food), (food, standard-object), (standard-object, +t) }. +

    +

    The class pie is not preceded by anything, so it comes first; +the result so far is (pie). Remove pie from S and pairs +mentioning pie from R to get S~= {apple, cinnamon, +fruit, spice, food, standard-object, t } and R~=~{(apple, cinnamon), (apple, fruit), (cinnamon, spice),\break (fruit, +food), (spice, food), (food, standard-object), +(standard-object, t) }. +

    +

    The class apple is not preceded by anything, so it is next; the +result is (pie apple). Removing apple and the relevant +pairs results in S~= { cinnamon, fruit, spice, food, +standard-object, t } and R~= { (cinnamon, spice), +(fruit, food), (spice, food), (food, standard-object),\break +(standard-object, t) }. +

    +

    The classes cinnamon and fruit are not preceded by +anything, so the one with a direct subclass rightmost in the +class precedence list computed so far goes next. The class apple is a +direct subclass of fruit, and the class pie is a direct +subclass of cinnamon. Because apple appears to the right +of pie in the class precedence list, +fruit goes next, and the +result so far is (pie apple fruit). S~= { cinnamon, +spice, food, standard-object, t }; R~= {(cinnamon, +spice), (spice, food),\break (food, standard-object), +(standard-object, t) }. +

    +

    The class cinnamon is next, giving the result so far as (pie apple fruit cinnamon). At this point S~= { spice, +food, standard-object, t }; R~= { (spice, food), (food, +standard-object), (standard-object, t) }. +

    +

    The classes spice, food, standard-object, and +t are added in that order, and the class precedence list +is (pie apple fruit cinnamon spice food standard-object t). +

    +

    It is possible to write a set of class definitions that cannot be +ordered. For example: +

    +
    +
     (defclass new-class (fruit apple) ())
+
+ (defclass apple (fruit) ())
+
    + +

    The class fruit must precede apple +because the local ordering of superclasses must be preserved. +The class apple must precede fruit +because a class always precedes its own superclasses. +When this situation occurs, an error is signaled, as happens here +when the system tries to compute the class precedence list +of new-class. +

    +

    The following might appear to be a conflicting set of definitions: +

    +
    +
     (defclass pie (apple cinnamon) ())
+
+ (defclass pastry (cinnamon apple) ())
+
+ (defclass apple () ())
+
+ (defclass cinnamon () ())
+
    + +

    The class precedence list for pie is +(pie apple cinnamon standard-object t). +

    +

    The class precedence list for pastry is +(pastry cinnamon apple standard-object t). +

    +

    It is not a problem for apple to precede cinnamon in the +ordering of the superclasses of pie but not in the ordering for +pastry. However, it is not possible to build a new class that +has both pie and pastry as superclasses. +

    +
    +
    +

    +Previous: , Up: Determining the Class Precedence List  

    +
    + + + + + diff --git a/info/gcl/Examples-of-Data_002ddirected-Destructuring-by-Lambda-Lists.html b/info/gcl/Examples-of-Data_002ddirected-Destructuring-by-Lambda-Lists.html new file mode 100644 index 0000000..3beb98c --- /dev/null +++ b/info/gcl/Examples-of-Data_002ddirected-Destructuring-by-Lambda-Lists.html @@ -0,0 +1,64 @@ + + + + + +Examples of Data-directed Destructuring by Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Macro Lambda Lists  

    +
    +
    +

    3.4.4.3 Examples of Data-directed Destructuring by Lambda Lists

    + +

    An example pattern is +

    +

    (a b c) +

    +

    which destructures a list of three elements. The variable a is assigned +to the first element, b to the second, etc. A more complex example +is +

    +

    ((first . rest) . more) +

    +

    The important features of data-directed destructuring are its syntactic +simplicity and the ability to extend it to lambda-list-directed destructuring. +

    + + + + + diff --git a/info/gcl/Examples-of-Declaration-Scope.html b/info/gcl/Examples-of-Declaration-Scope.html new file mode 100644 index 0000000..a3803c0 --- /dev/null +++ b/info/gcl/Examples-of-Declaration-Scope.html @@ -0,0 +1,139 @@ + + + + + +Examples of Declaration Scope (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Declaration Scope  

    +
    +
    +

    3.3.4.1 Examples of Declaration Scope

    + +

    Here is an example illustrating the scope of bound declarations. +

    +
    +
     (let ((x 1))                ;[1] 1st occurrence of x
+   (declare (special x))     ;[2] 2nd occurrence of x
+   (let ((x 2))              ;[3] 3rd occurrence of x
+     (let ((old-x x)         ;[4] 4th occurrence of x
+           (x 3))            ;[5] 5th occurrence of x
+       (declare (special x)) ;[6] 6th occurrence of x
+       (list old-x x))))     ;[7] 7th occurrence of x
+⇒  (2 3)
+
    + +

    The first occurrence of x establishes a dynamic binding +of x because of the special declaration for x +in the second line. The third occurrence of x establishes a +lexical binding of x (because there is no special +declaration in the corresponding let form). +The fourth occurrence of x x is a reference to the +lexical binding of x established in the third line. +The fifth occurrence of x establishes a dynamic binding +of x for the body of the let form that begins on +that line because of the special declaration for x +in the sixth line. The reference to x in the fourth line is not +affected by the special declaration in the sixth line +because that reference is not within the “would-be lexical scope” +of the variable x in the fifth line. The reference to x +in the seventh line is a reference to the dynamic binding of x +established in the fifth line. +

    +

    Here is another example, to illustrate the scope of a +free declaration. In the following: +

    +
    +
     (lambda (&optional (x (foo 1))) ;[1]
+   (declare (notinline foo))     ;[2]
+   (foo x))                      ;[3]
+
    + +

    the call to foo in the first line might be +compiled inline even though the call to foo in +the third line must not be. This is because +the notinline declaration +for foo in the second line applies only to the body on the +third line. In order to suppress inlining for both calls, +one might write: +

    +
    +
     (locally (declare (notinline foo)) ;[1]
+   (lambda (&optional (x (foo 1)))  ;[2]
+     (foo x)))                      ;[3]
+
    + +

    or, alternatively: +

    +
    +
     (lambda (&optional                               ;[1]
+            (x (locally (declare (notinline foo)) ;[2]
+                 (foo 1))))                       ;[3]
+   (declare (notinline foo))                      ;[4]
+   (foo x))                                       ;[5]
+
    + +

    Finally, here is an example that shows the scope of +declarations in an iteration form. +

    +
    +
     (let ((x  1))                     ;[1]
+   (declare (special x))           ;[2]
+     (let ((x 2))                  ;[3]
+       (dotimes (i x x)            ;[4]
+         (declare (special x)))))  ;[5]
+⇒  1
+
    + +

    In this example, the first reference to x on the fourth line is to +the lexical binding of x established on the third line. +However, the second occurrence of x on the fourth line lies within +the scope of the free declaration on the fifth line +(because this is the result-form of the dotimes) +and therefore refers to the dynamic binding of x. +

    + +
    +
    +

    +Previous: , Up: Declaration Scope  

    +
    + + + + + diff --git a/info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Printer.html b/info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Printer.html new file mode 100644 index 0000000..ef422d0 --- /dev/null +++ b/info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Printer.html @@ -0,0 +1,113 @@ + + + + + +Examples of Effect of Readtable Case on the Lisp Printer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.11 Examples of Effect of Readtable Case on the Lisp Printer

    + +
    +
     (defun test-readtable-case-printing ()
+   (let ((*readtable* (copy-readtable nil))
+         (*print-case* *print-case*))
+     (format t "READTABLE-CASE *PRINT-CASE*  Symbol-name  Output~
+              ~
+              ~
+     (dolist (readtable-case '(:upcase :downcase :preserve :invert))
+       (setf (readtable-case *readtable*) readtable-case)
+       (dolist (print-case '(:upcase :downcase :capitalize))
+         (dolist (symbol '(|ZEBRA| |Zebra| |zebra|))
+           (setq *print-case* print-case)
+           (format t "~&:~A~15T:~A~29T~A~42T~A"
+                   (string-upcase readtable-case)
+                   (string-upcase print-case)
+                   (symbol-name symbol)
+                   (prin1-to-string symbol)))))))
+
    + +

    The output from (test-readtable-case-printing) should be as follows: +

    +
    +
        READTABLE-CASE *PRINT-CASE*  Symbol-name  Output
+    --------------------------------------------------
+    :UPCASE        :UPCASE       ZEBRA        ZEBRA
+    :UPCASE        :UPCASE       Zebra        |Zebra|
+    :UPCASE        :UPCASE       zebra        |zebra|
+    :UPCASE        :DOWNCASE     ZEBRA        zebra
+    :UPCASE        :DOWNCASE     Zebra        |Zebra|
+    :UPCASE        :DOWNCASE     zebra        |zebra|
+    :UPCASE        :CAPITALIZE   ZEBRA        Zebra
+    :UPCASE        :CAPITALIZE   Zebra        |Zebra|
+    :UPCASE        :CAPITALIZE   zebra        |zebra|
+    :DOWNCASE      :UPCASE       ZEBRA        |ZEBRA|
+    :DOWNCASE      :UPCASE       Zebra        |Zebra|
+    :DOWNCASE      :UPCASE       zebra        ZEBRA
+    :DOWNCASE      :DOWNCASE     ZEBRA        |ZEBRA|
+    :DOWNCASE      :DOWNCASE     Zebra        |Zebra|
+    :DOWNCASE      :DOWNCASE     zebra        zebra
+    :DOWNCASE      :CAPITALIZE   ZEBRA        |ZEBRA|
+    :DOWNCASE      :CAPITALIZE   Zebra        |Zebra|
+    :DOWNCASE      :CAPITALIZE   zebra        Zebra
+    :PRESERVE      :UPCASE       ZEBRA        ZEBRA
+    :PRESERVE      :UPCASE       Zebra        Zebra
+    :PRESERVE      :UPCASE       zebra        zebra
+    :PRESERVE      :DOWNCASE     ZEBRA        ZEBRA
+    :PRESERVE      :DOWNCASE     Zebra        Zebra
+    :PRESERVE      :DOWNCASE     zebra        zebra
+    :PRESERVE      :CAPITALIZE   ZEBRA        ZEBRA
+    :PRESERVE      :CAPITALIZE   Zebra        Zebra
+    :PRESERVE      :CAPITALIZE   zebra        zebra
+    :INVERT        :UPCASE       ZEBRA        zebra
+    :INVERT        :UPCASE       Zebra        Zebra
+    :INVERT        :UPCASE       zebra        ZEBRA
+    :INVERT        :DOWNCASE     ZEBRA        zebra
+    :INVERT        :DOWNCASE     Zebra        Zebra
+    :INVERT        :DOWNCASE     zebra        ZEBRA
+    :INVERT        :CAPITALIZE   ZEBRA        zebra
+    :INVERT        :CAPITALIZE   Zebra        Zebra
+    :INVERT        :CAPITALIZE   zebra        ZEBRA
+
    + + + + + + diff --git a/info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Reader.html b/info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Reader.html new file mode 100644 index 0000000..4131e71 --- /dev/null +++ b/info/gcl/Examples-of-Effect-of-Readtable-Case-on-the-Lisp-Reader.html @@ -0,0 +1,85 @@ + + + + + +Examples of Effect of Readtable Case on the Lisp Reader (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Effect of Readtable Case on the Lisp Reader  

    +
    +
    +

    23.1.2.1 Examples of Effect of Readtable Case on the Lisp Reader

    + +
    +
     (defun test-readtable-case-reading ()
+   (let ((*readtable* (copy-readtable nil)))
+     (format t "READTABLE-CASE  Input   Symbol-name~
+              ~
+              ~
+     (dolist (readtable-case '(:upcase :downcase :preserve :invert))
+       (setf (readtable-case *readtable*) readtable-case)
+       (dolist (input '("ZEBRA" "Zebra" "zebra"))
+         (format t "~&:~A~16T~A~24T~A"
+                 (string-upcase readtable-case)
+                 input
+                 (symbol-name (read-from-string input)))))))
+
    + +

    The output from (test-readtable-case-reading) should be as follows: +

    +
    +
     READTABLE-CASE     Input Symbol-name
+ -------------------------------------
+    :UPCASE         ZEBRA   ZEBRA
+    :UPCASE         Zebra   ZEBRA
+    :UPCASE         zebra   ZEBRA
+    :DOWNCASE       ZEBRA   zebra
+    :DOWNCASE       Zebra   zebra
+    :DOWNCASE       zebra   zebra
+    :PRESERVE       ZEBRA   ZEBRA
+    :PRESERVE       Zebra   Zebra
+    :PRESERVE       zebra   zebra
+    :INVERT         ZEBRA   zebra
+    :INVERT         Zebra   Zebra
+    :INVERT         zebra   ZEBRA
+
    + + + + + + diff --git a/info/gcl/Examples-of-Evaluation-of-Subforms-to-Places.html b/info/gcl/Examples-of-Evaluation-of-Subforms-to-Places.html new file mode 100644 index 0000000..6004ba2 --- /dev/null +++ b/info/gcl/Examples-of-Evaluation-of-Subforms-to-Places.html @@ -0,0 +1,69 @@ + + + + + +Examples of Evaluation of Subforms to Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of Places and Generalized Reference  

    +
    +
    +

    5.1.1.2 Examples of Evaluation of Subforms to Places

    + +
    +
     (let ((ref2 (list '())))
+   (push (progn (princ "1") 'ref-1)
+         (car (progn (princ "2") ref2)))) 
+ |>  12
+⇒  (REF1)
+
+ (let (x)
+    (push (setq x (list 'a))
+          (car (setq x (list 'b))))
+     x)
+⇒  (((A) . B))
+
    + +

    push first evaluates (setq x (list 'a)) ⇒ (a), + then evaluates (setq x (list 'b)) ⇒ (b), + then modifies the car of this latest value to be ((a) . b). +

    + + + + + diff --git a/info/gcl/Examples-of-FORMAT.html b/info/gcl/Examples-of-FORMAT.html new file mode 100644 index 0000000..0c4e3b5 --- /dev/null +++ b/info/gcl/Examples-of-FORMAT.html @@ -0,0 +1,159 @@ + + + + + +Examples of FORMAT (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.11 Examples of FORMAT

    + +
    +
     (format nil "foo") ⇒  "foo"
+ (setq x 5) ⇒  5
+ (format nil "The answer is ~D." x) ⇒  "The answer is 5."
+ (format nil "The answer is ~3D." x) ⇒  "The answer is   5."
+ (format nil "The answer is ~3,'0D." x) ⇒  "The answer is 005."
+ (format nil "The answer is ~:D." (expt 47 x))
+⇒  "The answer is 229,345,007."
+ (setq y "elephant") ⇒  "elephant"
+ (format nil "Look at the ~A!" y) ⇒  "Look at the elephant!"
+ (setq n 3) ⇒  3
+ (format nil "~D item~:P found." n) ⇒  "3 items found."
+ (format nil "~R dog~:[s are~; is~] here." n (= n 1))
+⇒  "three dogs are here."
+ (format nil "~R dog~:*~[s are~; is~:;s are~] here." n)
+⇒  "three dogs are here."
+ (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n)
+⇒  "Here are three puppies."
+
    + +
    +
     (defun foo (x)
+   (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F"
+           x x x x x x)) ⇒  FOO
+ (foo 3.14159)  ⇒  "  3.14| 31.42|  3.14|3.1416|3.14|3.14159"
+ (foo -3.14159) ⇒  " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159"
+ (foo 100.0)    ⇒  "100.00|******|100.00| 100.0|100.00|100.0"
+ (foo 1234.0)   ⇒  "1234.00|******|??????|1234.0|1234.00|1234.0"
+ (foo 0.006)    ⇒  "  0.01|  0.06|  0.01| 0.006|0.01|0.006"
+
    + +
    +
     (defun foo (x)  
+    (format nil
+           "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~
+            ~9,3,2,-2,'
+           x x x x))
+ (foo 3.14159)  ⇒  "  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0"
+ (foo -3.14159) ⇒  " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0"
+ (foo 1100.0)   ⇒  "  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3"
+ (foo 1100.0L0) ⇒  "  1.10L+3| 11.00$+02|+.001L+06|  1.10L+3"
+ (foo 1.1E13)   ⇒  "*********| 11.00$+12|+.001E+16| 1.10E+13"
+ (foo 1.1L120)  ⇒  "*********|??????????|
+ (foo 1.1L1200) ⇒  "*********|??????????|
+
    + +

    As an example of the effects of varying the scale factor, the code +

    +
    +
     (dotimes (k 13)
+   (format t "~
+           (- k 5) (- k 5) 3.14159))
+
    + +

    produces the following output: +

    +
    +
    Scale factor -5: | 0.000003E+06|
+Scale factor -4: | 0.000031E+05|
+Scale factor -3: | 0.000314E+04|
+Scale factor -2: | 0.003142E+03|
+Scale factor -1: | 0.031416E+02|
+Scale factor  0: | 0.314159E+01|
+Scale factor  1: | 3.141590E+00|
+Scale factor  2: | 31.41590E-01|
+Scale factor  3: | 314.1590E-02|
+Scale factor  4: | 3141.590E-03|
+Scale factor  5: | 31415.90E-04|
+Scale factor  6: | 314159.0E-05|
+Scale factor  7: | 3141590.E-06|
+
    + +
    +
     (defun foo (x)
+   (format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'
+          x x x x))                                     
+ (foo 0.0314159) ⇒  "  3.14E-2|314.2$-04|0.314E-01|  3.14E-2"
+ (foo 0.314159)  ⇒  "  0.31   |0.314    |0.314    | 0.31    "
+ (foo 3.14159)   ⇒  "   3.1   | 3.14    | 3.14    |  3.1    "
+ (foo 31.4159)   ⇒  "   31.   | 31.4    | 31.4    |  31.    "
+ (foo 314.159)   ⇒  "  3.14E+2| 314.    | 314.    |  3.14E+2"
+ (foo 3141.59)   ⇒  "  3.14E+3|314.2$+01|0.314E+04|  3.14E+3"
+ (foo 3141.59L0) ⇒  "  3.14L+3|314.2$+01|0.314L+04|  3.14L+3"
+ (foo 3.14E12)   ⇒  "*********|314.0$+10|0.314E+13| 3.14E+12"
+ (foo 3.14L120)  ⇒  "*********|?????????|
+ (foo 3.14L1200) ⇒  "*********|?????????|
+
    + +
    +
     (format nil "~10<foo~;bar~>")   ⇒  "foo    bar"
+ (format nil "~10:<foo~;bar~>")  ⇒  "  foo  bar"
+ (format nil "~10<foobar~>")     ⇒  "    foobar"
+ (format nil "~10:<foobar~>")    ⇒  "    foobar"
+ (format nil "~10:@<foo~;bar~>") ⇒  "  foo bar "
+ (format nil "~10@<foobar~>")    ⇒  "foobar    "
+ (format nil "~10:@<foobar~>")   ⇒  "  foobar  "
+
    + +
    +
      (FORMAT NIL "Written to ~A." #P"foo.bin")
+  ⇒  "Written to foo.bin."
+
    + +
    +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    + + + + + diff --git a/info/gcl/Examples-of-Feature-Expressions.html b/info/gcl/Examples-of-Feature-Expressions.html new file mode 100644 index 0000000..28e05aa --- /dev/null +++ b/info/gcl/Examples-of-Feature-Expressions.html @@ -0,0 +1,90 @@ + + + + + +Examples of Feature Expressions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Features  

    +
    +
    +

    24.1.2.2 Examples of Feature Expressions

    + +

    For example, suppose that + in implementation A, the features spice and perq are present, + but the feature lispm is not present; + in implementation B, the feature lispm is present, + but the features spice and perq are + not present; + and + in implementation C, none of the features spice, lispm, or perq are + present. +Figure 24–1 shows some sample expressions, and how they would be +read_2 in these implementations. +

    +
    +
      (cons #+spice "Spice" #-spice "Lispm" x) 
+  in implementation A ...    (CONS "Spice" X)             
+    in implementation B ...  (CONS "Lispm" X)             
+    in implementation C ...  (CONS "Lispm" X)             
+  (cons #+spice "Spice" #+LispM "Lispm" x) 
+  in implementation A ...    (CONS "Spice" X)             
+    in implementation B ...  (CONS "Lispm" X)             
+    in implementation C ...  (CONS X)                     
+  (setq a '(1 2 #+perq 43 #+(not perq) 27)) 
+  in implementation A ...    (SETQ A '(1 2 43))           
+    in implementation B ...  (SETQ A '(1 2 27))           
+    in implementation C ...  (SETQ A '(1 2 27))           
+  (let ((a 3) #+(or spice lispm) (b 3)) (foo a)) 
+  in implementation A ...    (LET ((A 3) (B 3)) (FOO A))  
+    in implementation B ...  (LET ((A 3) (B 3)) (FOO A))  
+    in implementation C ...  (LET ((A 3)) (FOO A))        
+  (cons #+Lispm "#+Spice" #+Spice "foo" #-(or Lispm Spice) 7 x) 
+  in implementation A ...    (CONS "foo" X)               
+    in implementation B ...  (CONS "#+Spice" X)           
+    in implementation C ...  (CONS 7 X)                   
+
+              Figure 24–1: Features examples             
+
+
    + + + + + + + diff --git a/info/gcl/Examples-of-Inheritance.html b/info/gcl/Examples-of-Inheritance.html new file mode 100644 index 0000000..2ef92c3 --- /dev/null +++ b/info/gcl/Examples-of-Inheritance.html @@ -0,0 +1,74 @@ + + + + + +Examples of Inheritance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Inheritance  

    +
    +
    +

    4.3.4.1 Examples of Inheritance

    + +
    +
     (defclass C1 () 
+     ((S1 :initform 5.4 :type number) 
+      (S2 :allocation :class)))
+
+ (defclass C2 (C1) 
+     ((S1 :initform 5 :type integer)
+      (S2 :allocation :instance)
+      (S3 :accessor C2-S3)))
+
    + +

    Instances of the class C1 have a local slot named S1, +whose default initial value is 5.4 and +whose value should always be a number. +The class C1 also has a shared slot named S2. +

    +

    There is a local slot named S1 in instances of C2. +The default initial value of S1 is 5. +The value of S1 should always be of type (and integer number). +There are also local slots named S2 and S3 in instances of C2. +The class C2 has a method for C2-S3 for reading the value of slot S3; +there is also a method for (setf C2-S3) that writes the value of S3. +

    + + + + + diff --git a/info/gcl/Examples-of-Keyword-Arguments-in-Generic-Functions-and-Methods.html b/info/gcl/Examples-of-Keyword-Arguments-in-Generic-Functions-and-Methods.html new file mode 100644 index 0000000..39b66ae --- /dev/null +++ b/info/gcl/Examples-of-Keyword-Arguments-in-Generic-Functions-and-Methods.html @@ -0,0 +1,86 @@ + + + + + +Examples of Keyword Arguments in Generic Functions and Methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Keyword Arguments in Generic Functions and Methods  

    +
    +
    +

    7.6.5.1 Examples of Keyword Arguments in Generic Functions and Methods

    + +

    For example, suppose there are two methods defined for width +as follows: +

    +
    +
     (defmethod width ((c character-class) &key font) ...)
+
+ (defmethod width ((p picture-class) &key pixel-size) ...)
+
    + +

    Assume that there are no other methods and no generic +function definition for width. The evaluation of the +following form should signal an error because +the keyword argument :pixel-size is not accepted by the applicable method. +

    +
    +
     (width (make-instance `character-class :char #\Q) 
+        :font 'baskerville :pixel-size 10)
+
    + +

    The evaluation of the following form should signal an error. +

    +
    +
     (width (make-instance `picture-class :glyph (glyph #\Q)) 
+        :font 'baskerville :pixel-size 10)
+
    + +

    The evaluation of the following form will not signal an error +if the class named character-picture-class is a subclass of +both picture-class and character-class. +

    +
    +
     (width (make-instance `character-picture-class :char #\Q)
+        :font 'baskerville :pixel-size 10)
+
    + + + + + + diff --git a/info/gcl/Examples-of-MAXIMIZE-and-MINIMIZE-clauses.html b/info/gcl/Examples-of-MAXIMIZE-and-MINIMIZE-clauses.html new file mode 100644 index 0000000..b8aba30 --- /dev/null +++ b/info/gcl/Examples-of-MAXIMIZE-and-MINIMIZE-clauses.html @@ -0,0 +1,74 @@ + + + + + +Examples of MAXIMIZE and MINIMIZE clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Value Accumulation Clauses  

    +
    +
    +

    6.1.3.4 Examples of MAXIMIZE and MINIMIZE clauses

    + +
    +
     (loop for i in '(2 1 5 3 4)
+       maximize i)
+⇒  5
+ (loop for i in '(2 1 5 3 4)
+       minimize i)
+⇒  1
+
+;; In this example, FIXNUM applies to the internal variable that holds
+;; the maximum value.
+ (setq series '(1.2 4.3 5.7))
+⇒  (1.2 4.3 5.7)
+ (loop for v in series 
+       maximize (round v) of-type fixnum)
+⇒  6
+
+;; In this example, FIXNUM applies to the variable RESULT.
+ (loop for v of-type float in series
+       minimize (round v) into result of-type fixnum
+       finally (return result))
+⇒  1
+
    + + + + + + diff --git a/info/gcl/Examples-of-Merging-Pathnames.html b/info/gcl/Examples-of-Merging-Pathnames.html new file mode 100644 index 0000000..592f319 --- /dev/null +++ b/info/gcl/Examples-of-Merging-Pathnames.html @@ -0,0 +1,74 @@ + + + + + +Examples of Merging Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Merging Pathnames  

    +
    +
    +

    19.2.3.1 Examples of Merging Pathnames

    + +

    Although the following examples are possible to execute only in +implementations which permit :unspecific in the indicated +position andwhich permit four-letter type components, they serve to illustrate +the basic concept of pathname merging. +

    +
    +
     (pathname-type 
+   (merge-pathnames (make-pathname :type "LISP")
+                    (make-pathname :type "TEXT")))
+⇒  "LISP"
+
+ (pathname-type 
+   (merge-pathnames (make-pathname :type nil)
+                    (make-pathname :type "LISP")))
+⇒  "LISP"
+
+ (pathname-type 
+   (merge-pathnames (make-pathname :type :unspecific)
+                    (make-pathname :type "LISP")))
+⇒  :UNSPECIFIC
+
    + + + + + + + diff --git a/info/gcl/Examples-of-Miscellaneous-Loop-Features.html b/info/gcl/Examples-of-Miscellaneous-Loop-Features.html new file mode 100644 index 0000000..bc8043e --- /dev/null +++ b/info/gcl/Examples-of-Miscellaneous-Loop-Features.html @@ -0,0 +1,86 @@ + + + + + +Examples of Miscellaneous Loop Features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.8 Examples of Miscellaneous Loop Features

    + +
    +
     (let ((i 0))                     ; no loop keywords are used
+    (loop (incf i) (if (= i 3) (return i)))) ⇒  3
+ (let ((i 0)(j 0))
+    (tagbody
+      (loop (incf j 3) (incf i) (if (= i 3) (go exit)))
+      exit)
+    j) ⇒  9
+
    + +

    In the following example, the variable x is stepped +before y is stepped; thus, the value of y +reflects the updated value of x: +

    +
    +
     (loop for x from 1 to 10 
+       for y = nil then x 
+       collect (list x y))
+⇒  ((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10))
+
    + +

    In this example, x and y are stepped in parallel: +

    +
    +
     (loop for x from 1 to 10 
+       and y = nil then x 
+       collect (list x y))
+⇒  ((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8) (10 9))
+
    + + + +
    • Examples of clause grouping   +
    + + + + + + diff --git a/info/gcl/Examples-of-Multiple-Escape-Characters.html b/info/gcl/Examples-of-Multiple-Escape-Characters.html new file mode 100644 index 0000000..16207bd --- /dev/null +++ b/info/gcl/Examples-of-Multiple-Escape-Characters.html @@ -0,0 +1,60 @@ + + + + + +Examples of Multiple Escape Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.6 Examples of Multiple Escape Characters

    + +
    +
     ;; The following examples assume the readtable case of *readtable* 
+ ;; and *print-case* are both :upcase.
+ (eq 'abc 'ABC) ⇒  true
+ (eq 'abc '|ABC|) ⇒  true
+ (eq 'abc 'a|B|c) ⇒  true
+ (eq 'abc '|abc|) ⇒  false
+
    + + + + + + diff --git a/info/gcl/Examples-of-NAMED-clause.html b/info/gcl/Examples-of-NAMED-clause.html new file mode 100644 index 0000000..906443f --- /dev/null +++ b/info/gcl/Examples-of-NAMED-clause.html @@ -0,0 +1,61 @@ + + + + + +Examples of NAMED clause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Miscellaneous Clauses  

    +
    +
    +

    6.1.7.2 Examples of NAMED clause

    + +
    +
    ;; Just name and return.
+ (loop named max
+       for i from 1 to 10
+       do (print i)
+       do (return-from max 'done))
+ |>  1 
+⇒  DONE
+
    + + + + + + diff --git a/info/gcl/Examples-of-Ordinary-Lambda-Lists.html b/info/gcl/Examples-of-Ordinary-Lambda-Lists.html new file mode 100644 index 0000000..26c8a1d --- /dev/null +++ b/info/gcl/Examples-of-Ordinary-Lambda-Lists.html @@ -0,0 +1,145 @@ + + + + + +Examples of Ordinary Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.8 Examples of Ordinary Lambda Lists

    + +

    Here are some examples involving optional parameters and rest parameters: +

    +
    +
     ((lambda (a b) (+ a (* b 3))) 4 5) ⇒  19
+ ((lambda (a &optional (b 2)) (+ a (* b 3))) 4 5) ⇒  19
+ ((lambda (a &optional (b 2)) (+ a (* b 3))) 4) ⇒  10
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)))
+⇒  (2 NIL 3 NIL NIL)
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6)
+⇒  (6 T 3 NIL NIL)
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3)
+⇒  (6 T 3 T NIL)
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3 8)
+⇒  (6 T 3 T (8))
+ ((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x))
+  6 3 8 9 10 11)
+⇒  (6 t 3 t (8 9 10 11))
+
    + +

    Here are some examples involving keyword parameters: +

    +
    +
     ((lambda (a b &key c d) (list a b c d)) 1 2) ⇒  (1 2 NIL NIL)
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6) ⇒  (1 2 6 NIL)
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8) ⇒  (1 2 NIL 8)
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :c 6 :d 8) ⇒  (1 2 6 8)
+ ((lambda (a b &key c d) (list a b c d)) 1 2 :d 8 :c 6) ⇒  (1 2 6 8)
+ ((lambda (a b &key c d) (list a b c d)) :a 1 :d 8 :c 6) ⇒  (:a 1 6 8)
+ ((lambda (a b &key c d) (list a b c d)) :a :b :c :d) ⇒  (:a :b :d NIL)
+ ((lambda (a b &key ((:sea c)) d) (list a b c d)) 1 2 :sea 6) ⇒  (1 2 6 NIL)
+ ((lambda (a b &key ((c c)) d) (list a b c d)) 1 2 'c 6) ⇒  (1 2 6 NIL)
+
    + +

    Here are some examples involving optional parameters, rest parameters, +and keyword parameters together: +

    +
    +
     ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1)   
+⇒  (1 3 NIL 1 ()) 
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 2)
+⇒  (1 2 NIL 1 ())
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) :c 7)
+⇒  (:c 7 NIL :c ())
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 6 :c 7)
+⇒  (1 6 7 1 (:c 7))
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 6 :d 8)
+⇒  (1 6 NIL 8 (:d 8))
+ ((lambda (a &optional (b 3) &rest x &key c (d a))
+    (list a b c d x)) 1 6 :d 8 :c 9 :d 10)
+⇒  (1 6 9 8 (:d 8 :c 9 :d 10))
+
    + +

    As an example of the use of &allow-other-keys and +:allow-other-keys, consider a function that takes two named +arguments of its own and also accepts additional named arguments to be +passed to make-array: +

    +
    +
     (defun array-of-strings (str dims &rest named-pairs
+                          &key (start 0) end &allow-other-keys)
+   (apply #'make-array dims
+          :initial-element (subseq str start end)
+          :allow-other-keys t
+          named-pairs))
+
    + +

    This function takes a string and dimensioning +information and returns an array of the specified +dimensions, each of whose elements is the specified +string. However, :start and :end named +arguments may be used to specify that a substring of the given +string should be used. In addition, the presence of +&allow-other-keys in the lambda list indicates that the +caller may supply additional named arguments; the rest parameter +provides access to them. These additional named arguments are passed +to make-array. The function make-array +normally does not allow the named arguments :start +and :end to be used, and an error should be +signaled if such named arguments are supplied to make-array. +However, the presence in the call to make-array +of the named argument :allow-other-keys with +a true value causes any extraneous named arguments, including +:start and :end, to be acceptable and ignored. +

    +
    +
    +

    +Previous: , Up: Ordinary Lambda Lists  

    +
    + + + + + diff --git a/info/gcl/Examples-of-Potential-Numbers.html b/info/gcl/Examples-of-Potential-Numbers.html new file mode 100644 index 0000000..b1c1717 --- /dev/null +++ b/info/gcl/Examples-of-Potential-Numbers.html @@ -0,0 +1,87 @@ + + + + + +Examples of Potential Numbers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Numbers as Tokens  

    +
    +
    +

    2.3.1.3 Examples of Potential Numbers

    + +

    As examples, the tokens in Figure 2–10 are potential numbers, +but they are not actually numbers, and so are reserved tokens; +a conforming implementation is permitted, but not required, +to define their meaning. +

    +
    +
      1b5000                       777777q                1.7J  -3/4+6.7J  12/25/83  
+  27^19                      3^4/5                6//7  3.1.2.6    ^-43^   
+  3.141_592_653_589_793_238_4  -3.7+2.6i-6.17j+19.6k  
+
+                     Figure 2–10: Examples of reserved tokens                   
+
+
    + +

    The tokens in Figure 2–11 are not potential numbers; +they are always treated as symbols: +

    +
    +
      /     /5     +  1+  1-     
+  foo+  ab.cd  _  ^   ^/-  
+
+  Figure 2–11: Examples of symbols
+
+
    + +

    The tokens in Figure 2–12 are potential numbers +if the current input base is 16, +but they are always treated as symbols if the current input base is 10. +

    +
    +
      bad-face  25-dec-83  a/b  fad_cafe  f^ 
+
+  Figure 2–12: Examples of symbols or potential numbers
+
+
    + + + + + + diff --git a/info/gcl/Examples-of-Printer-Behavior.html b/info/gcl/Examples-of-Printer-Behavior.html new file mode 100644 index 0000000..4f334f7 --- /dev/null +++ b/info/gcl/Examples-of-Printer-Behavior.html @@ -0,0 +1,105 @@ + + + + + +Examples of Printer Behavior (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: The Lisp Printer  

    +
    +
    +

    22.1.4 Examples of Printer Behavior

    + +
    +
     (let ((*print-escape* t)) (fresh-line) (write #\a))
+ |>  #\a
+⇒  #\a
+ (let ((*print-escape* nil) (*print-readably* nil))
+   (fresh-line)
+   (write #\a))
+ |>  a
+⇒  #\a
+ (progn (fresh-line) (prin1 #\a))
+ |>  #\a
+⇒  #\a
+ (progn (fresh-line) (print #\a))
+ |>  
+ |>  #\a
+⇒  #\a
+ (progn (fresh-line) (princ #\a))
+ |>  a
+⇒  #\a
+
+ (dolist (val '(t nil))
+   (let ((*print-escape* val) (*print-readably* val))
+     (print '#\a) 
+     (prin1 #\a) (write-char #\Space)
+     (princ #\a) (write-char #\Space)
+     (write #\a)))
+ |>  #\a #\a a #\a
+ |>  #\a #\a a a
+⇒  NIL
+
+ (progn (fresh-line) (write '(let ((a 1) (b 2)) (+ a b))))
+ |>  (LET ((A 1) (B 2)) (+ A B))
+⇒  (LET ((A 1) (B 2)) (+ A B))
+
+ (progn (fresh-line) (pprint '(let ((a 1) (b 2)) (+ a b))))
+ |>  (LET ((A 1)
+ |>        (B 2))               
+ |>    (+ A B))
+⇒  (LET ((A 1) (B 2)) (+ A B))
+
+ (progn (fresh-line) 
+        (write '(let ((a 1) (b 2)) (+ a b)) :pretty t))
+ |>  (LET ((A 1)
+ |>        (B 2))
+ |>    (+ A B))                 
+⇒  (LET ((A 1) (B 2)) (+ A B))
+
+ (with-output-to-string (s)  
+    (write 'write :stream s)
+    (prin1 'prin1 s))
+⇒  "WRITEPRIN1"
+
    + + + + + + + diff --git a/info/gcl/Examples-of-Printing-Arrays.html b/info/gcl/Examples-of-Printing-Arrays.html new file mode 100644 index 0000000..a22c5b4 --- /dev/null +++ b/info/gcl/Examples-of-Printing-Arrays.html @@ -0,0 +1,65 @@ + + + + + +Examples of Printing Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.17 Examples of Printing Arrays

    + +
    +
     (let ((a (make-array '(3 3)))
+       (*print-pretty* t)
+       (*print-array* t))
+   (dotimes (i 3) (dotimes (j 3) (setf (aref a i j) (format nil "<~D,~D>" i j))))
+   (print a)
+   (print (make-array 9 :displaced-to a)))
+ |>  #2A(("<0,0>" "<0,1>" "<0,2>") 
+ |>      ("<1,0>" "<1,1>" "<1,2>") 
+ |>      ("<2,0>" "<2,1>" "<2,2>")) 
+ |>  #("<0,0>" "<0,1>" "<0,2>" "<1,0>" "<1,1>" "<1,2>" "<2,0>" "<2,1>" "<2,2>") 
+⇒  #<ARRAY 9 indirect 36363476>
+
    + + + + + + diff --git a/info/gcl/Examples-of-REPEAT-clause.html b/info/gcl/Examples-of-REPEAT-clause.html new file mode 100644 index 0000000..a96a47f --- /dev/null +++ b/info/gcl/Examples-of-REPEAT-clause.html @@ -0,0 +1,63 @@ + + + + + +Examples of REPEAT clause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Termination Test Clauses  

    +
    +
    +

    6.1.4.1 Examples of REPEAT clause

    + +
    +
     (loop repeat 3
+       do (format t "~&What I say three times is true.~
+ |>  What I say three times is true.
+ |>  What I say three times is true.
+ |>  What I say three times is true.
+⇒  NIL
+ (loop repeat -15
+   do (format t "What you see is what you expect~
+⇒  NIL
+
    + + + + + + diff --git a/info/gcl/Examples-of-Resolution-of-Apparent-Conflict-in-Exceptional-Situations.html b/info/gcl/Examples-of-Resolution-of-Apparent-Conflict-in-Exceptional-Situations.html new file mode 100644 index 0000000..7868e6e --- /dev/null +++ b/info/gcl/Examples-of-Resolution-of-Apparent-Conflict-in-Exceptional-Situations.html @@ -0,0 +1,61 @@ + + + + + +Examples of Resolution of Apparent Conflict in Exceptional Situations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conforming Implementations  

    +
    +
    +

    1.5.1.6 Examples of Resolution of Apparent Conflict in Exceptional Situations

    + +

    Suppose that function foo is a member of a set S of functions that +operate on numbers. Suppose that one passage states that an error must be +signaled if any function in S is ever given an argument of 17. +Suppose that an apparently conflicting passage states that the consequences +are undefined if foo receives an argument of 17. Then the second passage +(the one specifically about foo) would dominate because the description of +the situational context is the most specific, and it would not be required that +foo signal an error on an argument of 17 even though other functions in +the set S would be required to do so. +

    + + + + + diff --git a/info/gcl/Examples-of-Rule-of-Canonical-Representation-for-Complex-Rationals.html b/info/gcl/Examples-of-Rule-of-Canonical-Representation-for-Complex-Rationals.html new file mode 100644 index 0000000..c53cfa5 --- /dev/null +++ b/info/gcl/Examples-of-Rule-of-Canonical-Representation-for-Complex-Rationals.html @@ -0,0 +1,62 @@ + + + + + +Examples of Rule of Canonical Representation for Complex Rationals (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Complex Computations  

    +
    +
    +

    12.1.5.4 Examples of Rule of Canonical Representation for Complex Rationals

    + +
    +
     #c(1.0 1.0) ⇒  #C(1.0 1.0)
+ #c(0.0 0.0) ⇒  #C(0.0 0.0)
+ #c(1.0 1) ⇒  #C(1.0 1.0)
+ #c(0.0 0) ⇒  #C(0.0 0.0)
+ #c(1 1) ⇒  #C(1 1)
+ #c(0 0) ⇒  0
+ (typep #c(1 1) '(complex (eql 1))) ⇒  true
+ (typep #c(0 0) '(complex (eql 0))) ⇒  false
+
    + + + + + + diff --git a/info/gcl/Examples-of-Rule-of-Float-and-Rational-Contagion.html b/info/gcl/Examples-of-Rule-of-Float-and-Rational-Contagion.html new file mode 100644 index 0000000..742cd49 --- /dev/null +++ b/info/gcl/Examples-of-Rule-of-Float-and-Rational-Contagion.html @@ -0,0 +1,70 @@ + + + + + +Examples of Rule of Float and Rational Contagion (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Floating-point Computations  

    +
    +
    +

    12.1.4.2 Examples of Rule of Float and Rational Contagion

    + +
    +
     ;;;; Combining rationals with floats.
+ ;;; This example assumes an implementation in which 
+ ;;; (float-radix 0.5) is 2 (as in IEEE) or 16 (as in IBM/360),
+ ;;; or else some other implementation in which 1/2 has an exact 
+ ;;;  representation in floating point.
+ (+ 1/2 0.5) ⇒  1.0
+ (- 1/2 0.5d0) ⇒  0.0d0
+ (+ 0.5 -0.5 1/2) ⇒  0.5
+
+ ;;;; Comparing rationals with floats.
+ ;;; This example assumes an implementation in which the default float 
+ ;;; format is IEEE single-float, IEEE double-float, or some other format
+ ;;; in which 5/7 is rounded upwards by FLOAT.
+ (< 5/7 (float 5/7)) ⇒  true
+ (< 5/7 (rational (float 5/7))) ⇒  true
+ (< (float 5/7) (float 5/7)) ⇒  false
+
    + + + + + + diff --git a/info/gcl/Examples-of-SUM-clause.html b/info/gcl/Examples-of-SUM-clause.html new file mode 100644 index 0000000..55f53fa --- /dev/null +++ b/info/gcl/Examples-of-SUM-clause.html @@ -0,0 +1,62 @@ + + + + + +Examples of SUM clause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Value Accumulation Clauses  

    +
    +
    +

    6.1.3.5 Examples of SUM clause

    + +
    +
     (loop for i of-type fixnum in '(1 2 3 4 5)
+       sum i)
+⇒  15
+ (setq series '(1.2 4.3 5.7))
+⇒  (1.2 4.3 5.7)
+ (loop for v in series 
+       sum (* 2.0 v))
+⇒  22.4
+
    + + + + + + diff --git a/info/gcl/Examples-of-Satisfying-a-One_002dArgument-Test.html b/info/gcl/Examples-of-Satisfying-a-One_002dArgument-Test.html new file mode 100644 index 0000000..323e94c --- /dev/null +++ b/info/gcl/Examples-of-Satisfying-a-One_002dArgument-Test.html @@ -0,0 +1,64 @@ + + + + + +Examples of Satisfying a One-Argument Test (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Satisfying a One-Argument Test  

    +
    +
    +

    17.2.2.1 Examples of Satisfying a One-Argument Test

    + +
    +
     (count-if #'zerop '(1 #C(0.0 0.0) 0 0.0d0 0.0s0 3)) ⇒  4
+
+ (remove-if-not #'symbolp '(0 1 2 3 4 5 6 7 8 9 A B C D E F))
+⇒  (A B C D E F)
+ (remove-if (complement #'symbolp) '(0 1 2 3 4 5 6 7 8 9 A B C D E F))
+⇒  (A B C D E F)
+
+ (count-if #'zerop '("foo" "" "bar" "" "" "baz" "quux") :key #'length)
+⇒  3
+
    + + + + + + + diff --git a/info/gcl/Examples-of-Satisfying-a-Two_002dArgument-Test.html b/info/gcl/Examples-of-Satisfying-a-Two_002dArgument-Test.html new file mode 100644 index 0000000..9854cc9 --- /dev/null +++ b/info/gcl/Examples-of-Satisfying-a-Two_002dArgument-Test.html @@ -0,0 +1,79 @@ + + + + + +Examples of Satisfying a Two-Argument Test (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Satisfying a Two-Argument Test  

    +
    +
    +

    17.2.1.1 Examples of Satisfying a Two-Argument Test

    + +
    +
     (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equal)
+⇒  (foo bar "BAR" "foo" "bar")
+ (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equalp)
+⇒  (foo bar "BAR" "bar")
+ (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string-equal)
+⇒  (bar "BAR" "bar")
+ (remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string=)
+⇒  (BAR "BAR" "foo" "bar")
+
+ (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'eql)
+⇒  (1)
+ (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'=)
+⇒  (1 1.0 #C(1.0 0.0))
+ (remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test (complement #'=))
+⇒  (1 1.0 #C(1.0 0.0))
+
+ (count 1 '((one 1) (uno 1) (two 2) (dos 2)) :key #'cadr) ⇒  2
+
+ (count 2.0 '(1 2 3) :test #'eql :key #'float) ⇒  1
+
+ (count "FOO" (list (make-pathname :name "FOO" :type "X")  
+                    (make-pathname :name "FOO" :type "Y"))
+        :key #'pathname-name
+        :test #'equal)
+⇒  2
+
    + + + + + + diff --git a/info/gcl/Examples-of-Self_002dEvaluating-Objects.html b/info/gcl/Examples-of-Self_002dEvaluating-Objects.html new file mode 100644 index 0000000..8592a66 --- /dev/null +++ b/info/gcl/Examples-of-Self_002dEvaluating-Objects.html @@ -0,0 +1,62 @@ + + + + + +Examples of Self-Evaluating Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.13 Examples of Self-Evaluating Objects

    + +

    Numbers, pathnames, and arrays are examples of +self-evaluating objects. +

    +
    +
     3 ⇒  3
+ #c(2/3 5/8) ⇒  #C(2/3 5/8)
+ #p"S:[BILL]OTHELLO.TXT" ⇒  #P"S:[BILL]OTHELLO.TXT"
+ #(a b c) ⇒  #(A B C)
+ "fred smith" ⇒  "fred smith"
+
    + + + + + + diff --git a/info/gcl/Examples-of-Semicolon.html b/info/gcl/Examples-of-Semicolon.html new file mode 100644 index 0000000..0de9e8c --- /dev/null +++ b/info/gcl/Examples-of-Semicolon.html @@ -0,0 +1,57 @@ + + + + + +Examples of Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Semicolon  

    +
    +
    +

    2.4.4.1 Examples of Semicolon

    + +
    +
     (+ 3 ; three
+    4)
+⇒  7    
+
    + + + + + + diff --git a/info/gcl/Examples-of-Setf-Expansions.html b/info/gcl/Examples-of-Setf-Expansions.html new file mode 100644 index 0000000..807db30 --- /dev/null +++ b/info/gcl/Examples-of-Setf-Expansions.html @@ -0,0 +1,111 @@ + + + + + +Examples of Setf Expansions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Overview of Places and Generalized Reference  

    +
    +
    +

    5.1.1.4 Examples of Setf Expansions

    + +

    Examples of the contents of the constituents of setf expansions +follow. +

    +

    For a variable x: +

    +
    +
      ()              ;list of temporary variables  
+  ()              ;list of value forms          
+  (g0001)         ;list of store variables      
+  (setq x g0001)  ;storing form                 
+  x               ;accessing form               
+
+  Figure 5–3: Sample Setf Expansion of a Variable
+
+
    + +

    For (car exp): +

    +
    +
      (g0002)                             ;list of temporary variables  
+  (exp)                               ;list of value forms          
+  (g0003)                             ;list of store variables      
+  (progn (rplaca g0002 g0003) g0003)  ;storing form                 
+  (car g0002)                         ;accessing form               
+
+           Figure 5–4: Sample Setf Expansion of a CAR Form         
+
+
    + +

    For (subseq seq s e): +

    +
    +
      (g0004 g0005 g0006)         ;list of temporary variables  
+  (seq s e)                   ;list of value forms          
+  (g0007)                     ;list of store variables      
+  (progn (replace g0004 g0007 :start1 g0005 :end1 g0006) g0007) 
+                              ;storing form                 
+  (subseq g0004 g0005 g0006)  ; accessing form              
+
+     Figure 5–5: Sample Setf Expansion of a SUBSEQ Form    
+
+
    + +

    In some cases, if a subform of a place is itself +a place, it is necessary to expand the subform +in order to compute some of the values in the expansion of the outer +place. For (ldb bs (car exp)): +

    +
    +
      (g0001 g0002)            ;list of temporary variables  
+  (bs exp)                 ;list of value forms          
+  (g0003)                  ;list of store variables      
+  (progn (rplaca g0002 (dpb g0003 g0001 (car g0002))) g0003) 
+                           ;storing form                 
+  (ldb g0001 (car g0002))  ; accessing form              
+
+     Figure 5–6: Sample Setf Expansion of a LDB Form    
+
+
    + + + + + + diff --git a/info/gcl/Examples-of-Sharpsign-Asterisk.html b/info/gcl/Examples-of-Sharpsign-Asterisk.html new file mode 100644 index 0000000..75237a1 --- /dev/null +++ b/info/gcl/Examples-of-Sharpsign-Asterisk.html @@ -0,0 +1,68 @@ + + + + + +Examples of Sharpsign Asterisk (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.5 Examples of Sharpsign Asterisk

    + +

    For example, +

    +
      #*101111
+ #6*101111
+ #6*101
+ #6*1011
+
    + +

    all mean the same thing: a vector of length 6 +with elements 1, 0, 1, 1, 1, and 1. +

    +

    For example: +

    +
    +
     #*         ;An empty bit-vector
+
    + + + + + + diff --git a/info/gcl/Examples-of-Sharpsign-Vertical_002dBar.html b/info/gcl/Examples-of-Sharpsign-Vertical_002dBar.html new file mode 100644 index 0000000..867e683 --- /dev/null +++ b/info/gcl/Examples-of-Sharpsign-Vertical_002dBar.html @@ -0,0 +1,115 @@ + + + + + +Examples of Sharpsign Vertical-Bar (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.21 Examples of Sharpsign Vertical-Bar

    + +

    The following are some examples that exploit the #|...|# notation: +

    +
    +
    ;;; In this example, some debugging code is commented out with #|...|#
+;;; Note that this kind of comment can occur in the middle of a line
+;;; (because a delimiter marks where the end of the comment occurs)
+;;; where a semicolon comment can only occur at the end of a line 
+;;; (because it comments out the rest of the line).
+ (defun add3 (n) #|(format t "~&Adding 3 to ~D." n)|# (+ n 3))
+
+;;; The examples that follow show issues related to #| ... |# nesting.
+
+;;; In this first example, #| and |# always occur properly paired,
+;;; so nesting works naturally.
+ (defun mention-fun-fact-1a ()
+   (format t "CL uses ; and #|...|# in comments."))
+⇒  MENTION-FUN-FACT-1A
+ (mention-fun-fact-1a)
+ |>  CL uses ; and #|...|# in comments.
+⇒  NIL
+ #| (defun mention-fun-fact-1b ()
+      (format t "CL uses ; and #|...|# in comments.")) |#
+ (fboundp 'mention-fun-fact-1b) ⇒  NIL
+
+;;; In this example, vertical-bar followed by sharpsign needed to appear
+;;; in a string without any matching sharpsign followed by vertical-bar
+;;; having preceded this.  To compensate, the programmer has included a
+;;; slash separating the two characters.  In case 2a, the slash is 
+;;; unnecessary but harmless, but in case 2b, the slash is critical to
+;;; allowing the outer #| ... |# pair match.  If the slash were not present,
+;;; the outer comment would terminate prematurely.
+ (defun mention-fun-fact-2a ()
+   (format t "Don't use |\# unmatched or you'll get in trouble!"))
+⇒  MENTION-FUN-FACT-2A
+ (mention-fun-fact-2a)
+ |>  Don't use |# unmatched or you'll get in trouble!
+⇒  NIL
+ #| (defun mention-fun-fact-2b ()
+      (format t "Don't use |\# unmatched or you'll get in trouble!") |#
+ (fboundp 'mention-fun-fact-2b) ⇒  NIL
+
+;;; In this example, the programmer attacks the mismatch problem in a
+;;; different way.  The sharpsign vertical bar in the comment is not needed
+;;; for the correct parsing of the program normally (as in case 3a), but 
+;;; becomes important to avoid premature termination of a comment when such 
+;;; a program is commented out (as in case 3b).
+ (defun mention-fun-fact-3a () ; #|
+   (format t "Don't use |# unmatched or you'll get in trouble!"))
+⇒  MENTION-FUN-FACT-3A
+ (mention-fun-fact-3a)
+ |>  Don't use |# unmatched or you'll get in trouble!
+⇒  NIL
+ #|
+ (defun mention-fun-fact-3b () ; #|
+   (format t "Don't use |# unmatched or you'll get in trouble!"))
+ |#
+ (fboundp 'mention-fun-fact-3b) ⇒  NIL
+
    + +
    +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    + + + + + diff --git a/info/gcl/Examples-of-Single-Escape-Characters.html b/info/gcl/Examples-of-Single-Escape-Characters.html new file mode 100644 index 0000000..63630af --- /dev/null +++ b/info/gcl/Examples-of-Single-Escape-Characters.html @@ -0,0 +1,60 @@ + + + + + +Examples of Single Escape Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.8 Examples of Single Escape Characters

    + +
    +
     ;; The following examples assume the readtable case of *readtable* 
+ ;; and *print-case* are both :upcase.
+ (eq 'abc '\A\B\C) ⇒  true
+ (eq 'abc 'a\Bc) ⇒  true
+ (eq 'abc '\ABC) ⇒  true
+ (eq 'abc '\abc) ⇒  false
+
    + + + + + + diff --git a/info/gcl/Examples-of-Single_002dQuote.html b/info/gcl/Examples-of-Single_002dQuote.html new file mode 100644 index 0000000..159b6c0 --- /dev/null +++ b/info/gcl/Examples-of-Single_002dQuote.html @@ -0,0 +1,57 @@ + + + + + +Examples of Single-Quote (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Single-Quote  

    +
    +
    +

    2.4.3.1 Examples of Single-Quote

    + +
    +
     'foo ⇒  FOO
+ ''foo ⇒  (QUOTE FOO)
+ (car ''foo) ⇒  QUOTE
+
    + + + + + + diff --git a/info/gcl/Examples-of-Style-for-Semicolon.html b/info/gcl/Examples-of-Style-for-Semicolon.html new file mode 100644 index 0000000..91eabb0 --- /dev/null +++ b/info/gcl/Examples-of-Style-for-Semicolon.html @@ -0,0 +1,72 @@ + + + + + +Examples of Style for Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Semicolon  

    +
    +
    +

    2.4.4.7 Examples of Style for Semicolon

    + +
    +
    ;;;; Math Utilities
+
+;;; FIB computes the the Fibonacci function in the traditional
+;;; recursive way.
+
+(defun fib (n)
+  (check-type n integer)
+  ;; At this point we're sure we have an integer argument.
+  ;; Now we can get down to some serious computation.
+  (cond ((< n 0)
+         ;; Hey, this is just supposed to be a simple example.
+         ;; Did you really expect me to handle the general case?
+         (error "FIB got ~D as an argument." n))
+        ((< n 2) n)             ;fib[0]=0 and fib[1]=1
+        ;; The cheap cases didn't work.
+        ;; Nothing more to do but recurse.
+        (t (+ (fib (- n 1))     ;The traditional formula
+              (fib (- n 2)))))) ; is fib[n-1]+fib[n-2].
+
    + + + + + + diff --git a/info/gcl/Examples-of-Suppressing-Keyword-Argument-Checking.html b/info/gcl/Examples-of-Suppressing-Keyword-Argument-Checking.html new file mode 100644 index 0000000..6d4e75d --- /dev/null +++ b/info/gcl/Examples-of-Suppressing-Keyword-Argument-Checking.html @@ -0,0 +1,70 @@ + + + + + +Examples of Suppressing Keyword Argument Checking (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.6 Examples of Suppressing Keyword Argument Checking

    + +
    +
    ;;; The caller can supply :ALLOW-OTHER-KEYS T to suppress checking.
+ ((lambda (&key x) x) :x 1 :y 2 :allow-other-keys t) ⇒  1
+;;; The callee can use &ALLOW-OTHER-KEYS to suppress checking.
+ ((lambda (&key x &allow-other-keys) x) :x 1 :y 2) ⇒  1
+;;; :ALLOW-OTHER-KEYS NIL is always permitted.
+ ((lambda (&key) t) :allow-other-keys nil) ⇒  T
+;;; As with other keyword arguments, only the left-most pair
+;;; named :ALLOW-OTHER-KEYS has any effect.
+ ((lambda (&key x) x) 
+  :x 1 :y 2 :allow-other-keys t :allow-other-keys nil)
+⇒  1
+;;; Only the left-most pair named :ALLOW-OTHER-KEYS has any effect,
+;;; so in safe code this signals a PROGRAM-ERROR (and might enter the
+;;; debugger).  In unsafe code, the consequences are undefined.
+ ((lambda (&key x) x)                   ;This call is not valid
+  :x 1 :y 2 :allow-other-keys nil :allow-other-keys t)
+
    + + + + + + diff --git a/info/gcl/Examples-of-Transfer-of-Control-during-a-Destructive-Operation.html b/info/gcl/Examples-of-Transfer-of-Control-during-a-Destructive-Operation.html new file mode 100644 index 0000000..1c47ab8 --- /dev/null +++ b/info/gcl/Examples-of-Transfer-of-Control-during-a-Destructive-Operation.html @@ -0,0 +1,71 @@ + + + + + +Examples of Transfer of Control during a Destructive Operation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Transfer of Control during a Destructive Operation  

    +
    +
    +

    3.7.2.1 Examples of Transfer of Control during a Destructive Operation

    + +

    The following examples illustrate some of the many ways in which the +implementation-dependent nature of the modification can manifest +itself. +

    +
    +
     (let ((a (list 2 1 4 3 7 6 'five)))
+   (ignore-errors (sort a #'<))
+   a)
+⇒  (1 2 3 4 6 7 FIVE)
+OR⇒ (2 1 4 3 7 6 FIVE)
+OR⇒ (2)
+
+ (prog foo ((a (list 1 2 3 4 5 6 7 8 9 10)))
+   (sort a #'(lambda (x y) (if (zerop (random 5)) (return-from foo a) (> x y)))))
+⇒  (1 2 3 4 5 6 7 8 9 10)
+OR⇒ (3 4 5 6 2 7 8 9 10 1)
+OR⇒ (1 2 4 3)
+
    + + + + + + + diff --git a/info/gcl/Examples-of-Truenames.html b/info/gcl/Examples-of-Truenames.html new file mode 100644 index 0000000..4e14e26 --- /dev/null +++ b/info/gcl/Examples-of-Truenames.html @@ -0,0 +1,79 @@ + + + + + +Examples of Truenames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Truenames  

    +
    +
    +

    20.1.3.1 Examples of Truenames

    + +

    For example, a DEC TOPS-20 system with files PS:<JOE>FOO.TXT.1 +and PS:<JOE>FOO.TXT.2 might permit the second file to be referred +to as PS:<JOE>FOO.TXT.0, since the “.0” notation denotes “newest” +version of several files. +In the same file system, a “logical device” “JOE:” might be +taken to refer to PS:<JOE>” and so the names JOE:FOO.TXT.2 or +JOE:FOO.TXT.0 might refer to PS:<JOE>FOO.TXT.2. +In all of these cases, the truename of the file would probably be +PS:<JOE>FOO.TXT.2. +

    +

    If a file is a symbolic link to another file (in a file system +permitting such a thing), it is conventional for the truename to be +the canonical name of the file after any symbolic links have been followed; +that is, it is the canonical name of the file whose contents would +become available if an input stream to that file were +opened. +

    +

    In the case of a file still being created (that is, of an output +stream open to such a file), the exact truename of the file +might not be known until the stream is closed. In this case, +the function truename might return different values for such a stream +before and after it was closed. In fact, before it is closed, the name returned +might not even be a valid name in the file system—for example, while a +file is being written, it might have version :newest and might only take on +a specific numeric value later when the file is closed even in a file system +where all files have numeric versions. +

    + + + + + + diff --git a/info/gcl/Examples-of-WHEN-clause.html b/info/gcl/Examples-of-WHEN-clause.html new file mode 100644 index 0000000..85c01f5 --- /dev/null +++ b/info/gcl/Examples-of-WHEN-clause.html @@ -0,0 +1,95 @@ + + + + + +Examples of WHEN clause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conditional Execution Clauses  

    +
    +
    +

    6.1.6.1 Examples of WHEN clause

    + +
    +
    ;; Signal an exceptional condition.
+ (loop for item in '(1 2 3 a 4 5)
+       when (not (numberp item))
+        return (cerror "enter new value" "non-numeric value: ~s" item))
+Error: non-numeric value: A
+
+;; The previous example is equivalent to the following one.
+ (loop for item in '(1 2 3 a 4 5)
+       when (not (numberp item))
+        do (return 
+            (cerror "Enter new value" "non-numeric value: ~s" item)))
+Error: non-numeric value: A
+
    + +
    +
    ;; This example parses a simple printed string representation from 
+;; BUFFER (which is itself a string) and returns the index of the
+;; closing double-quote character.
+ (let ((buffer "\"a\" \"b\""))
+   (loop initially (unless (char= (char buffer 0) #\")
+                     (loop-finish))
+         for i of-type fixnum from 1 below (length (the string buffer))
+         when (char= (char buffer i) #\")
+          return i))
+⇒  2
+
+;; The collected value is returned.
+ (loop for i from 1 to 10
+       when (> i 5)
+         collect i
+       finally (prin1 'got-here))
+ |>  GOT-HERE
+⇒  (6 7 8 9 10) 
+
+;; Return both the count of collected numbers and the numbers.
+ (loop for i from 1 to 10
+       when (> i 5)
+         collect i into number-list
+         and count i into number-count
+       finally (return (values number-count number-list)))
+⇒  5, (6 7 8 9 10)
+
    + + + + + + diff --git a/info/gcl/Examples-of-WHILE-and-UNTIL-clauses.html b/info/gcl/Examples-of-WHILE-and-UNTIL-clauses.html new file mode 100644 index 0000000..57050b9 --- /dev/null +++ b/info/gcl/Examples-of-WHILE-and-UNTIL-clauses.html @@ -0,0 +1,72 @@ + + + + + +Examples of WHILE and UNTIL clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Termination Test Clauses  

    +
    +
    +

    6.1.4.3 Examples of WHILE and UNTIL clauses

    + +
    +
     (loop while (hungry-p) do (eat))
+
+;; UNTIL NOT is equivalent to WHILE.
+ (loop until (not (hungry-p)) do (eat))
+
+;; Collect the length and the items of STACK.
+ (let ((stack '(a b c d e f)))
+   (loop for item = (length stack) then (pop stack)
+         collect item
+         while stack))
+⇒  (6 A B C D E F)
+
+;; Use WHILE to terminate a loop that otherwise wouldn't terminate.
+;; Note that WHILE occurs after the WHEN.
+ (loop for i fixnum from 3
+       when (oddp i) collect i
+       while (< i 5))
+⇒  (3 5)
+
    + + + + + + diff --git a/info/gcl/Examples-of-WITH-clause.html b/info/gcl/Examples-of-WITH-clause.html new file mode 100644 index 0000000..fff15b2 --- /dev/null +++ b/info/gcl/Examples-of-WITH-clause.html @@ -0,0 +1,81 @@ + + + + + +Examples of WITH clause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.16 Examples of WITH clause

    + +
    +
    ;; These bindings occur in sequence.
+ (loop with a = 1 
+       with b = (+ a 2) 
+       with c = (+ b 3)
+       return (list a b c))
+⇒  (1 3 6)
+
+;; These bindings occur in parallel.
+ (setq a 5 b 10)
+⇒  10
+ (loop with a = 1
+       and b = (+ a 2)
+       and c = (+ b 3)
+       return (list a b c))
+⇒  (1 7 13)
+
+;; This example shows a shorthand way to declare local variables 
+;; that are of different types.
+ (loop with (a b c) of-type (float integer float)
+       return (format nil "~A ~A ~A" a b c))
+⇒  "0.0 0 0.0"
+
+;; This example shows a shorthand way to declare local variables 
+;; that are the same type.
+ (loop with (a b c) of-type float 
+       return (format nil "~A ~A ~A" a b c))
+⇒  "0.0 0.0 0.0"
+
    + + + + + + diff --git a/info/gcl/Examples-of-Whitespace-Characters.html b/info/gcl/Examples-of-Whitespace-Characters.html new file mode 100644 index 0000000..ad63514 --- /dev/null +++ b/info/gcl/Examples-of-Whitespace-Characters.html @@ -0,0 +1,61 @@ + + + + + +Examples of Whitespace Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.10 Examples of Whitespace Characters

    + +
    +
     (length '(this-that)) ⇒  1
+ (length '(this - that)) ⇒  3
+ (length '(a
+           b)) ⇒  2
+ (+ 34) ⇒  34
+ (+ 3 4) ⇒  7
+
    + + + + + + + diff --git a/info/gcl/Examples-of-clause-grouping.html b/info/gcl/Examples-of-clause-grouping.html new file mode 100644 index 0000000..7615826 --- /dev/null +++ b/info/gcl/Examples-of-clause-grouping.html @@ -0,0 +1,126 @@ + + + + + +Examples of clause grouping (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Examples of Miscellaneous Loop Features  

    +
    +
    +

    6.1.8.1 Examples of clause grouping

    + +
    +
    ;; Group conditional clauses.
+ (loop for i in '(1 324 2345 323 2 4 235 252)
+       when (oddp i)
+         do (print i)
+         and collect i into odd-numbers
+         and do (terpri)
+       else                              ; I is even.
+         collect i into even-numbers
+       finally
+         (return (values odd-numbers even-numbers)))
+ |>  1 
+ |>  
+ |>  2345 
+ |>  
+ |>  323 
+ |>  
+ |>  235 
+⇒  (1 2345 323 235), (324 2 4 252)
+
+;; Collect numbers larger than 3.
+ (loop for i in '(1 2 3 4 5 6)
+       when (and (> i 3) i)
+       collect it)                      ; IT refers to (and (> i 3) i).
+⇒  (4 5 6)
+
+;; Find a number in a list.
+ (loop for i in '(1 2 3 4 5 6)
+       when (and (> i 3) i)
+       return it)
+⇒  4
+
+;; The above example is similar to the following one.
+ (loop for i in '(1 2 3 4 5 6)
+       thereis (and (> i 3) i))
+⇒  4
+
+;; Nest conditional clauses.
+ (let ((list '(0 3.0 apple 4 5 9.8 orange banana)))
+   (loop for i in list
+         when (numberp i)
+           when (floatp i)
+             collect i into float-numbers
+           else                                  ; Not (floatp i)
+             collect i into other-numbers
+         else                                    ; Not (numberp i)
+           when (symbolp i) 
+             collect i into symbol-list
+           else                                  ; Not (symbolp i)
+             do (error "found a funny value in list ~S, value ~S~
+         finally (return (values float-numbers other-numbers symbol-list))))
+⇒  (3.0 9.8), (0 4 5), (APPLE ORANGE BANANA)
+
+;; Without the END preposition, the last AND would apply to the
+;; inner IF rather than the outer one.
+ (loop for x from 0 to 3 
+       do (print x)
+       if (zerop (mod x 2))
+         do (princ " a")
+          and if (zerop (floor x 2))
+                do (princ " b")
+                end
+          and do (princ " c"))
+ |>  0  a b c
+ |>  1 
+ |>  2  a c
+ |>  3 
+⇒  NIL
+
    + +
    +
    +

    +Previous: , Up: Examples of Miscellaneous Loop Features  

    +
    + + + + + diff --git a/info/gcl/Examples-of-for_002das_002dacross-subclause.html b/info/gcl/Examples-of-for_002das_002dacross-subclause.html new file mode 100644 index 0000000..69ddddf --- /dev/null +++ b/info/gcl/Examples-of-for_002das_002dacross-subclause.html @@ -0,0 +1,56 @@ + + + + + +Examples of for-as-across subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.11 Examples of for-as-across subclause

    + +
    +
     (loop for char across (the simple-string (find-message channel))
+       do (write-char char stream))
+
    + + + + + + diff --git a/info/gcl/Examples-of-for_002das_002darithmetic-subclause.html b/info/gcl/Examples-of-for_002das_002darithmetic-subclause.html new file mode 100644 index 0000000..dbd153d --- /dev/null +++ b/info/gcl/Examples-of-for_002das_002darithmetic-subclause.html @@ -0,0 +1,78 @@ + + + + + +Examples of for-as-arithmetic subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.3 Examples of for-as-arithmetic subclause

    + +
    +
    ;; Print some numbers.
+ (loop for i from 1 to 3
+       do (print i))
+ |>  1
+ |>  2
+ |>  3
+⇒  NIL
+
+;; Print every third number.
+ (loop for i from 10 downto 1 by 3
+       do (print i))
+ |>  10 
+ |>  7 
+ |>  4 
+ |>  1 
+⇒  NIL
+
+;; Step incrementally from the default starting value.
+ (loop for i below 3
+       do (print i))
+ |>  0
+ |>  1
+ |>  2
+⇒  NIL
+
    + + + + + + diff --git a/info/gcl/Examples-of-for_002das_002dequals_002dthen-subclause.html b/info/gcl/Examples-of-for_002das_002dequals_002dthen-subclause.html new file mode 100644 index 0000000..7641c8e --- /dev/null +++ b/info/gcl/Examples-of-for_002das_002dequals_002dthen-subclause.html @@ -0,0 +1,59 @@ + + + + + +Examples of for-as-equals-then subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.9 Examples of for-as-equals-then subclause

    + +
    +
    ;; Collect some numbers.
+ (loop for item = 1 then (+ item 10)
+       for iteration from 1 to 5
+       collect item)
+⇒  (1 11 21 31 41)
+
    + + + + + + diff --git a/info/gcl/Examples-of-for_002das_002din_002dlist-subclause.html b/info/gcl/Examples-of-for_002das_002din_002dlist-subclause.html new file mode 100644 index 0000000..abdc815 --- /dev/null +++ b/info/gcl/Examples-of-for_002das_002din_002dlist-subclause.html @@ -0,0 +1,73 @@ + + + + + +Examples of for-as-in-list subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.5 Examples of for-as-in-list subclause

    + +
    +
    ;; Print every item in a list.
+ (loop for item in '(1 2 3) do (print item))
+ |>  1
+ |>  2
+ |>  3
+⇒  NIL
+
+;; Print every other item in a list.
+ (loop for item in '(1 2 3 4 5) by #'cddr
+       do (print item))
+ |>  1
+ |>  3
+ |>  5
+⇒  NIL
+
+;; Destructure a list, and sum the x values using fixnum arithmetic.
+ (loop for (item . x) of-type (t . fixnum) in '((A . 1) (B . 2) (C . 3))
+       unless (eq item 'B) sum x)
+⇒  4
+
    + + + + + + diff --git a/info/gcl/Examples-of-for_002das_002don_002dlist-subclause.html b/info/gcl/Examples-of-for_002das_002don_002dlist-subclause.html new file mode 100644 index 0000000..0ddf1b7 --- /dev/null +++ b/info/gcl/Examples-of-for_002das_002don_002dlist-subclause.html @@ -0,0 +1,67 @@ + + + + + +Examples of for-as-on-list subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.7 Examples of for-as-on-list subclause

    + +
    +
    ;; Collect successive tails of a list.
+ (loop for sublist on '(a b c d)
+       collect sublist)
+⇒  ((A B C D) (B C D) (C D) (D))
+
+;; Print a list by using destructuring with the loop keyword ON.
+ (loop for (item) on '(1 2 3)
+       do (print item))
+ |>  1 
+ |>  2 
+ |>  3 
+⇒  NIL
+
+
    + + + + + + diff --git a/info/gcl/Examples-of-for_002das_002dpackage-subclause.html b/info/gcl/Examples-of-for_002das_002dpackage-subclause.html new file mode 100644 index 0000000..ba951a9 --- /dev/null +++ b/info/gcl/Examples-of-for_002das_002dpackage-subclause.html @@ -0,0 +1,65 @@ + + + + + +Examples of for-as-package subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.14 Examples of for-as-package subclause

    + +
    +
     (let ((*package* (make-package "TEST-PACKAGE-1")))
+   ;; For effect, intern some symbols
+   (read-from-string "(THIS IS A TEST)")
+   (export (intern "THIS"))
+   (loop for x being each present-symbol of *package*
+          do (print x)))
+ |>  A 
+ |>  TEST 
+ |>  THIS
+ |>  IS 
+⇒  NIL
+
    + + + + + + diff --git a/info/gcl/Examples-of-unconditional-execution.html b/info/gcl/Examples-of-unconditional-execution.html new file mode 100644 index 0000000..1749dbb --- /dev/null +++ b/info/gcl/Examples-of-unconditional-execution.html @@ -0,0 +1,67 @@ + + + + + +Examples of unconditional execution (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Unconditional Execution Clauses  

    +
    +
    +

    6.1.5.1 Examples of unconditional execution

    + +
    +
    ;; Print numbers and their squares.
+;; The DO construct applies to multiple forms.
+ (loop for i from 1 to 3
+       do (print i)
+          (print (* i i)))
+ |>  1 
+ |>  1 
+ |>  2 
+ |>  4 
+ |>  3 
+ |>  9 
+⇒  NIL
+
+
    + + + + + + diff --git a/info/gcl/Examples-of-using-the-Pretty-Printer.html b/info/gcl/Examples-of-using-the-Pretty-Printer.html new file mode 100644 index 0000000..0167867 --- /dev/null +++ b/info/gcl/Examples-of-using-the-Pretty-Printer.html @@ -0,0 +1,385 @@ + + + + + +Examples of using the Pretty Printer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Lisp Pretty Printer  

    +
    +
    +

    22.2.2 Examples of using the Pretty Printer

    + +

    As an example of the interaction of logical blocks, conditional newlines, +and indentation, consider the function simple-pprint-defun below. This +function prints out lists whose cars are defun in the +standard way assuming that the list has exactly length 4. +

    +
    +
    (defun simple-pprint-defun (*standard-output* list)
+  (pprint-logical-block (*standard-output* list :prefix "(" :suffix ")")
+    (write (first list))
+    (write-char #\Space)
+    (pprint-newline :miser)
+    (pprint-indent :current 0)
+    (write (second list))
+    (write-char #\Space)
+    (pprint-newline :fill)
+    (write (third list))
+    (pprint-indent :block 1)
+    (write-char #\Space)
+    (pprint-newline :linear)
+    (write (fourth list))))
+
    + +

    Suppose that one evaluates the following: +

    +
    +
    (simple-pprint-defun *standard-output* '(defun prod (x y) (* x y)))
+
    + +

    If the line width available is greater than or equal to 26, then all of the +output appears on one line. If the line width available is reduced to 25, +a line break is inserted at the +linear-style conditional newline + +

    +

    before the +expression (* x y), producing the output shown. The +(pprint-indent :block 1) causes (* x y) to be printed at a relative +indentation of 1 in the logical block. +

    +
    +
     (DEFUN PROD (X Y) 
+   (* X Y))
+
    + +

    If the line width available is 15, a line break is also inserted at the +fill style conditional newline before the argument list. The call on +(pprint-indent :current 0) causes the argument list to line up under the +function name. +

    +
    +
    (DEFUN PROD
+       (X Y)
+  (* X Y))
+
    + +

    If *print-miser-width* were greater than or equal to 14, the example +output above would have been as follows, because all indentation changes +are ignored in miser mode and line breaks are inserted at +miser-style conditional newlines. + +

    +
    +
     (DEFUN
+  PROD
+  (X Y)
+  (* X Y))
+
    + +

    As an example of a per-line prefix, consider that evaluating the following +produces the output shown with a line width of 20 and +*print-miser-width* of nil. +

    +
    +
     (pprint-logical-block (*standard-output* nil :per-line-prefix ";;; ")
+   (simple-pprint-defun *standard-output* '(defun prod (x y) (* x y))))
+
+ ;;; (DEFUN PROD
+ ;;;        (X Y)
+ ;;;   (* X Y))
+
    + +

    As a more complex (and realistic) example, consider the function pprint-let +below. This specifies how to print a let form in the traditional +style. It is more complex than the example above, because it has to deal with +nested structure. Also, unlike the example above it contains complete code to +readably print any possible list that begins with the symbol let. +The outermost pprint-logical-block form handles the printing of +the input list as a whole and specifies that parentheses should be printed in the +output. The second pprint-logical-block form handles the list +of binding pairs. Each pair in the list is itself printed by the innermost +pprint-logical-block. (A loop form is used instead of +merely decomposing the pair into two objects so that readable output will +be produced no matter whether the list corresponding to the pair has one element, +two elements, or (being malformed) has more than two elements.) +A space and a +fill-style conditional newline + +

    +

    are placed after +each pair except the last. The loop at the end of the topmost +pprint-logical-block form prints out the forms in the body +of the let form separated by spaces and +linear-style conditional newlines. +

    +
    +
     (defun pprint-let (*standard-output* list)
+   (pprint-logical-block (nil list :prefix "(" :suffix ")")
+     (write (pprint-pop))
+     (pprint-exit-if-list-exhausted)
+     (write-char #\Space)
+     (pprint-logical-block (nil (pprint-pop) :prefix "(" :suffix ")")
+       (pprint-exit-if-list-exhausted)
+       (loop (pprint-logical-block (nil (pprint-pop) :prefix "(" :suffix ")")
+               (pprint-exit-if-list-exhausted)
+               (loop (write (pprint-pop))
+                     (pprint-exit-if-list-exhausted)
+                     (write-char #\Space)
+                     (pprint-newline :linear)))
+             (pprint-exit-if-list-exhausted)
+             (write-char #\Space)
+             (pprint-newline :fill)))
+     (pprint-indent :block 1)
+     (loop (pprint-exit-if-list-exhausted)
+           (write-char #\Space)
+           (pprint-newline :linear)
+           (write (pprint-pop)))))
+
    + +

    Suppose that one evaluates the following with *print-level* being 4, +and *print-circle* being true. +

    +
    +
     (pprint-let *standard-output*
+             '#1=(let (x (*print-length* (f (g 3))) 
+                       (z . 2) (k (car y)))
+                   (setq x (sqrt z)) #1#))
+
    + +

    If the line length is greater than or equal to 77, the output produced +appears on one line. However, if the line length is 76, line breaks are +inserted at the linear-style conditional newlines separating the forms in +the body and the output below is produced. Note that, the degenerate +binding pair x is printed readably even though it fails to be a list; a +depth abbreviation marker is printed in place of (g 3); the binding pair +(z . 2) is printed readably even though it is not a proper list; and +appropriate circularity markers are printed. +

    +
    +
     #1=(LET (X (*PRINT-LENGTH* (F #)) (Z . 2) (K (CAR Y))) 
+      (SETQ X (SQRT Z))
+      #1#)
+
    + +

    If the line length is reduced to 35, a line break is inserted at one of the +fill-style conditional newlines separating the binding pairs. +

    +
    +
     #1=(LET (X (*PRINT-PRETTY* (F #))
+          (Z . 2) (K (CAR Y)))
+      (SETQ X (SQRT Z))
+      #1#)
+
    + +

    Suppose that the line length is further reduced to 22 and *print-length* is +set to 3. In this situation, line breaks are inserted after both the first +and second binding pairs. In addition, the second binding pair is itself +broken across two lines. Clause (b) of the description of fill-style +conditional newlines (see the function pprint-newline) +prevents the binding pair (z . 2) from being printed +at the end of the third line. Note that the length abbreviation hides the +circularity from view and therefore the printing of circularity markers +disappears. +

    +
    +
     (LET (X
+       (*PRINT-LENGTH*
+        (F #))
+       (Z . 2) ...)
+   (SETQ X (SQRT Z))
+   ...)
+
    + +

    The next function prints a vector using “#(...)” notation. +

    +
    +
    (defun pprint-vector (*standard-output* v)
+  (pprint-logical-block (nil nil :prefix "#(" :suffix ")")
+    (let ((end (length v)) (i 0))
+      (when (plusp end)
+        (loop (pprint-pop)
+              (write (aref v i))
+              (if (= (incf i) end) (return nil))
+              (write-char #\Space)
+              (pprint-newline :fill))))))
+
    + +

    Evaluating the following with a line length of 15 produces the output shown. +

    +
    +
     (pprint-vector *standard-output* '#(12 34 567 8 9012 34 567 89 0 1 23))
+
+ #(12 34 567 8 
+   9012 34 567 
+   89 0 1 23)
+
    + +

    As examples of the convenience of specifying pretty printing with +format strings, consider that the functions simple-pprint-defun +and pprint-let used as examples above can be compactly defined as follows. +(The function pprint-vector cannot be defined using format +because the data structure it traverses is not a list.) +

    +
    +
    (defun simple-pprint-defun (*standard-output* list)
+  (format T "~:<~W ~@_~:I~W ~:_~W~1I ~_~W~:>" list))
+
+(defun pprint-let (*standard-output* list)
+  (format T "~:<~W~^~:<~@{~:<~@{~W~^~_~}~:>~^~:_~}~:>~1I~@{~^~_~W~}~:>" list)) 
+
    + +

    In the following example, the first form restores +*print-pprint-dispatch* to the equivalent of its initial value. +The next two forms then set up a special way to pretty print ratios. +Note that the more specific type specifier has to be associated +with a higher priority. +

    +
    +
     (setq *print-pprint-dispatch* (copy-pprint-dispatch nil))
+
+ (set-pprint-dispatch 'ratio
+   #'(lambda (s obj)
+       (format s "#.(/ ~W ~W)" 
+                 (numerator obj) (denominator obj))))
+
+ (set-pprint-dispatch '(and ratio (satisfies minusp))
+   #'(lambda (s obj)
+       (format s "#.(- (/ ~W ~W))" 
+               (- (numerator obj)) (denominator obj)))
+   5)
+
+ (pprint '(1/3 -2/3))
+ (#.(/ 1 3) #.(- (/ 2 3)))
+
    + +

    The following two forms illustrate the definition of +pretty printing functions for types of code. The first +form illustrates how to specify the traditional method +for printing quoted objects using single-quote. Note +the care taken to ensure that data lists that happen to begin +with quote will be printed readably. The second form +specifies that lists beginning with the symbol my-let +should print the same way that lists beginning with let +print when the initial pprint dispatch table is in effect. +

    +
    +
     (set-pprint-dispatch '(cons (member quote)) () 
+   #'(lambda (s list)
+       (if (and (consp (cdr list)) (null (cddr list)))
+          (funcall (formatter "'~W") s (cadr list))
+          (pprint-fill s list))))
+
+ (set-pprint-dispatch '(cons (member my-let)) 
+                      (pprint-dispatch '(let) nil))
+
    + +

    The next example specifies a default method for printing lists that do not +correspond to function calls. Note that the functions pprint-linear, +pprint-fill, and pprint-tabular are all defined with +optional colon-p and at-sign-p arguments so that they can +be used as pprint dispatch functions as well as ~/.../ +functions. +

    +
    +
     (set-pprint-dispatch '(cons (not (and symbol (satisfies fboundp))))
+                      #'pprint-fill -5)
+
+ ;; Assume a line length of 9
+ (pprint '(0 b c d e f g h i j k))
+ (0 b c d
+  e f g h
+  i j k)
+
    + +

    This final example shows how to define a pretty printing function for a +user defined data structure. +

    +
    +
     (defstruct family mom kids)
+
+ (set-pprint-dispatch 'family
+   #'(lambda (s f)
+       (funcall (formatter "~@<#<~;~W and ~2I~_~/pprint-fill/~;>~:>")
+               s (family-mom f) (family-kids f))))
+
    + +

    The pretty printing function for the structure family specifies how to +adjust the layout of the output so that it can fit aesthetically into +a variety of line widths. In addition, it obeys +the printer control variables *print-level*, +*print-length*, *print-lines*, +*print-circle* +and *print-escape*, +and can tolerate several different kinds of malformity in the data structure. +The output below shows what is printed out with a right margin of 25, +*print-pretty* being true, *print-escape* being false, +and a malformed kids list. +

    +
    +
     (write (list 'principal-family
+              (make-family :mom "Lucy"
+                           :kids '("Mark" "Bob" . "Dan")))
+        :right-margin 25 :pretty T :escape nil :miser-width nil)
+ (PRINCIPAL-FAMILY
+  #<Lucy and
+      Mark Bob . Dan>)
+
    + +

    Note that a pretty printing function for a structure is different from +the structure’s print-object method. +While +print-object methods +are permanently associated with a structure, +pretty printing functions are stored in +pprint dispatch tables and can be rapidly changed to reflect +different printing needs. If there is no pretty printing function for +a structure in the current pprint dispatch table, +its print-object method +is used instead. +

    +
    +
    +

    +Next: , Previous: , Up: The Lisp Pretty Printer  

    +
    + + + + + diff --git a/info/gcl/Exceptional-Situations-in-the-Compiler.html b/info/gcl/Exceptional-Situations-in-the-Compiler.html new file mode 100644 index 0000000..3bf5b20 --- /dev/null +++ b/info/gcl/Exceptional-Situations-in-the-Compiler.html @@ -0,0 +1,98 @@ + + + + + +Exceptional Situations in the Compiler (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Compilation  

    +
    +
    +

    3.2.5 Exceptional Situations in the Compiler

    + +

    compile and compile-file are permitted to +signal errors and warnings, including errors due to compile-time +processing of (eval-when (:compile-toplevel) ...) forms, +macro expansion, and conditions signaled by the compiler itself. +

    +

    Conditions of type error might be signaled by the compiler +in situations where the compilation cannot proceed without intervention. +

    +

    In addition to situations for which the standard specifies that +conditions of type warning must or might be signaled, +warnings might be signaled in situations where the compiler can +determine that the consequences are undefined or that a run-time +error will be signaled. Examples of this situation are as follows: + violating type declarations, + altering or assigning the value of a constant defined with defconstant, + calling built-in Lisp functions with a wrong number of arguments or malformed keyword + argument lists, +and using unrecognized declaration specifiers. +

    +

    The compiler is permitted to issue warnings about matters of +programming style as conditions of type style-warning. +Examples of this situation are as follows: + redefining a function using a different argument list, + calling a function with a wrong number of arguments, + not declaring ignore of a local variable that is not referenced, + and referencing a variable declared ignore. +

    +

    Both compile and compile-file are permitted +(but not required) to establish a handler +for conditions of type error. For example, they +might signal a warning, and restart compilation from some +implementation-dependent point in order to let the +compilation proceed without manual intervention. +

    +

    Both compile and compile-file return three +values, the second two indicating whether the source code being compiled +contained errors and whether style warnings were issued. +

    +

    Some warnings might be deferred until the end of compilation. +See with-compilation-unit. +

    + +
    +
    +

    +Previous: , Up: Compilation  

    +
    + + + + + diff --git a/info/gcl/Expanding-Loop-Forms.html b/info/gcl/Expanding-Loop-Forms.html new file mode 100644 index 0000000..4210a46 --- /dev/null +++ b/info/gcl/Expanding-Loop-Forms.html @@ -0,0 +1,123 @@ + + + + + +Expanding Loop Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.6 Expanding Loop Forms

    + +

    A loop macro form expands into a form containing +one or more binding forms (that establish bindings of loop variables) +and a block and a tagbody (that express a looping control +structure). The variables established in loop are bound as +if by let or lambda. +

    +

    Implementations can interleave the setting of initial values with the bindings. +However, the assignment of the initial values is always calculated in the order +specified by the user. A variable is thus sometimes bound to a meaningless value +of the correct type, and then later in the prologue it is set to the true +initial value by using setq. +

    +

    One implication of this interleaving is that it is implementation-dependent +whether the lexical environment in which the initial value forms +(variously called the form1, form2, form3, step-fun, + vector, hash-table, and package) in any for-as-subclause, +except for-as-equals-then, +are evaluated includes only the loop variables preceding that form +or includes more or all of the loop variables; +the form1 and form2 in a for-as-equals-then form +includes the lexical environment of all the loop variables. +

    +

    After the form is expanded, it consists of three basic parts in the +tagbody: + the loop prologue, + the loop body, + and the loop epilogue. +

    +
    +
    Loop prologue
    +

    The loop prologue contains forms +that are executed before iteration begins, such as +any automatic variable initializations prescribed +by the variable clauses, along with any initially clauses +in the order they appear in the source. +

    +
    +
    Loop body
    +

    The loop body contains those forms that are executed during iteration, +including application-specific calculations, termination tests, +and variable stepping_1. +

    +
    +
    Loop epilogue
    +

    The loop epilogue contains forms that are executed after iteration +terminates, such as finally clauses, if any, along +with any implicit return value from an accumulation clause or +an termination-test clause. +

    +
    +
    + +

    Some clauses from the source form +contribute code only to the loop prologue; these clauses must + come before other clauses that are in the main body of the loop form. + Others contribute code only to the loop epilogue. + All other clauses contribute to the final +translated form in the same + order given in the original source form of the loop. +

    +

    Expansion of the loop macro produces an implicit block named nil +

    +

    unless named is supplied. +

    +

    Thus, return-from (and sometimes return) +can be used to return values from loop or to exit loop. +

    +
    +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    + + + + + diff --git a/info/gcl/Extended-Loop.html b/info/gcl/Extended-Loop.html new file mode 100644 index 0000000..e912f40 --- /dev/null +++ b/info/gcl/Extended-Loop.html @@ -0,0 +1,61 @@ + + + + + +Extended Loop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.3 Extended Loop

    + +

    An extended loop form is one that has a body containing +atomic expressions. When the loop macro processes such a +form, it invokes a facility that is commonly called “the Loop Facility.” +

    +

    The Loop Facility provides standardized access to mechanisms commonly used +in iterations through Loop schemas, which are introduced by loop keywords. +

    +

    The body of an extended loop form is divided into loop clauses, +each which is in turn made up of loop keywords and forms. +

    + + + + + diff --git a/info/gcl/Extensions-to-Similarity-Rules.html b/info/gcl/Extensions-to-Similarity-Rules.html new file mode 100644 index 0000000..4ebf00f --- /dev/null +++ b/info/gcl/Extensions-to-Similarity-Rules.html @@ -0,0 +1,66 @@ + + + + + +Extensions to Similarity Rules (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Literal Objects in Compiled Files  

    +
    +
    +

    3.2.4.5 Extensions to Similarity Rules

    + +

    Some objects, such as streams, readtables, and methods +are not externalizable objects under the definition of similarity given above. +That is, such objects may not portably appear as literal objects +in code to be processed by the file compiler. +

    +

    An implementation is permitted to extend the rules of similarity, +so that other kinds of objects are externalizable objects +for that implementation. +

    +

    If for some kind of object, similarity is +neither defined by this specification + nor by the implementation, +then the file compiler must signal an error upon encountering such +an object as a literal constant. +

    + + + + + diff --git a/info/gcl/Extent.html b/info/gcl/Extent.html new file mode 100644 index 0000000..80c0bff --- /dev/null +++ b/info/gcl/Extent.html @@ -0,0 +1,120 @@ + + + + + +Extent (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    +
    +

    3.1.6 Extent

    + +

    Contorted-example works only because the +function named by f is invoked during the extent of the +exit point. +Once the flow of execution has left the block, +the exit point is disestablished. For example: +

    +
    +
     (defun invalid-example ()
+   (let ((y (block here #'(lambda (z) (return-from here z)))))
+     (if (numberp y) y (funcall y 5))))
+
    + +

    One might expect the call (invalid-example) to produce 5 +by the following incorrect reasoning: +let binds y to the +value of block; this value is a function resulting +from the lambda expression. Because y is not a number, it is +invoked on the value 5. The return-from should then +return this value from the +exit point named here, thereby +exiting from the block again and giving y the value 5 +which, being a number, is then returned as the value of the call +to invalid-example. +

    +

    The argument fails only because exit points have +dynamic extent. The argument is correct up to the execution of +return-from. The execution of return-from +should signal an error of type control-error, however, not +because it cannot refer to the exit point, but because it +does correctly refer to an exit point and that +exit point has been disestablished. +

    +

    A reference by name to a dynamic exit point binding such as +a catch tag refers to the most recently +established binding of that name that has not been +disestablished. For example: +

    +
    +
     (defun fun1 (x)
+   (catch 'trap (+ 3 (fun2 x))))
+ (defun fun2 (y)
+   (catch 'trap (* 5 (fun3 y))))
+ (defun fun3 (z)
+   (throw 'trap z))
+
    + +

    Consider the call (fun1 7). The result is 10. At the time +the throw is executed, there are two outstanding catchers with the +name trap: one established within procedure fun1, and the other +within procedure fun2. The latter is the more recent, and so the +value 7 is returned from catch in fun2. +Viewed from within fun3, the catch +in fun2 shadows the one in fun1. +Had fun2 been defined as +

    +
    +
     (defun fun2 (y)
+   (catch 'snare (* 5 (fun3 y))))
+
    + +

    then the two exit points +would have different names, and therefore the one +in fun1 would not be shadowed. The result would then have been 7. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    + + + + + diff --git a/info/gcl/Externalizable-Objects.html b/info/gcl/Externalizable-Objects.html new file mode 100644 index 0000000..497011a --- /dev/null +++ b/info/gcl/Externalizable-Objects.html @@ -0,0 +1,87 @@ + + + + + +Externalizable Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Literal Objects in Compiled Files  

    +
    +
    +

    3.2.4.1 Externalizable Objects

    + +

    The fact that the file compiler represents literal objects +externally in a compiled file and must later reconstruct suitable +equivalents of those objects when that file is loaded +imposes a need for constraints on the nature of the objects that can be +used as literal objects in code to be processed +by the file compiler. +

    +

    An object that can be used as a literal object +in code to be processed by the file compiler is called an +externalizable object + +. +

    +

    We define that two objects are similar + + if they satisfy +a two-place conceptual equivalence predicate (defined below), which is +independent of the Lisp image so that the two objects in +different Lisp images can be understood to be equivalent under +this predicate. Further, by inspecting the definition of this conceptual +predicate, the programmer can anticipate what aspects of an object +are reliably preserved by file compilation. +

    +

    The file compiler must cooperate with the loader in order to +assure that in each case where an externalizable object is processed +as a literal object, the loader will construct a similar +object. +

    +

    The set of objects that are externalizable objects + + are those +for which the new conceptual term “similar” is defined, such that +when a compiled file is loaded, an object can be constructed +which can be shown to be similar to the original object which +existed at the time the file compiler was operating. +

    + + + + + diff --git a/info/gcl/FORMAT-Basic-Output.html b/info/gcl/FORMAT-Basic-Output.html new file mode 100644 index 0000000..2c1502f --- /dev/null +++ b/info/gcl/FORMAT-Basic-Output.html @@ -0,0 +1,64 @@ + + + + + +FORMAT Basic Output (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.1 FORMAT Basic Output

    + + + + + + + +
    • Tilde C-> Character   +
    • Tilde Percent-> Newline   +
    • Tilde Ampersand-> Fresh-Line   +
    • Tilde Vertical-Bar-> Page   +
    • Tilde Tilde-> Tilde   +
    + + + + + + diff --git a/info/gcl/FORMAT-Control_002dFlow-Operations.html b/info/gcl/FORMAT-Control_002dFlow-Operations.html new file mode 100644 index 0000000..7c2e020 --- /dev/null +++ b/info/gcl/FORMAT-Control_002dFlow-Operations.html @@ -0,0 +1,66 @@ + + + + + +FORMAT Control-Flow Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.7 FORMAT Control-Flow Operations

    + + + + + + + + +
    • Tilde Asterisk-> Go-To   +
    • Tilde Left-Bracket-> Conditional Expression   +
    • Tilde Right-Bracket-> End of Conditional Expression   +
    • Tilde Left-Brace-> Iteration   +
    • Tilde Right-Brace-> End of Iteration   +
    • Tilde Question-Mark-> Recursive Processing   +
    + + + + + + diff --git a/info/gcl/FORMAT-Floating_002dPoint-Printers.html b/info/gcl/FORMAT-Floating_002dPoint-Printers.html new file mode 100644 index 0000000..cb1a8d0 --- /dev/null +++ b/info/gcl/FORMAT-Floating_002dPoint-Printers.html @@ -0,0 +1,62 @@ + + + + + +FORMAT Floating-Point Printers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.3 FORMAT Floating-Point Printers

    + + + + + + +
    • Tilde F-> Fixed-Format Floating-Point   +
    • Tilde E-> Exponential Floating-Point   +
    • Tilde G-> General Floating-Point   +
    • Tilde Dollarsign-> Monetary Floating-Point   +
    + + + + + + diff --git a/info/gcl/FORMAT-Layout-Control.html b/info/gcl/FORMAT-Layout-Control.html new file mode 100644 index 0000000..ff27f0d --- /dev/null +++ b/info/gcl/FORMAT-Layout-Control.html @@ -0,0 +1,60 @@ + + + + + +FORMAT Layout Control (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.6 FORMAT Layout Control

    + + + + + +
    • Tilde T-> Tabulate   +
    • Tilde Less-Than-Sign-> Justification   +
    • Tilde Greater-Than-Sign-> End of Justification   +
    + + + + + + diff --git a/info/gcl/FORMAT-Miscellaneous-Operations.html b/info/gcl/FORMAT-Miscellaneous-Operations.html new file mode 100644 index 0000000..671dc8c --- /dev/null +++ b/info/gcl/FORMAT-Miscellaneous-Operations.html @@ -0,0 +1,60 @@ + + + + + +FORMAT Miscellaneous Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.8 FORMAT Miscellaneous Operations

    + + + + + +
    • Tilde Left-Paren-> Case Conversion   +
    • Tilde Right-Paren-> End of Case Conversion   +
    • Tilde P-> Plural   +
    + + + + + + diff --git a/info/gcl/FORMAT-Miscellaneous-Pseudo_002dOperations.html b/info/gcl/FORMAT-Miscellaneous-Pseudo_002dOperations.html new file mode 100644 index 0000000..37d86c0 --- /dev/null +++ b/info/gcl/FORMAT-Miscellaneous-Pseudo_002dOperations.html @@ -0,0 +1,60 @@ + + + + + +FORMAT Miscellaneous Pseudo-Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.9 FORMAT Miscellaneous Pseudo-Operations

    + + + + + +
    • Tilde Semicolon-> Clause Separator   +
    • Tilde Circumflex-> Escape Upward   +
    • Tilde Newline-> Ignored Newline   +
    + + + + + + diff --git a/info/gcl/FORMAT-Pretty-Printer-Operations.html b/info/gcl/FORMAT-Pretty-Printer-Operations.html new file mode 100644 index 0000000..185f560 --- /dev/null +++ b/info/gcl/FORMAT-Pretty-Printer-Operations.html @@ -0,0 +1,64 @@ + + + + + +FORMAT Pretty Printer Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.5 FORMAT Pretty Printer Operations

    + +

    The following constructs provide access to the pretty printer: +

    + + + + + +
    • Tilde Underscore-> Conditional Newline   +
    • Tilde Less-Than-Sign-> Logical Block   +
    • Tilde I-> Indent   +
    • Tilde Slash-> Call Function   +
    + + + + + + diff --git a/info/gcl/FORMAT-Printer-Operations.html b/info/gcl/FORMAT-Printer-Operations.html new file mode 100644 index 0000000..2750f2a --- /dev/null +++ b/info/gcl/FORMAT-Printer-Operations.html @@ -0,0 +1,60 @@ + + + + + +FORMAT Printer Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.4 FORMAT Printer Operations

    + + + + + +
    • Tilde A-> Aesthetic   +
    • Tilde S-> Standard   +
    • Tilde W-> Write   +
    + + + + + + diff --git a/info/gcl/FORMAT-Radix-Control.html b/info/gcl/FORMAT-Radix-Control.html new file mode 100644 index 0000000..b622441 --- /dev/null +++ b/info/gcl/FORMAT-Radix-Control.html @@ -0,0 +1,64 @@ + + + + + +FORMAT Radix Control (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.2 FORMAT Radix Control

    + + + + + + + +
    • Tilde R-> Radix   +
    • Tilde D-> Decimal   +
    • Tilde B-> Binary   +
    • Tilde O-> Octal   +
    • Tilde X-> Hexadecimal   +
    + + + + + + diff --git a/info/gcl/Feature-Expressions.html b/info/gcl/Feature-Expressions.html new file mode 100644 index 0000000..ef3adea --- /dev/null +++ b/info/gcl/Feature-Expressions.html @@ -0,0 +1,86 @@ + + + + + +Feature Expressions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Features  

    +
    +
    +

    24.1.2.1 Feature Expressions

    + +

    Boolean combinations of features, called feature expressions + +, +are used by the #+ and #- reader macros in order to +direct conditional reading of expressions by the Lisp reader. +

    +

    The rules for interpreting a feature expression are as follows: +

    +
    +
    feature
    +

    If a symbol naming a feature is used as a feature expression, +the feature expression succeeds if that feature is present; +otherwise it fails. +

    +
    +
    (not feature-conditional)
    +

    A not feature expression succeeds +if its argument feature-conditional fails; +otherwise, it succeeds. +

    +
    +
    (and {feature-conditional}*)
    +

    An and feature expression succeeds +if all of its argument feature-conditionals succeed; +otherwise, it fails. +

    +
    +
    (or {feature-conditional}*)
    +

    An or feature expression succeeds +if any of its argument feature-conditionals succeed; +otherwise, it fails. +

    +
    +
    + + + + + + diff --git a/info/gcl/Features.html b/info/gcl/Features.html new file mode 100644 index 0000000..fd02edf --- /dev/null +++ b/info/gcl/Features.html @@ -0,0 +1,75 @@ + + + + + +Features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: System Construction Concepts  

    +
    +
    +

    24.1.2 Features

    + +

    A feature + + is an aspect or attribute + of Common Lisp, + of the implementation, + or of the environment. +A feature is identified by a symbol. +

    +

    A feature is said to be present + + in a Lisp image +if and only if the symbol naming it is an element of the +list held by the variable *features*, +which is called the features list + +. +

    + + + +
    • Feature Expressions   +
    • Examples of Feature Expressions   +
    + + + + + + diff --git a/info/gcl/File-Compilation.html b/info/gcl/File-Compilation.html new file mode 100644 index 0000000..8e54f6a --- /dev/null +++ b/info/gcl/File-Compilation.html @@ -0,0 +1,99 @@ + + + + + +File Compilation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation  

    +
    +
    +

    3.2.3 File Compilation

    + +

    The function compile-file performs compilation of +forms in a file following the rules specified in Compilation Semantics, +and produces an output file that can be loaded by using load. +

    +

    Normally, the top level forms appearing in a file compiled with +compile-file are evaluated only when the resulting +compiled file is loaded, and not when the file is compiled. However, +it is typically the case that some forms in the file need to be evaluated +at compile time so the +remainder of the file can be read and compiled correctly. +

    +

    The eval-when special form can be used to control +whether a top level form is evaluated at compile time, load +time, or both. It is possible to specify any of three situations with +eval-when, denoted by the symbols :compile-toplevel, +:load-toplevel, and :execute. For top level +eval-when forms, :compile-toplevel specifies that the +compiler must evaluate the body at compile time, and :load-toplevel specifies that the compiler must arrange to evaluate +the body at load time. For non-top level eval-when forms, +:execute specifies that the body must be executed in the run-time +environment. +

    +

    The behavior of this form can be more precisely understood in +terms of a model of how compile-file processes forms in +a file to be compiled. There are two processing modes, called +“not-compile-time” and “compile-time-too”. +

    +

    Successive forms are read from the file by compile-file +and processed in not-compile-time mode; in this mode, +compile-file arranges for forms to be evaluated only at load time +and not at compile time. When compile-file is in +compile-time-too mode, forms are evaluated both at compile time and +load time. +

    + + + + +
    • Processing of Top Level Forms   +
    • Processing of Defining Macros   +
    • Constraints on Macros and Compiler Macros   +
    + +
    +
    +

    +Next: , Previous: , Up: Compilation  

    +
    + + + + + diff --git a/info/gcl/File-Operations-on-Open-and-Closed-Streams.html b/info/gcl/File-Operations-on-Open-and-Closed-Streams.html new file mode 100644 index 0000000..d4271ba --- /dev/null +++ b/info/gcl/File-Operations-on-Open-and-Closed-Streams.html @@ -0,0 +1,84 @@ + + + + + +File Operations on Open and Closed Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: File System Concepts  

    +
    +
    +

    20.1.2 File Operations on Open and Closed Streams

    + +

    Many functions that perform file operations accept either +open or closed streams as arguments; +see Stream Arguments to Standardized Functions. +

    +

    Of these, the functions in Figure 20–2 treat open and +closed streams differently. +

    +
    +
      delete-file  file-author      probe-file  
+  directory    file-write-date  truename    
+
+  Figure 20–2: File Functions that Treat Open and Closed Streams Differently
+
+
    + +

    Since treatment of open streams by the file system +may vary considerably between implementations, however, +a closed stream might be the most reliable kind of +argument for some of these functions—in particular, those in +Figure 20–3. For example, in some file systems, +open files are written under temporary names +and not renamed until closed +and/or are held invisible until closed. +In general, any code that is intended to be portable should +use such functions carefully. +

    +
    +
      directory  probe-file  truename  
+
+  Figure 20–3: File Functions where Closed Streams Might Work Best
+
+
    + + + + + + diff --git a/info/gcl/File-Streams.html b/info/gcl/File-Streams.html new file mode 100644 index 0000000..84a716a --- /dev/null +++ b/info/gcl/File-Streams.html @@ -0,0 +1,65 @@ + + + + + +File Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Streams  

    +
    +
    +

    21.1.1.6 File Streams

    + +

    Some streams, called file streams + +, provide access to files. +An object of class file-stream is used to represent a file stream. +

    +

    The basic operation for opening a file is open, +which typically returns a file stream +(see its dictionary entry for details). +The basic operation for closing a stream is close. +The macro with-open-file is useful +to express the common idiom of opening a file +for the duration of a given body of code, +and assuring that the resulting stream is closed upon exit from that body. +

    + + + + + diff --git a/info/gcl/File-System-Concepts.html b/info/gcl/File-System-Concepts.html new file mode 100644 index 0000000..05a0930 --- /dev/null +++ b/info/gcl/File-System-Concepts.html @@ -0,0 +1,90 @@ + + + + + +File System Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files  

    +
    +
    +

    20.1 File System Concepts

    + + +

    This section describes the Common Lisp interface to file systems. +The model used by this interface assumes + that files + + are named by filenames + +, + that a filename can be represented by a pathname object, + and that given a pathname a stream + + can be constructed + that connects to a file whose filename it represents. +

    +

    For information about opening and closing files, +and manipulating their contents, see Streams. +

    +

    Figure 20–1 lists some operators +that are applicable to files and directories. +

    +
    +
      compile-file  file-length      open            
+  delete-file   file-position    probe-file      
+  directory     file-write-date  rename-file     
+  file-author   load             with-open-file  
+
+    Figure 20–1: File and Directory Operations  
+
+
    + + + + + +
    • Coercion of Streams to Pathnames   +
    • File Operations on Open and Closed Streams   +
    • Truenames   +
    + + + + + + diff --git a/info/gcl/Filenames-Dictionary.html b/info/gcl/Filenames-Dictionary.html new file mode 100644 index 0000000..307d4f3 --- /dev/null +++ b/info/gcl/Filenames-Dictionary.html @@ -0,0 +1,89 @@ + + + + + +Filenames Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Filenames  

    +
    +
    +

    19.4 Filenames Dictionary

    + + + + + + + + + + + + + + + + + + + + +
    • pathname (System Class)   +
    • logical-pathname (System Class)   +
    • pathname   +
    • make-pathname   +
    • pathnamep   +
    • pathname-host   +
    • load-logical-pathname-translations   +
    • logical-pathname-translations   +
    • logical-pathname   +
    • *default-pathname-defaults*   +
    • namestring   +
    • parse-namestring   +
    • wild-pathname-p   +
    • pathname-match-p   +
    • translate-logical-pathname   +
    • translate-pathname   +
    • merge-pathnames   +
    + + + + + + diff --git a/info/gcl/Filenames.html b/info/gcl/Filenames.html new file mode 100644 index 0000000..b7fff36 --- /dev/null +++ b/info/gcl/Filenames.html @@ -0,0 +1,62 @@ + + + + + +Filenames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    19 Filenames

    + + + + + + +
    • Overview of Filenames   +
    • Pathnames   +
    • Logical Pathnames   +
    • Filenames Dictionary   +
    + + + + + + diff --git a/info/gcl/Files-Dictionary.html b/info/gcl/Files-Dictionary.html new file mode 100644 index 0000000..2d24c1c --- /dev/null +++ b/info/gcl/Files-Dictionary.html @@ -0,0 +1,75 @@ + + + + + +Files Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Files  

    +
    +
    +

    20.2 Files Dictionary

    + + + + + + + + + + + + + +
    • directory   +
    • probe-file   +
    • ensure-directories-exist   +
    • truename   +
    • file-author   +
    • file-write-date   +
    • rename-file   +
    • delete-file   +
    • file-error   +
    • file-error-pathname   +
    + + + + + + diff --git a/info/gcl/Files.html b/info/gcl/Files.html new file mode 100644 index 0000000..18e2168 --- /dev/null +++ b/info/gcl/Files.html @@ -0,0 +1,58 @@ + + + + + +Files (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    20 Files

    + + + + +
    • File System Concepts   +
    • Files Dictionary   +
    + + + + + + diff --git a/info/gcl/Fill-Pointers.html b/info/gcl/Fill-Pointers.html new file mode 100644 index 0000000..ba86dda --- /dev/null +++ b/info/gcl/Fill-Pointers.html @@ -0,0 +1,71 @@ + + + + + +Fill Pointers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.6 Fill Pointers

    + +

    A fill pointer + + is a non-negative integer no +larger than the total number of elements in a vector. +Not all vectors have fill pointers. +See the functions make-array and adjust-array. +

    +

    An element of a vector is said to be active + + if it has +an index that is greater than or equal to zero, +but less than the fill pointer (if any). +For an array that has no fill pointer, +all elements are considered active. +

    +

    Only vectors may have fill pointers; +multidimensional arrays may not. +A multidimensional array that is displaced to a vector +that has a fill pointer can be created. +

    + + + + + diff --git a/info/gcl/Floating_002dpoint-Computations.html b/info/gcl/Floating_002dpoint-Computations.html new file mode 100644 index 0000000..120cafb --- /dev/null +++ b/info/gcl/Floating_002dpoint-Computations.html @@ -0,0 +1,66 @@ + + + + + +Floating-point Computations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    +
    +

    12.1.4 Floating-point Computations

    + +

    The following rules apply to floating point computations. +

    + + + + + + +
    • Rule of Float and Rational Contagion   +
    • Examples of Rule of Float and Rational Contagion   +
    • Rule of Float Approximation   +
    • Rule of Float Underflow and Overflow   +
    • Rule of Float Precision Contagion   +
    + + + + + + diff --git a/info/gcl/Font-Key.html b/info/gcl/Font-Key.html new file mode 100644 index 0000000..3e08b35 --- /dev/null +++ b/info/gcl/Font-Key.html @@ -0,0 +1,107 @@ + + + + + +Font Key (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.1 Font Key

    + + + +

    Fonts are used in this document to convey information. +

    +
    +
    name
    +

    Denotes a formal term whose meaning is defined in the Glossary. +When this font is used, the Glossary definition takes precedence +over normal English usage. +

    +

    Sometimes a glossary term appears subscripted, +as in “whitespace_2.” +Such a notation selects one particular Glossary definition out of several, +in this case the second. +The subscript notation for Glossary terms is generally used where the +context might be insufficient to disambiguate among the available definitions. +

    +
    +
    name
    +
    + +

    Denotes the introduction of a formal term locally to the current text. +There is still a corresponding glossary entry, and is formally equivalent +to a use of “name,” but the hope is that making such uses +conspicuous will save the reader a trip to the glossary in some cases. +

    +
    +
    name
    +

    Denotes a symbol in the COMMON-LISP package. +For information about case conventions, +see Case in Symbols. +

    +
    +
    name
    +

    Denotes a sample name or piece of code that a programmer +might write in Common Lisp. +

    +

    This font is also used for certain standardized names that are not +names of external symbols of the COMMON-LISP package, +such as keywords_1, + package names, + and loop keywords. +

    +
    +
    name
    +

    Denotes the name of a parameter or value. +

    +

    In some situations the notation “<<name>>” (i.e., the same font, +but with surrounding “angle brackets”) is used instead in order to +provide better visual separation from surrounding characters. These +“angle brackets” are metasyntactic, and never actually appear in program +input or output. +

    +
    +
    + + + + + + diff --git a/info/gcl/Form-Evaluation.html b/info/gcl/Form-Evaluation.html new file mode 100644 index 0000000..7215c19 --- /dev/null +++ b/info/gcl/Form-Evaluation.html @@ -0,0 +1,55 @@ + + + + + +Form Evaluation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.1 Form Evaluation

    + +

    Forms fall into three categories: +symbols, conses, and self-evaluating objects. +The following sections explain these categories. +

    + + + + + diff --git a/info/gcl/Format-Directive-Interface.html b/info/gcl/Format-Directive-Interface.html new file mode 100644 index 0000000..ea09a3a --- /dev/null +++ b/info/gcl/Format-Directive-Interface.html @@ -0,0 +1,80 @@ + + + + + +Format Directive Interface (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pretty Printer Concepts  

    +
    +
    +

    22.2.1.2 Format Directive Interface

    + +

    The primary interface to operations for dynamically determining the +arrangement of output is provided through the functions and macros of the +pretty printer. Figure 22–3 shows the defined names related to pretty printing. +

    +
    +
      *print-lines*            pprint-dispatch                pprint-pop           
+  *print-miser-width*      pprint-exit-if-list-exhausted  pprint-tab           
+  *print-pprint-dispatch*  pprint-fill                    pprint-tabular       
+  *print-right-margin*     pprint-indent                  set-pprint-dispatch  
+  copy-pprint-dispatch     pprint-linear                  write                
+  format                   pprint-logical-block                                
+  formatter                pprint-newline                                      
+
+             Figure 22–3: Defined names related to pretty printing.           
+
+
    + +

    Figure 22–4 identifies a set of format directives which serve +as an alternate interface to the same pretty printing operations in a +more textually compact form. +

    +
    +
      ~I   ~W      ~<...~:>  
+  ~:T  ~/.../  ~_        
+
+  Figure 22–4: Format directives related to Pretty Printing
+
+
    + + + + + + diff --git a/info/gcl/Formatted-Output.html b/info/gcl/Formatted-Output.html new file mode 100644 index 0000000..3731993 --- /dev/null +++ b/info/gcl/Formatted-Output.html @@ -0,0 +1,187 @@ + + + + + +Formatted Output (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer  

    +
    +
    +

    22.3 Formatted Output

    + + +

    [Editorial Note by KMP: This is transplanted from FORMAT and will need a bit of work before + it looks good standing alone. Bear with me.] +

    +

    format is useful for producing nicely formatted text, producing +good-looking messages, and so on. format can generate and return +a string or output to destination. +

    +

    The control-string argument to format is actually a format control. +That is, it can be either a format string or a function, +for example a function returned +by the formatter macro. +

    +

    If it is a function, the function is called with the appropriate +output stream as its first argument and the data arguments to format +as its remaining arguments. The function should perform whatever output is +necessary and return the unused tail of the arguments (if any). +

    +

    The compilation process performed by formatter produces a function +that would do with its arguments as the format interpreter +would do with those arguments. +

    +

    The remainder of this section describes what happens if the control-string +is a format string. +

    +

    Control-string is composed of simple text (characters) +and embedded directives. +

    +

    format writes the simple text as is; +each embedded directive specifies further text output +that is to appear at the corresponding point within the simple text. +Most directives use one or more elements of args to +create their output. +

    +

    A directive consists of a tilde, +optional prefix parameters +separated by commas, optional colon and at-sign modifiers, +and a single character indicating what kind of directive this is. +

    +

    There is no required ordering between the at-sign and colon modifier. +

    +

    The case of the directive character is ignored. +Prefix parameters are notated as signed (sign is optional) decimal numbers, +or as a single-quote followed by a character. +For example, ~5,'0d can be used +to print an integer +in decimal radix in five columns with leading zeros, +or ~5,'*d to get leading asterisks. +

    +

    In place of a prefix parameter to a directive, V (or v) can be used. +In this case, format takes an argument from args as a parameter to +the directive. The argument should be an integer or character. +If the arg used by a V parameter is nil, +the effect is as if the parameter had been omitted. +# can be used in place of a prefix parameter; it +represents the number of args remaining to be processed. +When used within a recursive format, in the context of ~? or ~{, +the # prefix parameter represents the number of format arguments +remaining within the recursive call. +

    +

    Examples of format strings: +

    +
    +
      "~S"        ;This is an S directive with no parameters or modifiers.  
+  "~3,-4:@s"  ;This is an S directive with two parameters, 3 and -4,    
+              ; and both the colon and at-sign flags.                   
+  "~,+4S"     ;Here the first prefix parameter is omitted and takes     
+              ; on its default value, while the second parameter is 4.  
+
+             Figure 22–5: Examples of format control strings           
+
+
    + +

    format sends the output to destination. +If destination is nil, +format creates and returns a string +containing the output from control-string. +If destination is non-nil, +it must be a string with a fill pointer, +a stream, or the symbol t. +If destination is a string with a fill pointer, +the output is added to the end of the string. +If destination is a stream, +the output is sent to that stream. +If destination is t, +the output is sent to standard output. +

    +

    In the description of the directives that follows, +the term arg in general +refers to the next item of the set of args to be processed. +The word or phrase at the beginning of each description is a mnemonic +for the directive. +

    +

    format directives do not bind any of the printer control +variables (*print-...*) except as specified in the following +descriptions. + Implementations may specify the binding of new, implementation-specific +printer control variables for each format directive, but they + may neither bind any standard printer control variables not + specified in description of a format +directive nor fail to bind + any standard printer control variables as specified in the + description. +

    + + + + + + + + + + + + + +
    • FORMAT Basic Output   +
    • FORMAT Radix Control   +
    • FORMAT Floating-Point Printers   +
    • FORMAT Printer Operations   +
    • FORMAT Pretty Printer Operations   +
    • FORMAT Layout Control   +
    • FORMAT Control-Flow Operations   +
    • FORMAT Miscellaneous Operations   +
    • FORMAT Miscellaneous Pseudo-Operations   +
    • Additional Information about FORMAT Operations   +
    • Examples of FORMAT   +
    • Notes about FORMAT   +
    + +
    +
    +

    +Next: , Previous: , Up: Printer  

    +
    + + + + + diff --git a/info/gcl/Function-Call-Forms-as-Places.html b/info/gcl/Function-Call-Forms-as-Places.html new file mode 100644 index 0000000..cf10a8f --- /dev/null +++ b/info/gcl/Function-Call-Forms-as-Places.html @@ -0,0 +1,282 @@ + + + + + +Function Call Forms as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.2 Function Call Forms as Places

    + +

    A function form can be used as a place if it falls +into one of the following categories: +

    +
    +
    *
    +

    A function call form whose first element is the name of +any one of the functions in Figure 5–7. +

    +

    [Editorial Note by KMP: Note that what are in some places still called ‘condition accessors’ + are deliberately omitted from this table, and are not labeled as + accessors in their entries. I have not yet had time to do a full + search for these items and eliminate stray references to them as ‘accessors’, + which they are not, but I will do that at some point.] +

    +
    +
      aref    cdadr                    get                            
+  bit     cdar                     gethash                        
+  caaaar  cddaar                   logical-pathname-translations  
+  caaadr  cddadr                   macro-function                 
+  caaar   cddar                    ninth                          
+  caadar  cdddar                   nth                            
+  caaddr  cddddr                   readtable-case                 
+  caadr   cdddr                    rest                           
+  caar    cddr                     row-major-aref                 
+  cadaar  cdr                      sbit                           
+  cadadr  char                     schar                          
+  cadar   class-name               second                         
+  caddar  compiler-macro-function  seventh                        
+  cadddr  documentation            sixth                          
+  caddr   eighth                   slot-value                     
+  cadr    elt                      subseq                         
+  car     fdefinition              svref                          
+  cdaaar  fifth                    symbol-function                
+  cdaadr  fill-pointer             symbol-plist                   
+  cdaar   find-class               symbol-value                   
+  cdadar  first                    tenth                          
+  cdaddr  fourth                   third                          
+
+       Figure 5–7: Functions that setf can be used with—1      
+
+
    + +

    In the case of subseq, the replacement value must be a sequence +whose elements might be contained by the sequence argument to subseq, +but does not have to be a sequence of the same type +as the sequence of which the subsequence is specified. +If the length of the replacement value does not equal the length of +the subsequence to be replaced, then the shorter length determines +the number of elements to be stored, as for replace. +

    +
    +
    *
    +

    A function call form whose first element is the name of +a selector function constructed by defstruct. +

    +

    The function name must refer to the global function definition, +rather than a locally defined function. +

    +
    +
    *
    +

    A function call form whose first element is the name of +any one of the functions in Figure 5–8, +provided that the supplied argument +to that function is in turn a place form; +in this case the new place has stored back into it the +result of applying the supplied “update” function. +

    +
    +
      Function name  Argument that is a place  Update function used      
+  ldb            second                    dpb                       
+  mask-field     second                    deposit-field             
+  getf           first                     implementation-dependent  
+
+         Figure 5–8: Functions that setf can be used with—2       
+
+
    + +

    During the setf expansion of these forms, it is necessary to call +

    +

    get-setf-expansion +

    +

    in order to figure out how the inner, nested generalized variable must be treated. +

    +

    The information from +

    +

    get-setf-expansion +

    +

    is used as follows. +

    +
    ldb
    +

    In a form such as: +

    +

    (setf (ldb byte-spec place-form) value-form) +

    +

    the place referred to by the place-form must always be both read +and written; note that the update is to the generalized variable +specified by place-form, not to any object of type integer. +

    +

    Thus this setf should generate code to do the following: +

    +
    +
    1.
    +

    Evaluate byte-spec (and bind it into a temporary variable). +

    +
    2.
    +

    Bind the temporary variables for place-form. +

    +
    3.
    +

    Evaluate value-form (and bind +

    +

    its value or values into the store variable). +

    +
    +
    4.
    +

    Do the read from place-form. +

    +
    5.
    +

    Do the write into place-form with +the given bits of the integer + fetched in step 4 replaced with the value from step 3. +

    +
    + +

    If the evaluation of value-form +in step 3 alters what is found in place-form, +such as setting different bits of integer, + then the change of the bits denoted by +byte-spec is to that + altered integer, +because step 4 is done after the value-form + evaluation. Nevertheless, the + evaluations required for binding +the temporary variables are done in steps 1 and + 2, and thus the expected left-to-right evaluation order is seen. +For example: +

    +
    +
     (setq integer #x69) ⇒  #x69
+ (rotatef (ldb (byte 4 4) integer) 
+          (ldb (byte 4 0) integer))
+ integer ⇒  #x96
+;;; This example is trying to swap two independent bit fields 
+;;; in an integer.  Note that the generalized variable of 
+;;; interest here is just the (possibly local) program variable
+;;; integer.
+
    + +
    +
    mask-field
    +

    This case is the same as ldb in all essential aspects. +

    +
    +
    getf
    +

    In a form such as: +

    +

    (setf (getf place-form ind-form) value-form) +

    +

    the place referred to by place-form must always be both read + and written; note that the update is to the generalized variable + specified by place-form, not necessarily to the particular +list +that is the property list in question. +

    +

    Thus this setf should generate code to do the following: +

    +
    1.
    +

    Bind the temporary variables for place-form. +

    +
    2.
    +

    Evaluate ind-form (and bind it into a temporary variable). +

    +
    3.
    +

    Evaluate value-form (and bind +

    +

    its value or values into the store variable). +

    +
    +
    4.
    +

    Do the read from place-form. +

    +
    5.
    +

    Do the write into place-form with a possibly-new property list + obtained by combining the values from steps 2, 3, and 4. +(Note that the phrase “possibly-new property list” can mean that + the former property list is somehow destructively re-used, or it can + mean partial or full copying of it. +Since either copying or destructive re-use can occur, +the treatment of the resultant value for the + possibly-new property list must proceed as if it were a different copy + needing to be stored back into the generalized variable.) +

    +
    + +

    If the evaluation of value-form +in step 3 alters what is found in +place-form, such as setting a different named property in the list, + then the change of the property denoted by ind-form +is to that + altered list, because step 4 is done after the +value-form + evaluation. Nevertheless, the + evaluations required for binding +the temporary variables are done in steps 1 and + 2, and thus the expected left-to-right evaluation order is seen. +

    +

    For example: +

    +
    +
     (setq s (setq r (list (list 'a 1 'b 2 'c 3)))) ⇒  ((a 1 b 2 c 3))
+ (setf (getf (car r) 'b) 
+       (progn (setq r nil) 6)) ⇒  6
+ r ⇒  NIL
+ s ⇒  ((A 1 B 6 C 3))
+;;; Note that the (setq r nil) does not affect the actions of 
+;;; the SETF because the value of R had already been saved in 
+;;; a temporary variable as part of the step 1. Only the CAR
+;;; of this value will be retrieved, and subsequently modified 
+;;; after the value computation.
+
    + +
    +
    + +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    + + + + + diff --git a/info/gcl/Function-Forms.html b/info/gcl/Function-Forms.html new file mode 100644 index 0000000..11e2454 --- /dev/null +++ b/info/gcl/Function-Forms.html @@ -0,0 +1,124 @@ + + + + + +Function Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.10 Function Forms

    + +

    If the operator is a symbol naming a function, +the form represents a function form, +and the cdr of the list contains the forms +which when evaluated will supply the arguments passed to the function. +

    +

    When a function name is not defined, +an error of type undefined-function should be signaled at run time; +see Semantic Constraints. +

    +

    A function form is evaluated as follows: +

    +

    The subforms in the cdr of the original form +are evaluated in left-to-right order in the current lexical and +dynamic environments. The primary value of each +such evaluation becomes an argument to the named function; +any additional values returned by the subforms are discarded. +

    +

    The functional value of the operator +is retrieved from the lexical environment, +and that function is invoked with the indicated arguments. +

    +

    Although the order of evaluation of +the argument subforms themselves is +strictly left-to-right, it is not specified whether +the definition of the operator in a function form is looked up +before the evaluation of the argument subforms, +after the evaluation of the argument subforms, +or between the evaluation of any two argument subforms +if there is more than one such argument subform. +For example, the following might return 23 or~24. +

    +
    +
     (defun foo (x) (+ x 3))
+ (defun bar () (setf (symbol-function 'foo) #'(lambda (x) (+ x 4))))
+ (foo (progn (bar) 20))
+
    + +

    A binding for a function name can be established in +one of several ways. A binding for a function name in +the global environment can be established by + defun, + setf of fdefinition, + setf of symbol-function, + ensure-generic-function, + defmethod (implicitly, due to ensure-generic-function), +or + defgeneric. +A binding for a function name in the lexical environment +can be established by + flet +or labels. +

    +

    Figure 3–4 lists some defined names that are applicable to functions. +

    +
    +
      apply                 fdefinition  mapcan               
+  call-arguments-limit  flet         mapcar               
+  complement            fmakunbound  mapcon               
+  constantly            funcall      mapl                 
+  defgeneric            function     maplist              
+  defmethod             functionp    multiple-value-call  
+  defun                 labels       reduce               
+  fboundp               map          symbol-function      
+
+      Figure 3–4: Some function-related defined names    
+
+
    + +
    +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    + + + + + diff --git a/info/gcl/General-Restrictions-on-Parameters-that-must-be-Lists.html b/info/gcl/General-Restrictions-on-Parameters-that-must-be-Lists.html new file mode 100644 index 0000000..009e74a --- /dev/null +++ b/info/gcl/General-Restrictions-on-Parameters-that-must-be-Lists.html @@ -0,0 +1,63 @@ + + + + + +General Restrictions on Parameters that must be Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conses as Lists  

    +
    +
    +

    14.1.2.3 General Restrictions on Parameters that must be Lists

    + +

    Except as explicitly specified otherwise, +any standardized function that takes a parameter +that is required to be a list should be prepared to signal +an error of type type-error if the value received is a dotted list. +

    +

    Except as explicitly specified otherwise, +for any standardized function that takes a parameter +that is required to be a list, +the consequences are undefined +if that list is circular. +

    + + + + + + diff --git a/info/gcl/General-Restrictions-on-Parameters-that-must-be-Sequences.html b/info/gcl/General-Restrictions-on-Parameters-that-must-be-Sequences.html new file mode 100644 index 0000000..4c084c4 --- /dev/null +++ b/info/gcl/General-Restrictions-on-Parameters-that-must-be-Sequences.html @@ -0,0 +1,55 @@ + + + + + +General Restrictions on Parameters that must be Sequences (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Sequence Concepts  

    +
    +
    +

    17.1.1 General Restrictions on Parameters that must be Sequences

    + +

    In general, lists (including association lists and property lists) +that are treated as sequences must be proper lists. +

    + + + + + + diff --git a/info/gcl/General-Restrictions-on-Parameters-that-must-be-Trees.html b/info/gcl/General-Restrictions-on-Parameters-that-must-be-Trees.html new file mode 100644 index 0000000..c2db64f --- /dev/null +++ b/info/gcl/General-Restrictions-on-Parameters-that-must-be-Trees.html @@ -0,0 +1,57 @@ + + + + + +General Restrictions on Parameters that must be Trees (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conses as Trees  

    +
    +
    +

    14.1.1.1 General Restrictions on Parameters that must be Trees

    + +

    Except as explicitly stated otherwise, +for any standardized function that takes a parameter +that is required to be a tree, +the consequences are undefined +if that tree is circular. +

    + + + + + diff --git a/info/gcl/Generalized-Reference.html b/info/gcl/Generalized-Reference.html new file mode 100644 index 0000000..f670414 --- /dev/null +++ b/info/gcl/Generalized-Reference.html @@ -0,0 +1,61 @@ + + + + + +Generalized Reference (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow  

    +
    +
    +

    5.1 Generalized Reference

    + + + + + + +
    • Overview of Places and Generalized Reference   +
    • Kinds of Places   +
    • Treatment of Other Macros Based on SETF   +
    + + + + + + diff --git a/info/gcl/Generic-Function-Lambda-Lists.html b/info/gcl/Generic-Function-Lambda-Lists.html new file mode 100644 index 0000000..c8c3085 --- /dev/null +++ b/info/gcl/Generic-Function-Lambda-Lists.html @@ -0,0 +1,97 @@ + + + + + +Generic Function Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.2 Generic Function Lambda Lists

    + +

    A generic function lambda list + + is used to describe the overall shape of +the argument list to be accepted by a generic function. +Individual method signatures might contribute additional +keyword parameters to the lambda list of the effective method. +

    +

    A generic function lambda list is used by defgeneric. +

    +

    A generic function lambda list has the following syntax: +

    +

    lambda-list ::=({var}* +                 [&optional {var | (var)}*] +                 [&rest var] +                 [&key {var | ({var |          (keyword-name var)})}* pt [&allow-other-keys]]) +                +

    +

    A generic function lambda list can contain the lambda list keywords shown +in Figure 3–14. +

    +
    +
      &allow-other-keys  &optional    
+  &key               &rest        
+
+  Figure 3–14: Lambda List Keywords used by Generic Function Lambda Lists
+
+
    + +

    A generic function lambda list differs from an ordinary lambda list +in the following ways: +

    +
    +
    Required arguments
    +

    Zero or more required parameters must be specified. +

    +
    +
    Optional and keyword arguments
    +

    Optional parameters and keyword parameters may not have +default initial value forms nor use supplied-p parameters. +

    +
    +
    Use of &aux
    +

    The use of &aux is not allowed. +

    +
    + + + + + + diff --git a/info/gcl/Generic-Functions-and-Methods.html b/info/gcl/Generic-Functions-and-Methods.html new file mode 100644 index 0000000..d031f2a --- /dev/null +++ b/info/gcl/Generic-Functions-and-Methods.html @@ -0,0 +1,69 @@ + + + + + +Generic Functions and Methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects  

    +
    +
    +

    7.6 Generic Functions and Methods

    + + + + + + + + + + +
    • Introduction to Generic Functions   +
    • Introduction to Methods   +
    • Agreement on Parameter Specializers and Qualifiers   +
    • Congruent Lambda-lists for all Methods of a Generic Function   +
    • Keyword Arguments in Generic Functions and Methods   +
    • Method Selection and Combination   +
    • Inheritance of Methods   +
    + + + + + + diff --git a/info/gcl/Glossary-_0028Glossary_0029.html b/info/gcl/Glossary-_0028Glossary_0029.html new file mode 100644 index 0000000..dda0007 --- /dev/null +++ b/info/gcl/Glossary-_0028Glossary_0029.html @@ -0,0 +1,56 @@ + + + + + +Glossary (Glossary) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    26 Glossary

    + + + +
    • Glossary   +
    + + + + + + diff --git a/info/gcl/Glossary.html b/info/gcl/Glossary.html new file mode 100644 index 0000000..82fc885 --- /dev/null +++ b/info/gcl/Glossary.html @@ -0,0 +1,6801 @@ + + + + + +Glossary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Glossary (Glossary)  

    +
    +
    +

    26.1 Glossary

    + + +

    Each entry in this glossary has the following parts: +

    +
    +
    *
    +

    the term being defined, set in boldface. +

    +
    +
    *
    +

    optional pronunciation, enclosed in square brackets and +set in boldface, as in the following example: +pronounced ’a ,list . The pronunciation key follows +Webster’s Third New International Dictionary + the English Language, Unabridged, + except that “e” is used to notate the schwa (upside-down “e”) character. +

    +
    +
    *
    +

    the part or parts of speech, set in italics. If a term +can be used as several parts of speech, there is a separate definition +for each part of speech. +

    +
    +
    *
    +

    one or more definitions, organized as follows: +

    +
    +
    –
    +

    an optional number, present if there are several +definitions. Lowercase letters might also be used in cases where subdefinitions of +a numbered definition are necessary. +

    +
    +
    –
    +

    an optional part of speech, set in italics, present if the +term is one of several parts of speech. +

    +
    +
    –
    +

    an optional discipline, set in italics, present if the term +has a standard definition being repeated. For example, “Math.” +

    +
    +
    –
    +

    an optional context, present if this definition is +meaningful only in that context. For example, “(of a symbol)”. +

    +
    +
    –
    +

    the definition. +

    +
    +
    –
    +

    an optional example sentence. For example, + “This is an example of an example.” +

    +
    +
    –
    +

    optional cross references. +

    +
    +
    + +
    +
    + +

    In addition, some terms have idiomatic usage in the Common Lisp +community which is not shared by other communities, or which is not +technically correct. Definitions labeled “Idiom.” represent +such idiomatic usage; these definitions are sometimes followed by an +explanatory note. +

    +

    Words in this font are words with entries in the glossary. +Words in example sentences do not follow this convention. +

    +

    When an ambiguity arises, the longest matching substring has precedence. +For example, “complex float” refers to a single glossary entry +for “complex float” rather than the combined meaning of the +glossary terms “complex” and “float.” +

    +

    Subscript notation, as in “something_n” means that +the nth definition of “something” is intended. This +notation is used only in situations where the context might be insufficient +to disambiguate. +

    +

    The following are abbreviations used in the glossary: +

    +

    Abbreviation Meaning +

    +
    adj.
    +

    adjective +

    +
    adv.
    +

    adverb +

    +
    ANSI
    +

    compatible with one or more ANSI standards +

    +
    Comp.
    +

    computers +

    +
    Idiom.
    +

    idiomatic +

    +
    IEEE
    +

    compatible with one or more IEEE standards +

    +
    ISO
    +

    compatible with one or more ISO standards +

    +
    Math.
    +

    mathematics +

    +
    Trad.
    +

    traditional +

    +
    n.
    +

    noun +

    +
    v.
    +

    verb +

    +
    v.t.
    +

    transitive verb +

    +
    + + +

    Non-alphabetic

    +
    +
    + +
    +
    ()
    +

    pronounced ’nil , n. + an alternative notation for writing the symbol~nil, used to emphasize + the use of nil as an empty list. +

    +
    +
    +

    A

    +
    +
    + +
    +
    absolute
    +

    adj. + 1. (of a time) + representing a specific point in time. + 2. (of a pathname) + representing a specific position in a directory hierarchy. + See relative. +

    + +
    +
    access
    +

    n., v.t. + 1. v.t. (a place, or array) + to read_1 or write_1 the value of + the place + or an element of the array. + 2. n. (of a place) + an attempt to access_1 the value of the place. +

    + +
    +
    accessibility
    +

    n. + the state of being accessible. +

    + +
    +
    accessible
    +

    adj. + 1. (of an object) capable of being referenced. + 2. (of shared slots or local slots in an instance of + a class) having been defined by the class + of the instance or inherited from a + superclass of that class. + 3. (of a symbol in a package) + capable of being referenced without a package prefix + when that package is current, regardless of whether the + symbol is present in that package or is inherited. +

    + +
    +
    accessor
    +

    n. + an operator that performs an access. + See reader and writer. +

    + +
    +
    active
    +

    adj. + 1. (of a handler, a restart, or a catch tag) + having been established but not yet disestablished. + 2. (of an element of an array) + having an index that is greater than or equal to zero, + but less than the fill pointer (if any). + For an array that has no fill pointer, + all elements are considered active. +

    + +
    +
    actual adjustability
    +

    n. (of an array) + a generalized boolean that is associated with the array, + representing whether the array is actually adjustable. + See also expressed adjustability and adjustable-array-p. +

    + +
    +
    actual argument
    +

    n. Trad. + an argument. +

    + +
    +
    actual array element type
    +

    n. (of an array) + the type for which the array is actually specialized, + which is the upgraded array element type of + the expressed array element type of the array. + See the function array-element-type. +

    + +
    +
    actual complex part type
    +

    n. (of a complex) + the type in which the real and imaginary parts of the complex + are actually represented, which is the upgraded complex part type of the + expressed complex part type of the complex. +

    + +
    +
    actual parameter
    +

    n. Trad. + an argument. +

    + +
    +
    actually adjustable
    +

    adj. (of an array) + such that adjust-array can adjust its characteristics + by direct modification. + A conforming program may depend on + an array being actually adjustable + only if either that array is known to have been expressly adjustable + or if that array has been explicitly tested by adjustable-array-p. +

    + +
    +
    adjustability
    +

    n. (of an array) + 1. expressed adjustability. + 2. actual adjustability. +

    + +
    +
    adjustable
    +

    adj. (of an array) + 1. expressly adjustable. + 2. actually adjustable. +

    + +
    +
    after method
    +

    n. + a method having the qualifier :after. +

    + +
    +
    alist
    +

    pronounced ’\=a ,list , n. + an association list. +

    + +
    +
    alphabetic
    +

    n., adj. + 1. adj. (of a character) + being one of the standard characters A through Z + or a through z, + or being any implementation-defined character that has case, + or being some other graphic character + defined by the implementation to be alphabetic_1. + 2. a. n. + one of several possible constituent traits of a character. + For details, see Constituent Characters and Reader Algorithm. + b. adj. (of a character) + being a character + that has syntax type constituent in the current readtable + and that has the constituent trait alphabetic_{2a}. + See Figure~2–8. +

    + +
    +
    alphanumeric
    +

    adj. (of a character) + being either an alphabetic_1 character + or a numeric character. +

    + +
    +
    ampersand
    +

    n. + the standard character that is called “ampersand” (&). + See Figure~2–5. +

    + +
    +
    anonymous
    +

    adj. + 1. (of a class or function) having no name + 2. (of a restart) having a name of nil. +

    + +
    +
    apparently uninterned
    +

    adj. + having a home package of nil. (An apparently uninterned symbol + might or might not be an uninterned symbol. Uninterned symbols + have a home package of nil, but symbols which have been uninterned + from their home package also have a home package of nil, + even though they might still be interned in some other package.) +

    + +
    +
    applicable
    +

    adj. + 1. (of a handler) being an applicable handler. + 2. (of a method) being an applicable method. + 3. (of a restart) being an applicable restart. +

    + +
    +
    applicable handler
    +

    n. (for a condition being signaled) + an active handler for which the associated type contains the + condition. +

    + +
    +
    applicable method
    +

    n. (of a generic function + called with arguments) + a method of the generic function for which the + arguments satisfy the parameter specializers + of that method. + See Selecting the Applicable Methods. +

    + +
    +
    applicable restart
    +

    n. + 1. (for a condition) + an active handler for which the associated test returns + true when given the condition as an argument. + 2. (for no particular condition) + an active handler for which the associated test returns + true when given nil as an argument. +

    + +
    +
    apply
    +

    v.t. (a function to a list) + to call the function with arguments that are the elements + of the list. + “Applying the function + to a list of integers returns + the sum of the elements of that list.” +

    + +
    +
    argument
    +

    n. + 1. (of a function) an object which is offered as data + to the function when it is called. +

    +

    2. (of a format control) a format argument. +

    + +
    +
    argument evaluation order
    +

    n. + the order in which arguments are evaluated in a function call. + “The argument evaluation order for Common Lisp is left to right.” + See Evaluation. +

    + +
    +
    argument precedence order
    +

    n. + the order in which the arguments to a generic function are + considered when sorting the applicable methods into precedence order. +

    + +
    +
    around method
    +

    n. + a method having the qualifier :around. +

    + +
    +
    array
    +

    n. + an object of type array, which serves as a container for other + objects arranged in a Cartesian coordinate system. +

    + +
    +
    array element type
    +

    n. (of an array) + 1. a type associated with the array, + and of which all elements of the array are + constrained to be members. + 2. the actual array element type of the array. + 3. the expressed array element type of the array. +

    + +
    +
    array total size
    +

    n. + the total number of elements in an array, computed by taking + the product of the dimensions of the array. + (The size of a zero-dimensional array is therefore one.) +

    + +
    +
    assign
    +

    v.t. (a variable) + to change the value of the variable in a binding + that has already been established. + See the special operator setq. +

    + +
    +
    association list
    +

    n. + a list of conses representing an association + of keys with values, where the car of each + cons is the key and the cdr is the + value associated with that key. +

    + +
    +
    asterisk
    +

    n. + the standard character that is variously called + “asterisk” + or “star” (*). + See Figure~2–5. +

    + +
    +
    at-sign
    +

    n. + the standard character that is variously called + “commercial at” + or “at sign” (@). + See Figure~2–5. +

    + +
    +
    atom
    +

    n. + any object that is not a cons. + “A vector is an atom.” +

    + +
    +
    atomic
    +

    adj. + being an atom. + “The number 3, the symbol foo, and nil are atomic.” +

    + +
    +
    atomic type specifier
    +

    n. + a type specifier that is atomic. + For every atomic type specifier, x, there is an equivalent + compound type specifier with no arguments supplied, (x). +

    + +
    +
    attribute
    +

    n. (of a character) + a program-visible aspect of the character. + The only standardized attribute of a character + is its code_2, but implementations are permitted to have + additional implementation-defined attributes. + See Character Attributes. + “An implementation that support fonts + might make font information an attribute of a character, + while others might represent font information separately from characters.” +

    + +
    +
    aux variable
    +

    n. + a variable that occurs in the part of a lambda list + that was introduced by &aux. Unlike all other variables + introduced by a lambda-list, aux variables are not + parameters. +

    + +
    +
    auxiliary method
    +

    n. + a member of one of two sets of methods + (the set of primary methods is the other) + that form an exhaustive partition of the set of methods + on the method’s generic function. + How these sets are determined is dependent on the method combination type; + see Introduction to Methods. +

    +
    +
    +

    B

    +
    +
    + +
    +
    backquote
    +

    n. + the standard character that is variously called + “grave accent” + or “backquote” (`). + See Figure~2–5. +

    + +
    +
    backslash
    +

    n. + the standard character that is variously called + “reverse solidus” + or “backslash” (\). + See Figure~2–5. +

    + +
    +
    base character
    +

    n. + a character +

    +

    of type base-char. +

    + +
    +
    base string
    +

    n. + a string of type base-string. +

    + +
    +
    before method
    +

    n. + a method having the qualifier :before. +

    + +
    +
    bidirectional
    +

    adj. (of a stream) + being both an input stream and an output stream. +

    + +
    +
    binary
    +

    adj. + 1. (of a stream) + being a stream that has an element type that is a subtype of type integer. + The most fundamental operation on a binary input stream + is read-byte and on a binary output stream + is write-byte. + See character. + 2. (of a file) + having been created by opening a binary stream. + (It is implementation-dependent whether this is an detectable aspect + of the file, or whether any given character file can be + treated as a binary file.) +

    + +
    +
    bind
    +

    v.t. (a variable) + to establish a binding for the variable. +

    + +
    +
    binding
    +

    n. + an association between a name and that which the name + denotes. + “A lexical binding is a lexical association between a + name and its value.” +

    + +
    +
    bit
    +

    n. + an object of type bit; + that is, the integer 0 or the integer 1. +

    + +
    +
    bit array
    +

    n. + a specialized array that is of type (array bit), + and whose elements are of type bit. +

    + +
    +
    bit vector
    +

    n. + a specialized vector that is of type bit-vector, + and whose elements are of type bit. +

    + +
    +
    bit-wise logical operation specifier
    +

    n. + an object which names one of the sixteen possible bit-wise logical + operations that can be performed by the boole function, + and which is the value of exactly one of the + constant variables + boole-clr, boole-set, + boole-1, boole-2, + boole-c1, boole-c2, + boole-and, boole-ior, + boole-xor, boole-eqv, + boole-nand, boole-nor, + boole-andc1, boole-andc2, + boole-orc1, or boole-orc2. +

    + +
    +
    block
    +

    n. + a named lexical exit point, + established explicitly by block + or implicitly by operators + such as loop, do and prog, + to which control and values may be transfered by + using a return-from form with the name of the block. +

    + +
    +
    block tag
    +

    n. + the symbol that, within the lexical scope + of a block form, names the block + established by that block form. + See return or return-from. +

    + +
    +
    boa lambda list
    +

    n. + a lambda list that is syntactically like an ordinary lambda list, + but that is processed in “by order of argument” style. + See Boa Lambda Lists. +

    + +
    +
    body parameter
    +

    n. + a parameter available in certain lambda lists + which from the point of view of conforming programs + is like a rest parameter in every way except that it is introduced + by &body instead of &rest. (Implementations are + permitted to provide extensions which distinguish body parameters + and rest parameters—e.g., the forms for operators + which were defined using a body parameter might be pretty printed + slightly differently than forms for operators which were + defined using rest parameters.) +

    + +
    +
    boolean
    +

    n. + an object of type boolean; + that is, one of the following objects: + the symbol~t (representing true), + or the symbol~nil (representing false). + See generalized boolean. +

    + +
    +
    boolean equivalent
    +

    n. (of an object O_1) + any object O_2 that has the same truth value as O_1 + when both O_1 and O_2 are viewed as generalized booleans. +

    + +
    +
    bound
    +

    adj., v.t. + 1. adj. having an associated denotation in a binding. + “The variables named by a let are bound within + its body.” + See unbound. + 2. adj. having a local binding which + shadows_2 another. + “The variable *print-escape* is bound while in + the princ function.” + 3. v.t. the past tense of bind. +

    + +
    +
    bound declaration
    +

    n. + a declaration that refers to or is associated with a variable + or function and that appears within the special form + that establishes the variable or function, + but before the body of that special form + (specifically, at the head of that form’s body). + (If a bound declaration refers to a function binding or + a lexical variable binding, the scope of + the declaration is exactly the scope of that + binding. If the declaration refers to a + dynamic variable binding, the scope of + the declaration is what the scope of the + binding would have been if it were lexical rather than dynamic.) +

    + +
    +
    bounded
    +

    adj. (of a sequence S, + by an ordered pair + of bounding indices i_{start} and i_{end}) + restricted to a subrange of the elements of S that includes each element + beginning with (and including) the one indexed by i_{start} and + continuing up to (but not including) the one indexed by i_{end}. +

    + +
    +
    bounding index
    +

    n. (of a sequence with length n) + either of a conceptual pair of integers, i_{start} and i_{end}, + respectively called the “lower bounding index” and “upper bounding index”, + such that 0 <= i_{start} <= i_{end} <= n, and which therefore delimit + a subrange of the sequence bounded by i_{start} and i_{end}. +

    + +
    +
    bounding index designator
    +

    (for a sequence) + one of two objects that, taken together as an ordered pair, + behave as a designator for bounding indices of the sequence; + that is, they denote bounding indices of the sequence, + and are either: + an integer (denoting itself) and nil + (denoting the length of the sequence), + or two integers (each denoting themselves). +

    + +
    +
    break loop
    +

    n. + A variant of the normal Lisp read-eval-print loop that is recursively + entered, usually because the ongoing evaluation of some other form + has been suspended for the purpose of debugging. Often, a break loop + provides the ability to exit in such a way as to continue the suspended computation. + See the function break. +

    + +
    +
    broadcast stream
    +

    n. + an output stream of type broadcast-stream. +

    + +
    +
    built-in class
    +

    n. + a class that is a generalized instance of class built-in-class. +

    + +
    +
    built-in type
    +

    n. + one of the types in Figure~4–2. +

    + +
    +
    byte
    +

    n. + 1. adjacent bits within an integer. + (The specific number of bits can vary from point to point in the program; + see the function byte.) + 2. an integer in a specified range. + (The specific range can vary from point to point in the program; + see the functions open and write-byte.) +

    + +
    +
    byte specifier
    +

    n. + An object of implementation-dependent nature + that is returned by the function byte and + that specifies the range of bits in an integer to be used + as a byte by functions such as ldb. +

    +
    +
    +

    C

    +
    +
    + +
    +
    cadr
    +

    pronounced ’ka ,de r , n. (of an object) + the car of the cdr of that object. +

    + +
    +
    call
    +

    v.t., n. + 1. v.t. (a function with arguments) + to cause the code represented by that function to be + executed in an environment where bindings for + the values of its parameters have been established + based on the arguments. + “Calling the function + with the arguments + 5 and 1 yields a value of 6.” + 2. n. a situation in which a function is called. +

    + +
    +
    captured initialization form
    +

    n. + an initialization form along with the lexical environment + in which the form that defined the initialization form + was evaluated. + “Each newly added shared slot is set to the result of evaluating + the captured initialization form for the slot that was specified + in the defclass form for the new class.” +

    + +
    +
    car
    +

    n. + 1. a. (of a cons) + the component of a cons corresponding to the first + argument to cons; the other component is the + cdr. + “The function rplaca modifies the car of a cons.” + b. (of a list) + the first element of the list, or nil if the + list is the empty list. + 2. the object that is held in the car_1. + “The function car returns the car of a cons.” +

    + +
    +
    case
    +

    n. (of a character) + the property of being either uppercase or lowercase. + Not all characters have case. + “The characters #\A and #\a have case, + but the character #\$ has no case.” + See Characters With Case and the function both-case-p. +

    + +
    +
    case sensitivity mode
    +

    n. + one of the symbols + :upcase, :downcase, :preserve, or :invert. +

    + +
    +
    catch
    +

    n. + an exit point which is established by a catch + form within the dynamic scope of its body, + which is named by a catch tag, + and to which control and values may be thrown. +

    + +
    +
    catch tag
    +

    n. + an object which names an active catch. + (If more than one catch is active with the same catch tag, + it is only possible to throw to the innermost such catch + because the outer one is shadowed_2.) +

    + +
    +
    cddr
    +

    pronounced ’kud e ,de r or + pronounced ’ke ,dude r , n. + (of an object) + the cdr of the cdr of that object. +

    + +
    +
    cdr
    +

    pronounced ’ku ,de r , n. + 1. a. (of a cons) + the component of a cons corresponding to the second argument + to cons; the other component is the car. + “The function rplacd modifies the cdr of a cons.” + b. (of a list L_1) + either the list L_2 that contains + the elements of L_1 that follow after the first, + or else nil if L_1 is the empty list. + 2. the object that is held in the cdr_1. + “The function cdr returns the cdr of a cons.” +

    + +
    +
    cell
    +

    n. Trad. (of an object) + a conceptual slot of that object. + The dynamic variable and global function bindings + of a symbol are sometimes referred to as its value cell + and function cell, respectively. +

    + +
    +
    character
    +

    n., adj. + 1. n. an object of type character; that is, + an object that represents a unitary token in an aggregate quantity of text; + see Character Concepts. + 2. adj. + a. (of a stream) + having an element type that is a subtype of type character. + The most fundamental operation on a character input stream + is read-char and on a character output stream + is write-char. See binary. + b. (of a file) + having been created by opening a character stream. + (It is implementation-dependent whether this is an inspectable aspect + of the file, or whether any given binary file can be + treated as a character file.) +

    + +
    +
    character code
    +

    n. + 1. one of possibly several attributes of a character. + 2. a non-negative integer less than the value of char-code-limit + that is suitable for use as a character code_1. +

    + +
    +
    character designator
    +

    n. + a designator for a character; that is, + an object that denotes a character + and that is one of: + a designator for a string of length one + (denoting the character that is its only element), +

    +

    or a character (denoting itself). +

    + +
    +
    circular
    +

    adj. + 1. (of a list) a circular list. + 2. (of an arbitrary object) + having a component, element, constituent_2, + or subexpression (as appropriate to the context) + that is the object itself. +

    + +
    +
    circular list
    +

    n. + a chain of conses that has no termination because some + cons in the chain is the cdr of a later cons. +

    + +
    +
    class
    +

    n. + 1. an object that uniquely determines the structure and behavior of + a set of other objects called its direct instances, + that contributes structure and behavior to a set of + other objects called its indirect instances, + and that acts as a type specifier for a set of objects + called its generalized instances. + “The class integer is a subclass of the class number.” + (Note that the phrase “the class foo” is often substituted for + the more precise phrase “the class named foo”—in both + cases, a class object (not a symbol) is denoted.) + 2. (of an object) + the uniquely determined class of which the object is + a direct instance. + See the function class-of. + “The class of the object returned by gensym + is symbol.” + (Note that with this usage a phrase such as “its class is foo” + is often substituted for the more precise phrase + “its class is the class named foo”—in both + cases, a class object (not a symbol) is denoted.) +

    + +
    +
    class designator
    +

    n. + a designator for a class; that is, + an object that denotes a class + and that is one of: + a symbol (denoting the class named by that symbol; + see the function find-class) + or a class (denoting itself). +

    + +
    +
    class precedence list
    +

    n. + a unique total ordering on a class + and its superclasses that is consistent with the + local precedence orders for the class and its + superclasses. + For detailed information, see Determining the Class Precedence List. +

    + +
    +
    close
    +

    v.t. (a stream) + to terminate usage of the stream as a source or sink of data, + permitting the implementation to reclaim its internal data structures, + and to free any external resources which might have been locked by the + stream when it was opened. +

    + +
    +
    closed
    +

    adj. (of a stream) + having been closed (see close). + Some (but not all) operations that are valid on open streams + are not valid on closed streams. + See File Operations on Open and Closed Streams. +

    + +
    +
    closure
    +

    n. + a lexical closure. +

    + +
    +
    coalesce
    +

    v.t. (literal objects that are similar) + to consolidate the identity of those objects, + such that they become the same + object. + See Compiler Terminology. +

    + +
    +
    code
    +

    n. + 1. Trad. + any representation of actions to be performed, whether conceptual + or as an actual object, such as + forms, + lambda expressions, + objects of type function, + text in a source file, + or instruction sequences in a compiled file. + This is a generic term; + the specific nature of the representation depends on its context. + 2. (of a character) + a character code. +

    + +
    +
    coerce
    +

    v.t. (an object to a type) + to produce an object from the given object, + without modifying that object, + by following some set of coercion rules that must be specifically + stated for any context in which this term is used. + The resulting object is necessarily of the indicated type, + except when that type is a subtype of type complex; in that case, + if a complex rational with an imaginary part of zero would result, + the result is a rational + rather than a complex—see Rule of Canonical Representation for Complex Rationals. +

    + +
    +
    colon
    +

    n. + the standard character that is called “colon” (:). + See Figure~2–5. +

    + +
    +
    comma
    +

    n. + the standard character that is called “comma” (,). + See Figure~2–5. +

    + +
    +
    compilation
    +

    n. + the process of compiling code by the compiler. +

    + +
    +
    compilation environment
    +

    n. + 1. An environment that represents information known by the + compiler about a form that is being compiled. + See Compiler Terminology. + 2. An object that represents the + compilation environment_1 + and that is used as a second argument to a macro function + (which supplies a value for any &environment parameter + in the macro function’s definition). +

    + +
    +
    compilation unit
    +

    n. + an interval during which a single unit of compilation is occurring. + See the macro with-compilation-unit. +

    + +
    +
    compile
    +

    v.t. + 1. (code) + to perform semantic preprocessing of the code, usually optimizing + one or more qualities of the code, such as run-time speed of execution + or run-time storage usage. The minimum semantic requirements of compilation are + that it must remove all macro calls and arrange for all load time values + to be resolved prior to run time. + 2. (a function) + to produce a new object of type compiled-function + which represents the result of compiling the code + represented by the function. See the function compile. + 3. (a source file) + to produce a compiled file from a source file. + See the function compile-file. +

    + +
    +
    compile time
    +

    n. + the duration of time that the compiler is processing source code. +

    + +
    +
    compile-time definition
    +

    n. + a definition in the compilation environment. +

    + +
    +
    compiled code
    +

    n. + 1. compiled functions. + 2. code that represents compiled functions, + such as the contents of a compiled file. +

    + +
    +
    compiled file
    +

    n. + a file which represents the results of compiling the + forms which appeared in a corresponding source file, + and which can be loaded. See the function compile-file. +

    + +
    +
    compiled function
    +

    n. + an object of type compiled-function, which is a function + that has been compiled, which contains no references to macros that + must be expanded at run time, and which contains no unresolved references + to load time values. +

    + +
    +
    compiler
    +

    n. + a facility that is part of Lisp and that translates code + into an implementation-dependent form + that might be represented or executed efficiently. + The functions compile and compile-file + permit programs to invoke the compiler. +

    + +
    +
    compiler macro
    +

    n. + an auxiliary macro definition for a globally defined function + or macro which might or might not be called by any given + conforming implementation and which must preserve the semantics + of the globally defined function or macro but which might + perform some additional optimizations. (Unlike a macro, + a compiler macro does not extend the syntax of Common Lisp; rather, it + provides an alternate implementation strategy for some existing syntax + or functionality.) +

    + +
    +
    compiler macro expansion
    +

    n. + 1. the process of translating a form into another form + by a compiler macro. + 2. the form resulting from this process. +

    + +
    +
    compiler macro form
    +

    n. + a function form or macro form whose operator + has a definition as a compiler macro, + or a funcall form whose first argument is a + function form whose argument is the name + of a function that has a definition as a compiler macro. +

    + +
    +
    compiler macro function
    +

    n. + a function of two arguments, a form and an + environment, that implements compiler macro expansion by + producing either a form to be used in place of the original + argument form or else nil, indicating that the original form + should not be replaced. See Compiler Macros. +

    + +
    +
    complex
    +

    n. + an object of type complex. +

    + +
    +
    complex float
    +

    n. + an object of type complex which has a complex part type + that is a subtype of float. + A complex float is a complex, + but it is not a float. +

    + +
    +
    complex part type
    +

    n. (of a complex) + 1. the type which is used to represent both the real part + and the imaginary part of the complex. + 2. the actual complex part type of the complex. + 3. the expressed complex part type of the complex. +

    + +
    +
    complex rational
    +

    n. + an object of type complex which has a complex part type + that is a subtype of rational. + A complex rational is a complex, but it is not a rational. + No complex rational has an imaginary part of zero because such a + number is always represented by Common Lisp as an object of type rational; + see Rule of Canonical Representation for Complex Rationals. +

    + +
    +
    complex single float
    +

    n. + an object of type complex which has a complex part type + that is a subtype of single-float. + A complex single float is a complex, + but it is not a single float. +

    + +
    +
    composite stream
    +

    n. + a stream that is composed of one or more other streams. + “make-synonym-stream creates a composite stream.” +

    + +
    +
    compound form
    +

    n. + a non-empty list which is a form: + a special form, + a lambda form, + a macro form, + or a function form. +

    + +
    +
    compound type specifier
    +

    n. + a type specifier that is a cons; + i.e., a type specifier that is not an atomic type specifier. + “(vector single-float) is a compound type specifier.” +

    + +
    +
    concatenated stream
    +

    n. + an input stream of type concatenated-stream. +

    + +
    +
    condition
    +

    n. + 1. an object which represents a situation—usually, + but not necessarily, during signaling. + 2. an object of type condition. +

    + +
    +
    condition designator
    +

    n. + one or more objects that, taken together, + denote either an existing condition object + or a condition object to be implicitly created. + For details, see Condition Designators. +

    + +
    +
    condition handler
    +

    n. + a function that might be invoked by the act of signaling, + that receives the condition being signaled as its only argument, + and that is permitted to handle the condition + or to decline. See Signaling. +

    + +
    +
    condition reporter
    +

    n. + a function that describes how a condition is to be printed + when the Lisp printer is invoked while *print-escape* + is false. See Printing Conditions. +

    + +
    +
    conditional newline
    +

    n. + a point in output where a newline might be inserted at the + discretion of the pretty printer. + There are four kinds of conditional newlines, + called “linear-style,” + “fill-style,” + “miser-style,” + and “mandatory-style.” + See the function pprint-newline and Dynamic Control of the Arrangement of Output. +

    + +
    +
    conformance
    +

    n. + a state achieved by proper and complete adherence to the requirements + of this specification. See Conformance. +

    + +
    +
    conforming code
    +

    n. + code that is all of part of a conforming program. +

    + +
    +
    conforming implementation
    +

    n. + an implementation, used to emphasize complete and correct + adherance to all conformance criteria. + A conforming implementation is capable of + accepting a conforming program as input, + preparing that program for execution, + and executing the prepared program in accordance with this specification. + An implementation which + has been extended may still be a conforming implementation + provided that no extension interferes with the correct function of any + conforming program. +

    + +
    +
    conforming processor
    +

    n. ANSI + a conforming implementation. +

    + +
    +
    conforming program
    +

    n. + a program, used to emphasize the fact that the program + depends for its correctness only upon documented aspects of Common Lisp, and + can therefore be expected to run correctly in any conforming implementation. +

    + +
    +
    congruent
    +

    n. + conforming to the rules of lambda list congruency, as detailed in + Congruent Lambda-lists for all Methods of a Generic Function. +

    + +
    +
    cons
    +

    n.v. + 1. n. a compound data object having two components called the + car and the cdr. + 2. v. to create such an object. + 3. v. Idiom. to create any object, or to allocate storage. +

    + +
    +
    constant
    +

    n. + 1. a constant form. + 2. a constant variable. + 3. a constant object. + 4. a self-evaluating object. +

    + +
    +
    constant form
    +

    n. + any form + for which evaluation always yields the same value, + that neither affects nor is affected by the environment + in which it is evaluated (except that it is permitted to + refer to the names of constant variables + defined in the environment), + and + that neither affects nor is affected by the state of any object + except those objects that are otherwise inaccessible parts + of objects created by the form itself. + “A car form in which the argument is a + quote form is a constant form.” +

    + +
    +
    constant object
    +

    n. + an object that is constrained (e.g., by its context in a program + or by the source from which it was obtained) to be immutable. + “A literal object that has been processed by compile-file + is a constant object.” +

    + +
    +
    constant variable
    +

    n. + a variable, the value of which can never change; + that is, a keyword_1 or a named constant. + “The symbols t, nil, :direction, and + most-positive-fixnum are constant variables.” +

    + +
    +
    constituent
    +

    n., adj. + 1. a. n. the syntax type of a character that is part of a token. + For details, see Constituent Characters. + b. adj. (of a character) + having the constituent_{1a} syntax type_2. + c. n. a constituent_{1b} character. + 2. n. (of a composite stream) + one of possibly several objects that collectively comprise + the source or sink of that stream. +

    + +
    +
    constituent trait
    +

    n. (of a character) + one of several classifications of a constituent character + in a readtable. See Constituent Characters. +

    + +
    +
    constructed stream
    +

    n. + a stream whose source or sink is a Lisp object. + Note that since a stream is another Lisp object, + composite streams are considered constructed streams. + “A string stream is a constructed stream.” +

    + +
    +
    contagion
    +

    n. + a process whereby operations on objects of differing types + (e.g., arithmetic on mixed types of numbers) produce a result + whose type is controlled by the dominance of one argument’s + type over the types of the other arguments. + See Contagion in Numeric Operations. +

    + +
    +
    continuable
    +

    n. (of an error) + an error that is correctable by the continue restart. +

    + +
    +
    control form
    +

    n. + 1. a form that establishes one or more places to which control + can be transferred. + 2. a form that transfers control. +

    + +
    +
    copy
    +

    n. + 1. (of a cons C) + a fresh cons with the same car and cdr as C. + 2. (of a list L) + a fresh list with the same elements as L. + (Only the list structure is fresh; + the elements are the same.) + See the function copy-list. + 3. (of an association list A with elements A_i) + a fresh list B with elements B_i, each of which is + nil if A_i is nil, or else a copy of the cons A_i. + See the function copy-alist. + 4. (of a tree T) + a fresh tree with the same leaves as T. + See the function copy-tree. + 5. (of a random state R) + a fresh random state that, if used as an argument to + to the function random would produce the same series of “random” + values as R would produce. +

    +

    6. (of a structure S) + a fresh structure that has the same type as S, + and that has slot values, each of which is the same as the + corresponding slot value of S. +

    +

    (Note that since the difference between a cons, a list, + and a tree is a matter of “view” or “intention,” there can + be no general-purpose function which, based solely on the type + of an object, can determine which of these distinct meanings is + intended. The distinction rests solely on the basis of the text description + within this document. For example, phrases like “a copy of the + given list” or “copy of the list x” imply the + second definition.) +

    + +
    +
    correctable
    +

    adj. (of an error) + 1. (by a restart other than abort + that has been associated with the error) + capable of being corrected by invoking that restart. + “The function cerror signals an error + that is correctable by the continue restart.” +

    +

    (Note that correctability is not a property of an + error object, but rather a property of the + dynamic environment that is in effect when the + error is signaled. + Specifically, the restart is “associated with” + the error condition object. + See Associating a Restart with a Condition.) +

    +

    2. (when no specific restart is mentioned) + correctable_1 by at least one restart. + “import signals a correctable error of type package-error + if any of the imported symbols has the same name as + some distinct symbol already accessible in the package.” +

    + +
    +
    current input base
    +

    n. (in a dynamic environment) + the radix that is the value of *read-base* in that environment, + and that is the default radix employed by the Lisp reader + and its related functions. +

    + +
    +
    current logical block
    +

    n. + the context of the innermost lexically enclosing use of pprint-logical-block. +

    + +
    +
    current output base
    +

    n. (in a dynamic environment) + the radix that is the value of *print-base* in that environment, + and that is the default radix employed by the Lisp printer + and its related functions. +

    + +
    +
    current package
    +

    n. (in a dynamic environment) + the package that is the value of *package* in that environment, + and that is the default package employed by the Lisp reader + and Lisp printer, and their related functions. +

    + +
    +
    current pprint dispatch table
    +

    n. (in a dynamic environment) + the pprint dispatch table that is the value of *print-pprint-dispatch* + in that environment, and that is the default pprint dispatch table + employed by the pretty printer. +

    + +
    +
    current random state
    +

    n. (in a dynamic environment) + the random state that is the value of *random-state* in that environment, + and that is the default random state employed by random. +

    + +
    +
    current readtable
    +

    n. (in a dynamic environment) + the readtable that is the value of *readtable* in that environment, + and that affects the way in which expressions_2 are parsed + into objects by the Lisp reader. +

    +
    +
    +

    D

    +
    +
    + +
    +
    data type
    +

    n. Trad. + a type. +

    + +
    +
    debug I/O
    +

    n. + the bidirectional stream + that is the value of the variable *debug-io*. +

    + +
    +
    debugger
    +

    n. + a facility that allows the user to handle a condition interactively. + For example, the debugger might permit interactive + selection of a restart from among the active restarts, + and it might perform additional implementation-defined services + for the purposes of debugging. +

    + +
    +
    declaration
    +

    n. + a global declaration or local declaration. +

    + +
    +
    declaration identifier
    +

    n. + one of the symbols + declaration, + dynamic-extent, + ftype, + function, + ignore, + inline, + notinline, + optimize, + special, + or type; + or a symbol which is the name of a type; + or a symbol which has been declared + to be a declaration identifier by using a declaration + declaration. +

    + +
    +
    declaration specifier
    +

    n. + an expression that can appear at top level of a declare + expression or a declaim form, or as the argument to proclaim, + and which has a car which is a declaration identifier, + and which has a cdr that is data interpreted according to rules + specific to the declaration identifier. +

    + +
    +
    declare
    +

    v. + to establish a declaration. + See declare, declaim, or proclaim. +

    + +
    +
    decline
    +

    v. (of a handler) + to return normally without having handled the condition + being signaled, permitting the signaling process to continue + as if the handler had not been present. +

    + +
    +
    decoded time
    +

    n. + absolute time, represented as an ordered series of + nine objects which, taken together, form a description of + a point in calendar time, accurate to the nearest second (except + that leap seconds are ignored). + See Decoded Time. +

    + +
    +
    default method
    +

    n. + a method having no parameter specializers other than + the class t. Such a method is always an applicable method + but might be shadowed_2 by a more specific method. +

    + +
    +
    defaulted initialization argument list
    +

    n. + a list of alternating initialization argument names and + values in which unsupplied initialization arguments are + defaulted, used in the protocol for initializing and reinitializing + instances of classes. +

    + +
    +
    define-method-combination arguments lambda list
    +

    n. + a lambda list used by the :arguments option + to define-method-combination. + See Define-method-combination Arguments Lambda Lists. +

    + +
    +
    define-modify-macro lambda list
    +

    n. + a lambda list used by define-modify-macro. + See Define-modify-macro Lambda Lists. +

    + +
    +
    defined name
    +

    n. + a symbol the meaning of which is defined by Common Lisp. +

    + +
    +
    defining form
    +

    n. + a form that has the side-effect of establishing a definition. + “defun and defparameter are defining forms.” +

    + +
    +
    defsetf lambda list
    +

    n. + a lambda list that is like an ordinary lambda list + except that it does not permit &aux + and that it permits use of &environment. + See Defsetf Lambda Lists. +

    + +
    +
    deftype lambda list
    +

    n. + a lambda list that is like a macro lambda list + except that the default value for unsupplied optional parameters + and keyword parameters is the symbol * (rather than nil). + See Deftype Lambda Lists. +

    + +
    +
    denormalized
    +

    adj., ANSI, IEEE (of a float) + conforming to the description of “denormalized” as described by + IEEE Standard for Binary Floating-Point Arithmetic. + For example, in an implementation where the minimum possible exponent + was -7 but where 0.001 was a valid mantissa, the number 1.0e-10 + might be representable as 0.001e-7 internally even if the normalized + representation would call for it to be represented instead as 1.0e-10 + or 0.1e-9. By their nature, denormalized floats generally + have less precision than normalized floats. +

    + +
    +
    derived type
    +

    n. + a type specifier which is defined in terms of an expansion into another + type specifier. deftype defines derived types, + and there may be other implementation-defined operators + which do so as well. +

    + +
    +
    derived type specifier
    +

    n. + a type specifier for a derived type. +

    + +
    +
    designator
    +

    n. + an object that denotes another object. + In the dictionary entry for an operator + if a parameter is described as a designator for a type, + the description of the operator is written in a way + that assumes that appropriate coercion to that type has already occurred; + that is, that the parameter is already of the denoted type. + For more detailed information, see Designators. +

    + +
    +
    destructive
    +

    adj. (of an operator) + capable of modifying some program-visible aspect of one or more + objects that are either explicit arguments to the + operator or that can be obtained directly or indirectly + from the global environment by the operator. +

    + +
    +
    destructuring lambda list
    +

    n. + an extended lambda list used in destructuring-bind and + nested within macro lambda lists. + See Destructuring Lambda Lists. +

    + +
    +
    different
    +

    adj. + not the same + “The strings "FOO" and "foo" are different under + equal but not under equalp.” +

    + +
    +
    digit
    +

    n. (in a radix) + a character that is among the possible digits (0 to 9, + A to Z, and a to z) and that is defined to have an + associated numeric weight as a digit in that radix. + See Digits in a Radix. +

    + +
    +
    dimension
    +

    n. + 1. a non-negative integer indicating the number of + objects an array can hold along one axis. + If the array is a vector with a fill pointer, + the fill pointer is ignored. + “The second dimension of that array is 7.” + 2. an axis of an array. + “This array has six dimensions.” +

    + +
    +
    direct instance
    +

    n. (of a class C) + an object whose class is C itself, + rather than some subclass of C. + “The function make-instance always returns a + direct instance of the class which is (or is named by) + its first argument.” +

    + +
    +
    direct subclass
    +

    n. (of a class C_1) + a class C_2, + such that C_1 is a direct superclass of C_2. +

    + +
    +
    direct superclass
    +

    n. (of a class C_1) + a class C_2 which was explicitly designated as + a superclass of C_1 in the definition of C_1. +

    + +
    +
    disestablish
    +

    v.t. + to withdraw the establishment of + an object, + a binding, + an exit point, + a tag, + a handler, + a restart, + or an environment. +

    + +
    +
    disjoint
    +

    n. (of types) + having no elements in common. +

    + +
    +
    dispatching macro character
    +

    n. + a macro character that has an associated table that specifies + the function to be called for each character that is + seen following the dispatching macro character. + See the function make-dispatch-macro-character. +

    + +
    +
    displaced array
    +

    n. + an array which has no storage of its own, but which is instead + indirected to the storage of another array, called its + target, at a specified offset, in such a way that any attempt + to access the displaced array implicitly references the + target array. +

    + +
    +
    distinct
    +

    adj. + not identical. +

    + +
    +
    documentation string
    +

    n. (in a defining form) + A literal string which because of the context in which + it appears (rather than because of some intrinsically observable + aspect of the string) is taken as documentation. + In some cases, the documentation string is saved in such a + way that it can later be obtained by supplying either an object, + or by supplying a name and a “kind” to the function documentation. + “The body of code in a defmacro form can be preceded + by a documentation string of kind function.” +

    + +
    +
    dot
    +

    n. + the standard character that is variously called + “full stop,” + “period,” + or “dot” (.). + See Figure~2–5. +

    + +
    +
    dotted list
    +

    n. + a list which has a terminating atom that is not nil. + (An atom by itself is not a dotted list, however.) +

    + +
    +
    dotted pair
    +

    n. + 1. a cons whose cdr is a non-list. + 2. any cons, used to emphasize the use of the cons + as a symmetric data pair. +

    + +
    +
    double float
    +

    n. + an object of type double-float. +

    + +
    +
    double-quote
    +

    n. + the standard character that is variously called + “quotation mark” + or “double quote” ("). + See Figure~2–5. +

    + +
    +
    dynamic binding
    +

    n. + a binding in a dynamic environment. +

    + +
    +
    dynamic environment
    +

    n. + that part of an environment that contains bindings + with dynamic extent. A dynamic environment contains, + among other things: + exit points established by unwind-protect, + and + bindings of + dynamic variables, + exit points established by catch, + condition handlers, + and + restarts. +

    + +
    +
    dynamic extent
    +

    n. + an extent whose duration is bounded by points of + establishment and disestablishment within the execution + of a particular form. See indefinite extent. + “Dynamic variable bindings have dynamic extent.” +

    + +
    +
    dynamic scope
    +

    n. + indefinite scope along with dynamic extent. +

    + +
    +
    dynamic variable
    +

    n. + a variable the binding for which is in the dynamic environment. + See special. +

    +
    +
    +

    E

    +
    +
    + +
    +
    echo stream
    +

    n. + a stream of type echo-stream. +

    + +
    +
    effective method
    +

    n. + the combination of applicable methods that are executed + when a generic function is invoked with a particular sequence + of arguments. +

    + +
    +
    element
    +

    n. + 1. (of a list) + an object that is the car of one of the conses + that comprise the list. + 2. (of an array) + an object that is stored in the array. + 3. (of a sequence) + an object that is an element of the list or array + that is the sequence. + 4. (of a type) + an object that is a member of the set of objects + designated by the type. + 5. (of an input stream) + a character or number (as appropriate to the + element type of the stream) + that is among the ordered series of objects that can be + read from the stream (using read-char or read-byte, + as appropriate to the stream). + 6. (of an output stream) + a character or number (as appropriate to the + element type of the stream) + that is among the ordered series of objects that has been + or will be written to the stream (using write-char + or write-byte, as appropriate to the stream). + 7. (of a class) a generalized instance of the class. +

    + +
    +
    element type
    +

    n. + 1. (of an array) the array element type of the array. + 2. (of a stream) the stream element type of the stream. +

    + +
    +
    em
    +

    n. Trad. + a context-dependent unit of measure commonly used in typesetting, + equal to the displayed width of of a letter “M” in the current font. + (The letter “M” is traditionally chosen because it is typically + represented by the widest glyph in the font, and other characters’ + widths are typically fractions of an em. In implementations providing + non-Roman characters with wider characters than “M,” it is permissible + for another character to be the implementation-defined reference character + for this measure, and for “M” to be only a fraction of an em + wide.) + In a fixed width font, a line with n characters is n + ems wide; in a variable width font, n ems is the + expected upper bound on the width of such a line. +

    + +
    +
    empty list
    +

    n. + the list containing no elements. See (). +

    + +
    +
    empty type
    +

    n. + the type that contains no elements, and that is + a subtype of all types (including itself). + See nil. +

    + +
    +
    end of file
    +

    n. + 1. the point in an input stream beyond which there is + no further data. + Whether or not there is such a point on an interactive stream + is implementation-defined. + 2. a situation that occurs upon an attempt to obtain data from an + input stream that is at the end of file_1. +

    + +
    +
    environment
    +

    n. + 1. a set of bindings. See Introduction to Environments. + 2. an environment object. + “macroexpand takes an optional environment argument.” +

    + +
    +
    environment object
    +

    n. + an object representing a set of lexical bindings, + used in the processing of a form to provide meanings for + names within that form. + “macroexpand takes an optional environment argument.” + (The object nil when used as an environment object + denotes the null lexical environment; + the values of environment parameters + to macro functions are objects + of implementation-dependent nature which represent the + environment_1 in which the corresponding macro form + is to be expanded.) + See Environment Objects. +

    + +
    +
    environment parameter
    +

    n. + A parameter in a defining form f for which there is no corresponding + argument; instead, this parameter receives as its value an + environment object which corresponds to the + lexical environment in which the defining form f appeared. +

    + +
    +
    error
    +

    n. + 1. (only in the phrase “is an error”) + a situation in which the semantics of a program are not specified, + and in which the consequences are undefined. + 2. a condition which represents an error situation. + See Error Terminology. + 3. an object of type error. +

    + +
    +
    error output
    +

    n. + the output stream which is the value of the dynamic variable + *error-output*. +

    + +
    +
    escape
    +

    n., adj. + 1. n. a single escape or a multiple escape. + 2. adj. single escape or multiple escape. +

    + +
    +
    establish
    +

    v.t. + to build or bring into being + a binding, + a declaration, + an exit point, + a tag, + a handler, + a restart, + or an environment. + “let establishes lexical bindings.” +

    + +
    +
    evaluate
    +

    v.t. (a form or an implicit progn) + to execute the code represented by the form + (or the series of forms making up the implicit progn) + by applying the rules of evaluation, + returning zero or more values. +

    + +
    +
    evaluation
    +

    n. + a model whereby forms are executed, returning zero or more values. + Such execution might be implemented directly in one step by an interpreter + or in two steps by first compiling the form and then + executing the compiled code; this choice is + dependent both on context and the nature of the implementation, + but in any case is not in general detectable by any program. The evaluation + model is designed in such a way that a conforming implementation + might legitimately have only a compiler and no interpreter, or vice versa. + See The Evaluation Model. +

    + +
    +
    evaluation environment
    +

    n. + a run-time environment in which macro expanders + and code specified by eval-when to be evaluated + are evaluated. All evaluations initiated by the compiler + take place in the evaluation environment. +

    + +
    +
    execute
    +

    v.t. Trad. (code) + to perform the imperative actions represented by the code. +

    + +
    +
    execution time
    +

    n. + the duration of time that compiled code is being executed. +

    + +
    +
    exhaustive partition
    +

    n. (of a type) + a set of pairwise disjoint types that form an + exhaustive union. +

    + +
    +
    exhaustive union
    +

    n. (of a type) + a set of subtypes of the type, + whose union contains all elements of that type. +

    + +
    +
    exit point
    +

    n. + a point in a control form + from which (e.g., block), + through which (e.g., unwind-protect), + or to which (e.g., tagbody) + control and possibly values can be transferred both actively by using + another control form and passively through the normal control and + data flow of evaluation. + “catch and block establish bindings for + exit points to which throw and return-from, + respectively, can transfer control and values; + tagbody establishes a binding for an exit point + with lexical extent to which go can transfer control; + and unwind-protect establishes an exit point + through which control might be transferred by + operators such as throw, return-from, + and go.” +

    + +
    +
    explicit return
    +

    n. + the act of transferring control (and possibly values) + to a block by using return-from (or return). +

    + +
    +
    explicit use
    +

    n. (of a variable V in a form F) + a reference to V that is directly apparent in the normal semantics of F; + i.e., that does not expose any undocumented details of the + macro expansion of the form itself. + References to V exposed by expanding subforms of F are, however, + considered to be explicit uses of V. +

    + +
    +
    exponent marker
    +

    n. + a character that is used in the textual notation for a float + to separate the mantissa from the exponent. + The characters defined as exponent markers in the standard readtable + are shown in Figure 26–1. + For more information, see Character Syntax. + “The exponent marker ‘d’ in ‘3.0d7’ indicates + that this number is to be represented as a double float.” +

    +
    +
      Marker  Meaning                                  
+  D or d  double-float                             
+  E or e  float (see *read-default-float-format*)  
+  F or f  single-float                             
+  L or l  long-float                               
+  S or s  short-float                              
+
+           Figure 26–1: Exponent Markers          
+
+
    + + +
    +
    export
    +

    v.t. (a symbol in a package) + to add the symbol to the list of external symbols of the + package. +

    + +
    +
    exported
    +

    adj. (of a symbol in a package) + being an external symbol of the package. +

    + +
    +
    expressed adjustability
    +

    n. (of an array) + a generalized boolean that is conceptually (but not necessarily actually) + associated with the array, representing whether the array + is expressly adjustable. + See also actual adjustability. +

    + +
    +
    expressed array element type
    +

    n. (of an array) + the type which is the array element type + implied by a type declaration for the array, + or which is the requested array element type at its time + of creation, prior to any selection of an upgraded array element type. + (Common Lisp does not provide a way of detecting this type + directly at run time, but an implementation is permitted + to make assumptions about the array’s contents and + the operations which may be performed on the array when + this type is noted during code analysis, even if those + assumptions would not be valid in general for the + upgraded array element type of the + expressed array element type.) +

    + +
    +
    expressed complex part type
    +

    n. (of a complex) + the type which is implied as the complex part type + by a type declaration for the complex, + or which is the requested complex part type at its time of + creation, prior to any selection of an upgraded complex part type. + (Common Lisp does not provide a way of detecting this type + directly at run time, but an implementation is permitted + to make assumptions about the operations which may be performed on + the complex when this type is noted during code + analysis, even if those assumptions would not be valid in general for + the upgraded complex part type of the + expressed complex part type.) +

    + +
    +
    expression
    +

    n. + 1. an object, often used to emphasize the use + of the object to encode or represent information in a specialized + format, such as program text. + “The second expression in a let form is a list + of bindings.” + 2. the textual notation used to notate an object in a source file. + “The expression 'sample is equivalent to (quote sample).” +

    + +
    +
    expressly adjustable
    +

    adj. (of an array) + being actually adjustable by virtue of an explicit request for this + characteristic having been made at the time of its creation. + All arrays that are expressly adjustable + are actually adjustable, + but not necessarily vice versa. +

    + +
    +
    extended character
    +

    n. + a character +

    +

    of type extended-char: +

    +

    a character that is not a base character. +

    + +
    +
    extended function designator
    +

    n. + a designator for a function; that is, + an object that denotes a function + and that is one of: + a function name (denoting the function it names + in the global environment), + or a function (denoting itself). + The consequences are undefined if + a function name is used as an + extended function designator but + it does not have a global definition as a function, + or if it is a symbol + that has a global definition as a macro or a special form. + See also function designator. +

    + +
    +
    extended lambda list
    +

    n. + a list resembling an ordinary lambda list in form and purpose, but + offering additional syntax or functionality not available in an + ordinary lambda list. + “defmacro uses extended lambda lists.” +

    + +
    +
    extension
    +

    n. + a facility in an implementation of Common Lisp + that is not specified by this standard. +

    + +
    +
    extent
    +

    n. + the interval of time during which a reference to + an object, + a binding, + an exit point, + a tag, + a handler, + a restart, + or an environment is defined. +

    + +
    +
    external file format
    +

    n. + an object of implementation-dependent nature which determines + one of possibly several implementation-dependent ways in which + characters are encoded externally in a character file. +

    + +
    +
    external file format designator
    +

    n. + a designator for an external file format; that is, + an object that denotes an external file format + and that is one of: + the symbol :default + (denoting an implementation-dependent default + external file format that can accomodate at least + the base characters), + some other object defined by the implementation to be + an external file format designator + (denoting an implementation-defined external file format), + or some other object defined by the implementation to be + an external file format + (denoting itself). +

    + +
    +
    external symbol
    +

    n. (of a package) + a symbol that is part of the ‘external interface’ to the package + and that are inherited_3 by any other package + that uses the package. + When using the Lisp reader, + if a package prefix is used, + the name of an external symbol is separated + from the package name by a single package marker + while + the name of an internal symbol is separated + from the package name by a double package marker; + see Symbols as Tokens. +

    + +
    +
    externalizable object
    +

    n. + an object that can be used as a literal object + in code to be processed by the file compiler. +

    +
    +
    +

    F

    +
    +
    + +
    +
    false
    +

    n. + the symbol nil, + used to represent the failure of a predicate test. +

    + +
    +
    fbound
    +

    pronounced ’ef ,baund adj. + (of a function name) + bound in the function namespace. + (The names of macros and special operators are fbound, + but the nature and type of the object which is their value + is implementation-dependent. +

    +

    Further, defining a setf expander F does not cause the setf function + (setf F) to become defined; as such, if there is a such a definition + of a setf expander F, the function (setf F) + can be fbound if and only if, by design or coincidence, a + function binding for (setf F) has been independently established.) +

    +

    See the functions fboundp and symbol-function. +

    + +
    +
    feature
    +

    n. + 1. an aspect or attribute + of Common Lisp, + of the implementation, + or of the environment. + 2. a symbol that names a feature_1. + See Features. + “The :ansi-cl feature is present in all conforming implementations.” +

    + +
    +
    feature expression
    +

    n. + A boolean combination of features used by the #+ and #- + reader macros in order to direct conditional reading of + expressions by the Lisp reader. + See Feature Expressions. +

    + +
    +
    features list
    +

    n. + the list that is the value of *features*. +

    + +
    +
    file
    +

    n. + a named entry in a file system, + having an implementation-defined nature. +

    + +
    +
    file compiler
    +

    n. + any compiler which compiles source code contained in a file, + producing a compiled file as output. The compile-file + function is the only interface to such a compiler provided by Common Lisp, + but there might be other, implementation-defined mechanisms for + invoking the file compiler. +

    + +
    +
    file position
    +

    n. (in a stream) + a non-negative integer that represents a position in the stream. + Not all streams are able to represent the notion of file position; + in the description of any operator which manipulates file positions, + the behavior for streams that don’t have this notion must be explicitly stated. + For binary streams, the file position represents the number + of preceding bytes in the stream. + For character streams, the constraint is more relaxed: + file positions must increase monotonically, the amount of the increase + between file positions corresponding to any two successive characters + in the stream is implementation-dependent. +

    + +
    +
    file position designator
    +

    n. (in a stream) + a designator for a file position in that stream; that is, + the symbol :start + (denoting 0, the first file position in that stream), + the symbol :end + (denoting the last file position in that stream; + i.e., the position following the last element of the stream), + or a file position (denoting itself). +

    + +
    +
    file stream
    +

    n. + an object of type file-stream. +

    + +
    +
    file system
    +

    n. + a facility which permits aggregations of data to be stored in named + files on some medium that is external to the Lisp image + and that therefore persists from session to session. +

    + +
    +
    filename
    +

    n. + a handle, not necessarily ever directly represented as an object, + that can be used to refer to a file in a file system. + Pathnames and namestrings are two kinds of objects + that substitute for filenames in Common Lisp. +

    + +
    +
    fill pointer
    +

    n. (of a vector) + an integer associated with a vector that represents the + index above which no elements are active. + (A fill pointer is a non-negative integer no + larger than the total number of elements in the vector. + Not all vectors have fill pointers.) +

    + +
    +
    finite
    +

    adj. (of a type) + having a finite number of elements. + “The type specifier (integer 0 5) denotes a finite type, + but the type specifiers integer and (integer 0) do not.” +

    + +
    +
    fixnum
    +

    n. + an integer of type fixnum. +

    + +
    +
    float
    +

    n. + an object of type float. +

    + +
    +
    for-value
    +

    adj. (of a reference to a binding) + being a reference that reads_1 + the value of the binding. +

    + +
    +
    form
    +

    n. + 1. any object meant to be evaluated. + 2. a symbol, + a compound form, + or a self-evaluating object. + 3. (for an operator, as in “<<operator>> form”) + a compound form having that operator as its first element. + “A quote form is a constant form.” +

    + +
    +
    formal argument
    +

    n. Trad. + a parameter. +

    + +
    +
    formal parameter
    +

    n. Trad. + a parameter. +

    + +
    +
    format
    +

    v.t. (a format control and format arguments) + to perform output as if by format, + using the format string and format arguments. +

    + +
    +
    format argument
    +

    n. + an object which is used as data by functions such as format + which interpret format controls. +

    + +
    +
    format control
    +

    n. + a format string, + or a function that obeys the argument conventions + for a function returned by the formatter macro. + See Compiling Format Strings. +

    + +
    +
    format directive
    +

    n. + 1. a sequence of characters in a format string + which is introduced by a tilde, and which is specially + interpreted by code which processes format strings + to mean that some special operation should be performed, possibly + involving data supplied by the format arguments that + accompanied the format string. See the function format. + “In "~D base 10 = ~8R", the character + sequences ‘~D’ and ‘~8R’ are format directives.” + 2. the conceptual category of all format directives_1 + which use the same dispatch character. + “Both "~3d" and "~3,'0D" are valid uses of the + ‘~D’ format directive.” +

    + +
    +
    format string
    +

    n. + a string which can contain both ordinary text and format directives, + and which is used in conjunction with format arguments to describe how + text output should be formatted by certain functions, such as format. +

    + +
    +
    free declaration
    +

    n. + a declaration that is not a bound declaration. + See declare. +

    + +
    +
    fresh
    +

    adj. + 1. (of an object yielded by a function) + having been newly-allocated by that function. + (The caller of a function that returns a fresh object + may freely modify the object without fear that such modification will + compromise the future correct behavior of that function.) + 2. (of a binding for a name) + newly-allocated; not shared with other bindings for that name. +

    + +
    +
    freshline
    +

    n. + a conceptual operation on a stream, implemented by the function fresh-line + and by the format directive ~&, which advances the display position + to the beginning of the next line (as if a newline had been typed, or + the function terpri had been called) + unless the stream is already known to be positioned at the beginning of a line. + Unlike newline, freshline is not a character. +

    + +
    +
    funbound
    +

    pronounced ’ef unbaund n. (of a function name) + not fbound. +

    + +
    +
    function
    +

    n. +

    +

    1. an object representing code, + which can be called with zero or more arguments, + and which produces zero or more values. + 2. an object of type function. +

    + +
    +
    function block name
    +

    n. (of a function name) + The symbol that would be used as the name of an implicit block + which surrounds the body of a function having that function name. + If the function name is a symbol, its function block name is + the function name itself. + If the function name is a list whose car is setf + and whose cadr is a symbol, its function block name is + the symbol that is the cadr of the function name. + An implementation which supports additional kinds of function names + must specify for each how the corresponding function block name is computed. +

    + +
    +
    function cell
    +

    n. Trad. (of a symbol) + The place which holds the definition of the + global function binding, if any, named by that symbol, + and which is accessed by symbol-function. + See cell. +

    + +
    +
    function designator
    +

    n. + a designator for a function; that is, + an object that denotes a function + and that is one of: + a symbol (denoting the function named by that symbol + in the global environment), + or a function (denoting itself). + The consequences are undefined if + a symbol is used as a function designator but + it does not have a global definition as a function, + or it has a global definition as a macro or a special form. + See also extended function designator. +

    + +
    +
    function form
    +

    n. + a form that is a list and that has a first element + which is the name of a function to be called on + arguments which are the result of evaluating subsequent + elements of the function form. +

    + +
    +
    function name
    +

    n. (in an environment) + A symbol or a list (setf symbol) + that is the name of a function in that environment. +

    + +
    +
    functional evaluation
    +

    n. + the process of extracting a functional value from a function name + or a lambda expression. + The evaluator performs functional evaluation + implicitly when it encounters a function name + or a lambda expression + in the car of a compound form, + or explicitly when it encounters a function special form. + Neither a use of a symbol as a function designator nor a + use of the function symbol-function to extract the functional value + of a symbol is considered a functional evaluation. +

    + +
    +
    functional value
    +

    n. + 1. (of a function name N in an environment E) + The value of the binding named N + in the function namespace for environment E; + that is, the contents of the function cell named N in + environment E. + 2. (of an fbound symbol S) + the contents of the symbol’s function cell; that is, + the value of the binding named S + in the function namespace of the global environment. + (A name that is a macro name in the global environment + or is a special operator might or might not be fbound. + But if S is such a name and is fbound, the specific + nature of its functional value is implementation-dependent; + in particular, it might or might not be a function.) +

    + +
    +
    further compilation
    +

    n. + implementation-dependent compilation beyond minimal compilation. + Further compilation is permitted to take place at run time. + “Block compilation and generation of machine-specific instructions + are examples of further compilation.” +

    +
    +
    +

    G

    +
    +
    + +
    +
    general
    +

    adj. (of an array) + having element type t, + and consequently able to have any object as an element. +

    + +
    +
    generalized boolean
    +

    n. + an object used as a truth value, where the symbol~nil + represents false and all other objects represent true. + See boolean. +

    + +
    +
    generalized instance
    +

    n. (of a class) + an object the class of which is either that class itself, + or some subclass of that class. (Because of the correspondence between + types and classes, the term “generalized instance of X” + implies “object of type X” and in cases where X is a class + (or class name) the reverse is also true. + The former terminology emphasizes the view of X as a class + while the latter emphasizes the view of X as a type specifier.) +

    + +
    +
    generalized reference
    +

    n. + a reference to a location storing an object as if to a variable. + (Such a reference can be either to read or write the location.) + See Generalized Reference. See also place. +

    + +
    +
    generalized synonym stream
    +

    n. (with a synonym stream symbol) + 1. (to a stream) + a synonym stream to the stream, + or a composite stream which has as a target + a generalized synonym stream to the stream. + 2. (to a symbol) + a synonym stream to the symbol, + or a composite stream which has as a target + a generalized synonym stream to the symbol. +

    + +
    +
    generic function
    +

    n. + a function whose behavior depends on the classes or + identities of the arguments supplied to it and whose parts include, among + other things, a set of methods, a lambda list, and a + method combination type. +

    + +
    +
    generic function lambda list
    +

    n. + A lambda list that is used to describe data flow into a generic function. + See Generic Function Lambda Lists. +

    + +
    +
    gensym
    +

    n. Trad. + an uninterned symbol. + See the function gensym. +

    + +
    +
    global declaration
    +

    n. + a form that makes certain kinds of information about + code globally available; that is, a proclaim form + or a declaim form. +

    + +
    +
    global environment
    +

    n. + that part of an environment that contains bindings + with indefinite scope and indefinite extent. +

    + +
    +
    global variable
    +

    n. + a dynamic variable or a constant variable. +

    + +
    +
    glyph
    +

    n. + a visual representation. + “Graphic characters have associated glyphs.” +

    + +
    +
    go
    +

    v. + to transfer control to a go point. + See the special operator go. +

    + +
    +
    go point
    +
    +

    one of possibly several exit points that are established + by tagbody (or other abstractions, such as prog, + which are built from tagbody). +

    + +
    +
    go tag
    +

    n. + the symbol or integer that, within the lexical scope + of a tagbody form, names an exit point + established by that tagbody form. +

    + +
    +
    graphic
    +

    adj. (of a character) + being a “printing” or “displayable” character + that has a standard visual representation + as a single glyph, such as A or * or =. + Space is defined to be graphic. + Of the standard characters, all but newline are graphic. + See non-graphic. +

    +
    +
    +

    H

    +
    +
    + +
    +
    handle
    +

    v. (of a condition being signaled) + to perform a non-local transfer of control, terminating the ongoing + signaling of the condition. +

    + +
    +
    handler
    +

    n. +

    +

    a condition handler. +

    + +
    +
    hash table
    +

    n. + an object of type hash-table, + which provides a mapping from keys to values. +

    + +
    +
    home package
    +

    n. (of a symbol) + the package, if any, which is contents of the package cell + of the symbol, and which dictates how the Lisp printer + prints the symbol when it is not accessible in the + current package. (Symbols which have nil in their + package cell are said to have no home package, and also + to be apparently uninterned.) +

    +
    +
    +

    I

    +
    +
    + +
    +
    I/O customization variable
    +

    n. + one of the stream variables in Figure 26–2, + or some other (implementation-defined) stream variable + that is defined by the implementation + to be an I/O customization variable. +

    +
    +
      *debug-io*        *error-io*         query-io*       
+  *standard-input*  *standard-output*  *trace-output*  
+
+  Figure 26–2: Standardized I/O Customization Variables
+
+
    + + +
    +
    identical
    +

    adj. + the same under eq. +

    + +
    +
    identifier
    +

    n. + 1. a symbol used to identify or to distinguish names. + 2. a string used the same way. +

    + +
    +
    immutable
    +

    adj. + not subject to change, either because no operator is provided which is + capable of effecting such change or because some constraint exists which + prohibits the use of an operator that might otherwise be capable of + effecting such a change. Except as explicitly indicated otherwise, + implementations are not required to detect attempts to modify + immutable objects or cells; the consequences of attempting + to make such modification are undefined. + “Numbers are immutable.” +

    + +
    +
    implementation
    +

    n. + a system, mechanism, or body of code that implements the semantics of Common Lisp. +

    + +
    +
    implementation limit
    +

    n. + a restriction imposed by an implementation. +

    + +
    +
    implementation-defined
    +

    adj. + implementation-dependent, but required by this specification to be + defined by each conforming implementation and to be documented by + the corresponding implementor. +

    + +
    +
    implementation-dependent
    +

    adj. + describing a behavior or aspect of Common Lisp which has been deliberately left + unspecified, that might be defined in some conforming implementations + but not in others, and whose details may differ between implementations. + A conforming implementation is encouraged (but not required) to + document its treatment of each item in this specification which is + marked implementation-dependent, although in some cases + such documentation might simply identify the item as “undefined.” +

    + +
    +
    implementation-independent
    +

    adj. + used to identify or emphasize a behavior or aspect of Common Lisp which does + not vary between conforming implementations. +

    + +
    +
    implicit block
    +

    n. + a block introduced by a macro form + rather than by an explicit block form. +

    + +
    +
    implicit compilation
    +

    n. + compilation performed during evaluation. +

    + +
    +
    implicit progn
    +

    n. + an ordered set of adjacent forms appearing in another + form, and defined by their context in that form + to be executed as if within a progn. +

    + +
    +
    implicit tagbody
    +

    n. + an ordered set of adjacent forms and/or tags + appearing in another form, and defined by their context + in that form to be executed as if within a tagbody. +

    + +
    +
    import
    +

    v.t. (a symbol into a package) + to make the symbol be present in the package. +

    + +
    +
    improper list
    +

    n. + a list which is not a proper list: + a circular list or a dotted list. +

    + +
    +
    inaccessible
    +

    adj. + not accessible. +

    + +
    +
    indefinite extent
    +

    n. + an extent whose duration is unlimited. + “Most Common Lisp objects have indefinite extent.” +

    + +
    +
    indefinite scope
    +

    n. + scope that is unlimited. +

    + +
    +
    indicator
    +

    n. + a property indicator. +

    + +
    +
    indirect instance
    +

    n. (of a class C_1) + an object of class C_2, + where C_2 is a subclass of C_1. + “An integer is an indirect instance of the class number.” +

    + +
    +
    inherit
    +

    v.t. + 1. to receive or acquire a quality, trait, or characteristic; + to gain access to a feature defined elsewhere. + 2. (a class) to acquire the structure and behavior defined + by a superclass. + 3. (a package) to make symbols exported by another + package accessible by using use-package. +

    + +
    +
    initial pprint dispatch table
    +

    n. + the value of *print-pprint-dispatch* at the time the Lisp image is started. +

    + +
    +
    initial readtable
    +

    n. + the value of *readtable* at the time the Lisp image is started. +

    + +
    +
    initialization argument list
    +

    n. + a property list of initialization argument names and values + used in the protocol for initializing and reinitializing instances of classes. + See Object Creation and Initialization. +

    + +
    +
    initialization form
    +

    n. + a form used to supply the initial value for a slot + or variable. + “The initialization form for a slot in a defclass form + is introduced by the keyword :initform.” +

    + +
    +
    input
    +

    adj. (of a stream) + supporting input operations (i.e., being a “data source”). + An input stream might also be an output stream, + in which case it is sometimes called a bidirectional stream. + See the function input-stream-p. +

    + +
    +
    instance
    +

    n. + 1. a direct instance. + 2. a generalized instance. + 3. an indirect instance. +

    + +
    +
    integer
    +

    n. + an object of type integer, which represents a mathematical integer. +

    + +
    +
    interactive stream
    +

    n. + a stream on which it makes sense to perform interactive querying. + See Interactive Streams. +

    + +
    +
    intern
    +

    v.t. + 1. (a string in a package) + to look up the string in the package, + returning either a symbol with that name + which was already accessible in the package + or a newly created internal symbol of the package + with that name. + 2. Idiom. generally, to observe a protocol whereby objects which + are equivalent or have equivalent names under some predicate defined + by the protocol are mapped to a single canonical object. +

    + +
    +
    internal symbol
    +

    n. (of a package) + a symbol which is accessible in the package, + but which is not an external symbol of the package. +

    + +
    +
    internal time
    +

    n. + time, represented as an integer number of internal time units. + Absolute internal time is measured as an offset + from an arbitrarily chosen, implementation-dependent base. + See Internal Time. +

    + +
    +
    internal time unit
    +

    n. + a unit of time equal to 1/n of a second, + for some implementation-defined integer value of n. + See the variable internal-time-units-per-second. +

    + +
    +
    interned
    +

    adj. Trad. + 1. (of a symbol) accessible_3 in + any package. + 2. (of a symbol in a specific package) + present in that package. +

    + +
    +
    interpreted function
    +

    n. + a function that is not a compiled function. + (It is possible for there to be a conforming implementation which + has no interpreted functions, but a conforming program + must not assume that all functions are compiled functions.) +

    + +
    +
    interpreted implementation
    +

    n. + an implementation that uses an execution strategy for + interpreted functions that does not involve a one-time semantic + analysis pre-pass, and instead uses “lazy” (and sometimes repetitious) + semantic analysis of forms as they are encountered during execution. +

    + +
    +
    interval designator
    +

    n. (of type T) + an ordered pair of objects that describe a subtype of T + by delimiting an interval on the real number line. + See Interval Designators. +

    + +
    +
    invalid
    +

    n., adj. + 1. n. + a possible constituent trait of a character + which if present signifies that the character + cannot ever appear in a token + except under the control of a single escape character. + For details, see Constituent Characters. + 2. adj. (of a character) + being a character that has syntax type constituent + in the current readtable and that has the + constituent trait invalid_1. + See Figure~2–8. +

    + +
    +
    iteration form
    +

    n. + a compound form whose operator is named in Figure 26–3, + or a compound form that has an implementation-defined operator + and that is defined by the implementation to be an iteration form. +

    +
    +
      do              do-external-symbols  dotimes  
+  do*             do-symbols           loop     
+  do-all-symbols  dolist                        
+
+    Figure 26–3: Standardized Iteration Forms  
+
+
    + + +
    +
    iteration variable
    +

    n. + a variable V, the binding for which was created by an + explicit use of V in an iteration form. +

    +
    +
    +

    K

    +
    +
    + +
    +
    key
    +

    n. + an object used for selection during retrieval. + See association list, property list, and hash table. + Also, see Sequence Concepts. +

    + +
    +
    keyword
    +

    n. + 1. a symbol the home package of which is the KEYWORD package. + 2. any symbol, usually but not necessarily in the KEYWORD package, + that is used as an identifying marker in keyword-style argument passing. + See lambda. + 3. Idiom. a lambda list keyword. +

    + +
    +
    keyword parameter
    +

    n. + A parameter for which a corresponding keyword argument + is optional. (There is no such thing as a required keyword argument.) + If the argument is not supplied, a default value is used. + See also supplied-p parameter. +

    + +
    +
    keyword/value pair
    +

    n. + two successive elements (a keyword and a value, + respectively) of a property list. +

    +
    +
    +

    L

    +
    +
    + +
    +
    lambda combination
    +

    n. Trad. + a lambda form. +

    + +
    +
    lambda expression
    +

    n. + a list which can be used in place of a function name in + certain contexts to denote a function by directly describing its + behavior rather than indirectly by referring to the name of an + established function; its name derives from the fact that its + first element is the symbol lambda. + See lambda. +

    + +
    +
    lambda form
    +

    n. + a form that is a list and that has a first element + which is a lambda expression representing a function + to be called on arguments which are the result of evaluating + subsequent elements of the lambda form. +

    + +
    +
    lambda list
    +

    n. + a list that specifies a set of parameters + (sometimes called lambda variables) + and a protocol for receiving values for those parameters; + that is, + an ordinary lambda list, + an extended lambda list, + or a modified lambda list. +

    + +
    +
    lambda list keyword
    +

    n. + a symbol whose name begins with ampersand + and that is specially recognized in a lambda list. + Note that no standardized lambda list keyword + is in the KEYWORD package. +

    + +
    +
    lambda variable
    +

    n. + a formal parameter, used to emphasize the variable’s + relation to the lambda list that established it. +

    + +
    +
    leaf
    +

    n. + 1. an atom in a tree_1. + 2. a terminal node of a tree_2. +

    + +
    +
    leap seconds
    +

    n. + additional one-second intervals of time that are occasionally inserted + into the true calendar by official timekeepers as a correction similar + to “leap years.” All Common Lisp time representations ignore + leap seconds; every day is assumed to be exactly 86400 seconds + long. +

    + +
    +
    left-parenthesis
    +

    n. + the standard character “(”, + that is variously called + “left parenthesis” + or “open parenthesis” + See Figure~2–5. +

    + +
    +
    length
    +

    n. (of a sequence) + the number of elements in the sequence. + (Note that if the sequence is a vector with a + fill pointer, its length is the same as the + fill pointer even though the total allocated size of + the vector might be larger.) +

    + +
    +
    lexical binding
    +

    n. + a binding in a lexical environment. +

    + +
    +
    lexical closure
    +

    n. + a function that, when invoked on arguments, executes + the body of a lambda expression in the lexical environment + that was captured at the time of the creation of the lexical closure, + augmented by bindings of the function’s parameters + to the corresponding arguments. +

    + +
    +
    lexical environment
    +

    n. + that part of the environment that contains bindings + whose names have lexical scope. A lexical environment + contains, among other things: + ordinary bindings of variable names to values, + lexically established bindings of function names + to functions, + macros, + symbol macros, + blocks, + tags, + and + local declarations (see declare). +

    + +
    +
    lexical scope
    +

    n. + scope that is limited to a spatial or textual region within the + establishing form. + “The names of parameters to a function normally are lexically scoped.” +

    + +
    +
    lexical variable
    +

    n. + a variable the binding for which is in the + lexical environment. +

    + +
    +
    Lisp image
    +

    n. + a running instantiation of a Common Lisp implementation. + A Lisp image is characterized by a single address space in which any + object can directly refer to any another in conformance with this specification, + and by a single, common, global environment. + (External operating systems sometimes call this a + “core image,” + “fork,” + “incarnation,” + “job,” + or “process.” Note however, that the issue of a “process” in such + an operating system is technically orthogonal to the issue of a Lisp image + being defined here. Depending on the operating system, a single “process” + might have multiple Lisp images, and multiple “processes” might reside + in a single Lisp image. Hence, it is the idea of a fully shared address + space for direct reference among all objects which is the defining + characteristic. Note, too, that two “processes” which have a communication + area that permits the sharing of some but not all objects are considered + to be distinct Lisp images.) +

    + +
    +
    Lisp printer
    +

    n. Trad. + the procedure that prints the character representation of an + object onto a stream. (This procedure is implemented + by the function write.) +

    + +
    +
    Lisp read-eval-print loop
    +

    n. Trad. + an endless loop that reads_2 a form, + evaluates it, + and prints (i.e., writes_2) the results. + In many implementations, + the default mode of interaction with Common Lisp during program development + is through such a loop. +

    + +
    +
    Lisp reader
    +

    n. Trad. + the procedure that parses character representations of objects + from a stream, producing objects. + (This procedure is implemented by the function read.) +

    + +
    +
    list
    +

    n. + 1. a chain of conses in which the car of each + cons is an element of the list, + and the cdr of each cons is either the next + link in the chain or a terminating atom. + See also proper list, + dotted list, + or circular list. + 2. the type that is the union of null and cons. +

    + +
    +
    list designator
    +

    n. + a designator for a list of objects; that is, + an object that denotes a list + and that is one of: + a non-nil atom + (denoting a singleton list + whose element is that non-nil atom) + or a proper list (denoting itself). +

    + +
    +
    list structure
    +

    n. (of a list) + the set of conses that make up the list. + Note that while the car_{1b} component of each such cons + is part of the list structure, + the objects that are elements of the list + (i.e., the objects that are the cars_2 of each cons + in the list) + are not themselves part of its list structure, + even if they are conses, + except in the (circular_2) + case where the list + actually contains one of its tails as an element. + (The list structure of a list is sometimes redundantly + referred to as its “top-level list structure” in order to emphasize + that any conses that are elements of the list + are not involved.) +

    + +
    +
    literal
    +

    adj. (of an object) + referenced directly in a program rather than being computed by the program; + that is, + appearing as data in a quote form, + or, if the object is a self-evaluating object, + appearing as unquoted data. + “In the form (cons "one" '("two")), + the expressions "one", ("two"), and "two" + are literal objects.” +

    + +
    +
    load
    +

    v.t. (a file) + to cause the code contained in the file to be executed. + See the function load. +

    + +
    +
    load time
    +

    n. + the duration of time that the loader is loading compiled code. +

    + +
    +
    load time value
    +

    n. + an object referred to in code by a load-time-value + form. The value of such a form is some specific + object which can only be computed in the run-time environment. + In the case of file compilation, the value is + computed once as part of the process of loading the compiled file, + and not again. See the special operator load-time-value. +

    + +
    +
    loader
    +

    n. + a facility that is part of Lisp and that loads a file. + See the function load. +

    + +
    +
    local declaration
    +

    n. + an expression which may appear only in specially designated + positions of certain forms, and which provides information about + the code contained within the containing form; + that is, a declare expression. +

    + +
    +
    local precedence order
    +

    n. (of a class) + a list consisting of the class followed by its + direct superclasses in the order mentioned in the defining + form for the class. +

    + +
    +
    local slot
    +

    n. (of a class) + a slot accessible in only one instance, + namely the instance in which the slot is allocated. +

    + +
    +
    logical block
    +

    n. + a conceptual grouping of related output used by the pretty printer. + See the macro pprint-logical-block and Dynamic Control of the Arrangement of Output. +

    + +
    +
    logical host
    +

    n. + an object of implementation-dependent nature + that is used as the representation of a “host” in a logical pathname, + and that has an associated set of translation rules for converting + logical pathnames belonging to that host into physical pathnames. + See Logical Pathnames. +

    + +
    +
    logical host designator
    +

    n. + a designator for a logical host; that is, + an object that denotes a logical host + and that is one of: + a string (denoting the logical host that it names), + or a logical host (denoting itself). + (Note that because the representation of a logical host + is implementation-dependent, + it is possible that an implementation might represent + a logical host as the string that names it.) +

    + +
    +
    logical pathname
    +

    n. + an object of type logical-pathname. +

    + +
    +
    long float
    +

    n. + an object of type long-float. +

    + +
    +
    loop keyword
    +

    n. Trad. + a symbol that is a specially recognized part of the syntax of + an extended loop form. Such symbols are recognized by their + name (using string=), not by their identity; as such, they + may be in any package. A loop keyword is not a keyword. +

    + +
    +
    lowercase
    +

    adj. (of a character) + being among standard characters corresponding to + the small letters a through z, + or being some other implementation-defined character + that is defined by the implementation to be lowercase. + See Characters With Case. +

    +
    +
    +

    M

    +
    +
    + +
    +
    macro
    +

    n. + 1. a macro form + 2. a macro function. + 3. a macro name. +

    + +
    +
    macro character
    +

    n. + a character which, when encountered by the Lisp reader + in its main dispatch loop, introduces a reader macro_1. + (Macro characters have nothing to do with macros.) +

    + +
    +
    macro expansion
    +

    n. + 1. the process of translating a macro form into another + form. + 2. the form resulting from this process. +

    + +
    +
    macro form
    +

    n. + a form that stands for another form + (e.g., for the purposes of abstraction, information hiding, + or syntactic convenience); + that is, + either a compound form whose first element is a macro name, + or a form that is a symbol that names a + symbol macro. +

    + +
    +
    macro function
    +

    n. + a function of two arguments, a form and an + environment, that implements macro expansion by + producing a form to be evaluated in place of the original + argument form. +

    + +
    +
    macro lambda list
    +

    n. + an extended lambda list used in forms that establish + macro definitions, such as defmacro and macrolet. + See Macro Lambda Lists. +

    + +
    +
    macro name
    +

    n. + a name for which macro-function returns true + and which when used as the first element of a compound form + identifies that form as a macro form. +

    + +
    +
    macroexpand hook
    +

    n. + the function that is the value of *macroexpand-hook*. +

    + +
    +
    mapping
    +

    n. + 1. a type of iteration in which a function is successively + applied to objects taken from corresponding entries in + collections such as sequences or hash tables. + 2. Math. a relation between two sets in which each element of the + first set (the “domain”) is assigned one element of the second + set (the “range”). +

    + +
    +
    metaclass
    +

    n. + 1. a class whose instances are classes. + 2. (of an object) the class of the class of the object. +

    + +
    +
    Metaobject Protocol
    +

    n. + one of many possible descriptions of how a conforming implementation + might implement various aspects of the object system. This description is beyond + the scope of this document, and no conforming implementation is + required to adhere to it except as noted explicitly in this specification. + Nevertheless, its existence helps to establish normative practice, + and implementors with no reason to diverge from it are encouraged to + consider making their implementation adhere to it where possible. + It is described in detail in The Art of the Metaobject Protocol. +

    + +
    +
    method
    +

    n. + an object that is part of a generic function and which + provides information about how that generic function should + behave when its arguments are objects of certain + classes or with certain identities. +

    + +
    +
    method combination
    +

    n. + 1. generally, the composition of a set of methods to produce an + effective method for a generic function. + 2. an object of type method-combination, which represents the details + of how the method combination_1 for one or more + specific generic functions is to be performed. +

    + +
    +
    method-defining form
    +

    n. + a form that defines a method for a generic function, + whether explicitly or implicitly. + See Introduction to Generic Functions. +

    + +
    +
    method-defining operator
    +

    n. + an operator corresponding to a method-defining form. + See Figure~7–1. +

    + +
    +
    minimal compilation
    +

    n. + actions the compiler must take at compile time. + See Compilation Semantics. +

    + +
    +
    modified lambda list
    +

    n. + a list resembling an ordinary lambda list in form and purpose, + but which deviates in syntax or functionality from the definition of an + ordinary lambda list. + See ordinary lambda list. + “deftype uses a modified lambda list.” +

    + +
    +
    most recent
    +

    adj. + innermost; + that is, having been established (and not yet disestablished) + more recently than any other of its kind. +

    + +
    +
    multiple escape
    +

    n., adj. + 1. n. the syntax type of a character + that is used in pairs to indicate that the enclosed characters + are to be treated as alphabetic_2 characters + with their case preserved. + For details, see Multiple Escape Characters. + 2. adj. (of a character) + having the multiple escape syntax type. + 3. n. a multiple escape_2 character. + (In the standard readtable, + vertical-bar is a multiple escape character.) +

    + +
    +
    multiple values
    +

    n. + 1. more than one value. + “The function truncate returns multiple values.” + 2. a variable number of values, possibly including zero or one. + “The function values returns multiple values.” + 3. a fixed number of values other than one. + “The macro multiple-value-bind is among the few + operators in Common Lisp which can detect and manipulate + multiple values.” +

    +
    +
    +

    N

    +
    +
    + +
    +
    name
    +

    n., v.t. + 1. n. an identifier by which an object, + a binding, or an exit point + is referred to by association using a binding. + 2. v.t. to give a name to. + 3. n. (of an object having a name component) + the object which is that component. + “The string which is a symbol’s name is returned + by symbol-name.” + 4. n. (of a pathname) + a. the name component, returned by pathname-name. + b. the entire namestring, returned by namestring. + 5. n. (of a character) + a string that names the character + and that has length greater than one. + (All non-graphic characters are required to have names + unless they have some implementation-defined attribute + which is not null. Whether or not other characters + have names is implementation-dependent.) +

    + +
    +
    named constant
    +

    n. + a variable that is defined by Common Lisp, + by the implementation, + or by user code (see the macro defconstant) + to always yield the same value when evaluated. + “The value of a named constant may not be changed + by assignment or by binding.” +

    + +
    +
    namespace
    +

    n. + 1. bindings whose denotations are restricted to a particular kind. + “The bindings of names to tags is the tag namespace.” + 2. any mapping whose domain is a set of names. + “A package defines a namespace.” +

    + +
    +
    namestring
    +

    n. + a string that represents a filename + using either the standardized notation for naming logical pathnames + described in Syntax of Logical Pathname Namestrings, + or some implementation-defined notation for naming a physical pathname. +

    + +
    +
    newline
    +

    n. + the standard character <Newline>, + notated for the Lisp reader as #\Newline. +

    + +
    +
    next method
    +

    n. + the next method to be invoked with respect to a given + method for a particular set of arguments or argument + classes. + See Applying method combination to the sorted list of applicable methods. +

    + +
    +
    nickname
    +

    n. (of a package) + one of possibly several names that can be used to refer to + the package but that is not the primary name + of the package. +

    + +
    +
    nil
    +

    n. + the object that is at once + the symbol named "NIL" in the COMMON-LISP package, + the empty list, + the boolean (or generalized boolean) representing false, + and the name of the empty type. +

    + +
    +
    non-atomic
    +

    adj. + being other than an atom; i.e., being a cons. +

    + +
    +
    non-constant variable
    +

    n. + a variable that is not a constant variable. +

    + +
    +
    non-correctable
    +

    adj. (of an error) + not intentionally correctable. + (Because of the dynamic nature of restarts, + it is neither possible nor generally useful to completely prohibit + an error from being correctable. + This term is used in order to express an intent that no special effort + should be made by code signaling an error to make + that error correctable; + however, there is no actual requirement on conforming programs + or conforming implementations imposed by this term.) +

    + +
    +
    non-empty
    +

    adj. + having at least one element. +

    + +
    +
    non-generic function
    +

    n. + a function that is not a generic function. +

    + +
    +
    non-graphic
    +

    adj. (of a character) + not graphic. + See Graphic Characters. +

    + +
    +
    non-list
    +

    n., adj. + other than a list; i.e., a non-nil atom. +

    + +
    +
    non-local exit
    +

    n. + a transfer of control (and sometimes values) to + an exit point for reasons other than a normal return. + “The operators go, throw, + and return-from cause a non-local exit.” +

    + +
    +
    non-nil
    +

    n., adj. + not nil. Technically, any object which is not nil can be + referred to as true, but that would tend to imply a unique view + of the object as a generalized boolean. + Referring to such an object as non-nil avoids this implication. +

    + +
    +
    non-null lexical environment
    +

    n. + a lexical environment that has additional information not present in + the global environment, such as one or more bindings. +

    + +
    +
    non-simple
    +

    adj. + not simple. +

    + +
    +
    non-terminating
    +

    adj. (of a macro character) + being such that it is treated as a constituent character + when it appears in the middle of an extended token. + See Reader Algorithm. +

    + +
    +
    non-top-level form
    +

    n. + a form that, by virtue of its position as a subform + of another form, is not a top level form. + See Processing of Top Level Forms. +

    + +
    +
    normal return
    +

    n. + the natural transfer of control and values which occurs after + the complete execution of a form. +

    + +
    +
    normalized
    +

    adj., ANSI, IEEE (of a float) + conforming to the description of “normalized” as described by IEEE Standard for Binary Floating-Point Arithmetic. + See denormalized. +

    + +
    +
    null
    +

    adj., n. + 1. adj. + a. (of a list) having no elements: empty. See empty list. + b. (of a string) having a length of zero. + (It is common, both within this document and in observed spoken behavior, + to refer to an empty string by an apparent definite reference, + as in “the null string” even though no attempt is made to + intern_2 null strings. The phrase + “a null string” is technically more correct, + but is generally considered awkward by most Lisp programmers. + As such, the phrase “the null string” + should be treated as an indefinite reference in all cases + except for anaphoric references.) + c. (of an implementation-defined attribute of a character) + An object to which the value of that attribute defaults + if no specific value was requested. + 2. n. an object of type null (the only such object being nil). +

    + +
    +
    null lexical environment
    +

    n. + the lexical environment which has no bindings. +

    + +
    +
    number
    +

    n. + an object of type number. +

    + +
    +
    numeric
    +

    adj. (of a character) + being one of the standard characters 0 through 9, + or being some other graphic character + defined by the implementation to be numeric. +

    +
    +
    +

    O

    +
    +
    + +
    +
    object
    +

    n. + 1. any Lisp datum. + “The function cons creates an object which refers + to two other objects.” + 2. (immediately following the name of a type) + an object which is of that type, used to emphasize that the + object is not just a name for an object of that type + but really an element of the type in cases where objects + of that type (such as function or class) are commonly + referred to by name. + “The function symbol-function takes a function name + and returns a function object.” +

    + +
    +
    object-traversing
    +

    adj. + operating in succession on components of an object. + “The operators mapcar, maphash, + with-package-iterator and count + perform object-traversing operations.” +

    + +
    +
    open
    +

    adj., v.t. (a file) + 1. v.t. to create and return a stream to the file. + 2. adj. (of a stream) + having been opened_1, but not yet closed. +

    + +
    +
    operator
    +

    n. + 1. a function, macro, or special operator. + 2. a symbol that names + such a function, macro, or special operator. + 3. (in a function special form) + the cadr of the function special form, which + might be either an operator_2 or a lambda expression. + 4. (of a compound form) + the car of the compound form, which might be + either an operator_2 + or a lambda expression, and which is never (setf symbol). +

    + +
    +
    optimize quality
    +

    n. + one of several aspects of a program that might be optimizable by + certain compilers. Since optimizing one such quality + might conflict with optimizing another, relative priorities for + qualities can be established in an optimize declaration. + The standardized optimize qualities are + compilation-speed (speed of the compilation process), +

    +

    debug (ease of debugging), +

    +

    safety (run-time error checking), + space (both code size and run-time space), + and + speed (of the object code). + Implementations may define additional optimize qualities. +

    + +
    +
    optional parameter
    +

    n. + A parameter for which a corresponding positional argument + is optional. If the argument is not supplied, a default value + is used. See also supplied-p parameter. +

    + +
    +
    ordinary function
    +

    n. + a function that is not a generic function. +

    + +
    +
    ordinary lambda list
    +

    n. + the kind of lambda list used by lambda. + See modified lambda list and extended lambda list. + “defun uses an ordinary lambda list.” +

    + +
    +
    otherwise inaccessible part
    +

    n. (of an object, O_1) + an object, O_2, which would be made inaccessible if + O_1 were made inaccessible. (Every object is an + otherwise inaccessible part of itself.) +

    + +
    +
    output
    +

    adj. (of a stream) + supporting output operations (i.e., being a “data sink”). + An output stream might also be an input stream, + in which case it is sometimes called a bidirectional stream. + See the function output-stream-p. +

    +
    +
    +

    P

    +
    +
    + +
    +
    package
    +

    n. + an object of type package. +

    + +
    +
    package cell
    +

    n. Trad. (of a symbol) + The place in a symbol that holds one of + possibly several packages in which the symbol is + interned, called the home package, or which holds + nil if no such package exists or is known. + See the function symbol-package. +

    + +
    +
    package designator
    +

    n. + a designator for a package; that is, + an object that denotes a package + and that is one of: + a string designator + (denoting the package that has the string + that it designates as its name + or as one of its nicknames), + or a package (denoting itself). +

    + +
    +
    package marker
    +

    n. + a character which is used in the textual notation for a symbol + to separate the package name from the symbol name, and which + is colon in the standard readtable. + See Character Syntax. +

    + +
    +
    package prefix
    +

    n. + a notation preceding the name of a symbol in text that is + processed by the Lisp reader, which uses a package name + followed by one or more package markers, and which indicates that + the symbol is looked up in the indicated package. +

    + +
    +
    package registry
    +

    n. + A mapping of names to package objects. + It is possible for there to be a package object which is not + in this mapping; such a package is called an unregistered package. + Operators such as find-package consult this mapping in order + to find a package from its name. + Operators such as do-all-symbols, find-all-symbols, + and list-all-packages operate only on packages that exist + in the package registry. +

    + +
    +
    pairwise
    +

    adv. (of an adjective on a set) + applying individually to all possible pairings of elements of the set. + “The types A, B, and C are pairwise disjoint if + A and B are disjoint, + B and C are disjoint, and + A and C are disjoint.” +

    + +
    +
    parallel
    +

    adj. Trad. (of binding or assignment) + done in the style of psetq, let, or do; + that is, first evaluating all of the forms that produce values, + and only then assigning or binding the variables (or places). + Note that this does not imply traditional computational “parallelism” + since the forms that produce values are evaluated sequentially. + See sequential. +

    + +
    +
    parameter
    +

    n. + 1. (of a function) + a variable in the definition of a function + which takes on the value of a corresponding argument + (or of a list of corresponding arguments) + to that function when it is called, + or + which in some cases is given a default value because there + is no corresponding argument. + 2. (of a format directive) + an object received as data flow by a format directive + due to a prefix notation within the format string at the + format directive’s point of use. + See Formatted Output. + “In "~3,'0D", the number 3 and the character + #\0 are parameters to the ~D format directive.” +

    + +
    +
    parameter specializer
    +

    n. + 1. (of a method) an expression which constrains the + method to be applicable only to argument sequences + in which the corresponding argument matches the + parameter specializer. + 2. a class, + or a list (eql object). +

    + +
    +
    parameter specializer name
    +

    n. + 1. (of a method definition) an expression used in code to + name a parameter specializer. + See Introduction to Methods. + 2. a class, +

    +

    a symbol naming a class, +

    +

    or a list (eql form). +

    + +
    +
    pathname
    +

    n. + an object of type pathname, which is a structured representation + of the name of a file. A pathname has six components: + a “host,” + a “device,” + a “directory,” + a “name,” + a “type,” and + a “version.” +

    + +
    +
    pathname designator
    +

    n. + a designator for a pathname; that is, + an object that denotes a pathname + and that is one of: +

    +

    a pathname namestring +

    +

    (denoting the corresponding pathname), +

    +

    a stream associated with a file + (denoting the pathname used to open the file; + this may be, but is not required to be, the actual name of the file), + or a pathname (denoting itself). + See File Operations on Open and Closed Streams. +

    + +
    +
    physical pathname
    +

    n. + a pathname that is not a logical pathname. +

    +

    [Editorial Note by KMP: Still need to reconcile some confusion in the uses of “generalized + reference” and “place.” I think one was supposed to refer to the + abstract concept, and the other to an object (a form), but the usages + have become blurred.] +

    + +
    +
    place
    +

    n. + 1. a form which is suitable for use as a generalized reference. + 2. the conceptual location referred to by such a place_1. +

    + +
    +
    plist
    +

    pronounced ’p\=e ,list n. + a property list. +

    + +
    +
    portable
    +

    adj. (of code) + required to produce equivalent results and observable side effects + in all conforming implementations. +

    + +
    +
    potential copy
    +

    n. (of an object O_1 subject to constriants) + an object O_2 that if the specified constraints are satisfied + by O_1 without any modification might or might not be identical + to O_1, or else that must be a fresh object that + resembles a copy of O_1 except that it has been modified as + necessary to satisfy the constraints. +

    + +
    +
    potential number
    +

    n. + A textual notation that might be parsed by the Lisp reader + in some conforming implementation as a number + but is not required to be parsed as a number. + No object is a potential number—either an object is + a number or it is not. + See Potential Numbers as Tokens. +

    + +
    +
    pprint dispatch table
    +

    n. + an object that can be the value of *print-pprint-dispatch* + and hence can control how objects are printed when + *print-pretty* is true. + See Pretty Print Dispatch Tables. +

    + +
    +
    predicate
    +

    n. + a function that returns a generalized boolean + as its first value. +

    + +
    +
    present
    +

    n. + 1. (of a feature in a Lisp image) + a state of being that is in effect if and only if the symbol + naming the feature is an element of the features list. + 2. (of a symbol in a package) + being accessible in that package directly, + rather than being inherited from another package. +

    + +
    +
    pretty print
    +

    v.t. (an object) + to invoke the pretty printer on the object. +

    + +
    +
    pretty printer
    +

    n. + the procedure that prints the character representation of an + object onto a stream when the value of + *print-pretty* is true, + and that uses layout techniques (e.g., indentation) that + tend to highlight the structure of the object in a way that + makes it easier for human readers to parse visually. + See the variable *print-pprint-dispatch* and The Lisp Pretty Printer. +

    + +
    +
    pretty printing stream
    +

    n. + a stream that does pretty printing. Such streams are created by + the function pprint-logical-block as a link between the output stream + and the logical block. +

    + +
    +
    primary method
    +

    n. + a member of one of two sets of methods + (the set of auxiliary methods is the other) + that form an exhaustive partition of the set of methods + on the method’s generic function. + How these sets are determined is dependent on the method combination type; + see Introduction to Methods. +

    + +
    +
    primary value
    +

    n. (of values resulting from the + evaluation of a form) + the first value, if any, or else nil if there are no values. + “The primary value returned by truncate is an + integer quotient, truncated toward zero.” +

    + +
    +
    principal
    +

    adj. (of a value returned by a Common Lisp function that + implements a mathematically irrational or transcendental + function defined in the complex domain) + of possibly many (sometimes an infinite number of) correct values for the + mathematical function, being the particular value which the corresponding + Common Lisp function has been defined to return. +

    + +
    +
    print name
    +

    n. Trad. (usually of a symbol) + a name_3. +

    + +
    +
    printer control variable
    +

    n. + a variable whose specific purpose is to control some action + of the Lisp printer; that is, one of the variables + in Figure~22–1, + or else some implementation-defined variable which is + defined by the implementation to be a printer control variable. +

    + +
    +
    printer escaping
    +

    n. + The combined state of the printer control variables + *print-escape* and *print-readably*. + If the value of either *print-readably* or *print-escape* is true, + then printer escaping + + is “enabled”; + otherwise (if the values of both *print-readably* and *print-escape* + are false), + then printer escaping is “disabled”. +

    + +
    +
    printing
    +

    adj. (of a character) + being a graphic character other than space. +

    + +
    +
    process
    +

    v.t. (a form by the compiler) + to perform minimal compilation, determining the time of + evaluation for a form, and possibly evaluating that + form (if required). +

    + +
    +
    processor
    +

    n., ANSI + an implementation. +

    + +
    +
    proclaim
    +

    v.t. (a proclamation) + to establish that proclamation. +

    + +
    +
    proclamation
    +

    n. + a global declaration. +

    + +
    +
    prog tag
    +

    n. Trad. + a go tag. +

    + +
    +
    program
    +

    n. Trad. + Common Lisp code. +

    + +
    +
    programmer
    +

    n. + an active entity, typically a human, that writes a program, + and that might or might not also be a user of the program. +

    + +
    +
    programmer code
    +

    n. + code that is supplied by the programmer; + that is, code that is not system code. +

    + +
    +
    proper list
    +

    n. + A list terminated by the empty list. + (The empty list is a proper list.) + See improper list. +

    + +
    +
    proper name
    +

    n. (of a class) + a symbol that names the class whose name + is that symbol. + See the functions class-name and find-class. +

    + +
    +
    proper sequence
    +

    n. + a sequence which is not an improper list; + that is, a vector or a proper list. +

    + +
    +
    proper subtype
    +

    n. (of a type) + a subtype of the type which is not the same type + as the type (i.e., its elements are a “proper subset” of the + type). +

    + +
    +
    property
    +

    n. (of a property list) + 1. a conceptual pairing of a property indicator and its + associated property value on a property list. + 2. a property value. +

    + +
    +
    property indicator
    +

    n. (of a property list) + the name part of a property, used as a key + when looking up a property value on a property list. +

    + +
    +
    property list
    +

    n. +

    +

    1. a list containing an even number of elements that are + alternating names (sometimes called indicators + or keys) and values (sometimes called properties). + When there is more than one name and value pair with + the identical name in a property list, + the first such pair determines the property. +

    +

    2. (of a symbol) + the component of the symbol containing a property list. +

    + +
    +
    property value
    +

    n. (of a property indicator on + a property list) + the object associated with the property indicator + on the property list. +

    + +
    +
    purports to conform
    +

    v. + makes a good-faith claim of conformance. + This term expresses intention to conform, regardless of whether the + goal of that intention is realized in practice. + For example, language implementations have been known to have bugs, + and while an implementation of this specification with bugs + might not be a conforming implementation, it can still + purport to conform. This is an important distinction in + certain specific cases; e.g., see the variable *features*. +

    +
    +
    +

    Q

    +
    +
    + +
    +
    qualified method
    +

    n. + a method that has one or more qualifiers. +

    + +
    +
    qualifier
    +

    n. (of a method for a generic function) + one of possibly several objects used to annotate the method + in a way that identifies its role in the method combination. + The method combination type determines + how many qualifiers are permitted for each method, + which qualifiers are permitted, + and + the semantics of those qualifiers. +

    + +
    +
    query I/O
    +

    n. + the bidirectional stream + that is the value of the variable *query-io*. +

    + +
    +
    quoted object
    +

    n. + an object which is the second element of a + quote form. +

    +
    +
    +

    R

    +
    +
    + +
    +
    radix
    +

    n. + an integer between 2 and 36, inclusive, which can be used + to designate a base with respect to which certain kinds of numeric + input or output are performed. + (There are n valid digit characters for any given radix n, + and those digits are the first n digits in the sequence + 0, 1, ..., 9, A, B, ..., Z, + which have the weights + 0, 1, ..., 9, 10, 11, ..., 35, + respectively. + Case is not significant in parsing numbers of radix greater + than 10, so “9b8a” and “9B8A” denote the same radix + 16 number.) +

    + +
    +
    random state
    +

    n. + an object of type random-state. +

    + +
    +
    rank
    +

    n. + a non-negative integer indicating the number of + dimensions of an array. +

    + +
    +
    ratio
    +

    n. + an object of type ratio. +

    + +
    +
    ratio marker
    +

    n. + a character which is used in the textual notation for a ratio + to separate the numerator from the denominator, and which + is slash in the standard readtable. + See Character Syntax. +

    + +
    +
    rational
    +

    n. + an object of type rational. +

    + +
    +
    read
    +

    v.t. +

    +

    1. (a binding or slot or component) + to obtain the value of the binding or slot. +

    +

    2. (an object from a stream) + to parse an object from its representation on the stream. +

    + +
    +
    readably
    +

    adv. (of a manner of printing an object O_1) + in such a way as to permit the Lisp Reader to later parse + the printed output into an object O_2 that is similar to O_1. +

    + +
    +
    reader
    +

    n. + 1. a function that reads_1 a variable or slot. + 2. the Lisp reader. +

    + +
    +
    reader macro
    +

    n. + 1. a textual notation introduced by dispatch on one or two characters + that defines special-purpose syntax for use by the Lisp reader, + and that is implemented by a reader macro function. + See Reader Algorithm. + 2. the character or characters that introduce + a reader macro_1; that is, + a macro character + or the conceptual pairing of a dispatching macro character and the + character that follows it. + (A reader macro is not a kind of macro.) +

    + +
    +
    reader macro function
    +

    n. + a function designator that denotes a function + that implements a reader macro_2. + See the functions set-macro-character and set-dispatch-macro-character. +

    + +
    +
    readtable
    +

    n. + an object of type readtable. +

    + +
    +
    readtable case
    +

    n. + an attribute of a readtable + whose value is a case sensitivity mode, + and that selects the manner in which characters + in a symbol’s name are to be treated by + the Lisp reader + and the Lisp printer. + See Effect of Readtable Case on the Lisp Reader and Effect of Readtable Case on the Lisp Printer. +

    + +
    +
    readtable designator
    +

    n. + a designator for a readtable; that is, + an object that denotes a readtable + and that is one of: + nil (denoting the standard readtable), + or a readtable (denoting itself). +

    + +
    +
    recognizable subtype
    +

    n. (of a type) + a subtype of the type which can be reliably detected + to be such by the implementation. + See the function subtypep. +

    + +
    +
    reference
    +

    n., v.t. + 1. n. an act or occurrence of referring to an object, + a binding, an exit point, a tag, + or an environment. + 2. v.t. to refer to an object, a binding, an + exit point, a tag, or an environment, + usually by name. +

    + +
    +
    registered package
    +

    n. + a package object that is installed in the package registry. + (Every registered package has a name that is a string, + as well as zero or more string nicknames. + All packages that are initially specified by Common Lisp + or created by make-package or defpackage + are registered packages. Registered packages can be turned into + unregistered packages by delete-package.) +

    + +
    +
    relative
    +

    adj. + 1. (of a time) + representing an offset from an absolute time + in the units appropriate to that time. + For example, + a relative internal time is the difference between + two absolute internal times, and is measured in + internal time units. + 2. (of a pathname) + representing a position in a directory hierarchy by motion + from a position other than the root, which might therefore vary. + “The notation #P"../foo.text" denotes a relative + pathname if the host file system is Unix.” + See absolute. +

    + +
    +
    repertoire
    +

    n., ISO + a subtype of character. See Character Repertoires. +

    + +
    +
    report
    +

    n. (of a condition) + to call the function print-object on the condition + in an environment where the value of *print-escape* is false. +

    + +
    +
    report message
    +

    n. + the text that is output by a condition reporter. +

    + +
    +
    required parameter
    +

    n. + A parameter for which a corresponding positional argument + must be supplied when calling the function. +

    + +
    +
    rest list
    +

    n. (of a function having a rest parameter) + The list to which the rest parameter is bound on some + particular call to the function. +

    + +
    +
    rest parameter
    +

    n. + A parameter which was introduced by &rest. +

    + +
    +
    restart
    +

    n. + an object of type restart. +

    + +
    +
    restart designator
    +

    n. + a designator for a restart; that is, + an object that denotes a restart + and that is one of: + a non-nil symbol + (denoting the most recently established active + restart whose name is that symbol), + or a restart (denoting itself). +

    + +
    +
    restart function
    +

    n. + a function that invokes a restart, as if by invoke-restart. + The primary purpose of a restart function is to provide an alternate + interface. By convention, a restart function usually has the same name + as the restart which it invokes. Figure 26–4 shows a list of the + standardized restart functions. +

    +
    +
      abort     muffle-warning  use-value  
+  continue  store-value                
+
+  Figure 26–4: Standardized Restart Functions
+
+
    + + +
    +
    return
    +

    v.t. (of values) + 1. (from a block) to transfer control and values from the block; + that is, to cause the block to yield the values immediately + without doing any further evaluation of the forms in its body. + 2. (from a form) to yield the values. +

    + +
    +
    return value
    +

    n. Trad. + a value_1 +

    + +
    +
    right-parenthesis
    +

    n. + the standard character “)”, + that is variously called + “right parenthesis” + or “close parenthesis” + See Figure~2–5. +

    + +
    +
    run time
    +

    n. + 1. load time + 2. execution time +

    + +
    +
    run-time compiler
    +

    n. + refers to the compile function or to implicit compilation, + for which the compilation and run-time environments are maintained + in the same Lisp image. +

    + +
    +
    run-time definition
    +

    n. + a definition in the run-time environment. +

    + +
    +
    run-time environment
    +

    n. + the environment in which a program is executed. +

    +
    +
    +

    S

    +
    +
    + +
    +
    safe
    +

    adj. + 1. (of code) + processed in a lexical environment where the the highest + safety level (3) was in effect. + See optimize. + 2. (of a call) a safe call. +

    + +
    +
    safe call
    +

    n. + a call in which + the call, + the function being called, + and the point of functional evaluation + are all safe_1 code. + For more detailed information, see Safe and Unsafe Calls. +

    + +
    +
    same
    +

    adj. + 1. (of objects under a specified predicate) + indistinguishable by that predicate. + “The symbol car, the string "car", and the string "CAR" + are the same under string-equal”. + 2. (of objects if no predicate is implied by context) + indistinguishable by eql. + Note that eq might be capable of distinguishing some + numbers and characters which eql cannot + distinguish, but the nature of such, if any, + is implementation-dependent. + Since eq is used only rarely in this specification, + eql is the default predicate when none is mentioned explicitly. + “The conses returned by two successive calls to cons + are never the same.” + 3. (of types) having the same set of elements; + that is, each type is a subtype of the others. + “The types specified by (integer 0 1), + (unsigned-byte 1), + and bit are the same.” +

    + +
    +
    satisfy the test
    +

    v. + (of an object being considered by a sequence function) + 1. (for a one argument test) + to be in a state such that the function which is the + predicate argument to the sequence function + returns true when given a single argument that is the + result of calling the sequence function’s key argument + on the object being considered. + See Satisfying a One-Argument Test. + 2. (for a two argument test) + to be in a state such that the two-place predicate + which is the sequence function’s + test argument + returns true when given a first argument that + is + the object being considered, + and when given a second argument + that is the result of calling the sequence function’s + key argument on an element of the + sequence function’s sequence argument + which is being tested for equality; + or to be in a state such that the test-not function + returns false given the same arguments. + See Satisfying a Two-Argument Test. +

    + +
    +
    scope
    +

    n. + the structural or textual region of code in which references + to an object, a binding, an exit point, + a tag, or an environment (usually by name) + can occur. +

    + +
    +
    script
    +

    n. ISO + one of possibly several sets that form an exhaustive partition + of the type character. See Character Scripts. +

    + +
    +
    secondary value
    +

    n. (of values resulting from the + evaluation of a form) + the second value, if any, + or else nil if there are fewer than two values. + “The secondary value returned by truncate is a remainder.” +

    + +
    +
    section
    +

    n. + a partitioning of output by a conditional newline on a pretty printing stream. + See Dynamic Control of the Arrangement of Output. +

    + +
    +
    self-evaluating object
    +

    n. + an object that is neither a symbol nor a + cons. + If a self-evaluating object is evaluated, + it yields itself as its only value. + “Strings are self-evaluating objects.” +

    + +
    +
    semi-standard
    +

    adj. (of a language feature) + not required to be implemented by any conforming implementation, + but nevertheless recommended as the canonical approach in situations where + an implementation does plan to support such a feature. + The presence of semi-standard aspects in the language is intended + to lessen portability problems and reduce the risk of gratuitous divergence + among implementations that might stand in the way of future + standardization. +

    + +
    +
    semicolon
    +

    n. + the standard character that is called “semicolon” (;). + See Figure~2–5. +

    + +
    +
    sequence
    +

    n. + 1. an ordered collection of elements + 2. a vector or a list. +

    + +
    +
    sequence function
    +

    n. + one of the functions in Figure~17–1, + or an implementation-defined function + that operates on one or more sequences. + and that is defined by the implementation to be a sequence function. +

    + +
    +
    sequential
    +

    adj. Trad. (of binding or assignment) + done in the style of setq, let*, or do*; + that is, interleaving the evaluation of the forms that produce values + with the assignments or bindings of the variables (or places). + See parallel. +

    + +
    +
    sequentially
    +

    adv. + in a sequential way. +

    + +
    +
    serious condition
    +

    n. + a condition of type serious-condition, + which represents a situation that is generally sufficiently + severe that entry into the debugger should be expected if + the condition is signaled but not handled. +

    + +
    +
    session
    +

    n. + the conceptual aggregation of events in a Lisp image from the time + it is started to the time it is terminated. +

    + +
    +
    set
    +

    v.t. Trad. (any variable + or a symbol that + is the name of a dynamic variable) + to assign the variable. +

    + +
    +
    setf expander
    +

    n. + a function used by setf to compute the setf expansion + of a place. +

    + +
    +
    setf expansion
    +

    n. + a set of five expressions_1 that, taken together, describe + how to store into a place + and which subforms of the macro call associated with the + place are evaluated. + See Setf Expansions. +

    + +
    +
    setf function
    +

    n. + a function whose name is (setf symbol). +

    + +
    +
    setf function name
    +

    n. (of a symbol S) + the list (setf S). +

    + +
    +
    shadow
    +

    v.t. + 1. to override the meaning of. + “That binding of X shadows an outer one.” + 2. to hide the presence of. + “That macrolet of F shadows the + outer flet of F.” + 3. to replace. + “That package shadows the symbol cl:car with + its own symbol car.” +

    + +
    +
    shadowing symbol
    +

    n. (in a package) + an element of the package’s shadowing symbols list. +

    + +
    +
    shadowing symbols list
    +

    n. (of a package) + a list, associated with the package, + of symbols that are to be exempted from ‘symbol conflict errors’ + detected when packages are used. + See the function package-shadowing-symbols. +

    + +
    +
    shared slot
    +

    n. (of a class) + a slot accessible in more than one instance + of a class; specifically, such a slot is accessible + in all direct instances of the class and in those + indirect instances whose class does not + shadow_1 the slot. +

    + +
    +
    sharpsign
    +

    n. + the standard character that is variously called “number sign,” “sharp,” + or “sharp sign” (#). + See Figure~2–5. +

    + +
    +
    short float
    +

    n. + an object of type short-float. +

    + +
    +
    sign
    +

    n. + one of the standard characters “+” or “-”. +

    + +
    +
    signal
    +

    v. + to announce, using a standard protocol, that a particular situation, + represented by a condition, has been detected. + See Condition System Concepts. +

    + +
    +
    signature
    +

    n. (of a method) + a description of the parameters and + parameter specializers for the method which + determines the method’s applicability for a given set of + required arguments, and which also describes the + argument conventions for its other, non-required + arguments. +

    + +
    +
    similar
    +

    adj. (of two objects) + defined to be equivalent under the similarity relationship. +

    + +
    +
    similarity
    +

    n. + a two-place conceptual equivalence predicate, + which is independent of the Lisp image + so that two objects in different Lisp images + can be understood to be equivalent under this predicate. + See Literal Objects in Compiled Files. +

    + +
    +
    simple
    +

    adj. + 1. (of an array) being of type simple-array. + 2. (of a character) + having no implementation-defined attributes, + or else having implementation-defined attributes + each of which has the null value for that attribute. +

    + +
    +
    simple array
    +

    n. + an array of type simple-array. +

    + +
    +
    simple bit array
    +

    n. + a bit array that is a simple array; + that is, an object of type (simple-array bit). +

    + +
    +
    simple bit vector
    +

    n. + a bit vector of type simple-bit-vector. +

    + +
    +
    simple condition
    +

    n. + a condition of type simple-condition. +

    + +
    +
    simple general vector
    +

    n. + a simple vector. +

    + +
    +
    simple string
    +

    n. + a string of type simple-string. +

    + +
    +
    simple vector
    +

    n. + a vector of type simple-vector, + sometimes called a “simple general vector.” + Not all vectors that are simple are simple vectors—only + those that have element type t. +

    + +
    +
    single escape
    +

    n., adj. + 1. n. the syntax type of a character + that indicates that the next character is + to be treated as an alphabetic_2 character + with its case preserved. + For details, see Single Escape Character. + 2. adj. (of a character) + having the single escape syntax type. + 3. n. a single escape_2 character. + (In the standard readtable, + slash is the only single escape.) +

    + +
    +
    single float
    +

    n. + an object of type single-float. +

    + +
    +
    single-quote
    +

    n. + the standard character that is variously called + “apostrophe,” + “acute accent,” + “quote,” + or “single quote” ('). + See Figure~2–5. +

    + +
    +
    singleton
    +

    adj. (of a sequence) + having only one element. + “(list 'hello) returns a singleton list.” +

    + +
    +
    situation
    +

    n. + the evaluation of a form in a specific environment. +

    + +
    +
    slash
    +

    n. + the standard character that is variously called + “solidus” + or “slash” (/). + See Figure~2–5. +

    + +
    +
    slot
    +

    n. + a component of an object that can store a value. +

    + +
    +
    slot specifier
    +

    n. + a representation of a slot + that includes the name of the slot and zero or more slot options. + A slot option pertains only to a single slot. +

    + +
    +
    source code
    +

    n. + code representing objects suitable for evaluation + (e.g., objects created by read, + by macro expansion, +

    +

    or by compiler macro expansion). +

    + +
    +
    source file
    +

    n. + a file which contains a textual representation of source code, + that can be edited, loaded, or compiled. +

    + +
    +
    space
    +

    n. + the standard character <Space>, + notated for the Lisp reader as #\Space. +

    + +
    +
    special form
    +

    n. + a list, other than a macro form, which is a + form with special syntax or special evaluation + rules or both, possibly manipulating the evaluation + environment or control flow or both. The first element of + a special form is a special operator. +

    + +
    +
    special operator
    +

    n. + one of a fixed set of symbols, + enumerated in Figure~3–2, + that may appear in the car of + a form in order to identify the form as a special form. +

    + +
    +
    special variable
    +

    n. Trad. + a dynamic variable. +

    + +
    +
    specialize
    +

    v.t. (a generic function) + to define a method for the generic function, or in other words, + to refine the behavior of the generic function by giving it a specific + meaning for a particular set of classes or arguments. +

    + +
    +
    specialized
    +

    adj. + 1. (of a generic function) + having methods which specialize the generic function. + 2. (of an array) + having an actual array element type + that is a proper subtype of the type t; + see Array Elements. + “(make-array 5 :element-type 'bit) makes an array of length + five that is specialized for bits.” +

    + +
    +
    specialized lambda list
    +

    n. + an extended lambda list used in forms that establish + method definitions, such as defmethod. + See Specialized Lambda Lists. +

    + +
    +
    spreadable argument list designator
    +

    n. + a designator for a list of objects; that is, + an object that denotes a list + and that is a non-null list L1 of length n, + whose last element is a list L2 of length m + (denoting a list L3 of length m+n-1 whose elements are + L1_i for i < n-1 followed by L2_j for j < m). + “The list (1 2 (3 4 5)) is a spreadable argument list designator for + the list (1 2 3 4 5).” +

    + +
    +
    stack allocate
    +

    v.t. Trad. + to allocate in a non-permanent way, such as on a stack. Stack-allocation + is an optimization technique used in some implementations for + allocating certain kinds of objects that have dynamic extent. + Such objects are allocated on the stack rather than in the heap + so that their storage can be freed as part of unwinding the stack rather + than taking up space in the heap until the next garbage collection. + What types (if any) can have dynamic extent can vary + from implementation to implementation. No + implementation is ever required to perform stack-allocation. +

    + +
    +
    stack-allocated
    +

    adj. Trad. + having been stack allocated. +

    + +
    +
    standard character
    +

    n. + a character of type standard-char, which is one of a fixed set of 96 + such characters required to be present in all conforming implementations. + See Standard Characters. +

    + +
    +
    standard class
    +

    n. + a class that is a generalized instance of class standard-class. +

    + +
    +
    standard generic function
    +
    +

    a function of type standard-generic-function. +

    + +
    +
    standard input
    +

    n. + the input stream which is the value of the dynamic variable + *standard-input*. +

    + +
    +
    standard method combination
    +

    n. + the method combination named standard. +

    + +
    +
    standard object
    +

    n. + an object that is + a generalized instance + of class standard-object. +

    + +
    +
    standard output
    +

    n. + the output stream which is the value of the dynamic variable + *standard-output*. +

    + +
    +
    standard pprint dispatch table
    +

    n. + A pprint dispatch table that is different from + the initial pprint dispatch table, + that implements pretty printing as described in this specification, + and that, unlike other pprint dispatch tables, + must never be modified by any program. + (Although the definite reference “the standard pprint dispatch table” + is generally used + within this document, it is actually implementation-dependent whether a + single object fills the role of the standard pprint dispatch table, + or whether there might be multiple such objects, any one of which could be used on any + given occasion where “the standard pprint dispatch table” is called for. + As such, this phrase should be seen as an indefinite reference + in all cases except for anaphoric references.) +

    + +
    +
    standard readtable
    +

    n. + A readtable that is different from the initial readtable, + that implements the expression syntax defined in this specification, + and that, unlike other readtables, must never be modified by any program. + (Although the definite reference “the standard readtable” is generally used + within this document, it is actually implementation-dependent whether a + single object fills the role of the standard readtable, + or whether there might be multiple such objects, any one of which could be used on any + given occasion where “the standard readtable” is called for. + As such, this phrase should be seen as an indefinite reference + in all cases except for anaphoric references.) +

    + +
    +
    standard syntax
    +

    n. + the syntax represented by the standard readtable + and used as a reference syntax throughout this document. + See Character Syntax. +

    + +
    +
    standardized
    +

    adj. (of a name, object, or definition) + having been defined by Common Lisp. + “All standardized variables that are required to + hold bidirectional streams have “-io*” in their name.” +

    + +
    +
    startup environment
    +

    n. + the global environment of the running Lisp image + from which the compiler was invoked. +

    + +
    +
    step
    +

    v.t., n. + 1. v.t. (an iteration variable) to assign the variable + a new value at the end of an iteration, in preparation for a new iteration. + 2. n. the code that identifies how the next value in an iteration + is to be computed. + 3. v.t. (code) to specially execute the code, pausing at + intervals to allow user confirmation or intervention, usually for debugging. +

    + +
    +
    stream
    +

    n. + an object that can be used with an input or output function to + identify an appropriate source or sink of characters or + bytes for that operation. +

    + +
    +
    stream associated with a file
    +

    n. + a file stream, or a synonym stream the target + of which is a stream associated with a file. + Such a stream cannot be created with + make-two-way-stream, + make-echo-stream, + make-broadcast-stream, + make-concatenated-stream, + make-string-input-stream, + or make-string-output-stream. +

    + +
    +
    stream designator
    +

    n. + a designator for a stream; that is, + an object that denotes a stream + and that is one of: + t (denoting the value of *terminal-io*), + nil (denoting the value of *standard-input* + for input stream designators + or denoting the value of *standard-output* + for output stream designators), + or a stream (denoting itself). +

    + +
    +
    stream element type
    +

    n. (of a stream) + the type of data for which the stream is specialized. +

    + +
    +
    stream variable
    +

    n. + a variable whose value must be a stream. +

    + +
    +
    stream variable designator
    +

    n. + a designator for a stream variable; that is, + a symbol that denotes a stream variable + and that is one of: + t (denoting *terminal-io*), + nil (denoting *standard-input* + for input stream variable designators + or denoting *standard-output* + for output stream variable designators), + or some other symbol (denoting itself). +

    + +
    +
    string
    +

    n. + a specialized vector that is of type string, + and whose elements are of type character or a subtype of type character. +

    + +
    +
    string designator
    +

    n. + a designator for a string; that is, + an object that denotes a string + and that is one of: + a character (denoting a singleton string + that has the character as its only element), + a symbol (denoting the string that is its name), + or a string (denoting itself). +

    +

    The intent is that this term be consistent with the behavior of string; + implementations that extend string must extend the meaning of + this term in a compatible way. +

    + +
    +
    string equal
    +

    adj. + the same under string-equal. +

    + +
    +
    string stream
    +

    n. + a stream of type string-stream. +

    + +
    +
    structure
    +

    n. + an object of type structure-object. +

    + +
    +
    structure class
    +

    n. + a class that is a generalized instance of class structure-class. +

    + +
    +
    structure name
    +

    n. + a name defined with defstruct. + Usually, such a type is also a structure class, + but there may be implementation-dependent situations + in which this is not so, if the :type option to defstruct is used. +

    + +
    +
    style warning
    +

    n. + a condition of type style-warning. +

    + +
    +
    subclass
    +

    n. + a class that inherits from another class, + called a superclass. + (No class is a subclass of itself.) +

    + +
    +
    subexpression
    +

    n. (of an expression) + an expression that is contained within the expression. + (In fact, the state of being a subexpression is not an attribute + of the subexpression, but really an attribute of the containing + expression since the same object can at once be + a subexpression in one context, and not in another.) +

    + +
    +
    subform
    +

    n. (of a form) + an expression that is a subexpression of the form, + and which by virtue of its position in that form is also a + form. + “(f x) and x, but not exit, are subforms of + (return-from exit (f x)).” +

    + +
    +
    subrepertoire
    +

    n. + a subset of a repertoire. +

    + +
    +
    subtype
    +

    n. + a type whose membership is the same as or a proper subset of the + membership of another type, called a supertype. + (Every type is a subtype of itself.) +

    + +
    +
    superclass
    +

    n. + a class from which another class + (called a subclass) inherits. + (No class is a superclass of itself.) + See subclass. +

    + +
    +
    supertype
    +

    n. + a type whose membership is the same as or a proper superset + of the membership of another type, called a subtype. + (Every type is a supertype of itself.) + See subtype. +

    + +
    +
    supplied-p parameter
    +

    n. + a parameter which recieves its generalized boolean value + implicitly due to the presence or absence of an argument + corresponding to another parameter + (such as an optional parameter or a rest parameter). + See Ordinary Lambda Lists. +

    + +
    +
    symbol
    +

    n. + an object of type symbol. +

    + +
    +
    symbol macro
    +

    n. + a symbol that stands for another form. + See the macro symbol-macrolet. +

    + +
    +
    synonym stream
    +

    n. + 1. a stream of type synonym-stream, + which is consequently a stream that is an alias for another stream, + which is the value of a dynamic variable + whose name is the synonym stream symbol of the synonym stream. + See the function make-synonym-stream. + 2. (to a stream) + a synonym stream which has the stream as the value + of its synonym stream symbol. + 3. (to a symbol) + a synonym stream which has the symbol as its + synonym stream symbol. +

    + +
    +
    synonym stream symbol
    +

    n. (of a synonym stream) + the symbol which names the dynamic variable which has as its + value another stream for which the synonym stream + is an alias. +

    + +
    +
    syntax type
    +

    n. (of a character) + one of several classifications, enumerated in Figure~2–6, + that are used for dispatch during parsing by the Lisp reader. + See Character Syntax Types. +

    + +
    +
    system class
    +

    n. + a class that may be of type built-in-class in a conforming implementation + and hence cannot be inherited by classes defined by conforming programs. +

    + +
    +
    system code
    +

    n. + code supplied by the implementation to implement this specification + (e.g., the definition of mapcar) + or generated automatically in support of this specification + (e.g., during method combination); + that is, code that is not programmer code. +

    +
    +
    +

    T

    +
    +
    + +
    +
    t
    +

    n. + 1. a. the boolean representing true. + b. the canonical generalized boolean representing true. + (Although any object other than nil is considered true + as a generalized boolean, + t is generally used when there is no special reason to prefer one + such object over another.) + 2. the name of the type to which all objects belong—the + supertype of all types (including itself). + 3. the name of the superclass of all classes except itself. +

    + +
    +
    tag
    +

    n. + 1. a catch tag. + 2. a go tag. +

    + +
    +
    tail
    +

    n. (of a list) + an object that is the same as either some cons + which makes up that list or the atom (if any) which terminates + the list. + “The empty list is a tail of every proper list.” +

    + +
    +
    target
    +

    n. + 1. (of a constructed stream) + a constituent of the constructed stream. + “The target of a synonym stream is + the value of its synonym stream symbol.” + 2. (of a displaced array) + the array to which the displaced array is displaced. + (In the case of a chain of constructed streams or displaced arrays, + the unqualified term “target” always refers to the immediate + target of the first item in the chain, not the immediate target + of the last item.) +

    + +
    +
    terminal I/O
    +

    n. + the bidirectional stream + that is the value of the variable *terminal-io*. +

    + +
    +
    terminating
    +

    n. (of a macro character) + being such that, if it appears while parsing a token, it terminates that token. + See Reader Algorithm. +

    + +
    +
    tertiary value
    +

    n. (of values resulting from the + evaluation of a form) + the third value, if any, + or else nil if there are fewer than three values. +

    + +
    +
    throw
    +

    v. + to transfer control and values to a catch. + See the special operator throw. +

    + +
    +
    tilde
    +

    n. + the standard character that is called “tilde” (~). + See Figure~2–5. +

    + +
    +
    time
    +
    +

    a representation of a point (absolute time) + or an interval (relative time) + on a time line. + See decoded time, internal time, and universal time. +

    + +
    +
    time zone
    +

    n. + a rational multiple of 1/3600 between -24 (inclusive) + and 24 (inclusive) that represents a time zone as a number of hours + offset from Greenwich Mean Time. Time zone values increase with motion to the west, + so Massachusetts, U.S.A. is in time zone 5, + California, U.S.A. is time zone 8, + and Moscow, Russia is time zone -3. + (When “daylight savings time” is separately represented + as an argument or return value, the time zone + that accompanies it does not depend on whether daylight savings time + is in effect.) +

    + +
    +
    token
    +

    n. + a textual representation for a number or a symbol. + See Interpretation of Tokens. +

    + +
    +
    top level form
    +

    n. + a form which is processed specially by compile-file for + the purposes of enabling compile time evaluation of that + form. + Top level forms include those forms which + are not subforms of any other form, + and certain other cases. See Processing of Top Level Forms. +

    + +
    +
    trace output
    +

    n. + the output stream which is the value of the dynamic variable + *trace-output*. +

    + +
    +
    tree
    +

    n. + 1. a binary recursive data structure made up of conses and + atoms: the conses are themselves also trees + (sometimes called “subtrees” or “branches”), and the atoms + are terminal nodes (sometimes called leaves). Typically, + the leaves represent data while the branches establish some + relationship among that data. + 2. in general, any recursive data structure that has some notion of + “branches” and leaves. +

    + +
    +
    tree structure
    +

    n. (of a tree_1) + the set of conses that make up the tree. + Note that while the car_{1b} component of each such cons + is part of the tree structure, + the objects that are the cars_2 of each cons + in the tree + are not themselves part of its tree structure + unless they are also conses. +

    + +
    +
    true
    +

    n. + any object + that is not false + and that is used to represent the success of a predicate test. + See t_1. +

    + +
    +
    truename
    +

    n. + 1. the canonical filename of a file in the file system. + See Truenames. + 2. a pathname representing a truename_1. +

    + +
    +
    two-way stream
    +

    n. + a stream of type two-way-stream, + which is a bidirectional composite stream that + receives its input from an associated input stream + and sends its output to an associated output stream. +

    + +
    +
    type
    +

    n. + 1. a set of objects, usually with common structure, behavior, or purpose. + (Note that the expression “X is of type S_a” + naturally implies that “X is of type S_b” if + S_a is a subtype of S_b.) + 2. (immediately following the name of a type) + a subtype of that type. + “The type vector is an array type.” +

    + +
    +
    type declaration
    +

    n. + a declaration that asserts that every reference to a + specified binding within the scope of the declaration + results in some object of the specified type. +

    + +
    +
    type equivalent
    +

    adj. (of two types X and Y) + having the same elements; + that is, X is a subtype of Y + and Y is a subtype of X. +

    + +
    +
    type expand
    +

    n. + to fully expand a type specifier, removing any references to + derived types. (Common Lisp provides no program interface to cause + this to occur, but the semantics of Common Lisp are such that every + implementation must be able to do this internally, and some + situations involving type specifiers are most easily described + in terms of a fully expanded type specifier.) +

    + +
    +
    type specifier
    +

    n. + an expression that denotes a type. + “The symbol random-state, the list (integer 3 5), + the list (and list (not null)), and the class named + standard-class are type specifiers.” +

    +
    +
    +

    U

    +
    +
    + +
    +
    unbound
    +

    adj. + not having an associated denotation in a binding. + See bound. +

    + +
    +
    unbound variable
    +

    n. + a name that is syntactically plausible as the name of a + variable but which is not bound + in the variable namespace. +

    + +
    +
    undefined function
    +

    n. + a name that is syntactically plausible as the name of a + function but which is not bound + in the function namespace. +

    + +
    +
    unintern
    +

    v.t. (a symbol in a package) + to make the symbol not be present in that package. + (The symbol might continue to be accessible by inheritance.) +

    + +
    +
    uninterned
    +

    adj. (of a symbol) + not accessible in any package; i.e., not interned_1. +

    + +
    +
    universal time
    +

    n. + time, represented as a non-negative integer number of seconds. + Absolute universal time is measured as an offset + from the beginning of the year 1900 (ignoring leap seconds). + See Universal Time. +

    + +
    +
    unqualified method
    +

    n. + a method with no qualifiers. +

    + +
    +
    unregistered package
    +

    n. + a package object that is not present in the package registry. + An unregistered package has no name; i.e., its name is nil. + See the function delete-package. +

    + +
    +
    unsafe
    +

    adj. (of code) + not safe. (Note that, unless explicitly specified otherwise, + if a particular kind of error checking is + guaranteed only in a safe context, the same checking might or might not occur + in that context if it were unsafe; describing a context as unsafe + means that certain kinds of error checking are not reliably enabled + but does not guarantee that error checking is definitely disabled.) +

    + +
    +
    unsafe call
    +

    n. + a call that is not a safe call. + For more detailed information, see Safe and Unsafe Calls. +

    + +
    +
    upgrade
    +

    v.t. (a declared type to an actual type) + 1. (when creating an array) + to substitute an actual array element type + for an expressed array element type + when choosing an appropriately specialized array representation. + See the function upgraded-array-element-type. + 2. (when creating a complex) + to substitute an actual complex part type + for an expressed complex part type + when choosing an appropriately specialized complex representation. + See the function upgraded-complex-part-type. +

    + +
    +
    upgraded array element type
    +

    n. (of a type) + a type that is a supertype of the type + and that is used instead of the type whenever the + type is used as an array element type + for object creation or type discrimination. + See Array Upgrading. +

    + +
    +
    upgraded complex part type
    +

    n. (of a type) + a type that is a supertype of the type + and that is used instead of the type whenever the + type is used as a complex part type + for object creation or type discrimination. + See the function upgraded-complex-part-type. +

    + +
    +
    uppercase
    +

    adj. (of a character) + being among standard characters corresponding to + the capital letters A through Z, + or being some other implementation-defined character + that is defined by the implementation to be uppercase. + See Characters With Case. +

    + +
    +
    use
    +

    v.t. (a package P_1) + to inherit the external symbols of P_1. + (If a package P_2 uses P_1, + the external symbols of P_1 + become internal symbols of P_2 + unless they are explicitly exported.) + “The package CL-USER uses the package CL.” +

    + +
    +
    use list
    +

    n. (of a package) + a (possibly empty) list associated with each package + which determines what other packages are currently being + used by that package. +

    + +
    +
    user
    +

    n. + an active entity, typically a human, that invokes or interacts with a + program at run time, but that is not necessarily a programmer. +

    +
    +
    +

    V

    +
    +
    + +
    +
    valid array dimension
    +

    n. + a fixnum suitable for use as an array dimension. + Such a fixnum must be greater than or equal to zero, + and less than the value of array-dimension-limit. + When multiple array dimensions are to be used together to specify a + multi-dimensional array, there is also an implied constraint + that the product of all of the dimensions be less than the value of + array-total-size-limit. +

    + +
    +
    valid array index
    +

    n. (of an array) + a fixnum suitable for use as one of possibly several indices needed + to name an element of the array according to a multi-dimensional + Cartesian coordinate system. Such a fixnum must + be greater than or equal to zero, + and must be less than the corresponding dimension_1 + of the array. + (Unless otherwise explicitly specified, + the phrase “a list of valid array indices” further implies + that the length of the list must be the same as the + rank of the array.) + “For a 2 by~3 array, + valid array indices for the first dimension are 0 and~1, and + valid array indices for the second dimension are 0, 1 and~2.” +

    + +
    +
    valid array row-major index
    +

    n. (of an array, + which might have any number + of dimensions_2) + a single fixnum suitable for use in naming any element + of the array, by viewing the array’s storage as a linear + series of elements in row-major order. + Such a fixnum must be greater than or equal to zero, + and less than the array total size of the array. +

    + +
    +
    valid fill pointer
    +

    n. (of an array) + a fixnum suitable for use as a fill pointer for the array. + Such a fixnum must be greater than or equal to zero, + and less than or equal to the array total size of the array. +

    +

    [Editorial Note by KMP: The “valid pathname xxx” definitions were taken from + text found in make-pathname, but look wrong to me. + I’ll fix them later.] +

    + +
    +
    valid logical pathname host
    +

    n. + a string that has been defined as the name of a logical host. + See the function load-logical-pathname-translations. +

    + +
    +
    valid pathname device
    +

    n. + a string, + nil, + :unspecific, + or some other object defined by the implementation + to be a valid pathname device. +

    + +
    +
    valid pathname directory
    +

    n. + a string, + a list of strings, + nil, +

    +

    :wild, +

    +

    :unspecific, + or some other object defined by the implementation + to be a valid directory component. +

    + +
    +
    valid pathname host
    +

    n. + a valid physical pathname host + or a valid logical pathname host. +

    + +
    +
    valid pathname name
    +

    n. + a string, + nil, + :wild, + :unspecific, + or some other object defined by the implementation + to be a valid pathname name. +

    + +
    +
    valid pathname type
    +

    n. + a string, + nil, + :wild, + :unspecific. +

    + +
    +
    valid pathname version
    +

    n. + a non-negative integer, + or one of :wild, + :newest, + :unspecific, + or nil. + The symbols :oldest, :previous, and :installed are + semi-standard special version symbols. +

    + +
    +
    valid physical pathname host
    +

    n. + any of + a string, + a list of strings, + or the symbol :unspecific, + that is recognized by the implementation as the name of a host. +

    + +
    +
    valid sequence index
    +

    n. (of a sequence) + an integer suitable for use to name an element + of the sequence. Such an integer must + be greater than or equal to zero, + and must be less than the length of the sequence. +

    +

    (If the sequence is an array, + the valid sequence index is further constrained to be a fixnum.) +

    + +
    +
    value
    +

    n. + 1. a. one of possibly several objects that are the result of + an evaluation. + b. (in a situation where exactly one value is expected from the + evaluation of a form) + the primary value returned by the form. + c. (of forms in an implicit progn) one of possibly + several objects that result from the evaluation + of the last form, or nil if there are no forms. + 2. an object associated with a name in a binding. + 3. (of a symbol) the value of the dynamic variable + named by that symbol. + 4. an object associated with a key + in an association list, + a property list, + or a hash table. +

    + +
    +
    value cell
    +

    n. Trad. (of a symbol) + The place which holds the value, if any, of the + dynamic variable named by that symbol, + and which is accessed by symbol-value. + See cell. +

    + +
    +
    variable
    +

    n. + a binding in which a symbol is the name + used to refer to an object. +

    + +
    +
    vector
    +

    n. + a one-dimensional array. +

    + +
    +
    vertical-bar
    +

    n. + the standard character that is called “vertical bar” (|). + See Figure~2–5. +

    +
    +
    +

    W

    +
    +
    + +
    +
    whitespace
    +

    n. + 1. one or more characters that are + either the graphic character #\Space + or else non-graphic characters such as #\Newline + that only move the print position. + 2. a. n. the syntax type of a character + that is a token separator. + For details, see Whitespace Characters. + b. adj. (of a character) + having the whitespace_{2a} syntax type_2. + c. n. a whitespace_{2b} character. +

    + +
    +
    wild
    +

    adj. + 1. (of a namestring) using an implementation-defined + syntax for naming files, which might “match” any of possibly several + possible filenames, and which can therefore be used to refer to + the aggregate of the files named by those filenames. + 2. (of a pathname) a structured representation of a name which + might “match” any of possibly several pathnames, and which can + therefore be used to refer to the aggregate of the files named by those + pathnames. The set of wild pathnames includes, but + is not restricted to, pathnames which have a component which is + :wild, or which have a directory component which contains :wild + or :wild-inferors. + See the function wild-pathname-p. +

    + +
    +
    write
    +

    v.t. +

    +

    1. (a binding or slot or component) + to change the value of the binding or slot. +

    +

    2. (an object to a stream) + to output a representation of the object to the stream. +

    + +
    +
    writer
    +

    n. + a function that writes_1 a variable or slot. +

    +
    +
    +

    Y

    +
    +
    + +
    +
    yield
    +

    v.t. (values) + to produce the values as the result of evaluation. + “The form (+ 2 3) yields 5.” +

    +
    +
    + + + + + + + +
    +
    +

    +Previous: , Up: Glossary (Glossary)  

    +
    + + + + + diff --git a/info/gcl/Graphic-Characters.html b/info/gcl/Graphic-Characters.html new file mode 100644 index 0000000..9b2b280 --- /dev/null +++ b/info/gcl/Graphic-Characters.html @@ -0,0 +1,82 @@ + + + + + +Graphic Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.1 Graphic Characters

    + +

    Characters that are classified as graphic + +, or displayable, are each +associated with a glyph, a visual representation of the character. +

    +

    A graphic character is one that has a standard textual +representation as a single glyph, such as A or * or =. +Space, which effectively has a blank glyph, is defined +to be a graphic. +

    +

    Of the standard characters, + newline is non-graphic + and all others are graphic; see Standard Characters. +

    +

    Characters that are not graphic are called non-graphic + +. +

    +

    Non-graphic characters are sometimes informally called + “formatting characters” + or “control characters.” +

    +

    #\Backspace, +#\Tab, +#\Rubout, +#\Linefeed, +#\Return, and +#\Page, +if they are supported by the implementation, +are non-graphic. +

    + + + + + diff --git a/info/gcl/Hash-Table-Concepts.html b/info/gcl/Hash-Table-Concepts.html new file mode 100644 index 0000000..cccb6a2 --- /dev/null +++ b/info/gcl/Hash-Table-Concepts.html @@ -0,0 +1,59 @@ + + + + + +Hash Table Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables  

    +
    +
    +

    18.1 Hash Table Concepts

    + + + + + +
    • Hash-Table Operations   +
    • Modifying Hash Table Keys   +
    + + + + + + diff --git a/info/gcl/Hash-Tables-Dictionary.html b/info/gcl/Hash-Tables-Dictionary.html new file mode 100644 index 0000000..38a8101 --- /dev/null +++ b/info/gcl/Hash-Tables-Dictionary.html @@ -0,0 +1,83 @@ + + + + + +Hash Tables Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Hash Tables  

    +
    +
    +

    18.2 Hash Tables Dictionary

    + + + + + + + + + + + + + + + + + +
    • hash-table   +
    • make-hash-table   +
    • hash-table-p   +
    • hash-table-count   +
    • hash-table-rehash-size   +
    • hash-table-rehash-threshold   +
    • hash-table-size   +
    • hash-table-test   +
    • gethash   +
    • remhash   +
    • maphash   +
    • with-hash-table-iterator   +
    • clrhash   +
    • sxhash   +
    + + + + + + diff --git a/info/gcl/Hash-Tables.html b/info/gcl/Hash-Tables.html new file mode 100644 index 0000000..a8a3172 --- /dev/null +++ b/info/gcl/Hash-Tables.html @@ -0,0 +1,58 @@ + + + + + +Hash Tables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    18 Hash Tables

    + + + + +
    • Hash Table Concepts   +
    • Hash Tables Dictionary   +
    + + + + + + diff --git a/info/gcl/Hash_002dTable-Operations.html b/info/gcl/Hash_002dTable-Operations.html new file mode 100644 index 0000000..11cdbe5 --- /dev/null +++ b/info/gcl/Hash_002dTable-Operations.html @@ -0,0 +1,120 @@ + + + + + +Hash-Table Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Table Concepts  

    +
    +
    +

    18.1.1 Hash-Table Operations

    + +

    Figure 18–1 lists some defined names that are applicable +to hash tables. The following rules apply to hash tables. +

    +
    +
    –
    +

    A hash table can only associate one value with a given +key. If an attempt is made to add a second value for a given key, +the second value will replace the first. +Thus, adding a value to a hash table is a destructive operation; +the hash table is modified. +

    +
    +
    –
    +

    There are four kinds of hash tables: + those whose keys are compared with eq, + those whose keys are compared with eql, + those whose keys are compared with equal, and +

    +

    those whose keys are compared with equalp. +

    +
    +
    –
    +

    Hash tables are created by make-hash-table. +gethash is used to look up a key and find the associated value. +New entries are added to hash tables using setf with gethash. +remhash is used to remove an entry. +For example: +

    +
    +
     (setq a (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32536573>
+ (setf (gethash 'color a) 'brown) ⇒  BROWN
+ (setf (gethash 'name a) 'fred) ⇒  FRED
+ (gethash 'color a) ⇒  BROWN, true
+ (gethash 'name a) ⇒  FRED, true
+ (gethash 'pointy a) ⇒  NIL, false
+
    + +

    In this example, the symbols color and name are being used as +keys, and the symbols brown and fred are being used as the +associated values. The hash table +has two items in it, one of which +associates from color to brown, and the other of which +associates from name to fred. +

    +
    +
    –
    +

    A key or a value may be any object. +

    +
    +
    –
    +

    The existence of an entry in the hash table can be determined +from the secondary value returned by gethash. +

    +
    + +
    +
      clrhash           hash-table-p     remhash  
+  gethash           make-hash-table  sxhash   
+  hash-table-count  maphash                   
+
+     Figure 18–1: Hash-table defined names   
+
+
    + +
    +
    +

    +Next: , Previous: , Up: Hash Table Concepts  

    +
    + + + + + diff --git a/info/gcl/History.html b/info/gcl/History.html new file mode 100644 index 0000000..200099d --- /dev/null +++ b/info/gcl/History.html @@ -0,0 +1,231 @@ + + + + + +History (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Scope  

    +
    +
    +

    1.1.2 History

    + +

    Lisp is a family of languages with a long history. Early key ideas in +Lisp were developed by John McCarthy during the 1956 Dartmouth Summer +Research Project on Artificial Intelligence. McCarthy’s motivation +was to develop an algebraic list processing language for artificial +intelligence work. +Implementation efforts for early dialects of Lisp were undertaken on +the IBM~704, the IBM~7090, the Digital Equipment Corporation (DEC) PDP-1, +the DEC~PDP-6, and the PDP-10. The primary dialect of Lisp between +1960 and 1965 was Lisp~1.5. By the early 1970’s there were two +predominant dialects of Lisp, both arising from these early efforts: +MacLisp and Interlisp. +For further information about very early Lisp dialects, +see The Anatomy of Lisp or Lisp 1.5 Programmer’s Manual. +

    +

    MacLisp improved on the Lisp~1.5 notion of special variables and error +handling. MacLisp also introduced the concept of functions that could take +a variable number of arguments, macros, arrays, non-local dynamic +exits, fast arithmetic, the first good Lisp compiler, and an emphasis +on execution speed. +By the end of the 1970’s, MacLisp was in use at over 50 sites. +For further information about Maclisp, +see Maclisp Reference Manual, Revision~0 or The Revised Maclisp Manual. +

    +

    Interlisp introduced many ideas into Lisp programming environments and +methodology. One of the Interlisp ideas that influenced Common Lisp was an iteration +construct implemented by Warren Teitelman that inspired the loop +macro used both on the Lisp Machines and in MacLisp, and now in Common Lisp. +For further information about Interlisp, +see Interlisp Reference Manual. +

    +

    Although the first implementations of Lisp were on the IBM~704 and the +IBM~7090, later work focussed on the DEC +PDP-6 and, later, PDP-10 computers, the latter being the mainstay of +Lisp and artificial intelligence work at such places as +Massachusetts Institute of Technology (MIT), Stanford University, +and +Carnegie Mellon University (CMU) from the mid-1960’s through much of the 1970’s. +The PDP-10 computer and its predecessor the PDP-6 computer were, by +design, especially well-suited to Lisp because they had 36-bit words +and 18-bit addresses. This architecture allowed a cons cell to be +stored in one word; single instructions could extract the +car and cdr +parts. The PDP-6 and PDP-10 had fast, powerful stack instructions +that enabled fast function calling. +But the limitations of the PDP-10 were evident by 1973: it supported a +small number of researchers using Lisp, and the small, 18-bit address +space (2^18 = 262,144 words) limited the size of a single +program. +One response to the address space problem was the Lisp Machine, a +special-purpose computer designed to run Lisp programs. The other +response was to use general-purpose computers with address spaces +larger than 18~bits, such as the DEC VAX and +the S-1~Mark~IIA. +For further information about S-1 Common Lisp, see S-1 Common Lisp Implementation. +

    +

    The Lisp machine concept was developed in the late 1960’s. In the +early 1970’s, Peter Deutsch, working with +Daniel Bobrow, implemented a Lisp on the +Alto, a single-user minicomputer, using microcode to interpret a +byte-code implementation language. Shortly thereafter, Richard +Greenblatt began work on a different hardware and instruction set +design at MIT. +Although the Alto was not a total success as a Lisp machine, a dialect +of Interlisp known as Interlisp-D became available on the D-series +machines manufactured by Xerox—the Dorado, Dandelion, +Dandetiger, and Dove (or Daybreak). +An upward-compatible extension of MacLisp called Lisp +Machine Lisp became available on the early MIT Lisp Machines. +Commercial Lisp machines from Xerox, Lisp Machines (LMI), and +Symbolics were on the market by 1981. +For further information about Lisp Machine Lisp, see Lisp Machine Manual. +

    +

    During the late 1970’s, Lisp Machine Lisp began to expand towards a +much fuller language. Sophisticated lambda lists, +setf, multiple values, and structures +like those in Common Lisp are the results of early +experimentation with programming styles by the Lisp Machine group. +Jonl White and others migrated these features to MacLisp. +Around 1980, Scott Fahlman and others at CMU began work on a Lisp to +run on the Scientific Personal Integrated Computing +Environment (SPICE) workstation. One of the goals of the project was to +design a simpler dialect than Lisp Machine Lisp. +

    +

    The Macsyma group at MIT began a project during the late 1970’s called +the New Implementation of Lisp (NIL) for the VAX, which was headed by +White. One of the stated goals of the NIL project was to fix many of +the historic, but annoying, problems with Lisp while retaining significant +compatibility with MacLisp. At about the same time, a research group at +Stanford University and Lawrence Livermore National Laboratory headed +by Richard P. Gabriel began the design of a Lisp to run on the +S-1~Mark~IIA supercomputer. S-1~Lisp, never completely +functional, was the test bed for adapting advanced compiler techniques +to Lisp implementation. Eventually the S-1 and NIL groups +collaborated. +For further information about the NIL project, +see NIL—A Perspective. +

    +

    The first effort towards Lisp standardization was made in 1969, +when Anthony Hearn and Martin Griss at the University of Utah +defined Standard Lisp—a subset of Lisp~1.5 and other dialects—to +transport REDUCE, a symbolic algebra system. +During the 1970’s, the Utah group implemented first a retargetable +optimizing compiler for Standard Lisp, +and then an extended implementation known as Portable Standard Lisp (PSL). +By the mid 1980’s, PSL ran on about a dozen kinds of computers. +For further information about Standard Lisp, see Standard LISP Report. +

    +

    PSL and Franz Lisp—a MacLisp-like dialect for Unix machines—were +the first examples of widely available Lisp dialects on multiple +hardware platforms. +

    +

    One of the most important developments in Lisp occurred during the +second half of the 1970’s: Scheme. Scheme, designed by Gerald J. +Sussman and Guy L. Steele Jr., is a simple dialect of Lisp whose +design brought to Lisp some of the ideas from programming language +semantics developed in the 1960’s. Sussman was one of the prime +innovators behind many other advances in Lisp technology from the late +1960’s through the 1970’s. +The major contributions of Scheme were lexical scoping, lexical +closures, first-class continuations, and simplified syntax (no +separation of value cells and function cells). Some of these contributions made +a large impact on the design of Common Lisp. +For further information about Scheme, see IEEE Standard for the Scheme Programming Language +or Revised^3 Report on the Algorithmic Language Scheme. +

    +

    In the late 1970’s object-oriented programming concepts started to +make a strong impact on Lisp. +At MIT, certain ideas from Smalltalk made their way into several +widely used programming systems. +Flavors, an object-oriented programming system with multiple inheritance, +was developed at MIT for the Lisp machine community by Howard Cannon and others. +At Xerox, the experience with Smalltalk and +Knowledge Representation Language (KRL) led to the development of +Lisp Object Oriented Programming System (LOOPS) and later Common LOOPS. +For further information on Smalltalk, see Smalltalk-80: The Language and its Implementation. +For further information on Flavors, see Flavors: A Non-Hierarchical Approach to Object-Oriented Programming. +

    +

    These systems influenced the design of the Common Lisp Object System (CLOS). +CLOS was developed specifically for this standardization effort, +and was separately written up in Common Lisp Object System Specification. +However, minor details +of its design have changed slightly since that publication, and that paper +should not be taken as an authoritative reference to the semantics of the +object system as described in this document. +

    +

    In 1980 Symbolics and LMI were developing Lisp Machine Lisp; stock-hardware +implementation groups were developing NIL, Franz Lisp, and PSL; Xerox +was developing Interlisp; and the SPICE project at CMU was developing +a MacLisp-like dialect of Lisp called SpiceLisp. +

    +

    In April 1981, after a DARPA-sponsored meeting concerning the +splintered Lisp community, Symbolics, the SPICE project, the NIL +project, and the S-1~Lisp project joined together to define +Common Lisp. Initially spearheaded by White and Gabriel, the +driving force behind this grassroots effort was provided by Fahlman, +Daniel Weinreb, David Moon, Steele, and Gabriel. +Common Lisp was designed as a description of a family of languages. The +primary influences on Common Lisp were Lisp Machine Lisp, MacLisp, NIL, +S-1~Lisp, Spice Lisp, and Scheme. +Common Lisp: The Language is a description of that design. Its +semantics were intentionally underspecified in places where it was +felt that a tight specification would overly constrain Common Lisp +research and use. +

    +

    In 1986 X3J13 was formed as a technical working group to +produce a draft for an ANSI Common Lisp standard. Because of the +acceptance of Common Lisp, the goals of this group differed from those of +the original designers. These new goals included stricter +standardization for portability, an object-oriented programming +system, a condition system, iteration facilities, and a way to handle +large character sets. To accommodate those +goals, a new language specification, this +document, was developed. +

    + +
    +
    +

    +Previous: , Up: Scope  

    +
    + + + + + diff --git a/info/gcl/Identity-of-Characters.html b/info/gcl/Identity-of-Characters.html new file mode 100644 index 0000000..0d05f90 --- /dev/null +++ b/info/gcl/Identity-of-Characters.html @@ -0,0 +1,54 @@ + + + + + +Identity of Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.5 Identity of Characters

    + +

    Two characters that are eql, char=, or char-equal +are not necessarily eq. +

    + + + + + diff --git a/info/gcl/Implementation-Limits-on-Array-Rank.html b/info/gcl/Implementation-Limits-on-Array-Rank.html new file mode 100644 index 0000000..1301fbb --- /dev/null +++ b/info/gcl/Implementation-Limits-on-Array-Rank.html @@ -0,0 +1,54 @@ + + + + + +Implementation Limits on Array Rank (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.9 Implementation Limits on Array Rank

    + +

    An implementation may impose a limit on the rank of an array, +but there is a minimum requirement on that limit. See the variable array-rank-limit. +

    + + + + + diff --git a/info/gcl/Implementation-Limits-on-Individual-Array-Dimensions.html b/info/gcl/Implementation-Limits-on-Individual-Array-Dimensions.html new file mode 100644 index 0000000..60ec739 --- /dev/null +++ b/info/gcl/Implementation-Limits-on-Individual-Array-Dimensions.html @@ -0,0 +1,54 @@ + + + + + +Implementation Limits on Individual Array Dimensions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.3 Implementation Limits on Individual Array Dimensions

    + +

    An implementation may impose a limit on dimensions of an array, +but there is a minimum requirement on that limit. See the variable array-dimension-limit. +

    + + + + + diff --git a/info/gcl/Implementation_002dDefined-Packages.html b/info/gcl/Implementation_002dDefined-Packages.html new file mode 100644 index 0000000..4c450c2 --- /dev/null +++ b/info/gcl/Implementation_002dDefined-Packages.html @@ -0,0 +1,60 @@ + + + + + +Implementation-Defined Packages (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.9 Implementation-Defined Packages

    + +

    Other, implementation-defined packages might be present +in the initial Common Lisp environment. +

    +

    It is recommended, but not required, that the documentation for a +conforming implementation contain a full list of all package names +initially present in that implementation but not specified in this specification. +(See also the function list-all-packages.) +

    + + + + + + diff --git a/info/gcl/Implementation_002dDependent-Numeric-Constants.html b/info/gcl/Implementation_002dDependent-Numeric-Constants.html new file mode 100644 index 0000000..2680258 --- /dev/null +++ b/info/gcl/Implementation_002dDependent-Numeric-Constants.html @@ -0,0 +1,73 @@ + + + + + +Implementation-Dependent Numeric Constants (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    +
    +

    12.1.2 Implementation-Dependent Numeric Constants

    + +

    Figure 12–7 shows defined names relating to +implementation-dependent details about numbers. +

    +
    +
      double-float-epsilon           most-negative-fixnum           
+  double-float-negative-epsilon  most-negative-long-float       
+  least-negative-double-float    most-negative-short-float      
+  least-negative-long-float      most-negative-single-float     
+  least-negative-short-float     most-positive-double-float     
+  least-negative-single-float    most-positive-fixnum           
+  least-positive-double-float    most-positive-long-float       
+  least-positive-long-float      most-positive-short-float      
+  least-positive-short-float     most-positive-single-float     
+  least-positive-single-float    short-float-epsilon            
+  long-float-epsilon             short-float-negative-epsilon   
+  long-float-negative-epsilon    single-float-epsilon           
+  most-negative-double-float     single-float-negative-epsilon  
+
+  Figure 12–7: Defined names relating to implementation-dependent details about numbers.
+
+
    + + + + + + diff --git a/info/gcl/Implications-of-Strings-Being-Arrays.html b/info/gcl/Implications-of-Strings-Being-Arrays.html new file mode 100644 index 0000000..b24d006 --- /dev/null +++ b/info/gcl/Implications-of-Strings-Being-Arrays.html @@ -0,0 +1,60 @@ + + + + + +Implications of Strings Being Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: String Concepts  

    +
    +
    +

    16.1.1 Implications of Strings Being Arrays

    + +

    Since all strings are arrays, all rules which apply +generally to arrays also apply to strings. +See Array Concepts. +

    +

    For example, + strings can have fill pointers, + and strings are also subject to the rules of element type upgrading + that apply to arrays. +

    + + + + + diff --git a/info/gcl/Indirection-in-Modified-BNF-Syntax.html b/info/gcl/Indirection-in-Modified-BNF-Syntax.html new file mode 100644 index 0000000..97d529e --- /dev/null +++ b/info/gcl/Indirection-in-Modified-BNF-Syntax.html @@ -0,0 +1,65 @@ + + + + + +Indirection in Modified BNF Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.4 Indirection in Modified BNF Syntax

    + +

    An indirection extension is introduced in order to make this +new syntax more readable: +

    +
    !O +
    +

    If O is a non-terminal symbol, the right-hand side +of its definition is substituted for the entire expression +!O. For example, the following BNF is equivalent to +the BNF in the previous example: +

    +

    (x [[!O]] y) +

    +

    O ::=A | B* | C +

    + + + + + diff --git a/info/gcl/Inheritance-of-Class-Options.html b/info/gcl/Inheritance-of-Class-Options.html new file mode 100644 index 0000000..14c737e --- /dev/null +++ b/info/gcl/Inheritance-of-Class-Options.html @@ -0,0 +1,64 @@ + + + + + +Inheritance of Class Options (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Inheritance  

    +
    +
    +

    4.3.4.2 Inheritance of Class Options

    + +

    The :default-initargs class option is inherited. The set of +defaulted initialization arguments for a class is the union of the +sets of initialization arguments supplied in +the :default-initargs class options of the class and its superclasses. +When more than one default initial value form is supplied for a given +initialization argument, the default initial value form that is used +is the one supplied by the class that is most specific according to +the class precedence list. +

    +

    If a given :default-initargs class option specifies an +initialization argument of the same name more than once, an +error of type program-error is signaled. +

    + + + + + diff --git a/info/gcl/Inheritance-of-Methods.html b/info/gcl/Inheritance-of-Methods.html new file mode 100644 index 0000000..2b00796 --- /dev/null +++ b/info/gcl/Inheritance-of-Methods.html @@ -0,0 +1,62 @@ + + + + + +Inheritance of Methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Generic Functions and Methods  

    +
    +
    +

    7.6.7 Inheritance of Methods

    + +

    A subclass inherits methods in the sense that any method applicable to +all instances of a class is also applicable to all instances of any +subclass of that class. +

    +

    The inheritance of methods acts the same way regardless of +which of the method-defining operators created the methods. +

    +

    The inheritance of methods is described in detail in +Method Selection and Combination. +

    + + + + + + diff --git a/info/gcl/Inheritance-of-Slots-and-Slot-Options.html b/info/gcl/Inheritance-of-Slots-and-Slot-Options.html new file mode 100644 index 0000000..6e619fa --- /dev/null +++ b/info/gcl/Inheritance-of-Slots-and-Slot-Options.html @@ -0,0 +1,179 @@ + + + + + +Inheritance of Slots and Slot Options (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Slots  

    +
    +
    +

    7.5.3 Inheritance of Slots and Slot Options

    + +

    The set of the names of all slots accessible +in an instance of a class C is the union of +the sets of names of slots defined by C and its +superclasses. The structure of an instance is +the set of names of local slots in that instance. +

    +

    In the simplest case, only one class among C and its superclasses +defines a slot with a given slot name. +If a slot is defined by a superclass of C, +the slot is said to be inherited. The characteristics +of the slot are determined by the slot specifier +of the defining class. +Consider the defining class for +a slot S. If the value of the :allocation +slot +option is :instance, then S is a local slot and each +instance +of C has its own slot named S that stores its own value. If the +value of the :allocation slot +option is :class, then S +is a shared slot, the class +that defined S stores the value, and all +instances of C can access that single slot. +If the :allocation slot option is omitted, :instance is used. +

    +

    In general, more than one class among C and its +superclasses can +define a slot with a given name. +In such cases, only one slot with +the given name is accessible in an instance +of C, and +the characteristics of that slot are +a combination of the several slot +specifiers, computed as follows: +

    +
    +
    *
    +

    All the slot specifiers for a given slot name +are ordered from most specific to least specific, according to the order in C’s +class precedence list of the classes that define them. All references +to the specificity of slot specifiers immediately below refers to this +ordering. +

    +
    +
    *
    +

    The allocation of a slot is controlled by the most +specific slot specifier. If the most specific slot specifier +does not contain an :allocation slot option, :instance is used. +Less specific slot specifiers do not affect the allocation. +

    +
    +
    *
    +

    The default initial value form for a slot +is the value of the :initform slot option in the most specific +slot specifier that contains one. If no slot specifier +contains an :initform slot option, the slot +has no default initial value form. +

    +
    +
    *
    +

    The contents of a slot will always be of type +(and T_1 ... T_n) where T_1 ... T_n are +the values of the :type slot options contained in all of the +slot specifiers. If no slot specifier contains the +:type slot option, the contents of the slot will always be +of type t. The consequences of attempting to store in a slot +a value that does not satisfy the type of the slot are undefined. +

    +
    +
    *
    +

    The set of initialization arguments that initialize a +given slot is the union of the initialization arguments declared in +the :initarg slot options in all the slot specifiers. +

    +
    +
    *
    +

    The documentation string for a slot is the value of +the :documentation slot option in the most specific slot +specifier that contains one. If no slot specifier contains a +:documentation slot option, the slot has no documentation string. +

    +
    +
    + +

    A consequence of the allocation rule is that a shared slot can be +shadowed. For example, if a class C_1 defines +a slot named S +whose value for the :allocation slot option is :class, +that slot is accessible +in instances of C_1 and all of its +subclasses. However, if C_2 is a subclass +of C_1 and also +defines a slot named S, C_1’s +slot is not shared +by instances of C_2 and its subclasses. When a class +C_1 defines a shared slot, any subclass C_2 of C_1 will share this single slot +unless the defclass form for +C_2 specifies a slot of the same +name or there is a superclass +of C_2 that precedes C_1 in the class precedence list of +C_2 that defines a slot of the same name. +

    +

    A consequence of the type rule is that the value of a slot +satisfies the type constraint of each slot specifier that +contributes to that slot. Because the result of attempting to +store in a slot a value that does not satisfy the type +constraint for the slot is undefined, the value in a slot +might fail to satisfy its type constraint. +

    +

    The :reader, :writer, and :accessor slot options +create methods rather than define the characteristics of a slot. +Reader and writer methods are inherited in the sense described in +Inheritance of Methods. +

    +

    Methods that access slots use only the name of the +slot and the type of the slot’s value. Suppose +a superclass provides a method that expects to access a +shared slot of a given name, and a subclass defines +a local slot with the same name. If the method provided +by the superclass is used on an instance of the subclass, +the method accesses the local slot. +

    + +
    +
    +

    +Previous: , Up: Slots  

    +
    + + + + + diff --git a/info/gcl/Inheritance.html b/info/gcl/Inheritance.html new file mode 100644 index 0000000..b0ac654 --- /dev/null +++ b/info/gcl/Inheritance.html @@ -0,0 +1,64 @@ + + + + + +Inheritance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Classes  

    +
    +
    +

    4.3.4 Inheritance

    + +

    A class can inherit methods, slots, +and some defclass options from its superclasses. +Other sections describe the inheritance of methods, +the inheritance of slots and slot options, +and the inheritance of class options. +

    + + + +
    • Examples of Inheritance   +
    • Inheritance of Class Options   +
    + + + + + + diff --git a/info/gcl/Initial-and-Final-Execution.html b/info/gcl/Initial-and-Final-Execution.html new file mode 100644 index 0000000..137205d --- /dev/null +++ b/info/gcl/Initial-and-Final-Execution.html @@ -0,0 +1,96 @@ + + + + + +Initial and Final Execution (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Miscellaneous Clauses  

    +
    +
    +

    6.1.7.3 Initial and Final Execution

    + +

    The initially and finally constructs +evaluate forms that occur before and after the loop body. +

    +

    The initially construct causes the supplied +compound-forms +to be evaluated +in the loop prologue, which precedes all loop code except for +initial settings supplied by constructs with, for, or +as. + The code for any initially clauses is +executed +in the order in which the clauses appeared in + the loop. +

    +

    The finally construct causes the supplied +compound-forms +to be evaluated +in the loop epilogue after normal iteration terminates. + The code for any finally clauses is +executed + in the order in which the clauses appeared in + the loop. The collected code is executed once in the loop epilogue + before any implicit values are returned from the accumulation clauses. +An explicit transfer of control (e.g., by return, go, or throw) +from the loop body, however, will exit the + loop without executing the epilogue code. +

    +

    Clauses such as return, always, never, and +thereis +can bypass the finally clause. +

    +

    return (or return-from, if the named option was supplied) +

    +

    can be used after finally to return values from a loop. +

    +

    Such an explicit return +

    +

    inside the +finally clause takes precedence over returning the accumulation +from clauses supplied by such keywords as collect, nconc, +append, sum, count, maximize, and +minimize; +the accumulation values for these preempted clauses are not returned by +loop if return or return-from is used. +

    + + + + + diff --git a/info/gcl/Initialization-Arguments.html b/info/gcl/Initialization-Arguments.html new file mode 100644 index 0000000..eaf02c1 --- /dev/null +++ b/info/gcl/Initialization-Arguments.html @@ -0,0 +1,108 @@ + + + + + +Initialization Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    +
    +

    7.1.1 Initialization Arguments

    + +

    An initialization argument controls object creation and +initialization. It is often convenient to use keyword symbols +to name initialization arguments, but the name of an +initialization argument can be any symbol, including nil. An +initialization argument can be used in two ways: to fill a slot +with a value or to provide an argument for an initialization +method. A single initialization argument can be used for both +purposes. +

    +

    An initialization argument list is a +property list of +initialization argument names and values. +Its structure is identical +to a property list and also +to the portion of an argument list +processed for &key parameters. +As in those lists, +if an initialization +argument name appears more than once in an initialization argument list, +the leftmost occurrence supplies the value and the remaining occurrences +are ignored. The arguments to make-instance (after the first +argument) form an initialization argument list. +

    +

    An initialization argument can be associated with a slot. If +the initialization argument has a value in the initialization +argument list, the value is stored into the slot of the newly +created object, overriding any :initform form associated +with the slot. A single initialization argument can initialize +more than one slot. An initialization argument that initializes +a shared slot stores its value into the shared slot, +replacing any previous value. +

    +

    An initialization argument can be associated with a method. When +an object is created and a particular initialization argument is +supplied, the generic functions initialize-instance, +shared-initialize, and allocate-instance are called +with that initialization argument’s name and value as a keyword argument +pair. If a value for the initialization argument is not supplied in the +initialization argument list, the method’s +lambda list supplies a default value. +

    +

    Initialization arguments are used in four situations: when making an +instance, when re-initializing an instance, when updating +an instance to conform to a redefined class, and when +updating an instance to conform to the definition of a different +class. +

    +

    Because initialization arguments are used to control the creation and +initialization of an instance of some particular class, +we say that an initialization argument is +“an initialization argument for” that class. +

    +
    +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    + + + + + diff --git a/info/gcl/Initialize_002dInstance.html b/info/gcl/Initialize_002dInstance.html new file mode 100644 index 0000000..e4c5c9a --- /dev/null +++ b/info/gcl/Initialize_002dInstance.html @@ -0,0 +1,119 @@ + + + + + +Initialize-Instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    +
    +

    7.1.6 Initialize-Instance

    + +

    The generic function initialize-instance is called by +make-instance to initialize a newly created instance. +It uses standard method combination. Methods for +initialize-instance can be defined in order to perform any +initialization that cannot be achieved +simply by supplying initial values for slots. +

    +

    During initialization, initialize-instance is invoked +after the following actions have been taken: +

    +
    +
    *
    +

    The defaulted initialization argument list +has been computed by combining the supplied initialization argument list +with any default initialization arguments for the class. +

    +
    +
    *
    +

    The validity of the defaulted initialization argument list +has been checked. If any of the initialization arguments has not +been declared as valid, an error is signaled. +

    +
    +
    *
    +

    A new instance whose slots +are unbound has been created. +

    +
    +
    + +

    The generic function initialize-instance is called with the +new instance and the defaulted initialization arguments. There is +a system-supplied primary method for initialize-instance +whose parameter specializer is the class standard-object. This +method calls the generic function +shared-initialize to fill in +the slots according to the initialization arguments and the +:initform forms for the slots; the generic function +shared-initialize is called with the following arguments: the instance, +t, and the defaulted initialization arguments. +

    +

    Note that initialize-instance provides the +defaulted initialization argument list in its call to shared-initialize, +so the first step performed by the system-supplied primary method for +shared-initialize takes into account both the initialization +arguments provided in the call to make-instance and the +defaulted initialization argument list. +

    +

    Methods for initialize-instance can be defined to specify +actions to be taken when an instance is initialized. +If only after methods for initialize-instance are defined, they will be +run after the system-supplied primary method for initialization and +therefore will not interfere with the default behavior of +initialize-instance. +

    +

    The object system provides two functions that are useful in the bodies of +initialize-instance methods. The function slot-boundp +returns a generic boolean value that indicates whether a specified slot has a +value; this provides a mechanism for writing after methods for +initialize-instance that initialize slots only if they have +not already been initialized. The function slot-makunbound +causes the slot to have no value. +

    +
    +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    + + + + + diff --git a/info/gcl/Initializing-Newly-Added-Local-Slots-_0028Changing-the-Class-of-an-Instance_0029.html b/info/gcl/Initializing-Newly-Added-Local-Slots-_0028Changing-the-Class-of-an-Instance_0029.html new file mode 100644 index 0000000..c2ff587 --- /dev/null +++ b/info/gcl/Initializing-Newly-Added-Local-Slots-_0028Changing-the-Class-of-an-Instance_0029.html @@ -0,0 +1,81 @@ + + + + + +Initializing Newly Added Local Slots (Changing the Class of an Instance) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Changing the Class of an Instance  

    +
    +
    +

    7.2.2 Initializing Newly Added Local Slots

    + +

    The second step of the update initializes the newly added slots and +performs any other user-defined actions. This step is implemented by +the generic function update-instance-for-different-class. The +generic function update-instance-for-different-class is invoked +by change-class after the first step of the update has been +completed. +

    +

    The generic function update-instance-for-different-class is +invoked on arguments computed by change-class. +The first argument passed is a copy of the instance being updated +and is an instance of the class C_{from}; +this copy has dynamic extent within the generic function change-class. +The second argument is the instance as updated so far by change-class +and is an instance of the class C_{to}. +The remaining arguments are an initialization argument list. +

    +

    There is a system-supplied primary method for +update-instance-for-different-class that has two parameter +specializers, each of which is the class standard-object. First +this method checks the validity of initialization arguments and +signals an error if an initialization argument is supplied that is not +declared as valid. (For more information, see Declaring the Validity of Initialization Arguments.) +Then it calls the +generic function shared-initialize with the following arguments: +the +new +instance, a list of names of the newly added +slots, and the +initialization arguments it received. +

    + + + + + diff --git a/info/gcl/Initializing-Newly-Added-Local-Slots-_0028Redefining-Classes_0029.html b/info/gcl/Initializing-Newly-Added-Local-Slots-_0028Redefining-Classes_0029.html new file mode 100644 index 0000000..0f44cca --- /dev/null +++ b/info/gcl/Initializing-Newly-Added-Local-Slots-_0028Redefining-Classes_0029.html @@ -0,0 +1,86 @@ + + + + + +Initializing Newly Added Local Slots (Redefining Classes) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Redefining Classes  

    +
    +
    +

    4.3.6.2 Initializing Newly Added Local Slots

    + +

    The second step initializes the newly added local slots and performs +any other user-defined actions. This step is implemented by the generic +function update-instance-for-redefined-class, which is called after +completion of the first step of modifying the structure of the +instance. +

    +

    The generic function update-instance-for-redefined-class takes +four required arguments: the instance being updated after it has +undergone the first step, a list of the names of local slots that were +added, a list of the names of local slots that were discarded, and a +property list containing the slot names and values of +slots that were +discarded and had values. Included among the discarded slots are +slots that were local in the old class and that are shared in the new +class. +

    +

    The generic function update-instance-for-redefined-class also +takes any number of initialization arguments. When it is called by +the system to update an instance whose class +has been redefined, no +initialization arguments are provided. +

    +

    There is a system-supplied primary method for +update-instance-for-redefined-class whose parameter specializer +for its instance argument is the class standard-object. +First this method checks the validity of initialization arguments and signals an +error if an initialization argument is supplied that is not declared +as valid. (For more information, see Declaring the Validity of Initialization Arguments.) +Then it calls the generic function +shared-initialize with the following arguments: the +instance, +the list of names of +the newly added slots, and the initialization +arguments it received. +

    + + + + + diff --git a/info/gcl/Input.html b/info/gcl/Input.html new file mode 100644 index 0000000..a910dc3 --- /dev/null +++ b/info/gcl/Input.html @@ -0,0 +1,113 @@ + + + + + +Input (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Streams  

    +
    +
    +

    21.1.1.2 Input, Output, and Bidirectional Streams

    + +

    A stream, whether a character stream or a binary stream, +can be an input + + stream + + (source of data), + an output + + stream + + (sink for data), + both, + or (e.g., when “:direction :probe” is given to open) neither. +

    +

    Figure 21–2 shows operators relating to +input streams. +

    +
    +
      clear-input  read-byte            read-from-string            
+  listen       read-char            read-line                   
+  peek-char    read-char-no-hang    read-preserving-whitespace  
+  read         read-delimited-list  unread-char                 
+
+        Figure 21–2: Operators relating to Input Streams.      
+
+
    + +

    Figure 21–3 shows operators relating to +output streams. +

    +
    +
      clear-output   prin1            write            
+  finish-output  prin1-to-string  write-byte       
+  force-output   princ            write-char       
+  format         princ-to-string  write-line       
+  fresh-line     print            write-string     
+  pprint         terpri           write-to-string  
+
+  Figure 21–3: Operators relating to Output Streams.
+
+
    + +

    A stream that is both an input stream and an output stream +is called a bidirectional + + stream + +. +See the functions input-stream-p and output-stream-p. +

    +

    Any of the operators listed in Figure~21–2 or Figure~21–3 +can be used with bidirectional streams. In addition, Figure 21–4 +shows a list of operators that relate specificaly to +bidirectional streams. +

    +
    +
      y-or-n-p  yes-or-no-p    
+
+  Figure 21–4: Operators relating to Bidirectional Streams.
+
+
    + + + + + + diff --git a/info/gcl/Integrating-Types-and-Classes.html b/info/gcl/Integrating-Types-and-Classes.html new file mode 100644 index 0000000..8f59689 --- /dev/null +++ b/info/gcl/Integrating-Types-and-Classes.html @@ -0,0 +1,187 @@ + + + + + +Integrating Types and Classes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Classes  

    +
    +
    +

    4.3.7 Integrating Types and Classes

    + +

    The object system maps the space of classes into the space of types. +Every class that has a proper name has a corresponding type +with the same name. +

    +

    The proper name of every class is a valid type specifier. In +addition, every class object is a valid type specifier. +Thus the expression (typep object class) evaluates to +true if the class of object is class itself or +a subclass of class. The evaluation of the expression +(subtypep class1 class2) returns the values +true and true if class1 is a subclass of class2 or if they are the +same class; otherwise it returns the values +false and true. +If I is an instance of some class C named S +and C is an instance of standard-class, +the evaluation of the expression (type-of I\/) returns S +if S is the proper name of C; +otherwise, it returns C. +

    +

    Because the names of classes +and class objects are type specifiers, they may +be used in the special form the and in type declarations. +

    +

    Many but not all of the predefined type specifiers have a +corresponding class with +the same proper name as the type. These type +specifiers are listed in Figure~4–8. +For example, the type array has +a corresponding class named array. +No type specifier that is a +list, such as (vector double-float 100), has a corresponding class. +The operator deftype does not create any classes. +

    +

    Each class that corresponds to a predefined type specifier can +be implemented in one of three ways, at the discretion of each implementation. +It can be a standard class, +a structure class, +

    +

    or a system class. +

    +

    A built-in class is one whose generalized instances have restricted capabilities +or special representations. Attempting to use defclass to define +subclasses of a built-in-class signals an error. +Calling make-instance to create a generalized instance of a +built-in class signals an error. Calling slot-value on a +generalized instance of a built-in class signals an error. +Redefining a built-in class or using change-class to change +the class of an object to or from a built-in class signals an error. +However, built-in classes can be used as parameter specializers +in methods. +

    +

    It is possible to determine whether a class is a built-in class +by checking the metaclass. +A standard class is an instance of the class standard-class, +a built-in class is an instance of the class built-in-class, and +a structure class is an instance of the class structure-class. +

    +

    Each structure type created by defstruct without +using the :type option has a corresponding class. +This class is a generalized instance of the class structure-class. +The :include option of defstruct creates a direct +subclass of the class +that corresponds to the included structure +type. +

    +

    It is implementation-dependent whether slots are involved in the +operation of functions defined in this specification +on instances of classes defined in this specification, +except when slots are explicitly defined by this specification. +

    +

    If in a particular implementation a class defined in this specification +has slots that are not defined by this specfication, the names of these slots +must not be external symbols of packages defined in this specification nor +otherwise accessible in the CL-USER package. +

    +

    The purpose of specifying that many of the standard type specifiers have a +corresponding class is to enable users to write methods that +discriminate on these types. Method selection requires that a +class precedence list can be determined for each class. +

    +

    The hierarchical relationships among the type specifiers are mirrored by +relationships among the classes corresponding to those types. +

    +

    Figure~4–8 lists the set of classes +that correspond to predefined type specifiers. +

    +
    +
     arithmetic-error                 generic-function   simple-error              
+ array                            hash-table         simple-type-error         
+ bit-vector                       integer            simple-warning            
+ broadcast-stream                 list               standard-class            
+ built-in-class                   logical-pathname   standard-generic-function 
+ cell-error                       method             standard-method           
+ character                        method-combination standard-object           
+ class                            null               storage-condition         
+ complex                          number             stream                    
+ concatenated-stream              package            stream-error              
+ condition                        package-error      string                    
+ cons                             parse-error        string-stream             
+ control-error                    pathname           structure-class           
+ division-by-zero                 print-not-readable structure-object          
+ echo-stream                      program-error      style-warning             
+ end-of-file                      random-state       symbol                    
+ error                            ratio              synonym-stream            
+ file-error                       rational           t                         
+ file-stream                      reader-error       two-way-stream            
+ float                            readtable          type-error                
+ floating-point-inexact           real               unbound-slot              
+ floating-point-invalid-operation restart            unbound-variable          
+ floating-point-overflow          sequence           undefined-function        
+ floating-point-underflow         serious-condition  vector                    
+ function                         simple-condition   warning                   
+
+       Figure 4–8: Classes that correspond to pre-defined type specifiers      
+
+
    + +

    The class precedence list information specified in the entries for +each of these classes are those that are required by the object system. +

    +

    Individual implementations may be extended to define other type +specifiers to have a corresponding class. Individual implementations +may be extended to add other subclass relationships and to add other +elements to the class precedence lists as long as +they do not violate the type relationships and disjointness +requirements specified by this standard. +A standard class defined with no direct superclasses is guaranteed to +be disjoint from all of the classes in the table, except for the +class named t. +

    + +
    +
    +

    +Previous: , Up: Classes  

    +
    + + + + + diff --git a/info/gcl/Interactive-Streams.html b/info/gcl/Interactive-Streams.html new file mode 100644 index 0000000..967974c --- /dev/null +++ b/info/gcl/Interactive-Streams.html @@ -0,0 +1,88 @@ + + + + + +Interactive Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Streams  

    +
    +
    +

    21.1.1.4 Interactive Streams

    + +

    An interactive stream + + is one on which it makes sense to perform +interactive querying. +

    +

    The precise meaning of an interactive stream is +implementation-defined, and may depend on the underlying +operating system. Some examples of the things that an +implementation might choose to use as identifying characteristics +of an interactive stream include: +

    +
    +
    *
    +

    The stream is connected to a person (or equivalent) in such a way + that the program can prompt for information and expect to receive different + input depending on the prompt. +

    +
    +
    *
    +

    The program is expected to prompt for input and support “normal input editing”. +

    +
    +
    *
    +

    read-char might wait for the user to type something before returning + instead of immediately returning a character or end-of-file. +

    +
    +
    + +

    The general intent of having some streams be classified as +interactive streams is to allow them to be distinguished from +streams containing batch (or background or command-file) input. +Output to batch streams is typically discarded or saved for later viewing, +so interactive queries to such streams might not have the expected effect. +

    +

    Terminal I/O might or might not be an interactive stream. +

    + + + + + diff --git a/info/gcl/Interactive-Use-of-Restarts.html b/info/gcl/Interactive-Use-of-Restarts.html new file mode 100644 index 0000000..57c6c5e --- /dev/null +++ b/info/gcl/Interactive-Use-of-Restarts.html @@ -0,0 +1,77 @@ + + + + + +Interactive Use of Restarts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Signaling and Handling Conditions  

    +
    +
    +

    9.1.4.4 Interactive Use of Restarts

    + +

    For interactive handling, two pieces of information are needed +from a restart: a report function and an interactive function. +

    +

    The report function +is used by a program such as the debugger to +present a description of the action the restart will take. +The report function is specified and established by the +:report-function keyword to +restart-bind or the +:report keyword to restart-case. +

    +

    The interactive function, which can be specified using the +:interactive-function keyword to +restart-bind or :interactive keyword +to restart-case, is used when the restart +is invoked +interactively, such as from the debugger, to produce a suitable +list of arguments. +

    +

    invoke-restart invokes the most recently established +restart whose +name is the same as the first argument to invoke-restart. +If a restart is invoked interactively by the debugger and does +not transfer control but rather returns values, the precise +action of the debugger on those values is implementation-defined. +

    + + + + + diff --git a/info/gcl/Interfaces-to-Restarts.html b/info/gcl/Interfaces-to-Restarts.html new file mode 100644 index 0000000..0d3cb59 --- /dev/null +++ b/info/gcl/Interfaces-to-Restarts.html @@ -0,0 +1,74 @@ + + + + + +Interfaces to Restarts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Signaling and Handling Conditions  

    +
    +
    +

    9.1.4.5 Interfaces to Restarts

    + +

    Some restarts have functional interfaces, +such as abort, continue, +muffle-warning, store-value, and +use-value. +They are ordinary functions that use + find-restart and invoke-restart internally, +that have the same name as the restarts they manipulate, +and that are provided simply for notational convenience. +

    +

    Figure 9–6 shows defined names relating to +restarts. +

    +
    +
      abort             invoke-restart-interactively  store-value          
+  compute-restarts  muffle-warning                use-value            
+  continue          restart-bind                  with-simple-restart  
+  find-restart      restart-case                                       
+  invoke-restart    restart-name                                       
+
+            Figure 9–6: Defined names relating to restarts.           
+
+
    + + + + + + diff --git a/info/gcl/Internal-Time.html b/info/gcl/Internal-Time.html new file mode 100644 index 0000000..978d91e --- /dev/null +++ b/info/gcl/Internal-Time.html @@ -0,0 +1,68 @@ + + + + + +Internal Time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Time  

    +
    +
    +

    25.1.4.3 Internal Time

    + +

    Internal time + + represents time as a single integer, +in terms of an implementation-dependent unit called an internal time unit. +Relative time is measured as a number of these units. +Absolute time is relative to an arbitrary time base. +

    +

    Figure 25–7 shows defined names related to internal time. +

    +
    +
      get-internal-real-time  internal-time-units-per-second  
+  get-internal-run-time                                   
+
+  Figure 25–7: Defined names involving time in Internal Time.
+
+
    + + + + + + diff --git a/info/gcl/Internal-and-External-Symbols.html b/info/gcl/Internal-and-External-Symbols.html new file mode 100644 index 0000000..018d4ae --- /dev/null +++ b/info/gcl/Internal-and-External-Symbols.html @@ -0,0 +1,71 @@ + + + + + +Internal and External Symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Packages  

    +
    +
    +

    11.1.1.3 Internal and External Symbols

    + +

    The mappings in a package are divided into two classes, external and internal. +The symbols targeted by these different mappings +are called external symbols and internal symbols + + of the +package. Within a package, a name refers to one +symbol or to none; if it does refer +to a symbol, then it is either external or internal in that +package, but not both. +External symbols + +

    +

    are part of the package’s public interface to other packages. +Symbols become external symbols of a given +package if they have been exported from that package. +

    +

    A symbol has the same name no matter what package +it is present in, but it might be an external symbol of some packages +and an internal symbol of others. +

    + + + + + diff --git a/info/gcl/Interning-a-Symbol-in-the-KEYWORD-Package.html b/info/gcl/Interning-a-Symbol-in-the-KEYWORD-Package.html new file mode 100644 index 0000000..5a48c63 --- /dev/null +++ b/info/gcl/Interning-a-Symbol-in-the-KEYWORD-Package.html @@ -0,0 +1,57 @@ + + + + + +Interning a Symbol in the KEYWORD Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.7 Interning a Symbol in the KEYWORD Package

    + +

    The KEYWORD package is treated differently than other packages +in that special actions are taken when a symbol is interned in it. +In particular, when a symbol is interned in the KEYWORD package, + it is automatically made to be an external symbol +and is automatically made to be a constant variable with itself as a value. +

    + + + + + diff --git a/info/gcl/Interpretation-of-Tokens.html b/info/gcl/Interpretation-of-Tokens.html new file mode 100644 index 0000000..385ad57 --- /dev/null +++ b/info/gcl/Interpretation-of-Tokens.html @@ -0,0 +1,67 @@ + + + + + +Interpretation of Tokens (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax  

    +
    +
    +

    2.3 Interpretation of Tokens

    + + + + + + + + + +
    • Numbers as Tokens   +
    • Constructing Numbers from Tokens   +
    • The Consing Dot   +
    • Symbols as Tokens   +
    • Valid Patterns for Tokens   +
    • Package System Consistency Rules   +
    + + + + + + diff --git a/info/gcl/Interpreting-Dictionary-Entries.html b/info/gcl/Interpreting-Dictionary-Entries.html new file mode 100644 index 0000000..a2f1975 --- /dev/null +++ b/info/gcl/Interpreting-Dictionary-Entries.html @@ -0,0 +1,132 @@ + + + + + +Interpreting Dictionary Entries (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Definitions  

    +
    +
    +

    1.4.4 Interpreting Dictionary Entries

    + +

    The dictionary entry for each defined name is partitioned into +sections. Except as explicitly indicated otherwise below, each section +is introduced by a label identifying that section. The omission of a +section implies that the section is either not applicable, or would +provide no interesting information. +

    +

    This section defines the significance of each potential section in a +dictionary entry. +

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • The "Affected By" Section of a Dictionary Entry   +
    • The "Arguments" Section of a Dictionary Entry   +
    • The "Arguments and Values" Section of a Dictionary Entry   +
    • The "Binding Types Affected" Section of a Dictionary Entry   +
    • The "Class Precedence List" Section of a Dictionary Entry   +
    • Dictionary Entries for Type Specifiers   +
    • The "Compound Type Specifier Kind" Section of a Dictionary Entry   +
    • The "Compound Type Specifier Syntax" Section of a Dictionary Entry   +
    • The "Compound Type Specifier Arguments" Section of a Dictionary Entry   +
    • The "Compound Type Specifier Description" Section of a Dictionary Entry   +
    • The "Constant Value" Section of a Dictionary Entry   +
    • The "Description" Section of a Dictionary Entry   +
    • The "Examples" Section of a Dictionary Entry   +
    • The "Exceptional Situations" Section of a Dictionary Entry   +
    • The "Initial Value" Section of a Dictionary Entry   +
    • The "Argument Precedence Order" Section of a Dictionary Entry   +
    • The "Method Signature" Section of a Dictionary Entry   +
    • The "Name" Section of a Dictionary Entry   +
    • The "Notes" Section of a Dictionary Entry   +
    • The "Pronunciation" Section of a Dictionary Entry   +
    • The "See Also" Section of a Dictionary Entry   +
    • The "Side Effects" Section of a Dictionary Entry   +
    • The "Supertypes" Section of a Dictionary Entry   +
    • The "Syntax" Section of a Dictionary Entry   +
    • Special "Syntax" Notations for Overloaded Operators   +
    • Naming Conventions for Rest Parameters   +
    • Requiring Non-Null Rest Parameters in The "Syntax" Section   +
    • Return values in The "Syntax" Section   +
    • No Arguments or Values in The "Syntax" Section   +
    • Unconditional Transfer of Control in The "Syntax" Section   +
    • The "Valid Context" Section of a Dictionary Entry   +
    • The "Value Type" Section of a Dictionary Entry   +
    + +
    +
    +

    +Previous: , Up: Definitions  

    +
    + + + + + diff --git a/info/gcl/Interpreting-Pathname-Component-Values.html b/info/gcl/Interpreting-Pathname-Component-Values.html new file mode 100644 index 0000000..0577c3a --- /dev/null +++ b/info/gcl/Interpreting-Pathname-Component-Values.html @@ -0,0 +1,101 @@ + + + + + +Interpreting Pathname Component Values (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pathnames  

    +
    +
    +

    19.2.2 Interpreting Pathname Component Values

    + + + + + + + + + + + + + + + + + + + + + + + +
    • Strings in Component Values   +
    • Special Characters in Pathname Components   +
    • Case in Pathname Components   +
    • Local Case in Pathname Components   +
    • Common Case in Pathname Components   +
    • Special Pathname Component Values   +
    • NIL as a Component Value   +
    • ->WILD as a Component Value   +
    • ->UNSPECIFIC as a Component Value   +
    • Relation between component values NIL and ->UNSPECIFIC   +
    • Restrictions on Wildcard Pathnames   +
    • Restrictions on Examining Pathname Components   +
    • Restrictions on Examining a Pathname Host Component   +
    • Restrictions on Examining a Pathname Device Component   +
    • Restrictions on Examining a Pathname Directory Component   +
    • Directory Components in Non-Hierarchical File Systems   +
    • Restrictions on Examining a Pathname Name Component   +
    • Restrictions on Examining a Pathname Type Component   +
    • Restrictions on Examining a Pathname Version Component   +
    • Notes about the Pathname Version Component   +
    • Restrictions on Constructing Pathnames   +
    + +
    +
    +

    +Next: , Previous: , Up: Pathnames  

    +
    + + + + + diff --git a/info/gcl/Interval-Designators.html b/info/gcl/Interval-Designators.html new file mode 100644 index 0000000..4bf77fa --- /dev/null +++ b/info/gcl/Interval-Designators.html @@ -0,0 +1,105 @@ + + + + + +Interval Designators (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    +
    +

    12.1.6 Interval Designators

    + +

    The compound type specifier form of the numeric type specifiers +in Figure 12–10 permit the user to specify an interval on the real number line +which describe a subtype of the type which would be described by the +corresponding atomic type specifier. A subtype of some type +T is specified using an ordered pair of objects called +interval designators for type T. +

    +

    The first of the two interval designators for type T can be +any of the following: +

    +
    +
    a number N of type T
    +

    This denotes a lower inclusive bound of N. That is, elements +of the subtype of T will be greater than or equal to N. +

    +
    +
    a singleton list whose element is
    +

    a number M of type T +This denotes a lower exclusive bound of M. That is, elements +of the subtype of T will be greater than M. +

    +
    +
    the symbol *
    +

    This denotes the absence of a lower bound on the interval. +

    +
    +
    + +

    The second of the two interval designators for type T can be +any of the following: +

    +
    +
    a number N of type T
    +

    This denotes an upper inclusive bound of N. That is, elements +of the subtype of T will be less than or equal to N. +

    +
    +
    a singleton list whose element is
    +

    a number M of type T +This denotes an upper exclusive bound of M. That is, elements +of the subtype of T will be less than M. +

    +
    +
    the symbol *
    +

    This denotes the absence of an upper bound on the interval. +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    + + + + + diff --git a/info/gcl/Introduction-_0028Introduction_0029.html b/info/gcl/Introduction-_0028Introduction_0029.html new file mode 100644 index 0000000..c6d28ba --- /dev/null +++ b/info/gcl/Introduction-_0028Introduction_0029.html @@ -0,0 +1,72 @@ + + + + + +Introduction (Introduction) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    1 Introduction

    + + + + + + + + + + + +
    • Scope   +
    • Organization of the Document   +
    • Referenced Publications   +
    • Definitions   +
    • Conformance   +
    • Language Extensions   +
    • Language Subsets   +
    • Deprecated Language Features   +
    • Symbols in the COMMON-LISP Package   +
    + + + + + + diff --git a/info/gcl/Introduction-_0028Types-and-Classes_0029.html b/info/gcl/Introduction-_0028Types-and-Classes_0029.html new file mode 100644 index 0000000..bdb4cb4 --- /dev/null +++ b/info/gcl/Introduction-_0028Types-and-Classes_0029.html @@ -0,0 +1,109 @@ + + + + + +Introduction (Types and Classes) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes  

    +
    +
    +

    4.1 Introduction

    + + +

    A type is a (possibly infinite) set of objects. +An object can belong to more than one type. +Types are never explicitly represented as objects by Common Lisp. +Instead, they are referred to indirectly by the use of type specifiers, +which are objects that denote types. +

    +

    New types can be defined using deftype, defstruct, +defclass, and define-condition. +

    +

    The function typep, a set membership test, is used to determine +whether a given object is of a given type. The function +subtypep, a subset test, is used to determine whether a +given type is a subtype of another given type. The +function type-of returns a particular type to +which a given object belongs, even though that object +must belong to one or more other types as well. +(For example, every object is of type t, + but type-of always returns a type specifier + for a type more specific than t.) +

    +

    Objects, not variables, have types. +Normally, any variable can have any object as its value. +It is possible to declare that a variable takes on only +values of a given type by making an explicit type declaration. +Types are arranged in a directed acyclic graph, except +for the presence of equivalences. +

    +

    Declarations can be made about types using declare, +proclaim, declaim, or the. +For more information about declarations, +see Declarations. +

    +

    Among the fundamental objects of the object system are classes. +A class determines the structure and behavior of a set of +other objects, which are called its instances. +Every object is a direct instance of a class. +The class of an object determines the set of +operations that can be performed on the object. +For more information, see Classes. +

    +

    It is possible to write functions that have behavior specialized +to the class of the objects which are their arguments. +For more information, see Generic Functions and Methods. +

    +

    The class of the class of an object +is called its metaclass + +. +For more information about metaclasses, +see Meta-Objects. +

    + +
    +
    +

    +Next: , Previous: , Up: Types and Classes  

    +
    + + + + + diff --git a/info/gcl/Introduction-to-Characters.html b/info/gcl/Introduction-to-Characters.html new file mode 100644 index 0000000..aed466d --- /dev/null +++ b/info/gcl/Introduction-to-Characters.html @@ -0,0 +1,92 @@ + + + + + +Introduction to Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.1 Introduction to Characters

    + +

    A character + + is an object that represents a unitary token +(e.g., a letter, a special symbol, or a “control character”) +in an aggregate quantity of text +(e.g., a string or a text stream). +

    +

    Common Lisp allows an implementation to provide support +for international language characters as well +as characters used in specialized arenas (e.g., mathematics). +

    +

    The following figures contain lists of defined names applicable to +characters. +

    +

    Figure 13–1 lists some defined names relating to +character attributes and character predicates. +

    +
    +
      alpha-char-p     char-not-equal     char>            
+  alphanumericp    char-not-greaterp  char>=           
+  both-case-p      char-not-lessp     digit-char-p     
+  char-code-limit  char/=             graphic-char-p   
+  char-equal       char<              lower-case-p     
+  char-greaterp    char<=             standard-char-p  
+  char-lessp       char=              upper-case-p     
+
+       Figure 13–1: Character defined names – 1      
+
+
    + +

    Figure 13–2 lists some character construction and conversion defined names. +

    +
    +
      char-code      char-name    code-char   
+  char-downcase  char-upcase  digit-char  
+  char-int       character    name-char   
+
+  Figure 13–2: Character defined names – 2
+
+
    + + + + + + diff --git a/info/gcl/Introduction-to-Classes.html b/info/gcl/Introduction-to-Classes.html new file mode 100644 index 0000000..7858148 --- /dev/null +++ b/info/gcl/Introduction-to-Classes.html @@ -0,0 +1,178 @@ + + + + + +Introduction to Classes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Classes  

    +
    +
    +

    4.3.1 Introduction to Classes

    + +

    A class + + is an object that determines the structure and behavior +of a set of other objects, which are called its instances + +. +

    +

    A class can inherit structure and behavior from other classes. +A class whose definition refers to other classes for the purpose +of inheriting from them is said to be a subclass of each of +those classes. The classes that are designated for purposes of +inheritance are said to be superclasses of the inheriting class. +

    +

    A class can have a name. The function class-name +takes a class object and returns its name. +The name of an anonymous class is nil. A symbol +can name a class. The function find-class takes a +symbol and returns the class that the symbol names. +A class has a proper name if the name is a symbol +and if the name of the class names that class. +That is, a class~C has the proper name~S if S= +(class-name C) and C= (find-class S). +Notice that it is possible for +(find-class S_1) = (find-class S_2) +and S_1!= S_2. +If C= (find-class S), we say that C is the class named S. +

    +

    A class C_1 is +a direct superclass + + of a class C_2 +if C_2 explicitly designates C_1 +as a superclass in its definition. +In this case C_2 is a direct subclass + + of C_1. +A class C_n is a superclass + + of +a class C_1 if there exists a series of +classes C_2,...,C_{n-1} such that +C_{i+1} is a direct superclass of C_i for 1 <= i<n. +In this case, C_1 is a subclass + + of C_n. +A class is considered neither a superclass nor a subclass of itself. +That is, if C_1 is a superclass of C_2, +then C_1 != C_2. +The set of classes consisting of some given class C +along with all of its superclasses is called “C and its superclasses.” +

    +

    Each class has a class precedence list + +, +which is a total ordering on the set of the given class and its superclasses. +The total ordering is expressed as a list ordered from most specific to least specific. +The class precedence list is used in several ways. In general, more +specific classes can shadow + +_1 features that would +otherwise be inherited from less specific classes. +The method selection and combination process uses +the class precedence list to order methods +from most specific to least specific. +

    +

    When a class is defined, the order in which its direct superclasses +are mentioned in the defining form is important. Each class has a +local precedence order + +, which is a list consisting of the +class followed by its direct superclasses in the order mentioned +in the defining form. +

    +

    A class precedence list is always consistent with the +local precedence order of each class in the list. +The classes in each local precedence order appear +within the class precedence list in the same order. +If the local precedence orders are inconsistent with each other, +no class precedence list can be constructed, and an error is signaled. +The class precedence list and its computation is discussed +in Determining the Class Precedence List. +

    +

    classes are organized into a directed acyclic graph. +There are two distinguished classes, named t and standard-object. +The class named t has no superclasses. +It is a superclass of every class except itself. +The class named standard-object is an instance of +the class standard-class and is a superclass of +every class that is an instance of the class standard-class except itself. +

    +

    [Reviewer Note by Barmar: This or something like it needs to be said in the introduction.] +There is a mapping from the object system class space into +the type space. Many of the standard types specified +in this document have a corresponding class that has the same +name as the type. Some types do not have a +corresponding class. The integration of the type and class +systems is discussed in Integrating Types and Classes. +

    +

    Classes are represented by objects that are themselves +instances of classes. +The class of the class of an object is termed +the metaclass + + of that object. When no misinterpretation is +possible, the term metaclass is used to refer to a class +that has instances that are themselves classes. The metaclass +determines the form of inheritance used by the classes that are its +instances and the representation of the instances of those classes. +The object system provides a default metaclass, standard-class, that is +appropriate for most programs. +

    +

    Except where otherwise specified, all classes mentioned in this +standard are instances of the class standard-class, +all generic functions are instances +of the class standard-generic-function, +and all methods are instances of the class standard-method. +

    + + +
    • Standard Metaclasses   +
    + +
    +
    +

    +Next: , Previous: , Up: Classes  

    +
    + + + + + diff --git a/info/gcl/Introduction-to-Environments.html b/info/gcl/Introduction-to-Environments.html new file mode 100644 index 0000000..7fc83b0 --- /dev/null +++ b/info/gcl/Introduction-to-Environments.html @@ -0,0 +1,83 @@ + + + + + +Introduction to Environments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    +
    +

    3.1.1 Introduction to Environments

    + +

    A binding + + is an association between a name and +that which the name denotes. Bindings are established +in a lexical environment or a dynamic environment +by particular special operators. +

    +

    An environment + + is a set of bindings and other information +used during evaluation (e.g., to associate meanings with names). +

    +

    Bindings in an environment are partitioned into namespaces + +. +A single name can simultaneously have more than one +associated binding per environment, +but can have only one associated binding per namespace. +

    + + + + + + +
    • The Global Environment   +
    • Dynamic Environments   +
    • Lexical Environments   +
    • The Null Lexical Environment   +
    • Environment Objects   +
    + + + + + + diff --git a/info/gcl/Introduction-to-Generic-Functions.html b/info/gcl/Introduction-to-Generic-Functions.html new file mode 100644 index 0000000..618752e --- /dev/null +++ b/info/gcl/Introduction-to-Generic-Functions.html @@ -0,0 +1,157 @@ + + + + + +Introduction to Generic Functions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    +
    +

    7.6.1 Introduction to Generic Functions

    + +

    A generic function + + is a function whose behavior depends on +the classes or identities of the arguments supplied to it. +A generic function object +is associated with + a set of methods, + a lambda list, + a method combination_2, + and other information. +

    +

    Like an ordinary function, a generic function takes arguments, +performs a series of operations, and perhaps returns useful values. +An ordinary function has a single body of code that is always executed +when the function is called. A generic function has a set of bodies +of code of which a subset is selected for execution. The selected +bodies of code and the manner of their combination are determined by +the classes or identities of one or more of the arguments to the +generic function and by its method combination. +

    +

    Ordinary functions and generic functions are called with identical syntax. +

    +

    Generic functions are true functions that can be passed as arguments +and used as the first argument to funcall and apply. +

    +

    A binding of a function name to a generic function +can be established in one of several ways. It can be +established in the global environment by + ensure-generic-function, + defmethod (implicitly, due to ensure-generic-function) +or + defgeneric (also implicitly, due to ensure-generic-function). +

    +

    No standardized mechanism is provided for establishing a +binding of a function name to a generic function +in the lexical environment. +

    +

    When a defgeneric form is evaluated, one of three actions +is taken (due to ensure-generic-function): +

    +
    +
    *
    +

    If a generic function of the given name already exists, +the existing generic function object is modified. Methods specified +by the current defgeneric form are added, and any methods in the +existing generic function that were defined by a previous defgeneric +form are removed. Methods added by the current defgeneric +form might replace methods defined by defmethod, +defclass, define-condition, or defstruct. +No other methods in the generic function are affected +or replaced. +

    +
    +
    *
    +

    If the given name names + an ordinary function, + a macro, + or a special operator, +an error is signaled. +

    +
    +
    *
    +

    Otherwise a generic function is created with the +methods specified by the method definitions in the defgeneric +form. +

    +
    +
    + +

    Some operators permit specification of the options of a +generic function, such as +the type of method combination it uses +or its argument precedence order. +These operators will be referred to as +“operators that specify generic function options.” +

    +

    The only standardized operator in this category is defgeneric. +

    +

    Some operators define methods for a generic function. +These operators will be referred to as +method-defining operators + +; +their associated forms are called method-defining forms. +The standardized method-defining operators are listed in Figure 7–2. +

    +
    +
      defgeneric        defmethod  defclass  
+  define-condition  defstruct            
+
+  Figure 7–2: Standardized Method-Defining Operators
+
+
    + +

    Note that of the standardized method-defining operators +only defgeneric +can specify generic function options. +defgeneric and any implementation-defined operators +that can specify generic function options +are also referred to as “operators that specify generic function options.” +

    +
    +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    + + + + + diff --git a/info/gcl/Introduction-to-Methods.html b/info/gcl/Introduction-to-Methods.html new file mode 100644 index 0000000..decd8ca --- /dev/null +++ b/info/gcl/Introduction-to-Methods.html @@ -0,0 +1,201 @@ + + + + + +Introduction to Methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    +
    +

    7.6.2 Introduction to Methods

    + +

    Methods define the class-specific or identity-specific behavior +and operations of a generic function. +

    +

    A method object +is associated with + code that implements the method’s behavior, + a sequence of parameter specializers + that specify when the given method is applicable, + a lambda list, + and a sequence of qualifiers that are used by the method combination + facility to distinguish among methods. +

    +

    A method object is not a function and cannot be invoked as a function. +Various mechanisms in the object system take a method object and invoke its method +function, as is the case when a generic function is invoked. When this +occurs it is said that the method is invoked or called. +

    +

    A method-defining form contains the code that is to be run when the +arguments to the generic function cause the method that it defines to +be invoked. When a method-defining form is evaluated, a method object +is created and one of four actions is taken: +

    +
    +
    *
    +

    If a generic function of the given name already exists +and if a method object already exists that agrees with the new one on +parameter specializers and qualifiers, the new method object replaces +the old one. For a definition of one method agreeing with another on +parameter specializers and qualifiers, +see Agreement on Parameter Specializers and Qualifiers. +

    +
    +
    *
    +

    If a generic function of the given name already exists +and if there is no method object that agrees with the new one on +parameter specializers and qualifiers, the existing generic function +object is modified to contain the new method object. +

    +
    +
    *
    +

    If the given name names an ordinary function, a macro, +or a special operator, an error is signaled. +

    +
    +
    *
    +

    Otherwise a generic function is created with the method +specified by the method-defining form. +

    +
    +
    + +

    If the lambda list of a new method is not +congruent with the lambda list of the generic function, +an error is signaled. If a method-defining operator that cannot specify +generic function options creates a new generic function, +a lambda list for that generic function is derived from the +lambda list of the method in the method-defining form in such a way +as to be congruent with it. For a discussion of congruence + +, +see Congruent Lambda-lists for all Methods of a Generic Function. +

    +

    Each method has a specialized lambda list, which determines +when that method can be applied. A specialized lambda list is like +an ordinary lambda list except that a specialized parameter +may occur instead of the name of a required parameter. A specialized parameter +is a list (variable-name parameter-specializer-name), +where parameter-specializer-name is one of the following: +

    +
    +
    a symbol
    +

    denotes a parameter specializer which is the class +named by that symbol. +

    +
    +
    a class
    +

    denotes a parameter specializer which is the class itself. +

    +
    +
    (eql form)
    +

    denotes a parameter specializer which satisfies the type specifier +(eql object), where object is the +result of evaluating form. The form form is evaluated in +the lexical environment in which the method-defining form is evaluated. +Note that form is evaluated only once, at the time the method is +defined, not each time the generic function is called. +

    +
    + +

    Parameter specializer names are used in macros intended as the +user-level interface (defmethod), while parameter specializers +are used in the functional interface. +

    +

    Only required parameters may be specialized, and there must be a +parameter specializer for each required parameter. For notational +simplicity, if some required parameter in a specialized lambda list in +a method-defining form is simply a variable name, its +parameter specializer defaults to the class t. +

    +

    Given a generic function and a set of arguments, an applicable +method is a method for that generic function whose parameter +specializers are satisfied by their corresponding arguments. The +following definition specifies what it means for a method to be +applicable and for an argument to satisfy a parameter specializer. +

    +

    Let < A_1, ..., A_n> be the required +arguments to a generic function in order. Let < P_1, +..., P_n> be the parameter specializers corresponding to +the required parameters of the method M in order. The method M is +applicable when each A_i is of the type specified by +the type specifier P_i. +Because every valid parameter specializer is +also a valid type specifier, the function typep can be used during method +selection to determine whether an argument satisfies a parameter specializer. +

    +

    A method all of whose parameter specializers are +the class t is called a default method + +; it is always applicable but +may be shadowed by a more specific method. +

    +

    Methods can have qualifiers, which give the method combination +procedure a way to distinguish among methods. A method that has one +or more qualifiers is called a qualified method. +A method with no qualifiers is called an unqualified method. +A qualifier is any non-list. +The qualifiers defined by the standardized method combination types +are symbols. +

    +

    In this specification, the terms “primary method” and +“auxiliary method” are used to partition methods +within a method combination type according to their intended use. +In standard method combination, primary methods are +unqualified methods +and auxiliary methods are methods with a single qualifier +that is one of :around, :before, or :after. +Methods with these qualifiers are called around methods, +before methods, and after methods, respectively. +When a method combination type is defined using the short form of +define-method-combination, primary methods are +methods qualified with the name of the type of method combination, +and auxiliary methods have the qualifier :around. +Thus the terms “primary method” and “auxiliary method” +have only a relative definition within a given method combination type. +

    +
    +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    + + + + + diff --git a/info/gcl/Introduction-to-Packages.html b/info/gcl/Introduction-to-Packages.html new file mode 100644 index 0000000..53d80eb --- /dev/null +++ b/info/gcl/Introduction-to-Packages.html @@ -0,0 +1,111 @@ + + + + + +Introduction to Packages (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Package Concepts  

    +
    +
    +

    11.1.1 Introduction to Packages

    + +

    A package + + establishes a mapping from names to symbols. +At any given time, one package is current. +The current package + + is the one that is the value of *package*. +When using the Lisp reader, +it is possible to refer to symbols in packages +other than the current one through the use of package prefixes in the +printed representation of the symbol. +

    +

    Figure 11–1 lists some defined names that are applicable +to packages. +Where an operator +takes an argument that is either a symbol or a list +of symbols, +an argument of nil is treated as an empty list of symbols. +Any package argument may be either a string, a symbol, or +a package. If a symbol is supplied, its name will be used +as the package name. +

    +
    +
      *modules*            import                     provide           
+  *package*            in-package                 rename-package    
+  defpackage           intern                     require           
+  do-all-symbols       list-all-packages          shadow            
+  do-external-symbols  make-package               shadowing-import  
+  do-symbols           package-name               unexport          
+  export               package-nicknames          unintern          
+  find-all-symbols     package-shadowing-symbols  unuse-package     
+  find-package         package-use-list           use-package       
+  find-symbol          package-used-by-list                         
+
+         Figure 11–1: Some Defined Names related to Packages       
+
+
    + + + + + + + + + +
    • Package Names and Nicknames   +
    • Symbols in a Package   +
    • Internal and External Symbols   +
    • Package Inheritance   +
    • Accessibility of Symbols in a Package   +
    • Locating a Symbol in a Package   +
    • Prevention of Name Conflicts in Packages   +
    + +
    +
    +

    +Next: , Previous: , Up: Package Concepts  

    +
    + + + + + diff --git a/info/gcl/Introduction-to-Scripts-and-Repertoires.html b/info/gcl/Introduction-to-Scripts-and-Repertoires.html new file mode 100644 index 0000000..69762ee --- /dev/null +++ b/info/gcl/Introduction-to-Scripts-and-Repertoires.html @@ -0,0 +1,58 @@ + + + + + +Introduction to Scripts and Repertoires (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.2 Introduction to Scripts and Repertoires

    + + + + +
    • Character Scripts   +
    • Character Repertoires   +
    + + + + + + diff --git a/info/gcl/Introduction-to-Slots.html b/info/gcl/Introduction-to-Slots.html new file mode 100644 index 0000000..81fb01f --- /dev/null +++ b/info/gcl/Introduction-to-Slots.html @@ -0,0 +1,119 @@ + + + + + +Introduction to Slots (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Slots  

    +
    +
    +

    7.5.1 Introduction to Slots

    + +

    An object of metaclass standard-class has zero or more named +slots. The slots of an object are determined +by the class of the object. Each slot can hold +one value. +

    +

    [Reviewer Note by Barmar: All symbols are valid variable names. Perhaps this means + to preclude the use of named constants? We have a terminology + problem to solve.] +The name of a slot is a symbol that is syntactically +valid for use as a variable name. +

    +

    When a slot does not have a value, the slot is said to be +unbound. When an unbound slot is read, +

    +

    [Reviewer Note by Barmar: from an object whose metaclass is standard-class?] +the generic function slot-unbound is invoked. The +system-supplied primary method +for slot-unbound +on class t signals an error. +

    +

    If slot-unbound returns, its primary value +is used that time as the value of the slot. +

    +

    The default initial value form for a slot is defined by +the :initform slot option. When the :initform form is used to +supply a value, it is evaluated in the lexical environment in which +the defclass form was evaluated. The :initform along with +the lexical environment in which the defclass form was evaluated +is called a captured initialization form. +For more details, see Object Creation and Initialization. +

    +

    A local slot is defined to be a slot that is +accessible +to exactly one instance, +namely the one in which the slot is allocated. +A shared slot is defined to be a slot that is visible to more than one +instance of a given class and its subclasses. +

    +

    A class is said to define a slot with a given name when +the defclass form for that class contains a slot specifier with +that name. Defining a local slot does not immediately create +a slot; it causes a slot to be created each time +an instance of the class is created. +Defining a shared slot immediately creates a slot. +

    +

    The :allocation slot option to defclass controls the kind +of slot that is defined. If the value of the :allocation slot +option is :instance, a local slot is created. If the value of +:allocation is :class, a shared slot is created. +

    +

    A slot is said to be accessible in an instance +of a class if +the slot is defined by the class +of the instance or is inherited from +a superclass of that class. +At most one slot of a given name can be +accessible in an instance. +A shared slot defined by a class is +accessible in all instances +of that class. +A detailed explanation of the inheritance of slots is given in +Inheritance of Slots and Slot Options. +

    +
    +
    +

    +Next: , Previous: , Up: Slots  

    +
    + + + + + diff --git a/info/gcl/Introduction-to-Streams.html b/info/gcl/Introduction-to-Streams.html new file mode 100644 index 0000000..ec2a4f0 --- /dev/null +++ b/info/gcl/Introduction-to-Streams.html @@ -0,0 +1,102 @@ + + + + + +Introduction to Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Stream Concepts  

    +
    +
    +

    21.1.1 Introduction to Streams

    + +

    A stream + + is an object that can be used with an input or output +function to identify an appropriate source or sink of characters or +bytes for that operation. +A character + + stream + + is a source or sink of characters. +A binary + + stream + + is a source or sink of bytes. +

    +

    Some operations may be performed on any kind of stream; +Figure 21–1 provides a list of standardized operations +that are potentially useful with any kind of stream. +

    +
    +
      close                 stream-element-type  
+  input-stream-p        streamp              
+  interactive-stream-p  with-open-stream     
+  output-stream-p                            
+
+  Figure 21–1: Some General-Purpose Stream Operations
+
+
    + +

    Other operations are only meaningful on certain stream types. +For example, read-char is only defined for character streams +and read-byte is only defined for binary streams. +

    + + + + + + + + +
    • Abstract Classifications of Streams (Introduction to Streams)   +
    • Input   +
    • Open and Closed Streams   +
    • Interactive Streams   +
    • Abstract Classifications of Streams   +
    • File Streams   +
    • Other Subclasses of Stream   +
    + + + + + + diff --git a/info/gcl/Invalid-Characters.html b/info/gcl/Invalid-Characters.html new file mode 100644 index 0000000..7d55d6c --- /dev/null +++ b/info/gcl/Invalid-Characters.html @@ -0,0 +1,59 @@ + + + + + +Invalid Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.3 Invalid Characters

    + +

    Characters with the constituent trait invalid +cannot ever appear in a token +except under the control of a single escape character. +If an invalid character is encountered while an object is +being read, an error of type reader-error is signaled. +If an invalid character is preceded by a single escape character, +it is treated as an alphabetic_2 constituent instead. +

    + + + + + diff --git a/info/gcl/Invalid-Keyword-Arguments.html b/info/gcl/Invalid-Keyword-Arguments.html new file mode 100644 index 0000000..e9954e3 --- /dev/null +++ b/info/gcl/Invalid-Keyword-Arguments.html @@ -0,0 +1,61 @@ + + + + + +Invalid Keyword Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.6 Invalid Keyword Arguments

    + +

    It is not permitted to supply a keyword argument to a function +using a name that is not a symbol. +

    +

    If this situation occurs in a safe call, +

    +

    an error of type program-error must be signaled +unless keyword argument checking is suppressed as described +in Suppressing Keyword Argument Checking; +and in an unsafe call the situation has undefined consequences. +

    + + + + + diff --git a/info/gcl/Iteration-Control.html b/info/gcl/Iteration-Control.html new file mode 100644 index 0000000..bfd8d27 --- /dev/null +++ b/info/gcl/Iteration-Control.html @@ -0,0 +1,120 @@ + + + + + +Iteration Control (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.1 Iteration Control

    + +

    Iteration control clauses allow direction of loop iteration. +The loop keywords for and as +designate iteration control clauses. +Iteration control clauses differ with respect to the specification of +termination tests and to the initialization and stepping_1 +of loop variables. Iteration clauses by themselves +do not cause the Loop Facility to return values, but they +can be used in conjunction with value-accumulation clauses to +return values. +

    +

    All variables are initialized in the loop prologue. +A variable binding has lexical scope +unless it is proclaimed special; +thus, by default, the variable can be accessed only by forms +that lie textually within the loop. +Stepping assignments are made in the loop body before any other forms +are evaluated in the body. +

    +

    The variable argument in iteration control clauses can be a +destructuring list. A destructuring list +is a tree whose non-nil atoms are variable names. +See Destructuring. +

    +

    The iteration control clauses for, as, and repeat +must precede any other loop clauses, except + initially, with, and named, +since they establish variable bindings. +When iteration control clauses are +used in a loop, +the corresponding +termination tests in the loop body are evaluated +before any other loop body code is executed. +

    +

    If multiple iteration clauses are used to control iteration, variable +initialization and stepping_1 occur sequentially by default. +The and construct can be used to connect two or more +iteration clauses when sequential binding and +stepping_1 are not necessary. +The iteration behavior of clauses joined by and +is analogous to the behavior of the macro do with +respect to do*. +

    +

    The for and as clauses iterate by using one or more local +loop variables that are initialized to some value and that +can be modified or stepped_1 after each iteration. +For these clauses, iteration terminates when a local +variable reaches some supplied value or when some other loop clause +terminates iteration. +At each iteration, variables can be + stepped_1 by an increment or a decrement +or can be assigned a new value by the evaluation of a form). +Destructuring can be used to assign +values to variables during iteration. +

    +

    The for and as keywords are synonyms; they can be used +interchangeably. There are seven syntactic formats for these constructs. +In each syntactic format, the type of +var can be supplied by the optional type-spec +argument. If var is a destructuring list, the type +supplied by the type-spec argument must appropriately match +the elements of the list. +By convention, for introduces new iterations and as +introduces iterations that depend on a previous iteration specification. +

    +
    +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    + + + + + diff --git a/info/gcl/Iteration-Dictionary.html b/info/gcl/Iteration-Dictionary.html new file mode 100644 index 0000000..38cc7dc --- /dev/null +++ b/info/gcl/Iteration-Dictionary.html @@ -0,0 +1,65 @@ + + + + + +Iteration Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Iteration  

    +
    +
    +

    6.2 Iteration Dictionary

    + + + + + + + + +
    • do   +
    • dotimes   +
    • dolist   +
    • loop   +
    • loop-finish   +
    + + + + + + diff --git a/info/gcl/Iteration.html b/info/gcl/Iteration.html new file mode 100644 index 0000000..3be9275 --- /dev/null +++ b/info/gcl/Iteration.html @@ -0,0 +1,58 @@ + + + + + +Iteration (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    6 Iteration

    + + + + +
    • The LOOP Facility   +
    • Iteration Dictionary   +
    + + + + + + diff --git a/info/gcl/Keyword-Arguments-in-Generic-Functions-and-Methods.html b/info/gcl/Keyword-Arguments-in-Generic-Functions-and-Methods.html new file mode 100644 index 0000000..80b9ca4 --- /dev/null +++ b/info/gcl/Keyword-Arguments-in-Generic-Functions-and-Methods.html @@ -0,0 +1,80 @@ + + + + + +Keyword Arguments in Generic Functions and Methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    +
    +

    7.6.5 Keyword Arguments in Generic Functions and Methods

    + +

    When a generic function or any of its methods mentions +&key in a lambda list, the specific set of keyword +arguments accepted by the generic function varies according to the +applicable methods. The set of keyword arguments accepted by the +generic function for a particular call is the union of the keyword +arguments accepted by all applicable methods and the keyword arguments +mentioned after &key in the generic function definition, +if any. A method that has &rest but not &key does not affect the +set of acceptable keyword arguments. If +the lambda list of any applicable method or of the generic +function definition contains &allow-other-keys, all +keyword arguments are accepted by the generic function. +

    +

    The lambda list congruence rules require that each method +accept all of the keyword arguments mentioned after &key in the +generic function definition, by accepting them explicitly, by +specifying &allow-other-keys, or by specifying &rest but +not &key. Each method can accept additional keyword arguments +of its own, in addition to the keyword arguments mentioned in the +generic function definition. +

    +

    If a generic function is passed a keyword argument that no applicable +method accepts, an error should be signaled; see Error Checking in Function Calls. +

    + + +
    • Examples of Keyword Arguments in Generic Functions and Methods   +
    + + + + + + diff --git a/info/gcl/Kinds-of-Places.html b/info/gcl/Kinds-of-Places.html new file mode 100644 index 0000000..47c0ffa --- /dev/null +++ b/info/gcl/Kinds-of-Places.html @@ -0,0 +1,76 @@ + + + + + +Kinds of Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generalized Reference  

    +
    +
    +

    5.1.2 Kinds of Places

    + +

    Several kinds of places are defined by Common Lisp; +this section enumerates them. +This set can be extended by implementations and by programmer code. +

    + + + + + + + + + + +
    • Variable Names as Places   +
    • Function Call Forms as Places   +
    • VALUES Forms as Places   +
    • THE Forms as Places   +
    • APPLY Forms as Places   +
    • Setf Expansions and Places   +
    • Macro Forms as Places   +
    • Symbol Macros as Places   +
    • Other Compound Forms as Places   +
    + + + + + + diff --git a/info/gcl/Lambda-Expressions.html b/info/gcl/Lambda-Expressions.html new file mode 100644 index 0000000..60d0d2c --- /dev/null +++ b/info/gcl/Lambda-Expressions.html @@ -0,0 +1,64 @@ + + + + + +Lambda Expressions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    +
    +

    3.1.3 Lambda Expressions

    + +

    In a lambda expression, +the body is evaluated in a lexical environment that is formed by +adding the binding of +each parameter in the lambda list +with the corresponding value from the arguments +to the current lexical environment. +

    +

    For further discussion of how bindings are established +based on the lambda list, see Lambda Lists. +

    +

    The body of a lambda expression is an implicit progn; +the values it returns are returned by the lambda expression. +

    + + + + + diff --git a/info/gcl/Lambda-Forms.html b/info/gcl/Lambda-Forms.html new file mode 100644 index 0000000..9cbed36 --- /dev/null +++ b/info/gcl/Lambda-Forms.html @@ -0,0 +1,63 @@ + + + + + +Lambda Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.11 Lambda Forms

    + +

    A lambda form is similar to a function form, except that +the function name is replaced by a lambda expression. +

    +

    A lambda form is equivalent to using funcall of a +lexical closure of the lambda expression on the given arguments. +(In practice, some compilers are more likely to produce inline code +for a lambda form than for an arbitrary named function +that has been declared inline; however, such a difference +is not semantic.) +

    +

    For further information, see Lambda Expressions. +

    + + + + + diff --git a/info/gcl/Lambda-Lists.html b/info/gcl/Lambda-Lists.html new file mode 100644 index 0000000..fe0ab9d --- /dev/null +++ b/info/gcl/Lambda-Lists.html @@ -0,0 +1,127 @@ + + + + + +Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.4 Lambda Lists

    + + +

    A lambda list + + is a list that +specifies a set of parameters (sometimes called lambda variables) +and a protocol for receiving values for those parameters. +

    +

    There are several kinds of lambda lists. +

    +
    +
     Context                                     Kind of Lambda List                             
+ defun form                                  ordinary lambda list                            
+ defmacro form                               macro lambda list                               
+ lambda expression                           ordinary lambda list                            
+ flet local function definition              ordinary lambda list                            
+ labels local function definition            ordinary lambda list                            
+ handler-case clause specification           ordinary lambda list                            
+ restart-case clause specification           ordinary lambda list                            
+ macrolet local macro definition             macro lambda list                               
+ define-method-combination                   ordinary lambda list                            
+ define-method-combination :arguments option define-method-combination arguments lambda list 
+ defstruct :constructor option               boa lambda list                                 
+ defgeneric form                             generic function lambda list                    
+ defgeneric method clause                    specialized lambda list                         
+ defmethod form                              specialized lambda list                         
+ defsetf form                                defsetf lambda list                             
+ define-setf-expander form                   macro lambda list                               
+ deftype form                                deftype lambda list                             
+ destructuring-bind form                     destructuring lambda list                       
+ define-compiler-macro form                  macro lambda list                               
+ define-modify-macro form                    define-modify-macro lambda list                 
+
+                         Figure 3–10: What Kind of Lambda Lists to Use                       
+
+
    + +

    Figure 3–11 lists some defined names that are applicable +to lambda lists. +

    +
    +
      lambda-list-keywords  lambda-parameters-limit    
+
+  Figure 3–11: Defined names applicable to lambda lists
+
+
    + + + + + + + + + + + + + +
    • Ordinary Lambda Lists   +
    • Generic Function Lambda Lists   +
    • Specialized Lambda Lists   +
    • Macro Lambda Lists   +
    • Destructuring Lambda Lists   +
    • Boa Lambda Lists   +
    • Defsetf Lambda Lists   +
    • Deftype Lambda Lists   +
    • Define-modify-macro Lambda Lists   +
    • Define-method-combination Arguments Lambda Lists   +
    • Syntactic Interaction of Documentation Strings and Declarations   +
    + +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    + + + + + diff --git a/info/gcl/Lambda_002dlist_002ddirected-Destructuring-by-Lambda-Lists.html b/info/gcl/Lambda_002dlist_002ddirected-Destructuring-by-Lambda-Lists.html new file mode 100644 index 0000000..ae3356d --- /dev/null +++ b/info/gcl/Lambda_002dlist_002ddirected-Destructuring-by-Lambda-Lists.html @@ -0,0 +1,142 @@ + + + + + +Lambda-list-directed Destructuring by Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Macro Lambda Lists  

    +
    +
    +

    3.4.4.4 Lambda-list-directed Destructuring by Lambda Lists

    + +

    An extension of data-directed destructuring of trees is +lambda-list-directed destructuring. This derives from the analogy +between the three-element destructuring pattern +

    +

    (first second third) +

    +

    and the three-argument lambda list +

    +

    (first second third) +

    +

    Lambda-list-directed destructuring is identical to data-directed destructuring +if no lambda list keywords appear in the pattern. +Any list in the pattern (whether a sub-list or the whole pattern itself) +that contains a lambda list keyword is interpreted specially. +Elements of the list to the left of the first +lambda list keyword are treated as destructuring patterns, as usual, but the +remaining elements of the list are treated like a function’s +lambda list +except that where a variable would normally be required, an arbitrary +destructuring pattern is allowed. Note that in case of ambiguity, +lambda list syntax is preferred over destructuring syntax. Thus, after +&optional a list of elements is a list of a destructuring pattern +and a default value form. +

    +

    The detailed behavior of each lambda list keyword in a +lambda-list-directed destructuring +pattern is as follows: +

    +
    +
    &optional
    +

    Each following element is a variable or a list of a destructuring +pattern, a default value form, and a supplied-p variable. The default value and +the supplied-p variable can be omitted. +If the list being destructured ends +early, so that it does not have an element to match against this destructuring +(sub)-pattern, the default form is evaluated and destructured instead. The +supplied-p variable receives the value +nil if the default form is used, t otherwise. +

    +
    +
    &rest, &body
    +

    The next element is a destructuring pattern that matches the +rest of the list. &body is identical to &rest but declares that what +is being matched is a list of forms that constitutes the body of form. +This next element must be the last unless a lambda list keyword follows it. +

    +
    +
    &aux
    +

    The remaining elements are not destructuring patterns at all, but are +auxiliary variable bindings. +

    +
    +
    &whole
    +

    The next element is a destructuring pattern that matches the entire +form in a macro, or the entire subexpression at inner levels. +

    +
    +
    &key
    +

    Each following element is one of +

    +
    +

    a variable, +

    +
    +
    or
    +

    a list of a variable, + an optional initialization form, + and an optional supplied-p variable. +

    +
    +
    or
    +

    a list of a list of a keyword and a destructuring pattern, + an optional initialization form, + and an optional supplied-p variable. +

    +
    + +

    The rest of the list being destructured +is taken to be alternating keywords and values and is taken apart appropriately. +

    +
    +
    &allow-other-keys
    +

    Stands by itself. +

    +
    + +
    +
    +

    +Previous: , Up: Macro Lambda Lists  

    +
    + + + + + diff --git a/info/gcl/Language-Extensions.html b/info/gcl/Language-Extensions.html new file mode 100644 index 0000000..7e87755 --- /dev/null +++ b/info/gcl/Language-Extensions.html @@ -0,0 +1,117 @@ + + + + + +Language Extensions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.6 Language Extensions

    + + +

    A language extension is any documented implementation-defined behavior +of a defined name in this standard that varies from the +behavior described in this standard, or a documented consequence of a +situation that the standard specifies as undefined, unspecified, or +extendable by the implementation. For example, if this standard says +that “the results are unspecified,” an extension would be to specify +the results. +

    +

    [Reviewer Note by Barmar: This contradicts previous definitions of conforming code.] +If the correct behavior of a program depends on the results provided +by an extension, only implementations with the same extension will +execute the program correctly. Note that such a program might be +non-conforming. Also, if this standard says that “an implementation +may be extended,” a conforming, but possibly non-portable, program +can be written using an extension. +

    +

    An implementation can have extensions, provided they do not alter the +behavior of conforming code and provided they are not explicitly +prohibited by this standard. +

    +

    The term “extension” refers only to extensions available upon +startup. An implementation is free to allow or prohibit redefinition +of an extension. +

    +

    The following list contains specific guidance to implementations +concerning certain types of extensions. +

    +
    Extra return values
    +
    +

    An implementation must return exactly +the number of return values specified by this standard unless the +standard specifically indicates otherwise. +

    +
    +
    Unsolicited messages
    +
    +

    No output can be produced by a function other than that specified in +the standard or due to the signaling of conditions +detected by the function. +

    +

    Unsolicited output, such as garbage collection notifications and +autoload heralds, should not go directly to the stream +that is the value of a stream variable defined in this +standard, but can go indirectly to terminal I/O by using a +synonym stream to *terminal-io*. +

    +

    Progress reports from such functions as load and +compile are considered solicited, and are not covered by +this prohibition. +

    +
    +
    Implementation of macros and special forms
    +
    +

    Macros and special operators defined in this standard +must not be functions. +

    +
    +
    + + +
    +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    + + + + + diff --git a/info/gcl/Language-Subsets.html b/info/gcl/Language-Subsets.html new file mode 100644 index 0000000..0cd431b --- /dev/null +++ b/info/gcl/Language-Subsets.html @@ -0,0 +1,65 @@ + + + + + +Language Subsets (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.7 Language Subsets

    + + +

    The language described in this standard contains no subsets, +though subsets are not forbidden. +

    +

    For a language to be considered a subset, +it must have the property that any valid program in that language +has equivalent semantics and will run directly +(with no extralingual pre-processing, and no special compatibility packages) +in any conforming implementation of the full language. +

    +

    A language that conforms to this requirement shall be described +as being a “subset of Common Lisp as specified by ANSI <<standard number>>.” +

    + + + + + + diff --git a/info/gcl/Leading-and-Trailing-Newlines-in-Condition-Reports.html b/info/gcl/Leading-and-Trailing-Newlines-in-Condition-Reports.html new file mode 100644 index 0000000..df6a8a1 --- /dev/null +++ b/info/gcl/Leading-and-Trailing-Newlines-in-Condition-Reports.html @@ -0,0 +1,70 @@ + + + + + +Leading and Trailing Newlines in Condition Reports (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printing Conditions  

    +
    +
    +

    9.1.3.3 Leading and Trailing Newlines in Condition Reports

    + +

    It is recommended that a report message not begin with any +introductory text, such as “Error: ” or “Warning: ” +or even just freshline or newline. +Such text is added, if appropriate to the context, +by the routine invoking the condition reporter. +

    +

    It is recommended that a report message not be followed +by a trailing freshline or newline. +Such text is added, if appropriate to the context, +by the routine invoking the condition reporter. +

    +
    +
     (error "This is a message.~
+ (error "~&This is a message.")   ; Not recommended
+ (error "~&This is a message.~
+
+ (error "This is a message.")     ; Recommended instead
+
    + + + + + + diff --git a/info/gcl/Left_002dParenthesis.html b/info/gcl/Left_002dParenthesis.html new file mode 100644 index 0000000..2754577 --- /dev/null +++ b/info/gcl/Left_002dParenthesis.html @@ -0,0 +1,106 @@ + + + + + +Left-Parenthesis (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.1 Left-Parenthesis

    + +

    The left-parenthesis initiates reading of a list. +read is called recursively to read successive objects +until a right parenthesis is found in the input stream. +A list of the objects read is returned. Thus +

    +
    +
     (a b c)
+
    + +

    is read as a list of three objects +(the symbols a, b, and c). +The right parenthesis need not immediately follow the printed representation of +the last object; whitespace_2 +characters and comments may precede it. +

    +

    If no objects precede the right parenthesis, +it reads as a list of zero objects +(the empty list). +

    +

    If a token that is just a dot +not immediately preceded by an escape character +is read after some object +then exactly one more object must follow the dot, +possibly preceded or followed by whitespace_2 or a comment, +followed by the right parenthesis: +

    +
    +
     (a b c . d)
+
    + +

    This means that the cdr of the last cons in the +list is not nil, +but rather the object whose representation followed the dot. +The above example might have been the result of evaluating +

    +
    +
     (cons 'a (cons 'b (cons 'c 'd)))
+
    + +

    Similarly, +

    +
    +
     (cons 'this-one 'that-one) ⇒  (this-one . that-one)
+
    + +

    It is permissible for the object +following the dot to be a list: +

    +
    +
     (a b c d . (e f . (g))) ≡ (a b c d e f g)
+
    + +

    For information on how the Lisp printer prints lists and conses, +see Printing Lists and Conses. +

    + + + + + diff --git a/info/gcl/Lexical-Environments.html b/info/gcl/Lexical-Environments.html new file mode 100644 index 0000000..37856e0 --- /dev/null +++ b/info/gcl/Lexical-Environments.html @@ -0,0 +1,90 @@ + + + + + +Lexical Environments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Environments  

    +
    +
    +

    3.1.1.3 Lexical Environments

    + +

    A lexical environment + + for evaluation at some position in a program +is that part of the environment that contains information having +lexical scope within the forms containing that position. +A lexical environment contains, among other things, the following: +

    +
    +
    *
    +

    bindings of lexical variables and symbol macros. +

    +
    *
    +

    bindings of functions and macros. + (Implicit in this is information about those compiler macros + that are locally disabled.) +

    +
    *
    +

    bindings of block tags. +

    +
    *
    +

    bindings of go tags. +

    +
    *
    +

    information about declarations. +

    +
    + +

    The lexical environment that is active at any given position +in a program being semantically processed is referred to by +definite reference as “the current lexical environment,” +or sometimes as just “the lexical environment.” +

    +

    Within a given namespace, +a name is said to be bound in a lexical environment +if there is a binding +associated with its name +in the lexical environment or, if not, there is a binding +associated with its name in the global environment. +

    + + + + + diff --git a/info/gcl/Lexical-Variables.html b/info/gcl/Lexical-Variables.html new file mode 100644 index 0000000..39cf70a --- /dev/null +++ b/info/gcl/Lexical-Variables.html @@ -0,0 +1,71 @@ + + + + + +Lexical Variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.3 Lexical Variables

    + +

    A lexical variable is a variable that can be referenced only within +the lexical scope of the form that establishes that variable; +lexical variables have lexical scope. +Each time a form creates a lexical binding of a variable, +a fresh binding is established. +

    +

    Within the scope of a binding for a lexical variable name, +uses of that name as a variable are considered to be references +to that binding except where the variable is shadowed_2 +by a form that establishes a fresh binding for that +variable name, +or by a form that locally declares the name special. +

    +

    A lexical variable always has a value. +There is no operator that introduces a binding for a +lexical variable without giving it an initial value, nor +is there any operator that can make a lexical variable be unbound. +

    +

    Bindings of lexical variables are found in the lexical environment. +

    + + + + + diff --git a/info/gcl/Lists-as-Association-Lists.html b/info/gcl/Lists-as-Association-Lists.html new file mode 100644 index 0000000..5ef0577 --- /dev/null +++ b/info/gcl/Lists-as-Association-Lists.html @@ -0,0 +1,66 @@ + + + + + +Lists as Association Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses as Lists  

    +
    +
    +

    14.1.2.1 Lists as Association Lists

    + +

    An association list + + is a list of conses +representing an association of keys with values, +where the car of each cons is the key +and the cdr is the value associated with that key. +

    +
    +
      acons  assoc-if      pairlis  rassoc-if      
+  assoc  assoc-if-not  rassoc   rassoc-if-not  
+
+  Figure 14–4: Some defined names related to assocation lists.
+
+
    + + + + + + diff --git a/info/gcl/Lists-as-Sets.html b/info/gcl/Lists-as-Sets.html new file mode 100644 index 0000000..38fcf9d --- /dev/null +++ b/info/gcl/Lists-as-Sets.html @@ -0,0 +1,63 @@ + + + + + +Lists as Sets (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses as Lists  

    +
    +
    +

    14.1.2.2 Lists as Sets

    + +

    Lists are sometimes viewed as sets by considering their elements +unordered and by assuming there is no duplication of elements. +

    +
    +
      adjoin         nset-difference    set-difference    union  
+  intersection   nset-exclusive-or  set-exclusive-or         
+  nintersection  nunion             subsetp                  
+
+       Figure 14–5: Some defined names related to sets.     
+
+
    + + + + + + diff --git a/info/gcl/Literal-Objects-in-Compiled-Files.html b/info/gcl/Literal-Objects-in-Compiled-Files.html new file mode 100644 index 0000000..1abfde1 --- /dev/null +++ b/info/gcl/Literal-Objects-in-Compiled-Files.html @@ -0,0 +1,88 @@ + + + + + +Literal Objects in Compiled Files (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation  

    +
    +
    +

    3.2.4 Literal Objects in Compiled Files

    + +

    The functions eval and compile are +required to ensure that literal objects referenced within the resulting +interpreted or compiled code objects are the same as the +corresponding objects in the source code. +compile-file, on the other hand, +must produce a compiled file that, when loaded with +load, constructs the objects defined by the +source code and produces references to them. +

    +

    In the case of compile-file, objects +constructed by load of the compiled file cannot be spoken +of as being the same as the objects constructed at +compile time, because the compiled file may be loaded into a different +Lisp image than the one in which it was compiled. This section +defines the concept of similarity which relates +objects in the evaluation environment to the +corresponding objects in the run-time environment. +

    +

    The constraints on literal objects described in this section +apply only to compile-file; +eval and compile do not copy or coalesce constants. +

    + + + + + + + +
    • Externalizable Objects   +
    • Similarity of Literal Objects   +
    • Similarity of Aggregate Objects   +
    • Definition of Similarity   +
    • Extensions to Similarity Rules   +
    • Additional Constraints on Externalizable Objects   +
    + + + + + + diff --git a/info/gcl/Loading.html b/info/gcl/Loading.html new file mode 100644 index 0000000..3e786ce --- /dev/null +++ b/info/gcl/Loading.html @@ -0,0 +1,79 @@ + + + + + +Loading (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Concepts  

    +
    +
    +

    24.1.1 Loading

    + +

    To load a file is to treat its contents as code +and execute that code. +The file may contain source code + + or compiled code + +. +

    +

    A file containing source code is called a source file + +. +Loading a source file is accomplished essentially +by sequentially reading_2 the forms in the file, +evaluating each immediately after it is read. +

    +

    A file containing compiled code is called a compiled file + +. +Loading a compiled file is similar to loading a source file, +except that the file does not contain text but rather an +implementation-dependent representation of pre-digested expressions +created by the compiler. Often, a compiled file can be loaded +more quickly than a source file. +See Compilation. +

    +

    The way in which a source file is distinguished from a compiled file +is implementation-dependent. +

    + + + + + diff --git a/info/gcl/Local-Case-in-Pathname-Components.html b/info/gcl/Local-Case-in-Pathname-Components.html new file mode 100644 index 0000000..08d5d1e --- /dev/null +++ b/info/gcl/Local-Case-in-Pathname-Components.html @@ -0,0 +1,64 @@ + + + + + +Local Case in Pathname Components (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.4 Local Case in Pathname Components

    + +

    For the functions in Figure~19–2, +a value of :local + for the :case argument +(the default for these functions) +indicates that the functions should receive and yield strings in component values +as if they were already represented according to the host file system’s +convention for case. +

    +

    If the file system supports both cases, strings given or received +as pathname component values under this protocol are to be used exactly +as written. If the file system only supports one case, +the strings will be translated to that case. +

    + + + + + diff --git a/info/gcl/Local-Variable-Initializations.html b/info/gcl/Local-Variable-Initializations.html new file mode 100644 index 0000000..ffb8913 --- /dev/null +++ b/info/gcl/Local-Variable-Initializations.html @@ -0,0 +1,136 @@ + + + + + +Local Variable Initializations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.15 Local Variable Initializations

    + +

    When a loop form is executed, the local variables are bound and are +initialized to some value. These local variables exist until loop +iteration terminates, at which point they cease to exist. +Implicit variables are also established by iteration control clauses and the +into preposition of accumulation clauses. +

    +

    The with construct initializes variables that are local to +a loop. The variables are initialized one time only. +If the optional type-spec argument is supplied for the variable +var, but there is no related expression to be evaluated, var +is initialized to an appropriate default value for its type. +For example, for the types t, number, +and float, +the default values are nil, 0, and 0.0 respectively. +The consequences are undefined if a +type-spec argument is supplied for var if +the related expression returns a value that is not of the supplied +type. +By default, the with construct initializes variables +sequentially; that is, one variable is assigned a value before the +next expression is evaluated. However, by using the loop keyword and +to join several with clauses, +initializations can be forced to occur in parallel; that +is, all of the supplied +forms are evaluated, and the results are bound to the respective +variables simultaneously. +

    +

    Sequential binding is used when it is desireable for the initialization of +some variables to depend on the values of previously bound variables. +For example, suppose the variables a, b, and c are to be bound in sequence: +

    +
    +
     (loop with a = 1 
+       with b = (+ a 2) 
+       with c = (+ b 3)
+       return (list a b c))
+⇒  (1 3 6)
+
    + +

    The execution of the above loop is equivalent to the execution of +the following code: +

    +
    +
     (block nil
+   (let* ((a 1)
+          (b (+ a 2))
+          (c (+ b 3)))
+     (tagbody
+         (next-loop (return (list a b c))
+                    (go next-loop)
+                    end-loop))))
+
    + +

    If the values of previously bound variables are not needed +for the initialization of other local variables, an +and clause can be used to +specify that the bindings are to occur in parallel: +

    +
    +
     (loop with a = 1 
+       and b = 2 
+       and c = 3
+       return (list a b c))
+⇒  (1 2 3)
+
    + +

    The execution of the above loop is equivalent to the execution of +the following code: +

    +
    +
     (block nil
+   (let ((a 1)
+         (b 2)
+         (c 3))
+     (tagbody
+         (next-loop (return (list a b c))
+                    (go next-loop)
+                    end-loop))))
+
    + +
    +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    + + + + + diff --git a/info/gcl/Locating-a-Symbol-in-a-Package.html b/info/gcl/Locating-a-Symbol-in-a-Package.html new file mode 100644 index 0000000..0f3009d --- /dev/null +++ b/info/gcl/Locating-a-Symbol-in-a-Package.html @@ -0,0 +1,67 @@ + + + + + +Locating a Symbol in a Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Packages  

    +
    +
    +

    11.1.1.6 Locating a Symbol in a Package

    + +

    When a symbol is to be located in a given package +the following occurs: +

    +
    –
    +

    The external symbols and internal symbols of the +package are searched for the symbol. +

    +
    –
    +

    The external symbols of the used packages are +searched +in some unspecified order. The +order does not matter; see the rules for handling name +conflicts listed below. +

    +
    + + + + + + diff --git a/info/gcl/Logical-Operations-on-Integers.html b/info/gcl/Logical-Operations-on-Integers.html new file mode 100644 index 0000000..4548a98 --- /dev/null +++ b/info/gcl/Logical-Operations-on-Integers.html @@ -0,0 +1,77 @@ + + + + + +Logical Operations on Integers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numeric Operations  

    +
    +
    +

    12.1.1.5 Logical Operations on Integers

    + +

    Logical operations require integers as arguments; +an error of type type-error should be signaled +if an argument is supplied that is not an integer. +Integer arguments to logical operations are treated as if +they were represented in two’s-complement notation. +

    +

    Figure 12–5 shows defined names relating to +logical operations on numbers. +

    +
    +
      ash          boole-ior       logbitp   
+  boole        boole-nand      logcount  
+  boole-1      boole-nor       logeqv    
+  boole-2      boole-orc1      logior    
+  boole-and    boole-orc2      lognand   
+  boole-andc1  boole-set       lognor    
+  boole-andc2  boole-xor       lognot    
+  boole-c1     integer-length  logorc1   
+  boole-c2     logand          logorc2   
+  boole-clr    logandc1        logtest   
+  boole-eqv    logandc2        logxor    
+
+  Figure 12–5: Defined names relating to logical operations on numbers.
+
+
    + + + + + + diff --git a/info/gcl/Logical-Pathname-Components.html b/info/gcl/Logical-Pathname-Components.html new file mode 100644 index 0000000..7503b76 --- /dev/null +++ b/info/gcl/Logical-Pathname-Components.html @@ -0,0 +1,58 @@ + + + + + +Logical Pathname Components (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Logical Pathnames  

    +
    +
    +

    19.3.2 Logical Pathname Components

    + + + + +
    • Unspecific Components of a Logical Pathname   +
    • Null Strings as Components of a Logical Pathname   +
    + + + + + + diff --git a/info/gcl/Logical-Pathnames.html b/info/gcl/Logical-Pathnames.html new file mode 100644 index 0000000..2d43086 --- /dev/null +++ b/info/gcl/Logical-Pathnames.html @@ -0,0 +1,59 @@ + + + + + +Logical Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames  

    +
    +
    +

    19.3 Logical Pathnames

    + + + + + +
    • Syntax of Logical Pathname Namestrings   +
    • Logical Pathname Components   +
    + + + + + + diff --git a/info/gcl/Loop-Keywords.html b/info/gcl/Loop-Keywords.html new file mode 100644 index 0000000..b2a1516 --- /dev/null +++ b/info/gcl/Loop-Keywords.html @@ -0,0 +1,66 @@ + + + + + +Loop Keywords (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.4 Loop Keywords

    + +

    Loop keywords are not true keywords_1; +they are special symbols, recognized by name rather than object identity, +that are meaningful only to the loop facility. +A loop keyword is a symbol but is recognized by its name +(not its identity), regardless of the packages in which it is accessible. +

    +

    In general, loop keywords are not external symbols of the COMMON-LISP package, +except in the coincidental situation that a symbol with the same name as a +loop keyword was needed for some other purpose in Common Lisp. For example, +there is a symbol in the COMMON-LISP package whose name is "UNLESS" but +not one whose name is "UNTIL". +

    +

    If no loop keywords are supplied in a loop form, +the Loop Facility executes the loop body repeatedly; see Simple Loop. +

    + + + + + diff --git a/info/gcl/Lowercase-Characters.html b/info/gcl/Lowercase-Characters.html new file mode 100644 index 0000000..c321d27 --- /dev/null +++ b/info/gcl/Lowercase-Characters.html @@ -0,0 +1,59 @@ + + + + + +Lowercase Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.5 Lowercase Characters

    + +

    A lowercase character is one that has a corresponding +uppercase character that is different +(and can be obtained using char-upcase). +

    +

    Of the standard characters, only these are lowercase characters: +

    +

    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 +

    + + + + + diff --git a/info/gcl/Lowercase-Letters-in-a-Logical-Pathname-Namestring.html b/info/gcl/Lowercase-Letters-in-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..2de0151 --- /dev/null +++ b/info/gcl/Lowercase-Letters-in-a-Logical-Pathname-Namestring.html @@ -0,0 +1,54 @@ + + + + + +Lowercase Letters in a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.8 Lowercase Letters in a Logical Pathname Namestring

    + +

    When parsing words and wildcard-words, +lowercase letters are translated to uppercase. +

    + + + + + diff --git a/info/gcl/Macro-Characters.html b/info/gcl/Macro-Characters.html new file mode 100644 index 0000000..d718213 --- /dev/null +++ b/info/gcl/Macro-Characters.html @@ -0,0 +1,123 @@ + + + + + +Macro Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.4 Macro Characters

    + +

    When the Lisp reader encounters a macro character +on an input stream, +special parsing of subsequent characters +on the input stream +is performed. +

    +

    A macro character has an associated function +called a reader macro function + + that implements its specialized parsing behavior. +An association of this kind can be established or modified under control of +a conforming program by using +the functions set-macro-character and set-dispatch-macro-character. +

    +

    Upon encountering a macro character, the Lisp reader calls its +reader macro function, which parses one specially formatted object +from the input stream. +The function either returns the parsed object, +or else it returns no values + to indicate that the characters scanned by the function + are being ignored (e.g., in the case of a comment). +Examples of macro characters +are backquote, single-quote, left-parenthesis, and +right-parenthesis. +

    +

    A macro character is either terminating or non-terminating. +The difference between terminating and non-terminating macro characters +lies in what happens when such characters occur in the middle of a token. +If a non-terminating + + macro character occurs in the middle of a token, +the function associated +with the non-terminating macro character is not called, +and the +non-terminating macro character does not terminate the token’s name; it +becomes part of the name as if the macro character were really a constituent +character. A terminating + + macro character terminates any token, +and its associated reader macro function +is called no matter where the character appears. +The only non-terminating macro character in standard syntax +is sharpsign. +

    +

    If a character is a dispatching macro character C_1, +its reader macro function is a function supplied by the implementation. +This function reads decimal digit characters until a non-digit +C_2 is read. +If any digits were read, +they are converted into a corresponding integer infix parameter P; +otherwise, the infix parameter P is nil. +The terminating non-digit C_2 is a character +(sometimes called a “sub-character” to emphasize its subordinate role in the dispatching) +that is looked up in the dispatch table associated with +the dispatching macro character C_1. +The reader macro function associated with the sub-character C_2 +is invoked with three arguments: + the stream, + the sub-character C_2, + and the infix parameter P. +For more information about dispatch characters, +see the function set-dispatch-macro-character. +

    +

    For information about the macro characters +that are available in standard syntax, +see Standard Macro Characters. +

    +
    +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    + + + + + diff --git a/info/gcl/Macro-Forms-as-Places.html b/info/gcl/Macro-Forms-as-Places.html new file mode 100644 index 0000000..cbbc2ad --- /dev/null +++ b/info/gcl/Macro-Forms-as-Places.html @@ -0,0 +1,61 @@ + + + + + +Macro Forms as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.7 Macro Forms as Places

    + +

    A macro form can be used as a place, +in which case Common Lisp expands the macro form +

    +

    as if by macroexpand-1 +

    +

    and then uses the macro expansion in place of the original place. +

    +

    Such macro expansion is attempted only after exhausting all other possibilities +other than expanding into a call to a function named (setf reader). +

    + + + + + diff --git a/info/gcl/Macro-Forms.html b/info/gcl/Macro-Forms.html new file mode 100644 index 0000000..1357ae6 --- /dev/null +++ b/info/gcl/Macro-Forms.html @@ -0,0 +1,101 @@ + + + + + +Macro Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.9 Macro Forms

    + +

    If the operator names a macro, +its associated macro function is applied +to the entire form and the result of that application is +used in place of the original form. +

    +

    Specifically, a symbol names a macro in a given lexical environment if +macro-function is true of the +symbol and that environment. +The function returned by macro-function +is a function of two arguments, called the +expansion function. +The expansion function is invoked by calling the macroexpand hook with + the expansion function as its first argument, + the entire macro form as its second argument, + and an environment object (corresponding to the current lexical environment) + as its third argument. +The macroexpand hook, in turn, calls the expansion function with the +form as its first argument and the environment as its second argument. +The value of the expansion function, which is passed through +by the macroexpand hook, is a form. +The returned form is evaluated in place of the original form. +

    +

    The consequences are undefined if a macro function destructively modifies +any part of its form argument. +

    +

    A macro name is not a function designator, +and cannot be used as the function argument to functions +such as apply, funcall, or map. +

    +

    An implementation is free to implement a Common Lisp special operator +as a macro. An implementation is free to implement any +macro operator as a special operator, but only +if an equivalent definition of the macro is also provided. +

    +

    Figure 3–3 lists some defined names that are applicable +to macros. +

    +
    +
      *macroexpand-hook*  macro-function  macroexpand-1  
+  defmacro            macroexpand     macrolet       
+
+    Figure 3–3: Defined names applicable to macros  
+
+
    + +
    +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    + + + + + diff --git a/info/gcl/Macro-Lambda-Lists.html b/info/gcl/Macro-Lambda-Lists.html new file mode 100644 index 0000000..4c3cf30 --- /dev/null +++ b/info/gcl/Macro-Lambda-Lists.html @@ -0,0 +1,229 @@ + + + + + +Macro Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.4 Macro Lambda Lists

    + +

    A macro lambda list + + is used in describing macros +defined by the operators in Figure 3–17. +

    +
    +
      define-compiler-macro  defmacro  macrolet  
+  define-setf-expander                       
+
+  Figure 3–17: Operators that use Macro Lambda Lists
+
+
    + +

    With the additional restriction that +an environment parameter may appear only once +(at any of the positions indicated), +a macro lambda list has the following syntax: +

    + +

    reqvars ::={var | !pattern}* +

    +

    optvars ::=[&optional {var |         ({var | !pattern} [init-form [supplied-p-parameter]])}*] +

    +

    restvar ::=[{&rest | &body} {var | !pattern}] +

    +

    keyvars ::=[&key {var |              ({var |          (keyword-name {var | !pattern})}    [init-form [supplied-p-parameter]])}* +            [&allow-other-keys]] +

    + +

    auxvars ::=[&aux {var | (var [init-form])}*] +

    +

    envvar ::=[&environment var] +

    +

    wholevar ::=[&whole var] +

    +

    lambda-list ::=(!wholevar !envvar !reqvars !envvar !optvars !envvar +                !restvar !envvar !keyvars !envvar !auxvars !envvar) | +                (!wholevar !envvar !reqvars !envvar !optvars !envvar . var) +

    +

    pattern ::=(!wholevar !reqvars !optvars !restvar !keyvars !auxvars) | +            (!wholevar !reqvars !optvars . var) +

    + + +

    A macro lambda list can contain +the lambda list keywords shown in Figure 3–18. +

    +
    +
      &allow-other-keys  &environment  &rest   
+  &aux               &key          &whole  
+  &body              &optional             
+
+  Figure 3–18: Lambda List Keywords used by Macro Lambda Lists
+
+
    + +

    Optional parameters (introduced by &optional) and +keyword parameters (introduced by &key) +can be supplied in a macro lambda list, +just as in an ordinary lambda list. +Both may contain default initialization forms and supplied-p parameters. +

    +

    &body + +

    +

    is identical in function to &rest, +but it can be used to inform certain output-formatting +and editing functions that the remainder of the form is +treated as a body, and should be indented accordingly. +Only one of &body or &rest can be used at any particular level; +see Destructuring by Lambda Lists. +

    +

    &body can appear at any level of a +macro lambda list; +for details, see Destructuring by Lambda Lists. +

    +

    &whole + +

    +

    is followed by a single variable that is bound to the +entire macro-call form; this is the value that the macro function +receives as its first argument. +

    +

    If &whole and a following variable appear, +they must appear first in lambda-list, +

    +

    before any other parameter or lambda list keyword. +

    +

    &whole can appear at any level of a macro lambda list. +At inner levels, the &whole variable is bound to + the corresponding part of the argument, +as with &rest, but unlike &rest, other arguments are also allowed. +The use of &whole does not affect the pattern of arguments + specified. +

    +

    &environment + +

    +

    is followed by a single variable that is bound +to an environment representing the lexical environment in which the +macro call is to be interpreted. +This environment +should be used with +

    +

    macro-function, +

    +

    get-setf-expansion, +

    +

    compiler-macro-function, +

    +

    and +macroexpand +(for example) in computing the expansion of the macro, to ensure that any +lexical bindings or definitions established in the +compilation environment are taken into account. +

    +

    &environment can only appear at the top level of a + macro lambda list, and can only +appear once, but can appear anywhere in that list; +

    +

    the &environment parameter is bound along with &whole +before any other variables in the lambda list, regardless of where +&environment appears in the lambda list. +

    +

    The object that is bound to the +environment parameter has dynamic extent. +

    +

    Destructuring allows a macro lambda list to express +the structure of a macro call syntax. +If no lambda list keywords appear, +then the macro lambda list is a tree +containing parameter names at the leaves. +The pattern and the macro form must have compatible tree structure; +that is, their tree structure must be equivalent, +or it must differ only in that some leaves of the pattern +match non-atomic objects of the macro form. +

    +

    For information about error detection in this situation, +see Destructuring Mismatch. +

    +

    A destructuring lambda list +(whether at top level or embedded) +can +be dotted, ending +in a parameter name. This situation is treated exactly as if the +parameter name that ends the list had appeared preceded by &rest. +

    +

    It is permissible for a macro form (or a subexpression of a +macro form) +to be a dotted list +only when (... &rest var) or (... . var) is used to match + it. It is the responsibility of the macro to recognize and deal + with such situations. +

    +

    [Editorial Note by KMP: Apparently the dotted-macro-forms cleanup doesn’t allow for + the macro to ‘manually’ notice dotted forms and fix them as well. + It shouldn’t be required that this be done only by &REST or + a dotted pattern; it should only matter that ultimately the + non-macro result of a full-macro expansion not contain dots. + Anyway, I plan to address this editorially unless someone + raises an objection.] +

    + + + + + +
    • Destructuring by Lambda Lists   +
    • Data-directed Destructuring by Lambda Lists   +
    • Examples of Data-directed Destructuring by Lambda Lists   +
    • Lambda-list-directed Destructuring by Lambda Lists   +
    + +
    +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    + + + + + diff --git a/info/gcl/Mentioning-Containing-Function-in-Condition-Reports.html b/info/gcl/Mentioning-Containing-Function-in-Condition-Reports.html new file mode 100644 index 0000000..7db066d --- /dev/null +++ b/info/gcl/Mentioning-Containing-Function-in-Condition-Reports.html @@ -0,0 +1,55 @@ + + + + + +Mentioning Containing Function in Condition Reports (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Printing Conditions  

    +
    +
    +

    9.1.3.6 Mentioning Containing Function in Condition Reports

    + +

    The name of the containing function should generally not be mentioned in +report messages. It is assumed that the debugger will make this +information accessible in situations where it is necessary and appropriate. +

    + + + + + diff --git a/info/gcl/Merging-Pathnames.html b/info/gcl/Merging-Pathnames.html new file mode 100644 index 0000000..142ac18 --- /dev/null +++ b/info/gcl/Merging-Pathnames.html @@ -0,0 +1,69 @@ + + + + + +Merging Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Pathnames  

    +
    +
    +

    19.2.3 Merging Pathnames

    + +

    Merging takes a pathname with unfilled components +and supplies values for those components from a source of defaults. +

    +

    If a component’s value is nil, that component is considered to be unfilled. +If a component’s value is any non-nil object, +including :unspecific, that component is considered to be filled. +

    +

    Except as explicitly specified otherwise, +for functions that manipulate or inquire about files in the file system, +the pathname argument to such a function +is merged with *default-pathname-defaults* before accessing the file system +(as if by merge-pathnames). +

    + + +
    • Examples of Merging Pathnames   +
    + + + + + + diff --git a/info/gcl/Meta_002dObjects.html b/info/gcl/Meta_002dObjects.html new file mode 100644 index 0000000..3ebccee --- /dev/null +++ b/info/gcl/Meta_002dObjects.html @@ -0,0 +1,64 @@ + + + + + +Meta-Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects  

    +
    +
    +

    7.4 Meta-Objects

    + + +

    The implementation of the object system manipulates classes, methods, +and generic functions. The object system contains a set of +generic functions defined by methods on classes; +the behavior of those generic functions defines the behavior of +the object system. The instances of the classes on which those +methods are defined are called meta-objects. +

    + + +
    • Standard Meta-objects   +
    + + + + + + diff --git a/info/gcl/Method-Selection-and-Combination.html b/info/gcl/Method-Selection-and-Combination.html new file mode 100644 index 0000000..a36568a --- /dev/null +++ b/info/gcl/Method-Selection-and-Combination.html @@ -0,0 +1,89 @@ + + + + + +Method Selection and Combination (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generic Functions and Methods  

    +
    +
    +

    7.6.6 Method Selection and Combination

    + +

    When a generic function is called with particular arguments, it must +determine the code to execute. This code is called the +effective method + + for those arguments. +The effective method is a +combination of the applicable methods in the generic function +that calls some or all of the methods. +

    +

    If a generic function is called and no methods are +applicable, the generic function no-applicable-method +is invoked, with the results from that call being used as the +results of the call to the original generic function. Calling +no-applicable-method takes precedence over checking for acceptable +keyword arguments; see Keyword Arguments in Generic Functions and Methods. +

    +

    When the effective method has been determined, +it is invoked with the same arguments as were passed to the generic function. +Whatever values it returns are returned as the values +of the generic function. +

    + + + + + + + + +
    • Determining the Effective Method   +
    • Selecting the Applicable Methods   +
    • Sorting the Applicable Methods by Precedence Order   +
    • Applying method combination to the sorted list of applicable methods   +
    • Standard Method Combination   +
    • Declarative Method Combination   +
    • Built-in Method Combination Types   +
    + + + + + + diff --git a/info/gcl/Minimal-Compilation.html b/info/gcl/Minimal-Compilation.html new file mode 100644 index 0000000..c458a21 --- /dev/null +++ b/info/gcl/Minimal-Compilation.html @@ -0,0 +1,103 @@ + + + + + +Minimal Compilation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation Semantics  

    +
    +
    +

    3.2.2.6 Minimal Compilation

    + +

    Minimal compilation is defined as follows: +

    +
    +
    *
    +

    All compiler macro + + calls appearing in the +source code being compiled are expanded, if at all, at compile time; +they will not be expanded at run time. +

    +
    +
    *
    +

    All macro + + and +symbol macro + + calls +appearing in the source code being compiled are expanded at compile time +in such a way that they will not be expanded again at run time. +macrolet + +

    +

    and +symbol-macrolet + +

    +

    are effectively replaced by +forms corresponding to their bodies in which calls to +macros are replaced by their expansions. +

    +
    +
    *
    +

    The first argument in a load-time-value + +

    +

    form +in source code processed by compile + +

    +

    is evaluated at compile time; +in source code processed by compile-file + +, +the compiler arranges for it to be evaluated at load time. +In either case, the result of the evaluation +is remembered and used later as the value of the +load-time-value form at execution time. +

    +
    +
    + + + + + + diff --git a/info/gcl/Minimal-Declaration-Processing-Requirements.html b/info/gcl/Minimal-Declaration-Processing-Requirements.html new file mode 100644 index 0000000..0a1ecd2 --- /dev/null +++ b/info/gcl/Minimal-Declaration-Processing-Requirements.html @@ -0,0 +1,82 @@ + + + + + +Minimal Declaration Processing Requirements (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Declarations  

    +
    +
    +

    3.3.1 Minimal Declaration Processing Requirements

    + +

    In general, an implementation is free to ignore +declaration specifiers except for the + declaration + +, + notinline + +, + safety + +, + and special + + declaration specifiers. +

    +

    A declaration declaration must suppress warnings +about unrecognized declarations of the kind that it declares. +If an implementation does not produce warnings about +unrecognized declarations, it may safely ignore this declaration. +

    +

    A notinline declaration must be recognized by any implementation +that supports inline functions or compiler macros in order to disable those facilities. +An implementation that does not use inline functions or compiler macros +may safely ignore this declaration. +

    +

    A safety declaration that increases the current safety level +must always be recognized. An implementation that always processes +code as if safety were high may safely ignore this declaration. +

    +

    A special declaration must be processed by all implementations. +

    + + + + + diff --git a/info/gcl/Miscellaneous-Clauses.html b/info/gcl/Miscellaneous-Clauses.html new file mode 100644 index 0000000..47a399d --- /dev/null +++ b/info/gcl/Miscellaneous-Clauses.html @@ -0,0 +1,60 @@ + + + + + +Miscellaneous Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.7 Miscellaneous Clauses

    + + + + + +
    • Control Transfer Clauses   +
    • Examples of NAMED clause   +
    • Initial and Final Execution   +
    + + + + + + diff --git a/info/gcl/Missing-and-Additional-FORMAT-Arguments.html b/info/gcl/Missing-and-Additional-FORMAT-Arguments.html new file mode 100644 index 0000000..9f5a923 --- /dev/null +++ b/info/gcl/Missing-and-Additional-FORMAT-Arguments.html @@ -0,0 +1,55 @@ + + + + + +Missing and Additional FORMAT Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Additional Information about FORMAT Operations  

    +
    +
    +

    22.3.10.2 Missing and Additional FORMAT Arguments

    + +

    The consequences are undefined if no arg remains for a directive +requiring an argument. However, it is permissible for one or more args +to remain unprocessed by a directive; such args are ignored. +

    + + + + + diff --git a/info/gcl/Modification-of-Literal-Objects.html b/info/gcl/Modification-of-Literal-Objects.html new file mode 100644 index 0000000..ba228e8 --- /dev/null +++ b/info/gcl/Modification-of-Literal-Objects.html @@ -0,0 +1,142 @@ + + + + + +Modification of Literal Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Destructive Operations  

    +
    +
    +

    3.7.1 Modification of Literal Objects

    + +

    The consequences are undefined if literal objects +are destructively modified. For this purpose, the following operations +are considered destructive: +

    +
    +
    random-state
    +

    Using it as an argument to the function random. +

    +
    +
    cons
    +

    Changing the car_1 or cdr_1 of the cons, +or performing a destructive operation on an object which is either +the car_2 or the cdr_2 of the cons. +

    +
    +
    array
    +

    Storing a new value into some element of the array, +or performing a destructive operation +on an object that is already such an element. +

    +

    Changing the fill pointer, dimensions, or displacement of +the array (regardless of whether the array is actually adjustable). +

    +

    Performing a destructive operation on another array +that is displaced to the array or that otherwise shares its contents +with the array. +

    +
    +
    hash-table
    +

    Performing a destructive operation on any key. +

    +

    Storing a new value_4 for any key, +or performing a destructive operation +on any object that is such a value. +

    +

    Adding or removing entries from the hash table. +

    +
    +
    structure-object
    +

    Storing a new value into any slot, +or performing a destructive operation on an object +that is the value of some slot. +

    +
    +
    standard-object
    +

    Storing a new value into any slot, +or performing a destructive operation on an object +that is the value of some slot. +

    +

    Changing the class of the object (e.g., using the function change-class). +

    +
    +
    readtable
    +

    Altering the readtable case. +

    +

    Altering the syntax type of any character in this readtable. +

    +

    Altering the reader macro function associated with any character +in the readtable, or altering the reader macro functions +associated with characters defined as dispatching macro characters +in the readtable. +

    +
    +
    stream
    +

    Performing I/O operations on the stream, +or closing the stream. +

    +
    +
    All other standardized types
    +

    [This category includes, for example, character, + condition, + function, + method-combination, + method, + number, + package, + pathname, + restart, + and symbol.] +

    +

    There are no standardized destructive operations +defined on objects of these types. +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Destructive Operations  

    +
    + + + + + diff --git a/info/gcl/Modified-BNF-Syntax.html b/info/gcl/Modified-BNF-Syntax.html new file mode 100644 index 0000000..2a4329f --- /dev/null +++ b/info/gcl/Modified-BNF-Syntax.html @@ -0,0 +1,57 @@ + + + + + +Modified BNF Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.2 Modified BNF Syntax

    + + + +

    This specification uses an extended Backus Normal Form (BNF) to +describe the syntax of Common Lisp macro forms and special forms. +This section discusses the syntax of BNF expressions. +

    + + + + + diff --git a/info/gcl/Modifying-Hash-Table-Keys.html b/info/gcl/Modifying-Hash-Table-Keys.html new file mode 100644 index 0000000..64182a1 --- /dev/null +++ b/info/gcl/Modifying-Hash-Table-Keys.html @@ -0,0 +1,101 @@ + + + + + +Modifying Hash Table Keys (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Hash Table Concepts  

    +
    +
    +

    18.1.2 Modifying Hash Table Keys

    + +

    The function supplied as the :test argument to make-hash-table +specifies the ‘equivalence test’ for the hash table it creates. +

    +

    An object is ‘visibly modified’ with regard to an equivalence test +if there exists some set of objects (or potential objects) +which are equivalent to the object before the modification but are +no longer equivalent afterwards. +

    +

    If an object O_1 is used as a key in a hash table H +and is then visibly modified with regard to the equivalence test of H, +then the consequences are unspecified if O_1, or any object +O_2 equivalent to O_1 under the equivalence test (either before +or after the modification), is used as a key in further operations on H. +The consequences of using O_1 as a key are unspecified +even if O_1 is visibly modified +and then later modified again in such a way as +to undo the visible modification. +

    +

    Following are specifications of the modifications which are visible to the +equivalence tests which must be supported by hash tables. The modifications +are described in terms of modification of components, and are defined +recursively. Visible modifications of components of the object are +visible modifications of the object. +

    + + + + + + + + + + +
    • Visible Modification of Objects with respect to EQ and EQL   +
    • Visible Modification of Objects with respect to EQUAL   +
    • Visible Modification of Conses with respect to EQUAL   +
    • Visible Modification of Bit Vectors and Strings with respect to EQUAL   +
    • Visible Modification of Objects with respect to EQUALP   +
    • Visible Modification of Structures with respect to EQUALP   +
    • Visible Modification of Arrays with respect to EQUALP   +
    • Visible Modification of Hash Tables with respect to EQUALP   +
    • Visible Modifications by Language Extensions   +
    + +
    +
    +

    +Previous: , Up: Hash Table Concepts  

    +
    + + + + + diff --git a/info/gcl/Modifying-the-Structure-of-Instances.html b/info/gcl/Modifying-the-Structure-of-Instances.html new file mode 100644 index 0000000..90d352d --- /dev/null +++ b/info/gcl/Modifying-the-Structure-of-Instances.html @@ -0,0 +1,74 @@ + + + + + +Modifying the Structure of Instances (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Redefining Classes  

    +
    +
    +

    4.3.6.1 Modifying the Structure of Instances

    + +

    [Reviewer Note by Barmar: What about shared slots that are deleted?] +

    +

    The first step modifies the structure of instances of the redefined +class to conform to its new class definition. +Local slots specified +by the new class definition that are not specified as either local or +shared by the old class are added, and slots +not specified as either +local or shared by the new class definition that are specified as +local by the old class are discarded. +The names of these added and discarded +slots are passed as arguments +to update-instance-for-redefined-class +as described in the next section. +

    +

    The values of local slots specified by both the new and old +classes are retained. If such a local slot was unbound, +it remains unbound. +

    +

    The value of a slot that is specified as shared in the old +class and as local in the new class is retained. If such +a shared slot was unbound, the local slot is unbound. +

    + + + + + diff --git a/info/gcl/Modifying-the-Structure-of-the-Instance.html b/info/gcl/Modifying-the-Structure-of-the-Instance.html new file mode 100644 index 0000000..e5e5c6d --- /dev/null +++ b/info/gcl/Modifying-the-Structure-of-the-Instance.html @@ -0,0 +1,63 @@ + + + + + +Modifying the Structure of the Instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Changing the Class of an Instance  

    +
    +
    +

    7.2.1 Modifying the Structure of the Instance

    + +

    In order to make the instance conform to the class C_{to}, local slots specified by the class C_{to} that are not specified by the class C_{from} are added, and local slots not specified by +the class C_{to} that are specified by the +class C_{from} are discarded. +

    +

    The values of local slots specified by both the class C_{to} and the class C_{from} are retained. If such a local slot was unbound, it remains +unbound. +

    +

    The values of slots specified as shared in the class C_{from} and as local in the class C_{to} are retained. +

    +

    This first step of the update does not affect the values of any +shared slots. +

    + + + + + diff --git a/info/gcl/Multidimensional-Arrays.html b/info/gcl/Multidimensional-Arrays.html new file mode 100644 index 0000000..1c1832b --- /dev/null +++ b/info/gcl/Multidimensional-Arrays.html @@ -0,0 +1,51 @@ + + + + + +Multidimensional Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.7 Multidimensional Arrays

    + + + + + + diff --git a/info/gcl/Multiple-Escape-Characters.html b/info/gcl/Multiple-Escape-Characters.html new file mode 100644 index 0000000..41ef2fe --- /dev/null +++ b/info/gcl/Multiple-Escape-Characters.html @@ -0,0 +1,65 @@ + + + + + +Multiple Escape Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.5 Multiple Escape Characters

    + +

    A pair of multiple escape + + characters +is used to indicate that an enclosed sequence of characters, +including possible macro characters and whitespace_2 characters, +are to be treated as alphabetic_2 characters +with case preserved. +Any single escape and multiple escape characters +that are to appear in the sequence must be preceded by a single escape +character. +

    +

    Vertical-bar is a multiple escape character +in standard syntax. +

    + + + + + diff --git a/info/gcl/Multiple-Possible-Textual-Representations.html b/info/gcl/Multiple-Possible-Textual-Representations.html new file mode 100644 index 0000000..12f9d15 --- /dev/null +++ b/info/gcl/Multiple-Possible-Textual-Representations.html @@ -0,0 +1,121 @@ + + + + + +Multiple Possible Textual Representations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of The Lisp Printer  

    +
    +
    +

    22.1.1.1 Multiple Possible Textual Representations

    + +

    Most objects have more than one possible textual representation. +For example, the positive integer with a magnitude of twenty-seven +can be textually expressed in any of these ways: +

    +
    +
     27    27.    #o33    #x1B    #b11011    #.(* 3 3 3)    81/3
+
    + +

    A list containing the two symbols A and B can also be textually +expressed in a variety of ways: +

    +
    +
     (A B)    (a b)    (  a  b )    (\A |B|) 
+(|\A|
+  B
+)
+
    + +

    In general, +

    +

    from the point of view of the Lisp reader, +

    +

    wherever whitespace is permissible in a textual representation, +any number of spaces and newlines can appear in standard syntax. +

    +

    When a function such as print produces a printed representation, +it must choose +from among many possible textual representations. +In most cases, it chooses a +program readable representation, +but in certain cases it might use a more compact notation that is not +program-readable. +

    +

    A number of option variables, called +printer control variables + +, +are provided to permit control of individual aspects of the +printed representation of objects. +Figure 22–1 shows the standardized printer control variables; +there might also be implementation-defined printer control variables. +

    +
    +
      *print-array*   *print-gensym*       *print-pprint-dispatch*  
+  *print-base*    *print-length*       *print-pretty*           
+  *print-case*    *print-level*        *print-radix*            
+  *print-circle*  *print-lines*        *print-readably*         
+  *print-escape*  *print-miser-width*  *print-right-margin*     
+
+       Figure 22–1: Standardized Printer Control Variables     
+
+
    + +

    In addition to the printer control variables, +the following additional defined names +relate to or affect the behavior of the Lisp printer: +

    +
    +
      *package*                    *read-eval*  readtable-case  
+  *read-default-float-format*  *readtable*                  
+
+   Figure 22–2: Additional Influences on the Lisp printer. 
+
+
    + +
    +
    +

    +Next: , Previous: , Up: Overview of The Lisp Printer  

    +
    + + + + + diff --git a/info/gcl/NIL-as-a-Component-Value.html b/info/gcl/NIL-as-a-Component-Value.html new file mode 100644 index 0000000..7984a6c --- /dev/null +++ b/info/gcl/NIL-as-a-Component-Value.html @@ -0,0 +1,61 @@ + + + + + +NIL as a Component Value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.7 NIL as a Component Value

    + +

    As a pathname component value, +nil represents that the component is “unfilled”; +see Merging Pathnames. +

    +

    The value of any pathname component can be nil. +

    +

    When constructing a pathname, +nil in the host component might mean a default host +rather than an actual nil in some implementations. +

    + + + + + diff --git a/info/gcl/NIL.html b/info/gcl/NIL.html new file mode 100644 index 0000000..a143ef0 --- /dev/null +++ b/info/gcl/NIL.html @@ -0,0 +1,110 @@ + + + + + +NIL (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.11 NIL

    + + + + + + + +

    nil has a variety of meanings. +It is a symbol in the COMMON-LISP package with the name "NIL", +it is boolean (and generalized boolean) false, +it is the empty list, +and it is the name of the empty type (a subtype of all types). +

    +

    Within Common Lisp, nil can be notated interchangeably as either NIL or (). +By convention, the choice of notation offers a hint as to which of its many +roles it is playing. +

    +
    +
      For Evaluation?  Notation  Typically Implied Role       
+  ________________________________________________________
+  Yes              nil       use as a boolean.            
+  Yes              'nil      use as a symbol.             
+  Yes              '()       use as an empty list         
+  No               nil       use as a symbol or boolean.  
+  No               ()        use as an empty list.        
+
+               Figure 1–1: Notations for NIL             
+
+
    + +

    Within this document only, nil is also sometimes notated as false to +emphasize its role as a boolean. +

    +

    For example: +

    +
    +
     (print ())                          ;avoided
+ (defun three nil 3)                 ;avoided 
+ '(nil nil)                          ;list of two symbols
+ '(() ())                            ;list of empty lists
+ (defun three () 3)                  ;Emphasize empty parameter list.
+ (append '() '()) ⇒  ()              ;Emphasize use of empty lists
+ (not nil) ⇒  true                   ;Emphasize use as Boolean false
+ (get 'nil 'color)                   ;Emphasize use as a symbol
+
    + +

    A function is sometimes said to “be false” or “be true” +in some circumstance. +Since no function object can be the same as nil +and all function objects represent true when viewed as booleans, +it would be meaningless to say that the function was literally false +and uninteresting to say that it was literally true. +Instead, these phrases are just traditional alternative ways of saying that the +function “returns false” or “returns true,” respectively. +

    +
    +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    + + + + + diff --git a/info/gcl/Namestrings-as-Filenames.html b/info/gcl/Namestrings-as-Filenames.html new file mode 100644 index 0000000..0b62587 --- /dev/null +++ b/info/gcl/Namestrings-as-Filenames.html @@ -0,0 +1,73 @@ + + + + + +Namestrings as Filenames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of Filenames  

    +
    +
    +

    19.1.1 Namestrings as Filenames

    + +

    A namestring + + is a string that represents a filename. +

    +

    In general, the syntax of namestrings involves the use of +implementation-defined conventions, +usually those customary for the file system in which the named file resides. +The only exception is the syntax of a logical pathname namestring, +which is defined in this specification; see Syntax of Logical Pathname Namestrings. +

    +

    A conforming program must never unconditionally use a +literal namestring other than a logical pathname namestring +because Common Lisp does not define any namestring syntax +other than that for logical pathnames +that would be guaranteed to be portable. +However, a conforming program can, if it is careful, +successfully manipulate user-supplied data +which contains or refers to non-portable namestrings. +

    +

    A namestring can be coerced to a pathname by the functions pathname +or parse-namestring. +

    + + + + + diff --git a/info/gcl/Naming-Conventions-for-Rest-Parameters.html b/info/gcl/Naming-Conventions-for-Rest-Parameters.html new file mode 100644 index 0000000..19c6e00 --- /dev/null +++ b/info/gcl/Naming-Conventions-for-Rest-Parameters.html @@ -0,0 +1,66 @@ + + + + + +Naming Conventions for Rest Parameters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.26 Naming Conventions for Rest Parameters

    + +

    Within this specification, +if the name of a rest parameter is chosen to be a plural noun, +use of that name in parameter font refers +to the list to which the rest parameter is bound. +Use of the singular form of that name in parameter font refers +to an element of that list. +

    +

    For example, given a syntax description such as: +

    +

    F &rest arguments +

    +

    it is appropriate to refer either to the rest parameter named +arguments by name, or to one of its elements by speaking of “an argument,” +“some argument,” “each argument” etc. +

    + + + + + diff --git a/info/gcl/Naming-of-Compiler-Macros.html b/info/gcl/Naming-of-Compiler-Macros.html new file mode 100644 index 0000000..4469b49 --- /dev/null +++ b/info/gcl/Naming-of-Compiler-Macros.html @@ -0,0 +1,69 @@ + + + + + +Naming of Compiler Macros (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation Semantics  

    +
    +
    +

    3.2.2.3 Naming of Compiler Macros

    + +

    Compiler macros may be defined for function names that name +macros as well as functions. +

    +

    Compiler macro definitions are strictly global. There is no provision +for defining local compiler macros in the way that macrolet +defines local macros. Lexical bindings of a function name shadow any +compiler macro definition associated with the name as well as its +global function or macro definition. +

    +

    Note that the presence of a compiler macro definition does not affect +the values returned by +

    +

    functions that access function definitions (e.g., fboundp) +or macro definitions (e.g., macroexpand). +Compiler macros are global, and the function +compiler-macro-function is sufficient to resolve their interaction +with other lexical and global definitions. +

    + + + + + diff --git a/info/gcl/Nesting-of-FORMAT-Operations.html b/info/gcl/Nesting-of-FORMAT-Operations.html new file mode 100644 index 0000000..2d1ec07 --- /dev/null +++ b/info/gcl/Nesting-of-FORMAT-Operations.html @@ -0,0 +1,83 @@ + + + + + +Nesting of FORMAT Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Additional Information about FORMAT Operations  

    +
    +
    +

    22.3.10.1 Nesting of FORMAT Operations

    + +

    The case-conversion, conditional, iteration, and justification +constructs can contain other formatting constructs by bracketing them. +These constructs must nest properly with respect to each other. +For example, it is not legitimate to put the start of a case-conversion +construct in each arm of a conditional and the +end of the case-conversion construct outside the conditional: +

    +
    +
     (format nil "~:[abc~:@(def~;ghi~
+:@(jkl~]mno~)" x) ;Invalid!
+
    + +

    This notation is invalid because the ~[...~;...~] +and ~(...~) constructs are not properly nested. +

    +

    The processing indirection caused by the ~? directive +is also a kind of nesting for the purposes of this rule of proper nesting. +It is not permitted to +start a bracketing construct within a string processed +under control of a ~? +directive and end the construct at some point after the ~? construct +in the string containing that construct, or vice versa. +For example, this situation is invalid: +

    +
    +
     (format nil "~@?ghi~)" "abc~@(def") ;Invalid!
+
    + +

    This notation +is invalid because the ~? +and ~(...~) constructs are not properly nested. +

    + + + + + diff --git a/info/gcl/No-Arguments-or-Values-in-The-_0022Syntax_0022-Section.html b/info/gcl/No-Arguments-or-Values-in-The-_0022Syntax_0022-Section.html new file mode 100644 index 0000000..e059cd9 --- /dev/null +++ b/info/gcl/No-Arguments-or-Values-in-The-_0022Syntax_0022-Section.html @@ -0,0 +1,59 @@ + + + + + +No Arguments or Values in The "Syntax" Section (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.29 No Arguments or Values in The "Syntax" Section

    + +

    If no arguments are permitted, or no values are returned, +a special notation is used to make this more visually apparent. For example, +

    +

    F <no arguments> ⇒ <no values> +

    +

    indicates that F is an operator that accepts no arguments and returns +no values. +

    + + + + + diff --git a/info/gcl/Nonsense-Words.html b/info/gcl/Nonsense-Words.html new file mode 100644 index 0000000..b93c7f2 --- /dev/null +++ b/info/gcl/Nonsense-Words.html @@ -0,0 +1,74 @@ + + + + + +Nonsense Words (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.13 Nonsense Words

    + + + + + + + + + +

    When a word having no pre-attached semantics is required (e.g., in an +example), it is common in the Lisp community to use one of the words +“foo,” “bar,” “baz,” and “quux.” For example, in +

    +
    +
     (defun foo (x) (+ x 1))
+
    + +

    the use of the name foo is just a shorthand way of saying +“please substitute your favorite name here.” +

    +

    These nonsense words have gained such prevalance of usage, that it is +commonplace for newcomers to the community to begin to wonder if there +is an attached semantics which they are overlooking—there is not. +

    + + + + + diff --git a/info/gcl/Notational-Conventions.html b/info/gcl/Notational-Conventions.html new file mode 100644 index 0000000..19978b6 --- /dev/null +++ b/info/gcl/Notational-Conventions.html @@ -0,0 +1,84 @@ + + + + + +Notational Conventions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Definitions  

    +
    +
    +

    1.4.1 Notational Conventions

    + + + +

    The following notational conventions are used throughout this document. +

    + + + + + + + + + + + + + + +
    • Font Key   +
    • Modified BNF Syntax   +
    • Splicing in Modified BNF Syntax   +
    • Indirection in Modified BNF Syntax   +
    • Additional Uses for Indirect Definitions in Modified BNF Syntax   +
    • Special Symbols   +
    • Objects with Multiple Notations   +
    • Case in Symbols   +
    • Numbers (Objects with Multiple Notations)   +
    • Use of the Dot Character   +
    • NIL   +
    • Designators   +
    • Nonsense Words   +
    + + + + + + diff --git a/info/gcl/Note-about-Printing-Numbers.html b/info/gcl/Note-about-Printing-Numbers.html new file mode 100644 index 0000000..fcb3209 --- /dev/null +++ b/info/gcl/Note-about-Printing-Numbers.html @@ -0,0 +1,54 @@ + + + + + +Note about Printing Numbers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.6 Note about Printing Numbers

    + +

    The printed representation of a number must not contain escape characters; +see Escape Characters and Potential Numbers. +

    + + + + + diff --git a/info/gcl/Note-about-Tabs-in-Condition-Reports.html b/info/gcl/Note-about-Tabs-in-Condition-Reports.html new file mode 100644 index 0000000..259a142 --- /dev/null +++ b/info/gcl/Note-about-Tabs-in-Condition-Reports.html @@ -0,0 +1,58 @@ + + + + + +Note about Tabs in Condition Reports (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printing Conditions  

    +
    +
    +

    9.1.3.5 Note about Tabs in Condition Reports

    + +

    Because the indentation of a report message might be shifted to the right or +left by an arbitrary amount, special care should be taken with the +semi-standard character <Tab> +(in those implementations that support such a character). +Unless the implementation specifically defines its behavior +in this context, its use should be avoided. +

    + + + + + diff --git a/info/gcl/Notes-about-Backquote.html b/info/gcl/Notes-about-Backquote.html new file mode 100644 index 0000000..a3d61a0 --- /dev/null +++ b/info/gcl/Notes-about-Backquote.html @@ -0,0 +1,68 @@ + + + + + +Notes about Backquote (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Backquote  

    +
    +
    +

    2.4.6.1 Notes about Backquote

    + +

    Since the exact manner in which the Lisp reader will parse +an expression involving the backquote reader macro +is not specified, an implementation is free to choose any +representation that preserves the semantics described. +

    +

    Often an implementation will choose a representation that facilitates +pretty printing of the expression, so that (pprint `(a ,b)) will display +`(a ,b) and not, for example, (list 'a b). However, this is not a +requirement. +

    +

    Implementors who have no particular reason to make one choice or another +might wish to refer to IEEE Standard for the Scheme Programming Language, which identifies a popular choice of +representation for such expressions that might provide useful to be useful +compatibility for some user communities. There is no requirement, however, +that any conforming implementation use this particular representation. +This information is provided merely for cross-reference purposes. +

    + + + + + diff --git a/info/gcl/Notes-about-FORMAT.html b/info/gcl/Notes-about-FORMAT.html new file mode 100644 index 0000000..ad16b71 --- /dev/null +++ b/info/gcl/Notes-about-FORMAT.html @@ -0,0 +1,64 @@ + + + + + +Notes about FORMAT (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Formatted Output  

    +
    +
    +

    22.3.12 Notes about FORMAT

    + +

    Formatted output is performed not only by format, +but by certain other functions that accept a format control +the way format does. For example, error-signaling functions +such as cerror accept format controls. +

    +

    Note that the meaning of nil and t as destinations to format +are different than those of nil and t as stream designators. +

    +

    The ~^ should appear only at the beginning of a ~< clause, +because it aborts the entire clause in which it appears (as well as +all following clauses). +

    + + + + + + diff --git a/info/gcl/Notes-about-Loop.html b/info/gcl/Notes-about-Loop.html new file mode 100644 index 0000000..49d83fa --- /dev/null +++ b/info/gcl/Notes-about-Loop.html @@ -0,0 +1,83 @@ + + + + + +Notes about Loop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.9 Notes about Loop

    + +

    Types can be supplied for loop variables. +It is not necessary to supply a type for any variable, +but supplying the type +can ensure that the variable has a correctly typed initial value, +and it can also enable compiler optimizations +(depending on the implementation). +

    +

    The clause repeat n ... is roughly equivalent to a clause such as +

    +
    +
     (loop for internal-variable downfrom (- n 1) to 0 ...)
+
    + +

    but in some implementations, +the repeat construct might be more efficient. +

    +

    Within the executable parts of the loop clauses and around the entire +loop form, variables can be bound by using let. +

    +

    Use caution when using a variable named IT (in any package) +in connection with loop, since it is a loop keyword +that can be used in place of a form in certain contexts. +

    +

    There is +

    +

    no +

    +

    standardized +mechanism for users to add +extensions to loop. +

    + + + + + + diff --git a/info/gcl/Notes-about-Style-for-Semicolon.html b/info/gcl/Notes-about-Style-for-Semicolon.html new file mode 100644 index 0000000..b06705e --- /dev/null +++ b/info/gcl/Notes-about-Style-for-Semicolon.html @@ -0,0 +1,55 @@ + + + + + +Notes about Style for Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Semicolon  

    +
    +
    +

    2.4.4.2 Notes about Style for Semicolon

    + +

    Some text editors make assumptions about desired indentation based on +the number of semicolons that begin a comment. The following style +conventions are common, although not by any means universal. +

    + + + + + diff --git a/info/gcl/Notes-about-Style-for-Sharpsign-Vertical_002dBar.html b/info/gcl/Notes-about-Style-for-Sharpsign-Vertical_002dBar.html new file mode 100644 index 0000000..ba8e78c --- /dev/null +++ b/info/gcl/Notes-about-Style-for-Sharpsign-Vertical_002dBar.html @@ -0,0 +1,71 @@ + + + + + +Notes about Style for Sharpsign Vertical-Bar (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.22 Notes about Style for Sharpsign Vertical-Bar

    + +

    Some text editors that purport to understand Lisp syntax treat any |...| +as balanced pairs that cannot nest (as if they were just balanced pairs of +the multiple escapes used in notating certain symbols). To compensate for +this deficiency, some programmers use the notation #||...#||...||#...||# +instead of #|...#|...|#...|#. Note that this alternate usage is not +a different reader macro; it merely exploits the fact that the additional +vertical-bars occur within the comment in a way that tricks certain text editor +into better supporting nested comments. As such, one might sometimes see code +like: +

    +
    +
     #|| (+ #|| 3 ||# 4 5) ||# 
+
    + +

    Such code is equivalent to: +

    +
    +
     #| (+ #| 3 |# 4 5) |#
+
    + + + + + + diff --git a/info/gcl/Notes-about-The-KEYWORD-Package.html b/info/gcl/Notes-about-The-KEYWORD-Package.html new file mode 100644 index 0000000..59fa70b --- /dev/null +++ b/info/gcl/Notes-about-The-KEYWORD-Package.html @@ -0,0 +1,63 @@ + + + + + +Notes about The KEYWORD Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.8 Notes about The KEYWORD Package

    + +

    It is generally best to confine the use of keywords to situations in which +there are a finitely enumerable set of names to be selected between. For example, +if there were two states of a light switch, they might be called :on and :off. +

    +

    In situations where the set of names is not finitely enumerable +(i.e., where name conflicts might arise) +it is frequently best to use symbols in some package +other than KEYWORD so that conflicts will be naturally avoided. +For example, it is generally not wise for a program to use a keyword_1 +as a property indicator, since if there were ever another program +that did the same thing, each would clobber the other’s data. +

    + + + + + diff --git a/info/gcl/Notes-about-the-Condition-System_0060s-Background.html b/info/gcl/Notes-about-the-Condition-System_0060s-Background.html new file mode 100644 index 0000000..8b91f97 --- /dev/null +++ b/info/gcl/Notes-about-the-Condition-System_0060s-Background.html @@ -0,0 +1,57 @@ + + + + + +Notes about the Condition System`s Background (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Condition System Concepts  

    +
    +
    +

    9.1.6 Notes about the Condition System‘s Background

    + +

    For a background reference to the abstract concepts detailed in this +section, see Exceptional Situations in Lisp. The details of that paper are not binding on +this document, but may be helpful in establishing a conceptual basis for +understanding this material. +

    + + + + + + diff --git a/info/gcl/Notes-about-the-Implementation-of-Compiler-Macros.html b/info/gcl/Notes-about-the-Implementation-of-Compiler-Macros.html new file mode 100644 index 0000000..747b7eb --- /dev/null +++ b/info/gcl/Notes-about-the-Implementation-of-Compiler-Macros.html @@ -0,0 +1,68 @@ + + + + + +Notes about the Implementation of Compiler Macros (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation Semantics  

    +
    +
    +

    3.2.2.5 Notes about the Implementation of Compiler Macros

    + +

    Although it is technically permissible, as described above, +for eval to treat compiler macros in the same situations +as compiler might, this is not necessarily a good idea in +interpreted implementations. +

    +

    Compiler macros exist for the purpose of trading compile-time speed +for run-time speed. Programmers who write compiler macros tend to +assume that the compiler macros can take more time than normal functions +and macros in order to produce code which is especially optimal for use +at run time. Since eval in an interpreted implementation +might perform semantic analysis of the same form multiple times, it might be +inefficient in general for the implementation to choose to call +compiler macros on every such evaluation. +

    +

    Nevertheless, the decision about what to do in these situations is left to +each implementation. +

    + + + + + diff --git a/info/gcl/Notes-about-the-Pathname-Version-Component.html b/info/gcl/Notes-about-the-Pathname-Version-Component.html new file mode 100644 index 0000000..d7e6b6f --- /dev/null +++ b/info/gcl/Notes-about-the-Pathname-Version-Component.html @@ -0,0 +1,69 @@ + + + + + +Notes about the Pathname Version Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.20 Notes about the Pathname Version Component

    + +

    It is suggested, but not required, that implementations do the following: +

    +
    +
    *
    +

    Use positive integers starting at 1 as version numbers. +

    +
    +
    *
    +

    Recognize the symbol :oldest + to designate the smallest existing version number. +

    +
    +
    *
    +

    Use keywords for other special versions. +

    +
    +
    + + + + + + diff --git a/info/gcl/Notes-about-the-Pretty-Printer_0060s-Background.html b/info/gcl/Notes-about-the-Pretty-Printer_0060s-Background.html new file mode 100644 index 0000000..f96e14c --- /dev/null +++ b/info/gcl/Notes-about-the-Pretty-Printer_0060s-Background.html @@ -0,0 +1,57 @@ + + + + + +Notes about the Pretty Printer`s Background (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: The Lisp Pretty Printer  

    +
    +
    +

    22.2.3 Notes about the Pretty Printer‘s Background

    + +

    For a background reference to the abstract concepts detailed in this +section, see XP: A Common Lisp Pretty Printing System. The details of that paper are not binding on +this document, but may be helpful in establishing a conceptual basis for +understanding this material. +

    + + + + + + diff --git a/info/gcl/Null-Strings-as-Components-of-a-Logical-Pathname.html b/info/gcl/Null-Strings-as-Components-of-a-Logical-Pathname.html new file mode 100644 index 0000000..5c9a743 --- /dev/null +++ b/info/gcl/Null-Strings-as-Components-of-a-Logical-Pathname.html @@ -0,0 +1,54 @@ + + + + + +Null Strings as Components of a Logical Pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Logical Pathname Components  

    +
    +
    +

    19.3.2.2 Null Strings as Components of a Logical Pathname

    + +

    The null string, "", is not a valid value for any component of a logical pathname. +

    + + + + + + diff --git a/info/gcl/Number-Concepts.html b/info/gcl/Number-Concepts.html new file mode 100644 index 0000000..13a9928 --- /dev/null +++ b/info/gcl/Number-Concepts.html @@ -0,0 +1,69 @@ + + + + + +Number Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers (Numbers)  

    +
    +
    +

    12.1 Number Concepts

    + + + + + + + + + + +
    • Numeric Operations   +
    • Implementation-Dependent Numeric Constants   +
    • Rational Computations   +
    • Floating-point Computations   +
    • Complex Computations   +
    • Interval Designators   +
    • Random-State Operations   +
    + + + + + + diff --git a/info/gcl/Numbers-Dictionary.html b/info/gcl/Numbers-Dictionary.html new file mode 100644 index 0000000..093b173 --- /dev/null +++ b/info/gcl/Numbers-Dictionary.html @@ -0,0 +1,228 @@ + + + + + +Numbers Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Numbers (Numbers)  

    +
    +
    +

    12.2 Numbers Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • number   +
    • complex (System Class)   +
    • real   +
    • float (System Class)   +
    • short-float   +
    • rational (System Class)   +
    • ratio   +
    • integer   +
    • signed-byte   +
    • unsigned-byte   +
    • mod (System Class)   +
    • bit (System Class)   +
    • fixnum   +
    • bignum   +
    • =   +
    • max   +
    • minusp   +
    • zerop   +
    • floor   +
    • sin   +
    • asin   +
    • pi   +
    • sinh   +
    • *   +
    • +   +
    • -   +
    • /   +
    • 1+   +
    • abs   +
    • evenp   +
    • exp   +
    • gcd   +
    • incf   +
    • lcm   +
    • log   +
    • mod (Function)   +
    • signum   +
    • sqrt   +
    • random-state   +
    • make-random-state   +
    • random   +
    • random-state-p   +
    • *random-state*   +
    • numberp   +
    • cis   +
    • complex   +
    • complexp   +
    • conjugate   +
    • phase   +
    • realpart   +
    • upgraded-complex-part-type   +
    • realp   +
    • numerator   +
    • rational (Function)   +
    • rationalp   +
    • ash   +
    • integer-length   +
    • integerp   +
    • parse-integer   +
    • boole   +
    • boole-1   +
    • logand   +
    • logbitp   +
    • logcount   +
    • logtest   +
    • byte   +
    • deposit-field   +
    • dpb   +
    • ldb   +
    • ldb-test   +
    • mask-field   +
    • most-positive-fixnum   +
    • decode-float   +
    • float   +
    • floatp   +
    • most-positive-short-float   +
    • short-float-epsilon   +
    • arithmetic-error   +
    • arithmetic-error-operands   +
    • division-by-zero   +
    • floating-point-invalid-operation   +
    • floating-point-inexact   +
    • floating-point-overflow   +
    • floating-point-underflow   +
    + +
    +
    +

    +Previous: , Up: Numbers (Numbers)  

    +
    + + + + + diff --git a/info/gcl/Numbers-_0028Numbers_0029.html b/info/gcl/Numbers-_0028Numbers_0029.html new file mode 100644 index 0000000..d5f4761 --- /dev/null +++ b/info/gcl/Numbers-_0028Numbers_0029.html @@ -0,0 +1,58 @@ + + + + + +Numbers (Numbers) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    12 Numbers

    + + + + +
    • Number Concepts   +
    • Numbers Dictionary   +
    + + + + + + diff --git a/info/gcl/Numbers-_0028Objects-with-Multiple-Notations_0029.html b/info/gcl/Numbers-_0028Objects-with-Multiple-Notations_0029.html new file mode 100644 index 0000000..b937f9c --- /dev/null +++ b/info/gcl/Numbers-_0028Objects-with-Multiple-Notations_0029.html @@ -0,0 +1,55 @@ + + + + + +Numbers (Objects with Multiple Notations) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.9 Numbers

    + +

    Although Common Lisp provides a variety of ways for programs to manipulate the +input and output radix for rational numbers, all numbers in this document +are in decimal notation unless explicitly noted otherwise. +

    + + + + + diff --git a/info/gcl/Numbers-as-Tokens.html b/info/gcl/Numbers-as-Tokens.html new file mode 100644 index 0000000..740be8a --- /dev/null +++ b/info/gcl/Numbers-as-Tokens.html @@ -0,0 +1,82 @@ + + + + + +Numbers as Tokens (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpretation of Tokens  

    +
    +
    +

    2.3.1 Numbers as Tokens

    + +

    When a token is read, +it is interpreted as a number or symbol. +The token is interpreted as a number if it satisfies +the syntax for numbers specified in Figure 2–9. +

    +
    +
     numeric-token ::= !integer | !ratio | !float                                              
+ integer       ::= [sign] {decimal-digit}^+ decimal-point | [sign] {digit}^+               
+ ratio         ::= [sign] {digit}^+ slash {digit}^+                                        
+ float         ::= [sign] {decimal-digit}* decimal-point {decimal-digit}^+ [!exponent]   
+                   | [sign] {decimal-digit}^+ [decimal-point {decimal-digit}*] !exponent 
+ exponent      ::= exponent-marker [sign] {digit}^+                                        
+ sign—a sign.
+ slash—a slash
+ decimal-point—a dot.
+ exponent-marker—an exponent marker.
+ decimal-digit—a digit in radix 10.
+ digit—a digit in the current input radix.
+
    + +

      Figure 2–9: Syntax for Numeric Tokens +

    + + + + +
    • Potential Numbers as Tokens   +
    • Escape Characters and Potential Numbers   +
    • Examples of Potential Numbers   +
    + + + + + + diff --git a/info/gcl/Numeric-Characters.html b/info/gcl/Numeric-Characters.html new file mode 100644 index 0000000..4074fd5 --- /dev/null +++ b/info/gcl/Numeric-Characters.html @@ -0,0 +1,61 @@ + + + + + +Numeric Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.8 Numeric Characters

    + +

    The numeric characters are +a subset of the graphic characters. +Of the standard characters, only these are numeric characters: +

    +

    0 1 2 3 4 5 6 7 8 9 +

    +

    For each implementation-defined graphic character +that has no case, the implementation must define whether +or not it is a numeric character. +

    + + + + + diff --git a/info/gcl/Numeric-Operations.html b/info/gcl/Numeric-Operations.html new file mode 100644 index 0000000..c6bff5e --- /dev/null +++ b/info/gcl/Numeric-Operations.html @@ -0,0 +1,137 @@ + + + + + +Numeric Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    +
    +

    12.1.1 Numeric Operations

    + +

    Common Lisp provides a large variety of operations related to numbers. +This section provides an overview of those operations by grouping them +into categories that emphasize some of the relationships among them. +

    +

    Figure 12–1 shows operators relating to +arithmetic operations. +

    +
    +
      *  1+         gcd   
+  +  1-         incf  
+  -  conjugate  lcm   
+  /  decf             
+
+  Figure 12–1: Operators relating to Arithmetic.
+
+
    + +

    Figure 12–2 shows defined names relating to +exponential, logarithmic, and trigonometric operations. +

    +
    +
      abs    cos    signum  
+  acos   cosh   sin     
+  acosh  exp    sinh    
+  asin   expt   sqrt    
+  asinh  isqrt  tan     
+  atan   log    tanh    
+  atanh  phase          
+  cis    pi             
+
+  Figure 12–2: Defined names relating to Exponentials, Logarithms, and Trigonometry.
+
+
    + +

    Figure 12–3 shows operators relating to +numeric comparison and predication. +

    +
    +
      /=  >=      oddp   
+  <   evenp   plusp  
+  <=  max     zerop  
+  =   min            
+  >   minusp         
+
+  Figure 12–3: Operators for numeric comparison and predication.
+
+
    + +

    Figure 12–4 shows defined names relating to +numeric type manipulation and coercion. +

    +
    +
      ceiling          float-radix           rational     
+  complex          float-sign            rationalize  
+  decode-float     floor                 realpart     
+  denominator      fround                rem          
+  fceiling         ftruncate             round        
+  ffloor           imagpart              scale-float  
+  float            integer-decode-float  truncate     
+  float-digits     mod                                
+  float-precision  numerator                          
+
+  Figure 12–4: Defined names relating to numeric type manipulation and coercion.
+
+
    + + + + + + + + +
    • Associativity and Commutativity in Numeric Operations   +
    • Examples of Associativity and Commutativity in Numeric Operations   +
    • Contagion in Numeric Operations   +
    • Viewing Integers as Bits and Bytes   +
    • Logical Operations on Integers   +
    • Byte Operations on Integers   +
    + +
    +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    + + + + + diff --git a/info/gcl/Object-Creation-and-Initialization.html b/info/gcl/Object-Creation-and-Initialization.html new file mode 100644 index 0000000..6675c22 --- /dev/null +++ b/info/gcl/Object-Creation-and-Initialization.html @@ -0,0 +1,149 @@ + + + + + +Object Creation and Initialization (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects  

    +
    +
    +

    7.1 Object Creation and Initialization

    + + +

    The generic function make-instance creates and returns a new +instance of a class. The first argument is a class or +the name of a class, and the remaining arguments form an +initialization argument list + +. +

    +

    The initialization of a new instance consists of several distinct +steps, including the following: combining the explicitly supplied initialization +arguments with default values for the unsupplied initialization arguments, +checking the validity of the initialization arguments, allocating storage +for the instance, filling slots with +values, and executing user-supplied methods that perform additional +initialization. Each step of make-instance is implemented by a +generic function to provide a mechanism for customizing that step. +In addition, make-instance is itself a generic function +and thus also can be customized. +

    +

    The object system specifies system-supplied primary methods for each step +and thus specifies a well-defined standard behavior for the entire +initialization process. The standard behavior provides four simple +mechanisms for controlling initialization: +

    +
    +
    *
    +

    Declaring a symbol to be an initialization argument +for a slot. An initialization argument is declared by using the +:initarg slot option to defclass. This provides a mechanism +for supplying a value for a slot in a call to make-instance. +

    +
    +
    *
    +

    Supplying a default value form for an initialization argument. +Default value forms for initialization arguments are defined by using the +:default-initargs class option to defclass. If an +initialization argument is not explicitly provided +as an argument to make-instance, the default value form is +evaluated in the lexical environment of the defclass form that +defined it, and the resulting value is used as the value of the +initialization argument. +

    +
    +
    *
    +

    Supplying a default initial value form for a slot. +A default initial value form for a slot is defined by using the +:initform slot option to defclass. If no initialization +argument associated with that slot is given as an argument to +make-instance or is defaulted by :default-initargs, this +default initial value form is evaluated in the lexical environment of +the defclass form that defined it, and the resulting value is +stored in the slot. The :initform form for a +local slot may be used when creating an instance, when +updating an instance to conform to a redefined class, +or when updating an instance to conform to the definition of a +different class. The :initform form for a +shared slot may be used when defining or re-defining the class. +

    +
    +
    *
    +

    Defining methods for initialize-instance and +shared-initialize. The slot-filling behavior described above is +implemented by a system-supplied primary method for +initialize-instance which invokes shared-initialize. The +generic function shared-initialize implements the parts of +initialization shared by these four situations: when making an instance, +when re-initializing an instance, when updating an instance +to conform to a redefined class, and when updating an instance +to conform to the definition of a different class. The system-supplied +primary method for shared-initialize directly implements the +slot-filling behavior described above, and initialize-instance +simply invokes shared-initialize. +

    +
    +
    + + + + + + + + + +
    • Initialization Arguments   +
    • Declaring the Validity of Initialization Arguments   +
    • Defaulting of Initialization Arguments   +
    • Rules for Initialization Arguments   +
    • Shared-Initialize   +
    • Initialize-Instance   +
    • Definitions of Make-Instance and Initialize-Instance   +
    + +
    +
    +

    +Next: , Previous: , Up: Objects  

    +
    + + + + + diff --git a/info/gcl/Objects-Dictionary.html b/info/gcl/Objects-Dictionary.html new file mode 100644 index 0000000..2176581 --- /dev/null +++ b/info/gcl/Objects-Dictionary.html @@ -0,0 +1,142 @@ + + + + + +Objects Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Objects  

    +
    +
    +

    7.7 Objects Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • function-keywords   +
    • ensure-generic-function   +
    • allocate-instance   +
    • reinitialize-instance   +
    • shared-initialize   +
    • update-instance-for-different-class   +
    • update-instance-for-redefined-class   +
    • change-class   +
    • slot-boundp   +
    • slot-exists-p   +
    • slot-makunbound   +
    • slot-missing   +
    • slot-unbound   +
    • slot-value   +
    • method-qualifiers   +
    • no-applicable-method   +
    • no-next-method   +
    • remove-method   +
    • make-instance   +
    • make-instances-obsolete   +
    • make-load-form   +
    • make-load-form-saving-slots   +
    • with-accessors   +
    • with-slots   +
    • defclass   +
    • defgeneric   +
    • defmethod   +
    • find-class   +
    • next-method-p   +
    • call-method   +
    • call-next-method   +
    • compute-applicable-methods   +
    • define-method-combination   +
    • find-method   +
    • add-method   +
    • initialize-instance   +
    • class-name   +
    • setf class-name   +
    • class-of   +
    • unbound-slot   +
    • unbound-slot-instance   +
    + +
    +
    +

    +Previous: , Up: Objects  

    +
    + + + + + diff --git a/info/gcl/Objects-with-Multiple-Notations.html b/info/gcl/Objects-with-Multiple-Notations.html new file mode 100644 index 0000000..3ce7591 --- /dev/null +++ b/info/gcl/Objects-with-Multiple-Notations.html @@ -0,0 +1,55 @@ + + + + + +Objects with Multiple Notations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.7 Objects with Multiple Notations

    + +

    Some objects in Common Lisp can be notated in more than one way. +In such situations, the choice of which notation to use is technically arbitrary, +but conventions may exist which convey a “point of view” or “sense of intent.” +

    + + + + + diff --git a/info/gcl/Objects.html b/info/gcl/Objects.html new file mode 100644 index 0000000..383eed3 --- /dev/null +++ b/info/gcl/Objects.html @@ -0,0 +1,68 @@ + + + + + +Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    7 Objects

    + + + + + + + + + +
    • Object Creation and Initialization   +
    • Changing the Class of an Instance   +
    • Reinitializing an Instance   +
    • Meta-Objects   +
    • Slots   +
    • Generic Functions and Methods   +
    • Objects Dictionary   +
    + + + + + + diff --git a/info/gcl/Odd-Number-of-Keyword-Arguments.html b/info/gcl/Odd-Number-of-Keyword-Arguments.html new file mode 100644 index 0000000..6afadaa --- /dev/null +++ b/info/gcl/Odd-Number-of-Keyword-Arguments.html @@ -0,0 +1,60 @@ + + + + + +Odd Number of Keyword Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.7 Odd Number of Keyword Arguments

    + +

    An odd number of arguments must not be supplied for the keyword parameters. +

    +

    If this situation occurs in a safe call, +

    +

    an error of type program-error must be signaled +unless keyword argument checking is suppressed as described +in Suppressing Keyword Argument Checking; +and in an unsafe call the situation has undefined consequences. +

    + + + + + diff --git a/info/gcl/Open-and-Closed-Streams.html b/info/gcl/Open-and-Closed-Streams.html new file mode 100644 index 0000000..cda601f --- /dev/null +++ b/info/gcl/Open-and-Closed-Streams.html @@ -0,0 +1,75 @@ + + + + + +Open and Closed Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Streams  

    +
    +
    +

    21.1.1.3 Open and Closed Streams

    + +

    Streams are either open + + or closed + +. +

    +

    Except as explicitly specified otherwise, +operations that create and return streams return open streams. +

    +

    The action of closing a stream marks the end of its use as a source +or sink of data, permitting the implementation to reclaim its internal data +structures, and to free any external resources which might have been locked by the +stream when it was opened. +

    +

    Except as explicitly specified otherwise, +the consequences are undefined when a closed stream +is used where a stream is called for. +

    +

    Coercion of streams to pathnames +is permissible for closed streams; +in some situations, such as for a truename computation, +the result might be different for an open stream +and for that same stream once it has been closed. +

    + + + + + diff --git a/info/gcl/Order-of-Execution.html b/info/gcl/Order-of-Execution.html new file mode 100644 index 0000000..ed88d5b --- /dev/null +++ b/info/gcl/Order-of-Execution.html @@ -0,0 +1,122 @@ + + + + + +Order of Execution (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.14 Order of Execution

    + + + + + +

    With the exceptions listed below, clauses are executed in the loop body + in the order in which they appear in the source. Execution is repeated + until a clause + terminates the loop or until a return, go, + or throw form is encountered +which transfers control to a point outside of the loop. + The following actions are + exceptions to the linear order of execution: +

    +
    +
    *
    +

    All variables are initialized first, + regardless of where the establishing clauses appear in the + source. The order of initialization follows the order of these clauses. +

    +
    +
    *
    +

    The code for any initially clauses is collected + into one progn in the order in which the clauses appear in + the source. The collected code is executed once in the loop prologue + after any implicit variable initializations. +

    +
    +
    *
    +

    The code for any finally clauses is collected + into one progn in the order in which the clauses appear in + the source. The collected code is executed once in the loop epilogue + before any implicit values from the accumulation clauses are returned. + Explicit returns anywhere in the source, however, will exit the + loop without executing the epilogue code. +

    +
    +
    *
    +

    A with clause introduces a variable binding + and an optional initial value. The initial values are calculated + in the order in which the with clauses occur. +

    +
    +
    *
    +

    Iteration control clauses implicitly perform the following actions: +

    +
    +
    –
    +

    initialize variables; +

    +
    +
    –
    +

    step variables, generally +between each execution of the loop body; +

    +
    +
    –
    +

    perform termination tests, +generally just before the execution of the + loop body. +

    +
    +
    + +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    + + + + + diff --git a/info/gcl/Ordering-of-Characters.html b/info/gcl/Ordering-of-Characters.html new file mode 100644 index 0000000..e460a24 --- /dev/null +++ b/info/gcl/Ordering-of-Characters.html @@ -0,0 +1,106 @@ + + + + + +Ordering of Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.6 Ordering of Characters

    + +

    The total ordering on characters is guaranteed to have +the following properties: +

    +
    +
    *
    +

    If two characters have the same implementation-defined attributes, +then their ordering by char< is consistent with the numerical +ordering by the predicate < on their code attributes. +

    +
    +
    *
    +

    If two characters differ in any attribute, then they +are not char=. +

    +

    [Reviewer Note by Barmar: I wonder if we should say that the ordering may be dependent on the + implementation-defined attributes.] +

    +
    +
    *
    +

    The total ordering is not necessarily the same as the total ordering + on the integers produced by applying char-int to the + characters. +

    +
    +
    *
    +

    While alphabetic_1 standard characters of a given case + must + obey a partial ordering, + they need not be contiguous; it is permissible for + uppercase and lowercase characters to be interleaved. + Thus (char<= #\a x #\z) + is not a valid way of determining whether or not x is a + lowercase character. +

    +
    +
    + +

    Of the standard characters, +those which are alphanumeric obey the following partial ordering: +

    +
    +
     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
+ 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
+ 0<1<2<3<4<5<6<7<8<9
+ either 9<A or Z<0
+ either 9<a or z<0                                                      
+
    + +

    This implies that, for standard characters, alphabetic_1 +ordering holds within each case (uppercase and lowercase), +and that the numeric characters as a group are not interleaved +with alphabetic characters. +However, the ordering or possible interleaving of uppercase characters +and lowercase characters is implementation-defined. +

    + + + + + diff --git a/info/gcl/Ordinary-Lambda-Lists.html b/info/gcl/Ordinary-Lambda-Lists.html new file mode 100644 index 0000000..5457652 --- /dev/null +++ b/info/gcl/Ordinary-Lambda-Lists.html @@ -0,0 +1,136 @@ + + + + + +Ordinary Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.1 Ordinary Lambda Lists

    + +

    An ordinary lambda list + + is used to describe how a set of +arguments is received by an ordinary function. +The defined names in Figure 3–12 are those which use +ordinary lambda lists: +

    +
    +
      define-method-combination  handler-case  restart-case  
+  defun                      labels                      
+  flet                       lambda                      
+
+  Figure 3–12: Standardized Operators that use Ordinary Lambda Lists
+
+
    + +

    An ordinary lambda list can contain the lambda list keywords shown +in Figure 3–13. +

    +
    +
      &allow-other-keys  &key       &rest  
+  &aux               &optional         
+
+  Figure 3–13: Lambda List Keywords used by Ordinary Lambda Lists
+
+
    + +

    Each element of a lambda list is either a parameter specifier +or a lambda list keyword. +Implementations are free to provide additional lambda list keywords. +For a list of all lambda list keywords +used by the implementation, see lambda-list-keywords. +

    +

    The syntax for ordinary lambda lists is as follows: +

    +

    lambda-list ::=({var}* +                 [&optional {var |         (var [init-form [supplied-p-parameter ]])}*] +                 [&rest var] +                 [&key {var |              ({var |          (keyword-name var)}    [init-form [supplied-p-parameter]])}* pt [&allow-other-keys]] +                 [&aux {var | (var [init-form])}*]) +                +

    +

    A var or supplied-p-parameter must be a symbol +that is not the name of a constant variable. +

    +

    An init-form can be any form. +Whenever any init-form is evaluated for any parameter +specifier, that form may refer to any parameter variable to +the left of the specifier in which the init-form appears, +including any supplied-p-parameter variables, and may rely +on the fact that no other parameter variable has yet been bound +(including its own parameter variable). +

    +

    A keyword-name can be any symbol, +but by convention is normally a keyword_1; +all standardized functions follow that convention. +

    +

    An ordinary lambda list has five parts, any or all of which may be empty. +For information about the treatment of argument mismatches, +see Error Checking in Function Calls. +

    + + + + + + + + + +
    • Specifiers for the required parameters   +
    • Specifiers for optional parameters   +
    • A specifier for a rest parameter   +
    • Specifiers for keyword parameters   +
    • Suppressing Keyword Argument Checking   +
    • Examples of Suppressing Keyword Argument Checking   +
    • Specifiers for &aux variables   +
    • Examples of Ordinary Lambda Lists   +
    + +
    +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    + + + + + diff --git a/info/gcl/Organization-of-the-Document.html b/info/gcl/Organization-of-the-Document.html new file mode 100644 index 0000000..0647966 --- /dev/null +++ b/info/gcl/Organization-of-the-Document.html @@ -0,0 +1,103 @@ + + + + + +Organization of the Document (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.2 Organization of the Document

    + + +

    This is a reference document, not a tutorial document. Where possible +and convenient, the order of presentation has been chosen so that the +more primitive topics precede those that build upon them; however, +linear readability has not been a priority. +

    +

    This document is divided into chapters by topic. +Any given chapter might contain conceptual material, dictionary entries, or both. +

    +

    Defined names within the dictionary portion of a chapter are +grouped in a way that brings related topics into physical proximity. +Many such groupings were possible, +and no deep significance should be inferred from the particular grouping that was chosen. +To see defined names grouped alphabetically, consult the index. +For a complete list of defined names, see Symbols in the COMMON-LISP Package. +

    +

    In order to compensate for the sometimes-unordered portions of this document, +a glossary has been provided; see Glossary. +The glossary provides connectivity by providing easy access to +definitions of terms, and in some cases by providing examples or +cross references to additional conceptual material. +

    +

    For information about notational conventions used in this document, +see Definitions. +

    +

    For information about conformance, see Conformance. +

    +

    For information about extensions and subsets, see Language Extensions +and Language Subsets. +

    +

    For information about how programs in the language are parsed by the +Lisp reader, see Syntax. +

    +

    For information about how programs in the language are compiled +and executed, see Evaluation and Compilation. +

    +

    For information about data types, see Types and Classes. +Not all types and classes are defined in this chapter; +many are defined in chapter corresponding to their topic–for example, +the numeric types are defined in Numbers (Numbers). +For a complete list of standardized types, +see Figure~4–2. +

    +

    For information about general purpose control and data flow, +see Data and Control Flow or Iteration. +

    + +
    +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    + + + + + diff --git a/info/gcl/Other-Compound-Forms-as-Places.html b/info/gcl/Other-Compound-Forms-as-Places.html new file mode 100644 index 0000000..026c48c --- /dev/null +++ b/info/gcl/Other-Compound-Forms-as-Places.html @@ -0,0 +1,78 @@ + + + + + +Other Compound Forms as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.9 Other Compound Forms as Places

    + +

    For any other compound form for which the operator is a +symbol f, +the setf form expands into a call +to the function named (setf f). +The first argument in the newly constructed function form +is newvalue and the + remaining arguments are the remaining elements of + place. +This expansion occurs regardless of whether f or (setf f) +is defined as a function locally, globally, or not at all. +For example, +

    +

    (setf (f arg1 arg2 ...) new-value) +

    +

    expands into a form with the same effect and value as +

    +
    +
     (let ((#:temp-1 arg1)          ;force correct order of evaluation
+       (#:temp-2 arg2)
+       ...
+       (#:temp-0 new-value))
+   (funcall (function (setf f)) #:temp-0 #:temp-1 #:temp-2...))
+
    + +

    A function named (setf f) must return its first argument +as its only value in order to preserve the semantics of setf. +

    + + + + + diff --git a/info/gcl/Other-Subclasses-of-Stream.html b/info/gcl/Other-Subclasses-of-Stream.html new file mode 100644 index 0000000..a8ef067 --- /dev/null +++ b/info/gcl/Other-Subclasses-of-Stream.html @@ -0,0 +1,79 @@ + + + + + +Other Subclasses of Stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Introduction to Streams  

    +
    +
    +

    21.1.1.7 Other Subclasses of Stream

    + +

    The class stream has a number of subclasses defined +by this specification. Figure 21–5 shows some information +about these subclasses. +

    +
    +
      Class                Related Operators             
+  broadcast-stream     make-broadcast-stream         
+                       broadcast-stream-streams      
+  concatenated-stream  make-concatenated-stream      
+                       concatenated-stream-streams   
+  echo-stream          make-echo-stream              
+                       echo-stream-input-stream      
+                       echo-stream-output-stream     
+  string-stream        make-string-input-stream      
+                       with-input-from-string        
+                       make-string-output-stream     
+                       with-output-to-string         
+                       get-output-stream-string      
+  synonym-stream       make-synonym-stream           
+                       synonym-stream-symbol         
+  two-way-stream       make-two-way-stream           
+                       two-way-stream-input-stream   
+                       two-way-stream-output-stream  
+
+  Figure 21–5: Defined Names related to Specialized Streams
+
+
    + + + + + + diff --git a/info/gcl/Other-Syntax-in-a-Logical-Pathname-Namestring.html b/info/gcl/Other-Syntax-in-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..0a4fb9b --- /dev/null +++ b/info/gcl/Other-Syntax-in-a-Logical-Pathname-Namestring.html @@ -0,0 +1,57 @@ + + + + + +Other Syntax in a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.9 Other Syntax in a Logical Pathname Namestring

    + +

    The consequences of using characters other than those specified here +in a logical pathname namestring are unspecified. +

    +

    The consequences of using any value not specified here as a +logical pathname component are unspecified. +

    + + + + + diff --git a/info/gcl/Overview-of-Filenames.html b/info/gcl/Overview-of-Filenames.html new file mode 100644 index 0000000..8aa6fdb --- /dev/null +++ b/info/gcl/Overview-of-Filenames.html @@ -0,0 +1,73 @@ + + + + + +Overview of Filenames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames  

    +
    +
    +

    19.1 Overview of Filenames

    + + +

    There are many kinds of file systems, +varying widely both in their superficial syntactic details, + and in their underlying power and structure. +The facilities provided by Common Lisp for referring to and manipulating files +has been chosen to be compatible with many kinds of file systems, +while at the same time minimizing the program-visible differences +between kinds of file systems. +

    +

    Since file systems vary in their conventions for naming files, +there are two distinct ways to represent filenames: +as namestrings and as pathnames. +

    + + + + +
    • Namestrings as Filenames   +
    • Pathnames as Filenames   +
    • Parsing Namestrings Into Pathnames   +
    + + + + + + diff --git a/info/gcl/Overview-of-Places-and-Generalized-Reference.html b/info/gcl/Overview-of-Places-and-Generalized-Reference.html new file mode 100644 index 0000000..a1ccf9f --- /dev/null +++ b/info/gcl/Overview-of-Places-and-Generalized-Reference.html @@ -0,0 +1,126 @@ + + + + + +Overview of Places and Generalized Reference (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Generalized Reference  

    +
    +
    +

    5.1.1 Overview of Places and Generalized Reference

    + +

    A generalized reference + + is the use of a form, +sometimes called a place + +, +as if it were a variable that could be read and written. +The value of a place is +the object to which the place form evaluates. +The value of a place can be changed by using setf. +The concept of binding a place is not defined in Common Lisp, +but an implementation is permitted to extend the language by defining this concept. +

    +

    Figure 5–1 contains examples of the use of setf. +Note that the values returned by evaluating the forms in column two +are not necessarily the same as those obtained by evaluating the +forms in column three. +In general, the exact macro expansion of a setf form is not guaranteed +and can even be implementation-dependent; +all that is guaranteed is + that the expansion is an update form that works + for that particular implementation, + that the left-to-right evaluation of subforms is preserved, +and + that the ultimate result of evaluating setf is the value + or values being stored. +

    +
    +
      Access function   Update Function   Update using setf              
+  x                 (setq x datum)    (setf x datum)                 
+  (car x)           (rplaca x datum)  (setf (car x) datum)           
+  (symbol-value x)  (set x datum)     (setf (symbol-value x) datum)  
+
+                     Figure 5–1: Examples of setf                   
+
+
    + +

    Figure 5–2 shows operators relating to +places and generalized reference. +

    +
    +
      assert                defsetf             push     
+  ccase                 get-setf-expansion  remf     
+  ctypecase             getf                rotatef  
+  decf                  incf                setf     
+  define-modify-macro   pop                 shiftf   
+  define-setf-expander  psetf                        
+
+  Figure 5–2: Operators relating to places and generalized reference.
+
+
    + +

    Some of the operators above manipulate places +and some manipulate setf expanders. +A setf expansion can be derived from any place. +

    +

    New setf expanders can be defined by using defsetf +and define-setf-expander. +

    + + + + + +
    • Evaluation of Subforms to Places   +
    • Examples of Evaluation of Subforms to Places   +
    • Setf Expansions   +
    • Examples of Setf Expansions   +
    + +
    +
    +

    +Next: , Previous: , Up: Generalized Reference  

    +
    + + + + + diff --git a/info/gcl/Overview-of-The-Lisp-Printer.html b/info/gcl/Overview-of-The-Lisp-Printer.html new file mode 100644 index 0000000..db07e13 --- /dev/null +++ b/info/gcl/Overview-of-The-Lisp-Printer.html @@ -0,0 +1,69 @@ + + + + + +Overview of The Lisp Printer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Lisp Printer  

    +
    +
    +

    22.1.1 Overview of The Lisp Printer

    + +

    Common Lisp provides a representation of most objects in the form +of printed text called the printed representation. +Functions such as print take an object +and send the characters of its printed representation to a stream. +The collection of routines that does this is known as the (Common Lisp) printer. +

    +

    Reading a printed representation +typically +produces an object that is equal to the +originally printed object. +

    + + + +
    • Multiple Possible Textual Representations   +
    • Printer Escaping   +
    + + + + + + diff --git a/info/gcl/Overview-of-the-Loop-Facility.html b/info/gcl/Overview-of-the-Loop-Facility.html new file mode 100644 index 0000000..7af91c1 --- /dev/null +++ b/info/gcl/Overview-of-the-Loop-Facility.html @@ -0,0 +1,88 @@ + + + + + +Overview of the Loop Facility (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.1 Overview of the Loop Facility

    + +

    The loop macro performs iteration. +

    + + + + + + + + + + + + + + + + + +
    • Simple vs Extended Loop   +
    • Simple Loop   +
    • Extended Loop   +
    • Loop Keywords   +
    • Parsing Loop Clauses   +
    • Expanding Loop Forms   +
    • Summary of Loop Clauses   +
    • Summary of Variable Initialization and Stepping Clauses   +
    • Summary of Value Accumulation Clauses   +
    • Summary of Termination Test Clauses   +
    • Summary of Unconditional Execution Clauses   +
    • Summary of Conditional Execution Clauses   +
    • Summary of Miscellaneous Clauses   +
    • Order of Execution   +
    • Destructuring   +
    • Restrictions on Side-Effects   +
    + + + + + + diff --git a/info/gcl/Package-Concepts.html b/info/gcl/Package-Concepts.html new file mode 100644 index 0000000..085a925 --- /dev/null +++ b/info/gcl/Package-Concepts.html @@ -0,0 +1,59 @@ + + + + + +Package Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages  

    +
    +
    +

    11.1 Package Concepts

    + + + + + +
    • Introduction to Packages   +
    • Standardized Packages   +
    + + + + + + diff --git a/info/gcl/Package-Inheritance.html b/info/gcl/Package-Inheritance.html new file mode 100644 index 0000000..95366cc --- /dev/null +++ b/info/gcl/Package-Inheritance.html @@ -0,0 +1,71 @@ + + + + + +Package Inheritance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Packages  

    +
    +
    +

    11.1.1.4 Package Inheritance

    + +

    Packages can be built up in layers. From one point of view, +a package is a single collection +of mappings from strings into internal symbols and +external symbols. +However, some of these mappings might be established within the package +itself, while other mappings are inherited from other packages +via use-package. +A symbol is said to be present + + in a package +if the mapping is in the package itself and is +not inherited from somewhere else. +

    +

    There is no way to inherit the internal symbols of another package; +to refer to an internal symbol using the Lisp reader, + a package containing the symbol + must be made to be the current package, + a package prefix must be used, + or the symbol must be imported into the current package. +

    + + + + + diff --git a/info/gcl/Package-Names-and-Nicknames.html b/info/gcl/Package-Names-and-Nicknames.html new file mode 100644 index 0000000..4a5d5b3 --- /dev/null +++ b/info/gcl/Package-Names-and-Nicknames.html @@ -0,0 +1,65 @@ + + + + + +Package Names and Nicknames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Packages  

    +
    +
    +

    11.1.1.1 Package Names and Nicknames

    + +

    Each package has a name (a string) and perhaps some nicknames +(also strings). +These are assigned when the package is created and can be changed later. +

    +

    There is a single namespace for packages. +The function find-package translates a package +name or nickname into the associated package. +The function package-name returns the name of a package. +The function package-nicknames returns +a list of all nicknames for a package. +rename-package removes a package’s +current name and nicknames and replaces them with new ones +specified by the caller. +

    + + + + + diff --git a/info/gcl/Package-Prefixes-for-Symbols.html b/info/gcl/Package-Prefixes-for-Symbols.html new file mode 100644 index 0000000..6117f71 --- /dev/null +++ b/info/gcl/Package-Prefixes-for-Symbols.html @@ -0,0 +1,112 @@ + + + + + +Package Prefixes for Symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.9 Package Prefixes for Symbols

    + +

    Package prefixes are printed if necessary. +The rules for package prefixes are as follows. +When the symbol is printed, if it is in the KEYWORD package, +then it is printed with a preceding colon; otherwise, if +it is accessible in the current package, it is printed without any +package prefix; otherwise, it is printed with a package prefix. +

    +

    A symbol that is apparently uninterned is printed +preceded by “#:” +

    +

    if *print-gensym* is true and printer escaping is enabled; +if *print-gensym* is false or printer escaping is disabled, +

    +

    then the symbol is printed without a prefix, +as if it were in the current package. +

    +

    Because the #: syntax does not intern the +following symbol, it is necessary to use circular-list syntax +if *print-circle* is true and +the same uninterned symbol appears several times in an expression +to be printed. For example, the result of +

    +
    +
     (let ((x (make-symbol "FOO"))) (list x x))
+
    + +

    would be printed as (#:foo #:foo) if *print-circle* +were false, but as (#1=#:foo #1#) if *print-circle* +were true. +

    +

    A summary of the preceding package prefix rules follows: +

    +
    +
    foo:bar
    +

    foo:bar is printed when symbol bar +is external in its home package foo +and is not accessible in the current package. +

    +
    +
    foo::bar
    +

    foo::bar is printed when bar is internal in its home package +foo and is not accessible in the current package. +

    +
    +
    :bar
    +

    :bar is printed when the home package of bar is the KEYWORD package. +

    +
    +
    #:bar
    +

    #:bar is printed when bar is apparently uninterned, +even in the pathological case that bar +has no home package but is nevertheless somehow accessible +in the current package. +

    +
    + +
    +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    + + + + + diff --git a/info/gcl/Package-System-Consistency-Rules.html b/info/gcl/Package-System-Consistency-Rules.html new file mode 100644 index 0000000..6b223c4 --- /dev/null +++ b/info/gcl/Package-System-Consistency-Rules.html @@ -0,0 +1,101 @@ + + + + + +Package System Consistency Rules (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Interpretation of Tokens  

    +
    +
    +

    2.3.6 Package System Consistency Rules

    + +

    The following rules apply to the package system as long as +the value of *package* is not changed: +

    +
    +
    Read-read consistency
    +

    Reading the same symbol name +always results in the same symbol. +

    +
    +
    Print-read consistency
    +

    An interned symbol always prints as a sequence of characters that, +when read back in, yields the same symbol. +

    +

    For information about how the Lisp printer treats symbols, +see Printing Symbols. +

    +
    +
    Print-print consistency
    +

    If two interned symbols are not the same, +then their printed representations will be different sequences of characters. +

    +
    + +

    These rules are true regardless of any implicit interning. +As long as the current package is not changed, +results are reproducible regardless of the order of loading files +or the exact history of what symbols were typed in when. +If the value of *package* is changed and then changed back to the previous value, +consistency is maintained. +The rules can be violated by + changing the value of *package*, + forcing a change to symbols + or to packages + or to both + by continuing from an error, +or calling one of the following functions: + unintern, + unexport, + shadow, + shadowing-import, + or unuse-package. +

    +

    An inconsistency only applies if one of the restrictions is violated +between two of the named symbols. +shadow, unexport, unintern, +and shadowing-import can only affect the consistency of +symbols with the same names (under string=) +as the ones supplied as arguments. +

    + + + + + + diff --git a/info/gcl/Packages-Dictionary.html b/info/gcl/Packages-Dictionary.html new file mode 100644 index 0000000..330a46f --- /dev/null +++ b/info/gcl/Packages-Dictionary.html @@ -0,0 +1,115 @@ + + + + + +Packages Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Packages  

    +
    +
    +

    11.2 Packages Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • package   +
    • export   +
    • find-symbol   +
    • find-package   +
    • find-all-symbols   +
    • import   +
    • list-all-packages   +
    • rename-package   +
    • shadow   +
    • shadowing-import   +
    • delete-package   +
    • make-package   +
    • with-package-iterator   +
    • unexport   +
    • unintern   +
    • in-package   +
    • unuse-package   +
    • use-package   +
    • defpackage   +
    • do-symbols   +
    • intern   +
    • package-name   +
    • package-nicknames   +
    • package-shadowing-symbols   +
    • package-use-list   +
    • package-used-by-list   +
    • packagep   +
    • *package*   +
    • package-error   +
    • package-error-package   +
    + + + + + + diff --git a/info/gcl/Packages-No-Longer-Required.html b/info/gcl/Packages-No-Longer-Required.html new file mode 100644 index 0000000..c38e2a5 --- /dev/null +++ b/info/gcl/Packages-No-Longer-Required.html @@ -0,0 +1,66 @@ + + + + + +Packages No Longer Required (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Removed Language Features  

    +
    +
    +

    27.1.7 Packages No Longer Required

    + +

    The packages + LISP + +, + USER + +, + and SYSTEM + +

    +

    are no longer required. It is valid for packages with one or more of these +names to be provided by a conforming implementation as extensions. +

    + + + + + + + + diff --git a/info/gcl/Packages.html b/info/gcl/Packages.html new file mode 100644 index 0000000..3c7c03a --- /dev/null +++ b/info/gcl/Packages.html @@ -0,0 +1,58 @@ + + + + + +Packages (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    11 Packages

    + + + + +
    • Package Concepts   +
    • Packages Dictionary   +
    + + + + + + diff --git a/info/gcl/Parsing-Loop-Clauses.html b/info/gcl/Parsing-Loop-Clauses.html new file mode 100644 index 0000000..f53b1c8 --- /dev/null +++ b/info/gcl/Parsing-Loop-Clauses.html @@ -0,0 +1,88 @@ + + + + + +Parsing Loop Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.5 Parsing Loop Clauses

    + +

    The syntactic parts of an extended loop form are called clauses; +the rules for parsing are determined by +that clause’s keyword. +The following example shows a loop form with six clauses: +

    +
    +
     (loop for i from 1 to (compute-top-value)       ; first clause
+       while (not (unacceptable i))              ; second clause
+       collect (square i)                        ; third clause
+       do (format t "Working on ~D now" i)       ; fourth clause
+       when (evenp i)                            ; fifth clause
+         do (format t "~D is a non-odd number" i)
+       finally (format t "About to exit!"))      ; sixth clause
+
    + +

    Each loop keyword introduces +either a compound loop clause or a simple loop clause +that can consist of a loop keyword followed by a single form. +The number of forms in a clause is determined by the loop keyword +that begins the clause and by the auxiliary keywords in the clause. +The keywords do, +

    +

    doing, +

    +

    initially, and finally +are the only loop keywords that can take any number of forms and +group them as an implicit progn. +

    +

    Loop clauses can contain auxiliary keywords, which are sometimes +called prepositions. For example, the first clause in the code +above includes the prepositions from and to, +which mark the value from which stepping begins and the value at which stepping +ends. +

    +

    For detailed information about loop syntax, +see the macro loop. +

    + + + + + diff --git a/info/gcl/Parsing-Namestrings-Into-Pathnames.html b/info/gcl/Parsing-Namestrings-Into-Pathnames.html new file mode 100644 index 0000000..e581e63 --- /dev/null +++ b/info/gcl/Parsing-Namestrings-Into-Pathnames.html @@ -0,0 +1,65 @@ + + + + + +Parsing Namestrings Into Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Overview of Filenames  

    +
    +
    +

    19.1.3 Parsing Namestrings Into Pathnames

    + +

    Parsing is the operation used to convert a namestring into a pathname. +

    +

    Except in the case of parsing logical pathname namestrings, +

    +

    this operation is implementation-dependent, +because the format of namestrings is implementation-dependent. +

    +

    A conforming implementation is free to accommodate other file system +features in its pathname representation and provides a parser that can process +such specifications in namestrings. +Conforming programs must not depend on any such features, +since those features will not be portable. +

    + + + + + + diff --git a/info/gcl/Pathname-Components.html b/info/gcl/Pathname-Components.html new file mode 100644 index 0000000..254f3b1 --- /dev/null +++ b/info/gcl/Pathname-Components.html @@ -0,0 +1,74 @@ + + + + + +Pathname Components (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pathnames  

    +
    +
    +

    19.2.1 Pathname Components

    + +

    A pathname has six components: + a host, + a device, + a directory, + a name, + a type, + and a version. +

    + + + + + + + +
    • The Pathname Host Component   +
    • The Pathname Device Component   +
    • The Pathname Directory Component   +
    • The Pathname Name Component   +
    • The Pathname Type Component   +
    • The Pathname Version Component   +
    + + + + + + diff --git a/info/gcl/Pathnames-as-Filenames.html b/info/gcl/Pathnames-as-Filenames.html new file mode 100644 index 0000000..991366a --- /dev/null +++ b/info/gcl/Pathnames-as-Filenames.html @@ -0,0 +1,133 @@ + + + + + +Pathnames as Filenames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of Filenames  

    +
    +
    +

    19.1.2 Pathnames as Filenames

    + +

    Pathnames + + are structured objects that can represent, +in an implementation-independent way, +the filenames that are used natively by an underlying file system. +

    +

    In addition, pathnames can also represent certain partially composed +filenames for which an underlying file system +might not have a specific namestring representation. +

    +

    A pathname need not correspond to any file that actually exists, +and more than one pathname can refer to the same file. +For example, the pathname with a version of :newest +might refer to the same file as a pathname +with the same components except a certain number as the version. +Indeed, a pathname with version :newest might refer to +different files as time passes, because the meaning of such a pathname +depends on the state of the file system. +

    +

    Some file systems naturally use a structural model for their +filenames, while others do not. Within the Common Lisp pathname model, +all filenames are seen as having a particular structure, +even if that structure is not reflected in the underlying file system. +The nature of the mapping between structure imposed by pathnames +and the structure, if any, that is used by the underlying file system +is implementation-defined. +

    +

    Every pathname has six components: + a host, + a device, + a directory, + a name, + a type, + and a version. +By naming files with pathnames, +Common Lisp programs can work in essentially the same way even in file systems +that seem superficially quite different. +For a detailed description of these components, see Pathname Components. +

    +

    The mapping of the pathname components into the concepts peculiar to +each file system is implementation-defined. +There exist conceivable pathnames +for which there is no mapping to a syntactically valid filename +in a particular implementation. +An implementation may use various strategies in an attempt to find a mapping; +for example, +an implementation may quietly truncate filenames +that exceed length limitations imposed by the underlying file system, +or ignore certain pathname components +for which the file system provides no support. +If such a mapping cannot be found, +an error of type file-error is signaled. +

    +

    The time at which this mapping and associated error signaling +occurs is implementation-dependent. +Specifically, it may occur + at the time the pathname is constructed, + when coercing a pathname to a namestring, + or when an attempt is made to open or otherwise access the file + designated by the pathname. +

    +

    Figure 19–1 lists some defined names that are applicable to pathnames. +

    +
    +
      *default-pathname-defaults*  namestring          pathname-name          
+  directory-namestring         open                pathname-type          
+  enough-namestring            parse-namestring    pathname-version       
+  file-namestring              pathname            pathnamep              
+  file-string-length           pathname-device     translate-pathname     
+  host-namestring              pathname-directory  truename               
+  make-pathname                pathname-host       user-homedir-pathname  
+  merge-pathnames              pathname-match-p    wild-pathname-p        
+
+                     Figure 19–1: Pathname Operations                    
+
+
    + +
    +
    +

    +Next: , Previous: , Up: Overview of Filenames  

    +
    + + + + + diff --git a/info/gcl/Pathnames.html b/info/gcl/Pathnames.html new file mode 100644 index 0000000..e1ca1b2 --- /dev/null +++ b/info/gcl/Pathnames.html @@ -0,0 +1,61 @@ + + + + + +Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames  

    +
    +
    +

    19.2 Pathnames

    + + + + + + +
    • Pathname Components   +
    • Interpreting Pathname Component Values   +
    • Merging Pathnames   +
    + + + + + + diff --git a/info/gcl/Potential-Numbers-as-Tokens.html b/info/gcl/Potential-Numbers-as-Tokens.html new file mode 100644 index 0000000..4be75cb --- /dev/null +++ b/info/gcl/Potential-Numbers-as-Tokens.html @@ -0,0 +1,123 @@ + + + + + +Potential Numbers as Tokens (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers as Tokens  

    +
    +
    +

    2.3.1.1 Potential Numbers as Tokens

    + +

    To allow implementors and future Common Lisp standards +to extend the syntax of numbers, a +syntax for potential numbers is defined that is +more general than the syntax for numbers. +A token is a potential number if it satisfies all of the following +requirements: +

    +
    +
    1.
    +

    The token consists entirely of + digits, + signs, + ratio markers, + decimal points (.), + extension characters (^ or _), + and number markers. +A number marker is a letter. +Whether a letter may be treated as a number marker depends on context, +but no letter that is adjacent to another letter may ever be treated as a number marker. +Exponent markers are number markers. +

    +
    +
    2.
    +

    The token contains at least one digit. Letters may be considered to be +digits, depending on the current input base, but only +in tokens containing no decimal points. +

    +
    +
    3.
    +

    The token begins with a digit, sign, decimal point, or extension character, +

    +

    [Reviewer Note by Barmar: This section is unnecessary because the first bullet already + omits discussion of a colon (package marker).] +but not a +package marker. +The syntax involving a leading +package marker followed by a potential number is +not well-defined. The consequences of the use +of notation such as :1, :1/2, and :2^3 in a +position where an expression appropriate for read +is expected are unspecified. +

    +
    +
    4.
    +

    The token does not end with a sign. +

    +
    + +

    If a potential number has number syntax, +a number of the appropriate type is constructed and returned, +if the number is representable in an implementation. +A number will not be representable in an implementation +if it is outside the boundaries set by the implementation-dependent +constants for numbers. +For example, specifying too large or too small an exponent for a float +may make the number impossible to represent in the implementation. +A ratio with denominator zero (such as -35/000) +is not represented in any implementation. +When a token with the syntax of a number cannot be converted to an internal +number, an error of type reader-error is signaled. An error +must not be signaled for specifying too many significant digits +for a float; a truncated or rounded value should be produced. +

    +

    If there is an ambiguity as to whether +a letter should be treated as a digit or as a number marker, +the letter is treated as a digit. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers as Tokens  

    +
    + + + + + diff --git a/info/gcl/Pretty-Print-Dispatch-Tables.html b/info/gcl/Pretty-Print-Dispatch-Tables.html new file mode 100644 index 0000000..d949a77 --- /dev/null +++ b/info/gcl/Pretty-Print-Dispatch-Tables.html @@ -0,0 +1,89 @@ + + + + + +Pretty Print Dispatch Tables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pretty Printer Concepts  

    +
    +
    +

    22.2.1.4 Pretty Print Dispatch Tables

    + +

    A pprint dispatch table + + is a mapping from keys to pairs of values. +Each key is a type specifier. +The values associated with a key are + a “function” (specifically, a function designator or nil) + and a “numerical priority” (specifically, a real). +Basic insertion and retrieval is done based on the keys with the equality +of keys being tested by equal. +

    +

    When *print-pretty* is true, +the current pprint dispatch table + + (in *print-pprint-dispatch*) +controls how objects are printed. +The information in this table takes precedence over +all other mechanisms for specifying how to print objects. +In particular, it +has priority over +user-defined print-object methods +

    +

    because the current pprint dispatch table is consulted first. +

    +

    The function is chosen from the current pprint dispatch table +by finding the highest priority function +that is associated with a type specifier that matches the object; +if there is more than one such function, +it is implementation-dependent which is used. +

    +

    However, if there is no +information in the table +about how to pretty print a particular kind of object, +a function is invoked which uses print-object to print the object. +The value of *print-pretty* is still true +when this function is called, +and individual methods for print-object might still elect to +produce output in a special format conditional on the value of *print-pretty*. +

    + + + + + diff --git a/info/gcl/Pretty-Printer-Concepts.html b/info/gcl/Pretty-Printer-Concepts.html new file mode 100644 index 0000000..ee43dd3 --- /dev/null +++ b/info/gcl/Pretty-Printer-Concepts.html @@ -0,0 +1,92 @@ + + + + + +Pretty Printer Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Lisp Pretty Printer  

    +
    +
    +

    22.2.1 Pretty Printer Concepts

    + +

    The facilities provided by the pretty printer + + permit +programs to redefine the way in which code is displayed, +and allow the full power of pretty printing to be applied +to complex combinations of data structures. +

    +

    Whether any given style of output is in fact “pretty” is inherently a +somewhat subjective issue. However, since the effect of the +pretty printer can be customized by conforming programs, +the necessary flexibility is provided for individual programs +to achieve an arbitrary degree of aesthetic control. +

    +

    By providing direct access to the mechanisms within the pretty printer +that make dynamic decisions about layout, the macros and functions +pprint-logical-block, pprint-newline, and +pprint-indent make it possible to specify pretty printing +layout rules as a part of any function that produces output. They also +make it very easy for the detection of circularity and sharing, and +abbreviation based on length and nesting depth to be supported by the +function. +

    +

    The pretty printer is driven entirely by dispatch based on +the value of *print-pprint-dispatch*. +The function set-pprint-dispatch makes it possible +for conforming programs to associate new pretty printing +functions with a type. +

    + + + + + + +
    • Dynamic Control of the Arrangement of Output   +
    • Format Directive Interface   +
    • Compiling Format Strings   +
    • Pretty Print Dispatch Tables   +
    • Pretty Printer Margins   +
    + + + + + + diff --git a/info/gcl/Pretty-Printer-Margins.html b/info/gcl/Pretty-Printer-Margins.html new file mode 100644 index 0000000..e6bf11e --- /dev/null +++ b/info/gcl/Pretty-Printer-Margins.html @@ -0,0 +1,58 @@ + + + + + +Pretty Printer Margins (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Pretty Printer Concepts  

    +
    +
    +

    22.2.1.5 Pretty Printer Margins

    + +

    A primary goal of pretty printing is to keep the output between a pair of +margins. +The column where the output begins is taken as the left margin. +If the current column cannot be determined at the time output begins, +the left margin is assumed to be zero. +The right margin is controlled by *print-right-margin*. +

    + + + + + diff --git a/info/gcl/Prevention-of-Name-Conflicts-in-Packages.html b/info/gcl/Prevention-of-Name-Conflicts-in-Packages.html new file mode 100644 index 0000000..f6a9653 --- /dev/null +++ b/info/gcl/Prevention-of-Name-Conflicts-in-Packages.html @@ -0,0 +1,160 @@ + + + + + +Prevention of Name Conflicts in Packages (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Introduction to Packages  

    +
    +
    +

    11.1.1.7 Prevention of Name Conflicts in Packages

    + +

    Within one package, any particular name can refer to at most one +symbol. A name conflict is said to occur when there would be more than +one candidate symbol. Any time a name conflict is about to occur, +a correctable error is signaled. +

    +

    The following rules apply to name conflicts: +

    +
    –
    +

    Name conflicts are detected when they become possible, that is, when the +package structure is altered. Name +conflicts are not checked during every name lookup. +

    +
    +
    –
    +

    If the same symbol is accessible to a package +through more than one path, there is no name conflict. +A symbol cannot conflict with itself. +Name conflicts occur only between distinct symbols with +the same name (under string=). +

    +
    +
    –
    +

    Every package has a list of shadowing symbols. +A shadowing symbol takes precedence over any other symbol of +the same name that would otherwise be accessible in the package. +A name conflict involving a shadowing symbol is always resolved in favor of +the shadowing symbol, without signaling an error (except for one +exception involving import). +See shadow and shadowing-import. +

    +
    +
    –
    +

    The functions use-package, import, and +export check for name conflicts. +

    +
    +
    –
    +

    shadow and shadowing-import +never signal a name-conflict error. +

    +
    +
    –
    +

    unuse-package and unexport +do not need to do any name-conflict checking. +unintern does name-conflict checking only when a symbol +being uninterned is a shadowing symbol + +. +

    +
    +
    –
    +

    Giving a shadowing symbol to unintern +can uncover a name conflict that had +previously been resolved by the shadowing. +

    +
    +
    –
    +

    Package functions signal name-conflict errors of type package-error before making any + change to the package structure. When multiple changes are to be made, + it is + permissible for the implementation to process each change separately. + For example, when export is given a +list of +symbols, + aborting from a name + conflict caused by the second symbol + in the list might still export the + first symbol in the list. + However, a name-conflict error caused by export + of a single symbol will be signaled before + that symbol’s accessibility in any package is changed. +

    +
    +
    –
    +

    Continuing from a name-conflict error must offer the user a chance to +resolve the name conflict in favor of either of the candidates. The +package +structure should be altered to reflect the resolution of the +name conflict, via shadowing-import, +unintern, +or unexport. +

    +
    +
    –
    +

    A name conflict in use-package between a symbol +present in the using package and an external symbol of the used +package is resolved in favor of the first symbol by making it a +shadowing symbol, or in favor of the second symbol by uninterning +the first symbol from the using package. +

    +
    +
    –
    +

    A name conflict in export or unintern +due to a package’s inheriting two distinct symbols +with the same name (under string=) +from two other packages can be resolved in +favor of either symbol by importing it into the using +package and making it a shadowing symbol + +, +just as with use-package. +

    +
    + +
    +
    +

    +Previous: , Up: Introduction to Packages  

    +
    + + + + + diff --git a/info/gcl/Principal-Values-and-Branch-Cuts.html b/info/gcl/Principal-Values-and-Branch-Cuts.html new file mode 100644 index 0000000..662d317 --- /dev/null +++ b/info/gcl/Principal-Values-and-Branch-Cuts.html @@ -0,0 +1,103 @@ + + + + + +Principal Values and Branch Cuts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Complex Computations  

    +
    +
    +

    12.1.5.5 Principal Values and Branch Cuts

    + +

    Many of the irrational and transcendental functions are multiply defined +in the complex domain; for example, there are in general an infinite +number of complex values for the logarithm function. In each such +case, a principal value must be chosen for the function to return. +In general, such values cannot be chosen so as to make the range +continuous; lines in the domain +called branch cuts must be defined, which in turn +define the discontinuities in the range. +Common Lisp defines the branch cuts, principal values, and boundary +conditions for the complex functions following “Principal Values and Branch Cuts in Complex APL.” The branch +cut rules that apply to each function are located with the description of +that function. +

    +

    Figure 12–9 lists +the identities that are obeyed +throughout the applicable portion of the complex domain, even on +the branch cuts: +

    +
    +
      sin i z = i sinh z  sinh i z = i sin z        arctan i z = i arctanh z  
+  cos i z = cosh z    cosh i z = cos z          arcsinh i z = i arcsin z  
+  tan i z = i tanh z  arcsin i z = i arcsinh z  arctanh i z = i arctan z  
+
+         Figure 12–9: Trigonometric Identities for Complex Domain        
+
+
    + +

    The quadrant numbers referred to in the discussions of branch cuts are as illustrated +in Figure 12–10. +

    +
    +
                               Imaginary Axis
+	                         |
+	        		 |
+	        	II       |        I
+	        	         |
+	        	         |
+	        	         |
+	       ______________________________________ Real Axis
+	        	         |
+	        	         |
+	        	         |
+	               III       |     	   IV
+	        		 |
+	        		 |
+	        		 |
+	        		 |
+
+
    + +

      Figure 12–9: Quadrant Numbering for Branch Cuts +

    + + + + + diff --git a/info/gcl/Printer-Dictionary.html b/info/gcl/Printer-Dictionary.html new file mode 100644 index 0000000..5fa1bd9 --- /dev/null +++ b/info/gcl/Printer-Dictionary.html @@ -0,0 +1,117 @@ + + + + + +Printer Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Printer  

    +
    +
    +

    22.4 Printer Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • copy-pprint-dispatch   +
    • formatter   +
    • pprint-dispatch   +
    • pprint-exit-if-list-exhausted   +
    • pprint-fill   +
    • pprint-indent   +
    • pprint-logical-block   +
    • pprint-newline   +
    • pprint-pop   +
    • pprint-tab   +
    • print-object   +
    • print-unreadable-object   +
    • set-pprint-dispatch   +
    • write   +
    • write-to-string   +
    • *print-array*   +
    • *print-base*   +
    • *print-case*   +
    • *print-circle*   +
    • *print-escape*   +
    • *print-gensym*   +
    • *print-level*   +
    • *print-lines*   +
    • *print-miser-width*   +
    • *print-pprint-dispatch*   +
    • *print-pretty*   +
    • *print-readably*   +
    • *print-right-margin*   +
    • print-not-readable   +
    • print-not-readable-object   +
    • format   +
    + + + + + + diff --git a/info/gcl/Printer-Dispatching.html b/info/gcl/Printer-Dispatching.html new file mode 100644 index 0000000..2c9f47d --- /dev/null +++ b/info/gcl/Printer-Dispatching.html @@ -0,0 +1,62 @@ + + + + + +Printer Dispatching (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Lisp Printer  

    +
    +
    +

    22.1.2 Printer Dispatching

    + +

    The Lisp printer makes its determination of how to print an +object as follows: +

    +

    If the value of *print-pretty* is true, +printing is controlled by the current pprint dispatch table; +see Pretty Print Dispatch Tables. +

    +

    Otherwise (if the value of *print-pretty* is false), +the object’s print-object method is used; +see Default Print-Object Methods. +

    + + + + + diff --git a/info/gcl/Printer-Escaping.html b/info/gcl/Printer-Escaping.html new file mode 100644 index 0000000..b9f06d1 --- /dev/null +++ b/info/gcl/Printer-Escaping.html @@ -0,0 +1,70 @@ + + + + + +Printer Escaping (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Overview of The Lisp Printer  

    +
    +
    +

    22.1.1.2 Printer Escaping

    + +

    The variable *print-escape* controls whether the Lisp printer +tries to produce notations such as escape characters and package prefixes. +

    +

    The variable *print-readably* can be used to override +many of the individual aspects controlled by the other +printer control variables when program-readable output +is especially important. +

    +

    One of the many effects of making the value of *print-readably* be true +is that the Lisp printer behaves as if *print-escape* were also true. +For notational convenience, we say that +if the value of either *print-readably* or *print-escape* is true, +then printer escaping + + is “enabled”; +and we say that +if the values of both *print-readably* and *print-escape* are false, +then printer escaping is “disabled”. +

    + + + + + diff --git a/info/gcl/Printer.html b/info/gcl/Printer.html new file mode 100644 index 0000000..ac40a8f --- /dev/null +++ b/info/gcl/Printer.html @@ -0,0 +1,62 @@ + + + + + +Printer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    22 Printer

    + + + + + + +
    • The Lisp Printer   +
    • The Lisp Pretty Printer   +
    • Formatted Output   +
    • Printer Dictionary   +
    + + + + + + diff --git a/info/gcl/Printing-Bit-Vectors.html b/info/gcl/Printing-Bit-Vectors.html new file mode 100644 index 0000000..58fadd0 --- /dev/null +++ b/info/gcl/Printing-Bit-Vectors.html @@ -0,0 +1,62 @@ + + + + + +Printing Bit Vectors (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.14 Printing Bit Vectors

    + +

    A bit vector is printed as #* followed by the bits of the bit vector +in order. If *print-array* is false, then the bit vector is +printed in a format (using #<) that is concise but not readable. +Only the active elements of the bit vector are printed. +

    +

    [Reviewer Note by Barrett: Need to provide for #5*0 as an alternate + notation for #*00000.] +

    +

    For information on Lisp reader parsing of bit vectors, +see Sharpsign Asterisk. +

    + + + + + diff --git a/info/gcl/Printing-Characters.html b/info/gcl/Printing-Characters.html new file mode 100644 index 0000000..420450e --- /dev/null +++ b/info/gcl/Printing-Characters.html @@ -0,0 +1,74 @@ + + + + + +Printing Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.7 Printing Characters

    + +

    When printer escaping is disabled, +

    +

    a character prints as itself; +it is sent directly to the output stream. +

    +

    When printer escaping is enabled, +

    +

    then #\ syntax is used. +

    +

    When the printer types out the name of a character, +it uses the same table as the #\ reader macro would use; +therefore any character name that is typed out +is acceptable as input (in that implementation). +If a non-graphic character has a standardized name_5, +that name is preferred over non-standard names +for printing in #\ notation. +For the graphic standard characters, +the character itself is always used +for printing in #\ notation—even if +the character also has a name_5. +

    +

    For details about the #\ reader macro, see Sharpsign Backslash. +

    + + + + + diff --git a/info/gcl/Printing-Complexes.html b/info/gcl/Printing-Complexes.html new file mode 100644 index 0000000..186cddf --- /dev/null +++ b/info/gcl/Printing-Complexes.html @@ -0,0 +1,61 @@ + + + + + +Printing Complexes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.5 Printing Complexes

    + + + +

    A complex is printed as #C, an open parenthesis, +the printed representation of its real part, a space, +the printed representation of its imaginary part, and finally +a close parenthesis. +

    +

    For related information about the syntax of a complex, +see Syntax of a Complex and Sharpsign C. +

    + + + + + diff --git a/info/gcl/Printing-Conditions.html b/info/gcl/Printing-Conditions.html new file mode 100644 index 0000000..8546d23 --- /dev/null +++ b/info/gcl/Printing-Conditions.html @@ -0,0 +1,89 @@ + + + + + +Printing Conditions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Condition System Concepts  

    +
    +
    +

    9.1.3 Printing Conditions

    + +

    If the :report argument to define-condition is used, +a print function is defined that is called whenever +the defined condition is printed while the value of *print-escape* is false. +This function is called the condition reporter + +; +the text which it outputs is called a report message + +. +

    +

    When a condition is printed and *print-escape* +is false, the condition reporter for the condition is invoked. +Conditions are printed automatically by functions such as +invoke-debugger, break, and warn. +

    +

    When *print-escape* is true, the object should print in an +abbreviated fashion according to the style of the implementation +(e.g., by print-unreadable-object). It is not required that a +condition can be recreated by reading its printed representation. +

    +

    No function is provided for directly accessing +or invoking condition reporters. +

    + + + + + + + +
    • Recommended Style in Condition Reporting   +
    • Capitalization and Punctuation in Condition Reports   +
    • Leading and Trailing Newlines in Condition Reports   +
    • Embedded Newlines in Condition Reports   +
    • Note about Tabs in Condition Reports   +
    • Mentioning Containing Function in Condition Reports   +
    + + + + + + diff --git a/info/gcl/Printing-Floats.html b/info/gcl/Printing-Floats.html new file mode 100644 index 0000000..5e95a36 --- /dev/null +++ b/info/gcl/Printing-Floats.html @@ -0,0 +1,87 @@ + + + + + +Printing Floats (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.4 Printing Floats

    + + + +

    If the magnitude of the float is either zero or between 10^-3 (inclusive) +and 10^7 (exclusive), it is printed as the integer part of the number, +then a decimal point, +followed by the fractional part of the number; +there is always at least one +digit on each side of the decimal point. +If the sign of the number +(as determined by float-sign) +is negative, then a minus sign is printed before the number. +If the format of the number +does not match that specified by +*read-default-float-format*, then the exponent marker for +that format and the digit 0 are also printed. +For example, the base of the natural logarithms as a short float +might be printed as 2.71828S0. +

    +

    For non-zero magnitudes outside of the range 10^-3 to 10^7, +a float is printed in computerized scientific notation. +The representation of the number is scaled to be between +1 (inclusive) and 10 (exclusive) and then printed, with one digit +before the decimal point and at least one digit after the decimal point. +Next the exponent marker for the format is printed, +except that +if the format of the number matches that specified by +*read-default-float-format*, then the exponent marker E +is used. +Finally, the power of ten by which the fraction must be multiplied +to equal the original number is printed as a decimal integer. +For example, Avogadro’s number as a short float +is printed as 6.02S23. +

    +

    For related information about the syntax of a float, +see Syntax of a Float. +

    + + + + + diff --git a/info/gcl/Printing-Integers.html b/info/gcl/Printing-Integers.html new file mode 100644 index 0000000..3967c8c --- /dev/null +++ b/info/gcl/Printing-Integers.html @@ -0,0 +1,64 @@ + + + + + +Printing Integers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.2 Printing Integers

    + +

    Integers are printed in the radix specified by the current output base +in positional notation, most significant digit first. +If appropriate, a radix specifier can be printed; see *print-radix*. +If an integer is negative, a minus sign is printed and then the +absolute value of the integer is printed. +The integer zero is represented +by the single digit 0 and never has a sign. +A decimal point might be printed, +depending on the value of *print-radix*. +

    +

    For related information about the syntax of an integer, +see Syntax of an Integer. +

    + + + + + diff --git a/info/gcl/Printing-Lists-and-Conses.html b/info/gcl/Printing-Lists-and-Conses.html new file mode 100644 index 0000000..40f4d52 --- /dev/null +++ b/info/gcl/Printing-Lists-and-Conses.html @@ -0,0 +1,143 @@ + + + + + +Printing Lists and Conses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.13 Printing Lists and Conses

    + +

    Wherever possible, list notation is preferred over dot notation. +Therefore the following algorithm is used to print a cons x: +

    +
    +
    1.
    +

    A left-parenthesis is printed. +

    +
    +
    2.
    +

    The car of x is printed. +

    +
    +
    3.
    +

    If the cdr of x is itself a cons, + it is made to be the current cons + (i.e., x becomes that cons), +

    +

    a space +

    +

    is printed, + and step 2 is re-entered. +

    +
    +
    4.
    +

    If the cdr of x is not null, +

    +

    a space, +

    +

    a dot, +

    +

    a space, +

    +

    and the cdr of x are printed. +

    +
    +
    5.
    +

    A right-parenthesis is printed. +

    +
    + +

    Actually, the above algorithm is only used when *print-pretty* +is false. When *print-pretty* is true (or +when pprint is used), +additional whitespace_1 +may replace the use of a single space, +and a more elaborate algorithm with similar goals but more presentational +flexibility is used; see Printer Dispatching. +

    +

    Although the two expressions below are equivalent, +and the reader accepts +either one and +produces +the same cons, the printer +always prints such a cons in the second form. +

    +
    +
     (a . (b . ((c . (d . nil)) . (e . nil))))
+ (a b (c d) e)
+
    + +

    The printing of conses is affected by *print-level*, +*print-length*, and *print-circle*. +

    +

    Following are examples of printed representations of lists: +

    +
    +
     (a . b)     ;A dotted pair of a and b
+ (a.b)       ;A list of one element, the symbol named a.b
+ (a. b)      ;A list of two elements a. and b
+ (a .b)      ;A list of two elements a and .b
+ (a b . c)   ;A dotted list of a and b with c at the end; two conses
+ .iot        ;The symbol whose name is .iot
+ (. b)       ;Invalid -- an error is signaled if an attempt is made to read 
+             ;this syntax.
+ (a .)       ;Invalid -- an error is signaled.
+ (a .. b)    ;Invalid -- an error is signaled.
+ (a . . b)   ;Invalid -- an error is signaled.
+ (a b c ...) ;Invalid -- an error is signaled.
+ (a \. b)    ;A list of three elements a, ., and b
+ (a |.| b)   ;A list of three elements a, ., and b
+ (a \... b)  ;A list of three elements a, ..., and b
+ (a |...| b) ;A list of three elements a, ..., and b
+
    + +

    For information on how the Lisp reader parses lists and conses, +see Left-Parenthesis. +

    +
    +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    + + + + + diff --git a/info/gcl/Printing-Numbers.html b/info/gcl/Printing-Numbers.html new file mode 100644 index 0000000..1051382 --- /dev/null +++ b/info/gcl/Printing-Numbers.html @@ -0,0 +1,51 @@ + + + + + +Printing Numbers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.1 Printing Numbers

    + + + + + + diff --git a/info/gcl/Printing-Other-Arrays.html b/info/gcl/Printing-Other-Arrays.html new file mode 100644 index 0000000..e61e6ec --- /dev/null +++ b/info/gcl/Printing-Other-Arrays.html @@ -0,0 +1,118 @@ + + + + + +Printing Other Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.16 Printing Other Arrays

    + +

    If *print-array* is true +and *print-readably* is false, +any +

    +

    array other than a vector is printed +using #nA format. +Let n be the rank of the array. +Then # is printed, then n as a decimal integer, +then A, then n open parentheses. +Next the elements are scanned in row-major order, +using write on each element, +and separating elements from each other with whitespace_1. +The array’s dimensions are numbered 0 to n-1 from left to right, +and are enumerated with the rightmost index changing fastest. +Every time the index for dimension j is incremented, +the following actions are taken: +

    +
    +
    *
    +

    If j < n-1, then a close parenthesis is printed. +

    +
    +
    *
    +

    If incrementing the index for dimension j caused it to equal +dimension j, that index is reset to zero and the +index for dimension j-1 is incremented (thereby performing these three steps recursively), +unless j=0, in which case the entire algorithm is terminated. +If incrementing the index for dimension j did not cause it to +equal dimension j, then a space is printed. +

    +
    +
    *
    +

    If j < n-1, then an open parenthesis is printed. +

    +
    + +

    This causes the contents to be printed in a format suitable for +:initial-contents to make-array. +The lists effectively printed by this procedure are subject to +truncation by *print-level* and *print-length*. +

    +

    If the array +is of a specialized type, containing bits or characters, +then the innermost lists generated by the algorithm given above can instead +be printed using bit-vector or string syntax, provided that these innermost +lists would not be subject to truncation by *print-length*. +

    +

    If both *print-array* and *print-readably* are false, +

    +

    then the array is printed +in a format (using #<) that is concise but not readable. +

    +

    If *print-readably* is true, +the array prints in an implementation-defined manner; +see the variable *print-readably*. +

    +

    In particular, +this may be important for arrays having some dimension 0. +

    +

    For information on how the Lisp reader parses these “other arrays,” +see Sharpsign A. +

    +
    +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    + + + + + diff --git a/info/gcl/Printing-Other-Objects.html b/info/gcl/Printing-Other-Objects.html new file mode 100644 index 0000000..40f37b5 --- /dev/null +++ b/info/gcl/Printing-Other-Objects.html @@ -0,0 +1,72 @@ + + + + + +Printing Other Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.21 Printing Other Objects

    + +

    Other objects are printed in an implementation-dependent manner. +It is not required that an implementation print those objects +readably. +

    +

    For example, hash tables, + readtables, + packages, + streams, + and functions +might not print readably. +

    +

    A common notation to use in this circumstance is #<...>. +Since #< is not readable by the Lisp reader, +the precise format of the text which follows is not important, +but a common format to use is that provided by the print-unreadable-object macro. +

    +

    For information on how the Lisp reader treats this notation, +see Sharpsign Less-Than-Sign. +For information on how to notate objects that cannot be printed readably, +see Sharpsign Dot. +

    + + + + + diff --git a/info/gcl/Printing-Other-Vectors.html b/info/gcl/Printing-Other-Vectors.html new file mode 100644 index 0000000..d60abad --- /dev/null +++ b/info/gcl/Printing-Other-Vectors.html @@ -0,0 +1,88 @@ + + + + + +Printing Other Vectors (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.15 Printing Other Vectors

    + +

    If *print-array* is true +and *print-readably* is false, +any +

    +

    vector +other than a string or bit vector is printed using +general-vector syntax; this means that information +about specialized vector representations does not appear. +The printed representation of a zero-length vector is #(). +The printed representation of a non-zero-length vector begins with #(. +Following that, the first element of the vector is printed. +

    +

    If there are any other elements, they are printed in turn, with +each such additional element preceded by +a space if *print-pretty* is false, +or whitespace_1 if *print-pretty* is true. +

    +

    A right-parenthesis after the last element +terminates the printed representation of the vector. +The printing of vectors +is affected by *print-level* and *print-length*. +If the vector has a fill pointer, +then only those elements below +the fill pointer are printed. +

    +

    If both *print-array* and *print-readably* are false, +

    +

    the vector is not printed as described above, +but in a format (using #<) that is concise but not readable. +

    +

    If *print-readably* is true, +the vector prints in an implementation-defined manner; +see the variable *print-readably*. +

    +

    For information on how the Lisp reader parses these “other vectors,” +see Sharpsign Left-Parenthesis. +

    + + + + + diff --git a/info/gcl/Printing-Pathnames.html b/info/gcl/Printing-Pathnames.html new file mode 100644 index 0000000..c9e2693 --- /dev/null +++ b/info/gcl/Printing-Pathnames.html @@ -0,0 +1,65 @@ + + + + + +Printing Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.19 Printing Pathnames

    + +

    When printer escaping is enabled, +

    +

    the syntax #P"..." is how a +pathname is printed by write and the other functions herein described. +The "..." is the namestring representation of the pathname. +

    +

    When printer escaping is disabled, +

    +

    write writes a pathname P +by writing (namestring P) instead. +

    +

    For information on how the Lisp reader parses pathnames, +see Sharpsign P. +

    + + + + + diff --git a/info/gcl/Printing-Random-States.html b/info/gcl/Printing-Random-States.html new file mode 100644 index 0000000..90eef54 --- /dev/null +++ b/info/gcl/Printing-Random-States.html @@ -0,0 +1,71 @@ + + + + + +Printing Random States (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.18 Printing Random States

    + +

    A specific syntax for printing objects of type random-state is +not specified. However, every implementation +must arrange to print a random state object in such a way that, +within the same implementation, read +can construct from the printed representation a copy of the +random state +object as if the copy had been made by make-random-state. +

    +

    If the type random state is effectively implemented +by using the machinery for defstruct, +the usual structure syntax can then be used for printing +random state +objects; one might look something like +

    +
    +
     #S(RANDOM-STATE :DATA #(14 49 98436589 786345 8734658324 ... ))
+
    + +

    where the components are implementation-dependent. +

    + + + + + diff --git a/info/gcl/Printing-Ratios.html b/info/gcl/Printing-Ratios.html new file mode 100644 index 0000000..2526e23 --- /dev/null +++ b/info/gcl/Printing-Ratios.html @@ -0,0 +1,67 @@ + + + + + +Printing Ratios (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.3 Printing Ratios

    + + + +

    Ratios are printed as follows: +the absolute value of the numerator is printed, as for an integer; +then a /; then the denominator. The numerator and denominator are +both printed in the radix specified by the current output base; +they are obtained as if by +numerator and denominator, and so ratios +are printed in reduced form (lowest terms). +If appropriate, a radix specifier can be printed; see +*print-radix*. +If the ratio is negative, a minus sign is printed before the numerator. +

    +

    For related information about the syntax of a ratio, +see Syntax of a Ratio. +

    + + + + + diff --git a/info/gcl/Printing-Strings.html b/info/gcl/Printing-Strings.html new file mode 100644 index 0000000..db19b84 --- /dev/null +++ b/info/gcl/Printing-Strings.html @@ -0,0 +1,63 @@ + + + + + +Printing Strings (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.12 Printing Strings

    + +

    The characters of the string are output in order. +

    +

    If printer escaping is enabled, +

    +

    a double-quote is output before and after, and all +double-quotes and single escapes are preceded by backslash. +The printing of strings is not affected by *print-array*. +Only the active elements of the string are printed. +

    +

    For information on how the Lisp reader parses strings, +see Double-Quote. +

    + + + + + diff --git a/info/gcl/Printing-Structures.html b/info/gcl/Printing-Structures.html new file mode 100644 index 0000000..5fe8cbc --- /dev/null +++ b/info/gcl/Printing-Structures.html @@ -0,0 +1,74 @@ + + + + + +Printing Structures (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.20 Printing Structures

    + +

    By default, a structure of type S is printed using #S syntax. +This behavior can be customized by specifying a :print-function +or :print-object option to the defstruct form that defines S, +or by writing a print-object method +that is specialized for objects of type S. +

    +

    Different structures might print out in different ways; +the default notation for structures is: +

    +
    +
     #S(structure-name {slot-key slot-value}*)
+
    + +

    where #S indicates structure syntax, +structure-name is a structure name, +each slot-key is an initialization argument name +for a slot in the structure, +and each corresponding slot-value is a representation +of the object in that slot. +

    +

    For information on how the Lisp reader parses structures, +see Sharpsign S. +

    + + + + + diff --git a/info/gcl/Printing-Symbols.html b/info/gcl/Printing-Symbols.html new file mode 100644 index 0000000..241efcb --- /dev/null +++ b/info/gcl/Printing-Symbols.html @@ -0,0 +1,89 @@ + + + + + +Printing Symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Default Print-Object Methods  

    +
    +
    +

    22.1.3.8 Printing Symbols

    + +

    When printer escaping is disabled, +

    +

    only the characters of the symbol’s name are output +

    +

    (but the case in which to print characters in the name is +controlled by *print-case*; +see Effect of Readtable Case on the Lisp Printer). +

    +

    The remainder of this section applies only +

    +

    when printer escaping is enabled. +

    +

    When printing a symbol, the printer inserts enough +single escape and/or multiple escape +characters (backslashes and/or vertical-bars) so that if +read were called with the same *readtable* and +with *read-base* bound to the current output base, it +would return the same symbol (if it is not +apparently uninterned) or an uninterned symbol +with the same print name (otherwise). +

    +

    For example, if the value of *print-base* were 16 +when printing the symbol face, it would have to be printed as +\FACE or \Face or |FACE|, +because the token face would be read as a hexadecimal +number (decimal value 64206) if the value of *read-base* were 16. +

    +

    For additional restrictions concerning characters with nonstandard +syntax types in the current readtable, see the variable *print-readably* +

    +

    For information about how the Lisp reader parses symbols, +see Symbols as Tokens and Sharpsign Colon. +

    +

    nil might be printed as () +

    +

    when *print-pretty* is true +and printer escaping is enabled. +

    + + + + + diff --git a/info/gcl/Processing-of-Defining-Macros.html b/info/gcl/Processing-of-Defining-Macros.html new file mode 100644 index 0000000..4c7a325 --- /dev/null +++ b/info/gcl/Processing-of-Defining-Macros.html @@ -0,0 +1,111 @@ + + + + + +Processing of Defining Macros (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: File Compilation  

    +
    +
    +

    3.2.3.2 Processing of Defining Macros

    + +

    Defining macros (such as defmacro or defvar) +appearing within a file being processed by compile-file +normally have compile-time side effects which affect how subsequent forms +in the same file are compiled. A convenient model for explaining how these +side effects happen is that the defining macro expands into one or +more eval-when forms, and that the calls which cause the compile-time +side effects to happen appear +in the body of an (eval-when (:compile-toplevel) ...) form. +

    +

    The compile-time side effects may cause information about the definition to +be stored differently than if the defining macro had been processed in the +‘normal’ way (either interpretively or by loading the compiled file). +

    +

    In particular, the information stored by the defining macros at compile time +might or might not be available to the interpreter (either during or after compilation), +or during subsequent calls to the compiler. For example, +the following code is nonportable because it assumes that the compiler +stores the macro definition of foo where it is available to the interpreter: +

    +
    +
     (defmacro foo (x) `(car ,x))
+ (eval-when (:execute :compile-toplevel :load-toplevel)
+   (print (foo '(a b c))))
+
    + +

    A portable way to do the same thing would be to include the macro +definition inside the eval-when form, as in: +

    +
    +
     (eval-when (:execute :compile-toplevel :load-toplevel)
+   (defmacro foo (x) `(car ,x))
+   (print (foo '(a b c))))
+
    + +

    Figure 3–8 lists macros that make definitions +available both in the compilation and run-time environments. +It is not specified whether definitions made available in the +compilation environment are available in the evaluation +environment, nor is it specified whether they are available +in subsequent compilation units or subsequent invocations of the +compiler. As with eval-when, these compile-time side +effects happen only when the defining macros appear at +top level. +

    +
    +
      declaim                define-modify-macro   defsetf    
+  defclass               define-setf-expander  defstruct  
+  defconstant            defmacro              deftype    
+  define-compiler-macro  defpackage            defvar     
+  define-condition       defparameter                     
+
+  Figure 3–8: Defining Macros That Affect the Compile-Time Environment
+
+
    + +
    +
    +

    +Next: , Previous: , Up: File Compilation  

    +
    + + + + + diff --git a/info/gcl/Processing-of-Top-Level-Forms.html b/info/gcl/Processing-of-Top-Level-Forms.html new file mode 100644 index 0000000..5046daa --- /dev/null +++ b/info/gcl/Processing-of-Top-Level-Forms.html @@ -0,0 +1,174 @@ + + + + + +Processing of Top Level Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: File Compilation  

    +
    +
    +

    3.2.3.1 Processing of Top Level Forms

    + +

    Processing of top level forms in the file compiler is defined +as follows: +

    +
    +
    1.
    +

    If the form is a compiler macro form +(not disabled by a notinline declaration), +the implementation might or might not choose to compute +the compiler macro expansion of the form and, +having performed the expansion, might or might not choose to process the result +as a top level form in the same processing mode +(compile-time-too or not-compile-time). +If it declines to obtain or use the expansion, it must process the original form. +

    +
    +
    2.
    +

    If the form is a macro form, +its macro expansion is computed and processed as a +top level form in +the same processing mode (compile-time-too or not-compile-time). +

    +
    +
    3.
    +

    If the form is a progn form, each of its +body forms is sequentially processed as a +top level form in the same processing mode. +

    +
    +
    4.
    +

    If the form is a locally, +macrolet, or symbol-macrolet, +compile-file establishes the appropriate bindings and processes the +body forms as top level forms with those bindings in effect +in the same processing mode. (Note that this implies that the lexical +environment in which top level forms are processed +is not necessarily the null lexical environment.) +

    +
    +
    5.
    +

    If the form is an eval-when + + form, it is +handled according to Figure 3–7. +

    +

    plus .5 fil +\offinterlineskip +

    +
      CT   LT   E    Mode  Action    New Mode          
+  _________________________________________________
+  Yes  Yes  —  —   Process   compile-time-too  
+  No   Yes  Yes   CTT  Process   compile-time-too  
+  No   Yes  Yes   NCT  Process   not-compile-time  
+  No   Yes  No   —   Process   not-compile-time  
+  Yes  No   —  —   Evaluate  —               
+  No   No   Yes   CTT  Evaluate  —               
+  No   No   Yes   NCT  Discard   —               
+  No   No   No   —   Discard   —               
+
    + +

      Figure 3–7: EVAL-WHEN processing +

    +

    Column CT indicates whether :compile-toplevel is specified. +Column LT indicates whether :load-toplevel is specified. +Column E indicates whether :execute is specified. +Column Mode indicates the processing mode; + a dash (—) indicates that the processing mode is not relevant. +

    +

    The Action column specifies one of three actions: +

    +
    +
    +

    Process: process the body as top level forms in the +specified mode. +

    +
    +
    +

    Evaluate: evaluate the body in the dynamic execution +context of the compiler, using the evaluation environment as +the global environment and the lexical environment in which +the eval-when appears. +

    +
    +
    +

    Discard: ignore the form. +

    +
    + +

    The New Mode column indicates the new processing mode. +A dash (—) indicates the compiler remains in its current mode. +

    +
    +
    6.
    +

    Otherwise, the form is a top level form that +is not one of the special cases. In compile-time-too mode, the +compiler first evaluates the form in the evaluation +environment and then minimally compiles it. In not-compile-time +mode, the form is simply minimally compiled. All subforms +are treated as non-top-level forms. +

    +

    Note that top level forms are processed in the order in +which they textually appear in the file and that each +top level form read by the compiler is processed before the next is +read. However, the order of processing (including macro expansion) of +subforms that are not top level forms and the order of +further compilation is unspecified as long as Common Lisp semantics +are preserved. +

    +
    +
    + +

    eval-when forms cause compile-time evaluation only at +top level. Both :compile-toplevel and :load-toplevel situation specifications +are ignored for non-top-level forms. For non-top-level forms, +an eval-when +specifying the :execute situation is treated as an implicit progn +including the forms in the body of the eval-when form; +otherwise, the forms in the body are ignored. +

    +
    +
    +

    +Next: , Previous: , Up: File Compilation  

    +
    + + + + + diff --git a/info/gcl/Purpose-of-Compiler-Macros.html b/info/gcl/Purpose-of-Compiler-Macros.html new file mode 100644 index 0000000..6ac1c3b --- /dev/null +++ b/info/gcl/Purpose-of-Compiler-Macros.html @@ -0,0 +1,81 @@ + + + + + +Purpose of Compiler Macros (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation Semantics  

    +
    +
    +

    3.2.2.2 Purpose of Compiler Macros

    + +

    The purpose of the compiler macro facility is to permit +selective source code transformations as optimization advice +to the compiler. When a compound form is being +processed (as by the compiler), if the operator names a +compiler macro then the compiler macro function may be +invoked on the form, and the resulting expansion recursively processed +in preference to performing the usual processing on the original form +according to its normal interpretation as a function form or +macro form. +

    +

    A compiler macro function, like a macro function, +is a function of two arguments: the entire call form +and the environment. Unlike an ordinary macro function, a +compiler macro function can decline to provide an expansion merely by +returning a value that is the same as the original form. +The consequences are undefined if a compiler macro function +destructively modifies any part of its form argument. +

    +

    The form passed to the compiler macro function can either be a list +whose car is the function name, or a list whose car is +funcall and whose cadr is a list (function name); +note that this affects destructuring of the form argument by the +compiler macro function. +define-compiler-macro arranges for destructuring of arguments to be +performed correctly for both possible formats. +

    +

    When compile-file chooses to expand a top level form that is +a compiler macro form, the expansion is also treated as a top level form +for the purposes of eval-when processing; see Processing of Top Level Forms. +

    + + + + + diff --git a/info/gcl/Random_002dState-Operations.html b/info/gcl/Random_002dState-Operations.html new file mode 100644 index 0000000..ee22706 --- /dev/null +++ b/info/gcl/Random_002dState-Operations.html @@ -0,0 +1,62 @@ + + + + + +Random-State Operations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Number Concepts  

    +
    +
    +

    12.1.7 Random-State Operations

    + +

    Figure 12–10 lists some defined names that are applicable to random states. +

    +
    +
      *random-state*     random            
+  make-random-state  random-state-p    
+
+  Figure 12–10: Random-state defined names
+
+
    + + + + + + + diff --git a/info/gcl/Rational-Computations.html b/info/gcl/Rational-Computations.html new file mode 100644 index 0000000..fe832db --- /dev/null +++ b/info/gcl/Rational-Computations.html @@ -0,0 +1,62 @@ + + + + + +Rational Computations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Number Concepts  

    +
    +
    +

    12.1.3 Rational Computations

    + +

    The rules in this section apply to rational computations. +

    + + + + +
    • Rule of Unbounded Rational Precision   +
    • Rule of Canonical Representation for Rationals   +
    • Rule of Float Substitutability   +
    + + + + + + diff --git a/info/gcl/Re_002dReading-Abbreviated-Expressions.html b/info/gcl/Re_002dReading-Abbreviated-Expressions.html new file mode 100644 index 0000000..f57afe3 --- /dev/null +++ b/info/gcl/Re_002dReading-Abbreviated-Expressions.html @@ -0,0 +1,67 @@ + + + + + +Re-Reading Abbreviated Expressions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.9 Re-Reading Abbreviated Expressions

    + +

    Note that the Lisp reader will +generally +signal an error of type reader-error +when reading an expression_2 that has been +abbreviated because of length or level limits +(see *print-level*, + *print-length*, + and *print-lines*) +due to restrictions on “..”, “...”, “#” followed by whitespace_1, +and “#)”. +

    + + + + + + + + + + diff --git a/info/gcl/Reader-Algorithm.html b/info/gcl/Reader-Algorithm.html new file mode 100644 index 0000000..6b7174a --- /dev/null +++ b/info/gcl/Reader-Algorithm.html @@ -0,0 +1,253 @@ + + + + + +Reader Algorithm (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax  

    +
    +
    +

    2.2 Reader Algorithm

    + + +

    This section describes the algorithm used by the Lisp reader +to parse objects from an input character stream, +including how the Lisp reader processes macro characters. +

    +

    When dealing with tokens, the reader’s basic function is to distinguish +representations of symbols from those of numbers. +When a token is accumulated, it is assumed to represent a number if it +satisfies the syntax for numbers listed in Figure~2–9. +If it does not represent a number, +it is then assumed to be a potential number +if it satisfies the rules governing the syntax for a potential number. +If a valid token is neither a representation of a number + nor a potential number, +it represents a symbol. +

    +

    The algorithm performed by the Lisp reader is as follows: +

    +
    +
    1.
    +

    If at end of file, end-of-file processing is performed as specified +in read. +Otherwise, +one character, x, is read from the input stream, and +dispatched according to the syntax type of x to one +of steps 2 to 7. +

    +
    +
    2.
    +

    If x is an invalid character, +an error of type reader-error is signaled. +

    +
    +
    3.
    +

    If x is a whitespace_2 character, +then it is discarded and step 1 is re-entered. +

    +
    +
    4.
    +

    If x is a terminating or non-terminating macro character +then its associated reader macro function is called with two arguments, +the input stream and x. +

    +

    The reader macro function may read characters +from the input stream; +if it does, it will see those characters following the macro character. +The Lisp reader may be invoked recursively from the reader macro function. +

    +

    The reader macro function must not have any side effects other than on the +input stream; +because of backtracking and restarting of the read operation, +front ends to the Lisp reader (e.g., “editors” and “rubout handlers”) +may cause the reader macro function to be called repeatedly during the +reading of a single expression in which x only appears once. +

    +

    The reader macro function may return zero values or one value. +If one value is returned, +then that value is returned as the result of the read operation; +the algorithm is done. +If zero values are returned, then step 1 is re-entered. +

    +
    +
    5.
    +

    If x is a single escape character +then the next character, y, is read, or an error of type end-of-file +is signaled if at the end of file. +y is treated as if it is a constituent +whose only constituent trait is alphabetic_2. +y is used to begin a token, and step 8 is entered. +

    +
    +
    6.
    +

    If x is a multiple escape character +then a token (initially +containing no characters) is begun and step 9 is entered. +

    +
    +
    7.
    +

    If x is a constituent character, then it begins a token. +After the token is read in, it will be interpreted +either as a Lisp object or as being of invalid syntax. +If the token represents an object, +that object is returned as the result of the read operation. +If the token is of invalid syntax, an error is signaled. +If x is a character with case, +it might be replaced with the corresponding character of the opposite case, +depending on the readtable case of the current readtable, +as outlined in Effect of Readtable Case on the Lisp Reader. +X is used to begin a token, and step 8 is entered. +

    +
    +
    8.
    +

    At this point a token is being accumulated, and an even number +of multiple escape characters have been encountered. +If at end of file, step 10 is entered. +Otherwise, a character, y, is read, and +one of the following actions is performed according to its syntax type: +

    +
    +
    *
    +

    If y is a constituent or non-terminating macro character: +

    +
    –
    +

    If y is a character with case, +it might be replaced with the corresponding character of the opposite case, +depending on the readtable case of the current readtable, +as outlined in Effect of Readtable Case on the Lisp Reader. +

    +
    –
    +

    Y is appended to the token being built. +

    +
    –
    +

    Step 8 is repeated. +

    +
    + +
    +
    *
    +

    If y is a single escape character, then the next character, +z, is read, or an error of type end-of-file is signaled if at end of file. +Z is treated as if it is a constituent +whose only constituent trait is alphabetic_2. +Z is appended to the token being built, +and step 8 is repeated. +

    +
    +
    *
    +

    If y is a multiple escape character, +then step 9 is entered. +

    +
    +
    *
    +

    If y is an invalid character, +an error of type reader-error is signaled. +

    +
    +
    *
    +

    If y is a terminating macro character, +then it terminates the token. +First the character y is unread (see unread-char), +and then step 10 is entered. +

    +
    +
    *
    +

    If y is a whitespace_2 character, then it terminates +the token. First the character y is unread +if appropriate (see read-preserving-whitespace), +and then step 10 is entered. +

    +
    + +
    +
    9.
    +

    At this point a token is being accumulated, and an odd number +of multiple escape characters have been encountered. +If at end of file, an error of type end-of-file is signaled. +Otherwise, a character, y, is read, and +one of the following actions is performed according to its syntax type: +

    +
    +
    *
    +

    If y is a constituent, macro, or whitespace_2 character, +y is treated as a constituent +whose only constituent trait is alphabetic_2. +Y is appended to the token being built, and step 9 is repeated. +

    +
    +
    *
    +

    If y is a single escape character, then the next character, +z, is read, or an error of type end-of-file is signaled if at end of file. +Z is treated as a constituent +whose only constituent trait is alphabetic_2. +Z is appended to the token being built, +and step 9 is repeated. +

    +
    +
    *
    +

    If y is a multiple escape character, +then step 8 is entered. +

    +
    +
    *
    +

    If y is an invalid character, +an error of type reader-error is signaled. +

    +
    + +
    +
    10.
    +

    An entire token has been accumulated. +The object represented by the token is returned +as the result of the read operation, +or an error of type reader-error is signaled if the token is not of valid syntax. +

    +
    + + +
    +
    +

    +Next: , Previous: , Up: Syntax  

    +
    + + + + + diff --git a/info/gcl/Reader-Concepts.html b/info/gcl/Reader-Concepts.html new file mode 100644 index 0000000..766d068 --- /dev/null +++ b/info/gcl/Reader-Concepts.html @@ -0,0 +1,61 @@ + + + + + +Reader Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader  

    +
    +
    +

    23.1 Reader Concepts

    + + + + + + +
    • Dynamic Control of the Lisp Reader   +
    • Effect of Readtable Case on the Lisp Reader   +
    • Argument Conventions of Some Reader Functions   +
    + + + + + + diff --git a/info/gcl/Reader-Dictionary.html b/info/gcl/Reader-Dictionary.html new file mode 100644 index 0000000..0d11c3b --- /dev/null +++ b/info/gcl/Reader-Dictionary.html @@ -0,0 +1,91 @@ + + + + + +Reader Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Reader  

    +
    +
    +

    23.2 Reader Dictionary

    + + + + + + + + + + + + + + + + + + + + + +
    • readtable   +
    • copy-readtable   +
    • make-dispatch-macro-character   +
    • read   +
    • read-delimited-list   +
    • read-from-string   +
    • readtable-case   +
    • readtablep   +
    • set-dispatch-macro-character   +
    • set-macro-character   +
    • set-syntax-from-char   +
    • with-standard-io-syntax   +
    • *read-base*   +
    • *read-default-float-format*   +
    • *read-eval*   +
    • *read-suppress*   +
    • *readtable*   +
    • reader-error   +
    + + + + + + diff --git a/info/gcl/Reader.html b/info/gcl/Reader.html new file mode 100644 index 0000000..7334151 --- /dev/null +++ b/info/gcl/Reader.html @@ -0,0 +1,58 @@ + + + + + +Reader (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    23 Reader

    + + + + +
    • Reader Concepts   +
    • Reader Dictionary   +
    + + + + + + diff --git a/info/gcl/Readtables.html b/info/gcl/Readtables.html new file mode 100644 index 0000000..6ad60e2 --- /dev/null +++ b/info/gcl/Readtables.html @@ -0,0 +1,81 @@ + + + + + +Readtables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax  

    +
    +
    +

    2.1.1 Readtables

    + +

    Syntax information for use by the Lisp reader is embodied in an +object called a readtable + +. Among other things, +the readtable contains the association between characters +and syntax types. +

    +

    Figure 2–1 lists some defined names that are applicable to +readtables. +

    +
    +
      *readtable*                    readtable-case                
+  copy-readtable                 readtablep                    
+  get-dispatch-macro-character   set-dispatch-macro-character  
+  get-macro-character            set-macro-character           
+  make-dispatch-macro-character  set-syntax-from-char          
+
+              Figure 2–1: Readtable defined names             
+
+
    + + + + + +
    • The Current Readtable   +
    • The Standard Readtable   +
    • The Initial Readtable   +
    + + + + + + diff --git a/info/gcl/Recommended-Style-in-Condition-Reporting.html b/info/gcl/Recommended-Style-in-Condition-Reporting.html new file mode 100644 index 0000000..94390b4 --- /dev/null +++ b/info/gcl/Recommended-Style-in-Condition-Reporting.html @@ -0,0 +1,69 @@ + + + + + +Recommended Style in Condition Reporting (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printing Conditions  

    +
    +
    +

    9.1.3.1 Recommended Style in Condition Reporting

    + +

    In order to ensure a properly aesthetic result when presenting +report messages to the user, certain stylistic conventions are +recommended. +

    +

    There are stylistic recommendations for the content of the messages +output by condition reporters, but there are no formal requirements +on those programs. +If a program violates the recommendations for some message, the +display of that message might be less aesthetic than if the guideline +had been observed, but the program is still considered a +conforming program. +

    +

    The requirements on a program or implementation which +invokes a condition reporter are somewhat stronger. A conforming +program must be permitted to assume that if these style guidelines are +followed, proper aesthetics will be maintained. Where appropriate, any +specific requirements on such routines are explicitly mentioned below. +

    + + + + + diff --git a/info/gcl/Redefining-Classes.html b/info/gcl/Redefining-Classes.html new file mode 100644 index 0000000..b406711 --- /dev/null +++ b/info/gcl/Redefining-Classes.html @@ -0,0 +1,126 @@ + + + + + +Redefining Classes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Classes  

    +
    +
    +

    4.3.6 Redefining Classes

    + +

    A class that is a direct instance of standard-class can +be redefined if the new class is also +a direct instance of standard-class. +Redefining a class modifies the existing +class object to reflect the new class definition; it does not +create a new class object for the class. +Any method object created by a :reader, :writer, +or :accessor option specified by the old defclass form is +removed from the corresponding generic function. +Methods specified by the new defclass form are added. +

    +

    When the class C is redefined, changes are propagated to its instances +and to instances of any of its subclasses. Updating such an +instance occurs at an implementation-dependent time, but no later than +the next time a slot +of that instance is read or written. Updating an +instance +does not change its identity as defined by the function eq. +The updating process may change the slots of that +particular instance, +but it does not create a new instance. Whether +updating an instance consumes storage is implementation-dependent. +

    +

    Note that redefining a class may cause slots to be added or +deleted. If a class is redefined in a way that changes the set of +local slots accessible in instances, the instances +are updated. It is implementation-dependent whether instances +are updated if a class is redefined in a way that does not change +the set of local slots accessible in instances. +

    +

    The value of a slot +that is specified as shared both in the old class +and in the new class is retained. +If such a shared slot was unbound +in the old class, it is unbound in the new class. +Slots that +were local in the old class and that are shared in the new +class are +initialized. Newly added shared slots are initialized. +

    +

    Each newly added shared slot is set to the result of evaluating the +captured initialization form for the slot that was specified +in the defclass form for the new class. +If there was no initialization form, the slot is unbound. +

    +

    If a class is redefined in such a way that the set of +local slots accessible in an instance of the class +is changed, a two-step process of updating the instances of the +class takes place. The process may be explicitly started by +invoking the generic function make-instances-obsolete. This +two-step process can happen in other circumstances in some implementations. +For example, in some implementations this two-step process is +triggered if the order of slots in storage is changed. +

    +

    The first step modifies the structure of the instance by adding new +local slots and discarding local slots that are not +defined in the new version of the class. The second step +initializes the newly-added local slots and performs any other +user-defined actions. These two steps are further specified +in the next two sections. +

    + + + + +
    • Modifying the Structure of Instances   +
    • Initializing Newly Added Local Slots (Redefining Classes)   +
    • Customizing Class Redefinition   +
    + +
    +
    +

    +Next: , Previous: , Up: Classes  

    +
    + + + + + diff --git a/info/gcl/Referenced-Publications.html b/info/gcl/Referenced-Publications.html new file mode 100644 index 0000000..b1f199e --- /dev/null +++ b/info/gcl/Referenced-Publications.html @@ -0,0 +1,211 @@ + + + + + +Referenced Publications (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.3 Referenced Publications

    + + +
    +
    *
    +

    The Anatomy of Lisp, + John Allen, McGraw-Hill, Inc., 1978. +

    +
    +
    *
    +

    The Art of Computer Programming, Volume 3, + Donald E. Knuth, Addison-Wesley Company (Reading, MA), 1973. +

    +
    +
    *
    +

    The Art of the Metaobject Protocol, + Kiczales et al., MIT Press (Cambridge, MA), 1991. +

    +
    +
    *
    +

    Common Lisp Object System Specification, + D. Bobrow, L. DiMichiel, R.P. Gabriel, S. Keene, G. Kiczales, D. Moon, + SIGPLAN Notices V23, September, 1988. +

    +
    +
    *
    +

    Common Lisp: The Language, + Guy L. Steele Jr., Digital Press (Burlington, MA), 1984. +

    +
    +
    *
    +

    Common Lisp: The Language, Second Edition, + Guy L. Steele Jr., Digital Press (Bedford, MA), 1990. +

    +
    +
    *
    +

    Exceptional Situations in Lisp, + Kent M. Pitman, + Proceedings of the First European Conference + on the Practical Application of LISP\/ + (EUROPAL ’90), + Churchill College, Cambridge, England, + March 27-29, 1990. +

    +
    +
    *
    +

    Flavors: A Non-Hierarchical Approach to Object-Oriented Programming, + Howard I. Cannon, 1982. +

    +
    +
    *
    +

    IEEE Standard for Binary Floating-Point Arithmetic, + ANSI/IEEE Std 754-1985, + Institute of Electrical and Electronics Engineers, Inc. (New York), 1985. +

    +
    +
    *
    +

    IEEE Standard for the Scheme Programming Language, + IEEE Std 1178-1990, + Institute of Electrical and Electronic Engineers, Inc. (New York), 1991. +

    +
    +
    *
    +

    Interlisp Reference Manual, Third Revision, + Teitelman, Warren, et al, + Xerox Palo Alto Research Center (Palo Alto, CA), 1978. +

    +
    +
    *
    +

    ISO 6937/2, + Information processing—Coded character sets + for text communication—Part 2: Latin alphabetic and non-alphabetic + graphic characters, + ISO, 1983. +

    +
    +
    *
    +

    Lisp 1.5 Programmer’s Manual, + John McCarthy, MIT Press (Cambridge, MA), August, 1962. +

    +
    +
    *
    +

    Lisp Machine Manual, + D.L. Weinreb and D.A. Moon, + Artificial Intelligence Laboratory, MIT (Cambridge, MA), July, 1981. +

    +
    +
    *
    +

    Maclisp Reference Manual, Revision~0, + David A. Moon, Project MAC (Laboratory for Computer Science), + MIT (Cambridge, MA), March, 1974. +

    +
    +
    *
    +

    NIL—A Perspective, + JonL White, Macsyma User’s Conference, 1979. +

    +
    +
    *
    +

    Performance and Evaluation of Lisp Programs, + Richard P. Gabriel, MIT Press (Cambridge, MA), 1985. +

    +
    +
    *
    +

    Principal Values and Branch Cuts in Complex APL, + Paul Penfield Jr., APL 81 Conference Proceedings, + ACM SIGAPL (San Francisco, September 1981), 248-256. + Proceedings published as APL Quote Quad 12, 1 (September 1981). +

    +
    +
    *
    +

    The Revised Maclisp Manual, + Kent M. Pitman, + Technical Report 295, + Laboratory for Computer Science, MIT (Cambridge, MA), May 1983. +

    +
    +
    *
    +

    Revised^3 Report on the Algorithmic Language Scheme, + Jonathan Rees and William Clinger (editors), + SIGPLAN Notices V21, #12, December, 1986. +

    +
    +
    *
    +

    S-1 Common Lisp Implementation, + R.A. Brooks, R.P. Gabriel, and G.L. Steele, + Conference Record of the 1982 ACM Symposium on Lisp and Functional Programming, + 108-113, 1982. +

    +
    +
    *
    +

    Smalltalk-80: The Language and its Implementation, + A. Goldberg and D. Robson, Addison-Wesley, 1983. +

    +
    +
    *
    +

    Standard LISP Report, + J.B. Marti, A.C. Hearn, M.L. Griss, and C. Griss, + SIGPLAN Notices V14, #10, October, 1979. +

    +
    +
    *
    +

    Webster’s Third New International Dictionary + the English Language, Unabridged, + Merriam Webster (Springfield, MA), 1986. +

    +
    +
    *
    +

    XP: A Common Lisp Pretty Printing System, + R.C. Waters, + Memo 1102a, + Artificial Intelligence Laboratory, MIT (Cambridge, MA), September 1989. +

    +
    +
    + + +
    +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    + + + + + diff --git a/info/gcl/Reinitializing-an-Instance.html b/info/gcl/Reinitializing-an-Instance.html new file mode 100644 index 0000000..cb174e5 --- /dev/null +++ b/info/gcl/Reinitializing-an-Instance.html @@ -0,0 +1,82 @@ + + + + + +Reinitializing an Instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects  

    +
    +
    +

    7.3 Reinitializing an Instance

    + + +

    The generic function reinitialize-instance may be used to change +the values of slots according to initialization arguments. +

    +

    The process of reinitialization changes the values of some slots and +performs any user-defined actions. It does not modify the structure +of an instance to add or delete slots, +and it does not use any :initform forms to initialize slots. +

    +

    The generic function reinitialize-instance may be called +directly. It takes one required argument, the instance. It also +takes any number of initialization arguments to be used by methods for +reinitialize-instance or for shared-initialize. The +arguments after the required instance must form an +initialization argument list. +

    +

    There is a system-supplied primary method for +reinitialize-instance whose parameter specializer is +the class standard-object. First this method checks the validity of +initialization arguments and signals an error if an initialization +argument is supplied that is not declared as valid. +(For more information, see Declaring the Validity of Initialization Arguments.) +Then it calls the generic function +shared-initialize with the following arguments: the instance, +nil, and the initialization arguments it received. +

    + + +
    • Customizing Reinitialization   +
    + + + + + + diff --git a/info/gcl/Relation-between-component-values-NIL-and-_002d_003eUNSPECIFIC.html b/info/gcl/Relation-between-component-values-NIL-and-_002d_003eUNSPECIFIC.html new file mode 100644 index 0000000..646ae15 --- /dev/null +++ b/info/gcl/Relation-between-component-values-NIL-and-_002d_003eUNSPECIFIC.html @@ -0,0 +1,65 @@ + + + + + +Relation between component values NIL and ->UNSPECIFIC (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.10 Relation between component values NIL and :UNSPECIFIC

    + +

    If a pathname is converted to a namestring, +the symbols nil and :unspecific +cause the field to be treated as if it were empty. +That is, +both nil and :unspecific +cause the component not to appear in the namestring. +

    +

    However, when merging a pathname with a set of defaults, +only a nil value for a component +will be replaced with the default for that component, +while a value of :unspecific +will be left alone as if the field were “filled”; +see the function merge-pathnames and Merging Pathnames. +

    + + + + + diff --git a/info/gcl/Removed-Argument-Conventions.html b/info/gcl/Removed-Argument-Conventions.html new file mode 100644 index 0000000..7957f24 --- /dev/null +++ b/info/gcl/Removed-Argument-Conventions.html @@ -0,0 +1,59 @@ + + + + + +Removed Argument Conventions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Removed Language Features  

    +
    +
    +

    27.1.4 Removed Argument Conventions

    + +

    The font argument to digit-char + + was removed. +The bits and font arguments to code-char + +

    +

    were removed. +

    + + + + + diff --git a/info/gcl/Removed-Language-Features.html b/info/gcl/Removed-Language-Features.html new file mode 100644 index 0000000..ea13554 --- /dev/null +++ b/info/gcl/Removed-Language-Features.html @@ -0,0 +1,69 @@ + + + + + +Removed Language Features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Appendix  

    +
    +
    +

    27.1 Removed Language Features

    + + + + + + + + + + +
    • Requirements for removed and deprecated features   +
    • Removed Types   +
    • Removed Operators   +
    • Removed Argument Conventions   +
    • Removed Variables   +
    • Removed Reader Syntax   +
    • Packages No Longer Required   +
    + + + + + + diff --git a/info/gcl/Removed-Operators.html b/info/gcl/Removed-Operators.html new file mode 100644 index 0000000..6614cfe --- /dev/null +++ b/info/gcl/Removed-Operators.html @@ -0,0 +1,83 @@ + + + + + +Removed Operators (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Removed Language Features  

    +
    +
    +

    27.1.3 Removed Operators

    + +

    The functions +

    +

    int-char + +, +char-bits + +, +char-font + +, +make-char + +, +char-bit + +, +set-char-bit + +, +string-char-p + +, +

    +

    and +commonp + +

    +

    were removed. +

    +

    The special operator compiler-let was removed. +

    + + + + + diff --git a/info/gcl/Removed-Reader-Syntax.html b/info/gcl/Removed-Reader-Syntax.html new file mode 100644 index 0000000..41c31de --- /dev/null +++ b/info/gcl/Removed-Reader-Syntax.html @@ -0,0 +1,53 @@ + + + + + +Removed Reader Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Removed Language Features  

    +
    +
    +

    27.1.6 Removed Reader Syntax

    + +

    The “#,” reader macro in standard syntax was removed. +

    + + + + + diff --git a/info/gcl/Removed-Types.html b/info/gcl/Removed-Types.html new file mode 100644 index 0000000..323ffdc --- /dev/null +++ b/info/gcl/Removed-Types.html @@ -0,0 +1,55 @@ + + + + + +Removed Types (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Removed Language Features  

    +
    +
    +

    27.1.2 Removed Types

    + +

    The type string-char + + was removed. +

    + + + + + diff --git a/info/gcl/Removed-Variables.html b/info/gcl/Removed-Variables.html new file mode 100644 index 0000000..dfd465c --- /dev/null +++ b/info/gcl/Removed-Variables.html @@ -0,0 +1,77 @@ + + + + + +Removed Variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Removed Language Features  

    +
    +
    +

    27.1.5 Removed Variables

    + +

    The variables +

    +

    char-font-limit + +, +char-bits-limit + +, +char-control-bit + +, +char-meta-bit + +, +char-super-bit + +, +char-hyper-bit + +, +

    +

    and *break-on-warnings* + +

    +

    were removed. +

    + + + + + diff --git a/info/gcl/Required-Kinds-of-Specialized-Arrays.html b/info/gcl/Required-Kinds-of-Specialized-Arrays.html new file mode 100644 index 0000000..af7bb57 --- /dev/null +++ b/info/gcl/Required-Kinds-of-Specialized-Arrays.html @@ -0,0 +1,101 @@ + + + + + +Required Kinds of Specialized Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Specialized Arrays  

    +
    +
    +

    15.1.2.2 Required Kinds of Specialized Arrays

    + +

    Vectors whose elements are restricted to type +

    +

    character or a subtype of character +

    +

    are called strings + +. +Strings are of type string. +Figure 15–2 lists some defined names related to strings. +

    +

    Strings are specialized arrays +and might logically have been included in this chapter. +However, for purposes of readability +most information about strings does not appear in this chapter; +see instead Strings. +

    +
    +
      char                string-equal         string-upcase  
+  make-string         string-greaterp      string/=       
+  nstring-capitalize  string-left-trim     string<        
+  nstring-downcase    string-lessp         string<=       
+  nstring-upcase      string-not-equal     string=        
+  schar               string-not-greaterp  string>        
+  string              string-not-lessp     string>=       
+  string-capitalize   string-right-trim                   
+  string-downcase     string-trim                         
+
+      Figure 15–2: Operators that Manipulate Strings     
+
+
    + +

    Vectors whose elements are restricted to type +bit are called bit vectors + +. +Bit vectors are of type bit-vector. +Figure 15–3 lists some defined names for operations on bit arrays. +

    +
    +
      bit        bit-ior   bit-orc2  
+  bit-and    bit-nand  bit-xor   
+  bit-andc1  bit-nor   sbit      
+  bit-andc2  bit-not             
+  bit-eqv    bit-orc1            
+
+  Figure 15–3: Operators that Manipulate Bit Arrays
+
+
    + + + + + + + diff --git a/info/gcl/Required-Language-Features.html b/info/gcl/Required-Language-Features.html new file mode 100644 index 0000000..3e1683e --- /dev/null +++ b/info/gcl/Required-Language-Features.html @@ -0,0 +1,60 @@ + + + + + +Required Language Features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conforming Implementations  

    +
    +
    +

    1.5.1.1 Required Language Features

    + +

    A conforming implementation shall accept all features +(including deprecated features) +of the language specified in this standard, +with the meanings defined in this standard. +

    +

    A conforming implementation shall not require the inclusion of substitute +or additional language elements in code in order to accomplish a feature of +the language that is specified in this standard. +

    + + + + + diff --git a/info/gcl/Requirements-for-removed-and-deprecated-features.html b/info/gcl/Requirements-for-removed-and-deprecated-features.html new file mode 100644 index 0000000..82ccc2f --- /dev/null +++ b/info/gcl/Requirements-for-removed-and-deprecated-features.html @@ -0,0 +1,69 @@ + + + + + +Requirements for removed and deprecated features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Removed Language Features  

    +
    +
    +

    27.1.1 Requirements for removed and deprecated features

    + +

    For this standard, + some features from the language described in Common Lisp: The Language have been removed, +and others have been deprecated (and will most likely not appear +in future Common Lisp standards). +Which features were removed and which were deprecated +was decided on a case-by-case basis by the X3J13 committee. +

    +

    Conforming implementations that wish to retain any removed +features for compatibility must assure that such compatibility +does not interfere with the correct function of conforming programs. +For example, symbols corresponding to the names of removed functions +may not appear in the the COMMON-LISP package. +(Note, however, that this specification has been devised in such a way +that there can be a package named LISP which can contain such symbols.) +

    +

    Conforming implementations must implement all deprecated features. +For a list of deprecated features, see Deprecated Language Features. +

    + + + + + diff --git a/info/gcl/Requiring-Non_002dNull-Rest-Parameters-in-The-_0022Syntax_0022-Section.html b/info/gcl/Requiring-Non_002dNull-Rest-Parameters-in-The-_0022Syntax_0022-Section.html new file mode 100644 index 0000000..66d1a11 --- /dev/null +++ b/info/gcl/Requiring-Non_002dNull-Rest-Parameters-in-The-_0022Syntax_0022-Section.html @@ -0,0 +1,67 @@ + + + + + +Requiring Non-Null Rest Parameters in The "Syntax" Section (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.27 Requiring Non-Null Rest Parameters in The "Syntax" Section

    + +

    In some cases it is useful to refer to all arguments equally as a single +aggregation using a rest parameter while at the same time +requiring at least one argument. A variety of imperative and +declarative means are available in code for expressing such a +restriction, however they generally do not manifest themselves in a +lambda list. For descriptive purposes within this specification, +

    +

    F &rest arguments^+ +

    +

    means the same as +

    +

    F &rest arguments +

    +

    but introduces the additional requirement that there be +at least one argument. +

    + + + + + diff --git a/info/gcl/Resignaling-a-Condition.html b/info/gcl/Resignaling-a-Condition.html new file mode 100644 index 0000000..ce0062f --- /dev/null +++ b/info/gcl/Resignaling-a-Condition.html @@ -0,0 +1,71 @@ + + + + + +Resignaling a Condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Signaling and Handling Conditions  

    +
    +
    +

    9.1.4.2 Resignaling a Condition

    + +

    During the dynamic extent of the signaling process for +a particular condition object, +signaling the same condition object again +is permitted if and only if the situation represented in both +cases are the same. +

    +

    For example, a handler might legitimately signal +the condition object that is its argument +in order to allow outer handlers first opportunity to handle +the condition. (Such a handlers is sometimes called a “default handler.”) +This action is permitted because the situation which the second +signaling process is addressing is really the same situation. +

    +

    On the other hand, in an implementation that implemented asynchronous +keyboard events by interrupting the user process with a call to signal, +it would not be permissible for two distinct asynchronous keyboard events +to signal identical condition objects +at the same time for different +situations. +

    + + + + + diff --git a/info/gcl/Resolution-of-Apparent-Conflicts-in-Exceptional-Situations.html b/info/gcl/Resolution-of-Apparent-Conflicts-in-Exceptional-Situations.html new file mode 100644 index 0000000..a1312a3 --- /dev/null +++ b/info/gcl/Resolution-of-Apparent-Conflicts-in-Exceptional-Situations.html @@ -0,0 +1,57 @@ + + + + + +Resolution of Apparent Conflicts in Exceptional Situations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conforming Implementations  

    +
    +
    +

    1.5.1.5 Resolution of Apparent Conflicts in Exceptional Situations

    + +

    If more than one passage in this specification appears to apply to the +same situation but in conflicting ways, the passage that appears +to describe the situation in the most specific way (not necessarily the +passage that provides the most constrained kind of error detection) +takes precedence. +

    + + + + + diff --git a/info/gcl/Restart-Tests.html b/info/gcl/Restart-Tests.html new file mode 100644 index 0000000..4bd0c9b --- /dev/null +++ b/info/gcl/Restart-Tests.html @@ -0,0 +1,57 @@ + + + + + +Restart Tests (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Signaling and Handling Conditions  

    +
    +
    +

    9.1.4.6 Restart Tests

    + +

    Each restart has an associated test, which is a function of one +argument (a condition or nil) which returns true if the restart +should be visible in the current situation. This test is created by +the :test-function option to restart-bind or +the :test option to restart-case. +

    + + + + + diff --git a/info/gcl/Restarts.html b/info/gcl/Restarts.html new file mode 100644 index 0000000..e6107a3 --- /dev/null +++ b/info/gcl/Restarts.html @@ -0,0 +1,117 @@ + + + + + +Restarts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Signaling and Handling Conditions  

    +
    +
    +

    9.1.4.3 Restarts

    + +

    The interactive condition handler returns only through +non-local transfer of control to specially defined restarts +that can be set up either by the system or by user code. Transferring +control to a restart is called “invoking” the restart. Like +handlers, active restarts are established +dynamically, and +only active restarts +can be invoked. An active +restart can be invoked by the user from +the debugger or by a program by using invoke-restart. +

    +

    A restart contains a +function to be called when the restart is +invoked, an optional name that can be used to find or invoke the +restart, and +an optional set of interaction information for the debugger to use to +enable the user to manually invoke a restart. +

    +

    The name of a restart is +used by invoke-restart. Restarts that can be invoked +only within the debugger do not need names. +

    +

    Restarts can be established by using restart-bind, +restart-case, and with-simple-restart. +A restart function can itself invoke any other restart +that was active at the time of establishment of the restart +of which the function is part. +

    +

    The restarts established by + a restart-bind form, + a restart-case form, + or a with-simple-restart form +have dynamic extent +which extends for the duration of that form’s execution. +

    +

    Restarts of the same name can be ordered from least recent to +most recent according to the following two rules: +

    +
    +
    1.
    +

    Each restart in a set of active restarts +R_1 is more recent than every restart in a +set R_2 if the restarts +in R_2 were active when the restarts in R_1 were +established. +

    +
    +
    2.
    +

    Let r_1 and r_2 be two active restarts with +the same name established by the same form. Then r_1 is +more recent than r_2 if r_1 was defined to the +left of r_2 in the form that established them. +

    +
    +
    + +

    If a restart is invoked but does not transfer control, +the values resulting from the restart function are +returned by the function that invoked the restart, either +invoke-restart or invoke-restart-interactively. +

    +
    +
    +

    +Next: , Previous: , Up: Signaling and Handling Conditions  

    +
    + + + + + diff --git a/info/gcl/Restrictions-on-Composite-Streams.html b/info/gcl/Restrictions-on-Composite-Streams.html new file mode 100644 index 0000000..6745196 --- /dev/null +++ b/info/gcl/Restrictions-on-Composite-Streams.html @@ -0,0 +1,59 @@ + + + + + +Restrictions on Composite Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Stream Concepts  

    +
    +
    +

    21.1.4 Restrictions on Composite Streams

    + +

    The consequences are undefined if any component of a composite stream +is closed before the composite stream is closed. +

    +

    The consequences are undefined if the synonym stream symbol is not bound +to an open stream from the time of the synonym stream’s creation +until the time it is closed. +

    + + + + + + diff --git a/info/gcl/Restrictions-on-Constructing-Pathnames.html b/info/gcl/Restrictions-on-Constructing-Pathnames.html new file mode 100644 index 0000000..8dfe5e8 --- /dev/null +++ b/info/gcl/Restrictions-on-Constructing-Pathnames.html @@ -0,0 +1,98 @@ + + + + + +Restrictions on Constructing Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.21 Restrictions on Constructing Pathnames

    + +

    When constructing a pathname from components, conforming programs + must follow these rules: +

    +
    +
    *
    +

    Any component can be nil. + nil in the host might mean a default host + rather than an actual nil in some implementations. +

    +
    +
    *
    +

    The host, device, directory, name, and type can be strings. There + are implementation-dependent limits on the number and type of + characters in these strings. +

    +
    +
    *
    +

    The directory can be a list of strings and symbols. + There are implementation-dependent limits on the list’s + length and contents. +

    +
    +
    *
    +

    The version can be :newest. +

    +
    +
    *
    +

    Any component can be taken + from the corresponding component of another pathname. + When the two pathnames are for different file systems + (in implementations that support multiple file systems), + an appropriate translation occurs. + If no meaningful translation is possible, + an error is signaled. + The definitions of “appropriate” and “meaningful” + are implementation-dependent. +

    +
    +
    *
    +

    An implementation might support other values for some components, + but a portable program cannot use those values. + A conforming program can use implementation-dependent values + but this can make it non-portable; + for example, it might work only with Unix file systems. +

    +
    + + + + + + diff --git a/info/gcl/Restrictions-on-Examining-Pathname-Components.html b/info/gcl/Restrictions-on-Examining-Pathname-Components.html new file mode 100644 index 0000000..3bcbc3c --- /dev/null +++ b/info/gcl/Restrictions-on-Examining-Pathname-Components.html @@ -0,0 +1,70 @@ + + + + + +Restrictions on Examining Pathname Components (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.12 Restrictions on Examining Pathname Components

    + +

    The space of possible objects that a conforming program +must be prepared to read_1 +as the value of a pathname component +is substantially larger than the space of possible objects +that a conforming program is permitted to write_1 +into such a component. +

    +

    While the values discussed + in the subsections of this section, + in Special Pathname Component Values, +and in Restrictions on Wildcard Pathnames +apply to values that might be seen when +reading the component values, +substantially more restrictive rules apply to constructing pathnames; +see Restrictions on Constructing Pathnames. +

    +

    When examining pathname components, +conforming programs should be aware of the following restrictions. +

    + + + + + diff --git a/info/gcl/Restrictions-on-Examining-a-Pathname-Device-Component.html b/info/gcl/Restrictions-on-Examining-a-Pathname-Device-Component.html new file mode 100644 index 0000000..b9a2b89 --- /dev/null +++ b/info/gcl/Restrictions-on-Examining-a-Pathname-Device-Component.html @@ -0,0 +1,59 @@ + + + + + +Restrictions on Examining a Pathname Device Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.14 Restrictions on Examining a Pathname Device Component

    + +

    The device might be a string, +:wild, :unspecific, or nil. +

    +

    Note that :wild might result from an attempt to read_1 +the pathname component, even though portable programs are restricted +from writing_1 such a component value; +see Restrictions on Wildcard Pathnames and Restrictions on Constructing Pathnames. +

    + + + + + diff --git a/info/gcl/Restrictions-on-Examining-a-Pathname-Directory-Component.html b/info/gcl/Restrictions-on-Examining-a-Pathname-Directory-Component.html new file mode 100644 index 0000000..f7cb588 --- /dev/null +++ b/info/gcl/Restrictions-on-Examining-a-Pathname-Directory-Component.html @@ -0,0 +1,161 @@ + + + + + +Restrictions on Examining a Pathname Directory Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.15 Restrictions on Examining a Pathname Directory Component

    + +

    The directory might be a string, +:wild, :unspecific, or nil. +

    +

    The directory can be a list of strings and symbols. +

    +

    The car of the list is one of the symbols :absolute + or +:relative +, meaning: +

    +
    +
    :absolute
    +

    A list whose car is the symbol :absolute represents + a directory path starting from the root directory. The list + (:absolute) represents the root directory. The list + (:absolute "foo" "bar" "baz") represents the directory called + "/foo/bar/baz" in Unix (except possibly for case). +

    +
    +
    :relative
    +

    A list whose car is the symbol :relative represents + a directory path starting from a default directory. + The list (:relative) has the same meaning as nil and hence is not used. + The list (:relative "foo" "bar") represents the directory named "bar" + in the directory named "foo" in the default directory. +

    +
    +
    + +

    Each remaining element of the list is a string or a symbol. +

    +

    Each string names a single level of directory structure. +The strings should contain only the directory names +themselves—no punctuation characters. +

    +

    In place of a string, at any point in the list, symbols +can occur to indicate special file notations. +Figure 19–3 lists the symbols that have standard meanings. +Implementations are permitted to add additional objects +of any type that is disjoint from string +if necessary to represent features of their file systems that cannot be +represented with the standard strings and symbols. +

    +

    Supplying any non-string, including any of the symbols listed below, +to a file system for which it does not make sense +signals an error of type file-error. +For example, Unix does not support :wild-inferiors in most implementations. +

    + + + + +
    +
      Symbol           Meaning                                             
+  :wild            Wildcard match of one level of directory structure  
+  :wild-inferiors  Wildcard match of any number of directory levels    
+  :up              Go upward in directory structure (semantic)         
+  :back            Go upward in directory structure (syntactic)        
+
+          Figure 19–3: Special Markers In Directory Component         
+
+
    + +

    The following notes apply to the previous figure: +

    +
    +
    Invalid Combinations
    +

    Using :absolute or :wild-inferiors +immediately followed by :up or :back +signals an error of type file-error. +

    +
    +
    Syntactic vs Semantic
    +

    “Syntactic” means that the action of :back +depends only on the pathname +and not on the contents of the file system. +

    +

    “Semantic” means that the action of :up +depends on the contents of the file system; +to resolve a pathname containing +:up to a pathname whose directory component +contains only :absolute and +strings requires probing the file system. +

    +

    :up differs from +:back only in file systems that support multiple + names for directories, perhaps via symbolic links. For example, + suppose that there is a directory +(:absolute "X" "Y" "Z") + linked to +(:absolute "A" "B" "C") + and there also exist directories +(:absolute "A" "B" "Q") and +(:absolute "X" "Y" "Q"). +Then +(:absolute "X" "Y" "Z" :up "Q") + designates +(:absolute "A" "B" "Q") + while +(:absolute "X" "Y" "Z" :back "Q") + designates +(:absolute "X" "Y" "Q") +

    +
    + +
    +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    + + + + + diff --git a/info/gcl/Restrictions-on-Examining-a-Pathname-Host-Component.html b/info/gcl/Restrictions-on-Examining-a-Pathname-Host-Component.html new file mode 100644 index 0000000..0fc737c --- /dev/null +++ b/info/gcl/Restrictions-on-Examining-a-Pathname-Host-Component.html @@ -0,0 +1,53 @@ + + + + + +Restrictions on Examining a Pathname Host Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.13 Restrictions on Examining a Pathname Host Component

    + +

    It is implementation-dependent what object is used to represent the host. +

    + + + + + diff --git a/info/gcl/Restrictions-on-Examining-a-Pathname-Name-Component.html b/info/gcl/Restrictions-on-Examining-a-Pathname-Name-Component.html new file mode 100644 index 0000000..773c988 --- /dev/null +++ b/info/gcl/Restrictions-on-Examining-a-Pathname-Name-Component.html @@ -0,0 +1,54 @@ + + + + + +Restrictions on Examining a Pathname Name Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.17 Restrictions on Examining a Pathname Name Component

    + +

    The name might be a string, +:wild, :unspecific, or nil. +

    + + + + + diff --git a/info/gcl/Restrictions-on-Examining-a-Pathname-Type-Component.html b/info/gcl/Restrictions-on-Examining-a-Pathname-Type-Component.html new file mode 100644 index 0000000..b8ec758 --- /dev/null +++ b/info/gcl/Restrictions-on-Examining-a-Pathname-Type-Component.html @@ -0,0 +1,54 @@ + + + + + +Restrictions on Examining a Pathname Type Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.18 Restrictions on Examining a Pathname Type Component

    + +

    The type might be a string, +:wild, :unspecific, or nil. +

    + + + + + diff --git a/info/gcl/Restrictions-on-Examining-a-Pathname-Version-Component.html b/info/gcl/Restrictions-on-Examining-a-Pathname-Version-Component.html new file mode 100644 index 0000000..6608711 --- /dev/null +++ b/info/gcl/Restrictions-on-Examining-a-Pathname-Version-Component.html @@ -0,0 +1,66 @@ + + + + + +Restrictions on Examining a Pathname Version Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.19 Restrictions on Examining a Pathname Version Component

    + +

    The version can be any symbol or any integer. +

    +

    The symbol :newest refers to the largest version number +that already exists in the file system +when reading, overwriting, appending, superseding, or directory listing +an existing file. +The symbol :newest refers to the smallest version number +greater than any existing version number when creating a new file. +

    +

    The symbols nil, :unspecific, and :wild have special meanings and +restrictions; see Special Pathname Component Values and Restrictions on Constructing Pathnames. +

    +

    Other symbols and integers +have implementation-defined meaning. +

    + + + + + diff --git a/info/gcl/Restrictions-on-Side_002dEffects.html b/info/gcl/Restrictions-on-Side_002dEffects.html new file mode 100644 index 0000000..05388de --- /dev/null +++ b/info/gcl/Restrictions-on-Side_002dEffects.html @@ -0,0 +1,53 @@ + + + + + +Restrictions on Side-Effects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.16 Restrictions on Side-Effects

    + +

    See Traversal Rules and Side Effects. +

    + + + + + diff --git a/info/gcl/Restrictions-on-Wildcard-Pathnames.html b/info/gcl/Restrictions-on-Wildcard-Pathnames.html new file mode 100644 index 0000000..6ee58b8 --- /dev/null +++ b/info/gcl/Restrictions-on-Wildcard-Pathnames.html @@ -0,0 +1,75 @@ + + + + + +Restrictions on Wildcard Pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.11 Restrictions on Wildcard Pathnames

    + +

    Wildcard pathnames can be used with directory but not with + open, + and return true from wild-pathname-p. When examining + wildcard components of a wildcard pathname, conforming programs + must be prepared to encounter any of the following additional values + in any component or any element of a list that is the directory component: +

    +
    +
    *
    +

    The symbol :wild, which matches anything. +

    +
    +
    *
    +

    A string containing implementation-dependent + special wildcard characters. +

    +
    +
    *
    +

    Any object, + representing an implementation-dependent wildcard pattern. +

    +
    +
    + + + + + + diff --git a/info/gcl/Return-Values.html b/info/gcl/Return-Values.html new file mode 100644 index 0000000..8ea8757 --- /dev/null +++ b/info/gcl/Return-Values.html @@ -0,0 +1,88 @@ + + + + + +Return Values (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Evaluation  

    +
    +
    +

    3.1.7 Return Values

    + +

    Ordinarily the result of calling a function is a single object. +Sometimes, however, it is convenient for a function to compute several +objects and return them. +

    +

    In order to receive other than exactly one value from a form, +one of several special forms or macros must be used to request those +values. If a form produces multiple values which were not +requested in this way, then the first value is given to the caller and +all others are discarded; if the form produces zero values, +then the caller receives nil as a value. +

    +

    Figure 3–5 lists +some operators for receiving multiple values_2. +These operators can be used to specify + one or more forms to evaluate +and where to put the values returned by those forms. +

    +
    +
      multiple-value-bind  multiple-value-prog1  return-from  
+  multiple-value-call  multiple-value-setq   throw        
+  multiple-value-list  return                             
+
+  Figure 3–5: Some operators applicable to receiving multiple values
+
+
    + +

    The function values can produce multiple values_2. +(values) returns zero values; +(values form) returns the primary value returned by form; +(values form1 form2) returns two values, + the primary value of form1 +and the primary value of form2; +and so on. +

    +

    See multiple-values-limit and values-list. +

    + + + + + + diff --git a/info/gcl/Return-values-in-The-_0022Syntax_0022-Section.html b/info/gcl/Return-values-in-The-_0022Syntax_0022-Section.html new file mode 100644 index 0000000..d0c22c6 --- /dev/null +++ b/info/gcl/Return-values-in-The-_0022Syntax_0022-Section.html @@ -0,0 +1,63 @@ + + + + + +Return values in The "Syntax" Section (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.28 Return values in The "Syntax" Section

    + +

    An evaluation arrow “⇒” precedes a list of values to be returned. +For example: +

    +

    F a b c ⇒ x +

    +

    indicates that F is an operator that has three required parameters +(i.e., a, b, and c) and that returns one value (i.e., x). +If more than one value is returned by an operator, the names of the +values are separated by commas, as in: +

    +

    F a b c ⇒ x, y, z +

    + + + + + diff --git a/info/gcl/Right_002dParenthesis.html b/info/gcl/Right_002dParenthesis.html new file mode 100644 index 0000000..5682bd3 --- /dev/null +++ b/info/gcl/Right_002dParenthesis.html @@ -0,0 +1,55 @@ + + + + + +Right-Parenthesis (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.2 Right-Parenthesis

    + +

    The right-parenthesis is invalid +except when used in conjunction with the left parenthesis character. +For more information, see Reader Algorithm. +

    + + + + + diff --git a/info/gcl/Rule-of-Canonical-Representation-for-Complex-Rationals.html b/info/gcl/Rule-of-Canonical-Representation-for-Complex-Rationals.html new file mode 100644 index 0000000..7036508 --- /dev/null +++ b/info/gcl/Rule-of-Canonical-Representation-for-Complex-Rationals.html @@ -0,0 +1,63 @@ + + + + + +Rule of Canonical Representation for Complex Rationals (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Complex Computations  

    +
    +
    +

    12.1.5.3 Rule of Canonical Representation for Complex Rationals

    + +

    If the result of any computation would be a complex +number whose real part is of type rational and whose imaginary +part is zero, the result is converted to the rational +which is the real part. +This rule does not apply to complex numbers whose parts +are floats. +For example, #C(5 0) and 5 are not different objects in Common Lisp +(they are always the same under eql); +#C(5.0 0.0) and 5.0 are always different objects in Common Lisp +(they are never the same under eql, +although they are the same under equalp and =). +

    + + + + + diff --git a/info/gcl/Rule-of-Canonical-Representation-for-Rationals.html b/info/gcl/Rule-of-Canonical-Representation-for-Rationals.html new file mode 100644 index 0000000..335342d --- /dev/null +++ b/info/gcl/Rule-of-Canonical-Representation-for-Rationals.html @@ -0,0 +1,69 @@ + + + + + +Rule of Canonical Representation for Rationals (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Rational Computations  

    +
    +
    +

    12.1.3.2 Rule of Canonical Representation for Rationals

    + +

    If any computation produces a result that is a mathematical ratio of two integers +such that the denominator evenly divides the numerator, then the result is converted +to the equivalent integer. +

    +

    If the denominator does not evenly divide the numerator, +the canonical representation of a rational number is as the ratio +that numerator and that denominator, where the greatest common divisor of +the numerator and denominator is one, and where the denominator is positive +and greater than one. +

    +

    When used as input (in the default syntax), +the notation -0 always denotes the integer 0. +A conforming implementation must not have a +representation of “minus zero” for integers +that is distinct from its representation of zero for integers. +However, such a distinction is possible for floats; +see the type float. +

    + + + + + diff --git a/info/gcl/Rule-of-Complex-Contagion.html b/info/gcl/Rule-of-Complex-Contagion.html new file mode 100644 index 0000000..c3e6698 --- /dev/null +++ b/info/gcl/Rule-of-Complex-Contagion.html @@ -0,0 +1,63 @@ + + + + + +Rule of Complex Contagion (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Complex Computations  

    +
    +
    +

    12.1.5.2 Rule of Complex Contagion

    + +

    When a +

    +

    real +

    +

    and +a complex are both part of a computation, +the +

    +

    real +

    +

    is first converted to a complex by providing an imaginary part of 0. +

    + + + + + diff --git a/info/gcl/Rule-of-Complex-Substitutability.html b/info/gcl/Rule-of-Complex-Substitutability.html new file mode 100644 index 0000000..09774da --- /dev/null +++ b/info/gcl/Rule-of-Complex-Substitutability.html @@ -0,0 +1,55 @@ + + + + + +Rule of Complex Substitutability (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Complex Computations  

    +
    +
    +

    12.1.5.1 Rule of Complex Substitutability

    + +

    Except during the execution of irrational and transcendental functions, +no numerical function ever yields a complex unless +one or more of its arguments is a complex. +

    + + + + + diff --git a/info/gcl/Rule-of-Float-Approximation.html b/info/gcl/Rule-of-Float-Approximation.html new file mode 100644 index 0000000..be74b9e --- /dev/null +++ b/info/gcl/Rule-of-Float-Approximation.html @@ -0,0 +1,72 @@ + + + + + +Rule of Float Approximation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Floating-point Computations  

    +
    +
    +

    12.1.4.3 Rule of Float Approximation

    + +

    Computations with floats are only approximate, +although they are described as if the results +were mathematically accurate. +Two mathematically identical +expressions may be computationally different because of errors +inherent in the floating-point approximation process. +The precision of a float is not necessarily +correlated with the accuracy of that number. +For instance, 3.142857142857142857 is a more precise approximation +to \pi than 3.14159, but the latter is more accurate. +The precision refers to the number of bits retained in the representation. +When an operation combines a short float with a +long float, +the result will be a long float. +Common Lisp functions assume that the accuracy of +arguments to them does not exceed their precision. Therefore +when two small floats +are combined, the result is a small float. +Common Lisp functions +never convert automatically from a larger size to a smaller one. +

    + + + + + diff --git a/info/gcl/Rule-of-Float-Precision-Contagion.html b/info/gcl/Rule-of-Float-Precision-Contagion.html new file mode 100644 index 0000000..f8e979d --- /dev/null +++ b/info/gcl/Rule-of-Float-Precision-Contagion.html @@ -0,0 +1,54 @@ + + + + + +Rule of Float Precision Contagion (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Floating-point Computations  

    +
    +
    +

    12.1.4.5 Rule of Float Precision Contagion

    + +

    The result of a numerical function is a float of the +largest format among all the floating-point arguments to the function. +

    + + + + + diff --git a/info/gcl/Rule-of-Float-Substitutability.html b/info/gcl/Rule-of-Float-Substitutability.html new file mode 100644 index 0000000..653fc21 --- /dev/null +++ b/info/gcl/Rule-of-Float-Substitutability.html @@ -0,0 +1,116 @@ + + + + + +Rule of Float Substitutability (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Rational Computations  

    +
    +
    +

    12.1.3.3 Rule of Float Substitutability

    + +

    When the arguments to an irrational mathematical function +

    +

    [Reviewer Note by Barmar: There should be a table of these functions.] +are all rational and the true mathematical result +is also (mathematically) rational, then unless otherwise noted +an implementation is free to return either an accurate +rational result +or a single float approximation. +If the arguments are all rational +but the result cannot be expressed +as a rational number, then a single float +approximation is always returned. +

    +

    If the arguments to a mathematical function are all of type + (or rational (complex rational)) +and the true mathematical result is + (mathematically) a complex number with rational real and imaginary + parts, then unless otherwise noted an implementation is free to return + either an accurate result of type (or rational (complex rational)) +or + a single float + (permissible only if the imaginary part of the true mathematical + result is zero) or (complex single-float). If the arguments are + all of type (or rational (complex rational)) +but the result cannot be + expressed as a rational or complex rational, +then the returned + value will be of type single-float +(permissible only if the imaginary + part of the true mathematical result is zero) or (complex single-float). +

    +
    +
      Function  Sample Results                                   
+  abs       (abs #c(3 4)) ⇒  5 or 5.0                       
+  acos      (acos 1) ⇒  0 or 0.0                            
+  acosh     (acosh 1) ⇒  0 or 0.0                           
+  asin      (asin 0) ⇒  0 or 0.0                            
+  asinh     (asinh 0) ⇒  0 or 0.0                           
+  atan      (atan 0) ⇒  0 or 0.0                            
+  atanh     (atanh 0) ⇒  0 or 0.0                           
+  cis       (cis 0) ⇒  #c(1 0) or #c(1.0 0.0)               
+  cos       (cos 0) ⇒  1 or 1.0                             
+  cosh      (cosh 0) ⇒  1 or 1.0                            
+  exp       (exp 0) ⇒  1 or 1.0                             
+  expt      (expt 8 1/3) ⇒  2 or 2.0                        
+  log       (log 1) ⇒  0 or 0.0                             
+            (log 8 2) ⇒  3 or 3.0                           
+  phase     (phase 7) ⇒  0 or 0.0                           
+  signum    (signum #c(3 4)) ⇒  #c(3/5 4/5) or #c(0.6 0.8)  
+  sin       (sin 0) ⇒  0 or 0.0                             
+  sinh      (sinh 0) ⇒  0 or 0.0                            
+  sqrt      (sqrt 4) ⇒  2 or 2.0                            
+            (sqrt 9/16) ⇒  3/4 or 0.75                      
+  tan       (tan 0) ⇒  0 or 0.0                             
+  tanh      (tanh 0) ⇒  0 or 0.0                            
+
+  Figure 12–8: Functions Affected by Rule of Float Substitutability
+
+
    + +
    +
    +

    +Previous: , Up: Rational Computations  

    +
    + + + + + diff --git a/info/gcl/Rule-of-Float-Underflow-and-Overflow.html b/info/gcl/Rule-of-Float-Underflow-and-Overflow.html new file mode 100644 index 0000000..600403b --- /dev/null +++ b/info/gcl/Rule-of-Float-Underflow-and-Overflow.html @@ -0,0 +1,55 @@ + + + + + +Rule of Float Underflow and Overflow (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Floating-point Computations  

    +
    +
    +

    12.1.4.4 Rule of Float Underflow and Overflow

    + +

    An error of type floating-point-overflow +or floating-point-underflow should be signaled if a +floating-point computation causes exponent overflow or underflow, respectively. +

    + + + + + diff --git a/info/gcl/Rule-of-Float-and-Rational-Contagion.html b/info/gcl/Rule-of-Float-and-Rational-Contagion.html new file mode 100644 index 0000000..e284cc8 --- /dev/null +++ b/info/gcl/Rule-of-Float-and-Rational-Contagion.html @@ -0,0 +1,63 @@ + + + + + +Rule of Float and Rational Contagion (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Floating-point Computations  

    +
    +
    +

    12.1.4.1 Rule of Float and Rational Contagion

    + +

    When rationals and floats are combined by a numerical function, +the rational is first converted to a float of the same format. +For functions such as + that take more than two arguments, +it is permitted that part of the operation be carried out exactly using +rationals and the rest be done using floating-point arithmetic. +

    +

    When rationals and floats are compared by a numerical function, +the function rational is effectively called to convert the float +to a rational and then an exact +comparison is performed. In the case of complex numbers, +the real and imaginary parts are effectively handled individually. +

    + + + + + diff --git a/info/gcl/Rule-of-Unbounded-Rational-Precision.html b/info/gcl/Rule-of-Unbounded-Rational-Precision.html new file mode 100644 index 0000000..6821219 --- /dev/null +++ b/info/gcl/Rule-of-Unbounded-Rational-Precision.html @@ -0,0 +1,55 @@ + + + + + +Rule of Unbounded Rational Precision (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Rational Computations  

    +
    +
    +

    12.1.3.1 Rule of Unbounded Rational Precision

    + +

    Rational computations cannot overflow in the usual sense +(though there may not be enough storage to represent a result), +since integers and ratios may in principle be of any magnitude. +

    + + + + + diff --git a/info/gcl/Rules-about-Test-Functions.html b/info/gcl/Rules-about-Test-Functions.html new file mode 100644 index 0000000..d98f3e0 --- /dev/null +++ b/info/gcl/Rules-about-Test-Functions.html @@ -0,0 +1,59 @@ + + + + + +Rules about Test Functions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences  

    +
    +
    +

    17.2 Rules about Test Functions

    + + + + + +
    • Satisfying a Two-Argument Test   +
    • Satisfying a One-Argument Test   +
    + + + + + + diff --git a/info/gcl/Rules-for-Initialization-Arguments.html b/info/gcl/Rules-for-Initialization-Arguments.html new file mode 100644 index 0000000..c04f1e2 --- /dev/null +++ b/info/gcl/Rules-for-Initialization-Arguments.html @@ -0,0 +1,150 @@ + + + + + +Rules for Initialization Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    +
    +

    7.1.4 Rules for Initialization Arguments

    + +

    The :initarg slot option may be specified more than +once for a given slot. +

    +

    The following rules specify when initialization arguments may be +multiply defined: +

    +
    +
    *
    +

    A given initialization argument can be used to +initialize more than one slot if the same initialization argument name +appears in more than one :initarg slot option. +

    +
    +
    *
    +

    A given initialization argument name can appear +in the lambda list of more than one initialization method. +

    +
    +
    *
    +

    A given initialization argument name can +appear both in an :initarg slot option and +in the lambda list +of an initialization method. +

    +
    +
    + +

    [Reviewer Note by The next three paragraphs could be replaced by “If two or more +initialization arguments that initialize the same slot appear in the +defaulted initialization argument list, the leftmost of these supplies +the value, even if they have different names.” And the rest would follow +from the rules above.] +

    +

    If two or more initialization arguments that initialize the same +slot are given in the arguments to make-instance, the +leftmost of these initialization arguments in the initialization +argument list supplies the value, even if the initialization arguments +have different names. +

    +

    If two or more different initialization arguments that initialize the +same slot have default values and none is given explicitly in the +arguments to make-instance, the initialization argument that +appears in a :default-initargs class option in the most specific +of the classes supplies the value. If a single +:default-initargs class option specifies two or more initialization +arguments that initialize the same slot and none is given +explicitly in the arguments to make-instance, the leftmost in +the :default-initargs class option supplies the value, and the +values of the remaining default value forms are ignored. +

    +

    Initialization arguments given explicitly in the arguments to +make-instance appear to the left of defaulted initialization +arguments. Suppose that the classes C_1 and C_2 supply the +values of defaulted initialization arguments for different slots, +and suppose that C_1 is more specific than C_2; then the +defaulted initialization argument whose value is supplied by C_1 +is to the left of the defaulted initialization argument whose value is +supplied by C_2 in the defaulted initialization argument +list. If a single :default-initargs class option supplies the +values of initialization arguments for two different slots, the +initialization argument whose value is specified farther to the left in +the :default-initargs class option appears farther to the left in +the defaulted initialization argument list. +

    +

    [Reviewer Note by Barmar: End of claim made three paragraphs back.] +

    +

    If a slot has both an :initform form and an +:initarg slot option, and the initialization argument is defaulted +using :default-initargs or is supplied to make-instance, +the captured :initform form is neither used nor evaluated. +

    +

    The following is an example of the above rules: +

    +
    +
     (defclass q () ((x :initarg a)))
+ (defclass r (q) ((x :initarg b))
+   (:default-initargs a 1 b 2))
+
    + +
    +
    +
                                Defaulted                                     
+ Form                         Initialization Argument List Contents of Slot X 
+ _____________________________________________________________________________
+ (make-instance 'r)           (a 1 b 2)                    1                  
+ (make-instance 'r 'a 3)      (a 3 b 2)                    3                  
+ (make-instance 'r 'b 4)      (b 4 a 1)                    4                  
+ (make-instance 'r 'a 1 'a 2) (a 1 a 2 b 2)                1                  
+
    +
    +
+
    + + +
    +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    + + + + + diff --git a/info/gcl/Safe-and-Unsafe-Calls.html b/info/gcl/Safe-and-Unsafe-Calls.html new file mode 100644 index 0000000..20123c1 --- /dev/null +++ b/info/gcl/Safe-and-Unsafe-Calls.html @@ -0,0 +1,164 @@ + + + + + +Safe and Unsafe Calls (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.1 Safe and Unsafe Calls

    + +

    A call is a safe call + + if each of the following is +either safe code or system code (other than +system code that results from macro expansion of +programmer code): +

    +
    *
    +

    the call. +

    +
    *
    +

    the definition of the function being called. +

    +
    *
    +

    the point of functional evaluation +

    +
    + +

    The following special cases require some elaboration: +

    +
    +
    *
    +

    If the function being called is a generic function, +it is considered safe if all of the following are +

    +

    safe code or system code: +

    +
    +
    –
    +

    its definition (if it was defined explicitly). +

    +
    –
    +

    the method definitions for all applicable methods. +

    +
    –
    +

    the definition of its method combination. +

    +
    + +
    +
    *
    +

    For the form (coerce x 'function), +where x is a lambda expression, +the value of the optimize quality safety +in the global environment at the time the coerce +is executed applies to the resulting function. +

    +
    +
    *
    +

    For a call to the function ensure-generic-function, the value of the +optimize quality safety in the environment +object passed as the :environment argument applies +to the resulting generic function. +

    +
    +
    *
    +

    For a call to compile with a lambda expression as the +argument, the value of the optimize quality safety +in the global environment at the time compile is called +applies to the resulting compiled function. +

    +
    +
    *
    +

    For a call to compile with only one argument, if the original definition +of the function was safe, then the resulting compiled function +must also be safe. +

    +
    +
    *
    +

    A call to a method by call-next-method must be +considered safe if each of the following is +

    +

    safe code or system code: +

    +
    +
    –
    +

    the definition of the generic function (if it was defined explicitly). +

    +
    –
    +

    the method definitions for all applicable methods. +

    +
    –
    +

    the definition of the method combination. +

    +
    –
    +

    the point of entry into the body of the method defining form, + where the binding of call-next-method is established. +

    +
    –
    +

    the point of functional evaluation of the name call-next-method. +

    +
    + +
    +
    + +

    An unsafe call + + is a call that is not a safe call. +

    +

    The informal intent is that the programmer can rely on a call +to be safe, even when system code is involved, if all reasonable +steps have been taken to ensure that the call is safe. +For example, if a programmer calls mapcar from safe +code and supplies a function that was compiled +as safe, the implementation is required to ensure that +mapcar makes a safe call as well. +

    +
    +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    + + + + + diff --git a/info/gcl/Satisfying-a-One_002dArgument-Test.html b/info/gcl/Satisfying-a-One_002dArgument-Test.html new file mode 100644 index 0000000..c9fe67d --- /dev/null +++ b/info/gcl/Satisfying-a-One_002dArgument-Test.html @@ -0,0 +1,105 @@ + + + + + +Satisfying a One-Argument Test (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Rules about Test Functions  

    +
    +
    +

    17.2.2 Satisfying a One-Argument Test

    + +

    When using one of the functions in Figure 17–3, +the elements E of a sequence S are filtered +not on the basis of the presence or absence of an object O +under a two argument predicate, +as with the functions described in Satisfying a Two-Argument Test, +but rather on the basis of a one argument predicate. +

    +
    +
      assoc-if       member-if           rassoc-if          
+  assoc-if-not   member-if-not       rassoc-if-not      
+  count-if       nsubst-if           remove-if          
+  count-if-not   nsubst-if-not       remove-if-not      
+  delete-if      nsubstitute-if      subst-if           
+  delete-if-not  nsubstitute-if-not  subst-if-not       
+  find-if        position-if         substitute-if      
+  find-if-not    position-if-not     substitute-if-not  
+
+  Figure 17–3: Operators that have One-Argument Tests to be Satisfied
+
+
    + +

    The element E_i might not be considered directly. +If a :key argument is provided, +it is a designator for a function of one argument +to be called with each E_i as an argument, +and yielding an object Z_i to be used for comparison. +(If there is no :key argument, Z_i is E_i.) +

    +

    Functions defined in this specification and having a name that +ends in “-if” accept a first argument that is a designator for a +function of one argument, Z_i. +An E_i is said to satisfy the test + + if this :test function +returns a generalized boolean representing true. +

    +

    Functions defined in this specification and having a name that +ends in “-if-not” accept a first argument that is a designator for a +function of one argument, Z_i. +An E_i is said to satisfy the test + + if this :test function +returns a generalized boolean representing false. +

    + + +
    • Examples of Satisfying a One-Argument Test   +
    + +
    +
    +

    +Previous: , Up: Rules about Test Functions  

    +
    + + + + + diff --git a/info/gcl/Satisfying-a-Two_002dArgument-Test.html b/info/gcl/Satisfying-a-Two_002dArgument-Test.html new file mode 100644 index 0000000..db0ea26 --- /dev/null +++ b/info/gcl/Satisfying-a-Two_002dArgument-Test.html @@ -0,0 +1,125 @@ + + + + + +Satisfying a Two-Argument Test (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Rules about Test Functions  

    +
    +
    +

    17.2.1 Satisfying a Two-Argument Test

    + +

    When an object O is being considered iteratively +against each element E_i +of a sequence S +by an operator F listed in Figure 17–2, +it is sometimes useful to control the way in which the presence of O +is tested in S is tested by F. +This control is offered on the basis of a function designated with +either a :test or :test-not argument. +

    +
    +
      adjoin           nset-exclusive-or  search            
+  assoc            nsublis            set-difference    
+  count            nsubst             set-exclusive-or  
+  delete           nsubstitute        sublis            
+  find             nunion             subsetp           
+  intersection     position           subst             
+  member           pushnew            substitute        
+  mismatch         rassoc             tree-equal        
+  nintersection    remove             union             
+  nset-difference  remove-duplicates                    
+
+  Figure 17–2: Operators that have Two-Argument Tests to be Satisfied
+
+
    + +

    The object O might not be compared directly to E_i. +If a :key argument is provided, +it is a designator for a function of one argument +to be called with each E_i as an argument, +and yielding an object Z_i to be used for comparison. +(If there is no :key argument, Z_i is E_i.) +

    +

    The function designated by the :key argument is never called on O itself. +However, if the function operates on multiple sequences +(e.g., as happens in set-difference), O +will be the result of calling the :key function on an +element of the other sequence. +

    +

    A :test argument, if supplied to F, +is a designator for a function +of two arguments, O and Z_i. +An E_i is said (or, sometimes, an O and an E_i are said) +to satisfy the test + +

    +

    if this :test function returns a generalized boolean representing +true. +

    +

    A :test-not argument, if supplied to F, +is designator for a function +of two arguments, O and Z_i. +An E_i is said (or, sometimes, an O and an E_i are said) +to satisfy the test + +

    +

    if this :test-not function +returns a generalized boolean representing false. +

    +

    If neither a :test nor a :test-not argument is supplied, +it is as if a :test argument of #'eql was supplied. +

    +

    The consequences are unspecified if both a :test and a :test-not argument +are supplied in the same call to F. +

    + + +
    • Examples of Satisfying a Two-Argument Test   +
    + +
    +
    +

    +Next: , Previous: , Up: Rules about Test Functions  

    +
    + + + + + diff --git a/info/gcl/Scope-and-Purpose.html b/info/gcl/Scope-and-Purpose.html new file mode 100644 index 0000000..05b6b20 --- /dev/null +++ b/info/gcl/Scope-and-Purpose.html @@ -0,0 +1,57 @@ + + + + + +Scope and Purpose (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Scope  

    +
    +
    +

    1.1.1 Scope and Purpose

    + +

    The specification set forth in this document is designed to promote +the portability of Common Lisp programs among a variety of data processing +systems. It is a language specification aimed at an audience of +implementors and knowledgeable programmers. It is neither a tutorial nor +an implementation guide. +

    + + + + + diff --git a/info/gcl/Scope.html b/info/gcl/Scope.html new file mode 100644 index 0000000..91f3a1b --- /dev/null +++ b/info/gcl/Scope.html @@ -0,0 +1,59 @@ + + + + + +Scope (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.1 Scope, Purpose, and History

    + + + + + +
    • Scope and Purpose   +
    • History   +
    + + + + + + diff --git a/info/gcl/Seconds.html b/info/gcl/Seconds.html new file mode 100644 index 0000000..15f3044 --- /dev/null +++ b/info/gcl/Seconds.html @@ -0,0 +1,66 @@ + + + + + +Seconds (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Time  

    +
    +
    +

    25.1.4.4 Seconds

    + +

    One function, sleep, takes its argument as a non-negative real number +of seconds. Informally, it may be useful to think of this as +a relative universal time, but it differs in one important way: +universal times are always non-negative integers, whereas the argument to +sleep can be any kind of non-negative real, in order to allow for +the possibility of fractional seconds. +

    +
    +
      sleep    
+
+  Figure 25–8: Defined names involving time in Seconds.
+
+
    + + + + + + + diff --git a/info/gcl/Sections-Not-Formally-Part-Of-This-Standard.html b/info/gcl/Sections-Not-Formally-Part-Of-This-Standard.html new file mode 100644 index 0000000..88c2f76 --- /dev/null +++ b/info/gcl/Sections-Not-Formally-Part-Of-This-Standard.html @@ -0,0 +1,75 @@ + + + + + +Sections Not Formally Part Of This Standard (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Definitions  

    +
    +
    +

    1.4.3 Sections Not Formally Part Of This Standard

    + +

    Front matter and back matter, such as the “Table of Contents,” +“Index,” “Figures,” “Credits,” and “Appendix” are not considered formally +part of this standard, so that we retain the flexibility needed to update +these sections even at the last minute without fear of needing a formal +vote to change those parts of the document. These items are quite short +and very useful, however, and it is not recommended that they be removed +even in an abridged version of this document. +

    +

    Within the concept sections, subsections whose names begin with +the words “Note” or “Notes” or “Example” or “Examples” +are provided for illustration purposes only, and are not considered +part of the standard. +

    +

    An attempt has been made to place these sections last in their parent section, +so that they could be removed without disturbing the contiguous numbering of the +surrounding sections in order to produce a document of smaller size. +

    +

    Likewise, the “Examples” and “Notes” sections in a dictionary entry +are not considered part of the standard and could be removed if necessary. +

    +

    Nevertheless, the examples provide important clarifications and consistency +checks for the rest of the material, and such abridging is not recommended +unless absolutely unavoidable. +

    + + + + + diff --git a/info/gcl/Selecting-the-Applicable-Methods.html b/info/gcl/Selecting-the-Applicable-Methods.html new file mode 100644 index 0000000..823c7cd --- /dev/null +++ b/info/gcl/Selecting-the-Applicable-Methods.html @@ -0,0 +1,53 @@ + + + + + +Selecting the Applicable Methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    +
    +

    7.6.6.2 Selecting the Applicable Methods

    + +

    This step is described in Introduction to Methods. +

    + + + + + diff --git a/info/gcl/Self_002dEvaluating-Objects.html b/info/gcl/Self_002dEvaluating-Objects.html new file mode 100644 index 0000000..91e8f96 --- /dev/null +++ b/info/gcl/Self_002dEvaluating-Objects.html @@ -0,0 +1,65 @@ + + + + + +Self-Evaluating Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.12 Self-Evaluating Objects

    + +

    A form that is neither a symbol nor a cons is +defined to be a self-evaluating object. Evaluating +such an object yields the same object +as a result. +

    +

    Certain specific symbols and conses might also happen +to be “self-evaluating” but only as a special case of a more +general set of rules for the evaluation of symbols and +conses; such objects are not considered to be +self-evaluating objects. +

    +

    The consequences are undefined if literal objects (including +self-evaluating objects) are destructively modified. +

    + + + + + diff --git a/info/gcl/Semantic-Constraints.html b/info/gcl/Semantic-Constraints.html new file mode 100644 index 0000000..5cea81f --- /dev/null +++ b/info/gcl/Semantic-Constraints.html @@ -0,0 +1,171 @@ + + + + + +Semantic Constraints (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Compilation Semantics  

    +
    +
    +

    3.2.2.7 Semantic Constraints

    + +

    All conforming programs must obey the following constraints, +which are designed to minimize the observable differences +between compiled and interpreted programs: +

    +
    +
    *
    +

    Definitions of any referenced macros +must be present in the compilation environment. +Any form that is a list +beginning with a symbol that does not name a +special operator or a macro defined in the +compilation environment is treated by the compiler as a +function call. +

    +
    +
    *
    +

    Special proclamations for dynamic variables +must be made in the compilation environment. Any binding +for which there is no special declaration or proclamation in +the compilation environment is treated by the compiler as +a lexical binding. +

    +
    +
    *
    +

    The definition of a function that is defined and +declared inline in the compilation environment must be +the same at run time. +

    +
    +
    *
    +

    Within a function named F, the compiler may +(but is not required to) +assume that an apparent recursive call to a function named F +refers to the same definition of F, +unless that function has been declared notinline. +The consequences of redefining such a recursively defined function F +while it is executing are undefined. +

    +
    +
    *
    +

    A call within a file to a named function that is +defined in the same file refers to that function, unless that function +has been declared notinline. The consequences are unspecified +if functions are redefined individually at run time or multiply +defined in the same file. +

    +
    +
    *
    +

    The argument syntax and number of return values for +all functions whose ftype is declared at compile time must +remain the same at run time. +

    +
    +
    *
    +

    Constant variables defined in +the compilation environment must have a similar value at +run time. A reference to +a constant variable +in source code is equivalent to a reference to +a literal object that is the value of the constant variable. +

    +
    +
    *
    +

    Type definitions made with deftype or +defstruct in the compilation environment must +retain the same definition at run time. Classes defined by defclass +in the compilation environment must be defined +at run time to have the same superclasses and same +metaclass. +

    +

    This implies that subtype/supertype relationships of +type specifiers must not change between compile time and run time. +

    +
    +
    *
    +

    Type declarations present in the compilation +environment must accurately describe the corresponding values at run time; +otherwise, the consequences are undefined. It is permissible +for an unknown type to appear in a declaration at +compile time, though a warning might be signaled in such a case. +

    +
    +
    *
    +

    Except in the situations explicitly listed above, a +function defined in the evaluation environment +is permitted to have a different definition or a different signature +at run time, and the run-time definition prevails. +

    +
    +
    + +

    Conforming programs should not be written using any additional +assumptions about consistency between the run-time +environment and the startup, evaluation, and compilation +environments. +

    +

    Except where noted, when a compile-time and a run-time definition are +different, one of the following occurs at run time: +

    +
    +
    *
    +

    an error of type error is signaled +

    +
    *
    +

    the compile-time definition prevails +

    +
    *
    +

    the run-time definition prevails +

    +
    +
    + +

    If the compiler processes a function form whose operator +is not defined at compile time, no error is signaled at compile time. +

    +
    +
    +

    +Previous: , Up: Compilation Semantics  

    +
    + + + + + diff --git a/info/gcl/Semicolon.html b/info/gcl/Semicolon.html new file mode 100644 index 0000000..53bb9c6 --- /dev/null +++ b/info/gcl/Semicolon.html @@ -0,0 +1,74 @@ + + + + + +Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.4 Semicolon

    + +

    Syntax: ;<<text>> +

    +

    A semicolon introduces characters that are to be ignored, +such as comments. The semicolon and all characters up to +and including the next newline or end of file are ignored. +

    + + + + + + + + +
    • Examples of Semicolon   +
    • Notes about Style for Semicolon   +
    • Use of Single Semicolon   +
    • Use of Double Semicolon   +
    • Use of Triple Semicolon   +
    • Use of Quadruple Semicolon   +
    • Examples of Style for Semicolon   +
    + + + + + + diff --git a/info/gcl/Sequence-Concepts.html b/info/gcl/Sequence-Concepts.html new file mode 100644 index 0000000..9811eb6 --- /dev/null +++ b/info/gcl/Sequence-Concepts.html @@ -0,0 +1,98 @@ + + + + + +Sequence Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences  

    +
    +
    +

    17.1 Sequence Concepts

    + + +

    A sequence + + is an ordered collection of elements, +implemented as either a vector or a list. +

    +

    Sequences can be created by the function make-sequence, +as well as other functions that create objects +of types that are subtypes of sequence +(e.g., list, make-list, mapcar, and vector). +

    +

    A sequence function + + is a function + defined by this specification +or added as an extension by the implementation +that operates on one or more sequences. +Whenever a sequence function must construct and return +a new vector, it always returns a simple vector. +Similarly, any strings constructed will be simple strings. +

    +
    +
      concatenate        length              remove             
+  copy-seq           map                 remove-duplicates  
+  count              map-into            remove-if          
+  count-if           merge               remove-if-not      
+  count-if-not       mismatch            replace            
+  delete             notany              reverse            
+  delete-duplicates  notevery            search             
+  delete-if          nreverse            some               
+  delete-if-not      nsubstitute         sort               
+  elt                nsubstitute-if      stable-sort        
+  every              nsubstitute-if-not  subseq             
+  fill               position            substitute         
+  find               position-if         substitute-if      
+  find-if            position-if-not     substitute-if-not  
+  find-if-not        reduce                                 
+
+        Figure 17–1: Standardized Sequence Functions       
+
+
    + + + +
    • General Restrictions on Parameters that must be Sequences   +
    + + + + + + diff --git a/info/gcl/Sequences-Dictionary.html b/info/gcl/Sequences-Dictionary.html new file mode 100644 index 0000000..6642f55 --- /dev/null +++ b/info/gcl/Sequences-Dictionary.html @@ -0,0 +1,101 @@ + + + + + +Sequences Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Sequences  

    +
    +
    +

    17.3 Sequences Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • sequence   +
    • copy-seq   +
    • elt   +
    • fill   +
    • make-sequence   +
    • subseq   +
    • map   +
    • map-into   +
    • reduce   +
    • count   +
    • length   +
    • reverse   +
    • sort   +
    • find   +
    • position   +
    • search   +
    • mismatch   +
    • replace   +
    • substitute   +
    • concatenate   +
    • merge   +
    • remove   +
    • remove-duplicates   +
    + + + + + + diff --git a/info/gcl/Sequences.html b/info/gcl/Sequences.html new file mode 100644 index 0000000..69cbdbc --- /dev/null +++ b/info/gcl/Sequences.html @@ -0,0 +1,60 @@ + + + + + +Sequences (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    17 Sequences

    + + + + + +
    • Sequence Concepts   +
    • Rules about Test Functions   +
    • Sequences Dictionary   +
    + + + + + + diff --git a/info/gcl/Serious-Conditions.html b/info/gcl/Serious-Conditions.html new file mode 100644 index 0000000..e823129 --- /dev/null +++ b/info/gcl/Serious-Conditions.html @@ -0,0 +1,56 @@ + + + + + +Serious Conditions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Condition Types  

    +
    +
    +

    9.1.1.1 Serious Conditions

    + +

    A serious condition is a condition serious +enough to require interactive intervention if not handled. +Serious conditions are typically signaled with error or cerror; +non-serious conditions are typically signaled with signal or warn. +

    + + + + + diff --git a/info/gcl/Setf-Expansions-and-Places.html b/info/gcl/Setf-Expansions-and-Places.html new file mode 100644 index 0000000..2c384b2 --- /dev/null +++ b/info/gcl/Setf-Expansions-and-Places.html @@ -0,0 +1,62 @@ + + + + + +Setf Expansions and Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.6 Setf Expansions and Places

    + +

    Any compound form for which the operator has a +

    +

    setf expander +

    +

    defined can be used as a place. +

    +

    The +operator +must refer to the global function definition, +rather than a locally defined function or macro. +

    + + + + + diff --git a/info/gcl/Setf-Expansions.html b/info/gcl/Setf-Expansions.html new file mode 100644 index 0000000..6c1a3e6 --- /dev/null +++ b/info/gcl/Setf-Expansions.html @@ -0,0 +1,119 @@ + + + + + +Setf Expansions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of Places and Generalized Reference  

    +
    +
    +

    5.1.1.3 Setf Expansions

    + +

    Sometimes it is possible to avoid evaluating subforms of a +place multiple times or in the wrong order. A +

    +

    setf expansion +

    +

    for a given access form can be expressed as an ordered collection of five objects: +

    +
    +
    List of temporary variables
    +

    a list of symbols naming temporary variables to be bound +sequentially, as if by let*, to values +resulting from value forms. +

    +
    +
    List of value forms
    +

    a list of forms (typically, subforms of the +place) which when evaluated +yield the values to which the corresponding temporary +variables should be bound. +

    +
    +
    List of store variables
    +

    a list of symbols naming temporary store variables which are +to hold the new values that will be assigned to the +place. +

    +
    +
    Storing form
    +

    a form which can reference both the temporary and the store variables, +and which changes the value of the place +and guarantees to return as its values the values of the store variables, +which are the correct values for setf to return. +

    +
    +
    Accessing form
    +

    a form which can reference the temporary variables, +and which returns the value of the place. +

    +
    + +

    The value returned by the accessing form is +affected by execution of the storing form, but either of these +forms might be evaluated any number of times. +

    +

    It is possible +to do more than one setf in parallel via +psetf, shiftf, and rotatef. +Because of this, the +

    +

    setf expander +

    +

    must produce new temporary +and store variable names every time. For examples of how to do this, +see gensym. +

    +

    For each standardized accessor function F, +unless it is explicitly documented otherwise, +it is implementation-dependent whether the ability to +use an F form as a setf place +is implemented by a setf expander or a setf function. +Also, it follows from this that it is implementation-dependent +whether the name (setf F) is fbound. +

    +
    +
    +

    +Next: , Previous: , Up: Overview of Places and Generalized Reference  

    +
    + + + + + diff --git a/info/gcl/Shadowing.html b/info/gcl/Shadowing.html new file mode 100644 index 0000000..f57d098 --- /dev/null +++ b/info/gcl/Shadowing.html @@ -0,0 +1,144 @@ + + + + + +Shadowing (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    +
    +

    3.1.5 Shadowing

    + +

    If two forms that establish lexical bindings with +the same name N are textually nested, then references to N +within the inner form refer to the binding established by +the inner form; the inner binding for N +shadows + + the outer binding for N. Outside the inner +form but inside the outer one, references to N refer to the +binding established by the outer form. For example: +

    +
    +
     (defun test (x z)
+   (let ((z (* x 2)))
+     (print z))
+   z)
+
    + +

    The binding of the variable z by +let shadows +the parameter binding for the function test. The reference to the +variable z in the print form refers to the let binding. +The reference to z at the end of the function test +refers to the parameter named z. +

    +

    Constructs that are lexically scoped act as if new names were +generated for each object on each execution. Therefore, +dynamic shadowing cannot occur. For example: +

    +
    +
     (defun contorted-example (f g x)
+   (if (= x 0)
+       (funcall f)
+       (block here
+          (+ 5 (contorted-example g
+                                  #'(lambda () (return-from here 4))
+                                  (- x 1))))))
+
    + +

    Consider the call (contorted-example nil nil 2). This produces +4. During the course of execution, there are three +calls to contorted-example, interleaved with two +blocks: +

    +
    +
     (contorted-example nil nil 2)
+   (block here_1 ...)
+     (contorted-example nil #'(lambda () (return-from here_1 4)) 1)
+       (block here_2 ...)
+         (contorted-example #'(lambda () (return-from here_1 4))
+                            #'(lambda () (return-from here_2 4))
+                            0)
+             (funcall f)
+                    where f ⇒  #'(lambda () (return-from here_1 4))
+                 (return-from here_1 4)
+
    + +

    At the time the funcall is executed +there are two block exit points outstanding, each apparently +named here. +The return-from form executed as a result of the funcall +operation +refers to the outer outstanding exit point +(here_1), not the +inner one (here_2). +It +refers to that exit point textually visible at the point of +execution of function +(here abbreviated by the #' syntax) that resulted +in creation of the function object actually invoked by +funcall. +

    +

    If, in this example, one were to change the (funcall f) to +(funcall g), then the value of the call (contorted-example nil nil 2) +would be 9. The value would change because +funcall would cause the +execution of (return-from here_2 4), thereby causing +a return from the inner exit point (here_2). +When that occurs, the value 4 is returned from the +middle invocation of contorted-example, 5 is added to that +to get 9, and that value is returned from the outer block +and the outermost call to contorted-example. The point +is that the choice of exit point +returned from has nothing to do with its +being innermost or outermost; rather, +it depends on the lexical environment +that is packaged up with a lambda expression when +function is executed. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    + + + + + diff --git a/info/gcl/Shared_002dInitialize.html b/info/gcl/Shared_002dInitialize.html new file mode 100644 index 0000000..d0d6798 --- /dev/null +++ b/info/gcl/Shared_002dInitialize.html @@ -0,0 +1,136 @@ + + + + + +Shared-Initialize (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    +
    +

    7.1.5 Shared-Initialize

    + +

    The generic function shared-initialize is used to fill the +slots +of an instance +using initialization arguments and :initform +forms when an instance is created, when an +instance is re-initialized, +when an instance +is updated to conform to a redefined class, and when +an instance is updated to conform to a different class. +It uses +standard method combination. It takes the following arguments: the +instance to be initialized, a +specification of a set of names of slots +accessible in that instance, and any number of initialization +arguments. The arguments after the first two must form an +initialization argument list. +

    +

    The second argument to shared-initialize may be one of the following: +

    +
    +
    *
    +

    It can be a (possibly empty) list of slot names, +which specifies the set of those slot names. +

    +
    +
    *
    +

    It can be the symbol t, which specifies the set of all of the slots. +

    +
    +
    + +

    There is a system-supplied primary method for shared-initialize +whose first parameter specializer is the class standard-object. +This method behaves as follows on each slot, +whether shared or local: +

    +
    +
    *
    +

    If an initialization argument in the +initialization argument list specifies a value for that slot, +that value is stored +into the slot, even if a value has already been stored in the slot +before the method is run. +The affected slots are independent of which +slots are indicated by the second argument to shared-initialize. +

    +
    +
    *
    +

    Any slots +indicated by the second argument that are still +unbound at this point are initialized according to their +:initform forms. For any such slot +that has an :initform form, +that form is evaluated in the +lexical environment of its defining +defclass form and the result is stored into the slot. +For example, +if a before method stores a value in the +slot, the :initform form will not be used to supply a value +for the slot. If +the second argument specifies a name that does not correspond to any +slots accessible +in the instance, the results are unspecified. +

    +
    +
    *
    +

    The rules mentioned in Rules for Initialization Arguments are obeyed. +

    +
    +
    + +

    The generic function shared-initialize is called by the +system-supplied primary methods +for reinitialize-instance, +update-instance-for-different-class, +update-instance-for-redefined-class, and +initialize-instance. Thus, methods can be written for +shared-initialize to specify actions that should be taken in all of +these contexts. +

    +
    +
    +

    +Next: , Previous: , Up: Object Creation and Initialization  

    +
    + + + + + diff --git a/info/gcl/Sharpsign-A.html b/info/gcl/Sharpsign-A.html new file mode 100644 index 0000000..ea4d82d --- /dev/null +++ b/info/gcl/Sharpsign-A.html @@ -0,0 +1,97 @@ + + + + + +Sharpsign A (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.13 Sharpsign A

    + +

    #nA +

    +

    #nAobject constructs an n-dimensional array, +using object as the value of the :initial-contents argument +to make-array. +

    +

    For example, #2A((0 1 5) (foo 2 (hot dog))) represents a 2-by-3 matrix: +

    +
    +
     0       1       5
+ foo     2       (hot dog)
+
    + +

    In contrast, #1A((0 1 5) (foo 2 (hot dog))) +represents a vector of length 2 +whose elements are lists: +

    +
    +
     (0 1 5) (foo 2 (hot dog))
+
    + +

    #0A((0 1 5) (foo 2 (hot dog))) represents a zero-dimensional +array whose sole element is a list: +

    +
    +
     ((0 1 5) (foo 2 (hot dog)))
+
    + +

    #0A foo represents +a zero-dimensional array whose sole element is the +symbol foo. +The notation #1A foo is not valid because foo is +not a sequence. +

    +

    If some dimension of the array +whose representation is being parsed is found to be 0, +all dimensions to the right +(i.e., the higher numbered dimensions) +are also considered to be 0. +

    +

    For information on how the Lisp printer prints arrays, +see Printing Strings, + Printing Bit Vectors, + Printing Other Vectors, + or Printing Other Arrays. +

    + + + + + diff --git a/info/gcl/Sharpsign-Asterisk.html b/info/gcl/Sharpsign-Asterisk.html new file mode 100644 index 0000000..239f7c8 --- /dev/null +++ b/info/gcl/Sharpsign-Asterisk.html @@ -0,0 +1,80 @@ + + + + + +Sharpsign Asterisk (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.4 Sharpsign Asterisk

    + +

    Syntax: #*<<bits>> +

    +

    A simple bit vector is constructed containing the indicated bits +(0’s and 1’s), where the leftmost bit has index zero +and the subsequent bits have increasing indices. +

    +

    Syntax: #<<n>>*<<bits>> +

    +

    With an argument n, +the vector to be created is of length n. +If the number of bits is less than n but greater than zero, +the last bit is used to fill all remaining bits of the bit vector. +

    +

    The notations #* and #0* each denote an empty bit vector. +

    +

    Regardless of whether the optional numeric argument n is provided, +the token that follows the asterisk is delimited by +a normal token delimiter. +However, (unless the value of *read-suppress* is true) +an error of type reader-error is signaled + if that token is not composed entirely of 0’s and 1’s, + or if n was supplied + and the token is composed of more than n bits, + or if n is greater than one, but no bits were specified. +Neither a single escape nor a multiple escape is permitted in this token. +

    +

    For information on how the Lisp printer prints bit vectors, +see Printing Bit Vectors. +

    + + + + + diff --git a/info/gcl/Sharpsign-B.html b/info/gcl/Sharpsign-B.html new file mode 100644 index 0000000..7fca447 --- /dev/null +++ b/info/gcl/Sharpsign-B.html @@ -0,0 +1,62 @@ + + + + + +Sharpsign B (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.8 Sharpsign B

    + +

    #Brational reads rational in binary (radix 2). +For example, +

    +
    +
     #B1101 ≡ 13 ;1101_2
+ #b101/11 ≡ 5/3
+
    + +

    The consequences are undefined if the token immediately following +the #B does not have the syntax of a binary (i.e., radix 2) rational. +

    + + + + + diff --git a/info/gcl/Sharpsign-Backslash.html b/info/gcl/Sharpsign-Backslash.html new file mode 100644 index 0000000..94128a4 --- /dev/null +++ b/info/gcl/Sharpsign-Backslash.html @@ -0,0 +1,78 @@ + + + + + +Sharpsign Backslash (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.1 Sharpsign Backslash

    + +

    Syntax: #\<<x>> +

    +

    When the token x is a single character long, +this parses as the literal character char. +Uppercase and lowercase letters are distinguished after #\; +#\A and #\a denote different character objects. +Any single character works after #\, +even those that are normally special to read, +such as left-parenthesis and right-parenthesis. +

    +

    In the single character case, +the x must be followed by a non-constituent character. +After #\ is read, +the reader backs up over the slash and then reads a token, +treating the initial slash as a single escape character +(whether it really is or not in the current readtable). +

    +

    When the token x is more than one character long, +the x must have the syntax of a symbol +with no embedded package markers. +In this case, the sharpsign backslash notation +parses as the character whose name is (string-upcase x); +see Character Names. +

    +

    For information about how the Lisp printer prints character objects, +see Printing Characters. +

    + + + + + diff --git a/info/gcl/Sharpsign-C.html b/info/gcl/Sharpsign-C.html new file mode 100644 index 0000000..b7a3d64 --- /dev/null +++ b/info/gcl/Sharpsign-C.html @@ -0,0 +1,81 @@ + + + + + +Sharpsign C (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.12 Sharpsign C

    + +

    #C reads a following object, which must be a list of +length two whose elements are both reals. +These reals denote, respectively, +the real and imaginary parts of a complex number. +

    +

    If the two parts as notated are not of the same data type, +then they are converted +according to the rules of floating-point contagion +described in Contagion in Numeric Operations. +

    +

    #C(real imag) is equivalent to +#.(complex (quote real) (quote imag)), +except that #C is not affected by *read-eval*. +See the function complex. +

    +

    Figure 2–21 contains examples of the use of #C. +

    +
    +
      #C(3.0s1 2.0s-1)  ;A complex with small float parts.                
+  #C(5 -3)          ;A “Gaussian integer”                             
+  #C(5/3 7.0)       ;Will be converted internally to #C(1.66666 7.0)  
+  #C(0 1)           ;The imaginary unit; that is, i.                  
+
+                  Figure 2–21: Complex Number Example                
+
+
    + +

    For further information, +see Printing Complexes and Syntax of a Complex. +

    + + + + + diff --git a/info/gcl/Sharpsign-Colon.html b/info/gcl/Sharpsign-Colon.html new file mode 100644 index 0000000..dc9a940 --- /dev/null +++ b/info/gcl/Sharpsign-Colon.html @@ -0,0 +1,63 @@ + + + + + +Sharpsign Colon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.6 Sharpsign Colon

    + +

    Syntax: #:<<symbol-name>> +

    +

    #: introduces an uninterned symbol whose name +is symbol-name. Every time this syntax is encountered, +a distinct uninterned symbol is created. +The symbol-name must have the syntax of a symbol +with no package prefix. +

    +

    For information on how the Lisp reader +prints uninterned symbols, +see Printing Symbols. +

    + + + + + diff --git a/info/gcl/Sharpsign-Dot.html b/info/gcl/Sharpsign-Dot.html new file mode 100644 index 0000000..95be395 --- /dev/null +++ b/info/gcl/Sharpsign-Dot.html @@ -0,0 +1,66 @@ + + + + + +Sharpsign Dot (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.7 Sharpsign Dot

    + +

    #.foo is read as the object resulting from the evaluation +of the object represented by foo. +The evaluation is done during the read process, +when the #. notation is encountered. +The #. syntax therefore performs a read-time evaluation of foo. +

    +

    The normal effect of #. is inhibited when the value of *read-eval* is false. +

    +

    In that situation, an error of type reader-error is signaled. +

    +

    For an object +that does not have a convenient printed +representation, a form that computes the object can be given using +the #. notation. +

    + + + + + diff --git a/info/gcl/Sharpsign-Equal_002dSign.html b/info/gcl/Sharpsign-Equal_002dSign.html new file mode 100644 index 0000000..a5b201b --- /dev/null +++ b/info/gcl/Sharpsign-Equal_002dSign.html @@ -0,0 +1,61 @@ + + + + + +Sharpsign Equal-Sign (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.16 Sharpsign Equal-Sign

    + +

    #n= +

    +

    #n=object reads as whatever object +has object as its printed representation. However, that object +is labeled by n, a required unsigned decimal integer, for +possible reference by the syntax #n#. +The scope of the label is the expression being read by the outermost +call to read; within this expression, +the same label may not appear twice. +

    + + + + + diff --git a/info/gcl/Sharpsign-Left_002dParenthesis.html b/info/gcl/Sharpsign-Left_002dParenthesis.html new file mode 100644 index 0000000..95c469f --- /dev/null +++ b/info/gcl/Sharpsign-Left_002dParenthesis.html @@ -0,0 +1,96 @@ + + + + + +Sharpsign Left-Parenthesis (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.3 Sharpsign Left-Parenthesis

    + +

    #( and ) are used to notate a simple vector. +

    +

    If an unsigned decimal integer +appears between the # and (, +it specifies explicitly the length of the vector. +The consequences are undefined if the number of objects +specified before the closing ) +exceeds the unsigned decimal integer. +If the number of objects supplied before the closing ) +is less than the unsigned decimal integer but greater than zero, +the last object +is used to fill all +remaining elements of the vector. +

    +

    [Editorial Note by Barmar: This should say "signals...".] +The consequences are undefined if the unsigned decimal integer is non-zero and +number of objects supplied before the closing ) +is zero. +For example, +

    +
    +
     #(a b c c c c)
+ #6(a b c c c c)
+ #6(a b c)
+ #6(a b c c)
+
    + +

    all mean the same thing: a vector of length 6 +with elements a, b, and four occurrences of c. +Other examples follow: +

    +
    +
     #(a b c)               ;A vector of length 3
+ #(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)
+                        ;A vector containing the primes below 50
+ #()                    ;An empty vector
+
    + +

    The notation #() denotes an empty vector, as does #0(). +

    +

    For information on how the Lisp printer prints vectors, +see Printing Strings, + Printing Bit Vectors, + or Printing Other Vectors. +

    + + + + + diff --git a/info/gcl/Sharpsign-Less_002dThan_002dSign.html b/info/gcl/Sharpsign-Less_002dThan_002dSign.html new file mode 100644 index 0000000..492d7d2 --- /dev/null +++ b/info/gcl/Sharpsign-Less_002dThan_002dSign.html @@ -0,0 +1,60 @@ + + + + + +Sharpsign Less-Than-Sign (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.23 Sharpsign Less-Than-Sign

    + +

    #< is not valid reader syntax. +The Lisp reader will signal an error +

    +

    of type reader-error +

    +

    on encountering #<. +This syntax is typically used in the printed representation +of objects that cannot be read back in. +

    + + + + + diff --git a/info/gcl/Sharpsign-Minus.html b/info/gcl/Sharpsign-Minus.html new file mode 100644 index 0000000..e64078b --- /dev/null +++ b/info/gcl/Sharpsign-Minus.html @@ -0,0 +1,61 @@ + + + + + +Sharpsign Minus (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.19 Sharpsign Minus

    + +

    #- is like #+ +except that it skips the expression if the test succeeds; +that is, +

    +
    +
    #-test expression ≡ #+(not test) expression
+
    + +

    For examples, see Examples of Feature Expressions. +

    + + + + + diff --git a/info/gcl/Sharpsign-O.html b/info/gcl/Sharpsign-O.html new file mode 100644 index 0000000..27f7479 --- /dev/null +++ b/info/gcl/Sharpsign-O.html @@ -0,0 +1,63 @@ + + + + + +Sharpsign O (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.9 Sharpsign O

    + +

    #Orational reads rational in octal (radix 8). +For example, +

    +
    +
     #o37/15 ≡ 31/13
+ #o777 ≡ 511
+ #o105 ≡ 69 ;105_8
+
    + +

    The consequences are undefined if the token immediately following +the #O does not have the syntax of an octal (i.e., radix 8) rational. +

    + + + + + diff --git a/info/gcl/Sharpsign-P.html b/info/gcl/Sharpsign-P.html new file mode 100644 index 0000000..8994ed6 --- /dev/null +++ b/info/gcl/Sharpsign-P.html @@ -0,0 +1,60 @@ + + + + + +Sharpsign P (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.15 Sharpsign P

    + +

    #P reads a following object, which must be a string. +

    +

    #P<<expression>> is equivalent to +#.(parse-namestring '<<expression>>), +except that #P is not affected by *read-eval*. +

    +

    For information on how the Lisp printer prints pathnames, +see Printing Pathnames. +

    + + + + + diff --git a/info/gcl/Sharpsign-Plus.html b/info/gcl/Sharpsign-Plus.html new file mode 100644 index 0000000..3b52805 --- /dev/null +++ b/info/gcl/Sharpsign-Plus.html @@ -0,0 +1,74 @@ + + + + + +Sharpsign Plus (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.18 Sharpsign Plus

    + +

    #+ provides a read-time conditionalization facility; +the syntax is #+test expression. +If the feature expression test succeeds, +then this textual notation represents an object + whose printed representation is expression. +If the feature expression test fails, +then this textual notation is treated as whitespace_2; + that is, it is as if the “#+ test expression” + did not appear and only a space appeared in its place. +

    +

    For a detailed description of success and failure in feature expressions, +see Feature Expressions. +

    +

    #+ operates by first reading the feature expression +and then skipping over the form if the feature expression fails. +

    +

    While reading the test, the current package is the KEYWORD package. +

    +

    Skipping over the form is accomplished by binding +*read-suppress* to true and then calling read. +

    +

    For examples, see Examples of Feature Expressions. +

    + + + + + diff --git a/info/gcl/Sharpsign-R.html b/info/gcl/Sharpsign-R.html new file mode 100644 index 0000000..ba843ca --- /dev/null +++ b/info/gcl/Sharpsign-R.html @@ -0,0 +1,90 @@ + + + + + +Sharpsign R (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.11 Sharpsign R

    + +

    #nR +

    +

    #radixRrational reads rational in radix radix. +radix must consist of only digits +that are interpreted as an integer +in decimal radix; its value must be between 2 and 36 (inclusive). +Only valid digits +for the specified radix may be used. +

    +

    For example, #3r102 is another way of writing 11 (decimal), +and #11R32 +is another way of writing 35 (decimal). +For radices larger than 10, letters of +the alphabet are used in order for the digits after 9. +No alternate # notation exists for the decimal radix since a +decimal point suffices. +

    +

    Figure 2–20 contains examples of the use of #B, +#O, #X, and #R. +

    +
    +
      #2r11010101  ;Another way of writing 213 decimal  
+  #b11010101   ;Ditto                               
+  #b+11010101  ;Ditto                               
+  #o325        ;Ditto, in octal radix               
+  #xD5         ;Ditto, in hexadecimal radix         
+  #16r+D5      ;Ditto                               
+  #o-300       ;Decimal -192, written in base 8     
+  #3r-21010    ;Same thing in base 3                
+  #25R-7H      ;Same thing in base 25               
+  #xACCEDED    ;181202413, in hexadecimal radix     
+
+        Figure 2–20: Radix Indicator Example       
+
+
    + +

    The consequences are undefined if the token immediately following +the #nR does not have the syntax of a rational in radix n. +

    + + + + + diff --git a/info/gcl/Sharpsign-Right_002dParenthesis.html b/info/gcl/Sharpsign-Right_002dParenthesis.html new file mode 100644 index 0000000..4f19a49 --- /dev/null +++ b/info/gcl/Sharpsign-Right_002dParenthesis.html @@ -0,0 +1,59 @@ + + + + + +Sharpsign Right-Parenthesis (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.25 Sharpsign Right-Parenthesis

    + +

    This is not valid reader syntax. +

    +

    The Lisp reader will signal an error +

    +

    of type reader-error +

    +

    upon encountering #). +

    + + + + + diff --git a/info/gcl/Sharpsign-S.html b/info/gcl/Sharpsign-S.html new file mode 100644 index 0000000..49e19a8 --- /dev/null +++ b/info/gcl/Sharpsign-S.html @@ -0,0 +1,81 @@ + + + + + +Sharpsign S (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.14 Sharpsign S

    + +

    #s(name slot1 value1 slot2 value2 ...) +denotes a structure. This is valid only if name is the name +of a structure type already defined by defstruct +and if the structure type has a standard constructor function. +Let cm stand for the name of this constructor function; +then this syntax is equivalent to +

    +
    +
     #.(cm keyword1 'value1 keyword2 'value2 ...)
+
    + +

    where each keywordj is the result of computing +

    +
    +
     (intern (string slotj) (find-package 'keyword))
+
    + +

    The net effect is that the constructor function is called with the specified +slots having the specified values. +

    +

    (This coercion feature is deprecated; in the future, keyword names will + be taken in the package they are read in, so symbols that are + actually in the KEYWORD package should be used if that is what is desired.) +

    +

    Whatever object the constructor function returns +is returned by the #S syntax. +

    +

    For information on how the Lisp printer prints structures, +see Printing Structures. +

    + + + + + diff --git a/info/gcl/Sharpsign-Sharpsign.html b/info/gcl/Sharpsign-Sharpsign.html new file mode 100644 index 0000000..505ad8d --- /dev/null +++ b/info/gcl/Sharpsign-Sharpsign.html @@ -0,0 +1,87 @@ + + + + + +Sharpsign Sharpsign (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.17 Sharpsign Sharpsign

    + +

    #n# +

    +

    #n#, where n is a required unsigned decimal +integer, +provides a reference to some object labeled by #n=; +that is, #n# represents a pointer to the same +(eq) object labeled by #n=. +For example, a structure created in the variable y by this code: +

    +
    +
     (setq x (list 'p 'q))
+ (setq y (list (list 'a 'b) x 'foo x))
+ (rplacd (last y) (cdr y))
+
    + +

    could be represented in this way: +

    +
    +
     ((a b) . #1=(#2=(p q) foo #2# . #1#))
+
    + +

    Without this notation, but with *print-length* set to 10 +and *print-circle* set to nil, +the structure would print in this way: +

    +
    +
     ((a b) (p q) foo (p q) (p q) foo (p q) (p q) foo (p q) ...)
+
    + +

    A reference #n# may only occur after a label #n=; +forward references are not permitted. The reference +may not appear as the labeled object itself (that is, +#n=#n#) may not be written +because the object +labeled by #n= is not well defined in this case. +

    + + + + + diff --git a/info/gcl/Sharpsign-Single_002dQuote.html b/info/gcl/Sharpsign-Single_002dQuote.html new file mode 100644 index 0000000..bbd9ea3 --- /dev/null +++ b/info/gcl/Sharpsign-Single_002dQuote.html @@ -0,0 +1,62 @@ + + + + + +Sharpsign Single-Quote (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.2 Sharpsign Single-Quote

    + +

    Any expression preceded by #' +(sharpsign followed by single-quote), +as in #'expression, +is treated by the Lisp reader as an abbreviation for and parsed identically +to the expression (function expression). +See function. For example, +

    +
    +
    (apply #'+ l) ≡ (apply (function +) l)
+
    + + + + + + diff --git a/info/gcl/Sharpsign-Vertical_002dBar.html b/info/gcl/Sharpsign-Vertical_002dBar.html new file mode 100644 index 0000000..e9edaec --- /dev/null +++ b/info/gcl/Sharpsign-Vertical_002dBar.html @@ -0,0 +1,55 @@ + + + + + +Sharpsign Vertical-Bar (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.20 Sharpsign Vertical-Bar

    + +

    #|...|# is treated as a comment by the reader. +It must be balanced with respect to other occurrences of #| and |#, +but otherwise may contain any characters whatsoever. +

    + + + + + diff --git a/info/gcl/Sharpsign-Whitespace.html b/info/gcl/Sharpsign-Whitespace.html new file mode 100644 index 0000000..f1530f7 --- /dev/null +++ b/info/gcl/Sharpsign-Whitespace.html @@ -0,0 +1,55 @@ + + + + + +Sharpsign Whitespace (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.24 Sharpsign Whitespace

    + +

    # followed immediately by whitespace_1 is not valid reader syntax. +The Lisp reader will signal an error of type reader-error if it +encounters the reader macro notation #<Newline> or #<Space>. +

    + + + + + diff --git a/info/gcl/Sharpsign-X.html b/info/gcl/Sharpsign-X.html new file mode 100644 index 0000000..8c74350 --- /dev/null +++ b/info/gcl/Sharpsign-X.html @@ -0,0 +1,63 @@ + + + + + +Sharpsign X (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sharpsign  

    +
    +
    +

    2.4.8.10 Sharpsign X

    + +

    #Xrational reads rational in hexadecimal (radix 16). +The digits above 9 are the letters A through F (the lowercase +letters a through f are also acceptable). For example, +

    +
    +
     #xF00 ≡ 3840             
+ #x105 ≡ 261 ;105_16
+
    + +

    The consequences are undefined if the token immediately following +the #X does not have the syntax of a hexadecimal (i.e., radix 16) rational. +

    + + + + + diff --git a/info/gcl/Sharpsign.html b/info/gcl/Sharpsign.html new file mode 100644 index 0000000..91a8c01 --- /dev/null +++ b/info/gcl/Sharpsign.html @@ -0,0 +1,185 @@ + + + + + +Sharpsign (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.8 Sharpsign

    + +

    Sharpsign is a non-terminating dispatching macro character. +It reads an optional +sequence of digits and then one more character, +and uses that character to select a function to run as a +reader macro function. +

    +

    The standard syntax includes constructs introduced by the # character. +The syntax of these constructs is as follows: +a character that identifies the type of construct is +followed by arguments in some form. +If the character is a letter, its case is not important; +#O and #o are considered to be equivalent, for example. +

    +

    Certain # constructs allow an unsigned decimal number to appear +between the # and the character. +

    +

    The reader macros associated with the dispatching macro character # +are described later in this section and summarized in Figure 2–19. +

    + + +
    +
      dispatch char  purpose                  dispatch char  purpose                
+  Backspace      signals error            {              undefined*             
+  Tab            signals error            }              undefined*             
+  Newline        signals error            +              read-time conditional  
+  Linefeed       signals error            -              read-time conditional  
+  Page           signals error            .              read-time evaluation   
+  Return         signals error            /              undefined              
+  Space          signals error            A, a           array                  
+  !              undefined*               B, b           binary rational        
+  "              undefined                C, c           complex number         
+  #              reference to = label     D, d           undefined              
+  $             undefined                E, e           undefined              
+  %              undefined                F, f           undefined              
+  &              undefined                G, g           undefined              
+  ’              function abbreviation    H, h           undefined              
+  (              simple vector            I, i           undefined              
+  )              signals error            J, j           undefined              
+  *              bit vector               K, k           undefined              
+  ,              undefined                L, l           undefined              
+  :              uninterned symbol        M, m           undefined              
+  ;              undefined                N, n           undefined              
+  <              signals error            O, o           octal rational         
+  =              labels following object  P, p           pathname               
+  >              undefined                Q, q           undefined              
+  ?              undefined*               R, r           radix-n rational       
+  @              undefined                S, s           structure              
+  [              undefined*               T, t           undefined              
+  \              character object         U, u           undefined              
+  ]              undefined*               V, v           undefined              
+  ^            undefined                W, w           undefined              
+  _              undefined                X, x           hexadecimal rational   
+  ‘              undefined                Y, y           undefined              
+  |              balanced comment         Z, z           undefined              
+  ~              undefined                Rubout         undefined              
+
+           Figure 2–19: Standard # Dispatching Macro Character Syntax         
+
+
    + + +

    The combinations marked by an asterisk (*) are explicitly reserved to the +user. No conforming implementation defines them. +

    +

    Note also that digits do not appear in the preceding table. This is +because the notations #0, #1, ..., #9 are +reserved for another purpose which occupies the same syntactic space. +When a digit follows a sharpsign, +it is not treated as a dispatch character. +Instead, an unsigned integer argument is accumulated +and passed as an argument to the reader macro +for the character that follows the digits. +For example, +#2A((1 2) (3 4)) is a use of #A with an argument of 2. +

    + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • Sharpsign Backslash   +
    • Sharpsign Single-Quote   +
    • Sharpsign Left-Parenthesis   +
    • Sharpsign Asterisk   +
    • Examples of Sharpsign Asterisk   +
    • Sharpsign Colon   +
    • Sharpsign Dot   +
    • Sharpsign B   +
    • Sharpsign O   +
    • Sharpsign X   +
    • Sharpsign R   +
    • Sharpsign C   +
    • Sharpsign A   +
    • Sharpsign S   +
    • Sharpsign P   +
    • Sharpsign Equal-Sign   +
    • Sharpsign Sharpsign   +
    • Sharpsign Plus   +
    • Sharpsign Minus   +
    • Sharpsign Vertical-Bar   +
    • Examples of Sharpsign Vertical-Bar   +
    • Notes about Style for Sharpsign Vertical-Bar   +
    • Sharpsign Less-Than-Sign   +
    • Sharpsign Whitespace   +
    • Sharpsign Right-Parenthesis   +
    + +
    +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    + + + + + diff --git a/info/gcl/Shorthand-notation-for-Type-Declarations.html b/info/gcl/Shorthand-notation-for-Type-Declarations.html new file mode 100644 index 0000000..25956ce --- /dev/null +++ b/info/gcl/Shorthand-notation-for-Type-Declarations.html @@ -0,0 +1,55 @@ + + + + + +Shorthand notation for Type Declarations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Declaration Identifiers  

    +
    +
    +

    3.3.3.1 Shorthand notation for Type Declarations

    + +

    A type specifier can be used as a declaration identifier. +(type-specifier {var}*) is taken as shorthand for +(type type-specifier {var}*). +

    + + + + + diff --git a/info/gcl/Signaling-and-Handling-Conditions.html b/info/gcl/Signaling-and-Handling-Conditions.html new file mode 100644 index 0000000..e797455 --- /dev/null +++ b/info/gcl/Signaling-and-Handling-Conditions.html @@ -0,0 +1,129 @@ + + + + + +Signaling and Handling Conditions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Condition System Concepts  

    +
    +
    +

    9.1.4 Signaling and Handling Conditions

    + +

    The operation of the condition system depends on the ordering of +active applicable handlers from most recent to least recent. +

    +

    Each handler is associated with a type specifier +that must designate a subtype of type condition. A handler +is said to be applicable to a condition if that +condition is of the type designated by the associated +type specifier. +

    +

    Active handlers are established by using +handler-bind (or an abstraction based on handler-bind, +such as handler-case or ignore-errors). +

    +

    Active handlers can be established within the +dynamic scope of other active handlers. +At any point during program execution, there is a set of active handlers. +When a condition is signaled, the most recent active applicable handler +for that condition is selected from this set. +Given a condition, the order of recentness of +active applicable handlers is defined by the following two rules: +

    +
    +
    1.
    +

    Each handler in a set of active handlers H_1 is +more recent than every handler in a set H_2 if the +handlers in H_2 were active when the handlers in H_1 were +established. +

    +
    +
    2.
    +

    Let h_1 and h_2 be two applicable active +handlers established by the same form. Then h_1 is +more recent than h_2 if h_1 was defined to the left of +h_2 in the form that established them. +

    +
    +
    + +

    Once a handler in a handler binding form (such as +handler-bind or handler-case) has been selected, all +handlers in that form become inactive for +the remainder of the signaling process. +While the selected handler runs, no other handler established +by that form is active. That is, if the handler declines, +no other handler established by that form will be considered for possible invocation. +

    +

    Figure 9–4 shows operators relating to +the handling of conditions. +

    +
    +
      handler-bind  handler-case  ignore-errors  
+
+  Figure 9–4: Operators relating to handling conditions.
+
+
    + + + + + + + + + +
    • Signaling   +
    • Resignaling a Condition   +
    • Restarts   +
    • Interactive Use of Restarts   +
    • Interfaces to Restarts   +
    • Restart Tests   +
    • Associating a Restart with a Condition   +
    + +
    +
    +

    +Next: , Previous: , Up: Condition System Concepts  

    +
    + + + + + diff --git a/info/gcl/Signaling.html b/info/gcl/Signaling.html new file mode 100644 index 0000000..4d7f2e9 --- /dev/null +++ b/info/gcl/Signaling.html @@ -0,0 +1,83 @@ + + + + + +Signaling (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Signaling and Handling Conditions  

    +
    +
    +

    9.1.4.1 Signaling

    + +

    When a condition is signaled, the most recent +applicable active handler is invoked. +Sometimes a handler will decline by simply returning +without a transfer of control. +In such cases, the next most recent applicable active handler is +invoked. +

    +

    If there are no applicable handlers for a condition that +has been signaled, or if all applicable handlers decline, the +condition is unhandled. +

    +

    The functions cerror and error invoke the +interactive condition handler (the debugger) rather than +return if the condition being signaled, regardless of +its type, is unhandled. In contrast, signal +returns nil if the condition being signaled, +regardless of its type, is unhandled. +

    +

    The variable *break-on-signals* can be used to cause the +debugger to be entered before the signaling process begins. +

    +

    Figure 9–5 shows defined names relating to +the signaling of conditions. +

    +
    +
      *break-on-signals*  error   warn  
+  cerror              signal        
+
+  Figure 9–5: Defined names relating to signaling conditions.
+
+
    + + + + + + diff --git a/info/gcl/Similarity-of-Aggregate-Objects.html b/info/gcl/Similarity-of-Aggregate-Objects.html new file mode 100644 index 0000000..0f028e7 --- /dev/null +++ b/info/gcl/Similarity-of-Aggregate-Objects.html @@ -0,0 +1,58 @@ + + + + + +Similarity of Aggregate Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Literal Objects in Compiled Files  

    +
    +
    +

    3.2.4.3 Similarity of Aggregate Objects

    + +

    Of the types over which similarity is defined, +some are treated as aggregate objects. For these types, +similarity is defined recursively. +We say that an object of these types has certain “basic qualities” +and to satisfy the similarity relationship, the values of the +corresponding qualities of the two objects must also be similar. +

    + + + + + diff --git a/info/gcl/Similarity-of-Literal-Objects.html b/info/gcl/Similarity-of-Literal-Objects.html new file mode 100644 index 0000000..148e887 --- /dev/null +++ b/info/gcl/Similarity-of-Literal-Objects.html @@ -0,0 +1,51 @@ + + + + + +Similarity of Literal Objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Literal Objects in Compiled Files  

    +
    +
    +

    3.2.4.2 Similarity of Literal Objects

    + + + + + + diff --git a/info/gcl/Simple-Loop.html b/info/gcl/Simple-Loop.html new file mode 100644 index 0000000..95cd658 --- /dev/null +++ b/info/gcl/Simple-Loop.html @@ -0,0 +1,62 @@ + + + + + +Simple Loop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.2 Simple Loop

    + +

    A simple loop form is one that has a body containing +only compound forms. +Each form is evaluated in turn from left to right. +When the last form has been evaluated, +then the first form is evaluated again, and so on, in a never-ending cycle. +A simple loop form establishes an implicit block named nil. +The execution of a simple loop can be terminated by explicitly +transfering control to the implicit block (using return or +return-from) or to some exit point outside of the block +(e.g., using throw, go, or return-from). +

    + + + + + diff --git a/info/gcl/Simple-vs-Extended-Loop.html b/info/gcl/Simple-vs-Extended-Loop.html new file mode 100644 index 0000000..7cb5110 --- /dev/null +++ b/info/gcl/Simple-vs-Extended-Loop.html @@ -0,0 +1,55 @@ + + + + + +Simple vs Extended Loop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.1 Simple vs Extended Loop

    + +

    loop forms are partitioned into two categories: + simple loop forms + and extended loop forms. +

    + + + + + diff --git a/info/gcl/Single-Escape-Character.html b/info/gcl/Single-Escape-Character.html new file mode 100644 index 0000000..fb6d441 --- /dev/null +++ b/info/gcl/Single-Escape-Character.html @@ -0,0 +1,63 @@ + + + + + +Single Escape Character (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.7 Single Escape Character

    + +

    A single escape + + is used to indicate that +the next character is to be treated as +an alphabetic_2 character +with its case preserved, +no matter what the character is +or which constituent traits it has. +

    +

    Slash is a single escape character +in standard syntax. +

    + + + + + diff --git a/info/gcl/Single_002dQuote.html b/info/gcl/Single_002dQuote.html new file mode 100644 index 0000000..4d3a1f9 --- /dev/null +++ b/info/gcl/Single_002dQuote.html @@ -0,0 +1,64 @@ + + + + + +Single-Quote (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standard Macro Characters  

    +
    +
    +

    2.4.3 Single-Quote

    + +

    Syntax: '<<exp>> +

    +

    A single-quote introduces an expression to be “quoted.” +Single-quote followed by an expression exp +is treated by the Lisp reader as an abbreviation for +and is parsed identically to the expression (quote exp). +See the special operator quote. +

    + + +
    • Examples of Single-Quote   +
    + + + + + + diff --git a/info/gcl/Slots.html b/info/gcl/Slots.html new file mode 100644 index 0000000..3b70bf2 --- /dev/null +++ b/info/gcl/Slots.html @@ -0,0 +1,61 @@ + + + + + +Slots (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects  

    +
    +
    +

    7.5 Slots

    + + + + + + +
    • Introduction to Slots   +
    • Accessing Slots   +
    • Inheritance of Slots and Slot Options   +
    + + + + + + diff --git a/info/gcl/Some-Exceptions-to-Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html b/info/gcl/Some-Exceptions-to-Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html new file mode 100644 index 0000000..d0a5320 --- /dev/null +++ b/info/gcl/Some-Exceptions-to-Constraints-on-the-COMMON_002dLISP-Package-for-Conforming-Programs.html @@ -0,0 +1,86 @@ + + + + + +Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.4 Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs

    + +

    If an external symbol of the COMMON-LISP package +is not globally defined as a standardized dynamic variable + or constant variable, +it is allowed to lexically bind it + and to declare the type of that binding, +and +it is allowed to locally establish it as a symbol macro +(e.g., with symbol-macrolet). +

    +

    Unless explicitly specified otherwise, +if an external symbol of the COMMON-LISP package +is globally defined as a standardized dynamic variable, +it is permitted to bind or assign that dynamic variable +provided that the “Value Type” constraints on the dynamic variable +are maintained, and that the new value of the variable +is consistent with the stated purpose of the variable. +

    +

    If an external symbol of the COMMON-LISP package is not defined +as a standardized function, macro, or special operator, +it is allowed to lexically bind it as a function (e.g., with flet), + to declare the ftype of that binding, + and + (in implementations which provide the ability to do so) + to trace that binding. +

    +

    If an external symbol of the COMMON-LISP package is not defined +as a standardized function, macro, or special operator, +it is allowed to lexically bind it as a macro (e.g., with macrolet). +

    +

    If an external symbol of the COMMON-LISP package is not defined +as a standardized function, macro, or special operator, +it is allowed to lexically bind its setf function name +as a function, +and to declare the ftype of that binding. +

    + + + + + diff --git a/info/gcl/Sorting-the-Applicable-Methods-by-Precedence-Order.html b/info/gcl/Sorting-the-Applicable-Methods-by-Precedence-Order.html new file mode 100644 index 0000000..240b4fd --- /dev/null +++ b/info/gcl/Sorting-the-Applicable-Methods-by-Precedence-Order.html @@ -0,0 +1,88 @@ + + + + + +Sorting the Applicable Methods by Precedence Order (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    +
    +

    7.6.6.3 Sorting the Applicable Methods by Precedence Order

    + +

    To compare the precedence of two methods, their parameter specializers +are examined in order. The default examination order is from left to +right, but an alternative order may be specified by the +:argument-precedence-order option to defgeneric or to any of +the other operators that specify generic function options. +

    +

    The corresponding parameter specializers from each method are +compared. When a pair of parameter specializers agree, the next +pair are compared for agreement. If all corresponding parameter +specializers agree, the two methods must have different +qualifiers; in this case, either method can be selected to precede the +other. For information about agreement, see Agreement on Parameter Specializers and Qualifiers. +

    +

    If some corresponding parameter specializers do not agree, the first +pair of parameter specializers that do not agree determines the +precedence. If both parameter specializers are classes, the more +specific of the two methods is the method whose parameter specializer +appears earlier in the class precedence list of the corresponding +argument. Because of the way in which the set of applicable methods +is chosen, the parameter specializers are guaranteed to be present in +the class precedence list of the class of the argument. +

    +

    If just one of a pair of corresponding parameter specializers is (eql object), +the method with that parameter specializer precedes the +other method. If both parameter specializers are eql +expressions, the +specializers must agree (otherwise the two methods would +not both have been applicable to this argument). +

    +

    The resulting list of applicable methods has the most specific +method first and the least specific method last. +

    +
    +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    + + + + + diff --git a/info/gcl/Special-Characters-in-Pathname-Components.html b/info/gcl/Special-Characters-in-Pathname-Components.html new file mode 100644 index 0000000..ccec63d --- /dev/null +++ b/info/gcl/Special-Characters-in-Pathname-Components.html @@ -0,0 +1,70 @@ + + + + + +Special Characters in Pathname Components (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.2 Special Characters in Pathname Components

    + +

    Strings in pathname component values +never contain special characters that represent +separation between pathname fields, +such as slash in Unix filenames. +Whether separator characters are permitted as +part of a string in a pathname component +is implementation-defined; +however, if the implementation does permit it, +it must arrange to properly “quote” the character for the +file system when constructing a namestring. +For example, +

    +
    +
     ;; In a TOPS-20 implementation, which uses ^V to quote 
+ (NAMESTRING (MAKE-PATHNAME :HOST "OZ" :NAME "<TEST>"))
+⇒  #P"OZ:PS:^V<TEST^V>"
+NOT⇒ #P"OZ:PS:<TEST>"
+
    + + + + + + diff --git a/info/gcl/Special-Forms.html b/info/gcl/Special-Forms.html new file mode 100644 index 0000000..3af5e1e --- /dev/null +++ b/info/gcl/Special-Forms.html @@ -0,0 +1,89 @@ + + + + + +Special Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.8 Special Forms

    + +

    A special form is a form with special syntax, +special evaluation rules, or both, possibly manipulating the +evaluation environment, control flow, or both. +A special operator has access to + the current lexical environment +and the current dynamic environment. +Each special operator defines the manner in which its subexpressions +are treated—which are forms, which are special syntax, etc. +

    +

    Some special operators create new +lexical or dynamic environments for use during the +evaluation of subforms +of the special form. For example, block creates a +new lexical environment that is the same as the one in force +at the point of evaluation of the block form +with the addition of a binding of the block name +to an exit point from the block. +

    +

    The set of special operator names is fixed in Common Lisp; +no way is provided for the user to define a special operator. +Figure 3–2 lists all of the Common Lisp symbols +that have definitions as special operators. +

    +
    +
      block      let*                  return-from      
+  catch      load-time-value       setq             
+  eval-when  locally               symbol-macrolet  
+  flet       macrolet              tagbody          
+  function   multiple-value-call   the              
+  go         multiple-value-prog1  throw            
+  if         progn                 unwind-protect   
+  labels     progv                                  
+  let        quote                                  
+
+      Figure 3–2: Common Lisp Special Operators    
+
+
    + + + + + + diff --git a/info/gcl/Special-Pathname-Component-Values.html b/info/gcl/Special-Pathname-Component-Values.html new file mode 100644 index 0000000..d0755e2 --- /dev/null +++ b/info/gcl/Special-Pathname-Component-Values.html @@ -0,0 +1,51 @@ + + + + + +Special Pathname Component Values (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.6 Special Pathname Component Values

    + + + + + + diff --git a/info/gcl/Special-Symbols.html b/info/gcl/Special-Symbols.html new file mode 100644 index 0000000..c46dbe9 --- /dev/null +++ b/info/gcl/Special-Symbols.html @@ -0,0 +1,202 @@ + + + + + +Special Symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.6 Special Symbols

    + +

    The special symbols described here are used as a notational convenience +within this document, and are part of neither the Common Lisp language nor +its environment. +

    +
    +
    ⇒
    +

    This indicates evaluation. +For example: +

    +
    +
     (+ 4 5) ⇒  9 
+
    + +

    This means that the result of +evaluating the form (+ 4 5) is 9. +

    +

    If a form returns multiple values, those values might +be shown separated by spaces, line breaks, or commas. +For example: +

    +
    +
     (truncate 7 5)
+⇒  1 2
+ (truncate 7 5) 
+⇒  1
+   2
+ (truncate 7 5)
+⇒  1, 2
+
    + +

    Each of the above three examples is equivalent, and specifies +that (truncate 7 5) returns two values, which are 1 and 2. +

    +

    Some conforming implementations actually type an arrow (or some +other indicator) before showing return values, while others do not. +

    +
    +
    OR⇒
    +

    The notation “OR⇒” is used to denote one of several possible +alternate results. The example +

    +
    +
     (char-name #\a)
+⇒  NIL
+OR⇒ "LOWERCASE-a"
+OR⇒ "Small-A"
+OR⇒ "LA01"
+
    + +

    indicates that nil, "LOWERCASE-a", "Small-A", "LA01" are +among the possible results of (char-name #\a)—each with equal preference. +Unless explicitly specified otherwise, it should not be assumed that the set of possible +results shown is exhaustive. +Formally, the above example is equivalent to +

    +
    +
     (char-name #\a) ⇒  implementation-dependent
+
    + +

    but it is intended to provide additional information to illustrate some +of the ways in which it is permitted for implementations to diverge. +

    +
    +
    NOT⇒
    +

    The notation “NOT⇒” is used to denote a result which is not possible. +This might be used, for example, in order to emphasize a situation where +some anticipated misconception might lead the reader to falsely believe +that the result might be possible. For example, +

    +
    +
     (function-lambda-expression 
+    (funcall #'(lambda (x) #'(lambda () x)) nil))
+⇒  NIL, true, NIL
+OR⇒ (LAMBDA () X), true, NIL
+NOT⇒ NIL, false, NIL
+NOT⇒ (LAMBDA () X), false, NIL
+
    + +
    +
    ≡
    +

    This indicates code equivalence. For example: +

    +
    +
     (gcd x (gcd y z)) ≡ (gcd (gcd x y) z)
+
    + +

    This means that the results and observable side-effects of evaluating +the form +(gcd x (gcd y z)) are always the same as the results +and observable side-effects of +(gcd (gcd x y) z) for any +x, y, and z. +

    +
    +
    |>
    +

    Common Lisp specifies input and output with respect to a non-interactive stream model. +The specific details of how interactive input and output are mapped onto that +non-interactive model are implementation-defined. +

    +

    For example, conforming implementations are permitted to differ in issues +of how interactive input is terminated. For example, the function read +terminates when the final delimiter is typed on a non-interactive stream. +In some implementations, an interactive call to read returns +as soon as the final delimiter is typed, even if that delimiter is not a newline. +In other implementations, a final newline is always required. +In still other implementations, there might be a command which “activates” +a buffer full of input without the command itself being visible on the program’s +input stream. +

    +

    In the examples in this document, the notation “ |> ” precedes +lines where interactive input and output occurs. Within such a scenario, +“|>>this notation<<|” notates user input. +

    +

    For example, the notation +

    +
    +
     (+ 1 (print (+ (sqrt (read)) (sqrt (read)))))
+ |>  |>>9 16 <<|
+ |>  7
+⇒  8
+
    + +

    shows an interaction in which + “(+ 1 (print (+ (sqrt (read)) (sqrt (read)))))” + is a form to be evaluated, + “9 16 ” is interactive input, + “7” is interactive output, and + “8” is the value yielded from the evaluation. +

    +

    The use of this notation is intended to disguise small differences +in interactive input and output behavior between implementations. +

    +

    Sometimes, the non-interactive stream model calls for a newline. +How that newline character is interactively entered is an +implementation-defined detail of the user interface, but in that +case, either the notation “<Newline>” or “[<–~]” might be used. +

    +
    +
     (progn (format t "~&Who? ") (read-line))
+ |>  Who? |>>Fred, Mary, and Sally [<–~]<<|
+⇒  "Fred, Mary, and Sally", false
+
    + +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    + + + + + diff --git a/info/gcl/Special-_0022Syntax_0022-Notations-for-Overloaded-Operators.html b/info/gcl/Special-_0022Syntax_0022-Notations-for-Overloaded-Operators.html new file mode 100644 index 0000000..174eb45 --- /dev/null +++ b/info/gcl/Special-_0022Syntax_0022-Notations-for-Overloaded-Operators.html @@ -0,0 +1,70 @@ + + + + + +Special "Syntax" Notations for Overloaded Operators (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.25 Special "Syntax" Notations for Overloaded Operators

    + +

    If two descriptions exist for the same operation but with different numbers of +arguments, then the extra arguments are to be treated as optional. For example, +this pair of lines: +

    +

    file-position stream ⇒ position +

    +

    file-position stream position-spec ⇒ success-p +

    +

    is operationally equivalent to this line: +

    +

    file-position stream &optional position-spec ⇒ result +

    +

    and differs only in that it provides on opportunity to introduce different +names for parameter and values for each case. +The separated (multi-line) notation is used when an operator is overloaded in +such a way that the parameters are used in different ways +depending on how many arguments are supplied (e.g., for the function /) +or the return values are different in the two cases (e.g., for the function file-position). +

    + + + + + diff --git a/info/gcl/Specialized-Arrays.html b/info/gcl/Specialized-Arrays.html new file mode 100644 index 0000000..a95b44d --- /dev/null +++ b/info/gcl/Specialized-Arrays.html @@ -0,0 +1,86 @@ + + + + + +Specialized Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Array Concepts  

    +
    +
    +

    15.1.2 Specialized Arrays

    + +

    An array can be a general array, + meaning each element may be any object, +or it may be a specialized array, + meaning that each element must be of a restricted type. +

    +

    The phrasing “an array specialized to type <<type>>” +is sometimes used to emphasize the element type of an array. +This phrasing is tolerated even when the <<type>> is t, +even though an array specialized to type t +is a general array, not a specialized array. +

    +

    Figure 15–1 lists some defined names that are applicable to array +creation, access, and information operations. +

    +
    +
     adjust-array             array-in-bounds-p      svref                       
+ adjustable-array-p       array-rank             upgraded-array-element-type 
+ aref                     array-rank-limit       upgraded-complex-part-type  
+ array-dimension          array-row-major-index  vector                      
+ array-dimension-limit    array-total-size       vector-pop                  
+ array-dimensions         array-total-size-limit vector-push                 
+ array-element-type       fill-pointer           vector-push-extend          
+ array-has-fill-pointer-p make-array                                         
+
+           Figure 15–1: General Purpose Array-Related Defined Names          
+
+
    + + + + +
    • Array Upgrading   +
    • Required Kinds of Specialized Arrays   +
    + + + + + + diff --git a/info/gcl/Specialized-Lambda-Lists.html b/info/gcl/Specialized-Lambda-Lists.html new file mode 100644 index 0000000..7d5f3a5 --- /dev/null +++ b/info/gcl/Specialized-Lambda-Lists.html @@ -0,0 +1,88 @@ + + + + + +Specialized Lambda Lists (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.3 Specialized Lambda Lists

    + +

    A specialized lambda list + + is used to specialize a method +for a particular signature and to describe how arguments matching +that signature are received by the method. +The defined names in Figure 3–15 use specialized lambda lists +in some way; see the dictionary entry for each for information about how. +

    +
    +
      defmethod  defgeneric    
+
+  Figure 3–15: Standardized Operators that use Specialized Lambda Lists
+
+
    + +

    A specialized lambda list can contain the lambda list keywords shown +in Figure 3–16. +

    +
    +
      &allow-other-keys  &key       &rest  
+  &aux               &optional         
+
+  Figure 3–16: Lambda List Keywords used by Specialized Lambda Lists
+
+
    + +

    A specialized lambda list is syntactically the same as an ordinary lambda list +except that each required parameter may optionally be associated with a class +or object for which that parameter is specialized. +

    +

    lambda-list ::=({var | (var [specializer])}* +                [&optional {var |         (var [init-form [supplied-p-parameter]])}*] +                [&rest var] +                [&key {var |              ({var |          (keyword-name var)}    [init-form [supplied-p-parameter]])}* [&allow-other-keys]] +                [&aux {var | (var [init-form])}*]) +                +

    + + + + + diff --git a/info/gcl/Specifiers-for-_0026aux-variables.html b/info/gcl/Specifiers-for-_0026aux-variables.html new file mode 100644 index 0000000..a5bbd45 --- /dev/null +++ b/info/gcl/Specifiers-for-_0026aux-variables.html @@ -0,0 +1,67 @@ + + + + + +Specifiers for &aux variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.7 Specifiers for &aux variables

    + + + +

    These are not really parameters. If the lambda list keyword +&aux is present, all specifiers after it are auxiliary variable +specifiers. After all parameter specifiers have been processed, the +auxiliary variable specifiers (those following &aux) are processed +from left to right. For each one, init-form is evaluated and +var is bound to that value (or to nil if no init-form +was specified). &aux variable processing is analogous to +let* processing. +

    +
    +
     (lambda (x y &aux (a (car x)) (b 2) c) (list x y a b c))
+    ≡ (lambda (x y) (let* ((a (car x)) (b 2) c) (list x y a b c)))
+
    + + + + + + diff --git a/info/gcl/Specifiers-for-keyword-parameters.html b/info/gcl/Specifiers-for-keyword-parameters.html new file mode 100644 index 0000000..31ac502 --- /dev/null +++ b/info/gcl/Specifiers-for-keyword-parameters.html @@ -0,0 +1,140 @@ + + + + + +Specifiers for keyword parameters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.4 Specifiers for keyword parameters

    + +

    If &key +is present, all specifiers up to the next lambda list keyword +or the end of the list are keyword parameter specifiers. +When keyword parameters are processed, +the same arguments are processed that +would be made into a list for a rest parameter. +It is permitted to specify both &rest and &key. +In this case the remaining arguments are used for both purposes; +that is, all remaining arguments are made into a list for the +rest parameter, and are also processed for the &key parameters. +

    +

    If &key is specified, there must remain +an even number of arguments; see Odd Number of Keyword Arguments. +

    +

    These arguments are considered as pairs, +the first argument in each pair being interpreted as a name +and the second as the corresponding value. +The first object of each pair must be a symbol; +see Invalid Keyword Arguments. +The keyword parameter specifiers may optionally be followed by the +lambda list keyword &allow-other-keys. +

    +

    In each keyword parameter specifier must be a name var for +the parameter variable. +

    +

    If the var appears alone or in a (var init-form) +combination, the keyword name used when matching arguments to parameters +is a symbol in the KEYWORD package whose name is the +same (under string=) as var’s. +If the notation ((keyword-name var) init-form) is used, +then the keyword name used to match arguments to parameters is +keyword-name, which may be a symbol in any package. +(Of course, if it is not a symbol in the KEYWORD package, +it does not necessarily self-evaluate, so care must be taken when calling the function +to make sure that normal evaluation still yields the keyword name.) +

    +

    Thus +

    +
    +
     (defun foo (&key radix (type 'integer)) ...)
+
    + +

    means exactly the same as +

    +
    +
     (defun foo (&key ((:radix radix)) ((:type type) 'integer)) ...)
+
    + +

    The keyword parameter specifiers are, like all parameter specifiers, +effectively processed from left to right. For each keyword parameter +specifier, if there is an argument pair whose name matches that +specifier’s name (that is, the names are eq), then the +parameter variable for that specifier is bound to the second item (the +value) of that argument pair. If more than one such argument pair +matches, the leftmost argument pair is used. If no such argument pair +exists, then the init-form for that specifier is evaluated and +the parameter variable is bound to that value (or to nil if no +init-form was specified). supplied-p-parameter is +treated as for &optional parameters: it is bound to true if there +was a matching argument pair, and to false otherwise. +

    +

    Unless keyword argument checking is suppressed, +an argument pair must a name matched by a parameter specifier; +see Unrecognized Keyword Arguments. +

    +

    If keyword argument checking is suppressed, +then it is permitted for an argument pair +to match no parameter specifier, and the argument pair is ignored, but +such an argument pair is accessible through the rest parameter if +one was supplied. The purpose of these mechanisms is to allow sharing +of argument lists among several lambda expressions and to +allow either the caller or the called lambda expression to +specify that such sharing may be taking place. +

    +

    Note that if &key is present, a keyword argument of :allow-other-keys +is always permitted—regardless of whether the associated value is true +or false. However, if the value is false, other non-matching +keywords are not tolerated (unless &allow-other-keys was used). +

    +

    Furthermore, if the receiving argument list specifies a regular argument which +would be flagged by :allow-other-keys, then :allow-other-keys has both +its special-cased meaning (identifying whether additional keywords are permitted) +and its normal meaning (data flow into the function in question). +

    +
    +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    + + + + + diff --git a/info/gcl/Specifiers-for-optional-parameters.html b/info/gcl/Specifiers-for-optional-parameters.html new file mode 100644 index 0000000..8a3ad8d --- /dev/null +++ b/info/gcl/Specifiers-for-optional-parameters.html @@ -0,0 +1,73 @@ + + + + + +Specifiers for optional parameters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.2 Specifiers for optional parameters

    + + + +

    If &optional is present, +the optional parameter specifiers are those following +&optional +up to the next lambda list keyword or the end of the list. +If optional parameters are specified, then each one is processed as +follows. If any unprocessed arguments remain, then the parameter variable +var is bound to the next remaining argument, just as for a required +parameter. If no arguments remain, however, then init-form +is evaluated, and the parameter variable +is bound to the resulting value +(or to nil if no init-form appears +in the parameter specifier). +If another variable name supplied-p-parameter +appears in the specifier, it is bound +to true if an argument had been available, and to false if no +argument remained (and therefore init-form had to be evaluated). +Supplied-p-parameter +is bound not to an argument but to a value indicating whether or not +an argument had been supplied for the corresponding var. +

    + + + + + diff --git a/info/gcl/Specifiers-for-the-required-parameters.html b/info/gcl/Specifiers-for-the-required-parameters.html new file mode 100644 index 0000000..70c4186 --- /dev/null +++ b/info/gcl/Specifiers-for-the-required-parameters.html @@ -0,0 +1,64 @@ + + + + + +Specifiers for the required parameters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.1 Specifiers for the required parameters

    + +

    These are all the parameter specifiers up to +the first lambda list keyword; +if there are no lambda list keywords, +then all the specifiers are for required parameters. +Each required parameter is specified by a parameter variable var. +var is bound as a lexical variable unless it is declared special. +

    +

    If there are n required parameters (n may be zero), +there must be at least n passed arguments, and the +required parameters are bound to the first n passed arguments; +see Error Checking in Function Calls. +The other parameters are then processed using any remaining arguments. +

    + + + + + diff --git a/info/gcl/Splicing-in-Modified-BNF-Syntax.html b/info/gcl/Splicing-in-Modified-BNF-Syntax.html new file mode 100644 index 0000000..fc98c02 --- /dev/null +++ b/info/gcl/Splicing-in-Modified-BNF-Syntax.html @@ -0,0 +1,156 @@ + + + + + +Splicing in Modified BNF Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.3 Splicing in Modified BNF Syntax

    + +

    The primary extension used is the following: +

    +
    [[O]] +
    +

    An expression of this form appears whenever a list of elements is +to be spliced into a larger structure and the elements can appear in +any order. The symbol O represents a description of the syntax of +some number of syntactic elements to be spliced; that description must +be of the form +

    +
    O_1 | ... | O_l +
    +

    where each O_i can be of the form S or of +the form S* or of the form S^1. +

    +

    The expression [[O]] means that a list of the form +

    +
    (O_{i_1}... O_{i_j}) 1<= j +
    +

    is spliced into the enclosing expression, +such that if n != m and 1<= n,m<= j, +then either O_{i_n}!= O_{i_m} + or O_{i_n} = O_{i_m} = Q_k, +where for some 1<= k <= n, O_k is of the form Q_k*. +

    +

    Furthermore, for each O_{i_n} that is of the form Q_k^1, +that element is required to appear somewhere in the list to be spliced. +

    +

    For example, the expression +

    +

    (x [[A | B* | C]] y) +

    +

    means that at most one A, any number of B’s, and +at most one C can occur in any order. +It is a description of any of these: +

    +
    +
     (x y)
+ (x B A C y)
+ (x A B B B B B C y)
+ (x C B A B B B y)
+
    + +

    but not any of these: +

    +
    +
     (x B B A A C C y)
+ (x C B C y)
+
    + +

    In the first case, both A and C appear too often, +and in the second case C appears too often. +

    +

    The notation [[O_1 | O_2 | ...]]^+ +adds the additional restriction that at least one item from among the possible +choices must be used. For example: +

    +

    (x [[A | B* | C]]^+ y) +

    +

    means that at most one A, any number of B’s, and +at most one C can occur in any order, but that in any case at least +one of these options must be selected. +It is a description of any of these: +

    +
    +
     (x B y)
+ (x B A C y)
+ (x A B B B B B C y)
+ (x C B A B B B y)
+
    + +

    but not any of these: +

    +
    +
     (x y)
+ (x B B A A C C y)
+ (x C B C y)
+
    + +

    In the first case, no item was used; +in the second case, both A and C appear too often; +and in the third case C appears too often. +

    +

    Also, the expression: +

    +

    (x [[A^1 | B^1 | C]] y) +

    +

    can generate exactly these and no others: +

    +
    +
     (x A B C y)
+ (x A C B y)
+ (x A B y)
+ (x B A C y)
+ (x B C A y)
+ (x B A y)
+ (x C A B y)
+ (x C B A y)
+
    + +
    +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    + + + + + diff --git a/info/gcl/Standard-Characters.html b/info/gcl/Standard-Characters.html new file mode 100644 index 0000000..5e2180a --- /dev/null +++ b/info/gcl/Standard-Characters.html @@ -0,0 +1,158 @@ + + + + + +Standard Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax  

    +
    +
    +

    2.1.3 Standard Characters

    + +

    All implementations must support a character repertoire +called standard-char; characters that are members of that +repertoire are called standard characters + +. +

    +

    The standard-char repertoire consists of +the non-graphic character newline, +the graphic character space, +and the following additional +ninety-four graphic characters or their equivalents: +

    +
    +
      Graphic ID  Glyph  Description  Graphic ID  Glyph  Description  
+  LA01        a      small a      LN01        n      small n      
+  LA02        A      capital A    LN02        N      capital N    
+  LB01        b      small b      LO01        o      small o      
+  LB02        B      capital B    LO02        O      capital O    
+  LC01        c      small c      LP01        p      small p      
+  LC02        C      capital C    LP02        P      capital P    
+  LD01        d      small d      LQ01        q      small q      
+  LD02        D      capital D    LQ02        Q      capital Q    
+  LE01        e      small e      LR01        r      small r      
+  LE02        E      capital E    LR02        R      capital R    
+  LF01        f      small f      LS01        s      small s      
+  LF02        F      capital F    LS02        S      capital S    
+  LG01        g      small g      LT01        t      small t      
+  LG02        G      capital G    LT02        T      capital T    
+  LH01        h      small h      LU01        u      small u      
+  LH02        H      capital H    LU02        U      capital U    
+  LI01        i      small i      LV01        v      small v      
+  LI02        I      capital I    LV02        V      capital V    
+  LJ01        j      small j      LW01        w      small w      
+  LJ02        J      capital J    LW02        W      capital W    
+  LK01        k      small k      LX01        x      small x      
+  LK02        K      capital K    LX02        X      capital X    
+  LL01        l      small l      LY01        y      small y      
+  LL02        L      capital L    LY02        Y      capital Y    
+  LM01        m      small m      LZ01        z      small z      
+  LM02        M      capital M    LZ02        Z      capital Z    
+
+  Figure 2–3: Standard Character Subrepertoire (Part 1 of 3: Latin Characters)
+
+
    + +
    +
      Graphic ID  Glyph  Description  Graphic ID  Glyph  Description  
+  ND01        1      digit 1      ND06        6      digit 6      
+  ND02        2      digit 2      ND07        7      digit 7      
+  ND03        3      digit 3      ND08        8      digit 8      
+  ND04        4      digit 4      ND09        9      digit 9      
+  ND05        5      digit 5      ND10        0      digit 0      
+
+  Figure 2–4: Standard Character Subrepertoire (Part 2 of 3: Numeric Characters)
+
+
    + +
    +
      Graphic ID  Glyph  Description                              
+  SP02        !      exclamation mark                         
+  SC03        $     dollar sign                              
+  SP04        "      quotation mark, or double quote          
+  SP05        '      apostrophe, or [single] quote            
+  SP06        (      left parenthesis, or open parenthesis    
+  SP07        )      right parenthesis, or close parenthesis  
+  SP08        ,      comma                                    
+  SP09        _      low line, or underscore                  
+  SP10        -      hyphen, or minus [sign]                  
+  SP11        .      full stop, period, or dot                
+  SP12        /      solidus, or slash                        
+  SP13        :      colon                                    
+  SP14        ;      semicolon                                
+  SP15        ?      question mark                            
+  SA01        +      plus [sign]                              
+  SA03        <      less-than [sign]                         
+  SA04        =      equals [sign]                            
+  SA05        >      greater-than [sign]                      
+  SM01        #      number sign, or sharp[sign]              
+  SM02        %      percent [sign]                           
+  SM03        &      ampersand                                
+  SM04        *      asterisk, or star                        
+  SM05        @      commercial at, or at-sign                
+  SM06        [      left [square] bracket                    
+  SM07        \      reverse solidus, or backslash            
+  SM08        ]      right [square] bracket                   
+  SM11        {      left curly bracket, or left brace        
+  SM13        |      vertical bar                             
+  SM14        }      right curly bracket, or right brace      
+  SD13        `      grave accent, or backquote               
+  SD15        ^      circumflex accent                        
+  SD19        ~      tilde                                    
+
+  Figure 2–5: Standard Character Subrepertoire (Part 3 of 3: Special Characters)
+
+
    + +

    The graphic IDs are not used within Common Lisp, +but are provided for cross reference purposes with ISO 6937/2. +Note that the first letter of the graphic ID +categorizes the character as follows: +L—Latin, N—Numeric, S—Special. +

    +
    +
    +

    +Next: , Previous: , Up: Character Syntax  

    +
    + + + + + diff --git a/info/gcl/Standard-Macro-Characters.html b/info/gcl/Standard-Macro-Characters.html new file mode 100644 index 0000000..23ebc0e --- /dev/null +++ b/info/gcl/Standard-Macro-Characters.html @@ -0,0 +1,85 @@ + + + + + +Standard Macro Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Syntax  

    +
    +
    +

    2.4 Standard Macro Characters

    + + +

    If the reader encounters a macro character, +then its associated reader macro function +is invoked and may produce an object to be returned. +This function may read the characters +following the macro character in the stream +in any syntax and return the object represented by that syntax. +

    +

    Any character can be made to be a macro character. +The macro characters defined initially in a conforming implementation +include +the following: +

    + + + + + + + + + + +
    • Left-Parenthesis   +
    • Right-Parenthesis   +
    • Single-Quote   +
    • Semicolon   +
    • Double-Quote   +
    • Backquote   +
    • Comma   +
    • Sharpsign   +
    • Re-Reading Abbreviated Expressions   +
    + + + + + + diff --git a/info/gcl/Standard-Meta_002dobjects.html b/info/gcl/Standard-Meta_002dobjects.html new file mode 100644 index 0000000..c30c047 --- /dev/null +++ b/info/gcl/Standard-Meta_002dobjects.html @@ -0,0 +1,93 @@ + + + + + +Standard Meta-objects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Meta-Objects  

    +
    +
    +

    7.4.1 Standard Meta-objects

    + +

    The object system supplies a set of meta-objects, called standard meta-objects. +These include the class standard-object and +instances of the classes standard-method, +standard-generic-function, and method-combination. +

    +
    +
    +

    [Editorial Note by KMP: This is said redundantly in the definition of STANDARD-METHOD.] +

    +
    *
    +

    The class standard-method is the default class of +methods defined by the + defmethod and + defgeneric forms. +

    +
    +
    *
    +

    The class standard-generic-function is the default class of +generic functions defined by the forms + defmethod, + defgeneric, +

    +

    and + defclass. +

    +
    +
    *
    +

    The class named standard-object +is an instance of the class standard-class +and is a superclass of every class that is an +instance of standard-class except itself and +structure-class. +

    +
    +
    *
    +

    Every method combination object is +an instance of a subclass of class method-combination. +

    +
    +
    + + + + + + + diff --git a/info/gcl/Standard-Metaclasses.html b/info/gcl/Standard-Metaclasses.html new file mode 100644 index 0000000..9b7dead --- /dev/null +++ b/info/gcl/Standard-Metaclasses.html @@ -0,0 +1,78 @@ + + + + + +Standard Metaclasses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Introduction to Classes  

    +
    +
    +

    4.3.1.1 Standard Metaclasses

    + +

    The object system provides a number of predefined metaclasses. +These include the classes standard-class, +built-in-class, and structure-class: +

    +
    +
    *
    +

    The class standard-class is the default class of +classes defined by defclass. +

    +
    +
    *
    +

    The class built-in-class is the class whose +instances are classes that have special implementations with +restricted capabilities. Any class that corresponds to a standard +type might be an instance of built-in-class. +The predefined type specifiers that are required to have +corresponding classes are listed in Figure~4–8. +It is implementation-dependent whether each of these classes +is implemented as a built-in class. +

    +
    +
    *
    +

    All classes defined by means of defstruct are +instances of the class structure-class. +

    +
    + + + + + + diff --git a/info/gcl/Standard-Method-Combination.html b/info/gcl/Standard-Method-Combination.html new file mode 100644 index 0000000..259e5ca --- /dev/null +++ b/info/gcl/Standard-Method-Combination.html @@ -0,0 +1,185 @@ + + + + + +Standard Method Combination (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    +
    +

    7.6.6.5 Standard Method Combination

    + + + +

    Standard method combination is supported by the class standard-generic-function. +It is used if no other type of method +combination is specified or if the built-in method combination type +standard is specified. +

    +

    Primary methods define the main action of the effective method, +while auxiliary methods modify that action in one of three ways. +A primary method has no method qualifiers. +

    +

    An auxiliary method is a method whose +qualifier is :before, :after, or :around. +Standard method combination +allows no more than one qualifier per method; if a method definition +specifies more than one qualifier per method, an error is signaled. +

    +
    +
    *
    +

    A before method has the keyword :before as its only qualifier. +A before method specifies code that is to be run before any +primary methods. +

    +
    +
    *
    +

    An after method has the keyword :after as its only qualifier. +An after method specifies code that is to be run after +primary methods. +

    +
    +
    *
    +

    An around method has the keyword :around as its only qualifier. +An around method specifies code that is to be run instead of other +applicable methods, +but which might contain explicit code +which calls some of those shadowed methods +(via call-next-method). +

    +
    +
    + +

    The semantics of standard method combination is as follows: +

    +
    +
    *
    +

    If there are any around methods, the most specific +around method is called. It supplies the value or values of the +generic function. +

    +
    +
    *
    +

    Inside the body of an around method, +call-next-method can be used to call the next method. When the next +method returns, the around method can execute more code, +perhaps based on the returned value or values. +The generic function no-next-method is invoked if call-next-method is used and +there is no applicable method to call. The function next-method-p +may be used to determine whether a next method exists. +

    +
    +
    *
    +

    If an around method invokes call-next-method, +the next most specific around method +is called, if one is applicable. If there are no around methods +or if call-next-method is called by the least +specific around method, the other methods are called as +follows: +

    +
    –
    +

    All the before methods are called, in +most-specific-first order. Their values are ignored. +An error is signaled if call-next-method is used in a +before method. +

    +
    +
    –
    +

    The most specific primary method is called. Inside the +body of a primary method, call-next-method may be used to call +the next most specific primary method. When that method returns, the +previous primary method can execute more code, perhaps based on the +returned value or values. The generic function no-next-method +is invoked if call-next-method is used and there are no more +applicable primary methods. The function next-method-p may be +used to determine whether a next method exists. If call-next-method +is not used, only the most specific primary method is called. +

    +
    +
    –
    +

    All the after methods are called in +most-specific-last order. Their values are ignored. +An error is signaled if call-next-method is used in an +after method. +

    +
    + +
    +
    *
    +

    If no around methods were invoked, the most +specific primary method supplies the value or values returned by the +generic function. The value or values returned by the invocation of +call-next-method in the least specific around method are +those returned by the most specific primary method. +

    +
    +
    + +

    In standard method combination, if there is an applicable method +but no applicable primary method, an error is signaled. +

    +

    The before methods are run in most-specific-first order while +the after methods are run in least-specific-first order. The +design rationale for this difference can be illustrated with an +example. Suppose class C_1 modifies the behavior of its +superclass, C_2, by adding before methods and after methods. +Whether the behavior of the class C_2 is defined +directly by methods on C_2 or is inherited from its superclasses +does not affect the relative order of invocation of methods on +instances of the class C_1. Class C_1’s +before method runs before all of class C_2’s methods. +Class C_1’s after method runs after all of class C_2’s methods. +

    +

    By contrast, all around methods run before any other methods +run. Thus a less specific around method runs before a more +specific primary method. +

    +

    If only primary methods are used and if call-next-method is not +used, only the most specific method is invoked; that is, more specific +methods shadow more general ones. +

    +
    +
    +

    +Next: , Previous: , Up: Method Selection and Combination  

    +
    + + + + + diff --git a/info/gcl/Standardized-Packages.html b/info/gcl/Standardized-Packages.html new file mode 100644 index 0000000..ecb8aff --- /dev/null +++ b/info/gcl/Standardized-Packages.html @@ -0,0 +1,87 @@ + + + + + +Standardized Packages (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Package Concepts  

    +
    +
    +

    11.1.2 Standardized Packages

    + +

    This section describes the packages that are available +in every conforming implementation. A summary of the +names and nicknames of those standardized packages +is given in Figure 11–2. +

    +
    +
      Name              Nicknames  
+  COMMON-LISP       CL         
+  COMMON-LISP-USER  CL-USER    
+  KEYWORD           none       
+
+  Figure 11–2: Standardized Package Names
+
+
    + + + + + + + + + + + +
    • The COMMON-LISP Package   +
    • Constraints on the COMMON-LISP Package for Conforming Implementations   +
    • Constraints on the COMMON-LISP Package for Conforming Programs   +
    • Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs   +
    • The COMMON-LISP-USER Package   +
    • The KEYWORD Package   +
    • Interning a Symbol in the KEYWORD Package   +
    • Notes about The KEYWORD Package   +
    • Implementation-Defined Packages   +
    + + + + + + diff --git a/info/gcl/Storage-Layout-for-Multidimensional-Arrays.html b/info/gcl/Storage-Layout-for-Multidimensional-Arrays.html new file mode 100644 index 0000000..01a4411 --- /dev/null +++ b/info/gcl/Storage-Layout-for-Multidimensional-Arrays.html @@ -0,0 +1,56 @@ + + + + + +Storage Layout for Multidimensional Arrays (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.8 Storage Layout for Multidimensional Arrays

    + +

    Multidimensional arrays store their components in row-major order; +that is, internally a multidimensional array is stored as a +one-dimensional array, with the multidimensional index sets +ordered lexicographically, last index varying fastest. +

    + + + + + diff --git a/info/gcl/Stream-Arguments-to-Standardized-Functions.html b/info/gcl/Stream-Arguments-to-Standardized-Functions.html new file mode 100644 index 0000000..edb77ef --- /dev/null +++ b/info/gcl/Stream-Arguments-to-Standardized-Functions.html @@ -0,0 +1,100 @@ + + + + + +Stream Arguments to Standardized Functions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Stream Concepts  

    +
    +
    +

    21.1.3 Stream Arguments to Standardized Functions

    + +

    The operators in Figure 21–7 accept stream arguments that +might be either open or closed streams. +

    +
    +
      broadcast-stream-streams     file-author       pathnamep                     
+  close                        file-namestring   probe-file                    
+  compile-file                 file-write-date   rename-file                   
+  compile-file-pathname        host-namestring   streamp                       
+  concatenated-stream-streams  load              synonym-stream-symbol         
+  delete-file                  logical-pathname  translate-logical-pathname    
+  directory                    merge-pathnames   translate-pathname            
+  directory-namestring         namestring        truename                      
+  dribble                      open              two-way-stream-input-stream   
+  echo-stream-input-stream     open-stream-p     two-way-stream-output-stream  
+  echo-stream-ouput-stream     parse-namestring  wild-pathname-p               
+  ed                           pathname          with-open-file                
+  enough-namestring            pathname-match-p                                
+
+        Figure 21–7: Operators that accept either Open or Closed Streams      
+
+
    + +

    The operators in Figure 21–8 accept stream arguments that +must be open streams. +

    +
    +
     clear-input              output-stream-p         read-char-no-hang          
+ clear-output             peek-char               read-delimited-list        
+ file-length              pprint                  read-line                  
+ file-position            pprint-fill             read-preserving-whitespace 
+ file-string-length       pprint-indent           stream-element-type        
+ finish-output            pprint-linear           stream-external-format     
+ force-output             pprint-logical-block    terpri                     
+ format                   pprint-newline          unread-char                
+ fresh-line               pprint-tab              with-open-stream           
+ get-output-stream-string pprint-tabular          write                      
+ input-stream-p           prin1                   write-byte                 
+ interactive-stream-p     princ                   write-char                 
+ listen                   print                   write-line                 
+ make-broadcast-stream    print-object            write-string               
+ make-concatenated-stream print-unreadable-object y-or-n-p                   
+ make-echo-stream         read                    yes-or-no-p                
+ make-synonym-stream      read-byte                                          
+ make-two-way-stream      read-char                                          
+
+             Figure 21–8: Operators that accept Open Streams only            
+
+
    + + + + + + diff --git a/info/gcl/Stream-Concepts.html b/info/gcl/Stream-Concepts.html new file mode 100644 index 0000000..2d6bc56 --- /dev/null +++ b/info/gcl/Stream-Concepts.html @@ -0,0 +1,63 @@ + + + + + +Stream Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams  

    +
    +
    +

    21.1 Stream Concepts

    + + + + + + + +
    • Introduction to Streams   +
    • Stream Variables   +
    • Stream Arguments to Standardized Functions   +
    • Restrictions on Composite Streams   +
    + + + + + + diff --git a/info/gcl/Stream-Variables.html b/info/gcl/Stream-Variables.html new file mode 100644 index 0000000..e957356 --- /dev/null +++ b/info/gcl/Stream-Variables.html @@ -0,0 +1,86 @@ + + + + + +Stream Variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Stream Concepts  

    +
    +
    +

    21.1.2 Stream Variables

    + +

    Variables whose values must be streams are sometimes called +stream variables + +. +

    +

    Certain stream variables are defined by this specification +to be the proper source of input or output in various situations +where no specific stream has been specified instead. +A complete list of such standardized stream variables +appears in Figure 21–6. +The consequences are undefined if at any time +the value of any of these variables is not an open stream. +

    +
    +
      Glossary Term    Variable Name      
+  debug I/O        *debug-io*         
+  error output     *error-output*     
+  query I/O        *query-io*         
+  standard input   *standard-input*   
+  standard output  *standard-output*  
+  terminal I/O     *terminal-io*      
+  trace output     *trace-output*     
+
+  Figure 21–6: Standardized Stream Variables
+
+
    + +

    Note that, by convention, standardized stream variables have names + ending in “-input*” if they must be input streams, + ending in “-output*” if they must be output streams, + or ending in “-io*” if they must be bidirectional streams. +

    +

    User programs may assign or bind any standardized stream variable +except *terminal-io*. +

    + + + + + diff --git a/info/gcl/Streams-Dictionary.html b/info/gcl/Streams-Dictionary.html new file mode 100644 index 0000000..27e72f9 --- /dev/null +++ b/info/gcl/Streams-Dictionary.html @@ -0,0 +1,174 @@ + + + + + +Streams Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Streams  

    +
    +
    +

    21.2 Streams Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • stream   +
    • broadcast-stream   +
    • concatenated-stream   +
    • echo-stream   +
    • file-stream   +
    • string-stream   +
    • synonym-stream   +
    • two-way-stream   +
    • input-stream-p   +
    • interactive-stream-p   +
    • open-stream-p   +
    • stream-element-type   +
    • streamp   +
    • read-byte   +
    • write-byte   +
    • peek-char   +
    • read-char   +
    • read-char-no-hang   +
    • terpri   +
    • unread-char   +
    • write-char   +
    • read-line   +
    • write-string   +
    • read-sequence   +
    • write-sequence   +
    • file-length   +
    • file-position   +
    • file-string-length   +
    • open   +
    • stream-external-format   +
    • with-open-file   +
    • close   +
    • with-open-stream   +
    • listen   +
    • clear-input   +
    • finish-output   +
    • y-or-n-p   +
    • make-synonym-stream   +
    • synonym-stream-symbol   +
    • broadcast-stream-streams   +
    • make-broadcast-stream   +
    • make-two-way-stream   +
    • two-way-stream-input-stream   +
    • echo-stream-input-stream   +
    • make-echo-stream   +
    • concatenated-stream-streams   +
    • make-concatenated-stream   +
    • get-output-stream-string   +
    • make-string-input-stream   +
    • make-string-output-stream   +
    • with-input-from-string   +
    • with-output-to-string   +
    • *debug-io*   +
    • *terminal-io*   +
    • stream-error   +
    • stream-error-stream   +
    • end-of-file   +
    + +
    +
    +

    +Previous: , Up: Streams  

    +
    + + + + + diff --git a/info/gcl/Streams.html b/info/gcl/Streams.html new file mode 100644 index 0000000..4740aff --- /dev/null +++ b/info/gcl/Streams.html @@ -0,0 +1,58 @@ + + + + + +Streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    21 Streams

    + + + + +
    • Stream Concepts   +
    • Streams Dictionary   +
    + + + + + + diff --git a/info/gcl/String-Concepts.html b/info/gcl/String-Concepts.html new file mode 100644 index 0000000..68c22cf --- /dev/null +++ b/info/gcl/String-Concepts.html @@ -0,0 +1,59 @@ + + + + + +String Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings  

    +
    +
    +

    16.1 String Concepts

    + + + + + +
    • Implications of Strings Being Arrays   +
    • Subtypes of STRING   +
    + + + + + + diff --git a/info/gcl/Strings-Dictionary.html b/info/gcl/Strings-Dictionary.html new file mode 100644 index 0000000..219bd7b --- /dev/null +++ b/info/gcl/Strings-Dictionary.html @@ -0,0 +1,79 @@ + + + + + +Strings Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Strings  

    +
    +
    +

    16.2 Strings Dictionary

    + + + + + + + + + + + + + + + +
    • string (System Class)   +
    • base-string   +
    • simple-string   +
    • simple-base-string   +
    • simple-string-p   +
    • char   +
    • string   +
    • string-upcase   +
    • string-trim   +
    • string=   +
    • stringp   +
    • make-string   +
    + + + + + + diff --git a/info/gcl/Strings-in-Component-Values.html b/info/gcl/Strings-in-Component-Values.html new file mode 100644 index 0000000..b8701ef --- /dev/null +++ b/info/gcl/Strings-in-Component-Values.html @@ -0,0 +1,51 @@ + + + + + +Strings in Component Values (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.1 Strings in Component Values

    + + + + + + diff --git a/info/gcl/Strings.html b/info/gcl/Strings.html new file mode 100644 index 0000000..a88563f --- /dev/null +++ b/info/gcl/Strings.html @@ -0,0 +1,58 @@ + + + + + +Strings (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    16 Strings

    + + + + +
    • String Concepts   +
    • Strings Dictionary   +
    + + + + + + diff --git a/info/gcl/Structures-Dictionary.html b/info/gcl/Structures-Dictionary.html new file mode 100644 index 0000000..c31224b --- /dev/null +++ b/info/gcl/Structures-Dictionary.html @@ -0,0 +1,59 @@ + + + + + +Structures Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Structures  

    +
    +
    +

    8.1 Structures Dictionary

    + + + + + +
    • defstruct   +
    • copy-structure   +
    + + + + + + diff --git a/info/gcl/Structures.html b/info/gcl/Structures.html new file mode 100644 index 0000000..5d3515b --- /dev/null +++ b/info/gcl/Structures.html @@ -0,0 +1,56 @@ + + + + + +Structures (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    8 Structures

    + + + +
    • Structures Dictionary   +
    + + + + + + diff --git a/info/gcl/Subtypes-of-STRING.html b/info/gcl/Subtypes-of-STRING.html new file mode 100644 index 0000000..c7c1834 --- /dev/null +++ b/info/gcl/Subtypes-of-STRING.html @@ -0,0 +1,59 @@ + + + + + +Subtypes of STRING (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: String Concepts  

    +
    +
    +

    16.1.2 Subtypes of STRING

    + +

    All functions that operate on strings +will operate on subtypes of string as well. +

    +

    However, +the consequences are undefined if a character is inserted into a string +for which the element type of the string does not include that character. +

    + + + + + + diff --git a/info/gcl/Summary-of-Conditional-Execution-Clauses.html b/info/gcl/Summary-of-Conditional-Execution-Clauses.html new file mode 100644 index 0000000..21b53be --- /dev/null +++ b/info/gcl/Summary-of-Conditional-Execution-Clauses.html @@ -0,0 +1,71 @@ + + + + + +Summary of Conditional Execution Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.12 Summary of Conditional Execution Clauses

    + +

    The if and when constructs take one form as a test +and a clause that is executed when the test yields true. +The clause can be a value accumulation, unconditional, or +another conditional clause; it can also be any combination +of such clauses connected by the loop and keyword. +

    +

    The loop unless construct is similar to the loop when construct +except that it complements the test result. +

    +

    The loop else construct provides an optional component of if, +when, and unless clauses that is executed + when an if or when test yields false + or when an unless test yields true. +The component is one of the clauses described under if. +

    +

    The loop end construct provides an optional component to mark the +end of a conditional clause. +

    +

    For more information, see Conditional Execution Clauses. +

    + + + + + diff --git a/info/gcl/Summary-of-Loop-Clauses.html b/info/gcl/Summary-of-Loop-Clauses.html new file mode 100644 index 0000000..057a580 --- /dev/null +++ b/info/gcl/Summary-of-Loop-Clauses.html @@ -0,0 +1,53 @@ + + + + + +Summary of Loop Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.7 Summary of Loop Clauses

    + +

    Loop clauses fall into one of the following categories: +

    + + + + + diff --git a/info/gcl/Summary-of-Miscellaneous-Clauses.html b/info/gcl/Summary-of-Miscellaneous-Clauses.html new file mode 100644 index 0000000..b43f1e8 --- /dev/null +++ b/info/gcl/Summary-of-Miscellaneous-Clauses.html @@ -0,0 +1,63 @@ + + + + + +Summary of Miscellaneous Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.13 Summary of Miscellaneous Clauses

    + +

    The loop named construct gives a name for the block of the loop. +

    +

    The loop initially construct causes its forms to be +evaluated in the loop prologue, which precedes all loop code +except for initial settings supplied by the constructs with, +for, or as. +

    +

    The loop finally construct causes its forms to +be evaluated in the loop epilogue after normal iteration terminates. +

    +

    For more information, see Miscellaneous Clauses. +

    + + + + + diff --git a/info/gcl/Summary-of-Termination-Test-Clauses.html b/info/gcl/Summary-of-Termination-Test-Clauses.html new file mode 100644 index 0000000..759ca96 --- /dev/null +++ b/info/gcl/Summary-of-Termination-Test-Clauses.html @@ -0,0 +1,91 @@ + + + + + +Summary of Termination Test Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.10 Summary of Termination Test Clauses

    + +

    The for and as constructs provide a termination test +that is determined by the iteration control clause. +

    +

    The repeat construct causes termination after a specified +number of iterations. +(It uses an internal variable to keep track of the number of iterations.) +

    +

    The while construct takes one form, a test, +and terminates the iteration if the test evaluates to false. +A while clause is equivalent to the expression +(if (not test) (loop-finish)). +

    +

    The until construct is the inverse of while; +it terminates the iteration if the test evaluates to +any non-nil value. +An until clause is equivalent to the expression +(if test (loop-finish)). +

    +

    The always construct takes one form and +terminates the loop if the form ever evaluates to false; +in this case, the loop form returns nil. +Otherwise, it provides a default return value of t. +

    +

    The never construct takes one form and +terminates the loop if the form ever evaluates to true; +in this case, the loop form returns nil. +Otherwise, it provides a default return value of t. +

    +

    The thereis construct takes one form and +terminates the loop if the form ever evaluates to +a non-nil object; +in this case, the loop form returns that object. +

    +

    Otherwise, it provides a default return value of nil. +

    +

    If multiple termination test clauses are specified, +the loop form terminates if any are satisfied. +

    +

    For more information, see Termination Test Clauses. +

    + + + + + diff --git a/info/gcl/Summary-of-Unconditional-Execution-Clauses.html b/info/gcl/Summary-of-Unconditional-Execution-Clauses.html new file mode 100644 index 0000000..732ede0 --- /dev/null +++ b/info/gcl/Summary-of-Unconditional-Execution-Clauses.html @@ -0,0 +1,64 @@ + + + + + +Summary of Unconditional Execution Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.11 Summary of Unconditional Execution Clauses

    + +

    The do (or doing) construct evaluates all forms in its clause. +

    +

    The return construct takes one +

    +

    form. Any values returned by the form are + immediately returned by the loop form. + It is equivalent to the clause + do (return-from block-name value), + where block-name is the name specified in a named + clause, or nil if there is no named clause. +

    +

    For more information, see Unconditional Execution Clauses. +

    + + + + + diff --git a/info/gcl/Summary-of-Value-Accumulation-Clauses.html b/info/gcl/Summary-of-Value-Accumulation-Clauses.html new file mode 100644 index 0000000..b6ac894 --- /dev/null +++ b/info/gcl/Summary-of-Value-Accumulation-Clauses.html @@ -0,0 +1,97 @@ + + + + + +Summary of Value Accumulation Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.9 Summary of Value Accumulation Clauses

    + +

    The collect (or collecting) construct +takes one form in its clause +and adds the value of that form to the end of a list +of values. By default, the list of values is returned +when the loop finishes. +

    +

    The append (or appending) construct +takes one form in its clause +and appends the value of that form to the end of a list +of values. By default, the list of values is returned when the +loop finishes. +

    +

    The nconc (or nconcing) construct +is similar to the append construct, +but its list values are concatenated as if by the function +nconc. By default, the list of values is returned when +the loop finishes. +

    +

    The sum (or summing) construct +takes one form in its clause +that must evaluate to a number and accumulates the sum of all these +numbers. By default, the cumulative sum is returned when the +loop finishes. +

    +

    The count (or counting) construct +takes one form in its clause +and counts the number of times that the form evaluates to true. +By default, the count is returned when the loop finishes. +

    +

    The minimize (or minimizing) construct +takes one form in its clause +and determines the minimum value obtained by evaluating that form. +By default, the minimum value is returned when the loop finishes. +

    +

    The maximize (or maximizing) construct +takes one form in its clause +and determines the maximum value obtained by evaluating that form. +By default, the maximum value is returned when the loop finishes. +

    +

    For more information, see Value Accumulation Clauses. +

    +
    +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    + + + + + diff --git a/info/gcl/Summary-of-Variable-Initialization-and-Stepping-Clauses.html b/info/gcl/Summary-of-Variable-Initialization-and-Stepping-Clauses.html new file mode 100644 index 0000000..6de611d --- /dev/null +++ b/info/gcl/Summary-of-Variable-Initialization-and-Stepping-Clauses.html @@ -0,0 +1,63 @@ + + + + + +Summary of Variable Initialization and Stepping Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Overview of the Loop Facility  

    +
    +
    +

    6.1.1.8 Summary of Variable Initialization and Stepping Clauses

    + +

    The for and as constructs provide iteration control clauses +that establish a variable to be initialized. +for and as clauses can be combined with the loop +keyword and to get parallel initialization and stepping_1. +Otherwise, the initialization and stepping_1 are sequential. +

    +

    The with construct is similar to a single let clause. +with clauses can be combined using the loop keyword and +to get parallel initialization. +

    +

    For more information, see Variable Initialization and Stepping Clauses. +

    + + + + + diff --git a/info/gcl/Suppressing-Keyword-Argument-Checking.html b/info/gcl/Suppressing-Keyword-Argument-Checking.html new file mode 100644 index 0000000..7ec3147 --- /dev/null +++ b/info/gcl/Suppressing-Keyword-Argument-Checking.html @@ -0,0 +1,63 @@ + + + + + +Suppressing Keyword Argument Checking (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Ordinary Lambda Lists  

    +
    +
    +

    3.4.1.5 Suppressing Keyword Argument Checking

    + +

    If &allow-other-keys was specified in the lambda list of a function, +keyword_2 argument checking is suppressed in calls +to that function. +

    +

    If the :allow-other-keys argument is true in a call to a function, +keyword_2 argument checking is suppressed +in that call. +

    +

    The :allow-other-keys argument is permissible in all situations involving +keyword_2 arguments, even when its associated value +is false. +

    + + + + + diff --git a/info/gcl/Symbol-Concepts.html b/info/gcl/Symbol-Concepts.html new file mode 100644 index 0000000..9a3004b --- /dev/null +++ b/info/gcl/Symbol-Concepts.html @@ -0,0 +1,75 @@ + + + + + +Symbol Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols  

    +
    +
    +

    10.1 Symbol Concepts

    + + +

    Figure 10–1 lists some +defined names that are applicable to the property lists of symbols. +

    +
    +
      get  remprop  symbol-plist  
+
+  Figure 10–1: Property list defined names
+
+
    + +

    Figure 10–2 lists some defined names that are applicable +to the creation of and inquiry about symbols. +

    +
    +
      copy-symbol  keywordp     symbol-package  
+  gensym       make-symbol  symbol-value    
+  gentemp      symbol-name                  
+
+  Figure 10–2: Symbol creation and inquiry defined names
+
+
    + + + + + + + diff --git a/info/gcl/Symbol-Macros-as-Places.html b/info/gcl/Symbol-Macros-as-Places.html new file mode 100644 index 0000000..7467525 --- /dev/null +++ b/info/gcl/Symbol-Macros-as-Places.html @@ -0,0 +1,55 @@ + + + + + +Symbol Macros as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.8 Symbol Macros as Places

    + +

    A reference to a symbol that has been established as a symbol macro +can be used as a place. In this case, +setf expands the reference and then analyzes the resulting form. +

    + + + + + diff --git a/info/gcl/Symbols-Dictionary.html b/info/gcl/Symbols-Dictionary.html new file mode 100644 index 0000000..55b47e6 --- /dev/null +++ b/info/gcl/Symbols-Dictionary.html @@ -0,0 +1,95 @@ + + + + + +Symbols Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Symbols  

    +
    +
    +

    10.2 Symbols Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + +
    • symbol   +
    • keyword   +
    • symbolp   +
    • keywordp   +
    • make-symbol   +
    • copy-symbol   +
    • gensym   +
    • *gensym-counter*   +
    • gentemp   +
    • symbol-function   +
    • symbol-name   +
    • symbol-package   +
    • symbol-plist   +
    • symbol-value   +
    • get   +
    • remprop   +
    • boundp   +
    • makunbound   +
    • set   +
    • unbound-variable   +
    + + + + + + diff --git a/info/gcl/Symbols-Naming-Both-Lexical-and-Dynamic-Variables.html b/info/gcl/Symbols-Naming-Both-Lexical-and-Dynamic-Variables.html new file mode 100644 index 0000000..d1b5b72 --- /dev/null +++ b/info/gcl/Symbols-Naming-Both-Lexical-and-Dynamic-Variables.html @@ -0,0 +1,71 @@ + + + + + +Symbols Naming Both Lexical and Dynamic Variables (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.6 Symbols Naming Both Lexical and Dynamic Variables

    + +

    The same symbol can name both + a lexical variable +and a dynamic variable, +but never in the same lexical environment. +

    +

    In the following example, the symbol x is used, +at different times, + as the name of a lexical variable +and as the name of a dynamic variable. +

    +
    +
     (let ((x 1))            ;Binds a special variable X
+   (declare (special x))
+   (let ((x 2))          ;Binds a lexical variable X
+     (+ x                ;Reads a lexical variable X
+        (locally (declare (special x))
+                 x))))   ;Reads a special variable X
+⇒  3
+
    + + + + + + diff --git a/info/gcl/Symbols-as-Forms.html b/info/gcl/Symbols-as-Forms.html new file mode 100644 index 0000000..99183ad --- /dev/null +++ b/info/gcl/Symbols-as-Forms.html @@ -0,0 +1,113 @@ + + + + + +Symbols as Forms (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    +
    +

    3.1.2.2 Symbols as Forms

    + +

    If a form is a symbol, +then it is either a symbol macro or a variable. +

    +

    The symbol names a symbol macro +if there is a binding of the symbol as a symbol macro +in the current lexical environment +

    +

    (see define-symbol-macro and symbol-macrolet). +

    +

    If the symbol is a symbol macro, +its expansion function is obtained. +The expansion function is a function of two arguments, and is invoked +by calling the macroexpand hook with + the expansion function as its first argument, + the symbol as its second argument, + and an environment object (corresponding to the current lexical environment) + as its third argument. +The macroexpand hook, in turn, calls the expansion function with the +form as its first argument and the environment as its second argument. +The value of the expansion function, which is passed through +by the macroexpand hook, is a form. +This resulting form is processed in place of the original symbol. +

    +

    If a form is a symbol that is not a symbol macro, +then it is the name of a variable, and the value of that +variable is returned. There are three kinds of variables: + lexical variables, + dynamic variables, +and + constant variables. +A variable can store one object. +The main operations on a variable are + to read_1 and + to write_1 +its value. +

    +

    An error of type unbound-variable should be signaled if +an unbound variable is referenced. +

    +

    Non-constant variables can be assigned by using setq +or bound_3 by using let. +Figure 3–1 lists some defined names that +are applicable to assigning, binding, and defining variables. +

    +
    +
      boundp        let                  progv         
+  defconstant   let*                 psetq         
+  defparameter  makunbound           set           
+  defvar        multiple-value-bind  setq          
+  lambda        multiple-value-setq  symbol-value  
+
+  Figure 3–1: Some Defined Names Applicable to Variables
+
+
    + +

    The following is a description of each kind of variable. +

    +
    +
    +

    +Next: , Previous: , Up: The Evaluation Model  

    +
    + + + + + diff --git a/info/gcl/Symbols-as-Tokens.html b/info/gcl/Symbols-as-Tokens.html new file mode 100644 index 0000000..1f755dc --- /dev/null +++ b/info/gcl/Symbols-as-Tokens.html @@ -0,0 +1,135 @@ + + + + + +Symbols as Tokens (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpretation of Tokens  

    +
    +
    +

    2.3.4 Symbols as Tokens

    + +

    Any token that is not a potential number, +does not contain a package marker, +and does not consist entirely of dots +will always be interpreted as a symbol. +Any token that is a potential number but does not fit the +number syntax is a reserved token and +has an implementation-dependent interpretation. +In all other cases, the token is construed to be the name of a symbol. +

    +

    Examples of the printed representation of symbols are in Figure 2–15. +For presentational simplicity, +these examples assume that +the readtable case of the current readtable is :upcase. +

    +
    +
      FROBBOZ         The symbol whose name is FROBBOZ.                
+  frobboz         Another way to notate the same symbol.           
+  fRObBoz         Yet another way to notate it.                    
+  unwind-protect  A symbol with a hyphen in its name.              
+  +$             The symbol named +$.                            
+  1+              The symbol named 1+.                             
+  +1              This is the integer 1, not a symbol.             
+  pascal_style    This symbol has an underscore in its name.       
+  file.rel.43     This symbol has periods in its name.             
+  \(              The symbol whose name is (.                      
+  \+1             The symbol whose name is +1.                     
+  +\1             Also the symbol whose name is +1.                
+  \frobboz        The symbol whose name is fROBBOZ.                
+  3.14159265\s0   The symbol whose name is 3.14159265s0.           
+  3.14159265\S0   A different symbol, whose name is 3.14159265S0.  
+  3.14159265s0    A possible short float approximation to \pi.     
+
+  Figure 2–15: Examples of the printed representation of symbols (Part 1 of 2)
+
+
    + +
    +
      APL\\360               The symbol whose name is APL\360.       
+  apl\\360               Also the symbol whose name is APL\360.  
+  \(b^2\)\ -\ 4*a*c    The name is (B^2) - 4*A*C.            
+                         Parentheses and two spaces in it.       
+  \(\b^2\)\ -\4*\a*\c  The name is (b^2) - 4*a*c.            
+                         Letters explicitly lowercase.           
+  |"|                    The same as writing \".                 
+  |(b^2) - 4*a*c|      The name is (b^2) - 4*a*c.            
+  |frobboz|              The name is frobboz, not FROBBOZ.       
+  |APL\360|              The name is APL360.                     
+  |APL\\360|             The name is APL\360.                    
+  |apl\\360|             The name is apl\360.                    
+  |\|\||                 Same as \|\| —the name is ||.          
+  |(B^2) - 4*A*C|      The name is (B^2) - 4*A*C.            
+                         Parentheses and two spaces in it.       
+  |(b^2) - 4*a*c|      The name is (b^2) - 4*a*c.            
+
+  Figure 2–16: Examples of the printed representation of symbols (Part 2 of 2)
+
+
    + +

    In the process of parsing a symbol, +it is implementation-dependent which +implementation-defined attributes are removed +from the characters forming a token that represents a symbol. +

    +

    When parsing the syntax for a symbol, +the Lisp reader looks up the name of that symbol +in the current package. +This lookup may involve looking in other +packages whose external symbols +are inherited by the current package. If the name is found, +the corresponding symbol is returned. If the name is not found +(that is, there is no symbol +of that name accessible in the current package), +a new symbol is created and is placed in the current package +as an internal symbol. The current package becomes the owner +(home package) of the symbol, +and the symbol becomes interned in the current package. +If the name is later read again while this same package is +current, the same symbol will be found and returned. +

    +
    +
    +

    +Next: , Previous: , Up: Interpretation of Tokens  

    +
    + + + + + diff --git a/info/gcl/Symbols-in-a-Package.html b/info/gcl/Symbols-in-a-Package.html new file mode 100644 index 0000000..f43b7e1 --- /dev/null +++ b/info/gcl/Symbols-in-a-Package.html @@ -0,0 +1,51 @@ + + + + + +Symbols in a Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Packages  

    +
    +
    +

    11.1.1.2 Symbols in a Package

    + + + + + + diff --git a/info/gcl/Symbols-in-the-COMMON_002dLISP-Package.html b/info/gcl/Symbols-in-the-COMMON_002dLISP-Package.html new file mode 100644 index 0000000..a9201fa --- /dev/null +++ b/info/gcl/Symbols-in-the-COMMON_002dLISP-Package.html @@ -0,0 +1,600 @@ + + + + + +Symbols in the COMMON-LISP Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Introduction (Introduction)  

    +
    +
    +

    1.9 Symbols in the COMMON-LISP Package

    + + +

    The figures on the next twelve pages contain a complete enumeration +of the 978 external symbols in the COMMON-LISP package. + +

    +
    +
      &allow-other-keys            *print-miser-width*          
+  &aux                         *print-pprint-dispatch*      
+  &body                        *print-pretty*               
+  &environment                 *print-radix*                
+  &key                         *print-readably*             
+  &optional                    *print-right-margin*         
+  &rest                        *query-io*                   
+  &whole                       *random-state*               
+  *                            *read-base*                  
+  **                           *read-default-float-format*  
+  ***                          *read-eval*                  
+  *break-on-signals*           *read-suppress*              
+  *compile-file-pathname*      *readtable*                  
+  *compile-file-truename*      *standard-input*             
+  *compile-print*              *standard-output*            
+  *compile-verbose*            *terminal-io*                
+  *debug-io*                   *trace-output*               
+  *debugger-hook*              +                            
+  *default-pathname-defaults*  ++                           
+  *error-output*               +++                          
+  *features*                   -                            
+  *gensym-counter*             /                            
+  *load-pathname*              //                           
+  *load-print*                 ///                          
+  *load-truename*              /=                           
+  *load-verbose*               1+                           
+  *macroexpand-hook*           1-                           
+  *modules*                    <                            
+  *package*                    <=                           
+  *print-array*                =                            
+  *print-base*                 >                            
+  *print-case*                 >=                           
+  *print-circle*               abort                        
+  *print-escape*               abs                          
+  *print-gensym*               acons                        
+  *print-length*               acos                         
+  *print-level*                acosh                        
+  *print-lines*                add-method                   
+
+  Figure 1–4: Symbols in the COMMON-LISP package (part one of twelve).
+
+
    + + +
    +
      adjoin                      atom          boundp                    
+  adjust-array                base-char     break                     
+  adjustable-array-p          base-string   broadcast-stream          
+  allocate-instance           bignum        broadcast-stream-streams  
+  alpha-char-p                bit           built-in-class            
+  alphanumericp               bit-and       butlast                   
+  and                         bit-andc1     byte                      
+  append                      bit-andc2     byte-position             
+  apply                       bit-eqv       byte-size                 
+  apropos                     bit-ior       caaaar                    
+  apropos-list                bit-nand      caaadr                    
+  aref                        bit-nor       caaar                     
+  arithmetic-error            bit-not       caadar                    
+  arithmetic-error-operands   bit-orc1      caaddr                    
+  arithmetic-error-operation  bit-orc2      caadr                     
+  array                       bit-vector    caar                      
+  array-dimension             bit-vector-p  cadaar                    
+  array-dimension-limit       bit-xor       cadadr                    
+  array-dimensions            block         cadar                     
+  array-displacement          boole         caddar                    
+  array-element-type          boole-1       cadddr                    
+  array-has-fill-pointer-p    boole-2       caddr                     
+  array-in-bounds-p           boole-and     cadr                      
+  array-rank                  boole-andc1   call-arguments-limit      
+  array-rank-limit            boole-andc2   call-method               
+  array-row-major-index       boole-c1      call-next-method          
+  array-total-size            boole-c2      car                       
+  array-total-size-limit      boole-clr     case                      
+  arrayp                      boole-eqv     catch                     
+  ash                         boole-ior     ccase                     
+  asin                        boole-nand    cdaaar                    
+  asinh                       boole-nor     cdaadr                    
+  assert                      boole-orc1    cdaar                     
+  assoc                       boole-orc2    cdadar                    
+  assoc-if                    boole-set     cdaddr                    
+  assoc-if-not                boole-xor     cdadr                     
+  atan                        boolean       cdar                      
+  atanh                       both-case-p   cddaar                    
+
+  Figure 1–5: Symbols in the COMMON-LISP package (part two of twelve).
+
+
    + + +
    +
      cddadr             clear-input                  copy-tree                  
+  cddar              clear-output                 cos                        
+  cdddar             close                        cosh                       
+  cddddr             clrhash                      count                      
+  cdddr              code-char                    count-if                   
+  cddr               coerce                       count-if-not               
+  cdr                compilation-speed            ctypecase                  
+  ceiling            compile                      debug                      
+  cell-error         compile-file                 decf                       
+  cell-error-name    compile-file-pathname        declaim                    
+  cerror             compiled-function            declaration                
+  change-class       compiled-function-p          declare                    
+  char               compiler-macro               decode-float               
+  char-code          compiler-macro-function      decode-universal-time      
+  char-code-limit    complement                   defclass                   
+  char-downcase      complex                      defconstant                
+  char-equal         complexp                     defgeneric                 
+  char-greaterp      compute-applicable-methods   define-compiler-macro      
+  char-int           compute-restarts             define-condition           
+  char-lessp         concatenate                  define-method-combination  
+  char-name          concatenated-stream          define-modify-macro        
+  char-not-equal     concatenated-stream-streams  define-setf-expander       
+  char-not-greaterp  cond                         define-symbol-macro        
+  char-not-lessp     condition                    defmacro                   
+  char-upcase        conjugate                    defmethod                  
+  char/=             cons                         defpackage                 
+  char<              consp                        defparameter               
+  char<=             constantly                   defsetf                    
+  char=              constantp                    defstruct                  
+  char>              continue                     deftype                    
+  char>=             control-error                defun                      
+  character          copy-alist                   defvar                     
+  characterp         copy-list                    delete                     
+  check-type         copy-pprint-dispatch         delete-duplicates          
+  cis                copy-readtable               delete-file                
+  class              copy-seq                     delete-if                  
+  class-name         copy-structure               delete-if-not              
+  class-of           copy-symbol                  delete-package             
+
+    Figure 1–6: Symbols in the COMMON-LISP package (part three of twelve).  
+
+
    + + +
    +
      denominator                    eq                   
+  deposit-field                  eql                  
+  describe                       equal                
+  describe-object                equalp               
+  destructuring-bind             error                
+  digit-char                     etypecase            
+  digit-char-p                   eval                 
+  directory                      eval-when            
+  directory-namestring           evenp                
+  disassemble                    every                
+  division-by-zero               exp                  
+  do                             export               
+  do*                            expt                 
+  do-all-symbols                 extended-char        
+  do-external-symbols            fboundp              
+  do-symbols                     fceiling             
+  documentation                  fdefinition          
+  dolist                         ffloor               
+  dotimes                        fifth                
+  double-float                   file-author          
+  double-float-epsilon           file-error           
+  double-float-negative-epsilon  file-error-pathname  
+  dpb                            file-length          
+  dribble                        file-namestring      
+  dynamic-extent                 file-position        
+  ecase                          file-stream          
+  echo-stream                    file-string-length   
+  echo-stream-input-stream       file-write-date      
+  echo-stream-output-stream      fill                 
+  ed                             fill-pointer         
+  eighth                         find                 
+  elt                            find-all-symbols     
+  encode-universal-time          find-class           
+  end-of-file                    find-if              
+  endp                           find-if-not          
+  enough-namestring              find-method          
+  ensure-directories-exist       find-package         
+  ensure-generic-function        find-restart         
+
+  Figure 1–7: Symbols in the COMMON-LISP package (part four of twelve).
+
+
    + + +
    +
      find-symbol                       get-internal-run-time        
+  finish-output                     get-macro-character          
+  first                             get-output-stream-string     
+  fixnum                            get-properties               
+  flet                              get-setf-expansion           
+  float                             get-universal-time           
+  float-digits                      getf                         
+  float-precision                   gethash                      
+  float-radix                       go                           
+  float-sign                        graphic-char-p               
+  floating-point-inexact            handler-bind                 
+  floating-point-invalid-operation  handler-case                 
+  floating-point-overflow           hash-table                   
+  floating-point-underflow          hash-table-count             
+  floatp                            hash-table-p                 
+  floor                             hash-table-rehash-size       
+  fmakunbound                       hash-table-rehash-threshold  
+  force-output                      hash-table-size              
+  format                            hash-table-test              
+  formatter                         host-namestring              
+  fourth                            identity                     
+  fresh-line                        if                           
+  fround                            ignorable                    
+  ftruncate                         ignore                       
+  ftype                             ignore-errors                
+  funcall                           imagpart                     
+  function                          import                       
+  function-keywords                 in-package                   
+  function-lambda-expression        incf                         
+  functionp                         initialize-instance          
+  gcd                               inline                       
+  generic-function                  input-stream-p               
+  gensym                            inspect                      
+  gentemp                           integer                      
+  get                               integer-decode-float         
+  get-decoded-time                  integer-length               
+  get-dispatch-macro-character      integerp                     
+  get-internal-real-time            interactive-stream-p         
+
+  Figure 1–8: Symbols in the COMMON-LISP package (part five of twelve).
+
+
    + + +
    +
      intern                                  lisp-implementation-type            
+  internal-time-units-per-second          lisp-implementation-version         
+  intersection                            list                                
+  invalid-method-error                    list*                               
+  invoke-debugger                         list-all-packages                   
+  invoke-restart                          list-length                         
+  invoke-restart-interactively            listen                              
+  isqrt                                   listp                               
+  keyword                                 load                                
+  keywordp                                load-logical-pathname-translations  
+  labels                                  load-time-value                     
+  lambda                                  locally                             
+  lambda-list-keywords                    log                                 
+  lambda-parameters-limit                 logand                              
+  last                                    logandc1                            
+  lcm                                     logandc2                            
+  ldb                                     logbitp                             
+  ldb-test                                logcount                            
+  ldiff                                   logeqv                              
+  least-negative-double-float             logical-pathname                    
+  least-negative-long-float               logical-pathname-translations       
+  least-negative-normalized-double-float  logior                              
+  least-negative-normalized-long-float    lognand                             
+  least-negative-normalized-short-float   lognor                              
+  least-negative-normalized-single-float  lognot                              
+  least-negative-short-float              logorc1                             
+  least-negative-single-float             logorc2                             
+  least-positive-double-float             logtest                             
+  least-positive-long-float               logxor                              
+  least-positive-normalized-double-float  long-float                          
+  least-positive-normalized-long-float    long-float-epsilon                  
+  least-positive-normalized-short-float   long-float-negative-epsilon         
+  least-positive-normalized-single-float  long-site-name                      
+  least-positive-short-float              loop                                
+  least-positive-single-float             loop-finish                         
+  length                                  lower-case-p                        
+  let                                     machine-instance                    
+  let*                                    machine-type                        
+
+     Figure 1–9: Symbols in the COMMON-LISP package (part six of twelve).    
+
+
    + + +
    +
      machine-version                mask-field                  
+  macro-function                 max                         
+  macroexpand                    member                      
+  macroexpand-1                  member-if                   
+  macrolet                       member-if-not               
+  make-array                     merge                       
+  make-broadcast-stream          merge-pathnames             
+  make-concatenated-stream       method                      
+  make-condition                 method-combination          
+  make-dispatch-macro-character  method-combination-error    
+  make-echo-stream               method-qualifiers           
+  make-hash-table                min                         
+  make-instance                  minusp                      
+  make-instances-obsolete        mismatch                    
+  make-list                      mod                         
+  make-load-form                 most-negative-double-float  
+  make-load-form-saving-slots    most-negative-fixnum        
+  make-method                    most-negative-long-float    
+  make-package                   most-negative-short-float   
+  make-pathname                  most-negative-single-float  
+  make-random-state              most-positive-double-float  
+  make-sequence                  most-positive-fixnum        
+  make-string                    most-positive-long-float    
+  make-string-input-stream       most-positive-short-float   
+  make-string-output-stream      most-positive-single-float  
+  make-symbol                    muffle-warning              
+  make-synonym-stream            multiple-value-bind         
+  make-two-way-stream            multiple-value-call         
+  makunbound                     multiple-value-list         
+  map                            multiple-value-prog1        
+  map-into                       multiple-value-setq         
+  mapc                           multiple-values-limit       
+  mapcan                         name-char                   
+  mapcar                         namestring                  
+  mapcon                         nbutlast                    
+  maphash                        nconc                       
+  mapl                           next-method-p               
+  maplist                        nil                         
+
+  Figure 1–10: Symbols in the COMMON-LISP package (part seven of twelve).
+
+
    + + +
    +
      nintersection         package-error                  
+  ninth                 package-error-package          
+  no-applicable-method  package-name                   
+  no-next-method        package-nicknames              
+  not                   package-shadowing-symbols      
+  notany                package-use-list               
+  notevery              package-used-by-list           
+  notinline             packagep                       
+  nreconc               pairlis                        
+  nreverse              parse-error                    
+  nset-difference       parse-integer                  
+  nset-exclusive-or     parse-namestring               
+  nstring-capitalize    pathname                       
+  nstring-downcase      pathname-device                
+  nstring-upcase        pathname-directory             
+  nsublis               pathname-host                  
+  nsubst                pathname-match-p               
+  nsubst-if             pathname-name                  
+  nsubst-if-not         pathname-type                  
+  nsubstitute           pathname-version               
+  nsubstitute-if        pathnamep                      
+  nsubstitute-if-not    peek-char                      
+  nth                   phase                          
+  nth-value             pi                             
+  nthcdr                plusp                          
+  null                  pop                            
+  number                position                       
+  numberp               position-if                    
+  numerator             position-if-not                
+  nunion                pprint                         
+  oddp                  pprint-dispatch                
+  open                  pprint-exit-if-list-exhausted  
+  open-stream-p         pprint-fill                    
+  optimize              pprint-indent                  
+  or                    pprint-linear                  
+  otherwise             pprint-logical-block           
+  output-stream-p       pprint-newline                 
+  package               pprint-pop                     
+
+  Figure 1–11: Symbols in the COMMON-LISP package (part eight of twelve).
+
+
    + + +
    +
      pprint-tab                 read-char                   
+  pprint-tabular             read-char-no-hang           
+  prin1                      read-delimited-list         
+  prin1-to-string            read-from-string            
+  princ                      read-line                   
+  princ-to-string            read-preserving-whitespace  
+  print                      read-sequence               
+  print-not-readable         reader-error                
+  print-not-readable-object  readtable                   
+  print-object               readtable-case              
+  print-unreadable-object    readtablep                  
+  probe-file                 real                        
+  proclaim                   realp                       
+  prog                       realpart                    
+  prog*                      reduce                      
+  prog1                      reinitialize-instance       
+  prog2                      rem                         
+  progn                      remf                        
+  program-error              remhash                     
+  progv                      remove                      
+  provide                    remove-duplicates           
+  psetf                      remove-if                   
+  psetq                      remove-if-not               
+  push                       remove-method               
+  pushnew                    remprop                     
+  quote                      rename-file                 
+  random                     rename-package              
+  random-state               replace                     
+  random-state-p             require                     
+  rassoc                     rest                        
+  rassoc-if                  restart                     
+  rassoc-if-not              restart-bind                
+  ratio                      restart-case                
+  rational                   restart-name                
+  rationalize                return                      
+  rationalp                  return-from                 
+  read                       revappend                   
+  read-byte                  reverse                     
+
+  Figure 1–12: Symbols in the COMMON-LISP package (part nine of twelve).
+
+
    + + +
    +
      room                          simple-bit-vector                  
+  rotatef                       simple-bit-vector-p                
+  round                         simple-condition                   
+  row-major-aref                simple-condition-format-arguments  
+  rplaca                        simple-condition-format-control    
+  rplacd                        simple-error                       
+  safety                        simple-string                      
+  satisfies                     simple-string-p                    
+  sbit                          simple-type-error                  
+  scale-float                   simple-vector                      
+  schar                         simple-vector-p                    
+  search                        simple-warning                     
+  second                        sin                                
+  sequence                      single-float                       
+  serious-condition             single-float-epsilon               
+  set                           single-float-negative-epsilon      
+  set-difference                sinh                               
+  set-dispatch-macro-character  sixth                              
+  set-exclusive-or              sleep                              
+  set-macro-character           slot-boundp                        
+  set-pprint-dispatch           slot-exists-p                      
+  set-syntax-from-char          slot-makunbound                    
+  setf                          slot-missing                       
+  setq                          slot-unbound                       
+  seventh                       slot-value                         
+  shadow                        software-type                      
+  shadowing-import              software-version                   
+  shared-initialize             some                               
+  shiftf                        sort                               
+  short-float                   space                              
+  short-float-epsilon           special                            
+  short-float-negative-epsilon  special-operator-p                 
+  short-site-name               speed                              
+  signal                        sqrt                               
+  signed-byte                   stable-sort                        
+  signum                        standard                           
+  simple-array                  standard-char                      
+  simple-base-string            standard-char-p                    
+
+  Figure 1–13: Symbols in the COMMON-LISP package (part ten of twelve).
+
+
    + + +
    +
      standard-class             sublis                      
+  standard-generic-function  subseq                      
+  standard-method            subsetp                     
+  standard-object            subst                       
+  step                       subst-if                    
+  storage-condition          subst-if-not                
+  store-value                substitute                  
+  stream                     substitute-if               
+  stream-element-type        substitute-if-not           
+  stream-error               subtypep                    
+  stream-error-stream        svref                       
+  stream-external-format     sxhash                      
+  streamp                    symbol                      
+  string                     symbol-function             
+  string-capitalize          symbol-macrolet             
+  string-downcase            symbol-name                 
+  string-equal               symbol-package              
+  string-greaterp            symbol-plist                
+  string-left-trim           symbol-value                
+  string-lessp               symbolp                     
+  string-not-equal           synonym-stream              
+  string-not-greaterp        synonym-stream-symbol       
+  string-not-lessp           t                           
+  string-right-trim          tagbody                     
+  string-stream              tailp                       
+  string-trim                tan                         
+  string-upcase              tanh                        
+  string/=                   tenth                       
+  string<                    terpri                      
+  string<=                   the                         
+  string=                    third                       
+  string>                    throw                       
+  string>=                   time                        
+  stringp                    trace                       
+  structure                  translate-logical-pathname  
+  structure-class            translate-pathname          
+  structure-object           tree-equal                  
+  style-warning              truename                    
+
+  Figure 1–14: Symbols in the COMMON-LISP package (part eleven of twelve).
+
+
    + + +
    +
      truncate                             values-list               
+  two-way-stream                       variable                  
+  two-way-stream-input-stream          vector                    
+  two-way-stream-output-stream         vector-pop                
+  type                                 vector-push               
+  type-error                           vector-push-extend        
+  type-error-datum                     vectorp                   
+  type-error-expected-type             warn                      
+  type-of                              warning                   
+  typecase                             when                      
+  typep                                wild-pathname-p           
+  unbound-slot                         with-accessors            
+  unbound-slot-instance                with-compilation-unit     
+  unbound-variable                     with-condition-restarts   
+  undefined-function                   with-hash-table-iterator  
+  unexport                             with-input-from-string    
+  unintern                             with-open-file            
+  union                                with-open-stream          
+  unless                               with-output-to-string     
+  unread-char                          with-package-iterator     
+  unsigned-byte                        with-simple-restart       
+  untrace                              with-slots                
+  unuse-package                        with-standard-io-syntax   
+  unwind-protect                       write                     
+  update-instance-for-different-class  write-byte                
+  update-instance-for-redefined-class  write-char                
+  upgraded-array-element-type          write-line                
+  upgraded-complex-part-type           write-sequence            
+  upper-case-p                         write-string              
+  use-package                          write-to-string           
+  use-value                            y-or-n-p                  
+  user-homedir-pathname                yes-or-no-p               
+  values                               zerop                     
+
+  Figure 1–15: Symbols in the COMMON-LISP package (part twelve of twelve).
+
+
    + + + + + + +
    +
    +

    +Previous: , Up: Introduction (Introduction)  

    +
    + + + + + diff --git a/info/gcl/Symbols.html b/info/gcl/Symbols.html new file mode 100644 index 0000000..fb2f23b --- /dev/null +++ b/info/gcl/Symbols.html @@ -0,0 +1,58 @@ + + + + + +Symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    10 Symbols

    + + + + +
    • Symbol Concepts   +
    • Symbols Dictionary   +
    + + + + + + diff --git a/info/gcl/Syntactic-Interaction-of-Documentation-Strings-and-Declarations.html b/info/gcl/Syntactic-Interaction-of-Documentation-Strings-and-Declarations.html new file mode 100644 index 0000000..f015c4b --- /dev/null +++ b/info/gcl/Syntactic-Interaction-of-Documentation-Strings-and-Declarations.html @@ -0,0 +1,64 @@ + + + + + +Syntactic Interaction of Documentation Strings and Declarations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Lambda Lists  

    +
    +
    +

    3.4.11 Syntactic Interaction of Documentation Strings and Declarations

    + +

    In a number of situations, a documentation string can appear amidst a +series of declare expressions prior to a series of forms. +

    +

    In that case, if a string S appears where a documentation string is +permissible and is not followed by + either a declare expression + or a form +then S is taken to be a form; +otherwise, S is taken as a documentation string. +The consequences are unspecified if more than one such documentation string +is present. +

    + + + + + + diff --git a/info/gcl/Syntax-of-Logical-Pathname-Namestrings.html b/info/gcl/Syntax-of-Logical-Pathname-Namestrings.html new file mode 100644 index 0000000..6502b56 --- /dev/null +++ b/info/gcl/Syntax-of-Logical-Pathname-Namestrings.html @@ -0,0 +1,121 @@ + + + + + +Syntax of Logical Pathname Namestrings (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Logical Pathnames  

    +
    +
    +

    19.3.1 Syntax of Logical Pathname Namestrings

    + +

    The syntax of a logical pathname namestring is as follows. +(Note that unlike many notational descriptions in this document, + this is a syntactic description of character sequences, + not a structural description of objects.) +

    +

    logical-pathname ::=[!host host-marker]  +                     [!relative-directory-marker] {!directory directory-marker}*  +                     [!name] [type-marker !type [version-marker !version]] +

    +

    host ::=!word +

    +

    directory ::=!word | !wildcard-word | !wild-inferiors-word +

    +

    name ::=!word | !wildcard-word +

    +

    type ::=!word | !wildcard-word +

    +

    version ::=!pos-int | newest-word | wildcard-version +

    +

    host-marker—a colon. +

    +

    relative-directory-marker—a semicolon. +

    +

    directory-marker—a semicolon. +

    +

    type-marker—a dot. +

    +

    version-marker—a dot. +

    +

    wild-inferiors-word—The two character sequence “**” (two asterisks). +

    +

    newest-word—The six character sequence “newest” + or the six character sequence “NEWEST”. +

    +

    wildcard-version—an asterisk. +

    +

    wildcard-word—one or more asterisks, uppercase letters, + digits, and hyphens, including at least one asterisk, + with no two asterisks adjacent. +

    +

    word—one or more uppercase letters, digits, and hyphens. +

    +

    pos-int—a positive integer. +

    + + + + + + + + + + +
    • Additional Information about Parsing Logical Pathname Namestrings   +
    • The Host part of a Logical Pathname Namestring   +
    • The Device part of a Logical Pathname Namestring   +
    • The Directory part of a Logical Pathname Namestring   +
    • The Type part of a Logical Pathname Namestring   +
    • The Version part of a Logical Pathname Namestring   +
    • Wildcard Words in a Logical Pathname Namestring   +
    • Lowercase Letters in a Logical Pathname Namestring   +
    • Other Syntax in a Logical Pathname Namestring   +
    + +
    +
    +

    +Next: , Previous: , Up: Logical Pathnames  

    +
    + + + + + diff --git a/info/gcl/Syntax-of-a-Complex.html b/info/gcl/Syntax-of-a-Complex.html new file mode 100644 index 0000000..4dacd5d --- /dev/null +++ b/info/gcl/Syntax-of-a-Complex.html @@ -0,0 +1,72 @@ + + + + + +Syntax of a Complex (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Constructing Numbers from Tokens  

    +
    +
    +

    2.3.2.5 Syntax of a Complex

    + +

    A complex has a Cartesian structure, +with a real part and an imaginary part each of which is a +

    +

    real. +

    +

    The parts of a complex are not necessarily floats +but both parts must be of the same type: +

    +

    [Editorial Note by KMP: This is not the same as saying they must be the same type. + Maybe we mean they are of the same ‘precision’ or ‘format’? + GLS had suggestions which are not yet merged.] +either both are rationals, or both are of the same float subtype. +When constructing a complex, if the specified parts are not the +same type, the parts are converted to be the same type +internally (i.e., the rational part is converted to a float). +An object of type (complex rational) is converted internally +and represented thereafter as a rational if its imaginary part is an +integer whose value is 0. +

    +

    For further information, see Sharpsign C and Printing Complexes. +

    + + + + + diff --git a/info/gcl/Syntax-of-a-Float.html b/info/gcl/Syntax-of-a-Float.html new file mode 100644 index 0000000..a732577 --- /dev/null +++ b/info/gcl/Syntax-of-a-Float.html @@ -0,0 +1,111 @@ + + + + + +Syntax of a Float (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Constructing Numbers from Tokens  

    +
    +
    +

    2.3.2.4 Syntax of a Float

    + +

    Floats can be written in either decimal fraction or computerized +scientific notation: an optional sign, then a non-empty sequence of digits +with an embedded decimal point, +then an optional decimal exponent specification. +If there is no exponent specifier, then +the decimal point is required, and there must be digits +after it. +The exponent specifier consists of an exponent marker, +an optional sign, and a non-empty sequence of digits. +If no exponent specifier is present, or if the exponent marker e +(or E) is used, then +the format specified +by *read-default-float-format* is used. +See Figure~2–9. +

    +

    An implementation may provide one or more kinds of float +that collectively make up the type float. +The letters s, f, d, and l (or their +respective uppercase equivalents) explicitly specify the +use of the types short-float, single-float, +double-float, and long-float, respectively. +

    +

    The internal format used for an external representation depends only +on the exponent marker, and not on the number of decimal digits +in the external representation. +

    +

    Figure 2–14 contains examples of notations for floats: +

    +
    +
      0.0       ;Floating-point zero in default format                          
+  0E0       ;As input, this is also floating-point zero in default format.  
+            ;As output, this would appear as 0.0.                           
+  0e0       ;As input, this is also floating-point zero in default format.  
+            ;As output, this would appear as 0.0.                           
+  -.0       ;As input, this might be a zero or a minus zero,                
+            ; depending on whether the implementation supports              
+            ; a distinct minus zero.                                        
+            ;As output, 0.0 is zero and -0.0 is minus zero.                 
+  0.        ;On input, the integer zero—not a floating-point number!      
+            ;Whether this appears as 0 or 0. on output depends              
+            ;on the value of *print-radix*.                                 
+  0.0s0     ;A floating-point zero in short format                          
+  0s0       ;As input, this is a floating-point zero in short format.       
+            ;As output, such a zero would appear as 0.0s0                   
+            ; (or as 0.0 if short-float was the default format).            
+  6.02E+23  ;Avogadro’s number, in default format                           
+  602E+21   ;Also Avogadro’s number, in default format                      
+
+               Figure 2–14: Examples of Floating-point numbers             
+
+
    + +

    For information on how floats are printed, +see Printing Floats. +

    +
    +
    +

    +Next: , Previous: , Up: Constructing Numbers from Tokens  

    +
    + + + + + diff --git a/info/gcl/Syntax-of-a-Ratio.html b/info/gcl/Syntax-of-a-Ratio.html new file mode 100644 index 0000000..446c225 --- /dev/null +++ b/info/gcl/Syntax-of-a-Ratio.html @@ -0,0 +1,79 @@ + + + + + +Syntax of a Ratio (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Constructing Numbers from Tokens  

    +
    +
    +

    2.3.2.3 Syntax of a Ratio

    + +

    Ratios can be written as an optional sign followed by two +non-empty sequences of digits separated by a slash; +see Figure~2–9. +The second sequence may not consist +entirely of zeros. +Examples of ratios are in Figure 2–13. +

    +
    +
      2/3                 ;This is in canonical form                  
+  4/6                 ;A non-canonical form for 2/3               
+  -17/23              ;A ratio preceded by a sign                 
+  -30517578125/32768  ;This is (-5/2)^15                        
+  10/5                ;The canonical form for this is 2           
+  #o-101/75           ;Octal notation for -65/61                  
+  #3r120/21           ;Ternary notation for 15/7                  
+  #Xbc/ad             ;Hexadecimal notation for 188/173           
+  #xFADED/FACADE      ;Hexadecimal notation for 1027565/16435934  
+
+                  Figure 2–13: Examples of Ratios                
+
+
    + +

    [Reviewer Note by Barmar: #o, #3r, #X, and #x mentioned above + are not in the syntax rules defined just above that.] +

    +

    For information on how ratios are printed, +see Printing Ratios. +

    + + + + + diff --git a/info/gcl/Syntax-of-a-Rational.html b/info/gcl/Syntax-of-a-Rational.html new file mode 100644 index 0000000..01cc565 --- /dev/null +++ b/info/gcl/Syntax-of-a-Rational.html @@ -0,0 +1,51 @@ + + + + + +Syntax of a Rational (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Constructing Numbers from Tokens  

    +
    +
    +

    2.3.2.1 Syntax of a Rational

    + + + + + + diff --git a/info/gcl/Syntax-of-an-Integer.html b/info/gcl/Syntax-of-an-Integer.html new file mode 100644 index 0000000..03b6adf --- /dev/null +++ b/info/gcl/Syntax-of-an-Integer.html @@ -0,0 +1,61 @@ + + + + + +Syntax of an Integer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Constructing Numbers from Tokens  

    +
    +
    +

    2.3.2.2 Syntax of an Integer

    + +

    Integers can be written as a sequence of digits, +optionally preceded by a sign and optionally followed by a decimal point; +see Figure~2–9. +When a decimal point is used, +the digits are taken to be in radix 10; +when no decimal point is used, +the digits are taken to be in radix given by the current input base. +

    +

    For information on how integers are printed, see Printing Integers. +

    + + + + + diff --git a/info/gcl/Syntax.html b/info/gcl/Syntax.html new file mode 100644 index 0000000..0d98eb8 --- /dev/null +++ b/info/gcl/Syntax.html @@ -0,0 +1,62 @@ + + + + + +Syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    2 Syntax

    + + + + + + +
    • Character Syntax   +
    • Reader Algorithm   +
    • Interpretation of Tokens   +
    • Standard Macro Characters   +
    + + + + + + diff --git a/info/gcl/System-Construction-Concepts.html b/info/gcl/System-Construction-Concepts.html new file mode 100644 index 0000000..d942860 --- /dev/null +++ b/info/gcl/System-Construction-Concepts.html @@ -0,0 +1,59 @@ + + + + + +System Construction Concepts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction  

    +
    +
    +

    24.1 System Construction Concepts

    + + + + + +
    • Loading   +
    • Features   +
    + + + + + + diff --git a/info/gcl/System-Construction-Dictionary.html b/info/gcl/System-Construction-Dictionary.html new file mode 100644 index 0000000..df52f6a --- /dev/null +++ b/info/gcl/System-Construction-Dictionary.html @@ -0,0 +1,77 @@ + + + + + +System Construction Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: System Construction  

    +
    +
    +

    24.2 System Construction Dictionary

    + + + + + + + + + + + + + + +
    • compile-file   +
    • compile-file-pathname   +
    • load   +
    • with-compilation-unit   +
    • *features*   +
    • *compile-file-pathname*   +
    • *load-pathname*   +
    • *compile-print*   +
    • *load-print*   +
    • *modules*   +
    • provide   +
    + + + + + + diff --git a/info/gcl/System-Construction.html b/info/gcl/System-Construction.html new file mode 100644 index 0000000..272f07b --- /dev/null +++ b/info/gcl/System-Construction.html @@ -0,0 +1,58 @@ + + + + + +System Construction (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    24 System Construction

    + + + + +
    • System Construction Concepts   +
    • System Construction Dictionary   +
    + + + + + + diff --git a/info/gcl/THE-Forms-as-Places.html b/info/gcl/THE-Forms-as-Places.html new file mode 100644 index 0000000..6384731 --- /dev/null +++ b/info/gcl/THE-Forms-as-Places.html @@ -0,0 +1,65 @@ + + + + + +THE Forms as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.4 THE Forms as Places

    + +

    A the form can be used as a place, +in which case the declaration is transferred to the newvalue form, +and the resulting setf is analyzed. For example, +

    +
    +
     (setf (the integer (cadr x)) (+ y 3))
+
    + +

    is processed as if it were +

    +
    +
     (setf (cadr x) (the integer (+ y 3)))
+
    + + + + + + diff --git a/info/gcl/Termination-Test-Clauses.html b/info/gcl/Termination-Test-Clauses.html new file mode 100644 index 0000000..d55980e --- /dev/null +++ b/info/gcl/Termination-Test-Clauses.html @@ -0,0 +1,191 @@ + + + + + +Termination Test Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.4 Termination Test Clauses

    + +

    The repeat construct causes iteration to terminate after a +specified number of times. + The loop body executes n times, where n is the value +of the expression form. The form argument is evaluated one time +in the loop prologue. If the expression evaluates to 0 or +to a negative number, the loop body is not evaluated. +

    +

    The constructs always, +never, +thereis, +while, +until, +and the macro loop-finish +allow conditional termination of iteration within +a loop. +

    +

    The constructs always, never, and thereis provide +specific values to be returned when a loop terminates. +Using always, never, or thereis in a loop with +value accumulation clauses that are not into causes +an error of type program-error to be signaled (at macro expansion time). +Since always, never, and thereis +use +

    +

    the return-from special operator +

    +

    to terminate iteration, +any finally clause that is supplied is not evaluated +when exit occurs due to any of these constructs. +In all other respects these +constructs behave like the while and until constructs. +

    +

    The always construct takes one form and terminates the +loop + if the form ever evaluates to nil; in this case, it returns + nil. Otherwise, it provides a default return value of t. +If the value of the supplied form is never nil, some other construct +can terminate the iteration. +

    +

    The never construct terminates iteration the first time that +the value of the supplied form is non-nil; the loop returns +nil. +If the value of the supplied form is always nil, some other +construct can terminate the iteration. +Unless some other clause contributes +a return value, the default value returned is t. +

    +

    The thereis construct terminates iteration the first time that the +value of the supplied form is non-nil; the loop returns the +value of the supplied form. +If the value of the supplied form +is always nil, some other +construct can terminate the iteration. Unless some other clause contributes a +return value, the default value returned is nil. +

    +

    There are two differences between the thereis and until +constructs: +

    +
    +
    *
    +

    The until construct does not return a value or +nil based on the value of the supplied form. +

    +
    +
    *
    +

    The until construct executes +any finally clause. +Since thereis uses +

    +

    the return-from special operator +

    +

    to terminate iteration, +any finally clause that is supplied is not evaluated +when exit occurs due to thereis. +

    +
    +
    + +

    The while construct allows iteration to continue until the +supplied form +evaluates to false. The supplied form +is reevaluated at the location of the while clause. +

    +

    The until construct is equivalent to +while (not form)\dots. If the value of the +supplied form is non-nil, iteration terminates. +

    +

    Termination-test control constructs can be used anywhere within the loop body. +The termination tests are used in the order in which they appear. +If an until or while clause causes +termination, any clauses that precede it in the source +are still evaluated. +If the until and while constructs cause termination, +control is passed to the loop epilogue, where any finally +clauses will be executed. +

    +

    There are two differences between the never and until +constructs: +

    +
    +
    *
    +

    The until construct does not return +t or nil based on the value of the supplied form. +

    +
    +
    *
    +

    The until construct +does not bypass any finally clauses. +Since never uses +

    +

    the return-from special operator +

    +

    to terminate iteration, +any finally clause that is supplied is not evaluated +when exit occurs due to never. +

    +
    + +

    In most cases it is not necessary to use loop-finish +because other loop control clauses terminate the loop. +The macro loop-finish is used to provide a normal exit +from a nested conditional inside a loop. +Since loop-finish transfers control to the loop epilogue, +using loop-finish within a finally expression can cause +infinite looping. +

    + + + + +
    • Examples of REPEAT clause   +
    • Examples of ALWAYS   +
    • Examples of WHILE and UNTIL clauses   +
    + +
    +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    + + + + + diff --git a/info/gcl/The-COMMON_002dLISP-Package.html b/info/gcl/The-COMMON_002dLISP-Package.html new file mode 100644 index 0000000..c7f3d1f --- /dev/null +++ b/info/gcl/The-COMMON_002dLISP-Package.html @@ -0,0 +1,77 @@ + + + + + +The COMMON-LISP Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.1 The COMMON-LISP Package

    + + + + + +

    The COMMON-LISP package contains the primitives of the Common Lisp system as +defined by this specification. Its external symbols include +all of the defined names (except for defined names in +the KEYWORD package) that are present in the Common Lisp system, +such as car, cdr, *package*, etc. +The COMMON-LISP package has the nickname CL. +

    +

    The COMMON-LISP package has as external symbols those +symbols enumerated in the figures in Symbols in the COMMON-LISP Package, and no others. +These external symbols are present in the COMMON-LISP package +but their home package need not be the COMMON-LISP package. +

    +

    For example, the symbol HELP cannot be an external symbol of +the COMMON-LISP package because it is not mentioned in Symbols in the COMMON-LISP Package. +In contrast, the symbol variable +must be an external symbol of the COMMON-LISP package +even though it has no definition +because it is listed in that section +(to support its use as a valid second argument to the function documentation). +

    +

    The COMMON-LISP package can have additional internal symbols. +

    + + + + + diff --git a/info/gcl/The-COMMON_002dLISP_002dUSER-Package.html b/info/gcl/The-COMMON_002dLISP_002dUSER-Package.html new file mode 100644 index 0000000..335e528 --- /dev/null +++ b/info/gcl/The-COMMON_002dLISP_002dUSER-Package.html @@ -0,0 +1,62 @@ + + + + + +The COMMON-LISP-USER Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.5 The COMMON-LISP-USER Package

    + + + + + +

    The COMMON-LISP-USER package is the current package when +a Common Lisp system starts up. This package uses the COMMON-LISP package. +The COMMON-LISP-USER package has the nickname CL-USER. +

    +

    The COMMON-LISP-USER package can have additional symbols interned within it; +it can use other implementation-defined packages. +

    + + + + + diff --git a/info/gcl/The-Consing-Dot.html b/info/gcl/The-Consing-Dot.html new file mode 100644 index 0000000..5584fb0 --- /dev/null +++ b/info/gcl/The-Consing-Dot.html @@ -0,0 +1,59 @@ + + + + + +The Consing Dot (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpretation of Tokens  

    +
    +
    +

    2.3.3 The Consing Dot

    + +

    If a token consists solely of dots (with no escape characters), +then an error of type reader-error is signaled, +except in one circumstance: +if the token is a single dot +and appears in a situation where dotted pair notation permits a dot, +then it is accepted as part of such syntax and no error is signaled. +See Left-Parenthesis. +

    + + + + + diff --git a/info/gcl/The-Current-Readtable.html b/info/gcl/The-Current-Readtable.html new file mode 100644 index 0000000..eb744a3 --- /dev/null +++ b/info/gcl/The-Current-Readtable.html @@ -0,0 +1,62 @@ + + + + + +The Current Readtable (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Readtables  

    +
    +
    +

    2.1.1.1 The Current Readtable

    + +

    Several readtables describing different syntaxes can exist, +but at any given time only one, called the current readtable + +, +affects the way in which expressions_2 are parsed +into objects by the Lisp reader. +The current readtable in a given dynamic environment +is the value of *readtable* in that environment. +To make a different readtable become the current readtable, +*readtable* can be assigned or bound. +

    + + + + + diff --git a/info/gcl/The-Device-part-of-a-Logical-Pathname-Namestring.html b/info/gcl/The-Device-part-of-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..611b92a --- /dev/null +++ b/info/gcl/The-Device-part-of-a-Logical-Pathname-Namestring.html @@ -0,0 +1,55 @@ + + + + + +The Device part of a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.3 The Device part of a Logical Pathname Namestring

    + +

    There is no syntax for a logical pathname device since +the device component of a logical pathname is always :unspecific; +see Unspecific Components of a Logical Pathname. +

    + + + + + diff --git a/info/gcl/The-Directory-part-of-a-Logical-Pathname-Namestring.html b/info/gcl/The-Directory-part-of-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..bdc383f --- /dev/null +++ b/info/gcl/The-Directory-part-of-a-Logical-Pathname-Namestring.html @@ -0,0 +1,58 @@ + + + + + +The Directory part of a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.4 The Directory part of a Logical Pathname Namestring

    + +

    If a relative-directory-marker precedes the directories, +the directory component parsed is as relative; +otherwise, the directory component is parsed as absolute. +

    +

    If a wild-inferiors-marker is specified, +it parses into :wild-inferiors. +

    + + + + + diff --git a/info/gcl/The-EOF_002dERROR_002dP-argument.html b/info/gcl/The-EOF_002dERROR_002dP-argument.html new file mode 100644 index 0000000..4131ec1 --- /dev/null +++ b/info/gcl/The-EOF_002dERROR_002dP-argument.html @@ -0,0 +1,82 @@ + + + + + +The EOF-ERROR-P argument (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Conventions of Some Reader Functions  

    +
    +
    +

    23.1.3.1 The EOF-ERROR-P argument

    + +

    Eof-error-p in input function calls +controls what happens if input is from a file (or any other +input source that has a definite end) and the end of the file is reached. +If eof-error-p is true (the default), +an error of type end-of-file is signaled +at end of file. If it is false, then no error is signaled, and instead +the function returns eof-value. +

    +

    Functions such as read that read the representation +of an object rather than a single +character always signals an error, regardless of eof-error-p, if +the file ends in the middle of an object representation. +For example, if a file does +not contain enough right parentheses to balance the left parentheses in +it, read signals an error. If a file ends in a +symbol or a number +immediately followed by end-of-file, read reads the +symbol or +number +successfully and when called again will +act according to eof-error-p. +Similarly, the function read-line +successfully reads the last line of a file even if that line +is terminated by end-of-file rather than the newline character. +Ignorable text, such as lines containing only whitespace_2 or comments, +are not considered to begin an object; +if read begins to read an expression but sees only such +ignorable text, it does not consider the file to end in the middle of an object. +Thus an eof-error-p argument controls what happens +when the file ends between objects. +

    + + + + + diff --git a/info/gcl/The-Evaluation-Model.html b/info/gcl/The-Evaluation-Model.html new file mode 100644 index 0000000..5abee7a --- /dev/null +++ b/info/gcl/The-Evaluation-Model.html @@ -0,0 +1,84 @@ + + + + + +The Evaluation Model (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation  

    +
    +
    +

    3.1.2 The Evaluation Model

    + +

    A Common Lisp system evaluates forms with respect to lexical, +dynamic, and global environments. The following sections +describe the components of the Common Lisp evaluation model. +

    + + + + + + + + + + + + + + +
    • Form Evaluation   +
    • Symbols as Forms   +
    • Lexical Variables   +
    • Dynamic Variables   +
    • Constant Variables   +
    • Symbols Naming Both Lexical and Dynamic Variables   +
    • Conses as Forms   +
    • Special Forms   +
    • Macro Forms   +
    • Function Forms   +
    • Lambda Forms   +
    • Self-Evaluating Objects   +
    • Examples of Self-Evaluating Objects   +
    + + + + + + diff --git a/info/gcl/The-External-Environment.html b/info/gcl/The-External-Environment.html new file mode 100644 index 0000000..5ecb532 --- /dev/null +++ b/info/gcl/The-External-Environment.html @@ -0,0 +1,63 @@ + + + + + +The External Environment (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment  

    +
    +
    +

    25.1 The External Environment

    + + + + + + + +
    • Top level loop   +
    • Debugging Utilities   +
    • Environment Inquiry   +
    • Time   +
    + + + + + + diff --git a/info/gcl/The-Global-Environment.html b/info/gcl/The-Global-Environment.html new file mode 100644 index 0000000..13ac716 --- /dev/null +++ b/info/gcl/The-Global-Environment.html @@ -0,0 +1,78 @@ + + + + + +The Global Environment (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Environments  

    +
    +
    +

    3.1.1.1 The Global Environment

    + +

    The global environment + + is that part of an environment +that contains bindings with both indefinite scope +and indefinite extent. +The global environment contains, among other things, the following: +

    +
    +
    *
    +

    bindings of dynamic variables and constant variables. +

    +
    *
    +

    bindings of functions, macros, and special operators. +

    +
    *
    +
    +

    bindings of compiler macros. +

    +
    +
    *
    +

    bindings of type and class names +

    +
    *
    +

    information about proclamations. +

    +
    + + + + + + diff --git a/info/gcl/The-Host-part-of-a-Logical-Pathname-Namestring.html b/info/gcl/The-Host-part-of-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..28d38f9 --- /dev/null +++ b/info/gcl/The-Host-part-of-a-Logical-Pathname-Namestring.html @@ -0,0 +1,58 @@ + + + + + +The Host part of a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.2 The Host part of a Logical Pathname Namestring

    + +

    The host must have been defined as a logical pathname host; +this can be done by using setf of logical-pathname-translations. +

    +

    The logical pathname host name "SYS" is reserved for the implementation. +The existence and meaning of SYS: logical pathnames +is implementation-defined. +

    + + + + + diff --git a/info/gcl/The-Initial-Readtable.html b/info/gcl/The-Initial-Readtable.html new file mode 100644 index 0000000..c4925ea --- /dev/null +++ b/info/gcl/The-Initial-Readtable.html @@ -0,0 +1,62 @@ + + + + + +The Initial Readtable (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Readtables  

    +
    +
    +

    2.1.1.3 The Initial Readtable

    + +

    The initial readtable + + is +the readtable that is the current readtable +at the time when the Lisp image starts. +At that time, it conforms to standard syntax. +The initial readtable is distinct +from the standard readtable. +It is permissible for a conforming program +to modify the initial readtable. +

    + + + + + diff --git a/info/gcl/The-KEYWORD-Package.html b/info/gcl/The-KEYWORD-Package.html new file mode 100644 index 0000000..ef832d2 --- /dev/null +++ b/info/gcl/The-KEYWORD-Package.html @@ -0,0 +1,68 @@ + + + + + +The KEYWORD Package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Standardized Packages  

    +
    +
    +

    11.1.2.6 The KEYWORD Package

    + + + +

    The KEYWORD package contains symbols, called keywords_1, +that are typically used as special markers in programs +and their associated data expressions_1. +

    +

    Symbol tokens that start with a package marker +are parsed by the Lisp reader as symbols +in the KEYWORD package; see Symbols as Tokens. +This makes it notationally convenient to use keywords +when communicating between programs in different packages. +For example, the mechanism for passing keyword parameters in a call uses +keywords_1 to name the corresponding arguments; +see Ordinary Lambda Lists. +

    +

    Symbols in the KEYWORD package are, by definition, of type keyword. +

    + + + + + diff --git a/info/gcl/The-LOOP-Facility.html b/info/gcl/The-LOOP-Facility.html new file mode 100644 index 0000000..306ebd5 --- /dev/null +++ b/info/gcl/The-LOOP-Facility.html @@ -0,0 +1,73 @@ + + + + + +The LOOP Facility (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Iteration  

    +
    +
    +

    6.1 The LOOP Facility

    + + + + + + + + + + + + +
    • Overview of the Loop Facility   +
    • Variable Initialization and Stepping Clauses   +
    • Value Accumulation Clauses   +
    • Termination Test Clauses   +
    • Unconditional Execution Clauses   +
    • Conditional Execution Clauses   +
    • Miscellaneous Clauses   +
    • Examples of Miscellaneous Loop Features   +
    • Notes about Loop   +
    + + + + + + diff --git a/info/gcl/The-Lisp-Pretty-Printer.html b/info/gcl/The-Lisp-Pretty-Printer.html new file mode 100644 index 0000000..9590937 --- /dev/null +++ b/info/gcl/The-Lisp-Pretty-Printer.html @@ -0,0 +1,61 @@ + + + + + +The Lisp Pretty Printer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer  

    +
    +
    +

    22.2 The Lisp Pretty Printer

    + + + + + + +
    • Pretty Printer Concepts   +
    • Examples of using the Pretty Printer   +
    • Notes about the Pretty Printer`s Background   +
    + + + + + + diff --git a/info/gcl/The-Lisp-Printer.html b/info/gcl/The-Lisp-Printer.html new file mode 100644 index 0000000..32bfe14 --- /dev/null +++ b/info/gcl/The-Lisp-Printer.html @@ -0,0 +1,63 @@ + + + + + +The Lisp Printer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer  

    +
    +
    +

    22.1 The Lisp Printer

    + + + + + + + +
    • Overview of The Lisp Printer   +
    • Printer Dispatching   +
    • Default Print-Object Methods   +
    • Examples of Printer Behavior   +
    + + + + + + diff --git a/info/gcl/The-Null-Lexical-Environment.html b/info/gcl/The-Null-Lexical-Environment.html new file mode 100644 index 0000000..8a9e2dd --- /dev/null +++ b/info/gcl/The-Null-Lexical-Environment.html @@ -0,0 +1,60 @@ + + + + + +The Null Lexical Environment (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Introduction to Environments  

    +
    +
    +

    3.1.1.4 The Null Lexical Environment

    + +

    The null lexical environment + + is equivalent to the global environment. +

    +

    Although in general the representation of an environment object +is implementation-dependent, nil can be used in any situation where an +environment object is called for in order to denote +the null lexical environment. +

    + + + + + diff --git a/info/gcl/The-Pathname-Device-Component.html b/info/gcl/The-Pathname-Device-Component.html new file mode 100644 index 0000000..166e890 --- /dev/null +++ b/info/gcl/The-Pathname-Device-Component.html @@ -0,0 +1,54 @@ + + + + + +The Pathname Device Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pathname Components  

    +
    +
    +

    19.2.1.2 The Pathname Device Component

    + +

    Corresponds to the “device” or “file structure” concept in many +host file systems: the name of a logical or physical device containing files. +

    + + + + + diff --git a/info/gcl/The-Pathname-Directory-Component.html b/info/gcl/The-Pathname-Directory-Component.html new file mode 100644 index 0000000..18f82b9 --- /dev/null +++ b/info/gcl/The-Pathname-Directory-Component.html @@ -0,0 +1,54 @@ + + + + + +The Pathname Directory Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pathname Components  

    +
    +
    +

    19.2.1.3 The Pathname Directory Component

    + +

    Corresponds to the “directory” concept in many host file systems: +the name of a group of related files. +

    + + + + + diff --git a/info/gcl/The-Pathname-Host-Component.html b/info/gcl/The-Pathname-Host-Component.html new file mode 100644 index 0000000..48efed6 --- /dev/null +++ b/info/gcl/The-Pathname-Host-Component.html @@ -0,0 +1,54 @@ + + + + + +The Pathname Host Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pathname Components  

    +
    +
    +

    19.2.1.1 The Pathname Host Component

    + +

    The name of the file system on which the file resides, +or the name of a logical host. +

    + + + + + diff --git a/info/gcl/The-Pathname-Name-Component.html b/info/gcl/The-Pathname-Name-Component.html new file mode 100644 index 0000000..0621718 --- /dev/null +++ b/info/gcl/The-Pathname-Name-Component.html @@ -0,0 +1,54 @@ + + + + + +The Pathname Name Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pathname Components  

    +
    +
    +

    19.2.1.4 The Pathname Name Component

    + +

    The “name” part of a group of files that can be thought of +as conceptually related. +

    + + + + + diff --git a/info/gcl/The-Pathname-Type-Component.html b/info/gcl/The-Pathname-Type-Component.html new file mode 100644 index 0000000..75341b2 --- /dev/null +++ b/info/gcl/The-Pathname-Type-Component.html @@ -0,0 +1,55 @@ + + + + + +The Pathname Type Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Pathname Components  

    +
    +
    +

    19.2.1.5 The Pathname Type Component

    + +

    Corresponds to the “filetype” or “extension” concept in many host +file systems. This says what kind of file this is. +This component is always a string, nil, :wild, or :unspecific. +

    + + + + + diff --git a/info/gcl/The-Pathname-Version-Component.html b/info/gcl/The-Pathname-Version-Component.html new file mode 100644 index 0000000..ed85bcb --- /dev/null +++ b/info/gcl/The-Pathname-Version-Component.html @@ -0,0 +1,63 @@ + + + + + +The Pathname Version Component (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Pathname Components  

    +
    +
    +

    19.2.1.6 The Pathname Version Component

    + +

    Corresponds to the “version number” concept in many host file systems. +

    +

    The version is either a positive integer +or a symbol from the following list: +nil, :wild, :unspecific, or :newest +(refers to the largest version number that already exists in +the file system when reading a file, or to +a version number +greater than any already existing in the file system +when writing a new file). Implementations +can define other special version symbols. +

    + + + + + diff --git a/info/gcl/The-RECURSIVE_002dP-argument.html b/info/gcl/The-RECURSIVE_002dP-argument.html new file mode 100644 index 0000000..d97d328 --- /dev/null +++ b/info/gcl/The-RECURSIVE_002dP-argument.html @@ -0,0 +1,126 @@ + + + + + +The RECURSIVE-P argument (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Argument Conventions of Some Reader Functions  

    +
    +
    +

    23.1.3.2 The RECURSIVE-P argument

    + +

    If recursive-p is supplied and not nil, it specifies that +this function call is not an outermost call to read but an +embedded call, typically from a reader macro function. +It is important to distinguish such recursive calls for three reasons. +

    +
    +
    1.
    +

    An outermost call establishes the context within which the +#n= and #n# syntax is scoped. Consider, for example, +the expression +

    +
    +
     (cons '#3=(p q r) '(x y . #3#))
+
    + +

    If the single-quote reader macro were defined in this way: +

    +
    +
     (set-macro-character #\'       ;incorrect
+    #'(lambda (stream char)
+         (declare (ignore char))
+         (list 'quote (read stream))))
+
    + +

    then each call to the single-quote reader macro function would establish +independent contexts for the scope of read information, including the scope of +identifications between markers like “#3=” and “#3#”. However, for +this expression, the scope was clearly intended to be determined by the outer set +of parentheses, so such a definition would be incorrect. +The correct way to define the single-quote +reader macro uses recursive-p: +

    +
    +
     (set-macro-character #\'       ;correct
+    #'(lambda (stream char)
+         (declare (ignore char))
+         (list 'quote (read stream t nil t))))
+
    + +
    +
    2.
    +

    A recursive call does not alter whether the reading process +is to preserve whitespace_2 or not (as determined by whether the +outermost call was to read or read-preserving-whitespace). +Suppose again that single-quote +were to be defined as shown above in the incorrect definition. +Then a call to read-preserving-whitespace +that read the expression 'foo<Space> would fail to preserve the space +character following the symbol foo because the single-quote +reader macro function calls read, +not read-preserving-whitespace, +to read the following expression (in this case foo). +The correct definition, which passes the value true for recursive-p +to read, allows the outermost call to determine +whether whitespace_2 is preserved. +

    +
    +
    3.
    +

    When end-of-file is encountered and the eof-error-p argument +is not nil, the kind of error that is signaled may depend on the value +of recursive-p. If recursive-p +is true, then the end-of-file +is deemed to have occurred within the middle of a printed representation; +if recursive-p is false, then the end-of-file may be deemed to have +occurred between objects rather than within the middle of one. +

    +
    +
    + + +
    +
    +

    +Previous: , Up: Argument Conventions of Some Reader Functions  

    +
    + + + + + diff --git a/info/gcl/The-Standard-Readtable.html b/info/gcl/The-Standard-Readtable.html new file mode 100644 index 0000000..f63898d --- /dev/null +++ b/info/gcl/The-Standard-Readtable.html @@ -0,0 +1,61 @@ + + + + + +The Standard Readtable (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Readtables  

    +
    +
    +

    2.1.1.2 The Standard Readtable

    + +

    The standard readtable + + conforms to standard syntax. +The consequences are undefined if an attempt is made +to modify the standard readtable. +To achieve the effect of altering or extending standard syntax, +a copy of the standard readtable can be created; see the function copy-readtable. +

    +

    The readtable case of the standard readtable is :upcase. +

    + + + + + diff --git a/info/gcl/The-Type-part-of-a-Logical-Pathname-Namestring.html b/info/gcl/The-Type-part-of-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..34434a6 --- /dev/null +++ b/info/gcl/The-Type-part-of-a-Logical-Pathname-Namestring.html @@ -0,0 +1,55 @@ + + + + + +The Type part of a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.5 The Type part of a Logical Pathname Namestring

    + +

    The type of a logical pathname for a source file +is "LISP". This should be translated into whatever type is +appropriate in a physical pathname. +

    + + + + + diff --git a/info/gcl/The-Version-part-of-a-Logical-Pathname-Namestring.html b/info/gcl/The-Version-part-of-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..b86ae09 --- /dev/null +++ b/info/gcl/The-Version-part-of-a-Logical-Pathname-Namestring.html @@ -0,0 +1,60 @@ + + + + + +The Version part of a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.6 The Version part of a Logical Pathname Namestring

    + +

    Some file systems do not have versions. +Logical pathname translation to such a file system +ignores the version. +This implies that a program cannot rely on being able to store +more than one version of a file named by a logical pathname. +

    +

    If a wildcard-version is specified, +it parses into :wild. +

    + + + + + diff --git a/info/gcl/The-_0022Affected-By_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Affected-By_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..0a45071 --- /dev/null +++ b/info/gcl/The-_0022Affected-By_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,57 @@ + + + + + +The "Affected By" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.1 The "Affected By" Section of a Dictionary Entry

    + +

    For an operator, anything that can affect the side effects of +or values returned by the operator. +

    +

    For a variable, anything that can affect the value of the variable +including functions that bind or assign it. +

    + + + + + diff --git a/info/gcl/The-_0022Argument-Precedence-Order_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Argument-Precedence-Order_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..d987092 --- /dev/null +++ b/info/gcl/The-_0022Argument-Precedence-Order_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,54 @@ + + + + + +The "Argument Precedence Order" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.16 The "Argument Precedence Order" Section of a Dictionary Entry

    + +

    This information describes the argument precedence order. +If it is omitted, the argument precedence order is the default (left to right). +

    + + + + + diff --git a/info/gcl/The-_0022Arguments-and-Values_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Arguments-and-Values_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..f10b125 --- /dev/null +++ b/info/gcl/The-_0022Arguments-and-Values_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,59 @@ + + + + + +The "Arguments and Values" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.3 The "Arguments and Values" Section of a Dictionary Entry

    + +

    An English language description of what arguments the operator accepts +and what values it returns, including information about defaults for parameters +corresponding to omittable arguments +(such as optional parameters and keyword parameters). +For special operators and macros, +their arguments are not evaluated unless it is explicitly stated in their +descriptions that they are evaluated. +

    + + + + + diff --git a/info/gcl/The-_0022Arguments_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Arguments_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..a2ff5fd --- /dev/null +++ b/info/gcl/The-_0022Arguments_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,55 @@ + + + + + +The "Arguments" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.2 The "Arguments" Section of a Dictionary Entry

    + +

    This information describes the syntax information of entries such as those for +declarations and special expressions which are never evaluated +as forms, and so do not return values. +

    + + + + + diff --git a/info/gcl/The-_0022Binding-Types-Affected_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Binding-Types-Affected_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..0d184dc --- /dev/null +++ b/info/gcl/The-_0022Binding-Types-Affected_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,56 @@ + + + + + +The "Binding Types Affected" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.4 The "Binding Types Affected" Section of a Dictionary Entry

    + +

    This information alerts the reader to the kinds of bindings that might +potentially be affected by a declaration. Whether in fact any particular such +binding is actually affected is dependent on additional factors as well. +See The "Description" Section of the declaration in question for details. +

    + + + + + diff --git a/info/gcl/The-_0022Class-Precedence-List_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Class-Precedence-List_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..44c80f8 --- /dev/null +++ b/info/gcl/The-_0022Class-Precedence-List_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,72 @@ + + + + + +The "Class Precedence List" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.5 The "Class Precedence List" Section of a Dictionary Entry

    + +

    This appears in the dictionary entry for a class, +and contains an ordered list of the classes defined +by Common Lisp that must be in the class precedence list of this class. +

    +

    It is permissible for other (implementation-defined) classes +to appear in the implementation’s class precedence list for the class. +

    +

    It is permissible for + either standard-object + or structure-object +to appear in the implementation’s class precedence list; +for details, see Type Relationships. +

    +

    Except as explicitly indicated otherwise somewhere in this specification, +no additional standardized classes may appear in +the implementation’s class precedence list. +

    +

    By definition of the relationship between classes and types, +the classes listed in this section are also supertypes of +the type denoted by the class. +

    + + + + + diff --git a/info/gcl/The-_0022Compound-Type-Specifier-Arguments_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Compound-Type-Specifier-Arguments_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..ce8a96c --- /dev/null +++ b/info/gcl/The-_0022Compound-Type-Specifier-Arguments_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,54 @@ + + + + + +The "Compound Type Specifier Arguments" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.9 The "Compound Type Specifier Arguments" Section of a Dictionary Entry

    + +

    This information describes type information for the structures defined in +The "Compound Type Specifier Syntax" Section. +

    + + + + + diff --git a/info/gcl/The-_0022Compound-Type-Specifier-Description_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Compound-Type-Specifier-Description_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..a49c39d --- /dev/null +++ b/info/gcl/The-_0022Compound-Type-Specifier-Description_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,54 @@ + + + + + +The "Compound Type Specifier Description" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.10 The "Compound Type Specifier Description" Section of a Dictionary Entry

    + +

    This information describes the meaning of the structures defined in +The "Compound Type Specifier Syntax" Section. +

    + + + + + diff --git a/info/gcl/The-_0022Compound-Type-Specifier-Kind_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Compound-Type-Specifier-Kind_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..0aaff26 --- /dev/null +++ b/info/gcl/The-_0022Compound-Type-Specifier-Kind_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,66 @@ + + + + + +The "Compound Type Specifier Kind" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.7 The "Compound Type Specifier Kind" Section of a Dictionary Entry

    + +

    An “abbreviating” type specifier is one that describes a subtype +for which it is in principle possible to enumerate the elements, +but for which in practice it is impractical to do so. +

    +

    A “specializing” type specifier is one that describes a subtype +by restricting the type of one or more components of the type, +such as element type or complex part type. +

    +

    A “predicating” type specifier is one that describes a subtype +containing only those objects that satisfy a given predicate. +

    +

    A “combining” type specifier is one that describes a subtype +in a compositional way, using combining operations (such as “and,” “or,” and +“not”) on other types. +

    + + + + + diff --git a/info/gcl/The-_0022Compound-Type-Specifier-Syntax_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Compound-Type-Specifier-Syntax_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..5527ea7 --- /dev/null +++ b/info/gcl/The-_0022Compound-Type-Specifier-Syntax_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,57 @@ + + + + + +The "Compound Type Specifier Syntax" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.8 The "Compound Type Specifier Syntax" Section of a Dictionary Entry

    + +

    This information about a type describes the syntax of a +compound type specifier for that type. +

    +

    Whether or not the type is acceptable as an atomic type specifier +is not represented here; see Dictionary Entries for Type Specifiers. +

    + + + + + diff --git a/info/gcl/The-_0022Constant-Value_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Constant-Value_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..5d88842 --- /dev/null +++ b/info/gcl/The-_0022Constant-Value_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,54 @@ + + + + + +The "Constant Value" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.11 The "Constant Value" Section of a Dictionary Entry

    + +

    This information describes the unchanging type and value of +a constant variable. +

    + + + + + diff --git a/info/gcl/The-_0022Description_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Description_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..cd4e7d3 --- /dev/null +++ b/info/gcl/The-_0022Description_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,55 @@ + + + + + +The "Description" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.12 The "Description" Section of a Dictionary Entry

    + +

    A summary of the operator and all intended aspects of the operator, +but does not necessarily include all the fields referenced below it +(“Side Effects,” “Exceptional Situations,” etc.) +

    + + + + + diff --git a/info/gcl/The-_0022Examples_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Examples_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..e791d26 --- /dev/null +++ b/info/gcl/The-_0022Examples_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,55 @@ + + + + + +The "Examples" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.13 The "Examples" Section of a Dictionary Entry

    + +

    Examples of use of the operator. +These examples are not considered part of the standard; +see Sections Not Formally Part Of This Standard. +

    + + + + + diff --git a/info/gcl/The-_0022Exceptional-Situations_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Exceptional-Situations_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..95b64c7 --- /dev/null +++ b/info/gcl/The-_0022Exceptional-Situations_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,69 @@ + + + + + +The "Exceptional Situations" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.14 The "Exceptional Situations" Section of a Dictionary Entry

    + +

    Three kinds of information may appear here: +

    +
    *
    +

    Situations that are detected by the function and formally signaled. +

    +
    *
    +

    Situations that are handled by the function. +

    +
    *
    +

    Situations that may be detected by the function. +

    +
    + +

    This field does not include conditions that could +be signaled by functions passed to and called by this operator +as arguments or through dynamic variables, nor by executing subforms of this +operator if it is a macro or special operator. +

    + + + + + diff --git a/info/gcl/The-_0022Initial-Value_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Initial-Value_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..40b2445 --- /dev/null +++ b/info/gcl/The-_0022Initial-Value_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,54 @@ + + + + + +The "Initial Value" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.15 The "Initial Value" Section of a Dictionary Entry

    + +

    This information describes the initial value of a dynamic variable. +Since this variable might change, see type restrictions in The "Value Type" Section. +

    + + + + + diff --git a/info/gcl/The-_0022Method-Signature_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Method-Signature_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..c88178c --- /dev/null +++ b/info/gcl/The-_0022Method-Signature_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,79 @@ + + + + + +The "Method Signature" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.17 The "Method Signature" Section of a Dictionary Entry

    + +

    The description of a generic function includes descriptions of the +methods that are defined on that generic function by the standard. +A method signature is used to describe the parameters and +parameter specializers for each method. +Methods defined for the generic function must be of the form described +by the method signature. +

    +

    F (x class) + (y t) + &optional z &key k +

    +

    This signature indicates that this method on the generic function +F has two required parameters: + x, which must be a generalized instance of the class class; + and y, which can be any object + (i.e., a generalized instance of the class t). +In addition, there is an optional parameter z and a +keyword parameter k. This signature also indicates that this +method on F is a primary method and has no qualifiers. +

    +

    For each parameter, the argument supplied must be in the +intersection of the type specified in the description of the +corresponding generic function and the type given in +the signature of some method (including not only those +methods defined in this specification, but also +implementation-defined or user-defined methods in situations +where the definition of such methods is permitted). +

    + + + + + diff --git a/info/gcl/The-_0022Name_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Name_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..02a0eb1 --- /dev/null +++ b/info/gcl/The-_0022Name_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,145 @@ + + + + + +The "Name" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.18 The "Name" Section of a Dictionary Entry

    + +

    This section introduces the dictionary entry. It is not explicitly labeled. +It appears preceded and followed by a horizontal bar. +

    +

    In large print at left, the defined name appears; if more than one +defined name is to be described by the entry, all such names +are shown separated by commas. +

    +

    In somewhat smaller italic print at right is an indication of what kind +of dictionary entry this is. Possible values are: +

    +
    +
    Accessor
    +

    This is an accessor function. +

    +
    +
    Class
    +

    This is a class. +

    +
    +
    Condition Type
    +

    This is a subtype of type condition. +

    +
    +
    Constant Variable
    +

    This is a constant variable. +

    +
    +
    Declaration
    +

    This is a declaration identifier. +

    +
    +
    Function
    +

    This is a function. +

    +
    +
    Local Function
    +

    This is a function that is defined only lexically within the scope of some +other macro form. +

    +
    +
    Local Macro
    +

    This is a macro that is defined only lexically within the scope of some +other macro form. +

    +
    +
    Macro
    +

    This is a macro. +

    +
    +
    Restart
    +

    This is a restart. +

    +
    +
    Special Operator
    +

    This is a special operator. +

    +
    +
    Standard Generic Function
    +

    This is a standard generic function. +

    +
    +
    Symbol
    +

    This is a symbol that is specially recognized in some particular situation, +such as the syntax of a macro. +

    +
    +
    System Class
    +

    This is like class, but it identifies a class that is potentially +a built-in class. (No class is actually required to be a +built-in class.) +

    +
    +
    Type
    +

    This is an atomic type specifier, +and depending on information for each particular entry, +may subject to form other type specifiers. +

    +
    +
    Type Specifier
    +

    This is a defined name that is not an atomic type specifier, +but that can be used in constructing valid type specifiers. +

    +
    +
    Variable
    +

    This is a dynamic variable. +

    +
    +
    + +
    +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    + + + + + diff --git a/info/gcl/The-_0022Notes_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Notes_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..63c761a --- /dev/null +++ b/info/gcl/The-_0022Notes_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,63 @@ + + + + + +The "Notes" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.19 The "Notes" Section of a Dictionary Entry

    + +

    Information not found elsewhere in this description +which pertains to this operator. +Among other things, this might include + cross reference information, + code equivalences, + stylistic hints, + implementation hints, + typical uses. +This information is not considered part of the standard; +any conforming implementation or conforming program +is permitted to ignore the presence of this information. +

    + + + + + diff --git a/info/gcl/The-_0022Pronunciation_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Pronunciation_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..5c5c56d --- /dev/null +++ b/info/gcl/The-_0022Pronunciation_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,59 @@ + + + + + +The "Pronunciation" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.20 The "Pronunciation" Section of a Dictionary Entry

    + +

    This offers a suggested pronunciation for defined names +so that people not in verbal communication with the original designers +can figure out how to pronounce words that are not in normal English usage. +This information is advisory only, and is not considered part of the standard. +For brevity, it is only provided for entries with names that are specific to +Common Lisp and would not be found in Webster’s Third New International Dictionary + the English Language, Unabridged. +

    + + + + + diff --git a/info/gcl/The-_0022See-Also_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022See-Also_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..b7206bd --- /dev/null +++ b/info/gcl/The-_0022See-Also_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,55 @@ + + + + + +The "See Also" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.21 The "See Also" Section of a Dictionary Entry

    + +

    List of references to other parts of this standard +that offer information relevant to this operator. +This list is not part of the standard. +

    + + + + + diff --git a/info/gcl/The-_0022Side-Effects_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Side-Effects_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..bab3fa1 --- /dev/null +++ b/info/gcl/The-_0022Side-Effects_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,54 @@ + + + + + +The "Side Effects" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.22 The "Side Effects" Section of a Dictionary Entry

    + +

    Anything that is changed as a result of the +evaluation of the form containing this operator. +

    + + + + + diff --git a/info/gcl/The-_0022Supertypes_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Supertypes_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..48659bb --- /dev/null +++ b/info/gcl/The-_0022Supertypes_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,59 @@ + + + + + +The "Supertypes" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.23 The "Supertypes" Section of a Dictionary Entry

    + +

    This appears in the dictionary entry for a type, +and contains a list of the standardized types +that must be supertypes of this type. +

    +

    In implementations where there is a corresponding class, +the order of the classes in the class precedence list +is consistent with the order presented in this section. +

    + + + + + diff --git a/info/gcl/The-_0022Syntax_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Syntax_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..fa357d3 --- /dev/null +++ b/info/gcl/The-_0022Syntax_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,76 @@ + + + + + +The "Syntax" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.24 The "Syntax" Section of a Dictionary Entry

    + +

    This section describes how to use the defined name in code. +The "Syntax” description for a generic function +describes the lambda list of the generic function itself, +while The "Method Signatures” describe the lambda lists +of the defined methods. +The "Syntax” description for + an ordinary function, + a macro, + or a special operator +describes its parameters. +

    +

    For example, an operator description might say: +

    +

    F x y &optional z &key k +

    +

    This description indicates that the function F +has two required parameters, x and y. In addition, +there is an optional parameter z and a keyword parameter k. +

    +

    For macros and special operators, syntax is given +in modified BNF notation; see Modified BNF Syntax. +For functions a lambda list is given. +In both cases, however, the outermost parentheses are omitted, +and default value information is omitted. +

    + + + + + diff --git a/info/gcl/The-_0022Valid-Context_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Valid-Context_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..841f205 --- /dev/null +++ b/info/gcl/The-_0022Valid-Context_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,59 @@ + + + + + +The "Valid Context" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.31 The "Valid Context" Section of a Dictionary Entry

    + +

    This information is used by dictionary entries such as “Declarations” +in order to restrict the context in which the declaration may appear. +

    +

    A given “Declaration” might appear in + a declaration (i.e., a declare expression), + a proclamation (i.e., a declaim or proclaim form), + or both. +

    + + + + + diff --git a/info/gcl/The-_0022Value-Type_0022-Section-of-a-Dictionary-Entry.html b/info/gcl/The-_0022Value-Type_0022-Section-of-a-Dictionary-Entry.html new file mode 100644 index 0000000..c67b048 --- /dev/null +++ b/info/gcl/The-_0022Value-Type_0022-Section-of-a-Dictionary-Entry.html @@ -0,0 +1,54 @@ + + + + + +The "Value Type" Section of a Dictionary Entry (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.32 The "Value Type" Section of a Dictionary Entry

    + +

    This information describes any type restrictions on a dynamic variable. +

    + + + + + + diff --git a/info/gcl/The-for_002das_002dacross-subclause.html b/info/gcl/The-for_002das_002dacross-subclause.html new file mode 100644 index 0000000..71e1df1 --- /dev/null +++ b/info/gcl/The-for_002das_002dacross-subclause.html @@ -0,0 +1,61 @@ + + + + + +The for-as-across subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.10 The for-as-across subclause

    + +

    In the for-as-across subclause the for + or as construct binds the variable var to the value of + each element in the array vector. + The loop keyword across marks the array vector; across + is used as a preposition in this syntax. + Iteration stops when there are no more elements in the supplied + array that can be referenced. + Some implementations might recognize a the special form + in the vector form to produce more efficient code. +

    + + + + + diff --git a/info/gcl/The-for_002das_002darithmetic-subclause.html b/info/gcl/The-for_002das_002darithmetic-subclause.html new file mode 100644 index 0000000..5adb3be --- /dev/null +++ b/info/gcl/The-for_002das_002darithmetic-subclause.html @@ -0,0 +1,167 @@ + + + + + +The for-as-arithmetic subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.2 The for-as-arithmetic subclause

    + +

    In the for-as-arithmetic subclause, the for +or as construct iterates from the value supplied by +form1 to the value supplied by form2 in increments or +decrements denoted by form3. Each +expression is evaluated only once and must evaluate to a number. +The variable var is bound to the value of +form1 in the first iteration and is stepped_1 +by the value of form3 in each succeeding iteration, +or by 1 if form3 is not provided. +The following loop keywords serve as valid prepositions within this +syntax. +At least one of the +prepositions must be used; +and at most one from each line may be used in a single subclause. +

    +
    +
    from | downfrom | upfrom
    +
    to | downto | upto | below | above
    +
    by
    +
    + +

    The prepositional phrases in each subclause may appear in any order. +For example, either “from x by y” or “by y from x” is permitted. +However, because left-to-right order of evaluation is preserved, +the effects will be different in the case of side effects. +

    + + + + +

    Consider: +

    +
    +
    (let ((x 1)) (loop for i from x by (incf x) to 10 collect i))
+⇒  (1 3 5 7 9)
+(let ((x 1)) (loop for i by (incf x) from x to 10 collect i))
+⇒  (2 4 6 8 10)
+
    + +

    The descriptions of the prepositions follow: +

    +
    +
    from
    +

    The loop keyword from specifies the value from which +stepping_1 begins, as supplied by form1. +Stepping_1 is incremental by default. If +decremental stepping_1 is desired, +the preposition downto +or above must be used with form2. For incremental +stepping_1, the default from value is 0. +

    +
    +
    downfrom, upfrom
    +

    The loop keyword downfrom +indicates that the variable var is decreased in decrements +supplied by form3; the loop keyword upfrom indicates that +var is increased in increments supplied by form3. +

    +
    +
    to
    +

    The loop keyword to marks the end value +for stepping_1 supplied in form2. +Stepping_1 is incremental by default. +If decremental stepping_1 is desired, +the preposition downfrom must be used with form1, +or else the preposition downto or above should be used instead + of to with form2. +

    +
    +
    downto, upto
    +

    The loop keyword downto specifies decremental stepping; +the loop keyword upto specifies incremental stepping. +In both cases, the amount of change on each step is specified by form3, +and the loop terminates when the variable var passes +the value of form2. +Since there is no default for form1 in decremental stepping_1, +a form1 value must be supplied (using from or downfrom) +when downto is supplied. +

    +
    +
    below, above
    +

    The loop keywords below and above are analogous to +upto and downto respectively. These keywords stop +iteration just before the value of the variable var reaches the value +supplied by form2; the end value of form2 is not included. +Since there is no default for form1 in decremental stepping_1, +a form1 value must be supplied (using from or downfrom) +when above is supplied. +

    +
    +
    by
    +

    The loop keyword by marks the increment or decrement supplied by +form3. The value of form3 can be any +positive +number. +The default value is 1. +

    +
    +
    + +

    In an iteration control clause, the for or as construct +causes termination when the supplied limit is reached. That is, +iteration continues until the value var is stepped to the +exclusive or inclusive limit supplied by form2. The range is +exclusive if form3 increases or decreases var +to the value of form2 without reaching that value; the loop +keywords below and above provide exclusive limits. An +inclusive limit allows var to attain the value of +form2; to, downto, and upto provide inclusive +limits. +

    +
    +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    + + + + + diff --git a/info/gcl/The-for_002das_002dequals_002dthen-subclause.html b/info/gcl/The-for_002das_002dequals_002dthen-subclause.html new file mode 100644 index 0000000..510721c --- /dev/null +++ b/info/gcl/The-for_002das_002dequals_002dthen-subclause.html @@ -0,0 +1,64 @@ + + + + + +The for-as-equals-then subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.8 The for-as-equals-then subclause

    + +

    In the for-as-equals-then subclause +the for +or as construct +initializes the variable var by setting it to the + result of evaluating form1 on the first iteration, then setting + it to the result of evaluating form2 on the second and + subsequent iterations. If form2 is omitted, the construct + uses form1 on the second and + subsequent iterations. +The loop keywords = and then serve as valid prepositions +in this syntax. +This construct does not provide any termination tests. +

    + + + + + diff --git a/info/gcl/The-for_002das_002dhash-subclause.html b/info/gcl/The-for_002das_002dhash-subclause.html new file mode 100644 index 0000000..1e82fa7 --- /dev/null +++ b/info/gcl/The-for_002das_002dhash-subclause.html @@ -0,0 +1,126 @@ + + + + + +The for-as-hash subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.12 The for-as-hash subclause

    + +

    In the for-as-hash subclause + the for + or as construct + iterates over the elements, keys, and values of a hash-table. + In this syntax, a compound preposition is used to designate access to a + hash table. + The variable var takes on the value of each hash key + or hash value in the supplied hash-table. + The following loop keywords serve as valid prepositions within this syntax: +

    +
    +
    being
    +

    The keyword being introduces either the Loop schema +hash-key or hash-value. +

    +
    +
    each, the
    +

    The loop keyword each +follows the loop keyword being when hash-key or +hash-value is used. The loop keyword the is used with +hash-keys and hash-values only for ease of reading. +This agreement isn’t required. +

    +
    +
    hash-key, hash-keys
    +

    These loop keywords access each key entry of the hash table. If +the name hash-value is supplied in a using construct with one +of these Loop schemas, the iteration can optionally access the keyed +value. The order in which the keys are accessed is undefined; empty +slots in the hash table are ignored. +

    +
    +
    hash-value, hash-values
    +

    These loop keywords access each value entry of a +hash table. If +the name hash-key is supplied in a using construct with one of +these Loop schemas, the iteration can optionally access the key that +corresponds to the value. The order in which the keys are accessed is +undefined; empty slots in the hash table are ignored. +

    +
    +
    using
    +

    The loop keyword using introduces +the optional key or the keyed value to +be accessed. It allows access to the hash key if iteration is over +the hash values, and the hash value if +iteration is over the hash keys. +

    +
    +
    in, of
    +

    These loop prepositions introduce hash-table. +

    +
    +
    + +

    In effect +

    +

    being +{each | the} +{hash-value | + hash-values | + hash-key | + hash-keys} +{in | of} +

    +

    is a compound preposition. +

    +

    Iteration stops when there are no more hash keys or hash values to be +referenced in the supplied hash-table. +

    +
    +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    + + + + + diff --git a/info/gcl/The-for_002das_002din_002dlist-subclause.html b/info/gcl/The-for_002das_002din_002dlist-subclause.html new file mode 100644 index 0000000..32dec70 --- /dev/null +++ b/info/gcl/The-for_002das_002din_002dlist-subclause.html @@ -0,0 +1,66 @@ + + + + + +The for-as-in-list subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.4 The for-as-in-list subclause

    + +

    In the for-as-in-list subclause, +the for +or as construct iterates over the contents of a +list. It checks for +the end of the list as if by using endp. +The variable var is bound to the successive elements of +the list in form1 before each +iteration. At the end of each iteration, the function step-fun +is applied to the list; the default value for step-fun is +cdr. +The loop keywords in and by serve as valid prepositions in +this syntax. +The for or as construct causes termination when the +end of the list is reached. +

    + + + + + diff --git a/info/gcl/The-for_002das_002don_002dlist-subclause.html b/info/gcl/The-for_002das_002don_002dlist-subclause.html new file mode 100644 index 0000000..5d3d9a4 --- /dev/null +++ b/info/gcl/The-for_002das_002don_002dlist-subclause.html @@ -0,0 +1,65 @@ + + + + + +The for-as-on-list subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.6 The for-as-on-list subclause

    + +

    In the for-as-on-list subclause, the for or as +construct iterates over +a list. It checks for the +end of the list as if by using atom. +

    +

    The variable var is bound to the successive tails of the +list in +form1. At the end of each iteration, the function step-fun + is applied to the list; the default value for step-fun is cdr. + The loop keywords on and by serve as valid +prepositions in this syntax. +The for or as construct causes termination when the +end of the list is reached. +

    + + + + + diff --git a/info/gcl/The-for_002das_002dpackage-subclause.html b/info/gcl/The-for_002das_002dpackage-subclause.html new file mode 100644 index 0000000..d729bad --- /dev/null +++ b/info/gcl/The-for_002das_002dpackage-subclause.html @@ -0,0 +1,138 @@ + + + + + +The for-as-package subclause (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    +
    +

    6.1.2.13 The for-as-package subclause

    + +

    In the for-as-package subclause +the for +or as construct +iterates over the symbols in a package. +In this syntax, a compound preposition is used to designate access to a +package. +The variable var takes on the value of each symbol +in the supplied package. + The following loop keywords serve as valid prepositions within this syntax: +

    +
    +
    being
    +

    The keyword being introduces either the Loop schema +symbol, present-symbol, or external-symbol. +

    +
    +
    each, the
    +

    The loop keyword each +follows the loop keyword being when symbol, +present-symbol, or external-symbol is used. +The loop keyword the is used with symbols, +present-symbols, and external-symbols only for ease of reading. +This agreement isn’t required. +

    +
    +
    present-symbol, present-symbols
    +

    These Loop schemas iterate over the symbols +

    +

    that are present in a package. +

    +

    The package to be iterated over is supplied in the same way +that package arguments to find-package are supplied. +If the package for the iteration is not supplied, +the current package is used. +If a package that does not exist is supplied, +an error of type package-error is signaled. +

    +
    +
    symbol, symbols
    +

    These Loop schemas iterate over symbols that are +accessible in a given package. +The package to be iterated over is supplied in the same way +that package arguments to find-package are supplied. +If the package for the iteration is not supplied, +the current package is used. +If a package that does not exist is supplied, +an error of type package-error is signaled. +

    +
    +
    external-symbol, external-symbols
    +

    These Loop schemas iterate over the external symbols of a package. +The package to be iterated over is supplied in the same way +that package arguments to find-package are supplied. +If the package for the iteration is not supplied, +the current package is used. +If a package that does not exist is supplied, +an error of type package-error is signaled. +

    +
    +
    in, of
    +

    These loop prepositions introduce package. +

    +
    +
    + +

    In effect +

    +

    being +{each | the} +{symbol | + symbols | + present-symbol | + present-symbols | + external-symbol | + external-symbols} +{in | of} +

    +

    is a compound preposition. +

    +

    Iteration stops when there are no more symbols to be referenced +in the supplied package. +

    +
    +
    +

    +Next: , Previous: , Up: Variable Initialization and Stepping Clauses  

    +
    + + + + + diff --git a/info/gcl/Tilde-A_002d_003e-Aesthetic.html b/info/gcl/Tilde-A_002d_003e-Aesthetic.html new file mode 100644 index 0000000..f1d5824 --- /dev/null +++ b/info/gcl/Tilde-A_002d_003e-Aesthetic.html @@ -0,0 +1,80 @@ + + + + + +Tilde A-> Aesthetic (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Printer Operations  

    +
    +
    +

    22.3.4.1 Tilde A: Aesthetic

    + +

    An arg, any object, +is printed without escape characters +(as by princ). If arg is a string, +its characters +will be output verbatim. +If arg is nil it will be printed as nil; +the colon modifier (~:A) will cause an arg of nil to be printed as (), +but if arg is a composite structure, such as a list or vector, +any contained occurrences of nil will still be printed as nil. +

    +

    ~mincolA inserts spaces on the right, if necessary, to make the +width at least mincol columns. The @ +modifier causes the spaces +to be inserted on the left rather than the right. +

    +

    ~mincol,colinc,minpad,padcharA +is the full form of ~A, +which allows control of the padding. +The string is padded on the right (or on the left if the +@ modifier is used) with at least minpad copies +of padchar; padding characters are then inserted colinc characters +at a time until the total width is at least mincol. +The defaults are 0 for mincol and minpad, 1 for colinc, +and the space character for padchar. +

    +

    ~A binds *print-escape* to false, +

    +

    and *print-readably* to false. +

    + + + + + diff --git a/info/gcl/Tilde-Ampersand_002d_003e-Fresh_002dLine.html b/info/gcl/Tilde-Ampersand_002d_003e-Fresh_002dLine.html new file mode 100644 index 0000000..d96964a --- /dev/null +++ b/info/gcl/Tilde-Ampersand_002d_003e-Fresh_002dLine.html @@ -0,0 +1,58 @@ + + + + + +Tilde Ampersand-> Fresh-Line (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Basic Output  

    +
    +
    +

    22.3.1.3 Tilde Ampersand: Fresh-Line

    + +

    Unless it can be determined that the output stream +is already at the beginning of a line, +this outputs a newline. +~n& calls fresh-line +and then outputs n- 1 newlines. +~0& does nothing. +

    + + + + + diff --git a/info/gcl/Tilde-Asterisk_002d_003e-Go_002dTo.html b/info/gcl/Tilde-Asterisk_002d_003e-Go_002dTo.html new file mode 100644 index 0000000..fc00efa --- /dev/null +++ b/info/gcl/Tilde-Asterisk_002d_003e-Go_002dTo.html @@ -0,0 +1,70 @@ + + + + + +Tilde Asterisk-> Go-To (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Control-Flow Operations  

    +
    +
    +

    22.3.7.1 Tilde Asterisk: Go-To

    + +

    The next arg is ignored. +~n* ignores the next n arguments. +

    +

    ~:* backs up in the list of +arguments so that the argument last processed will be processed again. +~n:* backs up n arguments. +

    +

    When within a ~{ construct +(see below), the ignoring (in either direction) is relative to the list +of arguments being processed by the iteration. +

    +

    ~n@* +goes to the nth arg, where 0 means the first one; +n defaults to 0, so ~@* goes back to the first arg. +Directives after a ~n@* +will take arguments in sequence beginning with the one gone to. +When within a ~{ construct, the “goto” +is relative to the list of arguments being processed by the iteration. +

    + + + + + diff --git a/info/gcl/Tilde-B_002d_003e-Binary.html b/info/gcl/Tilde-B_002d_003e-Binary.html new file mode 100644 index 0000000..559954e --- /dev/null +++ b/info/gcl/Tilde-B_002d_003e-Binary.html @@ -0,0 +1,62 @@ + + + + + +Tilde B-> Binary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Radix Control  

    +
    +
    +

    22.3.2.3 Tilde B: Binary

    + +

    This is just like ~D but prints in binary radix (radix 2) +instead of decimal. The full form is therefore +~mincol,padchar,commachar,comma-intervalB. +

    +

    ~B binds + *print-escape* to false, + *print-radix* to false, + *print-base* to 2, +

    +

    and *print-readably* to false. +

    + + + + + diff --git a/info/gcl/Tilde-C_002d_003e-Character.html b/info/gcl/Tilde-C_002d_003e-Character.html new file mode 100644 index 0000000..20a63fa --- /dev/null +++ b/info/gcl/Tilde-C_002d_003e-Character.html @@ -0,0 +1,108 @@ + + + + + +Tilde C-> Character (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Basic Output  

    +
    +
    +

    22.3.1.1 Tilde C: Character

    + +

    The next arg should be a character; +it is printed +according to the modifier flags. +

    +

    ~C prints the character +as if by using write-char if it is a simple character. +Characters that are not simple +are not necessarily printed as if by write-char, +but are displayed in an implementation-defined, abbreviated format. +For example, +

    +
    +
     (format nil "~C" #\A) ⇒  "A"
+ (format nil "~C" #\Space) ⇒  " "
+
    + +

    ~:C is the same as ~C for printing characters, +but other characters are “spelled out.” The intent is that this +is a “pretty” format for printing characters. +For simple characters that are not printing, +what is spelled out is the name of the character (see char-name). +For characters that are not simple and not printing, +what is spelled out is implementation-defined. +For example, +

    +
    +
     (format nil "~:C" #\A) ⇒  "A"
+ (format nil "~:C" #\Space) ⇒  "Space"
+;; This next example assumes an implementation-defined "Control" attribute.
+ (format nil "~:C" #\Control-Space)
+⇒  "Control-Space"
+OR⇒ "c-Space"
+
    + +

    ~:@C prints what ~:C would, and then +if the character requires unusual shift keys on the keyboard to type it, +this fact is mentioned. For example, +

    +
    +
     (format nil "~:@C" #\Control-Partial) ⇒  "Control-\partial (Top-F)"  
+
    + +

    This is the format used for telling the user about a key he is expected to type, +in prompts, for instance. The precise output may depend not only +on the implementation, but on the particular I/O devices in use. +

    +

    ~@C +prints the character in a way that the Lisp reader can understand, +using #\ syntax. +

    +

    ~@C binds *print-escape* to t. +

    +
    +
    +

    +Next: , Previous: , Up: FORMAT Basic Output  

    +
    + + + + + diff --git a/info/gcl/Tilde-Circumflex_002d_003e-Escape-Upward.html b/info/gcl/Tilde-Circumflex_002d_003e-Escape-Upward.html new file mode 100644 index 0000000..ff606ba --- /dev/null +++ b/info/gcl/Tilde-Circumflex_002d_003e-Escape-Upward.html @@ -0,0 +1,151 @@ + + + + + +Tilde Circumflex-> Escape Upward (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Miscellaneous Pseudo-Operations  

    +
    +
    +

    22.3.9.2 Tilde Circumflex: Escape Upward

    + +

    ~^ +

    +

    This is an escape construct. If there are no more arguments remaining to +be processed, then the immediately +enclosing ~{ or ~< construct +is terminated. If there is no such enclosing construct, then the entire +formatting operation is terminated. +In the ~< case, the formatting +is performed, but no more segments are processed before doing the +justification. +~^ may appear anywhere in a ~{ +construct. +

    +
    +
     (setq donestr "Done.~^ ~D warning~:P.~^ ~D error~:P.")
+⇒  "Done.~^ ~D warning~:P.~^ ~D error~:P."
+ (format nil donestr) ⇒  "Done."
+ (format nil donestr 3) ⇒  "Done. 3 warnings."
+ (format nil donestr 1 5) ⇒  "Done. 1 warning. 5 errors."
+
    + +

    If a prefix parameter is given, then termination occurs if the parameter +is zero. (Hence ~^ is equivalent to +~#^.) If two +parameters are given, termination occurs if they are equal. +

    +

    [Reviewer Note by Barmar: Which equality predicate?] If three +parameters are given, termination occurs if the first is less than or +equal to the second and the second is less than or equal to the third. +Of course, this is useless if all the prefix parameters are constants; at +least one of them should be a # or a V parameter. +

    +

    If ~^ is used within a ~:{ +construct, then it terminates +the current iteration step because in the standard case it tests for +remaining arguments of the current step only; the next iteration step +commences immediately. ~:^ is used to terminate +the iteration process. +

    +

    ~:^ +may be used only if the command it would terminate is +~:{ or ~:@{ . +The entire iteration process is terminated if and only if the sublist that is +supplying the arguments for the current iteration step is the last sublist in +the case of ~:{ , +or the last format +argument in the case of ~:@{ . +~:^ is not +equivalent to ~#:^; +the latter terminates the entire iteration if and only if no +arguments remain for the current iteration step. +For example: +

    +
    +
     (format nil "~:{ ~@?~:^ ...~} " '(("a") ("b"))) ⇒  "a...b"
+
    + +

    If ~^ appears within a control string being processed +under the control of a ~? directive, but not within +any ~{ or ~< construct within that string, +then the string being +processed will be terminated, thereby ending processing +of the ~? directive. Processing then +continues within the string +containing the ~? directive at the point following that directive. +

    +

    If ~^ +appears within a ~[ or ~( construct, +then all the commands up to the ~^ are properly selected +or case-converted, +the ~[ or ~( processing is terminated, +and the outward search continues +for a ~{ or ~< construct +to be terminated. For example: +

    +
    +
     (setq tellstr "~@(~@[~R~]~^ ~A!~)")
+⇒  "~@(~@[~R~]~^ ~A!~)"
+ (format nil tellstr 23) ⇒  "Twenty-three!"
+ (format nil tellstr nil "losers") ⇒  " Losers!"
+ (format nil tellstr 23 "losers") ⇒  "Twenty-three losers!"
+
    + +

    Following are examples of the use of ~^ +within a ~< construct. +

    +
    +
     (format nil "~15<~S~;~^~S~;~^~S~>" 'foo)
+⇒   "            FOO"
+ (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar)
+⇒   "FOO         BAR"
+ (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
+⇒   "FOO   BAR   BAZ"
+
    + +
    +
    +

    +Next: , Previous: , Up: FORMAT Miscellaneous Pseudo-Operations  

    +
    + + + + + diff --git a/info/gcl/Tilde-D_002d_003e-Decimal.html b/info/gcl/Tilde-D_002d_003e-Decimal.html new file mode 100644 index 0000000..9fe2dbc --- /dev/null +++ b/info/gcl/Tilde-D_002d_003e-Decimal.html @@ -0,0 +1,88 @@ + + + + + +Tilde D-> Decimal (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Radix Control  

    +
    +
    +

    22.3.2.2 Tilde D: Decimal

    + +

    An arg, which should be an integer, +is printed in decimal radix. +~D will never put a decimal point after the number. +

    +

    ~mincolD uses +a column width of mincol; spaces are inserted on +the left if the number requires fewer than mincol columns for its digits +and sign. If the number doesn’t fit in mincol columns, additional columns +are used as needed. +

    +

    ~mincol,padcharD uses padchar as the pad character +instead of space. +

    +

    If arg is not an integer, it is printed in ~A format and decimal base. +

    +

    The @ modifier causes the number’s sign to be printed always; the default +is to print it only if the number is negative. +

    +

    The : modifier causes commas to be printed between groups of digits; +commachar may be used to change the character used as the comma. +comma-interval +must be an integer and defaults to 3. When the : +modifier is given to any of +these directives, the commachar +is printed between groups of comma-interval +digits. +

    +

    Thus the most general form of ~D is +~mincol,padchar,commachar,comma-intervalD. +

    +

    ~D binds + *print-escape* to false, + *print-radix* to false, + *print-base* to 10, +

    +

    and *print-readably* to false. +

    + + + + + diff --git a/info/gcl/Tilde-Dollarsign_002d_003e-Monetary-Floating_002dPoint.html b/info/gcl/Tilde-Dollarsign_002d_003e-Monetary-Floating_002dPoint.html new file mode 100644 index 0000000..e2b12d3 --- /dev/null +++ b/info/gcl/Tilde-Dollarsign_002d_003e-Monetary-Floating_002dPoint.html @@ -0,0 +1,107 @@ + + + + + +Tilde Dollarsign-> Monetary Floating-Point (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Floating-Point Printers  

    +
    +
    +

    22.3.3.4 Tilde Dollarsign: Monetary Floating-Point

    + +

    The next arg is printed as a float in fixed-format notation. +

    +

    The full form is ~d,n,w,padchar$. +The parameter d is the number +of digits to print after the decimal point (default value 2); +n is the minimum number of digits to print before the decimal +point (default value 1); +w is the minimum total width of the field to be printed (default +value 0). +

    +

    First padding and the sign are output. +If the arg is negative, then a minus sign is printed; +if the arg is not negative, then a plus sign is printed +if and only if the @ modifier was supplied. +If the : modifier is used, the sign appears before any padding, +and otherwise after the padding. +If w is supplied and the number of other characters to be output +is less than w, then copies of padchar (which defaults +to a space) are output to +make the total field width equal w. +Then n digits are printed for the integer part of arg, +with leading zeros if necessary; then a decimal point; +then d digits of fraction, properly rounded. +

    +

    If the magnitude of arg is so large that more than m digits would +have to be printed, where m is the larger of w and 100, then an +implementation is free, at its discretion, to print the number using +exponential notation instead, as if by the directive +~w,q,,,,padcharE, where w and padchar are +present or omitted according to whether they were present or omitted in +the ~$ directive, and where q=d+n- 1, +where d and n are the (possibly default) values given to the +~$ directive. +

    +

    If arg is a rational +number, then it is coerced to be a single float +and then printed. Alternatively, an implementation is permitted to +process a rational number by any +other method that has essentially the +same behavior but avoids loss of precision or overflow +because of the coercion. +

    +

    If arg is a complex number or some non-numeric +object, +then it is printed using the format directive ~wD, +thereby printing it in decimal radix and a minimum field width of w. +

    +

    ~$ binds *print-escape* to false +

    +

    and *print-readably* to false. +

    +
    +
    +

    +Previous: , Up: FORMAT Floating-Point Printers  

    +
    + + + + + diff --git a/info/gcl/Tilde-E_002d_003e-Exponential-Floating_002dPoint.html b/info/gcl/Tilde-E_002d_003e-Exponential-Floating_002dPoint.html new file mode 100644 index 0000000..f7a5da0 --- /dev/null +++ b/info/gcl/Tilde-E_002d_003e-Exponential-Floating_002dPoint.html @@ -0,0 +1,169 @@ + + + + + +Tilde E-> Exponential Floating-Point (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Floating-Point Printers  

    +
    +
    +

    22.3.3.2 Tilde E: Exponential Floating-Point

    + +

    The next arg is printed as a float in exponential notation. +

    +

    The full form is +~w,d,e,k,overflowchar,padchar,exponentcharE. +The parameter w +is the width of the field to be printed; d is the number +of digits to print after the decimal point; e is the number +of digits to use when printing the exponent; +k is a scale factor that defaults to one (not zero). +

    +

    Exactly w characters will +be output. First, leading copies of the character padchar +(which defaults to a space) are printed, if necessary, to pad the +field on the left. +If the arg is negative, then a minus sign is printed; +if the arg is not negative, then a plus sign is printed +if and only if the @ +modifier was supplied. Then a sequence +of digits containing a single embedded decimal point is printed. +The form of this sequence of digits depends on the scale factor k. +If k is zero, then d digits are printed after the decimal +point, and a single zero digit appears before the decimal point if +the total field width will permit it. If k is positive, +then it must be strictly less than d+2; k significant digits +are printed before the decimal point, and d- k+1 +digits are printed after the decimal point. If k is negative, +then it must be strictly greater than - d; +a single zero digit appears before the decimal point if +the total field width will permit it, and after the decimal point +are printed first +- k zeros and then d+k significant digits. +The printed fraction must be properly rounded. +When rounding up and rounding down would produce printed values +equidistant from the scaled value of arg, then the implementation +is free to use either one. For example, printing the argument +637.5 using the format ~8,2E may correctly produce +either 6.37E+2 or 6.38E+2. +

    +

    Following the digit sequence, the exponent is printed. +First the character parameter exponentchar is printed; if this +parameter is omitted, then the exponent marker that +prin1 would use is printed, as determined from the +type of the float and the current value of +*read-default-float-format*. +Next, either a plus sign or a minus sign +is printed, followed by e digits representing the power of +ten by which the printed fraction must be multiplied +to properly represent the rounded value of arg. +

    +

    If it is impossible to print the value in the required format in a field +of width w, possibly because k is too large or too small +or because the exponent cannot be printed in e character positions, +then one of two actions is taken. If the +parameter overflowchar is supplied, then w copies of that +parameter are printed instead of the scaled value of arg. +If the overflowchar parameter is omitted, then the scaled value +is printed using more than w characters, as many more as may be +needed; if the problem is that d is too small for the supplied k +or that e is too small, then a larger value is used for d or e +as may be needed. +

    +

    If the w parameter is omitted, then the field is of variable width. +In effect a value is chosen +for w in such a way that no leading pad characters need to be printed. +

    +

    If the parameter d is omitted, then there is no constraint +on the number of digits to appear. +A value is chosen for d in such a way that as many digits +as possible may be printed subject to the width constraint +imposed by the parameter w, the constraint of the scale factor k, +and the constraint that no trailing +zero digits may appear in the fraction, except that if the +fraction to be printed is zero then a single zero digit should +appear after the decimal point. +

    +

    If the parameter e is omitted, then the exponent is printed +using the smallest number of digits necessary to represent its value. +

    +

    If all of w, d, and e are omitted, then the effect is to print +the value using ordinary free-format exponential-notation output; +prin1 uses +

    +

    a similar +

    +

    format for any non-zero number whose magnitude +is less than 10^-3 or greater than or equal to 10^7. +

    +

    The only difference is that the ~E +directive always prints a plus or minus sign in front of the + exponent, while prin1 omits the plus sign if the exponent is + non-negative. +

    +

    If arg is a rational +number, then it is coerced to be a single float +and then printed. Alternatively, an implementation is permitted to +process a rational +number by any other method that has essentially the +same behavior but avoids loss of precision or overflow +because of the coercion. If w and d are +unsupplied and the number has no exact decimal representation, +for example 1/3, some precision cutoff must be chosen +by the implementation since only a finite number of digits may be printed. +

    +

    If arg is a complex number or some non-numeric +object, +then it is printed using the format directive ~wD, +thereby printing it in decimal radix and a minimum field width of w. +

    +

    ~E binds + *print-escape* to false +

    +

    and *print-readably* to false. +

    +
    +
    +

    +Next: , Previous: , Up: FORMAT Floating-Point Printers  

    +
    + + + + + diff --git a/info/gcl/Tilde-F_002d_003e-Fixed_002dFormat-Floating_002dPoint.html b/info/gcl/Tilde-F_002d_003e-Fixed_002dFormat-Floating_002dPoint.html new file mode 100644 index 0000000..0135974 --- /dev/null +++ b/info/gcl/Tilde-F_002d_003e-Fixed_002dFormat-Floating_002dPoint.html @@ -0,0 +1,143 @@ + + + + + +Tilde F-> Fixed-Format Floating-Point (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Floating-Point Printers  

    +
    +
    +

    22.3.3.1 Tilde F: Fixed-Format Floating-Point

    + +

    The next arg is printed as a float. +

    +

    The full form is ~w,d,k,overflowchar,padcharF. +The parameter w +is the width of the field to be printed; d is the number +of digits to print after the decimal point; k is a scale factor +that defaults to zero. +

    +

    Exactly w characters will +be output. First, leading copies of the character padchar +(which defaults to a space) are printed, if necessary, to pad the +field on the left. +If the arg is negative, then a minus sign is printed; +if the arg is not negative, then a plus sign is printed +if and only if the @ +modifier was supplied. Then a sequence +of digits, containing a single embedded decimal point, is printed; +this represents the magnitude of the value of arg times 10^k, +rounded to d fractional digits. +When rounding up and rounding down would produce printed values +equidistant from the scaled value of arg, then the implementation +is free to use either one. For example, printing the argument +6.375 using the format ~4,2F may correctly produce +either 6.37 or 6.38. +Leading zeros are not permitted, except that a single +zero digit is output before the decimal point if the printed value +is less than one, and this single zero digit is not output +at all if w=d+1. +

    +

    If it is impossible to print the value in the required format in a field +of width w, then one of two actions is taken. If the +parameter overflowchar is supplied, then w copies of that +parameter are printed instead of the scaled value of arg. +If the overflowchar parameter is omitted, then the scaled value +is printed using more than w characters, as many more as may be +needed. +

    +

    If the w parameter is omitted, then the field is of variable width. +In effect, a value is chosen +for w in such a way that no leading pad characters need to be printed +and exactly d characters will follow the decimal point. +For example, the directive ~,2F will print exactly +two digits after the decimal point and as many as necessary before the +decimal point. +

    +

    If the parameter d is omitted, then there is no constraint +on the number of digits to appear after the decimal point. +A value is chosen for d in such a way that as many digits +as possible may be printed subject to the width constraint +imposed by the parameter w and the constraint that no trailing +zero digits may appear in the fraction, except that if the +fraction to be printed is zero, then a single zero digit should +appear after the decimal point if permitted by the width constraint. +

    +

    If both w and d are omitted, then the effect is to print +the value using ordinary free-format output; prin1 uses this format +for any number whose magnitude is either zero or between +10^-3 (inclusive) and 10^7 (exclusive). +

    +

    If w is omitted, then if the magnitude of arg is so large (or, if +d is also omitted, so small) that more than 100 digits would have to +be printed, then an implementation is free, at its discretion, to print +the number using exponential notation instead, as if by the directive +~E (with all parameters to ~E defaulted, not +taking their values from the ~F directive). +

    +

    If arg is a rational +number, then it is coerced to be a single float +and then printed. Alternatively, an implementation is permitted to +process a rational +number by any other method that has essentially the +same behavior but avoids loss of precision or overflow +because of the coercion. If w and d are +not supplied and the number has no exact decimal representation, +for example 1/3, some precision cutoff must be chosen +by the implementation since only a finite number of digits may be printed. +

    +

    If arg is a complex number or some non-numeric +object, +then it is printed using the format directive ~wD, +thereby printing it in decimal radix and a minimum field width of w. +

    +

    ~F binds + *print-escape* to false +

    +

    and *print-readably* to false. +

    +
    +
    +

    +Next: , Previous: , Up: FORMAT Floating-Point Printers  

    +
    + + + + + diff --git a/info/gcl/Tilde-G_002d_003e-General-Floating_002dPoint.html b/info/gcl/Tilde-G_002d_003e-General-Floating_002dPoint.html new file mode 100644 index 0000000..ec1d6ff --- /dev/null +++ b/info/gcl/Tilde-G_002d_003e-General-Floating_002dPoint.html @@ -0,0 +1,87 @@ + + + + + +Tilde G-> General Floating-Point (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Floating-Point Printers  

    +
    +
    +

    22.3.3.3 Tilde G: General Floating-Point

    + +

    The next arg is printed as a float +in either fixed-format or exponential notation as appropriate. +

    +

    The full form is ~w,d,e,k,overflowchar,padchar,exponentcharG. +The format in which to print arg depends on the magnitude (absolute +value) of the arg. Let n be an integer such that +10^n-1 \le |arg| < 10^n. +Let ee equal e+2, or 4 if e is omitted. +Let ww equal w- ee, +or nil if w is omitted. If d is omitted, first let q +be the number of digits needed to print arg with no loss +of information and without leading or trailing zeros; +then let d equal (max q (min n 7)). +Let dd equal d- n. +

    +

    If 0 \le dd \le d, then arg is printed +as if by the format directives +

    +

    ~ww,dd,,overflowchar,padcharF~ee@T +

    +

    Note that the scale factor k is not passed to the ~F +directive. For all other values of dd, arg is printed as if +by the format directive +

    +

    ~w,d,e,k,overflowchar,padchar,exponentcharE +

    +

    In either case, an @ +modifier is supplied to the ~F +or ~E directive if and only if one was supplied to the +~G directive. +

    +

    ~G binds + *print-escape* to false +

    +

    and *print-readably* to false. +

    + + + + + diff --git a/info/gcl/Tilde-Greater_002dThan_002dSign_002d_003e-End-of-Justification.html b/info/gcl/Tilde-Greater_002dThan_002dSign_002d_003e-End-of-Justification.html new file mode 100644 index 0000000..176a4a1 --- /dev/null +++ b/info/gcl/Tilde-Greater_002dThan_002dSign_002d_003e-End-of-Justification.html @@ -0,0 +1,54 @@ + + + + + +Tilde Greater-Than-Sign-> End of Justification (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Layout Control  

    +
    +
    +

    22.3.6.3 Tilde Greater-Than-Sign: End of Justification

    + +

    ~> terminates a ~<. +The consequences of using it elsewhere are undefined. +

    + + + + + diff --git a/info/gcl/Tilde-I_002d_003e-Indent.html b/info/gcl/Tilde-I_002d_003e-Indent.html new file mode 100644 index 0000000..4541765 --- /dev/null +++ b/info/gcl/Tilde-I_002d_003e-Indent.html @@ -0,0 +1,56 @@ + + + + + +Tilde I-> Indent (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Pretty Printer Operations  

    +
    +
    +

    22.3.5.3 Tilde I: Indent

    + +

    ~nI is the same as (pprint-indent :block n). +

    +

    ~n:I is the same as (pprint-indent :current n). +In both cases, n defaults to zero, if it is omitted. +

    + + + + + diff --git a/info/gcl/Tilde-Left_002dBrace_002d_003e-Iteration.html b/info/gcl/Tilde-Left_002dBrace_002d_003e-Iteration.html new file mode 100644 index 0000000..faf8b49 --- /dev/null +++ b/info/gcl/Tilde-Left_002dBrace_002d_003e-Iteration.html @@ -0,0 +1,155 @@ + + + + + +Tilde Left-Brace-> Iteration (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Control-Flow Operations  

    +
    +
    +

    22.3.7.4 Tilde Left-Brace: Iteration

    + +

    ~{str~} +

    +

    This is an iteration construct. The argument should be a list, +which is used as a set of arguments +as if for a recursive call to format. +The string str is used repeatedly as the control string. +Each iteration can absorb as many elements of the list as it likes +as arguments; +if str uses up two arguments by itself, then two elements of the +list will get used up each time around the loop. +If before any iteration step the list +is empty, then the iteration is terminated. +Also, if a prefix parameter n is given, then there will be at most n +repetitions of processing of str. +Finally, the ~^ directive can be +used to terminate the iteration prematurely. +

    +

    For example: +

    +
    +
     (format nil "The winners are:~{ ~S~}." 
+         '(fred harry jill)) 
+⇒  "The winners are: FRED HARRY JILL."                           
+ (format nil "Pairs:~{ <~S,~S>~}." 
+         '(a 1 b 2 c 3))
+⇒  "Pairs: <A,1> <B,2> <C,3>."
+
    + +

    ~:{ str~} is similar, +but the argument should be a list of sublists. +At each repetition step, one sublist +is used as the set of arguments for +processing str; on the next repetition, a new sublist +is used, whether +or not all of the last sublist had been processed. +For example: +

    +
    +
     (format nil "Pairs:~:{ <~S,~S>~} ." 
+                 '((a 1) (b 2) (c 3)))
+⇒  "Pairs: <A,1> <B,2> <C,3>."
+
    + +

    ~@{ str~} +is similar to ~{ str~} , but instead of +using one argument that is a list, all the remaining arguments +are used as the list of arguments for the iteration. +Example: +

    +
    +
     (format nil "Pairs:~@{ <~S,~S>~} ." 'a 1 'b 2 'c 3)
+⇒  "Pairs: <A,1> <B,2> <C,3>."
+
    + +

    If the iteration is terminated before all the remaining arguments are +consumed, then any arguments not processed by the iteration remain to be +processed by any directives following the iteration construct. +

    +

    ~:@{ str~} +combines the features +of ~:{ str~} +and ~@{ str~} . +All the remaining arguments +are used, and each one must be a list. +On each iteration, the next argument is +used as a list of arguments to str. +Example: +

    +
    +
     (format nil "Pairs:~:@{ <~S,~S>~} ." 
+              '(a 1) '(b 2) '(c 3)) 
+⇒  "Pairs: <A,1> <B,2> <C,3>."
+
    + +

    Terminating the repetition construct with ~:} +instead of ~} +forces str to be processed at least once, even if the initial +list of arguments is null. However, this will not override an explicit +prefix parameter of zero. +

    +

    If str is empty, then an argument is used as str. +It must be a format control +and precede any arguments processed by the iteration. As an example, +the following are equivalent: +

    +
    +
        (apply #'format stream string arguments)
+ ≡ (format stream "~1{~:}" string arguments)
+
    + +

    This will use string as a formatting string. +The ~1{ says it will +be processed at most once, and the ~:} +says it will be processed at least once. +Therefore it is processed exactly once, using arguments as the arguments. +This case may be handled more clearly by the ~? directive, +but this general feature of ~{ +is more powerful than ~?. +

    +
    +
    +

    +Next: , Previous: , Up: FORMAT Control-Flow Operations  

    +
    + + + + + diff --git a/info/gcl/Tilde-Left_002dBracket_002d_003e-Conditional-Expression.html b/info/gcl/Tilde-Left_002dBracket_002d_003e-Conditional-Expression.html new file mode 100644 index 0000000..1620ba2 --- /dev/null +++ b/info/gcl/Tilde-Left_002dBracket_002d_003e-Conditional-Expression.html @@ -0,0 +1,125 @@ + + + + + +Tilde Left-Bracket-> Conditional Expression (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Control-Flow Operations  

    +
    +
    +

    22.3.7.2 Tilde Left-Bracket: Conditional Expression

    + +

    ~[str0~;str1~;...~;strn~] +

    +

    This is a set of control strings, called clauses, one of which is +chosen and used. The clauses are separated by ~; +and the construct is terminated by ~]. For example, +

    +

    "~[Siamese~;Manx~;Persian~] Cat" +

    +

    The argth +clause is selected, where the first clause is number 0. +If a prefix parameter is given (as ~n[), +then the parameter is used instead of an argument. +If arg is out of range then no clause is selected +and no error is signaled. +After the selected alternative has been processed, the control string +continues after the ~]. +

    +

    ~[str0~;str1~;...~;strn~:;default~] +has a default case. +If the last ~; used to separate clauses +is ~:; instead, then the last clause is an else clause +that is performed if no other clause is selected. +For example: +

    +

    "~[Siamese~;Manx~;Persian~:;Alley~] Cat" +

    +

    ~:[alternative~;consequent~] +selects the alternative control string if arg is false, +and selects the consequent control string otherwise. +

    +

    ~@[consequent~] +tests the argument. If it is true, +then the argument is not used up by the ~[ command +but remains as the next one to be processed, +and the one clause consequent is processed. +If the arg is false, then the argument is used up, +and the clause is not processed. +The clause therefore should normally use exactly one argument, +and may expect it to be non-nil. +For example: +

    +
    +
     (setq *print-level* nil *print-length* 5)
+ (format nil
+        "~@[ print level = ~D~]~@[ print length = ~D~]"
+        *print-level* *print-length*)
+⇒   " print length = 5"
+
    + +

    Note also that +

    +
    +
     (format stream "...~@[str~]..." ...)
+≡ (format stream "...~:[~;~:*str~]..." ...)
+
    + +

    The combination of ~[ and # is useful, for +example, for dealing with English conventions for printing lists: +

    +
    +
     (setq foo "Items:~#[ none~; ~S~; ~S and ~S~
+           ~:;~@{~#[~; and~] ~S~^ ,~}~].")
+ (format nil foo) ⇒   "Items: none."
+ (format nil foo 'foo) ⇒   "Items: FOO."
+ (format nil foo 'foo 'bar) ⇒   "Items: FOO and BAR."
+ (format nil foo 'foo 'bar 'baz) ⇒   "Items: FOO, BAR, and BAZ."
+ (format nil foo 'foo 'bar 'baz 'quux) ⇒   "Items: FOO, BAR, BAZ, and QUUX."
+
    + +
    +
    +

    +Next: , Previous: , Up: FORMAT Control-Flow Operations  

    +
    + + + + + diff --git a/info/gcl/Tilde-Left_002dParen_002d_003e-Case-Conversion.html b/info/gcl/Tilde-Left_002dParen_002d_003e-Case-Conversion.html new file mode 100644 index 0000000..8d685be --- /dev/null +++ b/info/gcl/Tilde-Left_002dParen_002d_003e-Case-Conversion.html @@ -0,0 +1,89 @@ + + + + + +Tilde Left-Paren-> Case Conversion (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Miscellaneous Operations  

    +
    +
    +

    22.3.8.1 Tilde Left-Paren: Case Conversion

    + +

    ~(str~) +

    +

    The contained control string str is processed, and what it produces +is subject to case conversion. +

    +

    With no flags, every uppercase character +is converted to the corresponding lowercase character. +

    +

    ~:( capitalizes all words, as if by string-capitalize. +

    +

    ~@( +capitalizes just the first word and forces the rest to lower +case. +

    +

    ~:@( converts every lowercase character +to the corresponding uppercase character. +

    +

    In this example ~@( is used to cause the first word +produced by ~@R to be capitalized: +

    +
    +
     (format nil "~@R ~(~@R~)" 14 14) 
+⇒  "XIV xiv"
+ (defun f (n) (format nil "~@(~R~) error~:P detected." n)) ⇒  F
+ (f 0) ⇒  "Zero errors detected."
+ (f 1) ⇒  "One error detected."
+ (f 23) ⇒  "Twenty-three errors detected."
+
    + +

    When case conversions appear nested, the outer conversion dominates, +as illustrated in the following example: +

    +
    +
     (format nil "~@(how is ~:(BOB SMITH~)?~)")
+ ⇒  "How is bob smith?"
+ NOT⇒ "How is Bob Smith?"
+
    + + + + + + diff --git a/info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Justification.html b/info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Justification.html new file mode 100644 index 0000000..a8437ba --- /dev/null +++ b/info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Justification.html @@ -0,0 +1,130 @@ + + + + + +Tilde Less-Than-Sign-> Justification (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Layout Control  

    +
    +
    +

    22.3.6.2 Tilde Less-Than-Sign: Justification

    + +

    ~mincol,colinc,minpad,padchar<str~> +

    +

    This justifies the text produced by processing str +within a field at least mincol columns wide. str +may be divided up into segments with ~;, in which case the +spacing is evenly divided between the text segments. +

    +

    With no modifiers, the leftmost text segment is left justified in the +field, and the rightmost text segment is right justified. If there is +only one text element, as a special case, it is right justified. +The : modifier causes +spacing to be introduced before the first text segment; the +@ modifier causes spacing to be added after the last. +The minpad parameter (default 0) is the minimum number of +padding characters to be output between each segment. +The padding character is supplied by padchar, +which defaults to the space character. +If the total width needed to satisfy these constraints is greater +than mincol, then the width used is mincol+k*colinc +for the smallest possible non-negative integer value k. +colinc defaults to 1, and mincol defaults to 0. +

    +

    Note that str may include format directives. +All the clauses in str are processed in order; +it is the resulting pieces of text that are justified. +

    +

    The ~^ directive may be used to terminate processing of the +clauses prematurely, in which case only the completely processed clauses +are justified. +

    +

    If the first clause of a ~< +is terminated with ~:; instead of +~;, then it is used in a special way. All of the clauses are +processed (subject to ~^ , of course), but the +first one is not used +in performing the spacing and padding. When the padded result has been +determined, then if it will fit on the current line of output, it is +output, and the text for the first clause is discarded. If, however, the +padded text will not fit on the current line, then the text segment for +the first clause is output before the padded text. The first clause +ought to contain a newline (such as a ~% directive). The first +clause is always processed, and so any arguments it refers to will be +used; the decision is whether to use the resulting segment of text, not +whether to process the first clause. If the ~:; has a prefix +parameter n, then the padded text must fit on the current line with +n character positions to spare to avoid outputting the first clause’s +text. For example, the control string +

    +
    +
     "~
+
    + +

    can be used to print a list of items separated by commas without +breaking items over line boundaries, beginning each line with +;; . The prefix parameter +1 in ~1:; accounts for the width of the +comma that will follow the justified item if it is not the last +element in the list, or the period +if it is. If ~:; has a second +prefix parameter, then it is used as the width of the line, +thus overriding the natural line width of the output stream. To make +the preceding example use a line width of 50, one would write +

    +
    +
     "~
+
    + +

    If the second argument is not supplied, then format uses the +line width of the destination output stream. +If this cannot be determined (for example, when producing a +string result), then format uses 72 as the line length. +

    +

    See also Tilde Less-Than-Sign-> Logical Block. +

    +
    +
    +

    +Next: , Previous: , Up: FORMAT Layout Control  

    +
    + + + + + diff --git a/info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Logical-Block.html b/info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Logical-Block.html new file mode 100644 index 0000000..c97f6c5 --- /dev/null +++ b/info/gcl/Tilde-Less_002dThan_002dSign_002d_003e-Logical-Block.html @@ -0,0 +1,120 @@ + + + + + +Tilde Less-Than-Sign-> Logical Block (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Pretty Printer Operations  

    +
    +
    +

    22.3.5.2 Tilde Less-Than-Sign: Logical Block

    + +

    ~<...~:> +

    +

    If ~:> is used to terminate a ~<...~>, +the directive is equivalent to a call to pprint-logical-block. +The argument corresponding to the ~<...~:> directive is treated in +the same way as the list argument to pprint-logical-block, +thereby providing automatic support for non-list arguments and +the detection of circularity, sharing, and depth abbreviation. +The portion of the control-string nested within the ~<...~:> +specifies the :prefix (or :per-line-prefix), :suffix, +and body of the pprint-logical-block. +

    +

    The control-string portion enclosed by ~<...~:> can be divided +into segments ~<prefix~;body~;suffix~:> +by ~; directives. If the first section is terminated by ~@;, +it specifies a per-line prefix rather than a simple prefix. +The prefix and suffix cannot contain format directives. +An error is signaled if either the prefix or suffix fails to be a +constant string or if the enclosed portion is divided into more than three segments. +

    +

    If the enclosed portion is divided into only two segments, the suffix +defaults to the null string. If the enclosed portion consists of only +a single segment, both the prefix and the suffix default to +the null string. If the colon modifier is used (i.e., ~:<...~:>), +the prefix and suffix default to "(" and ")" +(respectively) instead of the null string. +

    +

    The body segment can be any arbitrary format string. +This format string is applied to the elements of the list +corresponding to the ~<...~:> directive as a whole. +Elements are extracted from this list using pprint-pop, +thereby providing automatic support for malformed lists, and the detection +of circularity, sharing, and length abbreviation. +Within the body segment, ~^ acts like pprint-exit-if-list-exhausted. +

    +

    ~<...~:> supports a feature not supported by pprint-logical-block. +If ~:@> is used to terminate the directive (i.e., ~<...~:@>), +then a fill-style conditional newline is automatically inserted after each +group of blanks immediately contained in the body (except for blanks +after a ~<Newline> directive). This makes it easy to achieve the +equivalent of paragraph filling. +

    +

    If the at-sign modifier is used with ~<...~:>, the entire remaining argument +list is passed to the directive as its argument. All of the remaining +arguments are always consumed by ~@<...~:>, even if they are not all used +by the format string nested in the directive. Other than the difference in +its argument, ~@<...~:> is exactly the same as ~<...~:> except that +circularity detection is not applied if ~@<...~:> is encountered at top +level in a format string. This ensures that circularity detection is +applied only to data lists, not to format argument lists. +

    +

    " . #n#" is printed if circularity or sharing has to be indicated +for its argument as a whole. +

    +

    To a considerable extent, the basic form of the directive ~<...~> is +incompatible with the dynamic control of the arrangement of output by +~W, ~_, ~<...~:>, ~I, and ~:T. As a result, an error +is signaled if any of these directives is nested within ~<...~>. +Beyond this, an error is also signaled if the ~<...~:;...~> form of +~<...~> is used in the same format string with +~W, ~_, ~<...~:>, ~I, or ~:T. +

    +

    See also Tilde Less-Than-Sign-> Justification. +

    +
    +
    +

    +Next: , Previous: , Up: FORMAT Pretty Printer Operations  

    +
    + + + + + diff --git a/info/gcl/Tilde-Newline_002d_003e-Ignored-Newline.html b/info/gcl/Tilde-Newline_002d_003e-Ignored-Newline.html new file mode 100644 index 0000000..3f3e5c5 --- /dev/null +++ b/info/gcl/Tilde-Newline_002d_003e-Ignored-Newline.html @@ -0,0 +1,83 @@ + + + + + +Tilde Newline-> Ignored Newline (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Miscellaneous Pseudo-Operations  

    +
    +
    +

    22.3.9.3 Tilde Newline: Ignored Newline

    + +

    Tilde immediately followed by a newline ignores the newline +and any following non-newline whitespace_1 characters. +With a :, + the newline is ignored, + but any following whitespace_1 is left in place. +With an @, + the newline is left in place, + but any following whitespace_1 is ignored. +For example: +

    +
    +
     (defun type-clash-error (fn nargs argnum right-type wrong-type)
+   (format *error-output*
+           "~&~S requires its ~:[~:R~;~*~]~ 
+           argument to be of type ~S,~
+           with an argument of type ~S.~
+           fn (eql nargs 1) argnum right-type wrong-type))
+ (type-clash-error 'aref nil 2 'integer 'vector)  prints:
+AREF requires its second argument to be of type INTEGER,
+but it was called with an argument of type VECTOR.
+NIL
+ (type-clash-error 'car 1 1 'list 'short-float)  prints:
+CAR requires its argument to be of type LIST,
+but it was called with an argument of type SHORT-FLOAT.
+NIL
+
    + +

    Note that in this example newlines appear in the output only as specified +by the ~& and ~% directives; the +actual newline characters +in the control string are suppressed because each is preceded by a tilde. +

    + + + + + diff --git a/info/gcl/Tilde-O_002d_003e-Octal.html b/info/gcl/Tilde-O_002d_003e-Octal.html new file mode 100644 index 0000000..f128206 --- /dev/null +++ b/info/gcl/Tilde-O_002d_003e-Octal.html @@ -0,0 +1,62 @@ + + + + + +Tilde O-> Octal (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Radix Control  

    +
    +
    +

    22.3.2.4 Tilde O: Octal

    + +

    This is just like ~D but prints in octal radix (radix 8) +instead of decimal. The full form is therefore +~mincol,padchar,commachar,comma-intervalO. +

    +

    ~O binds + *print-escape* to false, + *print-radix* to false, + *print-base* to 8, +

    +

    and *print-readably* to false. +

    + + + + + diff --git a/info/gcl/Tilde-P_002d_003e-Plural.html b/info/gcl/Tilde-P_002d_003e-Plural.html new file mode 100644 index 0000000..b43c3b1 --- /dev/null +++ b/info/gcl/Tilde-P_002d_003e-Plural.html @@ -0,0 +1,72 @@ + + + + + +Tilde P-> Plural (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Miscellaneous Operations  

    +
    +
    +

    22.3.8.3 Tilde P: Plural

    + +

    If arg is not eql +to the integer 1, a lowercase s is +printed; if arg is eql to 1, nothing is printed. +If arg is a floating-point 1.0, the s is +printed. +

    +

    ~:P does the same thing, +after doing a ~:* to back up one argument; +that is, it prints a lowercase s if the previous argument was not +1. +

    +

    ~@P +prints y if the argument is 1, or ies if it is +not. ~:@P does the same thing, but backs up first. +

    +
    +
     (format nil "~D tr~:@P/~D win~:P" 7 1) ⇒  "7 tries/1 win"
+ (format nil "~D tr~:@P/~D win~:P" 1 0) ⇒  "1 try/0 wins"
+ (format nil "~D tr~:@P/~D win~:P" 1 3) ⇒  "1 try/3 wins"
+
    + + + + + + diff --git a/info/gcl/Tilde-Percent_002d_003e-Newline.html b/info/gcl/Tilde-Percent_002d_003e-Newline.html new file mode 100644 index 0000000..cd46e5e --- /dev/null +++ b/info/gcl/Tilde-Percent_002d_003e-Newline.html @@ -0,0 +1,56 @@ + + + + + +Tilde Percent-> Newline (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Basic Output  

    +
    +
    +

    22.3.1.2 Tilde Percent: Newline

    + +

    This outputs a #\Newline character, thereby terminating the current +output line and beginning a new one. +~n% outputs n newlines. +No arg is used. +

    + + + + + diff --git a/info/gcl/Tilde-Question_002dMark_002d_003e-Recursive-Processing.html b/info/gcl/Tilde-Question_002dMark_002d_003e-Recursive-Processing.html new file mode 100644 index 0000000..b5313e5 --- /dev/null +++ b/info/gcl/Tilde-Question_002dMark_002d_003e-Recursive-Processing.html @@ -0,0 +1,83 @@ + + + + + +Tilde Question-Mark-> Recursive Processing (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Control-Flow Operations  

    +
    +
    +

    22.3.7.6 Tilde Question-Mark: Recursive Processing

    + +

    The next arg must be a format control, and the one after it a list; +both are consumed by the ~? directive. +The two are processed as a control-string, with the elements of the list +as the arguments. Once the recursive processing +has been finished, the processing of the control +string containing the ~? directive is resumed. +Example: +

    +
    +
     (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) ⇒  "<Foo 5> 7"
+ (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) ⇒  "<Foo 5> 7"
+
    + +

    Note that in the second example three arguments are supplied +to the format string "<~A ~D>", but only two are processed +and the third is therefore ignored. +

    +

    With the @ +modifier, only one arg is directly consumed. +The arg must be a string; +it is processed as part of the control +string as if it had appeared in place of the ~@? construct, +and any directives in the recursively processed control string may +consume arguments of the control string containing the ~@? +directive. +Example: +

    +
    +
     (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) ⇒  "<Foo 5> 7"
+ (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) ⇒  "<Foo 5> 14"
+
    + + + + + + diff --git a/info/gcl/Tilde-R_002d_003e-Radix.html b/info/gcl/Tilde-R_002d_003e-Radix.html new file mode 100644 index 0000000..a9ce6d6 --- /dev/null +++ b/info/gcl/Tilde-R_002d_003e-Radix.html @@ -0,0 +1,101 @@ + + + + + +Tilde R-> Radix (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Radix Control  

    +
    +
    +

    22.3.2.1 Tilde R: Radix

    + +

    ~nR prints arg in radix n. +The modifier flags and any remaining parameters are used as for +the ~D directive. +~D is the same as ~10R. +The full form is +~radix,mincol,padchar,commachar,comma-intervalR. +

    +

    If no prefix parameters are given to ~R, then a different +interpretation is given. The argument should be an integer. +For example, if arg is 4: +

    +
    +
    *
    +

    ~R prints arg as a cardinal English number: four. +

    +
    +
    *
    +

    ~:R prints arg as an ordinal English number: fourth. +

    +
    +
    *
    +

    ~@R prints arg as a Roman numeral: IV. +

    +
    +
    *
    +

    ~:@R prints arg as an old Roman numeral: IIII. +

    +
    + +

    For example: +

    +
    +
     (format nil "~,,' ,4:B" 13) ⇒  "1101"
+ (format nil "~,,' ,4:B" 17) ⇒  "1 0001"
+ (format nil "~19,0,' ,4:B" 3333) ⇒  "0000 1101 0000 0101"
+ (format nil "~3,,,' ,2:R" 17) ⇒  "1 22"
+ (format nil "~,,'|,2:D" #xFFFF) ⇒   "6|55|35"
+
    + +

    If and only if the first parameter, n, is supplied, +~R binds + *print-escape* to false, + *print-radix* to false, + *print-base* to n, +

    +

    and *print-readably* to false. +

    +

    If and only if no parameters are supplied, +~R binds *print-base* to 10. +

    + + + + + diff --git a/info/gcl/Tilde-Right_002dBrace_002d_003e-End-of-Iteration.html b/info/gcl/Tilde-Right_002dBrace_002d_003e-End-of-Iteration.html new file mode 100644 index 0000000..3751578 --- /dev/null +++ b/info/gcl/Tilde-Right_002dBrace_002d_003e-End-of-Iteration.html @@ -0,0 +1,54 @@ + + + + + +Tilde Right-Brace-> End of Iteration (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Control-Flow Operations  

    +
    +
    +

    22.3.7.5 Tilde Right-Brace: End of Iteration

    + +

    ~} terminates a ~{. +The consequences of using it elsewhere are undefined. +

    + + + + + diff --git a/info/gcl/Tilde-Right_002dBracket_002d_003e-End-of-Conditional-Expression.html b/info/gcl/Tilde-Right_002dBracket_002d_003e-End-of-Conditional-Expression.html new file mode 100644 index 0000000..456e95b --- /dev/null +++ b/info/gcl/Tilde-Right_002dBracket_002d_003e-End-of-Conditional-Expression.html @@ -0,0 +1,54 @@ + + + + + +Tilde Right-Bracket-> End of Conditional Expression (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Control-Flow Operations  

    +
    +
    +

    22.3.7.3 Tilde Right-Bracket: End of Conditional Expression

    + +

    ~] terminates a ~[. +The consequences of using it elsewhere are undefined. +

    + + + + + diff --git a/info/gcl/Tilde-Right_002dParen_002d_003e-End-of-Case-Conversion.html b/info/gcl/Tilde-Right_002dParen_002d_003e-End-of-Case-Conversion.html new file mode 100644 index 0000000..030ba8a --- /dev/null +++ b/info/gcl/Tilde-Right_002dParen_002d_003e-End-of-Case-Conversion.html @@ -0,0 +1,54 @@ + + + + + +Tilde Right-Paren-> End of Case Conversion (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Miscellaneous Operations  

    +
    +
    +

    22.3.8.2 Tilde Right-Paren: End of Case Conversion

    + +

    ~) terminates a ~(. +The consequences of using it elsewhere are undefined. +

    + + + + + diff --git a/info/gcl/Tilde-S_002d_003e-Standard.html b/info/gcl/Tilde-S_002d_003e-Standard.html new file mode 100644 index 0000000..93379c7 --- /dev/null +++ b/info/gcl/Tilde-S_002d_003e-Standard.html @@ -0,0 +1,58 @@ + + + + + +Tilde S-> Standard (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Printer Operations  

    +
    +
    +

    22.3.4.2 Tilde S: Standard

    + +

    This is just like ~A, but arg is printed with escape +characters (as by prin1 rather than princ). The output is +therefore suitable for input to read. ~S accepts +all the arguments and modifiers that ~A does. +

    +

    ~S binds *print-escape* to t. +

    + + + + + diff --git a/info/gcl/Tilde-Semicolon_002d_003e-Clause-Separator.html b/info/gcl/Tilde-Semicolon_002d_003e-Clause-Separator.html new file mode 100644 index 0000000..9e15ec3 --- /dev/null +++ b/info/gcl/Tilde-Semicolon_002d_003e-Clause-Separator.html @@ -0,0 +1,54 @@ + + + + + +Tilde Semicolon-> Clause Separator (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Miscellaneous Pseudo-Operations  

    +
    +
    +

    22.3.9.1 Tilde Semicolon: Clause Separator

    + +

    This separates clauses in ~[ and ~< constructs. +The consequences of using it elsewhere are undefined. +

    + + + + + diff --git a/info/gcl/Tilde-Slash_002d_003e-Call-Function.html b/info/gcl/Tilde-Slash_002d_003e-Call-Function.html new file mode 100644 index 0000000..23c06c0 --- /dev/null +++ b/info/gcl/Tilde-Slash_002d_003e-Call-Function.html @@ -0,0 +1,93 @@ + + + + + +Tilde Slash-> Call Function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Pretty Printer Operations  

    +
    +
    +

    22.3.5.4 Tilde Slash: Call Function

    + +

    ~/name/ +

    +

    User defined functions can be called from within a format +string by using the directive ~/name/. +The colon modifier, the at-sign modifier, and arbitrarily many parameters +can be specified with the ~/name/ directive. +name can be any arbitrary string that does not contain a "/". +All of the characters in name are treated as if they were upper case. +If name contains a single colon (:) or double colon (::), +then everything up to but not including the first ":" or "::" +is taken to be a string that names a package. +Everything after the first ":" or "::" (if any) is taken to be a +string that names a symbol. The function corresponding to a +~/name/ directive is obtained by looking up the symbol +that has the indicated name in the indicated package. +If name does not contain a ":" or "::", +then the whole name string is looked up in the COMMON-LISP-USER package. +

    +

    When a ~/name/ directive is encountered, +the indicated function is called with four or more arguments. +The first four arguments are: + the output stream, + the format argument corresponding to the directive, + a generalized boolean that is true if the colon modifier was used, + and a generalized boolean that is true if the at-sign modifier was used. +The remaining arguments consist of any parameters specified with the directive. +The function should print the argument appropriately. +Any values returned by the function are ignored. +

    +

    The three functions + pprint-linear, + pprint-fill, + and pprint-tabular +are specifically designed so that they can be called by ~/.../ +(i.e., ~/pprint-linear/, ~/pprint-fill/, and ~/pprint-tabular/). +In particular they take colon and at-sign arguments. +

    +
    +
    +

    +Previous: , Up: FORMAT Pretty Printer Operations  

    +
    + + + + + diff --git a/info/gcl/Tilde-T_002d_003e-Tabulate.html b/info/gcl/Tilde-T_002d_003e-Tabulate.html new file mode 100644 index 0000000..dd05e87 --- /dev/null +++ b/info/gcl/Tilde-T_002d_003e-Tabulate.html @@ -0,0 +1,103 @@ + + + + + +Tilde T-> Tabulate (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Layout Control  

    +
    +
    +

    22.3.6.1 Tilde T: Tabulate

    + +

    This spaces over to a given column. +~colnum,colincT will output +sufficient spaces to move the cursor to column colnum. If the cursor +is already at or beyond column colnum, it will output spaces to move it to +column colnum+k*colinc for the smallest positive integer +k possible, unless colinc is zero, in which case no spaces +are output if the cursor is already at or beyond column colnum. +colnum and colinc default to 1. +

    +

    If for some reason the current absolute column position cannot be determined +by direct inquiry, +format +may be able to deduce the current column position by noting +that certain directives (such as ~%, or ~&, +or ~A +with the argument being a string containing a newline) cause +the column position to be reset to zero, and counting the number of characters +emitted since that point. If that fails, format +may attempt a +similar deduction on the riskier assumption that the destination was +at column zero when format +was invoked. If even this heuristic fails +or is implementationally inconvenient, at worst +the ~T operation will simply output two spaces. +

    +

    ~@T performs relative tabulation. +~colrel,colinc@T outputs colrel spaces +and then outputs the smallest non-negative +number of additional spaces necessary to move the cursor +to a column that is a multiple +of colinc. For example, the directive +~3,8@T outputs +three spaces and then moves the cursor to a “standard multiple-of-eight +tab stop” if not at one already. +If the current output column cannot be determined, however, +then colinc is ignored, and exactly colrel spaces are output. +

    +

    If the colon modifier is used with the ~T directive, +the tabbing computation is done relative to the horizontal position where the +section immediately containing the directive begins, rather than with +respect to a horizontal position of zero. The numerical parameters are +both interpreted as being in units of ems and both default to 1. +~n,m:T is the same as + (pprint-tab :section n m). +~n,m:@T is the same as + (pprint-tab :section-relative n m). +

    +
    +
    +

    +Next: , Previous: , Up: FORMAT Layout Control  

    +
    + + + + + diff --git a/info/gcl/Tilde-Tilde_002d_003e-Tilde.html b/info/gcl/Tilde-Tilde_002d_003e-Tilde.html new file mode 100644 index 0000000..cd1c269 --- /dev/null +++ b/info/gcl/Tilde-Tilde_002d_003e-Tilde.html @@ -0,0 +1,53 @@ + + + + + +Tilde Tilde-> Tilde (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Basic Output  

    +
    +
    +

    22.3.1.5 Tilde Tilde: Tilde

    + +

    This outputs a tilde. ~n~ outputs n tildes. +

    + + + + + diff --git a/info/gcl/Tilde-Underscore_002d_003e-Conditional-Newline.html b/info/gcl/Tilde-Underscore_002d_003e-Conditional-Newline.html new file mode 100644 index 0000000..773e2f1 --- /dev/null +++ b/info/gcl/Tilde-Underscore_002d_003e-Conditional-Newline.html @@ -0,0 +1,56 @@ + + + + + +Tilde Underscore-> Conditional Newline (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Pretty Printer Operations  

    +
    +
    +

    22.3.5.1 Tilde Underscore: Conditional Newline

    + +

    Without any modifiers, ~_ is the same as (pprint-newline :linear). +~@_ is the same as (pprint-newline :miser). +~:_ is the same as (pprint-newline :fill). +~:@_ is the same as (pprint-newline :mandatory). +

    + + + + + diff --git a/info/gcl/Tilde-Vertical_002dBar_002d_003e-Page.html b/info/gcl/Tilde-Vertical_002dBar_002d_003e-Page.html new file mode 100644 index 0000000..fb306e0 --- /dev/null +++ b/info/gcl/Tilde-Vertical_002dBar_002d_003e-Page.html @@ -0,0 +1,54 @@ + + + + + +Tilde Vertical-Bar-> Page (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: FORMAT Basic Output  

    +
    +
    +

    22.3.1.4 Tilde Vertical-Bar: Page

    + +

    This outputs a page separator character, if possible. +~n| does this n times. +

    + + + + + diff --git a/info/gcl/Tilde-W_002d_003e-Write.html b/info/gcl/Tilde-W_002d_003e-Write.html new file mode 100644 index 0000000..fb1e022 --- /dev/null +++ b/info/gcl/Tilde-W_002d_003e-Write.html @@ -0,0 +1,63 @@ + + + + + +Tilde W-> Write (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Printer Operations  

    +
    +
    +

    22.3.4.3 Tilde W: Write

    + +

    An argument, any object, is printed obeying every printer control +variable (as by write). In addition, ~W interacts correctly with depth +abbreviation, by not resetting the depth counter to zero. ~W does not +accept parameters. If given the colon modifier, ~W binds *print-pretty* +to true. If given the at-sign modifier, ~W binds *print-level* +and *print-length* to nil. +

    +

    ~W provides automatic support for the detection of circularity and +sharing. If the value of *print-circle* is not nil and ~W is applied +to an argument that is a circular (or shared) reference, an appropriate +#n# marker is inserted in the output instead of printing the argument. +

    + + + + + diff --git a/info/gcl/Tilde-X_002d_003e-Hexadecimal.html b/info/gcl/Tilde-X_002d_003e-Hexadecimal.html new file mode 100644 index 0000000..413790d --- /dev/null +++ b/info/gcl/Tilde-X_002d_003e-Hexadecimal.html @@ -0,0 +1,62 @@ + + + + + +Tilde X-> Hexadecimal (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: FORMAT Radix Control  

    +
    +
    +

    22.3.2.5 Tilde X: Hexadecimal

    + +

    This is just like ~D but prints in hexadecimal radix +(radix 16) instead of decimal. The full form is therefore +~mincol,padchar,commachar,comma-intervalX. +

    +

    ~X binds + *print-escape* to false, + *print-radix* to false, + *print-base* to 16, +

    +

    and *print-readably* to false. +

    + + + + + diff --git a/info/gcl/Time.html b/info/gcl/Time.html new file mode 100644 index 0000000..95d62cf --- /dev/null +++ b/info/gcl/Time.html @@ -0,0 +1,92 @@ + + + + + +Time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: The External Environment  

    +
    +
    +

    25.1.4 Time

    + +

    Time is represented in four different ways in Common Lisp: + decoded time, + universal time, + internal time, +and seconds. +Decoded time and universal time are used primarily to represent calendar time, +and are precise only to one second. +Internal time is used primarily to represent measurements of computer +time (such as run time) and is precise to some implementation-dependent +fraction of a second called an internal time unit, +as specified by internal-time-units-per-second. +An internal time can be used + for either absolute and relative time measurements. +Both a universal time and a decoded time can be used + only for absolute time measurements. +In the case of one function, sleep, +time intervals are represented as a non-negative real number of seconds. +

    +

    Figure 25–4 shows defined names relating to time. +

    +
    +
      decode-universal-time   get-internal-run-time           
+  encode-universal-time   get-universal-time              
+  get-decoded-time        internal-time-units-per-second  
+  get-internal-real-time  sleep                           
+
+        Figure 25–4: Defined names involving Time.       
+
+
    + + + + + + +
    • Decoded Time   +
    • Universal Time   +
    • Internal Time   +
    • Seconds   +
    + + + + + + diff --git a/info/gcl/Too-Few-Arguments.html b/info/gcl/Too-Few-Arguments.html new file mode 100644 index 0000000..b3b78db --- /dev/null +++ b/info/gcl/Too-Few-Arguments.html @@ -0,0 +1,60 @@ + + + + + +Too Few Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.3 Too Few Arguments

    + +

    It is not permitted to supply too few arguments to a function. +Too few arguments means fewer arguments than the number of required parameters +for the function. +

    +

    If this situation occurs in a safe call, +

    +

    an error of type program-error must be signaled; +and in an unsafe call the situation has undefined consequences. +

    + + + + + diff --git a/info/gcl/Too-Many-Arguments.html b/info/gcl/Too-Many-Arguments.html new file mode 100644 index 0000000..104628c --- /dev/null +++ b/info/gcl/Too-Many-Arguments.html @@ -0,0 +1,61 @@ + + + + + +Too Many Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.4 Too Many Arguments

    + +

    It is not permitted to supply too many arguments to a function. +Too many arguments means more arguments than the number of required parameters +plus the number of optional parameters; however, if the function +uses &rest or &key, it is not possible for it to receive too many arguments. +

    +

    If this situation occurs in a safe call, +

    +

    an error of type program-error must be signaled; +and in an unsafe call the situation has undefined consequences. +

    + + + + + diff --git a/info/gcl/Top-level-loop.html b/info/gcl/Top-level-loop.html new file mode 100644 index 0000000..5e7faca --- /dev/null +++ b/info/gcl/Top-level-loop.html @@ -0,0 +1,73 @@ + + + + + +Top level loop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The External Environment  

    +
    +
    +

    25.1.1 Top level loop

    + +

    The top level loop is the Common Lisp mechanism by which the user normally +interacts with the Common Lisp system. This loop is sometimes referred to +as the Lisp read-eval-print loop +because it typically consists of an endless loop that reads an expression, +evaluates it and prints the results. +

    +

    The top level loop is not completely specified; thus the user +interface is implementation-defined. +The top level loop +prints all values resulting from the evaluation of a +form. +Figure 25–1 lists variables that are maintained by the Lisp read-eval-print loop. +

    +
    +
      *    +    /    -  
+  **   ++   //      
+  ***  +++  ///     
+
+  Figure 25–1: Variables maintained by the Read-Eval-Print Loop
+
+
    + + + + + + diff --git a/info/gcl/Topological-Sorting.html b/info/gcl/Topological-Sorting.html new file mode 100644 index 0000000..cdbd757 --- /dev/null +++ b/info/gcl/Topological-Sorting.html @@ -0,0 +1,100 @@ + + + + + +Topological Sorting (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Determining the Class Precedence List  

    +
    +
    +

    4.3.5.1 Topological Sorting

    + +

    Topological sorting proceeds by finding a class C in~S_C such +that no other class precedes that element according to the elements +in~R. The class C is placed first in the result. +Remove C from S_C, and remove all pairs of the form (C,D), +D\in S_C, from R. Repeat the process, adding +classes with no predecessors to the end of the result. Stop when no +element can be found that has no predecessor. +

    +

    If S_C is not empty and the process has stopped, the set R is +inconsistent. If every class in the finite set of +classes is preceded +by another, then R contains a loop. That is, there is a chain of +classes C_1,...,C_n such that C_i precedes +C_{i+1}, 1<= i<n, and C_n precedes C_1. +

    +

    Sometimes there are several classes from S_C with no +predecessors. In this case select the one that has a direct +subclass rightmost in the class precedence list computed so far. +(If there is no such candidate class, R does not generate +a partial ordering—the R_c, c\in S_C, are inconsistent.) +

    +

    In more precise terms, let {N_1,...,N_m}, m>= 2, be +the classes from S_C with no predecessors. Let (C_1... C_n), n>= 1, be the class precedence list +constructed so far. C_1 is the most specific class, and C_n is the least specific. Let 1<= j<= n be the largest number +such that there exists an i where 1<= i<= m and N_i +is a direct superclass of C_j; N_i is placed next. +

    +

    The effect of this rule for selecting from a set of classes with no +predecessors is that the classes in a simple superclass chain are +adjacent in the class precedence list and that classes in each +relatively separated subgraph are adjacent in the class precedence list. +For example, let T_1 and T_2 be subgraphs whose only +element in common is the class J. +Suppose that no superclass of J appears in either T_1 or T_2, +and that J is in the superclass chain of every class in both T_1 and T_2. + Let C_1 be the bottom of T_1; +and let C_2 be the bottom of T_2. +Suppose C is a class whose direct superclasses +are C_1 and C_2 in that order, then the class precedence list +for C starts with C and is followed by +all classes in T_1 except J. +All the classes of T_2 are next. +The class J and its superclasses appear last. +

    +
    +
    +

    +Next: , Previous: , Up: Determining the Class Precedence List  

    +
    + + + + + diff --git a/info/gcl/Transfer-of-Control-during-a-Destructive-Operation.html b/info/gcl/Transfer-of-Control-during-a-Destructive-Operation.html new file mode 100644 index 0000000..bdc6bce --- /dev/null +++ b/info/gcl/Transfer-of-Control-during-a-Destructive-Operation.html @@ -0,0 +1,60 @@ + + + + + +Transfer of Control during a Destructive Operation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Destructive Operations  

    +
    +
    +

    3.7.2 Transfer of Control during a Destructive Operation

    + +

    Should a transfer of control out of a destructive operation occur +(e.g., due to an error) the state of the object being modified is +implementation-dependent. +

    + + +
    • Examples of Transfer of Control during a Destructive Operation   +
    + + + + + + diff --git a/info/gcl/Transfer-of-Control-to-an-Exit-Point.html b/info/gcl/Transfer-of-Control-to-an-Exit-Point.html new file mode 100644 index 0000000..97a14e4 --- /dev/null +++ b/info/gcl/Transfer-of-Control-to-an-Exit-Point.html @@ -0,0 +1,111 @@ + + + + + +Transfer of Control to an Exit Point (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow  

    +
    +
    +

    5.2 Transfer of Control to an Exit Point

    + + +

    When a transfer of control is initiated by go, +return-from, or throw +the following events occur in order to accomplish the transfer of control. +Note that for go, +the exit point is the form within the tagbody +that is being executed at the time the go is performed; +for return-from, +the exit point is the corresponding +block form; +and for throw, +the exit point is the corresponding +catch form. +

    +
    +
    1.
    +

    Intervening exit points are “abandoned” + (i.e., their extent ends + and it is no longer valid to attempt to transfer control through them). +

    +
    +
    2.
    +

    The cleanup clauses of any intervening unwind-protect clauses + are evaluated. +

    +
    +
    3.
    +

    Intervening dynamic bindings of special variables, + catch tags, condition handlers, and restarts + are undone. +

    +
    +
    4.
    +

    The extent of the exit point being invoked ends, + and control is passed to the target. +

    +
    + +

    The extent of an exit being “abandoned” because it is being passed over +ends as soon as the transfer of control is initiated. That is, +event 1 occurs at the beginning of the initiation of the transfer of +control. +The consequences are undefined if an attempt is made to transfer control +to an exit point whose dynamic extent has ended. +

    +

    Events 2 and 3 are actually performed interleaved, in the order +corresponding to the reverse order in which they were established. +The effect of this is that the cleanup clauses of an unwind-protect +see the same dynamic bindings +of variables and catch tags as were +visible when the unwind-protect was entered. +

    +

    Event 4 occurs at the end of the transfer of control. +

    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow  

    +
    + + + + + diff --git a/info/gcl/Traversal-Rules-and-Side-Effects.html b/info/gcl/Traversal-Rules-and-Side-Effects.html new file mode 100644 index 0000000..f0cd780 --- /dev/null +++ b/info/gcl/Traversal-Rules-and-Side-Effects.html @@ -0,0 +1,87 @@ + + + + + +Traversal Rules and Side Effects (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation  

    +
    +
    +

    3.6 Traversal Rules and Side Effects

    + + +

    The consequences are undefined +when code executed during an object-traversing operation +destructively modifies the object in a way that might affect the +ongoing traversal operation. +In particular, the following rules apply. +

    +
    List traversal
    +

    For list traversal operations, the cdr chain of the + list is not allowed to be destructively modified. +

    +
    +
    Array traversal
    +

    For array traversal operations, the array is not allowed + to be adjusted and its fill pointer, if any, is not allowed to + be changed. +

    +
    +
    Hash-table traversal
    +

    For hash table traversal operations, new elements may not be added + or deleted except that the element corresponding to the current hash key + may be changed or removed. +

    +
    +
    Package traversal
    +

    For package traversal operations (e.g., do-symbols), + new symbols may not be interned in or uninterned + from the package being traversed + or any package that it uses except that the + current symbol may be uninterned from the package + being traversed. +

    +
    +
    + + + + + + + diff --git a/info/gcl/Treatment-of-Exceptional-Situations.html b/info/gcl/Treatment-of-Exceptional-Situations.html new file mode 100644 index 0000000..4ed661c --- /dev/null +++ b/info/gcl/Treatment-of-Exceptional-Situations.html @@ -0,0 +1,54 @@ + + + + + +Treatment of Exceptional Situations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conforming Implementations  

    +
    +
    +

    1.5.1.4 Treatment of Exceptional Situations

    + +

    A conforming implementation shall treat exceptional situations +in a manner consistent with this specification. +

    + + + + + diff --git a/info/gcl/Treatment-of-Newline-during-Input-and-Output.html b/info/gcl/Treatment-of-Newline-during-Input-and-Output.html new file mode 100644 index 0000000..f787faa --- /dev/null +++ b/info/gcl/Treatment-of-Newline-during-Input-and-Output.html @@ -0,0 +1,57 @@ + + + + + +Treatment of Newline during Input and Output (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Concepts  

    +
    +
    +

    13.1.8 Treatment of Newline during Input and Output

    + +

    When the character #\Newline is written to an output file, +the implementation must take the appropriate action +to produce a line division. This might involve writing out a +record or translating #\Newline to a CR/LF sequence. +When reading, a corresponding reverse transformation must take place. +

    + + + + + diff --git a/info/gcl/Treatment-of-Other-Macros-Based-on-SETF.html b/info/gcl/Treatment-of-Other-Macros-Based-on-SETF.html new file mode 100644 index 0000000..3c56fe2 --- /dev/null +++ b/info/gcl/Treatment-of-Other-Macros-Based-on-SETF.html @@ -0,0 +1,102 @@ + + + + + +Treatment of Other Macros Based on SETF (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Generalized Reference  

    +
    +
    +

    5.1.3 Treatment of Other Macros Based on SETF

    + +

    For each of the “read-modify-write” operators in Figure 5–9, +and for any additional macros +defined by the programmer using define-modify-macro, +an exception is made to the normal rule of left-to-right evaluation of arguments. +Evaluation of argument forms occurs in left-to-right order, +with the exception that for the place argument, the actual +read of the “old value” from that place happens +after all of the argument form evaluations, +and just before a “new value” is computed and written back into the place. +

    +

    Specifically, each of these operators can be viewed as involving a +form with the following general syntax: +

    +
    +
     (operator {preceding-form}* place {following-form}*)
+
    + +

    The evaluation of each such form proceeds like this: +

    +
    +
    1.
    +

    Evaluate each of the preceding-forms, in left-to-right order. +

    +
    2.
    +

    Evaluate the subforms of the place, + in the order specified by the second value of the setf expansion + for that place. +

    +
    3.
    +

    Evaluate each of the following-forms, in left-to-right order. +

    +
    4.
    +

    Read the old value from place. +

    +
    5.
    +

    Compute the new value. +

    +
    6.
    +

    Store the new value into place. +

    +
    + +
    +
      decf  pop   pushnew  
+  incf  push  remf     
+
+  Figure 5–9: Read-Modify-Write Macros
+
+
    + + + + + + + diff --git a/info/gcl/Truenames.html b/info/gcl/Truenames.html new file mode 100644 index 0000000..d232640 --- /dev/null +++ b/info/gcl/Truenames.html @@ -0,0 +1,78 @@ + + + + + +Truenames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: File System Concepts  

    +
    +
    +

    20.1.3 Truenames

    + +

    Many file systems permit more than one filename to designate +a particular file. +

    +

    Even where multiple names are possible, most file systems have a convention +for generating a canonical filename in such situations. Such a canonical +filename (or the pathname representing such a filename) is +called a truename + +. +

    +

    The truename of a file may differ from other filenames +for the file because of + symbolic links, + version numbers, + logical device translations in the file system, + logical pathname translations within Common Lisp, + or other artifacts of the file system. +

    +

    The truename for a file is often, but not necessarily, unique for +each file. For instance, a Unix file with multiple hard links +could have several truenames. +

    + + +
    • Examples of Truenames   +
    + + + + + + diff --git a/info/gcl/Type-Relationships.html b/info/gcl/Type-Relationships.html new file mode 100644 index 0000000..d1d6ad6 --- /dev/null +++ b/info/gcl/Type-Relationships.html @@ -0,0 +1,110 @@ + + + + + +Type Relationships (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types  

    +
    +
    +

    4.2.2 Type Relationships

    + +
    +
    *
    +

    The types cons, symbol, array, number, +character, hash-table, +

    +

    function, +

    +

    readtable, package, pathname, stream, +random-state, condition, restart, +and any single other type created by defstruct, +

    +

    define-condition, +

    +

    or defclass are pairwise disjoint, +except for type relations explicitly established by specifying +superclasses in defclass +

    +

    or define-condition +

    +

    or the :include option of destruct. +

    +
    +
    *
    +

    Any two types created by defstruct are +disjoint unless +one is a supertype of the other by virtue of +the defstruct :include option. +

    +

    [Editorial Note by KMP: The comments in the source say gray suggested some change +from “common superclass” to “common subclass” in the following, but the +result looks suspicious to me.] +

    +
    +
    *
    +

    Any two distinct classes created by defclass +or define-condition +are disjoint unless they have a common subclass or +one class is a subclass of the other. +

    +
    +
    *
    +

    An implementation may be extended to add other subtype +relationships between the specified types, as long as they do +not violate the type relationships and disjointness requirements +specified here. An implementation may define additional types +that are subtypes or supertypes of any +specified types, as long as each additional type is +a subtype of type t and a supertype of type nil and the disjointness requirements +are not violated. +

    +

    At the discretion of the implementation, either standard-object +or structure-object might appear in any class precedence list +for a system class that does not already specify either +standard-object or structure-object. If it does, +it must precede the class t and follow all other standardized classes. +

    +
    +
    + + + + + + diff --git a/info/gcl/Type-Specifiers.html b/info/gcl/Type-Specifiers.html new file mode 100644 index 0000000..a6d194c --- /dev/null +++ b/info/gcl/Type-Specifiers.html @@ -0,0 +1,267 @@ + + + + + +Type Specifiers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Types  

    +
    +
    +

    4.2.3 Type Specifiers

    + +

    Type specifiers can be symbols, classes, or lists. +Figure~4–2 lists symbols that are + standardized atomic type specifiers, and +Figure~4–3 lists + standardized compound type specifier names. +For syntax information, see the dictionary entry for the corresponding type specifier. +It is possible to define new type specifiers using + defclass, + define-condition, + defstruct, +or + deftype. +

    +
    +
     arithmetic-error                 function           simple-condition          
+ array                            generic-function   simple-error              
+ atom                             hash-table         simple-string             
+ base-char                        integer            simple-type-error         
+ base-string                      keyword            simple-vector             
+ bignum                           list               simple-warning            
+ bit                              logical-pathname   single-float              
+ bit-vector                       long-float         standard-char             
+ broadcast-stream                 method             standard-class            
+ built-in-class                   method-combination standard-generic-function 
+ cell-error                       nil                standard-method           
+ character                        null               standard-object           
+ class                            number             storage-condition         
+ compiled-function                package            stream                    
+ complex                          package-error      stream-error              
+ concatenated-stream              parse-error        string                    
+ condition                        pathname           string-stream             
+ cons                             print-not-readable structure-class           
+ control-error                    program-error      structure-object          
+ division-by-zero                 random-state       style-warning             
+ double-float                     ratio              symbol                    
+ echo-stream                      rational           synonym-stream            
+ end-of-file                      reader-error       t                         
+ error                            readtable          two-way-stream            
+ extended-char                    real               type-error                
+ file-error                       restart            unbound-slot              
+ file-stream                      sequence           unbound-variable          
+ fixnum                           serious-condition  undefined-function        
+ float                            short-float        unsigned-byte             
+ floating-point-inexact           signed-byte        vector                    
+ floating-point-invalid-operation simple-array       warning                   
+ floating-point-overflow          simple-base-string                           
+ floating-point-underflow         simple-bit-vector                            
+
+                 Figure 4–2: Standardized Atomic Type Specifiers               
+
+
    + +

    \indent +If a type specifier is a list, the car of the list +is a symbol, and the rest of the list is subsidiary +type information. Such a type specifier is called +a compound type specifier + +. +Except as explicitly stated otherwise, +the subsidiary items can be unspecified. +The unspecified subsidiary items are indicated +by writing *. For example, to completely specify +a vector, the type of the elements +and the length of the vector must be present. +

    +
    +
     (vector double-float 100)
+
    + +

    The following leaves the length unspecified: +

    +
    +
     (vector double-float *)
+
    + +

    The following leaves the element type unspecified: +

    +
    +
     (vector * 100)                                      
+
    + +

    Suppose that two type specifiers are the same except that the first +has a * where the second has a more explicit specification. +Then the second denotes a subtype +of the type denoted by the first. +

    +

    If a list has one or more unspecified items at the end, +those items can be dropped. +If dropping all occurrences of * results in a singleton list, +then the parentheses can be dropped as well (the list can be replaced +by the symbol in its car). +For example, +(vector double-float *) +can be abbreviated to (vector double-float), +and (vector * *) can be abbreviated to (vector) +and then to +vector. +

    +
    +
      and           long-float    simple-base-string  
+  array         member        simple-bit-vector   
+  base-string   mod           simple-string       
+  bit-vector    not           simple-vector       
+  complex       or            single-float        
+  cons          rational      string              
+  double-float  real          unsigned-byte       
+  eql           satisfies     values              
+  float         short-float   vector              
+  function      signed-byte                       
+  integer       simple-array                      
+
+  Figure 4–3: Standardized Compound Type Specifier Names
+
+
    + +

    Figure 4–4 show the defined names that can be used as +compound type specifier names +but that cannot be used as atomic type specifiers. +

    +
    +
      and     mod  satisfies  
+  eql     not  values     
+  member  or              
+
+  Figure 4–4: Standardized Compound-Only Type Specifier Names
+
+
    + +

    New type specifiers can come into existence in two ways. +

    +
    *
    +

    Defining a structure by using defstruct without using + the :type specifier or defining a class by using + defclass + or define-condition + automatically causes the name of the structure + or class to be a new type specifier symbol. +

    +
    *
    +

    deftype can be used to define derived type specifiers + +, + which act as ‘abbreviations’ for other type specifiers. +

    +
    + +

    A class object can be used as a type specifier. +When used this way, it denotes the set of all members of that class. +

    +

    Figure 4–5 shows some defined names relating to +types and declarations. +

    +
    +
      coerce            defstruct  subtypep  
+  declaim           deftype    the       
+  declare           ftype      type      
+  defclass          locally    type-of   
+  define-condition  proclaim   typep     
+
+  Figure 4–5: Defined names relating to types and declarations.
+
+
    + +

    Figure 4–6 shows all defined names that are type specifier names, +whether for atomic type specifiers or compound type specifiers; +this list is the union of the lists in Figure~4–2 +and Figure~4–3. +

    +
    +
     and                              function           simple-array              
+ arithmetic-error                 generic-function   simple-base-string        
+ array                            hash-table         simple-bit-vector         
+ atom                             integer            simple-condition          
+ base-char                        keyword            simple-error              
+ base-string                      list               simple-string             
+ bignum                           logical-pathname   simple-type-error         
+ bit                              long-float         simple-vector             
+ bit-vector                       member             simple-warning            
+ broadcast-stream                 method             single-float              
+ built-in-class                   method-combination standard-char             
+ cell-error                       mod                standard-class            
+ character                        nil                standard-generic-function 
+ class                            not                standard-method           
+ compiled-function                null               standard-object           
+ complex                          number             storage-condition         
+ concatenated-stream              or                 stream                    
+ condition                        package            stream-error              
+ cons                             package-error      string                    
+ control-error                    parse-error        string-stream             
+ division-by-zero                 pathname           structure-class           
+ double-float                     print-not-readable structure-object          
+ echo-stream                      program-error      style-warning             
+ end-of-file                      random-state       symbol                    
+ eql                              ratio              synonym-stream            
+ error                            rational           t                         
+ extended-char                    reader-error       two-way-stream            
+ file-error                       readtable          type-error                
+ file-stream                      real               unbound-slot              
+ fixnum                           restart            unbound-variable          
+ float                            satisfies          undefined-function        
+ floating-point-inexact           sequence           unsigned-byte             
+ floating-point-invalid-operation serious-condition  values                    
+ floating-point-overflow          short-float        vector                    
+ floating-point-underflow         signed-byte        warning                   
+
+                  Figure 4–6: Standardized Type Specifier Names                
+
+
    + + +
    +
    +

    +Previous: , Up: Types  

    +
    + + + + + diff --git a/info/gcl/Types-and-Classes-Dictionary.html b/info/gcl/Types-and-Classes-Dictionary.html new file mode 100644 index 0000000..4218ece --- /dev/null +++ b/info/gcl/Types-and-Classes-Dictionary.html @@ -0,0 +1,122 @@ + + + + + +Types and Classes Dictionary (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Types and Classes  

    +
    +
    +

    4.4 Types and Classes Dictionary

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • nil (Type)   +
    • boolean   +
    • function (System Class)   +
    • compiled-function   +
    • generic-function   +
    • standard-generic-function   +
    • class   +
    • built-in-class   +
    • structure-class   +
    • standard-class   +
    • method   +
    • standard-method   +
    • structure-object   +
    • standard-object   +
    • method-combination   +
    • t (System Class)   +
    • satisfies   +
    • member (Type Specifier)   +
    • not (Type Specifier)   +
    • and (Type Specifier)   +
    • or (Type Specifier)   +
    • values (Type Specifier)   +
    • eql (Type Specifier)   +
    • coerce   +
    • deftype   +
    • subtypep   +
    • type-of   +
    • typep   +
    • type-error   +
    • type-error-datum   +
    • simple-type-error   +
    + +
    +
    +

    +Previous: , Up: Types and Classes  

    +
    + + + + + diff --git a/info/gcl/Types-and-Classes.html b/info/gcl/Types-and-Classes.html new file mode 100644 index 0000000..cf64d7a --- /dev/null +++ b/info/gcl/Types-and-Classes.html @@ -0,0 +1,62 @@ + + + + + +Types and Classes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Top  

    +
    +
    +

    4 Types and Classes

    + + + + + + +
    • Introduction (Types and Classes)   +
    • Types   +
    • Classes   +
    • Types and Classes Dictionary   +
    + + + + + + diff --git a/info/gcl/Types.html b/info/gcl/Types.html new file mode 100644 index 0000000..81129da --- /dev/null +++ b/info/gcl/Types.html @@ -0,0 +1,61 @@ + + + + + +Types (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes  

    +
    +
    +

    4.2 Types

    + + + + + + +
    • Data Type Definition   +
    • Type Relationships   +
    • Type Specifiers   +
    + + + + + + diff --git a/info/gcl/Unconditional-Execution-Clauses.html b/info/gcl/Unconditional-Execution-Clauses.html new file mode 100644 index 0000000..15faede --- /dev/null +++ b/info/gcl/Unconditional-Execution-Clauses.html @@ -0,0 +1,74 @@ + + + + + +Unconditional Execution Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.5 Unconditional Execution Clauses

    + +

    The do and doing constructs +evaluate the +supplied forms +wherever they occur in the expanded form of loop. + The form argument can be any compound form. +Each form is evaluated in every iteration. +Because every loop clause must begin with a loop keyword, +the keyword do is used when no control action other than execution is +required. +

    +

    The return construct takes one form. + Any values returned by the form + are immediately returned by the loop form. + It is equivalent to the clause + do (return-from block-name value), + where block-name is the name specified in a named + clause, or nil if there is no named clause. +

    + + +
    • Examples of unconditional execution   +
    + + + + + + diff --git a/info/gcl/Unconditional-Transfer-of-Control-in-The-_0022Syntax_0022-Section.html b/info/gcl/Unconditional-Transfer-of-Control-in-The-_0022Syntax_0022-Section.html new file mode 100644 index 0000000..69264d9 --- /dev/null +++ b/info/gcl/Unconditional-Transfer-of-Control-in-The-_0022Syntax_0022-Section.html @@ -0,0 +1,58 @@ + + + + + +Unconditional Transfer of Control in The "Syntax" Section (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Dictionary Entries  

    +
    +
    +

    1.4.4.30 Unconditional Transfer of Control in The "Syntax" Section

    + +

    Some operators perform an unconditional transfer of control, and +so never have any return values. Such operators are notated using +a notation such as the following: +

    +

    F a b c + ⇒ #<NoValue> +

    + + + + + diff --git a/info/gcl/Undefined-FORMAT-Modifier-Combinations.html b/info/gcl/Undefined-FORMAT-Modifier-Combinations.html new file mode 100644 index 0000000..f6e0eae --- /dev/null +++ b/info/gcl/Undefined-FORMAT-Modifier-Combinations.html @@ -0,0 +1,55 @@ + + + + + +Undefined FORMAT Modifier Combinations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Additional Information about FORMAT Operations  

    +
    +
    +

    22.3.10.4 Undefined FORMAT Modifier Combinations

    + +

    The consequences are undefined if colon or at-sign modifiers +are given to a directive in a combination not specifically described +here as being meaningful. +

    + + + + + diff --git a/info/gcl/Universal-Time.html b/info/gcl/Universal-Time.html new file mode 100644 index 0000000..cbd11f0 --- /dev/null +++ b/info/gcl/Universal-Time.html @@ -0,0 +1,75 @@ + + + + + +Universal Time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Time  

    +
    +
    +

    25.1.4.2 Universal Time

    + +

    Universal time + + is an absolute time represented as a +single non-negative integer—the number of seconds since +midnight, January 1, 1900 GMT (ignoring leap seconds). +Thus the time 1 is 00:00:01 (that is, 12:00:01 a.m.) on January 1, 1900 GMT. +Similarly, the time 2398291201 corresponds to time 00:00:01 on January 1, +1976 GMT. +Recall that the year 1900 was not a leap year; for the purposes of +Common Lisp, a year is a leap year if and only if its number is divisible by 4, +except that years divisible by 100 are not leap years, except that years +divisible by 400 are leap years. Therefore the year 2000 will +be a leap year. +Because universal time must be a non-negative integer, +times before the base time of midnight, January 1, 1900 GMT cannot be processed by Common Lisp. +

    +
    +
      decode-universal-time  get-universal-time  
+  encode-universal-time                      
+
+  Figure 25–6: Defined names involving time in Universal Time.
+
+
    + + + + + + diff --git a/info/gcl/Unrecognized-Keyword-Arguments.html b/info/gcl/Unrecognized-Keyword-Arguments.html new file mode 100644 index 0000000..98a05cf --- /dev/null +++ b/info/gcl/Unrecognized-Keyword-Arguments.html @@ -0,0 +1,61 @@ + + + + + +Unrecognized Keyword Arguments (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Argument Mismatch Detection  

    +
    +
    +

    3.5.1.5 Unrecognized Keyword Arguments

    + +

    It is not permitted to supply a keyword argument to a function +using a name that is not recognized by that function +unless keyword argument checking is suppressed as described +in Suppressing Keyword Argument Checking. +

    +

    If this situation occurs in a safe call, +

    +

    an error of type program-error must be signaled; +and in an unsafe call the situation has undefined consequences. +

    + + + + + diff --git a/info/gcl/Unspecific-Components-of-a-Logical-Pathname.html b/info/gcl/Unspecific-Components-of-a-Logical-Pathname.html new file mode 100644 index 0000000..64e7feb --- /dev/null +++ b/info/gcl/Unspecific-Components-of-a-Logical-Pathname.html @@ -0,0 +1,54 @@ + + + + + +Unspecific Components of a Logical Pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Logical Pathname Components  

    +
    +
    +

    19.3.2.1 Unspecific Components of a Logical Pathname

    + +

    The device component of a logical pathname is always :unspecific; +no other component of a logical pathname can be :unspecific. +

    + + + + + diff --git a/info/gcl/Uppercase-Characters.html b/info/gcl/Uppercase-Characters.html new file mode 100644 index 0000000..b67ab7f --- /dev/null +++ b/info/gcl/Uppercase-Characters.html @@ -0,0 +1,59 @@ + + + + + +Uppercase Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Categories  

    +
    +
    +

    13.1.4.4 Uppercase Characters

    + +

    An uppercase character is one that has a corresponding +lowercase character that is different +(and can be obtained using char-downcase). +

    +

    Of the standard characters, only these are uppercase characters: +

    +

    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 +

    + + + + + diff --git a/info/gcl/Use-of-Double-Semicolon.html b/info/gcl/Use-of-Double-Semicolon.html new file mode 100644 index 0000000..cff8467 --- /dev/null +++ b/info/gcl/Use-of-Double-Semicolon.html @@ -0,0 +1,59 @@ + + + + + +Use of Double Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Semicolon  

    +
    +
    +

    2.4.4.4 Use of Double Semicolon

    + +

    Comments that begin with a double semicolon are all aligned to +the same level of indentation as a form would be at that same +position in the code. +The text of such a comment usually describes + the state of the program at the point where the comment occurs, + the code which follows the comment, + or both. +

    + + + + + diff --git a/info/gcl/Use-of-Implementation_002dDefined-Language-Features.html b/info/gcl/Use-of-Implementation_002dDefined-Language-Features.html new file mode 100644 index 0000000..b5ad9db --- /dev/null +++ b/info/gcl/Use-of-Implementation_002dDefined-Language-Features.html @@ -0,0 +1,73 @@ + + + + + +Use of Implementation-Defined Language Features (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conforming Programs  

    +
    +
    +

    1.5.2.1 Use of Implementation-Defined Language Features

    + +

    Note that conforming code may rely on particular +implementation-defined values or features. Also note that the +requirements for conforming code and conforming implementations do not +require that the results produced by conforming code always be the +same when processed by a conforming implementation. The results may be the +same, or they may differ. +

    +

    Portable code is written using only standard characters. +

    +

    Conforming code may run in all conforming implementations, but might +have allowable implementation-defined behavior that makes it +non-portable code. +For example, the following are examples of forms that are conforming, but +that might return different values in different implementations: +

    +
    +
     (evenp most-positive-fixnum) ⇒  implementation-dependent
+ (random) ⇒  implementation-dependent
+ (> lambda-parameters-limit 93) ⇒  implementation-dependent
+ (char-name #\A) ⇒  implementation-dependent
+
    + + + + + + diff --git a/info/gcl/Use-of-Quadruple-Semicolon.html b/info/gcl/Use-of-Quadruple-Semicolon.html new file mode 100644 index 0000000..2c7c178 --- /dev/null +++ b/info/gcl/Use-of-Quadruple-Semicolon.html @@ -0,0 +1,57 @@ + + + + + +Use of Quadruple Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Semicolon  

    +
    +
    +

    2.4.4.6 Use of Quadruple Semicolon

    + +

    Comments that begin with a quadruple semicolon are all aligned to +the left margin, and generally contain only a short piece of text that +serve as a title for the code which follows, and might be used in the +header or footer of a program that prepares code for presentation as +a hardcopy document. +

    + + + + + diff --git a/info/gcl/Use-of-Read_002dTime-Conditionals.html b/info/gcl/Use-of-Read_002dTime-Conditionals.html new file mode 100644 index 0000000..03b928d --- /dev/null +++ b/info/gcl/Use-of-Read_002dTime-Conditionals.html @@ -0,0 +1,76 @@ + + + + + +Use of Read-Time Conditionals (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conforming Programs  

    +
    +
    +

    1.5.2.2 Use of Read-Time Conditionals

    + +

    Use of #+ and #- does not automatically disqualify a program +from being conforming. A program which uses #+ and #- is +considered conforming if there is no set of features in which the +program would not be conforming. Of course, conforming programs are +not necessarily working programs. The following program is conforming: +

    +
    +
    (defun foo ()
+  #+ACME (acme:initialize-something)
+  (print 'hello-there))
+
    + +

    However, this program might or might not work, depending on whether the +presence of the feature ACME really implies that a function named +acme:initialize-something is present in the environment. In effect, +using #+ or #- in a conforming program means that the variable +*features* + +

    +

    becomes just one more piece of input data to that +program. Like any other data coming into a program, the programmer +is responsible for assuring that the program does not make unwarranted +assumptions on the basis of input data. +

    + + + + + + diff --git a/info/gcl/Use-of-Single-Semicolon.html b/info/gcl/Use-of-Single-Semicolon.html new file mode 100644 index 0000000..ceb67d8 --- /dev/null +++ b/info/gcl/Use-of-Single-Semicolon.html @@ -0,0 +1,58 @@ + + + + + +Use of Single Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Semicolon  

    +
    +
    +

    2.4.4.3 Use of Single Semicolon

    + +

    Comments that begin with a single semicolon are all aligned to +the same column at the right (sometimes called the “comment column”). +The text of such a comment generally applies only to the line on which it appears. +Occasionally two or three contain a single sentence together; +this is sometimes indicated by indenting all but the first with an additional +space (after the semicolon). +

    + + + + + diff --git a/info/gcl/Use-of-Triple-Semicolon.html b/info/gcl/Use-of-Triple-Semicolon.html new file mode 100644 index 0000000..1a3b6ee --- /dev/null +++ b/info/gcl/Use-of-Triple-Semicolon.html @@ -0,0 +1,55 @@ + + + + + +Use of Triple Semicolon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Semicolon  

    +
    +
    +

    2.4.4.5 Use of Triple Semicolon

    + +

    Comments that begin with a triple semicolon are all aligned to +the left margin. Usually they are used prior to a definition or set +of definitions, rather than within a definition. +

    + + + + + diff --git a/info/gcl/Use-of-the-Dot-Character.html b/info/gcl/Use-of-the-Dot-Character.html new file mode 100644 index 0000000..2b5b8ec --- /dev/null +++ b/info/gcl/Use-of-the-Dot-Character.html @@ -0,0 +1,74 @@ + + + + + +Use of the Dot Character (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Notational Conventions  

    +
    +
    +

    1.4.1.10 Use of the Dot Character

    + +

    The dot appearing by itself in an expression such as +

    +

    (item1 item2 . tail) +

    +

    means that tail represents a list of objects +at the end of a list. For example, +

    +

    (A B C . (D E F)) +

    +

    is notationally equivalent to: +

    +

    (A B C D E F) +

    +

    Although dot is a valid constituent character in a symbol, no +standardized symbols contain the character dot, +so a period that follows a reference to a symbol at the end of +a sentence in this document should always be interpreted as a period +and never as part of the symbol’s name. +For example, within this document, a sentence such as + “This sample sentence refers to the symbol car.” +refers to a symbol whose name is "CAR" (with three letters), +and never to a four-letter symbol "CAR." +

    + + + + + diff --git a/info/gcl/VALUES-Forms-as-Places.html b/info/gcl/VALUES-Forms-as-Places.html new file mode 100644 index 0000000..fef1e04 --- /dev/null +++ b/info/gcl/VALUES-Forms-as-Places.html @@ -0,0 +1,87 @@ + + + + + +VALUES Forms as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.3 VALUES Forms as Places

    + +

    A values form can be used as a place, +provided that each of its subforms is also a place form. +

    +

    A form such as +

    +

    (setf (values place-1 \dots place-n) values-form) +

    +

    does the following: +

    +
    +
    1.
    +

    The subforms of each nested place are evaluated +in left-to-right order. +

    +
    2.
    +

    The values-form is evaluated, and the first store +variable from each place is bound to its return values as if by +multiple-value-bind. +

    +
    3.
    +

    If the setf expansion for any place +involves more than one store variable, then the additional +store variables are bound to nil. +

    +
    4.
    +

    The storing forms for each place are evaluated in +left-to-right order. +

    +
    + +

    The storing form in the setf expansion of values +returns as multiple values_2 the values of the store +variables in step 2. That is, the number of values returned is the +same as the number of place forms. This may be more or fewer +values than are produced by the values-form. +

    + + + + + diff --git a/info/gcl/Valid-Patterns-for-Tokens.html b/info/gcl/Valid-Patterns-for-Tokens.html new file mode 100644 index 0000000..1cb9465 --- /dev/null +++ b/info/gcl/Valid-Patterns-for-Tokens.html @@ -0,0 +1,150 @@ + + + + + +Valid Patterns for Tokens (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpretation of Tokens  

    +
    +
    +

    2.3.5 Valid Patterns for Tokens

    + +

    The valid patterns for tokens are summarized in Figure 2–17. +

    +
    +
      nnnnn              a number                                           
+  xxxxx              a symbol in the current package                    
+  :xxxxx             a symbol in the the KEYWORD package                
+  ppppp:xxxxx        an external symbol in the ppppp package            
+  ppppp::xxxxx       a (possibly internal) symbol in the ppppp package  
+  :nnnnn             undefined                                          
+  ppppp:nnnnn        undefined                                          
+  ppppp::nnnnn       undefined                                          
+  ::aaaaa            undefined                                          
+  aaaaa:             undefined                                          
+  aaaaa:aaaaa:aaaaa  undefined                                          
+
+                 Figure 2–17: Valid patterns for tokens                
+
+
    + +

    Note that nnnnn has number syntax, + neither xxxxx nor ppppp has number syntax, + and aaaaa has any syntax. +

    +

    A summary of rules concerning package markers follows. +In each case, examples are offered to illustrate the case; +for presentational simplicity, the examples assume that +the readtable case of the current readtable is :upcase. +

    +
    +
    1.
    +

    If there is a single package marker, and it occurs at the beginning of the +token, then the token is interpreted as a symbol in the KEYWORD package. +It also sets the symbol-value of the newly-created symbol to that +same symbol so that the symbol will self-evaluate. +

    +

    For example, +:bar, when read, interns BAR as an external symbol in the KEYWORD package. +

    +
    +
    2.
    +

    If there is a single package marker not at the beginning or end of the +token, then it divides the token into two parts. The first part +specifies a package; +the second part is the name of an external symbol +available in that package. +

    +

    For example, +foo:bar, when read, looks up BAR among the external symbols of +the package named FOO. +

    +
    +
    3.
    +

    If there are two adjacent package markers not at the beginning or end of the +token, then they divide the token into two parts. The first part +specifies a package; +the second part is the name of a symbol within +that package (possibly an internal symbol). +

    +

    For example, +foo::bar, when read, interns BAR in the package named FOO. +

    +
    +
    4.
    +

    If the token contains no package markers, +and does not have potential number syntax, +then the entire token is the name of the symbol. +The symbol is looked up in the current package. +

    +

    For example, +bar, when read, interns BAR in the current package. +

    +
    +
    5.
    +

    The consequences are unspecified if any other pattern of package markers +in a token is used. +All other uses of package markers within names of symbols +are not defined by this standard +but are reserved for implementation-dependent use. +

    +
    + +

    For example, +assuming the readtable case of the current readtable is :upcase, +editor:buffer refers to the external symbol +named BUFFER present in the package named editor, +regardless of whether there is a symbol named BUFFER in +the current package. If there is no package named +editor, or if no symbol named BUFFER +is present in editor, or if BUFFER is not exported by +editor, the reader signals +a correctable error. +If editor::buffer is seen, the effect is exactly the same as +reading buffer with the EDITOR package being the current package. +

    +
    +
    +

    +Next: , Previous: , Up: Interpretation of Tokens  

    +
    + + + + + diff --git a/info/gcl/Value-Accumulation-Clauses.html b/info/gcl/Value-Accumulation-Clauses.html new file mode 100644 index 0000000..399bd0f --- /dev/null +++ b/info/gcl/Value-Accumulation-Clauses.html @@ -0,0 +1,246 @@ + + + + + +Value Accumulation Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.3 Value Accumulation Clauses

    + +

    The constructs collect, collecting, +append, appending, +nconc, nconcing, +count, counting, +maximize, maximizing, +minimize, minimizing, +sum, and summing, +allow values to be accumulated in a loop. +

    +

    The constructs collect, +collecting, append, appending, +nconc, and nconcing, +designate clauses that +accumulate values in lists and return them. +The constructs count, counting, +maximize, maximizing, minimize, minimizing, +sum, and summing designate clauses that accumulate and +return numerical values. +

    +

    During each iteration, the constructs +collect and collecting +collect the value of the supplied +form into a list. +When iteration terminates, the list is returned. +The argument var is +set to the list +of collected values; if var is supplied, the loop +does not return the final list automatically. If +var is not +supplied, it is equivalent to supplying an internal name for +var and returning its value in a finally clause. +The var argument +is bound as if by the construct with. +No mechanism is provided for declaring the type of var; +it must be of type list. +

    +

    The constructs append, appending, +nconc, and nconcing +are similar to collect except that the +values of the supplied form must be lists. +

    +
    +
    *
    +

    The append keyword causes its list values to be concatenated +into a single list, as if +they were arguments to the function append. +

    +
    +
    *
    +

    The nconc keyword causes its list values to be concatenated +into a single list, +as if they were arguments to the function nconc. +

    +
    + +

    The argument var is +set to the list of +concatenated values; if var is supplied, +loop +does not return the final list automatically. +The var argument +is bound as if by the construct with. + A type cannot be supplied for var; +it must be of type list. + The construct nconc +destructively modifies its argument lists. +

    +

    The count construct counts the number of times +that the supplied form returns true. +The argument var accumulates the number of occurrences; +if var is supplied, +loop does not return the final count automatically. +The var argument is bound as if by the construct with +to a zero of the appropriate type. +Subsequent values (including any necessary coercions) +are computed as if by the function 1+. +If into var is used, +a type can be supplied for var with the type-spec argument; +the consequences are unspecified if a nonnumeric type is supplied. +If there is no into variable, +the optional type-spec argument +applies to the internal variable that is keeping the count. +The default type is implementation-dependent; +but it must be +a supertype of type fixnum. +

    +

    The maximize and +minimize +constructs compare +the value of the supplied form obtained during the first +iteration with values obtained in successive iterations. +The maximum (for maximize) or minimum (for minimize) +value encountered is determined +(as if by the function max for maximize and + as if by the function min for minimize) +and returned. +If the maximize or minimize clause +is never executed, the accumulated value is unspecified. +The argument var accumulates the maximum or minimum value; +if var is supplied, +loop does not return the maximum or minimum automatically. +The var argument is bound as if by the construct with. +If into var is used, +a type can be supplied for var with the type-spec argument; +the consequences are unspecified if a nonnumeric type is supplied. +If there is no into variable, +the optional type-spec argument applies to the internal variable +that is keeping the maximum or minimum value. +The default type +is implementation-dependent; but it +must be a supertype of type real. +

    +

    The sum construct forms a cumulative sum +of the successive primary values of the supplied form +at each iteration. +The argument var is used to accumulate the sum; +if var is supplied, +loop does not return the final sum automatically. +The var argument is bound as if by the construct with +to a zero of the appropriate type. +Subsequent values (including any necessary coercions) are computed as if by the function +. +If into var is used, +a type can be supplied for var with the type-spec argument; +the consequences are unspecified if a nonnumeric type is supplied. +If there is no into variable, +the optional type-spec argument applies to the internal variable +that is keeping the sum. +The default type +is implementation-dependent; but it +must be a supertype of type number. +

    +

    If into is used, +the construct does not provide a default return value; +however, the variable is available +for use in any finally clause. +

    +

    Certain kinds of accumulation clauses can be combined in a loop +if their destination is the same +(the result of loop or an into var) +because they are considered to accumulate conceptually compatible quantities. +In particular, +any elements of following sets of accumulation clauses can be mixed +with other elements of the same set for the same destination +in a loop form: +

    +
    +
    *
    +

    collect, append, nconc +

    +
    +
    *
    +

    sum, count +

    +
    +
    *
    +

    maximize, minimize +

    +
    + +
    +
    ;; Collect every name and the kids in one list by using 
+;; COLLECT and APPEND.
+ (loop for name in '(fred sue alice joe june)
+       for kids in '((bob ken) () () (kris sunshine) ())
+       collect name
+       append kids)
+⇒  (FRED BOB KEN SUE ALICE JOE KRIS SUNSHINE JUNE)
+
    + +

    Any two +clauses that do not accumulate the same type of +object +can coexist in a loop only +if each clause accumulates its values into +a different +variable. +

    + + + + + + +
    • Examples of COLLECT clause   +
    • Examples of APPEND and NCONC clauses   +
    • Examples of COUNT clause   +
    • Examples of MAXIMIZE and MINIMIZE clauses   +
    • Examples of SUM clause   +
    + +
    +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    + + + + + diff --git a/info/gcl/Variable-Initialization-and-Stepping-Clauses.html b/info/gcl/Variable-Initialization-and-Stepping-Clauses.html new file mode 100644 index 0000000..4b220c8 --- /dev/null +++ b/info/gcl/Variable-Initialization-and-Stepping-Clauses.html @@ -0,0 +1,86 @@ + + + + + +Variable Initialization and Stepping Clauses (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: The LOOP Facility  

    +
    +
    +

    6.1.2 Variable Initialization and Stepping Clauses

    + + + + + + + + + + + + + + + + + + +
    • Iteration Control   +
    • The for-as-arithmetic subclause   +
    • Examples of for-as-arithmetic subclause   +
    • The for-as-in-list subclause   +
    • Examples of for-as-in-list subclause   +
    • The for-as-on-list subclause   +
    • Examples of for-as-on-list subclause   +
    • The for-as-equals-then subclause   +
    • Examples of for-as-equals-then subclause   +
    • The for-as-across subclause   +
    • Examples of for-as-across subclause   +
    • The for-as-hash subclause   +
    • The for-as-package subclause   +
    • Examples of for-as-package subclause   +
    • Local Variable Initializations   +
    • Examples of WITH clause   +
    + + + + + + diff --git a/info/gcl/Variable-Names-as-Places.html b/info/gcl/Variable-Names-as-Places.html new file mode 100644 index 0000000..7e8be9b --- /dev/null +++ b/info/gcl/Variable-Names-as-Places.html @@ -0,0 +1,54 @@ + + + + + +Variable Names as Places (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Kinds of Places  

    +
    +
    +

    5.1.2.1 Variable Names as Places

    + +

    The name of a lexical variable or dynamic variable +can be used as a place. +

    + + + + + diff --git a/info/gcl/Variables-that-affect-the-Lisp-Reader.html b/info/gcl/Variables-that-affect-the-Lisp-Reader.html new file mode 100644 index 0000000..add05a9 --- /dev/null +++ b/info/gcl/Variables-that-affect-the-Lisp-Reader.html @@ -0,0 +1,63 @@ + + + + + +Variables that affect the Lisp Reader (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax  

    +
    +
    +

    2.1.2 Variables that affect the Lisp Reader

    + +

    The Lisp reader is influenced not only by the current readtable, +but also by various dynamic variables. Figure 2–2 lists +the variables that influence the behavior of the Lisp reader. +

    +
    +
      *package*    *read-default-float-format*  *readtable*  
+  *read-base*  *read-suppress*                           
+
+  Figure 2–2: Variables that influence the Lisp reader. 
+
+
    + + + + + + diff --git a/info/gcl/Vectors.html b/info/gcl/Vectors.html new file mode 100644 index 0000000..64a6722 --- /dev/null +++ b/info/gcl/Vectors.html @@ -0,0 +1,56 @@ + + + + + +Vectors (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Array Elements  

    +
    +
    +

    15.1.1.5 Vectors

    + +

    An array of rank one (i.e., a one-dimensional array) +is called a vector + +. +

    + + + + + diff --git a/info/gcl/Viewing-Integers-as-Bits-and-Bytes.html b/info/gcl/Viewing-Integers-as-Bits-and-Bytes.html new file mode 100644 index 0000000..6ac425b --- /dev/null +++ b/info/gcl/Viewing-Integers-as-Bits-and-Bytes.html @@ -0,0 +1,51 @@ + + + + + +Viewing Integers as Bits and Bytes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numeric Operations  

    +
    +
    +

    12.1.1.4 Viewing Integers as Bits and Bytes

    + + + + + + diff --git a/info/gcl/Visible-Modification-of-Arrays-with-respect-to-EQUALP.html b/info/gcl/Visible-Modification-of-Arrays-with-respect-to-EQUALP.html new file mode 100644 index 0000000..ecdb544 --- /dev/null +++ b/info/gcl/Visible-Modification-of-Arrays-with-respect-to-EQUALP.html @@ -0,0 +1,57 @@ + + + + + +Visible Modification of Arrays with respect to EQUALP (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.7 Visible Modification of Arrays with respect to EQUALP

    + +

    In an array, any visible change + to an active element, + to the fill pointer (if the array can and does have one), + or to the dimensions (if the array is actually adjustable) +is considered a visible modification with regard to equalp. +

    + + + + + diff --git a/info/gcl/Visible-Modification-of-Bit-Vectors-and-Strings-with-respect-to-EQUAL.html b/info/gcl/Visible-Modification-of-Bit-Vectors-and-Strings-with-respect-to-EQUAL.html new file mode 100644 index 0000000..2e6a426 --- /dev/null +++ b/info/gcl/Visible-Modification-of-Bit-Vectors-and-Strings-with-respect-to-EQUAL.html @@ -0,0 +1,57 @@ + + + + + +Visible Modification of Bit Vectors and Strings with respect to EQUAL (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.4 Visible Modification of Bit Vectors and Strings with respect to EQUAL

    + +

    For a vector of type bit-vector or of type string, any visible change + to an active element of the vector, + or to the length of the vector (if it is actually adjustable + or has a fill pointer) +is considered a visible modification with regard to equal. +

    + + + + + diff --git a/info/gcl/Visible-Modification-of-Conses-with-respect-to-EQUAL.html b/info/gcl/Visible-Modification-of-Conses-with-respect-to-EQUAL.html new file mode 100644 index 0000000..549667d --- /dev/null +++ b/info/gcl/Visible-Modification-of-Conses-with-respect-to-EQUAL.html @@ -0,0 +1,54 @@ + + + + + +Visible Modification of Conses with respect to EQUAL (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.3 Visible Modification of Conses with respect to EQUAL

    + +

    Any visible change to the car or the cdr of a cons +is considered a visible modification with regard to equal. +

    + + + + + diff --git a/info/gcl/Visible-Modification-of-Hash-Tables-with-respect-to-EQUALP.html b/info/gcl/Visible-Modification-of-Hash-Tables-with-respect-to-EQUALP.html new file mode 100644 index 0000000..96d0b9c --- /dev/null +++ b/info/gcl/Visible-Modification-of-Hash-Tables-with-respect-to-EQUALP.html @@ -0,0 +1,60 @@ + + + + + +Visible Modification of Hash Tables with respect to EQUALP (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.8 Visible Modification of Hash Tables with respect to EQUALP

    + +

    In a hash table, any visible change + to the count of entries in the hash table, + to the keys, + or to the values associated with the keys +is considered a visible modification with regard to equalp. +

    +

    Note that the visibility of modifications to the keys depends on the equivalence test +of the hash table, not on the specification of equalp. +

    + + + + + diff --git a/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQ-and-EQL.html b/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQ-and-EQL.html new file mode 100644 index 0000000..0715496 --- /dev/null +++ b/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQ-and-EQL.html @@ -0,0 +1,54 @@ + + + + + +Visible Modification of Objects with respect to EQ and EQL (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.1 Visible Modification of Objects with respect to EQ and EQL

    + +

    No standardized function is provided that is capable of visibly +modifying an object with regard to eq or eql. +

    + + + + + diff --git a/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUAL.html b/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUAL.html new file mode 100644 index 0000000..bf9d41c --- /dev/null +++ b/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUAL.html @@ -0,0 +1,55 @@ + + + + + +Visible Modification of Objects with respect to EQUAL (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.2 Visible Modification of Objects with respect to EQUAL

    + +

    As a consequence of the behavior for equal, +the rules for visible modification of objects not explicitly mentioned in this +section are inherited from those in Visible Modification of Objects with respect to EQ and EQL. +

    + + + + + diff --git a/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUALP.html b/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUALP.html new file mode 100644 index 0000000..a78c998 --- /dev/null +++ b/info/gcl/Visible-Modification-of-Objects-with-respect-to-EQUALP.html @@ -0,0 +1,55 @@ + + + + + +Visible Modification of Objects with respect to EQUALP (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.5 Visible Modification of Objects with respect to EQUALP

    + +

    As a consequence of the behavior for equalp, +the rules for visible modification of objects not explicitly mentioned in this +section are inherited from those in Visible Modification of Objects with respect to EQUAL. +

    + + + + + diff --git a/info/gcl/Visible-Modification-of-Structures-with-respect-to-EQUALP.html b/info/gcl/Visible-Modification-of-Structures-with-respect-to-EQUALP.html new file mode 100644 index 0000000..dfa051c --- /dev/null +++ b/info/gcl/Visible-Modification-of-Structures-with-respect-to-EQUALP.html @@ -0,0 +1,54 @@ + + + + + +Visible Modification of Structures with respect to EQUALP (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.6 Visible Modification of Structures with respect to EQUALP

    + +

    Any visible change to a slot of a structure +is considered a visible modification with regard to equalp. +

    + + + + + diff --git a/info/gcl/Visible-Modifications-by-Language-Extensions.html b/info/gcl/Visible-Modifications-by-Language-Extensions.html new file mode 100644 index 0000000..0dc1e86 --- /dev/null +++ b/info/gcl/Visible-Modifications-by-Language-Extensions.html @@ -0,0 +1,62 @@ + + + + + +Visible Modifications by Language Extensions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Modifying Hash Table Keys  

    +
    +
    +

    18.1.2.9 Visible Modifications by Language Extensions

    + +

    Implementations that extend the language by providing additional mutator +functions (or additional behavior for existing mutator functions) must +document how the use of these extensions interacts with equivalence tests and +hash table searches. +

    +

    Implementations that extend the language by defining additional acceptable +equivalence tests for hash tables (allowing additional values for the :test +argument to make-hash-table) must document the visible components of these +tests. +

    + + + + + + diff --git a/info/gcl/When-Compiler-Macros-Are-Used.html b/info/gcl/When-Compiler-Macros-Are-Used.html new file mode 100644 index 0000000..24705e6 --- /dev/null +++ b/info/gcl/When-Compiler-Macros-Are-Used.html @@ -0,0 +1,88 @@ + + + + + +When Compiler Macros Are Used (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Compilation Semantics  

    +
    +
    +

    3.2.2.4 When Compiler Macros Are Used

    + +

    The presence of a compiler macro definition for a function or macro +indicates that it is desirable for the compiler to use the expansion +of the compiler macro instead of the original function form or +macro form. However, no language processor +(compiler, evaluator, or other code walker) is ever required to actually +invoke compiler macro functions, or to +make use of the resulting expansion if it does invoke +a compiler macro function. +

    +

    When the compiler encounters a form during processing that represents +a call to a compiler macro name (that is not declared notinline), +the compiler might expand the compiler macro, +and might use the expansion in place of the original form. +

    +

    When eval encounters a form during processing that represents +a call to a compiler macro name (that is not declared notinline), +eval might expand the compiler macro, +and might use the expansion in place of the original form. +

    +

    There are two situations in which a compiler macro definition must not be +applied by any language processor: +

    +
    +
    *
    +

    The global function name binding associated with the compiler + macro is shadowed by a lexical binding of the function name. +

    +
    +
    *
    +

    The function name has been declared or proclaimed notinline and + the call form appears within the scope of the declaration. +

    +
    + +

    It is unspecified whether compiler macros are expanded or used in any other +situations. +

    + + + + + diff --git a/info/gcl/Whitespace-Characters.html b/info/gcl/Whitespace-Characters.html new file mode 100644 index 0000000..4e056ff --- /dev/null +++ b/info/gcl/Whitespace-Characters.html @@ -0,0 +1,56 @@ + + + + + +Whitespace Characters (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Character Syntax Types  

    +
    +
    +

    2.1.4.9 Whitespace Characters

    + +

    Whitespace_2 characters are used to separate tokens. +

    +

    Space and newline are whitespace_2 characters +in standard syntax. +

    + + + + + diff --git a/info/gcl/Wildcard-Words-in-a-Logical-Pathname-Namestring.html b/info/gcl/Wildcard-Words-in-a-Logical-Pathname-Namestring.html new file mode 100644 index 0000000..2edbb4b --- /dev/null +++ b/info/gcl/Wildcard-Words-in-a-Logical-Pathname-Namestring.html @@ -0,0 +1,55 @@ + + + + + +Wildcard Words in a Logical Pathname Namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Syntax of Logical Pathname Namestrings  

    +
    +
    +

    19.3.1.7 Wildcard Words in a Logical Pathname Namestring

    + +

    Each asterisk in a wildcard-word matches a sequence of +zero or more characters. The wildcard-word “*” +parses into :wild; other wildcard-words parse into strings. +

    + + + + + diff --git a/info/gcl/_002a-_0028Variable_0029.html b/info/gcl/_002a-_0028Variable_0029.html new file mode 100644 index 0000000..4adbd45 --- /dev/null +++ b/info/gcl/_002a-_0028Variable_0029.html @@ -0,0 +1,112 @@ + + + + + +* (Variable) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.22 *, **, *** [Variable]

    + +

    Value Type::

    + +

    an object. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The variables *, **, and *** are +maintained by the Lisp read-eval-print loop to save the +values of results that are printed each time through the loop. +

    +

    The value of * is the most recent primary value that was printed, +the value of ** is the previous value of *, and +the value of *** is the previous value of **. +

    +

    If several values are produced, * contains the first value only; +* contains nil if zero values are produced. +

    +

    The values of *, **, and *** are updated immediately +prior to printing the return value of a top-level form by the +Lisp read-eval-print loop. If the evaluation of such a form +is aborted prior to its normal return, the values of *, **, and *** +are not updated. +

    +

    Examples::

    +
    +
    (values 'a1 'a2) ⇒  A1, A2
+'b ⇒  B
+(values 'c1 'c2 'c3) ⇒  C1, C2, C3
+(list * ** ***) ⇒  (C1 B A1)
+
+(defun cube-root (x) (expt x 1/3)) ⇒  CUBE-ROOT
+(compile *) ⇒  CUBE-ROOT
+(setq a (cube-root 27.0)) ⇒  3.0
+(* * 9.0) ⇒  27.0
+
    + +

    Affected By::

    + +

    Lisp read-eval-print loop. +

    +

    See Also::

    + +

    - + (variable), ++ (variable), +/ + (variable), +Top level loop +

    +

    Notes::

    + +
    +
     *   ≡ (car /)
+ **  ≡ (car //)
+ *** ≡ (car ///)
+
    + + + + + + diff --git a/info/gcl/_002a.html b/info/gcl/_002a.html new file mode 100644 index 0000000..76b678d --- /dev/null +++ b/info/gcl/_002a.html @@ -0,0 +1,85 @@ + + + + + +* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.24 * [Function]

    + +

    * &rest numbers ⇒ product +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    product—a number. +

    +

    Description::

    + +

    Returns the product of numbers, +performing any necessary type conversions in the process. +If no numbers are supplied, 1 is returned. +

    +

    Examples::

    + +
    +
     (*) ⇒  1
+ (* 3 5) ⇒  15
+ (* 1.0 #c(22 33) 55/98) ⇒  #C(12.346938775510203 18.520408163265305)
+
    + +

    Exceptional Situations::

    + +

    Might signal type-error if some argument is not a number. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    Numeric Operations, +Rational Computations, +Floating-point Computations, +Complex Computations +

    + + + + + diff --git a/info/gcl/_002abreak_002don_002dsignals_002a.html b/info/gcl/_002abreak_002don_002dsignals_002a.html new file mode 100644 index 0000000..1d4247a --- /dev/null +++ b/info/gcl/_002abreak_002don_002dsignals_002a.html @@ -0,0 +1,138 @@ + + + + + +*break-on-signals* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.25 *break-on-signals* [Variable]

    + +

    Value Type::

    + +

    a type specifier. +

    +

    Initial Value::

    + +

    nil. +

    +

    Description::

    + +

    When (typep condition *break-on-signals*) returns true, +calls to signal, and to other operators such as error +that implicitly call signal, enter the debugger prior to +signaling the condition. +

    +

    The continue restart can be used to continue with the normal +signaling process when a break occurs process due to +*break-on-signals*. +

    +

    Examples::

    + +
    +
     *break-on-signals* ⇒  NIL
+ (ignore-errors (error 'simple-error :format-control "Fooey!"))
+⇒  NIL, #<SIMPLE-ERROR 32207172>
+
+ (let ((*break-on-signals* 'error))
+   (ignore-errors (error 'simple-error :format-control "Fooey!")))
+ |>  Break: Fooey!
+ |>  BREAK entered because of *BREAK-ON-SIGNALS*.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Continue to signal.
+ |>   2: Top level.
+ |>  Debug> |>>:CONTINUE 1<<|
+ |>  Continue to signal.
+⇒  NIL, #<SIMPLE-ERROR 32212257>
+
+ (let ((*break-on-signals* 'error))
+   (error 'simple-error :format-control "Fooey!"))
+ |>  Break: Fooey!
+ |>  BREAK entered because of *BREAK-ON-SIGNALS*.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Continue to signal.
+ |>   2: Top level.
+ |>  Debug> |>>:CONTINUE 1<<|
+ |>  Continue to signal.
+ |>  Error: Fooey!
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Top level.
+ |>  Debug> |>>:CONTINUE 1<<|
+ |>  Top level.
+
    + +

    See Also::

    + +

    break +, +signal +, +warn +, +error +, +typep +, +Condition System Concepts +

    +

    Notes::

    + +

    *break-on-signals* is intended primarily for use in debugging code that +does signaling. When setting *break-on-signals*, the user is +encouraged to choose the most restrictive specification that suffices. +Setting *break-on-signals* effectively violates the modular handling of +condition signaling. In practice, the complete effect of setting +*break-on-signals* might be unpredictable in some cases since the user +might not be aware of the variety or number of calls to signal +that are used in code called only incidentally. +

    +

    *break-on-signals* enables an early entry to the debugger but such an +entry does not preclude an additional entry to the debugger in the case of +operations such as error and cerror. +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002acompile_002dfile_002dpathname_002a.html b/info/gcl/_002acompile_002dfile_002dpathname_002a.html new file mode 100644 index 0000000..9f08bf0 --- /dev/null +++ b/info/gcl/_002acompile_002dfile_002dpathname_002a.html @@ -0,0 +1,89 @@ + + + + + +*compile-file-pathname* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.6 *compile-file-pathname*, *compile-file-truename* [Variable]

    + +

    Value Type::

    + +

    The value of *compile-file-pathname* must always be a pathname or nil. +The value of *compile-file-truename* must always be a physical pathname or nil. +

    +

    Initial Value::

    + +

    nil. +

    +

    Description::

    + +

    During a call to compile-file, + *compile-file-pathname* is bound to + the pathname denoted by the first argument to compile-file, + merged against the defaults; + that is, it is bound to (pathname (merge-pathnames input-file)). +During the same time interval, + *compile-file-truename* is bound to + the truename of the file being compiled. +

    +

    At other times, the value of these variables is nil. +

    +

    If a break loop is entered while compile-file is ongoing, +it is implementation-dependent whether these variables retain +the values they had just prior to entering the break loop +or whether they are bound to nil. +

    +

    The consequences are unspecified if +an attempt is made to assign or bind either of these variables. +

    +

    Affected By::

    + +

    The file system. +

    +

    See Also::

    + +

    compile-file +

    + + + + + diff --git a/info/gcl/_002acompile_002dprint_002a.html b/info/gcl/_002acompile_002dprint_002a.html new file mode 100644 index 0000000..c53b9c4 --- /dev/null +++ b/info/gcl/_002acompile_002dprint_002a.html @@ -0,0 +1,70 @@ + + + + + +*compile-print* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.8 *compile-print*, *compile-verbose* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The value of *compile-print* is the default value of the :print argument +to compile-file. +The value of *compile-verbose* is the default value of the :verbose argument +to compile-file. +

    +

    See Also::

    + +

    compile-file +

    + + + + + diff --git a/info/gcl/_002adebug_002dio_002a.html b/info/gcl/_002adebug_002dio_002a.html new file mode 100644 index 0000000..ddb2654 --- /dev/null +++ b/info/gcl/_002adebug_002dio_002a.html @@ -0,0 +1,196 @@ + + + + + +*debug-io* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.53 *debug-io*, *error-output*, *query-io*,

    +

    *standard-input*, *standard-output*,

    +

    *trace-output*

    +

    [Variable] +

    +

    Value Type::

    + +

    For *standard-input*: + an input stream +

    +

    For *error-output*, *standard-output*, and *trace-output*: + an output stream. +

    +

    For *debug-io*, *query-io*: + a bidirectional stream. +

    +

    Initial Value::

    + +

    implementation-dependent, but +it must be an open stream +that is not a generalized synonym stream +to an I/O customization variables +but that might be a generalized synonym stream to +the value of some I/O customization variable. +The initial value might also be a generalized synonym stream +to either the symbol *terminal-io* or to the stream +that is its value. +

    +

    Description::

    + +

    These variables are collectively called the +standardized I/O customization variables. +They can be bound or assigned in order to +change the default destinations for input and/or output +used by various standardized operators and facilities. +

    +

    The value of *debug-io*, called debug I/O, +is a stream to be used for interactive debugging purposes. +

    +

    The value of *error-output*, called error output, +is a stream to which warnings and non-interactive error messages should be sent. +

    +

    The value of *query-io*, called query I/O, +is a bidirectional stream +to be used when asking questions of the user. The question should be output +to this stream, and the answer read from it. +

    +

    The value of *standard-input*, called standard input, +is a stream that is used by many operators +as a default source of input when no specific input stream +is explicitly supplied. +

    +

    The value of *standard-output*, called standard output, +is a stream that is used by many operators +as a default destination for output when no specific output stream +is explicitly supplied. +

    +

    The value of *trace-output*, called trace output, +is the stream on which traced functions (see trace) +and the time macro print their output. +

    +

    Examples::

    + +
    +
     (with-output-to-string (*error-output*)
+   (warn "this string is sent to *error-output*"))
+ ⇒  "Warning: this string is sent to *error-output*
+" ;The exact format of this string is implementation-dependent.
+
+ (with-input-from-string (*standard-input* "1001")
+    (+ 990 (read))) ⇒  1991                       
+
+ (progn (setq out (with-output-to-string (*standard-output*)
+                     (print "print and format t send things to")
+                     (format t "*standard-output* now going to a string")))
+        :done)
+⇒  :DONE
+ out
+⇒  "
+\"print and format t send things to\" *standard-output* now going to a string"
+
+ (defun fact (n) (if (< n 2) 1 (* n (fact (- n 1)))))
+⇒  FACT
+ (trace fact)
+⇒  (FACT)
+;; Of course, the format of traced output is implementation-dependent.
+ (with-output-to-string (*trace-output*)
+   (fact 3)) 
+⇒  "
+1 Enter FACT 3
+| 2 Enter FACT 2
+|   3 Enter FACT 1
+|   3 Exit FACT 1
+| 2 Exit FACT 2
+1 Exit FACT 6"
+
    + +

    See Also::

    + +

    *terminal-io*, +synonym-stream, +Time +, +trace +, +Conditions, +Reader, +Printer +

    +

    Notes::

    + +

    The intent of the constraints on the initial value +of the I/O customization variables is to ensure that it +is always safe to bind or assign such a variable to +the value of another I/O customization variable, without +unduly restricting implementation flexibility. +

    +

    It is common for an implementation to make +the initial values of *debug-io* and *query-io* +be the same stream, +and to make +the initial values of *error-output* and *standard-output* +be the same stream. +

    +

    The functions y-or-n-p and yes-or-no-p use query I/O +for their input and output. +

    +

    In the normal Lisp read-eval-print loop, +input is read from standard input. +Many input functions, including read and read-char, +take a stream argument that defaults to standard input. +

    +

    In the normal Lisp read-eval-print loop, output is sent to standard output. +Many output functions, including print and write-char, +take a stream argument that defaults to standard output. +

    +

    A program that wants, for example, to divert output to a file should do so by +binding *standard-output*; that way error messages sent to +*error-output* can still get to the user by going through +*terminal-io* (if *error-output* is bound to *terminal-io*), +which is usually what is desired. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002adebugger_002dhook_002a.html b/info/gcl/_002adebugger_002dhook_002a.html new file mode 100644 index 0000000..7a35dde --- /dev/null +++ b/info/gcl/_002adebugger_002dhook_002a.html @@ -0,0 +1,127 @@ + + + + + +*debugger-hook* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.24 *debugger-hook* [Variable]

    + +

    Value Type::

    + +

    a designator for a function of two arguments + (a condition and the value of *debugger-hook* at the time + the debugger was entered), +or nil. +

    +

    Initial Value::

    + +

    nil. +

    +

    Description::

    + +

    When the value of *debugger-hook* is non-nil, it is called prior to +normal entry into the debugger, either due to a call to invoke-debugger +or due to automatic entry into the debugger from a call to error +or cerror with a condition that is not handled. +The function may either handle the condition +(transfer control) or return normally (allowing the standard debugger to run). +To minimize recursive errors while debugging, +*debugger-hook* is bound to nil by invoke-debugger +prior to calling the function. +

    +

    Examples::

    + +
    +
     (defun one-of (choices &optional (prompt "Choice"))
+   (let ((n (length choices)) (i))
+     (do ((c choices (cdr c)) (i 1 (+ i 1)))
+         ((null c))
+       (format t "~&[~D] ~A~
+     (do () ((typep i `(integer 1 ,n)))
+       (format t "~&~A: " prompt)
+       (setq i (read))
+       (fresh-line))
+     (nth (- i 1) choices)))
+
+ (defun my-debugger (condition me-or-my-encapsulation)
+   (format t "~&Fooey: ~A" condition)
+   (let ((restart (one-of (compute-restarts))))
+     (if (not restart) (error "My debugger got an error."))
+     (let ((*debugger-hook* me-or-my-encapsulation))
+       (invoke-restart-interactively restart))))
+
+ (let ((*debugger-hook* #'my-debugger))
+   (+ 3 'a))
+ |>  Fooey: The argument to +, A, is not a number.
+ |>   [1] Supply a replacement for A.
+ |>   [2] Return to Cloe Toplevel.
+ |>  Choice: 1
+ |>   Form to evaluate and use: (+ 5 'b)
+ |>   Fooey: The argument to +, B, is not a number.
+ |>   [1] Supply a replacement for B.
+ |>   [2] Supply a replacement for A.
+ |>   [3] Return to Cloe Toplevel.
+ |>  Choice: 1
+ |>   Form to evaluate and use: 1
+⇒  9
+
    + +

    Affected By::

    + +

    invoke-debugger +

    +

    Notes::

    + +

    When evaluating code typed in by the user interactively, it is sometimes +useful to have the hook function bind *debugger-hook* to the +function that was its second argument so that recursive errors +can be handled using the same interactive facility. +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002adefault_002dpathname_002ddefaults_002a.html b/info/gcl/_002adefault_002dpathname_002ddefaults_002a.html new file mode 100644 index 0000000..0cce76b --- /dev/null +++ b/info/gcl/_002adefault_002dpathname_002ddefaults_002a.html @@ -0,0 +1,83 @@ + + + + + +*default-pathname-defaults* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.10 *default-pathname-defaults* [Variable]

    + +

    Value Type::

    + +

    a pathname object. +

    +

    Initial Value::

    + +

    An implementation-dependent pathname, +typically in the working directory that was current when Common Lisp was started up. +

    +

    Description::

    + +

    a pathname, used as the default whenever a function +needs a default pathname and one is not supplied. +

    +

    Examples::

    +
    +
     ;; This example illustrates a possible usage for a hypothetical Lisp running on a
+ ;; DEC TOPS-20 file system.  Since pathname conventions vary between Lisp 
+ ;; implementations and host file system types, it is not possible to provide a
+ ;; general-purpose, conforming example.
+ *default-pathname-defaults* ⇒  #P"PS:<FRED>"
+ (merge-pathnames (make-pathname :name "CALENDAR"))
+⇒  #P"PS:<FRED>CALENDAR"
+ (let ((*default-pathname-defaults* (pathname "<MARY>")))
+   (merge-pathnames (make-pathname :name "CALENDAR")))
+⇒  #P"<MARY>CALENDAR"
+
    + +

    Affected By::

    + +

    The implementation. +

    + + + + + diff --git a/info/gcl/_002afeatures_002a.html b/info/gcl/_002afeatures_002a.html new file mode 100644 index 0000000..ac7a8bb --- /dev/null +++ b/info/gcl/_002afeatures_002a.html @@ -0,0 +1,187 @@ + + + + + +*features* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.5 *features* [Variable]

    + +

    Value Type::

    + +

    a proper list. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The value of *features* is called the features list. +It is a list of symbols, called features, +that correspond to some aspect of the implementation or environment. +

    +

    Most features have implementation-dependent meanings; +The following meanings have been assigned to feature names: +

    +
    +
    :cltl1
    +

    If present, indicates that the LISP package purports to conform +to the 1984 specification Common Lisp: The Language. +It is possible, but not required, for a conforming implementation +to have this feature because this specification specifies that +its symbols are to be in the COMMON-LISP package, +not the LISP package. +

    +
    +
    :cltl2
    +

    If present, indicates that the implementation purports to conform +to Common Lisp: The Language, Second Edition. +This feature must not be present in any conforming implementation, +since conformance to that document is not compatible with conformance +to this specification. +The name, however, is reserved by this specification in order to help +programs distinguish implementations which conform to that document +from implementations which conform to this specification. +

    +
    +
    :ieee-floating-point
    +

    If present, indicates that the implementation purports to conform +to the requirements of IEEE Standard for Binary Floating-Point Arithmetic. +

    +
    +
    :x3j13
    +

    If present, indicates that the implementation conforms to some +particular working draft of this specification, +or to some subset of features that approximates a belief about +what this specification might turn out to contain. +A conforming implementation might or might not contain +such a feature. +(This feature is intended primarily as a stopgap in order to +provide implementors something to use prior to the availability +of a draft standard, in order to discourage them from introducing +the :draft-ansi-cl and :ansi-cl features prematurely.) +

    +
    +
    :draft-ansi-cl
    +

    If present, indicates that the implementation +purports to conform to the first full draft of this specification, +which went to public review in 1992. +A conforming implementation +which has the :draft-ansi-cl-2 or :ansi-cl feature +is not permitted to retain the :draft-ansi-cl feature +since incompatible changes were made subsequent to the first draft. +

    +
    +
    :draft-ansi-cl-2
    +

    If present, indicates that a second full draft of this specification +has gone to public review, and that the implementation +purports to conform to that specification. +(If additional public review drafts are produced, this keyword + will continue to refer to the second draft, and additional keywords + will be added to identify conformance with such later drafts. + As such, the meaning of this keyword can be relied upon not to + change over time.) +A conforming implementation which has the :ansi-cl +feature is only permitted to retain the :draft-ansi-cl +feature if the finally approved standard is not incompatible +with the draft standard. +

    +
    +
    :ansi-cl
    +

    If present, indicates that this specification has been adopted by ANSI +as an official standard, and that the implementation +purports to conform. +

    +
    +
    :common-lisp
    +

    This feature must appear in *features* for any implementation that +has one or more of the features :x3j13, :draft-ansi-cl, +or :ansi-cl. It is intended that it should also appear in +implementations which have the features :cltl1 or :cltl2, +but this specification cannot force such behavior. The intent is +that this feature should identify the language family named “Common Lisp,” +rather than some specific dialect within that family. +

    +
    +
    + +

    See Also::

    + +

    Use of Read-Time Conditionals, +Standard Macro Characters +

    +

    Notes::

    + +

    The value of *features* is used by the #+ and #- reader syntax. +

    +

    Symbols in the features list may be in any package, +but in practice they are generally in the KEYWORD package. +This is because KEYWORD is the package used by default +when reading_2 feature expressions +in the #+ and #- reader macros. +Code that needs to name a feature_2 in a +package P (other than KEYWORD) can do so +by making explicit use of a package prefix for P, +but note that such code must also assure that the package P +exists in order for the feature expression to be read_2—even +in cases where the feature expression is expected to fail. +

    +

    It is generally considered wise for an implementation to include +one or more features identifying the specific implementation, +so that conditional expressions can be written which distinguish +idiosyncrasies of one implementation from those of another. +Since features are normally symbols in the KEYWORD package +where name collisions might easily result, and since no uniquely defined mechanism +is designated for deciding who has the right to use which symbol for +what reason, a conservative strategy is to prefer names derived from +one’s own company or product name, since those names are often trademarked +and are hence less likely to be used unwittingly by another implementation. +

    +
    +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002agensym_002dcounter_002a.html b/info/gcl/_002agensym_002dcounter_002a.html new file mode 100644 index 0000000..86d0b63 --- /dev/null +++ b/info/gcl/_002agensym_002dcounter_002a.html @@ -0,0 +1,80 @@ + + + + + +*gensym-counter* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.8 *gensym-counter* [Variable]

    + +

    Value Type::

    + +

    a non-negative integer. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    A number which will be used in constructing the name of +the next symbol generated by the function gensym. +

    +

    *gensym-counter* can be either assigned or bound +at any time, but its value must always be a non-negative integer. +

    +

    Affected By::

    + +

    gensym. +

    +

    See Also::

    + +

    gensym +

    +

    Notes::

    + +

    The ability to pass a numeric argument to gensym has been deprecated; +explicitly binding *gensym-counter* is now stylistically preferred. +

    + + + + + diff --git a/info/gcl/_002aload_002dpathname_002a.html b/info/gcl/_002aload_002dpathname_002a.html new file mode 100644 index 0000000..b7900c7 --- /dev/null +++ b/info/gcl/_002aload_002dpathname_002a.html @@ -0,0 +1,89 @@ + + + + + +*load-pathname* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.7 *load-pathname*, *load-truename* [Variable]

    + +

    Value Type::

    + +

    The value of *load-pathname* must always be a pathname or nil. +The value of *load-truename* must always be a physical pathname or nil. +

    +

    Initial Value::

    + +

    nil. +

    +

    Description::

    + +

    During a call to load, + *load-pathname* is bound to + the pathname denoted by the the first argument to load, + merged against the defaults; + that is, it is bound to (pathname (merge-pathnames filespec)). +During the same time interval, + *load-truename* is bound to + the truename of the file being loaded. +

    +

    At other times, the value of these variables is nil. +

    +

    If a break loop is entered while load is ongoing, +it is implementation-dependent whether these variables retain +the values they had just prior to entering the break loop +or whether they are bound to nil. +

    +

    The consequences are unspecified if +an attempt is made to assign or bind either of these variables. +

    +

    Affected By::

    + +

    The file system. +

    +

    See Also::

    + +

    load +

    + + + + + diff --git a/info/gcl/_002aload_002dprint_002a.html b/info/gcl/_002aload_002dprint_002a.html new file mode 100644 index 0000000..fe4ccea --- /dev/null +++ b/info/gcl/_002aload_002dprint_002a.html @@ -0,0 +1,69 @@ + + + + + +*load-print* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.9 *load-print*, *load-verbose* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    The initial value of *load-print* is false. +The initial value of *load-verbose* is implementation-dependent. +

    +

    Description::

    + +

    The value of *load-print* is the default value of the :print argument to load. +The value of *load-verbose* is the default value of the :verbose argument to load. +

    +

    See Also::

    + +

    load +

    + + + + + diff --git a/info/gcl/_002amacroexpand_002dhook_002a.html b/info/gcl/_002amacroexpand_002dhook_002a.html new file mode 100644 index 0000000..c7e5e95 --- /dev/null +++ b/info/gcl/_002amacroexpand_002dhook_002a.html @@ -0,0 +1,121 @@ + + + + + +*macroexpand-hook* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.15 *macroexpand-hook* [Variable]

    + +

    Value Type::

    + +

    a designator for a function of three arguments: + a macro function, + a macro form, + and an environment object. +

    +

    Initial Value::

    + +

    a designator for a function that is equivalent to the function funcall, +but that might have additional implementation-dependent side-effects. +

    +

    Description::

    + +

    Used as the expansion interface hook by macroexpand-1 to +control the macro expansion process. +When a macro form is to be expanded, +this function is called with three arguments: + the macro function, + the macro form, + and the environment in which the macro form is to be expanded. +

    +

    The environment object has dynamic extent; +the consequences are undefined if the environment object is +referred to outside the dynamic extent of the macro expansion function. +

    +

    Examples::

    + +
    +
     (defun hook (expander form env)
+    (format t "Now expanding: ~S~
+    (funcall expander form env)) ⇒  HOOK 
+ (defmacro machook (x y) `(/ (+ ,x ,y) 2)) ⇒  MACHOOK 
+ (macroexpand '(machook 1 2)) ⇒  (/ (+ 1 2) 2), true 
+ (let ((*macroexpand-hook* #'hook)) (macroexpand '(machook 1 2)))
+ |>  Now expanding (MACHOOK 1 2) 
+⇒  (/ (+ 1 2) 2), true
+
    + +

    See Also::

    + +

    macroexpand +, macroexpand-1, +funcall +, Evaluation +

    +

    Notes::

    + +

    The net effect of the chosen initial value is to just invoke the +macro function, giving it the macro form and +environment as its two arguments. +

    +

    Users or user programs can assign this variable to +customize or trace the macro expansion mechanism. Note, however, +that this variable is a global resource, potentially shared by +multiple programs; as such, if any two programs depend for +their correctness on the setting of this variable, those +programs may not be able to run in the same Lisp image. +For this reason, it is frequently best to confine its uses to debugging +situations. +

    +

    Users who put their own function into *macroexpand-hook* +should consider saving the previous value of the hook, and calling that +value from their own. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002amodules_002a.html b/info/gcl/_002amodules_002a.html new file mode 100644 index 0000000..8a73de6 --- /dev/null +++ b/info/gcl/_002amodules_002a.html @@ -0,0 +1,78 @@ + + + + + +*modules* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.10 *modules* [Variable]

    + +

    Value Type::

    + +

    a list of strings. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The value of *modules* is a list of names of the modules +that have been loaded into the current Lisp image. +

    +

    Affected By::

    + +

    provide +

    +

    See Also::

    + +

    provide +, +require +

    +

    Notes::

    + +

    The variable *modules* is deprecated. +

    + + + + + diff --git a/info/gcl/_002apackage_002a.html b/info/gcl/_002apackage_002a.html new file mode 100644 index 0000000..c544cc4 --- /dev/null +++ b/info/gcl/_002apackage_002a.html @@ -0,0 +1,102 @@ + + + + + +*package* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.28 *package* [Variable]

    + +

    Value Type::

    + +

    a package object. +

    +

    Initial Value::

    + +

    the COMMON-LISP-USER package. +

    +

    Description::

    + +

    Whatever package object is currently +the value of *package* is referred to as the current package. +

    +

    Examples::

    + +
    +
     (in-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ *package* ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (make-package "SAMPLE-PACKAGE" :use '("COMMON-LISP"))
+⇒  #<PACKAGE "SAMPLE-PACKAGE">
+ (list 
+   (symbol-package
+     (let ((*package* (find-package 'sample-package)))
+       (setq *some-symbol* (read-from-string "just-testing"))))
+   *package*)
+⇒  (#<PACKAGE "SAMPLE-PACKAGE"> #<PACKAGE "COMMON-LISP-USER">)
+ (list (symbol-package (read-from-string "just-testing"))
+       *package*)
+⇒  (#<PACKAGE "COMMON-LISP-USER"> #<PACKAGE "COMMON-LISP-USER">)
+ (eq 'foo (intern "FOO")) ⇒  true
+ (eq 'foo (let ((*package* (find-package 'sample-package)))
+            (intern "FOO")))
+⇒  false
+
    + +

    Affected By::

    + +

    load, +compile-file, +in-package +

    +

    See Also::

    + +

    compile-file +, +in-package +, +load +, +package +

    + + + + + diff --git a/info/gcl/_002aprint_002darray_002a.html b/info/gcl/_002aprint_002darray_002a.html new file mode 100644 index 0000000..8c14e0a --- /dev/null +++ b/info/gcl/_002aprint_002darray_002a.html @@ -0,0 +1,78 @@ + + + + + +*print-array* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.16 *print-array* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    Controls the format in which arrays are printed. +If it is false, the contents of arrays other than strings +are never printed. Instead, arrays are printed in a concise form using +#< that gives enough information for the user to be able to identify the +array, but does not include the entire array contents. +If it is true, non-string arrays are printed using +#(...), #*, or #nA syntax. +

    +

    Affected By::

    + +

    The implementation. +

    +

    See Also::

    + +

    Sharpsign Left-Parenthesis, +Sharpsign Less-Than-Sign +

    + + + + + diff --git a/info/gcl/_002aprint_002dbase_002a.html b/info/gcl/_002aprint_002dbase_002a.html new file mode 100644 index 0000000..e1fbd19 --- /dev/null +++ b/info/gcl/_002aprint_002dbase_002a.html @@ -0,0 +1,130 @@ + + + + + +*print-base* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.17 *print-base*, *print-radix* [Variable]

    + +

    Value Type::

    + +

    *print-base*—a radix. +*print-radix*—a generalized boolean. +

    +

    Initial Value::

    + +

    The initial value of *print-base* is 10. +The initial value of *print-radix* is false. +

    +

    Description::

    + +

    *print-base* and *print-radix* control the printing +of rationals. +The value of *print-base* is called the current output base + +. +

    +

    The value of *print-base* is the radix in which the printer +will print rationals. For radices above 10, letters of +the alphabet are used to represent digits above 9. +

    +

    If the value of *print-radix* is true, +the printer will print a radix specifier to indicate the radix +in which it is printing a rational number. The radix specifier +is always printed using lowercase letters. If *print-base* +is 2, 8, or 16, then the radix specifier used is #b, +#o, or #x, respectively. For integers, base ten is +indicated by a trailing decimal point instead of a leading radix +specifier; for ratios, #10r is used. +

    +

    Examples::

    + +
    +
     (let ((*print-base* 24.) (*print-radix* t)) 
+   (print 23.))
+ |>  #24rN
+⇒  23
+ (setq *print-base* 10) ⇒  10
+ (setq *print-radix* nil) ⇒  NIL                                          
+ (dotimes (i 35)
+    (let ((*print-base* (+ i 2)))           ;print the decimal number 40 
+      (write 40)                            ;in each base from 2 to 36
+      (if (zerop (mod i 10)) (terpri) (format t " "))))
+ |>  101000
+ |>  1111 220 130 104 55 50 44 40 37 34
+ |>  31 2C 2A 28 26 24 22 20 1J 1I
+ |>  1H 1G 1F 1E 1D 1C 1B 1A 19 18
+ |>  17 16 15 14 
+⇒  NIL
+ (dolist (pb '(2 3 8 10 16))               
+    (let ((*print-radix* t)                 ;print the integer 10 and 
+          (*print-base* pb))                ;the ratio 1/10 in bases 2, 
+     (format t "~&~S  ~S~
+ |>  #b1010  #b1/1010
+ |>  #3r101  #3r1/101
+ |>  #o12  #o1/12
+ |>  10.  #10r1/10
+ |>  #xA  #x1/A
+⇒  NIL
+
    + +

    Affected By::

    + +

    Might be bound by format, and write, write-to-string. +

    +

    See Also::

    + +

    format +, +write +, +write-to-string +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002aprint_002dcase_002a.html b/info/gcl/_002aprint_002dcase_002a.html new file mode 100644 index 0000000..736b2a5 --- /dev/null +++ b/info/gcl/_002aprint_002dcase_002a.html @@ -0,0 +1,120 @@ + + + + + +*print-case* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.18 *print-case* [Variable]

    + +

    Value Type::

    + +

    One of the symbols :upcase, :downcase, or :capitalize. +

    +

    Initial Value::

    + +

    The symbol :upcase. +

    +

    Description::

    + +

    The value of *print-case* controls the case (upper, lower, or mixed) in +which to print any uppercase characters in the names of symbols +when vertical-bar syntax is not used. +

    +

    *print-case* has an effect at all times when the value of *print-escape* +is false. *print-case* also has an effect when +the value of *print-escape* is true unless inside an escape context +(i.e., unless between vertical-bars or after a slash). +

    +

    Examples::

    + +
    +
     (defun test-print-case ()
+   (dolist (*print-case* '(:upcase :downcase :capitalize))
+     (format t "~&~S ~S~
+⇒  TEST-PC
+;; Although the choice of which characters to escape is specified by
+;; *PRINT-CASE*, the choice of how to escape those characters 
+;; (i.e., whether single escapes or multiple escapes are used)
+;; is implementation-dependent.  The examples here show two of the
+;; many valid ways in which escaping might appear.
+ (test-print-case) ;Implementation A
+ |>  THIS-AND-THAT |And-something-elSE|
+ |>  this-and-that a\n\d-\s\o\m\e\t\h\i\n\g-\e\lse
+ |>  This-And-That A\n\d-\s\o\m\e\t\h\i\n\g-\e\lse
+⇒  NIL
+ (test-print-case) ;Implementation B
+ |>  THIS-AND-THAT |And-something-elSE|
+ |>  this-and-that a|nd-something-el|se
+ |>  This-And-That A|nd-something-el|se
+⇒  NIL
+
    + +

    See Also::

    + +

    write +

    +

    Notes::

    + +

    read normally converts lowercase characters appearing +in symbols to corresponding uppercase characters, +so that internally print names normally contain only uppercase characters. +

    +

    If *print-escape* is true, +lowercase characters in the name of a symbol +are always printed in lowercase, and +are preceded by a single escape character +or enclosed by multiple escape characters; +uppercase characters in the name of a symbol +are printed in upper case, in lower case, or in mixed case +so as to capitalize words, according to the value of +*print-case*. The convention for what constitutes +a “word” is the same as for string-capitalize. +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002aprint_002dcircle_002a.html b/info/gcl/_002aprint_002dcircle_002a.html new file mode 100644 index 0000000..f6e8ba7 --- /dev/null +++ b/info/gcl/_002aprint_002dcircle_002a.html @@ -0,0 +1,115 @@ + + + + + +*print-circle* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.19 *print-circle* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    false. +

    +

    Description::

    + +

    Controls the attempt to detect circularity and sharing in an object +being printed. +

    +

    If false, +the printing process merely proceeds by recursive descent without attempting +to detect circularity and sharing. +

    +

    If true, +the printer will endeavor to detect cycles and sharing +in the structure to be printed, +and to use #n= and #n# +syntax to indicate the circularities or shared components. +

    +

    If true, a user-defined +

    +

    print-object method +

    +

    can print +objects to the supplied stream using write, prin1, +princ, or format and expect circularities and sharing +to be detected and printed using the #n# syntax. +

    +

    If a user-defined +

    +

    print-object method +

    +

    prints to a stream other than the one +that was supplied, then circularity detection starts over for that stream. +

    +

    Note that implementations should not use #n# notation +when the Lisp reader would automatically assure sharing without it +(e.g., as happens with interned symbols). +

    +

    Examples::

    + +
    +
     (let ((a (list 1 2 3)))
+   (setf (cdddr a) a)
+   (let ((*print-circle* t))
+     (write a)
+     :done))
+ |>  #1=(1 2 3 . #1#)
+⇒  :DONE
+
    + +

    See Also::

    + +

    write +

    +

    Notes::

    + +

    An attempt to print a circular structure with *print-circle* +set to nil may lead to looping behavior and failure to terminate. +

    + + + + + diff --git a/info/gcl/_002aprint_002descape_002a.html b/info/gcl/_002aprint_002descape_002a.html new file mode 100644 index 0000000..9fc33af --- /dev/null +++ b/info/gcl/_002aprint_002descape_002a.html @@ -0,0 +1,98 @@ + + + + + +*print-escape* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.20 *print-escape* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    true. +

    +

    Description::

    + +

    If false, +escape characters and package prefixes are not output +when an expression is printed. +

    +

    If true, an attempt is made to print an expression +in such a way that it can be read again to produce an equal expression. +(This is only a guideline; not a requirement. See *print-readably*.) +

    +

    For more specific details of how the value of *print-escape* +affects the printing of certain types, +see Default Print-Object Methods. +

    +

    Examples::

    +
    +
     (let ((*print-escape* t)) (write #\a))
+ |>  #\a
+⇒  #\a
+ (let ((*print-escape* nil)) (write #\a))
+ |>  a
+⇒  #\a
+
    + +

    Affected By::

    + +

    princ, prin1, format +

    +

    See Also::

    + +

    write +, +readtable-case +

    +

    Notes::

    + +

    princ effectively binds *print-escape* to false. +prin1 effectively binds *print-escape* to true. +

    + + + + + diff --git a/info/gcl/_002aprint_002dgensym_002a.html b/info/gcl/_002aprint_002dgensym_002a.html new file mode 100644 index 0000000..a527c56 --- /dev/null +++ b/info/gcl/_002aprint_002dgensym_002a.html @@ -0,0 +1,80 @@ + + + + + +*print-gensym* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.21 *print-gensym* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    true. +

    +

    Description::

    + +

    Controls whether the prefix “#:” is printed before +apparently uninterned symbols. +The prefix is printed before such symbols +if and only if the value of *print-gensym* is true. +

    +

    Examples::

    + +
    +
     (let ((*print-gensym* nil))
+   (print (gensym)))
+ |>  G6040 
+⇒  #:G6040
+
    + +

    See Also::

    + +

    write +, *print-escape* +

    + + + + + diff --git a/info/gcl/_002aprint_002dlevel_002a.html b/info/gcl/_002aprint_002dlevel_002a.html new file mode 100644 index 0000000..69c59ae --- /dev/null +++ b/info/gcl/_002aprint_002dlevel_002a.html @@ -0,0 +1,143 @@ + + + + + +*print-level* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.22 *print-level*, *print-length* [Variable]

    + +

    Value Type::

    + +

    a non-negative integer, or nil. +

    +

    Initial Value::

    + +

    nil. +

    +

    Description::

    + +

    *print-level* controls how many levels deep a nested object will print. +If it is false, then no control is exercised. +Otherwise, it is an integer indicating the maximum level to be printed. +An object to be printed is at level 0; +its components (as of a list or vector) are at level 1; +and so on. +If an object to be recursively printed has components +and is at a level equal to or greater than the value of *print-level*, +then the object is printed as “#”. +

    +

    *print-length* controls how many elements at a given level are printed. +If it is false, there is no limit to the number of components printed. +Otherwise, it is an integer indicating the maximum number of elements +of an object to be printed. If exceeded, the printer will print +“...” in place of the other elements. In the case of a dotted list, +if the list contains exactly as many elements as the value of *print-length*, +the terminating atom is printed rather than printing “...” +

    +

    *print-level* and *print-length* affect the printing +of an any object printed with a list-like syntax. They do not affect +the printing of symbols, strings, and bit vectors. +

    +

    Examples::

    + +
    +
     (setq a '(1 (2 (3 (4 (5 (6))))))) ⇒  (1 (2 (3 (4 (5 (6))))))
+ (dotimes (i 8) 
+   (let ((*print-level* i)) 
+     (format t "~&~D -- ~S~
+ |>  0 -- #
+ |>  1 -- (1 #)
+ |>  2 -- (1 (2 #))
+ |>  3 -- (1 (2 (3 #)))
+ |>  4 -- (1 (2 (3 (4 #))))
+ |>  5 -- (1 (2 (3 (4 (5 #)))))
+ |>  6 -- (1 (2 (3 (4 (5 (6))))))
+ |>  7 -- (1 (2 (3 (4 (5 (6))))))
+⇒  NIL
+
+ (setq a '(1 2 3 4 5 6)) ⇒  (1 2 3 4 5 6)
+ (dotimes (i 7) 
+   (let ((*print-length* i)) 
+     (format t "~&~D -- ~S~
+ |>  0 -- (...)
+ |>  1 -- (1 ...)
+ |>  2 -- (1 2 ...)
+ |>  3 -- (1 2 3 ...)
+ |>  4 -- (1 2 3 4 ...)
+ |>  5 -- (1 2 3 4 5 6)
+ |>  6 -- (1 2 3 4 5 6)
+⇒  NIL
+
+(dolist (level-length '((0 1) (1 1) (1 2) (1 3) (1 4) 
+                        (2 1) (2 2) (2 3) (3 2) (3 3) (3 4)))
+ (let ((*print-level*  (first  level-length))
+       (*print-length* (second level-length)))
+   (format t "~&~D ~D -- ~S~
+           *print-level* *print-length* 
+           '(if (member x y) (+ (car x) 3) '(foo . #(a b c d "Baz"))))))
+ |>  0 1 -- #
+ |>  1 1 -- (IF ...)
+ |>  1 2 -- (IF # ...)
+ |>  1 3 -- (IF # # ...)
+ |>  1 4 -- (IF # # #)
+ |>  2 1 -- (IF ...)
+ |>  2 2 -- (IF (MEMBER X ...) ...)
+ |>  2 3 -- (IF (MEMBER X Y) (+ # 3) ...)
+ |>  3 2 -- (IF (MEMBER X ...) ...)
+ |>  3 3 -- (IF (MEMBER X Y) (+ (CAR X) 3) ...)
+ |>  3 4 -- (IF (MEMBER X Y) (+ (CAR X) 3) '(FOO . #(A B C D ...)))
+⇒  NIL
+
    + +

    See Also::

    + +

    write +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002aprint_002dlines_002a.html b/info/gcl/_002aprint_002dlines_002a.html new file mode 100644 index 0000000..888dd0c --- /dev/null +++ b/info/gcl/_002aprint_002dlines_002a.html @@ -0,0 +1,90 @@ + + + + + +*print-lines* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.23 *print-lines* [Variable]

    + +

    Value Type::

    + +

    a non-negative integer, or nil. +

    +

    Initial Value::

    + +

    nil. +

    +

    Description::

    + +

    When the value of *print-lines* is other than nil, +it is a limit on the number of output lines produced when something is pretty +printed. If an attempt is made to go beyond that many lines, +“..” is printed at the end of the last line followed by all of the +suffixes (closing delimiters) that are pending to be printed. +

    +

    Examples::

    + +
    +
     (let ((*print-right-margin* 25) (*print-lines* 3))
+   (pprint '(progn (setq a 1 b 2 c 3 d 4))))
+ |>  (PROGN (SETQ A 1
+ |>               B 2
+ |>               C 3 ..))
+⇒  <no values>
+
    + +

    Notes::

    + +

    The “..” notation is intentionally different than +the “...” notation used for level abbreviation, so that the two +different situations can be visually distinguished. +

    +

    This notation is used to increase the likelihood that the Lisp reader +will signal an error if an attempt is later made to read the abbreviated output. +Note however that if the truncation occurs in a string, +as in "This string has been trunc..", the problem situation cannot be +detected later and no such error will be signaled. +

    + + + + + diff --git a/info/gcl/_002aprint_002dmiser_002dwidth_002a.html b/info/gcl/_002aprint_002dmiser_002dwidth_002a.html new file mode 100644 index 0000000..b17e570 --- /dev/null +++ b/info/gcl/_002aprint_002dmiser_002dwidth_002a.html @@ -0,0 +1,65 @@ + + + + + +*print-miser-width* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.24 *print-miser-width* [Variable]

    + +

    Value Type::

    + +

    a non-negative integer, or nil. +

    +

    Initial Value::

    + +

    implementation-dependent +

    +

    Description::

    + +

    If it is not nil, the pretty printer switches to a compact +style of output (called miser style) whenever the width available for +printing a substructure is less than or equal to this many ems. +

    + + + + + diff --git a/info/gcl/_002aprint_002dpprint_002ddispatch_002a.html b/info/gcl/_002aprint_002dpprint_002ddispatch_002a.html new file mode 100644 index 0000000..03dd828 --- /dev/null +++ b/info/gcl/_002aprint_002dpprint_002ddispatch_002a.html @@ -0,0 +1,84 @@ + + + + + +*print-pprint-dispatch* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.25 *print-pprint-dispatch* [Variable]

    + +

    Value Type::

    + +

    a pprint dispatch table. +

    +

    Initial Value::

    + +

    implementation-dependent, but the initial entries all use a +special class of priorities that have the property that they are less +than every priority that can be specified using set-pprint-dispatch, +so that the initial contents of any entry can be overridden. +

    +

    Description::

    + +

    The pprint dispatch table which currently controls the pretty printer. +

    +

    See Also::

    + +

    *print-pretty*, +Pretty Print Dispatch Tables +

    +

    Notes::

    + +

    The intent is that the initial value of this variable should +cause ‘traditional’ pretty printing of code. +In general, however, you can put a value in *print-pprint-dispatch* +that makes pretty-printed output look exactly like non-pretty-printed output. +

    +

    Setting *print-pretty* to true +just causes the functions contained in the current pprint dispatch table +to have priority over normal print-object methods; +it has no magic way of enforcing that those functions actually produce pretty +output. For details, see Pretty Print Dispatch Tables. +

    + + + + + diff --git a/info/gcl/_002aprint_002dpretty_002a.html b/info/gcl/_002aprint_002dpretty_002a.html new file mode 100644 index 0000000..eda66a6 --- /dev/null +++ b/info/gcl/_002aprint_002dpretty_002a.html @@ -0,0 +1,123 @@ + + + + + +*print-pretty* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.26 *print-pretty* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    Controls whether the Lisp printer calls the pretty printer. +

    +

    If it is false, +the pretty printer is not used and +

    +

    a minimum +

    +

    of whitespace_1 +is output when printing an expression. +

    +

    If it is true, +the pretty printer is used, and the Lisp printer will endeavor +to insert extra whitespace_1 where appropriate to make expressions +more readable. +

    +

    *print-pretty* has an effect even when the value of *print-escape* +is false. +

    +

    Examples::

    + +
    +
     (setq *print-pretty* 'nil) ⇒  NIL
+ (progn (write '(let ((a 1) (b 2) (c 3)) (+ a b c))) nil)
+ |>  (LET ((A 1) (B 2) (C 3)) (+ A B C))
+⇒  NIL
+ (let ((*print-pretty* t))
+   (progn (write '(let ((a 1) (b 2) (c 3)) (+ a b c))) nil))
+ |>  (LET ((A 1)
+ |>        (B 2)
+ |>        (C 3))
+ |>    (+ A B C))
+⇒  NIL
+;; Note that the first two expressions printed by this next form
+;; differ from the second two only in whether escape characters are printed.
+;; In all four cases, extra whitespace is inserted by the pretty printer.
+ (flet ((test (x)
+          (let ((*print-pretty* t))
+            (print x)
+            (format t "~
+            (terpri) (princ x) (princ " ")
+            (format t "~
+  (test '#'(lambda () (list "a" #’c #'d))))
+ |>  #'(LAMBDA ()
+ |>      (LIST "a" #’C #'D))
+ |>  #'(LAMBDA ()
+ |>      (LIST "a" #’C #'D))
+ |>  #'(LAMBDA ()
+ |>      (LIST a b 'C #'D)) 
+ |>  #'(LAMBDA ()
+ |>      (LIST a b 'C #'D))
+⇒  NIL
+
    + +

    See Also::

    + +

    write +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002aprint_002dreadably_002a.html b/info/gcl/_002aprint_002dreadably_002a.html new file mode 100644 index 0000000..bb0e01a --- /dev/null +++ b/info/gcl/_002aprint_002dreadably_002a.html @@ -0,0 +1,166 @@ + + + + + +*print-readably* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.27 *print-readably* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    false. +

    +

    Description::

    + +

    If *print-readably* is true, +some special rules for printing objects go into effect. +Specifically, printing any object O_1 produces a printed +representation that, when seen by the Lisp reader +while the standard readtable is in effect, +will produce +an object O_2 that is similar to O_1. +The printed representation produced might or might not be the same as +the printed representation produced when *print-readably* is false. +If printing an object readably is not possible, +an error of type print-not-readable is signaled rather than +using a syntax (e.g., the “#<” syntax) that would not be readable by +the same implementation. +If the value of some other printer control variable is such +that these requirements would be violated, the value of that other +variable is ignored. +

    +

    Specifically, if *print-readably* is true, +printing proceeds as if + *print-escape*, + *print-array*, + and *print-gensym* were also true, +and as if + *print-length*, + *print-level*, + and *print-lines* were false. +

    +

    If *print-readably* is false, +the normal rules for printing and the normal interpretations +of other printer control variables are in effect. +

    +

    Individual methods for print-object, including user-defined +methods, are responsible for implementing these requirements. +

    +

    If *read-eval* is false and *print-readably* is true, +any such method that would output a reference to the “#.” reader macro +will either output something else or will signal an error (as described above). +

    +

    Examples::

    + +
    +
     (let ((x (list "a" '\a (gensym) '((a (b (c))) d e f g)))
+       (*print-escape* nil)
+       (*print-gensym* nil)
+       (*print-level* 3)
+       (*print-length* 3))
+   (write x)
+   (let ((*print-readably* t))
+     (terpri)
+     (write x)
+     :done))
+ |>  (a a G4581 ((A #) D E ...))
+ |>  ("a" |a| #:G4581 ((A (B (C))) D E F G))
+⇒  :DONE
+
+;; This is setup code is shared between the examples
+;; of three hypothetical implementations which follow.
+ (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32005763> 
+ (setf (gethash table 1) 'one) ⇒  ONE
+ (setf (gethash table 2) 'two) ⇒  TWO
+
+;; Implementation A
+ (let ((*print-readably* t)) (print table))
+ Error: Can't print #<HASH-TABLE EQL 0/120 32005763> readably.
+
+;; Implementation B
+;; No standardized #S notation for hash tables is defined, 
+;; but there might be an implementation-defined notation.
+ (let ((*print-readably* t)) (print table))
+ |>  #S(HASH-TABLE :TEST EQL :SIZE 120 :CONTENTS (1 ONE 2 TWO))
+⇒  #<HASH-TABLE EQL 0/120 32005763>
+
+;; Implementation C
+;; Note that #. notation can only be used if *READ-EVAL* is true.
+;; If *READ-EVAL* were false, this same implementation might have to
+;; signal an error unless it had yet another printing strategy to fall
+;; back on.
+ (let ((*print-readably* t)) (print table))
+ |>  #.(LET ((HASH-TABLE (MAKE-HASH-TABLE)))
+ |>      (SETF (GETHASH 1 HASH-TABLE) ONE)
+ |>      (SETF (GETHASH 2 HASH-TABLE) TWO)
+ |>      HASH-TABLE)
+⇒  #<HASH-TABLE EQL 0/120 32005763>
+
    + +

    See Also::

    + +

    write +, +print-unreadable-object +

    +

    Notes::

    + +

    The rules for “similarity” imply that +#A or #( +syntax cannot be used for arrays of element type +other than t. +An implementation will have to use another syntax +or signal an error of type print-not-readable. +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002aprint_002dright_002dmargin_002a.html b/info/gcl/_002aprint_002dright_002dmargin_002a.html new file mode 100644 index 0000000..0803b02 --- /dev/null +++ b/info/gcl/_002aprint_002dright_002dmargin_002a.html @@ -0,0 +1,75 @@ + + + + + +*print-right-margin* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.28 *print-right-margin* [Variable]

    + +

    Value Type::

    + +

    a non-negative integer, or nil. +

    +

    Initial Value::

    + +

    nil. +

    +

    Description::

    + +

    If it is non-nil, it specifies the right margin (as integer +number of ems) to use when the pretty printer is making +layout decisions. +

    +

    If it is nil, the right margin is taken to be the maximum line length +such that output can be displayed without wraparound or truncation. +If this cannot be determined, an implementation-dependent value is used. +

    +

    Notes::

    + +

    This measure is in units of ems in order to be compatible with +implementation-defined variable-width fonts while still not +requiring the language to provide support for fonts. +

    + + + + + diff --git a/info/gcl/_002arandom_002dstate_002a.html b/info/gcl/_002arandom_002dstate_002a.html new file mode 100644 index 0000000..5b25fe0 --- /dev/null +++ b/info/gcl/_002arandom_002dstate_002a.html @@ -0,0 +1,103 @@ + + + + + +*random-state* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.43 *random-state* [Variable]

    + +

    Value Type::

    + +

    a random state. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The current random state, which is used, for example, +by the function random when a random state is not explicitly supplied. +

    +

    Examples::

    + +
    +
     (random-state-p *random-state*) ⇒  true
+ (setq snap-shot (make-random-state))
+ ;; The series from any given point is random,
+ ;; but if you backtrack to that point, you get the same series.
+ (list (loop for i from 1 to 10 collect (random))
+       (let ((*random-state* snap-shot))
+         (loop for i from 1 to 10 collect (random)))
+       (loop for i from 1 to 10 collect (random))
+       (let ((*random-state* snap-shot))
+         (loop for i from 1 to 10 collect (random))))
+⇒  ((19 16 44 19 96 15 76 96 13 61)
+    (19 16 44 19 96 15 76 96 13 61)
+    (16 67 0 43 70 79 58 5 63 50)
+    (16 67 0 43 70 79 58 5 63 50))
+
    + +

    Affected By::

    + +

    The implementation. +

    +

    random. +

    +

    See Also::

    + +

    make-random-state +, +random +, +random-state +

    +

    Notes::

    + +

    Binding *random-state* to a different +random state object correctly saves and +restores the old random state object. +

    + + + + + diff --git a/info/gcl/_002aread_002dbase_002a.html b/info/gcl/_002aread_002dbase_002a.html new file mode 100644 index 0000000..2325610 --- /dev/null +++ b/info/gcl/_002aread_002dbase_002a.html @@ -0,0 +1,97 @@ + + + + + +*read-base* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.13 *read-base* [Variable]

    + +

    Value Type::

    + +

    a radix. +

    +

    Initial Value::

    + +

    10. +

    +

    Description::

    + +

    Controls the interpretation of tokens by read as being +integers or ratios. +

    +

    The value of *read-base*, called the current input base + +, +is the radix in which integers and +ratios are to be read by the Lisp reader. +The parsing of other numeric types (e.g., floats) is +not affected by this option. +

    +

    The effect of *read-base* on the reading of any particular +rational number can be locally overridden by explicit use of the +#O, #X, #B, or #nR syntax +or by a trailing decimal point. +

    +

    Examples::

    + +
    +
     (dotimes (i 6)
+   (let ((*read-base* (+ 10. i)))
+     (let ((object (read-from-string "(\\DAD DAD |BEE| BEE 123. 123)")))
+       (print (list *read-base* object)))))
+ |>  (10 (DAD DAD BEE BEE 123 123))
+ |>  (11 (DAD DAD BEE BEE 123 146))
+ |>  (12 (DAD DAD BEE BEE 123 171))
+ |>  (13 (DAD DAD BEE BEE 123 198))
+ |>  (14 (DAD 2701 BEE BEE 123 227))
+ |>  (15 (DAD 3088 BEE 2699 123 258))
+⇒  NIL
+
    + +

    Notes::

    + +

    Altering the input radix can be useful when reading data files in special formats. +

    + + + + + diff --git a/info/gcl/_002aread_002ddefault_002dfloat_002dformat_002a.html b/info/gcl/_002aread_002ddefault_002dfloat_002dformat_002a.html new file mode 100644 index 0000000..4e4141d --- /dev/null +++ b/info/gcl/_002aread_002ddefault_002dfloat_002dformat_002a.html @@ -0,0 +1,88 @@ + + + + + +*read-default-float-format* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.14 *read-default-float-format* [Variable]

    + +

    Value Type::

    + +

    one of the atomic type specifiers + short-float, + single-float, + double-float, + or long-float, + or else some other type specifier defined + by the implementation to be acceptable. +

    +

    Initial Value::

    + +

    The symbol single-float. +

    +

    Description::

    + +

    Controls the floating-point format that is to be used when reading a +floating-point number that has no exponent marker or that has +e or E for an exponent marker. Other exponent markers +explicitly prescribe the floating-point format to be used. +

    +

    The printer uses *read-default-float-format* to guide the +choice of exponent markers when printing floating-point numbers. +

    +

    Examples::

    + +
    +
     (let ((*read-default-float-format* 'double-float))
+   (read-from-string "(1.0 1.0e0 1.0s0 1.0f0 1.0d0 1.0L0)"))
+⇒  (1.0   1.0   1.0   1.0 1.0   1.0)   ;Implementation has float format F.
+⇒  (1.0   1.0   1.0s0 1.0 1.0   1.0)   ;Implementation has float formats S and F.
+⇒  (1.0d0 1.0d0 1.0   1.0 1.0d0 1.0d0) ;Implementation has float formats F and D.
+⇒  (1.0d0 1.0d0 1.0s0 1.0 1.0d0 1.0d0) ;Implementation has float formats S, F, D.
+⇒  (1.0d0 1.0d0 1.0   1.0 1.0d0 1.0L0) ;Implementation has float formats F, D, L.
+⇒  (1.0d0 1.0d0 1.0s0 1.0 1.0d0 1.0L0) ;Implementation has formats S, F, D, L.
+
    + + + + + + diff --git a/info/gcl/_002aread_002deval_002a.html b/info/gcl/_002aread_002deval_002a.html new file mode 100644 index 0000000..899fcb2 --- /dev/null +++ b/info/gcl/_002aread_002deval_002a.html @@ -0,0 +1,75 @@ + + + + + +*read-eval* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.15 *read-eval* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    true. +

    +

    Description::

    + +

    If it is true, the #. reader macro has its normal effect. +Otherwise, that reader macro signals an error of type reader-error. +

    +

    See Also::

    + +

    *print-readably* +

    +

    Notes::

    + +

    If *read-eval* is false and *print-readably* is true, +any method for print-object that would output a reference +to the #. reader macro either outputs something different +or signals an error of type print-not-readable. +

    + + + + + diff --git a/info/gcl/_002aread_002dsuppress_002a.html b/info/gcl/_002aread_002dsuppress_002a.html new file mode 100644 index 0000000..1d03497 --- /dev/null +++ b/info/gcl/_002aread_002dsuppress_002a.html @@ -0,0 +1,163 @@ + + + + + +*read-suppress* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.16 *read-suppress* [Variable]

    + +

    Value Type::

    + +

    a generalized boolean. +

    +

    Initial Value::

    + +

    false. +

    +

    Description::

    + +

    This variable is intended primarily to support the operation of the +read-time conditional notations #+ and #-. It is important for the +reader macros which implement these notations +to be able to skip over the printed representation of an +expression despite the possibility that the syntax of the skipped +expression may not be entirely valid for the current implementation, +since #+ and #- exist in order to allow the same program to be +shared among several Lisp implementations (including dialects other than Common Lisp) +despite small incompatibilities of syntax. +

    +

    If it is false, the Lisp reader operates normally. +

    +

    If the value of *read-suppress* is true, + read, + read-preserving-whitespace, + read-delimited-list, + and read-from-string +all return a primary value of nil when they complete successfully; +however, they continue to parse the representation of an object +in the normal way, in order to skip over the object, +and continue to indicate end of file in the normal way. +Except as noted below, +any standardized reader macro_2 +that is defined to read_2 +a following object or token +will do so, +but not signal an error if the object +read is not of an appropriate type or syntax. +The standard syntax and its associated reader macros +will not construct any new objects + (e.g., when reading the representation of a symbol, + no symbol will be constructed or interned). +

    +
    +
    Extended tokens
    +

    All extended tokens are completely uninterpreted. +Errors such as those that might otherwise be signaled due to + detection of invalid potential numbers, + invalid patterns of package markers, + and invalid uses of the dot character are suppressed. +

    +
    +
    Dispatching macro characters (including sharpsign)
    +

    Dispatching macro characters continue to parse an infix numerical +argument, and invoke the dispatch function. The standardized +sharpsign reader macros do not enforce any constraints +on either the presence of or the value of the numerical argument. +

    +
    +
    #=
    +

    The #= notation is totally ignored. It does not read +a following object. It produces no object, +but is treated as whitespace_2. +

    +
    +
    ##
    +

    The ## notation always produces nil. +

    +
    + +

    No matter what the value of *read-suppress*, +parentheses still continue to delimit and construct lists; +the #( notation continues to delimit vectors; +and comments, strings, +and the single-quote and backquote notations continue to be +interpreted properly. Such situations as +'), #<, +#), and #<Space> continue to signal errors. +

    +

    Examples::

    + +
    +
     (let ((*read-suppress* t))
+   (mapcar #'read-from-string
+           '("#(foo bar baz)" "#P(:type :lisp)" "#c1.2"
+             "#.(PRINT 'FOO)" "#3AHELLO" "#S(INTEGER)"
+             "#*ABC" "#\GARBAGE" "#RALPHA" "#3R444")))
+⇒  (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
+
    + +

    See Also::

    + +

    read +, +Syntax +

    +

    Notes::

    + +

    Programmers and implementations that define additional +macro characters are strongly encouraged to make them respect +*read-suppress* just as standardized macro characters do. +That is, when the value of *read-suppress* is true, +they should ignore type errors when reading a following object +and the functions that implement dispatching macro characters +should tolerate nil as their infix parameter value even if a numeric +value would ordinarily be required. +

    +
    +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    + + + + + diff --git a/info/gcl/_002areadtable_002a.html b/info/gcl/_002areadtable_002a.html new file mode 100644 index 0000000..c8f3921 --- /dev/null +++ b/info/gcl/_002areadtable_002a.html @@ -0,0 +1,93 @@ + + + + + +*readtable* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.17 *readtable* [Variable]

    + +

    Value Type::

    + +

    a readtable. +

    +

    Initial Value::

    + +

    A readtable that conforms to the description of Common Lisp syntax in Syntax. +

    +

    Description::

    + +

    The value of *readtable* is called the current readtable. +It controls the parsing behavior of the Lisp reader, +and can also influence the Lisp printer (e.g., see the function readtable-case). +

    +

    Examples::

    + +
    +
     (readtablep *readtable*) ⇒  true
+ (setq zvar 123) ⇒  123
+ (set-syntax-from-char #\z #\' (setq table2 (copy-readtable))) ⇒  T
+ zvar ⇒  123
+ (setq *readtable* table2) ⇒  #<READTABLE>
+ zvar ⇒  VAR
+ (setq *readtable* (copy-readtable nil)) ⇒  #<READTABLE>
+ zvar ⇒  123
+
    + +

    Affected By::

    + +

    compile-file, +load +

    +

    See Also::

    + +

    compile-file +, +load +, +readtable +, +The Current Readtable +

    + + + + + diff --git a/info/gcl/_002aterminal_002dio_002a.html b/info/gcl/_002aterminal_002dio_002a.html new file mode 100644 index 0000000..1cd2fbb --- /dev/null +++ b/info/gcl/_002aterminal_002dio_002a.html @@ -0,0 +1,103 @@ + + + + + +*terminal-io* (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.54 *terminal-io* [Variable]

    + +

    Value Type::

    + +

    a bidirectional stream. +

    +

    Initial Value::

    + +

    implementation-dependent, but +it must be an open stream +that is not a generalized synonym stream +to an I/O customization variables +but that might be a generalized synonym stream to +the value of some I/O customization variable. +

    +

    Description::

    + +

    The value of *terminal-io*, called terminal I/O, is ordinarily +a bidirectional stream that connects to the user’s console. +Typically, writing to this stream +would cause the output to appear +on a display screen, for example, and reading from the stream would +accept input from a keyboard. It is intended +that standard input functions such as read and read-char, +when used with this stream, cause echoing of the input +into the output side of the stream. The means by which this is +accomplished are implementation-dependent. +

    +

    The effect of changing the value of *terminal-io*, +either by binding or assignment, +is implementation-defined. +

    +

    Examples::

    + +
    +
     (progn (prin1 'foo) (prin1 'bar *terminal-io*))
+ |>  FOOBAR
+⇒  BAR
+ (with-output-to-string (*standard-output*)
+   (prin1 'foo) 
+   (prin1 'bar *terminal-io*))
+ |>  BAR
+⇒  "FOO"
+
    + +

    See Also::

    + +

    *debug-io*, +*error-output*, +*query-io*, +*standard-input*, +*standard-output*, +*trace-output* +

    + + + + + diff --git a/info/gcl/_002b-_0028Variable_0029.html b/info/gcl/_002b-_0028Variable_0029.html new file mode 100644 index 0000000..4092c37 --- /dev/null +++ b/info/gcl/_002b-_0028Variable_0029.html @@ -0,0 +1,95 @@ + + + + + ++ (Variable) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.21 +, ++, +++ [Variable]

    + +

    Value Type::

    + +

    an object. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The variables +, ++, and +++ are maintained by the +Lisp read-eval-print loop to save forms that were +recently evaluated. +

    +

    The value of + is the last form that was evaluated, +the value of ++ is the previous value of +, and +the value of +++ is the previous value of ++. +

    +

    Examples::

    +
    +
    (+ 0 1) ⇒  1
+(- 4 2) ⇒  2
+(/ 9 3) ⇒  3
+(list + ++ +++) ⇒  ((/ 9 3) (- 4 2) (+ 0 1))
+(setq a 1 b 2 c 3 d (list a b c)) ⇒  (1 2 3)
+(setq a 4 b 5 c 6 d (list a b c)) ⇒  (4 5 6)
+(list a b c) ⇒  (4 5 6)
+(eval +++) ⇒  (1 2 3)
+#.`(,@++ d) ⇒  (1 2 3 (1 2 3))
+
    + +

    Affected By::

    + +

    Lisp read-eval-print loop. +

    +

    See Also::

    + +

    - + (variable), +* (variable), +/ + (variable), +Top level loop +

    + + + + + diff --git a/info/gcl/_002b.html b/info/gcl/_002b.html new file mode 100644 index 0000000..ad2044e --- /dev/null +++ b/info/gcl/_002b.html @@ -0,0 +1,85 @@ + + + + + ++ (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.25 + [Function]

    + +

    + &rest numbers ⇒ sum +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    sum—a number. +

    +

    Description::

    + +

    Returns the sum of numbers, +performing any necessary type conversions in the process. +If no numbers are supplied, 0 is returned. +

    +

    Examples::

    +
    +
     (+) ⇒  0
+ (+ 1) ⇒  1
+ (+ 31/100 69/100) ⇒  1
+ (+ 1/5 0.8) ⇒  1.0
+
    + +

    Exceptional Situations::

    + +

    Might signal type-error if some argument is not a number. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    Numeric Operations, +Rational Computations, +Floating-point Computations, +Complex Computations +

    + + + + + diff --git a/info/gcl/_002d-_0028Variable_0029.html b/info/gcl/_002d-_0028Variable_0029.html new file mode 100644 index 0000000..f0ab4a1 --- /dev/null +++ b/info/gcl/_002d-_0028Variable_0029.html @@ -0,0 +1,84 @@ + + + + + +- (Variable) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.20 - [Variable]

    + +

    Value Type::

    + +

    a form. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The value of - is the form that is currently being evaluated by +the Lisp read-eval-print loop. +

    +

    Examples::

    + +
    +
    (format t "~&Evaluating ~S~
+ |>  Evaluating (FORMAT T "~&Evaluating ~S~
+⇒  NIL
+
    + +

    Affected By::

    + +

    Lisp read-eval-print loop. +

    +

    See Also::

    + +

    + (variable), +* (variable), +/ + (variable), +Top level loop +

    + + + + + diff --git a/info/gcl/_002d.html b/info/gcl/_002d.html new file mode 100644 index 0000000..c5e11f7 --- /dev/null +++ b/info/gcl/_002d.html @@ -0,0 +1,97 @@ + + + + + +- (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.26 - [Function]

    + +

    - number ⇒ negation +

    +

    - minuend &rest subtrahends^+ ⇒ difference +

    +

    Arguments and Values::

    + +

    number, minuend, subtrahend—a number. +

    +

    negation, difference—a number. +

    +

    Description::

    + +

    The function - performs arithmetic subtraction and negation. +

    +

    If only one number is supplied, +the negation of that number is returned. +

    +

    If more than one argument is given, +it subtracts all of the subtrahends from the minuend +and returns the result. +

    +

    The function - performs necessary type conversions. +

    +

    Examples::

    + +
    +
     (- 55.55) ⇒  -55.55
+ (- #c(3 -5)) ⇒  #C(-3 5)
+ (- 0) ⇒  0
+ (eql (- 0.0) -0.0) ⇒  true
+ (- #c(100 45) #c(0 45)) ⇒  100
+ (- 10 1 2 3 4) ⇒  0
+
    + +

    Exceptional Situations::

    + +

    Might signal type-error if some argument is not a number. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    Numeric Operations, +Rational Computations, +Floating-point Computations, +Complex Computations +

    + + + + + diff --git a/info/gcl/_002d_003eUNSPECIFIC-as-a-Component-Value.html b/info/gcl/_002d_003eUNSPECIFIC-as-a-Component-Value.html new file mode 100644 index 0000000..d7ce28e --- /dev/null +++ b/info/gcl/_002d_003eUNSPECIFIC-as-a-Component-Value.html @@ -0,0 +1,76 @@ + + + + + +->UNSPECIFIC as a Component Value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.9 :UNSPECIFIC as a Component Value

    + +

    If :unspecific + is the value of a pathname component, +the component is considered to be “absent” +or to “have no meaning” +in the filename being represented by the pathname. +

    +

    Whether a value of :unspecific is permitted for any component +on any given file system accessible to the implementation +is implementation-defined. +A conforming program must never unconditionally use a +:unspecific as the value of a pathname component because +such a value is not guaranteed to be permissible in all implementations. +However, a conforming program can, if it is careful, +successfully manipulate user-supplied data +which contains or refers to non-portable pathname components. +And certainly a conforming program should be prepared for the +possibility that any components of a pathname could be :unspecific. +

    +

    When reading_1 the value of any pathname component, +conforming programs should be prepared for the value to be :unspecific. +

    +

    When writing_1 the value of any pathname component, +the consequences are undefined if :unspecific is given +for a pathname in a file system for which it does not make sense. +

    + + + + + diff --git a/info/gcl/_002d_003eWILD-as-a-Component-Value.html b/info/gcl/_002d_003eWILD-as-a-Component-Value.html new file mode 100644 index 0000000..bc15001 --- /dev/null +++ b/info/gcl/_002d_003eWILD-as-a-Component-Value.html @@ -0,0 +1,71 @@ + + + + + +->WILD as a Component Value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Interpreting Pathname Component Values  

    +
    +
    +

    19.2.2.8 :WILD as a Component Value

    + +

    If :wild + is the value of a pathname component, +that component is considered to be a wildcard, which matches anything. +

    +

    A conforming program must be prepared to encounter a value of :wild +as the value of any pathname component, +or as an element of a list that is the value of the directory component. +

    +

    When constructing a pathname, +a conforming program may use :wild as the value of any or all of +the directory, name, type, +or version component, but must not use :wild as the value of the host, +or device component. +

    +

    If :wild is used as the value of the directory component in the construction +of a pathname, the effect is equivalent to specifying the list +(:absolute :wild-inferiors), +or the same as (:absolute :wild) in a file system that does not support +:wild-inferiors. +

    + + + + + diff --git a/info/gcl/_002f-_0028Variable_0029.html b/info/gcl/_002f-_0028Variable_0029.html new file mode 100644 index 0000000..8412582 --- /dev/null +++ b/info/gcl/_002f-_0028Variable_0029.html @@ -0,0 +1,93 @@ + + + + + +/ (Variable) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.23 /, //, /// [Variable]

    + +

    Value Type::

    + +

    a proper list. +

    +

    Initial Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The variables /, //, and /// are maintained by +the Lisp read-eval-print loop to save the values of results that +were printed at the end of the loop. +

    +

    The value of / is a list of the most recent values that were printed, +the value of // is the previous value of /, and +the value of /// is the previous value of //. +

    +

    The values of /, //, and /// are updated immediately +prior to printing the return value of a top-level form by the +Lisp read-eval-print loop. If the evaluation of such a form +is aborted prior to its normal return, the values of /, //, and /// +are not updated. +

    +

    Examples::

    +
    +
     (floor 22 7) ⇒  3, 1
+ (+ (* (car /) 7) (cadr /)) ⇒  22
+
    + +

    Affected By::

    + +

    Lisp read-eval-print loop. +

    +

    See Also::

    + +

    - + (variable), ++ (variable), +* (variable), +Top level loop +

    + + + + + diff --git a/info/gcl/_002f.html b/info/gcl/_002f.html new file mode 100644 index 0000000..3715a39 --- /dev/null +++ b/info/gcl/_002f.html @@ -0,0 +1,109 @@ + + + + + +/ (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.27 / [Function]

    + +

    / number ⇒ reciprocal +

    +

    / numerator &rest denominators^+ ⇒ quotient +

    +

    Arguments and Values::

    + +

    number, denominator—a non-zero number. +

    +

    numerator, quotient, reciprocal—a number. +

    +

    Description::

    + +

    The function / performs division or reciprocation. +

    +

    If no denominators are supplied, +the function / returns the reciprocal of number. +

    +

    If at least one denominator is supplied, +the function / divides the numerator by all of the denominators +and returns the resulting quotient. +

    +

    If each argument is either an integer or a ratio, +and the result is not an integer, then it is a ratio. +

    +

    The function / performs necessary type conversions. +

    +

    If any argument is a float then +the rules of floating-point contagion apply; +see Floating-point Computations. +

    +

    Examples::

    + +
    +
     (/ 12 4) ⇒  3
+ (/ 13 4) ⇒  13/4
+ (/ -8) ⇒  -1/8
+ (/ 3 4 5) ⇒  3/20
+ (/ 0.5) ⇒  2.0
+ (/ 20 5) ⇒  4
+ (/ 5 20) ⇒  1/4
+ (/ 60 -2 3 5.0) ⇒  -2.0
+ (/ 2 #c(2 2)) ⇒  #C(1/2 -1/2)
+
    + +

    Exceptional Situations::

    + +

    The consequences are unspecified if any argument other than the first is zero. +If there is only one argument, the consequences are unspecified if it is zero. +

    +

    Might signal type-error if some argument is not a number. +Might signal division-by-zero if division by zero is attempted. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    floor +, ceiling, truncate, round +

    + + + + + diff --git a/info/gcl/_003d.html b/info/gcl/_003d.html new file mode 100644 index 0000000..c29005d --- /dev/null +++ b/info/gcl/_003d.html @@ -0,0 +1,165 @@ + + + + + += (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.15 =, /=, <, >, <=, >= [Function]

    + +

    = &rest numbers^+ ⇒ generalized-boolean +

    +

    /= &rest numbers^+ ⇒ generalized-boolean +

    +

    < &rest numbers^+ ⇒ generalized-boolean +

    +

    > &rest numbers^+ ⇒ generalized-boolean +

    +

    <= &rest numbers^+ ⇒ generalized-boolean +

    +

    >= &rest numbers^+ ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    number—for <, >, <=, >=: a real; + for =, /=: a number. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    =, /=, <, >, <=, and >= +perform arithmetic comparisons on their arguments as follows: +

    +
    +
    =
    +

    The value of = is true if all numbers are the same in value; +otherwise it is false. +Two complexes are considered equal by = +if their real and imaginary parts are equal according to =. +

    +
    +
    /=
    +

    The value of /= is true if no two numbers are the same in value; +otherwise it is false. +

    +
    +
    <
    +

    The value of < is true if the numbers are in monotonically increasing order; +otherwise it is false. +

    +
    +
    >
    +

    The value of > is true if the numbers are in monotonically decreasing order; +otherwise it is false. +

    +
    +
    <=
    +

    The value of <= is true if the numbers are in monotonically + nondecreasing order; +otherwise it is false. +

    +
    +
    >=
    +

    The value of >= is true if the numbers are in monotonically + nonincreasing order; +otherwise it is false. +

    +
    + +

    =, /=, <, >, <=, and >= +perform necessary type conversions. +

    +

    Examples::

    + +

    The uses of these functions are illustrated in Figure 12–12. +

    +
    +
      (= 3 3) is true.              (/= 3 3) is false.             
+  (= 3 5) is false.             (/= 3 5) is true.              
+  (= 3 3 3 3) is true.          (/= 3 3 3 3) is false.         
+  (= 3 3 5 3) is false.         (/= 3 3 5 3) is false.         
+  (= 3 6 5 2) is false.         (/= 3 6 5 2) is true.          
+  (= 3 2 3) is false.           (/= 3 2 3) is false.           
+  (< 3 5) is true.              (<= 3 5) is true.              
+  (< 3 -5) is false.            (<= 3 -5) is false.            
+  (< 3 3) is false.             (<= 3 3) is true.              
+  (< 0 3 4 6 7) is true.        (<= 0 3 4 6 7) is true.        
+  (< 0 3 4 4 6) is false.       (<= 0 3 4 4 6) is true.        
+  (> 4 3) is true.              (>= 4 3) is true.              
+  (> 4 3 2 1 0) is true.        (>= 4 3 2 1 0) is true.        
+  (> 4 3 3 2 0) is false.       (>= 4 3 3 2 0) is true.        
+  (> 4 3 1 2 0) is false.       (>= 4 3 1 2 0) is false.       
+  (= 3) is true.                (/= 3) is true.                
+  (< 3) is true.                (<= 3) is true.                
+  (= 3.0 #c(3.0 0.0)) is true.  (/= 3.0 #c(3.0 1.0)) is true.  
+  (= 3 3.0) is true.            (= 3.0s0 3.0d0) is true.       
+  (= 0.0 -0.0) is true.         (= 5/2 2.5) is true.           
+  (> 0.0 -0.0) is false.        (= 0 -0.0) is true.            
+  (<= 0 x 9) is true if x is between 0 and 9, inclusive
+  (< 0.0 x 1.0) is true if x is between 0.0 and 1.0, exclusive
+  (< -1 j (length v)) is true if j is a valid array index for a vector v
+
+         Figure 12–12: Uses of /=, =, <, >, <=, and >=        
+
+
    + +

    Exceptional Situations::

    + +

    Might signal type-error if some argument is not a real. +Might signal arithmetic-error if otherwise unable to fulfill its contract. +

    +

    Notes::

    + +

    = differs from eql in that +(= 0.0 -0.0) is always true, +because = compares the mathematical values of its operands, +whereas eql compares the representational values, so to speak. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/abort-_0028Function_0029.html b/info/gcl/abort-_0028Function_0029.html new file mode 100644 index 0000000..e7581ff --- /dev/null +++ b/info/gcl/abort-_0028Function_0029.html @@ -0,0 +1,280 @@ + + + + + +abort (Function) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.46 abort, continue, muffle-warning, store-value, use-value [Function]

    + + + + + + + + + + + +

    abort &optional condition + ⇒ #<NoValue> +

    +

    continue &optional condition ⇒ nil +

    +

    muffle-warning &optional condition + ⇒ #<NoValue> +

    +

    store-value value &optional condition ⇒ nil +

    +

    use-value value &optional condition ⇒ nil +

    +

    Arguments and Values::

    + +

    value—an object. +

    +

    condition—a condition object, or nil. +

    +

    Description::

    + +

    Transfers control to the most recently established applicable restart +having the same name as the function. That is, + the function abort searches for an applicable abort restart, + the function continue searches for an applicable continue restart, +and so on. +

    +

    If no such restart exists, +the functions + continue, + store-value, + and use-value +return nil, and +the functions + abort + and muffle-warning +signal an error of type control-error. +

    +

    When condition is non-nil, +only those restarts are considered that are + either explicitly associated with that condition, + or not associated with any condition; +that is, the excluded restarts are +those that are associated with a non-empty set of conditions +of which the given condition is not an element. +If condition is nil, all restarts are considered. +

    +

    Examples::

    + +
    +
    ;;; Example of the ABORT retart
+
+ (defmacro abort-on-error (&body forms)
+   `(handler-bind ((error #'abort))
+      ,@forms)) ⇒  ABORT-ON-ERROR
+ (abort-on-error (+ 3 5)) ⇒  8
+ (abort-on-error (error "You lose."))
+ |>  Returned to Lisp Top Level.
+
+;;; Example of the CONTINUE restart
+
+ (defun real-sqrt (n)
+   (when (minusp n)
+     (setq n (- n))
+     (cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n))
+   (sqrt n))
+
+ (real-sqrt 4) ⇒  2
+ (real-sqrt -9)
+ |>  Error: Tried to take sqrt(-9).
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Return sqrt(9) instead.
+ |>   2: Return to Lisp Toplevel.
+ |>  Debug> |>>(continue)<<|
+ |>  Return sqrt(9) instead.
+⇒  3
+
+ (handler-bind ((error #'(lambda (c) (continue))))
+   (real-sqrt -9)) ⇒  3
+
+;;; Example of the MUFFLE-WARNING restart
+
+ (defun count-down (x)
+   (do ((counter x (1- counter)))
+       ((= counter 0) 'done)
+     (when (= counter 1)
+       (warn "Almost done"))
+     (format t "~&~D~
+⇒  COUNT-DOWN
+ (count-down 3)
+ |>  3
+ |>  2
+ |>  Warning: Almost done
+ |>  1
+⇒  DONE
+ (defun ignore-warnings-while-counting (x)
+   (handler-bind ((warning #'ignore-warning))
+     (count-down x)))
+⇒  IGNORE-WARNINGS-WHILE-COUNTING
+ (defun ignore-warning (condition)
+   (declare (ignore condition))
+   (muffle-warning))
+⇒  IGNORE-WARNING
+ (ignore-warnings-while-counting 3)
+ |>  3
+ |>  2
+ |>  1
+⇒  DONE
+
+;;; Example of the STORE-VALUE and USE-VALUE restarts
+
+ (defun careful-symbol-value (symbol)
+   (check-type symbol symbol)
+   (restart-case (if (boundp symbol)
+                     (return-from careful-symbol-value 
+                                  (symbol-value symbol))
+                     (error 'unbound-variable
+                            :name symbol))
+     (use-value (value)
+       :report "Specify a value to use this time."
+       value)
+     (store-value (value)
+       :report "Specify a value to store and use in the future."
+       (setf (symbol-value symbol) value))))
+ (setq a 1234) ⇒  1234
+ (careful-symbol-value 'a) ⇒  1234
+ (makunbound 'a) ⇒  A
+ (careful-symbol-value 'a)
+ |>  Error: A is not bound.
+ |>  To continue, type :CONTINUE followed by an option number.
+ |>   1: Specify a value to use this time.
+ |>   2: Specify a value to store and use in the future.
+ |>   3: Return to Lisp Toplevel.
+ |>  Debug> |>>(use-value 12)<<|
+⇒  12
+ (careful-symbol-value 'a)
+ |>  Error: A is not bound.
+ |>  To continue, type :CONTINUE followed by an option number.
+ |>    1: Specify a value to use this time.
+ |>    2: Specify a value to store and use in the future.
+ |>    3: Return to Lisp Toplevel.
+ |>  Debug> |>>(store-value 24)<<|
+⇒  24
+ (careful-symbol-value 'a)
+⇒  24
+
+;;; Example of the USE-VALUE restart
+
+ (defun add-symbols-with-default (default &rest symbols)
+   (handler-bind ((sys:unbound-symbol
+                    #'(lambda (c)
+                        (declare (ignore c)) 
+                        (use-value default))))
+     (apply #'+ (mapcar #'careful-symbol-value symbols))))
+⇒  ADD-SYMBOLS-WITH-DEFAULT
+ (setq x 1 y 2) ⇒  2
+ (add-symbols-with-default 3 'x 'y 'z) ⇒  6
+
+
    + +

    Side Effects::

    + +

    A transfer of control may occur if an appropriate restart is available, +or (in the case of the function abort or the function muffle-warning) +execution may be stopped. +

    +

    Affected By::

    + +

    Each of these functions can be affected by +the presence of a restart having the same name. +

    +

    Exceptional Situations::

    + +

    If an appropriate abort restart + is not available for the function abort, +or an appropriate muffle-warning restart + is not available for the function muffle-warning, +an error of type control-error is signaled. +

    +

    See Also::

    + +

    invoke-restart +, +Restarts, +Interfaces to Restarts, +assert +, +ccase, +cerror +, +check-type +, +ctypecase, +use-value +, +warn +

    +

    Notes::

    + +
    +
     (abort condition) ≡ (invoke-restart 'abort)
+ (muffle-warning)  ≡ (invoke-restart 'muffle-warning)
+ (continue)        ≡ (let ((r (find-restart 'continue))) (if r (invoke-restart r)))
+ (use-value x) ≡ (let ((r (find-restart 'use-value))) (if r (invoke-restart r x)))
+ (store-value x) ≡ (let ((r (find-restart 'store-value))) (if r (invoke-restart r x)))
+
    + +

    No functions defined in this specification are required to provide +a use-value restart. +

    + + + + + +
    +
    +

    +Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/abort-_0028Restart_0029.html b/info/gcl/abort-_0028Restart_0029.html new file mode 100644 index 0000000..e4c8bac --- /dev/null +++ b/info/gcl/abort-_0028Restart_0029.html @@ -0,0 +1,78 @@ + + + + + +abort (Restart) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.41 abort [Restart]

    + +

    Data Arguments Required::

    + +

    None. +

    +

    Description::

    + +

    The intent of the abort restart is to allow return to the +innermost “command level.” Implementors are encouraged to make +sure that there is always a restart named abort +around any user code so that user code can call abort +at any time and expect something reasonable to happen; +exactly what the reasonable thing is may vary somewhat. Typically, +in an interactive listener, the invocation of abort +returns to the Lisp reader phase of the Lisp read-eval-print loop, +though in some batch or multi-processing +situations there may be situations in which having it kill the running +process is more appropriate. +

    +

    See Also::

    + +

    Restarts, +Interfaces to Restarts, +invoke-restart +, +abort (Function) + (function) +

    + + + + + diff --git a/info/gcl/abs.html b/info/gcl/abs.html new file mode 100644 index 0000000..8008c98 --- /dev/null +++ b/info/gcl/abs.html @@ -0,0 +1,113 @@ + + + + + +abs (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.29 abs [Function]

    + +

    abs number ⇒ absolute-value +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    absolute-value—a non-negative real. +

    +

    Description::

    + +

    abs returns the absolute value of number. +

    +

    If number is +

    +

    a real, +

    +

    the result is of the same type as number. +

    +

    If number is a complex, +the result is a positive +

    +

    real +

    +

    with +the same magnitude as number. +The result can be a float +

    +

    [Reviewer Note by Barmar: Single-float.] +even if number’s components are rationals +and an exact rational result +would have been possible. +Thus the result of (abs #c(3 4)) can be either 5 or 5.0, +depending on the implementation. +

    +

    Examples::

    + +
    +
     (abs 0) ⇒  0
+ (abs 12/13) ⇒  12/13
+ (abs -1.09) ⇒  1.09
+ (abs #c(5.0 -5.0)) ⇒  7.071068
+ (abs #c(5 5)) ⇒  7.071068
+ (abs #c(3/5 4/5)) ⇒  1 or approximately 1.0
+ (eql (abs -0.0) -0.0) ⇒  true
+
    + +

    See Also::

    + +

    Rule of Float Substitutability +

    +

    Notes::

    + +

    If number is a complex, +the result is equivalent to the following: +

    +

    (sqrt (+ (expt (realpart number) 2) (expt (imagpart number) 2))) +

    +

    An implementation should not use this formula directly +for all complexes +but should handle very large or very small components specially +to avoid intermediate overflow or underflow. +

    + + + + + diff --git a/info/gcl/acons.html b/info/gcl/acons.html new file mode 100644 index 0000000..f9fbfe7 --- /dev/null +++ b/info/gcl/acons.html @@ -0,0 +1,95 @@ + + + + + +acons (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.35 acons [Function]

    + +

    acons key datum alist ⇒ new-alist +

    +

    Arguments and Values::

    + +

    key—an object. +

    +

    datum—an object. +

    +

    alist—an association list. +

    +

    new-alist—an association list. +

    +

    Description::

    + +

    Creates a fresh cons, +the cdr of which is alist and +the car of which is another fresh cons, + the car of which is key and + the cdr of which is datum. +

    +

    Examples::

    + +
    +
     (setq alist '()) ⇒  NIL
+ (acons 1 "one" alist) ⇒  ((1 . "one"))
+ alist ⇒  NIL
+ (setq alist (acons 1 "one" (acons 2 "two" alist))) ⇒  ((1 . "one") (2 . "two"))
+ (assoc 1 alist) ⇒  (1 . "one")
+ (setq alist (acons 1 "uno" alist)) ⇒  ((1 . "uno") (1 . "one") (2 . "two"))
+ (assoc 1 alist) ⇒  (1 . "uno")
+
    + +

    See Also::

    + +

    assoc +, +pairlis +

    +

    Notes::

    + +
    +
    (acons key datum alist) ≡ (cons (cons key datum) alist)
+
    + + + + + + diff --git a/info/gcl/add_002dmethod.html b/info/gcl/add_002dmethod.html new file mode 100644 index 0000000..c36cf74 --- /dev/null +++ b/info/gcl/add_002dmethod.html @@ -0,0 +1,96 @@ + + + + + +add-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.35 add-method [Standard Generic Function]

    + +

    Syntax::

    + +

    add-method generic-function method ⇒ generic-function +

    +

    Method Signatures::

    + +

    add-method (generic-function standard-generic-function) + (method method) +

    +

    Arguments and Values::

    + +

    generic-function—a generic function object. +

    +

    method—a method object. +

    +

    Description::

    + +

    The generic function add-method adds a method +to a generic function. +

    +

    If method agrees with an existing method of generic-function +on parameter specializers and qualifiers, +the existing method is replaced. +

    +

    Exceptional Situations::

    + +

    The lambda list of the method function of method must be +congruent with the lambda list of generic-function, +or an error of type error is signaled. +

    +

    If method is a method object of +another generic function, an error of type error is signaled. +

    +

    See Also::

    + +

    defmethod +, +defgeneric +, +find-method +, +remove-method +, +Agreement on Parameter Specializers and Qualifiers +

    + + + + + diff --git a/info/gcl/adjoin.html b/info/gcl/adjoin.html new file mode 100644 index 0000000..97d2322 --- /dev/null +++ b/info/gcl/adjoin.html @@ -0,0 +1,124 @@ + + + + + +adjoin (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.44 adjoin [Function]

    + +

    adjoin item list &key key test test-not ⇒ new-list +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    list—a proper list. +

    +

    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. +

    +

    new-list—a list. +

    +

    Description::

    + +

    Tests whether item is the same as an existing element of list. +If the item is not an existing element, +adjoin adds it to list (as if by cons) +and returns the resulting list; +otherwise, nothing is added and the original list is returned. +

    +

    The test, test-not, and key +affect how it is determined whether item is the same as an element of list. +For details, see Satisfying a Two-Argument Test.\ifvmode\else\endgraf +\ifdim \prevdepth>-1000pt +\NIS\parskip \normalparskip\relax\fi +

    +

    Examples::

    + +
    +
     (setq slist '()) ⇒  NIL 
+ (adjoin 'a slist) ⇒  (A) 
+ slist ⇒  NIL 
+ (setq slist (adjoin '(test-item 1) slist)) ⇒  ((TEST-ITEM 1)) 
+ (adjoin '(test-item 1) slist) ⇒  ((TEST-ITEM 1) (TEST-ITEM 1)) 
+ (adjoin '(test-item 1) slist :test 'equal) ⇒  ((TEST-ITEM 1)) 
+ (adjoin '(new-test-item 1) slist :key #'cadr) ⇒  ((TEST-ITEM 1)) 
+ (adjoin '(new-test-item 1) slist) ⇒  ((NEW-TEST-ITEM 1) (TEST-ITEM 1)) 
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list is not a proper list. +

    +

    See Also::

    + +

    pushnew +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +
    +
     (adjoin item list :key fn)
+   ≡ (if (member (fn item) list :key fn) list (cons item list))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/adjust_002darray.html b/info/gcl/adjust_002darray.html new file mode 100644 index 0000000..7adbb62 --- /dev/null +++ b/info/gcl/adjust_002darray.html @@ -0,0 +1,312 @@ + + + + + +adjust-array (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.8 adjust-array [Function]

    + +

    adjust-array array new-dimensions &key element-type + initial-element + initial-contents + fill-pointer + displaced-to + displaced-index-offset
    + ⇒ adjusted-array +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    new-dimensions—a valid array dimension + or a list of valid array dimensions. +

    +

    element-type—a type specifier. +

    +

    initial-element—an object. + Initial-element must not be supplied if either + initial-contents or displaced-to is supplied. +

    +

    initial-contents—an object. + If array has rank greater than zero, then initial-contents + is composed of nested sequences, the depth of which must equal + the rank of array. Otherwise, array is zero-dimensional and + initial-contents supplies the single element. + initial-contents must not be supplied if either + initial-element or displaced-to is given. +

    +

    fill-pointer—a valid fill pointer for the + array to be created, or t, or nil. + The default is nil. +

    +

    displaced-to—an array or nil. + initial-elements and initial-contents must not be supplied + if displaced-to is supplied. +

    +

    displaced-index-offset—an object of type (fixnum 0 n) + where n is (array-total-size displaced-to). + displaced-index-offset may be supplied only if displaced-to is supplied. +

    +

    adjusted-array—an array. +

    +

    Description::

    + +

    adjust-array changes the dimensions or elements of array. +The result is an array of the same type and rank as array, +that is either the modified array, +or a newly created array to which +array can be displaced, and that has +the given new-dimensions. +

    +

    New-dimensions specify the size of each dimension of array. +

    +

    Element-type specifies the type of the elements +of the resulting array. If element-type is supplied, +the consequences are unspecified if +the upgraded array element type of element-type +is not the same as the actual array element type of array. +

    +

    If initial-contents is supplied, it is treated as for +make-array. In this case none of the original contents of +array appears in the resulting array. +

    +

    If fill-pointer is an integer, +it becomes the fill pointer for the resulting array. +If fill-pointer is the symbol t, +it indicates that the size of the resulting array +should be used as the fill pointer. +If fill-pointer is nil, +it indicates that the fill pointer should be left as it is. +

    +

    If displaced-to +non-nil, a displaced array +is created. The resulting array shares its contents with the array given by +displaced-to. +The resulting array cannot contain more elements than the array +it is displaced to. +If displaced-to is not supplied or nil, +the resulting array is not a displaced array. +If array A is created displaced to array B and subsequently +array B is given to adjust-array, array A will still be +displaced to array B. +Although array might be a displaced array, +the resulting array is not a displaced array unless +displaced-to is supplied and not nil. +

    +

    The interaction between adjust-array and +displaced arrays +is as follows given three arrays, A, B, and~C: +

    +
    +
    A is not displaced before or after the call
    +
    +
     (adjust-array A ...)
+
    + +

    The dimensions of A are altered, and the +contents rearranged as appropriate. +Additional elements of A are taken from +initial-element. +The use of initial-contents causes all old contents to be +discarded. +

    +
    +
    A is not displaced before, but is displaced to
    +

    C after the call +

    +
     (adjust-array A ... :displaced-to C)
+
    + +

    None of the original contents of A appears in +A afterwards; A now contains +the contents of C, without any rearrangement of C. +

    +
    +
    A is displaced to B
    +

    before the call, and is displaced to C after +the call +

    +
     (adjust-array A ... :displaced-to B)
+ (adjust-array A ... :displaced-to C)
+
    + +

    B and C might be the same. The contents of B do not appear in +A afterward unless such contents also happen to be in C If +displaced-index-offset +is not supplied in the adjust-array call, it defaults +to zero; the old offset into B is not retained. +

    +
    +
    A is displaced to B before the call, but not displaced
    +

    afterward. +

    +
     (adjust-array A ... :displaced-to B)
+ (adjust-array A ... :displaced-to nil)
+
    + +

    A gets a +new “data region,” and contents of B are copied into it as appropriate to +maintain the existing old contents; additional elements of A +are taken from +initial-element if supplied. However, +the use of initial-contents causes all old contents +to be discarded. +

    +
    + +

    If displaced-index-offset is supplied, +it specifies the offset +of the resulting array from the beginning of +the array that it is displaced to. +If displaced-index-offset is not supplied, the offset is~0. +The size of the resulting array plus the +offset value cannot exceed the size of +the array that it is displaced to. +

    +

    If only new-dimensions +and an initial-element argument are supplied, +those elements of array that +are still in bounds appear in the resulting array. The elements of +the resulting array that are not in the bounds of +array are initialized +to initial-element; if initial-element is not provided, +

    +

    the consequences of later reading any such new element of new-array +before it has been initialized +are undefined. +

    +

    If initial-contents or displaced-to is supplied, +then none of the original contents of array appears in the new array. +

    +

    The consequences are unspecified if array is adjusted +to a size smaller than its fill pointer without supplying +the fill-pointer argument so that its fill-pointer +is properly adjusted in the process. +

    +

    If A is displaced to B, the consequences are unspecified +if B is adjusted in such a way that it no longer has enough elements +to satisfy A. +

    +

    If adjust-array is applied to an array that is actually adjustable, +the array returned is identical to array. +If the array returned by adjust-array +is distinct from array, then the argument array is unchanged. +

    +

    Note that if an array A is displaced to another array B, +and B is displaced to another array C, and B is altered by +adjust-array, A must now refer to the adjust contents of B. +This means that an implementation cannot collapse the chain to make A +refer to C directly and forget that the chain of reference passes through +B. However, caching techniques are permitted as long as they preserve the +semantics specified here. +

    +

    Examples::

    + +
    +
     (adjustable-array-p
+  (setq ada (adjust-array
+              (make-array '(2 3)
+                          :adjustable t
+                          :initial-contents '((a b c) (1 2 3)))
+              '(4 6)))) ⇒  T 
+ (array-dimensions ada) ⇒  (4 6) 
+ (aref ada 1 1) ⇒  2 
+ (setq beta (make-array '(2 3) :adjustable t))
+⇒  #2A((NIL NIL NIL) (NIL NIL NIL)) 
+ (adjust-array beta '(4 6) :displaced-to ada)
+⇒  #2A((A B C NIL NIL NIL)
+       (1 2 3 NIL NIL NIL)
+       (NIL NIL NIL NIL NIL NIL) 
+       (NIL NIL NIL NIL NIL NIL))
+ (array-dimensions beta) ⇒  (4 6)
+ (aref beta 1 1) ⇒  2 
+
    + +

    Suppose that the 4-by-4 array in m looks like this: +

    +
    +
    #2A(( alpha     beta      gamma     delta )
+    ( epsilon   zeta      eta       theta )
+    ( iota      kappa     lambda    mu    )
+    ( nu        xi        omicron   pi    ))
+
    + +

    Then the result of +

    +
    +
     (adjust-array m '(3 5) :initial-element 'baz)
+
    + +

    is a 3-by-5 array with contents +

    +
    +
    #2A(( alpha     beta      gamma     delta     baz )
+    ( epsilon   zeta      eta       theta     baz )
+    ( iota      kappa     lambda    mu        baz ))
+
    + +

    Exceptional Situations::

    + +

    An error of type error is signaled if fill-pointer is supplied +and non-nil but array has no fill pointer. +

    +

    See Also::

    + +

    adjustable-array-p +, +make-array +, +array-dimension-limit +, +array-total-size-limit +, +array +

    +
    +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    + + + + + diff --git a/info/gcl/adjustable_002darray_002dp.html b/info/gcl/adjustable_002darray_002dp.html new file mode 100644 index 0000000..8a02227 --- /dev/null +++ b/info/gcl/adjustable_002darray_002dp.html @@ -0,0 +1,86 @@ + + + + + +adjustable-array-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.9 adjustable-array-p [Function]

    + +

    adjustable-array-p array ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if and only if adjust-array could return a value +which is identical to array when given that array as its +first argument. +

    +

    Examples::

    + +
    +
     (adjustable-array-p 
+   (make-array 5
+               :element-type 'character 
+               :adjustable t 
+               :fill-pointer 3)) ⇒  true
+ (adjustable-array-p (make-array 4)) ⇒  implementation-dependent
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if its argument is not an array. +

    +

    See Also::

    + +

    adjust-array +, +make-array +

    + + + + + diff --git a/info/gcl/allocate_002dinstance.html b/info/gcl/allocate_002dinstance.html new file mode 100644 index 0000000..7a1e196 --- /dev/null +++ b/info/gcl/allocate_002dinstance.html @@ -0,0 +1,101 @@ + + + + + +allocate-instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.3 allocate-instance [Standard Generic Function]

    + +

    Syntax::

    + +

    allocate-instance class &rest initargs &key &allow-other-keys ⇒ new-instance +

    +

    Method Signatures::

    + +

    allocate-instance (class standard-class) &rest initargs +

    +

    allocate-instance (class structure-class) &rest initargs +

    +

    Arguments and Values::

    + +

    class—a class. +

    +

    initargs—a list of keyword/value pairs + (initialization argument names and values). +

    +

    new-instance—an object whose class is class. +

    +

    Description::

    + +

    The generic function allocate-instance creates and returns +a new instance of the class, without initializing it. +When the class is a standard class, this means that +the slots are unbound; when the class is a +structure class, this means the slots’ values +are unspecified. +

    +

    The caller of allocate-instance is expected to have +already checked the initialization arguments. +

    +

    The generic function allocate-instance is called by +make-instance, as described in +Object Creation and Initialization. +

    +

    See Also::

    + +

    defclass +, +make-instance +, +class-of +, +Object Creation and Initialization +

    +

    Notes::

    + +

    The consequences of adding methods to allocate-instance is unspecified. +This capability might be added by the Metaobject Protocol. +

    + + + + + diff --git a/info/gcl/alpha_002dchar_002dp.html b/info/gcl/alpha_002dchar_002dp.html new file mode 100644 index 0000000..87731c8 --- /dev/null +++ b/info/gcl/alpha_002dchar_002dp.html @@ -0,0 +1,92 @@ + + + + + +alpha-char-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.8 alpha-char-p [Function]

    + +

    alpha-char-p character ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if character is an alphabetic_1 character; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (alpha-char-p #\a) ⇒  true
+ (alpha-char-p #\5) ⇒  false
+ (alpha-char-p #\Newline) ⇒  false
+ ;; This next example presupposes an implementation
+ ;; in which #\\alpha is a defined character.
+ (alpha-char-p #\\alpha) ⇒  implementation-dependent
+
    + +

    Affected By::

    + +

    None. +(In particular, the results of this predicate are independent +of any special syntax which might have been enabled in the current readtable.) +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    +

    See Also::

    + +

    alphanumericp +, +Documentation of Implementation-Defined Scripts +

    + + + + + diff --git a/info/gcl/alphanumericp.html b/info/gcl/alphanumericp.html new file mode 100644 index 0000000..0056f0c --- /dev/null +++ b/info/gcl/alphanumericp.html @@ -0,0 +1,107 @@ + + + + + +alphanumericp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.9 alphanumericp [Function]

    + +

    alphanumericp character ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if character is an alphabetic_1 character + or a numeric character; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (alphanumericp #\Z) ⇒  true
+ (alphanumericp #\9) ⇒  true
+ (alphanumericp #\Newline) ⇒  false
+ (alphanumericp #\#) ⇒  false
+
    + +

    Affected By::

    + +

    None. +(In particular, the results of this predicate are independent +of any special syntax which might have been enabled in the current readtable.) +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    +

    See Also::

    + +

    alpha-char-p +, +graphic-char-p +, +digit-char-p +

    +

    Notes::

    + +

    Alphanumeric characters are graphic +as defined by graphic-char-p. +The alphanumeric characters are a subset of the graphic characters. +The standard characters A through Z, + a through z, + and 0 through 9 are alphanumeric characters. +

    +
    +
     (alphanumericp x)
+   ≡ (or (alpha-char-p x) (not (null (digit-char-p x))))
+
    + + + + + + diff --git a/info/gcl/and-_0028Type-Specifier_0029.html b/info/gcl/and-_0028Type-Specifier_0029.html new file mode 100644 index 0000000..691b97f --- /dev/null +++ b/info/gcl/and-_0028Type-Specifier_0029.html @@ -0,0 +1,74 @@ + + + + + +and (Type Specifier) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.20 and [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Combining. +

    +

    Compound Type Specifier Syntax::

    + +

    (and{{typespec}*}) +

    +

    Compound Type Specifier Arguments::

    + +

    typespec—a type specifier. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of all objects of the type +determined by the intersection of the typespecs. +

    +

    * is not permitted as an argument. +

    +

    The type specifiers (and) and t are equivalent. +The symbol and is not valid as a type specifier, +and, specifically, it is not an abbreviation for (and). +

    + + + + + diff --git a/info/gcl/and.html b/info/gcl/and.html new file mode 100644 index 0000000..b7b1995 --- /dev/null +++ b/info/gcl/and.html @@ -0,0 +1,122 @@ + + + + + +and (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.41 and [Macro]

    + +

    and {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    form—a form. +

    +

    results—the values resulting from the evaluation of + the last form, or the symbols nil or t. +

    +

    Description::

    + +

    The macro and evaluates each form one at a time from left to right. +As soon as any form evaluates to nil, and returns +nil without evaluating the remaining forms. If all forms +but the last evaluate to true values, and returns the results +produced by evaluating the last form. +

    +

    If no forms are supplied, (and) returns t. +

    +

    and passes back multiple values from the last subform +but not from subforms other than the last. +

    +

    Examples::

    + +
    +
     (if (and (>= n 0)
+          (< n (length a-simple-vector))
+          (eq (elt a-simple-vector n) 'foo))
+     (princ "Foo!"))
+
    + +

    The above expression prints Foo! if element n of a-simple-vector +is the symbol foo, provided also that n is indeed a valid index +for a-simple-vector. Because and guarantees +left-to-right testing +of its parts, elt is not called if n is out of range. +

    +
    +
     (setq temp1 1 temp2 1 temp3 1) ⇒  1 
+ (and (incf temp1) (incf temp2) (incf temp3)) ⇒  2 
+ (and (eql 2 temp1) (eql 2 temp2) (eql 2 temp3)) ⇒  true
+ (decf temp3) ⇒  1 
+ (and (decf temp1) (decf temp2) (eq temp3 'nil) (decf temp3)) ⇒  NIL 
+ (and (eql temp1 temp2) (eql temp2 temp3)) ⇒  true
+ (and) ⇒  T 
+
    + +

    See Also::

    + +

    cond +, +every +, +if +, +or +, +when +

    +

    Notes::

    + +
    +
     (and form) ≡ (let () form)
+ (and form1 form2 ...) ≡ (when form1 (and form2 ...))
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/append.html b/info/gcl/append.html new file mode 100644 index 0000000..2ab5210 --- /dev/null +++ b/info/gcl/append.html @@ -0,0 +1,91 @@ + + + + + +append (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.26 append [Function]

    + +

    append &rest lists ⇒ result +

    +

    Arguments and Values::

    + +

    list—each must be a proper list except the last, + which may be any object. +

    +

    result—an object. This will be a list + unless the last list was not a list + and all preceding lists were null. +

    +

    Description::

    + +

    append returns a new list that is the concatenation of +the copies. lists are left unchanged; the list structure +of each of lists except the last is copied. +The last argument is not copied; it becomes the cdr of the +final dotted pair of the concatenation of the preceding lists, +or is returned directly if there are no preceding +non-empty +lists. +

    +

    Examples::

    + +
    +
     (append '(a b c) '(d e f) '() '(g)) ⇒  (A B C D E F G)
+ (append '(a b c) 'd) ⇒  (A B C . D)
+ (setq lst '(a b c)) ⇒  (A B C)
+ (append lst '(d)) ⇒  (A B C D)
+ lst ⇒  (A B C)
+ (append) ⇒  NIL
+ (append 'a) ⇒  A
+
    + +

    See Also::

    + +

    nconc +, +concatenate +

    + + + + + diff --git a/info/gcl/apply.html b/info/gcl/apply.html new file mode 100644 index 0000000..754710d --- /dev/null +++ b/info/gcl/apply.html @@ -0,0 +1,120 @@ + + + + + +apply (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.1 apply [Function]

    + +

    apply function &rest args^+ ⇒ {result}* +

    +

    Arguments and Values::

    + +

    function—a function designator. +

    +

    args—a spreadable argument list designator. +

    +

    results—the values returned by function. +

    +

    Description::

    + +

    Applies the function to the args. +

    +

    When the function receives its arguments via &rest, it is +permissible (but not required) for the implementation to bind +the rest parameter +to an object that shares structure with the last argument to apply. +Because a function can neither detect whether it was called via apply +nor whether (if so) the last argument to apply was a constant, +conforming programs must neither rely on the list structure +of a rest list to be freshly consed, nor modify that list structure. +

    +

    setf can be used with apply in certain circumstances; +see APPLY Forms as Places. +

    +

    Examples::

    + +
    +
     (setq f '+) ⇒  +
+ (apply f '(1 2)) ⇒  3
+ (setq f #'-) ⇒  #<FUNCTION ->
+ (apply f '(1 2)) ⇒  -1
+ (apply #'max 3 5 '(2 7 3)) ⇒  7
+ (apply 'cons '((+ 2 3) 4)) ⇒  ((+ 2 3) . 4)
+ (apply #'+ '()) ⇒  0
+
+ (defparameter *some-list* '(a b c))
+ (defun strange-test (&rest x) (eq x *some-list*))
+ (apply #'strange-test *some-list*) ⇒  implementation-dependent
+
+ (defun bad-boy (&rest x) (rplacd x 'y))
+ (bad-boy 'a 'b 'c) has undefined consequences.
+ (apply #'bad-boy *some-list*) has undefined consequences.
+
    + +
    +
     (defun foo (size &rest keys &key double &allow-other-keys)
+   (let ((v (apply #'make-array size :allow-other-keys t keys)))
+     (if double (concatenate (type-of v) v v) v)))
+ (foo 4 :initial-contents '(a b c d) :double t)
+    ⇒  #(A B C D A B C D)
+
    + +

    See Also::

    + +

    funcall +, +fdefinition +, +function, +Evaluation, +APPLY Forms as Places +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/apropos.html b/info/gcl/apropos.html new file mode 100644 index 0000000..8368849 --- /dev/null +++ b/info/gcl/apropos.html @@ -0,0 +1,97 @@ + + + + + +apropos (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.5 apropos, apropos-list [Function]

    + +

    apropos string &optional package ⇒ <no values> +

    +

    apropos-list string &optional package ⇒ symbols +

    +

    Arguments and Values::

    + +

    string—a string designator. +

    +

    package—a package designator or nil. + The default is nil. +

    +

    symbols—a list of symbols. +

    +

    Description::

    + +

    These functions search for interned symbols +whose names contain the substring string. +

    +

    For apropos, as each such symbol is found, +its name is printed on standard output. +In addition, +if such a symbol is defined as a function or dynamic variable, +information about those definitions might also be printed. +

    +

    For apropos-list, +no output occurs as the search proceeds; +instead a list of the matching symbols is returned when the search is complete. +

    +

    If package is non-nil, +only the symbols accessible in that package are searched; +otherwise all symbols accessible in any package are searched. +

    +

    Because a symbol might be available +by way of more than one inheritance path, +apropos might print information about the same symbol more than once, +or apropos-list might return a list containing duplicate symbols. +

    +

    Whether or not the search is case-sensitive is implementation-defined. +

    +

    Affected By::

    + +

    The set of symbols which are currently interned +in any packages being searched. +

    +

    apropos is also affected by *standard-output*. +

    + + + + + diff --git a/info/gcl/aref.html b/info/gcl/aref.html new file mode 100644 index 0000000..23835f6 --- /dev/null +++ b/info/gcl/aref.html @@ -0,0 +1,112 @@ + + + + + +aref (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.10 aref [Accessor]

    + +

    aref array &rest subscripts ⇒ element +

    +

    (setf ( aref array &rest subscripts) new-element)
    +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    subscripts—a list of valid array indices for the array. +

    +

    element, new-element—an object. +

    +

    Description::

    + +

    Accesses the array element specified by the subscripts. +If no subscripts are supplied and array is zero rank, +aref accesses the sole element of array. +

    +

    aref ignores fill pointers. +It is permissible to use aref +to access any array element, +whether active or not. +

    +

    Examples::

    + +

    If the variable foo names a 3-by-5 array, +then the first index could be 0, 1, or 2, and then second index +could be 0, 1, 2, 3, or 4. The array elements can be referred to by using +the function aref; for example, (aref foo 2 1) +refers to element (2, 1) of the array. +

    +
    +
     (aref (setq alpha (make-array 4)) 3) ⇒  implementation-dependent
+ (setf (aref alpha 3) 'sirens) ⇒  SIRENS
+ (aref alpha 3) ⇒  SIRENS
+ (aref (setq beta (make-array '(2 4) 
+                    :element-type '(unsigned-byte 2)
+                    :initial-contents '((0 1 2 3) (3 2 1 0))))
+        1 2) ⇒  1
+ (setq gamma '(0 2))
+ (apply #'aref beta gamma) ⇒  2
+ (setf (apply #'aref beta gamma) 3) ⇒  3
+ (apply #'aref beta gamma) ⇒  3
+ (aref beta 0 2) ⇒  3
+
    + +

    See Also::

    + +

    bit (Array) +, +char +, +elt +, +row-major-aref +, +svref +, +

    +

    Compiler Terminology +

    + + + + + diff --git a/info/gcl/arithmetic_002derror.html b/info/gcl/arithmetic_002derror.html new file mode 100644 index 0000000..b953efe --- /dev/null +++ b/info/gcl/arithmetic_002derror.html @@ -0,0 +1,73 @@ + + + + + +arithmetic-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.78 arithmetic-error [Condition Type]

    + +

    Class Precedence List::

    +

    arithmetic-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type arithmetic-error consists of error conditions +that occur during arithmetic operations. +The operation and operands are initialized with +the initialization arguments named :operation and :operands to make-condition, +and are accessed by +the functions arithmetic-error-operation and +arithmetic-error-operands. +

    +

    See Also::

    + +

    arithmetic-error-operation, +arithmetic-error-operands +

    + + + + + diff --git a/info/gcl/arithmetic_002derror_002doperands.html b/info/gcl/arithmetic_002derror_002doperands.html new file mode 100644 index 0000000..1e3ee4f --- /dev/null +++ b/info/gcl/arithmetic_002derror_002doperands.html @@ -0,0 +1,79 @@ + + + + + +arithmetic-error-operands (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.79 arithmetic-error-operands, arithmetic-error-operation [Function]

    + +

    arithmetic-error-operands condition ⇒ operands +

    +

    arithmetic-error-operation condition ⇒ operation +

    +

    Arguments and Values::

    + +

    condition—a condition of type arithmetic-error. +

    +

    operands—a list. +

    +

    operation—a function designator. +

    +

    Description::

    + +

    arithmetic-error-operands returns a list of the operands +which were used in the offending call to the operation that signaled +the condition. +

    +

    arithmetic-error-operation returns a list of +the offending operation in the offending call that signaled the condition. +

    +

    See Also::

    + +

    arithmetic-error, +Conditions +

    +

    Notes::

    + + + + + + diff --git a/info/gcl/array.html b/info/gcl/array.html new file mode 100644 index 0000000..6daf80b --- /dev/null +++ b/info/gcl/array.html @@ -0,0 +1,157 @@ + + + + + +array (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.1 array [System Class]

    + +

    Class Precedence List::

    +

    array, +t +

    +

    Description::

    + +

    An array contains objects arranged according to a +Cartesian coordinate system. +An array provides mappings from a set of +

    +

    fixnums +

    +

    \left{i_0,i_1,\dots,i_{r-1}\right} to corresponding elements +of the array, +where 0 \le i_j < d_j, +r is the rank of the array, and d_j is the size of dimension j of +the array. +

    +

    When an array is created, the program requesting its creation may +declare that all elements are of a particular type, +called the expressed array element type. +The implementation is permitted to upgrade this type in order to +produce the actual array element type, +which is the element type for the array is actually specialized. +See the function upgraded-array-element-type. +

    +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (array{[{element-type | *} [dimension-spec]]}) +

    +

    dimension-spec ::=rank | * | ({dimension | *}*) +

    +

    Compound Type Specifier Arguments::

    + +

    dimension—a valid array dimension. +

    +

    element-type—a type specifier. +

    +

    rank—a non-negative fixnum. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of arrays whose + element type, rank, and dimensions +match any given + element-type, rank, and dimensions. +Specifically: +

    +

    If element-type is the symbol *, +arrays are not excluded on the basis of their element type. +Otherwise, only those arrays are included whose actual array element type +

    +

    is the result of upgrading element-type; +see Array Upgrading. +

    +

    If the dimension-spec is a rank, +the set includes only those arrays having that rank. +If the dimension-spec is a list of dimensions, +the set includes only those arrays having a rank +given by the length of the dimensions, +and having the indicated dimensions; +in this case, * matches any value for the corresponding dimension. +If the dimension-spec is the symbol *, +the set is not restricted on the basis of rank or dimension. +

    +

    See Also::

    + +

    *print-array*, +aref +, +make-array +, +vector, +Sharpsign A, +Printing Other Arrays +

    +

    Notes::

    + +

    Note that the type (array t) +is a proper subtype of the type (array *). +The reason is that the type (array t) is the set of arrays +that can +hold any object (the elements are of type t, which includes +all objects). +On the other hand, the type (array *) +is the set of all arrays whatsoever, including for example +arrays that can hold only characters. +The type (array character) +is not a subtype of the type (array t); +the two sets +are disjoint because the type (array character) is not the +set of all arrays that can hold +characters, but rather the set of +arrays +that are specialized to hold precisely characters and no +other objects. +

    +
    +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    + + + + + diff --git a/info/gcl/array_002ddimension.html b/info/gcl/array_002ddimension.html new file mode 100644 index 0000000..207b444 --- /dev/null +++ b/info/gcl/array_002ddimension.html @@ -0,0 +1,89 @@ + + + + + +array-dimension (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.11 array-dimension [Function]

    + +

    array-dimension array axis-number ⇒ dimension +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    axis-number—an integer greater than or equal to zero + and less than the rank of the array. +

    +

    dimension—a non-negative integer. +

    +

    Description::

    + +

    array-dimension returns the axis-number +dimension_1 of array. +(Any fill pointer is ignored.) +

    +

    Examples::

    + +
    +
     (array-dimension (make-array 4) 0) ⇒  4
+ (array-dimension (make-array '(2 3)) 1) ⇒  3
+
    + +

    Affected By::

    +

    None. +

    +

    See Also::

    + +

    array-dimensions +, +length +

    +

    Notes::

    +
    +
     (array-dimension array n) ≡ (nth n (array-dimensions array))
+
    + + + + + + diff --git a/info/gcl/array_002ddimension_002dlimit.html b/info/gcl/array_002ddimension_002dlimit.html new file mode 100644 index 0000000..a615b86 --- /dev/null +++ b/info/gcl/array_002ddimension_002dlimit.html @@ -0,0 +1,68 @@ + + + + + +array-dimension-limit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.24 array-dimension-limit [Constant Variable]

    + +

    Constant Value::

    + +

    A positive +

    +

    fixnum, +

    +

    the exact magnitude of which is implementation-dependent, +but which is not less than 1024. +

    +

    Description::

    + +

    The upper exclusive bound on each individual dimension of an array. +

    +

    See Also::

    + +

    make-array +

    + + + + + diff --git a/info/gcl/array_002ddimensions.html b/info/gcl/array_002ddimensions.html new file mode 100644 index 0000000..d78e93b --- /dev/null +++ b/info/gcl/array_002ddimensions.html @@ -0,0 +1,81 @@ + + + + + +array-dimensions (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.12 array-dimensions [Function]

    + +

    array-dimensions array ⇒ dimensions +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    dimensions—a list of integers. +

    +

    Description::

    + +

    Returns a list of the dimensions of array. +(If array is a vector with a fill pointer, + that fill pointer is ignored.) +

    +

    Examples::

    + +
    +
     (array-dimensions (make-array 4)) ⇒  (4)
+ (array-dimensions (make-array '(2 3))) ⇒  (2 3)
+ (array-dimensions (make-array 4 :fill-pointer 2)) ⇒  (4)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if its argument is not an array. +

    +

    See Also::

    + +

    array-dimension +

    + + + + + diff --git a/info/gcl/array_002ddisplacement.html b/info/gcl/array_002ddisplacement.html new file mode 100644 index 0000000..b51b00a --- /dev/null +++ b/info/gcl/array_002ddisplacement.html @@ -0,0 +1,103 @@ + + + + + +array-displacement (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.15 array-displacement [Function]

    + +

    array-displacement array ⇒ displaced-to, displaced-index-offset +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    displaced-to—an array or nil. +

    +

    displaced-index-offset—a non-negative fixnum. +

    +

    Description::

    + +

    If the array is a displaced array, +returns the values of the :displaced-to and :displaced-index-offset +options +for the array (see the functions make-array and adjust-array). +If the array is not a displaced array, +nil and 0 are returned. +

    +

    If array-displacement is called on an array +for which a non-nil object was provided as the +:displaced-to argument to make-array +or adjust-array, it must return that object +as its first value. It is implementation-dependent +whether array-displacement returns a non-nil +primary value for any other array. +

    +

    Examples::

    + +
    +
     (setq a1 (make-array 5)) ⇒  #<ARRAY 5 simple 46115576>
+ (setq a2 (make-array 4 :displaced-to a1
+                        :displaced-index-offset 1))
+⇒  #<ARRAY 4 indirect 46117134>
+ (array-displacement a2)
+⇒  #<ARRAY 5 simple 46115576>, 1
+ (setq a3 (make-array 2 :displaced-to a2
+                        :displaced-index-offset 2))
+⇒  #<ARRAY 2 indirect 46122527>
+ (array-displacement a3)
+⇒  #<ARRAY 4 indirect 46117134>, 2
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if array is not an array. +

    +

    See Also::

    + +

    make-array +

    + + + + + diff --git a/info/gcl/array_002delement_002dtype.html b/info/gcl/array_002delement_002dtype.html new file mode 100644 index 0000000..83b3924 --- /dev/null +++ b/info/gcl/array_002delement_002dtype.html @@ -0,0 +1,101 @@ + + + + + +array-element-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.13 array-element-type [Function]

    + +

    array-element-type array ⇒ typespec +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    typespec—a type specifier. +

    +

    Description::

    + +

    Returns a type specifier which represents the actual array element type +of the array, which is the set of objects that such an array can hold. +(Because of array upgrading, this type specifier can in +some cases denote a supertype of the expressed array element type +of the array.) +

    +

    Examples::

    + +
    +
     (array-element-type (make-array 4)) ⇒  T
+ (array-element-type (make-array 12 :element-type '(unsigned-byte 8))) 
+⇒  implementation-dependent
+ (array-element-type (make-array 12 :element-type '(unsigned-byte 5)))
+⇒  implementation-dependent
+
    + +
    +
     (array-element-type (make-array 5 :element-type '(mod 5)))
+
    + +

    could be (mod 5), (mod 8), fixnum, t, or any other +type of which (mod 5) is a subtype. +

    +

    Affected By::

    + +

    The implementation. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if its argument is not an array. +

    +

    See Also::

    + +

    array, +make-array +, +subtypep +, +upgraded-array-element-type +

    + + + + + diff --git a/info/gcl/array_002dhas_002dfill_002dpointer_002dp.html b/info/gcl/array_002dhas_002dfill_002dpointer_002dp.html new file mode 100644 index 0000000..8edbe4b --- /dev/null +++ b/info/gcl/array_002dhas_002dfill_002dpointer_002dp.html @@ -0,0 +1,91 @@ + + + + + +array-has-fill-pointer-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.14 array-has-fill-pointer-p [Function]

    + +

    array-has-fill-pointer-p array ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if array has a fill pointer; +otherwise returns false. +

    +

    Examples::

    + +
    +
     (array-has-fill-pointer-p (make-array 4)) ⇒  implementation-dependent
+ (array-has-fill-pointer-p (make-array '(2 3))) ⇒  false
+ (array-has-fill-pointer-p
+   (make-array 8 
+               :fill-pointer 2 
+               :initial-element 'filler)) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if its argument is not an array. +

    +

    See Also::

    + +

    make-array +, +fill-pointer +

    +

    Notes::

    + +

    Since arrays of rank other than one cannot have a fill pointer, +array-has-fill-pointer-p always returns nil when its argument +is such an array. +

    + + + + + diff --git a/info/gcl/array_002din_002dbounds_002dp.html b/info/gcl/array_002din_002dbounds_002dp.html new file mode 100644 index 0000000..93f65ba --- /dev/null +++ b/info/gcl/array_002din_002dbounds_002dp.html @@ -0,0 +1,90 @@ + + + + + +array-in-bounds-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.16 array-in-bounds-p [Function]

    + +

    array-in-bounds-p array &rest subscripts ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    subscripts—a list of integers + of length equal to the rank of the array. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if the subscripts are all in bounds for array; +otherwise returns false. +(If array is a vector with a fill pointer, + that fill pointer is ignored.) +

    +

    Examples::

    +
    +
     (setq a (make-array '(7 11) :element-type 'string-char))
+ (array-in-bounds-p a 0  0) ⇒  true
+ (array-in-bounds-p a 6 10) ⇒  true
+ (array-in-bounds-p a 0 -1) ⇒  false
+ (array-in-bounds-p a 0 11) ⇒  false
+ (array-in-bounds-p a 7  0) ⇒  false
+
    + +

    See Also::

    + +

    array-dimensions +

    +

    Notes::

    +
    +
     (array-in-bounds-p array subscripts)   
+ ≡ (and (not (some #'minusp (list subscripts)))
+         (every #'< (list subscripts) (array-dimensions array)))
+
    + + + + + + diff --git a/info/gcl/array_002drank.html b/info/gcl/array_002drank.html new file mode 100644 index 0000000..108feaa --- /dev/null +++ b/info/gcl/array_002drank.html @@ -0,0 +1,82 @@ + + + + + +array-rank (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.17 array-rank [Function]

    + +

    array-rank array ⇒ rank +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    rank—a non-negative integer. +

    +

    Description::

    + +

    Returns the number of dimensions of array. +

    +

    Examples::

    + +
    +
     (array-rank (make-array '())) ⇒  0
+ (array-rank (make-array 4)) ⇒  1
+ (array-rank (make-array '(4))) ⇒  1
+ (array-rank (make-array '(2 3))) ⇒  2
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if its argument is not an array. +

    +

    See Also::

    + +

    array-rank-limit +, +make-array +

    + + + + + diff --git a/info/gcl/array_002drank_002dlimit.html b/info/gcl/array_002drank_002dlimit.html new file mode 100644 index 0000000..6109d69 --- /dev/null +++ b/info/gcl/array_002drank_002dlimit.html @@ -0,0 +1,68 @@ + + + + + +array-rank-limit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.25 array-rank-limit [Constant Variable]

    + +

    Constant Value::

    + +

    A positive +

    +

    fixnum, +

    +

    the exact magnitude of which is implementation-dependent, +but which is not less than 8. +

    +

    Description::

    + +

    The upper exclusive bound on the rank of an array. +

    +

    See Also::

    + +

    make-array +

    + + + + + diff --git a/info/gcl/array_002drow_002dmajor_002dindex.html b/info/gcl/array_002drow_002dmajor_002dindex.html new file mode 100644 index 0000000..eab89cc --- /dev/null +++ b/info/gcl/array_002drow_002dmajor_002dindex.html @@ -0,0 +1,99 @@ + + + + + +array-row-major-index (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.18 array-row-major-index [Function]

    + +

    array-row-major-index array &rest subscripts ⇒ index +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    subscripts—a list of valid array indices for the array. +

    +

    index—a valid array row-major index for the array. +

    +

    Description::

    + +

    Computes the position according to the row-major ordering of array +for the element that is specified by subscripts, and returns the +offset of the element in the computed position from the beginning of array. +

    +

    For a one-dimensional array, +the result of array-row-major-index +equals subscript. +

    +

    array-row-major-index ignores fill pointers. +

    +

    Examples::

    + +
    +
     (setq a (make-array '(4 7) :element-type '(unsigned-byte 8)))
+ (array-row-major-index a 1 2) ⇒  9
+ (array-row-major-index 
+    (make-array '(2 3 4) 
+                :element-type '(unsigned-byte 8)
+                :displaced-to a
+                :displaced-index-offset 4)
+    0 2 1) ⇒  9
+
    + +

    Notes::

    + +

    A possible definition of array-row-major-index, +with no error-checking, is +

    +
    +
     (defun array-row-major-index (a &rest subscripts)
+   (apply #'+ (maplist #'(lambda (x y)
+                            (* (car x) (apply #'* (cdr y))))
+                       subscripts
+                       (array-dimensions a))))
+
    + + + + + + diff --git a/info/gcl/array_002dtotal_002dsize.html b/info/gcl/array_002dtotal_002dsize.html new file mode 100644 index 0000000..b3ed2b4 --- /dev/null +++ b/info/gcl/array_002dtotal_002dsize.html @@ -0,0 +1,98 @@ + + + + + +array-total-size (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.19 array-total-size [Function]

    + +

    array-total-size array ⇒ size +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    size—a non-negative integer. +

    +

    Description::

    + +

    Returns the array total size of the array. +

    +

    Examples::

    + +
    +
     (array-total-size (make-array 4)) ⇒  4
+ (array-total-size (make-array 4 :fill-pointer 2)) ⇒  4
+ (array-total-size (make-array 0)) ⇒  0
+ (array-total-size (make-array '(4 2))) ⇒  8
+ (array-total-size (make-array '(4 0))) ⇒  0
+ (array-total-size (make-array '())) ⇒  1
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if its argument is not an array. +

    +

    See Also::

    + +

    make-array +, +array-dimensions +

    +

    Notes::

    + +

    If the array is a vector with a fill pointer, +the fill pointer is ignored when calculating the array total size. +

    +

    Since the product of no arguments is one, the array total size of a +zero-dimensional array is one. +

    +
    +
     (array-total-size x)
+    ≡ (apply #'* (array-dimensions x))
+    ≡ (reduce #'* (array-dimensions x))
+
    + + + + + + diff --git a/info/gcl/array_002dtotal_002dsize_002dlimit.html b/info/gcl/array_002dtotal_002dsize_002dlimit.html new file mode 100644 index 0000000..373c085 --- /dev/null +++ b/info/gcl/array_002dtotal_002dsize_002dlimit.html @@ -0,0 +1,76 @@ + + + + + +array-total-size-limit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.26 array-total-size-limit [Constant Variable]

    + +

    Constant Value::

    + +

    A positive +

    +

    fixnum, +

    +

    the exact magnitude of which is implementation-dependent, +but which is not less than 1024. +

    +

    Description::

    + +

    The upper exclusive bound on the array total size of an array. +

    +

    The actual limit on the array total size +imposed by the implementation +might vary according the element type of the array; +in this case, the value of array-total-size-limit +will be the smallest of these possible limits. +

    +

    See Also::

    + +

    make-array +, +array-element-type +

    + + + + + diff --git a/info/gcl/arrayp.html b/info/gcl/arrayp.html new file mode 100644 index 0000000..531cbfb --- /dev/null +++ b/info/gcl/arrayp.html @@ -0,0 +1,85 @@ + + + + + +arrayp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.20 arrayp [Function]

    + +

    arrayp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type array; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (arrayp (make-array '(2 3 4) :adjustable t)) ⇒  true
+ (arrayp (make-array 6)) ⇒  true
+ (arrayp #*1011) ⇒  true
+ (arrayp "hi") ⇒  true
+ (arrayp 'hi) ⇒  false
+ (arrayp 12) ⇒  false
+
    + +

    See Also::

    + +

    typep +

    +

    Notes::

    + +
    +
     (arrayp object) ≡ (typep object 'array)
+
    + + + + + + diff --git a/info/gcl/ash.html b/info/gcl/ash.html new file mode 100644 index 0000000..b33f5dc --- /dev/null +++ b/info/gcl/ash.html @@ -0,0 +1,105 @@ + + + + + +ash (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.56 ash [Function]

    + +

    ash integer count ⇒ shifted-integer +

    +

    Arguments and Values::

    + +

    integer—an integer. +

    +

    count—an integer. +

    +

    shifted-integer—an integer. +

    +

    Description::

    + +

    ash performs the arithmetic shift operation on the binary +representation of integer, which is treated as if it were binary. +

    +

    ash shifts integer arithmetically left by count bit +positions if count is positive, +or right count bit positions if count is negative. +The shifted value of the same sign +as integer is returned. +

    +

    Mathematically speaking, ash performs the computation +floor(integer\cdot 2^count). +Logically, ash +moves all of the bits in integer to the left, +adding zero-bits at the right, or moves them to the right, +discarding bits. +

    +

    ash is defined to behave as if integer were +represented in two’s complement form, regardless of +how integers are represented internally. +

    Examples::

    +
    +
     (ash 16 1) ⇒  32
+ (ash 16 0) ⇒  16
+ (ash 16 -1) ⇒  8
+ (ash -100000000000000000000000000000000 -100) ⇒  -79
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if integer is not an integer. +Should signal an error of type type-error + if count is not an integer. +Might signal arithmetic-error. +

    +

    Notes::

    + +
    +
     (logbitp j (ash n k))
+ ≡ (and (>= j k) (logbitp (- j k) n))
+
    + + + + + + diff --git a/info/gcl/asin.html b/info/gcl/asin.html new file mode 100644 index 0000000..22dfba8 --- /dev/null +++ b/info/gcl/asin.html @@ -0,0 +1,247 @@ + + + + + +asin (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.21 asin, acos, atan [Function]

    + +

    asin number ⇒ radians +

    +

    acos number ⇒ radians +

    +

    atan number1 &optional number2 ⇒ radians +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    number1—a number if number2 is not supplied, + or a real if number2 is supplied. +

    +

    number2—a real. +

    +

    radians—a number (of radians). +

    +

    Description::

    + +

    asin, acos, and atan +compute the arc sine, arc cosine, and arc tangent respectively. +

    +

    The arc sine, arc cosine, and arc tangent (with only number1 supplied) +functions can be defined mathematically for +number or number1 specified as x as in Figure 12–13. +

    +
    +
      Function     Definition                            
+  Arc sine      -i log  (ix+ \sqrt1-x^2 )          
+  Arc cosine    (\pi/2) - arcsin  x                  
+  Arc tangent   -i log  ((1+ix) \sqrt1/(1+x^2) )   
+
+  Figure 12–13: Mathematical definition of arc sine, arc cosine, and arc tangent
+
+
    + +

    These formulae are mathematically correct, assuming +completely accurate computation. They are not necessarily +the simplest ones for real-valued computations. +

    +

    If both number1 and number2 are supplied +for atan, the result is the arc tangent +of number1/number2. +The value of atan is always between +-\pi (exclusive) and~\pi (inclusive) +

    +

    when minus zero is not supported. +The range of the two-argument arc tangent when minus zero is supported +includes -\pi. +

    +

    For a +

    +

    real +

    +

    number1, +the result is +

    +

    a real +

    +

    and lies between +-\pi/2 and~\pi/2 (both exclusive). +number1 can be a complex if number2 +is not supplied. If both are supplied, number2 can be zero provided +number1 is not zero. +

    +

    [Reviewer Note by Barmar: Should add “However, if the implementation distinguishes + positive and negative zero, both may be signed zeros, + and limits are used to define the result.”] +

    +

    The following definition for arc sine determines the range and +branch cuts: +

    +
    arcsin z = -i log (iz+\sqrt1-z^2\Bigr) +
    +

    The branch cut for the arc sine function is in two pieces: +one along the negative real axis to the left of~-1 +(inclusive), continuous with quadrant II, and one along the positive real +axis to the right of~1 (inclusive), continuous with quadrant IV. The +range is that strip of the complex plane containing numbers whose real +part is between -\pi/2 and~\pi/2. A number with real +part equal to -\pi/2 is in the range if and only if its imaginary +part is non-negative; a number with real part equal to \pi/2 is in +the range if and only if its imaginary part is non-positive. +

    +

    The following definition for arc cosine determines the range and +branch cuts: +

    +
    arccos z = \pi\over2 - arcsin z +
    +

    or, which are equivalent, +

    +
    arccos z = -i log (z+i \sqrt1-z^2\Bigr) +
    +
    arccos z = 2 log (\sqrt(1+z)/2 + i \sqrt(1-z)/2)\overi +
    +

    The branch cut for the arc cosine function is in two pieces: +one along the negative real axis to the left of~-1 +(inclusive), continuous with quadrant II, and one along the positive real +axis to the right of~1 (inclusive), continuous with quadrant IV. +This is the same branch cut as for arc sine. +The range is that strip of the complex plane containing numbers whose real +part is between 0 and~\pi. A number with real +part equal to 0 is in the range if and only if its imaginary +part is non-negative; a number with real part equal to \pi is in +the range if and only if its imaginary part is non-positive. +

    +

    The following definition for (one-argument) arc tangent determines the +range and branch cuts: +

    +
    arctan z = log (1+iz) - log (1-iz)\over2i +
    +

    Beware of simplifying this formula; “obvious” simplifications are likely +to alter the branch cuts or the values on the branch cuts incorrectly. +The branch cut for the arc tangent function is in two pieces: +one along the positive imaginary axis above i +(exclusive), continuous with quadrant II, and one along the negative imaginary +axis below -i (exclusive), continuous with quadrant IV. +The points i and~-i are excluded from the domain. +The range is that strip of the complex plane containing numbers whose real +part is between -\pi/2 and~\pi/2. A number with real +part equal to -\pi/2 is in the range if and only if its imaginary +part is strictly positive; a number with real part equal to \pi/2 is in +the range if and only if its imaginary part is strictly negative. Thus the range of +arc tangent is identical to that of arc sine with the points +-\pi/2 and~\pi/2 excluded. +

    +

    For atan, +the signs of number1 (indicated as x) +and number2 (indicated as y) are used to derive quadrant +information. Figure 12–14 details various special cases. +

    +

    The asterisk (*) indicates that the entry in the figure applies to +implementations that support minus zero. +

    +
    +
       to 1pcy Condition  x Condition  Cartesian locus  Range of result          
+   to 1pc y = 0        x > 0       Positive x-axis   0                       
+   to 1pc* y = +0      x > 0       Positive x-axis  +0                       
+   to 1pc* y = -0      x > 0       Positive x-axis  -0                       
+   to 1pc y > 0        x > 0       Quadrant I       0 < result < \pi/2      
+   to 1pc y > 0        x = 0       Positive y-axis  \pi/2                    
+   to 1pc y > 0        x < 0       Quadrant II      \pi/2 < result < \pi    
+   to 1pc y = 0        x < 0       Negative x-axis   \pi                     
+   to 1pc* y = +0      x < 0       Negative x-axis  +\pi                     
+   to 1pc* y = -0      x < 0       Negative x-axis  -\pi                     
+   to 1pc y < 0        x < 0       Quadrant III     -\pi < result < -\pi/2  
+   to 1pc y < 0        x = 0       Negative y-axis  -\pi/2                   
+   to 1pc y < 0        x > 0       Quadrant IV      -\pi/2 < result < 0     
+   to 1pc y = 0        x = 0       Origin           undefined consequences   
+   to 1pc* y = +0      x = +0      Origin           +0                       
+   to 1pc* y = -0      x = +0      Origin           -0                       
+   to 1pc* y = +0      x = -0      Origin           +\pi                     
+   to 1pc* y = -0      x = -0      Origin           -\pi                     
+
+               Figure 12–14: Quadrant information for arc tangent             
+
+
    + +

    Examples::

    + +
    +
     (asin 0) ⇒  0.0 
+ (acos #c(0 1))  ⇒  #C(1.5707963267948966 -0.8813735870195432)
+ (/ (atan 1 (sqrt 3)) 6)  ⇒  0.087266 
+ (atan #c(0 2)) ⇒  #C(-1.5707964 0.54930615)
+
    + +

    Exceptional Situations::

    + +

    acos and asin should signal an error of type type-error + if number is not a number. +atan should signal type-error if + one argument is supplied and that argument is not a number, + or if two arguments are supplied and both of those arguments are not reals. +

    +

    acos, asin, and atan might signal arithmetic-error. +

    +

    See Also::

    + +

    log +, +sqrt +, +Rule of Float Substitutability +

    +

    Notes::

    + +

    The result of either asin or acos can be a complex +even if number is not a complex; this occurs when the +absolute value of number is greater than one. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/assert.html b/info/gcl/assert.html new file mode 100644 index 0000000..807da6d --- /dev/null +++ b/info/gcl/assert.html @@ -0,0 +1,173 @@ + + + + + +assert (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.10 assert [Macro]

    + +

    assert test-form [({place}*) + [datum-form + {argument-form}*]]
    + ⇒ nil +

    +

    Arguments and Values::

    + +

    test-form—a form; always evaluated. +

    +

    place—a place; evaluated if an error is signaled. +

    +

    datum-form—a form that evaluates to a datum. + Evaluated each time an error is to be signaled, + or not at all if no error is to be signaled. +

    +

    argument-form—a form that evaluates to an argument. + Evaluated each time an error is to be signaled, + or not at all if no error is to be signaled. +

    +

    datum, arguments—designators for a condition + of default type error. (These designators are the + result of evaluating datum-form and each of the argument-forms.) +

    +

    Description::

    + +

    assert assures that test-form evaluates to true. +If test-form evaluates to false, assert signals a +correctable error (denoted by datum and arguments). +Continuing from this error using the continue restart makes it possible +for the user to alter the values of the places before +assert evaluates test-form again. +If the value of test-form is non-nil, +assert returns nil. +

    +

    The places are generalized references to data +upon which test-form depends, +whose values can be changed by the user in attempting to correct the error. +Subforms of each place are only evaluated if an error is signaled, +and might be re-evaluated if the error is re-signaled (after continuing without +actually fixing the problem). +

    +

    The order of evaluation of the places is not specified; +see Evaluation of Subforms to Places. + +

    + + +

    If a place form is supplied that produces more values than there +are store variables, the extra values are ignored. If the supplied +form produces fewer values than there are store variables, +the missing values are set to nil. +

    +

    Examples::

    +
    +
     (setq x (make-array '(3 5) :initial-element 3))
+⇒  #2A((3 3 3 3 3) (3 3 3 3 3) (3 3 3 3 3))
+ (setq y (make-array '(3 5) :initial-element 7))
+⇒  #2A((7 7 7 7 7) (7 7 7 7 7) (7 7 7 7 7))
+ (defun matrix-multiply (a b)
+   (let ((*print-array* nil))
+     (assert (and (= (array-rank a) (array-rank b) 2)
+                  (= (array-dimension a 1) (array-dimension b 0)))
+             (a b)
+             "Cannot multiply ~S by ~S." a b)
+            (really-matrix-multiply a b))) ⇒  MATRIX-MULTIPLY
+ (matrix-multiply x y)
+ |>  Correctable error in MATRIX-MULTIPLY: 
+ |>  Cannot multiply #<ARRAY ...> by #<ARRAY ...>.
+ |>  Restart options:
+ |>   1: You will be prompted for one or more new values.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+ |>  Value for A: |>>x<<|
+ |>  Value for B: |>>(make-array '(5 3) :initial-element 6)<<|
+⇒  #2A((54 54 54 54 54)
+       (54 54 54 54 54)
+       (54 54 54 54 54)
+       (54 54 54 54 54)
+       (54 54 54 54 54))
+
    + +
    +
     (defun double-safely (x) (assert (numberp x) (x)) (+ x x))
+ (double-safely 4) 
+⇒  8
+
+ (double-safely t)
+ |>  Correctable error in DOUBLE-SAFELY: The value of (NUMBERP X) must be non-NIL.
+ |>  Restart options:
+ |>   1: You will be prompted for one or more new values.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+ |>  Value for X: |>>7<<|
+⇒  14
+
    + +

    Affected By::

    + +

    *break-on-signals* +

    +

    The set of active condition handlers. +

    +

    See Also::

    + +

    check-type +, +error +, Generalized Reference +

    +

    Notes::

    + +

    The debugger need not include the test-form in the error message, +and the places should not be included in the message, but they +should be made available for the user’s perusal. If the user gives the +“continue” command, the values of any of the references can be altered. +The details of this depend on the implementation’s style of user interface. +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/assoc.html b/info/gcl/assoc.html new file mode 100644 index 0000000..ebf05ff --- /dev/null +++ b/info/gcl/assoc.html @@ -0,0 +1,168 @@ + + + + + +assoc (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.36 assoc, assoc-if, assoc-if-not [Function]

    + +

    assoc item alist &key key test test-not ⇒ entry +

    +

    assoc-if predicate alist &key key ⇒ entry +

    +

    assoc-if-not predicate alist &key key ⇒ entry +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    alist—an association list. +

    +

    predicate—a designator for + a function of one argument + that returns a generalized boolean. +

    +

    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. +

    +

    entry—a cons that is an element of alist, + or nil. +

    +

    Description::

    + +

    assoc, assoc-if, and assoc-if-not +return the first cons in alist whose car satisfies the test, +or nil if no such cons is found. +

    +

    For assoc, assoc-if, and assoc-if-not, if nil appears +in alist in place of a pair, it is ignored. +

    +

    Examples::

    + +
    +
     (setq values '((x . 100) (y . 200) (z . 50))) ⇒  ((X . 100) (Y . 200) (Z . 50))
+ (assoc 'y values) ⇒  (Y . 200)
+ (rplacd (assoc 'y values) 201) ⇒  (Y . 201)
+ (assoc 'y values) ⇒  (Y . 201)
+ (setq alist '((1 . "one")(2 . "two")(3 . "three"))) 
+⇒  ((1 . "one") (2 . "two") (3 . "three"))
+ (assoc 2 alist) ⇒  (2 . "two")
+ (assoc-if #'evenp alist) ⇒  (2 . "two")
+ (assoc-if-not #'(lambda(x) (< x 3)) alist) ⇒  (3 . "three")
+ (setq alist '(("one" . 1)("two" . 2))) ⇒  (("one" . 1) ("two" . 2))
+ (assoc "one" alist) ⇒  NIL
+ (assoc "one" alist :test #'equalp) ⇒  ("one" . 1)
+ (assoc "two" alist :key #'(lambda(x) (char x 2))) ⇒  NIL 
+ (assoc #\o alist :key #'(lambda(x) (char x 2))) ⇒  ("two" . 2)
+ (assoc 'r '((a . b) (c . d) (r . x) (s . y) (r . z))) ⇒   (R . X)
+ (assoc 'goo '((foo . bar) (zoo . goo))) ⇒  NIL
+ (assoc '2 '((1 a b c) (2 b c d) (-7 x y z))) ⇒  (2 B C D)
+ (setq alist '(("one" . 1) ("2" . 2) ("three" . 3)))
+⇒  (("one" . 1) ("2" . 2) ("three" . 3))
+ (assoc-if-not #'alpha-char-p alist
+               :key #'(lambda (x) (char x 0))) ⇒  ("2" . 2)
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if alist is not an association list. +

    +

    See Also::

    + +

    rassoc +, +find +, +member (Function) +, +position +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    The function assoc-if-not is deprecated. +

    +

    It is possible to rplacd the result of assoc, provided +that it is not nil, +in order to “update” alist. +

    +

    The two expressions +

    +
    +
     (assoc item list :test fn)
+
    + +

    and +

    +
    +
     (find item list :test fn :key #'car)
+
    + +

    are equivalent in meaning with one exception: +if nil appears in alist in place of a pair, +and item is nil, +find will compute the car of the nil in alist, +find that it is equal to item, and return nil, +whereas assoc will ignore the nil in alist and continue +to search for an actual cons whose car is nil. +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/atom-_0028Type_0029.html b/info/gcl/atom-_0028Type_0029.html new file mode 100644 index 0000000..7bebbb2 --- /dev/null +++ b/info/gcl/atom-_0028Type_0029.html @@ -0,0 +1,60 @@ + + + + + +atom (Type) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.4 atom [Type]

    + +

    Supertypes::

    + +

    atom, +t +

    +

    Description::

    + +

    It is equivalent to (not cons). +

    + + + + + diff --git a/info/gcl/atom.html b/info/gcl/atom.html new file mode 100644 index 0000000..4f8c700 --- /dev/null +++ b/info/gcl/atom.html @@ -0,0 +1,80 @@ + + + + + +atom (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.7 atom [Function]

    + +

    atom object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type atom; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (atom 'sss) ⇒  true
+ (atom (cons 1 2)) ⇒  false
+ (atom nil) ⇒  true
+ (atom '()) ⇒  true
+ (atom 3) ⇒  true
+
    + +

    Notes::

    + +
    +
     (atom object) ≡ (typep object 'atom) ≡ (not (consp object))
+ ≡ (not (typep object 'cons)) ≡ (typep object '(not cons))
+
    + + + + + + diff --git a/info/gcl/base_002dchar.html b/info/gcl/base_002dchar.html new file mode 100644 index 0000000..d59c347 --- /dev/null +++ b/info/gcl/base_002dchar.html @@ -0,0 +1,112 @@ + + + + + +base-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.2 base-char [Type]

    + +

    Supertypes::

    + +

    base-char, +character, +t +

    +

    Description::

    + +

    The type base-char is defined as the upgraded array element type +of standard-char. +An implementation can support additional subtypes of type character +(besides the ones listed in this standard) +that might or might not be supertypes of type base-char. +In addition, an implementation can define base-char +to be the same type as character. +

    +

    Base characters are distinguished in the following respects: +

    +
    1.
    +

    The type standard-char is a subrepertoire of the type base-char. +

    +
    2.
    +

    The selection of base characters that are not standard characters + is implementation defined. +

    +
    3.
    +

    Only objects of the type base-char can be + elements of a base string. +

    +
    4.
    +

    No upper bound is specified for the number of characters in the +base-char repertoire; the size of that repertoire +is +implementation-defined. +The lower bound is~96, the number of standard characters. +

    +
    + +

    Whether a character is a base character depends on the way +that an implementation represents strings, +and not any other properties of the implementation or the host operating system. +For example, one implementation might encode all strings +as characters having 16-bit encodings, and another might have +two kinds of strings: those with characters having 8-bit +encodings and those with characters having 16-bit encodings. In the +first implementation, the type base-char is equivalent to +the type character: there is only one kind of string. +In the second implementation, the base characters might be +those characters that could be stored in a string of characters +having 8-bit encodings. In such an implementation, +the type base-char is a proper subtype of the type character. +

    +

    The type standard-char is a +

    +

    subtype of type base-char. +

    +
    +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    + + + + + diff --git a/info/gcl/base_002dstring.html b/info/gcl/base_002dstring.html new file mode 100644 index 0000000..302582e --- /dev/null +++ b/info/gcl/base_002dstring.html @@ -0,0 +1,87 @@ + + + + + +base-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.2 base-string [Type]

    + +

    Supertypes::

    + +

    base-string, +string, +vector, +array, +sequence, +t +

    +

    Description::

    + +

    The type base-string is equivalent to +

    +

    (vector base-char). +

    +

    The base string representation is the most efficient string representation +that can hold an arbitrary sequence of standard characters. +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (base-string{[size]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum, + or the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This is equivalent to the type (vector base-char size); +that is, the set of base strings of size size. +

    + + + + + diff --git a/info/gcl/bignum.html b/info/gcl/bignum.html new file mode 100644 index 0000000..6e85c76 --- /dev/null +++ b/info/gcl/bignum.html @@ -0,0 +1,66 @@ + + + + + +bignum (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.14 bignum [Type]

    + +

    Supertypes::

    + +

    bignum, +integer, +rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    The type bignum is defined to be exactly (and integer (not fixnum)). +

    + + + + + diff --git a/info/gcl/bit-_0028Array_0029.html b/info/gcl/bit-_0028Array_0029.html new file mode 100644 index 0000000..2c607ab --- /dev/null +++ b/info/gcl/bit-_0028Array_0029.html @@ -0,0 +1,104 @@ + + + + + +bit (Array) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.33 bit, sbit [Accessor]

    + +

    bit bit-array &rest subscripts ⇒ bit +

    +

    sbit bit-array &rest subscripts ⇒ bit +

    +

    (setf (bit bit-array &rest subscripts) new-bit)
    (setf (sbit bit-array &rest subscripts) new-bit)
    +

    +

    Arguments and Values::

    + +

    bit-array—for bit, a bit array; + for sbit, a simple bit array. +

    +

    subscripts—a list of valid array indices + for the bit-array. +

    +

    bit—a bit. +

    +

    Description::

    + +

    bit and sbit access the bit-array +element specified by subscripts. +

    +

    These functions ignore the fill pointer when accessing elements. +

    +

    Examples::

    + +
    +
     (bit (setq ba (make-array 8 
+                            :element-type 'bit 
+                            :initial-element 1))
+       3) ⇒  1
+ (setf (bit ba 3) 0) ⇒  0
+ (bit ba 3) ⇒  0
+ (sbit ba 5) ⇒  1
+ (setf (sbit ba 5) 1) ⇒  1
+ (sbit ba 5) ⇒  1
+
    + +

    See Also::

    + +

    aref +, +

    +

    Compiler Terminology +

    +

    Notes::

    + +

    bit and sbit are like aref +except that they require arrays to be +a bit array and a simple bit array, respectively. +

    +

    bit and sbit, unlike char and schar, +allow the first argument to be an array of any rank. +

    + + + + + diff --git a/info/gcl/bit-_0028System-Class_0029.html b/info/gcl/bit-_0028System-Class_0029.html new file mode 100644 index 0000000..bea54d6 --- /dev/null +++ b/info/gcl/bit-_0028System-Class_0029.html @@ -0,0 +1,69 @@ + + + + + +bit (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.12 bit [Type]

    + +

    Supertypes::

    + +

    bit, +unsigned-byte, +signed-byte, +integer, +rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    The type bit is equivalent to the type (integer 0 1) +and (unsigned-byte 1). +

    + + + + + diff --git a/info/gcl/bit_002dand.html b/info/gcl/bit_002dand.html new file mode 100644 index 0000000..46be710 --- /dev/null +++ b/info/gcl/bit_002dand.html @@ -0,0 +1,157 @@ + + + + + +bit-and (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.34 bit-and, bit-andc1, bit-andc2, bit-eqv,

    +

    bit-ior, bit-nand, bit-nor, bit-not, bit-orc1, bit-orc2, bit-xor

    +

    [Function] +

    +

    bit-and bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-andc1 bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-andc2 bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-eqv bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-ior bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-nand bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-nor bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-orc1 bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-orc2 bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-xor bit-array1 bit-array2 &optional opt-arg ⇒ resulting-bit-array +

    +

    bit-not bit-array &optional opt-arg ⇒ resulting-bit-array +

    +

    Arguments and Values::

    + +

    bit-array, bit-array1, bit-array2—a bit array. +

    +

    Opt-arg—a bit array, or t, or nil. + The default is nil. +

    +

    Bit-array, bit-array1, bit-array2, and opt-arg +(if an array) must all be of the same rank and dimensions. +

    +

    resulting-bit-array—a bit array. +

    +

    Description::

    + +

    These functions perform +bit-wise logical operations on bit-array1 and bit-array2 +and return an array +of matching rank and dimensions, +such that any given bit of the result +is produced by operating on corresponding bits from each of the arguments. +

    +

    In the case of bit-not, an array +of rank and dimensions matching bit-array +is returned that contains a copy of bit-array +with all the bits inverted. +

    +

    If opt-arg is of type (array bit) the contents of the +result are destructively placed into opt-arg. +If opt-arg is the symbol t, +bit-array or bit-array1 is replaced with the result; +if opt-arg is nil or omitted, a new array is created +to contain the result. +

    +

    Figure 15–4 indicates the logical operation +performed by each of the functions. +

    +

    2 +

    +
    Function                                                   Operation                                   
+_______________________________________________________________________________________________________
+                                                           
+bit-and                                                    and                                         
+bit-eqv                                                    equivalence (exclusive nor)                 
+bit-not                                                    complement                                  
+bit-ior                                                    inclusive or                                
+bit-xor                                                    exclusive or                                
+bit-nand                                                   complement of bit-array1 and bit-array2     
+bit-nor                                                    complement of bit-array1 or bit-array2      
+bit-andc1                                                  and complement of bit-array1 with bit-array2
+bit-andc2                                                  and bit-array1 with complement of bit-array2
+bit-orc1                                                   or complement of bit-array1 with bit-array2 
+bit-orc2                                                   or bit-array1 with complement of bit-array2 
+  Figure 15–3: Bit-wise Logical Operations on Bit Arrays
+
+
    + +

    Examples::

    +
    +
     (bit-and (setq ba #*11101010) #*01101011) ⇒  #*01101010
+ (bit-and #*1100 #*1010) ⇒  #*1000      
+ (bit-andc1 #*1100 #*1010) ⇒  #*0010
+ (setq rba (bit-andc2 ba #*00110011 t)) ⇒  #*11001000
+ (eq rba ba) ⇒  true
+ (bit-not (setq ba #*11101010)) ⇒  #*00010101
+ (setq rba (bit-not ba 
+                     (setq tba (make-array 8 
+                                           :element-type 'bit))))
+⇒  #*00010101
+ (equal rba tba) ⇒  true
+ (bit-xor #*1100 #*1010) ⇒  #*0110
+
    + +

    See Also::

    + +

    lognot, +logand +

    +
    +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    + + + + + diff --git a/info/gcl/bit_002dvector.html b/info/gcl/bit_002dvector.html new file mode 100644 index 0000000..4184d05 --- /dev/null +++ b/info/gcl/bit_002dvector.html @@ -0,0 +1,89 @@ + + + + + +bit-vector (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.5 bit-vector [System Class]

    + +

    Class Precedence List::

    +

    bit-vector, +vector, +array, +sequence, +t +

    +

    Description::

    + +

    A bit vector is a vector the element type of which is bit. +

    +

    The type bit-vector is a subtype of type vector, +for bit-vector means (vector bit). +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (bit-vector{[size]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum, + or the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the same type as the type (array bit (size)); +that is, the set of bit vectors of size size. +

    +

    See Also::

    + +

    Sharpsign Asterisk, +Printing Bit Vectors, +Required Kinds of Specialized Arrays +

    + + + + + diff --git a/info/gcl/bit_002dvector_002dp.html b/info/gcl/bit_002dvector_002dp.html new file mode 100644 index 0000000..9688e60 --- /dev/null +++ b/info/gcl/bit_002dvector_002dp.html @@ -0,0 +1,84 @@ + + + + + +bit-vector-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.35 bit-vector-p [Function]

    + +

    bit-vector-p object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type bit-vector; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (bit-vector-p (make-array 6 
+                           :element-type 'bit 
+                           :fill-pointer t)) ⇒  true
+ (bit-vector-p #*) ⇒  true
+ (bit-vector-p (make-array 6)) ⇒  false
+
    + +

    See Also::

    + +

    typep +

    +

    Notes::

    + +
    +
     (bit-vector-p object) ≡ (typep object 'bit-vector)
+
    + + + + + + diff --git a/info/gcl/block.html b/info/gcl/block.html new file mode 100644 index 0000000..40df6a4 --- /dev/null +++ b/info/gcl/block.html @@ -0,0 +1,108 @@ + + + + + +block (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.22 block [Special Operator]

    + +

    block name form* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    name—a symbol. +

    +

    form—a form. +

    +

    results—the values of the forms if a normal return occurs, + or else, if an explicit return occurs, the values that were transferred. +

    +

    Description::

    + +

    block establishes a block named name +and then evaluates forms as an implicit progn. +

    +

    The special operators block and return-from work together to +provide a structured, lexical, non-local exit facility. At any point lexically +contained within forms, return-from can be used with the +given name to return control and values from the block +form, except when an intervening block with the same name +has been established, in which case the outer block is +shadowed by the inner one. +

    +

    The block named name has +lexical scope and dynamic extent. +

    +

    Once established, a block may only be exited once, +whether by normal return or explicit return. +

    +

    Examples::

    + +
    +
     (block empty) ⇒  NIL
+ (block whocares (values 1 2) (values 3 4)) ⇒  3, 4
+ (let ((x 1)) 
+   (block stop (setq x 2) (return-from stop) (setq x 3))
+   x) ⇒  2
+ (block early (return-from early (values 1 2)) (values 3 4)) ⇒  1, 2
+ (block outer (block inner (return-from outer 1)) 2) ⇒  1
+ (block twin (block twin (return-from twin 1)) 2) ⇒  2
+ ;; Contrast behavior of this example with corresponding example of CATCH.
+ (block b
+   (flet ((b1 () (return-from b 1)))
+     (block b (b1) (print 'unreachable))
+     2)) ⇒  1
+
    + +

    See Also::

    + +

    return +, +return-from +, Evaluation +

    +

    Notes::

    + + + + + + diff --git a/info/gcl/boole.html b/info/gcl/boole.html new file mode 100644 index 0000000..481892d --- /dev/null +++ b/info/gcl/boole.html @@ -0,0 +1,190 @@ + + + + + +boole (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.60 boole [Function]

    + +

    boole op integer-1 integer-2 ⇒ result-integer +

    +

    Arguments and Values::

    + +

    Op—a bit-wise logical operation specifier. +

    +

    integer-1—an integer. +

    +

    integer-2—an integer. +

    +

    result-integer—an integer. +

    +

    Description::

    + +

    boole performs bit-wise logical operations on +integer-1 and integer-2, which are treated as if +they were binary and in two’s complement representation. +

    +

    The operation to be performed and the return value are determined by +op. +

    +

    boole returns the values +specified for any op in Figure 12–16. +

    + + +
    +
      Op           Result                                      
+  boole-1      integer-1                                   
+  boole-2      integer-2                                   
+  boole-andc1  and complement of integer-1 with integer-2  
+  boole-andc2  and integer-1 with complement of integer-2  
+  boole-and    and                                         
+  boole-c1     complement of integer-1                     
+  boole-c2     complement of integer-2                     
+  boole-clr    always 0 (all zero bits)                    
+  boole-eqv    equivalence (exclusive nor)                 
+  boole-ior    inclusive or                                
+  boole-nand   not-and                                     
+  boole-nor    not-or                                      
+  boole-orc1   or complement of integer-1 with integer-2   
+  boole-orc2   or integer-1 with complement of integer-2   
+  boole-set    always -1 (all one bits)                    
+  boole-xor    exclusive or                                
+
+         Figure 12–16: Bit-Wise Logical Operations        
+
+
    + + + +

    Examples::

    + +
    +
     (boole boole-ior 1 16) ⇒  17
+ (boole boole-and -2 5) ⇒  4
+ (boole boole-eqv 17 15) ⇒  -31
+
+;;; These examples illustrate the result of applying BOOLE and each
+;;; of the possible values of OP to each possible combination of bits.
+ (progn
+   (format t "~&Results of (BOOLE <op> #b0011 #b0101) ...~
+           ~
+   (dolist (symbol '(boole-1     boole-2    boole-and  boole-andc1
+                     boole-andc2 boole-c1   boole-c2   boole-clr
+                     boole-eqv   boole-ior  boole-nand boole-nor
+                     boole-orc1  boole-orc2 boole-set  boole-xor))
+     (let ((result (boole (symbol-value symbol) #b0011 #b0101)))
+       (format t "~& ~A~13T~3,' D~23T~:*~5,' B~31T ...~4,'0B~
+               symbol result (logand result #b1111)))))
+ |>  Results of (BOOLE <op> #b0011 #b0101) ...
+ |>  ---Op-------Decimal-----Binary----Bits---
+ |>   BOOLE-1       3          11    ...0011
+ |>   BOOLE-2       5         101    ...0101
+ |>   BOOLE-AND     1           1    ...0001
+ |>   BOOLE-ANDC1   4         100    ...0100
+ |>   BOOLE-ANDC2   2          10    ...0010
+ |>   BOOLE-C1     -4        -100    ...1100
+ |>   BOOLE-C2     -6        -110    ...1010
+ |>   BOOLE-CLR     0           0    ...0000
+ |>   BOOLE-EQV    -7        -111    ...1001
+ |>   BOOLE-IOR     7         111    ...0111
+ |>   BOOLE-NAND   -2         -10    ...1110
+ |>   BOOLE-NOR    -8       -1000    ...1000
+ |>   BOOLE-ORC1   -3         -11    ...1101
+ |>   BOOLE-ORC2   -5        -101    ...1011
+ |>   BOOLE-SET    -1          -1    ...1111
+ |>   BOOLE-XOR     6         110    ...0110
+⇒  NIL
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if its first argument is not a +bit-wise logical operation specifier or if any subsequent argument is not +an integer. +

    +

    See Also::

    + +

    logand +

    +

    Notes::

    + +

    In general, +

    +
    +
     (boole boole-and x y) ≡ (logand x y)
+
    + +

    Programmers who would prefer to use numeric indices rather than +bit-wise logical operation specifiers can get an equivalent effect +by a technique such as the following: +

    +
    +
    ;; The order of the values in this `table' are such that
+;; (logand (boole (elt boole-n-vector n) #b0101 #b0011) #b1111) => n
+ (defconstant boole-n-vector
+    (vector boole-clr   boole-and  boole-andc1 boole-2
+            boole-andc2 boole-1    boole-xor   boole-ior
+            boole-nor   boole-eqv  boole-c1    boole-orc1
+            boole-c2    boole-orc2 boole-nand  boole-set))
+⇒  BOOLE-N-VECTOR
+ (proclaim '(inline boole-n))
+⇒  implementation-dependent
+ (defun boole-n (n integer &rest more-integers)
+   (apply #'boole (elt boole-n-vector n) integer more-integers))
+⇒  BOOLE-N
+ (boole-n #b0111 5 3) ⇒  7
+ (boole-n #b0001 5 3) ⇒  1
+ (boole-n #b1101 5 3) ⇒  -3
+ (loop for n from #b0000 to #b1111 collect (boole-n n 5 3))
+⇒  (0 1 2 3 4 5 6 7 -8 -7 -6 -5 -4 -3 -2 -1)
+
    + +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/boole_002d1.html b/info/gcl/boole_002d1.html new file mode 100644 index 0000000..db12604 --- /dev/null +++ b/info/gcl/boole_002d1.html @@ -0,0 +1,78 @@ + + + + + +boole-1 (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.61 boole-1, boole-2, boole-and, boole-andc1, boole-andc2,

    +

    boole-c1, boole-c2, boole-clr, boole-eqv, boole-ior,

    +

    boole-nand, boole-nor, boole-orc1, boole-orc2, boole-set,

    +

    boole-xor

    +

    [Constant Variable] +

    +

    Constant Value::

    + +

    The identity and nature of the values of each of these variables +is implementation-dependent, +except that it must be distinct from each of the values of the others, +and it must be a valid first argument to the function boole. +

    +

    Description::

    + +

    Each of these constants has a value which is one of the +sixteen possible bit-wise logical operation specifiers. +

    +

    Examples::

    +
    +
     (boole boole-ior 1 16) ⇒  17
+ (boole boole-and -2 5) ⇒  4
+ (boole boole-eqv 17 15) ⇒  -31
+
    + +

    See Also::

    + +

    boole +

    + + + + + diff --git a/info/gcl/boolean.html b/info/gcl/boolean.html new file mode 100644 index 0000000..d61c34d --- /dev/null +++ b/info/gcl/boolean.html @@ -0,0 +1,84 @@ + + + + + +boolean (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.2 boolean [Type]

    + +

    Supertypes::

    + +

    boolean, +symbol, +t +

    +

    Description::

    + +

    The type boolean contains the symbols t and nil, +which represent true and false, respectively. +

    +

    See Also::

    + +

    t (constant variable), +nil (constant variable), +if +, +not +, +complement +

    +

    Notes::

    + +

    Conditional operations, such as if, +permit the use of generalized booleans, +not just booleans; +any non-nil value, +not just t, +counts as true for a generalized boolean. +However, as a matter of convention, +the symbol t is considered the canonical value to use +even for a generalized boolean when no better choice presents itself. +

    + + + + + diff --git a/info/gcl/boundp.html b/info/gcl/boundp.html new file mode 100644 index 0000000..6030829 --- /dev/null +++ b/info/gcl/boundp.html @@ -0,0 +1,96 @@ + + + + + +boundp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.17 boundp [Function]

    + +

    boundp symbol ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if symbol is bound; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (setq x 1) ⇒  1
+ (boundp 'x) ⇒  true
+ (makunbound 'x) ⇒  X
+ (boundp 'x) ⇒  false
+ (let ((x 2)) (boundp 'x)) ⇒  false
+ (let ((x 2)) (declare (special x)) (boundp 'x)) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    See Also::

    + +

    set +, +setq +, +symbol-value +, +makunbound +

    +

    Notes::

    + +

    The function bound determines only whether a symbol has a +value in the global environment; any lexical bindings +are ignored. +

    + + + + + diff --git a/info/gcl/break.html b/info/gcl/break.html new file mode 100644 index 0000000..19be50e --- /dev/null +++ b/info/gcl/break.html @@ -0,0 +1,136 @@ + + + + + +break (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.23 break [Function]

    + +

    break &optional format-control &rest format-arguments ⇒ nil +

    +

    Arguments and Values::

    + +

    format-control—a format control. +

    +

    The default is implementation-dependent. +

    +

    format-arguments—format arguments for the format-control. +

    +

    Description::

    + +

    break formats format-control and format-arguments +and then goes directly into the debugger without allowing any possibility of +interception by programmed error-handling facilities. +

    +

    If the continue restart is used while in the debugger, +break immediately returns nil without taking any unusual recovery action. +

    +

    break binds *debugger-hook* to nil +before attempting to enter the debugger. +

    +

    Examples::

    + +
    +
     (break "You got here with arguments: ~:S." '(FOO 37 A))
+ |>  BREAK: You got here with these arguments: FOO, 37, A.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Return from BREAK.
+ |>   2: Top level.
+ |>  Debug> :CONTINUE 1
+ |>  Return from BREAK.
+⇒  NIL
+
+
    + +

    Side Effects::

    + +

    The debugger is entered. +

    +

    Affected By::

    + +

    *debug-io*. +

    +

    See Also::

    + +

    error +, +invoke-debugger +. +

    +

    Notes::

    + +

    break is used as a way of inserting temporary debugging +“breakpoints” in a program, not as a way of signaling errors. +For this reason, break does not take the continue-format-control +argument that cerror takes. +This and the lack of any possibility of interception by +condition handling are the only program-visible +differences between break and cerror. +

    +

    The user interface aspects of break and cerror are +permitted to vary more widely, in order to accomodate the interface +needs of the implementation. For example, it is permissible for a +Lisp read-eval-print loop to be entered by break rather +than the conventional debugger. +

    +

    break could be defined by: +

    +
    +
     (defun break (&optional (format-control "Break") &rest format-arguments)
+   (with-simple-restart (continue "Return from BREAK.")
+     (let ((*debugger-hook* nil))
+       (invoke-debugger
+           (make-condition 'simple-condition
+                           :format-control format-control
+                           :format-arguments format-arguments))))
+   nil)
+
    + +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/broadcast_002dstream.html b/info/gcl/broadcast_002dstream.html new file mode 100644 index 0000000..a8fcb70 --- /dev/null +++ b/info/gcl/broadcast_002dstream.html @@ -0,0 +1,153 @@ + + + + + +broadcast-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.2 broadcast-stream [System Class]

    + +

    Class Precedence List::

    + +

    broadcast-stream, +stream, +t +

    +

    Description::

    + +

    A broadcast stream is an output stream which +has associated with it a set of zero or more output streams +such that any output sent to the broadcast stream gets passed on +as output to each of the associated output streams. +(If a broadcast stream has no component streams, +then all output to the broadcast stream is discarded.) +

    +

    The set of operations that may be performed on a broadcast stream +is the intersection of those for its associated output streams. +

    +

    Some output operations (e.g., fresh-line) return values based on the +state of the stream at the time of the operation. +

    +

    Since these values might differ for each of the component streams, +it is necessary to describe their return value specifically: +

    +
    +
    *
    +

    stream-element-type returns + the value from the last component stream, + or t if there are no component streams. +

    +
    +
    *
    +

    fresh-line returns + the value from the last component stream, + or nil if there are no component streams. +

    +
    +
    *
    +

    The functions + file-length, + file-position, + file-string-length, + and stream-external-format + return the value from the last component stream; + if there are no component streams, + file-length and file-position return 0, + file-string-length returns 1, + and stream-external-format returns :default. +

    +
    +
    *
    +

    The functions streamp and output-stream-p + always return true for broadcast streams. +

    +
    +
    *
    +

    The functions open-stream-p tests whether the broadcast stream + is open_2, not whether its component streams are open. +

    +
    +
    *
    +

    The functions input-stream-p and interactive-stream-p + return an implementation-defined, generalized boolean value. +

    +
    +
    *
    +

    For the input operations + clear-input + listen, + peek-char, + read-byte, + read-char-no-hang, + read-char, + read-line, + and unread-char, + the consequences are undefined if the indicated operation is performed. + However, an implementation is permitted + to define such a behavior as an implementation-dependent extension. +

    +
    + +

    For any output operations not having their return values explicitly specified above +or elsewhere in this document, it is defined that +the values returned by such an operation are +the values resulting from performing the operation +on the last of its component streams; +the values resulting from performing the operation +on all preceding streams are discarded. +If there are no component streams, +the value is implementation-dependent. +

    +

    See Also::

    + +

    broadcast-stream-streams +, +make-broadcast-stream +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/broadcast_002dstream_002dstreams.html b/info/gcl/broadcast_002dstream_002dstreams.html new file mode 100644 index 0000000..54e5ecd --- /dev/null +++ b/info/gcl/broadcast_002dstream_002dstreams.html @@ -0,0 +1,64 @@ + + + + + +broadcast-stream-streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.40 broadcast-stream-streams [Function]

    + +

    broadcast-stream-streams broadcast-stream ⇒ streams +

    +

    Arguments and Values::

    + +

    broadcast-stream—a broadcast stream. +

    +

    streams—a list of streams. +

    +

    Description::

    + +

    Returns a list of output streams that constitute +all the streams to which the broadcast-stream is broadcasting. +

    + + + + + diff --git a/info/gcl/built_002din_002dclass.html b/info/gcl/built_002din_002dclass.html new file mode 100644 index 0000000..ac04cd1 --- /dev/null +++ b/info/gcl/built_002din_002dclass.html @@ -0,0 +1,75 @@ + + + + + +built-in-class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.8 built-in-class [System Class]

    + +

    Class Precedence List::

    +

    built-in-class, +class, +

    +

    standard-object, +

    +

    t +

    +

    Description::

    + +

    A built-in class is a class whose instances have +restricted capabilities or special representations. +Attempting to use +defclass to define subclasses of a built-in class +signals an error of type error. +Calling make-instance to create an instance +of a built-in class signals an error of type error. +Calling slot-value on an instance of a built-in class +signals an error of type error. Redefining a built-in class +or using change-class to change the class of an instance +to or from a built-in class signals an error of type error. +However, built-in classes can be used as parameter specializers +in methods. +

    + + + + + diff --git a/info/gcl/butlast.html b/info/gcl/butlast.html new file mode 100644 index 0000000..9284d1e --- /dev/null +++ b/info/gcl/butlast.html @@ -0,0 +1,128 @@ + + + + + +butlast (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.28 butlast, nbutlast [Function]

    + +

    butlast list &optional n ⇒ result-list +

    +

    nbutlast list &optional n ⇒ result-list +

    +

    Arguments and Values::

    + +

    list—a list, +

    +

    which might be a dotted list but must not be a circular list. +

    +

    n—a non-negative integer. +

    +

    result-list—a list. +

    +

    Description::

    + +

    butlast returns a copy of list from which the last +n +

    +

    conses +

    +

    have been omitted. +If n is not supplied, its value is 1. +If there are fewer than n +

    +

    conses +

    +

    in list, +nil is returned and, in the case of nbutlast, +list is not modified. +

    +

    nbutlast is like butlast, but nbutlast +may modify list. +It changes the cdr of +the cons n+1 from the end of the list to nil. +

    +

    Examples::

    +
    +
     (setq lst '(1 2 3 4 5 6 7 8 9)) ⇒  (1 2 3 4 5 6 7 8 9)
+ (butlast lst) ⇒  (1 2 3 4 5 6 7 8)
+ (butlast lst 5) ⇒  (1 2 3 4)
+ (butlast lst (+ 5 5)) ⇒  NIL
+ lst ⇒  (1 2 3 4 5 6 7 8 9)
+ (nbutlast lst 3) ⇒  (1 2 3 4 5 6)
+ lst ⇒  (1 2 3 4 5 6)
+ (nbutlast lst 99) ⇒  NIL
+ lst ⇒  (1 2 3 4 5 6)
+ (butlast '(a b c d)) ⇒  (A B C)
+ (butlast '((a b) (c d))) ⇒  ((A B))
+ (butlast '(a)) ⇒  NIL
+ (butlast nil) ⇒  NIL
+ (setq foo (list 'a 'b 'c 'd)) ⇒  (A B C D)
+ (nbutlast foo) ⇒  (A B C)
+ foo ⇒  (A B C)
+ (nbutlast (list 'a)) ⇒  NIL
+ (nbutlast '()) ⇒  NIL
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if list is not a proper list or a dotted list. +

    +

    Should signal an error of type type-error + if n is not a non-negative integer. +

    +

    Notes::

    + +
    +
     (butlast list n) ≡ (ldiff list (last list n))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/byte.html b/info/gcl/byte.html new file mode 100644 index 0000000..683fd70 --- /dev/null +++ b/info/gcl/byte.html @@ -0,0 +1,104 @@ + + + + + +byte (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.66 byte, byte-size, byte-position [Function]

    + +

    byte size position ⇒ bytespec +

    +

    byte-size bytespec ⇒ size +

    +

    byte-position bytespec ⇒ position +

    +

    Arguments and Values::

    + +

    size, position—a non-negative integer. +

    +

    bytespec—a byte specifier. +

    +

    Description::

    + +

    byte returns a byte specifier that indicates +a byte of width size and whose bits have weights +2^position + size - 1\/ through 2^position, +and whose representation is +implementation-dependent. +

    +

    byte-size returns the number of bits specified by bytespec. +

    +

    byte-position returns the position specified by bytespec. +

    +

    Examples::

    + +
    +
     (setq b (byte 100 200)) ⇒  #<BYTE-SPECIFIER size 100 position 200>
+ (byte-size b) ⇒  100
+ (byte-position b) ⇒  200
+
    + +

    See Also::

    + +

    ldb +, +dpb +

    +

    Notes::

    + +
    +
     (byte-size (byte j k)) ≡ j
+ (byte-position (byte j k)) ≡ k
+
    + +

    A byte of size of 0 is permissible; +it refers to a byte of width zero. For example, +

    +
    +
     (ldb (byte 0 3) #o7777) ⇒  0
+ (dpb #o7777 (byte 0 3) 0) ⇒  0
+
    + + + + + + diff --git a/info/gcl/call_002darguments_002dlimit.html b/info/gcl/call_002darguments_002dlimit.html new file mode 100644 index 0000000..9d83f6a --- /dev/null +++ b/info/gcl/call_002darguments_002dlimit.html @@ -0,0 +1,68 @@ + + + + + +call-arguments-limit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.12 call-arguments-limit [Constant Variable]

    + +

    Constant Value::

    + +

    An integer not smaller than 50 and at least as great as +the value of lambda-parameters-limit, +the exact magnitude of which is implementation-dependent. +

    +

    Description::

    + +

    The upper exclusive bound on the number of arguments that +may be passed to a function. +

    +

    See Also::

    + +

    lambda-parameters-limit +, +multiple-values-limit +

    + + + + + diff --git a/info/gcl/call_002dmethod.html b/info/gcl/call_002dmethod.html new file mode 100644 index 0000000..f8bad3b --- /dev/null +++ b/info/gcl/call_002dmethod.html @@ -0,0 +1,141 @@ + + + + + +call-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.30 call-method, make-method [Local Macro]

    + +

    Syntax::

    + +

    call-method method &optional next-method-list ⇒ {result}* +

    +

    make-method form ⇒ method-object +

    +

    Arguments and Values::

    + +

    method—a method object, + or a list (see below); not evaluated. +

    +

    method-object—a method object. +

    +

    next-method-list—a list of method objects; not evaluated. +

    +

    results—the values returned by the method invocation. +

    +

    Description::

    + +

    The macro call-method is used in method combination. It hides +the implementation-dependent details of how +methods are called. The +macro call-method has lexical scope and +can only be used within +an effective method form. +

    +

    [Editorial Note by KMP: This next paragraph still needs some work.] +

    +

    Whether or not call-method is fbound in the +global environment is implementation-dependent; +however, the restrictions on redefinition and shadowing of +call-method are the same as for symbols in the COMMON-LISP package +which are fbound in the global environment. +The consequences of attempting to use call-method outside +of an effective method form are undefined. +

    +

    The macro call-method invokes the specified method, +supplying it with arguments and with definitions for +call-next-method and for next-method-p. +If the invocation of call-method is lexically inside +of a make-method, the arguments are those that +were supplied to that method. Otherwise the arguments are +those that were supplied to the generic function. +The definitions +of call-next-method and next-method-p rely on +the specified next-method-list. +

    +

    If method is a list, the first element of the list +must be the symbol make-method and the second element must be +a form. Such a list specifies a method object +whose method function has a body that is the given form. +

    +

    Next-method-list can contain method objects or lists, +the first element of which must be the symbol make-method and the +second element of which must be a form. +

    +

    Those are the only two places where make-method can be used. +The form used with make-method is evaluated in +the null lexical environment augmented with a local macro definition +for call-method and with bindings named by +symbols not accessible from the COMMON-LISP-USER package. +

    +

    The call-next-method function available to method +will call the first method in next-method-list. +The call-next-method function +available in that method, in turn, will call the second +method in next-method-list, and so on, until +the list of next methods is exhausted. +

    +

    If next-method-list is not supplied, the +call-next-method function available to +method signals an error of type control-error +and the next-method-p function +available to method returns nil. +

    +

    Examples::

    + +

    See Also::

    + +

    call-next-method +, +define-method-combination +, +next-method-p +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/call_002dnext_002dmethod.html b/info/gcl/call_002dnext_002dmethod.html new file mode 100644 index 0000000..9acdd14 --- /dev/null +++ b/info/gcl/call_002dnext_002dmethod.html @@ -0,0 +1,146 @@ + + + + + +call-next-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.31 call-next-method [Local Function]

    + +

    Syntax::

    + +

    call-next-method &rest args ⇒ {result}* +

    +

    Arguments and Values::

    + +

    arg—an object. +

    +

    results—the values returned by the method it calls. +

    +

    Description::

    + +

    The function call-next-method can be used +

    +

    within the body forms (but not the lambda list) +

    +

    of a method defined by a method-defining form to call the +next method. +

    +

    If there is no next method, the generic function +no-next-method is called. +

    +

    The type of method combination used determines which methods +can invoke call-next-method. The standard +method combination type allows call-next-method +to be used within primary methods and around methods. +For generic functions using a type of method combination defined by +the short form of define-method-combination, +call-next-method can be used in around methods only. +

    +

    When call-next-method is called with no arguments, it passes the +current method’s original arguments to the next method. Neither +argument defaulting, nor using setq, nor rebinding variables +with the same names as parameters of the method affects the values +call-next-method passes to the method it calls. +

    +

    When call-next-method is called with arguments, the +next method is called with those arguments. +

    +

    If call-next-method is called with arguments but omits +optional arguments, the next method called defaults those arguments. +

    +

    The function call-next-method returns any values that are +returned by the next method. +

    +

    The function call-next-method has lexical scope and +indefinite extent and can only be used within the body of a +method defined by a method-defining form. +

    +

    Whether or not call-next-method is fbound in the +global environment is implementation-dependent; +however, the restrictions on redefinition and shadowing of +call-next-method are the same as for symbols in the COMMON-LISP package +which are fbound in the global environment. +The consequences of attempting to use call-next-method outside +of a method-defining form are undefined. +

    +

    Affected By::

    + +

    defmethod, call-method, define-method-combination. +

    +

    Exceptional Situations::

    + +

    When providing arguments to call-next-method, +the following rule must be satisfied or an error of type error +should be +signaled: +the ordered set of applicable methods for a changed set of arguments +for call-next-method must be the same as the ordered set of +applicable methods for the original arguments to the +generic function. +Optimizations of the error checking are possible, but they must not change +the semantics of call-next-method. +

    +

    See Also::

    + +

    define-method-combination +, +defmethod +, +next-method-p +, +no-next-method +, +call-method +, +Method Selection and Combination, +Standard Method Combination, +Built-in Method Combination Types +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/car.html b/info/gcl/car.html new file mode 100644 index 0000000..9d6baa3 --- /dev/null +++ b/info/gcl/car.html @@ -0,0 +1,286 @@ + + + + + +car (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.9 car, cdr,

    +

    caar, cadr, cdar, cddr,

    +

    caaar, caadr, cadar, caddr, cdaar, cdadr, cddar, cdddr,

    +

    caaaar, caaadr, caadar, caaddr, cadaar, cadadr, caddar, cadddr,

    +

    cdaaar, cdaadr, cdadar, cdaddr, cddaar, cddadr, cdddar, cddddr

    +

    [Accessor] +

    +

    car x ⇒ object +(setf (car x) new-object)
    +

    +

    cdr x ⇒ object +(setf (cdr x) new-object)
    +

    +

    \vksip 5pt x ⇒ object +(setf (\vksip 5pt x) new-object)
    +

    +

    caar x ⇒ object +(setf (caar x) new-object)
    +

    +

    cadr x ⇒ object +(setf (cadr x) new-object)
    +

    +

    cdar x ⇒ object +(setf (cdar x) new-object)
    +

    +

    cddr x ⇒ object +(setf (cddr x) new-object)
    +

    +

    \vksip 5pt x ⇒ object +(setf (\vksip 5pt x) new-object)
    +

    +

    caaar x ⇒ object +(setf (caaar x) new-object)
    +

    +

    caadr x ⇒ object +(setf (caadr x) new-object)
    +

    +

    cadar x ⇒ object +(setf (cadar x) new-object)
    +

    +

    caddr x ⇒ object +(setf (caddr x) new-object)
    +

    +

    cdaar x ⇒ object +(setf (cdaar x) new-object)
    +

    +

    cdadr x ⇒ object +(setf (cdadr x) new-object)
    +

    +

    cddar x ⇒ object +(setf (cddar x) new-object)
    +

    +

    cdddr x ⇒ object +(setf (cdddr x) new-object)
    +

    +

    \vksip 5pt x ⇒ object +(setf (\vksip 5pt x) new-object)
    +

    +

    caaaar x ⇒ object +(setf (caaaar x) new-object)
    +

    +

    caaadr x ⇒ object +(setf (caaadr x) new-object)
    +

    +

    caadar x ⇒ object +(setf (caadar x) new-object)
    +

    +

    caaddr x ⇒ object +(setf (caaddr x) new-object)
    +

    +

    cadaar x ⇒ object +(setf (cadaar x) new-object)
    +

    +

    cadadr x ⇒ object +(setf (cadadr x) new-object)
    +

    +

    caddar x ⇒ object +(setf (caddar x) new-object)
    +

    +

    cadddr x ⇒ object +(setf (cadddr x) new-object)
    +

    +

    cdaaar x ⇒ object +(setf (cdaaar x) new-object)
    +

    +

    cdaadr x ⇒ object +(setf (cdaadr x) new-object)
    +

    +

    cdadar x ⇒ object +(setf (cdadar x) new-object)
    +

    +

    cdaddr x ⇒ object +(setf (cdaddr x) new-object)
    +

    +

    cddaar x ⇒ object +(setf (cddaar x) new-object)
    +

    +

    cddadr x ⇒ object +(setf (cddadr x) new-object)
    +

    +

    cdddar x ⇒ object +(setf (cdddar x) new-object)
    +

    +

    cddddr x ⇒ object +(setf (cddddr x) new-object)
    +

    +

    Pronunciation::

    + +

    cadr: pronounced ’ka ,de r +

    +

    caddr: pronounced ’kad e ,de r + or pronounced ’ka ,dude r +

    +

    cdr: pronounced ’ku ,de r +

    +

    cddr: pronounced ’kud e ,de r + or pronounced ’ke ,dude r +

    +

    Arguments and Values::

    + +

    x—a list. +

    +

    object—an object. +

    +

    new-object—an object. +

    +

    Description::

    + +

    If x is a cons, car returns the car +of that cons. If x is nil, car returns nil. +

    +

    If x is a cons, cdr returns the cdr +of that cons. If x is nil, cdr returns nil. +

    +

    Functions are provided which perform compositions of up to four +car and cdr operations. Their names consist of +a C, followed by two, three, or four occurrences of A or D, +and finally an R. The series of A’s and D’s in each +function’s name is chosen to identify the series of +car and cdr operations that is performed by the function. +The order in which the A’s and D’s appear is the inverse of the +order in which the corresponding operations are performed. Figure 14–6 +defines the relationships precisely. +

    +
    +
      This place ...  Is equivalent to this place ...  
+  (caar x)        (car (car x))                    
+  (cadr x)        (car (cdr x))                    
+  (cdar x)        (cdr (car x))                    
+  (cddr x)        (cdr (cdr x))                    
+  (caaar x)       (car (car (car x)))              
+  (caadr x)       (car (car (cdr x)))              
+  (cadar x)       (car (cdr (car x)))              
+  (caddr x)       (car (cdr (cdr x)))              
+  (cdaar x)       (cdr (car (car x)))              
+  (cdadr x)       (cdr (car (cdr x)))              
+  (cddar x)       (cdr (cdr (car x)))              
+  (cdddr x)       (cdr (cdr (cdr x)))              
+  (caaaar x)      (car (car (car (car x))))        
+  (caaadr x)      (car (car (car (cdr x))))        
+  (caadar x)      (car (car (cdr (car x))))        
+  (caaddr x)      (car (car (cdr (cdr x))))        
+  (cadaar x)      (car (cdr (car (car x))))        
+  (cadadr x)      (car (cdr (car (cdr x))))        
+  (caddar x)      (car (cdr (cdr (car x))))        
+  (cadddr x)      (car (cdr (cdr (cdr x))))        
+  (cdaaar x)      (cdr (car (car (car x))))        
+  (cdaadr x)      (cdr (car (car (cdr x))))        
+  (cdadar x)      (cdr (car (cdr (car x))))        
+  (cdaddr x)      (cdr (car (cdr (cdr x))))        
+  (cddaar x)      (cdr (cdr (car (car x))))        
+  (cddadr x)      (cdr (cdr (car (cdr x))))        
+  (cdddar x)      (cdr (cdr (cdr (car x))))        
+  (cddddr x)      (cdr (cdr (cdr (cdr x))))        
+
+         Figure 14–6: CAR and CDR variants        
+
+
    + +

    setf can also be used with any of these functions to change an +existing component of x, but setf will not make new +components. So, for example, the car of a cons +can be assigned with setf of car, +but the car of nil cannot be assigned with setf of car. +Similarly, the car of the car of a cons whose car +is a cons can be assigned with setf of caar, +but neither nil nor a cons whose car is nil can be assigned +with setf of caar. +

    +

    The argument x is permitted to be a dotted list +or a circular list. +

    +

    Examples::

    + +
    +
     (car nil) ⇒  NIL  
+ (cdr '(1 . 2)) ⇒  2
+ (cdr '(1 2)) ⇒  (2)
+ (cadr '(1 2)) ⇒  2 
+ (car '(a b c)) ⇒  A
+ (cdr '(a b c)) ⇒  (B C)
+
    + +

    Exceptional Situations::

    + +

    The functions car and cdr +should signal type-error if they receive an argument which is not a +list. The other functions (caar, cadr, +... cddddr) should behave for the purpose of +error checking as if defined by appropriate calls to car and +cdr. +

    +

    See Also::

    + +

    rplaca +, +first +, +rest +

    +

    Notes::

    + +

    The car of a cons can also be altered by using rplaca, +and the cdr of a cons can be altered by using rplacd. +

    +
    +
    (car x)    ≡ (first x)
+(cadr x)   ≡ (second x) ≡ (car (cdr x))
+(caddr x)  ≡ (third x)  ≡ (car (cdr (cdr x)))
+(cadddr x) ≡ (fourth x) ≡ (car (cdr (cdr (cdr x))))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/case.html b/info/gcl/case.html new file mode 100644 index 0000000..a412ba7 --- /dev/null +++ b/info/gcl/case.html @@ -0,0 +1,228 @@ + + + + + +case (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.46 case, ccase, ecase [Macro]

    + +

    case keyform {!normal-clause}* [!otherwise-clause] ⇒ {result}* +

    +

    ccase keyplace {!normal-clause}* ⇒ {result}* +

    +

    ecase keyform {!normal-clause}* ⇒ {result}* +

    +

    normal-clause ::=(keys {form}*) +

    +

    otherwise-clause ::=({otherwise | t} {form}*) +

    +

    clause ::=normal-clause | otherwise-clause +

    + + + + +

    Arguments and Values::

    + +

    keyform—a form; evaluated to produce a test-key. +

    +

    keyplace—a form; evaluated initially to produce a test-key. + Possibly also used later as a place if no keys match. +

    +

    test-key—an object produced by evaluating keyform or keyplace. +

    +

    keys—a designator for a list of objects. + In the case of case, the symbols t and otherwise may + not be used as the keys designator. To refer to these symbols + by themselves as keys, the designators (t) and (otherwise), respectively, + must be used instead. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms + in the matching clause. +

    +

    Description::

    + +

    These macros allow the conditional execution of a body of forms +in a clause that is selected by matching the test-key on the +basis of its identity. +

    +

    The keyform or keyplace is evaluated to produce the +test-key. +

    +

    Each of the normal-clauses is then considered in turn. +If the test-key is the same as any key for +that clause, the forms in that clause are +evaluated as an implicit progn, and the values +it returns are returned as the value of the case, +ccase, or ecase form. +

    +

    These macros differ only in their behavior when +no normal-clause matches; specifically: +

    +
    +
    case
    +

    If no normal-clause matches, and there is an otherwise-clause, +then that otherwise-clause automatically matches; the forms in +that clause are evaluated as an implicit progn, +and the values it returns are returned as the value of the case. +

    +

    If there is no otherwise-clause, case returns nil. +

    +
    +
    ccase
    +

    If no normal-clause matches, +a correctable error of type type-error is signaled. +The offending datum is the test-key and +the expected type is type equivalent to (member key1 key2 ...). +The store-value restart can be used to correct the error. +

    +

    If the store-value restart is invoked, its argument becomes the +new test-key, and is stored in keyplace as if by +(setf keyplace test-key). +Then ccase starts over, considering each clause anew. +

    +

    [Reviewer Note by Barmar: Will it prompt for multiple values if keyplace is a VALUES general ref?] +

    +

    The subforms of keyplace might be evaluated again if +none of the cases holds. +

    +
    +
    ecase
    +

    If no normal-clause matches, +a non-correctable error of type type-error is signaled. +The offending datum is the test-key and +the expected type is type equivalent to (member key1 key2 ...). +

    +

    Note that in contrast with ccase, +the caller of ecase may rely on the fact that ecase +does not return if a normal-clause does not match. +

    +
    +
    + +

    Examples::

    + +
    +
     (dolist (k '(1 2 3 :four #\v () t 'other))
+    (format t "~S "
+       (case k ((1 2) 'clause1)
+               (3 'clause2)
+               (nil 'no-keys-so-never-seen)
+               ((nil) 'nilslot)
+               ((:four #\v) 'clause4)
+               ((t) 'tslot)
+               (otherwise 'others)))) 
+ |>  CLAUSE1 CLAUSE1 CLAUSE2 CLAUSE4 CLAUSE4 NILSLOT TSLOT OTHERS 
+⇒  NIL
+ (defun add-em (x) (apply #'+ (mapcar #'decode x)))
+⇒  ADD-EM
+ (defun decode (x)
+   (ccase x
+     ((i uno) 1)
+     ((ii dos) 2)
+     ((iii tres) 3)
+     ((iv cuatro) 4)))
+⇒  DECODE
+ (add-em '(uno iii)) ⇒  4
+ (add-em '(uno iiii))
+ |>  Error: The value of X, IIII, is not I, UNO, II, DOS, III,
+ |>         TRES, IV, or CUATRO.
+ |>   1: Supply a value to use instead.
+ |>   2: Return to Lisp Toplevel.
+ |>  Debug> |>>:CONTINUE 1<<|
+ |>  Value to evaluate and use for X: |>>'IV<<|
+⇒  5
+
    + +

    Side Effects::

    + +

    The debugger might be entered. +If the store-value restart is invoked, +the value of keyplace might be changed. +

    +

    Affected By::

    + +

    ccase and ecase, since they might signal an error, +are potentially affected by existing handlers and *debug-io*. +

    +

    Exceptional Situations::

    + +

    ccase and ecase signal an error of type type-error +if no normal-clause matches. +

    +

    See Also::

    + +

    cond +, +typecase +, +setf +, +Generalized Reference +

    +

    Notes::

    + +
    +
    (case test-key
+  {(({key}*) {form}*)}*)
+≡
+(let ((#1=#:g0001 test-key))
+  (cond {((member #1# '({key}*)) {form}*)}*))
+
    + +

    The specific error message used by ecase and ccase can vary +between implementations. In situations where control of the specific wording +of the error message is important, it is better to use case with an +otherwise-clause that explicitly signals an error with an appropriate +message. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/catch.html b/info/gcl/catch.html new file mode 100644 index 0000000..23412ad --- /dev/null +++ b/info/gcl/catch.html @@ -0,0 +1,162 @@ + + + + + +catch (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.23 catch [Special Operator]

    + +

    catch tag {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    tag—a catch tag; evaluated. +

    +

    forms—an implicit progn. +

    +

    results—if the forms exit normally, + the values returned by the forms; + if a throw occurs to the tag, + the values that are thrown. +

    +

    Description::

    + +

    catch is used as the destination of a non-local +control transfer by throw. +Tags are used to find the catch +to which a throw is transferring control. +(catch 'foo form) catches a +(throw 'foo form) but not a +(throw 'bar form). +

    +

    The order of execution of catch follows: + +

    + + +
    +
    1.
    +

    Tag is evaluated. +It serves as the name of the +catch. +

    +
    +
    2.
    +

    Forms are then evaluated as an implicit progn, +and the results of the last form are returned unless a +throw occurs. +

    +
    +
    3.
    +

    If a throw occurs +during the execution of one of the forms, control +is transferred to the catch form whose tag +is eq to +the tag argument of the throw +and which is the most recently established catch with that +tag. +No further evaluation of forms occurs. +

    +
    +
    4.
    +

    The tag established +by catch is disestablished +just before the results are returned. +

    +
    +
    + +

    If during the execution of one of the forms, a throw +is executed whose tag is eq to the catch tag, +then the values specified by the throw are +returned as the result of the dynamically most recently established +catch form with that tag. +

    +

    The mechanism for catch and throw works even +if throw is not within the lexical scope of catch. +throw must occur within the dynamic extent +of the evaluation of the body of a catch with a corresponding tag. +

    +

    Examples::

    +
    +
     (catch 'dummy-tag 1 2 (throw 'dummy-tag 3) 4) ⇒  3
+ (catch 'dummy-tag 1 2 3 4) ⇒  4
+ (defun throw-back (tag) (throw tag t)) ⇒  THROW-BACK
+ (catch 'dummy-tag (throw-back 'dummy-tag) 2) ⇒  T
+
+ ;; Contrast behavior of this example with corresponding example of BLOCK.
+ (catch 'c
+   (flet ((c1 () (throw 'c 1)))
+     (catch 'c (c1) (print 'unreachable))
+     2)) ⇒  2
+
    + +

    Exceptional Situations::

    +

    An error of type control-error is signaled +if throw is done +when there is no suitable catch tag. +

    See Also::

    + +

    throw +, Evaluation +

    +

    Notes::

    + +

    It is customary for symbols to be used +as tags, but any object is permitted. +However, numbers should not be +used because the comparison is done using eq. +

    +

    catch differs from block in that +catch +tags have dynamic scope while +block names have lexical scope. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/cell_002derror.html b/info/gcl/cell_002derror.html new file mode 100644 index 0000000..0dbfb84 --- /dev/null +++ b/info/gcl/cell_002derror.html @@ -0,0 +1,69 @@ + + + + + +cell-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.6 cell-error [Condition Type]

    + +

    Class Precedence List::

    +

    cell-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type cell-error consists of error conditions that occur during +a location access. The name of the offending cell is initialized by +the :name initialization argument to make-condition, +and is accessed by the function cell-error-name. +

    +

    See Also::

    + +

    cell-error-name +

    + + + + + diff --git a/info/gcl/cell_002derror_002dname.html b/info/gcl/cell_002derror_002dname.html new file mode 100644 index 0000000..8f0faeb --- /dev/null +++ b/info/gcl/cell_002derror_002dname.html @@ -0,0 +1,81 @@ + + + + + +cell-error-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.7 cell-error-name [Function]

    + +

    cell-error-name condition ⇒ name +

    +

    Arguments and Values::

    + +

    condition—a condition of type cell-error. +

    +

    name—an object. +

    +

    Description::

    + +

    Returns the name of the offending cell involved in the situation +represented by condition. +

    +

    The nature of the result depends on the specific type of condition. +For example, + if the condition is of type unbound-variable, the result is + the name of the unbound variable which was being accessed, + if the condition is of type undefined-function, this is + the name of the undefined function which was being accessed, +and if the condition is of type unbound-slot, this is + the name of the slot which was being accessed. +

    +

    See Also::

    + +

    cell-error, +unbound-slot, +unbound-variable, +undefined-function, +Condition System Concepts +

    + + + + + diff --git a/info/gcl/cerror.html b/info/gcl/cerror.html new file mode 100644 index 0000000..81f6878 --- /dev/null +++ b/info/gcl/cerror.html @@ -0,0 +1,218 @@ + + + + + +cerror (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.12 cerror [Function]

    + +

    cerror continue-format-control datum &rest arguments ⇒ nil +

    +

    Arguments and Values::

    + +

    Continue-format-control—a format control. +

    +

    [Reviewer Note by Barmar: What is continue-format-control used for??] +

    +

    datum, arguments—designators for a condition + of default type simple-error. +

    +

    Description::

    + +

    cerror effectively invokes error on the +condition named by datum. As with any function that +implicitly calls error, if the condition is not handled, +(invoke-debugger condition) is executed. While signaling is going on, +and while in the debugger if it is reached, it is possible to continue +code execution (i.e., to return from cerror) using the continue restart. +

    +

    If datum is a condition, arguments can be supplied, +but are used only in conjunction with the continue-format-control. +

    +

    Examples::

    + +
    +
     (defun real-sqrt (n)
+   (when (minusp n)
+     (setq n (- n))
+     (cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n))
+   (sqrt n))
+
+ (real-sqrt 4)
+⇒  2.0
+
+ (real-sqrt -9)
+ |>  Correctable error in REAL-SQRT: Tried to take sqrt(-9).
+ |>  Restart options:
+ |>   1: Return sqrt(9) instead.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+⇒  3.0
+
+ (define-condition not-a-number (error)
+   ((argument :reader not-a-number-argument :initarg :argument))
+   (:report (lambda (condition stream)
+              (format stream "~S is not a number." 
+                      (not-a-number-argument condition)))))
+
+ (defun assure-number (n)
+   (loop (when (numberp n) (return n))
+         (cerror "Enter a number."
+                 'not-a-number :argument n)
+         (format t "~&Type a number: ")
+         (setq n (read))
+         (fresh-line)))
+
+ (assure-number 'a)
+ |>  Correctable error in ASSURE-NUMBER: A is not a number.
+ |>  Restart options:
+ |>   1: Enter a number.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+ |>  Type a number: |>>1/2<<|
+⇒  1/2
+
+ (defun assure-large-number (n)
+   (loop (when (and (numberp n) (> n 73)) (return n))
+         (cerror "Enter a number~:[~; a bit larger than ~D~]."
+                 "~*~A is not a large number." 
+                 (numberp n) n)
+         (format t "~&Type a large number: ")
+         (setq n (read))
+         (fresh-line)))
+
+ (assure-large-number 10000)
+⇒  10000
+
+ (assure-large-number 'a)
+ |>  Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
+ |>  Restart options:
+ |>   1: Enter a number.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+ |>  Type a large number: |>>88<<|
+⇒  88
+
+ (assure-large-number 37)
+ |>  Correctable error in ASSURE-LARGE-NUMBER: 37 is not a large number.
+ |>  Restart options:
+ |>   1: Enter a number a bit larger than 37.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+ |>  Type a large number: |>>259<<|
+⇒  259
+
+ (define-condition not-a-large-number (error)
+   ((argument :reader not-a-large-number-argument :initarg :argument))
+   (:report (lambda (condition stream)
+              (format stream "~S is not a large number." 
+                      (not-a-large-number-argument condition)))))
+
+ (defun assure-large-number (n)
+   (loop (when (and (numberp n) (> n 73)) (return n))
+         (cerror "Enter a number~3*~:[~; a bit larger than ~*~D~]."
+                 'not-a-large-number
+                 :argument n 
+                 :ignore (numberp n)
+                 :ignore n
+                 :allow-other-keys t)
+         (format t "~&Type a large number: ")
+         (setq n (read))
+         (fresh-line)))
+
+ (assure-large-number 'a)
+ |>  Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
+ |>  Restart options:
+ |>   1: Enter a number.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+ |>  Type a large number: |>>88<<|
+⇒  88
+
+ (assure-large-number 37)
+ |>  Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
+ |>  Restart options:
+ |>   1: Enter a number a bit larger than 37.
+ |>   2: Top level.
+ |>  Debug> |>>:continue 1<<|
+ |>  Type a large number: |>>259<<|
+⇒  259
+
    + +

    Affected By::

    + +

    *break-on-signals*. +

    +

    Existing handler bindings. +

    +

    See Also::

    + +

    error +, +format +, +handler-bind +, +*break-on-signals*, simple-type-error +

    +

    Notes::

    + +

    If datum is a condition type rather than a +string, the format directive ~* may be especially +useful in the continue-format-control in order to ignore the +keywords in the initialization argument list. For example: +

    +
    +
    (cerror "enter a new value to replace ~*~s" 
+        'not-a-number
+        :argument a)
+
    + +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/change_002dclass.html b/info/gcl/change_002dclass.html new file mode 100644 index 0000000..3c6233b --- /dev/null +++ b/info/gcl/change_002dclass.html @@ -0,0 +1,169 @@ + + + + + +change-class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.8 change-class [Standard Generic Function]

    + +

    Syntax::

    + +

    change-class instance new-class &key &allow-other-keys ⇒ instance +

    +

    Method Signatures::

    + +

    change-class (instance standard-object) + (new-class standard-class) + &rest initargs +

    +

    change-class (instance t) + (new-class symbol) + &rest initargs +

    +

    Arguments and Values::

    + +

    instance—an object. +

    +

    new-class—a class designator. +

    +

    initargs—an initialization argument list. +

    +

    Description::

    + +

    The generic function change-class changes the +class of an instance to new-class. +It destructively modifies and returns the instance. +

    +

    If in the old class there is any slot of the +same name as a local slot in the new-class, +the value of that slot is retained. This means that if +the slot has a value, the value returned by slot-value +after change-class is invoked is eql to the +value returned by slot-value before change-class is +invoked. Similarly, if the slot was unbound, it remains +unbound. The other slots are initialized as described in +Changing the Class of an Instance. +

    +

    After completing all other actions, change-class invokes +update-instance-for-different-class. The +generic function update-instance-for-different-class can be used +to assign values to slots in the transformed instance. +

    +

    See Initializing Newly Added Local Slots (Changing the Class of an Instance). +

    +

    If the second of the above methods is selected, +that method invokes change-class +on instance, (find-class new-class), +and the initargs. +

    +

    Examples::

    + +
    +
    +
+ (defclass position () ())
+
+ (defclass x-y-position (position)
+     ((x :initform 0 :initarg :x)
+      (y :initform 0 :initarg :y)))
+
+ (defclass rho-theta-position (position)
+     ((rho :initform 0)
+      (theta :initform 0)))
+
+ (defmethod update-instance-for-different-class :before ((old x-y-position) 
+                                                         (new rho-theta-position)
+                                                         &key)
+   ;; Copy the position information from old to new to make new
+   ;; be a rho-theta-position at the same position as old.
+   (let ((x (slot-value old 'x))
+         (y (slot-value old 'y)))
+     (setf (slot-value new 'rho) (sqrt (+ (* x x) (* y y)))
+           (slot-value new 'theta) (atan y x))))
+
+;;; At this point an instance of the class x-y-position can be
+;;; changed to be an instance of the class rho-theta-position using
+;;; change-class:
+
+ (setq p1 (make-instance 'x-y-position :x 2 :y 0))
+
+ (change-class p1 'rho-theta-position)
+
+;;; The result is that the instance bound to p1 is now an instance of
+;;; the class rho-theta-position.   The update-instance-for-different-class
+;;; method performed the initialization of the rho and theta slots based
+;;; on the value of the x and y slots, which were maintained by
+;;; the old instance.
+
+
    + +

    See Also::

    + +

    update-instance-for-different-class +, +Changing the Class of an Instance +

    +

    Notes::

    + +

    The generic function change-class has several semantic +difficulties. First, it performs a destructive operation that can be +invoked within a method on an instance that was used to select that +method. +When multiple methods are involved because methods are being +combined, the methods currently executing or about to be executed may +no longer be applicable. Second, some implementations might use +compiler optimizations of slot access, and when the class of an +instance is changed the assumptions the compiler made might be +violated. This implies that a programmer must not use +change-class inside a method if any +methods for that generic function +access any slots, or the results are undefined. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/char.html b/info/gcl/char.html new file mode 100644 index 0000000..7a9bd17 --- /dev/null +++ b/info/gcl/char.html @@ -0,0 +1,108 @@ + + + + + +char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.6 char, schar [Accessor]

    + +

    char string index ⇒ character +

    +

    schar string index ⇒ character +

    +

    (setf (char string index) new-character)
    (setf (schar string index) new-character)
    +

    +

    Arguments and Values::

    + +

    string—for char, a string; + for schar, a simple string. +

    +

    index—a valid array index for the string. +

    +

    character, new-character—a character. +

    +

    Description::

    + +

    char and schar access the element of string +specified by index. +

    +

    char ignores fill pointers when accessing elements. +

    +

    Examples::

    + +
    +
     (setq my-simple-string (make-string 6 :initial-element #\A)) ⇒  "AAAAAA"
+ (schar my-simple-string 4) ⇒  #\A
+ (setf (schar my-simple-string 4) #\B) ⇒  #\B
+ my-simple-string ⇒  "AAAABA"
+ (setq my-filled-string
+       (make-array 6 :element-type 'character
+                     :fill-pointer 5
+                     :initial-contents my-simple-string))
+⇒  "AAAAB"
+ (char my-filled-string 4) ⇒  #\B
+ (char my-filled-string 5) ⇒  #\A
+ (setf (char my-filled-string 3) #\C) ⇒  #\C
+ (setf (char my-filled-string 5) #\D) ⇒  #\D
+ (setf (fill-pointer my-filled-string) 6) ⇒  6
+ my-filled-string ⇒  "AAACBD"
+
    + +

    See Also::

    + +

    aref +, +elt +, +

    +

    Compiler Terminology +

    +

    Notes::

    + +
    +
     (char s j) ≡ (aref (the string s) j)
+
    + + + + + + diff --git a/info/gcl/char_002dcode.html b/info/gcl/char_002dcode.html new file mode 100644 index 0000000..7e8a0ba --- /dev/null +++ b/info/gcl/char_002dcode.html @@ -0,0 +1,81 @@ + + + + + +char-code (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.16 char-code [Function]

    + +

    char-code character ⇒ code +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    code—a character code. +

    +

    Description::

    + +

    char-code returns the code attribute of character. +

    +

    Examples::

    + +
    +
    ;; An implementation using ASCII character encoding 
+;; might return these values:
+(char-code #\$) ⇒  36
+(char-code #\a) ⇒  97
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    +

    See Also::

    + +

    char-code-limit +

    + + + + + diff --git a/info/gcl/char_002dcode_002dlimit.html b/info/gcl/char_002dcode_002dlimit.html new file mode 100644 index 0000000..c3b4d7a --- /dev/null +++ b/info/gcl/char_002dcode_002dlimit.html @@ -0,0 +1,71 @@ + + + + + +char-code-limit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.19 char-code-limit [Constant Variable]

    + +

    Constant Value::

    + +

    A non-negative integer, the exact magnitude of which +is implementation-dependent, but which is not less +than 96 (the number of standard characters). +

    +

    Description::

    + +

    The upper exclusive bound on the value returned by +the function char-code. +

    +

    See Also::

    + +

    char-code +

    +

    Notes::

    + +

    The value of char-code-limit might be larger than the actual +number of characters supported by the implementation. +

    + + + + + diff --git a/info/gcl/char_002dint.html b/info/gcl/char_002dint.html new file mode 100644 index 0000000..285d05d --- /dev/null +++ b/info/gcl/char_002dint.html @@ -0,0 +1,87 @@ + + + + + +char-int (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.17 char-int [Function]

    + +

    char-int character ⇒ integer +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    integer—a non-negative integer. +

    +

    Description::

    + +

    Returns a non-negative integer encoding the character object. +The manner in which the integer is computed is implementation-dependent. +In contrast to sxhash, the result is not guaranteed to be independent +of the particular Lisp image. +

    +

    If character has no implementation-defined attributes, +the results of char-int and char-code are the same. +

    +
    +
     (char= c1 c2) ≡ (= (char-int c1) (char-int c2))
+
    + +

    for characters c1 and c2. +

    +

    Examples::

    + +
    +
     (char-int #\A) ⇒  65       ; implementation A
+ (char-int #\A) ⇒  577      ; implementation B
+ (char-int #\A) ⇒  262145   ; implementation C
+
    + +

    See Also::

    + +

    char-code +

    + + + + + diff --git a/info/gcl/char_002dname.html b/info/gcl/char_002dname.html new file mode 100644 index 0000000..9b02355 --- /dev/null +++ b/info/gcl/char_002dname.html @@ -0,0 +1,120 @@ + + + + + +char-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.20 char-name [Function]

    + +

    char-name character ⇒ name +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    name—a string or nil. +

    +

    Description::

    + +

    Returns a string that is the name of the character, +or nil if the character has no name. +

    +

    All non-graphic characters are required to have names +unless they have some implementation-defined attribute +which is not null. Whether or not other characters +have names is implementation-dependent. +

    +

    The standard characters +<Newline> and <Space> have the respective names "Newline" and "Space". +The semi-standard characters +<Tab>, <Page>, <Rubout>, <Linefeed>, <Return>, and <Backspace> +(if they are supported by the implementation) +have the respective names +"Tab", "Page", "Rubout", "Linefeed", "Return", and "Backspace" +(in the indicated case, even though name lookup by “#\” +and by the function name-char is not case sensitive). +

    +

    Examples::

    + +
    +
     (char-name #\ ) ⇒  "Space"
+ (char-name #\Space) ⇒  "Space"
+ (char-name #\Page) ⇒  "Page"
+
+ (char-name #\a)
+⇒  NIL
+OR⇒ "LOWERCASE-a"
+OR⇒ "Small-A"
+OR⇒ "LA01"
+
+ (char-name #\A)
+⇒  NIL
+OR⇒ "UPPERCASE-A"
+OR⇒ "Capital-A"
+OR⇒ "LA02"
+
+ ;; Even though its CHAR-NAME can vary, #\A prints as #\A
+ (prin1-to-string (read-from-string (format nil "#\\~A" (or (char-name #\A) "A"))))
+⇒  "#\\A"
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    +

    See Also::

    + +

    name-char +, +Printing Characters +

    +

    Notes::

    + +

    Non-graphic +characters having names are written by the Lisp printer +as “#\” followed by the their name; see Printing Characters. +

    + + + + + diff --git a/info/gcl/char_002dupcase.html b/info/gcl/char_002dupcase.html new file mode 100644 index 0000000..b0571e3 --- /dev/null +++ b/info/gcl/char_002dupcase.html @@ -0,0 +1,121 @@ + + + + + +char-upcase (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.14 char-upcase, char-downcase [Function]

    + +

    char-upcase character ⇒ corresponding-character +

    +

    char-downcase character ⇒ corresponding-character +

    +

    Arguments and Values::

    + +

    character, corresponding-character—a character. +

    +

    Description::

    + +

    If character is a lowercase character, +char-upcase returns the corresponding uppercase character. +Otherwise, char-upcase just returns the given character. +

    +

    If character is an uppercase character, +char-downcase returns the corresponding lowercase character. +Otherwise, char-downcase just returns the given character. +

    +

    The result only ever differs from character +in its code attribute; +all implementation-defined attributes are preserved. +

    +

    Examples::

    + +
    +
     (char-upcase #\a) ⇒  #\A
+ (char-upcase #\A) ⇒  #\A
+ (char-downcase #\a) ⇒  #\a
+ (char-downcase #\A) ⇒  #\a
+ (char-upcase #\9) ⇒  #\9
+ (char-downcase #\9) ⇒  #\9
+ (char-upcase #\@) ⇒  #\@
+ (char-downcase #\@) ⇒  #\@
+ ;; Note that this next example might run for a very long time in 
+ ;; some implementations if CHAR-CODE-LIMIT happens to be very large
+ ;; for that implementation.
+ (dotimes (code char-code-limit)
+   (let ((char (code-char code)))
+     (when char
+       (unless (cond ((upper-case-p char) (char= (char-upcase (char-downcase char)) char))
+                     ((lower-case-p char) (char= (char-downcase (char-upcase char)) char))
+                     (t (and (char= (char-upcase (char-downcase char)) char)
+                             (char= (char-downcase (char-upcase char)) char))))
+         (return char)))))
+⇒  NIL
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    +

    See Also::

    + +

    upper-case-p +, +alpha-char-p +, +Characters With Case, +Documentation of Implementation-Defined Scripts +

    +

    Notes::

    + +

    If the corresponding-char is different than character, +then both the character and the corresponding-char have case. +

    +

    Since char-equal ignores the case of the characters it compares, +the corresponding-character is always the same as character +under char-equal. +

    + + + + + diff --git a/info/gcl/char_003d.html b/info/gcl/char_003d.html new file mode 100644 index 0000000..ca85584 --- /dev/null +++ b/info/gcl/char_003d.html @@ -0,0 +1,248 @@ + + + + + +char= (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.5 char=, char/=, char<, char>, char<=, char>=,

    +

    char-equal, char-not-equal, char-lessp, char-greaterp, char-not-greaterp,

    +

    char-not-lessp

    +

    [Function] +

    +

    char= &rest characters^+ ⇒ generalized-boolean +

    +

    char/= &rest characters^+ ⇒ generalized-boolean +

    +

    char< &rest characters^+ ⇒ generalized-boolean +

    +

    char> &rest characters^+ ⇒ generalized-boolean +

    +

    char<= &rest characters^+ ⇒ generalized-boolean +

    +

    char>= &rest characters^+ ⇒ generalized-boolean +

    +

    char-equal &rest characters^+ ⇒ generalized-boolean +

    +

    char-not-equal &rest characters^+ ⇒ generalized-boolean +

    +

    char-lessp &rest characters^+ ⇒ generalized-boolean +

    +

    char-greaterp &rest characters^+ ⇒ generalized-boolean +

    +

    char-not-greaterp &rest characters^+ ⇒ generalized-boolean +

    +

    char-not-lessp &rest characters^+ ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    These predicates compare characters. +

    +

    char= returns true if all characters are the same; +otherwise, it returns false. +

    +

    If two characters differ +in any implementation-defined attributes, +then they are not char=. +

    +

    char/= returns true if all characters are different; +otherwise, it returns false. +

    +

    char< returns true if the characters are monotonically increasing; +otherwise, it returns false. +

    +

    If two characters +have identical implementation-defined attributes, +then their ordering by char< is +consistent with the numerical ordering by the predicate < on their codes. +

    +

    char> returns true if the characters are monotonically decreasing; +otherwise, it returns false. +

    +

    If two characters have +identical implementation-defined attributes, +then their ordering by char> is +consistent with the numerical ordering by the predicate > on their codes. +

    +

    char<= returns true +if the characters are monotonically nondecreasing; +otherwise, it returns false. +

    +

    If two characters have +identical implementation-defined attributes, +then their ordering by char<= is +consistent with the numerical ordering by the predicate <= on their codes. +

    +

    char>= returns true +if the characters are monotonically nonincreasing; +otherwise, it returns false. +

    +

    If two characters have +identical implementation-defined attributes, +then their ordering by char>= is +consistent with the numerical ordering by the predicate >= on their codes. +

    +

    char-equal, + char-not-equal, + char-lessp, + char-greaterp, + char-not-greaterp, +and char-not-lessp +are similar to + char=, + char/=, + char<, + char>, + char<=, + char>=, +respectively, +except that they ignore differences in case and +

    +

    might have an implementation-defined behavior +for non-simple characters. +For example, an implementation might define that +char-equal, etc. ignore certain +implementation-defined attributes. +The effect, if any, +of each implementation-defined attribute +upon these functions must be specified as part of the definition of that attribute. +

    +

    Examples::

    + +
    +
     (char= #\d #\d) ⇒  true
+ (char= #\A #\a) ⇒  false
+ (char= #\d #\x) ⇒  false
+ (char= #\d #\D) ⇒  false
+ (char/= #\d #\d) ⇒  false
+ (char/= #\d #\x) ⇒  true
+ (char/= #\d #\D) ⇒  true
+ (char= #\d #\d #\d #\d) ⇒  true
+ (char/= #\d #\d #\d #\d) ⇒  false
+ (char= #\d #\d #\x #\d) ⇒  false
+ (char/= #\d #\d #\x #\d) ⇒  false
+ (char= #\d #\y #\x #\c) ⇒  false
+ (char/= #\d #\y #\x #\c) ⇒  true
+ (char= #\d #\c #\d) ⇒  false
+ (char/= #\d #\c #\d) ⇒  false
+ (char< #\d #\x) ⇒  true
+ (char<= #\d #\x) ⇒  true
+ (char< #\d #\d) ⇒  false
+ (char<= #\d #\d) ⇒  true
+ (char< #\a #\e #\y #\z) ⇒  true
+ (char<= #\a #\e #\y #\z) ⇒  true
+ (char< #\a #\e #\e #\y) ⇒  false
+ (char<= #\a #\e #\e #\y) ⇒  true
+ (char> #\e #\d) ⇒  true
+ (char>= #\e #\d) ⇒  true
+ (char> #\d #\c #\b #\a) ⇒  true
+ (char>= #\d #\c #\b #\a) ⇒  true
+ (char> #\d #\d #\c #\a) ⇒  false
+ (char>= #\d #\d #\c #\a) ⇒  true
+ (char> #\e #\d #\b #\c #\a) ⇒  false
+ (char>= #\e #\d #\b #\c #\a) ⇒  false
+ (char> #\z #\A) ⇒  implementation-dependent
+ (char> #\Z #\a) ⇒  implementation-dependent
+ (char-equal #\A #\a) ⇒  true
+ (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char-lessp)
+⇒  (#\A #\a #\b #\B #\c #\C)
+ (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char<)
+⇒  (#\A #\B #\C #\a #\b #\c) ;Implementation A
+⇒  (#\a #\b #\c #\A #\B #\C) ;Implementation B
+⇒  (#\a #\A #\b #\B #\c #\C) ;Implementation C
+⇒  (#\A #\a #\B #\b #\C #\c) ;Implementation D
+⇒  (#\A #\B #\a #\b #\C #\c) ;Implementation E
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type program-error + if at least one character is not supplied. +

    +

    See Also::

    + +

    Character Syntax, +Documentation of Implementation-Defined Scripts +

    +

    Notes::

    + +

    If characters differ in their code attribute +or any implementation-defined attribute, +they are considered to be different by char=. +

    +

    There is no requirement that (eq c1 c2) be true merely because +(char= c1 c2) is true. While eq can distinguish two +characters +that char= does not, it is distinguishing them not +as characters, but in some sense on the basis of a lower level +implementation characteristic. +If (eq c1 c2) is true, +then (char= c1 c2) is also true. +eql and equal +compare characters in the same +way that char= does. +

    +

    The manner in which case is used by + char-equal, + char-not-equal, + char-lessp, + char-greaterp, + char-not-greaterp, + and char-not-lessp +implies an ordering for standard characters such that +A=a, B=b, and so on, up to Z=z, and furthermore either +9<A or Z<0. +

    +
    +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    + + + + + diff --git a/info/gcl/character-_0028System-Class_0029.html b/info/gcl/character-_0028System-Class_0029.html new file mode 100644 index 0000000..2eb9a53 --- /dev/null +++ b/info/gcl/character-_0028System-Class_0029.html @@ -0,0 +1,70 @@ + + + + + +character (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.1 character [System Class]

    + +

    Class Precedence List::

    +

    character, +t +

    +

    Description::

    + +

    A character is an object that +represents a unitary token in an aggregate quantity of text; +see Character Concepts. +

    +

    The types base-char and extended-char +form an exhaustive partition of the type character. +

    +

    See Also::

    + +

    Character Concepts, +Sharpsign Backslash, +Printing Characters +

    + + + + + diff --git a/info/gcl/character.html b/info/gcl/character.html new file mode 100644 index 0000000..6eefdfd --- /dev/null +++ b/info/gcl/character.html @@ -0,0 +1,89 @@ + + + + + +character (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.6 character [Function]

    + +

    character character ⇒ denoted-character +

    +

    Arguments and Values::

    + +

    character—a character designator. +

    +

    denoted-character—a character. +

    +

    Description::

    + +

    Returns the character denoted by the character designator. +

    +

    Examples::

    + +
    +
     (character #\a) ⇒  #\a
+ (character "a") ⇒  #\a
+ (character 'a) ⇒  #\A
+ (character '\a) ⇒  #\a
+ (character 65.) is an error.
+ (character 'apple) is an error.
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if object is not a character designator. +

    +

    See Also::

    + +

    coerce +

    +

    Notes::

    + +
    +
     (character object) ≡ (coerce object 'character)
+
    + + + + + + diff --git a/info/gcl/characterp.html b/info/gcl/characterp.html new file mode 100644 index 0000000..a82f8bb --- /dev/null +++ b/info/gcl/characterp.html @@ -0,0 +1,89 @@ + + + + + +characterp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.7 characterp [Function]

    + +

    characterp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type character; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (characterp #\a) ⇒  true
+ (characterp 'a) ⇒  false
+ (characterp "a") ⇒  false
+ (characterp 65.) ⇒  false
+ (characterp #\Newline) ⇒  true
+ ;; This next example presupposes an implementation 
+ ;; in which #\Rubout is an implementation-defined character.
+ (characterp #\Rubout) ⇒  true
+
    + +

    See Also::

    + +

    character + (type and function), +typep +

    +

    Notes::

    + +
    +
     (characterp object) ≡ (typep object 'character)
+
    + + + + + + diff --git a/info/gcl/check_002dtype.html b/info/gcl/check_002dtype.html new file mode 100644 index 0000000..2af1672 --- /dev/null +++ b/info/gcl/check_002dtype.html @@ -0,0 +1,187 @@ + + + + + +check-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.13 check-type [Macro]

    + +

    check-type place typespec [string] ⇒ nil +

    +

    Arguments and Values::

    + +

    place—a place. +

    +

    typespec—a type specifier. +

    +

    string—a string; evaluated. +

    +

    Description::

    + +

    check-type signals a correctable error +of type type-error if the contents of place are not +of the type typespec. +

    +

    check-type can return only if the store-value restart is invoked, +either explicitly from a handler + or implicitly as one of the options offered by the debugger. +If the store-value restart is invoked, +check-type stores the new value +that is the argument to the restart invocation +(or that is prompted for interactively by the debugger) +in place and starts over, +checking the type of the new value +and signaling another error if it is still not of the desired type. +

    +

    The first time place is evaluated, +it is evaluated by normal evaluation rules. +It is later evaluated as a place +if the type check fails and the store-value restart is used; +see Evaluation of Subforms to Places. +

    +

    string should be an English description of the type, +starting with an indefinite article (“a” or “an”). +If string is not supplied, +it is computed automatically from typespec. +The automatically generated message mentions + place, + its contents, + and the desired type. +An implementation may choose to generate +a somewhat differently worded error message +if it recognizes that place is of a particular form, +such as one of the arguments to the function that called check-type. +string is allowed because some applications of check-type +may require a more specific description of what is wanted +than can be generated automatically from typespec. +

    +

    Examples::

    + +
    +
     (setq aardvarks '(sam harry fred))
+⇒  (SAM HARRY FRED)
+ (check-type aardvarks (array * (3)))
+ |>  Error: The value of AARDVARKS, (SAM HARRY FRED),
+ |>         is not a 3-long array.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a value to use instead.
+ |>   2: Return to Lisp Toplevel.
+ |>  Debug> |>>:CONTINUE 1<<|
+ |>  Use Value: |>>#(SAM FRED HARRY)<<|
+⇒  NIL
+ aardvarks
+⇒  #<ARRAY-T-3 13571>
+ (map 'list #'identity aardvarks)
+⇒  (SAM FRED HARRY)
+ (setq aardvark-count 'foo)
+⇒  FOO
+ (check-type aardvark-count (integer 0 *) "A positive integer")
+ |>  Error: The value of AARDVARK-COUNT, FOO, is not a positive integer.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a value to use instead.
+ |>   2: Top level.
+ |>  Debug> |>>:CONTINUE 2<<|
+
    + +
    +
     (defmacro define-adder (name amount)
+   (check-type name (and symbol (not null)) "a name for an adder function")
+   (check-type amount integer)
+   `(defun ,name (x) (+ x ,amount)))
+
+ (macroexpand '(define-adder add3 3))
+⇒  (defun add3 (x) (+ x 3))
+
+ (macroexpand '(define-adder 7 7))
+ |>  Error: The value of NAME, 7, is not a name for an adder function.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a value to use instead.
+ |>   2: Top level.
+ |>  Debug> |>>:Continue 1<<|
+ |>  Specify a value to use instead.
+ |>  Type a form to be evaluated and used instead: |>>'ADD7<<|
+⇒  (defun add7 (x) (+ x 7))
+
+ (macroexpand '(define-adder add5 something))
+ |>  Error: The value of AMOUNT, SOMETHING, is not an integer.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a value to use instead.
+ |>   2: Top level.
+ |>  Debug> |>>:Continue 1<<|
+ |>  Type a form to be evaluated and used instead: |>>5<<|
+⇒  (defun add5 (x) (+ x 5))
+
+
    + +

    Control is transferred to a handler. +

    +

    Side Effects::

    + +

    The debugger might be entered. +

    +

    Affected By::

    + +

    *break-on-signals* +

    +

    The implementation. +

    +

    See Also::

    + +

    Condition System Concepts +

    +

    Notes::

    + +
    +
     (check-type place typespec)
+ ≡ (assert (typep place 'typespec) (place)
+            'type-error :datum place :expected-type 'typespec)
+
    + +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/cis.html b/info/gcl/cis.html new file mode 100644 index 0000000..368ad01 --- /dev/null +++ b/info/gcl/cis.html @@ -0,0 +1,75 @@ + + + + + +cis (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.45 cis [Function]

    + +

    cis radians ⇒ number +

    +

    Arguments and Values::

    + +

    radians—a real. +

    +

    number—a complex. +

    +

    Description::

    + +

    cis returns the value of~e^i\cdot radians, +which is a complex in which the +real part is equal to the cosine of radians, and the +imaginary part is equal to the sine of radians. +

    +

    Examples::

    +
    +
     (cis 0) ⇒  #C(1.0 0.0)
+
    + +

    See Also::

    + +

    Rule of Float Substitutability +

    + + + + + diff --git a/info/gcl/class.html b/info/gcl/class.html new file mode 100644 index 0000000..d434d0e --- /dev/null +++ b/info/gcl/class.html @@ -0,0 +1,65 @@ + + + + + +class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.7 class [System Class]

    + +

    Class Precedence List::

    +

    class, +

    +

    standard-object, +

    +

    t +

    +

    Description::

    + +

    The type class represents objects that determine the structure +and behavior of their instances. Associated with an object +of type class is information describing its place in the +directed acyclic graph of classes, its slots, and its options. +

    + + + + + diff --git a/info/gcl/class_002dname.html b/info/gcl/class_002dname.html new file mode 100644 index 0000000..2e35b9b --- /dev/null +++ b/info/gcl/class_002dname.html @@ -0,0 +1,83 @@ + + + + + +class-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.37 class-name [Standard Generic Function]

    + +

    Syntax::

    + +

    class-name class ⇒ name +

    +

    Method Signatures::

    + +

    class-name (class class) +

    +

    Arguments and Values::

    + +

    class—a class object. +

    +

    name—a symbol. +

    +

    Description::

    + +

    Returns the name of the given class. +

    +

    See Also::

    + +

    find-class +, +Classes +

    +

    Notes::

    + +

    If S is a symbol such that S =(class-name C) +and C =(find-class S), then S is the proper name of C. +For further discussion, see Classes. +

    +

    The name of an anonymous class is nil. +

    + + + + + diff --git a/info/gcl/class_002dof.html b/info/gcl/class_002dof.html new file mode 100644 index 0000000..9b06044 --- /dev/null +++ b/info/gcl/class_002dof.html @@ -0,0 +1,86 @@ + + + + + +class-of (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.39 class-of [Function]

    + +

    class-of object ⇒ class +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    class—a class object. +

    +

    Description::

    + +

    Returns the class of which the object is +a direct instance. +

    +

    Examples::

    + +
    +
     (class-of 'fred) ⇒  #<BUILT-IN-CLASS SYMBOL 610327300>
+ (class-of 2/3) ⇒  #<BUILT-IN-CLASS RATIO 610326642>
+
+ (defclass book () ()) ⇒  #<STANDARD-CLASS BOOK 33424745>
+ (class-of (make-instance 'book)) ⇒  #<STANDARD-CLASS BOOK 33424745>
+
+ (defclass novel (book) ()) ⇒  #<STANDARD-CLASS NOVEL 33424764>
+ (class-of (make-instance 'novel)) ⇒  #<STANDARD-CLASS NOVEL 33424764>
+
+ (defstruct kons kar kdr) ⇒  KONS
+ (class-of (make-kons :kar 3 :kdr 4)) ⇒  #<STRUCTURE-CLASS KONS 250020317>
+
    + +

    See Also::

    + +

    make-instance +, +type-of +

    + + + + + diff --git a/info/gcl/clear_002dinput.html b/info/gcl/clear_002dinput.html new file mode 100644 index 0000000..e4ea727 --- /dev/null +++ b/info/gcl/clear_002dinput.html @@ -0,0 +1,118 @@ + + + + + +clear-input (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.35 clear-input [Function]

    + +

    clear-input &optional input-stream ⇒ nil +

    +

    Arguments and Values::

    + +

    input-stream—an input stream designator. + The default is standard input. +

    +

    Description::

    + +

    Clears any available input from input-stream. +

    +

    If clear-input does not make sense for input-stream, +then clear-input does nothing. +

    +

    Examples::

    +
    +
    ;; The exact I/O behavior of this example might vary from implementation
+;; to implementation depending on the kind of interactive buffering that
+;; occurs.  (The call to SLEEP here is intended to help even out the 
+;; differences in implementations which do not do line-at-a-time buffering.)
+
+(defun read-sleepily (&optional (clear-p nil) (zzz 0))
+  (list (progn (print '>) (read))
+        ;; Note that input typed within the first ZZZ seconds 
+        ;; will be discarded.
+        (progn (print '>) 
+               (if zzz (sleep zzz))
+               (print '>>)
+               (if clear-p (clear-input))
+               (read))))
+
+(read-sleepily)
+ |>  > |>>10<<|
+ |>  >
+ |>  >> |>>20<<|
+⇒  (10 20)
+
+(read-sleepily t)
+ |>  > |>>10<<|
+ |>  >
+ |>  >> |>>20<<|
+⇒  (10 20)
+
+(read-sleepily t 10)
+ |>  > |>>10<<|
+ |>  > |>>20<<|  ; Some implementations won't echo typeahead here.
+ |>  >> |>>30<<|
+⇒  (10 30)
+
    + +

    Side Effects::

    + +

    The input-stream is modified. +

    +

    Affected By::

    + +

    *standard-input* +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if input-stream is not a stream designator. +

    +

    See Also::

    + +

    clear-output +

    + + + + + diff --git a/info/gcl/close.html b/info/gcl/close.html new file mode 100644 index 0000000..0d32aa6 --- /dev/null +++ b/info/gcl/close.html @@ -0,0 +1,125 @@ + + + + + +close (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.32 close [Function]

    + +

    close stream &key abort ⇒ result +

    +

    Arguments and Values::

    + +

    stream—a stream (either open or closed). +

    +

    abort—a generalized boolean. + The default is false. +

    +

    result—t if the stream was open at the time it was + received as an argument, + or implementation-dependent otherwise. +

    +

    Description::

    + +

    close closes stream. +Closing a stream means +that it may no longer be used in input or output operations. +The act of closing a file stream +ends the association between the stream and its associated file; +the transaction with the file system is terminated, +and input/output may no longer be performed on the stream. +

    +

    If abort is true, an attempt is made to clean up any side +effects of having created stream. +If stream performs output to a file +that was created when the stream was created, the +file is deleted and any previously existing file is not superseded. +

    +

    It is permissible to close an already closed stream, +but in that case the result is implementation-dependent. +

    +

    After stream is closed, it is still possible to perform +the following query operations upon it: +

    +

    streamp, pathname, truename, +merge-pathnames, pathname-host, pathname-device, +pathname-directory,pathname-name, +pathname-type, pathname-version, namestring, +file-namestring, directory-namestring, +host-namestring, enough-namestring, open, +probe-file, and directory. +

    +

    The effect of close on a constructed stream is + to close the argument stream only. +There is no effect on the constituents of composite streams. +

    +

    For a stream created with make-string-output-stream, +the result of get-output-stream-string is unspecified after close. +

    +

    Examples::

    + +
    +
     (setq s (make-broadcast-stream)) ⇒  #<BROADCAST-STREAM>
+ (close s) ⇒  T
+ (output-stream-p s) ⇒  true
+
    + +

    Side Effects::

    + +

    The stream is closed (if necessary). +If abort is true and the stream is +an output file stream, its associated file +might be deleted. +

    +

    See Also::

    + +

    open +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/clrhash.html b/info/gcl/clrhash.html new file mode 100644 index 0000000..3f8fe4b --- /dev/null +++ b/info/gcl/clrhash.html @@ -0,0 +1,78 @@ + + + + + +clrhash (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.13 clrhash [Function]

    + +

    clrhash hash-table ⇒ hash-table +

    +

    Arguments and Values::

    + +

    hash-table—a hash table. +

    +

    Description::

    + +

    Removes all entries from hash-table, +and then returns that empty hash table. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32004073>
+ (dotimes (i 100) (setf (gethash i table) (format nil "~R" i))) ⇒  NIL
+ (hash-table-count table) ⇒  100
+ (gethash 57 table) ⇒  "fifty-seven", true
+ (clrhash table) ⇒  #<HASH-TABLE EQL 0/120 32004073>
+ (hash-table-count table) ⇒  0
+ (gethash 57 table) ⇒  NIL, false
+
    + +

    Side Effects::

    + +

    The hash-table is modified. +

    + + + + + diff --git a/info/gcl/code_002dchar.html b/info/gcl/code_002dchar.html new file mode 100644 index 0000000..3bbe21b --- /dev/null +++ b/info/gcl/code_002dchar.html @@ -0,0 +1,81 @@ + + + + + +code-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.18 code-char [Function]

    + +

    code-char code ⇒ char-p +

    +

    Arguments and Values::

    + +

    code—a character code. +

    +

    char-p—a character or nil. +

    +

    Description::

    + +

    Returns a character with the code attribute given by code. +If no such character exists and one cannot be created, nil is returned. +

    +

    Examples::

    + +
    +
    (code-char 65.) ⇒  #\A  ;in an implementation using ASCII codes
+(code-char (char-code #\Space)) ⇒  #\Space  ;in any implementation
+
    + +

    Affected By::

    + +

    The implementation’s character encoding. +

    +

    See Also::

    + +

    char-code +

    +

    Notes::

    + + + + + + diff --git a/info/gcl/coerce.html b/info/gcl/coerce.html new file mode 100644 index 0000000..ac3d43d --- /dev/null +++ b/info/gcl/coerce.html @@ -0,0 +1,220 @@ + + + + + +coerce (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.24 coerce [Function]

    + +

    coerce object result-type ⇒ result +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    result-type—a type specifier. +

    +

    result—an object, of type result-type + except in situations described in Rule of Canonical Representation for Complex Rationals. +

    +

    Description::

    + +

    Coerces the object to type result-type. +

    +

    If object is already of type result-type, +the object itself is returned, regardless of whether it +would have been possible in general to coerce an object of +some other type to result-type. +

    +

    Otherwise, the object is coerced to type result-type +according to the following rules: +

    +
    +
    sequence
    +
    +

    If the result-type is a recognizable subtype of list, +and the object is a sequence, +then the result is a list +that has the same elements as object. +

    +

    If the result-type is a recognizable subtype of vector, +and the object is a sequence, +then the result is a vector +that has the same elements as object. +If result-type is a specialized type, +the result has an actual array element type that is the result of +upgrading the element type part of that specialized type. +If no element type is specified, the element type defaults to t. +If the implementation cannot determine the element type, an error is signaled. +

    +
    +
    character
    +

    If the result-type is character +and the object is a character designator, +the result is the character it denotes. +

    +
    +
    complex
    +

    If the result-type is complex +and the object is a number, +then the result is obtained by constructing a complex +whose real part is the object and +whose imaginary part is the result of coercing an integer zero +to the type of the object (using coerce). +(If the real part is a rational, however, +then the result must be represented as a rational rather +than a complex; see Rule of Canonical Representation for Complex Rationals. +So, for example, (coerce 3 'complex) is permissible, +but will return 3, which is not a complex.) +

    +
    +
    float
    +

    If the result-type is any of float, + short-float, + single-float, + double-float, + long-float, +and the object is a +

    +

    real, +

    +

    then the result is a float of type result-type +which is equal in sign and magnitude to the object to whatever degree of +representational precision is permitted by that float representation. +(If the result-type is float +and object is not already a float, +then the result is a single float.) +

    +
    +
    function
    +

    If the result-type is function, +and object is any +

    +

    function name +

    +

    that is fbound +but that is globally defined neither as a macro name nor as a special operator, +then the result is the functional value of object. +

    +

    If the result-type is function, +and object is a lambda expression, +then the result is a closure of object +in the null lexical environment. +

    +
    +
    t
    +

    Any object can be coerced to an object of type t. +In this case, the object is simply returned. +

    +
    +
    + +

    Examples::

    + +
    +
     (coerce '(a b c) 'vector) ⇒  #(A B C)
+ (coerce 'a 'character) ⇒  #\A
+ (coerce 4.56 'complex) ⇒  #C(4.56 0.0)
+ (coerce 4.5s0 'complex) ⇒  #C(4.5s0 0.0s0)
+ (coerce 7/2 'complex) ⇒  7/2
+ (coerce 0 'short-float) ⇒  0.0s0
+ (coerce 3.5L0 'float) ⇒  3.5L0
+ (coerce 7/2 'float) ⇒  3.5
+ (coerce (cons 1 2) t) ⇒  (1 . 2)
+
    + +

    All the following forms should signal an error: +

    +
    +
     (coerce '(a b c) '(vector * 4))
+ (coerce #(a b c) '(vector * 4))
+ (coerce '(a b c) '(vector * 2))
+ (coerce #(a b c) '(vector * 2))
+ (coerce "foo" '(string 2))
+ (coerce #(#\a #\b #\c) '(string 2))
+ (coerce '(0 1) '(simple-bit-vector 3))
+
    + +

    Exceptional Situations::

    + +

    If a coercion is not possible, an error of type type-error is signaled. +

    +

    (coerce x 'nil) always signals an error of type type-error. +

    +

    An error +of type error is signaled +if the result-type is function but +object is a symbol that is not fbound or +if the symbol names a macro or a special operator. +

    +

    An error of type type-error should be signaled if result-type +specifies the number of elements and object is of a different length. +

    +

    See Also::

    + +

    rational (Function) +, +floor +, +char-code +, +char-int +

    +

    Notes::

    + +

    Coercions from floats to rationals +and from ratios to integers +are not provided because of rounding problems. +

    +
    +
     (coerce x 't) ≡ (identity x) ≡ x
+
    + +
    +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    + + + + + diff --git a/info/gcl/compile.html b/info/gcl/compile.html new file mode 100644 index 0000000..89dc000 --- /dev/null +++ b/info/gcl/compile.html @@ -0,0 +1,153 @@ + + + + + +compile (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.3 compile [Function]

    + +

    compile name &optional definition ⇒ function, warnings-p, failure-p +

    +

    Arguments and Values::

    + +

    name—a function name, or nil. +

    +

    definition—a lambda expression or a function. + The default is the function definition of name if it names a function, + or the macro function of name if it names a macro. + The consequences are undefined if no definition is supplied + when the name is nil. +

    +

    function—the function-name, +

    +

    or a compiled function. +

    +

    warnings-p—a generalized boolean. +

    +

    failure-p—a generalized boolean. +

    +

    Description::

    + +

    Compiles an interpreted function. +

    +

    compile produces a compiled function from definition. +If the definition is a lambda expression, +it is coerced to a function. +

    +

    If the definition is already a compiled function, +compile either produces that function itself (i.e., is an identity operation) +or an equivalent function. +

    +

    [Editorial Note by KMP: There are a number of ambiguities here that still need resolution.] +If the name is nil, +the resulting compiled function is returned directly as the primary value. +If a non-nil name is given, +then the resulting compiled function replaces +the existing function definition of name +and the name is returned as the primary value; +if name is a symbol that names a macro, +its macro function is updated +and the name is returned as the primary value. +

    +

    Literal objects appearing in code processed by +the compile function are neither copied nor coalesced. +The code resulting from the execution of compile +references objects that are eql to the corresponding +objects in the source code. +

    +

    compile is permitted, but not required, to establish +a handler for conditions of type error. +For example, the handler might issue a warning and +restart compilation from some implementation-dependent point +in order to let the compilation proceed without manual intervention. +

    +

    The secondary value, warnings-p, is false +if no conditions of type error or warning +were detected by the compiler, and true otherwise. +

    +

    The tertiary value, failure-p, is false +if no conditions of type error or warning +(other than style-warning) +were detected by the compiler, and true otherwise. +

    +

    Examples::

    + +
    +
     (defun foo () "bar") ⇒  FOO
+ (compiled-function-p #'foo) ⇒  implementation-dependent
+ (compile 'foo) ⇒  FOO 
+ (compiled-function-p #'foo) ⇒  true
+ (setf (symbol-function 'foo)
+       (compile nil '(lambda () "replaced"))) ⇒  #<Compiled-Function>
+ (foo) ⇒  "replaced"
+
    + +

    Affected By::

    + +

    *error-output*, +

    +

    *macroexpand-hook*. +

    +

    The presence of macro definitions and proclamations. +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if the lexical environment surrounding the +function to be compiled contains any bindings other than those for +macros, symbol macros, or declarations. +

    +

    For information about errors detected during the compilation process, +see Exceptional Situations in the Compiler. +

    +

    See Also::

    + +

    compile-file +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/compile_002dfile.html b/info/gcl/compile_002dfile.html new file mode 100644 index 0000000..2a55484 --- /dev/null +++ b/info/gcl/compile_002dfile.html @@ -0,0 +1,197 @@ + + + + + +compile-file (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.1 compile-file [Function]

    + +

    compile-file input-file &key output-file verbose + print external-format
    + ⇒ output-truename, warnings-p, failure-p +

    +

    Arguments and Values::

    + +

    input-file—a pathname designator. + (Default fillers for unspecified components are taken from + *default-pathname-defaults*.) +

    +

    output-file—a pathname designator. + The default is implementation-defined. +

    +

    verbose—a generalized boolean. + The default is the value of *compile-verbose*. +

    +

    print—a generalized boolean. + The default is the value of *compile-print*. +

    +

    external-format—an external file format designator. + The default is :default. +

    +

    output-truename—a pathname (the truename of the output file), + or nil. +

    +

    warnings-p—a generalized boolean. +

    +

    failure-p—a generalized boolean. +

    +

    Description::

    + +

    compile-file transforms the contents of the file specified +by input-file into implementation-dependent binary data +which are placed in the file specified by output-file. +

    +

    The file to which input-file refers should be a source file. +output-file can be used to specify an output pathname; +

    +

    the actual pathname of the compiled file +to which compiled code will be output +is computed as if by calling compile-file-pathname. +

    +

    If input-file or output-file is a logical pathname, +it is translated into a physical pathname as if by calling +translate-logical-pathname. +

    +

    If verbose is true, +compile-file prints a message in the form of a comment +(i.e., with a leading semicolon) +to standard output indicating what file is being compiled +and other useful information. +If verbose is false, +compile-file does not print +this information. +

    +

    If print is true, +information about top level forms in the file being +compiled is printed to standard output. +Exactly what is printed is implementation-dependent, +but nevertheless some information is printed. +If print is nil, no information is printed. +

    +

    The external-format specifies the external file format +to be used when opening the file; see the function open. +compile-file and load must cooperate in such a way that +the resulting compiled file can be loaded +without specifying an external file format anew; see the function load. +

    +

    compile-file binds *readtable* and *package* +to the values they held before processing the file. +

    +

    *compile-file-truename* is bound by compile-file +to hold the truename of the pathname of the file being compiled. +

    +

    *compile-file-pathname* is bound by compile-file +to hold a pathname denoted by the first argument to compile-file, +merged against the defaults; +that is, (pathname (merge-pathnames input-file)). +

    +

    The compiled functions contained in the compiled file become available +for use when the compiled file is loaded into Lisp. +

    +

    Any function definition that is processed by the +compiler, including #'(lambda ...) forms and local function +definitions made by flet, labels and defun forms, +result in an object of type compiled-function. +

    +

    The primary value returned by compile-file, output-truename, +is the truename of the output file, or nil if the file could not be created. +

    +

    The secondary value, warnings-p, is false +if no conditions of type error or warning +were detected by the compiler, and true otherwise. +

    +

    The tertiary value, failure-p, is false +if no conditions of type error or warning +(other than style-warning) +were detected by the compiler, and true otherwise. +

    +

    For general information about how files are processed by the file compiler, +see File Compilation. +

    +

    Programs to be compiled by the file compiler must only contain +externalizable objects; for details on such objects, +see Literal Objects in Compiled Files. +For information on how to extend the set of externalizable objects, +see the function make-load-form and Additional Constraints on Externalizable Objects. +

    +

    Affected By::

    + +

    *error-output*, +

    +

    *standard-output*, *compile-verbose*, *compile-print* +

    +

    The computer’s file system. +

    Exceptional Situations::

    + +

    For information about errors detected during the compilation process, +see Exceptional Situations in the Compiler. +

    +

    An error of type file-error might be signaled if +(wild-pathname-p input-file)\/ returns true. +

    +

    If either the attempt to open the source file for input + or the attempt to open the compiled file for output +fails, +an error of type file-error is signaled. +

    +

    See Also::

    + +

    compile +, +declare, +eval-when +, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    + + + + + diff --git a/info/gcl/compile_002dfile_002dpathname.html b/info/gcl/compile_002dfile_002dpathname.html new file mode 100644 index 0000000..bea0482 --- /dev/null +++ b/info/gcl/compile_002dfile_002dpathname.html @@ -0,0 +1,116 @@ + + + + + +compile-file-pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.2 compile-file-pathname [Function]

    + +

    compile-file-pathname input-file &key output-file &allow-other-keys ⇒ pathname +

    +

    Arguments and Values::

    + +

    input-file—a pathname designator. + (Default fillers for unspecified components are taken from + *default-pathname-defaults*.) +

    +

    output-file—a pathname designator. + The default is implementation-defined. +

    +

    pathname—a pathname. +

    +

    Description::

    + +

    Returns the pathname that compile-file would write into, +if given the same arguments. +

    +

    The defaults for the output-file +are taken from the pathname +that results from merging the input-file +with the value of *default-pathname-defaults*, +except that the type component +should default to the appropriate +implementation-defined default type for compiled files. +

    +

    If input-file is a logical pathname and output-file +is unsupplied, the result is a logical pathname. +

    +

    If input-file is a logical pathname, +it is translated into a physical pathname as if by calling +translate-logical-pathname. +

    +

    If input-file is a stream, +the stream can be either open or closed. +compile-file-pathname returns the same pathname after a +file is closed as it did when the file was open. +

    +

    It is an error if input-file is a stream that is +created with make-two-way-stream, make-echo-stream, +make-broadcast-stream, make-concatenated-stream, +make-string-input-stream, make-string-output-stream. +

    +

    If an implementation supports additional keyword arguments to compile-file, +compile-file-pathname must accept the same arguments. +

    +

    Examples::

    + +

    See logical-pathname-translations. +

    +

    Exceptional Situations::

    + +

    An error of type file-error might be signaled if either input-file or +output-file is wild. +

    +

    See Also::

    + +

    compile-file +, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/compiled_002dfunction.html b/info/gcl/compiled_002dfunction.html new file mode 100644 index 0000000..0639756 --- /dev/null +++ b/info/gcl/compiled_002dfunction.html @@ -0,0 +1,73 @@ + + + + + +compiled-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.4 compiled-function [Type]

    + +

    Supertypes::

    + +

    compiled-function, +function, +t +

    +

    Description::

    + +

    Any function may be considered by an implementation to be a +a compiled function if it contains no references to macros that +must be expanded at run time, and it contains no unresolved references +to load time values. See Compilation Semantics. +

    +

    Functions whose definitions appear lexically within a +file that has been compiled with compile-file and then +loaded with load are of type compiled-function. +

    +

    Functions produced by the compile function +are of type compiled-function. +

    +

    Other functions might also be of type compiled-function. +

    + + + + + diff --git a/info/gcl/compiled_002dfunction_002dp.html b/info/gcl/compiled_002dfunction_002dp.html new file mode 100644 index 0000000..337ce7f --- /dev/null +++ b/info/gcl/compiled_002dfunction_002dp.html @@ -0,0 +1,97 @@ + + + + + +compiled-function-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.11 compiled-function-p [Function]

    + +

    compiled-function-p object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type compiled-function; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (defun f (x) x) ⇒  F
+ (compiled-function-p #'f)
+⇒  false
+OR⇒ true
+ (compiled-function-p 'f) ⇒  false
+ (compile 'f) ⇒  F
+ (compiled-function-p #'f) ⇒  true
+ (compiled-function-p 'f) ⇒  false
+ (compiled-function-p (compile nil '(lambda (x) x)))
+⇒  true
+ (compiled-function-p #'(lambda (x) x))
+⇒  false
+OR⇒ true
+ (compiled-function-p '(lambda (x) x)) ⇒  false
+
    + +

    See Also::

    + +

    compile +, +compile-file +, +compiled-function +

    +

    Notes::

    + +
    +
     (compiled-function-p object) ≡ (typep object 'compiled-function)
+
    + + + + + + diff --git a/info/gcl/compiler_002dmacro_002dfunction.html b/info/gcl/compiler_002dmacro_002dfunction.html new file mode 100644 index 0000000..2413612 --- /dev/null +++ b/info/gcl/compiler_002dmacro_002dfunction.html @@ -0,0 +1,80 @@ + + + + + +compiler-macro-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.8 compiler-macro-function [Accessor]

    + +

    compiler-macro-function name &optional environment ⇒ function +

    +

    (setf ( compiler-macro-function name &optional environment) new-function)
    +

    +

    Arguments and Values::

    + +

    name—a function name. +

    +

    environment—an environment object. +

    +

    function, new-function—a compiler macro function, or nil. +

    +

    Description::

    + +

    Accesses the compiler macro function named name, if any, +in the environment. +

    +

    A value of nil denotes the absence of a compiler macro function named name. +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if environment is non-nil +in a use of setf of compiler-macro-function. +

    +

    See Also::

    + +

    define-compiler-macro +, Compiler Macros +

    + + + + + diff --git a/info/gcl/complement.html b/info/gcl/complement.html new file mode 100644 index 0000000..6219a70 --- /dev/null +++ b/info/gcl/complement.html @@ -0,0 +1,113 @@ + + + + + +complement (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.38 complement [Function]

    + +

    complement function ⇒ complement-function +

    +

    Arguments and Values::

    + +

    function—a function. +

    +

    complement-function—a function. +

    +

    Description::

    + +

    Returns a function that + takes the same arguments as function, + and has the same side-effect behavior as function, + but returns only a single value: + a generalized boolean with the opposite truth value of that + which would be returned as the primary value of function. + That is, when the function would have returned + true as its primary value + the complement-function returns false, + and when the function would have returned + false as its primary value + the complement-function returns true. +

    +

    Examples::

    + +
    +
     (funcall (complement #'zerop) 1) ⇒  true
+ (funcall (complement #'characterp) #\A) ⇒  false
+ (funcall (complement #'member) 'a '(a b c)) ⇒  false
+ (funcall (complement #'member) 'd '(a b c)) ⇒  true
+
    + +

    See Also::

    + +

    not +

    +

    Notes::

    + +
    +
     (complement x) ≡ #'(lambda (&rest arguments) (not (apply x arguments)))
+
    + +

    In Common Lisp, functions with names like “xxx-if-not” +are related to functions with names like “xxx-if” +in that +

    +
    +
    (xxx-if-not f . arguments) ≡ (xxx-if (complement f) . arguments)
+
    + +

    For example, +

    +
    +
     (find-if-not #'zerop '(0 0 3)) ≡
+ (find-if (complement #'zerop) '(0 0 3)) ⇒  3
+
    + +

    Note that since the “xxx-if-not” functions +and the :test-not arguments have been deprecated, +uses of “xxx-if” functions or +:test arguments with complement are preferred. +

    + + + + + diff --git a/info/gcl/complex-_0028System-Class_0029.html b/info/gcl/complex-_0028System-Class_0029.html new file mode 100644 index 0000000..18d6e39 --- /dev/null +++ b/info/gcl/complex-_0028System-Class_0029.html @@ -0,0 +1,123 @@ + + + + + +complex (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.2 complex [System Class]

    + +

    Class Precedence List::

    +

    complex, +number, +t +

    +

    Description::

    + +

    The type complex includes all mathematical complex numbers +other than those included in the type rational. +Complexes are +expressed +in Cartesian form with a +real part and an imaginary part, each of which is a real. +The real part and imaginary part are either both +rational or both of the same float type. +The imaginary part can be a float zero, but can never +be a rational zero, for such a number is always represented +by Common Lisp as a rational rather than a complex. +

    +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (complex{[typespec | *]}) +

    +

    Compound Type Specifier Arguments::

    + +

    typespec—a type specifier that denotes a subtype of type real. +

    +

    Compound Type Specifier Description::

    + +

    [Editorial Note by KMP: If you ask me, this definition is a complete mess. Looking at +issue ARRAY-TYPE-ELEMENT-TYPE-SEMANTICS:UNIFY-UPGRADING does not help me figure +it out, either. Anyone got any suggestions?] +

    +

    Every element of this type is a complex whose +real part and imaginary part are each of type +

    +

    (upgraded-complex-part-type typespec). +

    +

    This type encompasses those complexes +that can result by giving numbers of type typespec +to complex. +

    +

    (complex type-specifier) +refers to all complexes that can result from giving +numbers of type type-specifier to the function complex, +plus all other complexes of the same specialized representation. +

    +

    See Also::

    + +

    Rule of Canonical Representation for Complex Rationals, +Constructing Numbers from Tokens, +Printing Complexes +

    +

    Notes::

    + +

    The input syntax for a complex with real part r and +imaginary part i is #C(r i). +For further details, see Standard Macro Characters. +

    +

    For every float, n, there is a complex +which represents the same mathematical number +and which can be obtained by (COERCE n 'COMPLEX). +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/complex.html b/info/gcl/complex.html new file mode 100644 index 0000000..35e85b3 --- /dev/null +++ b/info/gcl/complex.html @@ -0,0 +1,113 @@ + + + + + +complex (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.46 complex [Function]

    + +

    complex realpart &optional imagpart ⇒ complex +

    +

    Arguments and Values::

    + +

    realpart—a real. +

    +

    imagpart—a real. +

    +

    complex—a rational or a complex. +

    +

    Description::

    + +

    complex returns a number + whose real part is realpart +and whose imaginary part is imagpart. +

    +

    If realpart is a rational +and imagpart is the rational number zero, +the result of complex is realpart, a rational. +Otherwise, the result is a complex. +

    +

    If either realpart or imagpart is a float, +the non-float is converted to a float +before the complex is created. +If imagpart is not supplied, the imaginary part is a +zero of the same type as realpart; i.e., (coerce 0 (type-of realpart)) is +effectively used. +

    +

    Type upgrading implies a movement upwards in the type +hierarchy lattice. +In the case of complexes, the type-specifier +

    +

    [Reviewer Note by Barmar: What type specifier?] +must be a subtype of +(upgraded-complex-part-type type-specifier). +If type-specifier1 is a subtype of type-specifier2, then +(upgraded-complex-element-type 'type-specifier1) +must also be a subtype of +(upgraded-complex-element-type 'type-specifier2). +Two disjoint types can be upgraded into +the same thing. +

    +

    Examples::

    +
    +
     (complex 0) ⇒  0
+ (complex 0.0) ⇒  #C(0.0 0.0)
+ (complex 1 1/2) ⇒  #C(1 1/2)
+ (complex 1 .99) ⇒  #C(1.0 0.99)
+ (complex 3/2 0.0) ⇒  #C(1.5 0.0)
+
    + +

    See Also::

    + +

    realpart +, imagpart +

    +

    Notes::

    + +
    +
     #c(a b) ≡ #.(complex a b)
+
    + + + + + + diff --git a/info/gcl/complexp.html b/info/gcl/complexp.html new file mode 100644 index 0000000..91e43cb --- /dev/null +++ b/info/gcl/complexp.html @@ -0,0 +1,83 @@ + + + + + +complexp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.47 complexp [Function]

    + +

    complexp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type complex; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (complexp 1.2d2) ⇒  false
+ (complexp #c(5/3 7.2)) ⇒  true
+
+
    + +

    See Also::

    + +

    complex + (function and type), +typep +

    +

    Notes::

    + +
    +
     (complexp object) ≡ (typep object 'complex)
+
    + + + + + + diff --git a/info/gcl/compute_002dapplicable_002dmethods.html b/info/gcl/compute_002dapplicable_002dmethods.html new file mode 100644 index 0000000..fceb25f --- /dev/null +++ b/info/gcl/compute_002dapplicable_002dmethods.html @@ -0,0 +1,84 @@ + + + + + +compute-applicable-methods (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.32 compute-applicable-methods [Standard Generic Function]

    + +

    Syntax::

    + +

    compute-applicable-methods generic-function function-arguments ⇒ methods +

    +

    Method Signatures::

    + +

    compute-applicable-methods (generic-function standard-generic-function) +

    +

    Arguments and Values::

    + +

    generic-function—a generic function. +

    +

    function-arguments—a list of arguments for the generic-function. +

    +

    methods—a list of method objects. +

    +

    Description::

    + +

    Given a generic-function and a set of +function-arguments, the function +compute-applicable-methods returns the set of methods +that are applicable for those arguments +sorted according to precedence order. +See Method Selection and Combination. +

    +

    Affected By::

    + +

    defmethod +

    +

    See Also::

    + +

    Method Selection and Combination +

    + + + + + diff --git a/info/gcl/compute_002drestarts.html b/info/gcl/compute_002drestarts.html new file mode 100644 index 0000000..01d467f --- /dev/null +++ b/info/gcl/compute_002drestarts.html @@ -0,0 +1,141 @@ + + + + + +compute-restarts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.32 compute-restarts [Function]

    + +

    compute-restarts &optional condition ⇒ restarts +

    +

    Arguments and Values::

    + +

    condition—a condition object, or nil. +

    +

    restarts—a list of restarts. +

    +

    Description::

    + +

    compute-restarts uses the dynamic state of the program to compute +a list of the restarts which are currently active. +

    +

    The resulting list is ordered so that the innermost +(more-recently established) restarts are nearer the head of the list. +

    +

    When condition is non-nil, only those restarts +are considered that are either explicitly associated with that condition, +or not associated with any condition; that is, the excluded restarts +are those that are associated with a non-empty set of conditions of +which the given condition is not an element. +If condition is nil, all restarts are considered. +

    +

    compute-restarts returns all +applicable restarts, +including anonymous ones, even if some of them have the same name as +others and would therefore not be found by find-restart +when given a symbol argument. +

    +

    Implementations are permitted, but not required, to return distinct +lists from repeated calls to compute-restarts while in +the same dynamic environment. +The consequences are undefined if the list returned by +compute-restarts is every modified. +

    +

    Examples::

    + +
    +
     ;; One possible way in which an interactive debugger might present
+ ;; restarts to the user.
+ (defun invoke-a-restart ()
+   (let ((restarts (compute-restarts)))
+     (do ((i 0 (+ i 1)) (r restarts (cdr r))) ((null r))
+       (format t "~&~D: ~A~
+     (let ((n nil) (k (length restarts)))
+       (loop (when (and (typep n 'integer) (>= n 0) (< n k))
+               (return t))
+             (format t "~&Option: ")
+             (setq n (read))
+             (fresh-line))
+       (invoke-restart-interactively (nth n restarts)))))
+
+ (restart-case (invoke-a-restart)
+   (one () 1)
+   (two () 2)
+   (nil () :report "Who knows?" 'anonymous)
+   (one () 'I)
+   (two () 'II))
+ |>  0: ONE
+ |>  1: TWO
+ |>  2: Who knows?
+ |>  3: ONE
+ |>  4: TWO
+ |>  5: Return to Lisp Toplevel.
+ |>  Option: |>>4<<|
+⇒  II
+
+ ;; Note that in addition to user-defined restart points, COMPUTE-RESTARTS
+ ;; also returns information about any system-supplied restarts, such as
+ ;; the "Return to Lisp Toplevel" restart offered above.
+
+
    + +

    Affected By::

    + +

    Existing restarts. +

    +

    See Also::

    + +

    find-restart +, +invoke-restart +, +restart-bind +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/concatenate.html b/info/gcl/concatenate.html new file mode 100644 index 0000000..081ba5f --- /dev/null +++ b/info/gcl/concatenate.html @@ -0,0 +1,124 @@ + + + + + +concatenate (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.20 concatenate [Function]

    + +

    concatenate result-type &rest sequences ⇒ result-sequence +

    +

    Arguments and Values::

    + +

    result-type—a sequence type specifier. +

    +

    sequences—a sequence. +

    +

    result-sequence—a proper sequence of type result-type. +

    +

    Description::

    + +

    concatenate returns a sequence that contains +all the individual elements of all the sequences in the order +that they are supplied. +The sequence is of type result-type, +which must be a subtype of type sequence. +

    +

    All of the sequences are copied from; the result +does not share any structure with any of the sequences. +Therefore, if only one sequence is provided +and it is of type result-type, +concatenate is required to copy sequence rather than simply +returning it. +

    +

    It is an error if any element of the sequences cannot be an +element of the sequence result. +

    +

    [Reviewer Note by Barmar: Should signal?] +

    +

    If the result-type is a subtype of list, +the result will be a list. +

    +

    If the result-type is a subtype of vector, +then if the implementation can determine the element type specified +for the result-type, the element type of the resulting array +is the result of upgrading that element type; or, if the +implementation can determine that the element type is unspecified (or *), +the element type of the resulting array is t; +otherwise, an error is signaled. +

    +

    Examples::

    + +
    +
    (concatenate 'string "all" " " "together" " " "now") ⇒  "all together now"
+(concatenate 'list "ABC" '(d e f) #(1 2 3) #*1011)
+⇒  (#\A #\B #\C D E F 1 2 3 1 0 1 1)
+(concatenate 'list) ⇒  NIL
+
    + +
    +
      (concatenate '(vector * 2) "a" "bc") should signal an error
+
    + +

    Exceptional Situations::

    + +

    An error is signaled if the result-type is neither + a recognizable subtype of list, + nor a recognizable subtype of vector. +

    +

    An error of type type-error should be signaled if result-type +specifies the number of elements and the sum of sequences +is different from that number. +

    +

    See Also::

    + +

    append +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/concatenated_002dstream.html b/info/gcl/concatenated_002dstream.html new file mode 100644 index 0000000..bdd5a06 --- /dev/null +++ b/info/gcl/concatenated_002dstream.html @@ -0,0 +1,82 @@ + + + + + +concatenated-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.3 concatenated-stream [System Class]

    + +

    Class Precedence List::

    + +

    concatenated-stream, +stream, +t +

    +

    Description::

    + +

    A concatenated stream is an input stream which +is a composite stream of zero or more other input streams, +such that the sequence of data which can be read from the +concatenated stream is the same as the concatenation of the +sequences of data which could be read from each of the +constituent streams. +

    +

    Input from a concatenated stream is taken from the first +of the associated input streams until it reaches end of file_1; +then that stream is discarded, and subsequent input is taken +from the next input stream, and so on. +An end of file on the associated input streams is always managed +invisibly by the concatenated stream—the only time a client of +a concatenated stream sees an end of file is when an attempt is +made to obtain data from the concatenated stream but it has no +remaining input streams from which to obtain such data. +

    +

    See Also::

    + +

    concatenated-stream-streams +, +make-concatenated-stream +

    + + + + + diff --git a/info/gcl/concatenated_002dstream_002dstreams.html b/info/gcl/concatenated_002dstream_002dstreams.html new file mode 100644 index 0000000..6acd5b0 --- /dev/null +++ b/info/gcl/concatenated_002dstream_002dstreams.html @@ -0,0 +1,69 @@ + + + + + +concatenated-stream-streams (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.46 concatenated-stream-streams [Function]

    + +

    concatenated-stream-streams concatenated-stream ⇒ streams +

    +

    Arguments and Values::

    + +

    concatenated-stream – a concatenated stream. +

    +

    streams—a list of input streams. +

    +

    Description::

    + +

    Returns a list of input streams that constitute the +ordered set of streams the concatenated-stream still +has to read from, starting with the current one it is reading from. +The list may be empty if no more streams remain to be read. +

    +

    The consequences are undefined if the list structure of the streams +is ever modified. +

    + + + + + diff --git a/info/gcl/cond.html b/info/gcl/cond.html new file mode 100644 index 0000000..9ce6795 --- /dev/null +++ b/info/gcl/cond.html @@ -0,0 +1,112 @@ + + + + + +cond (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.42 cond [Macro]

    + +

    cond {!clause}* ⇒ {result}* +

    +

    clause ::=(test-form {form}*) +

    +

    Arguments and Values::

    + +

    test-form—a form. +

    +

    forms—an implicit progn. +

    +

    results—the values of the forms + in the first clause whose test-form yields true, + or the primary value of the test-form + if there are no forms in that clause, + or else nil if no test-form yields true. +

    +

    Description::

    + +

    cond allows the execution of forms to be dependent +on test-form. +

    +

    Test-forms are evaluated one at a time in the order in which +they are given in the argument list until a test-form is found that +evaluates to true. +

    +

    If there are no forms in that clause, the primary value +of the test-form is returned by the cond form. +Otherwise, the forms associated with this test-form are +evaluated in order, left to right, as an implicit progn, and the +values returned by the last form +are returned by the cond form. +

    +

    Once one test-form has yielded true, +no additional test-forms are evaluated. +If no test-form yields true, nil is returned. +

    +

    Examples::

    + +
    +
     (defun select-options ()
+   (cond ((= a 1) (setq a 2))
+         ((= a 2) (setq a 3))
+         ((and (= a 3) (floor a 2)))
+         (t (floor a 3)))) ⇒  SELECT-OPTIONS
+ (setq a 1) ⇒  1
+ (select-options) ⇒  2
+ a ⇒  2
+ (select-options) ⇒  3
+ a ⇒  3
+ (select-options) ⇒  1
+ (setq a 5) ⇒  5
+ (select-options) ⇒  1, 2
+
    + +

    See Also::

    + +

    if +, +case +. +

    + + + + + diff --git a/info/gcl/condition.html b/info/gcl/condition.html new file mode 100644 index 0000000..c4aca45 --- /dev/null +++ b/info/gcl/condition.html @@ -0,0 +1,105 @@ + + + + + +condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.1 condition [Condition Type]

    + +

    [Reviewer Note by Barrett: I think CONDITION-RESTARTS is not fully integrated.] +

    +

    Class Precedence List::

    +

    condition, +t +

    +

    Description::

    + +

    All types of conditions, whether error or +non-error, must inherit from this type. +

    +

    No additional subtype relationships among the specified subtypes of type condition +are allowed, except when explicitly mentioned in the text; however +implementations are permitted to introduce additional types +and one of these types can be a subtype of any +number of the subtypes of type condition. +

    +

    Whether a user-defined condition type has slots +that are accessible by with-slots is implementation-dependent. +Furthermore, even in an implementation +in which user-defined condition types would have slots, +it is implementation-dependent whether any condition +types defined in this document have such slots or, +if they do, what their names might be; +only the reader functions documented by this specification may be relied +upon by portable code. +

    +

    Conforming code must observe the following restrictions related to +conditions: +

    +
    +
    *
    +

    define-condition, not defclass, must be used + to define new condition types. +

    +
    +
    *
    +

    make-condition, not make-instance, must be used to + create condition objects explicitly. +

    +
    +
    *
    +

    The :report option of define-condition, not defmethod + for print-object, must be used to define a condition reporter. +

    +
    +
    *
    +

    slot-value, slot-boundp, slot-makunbound, + and with-slots must not be used on condition objects. + Instead, the appropriate accessor functions (defined by define-condition) + should be used. +

    +
    + + + + + + diff --git a/info/gcl/conjugate.html b/info/gcl/conjugate.html new file mode 100644 index 0000000..42e0fb2 --- /dev/null +++ b/info/gcl/conjugate.html @@ -0,0 +1,87 @@ + + + + + +conjugate (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.48 conjugate [Function]

    + +

    conjugate number ⇒ conjugate +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    conjugate—a number. +

    +

    Description::

    + +

    Returns the complex conjugate of number. +The conjugate of a +

    +

    real +

    +

    number is itself. +

    +

    Examples::

    + +
    +
     (conjugate #c(0 -1)) ⇒  #C(0 1)
+ (conjugate #c(1 1)) ⇒  #C(1 -1)
+ (conjugate 1.5) ⇒  1.5
+ (conjugate #C(3/5 4/5)) ⇒  #C(3/5 -4/5)
+ (conjugate #C(0.0D0 -1.0D0)) ⇒  #C(0.0D0 1.0D0)
+ (conjugate 3.7) ⇒  3.7
+
    + +

    Notes::

    + +

    For a complex number z, +

    +
    +
     (conjugate z) ≡ (complex (realpart z) (- (imagpart z)))
+
    + + + + + + diff --git a/info/gcl/cons-_0028System-Class_0029.html b/info/gcl/cons-_0028System-Class_0029.html new file mode 100644 index 0000000..7f48ed1 --- /dev/null +++ b/info/gcl/cons-_0028System-Class_0029.html @@ -0,0 +1,94 @@ + + + + + +cons (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.3 cons [System Class]

    + +

    Class Precedence List::

    +

    cons, +list, +sequence, +t +

    +

    Description::

    + +

    A cons is a compound object having two components, +called the car and cdr. These form a dotted pair. +Each component can be any object. +

    +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (cons{[car-typespec [cdr-typespec]]}) +

    +

    Compound Type Specifier Arguments::

    + +

    car-typespec—a type specifier, + or the symbol *. + The default is the symbol *. +

    +

    cdr-typespec—a type specifier, + or the symbol *. + The default is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of conses +whose car is constrained to be of type car-typespec and +whose cdr is constrained to be of type cdr-typespec. +(If either car-typespec or cdr-typespec is *, + it is as if the type t had been denoted.) +

    +

    See Also::

    + +

    Left-Parenthesis, +Printing Lists and Conses +

    + + + + + diff --git a/info/gcl/cons.html b/info/gcl/cons.html new file mode 100644 index 0000000..20ae896 --- /dev/null +++ b/info/gcl/cons.html @@ -0,0 +1,87 @@ + + + + + +cons (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.5 cons [Function]

    + +

    cons object-1 object-2 ⇒ cons +

    +

    Arguments and Values::

    + +

    object-1—an object. +

    +

    object-2—an object. +

    +

    cons—a cons. +

    +

    Description::

    + +

    Creates a fresh cons, the car of which is object-1 +and the cdr of which is object-2. +

    +

    Examples::

    + +
    +
     (cons 1 2) ⇒  (1 . 2)
+ (cons 1 nil) ⇒  (1)
+ (cons nil 2) ⇒  (NIL . 2)
+ (cons nil nil) ⇒  (NIL)
+ (cons 1 (cons 2 (cons 3 (cons 4 nil)))) ⇒  (1 2 3 4)
+ (cons 'a 'b) ⇒  (A . B)
+ (cons 'a (cons 'b (cons 'c '()))) ⇒  (A B C)
+ (cons 'a '(b c d)) ⇒  (A B C D)
+
    + +

    See Also::

    + +

    list (Function) +

    +

    Notes::

    +

    If object-2 is a list, cons can be thought of as +producing a new list which is like it but has object-1 prepended. +

    + + + + + diff --git a/info/gcl/consp.html b/info/gcl/consp.html new file mode 100644 index 0000000..9ba1f1c --- /dev/null +++ b/info/gcl/consp.html @@ -0,0 +1,86 @@ + + + + + +consp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.6 consp [Function]

    + +

    consp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type cons; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (consp nil) ⇒  false
+ (consp (cons 1 2)) ⇒  true
+
    + +

    The empty list is not a cons, so +

    +
    +
     (consp '()) ≡ (consp 'nil) ⇒  false
+
    + +

    See Also::

    + +

    listp +

    +

    Notes::

    + +
    +
     (consp object) ≡ (typep object 'cons) ≡ (not (typep object 'atom)) ≡ (typep object '(not atom))
+
    + + + + + + diff --git a/info/gcl/constantly.html b/info/gcl/constantly.html new file mode 100644 index 0000000..fc688a9 --- /dev/null +++ b/info/gcl/constantly.html @@ -0,0 +1,88 @@ + + + + + +constantly (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.39 constantly [Function]

    + +

    constantly value ⇒ function +

    +

    Arguments and Values::

    + +

    value—an object. +

    +

    function—a function. +

    +

    Description::

    + +

    constantly returns a function that accepts any number of +arguments, that has no side-effects, and that always returns value. +

    +

    Examples::

    + +
    +
     (mapcar (constantly 3) '(a b c d)) ⇒  (3 3 3 3)
+ (defmacro with-vars (vars &body forms)
+   `((lambda ,vars ,@forms) ,@(mapcar (constantly nil) vars)))
+⇒  WITH-VARS
+ (macroexpand '(with-vars (a b) (setq a 3 b (* a a)) (list a b)))
+⇒  ((LAMBDA (A B) (SETQ A 3 B (* A A)) (LIST A B)) NIL NIL), true
+
    + +

    See Also::

    + +

    not +

    +

    Notes::

    + +

    constantly could be defined by: +

    +
    +
     (defun constantly (object)
+   #'(lambda (&rest arguments) object))
+
    + + + + + + diff --git a/info/gcl/constantp.html b/info/gcl/constantp.html new file mode 100644 index 0000000..c4e61ea --- /dev/null +++ b/info/gcl/constantp.html @@ -0,0 +1,155 @@ + + + + + +constantp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.30 constantp [Function]

    + +

    constantp form &optional environment ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    form—a form. +

    +

    environment—an environment object. + The default is nil. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if form can be determined +by the implementation to be a constant form +in the indicated environment; +otherwise, it returns false indicating either + that the form is not a constant form + or that it cannot be determined whether or not form is a constant form. +

    +

    The following kinds of forms are considered constant forms: +

    +
    *
    +

    Self-evaluating objects + (such as numbers, + characters, + and the various kinds of arrays) + are always considered constant forms + and must be recognized as such by constantp. +

    +
    +
    *
    +

    Constant variables, such as keywords, + symbols defined by Common Lisp as constant (such as nil, t, and pi), + and symbols declared as constant by the user in the indicated environment + using defconstant + are always considered constant forms + and must be recognized as such by constantp. +

    +
    +
    *
    +

    quote forms are always considered constant forms + and must be recognized as such by constantp. +

    +
    +
    *
    +

    An implementation is permitted, but not required, to detect + additional constant forms. If it does, it is also permitted, + but not required, to make use of information in the environment. + Examples of constant forms for which constantp might + or might not return true are: + (sqrt pi), + (+ 3 2), + (length '(a b c)), + and + (let ((x 7)) (zerop x)). +

    +
    + +

    If an implementation chooses to make use of the environment +information, such actions as expanding macros or performing function +inlining are permitted to be used, but not required; +however, expanding compiler macros is not permitted. +

    +

    Examples::

    + +
    +
     (constantp 1) ⇒  true
+ (constantp 'temp) ⇒  false
+ (constantp ''temp)) ⇒  true
+ (defconstant this-is-a-constant 'never-changing) ⇒  THIS-IS-A-CONSTANT 
+ (constantp 'this-is-a-constant) ⇒  true
+ (constantp "temp") ⇒  true
+ (setq a 6) ⇒  6 
+ (constantp a) ⇒  true
+ (constantp '(sin pi)) ⇒  implementation-dependent
+ (constantp '(car '(x))) ⇒  implementation-dependent
+ (constantp '(eql x x)) ⇒  implementation-dependent
+ (constantp '(typep x 'nil)) ⇒  implementation-dependent
+ (constantp '(typep x 't)) ⇒  implementation-dependent
+ (constantp '(values this-is-a-constant)) ⇒  implementation-dependent
+ (constantp '(values 'x 'y)) ⇒  implementation-dependent
+ (constantp '(let ((a '(a b c))) (+ (length a) 6))) ⇒  implementation-dependent
+
    + +

    Affected By::

    + +

    The state of the global environment (e.g., which symbols have been +declared to be the names of constant variables). +

    +

    See Also::

    + +

    defconstant +

    + + + + + +
    +
    +

    +Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/continue.html b/info/gcl/continue.html new file mode 100644 index 0000000..3ef79f9 --- /dev/null +++ b/info/gcl/continue.html @@ -0,0 +1,89 @@ + + + + + +continue (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.42 continue [Restart]

    + +

    Data Arguments Required::

    + +

    None. +

    +

    Description::

    + +

    The continue restart is generally part of protocols where there is + a single “obvious” way to continue, such as in +break and cerror. Some + user-defined protocols may also wish to incorporate it for similar reasons. + In general, however, it is more reliable to design a special purpose restart + with a name that more directly suits the particular application. +

    +

    Examples::

    + +
    +
     (let ((x 3))
+   (handler-bind ((error #'(lambda (c)
+                             (let ((r (find-restart 'continue c)))
+                               (when r (invoke-restart r))))))
+     (cond ((not (floatp x))
+            (cerror "Try floating it." "~D is not a float." x)
+            (float x))
+           (t x)))) ⇒  3.0
+
    + +

    See Also::

    + +

    Restarts, +Interfaces to Restarts, +invoke-restart +, +continue + (function), +assert +, +cerror +

    + + + + + diff --git a/info/gcl/control_002derror.html b/info/gcl/control_002derror.html new file mode 100644 index 0000000..beab41d --- /dev/null +++ b/info/gcl/control_002derror.html @@ -0,0 +1,66 @@ + + + + + +control-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.67 control-error [Condition Type]

    + +

    Class Precedence List::

    +

    control-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type control-error consists of error conditions that result from +invalid dynamic transfers of control in a program. The errors that +result from giving throw a tag that is not active or from +giving go or return-from a tag that is no longer +dynamically available are of type control-error. +

    + + + + + diff --git a/info/gcl/copy_002dalist.html b/info/gcl/copy_002dalist.html new file mode 100644 index 0000000..ccc7528 --- /dev/null +++ b/info/gcl/copy_002dalist.html @@ -0,0 +1,91 @@ + + + + + +copy-alist (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.37 copy-alist [Function]

    + +

    copy-alist alist ⇒ new-alist +

    +

    Arguments and Values::

    + +

    alist—an association list. +

    +

    new-alist—an association list. +

    +

    Description::

    + +

    copy-alist returns a copy of alist. +

    +

    The list structure of alist is copied, +and the elements of alist which are conses are +also copied (as conses only). +Any other objects which are referred to, +whether directly or indirectly, +by the alist continue to be shared. +

    +

    Examples::

    + +
    +
    (defparameter *alist* (acons 1 "one" (acons 2 "two" '())))
+*alist* ⇒  ((1 . "one") (2 . "two"))
+(defparameter *list-copy* (copy-list *alist*))
+*list-copy* ⇒  ((1 . "one") (2 . "two"))
+(defparameter *alist-copy* (copy-alist *alist*))
+*alist-copy* ⇒  ((1 . "one") (2 . "two"))
+(setf (cdr (assoc 2 *alist-copy*)) "deux") ⇒  "deux"
+*alist-copy* ⇒  ((1 . "one") (2 . "deux"))
+*alist* ⇒  ((1 . "one") (2 . "two"))
+(setf (cdr (assoc 1 *list-copy*)) "uno") ⇒  "uno"
+*list-copy* ⇒  ((1 . "uno") (2 . "two"))
+*alist* ⇒  ((1 . "uno") (2 . "two"))
+
    + +

    See Also::

    + +

    copy-list +

    + + + + + diff --git a/info/gcl/copy_002dlist.html b/info/gcl/copy_002dlist.html new file mode 100644 index 0000000..5a9d5d3 --- /dev/null +++ b/info/gcl/copy_002dlist.html @@ -0,0 +1,103 @@ + + + + + +copy-list (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.14 copy-list [Function]

    + +

    copy-list list ⇒ copy +

    +

    Arguments and Values::

    + +

    list—a proper list or a dotted list. +

    +

    copy—a list. +

    +

    Description::

    + +

    Returns a copy of list. +If list is a dotted list, +the resulting list will also be a dotted list. +

    +

    Only the list structure of list is copied; +the elements of the resulting list are +the same as the corresponding elements of the given list. +

    +

    Examples::

    + +
    +
     (setq lst (list 1 (list 2 3))) ⇒  (1 (2 3))
+ (setq slst lst) ⇒  (1 (2 3))
+ (setq clst (copy-list lst)) ⇒  (1 (2 3))
+ (eq slst lst) ⇒  true
+ (eq clst lst) ⇒  false
+ (equal clst lst) ⇒  true
+ (rplaca lst "one") ⇒  ("one" (2 3))
+ slst ⇒  ("one" (2 3))
+ clst ⇒  (1 (2 3))
+ (setf (caadr lst) "two") ⇒  "two"
+ lst ⇒  ("one" ("two" 3))
+ slst ⇒  ("one" ("two" 3))
+ clst ⇒  (1 ("two" 3))
+
    + +

    Exceptional Situations::

    + +

    The consequences are undefined if list is a circular list. +

    +

    See Also::

    + +

    copy-alist +, +copy-seq +, +copy-tree +

    +

    Notes::

    + +

    The copy created is equal to list, but not eq. +

    + + + + + diff --git a/info/gcl/copy_002dpprint_002ddispatch.html b/info/gcl/copy_002dpprint_002ddispatch.html new file mode 100644 index 0000000..d59096c --- /dev/null +++ b/info/gcl/copy_002dpprint_002ddispatch.html @@ -0,0 +1,70 @@ + + + + + +copy-pprint-dispatch (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.1 copy-pprint-dispatch [Function]

    + +

    copy-pprint-dispatch &optional table ⇒ new-table +

    +

    Arguments and Values::

    + +

    table—a pprint dispatch table, or nil. +

    +

    new-table—a fresh pprint dispatch table. +

    +

    Description::

    + +

    Creates and returns a copy of the specified table, +or of the value of *print-pprint-dispatch* if no table is specified, +or of the initial value of *print-pprint-dispatch* if nil is specified. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if table +is not a pprint dispatch table. +

    + + + + + diff --git a/info/gcl/copy_002dreadtable.html b/info/gcl/copy_002dreadtable.html new file mode 100644 index 0000000..9d517a4 --- /dev/null +++ b/info/gcl/copy_002dreadtable.html @@ -0,0 +1,117 @@ + + + + + +copy-readtable (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.2 copy-readtable [Function]

    + +

    copy-readtable &optional from-readtable to-readtable ⇒ readtable +

    +

    Arguments and Values::

    + +

    from-readtable—a readtable designator. + The default is the current readtable. +

    +

    to-readtable—a readtable or nil. + The default is nil. +

    +

    readtable—the to-readtable if it is non-nil, + or else a fresh readtable. +

    +

    Description::

    + +

    copy-readtable copies from-readtable. +

    +

    If to-readtable is nil, a new readtable is created and returned. +Otherwise the readtable specified by to-readtable is modified and returned. +

    +

    copy-readtable copies the setting of readtable-case. +

    +

    Examples::

    + +
    +
     (setq zvar 123) ⇒  123
+ (set-syntax-from-char #\z #\' (setq table2 (copy-readtable))) ⇒  T
+ zvar ⇒  123
+ (copy-readtable table2 *readtable*) ⇒  #<READTABLE 614000277>
+ zvar ⇒  VAR
+ (setq *readtable* (copy-readtable)) ⇒  #<READTABLE 46210223>
+ zvar ⇒  VAR
+ (setq *readtable* (copy-readtable nil)) ⇒  #<READTABLE 46302670>
+ zvar ⇒  123
+
    + +

    See Also::

    + +

    readtable, +readtable +

    +

    Notes::

    + +
    +
    (setq *readtable* (copy-readtable nil))
+
    + +

    restores the input syntax to standard Common Lisp syntax, even if +the initial readtable has been clobbered +(assuming it is not so badly clobbered that you cannot type in the above expression). +

    +

    On the other hand, +

    +
    +
    (setq *readtable* (copy-readtable))
+
    + +

    replaces the current readtable with a copy of itself. +This is useful if you want to save a copy of a readtable for later use, +protected from alteration in the meantime. It is also useful if you want to +locally bind the readtable to a copy of itself, as in: +

    +
    +
    (let ((*readtable* (copy-readtable))) ...)
+
    + + + + + + diff --git a/info/gcl/copy_002dseq.html b/info/gcl/copy_002dseq.html new file mode 100644 index 0000000..ad698ad --- /dev/null +++ b/info/gcl/copy_002dseq.html @@ -0,0 +1,97 @@ + + + + + +copy-seq (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.2 copy-seq [Function]

    + +

    copy-seq sequence ⇒ copied-sequence +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    copied-sequence—a proper sequence. +

    +

    Description::

    + +

    Creates a copy of sequence. The elements of the new +sequence are the same as the corresponding elements of +the given sequence. +

    +

    If sequence is a vector, +the result is a fresh simple array +of rank one +that has the same actual array element type as sequence. +If sequence is a list, +the result is a fresh list. +

    +

    Examples::

    +
    +
     (setq str "a string") ⇒  "a string"
+ (equalp str (copy-seq str)) ⇒  true
+ (eql str (copy-seq str)) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    copy-list +

    +

    Notes::

    + +

    From a functional standpoint, +

    +
     (copy-seq x) ≡ (subseq x 0)
+
    + +

    However, the programmer intent is typically very different in these two cases. +

    + + + + + diff --git a/info/gcl/copy_002dstructure.html b/info/gcl/copy_002dstructure.html new file mode 100644 index 0000000..00199fb --- /dev/null +++ b/info/gcl/copy_002dstructure.html @@ -0,0 +1,80 @@ + + + + + +copy-structure (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Structures Dictionary  

    +
    +
    +

    8.1.2 copy-structure [Function]

    + +

    copy-structure structure ⇒ copy +

    +

    Arguments and Values::

    + +

    structure—a structure. +

    +

    copy—a copy of the structure. +

    +

    Description::

    + +

    Returns a copy_6 of the structure. +

    +

    Only the structure itself is copied; not the values of the slots. +

    +

    See Also::

    + +

    the :copier option to +defstruct +

    +

    Notes::

    + +

    The copy is the same as the given structure +under equalp, but not under equal. +

    + + + + + + + + + + diff --git a/info/gcl/copy_002dsymbol.html b/info/gcl/copy_002dsymbol.html new file mode 100644 index 0000000..1ecd36c --- /dev/null +++ b/info/gcl/copy_002dsymbol.html @@ -0,0 +1,129 @@ + + + + + +copy-symbol (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.6 copy-symbol [Function]

    + +

    copy-symbol symbol &optional copy-properties ⇒ new-symbol +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    copy-properties—a generalized boolean. + The default is false. +

    +

    new-symbol—a fresh, uninterned symbol. +

    +

    Description::

    + +

    copy-symbol returns a fresh, uninterned symbol, +the name of which is string= to and possibly the same as +the name of the given symbol. +

    +

    If copy-properties is false, +the new-symbol is neither bound nor fbound +and has a null property list. +If copy-properties is true, then +the initial value of new-symbol is + the value of symbol, +the initial function definition of new-symbol is + the functional value of symbol, +and the property list of new-symbol is +

    +

    a copy_2 of the property list of symbol. +

    +

    Examples::

    + +
    +
     (setq fred 'fred-smith) ⇒  FRED-SMITH
+ (setf (symbol-value fred) 3) ⇒  3
+ (setq fred-clone-1a (copy-symbol fred nil)) ⇒  #:FRED-SMITH
+ (setq fred-clone-1b (copy-symbol fred nil)) ⇒  #:FRED-SMITH
+ (setq fred-clone-2a (copy-symbol fred t))   ⇒  #:FRED-SMITH
+ (setq fred-clone-2b (copy-symbol fred t))   ⇒  #:FRED-SMITH
+ (eq fred fred-clone-1a) ⇒  false
+ (eq fred-clone-1a fred-clone-1b) ⇒  false
+ (eq fred-clone-2a fred-clone-2b) ⇒  false
+ (eq fred-clone-1a fred-clone-2a) ⇒  false
+ (symbol-value fred) ⇒  3
+ (boundp fred-clone-1a) ⇒  false
+ (symbol-value fred-clone-2a) ⇒  3
+ (setf (symbol-value fred-clone-2a) 4) ⇒  4
+ (symbol-value fred) ⇒  3
+ (symbol-value fred-clone-2a) ⇒  4
+ (symbol-value fred-clone-2b) ⇒  3
+ (boundp fred-clone-1a) ⇒  false
+ (setf (symbol-function fred) #'(lambda (x) x)) ⇒  #<FUNCTION anonymous>
+ (fboundp fred) ⇒  true
+ (fboundp fred-clone-1a) ⇒  false
+ (fboundp fred-clone-2a) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    See Also::

    + +

    make-symbol +

    +

    Notes::

    + +

    Implementors are encouraged not to copy the string +which is the symbol’s name unnecessarily. +Unless there is a good reason to do so, the normal implementation +strategy is for the new-symbol’s name to +be identical to the given symbol’s name. +

    +
    +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    + + + + + diff --git a/info/gcl/copy_002dtree.html b/info/gcl/copy_002dtree.html new file mode 100644 index 0000000..47d5f78 --- /dev/null +++ b/info/gcl/copy_002dtree.html @@ -0,0 +1,99 @@ + + + + + +copy-tree (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.10 copy-tree [Function]

    + +

    copy-tree tree ⇒ new-tree +

    +

    Arguments and Values::

    + +

    tree—a tree. +

    +

    new-tree—a tree. +

    +

    Description::

    + +

    Creates a copy of a tree of conses. +

    +

    If tree is not a cons, it is returned; +otherwise, the result is a new cons of the results of calling copy-tree +on the car and cdr of tree. +In other words, all conses in the tree represented by tree +are copied recursively, stopping only when non-conses are encountered. +

    +

    copy-tree does not preserve circularities and the sharing of substructure. +

    +

    Examples::

    + +
    +
     (setq object (list (cons 1 "one")
+                    (cons 2 (list 'a 'b 'c))))
+⇒  ((1 . "one") (2 A B C))
+ (setq object-too object) ⇒  ((1 . "one") (2 A B C))
+ (setq copy-as-list (copy-list object))
+ (setq copy-as-alist (copy-alist object))
+ (setq copy-as-tree (copy-tree object))
+ (eq object object-too) ⇒  true
+ (eq copy-as-tree object) ⇒  false
+ (eql copy-as-tree object) ⇒  false
+ (equal copy-as-tree object) ⇒  true
+ (setf (first (cdr (second object))) "a"
+       (car (second object)) "two"
+       (car object) '(one . 1)) ⇒  (ONE . 1)
+ object ⇒  ((ONE . 1) ("two" "a" B C))
+ object-too ⇒  ((ONE . 1) ("two" "a" B C))
+ copy-as-list ⇒  ((1 . "one") ("two" "a" B C))
+ copy-as-alist ⇒  ((1 . "one") (2 "a" B C))
+ copy-as-tree ⇒  ((1 . "one") (2 A B C)) 
+
    + +

    See Also::

    + +

    tree-equal +

    + + + + + diff --git a/info/gcl/count.html b/info/gcl/count.html new file mode 100644 index 0000000..f3e556c --- /dev/null +++ b/info/gcl/count.html @@ -0,0 +1,130 @@ + + + + + +count (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.10 count, count-if, count-if-not [Function]

    + +

    count item sequence &key from-end start end key test test-not ⇒ n +

    +

    count-if predicate sequence &key from-end start end key ⇒ n +

    +

    count-if-not predicate sequence &key from-end start end key ⇒ n +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    sequence—a proper sequence. +

    +

    predicate—a designator for a function of one argument + that returns a generalized boolean. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start, end—bounding index designators of sequence. + The defaults for start and end are 0 and nil, respectively. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    n—a non-negative integer + less than or equal to the length of sequence. +

    +

    Description::

    + +

    count, count-if, and count-if-not +count and return the number of elements in +the sequence bounded by start and end +that satisfy the test. +

    +

    The from-end has no direct effect on the result. +However, if from-end is true, +the elements of sequence will be supplied as arguments to + the test, + test-not, + and key in reverse order, +which may change the side-effects, if any, of those functions. +

    +

    Examples::

    + +
    +
     (count #\a "how many A's are there in here?") ⇒  2
+ (count-if-not #'oddp '((1) (2) (3) (4)) :key #'car) ⇒  2
+ (count-if #'upper-case-p "The Crying of Lot 49" :start 4) ⇒  2 
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    Rules about Test Functions, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +

    The function count-if-not is deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/declaim.html b/info/gcl/declaim.html new file mode 100644 index 0000000..39bb04a --- /dev/null +++ b/info/gcl/declaim.html @@ -0,0 +1,74 @@ + + + + + +declaim (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.17 declaim [Macro]

    + +

    declaim {declaration-specifier}* ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    declaration-specifier—a declaration specifier; not evaluated. +

    +

    Description::

    + +

    Establishes the declarations specified by the declaration-specifiers. +

    +

    If a use of this macro appears as a top level form in a file +being processed by the file compiler, the proclamations are also made +at compile-time. As with other defining macros, it is unspecified whether or +not the compile-time side-effects of a declaim persist after the +file has been compiled. +

    +

    Examples::

    + +

    See Also::

    + +

    declare, +proclaim +

    + + + + + diff --git a/info/gcl/declaration.html b/info/gcl/declaration.html new file mode 100644 index 0000000..8939e8e --- /dev/null +++ b/info/gcl/declaration.html @@ -0,0 +1,87 @@ + + + + + +declaration (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.24 declaration [Declaration]

    + +

    Syntax::

    + +

    (declaration {name}*) +

    +

    Arguments::

    + +

    name—a symbol. +

    +

    Valid Context::

    + +

    proclamation only +

    +

    Description::

    + +

    Advises the compiler that each name is a valid but potentially +non-standard declaration name. The purpose of this is to tell one +compiler not to issue warnings for declarations meant for another +compiler or other program processor. +

    +

    Examples::

    + +
    +
     (declaim (declaration author target-language target-machine))
+ (declaim (target-language ada))
+ (declaim (target-machine IBM-650))
+ (defun strangep (x)
+   (declare (author "Harry Tweeker"))
+   (member x '(strange weird odd peculiar)))
+
    + +

    See Also::

    + +

    declaim +, +proclaim +

    + + + + + diff --git a/info/gcl/declare.html b/info/gcl/declare.html new file mode 100644 index 0000000..bc25503 --- /dev/null +++ b/info/gcl/declare.html @@ -0,0 +1,175 @@ + + + + + +declare (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.18 declare [Symbol]

    + +

    Syntax::

    + +

    declare {declaration-specifier}* +

    Arguments::

    + +

    declaration-specifier—a declaration specifier; not evaluated. +

    +

    Description::

    + +

    A declare expression, sometimes called a declaration, +can occur only at the beginning of the bodies of certain forms; +that is, it may be preceded only by other declare expressions, +or by a documentation string if the context permits. +

    +

    A declare expression can occur in a lambda expression +or in any of the forms listed in Figure 3–23. +

    +
    +
      defgeneric                 do-external-symbols   prog                      
+  define-compiler-macro      do-symbols            prog*                     
+  define-method-combination  dolist                restart-case              
+  define-setf-expander       dotimes               symbol-macrolet           
+  defmacro                   flet                  with-accessors            
+  defmethod                  handler-case          with-hash-table-iterator  
+  defsetf                    labels                with-input-from-string    
+  deftype                    let                   with-open-file            
+  defun                      let*                  with-open-stream          
+  destructuring-bind         locally               with-output-to-string     
+  do                         macrolet              with-package-iterator     
+  do*                        multiple-value-bind   with-slots                
+  do-all-symbols             pprint-logical-block                            
+
+       Figure 3–23: Standardized Forms In Which Declarations Can Occur      
+
+
    + +

    A declare expression can only occur +where specified by the syntax of these forms. +The consequences of attempting to evaluate a declare expression +are undefined. In situations where such expressions can appear, +explicit checks are made for their presence and they are never actually evaluated; +it is for this reason that they +are called “declare expressions” +rather than “declare forms.” +

    +

    Macro forms cannot expand into declarations; +declare expressions must appear as actual subexpressions of +the form to which they refer. +

    +

    Figure 3–24 shows a list of declaration identifiers +that can be used with declare. +

    +
    +
      dynamic-extent  ignore     optimize  
+  ftype           inline     special   
+  ignorable       notinline  type      
+
+  Figure 3–24: Local Declaration Specifiers
+
+
    + +

    An implementation is free to support other (implementation-defined) +declaration identifiers as well. +

    +

    Examples::

    + +
    +
     (defun nonsense (k x z)
+   (foo z x)                     ;First call to foo
+   (let ((j (foo k x))           ;Second call to foo
+         (x (* k k)))
+     (declare (inline foo) (special x z))
+     (foo x j z)))               ;Third call to foo
+
    + +

    In this example, +the inline declaration applies +only to the third call to foo, but not to the first or second ones. +The special declaration of x causes let +to make a dynamic binding for x, and causes the reference to +x +in the body of let to be a dynamic reference. +The reference to x in the second call to foo is a local reference +to the second parameter of nonsense. +The reference to x in the first call to foo is a local +reference, not a special one. The special declaration of z +causes the reference to z in the +third +call +to foo to be a dynamic reference; it does not +refer to the parameter to nonsense named z, because that +parameter binding has not been declared to be special. +(The special declaration of z does not appear in the body +of defun, but in an inner form, and therefore does not +affect the binding of the parameter.) +

    +

    Exceptional Situations::

    + +

    The consequences of trying to use a declare expression as +a form to be evaluated are undefined. +

    +

    [Editorial Note by KMP: Probably we need to say something here about ill-formed +declare expressions.] +

    +

    See Also::

    + +

    proclaim +, +Type Specifiers, +declaration, +dynamic-extent, +ftype, +ignorable, +ignore, +inline, +notinline, +optimize, +type +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/decode_002dfloat.html b/info/gcl/decode_002dfloat.html new file mode 100644 index 0000000..a0ba7aa --- /dev/null +++ b/info/gcl/decode_002dfloat.html @@ -0,0 +1,240 @@ + + + + + +decode-float (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.73 decode-float, scale-float, float-radix, float-sign,

    +

    float-digits, float-precision, integer-decode-float

    +

    [Function] +

    +

    decode-float float ⇒ significand, exponent, sign +

    +

    scale-float float integer ⇒ scaled-float +

    +

    float-radix float ⇒ float-radix +

    +

    float-sign float-1 &optional float-2 ⇒ signed-float +

    +

    float-digits float ⇒ digits1 +

    +

    float-precision float ⇒ digits2 +

    +

    integer-decode-float float ⇒ significand, exponent, integer-sign +

    +

    Arguments and Values::

    + +

    digits1—a non-negative integer. +

    +

    digits2—a non-negative integer. +

    +

    exponent—an integer. +

    +

    float—a float. +

    +

    float-1—a float. +

    +

    float-2—a float. +

    +

    float-radix—an integer. +

    +

    integer—a non-negative integer. +

    +

    integer-sign—the integer -1, + or the integer 1. +

    +

    scaled-float—a float. +

    +

    sign—A float of the same type as float + but numerically equal to 1.0 or -1.0. +

    +

    signed-float—a float. +

    +

    significand—a float. +

    +

    Description::

    + +

    decode-float computes three values that characterize +float. +The first value is of the same type +as float and +represents the significand. +The second value represents the exponent +to which the radix (notated in this description by b) must +be raised to obtain the value that, when multiplied with the first +result, produces the absolute value of float. +If float is zero, any integer value may be returned, +provided that the identity shown for scale-float holds. +The third value +is of the same type as float +and is 1.0 if float is greater +than or equal to zero or -1.0 otherwise. +

    +

    decode-float +divides float by an integral power of b +so as to bring its value between 1/b (inclusive) and~1 (exclusive), +and returns the quotient as the first value. +If float is zero, however, the result +equals the absolute value of float (that is, if there is a negative +zero, its significand is considered to be a positive zero). +

    +

    scale-float returns +(* float (expt (float b float) +integer))\/, where b is the radix of the floating-point +representation. float is not necessarily between 1/b and~1. +

    +

    float-radix returns +the radix of float. +

    +

    float-sign returns a number z such +that z and float-1 have the same sign and also such that +z and float-2 have the same absolute value. +If float-2 is not supplied, its value is (float 1 float-1). +If an implementation +has distinct representations for negative zero and positive zero, +then (float-sign -0.0) ⇒ -1.0. +

    +

    float-digits returns +the number of radix b digits +used in the representation of float (including any implicit +digits, such as a “hidden bit”). +

    +

    float-precision +returns +the number of significant radix b digits present in float; +if float is a float +zero, then the result is an integer zero. +

    +

    For normalized floats, +the results of float-digits and float-precision are the same, +but the precision is less than the number of representation digits +for a denormalized or zero number. +

    +

    integer-decode-float computes three values that characterize +float - +the significand scaled so as to be an integer, +and the same last two +values that are returned by decode-float. +If float is zero, integer-decode-float returns +zero as the first value. +The second value bears the same relationship to the first value +as for decode-float: +

    +
    +
     (multiple-value-bind (signif expon sign)
+                      (integer-decode-float f)
+   (scale-float (float signif f) expon)) ≡ (abs f)
+
    + +

    Examples::

    + +
    +
     ;; Note that since the purpose of this functionality is to expose
+ ;; details of the implementation, all of these examples are necessarily
+ ;; very implementation-dependent.  Results may vary widely.
+ ;; Values shown here are chosen consistently from one particular implementation.
+ (decode-float .5) ⇒  0.5, 0, 1.0
+ (decode-float 1.0) ⇒  0.5, 1, 1.0
+ (scale-float 1.0 1) ⇒  2.0
+ (scale-float 10.01 -2) ⇒  2.5025
+ (scale-float 23.0 0) ⇒  23.0
+ (float-radix 1.0) ⇒  2
+ (float-sign 5.0) ⇒  1.0
+ (float-sign -5.0) ⇒  -1.0
+ (float-sign 0.0) ⇒  1.0
+ (float-sign 1.0 0.0) ⇒  0.0
+ (float-sign 1.0 -10.0) ⇒  10.0
+ (float-sign -1.0 10.0) ⇒  -10.0
+ (float-digits 1.0) ⇒  24
+ (float-precision 1.0) ⇒  24
+ (float-precision least-positive-single-float) ⇒  1
+ (integer-decode-float 1.0) ⇒  8388608, -23, 1
+
    + +

    Affected By::

    + +

    The implementation’s representation for floats. +

    +

    Exceptional Situations::

    + +

    The functions decode-float, float-radix, float-digits, +float-precision, and integer-decode-float should signal an error +if their only argument is not a float. +

    +

    The function scale-float should signal an error if its first argument +is not a float or if its second argument is not an integer. +

    +

    The function float-sign should signal an error if its first argument +is not a float or if its second argument is supplied but is +not a float. +

    +

    Notes::

    + +

    The product of the first result of decode-float or integer-decode-float, +of the radix raised to the power of the second result, and of the third result +is exactly equal to the value of float. +

    +
    +
     (multiple-value-bind (signif expon sign)
+                      (decode-float f)
+   (scale-float signif expon))
+≡ (abs f)
+
    + +

    and +

    +
    +
     (multiple-value-bind (signif expon sign)
+                      (decode-float f)
+   (* (scale-float signif expon) sign))
+≡ f
+
    + +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/decode_002duniversal_002dtime.html b/info/gcl/decode_002duniversal_002dtime.html new file mode 100644 index 0000000..ed272aa --- /dev/null +++ b/info/gcl/decode_002duniversal_002dtime.html @@ -0,0 +1,104 @@ + + + + + +decode-universal-time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.1 decode-universal-time [Function]

    + +

    decode-universal-time universal-time &optional time-zone
    + ⇒ second, minute, hour, date, month, year, day, daylight-p, zone +

    +

    Arguments and Values::

    + +

    universal-time—a universal time. +

    +

    time-zone—a time zone. +

    +

    second, minute, hour, date, month, +year, day, daylight-p, zone—a decoded time. +

    +

    Description::

    + +

    Returns the decoded time represented by the given universal time. +

    +

    If time-zone is not supplied, +it defaults to the current time zone adjusted for daylight saving time. +

    +

    If time-zone is supplied, daylight saving time information is ignored. +The daylight saving time flag is nil if time-zone is supplied. +

    +

    Examples::

    + +
    +
     (decode-universal-time 0 0) ⇒  0, 0, 0, 1, 1, 1900, 0, false, 0
+
+;; The next two examples assume Eastern Daylight Time.
+ (decode-universal-time 2414296800 5) ⇒  0, 0, 1, 4, 7, 1976, 6, false, 5
+ (decode-universal-time 2414293200) ⇒  0, 0, 1, 4, 7, 1976, 6, true, 5
+
+;; This example assumes that the time zone is Eastern Daylight Time
+;; (and that the time zone is constant throughout the example).
+ (let* ((here (nth 8 (multiple-value-list (get-decoded-time)))) ;Time zone
+        (recently (get-universal-time))
+        (a (nthcdr 7 (multiple-value-list (decode-universal-time recently))))
+        (b (nthcdr 7 (multiple-value-list (decode-universal-time recently here)))))
+   (list a b (equal a b))) ⇒  ((T 5) (NIL 5) NIL)
+
    + +

    Affected By::

    + +

    Implementation-dependent mechanisms for calculating when or if daylight +savings time is in effect for any given session. +

    +

    See Also::

    + +

    encode-universal-time +, +get-universal-time +, +Time +

    + + + + + diff --git a/info/gcl/defclass.html b/info/gcl/defclass.html new file mode 100644 index 0000000..8e520cc --- /dev/null +++ b/info/gcl/defclass.html @@ -0,0 +1,403 @@ + + + + + +defclass (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.25 defclass [Macro]

    + +

    defclass class-name ({superclass-name}*) +({slot-specifier}*) + [[!class-option]]
    + ⇒ new-class +

    +

     slot-specifier::=slot-name | (slot-name [[!slot-option]])
    +

    +

     slot-name::= symbol
    +

    +

     slot-option::={:reader reader-function-name}* |
    +                         {:writer writer-function-name}* |
    +                         {:accessor reader-function-name}* |
    +                         {:allocation allocation-type} |
    +                         {:initarg initarg-name}* |
    +                         {:initform form} |
    +                         {:type type-specifier} |
    +                         {:documentation string}
    +

    +

     function-name::= {symbol | (setf symbol)}
    +

    +

     class-option::=(:default-initargs . initarg-list) |
    +                          (:documentation string) |
    +                          (:metaclass class-name)
    +

    +

    Arguments and Values::

    + +

    Class-name—a non-nil symbol. +

    +

    Superclass-name–a non-nil symbol. +

    +

    Slot-name–a symbol. + The slot-name argument is + a symbol that is syntactically valid for use as a variable name. +

    +

    Reader-function-name—a non-nil symbol. + :reader can be supplied more than once for a given slot. +

    +

    Writer-function-name—a generic function name. + :writer can be supplied more than once for a given slot. +

    +

    Reader-function-name—a non-nil symbol. + :accessor can be supplied more than once for a given slot. +

    +

    Allocation-type—(member :instance :class). + :allocation can be supplied once at most for a given slot. +

    +

    Initarg-name—a symbol. + :initarg can be supplied more than once for a given slot. +

    +

    Form—a form. + :init-form can be supplied once at most for a given slot. +

    +

    Type-specifier—a type specifier. + :type can be supplied once at most for a given slot. +

    +

    Class-option— refers to the class as a whole or to all class slots. +

    +

    Initarg-list—a list of alternating initialization argument + names and default initial value forms. + :default-initargs can be supplied at most once. +

    +

    Class-name—a non-nil symbol. + :metaclass can be supplied once at most. +

    +

    new-class—the new class object. +

    +

    Description::

    + +

    The macro defclass defines a new named class. It returns +the new class object as its result. +

    +

    The syntax of defclass provides options for specifying +initialization arguments for slots, for specifying default +initialization values for slots, and for requesting that +methods on specified generic functions be automatically +generated for reading and writing the values of slots. +No reader or writer functions are defined by default; +their generation must be explicitly requested. However, +slots can always be accessed using slot-value. +

    +

    Defining a new class also causes a type of the same name to be +defined. The predicate (typep object class-name) returns +true if the class of the given object is +the class named by class-name itself or +a subclass of the class class-name. A class object +can be used as a type specifier. +Thus (typep object class) returns true +if the class of the object is +class itself or a subclass of class. +

    +

    The class-name argument specifies the proper name +of the new class. +If a class with the same proper name already exists + and that class is an instance of standard-class, + and if the defclass form for the definition of the new class + specifies a class of class standard-class, +the existing class is redefined, +and instances of it (and its subclasses) are updated + to the new definition at the time that they are next accessed. +For details, see Redefining Classes. +

    +

    Each superclass-name argument +specifies a direct superclass of the new class. +If the superclass list is empty, then the superclass +defaults depending on the metaclass, +with standard-object being the +default for standard-class. +

    +

    The new class will +inherit slots and methods +from each of its direct superclasses, from +their direct superclasses, and so on. +For a discussion of how slots and methods are inherited, +see Inheritance. +

    +

    The following slot options are available: +

    +
    +
    *
    +

    The :reader slot option specifies that an unqualified method is +to be defined on the generic function named reader-function-name +to read the value of the given slot. +

    +
    +
    *
    +

    The :writer slot option specifies that an unqualified method is +to be defined on the generic function named writer-function-name +to write the value of the slot. +

    +
    +
    *
    +

    The :accessor slot option specifies that an unqualified method +is to be defined on the generic function named reader-function-name +to read the value of the given slot +and that an unqualified method is to be defined on the +generic function named (setf reader-function-name) to be +used with setf to modify the value of the slot. +

    +
    +
    *
    +

    The :allocation slot option is used to specify where storage is +to be allocated for the given slot. Storage for a +slot can be located +in each instance or in the class object itself. +The value of the allocation-type argument can be +either the keyword :instance +or the keyword :class. If the :allocation +slot option is not specified, the effect is the same as specifying +:allocation :instance. +

    +
    –
    +

    If allocation-type is :instance, a local slot of +the name slot-name is allocated in each instance of the +class. +

    +
    +
    –
    +

    If allocation-type is :class, a shared +slot of the given +name is allocated in the class object created by this defclass +form. The value of the slot is shared by all +instances of the class. +If a class C_1 defines such a shared slot, any +subclass C_2 of +C_1 will share this single slot unless the defclass form +for C_2 specifies a slot of the same name or there is a +superclass of C_2 that precedes C_1 in the class precedence +list of C_2 and that defines a slot of the same name. +

    +
    + +
    +
    *
    +

    The :initform slot option is used to provide a default +initial value form to be used in the initialization of the slot. This +form is evaluated every time it is used to initialize the +slot. The +lexical environment in which this form is evaluated is the lexical +environment in which the defclass form was evaluated. +Note that the lexical environment refers both to variables and to +functions. For local slots, the dynamic environment is the dynamic +environment in which make-instance is called; for shared +slots, the dynamic environment is the dynamic environment in which the +defclass form was evaluated. +See Object Creation and Initialization. +

    +

    No implementation is permitted to extend the syntax of defclass +to allow (slot-name form) as an abbreviation for +(slot-name :initform form). +

    +

    [Reviewer Note by Barmar: Can you extend this to mean something else?] +

    +
    +
    *
    +

    The :initarg slot option declares an initialization +argument named initarg-name and specifies that this +initialization argument initializes the given slot. If the +initialization argument has a value in the call to +initialize-instance, the value will be stored into the given slot, +and the slot’s :initform slot option, if any, is not +evaluated. If none of the initialization arguments specified for a +given slot has a value, the slot is initialized according to the +:initform slot option, if specified. +

    +
    +
    *
    +

    The :type slot option specifies that the contents of the +slot will always be of the specified data type. It effectively +declares the result type of the reader generic function when applied +to an object of this class. The consequences of attempting to store in a +slot a value that does not satisfy the type of the slot are undefined. +The :type slot option is further discussed in +Inheritance of Slots and Slot Options. +

    +
    +
    *
    +

    The :documentation slot option provides a documentation string +for the slot. :documentation can be supplied once at most +for a given slot. +[Reviewer Note by Barmar: How is this retrieved?] +

    +
    + +

    Each class option is an option that refers to the class as a whole. +The following class options are available: +

    +
    +
    *
    +

    The :default-initargs class option is followed by a list of +alternating initialization argument names and default initial value +forms. If any of these initialization arguments does not appear in +the initialization argument list supplied to make-instance, the +corresponding default initial value form is evaluated, and the +initialization argument name and the form’s value are added to the end +of the initialization argument list before the instance is created; +see Object Creation and Initialization. +The default initial value form is evaluated each time it is used. The lexical +environment in which this form is evaluated is the lexical environment +in which the defclass form was evaluated. The dynamic +environment is the dynamic environment in which make-instance +was called. If an initialization argument name appears more than once +in a :default-initargs class option, an error is signaled. +

    +
    +
    *
    +
    +

    The :documentation class option causes a documentation string +to be attached with the class object, +and attached with kind type to the class-name. +:documentation can be supplied once at most. +

    +
    +
    *
    +

    The :metaclass class option is used to specify that +instances of the class being defined are to have a different metaclass +than the default provided by the system (the class standard-class). +

    +
    +
    + +

    Note the following rules of defclass for standard classes: +

    +
    +
    *
    +

    It is not required that the superclasses of a class be defined before +the defclass form for that class is evaluated. +

    +
    +
    *
    +

    All the superclasses of a class must be defined before +an instance of the class can be made. +

    +
    +
    *
    +

    A class must be defined before it can be used as a parameter +specializer in a defmethod form. +

    +
    +
    + +

    The object system can be extended to cover situations where these rules are not +obeyed. +

    +

    Some slot options are inherited by a class from its +superclasses, and +some can be shadowed or altered by providing a local slot description. +No class options except :default-initargs are inherited. For a +detailed description of how slots and slot options are inherited, +see Inheritance of Slots and Slot Options. +

    +

    The options to defclass can be extended. It is required that +all implementations signal an error if they observe a class option or +a slot option that is not implemented locally. +

    +

    It is valid to specify more than one reader, writer, accessor, or +initialization argument for a slot. No other slot option can +appear +more than once in a single slot description, or an error is +signaled. +

    +

    If no reader, writer, or accessor is specified for a slot, +the slot can only be accessed by the function slot-value. +

    +

    If a defclass form appears as a top level form, +the compiler must make the class name be recognized as a +valid type name in subsequent declarations (as for deftype) +and be recognized as a valid class name for defmethod +parameter specializers and for use as the :metaclass option of a +subsequent defclass. The compiler must make +the class definition +available to be returned by find-class when its environment +argument is a value received as the environment parameter of a macro. +

    +

    Exceptional Situations::

    + +

    If there are any duplicate slot names, +an error of type program-error is signaled. +

    +

    If an initialization argument name appears more than once in +:default-initargs class option, +an error of type program-error is signaled. +

    +

    If any of the following slot options appears more than once in a +single slot description, an error of type program-error +is signaled: :allocation, +:initform, :type, :documentation. +

    +

    It is required that all implementations signal +an error of type program-error if they observe a class option +or a slot option that is not implemented locally. +

    +

    See Also::

    + +

    documentation +, +Initialize-Instance +, +make-instance +, +slot-value +, +Classes, +Inheritance, +Redefining Classes, +Determining the Class Precedence List, +Object Creation and Initialization +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/defconstant.html b/info/gcl/defconstant.html new file mode 100644 index 0000000..9fc6335 --- /dev/null +++ b/info/gcl/defconstant.html @@ -0,0 +1,147 @@ + + + + + +defconstant (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.15 defconstant [Macro]

    + +

    defconstant name initial-value [documentation] ⇒ name +

    +

    Arguments and Values::

    + +

    name—a symbol; not evaluated. +

    +

    initial-value—a form; evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    Description::

    + +

    defconstant +causes the global variable named by name to be +given a value that is the result of evaluating initial-value. +

    +

    A constant defined by defconstant can be redefined +with defconstant. +However, the consequences are undefined if an attempt is made to assign +a value to the symbol using another operator, or to +assign it to a different +value using a subsequent +defconstant. +

    +

    If documentation is supplied, it is attached to name as a +documentation string of kind variable. +

    +

    defconstant +normally appears as a top level form, but it is meaningful +for it to appear as a non-top-level form. +However, the compile-time side +effects described below +only take place when defconstant appears as a +top level form. +

    +

    The consequences are undefined if there are any +bindings +of the variable named by name at the time defconstant +is executed or if the value is not eql to the value of +initial-value. +

    +

    The consequences are undefined when constant symbols are rebound +as either lexical or dynamic variables. In other words, a reference to a +symbol declared with defconstant always refers to its global value. +

    +

    The side effects of the execution of defconstant must +be equivalent to at least the side effects of the execution of the following +code: +

    +
    +
     (setf (symbol-value 'name) initial-value)
+ (setf (documentation 'name 'variable) 'documentation)
+
    + +

    If a defconstant form appears as a top level form, +the compiler must recognize that name names +a constant variable. An implementation may choose to +evaluate the value-form at compile time, load time, or both. +Therefore, users must ensure that the initial-value +can be evaluated at compile time +(regardless of whether or not references to name +appear in the file) and that it always evaluates +to the same value. +

    +

    [Editorial Note by KMP: Does “same value” here mean eql or similar?] +

    +

    [Reviewer Note by Moon: Probably depends on whether load time is compared to compile time, + or two compiles.] +

    +

    Examples::

    +
    +
     (defconstant this-is-a-constant 'never-changing "for a test") ⇒  THIS-IS-A-CONSTANT
+this-is-a-constant ⇒  NEVER-CHANGING
+ (documentation 'this-is-a-constant 'variable) ⇒  "for a test"
+ (constantp 'this-is-a-constant) ⇒  true
+
    + +

    See Also::

    + +

    declaim +, +defparameter +, +defvar, +documentation +, +proclaim +, +Constant Variables, +Compilation +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/defgeneric.html b/info/gcl/defgeneric.html new file mode 100644 index 0000000..33f2b98 --- /dev/null +++ b/info/gcl/defgeneric.html @@ -0,0 +1,330 @@ + + + + + +defgeneric (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.26 defgeneric [Macro]

    + +

    defgeneric function-name gf-lambda-list + [[!option | {!method-description}*]]
    + ⇒ new-generic +

    +

    option ::=(:argument-precedence-order {parameter-name}^+) | +           (declare {gf-declaration}^+) | +           (:documentation gf-documentation) | +           (:method-combination method-combination {method-combination-argument}*) | +           (:generic-function-class generic-function-class) | +           (:method-class method-class) +

    +

    method-description ::=(:method {method-qualifier}* specialized-lambda-list [[{declaration}* | documentation]] {form}*) +

    +

    Arguments and Values::

    + +

    function-name—a function name. +

    +

    generic-function-class—a non-nil symbol naming a class. +

    +

    gf-declaration—an optimize declaration specifier; + other declaration specifiers are not permitted. +

    +

    gf-documentation—a string; not evaluated. +

    +

    gf-lambda-list—a generic function lambda list. +

    +

    method-class—a non-nil symbol naming a class. +

    +

    method-combination-argument—an object. +

    +

    method-combination-name—a symbol + naming a method combination type. +

    +

    method-qualifiers, +specialized-lambda-list, +declarations, +documentation, +forms—as per defmethod. +

    +

    new-generic—the generic function object. +

    +

    parameter-name—a symbol that names a required parameter + in the lambda-list. + (If the :argument-precedence-order option is specified, + each required parameter in the lambda-list + must be used exactly once as a parameter-name.) +

    +

    Description::

    + +

    The macro defgeneric is used to define a generic function +or to specify options and declarations that pertain +to a generic function as a whole. +

    +

    If function-name is a +list it must be of the form (setf symbol). +If (fboundp function-name) is false, a new +generic function is created. +

    +

    If (fdefinition function-name) is a generic function, that +

    +

    generic function +is modified. If function-name names +an ordinary function, +a macro, or a special operator, +an error is signaled. +

    +

    The effect of the defgeneric macro is as if the following three +steps were performed: first, +methods defined by previous defgeneric forms are removed; +

    +

    [Reviewer Note by Barmar: Shouldn’t this (second) be first?] +second, ensure-generic-function +is called; and finally, methods specified by the current +defgeneric form are added to the generic function. +

    +

    Each method-description defines a method on the generic function. +The lambda list of each method must be congruent with the +lambda list +specified by the gf-lambda-list option. +If no method descriptions are specified and a generic function of the same +name does not already exist, a generic function with no +methods is created. +

    +

    The gf-lambda-list argument of defgeneric specifies the shape of +lambda lists for the methods on this generic function. +All methods on the resulting +generic function must have +lambda lists that are congruent with this shape. If a defgeneric +form is evaluated and some +methods for that generic function +have lambda lists that are not congruent with that given in +the defgeneric form, an error is signaled. For further details +on method congruence, see Congruent Lambda-lists for all Methods of a Generic Function. +

    +

    The generic function passes to the +method all the argument values passed to +it, and only those; default values are not supported. +Note that optional and keyword arguments in method definitions, however, +can have default initial value forms and can use supplied-p parameters. +

    +

    The following options are provided. +

    +

    Except as otherwise noted, +

    +

    a given option may occur only once. +

    +
    +
    *
    +

    The :argument-precedence-order option is used to specify the +order in which the required arguments in a call to the generic function +are tested for specificity when selecting a particular +method. Each required argument, as specified in the gf-lambda-list +argument, must be included exactly once as a parameter-name +so that the full and unambiguous precedence order is +supplied. If this condition is not met, an error is signaled. +

    +

    [Reviewer Note by Barmar: What is the default order?] +

    +
    +
    *
    +

    The declare option is used to specify declarations that pertain +to the generic function. +

    +

    An optimize declaration specifier is allowed. +It specifies whether method selection should be optimized for +speed or space, but it has no effect on methods. +To control how a method is optimized, an optimize +declaration must be placed directly in the defmethod form +or method description. The optimization qualities speed and +space are the only qualities this standard requires, but an +implementation can extend the object system to recognize other qualities. +A simple implementation that has only one method selection technique +and ignores optimize declaration specifiers is valid. +

    +

    The special, ftype, function, inline, +notinline, and declaration declarations are not permitted. +Individual implementations can extend the declare option to +support additional declarations. +

    +

    [Editorial Note by KMP: Does “additional” mean including special, ftype, etc.? +Or only other things that are not mentioned here?] +If an implementation notices a declaration specifier that it does +not support and that has not been proclaimed as a non-standard +declaration identifier name in a declaration proclamation, +it should issue a warning. +[Editorial Note by KMP: The wording of this previous sentence, +particularly the word “and” suggests to me that you can ‘proclaim declaration’ +of an unsupported declaration (e.g., ftype) in order to suppress the warning. +That seems wrong. Perhaps it instead means to say “does not support or +is both undefined and not proclaimed declaration.”] +

    +

    The declare option may be specified more than once. +The effect is the same as if the lists of declaration specifiers +had been appended together into a single list and specified as a +single declare option. +

    +
    +
    *
    +

    The :documentation argument is a documentation string +to be attached to the generic function object, +and to be attached with kind function to the function-name. +

    +
    +
    *
    +

    The :generic-function-class option may be used to specify that +the generic function is to have a different class than +the default provided by the system (the class standard-generic-function). +The class-name argument is the name of a class that can be the +class of a generic function. If function-name specifies +an existing generic function that has a different value for the +:generic-function-class argument and the new generic function +class is compatible with the old, change-class is called +to change the class of the generic function; +otherwise an error is signaled. +

    +
    +
    *
    +

    The :method-class option is used to specify that all methods on +this generic function are to have a different class from the +default provided by the system (the class standard-method). +The class-name argument is the name of a class that is capable +of being the class of a method. +

    +

    [Reviewer Note by Barmar: Is change-class called on existing methods?] +

    +
    +
    *
    +

    The :method-combination option is followed by a symbol that +names a type of method combination. The arguments (if any) that +follow that symbol depend on the type of method combination. Note +that the standard method combination type does not support any +arguments. However, all types of method combination defined by the +short form of define-method-combination accept an optional +argument named order, defaulting to :most-specific-first, +where a value of :most-specific-last reverses +the order of the primary methods without affecting the order of the +auxiliary methods. +

    +
    +
    + +

    The method-description arguments define methods that will +be associated with the generic function. The method-qualifier +and specialized-lambda-list arguments in a method description +are the same as for defmethod. +

    +

    The form arguments specify the method body. The body of the +method is enclosed in an implicit block. +If function-name is a symbol, this block bears the same name as +the generic function. If function-name is a +list of the +form (setf symbol), the name of the block is symbol. +

    +

    Implementations can extend defgeneric to include other options. +It is required that an implementation signal an error if +it observes an option that is not implemented locally. +

    +

    defgeneric is not required to perform any compile-time side effects. +In particular, the methods are not installed for invocation during +compilation. An implementation may choose to store information about +the generic function for the purposes of compile-time error-checking +(such as checking the number of arguments on calls, or noting that a definition + for the function name has been seen). +

    +

    Examples::

    + +

    Exceptional Situations::

    + +

    If function-name names an ordinary function, a macro, +or a special operator, an error of type program-error is signaled. +

    +

    Each required argument, as specified in the gf-lambda-list +argument, must be included exactly once as a parameter-name, +or an error of type program-error is signaled. +

    +

    The lambda list of each method specified by a +method-description must be congruent with the lambda list specified +by the gf-lambda-list option, or +an error of type error is signaled. +

    +

    If a defgeneric form is evaluated and some methods for +that generic function have lambda lists that are not congruent with +that given in the defgeneric form, +an error of type error is signaled. +

    +

    A given option may occur only once, +or an error of type program-error is signaled. +

    +

    [Reviewer Note by Barmar: This says that an error is signaled if you specify the same generic + function class as it already has!] +If function-name specifies an existing generic function +that has a different value for the :generic-function-class +argument and the new generic function class is compatible with the +old, change-class is called to change the class of +the generic function; otherwise an error of type error is signaled. +

    +

    Implementations can extend defgeneric to include other options. +It is required that an implementation +signal an error of type program-error if +it observes an option that is not implemented locally. +

    +

    See Also::

    + +

    defmethod +, +documentation +, +ensure-generic-function +, +

    +

    generic-function, +

    +

    Congruent Lambda-lists for all Methods of a Generic Function +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/define_002dcompiler_002dmacro.html b/info/gcl/define_002dcompiler_002dmacro.html new file mode 100644 index 0000000..0a0378a --- /dev/null +++ b/info/gcl/define_002dcompiler_002dmacro.html @@ -0,0 +1,239 @@ + + + + + +define-compiler-macro (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.9 define-compiler-macro [Macro]

    + +

    define-compiler-macro name lambda-list [[{declaration}* | documentation]] {form}*
    + ⇒ name +

    +

    Arguments and Values::

    + +

    name—a function name. +

    +

    lambda-list—a macro lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    form—a form. +

    +

    Description::

    + +

    [Editorial Note by KMP: This definition probably needs to be fully expanded to not + refer through the definition of defmacro, but should suffice for now.] +

    +

    This is the normal mechanism for defining a compiler macro function. +Its manner of definition is the same as for defmacro; the only +differences are: +

    +
    +
    *
    +

    The name can be a function name naming + any function or macro. +

    +
    +
    *
    +

    The expander function is installed as a compiler macro function + for the name, rather than as a macro function. +

    +
    +
    *
    +

    The &whole argument is bound to the form argument that + is passed to the compiler macro function. The remaining lambda-list + parameters are specified as if this form contained the function name in the + car and the actual arguments in the cdr, but if the car + of the actual form is the symbol funcall, then the destructuring of + the arguments is actually performed using its cddr instead. +

    +
    +
    *
    +
    +

    Documentation is attached as a documentation string + to name (as kind compiler-macro) +and to the compiler macro function. +

    +
    +
    *
    +

    Unlike an ordinary macro, a compiler macro + can decline to provide an expansion merely by returning a form that is + the same as the original (which can be obtained by using + &whole). +

    +
    + +

    Examples::

    + +
    +
     (defun square (x) (expt x 2)) ⇒  SQUARE
+ (define-compiler-macro square (&whole form arg)
+   (if (atom arg)
+       `(expt ,arg 2)
+       (case (car arg)
+         (square (if (= (length arg) 2)
+                     `(expt ,(nth 1 arg) 4)
+                     form))
+         (expt   (if (= (length arg) 3)
+                     (if (numberp (nth 2 arg))
+                         `(expt ,(nth 1 arg) ,(* 2 (nth 2 arg)))
+                         `(expt ,(nth 1 arg) (* 2 ,(nth 2 arg))))
+                     form))
+         (otherwise `(expt ,arg 2))))) ⇒  SQUARE
+ (square (square 3)) ⇒  81
+ (macroexpand '(square x)) ⇒  (SQUARE X), false
+ (funcall (compiler-macro-function 'square) '(square x) nil)
+⇒  (EXPT X 2)
+ (funcall (compiler-macro-function 'square) '(square (square x)) nil)
+⇒  (EXPT X 4)
+ (funcall (compiler-macro-function 'square) '(funcall #'square x) nil)
+⇒  (EXPT X 2)
+
+ (defun distance-positional (x1 y1 x2 y2)
+   (sqrt (+ (expt (- x2 x1) 2) (expt (- y2 y1) 2))))
+⇒  DISTANCE-POSITIONAL
+ (defun distance (&key (x1 0) (y1 0) (x2 x1) (y2 y1))
+   (distance-positional x1 y1 x2 y2))
+⇒  DISTANCE
+ (define-compiler-macro distance (&whole form
+                                  &rest key-value-pairs
+                                  &key (x1 0  x1-p)
+                                       (y1 0  y1-p)
+                                       (x2 x1 x2-p)
+                                       (y2 y1 y2-p)
+                                  &allow-other-keys
+                                  &environment env)
+   (flet ((key (n) (nth (* n 2) key-value-pairs))
+          (arg (n) (nth (1+ (* n 2)) key-value-pairs))
+          (simplep (x)
+            (let ((expanded-x (macroexpand x env)))
+              (or (constantp expanded-x env)
+                  (symbolp expanded-x)))))
+     (let ((n (/ (length key-value-pairs) 2)))
+       (multiple-value-bind (x1s y1s x2s y2s others)
+           (loop for (key) on key-value-pairs by #'cddr
+                 count (eq key ':x1) into x1s
+                 count (eq key ':y1) into y1s
+                 count (eq key ':x2) into x2s
+                 count (eq key ':y1) into y2s
+                 count (not (member key '(:x1 :x2 :y1 :y2)))
+                   into others
+                 finally (return (values x1s y1s x2s y2s others)))
+         (cond ((and (= n 4)
+                     (eq (key 0) :x1)
+                     (eq (key 1) :y1)
+                     (eq (key 2) :x2)
+                     (eq (key 3) :y2))
+                `(distance-positional ,x1 ,y1 ,x2 ,y2))
+               ((and (if x1-p (and (= x1s 1) (simplep x1)) t)
+                     (if y1-p (and (= y1s 1) (simplep y1)) t)
+                     (if x2-p (and (= x2s 1) (simplep x2)) t)
+                     (if y2-p (and (= y2s 1) (simplep y2)) t)
+                     (zerop others))
+                `(distance-positional ,x1 ,y1 ,x2 ,y2))
+               ((and (< x1s 2) (< y1s 2) (< x2s 2) (< y2s 2)
+                     (zerop others))
+                (let ((temps (loop repeat n collect (gensym))))
+                  `(let ,(loop for i below n
+                               collect (list (nth i temps) (arg i)))
+                     (distance
+                       ,@(loop for i below n
+                               append (list (key i) (nth i temps)))))))
+               (t form))))))
+⇒  DISTANCE
+ (dolist (form
+           '((distance :x1 (setq x 7) :x2 (decf x) :y1 (decf x) :y2 (decf x))
+             (distance :x1 (setq x 7) :y1 (decf x) :x2 (decf x) :y2 (decf x))
+             (distance :x1 (setq x 7) :y1 (incf x))
+             (distance :x1 (setq x 7) :y1 (incf x) :x1 (incf x))
+             (distance :x1 a1 :y1 b1 :x2 a2 :y2 b2)
+             (distance :x1 a1 :x2 a2 :y1 b1 :y2 b2)
+             (distance :x1 a1 :y1 b1 :z1 c1 :x2 a2 :y2 b2 :z2 c2)))
+   (print (funcall (compiler-macro-function 'distance) form nil)))
+ |>  (LET ((#:G6558 (SETQ X 7))
+ |>        (#:G6559 (DECF X))
+ |>        (#:G6560 (DECF X))
+ |>        (#:G6561 (DECF X)))
+ |>    (DISTANCE :X1 #:G6558 :X2 #:G6559 :Y1 #:G6560 :Y2 #:G6561)) 
+ |>  (DISTANCE-POSITIONAL (SETQ X 7) (DECF X) (DECF X) (DECF X)) 
+ |>  (LET ((#:G6567 (SETQ X 7))
+ |>        (#:G6568 (INCF X)))
+ |>    (DISTANCE :X1 #:G6567 :Y1 #:G6568)) 
+ |>  (DISTANCE :X1 (SETQ X 7) :Y1 (INCF X) :X1 (INCF X)) 
+ |>  (DISTANCE-POSITIONAL A1 B1 A2 B2) 
+ |>  (DISTANCE-POSITIONAL A1 B1 A2 B2) 
+ |>  (DISTANCE :X1 A1 :Y1 B1 :Z1 C1 :X2 A2 :Y2 B2 :Z2 C2) 
+⇒  NIL
+
    + +

    See Also::

    + +

    compiler-macro-function +, +defmacro +, +documentation +, +Syntactic Interaction of Documentation Strings and Declarations +

    +

    Notes::

    + +

    The consequences of writing a compiler macro definition for a function +in the COMMON-LISP package are undefined; it is quite possible that in some +implementations such an attempt would override an equivalent or equally +important definition. In general, it is recommended that a programmer only +write compiler macro definitions for functions he or she personally +maintains–writing a compiler macro definition for a function maintained +elsewhere is normally considered a violation of traditional rules of modularity +and data abstraction. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/define_002dcondition.html b/info/gcl/define_002dcondition.html new file mode 100644 index 0000000..7a040d5 --- /dev/null +++ b/info/gcl/define_002dcondition.html @@ -0,0 +1,405 @@ + + + + + +define-condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.29 define-condition [Macro]

    + +

    [Editorial Note by KMP: This syntax stuff is still very confused and needs lots of work.] +

    +

    define-condition name ({parent-type}*) + ({!slot-spec}*) + {option}*
    + ⇒ name +

    +

    slot-spec ::=slot-name | (slot-name !slot-option) +

    +

    slot-option ::=[[ {:reader symbol}* |  +                {:writer !function-name}* |  +                {:accessor symbol}* |  +                {:allocation !allocation-type} |  +                {:initarg symbol}* |  +                {:initform form} |  +                {:type type-specifier} ]] +

    +

    option ::=[[ (:default-initargs . initarg-list) |  +           (:documentation string) |  +           (:report report-name) ]] +

    +

    function-name ::={symbol | (setf symbol)} +

    +

    allocation-type ::=:instance | :class +

    +

    report-name ::=string | symbol | lambda expression +

    +

    Arguments and Values::

    + +

    name—a symbol. +

    +

    parent-type—a symbol naming a condition type. + If no parent-types are supplied, + the parent-types default to (condition). +

    +

    default-initargs—a list of keyword/value pairs. +

    +

    [Editorial Note by KMP: This is all mixed up as to which is a slot option and which is + a main option. I’ll sort that out. Also, some of this is implied + by the bnf and needn’t be stated explicitly.] +

    +

    Slot-spec – the name of a slot or a list +consisting of the slot-name followed by zero or more slot-options. +

    +

    Slot-name – a slot name (a symbol), +the list of a slot name, or the +list of slot name/slot form pairs. +

    +

    Option – Any of the following: +

    +
    +
    :reader
    +

    :reader can be supplied more than once for a given slot +and cannot be nil. +

    +
    +
    :writer
    +

    :writer can be supplied more than once for a given slot +and must name a generic function. +

    +
    +
    :accessor
    +

    :accessor can be supplied more than once for a given slot +and cannot be nil. +

    +
    +
    :allocation
    +

    :allocation can be supplied once at most for a given slot. +The default if :allocation is not supplied is :instance. +

    +
    +
    :initarg
    +

    :initarg can be supplied more than once for a given slot. +

    +
    +
    :initform
    +

    :initform can be supplied once at most for a given slot. +

    +
    +
    :type
    +

    :type can be supplied once at most for a given slot. +

    +
    +
    :documentation
    +

    :documentation can be supplied once at most for a given slot. +

    +
    +
    :report
    +

    :report can be supplied once at most. +

    +
    +
    + +

    Description::

    + +

    define-condition defines a new condition type called name, +which is a subtype of +

    +

    the type or types named by + parent-type. +Each parent-type argument specifies a direct supertype +of the new condition. The new condition +inherits slots and methods from each of its direct +supertypes, and so on. +

    +

    If a slot name/slot form pair is supplied, +the slot form is a form that +can be evaluated by make-condition to + produce a default value when an explicit value is not provided. If no +slot form +is supplied, the contents of the slot +is initialized in an + implementation-dependent way. +

    +

    If the type being defined and some other +type from which it inherits + have a slot by the same name, only one slot is allocated in the + condition, +but the supplied slot form overrides any slot form + that might otherwise have been inherited from a parent-type. If no +slot form is supplied, the inherited slot form (if any) is still visible. +

    +

    Accessors are created according to the same rules as used by +defclass. +

    +

    A description of slot-options follows: +

    +
    +
    :reader
    +

    The :reader slot option specifies that an unqualified method is +to be defined on the generic function named by the argument +to :reader to read the value of the given slot. +

    +
    +
    *
    +

    The :initform slot option is used to provide a default +initial value form to be used in the initialization of the slot. This +form is evaluated every time it is used to initialize the +slot. The +lexical environment +in which this form is evaluated is the lexical +environment in which the define-condition +form was evaluated. +Note that the lexical environment refers both to variables and to +functions. +For local slots, the dynamic environment is the dynamic +environment +in which make-condition was called; for +shared slots, the dynamic environment +is the dynamic environment in which the +define-condition form was evaluated. +

    +

    [Reviewer Note by Barmar: Issue CLOS-CONDITIONS doesn’t say this.] +No implementation is permitted to extend the syntax of define-condition +to allow (slot-name form) as an abbreviation for +(slot-name :initform form). +

    +
    +
    :initarg
    +

    The :initarg slot option declares an initialization +argument named by its symbol argument +and specifies that this +initialization argument initializes the given slot. If the +initialization argument has a value in the call to +initialize-instance, the value is stored into the given slot, +and the slot’s :initform slot option, if any, is not +evaluated. If none of the initialization arguments specified for a +given slot has a value, the slot is initialized according to the +:initform slot option, if specified. +

    +
    +
    :type
    +

    The :type slot option specifies that the contents of the +slot is always of the specified type. It effectively +declares the result type of the reader generic function when applied +to an object of this condition type. +The consequences of attempting to store in a +slot a value that +does not satisfy the type of the slot is undefined. +

    +
    +
    :default-initargs
    +
    +

    [Editorial Note by KMP: This is an option, not a slot option.] +

    +

    This option is treated the same as it would be defclass. +

    +
    +
    :documentation
    +
    +

    [Editorial Note by KMP: This is both an option and a slot option.] +

    +

    The :documentation slot option provides a documentation string +for the slot. +

    +
    +
    :report
    +
    +

    [Editorial Note by KMP: This is an option, not a slot option.] +

    +

    Condition reporting is mediated through the print-object +method for the condition type in question, with *print-escape* +always being nil. Specifying (:report report-name) +in the definition of a condition type C is equivalent to: +

    +
    +
     (defmethod print-object ((x c) stream)
+   (if *print-escape* (call-next-method) (report-name x stream)))
+
    + +

    If the value supplied by the argument to :report (report-name) +is a symbol or a lambda expression, +it must be acceptable to + function. (function report-name) +is evaluated + in the current lexical environment. +It should return a function +of two + arguments, a condition and a stream, +that prints on the stream a + description of the condition. + This function is called whenever the + condition is printed while *print-escape* is nil. +

    +

    If report-name is a string, it is a shorthand for +

    +
    +
     (lambda (condition stream)
+   (declare (ignore condition))
+   (write-string report-name stream))
+
    + +

    This option is processed after the new condition type has been defined, +so use of the slot accessors within the :report function is permitted. +If this option is not supplied, information about how to report this +type of condition is inherited from the parent-type. +

    +
    +
    + +

    The consequences are unspecifed if an attempt is made to read a +slot that has not been explicitly initialized and that has not +been given a default value. +

    +

    The consequences are unspecified if an attempt is made to assign the +slots by using setf. +

    +

    If a define-condition form appears as a top level form, +the compiler must make name recognizable as a valid type name, +and it must be possible to reference the condition type as the +parent-type of another condition type in a subsequent +define-condition form in the file being compiled. +

    +

    Examples::

    + +

    The following form defines a condition of type +peg/hole-mismatch which inherits from a condition type +called blocks-world-error: +

    +
    +
    (define-condition peg/hole-mismatch 
+                  (blocks-world-error)
+                  ((peg-shape  :initarg :peg-shape
+                               :reader peg/hole-mismatch-peg-shape)
+                   (hole-shape :initarg :hole-shape
+                               :reader peg/hole-mismatch-hole-shape))
+  (:report (lambda (condition stream)
+             (format stream "A ~A peg cannot go in a ~A hole."
+                     (peg/hole-mismatch-peg-shape  condition)
+                     (peg/hole-mismatch-hole-shape condition)))))
+
    + +

    The new type has slots peg-shape and hole-shape, +so make-condition accepts :peg-shape and :hole-shape keywords. +The readers peg/hole-mismatch-peg-shape and peg/hole-mismatch-hole-shape +apply to objects of this type, as illustrated in the :report information. +

    +

    The following form defines a condition type named machine-error +which inherits from error: +

    +
    +
    (define-condition machine-error 
+                  (error)
+                  ((machine-name :initarg :machine-name
+                                 :reader machine-error-machine-name))
+  (:report (lambda (condition stream)
+             (format stream "There is a problem with ~A."
+                     (machine-error-machine-name condition)))))
+
    + +

    Building on this definition, a new error condition can be defined which +is a subtype of machine-error for use when machines are not available: +

    +
    +
    (define-condition machine-not-available-error (machine-error) ()
+  (:report (lambda (condition stream)
+             (format stream "The machine ~A is not available."
+                     (machine-error-machine-name condition)))))
+
    + +

    This defines a still more specific condition, built upon +machine-not-available-error, which provides a slot initialization form +for machine-name but which does not provide any new slots or report +information. It just gives the machine-name slot a default initialization: +

    +
    +
    (define-condition my-favorite-machine-not-available-error
+                  (machine-not-available-error)
+  ((machine-name :initform "mc.lcs.mit.edu")))
+
    + +

    Note that since no :report clause was given, the information +inherited from machine-not-available-error is used to +report this type of condition. +

    +
    +
     (define-condition ate-too-much (error) 
+     ((person :initarg :person :reader ate-too-much-person)
+      (weight :initarg :weight :reader ate-too-much-weight)
+      (kind-of-food :initarg :kind-of-food
+                    :reader :ate-too-much-kind-of-food)))
+⇒  ATE-TOO-MUCH
+ (define-condition ate-too-much-ice-cream (ate-too-much)
+   ((kind-of-food :initform 'ice-cream)
+    (flavor       :initarg :flavor
+                  :reader ate-too-much-ice-cream-flavor
+                  :initform 'vanilla ))
+   (:report (lambda (condition stream)
+              (format stream "~A ate too much ~A ice-cream"
+                      (ate-too-much-person condition)
+                      (ate-too-much-ice-cream-flavor condition)))))
+⇒  ATE-TOO-MUCH-ICE-CREAM
+ (make-condition 'ate-too-much-ice-cream
+                 :person 'fred
+                 :weight 300
+                 :flavor 'chocolate)
+⇒  #<ATE-TOO-MUCH-ICE-CREAM 32236101>
+ (format t "~A" *)
+ |>  FRED ate too much CHOCOLATE ice-cream
+⇒  NIL
+
    + +

    See Also::

    + +

    make-condition +, +defclass +, Condition System Concepts +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/define_002dmethod_002dcombination.html b/info/gcl/define_002dmethod_002dcombination.html new file mode 100644 index 0000000..2c6e2ca --- /dev/null +++ b/info/gcl/define_002dmethod_002dcombination.html @@ -0,0 +1,628 @@ + + + + + +define-method-combination (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.33 define-method-combination [Macro]

    + +

    define-method-combination name [[!short-form-option]]
    + ⇒ name +

    +

    define-method-combination name lambda-list + ({method-group-specifier}*) + [(:arguments . args-lambda-list)] + [(:generic-function + generic-function-symbol)] + [[{declaration}* | documentation]] + {form}*
    + ⇒ name +

    +

    short-form-option ::=:documentation documentation |  +                      :identity-with-one-argument identity-with-one-argument | +                      :operator operator +

    +

    method-group-specifier ::=(name {{qualifier-pattern}^+ | predicate} [[!long-form-option]]) +

    +

    long-form-option ::=:description description | +                     :order order | +                     :required required-p +

    +

    Arguments and Values::

    + +

    args-lambda-list— +a define-method-combination arguments lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    description—a format control. +

    +

    documentation—a string; not evaluated. +

    +

    forms—an implicit progn + that must compute and return the form that specifies how + the methods are combined, that is, the effective method. +

    +

    generic-function-symbol—a symbol. +

    +

    identity-with-one-argument—a generalized boolean. +

    +

    lambda-list—ordinary lambda list. +

    +

    name—a symbol. + Non-keyword, non-nil symbols are usually used. +

    +

    operator—an operator. + Name and operator are often the same symbol. + This is the default, but it is not required. +

    +

    order—:most-specific-first or :most-specific-last; evaluated. +

    +

    predicate—a symbol that names a function of one argument + that returns a generalized boolean. +

    +

    qualifier-pattern—a list, + or the symbol *. +

    +

    required-p—a generalized boolean. +

    +

    Description::

    + +

    The macro define-method-combination is used to define new types +of method combination. +

    +

    There are two forms of define-method-combination. The short +form is a simple facility for the cases that are expected +to be most commonly needed. The long form is more powerful but more +verbose. It resembles defmacro in that the body is an +expression, usually using backquote, that computes a form. Thus +arbitrary control structures can be implemented. The long form also +allows arbitrary processing of method qualifiers. +

    +
    +
    Short Form
    +

    The short form syntax of define-method-combination is recognized +when the second subform is a non-nil symbol or is not present. +When the short form is used, name is defined as a type of +method combination that produces a Lisp form +(operator method-call method-call ...). +The operator is a symbol that can be the name of a +function, macro, or special operator. +The operator can be supplied by a keyword option; +it defaults to name. +

    +

    Keyword options for the short form are the following: +

    +
    +
    *
    +

    The :documentation option is used to document the method-combination type; +see description of long form below. +

    +
    +
    *
    +

    The :identity-with-one-argument option enables an optimization +when its value is true (the default is false). If there is +exactly one applicable method and it is a primary method, that method +serves as the effective method and operator is not called. +This optimization avoids the need to create a new effective method and +avoids the overhead of a function call. This option is designed to be +used with operators such as progn, and, +, and +max. +

    +
    +
    *
    +

    The :operator option specifies the name of the operator. The +operator argument is a symbol that can be the +name of a function, +macro, or +special form. +

    +
    +
    + +

    These types of method combination require exactly one qualifier per +method. An error is signaled if there are applicable methods with no +qualifiers or with qualifiers that are not supported by +the method combination type. +

    +

    A method combination procedure defined in this way recognizes two +roles for methods. A method whose one qualifier is the symbol naming +this type of method combination is defined to be a primary method. At +least one primary method must be applicable or an error is signaled. +A method with :around as its one qualifier is an auxiliary +method that behaves the same as an around method in standard +method combination. The function call-next-method can only be +used in around methods; it cannot be used in primary methods +defined by the short form of the define-method-combination macro. +

    +

    A method combination procedure defined in this way accepts an optional +argument named order, which defaults to +:most-specific-first. A value of :most-specific-last reverses +the order of the primary methods without affecting the order of the +auxiliary methods. +

    +

    The short form automatically includes error checking and support for +around methods. +

    +

    For a discussion of built-in method combination types, +see Built-in Method Combination Types. +

    +
    +
    Long Form
    +

    The long form syntax of define-method-combination is recognized +when the second subform is a list. +

    +

    The lambda-list +receives any arguments provided after the name of the method +combination type in the :method-combination option to +defgeneric. +

    +

    A list of method group specifiers follows. Each specifier selects a subset +of the applicable methods to play a particular role, either by matching +their qualifiers against some patterns or by testing their qualifiers with +a predicate. +These method group specifiers define all method qualifiers +that can be used with this type of method combination. +

    +

    The car of each method-group-specifier is a symbol +which names a variable. +During the execution of +the forms in the body of define-method-combination, this +variable is bound to a list of the methods in the method group. The +methods in this list occur in the order specified by the +:order option. +

    +

    If qualifier-pattern is a symbol it must be *. +A method matches +a qualifier-pattern if the method’s +list of qualifiers is equal +to the qualifier-pattern (except that the symbol * in a +qualifier-pattern matches anything). Thus +a qualifier-pattern can be one of the +following: + the empty list, which matches unqualified methods; + the symbol *, which matches all methods; + a true list, which matches methods with the same number of qualifiers + as the length of the list when each qualifier matches + the corresponding list element; or + a dotted list that ends in the symbol * + (the * matches any number of additional qualifiers). +

    +

    Each applicable method is tested against the qualifier-patterns and +predicates in left-to-right order. +As soon as a qualifier-pattern matches +or a predicate returns true, the method becomes a member of the +corresponding method group and no further tests are made. Thus if a method +could be a member of more than one method group, it joins only the first +such group. If a method group has more than one +qualifier-pattern, a +method need only satisfy one of the qualifier-patterns to be a member of +the group. +

    +

    The name of a predicate function can appear instead of +qualifier-patterns in a method group specifier. +The predicate is called for +each method that has not been assigned to an earlier method group; it +is called with one argument, the method’s qualifier list. +The predicate should return true if the method is to be a member of the +method group. A predicate can be distinguished from a +qualifier-pattern +because it is a symbol other than nil or *. +

    +

    If there is an applicable method that does not fall into any method group, +the function invalid-method-error is called. +

    +

    Method group specifiers can have keyword options following the +qualifier patterns or predicate. Keyword options can be distinguished from +additional qualifier patterns because they are neither lists nor the symbol +*. The keyword options are as follows: +

    +
    +
    *
    +

    The :description option is used to provide a description of the +role of methods in the method group. Programming environment tools +use + (apply #'format stream format-control (method-qualifiers method)) +to print this description, which +is expected to be concise. This keyword +option allows the description of a method qualifier to be defined in +the same module that defines the meaning of the +method qualifier. In most cases, format-control will not contain any +format directives, but they are available for generality. +If :description is not supplied, a default description is generated +based on the variable name and the qualifier patterns and on whether +this method group includes the unqualified methods. +

    +
    +
    *
    +

    The :order option specifies the order of methods. The order +argument is a form that evaluates to +:most-specific-first or :most-specific-last. If it evaluates +to any other value, an error is signaled. +If :order is not supplied, it defaults to +:most-specific-first. +

    +
    +
    *
    +

    The :required option specifies whether at least one method in +this method group is required. +If its value is true and the method group is empty +(that is, no applicable methods match the qualifier patterns +or satisfy the predicate), +an error is signaled. +If :required is not supplied, +it defaults to nil. +

    +
    +
    + +

    The use of method group specifiers provides a convenient syntax to +select methods, to divide them among the possible roles, and to perform the +necessary error checking. It is possible to perform further filtering +of methods in the body forms by using normal list-processing operations +and the functions method-qualifiers and +invalid-method-error. It is permissible to use setq on the +variables named in the method group specifiers and to bind additional +variables. It is also possible to bypass the method group specifier +mechanism and do everything in the body forms. This is accomplished +by writing a single method group with * as its only +qualifier-pattern; +the variable is then bound to a list of all of the +applicable methods, in most-specific-first order. +

    +

    The body forms compute and return the form that specifies +how the methods are combined, that is, the effective method. +The effective method is evaluated in +the null lexical environment augmented with a local macro definition +for call-method and with bindings named by +symbols not accessible from the COMMON-LISP-USER package. +Given a method object in one of the +lists produced by the method group +specifiers and a list of next methods, +call-method +will invoke the method such that call-next-method has available +the next methods. +

    +

    When an effective method has no effect other than to call a single +method, some implementations employ an optimization that uses the +single method directly as the effective method, thus avoiding the need +to create a new effective method. This optimization is active when +the effective method form consists entirely of an invocation of +the call-method macro whose first subform is a method object and +whose second subform is nil or unsupplied. Each +define-method-combination body is responsible for stripping off +redundant invocations of progn, and, +multiple-value-prog1, and the like, if this optimization is desired. +

    +

    The list (:arguments . lambda-list) can appear before +any declarations or documentation string. This form is useful when +the method combination type performs some specific behavior as part of +the combined method and that behavior needs access to the arguments to +the generic function. Each parameter variable defined by +lambda-list is bound to a form that can be inserted into the +effective method. When this form is evaluated during execution of the +effective method, its value is the corresponding argument to the +generic function; the consequences of using such a form as +the place in a setf form are undefined. +

    +

    Argument correspondence is computed by dividing the :arguments lambda-list +and the generic function lambda-list into three sections: + the required parameters, + the optional parameters, + and the keyword and rest parameters. +The arguments supplied to the generic function for a particular call +are also divided into three sections; + the required arguments section contains as many arguments + as the generic function has required parameters, + the optional arguments section contains as many arguments + as the generic function has optional parameters, + and the keyword/rest arguments section contains the remaining arguments. +Each parameter in the required and optional sections of the +:arguments lambda-list accesses the argument at the same position +in the corresponding section of the arguments. +If the section of the :arguments lambda-list is shorter, + extra arguments are ignored. +If the section of the :arguments lambda-list is longer, + excess required parameters are bound to forms that evaluate to nil + and excess optional parameters are bound to their initforms. +The keyword parameters and rest parameters in the :arguments +lambda-list access the keyword/rest section of the arguments. +If the :arguments lambda-list contains &key, it behaves as +if it also contained &allow-other-keys. +

    +

    In addition, &whole var can be placed first in the :arguments +lambda-list. It causes var to be bound to a form +that evaluates to a list of all of the arguments supplied +to the generic function. This is different from &rest because it +accesses all of the arguments, not just the keyword/rest arguments. +

    +

    Erroneous conditions detected by the body should be reported with +method-combination-error or invalid-method-error; these +functions +add any necessary contextual information to the error message and will +signal the appropriate error. +

    +

    The body forms are evaluated inside of the bindings created by +the +lambda list and method group specifiers. +

    +

    [Reviewer Note by Barmar: Are they inside or outside the :ARGUMENTS bindings?] +Declarations at the head of +the body are positioned directly inside of bindings created by the +lambda list and outside of the bindings of the method group variables. +Thus method group variables cannot be declared in this way. locally may be used +around the body, however. +

    +

    Within the body forms, generic-function-symbol +is bound to the generic function object. +

    +

    Documentation is attached as a documentation string + to name (as kind method-combination) +and to the method combination object. +

    +

    Note that two methods with identical specializers, but with different +qualifiers, are not ordered by the algorithm described in Step 2 of +the method selection and combination process described in +Method Selection and Combination. Normally the two methods play +different roles in the effective method because they have different +qualifiers, and no matter how they are ordered in the result of Step +2, the effective method is the same. If the two methods play the same +role and their order matters, +

    +

    [Reviewer Note by Barmar: How does the system know when the order matters?] +an error is signaled. This happens as +part of the qualifier pattern matching in +define-method-combination. +

    +
    +
    + +

    If a define-method-combination form appears as a +top level form, the compiler must make the +method combination name be recognized as a valid +method combination name in subsequent defgeneric +forms. However, the method combination is executed +no earlier than when the define-method-combination form +is executed, and possibly as late as the time that generic functions +that use the method combination are executed. +

    +

    Examples::

    + +

    Most examples of the long form of define-method-combination also +illustrate the use of the related functions that are provided as part +of the declarative method combination facility. +

    +
    +
    ;;; Examples of the short form of define-method-combination
+
+ (define-method-combination and :identity-with-one-argument t) 
+
+ (defmethod func and ((x class1) y) ...)
+
+;;; The equivalent of this example in the long form is:
+
+ (define-method-combination and 
+         (&optional (order :most-specific-first))
+         ((around (:around))
+          (primary (and) :order order :required t))
+   (let ((form (if (rest primary)
+                   `(and ,@(mapcar #'(lambda (method)
+                                       `(call-method ,method))
+                                   primary))
+                   `(call-method ,(first primary)))))
+     (if around
+         `(call-method ,(first around)
+                       (,@(rest around)
+                        (make-method ,form)))
+         form)))
+
+;;; Examples of the long form of define-method-combination
+
+;The default method-combination technique
+ (define-method-combination standard ()
+         ((around (:around))
+          (before (:before))
+          (primary () :required t)
+          (after (:after)))
+   (flet ((call-methods (methods)
+            (mapcar #'(lambda (method)
+                        `(call-method ,method))
+                    methods)))
+     (let ((form (if (or before after (rest primary))
+                     `(multiple-value-prog1
+                        (progn ,@(call-methods before)
+                               (call-method ,(first primary)
+                                            ,(rest primary)))
+                        ,@(call-methods (reverse after)))
+                     `(call-method ,(first primary)))))
+       (if around
+           `(call-method ,(first around)
+                         (,@(rest around)
+                          (make-method ,form)))
+           form))))
+
+;A simple way to try several methods until one returns non-nil
+ (define-method-combination or ()
+         ((methods (or)))
+   `(or ,@(mapcar #'(lambda (method)
+                      `(call-method ,method))
+                  methods)))
+
+;A more complete version of the preceding
+ (define-method-combination or 
+         (&optional (order ':most-specific-first))
+         ((around (:around))
+          (primary (or)))
+   ;; Process the order argument
+   (case order
+     (:most-specific-first)
+     (:most-specific-last (setq primary (reverse primary)))
+     (otherwise (method-combination-error "~S is an invalid order.~@
+     :most-specific-first and :most-specific-last are the possible values."
+                                          order)))
+   ;; Must have a primary method
+   (unless primary
+     (method-combination-error "A primary method is required."))
+   ;; Construct the form that calls the primary methods
+   (let ((form (if (rest primary)
+                   `(or ,@(mapcar #'(lambda (method)
+                                      `(call-method ,method))
+                                  primary))
+                   `(call-method ,(first primary)))))
+     ;; Wrap the around methods around that form
+     (if around
+         `(call-method ,(first around)
+                       (,@(rest around)
+                        (make-method ,form)))
+         form)))
+
+;The same thing, using the :order and :required keyword options
+ (define-method-combination or 
+         (&optional (order ':most-specific-first))
+         ((around (:around))
+          (primary (or) :order order :required t))
+   (let ((form (if (rest primary)
+                   `(or ,@(mapcar #'(lambda (method)
+                                      `(call-method ,method))
+                                  primary))
+                   `(call-method ,(first primary)))))
+     (if around
+         `(call-method ,(first around)
+                       (,@(rest around)
+                        (make-method ,form)))
+         form)))
+
+;This short-form call is behaviorally identical to the preceding
+ (define-method-combination or :identity-with-one-argument t)
+
+;Order methods by positive integer qualifiers
+;:around methods are disallowed to keep the example small
+ (define-method-combination example-method-combination ()
+         ((methods positive-integer-qualifier-p))
+   `(progn ,@(mapcar #'(lambda (method)
+                         `(call-method ,method))
+                     (stable-sort methods #'<
+                       :key #'(lambda (method)
+                                (first (method-qualifiers method)))))))
+
+ (defun positive-integer-qualifier-p (method-qualifiers)
+   (and (= (length method-qualifiers) 1)
+        (typep (first method-qualifiers) '(integer 0 *))))
+
+;;; Example of the use of :arguments
+ (define-method-combination progn-with-lock ()
+         ((methods ()))
+   (:arguments object)
+   `(unwind-protect
+        (progn (lock (object-lock ,object))
+               ,@(mapcar #'(lambda (method)
+                             `(call-method ,method))
+                         methods))
+      (unlock (object-lock ,object))))
+
+
    + +

    Side Effects::

    + +

    The compiler is not required to perform any compile-time side-effects. +

    +

    Exceptional Situations::

    + +

    Method combination types defined with the short form require exactly +one qualifier per method. +An error of type error is signaled if there are +applicable methods with no qualifiers or with qualifiers that are not +supported by the method combination type. +At least one primary method must be applicable or +an error of type error is signaled. +

    +

    If an applicable method does not fall into any method group, the +system signals an error of type error +indicating that the method is invalid for the kind of +method combination in use. +

    +

    If the value of the :required option is true +and the method group is empty (that is, no applicable +methods match the qualifier patterns or satisfy the predicate), +an error of type error is signaled. +

    +

    If the :order option evaluates to a value other than +:most-specific-first or :most-specific-last, +an error of type error is signaled. +

    +

    See Also::

    + +

    call-method +, +call-next-method +, +documentation +, +method-qualifiers +, +method-combination-error +, +invalid-method-error +, +defgeneric +, +Method Selection and Combination, +Built-in Method Combination Types, +Syntactic Interaction of Documentation Strings and Declarations +

    +

    Notes::

    + +

    The :method-combination option of defgeneric is used to +specify that a generic function should use a particular method +combination type. The first argument to the :method-combination +option is the name of a method combination type and the remaining +arguments are options for that type. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/define_002dmodify_002dmacro.html b/info/gcl/define_002dmodify_002dmacro.html new file mode 100644 index 0000000..16b1739 --- /dev/null +++ b/info/gcl/define_002dmodify_002dmacro.html @@ -0,0 +1,140 @@ + + + + + +define-modify-macro (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.60 define-modify-macro [Macro]

    + +

    define-modify-macro name lambda-list function [documentation] ⇒ name +

    +

    Arguments and Values::

    + +

    name—a symbol. +

    +

    lambda-list—a define-modify-macro lambda list +

    +

    function—a symbol. +

    +

    documentation—a string; not evaluated. +

    +

    Description::

    + +

    define-modify-macro defines a macro named +name to read and write a place. +

    +

    The arguments to the new macro are a place, +followed +by the arguments that are supplied in lambda-list. +

    +

    Macros defined with define-modify-macro +correctly pass the environment parameter to +

    +

    get-setf-expansion. +

    +

    When the macro is invoked, function +is applied to the old contents of the place +and the lambda-list arguments to obtain the new value, +and the place is updated to contain the result. +

    +

    Except for the issue of avoiding multiple evaluation (see below), the expansion +of a define-modify-macro is equivalent to the following: +

    +
    +
     (defmacro name (reference . lambda-list)
+   documentation
+   `(setf ,reference
+          (function ,reference ,arg1 ,arg2 ...)))
+
    + +

    where arg1, arg2, ..., +are the parameters appearing in lambda-list; +appropriate provision is made for a rest parameter. +

    +

    The subforms of the macro calls defined by define-modify-macro +are evaluated as specified in Evaluation of Subforms to Places. +

    +

    Documentation is attached as a documentation string + to name (as kind function) +and to the macro function. +

    +

    If a define-modify-macro form appears as a top level form, +the compiler must store the macro definition at compile time, +so that occurrences of the macro later on in the file can be expanded correctly. +

    +

    Examples::

    +
    +
     (define-modify-macro appendf (&rest args) 
+    append "Append onto list") ⇒  APPENDF
+ (setq x '(a b c) y x) ⇒  (A B C)
+ (appendf x '(d e f) '(1 2 3)) ⇒  (A B C D E F 1 2 3)
+ x ⇒  (A B C D E F 1 2 3)
+ y ⇒  (A B C)
+ (define-modify-macro new-incf (&optional (delta 1)) +)
+ (define-modify-macro unionf (other-set &rest keywords) union)
+
    + +

    Side Effects::

    + +

    A macro definition is assigned to name. +

    +

    See Also::

    + +

    defsetf +, +

    +

    define-setf-expander +, +

    +

    documentation +, +Syntactic Interaction of Documentation Strings and Declarations +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/define_002dsetf_002dexpander.html b/info/gcl/define_002dsetf_002dexpander.html new file mode 100644 index 0000000..5d46cb6 --- /dev/null +++ b/info/gcl/define_002dsetf_002dexpander.html @@ -0,0 +1,190 @@ + + + + + +define-setf-expander (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.62 define-setf-expander [Macro]

    + +

    define-setf-expander access-fn lambda-list + [[{declaration}* | documentation]] {form}*
    + ⇒ access-fn +

    +

    Arguments and Values::

    + +

    access-fn—a symbol that names a function or macro. +

    +

    lambda-list – macro lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    forms—an implicit progn. +

    +

    Description::

    + +

    define-setf-expander specifies the means by which setf +updates a place that is referenced by access-fn. +

    +

    When setf is given a place that is +specified in terms of access-fn and a new value for the +place, it is expanded into a form that performs +the appropriate update. +

    +

    The lambda-list supports destructuring. +See Macro Lambda Lists. +

    +

    Documentation is attached to access-fn as a documentation string +of kind setf. +

    +

    Forms constitute the body of the +

    +

    setf expander +

    +

    definition and must compute the setf expansion for a call on setf +that references the place by means of the given +access-fn. +

    +

    The setf expander function is defined in the same lexical environment +in which the define-setf-expander form appears. +

    +

    While forms are being executed, +the variables in lambda-list are bound to parts of the place form. +

    +

    The body forms (but not the lambda-list) +

    +

    in a define-setf-expander form are implicitly enclosed in a +block whose name is +access-fn. +

    +

    The evaluation of forms must result in the five values +described in Setf Expansions. +

    +

    If a define-setf-expander form appears as a top level form, +the compiler must make the setf expander available so that +it may be used to expand calls to setf later on in the file. +Programmers must ensure that the forms can be evaluated +at compile time if the access-fn is used in a place +later in the same file. +The compiler must make these setf expanders available to +compile-time calls to get-setf-expansion when its environment +argument is a value received as the environment parameter of a macro. +

    +

    Examples::

    +
    +
     (defun lastguy (x) (car (last x))) ⇒  LASTGUY
+ (define-setf-expander lastguy (x &environment env)
+   "Set the last element in a list to the given value."
+   (multiple-value-bind (dummies vals newval setter getter)
+       (get-setf-expansion x env)
+     (let ((store (gensym)))
+       (values dummies
+               vals
+               `(,store)
+               `(progn (rplaca (last ,getter) ,store) ,store)
+               `(lastguy ,getter))))) ⇒  LASTGUY
+ (setq a (list 'a 'b 'c 'd)
+       b (list 'x)
+       c (list 1 2 3 (list 4 5 6))) ⇒  (1 2 3 (4 5 6))
+ (setf (lastguy a) 3) ⇒  3
+ (setf (lastguy b) 7) ⇒  7
+ (setf (lastguy (lastguy c)) 'lastguy-symbol) ⇒  LASTGUY-SYMBOL
+ a ⇒  (A B C 3)
+ b ⇒  (7)
+ c ⇒  (1 2 3 (4 5 LASTGUY-SYMBOL))
+
    + +
    +
    ;;; Setf expander for the form (LDB bytespec int).
+;;; Recall that the int form must itself be suitable for SETF.
+ (define-setf-expander ldb (bytespec int &environment env)
+   (multiple-value-bind (temps vals stores
+                          store-form access-form)
+       (get-setf-expansion int env);Get setf expansion for int.
+     (let ((btemp (gensym))     ;Temp var for byte specifier.
+           (store (gensym))     ;Temp var for byte to store.
+           (stemp (first stores))) ;Temp var for int to store.
+       (if (cdr stores) (error "Can't expand this."))
+;;; Return the setf expansion for LDB as five values.
+       (values (cons btemp temps)       ;Temporary variables.
+               (cons bytespec vals)     ;Value forms.
+               (list store)             ;Store variables.
+               `(let ((,stemp (dpb ,store ,btemp ,access-form)))
+                  ,store-form
+                  ,store)               ;Storing form.
+               `(ldb ,btemp ,access-form) ;Accessing form.
+              ))))
+
    + +

    See Also::

    + +

    setf +, +defsetf +, +documentation +, +get-setf-expansion +, +Syntactic Interaction of Documentation Strings and Declarations +

    +

    Notes::

    + +

    define-setf-expander differs from the long form of defsetf +in that while the body is being executed the variables +in lambda-list are bound to parts of the place form, +not to temporary variables that will be bound to the values of such parts. +In addition, define-setf-expander does not have defsetf’s +restriction that access-fn must be a function +or a function-like macro; an arbitrary defmacro destructuring +pattern is permitted in lambda-list. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/define_002dsymbol_002dmacro.html b/info/gcl/define_002dsymbol_002dmacro.html new file mode 100644 index 0000000..72bb1dd --- /dev/null +++ b/info/gcl/define_002dsymbol_002dmacro.html @@ -0,0 +1,133 @@ + + + + + +define-symbol-macro (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.13 define-symbol-macro [Macro]

    + +

    define-symbol-macro symbol expansion
    + ⇒ symbol +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    expansion—a form. +

    +

    Description::

    + +

    Provides a mechanism for globally affecting the macro expansion +of the indicated symbol. +

    +

    Globally establishes an expansion function for the symbol macro +named by symbol. +The only guaranteed property of an expansion function for a symbol macro +is that when it is applied to the form and the environment it returns +the correct expansion. (In particular, it is implementation-dependent +whether the expansion is conceptually stored in the expansion function, +the environment, or both.) +

    +

    Each global reference to symbol (i.e., not shadowed_2 by a +binding for a variable or symbol macro named by +the same symbol) is expanded by the normal macro expansion process; +see Symbols as Forms. +The expansion of a symbol macro is subject to further macro expansion +in the same lexical environment as the symbol macro reference, +exactly analogous to normal macros. +

    +

    The consequences are unspecified if a special declaration is made for +symbol while in the scope of this definition (i.e., when it is not +shadowed_2 by a binding for a variable +or symbol macro named by the same symbol). +

    +

    Any use of setq to set the value of +the symbol + while in the scope of this definition + is treated as if it were a setf. +psetq of symbol + is treated as if it were a psetf, and +multiple-value-setq + is treated as if it were a setf of values. +

    +

    A binding for a symbol macro can be shadowed_2 +by let or symbol-macrolet. +

    +

    Examples::

    + +
    +
    (defvar *things* (list 'alpha 'beta 'gamma)) ⇒  *THINGS*
+
+(define-symbol-macro thing1 (first *things*)) ⇒  THING1
+(define-symbol-macro thing2 (second *things*)) ⇒  THING2
+(define-symbol-macro thing3 (third *things*)) ⇒  THING3
+
+thing1 ⇒  ALPHA
+(setq thing1 'ONE) ⇒  ONE
+*things* ⇒  (ONE BETA GAMMA)
+(multiple-value-setq (thing2 thing3) (values 'two 'three)) ⇒  TWO
+thing3 ⇒  THREE
+*things* ⇒  (ONE TWO THREE)
+
+(list thing2 (let ((thing2 2)) thing2)) ⇒  (TWO 2)
+
    + +

    Exceptional Situations::

    + +

    If symbol is already defined as a global variable, +an error of type program-error is signaled. +

    +

    See Also::

    + +

    symbol-macrolet +, +macroexpand +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/defmacro.html b/info/gcl/defmacro.html new file mode 100644 index 0000000..753f211 --- /dev/null +++ b/info/gcl/defmacro.html @@ -0,0 +1,242 @@ + + + + + +defmacro (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.10 defmacro [Macro]

    + +

    defmacro name lambda-list [[{declaration}* | documentation]] {form}*
    + ⇒ name +

    +

    Arguments and Values::

    + +

    name—a symbol. +

    +

    lambda-list—a macro lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    form—a form. +

    +

    Description::

    + +

    Defines name as a macro +by associating a macro function with that name +in the global environment. +

    +

    The macro function is defined in the same lexical environment +in which the defmacro form appears. +

    +

    The parameter variables in lambda-list are bound to +destructured portions of the macro call. +

    +

    The expansion function +accepts two arguments, a form and an +environment. The expansion function returns a form. +The body of the expansion function is specified by forms. +Forms are executed in order. The value of the +last form executed is returned as the expansion of the +macro. +

    +

    The body forms of the expansion function (but not the lambda-list) +

    +

    are implicitly enclosed in a block whose name is name. +

    +

    The lambda-list conforms to the requirements described in Macro Lambda Lists. +

    +

    Documentation is attached as a documentation string + to name (as kind function) +and to the macro function. +

    +

    defmacro can be used to redefine a macro or to replace +a function definition with a macro definition. +

    +

    Recursive expansion of the form returned must terminate, +including the expansion of other macros which are subforms +of other forms returned. +

    +

    The consequences are undefined if the result of fully macroexpanding +a form +contains any circular list structure except in literal objects. +

    +

    If a defmacro form appears as a top level form, +the compiler must store the macro definition at compile time, +so that occurrences of the macro later on in the file can be expanded correctly. +Users must ensure that the body of the macro can be evaluated at +compile time if it is referenced within the file being compiled. +

    +

    Examples::

    + +
    +
     (defmacro mac1 (a b) "Mac1 multiplies and adds" 
+            `(+ ,a (* ,b 3))) ⇒  MAC1 
+ (mac1 4 5) ⇒  19 
+ (documentation 'mac1 'function) ⇒  "Mac1 multiplies and adds" 
+ (defmacro mac2 (&optional (a 2 b) (c 3 d) &rest x) `'(,a ,b ,c ,d ,x)) ⇒  MAC2 
+ (mac2 6) ⇒  (6 T 3 NIL NIL) 
+ (mac2 6 3 8) ⇒  (6 T 3 T (8)) 
+ (defmacro mac3 (&whole r a &optional (b 3) &rest x &key c (d a))
+    `'(,r ,a ,b ,c ,d ,x)) ⇒  MAC3 
+ (mac3 1 6 :d 8 :c 9 :d 10) ⇒  ((MAC3 1 6 :D 8 :C 9 :D 10) 1 6 9 8 (:D 8 :C 9 :D 10)) 
+
    + +

    The stipulation that +an embedded destructuring lambda list is permitted only +where ordinary lambda list syntax would permit a parameter name +but not a list is made to prevent ambiguity. For example, +the following is not valid: +

    +
    +
     (defmacro loser (x &optional (a b &rest c) &rest z)
+   ...)
+
    + +

    because ordinary lambda list syntax does permit a +list following &optional; +the list (a b &rest c) would be interpreted as describing an +optional parameter named a whose default value is that of the +form b, with a supplied-p parameter named &rest (not valid), +and an extraneous symbol c in the list (also not valid). An almost +correct way to express this is +

    +
    +
     (defmacro loser (x &optional ((a b &rest c)) &rest z)
+   ...)
+
    + +

    The extra set of parentheses removes the ambiguity. However, the +definition is now incorrect because a macro call such as (loser (car pool)) +would not provide any argument form for the lambda list (a b &rest c), +and so the default value against which to match the lambda list would be +nil because no explicit default value was specified. +The consequences of this are unspecified +since the empty list, nil, does not have forms to satisfy the +parameters a and b. The fully correct definition would be either +

    +
    +
     (defmacro loser (x &optional ((a b &rest c) '(nil nil)) &rest z)
+   ...)
+
    + +

    or +

    +
    +
     (defmacro loser (x &optional ((&optional a b &rest c)) &rest z)
+   ...)
+
    + +

    These differ slightly: the first requires that if the macro call +specifies a explicitly then it must also specify b explicitly, +whereas the second does not have this requirement. For example, +

    +
    +
     (loser (car pool) ((+ x 1)))
+
    + +

    would be a valid call for the second definition but not for the first. +

    +
    +
     (defmacro dm1a (&whole x) `',x)
+ (macroexpand '(dm1a))  ⇒  (QUOTE (DM1A))
+ (macroexpand '(dm1a a)) is an error.
+
+ (defmacro dm1b (&whole x a &optional b) `'(,x ,a ,b))
+ (macroexpand '(dm1b))  is an error.
+ (macroexpand '(dm1b q))  ⇒  (QUOTE ((DM1B Q) Q NIL))
+ (macroexpand '(dm1b q r)) ⇒  (QUOTE ((DM1B Q R) Q R))
+ (macroexpand '(dm1b q r s)) is an error.
+
    + +
    +
     (defmacro dm2a (&whole form a b) `'(form ,form a ,a b ,b))
+ (macroexpand '(dm2a x y)) ⇒  (QUOTE (FORM (DM2A X Y) A X B Y))
+ (dm2a x y) ⇒  (FORM (DM2A X Y) A X B Y)
+
+ (defmacro dm2b (&whole form a (&whole b (c . d) &optional (e 5)) 
+                 &body f &environment env)
+   ``(,',form ,,a ,',b ,',(macroexpand c env) ,',d ,',e ,',f))
+ ;Note that because backquote is involved, implementations may differ
+ ;slightly in the nature (though not the functionality) of the expansion.
+ (macroexpand '(dm2b x1 (((incf x2) x3 x4)) x5 x6))
+ ⇒  (LIST* '(DM2B X1 (((INCF X2) X3 X4))
+                   X5 X6)
+            X1
+            '((((INCF X2) X3 X4)) (SETQ X2 (+ X2 1)) (X3 X4) 5 (X5 X6))),
+     T
+ (let ((x1 5))
+   (macrolet ((segundo (x) `(cadr ,x)))
+     (dm2b x1 (((segundo x2) x3 x4)) x5 x6)))
+ ⇒  ((DM2B X1 (((SEGUNDO X2) X3 X4)) X5 X6)
+      5 (((SEGUNDO X2) X3 X4)) (CADR X2) (X3 X4) 5 (X5 X6))
+
    + +

    See Also::

    + +

    define-compiler-macro +, +

    +

    destructuring-bind +, +documentation +, +macroexpand +, +*macroexpand-hook*, +macrolet, +macro-function +, +Evaluation, +Compilation, +Syntactic Interaction of Documentation Strings and Declarations +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/defmethod.html b/info/gcl/defmethod.html new file mode 100644 index 0000000..62f2349 --- /dev/null +++ b/info/gcl/defmethod.html @@ -0,0 +1,238 @@ + + + + + +defmethod (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.27 defmethod [Macro]

    + +

    defmethod function-name + {method-qualifier}* + specialized-lambda-list + [[{declaration}* | documentation]] {form}*
    + ⇒ new-method +

    +

    function-name::= {symbol +| (setf symbol)} +

    +

    method-qualifier::= non-list +

    +

     specialized-lambda-list::= ({var | (var parameter-specializer-name)}*
    +                             [&optional {var | (var [initform [supplied-p-parameter] ])}*]
    +                             [&rest var]
    +                             [&key{var | ({var | (keywordvar)} [initform [supplied-p-parameter] ])}*
    +                                          [&allow-other-keys] ]
    +                             [&aux {var | (var [initform] )}*] )
    +

    +

     parameter-specializer-name::= symbol | (eql eql-specializer-form)
    +

    +

    Arguments and Values::

    + +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    var—a variable name. +

    +

    eql-specializer-form—a form. +

    +

    Form—a form. +

    +

    Initform—a form. +

    +

    Supplied-p-parameter—variable name. +

    +

    new-method—the new method object. +

    +

    Description::

    + +

    The macro defmethod defines a method on a +generic function. +

    +

    If (fboundp function-name) is nil, a +generic function is created with default values for +the argument precedence order +(each argument is more specific than the arguments to its right +in the argument list), +for the generic function class (the class standard-generic-function), +for the method class (the class standard-method), +and for the method combination type (the standard method combination type). +The lambda list of the generic function is +congruent with the lambda list of the +method being defined; if the +defmethod form mentions keyword arguments, the lambda list of +the generic function +will mention &key (but no keyword +arguments). If function-name names +an ordinary function, +a macro, or a special operator, +an error is signaled. +

    +

    If a generic function is currently named by function-name, +the lambda list of the +method must be congruent with the lambda list of the +generic function. +If this condition does not hold, an error is signaled. +For a definition of congruence in this context, see Congruent Lambda-lists for all Methods of a Generic Function. +

    +

    Each method-qualifier argument is an object that is used by +method combination to identify the given method. +The method combination type might further +restrict what a method qualifier can be. +The standard method combination type allows for unqualified methods and +methods whose sole +qualifier is one of the keywords :before, :after, or :around. +

    +

    The specialized-lambda-list argument is like an ordinary +lambda list except that the names of required parameters can +be replaced by specialized parameters. A specialized parameter is a +list of the form +(var parameter-specializer-name). +Only required parameters can be +specialized. If parameter-specializer-name is a symbol it names a +class; if it is a list, +it is of the form (eql eql-specializer-form). The parameter +specializer name (eql eql-specializer-form) indicates +that the corresponding argument must be eql to the object that +is the value of eql-specializer-form for the method to be applicable. +The eql-specializer-form is evaluated at the time +that the expansion of the defmethod macro is evaluated. +If no parameter specializer name is specified for a given +required parameter, the parameter specializer defaults to +the class t. +For further discussion, see Introduction to Methods. +

    +

    The form arguments specify the method body. +The body of the method is enclosed in an implicit block. If +function-name is a symbol, +this block bears the same name as the generic function. +If function-name is a list of the form +(setf symbol), the name of the block is symbol. +

    +

    The class of the method object that is created is that given by the +method class option of the generic function +on which the method is defined. +

    +

    If the generic function already has a method that agrees with the +method being defined on parameter specializers and qualifiers, +defmethod replaces the existing method with the one now being +defined. +For a definition of agreement in this context. +see Agreement on Parameter Specializers and Qualifiers. +

    +

    The parameter specializers are derived from +the parameter specializer names as described in +Introduction to Methods. +

    +

    The expansion of the defmethod macro “refers to” each +specialized parameter (see the description of ignore +within the description of declare). +This includes parameters that +have an explicit parameter specializer name of t. This means +that a compiler warning does not occur if the body of the method does +not refer to a specialized parameter, while a warning might occur +if the body of the method does not refer to an unspecialized parameter. +For this reason, a parameter that specializes on t is not quite synonymous +with an unspecialized parameter in this context. +

    +

    Declarations at the head of the method body that apply to the +method’s lambda variables are treated as bound declarations +whose scope is the same as the corresponding bindings. +

    +

    Declarations at the head of the method body that apply to the +functional bindings of call-next-method or next-method-p +apply to references to those functions within the method body forms. +Any outer bindings of the function names call-next-method and +next-method-p, and declarations associated with such bindings +are shadowed_2 within the method body forms. +

    +

    The scope of free declarations at the head of the method body +is the entire method body, +which includes any implicit local function definitions + but excludes initialization forms for the lambda variables. +

    +

    defmethod is not required to perform any compile-time side effects. +In particular, the methods are not installed for invocation during +compilation. An implementation may choose to store information about +the generic function for the purposes of compile-time error-checking +(such as checking the number of arguments on calls, or noting that a definition + for the function name has been seen). +

    +

    Documentation is attached as a documentation string +to the method object. +

    +

    Affected By::

    + +

    The definition of the referenced generic function. +

    +

    Exceptional Situations::

    + +

    If function-name names an ordinary function, +a macro, or a special operator, +an error of type error is signaled. +

    +

    If a generic function is currently named by function-name, +the lambda list of the +method must be congruent with the lambda list of the +generic function, or +an error of type error is signaled. +

    +

    See Also::

    + +

    defgeneric +, +documentation +, +Introduction to Methods, +Congruent Lambda-lists for all Methods of a Generic Function, +Agreement on Parameter Specializers and Qualifiers, +Syntactic Interaction of Documentation Strings and Declarations +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/defpackage.html b/info/gcl/defpackage.html new file mode 100644 index 0000000..bc6c06d --- /dev/null +++ b/info/gcl/defpackage.html @@ -0,0 +1,323 @@ + + + + + +defpackage (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.19 defpackage [Macro]

    + +

    defpackage defined-package-name [[!option]] ⇒ package +

    +

    option ::={(:nicknames {nickname}*)}* |  +           (:documentation string) |  +           {(:use {package-name}*)}* |  +           {(:shadow {!symbol-name}*)}* |  +           {(:shadowing-import-from package-name {!symbol-name}*)}* |  +           {(:import-from package-name {!symbol-name}*)}* |  +           {(:export {!symbol-name}*)}* |  +           {(:intern {!symbol-name}*)}* |  +           (:size integer) +

    +

    symbol-name ::=(symbol | string) +

    +

    Arguments and Values::

    + +

    defined-package-name—a string designator. +

    +

    package-name—a package designator. +

    +

    nickname—a string designator. +

    +

    symbol-name—a string designator. +

    +

    package—the package named package-name. +

    +

    Description::

    + +

    defpackage creates a package as specified and returns +the package. +

    +

    If defined-package-name already refers to an existing +package, the name-to-package mapping for that name is not changed. +If the new definition is at variance with the current state of that +package, the consequences are undefined; an implementation +might choose to modify the existing package to reflect the +new definition. If defined-package-name is a symbol, +its name is used. +

    +

    The standard options are described below. +

    +
    +
    :nicknames
    +

    The arguments to :nicknames set the package’s nicknames to the +supplied names. +

    +
    +
    :documentation
    +

    The argument to :documentation specifies a documentation string; +it is attached as a documentation string to the package. +At most one :documentation option +can appear in a single defpackage form. +

    +
    +
    :use
    +

    The arguments to :use set the packages that the package +named by package-name +will inherit from. If :use is not supplied, +

    +

    it defaults to the same implementation-dependent value as the :use argument to +make-package. +

    +
    +
    :shadow
    +

    The arguments to :shadow, symbol-names, name symbols +that are to be created in the package being defined. +These symbols are added to the list of shadowing +symbols effectively as if by shadow. +

    +
    +
    :shadowing-import-from
    +

    The symbols named by the argument symbol-names +are found (involving a lookup as if by find-symbol) +in the specified package-name. The resulting symbols +are imported into the package being defined, and +placed on the shadowing symbols list as if by shadowing-import. +In no case are symbols created in any package +other than the one being defined. +

    +
    +
    :import-from
    +

    The symbols named by the argument symbol-names +are found in the package named by package-name and +they are imported into the package being defined. +In no case are symbols created in any package +other than the one being defined. +

    +
    +
    :export
    +

    The symbols named by +the argument symbol-names are found +or created in the package being defined +and exported. +The :export option interacts +with the :use option, since inherited symbols + can be used rather than new ones created. +The :export option interacts + with the +:import-from and :shadowing-import-from options, since + imported +symbols can be used rather than new ones created. +If an argument to the :export option is accessible as +an (inherited) internal symbol via use-package, that the +symbol named by symbol-name +is first imported into the package being +defined, and is then exported from that package. +

    +
    +
    :intern
    +

    The symbols named by the argument symbol-names +are found or created in the package being defined. +The :intern option interacts with the +:use option, since inherited symbols +can be used rather than new ones created. +

    +
    +
    :size
    +

    The argument to the :size option +declares the approximate number of symbols expected in the +package. + This is an efficiency hint only and might be ignored by an +implementation. +

    +
    + +

    The order in which the options appear in a +defpackage form is irrelevant. +The order in which they are executed is as follows: +

    +
    1.
    +

    :shadow and :shadowing-import-from. +

    +
    2.
    +

    :use. +

    +
    3.
    +

    :import-from and :intern. +

    +
    4.
    +

    :export. +

    +
    + +

    Shadows are established first, since they might be necessary to block +spurious name conflicts when the :use +option is processed. The :use option is executed +next so that :intern and :export options can refer to normally +inherited symbols. +The :export option is executed last so that it can refer to +symbols created by any of the other options; in +particular, shadowing symbols and +imported symbols can be made external. +

    +

    If a defpackage form appears as a top level form, +all of the actions normally performed by this macro +at load time must also be performed at compile time. +

    +

    Examples::

    + +
    +
     (defpackage "MY-PACKAGE"
+   (:nicknames "MYPKG" "MY-PKG")
+   (:use "COMMON-LISP")
+   (:shadow "CAR" "CDR")
+   (:shadowing-import-from "VENDOR-COMMON-LISP"  "CONS")
+   (:import-from "VENDOR-COMMON-LISP"  "GC")
+   (:export "EQ" "CONS" "FROBOLA")
+   )
+
+ (defpackage my-package
+   (:nicknames mypkg :MY-PKG)  ; remember Common Lisp conventions for case
+   (:use common-lisp)          ; conversion on symbols
+   (:shadow CAR :cdr #:cons)                              
+   (:export "CONS")            ; this is the shadowed one.
+   )
+
    + +

    Affected By::

    + +

    Existing packages. +

    +

    Exceptional Situations::

    + +

    If one of the supplied :nicknames already +refers to an existing package, +an error of type package-error is signaled. +

    +

    An error of type program-error should be signaled if :size or :documentation +appears more than once. +

    +

    Since implementations might allow extended options +an error of type program-error should be signaled +if an option is present that is not +actually supported in the host implementation. +

    +

    The collection of symbol-name arguments given to the options + :shadow, :intern, +:import-from, and :shadowing-import-from must + all be disjoint; additionally, the symbol-name arguments given to + :export and :intern +must be disjoint. +Disjoint in this context is defined as no two of the symbol-names +being string= with each other. If either condition is + violated, an error of type program-error should be signaled. +

    +

    For the :shadowing-import-from and :import-from options, +a correctable error of type package-error + is signaled if no symbol is +accessible in the package named by + package-name for one of the argument symbol-names. +

    +

    Name conflict errors are handled by the underlying calls to +make-package, use-package, import, and +export. See Package Concepts. +

    +

    See Also::

    + +

    documentation +, +Package Concepts, +Compilation +

    +

    Notes::

    + +

    The :intern option is useful if an :import-from or a +:shadowing-import-from option in a subsequent call to defpackage +(for some other package) expects to find +these symbols accessible but not necessarily external. +

    +

    It is recommended that the entire package definition is put +in a single place, and that all the package definitions of a +program are in a single file. This file can be loaded before +loading or compiling anything else that depends on those +packages. Such a file can be read in the COMMON-LISP-USER package, +avoiding any initial state issues. +

    +

    defpackage cannot be used to create two “mutually +recursive” packages, such as: +

    +
    +
     (defpackage my-package
+   (:use common-lisp your-package)    ;requires your-package to exist first
+   (:export "MY-FUN"))                
+ (defpackage your-package
+   (:use common-lisp)
+   (:import-from my-package "MY-FUN") ;requires my-package to exist first
+   (:export "MY-FUN"))
+
    + +

    However, nothing prevents the user from using the +package-affecting functions +such as use-package, +import, and export to establish such links +after a more standard use of defpackage. +

    +

    The macroexpansion of defpackage +could usefully canonicalize the names +into strings, +so that even if a source file has random symbols in the +defpackage form, the compiled file would only contain +strings. +

    +

    Frequently additional implementation-dependent options take the +form of a keyword standing by itself as an abbreviation for a list +(keyword T); this syntax should be properly reported as an unrecognized +option in implementations that do not support it. +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/defparameter.html b/info/gcl/defparameter.html new file mode 100644 index 0000000..22c667a --- /dev/null +++ b/info/gcl/defparameter.html @@ -0,0 +1,233 @@ + + + + + +defparameter (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.16 defparameter, defvar [Macro]

    + +

    defparameter name initial-value [documentation] ⇒ name +

    +

    defvar name [initial-value [documentation]] ⇒ name +

    +

    Arguments and Values::

    + +

    name—a symbol; not evaluated. +

    +

    initial-value—a form; + for defparameter, it is always evaluated, + but for defvar it is evaluated + only if name is not already bound. +

    +

    documentation—a string; not evaluated. +

    +

    Description::

    + +

    defparameter and defvar establish name +as a dynamic variable. +

    +

    defparameter unconditionally +assigns the initial-value to the dynamic variable named name. +defvar, by contrast, assigns initial-value (if supplied) +to the dynamic variable named name +only if name is not already bound. +

    +

    If no initial-value is supplied, +defvar leaves the value cell of +the dynamic variable named name undisturbed; + if name was previously bound, its old value persists, +and if it was previously unbound, it remains unbound. +

    +

    If documentation is supplied, it is attached to name as a +documentation string of kind variable. +

    +

    defparameter and defvar normally appear as a top level form, +but it is meaningful for them to appear as non-top-level forms. However, +the compile-time side effects described below only take place when +they appear as top level forms. +

    +

    Examples::

    + +
    +
     (defparameter *p* 1) ⇒  *P*
+ *p* ⇒  1
+ (constantp '*p*) ⇒  false
+ (setq *p* 2) ⇒  2
+ (defparameter *p* 3) ⇒  *P*
+ *p* ⇒  3
+
+ (defvar *v* 1) ⇒  *V*
+ *v* ⇒  1
+ (constantp '*v*) ⇒  false
+ (setq *v* 2) ⇒  2
+ (defvar *v* 3) ⇒  *V*
+ *v* ⇒  2
+
+ (defun foo ()
+   (let ((*p* 'p) (*v* 'v))
+     (bar))) ⇒  FOO
+ (defun bar () (list *p* *v*)) ⇒  BAR
+ (foo) ⇒  (P V)
+
    + +

    The principal operational distinction between defparameter and defvar +is that defparameter makes an unconditional assignment to name, +while defvar makes a conditional one. In practice, this means that +defparameter is useful in situations where loading or reloading the definition +would want to pick up a new value of the variable, while defvar is used in +situations where the old value would want to be retained if the file were loaded or reloaded. +For example, one might create a file which contained: +

    +
    +
     (defvar *the-interesting-numbers* '())
+ (defmacro define-interesting-number (name n)
+   `(progn (defvar ,name ,n)
+           (pushnew ,name *the-interesting-numbers*)
+           ',name))
+ (define-interesting-number *my-height* 168) ;cm
+ (define-interesting-number *my-weight* 13)  ;stones
+
    + +

    Here the initial value, (), for the variable *the-interesting-numbers* +is just a seed that we are never likely to want to reset to something else +once something has been grown from it. As such, we have used defvar +to avoid having the *interesting-numbers* information reset if the file is +loaded a second time. It is true that the two calls to +define-interesting-number here would be reprocessed, but +if there were additional calls in another file, they would not be and that +information would be lost. On the other hand, consider the following code: +

    +
    +
     (defparameter *default-beep-count* 3)
+ (defun beep (&optional (n *default-beep-count*))
+   (dotimes (i n) (si:
+
    + +

    Here we could easily imagine editing the code to change the initial value of +*default-beep-count*, and then reloading the file to pick up the new value. +In order to make value updating easy, we have used defparameter. +

    +

    On the other hand, there is potential value to using defvar in this +situation. For example, suppose that someone had predefined an alternate +value for *default-beep-count*, or had loaded the file and then manually +changed the value. In both cases, if we had used defvar instead of +defparameter, those user preferences would not be overridden by +(re)loading the file. +

    +

    The choice of whether to use defparameter or defvar has +visible consequences to programs, but is nevertheless often made for subjective +reasons. +

    +

    Side Effects::

    + +

    If a defvar or defparameter form appears as a top level form, +the compiler must recognize that the name has been +proclaimed special. However, it must neither evaluate +the initial-value form nor assign the +dynamic variable named name at compile time. +

    +

    There may be additional (implementation-defined) compile-time or +run-time side effects, as long as such effects do not interfere with the +correct operation of conforming programs. +

    +

    Affected By::

    + +

    defvar is affected by whether name is already bound. +

    +

    See Also::

    + +

    declaim +, +defconstant +, +documentation +, +Compilation +

    +

    Notes::

    + +

    It is customary to name dynamic variables with an asterisk +at the beginning and end of the name. e.g., *foo* is a good name for +a dynamic variable, but not for a lexical variable; +foo is a good name for a lexical variable, +but not for a dynamic variable. +This naming convention is observed for all defined names in Common Lisp; +however, neither conforming programs nor conforming implementations +are obliged to adhere to this convention. +

    +

    The intent of the permission for additional side effects is to allow +implementations to do normal “bookkeeping” that accompanies +definitions. For example, the macro expansion of a defvar +or defparameter form might include code that arranges to +record the name of the source file in which the definition occurs. +

    +

    defparameter and defvar might be defined as follows: +

    +
    +
     (defmacro defparameter (name initial-value 
+                         &optional (documentation nil documentation-p))
+   `(progn (declaim (special ,name))
+           (setf (symbol-value ',name) ,initial-value)
+           ,(when documentation-p
+              `(setf (documentation ',name 'variable) ',documentation))
+           ',name))
+ (defmacro defvar (name &optional
+                        (initial-value nil initial-value-p)
+                        (documentation nil documentation-p))
+   `(progn (declaim (special ,name))
+           ,(when initial-value-p
+              `(unless (boundp ',name)
+                 (setf (symbol-value ',name) ,initial-value)))
+           ,(when documentation-p
+              `(setf (documentation ',name 'variable) ',documentation))
+           ',name))
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/defsetf.html b/info/gcl/defsetf.html new file mode 100644 index 0000000..04c6f8c --- /dev/null +++ b/info/gcl/defsetf.html @@ -0,0 +1,268 @@ + + + + + +defsetf (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.61 defsetf [Macro]

    + +

    The “short form”: +

    +

    defsetf access-fn update-fn [documentation]
    + ⇒ access-fn +

    +

    The “long form”: +

    +

    defsetf access-fn lambda-list ({store-variable}*) + [[{declaration}* | documentation]] {form}*
    + ⇒ access-fn +

    +

    Arguments and Values::

    + +

    access-fn—a symbol which names a function or a macro. +

    +

    update-fn—a symbol naming a function or macro. +

    +

    lambda-list—a defsetf lambda list. +

    +

    store-variable—a symbol (a variable name). +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    form—a form. +

    +

    Description::

    + +

    defsetf defines how to +setf a place +of the form (access-fn ...) for relatively simple cases. +(See define-setf-expander for more general access to this facility.) +

    +

    It must be the case that the function or macro named by access-fn +evaluates all of its arguments. +

    +

    defsetf may take one of two forms, called the “short form” and the “long form,” +which are distinguished by the type of the second argument. +

    +

    When the short form is used, +update-fn must name +a function (or macro) that takes one more argument +than access-fn takes. When setf is given a place +that is a call on access-fn, it expands into +a call on update-fn that is given all the arguments to +access-fn and also, as its last argument, the new value +(which must be returned by update-fn as its value). +

    +

    The long form defsetf +resembles defmacro. +The lambda-list describes the arguments of access-fn. +The store-variables describe the +value +

    +

    or values +

    +

    to be stored into the place. +The body must +compute the expansion of a setf of a call on access-fn. +

    +

    The expansion function is defined in the same lexical environment +in which the defsetf form appears. +

    +

    During the evaluation of the +forms, the variables in the lambda-list and the +store-variables +are bound to names of temporary variables, +generated as if by gensym +or gentemp, +that will be bound by the +expansion of setf +to the values of those subforms. This binding +permits the +forms to be written without regard for order-of-evaluation +issues. defsetf arranges for the temporary variables to be +optimized out of the final result in cases where that is possible. +

    +

    The body code in defsetf is implicitly enclosed in a +block whose name is +access-fn +

    +

    defsetf +ensures that subforms +of the place are evaluated exactly once. +

    +

    Documentation is attached to access-fn as a documentation string +of kind setf. +

    +

    If a defsetf form appears as a top level form, +the compiler must make the setf expander available so that +it may be used to expand calls to setf later on in the file. +Users must ensure that the forms, if any, can be evaluated +at compile time if the access-fn is used in a place +later in the same file. +The compiler must make these setf expanders available to +compile-time calls to get-setf-expansion when its environment +argument is a value received as the environment parameter of a macro. +

    +

    Examples::

    +

    The effect of +

    +
    +
     (defsetf symbol-value set)
+
    + +

    is built into the Common Lisp system. +This causes the form (setf (symbol-value foo) fu) +to expand into (set foo fu). +

    +

    Note that +

    +
    +
     (defsetf car rplaca)
+
    + +

    would be incorrect because rplaca does not return its last argument. +

    +
    +
     (defun middleguy (x) (nth (truncate (1- (list-length x)) 2) x)) ⇒  MIDDLEGUY
+ (defun set-middleguy (x v)
+    (unless (null x)
+      (rplaca (nthcdr (truncate (1- (list-length x)) 2) x) v))
+    v) ⇒  SET-MIDDLEGUY
+ (defsetf middleguy set-middleguy) ⇒  MIDDLEGUY
+ (setq a (list 'a 'b 'c 'd)
+       b (list 'x)
+       c (list 1 2 3 (list 4 5 6) 7 8 9)) ⇒  (1 2 3 (4 5 6) 7 8 9)
+ (setf (middleguy a) 3) ⇒  3
+ (setf (middleguy b) 7) ⇒  7
+ (setf (middleguy (middleguy c)) 'middleguy-symbol) ⇒  MIDDLEGUY-SYMBOL
+ a ⇒  (A 3 C D)
+ b ⇒  (7)
+ c ⇒  (1 2 3 (4 MIDDLEGUY-SYMBOL 6) 7 8 9)
+
    + +

    An example of the use of the long form of defsetf: +

    +
    +
     (defsetf subseq (sequence start &optional end) (new-sequence)
+   `(progn (replace ,sequence ,new-sequence
+                    :start1 ,start :end1 ,end)
+           ,new-sequence)) ⇒  SUBSEQ
+
    + +
    +
     (defvar *xy* (make-array '(10 10)))
+ (defun xy (&key ((x x) 0) ((y y) 0)) (aref *xy* x y)) ⇒  XY
+ (defun set-xy (new-value &key ((x x) 0) ((y y) 0))
+   (setf (aref *xy* x y) new-value)) ⇒  SET-XY
+ (defsetf xy (&key ((x x) 0) ((y y) 0)) (store)
+   `(set-xy ,store 'x ,x 'y ,y)) ⇒  XY
+ (get-setf-expansion '(xy a b))
+⇒  (#:t0 #:t1),
+   (a b),
+   (#:store),
+   ((lambda (&key ((x #:x)) ((y #:y))) 
+      (set-xy #:store 'x #:x 'y #:y))
+    #:t0 #:t1),
+   (xy #:t0 #:t1)
+ (xy 'x 1) ⇒  NIL
+ (setf (xy 'x 1) 1) ⇒  1
+ (xy 'x 1) ⇒  1
+ (let ((a 'x) (b 'y))
+   (setf (xy a 1 b 2) 3)
+   (setf (xy b 5 a 9) 14))
+⇒  14
+ (xy 'y 0 'x 1) ⇒  1
+ (xy 'x 1 'y 2) ⇒  3
+
    + +

    See Also::

    + +

    documentation +, +setf +, +

    +

    define-setf-expander +, +get-setf-expansion +, +

    +

    Generalized Reference, +Syntactic Interaction of Documentation Strings and Declarations +

    +

    Notes::

    + +

    forms must include provision +for returning the correct value (the value +

    +

    or values +

    +

    of store-variable). +This is +handled by forms rather than by defsetf because +in many cases this value can be returned at no extra cost, by calling a +function that simultaneously stores into the place and +returns the correct value. +

    +

    A setf of a call on access-fn also evaluates +all of access-fn’s arguments; it cannot treat any of them specially. +This means that defsetf +cannot be used to describe how to store into +a generalized reference to a byte, such as (ldb field reference). +

    +

    define-setf-expander +

    +

    is used to handle situations that +do not fit the restrictions imposed by defsetf +and gives the user additional control. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/defstruct.html b/info/gcl/defstruct.html new file mode 100644 index 0000000..36fd98b --- /dev/null +++ b/info/gcl/defstruct.html @@ -0,0 +1,1193 @@ + + + + + +defstruct (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Structures Dictionary  

    +
    +
    +

    8.1.1 defstruct [Macro]

    + +

    defstruct name-and-options [documentation] {!slot-description}*
    + ⇒ structure-name +

    +

    name-and-options ::=structure-name | (structure-name [[!options]]) +

    +

    options ::=!conc-name-option | +            {!constructor-option}* | +            !copier-option | +            !include-option | +            !initial-offset-option | +            !named-option | +            !predicate-option | +            !printer-option | +            !type-option +

    +

    conc-name-option ::=:conc-name | (:conc-name) | (:conc-name conc-name) +

    +

    constructor-option ::=:constructor | +                       (:constructor) | +                       (:constructor constructor-name) | +                       (:constructor constructor-name constructor-arglist) +

    +

    copier-option ::=:copier | (:copier) | (:copier copier-name) +

    +

    predicate-option ::=:predicate | (:predicate) | (:predicate predicate-name) +

    +

    include-option ::=(:include included-structure-name {!slot-description}*) +

    +

    printer-option ::=!print-object-option | !print-function-option +

    +

    print-object-option ::=(:print-object printer-name) | (:print-object) +

    +

    print-function-option ::=(:print-function printer-name) | (:print-function) +

    +

    type-option ::=(:type type) +

    +

    named-option ::=:named +

    +

    initial-offset-option ::=(:initial-offset initial-offset) +

    +

    slot-description ::=slot-name |  +                     (slot-name [slot-initform [[!slot-option]]]) +

    +

    slot-option ::=:type slot-type |  +                :read-only slot-read-only-p +

    +

    Arguments and Values::

    + +

    conc-name—a string designator. +

    +

    constructor-arglist—a boa lambda list. +

    +

    constructor-name—a symbol. +

    +

    copier-name—a symbol. +

    +

    included-structure-name—an already-defined structure name. +

    +

    Note that a derived type is not permissible, +even if it would expand into a structure name. +

    +

    initial-offset—a non-negative integer. +

    +

    predicate-name—a symbol. +

    +

    printer-name—a function name or a lambda expression. +

    +

    slot-name—a symbol. +

    +

    slot-initform—a form. +

    +

    slot-read-only-p—a generalized boolean. +

    +

    structure-name—a symbol. +

    +

    type—one of the type specifiers + list, + vector, + or (vector size), + or some other type specifier defined + by the implementation to be appropriate. +

    +

    documentation—a string; not evaluated. +

    +

    Description::

    + +

    defstruct defines a structured type, named structure-type, +with named slots as specified by the slot-options. +

    +

    defstruct defines readers for the slots and +arranges for setf to work properly on such +reader functions. +Also, unless overridden, it + defines a predicate named name-p, + defines a constructor function named make-constructor-name, + and defines a copier function named copy-constructor-name. +All names of automatically created functions might automatically +be declared inline (at the discretion of the implementation). +

    +

    If documentation is supplied, it is attached to structure-name +as a documentation string of kind structure, +

    +

    and unless :type is used, the documentation is also attached +to structure-name as a documentation string of kind +type and as a documentation string to the class object +for the class named structure-name. +

    +

    defstruct defines a constructor function that is used to +create instances of the structure created by defstruct. +The default name is make-structure-name. +A different name can be supplied +by giving the name as the argument to the constructor option. +nil indicates that no constructor function will be created. +

    +

    After a new structure type has been defined, instances of that type +normally can be created by using the constructor function for the +type. +A call to a constructor function is of the following form: +

    +

     (constructor-function-name
    +  slot-keyword-1 form-1
    +  slot-keyword-2 form-2
    +  ...)
    +

    +

    The arguments to the constructor function are all keyword arguments. Each +slot keyword argument must be +a keyword whose name corresponds to the name of a structure slot. +All the keywords and forms +are evaluated. +If a slot is not initialized in this way, +it is initialized by evaluating slot-initform in the slot description +

    +

    at the time the constructor function is called. +

    +

    If no slot-initform is supplied, +the consequences are undefined if an attempt is later made to read the slot’s value +before a value is explicitly assigned. +

    +

    Each slot-initform supplied for a defstruct component, +when used by the constructor function for an otherwise unsupplied +component, is re-evaluated on every call to the +constructor function. +

    +

    The slot-initform is not evaluated + unless it is needed in the creation of a particular structure + instance. If it is never needed, there can be no type-mismatch + error, even if the type +of the slot is specified; no warning + should be issued in this case. +

    +

    For example, in the following sequence, only the last call is an error. +

    +
    +
     (defstruct person (name 007 :type string)) 
+ (make-person :name "James")
+ (make-person)
+
    + +

    It is as if the slot-initforms were +used as initialization forms for the keyword parameters +of the constructor function. +

    +

    The symbols which name the slots must not be used by the +implementation as the names for the lambda variables +in the constructor function, since one or more of those symbols +might have been proclaimed special or might be defined as +the name of a constant variable. +The slot default init forms are evaluated +in the lexical environment in which the defstruct form itself appears and +in the dynamic environment in which the call to the constructor function appears. +

    +

    For example, if the form (gensym) were used as an initialization form, +either in the constructor-function call or as the default initialization form +in defstruct, then every call to the constructor function would call +gensym once to generate a new symbol. +

    +

    Each slot-description in defstruct can specify zero or more +slot-options. +

    +

    A slot-option consists of a pair of a keyword and a value +(which is not a form to be evaluated, but the value itself). For example: +

    +
    +
     (defstruct ship
+   (x-position 0.0 :type short-float)
+   (y-position 0.0 :type short-float)
+   (x-velocity 0.0 :type short-float)
+   (y-velocity 0.0 :type short-float)
+   (mass *default-ship-mass* :type short-float :read-only t))
+
    + +

    This specifies that each slot always contains a short float, +and that the last slot cannot be altered once a ship is constructed. +

    +

    The available slot-options are: +

    +
    :type type
    +

    This specifies that the contents of the +slot is always of type type. This is entirely +analogous to the declaration of a variable or function; it +effectively declares the result type of the reader function. +It is implementation-dependent whether the type is checked + when initializing a slot + or when assigning to it. +Type is not evaluated; it must be a valid type specifier. +

    +
    +
    :read-only x
    +

    When x is true, +this specifies that this slot cannot be +altered; it will always contain the value supplied at construction time. +setf will not accept the reader function for this slot. +If x is false, this slot-option has no effect. +X is not evaluated. +

    +

    When this option is false or unsupplied, +it is implementation-dependent whether the ability to write +the slot is implemented by a setf function or a setf expander. +

    +
    +
    + +

    The following keyword options are available for use with defstruct. +A defstruct option can be either a keyword or a list +of a keyword and arguments for that keyword; +specifying the keyword by itself is equivalent to specifying a list consisting of +the keyword and no arguments. +The syntax for defstruct options differs from the pair syntax +used for slot-options. No part of any of these options is evaluated. +

    +
    :conc-name
    +

    This provides for automatic prefixing of names of reader (or access) functions. +The default behavior is to begin the names of all the reader functions of +a structure with the name of the structure followed by a hyphen. +

    +

    :conc-name supplies an alternate +prefix to be used. If a hyphen is to be used as a separator, +it must be supplied as part of the prefix. +If :conc-name is nil or no argument is supplied, +then no prefix is used; +then the names of the reader functions +are the same as the slot names. +If a non-nil prefix is given, +the name of the reader function for each slot is constructed by +concatenating that prefix and the name of the slot, and interning the resulting +symbol in the package that is current at the time the +defstruct form is expanded. +

    +

    Note that no matter what is supplied for :conc-name, +slot keywords that match the slot names with no prefix attached are used +with a constructor function. +The reader function name is used +in conjunction with setf. Here is an example: +

    +
    +
     (defstruct (door (:conc-name dr-)) knob-color width material) ⇒  DOOR
+ (setq my-door (make-door :knob-color 'red :width 5.0)) 
+⇒  #S(DOOR :KNOB-COLOR RED :WIDTH 5.0 :MATERIAL NIL)
+ (dr-width my-door) ⇒  5.0
+ (setf (dr-width my-door) 43.7) ⇒  43.7
+ (dr-width my-door) ⇒  43.7
+
    + +

    Whether or not the :conc-name option is explicitly supplied, +the following rule governs name conflicts of generated reader +(or accessor) names: +For any structure type S_1 +having a reader function named R for a slot named X_1 +that is inherited by another structure type S_2 +that would have a reader function with the same name R for a slot named X_2, +no definition for R is generated by the definition of S_2; +instead, the definition of R is inherited from the definition of S_1. +(In such a case, if X_1 and X_2 are different slots, +the implementation might signal a style warning.) +

    +
    +
    :constructor
    +

    This option takes zero, one, or two arguments. +If at least one argument is supplied and the first argument is not nil, then +that argument is a symbol which specifies the name of the +constructor function. If the argument is not supplied (or if the option itself is not +supplied), the name of the constructor is produced by concatenating the +string "MAKE-" and the name of the structure, interning the name +in whatever package is current at the time defstruct +is expanded. If the argument is provided and is nil, +no constructor function is defined. +

    +

    If :constructor is given as +(:constructor name arglist), +then instead of making a keyword +driven constructor function, defstruct +defines a “positional” constructor function, +taking arguments whose meaning is determined by the argument’s position +and possibly by keywords. +Arglist is used to describe what the arguments to the +constructor will be. In the simplest case something like +(:constructor make-foo (a b c)) defines make-foo to be +a three-argument +constructor function whose arguments are used to initialize the +slots named a, b, and c. +

    +

    Because a constructor of this type operates “By Order of Arguments,” +it is sometimes known as a “boa constructor.” +

    +

    For information on how the arglist for a “boa constructor” is +processed, see Boa Lambda Lists. +

    +

    It is permissible to use the +:constructor option more than once, so that you can define several +different constructor functions, each taking different parameters. +

    +

    [Reviewer Note by Barmar: What about (:constructor) and (:constructor nil). + Should we worry about it?] +

    +

    defstruct creates the default-named keyword constructor function +only if no explicit :constructor options are specified, or if the +:constructor option is specified without a name argument. +

    +

    (:constructor nil) is meaningful only when there are no other +:constructor options specified. It prevents defstruct +from generating any constructors at all. +

    +

    Otherwise, defstruct creates a constructor function corresponding +to each supplied :constructor option. It is permissible to specify +multiple keyword constructor functions as well as multiple +“boa constructors”. +

    +
    +
    :copier
    +

    This option takes one argument, a symbol, +which specifies the name of the copier +function. If the argument is not provided or if the option itself is not +provided, the name of the copier is produced by concatenating the +string "COPY-" and the name of the structure, interning the name +in whatever package is current at the time defstruct +is expanded. +If the argument is provided and is nil, no copier function is defined. +

    +

    The automatically defined copier function is a function of +one argument, +

    +

    which must be of the structure type being defined. +

    +

    The copier function creates a fresh +structure that has the same type as its argument, +and that has the same component values as the original +structure; that is, the component values are not copied recursively. +

    +

    If the defstruct :type option was not used, +the following equivalence applies: +

    +
    +
     (copier-name x) = (copy-structure (the structure-name x))
+
    + +
    +
    :include
    +

    This option is used for building a new structure definition as +an extension of another structure definition. For example: +

    +
    +
     (defstruct person name age sex)
+
    + +

    To make a new structure to represent an astronaut +that has the +attributes of name, age, and sex, and functions +that operate on person structures, astronaut is defined +with :include as follows: +

    +
    +
     (defstruct (astronaut (:include person)
+                       (:conc-name astro-))
+    helmet-size
+    (favorite-beverage 'tang))
+
    + +

    :include causes the structure being defined +to have the same slots as the included structure. +This is done in such a way +that the reader functions for the included +structure also work on the structure being defined. +In this example, an +astronaut therefore has five slots: the three defined in +person and the two defined in astronaut +itself. The reader functions defined by the person structure +can be applied to instances of the astronaut structure, and they +work correctly. +Moreover, astronaut has its own reader functions for +components defined by the person structure. +The following examples illustrate the +use of astronaut structures: +

    +
    +
     (setq x (make-astronaut :name 'buzz
+                         :age 45.
+                         :sex t
+                         :helmet-size 17.5))
+ (person-name x) ⇒  BUZZ
+ (astro-name x) ⇒  BUZZ
+ (astro-favorite-beverage x) ⇒  TANG
+
    + +
    +
     (reduce #'+ astros :key #'person-age) ; obtains the total of the ages 
+                                       ; of the possibly empty
+                                       ; sequence of astros
+
    + +

    The difference between the reader functions person-name and astro-name +is that person-name can be correctly applied to any person, +including an astronaut, while astro-name can be correctly +applied only to an astronaut. An implementation might +check for incorrect use of reader functions. +

    +

    At most one :include can be supplied in a single defstruct. +The argument to :include is required and must be the +name of some previously defined structure. If the structure being +defined has no :type option, then the included structure must +also have had no :type option supplied for it. +If the structure being defined has a :type option, +then the included structure must have been declared with a :type +option specifying the same representation type. +

    +

    If no :type option is involved, then +the structure name of the including structure definition +becomes the name of a data type, and therefore +a valid type specifier recognizable by typep; it becomes +a subtype of the included structure. +In the above example, +astronaut is a subtype of person; hence +

    +
    +
     (typep (make-astronaut) 'person) ⇒  true
+
    + +

    indicating that all operations on persons also +work on astronauts. +

    +

    The structure using :include can specify default values or +slot-options for the included slots different from those the included +structure specifies, by giving the :include option as: +

    +
    +
     (:include included-structure-name {slot-description}*)
+
    + +

    Each slot-description must have a slot-name +that is the same +as that of some slot in the included structure. +If a slot-description has no slot-initform, +then in the new structure the slot has no initial value. +Otherwise its initial value form is replaced by +the slot-initform in the slot-description. +A normally writable slot can be made read-only. +If a slot is read-only in the included structure, then it +must also be so in the including structure. +If a type is supplied for a slot, it must be +a subtype of +the +type specified in the included structure. +

    +

    For example, if the +default age for an astronaut is 45, then +

    +
    +
     (defstruct (astronaut (:include person (age 45)))
+    helmet-size
+    (favorite-beverage 'tang))
+
    + +

    If :include is used with the :type +option, then the effect is first to skip over as many representation +elements as needed to represent the included structure, then to +skip over any additional elements supplied by the :initial-offset +option, and then to begin allocation of elements from that point. +For example: +

    +
    +
     (defstruct (binop (:type list) :named (:initial-offset 2))
+   (operator '? :type symbol)   
+   operand-1
+   operand-2) ⇒  BINOP
+ (defstruct (annotated-binop (:type list)
+                             (:initial-offset 3)
+                             (:include binop))
+  commutative associative identity) ⇒  ANNOTATED-BINOP
+ (make-annotated-binop :operator '*
+                       :operand-1 'x
+                       :operand-2 5
+                       :commutative t
+                       :associative t
+                       :identity 1)
+   ⇒  (NIL NIL BINOP * X 5 NIL NIL NIL T T 1)
+
    + +

    The first two nil elements stem from the :initial-offset of 2 +in the definition of binop. The next four elements contain the +structure name and three slots for binop. The next three nil elements +stem from the :initial-offset of 3 in the definition of +annotated-binop. The last three list elements contain the additional +slots for an annotated-binop. +

    +
    +
    :initial-offset
    +

    :initial-offset instructs defstruct to skip over a certain +number of slots before it starts allocating the slots described in the +body. This option’s argument is the number of slots defstruct +should skip. :initial-offset can be used only if :type is also supplied. +

    +

    [Reviewer Note by Barmar: What are initial values of the skipped slots?] +

    +

    :initial-offset allows +slots to be allocated beginning at a representational +element other than the first. For example, the form +

    +
    +
     (defstruct (binop (:type list) (:initial-offset 2))
+   (operator '? :type symbol)
+   operand-1
+   operand-2) ⇒  BINOP
+
    + +

    would result in the following behavior for make-binop: +

    +
    +
     (make-binop :operator '+ :operand-1 'x :operand-2 5)
+⇒  (NIL NIL + X 5)
+ (make-binop :operand-2 4 :operator '*)
+⇒  (NIL NIL * NIL 4)
+
    + +

    The selector functions +binop-operator, binop-operand-1, +and binop-operand-2 would be essentially equivalent to third, +fourth, and fifth, respectively. +Similarly, the form +

    +
    +
     (defstruct (binop (:type list) :named (:initial-offset 2))
+   (operator '? :type symbol)
+   operand-1
+   operand-2) ⇒  BINOP
+
    + +

    would result in the following behavior for make-binop: +

    +
    +
     (make-binop :operator '+ :operand-1 'x :operand-2 5) ⇒  (NIL NIL BINOP + X 5)
+ (make-binop :operand-2 4 :operator '*) ⇒  (NIL NIL BINOP * NIL 4)
+
    + +

    The first two nil elements stem from the :initial-offset of 2 +in the definition of binop. The next four elements contain the +structure name and three slots for binop. +

    +
    +
    :named
    +

    :named specifies that the structure is named. +If no :type is supplied, +then the structure is always named. +

    +

    For example: +

    +
    +
     (defstruct (binop (:type list))
+   (operator '? :type symbol)
+   operand-1
+   operand-2) ⇒  BINOP
+
    + +

    This defines a constructor function make-binop and three +selector functions, namely binop-operator, binop-operand-1, +and binop-operand-2. (It does not, however, define a predicate +binop-p, for reasons explained below.) +

    +

    The effect of make-binop is simply to construct a list of length three: +

    +
    +
     (make-binop :operator '+ :operand-1 'x :operand-2 5) ⇒  (+ X 5)  
+ (make-binop :operand-2 4 :operator '*) ⇒  (* NIL 4)
+
    + +

    It is just like the function list except that it takes +keyword arguments and performs slot defaulting appropriate to the binop +conceptual data type. Similarly, the selector functions +binop-operator, binop-operand-1, +and binop-operand-2 are essentially equivalent to car, +cadr, and caddr, respectively. They might not be +completely equivalent because, +for example, an implementation would be justified in adding error-checking +code to ensure that the argument to each selector function is a length-3 +list. +

    +

    binop is a conceptual data type in that it is not made a part of +the Common Lisp type system. typep does not recognize binop as +a type specifier, and type-of returns list when +given a binop structure. There is no way to distinguish a data +structure constructed by make-binop from any other list that +happens to have the correct structure. +

    +

    There is not any way to recover the structure name binop from +a structure created by make-binop. This can only be done +if the structure is named. +A named structure has the property that, given an instance of the +structure, the structure name (that names the type) can be reliably +recovered. For structures defined +with no :type option, the structure name actually becomes part +of the Common Lisp data-type system. type-of, +when applied to such a structure, returns the structure name +as the type of the object; +typep recognizes +the structure name as a valid type specifier. +

    +

    For structures defined with a :type option, type-of +returns a type specifier such as list or (vector t), +depending on the type supplied to the :type option. +The structure name does not become a valid type specifier. +However, +if the :named option is also supplied, then the first component +of the structure (as created by a defstruct constructor function) +always contains the structure name. This allows the structure name +to be recovered from an instance of the structure and allows a reasonable +predicate for the conceptual type to be defined: +the automatically defined +name-p predicate for the structure operates by first +checking that its argument is of the proper type (list, +(vector t), +or whatever) and then checking whether the first component contains +the appropriate type name. +

    +

    Consider the binop example shown above, modified only to +include the :named option: +

    +
    +
     (defstruct (binop (:type list) :named)
+   (operator '? :type symbol)
+   operand-1
+   operand-2) ⇒  BINOP
+
    + +

    As before, this defines a constructor function make-binop and three +selector functions binop-operator, binop-operand-1, +and binop-operand-2. It also defines a predicate binop-p. +The effect of make-binop is now to construct a list of length four: +

    +
    +
     (make-binop :operator '+ :operand-1 'x :operand-2 5) ⇒  (BINOP + X 5)
+ (make-binop :operand-2 4 :operator '*) ⇒  (BINOP * NIL 4)
+
    + +

    The structure has the same layout as before except that the structure name +binop is included as the first list element. +The selector functions +binop-operator, binop-operand-1, +and binop-operand-2 are essentially equivalent to cadr, +caddr, and cadddr, respectively. +The predicate binop-p is more or less equivalent to this +definition: +

    +
    +
     (defun binop-p (x)
+   (and (consp x) (eq (car x) 'binop))) ⇒  BINOP-P
+
    + +

    The name binop is still not a valid type specifier recognizable +to typep, but at least there is a way of distinguishing binop +structures from other similarly defined structures. +

    +
    +
    :predicate
    +

    This option takes one argument, which specifies the name of the type predicate. +If the argument is not supplied or if the option itself is not +supplied, the name of the predicate is made by concatenating the +name of the structure to the string "-P", interning the name +in whatever package is current at the time defstruct +is expanded. +If the argument is provided and is nil, no predicate is defined. +A predicate can be defined only if the structure is named; +if :type is supplied and :named is not supplied, +then :predicate must either be unsupplied or have the value nil. +

    +
    +
    :print-function, :print-object
    +

    The :print-function and :print-object +options +specify that a print-object +method for structures of type structure-name should be generated. +These options are not synonyms, but do perform a similar service; +the choice of which option (:print-function or :print-object) is used +affects how the function named printer-name is called. +Only one of these options may be used, and +these options may be used only if :type is not supplied. +

    +

    If the :print-function option is used, +then when a structure of type structure-name is to be printed, +the designated printer function is called on three arguments: +

    +
    +
    –
    +

    the structure to be printed + (a generalized instance of structure-name). +

    +
    +
    –
    +

    a stream to print to. +

    +
    +
    –
    +

    an integer indicating the current depth. + The magnitude of this integer may vary between implementations; + however, it can reliably be compared against *print-level* + to determine whether depth abbreviation is appropriate. +

    +
    +
    + +

    Specifying (:print-function printer-name) +is approximately equivalent to specifying: +

    +
    +
     (defmethod print-object ((object structure-name) stream)
+   (funcall (function printer-name) object stream <<current-print-depth>>))
+
    + +

    where the <<current-print-depth>> represents the printer’s belief of +how deep it is currently printing. It is implementation-dependent +whether <<current-print-depth>> is always 0 and *print-level*, +if non-nil, is re-bound to successively smaller values as printing +descends recursively, or whether current-print-depth varies in +value as printing descends recursively and *print-level* remains +constant during the same traversal. +

    +

    If the :print-object option is used, then +when a structure of type structure-name is to be printed, +the designated printer function is called on two arguments: +

    +
    +
    –
    +

    the structure to be printed. +

    +
    +
    –
    +

    the stream to print to. +

    +
    +
    + +

    Specifying (:print-object printer-name) is equivalent to specifying: +

    +
    +
     (defmethod print-object ((object structure-name) stream)
+   (funcall (function printer-name) object stream))
+
    + +

    If no :type option is supplied, +and if either a :print-function or a :print-object option is supplied, +and if no printer-name is supplied, +then a print-object method specialized for structure-name +is generated that calls a function that implements the default printing behavior for +structures using #S notation; see Printing Structures. +

    +

    If neither a :print-function + nor a :print-object option +is supplied, +then defstruct does not generate a print-object method +specialized for structure-name and some default behavior is inherited +either from a structure named in an :include option + or from the default behavior for printing structures; +see the function print-object and Printing Structures. +

    +

    When *print-circle* is true, +a user-defined print function can print objects +to the supplied stream using + write, + prin1, + princ, + or format +and expect circularities to be detected and printed using the #n# syntax. +This applies to methods on print-object in addition to +:print-function options. +If a user-defined print function prints to a stream other than the one +that was supplied, then circularity detection starts over for that stream. +See the variable *print-circle*. +

    +
    +
    :type
    +

    :type explicitly specifies the representation to be used for +the structure. Its argument must be one of these types: +

    +
    +
    vector
    +

    This produces the same result as specifying (vector t). +The structure is represented +as a general vector, storing components as vector elements. +The first component is vector +element 1 if the structure is :named, and element 0 otherwise. +

    +

    [Reviewer Note by Barmar: Do any implementations create non-simple vectors?] +

    +
    +
    (vector element-type)
    +

    The structure is represented as a (possibly specialized) vector, storing +components as vector elements. Every component must be of a type +that can be stored in a vector of the type specified. +The first component is vector +element 1 if the structure is :named, and element 0 otherwise. +The structure can be :named only if the type symbol +is a subtype of the supplied element-type. +

    +
    +
    list
    +

    The structure is represented as a list. +The first component is the cadr if the structure is :named, +and the car if it is not :named. +

    +
    + +

    Specifying this option has the effect of forcing +a specific representation and of forcing the components to be +stored in the order specified in defstruct +in corresponding successive elements of the specified representation. +It also prevents the structure name from becoming a valid +type specifier recognizable by typep. +

    +

    For example: +

    +
    +
     (defstruct (quux (:type list) :named) x y)
+
    + +

    should make a constructor that builds a list exactly like the one +that list produces, +with quux as its car. +

    +

    If this type is defined: +

    +
    +
     (deftype quux () '(satisfies quux-p))
+
    + +

    then this form +

    +
    +
     (typep (make-quux) 'quux)
+
    + +

    should return precisely what this one does +

    +
    +
     (typep (list 'quux nil nil) 'quux)
+
    + +

    If :type is not supplied, +the structure is represented as an object of type structure-object. +

    +

    defstruct without a :type option defines a class with +the structure name as its name. The metaclass of structure +instances is structure-class. +

    +
    +
    + +

    The consequences of redefining a defstruct structure are undefined. +

    +

    In the case where no defstruct options have been supplied, +the following functions are automatically defined to operate +on instances of the new structure: +

    +
    +
    Predicate
    +

    A predicate with the name structure-name-p is defined to +test membership in the structure type. The predicate +(structure-name-p object) is true if an object +is of this type; otherwise it is false. typep can also +be used with the name of the new type to test whether an +object +belongs to the type. +Such a function call has the form +(typep object 'structure-name). +

    +
    +
    Component reader functions
    +

    Reader functions are defined to read the components of the +structure. For each slot name, there is a corresponding +reader function with the name structure-name-slot-name. +This function reads the contents of that slot. +Each reader function takes one argument, which is +an instance of the structure type. +setf can be used with any of these reader functions +to alter the slot contents. +

    +
    +
    Constructor function
    +

    A constructor function with the name make-structure-name +is defined. This function creates and returns new +instances of the structure type. +

    +
    +
    Copier function
    +

    A copier function with the name copy-structure-name is defined. +The copier function takes an object of the structure type and creates a +new object of the same type that is a copy of the first. The copier +function creates a new structure with the same component entries +as the original. Corresponding components of the two structure instances +are eql. +

    +
    + +

    If a defstruct form appears as a top level form, +the compiler must make the structure type name recognized +as a valid type name in subsequent declarations (as for deftype) +and make the structure slot readers known to setf. In addition, the +compiler must save enough information about the structure type +so that further defstruct definitions can use :include in a subsequent +deftype in the same file to refer to the structure type name. +The functions which defstruct generates are not defined +in the compile time environment, although the compiler may save enough +information about the functions to code subsequent calls inline. +The #S reader macro might or might not recognize the newly defined +structure type name at compile time. +

    +

    Examples::

    +

    An example of a structure definition follows: +

    +
    +
     (defstruct ship
+   x-position
+   y-position
+   x-velocity
+   y-velocity
+   mass)
+
    + +

    This declares that every ship is an object +with five named components. +The evaluation of this form does the following: +

    +
    +
    1.
    +

    It defines ship-x-position to be a function +of one argument, a ship, that returns the x-position +of the ship; ship-y-position +and the other components are given similar function definitions. +These functions are called the access functions, as they +are used to access elements of the structure. +

    +
    +
    2.
    +

    ship becomes the name of a type of which instances +of ships are elements. ship becomes acceptable to typep, +for example; (typep x 'ship) is true if x is a ship +and false if x is any object other than a ship. +

    +
    +
    3.
    +

    A function named ship-p of +one argument is defined; it is a predicate +that is true if its argument is a ship and is false otherwise. +

    +
    +
    4.
    +

    A function called make-ship is defined that, when invoked, +creates a data structure with five components, suitable for use with +the access functions. Thus executing +

    +
    +
     (setq ship2 (make-ship))
+
    + +

    sets ship2 to a newly created ship object. +One can supply the initial values of any desired component in the call +to make-ship by using keyword arguments in this way: +

    +
    +
     (setq ship2 (make-ship :mass *default-ship-mass*
+                        :x-position 0
+                        :y-position 0))
+
    + +

    This constructs a new ship and initializes three of its components. +This function is called the “constructor function” +because it constructs a new structure. +

    +
    +
    5.
    +

    A function called copy-ship of one argument +is defined that, when given a ship object, +creates a new ship object that is a copy of the given one. +This function is called the “copier function.” +

    +
    + +

    setf can be used to alter the components of a ship: +

    +
    +
     (setf (ship-x-position ship2) 100)
+
    + +

    This alters the x-position of ship2 to be 100. +This works because defstruct behaves as if +it generates an appropriate defsetf +for each access function. +

    +
    +
    ;;;
+;;; Example 1
+;;; define town structure type
+;;; area, watertowers, firetrucks, population, elevation are its components
+;;;
+ (defstruct town
+             area
+             watertowers
+             (firetrucks 1 :type fixnum)    ;an initialized slot
+             population 
+             (elevation 5128 :read-only t)) ;a slot that can't be changed
+⇒  TOWN
+;create a town instance
+ (setq town1 (make-town :area 0 :watertowers 0)) ⇒  #S(TOWN...)
+;town's predicate recognizes the new instance
+ (town-p town1) ⇒  true
+;new town's area is as specified by make-town
+ (town-area town1) ⇒  0
+;new town's elevation has initial value
+ (town-elevation town1) ⇒  5128
+;setf recognizes reader function
+ (setf (town-population town1) 99) ⇒  99
+ (town-population town1) ⇒  99
+;copier function makes a copy of town1
+ (setq town2 (copy-town town1)) ⇒  #S(TOWN...)
+ (= (town-population town1) (town-population town2))  ⇒  true
+;since elevation is a read-only slot, its value can be set only
+;when the structure is created
+ (setq town3 (make-town :area 0 :watertowers 3 :elevation 1200))
+⇒  #S(TOWN...)
+;;;
+;;; Example 2
+;;; define clown structure type
+;;; this structure uses a nonstandard prefix
+;;;
+ (defstruct (clown (:conc-name bozo-))
+             (nose-color 'red)         
+             frizzy-hair-p polkadots) ⇒  CLOWN
+ (setq funny-clown (make-clown)) ⇒  #S(CLOWN)
+;use non-default reader name
+ (bozo-nose-color funny-clown) ⇒  RED        
+ (defstruct (klown (:constructor make-up-klown) ;similar def using other
+             (:copier clone-klown)              ;customizing keywords
+             (:predicate is-a-bozo-p))
+             nose-color frizzy-hair-p polkadots) ⇒  klown
+;custom constructor now exists
+ (fboundp 'make-up-klown) ⇒  true
+;;;
+;;; Example 3
+;;; define a vehicle structure type
+;;; then define a truck structure type that includes 
+;;; the vehicle structure
+;;;
+ (defstruct vehicle name year (diesel t :read-only t)) ⇒  VEHICLE
+ (defstruct (truck (:include vehicle (year 79)))
+             load-limit                          
+             (axles 6)) ⇒  TRUCK
+ (setq x (make-truck :name 'mac :diesel t :load-limit 17))
+⇒  #S(TRUCK...)
+;vehicle readers work on trucks
+ (vehicle-name x)
+⇒  MAC
+;default taken from :include clause 
+ (vehicle-year x)
+⇒  79 
+ (defstruct (pickup (:include truck))     ;pickup type includes truck
+             camper long-bed four-wheel-drive) ⇒  PICKUP
+ (setq x (make-pickup :name 'king :long-bed t)) ⇒  #S(PICKUP...)
+;:include default inherited
+ (pickup-year x) ⇒  79
+;;;
+;;; Example 4
+;;; use of BOA constructors
+;;;
+ (defstruct (dfs-boa                      ;BOA constructors
+               (:constructor make-dfs-boa (a b c)) 
+               (:constructor create-dfs-boa
+                 (a &optional b (c 'cc) &rest d &aux e (f 'ff))))
+             a b c d e f) ⇒  DFS-BOA
+;a, b, and c set by position, and the rest are uninitialized
+ (setq x (make-dfs-boa 1 2 3)) ⇒  #(DFS-BOA...)
+ (dfs-boa-a x) ⇒  1
+;a and b set, c and f defaulted
+ (setq x (create-dfs-boa 1 2)) ⇒  #(DFS-BOA...)
+ (dfs-boa-b x) ⇒  2
+ (eq (dfs-boa-c x) 'cc) ⇒  true
+;a, b, and c set, and the rest are collected into d
+ (setq x (create-dfs-boa 1 2 3 4 5 6)) ⇒  #(DFS-BOA...)
+ (dfs-boa-d x) ⇒  (4 5 6)
+
    + +

    Exceptional Situations::

    + +

    If any two slot names (whether present directly or inherited by the :include option) +are the same under string=, +defstruct should signal an error of type program-error. +

    +

    The consequences are undefined if the included-structure-name +does not name a structure type. +

    +

    See Also::

    + +

    documentation +, +print-object +, +setf +, +subtypep +, +type-of +, +typep +, +Compilation +

    +

    Notes::

    + +

    The printer-name should observe the values of +such printer-control variables as *print-escape*. +

    +

    The restriction against issuing a warning for type mismatches between +a slot-initform and the corresponding slot’s :type option is +necessary because a slot-initform must be specified in order to +specify slot options; in some cases, no suitable default may exist. +

    +

    The mechanism by which defstruct arranges for slot accessors to +be usable with setf is implementation-dependent; +for example, it may use setf functions, setf expanders, or +some other implementation-dependent mechanism known to that +implementation’s code for setf. +

    +
    +
    +

    +Next: , Previous: , Up: Structures Dictionary  

    +
    + + + + + diff --git a/info/gcl/deftype.html b/info/gcl/deftype.html new file mode 100644 index 0000000..33a04d2 --- /dev/null +++ b/info/gcl/deftype.html @@ -0,0 +1,150 @@ + + + + + +deftype (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.25 deftype [Macro]

    + +

    deftype name lambda-list [[{declaration}* | documentation]] {form}* ⇒ name +

    +

    Arguments and Values::

    + +

    name—a symbol. +

    +

    lambda-list—a deftype lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    form—a form. +

    +

    Description::

    + +

    deftype defines a derived type specifier named name. +

    +

    The meaning of the new type specifier is given in terms of +a function which expands the type specifier into another +type specifier, which itself will be expanded if it contains +references to another derived type specifier. +

    +

    The newly defined type specifier may be referenced as a list of +the form (name arg_1 arg_2 ...)\/. +The number of arguments must be appropriate to the lambda-list. +If the new type specifier takes no arguments, +or if all of its arguments are optional, +the type specifier may be used as an atomic type specifier. +

    +

    The argument expressions to the type specifier, +arg_1 ... arg_n, are not evaluated. +Instead, these literal objects become the objects to which +corresponding parameters become bound. +

    +

    The body of the deftype form +

    +

    (but not the lambda-list) +

    +

    is +

    +

    implicitly enclosed in a block named name, +

    +

    and is evaluated as an implicit progn, +returning a new type specifier. +

    +

    The lexical environment of the body is the one which was current +at the time the deftype form was evaluated, augmented by the +variables in the lambda-list. +

    +

    Recursive expansion of the type specifier returned as the expansion +must terminate, including the expansion of type specifiers which +are nested within the expansion. +

    +

    The consequences are undefined if the result of fully expanding a +type specifier contains any circular structure, except within +the objects referred to by member and eql +type specifiers. +

    +

    Documentation is attached to name as a documentation string +of kind type. +

    +

    If a deftype form appears as a top level form, +the compiler must ensure that the name is recognized +in subsequent type declarations. +The programmer must ensure that the body of a deftype form +can be evaluated at compile time if the name is +referenced in subsequent type declarations. +If the expansion of a type specifier is not defined fully at compile time +(perhaps because it expands into an unknown type specifier or a +satisfies of a named function that isn’t defined in the +compile-time environment), an implementation may ignore any references to +this type in declarations and/or signal a warning. +

    +

    Examples::

    +
    +
     (defun equidimensional (a)
+   (or (< (array-rank a) 2)
+       (apply #'= (array-dimensions a)))) ⇒  EQUIDIMENSIONAL
+ (deftype square-matrix (&optional type size)
+   `(and (array ,type (,size ,size))
+         (satisfies equidimensional))) ⇒  SQUARE-MATRIX
+
    + +

    See Also::

    + +

    declare, +defmacro +, +documentation +, +Type Specifiers, +Syntactic Interaction of Documentation Strings and Declarations +

    +
    +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    + + + + + diff --git a/info/gcl/defun.html b/info/gcl/defun.html new file mode 100644 index 0000000..494ce82 --- /dev/null +++ b/info/gcl/defun.html @@ -0,0 +1,173 @@ + + + + + +defun (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.2 defun [Macro]

    + +

    defun function-name lambda-list [[{declaration}* | documentation]] {form}*
    + ⇒ function-name +

    +

    Arguments and Values::

    + +

    function-name—a function name. +

    +

    lambda-list—an ordinary lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    forms—an implicit progn. +

    +

    block-name—the function block name of the function-name. +

    +

    Description::

    + +

    Defines a new function named function-name in the global environment. +The body of the function defined by defun consists +of forms; they are executed as an implicit progn +when the function is called. +defun can be used + to define a new function, + to install a corrected version of an incorrect definition, + to redefine an already-defined function, + or to redefine a macro as a function. +

    +

    defun implicitly puts a block named block-name +around the body forms +

    +

    (but not the forms in the lambda-list) +

    +

    of the function defined. +

    +

    Documentation is attached as a documentation string + to name (as kind function) +and to the function object. +

    +

    Evaluating defun causes function-name to be a global name +for the function specified by the lambda expression +

    +
    +
     (lambda lambda-list
+   [[{declaration}* | documentation]]
+   (block block-name {form}*))
+
    + +

    processed in the lexical environment in which defun was executed. +

    +

    (None of the arguments are evaluated at macro expansion time.) +

    +

    defun is not required to perform any compile-time side effects. +In particular, defun does not make the function definition available +at compile time. An implementation may choose to store information +about the function for the purposes of compile-time error-checking +(such as checking the number of arguments on calls), +or to enable the function to be expanded inline. +

    +

    Examples::

    + +
    +
     (defun recur (x)
+  (when (> x 0)
+    (recur (1- x)))) ⇒  RECUR 
+ (defun ex (a b &optional c (d 66) &rest keys &key test (start 0))
+    (list a b c d keys test start)) ⇒  EX 
+ (ex 1 2) ⇒  (1 2 NIL 66 NIL NIL 0)
+ (ex 1 2 3 4 :test 'equal :start 50) 
+⇒  (1 2 3 4 (:TEST EQUAL :START 50) EQUAL 50)
+ (ex :test 1 :start 2) ⇒  (:TEST 1 :START 2 NIL NIL 0)
+
+ ;; This function assumes its callers have checked the types of the
+ ;; arguments, and authorizes the compiler to build in that assumption.
+ (defun discriminant (a b c)
+   (declare (number a b c))
+   "Compute the discriminant for a quadratic equation."
+   (- (* b b) (* 4 a c))) ⇒  DISCRIMINANT
+ (discriminant 1 2/3 -2) ⇒  76/9
+
+ ;; This function assumes its callers have not checked the types of the
+ ;; arguments, and performs explicit type checks before making any assumptions. 
+ (defun careful-discriminant (a b c)
+   "Compute the discriminant for a quadratic equation."
+   (check-type a number)
+   (check-type b number)
+   (check-type c number)
+   (locally (declare (number a b c))
+     (- (* b b) (* 4 a c)))) ⇒  CAREFUL-DISCRIMINANT
+ (careful-discriminant 1 2/3 -2) ⇒  76/9
+
    + +

    See Also::

    + +

    flet +, +labels, +block +, +return-from +, +declare, +documentation +, +Evaluation, +Ordinary Lambda Lists, +Syntactic Interaction of Documentation Strings and Declarations +

    +

    Notes::

    +

    return-from can be used to return +prematurely from a function defined by defun. +

    +

    Additional side effects might take place when additional information +(typically debugging information) +about the function definition is recorded. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/delete_002dfile.html b/info/gcl/delete_002dfile.html new file mode 100644 index 0000000..8a19d4a --- /dev/null +++ b/info/gcl/delete_002dfile.html @@ -0,0 +1,107 @@ + + + + + +delete-file (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.8 delete-file [Function]

    + +

    delete-file filespec ⇒ t +

    +

    Arguments and Values::

    + +

    filespec—a pathname designator. +

    +

    Description::

    + +

    Deletes the file specified by filespec. +

    +

    If the filespec designator is an open stream, +then filespec and the file associated with it are affected +(if the file system permits), +in which case filespec might be closed immediately, +and the deletion might be immediate or delayed until filespec is explicitly closed, +depending on the requirements of the file system. +

    +

    It is implementation-dependent whether an attempt +to delete a nonexistent file is considered to be successful. +

    +

    delete-file returns true if it succeeds, +or signals an error of type file-error if it does not. +

    +

    The consequences are undefined + if filespec has a wild component, + or if filespec has a nil component + and the file system does not permit a nil component. +

    +

    Examples::

    + +
    +
     (with-open-file (s "delete-me.text" :direction :output :if-exists :error))
+⇒  NIL
+ (setq p (probe-file "delete-me.text")) ⇒  #P"R:>fred>delete-me.text.1"
+ (delete-file p) ⇒  T
+ (probe-file "delete-me.text") ⇒  false
+ (with-open-file (s "delete-me.text" :direction :output :if-exists :error)
+   (delete-file s))
+⇒  T
+ (probe-file "delete-me.text") ⇒  false
+
    + +

    Exceptional Situations::

    + +

    If the deletion operation is not successful, an error of type file-error is signaled. +

    +

    An error of type file-error might be signaled if filespec is wild. +

    +

    See Also::

    + +

    pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/delete_002dpackage.html b/info/gcl/delete_002dpackage.html new file mode 100644 index 0000000..3e71eba --- /dev/null +++ b/info/gcl/delete_002dpackage.html @@ -0,0 +1,196 @@ + + + + + +delete-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.11 delete-package [Function]

    + +

    delete-package package ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    package—a package designator. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    delete-package deletes package from all package system +data structures. +If the operation is successful, delete-package returns +true, otherwise nil. +The effect of delete-package is that the name and nicknames +of package cease to be recognized package names. +The package object is still a package +(i.e., packagep is true of it) +but package-name returns nil. +The consequences of deleting the COMMON-LISP package or the KEYWORD package are undefined. +The consequences of invoking any other package operation on package +once it has been deleted are unspecified. +In particular, the consequences of invoking find-symbol, +intern and other functions that look for a symbol name in +a package are unspecified if they are called with *package* +bound to the deleted package or with the deleted package +as an argument. +

    +

    If package is a package object that has already +been deleted, delete-package immediately returns nil. +

    +

    After this operation completes, the +home package +of any symbol whose home package +had previously been +package +is +implementation-dependent. +Except for this, symbols accessible +in package are not modified in any other way; +symbols whose home package is not package remain unchanged. +

    +

    Examples::

    + +
    +
     (setq *foo-package* (make-package "FOO" :use nil))
+ (setq *foo-symbol*  (intern "FOO" *foo-package*))
+ (export *foo-symbol* *foo-package*)
+
+ (setq *bar-package* (make-package "BAR" :use '("FOO")))
+ (setq *bar-symbol*  (intern "BAR" *bar-package*))
+ (export *foo-symbol* *bar-package*)
+ (export *bar-symbol* *bar-package*)
+
+ (setq *baz-package* (make-package "BAZ" :use '("BAR")))
+
+ (symbol-package *foo-symbol*) ⇒  #<PACKAGE "FOO">
+ (symbol-package *bar-symbol*) ⇒  #<PACKAGE "BAR">
+
+ (prin1-to-string *foo-symbol*) ⇒  "FOO:FOO"
+ (prin1-to-string *bar-symbol*) ⇒  "BAR:BAR"
+
+ (find-symbol "FOO" *bar-package*) ⇒  FOO:FOO, :EXTERNAL
+
+ (find-symbol "FOO" *baz-package*) ⇒  FOO:FOO, :INHERITED
+ (find-symbol "BAR" *baz-package*) ⇒  BAR:BAR, :INHERITED
+
+ (packagep *foo-package*) ⇒  true
+ (packagep *bar-package*) ⇒  true
+ (packagep *baz-package*) ⇒  true
+
+ (package-name *foo-package*) ⇒  "FOO"
+ (package-name *bar-package*) ⇒  "BAR"
+ (package-name *baz-package*) ⇒  "BAZ"
+
+ (package-use-list *foo-package*) ⇒  ()
+ (package-use-list *bar-package*) ⇒  (#<PACKAGE "FOO">)
+ (package-use-list *baz-package*) ⇒  (#<PACKAGE "BAR">)
+
+ (package-used-by-list *foo-package*) ⇒  (#<PACKAGE "BAR">)
+ (package-used-by-list *bar-package*) ⇒  (#<PACKAGE "BAZ">)
+ (package-used-by-list *baz-package*) ⇒  ()
+
+ (delete-package *bar-package*)
+ |>  Error: Package BAZ uses package BAR.
+ |>  If continued, BAZ will be made to unuse-package BAR,
+ |>  and then BAR will be deleted.
+ |>  Type :CONTINUE to continue.
+ |>  Debug> |>>:CONTINUE<<|
+⇒  T
+
+ (symbol-package *foo-symbol*) ⇒  #<PACKAGE "FOO">
+ (symbol-package *bar-symbol*) is unspecified
+
+ (prin1-to-string *foo-symbol*) ⇒  "FOO:FOO"
+ (prin1-to-string *bar-symbol*) is unspecified
+
+ (find-symbol "FOO" *bar-package*) is unspecified
+
+ (find-symbol "FOO" *baz-package*) ⇒  NIL, NIL
+ (find-symbol "BAR" *baz-package*) ⇒  NIL, NIL
+
+ (packagep *foo-package*) ⇒  T
+ (packagep *bar-package*) ⇒  T
+ (packagep *baz-package*) ⇒  T
+
+ (package-name *foo-package*) ⇒  "FOO"
+ (package-name *bar-package*) ⇒  NIL
+ (package-name *baz-package*) ⇒  "BAZ"
+
+ (package-use-list *foo-package*) ⇒  ()
+ (package-use-list *bar-package*) is unspecified
+ (package-use-list *baz-package*) ⇒  ()
+
+ (package-used-by-list *foo-package*) ⇒  ()
+ (package-used-by-list *bar-package*) is unspecified
+ (package-used-by-list *baz-package*) ⇒  ()
+
    + +

    Exceptional Situations::

    + +

    If the package designator is a name that does not +currently name a package, +a correctable error of type package-error is signaled. +If correction is attempted, no deletion action is attempted; +instead, delete-package immediately returns nil. +

    +

    If package is used by other packages, +a correctable error of type package-error is signaled. +If correction is attempted, +unuse-package is effectively called to remove any dependencies, +causing package’s external symbols to cease being accessible to those +packages that use package. +delete-package then deletes package just as it would have had +there been no packages that used it. +

    +

    See Also::

    + +

    unuse-package +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/deposit_002dfield.html b/info/gcl/deposit_002dfield.html new file mode 100644 index 0000000..09b996d --- /dev/null +++ b/info/gcl/deposit_002dfield.html @@ -0,0 +1,96 @@ + + + + + +deposit-field (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.67 deposit-field [Function]

    + +

    deposit-field newbyte bytespec integer ⇒ result-integer +

    +

    Arguments and Values::

    + +

    newbyte—an integer. +

    +

    bytespec—a byte specifier. +

    +

    integer—an integer. +

    +

    result-integer—an integer. +

    +

    Description::

    + +

    Replaces a field of bits within integer; specifically, +returns an integer that contains the bits of newbyte +within the byte specified by bytespec, +and elsewhere contains the bits of integer. +

    +

    Examples::

    + +
    +
     (deposit-field 7 (byte 2 1) 0) ⇒  6
+ (deposit-field -1 (byte 4 0) 0) ⇒  15
+ (deposit-field 0 (byte 2 1) -3) ⇒  -7
+
    + +

    See Also::

    + +

    byte +, +dpb +

    +

    Notes::

    + +
    +
     (logbitp j (deposit-field m (byte s p) n))
+ ≡ (if (and (>= j p) (< j (+ p s)))
+        (logbitp j m)
+        (logbitp j n))
+
    + +

    deposit-field is to mask-field +as dpb is to ldb. +

    + + + + + diff --git a/info/gcl/describe.html b/info/gcl/describe.html new file mode 100644 index 0000000..7e026f4 --- /dev/null +++ b/info/gcl/describe.html @@ -0,0 +1,104 @@ + + + + + +describe (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.6 describe [Function]

    + +

    describe object &optional stream ⇒ <no values> +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    stream—an output stream designator. + The default is standard output. +

    +

    Description::

    + +

    describe displays information about object +

    +

    to stream. +

    +

    For example, describe of a symbol might show the +symbol’s value, its definition, and each of its properties. +describe of a float might show the number’s +internal representation in a way that is useful for tracking +down round-off errors. In all cases, however, the nature and format of the +output of describe is implementation-dependent. +

    +

    describe can describe something that it finds inside the object; +in such cases, a notational device such as increased indentation or positioning in a +table is typically used in order to visually distinguish such recursive descriptions +from descriptions of the argument object. +

    +

    The actual act of describing the object is implemented by describe-object. +describe exists as an interface primarily to manage argument defaulting (including +conversion of arguments t and nil into stream objects) and to inhibit +any return values from describe-object. +

    +

    describe is not intended to be an interactive function. In a +conforming implementation, describe must not, by default, +prompt for user input. User-defined methods for describe-object +are likewise restricted. +

    +

    Side Effects::

    + +

    Output to standard output or terminal I/O. +

    +

    Affected By::

    + +

    *standard-output* and *terminal-io*, +methods on describe-object and print-object +for objects having user-defined classes. +

    +

    See Also::

    + +

    inspect +, +describe-object +

    + + + + + diff --git a/info/gcl/describe_002dobject.html b/info/gcl/describe_002dobject.html new file mode 100644 index 0000000..854e0f3 --- /dev/null +++ b/info/gcl/describe_002dobject.html @@ -0,0 +1,137 @@ + + + + + +describe-object (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.7 describe-object [Standard Generic Function]

    + +

    Syntax::

    + +

    describe-object object stream ⇒ implementation-dependent +

    +

    Method Signatures::

    + +

    describe-object (object standard-object) stream +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    stream—a stream. +

    +

    Description::

    + +

    The generic function describe-object prints a description of +object to a stream. describe-object is called +by describe; it must not be called by the user. +

    +

    Each implementation is required to provide a method on +the class standard-object and methods on enough other +classes so as to ensure that there is always an applicable method. +Implementations are free to add methods for other classes. +Users can write methods for describe-object for their +own classes if they do not wish to inherit an implementation-supplied +method. +

    +

    Methods on describe-object can recursively call +describe. Indentation, depth limits, and circularity detection +are all taken care of automatically, provided that each method +handles exactly one level of structure and calls describe +recursively if there are more structural levels. The consequences are +undefined if this rule is not obeyed. +

    +

    In some implementations the stream argument passed to a +describe-object method is not the original stream, but is +an intermediate stream that implements parts of describe. +Methods should therefore not depend on the identity of this +stream. +

    +

    Examples::

    + +
    +
     (defclass spaceship ()
+   ((captain :initarg :captain :accessor spaceship-captain)
+    (serial# :initarg :serial-number :accessor spaceship-serial-number)))
+
+ (defclass federation-starship (spaceship) ())
+
+ (defmethod describe-object ((s spaceship) stream)
+   (with-slots (captain serial#) s
+     (format stream "~&~S is a spaceship of type ~S,~
+                     ~
+                       and with serial number ~D.~
+             s (type-of s) captain serial#)))
+
+ (make-instance 'federation-starship
+                :captain "Rachel Garrett"
+                :serial-number "NCC-1701-C")
+⇒  #<FEDERATION-STARSHIP 26312465>
+
+ (describe *)
+ |>  #<FEDERATION-STARSHIP 26312465> is a spaceship of type FEDERATION-STARSHIP,
+ |>  with Rachel Garrett at the helm and with serial number NCC-1701-C.
+⇒  <no values>
+
    + +

    See Also::

    + +

    describe +

    +

    Notes::

    + +

    The same implementation techniques that are applicable to print-object are +applicable to describe-object. +

    +

    The reason for making the return values for describe-object +unspecified is to avoid forcing users to include explicit (values) +in all of their methods. describe takes care of that. +

    +
    +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    + + + + + diff --git a/info/gcl/destructuring_002dbind.html b/info/gcl/destructuring_002dbind.html new file mode 100644 index 0000000..ea46f00 --- /dev/null +++ b/info/gcl/destructuring_002dbind.html @@ -0,0 +1,93 @@ + + + + + +destructuring-bind (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.17 destructuring-bind [Macro]

    + +

    destructuring-bind lambda-list expression {declaration}* {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    lambda-list—a destructuring lambda list. +

    +

    expression—a form. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    destructuring-bind binds the variables specified in lambda-list +to the corresponding values in the tree structure resulting from the evaluation +of expression; then destructuring-bind evaluates forms. +

    +

    The lambda-list supports destructuring as described in +Destructuring Lambda Lists. +

    +

    Examples::

    +
    +
     (defun iota (n) (loop for i from 1 to n collect i))       ;helper
+ (destructuring-bind ((a &optional (b 'bee)) one two three)
+     `((alpha) ,@(iota 3))
+   (list a b three two one)) ⇒  (ALPHA BEE 3 2 1)
+
    + +

    Exceptional Situations::

    + +

    If the result of evaluating the expression does not match the +destructuring pattern, an error of type error should be signaled. +

    +

    See Also::

    + +

    macrolet, +defmacro +

    + + + + + diff --git a/info/gcl/digit_002dchar.html b/info/gcl/digit_002dchar.html new file mode 100644 index 0000000..8e0465e --- /dev/null +++ b/info/gcl/digit_002dchar.html @@ -0,0 +1,96 @@ + + + + + +digit-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.10 digit-char [Function]

    + +

    digit-char weight &optional radix ⇒ char +

    +

    Arguments and Values::

    + +

    weight—a non-negative integer. +

    +

    radix—a radix. + The default is 10. +

    +

    char—a character or false. +

    +

    Description::

    + +

    If weight is less than radix, +digit-char returns a character which has that weight +when considered as a digit in the specified radix. +If the resulting character is to be an alphabetic_1 character, +it will be an uppercase character. +

    +

    If weight is greater than or equal to radix, +digit-char returns false. +

    +

    Examples::

    + +
    +
     (digit-char 0) ⇒  #\0
+ (digit-char 10 11) ⇒  #\A
+ (digit-char 10 10) ⇒  false
+ (digit-char 7) ⇒  #\7
+ (digit-char 12) ⇒  false
+ (digit-char 12 16) ⇒  #\C  ;not #\c
+ (digit-char 6 2) ⇒  false
+ (digit-char 1 2) ⇒  #\1
+
    + +

    See Also::

    + +

    digit-char-p +, +graphic-char-p +, +Character Syntax +

    +

    Notes::

    + + + + + + diff --git a/info/gcl/digit_002dchar_002dp.html b/info/gcl/digit_002dchar_002dp.html new file mode 100644 index 0000000..6d17fdd --- /dev/null +++ b/info/gcl/digit_002dchar_002dp.html @@ -0,0 +1,105 @@ + + + + + +digit-char-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.11 digit-char-p [Function]

    + +

    digit-char-p char &optional radix ⇒ weight +

    +

    Arguments and Values::

    + +

    char—a character. +

    +

    radix—a radix. + The default is 10. +

    +

    weight—either a non-negative integer less than radix, + or false. +

    +

    Description::

    + +

    Tests whether char is a digit in the specified radix +(i.e., with a weight less than radix). +If it is a digit in that radix, +its weight is returned as an integer; +otherwise nil is returned. +

    +

    Examples::

    + +
    +
     (digit-char-p #\5)    ⇒  5
+ (digit-char-p #\5 2)  ⇒  false
+ (digit-char-p #\A)    ⇒  false
+ (digit-char-p #\a)    ⇒  false
+ (digit-char-p #\A 11) ⇒  10
+ (digit-char-p #\a 11) ⇒  10
+ (mapcar #'(lambda (radix) 
+             (map 'list #'(lambda (x) (digit-char-p x radix)) 
+                  "059AaFGZ"))
+         '(2 8 10 16 36))
+ ⇒  ((0 NIL NIL NIL NIL NIL NIL NIL)
+     (0 5 NIL NIL NIL NIL NIL NIL)
+     (0 5 9 NIL NIL NIL NIL NIL)
+     (0 5 9 10 10 15 NIL NIL)
+     (0 5 9 10 10 15 16 35))
+
    + +

    Affected By::

    + +

    None. +(In particular, the results of this predicate are independent +of any special syntax which might have been enabled in the current readtable.) +

    +

    See Also::

    + +

    alphanumericp +

    +

    Notes::

    + +

    Digits are graphic characters. +

    + + + + + diff --git a/info/gcl/directory.html b/info/gcl/directory.html new file mode 100644 index 0000000..e3f629d --- /dev/null +++ b/info/gcl/directory.html @@ -0,0 +1,110 @@ + + + + + +directory (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.1 directory [Function]

    + +

    directory pathspec &key ⇒ pathnames +

    +

    Arguments and Values::

    + +

    pathspec—a pathname designator, + which may contain wild components. +

    +

    pathnames—a list of +

    +

    physical pathnames. +

    +

    Description::

    + +

    Determines which, if any, files that are present +in the file system have names matching pathspec, +and returns a +

    +

    fresh +

    +

    list of pathnames corresponding to the truenames of +those files. +

    +

    An implementation may be extended to accept +implementation-defined keyword arguments to directory. +

    +

    Affected By::

    + +

    The host computer’s file system. +

    +

    Exceptional Situations::

    + +

    If the attempt to obtain a directory listing is not successful, +an error of type file-error is signaled. +

    +

    See Also::

    + +

    pathname, +

    +

    logical-pathname, +

    +

    ensure-directories-exist +, +File System Concepts, +File Operations on Open and Closed Streams, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    If the pathspec is not wild, +the resulting list will contain either zero or one elements. +

    +

    Common Lisp specifies “&key” in the argument list to directory +even though no standardized keyword arguments to directory are defined. +“:allow-other-keys t” +may be used in conforming programs in order to quietly ignore any +additional keywords which are passed by the program but not supported +by the implementation. +

    + + + + + diff --git a/info/gcl/disassemble.html b/info/gcl/disassemble.html new file mode 100644 index 0000000..afae947 --- /dev/null +++ b/info/gcl/disassemble.html @@ -0,0 +1,94 @@ + + + + + +disassemble (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.14 disassemble [Function]

    + +

    disassemble fn ⇒ nil +

    +

    Arguments and Values::

    + +

    fn—an extended function designator + or a lambda expression. +

    +

    Description::

    + +

    The function disassemble is a debugging aid that composes symbolic +instructions or expressions in some implementation-dependent +language which represent the code used to produce the function +which is or is named by the argument fn. The result is displayed +to standard output in an implementation-dependent format. +

    +

    If fn is a lambda expression or interpreted function, +it is compiled first and the result is disassembled. +

    +

    If the fn designator is a function name, +the function that it names is disassembled. +

    +

    (If that function is an interpreted function, +it is first compiled but the result of this implicit compilation is not installed.) +

    +

    Examples::

    + +
    +
     (defun f (a) (1+ a)) ⇒  F
+ (eq (symbol-function 'f)
+     (progn (disassemble 'f)
+            (symbol-function 'f))) ⇒  true
+
    + +

    Affected By::

    + +

    *standard-output*. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if fn is not an extended function designator + or a lambda expression. +

    + + + + + diff --git a/info/gcl/division_002dby_002dzero.html b/info/gcl/division_002dby_002dzero.html new file mode 100644 index 0000000..65ac7b1 --- /dev/null +++ b/info/gcl/division_002dby_002dzero.html @@ -0,0 +1,64 @@ + + + + + +division-by-zero (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.80 division-by-zero [Condition Type]

    + +

    Class Precedence List::

    +

    division-by-zero, +arithmetic-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type division-by-zero consists of error conditions that +occur because of division by zero. +

    + + + + + diff --git a/info/gcl/do.html b/info/gcl/do.html new file mode 100644 index 0000000..649d777 --- /dev/null +++ b/info/gcl/do.html @@ -0,0 +1,330 @@ + + + + + +do (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    +
    +

    6.2.1 do, do* [Macro]

    + +

    do ({var | (var [init-form [step-form]])}*) + (end-test-form {result-form}*) + {declaration}* {tag | statement}*
    + ⇒ {result}* +

    +

    do* ({var | (var [init-form [step-form]])}*) + (end-test-form {result-form}*) + {declaration}* {tag | statement}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a symbol. +

    +

    init-form—a form. +

    +

    step-form—a form. +

    +

    end-test-form—a form. +

    +

    result-forms—an implicit progn. +

    +

    declaration—a declare expression; not evaluated. +

    +

    tag—a go tag; not evaluated. +

    +

    statement—a compound form; evaluated as described below. +

    +

    results—if a return or return-from form is executed, + the values passed from that form; + otherwise, the values returned by the result-forms. +

    +

    Description::

    + +

    do iterates over a group of statements +while a test condition holds. +do accepts an arbitrary number of iteration vars +which are bound within the iteration and stepped in parallel. +An initial value may be supplied for each iteration variable by use of +an init-form. +Step-forms may be used to specify how the +vars should be updated on succeeding iterations through the loop. +Step-forms may be used both to generate successive +values or to accumulate results. +If the end-test-form condition +is met prior to an execution of the body, the iteration terminates. +Tags label statements. +

    +

    do* is exactly like do +except that the bindings and steppings +of the vars are performed sequentially rather than in parallel. +

    +

    Before the first iteration, all the init-forms are evaluated, and +each var is bound to the value of its respective init-form, +if supplied. +This is a binding, not an assignment; when the loop terminates, +the old values of those variables will be restored. +For do, all +of the init-forms are evaluated before any var +is bound. The +init-forms can refer to the bindings of the vars +visible before beginning execution of +do. +For do*, the first init-form is evaluated, then the first +var is bound to that value, then the second init-form +is evaluated, then the second var is bound, and so on; +in general, the kth init-form can refer to the new binding +of the jth var if j < k, and otherwise to the +old binding of the jth var. +

    +

    At the beginning of each iteration, after processing the variables, +the end-test-form is evaluated. If the result is +false, execution proceeds with the body of the do +(or do*) form. +If the result is true, the result-forms are evaluated in order +as an implicit progn, +and then do or do* returns. +

    +

    At the beginning of each iteration other than the first, +vars are updated as follows. All the step-forms, if supplied, +are evaluated, from left to right, and the resulting values are +assigned to the respective vars. +Any var that has no associated step-form is not assigned to. +For do, all the step-forms are evaluated before any var +is updated; the assignment of values to vars is done in parallel, +as if by psetq. +Because all of the step-forms are evaluated before any +of the vars are altered, a step-form when evaluated always has +access to the old values of all the vars, even if other step-forms +precede it. +For do*, the first step-form is evaluated, then the +value is assigned to the first var, then the second step-form +is evaluated, then the value is assigned to the second var, and so on; +the assignment of values to variables is done sequentially, +as if by setq. +For either do or do*, +after the vars have been updated, +the end-test-form +is evaluated as described above, and the iteration continues. +

    +

    The remainder of the do (or do*) form constitutes +an implicit tagbody. +Tags may appear within the body of a do loop +for use by go statements appearing in the body (but such go +statements may not appear in the variable specifiers, the end-test-form, +or the result-forms). +When the end of a do body is reached, the next iteration cycle +(beginning with the evaluation of step-forms) occurs. +

    +

    An implicit block named nil surrounds the entire do +(or do*) form. +A return statement may be used at any point to exit the loop +immediately. +

    +

    Init-form is an +initial value for the var with which it is associated. +If init-form is omitted, the initial value of var is nil. +If a declaration is supplied for a var, init-form +must be consistent with the declaration. +

    +

    Declarations can appear at the beginning of a do +(or do*) body. +They apply to code in the do (or do*) body, +to the bindings of the do (or do*) +vars, +to the step-forms, +to the end-test-form, and to the result-forms. +

    +

    Examples::

    +
    +
     (do ((temp-one 1 (1+ temp-one))
+       (temp-two 0 (1- temp-two)))
+      ((> (- temp-one temp-two) 5) temp-one)) ⇒  4
+
+ (do ((temp-one 1 (1+ temp-one))
+       (temp-two 0 (1+ temp-one)))     
+      ((= 3 temp-two) temp-one)) ⇒  3
+
+ (do* ((temp-one 1 (1+ temp-one))
+        (temp-two 0 (1+ temp-one)))
+       ((= 3 temp-two) temp-one)) ⇒  2                     
+
+ (do ((j 0 (+ j 1)))
+     (nil)                       ;Do forever.
+   (format t "~
+   (let ((item (read)))
+     (if (null item) (return)   ;Process items until NIL seen.
+         (format t "~&Output ~D: ~S" j item))))
+ |>  Input 0: |>>banana<<|
+ |>  Output 0: BANANA
+ |>  Input 1: |>>(57 boxes)<<|
+ |>  Output 1: (57 BOXES)
+ |>  Input 2: |>>NIL<<|
+⇒  NIL
+
+ (setq a-vector (vector 1 nil 3 nil))
+ (do ((i 0 (+ i 1))     ;Sets every null element of a-vector to zero.
+      (n (array-dimension a-vector 0)))
+     ((= i n))
+   (when (null (aref a-vector i))
+     (setf (aref a-vector i) 0))) ⇒  NIL
+a-vector ⇒  #(1 0 3 0)
+
    + +
    +
     (do ((x e (cdr x))
+      (oldx x x))
+     ((null x))
+   body)
+
    + +

    is an example of parallel assignment to index variables. On the first +iteration, the value of oldx is whatever value x had before +the do was entered. On succeeding iterations, oldx contains +the value that x had on the previous iteration. +

    +
    +
     (do ((x foo (cdr x))
+      (y bar (cdr y))
+      (z '() (cons (f (car x) (car y)) z)))
+     ((or (null x) (null y))
+      (nreverse z)))
+
    + +

    does the same thing as (mapcar #'f foo bar). The step +computation for z is an example of the fact that variables +are stepped in parallel. +Also, the body of the loop is empty. +

    +
    +
     (defun list-reverse (list)
+        (do ((x list (cdr x))
+             (y '() (cons (car x) y)))
+            ((endp x) y)))
+
    + +

    As an example of nested iterations, consider a data structure that is a +list of conses. The car of each cons is a +list of symbols, +and the cdr of each cons is a +list of equal length containing +corresponding values. Such a data structure is similar to an association +list, +but is divided into “frames”; the overall structure resembles a rib-cage. +A lookup function on such a data structure might be: +

    +
    +
     (defun ribcage-lookup (sym ribcage)           
+        (do ((r ribcage (cdr r)))
+            ((null r) nil)
+          (do ((s (caar r) (cdr s))
+               (v (cdar r) (cdr v))) 
+              ((null s))
+            (when (eq (car s) sym)
+              (return-from ribcage-lookup (car v)))))) ⇒  RIBCAGE-LOOKUP
+
    + +

    See Also::

    + +

    other iteration functions + ( +dolist +, +dotimes +, and +loop +) +and more primitive functionality + ( +tagbody +, +go +, +block +, +return +, +

    +

    let +, and +setq +) +

    +

    Notes::

    +

    If end-test-form is nil, the test will never succeed. +This provides an idiom for “do forever”: +the body of the do or do* +is executed repeatedly. +The infinite loop can be terminated by the use of return, +return-from, go to an outer level, or throw. +

    +

    A do form may be explained in terms of the more primitive forms +block, return, +let, loop, tagbody, +and psetq as follows: +

    +
    +
     (block nil        
+   (let ((var1 init1)
+         (var2 init2)
+         ...
+         (varn initn))
+     declarations
+     (loop (when end-test (return (progn . result)))
+           (tagbody . tagbody)
+           (psetq var1 step1
+                  var2 step2
+                  ...
+                  varn stepn))))
+
    + +

    do* is similar, except that let* and setq replace +the let and psetq, respectively. +

    +
    +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    + + + + + diff --git a/info/gcl/do_002dsymbols.html b/info/gcl/do_002dsymbols.html new file mode 100644 index 0000000..7dc3694 --- /dev/null +++ b/info/gcl/do_002dsymbols.html @@ -0,0 +1,174 @@ + + + + + +do-symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.20 do-symbols, do-external-symbols, do-all-symbols [Macro]

    + +

    do-symbols (var [package [result-form]]) + {declaration}* + {tag | statement}*
    + ⇒ {result}* +

    +

    do-external-symbols (var [package [result-form]]) + {declaration}* + {tag | statement}*
    + ⇒ {result}* +

    +

    do-all-symbols (var [result-form]) + {declaration}* + {tag | statement}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a variable name; not evaluated. +

    +

    package—a package designator; evaluated. +

    +

    The default in do-symbols and do-external-symbols is the current package. +

    +

    result-form—a form; evaluated as described below. + The default is nil. +

    +

    declaration—a declare expression; not evaluated. +

    +

    tag—a go tag; not evaluated. +

    +

    statement—a compound form; evaluated as described below. +

    +

    results—the values returned by the result-form + if a normal return occurs, + or else, if an explicit return occurs, the values that were transferred. +

    +

    Description::

    + +

    do-symbols, +do-external-symbols, and +do-all-symbols iterate over the symbols +of packages. +For each symbol in the set of packages chosen, +the var is bound to the symbol, +and the statements in the body are executed. +When all the symbols have been processed, +result-form is evaluated and returned as the value of the macro. +

    +

    do-symbols iterates +over the symbols accessible in +package. +

    +

    Statements may execute more than once for symbols +that are inherited from multiple packages. +

    +

    do-all-symbols iterates on every registered package. +do-all-symbols will not process every symbol +whatsoever, because a symbol not accessible in any +registered package will not be processed. +do-all-symbols may cause a symbol that is present in +several packages to be processed more than once. +

    +

    do-external-symbols iterates on the external symbols of package. +

    +

    When result-form is evaluated, var is bound and has the value nil. +

    +

    An implicit block named nil surrounds the entire do-symbols, +do-external-symbols, or do-all-symbols form. +

    +

    return or return-from may be used to terminate the +iteration prematurely. +

    +

    If execution of the body affects which symbols +are contained in the set of packages over which iteration +is occurring, other than to +remove the symbol +currently the value of var by using unintern, +the consequences are undefined. +

    +

    For each of these macros, the +scope of the name binding does not include any +initial value form, but the optional result forms are included. +

    +

    Any tag in the body is treated as with tagbody. +

    +

    Examples::

    + +
    +
     (make-package 'temp :use nil) ⇒  #<PACKAGE "TEMP">
+ (intern "SHY" 'temp) ⇒  TEMP::SHY, NIL ;SHY will be an internal symbol
+                                         ;in the package TEMP
+ (export (intern "BOLD" 'temp) 'temp)  ⇒  T  ;BOLD will be external  
+ (let ((lst ()))
+   (do-symbols (s (find-package 'temp)) (push s lst))
+   lst)
+⇒  (TEMP::SHY TEMP:BOLD)
+OR⇒ (TEMP:BOLD TEMP::SHY)
+ (let ((lst ()))
+   (do-external-symbols (s (find-package 'temp) lst) (push s lst))
+   lst) 
+⇒  (TEMP:BOLD)
+ (let ((lst ()))                                                     
+   (do-all-symbols (s lst)
+     (when (eq (find-package 'temp) (symbol-package s)) (push s lst)))
+   lst)
+⇒  (TEMP::SHY TEMP:BOLD)
+OR⇒ (TEMP:BOLD TEMP::SHY)
+
    + +

    See Also::

    + +

    intern +, +export +, +

    +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/documentation.html b/info/gcl/documentation.html new file mode 100644 index 0000000..8bc84f8 --- /dev/null +++ b/info/gcl/documentation.html @@ -0,0 +1,247 @@ + + + + + +documentation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.15 documentation, (setf documentation) [Standard Generic Function]

    + +

    Syntax::

    + +

    documentation x doc-type ⇒ documentation +

    +

    (setf documentation) new-value x doc-type ⇒ new-value +

    +

    Argument Precedence Order::

    + +

    doc-type, object +

    +

    Method Signatures::

    + +

    Functions, Macros, and Special Forms

    + +

    documentation (x function) (doc-type (eql ’t))
    +(setf documentation) new-value(x function) (doc-type (eql ’t)) +

    +

    documentation (x function) (doc-type (eql ’function))
    +(setf documentation) new-value(x function) (doc-type (eql ’function)) +

    +

    documentation (x list) (doc-type (eql ’function))
    +(setf documentation) new-value(x list) (doc-type (eql ’function)) +

    +

    documentation (x list) (doc-type (eql ’compiler-macro))
    +(setf documentation) new-value(x list) (doc-type (eql ’compiler-macro)) +

    +

    documentation (x symbol) (doc-type (eql ’function))
    +(setf documentation) new-value(x symbol) (doc-type (eql ’function)) +

    +

    documentation (x symbol) (doc-type (eql ’compiler-macro))
    +(setf documentation) new-value(x symbol) (doc-type (eql ’compiler-macro)) +

    +

    documentation (x symbol) (doc-type (eql ’setf))
    +(setf documentation) new-value(x symbol) (doc-type (eql ’setf)) +

    +

    Method Combinations

    + +

    documentation (x method-combination) (doc-type (eql ’t))
    +(setf documentation) new-value(x method-combination) (doc-type (eql ’t)) +

    +

    documentation (x method-combination) (doc-type (eql ’method-combination))
    +(setf documentation) new-value(x method-combination) (doc-type (eql ’method-combination)) +

    +

    documentation (x symbol) (doc-type (eql ’method-combination))
    +(setf documentation) new-value(x symbol) (doc-type (eql ’method-combination)) +

    +

    Methods

    + +

    documentation (x standard-method) (doc-type (eql ’t))
    +(setf documentation) new-value(x standard-method) (doc-type (eql ’t)) +

    +

    Packages

    + +

    documentation (x package) (doc-type (eql ’t))
    +(setf documentation) new-value(x package) (doc-type (eql ’t)) +

    +

    Types, Classes, and Structure Names

    + +

    documentation (x standard-class) (doc-type (eql ’t))
    +(setf documentation) new-value(x standard-class) (doc-type (eql ’t)) +

    +

    documentation (x standard-class) (doc-type (eql ’type))
    +(setf documentation) new-value(x standard-class) (doc-type (eql ’type)) +

    +

    documentation (x structure-class) (doc-type (eql ’t))
    +(setf documentation) new-value(x structure-class) (doc-type (eql ’t)) +

    +

    documentation (x structure-class) (doc-type (eql ’type))
    +(setf documentation) new-value(x structure-class) (doc-type (eql ’type)) +

    +

    documentation (x symbol) (doc-type (eql ’type))
    +(setf documentation) new-value(x symbol) (doc-type (eql ’type)) +

    +

    documentation (x symbol) (doc-type (eql ’structure))
    +(setf documentation) new-value(x symbol) (doc-type (eql ’structure)) +

    +

    Variables

    + +

    documentation (x symbol) (doc-type (eql ’variable))
    +(setf documentation) new-value(x symbol) (doc-type (eql ’variable)) +

    +

    Arguments and Values::

    + +

    x—an object. +

    +

    doc-type—a symbol. +

    +

    documentation—a string, or nil. +

    +

    new-value—a string. +

    +

    Description::

    + +

    The generic function documentation returns the documentation string +associated with the given object if it is available; +otherwise it returns nil. +

    +

    The generic function (setf documentation) updates the +documentation string associated with x to new-value. +If x is a list, +it must be of the form (setf symbol). +

    +

    Documentation strings are made available for debugging purposes. +Conforming programs are permitted to use documentation strings +when they are present, but should not depend for their correct behavior on +the presence of those documentation strings. +An implementation is permitted to discard documentation strings +at any time for implementation-defined reasons. +

    +

    The nature of the documentation string returned depends on the +doc-type, as follows: +

    +
    +
    compiler-macro
    +

    Returns the documentation string of the compiler macro +whose name is the function name x. +

    +
    +
    function
    +

    If x is a function name, +returns the documentation string of +the function, macro, or special operator +whose name is x. +

    +

    If x is a function, +returns the documentation string associated with x. +

    +
    +
    method-combination
    +

    If x is a symbol, +returns the documentation string of +the method combination +whose name is x. +

    +

    If x is a method combination, +returns the documentation string associated with x. +

    +
    +
    setf
    +

    Returns the documentation string of +

    +

    the setf expander +

    +

    whose name is the symbol x. +

    +
    +
    structure
    +

    Returns the documentation string +associated with the structure name x. +

    +
    +
    t
    +

    Returns a documentation string specialized on the class of +the argument x itself. +For example, if x is a function, +the documentation string associated with the function x is returned. +

    +
    +
    type
    +

    If x is a symbol, +returns the documentation string of the class +whose name is the symbol x, +if there is such a class. +Otherwise, it returns the documentation string of the type +which is the type specifier symbol x. +

    +

    If x is a structure class or standard class, +returns the documentation string associated with +the class x. +

    +
    +
    variable
    +

    Returns the documentation string of +the dynamic variable or constant variable +whose name is the symbol x. +

    +
    +
    + +

    A conforming implementation or a conforming program +may extend the set of symbols that are acceptable as the doc-type. +

    +

    Notes::

    + +

    This standard prescribes no means to retrieve the documentation strings +for individual slots specified in a defclass form, but +implementations might still provide debugging tools and/or +programming language extensions which manipulate this information. +Implementors wishing to provide such support are encouraged to consult the +Metaobject Protocol for suggestions about how this might be done. +

    +
    +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    + + + + + diff --git a/info/gcl/dolist.html b/info/gcl/dolist.html new file mode 100644 index 0000000..9836349 --- /dev/null +++ b/info/gcl/dolist.html @@ -0,0 +1,144 @@ + + + + + +dolist (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    +
    +

    6.2.3 dolist [Macro]

    + +

    dolist (var list-form [result-form]) + {declaration}* + {tag | statement}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a symbol. +

    +

    list-form—a form. +

    +

    result-form—a form. +

    +

    declaration—a declare expression; not evaluated. +

    +

    tag—a go tag; not evaluated. +

    +

    statement—a compound form; evaluated as described below. +

    +

    results—if a return or return-from form is executed, + the values passed from that form; + otherwise, the values returned by the result-form + or nil if there is no result-form. +

    +

    Description::

    + +

    dolist iterates over the elements of a list. +The body of dolist is like a tagbody. +It consists of a series of tags and statements. +

    +

    dolist +evaluates list-form, +which should produce a list. It then executes the body +once for each element in the list, in the order in which the +tags and statements occur, with +var bound to the element. +Then result-form +is evaluated. +tags label +statements. +

    +

    At the time result-form is processed, +var is bound to nil. +

    +

    An implicit block +named nil surrounds dolist. +return may be used to terminate the loop immediately without +performing any further iterations, returning zero or more values. +

    +

    The scope of the binding of var +does not include the list-form, +but the result-form is included. +

    +

    It is implementation-dependent whether dolist +establishes a new binding of var on each iteration +or whether it establishes a binding for var once at the +beginning and then assigns it on any subsequent iterations. +

    +

    Examples::

    +
    +
     (setq temp-two '()) ⇒  NIL
+ (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two)) ⇒  (4 3 2 1)
+
+ (setq temp-two 0) ⇒  0
+ (dolist (temp-one '(1 2 3 4)) (incf temp-two)) ⇒  NIL
+ temp-two ⇒  4
+
+ (dolist (x '(a b c d)) (prin1 x) (princ " ")) 
+ |>  A B C D 
+⇒  NIL
+
    + +

    See Also::

    + +

    do +, +dotimes +, +tagbody +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    go may be used within the body of dolist +to transfer control to a statement labeled by a tag. +

    +
    +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    + + + + + diff --git a/info/gcl/dotimes.html b/info/gcl/dotimes.html new file mode 100644 index 0000000..5578060 --- /dev/null +++ b/info/gcl/dotimes.html @@ -0,0 +1,172 @@ + + + + + +dotimes (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    +
    +

    6.2.2 dotimes [Macro]

    + +

    dotimes (var count-form [result-form]) + {declaration}* + {tag | statement}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a symbol. +

    +

    count-form—a form. +

    +

    result-form—a form. +

    +

    declaration—a declare expression; not evaluated. +

    +

    tag—a go tag; not evaluated. +

    +

    statement—a compound form; evaluated as described below. +

    +

    results—if a return or return-from form is executed, + the values passed from that form; + otherwise, the values returned by the result-form + or nil if there is no result-form. +

    +

    Description::

    + +

    dotimes iterates over a series of integers. +

    +

    dotimes evaluates count-form, +which should produce an integer. +If count-form is zero or negative, +the body is not executed. +dotimes then executes the body once for each integer from 0 up to +but not including +the value of count-form, +in the order in which the +tags and statements occur, with +var bound to each integer. +Then result-form +is evaluated. +At the time result-form is processed, var is bound to +the number of times the body was executed. +Tags label +statements. +

    +

    An implicit block +named nil surrounds dotimes. +return may be used to terminate the loop immediately without +performing any further iterations, returning zero or more values. +

    +

    The body of the loop is an implicit tagbody; +it may contain tags to serve as the targets of go statements. +Declarations may appear before the body of the loop. +

    +

    The scope of the binding of var +does not include the count-form, +but the result-form is included. +

    +

    It is implementation-dependent whether dotimes +establishes a new binding of var on each iteration +or whether it establishes a binding for var once at the +beginning and then assigns it on any subsequent iterations. +

    +

    Examples::

    + +
    +
     (dotimes (temp-one 10 temp-one)) ⇒  10
+ (setq temp-two 0) ⇒  0
+ (dotimes (temp-one 10 t) (incf temp-two)) ⇒  T
+ temp-two ⇒  10
+
    + +

    Here is an example of the use of dotimes in processing strings: +

    +
    +
    ;;; True if the specified subsequence of the string is a
+;;; palindrome (reads the same forwards and backwards).
+ (defun palindromep (string &optional
+                           (start 0)
+                           (end (length string)))
+   (dotimes (k (floor (- end start) 2) t)
+    (unless (char-equal (char string (+ start k))
+                        (char string (- end k 1)))
+      (return nil))))
+ (palindromep "Able was I ere I saw Elba") ⇒  T
+ (palindromep "A man, a plan, a canal--Panama!") ⇒  NIL
+ (remove-if-not #'alpha-char-p          ;Remove punctuation.
+               "A man, a plan, a canal--Panama!")
+⇒  "AmanaplanacanalPanama"
+ (palindromep
+  (remove-if-not #'alpha-char-p
+                "A man, a plan, a canal--Panama!")) ⇒  T
+ (palindromep
+  (remove-if-not
+   #'alpha-char-p
+   "Unremarkable was I ere I saw Elba Kramer, nu?")) ⇒  T
+ (palindromep
+  (remove-if-not
+   #'alpha-char-p
+   "A man, a plan, a cat, a ham, a yak,
+                  a yam, a hat, a canal--Panama!")) ⇒  T
+
    + +

    See Also::

    + +

    do +, +dolist +, +tagbody +

    +

    Notes::

    + +

    go may be used within the body of +dotimes to transfer control to a statement labeled by a tag. +

    +
    +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    + + + + + diff --git a/info/gcl/dpb.html b/info/gcl/dpb.html new file mode 100644 index 0000000..201bcf7 --- /dev/null +++ b/info/gcl/dpb.html @@ -0,0 +1,118 @@ + + + + + +dpb (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.68 dpb [Function]

    + +

    dpb newbyte bytespec integer ⇒ result-integer +

    +

    Pronunciation::

    + +

    pronounced ,de ’pib + or pronounced ,de ’pe b + or pronounced ’d\=e ’p\=e ’b\=e +

    +

    Arguments and Values::

    + +

    newbyte—an integer. +

    +

    bytespec—a byte specifier. +

    +

    integer—an integer. +

    +

    result-integer—an integer. +

    +

    Description::

    + +

    dpb (deposit byte) is used to +replace a field of bits within integer. +dpb returns an integer that is +the same as integer except in the bits specified by bytespec. +

    +

    Let s be the size specified +by bytespec; then the low s bits of newbyte appear in +the result in the byte specified by bytespec. +Newbyte is interpreted as +being right-justified, as if it were the result of ldb. +

    +

    Examples::

    + +
    +
     (dpb 1 (byte 1 10) 0) ⇒  1024
+ (dpb -2 (byte 2 10) 0) ⇒  2048
+ (dpb 1 (byte 2 10) 2048) ⇒  1024
+
    + +

    See Also::

    + +

    byte +, +deposit-field +, +ldb +

    +

    Notes::

    + +
    +
     (logbitp j (dpb m (byte s p) n))
+ ≡ (if (and (>= j p) (< j (+ p s)))
+        (logbitp (- j p) m)
+        (logbitp j n))
+
    + +

    In general, +

    +
    +
     (dpb x (byte 0 y) z) ⇒  z
+
    + +

    for all valid values of x, y, and z. +

    +

    Historically, the name “dpb” comes from a DEC PDP-10 assembly language +instruction meaning “deposit byte.” +

    + + + + + diff --git a/info/gcl/dribble.html b/info/gcl/dribble.html new file mode 100644 index 0000000..2b31c32 --- /dev/null +++ b/info/gcl/dribble.html @@ -0,0 +1,112 @@ + + + + + +dribble (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.19 dribble [Function]

    + +

    dribble &optional pathname ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    pathname—a pathname designator. +

    +

    Description::

    + +

    Either binds *standard-input* and *standard-output* +or takes other appropriate action, +so as to send a record of the input/output interaction to a file +named by pathname. dribble is intended to create +a readable record of an interactive session. +

    +

    If pathname is a logical pathname, it is translated +into a physical pathname as if by calling translate-logical-pathname. +

    +

    (dribble) terminates the recording of input and output +and closes the dribble file. +

    +

    If dribble is called while a stream to a “dribble file” +is still open from a previous call to dribble, +the effect is implementation-defined. For example, + the already-open stream might be closed, + or dribbling might occur both to the old stream and to a new one, + or the old stream might stay open but not receive any further output, + or the new request might be ignored, + or some other action might be taken. +

    +

    Affected By::

    + +

    The implementation. +

    +

    Exceptional Situations::

    + +

    If a failure occurs when performing some operation on the file system +while creating the dribble file, +an error of type file-error is signaled. +

    +

    An error of type file-error might be signaled if pathname +is a designator for a wild pathname. +

    +

    See Also::

    + +

    Pathnames as Filenames +

    +

    Notes::

    + +

    dribble can return before subsequent +forms are executed. It also +can enter a recursive interaction loop, +returning only when (dribble) is done. +

    +

    dribble is intended primarily for interactive debugging; +its effect cannot be relied upon when used in a program. +

    +
    +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    + + + + + diff --git a/info/gcl/dynamic_002dextent.html b/info/gcl/dynamic_002dextent.html new file mode 100644 index 0000000..252c477 --- /dev/null +++ b/info/gcl/dynamic_002dextent.html @@ -0,0 +1,267 @@ + + + + + +dynamic-extent (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.20 dynamic-extent [Declaration]

    + +

    Syntax::

    + +

    (dynamic-extent [[{var}* | + (function fn)*]]) +

    +

    Arguments::

    + +

    var—a variable name. +

    +

    fn—a function name. +

    +

    Valid Context::

    + +

    declaration +

    +

    Binding Types Affected::

    + +

    variable, function +

    +

    Description::

    + +

    In some containing form, F, this declaration +asserts for each var_i (which need not be bound by F), +and for each value v_{ij} that var_i takes on, +and for each object x_{ijk} that +is +an otherwise inaccessible part of v_{ij} at any time when +v_{ij} +becomes the value of var_i, +that just after the execution of F terminates, +x_{ijk} is either inaccessible +(if F established a binding for var_i) +or still an otherwise inaccessible part of the current value of +var_i (if F did not establish a binding +for var_i). +

    +

    The same relation holds for each fn_i, +except that the bindings are in the function namespace. +

    +

    The compiler is permitted to use +this information in any way that is appropriate to the implementation +and that does not conflict with the semantics of Common Lisp. +

    +

    dynamic-extent declarations can be free declarations +or bound declarations. +

    +

    The vars and fns named in a dynamic-extent +declaration must not refer to symbol macro or macro bindings. +

    +

    Examples::

    + +

    Since stack allocation of the initial value entails knowing at the +object’s creation time that the object can be +stack-allocated, it is not generally useful to make a +dynamic-extent declaration for variables +which have no lexically apparent initial value. +For example, it is probably useful to write: +

    +
    +
     (defun f ()
+   (let ((x (list 1 2 3)))
+     (declare (dynamic-extent x))
+         ...))
+
    + +

    This would permit those compilers that wish to do so to stack allocate +the list held by the local variable x. It is permissible, +but in practice probably not as useful, to write: +

    +
    +
     (defun g (x) (declare (dynamic-extent x)) ...)
+ (defun f () (g (list 1 2 3)))
+
    + +

    Most compilers would probably not stack allocate the argument +to g in f because it would be a modularity violation for the compiler +to assume facts about g from within f. Only an implementation that +was willing to be responsible for recompiling f if the definition of g +changed incompatibly could legitimately stack allocate the list +argument to g in f. +

    +

    Here is another example: +

    +
    +
     (declaim (inline g))
+ (defun g (x) (declare (dynamic-extent x)) ...)
+ (defun f () (g (list 1 2 3)))
+
+ (defun f ()
+   (flet ((g (x) (declare (dynamic-extent x)) ...))
+     (g (list 1 2 3))))
+
+
    + +

    In the previous example, some compilers might determine that optimization was +possible and others might not. +

    +

    A variant of this is the so-called “stack allocated rest list” +that can be achieved (in implementations supporting the optimization) by: +

    +
    +
     (defun f (&rest x)
+   (declare (dynamic-extent x))
+   ...)
+
    + +

    Note that although the initial value of x is not explicit, the f +function is responsible for assembling the list x from the passed arguments, +so the f function can be optimized by the compiler to construct a +stack-allocated list instead of a heap-allocated list in implementations +that support such. +

    +

    In the following example, +

    +
    +
     (let ((x (list 'a1 'b1 'c1))
+       (y (cons 'a2 (cons 'b2 (cons 'c2 nil)))))
+   (declare (dynamic-extent x y))
+   ...)
+
    + +

    The otherwise inaccessible parts of x are three +conses, and the otherwise inaccessible parts +of y are three other conses. +None of the symbols a1, b1, c1, a2, +b2, c2, or nil is an +otherwise inaccessible part of x or y because each +is interned and hence accessible by the package +(or packages) in which it is interned. +However, if a freshly allocated uninterned symbol had +been used, it would have been an otherwise inaccessible part of +the list which contained it. +

    +
    +
    ;; In this example, the implementation is permitted to stack allocate
+;; the list that is bound to X.
+ (let ((x (list 1 2 3)))
+   (declare (dynamic-extent x))
+   (print x)
+   :done)
+ |>  (1 2 3)
+⇒  :DONE
+
+;; In this example, the list to be bound to L can be stack-allocated.
+ (defun zap (x y z)
+   (do ((l (list x y z) (cdr l)))
+       ((null l))
+     (declare (dynamic-extent l))
+     (prin1 (car l)))) ⇒  ZAP
+ (zap 1 2 3)
+ |>  123
+⇒  NIL
+
+;; Some implementations might open-code LIST-ALL-PACKAGES in a way
+;; that permits using stack allocation of the list to be bound to L.
+ (do ((l (list-all-packages) (cdr l)))
+     ((null l))
+   (declare (dynamic-extent l))
+   (let ((name (package-name (car l))))
+     (when (string-search "COMMON-LISP" name) (print name))))
+ |>  "COMMON-LISP"
+ |>  "COMMON-LISP-USER"
+⇒  NIL
+
+;; Some implementations might have the ability to stack allocate 
+;; rest lists.  A declaration such as the following should be a cue
+;; to such implementations that stack-allocation of the rest list
+;; would be desirable.
+ (defun add (&rest x)
+   (declare (dynamic-extent x))
+   (apply #'+ x)) ⇒  ADD
+ (add 1 2 3) ⇒  6
+
+ (defun zap (n m)
+   ;; Computes (RANDOM (+ M 1)) at relative speed of roughly O(N).
+   ;; It may be slow, but with a good compiler at least it
+   ;; doesn't waste much heap storage.  :-}
+   (let ((a (make-array n)))
+     (declare (dynamic-extent a))
+     (dotimes (i n) 
+       (declare (dynamic-extent i))
+       (setf (aref a i) (random (+ i 1))))
+     (aref a m))) ⇒  ZAP
+ (< (zap 5 3) 3) ⇒  true
+
    + +

    The following are in error, since the value of x is used outside of its +extent: +

    +
    +
     (length (list (let ((x (list 1 2 3)))  ; Invalid
+                (declare (dynamic-extent x))
+                x)))
+
+ (progn (let ((x (list 1 2 3)))  ; Invalid
+          (declare (dynamic-extent x))
+          x)
+        nil)
+
    + +

    See Also::

    + +

    declare +

    +

    Notes::

    + +

    The most common optimization is to stack allocate the +initial value of the objects named by the vars. +

    +

    It is permissible for an implementation to simply ignore this declaration. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/echo_002dstream.html b/info/gcl/echo_002dstream.html new file mode 100644 index 0000000..42d16e7 --- /dev/null +++ b/info/gcl/echo_002dstream.html @@ -0,0 +1,76 @@ + + + + + +echo-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.4 echo-stream [System Class]

    + +

    Class Precedence List::

    + +

    echo-stream, +stream, +t +

    +

    Description::

    + +

    An echo stream is a bidirectional stream +that gets its input from an associated input stream +and sends its output to an associated output stream. +

    +

    All input taken from the input stream +is echoed to the output stream. +Whether the input is echoed immediately after it is encountered, +or after it has been read from the input stream +is implementation-dependent. +

    +

    See Also::

    + +

    echo-stream-input-stream +, +echo-stream-output-stream, +make-echo-stream +

    + + + + + diff --git a/info/gcl/echo_002dstream_002dinput_002dstream.html b/info/gcl/echo_002dstream_002dinput_002dstream.html new file mode 100644 index 0000000..daefb1c --- /dev/null +++ b/info/gcl/echo_002dstream_002dinput_002dstream.html @@ -0,0 +1,71 @@ + + + + + +echo-stream-input-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.44 echo-stream-input-stream, echo-stream-output-stream [Function]

    + +

    echo-stream-input-stream echo-stream ⇒ input-stream +

    +

    echo-stream-output-stream echo-stream ⇒ output-stream +

    +

    Arguments and Values::

    + +

    echo-stream—an echo stream. +

    +

    input-stream—an input stream. +

    +

    output-stream—an output stream. +

    +

    Description::

    + +

    echo-stream-input-stream returns the input stream +from which echo-stream receives input. +

    +

    echo-stream-output-stream returns the output stream +to which echo-stream sends output. +

    + + + + + diff --git a/info/gcl/ed.html b/info/gcl/ed.html new file mode 100644 index 0000000..1067b69 --- /dev/null +++ b/info/gcl/ed.html @@ -0,0 +1,101 @@ + + + + + +ed (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.17 ed [Function]

    + +

    ed &optional x ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    x—nil, a pathname, a string, or a function name. +

    +

    The default is nil. +

    +

    Description::

    + +

    ed invokes the editor if the implementation provides a resident editor. +

    +

    If x is nil, the editor is entered. +If the editor had been previously entered, its prior state is resumed, if possible. +

    +

    If x is a pathname or string, +it is taken as the pathname designator for a file to be edited. +

    +

    If x is a function name, the text of its definition is edited. +The means by which the function text is obtained is implementation-defined. +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if the implementation does not provide a resident editor. +

    +

    Might signal type-error if its argument is supplied but is not +a symbol, a pathname, or nil. +

    +

    If a failure occurs when performing some operation on the file system +while attempting to edit a file, +an error of type file-error is signaled. +

    +

    An error of type file-error might be signaled if x +is a designator for a wild pathname. +

    +

    Implementation-dependent additional conditions might be signaled as well. +

    +

    See Also::

    + +

    pathname, +

    +

    logical-pathname, +

    +

    compile-file +, +load +, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/elt.html b/info/gcl/elt.html new file mode 100644 index 0000000..c58df66 --- /dev/null +++ b/info/gcl/elt.html @@ -0,0 +1,99 @@ + + + + + +elt (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.3 elt [Accessor]

    + +

    elt sequence index ⇒ object +

    +

    (setf ( elt sequence index) new-object)
    +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    index—a valid sequence index for sequence. +

    +

    object—an object. +

    +

    new-object—an object. +

    +

    Description::

    + +

    Accesses the element of sequence specified by index. +

    +

    Examples::

    + +
    +
     (setq str (copy-seq "0123456789")) ⇒  "0123456789"
+ (elt str 6) ⇒  #\6
+ (setf (elt str 0) #\#) ⇒  #\#
+ str ⇒  "#123456789"
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +Should signal an error of type type-error + if index is not a valid sequence index for sequence. +

    +

    See Also::

    + +

    aref +, +nth +, +

    +

    Compiler Terminology +

    +

    Notes::

    + +

    aref may be used to access vector +elements that are beyond the vector’s fill pointer. +

    + + + + + diff --git a/info/gcl/encode_002duniversal_002dtime.html b/info/gcl/encode_002duniversal_002dtime.html new file mode 100644 index 0000000..4552080 --- /dev/null +++ b/info/gcl/encode_002duniversal_002dtime.html @@ -0,0 +1,88 @@ + + + + + +encode-universal-time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.2 encode-universal-time [function]

    + +

    Syntax::

    + +

    encode-universal-time second minute hour date month year + &optional time-zone
    + ⇒ universal-time +

    +

    Arguments and Values::

    + +

    second, minute, hour, +date, month, year, +time-zone—the corresponding parts of a decoded time. + (Note that some of the nine values in a full decoded time are redundant, + and so are not used as inputs to this function.) +

    +

    universal-time—a universal time. +

    +

    Description::

    + +

    encode-universal-time converts a time from Decoded Time format +to a universal time. +

    +

    If time-zone is supplied, no adjustment for daylight savings time is performed. +

    +

    Examples::

    + +
    +
     (encode-universal-time 0 0 0 1 1 1900 0) ⇒  0
+ (encode-universal-time 0 0 1 4 7 1976 5) ⇒  2414296800
+;; The next example assumes Eastern Daylight Time.
+ (encode-universal-time 0 0 1 4 7 1976) ⇒  2414293200
+
    + +

    See Also::

    + +

    decode-universal-time +, get-decoded-time +

    + + + + + diff --git a/info/gcl/end_002dof_002dfile.html b/info/gcl/end_002dof_002dfile.html new file mode 100644 index 0000000..3146dc5 --- /dev/null +++ b/info/gcl/end_002dof_002dfile.html @@ -0,0 +1,74 @@ + + + + + +end-of-file (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.57 end-of-file [Condition Type]

    + +

    Class Precedence List::

    +

    end-of-file, +stream-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type end-of-file consists of +error conditions related to read operations that are done on +streams that have no more data. +

    +

    See Also::

    + +

    stream-error-stream +

    + + + + + + + + + + diff --git a/info/gcl/endp.html b/info/gcl/endp.html new file mode 100644 index 0000000..c718058 --- /dev/null +++ b/info/gcl/endp.html @@ -0,0 +1,97 @@ + + + + + +endp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.23 endp [Function]

    + +

    endp list ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    list—a list, +

    +

    which might be a dotted list or a circular list. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if list is the empty list. +Returns false if list is a cons. +

    +

    Examples::

    + +
    +
     (endp nil) ⇒  true
+ (endp '(1 2)) ⇒  false
+ (endp (cddr '(1 2))) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if list is not a list. +

    +

    Notes::

    + +

    The purpose of endp is to test for the end of proper list. +Since endp does not descend into a cons, +it is well-defined to pass it a dotted list. +However, if shorter “lists” are iteratively produced +by calling cdr on such a dotted list +and those “lists” are tested with endp, +a situation that has undefined consequences will eventually result +when the non-nil atom (which is not in fact a list) +finally becomes the argument to endp. +Since this is the usual way in which endp is used, +it is conservative programming style +and consistent with the intent of endp +to treat endp as simply a function on proper lists +which happens not to enforce an argument type of proper list except +when the argument is atomic. +

    + + + + + diff --git a/info/gcl/ensure_002ddirectories_002dexist.html b/info/gcl/ensure_002ddirectories_002dexist.html new file mode 100644 index 0000000..55b3936 --- /dev/null +++ b/info/gcl/ensure_002ddirectories_002dexist.html @@ -0,0 +1,102 @@ + + + + + +ensure-directories-exist (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.3 ensure-directories-exist [Function]

    + +

    ensure-directories-exist pathspec &key verbose ⇒ pathspec, created +

    +

    Arguments and Values::

    + +

    pathspec—a pathname designator. +

    +

    verbose—a generalized boolean. +

    +

    created—a generalized boolean. +

    +

    Description::

    + +

    Tests whether the directories containing the specified file actually exist, +and attempts to create them if they do not. +

    +

    If the containing directories do not exist and if verbose is true, +then the implementation is permitted (but not required) +to perform output to standard output saying what directories were created. +If the containing directories exist, or if verbose is false, +this function performs no output. +

    +

    The primary value is the given pathspec so that this operation can +be straightforwardly composed with other file manipulation expressions. +The secondary value, created, is true if any directories were +created. +

    +

    Affected By::

    + +

    The host computer’s file system. +

    +

    Exceptional Situations::

    + +

    An error of type file-error is signaled if the host, device, or directory +part of pathspec is wild. +

    +

    If the directory creation attempt is not successful, +an error of type file-error is signaled; +if this occurs, +it might be the case that none, some, or all +of the requested creations have actually occurred +within the file system. +

    +

    See Also::

    + +

    probe-file +, +open +, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/ensure_002dgeneric_002dfunction.html b/info/gcl/ensure_002dgeneric_002dfunction.html new file mode 100644 index 0000000..06e6c17 --- /dev/null +++ b/info/gcl/ensure_002dgeneric_002dfunction.html @@ -0,0 +1,158 @@ + + + + + +ensure-generic-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.2 ensure-generic-function [Function]

    + +

    ensure-generic-function function-name &key + argument-precedence-order declare + documentation environment + generic-function-class lambda-list + method-class method-combination
    + ⇒ generic-function +

    +

    Arguments and Values::

    + +

    function-name—a function name. +

    +

    The keyword arguments correspond to the option arguments of +defgeneric, except that the :method-class and +:generic-function-class arguments can be class objects +as well as names. +

    +

    Method-combination – method combination object. +

    +

    Environment – the same as the &environment argument +to macro expansion functions and is used to distinguish between compile-time +and run-time environments. +

    +

    [Editorial Note by KMP: What about documentation. Missing from this arguments enumeration, + and confusing in description below.] +

    +

    generic-function—a generic function object. +

    +

    Description::

    + +

    The function ensure-generic-function is used to define +a globally named generic function with no methods +or to specify or modify options and declarations that pertain to +a globally named generic function as a whole. +

    +

    If function-name is not fbound in the global environment, +a new +generic function is created. +If +

    +

    (fdefinition function-name) +

    +

    is an ordinary function, +a macro, +or a special operator, +an error is signaled. +

    +

    If function-name +is a list, it must be of the +form (setf symbol). +If function-name specifies a generic function that has a +different value for any of the following arguments, +the generic function is modified to have the new value: +:argument-precedence-order, :declare, :documentation, +:method-combination. +

    +

    If function-name specifies a generic function that has a +different value for the :lambda-list argument, and the new value +is congruent with the lambda lists of all existing +methods or there +are no methods, the value is changed; otherwise an error is signaled. +

    +

    If function-name specifies a generic function that has a +different value for the :generic-function-class argument and if +the new generic function class is compatible with the old, +change-class is called to change the class of the +generic function; +otherwise an error is signaled. +

    +

    If function-name specifies a generic function that has a +different value for the :method-class argument, the value is +changed, but any existing methods are not changed. +

    +

    Affected By::

    + +

    Existing function binding of function-name. +

    +

    Exceptional Situations::

    + +

    If +

    +

    (fdefinition function-name) +

    +

    is an ordinary function, a macro, or a special operator, +an error of type error is signaled. +

    +

    If function-name specifies a +generic function that has a +different value for the :lambda-list argument, and the new value +is not congruent with the lambda list of any existing +method, +an error of type error is signaled. +

    +

    If function-name specifies a +generic function that has a +different value for the :generic-function-class argument and if +the new generic function class not is compatible with the old, +an error of type error is signaled. +

    +

    See Also::

    + +

    defgeneric +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/eq.html b/info/gcl/eq.html new file mode 100644 index 0000000..560cba7 --- /dev/null +++ b/info/gcl/eq.html @@ -0,0 +1,150 @@ + + + + + +eq (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.33 eq [Function]

    + +

    eq x y ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    x—an object. +

    +

    y—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if its arguments are the same, identical object; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (eq 'a 'b) ⇒  false
+ (eq 'a 'a) ⇒  true
+ (eq 3 3)
+⇒  true
+OR⇒ false
+ (eq 3 3.0) ⇒  false
+ (eq 3.0 3.0)
+⇒  true
+OR⇒ false
+ (eq #c(3 -4) #c(3 -4))
+⇒  true
+OR⇒ false
+ (eq #c(3 -4.0) #c(3 -4)) ⇒  false
+ (eq (cons 'a 'b) (cons 'a 'c)) ⇒  false
+ (eq (cons 'a 'b) (cons 'a 'b)) ⇒  false
+ (eq '(a . b) '(a . b))
+⇒  true
+OR⇒ false
+ (progn (setq x (cons 'a 'b)) (eq x x)) ⇒  true
+ (progn (setq x '(a . b)) (eq x x)) ⇒  true
+ (eq #\A #\A)
+⇒  true
+OR⇒ false
+ (let ((x "Foo")) (eq x x)) ⇒  true
+ (eq "Foo" "Foo")
+⇒  true
+OR⇒ false
+ (eq "Foo" (copy-seq "Foo")) ⇒  false
+ (eq "FOO" "foo") ⇒  false
+ (eq "string-seq" (copy-seq "string-seq")) ⇒  false
+ (let ((x 5)) (eq x x))
+⇒  true
+OR⇒ false
+
    + +

    See Also::

    + +

    eql +, +equal +, +equalp +, += +, +Compilation +

    +

    Notes::

    +

    Objects that appear the same when printed are not necessarily +eq to each other. Symbols that print the same +usually are eq to each other because of the use of the +intern function. However, numbers with the +same value need not be eq, and two similar +lists are usually not identical. +

    +

    An implementation is permitted to make “copies” of +characters and numbers at any time. +The effect is that Common Lisp makes no guarantee that eq +is true even when both its arguments are “the same thing” if +that thing is a character or number. +

    +

    Most Common Lisp operators use eql rather than +eq to compare objects, or else they default to eql +and only use eq if specifically requested to do so. +However, the following operators are defined to use eq +rather than eql in a way that cannot be overridden by the +code which employs them: +

    +
    +
      catch           getf     throw  
+  get             remf            
+  get-properties  remprop  
+
+  Figure 5–11: Operators that always prefer EQ over EQL
+
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/eql-_0028Type-Specifier_0029.html b/info/gcl/eql-_0028Type-Specifier_0029.html new file mode 100644 index 0000000..57607e3 --- /dev/null +++ b/info/gcl/eql-_0028Type-Specifier_0029.html @@ -0,0 +1,72 @@ + + + + + +eql (Type Specifier) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.23 eql [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Combining. +

    +

    Compound Type Specifier Syntax::

    + +

    (eql{object}) +

    +

    Compound Type Specifier Arguments::

    + +

    object—an object. +

    +

    Compound Type Specifier Description::

    + +

    Represents the type whose only element is object. +

    +

    The argument object is required. The object can be *, +but if so it denotes itself (the symbol *) +and does not represent an unspecified value. +The symbol eql is not valid as an atomic type specifier. +

    + + + + + diff --git a/info/gcl/eql.html b/info/gcl/eql.html new file mode 100644 index 0000000..efa5e2b --- /dev/null +++ b/info/gcl/eql.html @@ -0,0 +1,167 @@ + + + + + +eql (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.34 eql [Function]

    + +

    eql x y ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    x—an object. +

    +

    y—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    The value of eql is true of two objects, x and +y, in the folowing cases: +

    +
    1.
    +

    If x and y are eq. +

    +
    2.
    +

    If x and y are both numbers +of the same type and the same value. +

    +
    3.
    +

    If they are both characters that represent the +same character. +

    +
    + +

    Otherwise the value of eql is false. +

    +

    If an implementation supports positive and negative zeros as distinct values, +then (eql 0.0 -0.0) returns false. +Otherwise, when the syntax -0.0 is read it is interpreted as the value 0.0, +and so (eql 0.0 -0.0) returns true. +

    +

    Examples::

    + +
    +
     (eql 'a 'b) ⇒  false
+ (eql 'a 'a) ⇒  true
+ (eql 3 3) ⇒  true
+ (eql 3 3.0) ⇒  false
+ (eql 3.0 3.0) ⇒  true
+ (eql #c(3 -4) #c(3 -4)) ⇒  true
+ (eql #c(3 -4.0) #c(3 -4)) ⇒  false
+ (eql (cons 'a 'b) (cons 'a 'c)) ⇒  false
+ (eql (cons 'a 'b) (cons 'a 'b)) ⇒  false
+ (eql '(a . b) '(a . b))
+⇒  true
+OR⇒ false
+ (progn (setq x (cons 'a 'b)) (eql x x)) ⇒  true
+ (progn (setq x '(a . b)) (eql x x)) ⇒  true
+ (eql #\A #\A) ⇒  true
+ (eql "Foo" "Foo")
+⇒  true
+OR⇒ false
+ (eql "Foo" (copy-seq "Foo")) ⇒  false
+ (eql "FOO" "foo") ⇒  false
+
    + +

    Normally (eql 1.0s0 1.0d0) is false, under the assumption +that 1.0s0 and 1.0d0 are of distinct data types. +However, implementations that do not provide four distinct floating-point +formats are permitted to “collapse” the four formats into some +smaller number of them; in such an implementation (eql 1.0s0 1.0d0) +might be true. +

    +

    See Also::

    + +

    eq +, +equal +, +equalp +, += +, +char= +

    +

    Notes::

    + +

    eql is the same as eq, except that if the +arguments are characters or numbers +of the same type then their +values are compared. Thus eql tells whether two objects +are conceptually the same, whereas eq tells whether two +objects are implementationally identical. It is for this reason +that eql, not eq, is the default comparison predicate +for operators that take sequences +as arguments. +

    +

    eql may not be true of two floats +even when they represent the same +value. = is used to compare +mathematical values. +

    +

    Two complex numbers are considered to be eql +if their real parts are eql +and their imaginary parts are eql. +For example, (eql #C(4 5) #C(4 5)) is true and +(eql #C(4 5) #C(4.0 5.0)) is false. +Note that while (eql #C(5.0 0.0) 5.0) is false, +(eql #C(5 0) 5) is true. +In the case of (eql #C(5.0 0.0) 5.0) the +two arguments are of different types, +and so cannot satisfy eql. +In the case of (eql #C(5 0) 5), +#C(5 0) is not a complex number, but +is automatically reduced +to the integer 5. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/equal.html b/info/gcl/equal.html new file mode 100644 index 0000000..203c8a0 --- /dev/null +++ b/info/gcl/equal.html @@ -0,0 +1,193 @@ + + + + + +equal (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.35 equal [Function]

    + +

    equal x y ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    x—an object. +

    +

    y—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if x and y are structurally similar +(isomorphic) objects. Objects are treated as follows by +equal. +

    +
    +
    Symbols, Numbers, and Characters
    +

    equal is true of two objects +if they are symbols that are eq, +if they are numbers that are eql, or +if they are characters that are eql. +

    +
    +
    Conses
    +

    For conses, equal is defined recursively as +the two cars being equal +and the two cdrs being equal. +

    +
    +
    Arrays
    +

    Two arrays are equal only if they are eq, +with one exception: +strings and bit vectors are compared element-by-element (using eql). +If either x or y has a fill pointer, the +fill pointer limits +the number of elements examined by equal. +Uppercase and lowercase letters in strings are considered by +equal to be different. +

    +
    +
    Pathnames
    +

    Two pathnames are equal if and only if +all the corresponding components +(host, device, and so on) are +equivalent. Whether or not +uppercase and lowercase letters are considered equivalent +in strings appearing in components is implementation-dependent. +pathnames +that are equal should be functionally equivalent. +

    +
    +
    Other (Structures, hash-tables, instances, ...)
    +

    Two other objects are equal only if they are eq. +

    +
    +
    + +

    equal does not descend any objects other than the +ones explicitly specified above. +Figure 5–12 summarizes the information given in the previous list. +In addition, the figure specifies the priority of the behavior of equal, +with upper + entries taking priority over lower ones. +

    +
    +
      Type          Behavior                   
+  number        uses eql                   
+  character     uses eql                   
+  cons          descends                   
+  bit vector    descends                   
+  string        descends                   
+  pathname      “functionally equivalent”  
+  structure     uses eq                    
+  Other array   uses eq                    
+  hash table    uses eq                    
+  Other object  uses eq                    
+
+  Figure 5–12: Summary and priorities of behavior of equal
+
+
    + +

    Any two objects that are eql are also equal. +

    +

    equal may fail to terminate if x or y is circular. +

    +

    Examples::

    + +
    +
     (equal 'a 'b) ⇒  false
+ (equal 'a 'a) ⇒  true
+ (equal 3 3) ⇒  true
+ (equal 3 3.0) ⇒  false
+ (equal 3.0 3.0) ⇒  true
+ (equal #c(3 -4) #c(3 -4)) ⇒  true
+ (equal #c(3 -4.0) #c(3 -4)) ⇒  false
+ (equal (cons 'a 'b) (cons 'a 'c)) ⇒  false
+ (equal (cons 'a 'b) (cons 'a 'b)) ⇒  true
+ (equal #\A #\A) ⇒  true
+ (equal #\A #\a) ⇒  false
+ (equal "Foo" "Foo") ⇒  true
+ (equal "Foo" (copy-seq "Foo")) ⇒  true
+ (equal "FOO" "foo") ⇒  false
+ (equal "This-string" "This-string") ⇒  true
+ (equal "This-string" "this-string") ⇒  false
+
    + +

    See Also::

    + +

    eq +, +eql +, +equalp +, += +, +string= +, string-equal, +char= +, +char-equal, +tree-equal +

    +

    Notes::

    + +

    Object equality is not a concept for which there is a uniquely + determined correct algorithm. The appropriateness of an equality + predicate can be judged only in the context of the needs of some + particular program. Although these functions take any type of + argument and their names sound very generic, +equal and equalp are + not appropriate for every application. +

    +

    A rough rule of thumb is that two objects are equal +if and only if their printed representations are the same. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/equalp.html b/info/gcl/equalp.html new file mode 100644 index 0000000..6c688c1 --- /dev/null +++ b/info/gcl/equalp.html @@ -0,0 +1,197 @@ + + + + + +equalp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.36 equalp [Function]

    + +

    equalp x y ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    x—an object. +

    +

    y—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if x and y are equal, +or if they have components that are of the same type as each other + and if those components are equalp; +specifically, equalp returns true in the following cases: +

    +
    Characters
    +

    If two characters are char-equal. +

    +
    +
    Numbers
    +

    If two numbers are the same under =. +

    +
    +
    Conses
    +

    If the two cars in the conses are equalp +and the two cdrs in the conses are equalp. +

    +
    +
    Arrays
    +

    If two arrays have the same +number of dimensions, the dimensions match, +and the corresponding +active elements +are equalp. +The types for which the arrays are specialized need not match; +for example, a string and a general array that happens to contain the same +characters are equalp. +Because equalp performs element-by-element comparisons +of strings and ignores the case of characters, +case distinctions are ignored when equalp compares strings. +

    +
    +
    Structures
    +

    If two structures S_1 and S_2 have the same class +and the value of each slot in S_1 is the same under equalp +as the value of the corresponding slot in S_2. +

    +
    +
    Hash Tables
    +

    equalp descends hash-tables by first comparing the count of entries + and the :test function; if those are the same, it compares the + keys of the tables using the :test function and then the values + of the matching keys using equalp recursively. +

    +
    +
    + +

    equalp does not descend any objects + other than the ones explicitly specified above. +Figure 5–13 summarizes the information given in the previous list. +In addition, the figure specifies the priority of the behavior of equalp, +with upper + entries taking priority over lower ones. +

    +
    +
      Type          Behavior                      
+  number        uses =                        
+  character     uses char-equal               
+  cons          descends                      
+  bit vector    descends                      
+  string        descends                      
+  pathname      same as equal                 
+  structure     descends, as described above  
+  Other array   descends                      
+  hash table    descends, as described above  
+  Other object  uses eq                       
+
+  Figure 5–13: Summary and priorities of behavior of equalp
+
+
    + +

    Examples::

    + +
    +
     (equalp 'a 'b) ⇒  false
+ (equalp 'a 'a) ⇒  true
+ (equalp 3 3) ⇒  true
+ (equalp 3 3.0) ⇒  true
+ (equalp 3.0 3.0) ⇒  true
+ (equalp #c(3 -4) #c(3 -4)) ⇒  true
+ (equalp #c(3 -4.0) #c(3 -4)) ⇒  true
+ (equalp (cons 'a 'b) (cons 'a 'c)) ⇒  false
+ (equalp (cons 'a 'b) (cons 'a 'b)) ⇒  true
+ (equalp #\A #\A) ⇒  true
+ (equalp #\A #\a) ⇒  true
+ (equalp "Foo" "Foo") ⇒  true
+ (equalp "Foo" (copy-seq "Foo")) ⇒  true
+ (equalp "FOO" "foo") ⇒  true
+
    + +
    +
     (setq array1 (make-array 6 :element-type 'integer
+                            :initial-contents '(1 1 1 3 5 7))) 
+⇒  #(1 1 1 3 5 7)
+ (setq array2 (make-array 8 :element-type 'integer
+                            :initial-contents '(1 1 1 3 5 7 2 6)
+                            :fill-pointer 6))
+⇒  #(1 1 1 3 5 7)
+ (equalp array1 array2) ⇒  true
+ (setq vector1 (vector 1 1 1 3 5 7)) ⇒  #(1 1 1 3 5 7)
+ (equalp array1 vector1) ⇒  true 
+
    + +

    See Also::

    + +

    eq +, +eql +, +equal +, += +, +string= +, string-equal, +char= +, +char-equal +

    +

    Notes::

    + +

    Object equality is not a concept for which there is a uniquely + determined correct algorithm. The appropriateness of an equality + predicate can be judged only in the context of the needs of some + particular program. Although these functions take any type of + argument and their names sound very generic, +equal and equalp are + not appropriate for every application. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/error-_0028Condition-Type_0029.html b/info/gcl/error-_0028Condition-Type_0029.html new file mode 100644 index 0000000..d342b63 --- /dev/null +++ b/info/gcl/error-_0028Condition-Type_0029.html @@ -0,0 +1,61 @@ + + + + + +error (Condition Type) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.5 error [Condition Type]

    + +

    Class Precedence List::

    +

    error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type error consists of all conditions that represent errors. +

    + + + + + diff --git a/info/gcl/error.html b/info/gcl/error.html new file mode 100644 index 0000000..2a681f5 --- /dev/null +++ b/info/gcl/error.html @@ -0,0 +1,171 @@ + + + + + +error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.11 error [Function]

    + +

    error datum &rest arguments + ⇒ #<NoValue> +

    +

    Arguments and Values::

    + +

    datum, arguments—designators for a condition + of default type simple-error. +

    +

    Description::

    + +

    error effectively invokes signal on the denoted condition. +

    +

    If the condition is not handled, (invoke-debugger condition) is done. +As a consequence of calling invoke-debugger, error +cannot directly return; the only exit from error +can come by non-local transfer of control in a handler or by use of +an interactive debugging command. +

    +

    Examples::

    + +
    +
     (defun factorial (x)
+   (cond ((or (not (typep x 'integer)) (minusp x))
+          (error "~S is not a valid argument to FACTORIAL." x))
+         ((zerop x) 1)
+         (t (* x (factorial (- x 1))))))
+⇒  FACTORIAL
+(factorial 20)
+⇒  2432902008176640000
+(factorial -1)
+ |>  Error: -1 is not a valid argument to FACTORIAL.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Return to Lisp Toplevel.
+ |>  Debug> 
+
    + +
    +
     (setq a 'fred)
+⇒  FRED
+ (if (numberp a) (1+ a) (error "~S is not a number." A))
+ |>  Error: FRED is not a number.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Return to Lisp Toplevel.
+ |>  Debug> |>>:Continue 1<<|
+ |>  Return to Lisp Toplevel.
+
+ (define-condition not-a-number (error) 
+                   ((argument :reader not-a-number-argument :initarg :argument))
+   (:report (lambda (condition stream)
+              (format stream "~S is not a number."
+                      (not-a-number-argument condition)))))
+⇒  NOT-A-NUMBER
+
+ (if (numberp a) (1+ a) (error 'not-a-number :argument a))
+ |>  Error: FRED is not a number.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Return to Lisp Toplevel.
+ |>  Debug> |>>:Continue 1<<|
+ |>  Return to Lisp Toplevel.
+
    + +

    Side Effects::

    + +

    Handlers for the specified condition, if any, are invoked +and might have side effects. +Program execution might stop, and the debugger might be entered. +

    +

    Affected By::

    + +

    Existing handler bindings. +

    +

    *break-on-signals* +

    +

    Signals an error of type type-error if datum and arguments are not designators for a condition. +

    +

    See Also::

    + +

    cerror +, +signal +, +format +, +ignore-errors +, *break-on-signals*, +handler-bind +, Condition System Concepts +

    +

    Notes::

    + +

    Some implementations may provide debugger +commands for interactively returning from individual stack frames. +However, it should be possible for the programmer to feel confident +about writing code like: +

    +
    +
     (defun wargames:no-win-scenario ()
+   (if (error "pushing the button would be stupid."))
+   (push-the-button))
+
    + +

    In this scenario, there should be no chance that +error will return +and the button will get pushed. +

    +

    While the meaning of this program is clear and it might be proven ‘safe’ +by a formal theorem prover, such a proof is no guarantee that the +program is safe to execute. Compilers have been known to have bugs, +computers to have signal glitches, and human beings to manually +intervene in ways that are not always possible to predict. Those kinds +of errors, while beyond the scope of the condition system to formally +model, are not beyond the scope of things that should seriously be +considered when writing code that could have the kinds of sweeping +effects hinted at by this example. +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/eval.html b/info/gcl/eval.html new file mode 100644 index 0000000..a226a19 --- /dev/null +++ b/info/gcl/eval.html @@ -0,0 +1,121 @@ + + + + + +eval (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.4 eval [Function]

    + +

    eval form ⇒ {result}* +

    +

    Arguments and Values::

    + +

    form—a form. +

    +

    results—the values yielded by the evaluation of form. +

    +

    Description::

    + +

    Evaluates form in the current dynamic environment +and the null lexical environment. +

    +

    eval is a user interface to the evaluator. +

    +

    The evaluator expands macro calls as if through the use of macroexpand-1. +

    +

    Constants appearing in code +processed by eval are +not copied nor coalesced. The code resulting from the execution of +eval +references objects +that are eql to the corresponding objects in +the source code. +

    +

    Examples::

    + +
    +
     (setq form '(1+ a) a 999) ⇒  999
+ (eval form) ⇒  1000
+ (eval 'form) ⇒  (1+ A)
+ (let ((a '(this would break if eval used local value))) (eval form))
+⇒  1000
+
    + +

    See Also::

    + +

    macroexpand-1, +The Evaluation Model +

    +

    Notes::

    + +

    To obtain the current dynamic value of a symbol, +use of symbol-value is equivalent (and usually preferable) +to use of eval. +

    +

    Note that an eval form involves two levels of evaluation +for its argument. First, form is evaluated by the +normal argument evaluation mechanism as would occur with any call. +The object that results from this normal argument evaluation +becomes the value of the form parameter, and is then +evaluated as part of the eval form. +For example: +

    +
    +
     (eval (list 'cdr (car '((quote (a . b)) c)))) ⇒  b
+
    + +

    The argument form (list 'cdr (car '((quote (a . b)) c))) is evaluated +in the usual way to produce the argument (cdr (quote (a . b))); +eval then evaluates its argument, (cdr (quote (a . b))), to produce b. +Since a single evaluation already occurs for any argument form +in any function form, +eval is sometimes said to perform “an extra level of evaluation.” +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/eval_002dwhen.html b/info/gcl/eval_002dwhen.html new file mode 100644 index 0000000..4aa83e0 --- /dev/null +++ b/info/gcl/eval_002dwhen.html @@ -0,0 +1,262 @@ + + + + + +eval-when (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.5 eval-when [Special Operator]

    + +

    eval-when ({situation}*) {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    situation—One of the symbols + :compile-toplevel +, + :load-toplevel +, + :execute +, + compile + +, + load + +, or + eval + +. +

    +

    The use of eval, compile, and load is deprecated. +

    +

    forms—an implicit progn. +

    +

    results—the values of the forms if they are executed, + or nil if they are not. +

    +

    Description::

    + +

    The body of an eval-when form is processed as an implicit progn, +but only in the situations listed. +

    +

    The use of the situations :compile-toplevel (or compile) and +:load-toplevel (or load) controls whether and when evaluation +occurs when eval-when appears as a top level form in +code processed by compile-file. See File Compilation. +

    +

    The use of the situation :execute (or eval) controls whether +evaluation occurs for other eval-when forms; that is, +those that are not top level forms, or those in code processed by +eval or compile. If the :execute situation is +specified in such a form, then the body forms are processed as +an implicit progn; otherwise, the eval-when form +returns nil. +

    +

    eval-when +normally appears as a top level form, but it is meaningful +for it to appear as a non-top-level form. +However, the compile-time side +effects described in Compilation +only take place when eval-when appears as a +top level form. +

    +

    Examples::

    + +

    One example of the use of eval-when is that for the +compiler to be able to read a file properly when it uses user-defined +reader macros, it is necessary to write +

    +
    +
     (eval-when (:compile-toplevel :load-toplevel :execute)
+   (set-macro-character #\$ #'(lambda (stream char)
+                                (declare (ignore char))
+                                (list 'dollar (read stream))))) ⇒  T
+
    + +

    This causes the call to set-macro-character to be executed +in the compiler’s execution environment, thereby modifying its +reader syntax table. +

    +
    +
    ;;;     The EVAL-WHEN in this case is not at toplevel, so only the :EXECUTE
+;;;     keyword is considered. At compile time, this has no effect.
+;;;     At load time (if the LET is at toplevel), or at execution time
+;;;     (if the LET is embedded in some other form which does not execute
+;;;     until later) this sets (SYMBOL-FUNCTION 'FOO1) to a function which
+;;;     returns 1.
+ (let ((x 1))
+   (eval-when (:execute :load-toplevel :compile-toplevel)
+     (setf (symbol-function 'foo1) #'(lambda () x))))
+
+;;;     If this expression occurs at the toplevel of a file to be compiled,
+;;;     it has BOTH a compile time AND a load-time effect of setting
+;;;     (SYMBOL-FUNCTION 'FOO2) to a function which returns 2.
+ (eval-when (:execute :load-toplevel :compile-toplevel)
+   (let ((x 2))
+     (eval-when (:execute :load-toplevel :compile-toplevel)
+       (setf (symbol-function 'foo2) #'(lambda () x)))))
+
+;;;     If this expression occurs at the toplevel of a file to be compiled,
+;;;     it has BOTH a compile time AND a load-time effect of setting the
+;;;     function cell of FOO3 to a function which returns 3.
+ (eval-when (:execute :load-toplevel :compile-toplevel)
+   (setf (symbol-function 'foo3) #'(lambda () 3)))
+
+;;; #4: This always does nothing. It simply returns NIL.
+ (eval-when (:compile-toplevel)
+   (eval-when (:compile-toplevel) 
+     (print 'foo4)))
+
+;;;     If this form occurs at toplevel of a file to be compiled, FOO5 is
+;;;     printed at compile time. If this form occurs in a non-top-level
+;;;     position, nothing is printed at compile time. Regardless of context,
+;;;     nothing is ever printed at load time or execution time.
+ (eval-when (:compile-toplevel) 
+   (eval-when (:execute)
+     (print 'foo5)))
+
+;;;     If this form occurs at toplevel of a file to be compiled, FOO6 is
+;;;     printed at compile time.  If this form occurs in a non-top-level
+;;;     position, nothing is printed at compile time. Regardless of context,
+;;;     nothing is ever printed at load time or execution time.
+ (eval-when (:execute :load-toplevel)
+   (eval-when (:compile-toplevel)
+     (print 'foo6)))
+
    + +

    See Also::

    + +

    compile-file +, Compilation +

    +

    Notes::

    + +

    The following effects are logical consequences of the definition of +eval-when: +

    +
    +
    *
    +

    Execution of a single eval-when +expression executes the body code at most once. +

    +
    +
    *
    +

    Macros intended for use in top level forms +should be written so that side-effects are done by the forms +in the macro expansion. The macro-expander itself should not do +the side-effects. +

    +

    For example: +

    +

    Wrong: +

    +
    +
     (defmacro foo ()
+   (really-foo)
+   `(really-foo))
+
    + +

    Right: +

    +
    +
     (defmacro foo ()
+   `(eval-when (:compile-toplevel :execute :load-toplevel) (really-foo)))
+
    + +

    Adherence to this convention means that such macros behave +intuitively when appearing as non-top-level forms. +

    +
    +
    *
    +

    Placing a variable binding around an eval-when reliably +captures the binding because the compile-time-too mode cannot occur + (i.e., introducing a variable binding means that the eval-when + is not a top level form). +For example, +

    +
    +
     (let ((x 3))
+   (eval-when (:execute :load-toplevel :compile-toplevel) (print x)))
+
    + +

    prints 3 +at execution (i.e., load) time, and does not print anything at +compile time. This is important so that expansions of +defun and +defmacro +can be done in terms of eval-when and can correctly capture +the lexical environment. +

    +
    +
     (defun bar (x) (defun foo () (+ x 3)))
+
    + +

    might expand into +

    +
    +
     (defun bar (x) 
+   (progn (eval-when (:compile-toplevel) 
+            (compiler::notice-function-definition 'foo '(x)))
+          (eval-when (:execute :load-toplevel)
+            (setf (symbol-function 'foo) #'(lambda () (+ x 3))))))
+
    + +

    which would be treated by the above rules the same as +

    +
    +
     (defun bar (x) 
+   (setf (symbol-function 'foo) #'(lambda () (+ x 3))))
+
    + +

    when the definition of bar is not a top level form. +

    +
    + +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/evenp.html b/info/gcl/evenp.html new file mode 100644 index 0000000..5f90f5b --- /dev/null +++ b/info/gcl/evenp.html @@ -0,0 +1,89 @@ + + + + + +evenp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.30 evenp, oddp [Function]

    + +

    evenp integer ⇒ generalized-boolean +

    +

    oddp integer ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    integer—an integer. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    evenp returns true if integer is even (divisible by two); +otherwise, returns false. +

    +

    oddp returns true if integer is odd (not divisible by two); +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (evenp 0) ⇒  true
+ (oddp 10000000000000000000000) ⇒  false
+ (oddp -1) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if integer is not an integer. +

    +

    Notes::

    + +
    +
     (evenp integer) ≡ (not (oddp integer))
+ (oddp integer)  ≡ (not (evenp integer))
+
    + + + + + + diff --git a/info/gcl/every.html b/info/gcl/every.html new file mode 100644 index 0000000..f343a0a --- /dev/null +++ b/info/gcl/every.html @@ -0,0 +1,149 @@ + + + + + +every (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.40 every, some, notevery, notany [Function]

    + +

    every predicate &rest sequences^+ ⇒ generalized-boolean +

    +

    some predicate &rest sequences^+ ⇒ result +

    +

    notevery predicate &rest sequences^+ ⇒ generalized-boolean +

    +

    notany predicate &rest sequences^+ ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    predicate—a designator for a function of + as many arguments as there are sequences. +

    +

    sequence—a sequence. +

    +

    result—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    every, some, notevery, and notany +test elements of sequences for satisfaction of a given predicate. +The first argument to predicate is an element of the first sequence; +each succeeding argument is an element of a succeeding sequence. +

    +

    Predicate is first applied to the elements +with index 0 in each of the sequences, and possibly then to +the elements with index 1, and so on, until a termination +criterion is met or the end of the shortest of the sequences is reached. +

    +

    every returns false as soon +as any invocation of predicate returns false. +If the end of a sequence is reached, +every returns true. +Thus, every returns true if and only if +every invocation of predicate returns true. +

    +

    some returns the first non-nil value +which is returned by an invocation of predicate. +If the end of a sequence is reached without any invocation of the +predicate returning true, some returns false. +Thus, some returns true if and only if +some invocation of predicate returns true. +

    +

    notany returns false +as soon as any invocation of predicate returns true. +If the end of a sequence is reached, +notany returns true. +Thus, notany returns true if and only if +it is not the case that any invocation of predicate returns true. +

    +

    notevery returns true as soon as any invocation of +predicate returns false. +If the end of a sequence is reached, +notevery returns false. +Thus, notevery returns true if and only if +it is not the case that every invocation of predicate returns true. +

    +

    Examples::

    + +
    +
     (every #'characterp "abc") ⇒  true
+ (some #'= '(1 2 3 4 5) '(5 4 3 2 1)) ⇒  true
+ (notevery #'< '(1 2 3 4) '(5 6 7 8) '(9 10 11 12)) ⇒  false
+ (notany #'> '(1 2 3 4) '(5 6 7 8) '(9 10 11 12)) ⇒  true 
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if its first argument is neither a +symbol nor a function or if any subsequent +argument is not a proper sequence. +

    +

    Other exceptional situations are possible, depending on the nature +of the predicate. +

    +

    See Also::

    + +

    and +, +or +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +
    +
     (notany predicate {sequence}*) ≡ (not (some predicate {sequence}*))
+ (notevery predicate {sequence}*) ≡ (not (every predicate {sequence}*))
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/exp.html b/info/gcl/exp.html new file mode 100644 index 0000000..1e22a01 --- /dev/null +++ b/info/gcl/exp.html @@ -0,0 +1,165 @@ + + + + + +exp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.31 exp, expt [Function]

    + +

    exp number ⇒ result +

    +

    expt base-number power-number ⇒ result +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    base-number—a number. +

    +

    power-number—a number. +

    +

    result—a number. +

    +

    Description::

    + +

    exp and expt perform exponentiation. +

    +

    exp returns e raised to the power number, +where e is the base of the natural logarithms. +exp has no branch cut. +

    +

    expt returns base-number +raised to the power power-number. +If the base-number is a rational +and power-number is +an integer, +the calculation is exact and the result will be of type rational; +otherwise a floating-point approximation might result. +

    +

    For expt of a complex rational to an integer power, +the calculation must be exact and the result is +of type (or rational (complex rational)). +

    +

    The result of expt can be a complex, +even when neither argument is a complex, +if base-number is negative and power-number +is not an integer. +The result is always the principal complex value. +For example, (expt -8 1/3) is not permitted to return -2, +even though -2 is one of the cube roots of -8. +The principal cube root is a complex +approximately equal to #C(1.0 1.73205), not -2. +

    +

    expt is defined +as b^x = e^x log b\/. +This defines the principal values precisely. The range of +expt is the entire complex plane. Regarded +as a function of x, with b fixed, there is no branch cut. +Regarded as a function of b, with x fixed, there is in general +a branch cut along the negative real axis, continuous with quadrant II. +The domain excludes the origin. +By definition, 0^0=1. If b=0 and the real part of x is strictly +positive, then +b^x=0. For all other values of x, 0^x +is an error. +

    +

    When power-number is an integer 0, +then the result is always the value one in the type +of base-number, +even if the base-number is zero (of any type). That is: +

    +
    +
     (expt x 0) ≡ (coerce 1 (type-of x))
+
    + +

    If power-number is a zero of any other type, +then the result is also the value one, in the type of the arguments +after the application of the contagion rules in Contagion in Numeric Operations, +with one exception: +the consequences are undefined if base-number is zero when power-number +is zero and not of type integer. +

    +

    Examples::

    + +
    +
     (exp 0) ⇒  1.0
+ (exp 1) ⇒  2.718282
+ (exp (log 5)) ⇒  5.0 
+ (expt 2 8) ⇒  256
+ (expt 4 .5) ⇒  2.0
+ (expt #c(0 1) 2) ⇒  -1
+ (expt #c(2 2) 3) ⇒  #C(-16 16)
+ (expt #c(2 2) 4) ⇒  -64 
+
    + +

    See Also::

    + +

    log +, +Rule of Float Substitutability +

    +

    Notes::

    + +

    Implementations of expt are permitted to use different algorithms +for the cases of a power-number of type rational + and a power-number of type float. +

    +

    Note that by the following logic, +(sqrt (expt x 3)) is not equivalent to +(expt x 3/2). +

    +
    +
     (setq x (exp (/ (* 2 pi #c(0 1)) 3)))         ;exp(2.pi.i/3)
+ (expt x 3) ⇒  1 ;except for round-off error
+ (sqrt (expt x 3)) ⇒  1 ;except for round-off error
+ (expt x 3/2) ⇒  -1 ;except for round-off error
+
    + +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/export.html b/info/gcl/export.html new file mode 100644 index 0000000..7122b44 --- /dev/null +++ b/info/gcl/export.html @@ -0,0 +1,158 @@ + + + + + +export (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.2 export [Function]

    + +

    export symbols &optional package ⇒ t +

    +

    Arguments and Values::

    + +

    symbols—a designator for a list of symbols. +

    +

    package—a package designator. +

    +

    The default is the current package. +

    +

    Description::

    + +

    export makes one or more symbols that are accessible +in package (whether directly or by inheritance) be external symbols +of that package. +

    +

    If any of the symbols is already accessible as +an external symbol of package, +export has no effect on that symbol. +If the symbol is +present in package +as an internal symbol, it is simply changed to external status. +If it is accessible as an internal symbol via use-package, +it +is first imported into package, +then exported. +(The symbol is then present in the package +whether or not package continues to use the package through +which the symbol was originally inherited.) +

    +

    export makes +each symbol +accessible to all the packages that use package. +All of these packages are checked for name conflicts: +(export s p) does +(find-symbol (symbol-name s) q) for each package q +in (package-used-by-list p). Note that in the usual case of +an export during the initial definition of a package, +the +result of package-used-by-list +is nil and the name-conflict checking +takes negligible time. +When multiple changes are to be made, +for example when export +is given a list of symbols, it is +permissible for the implementation to process each change separately, +so that aborting from a name +conflict caused by any but the first symbol in the +list does not unexport the +first symbol in the list. +However, aborting from a name-conflict error +caused by export +of one of symbols does not leave that symbol +accessible +to some packages +and inaccessible to others; with respect to +each of symbols processed, export +behaves as if it were as an atomic operation. +

    +

    A name conflict in export between one of +symbols being exported and a +symbol already present in a package +that would inherit the +newly-exported symbol +may be resolved in favor of the exported symbol +by uninterning the other one, or in favor of the already-present +symbol by making it a shadowing symbol. +

    +

    Examples::

    + +
    +
     (make-package 'temp :use nil) ⇒  #<PACKAGE "TEMP">
+ (use-package 'temp) ⇒  T
+ (intern "TEMP-SYM" 'temp) ⇒  TEMP::TEMP-SYM, NIL
+ (find-symbol "TEMP-SYM") ⇒  NIL, NIL
+ (export (find-symbol "TEMP-SYM" 'temp) 'temp) ⇒  T
+ (find-symbol "TEMP-SYM") ⇒  TEMP-SYM, :INHERITED
+
    + +

    Side Effects::

    + +

    The package system is modified. +

    +

    Affected By::

    + +

    Accessible symbols. +

    +

    Exceptional Situations::

    + +

    If any of the symbols is not accessible at all in package, +an error of type package-error is signaled that is correctable +by permitting the user +to interactively specify whether that symbol should be imported. +

    +

    See Also::

    + +

    import +, +unexport +, +Package Concepts +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/extended_002dchar.html b/info/gcl/extended_002dchar.html new file mode 100644 index 0000000..851b70d --- /dev/null +++ b/info/gcl/extended_002dchar.html @@ -0,0 +1,67 @@ + + + + + +extended-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.4 extended-char [Type]

    + +

    Supertypes::

    + +

    extended-char, +character, +t +

    +

    Description::

    + +

    The type extended-char is equivalent to the type (and character (not base-char)). +

    +

    Notes::

    + +

    The type extended-char might +have no elements_4 +in implementations in which all characters are of type base-char. +

    + + + + + diff --git a/info/gcl/fboundp.html b/info/gcl/fboundp.html new file mode 100644 index 0000000..247a577 --- /dev/null +++ b/info/gcl/fboundp.html @@ -0,0 +1,118 @@ + + + + + +fboundp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.4 fboundp [Function]

    + +

    fboundp name ⇒ generalized-boolean +

    +

    Pronunciation::

    + +

    pronounced ,ef ’baund p\=e +

    +

    Arguments and Values::

    + +

    name—a function name. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if name is fbound; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (fboundp 'car) ⇒  true
+ (fboundp 'nth-value) ⇒  false
+ (fboundp 'with-open-file) ⇒  true
+ (fboundp 'unwind-protect) ⇒  true
+ (defun my-function (x) x) ⇒  MY-FUNCTION
+ (fboundp 'my-function) ⇒  true
+ (let ((saved-definition (symbol-function 'my-function)))
+   (unwind-protect (progn (fmakunbound 'my-function)
+                          (fboundp 'my-function))
+     (setf (symbol-function 'my-function) saved-definition)))
+⇒  false
+ (fboundp 'my-function) ⇒  true
+ (defmacro my-macro (x) `',x) ⇒  MY-MACRO
+ (fboundp 'my-macro) ⇒  true
+ (fmakunbound 'my-function) ⇒  MY-FUNCTION
+ (fboundp 'my-function) ⇒  false
+ (flet ((my-function (x) x))
+   (fboundp 'my-function)) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if name is not a function name. +

    +

    See Also::

    + +

    symbol-function +, +fmakunbound +, +fdefinition +

    +

    Notes::

    + +

    It is permissible to call symbol-function on any symbol +that is fbound. +

    +

    fboundp is sometimes used to “guard” +an access to the function cell, as in: +

    +
    (if (fboundp x) (symbol-function x))
+
    + +

    Defining a setf expander F does not cause the setf function +(setf F) to become defined. +

    + + + + + diff --git a/info/gcl/fdefinition.html b/info/gcl/fdefinition.html new file mode 100644 index 0000000..ece6d85 --- /dev/null +++ b/info/gcl/fdefinition.html @@ -0,0 +1,117 @@ + + + + + +fdefinition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.3 fdefinition [Accessor]

    + +

    fdefinition function-name ⇒ definition +

    +

    (setf ( fdefinition function-name) new-definition)
    +

    +

    Arguments and Values::

    + +

    function-name—a function name. +

    +

    In the non-setf case, +the name must be fbound in the global environment. +

    +

    definition—Current global function definition named by function-name. +

    +

    new-definition—a function. +

    +

    Description::

    + +

    fdefinition accesses the current global function definition +named by function-name. The definition may be a +function or may be an object representing a +special form or macro. +

    +

    The value returned by fdefinition when fboundp returns true +but the function-name denotes a macro or +special form is not well-defined, but fdefinition does not signal an error. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if function-name is not a function name. +

    +

    An error of type undefined-function is signaled +in the non-setf case if function-name is not fbound. +

    +

    See Also::

    + +

    fboundp +, +fmakunbound +, +macro-function +, +

    +

    special-operator-p +, +

    +

    symbol-function +

    +

    Notes::

    + +

    fdefinition cannot access the value of a lexical function name +produced by flet or labels; it can access only +the global function value. +

    +

    setf can be used with +fdefinition to replace a global function +definition when the function-name’s function definition +does not represent a special form. +

    +

    setf of fdefinition +requires a function as the new value. +It is an error to set the fdefinition of a function-name +to a symbol, a list, or the value returned +by fdefinition on the name of a macro +or special form. +

    + + + + + diff --git a/info/gcl/file_002dauthor.html b/info/gcl/file_002dauthor.html new file mode 100644 index 0000000..4e91600 --- /dev/null +++ b/info/gcl/file_002dauthor.html @@ -0,0 +1,91 @@ + + + + + +file-author (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.5 file-author [Function]

    + +

    file-author pathspec ⇒ author +

    +

    Arguments and Values::

    + +

    pathspec—a pathname designator. +

    +

    author—a string or nil. +

    +

    Description::

    + +

    Returns a string naming the author of the file specified by pathspec, +or nil if the author’s name cannot be determined. +

    +

    Examples::

    + +
    +
     (with-open-file (stream ">relativity>general.text")
+   (file-author s))
+⇒  "albert"
+
    + +

    Affected By::

    +

    The host computer’s file system. +

    +

    Other users of the file named by pathspec. +

    Exceptional Situations::

    + +

    An error of type file-error is signaled if pathspec is wild. +

    +

    An error of type file-error is signaled +if the file system cannot perform the requested operation. +

    +

    See Also::

    + +

    pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/file_002derror.html b/info/gcl/file_002derror.html new file mode 100644 index 0000000..de0c3bc --- /dev/null +++ b/info/gcl/file_002derror.html @@ -0,0 +1,77 @@ + + + + + +file-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.9 file-error [Condition Type]

    + +

    Class Precedence List::

    +

    file-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type file-error consists of error conditions that occur during +an attempt to open or close a file, or during some low-level transactions +with a file system. The “offending pathname” is initialized by +the :pathname initialization argument to make-condition, and is accessed +by the function file-error-pathname. +

    +

    See Also::

    + +

    file-error-pathname, +open +, +probe-file +, +directory +, +ensure-directories-exist +

    + + + + + diff --git a/info/gcl/file_002derror_002dpathname.html b/info/gcl/file_002derror_002dpathname.html new file mode 100644 index 0000000..c2a8271 --- /dev/null +++ b/info/gcl/file_002derror_002dpathname.html @@ -0,0 +1,75 @@ + + + + + +file-error-pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.10 file-error-pathname [Function]

    + +

    file-error-pathname condition ⇒ pathspec +

    +

    Arguments and Values::

    + +

    condition—a condition of type file-error. +

    +

    pathspec—a pathname designator. +

    +

    Description::

    + +

    Returns the “offending pathname” of a condition of type file-error. +

    +

    Exceptional Situations::

    + +

    See Also::

    + +

    file-error, +Conditions +

    + + + + + + + + + + diff --git a/info/gcl/file_002dlength.html b/info/gcl/file_002dlength.html new file mode 100644 index 0000000..c714766 --- /dev/null +++ b/info/gcl/file_002dlength.html @@ -0,0 +1,89 @@ + + + + + +file-length (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.26 file-length [Function]

    + +

    file-length stream ⇒ length +

    +

    Arguments and Values::

    + +

    stream—a stream associated with a file. +

    +

    length—a non-negative integer or nil. +

    +

    Description::

    + +

    file-length returns the length of stream, +or nil if the length cannot be determined. +

    +

    For a binary file, the length is measured in units of +the element type of the stream. +

    +

    Examples::

    + +
    +
     (with-open-file (s "decimal-digits.text" 
+                    :direction :output :if-exists :error)
+   (princ "0123456789" s)
+   (truename s))
+⇒  #P"A:>Joe>decimal-digits.text.1"
+ (with-open-file (s "decimal-digits.text")
+   (file-length s))
+⇒  10
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if stream is not a stream associated with a file. +

    +

    See Also::

    + +

    open +

    + + + + + diff --git a/info/gcl/file_002dposition.html b/info/gcl/file_002dposition.html new file mode 100644 index 0000000..769779a --- /dev/null +++ b/info/gcl/file_002dposition.html @@ -0,0 +1,169 @@ + + + + + +file-position (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.27 file-position [Function]

    + +

    file-position stream ⇒ position +

    +

    file-position stream position-spec ⇒ success-p +

    +

    Arguments and Values::

    + +

    stream—a stream. +

    +

    position-spec—a file position designator. +

    +

    position—a file position or nil. +

    +

    success-p—a generalized boolean. +

    +

    Description::

    + +

    Returns or changes the current position within a stream. +

    +

    When position-spec is not supplied, +file-position returns the current file position in the stream, +or nil if this cannot be determined. +

    +

    When position-spec is supplied, +the file position in stream is set to that file position (if possible). +file-position returns true +if the repositioning is performed successfully, +or false if it is not. +

    +

    An integer returned by file-position of one argument +should be acceptable as position-spec for use with the same file. +

    +

    For a character file, +performing a single read-char or write-char operation +may cause the file position to be increased by more than 1 because of +character-set translations (such as translating between the Common Lisp +#\Newline character and an external ASCII +carriage-return/line-feed sequence) and other aspects of the +implementation. For a binary file, every read-byte +or write-byte +operation increases the file position by 1. +

    +

    Examples::

    + +
    +
     (defun tester ()
+   (let ((noticed '()) file-written)
+     (flet ((notice (x) (push x noticed) x))
+       (with-open-file (s "test.bin" 
+                          :element-type '(unsigned-byte 8)
+                          :direction :output
+                          :if-exists :error)
+          (notice (file-position s)) ;1
+          (write-byte 5 s) 
+          (write-byte 6 s)
+          (let ((p (file-position s)))
+            (notice p) ;2
+            (notice (when p (file-position s (1- p))))) ;3
+          (write-byte 7 s)
+          (notice (file-position s)) ;4
+          (setq file-written (truename s)))
+        (with-open-file (s file-written
+                           :element-type '(unsigned-byte 8)
+                           :direction :input)
+          (notice (file-position s)) ;5
+          (let ((length (file-length s)))
+            (notice length) ;6
+            (when length
+              (dotimes (i length)
+                (notice (read-byte s)))))) ;7,...
+        (nreverse noticed))))
+⇒  tester
+ (tester)
+⇒  (0 2 T 2 0 2 5 7)
+OR⇒ (0 2 NIL 3 0 3 5 6 7)
+OR⇒ (NIL NIL NIL NIL NIL NIL)
+
    + +

    Side Effects::

    + +

    When the position-spec argument is supplied, +the file position in the stream might be moved. +

    +

    Affected By::

    + +

    The value returned by file-position increases monotonically +as input or output operations are performed. +

    +

    Exceptional Situations::

    + +

    If position-spec is supplied, but is too large or otherwise inappropriate, +an error is signaled. +

    +

    See Also::

    + +

    file-length +, +file-string-length +, +open +

    +

    Notes::

    + +

    Implementations that have character files represented +as a sequence of records of bounded size might choose to encode the +file position as, for example, +<<record-number>>*<<max-record-size>>+<<character-within-record>>. +This is a valid encoding because it increases monotonically as +each character is read or written, though not necessarily by 1 at +each step. An integer might then be considered “inappropriate” +as position-spec to file-position if, when decoded into +record number and character number, it turned out that the +supplied record was too short for the specified character number. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/file_002dstream.html b/info/gcl/file_002dstream.html new file mode 100644 index 0000000..ed77b84 --- /dev/null +++ b/info/gcl/file_002dstream.html @@ -0,0 +1,72 @@ + + + + + +file-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.5 file-stream [System Class]

    + +

    Class Precedence List::

    + +

    file-stream, +stream, +t +

    +

    Description::

    + +

    An object of type file-stream is a stream the direct +source or sink of which is a file. Such a stream is +created explicitly by open and with-open-file, and +implicitly by functions such as load that process files. +

    +

    See Also::

    + +

    load +, +open +, +with-open-file +

    + + + + + diff --git a/info/gcl/file_002dstring_002dlength.html b/info/gcl/file_002dstring_002dlength.html new file mode 100644 index 0000000..eea9e75 --- /dev/null +++ b/info/gcl/file_002dstring_002dlength.html @@ -0,0 +1,72 @@ + + + + + +file-string-length (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.28 file-string-length [Function]

    + +

    file-string-length stream object ⇒ length +

    +

    Arguments and Values::

    + +

    stream—an output character file stream. +

    +

    object—a string or a character. +

    +

    length—a non-negative integer, or nil. +

    +

    Description::

    + +

    file-string-length returns the difference between what +(file-position stream) would be after writing +object and its current value, or nil if this cannot be determined. +

    +

    The returned value corresponds to the current state of stream +at the time of the call and might not be +the same if it is called again +when the state of the stream has changed. +

    + + + + + diff --git a/info/gcl/file_002dwrite_002ddate.html b/info/gcl/file_002dwrite_002ddate.html new file mode 100644 index 0000000..369c6c3 --- /dev/null +++ b/info/gcl/file_002dwrite_002ddate.html @@ -0,0 +1,97 @@ + + + + + +file-write-date (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.6 file-write-date [Function]

    + +

    file-write-date pathspec ⇒ date +

    +

    Arguments and Values::

    + +

    pathspec—a pathname designator. +

    +

    date—a universal time or nil. +

    +

    Description::

    + +

    Returns a universal time representing the time at which the file +specified by pathspec was last written (or created), +or returns nil if such a time cannot be determined. +

    +

    Examples::

    + +
    +
     (with-open-file (s "noel.text" 
+                    :direction :output :if-exists :error)
+   (format s "~&Dear Santa,~2
+                Please leave lots of toys.~2
+             ~2
+   (truename s))
+⇒  #P"CUPID:/susan/noel.text"
+ (with-open-file (s "noel.text")
+   (file-write-date s))
+⇒  2902600800
+
    + +

    Affected By::

    + +

    The host computer’s file system. +

    +

    Exceptional Situations::

    + +

    An error of type file-error is signaled if pathspec is wild. +

    +

    An error of type file-error is signaled +if the file system cannot perform the requested operation. +

    +

    See Also::

    + +

    Universal Time, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/fill.html b/info/gcl/fill.html new file mode 100644 index 0000000..e301509 --- /dev/null +++ b/info/gcl/fill.html @@ -0,0 +1,103 @@ + + + + + +fill (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.4 fill [Function]

    + +

    fill sequence item &key start end ⇒ sequence +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    item—a sequence. +

    +

    start, end—bounding index designators of sequence. + The defaults for start and end are 0 and nil, respectively. +

    +

    Description::

    + +

    Replaces the elements of sequence +bounded by start and end +with item. +

    +

    Examples::

    + +
    +
     (fill (list 0 1 2 3 4 5) '(444)) ⇒  ((444) (444) (444) (444) (444) (444))
+ (fill (copy-seq "01234") #\e :start 3) ⇒  "012ee"
+ (setq x (vector 'a 'b 'c 'd 'e)) ⇒  #(A B C D E)
+ (fill x 'z :start 1 :end 3) ⇒  #(A Z Z D E)
+ x ⇒  #(A Z Z D E)
+ (fill x 'p) ⇒  #(P P P P P)
+ x ⇒  #(P P P P P)
+
    + +

    Side Effects::

    + +

    Sequence is destructively modified. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +Should signal an error of type type-error + if start is not a non-negative integer. +Should signal an error of type type-error + if end is not a non-negative integer or nil. +

    +

    See Also::

    + +

    replace +, nsubstitute +

    +

    Notes::

    + +

    (fill sequence item) ≡ + (nsubstitute-if item (constantly t) sequence) +

    + + + + + diff --git a/info/gcl/fill_002dpointer.html b/info/gcl/fill_002dpointer.html new file mode 100644 index 0000000..d79313c --- /dev/null +++ b/info/gcl/fill_002dpointer.html @@ -0,0 +1,95 @@ + + + + + +fill-pointer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.21 fill-pointer [Accessor]

    + +

    fill-pointer vector ⇒ fill-pointer +

    +

    (setf ( fill-pointer vector) new-fill-pointer)
    +

    +

    Arguments and Values::

    + +

    vector—a vector with a fill pointer. +

    +

    fill-pointer, new-fill-pointer—a valid fill pointer + for the vector. +

    +

    Description::

    + +

    Accesses the fill pointer of vector. +

    +

    Examples::

    + +
    +
     (setq a (make-array 8 :fill-pointer 4)) ⇒  #(NIL NIL NIL NIL)
+ (fill-pointer a) ⇒  4
+ (dotimes (i (length a)) (setf (aref a i) (* i i))) ⇒  NIL
+ a ⇒  #(0 1 4 9)
+ (setf (fill-pointer a) 3) ⇒  3
+ (fill-pointer a) ⇒  3
+ a ⇒  #(0 1 4)
+ (setf (fill-pointer a) 8) ⇒  8
+ a ⇒  #(0 1 4 9 NIL NIL NIL NIL)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if vector is not a vector with a fill pointer. +

    +

    See Also::

    + +

    make-array +, +length +

    +

    Notes::

    + +

    There is no operator that will remove a vector’s fill pointer. +

    + + + + + diff --git a/info/gcl/find.html b/info/gcl/find.html new file mode 100644 index 0000000..d5c70ac --- /dev/null +++ b/info/gcl/find.html @@ -0,0 +1,137 @@ + + + + + +find (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.14 find, find-if, find-if-not [Function]

    + +

    find item sequence &key from-end test test-not start end key ⇒ element +

    +

    find-if predicate sequence &key from-end start end key ⇒ element +

    +

    find-if-not predicate sequence &key from-end start end key ⇒ element +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    sequence—a proper sequence. +

    +

    predicate—a designator for a function of one argument + that returns a generalized boolean. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start, end—bounding index designators of sequence. + The defaults for start and end are 0 and nil, respectively. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    element—an element of the sequence, or nil. +

    +

    Description::

    + +

    find, find-if, and find-if-not +each search for an element of the sequence +bounded by start and end + that satisfies the predicate predicate +or that satisfies the test test or test-not, +as appropriate. +

    +

    If from-end is true, +then the result is the rightmost element that satisfies the test. +

    +

    If the sequence contains an element that satisfies the test, +then the leftmost or rightmost sequence element, +depending on from-end, +is returned; +otherwise nil is returned. +

    +

    Examples::

    + +
    +
     (find #\d "here are some letters that can be looked at" :test #'char>)
+⇒  #\Space 
+ (find-if #'oddp '(1 2 3 4 5) :end 3 :from-end t) ⇒  3
+ (find-if-not #'complexp                                    
+             '#(3.5 2 #C(1.0 0.0) #C(0.0 1.0))
+             :start 2) ⇒  NIL 
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    position +, +Rules about Test Functions, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +

    The function find-if-not is deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/find_002dall_002dsymbols.html b/info/gcl/find_002dall_002dsymbols.html new file mode 100644 index 0000000..03c763b --- /dev/null +++ b/info/gcl/find_002dall_002dsymbols.html @@ -0,0 +1,88 @@ + + + + + +find-all-symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.5 find-all-symbols [Function]

    + +

    find-all-symbols string ⇒ symbols +

    +

    Arguments and Values::

    + +

    string—a string designator. +

    +

    symbols—a list of symbols. +

    +

    Description::

    + +

    find-all-symbols searches + every registered package + for symbols that have a +name that is the same (under string=) as +string. A list of all such symbols is returned. +Whether or how the list is ordered is +implementation-dependent. +

    +

    Examples::

    + +
    +
     (find-all-symbols 'car)
+⇒  (CAR)
+OR⇒ (CAR VEHICLES:CAR)
+OR⇒ (VEHICLES:CAR CAR)
+ (intern "CAR" (make-package 'temp :use nil)) ⇒  TEMP::CAR, NIL
+ (find-all-symbols 'car)
+⇒  (TEMP::CAR CAR)
+OR⇒ (CAR TEMP::CAR)
+OR⇒ (TEMP::CAR CAR VEHICLES:CAR)
+OR⇒ (CAR TEMP::CAR VEHICLES:CAR)
+
    + +

    See Also::

    + +

    find-symbol +

    + + + + + diff --git a/info/gcl/find_002dclass.html b/info/gcl/find_002dclass.html new file mode 100644 index 0000000..0800e50 --- /dev/null +++ b/info/gcl/find_002dclass.html @@ -0,0 +1,120 @@ + + + + + +find-class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.28 find-class [Accessor]

    + +

    find-class symbol &optional errorp environment ⇒ class +

    +

    (setf ( find-class symbol &optional errorp environment) new-class)
    +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    errorp—a generalized boolean. + The default is true. +

    +

    environment – same as the &environment argument to + macro expansion functions and is used to distinguish between + compile-time and run-time environments. +

    +

    The &environment argument has + dynamic extent; the consequences are undefined if + the &environment argument is + referred to outside the dynamic extent + of the macro expansion function. +

    +

    class—a class object, or nil. +

    +

    Description::

    + +

    Returns the class object named by the symbol +in the environment. If there is no such class, +nil is returned if errorp is false; otherwise, +if errorp is true, an error is signaled. +

    +

    The class associated with a particular symbol can be changed by using +setf with find-class; +

    +

    or, if the new class given to setf is nil, +the class association is removed +(but the class object itself is not affected). +

    +

    The results are undefined if the user attempts to change +

    +

    or remove +

    +

    the class associated with a +symbol that is defined as a type specifier in this standard. +See Integrating Types and Classes. +

    +

    When using setf of find-class, any errorp argument is evaluated +for effect, but any values it returns are ignored; the errorp +parameter is permitted primarily so that the environment parameter +can be used. +

    +

    The environment might be used to distinguish between a compile-time and a +run-time environment. +

    +

    Exceptional Situations::

    + +

    If there is no such class and errorp is true, +find-class signals an error of type error. +

    +

    See Also::

    + +

    defmacro +, +Integrating Types and Classes +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/find_002dmethod.html b/info/gcl/find_002dmethod.html new file mode 100644 index 0000000..cca1672 --- /dev/null +++ b/info/gcl/find_002dmethod.html @@ -0,0 +1,137 @@ + + + + + +find-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.34 find-method [Standard Generic Function]

    + +

    Syntax::

    + +

    find-method generic-function method-qualifiers specializers &optional errorp
    + ⇒ method +

    +

    Method Signatures::

    + +

    find-method (generic-function standard-generic-function) + method-qualifiers specializers &optional errorp +

    +

    Arguments and Values::

    + +

    generic-function—a generic function. +

    +

    method-qualifiers—a list. +

    +

    specializers—a list. +

    +

    errorp—a generalized boolean. + The default is true. +

    +

    method—a method object, or nil. +

    +

    Description::

    + +

    The generic function find-method takes a generic function +and returns the method object that agrees on qualifiers +and parameter specializers with the method-qualifiers and +specializers arguments of find-method. +Method-qualifiers contains the +method qualifiers for the method. +The order of the method qualifiers +is significant. +For a definition of agreement in this context, +see Agreement on Parameter Specializers and Qualifiers. +

    +

    The specializers argument contains the parameter +specializers for the method. It must correspond in length to +the number of required arguments of the generic function, or +an error is signaled. This means that to obtain the +default method on a given generic-function, +a list whose elements are the class t must be given. +

    +

    If there is no such method and errorp is true, +find-method signals an error. +If there is no such method and errorp is false, +find-method returns nil. +

    +

    Examples::

    + +
    +
     (defmethod some-operation ((a integer) (b float)) (list a b))
+⇒  #<STANDARD-METHOD SOME-OPERATION (INTEGER FLOAT) 26723357>
+ (find-method #'some-operation '() (mapcar #'find-class '(integer float)))
+⇒  #<STANDARD-METHOD SOME-OPERATION (INTEGER FLOAT) 26723357>
+ (find-method #'some-operation '() (mapcar #'find-class '(integer integer)))
+ |>  Error: No matching method
+ (find-method #'some-operation '() (mapcar #'find-class '(integer integer)) nil)
+⇒  NIL
+
    + +

    Affected By::

    + +

    add-method, +defclass, +defgeneric, +defmethod +

    +

    Exceptional Situations::

    + +

    If the specializers argument does not correspond in length to +the number of required arguments of the generic-function, an +an error of type error is signaled. +

    +

    If there is no such method and errorp is true, +find-method signals an error of type error. +

    +

    See Also::

    + +

    Agreement on Parameter Specializers and Qualifiers +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/find_002dpackage.html b/info/gcl/find_002dpackage.html new file mode 100644 index 0000000..20f1d03 --- /dev/null +++ b/info/gcl/find_002dpackage.html @@ -0,0 +1,93 @@ + + + + + +find-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.4 find-package [Function]

    + +

    find-package name ⇒ package +

    +

    Arguments and Values::

    + +

    name—a string designator or a package object. +

    +

    package—a package object or nil. +

    +

    Description::

    + +

    If name is a string designator, +find-package locates and returns the +package whose name or nickname is name. +This +search is case sensitive. +If there is no such package, +find-package returns nil. +

    +

    If name is a package object, +that package object is returned. +

    +

    Examples::

    + +
    +
     (find-package 'common-lisp) ⇒  #<PACKAGE "COMMON-LISP">
+ (find-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (find-package 'not-there) ⇒  NIL
+
    + +

    Affected By::

    + +

    The set of packages created by the implementation. +

    +

    defpackage, +delete-package, +make-package, +rename-package +

    +

    See Also::

    + +

    make-package +

    + + + + + diff --git a/info/gcl/find_002drestart.html b/info/gcl/find_002drestart.html new file mode 100644 index 0000000..d11a615 --- /dev/null +++ b/info/gcl/find_002drestart.html @@ -0,0 +1,117 @@ + + + + + +find-restart (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.33 find-restart [Function]

    + +

    find-restart identifier &optional condition + restart +

    +

    Arguments and Values::

    + +

    identifier—a non-nil symbol, or a restart. +

    +

    condition—a condition object, or nil. +

    +

    restart—a restart or nil. +

    +

    Description::

    + +

    find-restart searches for a particular restart in the +current dynamic environment. +

    +

    When condition is non-nil, only those restarts +are considered that are either explicitly associated with that condition, +or not associated with any condition; that is, the excluded restarts +are those that are associated with a non-empty set of conditions of +which the given condition is not an element. +If condition is nil, all restarts are considered. +

    +

    If identifier is a symbol, then the innermost +(most recently established) applicable restart with that name is returned. +nil is returned if no such restart is found. +

    +

    If identifier is a currently active restart, then it is returned. +Otherwise, nil is returned. +

    +

    Examples::

    + +
    +
     (restart-case
+     (let ((r (find-restart 'my-restart)))
+       (format t "~S is named ~S" r (restart-name r)))
+   (my-restart () nil))
+ |>  #<RESTART 32307325> is named MY-RESTART
+⇒  NIL
+ (find-restart 'my-restart)
+⇒  NIL
+
    + +

    Affected By::

    + +

    Existing restarts. +

    +

    restart-case, restart-bind, with-condition-restarts. +

    +

    See Also::

    + +

    compute-restarts +

    +

    Notes::

    + +
    +
     (find-restart identifier)
+ ≡ (find identifier (compute-restarts) :key :restart-name)
+
    + +

    Although anonymous restarts have a name of nil, +the consequences are unspecified if nil is given as an identifier. +Occasionally, programmers lament that nil is not permissible as an +identifier argument. In most such cases, compute-restarts +can probably be used to simulate the desired effect. +

    + + + + + diff --git a/info/gcl/find_002dsymbol.html b/info/gcl/find_002dsymbol.html new file mode 100644 index 0000000..f4d0092 --- /dev/null +++ b/info/gcl/find_002dsymbol.html @@ -0,0 +1,147 @@ + + + + + +find-symbol (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.3 find-symbol [Function]

    + +

    find-symbol string &optional package ⇒ symbol, status +

    +

    Arguments and Values::

    + +

    string—a string. +

    +

    package—a package designator. +

    +

    The default is the current package. +

    +

    symbol—a symbol accessible in the package, + or nil. +

    +

    status—one of :inherited, :external, :internal, or nil. +

    +

    Description::

    + +

    find-symbol locates a symbol whose name is +string in a package. +If a symbol named string is found in package, +directly or by inheritance, the symbol +found is returned as the first +value; the second value is as follows: +

    +
    +
    :internal
    +

    If the symbol is present in package +as an internal symbol. +

    +
    +
    :external
    +

    If the symbol is present in package +as an external symbol. +

    +
    +
    :inherited
    +

    If the symbol is inherited by package +through use-package, +but is not present in package. +

    +
    +
    + +

    If no such symbol is accessible in package, +both values are nil. +

    +

    Examples::

    + +
    +
     (find-symbol "NEVER-BEFORE-USED") ⇒  NIL, NIL
+ (find-symbol "NEVER-BEFORE-USED") ⇒  NIL, NIL
+ (intern "NEVER-BEFORE-USED") ⇒  NEVER-BEFORE-USED, NIL
+ (intern "NEVER-BEFORE-USED") ⇒  NEVER-BEFORE-USED, :INTERNAL
+ (find-symbol "NEVER-BEFORE-USED") ⇒  NEVER-BEFORE-USED, :INTERNAL
+ (find-symbol "never-before-used") ⇒  NIL, NIL
+ (find-symbol "CAR" 'common-lisp-user) ⇒  CAR, :INHERITED
+ (find-symbol "CAR" 'common-lisp) ⇒  CAR, :EXTERNAL
+ (find-symbol "NIL" 'common-lisp-user) ⇒  NIL, :INHERITED
+ (find-symbol "NIL" 'common-lisp) ⇒  NIL, :EXTERNAL
+ (find-symbol "NIL" (prog1 (make-package "JUST-TESTING" :use '())
+                           (intern "NIL" "JUST-TESTING")))
+⇒  JUST-TESTING::NIL, :INTERNAL
+ (export 'just-testing::nil 'just-testing)
+ (find-symbol "NIL" 'just-testing) ⇒  JUST-TESTING:NIL, :EXTERNAL
+ (find-symbol "NIL" "KEYWORD")
+⇒  NIL, NIL
+OR⇒ :NIL, :EXTERNAL
+ (find-symbol (symbol-name :nil) "KEYWORD") ⇒  :NIL, :EXTERNAL
+
    + +

    Affected By::

    + +

    intern, +import, +export, +use-package, +unintern, +unexport, +unuse-package +

    +

    See Also::

    + +

    intern +, +find-all-symbols +

    +

    Notes::

    + +

    find-symbol is operationally equivalent to intern, +except that it never creates a new symbol. +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/finish_002doutput.html b/info/gcl/finish_002doutput.html new file mode 100644 index 0000000..00c60b7 --- /dev/null +++ b/info/gcl/finish_002doutput.html @@ -0,0 +1,108 @@ + + + + + +finish-output (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.36 finish-output, force-output, clear-output [Function]

    + +

    finish-output &optional output-stream ⇒ nil +

    +

    force-output &optional output-stream ⇒ nil +

    +

    clear-output &optional output-stream ⇒ nil +

    +

    Arguments and Values::

    + +

    output-stream—an output stream designator. + The default is standard output. +

    +

    Description::

    + +

    finish-output, force-output, and clear-output +exercise control over the internal handling of buffered stream output. +

    +

    finish-output attempts to ensure that any buffered output +sent to output-stream has reached its destination, and then returns. +

    +

    force-output initiates the emptying of any +internal buffers but does not wait for completion +or acknowledgment to return. +

    +

    clear-output attempts to abort any +outstanding output operation in progress in order +to allow as little output as possible +to continue to the destination. +

    +

    If any of these operations does not make sense for output-stream, +then it does nothing. +The precise actions of these functions are implementation-dependent. +

    +

    Examples::

    +
    +
    ;; Implementation A
+ (progn (princ "am i seen?") (clear-output))
+⇒  NIL
+
+;; Implementation B
+ (progn (princ "am i seen?") (clear-output))
+ |>  am i seen?
+⇒  NIL
+
    + +

    Affected By::

    + +

    *standard-output* +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if output-stream is not a stream designator. +

    +

    See Also::

    + +

    clear-input +

    + + + + + diff --git a/info/gcl/first.html b/info/gcl/first.html new file mode 100644 index 0000000..f085048 --- /dev/null +++ b/info/gcl/first.html @@ -0,0 +1,168 @@ + + + + + +first (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.21 first, second, third, fourth, fifth,

    +

    sixth, seventh, eighth, ninth, tenth

    +

    [Accessor] +

    +

    first list ⇒ object +(setf (first list) new-object)
    +

    +

    second list ⇒ object +(setf (second list) new-object)
    +

    +

    third list ⇒ object +(setf (third list) new-object)
    +

    +

    fourth list ⇒ object +(setf (fourth list) new-object)
    +

    +

    fifth list ⇒ object +(setf (fifth list) new-object)
    +

    +

    sixth list ⇒ object +(setf (sixth list) new-object)
    +

    +

    seventh list ⇒ object +(setf (seventh list) new-object)
    +

    +

    eighth list ⇒ object +(setf (eighth list) new-object)
    +

    +

    ninth list ⇒ object +(setf (ninth list) new-object)
    +

    +

    tenth list ⇒ object +(setf (tenth list) new-object)
    +

    +

    Arguments and Values::

    + +

    list—a list, +

    +

    which might be a dotted list or a circular list. +

    +

    object, new-object—an object. +

    +

    Description::

    + +

    The functions +first, +second, +third, +fourth, +fifth, +sixth, +seventh, +eighth, +ninth, +and +tenth +access the first, second, third, fourth, fifth, sixth, seventh, eighth, +ninth, and tenth elements of list, respectively. +Specifically, +

    +
    +
     (first list)    ≡  (car list)
+ (second list)   ≡  (car (cdr list))
+ (third list)    ≡  (car (cddr list))
+ (fourth list)   ≡  (car (cdddr list))
+ (fifth list)    ≡  (car (cddddr list))
+ (sixth list)    ≡  (car (cdr (cddddr list)))
+ (seventh list)  ≡  (car (cddr (cddddr list)))
+ (eighth list)   ≡  (car (cdddr (cddddr list)))
+ (ninth list)    ≡  (car (cddddr (cddddr list)))
+ (tenth list)    ≡  (car (cdr (cddddr (cddddr list))))
+
    + +

    setf can also be used with any of these functions to change an +existing component. The same equivalences apply. For example: +

    +
    +
     (setf (fifth list) new-object) ≡ (setf (car (cddddr list)) new-object)
+
    + +

    Examples::

    + +
    +
     (setq lst '(1 2 3 (4 5 6) ((V)) vi 7 8 9 10)) 
+⇒  (1 2 3 (4 5 6) ((V)) VI 7 8 9 10)
+ (first lst) ⇒  1
+ (tenth lst) ⇒  10
+ (fifth lst) ⇒  ((V))
+ (second (fourth lst)) ⇒  5
+ (sixth '(1 2 3)) ⇒  NIL
+ (setf (fourth lst) "four") ⇒  "four"
+ lst ⇒  (1 2 3 "four" ((V)) VI 7 8 9 10)
+
    + +

    See Also::

    + +

    car +, +nth +

    +

    Notes::

    + +

    first is functionally equivalent to car, +second is functionally equivalent to cadr, +third is functionally equivalent to caddr, and +fourth is functionally equivalent to cadddr. +

    +

    The ordinal numbering used here is one-origin, +as opposed to the zero-origin numbering used by nth: +

    +
    +
     (fifth x) ≡ (nth 4 x)
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/fixnum.html b/info/gcl/fixnum.html new file mode 100644 index 0000000..2e26ed9 --- /dev/null +++ b/info/gcl/fixnum.html @@ -0,0 +1,72 @@ + + + + + +fixnum (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.13 fixnum [Type]

    + +

    Supertypes::

    + +

    fixnum, +integer, +rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    A fixnum is an integer whose value is between +most-negative-fixnum and most-positive-fixnum inclusive. +Exactly which integers are fixnums is +implementation-defined. +

    +

    The type fixnum is required to be a supertype of +(signed-byte 16). +

    + + + + + diff --git a/info/gcl/flet.html b/info/gcl/flet.html new file mode 100644 index 0000000..116265f --- /dev/null +++ b/info/gcl/flet.html @@ -0,0 +1,317 @@ + + + + + +flet (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.6 flet, labels, macrolet [Special Operator]

    + +

    flet ({(function-name + lambda-list + [[{local-declaration}* + | local-documentation]] + {local-form}*)}*) + {declaration}* {form}*
    + ⇒ {result}* +

    +

    labels ({(function-name + lambda-list + [[{local-declaration}* + | local-documentation]] + {local-form}*)}*) + {declaration}* {form}*
    + ⇒ {result}* +

    +

    macrolet ({(name + lambda-list + [[{local-declaration}* + | local-documentation]] + {local-form}*)}*) + {declaration}* {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    function-name—a function name. +

    +

    name—a symbol. +

    +

    lambda-list—a lambda list; + for flet and labels, + it is an ordinary lambda list; + for macrolet, + it is a macro lambda list. +

    +

    local-declaration—a declare expression; not evaluated. +

    +

    declaration—a declare expression; not evaluated. +

    +

    local-documentation—a string; not evaluated. +

    +

    local-forms, forms—an implicit progn. +

    +

    results—the values of the forms. +

    +

    Description::

    + +

    flet, labels, and macrolet +define local functions and macros, and execute +forms using the local definitions. +Forms are executed in order of occurrence. +

    +

    The body forms (but not the lambda list) +

    +

    of each function created by flet and labels +and each macro created by macrolet +are enclosed in an implicit block whose name +is the function block name of the function-name or name, +as appropriate. +

    +

    The scope of the declarations +between +the list of local function/macro definitions and the body forms +in flet and labels +does not include the bodies of the +locally defined functions, except that for labels, +any inline, notinline, or ftype declarations +that refer to the locally defined functions do apply to the local function +bodies. That is, their scope +is the same as the function name that they +affect. +

    +

    The scope of these declarations +does not include the bodies of the macro expander +functions defined by macrolet. +

    +
    +
    flet
    +

    flet defines locally named functions and executes a series of +forms with these definition bindings. Any number of +such local functions can be defined. +

    +

    The scope of the name binding encompasses only the body. +Within the +body of flet, +function-names matching those defined +by flet +refer to the locally defined functions +rather than to +the global function definitions of the same name. +

    +

    Also, within the scope of flet, +global setf expander definitions of the function-name +defined by flet do not apply. +Note that this applies to +(defsetf f ...), not +(defmethod (setf f) ...). +

    +

    The names of functions defined by flet +are in the lexical environment; they retain +their local definitions only within the body of flet. +The function definition bindings are visible only in +the body of flet, not the definitions themselves. Within the +function definitions, local function names +that match those being +defined refer to functions or +macros defined outside the flet. +flet can locally shadow a global function name, +and the new definition can refer to the global definition. +

    +

    Any local-documentation is attached to the corresponding local function +(if one is actually created) as a documentation string. +

    +
    +
    labels
    +

    labels is equivalent to flet except that +the scope of the defined function names for labels +encompasses the function definitions themselves as well as the body. +

    +
    +
    macrolet
    +

    macrolet +establishes local macro definitions, +using the same format used by defmacro. +

    +

    Within the body of macrolet, +global setf expander definitions of the names defined by the +macrolet do not apply; rather, setf expands the +macro form and recursively process the resulting form. +

    +

    The macro-expansion functions defined by macrolet +are defined in the +

    +

    lexical environment in which the macrolet form appears. +Declarations and macrolet and +symbol-macrolet definitions +affect the local macro definitions in a macrolet, but the +consequences are undefined if the local macro definitions reference +any local variable or function bindings that are visible in that +lexical environment. +

    +

    Any local-documentation is attached to the corresponding local macro function +as a documentation string. +

    +
    +
    + +

    Examples::

    + +
    +
     (defun foo (x flag)
+   (macrolet ((fudge (z)
+                 ;The parameters x and flag are not accessible
+                 ; at this point; a reference to flag would be to
+                 ; the global variable of that name.
+                 ` (if flag (* ,z ,z) ,z)))
+    ;The parameters x and flag are accessible here.
+     (+ x
+        (fudge x)
+        (fudge (+ x 1)))))
+ ≡
+ (defun foo (x flag)
+   (+ x
+      (if flag (* x x) x)
+      (if flag (* (+ x 1) (+ x 1)) (+ x 1))))
+
    + +

    after macro expansion. The occurrences of x and flag legitimately +refer to the parameters of the function foo because those parameters are +visible at the site of the macro call which produced the expansion. +

    +
    +
     (flet ((flet1 (n) (+ n n)))
+    (flet ((flet1 (n) (+ 2 (flet1 n))))
+      (flet1 2))) ⇒  6
+
+ (defun dummy-function () 'top-level) ⇒  DUMMY-FUNCTION 
+ (funcall #'dummy-function) ⇒  TOP-LEVEL 
+ (flet ((dummy-function () 'shadow)) 
+      (funcall #'dummy-function)) ⇒  SHADOW 
+ (eq (funcall #'dummy-function) (funcall 'dummy-function))
+⇒  true 
+ (flet ((dummy-function () 'shadow))
+   (eq (funcall #'dummy-function)
+       (funcall 'dummy-function)))
+⇒  false 
+
+ (defun recursive-times (k n)
+   (labels ((temp (n) 
+              (if (zerop n) 0 (+ k (temp (1- n))))))
+     (temp n))) ⇒  RECURSIVE-TIMES
+ (recursive-times 2 3) ⇒  6
+
+ (defmacro mlets (x &environment env) 
+    (let ((form `(babbit ,x)))
+      (macroexpand form env))) ⇒  MLETS
+ (macrolet ((babbit (z) `(+ ,z ,z))) (mlets 5)) ⇒  10
+
    + +
    +
     (flet ((safesqrt (x) (sqrt (abs x))))
+  ;; The safesqrt function is used in two places.
+   (safesqrt (apply #'+ (map 'list #'safesqrt '(1 2 3 4 5 6)))))
+⇒  3.291173
+
    + +
    +
     (defun integer-power (n k)     
+   (declare (integer n))         
+   (declare (type (integer 0 *) k))
+   (labels ((expt0 (x k a)
+              (declare (integer x a) (type (integer 0 *) k))
+              (cond ((zerop k) a)
+                    ((evenp k) (expt1 (* x x) (floor k 2) a))
+                    (t (expt0 (* x x) (floor k 2) (* x a)))))
+            (expt1 (x k a)
+              (declare (integer x a) (type (integer 0 *) k))
+              (cond ((evenp k) (expt1 (* x x) (floor k 2) a))
+                    (t (expt0 (* x x) (floor k 2) (* x a))))))
+    (expt0 n k 1))) ⇒  INTEGER-POWER
+
    + +
    +
     (defun example (y l)
+   (flet ((attach (x)
+            (setq l (append l (list x)))))
+     (declare (inline attach))
+     (dolist (x y)
+       (unless (null (cdr x))
+         (attach x)))
+     l))
+
+ (example '((a apple apricot) (b banana) (c cherry) (d) (e))
+          '((1) (2) (3) (4 2) (5) (6 3 2)))
+⇒  ((1) (2) (3) (4 2) (5) (6 3 2) (A APPLE APRICOT) (B BANANA) (C CHERRY))
+
    + +

    See Also::

    + +

    declare, +defmacro +, +defun +, +documentation +, +let +, +Evaluation, +Syntactic Interaction of Documentation Strings and Declarations +

    +

    Notes::

    + +

    It is not possible to define recursive functions with flet. +labels can be used to define mutually recursive functions. +

    +

    If a macrolet form is a top level form, +the body forms are also processed as top level forms. +See File Compilation. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/float-_0028System-Class_0029.html b/info/gcl/float-_0028System-Class_0029.html new file mode 100644 index 0000000..7e048c5 --- /dev/null +++ b/info/gcl/float-_0028System-Class_0029.html @@ -0,0 +1,137 @@ + + + + + +float (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.4 float [System Class]

    + +

    Class Precedence List::

    +

    float, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    A float +is a mathematical rational (but not a Common Lisp rational) +of the form +s\cdot f\cdot b^e-p, +where s is +1 or -1, the sign; +b is an integer +greater than~1, the base or radix of the representation; +p is a positive integer, +the precision (in base-b digits) of the float; +f is a positive integer +between b^p-1 and +b^p-1 (inclusive), the significand; +and e is an integer, the exponent. +The value of p and the range of~e +depends on the implementation and on the type of float +within that implementation. In addition, there is a floating-point zero; +depending on the implementation, there can also be a “minus zero”. If there +is no minus zero, then 0.0 and~-0.0 are both interpreted as simply a +floating-point zero. +(= 0.0 -0.0) is always true. +If there is a minus zero, (eql -0.0 0.0) is false, +otherwise it is true. +

    +

    [Reviewer Note by Barmar: What about IEEE NaNs and infinities?] +

    +

    [Reviewer Note by RWK: In the following, what is the “ordering”? precision? range? + Can there be additional subtypes of float or does “others” in the + list of four?] +

    +

    The types short-float, single-float, double-float, +and long-float are subtypes of type float. Any two of them must be +either disjoint types or the same type; +if the same type, then any other types between them in the +above ordering must also be the same type. For example, +if the type single-float and the type long-float are the same type, +then the type double-float must be the same type also. +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (float{[lower-limit [upper-limit]]}) +

    +

    Compound Type Specifier Arguments::

    + +

    lower-limit, upper-limit—interval designators + for type float. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the floats on the interval described by +lower-limit and upper-limit. +

    +

    See Also::

    + +

    Figure~2–9, +Constructing Numbers from Tokens, +Printing Floats +

    +

    Notes::

    + +

    Note that all mathematical integers are representable not only as +Common Lisp reals, but also as complex floats. For example, +possible representations of the mathematical number 1 +include the integer 1, + the float 1.0, + or the complex #C(1.0 0.0). +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/float.html b/info/gcl/float.html new file mode 100644 index 0000000..62b4770 --- /dev/null +++ b/info/gcl/float.html @@ -0,0 +1,94 @@ + + + + + +float (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.74 float [Function]

    + +

    float number &optional prototype ⇒ float +

    +

    Arguments and Values::

    + +

    number—a real. +

    +

    prototype—a float. +

    +

    float—a float. +

    +

    Description::

    + +

    float converts a +

    +

    real +

    +

    number to a float. +

    +

    If a prototype is supplied, +a float is returned that is mathematically equal to number +but has the same format as prototype. +

    +

    If prototype is not supplied, +then if the number is already a float, it is returned; +otherwise, a float is returned that is mathematically equal to number +but is a single float. +

    +

    Examples::

    + +
    +
     (float 0) ⇒  0.0
+ (float 1 .5) ⇒  1.0
+ (float 1.0) ⇒  1.0
+ (float 1/2) ⇒  0.5
+⇒  1.0d0
+OR⇒ 1.0
+ (eql (float 1.0 1.0d0) 1.0d0) ⇒  true
+
    + +

    See Also::

    + +

    coerce +

    + + + + + diff --git a/info/gcl/floating_002dpoint_002dinexact.html b/info/gcl/floating_002dpoint_002dinexact.html new file mode 100644 index 0000000..ff8e7c3 --- /dev/null +++ b/info/gcl/floating_002dpoint_002dinexact.html @@ -0,0 +1,70 @@ + + + + + +floating-point-inexact (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.82 floating-point-inexact [Condition Type]

    + +

    Class Precedence List::

    +

    floating-point-inexact, +arithmetic-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type floating-point-inexact consists of +error conditions that occur because of certain +floating point traps. +

    +

    It is implementation-dependent whether floating point traps +occur, and whether or how they may be enabled or disabled. Therefore, +conforming code may establish handlers for this condition, but must not +depend on its being signaled. +

    + + + + + diff --git a/info/gcl/floating_002dpoint_002dinvalid_002doperation.html b/info/gcl/floating_002dpoint_002dinvalid_002doperation.html new file mode 100644 index 0000000..945bacd --- /dev/null +++ b/info/gcl/floating_002dpoint_002dinvalid_002doperation.html @@ -0,0 +1,70 @@ + + + + + +floating-point-invalid-operation (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.81 floating-point-invalid-operation [Condition Type]

    + +

    Class Precedence List::

    +

    floating-point-invalid-operation, +arithmetic-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type floating-point-invalid-operation consists of +error conditions that occur because of certain +floating point traps. +

    +

    It is implementation-dependent whether floating point traps +occur, and whether or how they may be enabled or disabled. Therefore, +conforming code may establish handlers for this condition, but must not +depend on its being signaled. +

    + + + + + diff --git a/info/gcl/floating_002dpoint_002doverflow.html b/info/gcl/floating_002dpoint_002doverflow.html new file mode 100644 index 0000000..d8b2eb0 --- /dev/null +++ b/info/gcl/floating_002dpoint_002doverflow.html @@ -0,0 +1,64 @@ + + + + + +floating-point-overflow (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.83 floating-point-overflow [Condition Type]

    + +

    Class Precedence List::

    +

    floating-point-overflow, +arithmetic-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type floating-point-overflow consists of error +conditions that occur because of floating-point overflow. +

    + + + + + diff --git a/info/gcl/floating_002dpoint_002dunderflow.html b/info/gcl/floating_002dpoint_002dunderflow.html new file mode 100644 index 0000000..0ac4e32 --- /dev/null +++ b/info/gcl/floating_002dpoint_002dunderflow.html @@ -0,0 +1,69 @@ + + + + + +floating-point-underflow (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.84 floating-point-underflow [Condition Type]

    + +

    Class Precedence List::

    +

    floating-point-underflow, +arithmetic-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type floating-point-underflow consists of +error conditions that occur because of floating-point underflow. +

    + + + + + + + + + + diff --git a/info/gcl/floatp.html b/info/gcl/floatp.html new file mode 100644 index 0000000..da169a6 --- /dev/null +++ b/info/gcl/floatp.html @@ -0,0 +1,80 @@ + + + + + +floatp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.75 floatp [Function]

    + +

    floatp object + generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type float; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (floatp 1.2d2) ⇒  true
+ (floatp 1.212) ⇒  true
+ (floatp 1.2s2) ⇒  true
+ (floatp (expt 2 130)) ⇒  false
+
    + +

    Notes::

    + +
    +
     (floatp object) ≡ (typep object 'float)
+
    + + + + + + diff --git a/info/gcl/floor.html b/info/gcl/floor.html new file mode 100644 index 0000000..1bcd516 --- /dev/null +++ b/info/gcl/floor.html @@ -0,0 +1,205 @@ + + + + + +floor (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.19 floor, ffloor, ceiling, fceiling,

    +

    truncate, ftruncate, round, fround

    +

    [Function] +

    +

    floor number &optional divisor ⇒ quotient, remainder +

    +

    ffloor number &optional divisor ⇒ quotient, remainder +

    +

    ceiling number &optional divisor ⇒ quotient, remainder +

    +

    fceiling number &optional divisor ⇒ quotient, remainder +

    +

    truncate number &optional divisor ⇒ quotient, remainder +

    +

    ftruncate number &optional divisor ⇒ quotient, remainder +

    +

    round number &optional divisor ⇒ quotient, remainder +

    +

    fround number &optional divisor ⇒ quotient, remainder +

    +

    Arguments and Values::

    + +

    number—a real. +

    +

    divisor—a non-zero real. + The default is the integer 1. +

    +

    quotient—for floor, ceiling, + truncate, and round: an integer; + for ffloor, fceiling, + ftruncate, and fround: a float. +

    +

    remainder—a real. +

    +

    Description::

    + +

    These functions divide number by divisor, +returning a quotient and remainder, such that +

    +

    quotient\cdot divisor+remainder=number +

    +

    The quotient always represents a mathematical integer. +When more than one mathematical integer might be possible + (i.e., when the remainder is not zero), +the kind of rounding or truncation depends on the operator: +

    +
    +
    floor, ffloor
    +

    floor and ffloor produce a quotient +that has been truncated toward negative infinity; +that is, the quotient represents the largest mathematical integer +that is not larger than the mathematical quotient. +

    +
    +
    ceiling, fceiling
    +

    ceiling and fceiling produce a quotient +that has been truncated toward positive infinity; +that is, the quotient represents the smallest mathematical integer +that is not smaller than the mathematical result. +

    +
    +
    truncate, ftruncate
    +

    truncate and ftruncate produce a quotient +that has been truncated towards zero; +that is, the quotient represents the mathematical integer +of the same sign as the mathematical quotient, and +that has the greatest integral magnitude not greater than that of the mathematical quotient. +

    +
    +
    round, fround
    +

    round and fround produce a quotient +that has been rounded to the nearest mathematical integer; +if the mathematical quotient is exactly halfway between two integers, +(that is, it has the form integer+1\over2), +then the quotient has been rounded to the even (divisible by two) integer. +

    +
    +
    + +

    All of these functions perform type conversion operations on numbers. +

    +

    The remainder +is an integer if both x and y are integers, +is a rational if both x and y are rationals, and +is a float if either x or y is a float. +

    +

    ffloor, fceiling, ftruncate, and fround +handle arguments of different types in the following way: +If number is a float, +and divisor is not a float of longer format, +then the first result is a float of the same type as number. +Otherwise, the first result is of the type determined by contagion rules; +see Contagion in Numeric Operations. +

    +

    Examples::

    + +
    +
     (floor 3/2) ⇒  1, 1/2
+ (ceiling 3 2) ⇒  2, -1
+ (ffloor 3 2) ⇒  1.0, 1
+ (ffloor -4.7) ⇒  -5.0, 0.3
+ (ffloor 3.5d0) ⇒  3.0d0, 0.5d0
+ (fceiling 3/2) ⇒  2.0, -1/2
+ (truncate 1) ⇒  1, 0
+ (truncate .5) ⇒  0, 0.5
+ (round .5) ⇒  0, 0.5
+ (ftruncate -7 2) ⇒  -3.0, -1
+ (fround -7 2) ⇒  -4.0, 1
+ (dolist (n '(2.6 2.5 2.4 0.7 0.3 -0.3 -0.7 -2.4 -2.5 -2.6))
+   (format t "~&~4,1@F ~2,' D ~2,' D ~2,' D ~2,' D"
+           n (floor n) (ceiling n) (truncate n) (round n)))
+ |>  +2.6  2  3  2  3
+ |>  +2.5  2  3  2  2
+ |>  +2.4  2  3  2  2
+ |>  +0.7  0  1  0  1
+ |>  +0.3  0  1  0  0
+ |>  -0.3 -1  0  0  0
+ |>  -0.7 -1  0  0 -1
+ |>  -2.4 -3 -2 -2 -2
+ |>  -2.5 -3 -2 -2 -2
+ |>  -2.6 -3 -2 -2 -3
+⇒  NIL
+
    + +

    Notes::

    + +

    When only number is given, the two results are exact; +the mathematical sum of the two results is always equal to the +mathematical value of number. +

    +

    (function number divisor) +and (function (/ number divisor)) +(where function is any of one +of floor, ceiling, ffloor, +fceiling, truncate, +round, ftruncate, and fround) +return the same first value, but +they return different remainders as the second value. For example: +

    +
    +
     (floor 5 2) ⇒  2, 1
+ (floor (/ 5 2)) ⇒  2, 1/2
+
    + +

    If an effect is desired that is similar to round, +but that always rounds up or down (rather than toward the nearest even integer) +if the mathematical quotient is exactly halfway between two integers, +the programmer should consider a construction such as + (floor (+ x 1/2)) + or (ceiling (- x 1/2)). +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/fmakunbound.html b/info/gcl/fmakunbound.html new file mode 100644 index 0000000..d188d09 --- /dev/null +++ b/info/gcl/fmakunbound.html @@ -0,0 +1,91 @@ + + + + + +fmakunbound (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.5 fmakunbound [Function]

    + +

    fmakunbound name ⇒ name +

    +

    Pronunciation::

    + +

    pronounced ,ef ’mak e n,baund + or pronounced ,ef ’m\=a k e n,baund +

    +

    Arguments and Values::

    + +

    name—a function name. +

    +

    Description::

    + +

    Removes the function or macro definition, if any, of name +in the global environment. +

    +

    Examples::

    + +
    +
    (defun add-some (x) (+ x 19)) ⇒  ADD-SOME
+ (fboundp 'add-some) ⇒  true
+ (flet ((add-some (x) (+ x 37)))
+    (fmakunbound 'add-some)
+    (add-some 1)) ⇒  38
+ (fboundp 'add-some) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if name is not a function name. +

    +

    The consequences are undefined if name is a special operator. +

    +

    See Also::

    + +

    fboundp +, +makunbound +

    + + + + + diff --git a/info/gcl/format.html b/info/gcl/format.html new file mode 100644 index 0000000..2a180b7 --- /dev/null +++ b/info/gcl/format.html @@ -0,0 +1,118 @@ + + + + + +format (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.31 format [Function]

    + +

    format destination control-string &rest args ⇒ result +

    +

    Arguments and Values::

    + +

    destination—nil, + t, + a stream, + or a string with a fill pointer. +

    +

    control-string—a format control. +

    +

    args—format arguments for control-string. +

    +

    result—if destination is non-nil, then nil; + otherwise, a string. +

    +

    Description::

    + +

    format produces formatted output by outputting the characters +of control-string and observing that a tilde +introduces a directive. The character after the tilde, possibly preceded +by prefix parameters and modifiers, specifies what kind of formatting +is desired. Most directives use one or more elements of args to +create their output. +

    +

    If destination is a string, a stream, or t, +then the result is nil. Otherwise, the result is +a string containing the ‘output.’ +

    +

    format is useful for producing nicely formatted text, producing +good-looking messages, and so on. format can generate and return +a string or output to destination. +

    +

    For details on how the control-string is interpreted, +see Formatted Output. +

    +

    Affected By::

    + +

    *standard-output*, +*print-escape*, +*print-radix*, +*print-base*, +*print-circle*, +*print-pretty*, +*print-level*, +*print-length*, +*print-case*, +*print-gensym*, +*print-array*. +

    +

    Exceptional Situations::

    + +

    If destination is a string with a fill pointer, +the consequences are undefined if destructive modifications are performed +directly on the string during the dynamic extent of the call. +

    +

    See Also::

    + +

    write +, +Documentation of Implementation-Defined Scripts +

    + + + + + + + + + + diff --git a/info/gcl/formatter.html b/info/gcl/formatter.html new file mode 100644 index 0000000..0eb6bd0 --- /dev/null +++ b/info/gcl/formatter.html @@ -0,0 +1,96 @@ + + + + + +formatter (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.2 formatter [Macro]

    + +

    formatter control-string ⇒ function +

    +

    Arguments and Values::

    + +

    control-string—a format string; not evaluated. +

    +

    function—a function. +

    +

    Description::

    + +

    Returns a function which has behavior equivalent to: +

    +
    +
      #'(lambda (*standard-output* &rest arguments)
+      (apply #'format t control-string arguments)
+      arguments-tail)
+
    + +

    where arguments-tail is either the tail of arguments +which has as its car the argument that would be processed next +if there were more format directives in the control-string, +or else nil if no more arguments follow the most recently +processed argument. +

    +

    Examples::

    + +
    +
    (funcall (formatter "~&~A~A") *standard-output* 'a 'b 'c)
+ |>  AB
+⇒  (C)
+
+(format t (formatter "~&~A~A") 'a 'b 'c)
+ |>  AB
+⇒  NIL
+
    + +

    Exceptional Situations::

    + +

    Might signal an error (at macro expansion time or at run time) if the argument +is not a valid format string. +

    +

    See Also::

    + +

    format +

    + + + + + diff --git a/info/gcl/ftype.html b/info/gcl/ftype.html new file mode 100644 index 0000000..70ebad2 --- /dev/null +++ b/info/gcl/ftype.html @@ -0,0 +1,109 @@ + + + + + +ftype (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.23 ftype [Declaration]

    + +

    Syntax::

    + +

    (ftype type {function-name}*) +

    +

    Arguments::

    + +

    function-name—a function name. +

    +

    type—a type specifier. +

    +

    Valid Context::

    + +

    declaration or proclamation +

    +

    Binding Types Affected::

    + +

    function +

    +

    Description::

    + +

    Specifies that the functions named by function-names are of +the functional type type. +For example: +

    +
    +
     (declare (ftype (function (integer list) t) ith)
+          (ftype (function (number) float) sine cosine))
+
    + +

    If one of the functions mentioned has a lexically apparent local definition +(as made by flet or labels), then the declaration +applies to that local definition and not to the global function definition. +ftype declarations never apply to variable bindings (see type). +

    +

    The lexically apparent bindings of function-names must not be +macro definitions. (This is because ftype declares the +functional definition of each function name to be of a particular +subtype of function, and macros do not denote +functions.) +

    +

    ftype +

    +

    declarations +can be free declarations or bound declarations. +ftype declarations of functions that appear before the body of a + flet +or labels +

    +

    form that defines that function are bound declarations. +Such declarations in other contexts are free declarations. +

    +

    See Also::

    + +

    declare, +declaim +, +proclaim +

    + + + + + diff --git a/info/gcl/funcall.html b/info/gcl/funcall.html new file mode 100644 index 0000000..901967e --- /dev/null +++ b/info/gcl/funcall.html @@ -0,0 +1,108 @@ + + + + + +funcall (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.7 funcall [Function]

    + +

    funcall function &rest args ⇒ {result}* +

    +

    Arguments and Values::

    + +

    function—a function designator. +

    +

    args—arguments to the function. +

    +

    results—the values returned by the function. +

    +

    Description::

    + +

    funcall applies function to args. +

    +

    If function is a symbol, +it is coerced to a function as if by +finding its functional value in the global environment. +

    +

    Examples::

    + +
    +
     (funcall #'+ 1 2 3) ⇒  6
+ (funcall 'car '(1 2 3)) ⇒  1
+ (funcall 'position 1 '(1 2 3 2 1) :start 1) ⇒  4
+ (cons 1 2) ⇒  (1 . 2)
+ (flet ((cons (x y) `(kons ,x ,y)))
+   (let ((cons (symbol-function '+)))
+     (funcall #'cons
+              (funcall 'cons 1 2)
+              (funcall cons 1 2))))
+⇒  (KONS (1 . 2) 3)
+
    + +

    Exceptional Situations::

    + +

    An error of type undefined-function should be signaled if function +is a symbol that does not have a global definition as a function +or that has a global definition as a macro or a special operator. +

    +

    See Also::

    + +

    apply +, function, Evaluation +

    +

    Notes::

    + +
    +
     (funcall function arg1 arg2 ...)
+ ≡ (apply function arg1 arg2 ... nil)
+ ≡ (apply function (list arg1 arg2 ...))
+
    + +

    The difference between funcall and an ordinary function call is that +in the former case the function is obtained by ordinary evaluation +of a form, and in the latter case it is obtained by the special +interpretation of the function position that normally occurs. +

    + + + + + diff --git a/info/gcl/function-_0028Special-Operator_0029.html b/info/gcl/function-_0028Special-Operator_0029.html new file mode 100644 index 0000000..b07ccb0 --- /dev/null +++ b/info/gcl/function-_0028Special-Operator_0029.html @@ -0,0 +1,128 @@ + + + + + +function (Special Operator) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.8 function [Special Operator]

    + +

    function name ⇒ function +

    +

    Arguments and Values::

    + +

    name—a function name or lambda expression. +

    +

    function—a function object. +

    +

    Description::

    + +

    The value of function is the functional value of name +in the current lexical environment. +

    +

    If name is a function name, the functional definition of that name +is that +established by the innermost lexically enclosing +flet, labels, or macrolet form, +if there is one. Otherwise the global functional definition of the +function name +is returned. +

    +

    If name is a lambda expression, then a lexical closure +is returned. In situations where a closure over the same set of +bindings might be produced more than once, the various resulting +closures might or might not be eq. +

    +

    It is an error to use function on a function name +that does not denote a function in the lexical environment in +which the function form appears. +Specifically, it is an error to use function on a symbol +that denotes a macro or special form. +An implementation may choose not to signal this error for +performance reasons, but implementations are forbidden from +defining the failure to signal an error as a useful behavior. +

    +

    Examples::

    + +
    +
     (defun adder (x) (function (lambda (y) (+ x y))))
+
    + +

    The result of (adder 3) is a function that adds 3 to its argument: +

    +
    +
     (setq add3 (adder 3))
+ (funcall add3 5) ⇒  8
+
    + +

    This works because function creates a closure of +the lambda expression that is able to refer to the value 3 +of the variable x even after control has returned from the function adder. +

    +

    See Also::

    + +

    defun +, +fdefinition +, +flet +, +labels, +symbol-function +, +Symbols as Forms, +Sharpsign Single-Quote, +Printing Other Objects +

    +

    Notes::

    + +

    The notation #'name may be used as an abbreviation +for (function name). +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/function-_0028System-Class_0029.html b/info/gcl/function-_0028System-Class_0029.html new file mode 100644 index 0000000..0cbd216 --- /dev/null +++ b/info/gcl/function-_0028System-Class_0029.html @@ -0,0 +1,217 @@ + + + + + +function (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.3 function [System Class]

    + +

    Class Precedence List::

    +

    function, +t +

    +

    Description::

    + +

    A function is an object that represents code +to be executed when an appropriate number of arguments is supplied. +A function is produced by + the function special form, + the function coerce, +

    +

    or + the function compile. +A function can be directly invoked by using it as the first argument to +funcall, apply, or multiple-value-call. +

    +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (function{[arg-typespec [value-typespec]]}) +

    +

    arg-typespec ::=({typespec}*  +                  [&optional {typespec}*]  +                  [&rest typespec]  +                  [&key {(keyword typespec )}*]) +

    +

    Compound Type Specifier Arguments::

    + +

    typespec—a type specifier. +

    +

    value-typespec—a type specifier. +

    +

    Compound Type Specifier Description::

    + +

    [Editorial Note by KMP: Isn’t there some context info about ftype declarations to be merged here?] +

    +

    [Editorial Note by KMP: This could still use some cleaning up.] +

    +

    [Editorial Note by Sandra: Still need clarification about what happens if the +number of arguments doesn’t match the FUNCTION type declaration.] +

    +

    The list form of the function type-specifier +can be used only for declaration and not for discrimination. +Every element of this type is +a function that accepts arguments of the +types +specified by the argj-types and returns values that are +members of the types specified by value-type. The +&optional, &rest, &key, +

    +

    and &allow-other-keys +

    +

    markers can appear in the list of argument types. +

    +

    The type specifier provided +with &rest is the type +of each actual argument, not the type of the +corresponding variable. +

    +

    The &key parameters +should be supplied as lists of the form (keyword type). +The keyword must be a valid keyword-name symbol +as must be supplied in the actual arguments of a +call. +

    +

    This is usually a symbol in the KEYWORD package but can be any symbol. +

    +

    When &key is given in a +function type specifier lambda list, +the keyword parameters given +are exhaustive unless &allow-other-keys is also present. +&allow-other-keys is an indication +that other keyword arguments might actually be +supplied and, if supplied, can be used. +For example, +the type of the function make-list could be declared as follows: +

    +
    +
     (function ((integer 0) &key (:initial-element t)) list)
+
    + +

    The value-type can be a values +type specifier in order to indicate the +types of multiple values. +

    +

    Consider a declaration of the following form: +

    +
    +
     (ftype (function (arg0-type arg1-type ...) val-type) f))
+
    + +

    Any form +(f arg0 arg1 ...) +within the scope of +that declaration is equivalent to the following: +

    +
    +
     (the val-type (f (the arg0-type arg0) (the arg1-type arg1) ...))
+
    + +

    That is, the consequences are undefined if any of the arguments are +not of the specified types or the result is not of the +specified type. In particular, if any argument is not of the +correct type, the result is not guaranteed to be of the +specified type. +

    +

    Thus, an ftype declaration for a function +describes calls to the function, not the actual definition +of the function. +

    +

    Consider a declaration of the following form: +

    +
    +
     (type (function (arg0-type arg1-type ...) val-type) fn-valued-variable)
+
    + +

    This declaration has the interpretation that, within the scope of the +declaration, the consequences are unspecified if the value of fn-valued-variable is called with arguments not of the specified +types; the value resulting from a valid call will be of type +val-type. +

    +

    As with variable type declarations, nested declarations +imply intersections of types, as follows: +

    +
    *
    +

    Consider the following two +declarations of ftype: +

    +
    +
     (ftype (function (arg0-type1 arg1-type1 ...) val-type1) f))
+
    + +

    and +

    +
    +
     (ftype (function (arg0-type2 arg1-type2 ...) val-type2) f))
+
    + +

    If both these declarations are in effect, +then within the shared scope of the declarations, calls to f can be +treated as if f were declared as follows: +

    +
    +
     (ftype (function ((and arg0-type1 arg0-type2) (and arg1-type1 arg1-type2 ...) ...)
+                  (and val-type1 val-type2)) 
+        f))
+
    + +

    It is permitted to ignore one or all of the ftype declarations in force. +

    +
    +
    *
    +

    If two (or more) type declarations are in effect for a variable, and +they are both function declarations, the declarations combine similarly. +

    +
    + +
    +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    + + + + + diff --git a/info/gcl/function_002dkeywords.html b/info/gcl/function_002dkeywords.html new file mode 100644 index 0000000..1e5a2e0 --- /dev/null +++ b/info/gcl/function_002dkeywords.html @@ -0,0 +1,106 @@ + + + + + +function-keywords (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.1 function-keywords [Standard Generic Function]

    + +

    Syntax::

    + +

    function-keywords method ⇒ keys, allow-other-keys-p +

    +

    Method Signatures::

    + +

    function-keywords (method standard-method) +

    +

    Arguments and Values::

    + +

    method—a method. +

    +

    keys—a list. +

    +

    allow-other-keys-p—a generalized boolean. +

    +

    Description::

    + +

    Returns the keyword parameter specifiers for a method. +

    +

    Two values are returned: + a list of the explicitly named keywords + and a generalized boolean that states whether &allow-other-keys + had been specified in the method definition. +

    +

    Examples::

    + +
    +
     (defmethod gf1 ((a integer) &optional (b 2)
+                 &key (c 3) ((:dee d) 4) e ((eff f)))
+   (list a b c d e f))
+⇒  #<STANDARD-METHOD GF1 (INTEGER) 36324653>
+ (find-method #'gf1 '() (list (find-class 'integer))) 
+⇒  #<STANDARD-METHOD GF1 (INTEGER) 36324653>
+ (function-keywords *)
+⇒  (:C :DEE :E EFF), false
+ (defmethod gf2 ((a integer))
+   (list a b c d e f))
+⇒  #<STANDARD-METHOD GF2 (INTEGER) 42701775>
+ (function-keywords (find-method #'gf1 '() (list (find-class 'integer))))
+⇒  (), false
+ (defmethod gf3 ((a integer) &key b c d &allow-other-keys)
+   (list a b c d e f))
+ (function-keywords *)
+⇒  (:B :C :D), true
+
    + +

    Affected By::

    + +

    defmethod +

    +

    See Also::

    + +

    defmethod +

    + + + + + diff --git a/info/gcl/function_002dlambda_002dexpression.html b/info/gcl/function_002dlambda_002dexpression.html new file mode 100644 index 0000000..c393da3 --- /dev/null +++ b/info/gcl/function_002dlambda_002dexpression.html @@ -0,0 +1,150 @@ + + + + + +function-lambda-expression (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.9 function-lambda-expression [Function]

    + +

    function-lambda-expression function
    + ⇒ lambda-expression, closure-p, name +

    +

    Arguments and Values::

    + +

    function—a function. +

    +

    lambda-expression—a lambda expression or nil. +

    +

    closure-p—a generalized boolean. +

    +

    name—an object. +

    +

    Description::

    + +

    Returns information about function as follows: +

    +

    The primary value, lambda-expression, +is function’s defining lambda expression, +or nil if the information is not available. The lambda expression +may have been pre-processed in some ways, but it should remain a suitable +argument to compile or function. +Any implementation may legitimately return nil +as the lambda-expression of any function. +

    +

    The secondary value, closure-p, +is nil if function’s definition was enclosed +in the null lexical environment or something non-nil if +function’s definition might have been enclosed in some +non-null lexical environment. +Any implementation may legitimately return true +as the closure-p of any function. +

    +

    The tertiary value, name, +is the “name” of function. +The name is intended for debugging only and is not necessarily one that would +be valid for use as a name in defun or function, for example. +By convention, nil is used to mean that function has no name. +Any implementation may legitimately return nil +as the name of any function. +

    +

    Examples::

    + +

    The following examples illustrate some possible return values, but +are not intended to be exhaustive: +

    +
    +
     (function-lambda-expression #'(lambda (x) x))
+⇒  NIL, false, NIL
+OR⇒ NIL, true, NIL
+OR⇒ (LAMBDA (X) X), true, NIL
+OR⇒ (LAMBDA (X) X), false, NIL
+
+ (function-lambda-expression
+    (funcall #'(lambda () #'(lambda (x) x))))
+⇒  NIL, false, NIL
+OR⇒ NIL, true, NIL
+OR⇒ (LAMBDA (X) X), true, NIL
+OR⇒ (LAMBDA (X) X), false, NIL
+
+ (function-lambda-expression 
+    (funcall #'(lambda (x) #'(lambda () x)) nil))
+⇒  NIL, true, NIL
+OR⇒ (LAMBDA () X), true, NIL
+NOT⇒ NIL, false, NIL
+NOT⇒ (LAMBDA () X), false, NIL
+
+ (flet ((foo (x) x))
+   (setf (symbol-function 'bar) #'foo)
+   (function-lambda-expression #'bar))
+⇒  NIL, false, NIL
+OR⇒ NIL, true, NIL
+OR⇒ (LAMBDA (X) (BLOCK FOO X)), true, NIL
+OR⇒ (LAMBDA (X) (BLOCK FOO X)), false, FOO
+OR⇒ (SI::BLOCK-LAMBDA FOO (X) X), false, FOO
+
+ (defun foo ()
+   (flet ((bar (x) x))
+     #'bar))
+ (function-lambda-expression (foo))
+⇒  NIL, false, NIL
+OR⇒ NIL, true, NIL
+OR⇒ (LAMBDA (X) (BLOCK BAR X)), true, NIL
+OR⇒ (LAMBDA (X) (BLOCK BAR X)), true, (:INTERNAL FOO 0 BAR)
+OR⇒ (LAMBDA (X) (BLOCK BAR X)), false, "BAR in FOO"
+
    + +

    Notes::

    + +

    Although implementations are free to return “nil, true, nil” in all cases, +they are encouraged to return a lambda expression as the primary value +in the case where the argument was created by a call to compile +or eval (as opposed to being created by loading a compiled file). +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/functionp.html b/info/gcl/functionp.html new file mode 100644 index 0000000..54bcea2 --- /dev/null +++ b/info/gcl/functionp.html @@ -0,0 +1,84 @@ + + + + + +functionp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.10 functionp [Function]

    + +

    functionp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type function; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (functionp 'append) ⇒  false
+ (functionp #'append) ⇒  true
+ (functionp (symbol-function 'append)) ⇒  true
+ (flet ((f () 1)) (functionp #'f)) ⇒  true
+ (functionp (compile nil '(lambda () 259))) ⇒  true
+ (functionp nil) ⇒  false
+ (functionp 12) ⇒  false
+ (functionp '(lambda (x) (* x x))) ⇒  false
+ (functionp #'(lambda (x) (* x x))) ⇒  true
+
    + +

    Notes::

    + +
    +
     (functionp object) ≡ (typep object 'function)
+
    + + + + + + diff --git a/info/gcl/gcd.html b/info/gcl/gcd.html new file mode 100644 index 0000000..63b27b2 --- /dev/null +++ b/info/gcl/gcd.html @@ -0,0 +1,95 @@ + + + + + +gcd (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.32 gcd [Function]

    + +

    gcd &rest integers ⇒ greatest-common-denominator +

    +

    Arguments and Values::

    + +

    integer—an integer. +

    +

    greatest-common-denominator—a non-negative integer. +

    +

    Description::

    + +

    Returns the greatest common divisor of integers. +If only one integer is supplied, its absolute value is returned. +If no integers are given, gcd returns 0, +which is an identity for this operation. +

    +

    Examples::

    + +
    +
     (gcd) ⇒  0
+ (gcd 60 42) ⇒  6
+ (gcd 3333 -33 101) ⇒  1
+ (gcd 3333 -33 1002001) ⇒  11
+ (gcd 91 -49) ⇒  7
+ (gcd 63 -42 35) ⇒  7
+ (gcd 5) ⇒  5
+ (gcd -4) ⇒  4
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if any integer is not an integer. +

    +

    See Also::

    + +

    lcm +

    +

    Notes::

    +

    For three or more arguments, +

    +
    +
     (gcd b c ... z) ≡ (gcd (gcd a b) c ... z)
+
    + + + + + + diff --git a/info/gcl/generic_002dfunction.html b/info/gcl/generic_002dfunction.html new file mode 100644 index 0000000..55b5771 --- /dev/null +++ b/info/gcl/generic_002dfunction.html @@ -0,0 +1,76 @@ + + + + + +generic-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.5 generic-function [System Class]

    + +

    Class Precedence List::

    + +

    generic-function, +function, +t +

    +

    Description::

    + +

    A generic function + + is a function whose behavior +depends on the classes or identities of the arguments +supplied to it. A generic function object contains a set of +methods, a lambda list, a method combination type, +and other information. The methods +define the class-specific behavior and operations of the generic function; +a method is said to specialize a generic function. +When invoked, a generic function executes a subset of its +methods based on the classes or identities of its arguments. +

    +

    A generic function can be used in the same ways that an +ordinary function can be used; specifically, a generic function can +be used as an argument to funcall and apply, +and can be given a global or a local name. +

    + + + + + diff --git a/info/gcl/gensym.html b/info/gcl/gensym.html new file mode 100644 index 0000000..e6bfa13 --- /dev/null +++ b/info/gcl/gensym.html @@ -0,0 +1,130 @@ + + + + + +gensym (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.7 gensym [Function]

    + +

    gensym &optional x ⇒ new-symbol +

    +

    Arguments and Values::

    + +

    x—a string or a non-negative integer. + Complicated defaulting behavior; see below. +

    +

    new-symbol—a fresh, uninterned symbol. +

    +

    Description::

    + +

    Creates and returns a fresh, uninterned symbol, +as if by calling make-symbol. (The only difference between +gensym and make-symbol is in how the new-symbol’s +name is determined.) +

    +

    The name of the new-symbol is the concatenation +of a prefix, which defaults to "G", and +

    +

    a suffix, which is the decimal representation of a number that +defaults to the value of *gensym-counter*. +

    +

    If x is supplied, and is a string, then that string +is used as a prefix instead of "G" for this call to gensym only. +

    +

    If x is supplied, and is an integer, then that integer, +instead of the value of *gensym-counter*, is used as the suffix +for this call to gensym only. +

    +

    If and only if no explicit suffix is supplied, +*gensym-counter* is incremented after it is used. +

    +

    Examples::

    + +
    +
     (setq sym1 (gensym)) ⇒  #:G3142
+ (symbol-package sym1) ⇒  NIL
+ (setq sym2 (gensym 100)) ⇒  #:G100
+ (setq sym3 (gensym 100)) ⇒  #:G100
+ (eq sym2 sym3) ⇒  false
+ (find-symbol "G100") ⇒  NIL, NIL
+ (gensym "T") ⇒  #:T3143
+ (gensym) ⇒  #:G3144
+
    + +

    Side Effects::

    + +

    Might increment *gensym-counter*. +

    +

    Affected By::

    + +

    *gensym-counter* +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if x is not a string or a non-negative integer. +

    +

    See Also::

    + +

    gentemp +, +*gensym-counter* +

    +

    Notes::

    + +

    The ability to pass a numeric argument to gensym has been deprecated; +explicitly binding *gensym-counter* is now stylistically preferred. +(The somewhat baroque conventions for the optional argument are historical +in nature, and supported primarily for compatibility with older dialects +of Lisp. In modern code, it is recommended that the only kind of argument +used be a string prefix. In general, though, to obtain more flexible control +of the new-symbol’s name, consider using make-symbol instead.) +

    +
    +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    + + + + + diff --git a/info/gcl/gentemp.html b/info/gcl/gentemp.html new file mode 100644 index 0000000..c5d5c2e --- /dev/null +++ b/info/gcl/gentemp.html @@ -0,0 +1,142 @@ + + + + + +gentemp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.9 gentemp [Function]

    + +

    gentemp &optional prefix package ⇒ new-symbol +

    +

    Arguments and Values::

    + +

    prefix—a string. + The default is "T". +

    +

    package—a package designator. + The default is the current package. +

    +

    new-symbol—a fresh, interned symbol. +

    +

    Description::

    + +

    gentemp creates and returns a fresh symbol, +interned in the indicated package. +The symbol is guaranteed to be one that was not previously +accessible in package. +It is neither bound nor fbound, and has a null +property list. +

    +

    The name of the new-symbol is the concatenation +of the prefix and a suffix, which is taken from an internal +counter used only by gentemp. (If a symbol by that name +is already accessible in package, the counter is incremented as +many times as is necessary to produce a name that is not already the +name of a symbol accessible in package.) +

    +

    Examples::

    + +
    +
     (gentemp) ⇒  T1298
+ (gentemp "FOO") ⇒  FOO1299
+ (find-symbol "FOO1300") ⇒  NIL, NIL
+ (gentemp "FOO") ⇒  FOO1300
+ (find-symbol "FOO1300") ⇒  FOO1300, :INTERNAL
+ (intern "FOO1301") ⇒  FOO1301, :INTERNAL
+ (gentemp "FOO") ⇒  FOO1302
+ (gentemp) ⇒  T1303
+
    + +

    Side Effects::

    + +

    Its internal counter is incremented one or more times. +

    +

    Interns the new-symbol in package. +

    +

    Affected By::

    + +

    The current state of its internal counter, and +the current state of the package. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if prefix is not a string. +Should signal an error of type type-error + if package is not a package designator. +

    +

    See Also::

    + +

    gensym +

    +

    Notes::

    + +

    The function gentemp is deprecated. +

    +

    If package is the KEYWORD package, +the result is an external symbol of package. +Otherwise, the result is an internal symbol of package. +

    +

    The gentemp internal counter is independent of +*gensym-counter*, the counter used by gensym. +There is no provision for accessing the gentemp internal counter. +

    +

    Just because gentemp creates a symbol which did not +previously exist does not mean that such a symbol might not be +seen in the future (e.g., in a data file—perhaps even created by the +same program in another session). As such, this symbol is not truly +unique in the same sense as a gensym would be. In particular, +programs which do automatic code generation should be careful not to +attach global attributes to such generated symbols (e.g., special declarations) and then write them into a file +because such global attributes might, in a different session, end up +applying to other symbols that were automatically generated on +another day for some other purpose. +

    +
    +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    + + + + + diff --git a/info/gcl/get.html b/info/gcl/get.html new file mode 100644 index 0000000..ab5a054 --- /dev/null +++ b/info/gcl/get.html @@ -0,0 +1,161 @@ + + + + + +get (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.15 get [Accessor]

    + +

    get symbol indicator &optional default ⇒ value +

    +

    (setf ( get symbol indicator &optional default) new-value)
    +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    indicator—an object. +

    +

    default—an object. + The default is nil. +

    +

    value—if the indicated property exists, + the object that is its value; + otherwise, the specified default. +

    +

    new-value—an object. +

    +

    Description::

    + +

    get finds a property +on the property list_2 of symbol +whose property indicator is identical to indicator, +and returns its corresponding property value. +

    +

    If there are multiple properties_1 with that property indicator, +get uses the first such property. +

    +

    If there is no property with that property indicator, +default is returned. +

    +

    setf of get may be used to associate a new object +with an existing indicator already on the symbol’s property list, +or to create a new assocation if none exists. +

    +

    If there are multiple properties_1 with that property indicator, +setf of get associates the new-value +with the first such property. +

    +

    When a get form is used as a setf place, +any default which is supplied is evaluated according to normal +left-to-right evaluation rules, but its value is ignored. +

    +

    Examples::

    + +
    +
     (defun make-person (first-name last-name)
+   (let ((person (gensym "PERSON")))
+     (setf (get person 'first-name) first-name)
+     (setf (get person 'last-name) last-name)
+     person)) ⇒  MAKE-PERSON
+ (defvar *john* (make-person "John" "Dow")) ⇒  *JOHN*
+ *john* ⇒  #:PERSON4603
+ (defvar *sally* (make-person "Sally" "Jones")) ⇒  *SALLY*
+ (get *john* 'first-name) ⇒  "John"
+ (get *sally* 'last-name) ⇒  "Jones"
+ (defun marry (man woman married-name)
+   (setf (get man 'wife) woman)
+   (setf (get woman 'husband) man)
+   (setf (get man 'last-name) married-name)
+   (setf (get woman 'last-name) married-name)
+   married-name) ⇒  MARRY
+ (marry *john* *sally* "Dow-Jones") ⇒  "Dow-Jones"
+ (get *john* 'last-name) ⇒  "Dow-Jones"
+ (get (get *john* 'wife) 'first-name) ⇒  "Sally"
+ (symbol-plist *john*)
+⇒  (WIFE #:PERSON4604 LAST-NAME "Dow-Jones" FIRST-NAME "John")
+ (defmacro age (person &optional (default ''thirty-something)) 
+   `(get ,person 'age ,default)) ⇒  AGE
+ (age *john*) ⇒  THIRTY-SOMETHING
+ (age *john* 20) ⇒  20
+ (setf (age *john*) 25) ⇒  25
+ (age *john*) ⇒  25
+ (age *john* 20) ⇒  25
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    See Also::

    + +

    getf +, +symbol-plist +, +remprop +

    +

    Notes::

    + +
    +
     (get x y) ≡ (getf (symbol-plist x) y)
+
    + +

    Numbers and characters are not recommended for use +as indicators in portable code since get tests +with eq rather than eql, and consequently +the effect of using such indicators is +implementation-dependent. +

    +

    There is no way using get to distinguish an absent property from +one whose value is default. However, see get-properties. +

    +
    +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    + + + + + diff --git a/info/gcl/get_002dinternal_002dreal_002dtime.html b/info/gcl/get_002dinternal_002dreal_002dtime.html new file mode 100644 index 0000000..11770a9 --- /dev/null +++ b/info/gcl/get_002dinternal_002dreal_002dtime.html @@ -0,0 +1,73 @@ + + + + + +get-internal-real-time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.12 get-internal-real-time [Function]

    + +

    get-internal-real-time <no arguments> ⇒ internal-time +

    +

    Arguments and Values::

    + +

    internal-time—a non-negative integer. +

    +

    Description::

    + +

    get-internal-real-time returns as an integer the +current time in internal time units, relative to an arbitrary +time base. The difference between the values of two calls to this +function is the amount of elapsed real time (i.e., clock time) between the two calls. +

    +

    Affected By::

    + +

    Time of day (i.e., the passage of time). +The time base affects the result magnitude. +

    +

    See Also::

    + +

    internal-time-units-per-second +

    + + + + + diff --git a/info/gcl/get_002dinternal_002drun_002dtime.html b/info/gcl/get_002dinternal_002drun_002dtime.html new file mode 100644 index 0000000..c22b2e5 --- /dev/null +++ b/info/gcl/get_002dinternal_002drun_002dtime.html @@ -0,0 +1,84 @@ + + + + + +get-internal-run-time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.13 get-internal-run-time [Function]

    + +

    get-internal-run-time <no arguments> ⇒ internal-time +

    +

    Arguments and Values::

    + +

    internal-time—a non-negative integer. +

    +

    Description::

    + +

    Returns as an integer the current +run time in internal time units. The precise meaning of this quantity is +implementation-defined; it may measure real time, run time, CPU cycles, or some +other quantity. The intent is that the difference between the values of two calls +to this function be the amount of time between the two calls during which +computational effort was expended on behalf of the executing program. +

    +

    Affected By::

    + +

    The implementation, +the time of day (i.e., the passage of time). +

    +

    See Also::

    + +

    internal-time-units-per-second +

    +

    Notes::

    + +

    Depending on the implementation, paging time and garbage +collection time might be included in this measurement. Also, in a +multitasking environment, it might not be possible to show the time for +just the running process, so in some implementations, time taken +by other processes during the same time interval might be included in +this measurement as well. +

    + + + + + diff --git a/info/gcl/get_002doutput_002dstream_002dstring.html b/info/gcl/get_002doutput_002dstream_002dstring.html new file mode 100644 index 0000000..8b8426d --- /dev/null +++ b/info/gcl/get_002doutput_002dstream_002dstring.html @@ -0,0 +1,96 @@ + + + + + +get-output-stream-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.48 get-output-stream-string [Function]

    + +

    get-output-stream-string string-output-stream ⇒ string +

    +

    Arguments and Values::

    + +

    string-output-stream—a stream. +

    +

    string—a string. +

    +

    Description::

    + +

    Returns a string containing, in order, all the characters +that have been output to string-output-stream. +This operation clears any characters on string-output-stream, +so the string contains only those characters which have been output + since the last call to get-output-stream-string +or since the creation of the string-output-stream, +whichever occurred most recently. +

    +

    Examples::

    +
    +
     (setq a-stream (make-string-output-stream)
+        a-string "abcdefghijklm") ⇒  "abcdefghijklm"
+ (write-string a-string a-stream) ⇒  "abcdefghijklm"
+ (get-output-stream-string a-stream) ⇒  "abcdefghijklm"
+ (get-output-stream-string a-stream) ⇒  ""
+
    + +

    Side Effects::

    + +

    The string-output-stream is cleared. +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if stream-output-string is closed. +

    +

    The consequences are undefined if string-output-stream is a stream that +was not produced by make-string-output-stream. +

    +

    The consequences are undefined if string-output-stream was +created implicitly by with-output-to-string or format. +

    +

    See Also::

    + +

    make-string-output-stream +

    + + + + + diff --git a/info/gcl/get_002dproperties.html b/info/gcl/get_002dproperties.html new file mode 100644 index 0000000..c6031f9 --- /dev/null +++ b/info/gcl/get_002dproperties.html @@ -0,0 +1,97 @@ + + + + + +get-properties (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.40 get-properties [Function]

    + +

    get-properties plist indicator-list ⇒ indicator, value, tail +

    +

    Arguments and Values::

    + +

    plist—a property list. +

    +

    indicator-list—a proper list (of indicators). +

    +

    indicator—an object that is an element of indicator-list. +

    +

    value—an object. +

    +

    tail—a list. +

    +

    Description::

    + +

    get-properties is used to look up any of several +property list entries all at once. +

    +

    It searches the plist for the first entry whose indicator +is identical to one of the objects in indicator-list. +If such an entry is found, the indicator and value returned +are the property indicator and its associated property value, +and the tail returned is the tail of the plist +that begins with the found entry (i.e., whose car is the indicator). +If no such entry is found, the indicator, value, and tail +are all nil. +

    +

    Examples::

    + +
    +
     (setq x '()) ⇒  NIL
+ (setq *indicator-list* '(prop1 prop2)) ⇒  (PROP1 PROP2)
+ (getf x 'prop1) ⇒  NIL
+ (setf (getf x 'prop1) 'val1) ⇒  VAL1
+ (eq (getf x 'prop1) 'val1) ⇒  true
+ (get-properties x *indicator-list*) ⇒  PROP1, VAL1, (PROP1 VAL1)
+ x ⇒  (PROP1 VAL1)
+
    + +

    See Also::

    + +

    get +, +getf +

    + + + + + diff --git a/info/gcl/get_002dsetf_002dexpansion.html b/info/gcl/get_002dsetf_002dexpansion.html new file mode 100644 index 0000000..8d21d7b --- /dev/null +++ b/info/gcl/get_002dsetf_002dexpansion.html @@ -0,0 +1,112 @@ + + + + + +get-setf-expansion (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.63 get-setf-expansion [Function]

    + +

    get-setf-expansion place &optional environment
    + ⇒ vars, vals, store-vars, writer-form, reader-form +

    +

    Arguments and Values::

    + +

    place—a place. +

    +

    environment—an environment object. +

    +

    vars, vals, store-vars, writer-form, reader-form—a setf expansion. +

    +

    Description::

    + +

    Determines +five values constituting the setf expansion for place +in environment; see Setf Expansions. +

    +

    If environment is not supplied or nil, +the environment is the null lexical environment. +

    +

    Examples::

    + +
    +
     (get-setf-expansion 'x)
+⇒  NIL, NIL, (#:G0001), (SETQ X #:G0001), X 
+
    + +
    +
    ;;; This macro is like POP 
+
+ (defmacro xpop (place &environment env)
+   (multiple-value-bind (dummies vals new setter getter)
+                        (get-setf-expansion place env)
+      `(let* (,@(mapcar #'list dummies vals) (,(car new) ,getter))
+         (if (cdr new) (error "Can't expand this."))
+         (prog1 (car ,(car new))
+                (setq ,(car new) (cdr ,(car new)))
+                ,setter))))
+
+ (defsetf frob (x) (value) 
+     `(setf (car ,x) ,value)) ⇒  FROB
+;;; The following is an error; an error might be signaled at macro expansion time
+ (flet ((frob (x) (cdr x)))  ;Invalid
+   (xpop (frob z)))
+
+
    + +

    See Also::

    + +

    defsetf +, +define-setf-expander +, +setf +

    +

    Notes::

    + +

    Any compound form is a valid place, +since any compound form whose operator f has no setf expander +are expanded into a call to (setf f). +

    + + + + + diff --git a/info/gcl/get_002duniversal_002dtime.html b/info/gcl/get_002duniversal_002dtime.html new file mode 100644 index 0000000..af4a47a --- /dev/null +++ b/info/gcl/get_002duniversal_002dtime.html @@ -0,0 +1,121 @@ + + + + + +get-universal-time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.3 get-universal-time, get-decoded-time [Function]

    + +

    get-universal-time <no arguments> ⇒ universal-time +

    +

    get-decoded-time <no arguments>
    + ⇒ second, minute, hour, date, month, year, day, daylight-p, zone +

    +

    Arguments and Values::

    + +

    universal-time—a universal time. +

    +

    second, minute, hour, +date, month, year, +day, daylight-p, zone—a decoded time. +

    +

    Description::

    + +

    get-universal-time returns the current time, represented as a universal time. +

    +

    get-decoded-time returns the current time, represented as a decoded time. +

    +

    Examples::

    + +
    +
    ;; At noon on July 4, 1976 in Eastern Daylight Time.
+ (get-decoded-time) ⇒  0, 0, 12, 4, 7, 1976, 6, true, 5
+;; At exactly the same instant.
+ (get-universal-time) ⇒  2414332800
+;; Exactly five minutes later.
+ (get-universal-time) ⇒  2414333100
+;; The difference is 300 seconds (five minutes)
+ (- * **) ⇒  300
+
    + +

    Affected By::

    + +

    The time of day (i.e., the passage of time), +the system clock’s ability to keep accurate time, +and the accuracy of the system clock’s initial setting. +

    +

    Exceptional Situations::

    + +

    An error of type error might be signaled if the current time cannot be determined. +

    +

    See Also::

    + +

    decode-universal-time +, +encode-universal-time +, +Time +

    +

    Notes::

    + +
    +
     (get-decoded-time) ≡ (decode-universal-time (get-universal-time))
+
    + +

    No implementation is required to have a way to verify that the +time returned is correct. However, if an implementation provides +a validity check (e.g., the failure to have properly initialized the system +clock can be reliably detected) and that validity check fails, +the implementation is strongly encouraged (but not required) +to signal an error of type error (rather than, for example, returning a +known-to-be-wrong value) that is correctable by allowing the user +to interactively set the correct time. +

    +
    +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    + + + + + diff --git a/info/gcl/getf.html b/info/gcl/getf.html new file mode 100644 index 0000000..10a4790 --- /dev/null +++ b/info/gcl/getf.html @@ -0,0 +1,159 @@ + + + + + +getf (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.41 getf [Accessor]

    + +

    getf plist indicator &optional default ⇒ value +

    +

    (setf ( getf place indicator &optional default) new-value)
    +

    +

    Arguments and Values::

    + +

    plist—a property list. +

    +

    place—a place, the value of which is a property list. +

    +

    indicator—an object. +

    +

    default—an object. + The default is nil. +

    +

    value—an object. +

    +

    new-value—an object. +

    +

    Description::

    + +

    getf finds a property on the plist +whose property indicator is identical to indicator, +and returns its corresponding property value. +

    +

    If there are multiple properties_1 with that property indicator, +getf uses the first such property. +

    +

    If there is no property with that property indicator, +default is returned. +

    +

    setf of getf may be used to associate a new object +with an existing indicator in the property list held by place, +or to create a new assocation if none exists. +

    +

    If there are multiple properties_1 with that property indicator, +setf of getf associates the new-value +with the first such property. +

    +

    When a getf form is used as a setf place, +any default which is supplied is evaluated according to normal +left-to-right evaluation rules, but its value is ignored. +

    +

    setf of getf is permitted to either + write the value of place itself, + or modify of any part, car or cdr, + of the list structure held by place. +

    +

    Examples::

    + +
    +
     (setq x '()) ⇒  NIL
+ (getf x 'prop1) ⇒  NIL
+ (getf x 'prop1 7) ⇒  7
+ (getf x 'prop1) ⇒  NIL
+ (setf (getf x 'prop1) 'val1) ⇒  VAL1
+ (eq (getf x 'prop1) 'val1) ⇒  true
+ (getf x 'prop1) ⇒  VAL1
+ (getf x 'prop1 7) ⇒  VAL1
+ x ⇒  (PROP1 VAL1)
+
+;; Examples of implementation variation permitted.
+ (setq foo (list 'a 'b 'c 'd 'e 'f)) ⇒  (A B C D E F)
+ (setq bar (cddr foo)) ⇒  (C D E F)
+ (remf foo 'c) ⇒  true
+ foo ⇒  (A B E F)
+ bar
+⇒  (C D E F)
+OR⇒ (C)
+OR⇒ (NIL)
+OR⇒ (C NIL)
+OR⇒ (C D)
+
    + +

    See Also::

    + +

    get +, +get-properties +, +setf +, +Function Call Forms as Places +

    +

    Notes::

    + +

    There is no way (using getf) to distinguish an absent property +from one whose value is default; but see get-properties. +

    +

    Note that while supplying a default argument to getf +in a setf situation is sometimes not very interesting, +it is still important because some macros, such as push and +incf, require a place argument which data is both read +from and written to. In such a context, if a default +argument is to be supplied for the read situation, it must be +syntactically valid for the write situation as well. For example, +

    +
    +
     (let ((plist '()))
+   (incf (getf plist 'count 0))
+   plist) ⇒  (COUNT 1)
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/gethash.html b/info/gcl/gethash.html new file mode 100644 index 0000000..c75d57b --- /dev/null +++ b/info/gcl/gethash.html @@ -0,0 +1,122 @@ + + + + + +gethash (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.9 gethash [Accessor]

    + +

    gethash key hash-table &optional default ⇒ value, present-p +

    +

    (setf ( gethash key hash-table &optional default) new-value)
    +

    +

    Arguments and Values::

    + +

    key—an object. +

    +

    hash-table—a hash table. +

    +

    default—an object. + The default is nil. +

    +

    value—an object. +

    +

    present-p—a generalized boolean. +

    +

    Description::

    + +

    Value is the object in hash-table whose key +is the same as key under the hash-table’s equivalence test. +If there is no such entry, value is the default. +

    +

    Present-p is true if an entry is found; otherwise, it is false. +

    +

    setf may be used with gethash to modify the value +associated with a given key, or to add a new entry. +

    +

    When a gethash form is used as a setf place, +any default which is supplied is evaluated according to normal +left-to-right evaluation rules, but its value is ignored. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32206334>
+ (gethash 1 table) ⇒  NIL, false
+ (gethash 1 table 2) ⇒  2, false
+ (setf (gethash 1 table) "one") ⇒  "one"
+ (setf (gethash 2 table "two") "two") ⇒  "two"
+ (gethash 1 table) ⇒  "one", true
+ (gethash 2 table) ⇒  "two", true
+ (gethash nil table) ⇒  NIL, false
+ (setf (gethash nil table) nil) ⇒  NIL 
+ (gethash nil table) ⇒  NIL, true
+ (defvar *counters* (make-hash-table)) ⇒  *COUNTERS*
+ (gethash 'foo *counters*) ⇒  NIL, false
+ (gethash 'foo *counters* 0) ⇒  0, false
+ (defmacro how-many (obj) `(values (gethash ,obj *counters* 0))) ⇒  HOW-MANY
+ (defun count-it (obj) (incf (how-many obj))) ⇒  COUNT-IT
+ (dolist (x '(bar foo foo bar bar baz)) (count-it x))
+ (how-many 'foo) ⇒  2
+ (how-many 'bar) ⇒  3
+ (how-many 'quux) ⇒  0
+
    + +

    See Also::

    + +

    remhash +

    +

    Notes::

    + +

    The secondary value, present-p, +can be used to distinguish the absence of an entry +from the presence of an entry that has a value of default. +

    +
    +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    + + + + + diff --git a/info/gcl/go.html b/info/gcl/go.html new file mode 100644 index 0000000..fbf1964 --- /dev/null +++ b/info/gcl/go.html @@ -0,0 +1,109 @@ + + + + + +go (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.24 go [Special Operator]

    + +

    go tag + ⇒ #<NoValue> +

    Arguments and Values::

    + +

    tag—a go tag. +

    +

    Description::

    + +

    go transfers control to the point in the body +of an enclosing tagbody form labeled by a +tag eql to tag. +If there is no such tag in the body, the +bodies of lexically containing tagbody forms +(if any) are examined as well. +If several tags are eql +to tag, control is transferred to +whichever matching tag +is contained in the innermost tagbody form that +contains the go. +The consequences are undefined +if there is no matching tag lexically visible +to the point of the go. +

    +

    The transfer of control initiated by go is performed +as described in Transfer of Control to an Exit Point. +

    +

    Examples::

    +
    +
     (tagbody
+   (setq val 2)
+   (go lp)
+   (incf val 3)
+   lp (incf val 4)) ⇒  NIL
+ val ⇒  6 
+
    + +

    The following is in error because there is a normal exit +of the tagbody before the +go is executed. +

    +
    +
     (let ((a nil)) 
+   (tagbody t (setq a #'(lambda () (go t))))
+   (funcall a))
+
    + +

    The following is in error because the tagbody is passed over +before the go form is executed. +

    +
    +
     (funcall (block nil
+            (tagbody a (return #'(lambda () (go a))))))
+
    + +

    See Also::

    + +

    tagbody +

    + + + + + diff --git a/info/gcl/graphic_002dchar_002dp.html b/info/gcl/graphic_002dchar_002dp.html new file mode 100644 index 0000000..4e474b0 --- /dev/null +++ b/info/gcl/graphic_002dchar_002dp.html @@ -0,0 +1,85 @@ + + + + + +graphic-char-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.12 graphic-char-p [Function]

    + +

    graphic-char-p char ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    char—a character. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if character is a graphic character; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (graphic-char-p #\G) ⇒  true
+ (graphic-char-p #\#) ⇒  true
+ (graphic-char-p #\Space) ⇒  true
+ (graphic-char-p #\Newline) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    +

    See Also::

    + +

    read +, +Character Syntax, +Documentation of Implementation-Defined Scripts +

    + + + + + diff --git a/info/gcl/handler_002dbind.html b/info/gcl/handler_002dbind.html new file mode 100644 index 0000000..89e5de3 --- /dev/null +++ b/info/gcl/handler_002dbind.html @@ -0,0 +1,136 @@ + + + + + +handler-bind (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.26 handler-bind [Macro]

    + +

    handler-bind ({!binding}*) + {form}* ⇒ {result}* +

    +

    binding ::=(type handler) +

    +

    Arguments and Values::

    + +

    type—a type specifier. +

    +

    handler—a form; evaluated to produce a handler-function. +

    +

    handler-function—a designator for a function of one argument. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    Executes forms in a dynamic environment where the indicated +handler bindings are in effect. +

    +

    Each handler should evaluate to a handler-function, +which is used to handle conditions of the given type +during execution of the forms. This function should +take a single argument, the condition being signaled. +

    +

    If more than one handler binding is supplied, +the handler bindings are searched sequentially from +top to bottom in search of a match (by visual analogy with typecase). +If an appropriate type is found, +the associated handler is run in a dynamic environment where none of these +handler bindings are visible (to avoid recursive errors). +If the handler declines, the search continues for another handler. +

    +

    If no appropriate handler is found, other handlers are sought +from dynamically enclosing contours. If no handler is found outside, +then signal returns or error enters the debugger. +

    +

    Examples::

    + +

    In the following code, if an unbound variable error is +signaled in the body (and not handled by an intervening handler), +the first function is called. +

    +
    +
     (handler-bind ((unbound-variable #'(lambda ...))
+                (error #'(lambda ...)))
+   ...)
+
    + +

    If any other kind of error is signaled, the second function is called. +In either case, neither handler is active while executing the code +in the associated function. +

    +
    +
     (defun trap-error-handler (condition)
+   (format *error-output* "~&~A~&" condition)
+   (throw 'trap-errors nil))
+
+ (defmacro trap-errors (&rest forms)
+   `(catch 'trap-errors
+      (handler-bind ((error #'trap-error-handler))
+        ,@forms)))
+
+ (list (trap-errors (signal "Foo.") 1)
+       (trap-errors (error  "Bar.") 2)
+       (+ 1 2))
+ |>  Bar.
+⇒  (1 NIL 3)
+
    + +

    Note that “Foo.” is not printed because the condition made +by signal is a simple condition, which is not of type error, +so it doesn’t trigger the handler for error set up by trap-errors. +

    +

    See Also::

    + +

    handler-case +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/handler_002dcase.html b/info/gcl/handler_002dcase.html new file mode 100644 index 0000000..6c2a776 --- /dev/null +++ b/info/gcl/handler_002dcase.html @@ -0,0 +1,220 @@ + + + + + +handler-case (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.27 handler-case [Macro]

    + +

    handler-case expression + [[{!error-clause}* | !no-error-clause]] ⇒ {result}* +

    +

    clause ::=!error-clause | !no-error-clause +

    +

    error-clause ::=(typespec ([var]) {declaration}* {form}*) +

    +

    no-error-clause ::=(:no-error lambda-list {declaration}* {form}*) +

    +

    Arguments and Values::

    + +

    expression—a form. +

    +

    typespec—a type specifier. +

    +

    var—a variable name. +

    +

    lambda-list—an ordinary lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    form—a form. +

    +

    results—In the normal situation, the values returned are those that result from + the evaluation of expression; + in the exceptional situation when control is transferred to a clause, + the value of the last form in that clause is returned. +

    +

    Description::

    + +

    handler-case executes expression in a dynamic environment where +various handlers are active. Each error-clause specifies how to +handle a condition matching the indicated typespec. +A no-error-clause allows the specification of a particular action +if control returns normally. +

    +

    If a condition is signaled for which there is an appropriate +error-clause during the execution of expression +(i.e., one for which (typep condition 'typespec) +returns true) and if there is no intervening handler for a +condition of that type, then control is transferred to +the body of the relevant error-clause. In this case, the +dynamic state is unwound appropriately (so that the handlers established +around the expression are no longer active), and var is bound to +the condition that had been signaled. +If more than one case is provided, those cases are made accessible +in parallel. That is, in +

    +
    +
      (handler-case form
+    (typespec1 (var1) form1)
+    (typespec2 (var2) form2))
+
    + +

    if the first clause (containing form1) has been selected, +the handler for the second is no longer visible (or vice versa). +

    +

    The clauses +are searched sequentially from top to bottom. If there is type + overlap between typespecs, +the earlier of the clauses is selected. +

    +

    If var +is not needed, it can be omitted. That is, a clause such as: +

    +
    +
      (typespec (var) (declare (ignore var)) form)
+
    + +

    can be written + (typespec () form). +

    +

    If there are no forms in a selected clause, the case, and therefore + handler-case, returns nil. + If execution of expression +returns normally and no no-error-clause + exists, the values returned by +expression are returned by handler-case. + If execution of +expression returns normally and a no-error-clause + does exist, the values returned are used as arguments to the function + described by constructing + (lambda lambda-list {form}*) + from the no-error-clause, and the values of that function call are + returned by handler-case. +The handlers which were established around the expression are no longer active at the time of this call. +

    +

    Examples::

    + +
    +
     (defun assess-condition (condition)
+   (handler-case (signal condition)
+     (warning () "Lots of smoke, but no fire.")
+     ((or arithmetic-error control-error cell-error stream-error)
+        (condition)
+       (format nil "~S looks especially bad." condition))
+     (serious-condition (condition)
+       (format nil "~S looks serious." condition))
+     (condition () "Hardly worth mentioning.")))
+⇒  ASSESS-CONDITION
+ (assess-condition (make-condition 'stream-error :stream *terminal-io*))
+⇒  "#<STREAM-ERROR 12352256> looks especially bad."
+ (define-condition random-condition (condition) () 
+   (:report (lambda (condition stream)
+              (declare (ignore condition))
+              (princ "Yow" stream))))
+⇒  RANDOM-CONDITION
+ (assess-condition (make-condition 'random-condition))
+⇒  "Hardly worth mentioning."
+
    + +

    See Also::

    + +

    handler-bind +, +ignore-errors +, +Condition System Concepts +

    +

    Notes::

    + +
    +
     (handler-case form
+   (type1 (var1) . body1)
+   (type2 (var2) . body2) ...)
+
    + +

    is approximately equivalent to: +

    +
    +
     (block #1=#:g0001
+   (let ((#2=#:g0002 nil))
+     (tagbody
+       (handler-bind ((type1 #'(lambda (temp)
+                                       (setq #1# temp)
+                                       (go #3=#:g0003)))
+                      (type2 #'(lambda (temp)
+                                       (setq #2# temp)
+                                       (go #4=#:g0004))) ...)
+       (return-from #1# form))
+         #3# (return-from #1# (let ((var1 #2#)) . body1))
+         #4# (return-from #1# (let ((var2 #2#)) . body2)) ...)))
+
    + +
    +
     (handler-case form
+   (type1 (var1) . body1)
+   ...
+   (:no-error (varN-1 varN-2 ...) . bodyN))
+
    + +

    is approximately equivalent to: +

    +
    +
    +
+ (block #1=#:error-return
+  (multiple-value-call #'(lambda (varN-1 varN-2 ...) . bodyN)
+     (block #2=#:normal-return
+       (return-from #1#
+         (handler-case (return-from #2# form)
+           (type1 (var1) . body1) ...)))))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/hash_002dtable.html b/info/gcl/hash_002dtable.html new file mode 100644 index 0000000..8b89f84 --- /dev/null +++ b/info/gcl/hash_002dtable.html @@ -0,0 +1,72 @@ + + + + + +hash-table (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.1 hash-table [System Class]

    + +

    Class Precedence List::

    +

    hash-table, +t +

    +

    Description::

    + +

    Hash tables provide a way of mapping any object (a key) +to an associated object (a value). +

    +

    See Also::

    + +

    Hash Table Concepts, +Printing Other Objects +

    +

    Notes::

    + +

    The intent is that this mapping be implemented by a hashing mechanism, +such as that described in Section 6.4 “Hashing” of The Art of Computer Programming, Volume 3 +(pp506-549). In spite of this intent, no conforming implementation +is required to use any particular technique to implement the mapping. +

    + + + + + diff --git a/info/gcl/hash_002dtable_002dcount.html b/info/gcl/hash_002dtable_002dcount.html new file mode 100644 index 0000000..68d926d --- /dev/null +++ b/info/gcl/hash_002dtable_002dcount.html @@ -0,0 +1,103 @@ + + + + + +hash-table-count (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.4 hash-table-count [Function]

    + +

    hash-table-count hash-table ⇒ count +

    +

    Arguments and Values::

    + +

    hash-table—a hash table. +

    +

    count—a non-negative integer. +

    +

    Description::

    + +

    Returns the number of entries in the hash-table. +If hash-table has just been created +or newly cleared (see clrhash) +the entry count is 0. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32115135>
+ (hash-table-count table) ⇒  0
+ (setf (gethash 57 table) "fifty-seven") ⇒  "fifty-seven"
+ (hash-table-count table) ⇒  1
+ (dotimes (i 100) (setf (gethash i table) i)) ⇒  NIL
+ (hash-table-count table) ⇒  100
+
    + +

    Affected By::

    + +

    clrhash, +remhash, +setf of gethash +

    +

    See Also::

    + +

    hash-table-size +

    +

    Notes::

    + +

    The following relationships are functionally correct, although in practice +using hash-table-count is probably much faster: +

    +
    +
     (hash-table-count table) ≡
+ (loop for value being the hash-values of table count t) ≡
+ (let ((total 0))
+   (maphash #'(lambda (key value)
+                (declare (ignore key value))
+                (incf total))
+            table)
+   total)
+
    + + + + + + diff --git a/info/gcl/hash_002dtable_002dp.html b/info/gcl/hash_002dtable_002dp.html new file mode 100644 index 0000000..5c5e146 --- /dev/null +++ b/info/gcl/hash_002dtable_002dp.html @@ -0,0 +1,79 @@ + + + + + +hash-table-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.3 hash-table-p [Function]

    + +

    hash-table-p object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type hash-table; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32511220>
+ (hash-table-p table) ⇒  true
+ (hash-table-p 37) ⇒  false
+ (hash-table-p '((a . 1) (b . 2))) ⇒  false
+
    + +

    Notes::

    + +
    +
     (hash-table-p object) ≡ (typep object 'hash-table)
+
    + + + + + + diff --git a/info/gcl/hash_002dtable_002drehash_002dsize.html b/info/gcl/hash_002dtable_002drehash_002dsize.html new file mode 100644 index 0000000..d505ea7 --- /dev/null +++ b/info/gcl/hash_002dtable_002drehash_002dsize.html @@ -0,0 +1,99 @@ + + + + + +hash-table-rehash-size (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.5 hash-table-rehash-size [Function]

    + +

    hash-table-rehash-size hash-table ⇒ rehash-size +

    +

    Arguments and Values::

    + +

    hash-table—a hash table. +

    +

    rehash-size—a real of type (or (integer 1 *) (float (1.0) *)). +

    +

    Description::

    + +

    Returns the current rehash size of hash-table, +suitable for use in a call to make-hash-table +in order to produce a hash table +with state corresponding to the current state of the hash-table. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table :size 100 :rehash-size 1.4))
+⇒  #<HASH-TABLE EQL 0/100 2556371>
+ (hash-table-rehash-size table) ⇒  1.4
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if hash-table is not a hash table. +

    +

    See Also::

    + +

    make-hash-table +, +hash-table-rehash-threshold +

    +

    Notes::

    + +

    If the hash table was created with an integer rehash size, +the result is an integer, +indicating that the rate of growth of the hash-table when rehashed +is intended to be additive; +otherwise, +the result is a float, +indicating that the rate of growth of the hash-table when rehashed +is intended to be multiplicative. +However, this value is only advice to the implementation; +the actual amount by which the hash-table will grow upon rehash is +implementation-dependent. +

    + + + + + diff --git a/info/gcl/hash_002dtable_002drehash_002dthreshold.html b/info/gcl/hash_002dtable_002drehash_002dthreshold.html new file mode 100644 index 0000000..3bff7fa --- /dev/null +++ b/info/gcl/hash_002dtable_002drehash_002dthreshold.html @@ -0,0 +1,85 @@ + + + + + +hash-table-rehash-threshold (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.6 hash-table-rehash-threshold [Function]

    + +

    hash-table-rehash-threshold hash-table ⇒ rehash-threshold +

    +

    Arguments and Values::

    + +

    hash-table—a hash table. +

    +

    rehash-threshold—a real of type (real 0 1). +

    +

    Description::

    + +

    Returns the current rehash threshold of hash-table, which is +suitable for use in a call to make-hash-table in order to +produce a hash table with state corresponding to the current +state of the hash-table. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table :size 100 :rehash-threshold 0.5))
+⇒  #<HASH-TABLE EQL 0/100 2562446>
+ (hash-table-rehash-threshold table) ⇒  0.5
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if hash-table is not a hash table. +

    +

    See Also::

    + +

    make-hash-table +, +hash-table-rehash-size +

    + + + + + diff --git a/info/gcl/hash_002dtable_002dsize.html b/info/gcl/hash_002dtable_002dsize.html new file mode 100644 index 0000000..4d89ee4 --- /dev/null +++ b/info/gcl/hash_002dtable_002dsize.html @@ -0,0 +1,76 @@ + + + + + +hash-table-size (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.7 hash-table-size [Function]

    + +

    hash-table-size hash-table ⇒ size +

    +

    Arguments and Values::

    + +

    hash-table—a hash table. +

    +

    size—a non-negative integer. +

    +

    Description::

    + +

    Returns the current size of hash-table, which is suitable for use in +a call to make-hash-table in order to produce a hash table +with state corresponding to the current state of the hash-table. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if hash-table is not a hash table. +

    +

    See Also::

    + +

    hash-table-count +, +make-hash-table +

    + + + + + diff --git a/info/gcl/hash_002dtable_002dtest.html b/info/gcl/hash_002dtable_002dtest.html new file mode 100644 index 0000000..a7b40f6 --- /dev/null +++ b/info/gcl/hash_002dtable_002dtest.html @@ -0,0 +1,77 @@ + + + + + +hash-table-test (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.8 hash-table-test [Function]

    + +

    hash-table-test hash-table ⇒ test +

    +

    Arguments and Values::

    + +

    hash-table—a hash table. +

    +

    test—a function designator. + For the four standardized hash table test functions + (see make-hash-table), the test value returned + is always a symbol. If an implementation permits additional + tests, it is implementation-dependent whether such tests are + returned as function objects or function names. +

    +

    Description::

    + +

    Returns the test used for comparing keys in hash-table. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if hash-table is not a hash table. +

    +

    See Also::

    + +

    make-hash-table +

    + + + + + diff --git a/info/gcl/identity.html b/info/gcl/identity.html new file mode 100644 index 0000000..62dfab3 --- /dev/null +++ b/info/gcl/identity.html @@ -0,0 +1,83 @@ + + + + + +identity (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.37 identity [Function]

    + +

    identity object ⇒ object +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    Description::

    + +

    Returns its argument object. +

    +

    Examples::

    + +
    +
     (identity 101) ⇒  101
+ (mapcan #'identity (list (list 1 2 3) '(4 5 6))) ⇒  (1 2 3 4 5 6)
+
    + +

    Notes::

    + +

    identity is intended for use with functions that require +a function as an argument. +

    +

    (eql x (identity x)) returns true for all possible values of x, +but (eq x (identity x)) might return false when x is a number +or character. +

    +

    identity could be defined by +

    +
    +
    (defun identity (x) x)
+
    + + + + + + diff --git a/info/gcl/if.html b/info/gcl/if.html new file mode 100644 index 0000000..2928817 --- /dev/null +++ b/info/gcl/if.html @@ -0,0 +1,107 @@ + + + + + +if (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.43 if [Special Operator]

    + +

    if test-form then-form [else-form] ⇒ {result}* +

    +

    Arguments and Values::

    + +

    Test-form—a form. +

    +

    Then-form—a form. +

    +

    Else-form—a form. + The default is nil. +

    +

    results—if the test-form yielded true, + the values returned by the then-form; otherwise, + the values returned by the else-form. +

    +

    Description::

    + +

    if allows the execution of a form to be dependent +on a single test-form. +

    +

    First test-form is evaluated. +If the result is true, then then-form is selected; +otherwise else-form is selected. +Whichever form is selected is then evaluated. +

    +

    Examples::

    + +
    +
     (if t 1) ⇒  1
+ (if nil 1 2) ⇒  2 
+ (defun test ()
+   (dolist (truth-value '(t nil 1 (a b c)))
+     (if truth-value (print 'true) (print 'false))
+     (prin1 truth-value))) ⇒  TEST
+ (test)
+ |>  TRUE T
+ |>  FALSE NIL
+ |>  TRUE 1
+ |>  TRUE (A B C)
+⇒  NIL
+
    + +

    See Also::

    + +

    cond +, +unless, +when +

    +

    Notes::

    + +
    +
     (if test-form then-form else-form)
+ ≡ (cond (test-form then-form) (t else-form))
+
    + + + + + + diff --git a/info/gcl/ignore.html b/info/gcl/ignore.html new file mode 100644 index 0000000..2e0ea56 --- /dev/null +++ b/info/gcl/ignore.html @@ -0,0 +1,132 @@ + + + + + +ignore (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.19 ignore, ignorable [Declaration]

    + +

    Syntax::

    + +

    (ignore {var | (function fn)}*) +

    +

    (ignorable {var | (function fn)}*) +

    +

    Arguments::

    + +

    var—a variable name. +

    +

    fn—a function name. +

    +

    Valid Context::

    + +

    declaration +

    +

    Binding Types Affected::

    + +

    variable, function +

    +

    Description::

    + +

    The ignore and ignorable declarations +refer to for-value references + to variable bindings for the vars +and to function bindings for the fns. +

    +

    An ignore declaration specifies that +for-value references to the indicated bindings +will not +occur within the scope of the declaration. +Within the scope of such a declaration, +it is desirable +for a compiler to issue a warning about +the presence of +either a for-value reference to any var or fn, + or a special declaration for any var. +

    +

    An ignorable declaration specifies that +for-value references to the indicated bindings +might or might not +occur within the scope of the declaration. +Within the scope of such a declaration, +it is not desirable +for a compiler to issue a warning about +the presence or absence of +either a for-value reference to any var or fn, + or a special declaration for any var. +

    +

    When not within the scope +of a ignore or ignorable declaration, +it is desirable +for a compiler to issue a warning about +any var for which there is +neither a for-value reference + nor a special declaration, +or about +any fn for which there is + no for-value reference. +

    +

    Any warning about a “used” or “unused” binding must be of type style-warning, +and may not affect program semantics. +

    +

    The stream variables established by + with-open-file, + with-open-stream, + with-input-from-string, + and with-output-to-string, +and all iteration variables are, by definition, always “used”. +Using (declare (ignore v)), +for such a variable v has unspecified consequences. +

    +

    See Also::

    + +

    declare +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/ignore_002derrors.html b/info/gcl/ignore_002derrors.html new file mode 100644 index 0000000..a0d603e --- /dev/null +++ b/info/gcl/ignore_002derrors.html @@ -0,0 +1,117 @@ + + + + + +ignore-errors (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.28 ignore-errors [Macro]

    + +

    ignore-errors {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    forms—an implicit progn. +

    +

    results—In the normal situation, + the values of the forms are returned; + in the exceptional situation, + two values are returned: nil and the condition. +

    +

    Description::

    + +

    ignore-errors is used to prevent conditions of type error +from causing entry into the debugger. +

    +

    Specifically, ignore-errors executes forms +in a dynamic environment where a handler for +conditions of type error has been established; +if invoked, it handles such conditions by +returning two values, nil and the condition that was signaled, +from the ignore-errors form. +

    +

    If a normal return from the forms occurs, +any values returned are returned by ignore-errors. +

    +

    Examples::

    + +
    +
     (defun load-init-file (program)
+   (let ((win nil))
+     (ignore-errors ;if this fails, don't enter debugger
+       (load (merge-pathnames (make-pathname :name program :type :lisp)
+                              (user-homedir-pathname)))
+       (setq win t))
+     (unless win (format t "~&Init file failed to load.~
+     win))
+
+ (load-init-file "no-such-program")
+ |>  Init file failed to load.
+NIL
+
    + +

    See Also::

    + +

    handler-case +, Condition System Concepts +

    +

    Notes::

    + +
    +
     (ignore-errors . forms)
+
    + +

    is equivalent to: +

    +
    +
     (handler-case (progn . forms)
+   (error (condition) (values nil condition)))
+
    + +

    Because the second return value is a condition +in the exceptional case, it is common (but not required) to arrange +for the second return value in the normal case to be missing or nil so +that the two situations can be distinguished. +

    + + + + + diff --git a/info/gcl/import.html b/info/gcl/import.html new file mode 100644 index 0000000..6468008 --- /dev/null +++ b/info/gcl/import.html @@ -0,0 +1,137 @@ + + + + + +import (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.6 import [Function]

    + +

    import symbols &optional package ⇒ t +

    +

    Arguments and Values::

    + +

    symbols—a designator for a list of symbols. +

    +

    package—a package designator. +

    +

    The default is the current package. +

    +

    Description::

    + +

    import adds symbol or +symbols to the internals of package, checking for name +conflicts with existing symbols either present in package +or accessible to it. Once the symbols have been +imported, they may be referenced in the importing +package without the use of a package prefix when using the Lisp reader. +

    +

    A name conflict in import between the +symbol being imported and a symbol inherited from some other package can +be resolved in favor of the +symbol being imported +by making it a shadowing symbol, or in favor +of the symbol already accessible by +not doing the import. A +name conflict in import with a symbol +already present in the +package +may be resolved by uninterning that symbol, or by not +doing the import. +

    +

    The imported symbol is +not automatically exported from the current package, but if it is +already present and external, then the fact that it +is external is not changed. +

    +

    If any symbol to be imported has no home +package (i.e., (symbol-package symbol) ⇒ nil), +import sets the home package +of the symbol to package. +

    +

    If the symbol is already present in the importing package, +import has no effect. +

    +

    Examples::

    + +
    +
     (import 'common-lisp::car (make-package 'temp :use nil)) ⇒  T
+ (find-symbol "CAR" 'temp) ⇒  CAR, :INTERNAL
+ (find-symbol "CDR" 'temp) ⇒  NIL, NIL 
+
    + +

    The form (import 'editor:buffer) takes the external symbol named +buffer in the EDITOR package (this symbol was located when the form +was read by the Lisp reader) and adds it to the current package +as an internal symbol. The symbol buffer is then present in +the current package. +

    +

    Side Effects::

    + +

    The package system is modified. +

    +

    Affected By::

    + +

    Current state of the package system. +

    +

    Exceptional Situations::

    + +

    import signals a correctable error of type package-error +if any of the symbols to be imported has the same name +(under string=) as some distinct symbol (under eql) +already accessible in the package, even if the conflict is +with a shadowing symbol of the package. +

    +

    See Also::

    + +

    shadow +, +export +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/in_002dpackage.html b/info/gcl/in_002dpackage.html new file mode 100644 index 0000000..2dfe4c4 --- /dev/null +++ b/info/gcl/in_002dpackage.html @@ -0,0 +1,82 @@ + + + + + +in-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.16 in-package [Macro]

    + +

    in-package name ⇒ package +

    +

    Arguments and Values::

    + +

    name—a string designator; not evaluated. +

    +

    package—the package named by name. +

    +

    Description::

    + +

    Causes the the package named by name +to become the current package—that is, the value of *package*. +If no such package already exists, an error of type package-error is signaled. +

    +

    Everything in-package does is also performed at compile time +if the call appears as a top level form. +

    +

    Side Effects::

    + +

    The variable *package* is assigned. +If the in-package form is a top level form, +this assignment also occurs at compile time. +

    +

    Exceptional Situations::

    + +

    An error of type package-error is signaled if the specified package does not exist. +

    +

    See Also::

    + +

    package +

    + + + + + diff --git a/info/gcl/incf.html b/info/gcl/incf.html new file mode 100644 index 0000000..8a25c7a --- /dev/null +++ b/info/gcl/incf.html @@ -0,0 +1,106 @@ + + + + + +incf (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.33 incf, decf [Macro]

    + +

    incf place [delta-form] ⇒ new-value +

    +

    decf place [delta-form] ⇒ new-value +

    +

    Arguments and Values::

    + +

    place—a place. +

    +

    delta-form—a form; evaluated to produce a delta. + The default is 1. +

    +

    delta—a number. +

    +

    new-value—a number. +

    +

    Description::

    + +

    incf and decf are used for incrementing and +decrementing the value of place, respectively. +

    +

    The delta is + added to (in the case of incf) + or subtracted from (in the case of decf) +the number in place and the result is stored in place. +

    +

    Any necessary type conversions are performed automatically. +

    +

    For information about the evaluation of subforms of places, +see Evaluation of Subforms to Places. +

    +

    Examples::

    +
    +
     (setq n 0)
+ (incf n) ⇒  1      
+ n ⇒  1
+ (decf n 3) ⇒  -2   
+ n ⇒  -2
+ (decf n -5) ⇒  3      
+ (decf n) ⇒  2      
+ (incf n 0.5) ⇒  2.5
+ (decf n) ⇒  1.5
+ n ⇒  1.5
+
    + +

    Side Effects::

    + +

    Place is modified. +

    +

    See Also::

    + +

    +, +- +, 1+, 1-, +setf +

    + + + + + diff --git a/info/gcl/index.html b/info/gcl/index.html new file mode 100644 index 0000000..b36c65f --- /dev/null +++ b/info/gcl/index.html @@ -0,0 +1,3651 @@ + + + + + +Top (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + +

    ANSI and GNU Common Lisp Document

    + + + + +
    +

    +Next: , Previous: , Up: (dir)  

    +
    +
    +

    Top

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    • Introduction (Introduction)   +
    • Syntax   +
    • Evaluation and Compilation   +
    • Types and Classes   +
    • Data and Control Flow   +
    • Iteration   +
    • Objects   +
    • Structures   +
    • Conditions   +
    • Symbols   +
    • Packages   +
    • Numbers (Numbers)   +
    • Characters   +
    • Conses   +
    • Arrays   +
    • Strings   +
    • Sequences   +
    • Hash Tables   +
    • Filenames   +
    • Files   +
    • Streams   +
    • Printer   +
    • Reader   +
    • System Construction   +
    • Environment   +
    • Glossary (Glossary)   +
    • Appendix   +
    +
+ — The Detailed Node Listing —
+
+Introduction
+
+
    • Scope   +
    • Organization of the Document   +
    • Referenced Publications   +
    • Definitions   +
    • Conformance   +
    • Language Extensions   +
    • Language Subsets   +
    • Deprecated Language Features   +
    • Symbols in the COMMON-LISP Package   +
    +
+Scope, Purpose, and History
+
+
    • Scope and Purpose   +
    • History   +
    +
+Definitions
+
+
    • Notational Conventions   +
    • Error Terminology   +
    • Sections Not Formally Part Of This Standard   +
    • Interpreting Dictionary Entries   +
    +
+Notational Conventions
+
+
    • Font Key   +
    • Modified BNF Syntax   +
    • Splicing in Modified BNF Syntax   +
    • Indirection in Modified BNF Syntax   +
    • Additional Uses for Indirect Definitions in Modified BNF Syntax   +
    • Special Symbols   +
    • Objects with Multiple Notations   +
    • Case in Symbols   +
    • Numbers (Objects with Multiple Notations)   +
    • Use of the Dot Character   +
    • NIL   +
    • Designators   +
    • Nonsense Words   +
    +
+Interpreting Dictionary Entries
+
+
    • The "Affected By" Section of a Dictionary Entry   +
    • The "Arguments" Section of a Dictionary Entry   +
    • The "Arguments and Values" Section of a Dictionary Entry   +
    • The "Binding Types Affected" Section of a Dictionary Entry   +
    • The "Class Precedence List" Section of a Dictionary Entry   +
    • Dictionary Entries for Type Specifiers   +
    • The "Compound Type Specifier Kind" Section of a Dictionary Entry   +
    • The "Compound Type Specifier Syntax" Section of a Dictionary Entry   +
    • The "Compound Type Specifier Arguments" Section of a Dictionary Entry   +
    • The "Compound Type Specifier Description" Section of a Dictionary Entry   +
    • The "Constant Value" Section of a Dictionary Entry   +
    • The "Description" Section of a Dictionary Entry   +
    • The "Examples" Section of a Dictionary Entry   +
    • The "Exceptional Situations" Section of a Dictionary Entry   +
    • The "Initial Value" Section of a Dictionary Entry   +
    • The "Argument Precedence Order" Section of a Dictionary Entry   +
    • The "Method Signature" Section of a Dictionary Entry   +
    • The "Name" Section of a Dictionary Entry   +
    • The "Notes" Section of a Dictionary Entry   +
    • The "Pronunciation" Section of a Dictionary Entry   +
    • The "See Also" Section of a Dictionary Entry   +
    • The "Side Effects" Section of a Dictionary Entry   +
    • The "Supertypes" Section of a Dictionary Entry   +
    • The "Syntax" Section of a Dictionary Entry   +
    • Special "Syntax" Notations for Overloaded Operators   +
    • Naming Conventions for Rest Parameters   +
    • Requiring Non-Null Rest Parameters in The "Syntax" Section   +
    • Return values in The "Syntax" Section   +
    • No Arguments or Values in The "Syntax" Section   +
    • Unconditional Transfer of Control in The "Syntax" Section   +
    • The "Valid Context" Section of a Dictionary Entry   +
    • The "Value Type" Section of a Dictionary Entry   +
    +
+Conformance
+
+
    • Conforming Implementations   +
    • Conforming Programs   +
    +
+Conforming Implementations
+
+
    • Required Language Features   +
    • Documentation of Implementation-Dependent Features   +
    • Documentation of Extensions   +
    • Treatment of Exceptional Situations   +
    • Resolution of Apparent Conflicts in Exceptional Situations   +
    • Examples of Resolution of Apparent Conflict in Exceptional Situations   +
    • Conformance Statement   +
    +
+Conforming Programs
+
+
    • Use of Implementation-Defined Language Features   +
    • Use of Read-Time Conditionals   +
    +
+Deprecated Language Features
+
+
    • Deprecated Functions   +
    • Deprecated Argument Conventions   +
    • Deprecated Variables   +
    • Deprecated Reader Syntax   +
    +
+Syntax
+
+
    • Character Syntax   +
    • Reader Algorithm   +
    • Interpretation of Tokens   +
    • Standard Macro Characters   +
    +
+Character Syntax
+
+
    • Readtables   +
    • Variables that affect the Lisp Reader   +
    • Standard Characters   +
    • Character Syntax Types   +
    +
+Readtables
+
+
    • The Current Readtable   +
    • The Standard Readtable   +
    • The Initial Readtable   +
    +
+Character Syntax Types
+
+
    • Constituent Characters   +
    • Constituent Traits   +
    • Invalid Characters   +
    • Macro Characters   +
    • Multiple Escape Characters   +
    • Examples of Multiple Escape Characters   +
    • Single Escape Character   +
    • Examples of Single Escape Characters   +
    • Whitespace Characters   +
    • Examples of Whitespace Characters   +
    +
+Interpretation of Tokens
+
+
    • Numbers as Tokens   +
    • Constructing Numbers from Tokens   +
    • The Consing Dot   +
    • Symbols as Tokens   +
    • Valid Patterns for Tokens   +
    • Package System Consistency Rules   +
    +
+Numbers as Tokens
+
+
    • Potential Numbers as Tokens   +
    • Escape Characters and Potential Numbers   +
    • Examples of Potential Numbers   +
    +
+Constructing Numbers from Tokens
+
+
    • Syntax of a Rational   +
    • Syntax of an Integer   +
    • Syntax of a Ratio   +
    • Syntax of a Float   +
    • Syntax of a Complex   +
    +
+Standard Macro Characters
+
+
    • Left-Parenthesis   +
    • Right-Parenthesis   +
    • Single-Quote   +
    • Semicolon   +
    • Double-Quote   +
    • Backquote   +
    • Comma   +
    • Sharpsign   +
    • Re-Reading Abbreviated Expressions   +
    +
+Single-Quote
+
+
    • Examples of Single-Quote   +
    +
+Semicolon
+
+
    • Examples of Semicolon   +
    • Notes about Style for Semicolon   +
    • Use of Single Semicolon   +
    • Use of Double Semicolon   +
    • Use of Triple Semicolon   +
    • Use of Quadruple Semicolon   +
    • Examples of Style for Semicolon   +
    +
+Backquote
+
+
    • Notes about Backquote   +
    +
+Sharpsign
+
+
    • Sharpsign Backslash   +
    • Sharpsign Single-Quote   +
    • Sharpsign Left-Parenthesis   +
    • Sharpsign Asterisk   +
    • Examples of Sharpsign Asterisk   +
    • Sharpsign Colon   +
    • Sharpsign Dot   +
    • Sharpsign B   +
    • Sharpsign O   +
    • Sharpsign X   +
    • Sharpsign R   +
    • Sharpsign C   +
    • Sharpsign A   +
    • Sharpsign S   +
    • Sharpsign P   +
    • Sharpsign Equal-Sign   +
    • Sharpsign Sharpsign   +
    • Sharpsign Plus   +
    • Sharpsign Minus   +
    • Sharpsign Vertical-Bar   +
    • Examples of Sharpsign Vertical-Bar   +
    • Notes about Style for Sharpsign Vertical-Bar   +
    • Sharpsign Less-Than-Sign   +
    • Sharpsign Whitespace   +
    • Sharpsign Right-Parenthesis   +
    +
+Evaluation and Compilation
+
+
    • Evaluation   +
    • Compilation   +
    • Declarations   +
    • Lambda Lists   +
    • Error Checking in Function Calls   +
    • Traversal Rules and Side Effects   +
    • Destructive Operations   +
    • Evaluation and Compilation Dictionary   +
    +
+Evaluation
+
+
    • Introduction to Environments   +
    • The Evaluation Model   +
    • Lambda Expressions   +
    • Closures and Lexical Binding   +
    • Shadowing   +
    • Extent   +
    • Return Values   +
    +
+Introduction to Environments
+
+
    • The Global Environment   +
    • Dynamic Environments   +
    • Lexical Environments   +
    • The Null Lexical Environment   +
    • Environment Objects   +
    +
+The Evaluation Model
+
+
    • Form Evaluation   +
    • Symbols as Forms   +
    • Lexical Variables   +
    • Dynamic Variables   +
    • Constant Variables   +
    • Symbols Naming Both Lexical and Dynamic Variables   +
    • Conses as Forms   +
    • Special Forms   +
    • Macro Forms   +
    • Function Forms   +
    • Lambda Forms   +
    • Self-Evaluating Objects   +
    • Examples of Self-Evaluating Objects   +
    +
+Compilation
+
+
    • Compiler Terminology   +
    • Compilation Semantics   +
    • File Compilation   +
    • Literal Objects in Compiled Files   +
    • Exceptional Situations in the Compiler   +
    +
+Compilation Semantics
+
+
    • Compiler Macros   +
    • Purpose of Compiler Macros   +
    • Naming of Compiler Macros   +
    • When Compiler Macros Are Used   +
    • Notes about the Implementation of Compiler Macros   +
    • Minimal Compilation   +
    • Semantic Constraints   +
    +
+File Compilation
+
+
    • Processing of Top Level Forms   +
    • Processing of Defining Macros   +
    • Constraints on Macros and Compiler Macros   +
    +
+Literal Objects in Compiled Files
+
+
    • Externalizable Objects   +
    • Similarity of Literal Objects   +
    • Similarity of Aggregate Objects   +
    • Definition of Similarity   +
    • Extensions to Similarity Rules   +
    • Additional Constraints on Externalizable Objects   +
    +
+Declarations
+
+
    • Minimal Declaration Processing Requirements   +
    • Declaration Specifiers   +
    • Declaration Identifiers   +
    • Declaration Scope   +
    +
+Declaration Identifiers
+
+
    • Shorthand notation for Type Declarations   +
    +
+Declaration Scope
+
+
    • Examples of Declaration Scope   +
    +
+Lambda Lists
+
+
    • Ordinary Lambda Lists   +
    • Generic Function Lambda Lists   +
    • Specialized Lambda Lists   +
    • Macro Lambda Lists   +
    • Destructuring Lambda Lists   +
    • Boa Lambda Lists   +
    • Defsetf Lambda Lists   +
    • Deftype Lambda Lists   +
    • Define-modify-macro Lambda Lists   +
    • Define-method-combination Arguments Lambda Lists   +
    • Syntactic Interaction of Documentation Strings and Declarations   +
    +
+Ordinary Lambda Lists
+
+
    • Specifiers for the required parameters   +
    • Specifiers for optional parameters   +
    • A specifier for a rest parameter   +
    • Specifiers for keyword parameters   +
    • Suppressing Keyword Argument Checking   +
    • Examples of Suppressing Keyword Argument Checking   +
    • Specifiers for &aux variables   +
    • Examples of Ordinary Lambda Lists   +
    +
+Macro Lambda Lists
+
+
    • Destructuring by Lambda Lists   +
    • Data-directed Destructuring by Lambda Lists   +
    • Examples of Data-directed Destructuring by Lambda Lists   +
    • Lambda-list-directed Destructuring by Lambda Lists   +
    +
+Error Checking in Function Calls
+
+
    • Argument Mismatch Detection   +
    +
+Argument Mismatch Detection
+
+
    • Safe and Unsafe Calls   +
    • Error Detection Time in Safe Calls   +
    • Too Few Arguments   +
    • Too Many Arguments   +
    • Unrecognized Keyword Arguments   +
    • Invalid Keyword Arguments   +
    • Odd Number of Keyword Arguments   +
    • Destructuring Mismatch   +
    • Errors When Calling a Next Method   +
    +
+Destructive Operations
+
+
    • Modification of Literal Objects   +
    • Transfer of Control during a Destructive Operation   +
    +
+Transfer of Control during a Destructive Operation
+
+
    • Examples of Transfer of Control during a Destructive Operation   +
    +
+Evaluation and Compilation Dictionary
+
+
    • lambda (Symbol)   +
    • lambda   +
    • compile   +
    • eval   +
    • eval-when   +
    • load-time-value   +
    • quote   +
    • compiler-macro-function   +
    • define-compiler-macro   +
    • defmacro   +
    • macro-function   +
    • macroexpand   +
    • define-symbol-macro   +
    • symbol-macrolet   +
    • *macroexpand-hook*   +
    • proclaim   +
    • declaim   +
    • declare   +
    • ignore   +
    • dynamic-extent   +
    • type   +
    • inline   +
    • ftype   +
    • declaration   +
    • optimize   +
    • special   +
    • locally   +
    • the   +
    • special-operator-p   +
    • constantp   +
    +
+Types and Classes
+
+
    • Introduction (Types and Classes)   +
    • Types   +
    • Classes   +
    • Types and Classes Dictionary   +
    +
+Types
+
+
    • Data Type Definition   +
    • Type Relationships   +
    • Type Specifiers   +
    +
+Classes
+
+
    • Introduction to Classes   +
    • Defining Classes   +
    • Creating Instances of Classes   +
    • Inheritance   +
    • Determining the Class Precedence List   +
    • Redefining Classes   +
    • Integrating Types and Classes   +
    +
+Introduction to Classes
+
+
    • Standard Metaclasses   +
    +
+Inheritance
+
+
    • Examples of Inheritance   +
    • Inheritance of Class Options   +
    +
+Determining the Class Precedence List
+
+
    • Topological Sorting   +
    • Examples of Class Precedence List Determination   +
    +
+Redefining Classes
+
+
    • Modifying the Structure of Instances   +
    • Initializing Newly Added Local Slots (Redefining Classes)   +
    • Customizing Class Redefinition   +
    +
+Types and Classes Dictionary
+
+
    • nil (Type)   +
    • boolean   +
    • function (System Class)   +
    • compiled-function   +
    • generic-function   +
    • standard-generic-function   +
    • class   +
    • built-in-class   +
    • structure-class   +
    • standard-class   +
    • method   +
    • standard-method   +
    • structure-object   +
    • standard-object   +
    • method-combination   +
    • t (System Class)   +
    • satisfies   +
    • member (Type Specifier)   +
    • not (Type Specifier)   +
    • and (Type Specifier)   +
    • or (Type Specifier)   +
    • values (Type Specifier)   +
    • eql (Type Specifier)   +
    • coerce   +
    • deftype   +
    • subtypep   +
    • type-of   +
    • typep   +
    • type-error   +
    • type-error-datum   +
    • simple-type-error   +
    +
+Data and Control Flow
+
+
    • Generalized Reference   +
    • Transfer of Control to an Exit Point   +
    • Data and Control Flow Dictionary   +
    +
+Generalized Reference
+
+
    • Overview of Places and Generalized Reference   +
    • Kinds of Places   +
    • Treatment of Other Macros Based on SETF   +
    +
+Overview of Places and Generalized Reference
+
+
    • Evaluation of Subforms to Places   +
    • Examples of Evaluation of Subforms to Places   +
    • Setf Expansions   +
    • Examples of Setf Expansions   +
    +
+Kinds of Places
+
+
    • Variable Names as Places   +
    • Function Call Forms as Places   +
    • VALUES Forms as Places   +
    • THE Forms as Places   +
    • APPLY Forms as Places   +
    • Setf Expansions and Places   +
    • Macro Forms as Places   +
    • Symbol Macros as Places   +
    • Other Compound Forms as Places   +
    +
+Data and Control Flow Dictionary
+
+
    • apply   +
    • defun   +
    • fdefinition   +
    • fboundp   +
    • fmakunbound   +
    • flet   +
    • funcall   +
    • function (Special Operator)   +
    • function-lambda-expression   +
    • functionp   +
    • compiled-function-p   +
    • call-arguments-limit   +
    • lambda-list-keywords   +
    • lambda-parameters-limit   +
    • defconstant   +
    • defparameter   +
    • destructuring-bind   +
    • let   +
    • progv   +
    • setq   +
    • psetq   +
    • block   +
    • catch   +
    • go   +
    • return-from   +
    • return   +
    • tagbody   +
    • throw   +
    • unwind-protect   +
    • nil   +
    • not   +
    • t   +
    • eq   +
    • eql   +
    • equal   +
    • equalp   +
    • identity   +
    • complement   +
    • constantly   +
    • every   +
    • and   +
    • cond   +
    • if   +
    • or   +
    • when   +
    • case   +
    • typecase   +
    • multiple-value-bind   +
    • multiple-value-call   +
    • multiple-value-list   +
    • multiple-value-prog1   +
    • multiple-value-setq   +
    • values   +
    • values-list   +
    • multiple-values-limit   +
    • nth-value   +
    • prog   +
    • prog1   +
    • progn   +
    • define-modify-macro   +
    • defsetf   +
    • define-setf-expander   +
    • get-setf-expansion   +
    • setf   +
    • shiftf   +
    • rotatef   +
    • control-error   +
    • program-error   +
    • undefined-function   +
    +
+Iteration
+
+
    • The LOOP Facility   +
    • Iteration Dictionary   +
    +
+The LOOP Facility
+
+
    • Overview of the Loop Facility   +
    • Variable Initialization and Stepping Clauses   +
    • Value Accumulation Clauses   +
    • Termination Test Clauses   +
    • Unconditional Execution Clauses   +
    • Conditional Execution Clauses   +
    • Miscellaneous Clauses   +
    • Examples of Miscellaneous Loop Features   +
    • Notes about Loop   +
    +
+Overview of the Loop Facility
+
+
    • Simple vs Extended Loop   +
    • Simple Loop   +
    • Extended Loop   +
    • Loop Keywords   +
    • Parsing Loop Clauses   +
    • Expanding Loop Forms   +
    • Summary of Loop Clauses   +
    • Summary of Variable Initialization and Stepping Clauses   +
    • Summary of Value Accumulation Clauses   +
    • Summary of Termination Test Clauses   +
    • Summary of Unconditional Execution Clauses   +
    • Summary of Conditional Execution Clauses   +
    • Summary of Miscellaneous Clauses   +
    • Order of Execution   +
    • Destructuring   +
    • Restrictions on Side-Effects   +
    +
+Variable Initialization and Stepping Clauses
+
+
    • Iteration Control   +
    • The for-as-arithmetic subclause   +
    • Examples of for-as-arithmetic subclause   +
    • The for-as-in-list subclause   +
    • Examples of for-as-in-list subclause   +
    • The for-as-on-list subclause   +
    • Examples of for-as-on-list subclause   +
    • The for-as-equals-then subclause   +
    • Examples of for-as-equals-then subclause   +
    • The for-as-across subclause   +
    • Examples of for-as-across subclause   +
    • The for-as-hash subclause   +
    • The for-as-package subclause   +
    • Examples of for-as-package subclause   +
    • Local Variable Initializations   +
    • Examples of WITH clause   +
    +
+Value Accumulation Clauses
+
+
    • Examples of COLLECT clause   +
    • Examples of APPEND and NCONC clauses   +
    • Examples of COUNT clause   +
    • Examples of MAXIMIZE and MINIMIZE clauses   +
    • Examples of SUM clause   +
    +
+Termination Test Clauses
+
+
    • Examples of REPEAT clause   +
    • Examples of ALWAYS   +
    • Examples of WHILE and UNTIL clauses   +
    +
+Unconditional Execution Clauses
+
+
    • Examples of unconditional execution   +
    +
+Conditional Execution Clauses
+
+
    • Examples of WHEN clause   +
    +
+Miscellaneous Clauses
+
+
    • Control Transfer Clauses   +
    • Examples of NAMED clause   +
    • Initial and Final Execution   +
    +
+Examples of Miscellaneous Loop Features
+
+
    • Examples of clause grouping   +
    +
+Iteration Dictionary
+
+
    • do   +
    • dotimes   +
    • dolist   +
    • loop   +
    • loop-finish   +
    +
+Objects
+
+
    • Object Creation and Initialization   +
    • Changing the Class of an Instance   +
    • Reinitializing an Instance   +
    • Meta-Objects   +
    • Slots   +
    • Generic Functions and Methods   +
    • Objects Dictionary   +
    +
+Object Creation and Initialization
+
+
    • Initialization Arguments   +
    • Declaring the Validity of Initialization Arguments   +
    • Defaulting of Initialization Arguments   +
    • Rules for Initialization Arguments   +
    • Shared-Initialize   +
    • Initialize-Instance   +
    • Definitions of Make-Instance and Initialize-Instance   +
    +
+Changing the Class of an Instance
+
+
    • Modifying the Structure of the Instance   +
    • Initializing Newly Added Local Slots (Changing the Class of an Instance)   +
    • Customizing the Change of Class of an Instance   +
    +
+Reinitializing an Instance
+
+
    • Customizing Reinitialization   +
    +
+Meta-Objects
+
+
    • Standard Meta-objects   +
    +
+Slots
+
+
    • Introduction to Slots   +
    • Accessing Slots   +
    • Inheritance of Slots and Slot Options   +
    +
+Generic Functions and Methods
+
+
    • Introduction to Generic Functions   +
    • Introduction to Methods   +
    • Agreement on Parameter Specializers and Qualifiers   +
    • Congruent Lambda-lists for all Methods of a Generic Function   +
    • Keyword Arguments in Generic Functions and Methods   +
    • Method Selection and Combination   +
    • Inheritance of Methods   +
    +
+Keyword Arguments in Generic Functions and Methods
+
+
    • Examples of Keyword Arguments in Generic Functions and Methods   +
    +
+Method Selection and Combination
+
+
    • Determining the Effective Method   +
    • Selecting the Applicable Methods   +
    • Sorting the Applicable Methods by Precedence Order   +
    • Applying method combination to the sorted list of applicable methods   +
    • Standard Method Combination   +
    • Declarative Method Combination   +
    • Built-in Method Combination Types   +
    +
+Objects Dictionary
+
+
    • function-keywords   +
    • ensure-generic-function   +
    • allocate-instance   +
    • reinitialize-instance   +
    • shared-initialize   +
    • update-instance-for-different-class   +
    • update-instance-for-redefined-class   +
    • change-class   +
    • slot-boundp   +
    • slot-exists-p   +
    • slot-makunbound   +
    • slot-missing   +
    • slot-unbound   +
    • slot-value   +
    • method-qualifiers   +
    • no-applicable-method   +
    • no-next-method   +
    • remove-method   +
    • make-instance   +
    • make-instances-obsolete   +
    • make-load-form   +
    • make-load-form-saving-slots   +
    • with-accessors   +
    • with-slots   +
    • defclass   +
    • defgeneric   +
    • defmethod   +
    • find-class   +
    • next-method-p   +
    • call-method   +
    • call-next-method   +
    • compute-applicable-methods   +
    • define-method-combination   +
    • find-method   +
    • add-method   +
    • initialize-instance   +
    • class-name   +
    • (setf class-name)   +
    • class-of   +
    • unbound-slot   +
    • unbound-slot-instance   +
    +
+Structures
+
+
    • Structures Dictionary   +
    +
+Structures Dictionary
+
+
    • defstruct   +
    • copy-structure   +
    +
+Conditions
+
+
    • Condition System Concepts   +
    • Conditions Dictionary   +
    +
+Condition System Concepts
+
+
    • Condition Types   +
    • Creating Conditions   +
    • Printing Conditions   +
    • Signaling and Handling Conditions   +
    • Assertions   +
    • Notes about the Condition System`s Background   +
    +
+Condition Types
+
+
    • Serious Conditions   +
    +
+Creating Conditions
+
+
    • Condition Designators   +
    +
+Printing Conditions
+
+
    • Recommended Style in Condition Reporting   +
    • Capitalization and Punctuation in Condition Reports   +
    • Leading and Trailing Newlines in Condition Reports   +
    • Embedded Newlines in Condition Reports   +
    • Note about Tabs in Condition Reports   +
    • Mentioning Containing Function in Condition Reports   +
    +
+Signaling and Handling Conditions
+
+
    • Signaling   +
    • Resignaling a Condition   +
    • Restarts   +
    • Interactive Use of Restarts   +
    • Interfaces to Restarts   +
    • Restart Tests   +
    • Associating a Restart with a Condition   +
    +
+Conditions Dictionary
+
+
    • condition   +
    • warning   +
    • style-warning   +
    • serious-condition   +
    • error (Condition Type)   +
    • cell-error   +
    • cell-error-name   +
    • parse-error   +
    • storage-condition   +
    • assert   +
    • error   +
    • cerror   +
    • check-type   +
    • simple-error   +
    • invalid-method-error   +
    • method-combination-error   +
    • signal   +
    • simple-condition   +
    • simple-condition-format-control   +
    • warn   +
    • simple-warning   +
    • invoke-debugger   +
    • break   +
    • *debugger-hook*   +
    • *break-on-signals*   +
    • handler-bind   +
    • handler-case   +
    • ignore-errors   +
    • define-condition   +
    • make-condition   +
    • restart   +
    • compute-restarts   +
    • find-restart   +
    • invoke-restart   +
    • invoke-restart-interactively   +
    • restart-bind   +
    • restart-case   +
    • restart-name   +
    • with-condition-restarts   +
    • with-simple-restart   +
    • abort (Restart)   +
    • continue   +
    • muffle-warning   +
    • store-value   +
    • use-value   +
    • abort (Function)   +
    +
+Symbols
+
+
    • Symbol Concepts   +
    • Symbols Dictionary   +
    +
+Symbols Dictionary
+
+
    • symbol   +
    • keyword   +
    • symbolp   +
    • keywordp   +
    • make-symbol   +
    • copy-symbol   +
    • gensym   +
    • *gensym-counter*   +
    • gentemp   +
    • symbol-function   +
    • symbol-name   +
    • symbol-package   +
    • symbol-plist   +
    • symbol-value   +
    • get   +
    • remprop   +
    • boundp   +
    • makunbound   +
    • set   +
    • unbound-variable   +
    +
+Packages
+
+
    • Package Concepts   +
    • Packages Dictionary   +
    +
+Package Concepts
+
+
    • Introduction to Packages   +
    • Standardized Packages   +
    +
+Introduction to Packages
+
+
    • Package Names and Nicknames   +
    • Symbols in a Package   +
    • Internal and External Symbols   +
    • Package Inheritance   +
    • Accessibility of Symbols in a Package   +
    • Locating a Symbol in a Package   +
    • Prevention of Name Conflicts in Packages   +
    +
+Standardized Packages
+
+
    • The COMMON-LISP Package   +
    • Constraints on the COMMON-LISP Package for Conforming Implementations   +
    • Constraints on the COMMON-LISP Package for Conforming Programs   +
    • Some Exceptions to Constraints on the COMMON-LISP Package for Conforming Programs   +
    • The COMMON-LISP-USER Package   +
    • The KEYWORD Package   +
    • Interning a Symbol in the KEYWORD Package   +
    • Notes about The KEYWORD Package   +
    • Implementation-Defined Packages   +
    +
+Packages Dictionary
+
+
    • package   +
    • export   +
    • find-symbol   +
    • find-package   +
    • find-all-symbols   +
    • import   +
    • list-all-packages   +
    • rename-package   +
    • shadow   +
    • shadowing-import   +
    • delete-package   +
    • make-package   +
    • with-package-iterator   +
    • unexport   +
    • unintern   +
    • in-package   +
    • unuse-package   +
    • use-package   +
    • defpackage   +
    • do-symbols   +
    • intern   +
    • package-name   +
    • package-nicknames   +
    • package-shadowing-symbols   +
    • package-use-list   +
    • package-used-by-list   +
    • packagep   +
    • *package*   +
    • package-error   +
    • package-error-package   +
    +
+Numbers
+
+
    • Number Concepts   +
    • Numbers Dictionary   +
    +
+Number Concepts
+
+
    • Numeric Operations   +
    • Implementation-Dependent Numeric Constants   +
    • Rational Computations   +
    • Floating-point Computations   +
    • Complex Computations   +
    • Interval Designators   +
    • Random-State Operations   +
    +
+Numeric Operations
+
+
    • Associativity and Commutativity in Numeric Operations   +
    • Examples of Associativity and Commutativity in Numeric Operations   +
    • Contagion in Numeric Operations   +
    • Viewing Integers as Bits and Bytes   +
    • Logical Operations on Integers   +
    • Byte Operations on Integers   +
    +
+Rational Computations
+
+
    • Rule of Unbounded Rational Precision   +
    • Rule of Canonical Representation for Rationals   +
    • Rule of Float Substitutability   +
    +
+Floating-point Computations
+
+
    • Rule of Float and Rational Contagion   +
    • Examples of Rule of Float and Rational Contagion   +
    • Rule of Float Approximation   +
    • Rule of Float Underflow and Overflow   +
    • Rule of Float Precision Contagion   +
    +
+Complex Computations
+
+
    • Rule of Complex Substitutability   +
    • Rule of Complex Contagion   +
    • Rule of Canonical Representation for Complex Rationals   +
    • Examples of Rule of Canonical Representation for Complex Rationals   +
    • Principal Values and Branch Cuts   +
    +
+Numbers Dictionary
+
+
    • number   +
    • complex (System Class)   +
    • real   +
    • float (System Class)   +
    • short-float   +
    • rational (System Class)   +
    • ratio   +
    • integer   +
    • signed-byte   +
    • unsigned-byte   +
    • mod (System Class)   +
    • bit (System Class)   +
    • fixnum   +
    • bignum   +
    • =   +
    • max   +
    • minusp   +
    • zerop   +
    • floor   +
    • sin   +
    • asin   +
    • pi   +
    • sinh   +
    • *   +
    • +   +
    • -   +
    • /   +
    • 1+   +
    • abs   +
    • evenp   +
    • exp   +
    • gcd   +
    • incf   +
    • lcm   +
    • log   +
    • mod (Function)   +
    • signum   +
    • sqrt   +
    • random-state   +
    • make-random-state   +
    • random   +
    • random-state-p   +
    • *random-state*   +
    • numberp   +
    • cis   +
    • complex   +
    • complexp   +
    • conjugate   +
    • phase   +
    • realpart   +
    • upgraded-complex-part-type   +
    • realp   +
    • numerator   +
    • rational (Function)   +
    • rationalp   +
    • ash   +
    • integer-length   +
    • integerp   +
    • parse-integer   +
    • boole   +
    • boole-1   +
    • logand   +
    • logbitp   +
    • logcount   +
    • logtest   +
    • byte   +
    • deposit-field   +
    • dpb   +
    • ldb   +
    • ldb-test   +
    • mask-field   +
    • most-positive-fixnum   +
    • decode-float   +
    • float   +
    • floatp   +
    • most-positive-short-float   +
    • short-float-epsilon   +
    • arithmetic-error   +
    • arithmetic-error-operands   +
    • division-by-zero   +
    • floating-point-invalid-operation   +
    • floating-point-inexact   +
    • floating-point-overflow   +
    • floating-point-underflow   +
    +
+Characters
+
+
    • Character Concepts   +
    • Characters Dictionary   +
    +
+Character Concepts
+
+
    • Introduction to Characters   +
    • Introduction to Scripts and Repertoires   +
    • Character Attributes   +
    • Character Categories   +
    • Identity of Characters   +
    • Ordering of Characters   +
    • Character Names   +
    • Treatment of Newline during Input and Output   +
    • Character Encodings   +
    • Documentation of Implementation-Defined Scripts   +
    +
+Introduction to Scripts and Repertoires
+
+
    • Character Scripts   +
    • Character Repertoires   +
    +
+Character Categories
+
+
    • Graphic Characters   +
    • Alphabetic Characters   +
    • Characters With Case   +
    • Uppercase Characters   +
    • Lowercase Characters   +
    • Corresponding Characters in the Other Case   +
    • Case of Implementation-Defined Characters   +
    • Numeric Characters   +
    • Alphanumeric Characters   +
    • Digits in a Radix   +
    +
+Characters Dictionary
+
+
    • character (System Class)   +
    • base-char   +
    • standard-char   +
    • extended-char   +
    • char=   +
    • character   +
    • characterp   +
    • alpha-char-p   +
    • alphanumericp   +
    • digit-char   +
    • digit-char-p   +
    • graphic-char-p   +
    • standard-char-p   +
    • char-upcase   +
    • upper-case-p   +
    • char-code   +
    • char-int   +
    • code-char   +
    • char-code-limit   +
    • char-name   +
    • name-char   +
    +
+Conses
+
+
    • Cons Concepts   +
    • Conses Dictionary   +
    +
+Cons Concepts
+
+
    • Conses as Trees   +
    • Conses as Lists   +
    +
+Conses as Trees
+
+
    • General Restrictions on Parameters that must be Trees   +
    +
+Conses as Lists
+
+
    • Lists as Association Lists   +
    • Lists as Sets   +
    • General Restrictions on Parameters that must be Lists   +
    +
+Conses Dictionary
+
+
    • list (System Class)   +
    • null (System Class)   +
    • cons (System Class)   +
    • atom (Type)   +
    • cons   +
    • consp   +
    • atom   +
    • rplaca   +
    • car   +
    • copy-tree   +
    • sublis   +
    • subst   +
    • tree-equal   +
    • copy-list   +
    • list (Function)   +
    • list-length   +
    • listp   +
    • make-list   +
    • push   +
    • pop   +
    • first   +
    • nth   +
    • endp   +
    • null   +
    • nconc   +
    • append   +
    • revappend   +
    • butlast   +
    • last   +
    • ldiff   +
    • nthcdr   +
    • rest   +
    • member (Function)   +
    • mapc   +
    • acons   +
    • assoc   +
    • copy-alist   +
    • pairlis   +
    • rassoc   +
    • get-properties   +
    • getf   +
    • remf   +
    • intersection   +
    • adjoin   +
    • pushnew   +
    • set-difference   +
    • set-exclusive-or   +
    • subsetp   +
    • union   +
    +
+Arrays
+
+
    • Array Concepts   +
    • Arrays Dictionary   +
    +
+Array Concepts
+
+
    • Array Elements   +
    • Specialized Arrays   +
    +
+Array Elements
+
+
    • Array Indices   +
    • Array Dimensions   +
    • Implementation Limits on Individual Array Dimensions   +
    • Array Rank   +
    • Vectors   +
    • Fill Pointers   +
    • Multidimensional Arrays   +
    • Storage Layout for Multidimensional Arrays   +
    • Implementation Limits on Array Rank   +
    +
+Specialized Arrays
+
+
    • Array Upgrading   +
    • Required Kinds of Specialized Arrays   +
    +
+Arrays Dictionary
+
+
    • array   +
    • simple-array   +
    • vector (System Class)   +
    • simple-vector   +
    • bit-vector   +
    • simple-bit-vector   +
    • make-array   +
    • adjust-array   +
    • adjustable-array-p   +
    • aref   +
    • array-dimension   +
    • array-dimensions   +
    • array-element-type   +
    • array-has-fill-pointer-p   +
    • array-displacement   +
    • array-in-bounds-p   +
    • array-rank   +
    • array-row-major-index   +
    • array-total-size   +
    • arrayp   +
    • fill-pointer   +
    • row-major-aref   +
    • upgraded-array-element-type   +
    • array-dimension-limit   +
    • array-rank-limit   +
    • array-total-size-limit   +
    • simple-vector-p   +
    • svref   +
    • vector   +
    • vector-pop   +
    • vector-push   +
    • vectorp   +
    • bit (Array)   +
    • bit-and   +
    • bit-vector-p   +
    • simple-bit-vector-p   +
    +
+Strings
+
+
    • String Concepts   +
    • Strings Dictionary   +
    +
+String Concepts
+
+
    • Implications of Strings Being Arrays   +
    • Subtypes of STRING   +
    +
+Strings Dictionary
+
+
    • string (System Class)   +
    • base-string   +
    • simple-string   +
    • simple-base-string   +
    • simple-string-p   +
    • char   +
    • string   +
    • string-upcase   +
    • string-trim   +
    • string=   +
    • stringp   +
    • make-string   +
    +
+Sequences
+
+
    • Sequence Concepts   +
    • Rules about Test Functions   +
    • Sequences Dictionary   +
    +
+Sequence Concepts
+
+
    • General Restrictions on Parameters that must be Sequences   +
    +
+Rules about Test Functions
+
+
    • Satisfying a Two-Argument Test   +
    • Satisfying a One-Argument Test   +
    +
+Satisfying a Two-Argument Test
+
+
    • Examples of Satisfying a Two-Argument Test   +
    +
+Satisfying a One-Argument Test
+
+
    • Examples of Satisfying a One-Argument Test   +
    +
+Sequences Dictionary
+
+
    • sequence   +
    • copy-seq   +
    • elt   +
    • fill   +
    • make-sequence   +
    • subseq   +
    • map   +
    • map-into   +
    • reduce   +
    • count   +
    • length   +
    • reverse   +
    • sort   +
    • find   +
    • position   +
    • search   +
    • mismatch   +
    • replace   +
    • substitute   +
    • concatenate   +
    • merge   +
    • remove   +
    • remove-duplicates   +
    +
+Hash Tables
+
+
    • Hash Table Concepts   +
    • Hash Tables Dictionary   +
    +
+Hash Table Concepts
+
+
    • Hash-Table Operations   +
    • Modifying Hash Table Keys   +
    +
+Modifying Hash Table Keys
+
+
    • Visible Modification of Objects with respect to EQ and EQL   +
    • Visible Modification of Objects with respect to EQUAL   +
    • Visible Modification of Conses with respect to EQUAL   +
    • Visible Modification of Bit Vectors and Strings with respect to EQUAL   +
    • Visible Modification of Objects with respect to EQUALP   +
    • Visible Modification of Structures with respect to EQUALP   +
    • Visible Modification of Arrays with respect to EQUALP   +
    • Visible Modification of Hash Tables with respect to EQUALP   +
    • Visible Modifications by Language Extensions   +
    +
+Hash Tables Dictionary
+
+
    • hash-table   +
    • make-hash-table   +
    • hash-table-p   +
    • hash-table-count   +
    • hash-table-rehash-size   +
    • hash-table-rehash-threshold   +
    • hash-table-size   +
    • hash-table-test   +
    • gethash   +
    • remhash   +
    • maphash   +
    • with-hash-table-iterator   +
    • clrhash   +
    • sxhash   +
    +
+Filenames
+
+
    • Overview of Filenames   +
    • Pathnames   +
    • Logical Pathnames   +
    • Filenames Dictionary   +
    +
+Overview of Filenames
+
+
    • Namestrings as Filenames   +
    • Pathnames as Filenames   +
    • Parsing Namestrings Into Pathnames   +
    +
+Pathnames
+
+
    • Pathname Components   +
    • Interpreting Pathname Component Values   +
    • Merging Pathnames   +
    +
+Pathname Components
+
+
    • The Pathname Host Component   +
    • The Pathname Device Component   +
    • The Pathname Directory Component   +
    • The Pathname Name Component   +
    • The Pathname Type Component   +
    • The Pathname Version Component   +
    +
+Interpreting Pathname Component Values
+
+
    • Strings in Component Values   +
    • Special Characters in Pathname Components   +
    • Case in Pathname Components   +
    • Local Case in Pathname Components   +
    • Common Case in Pathname Components   +
    • Special Pathname Component Values   +
    • NIL as a Component Value   +
    • ->WILD as a Component Value   +
    • ->UNSPECIFIC as a Component Value   +
    • Relation between component values NIL and ->UNSPECIFIC   +
    • Restrictions on Wildcard Pathnames   +
    • Restrictions on Examining Pathname Components   +
    • Restrictions on Examining a Pathname Host Component   +
    • Restrictions on Examining a Pathname Device Component   +
    • Restrictions on Examining a Pathname Directory Component   +
    • Directory Components in Non-Hierarchical File Systems   +
    • Restrictions on Examining a Pathname Name Component   +
    • Restrictions on Examining a Pathname Type Component   +
    • Restrictions on Examining a Pathname Version Component   +
    • Notes about the Pathname Version Component   +
    • Restrictions on Constructing Pathnames   +
    +
+Merging Pathnames
+
+
    • Examples of Merging Pathnames   +
    +
+Logical Pathnames
+
+
    • Syntax of Logical Pathname Namestrings   +
    • Logical Pathname Components   +
    +
+Syntax of Logical Pathname Namestrings
+
+
    • Additional Information about Parsing Logical Pathname Namestrings   +
    • The Host part of a Logical Pathname Namestring   +
    • The Device part of a Logical Pathname Namestring   +
    • The Directory part of a Logical Pathname Namestring   +
    • The Type part of a Logical Pathname Namestring   +
    • The Version part of a Logical Pathname Namestring   +
    • Wildcard Words in a Logical Pathname Namestring   +
    • Lowercase Letters in a Logical Pathname Namestring   +
    • Other Syntax in a Logical Pathname Namestring   +
    +
+Logical Pathname Components
+
+
    • Unspecific Components of a Logical Pathname   +
    • Null Strings as Components of a Logical Pathname   +
    +
+Filenames Dictionary
+
+
    • pathname (System Class)   +
    • logical-pathname (System Class)   +
    • pathname   +
    • make-pathname   +
    • pathnamep   +
    • pathname-host   +
    • load-logical-pathname-translations   +
    • logical-pathname-translations   +
    • logical-pathname   +
    • *default-pathname-defaults*   +
    • namestring   +
    • parse-namestring   +
    • wild-pathname-p   +
    • pathname-match-p   +
    • translate-logical-pathname   +
    • translate-pathname   +
    • merge-pathnames   +
    +
+Files
+
+
    • File System Concepts   +
    • Files Dictionary   +
    +
+File System Concepts
+
+
    • Coercion of Streams to Pathnames   +
    • File Operations on Open and Closed Streams   +
    • Truenames   +
    +
+Truenames
+
+
    • Examples of Truenames   +
    +
+Files Dictionary
+
+
    • directory   +
    • probe-file   +
    • ensure-directories-exist   +
    • truename   +
    • file-author   +
    • file-write-date   +
    • rename-file   +
    • delete-file   +
    • file-error   +
    • file-error-pathname   +
    +
+Streams
+
+
    • Stream Concepts   +
    • Streams Dictionary   +
    +
+Stream Concepts
+
+
    • Introduction to Streams   +
    • Stream Variables   +
    • Stream Arguments to Standardized Functions   +
    • Restrictions on Composite Streams   +
    +
+Introduction to Streams
+
+
    • Abstract Classifications of Streams (Introduction to Streams)   +
    • Input   +
    • Open and Closed Streams   +
    • Interactive Streams   +
    • Abstract Classifications of Streams   +
    • File Streams   +
    • Other Subclasses of Stream   +
    +
+Streams Dictionary
+
+
    • stream   +
    • broadcast-stream   +
    • concatenated-stream   +
    • echo-stream   +
    • file-stream   +
    • string-stream   +
    • synonym-stream   +
    • two-way-stream   +
    • input-stream-p   +
    • interactive-stream-p   +
    • open-stream-p   +
    • stream-element-type   +
    • streamp   +
    • read-byte   +
    • write-byte   +
    • peek-char   +
    • read-char   +
    • read-char-no-hang   +
    • terpri   +
    • unread-char   +
    • write-char   +
    • read-line   +
    • write-string   +
    • read-sequence   +
    • write-sequence   +
    • file-length   +
    • file-position   +
    • file-string-length   +
    • open   +
    • stream-external-format   +
    • with-open-file   +
    • close   +
    • with-open-stream   +
    • listen   +
    • clear-input   +
    • finish-output   +
    • y-or-n-p   +
    • make-synonym-stream   +
    • synonym-stream-symbol   +
    • broadcast-stream-streams   +
    • make-broadcast-stream   +
    • make-two-way-stream   +
    • two-way-stream-input-stream   +
    • echo-stream-input-stream   +
    • make-echo-stream   +
    • concatenated-stream-streams   +
    • make-concatenated-stream   +
    • get-output-stream-string   +
    • make-string-input-stream   +
    • make-string-output-stream   +
    • with-input-from-string   +
    • with-output-to-string   +
    • *debug-io*   +
    • *terminal-io*   +
    • stream-error   +
    • stream-error-stream   +
    • end-of-file   +
    +
+Printer
+
+
    • The Lisp Printer   +
    • The Lisp Pretty Printer   +
    • Formatted Output   +
    • Printer Dictionary   +
    +
+The Lisp Printer
+
+
    • Overview of The Lisp Printer   +
    • Printer Dispatching   +
    • Default Print-Object Methods   +
    • Examples of Printer Behavior   +
    +
+Overview of The Lisp Printer
+
+
    • Multiple Possible Textual Representations   +
    • Printer Escaping   +
    +
+Default Print-Object Methods
+
+
    • Printing Numbers   +
    • Printing Integers   +
    • Printing Ratios   +
    • Printing Floats   +
    • Printing Complexes   +
    • Note about Printing Numbers   +
    • Printing Characters   +
    • Printing Symbols   +
    • Package Prefixes for Symbols   +
    • Effect of Readtable Case on the Lisp Printer   +
    • Examples of Effect of Readtable Case on the Lisp Printer   +
    • Printing Strings   +
    • Printing Lists and Conses   +
    • Printing Bit Vectors   +
    • Printing Other Vectors   +
    • Printing Other Arrays   +
    • Examples of Printing Arrays   +
    • Printing Random States   +
    • Printing Pathnames   +
    • Printing Structures   +
    • Printing Other Objects   +
    +
+The Lisp Pretty Printer
+
+
    • Pretty Printer Concepts   +
    • Examples of using the Pretty Printer   +
    • Notes about the Pretty Printer`s Background   +
    +
+Pretty Printer Concepts
+
+
    • Dynamic Control of the Arrangement of Output   +
    • Format Directive Interface   +
    • Compiling Format Strings   +
    • Pretty Print Dispatch Tables   +
    • Pretty Printer Margins   +
    +
+Formatted Output
+
+
    • FORMAT Basic Output   +
    • FORMAT Radix Control   +
    • FORMAT Floating-Point Printers   +
    • FORMAT Printer Operations   +
    • FORMAT Pretty Printer Operations   +
    • FORMAT Layout Control   +
    • FORMAT Control-Flow Operations   +
    • FORMAT Miscellaneous Operations   +
    • FORMAT Miscellaneous Pseudo-Operations   +
    • Additional Information about FORMAT Operations   +
    • Examples of FORMAT   +
    • Notes about FORMAT   +
    +
+FORMAT Basic Output
+
+
    • Tilde C-> Character   +
    • Tilde Percent-> Newline   +
    • Tilde Ampersand-> Fresh-Line   +
    • Tilde Vertical-Bar-> Page   +
    • Tilde Tilde-> Tilde   +
    +
+FORMAT Radix Control
+
+
    • Tilde R-> Radix   +
    • Tilde D-> Decimal   +
    • Tilde B-> Binary   +
    • Tilde O-> Octal   +
    • Tilde X-> Hexadecimal   +
    +
+FORMAT Floating-Point Printers
+
+
    • Tilde F-> Fixed-Format Floating-Point   +
    • Tilde E-> Exponential Floating-Point   +
    • Tilde G-> General Floating-Point   +
    • Tilde Dollarsign-> Monetary Floating-Point   +
    +
+FORMAT Printer Operations
+
+
    • Tilde A-> Aesthetic   +
    • Tilde S-> Standard   +
    • Tilde W-> Write   +
    +
+FORMAT Pretty Printer Operations
+
+
    • Tilde Underscore-> Conditional Newline   +
    • Tilde Less-Than-Sign-> Logical Block   +
    • Tilde I-> Indent   +
    • Tilde Slash-> Call Function   +
    +
+FORMAT Layout Control
+
+
    • Tilde T-> Tabulate   +
    • Tilde Less-Than-Sign-> Justification   +
    • Tilde Greater-Than-Sign-> End of Justification   +
    +
+FORMAT Control-Flow Operations
+
+
    • Tilde Asterisk-> Go-To   +
    • Tilde Left-Bracket-> Conditional Expression   +
    • Tilde Right-Bracket-> End of Conditional Expression   +
    • Tilde Left-Brace-> Iteration   +
    • Tilde Right-Brace-> End of Iteration   +
    • Tilde Question-Mark-> Recursive Processing   +
    +
+FORMAT Miscellaneous Operations
+
+
    • Tilde Left-Paren-> Case Conversion   +
    • Tilde Right-Paren-> End of Case Conversion   +
    • Tilde P-> Plural   +
    +
+FORMAT Miscellaneous Pseudo-Operations
+
+
    • Tilde Semicolon-> Clause Separator   +
    • Tilde Circumflex-> Escape Upward   +
    • Tilde Newline-> Ignored Newline   +
    +
+Additional Information about FORMAT Operations
+
+
    • Nesting of FORMAT Operations   +
    • Missing and Additional FORMAT Arguments   +
    • Additional FORMAT Parameters   +
    • Undefined FORMAT Modifier Combinations   +
    +
+Printer Dictionary
+
+
    • copy-pprint-dispatch   +
    • formatter   +
    • pprint-dispatch   +
    • pprint-exit-if-list-exhausted   +
    • pprint-fill   +
    • pprint-indent   +
    • pprint-logical-block   +
    • pprint-newline   +
    • pprint-pop   +
    • pprint-tab   +
    • print-object   +
    • print-unreadable-object   +
    • set-pprint-dispatch   +
    • write   +
    • write-to-string   +
    • *print-array*   +
    • *print-base*   +
    • *print-case*   +
    • *print-circle*   +
    • *print-escape*   +
    • *print-gensym*   +
    • *print-level*   +
    • *print-lines*   +
    • *print-miser-width*   +
    • *print-pprint-dispatch*   +
    • *print-pretty*   +
    • *print-readably*   +
    • *print-right-margin*   +
    • print-not-readable   +
    • print-not-readable-object   +
    • format   +
    +
+Reader
+
+
    • Reader Concepts   +
    • Reader Dictionary   +
    +
+Reader Concepts
+
+
    • Dynamic Control of the Lisp Reader   +
    • Effect of Readtable Case on the Lisp Reader   +
    • Argument Conventions of Some Reader Functions   +
    +
+Effect of Readtable Case on the Lisp Reader
+
+
    • Examples of Effect of Readtable Case on the Lisp Reader   +
    +
+Argument Conventions of Some Reader Functions
+
+
    • The EOF-ERROR-P argument   +
    • The RECURSIVE-P argument   +
    +
+Reader Dictionary
+
+
    • readtable   +
    • copy-readtable   +
    • make-dispatch-macro-character   +
    • read   +
    • read-delimited-list   +
    • read-from-string   +
    • readtable-case   +
    • readtablep   +
    • set-dispatch-macro-character   +
    • set-macro-character   +
    • set-syntax-from-char   +
    • with-standard-io-syntax   +
    • *read-base*   +
    • *read-default-float-format*   +
    • *read-eval*   +
    • *read-suppress*   +
    • *readtable*   +
    • reader-error   +
    +
+System Construction
+
+
    • System Construction Concepts   +
    • System Construction Dictionary   +
    +
+System Construction Concepts
+
+
    • Loading   +
    • Features   +
    +
+Features
+
+
    • Feature Expressions   +
    • Examples of Feature Expressions   +
    +
+System Construction Dictionary
+
+
    • compile-file   +
    • compile-file-pathname   +
    • load   +
    • with-compilation-unit   +
    • *features*   +
    • *compile-file-pathname*   +
    • *load-pathname*   +
    • *compile-print*   +
    • *load-print*   +
    • *modules*   +
    • provide   +
    +
+Environment
+
+
    • The External Environment   +
    • Environment Dictionary   +
    +
+The External Environment
+
+
    • Top level loop   +
    • Debugging Utilities   +
    • Environment Inquiry   +
    • Time   +
    +
+Time
+
+
    • Decoded Time   +
    • Universal Time   +
    • Internal Time   +
    • Seconds   +
    +
+Environment Dictionary
+
+
    • decode-universal-time   +
    • encode-universal-time   +
    • get-universal-time   +
    • sleep   +
    • apropos   +
    • describe   +
    • describe-object   +
    • trace   +
    • step   +
    • time   +
    • internal-time-units-per-second   +
    • get-internal-real-time   +
    • get-internal-run-time   +
    • disassemble   +
    • documentation   +
    • room   +
    • ed   +
    • inspect   +
    • dribble   +
    • -   +
    • +   +
    • *   +
    • /   +
    • lisp-implementation-type   +
    • short-site-name   +
    • machine-instance   +
    • machine-type   +
    • machine-version   +
    • software-type   +
    • user-homedir-pathname   +
    +
+Glossary
+
+
    • Glossary   +
    +
+Appendix
+
+
    • Removed Language Features   +
    +
+Removed Language Features
+
+
    • Requirements for removed and deprecated features   +
    • Removed Types   +
    • Removed Operators   +
    • Removed Argument Conventions   +
    • Removed Variables   +
    • Removed Reader Syntax   +
    • Packages No Longer Required   +
    + + + +
    +
    +

    +Next: , Previous: , Up: (dir)  

    +
    + + + + + diff --git a/info/gcl/initialize_002dinstance.html b/info/gcl/initialize_002dinstance.html new file mode 100644 index 0000000..78e5884 --- /dev/null +++ b/info/gcl/initialize_002dinstance.html @@ -0,0 +1,100 @@ + + + + + +initialize-instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.36 initialize-instance [Standard Generic Function]

    + +

    Syntax::

    + +

    initialize-instance instance &rest initargs &key &allow-other-keys ⇒ instance +

    +

    Method Signatures::

    + +

    initialize-instance (instance standard-object) &rest initargs +

    +

    Arguments and Values::

    + +

    instance—an object. +

    +

    initargs—a defaulted initialization argument list. +

    +

    Description::

    + +

    Called by make-instance to initialize a newly created instance. +The generic function is called with the new instance +and the defaulted initialization argument list. +

    +

    The system-supplied primary method on initialize-instance +initializes the slots of the instance with values according +to the initargs and the :initform forms of the slots. +It does this by calling the generic function shared-initialize +with the following arguments: the instance, t (this indicates +that all slots for which no initialization arguments are provided +should be initialized according to their :initform forms), and +the initargs. +

    +

    Programmers can define methods for initialize-instance to +specify actions to be taken when an instance is initialized. If only +after methods are defined, they will be run after the +system-supplied primary method for initialization and therefore will +not interfere with the default behavior of initialize-instance. +

    +

    See Also::

    + +

    Shared-Initialize +, +make-instance +, +slot-boundp +, +slot-makunbound +, +Object Creation and Initialization, +Rules for Initialization Arguments, +Declaring the Validity of Initialization Arguments +

    + + + + + diff --git a/info/gcl/inline.html b/info/gcl/inline.html new file mode 100644 index 0000000..18488eb --- /dev/null +++ b/info/gcl/inline.html @@ -0,0 +1,172 @@ + + + + + +inline (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.22 inline, notinline [Declaration]

    + +

    Syntax::

    + +

    (inline {function-name}*) +

    +

    (notinline {function-name}*) +

    +

    Arguments::

    + +

    function-name—a function name. +

    +

    Valid Context::

    + +

    declaration or proclamation +

    +

    Binding Types Affected::

    + +

    function +

    +

    Description::

    + +

    inline specifies that +it is desirable for the compiler to produce inline calls +to the functions named by function-names; +that is, the code for a specified function-name +

    +

    should be integrated into the calling routine, appearing “in line” +in place of a procedure call. +A compiler is free to ignore this declaration. +inline declarations never apply to variable bindings. +

    +

    If one of the functions mentioned has a lexically apparent local definition +(as made by flet or labels), then the declaration +applies to that local definition and not to the global function definition. +

    +

    While no conforming implementation is required to perform inline expansion +of user-defined functions, those implementations that do attempt +to recognize the following paradigm: +

    +

    To define a function f that is not inline by default +but for which (declare (inline f)) will make f be locally inlined, +the proper definition sequence is: +

    +
    +
     (declaim (inline f))
+ (defun f ...)
+ (declaim (notinline f))
+
    + +

    The inline proclamation preceding the defun form +ensures that the compiler has the opportunity save the information +necessary for inline expansion, and the notinline proclamation +following the defun form prevents f from being expanded +inline everywhere. +

    +

    notinline specifies that it is +

    +

    undesirable to compile the functions +named by function-names in-line. +A compiler is not free to ignore this declaration; +calls to the specified functions must be implemented as out-of-line subroutine calls. +

    +

    If one of the functions +mentioned has a lexically apparent local definition +(as made by flet or labels), then the declaration +applies to that local definition and not to the global function definition. +

    +

    In the presence of a compiler macro definition for +function-name, a notinline declaration prevents that +

    +

    compiler macro from being used. +

    +

    An inline declaration may be used to encourage use of +compiler macro definitions. inline and notinline +declarations otherwise have no effect when the lexically visible definition +of function-name is a macro definition. +

    +

    inline and notinline declarations can be free declarations or +bound declarations. +inline and notinline declarations of functions that +appear before the body of a + flet + or labels +

    +

    form that defines that function are bound declarations. +Such declarations in other contexts are free declarations. +

    +

    Examples::

    + +
    +
     ;; The globally defined function DISPATCH should be open-coded,
+ ;; if the implementation supports inlining, unless a NOTINLINE 
+ ;; declaration overrides this effect.
+ (declaim (inline dispatch))
+ (defun dispatch (x) (funcall (get (car x) 'dispatch) x))
+ ;; Here is an example where inlining would be encouraged.
+ (defun top-level-1 () (dispatch (read-command)))
+ ;; Here is an example where inlining would be prohibited.
+ (defun top-level-2 ()
+   (declare (notinline dispatch))
+   (dispatch (read-command)))
+ ;; Here is an example where inlining would be prohibited.
+ (declaim (notinline dispatch))
+ (defun top-level-3 () (dispatch (read-command)))
+ ;; Here is an example where inlining would be encouraged.
+ (defun top-level-4 () 
+   (declare (inline dispatch))
+   (dispatch (read-command)))
+
    + +

    See Also::

    + +

    declare, +declaim +, +proclaim +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/input_002dstream_002dp.html b/info/gcl/input_002dstream_002dp.html new file mode 100644 index 0000000..1116b85 --- /dev/null +++ b/info/gcl/input_002dstream_002dp.html @@ -0,0 +1,86 @@ + + + + + +input-stream-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.9 input-stream-p, output-stream-p [Function]

    + +

    input-stream-p stream ⇒ generalized-boolean +

    +

    output-stream-p stream ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    stream—a stream. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    input-stream-p returns true if stream is an input stream; +otherwise, returns false. +

    +

    output-stream-p returns true if stream is an output stream; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (input-stream-p *standard-input*) ⇒  true
+ (input-stream-p *terminal-io*) ⇒  true
+ (input-stream-p (make-string-output-stream)) ⇒  false
+
+ (output-stream-p *standard-output*) ⇒  true
+ (output-stream-p *terminal-io*) ⇒  true
+ (output-stream-p (make-string-input-stream "jr")) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if stream is not a stream. +

    + + + + + diff --git a/info/gcl/inspect.html b/info/gcl/inspect.html new file mode 100644 index 0000000..223b68a --- /dev/null +++ b/info/gcl/inspect.html @@ -0,0 +1,86 @@ + + + + + +inspect (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.18 inspect [Function]

    + +

    inspect object ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    Description::

    + +

    inspect is an interactive version of describe. +The nature of the interaction is implementation-dependent, +but the purpose of inspect is to make it easy to wander +through a data structure, examining and modifying parts of it. +

    +

    Side Effects::

    + +

    implementation-dependent. +

    +

    Affected By::

    + +

    implementation-dependent. +

    +

    Exceptional Situations::

    + +

    implementation-dependent. +

    +

    See Also::

    + +

    describe +

    +

    Notes::

    + +

    Implementations are encouraged to respond to the typing +of ? or a “help key” by providing help, including a list +of commands. +

    + + + + + diff --git a/info/gcl/integer.html b/info/gcl/integer.html new file mode 100644 index 0000000..7acfd38 --- /dev/null +++ b/info/gcl/integer.html @@ -0,0 +1,103 @@ + + + + + +integer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.8 integer [System Class]

    + +

    Class Precedence List::

    +

    integer, +rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    An integer is a mathematical integer. There is no limit on the +magnitude of an integer. +

    +

    The types fixnum and bignum +form an exhaustive partition of type integer. +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (integer{[lower-limit [upper-limit]]}) +

    +

    Compound Type Specifier Arguments::

    + +

    lower-limit, upper-limit—interval designators + for type integer. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the integers on the interval described by +lower-limit and upper-limit. +

    +

    See Also::

    + +

    Figure~2–9, +Constructing Numbers from Tokens, +Printing Integers +

    +

    Notes::

    + +

    The type (integer lower upper), +where lower and upper +are most-negative-fixnum and most-positive-fixnum, respectively, +is also called fixnum. +

    +

    The type (integer 0 1) is also called bit. +The type (integer 0 *) is also called unsigned-byte. +

    + + + + + diff --git a/info/gcl/integer_002dlength.html b/info/gcl/integer_002dlength.html new file mode 100644 index 0000000..42e72b5 --- /dev/null +++ b/info/gcl/integer_002dlength.html @@ -0,0 +1,106 @@ + + + + + +integer-length (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.57 integer-length [Function]

    + +

    integer-length integer ⇒ number-of-bits +

    +

    Arguments and Values::

    + +

    integer—an integer. +

    +

    number-of-bits—a non-negative integer. +

    +

    Description::

    + +

    Returns the number of bits needed to represent integer +in binary two’s-complement format. +

    +

    Examples::

    + +
    +
     (integer-length 0) ⇒  0
+ (integer-length 1) ⇒  1
+ (integer-length 3) ⇒  2
+ (integer-length 4) ⇒  3
+ (integer-length 7) ⇒  3
+ (integer-length -1) ⇒  0
+ (integer-length -4) ⇒  2
+ (integer-length -7) ⇒  3
+ (integer-length -8) ⇒  3
+ (integer-length (expt 2 9)) ⇒  10
+ (integer-length (1- (expt 2 9))) ⇒  9
+ (integer-length (- (expt 2 9))) ⇒  9
+ (integer-length (- (1+ (expt 2 9)))) ⇒  10
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if integer is not an integer. +

    +

    Notes::

    + +

    This function could have been defined by: +

    +
    +
    (defun integer-length (integer)
+  (ceiling (log (if (minusp integer)
+                    (- integer)
+                    (1+ integer))
+                2)))
+
    + +

    If integer is non-negative, then its value can be represented +in unsigned binary form in a field whose width in bits is +no smaller than (integer-length integer). +Regardless of the sign of integer, its value can be +represented in signed binary two’s-complement form in a field +whose width in bits is no smaller than (+ (integer-length integer) 1). +

    + + + + + diff --git a/info/gcl/integerp.html b/info/gcl/integerp.html new file mode 100644 index 0000000..5220d88 --- /dev/null +++ b/info/gcl/integerp.html @@ -0,0 +1,79 @@ + + + + + +integerp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.58 integerp [Function]

    + +

    integerp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type integer; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (integerp 1) ⇒  true
+ (integerp (expt 2 130)) ⇒  true
+ (integerp 6/5) ⇒  false
+ (integerp nil) ⇒  false
+
+
    + +

    Notes::

    + +
    +
     (integerp object) ≡ (typep object 'integer)
+
    + + + + + + diff --git a/info/gcl/interactive_002dstream_002dp.html b/info/gcl/interactive_002dstream_002dp.html new file mode 100644 index 0000000..d64b9f1 --- /dev/null +++ b/info/gcl/interactive_002dstream_002dp.html @@ -0,0 +1,86 @@ + + + + + +interactive-stream-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.10 interactive-stream-p [Function]

    + +

    interactive-stream-p stream ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    stream—a stream. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if stream is an interactive stream; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (when (> measured limit)
+   (let ((error (round (* (- measured limit) 100)
+                       limit)))
+     (unless (if (interactive-stream-p *query-io*)
+                 (yes-or-no-p "The frammis is out of tolerance by ~D
+                               Is it safe to proceed? " error)
+                 (< error 15))  ;15
+       (error "The frammis is out of tolerance by ~D
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if stream is not a stream. +

    +

    See Also::

    + +

    Stream Concepts +

    + + + + + diff --git a/info/gcl/intern.html b/info/gcl/intern.html new file mode 100644 index 0000000..02adac2 --- /dev/null +++ b/info/gcl/intern.html @@ -0,0 +1,146 @@ + + + + + +intern (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.21 intern [Function]

    + +

    intern string &optional package ⇒ symbol, status +

    +

    Arguments and Values::

    + +

    string—a string. +

    +

    package—a package designator. +

    +

    The default is the current package. +

    +

    symbol—a symbol. +

    +

    status—one of :inherited, :external, :internal, or nil. +

    +

    Description::

    + +

    intern enters a symbol named string into package. +If a symbol whose name is the same as string +is already accessible in package, it is returned. +If no such symbol is accessible in package, +a new symbol with the given name is created +and entered into package as an internal symbol, +or as an external symbol if the package is the KEYWORD package; +package becomes the home package of the created symbol. +

    +

    The first value returned by intern, symbol, +is the symbol that was found or +created. +The meaning of the secondary value, status, is as follows: +

    +
    :internal
    +

    The symbol was found +and is +present in package as an internal symbol. +

    +
    +
    :external
    +

    The symbol was found +and is +present as an external symbol. +

    +
    +
    :inherited
    +

    The symbol was found +and is inherited via use-package +(which implies that the symbol is internal). +

    +
    +
    nil
    +

    No pre-existing symbol was found, +so one was created. +

    +

    It is implementation-dependent whether the string +that becomes the new symbol’s name is the given +string or a copy of it. Once a string +has been given as the string argument to +intern in this situation where a new symbol is created, +the consequences are undefined if a +subsequent attempt is made to alter that string. +

    +
    +
    + +

    Examples::

    + +
    +
     (in-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (intern "Never-Before") ⇒  |Never-Before|, NIL
+ (intern "Never-Before") ⇒  |Never-Before|, :INTERNAL 
+ (intern "NEVER-BEFORE" "KEYWORD") ⇒  :NEVER-BEFORE, NIL
+ (intern "NEVER-BEFORE" "KEYWORD") ⇒  :NEVER-BEFORE, :EXTERNAL
+
    + +

    See Also::

    + +

    find-symbol +, +read +, +symbol, +unintern +, +Symbols as Tokens +

    +

    Notes::

    + +

    intern does not need to do any name conflict checking +because it never creates a new symbol +if there is already an accessible symbol with the name given. +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/internal_002dtime_002dunits_002dper_002dsecond.html b/info/gcl/internal_002dtime_002dunits_002dper_002dsecond.html new file mode 100644 index 0000000..84eba5a --- /dev/null +++ b/info/gcl/internal_002dtime_002dunits_002dper_002dsecond.html @@ -0,0 +1,69 @@ + + + + + +internal-time-units-per-second (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.11 internal-time-units-per-second [Constant Variable]

    + +

    Constant Value::

    + +

    A positive integer, the magnitude of which is implementation-dependent. +

    +

    Description::

    + +

    The number of internal time units in one second. +

    +

    See Also::

    + +

    get-internal-run-time +, +get-internal-real-time +

    +

    Notes::

    + +

    These units form the basis of the Internal Time format representation. +

    + + + + + diff --git a/info/gcl/intersection.html b/info/gcl/intersection.html new file mode 100644 index 0000000..f070357 --- /dev/null +++ b/info/gcl/intersection.html @@ -0,0 +1,174 @@ + + + + + +intersection (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.43 intersection, nintersection [Function]

    + +

    intersection list-1 list-2 &key key test test-not ⇒ result-list +

    +

    nintersection list-1 list-2 &key key test test-not ⇒ result-list +

    +

    Arguments and Values::

    + +

    list-1—a proper list. +

    +

    list-2—a proper list. +

    +

    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. +

    +

    result-list—a list. +

    +

    Description::

    + +

    intersection and nintersection return a list +that contains every element that occurs in both list-1 and list-2. +

    +

    nintersection is the destructive version of intersection. +It performs the same operation, +but may destroy list-1 using its cells to construct the result. +

    +

    list-2 is not destroyed. +

    +

    The intersection operation is described as follows. +For all possible ordered pairs consisting of + one element from list-1 +and one element from list-2, +:test or :test-not are used +to determine whether they satisfy the test. +The first argument to the :test or :test-not +function is an element of list-1; the second argument is an +element of list-2. +If :test or :test-not is not supplied, eql +is used. +It is an error if :test and :test-not are supplied in +the same function call. +

    +

    If :key is supplied (and not nil), it is used to +extract the part to be tested from the list element. +The argument to the :key function +is an element of either list-1 or list-2; +the :key function typically returns part of the supplied element. +If :key is not supplied or nil, the list-1 and +list-2 elements are used. +

    +

    For every pair that satifies the test, +exactly one of the two elements of the pair will be put in the result. +No element from either list appears in the result that does not +satisfy the test for +an element from the other list. +If one of the lists contains duplicate +elements, there may be duplication in the result. +

    +

    There is no guarantee that the order of elements in the result will +reflect the ordering of the arguments in any particular way. +The result list may share cells with, +or be eq to, either list-1 or list-2 +if appropriate. +

    +

    Examples::

    + +
    +
     (setq list1 (list 1 1 2 3 4 a b c "A" "B" "C" "d")
+       list2 (list 1 4 5 b c d "a" "B" "c" "D")) 
+  ⇒  (1 4 5 B C D "a" "B" "c" "D")
+ (intersection list1 list2) ⇒  (C B 4 1 1)
+ (intersection list1 list2 :test 'equal) ⇒  ("B" C B 4 1 1)
+ (intersection list1 list2 :test #'equalp) ⇒  ("d" "C" "B" "A" C B 4 1 1) 
+ (nintersection list1 list2) ⇒  (1 1 4 B C)
+ list1 ⇒  implementation-dependent ;e.g., (1 1 4 B C)
+ list2 ⇒  implementation-dependent ;e.g., (1 4 5 B C D "a" "B" "c" "D")
+ (setq list1 (copy-list '((1 . 2) (2 . 3) (3 . 4) (4 . 5))))
+⇒  ((1 . 2) (2 . 3) (3 . 4) (4 . 5)) 
+ (setq list2 (copy-list '((1 . 3) (2 . 4) (3 . 6) (4 . 8))))
+⇒  ((1 . 3) (2 . 4) (3 . 6) (4 . 8)) 
+ (nintersection list1 list2 :key #'cdr) ⇒  ((2 . 3) (3 . 4)) 
+ list1 ⇒  implementation-dependent ;e.g., ((1 . 2) (2 . 3) (3 . 4)) 
+ list2 ⇒  implementation-dependent ;e.g., ((1 . 3) (2 . 4) (3 . 6) (4 . 8)) 
+
    + +

    Side Effects::

    + +

    nintersection can modify list-1, +

    +

    but not list-2. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list-1 and list-2 are not proper lists. +

    +

    See Also::

    + +

    union +, +

    +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    Since the nintersection side effect is not required, +it should not be used in for-effect-only + positions in portable code. +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/invalid_002dmethod_002derror.html b/info/gcl/invalid_002dmethod_002derror.html new file mode 100644 index 0000000..d1a80cb --- /dev/null +++ b/info/gcl/invalid_002dmethod_002derror.html @@ -0,0 +1,94 @@ + + + + + +invalid-method-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.15 invalid-method-error [Function]

    + +

    invalid-method-error method format-control &rest args ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    method—a method. +

    +

    format-control—a format control. +

    +

    args—format arguments for the format-control. +

    +

    Description::

    + +

    The function invalid-method-error is used to signal an error of type error +when there is an applicable method whose qualifiers are not valid for +the method combination type. The error message is constructed by +using the format-control suitable for format +and any args to it. Because an +implementation may need to add additional contextual information to +the error message, invalid-method-error should be called only +within the dynamic extent of a method combination function. +

    +

    The function invalid-method-error is called automatically when a +method fails to satisfy every qualifier pattern and predicate in a +define-method-combination form. A method combination function +that imposes additional restrictions should call +invalid-method-error explicitly if it encounters a method +it cannot accept. +

    +

    Whether invalid-method-error returns to its caller or exits via +throw is implementation-dependent. +

    +

    Side Effects::

    + +

    The debugger might be entered. +

    +

    Affected By::

    + +

    *break-on-signals* +

    +

    See Also::

    + +

    define-method-combination +

    + + + + + diff --git a/info/gcl/invoke_002ddebugger.html b/info/gcl/invoke_002ddebugger.html new file mode 100644 index 0000000..40c55af --- /dev/null +++ b/info/gcl/invoke_002ddebugger.html @@ -0,0 +1,102 @@ + + + + + +invoke-debugger (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.22 invoke-debugger [Function]

    + +

    invoke-debugger condition + ⇒ #<NoValue> +

    +

    Arguments and Values::

    + +

    condition—a condition object. +

    +

    Description::

    + +

    invoke-debugger attempts to enter the debugger with condition. +

    +

    If *debugger-hook* is not nil, it should be a function +(or the name of a function) to be called prior to entry to +the standard debugger. The function is called with +*debugger-hook* bound to nil, and the function +must accept two arguments: the condition +and the value of *debugger-hook* prior to binding it to nil. +If the function returns normally, +the standard debugger is entered. +

    +

    The standard debugger never directly returns. Return can occur only by a +non-local transfer of control, such as the use of a restart function. +

    +

    Examples::

    + +
    +
     (ignore-errors ;Normally, this would suppress debugger entry
+   (handler-bind ((error #'invoke-debugger)) ;But this forces debugger entry
+     (error "Foo.")))
+Debug: Foo.
+To continue, type :CONTINUE followed by an option number:
+ 1: Return to Lisp Toplevel.
+Debug>
+
    + +

    Side Effects::

    + +

    *debugger-hook* is bound to nil, +program execution is discontinued, +and the debugger is entered. +

    +

    Affected By::

    + +

    *debug-io* and *debugger-hook*. +

    +

    See Also::

    + +

    error +, +break +

    + + + + + diff --git a/info/gcl/invoke_002drestart.html b/info/gcl/invoke_002drestart.html new file mode 100644 index 0000000..cc82fa7 --- /dev/null +++ b/info/gcl/invoke_002drestart.html @@ -0,0 +1,113 @@ + + + + + +invoke-restart (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.34 invoke-restart [Function]

    + +

    invoke-restart restart &rest arguments ⇒ {result}* +

    +

    Arguments and Values::

    + +

    restart—a restart designator. +

    +

    argument—an object. +

    +

    results—the values returned by the function + associated with restart, if that function returns. +

    +

    Description::

    + +

    Calls the function associated with restart, +passing arguments to it. +Restart must be valid in the current dynamic environment. +

    +

    Examples::

    +
    +
     (defun add3 (x) (check-type x number) (+ x 3))
+
+ (foo 'seven)
+ |>  Error: The value SEVEN was not of type NUMBER.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a different value to use.
+ |>   2: Return to Lisp Toplevel.
+ |>  Debug> |>>(invoke-restart 'store-value 7)<<|
+⇒  10
+
    + +

    Side Effects::

    + +

    A non-local transfer of control might be done by the restart. +

    +

    Affected By::

    + +

    Existing restarts. +

    +

    Exceptional Situations::

    + +

    If restart is not valid, an error of type control-error is signaled. +

    +

    See Also::

    + +

    find-restart +, +restart-bind +, +restart-case +, +invoke-restart-interactively +

    +

    Notes::

    + +

    The most common use for invoke-restart is in a handler. +It might be used explicitly, or implicitly through invoke-restart-interactively +or a restart function. +

    +

    Restart functions call invoke-restart, not vice versa. That is, +invoke-restart provides primitive functionality, and restart functions +are non-essential “syntactic sugar.” +

    + + + + + diff --git a/info/gcl/invoke_002drestart_002dinteractively.html b/info/gcl/invoke_002drestart_002dinteractively.html new file mode 100644 index 0000000..4b5dc21 --- /dev/null +++ b/info/gcl/invoke_002drestart_002dinteractively.html @@ -0,0 +1,138 @@ + + + + + +invoke-restart-interactively (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.35 invoke-restart-interactively [Function]

    + +

    invoke-restart-interactively restart ⇒ {result}* +

    +

    Arguments and Values::

    + +

    restart—a restart designator. +

    +

    results—the values returned by the function + associated with restart, if that function returns. +

    +

    Description::

    + +

    invoke-restart-interactively calls the function associated +with restart, prompting for any necessary arguments. +If restart is a name, it must be valid in the current dynamic environment. +

    +

    invoke-restart-interactively +prompts for arguments by executing + the code provided in the :interactive keyword to +restart-case or + :interactive-function keyword to restart-bind. +

    +

    If no such options have been supplied in the corresponding +restart-bind or restart-case, +then the consequences are undefined if the restart takes + required arguments. If the arguments are optional, an argument list of + nil is used. +

    +

    Once the arguments have been determined, +invoke-restart-interactively + executes the following: +

    +
    +
     (apply #'invoke-restart restart arguments)
+
    + +

    Examples::

    + +
    +
     (defun add3 (x) (check-type x number) (+ x 3))
+
+ (add3 'seven)
+ |>  Error: The value SEVEN was not of type NUMBER.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a different value to use.
+ |>   2: Return to Lisp Toplevel.
+ |>  Debug> |>>(invoke-restart-interactively 'store-value)<<|
+ |>  Type a form to evaluate and use: |>>7<<|
+⇒  10
+
    + +

    Side Effects::

    + +

    If prompting for arguments is necesary, +some typeout may occur (on query I/O). +

    +

    A non-local transfer of control might be done by the restart. +

    +

    Affected By::

    + +

    *query-io*, active restarts +

    +

    Exceptional Situations::

    + +

    If restart is not valid, an error of type control-error +is signaled. +

    +

    See Also::

    + +

    find-restart +, +invoke-restart +, +restart-case +, +restart-bind +

    +

    Notes::

    + +

    invoke-restart-interactively is used internally by the debugger +and may also be useful in implementing other portable, interactive debugging +tools. +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/keyword.html b/info/gcl/keyword.html new file mode 100644 index 0000000..1ef829e --- /dev/null +++ b/info/gcl/keyword.html @@ -0,0 +1,80 @@ + + + + + +keyword (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.2 keyword [Type]

    + +

    Supertypes::

    + +

    keyword, +symbol, +t +

    +

    Description::

    + +

    The type keyword includes all symbols interned the KEYWORD package. +

    +

    Interning a symbol in the KEYWORD package has three automatic effects: +

    +
    +
    1.
    +

    It causes the symbol to become bound to itself. +

    +
    2.
    +

    It causes the symbol to become an external symbol + of the KEYWORD package. +

    +
    3.
    +

    It causes the symbol to become a constant variable. +

    +
    + +

    See Also::

    + +

    keywordp +

    + + + + + diff --git a/info/gcl/keywordp.html b/info/gcl/keywordp.html new file mode 100644 index 0000000..4e8b17d --- /dev/null +++ b/info/gcl/keywordp.html @@ -0,0 +1,89 @@ + + + + + +keywordp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.4 keywordp [Function]

    + +

    keywordp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is a keyword_1; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (keywordp 'elephant) ⇒  false
+ (keywordp 12) ⇒  false
+ (keywordp :test) ⇒  true
+ (keywordp ':test) ⇒  true
+ (keywordp nil) ⇒  false
+ (keywordp :nil) ⇒  true
+ (keywordp '(:test)) ⇒  false
+ (keywordp "hello") ⇒  false
+ (keywordp ":hello") ⇒  false
+ (keywordp '&optional) ⇒  false
+
    + +

    See Also::

    + +

    constantp +, +keyword +, +symbolp +, +symbol-package +

    + + + + + diff --git a/info/gcl/lambda-_0028Symbol_0029.html b/info/gcl/lambda-_0028Symbol_0029.html new file mode 100644 index 0000000..9b5231e --- /dev/null +++ b/info/gcl/lambda-_0028Symbol_0029.html @@ -0,0 +1,97 @@ + + + + + +lambda (Symbol) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.1 lambda [Symbol]

    + +

    Syntax::

    + +

    lambda lambda-list [[{declaration}* | documentation]] {form}* +

    Arguments::

    + +

    lambda-list—an ordinary lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    form—a form. +

    +

    Description::

    + +

    A lambda expression is a list that can be used in place of a +function name in certain contexts to denote a function by +directly describing its behavior rather than indirectly by referring to the +name of an established function. +

    +

    Documentation is attached to the denoted function (if any +is actually created) as a documentation string. +

    +

    See Also::

    + +

    function, +documentation +, +Lambda Expressions, +Lambda Forms, +Syntactic Interaction of Documentation Strings and Declarations +

    +

    Notes::

    + +

    The lambda form +

    +
    +
     ((lambda lambda-list . body) . arguments)
+
    + +

    is semantically equivalent to the function form +

    +
    +
     (funcall #'(lambda lambda-list . body) . arguments)
+
    + + + + + + diff --git a/info/gcl/lambda.html b/info/gcl/lambda.html new file mode 100644 index 0000000..3c31be4 --- /dev/null +++ b/info/gcl/lambda.html @@ -0,0 +1,96 @@ + + + + + +lambda (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.2 lambda [Macro]

    + +

    lambda lambda-list [[{declaration}* | documentation]] {form}* ⇒ function +

    +

    Arguments and Values::

    + +

    lambda-list—an ordinary lambda list. +

    +

    declaration—a declare expression; not evaluated. +

    +

    documentation—a string; not evaluated. +

    +

    form—a form. +

    +

    function—a function. +

    +

    Description::

    + +

    Provides a shorthand notation for a function special form +involving a lambda expression such that: +

    +
    +
        (lambda lambda-list [[{declaration}* | documentation]] {form}*)
+ ≡ (function (lambda lambda-list [[{declaration}* | documentation]] {form}*))
+ ≡ #'(lambda lambda-list [[{declaration}* | documentation]] {form}*)
+
    + +

    Examples::

    + +
    +
     (funcall (lambda (x) (+ x 3)) 4) ⇒  7
+
    + +

    See Also::

    + +

    lambda (symbol) +

    +

    Notes::

    + +

    This macro could be implemented by: +

    +
    +
    (defmacro lambda (&whole form &rest bvl-decls-and-body)
+  (declare (ignore bvl-decls-and-body))
+  `#',form)
+
    + + + + + + diff --git a/info/gcl/lambda_002dlist_002dkeywords.html b/info/gcl/lambda_002dlist_002dkeywords.html new file mode 100644 index 0000000..e2baa26 --- /dev/null +++ b/info/gcl/lambda_002dlist_002dkeywords.html @@ -0,0 +1,82 @@ + + + + + +lambda-list-keywords (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.13 lambda-list-keywords [Constant Variable]

    + +

    Constant Value::

    + +

    a list, the elements of which are implementation-dependent, +but which must contain at least the symbols + &allow-other-keys, + &aux, + &body, + &environment, + &key, + &optional, + &rest, +and + &whole. +

    +

    Description::

    + +

    A list of all the lambda list keywords used +in the implementation, including the additional ones +used only by macro definition forms. +

    +

    See Also::

    + +

    defun +, +flet +, +defmacro +, +macrolet, +The Evaluation Model +

    + + + + + diff --git a/info/gcl/lambda_002dparameters_002dlimit.html b/info/gcl/lambda_002dparameters_002dlimit.html new file mode 100644 index 0000000..f88acda --- /dev/null +++ b/info/gcl/lambda_002dparameters_002dlimit.html @@ -0,0 +1,70 @@ + + + + + +lambda-parameters-limit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.14 lambda-parameters-limit [Constant Variable]

    + +

    Constant Value::

    + +

    implementation-dependent, but not smaller than 50. +

    +

    Description::

    + +

    A positive integer that is the upper exclusive bound on +the number of parameter names that can appear +in a single lambda list. +

    +

    See Also::

    + +

    call-arguments-limit +

    +

    Notes::

    + +

    Implementors are encouraged to make the value of +lambda-parameters-limit as large as possible. +

    + + + + + diff --git a/info/gcl/last.html b/info/gcl/last.html new file mode 100644 index 0000000..79e9ae5 --- /dev/null +++ b/info/gcl/last.html @@ -0,0 +1,131 @@ + + + + + +last (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.29 last [Function]

    + +

    last list &optional n ⇒ tail +

    +

    Arguments and Values::

    + +

    list—a list, +

    +

    which might be a dotted list but must not be a circular list. +

    +

    n—a non-negative integer. + The default is 1. +

    +

    tail—an object. +

    +

    Description::

    + +

    last returns the last n conses + (not the last n elements) of list). +If list is (), last returns (). +

    +

    If n is zero, + the atom that terminates list is returned. +If n is greater than or equal to the number of cons cells in list, + the result is list. +

    +

    Examples::

    + +
    +
     (last nil) ⇒  NIL
+ (last '(1 2 3)) ⇒  (3)
+ (last '(1 2 . 3)) ⇒  (2 . 3)
+ (setq x (list 'a 'b 'c 'd)) ⇒  (A B C D)
+ (last x) ⇒  (D)
+ (rplacd (last x) (list 'e 'f)) x ⇒  (A B C D E F)
+ (last x) ⇒  (F)
+
+ (last '(a b c))   ⇒  (C)
+
+ (last '(a b c) 0) ⇒  ()
+ (last '(a b c) 1) ⇒  (C)
+ (last '(a b c) 2) ⇒  (B C)
+ (last '(a b c) 3) ⇒  (A B C)
+ (last '(a b c) 4) ⇒  (A B C)
+
+ (last '(a . b) 0) ⇒  B
+ (last '(a . b) 1) ⇒  (A . B)
+ (last '(a . b) 2) ⇒  (A . B)
+
    + +

    Exceptional Situations::

    + +

    The consequences are undefined if list is a circular list. +

    +

    Should signal an error of type type-error + if n is not a non-negative integer. +

    +

    See Also::

    + +

    butlast +, +nth +

    +

    Notes::

    + +

    The following code could be used to define last. +

    +
    +
     (defun last (list &optional (n 1))
+   (check-type n (integer 0))
+   (do ((l list (cdr l))
+        (r list)
+        (i 0 (+ i 1)))
+       ((atom l) r)
+     (if (>= i n) (pop r))))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/lcm.html b/info/gcl/lcm.html new file mode 100644 index 0000000..9fd9f45 --- /dev/null +++ b/info/gcl/lcm.html @@ -0,0 +1,104 @@ + + + + + +lcm (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.34 lcm [Function]

    + +

    lcm &rest integers ⇒ least-common-multiple +

    +

    Arguments and Values::

    + +

    integer—an integer. +

    +

    least-common-multiple—a non-negative integer. +

    +

    Description::

    + +

    lcm returns the least common multiple of the integers. +

    +

    If no integer is supplied, the integer 1 is returned. +

    +

    If only one integer is supplied, +the absolute value of that integer is returned. +

    +

    For two arguments that are not both zero, +

    +
    +
     (lcm a b) ≡ (/ (abs (* a b)) (gcd a b))
+
    + +

    If one or both arguments are zero, +

    +
    +
     (lcm a 0) ≡ (lcm 0 a) ≡ 0
+
    + +

    For three or more arguments, +

    +
    +
     (lcm a b c ... z) ≡ (lcm (lcm a b) c ... z)
+
    + +

    Examples::

    +
    +
     (lcm 10) ⇒  10
+ (lcm 25 30) ⇒  150
+ (lcm -24 18 10) ⇒  360
+ (lcm 14 35) ⇒  70
+ (lcm 0 5) ⇒  0
+ (lcm 1 2 3 4 5 6) ⇒  60
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if any argument is not an integer. +

    +

    See Also::

    + +

    gcd +

    + + + + + diff --git a/info/gcl/ldb.html b/info/gcl/ldb.html new file mode 100644 index 0000000..9842712 --- /dev/null +++ b/info/gcl/ldb.html @@ -0,0 +1,130 @@ + + + + + +ldb (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.69 ldb [Accessor]

    + +

    ldb bytespec integer ⇒ byte +

    +

    (setf ( ldb bytespec place) new-byte)
    +

    +

    Pronunciation::

    + +

    pronounced ’lid ib + or pronounced ’lid e b + or pronounced ’el ’d\=e ’b\=e +

    +

    Arguments and Values::

    + +

    bytespec—a byte specifier. +

    +

    integer—an integer. +

    +

    byte, new-byte—a non-negative integer. +

    +

    Description::

    + +

    ldb extracts and returns the byte of integer +specified by bytespec. +

    +

    ldb returns an integer in which the bits with weights +2^(s-1) through 2^0 are the same as those in +integer with weights 2^(p+s-1) +through 2^p, and all other bits zero; s is +(byte-size bytespec) +and p is (byte-position bytespec). +

    +

    setf may be used with ldb to modify +a byte within the integer that is stored +in a given place. +

    +

    The order of evaluation, when an ldb form is supplied +to setf, is exactly left-to-right. +

    + + + + +

    The effect is to perform a dpb operation +and then store the result back into the place. +

    +

    Examples::

    + +
    +
     (ldb (byte 2 1) 10) ⇒  1
+ (setq a (list 8)) ⇒  (8)
+ (setf (ldb (byte 2 1) (car a)) 1) ⇒  1
+ a ⇒  (10)
+
    + +

    See Also::

    + +

    byte +, +byte-position, +byte-size, +dpb +

    +

    Notes::

    + +
    +
     (logbitp j (ldb (byte s p) n))
+    ≡ (and (< j s) (logbitp (+ j p) n))
+
    + +

    In general, +

    +
    +
     (ldb (byte 0 x) y) ⇒  0
+
    + +

    for all valid values of x and y. +

    +

    Historically, the name “ldb” comes from a DEC PDP-10 assembly language +instruction meaning “load byte.” +

    + + + + + diff --git a/info/gcl/ldb_002dtest.html b/info/gcl/ldb_002dtest.html new file mode 100644 index 0000000..d84f081 --- /dev/null +++ b/info/gcl/ldb_002dtest.html @@ -0,0 +1,89 @@ + + + + + +ldb-test (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.70 ldb-test [Function]

    + +

    ldb-test bytespec integer ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    bytespec—a byte specifier. +

    +

    integer—an integer. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if any of the bits of the byte in integer +specified by bytespec is non-zero; otherwise returns false. +

    +

    Examples::

    + +
    +
     (ldb-test (byte 4 1) 16) ⇒  true
+ (ldb-test (byte 3 1) 16) ⇒  false
+ (ldb-test (byte 3 2) 16) ⇒  true
+
    + +

    See Also::

    + +

    byte +, +ldb +, +zerop +

    +

    Notes::

    +
    +
     (ldb-test bytespec n) ≡
+ (not (zerop (ldb bytespec n))) ≡
+ (logtest (ldb bytespec -1) n)
+
    + + + + + + diff --git a/info/gcl/ldiff.html b/info/gcl/ldiff.html new file mode 100644 index 0000000..50ca04e --- /dev/null +++ b/info/gcl/ldiff.html @@ -0,0 +1,164 @@ + + + + + +ldiff (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.30 ldiff, tailp [Function]

    + +

    ldiff list object ⇒ result-list +

    +

    tailp object list ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    list—a list, +

    +

    which might be a dotted list. +

    +

    object—an object. +

    +

    result-list—a list. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    If object is the same as some tail of list, +tailp returns true; +otherwise, it returns false. +

    +

    If object is the same as some tail of list, +ldiff returns a fresh list +of the elements of list +that precede object in the list structure of list; +otherwise, it returns a copy_2 of list. +

    +

    Examples::

    + +
    +
     (let ((lists '#((a b c) (a b c . d))))
+   (dotimes (i (length lists)) ()
+     (let ((list (aref lists i)))
+       (format t "~2&list=~S ~21T(tailp object list)~
+                  ~44T(ldiff list object)~
+         (let ((objects (vector list (cddr list) (copy-list (cddr list))
+                                '(f g h) '() 'd 'x)))
+           (dotimes (j (length objects)) ()
+             (let ((object (aref objects j)))
+               (format t "~& object=~S ~21T~S ~44T~S"
+                       object (tailp object list) (ldiff list object))))))))
+ |>  
+ |>  list=(A B C)         (tailp object list)    (ldiff list object)
+ |>   object=(A B C)      T                      NIL
+ |>   object=(C)          T                      (A B)
+ |>   object=(C)          NIL                    (A B C)
+ |>   object=(F G H)      NIL                    (A B C)
+ |>   object=NIL          T                      (A B C)
+ |>   object=D            NIL                    (A B C)
+ |>   object=X            NIL                    (A B C)
+ |>  
+ |>  list=(A B C . D)     (tailp object list)    (ldiff list object)
+ |>   object=(A B C . D)  T                      NIL
+ |>   object=(C . D)      T                      (A B)
+ |>   object=(C . D)      NIL                    (A B C . D)
+ |>   object=(F G H)      NIL                    (A B C . D)
+ |>   object=NIL          NIL                    (A B C . D)
+ |>   object=D            T                      (A B C)
+ |>   object=X            NIL                    (A B C . D)
+⇒  NIL
+
    + +

    Side Effects::

    + +

    Neither ldiff nor tailp modifies either of its arguments. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list is not a proper list or a dotted list. +

    +

    See Also::

    + +

    set-difference +

    +

    Notes::

    + +

    If the list is a circular list, +tailp will reliably yield a value +only if the given object is in fact a tail of list. +Otherwise, the consequences are unspecified: +a given implementation which detects the circularity must return false, +but since an implementation is not obliged to detect such a situation, +tailp might just loop indefinitely without returning in that case. +

    +

    tailp could be defined as follows: +

    +
    +
     (defun tailp (object list)
+   (do ((list list (cdr list)))
+       ((atom list) (eql list object))
+      (if (eql object list)
+          (return t))))
+
    + +

    and ldiff could be defined by: +

    +
    +
    (defun ldiff (list object)
+  (do ((list list (cdr list))
+       (r '() (cons (car list) r)))
+      ((atom list)
+       (if (eql list object) (nreverse r) (nreconc r list)))
+    (when (eql object list)
+      (return (nreverse r)))))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/length.html b/info/gcl/length.html new file mode 100644 index 0000000..7832223 --- /dev/null +++ b/info/gcl/length.html @@ -0,0 +1,89 @@ + + + + + +length (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.11 length [Function]

    + +

    length sequence ⇒ n +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    n—a non-negative integer. +

    +

    Description::

    + +

    Returns the number of elements in sequence. +

    +

    If sequence is a vector with a fill pointer, +the active length as specified by the fill pointer is returned. +

    +

    Examples::

    + +
    +
     (length "abc") ⇒  3
+ (setq str (make-array '(3) :element-type 'character 
+                            :initial-contents "abc"
+                            :fill-pointer t)) ⇒  "abc"
+ (length str) ⇒  3
+ (setf (fill-pointer str) 2) ⇒  2
+ (length str) ⇒  2
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    list-length +, +sequence +

    + + + + + diff --git a/info/gcl/let.html b/info/gcl/let.html new file mode 100644 index 0000000..9a6d44d --- /dev/null +++ b/info/gcl/let.html @@ -0,0 +1,183 @@ + + + + + +let (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.18 let, let* [Special Operator]

    + +

    let ({var | (var [init-form])}*) {declaration}* {form}* ⇒ {result}* +

    +

    let* ({var | (var [init-form])}*) {declaration}* {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a symbol. +

    +

    init-form—a form. +

    +

    declaration—a declare expression; not evaluated. +

    +

    form—a form. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    let and let* +create new variable bindings and +execute a series of forms that use these bindings. +let performs the bindings in parallel and +let* does them sequentially. +

    +

    The form +

    +
    +
     (let ((var1 init-form-1)
+       (var2 init-form-2)
+       ...
+       (varm init-form-m))
+   declaration1
+   declaration2
+   ...
+   declarationp
+   form1
+   form2
+   ...
+   formn)
+
    + +

    first evaluates the expressions init-form-1, init-form-2, and so on, +

    +

    in that order, saving the resulting values. +Then all of the variables varj are bound to the corresponding +values; each binding is lexical unless +there is a special declaration to the contrary. +The expressions formk are then evaluated +in order; the values of all but the last are discarded +(that is, the body of a let +is an implicit progn). +

    +

    let* +is similar to let, but the bindings of variables +are performed sequentially rather than in parallel. +The expression for the init-form of a +var can refer to vars +previously bound in the let*. +

    +

    The form +

    +
    +
     (let* ((var1 init-form-1)
+        (var2 init-form-2)
+        ...
+        (varm init-form-m))
+   declaration1
+   declaration2
+   ...
+   declarationp
+   form1
+   form2
+   ...
+   formn)
+
    + +

    first evaluates the expression init-form-1, then binds the variable +var1 to that value; then it evaluates init-form-2 and binds +

    +

    var2, and so on. +The expressions formj are then evaluated +in order; the values of all but the last are discarded +(that is, the body of let* is an implicit progn). +

    +

    For both let and let*, +if there is not an init-form associated with a var, +var is initialized to nil. +

    +

    The special form let +has the property that the scope +of the name binding does not include any +initial value form. +For let*, a variable’s scope also includes the + remaining initial value forms for subsequent variable bindings. +

    +

    Examples::

    + +
    +
     (setq a 'top) ⇒  TOP
+ (defun dummy-function () a) ⇒  DUMMY-FUNCTION
+ (let ((a 'inside) (b a))
+    (format nil "~S ~S ~S" a b (dummy-function))) ⇒  "INSIDE TOP TOP" 
+ (let* ((a 'inside) (b a))
+    (format nil "~S ~S ~S" a b (dummy-function))) ⇒  "INSIDE INSIDE TOP" 
+ (let ((a 'inside) (b a))
+    (declare (special a))
+    (format nil "~S ~S ~S" a b (dummy-function))) ⇒  "INSIDE TOP INSIDE"
+
    + +

    The code +

    +
    +
     (let (x)
+   (declare (integer x))
+   (setq x (gcd y z))
+   ...)
+
    + +

    is incorrect; although x is indeed set before it is used, +and is set to a value of the declared type integer, nevertheless +x initially takes on the value nil in violation of the type +declaration. +

    +

    See Also::

    + +

    progv +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/lisp_002dimplementation_002dtype.html b/info/gcl/lisp_002dimplementation_002dtype.html new file mode 100644 index 0000000..0f0dc11 --- /dev/null +++ b/info/gcl/lisp_002dimplementation_002dtype.html @@ -0,0 +1,90 @@ + + + + + +lisp-implementation-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.24 lisp-implementation-type,

    +

    lisp-implementation-version

    +

    [Function] +

    +

    lisp-implementation-type <no arguments> ⇒ description +

    +

    lisp-implementation-version <no arguments> ⇒ description +

    +

    Arguments and Values::

    + +

    description—a string or nil. +

    +

    Description::

    + +

    lisp-implementation-type and lisp-implementation-version +identify the current implementation of Common Lisp. +

    +

    lisp-implementation-type returns a string +that identifies the generic name of +the particular Common Lisp implementation. +

    +

    lisp-implementation-version +returns a string that identifies the version of +the particular Common Lisp implementation. +

    +

    If no appropriate +and relevant result can be produced, nil is returned instead +of a string. +

    +

    Examples::

    + +
    +
     (lisp-implementation-type)
+⇒  "ACME Lisp"
+OR⇒ "Joe's Common Lisp"
+ (lisp-implementation-version)
+⇒  "1.3a"
+⇒  "V2"
+OR⇒ "Release 17.3, ECO #6"
+
    + + + + + + diff --git a/info/gcl/list-_0028Function_0029.html b/info/gcl/list-_0028Function_0029.html new file mode 100644 index 0000000..3732925 --- /dev/null +++ b/info/gcl/list-_0028Function_0029.html @@ -0,0 +1,116 @@ + + + + + +list (Function) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.15 list, list* [Function]

    + +

    list &rest objects ⇒ list +

    +

    list* &rest objects^+ ⇒ result +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    list—a list. +

    +

    result—an object. +

    +

    Description::

    + +

    list returns a list containing the supplied objects. +

    +

    list* is like list except that +the last argument to list becomes +the car of the last cons constructed, while +the last argument to list* becomes +the cdr of the last cons constructed. +Hence, any given call to list* always produces one fewer conses +than a call to list with the same number of arguments. +

    +

    If the last argument to list* is a list, +the effect is to construct a new list which is similar, but +which has additional elements added to the front corresponding to +the preceding arguments of list*. +

    +

    If list* receives only one object, +that object is returned, regardless of whether or not it is a list. +

    +

    Examples::

    + +
    +
     (list 1) ⇒  (1)
+ (list* 1) ⇒  1
+ (setq a 1) ⇒  1
+ (list a 2) ⇒  (1 2)
+ '(a 2) ⇒  (A 2)
+ (list 'a 2) ⇒  (A 2)
+ (list* a 2) ⇒  (1 . 2)
+ (list) ⇒  NIL ;i.e., ()
+ (setq a '(1 2)) ⇒  (1 2)
+ (eq a (list* a)) ⇒  true
+ (list 3 4 'a (car '(b . c)) (+ 6 -2)) ⇒  (3 4 A B 4)
+ (list* 'a 'b 'c 'd) ≡ (cons 'a (cons 'b (cons 'c 'd))) ⇒  (A B C . D)
+ (list* 'a 'b 'c '(d e f)) ⇒  (A B C D E F)
+
    + +

    See Also::

    + +

    cons +

    +

    Notes::

    + +
    +
     (list* x) ≡ x
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/list-_0028System-Class_0029.html b/info/gcl/list-_0028System-Class_0029.html new file mode 100644 index 0000000..7c66740 --- /dev/null +++ b/info/gcl/list-_0028System-Class_0029.html @@ -0,0 +1,97 @@ + + + + + +list (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.1 list [System Class]

    + +

    Class Precedence List::

    + +

    list, +sequence, +t +

    +

    Description::

    + +

    A list + + is a chain of conses in which the car of each +cons is an element of the list, and the cdr of +each cons is either the next link in the chain or a terminating +atom. +

    +

    A proper list + + is a chain of conses terminated by +the empty list + +, (), which is itself a proper list. +A dotted list + + is a list which has a terminating atom +that is not the empty list. +A circular list + + is a chain of conses that has no termination +because some cons in the chain is the cdr of a later cons. +

    +

    Dotted lists and circular lists are also lists, but usually +the unqualified term “list” within this specification means proper list. +Nevertheless, the type list unambiguously includes dotted lists +and circular lists. +

    +

    For each element of a list there is a cons. +The empty list has no elements and is not a cons. +

    +

    The types cons and null form an exhaustive partition +of the type list. +

    +

    See Also::

    + +

    Left-Parenthesis, +Printing Lists and Conses +

    + + + + + diff --git a/info/gcl/list_002dall_002dpackages.html b/info/gcl/list_002dall_002dpackages.html new file mode 100644 index 0000000..41ed1d6 --- /dev/null +++ b/info/gcl/list_002dall_002dpackages.html @@ -0,0 +1,81 @@ + + + + + +list-all-packages (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.7 list-all-packages [Function]

    + +

    list-all-packages <no arguments> ⇒ packages +

    +

    Arguments and Values::

    + +

    packages—a list of package objects. +

    +

    Description::

    + +

    list-all-packages returns a +

    +

    fresh +

    +

    list of +

    +

    all registered packages. +

    +

    Examples::

    + +
    +
     (let ((before (list-all-packages)))
+    (make-package 'temp)
+    (set-difference (list-all-packages) before)) ⇒  (#<PACKAGE "TEMP">)
+
    + +

    Affected By::

    + +

    defpackage, +delete-package, +make-package +

    + + + + + diff --git a/info/gcl/list_002dlength.html b/info/gcl/list_002dlength.html new file mode 100644 index 0000000..afe80c2 --- /dev/null +++ b/info/gcl/list_002dlength.html @@ -0,0 +1,111 @@ + + + + + +list-length (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.16 list-length [Function]

    + +

    list-length list ⇒ length +

    +

    Arguments and Values::

    + +

    list—a proper list or a circular list. +

    +

    length—a non-negative integer, or nil. +

    +

    Description::

    + +

    Returns the length of list if list is a proper list. +Returns nil if list is a circular list. +

    +

    Examples::

    + +
    +
     (list-length '(a b c d)) ⇒  4
+ (list-length '(a (b c) d)) ⇒  3
+ (list-length '()) ⇒  0
+ (list-length nil) ⇒  0
+ (defun circular-list (&rest elements)
+   (let ((cycle (copy-list elements))) 
+     (nconc cycle cycle)))
+ (list-length (circular-list 'a 'b)) ⇒  NIL
+ (list-length (circular-list 'a)) ⇒  NIL
+ (list-length (circular-list)) ⇒  0
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if list is not a proper list or a circular list. +

    +

    See Also::

    + +

    length +

    +

    Notes::

    + +

    list-length could be implemented as follows: +

    +
    +
     (defun list-length (x)  
+   (do ((n 0 (+ n 2))           ;Counter.
+        (fast x (cddr fast))    ;Fast pointer: leaps by 2.
+        (slow x (cdr slow)))    ;Slow pointer: leaps by 1.
+       (nil)
+     ;; If fast pointer hits the end, return the count.
+     (when (endp fast) (return n))
+     (when (endp (cdr fast)) (return (+ n 1)))
+     ;; If fast pointer eventually equals slow pointer,
+     ;;  then we must be stuck in a circular list.
+     ;; (A deeper property is the converse: if we are
+     ;;  stuck in a circular list, then eventually the
+     ;;  fast pointer will equal the slow pointer.
+     ;;  That fact justifies this implementation.)
+     (when (and (eq fast slow) (> n 0)) (return nil))))
+
+
    + + + + + + diff --git a/info/gcl/listen.html b/info/gcl/listen.html new file mode 100644 index 0000000..b9d19d7 --- /dev/null +++ b/info/gcl/listen.html @@ -0,0 +1,92 @@ + + + + + +listen (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.34 listen [Function]

    + +

    listen &optional input-stream ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    input-stream—an input stream designator. + The default is standard input. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if +there is a character immediately available from input-stream; +otherwise, returns false. +On a non-interactive input-stream, +listen returns true except when at end of file_1. +If an end of file is encountered, listen returns false. +listen is intended to be used +when input-stream obtains characters +from an interactive device such as a keyboard. +

    +

    Examples::

    + +
    +
     (progn (unread-char (read-char)) (list (listen) (read-char)))
+ |>  |>>1<<|
+⇒  (T #\1)
+ (progn (clear-input) (listen))
+⇒  NIL ;Unless you're a very fast typist!
+
    + +

    Affected By::

    + +

    *standard-input* +

    +

    See Also::

    + +

    interactive-stream-p +, +read-char-no-hang +

    + + + + + diff --git a/info/gcl/listp.html b/info/gcl/listp.html new file mode 100644 index 0000000..cc12522 --- /dev/null +++ b/info/gcl/listp.html @@ -0,0 +1,86 @@ + + + + + +listp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.17 listp [Function]

    + +

    listp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type list; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (listp nil) ⇒  true
+ (listp (cons 1 2)) ⇒  true
+ (listp (make-array 6)) ⇒  false
+ (listp t) ⇒  false
+
    + +

    See Also::

    + +

    consp +

    +

    Notes::

    + +

    If object is a cons, +listp does not check whether object is a proper list; +it returns true for any kind of list. +

    +
    +
     (listp object) ≡ (typep object 'list) ≡ (typep object '(or cons null))
+
    + + + + + + diff --git a/info/gcl/load.html b/info/gcl/load.html new file mode 100644 index 0000000..578a849 --- /dev/null +++ b/info/gcl/load.html @@ -0,0 +1,231 @@ + + + + + +load (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.3 load [Function]

    + +

    load filespec &key verbose print + if-does-not-exist external-format
    + ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    filespec—a stream, or a pathname designator. + The default is taken from *default-pathname-defaults*. +

    +

    verbose—a generalized boolean. + The default is the value of *load-verbose*. +

    +

    print—a generalized boolean. + The default is the value of *load-print*. +

    +

    if-does-not-exist—a generalized boolean. + The default is true. +

    +

    external-format—an external file format designator. + The default is :default. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    load loads the file named by filespec +into the Lisp environment. +

    +

    The manner in which a source file +is distinguished from a compiled file is implementation-dependent. +If the file specification is not complete and both a source file and a +compiled file exist which might match, +then which of those files load selects is implementation-dependent. +

    +

    If filespec is a stream, +load determines what kind of stream it is +and loads directly from the stream. +

    +

    If filespec is a logical pathname, +it is translated into a physical pathname +as if by calling translate-logical-pathname. +

    +

    load sequentially executes each form it encounters +in the file named by filespec. +If the file is a source file +and the implementation chooses to perform implicit compilation, +load must recognize top level forms +as described in Processing of Top Level Forms +and arrange for each top level form to be executed +before beginning implicit compilation of the next. +(Note, however, that processing of eval-when forms +by load is controlled by the :execute situation.) +

    +

    If verbose is true, +load prints a message in the form of a comment +(i.e., with a leading semicolon) +to standard output indicating what file is being loaded +and other useful information. +

    +

    If verbose is false, +load does not print this information. +

    +

    If print is true, +load incrementally prints information to standard output +showing the progress of the loading process. +For a source file, +this information might mean printing the values +yielded by each form in the file +as soon as those values are returned. +For a compiled file, +what is printed might not reflect precisely the contents of the source file, +but some information is generally printed. +If print is false, +load does not print this information. +

    +

    If the file named by filespec is successfully loaded, +load returns true. +

    +

    [Reviewer Note by Loosemore: What happens if the file cannot be loaded for some reason other +than that it doesn’t exist?] +[Editorial Note by KMP: i.e., can it return NIL? must it?] +

    +

    If the file does not exist, +the specific action taken depends on if-does-not-exist: +if it is nil, load returns nil; +otherwise, load signals an error. +

    +

    The external-format specifies the external file format +to be used when opening the file (see the function open), +except that when the file named by filespec is a compiled file, +the external-format is ignored. +compile-file and load cooperate +in an implementation-dependent way to assure +the preservation of the similarity of characters +referred to in the source file +at the time the source file was processed by the file compiler +under a given external file format, +regardless of the value of external-format +at the time the compiled file is loaded. +

    +

    load binds *readtable* and *package* +to the values they held before loading the file. +

    +

    *load-truename* is bound by load to hold +the truename of the pathname of the file being loaded. +

    +

    *load-pathname* is bound by load to hold +a pathname that represents filespec merged against the defaults. +That is, (pathname (merge-pathnames filespec)). +

    +

    Examples::

    + +
    +
    ;Establish a data file...
+ (with-open-file (str "data.in" :direction :output :if-exists :error)
+   (print 1 str) (print '(setq a 888) str) t)
+⇒  T
+ (load "data.in") ⇒  true
+ a ⇒  888
+ (load (setq p (merge-pathnames "data.in")) :verbose t)
+; Loading contents of file /fred/data.in
+; Finished loading /fred/data.in
+⇒  true
+ (load p :print t) 
+; Loading contents of file /fred/data.in
+;  1
+;  888
+; Finished loading /fred/data.in
+⇒  true
+
    + +
    +
     ;----[Begin file SETUP]----
+ (in-package "MY-STUFF")
+ (defmacro compile-truename () `',*compile-file-truename*)
+ (defvar *my-compile-truename* (compile-truename) "Just for debugging.")
+ (defvar *my-load-pathname* *load-pathname*)
+ (defun load-my-system ()
+   (dolist (module-name '("FOO" "BAR" "BAZ"))
+     (load (merge-pathnames module-name *my-load-pathname*))))
+ ;----[End of file SETUP]----
+
+ (load "SETUP")
+ (load-my-system)
+
    + +

    Affected By::

    + +

    The implementation, and the host computer’s file system. +

    +

    Exceptional Situations::

    + +

    If :if-does-not-exist is supplied and is true, or is not supplied, +load signals an error of type file-error if the file named by +filespec does not exist, +

    +

    or if the file system cannot perform the requested operation. +

    +

    An error of type file-error might be signaled if +(wild-pathname-p filespec) returns true. +

    +

    See Also::

    + +

    error +, +merge-pathnames +, +*load-verbose*, +*default-pathname-defaults*, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    + + + + + diff --git a/info/gcl/load_002dlogical_002dpathname_002dtranslations.html b/info/gcl/load_002dlogical_002dpathname_002dtranslations.html new file mode 100644 index 0000000..ef83c8f --- /dev/null +++ b/info/gcl/load_002dlogical_002dpathname_002dtranslations.html @@ -0,0 +1,105 @@ + + + + + +load-logical-pathname-translations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.7 load-logical-pathname-translations [Function]

    + +

    load-logical-pathname-translations host ⇒ just-loaded +

    +

    Arguments and Values::

    + +

    host—a string. +

    +

    just-loaded—a generalized boolean. +

    +

    Description::

    + +

    Searches for and loads the definition of a logical host named host, +if it is not already defined. +The specific nature of the search is implementation-defined. +

    +

    If the host is already defined, +no attempt to find or load a definition is attempted, +and false is returned. +If the host is not already defined, +but a definition is successfully found and loaded, +true is returned. +Otherwise, an error is signaled. +

    +

    Examples::

    + +
    +
     (translate-logical-pathname "hacks:weather;barometer.lisp.newest")
+ |>  Error: The logical host HACKS is not defined.
+ (load-logical-pathname-translations "HACKS")
+ |>  ;; Loading SYS:SITE;HACKS.TRANSLATIONS
+ |>  ;; Loading done.
+⇒  true
+ (translate-logical-pathname "hacks:weather;barometer.lisp.newest")
+⇒  #P"HELIUM:[SHARED.HACKS.WEATHER]BAROMETER.LSP;0"
+ (load-logical-pathname-translations "HACKS")
+⇒  false
+
    + +

    Exceptional Situations::

    + +

    If no definition is found, an error of type error is signaled. +

    +

    See Also::

    + +

    logical-pathname +

    +

    Notes::

    + +

    Logical pathname definitions will be created not just by +implementors but also by programmers. As such, +it is important that the search strategy be documented. +For example, an implementation might define that the +definition of a host is to be found in a file called +“host.translations” in some specifically named directory. +

    + + + + + diff --git a/info/gcl/load_002dtime_002dvalue.html b/info/gcl/load_002dtime_002dvalue.html new file mode 100644 index 0000000..2b04232 --- /dev/null +++ b/info/gcl/load_002dtime_002dvalue.html @@ -0,0 +1,197 @@ + + + + + +load-time-value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.6 load-time-value [Special Operator]

    + +

    load-time-value form &optional read-only-p ⇒ object +

    +

    Arguments and Values::

    + +

    form—a form; evaluated as described below. +

    +

    read-only-p—a boolean; not evaluated. +

    +

    object—the primary value resulting from evaluating form. +

    +

    Description::

    + +

    load-time-value provides a mechanism for delaying evaluation of form +until the expression is in the run-time environment; see Compilation. +

    +

    Read-only-p designates whether the result can be considered a +constant object. +If t, + the result is a read-only quantity that can, + if appropriate to the implementation, + be copied into read-only space and/or coalesced with similar + constant objects from other programs. +If nil (the default), + the result must be neither copied nor coalesced; + it must be considered to be potentially modifiable data. +

    +

    If a load-time-value expression is processed by compile-file, +the compiler performs its normal semantic processing (such as macro expansion +and translation into machine code) on form, but arranges for the +execution of form to occur at load time in a null lexical environment, +with the result of this evaluation then being treated as +a literal object +at run time. It is guaranteed that the evaluation of form +will take place only once when the file is loaded, but +the order of evaluation with respect to the evaluation of +top level forms in the file is implementation-dependent. +

    + + + + +

    If a load-time-value expression appears within a function compiled +with compile, the form is evaluated at compile time in a +null lexical environment. The result of this compile-time evaluation +is treated as +a literal object +in the compiled code. +

    +

    If a load-time-value expression is processed by eval, +form is evaluated in a null lexical environment, +and one value is returned. Implementations that implicitly compile +(or partially compile) expressions processed by eval +might evaluate form only once, at the time this compilation is performed. +

    +

    If the same list (load-time-value form) is +evaluated or compiled more than once, it is implementation-dependent +whether form is evaluated only once or is evaluated more than once. +This can happen both when an expression being evaluated or compiled shares +substructure, and when the same form is processed by eval or +compile multiple times. +Since a load-time-value expression can be + referenced in more than one place and can be evaluated multiple times + by eval, it is +implementation-dependent whether each execution returns + a fresh object +or returns the same object as some other execution. + Users must use caution when destructively modifying the resulting + object. +

    +

    If two lists (load-time-value form) +that are the same under equal but are not identical +are evaluated or compiled, +their values always come from distinct evaluations of form. +Their values may not be coalesced +unless read-only-p is t. +

    +

    Examples::

    + +
    +
    ;;; The function INCR1 always returns the same value, even in different images.
+;;; The function INCR2 always returns the same value in a given image, 
+;;; but the value it returns might vary from image to image.
+(defun incr1 (x) (+ x #.(random 17)))
+(defun incr2 (x) (+ x (load-time-value (random 17))))
+
+;;; The function FOO1-REF references the nth element of the first of 
+;;; the *FOO-ARRAYS* that is available at load time.  It is permissible for
+;;; that array to be modified (e.g., by SET-FOO1-REF); FOO1-REF will see the
+;;; updated values.
+(defvar *foo-arrays* (list (make-array 7) (make-array 8)))
+(defun foo1-ref (n) (aref (load-time-value (first *my-arrays*) nil) n))
+(defun set-foo1-ref (n val) 
+  (setf (aref (load-time-value (first *my-arrays*) nil) n) val))
+
+;;; The function BAR1-REF references the nth element of the first of 
+;;; the *BAR-ARRAYS* that is available at load time.  The programmer has
+;;; promised that the array will be treated as read-only, so the system 
+;;; can copy or coalesce the array.
+(defvar *bar-arrays* (list (make-array 7) (make-array 8)))
+(defun bar1-ref (n) (aref (load-time-value (first *my-arrays*) t) n))
+
+;;; This use of LOAD-TIME-VALUE permits the indicated vector to be coalesced
+;;; even though NIL was specified, because the object was already read-only
+;;; when it was written as a literal vector rather than created by a constructor.
+;;; User programs must treat the vector v as read-only.
+(defun baz-ref (n)
+  (let ((v (load-time-value #(A B C) nil)))
+    (values (svref v n) v)))
+
+;;; This use of LOAD-TIME-VALUE permits the indicated vector to be coalesced
+;;; even though NIL was specified in the outer situation because T was specified
+;;; in the inner situation.  User programs must treat the vector v as read-only.
+(defun baz-ref (n)
+  (let ((v (load-time-value (load-time-value (vector 1 2 3) t) nil)))
+    (values (svref v n) v)))
+
    + +

    See Also::

    + +

    compile-file +, +compile +, +eval +, +Minimal Compilation, +Compilation +

    +

    Notes::

    + +

    load-time-value must appear outside of quoted structure in a +“for evaluation” position. In situations which would appear to call +for use of load-time-value within a quoted structure, +the backquote reader macro is probably called for; +see Backquote. +

    +

    Specifying nil for read-only-p is not a way to force an object +to become modifiable if it has already been made read-only. It is only a way +to say that, for an object that is modifiable, this operation is not intended +to make that object read-only. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/locally.html b/info/gcl/locally.html new file mode 100644 index 0000000..933b14f --- /dev/null +++ b/info/gcl/locally.html @@ -0,0 +1,120 @@ + + + + + +locally (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.27 locally [Special Operator]

    + +

    locally {declaration}* {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    Declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values of the forms. +

    +

    Description::

    + +

    Sequentially evaluates a body of forms +in a lexical environment where the given declarations have effect. +

    +

    Examples::

    + +
    +
     (defun sample-function (y)  ;this y is regarded as special
+   (declare (special y))                                
+   (let ((y t))              ;this y is regarded as lexical
+     (list y
+           (locally (declare (special y))
+             ;; this next y is regarded as special
+             y))))
+⇒  SAMPLE-FUNCTION
+ (sample-function nil) ⇒  (T NIL) 
+ (setq x '(1 2 3) y '(4 . 5)) ⇒  (4 . 5)
+
+;;; The following declarations are not notably useful in specific.
+;;; They just offer a sample of valid declaration syntax using LOCALLY.
+ (locally (declare (inline floor) (notinline car cdr))
+          (declare (optimize space))
+    (floor (car x) (cdr y))) ⇒  0, 1
+
    + +
    +
    ;;; This example shows a definition of a function that has a particular set
+;;; of OPTIMIZE settings made locally to that definition.
+ (locally (declare (optimize (safety 3) (space 3) (speed 0)))
+   (defun frob (w x y &optional (z (foo x y)))
+     (mumble x y z w)))
+⇒  FROB
+
+;;; This is like the previous example, except that the optimize settings
+;;; remain in effect for subsequent definitions in the same compilation unit.
+ (declaim (optimize (safety 3) (space 3) (speed 0)))
+ (defun frob (w x y &optional (z (foo x y)))
+   (mumble x y z w))
+⇒  FROB
+
    + +

    See Also::

    + +

    declare +

    +

    Notes::

    + +

    The special declaration may be used with locally +to affect references to, rather than bindings of, variables. +

    +

    If a locally form is a top level form, the body forms +are also processed as top level forms. See File Compilation. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/log.html b/info/gcl/log.html new file mode 100644 index 0000000..25a3d0d --- /dev/null +++ b/info/gcl/log.html @@ -0,0 +1,146 @@ + + + + + +log (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.35 log [Function]

    + +

    log number &optional base ⇒ logarithm +

    +

    Arguments and Values::

    + +

    number—a non-zero number. +

    +

    base—a number. +

    +

    logarithm—a number. +

    +

    Description::

    + +

    log returns the logarithm of number in base base. +If base is not supplied its value is e, +the base of the natural logarithms. +

    +

    log may return a complex when given a +

    +

    real +

    +

    negative number. +

    +
    +
     (log -1.0) ≡ (complex 0.0 (float pi 0.0))
+
    + +

    If base is zero, +log returns zero. +

    +

    The result of (log 8 2) may be either 3 or 3.0, depending on the +implementation. An implementation can use floating-point calculations +even if an exact integer result is possible. +

    +

    The branch cut for the logarithm function of one argument (natural +logarithm) lies along the negative real axis, continuous with quadrant II. +The domain excludes the origin. +

    +

    The mathematical definition of a complex logarithm +is as follows, whether or not minus zero is supported by the +implementation: +

    +
    +
    (log x) ≡ (complex (log (abs x)) (phase x))
+
    + +

    Therefore the range of the one-argument logarithm function is that strip +of the complex plane containing numbers with imaginary parts between +

    +

    -\pi (exclusive) and~\pi (inclusive) if minus zero is not supported, +or -\pi (inclusive) and~\pi (inclusive) if minus zero is supported. +

    +

    The two-argument logarithm function is defined as +

    +
    +
     (log base number)
+ ≡ (/ (log number) (log base))
+
    + +

    This defines the principal values precisely. +The range of the two-argument logarithm function is the entire complex plane. +

    +

    Examples::

    + +
    +
     (log 100 10)
+⇒  2.0
+⇒  2
+ (log 100.0 10) ⇒  2.0
+ (log #c(0 1) #c(0 -1))
+⇒  #C(-1.0 0.0)
+OR⇒ #C(-1 0)
+ (log 8.0 2) ⇒  3.0
+
    + +
    +
     (log #c(-16 16) #c(2 2)) ⇒  3 or approximately #c(3.0 0.0)
+                               or approximately 3.0 (unlikely)
+
    + +

    Affected By::

    + +

    The implementation. +

    +

    See Also::

    + +

    exp +, +expt, +Rule of Float Substitutability +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/logand.html b/info/gcl/logand.html new file mode 100644 index 0000000..861fbe8 --- /dev/null +++ b/info/gcl/logand.html @@ -0,0 +1,197 @@ + + + + + +logand (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.62 logand, logandc1, logandc2, logeqv, logior,

    +

    lognand, lognor, lognot, logorc1, logorc2,

    +

    logxor

    +

    [Function] +

    +

    logand &rest integers ⇒ result-integer +

    +

    logandc 1 ⇒ integer-1 integer-2 + result-integer +logandc 2 ⇒ integer-1 integer-2 + result-integer +logeqv &rest integers ⇒ result-integer +

    +

    logior &rest integers ⇒ result-integer +

    +

    lognand integer-1 integer-2 ⇒ result-integer +

    +

    lognor integer-1 integer-2 ⇒ result-integer +

    +

    lognot integer ⇒ result-integer +

    +

    logorc 1 ⇒ integer-1 integer-2 + result-integer +logorc 2 ⇒ integer-1 integer-2 + result-integer +logxor &rest integers ⇒ result-integer +

    +

    Arguments and Values::

    + +

    integers—integers. +

    +

    integer—an integer. +

    +

    integer-1—an integer. +

    +

    integer-2—an integer. +

    +

    result-integer—an integer. +

    +

    Description::

    + +

    The functions + logandc1, + logandc2, + logand, + logeqv, + logior, + lognand, + lognor, + lognot, + logorc1, + logorc2, + and logxor +perform bit-wise logical operations on their arguments, +that are treated as if they were binary. +

    +

    Figure 12–17 lists the meaning of each of the functions. +Where an ‘identity’ is shown, it indicates the value yielded +by the function when no arguments are supplied. +

    +
    +
      Function  Identity  Operation performed                         
+  logandc1  —       and complement of integer-1 with integer-2  
+  logandc2  —       and integer-1 with complement of integer-2  
+  logand    -1        and                                         
+  logeqv    -1        equivalence (exclusive nor)                 
+  logior    0         inclusive or                                
+  lognand   —       complement of integer-1 and integer-2       
+  lognor    —       complement of integer-1 or integer-2        
+  lognot    —       complement                                  
+  logorc1   —       or complement of integer-1 with integer-2   
+  logorc2   —       or integer-1 with complement of integer-2   
+  logxor    0         exclusive or                                
+
+       Figure 12–17: Bit-wise Logical Operations on Integers     
+
+
    + +

    Negative integers are treated as if they were in two’s-complement notation. +

    +

    Examples::

    + +
    +
     (logior 1 2 4 8) ⇒  15
+ (logxor 1 3 7 15) ⇒  10
+ (logeqv) ⇒  -1
+ (logand 16 31) ⇒  16
+ (lognot 0) ⇒  -1
+ (lognot 1) ⇒  -2
+ (lognot -1) ⇒  0
+ (lognot (1+ (lognot 1000))) ⇒  999
+
+;;; In the following example, m is a mask.  For each bit in
+;;; the mask that is a 1, the corresponding bits in x and y are
+;;; exchanged.  For each bit in the mask that is a 0, the 
+;;; corresponding bits of x and y are left unchanged.
+ (flet ((show (m x y)
+          (format t "~
+                  m x y)))
+   (let ((m #o007750)
+         (x #o452576)
+         (y #o317407))
+     (show m x y)
+     (let ((z (logand (logxor x y) m)))
+       (setq x (logxor z x))
+       (setq y (logxor z y))
+       (show m x y))))
+ |>  m = #o007750
+ |>  x = #o452576
+ |>  y = #o317407
+ |>  
+ |>  m = #o007750
+ |>  x = #o457426
+ |>  y = #o312557
+⇒  NIL
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if any argument is not an integer. +

    +

    See Also::

    + +

    boole +

    +

    Notes::

    + +

    (logbitp k -1) returns true for all values of k. +

    +

    Because the following functions are not associative, +they take exactly two arguments rather than any number +of arguments. +

    +
    +
     (lognand n1 n2) ≡ (lognot (logand n1 n2))
+ (lognor n1 n2) ≡ (lognot (logior n1 n2))
+ (logandc1 n1 n2) ≡ (logand (lognot n1) n2)
+ (logandc2 n1 n2) ≡ (logand n1 (lognot n2))
+ (logiorc1 n1 n2) ≡ (logior (lognot n1) n2)
+ (logiorc2 n1 n2) ≡ (logior n1 (lognot n2))
+ (logbitp j (lognot x)) ≡ (not (logbitp j x))
+
    + +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/logbitp.html b/info/gcl/logbitp.html new file mode 100644 index 0000000..2c7f8c4 --- /dev/null +++ b/info/gcl/logbitp.html @@ -0,0 +1,95 @@ + + + + + +logbitp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.63 logbitp [Function]

    + +

    logbitp index integer ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    index—a non-negative integer. +

    +

    integer—an integer. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    logbitp is used to test the value of a particular bit +in integer, that is treated as if it were binary. +The value of logbitp is true if the bit in integer +whose index is index (that is, its weight is 2^index) +is a one-bit; otherwise it is false. +

    +

    Negative integers are treated as if they were in +two’s-complement notation. +

    +

    Examples::

    +
    +
     (logbitp 1 1) ⇒  false
+ (logbitp 0 1) ⇒  true
+ (logbitp 3 10) ⇒  true
+ (logbitp 1000000 -1) ⇒  true
+ (logbitp 2 6) ⇒  true
+ (logbitp 0 6) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if index is not a non-negative integer. +Should signal an error of type type-error + if integer is not an integer. +

    +

    Notes::

    + +
    +
     (logbitp k n) ≡ (ldb-test (byte 1 k) n)
+
    + + + + + + diff --git a/info/gcl/logcount.html b/info/gcl/logcount.html new file mode 100644 index 0000000..01fd146 --- /dev/null +++ b/info/gcl/logcount.html @@ -0,0 +1,99 @@ + + + + + +logcount (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.64 logcount [Function]

    + +

    logcount integer ⇒ number-of-on-bits +

    +

    Arguments and Values::

    + +

    integer—an integer. +

    +

    number-of-on-bits—a non-negative integer. +

    +

    Description::

    + +

    Computes and returns the number of bits +in the two’s-complement binary representation of integer +that are ‘on’ or ‘set’. +If integer is negative, the 0 bits are counted; +otherwise, the 1 bits are counted. +

    +

    Examples::

    + +
    +
     (logcount 0) ⇒  0
+ (logcount -1) ⇒  0
+ (logcount 7) ⇒  3
+ (logcount  13) ⇒  3 ;Two's-complement binary: ...0001101
+ (logcount -13) ⇒  2 ;Two's-complement binary: ...1110011
+ (logcount  30) ⇒  4 ;Two's-complement binary: ...0011110
+ (logcount -30) ⇒  4 ;Two's-complement binary: ...1100010
+ (logcount (expt 2 100)) ⇒  1
+ (logcount (- (expt 2 100))) ⇒  100
+ (logcount (- (1+ (expt 2 100)))) ⇒  1
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if its argument is not an integer. +

    +

    Notes::

    + +

    Even if the implementation does not represent integers internally +in two’s complement binary, logcount behaves as if it did. +

    +

    The following identity always holds: +

    +
    +
        (logcount x)
+ ≡ (logcount (- (+ x 1)))
+ ≡ (logcount (lognot x))
+
    + + + + + + diff --git a/info/gcl/logical_002dpathname-_0028System-Class_0029.html b/info/gcl/logical_002dpathname-_0028System-Class_0029.html new file mode 100644 index 0000000..a86169c --- /dev/null +++ b/info/gcl/logical_002dpathname-_0028System-Class_0029.html @@ -0,0 +1,70 @@ + + + + + +logical-pathname (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.2 logical-pathname [System Class]

    + +

    Class Precedence List::

    + +

    logical-pathname, +pathname, +t +

    +

    Description::

    + +

    A pathname that uses a namestring syntax that is +implementation-independent, +and that has component values that are implementation-independent. +Logical pathnames do not refer directly to filenames +

    +

    See Also::

    + +

    File System Concepts, +Sharpsign P, +Printing Pathnames +

    + + + + + diff --git a/info/gcl/logical_002dpathname.html b/info/gcl/logical_002dpathname.html new file mode 100644 index 0000000..78e6d2f --- /dev/null +++ b/info/gcl/logical_002dpathname.html @@ -0,0 +1,95 @@ + + + + + +logical-pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.9 logical-pathname [Function]

    + +

    logical-pathname pathspec ⇒ logical-pathname +

    +

    Arguments and Values::

    + +

    pathspec—a logical pathname, + a logical pathname namestring, + or a stream. +

    +

    logical-pathname—a logical pathname. +

    +

    Description::

    + +

    logical-pathname converts pathspec to a +logical pathname and returns the new logical pathname. +If pathspec is a logical pathname namestring, +it should contain a host component and its following colon. +If pathspec is a stream, it should be one +for which pathname returns a logical pathname. +

    +

    If pathspec is a stream, the stream can be either open or closed. +logical-pathname returns the same logical pathname after a +file is closed as it did when the file was open. +

    +

    It is an error if pathspec is a stream that is +created with + make-two-way-stream, + make-echo-stream, + make-broadcast-stream, + make-concatenated-stream, + make-string-input-stream, +or + make-string-output-stream. +

    +

    Exceptional Situations::

    + +

    Signals an error of type type-error if pathspec isn’t supplied correctly. +

    +

    See Also::

    + +

    logical-pathname, +translate-logical-pathname +, +Logical Pathnames +

    + + + + + diff --git a/info/gcl/logical_002dpathname_002dtranslations.html b/info/gcl/logical_002dpathname_002dtranslations.html new file mode 100644 index 0000000..ada9103 --- /dev/null +++ b/info/gcl/logical_002dpathname_002dtranslations.html @@ -0,0 +1,242 @@ + + + + + +logical-pathname-translations (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.8 logical-pathname-translations [Accessor]

    + +

    logical-pathname-translations host ⇒ translations +

    +

    (setf ( logical-pathname-translations host) new-translations)
    +

    +

    Arguments and Values::

    + +

    host–a logical host designator. +

    +

    translations, new-translations—a list. +

    +

    Description::

    + +

    Returns the host’s list of translations. +Each translation is a list of at least two elements: +from-wildcard and to-wildcard. Any + additional elements are implementation-defined. +From-wildcard is a + logical pathname whose host is host. +To-wildcard is a pathname. +

    +

    [Reviewer Note by Laddaga: Can this be a logical pathname?] +

    +

    (setf (logical-pathname-translations host) translations) sets a +logical pathname host’s +list of translations. If host +is a string that has + not been previously used as +a logical pathname host, a new +logical pathname host is defined; +otherwise an existing host’s translations are + replaced. logical pathname host names are compared with string-equal. +

    +

    When setting the translations list, each from-wildcard +can be a logical pathname whose +host is host or a logical pathname namestring + parseable by (parse-namestring string host), +where host + represents the appropriate object as defined +by parse-namestring. Each + to-wildcard can be anything coercible to a +pathname by + (pathname to-wildcard). +If to-wildcard coerces to a logical pathname, +translate-logical-pathname +will perform repeated translation steps when + it uses it. +

    +

    host is either the host component of a +logical pathname or a + string that has been defined +as a logical pathname host name by setf of +logical-pathname-translations. +

    +

    Examples::

    + +

    [Reviewer Note by Laddaga: Shouldn’t there be some *.*’s in the list + of translations for PROG below?] +

    +
    +
     ;;;A very simple example of setting up a logical pathname host.  No
+ ;;;translations are necessary to get around file system restrictions, so
+ ;;;all that is necessary is to specify the root of the physical directory
+ ;;;tree that contains the logical file system.
+ ;;;The namestring syntax on the right-hand side is implementation-dependent.
+ (setf (logical-pathname-translations "foo")
+       '(("**;*.*.*"              "MY-LISPM:>library>foo>**>")))
+
+ ;;;Sample use of that logical pathname.  The return value
+ ;;;is implementation-dependent.          
+ (translate-logical-pathname "foo:bar;baz;mum.quux.3")
+⇒  #P"MY-LISPM:>library>foo>bar>baz>mum.quux.3"
+
+ ;;;A more complex example, dividing the files among two file servers
+ ;;;and several different directories.  This Unix doesn't support
+ ;;;:WILD-INFERIORS in the directory, so each directory level must
+ ;;;be translated individually.  No file name or type translations
+ ;;;are required except for .MAIL to .MBX.
+ ;;;The namestring syntax on the right-hand side is implementation-dependent.
+ (setf (logical-pathname-translations "prog")
+       '(("RELEASED;*.*.*"        "MY-UNIX:/sys/bin/my-prog/")
+         ("RELEASED;*;*.*.*"      "MY-UNIX:/sys/bin/my-prog/*/")
+         ("EXPERIMENTAL;*.*.*"    "MY-UNIX:/usr/Joe/development/prog/")
+         ("EXPERIMENTAL;DOCUMENTATION;*.*.*"
+                                  "MY-VAX:SYS$DISK:[JOE.DOC]")
+         ("EXPERIMENTAL;*;*.*.*"  "MY-UNIX:/usr/Joe/development/prog/*/")
+         ("MAIL;**;*.MAIL"        "MY-VAX:SYS$DISK:[JOE.MAIL.PROG...]*.MBX")))
+
+ ;;;Sample use of that logical pathname.  The return value
+ ;;;is implementation-dependent.          
+ (translate-logical-pathname "prog:mail;save;ideas.mail.3")
+⇒  #P"MY-VAX:SYS$DISK:[JOE.MAIL.PROG.SAVE]IDEAS.MBX.3"
+
+ ;;;Example translations for a program that uses three files main.lisp,
+ ;;;auxiliary.lisp, and documentation.lisp.  These translations might be
+ ;;;supplied by a software supplier as examples.
+
+ ;;;For Unix with long file names
+ (setf (logical-pathname-translations "prog")
+       '(("CODE;*.*.*"             "/lib/prog/")))
+
+ ;;;Sample use of that logical pathname.  The return value
+ ;;;is implementation-dependent.          
+ (translate-logical-pathname "prog:code;documentation.lisp")
+⇒  #P"/lib/prog/documentation.lisp"
+
+ ;;;For Unix with 14-character file names, using .lisp as the type
+ (setf (logical-pathname-translations "prog")
+       '(("CODE;DOCUMENTATION.*.*" "/lib/prog/docum.*")
+         ("CODE;*.*.*"             "/lib/prog/")))
+
+ ;;;Sample use of that logical pathname.  The return value
+ ;;;is implementation-dependent.          
+ (translate-logical-pathname "prog:code;documentation.lisp")
+⇒  #P"/lib/prog/docum.lisp"
+
+ ;;;For Unix with 14-character file names, using .l as the type
+ ;;;The second translation shortens the compiled file type to .b
+ (setf (logical-pathname-translations "prog")
+       `(("**;*.LISP.*"            ,(logical-pathname "PROG:**;*.L.*"))
+         (,(compile-file-pathname (logical-pathname "PROG:**;*.LISP.*"))
+                                   ,(logical-pathname "PROG:**;*.B.*"))
+         ("CODE;DOCUMENTATION.*.*" "/lib/prog/documentatio.*")
+         ("CODE;*.*.*"             "/lib/prog/")))
+
+ ;;;Sample use of that logical pathname.  The return value
+ ;;;is implementation-dependent.          
+ (translate-logical-pathname "prog:code;documentation.lisp")
+⇒  #P"/lib/prog/documentatio.l"
+
+ ;;;For a Cray with 6 character names and no directories, types, or versions.
+ (setf (logical-pathname-translations "prog")
+       (let ((l '(("MAIN" "PGMN")
+                  ("AUXILIARY" "PGAUX")
+                  ("DOCUMENTATION" "PGDOC")))
+             (logpath (logical-pathname "prog:code;"))
+             (phypath (pathname "XXX")))
+         (append
+           ;; Translations for source files
+           (mapcar #'(lambda (x)
+                       (let ((log (first x))
+                             (phy (second x)))
+                         (list (make-pathname :name log
+                                              :type "LISP"
+                                              :version :wild
+                                              :defaults logpath)
+                               (make-pathname :name phy
+                                              :defaults phypath))))
+                   l)
+           ;; Translations for compiled files
+           (mapcar #'(lambda (x)
+                       (let* ((log (first x))
+                              (phy (second x))
+                              (com (compile-file-pathname
+                                     (make-pathname :name log
+                                                    :type "LISP"
+                                                    :version :wild
+                                                    :defaults logpath))))
+                         (setq phy (concatenate 'string phy "B"))
+                         (list com
+                               (make-pathname :name phy
+                                              :defaults phypath))))
+                   l))))
+
+ ;;;Sample use of that logical pathname.  The return value
+ ;;;is implementation-dependent.          
+ (translate-logical-pathname "prog:code;documentation.lisp")
+⇒  #P"PGDOC"
+
    + +

    Exceptional Situations::

    + +

    If host is incorrectly supplied, +an error of type type-error is signaled. +

    +

    See Also::

    + +

    logical-pathname, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    Implementations can define additional functions +that operate on logical pathname hosts, +for example to specify additional translation rules or options. +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/logtest.html b/info/gcl/logtest.html new file mode 100644 index 0000000..549084d --- /dev/null +++ b/info/gcl/logtest.html @@ -0,0 +1,93 @@ + + + + + +logtest (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.65 logtest [Function]

    + +

    logtest integer-1 integer-2 ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    integer-1—an integer. +

    +

    integer-2—an integer. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if any of the bits designated by the 1’s +in integer-1 is 1 in integer-2; +otherwise it is false. +integer-1 and integer-2 are treated as if they were binary. +

    +

    Negative integer-1 and integer-2 are treated as if +they were represented in two’s-complement binary. +

    +

    Examples::

    + +
    +
     (logtest 1 7) ⇒  true
+ (logtest 1 2) ⇒  false
+ (logtest -2 -1) ⇒  true
+ (logtest 0 -1) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if integer-1 is not an integer. +Should signal an error of type type-error + if integer-2 is not an integer. +

    +

    Notes::

    + +
    +
     (logtest x y) ≡ (not (zerop (logand x y)))
+
    + + + + + + diff --git a/info/gcl/loop.html b/info/gcl/loop.html new file mode 100644 index 0000000..3e2694d --- /dev/null +++ b/info/gcl/loop.html @@ -0,0 +1,242 @@ + + + + + +loop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    +
    +

    6.2.4 loop [Macro]

    + +

    The “simple” loop form: +

    +

    loop {compound-form}* ⇒ {result}* +

    +

    The “extended” loop form: +

    +

    loop [!name-clause] + {!variable-clause}* + {!main-clause}* ⇒ {result}* +

    +

    name-clause ::=named name +

    +

    variable-clause ::=!with-clause | !initial-final | !for-as-clause +

    +

    with-clause ::=with var1 [type-spec] [= form1] {and var2 [type-spec] [= form2]}* +

    +

    main-clause ::=!unconditional | !accumulation | !conditional | !termination-test | !initial-final +

    +

    initial-final ::=initially {compound-form}^+ | finally {compound-form}^+ +

    +

    unconditional ::={do | doing} {compound-form}^+ | return {form | it} +

    +

    accumulation ::=!list-accumulation | !numeric-accumulation +

    +

    list-accumulation ::={collect | collecting | append | appending | nconc | nconcing} {form | it}  +                      [into simple-var] +

    +

    numeric-accumulation ::={count | counting | sum | summing | }                          maximize | maximizing | minimize | minimizing {form | it}  +                         [into simple-var] [type-spec] +

    +

    conditional ::={if | when | unless} form !selectable-clause {and !selectable-clause}*  +                [else !selectable-clause {and !selectable-clause}*]  +                [end] +

    +

    selectable-clause ::=!unconditional | !accumulation | !conditional +

    +

    termination-test ::=while form | until form | repeat form | always form | never form | thereis form +

    +

    for-as-clause ::={for | as} !for-as-subclause {and !for-as-subclause}* +

    +

    for-as-subclause ::=!for-as-arithmetic | !for-as-in-list | !for-as-on-list | !for-as-equals-then | +                     !for-as-across | !for-as-hash | !for-as-package +

    +

    for-as-arithmetic ::=var [type-spec] !for-as-arithmetic-subclause +

    +

    for-as-arithmetic-subclause ::=!arithmetic-up | !arithmetic-downto | !arithmetic-downfrom +

    +

    arithmetic-up ::=[[{from | upfrom} form1 | {to | upto | below} form2 | by form3]]^+ +

    +

    arithmetic-downto ::=[[{from form1}^1 | {{downto | above} form2}^1 | by form3]] +

    +

    arithmetic-downfrom ::=[[{downfrom form1}^1 | {to | downto | above} form2 | by form3]] +

    +

    for-as-in-list ::=var [type-spec] in form1 [by step-fun] +

    +

    for-as-on-list ::=var [type-spec] on form1 [by step-fun] +

    +

    for-as-equals-then ::=var [type-spec] = form1 [then form2] +

    +

    for-as-across ::=var [type-spec] across vector +

    +

    for-as-hash ::=var [type-spec] being {each | the}  +                {{hash-key | hash-keys} {in | of} hash-table  +                [using (hash-value other-var)] |  +                {hash-value | hash-values} {in | of} hash-table  +                [using (hash-key other-var)]} +

    +

    for-as-package ::=var [type-spec] being {each | the}  +                   {symbol | symbols | +                   present-symbol | present-symbols | +                   external-symbol | external-symbols}  +                   [{in | of} package] +

    +

    type-spec ::=!simple-type-spec | !destructured-type-spec +

    +

    simple-type-spec ::=fixnum | float | t | nil +

    +

    destructured-type-spec ::=of-type d-type-spec +

    +

    d-type-spec ::=type-specifier | (d-type-spec . d-type-spec) +

    +

    var ::=!d-var-spec +

    +

    var1 ::=!d-var-spec +

    +

    var2 ::=!d-var-spec +

    +

    other-var ::=!d-var-spec +

    +

    d-var-spec ::=simple-var | nil | (!d-var-spec . !d-var-spec) +

    +

    Arguments and Values::

    + +

    compound-form—a compound form. +

    +

    name—a symbol. +

    +

    simple-var—a symbol (a variable name). +

    +

    form, form1, form2, form3—a form. +

    +

    step-fun—a form that evaluates to a function of one argument. +

    +

    vector—a form that evaluates to a vector. +

    +

    hash-table—a form that evaluates to a hash table. +

    +

    package—a form that evaluates to a package designator. +

    +

    type-specifier—a type specifier. + This might be either an atomic type specifier or a compound type specifier, + which introduces some additional complications to proper parsing in the face of + destructuring; for further information, see Destructuring. +

    +

    result—an object. +

    +

    Description::

    + +

    For details, see The LOOP Facility. +

    +

    Examples::

    + +
    +
    ;; An example of the simple form of LOOP.
+ (defun sqrt-advisor ()
+   (loop (format t "~&Number: ")
+         (let ((n (parse-integer (read-line) :junk-allowed t)))
+           (when (not n) (return))
+           (format t "~&The square root of ~D is ~D.~%" n (sqrt n)))))
+⇒  SQRT-ADVISOR
+ (sqrt-advisor)
+ |>  Number: |>>5 [<–~]<<|
+ |>  The square root of 5 is 2.236068.
+ |>  Number: |>>4 [<–~]<<|
+ |>  The square root of 4 is 2.
+ |>  Number: |>>done [<–~]<<|
+⇒  NIL
+
+;; An example of the extended form of LOOP.
+ (defun square-advisor ()
+   (loop as n = (progn (format t "~&Number: ")
+                       (parse-integer (read-line) :junk-allowed t))
+         while n
+         do (format t "~&The square of ~D is ~D.~
+⇒  SQUARE-ADVISOR
+ (square-advisor)
+ |>  Number: |>>4 [<–~]<<|
+ |>  The square of 4 is 16.
+ |>  Number: |>>23 [<–~]<<|
+ |>  The square of 23 is 529.
+ |>  Number: |>>done [<–~]<<|
+⇒  NIL
+
+;; Another example of the extended form of LOOP.
+ (loop for n from 1 to 10
+       when (oddp n)
+         collect n)
+⇒  (1 3 5 7 9)
+
    + +

    See Also::

    + +

    do +, +dolist +, +dotimes +, +return +, +go +, +throw +, +Destructuring +

    +

    Notes::

    + +

    Except that loop-finish cannot be used within a simple loop form, +a simple loop form is related to an extended loop form +in the following way: +

    +
    +
     (loop {compound-form}*) ≡ (loop do {compound-form}*)
+
    + +
    +
    +

    +Next: , Previous: , Up: Iteration Dictionary  

    +
    + + + + + diff --git a/info/gcl/loop_002dfinish.html b/info/gcl/loop_002dfinish.html new file mode 100644 index 0000000..eea197b --- /dev/null +++ b/info/gcl/loop_002dfinish.html @@ -0,0 +1,145 @@ + + + + + +loop-finish (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Iteration Dictionary  

    +
    +
    +

    6.2.5 loop-finish [Local Macro]

    + +

    Syntax::

    + +

    loop-finish <no arguments> ⇒ #<NoValue> +

    +

    Description::

    + +

    The loop-finish macro can be used lexically within +an extended +loop form +to terminate that form “normally.” +That is, it transfers control to the loop epilogue +of the lexically innermost extended loop form. +This permits execution of any finally clause (for effect) +and +the return of +any accumulated result. +

    +

    Examples::

    + +
    +
    ;; Terminate the loop, but return the accumulated count.
+ (loop for i in '(1 2 3 stop-here 4 5 6)
+       when (symbolp i) do (loop-finish)
+       count i)
+⇒  3
+
+;; The preceding loop is equivalent to:
+ (loop for i in '(1 2 3 stop-here 4 5 6)
+       until (symbolp i)
+       count i)
+⇒  3
+
+;; While LOOP-FINISH can be used can be used in a variety of 
+;; situations it is really most needed in a situation where a need
+;; to exit is detected at other than the loop's `top level'
+;; (where UNTIL or WHEN often work just as well), or where some 
+;; computation must occur between the point where a need to exit is
+;; detected and the point where the exit actually occurs.  For example:
+ (defun tokenize-sentence (string)
+   (macrolet ((add-word (wvar svar)
+                `(when ,wvar
+                   (push (coerce (nreverse ,wvar) 'string) ,svar)
+                   (setq ,wvar nil))))
+     (loop with word = '() and sentence = '() and endpos = nil
+           for i below (length string)
+           do (let ((char (aref string i)))
+                (case char
+                  (#\Space (add-word word sentence))
+                  (#\. (setq endpos (1+ i)) (loop-finish))
+                  (otherwise (push char word))))
+           finally (add-word word sentence)
+                   (return (values (nreverse sentence) endpos)))))
+⇒  TOKENIZE-SENTENCE
+
+ (tokenize-sentence "this is a sentence. this is another sentence.")
+⇒  ("this" "is" "a" "sentence"), 19
+
+ (tokenize-sentence "this is a sentence")
+⇒  ("this" "is" "a" "sentence"), NIL
+
+
    + +

    Side Effects::

    + +

    Transfers control. +

    +

    Exceptional Situations::

    + +

    Whether or not loop-finish is fbound in the +global environment is implementation-dependent; +however, the restrictions on redefinition and shadowing of +loop-finish are the same as for symbols in the COMMON-LISP package +which are fbound in the global environment. +The consequences of attempting to use loop-finish outside +of loop are undefined. +

    +

    See Also::

    + +

    loop +, +The LOOP Facility +

    +

    Notes::

    + + + + + + +
    +
    +

    +Previous: , Up: Iteration Dictionary  

    +
    + + + + + diff --git a/info/gcl/machine_002dinstance.html b/info/gcl/machine_002dinstance.html new file mode 100644 index 0000000..16ccb72 --- /dev/null +++ b/info/gcl/machine_002dinstance.html @@ -0,0 +1,84 @@ + + + + + +machine-instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.26 machine-instance [Function]

    + +

    machine-instance <no arguments> ⇒ description +

    +

    Arguments and Values::

    + +

    description—a string or nil. +

    +

    Description::

    + +

    Returns a string that identifies the particular instance of +the computer hardware on which Common Lisp is running, +or nil if no such string can be computed. +

    +

    Examples::

    + +
    +
     (machine-instance)
+⇒  "ACME.COM"
+OR⇒ "S/N 123231"
+OR⇒ "18.26.0.179"
+OR⇒ "AA-00-04-00-A7-A4"
+
    + +

    Affected By::

    + +

    The machine instance, +and the implementation. +

    +

    See Also::

    + +

    machine-type +, +machine-version +

    + + + + + diff --git a/info/gcl/machine_002dtype.html b/info/gcl/machine_002dtype.html new file mode 100644 index 0000000..e866894 --- /dev/null +++ b/info/gcl/machine_002dtype.html @@ -0,0 +1,79 @@ + + + + + +machine-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.27 machine-type [Function]

    + +

    machine-type <no arguments> ⇒ description +

    +

    Arguments and Values::

    + +

    description—a string or nil. +

    +

    Description::

    + +

    Returns a string that identifies the generic name of +the computer hardware on which Common Lisp is running. +

    +

    Examples::

    + +
    +
     (machine-type)
+⇒  "DEC PDP-10"
+OR⇒ "Symbolics LM-2"
+
    + +

    Affected By::

    + +

    The machine type. +The implementation. +

    +

    See Also::

    + +

    machine-version +

    + + + + + diff --git a/info/gcl/machine_002dversion.html b/info/gcl/machine_002dversion.html new file mode 100644 index 0000000..4816470 --- /dev/null +++ b/info/gcl/machine_002dversion.html @@ -0,0 +1,79 @@ + + + + + +machine-version (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.28 machine-version [Function]

    + +

    machine-version <no arguments> ⇒ description +

    +

    Arguments and Values::

    + +

    description—a string or nil. +

    +

    Description::

    + +

    Returns a string that identifies the version of the computer hardware +on which Common Lisp is running, or nil if no such value can be computed. +

    +

    Examples::

    + +
    +
     (machine-version) ⇒  "KL-10, microcode 9"
+
    + +

    Affected By::

    + +

    The machine version, +and the implementation. +

    +

    See Also::

    + +

    machine-type +, +machine-instance +

    + + + + + diff --git a/info/gcl/macro_002dfunction.html b/info/gcl/macro_002dfunction.html new file mode 100644 index 0000000..7cf22da --- /dev/null +++ b/info/gcl/macro_002dfunction.html @@ -0,0 +1,136 @@ + + + + + +macro-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.11 macro-function [Accessor]

    + +

    macro-function symbol &optional environment ⇒ function +

    +

    (setf ( macro-function symbol &optional environment) new-function)
    +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    environment—an environment object. +

    +

    function—a macro function or nil. +

    +

    new-function—a macro function. +

    +

    Description::

    + +

    Determines whether symbol has a function definition +as a macro in the specified environment. +

    +

    If so, the macro expansion function, a function of two arguments, +is returned. If symbol has no function definition +in the lexical environment environment, or its definition +is not a macro, macro-function returns nil. +

    +

    It is possible for both macro-function and +

    +

    special-operator-p +

    +

    to return true of symbol. The macro definition must +be available for use by programs that understand only the standard +Common Lisp special forms. +

    +

    Examples::

    +
    +
     (defmacro macfun (x) '(macro-function 'macfun)) ⇒  MACFUN 
+ (not (macro-function 'macfun)) ⇒  false 
+
    + +
    +
     (macrolet ((foo (&environment env)
+               (if (macro-function 'bar env)
+                  ''yes
+                  ''no)))
+    (list (foo)
+          (macrolet ((bar () :beep))
+             (foo))))
+
+⇒  (NO YES)
+
    + +

    Affected By::

    +

    (setf macro-function), defmacro, and macrolet. +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if environment is non-nil +in a use of setf of macro-function. +

    +

    See Also::

    + +

    defmacro +, Evaluation +

    +

    Notes::

    + +

    setf can be used with macro-function to install +a macro as a symbol’s global function definition: +

    +
    +
     (setf (macro-function symbol) fn)
+
    + +

    The value installed must be a function that accepts two arguments, +the entire macro call and an environment, +and computes the expansion for that call. +Performing this operation causes symbol to have only that +macro definition as its global function definition; any previous +definition, whether as a macro or as a +function, is lost. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/macroexpand.html b/info/gcl/macroexpand.html new file mode 100644 index 0000000..90f8714 --- /dev/null +++ b/info/gcl/macroexpand.html @@ -0,0 +1,211 @@ + + + + + +macroexpand (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.12 macroexpand, macroexpand-1 [Function]

    + +

    macroexpand form &optional env ⇒ expansion, expanded-p +

    +

    macroexpand- 1 ⇒ form &optional env + expansion, expanded-p +

    +

    Arguments and Values::

    + +

    form—a form. +

    +

    env—an environment object. + The default is nil. +

    +

    expansion—a form. +

    +

    expanded-p—a generalized boolean. +

    +

    Description::

    + +

    macroexpand and macroexpand-1 expand macros. +

    +

    If form is a macro form, +then macroexpand-1 expands the macro form call once. +

    +

    macroexpand +repeatedly expands form until it is no longer a macro form. +In effect, macroexpand calls macroexpand-1 repeatedly +until the secondary value it returns is nil. +

    +

    If form is a macro form, +then the expansion is a macro expansion + and expanded-p is true. +Otherwise, + the expansion is the given form + and expanded-p is false. +

    +

    Macro expansion is carried out as follows. +Once macroexpand-1 has +determined that the form is a macro form, +it obtains an appropriate expansion function for the +macro or symbol macro. +The value of +*macroexpand-hook* is +

    +

    coerced to a function and +

    +

    then called as a function of three arguments: + the expansion function, + the form, + and the env. +The value returned from this call is taken to be the expansion +of the form. +

    +

    In addition to macro definitions in the global environment, +any local macro definitions established within env by macrolet +or symbol-macrolet are considered. +If only form is supplied as an argument, +then the environment is effectively null, and only global macro definitions +as established by defmacro are considered. +Macro definitions are shadowed by local function definitions. +

    +

    Examples::

    + +
    +
     (defmacro alpha (x y) `(beta ,x ,y)) ⇒  ALPHA
+ (defmacro beta (x y) `(gamma ,x ,y)) ⇒  BETA
+ (defmacro delta (x y) `(gamma ,x ,y)) ⇒  EPSILON
+ (defmacro expand (form &environment env)
+   (multiple-value-bind (expansion expanded-p)
+       (macroexpand form env)
+     `(values ',expansion ',expanded-p))) ⇒  EXPAND
+ (defmacro expand-1 (form &environment env)
+   (multiple-value-bind (expansion expanded-p)
+       (macroexpand-1 form env)
+     `(values ',expansion ',expanded-p))) ⇒  EXPAND-1
+
+;; Simple examples involving just the global environment
+ (macroexpand-1 '(alpha a b)) ⇒  (BETA A B), true
+ (expand-1 (alpha a b)) ⇒  (BETA A B), true
+ (macroexpand '(alpha a b)) ⇒  (GAMMA A B), true
+ (expand (alpha a b)) ⇒  (GAMMA A B), true
+ (macroexpand-1 'not-a-macro) ⇒  NOT-A-MACRO, false
+ (expand-1 not-a-macro) ⇒  NOT-A-MACRO, false
+ (macroexpand '(not-a-macro a b)) ⇒  (NOT-A-MACRO A B), false
+ (expand (not-a-macro a b)) ⇒  (NOT-A-MACRO A B), false
+
+;; Examples involving lexical environments
+ (macrolet ((alpha (x y) `(delta ,x ,y)))
+   (macroexpand-1 '(alpha a b))) ⇒  (BETA A B), true
+ (macrolet ((alpha (x y) `(delta ,x ,y)))
+   (expand-1 (alpha a b))) ⇒  (DELTA A B), true
+ (macrolet ((alpha (x y) `(delta ,x ,y)))
+   (macroexpand '(alpha a b))) ⇒  (GAMMA A B), true
+ (macrolet ((alpha (x y) `(delta ,x ,y)))
+   (expand (alpha a b))) ⇒  (GAMMA A B), true
+ (macrolet ((beta (x y) `(epsilon ,x ,y)))
+   (expand (alpha a b))) ⇒  (EPSILON A B), true
+ (let ((x (list 1 2 3)))
+   (symbol-macrolet ((a (first x)))
+     (expand a))) ⇒  (FIRST X), true
+ (let ((x (list 1 2 3)))
+   (symbol-macrolet ((a (first x)))
+     (macroexpand 'a))) ⇒  A, false
+ (symbol-macrolet ((b (alpha x y)))
+   (expand-1 b)) ⇒  (ALPHA X Y), true
+ (symbol-macrolet ((b (alpha x y)))
+   (expand b)) ⇒  (GAMMA X Y), true
+ (symbol-macrolet ((b (alpha x y))
+                   (a b))
+   (expand-1 a)) ⇒  B, true
+ (symbol-macrolet ((b (alpha x y))
+                   (a b))
+   (expand a)) ⇒  (GAMMA X Y), true
+
+;; Examples of shadowing behavior
+ (flet ((beta (x y) (+ x y)))
+   (expand (alpha a b))) ⇒  (BETA A B), true
+ (macrolet ((alpha (x y) `(delta ,x ,y)))
+   (flet ((alpha (x y) (+ x y)))
+     (expand (alpha a b)))) ⇒  (ALPHA A B), false
+ (let ((x (list 1 2 3)))
+   (symbol-macrolet ((a (first x)))
+     (let ((a x))
+       (expand a)))) ⇒  A, false
+
    + +

    Affected By::

    + +

    defmacro, +setf of macro-function, +macrolet, +symbol-macrolet +

    +

    See Also::

    + +

    *macroexpand-hook*, +defmacro +, +setf + of +macro-function +, +macrolet, +symbol-macrolet +, +Evaluation +

    +

    Notes::

    + +

    Neither macroexpand nor macroexpand-1 +makes any explicit attempt to expand macro forms that are +either subforms of the form + or subforms of the expansion. +Such expansion might occur implicitly, however, +due to the semantics or implementation of the macro function. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002darray.html b/info/gcl/make_002darray.html new file mode 100644 index 0000000..04b415c --- /dev/null +++ b/info/gcl/make_002darray.html @@ -0,0 +1,316 @@ + + + + + +make-array (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.7 make-array [Function]

    + +

    make-array dimensions &key element-type + initial-element + initial-contents + adjustable + fill-pointer + displaced-to + displaced-index-offset
    + ⇒ new-array +

    +

    Arguments and Values::

    + +

    dimensions—a designator for a list of valid array dimensions. +

    +

    element-type—a type specifier. + The default is t. +

    +

    initial-element—an object. +

    +

    initial-contents—an object. +

    +

    adjustable—a generalized boolean. + The default is nil. +

    +

    fill-pointer—a valid fill pointer for the array to be created, + or t or nil. + The default is nil. +

    +

    displaced-to—an array or nil. + The default is nil. + This option must not be supplied if either initial-element + or initial-contents is supplied. +

    +

    displaced-index-offset—a valid array row-major index + for displaced-to. The default is 0. + This option must not be supplied unless a non-nil displaced-to is supplied. +

    +

    new-array—an array. +

    +

    Description::

    + +

    Creates and returns an array constructed of the most specialized +type that can accommodate elements of type given by element-type. +If dimensions is nil then a zero-dimensional array is created. +

    +

    Dimensions represents the dimensionality of the new array. +

    +

    element-type indicates the type of the elements intended to be stored +in the new-array. The new-array can actually store any objects +of the type which results from upgrading element-type; +see Array Upgrading. +

    +

    If initial-element is supplied, +it is used to initialize each element of new-array. +If initial-element is supplied, +it must be of the type given by element-type. +initial-element cannot be supplied if either the :initial-contents option +is supplied or displaced-to is non-nil. +If initial-element is not supplied, +

    +

    the consequences of later reading an uninitialized element of new-array +are undefined +

    +

    unless either initial-contents is supplied +or displaced-to is non-nil. +

    +

    initial-contents is used to initialize the contents of array. +For example: +

    +
    +
     (make-array '(4 2 3) :initial-contents
+             '(((a b c) (1 2 3))
+              ((d e f) (3 1 2))
+              ((g h i) (2 3 1))
+              ((j k l) (0 0 0))))
+
    + +

    initial-contents is composed of a nested structure of sequences. +The numbers of levels in the structure must equal the rank of array. +Each leaf of the nested structure must be of the type given by element-type. +If array is zero-dimensional, then initial-contents specifies the single +element. Otherwise, initial-contents must be a sequence +whose length is equal to the first dimension; each element must be a nested +structure for an array whose dimensions are the remaining dimensions, +and so on. +Initial-contents cannot be supplied if either +initial-element is supplied +or displaced-to is non-nil. +If initial-contents is not supplied, +

    +

    the consequences of later reading an uninitialized element of new-array +are undefined +

    +

    unless either initial-element is supplied +or displaced-to is non-nil. +

    +

    If adjustable is non-nil, +the array is expressly adjustable + (and so actually adjustable); +otherwise, the array is not expressly adjustable + (and it is implementation-dependent whether + the array is actually adjustable). +

    +

    If fill-pointer is non-nil, +the array must be one-dimensional; +that is, the array must be a vector. +If fill-pointer is t, +the length of the vector is used to initialize the fill pointer. +If fill-pointer is an integer, +it becomes the initial fill pointer for the vector. +

    +

    If displaced-to is non-nil, +make-array will create a displaced array +and displaced-to is the target of that displaced array. +In that case, the consequences are undefined if the actual array element type of +displaced-to is not type equivalent to the actual array element type +of the array being created. +If displaced-to is nil, the array is not a displaced array. +

    +

    The displaced-index-offset is made to be the index offset of the array. +When an array A is given as +the :displaced-to argument to make-array +when creating array B, +then array B is said to be displaced to array A. The +total number of elements in an array, +called the total size of the array, +is calculated as the product of all the dimensions. +It is required that the total size of A be no smaller than the sum +of the total size of B plus the offset n supplied by +the displaced-index-offset. +The effect of displacing is that array B does not have any +elements of its own, but instead maps accesses to itself into +accesses to array A. The mapping treats both arrays as if they +were one-dimensional by taking the elements in row-major order, +and then maps an access to element k of array B to an access to element +k+n of array A. +

    +

    If make-array is called with adjustable, fill-pointer, +and displaced-to each nil, +then the result is a simple array. +

    +

    If make-array is called with one or more of adjustable, +fill-pointer, or displaced-to being true, whether the +resulting array is a simple array is implementation-dependent. +

    +

    When an array A is given as the :displaced-to argument to + make-array when creating array B, then array B is said to + be displaced to array A. The total number of elements in an array, + called the total size of the array, is calculated as the product + of all the dimensions. +The consequences are unspecified if +the total size of A is smaller than the sum +of the total size of B plus the offset n supplied by +the displaced-index-offset. +The effect of displacing is that array B does not have any +elements of its own, but instead maps accesses to itself into +accesses to array A. The mapping treats both arrays as if they +were one-dimensional by taking the elements in row-major order, +and then maps an access to element k of array B to an access +to element k+n of array A. +

    +

    Examples::

    +
    +
    +
+ (make-array 5) ;; Creates a one-dimensional array of five elements.
+ (make-array '(3 4) :element-type '(mod 16)) ;; Creates a 
+                ;;two-dimensional array, 3 by 4, with four-bit elements.
+ (make-array 5 :element-type 'single-float) ;; Creates an array of single-floats.
+
    + +
    +
     (make-array nil :initial-element nil) ⇒  #0ANIL
+ (make-array 4 :initial-element nil) ⇒  #(NIL NIL NIL NIL)
+ (make-array '(2 4) 
+              :element-type '(unsigned-byte 2) 
+              :initial-contents '((0 1 2 3) (3 2 1 0)))
+⇒  #2A((0 1 2 3) (3 2 1 0))
+ (make-array 6
+              :element-type 'character 
+              :initial-element #\a 
+              :fill-pointer 3) ⇒  "aaa"
+
    + +

    The following is an example of making a displaced array. +

    +
    +
     (setq a (make-array '(4 3))) 
+⇒  #<ARRAY 4x3 simple 32546632>
+ (dotimes (i 4)
+   (dotimes (j 3)
+     (setf (aref a i j) (list i 'x j '= (* i j)))))
+⇒  NIL
+ (setq b (make-array 8 :displaced-to a
+                       :displaced-index-offset 2))
+⇒  #<ARRAY 8 indirect 32550757>
+ (dotimes (i 8)
+   (print (list i (aref b i))))
+ |>  (0 (0 X 2 = 0)) 
+ |>  (1 (1 X 0 = 0)) 
+ |>  (2 (1 X 1 = 1)) 
+ |>  (3 (1 X 2 = 2)) 
+ |>  (4 (2 X 0 = 0)) 
+ |>  (5 (2 X 1 = 2)) 
+ |>  (6 (2 X 2 = 4)) 
+ |>  (7 (3 X 0 = 0)) 
+⇒  NIL
+
    + +

    The last example depends on the fact that arrays are, in effect, +stored in row-major order. +

    +
    +
     (setq a1 (make-array 50))
+⇒  #<ARRAY 50 simple 32562043>
+ (setq b1 (make-array 20 :displaced-to a1 :displaced-index-offset 10))
+⇒  #<ARRAY 20 indirect 32563346>
+ (length b1) ⇒  20
+
+ (setq a2 (make-array 50 :fill-pointer 10))
+⇒  #<ARRAY 50 fill-pointer 10 46100216>
+ (setq b2 (make-array 20 :displaced-to a2 :displaced-index-offset 10))
+⇒  #<ARRAY 20 indirect 46104010>
+ (length a2) ⇒  10
+ (length b2) ⇒  20
+
+ (setq a3 (make-array 50 :fill-pointer 10))
+⇒  #<ARRAY 50 fill-pointer 10 46105663>
+ (setq b3 (make-array 20 :displaced-to a3 :displaced-index-offset 10
+                         :fill-pointer 5))
+⇒  #<ARRAY 20 indirect, fill-pointer 5 46107432>
+ (length a3) ⇒  10
+ (length b3) ⇒  5
+
    + +

    See Also::

    + +

    adjustable-array-p +, +aref +, +arrayp +, +array-element-type +, +array-rank-limit +, +array-dimension-limit +, +fill-pointer +, +upgraded-array-element-type +

    +

    Notes::

    + +

    There is no specified way to create an array +for which adjustable-array-p definitely +returns false. +There is no specified way to create an array +that is not a simple array. +

    +
    +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002dbroadcast_002dstream.html b/info/gcl/make_002dbroadcast_002dstream.html new file mode 100644 index 0000000..8618084 --- /dev/null +++ b/info/gcl/make_002dbroadcast_002dstream.html @@ -0,0 +1,83 @@ + + + + + +make-broadcast-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.41 make-broadcast-stream [Function]

    + +

    make-broadcast-stream &rest streams ⇒ broadcast-stream +

    +

    Arguments and Values::

    + +

    stream—an output stream. +

    +

    broadcast-stream—a broadcast stream. +

    +

    Description::

    + +

    Returns a broadcast stream. +

    +

    Examples::

    + +
    +
     (setq a-stream (make-string-output-stream)
+        b-stream (make-string-output-stream)) ⇒  #<String Output Stream>
+ (format (make-broadcast-stream a-stream b-stream)
+          "this will go to both streams") ⇒  NIL
+ (get-output-stream-string a-stream) ⇒  "this will go to both streams"
+ (get-output-stream-string b-stream) ⇒  "this will go to both streams"
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if any stream is not an output stream. +

    +

    See Also::

    + +

    broadcast-stream-streams +

    + + + + + diff --git a/info/gcl/make_002dconcatenated_002dstream.html b/info/gcl/make_002dconcatenated_002dstream.html new file mode 100644 index 0000000..1db7255 --- /dev/null +++ b/info/gcl/make_002dconcatenated_002dstream.html @@ -0,0 +1,79 @@ + + + + + +make-concatenated-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.47 make-concatenated-stream [Function]

    + +

    make-concatenated-stream &rest input-streams ⇒ concatenated-stream +

    +

    Arguments and Values::

    + +

    input-stream—an input stream. +

    +

    concatenated-stream—a concatenated stream. +

    +

    Description::

    + +

    Returns a concatenated stream that has the indicated input-streams +initially associated with it. +

    +

    Examples::

    +
    +
     (read (make-concatenated-stream
+         (make-string-input-stream "1")
+         (make-string-input-stream "2"))) ⇒  12
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if any argument is not an input stream. +

    +

    See Also::

    + +

    concatenated-stream-streams +

    + + + + + diff --git a/info/gcl/make_002dcondition.html b/info/gcl/make_002dcondition.html new file mode 100644 index 0000000..ce63e11 --- /dev/null +++ b/info/gcl/make_002dcondition.html @@ -0,0 +1,97 @@ + + + + + +make-condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.30 make-condition [Function]

    + +

    make-condition type &rest slot-initializations ⇒ condition +

    +

    Arguments and Values::

    + +

    type—a type specifier (for a subtype of condition). +

    +

    slot-initializations—an initialization argument list. +

    +

    condition—a condition. +

    +

    Description::

    + +

    Constructs and returns a condition of type type +using slot-initializations for the initial values of the slots. +The newly created condition is returned. +

    +

    Examples::

    + +
    +
     (defvar *oops-count* 0)
+
+ (setq a (make-condition 'simple-error
+                         :format-control "This is your ~:R error."
+                         :format-arguments (list (incf *oops-count*))))
+⇒  #<SIMPLE-ERROR 32245104>
+
+ (format t "~&~A~
+ |>  This is your first error.
+⇒  NIL
+
+ (error a)
+ |>  Error: This is your first error.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Return to Lisp Toplevel.
+ |>  Debug> 
+
    + +

    Affected By::

    + +

    The set of defined condition types. +

    +

    See Also::

    + +

    define-condition +, Condition System Concepts +

    + + + + + diff --git a/info/gcl/make_002ddispatch_002dmacro_002dcharacter.html b/info/gcl/make_002ddispatch_002dmacro_002dcharacter.html new file mode 100644 index 0000000..92d6032 --- /dev/null +++ b/info/gcl/make_002ddispatch_002dmacro_002dcharacter.html @@ -0,0 +1,95 @@ + + + + + +make-dispatch-macro-character (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.3 make-dispatch-macro-character [Function]

    + +

    make-dispatch-macro-character char &optional non-terminating-p readtable ⇒ t +

    +

    Arguments and Values::

    + +

    char—a character. +

    +

    non-terminating-p—a generalized boolean. + The default is false. +

    +

    readtable—a readtable. + The default is the current readtable. +

    +

    Description::

    + +

    make-dispatch-macro-character makes char +be a dispatching macro character in readtable. +

    +

    Initially, every character in the dispatch table +associated with the char has an associated function +that signals an error of type reader-error. +

    +

    If non-terminating-p is true, +the dispatching macro character +is made a non-terminating macro character; +if non-terminating-p is false, +the dispatching macro character +is made a terminating macro character. +

    +

    Examples::

    + +
    +
     (get-macro-character #\{) ⇒  NIL, false
+ (make-dispatch-macro-character #\{) ⇒  T
+ (not (get-macro-character #\{)) ⇒  false
+
    + +

    The readtable is altered. +

    +

    See Also::

    + +

    readtable +, +set-dispatch-macro-character +

    + + + + + diff --git a/info/gcl/make_002decho_002dstream.html b/info/gcl/make_002decho_002dstream.html new file mode 100644 index 0000000..9d3e63c --- /dev/null +++ b/info/gcl/make_002decho_002dstream.html @@ -0,0 +1,87 @@ + + + + + +make-echo-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.45 make-echo-stream [Function]

    + +

    make-echo-stream input-stream output-stream ⇒ echo-stream +

    +

    Arguments and Values::

    + +

    input-stream—an input stream. +

    +

    output-stream—an output stream. +

    +

    echo-stream—an echo stream. +

    +

    Description::

    + +

    Creates and returns an echo stream +that takes input from input-stream +and sends output to output-stream. +

    +

    Examples::

    +
    +
     (let ((out (make-string-output-stream)))
+    (with-open-stream 
+        (s (make-echo-stream
+            (make-string-input-stream "this-is-read-and-echoed")
+            out))
+      (read s)
+      (format s " * this-is-direct-output")
+      (get-output-stream-string out)))
+⇒  "this-is-read-and-echoed * this-is-direct-output"
+
    + +

    See Also::

    + +

    echo-stream-input-stream +, +echo-stream-output-stream, +make-two-way-stream +

    + + + + + diff --git a/info/gcl/make_002dhash_002dtable.html b/info/gcl/make_002dhash_002dtable.html new file mode 100644 index 0000000..7a33208 --- /dev/null +++ b/info/gcl/make_002dhash_002dtable.html @@ -0,0 +1,145 @@ + + + + + +make-hash-table (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.2 make-hash-table [Function]

    + +

    make-hash-table &key test size rehash-size rehash-threshold ⇒ hash-table +

    +

    Arguments and Values::

    + +

    test—a designator for one of the functions + eq, + eql, + equal, or +

    +

    equalp. +

    +

    The default is eql. +

    +

    size—a non-negative integer. +

    +

    The default is implementation-dependent. +

    +

    rehash-size—a real of type (or (integer 1 *) (float (1.0) *)). + The default is implementation-dependent. +

    +

    rehash-threshold—a real of type (real 0 1). + The default is implementation-dependent. +

    +

    hash-table—a hash table. +

    +

    Description::

    + +

    Creates and returns a new hash table. +

    +

    test determines how keys are compared. +An object is said to be present in the hash-table +if that object is the same under the test +as the key for some entry in the hash-table. +

    +

    size is a hint to the implementation about how much initial space +to allocate in the hash-table. +

    +

    This information, taken together with the rehash-threshold, controls +the approximate number of entries which it should be possible +to insert before the table has to grow. +

    +

    The actual size might be rounded up from size to the next ‘good’ size; +for example, some implementations might round to the next prime number. +

    +

    rehash-size specifies a minimum amount to increase the size of the +hash-table when it becomes full +enough to require rehashing; +see rehash-theshold below. +

    +

    If rehash-size is an integer, +the expected growth rate for the table is additive and +the integer is the number of entries to add; +if it is a float, +the expected growth rate for the table is multiplicative and +the float is the ratio of the new size to the old size. +

    +

    As with size, the actual size of the increase might be rounded up. +

    +

    rehash-threshold specifies how full the hash-table can get +before it must grow. +

    +

    It specifies the maximum desired hash-table occupancy level. +

    +

    The values of rehash-size and rehash-threshold do not constrain the +implementation to use any particular method for computing when and by how much +the size of hash-table should be enlarged. Such decisions are +implementation-dependent, and these values only hints +from the programmer to the implementation, and the implementation +is permitted to ignore them. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 46142754>
+ (setf (gethash "one" table) 1) ⇒  1
+ (gethash "one" table) ⇒  NIL, false
+ (setq table (make-hash-table :test 'equal)) ⇒  #<HASH-TABLE EQUAL 0/139 46145547>
+ (setf (gethash "one" table) 1) ⇒  1
+ (gethash "one" table) ⇒  1, T
+ (make-hash-table :rehash-size 1.5 :rehash-threshold 0.7) 
+⇒  #<HASH-TABLE EQL 0/120 46156620>
+
    + +

    See Also::

    + +

    gethash +, +hash-table +

    +
    +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002dinstance.html b/info/gcl/make_002dinstance.html new file mode 100644 index 0000000..bb12642 --- /dev/null +++ b/info/gcl/make_002dinstance.html @@ -0,0 +1,101 @@ + + + + + +make-instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.19 make-instance [Standard Generic Function]

    + +

    Syntax::

    + +

    make-instance class &rest initargs &key &allow-other-keys ⇒ instance +

    +

    Method Signatures::

    + +

    make-instance (class standard-class) &rest initargs +

    +

    make-instance (class symbol) &rest initargs +

    +

    Arguments and Values::

    + +

    class—a class, + or a symbol that names a class. +

    +

    initargs—an initialization argument list. +

    +

    instance—a fresh instance of class class. +

    +

    Description::

    + +

    The generic function make-instance +creates and returns a new instance of the given class. +

    +

    If the second of the above methods is selected, +that method invokes make-instance on the arguments +(find-class class) and initargs. +

    +

    The initialization arguments are checked within make-instance. +

    +

    The generic function make-instance +may be used as described in Object Creation and Initialization. +

    +

    Exceptional Situations::

    + +

    If any of the initialization arguments has not +been declared as valid, an error of type error is signaled. +

    +

    See Also::

    + +

    defclass +, +class-of +, +allocate-instance +, +Initialize-Instance +, +Object Creation and Initialization +

    + + + + + diff --git a/info/gcl/make_002dinstances_002dobsolete.html b/info/gcl/make_002dinstances_002dobsolete.html new file mode 100644 index 0000000..c2fe0f1 --- /dev/null +++ b/info/gcl/make_002dinstances_002dobsolete.html @@ -0,0 +1,91 @@ + + + + + +make-instances-obsolete (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.20 make-instances-obsolete [Standard Generic Function]

    + +

    Syntax::

    + +

    make-instances-obsolete class ⇒ class +

    +

    Method Signatures::

    + +

    make-instances-obsolete (class standard-class) +

    +

    make-instances-obsolete (class symbol) +

    +

    Arguments and Values::

    + +

    class—a class designator. +

    +

    Description::

    + +

    The function make-instances-obsolete has the effect of +initiating the process of updating the instances of the +class. During updating, the generic function +update-instance-for-redefined-class will be invoked. +

    +

    The generic function make-instances-obsolete is invoked +automatically by the system when defclass has been used to +redefine an existing standard class and the set of local +slots accessible in an +instance is changed or the order of slots in storage is changed. It +can also be explicitly invoked by the user. +

    +

    If the second of the above methods is selected, that +method invokes +make-instances-obsolete on (find-class class). +

    +

    Examples::

    + +

    See Also::

    + +

    update-instance-for-redefined-class +, +Redefining Classes +

    + + + + + diff --git a/info/gcl/make_002dlist.html b/info/gcl/make_002dlist.html new file mode 100644 index 0000000..e587f01 --- /dev/null +++ b/info/gcl/make_002dlist.html @@ -0,0 +1,87 @@ + + + + + +make-list (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.18 make-list [Function]

    + +

    make-list size &key initial-element ⇒ list +

    +

    Arguments and Values::

    + +

    size—a non-negative integer. +

    +

    initial-element—an object. + The default is nil. +

    +

    list—a list. +

    +

    Description::

    + +

    Returns a list of length given by size, +each of the elements of which is initial-element. +

    +

    Examples::

    +
    +
     (make-list 5) ⇒  (NIL NIL NIL NIL NIL)
+ (make-list 3 :initial-element 'rah) ⇒  (RAH RAH RAH)
+ (make-list 2 :initial-element '(1 2 3)) ⇒  ((1 2 3) (1 2 3))
+ (make-list 0) ⇒  NIL ;i.e., ()
+ (make-list 0 :initial-element 'new-element) ⇒  NIL 
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if size is not a non-negative integer. +

    +

    See Also::

    + +

    cons +, +list (Function) +

    + + + + + diff --git a/info/gcl/make_002dload_002dform.html b/info/gcl/make_002dload_002dform.html new file mode 100644 index 0000000..a23f09d --- /dev/null +++ b/info/gcl/make_002dload_002dform.html @@ -0,0 +1,339 @@ + + + + + +make-load-form (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.21 make-load-form [Standard Generic Function]

    + +

    Syntax::

    + +

    make-load-form object &optional environment ⇒ creation-form [, initialization-form ] +

    +

    Method Signatures::

    + +

    make-load-form (object standard-object) &optional environment +

    +

    make-load-form (object structure-object) &optional environment +

    +

    make-load-form (object condition) &optional environment +

    +

    make-load-form (object class) &optional environment +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    environment—an environment object. +

    +

    creation-form—a form. +

    +

    initialization-form—a form. +

    +

    Description::

    + +

    The generic function make-load-form creates and returns +one or two forms, + a creation-form + and an initialization-form, +that enable load to construct an object +equivalent to object. +Environment is an environment object +corresponding to the lexical environment +in which the forms will be processed. +

    +

    The file compiler calls make-load-form to process certain +classes of literal objects; see Additional Constraints on Externalizable Objects. +

    +

    Conforming programs may call make-load-form directly, +providing object is a generalized instance of +standard-object, structure-object, +or condition. +

    +

    The creation form is a form that, when evaluated at +load time, should return an object that +is equivalent to object. The exact meaning of +equivalent depends on the type of object +and is up to the programmer who defines a method for +make-load-form; +see Literal Objects in Compiled Files. +

    +

    The initialization form is a form that, when evaluated at load time, +should perform further initialization of the object. +The value returned by the initialization form is ignored. +If make-load-form +returns only one value, +the initialization form is nil, which has no effect. +If object appears as a constant in the initialization form, +at load time it will be replaced by the equivalent object +constructed by the creation form; +this is how the further initialization gains access to the object. +

    +

    Both the creation-form and the initialization-form may contain references +to any externalizable object. +However, there must not be any circular dependencies in creation forms. +An example of a circular dependency is when the creation form for the +object X contains a reference to the object Y, +and the creation form for the object Y contains a reference to the object X. +Initialization forms are not subject to any restriction against circular dependencies, +which is the reason that initialization forms exist; +see the example of circular data structures below. +

    +

    The creation form for an object is always evaluated before the +initialization form for that object. When either the creation form or +the initialization form references other objects that have not been +referenced earlier in the file being compiled, the compiler ensures +that all of the referenced objects have been created before evaluating +the referencing form. When the referenced object is of a type which +the file compiler processes using make-load-form, +this involves evaluating +the creation form returned for it. (This is the reason for the +prohibition against circular references among creation forms). +

    +

    Each initialization form is evaluated as soon as possible after its +associated creation form, as determined by data flow. If the +initialization form for an object does not reference any other objects +not referenced earlier in the file and processed by +the file compiler +using +make-load-form, the initialization form is evaluated immediately after +the creation form. If a creation or initialization form F does contain +references to such objects, the creation forms for those other objects +are evaluated before F, and the initialization forms for those other +objects are also evaluated before F whenever they do not depend on the +object created or initialized by F. Where these rules do not uniquely +determine an order of evaluation between two creation/initialization +forms, the order of evaluation is unspecified. +

    +

    While these creation and initialization forms are being evaluated, the + objects are possibly in an uninitialized state, +analogous to the state + of an object +between the time it has been created by allocate-instance + and it has been processed fully by +initialize-instance. Programmers + writing methods for +make-load-form must take care in manipulating + objects not to depend on +slots that have not yet been initialized. +

    +

    It is implementation-dependent +whether load calls eval on the +forms or does some + other operation that has an equivalent effect. For example, the + forms might be translated into different but equivalent +forms and + then evaluated, they might be compiled and the resulting functions + called by load, +or they might be interpreted by a special-purpose +function different from eval. +All that is required is that the + effect be equivalent to evaluating the forms. +

    +

    The method specialized on class returns a creation +form using the name of the class if the class has +a proper name in environment, signaling an error of type error +if it does not have a proper name. Evaluation of the creation +form uses the name to find the class with that +name, as if by calling find-class. If a class +with that name has not been defined, then a class may be +computed in an implementation-defined manner. If a class +cannot be returned as the result of evaluating the creation +form, then an error of type error is signaled. +

    +

    Both conforming implementations and conforming programs may +further specialize make-load-form. +

    +

    Examples::

    + +
    +
     (defclass obj ()
+    ((x :initarg :x :reader obj-x)
+     (y :initarg :y :reader obj-y)
+     (dist :accessor obj-dist)))
+⇒  #<STANDARD-CLASS OBJ 250020030>
+ (defmethod shared-initialize :after ((self obj) slot-names &rest keys)
+   (declare (ignore slot-names keys))
+   (unless (slot-boundp self 'dist)
+     (setf (obj-dist self)
+           (sqrt (+ (expt (obj-x self) 2) (expt (obj-y self) 2))))))
+⇒  #<STANDARD-METHOD SHARED-INITIALIZE (:AFTER) (OBJ T) 26266714>
+ (defmethod make-load-form ((self obj) &optional environment)
+   (declare (ignore environment))
+   ;; Note that this definition only works because X and Y do not
+   ;; contain information which refers back to the object itself.
+   ;; For a more general solution to this problem, see revised example below.
+   `(make-instance ',(class-of self)
+                   :x ',(obj-x self) :y ',(obj-y self)))
+⇒  #<STANDARD-METHOD MAKE-LOAD-FORM (OBJ) 26267532>
+ (setq obj1 (make-instance 'obj :x 3.0 :y 4.0)) ⇒  #<OBJ 26274136>
+ (obj-dist obj1) ⇒  5.0
+ (make-load-form obj1) ⇒  (MAKE-INSTANCE 'OBJ :X '3.0 :Y '4.0)
+
    + +

    In the above example, an equivalent instance of obj is +reconstructed by using the values of two of its slots. +The value of the third slot is derived from those two values. +

    +

    Another way to write the make-load-form method +in that example is to use make-load-form-saving-slots. +The code it generates might yield a slightly different result +from the make-load-form method shown above, +but the operational effect will be the same. For example: +

    +
    +
     ;; Redefine method defined above.
+ (defmethod make-load-form ((self obj) &optional environment)
+    (make-load-form-saving-slots self
+                                 :slot-names '(x y)
+                                 :environment environment))
+⇒  #<STANDARD-METHOD MAKE-LOAD-FORM (OBJ) 42755655>
+ ;; Try MAKE-LOAD-FORM on object created above.
+ (make-load-form obj1)
+⇒  (ALLOCATE-INSTANCE '#<STANDARD-CLASS OBJ 250020030>),
+    (PROGN
+      (SETF (SLOT-VALUE '#<OBJ 26274136> 'X) '3.0)
+      (SETF (SLOT-VALUE '#<OBJ 26274136> 'Y) '4.0)
+      (INITIALIZE-INSTANCE '#<OBJ 26274136>))
+
    + +

    In the following example, instances of my-frob are “interned” +in some way. An equivalent instance is reconstructed by using the +value of the name slot as a key for searching existing objects. +In this case the programmer has chosen to create a new object +if no existing object is found; alternatively an error could +have been signaled in that case. +

    +
    +
     (defclass my-frob ()
+    ((name :initarg :name :reader my-name)))
+ (defmethod make-load-form ((self my-frob) &optional environment)
+   (declare (ignore environment))
+   `(find-my-frob ',(my-name self) :if-does-not-exist :create))
+
    + +

    In the following example, the data structure to be dumped is circular, +because each parent has a list of its children and each child has a reference +back to its parent. If make-load-form is called on one +object in such a structure, the creation form creates an equivalent +object and fills in the children slot, which forces creation of equivalent +objects for all of its children, grandchildren, etc. At this point +none of the parent slots have been filled in. +The initialization form fills in the parent slot, which forces creation +of an equivalent object for the parent if it was not already created. +Thus the entire tree is recreated at load time. +At compile time, make-load-form is called once for each object +in the tree. +All of the creation forms are evaluated, +in implementation-dependent order, +and then all of the initialization forms are evaluated, +also in implementation-dependent order. +

    +
    +
     (defclass tree-with-parent () ((parent :accessor tree-parent)
+                                (children :initarg :children)))
+ (defmethod make-load-form ((x tree-with-parent) &optional environment)
+   (declare (ignore environment))
+   (values
+     ;; creation form
+     `(make-instance ',(class-of x) :children ',(slot-value x 'children))
+     ;; initialization form
+     `(setf (tree-parent ',x) ',(slot-value x 'parent))))
+
    + +

    In the following example, the data structure to be dumped has no special +properties and an equivalent structure can be reconstructed +simply by reconstructing the slots’ contents. +

    +
    +
     (defstruct my-struct a b c)
+ (defmethod make-load-form ((s my-struct) &optional environment)
+    (make-load-form-saving-slots s :environment environment))
+
    + +

    Exceptional Situations::

    + +

    The methods specialized on + standard-object, + structure-object, + and condition +all signal an error of type error. +

    +

    It is implementation-dependent whether calling +make-load-form on a generalized instance of a +system class signals an error or returns creation and +initialization forms. +

    +

    See Also::

    + +

    compile-file +, +make-load-form-saving-slots +, +Additional Constraints on Externalizable Objects +Evaluation, +Compilation +

    +

    Notes::

    + +

    The file compiler +calls make-load-form in specific circumstances +detailed in Additional Constraints on Externalizable Objects. +

    +

    Some implementations may provide facilities for defining new +subclasses of classes which are specified as +system classes. (Some likely candidates include +generic-function, method, and stream). Such +implementations should document how the file compiler processes +instances of such classes when encountered as +literal objects, and should document any relevant methods +for make-load-form. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002dload_002dform_002dsaving_002dslots.html b/info/gcl/make_002dload_002dform_002dsaving_002dslots.html new file mode 100644 index 0000000..b5a70ab --- /dev/null +++ b/info/gcl/make_002dload_002dform_002dsaving_002dslots.html @@ -0,0 +1,113 @@ + + + + + +make-load-form-saving-slots (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.22 make-load-form-saving-slots [Function]

    + +

    make-load-form-saving-slots object &key slot-names environment
    + ⇒ creation-form, initialization-form +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    slot-names—a list. +

    +

    environment—an environment object. +

    +

    creation-form—a form. +

    +

    initialization-form—a form. +

    +

    Description::

    + +

    Returns forms that, when evaluated, will construct an +object equivalent to object, without executing +initialization forms. The slots in the new object +that correspond to initialized slots in object are +initialized using the values from object. Uninitialized slots +in object are not initialized in the new object. +make-load-form-saving-slots works for any instance of +standard-object or structure-object. +

    +

    Slot-names is a list of the names of the +slots to preserve. If slot-names is not +supplied, its value is all of the local slots. +

    +

    make-load-form-saving-slots returns two values, +thus it can deal with circular structures. +Whether the result is useful in an application depends on +whether the object’s type and slot contents +fully capture the application’s idea of the object’s state. +

    +

    Environment is the environment in which the forms will be processed. +

    +

    See Also::

    + +

    make-load-form +, +make-instance +, +setf +, +slot-value +, +slot-makunbound +

    +

    Notes::

    + +

    make-load-form-saving-slots can be useful in user-written +make-load-form methods. +

    +

    When the object is an instance of standard-object, +make-load-form-saving-slots could return a creation form that +calls allocate-instance and an initialization form that +contains calls to setf of slot-value and +slot-makunbound, though other functions of similar effect +might actually be used. +

    + + + + + diff --git a/info/gcl/make_002dpackage.html b/info/gcl/make_002dpackage.html new file mode 100644 index 0000000..fac1b4e --- /dev/null +++ b/info/gcl/make_002dpackage.html @@ -0,0 +1,122 @@ + + + + + +make-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.12 make-package [Function]

    + +

    make-package package-name &key nicknames use ⇒ package +

    +

    Arguments and Values::

    + +

    package-name—a string designator. +

    +

    nicknames—a list of string designators. + The default is the empty list. +

    +

    use— +a list of package designators. +

    +

    The default is implementation-defined. +

    +

    package—a package. +

    +

    Description::

    + +

    Creates a new package with the name package-name. +

    +

    Nicknames are additional names which may be used +to refer to the new package. +

    +

    use specifies zero or more packages +the external symbols of which are to be inherited by +the new package. See the function use-package. +

    +

    Examples::

    + +
    +
     (make-package 'temporary :nicknames '("TEMP" "temp")) ⇒  #<PACKAGE "TEMPORARY">
+ (make-package "OWNER" :use '("temp")) ⇒  #<PACKAGE "OWNER">
+ (package-used-by-list 'temp) ⇒  (#<PACKAGE "OWNER">)
+ (package-use-list 'owner) ⇒  (#<PACKAGE "TEMPORARY">)
+
    + +

    Affected By::

    + +

    The existence of other packages in the system. +

    +

    Exceptional Situations::

    + +

    The consequences are unspecified if packages denoted by use +do not exist. +

    +

    A correctable error is signaled if the package-name +or any of the nicknames is already +the name or nickname of an existing package. +

    +

    See Also::

    + +

    defpackage +, +use-package +

    +

    Notes::

    + +

    In situations where the packages to be used contain symbols which would conflict, +it is necessary to first create the package with :use '(), +then to use shadow or shadowing-import to address the conflicts, +and then after that to use use-package once the conflicts have been addressed. +

    +

    When packages are being created as part of the static definition of a program +rather than dynamically by the program, it is generally considered more stylistically +appropriate to use defpackage rather than make-package. +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002dpathname.html b/info/gcl/make_002dpathname.html new file mode 100644 index 0000000..3a3d649 --- /dev/null +++ b/info/gcl/make_002dpathname.html @@ -0,0 +1,190 @@ + + + + + +make-pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.4 make-pathname [Function]

    + +

    make-pathname &key host device directory name type version defaults case
    + ⇒ pathname +

    +

    Arguments and Values::

    + +

    host—a valid physical pathname host. + Complicated defaulting behavior; see below. +

    +

    device—a valid pathname device. + Complicated defaulting behavior; see below. +

    +

    directory—a valid pathname directory. + Complicated defaulting behavior; see below. +

    +

    name—a valid pathname name. + Complicated defaulting behavior; see below. +

    +

    type—a valid pathname type. + Complicated defaulting behavior; see below. +

    +

    version—a valid pathname version. + Complicated defaulting behavior; see below. +

    +

    defaults—a pathname designator. + The default is a pathname whose host component is the same as the + host component of the value of *default-pathname-defaults*, + and whose other components are all nil. +

    +

    case—one of :common or :local. + The default is :local. +

    +

    pathname—a pathname. +

    +

    Description::

    + +

    Constructs and returns a pathname from the supplied keyword arguments. +

    +

    After the components supplied explicitly by + host, + device, + directory, + name, + type, + and version +are filled in, +the merging rules used by merge-pathnames +are used to fill in any +unsupplied +components +from the defaults supplied by defaults. +

    +

    Whenever a pathname is constructed the components may be +canonicalized if appropriate. +For the explanation of the arguments that can be supplied for each component, +see Pathname Components. +

    +

    If case is supplied, +it is treated as described in Case in Pathname Components. +

    +

    The resulting pathname is a logical pathname +if and only its host component +is +a logical host +or a string that names a defined logical host. +

    +

    If the directory is a string, +it should be the name of a top level directory, +and should not contain any punctuation characters; that is, +specifying a string, str, is +equivalent to specifying the list (:absolute str). +Specifying the symbol :wild is equivalent to specifying the list +(:absolute :wild-inferiors), or (:absolute :wild) +in a file system that does not support :wild-inferiors. +

    +

    Examples::

    + +
    +
     ;; Implementation A -- an implementation with access to a single
+ ;;  Unix file system.  This implementation happens to never display
+ ;;  the `host' information in a namestring, since there is only one host. 
+ (make-pathname :directory '(:absolute "public" "games")
+                :name "chess" :type "db")
+⇒  #P"/public/games/chess.db" 
+
+ ;; Implementation B -- an implementation with access to one or more
+ ;;  VMS file systems.  This implementation displays `host' information
+ ;;  in the namestring only when the host is not the local host.
+ ;;  It uses a double colon to separate a host name from the host's local
+ ;;  file name.
+ (make-pathname :directory '(:absolute "PUBLIC" "GAMES")
+                :name "CHESS" :type "DB")
+⇒  #P"SYS$DISK:[PUBLIC.GAMES]CHESS.DB" 
+ (make-pathname :host "BOBBY"
+                :directory '(:absolute "PUBLIC" "GAMES")
+                :name "CHESS" :type "DB")
+⇒  #P"BOBBY::SYS$DISK:[PUBLIC.GAMES]CHESS.DB" 
+
+ ;; Implementation C -- an implementation with simultaneous access to
+ ;;  multiple file systems from the same Lisp image.  In this 
+ ;;  implementation, there is a convention that any text preceding the
+ ;;  first colon in a pathname namestring is a host name.
+ (dolist (case '(:common :local))
+   (dolist (host '("MY-LISPM" "MY-VAX" "MY-UNIX"))
+     (print (make-pathname :host host :case case
+                           :directory '(:absolute "PUBLIC" "GAMES")
+                           :name "CHESS" :type "DB"))))
+ |>  #P"MY-LISPM:>public>games>chess.db"
+ |>  #P"MY-VAX:SYS$DISK:[PUBLIC.GAMES]CHESS.DB"
+ |>  #P"MY-UNIX:/public/games/chess.db"
+ |>  #P"MY-LISPM:>public>games>chess.db" 
+ |>  #P"MY-VAX:SYS$DISK:[PUBLIC.GAMES]CHESS.DB" 
+ |>  #P"MY-UNIX:/PUBLIC/GAMES/CHESS.DB" 
+⇒  NIL
+
    + +

    Affected By::

    + +

    The file system. +

    +

    See Also::

    + +

    merge-pathnames +, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    Portable programs should not supply :unspecific for any component. +See ->UNSPECIFIC as a Component Value. +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002drandom_002dstate.html b/info/gcl/make_002drandom_002dstate.html new file mode 100644 index 0000000..c5bcdf6 --- /dev/null +++ b/info/gcl/make_002drandom_002dstate.html @@ -0,0 +1,117 @@ + + + + + +make-random-state (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.40 make-random-state [Function]

    + +

    make-random-state &optional state ⇒ new-state +

    +

    Arguments and Values::

    + +

    state—a random state, or nil, or t. + The default is nil. +

    +

    new-state—a random state object. +

    +

    Description::

    + +

    Creates a fresh object of type random-state suitable +for use as the value of *random-state*. +

    +

    If state is a random state object, +the new-state is a copy_5 of that object. +If state is nil, +the new-state is a copy_5 of the current random state. +If state is t, +the new-state is a fresh random state object +that has been randomly initialized by some means. +

    +

    Examples::

    + +
    +
     (let* ((rs1 (make-random-state nil))
+        (rs2 (make-random-state t))
+        (rs3 (make-random-state rs2))
+        (rs4 nil))
+   (list (loop for i from 1 to 10 
+               collect (random 100)
+               when (= i 5)
+                do (setq rs4 (make-random-state)))
+         (loop for i from 1 to 10 collect (random 100 rs1))
+         (loop for i from 1 to 10 collect (random 100 rs2))
+         (loop for i from 1 to 10 collect (random 100 rs3))
+         (loop for i from 1 to 10 collect (random 100 rs4))))
+⇒  ((29 25 72 57 55 68 24 35 54 65)
+    (29 25 72 57 55 68 24 35 54 65)
+    (93 85 53 99 58 62 2 23 23 59)
+    (93 85 53 99 58 62 2 23 23 59)
+    (68 24 35 54 65 54 55 50 59 49))
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if state is not a random state, or nil, or t. +

    +

    See Also::

    + +

    random +, +random-state +

    +

    Notes::

    + +

    One important use of make-random-state is to allow the same +series of pseudo-random numbers to be generated many times within a +single program. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002dsequence.html b/info/gcl/make_002dsequence.html new file mode 100644 index 0000000..466ec4c --- /dev/null +++ b/info/gcl/make_002dsequence.html @@ -0,0 +1,129 @@ + + + + + +make-sequence (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.5 make-sequence [Function]

    + +

    make-sequence result-type size &key initial-element ⇒ sequence +

    +

    Arguments and Values::

    + +

    result-type—a sequence type specifier. +

    +

    size—a non-negative integer. +

    +

    initial-element—an object. + The default is implementation-dependent. +

    +

    sequence—a proper sequence. +

    +

    Description::

    + +

    Returns a sequence of the type result-type and of length size, +each of the elements of which has been initialized to initial-element. +

    +

    If the result-type is a subtype of list, +the result will be a list. +

    +

    If the result-type is a subtype of vector, +then if the implementation can determine the element type specified +for the result-type, the element type of the resulting array +is the result of upgrading that element type; or, if the +implementation can determine that the element type is unspecified (or *), +the element type of the resulting array is t; +otherwise, an error is signaled. +

    +

    Examples::

    + +
    +
     (make-sequence 'list 0) ⇒  ()
+ (make-sequence 'string 26 :initial-element #\.) 
+⇒  ".........................."
+ (make-sequence '(vector double-float) 2
+                :initial-element 1d0)
+⇒  #(1.0d0 1.0d0)
+
    + +
    +
     (make-sequence '(vector * 2) 3) should signal an error
+ (make-sequence '(vector * 4) 3) should signal an error
+
    + +

    Affected By::

    + +

    The implementation. +

    +

    Exceptional Situations::

    + +

    The consequences are unspecified if initial-element +is not an object which can be stored in the resulting sequence. +

    +

    An error of type type-error must be signaled if the result-type is neither + a recognizable subtype of list, + nor a recognizable subtype of vector. +

    +

    An error of type type-error should be signaled if result-type specifies +the number of elements and size is different from that number. +

    +

    See Also::

    + +

    make-array +, +make-list +

    +

    Notes::

    + +
    +
     (make-sequence 'string 5) ≡ (make-string 5)               
+
    + +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/make_002dstring.html b/info/gcl/make_002dstring.html new file mode 100644 index 0000000..328cbbb --- /dev/null +++ b/info/gcl/make_002dstring.html @@ -0,0 +1,91 @@ + + + + + +make-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.12 make-string [Function]

    + +

    make-string size &key initial-element element-type ⇒ string +

    +

    Arguments and Values::

    + +

    size—a valid array dimension. +

    +

    initial-element—a character. +

    +

    The default is implementation-dependent. +

    +

    element-type—a type specifier. + The default is character. +

    +

    string—a simple string. +

    +

    Description::

    + +

    make-string returns a simple string of length size +whose elements have been initialized to initial-element. +

    +

    The element-type names the type of the elements of the string; +a string is constructed of the most specialized +type that can accommodate elements of the given type. +

    +

    Examples::

    + +
    +
     (make-string 10 :initial-element #\5) ⇒  "5555555555"
+ (length (make-string 10)) ⇒  10
+
    + +

    Affected By::

    + +

    The implementation. +

    + + + + + + + + + + diff --git a/info/gcl/make_002dstring_002dinput_002dstream.html b/info/gcl/make_002dstring_002dinput_002dstream.html new file mode 100644 index 0000000..bf6d518 --- /dev/null +++ b/info/gcl/make_002dstring_002dinput_002dstream.html @@ -0,0 +1,86 @@ + + + + + +make-string-input-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.49 make-string-input-stream [Function]

    + +

    make-string-input-stream string &optional start end ⇒ string-stream +

    +

    Arguments and Values::

    + +

    string—a string. +

    +

    start, end—bounding index designators of string. + The defaults for start and end are 0 and nil, respectively. +

    +

    string-stream—an input string stream. +

    +

    Description::

    + +

    Returns an input string stream. +This stream will supply, in order, the characters in the substring +of string bounded by start and end. +After the last character has been supplied, +the string stream will then be at end of file. +

    +

    Examples::

    + +
    +
     (let ((string-stream (make-string-input-stream "1 one ")))
+   (list (read string-stream nil nil)
+         (read string-stream nil nil)
+         (read string-stream nil nil)))
+⇒  (1 ONE NIL)
+
+ (read (make-string-input-stream "prefixtargetsuffix" 6 12)) ⇒  TARGET
+
    + +

    See Also::

    + +

    with-input-from-string +

    + + + + + diff --git a/info/gcl/make_002dstring_002doutput_002dstream.html b/info/gcl/make_002dstring_002doutput_002dstream.html new file mode 100644 index 0000000..ac48501 --- /dev/null +++ b/info/gcl/make_002dstring_002doutput_002dstream.html @@ -0,0 +1,90 @@ + + + + + +make-string-output-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.50 make-string-output-stream [Function]

    + +

    make-string-output-stream &key element-type ⇒ string-stream +

    +

    Arguments and Values::

    + +

    element-type—a type specifier. + The default is character. +

    +

    string-stream—an output string stream. +

    +

    Description::

    + +

    Returns +

    +

    an output string stream that accepts characters +and makes available (via get-output-stream-string) +a string that contains the characters that were actually output. +

    +

    The element-type names the type of the elements +of the string; a string is constructed of the most specialized +type that can accommodate elements of that element-type. +

    +

    Examples::

    + +
    +
     (let ((s (make-string-output-stream)))
+   (write-string "testing... " s)
+   (prin1 1234 s)
+   (get-output-stream-string s))
+⇒  "testing... 1234"
+
    + +

    None.. +

    +

    See Also::

    + +

    get-output-stream-string +, +with-output-to-string +

    + + + + + diff --git a/info/gcl/make_002dsymbol.html b/info/gcl/make_002dsymbol.html new file mode 100644 index 0000000..d9180a2 --- /dev/null +++ b/info/gcl/make_002dsymbol.html @@ -0,0 +1,101 @@ + + + + + +make-symbol (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.5 make-symbol [Function]

    + +

    make-symbol name ⇒ new-symbol +

    +

    Arguments and Values::

    + +

    name—a string. +

    +

    new-symbol—a fresh, uninterned symbol. +

    +

    Description::

    + +

    make-symbol creates and returns a fresh, uninterned +symbol whose name is the given name. +The new-symbol is neither bound nor fbound +and has a null property list. +

    +

    It is implementation-dependent whether the string +that becomes the new-symbol’s name is the given +name or a copy of it. Once a string +has been given as the name argument to +make-symbol, the consequences are undefined if a +subsequent attempt is made to alter that string. +

    +

    Examples::

    + +
    +
     (setq temp-string "temp") ⇒  "temp"
+ (setq temp-symbol (make-symbol temp-string)) ⇒  #:|temp|
+ (symbol-name temp-symbol) ⇒  "temp"
+ (eq (symbol-name temp-symbol) temp-string) ⇒  implementation-dependent
+ (find-symbol "temp") ⇒  NIL, NIL
+ (eq (make-symbol temp-string) (make-symbol temp-string)) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if name is not a string. +

    +

    See Also::

    + +

    copy-symbol +

    +

    Notes::

    + +

    No attempt is made by make-symbol to convert the case +of the name to uppercase. The only case conversion which ever +occurs for symbols is done by the Lisp reader. +The program interface to symbol creation retains case, +and the program interface to interning symbols is case-sensitive. +

    + + + + + diff --git a/info/gcl/make_002dsynonym_002dstream.html b/info/gcl/make_002dsynonym_002dstream.html new file mode 100644 index 0000000..a68f906 --- /dev/null +++ b/info/gcl/make_002dsynonym_002dstream.html @@ -0,0 +1,87 @@ + + + + + +make-synonym-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.38 make-synonym-stream [Function]

    + +

    make-synonym-stream symbol ⇒ synonym-stream +

    +

    Arguments and Values::

    + +

    symbol—a symbol that names a dynamic variable. +

    +

    synonym-stream—a synonym stream. +

    +

    Description::

    + +

    Returns a synonym stream whose synonym stream symbol is symbol. +

    +

    Examples::

    + +
    +
     (setq a-stream (make-string-input-stream "a-stream")
+        b-stream (make-string-input-stream "b-stream"))
+⇒  #<String Input Stream> 
+ (setq s-stream (make-synonym-stream 'c-stream))
+⇒  #<SYNONYM-STREAM for C-STREAM> 
+ (setq c-stream a-stream)
+⇒  #<String Input Stream> 
+ (read s-stream) ⇒  A-STREAM
+ (setq c-stream b-stream)
+⇒  #<String Input Stream> 
+ (read s-stream) ⇒  B-STREAM
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if its argument is not a symbol. +

    +

    See Also::

    + +

    Stream Concepts +

    + + + + + diff --git a/info/gcl/make_002dtwo_002dway_002dstream.html b/info/gcl/make_002dtwo_002dway_002dstream.html new file mode 100644 index 0000000..a7fe97e --- /dev/null +++ b/info/gcl/make_002dtwo_002dway_002dstream.html @@ -0,0 +1,85 @@ + + + + + +make-two-way-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.42 make-two-way-stream [Function]

    + +

    make-two-way-stream input-stream output-stream ⇒ two-way-stream +

    +

    Arguments and Values::

    + +

    input-stream—a stream. +

    +

    output-stream—a stream. +

    +

    two-way-stream—a two-way stream. +

    +

    Description::

    + +

    Returns a two-way stream +that gets its input from input-stream +and sends its output to output-stream. +

    +

    Examples::

    + +
    +
     (with-output-to-string (out)
+    (with-input-from-string (in "input...")
+      (let ((two (make-two-way-stream in out)))
+        (format two "output...")
+        (setq what-is-read (read two))))) ⇒  "output..."
+ what-is-read ⇒  INPUT... 
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if input-stream is not an input stream. +Should signal an error of type type-error + if output-stream is not an output stream. +

    + + + + + diff --git a/info/gcl/makunbound.html b/info/gcl/makunbound.html new file mode 100644 index 0000000..703a564 --- /dev/null +++ b/info/gcl/makunbound.html @@ -0,0 +1,87 @@ + + + + + +makunbound (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.18 makunbound [Function]

    + +

    makunbound symbol ⇒ symbol +

    +

    Arguments and Values::

    + +

    symbol—a symbol +

    +

    Description::

    + +

    Makes the symbol be unbound, +regardless of whether it was previously bound. +

    +

    Examples::

    + +
    +
     (setf (symbol-value 'a) 1)
+ (boundp 'a) ⇒  true
+ a ⇒  1
+ (makunbound 'a) ⇒  A
+ (boundp 'a) ⇒  false
+
    + +

    Side Effects::

    + +

    The value cell of symbol is modified. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    See Also::

    + +

    boundp +, +fmakunbound +

    + + + + + diff --git a/info/gcl/map.html b/info/gcl/map.html new file mode 100644 index 0000000..84991ff --- /dev/null +++ b/info/gcl/map.html @@ -0,0 +1,141 @@ + + + + + +map (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.7 map [Function]

    + +

    map result-type function &rest sequences^+ ⇒ result +

    +

    Arguments and Values::

    + +

    result-type – a sequence type specifier, or nil. +

    +

    function—a function designator. + function must take as many arguments as + there are sequences. +

    +

    sequence—a proper sequence. +

    +

    result—if result-type is a type specifier other than nil, + then a sequence of the type it denotes; + otherwise (if the result-type is nil), nil. +

    +

    Description::

    + +

    Applies function to successive sets of arguments in which +one argument is obtained from each sequence. +The function is called first on all the elements with index 0, +then on all those with index 1, and so on. +The result-type specifies the type of the resulting sequence. +

    +

    map returns nil if result-type is nil. +Otherwise, map returns +a sequence such that element j is the result +of applying function to element j of each of the +sequences. The result sequence +is as long as the shortest of the +sequences. +The consequences are undefined if the result of applying function +to the successive elements of the sequences cannot +be contained in a sequence of the type given by result-type. +

    +

    If the result-type is a subtype of list, +the result will be a list. +

    +

    If the result-type is a subtype of vector, +then if the implementation can determine the element type specified +for the result-type, the element type of the resulting array +is the result of upgrading that element type; or, if the +implementation can determine that the element type is unspecified (or *), +the element type of the resulting array is t; +otherwise, an error is signaled. +

    +

    Examples::

    + +
    +
     (map 'string #'(lambda (x y)
+                  (char "01234567890ABCDEF" (mod (+ x y) 16)))
+       '(1 2 3 4)
+       '(10 9 8 7)) ⇒  "AAAA"
+ (setq seq '("lower" "UPPER" "" "123")) ⇒  ("lower" "UPPER" "" "123")
+ (map nil #'nstring-upcase seq) ⇒  NIL
+ seq ⇒  ("LOWER" "UPPER" "" "123")
+ (map 'list #'- '(1 2 3 4)) ⇒  (-1 -2 -3 -4)
+ (map 'string
+      #'(lambda (x) (if (oddp x) #\1 #\0))
+      '(1 2 3 4)) ⇒  "1010"
+
    + +
    +
     (map '(vector * 4) #'cons "abc" "de") should signal an error
+
    + +

    Exceptional Situations::

    + +

    An error of type type-error must be signaled if the result-type is + not a recognizable subtype of list, + not a recognizable subtype of vector, + and not nil. +

    +

    Should be prepared to signal an error of type type-error + if any sequence is not a proper sequence. +

    +

    An error of type type-error should be signaled +if result-type specifies the +number of elements and the minimum length of the sequences +is different from that number. +

    +

    See Also::

    + +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/map_002dinto.html b/info/gcl/map_002dinto.html new file mode 100644 index 0000000..75dc5a6 --- /dev/null +++ b/info/gcl/map_002dinto.html @@ -0,0 +1,133 @@ + + + + + +map-into (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.8 map-into [Function]

    + +

    map-into result-sequence function &rest sequences ⇒ result-sequence +

    +

    Arguments and Values::

    + +

    result-sequence—a proper sequence. +

    +

    function—a designator for a function + of as many arguments as there are sequences. +

    +

    sequence—a proper sequence. +

    +

    Description::

    + +

    Destructively modifies result-sequence to contain the results of +applying function to each element in the argument sequences +in turn. +

    +

    result-sequence and each element of sequences can each be +either a list or a vector. +If result-sequence and each element of sequences are not all +the same length, the iteration terminates when the shortest sequence +(of any of the sequences or the result-sequence) +is exhausted. +If result-sequence is a vector with a +fill pointer, the fill pointer is ignored when deciding how +many iterations to perform, and afterwards the fill pointer is set to +the number of times function was applied. +If result-sequence is longer than the shortest element of sequences, +extra elements at the end of result-sequence are left unchanged. +If result-sequence is nil, map-into immediately returns +nil, since nil is a sequence of length zero. +

    +

    If function has side effects, it can count on being called +first on all of the elements with index 0, then on all of those +numbered 1, and so on. +

    +

    Examples::

    + +
    +
     (setq a (list 1 2 3 4) b (list 10 10 10 10)) ⇒  (10 10 10 10)
+ (map-into a #'+ a b) ⇒  (11 12 13 14)
+ a ⇒  (11 12 13 14)
+ b ⇒  (10 10 10 10)
+ (setq k '(one two three)) ⇒  (ONE TWO THREE)
+ (map-into a #'cons k a) ⇒  ((ONE . 11) (TWO . 12) (THREE . 13) 14)
+ (map-into a #'gensym) ⇒  (#:G9090 #:G9091 #:G9092 #:G9093)
+ a ⇒  (#:G9090 #:G9091 #:G9092 #:G9093)
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if result-sequence is not a proper sequence. +Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    Notes::

    + +

    map-into differs from map in that it modifies an +existing sequence rather than creating a new one. +In addition, map-into can be called with only two +arguments, while map requires at least three arguments. +

    +

    map-into could be defined by: +

    +
    +
     (defun map-into (result-sequence function &rest sequences)
+   (loop for index below (apply #'min 
+                                (length result-sequence)
+                                (mapcar #'length sequences))
+         do (setf (elt result-sequence index)
+                  (apply function
+                         (mapcar #'(lambda (seq) (elt seq index))
+                                 sequences))))
+   result-sequence)
+
    + +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/mapc.html b/info/gcl/mapc.html new file mode 100644 index 0000000..25909d1 --- /dev/null +++ b/info/gcl/mapc.html @@ -0,0 +1,196 @@ + + + + + +mapc (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.34 mapc, mapcar, mapcan, mapl, maplist, mapcon [Function]

    + +

    mapc function &rest lists^+ ⇒ list-1 +

    +

    mapcar function &rest lists^+ ⇒ result-list +

    +

    mapcan function &rest lists^+ ⇒ concatenated-results +

    +

    mapl function &rest lists^+ ⇒ list-1 +

    +

    maplist function &rest lists^+ ⇒ result-list +

    +

    mapcon function &rest lists^+ ⇒ concatenated-results +

    +

    Arguments and Values::

    + +

    function—a designator for a function + that must take as many arguments as there are lists. +

    +

    list—a proper list. +

    +

    list-1—the first list (which must be a proper list). +

    +

    result-list—a list. +

    +

    concatenated-results—a list. +

    +

    Description::

    + +

    The mapping operation involves applying function to +successive sets of arguments in which +one argument is obtained from each sequence. +Except for mapc and mapl, +the result contains the results returned by function. +In the cases of mapc and mapl, +the resulting sequence is list. +

    +

    function is called +first on all the elements with index 0, then on all those +with index 1, and so on. +result-type specifies the type of +the +resulting sequence. +

    +

    If function is a symbol, it is coerced +to a function as if by symbol-function. +

    +

    mapcar operates on successive elements of the lists. +function is applied to the first element of each list, +then to the second element of each list, and so on. +The iteration terminates when the shortest list runs out, +and excess elements in other lists are ignored. +The value returned by mapcar is a list +of the results of successive calls to function. +

    +

    mapc is like mapcar except that the results of +applying function are not accumulated. +The list argument is returned. +

    +

    maplist is like mapcar except that +function is applied to successive sublists of the lists. +function +is first applied to the lists themselves, +and then to the cdr of each +list, and then to the cdr of the cdr +of each list, and so on. +

    +

    mapl is like maplist except that the results of +applying function are not accumulated; +list-1 is returned. +

    +

    mapcan and mapcon are like mapcar and +maplist respectively, except that the results of +applying function are combined +into a list by the use of nconc +rather than list. +That is, +

    +
    +
     (mapcon f x1 ... xn)
+   ≡ (apply #'nconc (maplist f x1 ... xn))
+
    + +

    and similarly for the relationship between mapcan +and mapcar. +

    +

    Examples::

    + +
    +
     (mapcar #'car '((1 a) (2 b) (3 c))) ⇒  (1 2 3) 
+ (mapcar #'abs '(3 -4 2 -5 -6)) ⇒  (3 4 2 5 6)
+ (mapcar #'cons '(a b c) '(1 2 3)) ⇒  ((A . 1) (B . 2) (C . 3))
+
+ (maplist #'append '(1 2 3 4) '(1 2) '(1 2 3)) 
+⇒  ((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3)) 
+ (maplist #'(lambda (x) (cons 'foo x)) '(a b c d))
+⇒  ((FOO A B C D) (FOO B C D) (FOO C D) (FOO D))
+ (maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1)) '(a b a c d b c))
+⇒  (0 0 1 0 1 1 1)
+;An entry is 1 if the corresponding element of the input
+;  list was the last instance of that element in the input list.
+
+ (setq dummy nil) ⇒  NIL 
+ (mapc #'(lambda (&rest x) (setq dummy (append dummy x)))
+        '(1 2 3 4)
+        '(a b c d e)
+        '(x y z)) ⇒  (1 2 3 4) 
+ dummy ⇒  (1 A X 2 B Y 3 C Z)                   
+
+ (setq dummy nil) ⇒  NIL 
+ (mapl #'(lambda (x) (push x dummy)) '(1 2 3 4)) ⇒  (1 2 3 4) 
+ dummy ⇒  ((4) (3 4) (2 3 4) (1 2 3 4)) 
+
+ (mapcan #'(lambda (x y) (if (null x) nil (list x y)))
+          '(nil nil nil d e)
+          '(1 2 3 4 5 6)) ⇒  (D 4 E 5) 
+ (mapcan #'(lambda (x) (and (numberp x) (list x)))
+          '(a 1 b c 3 4 d 5))
+⇒  (1 3 4 5)
+
    + +

    In this case the function serves as a filter; +this is a standard Lisp idiom using mapcan. +

    +
    +
     (mapcon #'list '(1 2 3 4)) ⇒  ((1 2 3 4) (2 3 4) (3 4) (4)) 
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if any list is not a proper list. +

    +

    See Also::

    + +

    dolist +, +map +, +

    +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/maphash.html b/info/gcl/maphash.html new file mode 100644 index 0000000..67a384d --- /dev/null +++ b/info/gcl/maphash.html @@ -0,0 +1,112 @@ + + + + + +maphash (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.11 maphash [Function]

    + +

    maphash function hash-table ⇒ nil +

    +

    Arguments and Values::

    + +

    function—a designator for a function of two arguments, + the key and the value. +

    +

    hash-table—a hash table. +

    +

    Description::

    + +

    Iterates over all entries in the hash-table. For each entry, +the function is called with two arguments–the key +and the value of that entry. +

    +

    The consequences are unspecified if any attempt is made to add or remove +an entry from the hash-table while a maphash is in progress, +with two exceptions: + the function can use can use setf of gethash + to change the value part of the entry currently being processed, +or it can use remhash to remove that entry. +

    +

    Examples::

    + +
    +
     (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32304110>
+ (dotimes (i 10) (setf (gethash i table) i)) ⇒  NIL
+ (let ((sum-of-squares 0))
+    (maphash #'(lambda (key val) 
+                 (let ((square (* val val)))
+                   (incf sum-of-squares square)
+                   (setf (gethash key table) square)))
+             table)
+    sum-of-squares) ⇒  285
+ (hash-table-count table) ⇒  10
+ (maphash #'(lambda (key val)
+               (when (oddp val) (remhash key table)))
+           table) ⇒  NIL
+ (hash-table-count table) ⇒  5
+ (maphash #'(lambda (k v) (print (list k v))) table)
+(0 0) 
+(8 64) 
+(2 4) 
+(6 36) 
+(4 16) 
+⇒  NIL
+
    + +

    Side Effects::

    + +

    None, other than any which might be done by the function. +

    +

    See Also::

    + +

    loop +, +with-hash-table-iterator +, +

    +

    Traversal Rules and Side Effects +

    + + + + + diff --git a/info/gcl/mask_002dfield.html b/info/gcl/mask_002dfield.html new file mode 100644 index 0000000..8866d8d --- /dev/null +++ b/info/gcl/mask_002dfield.html @@ -0,0 +1,101 @@ + + + + + +mask-field (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.71 mask-field [Accessor]

    + +

    mask-field bytespec integer ⇒ masked-integer +

    +

    (setf ( mask-field bytespec place) new-masked-integer)
    +

    +

    Arguments and Values::

    + +

    bytespec—a byte specifier. +

    +

    integer—an integer. +

    +

    masked-integer, new-masked-integer—a non-negative integer. +

    +

    Description::

    + +

    mask-field performs a “mask” operation on integer. +It returns an integer that has the same bits as integer in +the byte specified by bytespec, but that has zero-bits everywhere else. +

    +

    setf may be used with mask-field +to modify a byte within the integer that is stored +in a given place. +The effect is to perform a deposit-field operation +and then store the result back into the place. +

    +

    Examples::

    + +
    +
     (mask-field (byte 1 5) -1) ⇒  32
+ (setq a 15) ⇒  15
+ (mask-field (byte 2 0) a) ⇒  3
+ a ⇒  15
+ (setf (mask-field (byte 2 0) a) 1) ⇒  1
+ a ⇒  13
+
    + +

    See Also::

    + +

    byte +, +ldb +

    +

    Notes::

    + +
    +
     (ldb bs (mask-field bs n)) ≡ (ldb bs n)
+ (logbitp j (mask-field (byte s p) n))
+   ≡ (and (>= j p) (< j s) (logbitp j n))
+ (mask-field bs n) ≡ (logand n (dpb -1 bs 0))
+
    + + + + + + diff --git a/info/gcl/max.html b/info/gcl/max.html new file mode 100644 index 0000000..acbef78 --- /dev/null +++ b/info/gcl/max.html @@ -0,0 +1,131 @@ + + + + + +max (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.16 max, min [Function]

    + +

    max &rest reals^+ ⇒ max-real +

    +

    min &rest reals^+ ⇒ min-real +

    +

    Arguments and Values::

    + +

    real—a real. +

    +

    max-real, min-real—a real. +

    +

    Description::

    + +

    max returns the real that is greatest (closest to positive infinity). +min returns the real that is least (closest to negative infinity). +

    +

    For max, +the implementation has the choice of returning the largest +argument as is or applying the rules of floating-point contagion, +taking all the arguments into consideration for contagion purposes. +Also, if one or more of the arguments are =, then any one +of them may be chosen as the value to return. +For example, if the reals are a mixture of rationals and floats, +and the largest argument is a rational, +then the implementation is free to +produce either that rational +or its float approximation; +if the largest argument is a +float of a smaller format +than the largest format of any float argument, +then the implementation is free to +return the argument in its given format or expanded to the larger format. +Similar remarks apply to min +(replacing “largest argument” by “smallest argument”). +

    +

    Examples::

    + +
    +
     (max 3) ⇒  3 
+ (min 3) ⇒  3
+ (max 6 12) ⇒  12 
+ (min 6 12) ⇒  6
+ (max -6 -12) ⇒  -6 
+ (min -6 -12) ⇒  -12
+ (max 1 3 2 -7) ⇒  3 
+ (min 1 3 2 -7) ⇒  -7
+ (max -2 3 0 7) ⇒  7 
+ (min -2 3 0 7) ⇒  -2
+ (max 5.0 2) ⇒  5.0 
+ (min 5.0 2)
+⇒  2
+OR⇒ 2.0
+ (max 3.0 7 1)
+⇒  7
+OR⇒ 7.0 
+ (min 3.0 7 1)
+⇒  1
+OR⇒ 1.0
+ (max 1.0s0 7.0d0) ⇒  7.0d0
+ (min 1.0s0 7.0d0)
+⇒  1.0s0
+OR⇒ 1.0d0
+ (max 3 1 1.0s0 1.0d0)
+⇒  3
+OR⇒ 3.0d0
+ (min 3 1 1.0s0 1.0d0)
+⇒  1
+OR⇒ 1.0s0 
+OR⇒ 1.0d0
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if any number is not a real. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/member-_0028Function_0029.html b/info/gcl/member-_0028Function_0029.html new file mode 100644 index 0000000..a7c270a --- /dev/null +++ b/info/gcl/member-_0028Function_0029.html @@ -0,0 +1,145 @@ + + + + + +member (Function) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.33 member, member-if, member-if-not [Function]

    + +

    member item list &key key test test-not ⇒ tail +

    +

    member-if predicate list &key key ⇒ tail +

    +

    member-if-not predicate list &key key ⇒ tail +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    list—a proper list. +

    +

    predicate—a designator for + a function of one argument + that returns a generalized boolean. +

    +

    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. +

    +

    tail—a list. +

    +

    Description::

    + +

    member, member-if, and member-if-not each +search list for item or for a top-level element that +satisfies the test. The argument to the predicate function +is an element of list. +

    +

    If some element satisfies the test, +the tail of list beginning +with this element is returned; otherwise nil is returned. +

    +

    list is searched on the top level only. +

    +

    Examples::

    + +
    +
     (member 2 '(1 2 3)) ⇒  (2 3)                                 
+ (member 2 '((1 . 2) (3 . 4)) :test-not #'= :key #'cdr) ⇒  ((3 . 4))
+ (member 'e '(a b c d)) ⇒  NIL
+
    + +
    +
     (member-if #'listp '(a b nil c d)) ⇒  (NIL C D)
+ (member-if #'numberp '(a #\Space 5/3 foo)) ⇒  (5/3 FOO)
+ (member-if-not #'zerop 
+                 '(3 6 9 11 . 12)
+                 :key #'(lambda (x) (mod x 3))) ⇒  (11 . 12)
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list is not a proper list. +

    +

    See Also::

    + +

    find +, +position +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    The function member-if-not is deprecated. +

    +

    In the following +

    +
    +
     (member 'a '(g (a y) c a d e a f)) ⇒  (A D E A F)
+
    + +

    the value returned by member is identical to the portion +of the list beginning with a. Thus rplaca on the +result of member can be used to alter the part of the list +where a was found (assuming a check has been made that member +did not return nil). +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/member-_0028Type-Specifier_0029.html b/info/gcl/member-_0028Type-Specifier_0029.html new file mode 100644 index 0000000..45c544b --- /dev/null +++ b/info/gcl/member-_0028Type-Specifier_0029.html @@ -0,0 +1,80 @@ + + + + + +member (Type Specifier) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.18 member [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Combining. +

    +

    Compound Type Specifier Syntax::

    + +

    (member{{object}*}) +

    +

    Compound Type Specifier Arguments::

    + +

    object—an object. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set containing the named objects. An +object is of this type if and only if it is eql +to one of the specified objects. +

    +

    The type specifiers (member) and nil are equivalent. +* can be among the objects, +but if so it denotes itself (the symbol *) +and does not represent an unspecified value. +The symbol member is not valid as a type specifier; +and, specifically, it is not an abbreviation for either (member) or (member *). +

    +

    See Also::

    + +

    the type eql +

    + + + + + diff --git a/info/gcl/merge.html b/info/gcl/merge.html new file mode 100644 index 0000000..0455fe5 --- /dev/null +++ b/info/gcl/merge.html @@ -0,0 +1,172 @@ + + + + + +merge (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.21 merge [Function]

    + +

    merge result-type sequence-1 sequence-2 predicate &key key ⇒ result-sequence +

    +

    Arguments and Values::

    + +

    result-type—a sequence type specifier. +

    +

    sequence-1—a sequence. +

    +

    sequence-2—a sequence. +

    +

    predicate—a designator for + a function of two arguments that returns a generalized boolean. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    result-sequence—a proper sequence of type result-type. +

    +

    Description::

    + +

    Destructively merges sequence-1 with sequence-2 according +to an order determined by the predicate. merge determines +the relationship between two elements by giving keys extracted from the +sequence elements to the predicate. +

    +

    The first argument to the predicate function is an element of +sequence-1 as returned by the key (if supplied); +the second argument is an element of sequence-2 as returned by +the key (if supplied). +Predicate should return true if and only if its first +argument is strictly less than the second (in some appropriate sense). +If the first argument is greater than or equal to the second +(in the appropriate sense), then predicate should return false. +merge +considers two elements x and y to be equal if +(funcall predicate x y) and +(funcall predicate y x) both yield false. +

    +

    The argument to the key is the sequence element. +Typically, the return value of the key +becomes the argument to predicate. +If key is not supplied or nil, the sequence element itself is used. +The key may be executed more than once for each sequence element, +and its side effects may occur in any order. +

    +

    If key and predicate return, then the merging operation +will terminate. The result of merging two sequences x and y +is a new sequence of type result-type z, +such that the length of z is the sum of the lengths of x +and y, and z contains all the elements of x and y. +If x1 and x2 are two elements of x, and x1 precedes +x2 in x, then x1 precedes x2 in z, and similarly for +elements of y. In short, z is an interleaving of x and y. +

    +

    If x and y were correctly sorted according to the +predicate, then z will also be correctly sorted. +If x or y is not so sorted, then z will not be sorted, +but will nevertheless be an interleaving of x and y. +

    +

    The merging operation is guaranteed stable; +if two or more elements are considered equal by the predicate, +then the elements from sequence-1 will +precede those from sequence-2 in the result. +

    +

    sequence-1 and/or sequence-2 may be destroyed. +

    +

    If the result-type is a subtype of list, +the result will be a list. +

    +

    If the result-type is a subtype of vector, +then if the implementation can determine the element type specified +for the result-type, the element type of the resulting array +is the result of upgrading that element type; or, if the +implementation can determine that the element type is unspecified (or *), +the element type of the resulting array is t; +otherwise, an error is signaled. +

    +

    Examples::

    +
    +
     (setq test1 (list 1 3 4 6 7))
+ (setq test2 (list 2 5 8))
+ (merge 'list test1 test2 #'<) ⇒  (1 2 3 4 5 6 7 8)
+ (setq test1 (copy-seq "BOY"))
+ (setq test2 (copy-seq :nosy"))
+ (merge 'string test1 test2 #'char-lessp) ⇒  "BnOosYy"
+ (setq test1 (vector ((red . 1) (blue . 4))))
+ (setq test2 (vector ((yellow . 2) (green . 7))))
+ (merge 'vector test1 test2 #'< :key #'cdr) 
+⇒  #((RED . 1) (YELLOW . 2) (BLUE . 4) (GREEN . 7)) 
+
    + +
    +
     (merge '(vector * 4) '(1 5) '(2 4 6) #'<) should signal an error
+
    + +

    Exceptional Situations::

    + +

    An error must be signaled if the result-type is neither + a recognizable subtype of list, + nor a recognizable subtype of vector. +

    +

    An error of type type-error should be signaled +if result-type specifies the number of elements +and the sum of the lengths of sequence-1 and sequence-2 +is different from that number. +

    +

    See Also::

    + +

    sort +, +stable-sort, +

    +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/merge_002dpathnames.html b/info/gcl/merge_002dpathnames.html new file mode 100644 index 0000000..1aef2ad --- /dev/null +++ b/info/gcl/merge_002dpathnames.html @@ -0,0 +1,187 @@ + + + + + +merge-pathnames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.17 merge-pathnames [Function]

    + +

    merge-pathnames pathname &optional default-pathname default-version
    + ⇒ merged-pathname +

    +

    Arguments and Values::

    + +

    pathname—a pathname designator. +

    +

    default-pathname—a pathname designator. +

    +

    The default is the value of *default-pathname-defaults*. +

    +

    default-version—a valid pathname version. +

    +

    The default is :newest. +

    +

    merged-pathname—a pathname. +

    +

    Description::

    + +

    Constructs a pathname from pathname +by filling in any unsupplied components with the corresponding values +from default-pathname and default-version. +

    +

    Defaulting of pathname components +is done by filling in components taken from another pathname. +

    +

    This is especially useful for cases such as +a program that has an input file and an output file. +Unspecified components of the output pathname will come from the input pathname, +except that the type should not default +to the type of the input pathname +but rather to the appropriate default type for output from the program; +for example, see the function compile-file-pathname. +

    +

    If no version is supplied, default-version is used. +If default-version is nil, the version component will remain unchanged. +

    +

    If pathname explicitly specifies a host and not a device, and +if the host component of default-pathname matches the host component +of pathname, then the device is taken from the default-pathname; +otherwise the device will be the default file device for that host. If +pathname does not specify a host, device, directory, name, +or type, each such component is copied from default-pathname. +If pathname does not specify a name, then the version, if not provided, will +come from default-pathname, just like the other components. If +pathname does specify a name, then the version is not affected +by default-pathname. If this process leaves the +version missing, the default-version is used. +If the host’s file name syntax provides a way +to input a version without a name or type, the user can let the name +and type default but supply a version different from the one in default-pathname. +

    +

    If pathname is a stream, pathname effectively +becomes (pathname pathname). merge-pathnames +can be used on either an open or a closed stream. +

    +

    If pathname is a pathname +it represents the name used to open the file. This may be, but is +not required to be, the actual name of the file. +

    +

    merge-pathnames recognizes a logical pathname namestring + when default-pathname is a logical pathname, +

    +

    or when the namestring begins with + the name of a defined logical host followed by a colon. +In the first of these two cases, +

    +

    the host portion of the logical pathname namestring +and its following colon are optional. +

    +

    merge-pathnames returns a +logical pathname if and only if + its first argument is a logical pathname, +

    +

    or its first argument is a logical pathname namestring with an explicit host, +or its first argument does not specify a host + and the default-pathname is a logical pathname. +

    +

    Pathname merging treats a relative directory specially. +If (pathname-directory pathname) is a list whose +car is :relative, and +(pathname-directory default-pathname) is a list, then +the merged directory is the value of +

    +
    +
     (append (pathname-directory default-pathname)
+         (cdr  ;remove :relative from the front
+           (pathname-directory pathname)))
+
    + +

    except that if the resulting list contains a string or :wild +immediately followed by :back, both of them are removed. This removal of +redundant :back keywords is repeated as many times as possible. +If (pathname-directory default-pathname) is not a list or +(pathname-directory pathname) is not a list +whose car is :relative, the merged directory is +(or (pathname-directory pathname) (pathname-directory default-pathname)) +

    +

    merge-pathnames maps customary case in pathname +into customary case in the output pathname. +

    +

    Examples::

    +
    +
     (merge-pathnames "CMUC::FORMAT"
+                  "CMUC::PS:<LISPIO>.FASL")
+⇒  #P"CMUC::PS:<LISPIO>FORMAT.FASL.0"
+
    + +

    See Also::

    + +

    *default-pathname-defaults*, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    The net effect +is that if just a name is supplied, +the host, device, directory, and type will come from default-pathname, +but the version will come from default-version. +If nothing or just a directory is supplied, +the name, type, and version will come from default-pathname together. +

    + + + + + +
    +
    +

    +Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/method.html b/info/gcl/method.html new file mode 100644 index 0000000..f7fdd98 --- /dev/null +++ b/info/gcl/method.html @@ -0,0 +1,79 @@ + + + + + +method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.11 method [System Class]

    + +

    Class Precedence List::

    +

    method, +t +

    +

    Description::

    + +

    A method is an object that represents a modular part of the behavior +of a generic function. +

    +

    A method contains code to implement the method’s +behavior, a sequence of parameter specializers that specify when the +given method is applicable, and a sequence of qualifiers +that is used by the method combination facility to distinguish among +methods. Each required parameter of each +method has an associated parameter specializer, and the +method will be invoked only on arguments that satisfy its +parameter specializers. +

    +

    The method combination facility controls the selection of +methods, the order in which they are run, and the values that are +returned by the generic function. The object system offers a default method +combination type and provides a facility for declaring new types of +method combination. +

    +

    See Also::

    + +

    Generic Functions and Methods +

    + + + + + diff --git a/info/gcl/method_002dcombination.html b/info/gcl/method_002dcombination.html new file mode 100644 index 0000000..d16b7ec --- /dev/null +++ b/info/gcl/method_002dcombination.html @@ -0,0 +1,65 @@ + + + + + +method-combination (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.15 method-combination [System Class]

    + +

    Class Precedence List::

    +

    method-combination, +t +

    +

    Description::

    + +

    Every method combination object is an +indirect instance of the class method-combination. +A method combination object represents the information about +the method combination being used by a generic function. +A method combination object contains information about +both the type of method combination and the arguments being used +with that type. +

    + + + + + diff --git a/info/gcl/method_002dcombination_002derror.html b/info/gcl/method_002dcombination_002derror.html new file mode 100644 index 0000000..aec54b6 --- /dev/null +++ b/info/gcl/method_002dcombination_002derror.html @@ -0,0 +1,85 @@ + + + + + +method-combination-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.16 method-combination-error [Function]

    + +

    method-combination-error format-control &rest args ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    format-control—a format control. +

    +

    args—format arguments for format-control. +

    +

    Description::

    + +

    The function method-combination-error is used to signal an error +in method combination. +

    +

    The error message is constructed by using a format-control suitable +for format and any args to it. Because an implementation may +need to add additional contextual information to the error message, +method-combination-error should be called only within the +dynamic extent of a method combination function. +

    +

    Whether method-combination-error returns to its caller or exits +via throw is implementation-dependent. +

    +

    Side Effects::

    + +

    The debugger might be entered. +

    +

    Affected By::

    + +

    *break-on-signals* +

    +

    See Also::

    + +

    define-method-combination +

    + + + + + diff --git a/info/gcl/method_002dqualifiers.html b/info/gcl/method_002dqualifiers.html new file mode 100644 index 0000000..88270bb --- /dev/null +++ b/info/gcl/method_002dqualifiers.html @@ -0,0 +1,81 @@ + + + + + +method-qualifiers (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.15 method-qualifiers [Standard Generic Function]

    + +

    Syntax::

    + +

    method-qualifiers method ⇒ qualifiers +

    +

    Method Signatures::

    + +

    method-qualifiers (method standard-method) +

    +

    Arguments and Values::

    + +

    method—a method. +

    +

    qualifiers—a proper list. +

    +

    Description::

    + +

    Returns a list of the qualifiers of the method. +

    +

    Examples::

    + +
    +
     (defmethod some-gf :before ((a integer)) a)
+⇒  #<STANDARD-METHOD SOME-GF (:BEFORE) (INTEGER) 42736540>
+ (method-qualifiers *) ⇒  (:BEFORE)
+
    + +

    See Also::

    + +

    define-method-combination +

    + + + + + diff --git a/info/gcl/minusp.html b/info/gcl/minusp.html new file mode 100644 index 0000000..b579880 --- /dev/null +++ b/info/gcl/minusp.html @@ -0,0 +1,85 @@ + + + + + +minusp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.17 minusp, plusp [Function]

    + +

    minusp real ⇒ generalized-boolean +

    +

    plusp real ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    real—a real. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    minusp returns true if real is less than zero; +otherwise, returns false. +

    +

    plusp returns true if real is greater than zero; +otherwise, returns false. +

    +

    Regardless of whether an implementation provides distinct +representations for positive and negative float zeros, +(minusp -0.0) always returns false. +

    +

    Examples::

    +
    +
     (minusp -1) ⇒  true
+ (plusp 0) ⇒  false
+ (plusp least-positive-single-float) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if real is not a real. +

    + + + + + diff --git a/info/gcl/mismatch.html b/info/gcl/mismatch.html new file mode 100644 index 0000000..c62228a --- /dev/null +++ b/info/gcl/mismatch.html @@ -0,0 +1,130 @@ + + + + + +mismatch (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.17 mismatch [Function]

    + +

    mismatch sequence-1 sequence-2 + &key from-end test test-not key start1 start2 end1 end2
    + ⇒ position +

    +

    Arguments and Values::

    + +

    Sequence-1—a sequence. +

    +

    Sequence-2—a sequence. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start1, end1—bounding index designators of sequence-1. + The defaults for start1 and end1 are 0 and nil, respectively. +

    +

    start2, end2—bounding index designators of sequence-2. + The defaults for start2 and end2 are 0 and nil, respectively. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    position—a bounding index of sequence-1, + or nil. +

    +

    Description::

    + +

    The specified subsequences of +sequence-1 and sequence-2 are compared element-wise. +

    +

    The key argument is used for both the sequence-1 and the sequence-2. +

    +

    If sequence-1 and sequence-2 +are of equal length and match in every element, the result is +false. Otherwise, the result is a non-negative integer, +the index within +sequence-1 of the leftmost or rightmost position, depending +on from-end, at which the two +subsequences fail to match. +If one subsequence +is shorter than and a matching prefix of the other, +the result is the index +relative to sequence-1 beyond the last position tested. +

    +

    If from-end is true, then one plus the index of the rightmost +position in which the sequences +differ is returned. In effect, the subsequences +are aligned at their right-hand ends; then, the last elements are compared, +the penultimate elements, and so on. The index returned is +an index relative to sequence-1. +

    +

    Examples::

    +
    +
     (mismatch "abcd" "ABCDE" :test #'char-equal) ⇒  4
+ (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) ⇒  3
+ (mismatch '(1 2 3) '(2 3 4) :test-not #'eq :key #'oddp) ⇒  NIL
+ (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4) ⇒  NIL 
+
    + +

    See Also::

    + +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/mod-_0028Function_0029.html b/info/gcl/mod-_0028Function_0029.html new file mode 100644 index 0000000..03d15ad --- /dev/null +++ b/info/gcl/mod-_0028Function_0029.html @@ -0,0 +1,111 @@ + + + + + +mod (Function) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.36 mod, rem [Function]

    + +

    mod number divisor ⇒ modulus +

    +

    rem number divisor ⇒ remainder +

    +

    Arguments and Values::

    + +

    number—a real. +

    +

    divisor—a real. +

    +

    modulus, remainder—a real. +

    +

    Description::

    + +

    mod and rem are generalizations of the modulus +and remainder functions respectively. +

    +

    mod performs the operation floor +on number and divisor +and returns the remainder of the floor operation. +

    +

    rem performs the operation truncate +on number and divisor +and returns the remainder of the truncate operation. +

    +

    mod and rem are +the modulus and remainder functions +when number and divisor are integers. +

    +

    Examples::

    +
    +
     (rem -1 5) ⇒  -1
+ (mod -1 5) ⇒  4
+ (mod 13 4) ⇒  1
+ (rem 13 4) ⇒  1
+ (mod -13 4) ⇒  3
+ (rem -13 4) ⇒  -1
+ (mod 13 -4) ⇒  -3
+ (rem 13 -4) ⇒  1
+ (mod -13 -4) ⇒  -1
+ (rem -13 -4) ⇒  -1
+ (mod 13.4 1) ⇒  0.4
+ (rem 13.4 1) ⇒  0.4
+ (mod -13.4 1) ⇒  0.6
+ (rem -13.4 1) ⇒  -0.4
+
    + +

    See Also::

    + +

    floor +, truncate +

    +

    Notes::

    + +

    The result of mod is either zero or a +

    +

    real +

    +

    with the same sign as divisor. +

    + + + + + diff --git a/info/gcl/mod-_0028System-Class_0029.html b/info/gcl/mod-_0028System-Class_0029.html new file mode 100644 index 0000000..14543e8 --- /dev/null +++ b/info/gcl/mod-_0028System-Class_0029.html @@ -0,0 +1,76 @@ + + + + + +mod (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.11 mod [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (mod{n}) +

    +

    Compound Type Specifier Arguments::

    + +

    n—a positive integer. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of non-negative integers less than n. +This is equivalent to + (integer 0 (n)) +or to + (integer 0 m), +where m=n-1. +

    +

    The argument is required, and cannot be *. +

    +

    The symbol mod is not valid as a type specifier. +

    + + + + + diff --git a/info/gcl/most_002dpositive_002dfixnum.html b/info/gcl/most_002dpositive_002dfixnum.html new file mode 100644 index 0000000..ffae51c --- /dev/null +++ b/info/gcl/most_002dpositive_002dfixnum.html @@ -0,0 +1,68 @@ + + + + + +most-positive-fixnum (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.72 most-positive-fixnum, most-negative-fixnum [Constant Variable]

    + +

    Constant Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    most-positive-fixnum is that fixnum closest in value +to positive infinity provided by the implementation, +

    +

    and greater than or equal to both 2^15 - 1 and +array-dimension-limit. +

    +

    most-negative-fixnum is that fixnum closest in value +to negative infinity provided by the implementation, +

    +

    and less than or equal to -2^15. +

    + + + + + diff --git a/info/gcl/most_002dpositive_002dshort_002dfloat.html b/info/gcl/most_002dpositive_002dshort_002dfloat.html new file mode 100644 index 0000000..b8188b3 --- /dev/null +++ b/info/gcl/most_002dpositive_002dshort_002dfloat.html @@ -0,0 +1,159 @@ + + + + + +most-positive-short-float (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.76 most-positive-short-float, least-positive-short-float,

    +

    least-positive-normalized-short-float,

    +

    most-positive-double-float, least-positive-double-float,

    +

    least-positive-normalized-double-float,

    +

    most-positive-long-float, least-positive-long-float,

    +

    least-positive-normalized-long-float,

    +

    most-positive-single-float, least-positive-single-float,

    +

    least-positive-normalized-single-float,

    +

    most-negative-short-float, least-negative-short-float,

    +

    least-negative-normalized-short-float,

    +

    most-negative-single-float, least-negative-single-float,

    +

    least-negative-normalized-single-float,

    +

    most-negative-double-float, least-negative-double-float,

    +

    least-negative-normalized-double-float,

    +

    most-negative-long-float, least-negative-long-float,

    +

    least-negative-normalized-long-float

    +

    [Constant Variable] +

    +

    Constant Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    These constant variables provide a way for programs to examine +the implementation-defined limits for the various float formats. +

    +

    Of these variables, + each which has “-normalized” in its name + must have a value which is a normalized float, and + each which does not have “-normalized” in its name + may have a value which is either a normalized float + or a denormalized float, as appropriate. +

    +

    Of these variables, + each which has “short-float” in its name + must have a value which is a short float, + each which has “single-float” in its name + must have a value which is a single float, + each which has “double-float” in its name + must have a value which is a double float, and + each which has “long-float” in its name + must have a value which is a long float. +

    +
    +
    *
    +

    most-positive-short-float, + most-positive-single-float, + most-positive-double-float, + most-positive-long-float +

    +

    Each of these constant variables has as its value + the positive float of the largest magnitude + (closest in value to, but not equal to, positive infinity) + for the float format implied by its name. +

    +
    +
    *
    +

    least-positive-short-float, + least-positive-normalized-short-float, + least-positive-single-float, + least-positive-normalized-single-float, + least-positive-double-float, + least-positive-normalized-double-float, + least-positive-long-float, + least-positive-normalized-long-float +

    +

    Each of these constant variables has as its value + the smallest positive (nonzero) float + for the float format implied by its name. +

    +
    +
    *
    +

    least-negative-short-float, + least-negative-normalized-short-float, + least-negative-single-float, + least-negative-normalized-single-float, + least-negative-double-float, + least-negative-normalized-double-float, + least-negative-long-float, + least-negative-normalized-long-float +

    +

    Each of these constant variables has as its value + the negative (nonzero) float of the smallest magnitude + for the float format implied by its name. + (If an implementation supports minus zero as a different + object from positive zero, this value must not be minus zero.) +

    +
    +
    *
    +

    most-negative-short-float, + most-negative-single-float, + most-negative-double-float, + most-negative-long-float +

    +

    Each of these constant variables has as its value + the negative float of the largest magnitude + (closest in value to, but not equal to, negative infinity) + for the float format implied by its name. +

    +
    +
    + +

    Notes::

    + +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/muffle_002dwarning.html b/info/gcl/muffle_002dwarning.html new file mode 100644 index 0000000..792942a --- /dev/null +++ b/info/gcl/muffle_002dwarning.html @@ -0,0 +1,104 @@ + + + + + +muffle-warning (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.43 muffle-warning [Restart]

    + +

    Data Arguments Required::

    + +

    None. +

    +

    Description::

    + +

    This restart is established by warn so that handlers +of warning conditions have a way to tell warn +that a warning has already been dealt with and that no further action is warranted. +

    +

    Examples::

    + +
    +
     (defvar *all-quiet* nil) ⇒  *ALL-QUIET*
+ (defvar *saved-warnings* '()) ⇒  *SAVED-WARNINGS*
+ (defun quiet-warning-handler (c)
+   (when *all-quiet*
+     (let ((r (find-restart 'muffle-warning c)))
+       (when r 
+         (push c *saved-warnings*)
+         (invoke-restart r)))))
+⇒  CUSTOM-WARNING-HANDLER
+ (defmacro with-quiet-warnings (&body forms)
+   `(let ((*all-quiet* t)
+          (*saved-warnings* '()))
+      (handler-bind ((warning #'quiet-warning-handler))
+        ,@forms
+        *saved-warnings*)))
+⇒  WITH-QUIET-WARNINGS
+ (setq saved
+   (with-quiet-warnings
+     (warn "Situation #1.")
+     (let ((*all-quiet* nil))
+       (warn "Situation #2."))
+     (warn "Situation #3.")))
+ |>  Warning: Situation #2.
+⇒  (#<SIMPLE-WARNING 42744421> #<SIMPLE-WARNING 42744365>)
+ (dolist (s saved) (format t "~&~A~
+ |>  Situation #3.
+ |>  Situation #1.
+⇒  NIL
+
    + +

    See Also::

    + +

    Restarts, +Interfaces to Restarts, +invoke-restart +, +muffle-warning + (function), +warn +

    + + + + + diff --git a/info/gcl/multiple_002dvalue_002dbind.html b/info/gcl/multiple_002dvalue_002dbind.html new file mode 100644 index 0000000..d93a08c --- /dev/null +++ b/info/gcl/multiple_002dvalue_002dbind.html @@ -0,0 +1,116 @@ + + + + + +multiple-value-bind (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.48 multiple-value-bind [Macro]

    + +

    multiple-value-bind ({var}*) + values-form + {declaration}* + {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a symbol naming a variable; not evaluated. +

    +

    values-form—a form; evaluated. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    Creates new variable bindings for the vars and +executes a series of forms that use these bindings. +

    +

    The variable bindings created are lexical unless +special declarations are specified. +

    +

    Values-form is evaluated, and each of the vars is +bound to the respective value returned by that form. If there are more +vars than values returned, extra values of nil are given to the +remaining vars. If there are more values than +vars, the excess +values are discarded. The vars are bound to the values over +the execution of the forms, which make up an implicit progn. +The consequences are unspecified if a type declaration is specified +for a var, but the value to which +that var is bound is not consistent with +the type declaration. +

    +

    The scopes of the name binding and declarations +do not include the values-form. +

    +

    Examples::

    + +
    +
     (multiple-value-bind (f r) 
+     (floor 130 11)
+   (list f r)) ⇒  (11 9)
+
    + +

    See Also::

    + +

    let +, +multiple-value-call +

    +

    Notes::

    + +
    +
     (multiple-value-bind ({var}*) values-form {form}*)
+ ≡ (multiple-value-call #'(lambda (&optional {var}* &rest #1=#:ignore)
+                             (declare (ignore #1#))
+                             {form}*)
+                         values-form)
+
    + + + + + + diff --git a/info/gcl/multiple_002dvalue_002dcall.html b/info/gcl/multiple_002dvalue_002dcall.html new file mode 100644 index 0000000..b8e40dc --- /dev/null +++ b/info/gcl/multiple_002dvalue_002dcall.html @@ -0,0 +1,91 @@ + + + + + +multiple-value-call (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.49 multiple-value-call [Special Operator]

    + +

    multiple-value-call function-form form* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    function-form—a form; evaluated to produce function. +

    +

    function—a function designator + resulting from the evaluation of function-form. +

    +

    form—a form. +

    +

    results—the values returned by the function. +

    +

    Description::

    + +

    Applies function to a list of the objects collected from groups of +multiple values_2. +

    +

    multiple-value-call first evaluates the function-form +to obtain function, and then evaluates each form. +All the values +of each form are gathered together (not just one value from each) +and given as arguments to the function. +

    +

    Examples::

    +
    +
     (multiple-value-call #'list 1 '/ (values 2 3) '/ (values) '/ (floor 2.5))
+⇒  (1 / 2 3 / / 2 0.5)
+ (+ (floor 5 3) (floor 19 4)) ≡ (+ 1 4)
+⇒  5
+ (multiple-value-call #'+ (floor 5 3) (floor 19 4)) ≡ (+ 1 2 4 3)
+⇒  10
+
    + +

    See Also::

    + +

    multiple-value-list +, +multiple-value-bind +

    + + + + + diff --git a/info/gcl/multiple_002dvalue_002dlist.html b/info/gcl/multiple_002dvalue_002dlist.html new file mode 100644 index 0000000..b12a45c --- /dev/null +++ b/info/gcl/multiple_002dvalue_002dlist.html @@ -0,0 +1,85 @@ + + + + + +multiple-value-list (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.50 multiple-value-list [Macro]

    + +

    multiple-value-list form ⇒ list +

    +

    Arguments and Values::

    + +

    form—a form; evaluated as described below. +

    +

    list—a list of the values returned by form. +

    +

    Description::

    + +

    multiple-value-list evaluates form +and creates a list of the multiple values_2 it returns. +

    +

    Examples::

    + +
    +
     (multiple-value-list (floor -3 4)) ⇒  (-1 1)
+
    + +

    See Also::

    + +

    values-list +, +multiple-value-call +

    +

    Notes::

    + +

    multiple-value-list and values-list are inverses +of each other. +

    +
    +
     (multiple-value-list form) ≡ (multiple-value-call #'list form)
+
    + + + + + + diff --git a/info/gcl/multiple_002dvalue_002dprog1.html b/info/gcl/multiple_002dvalue_002dprog1.html new file mode 100644 index 0000000..f202a8d --- /dev/null +++ b/info/gcl/multiple_002dvalue_002dprog1.html @@ -0,0 +1,84 @@ + + + + + +multiple-value-prog1 (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.51 multiple-value-prog1 [Special Operator]

    + +

    multiple-value-prog 1 ⇒ first-form {form}* +

    +

    first-form-results +

    +

    Arguments and Values::

    + +

    first-form—a form; evaluated as described below. +

    +

    form—a form; evaluated as described below. +

    +

    first-form-results—the values resulting from + the evaluation of first-form. +

    +

    Description::

    + +

    multiple-value-prog1 evaluates first-form and saves +all the values produced by that form. It then evaluates each +form from left to right, discarding their values. +

    +

    Examples::

    + +
    +
     (setq temp '(1 2 3)) ⇒  (1 2 3)
+ (multiple-value-prog1
+    (values-list temp)
+    (setq temp nil)
+    (values-list temp)) ⇒  1, 2, 3
+
    + +

    See Also::

    + +

    prog1 +

    + + + + + diff --git a/info/gcl/multiple_002dvalue_002dsetq.html b/info/gcl/multiple_002dvalue_002dsetq.html new file mode 100644 index 0000000..25f9516 --- /dev/null +++ b/info/gcl/multiple_002dvalue_002dsetq.html @@ -0,0 +1,117 @@ + + + + + +multiple-value-setq (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.52 multiple-value-setq [Macro]

    + +

    multiple-value-setq vars form ⇒ result +

    +

    Arguments and Values::

    + +

    vars—a list of symbols + that are either variable names + or names of symbol macros. +

    +

    form—a form. +

    +

    result—The primary value returned by the form. +

    +

    Description::

    + +

    multiple-value-setq assigns values to vars. +

    +

    The form is evaluated, +and each var is assigned +to the corresponding value returned by that form. +If there are more vars than values returned, +nil is assigned to the extra vars. +If there are more values than vars, +the extra values are discarded. +

    +

    If any var is the name of a symbol macro, +then it is assigned as if by setf. Specifically, +

    +
    +
     (multiple-value-setq (symbol_1 ... symbol_n) value-producing-form)
+
    + +

    is defined to always behave in the same way as +

    +
    +
     (values (setf (values symbol_1 ... symbol_n) value-producing-form))
+
    + +

    in order that the rules for order of evaluation and side-effects be consistent +with those used by setf. + +

    + + +

    See VALUES Forms as Places. +

    +

    Examples::

    + +
    +
     (multiple-value-setq (quotient remainder) (truncate 3.2 2)) ⇒  1
+ quotient ⇒  1
+ remainder ⇒  1.2
+ (multiple-value-setq (a b c) (values 1 2)) ⇒  1
+ a ⇒  1
+ b ⇒  2
+ c ⇒  NIL
+ (multiple-value-setq (a b) (values 4 5 6)) ⇒  4
+ a ⇒  4
+ b ⇒  5
+
    + +

    See Also::

    + +

    setq +, +symbol-macrolet +

    + + + + + diff --git a/info/gcl/multiple_002dvalues_002dlimit.html b/info/gcl/multiple_002dvalues_002dlimit.html new file mode 100644 index 0000000..26d4030 --- /dev/null +++ b/info/gcl/multiple_002dvalues_002dlimit.html @@ -0,0 +1,75 @@ + + + + + +multiple-values-limit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.55 multiple-values-limit [Constant Variable]

    + +

    Constant Value::

    + +

    An integer not smaller than 20, +the exact magnitude of which is implementation-dependent. +

    +

    Description::

    + +

    The upper exclusive bound on the number of values that may be + returned from a function, +

    +

    bound or assigned by multiple-value-bind or multiple-value-setq, + or passed as a first argument to nth-value. +(If these individual limits might differ, the minimum value is used.) +

    +

    See Also::

    + +

    lambda-parameters-limit +, +call-arguments-limit +

    +

    Notes::

    + +

    Implementors are encouraged to make this limit as large as possible. +

    + + + + + diff --git a/info/gcl/name_002dchar.html b/info/gcl/name_002dchar.html new file mode 100644 index 0000000..86895e3 --- /dev/null +++ b/info/gcl/name_002dchar.html @@ -0,0 +1,89 @@ + + + + + +name-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.21 name-char [Function]

    + +

    name-char name ⇒ char-p +

    +

    Arguments and Values::

    + +

    name—a string designator. +

    +

    char-p—a character or nil. +

    +

    Description::

    + +

    Returns the character object whose name is +name (as determined by string-equal—i.e., lookup is not case sensitive). +If such a character does not exist, nil is returned. +

    +

    Examples::

    + +
    +
    (name-char 'space) ⇒  #\Space
+(name-char "space") ⇒  #\Space
+(name-char "Space") ⇒  #\Space
+(let ((x (char-name #\a)))
+  (or (not x) (eql (name-char x) #\a))) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if name is not a string designator. +

    +

    See Also::

    + +

    char-name +

    + + + + + + + + + + diff --git a/info/gcl/namestring.html b/info/gcl/namestring.html new file mode 100644 index 0000000..e900c4a --- /dev/null +++ b/info/gcl/namestring.html @@ -0,0 +1,168 @@ + + + + + +namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.11 namestring, file-namestring, directory-namestring,

    +

    host-namestring, enough-namestring

    +

    [Function] +

    +

    namestring pathname ⇒ namestring +

    +

    file-namestring pathname ⇒ namestring +

    +

    directory-namestring pathname ⇒ namestring +

    +

    host-namestring pathname ⇒ namestring +

    +

    enough-namestring pathname &optional defaults ⇒ namestring +

    +

    Arguments and Values::

    + +

    pathname—a pathname designator. +

    +

    defaults—a pathname designator. +

    +

    The default is the value of *default-pathname-defaults*. +

    +

    namestring—a string or nil. +

    +

    [Editorial Note by KMP: Under what circumstances can NIL be returned??] +

    +

    Description::

    + +

    These functions convert pathname into a namestring. +The name represented by pathname is returned as a namestring +in an implementation-dependent canonical form. +

    +

    namestring returns the full form of pathname. +

    +

    file-namestring returns just the name, type, and version + components of pathname. +

    +

    directory-namestring returns the directory name portion. +

    +

    host-namestring returns the host name. +

    +

    enough-namestring returns an abbreviated namestring + that is just sufficient to identify the file named by pathname + when considered relative to the defaults. + It is required that +

    +
    +
     (merge-pathnames (enough-namestring pathname defaults) defaults)
+≡ (merge-pathnames (parse-namestring pathname nil defaults) defaults)
+
    + +

    in all cases, and the result of enough-namestring is +the shortest reasonable string that will satisfy this criterion. +

    +

    It is not necessarily possible to construct a valid namestring +by concatenating some of the three shorter namestrings in some order. +

    +

    Examples::

    + +
    +
     (namestring "getty")            
+⇒  "getty"
+ (setq q (make-pathname :host "kathy" 
+                         :directory 
+                           (pathname-directory *default-pathname-defaults*)
+                         :name "getty")) 
+⇒  #S(PATHNAME :HOST "kathy" :DEVICE NIL :DIRECTORY directory-name 
+       :NAME "getty" :TYPE NIL :VERSION NIL)
+ (file-namestring q) ⇒  "getty"
+ (directory-namestring q) ⇒  directory-name
+ (host-namestring q) ⇒  "kathy" 
+
    + +
    +
     ;;;Using Unix syntax and the wildcard conventions used by the
+ ;;;particular version of Unix on which this example was created:
+ (namestring
+   (translate-pathname "/usr/dmr/hacks/frob.l"
+                       "/usr/d*/hacks/*.l"
+                       "/usr/d*/backup/hacks/backup-*.*"))
+⇒  "/usr/dmr/backup/hacks/backup-frob.l"
+ (namestring
+   (translate-pathname "/usr/dmr/hacks/frob.l"
+                       "/usr/d*/hacks/fr*.l"
+                       "/usr/d*/backup/hacks/backup-*.*"))
+⇒  "/usr/dmr/backup/hacks/backup-ob.l"
+
+ ;;;This is similar to the above example but uses two different hosts,
+ ;;;U: which is a Unix and V: which is a VMS.  Note the translation
+ ;;;of file type and alphabetic case conventions.
+ (namestring
+   (translate-pathname "U:/usr/dmr/hacks/frob.l"
+                       "U:/usr/d*/hacks/*.l"
+                       "V:SYS$DISK:[D*.BACKUP.HACKS]BACKUP-*.*"))
+⇒  "V:SYS$DISK:[DMR.BACKUP.HACKS]BACKUP-FROB.LSP"
+ (namestring
+   (translate-pathname "U:/usr/dmr/hacks/frob.l"
+                       "U:/usr/d*/hacks/fr*.l"
+                       "V:SYS$DISK:[D*.BACKUP.HACKS]BACKUP-*.*"))
+⇒  "V:SYS$DISK:[DMR.BACKUP.HACKS]BACKUP-OB.LSP"
+
    + +

    See Also::

    + +

    truename +, +merge-pathnames +, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/nconc.html b/info/gcl/nconc.html new file mode 100644 index 0000000..53865dd --- /dev/null +++ b/info/gcl/nconc.html @@ -0,0 +1,129 @@ + + + + + +nconc (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.25 nconc [Function]

    + +

    nconc &rest lists ⇒ concatenated-list +

    +

    Arguments and Values::

    + +

    list—each but the last must be a list + (which might be a dotted list but must not be a circular list); + the last list may be any object. +

    +

    concatenated-list—a list. +

    +

    Description::

    + +

    Returns a list that is the concatenation of lists. +If no lists are supplied, (nconc) returns nil. +

    +

    nconc is defined using the following recursive relationship: +

    +
    +
     (nconc) ⇒  ()
+ (nconc nil . lists) ≡ (nconc . lists)
+ (nconc list) ⇒  list
+ (nconc list-1 list-2) ≡ (progn (rplacd (last list-1) list-2) list-1)
+ (nconc list-1 list-2 . lists) ≡ (nconc (nconc list-1 list-2) . lists)
+
    + +

    Examples::

    + +
    +
     (nconc) ⇒  NIL
+ (setq x '(a b c)) ⇒  (A B C)
+ (setq y '(d e f)) ⇒  (D E F)
+ (nconc x y) ⇒  (A B C D E F)
+ x ⇒  (A B C D E F)
+
    + +

    Note, in the example, that the value of x is now different, +since its last cons +has been rplacd’d to the value of y. +If (nconc x y) were evaluated again, +it would yield a piece of a circular list, +whose printed representation would be +(A B C D E F D E F D E F ...), repeating forever; +if the *print-circle* switch were non-nil, +it would be printed as (A B C . #1=(D E F . #1#)). +

    +
    +
     (setq foo (list 'a 'b 'c 'd 'e)
+       bar (list 'f 'g 'h 'i 'j)
+       baz (list 'k 'l 'm)) ⇒  (K L M)
+ (setq foo (nconc foo bar baz)) ⇒  (A B C D E F G H I J K L M)
+ foo ⇒  (A B C D E F G H I J K L M)
+ bar ⇒  (F G H I J K L M)
+ baz ⇒  (K L M)
+
+ (setq foo (list 'a 'b 'c 'd 'e)
+       bar (list 'f 'g 'h 'i 'j)
+       baz (list 'k 'l 'm)) ⇒  (K L M)
+ (setq foo (nconc nil foo bar nil baz)) ⇒  (A B C D E F G H I J K L M) 
+ foo ⇒  (A B C D E F G H I J K L M)
+ bar ⇒  (F G H I J K L M)
+ baz ⇒  (K L M)
+
    + +

    Side Effects::

    + +

    The lists are modified rather than copied. +

    +

    See Also::

    + +

    append +, +concatenate +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/next_002dmethod_002dp.html b/info/gcl/next_002dmethod_002dp.html new file mode 100644 index 0000000..eb1c785 --- /dev/null +++ b/info/gcl/next_002dmethod_002dp.html @@ -0,0 +1,86 @@ + + + + + +next-method-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.29 next-method-p [Local Function]

    + +

    Syntax::

    + +

    next-method-p <no arguments> ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    The locally defined function next-method-p can be used +

    +

    within the body forms (but not the lambda list) +

    +

    defined by a method-defining form to determine +whether a next method exists. +

    +

    The function next-method-p has lexical scope and indefinite extent. +

    +

    Whether or not next-method-p is fbound in the +global environment is implementation-dependent; +however, the restrictions on redefinition and shadowing of +next-method-p are the same as for symbols in the COMMON-LISP package +which are fbound in the global environment. +The consequences of attempting to use next-method-p outside +of a method-defining form are undefined. +

    +

    See Also::

    + +

    call-next-method +, +defmethod +, +call-method +

    + + + + + diff --git a/info/gcl/nil-_0028Type_0029.html b/info/gcl/nil-_0028Type_0029.html new file mode 100644 index 0000000..fd69df1 --- /dev/null +++ b/info/gcl/nil-_0028Type_0029.html @@ -0,0 +1,66 @@ + + + + + +nil (Type) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.1 nil [Type]

    + +

    Supertypes::

    +

    all types +

    +

    Description::

    + +

    The type nil contains no objects and so is also +called the empty type. +The type nil is a subtype of every type. +No object is of type nil. +

    +

    Notes::

    + +

    The type containing the object nil is the type null, +not the type nil. +

    + + + + + diff --git a/info/gcl/nil.html b/info/gcl/nil.html new file mode 100644 index 0000000..5f1a7cd --- /dev/null +++ b/info/gcl/nil.html @@ -0,0 +1,69 @@ + + + + + +nil (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.30 nil [Constant Variable]

    + +

    Constant Value::

    + +

    nil. +

    +

    Description::

    + +

    nil represents both boolean (and generalized boolean) false +and the empty list. +

    +

    Examples::

    +
    +
     nil ⇒  NIL 
+
    + +

    See Also::

    + +

    t +

    + + + + + diff --git a/info/gcl/no_002dapplicable_002dmethod.html b/info/gcl/no_002dapplicable_002dmethod.html new file mode 100644 index 0000000..e96eaeb --- /dev/null +++ b/info/gcl/no_002dapplicable_002dmethod.html @@ -0,0 +1,86 @@ + + + + + +no-applicable-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.16 no-applicable-method [Standard Generic Function]

    + +

    Syntax::

    + +

    no-applicable-method generic-function &rest function-arguments ⇒ {result}* +

    +

    Method Signatures::

    + +

    no-applicable-method (generic-function t) + &rest function-arguments +

    +

    Arguments and Values::

    + +

    generic-function—a generic function + on which no applicable method was found. +

    +

    function-arguments—arguments to the generic-function. +

    +

    result—an object. +

    +

    Description::

    + +

    The generic function no-applicable-method is called when a +generic function +is invoked +and no method on that generic function is applicable. +The default method signals an error. +

    +

    The generic function no-applicable-method is not intended +to be called by programmers. Programmers may write methods for it. +

    +

    Exceptional Situations::

    + +

    The default method signals an error of type error. +

    +

    See Also::

    + + + + + + diff --git a/info/gcl/no_002dnext_002dmethod.html b/info/gcl/no_002dnext_002dmethod.html new file mode 100644 index 0000000..7f65f0d --- /dev/null +++ b/info/gcl/no_002dnext_002dmethod.html @@ -0,0 +1,90 @@ + + + + + +no-next-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.17 no-next-method [Standard Generic Function]

    + +

    Syntax::

    + +

    no-next-method generic-function method &rest args ⇒ {result}* +

    +

    Method Signatures::

    + +

    no-next-method (generic-function standard-generic-function) + (method standard-method) + &rest args +

    +

    Arguments and Values::

    + +

    generic-function – generic function to which method belongs. +

    +

    method – method that contained the call to + call-next-method for which there is no next method. +

    +

    args – arguments to call-next-method. +

    +

    result—an object. +

    +

    Description::

    + +

    The generic function no-next-method is called by call-next-method +when there is no next method. +

    +

    The generic function no-next-method is not intended to be called by programmers. +Programmers may write methods for it. +

    +

    Exceptional Situations::

    + +

    The system-supplied method on no-next-method +signals an error of type error. +[Editorial Note by KMP: perhaps control-error??] +

    +

    See Also::

    + +

    call-next-method +

    + + + + + diff --git a/info/gcl/not-_0028Type-Specifier_0029.html b/info/gcl/not-_0028Type-Specifier_0029.html new file mode 100644 index 0000000..da13177 --- /dev/null +++ b/info/gcl/not-_0028Type-Specifier_0029.html @@ -0,0 +1,71 @@ + + + + + +not (Type Specifier) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.19 not [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Combining. +

    +

    Compound Type Specifier Syntax::

    + +

    (not{typespec}) +

    +

    Compound Type Specifier Arguments::

    + +

    typespec—a type specifier. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of all objects that are not of the type typespec. +

    +

    The argument is required, and cannot be *. +

    +

    The symbol not is not valid as a type specifier. +

    + + + + + diff --git a/info/gcl/not.html b/info/gcl/not.html new file mode 100644 index 0000000..9fdcee5 --- /dev/null +++ b/info/gcl/not.html @@ -0,0 +1,87 @@ + + + + + +not (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.31 not [Function]

    + +

    not x ⇒ boolean +

    +

    Arguments and Values::

    + +

    x—a generalized boolean (i.e., any object). +

    +

    boolean—a boolean. +

    +

    Description::

    + +

    Returns t if x is false; +otherwise, returns nil. +

    +

    Examples::

    + +
    +
     (not nil) ⇒  T
+ (not '()) ⇒  T
+ (not (integerp 'sss)) ⇒  T
+ (not (integerp 1)) ⇒  NIL
+ (not 3.7) ⇒  NIL
+ (not 'apple) ⇒  NIL
+
    + +

    See Also::

    + +

    null +

    +

    Notes::

    + +

    not is intended to be used to invert the ‘truth value’ of a boolean +(or generalized boolean) +whereas null is intended to be used to test for the empty list. +Operationally, not and null compute the same result; +which to use is a matter of style. +

    + + + + + diff --git a/info/gcl/nth.html b/info/gcl/nth.html new file mode 100644 index 0000000..d92bcac --- /dev/null +++ b/info/gcl/nth.html @@ -0,0 +1,105 @@ + + + + + +nth (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.22 nth [Accessor]

    + +

    nth n list ⇒ object +

    +

    (setf ( nth n list) new-object)
    +

    +

    Arguments and Values::

    + +

    n—a non-negative integer. +

    +

    list—a list, +

    +

    which might be a dotted list or a circular list. +

    +

    object—an object. +

    +

    new-object—an object. +

    +

    Description::

    + +

    nth locates the nth element of list, +where the car of the list is the “zeroth” element. +

    +

    Specifically, +

    +
    +
     (nth n list) ≡ (car (nthcdr n list))
+
    + +

    nth may be used to specify a place to setf. +

    +

    Specifically, +

    +
    +
     (setf (nth n list) new-object) ≡ (setf (car (nthcdr n list)) new-object)
+
    + +

    Examples::

    + +
    +
     (nth 0 '(foo bar baz)) ⇒  FOO
+ (nth 1 '(foo bar baz)) ⇒  BAR
+ (nth 3 '(foo bar baz)) ⇒  NIL
+ (setq 0-to-3 (list 0 1 2 3)) ⇒  (0 1 2 3)
+ (setf (nth 2 0-to-3) "two") ⇒  "two"
+ 0-to-3 ⇒  (0 1 "two" 3)
+
    + +

    See Also::

    + +

    elt +, +first +, +nthcdr +

    + + + + + diff --git a/info/gcl/nth_002dvalue.html b/info/gcl/nth_002dvalue.html new file mode 100644 index 0000000..a085bc2 --- /dev/null +++ b/info/gcl/nth_002dvalue.html @@ -0,0 +1,98 @@ + + + + + +nth-value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.56 nth-value [Macro]

    + +

    nth-value n form ⇒ object +

    +

    Arguments and Values::

    + +

    n—a non-negative integer; evaluated. +

    +

    form—a form; evaluated as described below. +

    +

    object—an object. +

    +

    Description::

    + +

    Evaluates n and then form, +returning as its only value the nth value yielded by form, +or nil if n is greater than or equal to the number of values +returned by form. (The first returned value is numbered 0.) +

    +

    Examples::

    + +
    +
     (nth-value 0 (values 'a 'b)) ⇒  A
+ (nth-value 1 (values 'a 'b)) ⇒  B
+ (nth-value 2 (values 'a 'b)) ⇒  NIL
+ (let* ((x 83927472397238947423879243432432432)
+        (y 32423489732)
+        (a (nth-value 1 (floor x y)))
+        (b (mod x y)))
+   (values a b (= a b)))
+⇒  3332987528, 3332987528, true
+
    + +

    See Also::

    + +

    multiple-value-list +, +nth +

    +

    Notes::

    + +

    Operationally, the following relationship is true, although nth-value +might be more efficient in some implementations +because, for example, some consing might be avoided. +

    +
    +
     (nth-value n form) ≡ (nth n (multiple-value-list form))
+
    + + + + + + diff --git a/info/gcl/nthcdr.html b/info/gcl/nthcdr.html new file mode 100644 index 0000000..4658952 --- /dev/null +++ b/info/gcl/nthcdr.html @@ -0,0 +1,100 @@ + + + + + +nthcdr (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.31 nthcdr [Function]

    + +

    nthcdr n list ⇒ tail +

    +

    Arguments and Values::

    + +

    n—a non-negative integer. +

    +

    list—a list, +

    +

    which might be a dotted list or a circular list. +

    +

    tail—an object. +

    +

    Description::

    + +

    Returns the tail of list that would be obtained by calling cdr +n times in succession. +

    +

    Examples::

    + +
    +
     (nthcdr 0 '()) ⇒  NIL
+ (nthcdr 3 '()) ⇒  NIL
+ (nthcdr 0 '(a b c)) ⇒  (A B C)
+ (nthcdr 2 '(a b c)) ⇒  (C)
+ (nthcdr 4 '(a b c)) ⇒  ()
+ (nthcdr 1 '(0 . 1)) ⇒  1
+
+ (locally (declare (optimize (safety 3)))
+   (nthcdr 3 '(0 . 1)))
+ Error: Attempted to take CDR of 1.
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if n is not a non-negative integer. +

    +

    For n being an integer greater than 1, +the error checking done by (nthcdr n list) +is the same as for (nthcdr (- n 1) (cdr list)); +see the function cdr. +

    +

    See Also::

    + +

    cdr, +nth +, +rest +

    + + + + + diff --git a/info/gcl/null-_0028System-Class_0029.html b/info/gcl/null-_0028System-Class_0029.html new file mode 100644 index 0000000..ce520e7 --- /dev/null +++ b/info/gcl/null-_0028System-Class_0029.html @@ -0,0 +1,69 @@ + + + + + +null (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.2 null [System Class]

    + +

    Class Precedence List::

    +

    null, +symbol, +list, +sequence, +t +

    +

    Description::

    + +

    The only object of type null is nil, +which represents the empty list and can also be notated (). +

    +

    See Also::

    + +

    Symbols as Tokens, +Left-Parenthesis, +Printing Symbols +

    + + + + + diff --git a/info/gcl/null.html b/info/gcl/null.html new file mode 100644 index 0000000..6f947bf --- /dev/null +++ b/info/gcl/null.html @@ -0,0 +1,89 @@ + + + + + +null (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.24 null [Function]

    + +

    null object ⇒ boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    boolean—a boolean. +

    +

    Description::

    + +

    Returns t if object is the empty list; +otherwise, returns nil. +

    +

    Examples::

    + +
    +
     (null '()) ⇒  T
+ (null nil) ⇒  T
+ (null t) ⇒  NIL
+ (null 1) ⇒  NIL
+
    + +

    See Also::

    + +

    not +

    +

    Notes::

    + +

    null is intended to be used to test for the empty list +whereas not is intended to be used to invert a boolean +(or generalized boolean). +Operationally, null and not compute the same result; +which to use is a matter of style. +

    +
    +
     (null object) ≡ (typep object 'null) ≡ (eq object '())
+
    + + + + + + diff --git a/info/gcl/number.html b/info/gcl/number.html new file mode 100644 index 0000000..050c530 --- /dev/null +++ b/info/gcl/number.html @@ -0,0 +1,79 @@ + + + + + +number (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.1 number [System Class]

    + +

    Class Precedence List::

    +

    number, +t +

    +

    Description::

    + +

    The type number contains objects which represent +mathematical numbers. +

    +

    The types real and complex are disjoint +subtypes of number. +

    +

    The function = tests for numerical equality. +The function eql, when its arguments are both numbers, +tests that they have both the same type and numerical value. +Two numbers that are the same under eql or = +are not necessarily the same under eq. +

    +

    Notes::

    + +

    Common Lisp differs from mathematics on some naming issues. In mathematics, +the set of real numbers is traditionally described as a subset of the +complex numbers, but in Common Lisp, the type real and the type complex are +disjoint. The Common Lisp type which includes all mathematical complex +numbers is called number. The reasons for these differences +include historical precedent, compatibility with most other popular +computer languages, and various issues of time and space efficiency. +

    + + + + + diff --git a/info/gcl/numberp.html b/info/gcl/numberp.html new file mode 100644 index 0000000..3b02ca2 --- /dev/null +++ b/info/gcl/numberp.html @@ -0,0 +1,80 @@ + + + + + +numberp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.44 numberp [Function]

    + +

    numberp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type number; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (numberp 12) ⇒  true
+ (numberp (expt 2 130)) ⇒  true
+ (numberp #c(5/3 7.2)) ⇒  true
+ (numberp nil) ⇒  false
+ (numberp (cons 1 2)) ⇒  false
+
    + +

    Notes::

    + +
    +
     (numberp object) ≡ (typep object 'number)
+
    + + + + + + diff --git a/info/gcl/numerator.html b/info/gcl/numerator.html new file mode 100644 index 0000000..a15adb4 --- /dev/null +++ b/info/gcl/numerator.html @@ -0,0 +1,94 @@ + + + + + +numerator (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.53 numerator, denominator [Function]

    + +

    numerator rational ⇒ numerator +

    +

    denominator rational ⇒ denominator +

    +

    Arguments and Values::

    + +

    rational—a rational. +

    +

    numerator—an integer. +

    +

    denominator—a positive integer. +

    +

    Description::

    + +

    numerator and denominator reduce rational +to canonical form and compute the numerator or denominator of that number. +

    +

    numerator and denominator return the numerator +or denominator of the canonical form of rational. +

    +

    If rational is an integer, +numerator returns rational +and denominator returns 1. +

    +

    Examples::

    +
    +
     (numerator 1/2) ⇒  1
+ (denominator 12/36) ⇒  3
+ (numerator -1) ⇒  -1
+ (denominator (/ -33)) ⇒  33
+ (numerator (/ 8 -6)) ⇒  -4
+ (denominator (/ 8 -6)) ⇒  3
+
    + +

    See Also::

    + +

    / +

    +

    Notes::

    +
    +
     (gcd (numerator x) (denominator x)) ⇒  1
+
    + + + + + + diff --git a/info/gcl/open.html b/info/gcl/open.html new file mode 100644 index 0000000..b134b14 --- /dev/null +++ b/info/gcl/open.html @@ -0,0 +1,356 @@ + + + + + +open (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.29 open [Function]

    + +

    open filespec &key direction element-type + if-exists if-does-not-exist + external-format
    + ⇒ stream +

    +

    Arguments and Values::

    + +

    filespec—a pathname designator. +

    +

    direction—one of :input, :output, :io, or :probe. + The default is :input. +

    +

    element-type—a type specifier + for recognizable subtype of character; + or a type specifier + for a finite recognizable subtype of integer; + or one of the symbols + signed-byte, + unsigned-byte, + or :default. + The default is character. +

    +

    if-exists—one of :error, :new-version, :rename, + :rename-and-delete, :overwrite, :append, + :supersede, or nil. + The default is :new-version if the version component of filespec is :newest, + or :error otherwise. +

    +

    if-does-not-exist—one of :error, :create, or nil. + The default is :error if direction is :input + or if-exists is :overwrite or :append; + :create if direction is :output or :io, + and if-exists is neither :overwrite nor :append; + or nil when direction is :probe. +

    +

    external-format—an external file format designator. + The default is :default. +

    +

    stream—a file stream or nil. +

    +

    Description::

    + +

    open creates, opens, and returns a file stream +that is connected to the file specified by filespec. +Filespec is the name of the file to be opened. +If the filespec designator is a stream, +that stream is not closed first or otherwise affected. +

    +

    The keyword arguments to open specify the characteristics +of the file stream that is returned, and how to handle errors. +

    +

    If direction is :input +or :probe, +or if if-exists is not :new-version +and the version component of the filespec is :newest, +then the file opened is that file already existing in the file system +that has a version greater than that of any other file in the file system +whose other pathname components are the same as those of filespec. +

    +

    An implementation is required to recognize all of +the open keyword options +and to do something reasonable in the context of the host operating +system. +For example, if a file system does not support distinct file +versions and does not distinguish the notions of deletion and expunging, +:new-version might be treated the same as +:rename or :supersede, and :rename-and-delete might +be treated the same as :supersede. +

    +
    +
    :direction
    +

    These are the possible values for direction, +and how they affect the nature of the stream that is created: +

    +
    +
    :input
    +

    Causes the creation of an input file stream. +

    +
    +
    :output
    +

    Causes the creation of an output file stream. +

    +
    +
    :io
    +

    Causes the creation of a bidirectional file stream. +

    +
    +
    :probe
    +

    Causes the creation of a “no-directional” file stream; +in effect, the file stream is created +and then closed prior to being returned by open. +

    +
    +
    + +
    +
    :element-type
    +

    The element-type specifies the unit of transaction for the file stream. +If it is :default, +the unit is determined by file system, +possibly based on the file. +

    +
    +
    :if-exists
    +

    if-exists specifies the action to be taken if direction is +:output or :io and a file of the name filespec +already exists. +If direction is :input, not supplied, or :probe, +if-exists is ignored. +These are the results of open as modified by if-exists: +

    +
    +
    :error
    +

    An error of type file-error is signaled. +

    +
    +
    :new-version
    +

    A new file is created with a larger version number. +

    +
    +
    :rename
    +

    The existing file is renamed to some other name and then a new file is created. +

    +
    +
    :rename-and-delete
    +

    The existing file is renamed to some other name, +then it is deleted but not expunged, and then a new file is created. +

    +
    +
    :overwrite
    +

    Output operations on the stream destructively modify the existing file. +If direction is :io the file is opened in a bidirectional mode +that allows both reading and writing. The file pointer is initially +positioned at the beginning of the file; however, the file is not truncated +back to length zero when it is opened. +

    +
    +
    :append
    +

    Output operations on the stream destructively modify the existing file. +The file pointer is initially positioned at the end of the file. +

    +

    If direction is :io, +the file is opened in a bidirectional mode that allows both reading and writing. +

    +
    +
    :supersede
    +

    The existing file is superseded; +that is, a new file with the same name as the old one is created. +If possible, the implementation should not destroy the old file until the new +stream is closed. +

    +
    +
    nil
    +

    No file or stream is created; +instead, nil is returned to indicate failure. +

    +
    +
    + +
    +
    :if-does-not-exist
    +

    if-does-not-exist +specifies the action to be taken if +a file of name filespec does not already exist. +These are the results of open as modified by if-does-not-exist: +

    +
    +
    :error
    +

    An error of type file-error is signaled. +

    +
    +
    :create
    +

    An empty file is created. +Processing continues as if the file +had already existed but no processing as +directed by if-exists is performed. +

    +
    +
    nil
    +

    No file or stream is created; +instead, nil is returned to indicate failure. +

    +
    +
    + +
    +
    :external-format
    +

    This option selects an external file format for the file: +The only standardized value for this option is :default, +although implementations are permitted to define additional +external file formats and implementation-dependent values +returned by stream-external-format can also be used by conforming programs. +

    +

    The external-format is meaningful for +any kind of file stream whose element type +is a subtype of character. +This option is ignored for streams for which it is not meaningful; +however, implementations may define other element types +for which it is meaningful. +The consequences are unspecified if a character is written +that cannot be represented by the given external file format. +

    +
    +
    + +

    When a file is opened, a file stream is constructed to serve +as the file system’s ambassador to the Lisp environment; +operations on the file stream are reflected by operations on the file +in the file system. +

    +

    A file can be deleted, renamed, or destructively modified by open. +

    +

    For information about opening relative pathnames, +see Merging Pathnames. +

    +

    Examples::

    + +
    +
     (open filespec :direction :probe)  ⇒  #<Closed Probe File Stream...>
+ (setq q (merge-pathnames (user-homedir-pathname) "test"))
+⇒  #<PATHNAME :HOST NIL :DEVICE device-name :DIRECTORY directory-name
+    :NAME "test" :TYPE NIL :VERSION :NEWEST>
+ (open filespec :if-does-not-exist :create) ⇒  #<Input File Stream...>
+ (setq s (open filespec :direction :probe)) ⇒  #<Closed Probe File Stream...>
+ (truename s) ⇒  #<PATHNAME :HOST NIL :DEVICE device-name :DIRECTORY
+    directory-name :NAME filespec :TYPE extension :VERSION 1>
+ (open s :direction :output :if-exists nil) ⇒  NIL 
+
    + +

    Affected By::

    + +

    The nature and state of the host computer’s file system. +

    +

    Exceptional Situations::

    + +

    If if-exists is :error, (subject to the +constraints on the meaning of if-exists listed above), +an error of type file-error is signaled. +

    +

    If if-does-not-exist is :error (subject to the +constraints on the meaning of if-does-not-exist listed above), +an error of type file-error is signaled. +

    +

    If it is impossible for an implementation to handle some option +in a manner close to what is specified here, +an error of type error might be signaled. +

    +

    An error of type file-error is signaled if +(wild-pathname-p filespec) returns true. +

    +

    An error of type error is signaled if the external-format +is not understood by the implementation. +

    +

    The various file systems in existence today have widely differing capabilities, +and some aspects of the file system are beyond the scope of this specification +to define. A given implementation might not be able to support all of these options +in exactly the manner stated. An implementation is required to recognize all of +these option keywords and to try to do something “reasonable” in the context of the +host file system. Where necessary to accomodate the file system, +an implementation deviate slightly from the semantics specified here without +being disqualified for consideration as a conforming implementation. +If it is utterly impossible for an implementation to handle some option +in a manner similar to what is specified here, it may simply signal an error. +

    +

    With regard to the :element-type option, if a type is +requested that is not supported by the file system, a substitution of types +such as that which goes on in upgrading is permissible. As a minimum +requirement, it should be the case that opening an output stream +to a file in a given element type and later opening +an input stream to the same file in the same element type +should work compatibly. +

    +

    See Also::

    + +

    with-open-file +, +close +, +pathname, +logical-pathname, +

    +

    Merging Pathnames, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    open does not automatically close the file when an abnormal +exit occurs. +

    +

    When element-type is a subtype of character, +read-char and/or write-char can be +used on the resulting file stream. +

    +

    When element-type is a subtype of integer, +read-byte and/or write-byte can be used on the resulting file stream. +

    +

    When element-type is :default, +the type can be determined by using stream-element-type. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/open_002dstream_002dp.html b/info/gcl/open_002dstream_002dp.html new file mode 100644 index 0000000..36d86ec --- /dev/null +++ b/info/gcl/open_002dstream_002dp.html @@ -0,0 +1,86 @@ + + + + + +open-stream-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.11 open-stream-p [Function]

    + +

    open-stream-p stream ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    stream—a stream. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if stream is an open stream; +otherwise, returns false. +

    +

    Streams are open until they have been explicitly closed with close, +or until they are implicitly closed due to exit from a + with-output-to-string, + with-open-file, + with-input-from-string, or + with-open-stream form. +

    +

    Examples::

    + +
    +
     (open-stream-p *standard-input*) ⇒  true
+
    + +

    Affected By::

    + +

    close. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if stream is not a stream. +

    + + + + + diff --git a/info/gcl/optimize.html b/info/gcl/optimize.html new file mode 100644 index 0000000..e80c00b --- /dev/null +++ b/info/gcl/optimize.html @@ -0,0 +1,146 @@ + + + + + +optimize (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.25 optimize [Declaration]

    + +

    Syntax::

    + +

    (optimize {quality | (quality value)}*) +

    + + + + + + + + + + +

    Arguments::

    + +

    quality—an optimize quality. +

    +

    value—one of the integers 0, 1, 2, or 3. +

    +

    Valid Context::

    + +

    declaration or proclamation +

    +

    Description::

    + +

    Advises the compiler that each quality should be given attention +according to the specified corresponding value. +Each quality must be a symbol naming an optimize quality; +the names and meanings of the standard optimize qualities are shown in +Figure 3–25. +

    +
    +
      Name               Meaning                            
+  compilation-speed  speed of the compilation process   
+  debug              ease of debugging                  
+  safety             run-time error checking            
+  space              both code size and run-time space  
+  speed              speed of the object code           
+
+             Figure 3–25: Optimize qualities           
+
+
    + +

    There may be other, implementation-defined optimize qualities. +

    +

    A value 0 means that the corresponding quality is totally +unimportant, and 3 that the quality is extremely important; +1 and 2 are intermediate values, with 1 the +neutral value. +(quality 3) can be abbreviated to quality. +

    +

    Note that code which has the optimization (safety 3), +or just safety, +is called safe code. +

    +

    The consequences are unspecified if a quality appears more than once +with different values. +

    +

    Examples::

    + +
    +
     (defun often-used-subroutine (x y)
+   (declare (optimize (safety 2)))
+   (error-check x y)
+   (hairy-setup x)
+   (do ((i 0 (+ i 1))
+        (z x (cdr z)))
+       ((null z))
+     ;; This inner loop really needs to burn.
+     (declare (optimize speed))
+     (declare (fixnum i))
+     ))
+
    + +

    See Also::

    + +

    declare, +declaim +, +proclaim +, +Declaration Scope +

    +

    Notes::

    + +

    An optimize declaration never applies to either a variable or +a function binding. An optimize declaration can only +be a free declaration. For more information, see Declaration Scope. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/or-_0028Type-Specifier_0029.html b/info/gcl/or-_0028Type-Specifier_0029.html new file mode 100644 index 0000000..e93a4a6 --- /dev/null +++ b/info/gcl/or-_0028Type-Specifier_0029.html @@ -0,0 +1,77 @@ + + + + + +or (Type Specifier) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.21 or [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Combining. +

    +

    Compound Type Specifier Syntax::

    + +

    (or{{typespec}*}) +

    +

    Compound Type Specifier Arguments::

    + +

    typespec—a type specifier. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of all objects of the +type determined by the union of the typespecs. +For example, the type list by definition is the same as (or null cons). +Also, the value returned by position is an object of type (or null (integer 0 *)); +i.e., either nil or a non-negative integer. +

    +

    * is not permitted as an argument. +

    +

    The type specifiers (or) and nil are equivalent. +The symbol or is not valid as a type specifier; +and, specifically, it is not an abbreviation for (or). +

    + + + + + diff --git a/info/gcl/or.html b/info/gcl/or.html new file mode 100644 index 0000000..1f2a394 --- /dev/null +++ b/info/gcl/or.html @@ -0,0 +1,99 @@ + + + + + +or (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.44 or [Macro]

    + +

    or {form}* ⇒ {results}* +

    +

    Arguments and Values::

    + +

    form—a form. +

    +

    results—the values or primary value (see below) + resulting from the evaluation of + the last form executed or nil. +

    +

    Description::

    + +

    or evaluates each form, one at a time, from left to right. +The evaluation of all forms terminates when a form evaluates +to true (i.e., something other than nil). +

    +

    If the evaluation of any form other than the last returns a +primary value that is true, or immediately returns +that value (but no additional values) without evaluating the +remaining forms. +If every form but the last returns false as its primary value, +or returns all values returned by the last form. +If no forms are supplied, or returns nil. +

    +

    Examples::

    + +
    +
     (or) ⇒  NIL 
+ (setq temp0 nil temp1 10 temp2 20 temp3 30) ⇒  30
+ (or temp0 temp1 (setq temp2 37)) ⇒  10
+ temp2 ⇒  20
+ (or (incf temp1) (incf temp2) (incf temp3)) ⇒  11
+ temp1 ⇒  11
+ temp2 ⇒  20
+ temp3 ⇒  30
+ (or (values) temp1) ⇒  11
+ (or (values temp1 temp2) temp3) ⇒  11
+ (or temp0 (values temp1 temp2)) ⇒  11, 20
+ (or (values temp0 temp1) (values temp2 temp3)) ⇒  20, 30
+
    + +

    See Also::

    + +

    and +, +some, +unless +

    + + + + + diff --git a/info/gcl/package.html b/info/gcl/package.html new file mode 100644 index 0000000..e6e1629 --- /dev/null +++ b/info/gcl/package.html @@ -0,0 +1,66 @@ + + + + + +package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.1 package [System Class]

    + +

    Class Precedence List::

    +

    package, +t +

    +

    Description::

    + +

    A package is a namespace that maps symbol names +to symbols; see Package Concepts. +

    +

    See Also::

    + +

    Package Concepts, +Printing Other Objects, +Symbols as Tokens +

    + + + + + diff --git a/info/gcl/package_002derror.html b/info/gcl/package_002derror.html new file mode 100644 index 0000000..1af36a2 --- /dev/null +++ b/info/gcl/package_002derror.html @@ -0,0 +1,72 @@ + + + + + +package-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.29 package-error [Condition Type]

    + +

    Class Precedence List::

    +

    package-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type package-error consists of error conditions +related to operations on packages. +The offending package (or package name) +is initialized by the :package initialization argument to make-condition, +and is accessed by the function package-error-package. +

    +

    See Also::

    + +

    package-error-package +, +Conditions +

    + + + + + diff --git a/info/gcl/package_002derror_002dpackage.html b/info/gcl/package_002derror_002dpackage.html new file mode 100644 index 0000000..096af1d --- /dev/null +++ b/info/gcl/package_002derror_002dpackage.html @@ -0,0 +1,82 @@ + + + + + +package-error-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.30 package-error-package [Function]

    + +

    package-error-package condition ⇒ package +

    +

    Arguments and Values::

    + +

    condition—a condition of type package-error. +

    +

    package—a package designator. +

    +

    Description::

    + +

    Returns a designator for the offending package +in the situation represented by the condition. +

    +

    Examples::

    + +
    +
     (package-error-package 
+   (make-condition 'package-error
+     :package (find-package "COMMON-LISP")))
+⇒  #<Package "COMMON-LISP">
+
    + +

    See Also::

    + +

    package-error +

    + + + + + + + + + + diff --git a/info/gcl/package_002dname.html b/info/gcl/package_002dname.html new file mode 100644 index 0000000..2268a29 --- /dev/null +++ b/info/gcl/package_002dname.html @@ -0,0 +1,88 @@ + + + + + +package-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.22 package-name [Function]

    + +

    package-name package ⇒ name +

    +

    Arguments and Values::

    + +

    package—a package designator. +

    +

    name—a string +

    +

    or nil. +

    +

    Description::

    + +

    package-name returns the string that names package, +

    +

    or nil if the package designator +is a package object that has no name (see the function delete-package). +

    +

    Examples::

    + +
    +
     (in-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (package-name *package*) ⇒  "COMMON-LISP-USER"
+ (package-name (symbol-package :test)) ⇒  "KEYWORD"
+ (package-name (find-package 'common-lisp)) ⇒  "COMMON-LISP"
+
    + +
    +
     (defvar *foo-package* (make-package "FOO"))
+ (rename-package "FOO" "FOO0")
+ (package-name *foo-package*) ⇒  "FOO0"
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if package is not a package designator. +

    + + + + + diff --git a/info/gcl/package_002dnicknames.html b/info/gcl/package_002dnicknames.html new file mode 100644 index 0000000..b0ab6a6 --- /dev/null +++ b/info/gcl/package_002dnicknames.html @@ -0,0 +1,77 @@ + + + + + +package-nicknames (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.23 package-nicknames [Function]

    + +

    package-nicknames package ⇒ nicknames +

    +

    Arguments and Values::

    + +

    package—a package designator. +

    +

    nicknames—a list of strings. +

    +

    Description::

    + +

    Returns the list of nickname strings +for package, not including the name of package. +

    +

    Examples::

    + +
    +
     (package-nicknames (make-package 'temporary
+                                   :nicknames '("TEMP" "temp")))
+⇒  ("temp" "TEMP") 
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if package is not a package designator. +

    + + + + + diff --git a/info/gcl/package_002dshadowing_002dsymbols.html b/info/gcl/package_002dshadowing_002dsymbols.html new file mode 100644 index 0000000..5487e3d --- /dev/null +++ b/info/gcl/package_002dshadowing_002dsymbols.html @@ -0,0 +1,92 @@ + + + + + +package-shadowing-symbols (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.24 package-shadowing-symbols [Function]

    + +

    package-shadowing-symbols package ⇒ symbols +

    +

    Arguments and Values::

    + +

    package—a package designator. +

    +

    symbols—a list of symbols. +

    +

    Description::

    + +

    Returns a list of symbols that have been declared +as shadowing symbols in package by shadow +or shadowing-import (or the equivalent defpackage options). +All symbols on this list are present in package. +

    +

    Examples::

    + +
    +
     (package-shadowing-symbols (make-package 'temp)) ⇒  ()
+ (shadow 'cdr 'temp) ⇒  T
+ (package-shadowing-symbols 'temp) ⇒  (TEMP::CDR)
+ (intern "PILL" 'temp) ⇒  TEMP::PILL, NIL
+ (shadowing-import 'pill 'temp) ⇒  T
+ (package-shadowing-symbols 'temp) ⇒  (PILL TEMP::CDR)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if package is not a package designator. +

    +

    See Also::

    + +

    shadow +, +shadowing-import +

    +

    Notes::

    + +

    Whether the list of symbols is fresh is implementation-dependent. +

    + + + + + diff --git a/info/gcl/package_002duse_002dlist.html b/info/gcl/package_002duse_002dlist.html new file mode 100644 index 0000000..6b7c5ba --- /dev/null +++ b/info/gcl/package_002duse_002dlist.html @@ -0,0 +1,82 @@ + + + + + +package-use-list (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.25 package-use-list [Function]

    + +

    package-use-list package ⇒ use-list +

    +

    Arguments and Values::

    + +

    package—a package designator. +

    +

    use-list—a list of package objects. +

    +

    Description::

    + +

    Returns a list of other packages used by package. +

    +

    Examples::

    + +
    +
     (package-use-list (make-package 'temp)) ⇒  (#<PACKAGE "COMMON-LISP">)
+ (use-package 'common-lisp-user 'temp) ⇒  T
+ (package-use-list 'temp) ⇒  (#<PACKAGE "COMMON-LISP"> #<PACKAGE "COMMON-LISP-USER">)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if package is not a package designator. +

    +

    See Also::

    + +

    use-package +, +unuse-package +

    + + + + + diff --git a/info/gcl/package_002dused_002dby_002dlist.html b/info/gcl/package_002dused_002dby_002dlist.html new file mode 100644 index 0000000..b9641c4 --- /dev/null +++ b/info/gcl/package_002dused_002dby_002dlist.html @@ -0,0 +1,83 @@ + + + + + +package-used-by-list (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.26 package-used-by-list [Function]

    + +

    package-used-by-list package ⇒ used-by-list +

    +

    Arguments and Values::

    + +

    package—a package designator. +

    +

    used-by-list—a list of package objects. +

    +

    Description::

    + +

    package-used-by-list returns a list +of other packages that use package. +

    +

    Examples::

    + +
    +
     (package-used-by-list (make-package 'temp)) ⇒  ()
+ (make-package 'trash :use '(temp)) ⇒  #<PACKAGE "TRASH">
+ (package-used-by-list 'temp) ⇒  (#<PACKAGE "TRASH">)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if package is not a package. +

    +

    See Also::

    + +

    use-package +, +unuse-package +

    + + + + + diff --git a/info/gcl/packagep.html b/info/gcl/packagep.html new file mode 100644 index 0000000..bcca6b9 --- /dev/null +++ b/info/gcl/packagep.html @@ -0,0 +1,77 @@ + + + + + +packagep (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.27 packagep [Function]

    + +

    packagep object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type package; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (packagep *package*) ⇒  true 
+ (packagep 'common-lisp) ⇒  false 
+ (packagep (find-package 'common-lisp)) ⇒  true 
+
    + +

    Notes::

    + +
    +
     (packagep object) ≡ (typep object 'package)
+
    + + + + + + diff --git a/info/gcl/pairlis.html b/info/gcl/pairlis.html new file mode 100644 index 0000000..72bb59f --- /dev/null +++ b/info/gcl/pairlis.html @@ -0,0 +1,114 @@ + + + + + +pairlis (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.38 pairlis [Function]

    + +

    pairlis keys data &optional alist ⇒ new-alist +

    +

    Arguments and Values::

    + +

    keys—a proper list. +

    +

    data—a proper list. +

    +

    alist—an association list. + The default is the empty list. +

    +

    new-alist—an association list. +

    +

    Description::

    + +

    Returns an association list that associates +elements of keys to corresponding elements of data. +The consequences are undefined if keys and data are +not of the same length. +

    +

    If alist is supplied, pairlis returns +a modified alist with the +new pairs prepended to it. +The new pairs may appear in the resulting association list in +either forward or backward order. +The result of +

    +
    +
     (pairlis '(one two) '(1 2) '((three . 3) (four . 19)))
+
    + +

    might be +

    +
    +
     ((one . 1) (two . 2) (three . 3) (four . 19))
+
    + +

    or +

    +
    +
     ((two . 2) (one . 1) (three . 3) (four . 19))
+
    + +

    Examples::

    +
    +
     (setq keys '(1 2 3)
+        data '("one" "two" "three")
+        alist '((4 . "four"))) ⇒  ((4 . "four"))
+ (pairlis keys data) ⇒  ((3 . "three") (2 . "two") (1 . "one"))
+ (pairlis keys data alist)
+⇒  ((3 . "three") (2 . "two") (1 . "one") (4 . "four"))
+ alist ⇒  ((4 . "four"))
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if keys and data are not proper lists. +

    +

    See Also::

    + +

    acons +

    + + + + + diff --git a/info/gcl/parse_002derror.html b/info/gcl/parse_002derror.html new file mode 100644 index 0000000..17513a6 --- /dev/null +++ b/info/gcl/parse_002derror.html @@ -0,0 +1,70 @@ + + + + + +parse-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.8 parse-error [Condition Type]

    + +

    Class Precedence List::

    + +

    parse-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type parse-error consists of +error conditions that are related to parsing. +

    +

    See Also::

    + +

    parse-namestring +, +reader-error +

    + + + + + diff --git a/info/gcl/parse_002dinteger.html b/info/gcl/parse_002dinteger.html new file mode 100644 index 0000000..af1377b --- /dev/null +++ b/info/gcl/parse_002dinteger.html @@ -0,0 +1,119 @@ + + + + + +parse-integer (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.59 parse-integer [Function]

    + +

    parse-integer string &key start end radix junk-allowed ⇒ integer, pos +

    +

    Arguments and Values::

    + +

    string—a string. +

    +

    start, end—bounding index designators of string. + The defaults for start and end are 0 and nil, respectively. +

    +

    radix—a radix. + The default is 10. +

    +

    junk-allowed—a generalized boolean. + The default is false. +

    +

    integer—an integer or false. +

    +

    pos—a bounding index of string. +

    +

    Description::

    + +

    parse-integer parses an integer in the specified radix +from the substring of string delimited by start and end. +

    +

    parse-integer expects an optional sign (+ or -) followed by +a a non-empty sequence of digits to be interpreted in the specified radix. +Optional leading and trailing whitespace_1 is ignored. +

    +

    parse-integer does not recognize the syntactic radix-specifier +prefixes #O, #B, #X, and #nR, +nor does it recognize a trailing decimal point. +

    +

    If junk-allowed is false, an error of type parse-error is +signaled if substring does not consist entirely of the representation of a +signed integer, possibly surrounded on either side by whitespace_1 +characters. +

    +

    The first value returned is either + the integer that was parsed, + or else nil if no syntactically correct integer + was seen but junk-allowed was true. +

    +

    The second value is either + the index into the string of the delimiter that terminated the parse, + or the upper bounding index of the substring if the parse terminated at + the end of the substring (as is always the case if junk-allowed + is false). +

    +

    Examples::

    +
    +
     (parse-integer "123") ⇒  123, 3
+ (parse-integer "123" :start 1 :radix 5) ⇒  13, 3
+ (parse-integer "no-integer" :junk-allowed t) ⇒  NIL, 0
+
    + +

    Exceptional Situations::

    + +

    If junk-allowed is false, +an error is signaled if substring does not consist entirely of +the representation of an integer, +possibly surrounded on either side by +whitespace_1 characters. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/parse_002dnamestring.html b/info/gcl/parse_002dnamestring.html new file mode 100644 index 0000000..7e34f91 --- /dev/null +++ b/info/gcl/parse_002dnamestring.html @@ -0,0 +1,210 @@ + + + + + +parse-namestring (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.12 parse-namestring [Function]

    + +

    parse-namestring thing &optional host default-pathname &key start end junk-allowed
    + ⇒ pathname, position +

    +

    Arguments and Values::

    + +

    thing—a string, + a pathname, + or a stream associated with a file. +

    +

    host—a valid pathname host, a logical host, or nil. +

    +

    default-pathname—a pathname designator. + The default is the value of *default-pathname-defaults*. +

    +

    start, end—bounding index designators of thing. + The defaults for start and end are 0 and nil, respectively. +

    +

    junk-allowed—a generalized boolean. + The default is false. +

    +

    pathname—a pathname, or nil. +

    +

    position—a bounding index designator for thing. +

    +

    Description::

    + +

    Converts thing into a pathname. +

    +

    The host supplies a host name with respect to which the parsing occurs. +

    +

    If thing is a stream associated with a file, +processing proceeds as if the pathname used to open that file +had been supplied instead. +

    +

    If thing is a pathname, +the host and the host component of thing are compared. +If they match, +two values are immediately returned: thing and start; +otherwise (if they do not match), an error is signaled. +

    +

    Otherwise (if thing is a string), +parse-namestring parses the name of a file within +the substring of thing bounded by start and end. +

    +

    If thing is a string then +the substring of thing bounded by start and end +is parsed into a pathname +as follows: +

    +
    +
    *
    +

    If host is a logical host then thing is parsed + as a logical pathname namestring + on the host. +

    +
    +
    *
    +

    If host is nil and thing is a syntactically valid + logical pathname namestring containing an explicit host, + then it is parsed as a logical pathname namestring. +

    +
    +
    *
    +

    If host is nil, + default-pathname is a logical pathname, + and thing is a syntactically valid logical pathname namestring + without an explicit host, + then it is parsed as a logical pathname namestring + on the host that is the host component of default-pathname. +

    +
    +
    *
    +

    Otherwise, the parsing of thing is implementation-defined. +

    +
    +
    + +

    In the first +of these +cases, +the host portion of the logical pathname namestring +and its following colon are optional. +

    +

    If the host portion of the namestring and host +are both present and do not match, +an error is signaled. +

    +

    If junk-allowed is true, +then the primary value is the pathname parsed +or, if no syntactically correct pathname was seen, nil. +If junk-allowed is false, +then the entire substring is scanned, +and the primary value is the pathname parsed. +

    +

    In either case, the secondary value +is the index into thing of the delimiter that terminated the parse, +or the index beyond the substring if the parse terminated at the end of the substring + (as will always be the case if junk-allowed is false). +

    +

    Parsing a null string always succeeds, +producing a pathname with all components (except the host) equal to nil. +

    +

    If thing contains an explicit host name and no explicit device name, +then it is implementation-defined whether parse-namestring +will supply the standard default device for that host as the device component +of the resulting pathname. +

    +

    Examples::

    + +
    +
     (setq q (parse-namestring "test"))  
+⇒  #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test" 
+       :TYPE NIL :VERSION NIL)
+ (pathnamep q) ⇒  true
+ (parse-namestring "test") 
+⇒  #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test"
+       :TYPE NIL :VERSION NIL), 4
+ (setq s (open xxx)) ⇒  #<Input File Stream...>
+ (parse-namestring s) 
+⇒  #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME xxx 
+       :TYPE NIL :VERSION NIL), 0
+ (parse-namestring "test" nil nil :start 2 :end 4 )
+ ⇒  #S(PATHNAME ...), 15
+ (parse-namestring "foo.lisp")
+⇒  #P"foo.lisp"
+
    + +

    Exceptional Situations::

    + +

    If junk-allowed is false, +an error of type parse-error is signaled if thing +does not consist entirely of the representation of a pathname, +possibly surrounded on either side by whitespace_1 characters if that is +appropriate to the cultural conventions of the implementation. +

    +

    If host is supplied and not nil, +and thing contains a manifest host name, +an error of type error is signaled if the hosts do not match. +

    +

    If thing is a logical pathname namestring +and if the host portion of the namestring and host +are both present and do not match, +an error of type error is signaled. +

    +

    See Also::

    + +

    pathname, +logical-pathname, +File System Concepts, +

    +

    ->UNSPECIFIC as a Component Value, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/pathname-_0028System-Class_0029.html b/info/gcl/pathname-_0028System-Class_0029.html new file mode 100644 index 0000000..c63584b --- /dev/null +++ b/info/gcl/pathname-_0028System-Class_0029.html @@ -0,0 +1,62 @@ + + + + + +pathname (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.1 pathname [System Class]

    + +

    Class Precedence List::

    +

    pathname, +t +

    +

    Description::

    + +

    A pathname is a structured object which represents a filename. +

    +

    There are two kinds of pathnames—physical pathnames and +logical pathnames. +

    + + + + + diff --git a/info/gcl/pathname.html b/info/gcl/pathname.html new file mode 100644 index 0000000..583035e --- /dev/null +++ b/info/gcl/pathname.html @@ -0,0 +1,126 @@ + + + + + +pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.3 pathname [Function]

    + +

    pathname pathspec ⇒ pathname +

    +

    Arguments and Values::

    + +

    pathspec—a pathname designator. +

    +

    pathname—a pathname. +

    +

    Description::

    + +

    Returns the pathname denoted by pathspec. +

    +

    If the pathspec designator is a stream, +the stream can be either open or closed; +in both cases, the pathname returned +corresponds to the filename used to open the file. +pathname returns the same pathname for a file stream +after it is closed as it did when it was open. +

    +

    If the pathspec designator is +a file stream created by opening a logical pathname, +a logical pathname is returned. +

    +

    Examples::

    + +
    +
     ;; There is a great degree of variability permitted here.  The next
+ ;; several examples are intended to illustrate just a few of the many
+ ;; possibilities.  Whether the name is canonicalized to a particular
+ ;; case (either upper or lower) depends on both the file system and the
+ ;; implementation since two different implementations using the same
+ ;; file system might differ on many issues.  How information is stored
+ ;; internally (and possibly presented in #S notation) might vary,
+ ;; possibly requiring `accessors' such as PATHNAME-NAME to perform case
+ ;; conversion upon access.  The format of a namestring is dependent both
+ ;; on the file system and the implementation since, for example, one
+ ;; implementation might include the host name in a namestring, and
+ ;; another might not.  #S notation would generally only be used in a
+ ;; situation where no appropriate namestring could be constructed for use
+ ;; with #P.
+ (setq p1 (pathname "test"))
+⇒  #P"CHOCOLATE:TEST" ; with case canonicalization (e.g., VMS)
+OR⇒ #P"VANILLA:test"   ; without case canonicalization (e.g., Unix)
+OR⇒ #P"test"
+OR⇒ #S(PATHNAME :HOST "STRAWBERRY" :NAME "TEST")
+OR⇒ #S(PATHNAME :HOST "BELGIAN-CHOCOLATE" :NAME "test")
+ (setq p2 (pathname "test"))
+⇒  #P"CHOCOLATE:TEST"
+OR⇒ #P"VANILLA:test"
+OR⇒ #P"test"
+OR⇒ #S(PATHNAME :HOST "STRAWBERRY" :NAME "TEST")
+OR⇒ #S(PATHNAME :HOST "BELGIAN-CHOCOLATE" :NAME "test")
+ (pathnamep p1) ⇒  true
+ (eq p1 (pathname p1)) ⇒  true
+ (eq p1 p2)
+⇒  true
+OR⇒ false
+ (with-open-file (stream "test" :direction :output)
+   (pathname stream))
+⇒  #P"ORANGE-CHOCOLATE:>Gus>test.lisp.newest"
+
    + +

    See Also::

    + +

    pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/pathname_002dhost.html b/info/gcl/pathname_002dhost.html new file mode 100644 index 0000000..eb607ec --- /dev/null +++ b/info/gcl/pathname_002dhost.html @@ -0,0 +1,181 @@ + + + + + +pathname-host (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.6 pathname-host, pathname-device, pathname-directory,

    +

    pathname-name, pathname-type, pathname-version

    +

    [Function] +

    +

    pathname-host pathname &key case ⇒ host +

    +

    pathname-device pathname &key case ⇒ device +

    +

    pathname-directory pathname &key case ⇒ directory +

    +

    pathname-name pathname &key case ⇒ name +

    +

    pathname-type pathname &key case ⇒ type +

    +

    pathname-version pathname ⇒ version +

    +

    Arguments and Values::

    + +

    pathname—a pathname designator. +

    +

    case—one of :local or :common. + The default is :local. +

    +

    host—a valid pathname host. +

    +

    device—a valid pathname device. +

    +

    directory—a valid pathname directory. +

    +

    name—a valid pathname name. +

    +

    type—a valid pathname type. +

    +

    version—a valid pathname version. +

    +

    Description::

    + +

    These functions return the components of pathname. +

    +

    If the pathname designator is a pathname, +it represents the name used to open the file. This may be, but is +not required to be, the actual name of the file. +

    +

    If case is supplied, +it is treated as described in Case in Pathname Components. +

    +

    Examples::

    + +
    +
     (setq q (make-pathname :host "KATHY"
+                        :directory "CHAPMAN" 
+                        :name "LOGIN" :type "COM"))
+⇒  #P"KATHY::[CHAPMAN]LOGIN.COM"
+ (pathname-host q) ⇒  "KATHY"
+ (pathname-name q) ⇒  "LOGIN"
+ (pathname-type q) ⇒  "COM"
+
+ ;; Because namestrings are used, the results shown in the remaining
+ ;; examples are not necessarily the only possible results.  Mappings
+ ;; from namestring representation to pathname representation are 
+ ;; dependent both on the file system involved and on the implementation
+ ;; (since there may be several implementations which can manipulate the
+ ;; the same file system, and those implementations are not constrained
+ ;; to agree on all details). Consult the documentation for each
+ ;; implementation for specific information on how namestrings are treated
+ ;; that implementation.
+
+ ;; VMS
+ (pathname-directory (parse-namestring "[FOO.*.BAR]BAZ.LSP"))
+⇒  (:ABSOLUTE "FOO" "BAR")
+ (pathname-directory (parse-namestring "[FOO.*.BAR]BAZ.LSP") :case :common)
+⇒  (:ABSOLUTE "FOO" "BAR")
+
+ ;; Unix
+ (pathname-directory "foo.l") ⇒  NIL
+ (pathname-device "foo.l") ⇒  :UNSPECIFIC
+ (pathname-name "foo.l") ⇒  "foo"
+ (pathname-name "foo.l" :case :local) ⇒  "foo"
+ (pathname-name "foo.l" :case :common) ⇒  "FOO"
+ (pathname-type "foo.l") ⇒  "l"
+ (pathname-type "foo.l" :case :local) ⇒  "l"
+ (pathname-type "foo.l" :case :common) ⇒  "L"
+ (pathname-type "foo") ⇒  :UNSPECIFIC
+ (pathname-type "foo" :case :common) ⇒  :UNSPECIFIC
+ (pathname-type "foo.") ⇒  ""
+ (pathname-type "foo." :case :common) ⇒  ""
+ (pathname-directory (parse-namestring "/foo/bar/baz.lisp") :case :local)
+⇒  (:ABSOLUTE "foo" "bar")
+ (pathname-directory (parse-namestring "/foo/bar/baz.lisp") :case :local)
+⇒  (:ABSOLUTE "FOO" "BAR")
+ (pathname-directory (parse-namestring "../baz.lisp"))
+⇒  (:RELATIVE :UP)
+ (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/BAR/../Mum/baz"))
+⇒  (:ABSOLUTE "foo" "BAR" :UP "Mum")
+ (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/BAR/../Mum/baz") :case :common)
+⇒  (:ABSOLUTE "FOO" "bar" :UP "Mum")
+ (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/*/bar/baz.l"))
+⇒  (:ABSOLUTE "foo" :WILD "bar")
+ (PATHNAME-DIRECTORY (PARSE-NAMESTRING "/foo/*/bar/baz.l") :case :common)
+⇒  (:ABSOLUTE "FOO" :WILD "BAR")
+
+ ;; Symbolics LMFS
+ (pathname-directory (parse-namestring ">foo>**>bar>baz.lisp"))
+⇒  (:ABSOLUTE "foo" :WILD-INFERIORS "bar")
+ (pathname-directory (parse-namestring ">foo>*>bar>baz.lisp"))
+⇒  (:ABSOLUTE "foo" :WILD "bar")
+ (pathname-directory (parse-namestring ">foo>*>bar>baz.lisp") :case :common)
+⇒  (:ABSOLUTE "FOO" :WILD "BAR")
+ (pathname-device (parse-namestring ">foo>baz.lisp")) ⇒  :UNSPECIFIC
+
    + +

    Affected By::

    + +

    The implementation and the host file system. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if its first argument is not a pathname. +

    +

    See Also::

    + +

    pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/pathname_002dmatch_002dp.html b/info/gcl/pathname_002dmatch_002dp.html new file mode 100644 index 0000000..35636b7 --- /dev/null +++ b/info/gcl/pathname_002dmatch_002dp.html @@ -0,0 +1,88 @@ + + + + + +pathname-match-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.14 pathname-match-p [Function]

    + +

    pathname-match-p pathname wildcard ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    pathname—a pathname designator. +

    +

    wildcard—a designator for a wild pathname. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    pathname-match-p returns true if +pathname matches wildcard, otherwise nil. The +matching rules are implementation-defined but should be consistent with +directory. Missing components of wildcard default to :wild. +

    +

    It is valid for pathname to be a wild pathname; +a wildcard field in pathname only matches a +wildcard field in wildcard (i.e., pathname-match-p is not commutative). +It is valid for wildcard to be a non-wild pathname. +

    +

    Exceptional Situations::

    + +

    If pathname or wildcard is not a pathname, string, +or stream associated with a file an error of type type-error is signaled. +

    +

    See Also::

    + +

    directory +, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/pathnamep.html b/info/gcl/pathnamep.html new file mode 100644 index 0000000..49a6734 --- /dev/null +++ b/info/gcl/pathnamep.html @@ -0,0 +1,84 @@ + + + + + +pathnamep (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.5 pathnamep [Function]

    + +

    pathnamep object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type pathname; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (setq q "test")  ⇒  "test"
+ (pathnamep q) ⇒  false
+ (setq q (pathname "test"))
+⇒  #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY NIL :NAME "test" :TYPE NIL
+       :VERSION NIL)
+ (pathnamep q) ⇒  true 
+ (setq q (logical-pathname "SYS:SITE;FOO.SYSTEM"))
+⇒  #P"SYS:SITE;FOO.SYSTEM"
+ (pathnamep q) ⇒  true
+
    + +

    Notes::

    + +
    +
     (pathnamep object) ≡ (typep object 'pathname)
+
    + + + + + + diff --git a/info/gcl/peek_002dchar.html b/info/gcl/peek_002dchar.html new file mode 100644 index 0000000..36ac05d --- /dev/null +++ b/info/gcl/peek_002dchar.html @@ -0,0 +1,150 @@ + + + + + +peek-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.16 peek-char [Function]

    + +

    peek-char &optional peek-type input-stream eof-error-p + eof-value recursive-p ⇒ char +

    +

    Arguments and Values::

    + +

    peek-type—a character or t or nil. +

    +

    input-stream—input stream designator. + The default is standard input. +

    +

    eof-error-p—a generalized boolean. + The default is true. +

    +

    eof-value—an object. + The default is nil. +

    +

    recursive-p—a generalized boolean. + The default is false. +

    +

    char—a character or the eof-value. +

    +

    Description::

    + +

    peek-char obtains the next character in input-stream +without actually reading it, thus leaving the character +to be read at a later time. It can +also be used to skip over and discard intervening +characters in the input-stream +until a particular character is found. +

    +

    If peek-type is not supplied or nil, +peek-char returns the next character to be read from +input-stream, without actually removing it from +input-stream. +The next time input is done from input-stream, the character will still +be there. +If peek-type is t, +then peek-char skips over whitespace_2 characters, +but not comments, +and then performs the peeking operation on the next +character. +The last character examined, the one that starts an object, +is not removed from input-stream. +If peek-type is a character, +then peek-char skips +over input characters until a character that +is char= to that character is found; +that character is left in input-stream. +

    +

    If an end of file_2 occurs and eof-error-p is false, +eof-value is returned. +

    +

    If recursive-p is true, +this call is expected to be embedded in a higher-level call to read +or a similar function used by the Lisp reader. +

    +

    When input-stream is an echo stream, +characters that are only peeked at are not echoed. In the +case that peek-type is not nil, +the characters that are passed by peek-char +are treated as if by read-char, +and so are echoed unless they have been marked otherwise by unread-char. +

    +

    Examples::

    +
    +
     (with-input-from-string (input-stream "    1 2 3 4 5")
+    (format t "~S ~S ~S" 
+            (peek-char t input-stream)
+            (peek-char #\4 input-stream)
+            (peek-char nil input-stream)))
+ |>  #\1 #\4 #\4
+⇒  NIL
+
    + +

    Affected By::

    + +

    *readtable*, +*standard-input*, +*terminal-io*. +

    +

    Exceptional Situations::

    + +

    If eof-error-p is true and an end of file_2 occurs +an error of type end-of-file is signaled. +

    +

    If peek-type is a character, + an end of file_2 occurs, + and eof-error-p is true, +an error of type end-of-file is signaled. +

    +

    If recursive-p is true +and an end of file_2 occurs, +an error of type end-of-file is signaled. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/phase.html b/info/gcl/phase.html new file mode 100644 index 0000000..2e55150 --- /dev/null +++ b/info/gcl/phase.html @@ -0,0 +1,115 @@ + + + + + +phase (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.49 phase [Function]

    + +

    phase number ⇒ phase +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    phase—a number. +

    +

    Description::

    + +

    phase +returns the phase +of number (the angle part of its polar representation) +in radians, in the range +

    +

    -\pi (exclusive) if minus zero is not supported, or +-\pi (inclusive) if minus zero is supported, +

    +

    to \pi (inclusive). The phase of a positive +

    +

    real +

    +

    number +is zero; that of a negative +

    +

    real +

    +

    number is \pi. +The phase of zero is defined to be zero. +

    +

    If number is a complex float, +the result is a float of the same type +as the components of number. +If number is a float, the result is a +float of the same type. +If number is a rational or a complex rational, +the result is a single float. +

    +

    The branch cut for phase lies along the negative real +axis, continuous with quadrant II. The range consists of that portion of +the real axis between -\pi (exclusive) and~\pi (inclusive). +

    +

    The mathematical definition of phase is as follows: +

    +

    (phase x) = (atan (imagpart x) (realpart x)) +

    +

    Examples::

    + +
    +
     (phase 1) ⇒  0.0s0
+ (phase 0) ⇒  0.0s0
+ (phase (cis 30)) ⇒  -1.4159266
+ (phase #c(0 1)) ⇒  1.5707964
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if its argument is not a number. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    Rule of Float Substitutability +

    + + + + + diff --git a/info/gcl/pi.html b/info/gcl/pi.html new file mode 100644 index 0000000..71ad1b4 --- /dev/null +++ b/info/gcl/pi.html @@ -0,0 +1,82 @@ + + + + + +pi (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.22 pi [Constant Variable]

    + +

    Value::

    + +

    an implementation-dependent long float. +

    +

    Description::

    + +

    The best long float approximation to the mathematical constant \pi. +

    +

    Examples::

    + +
    +
     ;; In each of the following computations, the precision depends 
+ ;; on the implementation.  Also, if `long float' is treated by 
+ ;; the implementation as equivalent to some other float format 
+ ;; (e.g., `double float') the exponent marker might be the marker
+ ;; for that equivalent (e.g., `D' instead of `L').
+ pi ⇒  3.141592653589793L0
+ (cos pi) ⇒  -1.0L0
+
+ (defun sin-of-degrees (degrees)
+   (let ((x (if (floatp degrees) degrees (float degrees pi))))
+     (sin (* x (/ (float pi x) 180)))))
+
    + +

    Notes::

    + +

    An approximation to \pi in some other precision can be obtained +by writing (float pi x), where x is a float of the +desired precision, or by writing (coerce pi type), +where type is the desired type, such as short-float. +

    + + + + + diff --git a/info/gcl/pop.html b/info/gcl/pop.html new file mode 100644 index 0000000..f0f8364 --- /dev/null +++ b/info/gcl/pop.html @@ -0,0 +1,104 @@ + + + + + +pop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.20 pop [Macro]

    + +

    pop place ⇒ element +

    +

    Arguments and Values::

    + +

    place—a place, the value of which is a list + (possibly, but necessarily, a dotted list or circular list). +

    +

    element—an object (the car of the contents of place). +

    +

    Description::

    + +

    pop reads the value of place, +remembers the car of the list which was retrieved, +writes the cdr of the list back into the place, +and finally yields the car of the originally retrieved list. +

    +

    For information about the evaluation of subforms of place, +see Evaluation of Subforms to Places. +

    +

    Examples::

    + +
    +
     (setq stack '(a b c)) ⇒  (A B C)
+ (pop stack) ⇒  A  
+ stack ⇒  (B C)
+ (setq llst '((1 2 3 4))) ⇒  ((1 2 3 4))
+ (pop (car llst)) ⇒  1
+ llst ⇒  ((2 3 4))
+
    + +

    Side Effects::

    + +

    The contents of place are modified. +

    +

    See Also::

    + +

    push +, +pushnew +, +Generalized Reference +

    +

    Notes::

    + +

    The effect of (pop place) is roughly equivalent to +

    +
    +
     (prog1 (car place) (setf place (cdr place)))
+
    + +

    except that the latter would evaluate any subforms of place +three times, while pop evaluates them only once. +

    + + + + + diff --git a/info/gcl/position.html b/info/gcl/position.html new file mode 100644 index 0000000..4306743 --- /dev/null +++ b/info/gcl/position.html @@ -0,0 +1,129 @@ + + + + + +position (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.15 position, position-if, position-if-not [Function]

    + +

    position item sequence &key from-end test test-not start end key ⇒ position +

    +

    position-if predicate sequence &key from-end start end key ⇒ position +

    +

    position-if-not predicate sequence &key from-end start end key ⇒ position +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    sequence—a proper sequence. +

    +

    predicate—a designator for a function of one argument + that returns a generalized boolean. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start, end—bounding index designators of sequence. + The defaults for start and end are 0 and nil, respectively. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    position—a bounding index of sequence, or nil. +

    +

    Description::

    + +

    position, position-if, and position-if-not +each search sequence for an element that satisfies the test. +

    +

    The position returned is the index within sequence + of the leftmost (if from-end is true) + or of the rightmost (if from-end is false) +element that satisfies the test; +otherwise nil is returned. +The index returned is relative to the left-hand end of the entire sequence, +regardless of the value of start, end, or from-end. +

    +

    Examples::

    + +
    +
     (position #\a "baobab" :from-end t) ⇒  4
+ (position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car) ⇒  2
+ (position 595 '()) ⇒  NIL
+ (position-if-not #'integerp '(1 2 3 4 5.0)) ⇒  4 
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    find +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +

    The function position-if-not is deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/pprint_002ddispatch.html b/info/gcl/pprint_002ddispatch.html new file mode 100644 index 0000000..011ab23 --- /dev/null +++ b/info/gcl/pprint_002ddispatch.html @@ -0,0 +1,101 @@ + + + + + +pprint-dispatch (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.3 pprint-dispatch [Function]

    + +

    pprint-dispatch object &optional table ⇒ function, found-p +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    table—a pprint dispatch table, or nil. + The default is the value of *print-pprint-dispatch*. +

    +

    function—a function designator. +

    +

    found-p—a generalized boolean. +

    +

    Description::

    + +

    Retrieves the highest priority function in table that is +associated with a type specifier that matches object. +The function is chosen by finding all of the type specifiers in table +that match the object and +selecting the highest priority function associated with any of these +type specifiers. If there is more than one highest priority function, +an arbitrary choice is made. If no type specifiers match the +object, a function is returned that prints object +

    +

    using print-object. +

    +

    The secondary value, found-p, is true if a matching +type specifier was found in table, or false otherwise. +

    +

    If table is nil, +retrieval is done in the +initial pprint dispatch table. +

    +

    Affected By::

    + +

    The state of the table. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error if table is neither a +pprint-dispatch-table nor nil. +

    +

    Notes::

    + +
    +
    (let ((*print-pretty* t))
+  (write object :stream s))
+≡ (funcall (pprint-dispatch object) s object)
+
    + + + + + + diff --git a/info/gcl/pprint_002dexit_002dif_002dlist_002dexhausted.html b/info/gcl/pprint_002dexit_002dif_002dlist_002dexhausted.html new file mode 100644 index 0000000..ccfaa74 --- /dev/null +++ b/info/gcl/pprint_002dexit_002dif_002dlist_002dexhausted.html @@ -0,0 +1,89 @@ + + + + + +pprint-exit-if-list-exhausted (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.4 pprint-exit-if-list-exhausted [Local Macro]

    + +

    Syntax::

    + +

    pprint-exit-if-list-exhausted <no arguments> ⇒ nil +

    +

    Description::

    + +

    Tests whether or not the list passed to +the lexically current logical block +has been exhausted; see Dynamic Control of the Arrangement of Output. +If this list has been +reduced to nil, pprint-exit-if-list-exhausted terminates the execution +of the lexically current logical block except for the printing +of the suffix. Otherwise pprint-exit-if-list-exhausted returns nil. +

    +

    Whether or not pprint-exit-if-list-exhausted is fbound in the +global environment is implementation-dependent; +however, the restrictions on redefinition and shadowing of +pprint-exit-if-list-exhausted are the same as for symbols in the COMMON-LISP package +which are fbound in the global environment. +The consequences of attempting to use pprint-exit-if-list-exhausted outside +of pprint-logical-block are undefined. +

    +

    Exceptional Situations::

    + +

    An error is signaled (at macro expansion time or at run time) if +pprint-exit-if-list-exhausted is used anywhere other than +lexically within a call on pprint-logical-block. +Also, the consequences of executing pprint-if-list-exhausted outside +of the dynamic extent of the pprint-logical-block which lexically +contains it are undefined. +

    +

    See Also::

    + +

    pprint-logical-block +, +pprint-pop +. +

    + + + + + diff --git a/info/gcl/pprint_002dfill.html b/info/gcl/pprint_002dfill.html new file mode 100644 index 0000000..6212b0a --- /dev/null +++ b/info/gcl/pprint_002dfill.html @@ -0,0 +1,161 @@ + + + + + +pprint-fill (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.5 pprint-fill, pprint-linear, pprint-tabular [Function]

    + +

    pprint-fill stream object &optional colon-p at-sign-p ⇒ nil +

    +

    pprint-linear stream object &optional colon-p at-sign-p ⇒ nil +

    +

    pprint-tabular stream object &optional colon-p at-sign-p tabsize ⇒ nil +

    +

    Arguments and Values::

    + +

    stream—an output stream designator. +

    +

    object—an object. +

    +

    colon-p—a generalized boolean. + The default is true. +

    +

    at-sign-p—a generalized boolean. + The default is implementation-dependent. +

    +

    tabsize—a non-negative integer. + The default is 16. +

    +

    Description::

    + +

    The functions pprint-fill, pprint-linear, and +pprint-tabular specify particular ways of pretty printing +a list to stream. +Each function prints parentheses around the output if and only +if colon-p is true. +Each function ignores its at-sign-p argument. +(Both arguments are included even though only one is needed +so that these functions can be used via ~/.../ +and as set-pprint-dispatch functions, as well as directly.) +Each function handles abbreviation and the detection of circularity +and sharing correctly, and uses write to print object +when it is a non-list. +

    +

    If object is a list and +if the value of *print-pretty* is false, +each of these functions prints object +using a minimum of whitespace, +as described in Printing Lists and Conses. +Otherwise (if object is a list and + if the value of *print-pretty* is true): +

    +
    +
    *
    +

    The function pprint-linear prints a list either all on one line, +or with each element on a separate line. +

    +
    +
    *
    +

    The function pprint-fill prints a list with as many elements +as possible on each line. +

    +
    +
    *
    +

    The function pprint-tabular is the same as pprint-fill +except that it prints the elements so that they line up in columns. +The tabsize specifies the column spacing in ems, +which is the total spacing from the leading edge of one column to +the leading edge of the next. +

    +
    + +

    Examples::

    + +

    Evaluating the following with a line length of 25 produces the output shown. +

    +
    +
    (progn (princ "Roads ") 
+       (pprint-tabular *standard-output* '(elm main maple center) nil nil 8))
+Roads ELM     MAIN
+      MAPLE   CENTER
+
    + +

    Side Effects::

    + +

    Performs output to the indicated stream. +

    +

    Affected By::

    + +

    The cursor position on the indicated stream, if it can be determined. +

    +

    Notes::

    + +

    The function pprint-tabular could be defined as follows: +

    +
    +
    (defun pprint-tabular (s list &optional (colon-p t) at-sign-p (tabsize nil))
+  (declare (ignore at-sign-p))
+  (when (null tabsize) (setq tabsize 16))
+  (pprint-logical-block (s list :prefix (if colon-p "(" "")
+                                :suffix (if colon-p ")" ""))
+    (pprint-exit-if-list-exhausted)
+    (loop (write (pprint-pop) :stream s)
+          (pprint-exit-if-list-exhausted)
+          (write-char #\Space s)
+          (pprint-tab :section-relative 0 tabsize s)
+          (pprint-newline :fill s))))
+
    + +

    Note that it would have been inconvenient to specify this function +using format, because of the need to pass its tabsize argument +through to a ~:T format directive nested within an iteration over a list. +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/pprint_002dindent.html b/info/gcl/pprint_002dindent.html new file mode 100644 index 0000000..9930fe0 --- /dev/null +++ b/info/gcl/pprint_002dindent.html @@ -0,0 +1,101 @@ + + + + + +pprint-indent (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.6 pprint-indent [Function]

    + +

    pprint-indent relative-to n &optional stream ⇒ nil +

    +

    Arguments and Values::

    + +

    relative-to—either :block or :current. +

    +

    n—a real. +

    +

    stream—an output stream designator. + The default is standard output. +

    +

    Description::

    + +

    pprint-indent specifies the indentation to use in a logical block on stream. +

    +

    If stream is a pretty printing stream + and the value of *print-pretty* is true, +pprint-indent sets the indentation in the innermost +dynamically enclosing logical block; +otherwise, pprint-indent has no effect. +

    +

    N specifies the indentation in +ems. If relative-to is :block, the indentation is set +to the horizontal position of the first character in the dynamically current logical block plus n +ems. If relative-to is :current, the indentation is set +to the current output position plus n ems. (For robustness +in the face of variable-width fonts, it is advisable to use :current +with an n of zero whenever possible.) +

    +

    N can be negative; +however, the total indentation cannot be moved +left of the beginning of the line +or left of the end of the rightmost per-line prefix—an attempt to move beyond +one of these limits is treated +the same as an attempt to move to that limit. +Changes in indentation caused by pprint-indent +do not take effect until after the next line break. In addition, in +miser mode all calls to pprint-indent are ignored, forcing the lines +corresponding to the logical block to line up under the first character in +the block. +

    +

    Exceptional Situations::

    + +

    An error is signaled if relative-to is any object other +than :block or :current. +

    +

    See Also::

    + +

    Tilde I-> Indent +

    + + + + + diff --git a/info/gcl/pprint_002dlogical_002dblock.html b/info/gcl/pprint_002dlogical_002dblock.html new file mode 100644 index 0000000..c2fb565 --- /dev/null +++ b/info/gcl/pprint_002dlogical_002dblock.html @@ -0,0 +1,196 @@ + + + + + +pprint-logical-block (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.7 pprint-logical-block [Macro]

    + +

    pprint-logical-block (stream-symbol object + &key prefix per-line-prefix suffix) + {declaration}* {form}*
    + ⇒ nil +

    +

    Arguments and Values::

    + +

    stream-symbol—a stream variable designator. +

    +

    object—an object; evaluated. +

    +

    :prefix—a string; evaluated. + Complicated defaulting behavior; see below. +

    +

    :per-line-prefix—a string; evaluated. + Complicated defaulting behavior; see below. +

    +

    :suffix—a string; evaluated. + The default is the null string. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    Description::

    + +

    Causes printing to be grouped into a logical block. +

    +

    The logical block is printed to the stream that is the value +of the variable denoted by stream-symbol. +During the execution of the forms, +that variable is bound to a pretty printing stream +that supports decisions about the arrangement of output +and then forwards the output to the destination stream. +

    +

    All the standard printing functions + (e.g., write, + princ, + and terpri) +can be used to print output to the pretty printing stream. +All and only the output sent to this pretty printing stream +is treated as being in the logical block. +

    +

    The prefix specifies a prefix to be printed before the beginning of +the logical block. +The per-line-prefix specifies a prefix that is printed before the block +and at the beginning of each new line in the block. +The :prefix and :pre-line-prefix arguments are mutually exclusive. +If neither :prefix nor :per-line-prefix is specified, +a prefix of the null string is assumed. +

    +

    The suffix specifies a suffix that is printed just after the logical block. +

    +

    The object is +normally +a list that the body forms are responsible for printing. +If object is not a list, +it is printed using write. +(This makes it easier to write printing functions that are robust + in the face of malformed arguments.) +If *print-circle* +is non-nil and object is a circular (or shared) reference to a cons, +then an appropriate “#n#” marker is printed. (This +makes it easy to write printing functions that provide full support +for circularity and sharing abbreviation.) If *print-level* is not +nil and the logical block is at a dynamic nesting depth of greater +than *print-level* in logical blocks, “#” is printed. +(This makes easy to write printing functions that provide full support for depth +abbreviation.) +

    +

    If either of the three conditions above occurs, the indicated output is +printed on stream-symbol and the body forms are skipped +along with the printing of the :prefix and :suffix. +(If the body forms are not to be responsible for printing a list, +then the first two tests above can be turned off by supplying nil for +the object argument.) +

    +

    In addition to the object argument of pprint-logical-block, +the arguments of the standard printing functions (such as write, +print, prin1, and pprint, as well as the arguments +of the standard format directives such as ~A, ~S, +(and ~W) are all checked (when necessary) for circularity and sharing. +However, such checking is not applied to the arguments of the +functions write-line, write-string, and write-char +or to the literal text output by format. A consequence of this is +that you must use one of the latter functions if you want to print some +literal text in the output that is not supposed to be checked for circularity +or sharing. +

    +

    The body forms of a pprint-logical-block form +must not perform any side-effects on the surrounding environment; for +example, no variables must be assigned which have not been +bound within its scope. +

    +

    The pprint-logical-block macro may be used regardless of the value of *print-pretty*. +

    +

    Affected By::

    + +

    *print-circle*, *print-level*. +

    +

    Exceptional Situations::

    + +

    An error of type type-error is signaled if any of the :suffix, +:prefix, or :per-line-prefix is supplied but does not evaluate +to a string. +

    +

    An error is signaled if :prefix and :pre-line-prefix are both used. +

    +

    pprint-logical-block and the pretty printing stream it creates +have dynamic extent. The consequences are undefined if, outside +of this extent, output is attempted to the pretty printing stream it creates. +

    +

    It is also unspecified what happens if, within this extent, any output is +sent directly to the underlying destination stream. +

    +

    See Also::

    + +

    pprint-pop +, +pprint-exit-if-list-exhausted +, +Tilde Less-Than-Sign-> Logical Block +

    +

    Notes::

    + +

    One reason for using the pprint-logical-block macro when the value of *print-pretty* +is nil would be to allow it to perform checking for dotted lists, +as well as (in conjunction with pprint-pop) +checking for *print-level* or *print-length* being exceeded. +

    +

    Detection of circularity and sharing is supported by the pretty printer +by in essence performing requested output twice. On the first pass, +circularities and sharing are detected and the actual outputting of characters +is suppressed. On the second pass, the appropriate “#n=” +and “#n#” markers are inserted and characters are output. +This is why the restriction on side-effects is necessary. +Obeying this restriction is facilitated by using pprint-pop, +instead of an ordinary pop when traversing a list being printed by +the body forms of the pprint-logical-block form.) +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/pprint_002dnewline.html b/info/gcl/pprint_002dnewline.html new file mode 100644 index 0000000..41eda68 --- /dev/null +++ b/info/gcl/pprint_002dnewline.html @@ -0,0 +1,184 @@ + + + + + +pprint-newline (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.8 pprint-newline [Function]

    + +

    pprint-newline kind &optional stream ⇒ nil +

    +

    Arguments and Values::

    + +

    kind—one of :linear, :fill, :miser, or :mandatory. +

    +

    stream—a stream designator. + The default is standard output. +

    +

    Description::

    + +

    If stream is a pretty printing stream + and the value of *print-pretty* is true, +a line break is inserted in the output +when the appropriate condition below is satisfied; +otherwise, pprint-newline has no effect. +

    +

    Kind specifies the style of conditional newline. +This parameter is treated as follows: +

    +
    +
    :linear
    +

    This specifies a +“linear-style” conditional newline. + +

    +

    A line break is inserted +if and only if the immediately containing section +cannot be printed on one line. +The effect of this is that line breaks are +either inserted at every linear-style conditional newline in a logical block +or at none of them. +

    +
    +
    :miser
    +

    This specifies a +“miser-style” conditional newline. + +

    +

    A line break is inserted +if and only if the immediately containing section +cannot be printed on one line +and miser style is in effect in the immediately containing logical block. +The effect of this is that miser-style conditional newlines +act like linear-style conditional newlines, +but only when miser style is in effect. +Miser style is in effect for a logical block if and only if +the starting position of the logical block +is less than or equal to +*print-miser-width* ems from the right margin. +

    +
    +
    :fill
    +

    This specifies a +“fill-style” conditional newline. + +

    +

    A line break is inserted if and only if +either (a) the following section cannot be printed + on the end of the current line, + (b) the preceding section was not printed on a single line, + or (c) the immediately containing section cannot + be printed on one line and miser style is in effect + in the immediately containing logical block. +If a logical block is broken up into a number of subsections +by fill-style conditional newlines, +the basic effect is that the logical block +is printed with as many subsections as possible on each line. +However, if miser style is in effect, +fill-style conditional newlines act like linear-style conditional newlines. +

    +
    +
    :mandatory
    +

    This specifies a +“mandatory-style” conditional newline. + +

    +

    A line break is always inserted. +This implies that none of the containing sections +can be printed on a single line and +will therefore trigger the insertion of line breaks +at linear-style conditional newlines in these sections. +

    +
    +
    + +

    When a line break is inserted by any type of conditional newline, +any blanks that immediately precede the conditional newline are omitted +from the output and indentation is introduced at the beginning of the next line. +By default, the indentation causes the following line to begin +in the same horizontal position +as the first character in the immediately containing logical block. +(The indentation can be changed via pprint-indent.) +

    +

    There are a variety of ways unconditional newlines can be introduced into +the output (i.e., via terpri or by printing a string containing a newline +character). As with mandatory conditional newlines, this prevents any of +the containing sections from being printed on one line. In general, when +an unconditional newline is encountered, it is printed out without +suppression of the preceding blanks and without any indentation following +it. However, if a per-line prefix has been specified (see +pprint-logical-block), this prefix will always be printed no matter +how a newline originates. +

    +

    Examples::

    + +

    See Examples of using the Pretty Printer. +

    +

    Side Effects::

    + +

    Output to stream. +

    +

    Affected By::

    + +

    *print-pretty*, *print-miser*. +The presence of containing logical blocks. +The placement of newlines and conditional newlines. +

    +

    Exceptional Situations::

    + +

    An error of type type-error is signaled if kind +is not one of :linear, :fill, :miser, or :mandatory. +

    +

    See Also::

    + +

    Tilde Underscore-> Conditional Newline, +Examples of using the Pretty Printer +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/pprint_002dpop.html b/info/gcl/pprint_002dpop.html new file mode 100644 index 0000000..7f41ab0 --- /dev/null +++ b/info/gcl/pprint_002dpop.html @@ -0,0 +1,152 @@ + + + + + +pprint-pop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.9 pprint-pop [Local Macro]

    + +

    Syntax::

    + +

    pprint-pop <no arguments> ⇒ object +

    +

    Arguments and Values::

    + +

    object—an element of the list + being printed in the lexically current logical block, + or nil. +

    +

    Description::

    + +

    Pops one element from the list being printed +in the lexically current logical block, obeying *print-length* +and *print-circle* as described below. +

    +

    Each time pprint-pop is called, it pops the next value off the +list passed to the lexically current logical block and returns it. +However, before doing this, it performs three tests: +

    +
    +
    *
    +

    If the remaining ‘list’ is not a list, + “. ” is printed followed by the remaining ‘list.’ + (This makes it easier to write printing functions that + are robust in the face of malformed arguments.) +

    +
    +
    *
    +

    If *print-length* is non-nil, + and pprint-pop has already been called *print-length* times + within the immediately containing logical block, + “...” is printed. + (This makes it easy to write printing functions that properly handle + *print-length*.) +

    +
    +
    *
    +

    If *print-circle* is + non-nil, and the remaining list is a circular (or shared) reference, + then “. ” is printed followed by an appropriate + “#n#” marker. + (This catches instances of cdr circularity and sharing in lists.) +

    +
    + +

    If either of the three conditions above occurs, the indicated output is +printed on the pretty printing stream created by the immediately containing +pprint-logical-block and the execution of the immediately containing +pprint-logical-block is terminated except for the printing of the suffix. +

    +

    If pprint-logical-block is given a ‘list’ argument of nil—because +it is not processing a list—pprint-pop can still be used to obtain +support for *print-length*. +In this situation, the first and third tests above are disabled and +pprint-pop always returns nil. +See Examples of using the Pretty Printer—specifically, the pprint-vector example. +

    +

    Whether or not pprint-pop is fbound in the +global environment is implementation-dependent; +however, the restrictions on redefinition and shadowing of +pprint-pop are the same as for symbols in the COMMON-LISP package +which are fbound in the global environment. +The consequences of attempting to use pprint-pop outside +of pprint-logical-block are undefined. +

    +

    Side Effects::

    + +

    Might cause output +to the pretty printing stream associated with the lexically current logical block. +

    +

    Affected By::

    + +

    *print-length*, *print-circle*. +

    +

    Exceptional Situations::

    + +

    An error is signaled (either at macro expansion time or at run time) +if a usage of pprint-pop occurs where there is no lexically +containing pprint-logical-block form. +

    +

    The consequences are undefined if pprint-pop is executed outside +of the dynamic extent of this pprint-logical-block. +

    +

    See Also::

    + +

    pprint-exit-if-list-exhausted +, +pprint-logical-block +. +

    +

    Notes::

    + +

    It is frequently a good idea to call pprint-exit-if-list-exhausted +before calling pprint-pop. +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/pprint_002dtab.html b/info/gcl/pprint_002dtab.html new file mode 100644 index 0000000..695b787 --- /dev/null +++ b/info/gcl/pprint_002dtab.html @@ -0,0 +1,95 @@ + + + + + +pprint-tab (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.10 pprint-tab [Function]

    + +

    pprint-tab kind colnum colinc &optional stream ⇒ nil +

    +

    Arguments and Values::

    + +

    kind—one of :line, :section, :line-relative, + or :section-relative. +

    +

    colnum—a non-negative integer. +

    +

    colinc—a non-negative integer. +

    +

    stream—an output stream designator. +

    +

    Description::

    + +

    Specifies tabbing to stream as performed by the standard ~T format directive. +

    +

    If stream is a pretty printing stream and + the value of *print-pretty* is true, +

    +

    tabbing is performed; +otherwise, pprint-tab has no effect. +

    +

    The arguments colnum and colinc correspond to the two +parameters to ~T and are in terms of ems. +The kind argument specifies the style of tabbing. It must be one of + :line (tab as by ~T), + :section (tab as by ~:T, + but measuring horizontal positions relative to + the start of the dynamically enclosing section), + :line-relative (tab as by ~@T), or + :section-relative (tab as by ~:@T, + but measuring horizontal positions relative to + the start of the dynamically enclosing section). +

    +

    Exceptional Situations::

    + +

    An error is signaled if kind is not one of :line, +:section, :line-relative, or :section-relative. +

    +

    See Also::

    + +

    pprint-logical-block +

    + + + + + diff --git a/info/gcl/print_002dnot_002dreadable.html b/info/gcl/print_002dnot_002dreadable.html new file mode 100644 index 0000000..75624a2 --- /dev/null +++ b/info/gcl/print_002dnot_002dreadable.html @@ -0,0 +1,72 @@ + + + + + +print-not-readable (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.29 print-not-readable [Condition Type]

    + +

    Class Precedence List::

    +

    print-not-readable, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type print-not-readable consists of error conditions that occur during +output while *print-readably* is true, as a result of attempting +to write a printed representation with the Lisp printer +that would not be correctly read back with the Lisp reader. +The object which could not be printed is initialized by +the :object initialization argument to make-condition, and is accessed by +the function print-not-readable-object. +

    +

    See Also::

    + +

    print-not-readable-object +

    + + + + + diff --git a/info/gcl/print_002dnot_002dreadable_002dobject.html b/info/gcl/print_002dnot_002dreadable_002dobject.html new file mode 100644 index 0000000..17ca7b2 --- /dev/null +++ b/info/gcl/print_002dnot_002dreadable_002dobject.html @@ -0,0 +1,69 @@ + + + + + +print-not-readable-object (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.30 print-not-readable-object [Function]

    + +

    print-not-readable-object condition ⇒ object +

    +

    Arguments and Values::

    + +

    condition—a condition of type print-not-readable. +

    +

    object—an object. +

    +

    Description::

    + +

    Returns the object that could not be printed readably +in the situation represented by condition. +

    +

    See Also::

    + +

    print-not-readable, +Conditions +

    + + + + + diff --git a/info/gcl/print_002dobject.html b/info/gcl/print_002dobject.html new file mode 100644 index 0000000..9eea3ad --- /dev/null +++ b/info/gcl/print_002dobject.html @@ -0,0 +1,210 @@ + + + + + +print-object (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.11 print-object [Standard Generic Function]

    + +

    Syntax::

    + +

    print-object object stream ⇒ object +

    +

    Method Signatures::

    + +

    print-object (object standard-object) stream +

    +

    print-object (object structure-object) stream +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    stream—a stream. +

    +

    Description::

    + +

    The generic function print-object writes the printed representation of object +to stream. +The function print-object is called by the Lisp printer; +it should not be called by the user. +

    +

    Each implementation is required to provide a method on +the class standard-object and on the class structure-object. +In addition, each implementation must provide +methods on enough other classes +so as to ensure that there is always an applicable method. +Implementations are free to add methods for other classes. +Users may write methods for print-object for their own +classes if they do not wish to inherit an +implementation-dependent method. +

    +

    The method on the class structure-object prints the object in the +default #S notation; see Printing Structures. +

    +

    Methods on print-object are responsible for implementing +their part of the semantics of the printer control variables, as follows: +

    +
    +
    *print-readably*
    +

    All methods for print-object must obey *print-readably*. +This includes both user-defined methods and implementation-defined methods. +Readable printing of structures and standard objects +is controlled by their print-object method, +not by their make-load-form method. +Similarity for these objects is application dependent +and hence is defined to be whatever these methods do; +see Similarity of Literal Objects. +

    +
    +
    *print-escape*
    +

    Each method must implement *print-escape*. +

    +
    +
    *print-pretty*
    +
    +

    The method may wish to perform specialized line breaking +or other output conditional on the value of *print-pretty*. +For further information, +see (for example) the macro pprint-fill. +See also Pretty Print Dispatch Tables and Examples of using the Pretty Printer. +

    +
    +
    *print-length*
    +

    Methods that produce output of indefinite length must obey +*print-length*. +

    +

    For further information, +see (for example) the macros pprint-logical-block +and pprint-pop. +See also Pretty Print Dispatch Tables and Examples of using the Pretty Printer. +

    +
    +
    *print-level*
    +

    The printer takes care of *print-level* automatically, +provided that each method handles exactly one level of structure and +calls write (or an equivalent function) recursively if +there are more structural levels. The printer’s decision of whether an +object has components (and therefore should not be printed when the +printing depth is not less than *print-level*) is +implementation-dependent. In some implementations its +print-object method is not called; +in others the method is called, +and the determination that the object has components is based on what +it tries to write to the stream. +

    +
    +
    *print-circle*
    +
    +

    When the value of *print-circle* is true, +a user-defined +

    +

    print-object method +

    +

    can print objects to the supplied stream +using write, + prin1, + princ, + or format +and expect circularities to be detected +and printed using the #n# syntax. +If a user-defined +

    +

    print-object method +

    +

    prints to a stream other than the one +that was supplied, then circularity detection starts over for that +stream. See *print-circle*. +

    +
    +
    *print-base*,
    +

    *print-radix*, + *print-case*, + *print-gensym*, + and *print-array* +These printer control variables apply to specific types of objects +and are handled by the methods for those objects. +

    +
    +
    + +

    If these rules are not obeyed, the results are undefined. +

    +

    In general, the printer and the print-object methods should not +rebind the print control variables as they operate recursively through the +structure, but this is implementation-dependent. +

    +

    In some implementations the stream argument passed to a +print-object method is not the original stream, +but is an intermediate stream that implements part of the printer. +methods should therefore not depend on the identity of this stream. +

    +

    See Also::

    + +

    pprint-fill +, +pprint-logical-block +, +pprint-pop +, +write +, +*print-readably*, +*print-escape*, +*print-pretty*, +*print-length*, +Default Print-Object Methods, +

    +

    Printing Structures, +

    +

    Pretty Print Dispatch Tables, +Examples of using the Pretty Printer +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/print_002dunreadable_002dobject.html b/info/gcl/print_002dunreadable_002dobject.html new file mode 100644 index 0000000..260582f --- /dev/null +++ b/info/gcl/print_002dunreadable_002dobject.html @@ -0,0 +1,106 @@ + + + + + +print-unreadable-object (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.12 print-unreadable-object [Macro]

    + +

    print-unreadable-object (object stream &key type identity) {form}* ⇒ nil +

    +

    Arguments and Values::

    + +

    object—an object; evaluated. +

    +

    stream— +a stream designator; evaluated. +

    +

    type—a generalized boolean; evaluated. +

    +

    identity—a generalized boolean; evaluated. +

    +

    forms—an implicit progn. +

    +

    Description::

    + +

    Outputs a printed representation of object on stream, +beginning with “#<” and ending with “>”. +Everything output to stream by the body forms +is enclosed in the the angle brackets. +If type is true, the output from forms +is preceded by a brief description of the object’s +type and a space character. +If identity is true, +the output from forms is followed by a space character +and a representation of the object’s identity, +typically a storage address. +

    +

    If either type or identity is not supplied, +its value is false. It is valid to omit the body forms. +If type and identity are both true and there are no +body forms, only one space character separates the type +and the identity. +

    +

    Examples::

    + +

    ;; Note that in this example, the precise form of the output +;; is implementation-dependent. +

    +
    +
     (defmethod print-object ((obj airplane) stream)
+   (print-unreadable-object (obj stream :type t :identity t)
+     (princ (tail-number obj) stream)))
+
+ (prin1-to-string my-airplane)
+⇒  "#<Airplane NW0773 36000123135>"
+OR⇒ "#<FAA:AIRPLANE NW0773 17>"
+
    + +

    Exceptional Situations::

    + +

    If *print-readably* is true, print-unreadable-object +signals an error of type print-not-readable without printing anything. +

    + + + + + diff --git a/info/gcl/probe_002dfile.html b/info/gcl/probe_002dfile.html new file mode 100644 index 0000000..68cb8c9 --- /dev/null +++ b/info/gcl/probe_002dfile.html @@ -0,0 +1,100 @@ + + + + + +probe-file (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.2 probe-file [Function]

    + +

    probe-file pathspec ⇒ truename +

    +

    Arguments and Values::

    + +

    pathspec—a pathname designator. +

    +

    truename—a physical pathname or nil. +

    +

    Description::

    + +

    probe-file tests whether a file exists. +

    +

    probe-file returns false if there is no file named pathspec, +and otherwise returns the truename of pathspec. +

    +

    If the pathspec designator is an open stream, +then probe-file produces the truename of its associated file. +

    +

    If pathspec is a stream, whether open or closed, +it is coerced to a pathname as if by the function pathname. +

    +

    Affected By::

    + +

    The host computer’s file system. +

    +

    Exceptional Situations::

    + +

    An error of type file-error is signaled if pathspec is wild. +

    +

    An error of type file-error is signaled +if the file system cannot perform the requested operation. +

    +

    See Also::

    + +

    truename +, +open +, +ensure-directories-exist +, +pathname, +

    +

    logical-pathname, +

    +

    File System Concepts, +File Operations on Open and Closed Streams, +

    +

    Pathnames as Filenames +

    + + + + + diff --git a/info/gcl/proclaim.html b/info/gcl/proclaim.html new file mode 100644 index 0000000..41c41f3 --- /dev/null +++ b/info/gcl/proclaim.html @@ -0,0 +1,134 @@ + + + + + +proclaim (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.16 proclaim [Function]

    + +

    proclaim declaration-specifier ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    declaration-specifier—a declaration specifier. +

    +

    Description::

    + +

    Establishes the declaration specified by declaration-specifier +in the global environment. +

    +

    Such a declaration, sometimes called a global declaration +or a proclamation, is always in force unless locally shadowed. +

    +

    Names of variables and functions within +declaration-specifier refer to dynamic variables +and global function definitions, respectively. +

    +

    Figure 3–22 shows a list of declaration identifiers +that can be used with proclaim. +

    +
    +
      declaration  inline     optimize  type  
+  ftype        notinline  special         
+
+  Figure 3–22: Global Declaration Specifiers
+
+
    + +

    An implementation is free to support other (implementation-defined) +declaration identifiers as well. +

    +

    Examples::

    + +
    +
     (defun declare-variable-types-globally (type vars)
+   (proclaim `(type ,type ,@vars))
+   type)
+
+ ;; Once this form is executed, the dynamic variable *TOLERANCE*
+ ;; must always contain a float.
+ (declare-variable-types-globally 'float '(*tolerance*))
+⇒  FLOAT
+
    + +

    See Also::

    + +

    declaim +, +declare, +Compilation +

    +

    Notes::

    + +

    Although the execution of a proclaim form +has effects that might affect compilation, the compiler does not make +any attempt to recognize and specially process proclaim forms. +A proclamation such as the following, even if a top level form, +does not have any effect until it is executed: +

    +
    +
    (proclaim '(special *x*))
+
    + +

    If compile time side effects are desired, eval-when may be useful. +For example: +

    +
    +
     (eval-when (:execute :compile-toplevel :load-toplevel)
+   (proclaim '(special *x*)))
+
    + +

    In most such cases, however, it is preferrable to use declaim for +this purpose. +

    +

    Since proclaim forms are ordinary function forms, +macro forms can expand into them. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/prog.html b/info/gcl/prog.html new file mode 100644 index 0000000..269fa03 --- /dev/null +++ b/info/gcl/prog.html @@ -0,0 +1,202 @@ + + + + + +prog (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.57 prog, prog* [Macro]

    + +

    prog ({var | + (var [init-form])}*) + {declaration}* + {tag | statement}*
    + ⇒ {result}* +

    +

    prog* ({var | + (var [init-form])}*) + {declaration}* + {tag | statement}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—variable name. +

    +

    init-form—a form. +

    +

    declaration—a declare expression; not evaluated. +

    +

    tag—a go tag; not evaluated. +

    +

    statement—a compound form; evaluated as described below. +

    +

    results—nil if a normal return occurs, + or else, if an explicit return occurs, the values that were transferred. +

    +

    Description::

    + +

    Three distinct operations are performed by prog and +prog*: +they bind local variables, +they permit use of the return +statement, and they permit use of the go +statement. +A typical prog looks like this: +

    +
    +
     (prog (var1 var2 (var3 init-form-3) var4 (var5 init-form-5))
+       {declaration}*
+       statement1
+  tag1
+       statement2
+       statement3
+       statement4
+  tag2
+       statement5
+       ...
+       )
+
    + +

    For prog, +init-forms are evaluated first, in the order in which they are +supplied. The vars are then bound to the corresponding values in +parallel. If no init-form +is supplied for a given var, +that var is bound to nil. +

    +

    The body of prog is executed as if it were a tagbody form; +the go statement can be used to transfer control +to a tag. +Tags label statements. +

    +

    prog implicitly establishes a block named nil around +the entire prog form, so that return can be used +at any time to exit from the prog form. +

    +

    The difference between prog* and prog is that +in prog* the binding and initialization of the vars +is done sequentially, so that the init-form for each +one can use the values of previous ones. +

    +

    Examples::

    +
    +
    (prog* ((y z) (x (car y)))
+       (return x))
+
    + +

    returns the car of the value of z. +

    +
    +
     (setq a 1) ⇒  1
+ (prog ((a 2) (b a)) (return (if (= a b) '= '/=))) ⇒  /=
+ (prog* ((a 2) (b a)) (return (if (= a b) '= '/=))) ⇒  =
+ (prog () 'no-return-value) ⇒  NIL
+
    + +
    +
     (defun king-of-confusion (w)
+   "Take a cons of two lists and make a list of conses.
+    Think of this function as being like a zipper."
+   (prog (x y z)          ;Initialize x, y, z to NIL
+        (setq y (car w) z (cdr w))
+    loop
+        (cond ((null y) (return x))
+              ((null z) (go err)))
+    rejoin
+        (setq x (cons (cons (car y) (car z)) x))
+        (setq y (cdr y) z (cdr z))
+        (go loop)
+    err
+        (cerror "Will self-pair extraneous items"
+                "Mismatch - gleep!  ~S" y)
+        (setq z y)
+        (go rejoin))) ⇒  KING-OF-CONFUSION 
+
    + +

    This can be accomplished more perspicuously as follows: +

    +
    +
     (defun prince-of-clarity (w)
+   "Take a cons of two lists and make a list of conses.
+    Think of this function as being like a zipper."
+   (do ((y (car w) (cdr y))
+        (z (cdr w) (cdr z))
+        (x '() (cons (cons (car y) (car z)) x)))
+       ((null y) x)
+     (when (null z)
+       (cerror "Will self-pair extraneous items"
+              "Mismatch - gleep!  ~S" y)
+       (setq z y)))) ⇒  PRINCE-OF-CLARITY 
+
    + +

    See Also::

    + +

    block +, +let +, +tagbody +, +go +, +return +, Evaluation +

    +

    Notes::

    +

    prog can be explained in terms of +block, let, and tagbody as +follows: +

    +
    +
     (prog variable-list declaration . body)
+    ≡ (block nil (let variable-list declaration (tagbody . body)))
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/prog1.html b/info/gcl/prog1.html new file mode 100644 index 0000000..29ea36e --- /dev/null +++ b/info/gcl/prog1.html @@ -0,0 +1,134 @@ + + + + + +prog1 (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.58 prog1, prog2 [Macro]

    + +

    prog 1 ⇒ first-form {form}* + result-1 +prog 2 ⇒ first-form second-form {form}* + result-2 +

    +

    Arguments and Values::

    + +

    first-form—a form; evaluated as described below. +

    +

    second-form—a form; evaluated as described below. +

    +

    forms—an implicit progn; evaluated as described below. +

    +

    result-1—the primary value resulting from + the evaluation of first-form. +

    +

    result-2—the primary value resulting from + the evaluation of second-form. +

    +

    Description::

    + +

    prog1 evaluates first-form + and then forms, +yielding as its only value +the primary value yielded by first-form. +

    +

    prog2 evaluates first-form, + then second-form, + and then forms, +yielding as its only value +the primary value yielded by first-form. +

    +

    Examples::

    + +
    +
     (setq temp 1) ⇒  1
+ (prog1 temp (print temp) (incf temp) (print temp))
+ |>  1
+ |>  2
+⇒  1
+ (prog1 temp (setq temp nil)) ⇒  2
+ temp ⇒  NIL
+ (prog1 (values 1 2 3) 4) ⇒  1 
+ (setq temp (list 'a 'b 'c))
+ (prog1 (car temp) (setf (car temp) 'alpha)) ⇒  A
+ temp ⇒  (ALPHA B C)
+ (flet ((swap-symbol-values (x y)
+          (setf (symbol-value x) 
+                (prog1 (symbol-value y)
+                       (setf (symbol-value y) (symbol-value x))))))
+   (let ((*foo* 1) (*bar* 2))
+     (declare (special *foo* *bar*))
+     (swap-symbol-values '*foo* '*bar*)
+     (values *foo* *bar*)))
+⇒  2, 1
+ (setq temp 1) ⇒  1
+ (prog2 (incf temp) (incf temp) (incf temp)) ⇒  3
+ temp ⇒  4
+ (prog2 1 (values 2 3 4) 5) ⇒  2
+
    + +

    See Also::

    + +

    multiple-value-prog1 +, +progn +

    +

    Notes::

    + +

    prog1 and prog2 are typically used to evaluate +one or more forms with side effects and return a value that +must be computed before some or all of the side effects happen. +

    +
    +
     (prog1 {form}*) ≡ (values (multiple-value-prog1 {form}*))
+ (prog2 form1 {form}*) ≡ (let () form1 (prog1 {form}*))
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/progn.html b/info/gcl/progn.html new file mode 100644 index 0000000..a997f02 --- /dev/null +++ b/info/gcl/progn.html @@ -0,0 +1,98 @@ + + + + + +progn (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.59 progn [Special Operator]

    + +

    progn {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    forms—an implicit progn. +

    +

    results—the values of the forms. +

    +

    Description::

    + +

    progn evaluates forms, +in the order in which they are given. +

    +

    The values of each form but the last are discarded. +

    +

    If progn appears as a top level form, then all forms +within that progn are considered by the compiler to be +top level forms. +

    +

    Examples::

    +
    +
     (progn) ⇒  NIL
+ (progn 1 2 3) ⇒  3
+ (progn (values 1 2 3)) ⇒  1, 2, 3
+ (setq a 1) ⇒  1
+ (if a
+      (progn (setq a nil) 'here)
+      (progn (setq a t) 'there)) ⇒  HERE
+ a ⇒  NIL
+
    + +

    See Also::

    + +

    prog1 +, prog2, Evaluation +

    +

    Notes::

    + +

    Many places in Common Lisp involve syntax that uses implicit progns. +That is, part of their syntax allows many forms to be written +that are to be evaluated sequentially, discarding the results +of all forms but the last and returning the results of the last form. +Such places include, but are not limited to, the following: + the body of a lambda expression; + the bodies of various control and conditional forms + (e.g., case, catch, progn, and when). +

    + + + + + diff --git a/info/gcl/program_002derror.html b/info/gcl/program_002derror.html new file mode 100644 index 0000000..3c9ce6a --- /dev/null +++ b/info/gcl/program_002derror.html @@ -0,0 +1,65 @@ + + + + + +program-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.68 program-error [Condition Type]

    + +

    Class Precedence List::

    +

    program-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type program-error +consists of error conditions related to incorrect program syntax. The +errors that result from naming a go tag or a block tag +that is not lexically apparent are of type program-error. +

    + + + + + diff --git a/info/gcl/progv.html b/info/gcl/progv.html new file mode 100644 index 0000000..1835734 --- /dev/null +++ b/info/gcl/progv.html @@ -0,0 +1,105 @@ + + + + + +progv (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.19 progv [Special Operator]

    + +

    progv symbols values {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    symbols—a list of symbols; evaluated. +

    +

    values—a list of objects; evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    progv creates new dynamic variable bindings and +executes each form using those bindings. +Each form is evaluated in order. +

    +

    progv allows binding one or more dynamic +variables whose names may be determined at run time. +Each form is evaluated in order +with the dynamic variables whose names are in +symbols bound to corresponding values. +If too few values +are supplied, the remaining symbols are bound and then +made to have no value. If too many values are +supplied, the excess values are ignored. +The bindings of the dynamic variables are undone on +exit from progv. +

    +

    Examples::

    +
    +
     (setq *x* 1) ⇒  1
+ (progv '(*x*) '(2) *x*) ⇒  2
+ *x* ⇒  1
+
+Assuming *x* is not globally special,
+
+ (let ((*x* 3)) 
+    (progv '(*x*) '(4) 
+      (list *x* (symbol-value '*x*)))) ⇒  (3 4)
+
    + +

    See Also::

    + +

    let +, Evaluation +

    +

    Notes::

    + +

    Among other things, progv is useful when writing +interpreters for languages embedded in Lisp; it provides a handle +on the mechanism for binding dynamic variables. +

    + + + + + diff --git a/info/gcl/provide.html b/info/gcl/provide.html new file mode 100644 index 0000000..52c10ad --- /dev/null +++ b/info/gcl/provide.html @@ -0,0 +1,152 @@ + + + + + +provide (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.11 provide, require [Function]

    + +

    provide module-name ⇒ implementation-dependent +

    +

    require module-name &optional pathname-list ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    module-name—a string designator. +

    +

    pathname-list—nil, or + a designator + for a non-empty list of pathname designators. + The default is nil. +

    +

    Description::

    + +

    provide adds the module-name to the list held by +*modules*, if such a name is not already present. +

    +

    require tests for the presence of the module-name in the +list held by *modules*. +If it is present, require immediately returns. +

    +

    Otherwise, an attempt is made to load an appropriate set of files as follows: +The pathname-list argument, if non-nil, + specifies a list of pathnames to be loaded in order, from left to right. +If the pathname-list is nil, +an implementation-dependent mechanism will be invoked in an attempt +to load the module named module-name; +if no such module can be loaded, an error of type error is signaled. +

    +

    Both functions use string= to test for the presence of a module-name. +

    +

    Examples::

    + +
    +
    ;;; This illustrates a nonportable use of REQUIRE, because it
+;;; depends on the implementation-dependent file-loading mechanism.
+
+(require "CALCULUS")
+
+;;; This use of REQUIRE is nonportable because of the literal 
+;;; physical pathname.  
+
+(require "CALCULUS" "/usr/lib/lisp/calculus")
+
+;;; One form of portable usage involves supplying a logical pathname,
+;;; with appropriate translations defined elsewhere.
+
+(require "CALCULUS" "lib:calculus")
+
+;;; Another form of portable usage involves using a variable or
+;;; table lookup function to determine the pathname, which again
+;;; must be initialized elsewhere.
+
+(require "CALCULUS" *calculus-module-pathname*)
+
    + +

    Side Effects::

    + +

    provide modifies *modules*. +

    +

    Affected By::

    + +

    The specific action taken by require is affected by calls to provide +(or, in general, any changes to the value of *modules*). +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if module-name is not a string designator. +

    +

    If require fails to perform the requested operation +due to a problem while interacting with the file system, +an error of type file-error is signaled. +

    +

    An error of type file-error might be signaled if any pathname +in pathname-list is a designator for a wild pathname. +

    +

    See Also::

    + +

    *modules*, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    The functions provide and require are deprecated. +

    +

    If a module consists of a single package, +it is customary for the package and module names to be the same. +

    + + + + + +
    +
    +

    +Previous: , Up: System Construction Dictionary  

    +
    + + + + + diff --git a/info/gcl/psetq.html b/info/gcl/psetq.html new file mode 100644 index 0000000..8f6ac8e --- /dev/null +++ b/info/gcl/psetq.html @@ -0,0 +1,128 @@ + + + + + +psetq (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.21 psetq [Macro]

    + +

    psetq {!pair}* ⇒ nil +

    +

    pair ::=var form +

    +

    Pronunciation::

    + +

    psetq: pronounced +

    +

    Arguments and Values::

    + +

    var—a symbol naming a variable other than a constant variable. +

    +

    form—a form. +

    +

    Description::

    + +

    Assigns values to variables. +

    +

    This is just like setq, except that the assignments +happen “in parallel.” That is, first all of the forms are +evaluated, and only then are the variables set to the resulting values. +In this way, the assignment to one variable does not affect the value +computation of another in the way that would occur with setq’s +sequential assignment. +

    +

    If any var refers to a binding +made by symbol-macrolet, +then that var is treated as if psetf (not psetq) +had been used. +

    +

    Examples::

    + +
    +
     ;; A simple use of PSETQ to establish values for variables.
+ ;; As a matter of style, many programmers would prefer SETQ 
+ ;; in a simple situation like this where parallel assignment
+ ;; is not needed, but the two have equivalent effect.
+ (psetq a 1 b 2 c 3) ⇒  NIL
+ a ⇒  1
+ b ⇒  2
+ c ⇒  3
+
+ ;; Use of PSETQ to update values by parallel assignment.
+ ;; The effect here is very different than if SETQ had been used.
+ (psetq a (1+ b) b (1+ a) c (+ a b)) ⇒  NIL
+ a ⇒  3
+ b ⇒  2
+ c ⇒  3
+
+ ;; Use of PSETQ on a symbol macro.
+ (let ((x (list 10 20 30)))
+   (symbol-macrolet ((y (car x)) (z (cadr x)))
+     (psetq y (1+ z) z (1+ y))
+     (list x y z)))
+⇒  ((21 11 30) 21 11)
+
+ ;; Use of parallel assignment to swap values of A and B.
+ (let ((a 1) (b 2))
+   (psetq a b  b a)
+   (values a b))
+⇒  2, 1
+
    + +

    Side Effects::

    + +

    The values of forms are assigned to vars. +

    +

    See Also::

    + +

    psetf, +setq +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/push.html b/info/gcl/push.html new file mode 100644 index 0000000..2dc96da --- /dev/null +++ b/info/gcl/push.html @@ -0,0 +1,106 @@ + + + + + +push (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.19 push [Macro]

    + +

    push item place ⇒ new-place-value +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    place—a place, the value of which may be any object. +

    +

    new-place-value—a list (the new value of place). +

    +

    Description::

    + +

    push prepends item to the list that is stored +in place, stores the resulting list in place, +and returns the list. +

    +

    For information about the evaluation of subforms of place, +see Evaluation of Subforms to Places. +

    +

    Examples::

    +
    +
     (setq llst '(nil)) ⇒  (NIL)
+ (push 1 (car llst)) ⇒  (1)
+ llst ⇒  ((1))
+ (push 1 (car llst)) ⇒  (1 1)
+ llst ⇒  ((1 1))
+ (setq x '(a (b c) d)) ⇒  (A (B C) D)
+ (push 5 (cadr x)) ⇒  (5 B C)  
+ x ⇒  (A (5 B C) D)
+
    + +

    Side Effects::

    + +

    The contents of place are modified. +

    +

    See Also::

    + +

    pop +, +pushnew +, +Generalized Reference +

    +

    Notes::

    +

    The effect of (push item place) +is equivalent to +

    +
    +
     (setf place (cons item place))
+
    + +

    except that the subforms of place +are evaluated only once, and item is evaluated +before place. +

    + + + + + diff --git a/info/gcl/pushnew.html b/info/gcl/pushnew.html new file mode 100644 index 0000000..4ec7a7f --- /dev/null +++ b/info/gcl/pushnew.html @@ -0,0 +1,153 @@ + + + + + +pushnew (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.45 pushnew [Macro]

    + +

    pushnew item place &key key test test-not
    + ⇒ new-place-value +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    place—a place, the value of which is a proper list. +

    +

    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. +

    +

    new-place-value—a list (the new value of place). +

    +

    Description::

    + +

    pushnew tests whether item is the same as any existing +element of the list stored in place. If item is not, +it is prepended to the list, and the new list is stored in +place. +

    +

    pushnew returns the new list that is stored in place. +

    +

    Whether or not item is already a member of the list that is +in place is determined by comparisons using :test or :test-not. +The first argument to the :test or :test-not +function is item; the second argument is +an element of the list in place as returned by +the :key function (if supplied). +

    +

    If :key is supplied, it is used to extract the part to be tested from +both item and the list element, +as for adjoin. +

    +

    The argument to the :key function +is an element of the list stored in +place. The :key function typically returns part +part of the element of the list. +If :key is not supplied or nil, the list +element is used. +

    +

    For information about the evaluation of subforms of place, +see Evaluation of Subforms to Places. +

    +

    It is implementation-dependent whether or not pushnew +actually executes the storing form for its place in the +situation where the item is already a member of the list +held by place. +

    +

    Examples::

    +
    +
     (setq x '(a (b c) d)) ⇒  (A (B C) D)
+ (pushnew 5 (cadr x)) ⇒  (5 B C)   
+ x ⇒  (A (5 B C) D)
+ (pushnew 'b (cadr x)) ⇒  (5 B C)  
+ x ⇒  (A (5 B C) D)
+ (setq lst '((1) (1 2) (1 2 3))) ⇒  ((1) (1 2) (1 2 3))
+ (pushnew '(2) lst) ⇒  ((2) (1) (1 2) (1 2 3))
+ (pushnew '(1) lst) ⇒  ((1) (2) (1) (1 2) (1 2 3))
+ (pushnew '(1) lst :test 'equal) ⇒  ((1) (2) (1) (1 2) (1 2 3))
+ (pushnew '(1) lst :key #'car) ⇒  ((1) (2) (1) (1 2) (1 2 3)) 
+
    + +

    Side Effects::

    + +

    The contents of place may be modified. +

    +

    See Also::

    + +

    push +, +adjoin +, +Generalized Reference +

    +

    Notes::

    + +

    The effect of +

    +
     (pushnew item place :test p)
+
    + +

    is roughly equivalent to +

    +
     (setf place (adjoin item place :test p))
+
    + +

    except that the subforms of place are evaluated only once, +and item is evaluated before place. +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/quote.html b/info/gcl/quote.html new file mode 100644 index 0000000..3d67e01 --- /dev/null +++ b/info/gcl/quote.html @@ -0,0 +1,105 @@ + + + + + +quote (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.7 quote [Special Operator]

    + +

    quote object ⇒ object +

    +

    Arguments and Values::

    + +

    object—an object; not evaluated. +

    +

    Description::

    + +

    The quote special operator just returns object. +

    +

    The consequences are undefined if literal objects (including +quoted objects) are destructively modified. +

    +

    Examples::

    + +
    +
     (setq a 1) ⇒  1
+ (quote (setq a 3)) ⇒  (SETQ A 3)
+ a ⇒  1
+ 'a ⇒  A
+ ''a ⇒  (QUOTE A) 
+ '''a ⇒  (QUOTE (QUOTE A))
+ (setq a 43) ⇒  43
+ (list a (cons a 3)) ⇒  (43 (43 . 3))
+ (list (quote a) (quote (cons a 3))) ⇒  (A (CONS A 3)) 
+ 1 ⇒  1
+ '1 ⇒  1
+ "foo" ⇒  "foo"
+ '"foo" ⇒  "foo"
+ (car '(a b)) ⇒  A
+ '(car '(a b)) ⇒  (CAR (QUOTE (A B)))
+ #(car '(a b)) ⇒  #(CAR (QUOTE (A B)))
+ '#(car '(a b)) ⇒  #(CAR (QUOTE (A B)))
+
    + +

    See Also::

    + +

    Evaluation, +Single-Quote, +

    +

    Compiler Terminology +

    +

    Notes::

    + +

    The textual notation 'object is equivalent to (quote object); +see Compiler Terminology. +

    +

    Some objects, called self-evaluating objects, +do not require quotation by quote. +However, symbols and lists are used to represent parts of programs, +and so would not be useable as constant data in a program without quote. +Since quote suppresses the evaluation of these objects, +they become data rather than program. +

    + + + + + diff --git a/info/gcl/random.html b/info/gcl/random.html new file mode 100644 index 0000000..8fbcefb --- /dev/null +++ b/info/gcl/random.html @@ -0,0 +1,105 @@ + + + + + +random (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.41 random [Function]

    + +

    random limit &optional random-state ⇒ random-number +

    +

    Arguments and Values::

    + +

    limit—a positive integer, + or a positive float. +

    +

    random-state—a random state. + The default is the current random state. +

    +

    random-number—a non-negative number + less than limit + and of the same type as limit. +

    +

    Description::

    + +

    Returns a pseudo-random number that is a non-negative number +less than limit and of the same type as limit. +

    +

    The random-state, which is modified by this function, +encodes the internal state maintained by the random number generator. +

    +

    An approximately uniform choice distribution is used. If limit +is an integer, each of the possible results occurs with +(approximate) probability 1/limit. +

    +

    Examples::

    + +
    +
     (<= 0 (random 1000) 1000) ⇒  true
+ (let ((state1 (make-random-state))
+       (state2 (make-random-state)))
+   (= (random 1000 state1) (random 1000 state2))) ⇒  true
+
    + +

    Side Effects::

    + +

    The random-state is modified. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if limit is not a positive integer or a positive real. +

    +

    See Also::

    + +

    make-random-state +, +random-state +

    +

    Notes::

    + +

    See Common Lisp: The Language for information about generating random numbers. +

    + + + + + diff --git a/info/gcl/random_002dstate.html b/info/gcl/random_002dstate.html new file mode 100644 index 0000000..10520bc --- /dev/null +++ b/info/gcl/random_002dstate.html @@ -0,0 +1,75 @@ + + + + + +random-state (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.39 random-state [System Class]

    + +

    Class Precedence List::

    +

    random-state, +t +

    +

    Description::

    + +

    A random state object contains state +information used by the pseudo-random number generator. +The nature of a random state object is implementation-dependent. +It can be printed out and successfully read back in by the same implementation, +but might not function correctly as a random state in another implementation. +

    +

    Implementations are required to provide a read syntax for +objects of type random-state, but the specific nature of that syntax +is implementation-dependent. +

    +

    See Also::

    + +

    random-state +, +random +, +Printing Random States +

    + + + + + diff --git a/info/gcl/random_002dstate_002dp.html b/info/gcl/random_002dstate_002dp.html new file mode 100644 index 0000000..427e027 --- /dev/null +++ b/info/gcl/random_002dstate_002dp.html @@ -0,0 +1,84 @@ + + + + + +random-state-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.42 random-state-p [Function]

    + +

    random-state-p object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type random-state; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (random-state-p *random-state*) ⇒  true
+ (random-state-p (make-random-state)) ⇒  true
+ (random-state-p 'test-function) ⇒  false
+
    + +

    See Also::

    + +

    make-random-state +, +random-state +

    +

    Notes::

    + +
    +
     (random-state-p object) ≡ (typep object 'random-state)
+
    + + + + + + diff --git a/info/gcl/rassoc.html b/info/gcl/rassoc.html new file mode 100644 index 0000000..08a8ff5 --- /dev/null +++ b/info/gcl/rassoc.html @@ -0,0 +1,141 @@ + + + + + +rassoc (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.39 rassoc, rassoc-if, rassoc-if-not [Function]

    + +

    rassoc item alist &key key test test-not ⇒ entry +

    +

    rassoc-if predicate alist &key key ⇒ entry +

    +

    rassoc-if-not predicate alist &key key ⇒ entry +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    alist—an association list. +

    +

    predicate—a designator for + a function of one argument + that returns a generalized boolean. +

    +

    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. +

    +

    entry—a cons that is an element of the alist, + or nil. +

    +

    Description::

    + +

    rassoc, rassoc-if, and rassoc-if-not +return the first cons whose cdr +satisfies the test. +If no such cons is found, nil +is returned. +

    +

    If nil appears in alist in place of a pair, it is ignored. +

    +

    Examples::

    + +
    +
     (setq alist '((1 . "one") (2 . "two") (3 . 3))) 
+⇒  ((1 . "one") (2 . "two") (3 . 3))
+ (rassoc 3 alist) ⇒  (3 . 3)
+ (rassoc "two" alist) ⇒  NIL
+ (rassoc "two" alist :test 'equal) ⇒  (2 . "two")
+ (rassoc 1 alist :key #'(lambda (x) (if (numberp x) (/ x 3)))) ⇒  (3 . 3)
+ (rassoc 'a '((a . b) (b . c) (c . a) (z . a))) ⇒  (C . A)
+ (rassoc-if #'stringp alist) ⇒  (1 . "one")
+ (rassoc-if-not #'vectorp alist) ⇒  (3 . 3)
+
    + +

    See Also::

    + +

    assoc +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    The function rassoc-if-not is deprecated. +

    +

    It is possible to rplaca the result of rassoc, +provided that it is not nil, in order to “update” alist. +

    +

    The expressions +

    +
    +
     (rassoc item list :test fn)
+
    + +

    and +

    +
    +
     (find item list :test fn :key #'cdr)
+
    + +

    are equivalent in meaning, except when the item is nil +and nil appears in place of a pair in the alist. +See the function assoc. +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/ratio.html b/info/gcl/ratio.html new file mode 100644 index 0000000..0338628 --- /dev/null +++ b/info/gcl/ratio.html @@ -0,0 +1,74 @@ + + + + + +ratio (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.7 ratio [System Class]

    + +

    Class Precedence List::

    +

    ratio, +rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    A ratio is a number +representing the mathematical ratio of two non-zero integers, +the numerator and denominator, +whose greatest common divisor is one, +and of which the denominator is positive and greater than one. +

    +

    See Also::

    + +

    Figure~2–9, +Constructing Numbers from Tokens, +Printing Ratios +

    + + + + + diff --git a/info/gcl/rational-_0028Function_0029.html b/info/gcl/rational-_0028Function_0029.html new file mode 100644 index 0000000..4cc8d2d --- /dev/null +++ b/info/gcl/rational-_0028Function_0029.html @@ -0,0 +1,121 @@ + + + + + +rational (Function) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.54 rational, rationalize [Function]

    + +

    rational number ⇒ rational +

    +

    rationalize number ⇒ rational +

    +

    Arguments and Values::

    + +

    number—a real. +

    +

    rational—a rational. +

    +

    Description::

    + +

    rational and rationalize convert +

    +

    reals +

    +

    to rationals. +

    +

    If number is already rational, it is returned. +

    +

    If number is a float, +rational returns a rational +that is mathematically equal in value to the float. +rationalize returns a rational that +approximates the float to the accuracy of +the underlying floating-point representation. +

    +

    rational assumes that the float is completely accurate. +

    +

    rationalize assumes that the +float is accurate only to the precision of the +floating-point representation. +

    +

    Examples::

    +
    +
     (rational 0) ⇒  0
+ (rationalize -11/100) ⇒  -11/100
+ (rational .1) ⇒  13421773/134217728 ;implementation-dependent
+ (rationalize .1) ⇒  1/10
+
    + +

    Affected By::

    + +

    The implementation. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if number is not a real. +Might signal arithmetic-error. +

    +

    Notes::

    + +

    It is always the case that +

    +
    +
     (float (rational x) x) ≡ x
+
    + +

    and +

    +
    +
     (float (rationalize x) x) ≡ x
+
    + +

    That is, rationalizing a float by either method +and then converting it back +to a float +of the same format produces the original number. +

    + + + + + diff --git a/info/gcl/rational-_0028System-Class_0029.html b/info/gcl/rational-_0028System-Class_0029.html new file mode 100644 index 0000000..5654fe9 --- /dev/null +++ b/info/gcl/rational-_0028System-Class_0029.html @@ -0,0 +1,87 @@ + + + + + +rational (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.6 rational [System Class]

    + +

    Class Precedence List::

    +

    rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    The canonical representation of a rational +is as an integer if its value is integral, +and otherwise as a ratio. +

    +

    The types integer and ratio +are disjoint subtypes of type rational. +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (rational{[lower-limit [upper-limit]]}) +

    +

    Compound Type Specifier Arguments::

    + +

    lower-limit, upper-limit—interval designators + for type rational. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the rationals on the interval described by +lower-limit and upper-limit. +

    + + + + + diff --git a/info/gcl/rationalp.html b/info/gcl/rationalp.html new file mode 100644 index 0000000..87c34ed --- /dev/null +++ b/info/gcl/rationalp.html @@ -0,0 +1,81 @@ + + + + + +rationalp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.55 rationalp [Function]

    + +

    rationalp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type rational; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (rationalp 12) ⇒  true
+ (rationalp 6/5) ⇒  true
+ (rationalp 1.212) ⇒  false
+
    + +

    See Also::

    + +

    rational (Function) +

    +

    Notes::

    +
    +
     (rationalp object) ≡ (typep object 'rational)
+
    + + + + + + diff --git a/info/gcl/read.html b/info/gcl/read.html new file mode 100644 index 0000000..deffb87 --- /dev/null +++ b/info/gcl/read.html @@ -0,0 +1,223 @@ + + + + + +read (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.4 read, read-preserving-whitespace [Function]

    + +

    read &optional input-stream eof-error-p eof-value recursive-p ⇒ object +

    +

    read-preserving-whitespace &optional input-stream eof-error-p + eof-value recursive-p
    + ⇒ object +

    +

    Arguments and Values::

    + +

    input-stream—an input stream designator. +

    +

    eof-error-p—a generalized boolean. + The default is true. +

    +

    eof-value—an object. +

    +

    The default is nil. +

    +

    recursive-p—a generalized boolean. + The default is false. +

    +

    object—an object (parsed by the Lisp reader) + or the eof-value. +

    +

    Description::

    + +

    read parses the printed representation of an object +from input-stream and builds such an object. +

    +

    read-preserving-whitespace is like read but preserves +any whitespace_2 character +that delimits the printed representation of the object. +read-preserving-whitespace is exactly like read +when the recursive-p argument to read-preserving-whitespace +is true. +

    +

    When *read-suppress* is false, +read throws away the delimiting character required by +certain printed representations if it is a +whitespace_2 character; +but read preserves the character +(using unread-char) if it is +syntactically meaningful, because it could be the start of the next expression. +

    +

    If a file ends in a symbol or a number +immediately followed by an end of file_1, +read reads the symbol or number successfully; +when called again, it sees the end of file_1 and +only then acts according to eof-error-p. +If a file contains ignorable text at the end, such +as blank lines and comments, read +does not consider it to end in the +middle of an object. +

    +

    If recursive-p is true, the call to read is +expected to be made +from within some function that itself +has been called from read or from a similar input function, rather +than from the top level. +

    +

    Both functions return the object read from input-stream. +Eof-value is returned if eof-error-p is false and end of file +is reached before the beginning of an object. +

    +

    Examples::

    + +
    +
     (read)
+ |>  |>>'a<<|
+⇒  (QUOTE A)
+ (with-input-from-string (is " ") (read is nil 'the-end)) ⇒  THE-END
+ (defun skip-then-read-char (s c n)
+    (if (char= c #\{) (read s t nil t) (read-preserving-whitespace s))
+    (read-char-no-hang s)) ⇒  SKIP-THEN-READ-CHAR
+ (let ((*readtable* (copy-readtable nil)))
+    (set-dispatch-macro-character #\# #\{ #'skip-then-read-char)
+    (set-dispatch-macro-character #\# #\} #'skip-then-read-char)
+    (with-input-from-string (is "#{123 x #}123 y")
+      (format t "~S ~S" (read is) (read is)))) ⇒  #\x, #\Space, NIL
+
    + +

    As an example, consider this reader macro definition: +

    +
    +
     (defun slash-reader (stream char)
+   (declare (ignore char))
+   `(path . ,(loop for dir = (read-preserving-whitespace stream t nil t)
+                   then (progn (read-char stream t nil t)
+                               (read-preserving-whitespace stream t nil t))
+                   collect dir
+                   while (eql (peek-char nil stream nil nil t) #\/))))
+ (set-macro-character #\/ #'slash-reader)
+
    + +

    Consider now calling read on this expression: +

    +
    +
     (zyedh /usr/games/zork /usr/games/boggle)
+
    + +

    The / macro reads objects separated by more / characters; +thus /usr/games/zork is intended to read as (path usr games zork). +The entire example expression should therefore be read as +

    +
    +
     (zyedh (path usr games zork) (path usr games boggle))
+
    + +

    However, if read had been used instead of +read-preserving-whitespace, then after the reading of the symbol +zork, the following space would be discarded; the next call +to peek-char would see the following /, and the loop would +continue, producing this interpretation: +

    +
    +
     (zyedh (path usr games zork usr games boggle))
+
    + +

    There are times when whitespace_2 should be discarded. +If a command interpreter takes single-character commands, +but occasionally reads an object then if the whitespace_2 +after a symbol +is not discarded it might be interpreted as a command +some time later after the symbol had been read. +

    +

    Affected By::

    + +

    *standard-input*, +*terminal-io*, +*readtable*, +*read-default-float-format*, +*read-base*, +*read-suppress*, +*package*, +*read-eval*. +

    +

    Exceptional Situations::

    + +

    read signals an error of type end-of-file, +regardless of eof-error-p, if +the file ends in the middle of an object representation. +For example, if a file does +not contain enough right parentheses to balance the left parentheses in +it, read signals an error. +This is detected when read or read-preserving-whitespace +is called with recursive-p and eof-error-p non-nil, +and end-of-file is reached before the beginning of an object. +

    +

    If eof-error-p is true, an error of type end-of-file +is signaled at the end of file. +

    +

    See Also::

    + +

    peek-char +, +read-char +, +unread-char +, +read-from-string +, +read-delimited-list +, +parse-integer +, +Syntax, +Reader Concepts +

    +
    +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    + + + + + diff --git a/info/gcl/read_002dbyte.html b/info/gcl/read_002dbyte.html new file mode 100644 index 0000000..c6a0cc2 --- /dev/null +++ b/info/gcl/read_002dbyte.html @@ -0,0 +1,110 @@ + + + + + +read-byte (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.14 read-byte [Function]

    + +

    read-byte stream &optional eof-error-p eof-value ⇒ byte +

    +

    Arguments and Values::

    + +

    stream—a binary input stream. +

    +

    eof-error-p—a generalized boolean. + The default is true. +

    +

    eof-value—an object. + The default is nil. +

    +

    byte—an integer, + or the eof-value. +

    +

    Description::

    + +

    read-byte reads and returns one byte from stream. +

    +

    If an end of file_2 occurs and eof-error-p is false, +the eof-value is returned. +

    +

    Examples::

    +
    +
     (with-open-file (s "temp-bytes" 
+                     :direction :output
+                     :element-type 'unsigned-byte)
+    (write-byte 101 s)) ⇒  101
+ (with-open-file (s "temp-bytes" :element-type 'unsigned-byte)
+    (format t "~S ~S" (read-byte s) (read-byte s nil 'eof)))
+ |>  101 EOF
+⇒  NIL
+
    + +

    Side Effects::

    + +

    Modifies stream. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if stream is not a stream. +

    +

    Should signal an error of type error +if stream is not a binary input stream. +

    +

    If there are no bytes remaining in the stream +and eof-error-p is true, an error of type end-of-file is signaled. +

    +

    See Also::

    + +

    read-char +, +

    +

    read-sequence +, +

    +

    write-byte +

    + + + + + diff --git a/info/gcl/read_002dchar.html b/info/gcl/read_002dchar.html new file mode 100644 index 0000000..fd813f0 --- /dev/null +++ b/info/gcl/read_002dchar.html @@ -0,0 +1,125 @@ + + + + + +read-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.17 read-char [Function]

    + +

    read-char &optional input-stream eof-error-p eof-value recursive-p ⇒ char +

    +

    Arguments and Values::

    + +

    input-stream—an input stream designator. + The default is standard input. +

    +

    eof-error-p—a generalized boolean. + The default is true. +

    +

    eof-value—an object. + The default is nil. +

    +

    recursive-p—a generalized boolean. + The default is false. +

    +

    char—a character or the eof-value. +

    +

    Description::

    + +

    read-char returns the next character from input-stream. +

    +

    When input-stream is an echo stream, +the character is echoed on input-stream the first time the character is +seen. + Characters that are not echoed by read-char +are those that were + put there by unread-char +and hence are assumed to have been echoed + already by a previous call to read-char. +

    +

    If recursive-p is true, +this call is expected to be embedded in a higher-level call to read +or a similar function used by the Lisp reader. +

    +

    If an end of file_2 occurs and eof-error-p is false, +eof-value is returned. +

    +

    Examples::

    +
    +
     (with-input-from-string (is "0123")
+    (do ((c (read-char is) (read-char is nil 'the-end)))
+        ((not (characterp c)))
+     (format t "~S " c)))
+ |>  #\0 #\1 #\2 #\3
+⇒  NIL
+
    + +

    Affected By::

    + +

    *standard-input*, +*terminal-io*. +

    +

    Exceptional Situations::

    + +

    If an end of file_2 occurs before a character can be read, and +eof-error-p is true, +an error of type end-of-file is signaled. +

    +

    See Also::

    + +

    read-byte +, +

    +

    read-sequence +, +

    +

    write-char +, +read +

    +

    Notes::

    +

    The corresponding output function is write-char. +

    + + + + + diff --git a/info/gcl/read_002dchar_002dno_002dhang.html b/info/gcl/read_002dchar_002dno_002dhang.html new file mode 100644 index 0000000..797e7d6 --- /dev/null +++ b/info/gcl/read_002dchar_002dno_002dhang.html @@ -0,0 +1,133 @@ + + + + + +read-char-no-hang (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.18 read-char-no-hang [Function]

    + +

    read-char-no-hang &optional input-stream eof-error-p + eof-value recursive-p ⇒ char +

    +

    Arguments and Values::

    + +

    input-stream – an input stream designator. + The default is standard input. +

    +

    eof-error-p—a generalized boolean. + The default is true. +

    +

    eof-value—an object. + The default is nil. +

    +

    recursive-p—a generalized boolean. + The default is false. +

    +

    char—a character or nil or the eof-value. +

    +

    Description::

    + +

    read-char-no-hang returns a character +from input-stream if such a character is available. If no character +is available, read-char-no-hang returns nil. +

    +

    If recursive-p is true, +this call is expected to be embedded in a higher-level call to read +or a similar function used by the Lisp reader. +

    +

    If an end of file_2 occurs and eof-error-p is false, +eof-value is returned. +

    +

    Examples::

    + +
    +
    ;; This code assumes an implementation in which a newline is not
+;; required to terminate input from the console.
+ (defun test-it ()
+   (unread-char (read-char))
+   (list (read-char-no-hang) 
+         (read-char-no-hang) 
+         (read-char-no-hang)))
+⇒  TEST-IT
+;; Implementation A, where a Newline is not required to terminate
+;; interactive input on the console.
+ (test-it)
+ |>  |>>a<<|
+⇒  (#\a NIL NIL)
+;; Implementation B, where a Newline is required to terminate
+;; interactive input on the console, and where that Newline remains
+;; on the input stream.
+ (test-it)
+ |>  |>>a[<–~]<<|
+⇒  (#\a #\Newline NIL)
+
    + +

    Affected By::

    + +

    *standard-input*, +*terminal-io*. +

    +

    Exceptional Situations::

    + +

    If an end of file_2 occurs +when eof-error-p is true, +an error of type end-of-file is signaled . +

    +

    See Also::

    + +

    listen +

    +

    Notes::

    + +

    read-char-no-hang is exactly like read-char, except +that if it would be necessary to wait in order to get a character (as +from a keyboard), nil is immediately returned without waiting. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/read_002ddelimited_002dlist.html b/info/gcl/read_002ddelimited_002dlist.html new file mode 100644 index 0000000..9e14b36 --- /dev/null +++ b/info/gcl/read_002ddelimited_002dlist.html @@ -0,0 +1,184 @@ + + + + + +read-delimited-list (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.5 read-delimited-list [Function]

    + +

    read-delimited-list char &optional input-stream recursive-p ⇒ list +

    +

    Arguments and Values::

    + +

    char—a character. +

    +

    input-stream—an input stream designator. + The default is standard input. +

    +

    recursive-p—a generalized boolean. + The default is false. +

    +

    list—a list of the objects read. +

    +

    Description::

    + +

    read-delimited-list reads objects from input-stream +until the next character after an object’s +representation (ignoring whitespace_2 characters and comments) is char. +

    +

    read-delimited-list looks ahead at each step +for the next non-whitespace_2 character +and peeks at it as if with peek-char. +If it is char, +then the character is consumed and the list of objects is returned. +If it is a constituent or escape character, +then read is used to read an object, +which is added to the end of the list. +If it is a macro character, +its reader macro function is called; +if the function returns a value, +that value is added to the list. +The peek-ahead process is then repeated. +

    +

    If recursive-p is true, +this call is expected to be embedded in a higher-level call to read +or a similar function. +

    +

    It is an error to reach end-of-file during the operation of +read-delimited-list. +

    +

    The consequences are undefined +if char has a syntax type of whitespace_2 +in the current readtable. +

    +

    Examples::

    +
    +
     (read-delimited-list #\]) 1 2 3 4 5 6 ]
+⇒  (1 2 3 4 5 6)
+
    + +

    Suppose you wanted #{a b c ... z} +to read as a list of all pairs of the elements a, b, c, +..., z, for example. +

    +
    +
     #{p q z a}  reads as  ((p q) (p z) (p a) (q z) (q a) (z a))
+
    + +

    This can be done by specifying a macro-character definition for #{ +that does two things: reads in all the items up to the }, +and constructs the pairs. read-delimited-list performs +the first task. +

    +
    +
     (defun |#{-reader| (stream char arg)
+   (declare (ignore char arg))
+   (mapcon #'(lambda (x)
+              (mapcar #'(lambda (y) (list (car x) y)) (cdr x)))
+          (read-delimited-list #\} stream t))) ⇒  |#{-reader|
+
+ (set-dispatch-macro-character #\# #\{ #'|#{-reader|) ⇒  T 
+ (set-macro-character #\} (get-macro-character #\) nil))
+
    + +

    Note that true is supplied for the recursive-p argument. +

    +

    It is necessary here to give a definition to the character } as +well to prevent it from being a constituent. +If the line +

    +
    +
     (set-macro-character #\} (get-macro-character #\) nil))
+
    + +

    shown above were not included, then the } in +

    +
    +
     #{ p q z a}
+
    + +

    would be considered a constituent character, part of the symbol named +a}. This could be corrected by putting a space before +the }, but it is better to call +set-macro-character. +

    +

    Giving } the same +definition as the standard definition of the character ) has the +twin benefit of making it terminate tokens for use with +read-delimited-list and also making it invalid for use in any +other context. Attempting to read a stray } will signal an error. +

    +

    Affected By::

    + +

    *standard-input*, +*readtable*, +*terminal-io*. +

    +

    See Also::

    + +

    read +, +peek-char +, +read-char +, +unread-char +. +

    +

    Notes::

    + +

    read-delimited-list is intended for use in implementing reader macros. +Usually it is desirable for char to be a terminating macro character +so that it can be used to delimit tokens; however, read-delimited-list +makes no attempt to alter the syntax specified for char by the current +readtable. The caller must make any necessary changes to the readtable syntax +explicitly. +

    +
    +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    + + + + + diff --git a/info/gcl/read_002dfrom_002dstring.html b/info/gcl/read_002dfrom_002dstring.html new file mode 100644 index 0000000..7e6178c --- /dev/null +++ b/info/gcl/read_002dfrom_002dstring.html @@ -0,0 +1,137 @@ + + + + + +read-from-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.6 read-from-string [Function]

    + +

    read-from-string string &optional eof-error-p eof-value + &key start end preserve-whitespace
    + ⇒ object, position +

    +

    Arguments and Values::

    + +

    string—a string. +

    +

    eof-error-p—a generalized boolean. + The default is true. +

    +

    eof-value—an object. +

    +

    The default is nil. +

    +

    start, end—bounding index designators of string. + The defaults for start and end are 0 and nil, respectively. +

    +

    preserve-whitespace—a generalized boolean. + The default is false. +

    +

    object—an object (parsed by the Lisp reader) + or the eof-value. +

    +

    position—an integer greater than or equal to zero, + and less than or equal to + one more than the length of the string. +

    +

    Description::

    + +

    Parses the printed representation of an object +from the subsequence of string bounded by start and end, +as if read had been called on an input stream +containing those same characters. +

    +

    If preserve-whitespace is true, +the operation will preserve whitespace_2 +as read-preserving-whitespace would do. +

    +

    If an object is successfully parsed, the primary value, object, +is the object that was parsed. +If eof-error-p is false and if the end of the substring is reached, +eof-value is returned. +

    +

    The secondary value, position, is the index of the first character +in the bounded string that was not read. +The position may depend upon the value of preserve-whitespace. +If the entire string was read, +the position returned is either the length of the string +or one greater than the length of the string. +

    +

    Examples::

    + +
    +
     (read-from-string " 1 3 5" t nil :start 2) ⇒  3, 5
+ (read-from-string "(a b c)") ⇒  (A B C), 7
+
    + +

    Exceptional Situations::

    + +

    If the end of the supplied substring +occurs before an object can be read, an +error is signaled if eof-error-p is true. +An error is signaled if the end of the substring occurs +in the middle of an incomplete object. +

    +

    See Also::

    + +

    read +, +read-preserving-whitespace +

    +

    Notes::

    + +

    The reason that position is allowed to be beyond the +length of the string is to permit (but not require) +the implementation to work by simulating the effect of a +trailing delimiter at the end of the bounded string. +When preserve-whitespace is true, +the position might count the simulated delimiter. +

    +
    +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    + + + + + diff --git a/info/gcl/read_002dline.html b/info/gcl/read_002dline.html new file mode 100644 index 0000000..b1a278c --- /dev/null +++ b/info/gcl/read_002dline.html @@ -0,0 +1,133 @@ + + + + + +read-line (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.22 read-line [Function]

    + +

    read-line &optional input-stream eof-error-p eof-value recursive-p
    + ⇒ line, missing-newline-p +

    +

    Arguments and Values::

    + +

    input-stream—an input stream designator. + The default is standard input. +

    +

    eof-error-p—a generalized boolean. + The default is true. +

    +

    eof-value—an object. + The default is nil. +

    +

    recursive-p—a generalized boolean. + The default is false. +

    +

    line—a string or the eof-value. +

    +

    missing-newline-p—a generalized boolean. +

    +

    Description::

    + +

    Reads from input-stream a line of text +that is terminated by a newline or end of file. +

    +

    If recursive-p is true, +this call is expected to be embedded in a higher-level call to read +or a similar function used by the Lisp reader. +

    +

    The primary value, line, is the line that is read, +represented as a string (without the trailing newline, if any). +If eof-error-p is false +and the end of file for input-stream is reached + before any characters are read, +eof-value is returned as the line. +

    +

    The secondary value, missing-newline-p, +is a generalized boolean that is + false if the line was terminated by a newline, + or true if the line was terminated by + the end of file for input-stream + (or if the line is the eof-value). +

    +

    Examples::

    + +
    +
     (setq a "line 1
+ line2")
+⇒  "line 1
+ line2"
+ (read-line (setq input-stream (make-string-input-stream a)))
+⇒  "line 1", false
+ (read-line input-stream)
+⇒  "line2", true
+ (read-line input-stream nil nil)
+⇒  NIL, true
+
    + +

    Affected By::

    + +

    *standard-input*, +*terminal-io*. +

    +

    Exceptional Situations::

    + +

    If an end of file_2 occurs before any characters are read in the line, +an error is signaled if eof-error-p is true. +

    +

    See Also::

    + +

    read +

    +

    Notes::

    + +

    The corresponding output function is write-line. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/read_002dsequence.html b/info/gcl/read_002dsequence.html new file mode 100644 index 0000000..79c7da0 --- /dev/null +++ b/info/gcl/read_002dsequence.html @@ -0,0 +1,125 @@ + + + + + +read-sequence (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.24 read-sequence [Function]

    + +

    read-sequence sequence stream &key start end ⇒ position +

    +

    sequence—a sequence. +

    +

    stream—an input stream. +

    +

    start, end—bounding index designators of + sequence. The defaults for start and end are 0 and nil, respectively. +

    +

    position—an integer greater than or equal to zero, and + less than or equal to the length of the sequence. +

    +

    Description::

    + +

    Destructively modifies sequence by replacing the elements +of sequence bounded by start and end with +elements read from stream. +

    +

    Sequence is destructively modified by copying successive +elements into it from stream. If the end of file for +stream is reached before copying all elements of the +subsequence, then the extra elements near the end of sequence +are not updated. +

    +

    Position is the index of the first element of sequence +that was not updated, which might be less than end because the +end of file was reached. +

    +

    Examples::

    + +
    +
     (defvar *data* (make-array 15 :initial-element nil))
+ (values (read-sequence *data* (make-string-input-stream "test string")) *data*)
+ ⇒  11, #(#\t #\e #\s #\t #\Space #\s #\t #\r #\i #\n #\g NIL NIL NIL NIL)
+
    + +

    Side Effects::

    + +

    Modifies stream and sequence. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +Should signal an error of type type-error + if start is not a non-negative integer. +Should signal an error of type type-error + if end is not a non-negative integer or nil. +

    +

    Might signal an error of type type-error if an element read from +the stream is not a member of the element type of the +sequence. +

    +

    See Also::

    + +

    Compiler Terminology, +write-sequence +, +read-line +

    +

    Notes::

    + +

    read-sequence is identical in effect to iterating over the indicated +subsequence and reading one element at a time from stream and +storing it into sequence, but may be more efficient than the +equivalent loop. An efficient implementation is more likely to exist +for the case where the sequence is a vector with the same +element type as the stream. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/reader_002derror.html b/info/gcl/reader_002derror.html new file mode 100644 index 0000000..85c9f86 --- /dev/null +++ b/info/gcl/reader_002derror.html @@ -0,0 +1,79 @@ + + + + + +reader-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.18 reader-error [Condition Type]

    + +

    Class Precedence List::

    +

    reader-error, +parse-error, +stream-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type reader-error consists of +error conditions that are related to tokenization and parsing +done by the Lisp reader. +

    +

    See Also::

    + +

    read +, +stream-error-stream +, +Reader Concepts +

    + + + + + + + + + + diff --git a/info/gcl/readtable.html b/info/gcl/readtable.html new file mode 100644 index 0000000..3645665 --- /dev/null +++ b/info/gcl/readtable.html @@ -0,0 +1,74 @@ + + + + + +readtable (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.1 readtable [System Class]

    + +

    Class Precedence List::

    +

    readtable, +t +

    +

    Description::

    + +

    A readtable maps characters into syntax types for +the Lisp reader; see Syntax. +A readtable also + contains associations between macro characters + and their reader macro functions, + and records information about the case conversion rules + to be used by the Lisp reader when parsing symbols. +

    +

    Each simple character must be representable in the readtable. +It is implementation-defined whether non-simple characters +can have syntax descriptions in the readtable. +

    +

    See Also::

    + +

    Readtables, +Printing Other Objects +

    + + + + + diff --git a/info/gcl/readtable_002dcase.html b/info/gcl/readtable_002dcase.html new file mode 100644 index 0000000..1ae92b6 --- /dev/null +++ b/info/gcl/readtable_002dcase.html @@ -0,0 +1,91 @@ + + + + + +readtable-case (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.7 readtable-case [Accessor]

    + +

    readtable-case readtable ⇒ mode +

    +

    (setf ( readtable-case readtable) mode)
    +

    +

    Arguments and Values::

    + +

    readtable—a readtable. +

    +

    mode—a case sensitivity mode. +

    +

    Description::

    + +

    Accesses the readtable case of readtable, +which affects the way in which the Lisp Reader reads symbols + and the way in which the Lisp Printer writes symbols. +

    +

    Examples::

    + +

    See Examples of Effect of Readtable Case on the Lisp Reader and Examples of Effect of Readtable Case on the Lisp Printer. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if readtable is not a readtable. +Should signal an error of type type-error + if mode is not a case sensitivity mode. +

    +

    See Also::

    + +

    readtable +, +*print-escape*, +Reader Algorithm, +Effect of Readtable Case on the Lisp Reader, +Effect of Readtable Case on the Lisp Printer +

    +

    Notes::

    + +

    copy-readtable copies the readtable case of the readtable. +

    + + + + + diff --git a/info/gcl/readtablep.html b/info/gcl/readtablep.html new file mode 100644 index 0000000..41a89be --- /dev/null +++ b/info/gcl/readtablep.html @@ -0,0 +1,78 @@ + + + + + +readtablep (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.8 readtablep [Function]

    + +

    readtablep object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type readtable; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (readtablep *readtable*) ⇒  true
+ (readtablep (copy-readtable)) ⇒  true
+ (readtablep '*readtable*) ⇒  false
+
    + +

    Notes::

    + +
    +
     (readtablep object) ≡ (typep object 'readtable) 
+
    + + + + + + diff --git a/info/gcl/real.html b/info/gcl/real.html new file mode 100644 index 0000000..be510d2 --- /dev/null +++ b/info/gcl/real.html @@ -0,0 +1,86 @@ + + + + + +real (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.3 real [System Class]

    + +

    Class Precedence List::

    +

    real, +number, +t +

    +

    Description::

    + +

    The type real includes all numbers that +represent mathematical real numbers, though there are mathematical real +numbers (e.g., irrational numbers) that do not have an exact representation +in Common Lisp. Only reals can be ordered using the +<, >, <=, and >= functions. +

    +

    The types rational and float are disjoint +subtypes of type real. +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (real{[lower-limit [upper-limit]]}) +

    +

    Compound Type Specifier Arguments::

    + +

    lower-limit, upper-limit—interval designators + for type real. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the reals on the interval described by +lower-limit and upper-limit. +

    + + + + + diff --git a/info/gcl/realp.html b/info/gcl/realp.html new file mode 100644 index 0000000..cb75ef6 --- /dev/null +++ b/info/gcl/realp.html @@ -0,0 +1,78 @@ + + + + + +realp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.52 realp [Function]

    + +

    realp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type real; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (realp 12) ⇒  true
+ (realp #c(5/3 7.2)) ⇒  false
+ (realp nil) ⇒  false
+ (realp (cons 1 2)) ⇒  false
+
    + +

    Notes::

    + +
    +
     (realp object) ≡ (typep object 'real)
+
    + + + + + + diff --git a/info/gcl/realpart.html b/info/gcl/realpart.html new file mode 100644 index 0000000..3dd34b4 --- /dev/null +++ b/info/gcl/realpart.html @@ -0,0 +1,92 @@ + + + + + +realpart (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.50 realpart, imagpart [Function]

    + +

    realpart number ⇒ real +

    +

    imagpart number ⇒ real +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    real—a real. +

    +

    Description::

    + +

    realpart and imagpart return the real and +imaginary parts of number respectively. +If number is +

    +

    real, +

    +

    then realpart returns number and imagpart +returns (* 0 number), which has the effect that the +imaginary part of a rational is 0 and that of +a float is a floating-point zero of the same format. +

    +

    Examples::

    + +
    +
     (realpart #c(23 41)) ⇒  23
+ (imagpart #c(23 41.0)) ⇒  41.0
+ (realpart #c(23 41.0)) ⇒  23.0
+ (imagpart 23.0) ⇒  0.0
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if number is not a number. +

    +

    See Also::

    + +

    complex +

    + + + + + diff --git a/info/gcl/reduce.html b/info/gcl/reduce.html new file mode 100644 index 0000000..096c3eb --- /dev/null +++ b/info/gcl/reduce.html @@ -0,0 +1,146 @@ + + + + + +reduce (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.9 reduce [Function]

    + +

    reduce function sequence &key key from-end start end initial-value ⇒ result +

    +

    Arguments and Values::

    + +

    function—a designator for a function + that might be called with either zero or two arguments. +

    +

    sequence—a proper sequence. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    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. +

    +

    initial-value—an object. +

    +

    result—an object. +

    +

    Description::

    + +

    reduce uses a binary operation, function, +to combine the elements of sequence +bounded by start and end. +

    +

    The function must accept as arguments two elements +of sequence or the results from combining those elements. +The function must also be able to accept no arguments. +

    +

    If key is supplied, it is used is used to extract the values to reduce. +The key function is applied exactly once to each element of sequence +in the order implied by the reduction order but not to the value of +initial-value, if supplied. +

    +

    The key function typically returns part of the element of sequence. +If key is not supplied or is nil, the sequence element itself is used. +

    +

    The reduction is left-associative, +unless from-end is true in which case it is right-associative. +

    +

    If initial-value is supplied, +it is logically placed before the subsequence +(or after it if from-end is true) +and included in the reduction operation. +

    +

    In the normal case, the result of reduce is the combined +result of function’s being applied to successive pairs of elements +of sequence. +If the subsequence contains exactly one element +and no initial-value is given, +then that element is returned and function is not called. +If the subsequence is empty and an initial-value is given, +then the initial-value is returned and function is not called. +If the subsequence is empty and no initial-value is given, +then the function is called with zero arguments, +and reduce returns whatever function does. +This is the only case where the +function is called with other than two arguments. +

    +

    Examples::

    +
    +
     (reduce #'* '(1 2 3 4 5)) ⇒  120
+ (reduce #'append '((1) (2)) :initial-value '(i n i t)) ⇒  (I N I T 1 2)
+ (reduce #'append '((1) (2)) :from-end t                  
+                             :initial-value '(i n i t)) ⇒  (1 2 I N I T) 
+ (reduce #'- '(1 2 3 4)) ≡ (- (- (- 1 2) 3) 4) ⇒  -8
+ (reduce #'- '(1 2 3 4) :from-end t)    ;Alternating sum.
+≡ (- 1 (- 2 (- 3 4))) ⇒  -2
+ (reduce #'+ '()) ⇒  0
+ (reduce #'+ '(3)) ⇒  3
+ (reduce #'+ '(foo)) ⇒  FOO
+ (reduce #'list '(1 2 3 4)) ⇒  (((1 2) 3) 4)
+ (reduce #'list '(1 2 3 4) :from-end t) ⇒  (1 (2 (3 4)))
+ (reduce #'list '(1 2 3 4) :initial-value 'foo) ⇒  ((((foo 1) 2) 3) 4)
+ (reduce #'list '(1 2 3 4)
+        :from-end t :initial-value 'foo) ⇒  (1 (2 (3 (4 foo))))
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/reinitialize_002dinstance.html b/info/gcl/reinitialize_002dinstance.html new file mode 100644 index 0000000..36ca967 --- /dev/null +++ b/info/gcl/reinitialize_002dinstance.html @@ -0,0 +1,121 @@ + + + + + +reinitialize-instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.4 reinitialize-instance [Standard Generic Function]

    + +

    Syntax::

    + +

    reinitialize-instance instance &rest initargs &key &allow-other-keys ⇒ instance +

    +

    Method Signatures::

    + +

    reinitialize-instance (instance standard-object) &rest initargs +

    +

    Arguments and Values::

    + +

    instance—an object. +

    +

    initargs—an initialization argument list. +

    +

    Description::

    + +

    The generic function reinitialize-instance can be used to change +the values of local slots of an instance according to +initargs. +This generic function can be called by users. +

    +

    The system-supplied primary method for reinitialize-instance +checks the validity of initargs and signals an error if +an initarg is supplied that is not declared as valid. +The method then calls the generic function shared-initialize +with the following arguments: the instance, +nil (which means no slots +should be initialized according to their initforms), and the +initargs it received. +

    +

    Side Effects::

    + +

    The generic function reinitialize-instance changes the values of local slots. +

    +

    Exceptional Situations::

    + +

    The system-supplied primary method for reinitialize-instance +signals an error if an initarg is supplied that is not declared as valid. +

    +

    See Also::

    + +

    Initialize-Instance +, +Shared-Initialize +, +update-instance-for-redefined-class +, +update-instance-for-different-class +, +slot-boundp +, +slot-makunbound +, +Reinitializing an Instance, +Rules for Initialization Arguments, +Declaring the Validity of Initialization Arguments +

    +

    Notes::

    + +

    Initargs are declared as valid by using the +:initarg option to defclass, or by defining +methods for reinitialize-instance +or shared-initialize. The keyword name +of each keyword parameter specifier in the lambda list of any +method +defined on reinitialize-instance or shared-initialize is +declared as a valid initialization argument name for all +classes for +which that method is applicable. +

    + + + + + diff --git a/info/gcl/remf.html b/info/gcl/remf.html new file mode 100644 index 0000000..f3c4e69 --- /dev/null +++ b/info/gcl/remf.html @@ -0,0 +1,104 @@ + + + + + +remf (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.42 remf [Macro]

    + +

    remf place indicator ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    place—a place. +

    +

    indicator—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    remf removes from the property list stored in place +a property_1 with a property indicator +identical to indicator. +

    +

    If there are multiple properties_1 with the identical key, +remf only removes the first such property. +

    +

    remf returns false if no such property was found, +or true if a property was found. +

    +

    The property indicator +and the corresponding property value +are removed in an undefined order +by destructively splicing the property list. +

    +

    remf is permitted to either setf place or to +setf any part, car or cdr, +of the list structure held by that place. +

    +

    For information about the evaluation of subforms of place, +see Evaluation of Subforms to Places. +

    +

    Examples::

    + +
    +
     (setq x (cons () ())) ⇒  (NIL)
+ (setf (getf (car x) 'prop1) 'val1) ⇒  VAL1
+ (remf (car x) 'prop1) ⇒  true
+ (remf (car x) 'prop1) ⇒  false
+
    + +

    Side Effects::

    + +

    The property list stored in place is modified. +

    +

    See Also::

    + +

    remprop +, +getf +

    + + + + + diff --git a/info/gcl/remhash.html b/info/gcl/remhash.html new file mode 100644 index 0000000..024edc3 --- /dev/null +++ b/info/gcl/remhash.html @@ -0,0 +1,80 @@ + + + + + +remhash (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.10 remhash [Function]

    + +

    remhash key hash-table ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    key—an object. +

    +

    hash-table—a hash table. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Removes the entry for key in hash-table, if any. +Returns true if there was such an entry, or false otherwise. +

    +

    Examples::

    +
    +
     (setq table (make-hash-table)) ⇒  #<HASH-TABLE EQL 0/120 32115666>
+ (setf (gethash 100 table) "C") ⇒  "C"
+ (gethash 100 table) ⇒  "C", true
+ (remhash 100 table) ⇒  true
+ (gethash 100 table) ⇒  NIL, false
+ (remhash 100 table) ⇒  false
+
    + +

    Side Effects::

    + +

    The hash-table is modified. +

    + + + + + diff --git a/info/gcl/remove.html b/info/gcl/remove.html new file mode 100644 index 0000000..d9fc225 --- /dev/null +++ b/info/gcl/remove.html @@ -0,0 +1,244 @@ + + + + + +remove (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.22 remove, remove-if, remove-if-not,

    +

    delete, delete-if, delete-if-not

    +

    [Function] +

    +

    remove item sequence &key from-end test test-not start end count key ⇒ result-sequence +

    +

    remove-if test sequence &key from-end start end count key ⇒ result-sequence +

    +

    remove-if-not test sequence &key from-end start end count key ⇒ result-sequence +

    +

    delete item sequence &key from-end test test-not start end count key ⇒ result-sequence +

    +

    delete-if test sequence &key from-end start end count key ⇒ result-sequence +

    +

    delete-if-not test sequence &key from-end start end count key ⇒ result-sequence +

    +

    Arguments and Values::

    + +

    item—an object. +

    +

    sequence—a proper sequence. +

    +

    test—a designator for a function + of one argument that returns a generalized boolean. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start, end—bounding index designators of sequence. + The defaults for start and end are 0 and nil, respectively. +

    +

    count—an integer or nil. +

    +

    The default is nil. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    result-sequence—a sequence. +

    +

    Description::

    + +

    remove, remove-if, and remove-if-not +return a sequence from which +the elements that satisfy the test +have been removed. +

    +

    delete, delete-if, and delete-if-not +are like remove, remove-if, and +remove-if-not respectively, +but they may modify sequence. +

    +

    If sequence is a vector, the result is a +vector that has the same +actual array element type as sequence. +The result might or might not be simple, and +might or might not be identical +to sequence. +If sequence is a list, the result is a list. +

    +

    Supplying a from-end of true matters only when the +count is provided; in that case only the rightmost count elements +satisfying the test are deleted. +

    +

    Count, if supplied, limits the number of elements +removed or deleted; if more than count elements satisfy the test, +then of these elements only the leftmost or rightmost, depending on +from-end, +are deleted or removed, +as many as specified by count. +

    +

    If count is supplied and negative, +the behavior is as if zero had been supplied instead. +

    +

    If count is nil, all matching items are affected. +

    +

    For all these functions, +elements +not removed or deleted occur in the same order in the result +as they did in sequence. +

    +

    remove, remove-if, remove-if-not return +a sequence +of the same type as sequence +that has the same elements except that those in the subsequence +bounded by start and end and satisfying the test +have been removed. +This is a non-destructive operation. If any +elements need to be removed, the result will be a copy. +The result of remove may share +with sequence; +the result may be identical to the input sequence +if no elements need to be removed. +

    +

    delete, delete-if, and delete-if-not +return a sequence +of the same type as sequence +that has the same elements except that those in the subsequence +bounded by start and end and satisfying the test +have been deleted. +Sequence may be destroyed and used to construct +the result; however, the result might or might not be identical +to sequence. +

    +

    delete, when sequence is a list, is permitted to +setf any part, car or cdr, of the +top-level list structure in that sequence. +When sequence is a vector, delete is +permitted to change the dimensions of the vector +and to slide its elements into new positions without +permuting them to produce the resulting vector. +

    +

    delete-if is constrained to behave exactly as follows: +

    +
    +
     (delete nil sequence
+             :test #'(lambda (ignore item) (funcall test item))
+             ...)
+
    + +

    Examples::

    +
    +
     (remove 4 '(1 3 4 5 9)) ⇒  (1 3 5 9)
+ (remove 4 '(1 2 4 1 3 4 5)) ⇒  (1 2 1 3 5)
+ (remove 4 '(1 2 4 1 3 4 5) :count 1) ⇒  (1 2 1 3 4 5)
+ (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) ⇒  (1 2 4 1 3 5)
+ (remove 3 '(1 2 4 1 3 4 5) :test #'>) ⇒  (4 3 4 5)
+ (setq lst '(list of four elements)) ⇒  (LIST OF FOUR ELEMENTS)
+ (setq lst2 (copy-seq lst)) ⇒  (LIST OF FOUR ELEMENTS)
+ (setq lst3 (delete 'four lst)) ⇒  (LIST OF ELEMENTS)
+ (equal lst lst2) ⇒  false
+ (remove-if #'oddp '(1 2 4 1 3 4 5)) ⇒  (2 4 4)
+ (remove-if #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) 
+⇒  (1 2 4 1 3 5)
+ (remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t)
+⇒  (1 2 3 4 5 6 8)
+ (setq tester (list 1 2 4 1 3 4 5)) ⇒  (1 2 4 1 3 4 5)
+ (delete 4 tester) ⇒  (1 2 1 3 5)
+ (setq tester (list 1 2 4 1 3 4 5)) ⇒  (1 2 4 1 3 4 5)
+ (delete 4 tester :count 1) ⇒  (1 2 1 3 4 5)
+ (setq tester (list 1 2 4 1 3 4 5)) ⇒  (1 2 4 1 3 4 5)
+ (delete 4 tester :count 1 :from-end t) ⇒  (1 2 4 1 3 5)
+ (setq tester (list 1 2 4 1 3 4 5)) ⇒  (1 2 4 1 3 4 5)
+ (delete 3 tester :test #'>) ⇒  (4 3 4 5)
+ (setq tester (list 1 2 4 1 3 4 5)) ⇒  (1 2 4 1 3 4 5)
+ (delete-if #'oddp tester) ⇒  (2 4 4)
+ (setq tester (list 1 2 4 1 3 4 5)) ⇒  (1 2 4 1 3 4 5)
+ (delete-if #'evenp tester :count 1 :from-end t) ⇒  (1 2 4 1 3 5)    
+ (setq tester (list 1 2 3 4 5 6)) ⇒  (1 2 3 4 5 6) 
+ (delete-if #'evenp tester) ⇒  (1 3 5) 
+ tester ⇒  implementation-dependent
+
    + +
    +
     (setq foo (list 'a 'b 'c)) ⇒  (A B C)
+ (setq bar (cdr foo)) ⇒  (B C)
+ (setq foo (delete 'b foo)) ⇒  (A C)
+ bar ⇒  ((C)) or ...
+ (eq (cdr foo) (car bar)) ⇒  T or ...
+
    + +

    Side Effects::

    + +

    For delete, delete-if, and delete-if-not, +sequence may be destroyed and used to construct the result. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +

    The functions delete-if-not and remove-if-not are deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/remove_002dduplicates.html b/info/gcl/remove_002dduplicates.html new file mode 100644 index 0000000..3d8182f --- /dev/null +++ b/info/gcl/remove_002dduplicates.html @@ -0,0 +1,170 @@ + + + + + +remove-duplicates (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.23 remove-duplicates, delete-duplicates [Function]

    + +

    remove-duplicates sequence &key + from-end test test-not + start end key
    + ⇒ result-sequence +

    +

    delete-duplicates sequence &key + from-end test test-not + start end key
    + ⇒ result-sequence +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start, end—bounding index designators of sequence. + The defaults for start and end are 0 and nil, respectively. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    result-sequence—a sequence. +

    +

    Description::

    + +

    remove-duplicates returns a modified copy of sequence +from which any element that matches another element occurring in +sequence has been removed. +

    +

    If sequence is a vector, the result is a +vector that has the same +actual array element type as sequence. +The result might or might not be simple, and +might or might not be identical +to sequence. +If sequence is a list, the result is a list. +

    +

    delete-duplicates is like remove-duplicates, +but delete-duplicates may modify sequence. +

    +

    The elements of sequence are compared pairwise, and if any two match, +then the one occurring earlier in sequence +is discarded, unless from-end is true, in which case the one +later in sequence is discarded. +

    +

    remove-duplicates and delete-duplicates +return a sequence of the same type as +sequence with enough elements removed so that no two of the remaining +elements match. The order of the elements remaining in the result +is the same as the order in which they appear in sequence. +

    +

    remove-duplicates returns a sequence +that may share +with sequence or may be identical to sequence +if no elements need to be removed. +

    +

    delete-duplicates, when sequence is a list, +is permitted to setf any part, car or cdr, +of the top-level list structure in that sequence. +When sequence is a vector, delete-duplicates +is permitted to change the dimensions of the vector +and to slide its elements into new positions without +permuting them to produce the resulting vector. +

    +

    Examples::

    + +
    +
     (remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) ⇒  "aBcD"
+ (remove-duplicates '(a b c b d d e)) ⇒  (A C B D E)
+ (remove-duplicates '(a b c b d d e) :from-end t) ⇒  (A B C D E)
+ (remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
+     :test #'char-equal :key #'cadr) ⇒  ((BAR #\%) (BAZ #\A))
+ (remove-duplicates '((foo #\a) (bar #\%) (baz #\A)) 
+     :test #'char-equal :key #'cadr :from-end t) ⇒  ((FOO #\a) (BAR #\%))
+ (setq tester (list 0 1 2 3 4 5 6))
+ (delete-duplicates tester :key #'oddp :start 1 :end 6) ⇒  (0 4 5 6)
+
    + +

    Side Effects::

    + +

    delete-duplicates might destructively modify sequence. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +

    These functions are useful for converting sequence into a canonical +form suitable for representing a set. +

    + + + + + +
    +
    +

    +Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/remove_002dmethod.html b/info/gcl/remove_002dmethod.html new file mode 100644 index 0000000..0d8cf41 --- /dev/null +++ b/info/gcl/remove_002dmethod.html @@ -0,0 +1,78 @@ + + + + + +remove-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.18 remove-method [Standard Generic Function]

    + +

    Syntax::

    + +

    remove-method generic-function method ⇒ generic-function +

    +

    Method Signatures::

    + +

    remove-method (generic-function standard-generic-function) + method +

    +

    Arguments and Values::

    + +

    generic-function—a generic function. +

    +

    method—a method. +

    +

    Description::

    + +

    The generic function remove-method removes a method from generic-function +by modifying the generic-function (if necessary). +

    +

    remove-method must not signal an error if the method +is not one of the methods on the generic-function. +

    +

    See Also::

    + +

    find-method +

    + + + + + diff --git a/info/gcl/remprop.html b/info/gcl/remprop.html new file mode 100644 index 0000000..8782a74 --- /dev/null +++ b/info/gcl/remprop.html @@ -0,0 +1,143 @@ + + + + + +remprop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.16 remprop [Function]

    + +

    remprop symbol indicator ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    indicator—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    remprop removes from the property list_2 of symbol +a property_1 with a property indicator +identical to indicator. +

    +

    If there are multiple properties_1 with the identical key, +remprop only removes the first such property. +

    +

    remprop returns false if no such property was found, +or true if a property was found. +

    +

    The property indicator +and the corresponding property value +are removed in an undefined order +by destructively splicing the property list. +

    +

    The permissible side-effects correspond to those permitted for remf, +such that: +

    +
    +
     (remprop x y) ≡ (remf (symbol-plist x) y)
+
    + +

    Examples::

    + +
    +
     (setq test (make-symbol "PSEUDO-PI")) ⇒  #:PSEUDO-PI
+ (symbol-plist test) ⇒  ()
+ (setf (get test 'constant) t) ⇒  T
+ (setf (get test 'approximation) 3.14) ⇒  3.14
+ (setf (get test 'error-range) 'noticeable) ⇒  NOTICEABLE
+ (symbol-plist test) 
+⇒  (ERROR-RANGE NOTICEABLE APPROXIMATION 3.14 CONSTANT T)
+ (setf (get test 'approximation) nil) ⇒  NIL
+ (symbol-plist test) 
+⇒  (ERROR-RANGE NOTICEABLE APPROXIMATION NIL CONSTANT T)
+ (get test 'approximation) ⇒  NIL
+ (remprop test 'approximation) ⇒  true
+ (get test 'approximation) ⇒  NIL
+ (symbol-plist test)
+⇒  (ERROR-RANGE NOTICEABLE CONSTANT T)
+ (remprop test 'approximation) ⇒  NIL
+ (symbol-plist test)
+⇒  (ERROR-RANGE NOTICEABLE CONSTANT T)
+ (remprop test 'error-range) ⇒  true
+ (setf (get test 'approximation) 3) ⇒  3
+ (symbol-plist test)
+⇒  (APPROXIMATION 3 CONSTANT T)
+
    + +

    Side Effects::

    + +

    The property list of symbol is modified. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    See Also::

    + +

    remf +, +symbol-plist +

    +

    Notes::

    + +

    Numbers and characters are not recommended for use as +indicators in portable code since remprop tests with +eq rather than eql, and consequently the effect of +using such indicators is implementation-dependent. +Of course, if you’ve gotten as far as needing to remove such a +property, you don’t have much choice—the time to have been +thinking about this was when you used setf of get to +establish the property. +

    +
    +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    + + + + + diff --git a/info/gcl/rename_002dfile.html b/info/gcl/rename_002dfile.html new file mode 100644 index 0000000..794c851 --- /dev/null +++ b/info/gcl/rename_002dfile.html @@ -0,0 +1,131 @@ + + + + + +rename-file (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.7 rename-file [Function]

    + +

    rename-file filespec new-name ⇒ defaulted-new-name, old-truename, new-truename +

    +

    Arguments and Values::

    + +

    filespec—a pathname designator. +

    +

    new-name—a pathname designator +other than a stream. +

    +

    defaulted-new-name—a pathname +

    +

    old-truename—a physical pathname. +

    +

    new-truename—a physical pathname. +

    +

    Description::

    + +

    rename-file modifies the file system in such a way +that the file indicated by filespec is renamed to +defaulted-new-name. +

    +

    It is an error to specify a filename containing a wild component, +for filespec to contain a nil component where the file system does +not permit a nil component, or for the result of defaulting missing +components of new-name from filespec to contain a nil component +where the file system does not permit a nil component. +

    +

    If new-name is a logical pathname, +rename-file returns a logical pathname as its primary value. +

    +

    rename-file +returns three values if successful. The primary value, defaulted-new-name, +is the resulting name which is composed of +new-name with any missing components filled in by performing +a merge-pathnames operation using filespec as the defaults. +The secondary value, old-truename, +is the truename of the file before it was renamed. +The tertiary value, new-truename, +is the truename of the file after it was renamed. +

    +

    If the filespec designator is an open stream, +then the stream itself and the file associated with it are +affected (if the file system permits). +

    +

    Examples::

    + +
    +
    ;; An example involving logical pathnames.
+ (with-open-file (stream "sys:chemistry;lead.text"
+                         :direction :output :if-exists :error)
+   (princ "eureka" stream)
+   (values (pathname stream) (truename stream)))
+⇒  #P"SYS:CHEMISTRY;LEAD.TEXT.NEWEST", #P"Q:>sys>chem>lead.text.1"
+ (rename-file "sys:chemistry;lead.text" "gold.text")
+⇒  #P"SYS:CHEMISTRY;GOLD.TEXT.NEWEST",
+   #P"Q:>sys>chem>lead.text.1",
+   #P"Q:>sys>chem>gold.text.1"
+
    + +

    Exceptional Situations::

    + +

    If the renaming operation is not successful, an error of type file-error is signaled. +

    +

    An error of type file-error might be signaled if filespec is wild. +

    +

    See Also::

    + +

    truename +, +pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    + + + + + diff --git a/info/gcl/rename_002dpackage.html b/info/gcl/rename_002dpackage.html new file mode 100644 index 0000000..b147d9b --- /dev/null +++ b/info/gcl/rename_002dpackage.html @@ -0,0 +1,89 @@ + + + + + +rename-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.8 rename-package [Function]

    + +

    rename-package package new-name &optional new-nicknames ⇒ package-object +

    +

    Arguments and Values::

    + +

    package—a package designator. +

    +

    new-name—a package designator. +

    +

    new-nicknames—a list of string designators. + The default is the empty list. +

    +

    package-object—the renamed package object. +

    +

    Description::

    + +

    Replaces the name and nicknames of package. +The old name and all of the old nicknames of package are eliminated +and are replaced by new-name and new-nicknames. +

    +

    The consequences are undefined if new-name or any new-nickname +conflicts with any existing package names. +

    +

    Examples::

    + +
    +
     (make-package 'temporary :nicknames '("TEMP")) ⇒  #<PACKAGE "TEMPORARY">
+ (rename-package 'temp 'ephemeral) ⇒  #<PACKAGE "EPHEMERAL">
+ (package-nicknames (find-package 'ephemeral)) ⇒  ()
+ (find-package 'temporary) ⇒  NIL
+ (rename-package 'ephemeral 'temporary '(temp fleeting))
+⇒  #<PACKAGE "TEMPORARY">
+ (package-nicknames (find-package 'temp)) ⇒  ("TEMP" "FLEETING")
+
    + +

    See Also::

    + +

    make-package +

    + + + + + diff --git a/info/gcl/replace.html b/info/gcl/replace.html new file mode 100644 index 0000000..53a32ce --- /dev/null +++ b/info/gcl/replace.html @@ -0,0 +1,124 @@ + + + + + +replace (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.18 replace [Function]

    + +

    replace sequence-1 sequence-2 &key start1 end1 start2 end2 ⇒ sequence-1 +

    +

    Arguments and Values::

    + +

    sequence-1—a sequence. +

    +

    sequence-2—a sequence. +

    +

    start1, end1—bounding index designators of sequence-1. + The defaults for start1 and end1 are 0 and nil, respectively. +

    +

    start2, end2—bounding index designators of sequence-2. + The defaults for start2 and end2 are 0 and nil, respectively. +

    +

    Description::

    + +

    Destructively modifies sequence-1 +by replacing the elements of subsequence-1 + bounded by start1 and end1 +with the elements of subsequence-2 + bounded by start2 and end2. +

    +

    Sequence-1 is destructively modified by copying successive +elements into it from sequence-2. +Elements of the subsequence of sequence-2 +bounded by start2 and end2 +are copied into the subsequence of sequence-1 +bounded by start1 and end1. +If these subsequences are not of the same length, +then the shorter length determines how many elements are copied; +the extra elements near the end of the longer subsequence +are not involved in the operation. +The number of elements copied can be expressed as: +

    +
    +
     (min (- end1 start1) (- end2 start2))
+
    + +

    If sequence-1 and sequence-2 are the same object +and the region being modified overlaps the region being copied +from, then it is as if the entire source region were copied to another +place and only then copied back into the target region. +However, if sequence-1 and sequence-2 are not the same, +but the region being modified overlaps the region being copied from +(perhaps because of shared list structure or displaced arrays), +then after the replace operation +the subsequence of sequence-1 being modified will have +unpredictable contents. +It is an error if the elements of sequence-2 are not of a +type that can be stored into sequence-1. +

    +

    Examples::

    +
    +
     (replace "abcdefghij" "0123456789" :start1 4 :end1 7 :start2 4) 
+⇒  "abcd456hij"
+ (setq lst "012345678") ⇒  "012345678"
+ (replace lst lst :start1 2 :start2 0) ⇒  "010123456"
+ lst ⇒  "010123456"
+
    + +

    Side Effects::

    + +

    The sequence-1 is modified. +

    +

    See Also::

    + +

    fill +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/rest.html b/info/gcl/rest.html new file mode 100644 index 0000000..bf34dd0 --- /dev/null +++ b/info/gcl/rest.html @@ -0,0 +1,96 @@ + + + + + +rest (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.32 rest [Accessor]

    + +

    rest list ⇒ tail +

    +

    (setf ( rest list) new-tail)
    +

    +

    Arguments and Values::

    + +

    list—a list, +

    +

    which might be a dotted list or a circular list. +

    +

    tail—an object. +

    +

    Description::

    + +

    rest performs the same operation as cdr, +but mnemonically complements first. +Specifically, +

    +
    +
     (rest list) ≡ (cdr list)
+ (setf (rest list) new-tail) ≡ (setf (cdr list) new-tail)
+
    + +

    Examples::

    + +
    +
     (rest '(1 2)) ⇒  (2)
+ (rest '(1 . 2)) ⇒  2
+ (rest '(1)) ⇒  NIL
+ (setq *cons* '(1 . 2)) ⇒  (1 . 2)
+ (setf (rest *cons*) "two") ⇒  "two"
+ *cons* ⇒  (1 . "two")
+
    + +

    See Also::

    + +

    cdr, +nthcdr +

    +

    Notes::

    + +

    rest is often preferred stylistically over cdr +when the argument is to being subjectively viewed as a list +rather than as a cons. +

    + + + + + diff --git a/info/gcl/restart.html b/info/gcl/restart.html new file mode 100644 index 0000000..40cf4d4 --- /dev/null +++ b/info/gcl/restart.html @@ -0,0 +1,65 @@ + + + + + +restart (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.31 restart [System Class]

    + +

    Class Precedence List::

    +

    restart, +t +

    +

    Description::

    + +

    An object of type restart represents a function that can be +called to perform some form of recovery action, usually a transfer of control +to an outer point in the running program. +

    +

    An implementation is free to implement a restart in whatever +manner is most convenient; a restart has only dynamic extent +relative to the scope of the binding form which establishes it. +

    + + + + + diff --git a/info/gcl/restart_002dbind.html b/info/gcl/restart_002dbind.html new file mode 100644 index 0000000..f906ae9 --- /dev/null +++ b/info/gcl/restart_002dbind.html @@ -0,0 +1,171 @@ + + + + + +restart-bind (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.36 restart-bind [Macro]

    + +

    restart-bind ({(name function + {!key-val-pair}*)}) + {form}*
    + ⇒ {result}* +

    +

    key-val-pair ::=:interactive-function interactive-function |  +                 :report-function report-function |  +                 :test-function test-function +

    +

    Arguments and Values::

    + +

    name—a symbol; not evaluated. +

    +

    function—a form; evaluated. +

    +

    forms—an implicit progn. +

    +

    interactive-function—a form; evaluated. +

    +

    report-function—a form; evaluated. +

    +

    test-function—a form; evaluated. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    restart-bind executes the body of forms +in a dynamic environment where restarts with the given names are in effect. +

    +

    If a name is nil, it indicates an anonymous restart; +if a name is a non-nil symbol, it indicates a named restart. +

    +

    The function, interactive-function, and report-function +are unconditionally evaluated in the current lexical and dynamic environment +prior to evaluation of the body. Each of these forms must evaluate to +a function. +

    +

    If invoke-restart is done on that restart, +the function which resulted from evaluating function +is called, in the dynamic environment of the invoke-restart, +with the arguments given to invoke-restart. +The function may either perform a non-local transfer of control or may return normally. +

    +

    If the restart is invoked interactively from the debugger +(using invoke-restart-interactively), +the arguments are defaulted by calling the function +which resulted from evaluating interactive-function. +That function may optionally prompt interactively on query I/O, +and should return a list of arguments to be used by +invoke-restart-interactively when invoking the restart. +

    +

    If a restart is invoked interactively but no interactive-function is used, +then an argument list of nil is used. In that case, the function +must be compatible with an empty argument list. +

    +

    If the restart is presented interactively (e.g., by the debugger), +the presentation is done by calling the function which resulted +from evaluating report-function. +This function must be a function of one argument, a stream. +It is expected to print a description of the action that the restart takes +to that stream. +This function is called any time the restart is printed +while *print-escape* is nil. +

    +

    In the case of interactive invocation, +the result is dependent on the value of :interactive-function +as follows. +

    +
    +
    :interactive-function
    +

    Value is evaluated in the current lexical environment and + should return a function of no arguments which constructs a + list of arguments to be used by invoke-restart-interactively + when invoking this restart. The function may prompt interactively + using query I/O if necessary. +

    +
    +
    :report-function
    +

    Value is evaluated in the current lexical environment and + should return a function of one argument, a stream, which + prints on the stream a summary of the action that this restart + takes. This function is called whenever the restart is + reported (printed while *print-escape* is nil). + If no :report-function option is provided, the manner in which the + restart is reported is implementation-dependent. +

    +
    +
    :test-function
    +

    Value is evaluated in the current lexical environment and + should return a function of one argument, a condition, which + returns true if the restart is to be considered visible. +

    +
    +
    + +

    Affected By::

    + +

    *query-io*. +

    +

    See Also::

    + +

    restart-case +, +with-simple-restart +

    +

    Notes::

    + +

    restart-bind is primarily intended to be used to implement +restart-case and might be useful in implementing other +macros. Programmers who are uncertain about whether to use restart-case +or restart-bind should prefer restart-case for the cases where +it is powerful enough, using restart-bind only in cases where its full +generality is really needed. +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/restart_002dcase.html b/info/gcl/restart_002dcase.html new file mode 100644 index 0000000..5ed562d --- /dev/null +++ b/info/gcl/restart_002dcase.html @@ -0,0 +1,332 @@ + + + + + +restart-case (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.37 restart-case [Macro]

    + +

    restart-case restartable-form {!clause} ⇒ {result}* +

    +

    clause ::=( case-name lambda-list  +            [[:interactive interactive-expression | :report report-expression | :test test-expression]]  +            {declaration}* {form}*) +

    +

    Arguments and Values::

    + +

    restartable-form—a form. +

    +

    case-name—a symbol or nil. +

    +

    lambda-list—an ordinary lambda list. +

    +

    interactive-expression—a symbol or a lambda expression. +

    +

    report-expression—a string, + a symbol, + or a lambda expression. +

    +

    test-expression—a symbol or a lambda expression. +

    +

    declaration—a declare expression; not evaluated. +

    +

    form—a form. +

    +

    results—the values resulting from the evaluation + of restartable-form, + or the values returned by the last form + executed in a chosen clause, + or nil. +

    +

    Description::

    + +

    restart-case evaluates restartable-form in a dynamic environment +where the clauses have special meanings as points to which control may be transferred. +If restartable-form finishes executing and returns any values, +all values returned are returned by restart-case and +processing has completed. While restartable-form is executing, any code may + transfer control to one of the clauses (see invoke-restart). +If a transfer + occurs, the forms in the body of that clause is evaluated and any values + returned by the last such form are returned by +restart-case. +In this case, the +dynamic state is unwound appropriately (so that the restarts established +around the restartable-form are no longer active) prior to execution of the +clause. +

    +

    If there are no forms +in a selected clause, restart-case returns nil. +

    +

    If case-name is a symbol, it names this restart. +

    +

    It is possible to have more than one clause use the same case-name. +In this case, the first clause with that name is found by find-restart. +The other clauses are accessible using compute-restarts. +

    +

    Each arglist is an ordinary lambda list to be bound during the +execution of its corresponding forms. These parameters are used +by the restart-case clause to receive any necessary data from a call +to invoke-restart. +

    +

    By default, invoke-restart-interactively passes no arguments and +all arguments must be optional in order to accomodate interactive +restarting. However, the arguments need not be optional if the +:interactive +keyword has been used to inform invoke-restart-interactively + about how to compute a proper argument list. +

    +

    Keyword options have the following meaning. +

    +
    :interactive
    +

    The value supplied by :interactive value +must be a suitable argument to function. +(function value) is evaluated in the current lexical + environment. It should return a function of no arguments which + returns arguments to be used by +invoke-restart-interactively when it is invoked. +invoke-restart-interactively +is called in the dynamic + environment available prior to any restart attempt, and uses +query I/O for user interaction. +

    +

    If a restart is invoked interactively but no :interactive option + was supplied, the argument list used in the invocation is the empty + list. +

    +
    +
    :report
    +

    If the value supplied by :report value +is a lambda expression or a symbol, it +must be acceptable to function. +(function value) is evaluated in the current lexical +environment. It should return a function of one +argument, a stream, which prints on the stream a +description of the restart. This function is called +whenever the restart is printed while *print-escape* is nil. +

    +

    If value is a string, it is a shorthand for +

    +
    +
     (lambda (stream) (write-string value stream))
+
    + +

    If a named restart is asked to report but no report information has been + supplied, the name of the restart is used in generating default report text. +

    +

    When *print-escape* is nil, the +printer uses the report information for + a restart. For example, a debugger might announce the action of typing + a “continue” command by: +

    +
    +
     (format t "~&~S -- ~A~
+
    + +

    which might then display as something like: +

    +
    +
     :CONTINUE -- Return to command level
+
    + +

    The consequences are unspecified if an unnamed restart is specified +but no :report option is provided. +

    +
    +
    :test
    +

    The value supplied by :test value +must be a suitable argument to function. +(function value) is evaluated in the current lexical + environment. It should return a function of one argument, the +condition, that +returns true if the restart is to be considered visible. +

    +

    The default for this option is equivalent to (lambda (c) (declare (ignore c)) t). +

    +
    +
    + +

    If the restartable-form is a list whose car is any of +the symbols signal, error, cerror, +or warn (or is a macro form which macroexpands into such a +list), then with-condition-restarts is used implicitly +to associate the indicated restarts with the condition to be +signaled. +

    +

    Examples::

    + +
    +
     (restart-case
+     (handler-bind ((error #'(lambda (c)
+                             (declare (ignore condition))
+                             (invoke-restart 'my-restart 7))))
+       (error "Foo."))
+   (my-restart (&optional v) v))
+⇒  7
+
+ (define-condition food-error (error) ())
+⇒  FOOD-ERROR
+ (define-condition bad-tasting-sundae (food-error) 
+   ((ice-cream :initarg :ice-cream :reader bad-tasting-sundae-ice-cream)
+    (sauce :initarg :sauce :reader bad-tasting-sundae-sauce)
+    (topping :initarg :topping :reader bad-tasting-sundae-topping))
+   (:report (lambda (condition stream)
+              (format stream "Bad tasting sundae with ~S, ~S, and ~S"
+                      (bad-tasting-sundae-ice-cream condition)
+                      (bad-tasting-sundae-sauce condition)
+                      (bad-tasting-sundae-topping condition)))))
+⇒  BAD-TASTING-SUNDAE
+ (defun all-start-with-same-letter (symbol1 symbol2 symbol3)
+   (let ((first-letter (char (symbol-name symbol1) 0)))
+     (and (eql first-letter (char (symbol-name symbol2) 0))
+          (eql first-letter (char (symbol-name symbol3) 0)))))
+⇒  ALL-START-WITH-SAME-LETTER
+ (defun read-new-value ()
+   (format t "Enter a new value: ")
+   (multiple-value-list (eval (read))))
+⇒  READ-NEW-VALUE
+
     (defun verify-or-fix-perfect-sundae (ice-cream sauce topping)
+   (do ()
+      ((all-start-with-same-letter ice-cream sauce topping))
+     (restart-case
+       (error 'bad-tasting-sundae
+              :ice-cream ice-cream
+              :sauce sauce
+              :topping topping)
+       (use-new-ice-cream (new-ice-cream)
+         :report "Use a new ice cream."
+         :interactive read-new-value  
+         (setq ice-cream new-ice-cream))
+       (use-new-sauce (new-sauce)
+         :report "Use a new sauce."
+         :interactive read-new-value
+         (setq sauce new-sauce))
+       (use-new-topping (new-topping)
+         :report "Use a new topping."
+         :interactive read-new-value
+         (setq topping new-topping))))
+   (values ice-cream sauce topping))
+⇒  VERIFY-OR-FIX-PERFECT-SUNDAE
+ (verify-or-fix-perfect-sundae 'vanilla 'caramel 'cherry)
+ |>  Error: Bad tasting sundae with VANILLA, CARAMEL, and CHERRY.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Use a new ice cream.
+ |>   2: Use a new sauce.
+ |>   3: Use a new topping.
+ |>   4: Return to Lisp Toplevel.
+ |>  Debug> |>>:continue 1<<|
+ |>  Use a new ice cream.
+ |>  Enter a new ice cream: |>>'chocolate<<|
+⇒  CHOCOLATE, CARAMEL, CHERRY
+
    + +

    See Also::

    + +

    restart-bind +, +with-simple-restart +. +

    +

    Notes::

    + +
    +
     (restart-case expression
+    (name1 arglist1 ...options1... . body1)
+    (name2 arglist2 ...options2... . body2))
+
    + +

    is essentially equivalent to +

    +
    +
     (block #1=#:g0001
+   (let ((#2=#:g0002 nil))
+        (tagbody
+        (restart-bind ((name1 #'(lambda (&rest temp)
+                                (setq #2# temp)
+                                (go #3=#:g0003))
+                          ...slightly-transformed-options1...)
+                       (name2 #'(lambda (&rest temp)
+                                (setq #2# temp)
+                                (go #4=#:g0004))
+                          ...slightly-transformed-options2...))
+        (return-from #1# expression))
+          #3# (return-from #1#
+                  (apply #'(lambda arglist1 . body1) #2#))
+          #4# (return-from #1#
+                  (apply #'(lambda arglist2 . body2) #2#)))))
+
    + +

    Unnamed restarts are generally only useful interactively + and an interactive option which has no description is of little value. + Implementations are encouraged to warn if +an unnamed restart is used and no report information + is provided +at compilation time. +At runtime, this error might be noticed when entering + the debugger. Since signaling an error would probably cause recursive + entry into the debugger (causing yet another recursive error, etc.) it is + suggested that the debugger print some indication of such problems when + they occur but not actually signal errors. +

    +
    +
     (restart-case (signal fred)
+   (a ...)
+   (b ...))
+ ≡
+ (restart-case
+     (with-condition-restarts fred 
+                              (list (find-restart 'a) 
+                                    (find-restart 'b))
+       (signal fred))
+   (a ...)
+   (b ...))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/restart_002dname.html b/info/gcl/restart_002dname.html new file mode 100644 index 0000000..51773d3 --- /dev/null +++ b/info/gcl/restart_002dname.html @@ -0,0 +1,85 @@ + + + + + +restart-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.38 restart-name [Function]

    + +

    restart-name restart ⇒ name +

    +

    Arguments and Values::

    + +

    restart—a restart. +

    +

    name—a symbol. +

    +

    Description::

    + +

    Returns the name of the restart, +or nil if the restart is not named. +

    +

    Examples::

    + +
    +
     (restart-case 
+     (loop for restart in (compute-restarts)
+               collect (restart-name restart))
+   (case1 () :report "Return 1." 1)
+   (nil   () :report "Return 2." 2)
+   (case3 () :report "Return 3." 3)
+   (case1 () :report "Return 4." 4))
+⇒  (CASE1 NIL CASE3 CASE1 ABORT)
+ ;; In the example above the restart named ABORT was not created
+ ;; explicitly, but was implicitly supplied by the system.
+
    + +

    See Also::

    + +

    compute-restarts +

    +

    find-restart +

    + + + + + diff --git a/info/gcl/return.html b/info/gcl/return.html new file mode 100644 index 0000000..6d8f9be --- /dev/null +++ b/info/gcl/return.html @@ -0,0 +1,92 @@ + + + + + +return (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.26 return [Macro]

    + +

    return [result] ⇒ #<NoValue> +

    +

    Arguments and Values::

    + +

    result—a form; evaluated. + The default is nil. +

    +

    Description::

    + +

    Returns, as if by return-from, from the block named nil. +

    +

    Examples::

    + +
    +
     (block nil (return) 1) ⇒  NIL
+ (block nil (return 1) 2) ⇒  1
+ (block nil (return (values 1 2)) 3) ⇒  1, 2
+ (block nil (block alpha (return 1) 2)) ⇒  1
+ (block alpha (block nil (return 1)) 2) ⇒  2
+ (block nil (block nil (return 1) 2)) ⇒  1
+
    + +

    See Also::

    + +

    block +, +return-from +, +Evaluation +

    +

    Notes::

    + +
    +
     (return) ≡ (return-from nil)
+ (return form) ≡ (return-from nil form)
+
    + +

    The implicit blocks established by macros such as do +are often named nil, so that return can be used to exit from +such forms. +

    + + + + + diff --git a/info/gcl/return_002dfrom.html b/info/gcl/return_002dfrom.html new file mode 100644 index 0000000..76ac2fb --- /dev/null +++ b/info/gcl/return_002dfrom.html @@ -0,0 +1,141 @@ + + + + + +return-from (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.25 return-from [Special Operator]

    + +

    return-from name [result] + ⇒ #<NoValue> +

    Arguments and Values::

    + +

    name—a block tag; not evaluated. +

    +

    result—a form; evaluated. + The default is nil. +

    +

    Description::

    + +

    Returns control and multiple values_2 from a lexically enclosing block. +

    +

    A block form named name must lexically enclose +the occurrence of return-from; any values yielded +by the evaluation of result are immediately returned from +the innermost such lexically enclosing block. +

    +

    The transfer of control initiated by return-from is performed +as described in Transfer of Control to an Exit Point. +

    +

    Examples::

    + +
    +
     (block alpha (return-from alpha) 1) ⇒  NIL
+ (block alpha (return-from alpha 1) 2) ⇒  1
+ (block alpha (return-from alpha (values 1 2)) 3) ⇒  1, 2
+ (let ((a 0))
+    (dotimes (i 10) (incf a) (when (oddp i) (return)))
+    a) ⇒  2
+ (defun temp (x)
+    (if x (return-from temp 'dummy))
+    44) ⇒  TEMP
+ (temp nil) ⇒  44
+ (temp t) ⇒  DUMMY
+ (block out
+   (flet ((exit (n) (return-from out n)))
+     (block out (exit 1)))
+   2) ⇒  1
+ (block nil   
+   (unwind-protect (return-from nil 1)
+     (return-from nil 2)))
+⇒  2
+ (dolist (flag '(nil t))
+   (block nil
+     (let ((x 5))
+       (declare (special x))
+       (unwind-protect (return-from nil)
+         (print x))))
+   (print 'here))
+ |>  5
+ |>  HERE
+ |>  5
+ |>  HERE
+⇒  NIL
+ (dolist (flag '(nil t))
+   (block nil
+     (let ((x 5))
+       (declare (special x))
+       (unwind-protect
+           (if flag (return-from nil))
+         (print x))))
+   (print 'here))
+ |>  5
+ |>  HERE
+ |>  5
+ |>  HERE
+⇒  NIL
+
    + +

    The following has undefined consequences because the block form +exits normally before the return-from form is attempted. +

    +
    +
     (funcall (block nil #'(lambda () (return-from nil)))) is an error.
+
    + +

    See Also::

    + +

    block +, +return +, +Evaluation +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/revappend.html b/info/gcl/revappend.html new file mode 100644 index 0000000..3b0f0ed --- /dev/null +++ b/info/gcl/revappend.html @@ -0,0 +1,141 @@ + + + + + +revappend (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.27 revappend, nreconc [Function]

    + +

    revappend list tail ⇒ result-list +

    +

    nreconc list tail ⇒ result-list +

    +

    Arguments and Values::

    + +

    list—a proper list. +

    +

    tail—an object. +

    +

    result-list—an object. +

    +

    Description::

    + +

    revappend constructs a copy_2 of list, +but with the elements in reverse order. It then appends (as if +by nconc) the tail to that reversed list and returns the result. +

    +

    nreconc reverses the order of elements in list +(as if by nreverse). It then appends (as if by nconc) +the tail to that reversed list and returns the result. +

    +

    The resulting list shares list structure with tail. +

    +

    Examples::

    + +
    +
     (let ((list-1 (list 1 2 3))
+       (list-2 (list 'a 'b 'c)))
+   (print (revappend list-1 list-2))
+   (print (equal list-1 '(1 2 3)))
+   (print (equal list-2 '(a b c))))
+ |>  (3 2 1 A B C) 
+ |>  T
+ |>  T
+⇒  T
+
+ (revappend '(1 2 3) '()) ⇒  (3 2 1)
+ (revappend '(1 2 3) '(a . b)) ⇒  (3 2 1 A . B)
+ (revappend '() '(a b c)) ⇒  (A B C)
+ (revappend '(1 2 3) 'a) ⇒  (3 2 1 . A)
+ (revappend '() 'a) ⇒  A   ;degenerate case
+
+ (let ((list-1 '(1 2 3))
+       (list-2 '(a b c)))
+   (print (nreconc list-1 list-2))
+   (print (equal list-1 '(1 2 3)))
+   (print (equal list-2 '(a b c))))
+ |>  (3 2 1 A B C) 
+ |>  NIL
+ |>  T
+⇒  T
+
+
    + +

    Side Effects::

    + +

    revappend does not modify either of its arguments. +nreconc is permitted to modify list but not tail. +

    +

    Although it might be implemented differently, +nreconc is constrained to have side-effect behavior equivalent to: +

    +
    +
     (nconc (nreverse list) tail)
+
    + +

    See Also::

    + +

    reverse +, +nreverse, +nconc +

    +

    Notes::

    + +

    The following functional equivalences are true, +although good implementations will typically use a faster algorithm for +achieving the same effect: +

    +
    +
     (revappend list tail) ≡ (nconc (reverse list) tail)
+ (nreconc list tail) ≡ (nconc (nreverse list) tail)
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/reverse.html b/info/gcl/reverse.html new file mode 100644 index 0000000..46ae078 --- /dev/null +++ b/info/gcl/reverse.html @@ -0,0 +1,122 @@ + + + + + +reverse (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.12 reverse, nreverse [Function]

    + +

    reverse sequence ⇒ reversed-sequence +

    +

    nreverse sequence ⇒ reversed-sequence +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    reversed-sequence—a sequence. +

    +

    Description::

    + +

    reverse and nreverse return a new sequence +of the same kind as sequence, containing the same elements, +but in reverse order. +

    +

    reverse and nreverse differ in that reverse +always creates and returns a new sequence, whereas nreverse +might modify and return the given sequence. reverse never +modifies the given sequence. +

    +

    For reverse, if sequence is a vector, +the result is a fresh simple array of rank one +that has the same actual array element type as sequence. +If sequence is a list, the result is a fresh list. +

    +

    For nreverse, if sequence is a vector, +the result is a vector +that has the same actual array element type as sequence. +If sequence is a list, the result is a list. +

    +

    For nreverse, +sequence might be destroyed and re-used to produce the result. +The result might or might not be identical to sequence. +

    +

    Specifically, when sequence is a list, +nreverse is permitted to setf any part, car or cdr, +of any cons that is part of the list structure of sequence. +When sequence is a vector, +nreverse is permitted to re-order the elements of sequence +in order to produce the resulting vector. +

    +

    Examples::

    +
    +
     (setq str "abc") ⇒  "abc"
+ (reverse str) ⇒  "cba"
+ str ⇒  "abc"
+ (setq str (copy-seq str)) ⇒  "abc"
+ (nreverse str) ⇒  "cba"
+ str ⇒  implementation-dependent
+ (setq l (list 1 2 3)) ⇒  (1 2 3)
+ (nreverse l) ⇒  (3 2 1)
+ l ⇒  implementation-dependent
+
    + +

    Side Effects::

    + +

    nreverse might either create a new sequence, +modify the argument sequence, or both. +(reverse does not modify sequence.) +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/room.html b/info/gcl/room.html new file mode 100644 index 0000000..531d2d6 --- /dev/null +++ b/info/gcl/room.html @@ -0,0 +1,82 @@ + + + + + +room (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.16 room [Function]

    + +

    room &optional x ⇒ implementation-dependent +

    +

    Arguments and Values::

    + +

    x—one of t, nil, or :default. +

    +

    Description::

    + +

    room prints, to standard output, +information about the state of internal storage and its management. +This might include descriptions of the amount of memory in use and +the degree of memory compaction, possibly broken down by internal data type if that +is appropriate. The nature and format of the printed information is +implementation-dependent. +The intent is to provide information that a programmer +might use to tune a program for a particular implementation. +

    +

    (room nil) prints out a minimal amount of information. +(room t) prints out a maximal amount of information. +

    +

    (room) or (room :default) prints out an intermediate amount +of information that is likely to be useful. +

    +

    Side Effects::

    + +

    Output to standard output. +

    +

    Affected By::

    + +

    *standard-output*. +

    + + + + + diff --git a/info/gcl/rotatef.html b/info/gcl/rotatef.html new file mode 100644 index 0000000..d514581 --- /dev/null +++ b/info/gcl/rotatef.html @@ -0,0 +1,117 @@ + + + + + +rotatef (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.66 rotatef [Macro]

    + +

    rotatef {place}* ⇒ nil +

    +

    Arguments and Values::

    + +

    place—a place. +

    +

    Description::

    + +

    rotatef modifies the values of each place by +rotating values from one place into another. +

    +

    If a place produces more values than there +are store variables, the extra values are ignored. If a place +produces fewer values than there are store variables, the missing values +are set to nil. +

    +

    In the form (rotatef place1 place2 ... placen), +the values in place1 through placen are read and written. +Values 2 through n +and value 1 are then stored into place1 through placen. +It is as if all the places form an end-around shift register +that is rotated one place to the left, with the value of place1 +being shifted around the end to placen. +

    +

    For information about the evaluation of subforms of places, +see Evaluation of Subforms to Places. +

    +

    Examples::

    +
    +
     (let ((n 0)
+        (x (list 'a 'b 'c 'd 'e 'f 'g)))
+    (rotatef (nth (incf n) x)
+             (nth (incf n) x)
+             (nth (incf n) x))
+    x) ⇒  (A C D B E F G)
+
    + +

    See Also::

    + +

    define-setf-expander +, +defsetf +, +setf +, +shiftf +, +*macroexpand-hook*, +Generalized Reference +

    +

    Notes::

    + +

    The effect of + (rotatef place1 place2 ... placen) +is roughly equivalent to +

    +
    +
     (psetf place1 place2
+        place2 place3
+        ...
+        placen place1)
+
    + +

    except that the latter would evaluate any subforms +of each place twice, whereas rotatef evaluates them once. +

    + + + + + diff --git a/info/gcl/row_002dmajor_002daref.html b/info/gcl/row_002dmajor_002daref.html new file mode 100644 index 0000000..9da47fb --- /dev/null +++ b/info/gcl/row_002dmajor_002daref.html @@ -0,0 +1,90 @@ + + + + + +row-major-aref (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.22 row-major-aref [Accessor]

    + +

    row-major-aref array index ⇒ element +

    +

    (setf ( row-major-aref array index) new-element)
    +

    +

    Arguments and Values::

    + +

    array—an array. +

    +

    index—a valid array row-major index for the array. +

    +

    element, new-element—an object. +

    +

    Description::

    + +

    Considers array as a vector by viewing its elements +in row-major order, and returns the element of that vector +which is referred to by the given index. +

    +

    row-major-aref is valid for use with setf. +

    +

    See Also::

    + +

    aref +, +array-row-major-index +

    +

    Notes::

    + +
    +
     (row-major-aref array index) ≡
+   (aref (make-array (array-total-size array)
+                     :displaced-to array
+                     :element-type (array-element-type array))
+         index)
+
+ (aref array i1 i2 ...) ≡
+     (row-major-aref array (array-row-major-index array i1 i2))
+
    + + + + + + diff --git a/info/gcl/rplaca.html b/info/gcl/rplaca.html new file mode 100644 index 0000000..62a2582 --- /dev/null +++ b/info/gcl/rplaca.html @@ -0,0 +1,94 @@ + + + + + +rplaca (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.8 rplaca, rplacd [Function]

    + +

    rplaca cons object ⇒ cons +

    +

    rplacd cons object ⇒ cons +

    +

    Pronunciation::

    + +

    rplaca: pronounced ,r\=e ’plak e + or pronounced ,re ’plak e +

    +

    rplacd: pronounced ,r\=e ’plak de + or pronounced ,re ’plak de + or pronounced ,r\=e ’plak d\=e + or pronounced ,re ’plak d\=e +

    +

    Arguments and Values::

    + +

    cons—a cons. +

    +

    object—an object. +

    +

    Description::

    + +

    rplaca replaces the car of the cons with object. +

    +

    rplacd replaces the cdr of the cons with object. +

    +

    Examples::

    +
    +
     (defparameter *some-list* (list* 'one 'two 'three 'four)) ⇒  *some-list*
+ *some-list* ⇒  (ONE TWO THREE . FOUR)
+ (rplaca *some-list* 'uno) ⇒  (UNO TWO THREE . FOUR)
+ *some-list* ⇒  (UNO TWO THREE . FOUR)
+ (rplacd (last *some-list*) (list 'IV)) ⇒  (THREE IV)
+ *some-list* ⇒  (UNO TWO THREE IV)
+
    + +

    Side Effects::

    + +

    The cons is modified. +

    +

    Should signal an error of type type-error + if cons is not a cons. +

    + + + + + diff --git a/info/gcl/satisfies.html b/info/gcl/satisfies.html new file mode 100644 index 0000000..3b5feee --- /dev/null +++ b/info/gcl/satisfies.html @@ -0,0 +1,82 @@ + + + + + +satisfies (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.17 satisfies [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Predicating. +

    +

    Compound Type Specifier Syntax::

    + +

    (satisfies{predicate-name}) +

    +

    Compound Type Specifier Arguments::

    + +

    predicate-name—a symbol. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of all objects that satisfy the +predicate predicate-name, which must be a symbol +whose global function definition is a one-argument +predicate. A name is required for predicate-name; +lambda expressions are not allowed. +For example, the type specifier (and integer (satisfies evenp)) +denotes the set of all even integers. +The form (typep x '(satisfies p)) is equivalent to +(if (p x) t nil). +

    +

    The argument is required. +The symbol * can be the argument, but it +denotes itself (the symbol *), +and does not represent an unspecified value. +

    +

    The symbol satisfies is not valid as a type specifier. +

    + + + + + diff --git a/info/gcl/search.html b/info/gcl/search.html new file mode 100644 index 0000000..426466b --- /dev/null +++ b/info/gcl/search.html @@ -0,0 +1,124 @@ + + + + + +search (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.16 search [Function]

    + +

    search sequence-1 sequence-2 + &key from-end test test-not + key start1 start2 + end1 end2
    + ⇒ position +

    +

    Arguments and Values::

    + +

    Sequence-1—a sequence. +

    +

    Sequence-2—a sequence. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start1, end1—bounding index designators of sequence-1. + The defaults for start1 and end1 are 0 and nil, respectively. +

    +

    start2, end2—bounding index designators of sequence-2. + The defaults for start2 and end2 are 0 and nil, respectively. +

    +

    position—a bounding index of sequence-2, + or nil. +

    +

    Description::

    + +

    Searches sequence-2 for a subsequence that matches sequence-1. +

    +

    The implementation may choose to search sequence-2 in any order; +there is no guarantee on the number of times the test is made. +For example, +when start-end is true, +the sequence might actually be searched from left to right +instead of from right to left (but in either case would return +the rightmost matching subsequence). +If the search succeeds, +search returns the offset into sequence-2 +of the first element of the leftmost or rightmost matching subsequence, +depending on from-end; +otherwise search returns nil. +

    +

    If from-end is true, the index of the leftmost +element of the rightmost matching subsequence is returned. +

    +

    Examples::

    +
    +
     (search "dog" "it's a dog's life") ⇒  7
+ (search '(0 1) '(2 4 6 1 3 5) :key #'oddp) ⇒  2
+
    + +

    See Also::

    + +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/sequence.html b/info/gcl/sequence.html new file mode 100644 index 0000000..c048589 --- /dev/null +++ b/info/gcl/sequence.html @@ -0,0 +1,70 @@ + + + + + +sequence (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.1 sequence [System Class]

    + +

    Class Precedence List::

    +

    sequence, +t +

    +

    Description::

    + +

    Sequences are ordered collections of objects, +called the elements of the sequence. +

    +

    The types vector and the type list are disjoint subtypes of type sequence, +but are not necessarily an exhaustive partition of sequence. +

    +

    When viewing a vector as a sequence, +only the active elements of that vector +are considered elements of the sequence; +that is, +sequence operations respect the fill pointer +when given sequences represented as vectors. +

    + + + + + diff --git a/info/gcl/serious_002dcondition.html b/info/gcl/serious_002dcondition.html new file mode 100644 index 0000000..fb973b3 --- /dev/null +++ b/info/gcl/serious_002dcondition.html @@ -0,0 +1,79 @@ + + + + + +serious-condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.4 serious-condition [Condition Type]

    + +

    Class Precedence List::

    +

    serious-condition, +condition, +t +

    +

    Description::

    + +

    All conditions serious enough to require interactive intervention +if not handled should inherit from the type serious-condition. +This condition type is provided +primarily so that it may be included as +a superclass of other condition types; +it is not intended to be signaled directly. +

    +

    Notes::

    + +

    Signaling a serious condition does not itself force entry into +the debugger. However, except in the unusual situation where the +programmer can assure that no harm will come from failing to +handle a serious condition, such a condition is +usually signaled with error rather than signal in +order to assure that the program does not continue without +handling the condition. (And conversely, it is +conventional to use signal rather than error to signal +conditions which are not serious conditions, since normally the +failure to handle a non-serious condition is not reason enough for the +debugger to be entered.) +

    + + + + + diff --git a/info/gcl/set.html b/info/gcl/set.html new file mode 100644 index 0000000..a27653a --- /dev/null +++ b/info/gcl/set.html @@ -0,0 +1,123 @@ + + + + + +set (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.19 set [Function]

    + +

    set symbol value ⇒ value +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    value—an object. +

    +

    Description::

    + +

    set changes the contents of the value cell of symbol +to the given value. +

    +
    +
    (set symbol value) ≡ (setf (symbol-value symbol) value)
+
    + +

    Examples::

    + +
    +
     (setf (symbol-value 'n) 1) ⇒  1
+ (set 'n 2) ⇒  2
+ (symbol-value 'n) ⇒  2
+ (let ((n 3))
+   (declare (special n))
+   (setq n (+ n 1))
+   (setf (symbol-value 'n) (* n 10))
+   (set 'n (+ (symbol-value 'n) n))
+   n) ⇒  80
+ n ⇒  2
+ (let ((n 3))
+   (setq n (+ n 1))
+   (setf (symbol-value 'n) (* n 10))
+   (set 'n (+ (symbol-value 'n) n))
+   n) ⇒  4
+ n ⇒  44
+ (defvar *n* 2)
+ (let ((*n* 3))
+   (setq *n* (+ *n* 1))
+   (setf (symbol-value '*n*) (* *n* 10))
+   (set '*n* (+ (symbol-value '*n*) *n*))
+   *n*) ⇒  80
+  *n* ⇒  2
+ (defvar *even-count* 0) ⇒  *EVEN-COUNT*
+ (defvar *odd-count* 0) ⇒  *ODD-COUNT*
+ (defun tally-list (list)
+   (dolist (element list)
+     (set (if (evenp element) '*even-count* '*odd-count*)
+          (+ element (if (evenp element) *even-count* *odd-count*)))))
+ (tally-list '(1 9 4 3 2 7)) ⇒  NIL
+ *even-count* ⇒  6
+ *odd-count* ⇒  20
+
    + +

    Side Effects::

    + +

    The value of symbol is changed. +

    +

    See Also::

    + +

    setq +, +progv +, +symbol-value +

    +

    Notes::

    + +

    The function set is deprecated. +

    +

    set cannot change the value of a lexical variable. +

    + + + + + diff --git a/info/gcl/set_002ddifference.html b/info/gcl/set_002ddifference.html new file mode 100644 index 0000000..caab8bd --- /dev/null +++ b/info/gcl/set_002ddifference.html @@ -0,0 +1,162 @@ + + + + + +set-difference (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.46 set-difference, nset-difference [Function]

    + +

    set-difference list-1 list-2 &key key test test-not ⇒ result-list +

    +

    nset-difference list-1 list-2 &key key test test-not ⇒ result-list +

    +

    Arguments and Values::

    + +

    list-1—a proper list. +

    +

    list-2—a proper list. +

    +

    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. +

    +

    result-list—a list. +

    +

    Description::

    +

    set-difference returns a list +of elements of list-1 +that do not appear in list-2. +

    +

    nset-difference is the destructive +version of set-difference. +It may destroy list-1. +

    +

    For all possible ordered pairs consisting of +one element from list-1 and one element from list-2, the +:test or :test-not function is +used to determine whether they satisfy the test. +The first argument to the :test or :test-not function +is the part of an element of list-1 that is returned by +the :key function (if supplied); the second argument is the part of +an element of list-2 that is +returned by the :key function (if supplied). +

    +

    If :key is supplied, its argument is a list-1 or +list-2 element. The :key function +typically returns part of +the supplied element. +If :key is not supplied, the list-1 or list-2 +element is used. +

    +

    An element of list-1 +appears in the result if and only if it does not match any element +of list-2. +

    +

    There is no guarantee that the order of elements in the result will +reflect the ordering of the arguments in any particular way. +The result list +may share cells with, or be eq to, either of list-1 +or list-2, +if appropriate. +

    +

    Examples::

    + +
    +
     (setq lst1 (list "A" "b" "C" "d")
+       lst2 (list "a" "B" "C" "d")) ⇒  ("a" "B" "C" "d")
+ (set-difference lst1 lst2) ⇒  ("d" "C" "b" "A")
+ (set-difference lst1 lst2 :test 'equal) ⇒  ("b" "A")
+ (set-difference lst1 lst2 :test #'equalp) ⇒  NIL 
+ (nset-difference lst1 lst2 :test #'string=) ⇒  ("A" "b")
+ (setq lst1 '(("a" . "b") ("c" . "d") ("e" . "f")))
+⇒  (("a" . "b") ("c" . "d") ("e" . "f")) 
+ (setq lst2 '(("c" . "a") ("e" . "b") ("d" . "a")))
+⇒  (("c" . "a") ("e" . "b") ("d" . "a")) 
+ (nset-difference lst1 lst2 :test #'string= :key #'cdr)
+⇒  (("c" . "d") ("e" . "f")) 
+ lst1 ⇒  (("a" . "b") ("c" . "d") ("e" . "f")) 
+ lst2 ⇒  (("c" . "a") ("e" . "b") ("d" . "a")) 
+
    + +
    +
    ;; Remove all flavor names that contain "c" or "w".
+ (set-difference '("strawberry" "chocolate" "banana"
+                  "lemon" "pistachio" "rhubarb")
+          '(#\c #\w)
+          :test #'(lambda (s c) (find c s)))
+⇒  ("banana" "rhubarb" "lemon")    ;One possible ordering.
+
    + +

    Side Effects::

    + +

    nset-difference may destroy list-1. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list-1 and list-2 are not proper lists. +

    +

    See Also::

    + +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/set_002ddispatch_002dmacro_002dcharacter.html b/info/gcl/set_002ddispatch_002dmacro_002dcharacter.html new file mode 100644 index 0000000..3dfbe90 --- /dev/null +++ b/info/gcl/set_002ddispatch_002dmacro_002dcharacter.html @@ -0,0 +1,154 @@ + + + + + +set-dispatch-macro-character (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.9 set-dispatch-macro-character, get-dispatch-macro-character

    +

    [Function] +

    +

    get-dispatch-macro-character disp-char sub-char &optional readtable ⇒ function +

    +

    set-dispatch-macro-character disp-char sub-char new-function &optional readtable ⇒ t +

    +

    Arguments and Values::

    + +

    disp-char—a character. +

    +

    sub-char—a character. +

    +

    readtable—a readtable designator. +

    +

    The default is the current readtable. +

    +

    function—a function designator or nil. +

    +

    new-function—a function designator. +

    +

    Description::

    + +

    set-dispatch-macro-character causes new-function to be called +when disp-char followed by sub-char is read. +If sub-char is a lowercase letter, +it is converted to its uppercase equivalent. +It is an error if sub-char is one of the ten decimal digits. +

    +

    set-dispatch-macro-character installs a new-function to be called +when a particular dispatching macro character pair is read. +New-function is installed as the dispatch function to be +called when readtable is in use and when disp-char is followed by +sub-char. +

    +

    For more information about how the new-function is invoked, +see Macro Characters. +

    +

    get-dispatch-macro-character retrieves +the dispatch function associated with disp-char and sub-char +in readtable. +

    +

    get-dispatch-macro-character returns the macro-character function +for sub-char under disp-char, or nil if there is no +function associated with sub-char. +If sub-char is a decimal digit, get-dispatch-macro-character +returns nil. +

    +

    Examples::

    + +
    +
     (get-dispatch-macro-character #\# #\{) ⇒  NIL
+ (set-dispatch-macro-character #\# #\{        ;dispatch on #{
+    #'(lambda(s c n)
+        (let ((list (read s nil (values) t)))  ;list is object after #n{
+          (when (consp list)                   ;return nth element of list
+            (unless (and n (< 0 n (length list))) (setq n 0))
+            (setq list (nth n list)))
+         list))) ⇒  T
+ #{(1 2 3 4) ⇒  1
+ #3{(0 1 2 3) ⇒  3
+ #{123 ⇒  123
+
    + +

    If it is desired that #$foo : +as if it were (dollars foo). +

    +
    +
    (defun |#$-reader| (stream subchar arg)
+   (declare (ignore subchar arg))
+   (list 'dollars (read stream t nil t))) ⇒  |#$-reader|
+ (set-dispatch-macro-character #\# #\$ #'|#$-reader|) ⇒  T
+
    + +

    See Also::

    + +

    Macro Characters +

    +

    Side Effects::

    + +

    The readtable is modified. +

    +

    Affected By::

    + +

    *readtable*. +

    +

    Exceptional Situations::

    + +

    For either function, an error is signaled if disp-char is not +a dispatching macro character in readtable. +

    +

    See Also::

    + +

    readtable +

    +

    Notes::

    +

    It is necessary +to use make-dispatch-macro-character to set up the +dispatch character before specifying its sub-characters. +

    +
    +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    + + + + + diff --git a/info/gcl/set_002dexclusive_002dor.html b/info/gcl/set_002dexclusive_002dor.html new file mode 100644 index 0000000..d74bd0b --- /dev/null +++ b/info/gcl/set_002dexclusive_002dor.html @@ -0,0 +1,149 @@ + + + + + +set-exclusive-or (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.47 set-exclusive-or, nset-exclusive-or [Function]

    + +

    set-exclusive-or list-1 list-2 &key key test test-not ⇒ result-list +

    +

    nset-exclusive-or list-1 list-2 &key key test test-not ⇒ result-list +

    +

    Arguments and Values::

    + +

    list-1—a proper list. +

    +

    list-2—a proper list. +

    +

    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. +

    +

    result-list—a list. +

    +

    Description::

    +

    set-exclusive-or returns a list of elements that appear +in exactly one of list-1 and list-2. +

    +

    nset-exclusive-or +is the destructive version of set-exclusive-or. +

    +

    For all possible ordered pairs consisting of +one element from list-1 and one element from list-2, the +:test or :test-not function is +used to determine whether they satisfy the test. +

    +

    If :key is supplied, it is used to +extract the part to be tested from the list-1 or list-2 element. +The first argument to the :test or :test-not function +is the part of an element of list-1 extracted by the :key +function (if supplied); the second argument is the part of an +element of list-2 extracted by the :key function (if supplied). +If :key is not supplied or nil, the list-1 or +list-2 element is used. +

    +

    The result contains precisely +those elements of list-1 and list-2 +that appear in no matching pair. +

    +

    The result list of set-exclusive-or +might share storage with one of list-1 or list-2. +

    +

    Examples::

    + +
    +
     (setq lst1 (list 1 "a" "b")
+       lst2 (list 1 "A" "b")) ⇒  (1 "A" "b")
+ (set-exclusive-or lst1 lst2) ⇒  ("b" "A" "b" "a")
+ (set-exclusive-or lst1 lst2 :test #'equal) ⇒  ("A" "a")
+ (set-exclusive-or lst1 lst2 :test 'equalp) ⇒  NIL 
+ (nset-exclusive-or lst1 lst2) ⇒  ("a" "b" "A" "b") 
+ (setq lst1 (list (("a" . "b") ("c" . "d") ("e" . "f"))))
+⇒  (("a" . "b") ("c" . "d") ("e" . "f"))
+ (setq lst2 (list (("c" . "a") ("e" . "b") ("d" . "a"))))
+⇒  (("c" . "a") ("e" . "b") ("d" . "a")) 
+ (nset-exclusive-or lst1 lst2 :test #'string= :key #'cdr)
+⇒  (("c" . "d") ("e" . "f") ("c" . "a") ("d" . "a")) 
+ lst1 ⇒  (("a" . "b") ("c" . "d") ("e" . "f"))
+ lst2 ⇒  (("c" . "a") ("d" . "a")) 
+
    + +

    Side Effects::

    + +

    nset-exclusive-or is permitted to modify any part, +car or cdr, of the list structure of list-1 or list-2. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list-1 and list-2 are not proper lists. +

    +

    See Also::

    + +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    Since the nset-exclusive-or side effect is not required, +it should not be used in for-effect-only + positions in portable code. +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/set_002dmacro_002dcharacter.html b/info/gcl/set_002dmacro_002dcharacter.html new file mode 100644 index 0000000..6af141a --- /dev/null +++ b/info/gcl/set_002dmacro_002dcharacter.html @@ -0,0 +1,135 @@ + + + + + +set-macro-character (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.10 set-macro-character, get-macro-character [Function]

    + +

    get-macro-character char &optional readtable ⇒ function, non-terminating-p +

    +

    set-macro-character char new-function &optional non-terminating-p readtable ⇒ t +

    +

    Arguments and Values::

    + +

    char—a character. +

    +

    non-terminating-p—a generalized boolean. + The default is false. +

    +

    readtable—a readtable designator. +

    +

    The default is the current readtable. +

    +

    function—nil, + or a designator for a function of two arguments. +

    +

    new-function—a function designator. +

    +

    Description::

    + +

    get-macro-character returns as its primary value, function, +the reader macro function associated with char in readtable (if any), +or else nil if char is not a macro character in readtable. +The secondary value, non-terminating-p, is true +if char is a non-terminating macro character; +otherwise, it is false. +

    +

    set-macro-character causes char to be a macro character +associated with the reader macro function new-function +(or the designator for new-function) in readtable. +If non-terminating-p is true, +char becomes a non-terminating macro character; +otherwise it becomes a terminating macro character. +

    +

    Examples::

    + +
    +
     (get-macro-character #\{) ⇒  NIL, false
+ (not (get-macro-character #\;)) ⇒  false
+
    + +

    The following is a possible definition for the single-quote reader macro +in standard syntax: +

    +
    +
     (defun single-quote-reader (stream char)
+   (declare (ignore char))
+   (list 'quote (read stream t nil t))) ⇒  SINGLE-QUOTE-READER
+ (set-macro-character #\' #'single-quote-reader) ⇒  T
+
    + +

    Here single-quote-reader reads an object following the single-quote +and returns a list of quote and that object. +The char argument is ignored. +

    +

    The following is a possible definition for the semicolon reader macro +in standard syntax: +

    +
    +
     (defun semicolon-reader (stream char)
+   (declare (ignore char))
+   ;; First swallow the rest of the current input line.
+   ;; End-of-file is acceptable for terminating the comment.
+   (do () ((char= (read-char stream nil #\Newline t) #\Newline)))
+   ;; Return zero values.
+   (values)) ⇒  SEMICOLON-READER
+ (set-macro-character #\; #'semicolon-reader) ⇒  T
+
    + +

    Side Effects::

    + +

    The readtable is modified. +

    +

    See Also::

    + +

    readtable +

    +
    +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    + + + + + diff --git a/info/gcl/set_002dpprint_002ddispatch.html b/info/gcl/set_002dpprint_002ddispatch.html new file mode 100644 index 0000000..c9fbca9 --- /dev/null +++ b/info/gcl/set_002dpprint_002ddispatch.html @@ -0,0 +1,117 @@ + + + + + +set-pprint-dispatch (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.13 set-pprint-dispatch [Function]

    + +

    set-pprint-dispatch type-specifier function &optional priority table ⇒ nil +

    +

    Arguments and Values::

    + +

    type-specifier—a type specifier. +

    +

    function—a function, a function name, or nil. +

    +

    priority—a real. + The default is 0. +

    +

    table—a pprint dispatch table. + The default is the value of *print-pprint-dispatch*. +

    +

    Description::

    + +

    Installs an entry into the pprint dispatch table which is table. +

    +

    Type-specifier +is the key +of the entry. The first action of set-pprint-dispatch is to remove any +pre-existing entry associated with type-specifier. This guarantees that +there will never be two entries associated with the same type specifier +in a given pprint dispatch table. Equality of type specifiers is +tested by equal. +

    +

    Two values are associated with each type specifier in a +pprint dispatch table: a function and a priority. +The function must accept two arguments: the stream to which output +is sent and the object to be printed. The function should +pretty print the object to the stream. The function +can assume that object satisfies the type given by type-specifier. +The function must obey *print-readably*. +Any values returned by the function are ignored. +

    +

    Priority is a priority to resolve conflicts +when an object matches more than one entry. +

    +

    It is permissible for function to be nil. In this situation, +there will be no type-specifier entry in table after +set-pprint-dispatch returns. +

    +

    Exceptional Situations::

    + +

    An error is signaled if priority is not a real. +

    +

    Notes::

    + +

    Since pprint dispatch tables are often used to control the pretty +printing of Lisp code, it is common for the type-specifier to be +an expression of the form +

    +
    +
     (cons car-type cdr-type)
+
    + +

    This signifies that the corresponding object must be a cons cell +whose car matches the type specifier car-type +and whose cdr matches the type specifier cdr-type. +The cdr-type can be omitted in which case it defaults to t. +

    +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/set_002dsyntax_002dfrom_002dchar.html b/info/gcl/set_002dsyntax_002dfrom_002dchar.html new file mode 100644 index 0000000..66381fc --- /dev/null +++ b/info/gcl/set_002dsyntax_002dfrom_002dchar.html @@ -0,0 +1,124 @@ + + + + + +set-syntax-from-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.11 set-syntax-from-char [Function]

    + +

    set-syntax-from-char to-char from-char &optional to-readtable from-readtable ⇒ t +

    +

    Arguments and Values::

    + +

    to-char—a character. +

    +

    from-char—a character. +

    +

    to-readtable—a readtable. + The default is the current readtable. +

    +

    from-readtable—a readtable designator. + The default is the standard readtable. +

    +

    Description::

    + +

    set-syntax-from-char makes +the syntax of to-char in to-readtable be the same as +the syntax of from-char in from-readtable. +

    +

    set-syntax-from-char copies the syntax types of from-char. +If from-char is a macro character, +its reader macro function is copied also. +If the character is a dispatching macro character, +its entire dispatch table of reader macro functions is copied. +The constituent traits of from-char are not copied. +

    +

    A macro definition from a character such as +" can be copied to another character; the standard definition for " +looks for another character that is the same as the character that +invoked it. The definition of ( can not be meaningfully copied +to {, on the other hand. +The result is that lists are of the form +{a b c), not {a b c}, +because the definition +always looks for a closing parenthesis, not a closing brace. +

    +

    Examples::

    +
    +
     (set-syntax-from-char #\7 #\;) ⇒  T
+ 123579 ⇒  1235
+
    + +

    Side Effects::

    + +

    The to-readtable is modified. +

    +

    Affected By::

    + +

    The existing values in the from-readtable. +

    +

    See Also::

    + +

    set-macro-character +, +make-dispatch-macro-character +, +Character Syntax Types +

    +

    Notes::

    + +

    The constituent traits of a character are “hard wired” +into the parser for extended tokens. For example, if the definition +of S is copied to *, then * will become a constituent +that is alphabetic_2 but that cannot be used as a +short float exponent marker. +For further information, see Constituent Traits. +

    +
    +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    + + + + + diff --git a/info/gcl/setf-class_002dname.html b/info/gcl/setf-class_002dname.html new file mode 100644 index 0000000..7aec3ca --- /dev/null +++ b/info/gcl/setf-class_002dname.html @@ -0,0 +1,77 @@ + + + + + +setf class-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.38 setf class-name [Standard Generic Function]

    + +

    Syntax::

    + +

    setf class-name new-value class ⇒ new-value +

    +

    Method Signatures::

    + +

    setf class-name new-value (class class) +

    +

    Arguments and Values::

    + +

    new-value—a symbol. +

    +

    class—a class. +

    +

    Description::

    + +

    The generic function setf class-name sets the name of +a class object. +

    +

    See Also::

    + +

    find-class +, +proper name, +Classes +

    + + + + + diff --git a/info/gcl/setf.html b/info/gcl/setf.html new file mode 100644 index 0000000..e7f48ea --- /dev/null +++ b/info/gcl/setf.html @@ -0,0 +1,155 @@ + + + + + +setf (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.64 setf, psetf [Macro]

    + +

    setf {!pair}* ⇒ {result}* +

    +

    psetf {!pair}* ⇒ nil +

    +

    pair ::=place newvalue +

    +

    Arguments and Values::

    + +

    place—a place. +

    +

    newvalue—a form. +

    +

    results—the multiple values_2 + returned by the storing form for the last place, + or nil if there are no pairs. +

    +

    Description::

    + +

    setf changes the value of place to be newvalue. +

    +

    (setf place newvalue) +expands into an update form that stores the +result +of evaluating +newvalue into the location referred to by place. + Some place forms +involve uses of accessors that take optional arguments. + Whether those optional arguments are permitted by +setf, or what their use + is, is up to the +setf expander function and is not under the control + of setf. +The documentation for any function +that accepts &optional, &rest, + or &key arguments and that +claims to be usable with setf must specify + how those arguments are treated. +

    +

    If more than one pair is supplied, +the pairs are processed sequentially; that is, +

    +
    +
     (setf place-1 newvalue-1
+       place-2 newvalue-2
+       ...
+       place-N newvalue-N)
+
    + +

    is precisely equivalent to +

    +
    +
     (progn (setf place-1 newvalue-1)
+        (setf place-2 newvalue-2)
+        ...
+        (setf place-N newvalue-N))
+
    + +

    For psetf, +if more than one pair is supplied then the assignments of new values to places are +done in parallel. More precisely, all subforms (in both the place +and newvalue forms) that are to be evaluated +are evaluated from left to right; after all evaluations have been performed, +all of the assignments are performed in an unpredictable order. +

    +

    For detailed treatment of the expansion of setf and psetf, +see Kinds of Places. +

    +

    Examples::

    + +
    +
     (setq x (cons 'a 'b) y (list 1 2 3)) ⇒  (1 2 3) 
+ (setf (car x) 'x (cadr y) (car x) (cdr x) y) ⇒  (1 X 3) 
+ x ⇒  (X 1 X 3) 
+ y ⇒  (1 X 3) 
+ (setq x (cons 'a 'b) y (list 1 2 3)) ⇒  (1 2 3) 
+ (psetf (car x) 'x (cadr y) (car x) (cdr x) y) ⇒  NIL 
+ x ⇒  (X 1 A 3) 
+ y ⇒  (1 A 3) 
+
    + +

    Affected By::

    + +

    define-setf-expander, +defsetf, +*macroexpand-hook* +

    +

    See Also::

    + +

    define-setf-expander +, +defsetf +, +macroexpand-1, +rotatef +, +shiftf +, +Generalized Reference +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/setq.html b/info/gcl/setq.html new file mode 100644 index 0000000..fb3dd6f --- /dev/null +++ b/info/gcl/setq.html @@ -0,0 +1,125 @@ + + + + + +setq (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.20 setq [Special Form]

    + +

    setq {!pair}* ⇒ result +

    +

    pair ::=var form +

    +

    Pronunciation::

    + +

    pronounced ’set ,ky\"u +

    +

    Arguments and Values::

    + +

    var—a symbol naming a variable other than a constant variable. +

    +

    form—a form. +

    +

    result—the primary value of the last form, + or nil if no pairs were supplied. +

    +

    Description::

    + +

    Assigns values to variables. +

    +

    (setq var1 form1 var2 form2 ...) +is the simple variable assignment statement of Lisp. +First form1 is evaluated +and the result is stored in the variable var1, then form2 +is evaluated and the result stored in var2, and so forth. +setq may be used for assignment of both lexical +and dynamic variables. +

    +

    If any var refers to a binding +made by symbol-macrolet, +then that var is treated as if setf +(not setq) had been used. +

    +

    Examples::

    + +
    +
     ;; A simple use of SETQ to establish values for variables.
+ (setq a 1 b 2 c 3) ⇒  3
+ a ⇒  1
+ b ⇒  2
+ c ⇒  3
+
+ ;; Use of SETQ to update values by sequential assignment.
+ (setq a (1+ b) b (1+ a) c (+ a b)) ⇒  7
+ a ⇒  3
+ b ⇒  4
+ c ⇒  7
+
+ ;; This illustrates the use of SETQ on a symbol macro.
+ (let ((x (list 10 20 30)))
+   (symbol-macrolet ((y (car x)) (z (cadr x)))
+     (setq y (1+ z) z (1+ y))
+     (list x y z)))
+⇒  ((21 22 30) 21 22)
+
    + +

    Side Effects::

    + +

    The primary value of each form is assigned to the corresponding var. +

    +

    See Also::

    + +

    psetq +, +set +, +setf +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/shadow.html b/info/gcl/shadow.html new file mode 100644 index 0000000..d3837fe --- /dev/null +++ b/info/gcl/shadow.html @@ -0,0 +1,131 @@ + + + + + +shadow (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.9 shadow [Function]

    + +

    shadow symbol-names &optional package ⇒ t +

    +

    Arguments and Values::

    + +

    symbol-names—a designator for + a list of string designators. +

    +

    package—a package designator. +

    +

    The default is the current package. +

    +

    Description::

    + +

    shadow assures that symbols with names given +by symbol-names are present +in +the package. +

    +

    Specifically, package is searched for symbols +with the names supplied by symbol-names. +

    +

    For each such name, if a corresponding symbol +is not present in package (directly, not by inheritance), +then a corresponding symbol is created with that name, +and inserted into package as an internal symbol. +The corresponding symbol, whether pre-existing or newly created, +is then added, if not already present, to the shadowing symbols list +of package. +

    +

    Examples::

    + +
    +
     (package-shadowing-symbols (make-package 'temp)) ⇒  NIL
+ (find-symbol 'car 'temp) ⇒  CAR, :INHERITED
+ (shadow 'car 'temp) ⇒  T
+ (find-symbol 'car 'temp) ⇒  TEMP::CAR, :INTERNAL
+ (package-shadowing-symbols 'temp) ⇒  (TEMP::CAR)
+
    + +
    +
     (make-package 'test-1) ⇒  #<PACKAGE "TEST-1">
+ (intern "TEST" (find-package 'test-1)) ⇒  TEST-1::TEST, NIL
+ (shadow 'test-1::test (find-package 'test-1)) ⇒  T
+ (shadow 'TEST (find-package 'test-1)) ⇒  T
+ (assert (not (null (member 'test-1::test (package-shadowing-symbols
+                                            (find-package 'test-1))))))
+
+ (make-package 'test-2) ⇒  #<PACKAGE "TEST-2">
+ (intern "TEST" (find-package 'test-2)) ⇒  TEST-2::TEST, NIL
+ (export 'test-2::test (find-package 'test-2)) ⇒  T
+ (use-package 'test-2 (find-package 'test-1))    ;should not error
+
+
    + +

    Side Effects::

    + +

    shadow changes the state of the package system in such a +way that the package consistency rules do not hold across the change. +

    +

    Affected By::

    + +

    Current state of the package system. +

    +

    See Also::

    + +

    package-shadowing-symbols +, +Package Concepts +

    +

    Notes::

    + +

    If a symbol with a name in symbol-names already exists +in package, but by inheritance, the inherited symbol becomes +shadowed_3 by a newly created internal symbol. +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/shadowing_002dimport.html b/info/gcl/shadowing_002dimport.html new file mode 100644 index 0000000..7ef2162 --- /dev/null +++ b/info/gcl/shadowing_002dimport.html @@ -0,0 +1,113 @@ + + + + + +shadowing-import (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.10 shadowing-import [Function]

    + +

    shadowing-import symbols &optional package ⇒ t +

    +

    Arguments and Values::

    + +

    symbols—a designator for a list of symbols. +

    +

    package —a package designator. +

    +

    The default is the current package. +

    +

    Description::

    + +

    shadowing-import is like import, +but it does not signal an error even if the importation of a symbol +would shadow some symbol already accessible in package. +

    +

    shadowing-import inserts each of symbols +into package as an internal symbol, regardless +of whether another symbol of the same name is shadowed by this +action. +If a different symbol of the same name is already present +in package, +that symbol is first uninterned from package. +The new symbol is added to package’s shadowing-symbols list. +

    +

    shadowing-import does name-conflict +checking to the extent that it checks whether a distinct existing +symbol with the same name is accessible; if so, it is shadowed by +the new symbol, which implies that it must be uninterned +if it was +present in package. +

    +

    Examples::

    +
    +
     (in-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (setq sym (intern "CONFLICT")) ⇒  CONFLICT
+ (intern "CONFLICT" (make-package 'temp)) ⇒  TEMP::CONFLICT, NIL
+ (package-shadowing-symbols 'temp) ⇒  NIL
+ (shadowing-import sym 'temp) ⇒  T 
+ (package-shadowing-symbols 'temp) ⇒  (CONFLICT)
+
    + +

    Side Effects::

    + +

    shadowing-import +changes the state of the package system in such a way that +the consistency rules do not hold across the change. +

    +

    package’s shadowing-symbols list is modified. +

    +

    Affected By::

    + +

    Current state of the package system. +

    +

    See Also::

    + +

    import +, +unintern +, +package-shadowing-symbols +

    + + + + + diff --git a/info/gcl/shared_002dinitialize.html b/info/gcl/shared_002dinitialize.html new file mode 100644 index 0000000..26d9856 --- /dev/null +++ b/info/gcl/shared_002dinitialize.html @@ -0,0 +1,178 @@ + + + + + +shared-initialize (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.5 shared-initialize [Standard Generic Function]

    + +

    Syntax::

    + +

    shared-initialize instance slot-names &rest initargs &key &allow-other-keys ⇒ instance +

    +

    Method Signatures::

    + +

    shared-initialize (instance standard-object) slot-names &rest initargs +

    +

    Arguments and Values::

    + +

    instance—an object. +

    +

    slot-names—a list or t. +

    +

    initargs—a list of keyword/value pairs + (of initialization argument names and values). +

    +

    Description::

    + +

    The generic function shared-initialize is used to fill the +slots +of an instance +using initargs and :initform +forms. It is called when an instance is created, when an instance is +re-initialized, when an instance is updated to conform to a redefined +class, and when an instance is updated to conform to a different +class. The generic function shared-initialize is called by the +system-supplied primary method for initialize-instance, +reinitialize-instance, update-instance-for-redefined-class, and +update-instance-for-different-class. +

    +

    The generic function shared-initialize takes the following +arguments: the instance to be initialized, a specification of a set of +slot-names accessible in that instance, +and any number of initargs. +The arguments after the first two must form an +initialization argument list. The system-supplied primary method on +shared-initialize initializes the slots with values according to the +initargs and supplied :initform forms. Slot-names +indicates which slots should be initialized according +to their :initform forms if no initargs are +provided for those slots. +

    +

    The system-supplied primary method behaves as follows, +regardless of whether the slots are local or shared: +

    +
    +
    *
    +

    If an initarg in the initialization argument list + specifies a value for that slot, that + value is stored into the slot, even if a value has + already been stored in the slot before the method is run. +

    +
    +
    *
    +

    Any slots indicated by slot-names that are still unbound + at this point are initialized according to their :initform forms. + For any such slot that has an :initform form, + that form is evaluated in the lexical environment of its defining + defclass form and the result is stored into the slot. + For example, if a before method stores a value in the slot, + the :initform form will not be used to supply a value for the slot. +

    +
    +
    *
    +

    The rules mentioned in Rules for Initialization Arguments are obeyed. +

    +
    +
    + +

    The slots-names argument specifies the slots that are to be +initialized according to their :initform forms if no +initialization arguments apply. It can be a list of slot names, +which specifies the set of those slot names; or it can be the symbol t, +which specifies the set of all of the slots. +

    +

    See Also::

    + +

    Initialize-Instance +, +reinitialize-instance +, +update-instance-for-redefined-class +, +update-instance-for-different-class +, +slot-boundp +, +slot-makunbound +, +Object Creation and Initialization, +Rules for Initialization Arguments, +Declaring the Validity of Initialization Arguments +

    +

    Notes::

    + +

    Initargs are declared as valid by using the :initarg +option to defclass, or by defining +methods for shared-initialize. +The keyword name of each keyword parameter +specifier in the lambda list of any method defined on +shared-initialize is declared as a valid initarg +name for all classes for which that method is applicable. +

    +

    Implementations are permitted to optimize :initform forms that +neither produce nor depend on side effects, by evaluating these forms +and storing them into slots before running any +initialize-instance methods, rather than by handling them in the +primary initialize-instance method. (This optimization might +be implemented by having the allocate-instance method copy a +prototype instance.) +

    +

    Implementations are permitted to optimize default initial value forms +for initargs associated with slots by not actually +creating the complete initialization argument +list when the only method +that would receive the complete list is the +method on standard-object. +In this case default initial value forms can be +treated like :initform forms. This optimization has no visible +effects other than a performance improvement. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/shiftf.html b/info/gcl/shiftf.html new file mode 100644 index 0000000..b1a1b2b --- /dev/null +++ b/info/gcl/shiftf.html @@ -0,0 +1,153 @@ + + + + + +shiftf (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.65 shiftf [Macro]

    + +

    shiftf {place}^+ newvalue ⇒ old-value-1 +

    +

    Arguments and Values::

    + +

    place—a place. +

    +

    newvalue—a form; evaluated. +

    +

    old-value-1—an object (the old value of the first place). +

    +

    Description::

    + +

    shiftf modifies the values of each +place by storing newvalue +into the last place, and shifting the +values of the second through the last place +into the remaining places. +

    +

    If newvalue produces more values than there +are store variables, the extra values are ignored. If newvalue +produces fewer values than there are store variables, the missing values +are set to nil. +

    +

    In the form (shiftf place1 place2 ... placen newvalue), +the values in place1 through placen are read and saved, +and newvalue is evaluated, for a total of n+1 values in all. +Values 2 through n+1 are then stored into place1 through placen, respectively. +It is as if all the places form a shift register; the newvalue +is shifted in from the right, all values shift over to the left one place, +and the value shifted out of place1 is returned. +

    +

    For information about the evaluation of subforms of places, +see Evaluation of Subforms to Places. +

    +

    Examples::

    + +
    +
     (setq x (list 1 2 3) y 'trash) ⇒  TRASH
+ (shiftf y x (cdr x) '(hi there)) ⇒  TRASH
+ x ⇒  (2 3)
+ y ⇒  (1 HI THERE)
+
+ (setq x (list 'a 'b 'c)) ⇒  (A B C)
+ (shiftf (cadr x) 'z) ⇒  B
+ x ⇒  (A Z C)
+ (shiftf (cadr x) (cddr x) 'q) ⇒  Z
+ x ⇒  (A (C) . Q)
+ (setq n 0) ⇒  0
+ (setq x (list 'a 'b 'c 'd)) ⇒  (A B C D)
+ (shiftf (nth (setq n (+ n 1)) x) 'z) ⇒  B
+ x ⇒  (A Z C D)
+
    + +

    Affected By::

    + +

    define-setf-expander, +defsetf, +*macroexpand-hook* +

    +

    See Also::

    + +

    setf +, +rotatef +, Generalized Reference +

    +

    Notes::

    + +

    The effect of + (shiftf place1 place2 ... placen newvalue) +is roughly equivalent to +

    +
    +
     (let ((var1 place1)
+       (var2 place2)
+       ...
+       (varn placen)
+       (var0 newvalue))
+   (setf place1 var2)
+   (setf place2 var3)
+   ...
+   (setf placen var0)
+   var1)
+
    + +

    except that the latter would evaluate any subforms +of each place twice, whereas shiftf evaluates them once. +For example, +

    +
    +
     (setq n 0) ⇒  0
+ (setq x (list 'a 'b 'c 'd)) ⇒  (A B C D)
+ (prog1 (nth (setq n (+ n 1)) x)
+        (setf (nth (setq n (+ n 1)) x) 'z)) ⇒  B
+ x ⇒  (A B Z D)
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/short_002dfloat.html b/info/gcl/short_002dfloat.html new file mode 100644 index 0000000..eb55bda --- /dev/null +++ b/info/gcl/short_002dfloat.html @@ -0,0 +1,204 @@ + + + + + +short-float (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.5 short-float, single-float, double-float, long-float [Type]

    + +

    Supertypes::

    + +

    short-float: + short-float, + float, +

    +

    real, +

    +

    number, + t +

    +

    single-float: + single-float, + float, +

    +

    real, +

    +

    number, + t +

    +

    double-float: + double-float, + float, +

    +

    real, +

    +

    number, + t +

    +

    long-float: + long-float, + float, +

    +

    real, +

    +

    number, + t +

    +

    Description::

    + +

    For the four defined subtypes of type float, it is true that +intermediate between the type short-float and the type long-float are +the type single-float and the type double-float. +The precise definition of these categories is +implementation-defined. +The precision (measured in “bits”, computed as p\log_2b) +and the exponent size (also measured in “bits,” computed as +\log_2(n+1), where n is the maximum exponent value) is recommended +to be at least as great +as the values in Figure 12–11. +Each of the defined subtypes of type float might or might not have a minus zero. +

    +
    +
      Format  Minimum Precision  Minimum Exponent Size  
+  __________________________________________________
+  Short   13 bits            5 bits                 
+  Single  24 bits            8 bits                 
+  Double  50 bits            8 bits                 
+  Long    50 bits            8 bits                 
+
+  Figure 12–11: Recommended Minimum Floating-Point Precision and Exponent Size
+
+
    + +

    There can be fewer than four internal +representations for floats. +If there are fewer distinct representations, the following rules apply: +

    +
    –
    +

    If there is only one, it is +the type single-float. +In this representation, an object is simultaneously of types +single-float, double-float, short-float, +and long-float. +

    +
    –
    +

    Two internal representations can be arranged in either of the +following ways: +

    +
    *
    +

    Two types are provided: single-float and +short-float. An object is simultaneously +of types single-float, double-float, and long-float. +

    +
    *
    +

    Two types are provided: single-float and +double-float. An object is simultaneously of types +single-float and short-float, or +double-float and long-float. +

    +
    + +
    +
    –
    +

    Three internal representations can be arranged in either +of the following ways: +

    +
    *
    +

    Three types are provided: short-float, +single-float, and double-float. +An object can simultaneously be of type double-float +and long-float. +

    +
    *
    +

    Three types are provided: +single-float, double-float, +and long-float. An object can simultaneously +be of types single-float and short-float. +

    +
    + +
    +
    + +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (short-float{[short-lower-limit [short-upper-limit]]}) +(single-float{[single-lower-limit [single-upper-limit]]}) +(double-float{[double-lower-limit [double-upper-limit]]}) +(long-float{[long-lower-limit [long-upper-limit]]}) +

    +

    Compound Type Specifier Arguments::

    + +

    short-lower-limit, short-upper-limit—interval designators + for type short-float. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    single-lower-limit, single-upper-limit—interval designators + for type single-float. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    double-lower-limit, double-upper-limit—interval designators + for type double-float. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    long-lower-limit, long-upper-limit—interval designators + for type long-float. + The defaults for each of lower-limit and upper-limit is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    Each of these denotes the set of floats of the indicated type +that are on the interval specified by the interval designators. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/short_002dfloat_002depsilon.html b/info/gcl/short_002dfloat_002depsilon.html new file mode 100644 index 0000000..a776eda --- /dev/null +++ b/info/gcl/short_002dfloat_002depsilon.html @@ -0,0 +1,78 @@ + + + + + +short-float-epsilon (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.77 short-float-epsilon, short-float-negative-epsilon,

    +

    single-float-epsilon, single-float-negative-epsilon,

    +

    double-float-epsilon, double-float-negative-epsilon,

    +

    long-float-epsilon, long-float-negative-epsilon

    +

    [Constant Variable] +

    +

    Constant Value::

    + +

    implementation-dependent. +

    +

    Description::

    + +

    The value of each of the constants short-float-epsilon, +single-float-epsilon, +double-float-epsilon, and long-float-epsilon is +the smallest positive float \epsilon of the given format, +such that the following expression is true when evaluated: +

    +

    (not (= (float 1 \epsilon) (+ (float 1 \epsilon) \epsilon)))\/ +

    +

    The value of each of the constants short-float-negative-epsilon, +single-float-negative-epsilon, +double-float-negative-epsilon, and +long-float-negative-epsilon is the smallest positive +float \epsilon of the given format, such that the following +expression is true when evaluated: +

    +

    (not (= (float 1 \epsilon) (- (float 1 \epsilon) \epsilon)))\/ +

    + + + + + diff --git a/info/gcl/short_002dsite_002dname.html b/info/gcl/short_002dsite_002dname.html new file mode 100644 index 0000000..8f529db --- /dev/null +++ b/info/gcl/short_002dsite_002dname.html @@ -0,0 +1,83 @@ + + + + + +short-site-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.25 short-site-name, long-site-name [Function]

    + +

    short-site-name <no arguments> ⇒ description +

    +

    long-site-name <no arguments> ⇒ description +

    +

    Arguments and Values::

    + +

    description—a string or nil. +

    +

    Description::

    + +

    short-site-name and long-site-name return +a string that identifies the physical location +of the computer hardware, +or nil if no appropriate description can be produced. +

    +

    Examples::

    + +
    +
     (short-site-name)
+⇒  "MIT AI Lab"
+OR⇒ "CMU-CSD"
+ (long-site-name)
+⇒  "MIT Artificial Intelligence Laboratory"
+OR⇒ "CMU Computer Science Department"
+
    + +

    Affected By::

    + +

    The implementation, +the location of the computer hardware, +and the installation/configuration process. +

    + + + + + diff --git a/info/gcl/signal.html b/info/gcl/signal.html new file mode 100644 index 0000000..79dd88f --- /dev/null +++ b/info/gcl/signal.html @@ -0,0 +1,123 @@ + + + + + +signal (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.17 signal [Function]

    + +

    signal datum &rest arguments ⇒ nil +

    +

    Arguments and Values::

    + +

    datum, arguments—designators for a condition + of default type simple-condition. +

    +

    Description::

    + +

    Signals the condition denoted by the given datum and arguments. +If the condition is not handled, signal returns nil. +

    +

    Examples::

    + +
    +
     (defun handle-division-conditions (condition)
+   (format t "Considering condition for division condition handling~
+   (when (and (typep condition 'arithmetic-error)
+              (eq '/ (arithmetic-error-operation condition)))
+     (invoke-debugger condition)))
+HANDLE-DIVISION-CONDITIONS
+ (defun handle-other-arithmetic-errors (condition)
+   (format t "Considering condition for arithmetic condition handling~
+   (when (typep condition 'arithmetic-error)
+     (abort)))
+HANDLE-OTHER-ARITHMETIC-ERRORS
+ (define-condition a-condition-with-no-handler (condition) ())
+A-CONDITION-WITH-NO-HANDLER
+ (signal 'a-condition-with-no-handler)
+NIL
+ (handler-bind ((condition #'handle-division-conditions)
+                  (condition #'handle-other-arithmetic-errors))
+   (signal 'a-condition-with-no-handler))
+Considering condition for division condition handling
+Considering condition for arithmetic condition handling
+NIL
+ (handler-bind ((arithmetic-error #'handle-division-conditions)
+                  (arithmetic-error #'handle-other-arithmetic-errors))
+   (signal 'arithmetic-error :operation '* :operands '(1.2 b)))
+Considering condition for division condition handling
+Considering condition for arithmetic condition handling
+Back to Lisp Toplevel
+
    + +

    Side Effects::

    + +

    The debugger might be entered due to *break-on-signals*. +

    +

    Handlers for the condition being signaled might transfer control. +

    +

    Affected By::

    + +

    Existing handler bindings. +

    +

    *break-on-signals* +

    +

    See Also::

    + +

    *break-on-signals*, +error +, +simple-condition, +Signaling and Handling Conditions +

    +

    Notes::

    + +

    If (typep datum *break-on-signals*) yields true, +the debugger is entered prior to beginning the signaling process. +The continue restart can be used to continue with the signaling process. +This is also true for all other functions and macros that +should, might, or must signal conditions. +

    + + + + + diff --git a/info/gcl/signed_002dbyte.html b/info/gcl/signed_002dbyte.html new file mode 100644 index 0000000..5717bc9 --- /dev/null +++ b/info/gcl/signed_002dbyte.html @@ -0,0 +1,88 @@ + + + + + +signed-byte (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.9 signed-byte [Type]

    + +

    Supertypes::

    + +

    signed-byte, +integer, +rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    The atomic type specifier signed-byte denotes the same +type as is denoted by the type specifier integer; +however, the list forms of these two type specifiers have different semantics. +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (signed-byte{[s | *]}) +

    +

    Compound Type Specifier Arguments::

    + +

    s—a positive integer. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of integers that can be represented +in two’s-complement form in a byte of s bits. This is +equivalent to (integer -2^s-1 2^s-1-1). The type +signed-byte or the type (signed-byte *) is the same +as the type integer. +

    + + + + + diff --git a/info/gcl/signum.html b/info/gcl/signum.html new file mode 100644 index 0000000..5ebb8b7 --- /dev/null +++ b/info/gcl/signum.html @@ -0,0 +1,107 @@ + + + + + +signum (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.37 signum [Function]

    + +

    signum number ⇒ signed-prototype +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    signed-prototype—a number. +

    +

    Description::

    + +

    signum determines a numerical value that indicates whether +number is negative, zero, or positive. +

    +

    For a rational, +signum returns one of -1, 0, or 1 +according to whether number is negative, zero, or positive. +For a float, +the result is a float of the same format +whose value is minus one, zero, or one. +For a complex number z, +(signum z) is a complex number of the same phase but with unit magnitude, +unless z is a complex zero, in which case the result is z. +

    +

    For rational arguments, signum is a rational function, +but it may be irrational for complex arguments. +

    +

    If number is a float, the result is a float. +If number is a rational, the result is a rational. +If number is a complex float, the result is a complex float. +If number is a complex rational, the result is a complex, +but it is implementation-dependent whether that result is a +complex rational or a complex float. +

    +

    Examples::

    + +
    +
     (signum 0) ⇒  0
+ (signum 99) ⇒  1
+ (signum 4/5) ⇒  1
+ (signum -99/100) ⇒  -1
+ (signum 0.0) ⇒  0.0
+ (signum #c(0 33)) ⇒  #C(0.0 1.0)
+ (signum #c(7.5 10.0)) ⇒  #C(0.6 0.8)
+ (signum #c(0.0 -14.7)) ⇒  #C(0.0 -1.0)
+ (eql (signum -0.0) -0.0) ⇒  true
+
    + +

    See Also::

    + +

    Rule of Float Substitutability +

    +

    Notes::

    +
    +
     (signum x) ≡ (if (zerop x) x (/ x (abs x)))
+
    + + + + + + diff --git a/info/gcl/simple_002darray.html b/info/gcl/simple_002darray.html new file mode 100644 index 0000000..e883a44 --- /dev/null +++ b/info/gcl/simple_002darray.html @@ -0,0 +1,115 @@ + + + + + +simple-array (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.2 simple-array [Type]

    + +

    Supertypes::

    + +

    simple-array, +array, +t +

    +

    Description::

    + +

    The type of an array that is not displaced +to another array, has no fill pointer, and is +not +expressly adjustable is a subtype of type simple-array. +The concept of a simple array +exists to allow the implementation to use a specialized representation +and to allow the user to declare that certain values will always be +simple arrays. +

    +

    The types simple-vector, + simple-string, + and simple-bit-vector +are disjoint subtypes of type simple-array, +for they respectively mean (simple-array t (*)), + the union of all (simple-array c (*)) + for any c being a subtype of type character, + and (simple-array bit (*)). +

    +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (simple-array{[{element-type | *} [dimension-spec]]}) +

    +

    dimension-spec ::=rank | * | ({dimension | *}*) +

    +

    Compound Type Specifier Arguments::

    + +

    dimension—a valid array dimension. +

    +

    element-type—a type specifier. +

    +

    rank—a non-negative fixnum. +

    +

    Compound Type Specifier Description::

    + +

    This compound type specifier is treated exactly as the corresponding +compound type specifier for type array would be treated, +except that the set is further constrained to include only simple arrays. +

    +

    Notes::

    + +

    It is implementation-dependent +whether displaced arrays, + vectors with fill pointers, + or arrays that are actually adjustable + are simple arrays. +

    +

    (simple-array *) refers to all simple arrays +regardless of element type, (simple-array type-specifier) +refers only to those simple arrays +that can result from giving type-specifier as the +:element-type argument to make-array. +

    + + + + + diff --git a/info/gcl/simple_002dbase_002dstring.html b/info/gcl/simple_002dbase_002dstring.html new file mode 100644 index 0000000..5566930 --- /dev/null +++ b/info/gcl/simple_002dbase_002dstring.html @@ -0,0 +1,87 @@ + + + + + +simple-base-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.4 simple-base-string [Type]

    + +

    Supertypes::

    + +

    simple-base-string, +base-string, +simple-string, +string, +vector, +simple-array, +array, +sequence, +t +

    +

    Description::

    + +

    The type simple-base-string is equivalent to +

    +

    (simple-array base-char (*)). +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (simple-base-string{[size]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum, + or the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This is equivalent to the type (simple-array base-char (size)); +that is, the set of simple base strings of size size. +

    + + + + + diff --git a/info/gcl/simple_002dbit_002dvector.html b/info/gcl/simple_002dbit_002dvector.html new file mode 100644 index 0000000..9d74779 --- /dev/null +++ b/info/gcl/simple_002dbit_002dvector.html @@ -0,0 +1,90 @@ + + + + + +simple-bit-vector (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.6 simple-bit-vector [Type]

    + +

    Supertypes::

    + +

    simple-bit-vector, +bit-vector, +vector, +simple-array, +array, +sequence, +t +

    +

    Description::

    + +

    The type of a bit vector that is not displaced +to another array, has no fill pointer, and is +not +expressly adjustable +is a +subtype of type simple-bit-vector. +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (simple-bit-vector{[size]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum, + or the symbol *. + The default is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the same type as the type +(simple-array bit (size)); +that is, the set of simple bit vectors of size size. +

    + + + + + diff --git a/info/gcl/simple_002dbit_002dvector_002dp.html b/info/gcl/simple_002dbit_002dvector_002dp.html new file mode 100644 index 0000000..74e1d96 --- /dev/null +++ b/info/gcl/simple_002dbit_002dvector_002dp.html @@ -0,0 +1,84 @@ + + + + + +simple-bit-vector-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.36 simple-bit-vector-p [Function]

    + +

    simple-bit-vector-p object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type simple-bit-vector; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (simple-bit-vector-p (make-array 6)) ⇒  false
+ (simple-bit-vector-p #*) ⇒  true
+
    + +

    See Also::

    + +

    simple-vector-p +

    +

    Notes::

    +
    +
     (simple-bit-vector-p object) ≡ (typep object 'simple-bit-vector)
+
    + + + + + + + + + + + diff --git a/info/gcl/simple_002dcondition.html b/info/gcl/simple_002dcondition.html new file mode 100644 index 0000000..ff28298 --- /dev/null +++ b/info/gcl/simple_002dcondition.html @@ -0,0 +1,81 @@ + + + + + +simple-condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.18 simple-condition [Condition Type]

    + +

    Class Precedence List::

    +

    simple-condition, +condition, +t +

    +

    Description::

    + +

    The type simple-condition represents conditions that are +signaled by signal whenever a format-control is +supplied as the function’s first argument. +

    +

    The format control and format arguments are initialized with +the initialization arguments named :format-control +

    +

    and :format-arguments to make-condition, and are +accessed by the functions +

    +

    simple-condition-format-control +

    +

    and simple-condition-format-arguments. +If format arguments are not supplied to make-condition, +nil is used as a default. +

    +

    See Also::

    + +

    simple-condition-format-control +, +

    +

    simple-condition-format-arguments +

    + + + + + diff --git a/info/gcl/simple_002dcondition_002dformat_002dcontrol.html b/info/gcl/simple_002dcondition_002dformat_002dcontrol.html new file mode 100644 index 0000000..194c3ce --- /dev/null +++ b/info/gcl/simple_002dcondition_002dformat_002dcontrol.html @@ -0,0 +1,90 @@ + + + + + +simple-condition-format-control (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.19 simple-condition-format-control, simple-condition-format-arguments

    +

    [Function] +

    +

    simple-condition-format-control condition ⇒ format-control +

    +

    simple-condition-format-arguments condition ⇒ format-arguments +

    +

    Arguments and Values::

    + +

    condition—a condition of type simple-condition. +

    +

    format-control—a format control. +

    +

    format-arguments—a list. +

    +

    Description::

    + +

    simple-condition-format-control returns the format control needed to +process the condition’s format arguments. +

    +

    simple-condition-format-arguments returns a list of format arguments +needed to process the condition’s format control. +

    +

    Examples::

    + +
    +
     (setq foo (make-condition 'simple-condition
+                          :format-control "Hi ~S"
+                          :format-arguments '(ho)))
+⇒  #<SIMPLE-CONDITION 26223553>
+ (apply #'format nil (simple-condition-format-control foo)
+                     (simple-condition-format-arguments foo))
+⇒  "Hi HO"
+
    + +

    See Also::

    + +

    simple-condition +, +Condition System Concepts +

    + + + + + diff --git a/info/gcl/simple_002derror.html b/info/gcl/simple_002derror.html new file mode 100644 index 0000000..75262c3 --- /dev/null +++ b/info/gcl/simple_002derror.html @@ -0,0 +1,69 @@ + + + + + +simple-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.14 simple-error [Condition Type]

    + +

    Class Precedence List::

    + +

    simple-error, +simple-condition, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type simple-error consists of conditions that +are signaled by error or cerror when a +

    +

    format control +

    +

    is supplied as the function’s first argument. +

    + + + + + diff --git a/info/gcl/simple_002dstring.html b/info/gcl/simple_002dstring.html new file mode 100644 index 0000000..2f4db70 --- /dev/null +++ b/info/gcl/simple_002dstring.html @@ -0,0 +1,87 @@ + + + + + +simple-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.3 simple-string [Type]

    + +

    Supertypes::

    + +

    simple-string, +string, +vector, +simple-array, +array, +sequence, +t +

    +

    Description::

    + +

    A simple string is a specialized one-dimensional +simple array whose elements are of type character or a subtype of type character. +When used as a type specifier for object creation, +simple-string means (simple-array character (size)). +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (simple-string{[size]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum, + or the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the union of all types +(simple-array c (size)) for all subtypes c of +character; that is, the set of simple strings of size size. +

    + + + + + diff --git a/info/gcl/simple_002dstring_002dp.html b/info/gcl/simple_002dstring_002dp.html new file mode 100644 index 0000000..f833bdd --- /dev/null +++ b/info/gcl/simple_002dstring_002dp.html @@ -0,0 +1,77 @@ + + + + + +simple-string-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.5 simple-string-p [Function]

    + +

    simple-string-p object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type simple-string; +otherwise, returns false. +

    +

    Examples::

    +
    +
     (simple-string-p "aaaaaa") ⇒  true
+ (simple-string-p (make-array 6 
+                              :element-type 'character 
+                              :fill-pointer t)) ⇒  false
+
    + +

    Notes::

    +
    +
     (simple-string-p object) ≡ (typep object 'simple-string)
+
    + + + + + + diff --git a/info/gcl/simple_002dtype_002derror.html b/info/gcl/simple_002dtype_002derror.html new file mode 100644 index 0000000..86a86c2 --- /dev/null +++ b/info/gcl/simple_002dtype_002derror.html @@ -0,0 +1,86 @@ + + + + + +simple-type-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.31 simple-type-error [Condition Type]

    + +

    Class Precedence List::

    + +

    simple-type-error, +simple-condition, +type-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    Conditions of type simple-type-error +are like conditions of type type-error, +except that they provide an alternate mechanism for specifying +how the condition is to be reported; +see the type simple-condition. +

    +

    See Also::

    + +

    simple-condition, +

    +

    simple-condition-format-control +, +

    +

    simple-condition-format-arguments, +type-error-datum +, +type-error-expected-type +

    + + + + + + + + + + diff --git a/info/gcl/simple_002dvector.html b/info/gcl/simple_002dvector.html new file mode 100644 index 0000000..f1ef6bc --- /dev/null +++ b/info/gcl/simple_002dvector.html @@ -0,0 +1,89 @@ + + + + + +simple-vector (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.4 simple-vector [Type]

    + +

    Supertypes::

    + +

    simple-vector, +vector, +simple-array, +array, +sequence, +t +

    +

    Description::

    + +

    The type of a vector that is not displaced to another +array, has no fill pointer, is not +expressly adjustable +and is able to hold +elements of any type is a subtype of type simple-vector. +

    +

    The type simple-vector is a subtype of type vector, +and is a subtype of type (vector t). +

    +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (simple-vector{[size]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum, + or the symbol *. + The default is the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This is the same as (simple-array t (size)). +

    + + + + + diff --git a/info/gcl/simple_002dvector_002dp.html b/info/gcl/simple_002dvector_002dp.html new file mode 100644 index 0000000..dd44386 --- /dev/null +++ b/info/gcl/simple_002dvector_002dp.html @@ -0,0 +1,82 @@ + + + + + +simple-vector-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.27 simple-vector-p [Function]

    + +

    simple-vector-p object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type simple-vector; +otherwise, returns false.. +

    +

    Examples::

    + +
    +
     (simple-vector-p (make-array 6)) ⇒  true
+ (simple-vector-p "aaaaaa") ⇒  false
+ (simple-vector-p (make-array 6 :fill-pointer t)) ⇒  false
+
    + +

    See Also::

    + +

    simple-vector +

    +

    Notes::

    + +
    +
     (simple-vector-p object) ≡ (typep object 'simple-vector)
+
    + + + + + + diff --git a/info/gcl/simple_002dwarning.html b/info/gcl/simple_002dwarning.html new file mode 100644 index 0000000..73cb9dd --- /dev/null +++ b/info/gcl/simple_002dwarning.html @@ -0,0 +1,68 @@ + + + + + +simple-warning (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.21 simple-warning [Condition Type]

    + +

    Class Precedence List::

    + +

    simple-warning, +simple-condition, +warning, +condition, +t +

    +

    Description::

    + +

    The type simple-warning represents conditions that +are signaled by warn whenever a +

    +

    format control +

    +

    is supplied as the function’s first argument. +

    + + + + + diff --git a/info/gcl/sin.html b/info/gcl/sin.html new file mode 100644 index 0000000..b0a1ca9 --- /dev/null +++ b/info/gcl/sin.html @@ -0,0 +1,90 @@ + + + + + +sin (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.20 sin, cos, tan [Function]

    + +

    sin radians ⇒ number +

    +

    cos radians ⇒ number +

    +

    tan radians ⇒ number +

    +

    Arguments and Values::

    + +

    radians—a number given in radians. +

    +

    number—a number. +

    +

    Description::

    + +

    sin, cos, and tan +return the sine, cosine, and tangent, respectively, of radians. +

    +

    Examples::

    + +
    +
     (sin 0) ⇒  0.0
+ (cos 0.7853982) ⇒  0.707107
+ (tan #c(0 1)) ⇒  #C(0.0 0.761594)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if radians is not a number. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    asin +, +acos, +atan, +Rule of Float Substitutability +

    + + + + + diff --git a/info/gcl/sinh.html b/info/gcl/sinh.html new file mode 100644 index 0000000..350f504 --- /dev/null +++ b/info/gcl/sinh.html @@ -0,0 +1,185 @@ + + + + + +sinh (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.23 sinh, cosh, tanh, asinh, acosh, atanh [Function]

    + +

    sinh number ⇒ result +

    +

    cosh number ⇒ result +

    +

    tanh number ⇒ result +

    +

    asinh number ⇒ result +

    +

    acosh number ⇒ result +

    +

    atanh number ⇒ result +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    result—a number. +

    +

    Description::

    + +

    These functions compute the hyperbolic sine, cosine, tangent, +arc sine, arc cosine, and arc tangent functions, +which are mathematically defined for an argument x +as given in Figure 12–15. +

    +
    +
      Function                Definition                                  
+  Hyperbolic sine          (e^x-e^-x)/2                             
+  Hyperbolic cosine        (e^x+e^-x)/2                             
+  Hyperbolic tangent       (e^x-e^-x)/(e^x+e^-x)                  
+  Hyperbolic arc sine      log  (x+\sqrt1+x^2)                      
+  Hyperbolic arc cosine    2 log  (\sqrt(x+1)/2 + \sqrt(x-1)/2)   
+  Hyperbolic arc tangent   (log  (1+x) - log (1-x))/2                 
+
+    Figure 12–15: Mathematical definitions for hyperbolic functions  
+
+
    + +

    The following definition for the inverse hyperbolic cosine +determines the range and branch cuts: +

    +
    arccosh z = 2 log (\sqrt(z+1)/2 + \sqrt(z-1)/2\Bigr). +
    +

    The branch cut for the inverse hyperbolic cosine function +lies along the real axis to the left of~1 (inclusive), extending +indefinitely along the negative real axis, continuous with quadrant II +and (between 0 and~1) with quadrant I. +The range is that half-strip of the complex plane containing numbers whose +real part is non-negative and whose imaginary +part is between -\pi (exclusive) and~\pi (inclusive). +A number with real part zero is in the range +if its imaginary part is between zero (inclusive) and~\pi (inclusive). +

    +

    The following definition for the inverse hyperbolic sine determines +the range and branch cuts: +

    +
    arcsinh z = log (z+\sqrt1+z^2\Bigr). +
    +

    The branch cut for the inverse hyperbolic sine function is in two pieces: +one along the positive imaginary axis above i +(inclusive), continuous with quadrant I, and one along the negative imaginary +axis below -i (inclusive), continuous with quadrant III. +The range is that strip of the complex plane containing numbers whose imaginary +part is between -\pi/2 and~\pi/2. A number with imaginary +part equal to -\pi/2 is in the range if and only if its real +part is non-positive; a number with imaginary part equal to \pi/2 is in +the range if and only if its imaginary part is non-negative. +

    +

    The following definition for the inverse hyperbolic tangent +determines the range and branch cuts: +

    +
    arctanh z = log (1+z) - log (1-z)\over2. +
    +

    Note that: +

    +
    i arctan z = arctanh iz. +
    +

    The branch cut for the inverse hyperbolic tangent function +is in two pieces: one along the negative real axis to the left of +-1 (inclusive), continuous with quadrant III, and one along +the positive real axis to the right of~1 (inclusive), continuous with +quadrant I. The points -1 and~1 are excluded from the +domain. +The range is that strip of the complex plane containing +numbers whose imaginary part is between -\pi/2 and +\pi/2. A number with imaginary part equal to -\pi/2 +is in the range if and only if its real part is strictly negative; a number with +imaginary part equal to \pi/2 is in the range if and only if its imaginary +part is strictly positive. +Thus the range of the inverse hyperbolic tangent function is identical to +that of the inverse hyperbolic sine function with the points +-\pi i/2 and~\pi i/2 excluded. +

    +

    Examples::

    + +
    +
     (sinh 0) ⇒  0.0 
+ (cosh (complex 0 -1)) ⇒  #C(0.540302 -0.0)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if number is not a number. +Might signal arithmetic-error. +

    +

    See Also::

    + +

    log +, +sqrt +, +Rule of Float Substitutability +

    +

    Notes::

    + +

    The result of acosh may be a complex even if number +is not a complex; this occurs when number is less than one. +Also, the result of atanh may be a complex even if number +is not a complex; this occurs when the absolute value of number +is greater than one. +

    +

    The branch cut formulae are mathematically correct, assuming +completely accurate computation. +Implementors should consult a good text on +numerical analysis. The formulae given above are not necessarily +the simplest ones for real-valued computations; they are chosen +to define the branch cuts in desirable ways for the complex case. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/sleep.html b/info/gcl/sleep.html new file mode 100644 index 0000000..ad5fdc7 --- /dev/null +++ b/info/gcl/sleep.html @@ -0,0 +1,90 @@ + + + + + +sleep (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.4 sleep [Function]

    + +

    sleep seconds ⇒ nil +

    +

    Arguments and Values::

    + +

    seconds—a non-negative real. +

    +

    Description::

    + +

    Causes execution to cease and become dormant for approximately the +seconds of real time indicated by seconds, +whereupon execution is resumed. +

    +

    Examples::

    + +
    +
     (sleep 1) ⇒  NIL 
+
+;; Actually, since SLEEP is permitted to use approximate timing, 
+;; this might not always yield true, but it will often enough that
+;; we felt it to be a productive example of the intent.
+ (let ((then (get-universal-time))
+       (now  (progn (sleep 10) (get-universal-time))))
+   (>= (- now then) 10))
+⇒  true
+
    + +

    Side Effects::

    + +

    Causes processing to pause. +

    +

    Affected By::

    + +

    The granularity of the scheduler. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if seconds is not a non-negative real. +

    + + + + + diff --git a/info/gcl/slot_002dboundp.html b/info/gcl/slot_002dboundp.html new file mode 100644 index 0000000..4c0fd09 --- /dev/null +++ b/info/gcl/slot_002dboundp.html @@ -0,0 +1,105 @@ + + + + + +slot-boundp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.9 slot-boundp [Function]

    + +

    slot-boundp instance slot-name ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    instance—an object. +

    +

    slot-name—a symbol naming a slot of instance. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if the slot named slot-name in instance is bound; +otherwise, returns false. +

    +

    Exceptional Situations::

    + +

    If no slot of the name slot-name exists in the +instance, slot-missing is called as follows: +

    +
    +
     (slot-missing (class-of instance)
+               instance
+               slot-name
+               'slot-boundp)
+
    + +

    (If slot-missing is invoked and returns a value, +a boolean equivalent to its primary value +is returned by slot-boundp.) +

    +

    The specific behavior depends on instance’s metaclass. +An error is never signaled if instance has metaclass standard-class. +An error is always signaled if instance has metaclass built-in-class. +The consequences are undefined if instance has any other metaclass–an error +might or might not be signaled in this situation. Note in particular that the behavior +for conditions and structures is not specified. +

    +

    See Also::

    + +

    slot-makunbound +, +slot-missing +

    +

    Notes::

    + +

    The function slot-boundp allows for writing +after methods on initialize-instance in order to initialize only +those slots that have not already been bound. +

    +

    Although no implementation is required to do so, + implementors are strongly encouraged to implement the function slot-boundp using + the function slot-boundp-using-class described in the Metaobject Protocol. +

    + + + + + diff --git a/info/gcl/slot_002dexists_002dp.html b/info/gcl/slot_002dexists_002dp.html new file mode 100644 index 0000000..fcdf0f7 --- /dev/null +++ b/info/gcl/slot_002dexists_002dp.html @@ -0,0 +1,83 @@ + + + + + +slot-exists-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.10 slot-exists-p [Function]

    + +

    slot-exists-p object slot-name ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    slot-name—a symbol. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if the object has +a slot named slot-name. +

    +

    Affected By::

    + +

    defclass, +defstruct +

    +

    See Also::

    + +

    defclass +, +slot-missing +

    +

    Notes::

    + +

    Although no implementation is required to do so, + implementors are strongly encouraged to implement the function slot-exists-p using + the function slot-exists-p-using-class described in the Metaobject Protocol. +

    + + + + + diff --git a/info/gcl/slot_002dmakunbound.html b/info/gcl/slot_002dmakunbound.html new file mode 100644 index 0000000..885e0ab --- /dev/null +++ b/info/gcl/slot_002dmakunbound.html @@ -0,0 +1,99 @@ + + + + + +slot-makunbound (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.11 slot-makunbound [Function]

    + +

    slot-makunbound instance slot-name ⇒ instance +

    +

    Arguments and Values::

    + +

    instance – instance. +

    +

    Slot-name—a symbol. +

    +

    Description::

    + +

    The function slot-makunbound restores a slot +of the name slot-name in an instance to +the unbound state. +

    +

    Exceptional Situations::

    + +

    If no slot of the name slot-name exists in the +instance, slot-missing is called as follows: +

    +
    +
    (slot-missing (class-of instance)
+              instance
+              slot-name
+              'slot-makunbound)
+
    + +

    (Any values returned by slot-missing in this case are +ignored by slot-makunbound.) +

    +

    The specific behavior depends on instance’s metaclass. +An error is never signaled if instance has metaclass standard-class. +An error is always signaled if instance has metaclass built-in-class. +The consequences are undefined if instance has any other metaclass–an error +might or might not be signaled in this situation. Note in particular that the behavior +for conditions and structures is not specified. +

    +

    See Also::

    + +

    slot-boundp +, +slot-missing +

    +

    Notes::

    + +

    Although no implementation is required to do so, + implementors are strongly encouraged to implement the function slot-makunbound using + the function slot-makunbound-using-class described in the Metaobject Protocol. +

    + + + + + diff --git a/info/gcl/slot_002dmissing.html b/info/gcl/slot_002dmissing.html new file mode 100644 index 0000000..ca0bc8e --- /dev/null +++ b/info/gcl/slot_002dmissing.html @@ -0,0 +1,148 @@ + + + + + +slot-missing (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.12 slot-missing [Standard Generic Function]

    + +

    Syntax::

    + +

    slot-missing class object slot-name operation &optional new-value ⇒ {result}* +

    +

    Method Signatures::

    + +

    slot-missing (class t) + object slot-name + operation &optional new-value +

    +

    Arguments and Values::

    + +

    class—the class of object. +

    +

    object—an object. +

    +

    slot-name—a symbol (the name of a would-be slot). +

    +

    operation—one of the symbols + setf, + slot-boundp, + slot-makunbound, + or slot-value. +

    +

    new-value—an object. +

    +

    result—an object. +

    +

    Description::

    + +

    The generic function slot-missing is invoked when an attempt is +made to access a slot in an object whose +metaclass is standard-class +and the slot of the name slot-name +is not a name of a +slot in that class. +The default method signals an error. +

    +

    The generic function slot-missing is not intended to be called by +programmers. Programmers may write methods for it. +

    +

    The generic function slot-missing may be called during +evaluation of slot-value, (setf slot-value), +slot-boundp, and slot-makunbound. For each +of these operations the corresponding symbol +for the operation +argument is slot-value, setf, slot-boundp, +and slot-makunbound respectively. +

    +

    The optional new-value argument to slot-missing is used +when the operation is attempting to set the value of the slot. +

    +

    If slot-missing returns, its values will be treated as follows: +

    +
    +
    *
    +

    If the operation is setf or slot-makunbound, +any values will be ignored by the caller. +

    +
    +
    *
    +

    If the operation is slot-value, +only the primary value will be used by the caller, +and all other values will be ignored. +

    +
    +
    *
    +

    If the operation is slot-boundp, +any boolean equivalent of the primary value +of the method might be is used, +and all other values will be ignored. +

    +
    + +

    Exceptional Situations::

    + +

    The default method on slot-missing +signals an error of type error. +

    +

    See Also::

    + +

    defclass +, +slot-exists-p +, +slot-value +

    +

    Notes::

    + +

    The set of arguments (including the class of the instance) facilitates +defining methods on the metaclass for slot-missing. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/slot_002dunbound.html b/info/gcl/slot_002dunbound.html new file mode 100644 index 0000000..5b767a3 --- /dev/null +++ b/info/gcl/slot_002dunbound.html @@ -0,0 +1,108 @@ + + + + + +slot-unbound (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.13 slot-unbound [Standard Generic Function]

    + +

    Syntax::

    + +

    slot-unbound class instance slot-name ⇒ {result}* +

    +

    Method Signatures::

    + +

    slot-unbound (class t) + instance slot-name +

    +

    Arguments and Values::

    + +

    class—the class of the instance. +

    +

    instance—the instance in which an attempt + was made to read the unbound slot. +

    +

    slot-name—the name of the unbound slot. +

    +

    result—an object. +

    +

    Description::

    + +

    The generic function slot-unbound is called when an +unbound slot is read in +an instance whose metaclass is standard-class. +The default method signals an error +

    +

    of type unbound-slot. +The name slot of the +unbound-slot condition is initialized + to the name of the offending variable, and the instance slot + of the unbound-slot condition is initialized to the offending instance. +

    +

    The generic function slot-unbound is not intended to be called +by programmers. Programmers may write methods for it. +The function slot-unbound is called only +indirectly by slot-value. +

    +

    If slot-unbound returns, +only the primary value will be used by the caller, +and all other values will be ignored. +

    +

    Exceptional Situations::

    + +

    The default method on slot-unbound +signals an error of type unbound-slot. +

    +

    See Also::

    + +

    slot-makunbound +

    +

    Notes::

    + +

    An unbound slot may occur if no :initform form was +specified for the slot and the slot value has not been set, +or if slot-makunbound has been called on the slot. +

    + + + + + diff --git a/info/gcl/slot_002dvalue.html b/info/gcl/slot_002dvalue.html new file mode 100644 index 0000000..1e6d92d --- /dev/null +++ b/info/gcl/slot_002dvalue.html @@ -0,0 +1,152 @@ + + + + + +slot-value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.14 slot-value [Function]

    + +

    slot-value object slot-name ⇒ value +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    name—a symbol. +

    +

    value—an object. +

    +

    Description::

    + +

    The function slot-value returns the value of the slot +named slot-name in the object. +If there is no slot named slot-name, slot-missing is called. +If the slot is unbound, slot-unbound is called. +

    +

    The macro setf can be used with slot-value +to change the value of a slot. +

    +

    Examples::

    + +
    +
     (defclass foo () 
+   ((a :accessor foo-a :initarg :a :initform 1)
+    (b :accessor foo-b :initarg :b)
+    (c :accessor foo-c :initform 3)))
+⇒  #<STANDARD-CLASS FOO 244020371>
+ (setq foo1 (make-instance 'foo :a 'one :b 'two))
+⇒  #<FOO 36325624>
+ (slot-value foo1 'a) ⇒  ONE
+ (slot-value foo1 'b) ⇒  TWO
+ (slot-value foo1 'c) ⇒  3
+ (setf (slot-value foo1 'a) 'uno) ⇒  UNO
+ (slot-value foo1 'a) ⇒  UNO
+ (defmethod foo-method ((x foo))
+   (slot-value x 'a))
+⇒  #<STANDARD-METHOD FOO-METHOD (FOO) 42720573>
+ (foo-method foo1) ⇒  UNO
+
    + +

    Exceptional Situations::

    + +

    If an attempt is made to read a slot and no slot of +the name slot-name exists in the object, +slot-missing is called as follows: +

    +
    +
     (slot-missing (class-of instance)
+               instance
+               slot-name
+               'slot-value)
+
    + +

    (If slot-missing is invoked, its primary value + is returned by slot-value.) +

    +

    If an attempt is made to write a slot and no slot of +the name slot-name exists in the object, +slot-missing is called as follows: +

    +
    +
     (slot-missing (class-of instance)
+               instance
+               slot-name
+               'setf
+               new-value)
+
    + +

    (If slot-missing returns in this case, any values are ignored.) +

    +

    The specific behavior depends on object’s metaclass. +An error is never signaled if object has metaclass standard-class. +An error is always signaled if object has metaclass built-in-class. +The consequences are +unspecified +if object has any other metaclass–an error +might or might not be signaled in this situation. Note in particular that the behavior +for conditions and structures is not specified. +

    +

    See Also::

    + +

    slot-missing +, +slot-unbound +, +with-slots +

    +

    Notes::

    + +

    Although no implementation is required to do so, + implementors are strongly encouraged to implement the function slot-value using + the function slot-value-using-class described in the Metaobject Protocol. +

    +

    Implementations may optimize slot-value by compiling it inline. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/software_002dtype.html b/info/gcl/software_002dtype.html new file mode 100644 index 0000000..40451ad --- /dev/null +++ b/info/gcl/software_002dtype.html @@ -0,0 +1,84 @@ + + + + + +software-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.29 software-type, software-version [Function]

    + +

    software-type <no arguments> ⇒ description +

    +

    software-version <no arguments> ⇒ description +

    +

    Arguments and Values::

    + +

    description—a string or nil. +

    +

    Description::

    + +

    software-type returns a string that identifies the +generic name of any relevant supporting software, or nil if no +appropriate or relevant result can be produced. +

    +

    software-version returns a string that identifies +the version of any relevant supporting software, or nil if no +appropriate or relevant result can be produced. +

    +

    Examples::

    + +
    +
     (software-type) ⇒  "Multics"
+ (software-version) ⇒  "1.3x"
+
    + +

    Affected By::

    + +

    Operating system environment. +

    +

    Notes::

    + +

    This information should be of use to maintainers of the implementation. +

    + + + + + diff --git a/info/gcl/sort.html b/info/gcl/sort.html new file mode 100644 index 0000000..53981b3 --- /dev/null +++ b/info/gcl/sort.html @@ -0,0 +1,193 @@ + + + + + +sort (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.13 sort, stable-sort [Function]

    + +

    sort sequence predicate &key key ⇒ sorted-sequence +

    +

    stable-sort sequence predicate &key key ⇒ sorted-sequence +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    predicate—a designator for + a function of two arguments that returns a generalized boolean. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    sorted-sequence—a sequence. +

    +

    Description::

    + +

    sort and stable-sort destructively sort sequences +according to the order determined by the predicate function. +

    +

    If sequence is a vector, +the result is a vector +that has the same actual array element type as sequence. +The result might or might not be simple, +and might or might not be identical to sequence. +If sequence is a list, +the result is a list. +

    +

    sort determines the relationship between two elements +by giving keys extracted from the elements to the predicate. +The first argument to the predicate function is the part of one element +of sequence extracted by the key function +(if supplied); the second +argument is the part of another element +of sequence extracted by the key function +(if supplied). +Predicate should return true if and only if the first argument is +strictly less than the second (in some appropriate sense). +If the first argument is greater than or equal to the second +(in the appropriate sense), then the predicate should return false. +

    +

    The argument to the key function is the sequence element. +The return value of the key function +becomes an argument to predicate. +If key is not supplied or nil, the sequence element itself is used. +There is no guarantee on the number of times the key will be called. +

    +

    If the key and predicate always return, +then the sorting operation will always terminate, +producing a sequence containing the same elements as sequence +(that is, the result is a permutation of sequence). +This is guaranteed even if the predicate +does not really consistently represent a total order +(in which case the elements will be scrambled in some unpredictable way, +but no element will be lost). +If the key consistently returns meaningful keys, +and the predicate does reflect some total ordering criterion on those keys, +then the elements of the sorted-sequence +will be properly sorted according to that ordering. +

    +

    The sorting operation performed by sort is not guaranteed stable. +Elements considered equal by the predicate might or might not +stay in their original order. The predicate is assumed to +consider two elements x and y to be equal if +(funcall predicate x y) and +(funcall predicate y x) are both false. +stable-sort guarantees stability. +

    +

    The sorting operation can be destructive in all cases. In the case of a +vector +argument, this is accomplished by permuting the elements in place. +In the case of a list, the list is +destructively reordered in the same manner as for +nreverse. +

    +

    Examples::

    + +
    +
     (setq tester (copy-seq "lkjashd")) ⇒  "lkjashd"
+ (sort tester #'char-lessp) ⇒  "adhjkls"
+ (setq tester (list '(1 2 3) '(4 5 6) '(7 8 9))) ⇒  ((1 2 3) (4 5 6) (7 8 9))
+ (sort tester #'> :key #'car)  ⇒  ((7 8 9) (4 5 6) (1 2 3)) 
+ (setq tester (list 1 2 3 4 5 6 7 8 9 0)) ⇒  (1 2 3 4 5 6 7 8 9 0)
+ (stable-sort tester #'(lambda (x y) (and (oddp x) (evenp y))))
+⇒  (1 3 5 7 9 2 4 6 8 0)
+ (sort (setq committee-data
+             (vector (list (list "JonL" "White") "Iteration")
+                     (list (list "Dick" "Waters") "Iteration")
+                     (list (list "Dick" "Gabriel") "Objects")
+                     (list (list "Kent" "Pitman") "Conditions")
+                     (list (list "Gregor" "Kiczales") "Objects")
+                     (list (list "David" "Moon") "Objects")
+                     (list (list "Kathy" "Chapman") "Editorial")
+                     (list (list "Larry" "Masinter") "Cleanup")
+                     (list (list "Sandra" "Loosemore") "Compiler")))
+       #'string-lessp :key #'cadar)
+⇒  #((("Kathy" "Chapman") "Editorial")
+     (("Dick" "Gabriel") "Objects")
+     (("Gregor" "Kiczales") "Objects")
+     (("Sandra" "Loosemore") "Compiler")
+     (("Larry" "Masinter") "Cleanup")
+     (("David" "Moon") "Objects")
+     (("Kent" "Pitman") "Conditions")
+     (("Dick" "Waters") "Iteration")
+     (("JonL" "White") "Iteration"))
+ ;; Note that individual alphabetical order within `committees'
+ ;; is preserved.
+ (setq committee-data 
+       (stable-sort committee-data #'string-lessp :key #'cadr))
+⇒  #((("Larry" "Masinter") "Cleanup")
+     (("Sandra" "Loosemore") "Compiler")
+     (("Kent" "Pitman") "Conditions")
+     (("Kathy" "Chapman") "Editorial")
+     (("Dick" "Waters") "Iteration")
+     (("JonL" "White") "Iteration")
+     (("Dick" "Gabriel") "Objects")
+     (("Gregor" "Kiczales") "Objects")
+     (("David" "Moon") "Objects"))
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    merge +, +

    +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects, +

    +

    Destructive Operations +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/special.html b/info/gcl/special.html new file mode 100644 index 0000000..8322d52 --- /dev/null +++ b/info/gcl/special.html @@ -0,0 +1,209 @@ + + + + + +special (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.26 special [Declaration]

    + +

    Syntax::

    + +

    (special {var}*) +

    +

    Arguments::

    + +

    var—a symbol. +

    +

    Valid Context::

    + +

    declaration or proclamation +

    +

    Binding Types Affected::

    + +

    variable +

    +

    Description::

    + +

    Specifies that all of +the vars named are dynamic. +This specifier affects variable bindings and +affects references. +All variable bindings affected are made to be dynamic bindings, +and affected variable references refer to the current dynamic +binding. +For example: +

    +
    +
     (defun hack (thing *mod*)    ;The binding of the parameter
+   (declare (special *mod*))  ; *mod* is visible to hack1,
+   (hack1 (car thing)))       ; but not that of thing.
+ (defun hack1 (arg)
+   (declare (special *mod*))  ;Declare references to *mod*
+                              ;within hack1 to be special.
+   (if (atom arg) *mod*
+       (cons (hack1 (car arg)) (hack1 (cdr arg)))))
+
    + +

    A special declaration does not affect inner bindings +of a var; the inner bindings implicitly shadow +a special declaration and must be explicitly re-declared to +be special. +special declarations never apply to function bindings. +

    +

    special declarations can be either bound declarations, +affecting both a binding and references, or free declarations, +affecting only references, depending on whether the declaration is +attached to a variable binding. +

    +

    When used in a proclamation, a special +declaration specifier +applies to all bindings as well as to all references of the +mentioned variables. For example, after +

    +
    +
     (declaim (special x))
+
    + +

    then in a function definition such as +

    +
    +
     (defun example (x) ...)
+
    + +

    the parameter x is bound as a dynamic variable +rather than as a lexical variable. +

    +

    Examples::

    + +
    +
    (defun declare-eg (y)                 ;this y is special
+ (declare (special y))
+ (let ((y t))                         ;this y is lexical
+      (list y
+            (locally (declare (special y)) y)))) ;this y refers to the
+                                                 ;special binding of y
+⇒  DECLARE-EG 
+ (declare-eg nil) ⇒  (T NIL) 
+
    + +
    +
    (setf (symbol-value 'x) 6)
+(defun foo (x)                         ;a lexical binding of x
+  (print x)
+  (let ((x (1+ x)))                    ;a special binding of x
+    (declare (special x))              ;and a lexical reference
+    (bar))
+  (1+ x))
+(defun bar () 
+  (print (locally (declare (special x))
+           x)))
+(foo 10) 
+ |>  10
+ |>  11
+⇒  11
+
    + +
    +
    (setf (symbol-value 'x) 6)
+(defun bar (x y)            ;[1] 1st occurrence of x
+  (let ((old-x x)           ;[2] 2nd occurrence of x -- same as 1st occurrence
+        (x y))              ;[3] 3rd occurrence of x
+    (declare (special x))
+    (list old-x x)))
+(bar 'first 'second) ⇒  (FIRST SECOND)
+
    + +
    +
     (defun few (x &optional (y *foo*))
+   (declare (special *foo*))
+   ...)
+
    + +

    The reference to *foo* +in the first line of this example is not special +even though there is a special declaration in the second line. +

    +
    +
     (declaim (special prosp)) ⇒  implementation-dependent
+ (setq prosp 1 reg 1) ⇒  1
+ (let ((prosp 2) (reg 2))         ;the binding of prosp is special
+    (set 'prosp 3) (set 'reg 3)   ;due to the preceding proclamation,
+    (list prosp reg))             ;whereas the variable reg is lexical
+⇒  (3 2)
+ (list prosp reg) ⇒  (1 3)
+
+ (declaim (special x))          ;x is always special.
+ (defun example (x y)                                 
+   (declare (special y))
+   (let ((y 3) (x (* x 2)))
+     (print (+ y (locally (declare (special y)) y)))
+     (let ((y 4)) (declare (special y)) (foo x)))) ⇒  EXAMPLE
+
    + +

    In the contorted code above, the outermost and innermost bindings of +y are dynamic, +but the middle +binding is lexical. The two arguments to + are different, +one being the value, which is 3, of the lexical variable +y, and the other being the value of the dynamic variable named y +(a binding +of which happens, coincidentally, to lexically surround it at +an outer level). All the bindings +of x and references to x +are dynamic, however, because of the proclamation that x is +always special. +

    +

    See Also::

    + +

    defparameter +, +defvar +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/special_002doperator_002dp.html b/info/gcl/special_002doperator_002dp.html new file mode 100644 index 0000000..5f01d8f --- /dev/null +++ b/info/gcl/special_002doperator_002dp.html @@ -0,0 +1,82 @@ + + + + + +special-operator-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.29 special-operator-p [Function]

    + +

    special-operator-p symbol ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if symbol is a special operator; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (special-operator-p 'if) ⇒  true
+ (special-operator-p 'car) ⇒  false
+ (special-operator-p 'one) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if its argument is not a symbol. +

    +

    Notes::

    + +

    Historically, this function was called special-form-p. The name was +finally declared a misnomer and changed, since it returned true for +special operators, not special forms. +

    + + + + + diff --git a/info/gcl/sqrt.html b/info/gcl/sqrt.html new file mode 100644 index 0000000..f18b10e --- /dev/null +++ b/info/gcl/sqrt.html @@ -0,0 +1,138 @@ + + + + + +sqrt (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.38 sqrt, isqrt [Function]

    + +

    sqrt number ⇒ root +

    +

    isqrt natural ⇒ natural-root +

    +

    Arguments and Values::

    + +

    number, root—a number. +

    +

    natural, natural-root—a non-negative integer. +

    +

    Description::

    + +

    sqrt and isqrt compute square roots. +

    +

    sqrt returns the principal square root of number. +If the number is not a complex but is negative, +then the result is a complex. +

    +

    isqrt returns the greatest integer +less than or equal to the exact positive square root of natural. +

    +

    If number is a positive rational, +it is implementation-dependent +whether root is a rational or a float. +If number is a negative rational, +it is implementation-dependent +whether root is a complex rational or a complex float. +

    +

    The mathematical definition of complex square root (whether or not +minus zero is supported) follows: +

    +

    (sqrt x) = (exp (/ (log x) 2)) +

    +

    The branch cut for square root lies along the negative real axis, +continuous with quadrant II. +The range consists of the right half-plane, including the non-negative +imaginary axis and excluding the negative imaginary axis. +

    +

    Examples::

    + +
    +
     (sqrt 9.0) ⇒  3.0
+ (sqrt -9.0) ⇒  #C(0.0 3.0)
+ (isqrt 9) ⇒  3
+ (sqrt 12) ⇒  3.4641016
+ (isqrt 12) ⇒  3
+ (isqrt 300) ⇒  17
+ (isqrt 325) ⇒  18
+ (sqrt 25)
+⇒  5
+OR⇒ 5.0
+ (isqrt 25) ⇒  5
+ (sqrt -1) ⇒  #C(0.0 1.0)
+ (sqrt #c(0 2)) ⇒  #C(1.0 1.0)
+
    + +

    Exceptional Situations::

    + +

    The function sqrt should signal type-error if its argument +is not a number. +

    +

    The function isqrt should signal type-error if its argument +is not a non-negative integer. +

    +

    The functions sqrt and isqrt might signal arithmetic-error. +

    +

    See Also::

    + +

    exp +, +log +, +Rule of Float Substitutability +

    +

    Notes::

    + +
    +
     (isqrt x) ≡ (values (floor (sqrt x))) 
+
    + +

    but it is potentially more efficient. +

    +
    +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    + + + + + diff --git a/info/gcl/standard_002dchar.html b/info/gcl/standard_002dchar.html new file mode 100644 index 0000000..41533d0 --- /dev/null +++ b/info/gcl/standard_002dchar.html @@ -0,0 +1,72 @@ + + + + + +standard-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.3 standard-char [Type]

    + +

    Supertypes::

    + +

    standard-char, +

    +

    base-char, +

    +

    character, +t +

    +

    Description::

    + +

    A fixed set of 96 characters required to be present in all +conforming implementations. Standard characters are +defined in Standard Characters. +

    +

    Any character that is not simple is not a standard character. +

    +

    See Also::

    + +

    Standard Characters +

    + + + + + diff --git a/info/gcl/standard_002dchar_002dp.html b/info/gcl/standard_002dchar_002dp.html new file mode 100644 index 0000000..cdb2ad2 --- /dev/null +++ b/info/gcl/standard_002dchar_002dp.html @@ -0,0 +1,79 @@ + + + + + +standard-char-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.13 standard-char-p [Function]

    + +

    standard-char-p character ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if character is of type standard-char; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (standard-char-p #\Space) ⇒  true
+ (standard-char-p #\~) ⇒  true
+ ;; This next example presupposes an implementation
+ ;; in which #\Bell is a defined character.
+ (standard-char-p #\Bell) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    + + + + + diff --git a/info/gcl/standard_002dclass.html b/info/gcl/standard_002dclass.html new file mode 100644 index 0000000..3661f60 --- /dev/null +++ b/info/gcl/standard_002dclass.html @@ -0,0 +1,64 @@ + + + + + +standard-class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.10 standard-class [System Class]

    + +

    Class Precedence List::

    +

    standard-class, +class, +

    +

    standard-object, +

    +

    t +

    +

    Description::

    + +

    The class standard-class is the default class of classes +defined by defclass. +

    + + + + + diff --git a/info/gcl/standard_002dgeneric_002dfunction.html b/info/gcl/standard_002dgeneric_002dfunction.html new file mode 100644 index 0000000..6c44485 --- /dev/null +++ b/info/gcl/standard_002dgeneric_002dfunction.html @@ -0,0 +1,68 @@ + + + + + +standard-generic-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.6 standard-generic-function [System Class]

    + +

    Class Precedence List::

    +

    standard-generic-function, +generic-function, +function, +t +

    +

    Description::

    + +

    The class standard-generic-function is the default class of +generic functions established by +defmethod, +ensure-generic-function, +defgeneric, +

    +

    and +defclass forms. +

    + + + + + diff --git a/info/gcl/standard_002dmethod.html b/info/gcl/standard_002dmethod.html new file mode 100644 index 0000000..08389e1 --- /dev/null +++ b/info/gcl/standard_002dmethod.html @@ -0,0 +1,66 @@ + + + + + +standard-method (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.12 standard-method [System Class]

    + +

    Class Precedence List::

    +

    standard-method, +method, +

    +

    standard-object, +

    +

    t +

    +

    Description::

    + +

    The class standard-method is the default class of +methods defined by the + defmethod and + defgeneric forms. +

    + + + + + diff --git a/info/gcl/standard_002dobject.html b/info/gcl/standard_002dobject.html new file mode 100644 index 0000000..f3cbb71 --- /dev/null +++ b/info/gcl/standard_002dobject.html @@ -0,0 +1,61 @@ + + + + + +standard-object (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.14 standard-object [Class]

    + +

    Class Precedence List::

    +

    standard-object, +t +

    +

    Description::

    + +

    The class standard-object is an instance of standard-class +and is a superclass of every class that is an instance of +standard-class except itself. +

    + + + + + diff --git a/info/gcl/step.html b/info/gcl/step.html new file mode 100644 index 0000000..a7c4409 --- /dev/null +++ b/info/gcl/step.html @@ -0,0 +1,94 @@ + + + + + +step (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.9 step [Macro]

    + +

    step form ⇒ {result}* +

    +

    Arguments and Values::

    + +

    form—a form; evaluated as described below. +

    +

    results—the values returned by the form. +

    +

    Description::

    + +

    step implements a debugging paradigm wherein the programmer +is allowed to step through the evaluation of a form. +The specific nature of the interaction, +

    +

    including which I/O streams are used and +whether the stepping has lexical or dynamic scope, +

    +

    is implementation-defined. +

    +

    step evaluates form in the current environment. +A call to step can be compiled, but it is acceptable for an +implementation to interactively step through only those parts of the computation +that are interpreted. +

    +

    It is technically permissible for a conforming implementation +to take no action at all other than normal execution of the form. +In such a situation, +(step form) +is equivalent to, for example, +(let () form). +In implementations where this is the case, the associated documentation +should mention that fact. +

    +

    See Also::

    + +

    trace +

    +

    Notes::

    + +

    Implementations are encouraged to respond to the typing of ? +or the pressing of a “help key” by providing help including a list of +commands. +

    + + + + + diff --git a/info/gcl/storage_002dcondition.html b/info/gcl/storage_002dcondition.html new file mode 100644 index 0000000..f70a97c --- /dev/null +++ b/info/gcl/storage_002dcondition.html @@ -0,0 +1,91 @@ + + + + + +storage-condition (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.9 storage-condition [Condition Type]

    + +

    Class Precedence List::

    +

    storage-condition, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type storage-condition consists of serious conditions that +relate to problems with memory management that are potentially due to +implementation-dependent limits rather than semantic errors +in conforming programs, and that typically warrant entry to the +debugger if not handled. Depending on the details of the implementation, +these might include such problems as + stack overflow, + memory region overflow, +and + storage exhausted. +

    +

    Notes::

    + +

    While some Common Lisp operations might signal storage-condition +because they are defined to create objects, +it is unspecified whether operations that are not defined to create +objects create them anyway +and so might also signal storage-condition. +Likewise, the evaluator itself might create objects +and so might signal storage-condition. +(The natural assumption might be that such +object creation is naturally inefficient, +but even that is implementation-dependent.) +In general, the entire question of how storage allocation is done is +implementation-dependent, +and so any operation might signal storage-condition at any time. +Because such a condition is indicative of a limitation + of the implementation +or of the image +rather than an error in a program, +objects of type storage-condition are not of type error. +

    + + + + + diff --git a/info/gcl/store_002dvalue.html b/info/gcl/store_002dvalue.html new file mode 100644 index 0000000..4eeee2e --- /dev/null +++ b/info/gcl/store_002dvalue.html @@ -0,0 +1,93 @@ + + + + + +store-value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.44 store-value [Restart]

    + +

    Data Arguments Required::

    + +

    a value to use instead (on an ongoing basis). +

    +

    Description::

    + +

    The store-value restart is generally used by handlers +trying to recover from errors of types such as cell-error +or type-error, which may wish to supply a replacement datum to +be stored permanently. +

    +

    Examples::

    + +
    +
     (defun type-error-auto-coerce (c)
+   (when (typep c 'type-error)
+     (let ((r (find-restart 'store-value c)))
+       (handler-case (let ((v (coerce (type-error-datum c)
+                                      (type-error-expected-type c))))
+                       (invoke-restart r v))
+         (error ()))))) ⇒  TYPE-ERROR-AUTO-COERCE
+ (let ((x 3))
+   (handler-bind ((type-error #'type-error-auto-coerce))
+     (check-type x float)
+     x)) ⇒  3.0
+
    + +

    See Also::

    + +

    Restarts, +Interfaces to Restarts, +invoke-restart +, +store-value + (function), +ccase, +check-type +, +ctypecase, +use-value + (function and restart) +

    + + + + + diff --git a/info/gcl/stream.html b/info/gcl/stream.html new file mode 100644 index 0000000..4d9bcdb --- /dev/null +++ b/info/gcl/stream.html @@ -0,0 +1,70 @@ + + + + + +stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.1 stream [System Class]

    + +

    Class Precedence List::

    +

    stream, +t +

    +

    Description::

    + +

    A stream is an object that can be used with an input or output +function to identify an appropriate source or sink of characters or +bytes for that operation. +

    +

    For more complete information, see Stream Concepts. +

    +

    See Also::

    + +

    Stream Concepts, +Printing Other Objects, +Printer, +Reader +

    + + + + + diff --git a/info/gcl/stream_002delement_002dtype.html b/info/gcl/stream_002delement_002dtype.html new file mode 100644 index 0000000..6e9abbd --- /dev/null +++ b/info/gcl/stream_002delement_002dtype.html @@ -0,0 +1,93 @@ + + + + + +stream-element-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.12 stream-element-type [Function]

    + +

    stream-element-type stream ⇒ typespec +

    +

    Arguments and Values::

    + +

    stream—a stream. +

    +

    typespec—a type specifier. +

    +

    Description::

    + +

    stream-element-type returns a type specifier that +indicates the types of objects that may be read from +or written to stream. +

    +

    Streams created by open have an element type +restricted to integer or a subtype of type character. +

    +

    Examples::

    + +
    +
    ;; Note that the stream must accomodate at least the specified type,
+;; but might accomodate other types.  Further note that even if it does
+;; accomodate exactly the specified type, the type might be specified in
+;; any of several ways.
+ (with-open-file (s "test" :element-type '(integer 0 1)
+                           :if-exists :error
+                           :direction :output)
+   (stream-element-type s))
+⇒  INTEGER
+OR⇒ (UNSIGNED-BYTE 16)
+OR⇒ (UNSIGNED-BYTE 8)
+OR⇒ BIT
+OR⇒ (UNSIGNED-BYTE 1)
+OR⇒ (INTEGER 0 1)
+OR⇒ (INTEGER 0 (2))
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if stream is not a stream. +

    + + + + + diff --git a/info/gcl/stream_002derror.html b/info/gcl/stream_002derror.html new file mode 100644 index 0000000..f6aac9e --- /dev/null +++ b/info/gcl/stream_002derror.html @@ -0,0 +1,71 @@ + + + + + +stream-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.55 stream-error [Condition Type]

    + +

    Class Precedence List::

    +

    stream-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type stream-error +consists of error conditions that are related to receiving input from +or sending output to a stream. +The “offending stream” is initialized by +the :stream initialization argument to make-condition, +and is accessed by the function stream-error-stream. +

    +

    See Also::

    + +

    stream-error-stream +

    + + + + + diff --git a/info/gcl/stream_002derror_002dstream.html b/info/gcl/stream_002derror_002dstream.html new file mode 100644 index 0000000..fd4da3c --- /dev/null +++ b/info/gcl/stream_002derror_002dstream.html @@ -0,0 +1,77 @@ + + + + + +stream-error-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.56 stream-error-stream [Function]

    + +

    stream-error-stream condition ⇒ stream +

    +

    Arguments and Values::

    + +

    condition—a condition of type stream-error. +

    +

    stream—a stream. +

    +

    Description::

    + +

    Returns the offending stream of a condition of type stream-error. +

    +

    Examples::

    +
    +
     (with-input-from-string (s "(FOO")
+   (handler-case (read s)
+     (end-of-file (c)
+       (format nil "~&End of file on ~S." (stream-error-stream c)))))
+"End of file on #<String Stream>."
+
    + +

    See Also::

    + +

    stream-error, +Conditions +

    + + + + + diff --git a/info/gcl/stream_002dexternal_002dformat.html b/info/gcl/stream_002dexternal_002dformat.html new file mode 100644 index 0000000..551b316 --- /dev/null +++ b/info/gcl/stream_002dexternal_002dformat.html @@ -0,0 +1,89 @@ + + + + + +stream-external-format (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.30 stream-external-format [Function]

    + +

    stream-external-format stream ⇒ format +

    +

    Arguments and Values::

    + +

    stream—a file stream. +

    +

    format—an external file format. +

    +

    Description::

    + +

    Returns an external file format designator for the stream. +

    +

    Examples::

    + +
    +
     (with-open-file (stream "test" :direction :output)
+   (stream-external-format stream))
+⇒  :DEFAULT
+OR⇒ :ISO8859/1-1987
+OR⇒ (:ASCII :SAIL)
+OR⇒ ACME::PROPRIETARY-FILE-FORMAT-17
+OR⇒ #<FILE-FORMAT :ISO646-1983 2343673>
+
    + +

    See Also::

    + +

    the :external-format argument to the function +open + and +the +with-open-file + macro. +

    +

    Notes::

    + +

    The format returned is not necessarily meaningful +to other implementations. +

    + + + + + diff --git a/info/gcl/streamp.html b/info/gcl/streamp.html new file mode 100644 index 0000000..7e89bbf --- /dev/null +++ b/info/gcl/streamp.html @@ -0,0 +1,80 @@ + + + + + +streamp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.13 streamp [Function]

    + +

    streamp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type stream; +otherwise, returns false. +

    +

    streamp is unaffected by whether object, +if it is a stream, is open or closed. +

    +

    Examples::

    + +
    +
     (streamp *terminal-io*) ⇒  true
+ (streamp 1) ⇒  false
+
    + +

    Notes::

    + +
    +
     (streamp object) ≡ (typep object 'stream)
+
    + + + + + + diff --git a/info/gcl/string-_0028System-Class_0029.html b/info/gcl/string-_0028System-Class_0029.html new file mode 100644 index 0000000..92ccd5f --- /dev/null +++ b/info/gcl/string-_0028System-Class_0029.html @@ -0,0 +1,91 @@ + + + + + +string (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.1 string [System Class]

    + +

    Class Precedence List::

    +

    string, +vector, +array, +sequence, +t +

    +

    Description::

    + +

    A string is a specialized vector +whose elements are of type character or a subtype of type character. +When used as a type specifier for object creation, +string means (vector character). +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (string{[size]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum, + or the symbol *. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the union of all types +(array c (size)) +for all subtypes c of character; +that is, the set of strings of size size. +

    +

    See Also::

    + +

    String Concepts, +Double-Quote, +Printing Strings +

    + + + + + diff --git a/info/gcl/string.html b/info/gcl/string.html new file mode 100644 index 0000000..370e541 --- /dev/null +++ b/info/gcl/string.html @@ -0,0 +1,111 @@ + + + + + +string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.7 string [Function]

    + +

    string x ⇒ string +

    +

    Arguments and Values::

    + +

    x—a string, a symbol, or a character. +

    +

    string—a string. +

    +

    Description::

    + +

    Returns a string described by x; specifically: +

    +
    +
    *
    +

    If x is a string, it is returned. +

    +
    *
    +

    If x is a symbol, its name is returned. +

    +
    *
    +
    +

    If x is a character, +

    +

    then a string containing that one character is returned. +

    +
    *
    +
    +

    string might perform additional, implementation-defined conversions. +

    +
    +
    + +

    Examples::

    + +
    +
     (string "already a string") ⇒  "already a string"
+ (string 'elm) ⇒  "ELM"
+ (string #\c) ⇒  "c"
+
    + +

    Exceptional Situations::

    + +

    In the case where a conversion is defined neither by this specification nor +by the implementation, an error of type type-error is signaled. +

    +

    See Also::

    + +

    coerce +, +string (type). +

    +

    Notes::

    + +

    coerce can be used to convert a sequence of characters +to a string. +

    +

    prin1-to-string, princ-to-string, write-to-string, +or format (with a first argument of nil) can be used to get a +string representation of a number or any other object. +

    + + + + + diff --git a/info/gcl/string_002dstream.html b/info/gcl/string_002dstream.html new file mode 100644 index 0000000..05e8e2d --- /dev/null +++ b/info/gcl/string_002dstream.html @@ -0,0 +1,75 @@ + + + + + +string-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.6 string-stream [System Class]

    + +

    Class Precedence List::

    + +

    string-stream, +stream, +t +

    +

    Description::

    + +

    A string stream is a stream +which reads input from or writes output to an associated string. +

    +

    The stream element type of a string stream is always +a subtype of type character. +

    +

    See Also::

    + +

    make-string-input-stream +, +make-string-output-stream +, +with-input-from-string +, +with-output-to-string +

    + + + + + diff --git a/info/gcl/string_002dtrim.html b/info/gcl/string_002dtrim.html new file mode 100644 index 0000000..8875219 --- /dev/null +++ b/info/gcl/string_002dtrim.html @@ -0,0 +1,98 @@ + + + + + +string-trim (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.9 string-trim, string-left-trim, string-right-trim [Function]

    + +

    string-trim character-bag string ⇒ trimmed-string +

    +

    string-left-trim character-bag string ⇒ trimmed-string +

    +

    string-right-trim character-bag string ⇒ trimmed-string +

    +

    Arguments and Values::

    + +

    character-bag—a sequence containing characters. +

    +

    string—a string designator. +

    +

    trimmed-string—a string. +

    +

    Description::

    + +

    string-trim returns a substring of string, +with all characters in character-bag stripped off the beginning and end. +string-left-trim is similar but strips characters off only the beginning; +string-right-trim strips off only the end. +

    +

    If no characters need to be trimmed from the string, +then either string itself or a copy of it may be returned, +at the discretion of the implementation. +

    +

    All of these functions observe the fill pointer. +

    +

    Examples::

    +
    +
     (string-trim "abc" "abcaakaaakabcaaa") ⇒  "kaaak"
+ (string-trim '(#\Space #\Tab #\Newline) " garbanzo beans
+        ") ⇒  "garbanzo beans"
+ (string-trim " (*)" " ( *three (silly) words* ) ")
+⇒  "three (silly) words"
+
+ (string-left-trim "abc" "labcabcabc") ⇒  "labcabcabc"
+ (string-left-trim " (*)" " ( *three (silly) words* ) ")
+⇒  "three (silly) words* ) "
+
+ (string-right-trim " (*)" " ( *three (silly) words* ) ") 
+⇒  " ( *three (silly) words"
+
    + +

    Affected By::

    + +

    The implementation. +

    + + + + + diff --git a/info/gcl/string_002dupcase.html b/info/gcl/string_002dupcase.html new file mode 100644 index 0000000..0b9b083 --- /dev/null +++ b/info/gcl/string_002dupcase.html @@ -0,0 +1,170 @@ + + + + + +string-upcase (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.8 string-upcase, string-downcase, string-capitalize,

    +

    nstring-upcase, nstring-downcase, nstring-capitalize

    +

    [Function] +

    +

    string-upcase string &key start end ⇒ cased-string +

    +

    string-downcase string &key start end ⇒ cased-string +

    +

    string-capitalize string &key start end ⇒ cased-string +

    +

    nstring-upcase string &key start end ⇒ string +

    +

    nstring-downcase string &key start end ⇒ string +

    +

    nstring-capitalize string &key start end ⇒ string +

    +

    Arguments and Values::

    + +

    string—a string designator. + For nstring-upcase, + nstring-downcase, + and nstring-capitalize, + the string designator must be a string. +

    +

    start, end—bounding index designators of string. + The defaults for start and end are 0 and nil, respectively. +

    +

    cased-string—a string. +

    +

    Description::

    + +

    string-upcase, string-downcase, string-capitalize, +nstring-upcase, nstring-downcase, nstring-capitalize +change the case of the subsequence of string +bounded by start and end +as follows: +

    +
    +
    string-upcase
    +

    string-upcase returns a string just like string +with all lowercase characters replaced by the corresponding uppercase +characters. More precisely, each character of the result string +is produced by applying the function char-upcase to the corresponding +character of string. +

    +
    +
    string-downcase
    +

    string-downcase is like string-upcase +except that all uppercase characters are replaced by the corresponding +lowercase characters (using char-downcase). +

    +
    +
    string-capitalize
    +

    string-capitalize produces a copy of string such that, +for every word in the copy, the first character of the “word,” +if it has case, is uppercase and +any other characters with case in the word are lowercase. +For the purposes of string-capitalize, +a “word” is defined to be a +consecutive subsequence consisting of alphanumeric characters, +delimited at each end either by a non-alphanumeric character +or by an end of the string. +

    +
    +
    nstring-upcase, nstring-downcase, nstring-capitalize
    +

    nstring-upcase, nstring-downcase, +and nstring-capitalize are identical to string-upcase, +string-downcase, and string-capitalize +respectively except that they modify string. +

    +
    + +

    For string-upcase, string-downcase, and string-capitalize, +string is not modified. However, if no characters in string +require conversion, the result may be either string or a copy of it, +at the implementation’s discretion. +

    +

    Examples::

    +
    +
     (string-upcase "abcde") ⇒  "ABCDE"
+ (string-upcase "Dr. Livingston, I presume?")
+⇒  "DR. LIVINGSTON, I PRESUME?"
+ (string-upcase "Dr. Livingston, I presume?" :start 6 :end 10)
+⇒  "Dr. LiVINGston, I presume?"
+ (string-downcase "Dr. Livingston, I presume?")
+⇒  "dr. livingston, i presume?"
+
+ (string-capitalize "elm 13c arthur;fig don't") ⇒  "Elm 13c Arthur;Fig Don'T"
+ (string-capitalize " hello ") ⇒  " Hello "
+ (string-capitalize "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
+⇒   "Occluded Casements Forestall Inadvertent Defenestration"
+ (string-capitalize 'kludgy-hash-search) ⇒  "Kludgy-Hash-Search"
+ (string-capitalize "DON'T!") ⇒  "Don'T!"    ;not "Don't!"
+ (string-capitalize "pipe 13a, foo16c") ⇒  "Pipe 13a, Foo16c"
+
+ (setq str (copy-seq "0123ABCD890a")) ⇒  "0123ABCD890a"
+ (nstring-downcase str :start 5 :end 7) ⇒  "0123AbcD890a"
+ str ⇒  "0123AbcD890a"
+
    + +

    Side Effects::

    + +

    nstring-upcase, + nstring-downcase, +and nstring-capitalize modify string as appropriate +rather than constructing a new string. +

    +

    See Also::

    + +

    char-upcase +, char-downcase +

    +

    Notes::

    +

    The result is always of the same length +as string. +

    +
    +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    + + + + + diff --git a/info/gcl/string_003d.html b/info/gcl/string_003d.html new file mode 100644 index 0000000..bb385b0 --- /dev/null +++ b/info/gcl/string_003d.html @@ -0,0 +1,212 @@ + + + + + +string= (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.10 string=, string/=, string<, string>, string<=, string>=,

    +

    string-equal, string-not-equal, string-lessp,

    +

    string-greaterp, string-not-greaterp, string-not-lessp

    +

    [Function] +

    +

    string= string1 string2 &key start1 end1 start2 end2 ⇒ generalized-boolean +

    +

    string/= string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string< string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string> string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string<= string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string>= string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string-equal string1 string2 &key start1 end1 start2 end2 ⇒ generalized-boolean +

    +

    string-not-equal string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string-lessp string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string-greaterp string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string-not-greaterp string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    string-not-lessp string1 string2 &key start1 end1 start2 end2 ⇒ mismatch-index +

    +

    Arguments and Values::

    + +

    string1—a string designator. +

    +

    string2—a string designator. +

    +

    start1, end1—bounding index designators of string1. + The defaults for start and end are 0 and nil, respectively. +

    +

    start2, end2—bounding index designators of string2. + The defaults for start and end are 0 and nil, respectively. +

    +

    generalized-boolean—a generalized boolean. +

    +

    mismatch-index—a bounding index of string1, or nil. +

    +

    Description::

    + +

    These functions perform lexicographic comparisons on string1 and string2. +string= and string-equal are called equality functions; +the others are called inequality functions. +The comparison operations these functions perform are restricted + to the subsequence of string1 bounded by start1 and end1 + and to the subsequence of string2 bounded by start2 and end2. +

    +

    A string a is equal to a string b if it contains the same number +of characters, and the corresponding characters are the same +under char= or char-equal, as appropriate. +

    +

    A string a is less than a string b if in the first position in +which they differ the character of a is less than the corresponding +character of b according to char< or char-lessp +as appropriate, or if string a is a proper prefix of string b +(of shorter length and matching in all the characters of a). +

    +

    The equality functions return a generalized boolean +that is true if the strings are equal, +or false otherwise. +

    +

    The inequality functions return a mismatch-index +that is true if the strings are not equal, +or false otherwise. +When the mismatch-index is true, +it is an integer representing the first character position at which the +two substrings differ, as an offset from the beginning of string1. +

    +

    The comparison has one of the following results: +

    +
    +
    string=
    +

    string= is true if the supplied substrings are of +the same length and contain the same characters in corresponding +positions; otherwise it is false. +

    +
    +
    string/=
    +

    string/= is true if the supplied substrings are +different; otherwise it is false. +

    +
    +
    string-equal
    +

    string-equal is just like string= +except that differences in case are ignored; +two characters are considered to be the same if char-equal is true of them. +

    +
    +
    string<
    +

    string< is true if substring1 is less than substring2; +otherwise it is false. +

    +
    +
    string>
    +

    string> is true if substring1 is greater than substring2; +otherwise it is false. +

    +
    +
    string-lessp, string-greaterp
    +

    string-lessp and string-greaterp +are exactly like string< and string>, respectively, +except that distinctions between uppercase and lowercase letters are ignored. +It is as if char-lessp were used instead of char< +for comparing characters. +

    +
    +
    string<=
    +

    string<= is true if substring1 is less than or equal to substring2; +otherwise it is false. +

    +
    +
    string>=
    +

    string>= is true if substring1 is greater than or equal to substring2; +otherwise it is false. +

    +
    +
    string-not-greaterp, string-not-lessp
    +

    string-not-greaterp and string-not-lessp +are exactly like string<= and string>=, respectively, +except that distinctions between uppercase and lowercase letters are ignored. +It is as if char-lessp were used instead of char< +for comparing characters. +

    +
    +
    + +

    Examples::

    + +
    +
     (string= "foo" "foo") ⇒  true
+ (string= "foo" "Foo") ⇒  false
+ (string= "foo" "bar") ⇒  false
+ (string= "together" "frog" :start1 1 :end1 3 :start2 2) ⇒  true
+ (string-equal "foo" "Foo") ⇒  true
+ (string= "abcd" "01234abcd9012" :start2 5 :end2 9) ⇒  true
+ (string< "aaaa" "aaab") ⇒  3
+ (string>= "aaaaa" "aaaa") ⇒  4
+ (string-not-greaterp "Abcde" "abcdE") ⇒  5
+ (string-lessp "012AAAA789" "01aaab6" :start1 3 :end1 7
+                                      :start2 2 :end2 6) ⇒  6
+ (string-not-equal "AAAA" "aaaA") ⇒  false
+
    + +

    See Also::

    + +

    char= +

    +

    Notes::

    + +

    equal calls string= if applied to two strings. +

    +
    +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    + + + + + diff --git a/info/gcl/stringp.html b/info/gcl/stringp.html new file mode 100644 index 0000000..4ac0993 --- /dev/null +++ b/info/gcl/stringp.html @@ -0,0 +1,83 @@ + + + + + +stringp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Strings Dictionary  

    +
    +
    +

    16.2.11 stringp [Function]

    + +

    stringp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type string; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (stringp "aaaaaa") ⇒  true
+ (stringp #\a) ⇒  false
+
    + +

    See Also::

    + +

    typep +, +string (type) +

    +

    Notes::

    + +
    +
     (stringp object) ≡ (typep object 'string)
+
    + + + + + + diff --git a/info/gcl/structure_002dclass.html b/info/gcl/structure_002dclass.html new file mode 100644 index 0000000..dae9ec4 --- /dev/null +++ b/info/gcl/structure_002dclass.html @@ -0,0 +1,65 @@ + + + + + +structure-class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.9 structure-class [System Class]

    + +

    Class Precedence List::

    + +

    structure-class, +class, +

    +

    standard-object, +

    +

    t +

    +

    Description::

    + +

    All classes defined by means of defstruct +are instances of the class structure-class. +

    + + + + + diff --git a/info/gcl/structure_002dobject.html b/info/gcl/structure_002dobject.html new file mode 100644 index 0000000..7877ad5 --- /dev/null +++ b/info/gcl/structure_002dobject.html @@ -0,0 +1,71 @@ + + + + + +structure-object (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.13 structure-object [Class]

    + +

    Class Precedence List::

    + +

    structure-object, +t +

    +

    Description::

    + +

    The class structure-object is an instance of structure-class +and is a superclass of every class +that is an instance of structure-class +except itself, and is a superclass of every class +that is defined by defstruct. +

    +

    See Also::

    + +

    defstruct +, +Sharpsign S, +Printing Structures +

    + + + + + diff --git a/info/gcl/style_002dwarning.html b/info/gcl/style_002dwarning.html new file mode 100644 index 0000000..b7f678b --- /dev/null +++ b/info/gcl/style_002dwarning.html @@ -0,0 +1,85 @@ + + + + + +style-warning (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.3 style-warning [Condition Type]

    + +

    Class Precedence List::

    +

    style-warning, +warning, +condition, +t +

    +

    Description::

    + +

    The type style-warning includes those conditions +that represent situations involving code +that is conforming code but that is nevertheless +considered to be faulty or substandard. +

    +

    See Also::

    + +

    muffle-warning +

    +

    Notes::

    + +

    An implementation might signal such a condition +if it encounters code + that uses deprecated features + or that appears unaesthetic or inefficient. +

    +

    An ‘unused variable’ warning must be of type style-warning. +

    +

    In general, the question of whether code is faulty or substandard +is a subjective decision to be made by the facility processing that code. +The intent is that whenever such a facility wishes to complain about +code on such subjective grounds, it should use this +condition type so that any clients who wish to redirect or +muffle superfluous warnings can do so without risking that they will be +redirecting or muffling other, more serious warnings. +

    + + + + + diff --git a/info/gcl/sublis.html b/info/gcl/sublis.html new file mode 100644 index 0000000..eac279c --- /dev/null +++ b/info/gcl/sublis.html @@ -0,0 +1,168 @@ + + + + + +sublis (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.11 sublis, nsublis [Function]

    + +

    sublis alist tree &key key test test-not ⇒ new-tree +

    +

    nsublis alist tree &key key test test-not ⇒ new-tree +

    +

    Arguments and Values::

    + +

    alist—an association list. +

    +

    tree—a tree. +

    +

    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. +

    +

    new-tree—a tree. +

    +

    Description::

    + +

    sublis makes substitutions for objects in tree +(a structure of conses). +nsublis is like sublis +but destructively modifies the relevant +parts of the tree. +

    +

    sublis looks at all subtrees and leaves of tree; +if a subtree or leaf appears as a key in alist +(that is, the key and the subtree or leaf satisfy the test), +it is replaced by the object with which that key is associated. +This operation is non-destructive. In effect, sublis can +perform several subst operations simultaneously. +

    +

    If sublis succeeds, a new copy of tree is returned in +which each occurrence of such a subtree or leaf is replaced by the +object with which it is associated. If no changes are made, the +original tree is returned. The original tree is left unchanged, +but the result tree may share cells with it. +

    +

    nsublis is permitted to modify tree +but otherwise returns the same values as sublis. +

    +

    Examples::

    + +
    +
     (sublis '((x . 100) (z . zprime))
+         '(plus x (minus g z x p) 4 . x))
+⇒  (PLUS 100 (MINUS G ZPRIME 100 P) 4 . 100)
+ (sublis '(((+ x y) . (- x y)) ((- x y) . (+ x y)))
+         '(* (/ (+ x y) (+ x p)) (- x y))
+         :test #'equal)
+⇒  (* (/ (- X Y) (+ X P)) (+ X Y))
+ (setq tree1 '(1 (1 2) ((1 2 3)) (((1 2 3 4)))))
+⇒  (1 (1 2) ((1 2 3)) (((1 2 3 4))))
+ (sublis '((3 . "three")) tree1) 
+⇒  (1 (1 2) ((1 2 "three")) (((1 2 "three" 4))))
+ (sublis '((t . "string"))
+          (sublis '((1 . "") (4 . 44)) tree1)
+          :key #'stringp)
+⇒  ("string" ("string" 2) (("string" 2 3)) ((("string" 2 3 44))))
+ tree1 ⇒  (1 (1 2) ((1 2 3)) (((1 2 3 4))))
+ (setq tree2 '("one" ("one" "two") (("one" "Two" "three"))))
+⇒  ("one" ("one" "two") (("one" "Two" "three"))) 
+ (sublis '(("two" . 2)) tree2) 
+⇒  ("one" ("one" "two") (("one" "Two" "three"))) 
+ tree2 ⇒  ("one" ("one" "two") (("one" "Two" "three"))) 
+ (sublis '(("two" . 2)) tree2 :test 'equal) 
+⇒  ("one" ("one" 2) (("one" "Two" "three"))) 
+
+ (nsublis '((t . 'temp))
+           tree1
+           :key #'(lambda (x) (or (atom x) (< (list-length x) 3))))
+⇒  ((QUOTE TEMP) (QUOTE TEMP) QUOTE TEMP) 
+
    + +

    Side Effects::

    + +

    nsublis modifies tree. +

    +

    See Also::

    + +

    subst +, +

    +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    Because the side-effecting variants (e.g., nsublis) potentially +change the path that is being traversed, their effects in the presence +of shared or circular structure structure may vary in surprising ways +when compared to their non-side-effecting alternatives. To see this, +consider the following side-effect behavior, which might be exhibited by +some implementations: +

    +
    +
     (defun test-it (fn)
+   (let* ((shared-piece (list 'a 'b))
+          (data (list shared-piece shared-piece)))
+     (funcall fn '((a . b) (b . a)) data)))
+ (test-it #'sublis) ⇒  ((B A) (B A))
+ (test-it #'nsublis) ⇒  ((A B) (A B))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/subseq.html b/info/gcl/subseq.html new file mode 100644 index 0000000..2909964 --- /dev/null +++ b/info/gcl/subseq.html @@ -0,0 +1,123 @@ + + + + + +subseq (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.6 subseq [Accessor]

    + +

    subseq sequence start &optional end ⇒ subsequence +

    +

    (setf ( subseq sequence start &optional end) new-subsequence)
    +

    +

    Arguments and Values::

    + +

    sequence—a proper sequence. +

    +

    start, end—bounding index designators of sequence. + The default for end is nil. +

    +

    subsequence—a proper sequence. +

    +

    new-subsequence—a proper sequence. +

    +

    Description::

    + +

    subseq creates a sequence +that is a copy of the subsequence of sequence +bounded by start and end. +

    +

    Start specifies an offset into the original sequence and +marks the beginning position of the subsequence. +end marks the position following the last element of the subsequence. +

    +

    subseq always allocates a new sequence for a result; +it never shares storage with an old sequence. +The result subsequence is always of the same type as sequence. +

    +

    If sequence is a vector, +the result is a fresh simple array +of rank one +that has the same actual array element type as sequence. +If sequence is a list, +the result is a fresh list. +

    +

    setf may be used with subseq to destructively replace +elements of a subsequence with elements +taken from a sequence of new values. +If the subsequence and the new sequence are not of equal length, +the shorter length determines the number of elements that are +replaced. The remaining elements at the end of the longer sequence +are not modified in the operation. +

    +

    Examples::

    + +
    +
     (setq str "012345") ⇒  "012345"
+ (subseq str 2) ⇒  "2345"
+ (subseq str 3 5) ⇒  "34"
+ (setf (subseq str 4) "abc") ⇒  "abc"
+ str ⇒  "0123ab"
+ (setf (subseq str 0 2) "A") ⇒  "A"
+ str ⇒  "A123ab"
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +Should be prepared to signal an error of type type-error + if new-subsequence is not a proper sequence. +

    +

    See Also::

    + +

    replace +

    +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/subsetp.html b/info/gcl/subsetp.html new file mode 100644 index 0000000..e881cc6 --- /dev/null +++ b/info/gcl/subsetp.html @@ -0,0 +1,125 @@ + + + + + +subsetp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.48 subsetp [Function]

    + +

    subsetp list-1 list-2 &key key test test-not ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    list-1—a proper list. +

    +

    list-2—a proper list. +

    +

    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. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    subsetp returns true if every element of list-1 +matches some element of list-2, +and false otherwise. +

    +

    Whether a list element is the same as another list element is +determined by the functions specified by the keyword arguments. +The first argument to the :test or :test-not +function is +typically +part of an element of list-1 extracted by +the :key function; the second argument is typically part of +an element of list-2 extracted by +the :key function. +

    +

    The argument to the :key function is an element of either +list-1 or list-2; the return value is part of the element +of the supplied list element. +If :key is not supplied or nil, +the list-1 or list-2 +element itself is supplied to the :test or :test-not +function. +

    +

    Examples::

    + +
    +
     (setq cosmos '(1 "a" (1 2))) ⇒  (1 "a" (1 2))
+ (subsetp '(1) cosmos) ⇒  true
+ (subsetp '((1 2)) cosmos) ⇒  false
+ (subsetp '((1 2)) cosmos :test 'equal) ⇒  true
+ (subsetp '(1 "A") cosmos :test #'equalp) ⇒  true
+ (subsetp '((1) (2)) '((1) (2))) ⇒  false
+ (subsetp '((1) (2)) '((1) (2)) :key #'car) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list-1 and list-2 are not proper lists. +

    +

    See Also::

    + +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/subst.html b/info/gcl/subst.html new file mode 100644 index 0000000..3f064a4 --- /dev/null +++ b/info/gcl/subst.html @@ -0,0 +1,196 @@ + + + + + +subst (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.12 subst, subst-if, subst-if-not, nsubst, nsubst-if, nsubst-if-not

    +

    [Function] +

    +

    subst new old tree &key key test test-not ⇒ new-tree +

    +

    subst-if new predicate tree &key key ⇒ new-tree +

    +

    subst-if-not new predicate tree &key key ⇒ new-tree +

    +

    nsubst new old tree &key key test test-not ⇒ new-tree +

    +

    nsubst-if new predicate tree &key key ⇒ new-tree +

    +

    nsubst-if-not new predicate tree &key key ⇒ new-tree +

    +

    Arguments and Values::

    + +

    new—an object. +

    +

    old—an object. +

    +

    predicate—a symbol that names a function, + or a function of one argument + that returns a generalized boolean value. +

    +

    tree—a tree. +

    +

    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. +

    +

    new-tree—a tree. +

    +

    Description::

    + +

    subst, subst-if, and subst-if-not perform +substitution operations on tree. +Each function searches tree for occurrences of a +particular old item of an element or subexpression that +satisfies the test. +

    +

    nsubst, nsubst-if, and nsubst-if-not are +like subst, +subst-if, and subst-if-not respectively, except that the +original tree is modified. +

    +

    subst makes a copy of tree, +substituting new for every subtree or leaf of tree +(whether the subtree or leaf is a car or a cdr of its parent) +such that old and the subtree or leaf satisfy the test. +

    +

    nsubst is a destructive version of subst. +The list structure of +tree is altered by destructively replacing with new +each leaf of the tree such that old and the leaf +satisfy the test. +

    +

    For subst, subst-if, +and subst-if-not, +if the functions succeed, a new +copy of the tree is returned in which each occurrence of such an +element is replaced by the +new element or subexpression. If no changes are made, the original +tree may be returned. +The original tree is left unchanged, but the result tree +may share storage with it. +

    +

    For nsubst, nsubst-if, +and nsubst-if-not +the original tree is modified and returned as the function result, +but the result may not be eq to tree. +

    +

    Examples::

    + +
    +
     (setq tree1 '(1 (1 2) (1 2 3) (1 2 3 4))) ⇒  (1 (1 2) (1 2 3) (1 2 3 4))
+ (subst "two" 2 tree1) ⇒  (1 (1 "two") (1 "two" 3) (1 "two" 3 4))
+ (subst "five" 5 tree1) ⇒  (1 (1 2) (1 2 3) (1 2 3 4))
+ (eq tree1 (subst "five" 5 tree1)) ⇒  implementation-dependent
+ (subst 'tempest 'hurricane
+        '(shakespeare wrote (the hurricane)))
+⇒  (SHAKESPEARE WROTE (THE TEMPEST))
+ (subst 'foo 'nil '(shakespeare wrote (twelfth night)))
+⇒  (SHAKESPEARE WROTE (TWELFTH NIGHT . FOO) . FOO)
+ (subst '(a . cons) '(old . pair)
+        '((old . spice) ((old . shoes) old . pair) (old . pair))
+        :test #'equal)
+⇒  ((OLD . SPICE) ((OLD . SHOES) A . CONS) (A . CONS))
+
+ (subst-if 5 #'listp tree1) ⇒  5
+ (subst-if-not '(x) #'consp tree1) 
+⇒  (1 X)
+
+ tree1 ⇒  (1 (1 2) (1 2 3) (1 2 3 4))
+ (nsubst 'x 3 tree1 :key #'(lambda (y) (and (listp y) (third y)))) 
+⇒  (1 (1 2) X X)
+ tree1 ⇒  (1 (1 2) X X)
+
    + +

    Side Effects::

    + +

    nsubst, nsubst-if, and nsubst-if-not +might alter the tree structure of tree. +

    +

    See Also::

    + +

    substitute +, +nsubstitute, +

    +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    The functions subst-if-not and nsubst-if-not are deprecated. +

    +

    One possible definition of subst: +

    +
    +
     (defun subst (old new tree &rest x &key test test-not key)
+   (cond ((satisfies-the-test old tree :test test
+                                 :test-not test-not :key key)
+         new)
+        ((atom tree) tree)
+        (t (let ((a (apply #'subst old new (car tree) x))
+                 (d (apply #'subst old new (cdr tree) x)))
+             (if (and (eql a (car tree))
+                      (eql d (cdr tree)))
+                 tree
+                 (cons a d))))))
+
    + +
    +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/substitute.html b/info/gcl/substitute.html new file mode 100644 index 0000000..4a1cff9 --- /dev/null +++ b/info/gcl/substitute.html @@ -0,0 +1,244 @@ + + + + + +substitute (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    +
    +

    17.3.19 substitute, substitute-if, substitute-if-not,

    +

    nsubstitute, nsubstitute-if, nsubstitute-if-not

    +

    [Function] +

    +

    substitute newitem olditem sequence + &key from-end test + test-not start + end count key
    + ⇒ result-sequence +

    +

    substitute-if newitem predicate sequence &key from-end start end count key
    + ⇒ result-sequence +

    +

    substitute-if-not newitem predicate sequence &key from-end start end count key
    + ⇒ result-sequence +

    +

    nsubstitute newitem olditem sequence + &key from-end test test-not start end count key
    + ⇒ sequence +

    +

    nsubstitute-if newitem predicate sequence &key from-end start end count key
    + ⇒ sequence +

    +

    nsubstitute-if-not newitem predicate sequence &key from-end start end count key
    + ⇒ sequence +

    +

    Arguments and Values::

    + +

    newitem—an object. +

    +

    olditem—an object. +

    +

    sequence—a proper sequence. +

    +

    predicate—a designator for a function of one argument + that returns a generalized boolean. +

    +

    from-end—a generalized boolean. + The default is false. +

    +

    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. +

    +

    start, end—bounding index designators of sequence. + The defaults for start and end are 0 and nil, respectively. +

    +

    count—an integer or nil. +

    +

    The default is nil. +

    +

    key—a designator for a function of one argument, + or nil. +

    +

    result-sequence—a sequence. +

    +

    Description::

    + +

    substitute, substitute-if, and substitute-if-not +return a +copy of sequence in which each element +that satisfies the test has been replaced with newitem. +

    +

    nsubstitute, nsubstitute-if, and nsubstitute-if-not +are like substitute, substitute-if, and +substitute-if-not respectively, but they may modify +sequence. +

    +

    If +sequence is a vector, the result is a +vector that has the same +actual array element type as sequence. +The result might or might not be simple, and +might or might not be identical +to sequence. +If sequence is a list, the result is a +list. +

    +

    Count, if supplied, limits the number of elements +altered; if more than count elements satisfy the test, +then of these elements only the leftmost or rightmost, depending +on from-end, are replaced, +as many as specified by count. +

    +

    If count is supplied and negative, +the behavior is as if zero had been supplied instead. +

    +

    If count is nil, all matching items are affected. +

    +

    Supplying a from-end of true matters only when the +count is provided (and non-nil); +in that case, +only the rightmost count elements satisfying the test are removed +(instead of the leftmost). +

    +

    predicate, test, and test-not +might be called more than once for each sequence element, +and their side effects can happen in any order. +

    +

    The result of all these functions is a sequence +of the same type as sequence +that has the same elements except that those in the subsequence +bounded by start and end and satisfying the test +have been replaced by newitem. +

    +

    substitute, substitute-if, and substitute-if-not +return a sequence which can share with sequence +or may be identical to the input sequence +if no elements need to be changed. +

    +

    nsubstitute and nsubstitute-if are required to +setf any car (if sequence is a list) +or aref (if sequence is a vector) +of sequence that is required to be replaced with newitem. +If sequence is a list, +none of the cdrs of the top-level list can be modified. +

    +

    Examples::

    + +
    +
     (substitute #\. #\SPACE "0 2 4 6") ⇒  "0.2.4.6"
+ (substitute 9 4 '(1 2 4 1 3 4 5)) ⇒  (1 2 9 1 3 9 5)
+ (substitute 9 4 '(1 2 4 1 3 4 5) :count 1) ⇒  (1 2 9 1 3 4 5)
+ (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t)
+⇒  (1 2 4 1 3 9 5)
+ (substitute 9 3 '(1 2 4 1 3 4 5) :test #'>) ⇒  (9 9 4 9 3 4 5)
+
+ (substitute-if 0 #'evenp '((1) (2) (3) (4)) :start 2 :key #'car)
+⇒  ((1) (2) (3) 0)
+ (substitute-if 9 #'oddp '(1 2 4 1 3 4 5)) ⇒  (9 2 4 9 9 4 9)
+ (substitute-if 9 #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
+⇒  (1 2 4 1 3 9 5)
+
+ (setq some-things (list 'a 'car 'b 'cdr 'c)) ⇒  (A CAR B CDR C)
+ (nsubstitute-if "function was here" #'fboundp some-things
+                 :count 1 :from-end t) ⇒  (A CAR B "function was here" C)
+ some-things ⇒  (A CAR B "function was here" C)
+ (setq alpha-tester (copy-seq "ab ")) ⇒  "ab "
+ (nsubstitute-if-not #\z #'alpha-char-p alpha-tester) ⇒  "abz"
+ alpha-tester ⇒  "abz"
+
    + +

    Side Effects::

    + +

    nsubstitute, nsubstitute-if, and nsubstitute-if-not +modify sequence. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +

    +

    See Also::

    + +

    subst +, +nsubst, +

    +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not argument is deprecated. +

    +

    The functions substitute-if-not and nsubstitute-if-not are deprecated. +

    +

    nsubstitute and nsubstitute-if can be used +in for-effect-only positions in code. +

    +

    Because the side-effecting variants (e.g., nsubstitute) +potentially change the path that is being traversed, their effects in +the presence of shared or circular structure may vary in surprising ways when +compared to their non-side-effecting alternatives. To see this, +consider the following side-effect behavior, which might be exhibited by +some implementations: +

    +
    +
     (defun test-it (fn)
+   (let ((x (cons 'b nil)))
+     (rplacd x x)
+     (funcall fn 'a 'b x :count 1)))
+ (test-it #'substitute) ⇒  (A . #1=(B . #1#))
+ (test-it #'nsubstitute) ⇒  (A . #1#)
+
    + +
    +
    +

    +Next: , Previous: , Up: Sequences Dictionary  

    +
    + + + + + diff --git a/info/gcl/subtypep.html b/info/gcl/subtypep.html new file mode 100644 index 0000000..a248785 --- /dev/null +++ b/info/gcl/subtypep.html @@ -0,0 +1,284 @@ + + + + + +subtypep (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.26 subtypep [Function]

    + +

    subtypep type-1 type-2 &optional environment ⇒ subtype-p, valid-p +

    +

    Arguments and Values::

    + +

    type-1—a type specifier. +

    +

    type-2—a type specifier. +

    +

    environment—an environment object. + The default is nil, denoting the null lexical environment + and the current global environment. +

    +

    subtype-p—a generalized boolean. +

    +

    valid-p—a generalized boolean. +

    +

    Description::

    + +

    If type-1 is a recognizable subtype of type-2, +the first value is true. +Otherwise, the first value is false, +indicating that either + type-1 is not a subtype of type-2, or else + type-1 is a subtype of type-2 + but is not a recognizable subtype. +

    +

    A second value is also returned indicating the ‘certainty’ of +the first value. If this value is true, then the first +value is an accurate indication of the subtype relationship. +(The second value is always true when the first value + is true.) +

    +

    Figure 4–9 summarizes the possible combinations of values +that might result. +

    +
    +
      Value 1  Value 2  Meaning                                               
+  true     true     type-1 is definitely a subtype of type-2.             
+  false    true     type-1 is definitely not a subtype of type-2.         
+  false    false    subtypep could not determine the relationship,        
+                    so type-1 might or might not be a subtype of type-2.  
+
+               Figure 4–9: Result possibilities for subtypep             
+
+
    + +

    subtypep is permitted to return the +values false and false only when at least +one argument involves one of these type specifiers: + and, + eql, + the list form of function, + member, + not, + or, + satisfies, +or + values. +(A type specifier ‘involves’ such a symbol if, + after being type expanded, + it contains that symbol in a position that would call for + its meaning as a type specifier to be used.) +One consequence of this is that if neither type-1 nor type-2 +involves any of these type specifiers, then subtypep is obliged +to determine the relationship accurately. In particular, subtypep +returns the values true and true +if the arguments are equal and do not involve +any of these type specifiers. +

    +

    subtypep never returns a second value of nil when both +type-1 and type-2 involve only + the names in Figure~4–2, or + names of types defined by defstruct, +define-condition, + or defclass, or + derived types that expand into only those names. +While type specifiers listed in Figure~4–2 and +names of defclass and defstruct can in some cases be +implemented as derived types, subtypep regards them as primitive. +

    +

    The relationships between types reflected by subtypep +are those specific to the particular implementation. For example, if +an implementation supports only a single type of floating-point numbers, +in that implementation (subtypep 'float 'long-float) +returns the values true and true +(since the two types are identical). +

    +

    For all T1 and T2 other than *, +(array T1) and (array T2) +are two different type specifiers that always refer to the same sets of +things if and only if they refer to arrays +of exactly the same specialized representation, i.e., if (upgraded-array-element-type 'T1) and + (upgraded-array-element-type 'T2) +return two different type specifiers that always refer to the same sets of +objects. +This is another way of saying that +`(array type-specifier) +and +`(array ,(upgraded-array-element-type 'type-specifier)) +refer to the same +set of specialized array representations. +For all T1 and T2 other than *, +the intersection of + (array T1) +and (array T2) is the empty set +if and only if they refer to arrays of different, +distinct specialized representations. +

    +

    Therefore, +

    +
    +
     (subtypep '(array T1) '(array T2)) ⇒  true
+
    + +

    if and only if +

    +
    +
     (upgraded-array-element-type 'T1)  and
+ (upgraded-array-element-type 'T2)  
+
    + +

    return two different type specifiers that always refer to the same sets of +objects. +

    +

    For all type-specifiers T1 and T2 other than *, +

    +
    +
     (subtypep '(complex T1) '(complex T2)) ⇒  true, true
+
    + +

    if: +

    +
    1.
    +

    T1 is a subtype of T2, or +

    +
    2.
    +

    (upgraded-complex-part-type 'T1) and + (upgraded-complex-part-type 'T2) + return two different type specifiers that always refer to the + same sets of objects; in this case, + (complex T1) and + (complex T2) both refer to the + same specialized representation. +

    +
    + +

    The values are false and true otherwise. +

    +

    The form +

    +
    +
     (subtypep '(complex single-float) '(complex float))
+
    + +

    must return true in all implementations, but +

    +
    +
     (subtypep '(array single-float) '(array float))
+
    + +

    returns true only in implementations that do not have a specialized array +representation for single floats distinct from that for other floats. +

    +

    Examples::

    + +
    +
     (subtypep 'compiled-function 'function) ⇒  true, true
+ (subtypep 'null 'list) ⇒  true, true
+ (subtypep 'null 'symbol) ⇒  true, true
+ (subtypep 'integer 'string) ⇒  false, true
+ (subtypep '(satisfies dummy) nil) ⇒  false, implementation-dependent
+ (subtypep '(integer 1 3) '(integer 1 4)) ⇒  true, true
+ (subtypep '(integer (0) (0)) 'nil) ⇒  true, true
+ (subtypep 'nil '(integer (0) (0))) ⇒  true, true
+ (subtypep '(integer (0) (0)) '(member)) ⇒  true, true ;or false, false
+ (subtypep '(member) 'nil) ⇒  true, true ;or false, false
+ (subtypep 'nil '(member)) ⇒  true, true ;or false, false
+
    + +

    Let <aet-x> and <aet-y> be two distinct type specifiers that +do not always refer to the same sets of +objects +in a given implementation, but for which +make-array, will return an +object of the same array type. +

    +

    Thus, in each case, +

    +
    +
      (subtypep (array-element-type (make-array 0 :element-type '<aet-x>))
+            (array-element-type (make-array 0 :element-type '<aet-y>)))
+⇒  true, true
+
+  (subtypep (array-element-type (make-array 0 :element-type '<aet-y>))
+            (array-element-type (make-array 0 :element-type '<aet-x>)))
+⇒  true, true
+
    + +

    If (array <aet-x>) +and (array <aet-y>) are different names for +exactly the same set of objects, +these names should always refer to the same sets of +objects. + That implies that the following set of tests are also true: +

    +
    +
     (subtypep '(array <aet-x>) '(array <aet-y>)) ⇒  true, true
+ (subtypep '(array <aet-y>) '(array <aet-x>)) ⇒  true, true
+
    + +

    See Also::

    + +

    Types +

    +

    Notes::

    + +

    The small differences between the subtypep specification for +the array and complex types are necessary because there +is no creation function for complexes which allows +the specification of the resultant part type independently of +the actual types of the parts. Thus in the case of the type complex, +the actual type of the parts is referred to, although a number +can be a member of more than one type. +For example, 17 is of type (mod 18) +as well as type (mod 256) and type integer; +and 2.3f5 is of type single-float +as well as type float. +

    +
    +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    + + + + + diff --git a/info/gcl/svref.html b/info/gcl/svref.html new file mode 100644 index 0000000..dc992ba --- /dev/null +++ b/info/gcl/svref.html @@ -0,0 +1,99 @@ + + + + + +svref (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.28 svref [Accessor]

    + +

    svref simple-vector index ⇒ element +

    +

    (setf ( svref simple-vector index) new-element)
    +

    +

    Arguments and Values::

    + +

    simple-vector—a simple vector. +

    +

    index—a valid array index for the simple-vector. +

    +

    element, new-element—an object + (whose type is a subtype + of the array element type of the simple-vector). +

    +

    Description::

    + +

    Accesses the element of simple-vector specified by index. +

    +

    Examples::

    + +
    +
     (simple-vector-p (setq v (vector 1 2 'sirens))) ⇒  true
+ (svref v 0) ⇒  1
+ (svref v 2) ⇒  SIRENS
+ (setf (svref v 1) 'newcomer) ⇒  NEWCOMER               
+ v ⇒  #(1 NEWCOMER SIRENS)
+
    + +

    See Also::

    + +

    aref +, +sbit, +schar, +vector +, +

    +

    Compiler Terminology +

    +

    Notes::

    + +

    svref is identical to aref +except that it requires its first argument to be a simple vector. +

    +
    +
     (svref v i) ≡ (aref (the simple-vector v) i)
+
    + + + + + + diff --git a/info/gcl/sxhash.html b/info/gcl/sxhash.html new file mode 100644 index 0000000..59d1a28 --- /dev/null +++ b/info/gcl/sxhash.html @@ -0,0 +1,159 @@ + + + + + +sxhash (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.14 sxhash [Function]

    + +

    sxhash object ⇒ hash-code +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    hash-code—a non-negative fixnum. +

    +

    Description::

    + +

    sxhash returns a hash code for object. +

    +

    The manner in which the hash code is computed is implementation-dependent, +but subject to certain constraints: +

    +
    +
    1.
    +

    (equal x y) implies (= (sxhash x) (sxhash y)). +

    +
    +
    2.
    +

    For any two objects, x and y, + both of which are + bit vectors, + characters, + conses, + numbers, + pathnames, + strings, + or symbols, + and which are similar, + (sxhash x) and (sxhash y) + yield the same mathematical value + even if x and y exist in different Lisp images of + the same implementation. + See Literal Objects in Compiled Files. +

    +
    +
    3.
    +

    The hash-code for an object is always the same + within a single session provided that the object is not + visibly modified with regard to the equivalence test equal. + See Modifying Hash Table Keys. +

    +
    +
    4.
    +

    The hash-code is intended for hashing. This places no verifiable + constraint on a conforming implementation, but the intent is that + an implementation should make a good-faith effort to produce + hash-codes that are well distributed within the range of + non-negative fixnums. +

    +
    +
    5.
    +

    Computation of the hash-code must terminate, + even if the object contains circularities. +

    +
    + +

    Examples::

    + +
    +
     (= (sxhash (list 'list "ab")) (sxhash (list 'list "ab"))) ⇒  true
+ (= (sxhash "a") (sxhash (make-string 1 :initial-element #\a))) ⇒  true
+ (let ((r (make-random-state)))
+   (= (sxhash r) (sxhash (make-random-state r))))
+⇒  implementation-dependent
+
    + +

    Affected By::

    + +

    The implementation. +

    +

    Notes::

    + +

    Many common hashing needs are satisfied by make-hash-table and the +related functions on hash tables. sxhash is intended for use +where the pre-defined abstractions are insufficient. Its main intent is to +allow the user a convenient means of implementing more complicated hashing +paradigms than are provided through hash tables. +

    +

    The hash codes returned by sxhash are not necessarily related to +any hashing strategy used by any other function in Common Lisp. +

    +

    For objects of types that equal compares +with eq, item 3 requires that the hash-code be +based on some immutable quality of the identity of the object. +Another legitimate implementation technique would be to have +sxhash assign (and cache) a random hash code for these +objects, since there is no requirement that similar but +non-eq objects have the same hash code. +

    +

    Although similarity is defined for symbols in terms +of both the symbol’s name and the packages in which +the symbol is accessible, item 3 disallows using package +information to compute the hash code, since changes to the package status +of a symbol are not visible to equal. +

    + + + + + +
    +
    +

    +Previous: , Up: Hash Tables Dictionary  

    +
    + + + + + diff --git a/info/gcl/symbol.html b/info/gcl/symbol.html new file mode 100644 index 0000000..57469db --- /dev/null +++ b/info/gcl/symbol.html @@ -0,0 +1,185 @@ + + + + + +symbol (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.1 symbol [System Class]

    + +

    Class Precedence List::

    +

    symbol, +t +

    +

    Description::

    + +

    Symbols are used for their object identity to name various entities +in Common Lisp, including (but not limited to) linguistic entities such as +variables and functions. +

    +

    Symbols can be collected together into packages. +A symbol is said to be interned in a package +if it is accessible in that package; +the same symbol can be interned in more than one package. +If a symbol is not interned in any package, +it is called uninterned. +

    +

    An interned symbol is uniquely identifiable by its name from +any package in which it is accessible. +

    +

    Symbols have the following attributes. For historically reasons, +these are sometimes referred to as cells, although the actual +internal representation of symbols and their attributes is +implementation-dependent. +

    +
    +
    Name
    +

    The name of a symbol is a string used to identify the symbol. +Every symbol has a name, +

    +

    and the consequences are undefined if that name is altered. +

    +

    The name is used as part of the external, printed representation of +the symbol; see Character Syntax. +The function symbol-name returns the name of a given symbol. +

    +

    A symbol may have any character in its name. +

    +
    +
    Package
    +

    The object in this cell is called the home package +of the symbol. If the home package is nil, the symbol +is sometimes said to have no home package. +

    +

    When a symbol is first created, it has no home package. +When it is first interned, the package in which it is +initially interned becomes its home package. +The home package of a symbol can be accessed +by using the function symbol-package. +

    +

    If a symbol is uninterned from the package +which is its home package, its home package is set to nil. +Depending on whether there is another package in which the symbol +is interned, the symbol might or might not really be an uninterned symbol. +A symbol with no home package is therefore called +apparently uninterned. +

    +

    The consequences are undefined if an attempt is made to alter the home package +of a symbol +external +in the COMMON-LISP package or the KEYWORD package. +

    +
    +
    Property list
    +

    The property list of a symbol provides a mechanism for +associating named attributes with that symbol. +The operations for adding and removing entries are destructive +to the property list. Common Lisp provides operators both for +direct manipulation of property list objects + (e.g., see getf, remf, and symbol-plist) +and for implicit manipulation of a symbol’s property list +by reference to the symbol + (e.g., see get and remprop). +The property list associated with a fresh symbol is +initially null. +

    +
    +
    Value
    +

    If a symbol has a value attribute, it is said to be bound, +and that fact can be detected by the function boundp. +The object contained in the value cell of a bound symbol +is the value of the global variable named by that symbol, +and can be accessed by the function symbol-value. +A symbol can be made to be unbound by the function makunbound. +

    +

    The consequences are undefined if an attempt is made to change the value +of a symbol that names a constant variable, or to make such a +symbol be unbound. +

    +
    +
    Function
    +

    If a symbol has a function attribute, it is said to be fbound, +and that fact can be detected by the function fboundp. +If the symbol is the name of a function in the global environment, +the function cell contains the function, +and can be accessed by the function symbol-function. +If the symbol is the name of either + a macro in the global environment (see macro-function) +or a special operator (see special-operator-p), +the symbol is fbound, +and can be accessed by the function symbol-function, +but the object which the function cell +contains is of implementation-dependent type and purpose. +A symbol can be made to be funbound by the function fmakunbound. +

    +

    The consequences are undefined if an attempt is made to change the functional value +of a symbol that names a special form. +

    +
    +
    + +

    Operations on a symbol’s value cell and function cell are +sometimes described in terms of their effect on the symbol itself, but +the user should keep in mind that there is an intimate relationship between the +contents of those cells and the global variable or +global function definition, respectively. +

    +

    Symbols are used as identifiers for lexical variables and +lexical function definitions, but in that role, only their object +identity is significant. Common Lisp provides no operation on a symbol that +can have any effect on a lexical variable or +on a lexical function definition. +

    +

    See Also::

    + +

    Symbols as Tokens, +Potential Numbers as Tokens, +Printing Symbols +

    +
    +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    + + + + + diff --git a/info/gcl/symbol_002dfunction.html b/info/gcl/symbol_002dfunction.html new file mode 100644 index 0000000..a76f3eb --- /dev/null +++ b/info/gcl/symbol_002dfunction.html @@ -0,0 +1,157 @@ + + + + + +symbol-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.10 symbol-function [Accessor]

    + +

    symbol-function symbol ⇒ contents +

    +

    (setf ( symbol-function symbol) new-contents)
    +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    contents— +

    +

    If the symbol is globally defined as a macro or a special operator, +an object of implementation-dependent nature and identity is returned. +If the symbol is not globally defined as + either a macro or a special operator, +and + if the symbol is fbound, +a function object is returned. +

    +

    new-contents—a function. +

    +

    Description::

    + +

    Accesses the symbol’s function cell. +

    +

    Examples::

    + +
    +
     (symbol-function 'car) ⇒  #<FUNCTION CAR>
+ (symbol-function 'twice) is an error   ;because TWICE isn't defined.
+ (defun twice (n) (* n 2)) ⇒  TWICE
+ (symbol-function 'twice) ⇒  #<FUNCTION TWICE>
+ (list (twice 3)
+       (funcall (function twice) 3)
+       (funcall (symbol-function 'twice) 3))
+⇒  (6 6 6)
+ (flet ((twice (x) (list x x)))
+   (list (twice 3)
+         (funcall (function twice) 3)
+         (funcall (symbol-function 'twice) 3)))
+⇒  ((3 3) (3 3) 6)   
+ (setf (symbol-function 'twice) #'(lambda (x) (list x x)))
+⇒  #<FUNCTION anonymous>
+ (list (twice 3)
+       (funcall (function twice) 3)
+       (funcall (symbol-function 'twice) 3))
+⇒  ((3 3) (3 3) (3 3))
+ (fboundp 'defun) ⇒  true
+ (symbol-function 'defun)
+⇒  implementation-dependent
+ (functionp (symbol-function 'defun))
+⇒  implementation-dependent
+ (defun symbol-function-or-nil (symbol)
+   (if (and (fboundp symbol) 
+            (not (macro-function symbol))
+            (not (special-operator-p symbol)))
+       (symbol-function symbol)
+       nil)) ⇒  SYMBOL-FUNCTION-OR-NIL
+ (symbol-function-or-nil 'car) ⇒  #<FUNCTION CAR>
+ (symbol-function-or-nil 'defun) ⇒  NIL
+
    + +

    Affected By::

    + +

    defun +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    Should signal undefined-function if symbol is not fbound +and an attempt is made to read its definition. (No such error is signaled +on an attempt to write its definition.) +

    +

    See Also::

    + +

    fboundp +, +fmakunbound +, +macro-function +, +

    +

    special-operator-p +

    +

    Notes::

    +

    symbol-function cannot access the value of a lexical function name +produced by flet or labels; it can access only +the global function value. +

    +

    setf may be used with +symbol-function to replace a global function +definition when the symbol’s function definition +does not represent a special operator. +

    +
    +
    (symbol-function symbol) ≡ (fdefinition symbol)
+
    + +

    However, fdefinition accepts arguments other than just symbols. +

    +
    +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    + + + + + diff --git a/info/gcl/symbol_002dmacrolet.html b/info/gcl/symbol_002dmacrolet.html new file mode 100644 index 0000000..4603347 --- /dev/null +++ b/info/gcl/symbol_002dmacrolet.html @@ -0,0 +1,153 @@ + + + + + +symbol-macrolet (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.14 symbol-macrolet [Special Operator]

    + +

    symbol-macrolet ({(symbol expansion )}*) + {declaration}* + {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    expansion—a form. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    symbol-macrolet provides a mechanism for +affecting the macro expansion environment for symbols. +

    +

    symbol-macrolet lexically establishes expansion functions +for each of the symbol macros named by symbols. +

    +

    The only guaranteed property of an expansion function for a symbol macro +is that when it is applied to the form and the environment it returns +the correct expansion. (In particular, it is implementation-dependent +whether the expansion is conceptually stored in the expansion function, +the environment, or both.) +

    +

    Each reference to symbol as a variable within the lexical scope +of symbol-macrolet is expanded by the normal macro expansion process; +see Symbols as Forms. +The expansion of a symbol macro is subject to further macro expansion +in the same lexical environment as the symbol macro invocation, exactly +analogous to normal macros. +

    +

    Exactly the same declarations are allowed as for let +with one exception: symbol-macrolet signals an error +if a special declaration names one of the symbols +being defined by symbol-macrolet. +

    +

    When the forms of the symbol-macrolet form are expanded, +any use of setq to set the value of one of the specified variables + is treated as if it were a setf. +psetq of a symbol defined as a symbol macro + is treated as if it were a psetf, and +multiple-value-setq + is treated as if it were a setf of values. +

    +

    The use of symbol-macrolet can be shadowed by let. +In other words, symbol-macrolet only substitutes for occurrences +of symbol that would be in the scope of a lexical binding of +symbol surrounding the forms. +

    +

    Examples::

    + +
    +
    ;;; The following is equivalent to
+;;;   (list 'foo (let ((x 'bar)) x)),
+;;; not
+;;;   (list 'foo (let (('foo 'bar)) 'foo))
+ (symbol-macrolet ((x 'foo))
+   (list x (let ((x 'bar)) x))) 
+⇒  (foo bar)
+NOT⇒ (foo foo) 
+
+ (symbol-macrolet ((x '(foo x)))
+   (list x))
+⇒  ((FOO X))
+
    + +

    Exceptional Situations::

    + +

    If an attempt is made to bind a symbol that is defined as a global variable, +an error of type program-error is signaled. +

    +

    If declaration contains a special declaration +that names one of the symbols being bound by symbol-macrolet, +an error of type program-error is signaled. +

    +

    See Also::

    + +

    with-slots +, +macroexpand +

    +

    Notes::

    + +

    The special form symbol-macrolet is the basic mechanism that is used to +implement with-slots. +

    +

    If a symbol-macrolet form is a top level form, +the forms are also processed as top level forms. +See File Compilation. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/symbol_002dname.html b/info/gcl/symbol_002dname.html new file mode 100644 index 0000000..ec0769e --- /dev/null +++ b/info/gcl/symbol_002dname.html @@ -0,0 +1,78 @@ + + + + + +symbol-name (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.11 symbol-name [Function]

    + +

    symbol-name symbol ⇒ name +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    name—a string. +

    +

    Description::

    + +

    symbol-name returns the name of symbol. +

    +

    The consequences are undefined if name is ever modified. +

    +

    Examples::

    + +
    +
     (symbol-name 'temp) ⇒  "TEMP" 
+ (symbol-name :start) ⇒  "START"
+ (symbol-name (gensym)) ⇒  "G1234" ;for example
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    + + + + + diff --git a/info/gcl/symbol_002dpackage.html b/info/gcl/symbol_002dpackage.html new file mode 100644 index 0000000..2dfb7ac --- /dev/null +++ b/info/gcl/symbol_002dpackage.html @@ -0,0 +1,106 @@ + + + + + +symbol-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.12 symbol-package [Function]

    + +

    symbol-package symbol ⇒ contents +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    contents—a package object or nil. +

    +

    Description::

    + +

    Returns the home package of symbol. +

    +

    Examples::

    + +
    +
     (in-package "CL-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (symbol-package 'car) ⇒  #<PACKAGE "COMMON-LISP">
+ (symbol-package 'bus) ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (symbol-package :optional) ⇒  #<PACKAGE "KEYWORD">
+ ;; Gensyms are uninterned, so have no home package.
+ (symbol-package (gensym)) ⇒  NIL
+ (make-package 'pk1) ⇒  #<PACKAGE "PK1">
+ (intern "SAMPLE1" "PK1") ⇒  PK1::SAMPLE1, NIL
+ (export (find-symbol "SAMPLE1" "PK1") "PK1") ⇒  T
+ (make-package 'pk2 :use '(pk1)) ⇒  #<PACKAGE "PK2">
+ (find-symbol "SAMPLE1" "PK2") ⇒  PK1:SAMPLE1, :INHERITED
+ (symbol-package 'pk1::sample1) ⇒  #<PACKAGE "PK1">
+ (symbol-package 'pk2::sample1) ⇒  #<PACKAGE "PK1">
+ (symbol-package 'pk1::sample2) ⇒  #<PACKAGE "PK1">
+ (symbol-package 'pk2::sample2) ⇒  #<PACKAGE "PK2">
+ ;; The next several forms create a scenario in which a symbol
+ ;; is not really uninterned, but is "apparently uninterned",
+ ;; and so SYMBOL-PACKAGE still returns NIL.
+ (setq s3 'pk1::sample3) ⇒  PK1::SAMPLE3
+ (import s3 'pk2) ⇒  T
+ (unintern s3 'pk1) ⇒  T
+ (symbol-package s3) ⇒  NIL
+ (eq s3 'pk2::sample3) ⇒  T
+
    + +

    Affected By::

    + +

    import, +intern, +unintern +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    See Also::

    + +

    intern +

    + + + + + diff --git a/info/gcl/symbol_002dplist.html b/info/gcl/symbol_002dplist.html new file mode 100644 index 0000000..27e2fdd --- /dev/null +++ b/info/gcl/symbol_002dplist.html @@ -0,0 +1,95 @@ + + + + + +symbol-plist (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.13 symbol-plist [Accessor]

    + +

    symbol-plist symbol ⇒ plist +

    +

    (setf ( symbol-plist symbol) new-plist)
    +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    plist, new-plist—a property list. +

    +

    Description::

    + +

    Accesses the property list of symbol. +

    +

    Examples::

    + +
    +
     (setq sym (gensym)) ⇒  #:G9723
+ (symbol-plist sym) ⇒  ()
+ (setf (get sym 'prop1) 'val1) ⇒  VAL1
+ (symbol-plist sym) ⇒  (PROP1 VAL1)
+ (setf (get sym 'prop2) 'val2) ⇒  VAL2
+ (symbol-plist sym) ⇒  (PROP2 VAL2 PROP1 VAL1)
+ (setf (symbol-plist sym) (list 'prop3 'val3)) ⇒  (PROP3 VAL3)
+ (symbol-plist sym) ⇒  (PROP3 VAL3)
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    See Also::

    + +

    get +, +remprop +

    +

    Notes::

    + +

    The use of setf should be avoided, since a symbol’s +property list is a global resource that can contain information +established and depended upon by unrelated programs in the same Lisp image. +

    + + + + + diff --git a/info/gcl/symbol_002dvalue.html b/info/gcl/symbol_002dvalue.html new file mode 100644 index 0000000..f127b99 --- /dev/null +++ b/info/gcl/symbol_002dvalue.html @@ -0,0 +1,129 @@ + + + + + +symbol-value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.14 symbol-value [Accessor]

    + +

    symbol-value symbol ⇒ value +

    +

    (setf ( symbol-value symbol) new-value)
    +

    +

    Arguments and Values::

    + +

    symbol—a symbol that must have a value. +

    +

    value, new-value—an object. +

    +

    Description::

    + +

    Accesses the symbol’s value cell. +

    +

    Examples::

    + +
    +
     (setf (symbol-value 'a) 1) ⇒  1
+ (symbol-value 'a) ⇒  1
+ ;; SYMBOL-VALUE cannot see lexical variables.
+ (let ((a 2)) (symbol-value 'a)) ⇒  1
+ (let ((a 2)) (setq a 3) (symbol-value 'a)) ⇒  1
+ ;; SYMBOL-VALUE can see dynamic variables.
+ (let ((a 2)) 
+   (declare (special a)) 
+   (symbol-value 'a)) ⇒  2
+ (let ((a 2)) 
+   (declare (special a)) 
+   (setq a 3)
+   (symbol-value 'a)) ⇒  3
+ (let ((a 2))
+   (setf (symbol-value 'a) 3)
+   a) ⇒  2
+ a ⇒  3
+ (symbol-value 'a) ⇒  3
+ (let ((a 4))
+   (declare (special a))
+   (let ((b (symbol-value 'a)))
+     (setf (symbol-value 'a) 5)
+     (values a b))) ⇒  5, 4
+ a ⇒  3
+ (symbol-value :any-keyword) ⇒  :ANY-KEYWORD
+ (symbol-value 'nil) ⇒  NIL
+ (symbol-value '()) ⇒  NIL
+ ;; The precision of this next one is implementation-dependent.
+ (symbol-value 'pi) ⇒  3.141592653589793d0  
+
    + +

    Affected By::

    + +

    makunbound, +set, +setq +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if symbol is not a symbol. +

    +

    Should signal unbound-variable if symbol is unbound +and an attempt is made to read its value. (No such error is signaled +on an attempt to write its value.) +

    +

    See Also::

    + +

    boundp +, +makunbound +, +set +, +setq +

    +

    Notes::

    + +

    symbol-value can be used to get the value of a constant variable. +symbol-value cannot access the value of a lexical variable. +

    + + + + + diff --git a/info/gcl/symbolp.html b/info/gcl/symbolp.html new file mode 100644 index 0000000..fb69e5b --- /dev/null +++ b/info/gcl/symbolp.html @@ -0,0 +1,88 @@ + + + + + +symbolp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.3 symbolp [Function]

    + +

    symbolp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type symbol; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (symbolp 'elephant) ⇒  true
+ (symbolp 12) ⇒  false
+ (symbolp nil) ⇒  true
+ (symbolp '()) ⇒  true
+ (symbolp :test) ⇒  true
+ (symbolp "hello") ⇒  false
+
    + +

    See Also::

    + +

    keywordp +, +symbol, +typep +

    +

    Notes::

    + +
    +
     (symbolp object) ≡ (typep object 'symbol)
+
    + + + + + + diff --git a/info/gcl/synonym_002dstream.html b/info/gcl/synonym_002dstream.html new file mode 100644 index 0000000..64113bb --- /dev/null +++ b/info/gcl/synonym_002dstream.html @@ -0,0 +1,76 @@ + + + + + +synonym-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.7 synonym-stream [System Class]

    + +

    Class Precedence List::

    + +

    synonym-stream, +stream, +t +

    +

    Description::

    + +

    A stream that is an alias for another stream, +which is the value of a dynamic variable +whose name is the synonym stream symbol of the synonym stream. +

    +

    Any operations on a synonym stream will be performed +on the stream that is then the value of the +dynamic variable named by the synonym stream symbol. +If the value of the variable should change, +or if the variable should be bound, +then the stream will operate on the new value of the variable. +

    +

    See Also::

    + +

    make-synonym-stream +, +synonym-stream-symbol +

    + + + + + diff --git a/info/gcl/synonym_002dstream_002dsymbol.html b/info/gcl/synonym_002dstream_002dsymbol.html new file mode 100644 index 0000000..0a40602 --- /dev/null +++ b/info/gcl/synonym_002dstream_002dsymbol.html @@ -0,0 +1,67 @@ + + + + + +synonym-stream-symbol (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.39 synonym-stream-symbol [Function]

    + +

    synonym-stream-symbol synonym-stream ⇒ symbol +

    +

    Arguments and Values::

    + +

    synonym-stream—a synonym stream. +

    +

    symbol—a symbol. +

    +

    Description::

    + +

    Returns the symbol whose symbol-value the synonym-stream is using. +

    +

    See Also::

    + +

    make-synonym-stream +

    + + + + + diff --git a/info/gcl/t-_0028System-Class_0029.html b/info/gcl/t-_0028System-Class_0029.html new file mode 100644 index 0000000..4881c8b --- /dev/null +++ b/info/gcl/t-_0028System-Class_0029.html @@ -0,0 +1,59 @@ + + + + + +t (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.16 t [System Class]

    + +

    Class Precedence List::

    +

    t +

    +

    Description::

    +

    The set of all objects. +The type t is a supertype of every type, +including itself. Every object is of type t. +

    + + + + + diff --git a/info/gcl/t.html b/info/gcl/t.html new file mode 100644 index 0000000..8f06cd9 --- /dev/null +++ b/info/gcl/t.html @@ -0,0 +1,88 @@ + + + + + +t (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.32 t [Constant Variable]

    + +

    Constant Value::

    + +

    t. +

    +

    Description::

    + +

    The boolean representing true, +and the canonical generalized boolean representing true. +Although any object +other than nil is considered true, +t is generally used when there is no special reason +to prefer one such object over another. +

    +

    The symbol t is also sometimes used for other purposes as well. +For example, + as the name of a class, + as a designator (e.g., a stream designator) + or as a special symbol for some syntactic reason + (e.g., in case and typecase to label the otherwise-clause). +

    +

    Examples::

    + +
    +
     t ⇒  T 
+ (eq t 't) ⇒  true
+ (find-class 't) ⇒  #<CLASS T 610703333>
+ (case 'a (a 1) (t 2)) ⇒  1
+ (case 'b (a 1) (t 2)) ⇒  2
+ (prin1 'hello t)
+ |>  HELLO
+⇒  HELLO
+
    + +

    See Also::

    + +

    NIL +

    + + + + + diff --git a/info/gcl/tagbody.html b/info/gcl/tagbody.html new file mode 100644 index 0000000..366e85c --- /dev/null +++ b/info/gcl/tagbody.html @@ -0,0 +1,145 @@ + + + + + +tagbody (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.27 tagbody [Special Operator]

    + +

    tagbody {tag | statement}* ⇒ nil +

    +

    Arguments and Values::

    + +

    tag—a go tag; not evaluated. +

    +

    statement—a compound form; evaluated as described below. +

    +

    Description::

    + +

    Executes zero or more statements in a +lexical environment +that provides for control transfers to labels indicated by the tags. +

    +

    The statements in a tagbody are evaluated in order +from left to right, and their values are discarded. If at any time +there are no remaining statements, tagbody returns nil. +However, if (go tag) is evaluated, control jumps to the +part of the body labeled with the tag. (Tags are compared with eql.) +

    +

    A tag established by tagbody has lexical scope +and has dynamic extent. Once tagbody has been exited, +it is no longer valid to go to a tag in its body. +It is permissible for go to jump to a tagbody that is +not the innermost tagbody containing that go; +the tags established by a tagbody only shadow +other tags of like name. +

    +

    The determination of which elements of the body are tags +and which are statements is made prior to any macro expansion +of that element. If a statement is a macro form and +its macro expansion is an atom, that atom is treated +as a statement, not a tag. +

    +

    Examples::

    + +
    +
     (let (val)
+    (tagbody
+      (setq val 1)
+      (go point-a)
+      (incf val 16)
+     point-c
+      (incf val 04)
+      (go point-b)
+      (incf val 32)
+     point-a
+      (incf val 02)
+      (go point-c)
+      (incf val 64)
+     point-b
+      (incf val 08))
+    val)
+⇒  15
+ (defun f1 (flag)
+   (let ((n 1))
+     (tagbody 
+       (setq n (f2 flag #'(lambda () (go out))))
+      out
+       (prin1 n))))
+⇒  F1
+ (defun f2 (flag escape)
+   (if flag (funcall escape) 2))
+⇒  F2
+ (f1 nil)
+ |>  2
+⇒  NIL
+ (f1 t)
+ |>  1
+⇒  NIL
+
    + +

    See Also::

    + +

    go +

    +

    Notes::

    + +

    The macros in Figure 5–10 have implicit tagbodies. +

    +
    +
      do              do-external-symbols  dotimes  
+  do*             do-symbols           prog     
+  do-all-symbols  dolist               prog*    
+
+  Figure 5–10: Macros that have implicit tagbodies.
+
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/terpri.html b/info/gcl/terpri.html new file mode 100644 index 0000000..a929833 --- /dev/null +++ b/info/gcl/terpri.html @@ -0,0 +1,115 @@ + + + + + +terpri (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.19 terpri, fresh-line [Function]

    + +

    terpri &optional output-stream ⇒ nil +

    +

    fresh-line &optional output-stream ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    output-stream – an output stream designator. + The default is standard output. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    terpri outputs a newline to output-stream. +

    +

    fresh-line is similar to terpri but outputs a newline +only if the output-stream is not already at the start of a line. +If for some reason this cannot be determined, then a newline is output anyway. +fresh-line returns true if it outputs a newline; +otherwise it returns false. +

    +

    Examples::

    + +
    +
     (with-output-to-string (s)
+    (write-string "some text" s)
+    (terpri s)
+    (terpri s)
+    (write-string "more text" s))
+⇒  "some text
+
+more text"
+ (with-output-to-string (s)
+    (write-string "some text" s)
+    (fresh-line s)
+    (fresh-line s)
+    (write-string "more text" s))
+⇒  "some text
+more text"
+
    + +

    Side Effects::

    + +

    The output-stream is modified. +

    +

    Affected By::

    + +

    *standard-output*, +*terminal-io*. +

    +

    Exceptional Situations::

    + +

    None. +

    +

    [Reviewer Note by Barmar: What if stream is closed?] +

    +

    Notes::

    + +

    terpri is identical in effect to +

    +
    +
     (write-char #\Newline output-stream)
+
    + + + + + + diff --git a/info/gcl/the.html b/info/gcl/the.html new file mode 100644 index 0000000..414508f --- /dev/null +++ b/info/gcl/the.html @@ -0,0 +1,131 @@ + + + + + +the (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.28 the [Special Operator]

    + +

    the value-type form ⇒ {result}* +

    +

    Arguments and Values::

    + +

    value-type—a type specifier; not evaluated. +

    +

    form—a form; evaluated. +

    +

    results—the values resulting from the evaluation of form. + These values must conform to the type supplied by value-type; + see below. +

    +

    Description::

    + +

    the specifies that the values_{1a} returned by form +are of the types specified by value-type. +The consequences are undefined if any result +is not of the declared type. +

    +

    It is permissible for form to yield a different number of values +than are specified by value-type, provided that the values +for which types are declared are indeed of those types. +Missing values are treated as nil for the purposes of checking their types. +

    +

    Regardless of number of values declared by value-type, +the number of values returned by the the special form is the same as +the number of values returned by form. +

    +

    Examples::

    + +
    +
     (the symbol (car (list (gensym)))) ⇒  #:G9876
+ (the fixnum (+ 5 7)) ⇒  12
+ (the (values) (truncate 3.2 2)) ⇒  1, 1.2
+ (the integer (truncate 3.2 2)) ⇒  1, 1.2
+ (the (values integer) (truncate 3.2 2)) ⇒  1, 1.2
+ (the (values integer float) (truncate 3.2 2))   ⇒  1, 1.2
+ (the (values integer float symbol) (truncate 3.2 2)) ⇒  1, 1.2
+ (the (values integer float symbol t null list) 
+      (truncate 3.2 2)) ⇒  1, 1.2
+ (let ((i 100))
+    (declare (fixnum i))
+    (the fixnum (1+ i))) ⇒  101
+ (let* ((x (list 'a 'b 'c))
+        (y 5))
+    (setf (the fixnum (car x)) y)
+    x) ⇒  (5 B C)
+
    + +

    Exceptional Situations::

    + +

    The consequences are undefined if +the values yielded by the form +are not of the type specified by value-type. +

    +

    See Also::

    + +

    values +

    +

    Notes::

    + +

    The values type specifier can be used to indicate the types +of multiple values: +

    +
    +
     (the (values integer integer) (floor x y))
+ (the (values string t)
+      (gethash the-key the-string-table))
+
    + +

    setf can be used with the type declarations. +In this case the declaration is transferred to the form that +specifies the new value. The resulting setf form +is then analyzed. +

    +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/throw.html b/info/gcl/throw.html new file mode 100644 index 0000000..58d9b2b --- /dev/null +++ b/info/gcl/throw.html @@ -0,0 +1,154 @@ + + + + + +throw (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.28 throw [Special Operator]

    + +

    throw tag result-form + ⇒ #<NoValue> +

    Arguments and Values::

    + +

    tag—a catch tag; evaluated. +

    +

    result-form—a form; evaluated as described below. +

    +

    Description::

    + +

    throw causes a non-local control transfer +to a catch whose tag is eq to tag. +

    +

    Tag is evaluated first to produce an object +called the throw tag; then result-form is evaluated, +and its results are saved. If the result-form produces +multiple values, then all the values are saved. +The most recent outstanding catch +whose tag is eq to the throw tag +is exited; the saved results are returned as the value or +values of catch. +

    +

    The transfer of control initiated by throw is performed +as described in Transfer of Control to an Exit Point. +

    +

    Examples::

    + +
    +
     (catch 'result
+    (setq i 0 j 0)
+    (loop (incf j 3) (incf i)
+          (if (= i 3) (throw 'result (values i j))))) ⇒  3, 9
+
+
    + +
    +
     (catch nil 
+   (unwind-protect (throw nil 1)
+     (throw nil 2))) ⇒  2
+
    + +

    The consequences of the following are undefined +because the catch of b +is passed over by the first throw, +hence portable programs must assume that +its dynamic extent is terminated. +The binding of the catch tag is not yet disestablished +and therefore it is the target of the second throw. +

    +
    +
     (catch 'a
+   (catch 'b
+     (unwind-protect (throw 'a 1)
+       (throw 'b 2))))
+
    + +

    The following prints “The inner catch returns :SECOND-THROW” +and then returns :outer-catch. +

    +
    +
     (catch 'foo
+         (format t "The inner catch returns ~s.~
+                 (catch 'foo
+                     (unwind-protect (throw 'foo :first-throw)
+                         (throw 'foo :second-throw))))
+         :outer-catch)
+ |>  The inner catch returns :SECOND-THROW
+⇒  :OUTER-CATCH
+
    + +

    Exceptional Situations::

    + +

    If there is no outstanding catch tag that matches the throw tag, +no unwinding of the stack is performed, +and an error of type control-error is signaled. +When the error is signaled, +the dynamic environment is that which was +in force at the point of the throw. +

    +

    See Also::

    + +

    block +, +catch +, +return-from +, +unwind-protect +, +Evaluation +

    +

    Notes::

    + +

    catch and throw are normally used when the exit point +must have dynamic scope (e.g., the throw is not lexically enclosed +by the catch), while block and return are used +when lexical scope is sufficient. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/time.html b/info/gcl/time.html new file mode 100644 index 0000000..8cb5f3e --- /dev/null +++ b/info/gcl/time.html @@ -0,0 +1,107 @@ + + + + + +time (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.10 time [Macro]

    + +

    time form ⇒ {result}* +

    +

    Arguments and Values::

    + +

    form—a form; evaluated as described below. +

    +

    results—the values returned by the form. +

    +

    Description::

    + +

    time evaluates form in the current environment (lexical and dynamic). +A call to time can be compiled. +

    +

    time prints various timing data and other information to trace output. +The nature and format of the printed information is implementation-defined. +Implementations are encouraged to provide such information as + elapsed real time, + machine run time, + and storage management statistics. +

    +

    Affected By::

    + +

    The accuracy of the results depends, among other things, on the accuracy +of the corresponding functions provided by the underlying operating system. +

    +

    The magnitude of the results may depend on + the hardware, + the operating system, + the lisp implementation, + and the state of the global environment. +Some specific issues which frequently affect the outcome are + hardware speed, + nature of the scheduler (if any), + number of competing processes (if any), + system paging, + whether the call is interpreted or compiled, + whether functions called are compiled, + the kind of garbage collector involved and whether it runs, + whether internal data structures (e.g., hash tables) are implicitly reorganized, + etc. +

    +

    See Also::

    + +

    get-internal-real-time +, +get-internal-run-time +

    +

    Notes::

    + +

    In general, these timings are not guaranteed to be reliable enough for +marketing comparisons. Their value is primarily heuristic, for tuning +purposes. +

    +

    For useful background information on the complicated issues involved in +interpreting timing results, see Performance and Evaluation of Lisp Programs. +

    + + + + + diff --git a/info/gcl/trace.html b/info/gcl/trace.html new file mode 100644 index 0000000..0c20323 --- /dev/null +++ b/info/gcl/trace.html @@ -0,0 +1,148 @@ + + + + + +trace (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.8 trace, untrace [Macro]

    + +

    trace {function-name}* ⇒ trace-result +

    +

    untrace {function-name}* ⇒ untrace-result +

    +

    Arguments and Values::

    + +

    function-name—a function name. +

    +

    trace-result—implementation-dependent, + unless no function-names are supplied, + in which case trace-result is a list of function names. +

    +

    untrace-result—implementation-dependent. +

    +

    Description::

    + +

    trace and untrace control the invocation of the trace facility. +

    +

    Invoking trace with one or more function-names causes +the denoted functions to be “traced.” +Whenever a traced function is invoked, information + about the call, + about the arguments passed, + and about any eventually returned values +is printed to trace output. +If trace is used with no function-names, +no tracing action is performed; +instead, a list of the functions currently being traced is returned. +

    +

    Invoking untrace with one or more function names causes those +functions to be “untraced” (i.e., no longer traced). +If untrace is used with no function-names, +all functions currently being traced are untraced. +

    +

    If a function to be traced has been open-coded +(e.g., because it was declared inline), +a call to that function might not produce trace output. +

    +

    Examples::

    + +
    +
     (defun fact (n) (if (zerop n) 1 (* n (fact (- n 1)))))
+⇒  FACT
+ (trace fact)
+⇒  (FACT)
+;; Of course, the format of traced output is implementation-dependent.
+ (fact 3)
+ |>  1 Enter FACT 3
+ |>  | 2 Enter FACT 2
+ |>  |   3 Enter FACT 1
+ |>  |   | 4 Enter FACT 0
+ |>  |   | 4 Exit FACT 1
+ |>  |   3 Exit FACT 1
+ |>  | 2 Exit FACT 2
+ |>  1 Exit FACT 6
+⇒  6
+
    + +

    Side Effects::

    + +

    Might change the definitions of the functions named by function-names. +

    +

    Affected By::

    + +

    Whether the functions named are defined or already being traced. +

    +

    Exceptional Situations::

    + +

    Tracing an already traced function, +or untracing a function not currently being traced, +should produce no harmful effects, but might signal a warning. +

    +

    See Also::

    + +

    *trace-output*, +step +

    +

    Notes::

    + +

    trace and untrace may also accept additional +implementation-dependent argument formats. The format of the trace +output is implementation-dependent. +

    +

    Although trace can be extended to permit non-standard options, +implementations are nevertheless encouraged (but not required) +to warn about the use of syntax or options +that are neither specified by this standard +nor added as an extension by the implementation, +since they could be symptomatic of typographical errors +or of reliance on features supported in implementations +other than the current implementation. +

    +
    +
    +

    +Next: , Previous: , Up: Environment Dictionary  

    +
    + + + + + diff --git a/info/gcl/translate_002dlogical_002dpathname.html b/info/gcl/translate_002dlogical_002dpathname.html new file mode 100644 index 0000000..7fc156e --- /dev/null +++ b/info/gcl/translate_002dlogical_002dpathname.html @@ -0,0 +1,134 @@ + + + + + +translate-logical-pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.15 translate-logical-pathname [Function]

    + +

    translate-logical-pathname pathname &key ⇒ physical-pathname +

    +

    Arguments and Values::

    + +

    pathname—a pathname designator, + or a logical pathname namestring. +

    +

    physical-pathname—a physical pathname. +

    +

    Description::

    + +

    Translates pathname to a physical pathname, which it returns. +

    +

    If pathname is a stream, the +stream can be either open or closed. +translate-logical-pathname returns the same +physical pathname after a + file is closed as it did when the file was open. +

    +

    It is an error if pathname is a stream that is +created with make-two-way-stream, +make-echo-stream, +make-broadcast-stream, +make-concatenated-stream, make-string-input-stream, +make-string-output-stream. +

    +

    If pathname is a logical pathname namestring, +the host portion of the +logical pathname namestring and its following colon are required. +

    +

    Pathname is first coerced to a pathname. +If the coerced pathname is a physical pathname, it is returned. +If the coerced pathname is a logical pathname, +the first matching translation (according to pathname-match-p) +of the logical pathname host is applied, as if by calling +translate-pathname. If the result is + a logical pathname, this process is repeated. +When the result is + finally a physical pathname, it is returned. + If no translation matches, an error +is signaled. +

    +

    translate-logical-pathname might perform additional translations, + typically to provide translation of file types to local naming + conventions, to accomodate physical file systems with limited length + names, or to deal with special character requirements such as + translating hyphens to underscores or uppercase letters to lowercase. + Any such additional translations are implementation-defined. Some + implementations do no additional translations. +

    +

    There are no specified keyword arguments for +translate-logical-pathname, +but implementations are permitted to extend + it by adding keyword arguments. +

    +

    Examples::

    + +

    See logical-pathname-translations. +

    +

    Exceptional Situations::

    + +

    If pathname is incorrectly supplied, an error of type type-error is signaled. +

    +

    If no translation matches, an error of type file-error is signaled. +

    +

    [Editorial Note by KMP: Is file-error really right, or should it be pathname-error?] +

    +

    See Also::

    + +

    logical-pathname +, +logical-pathname-translations +, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/translate_002dpathname.html b/info/gcl/translate_002dpathname.html new file mode 100644 index 0000000..7ab9178 --- /dev/null +++ b/info/gcl/translate_002dpathname.html @@ -0,0 +1,221 @@ + + + + + +translate-pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.16 translate-pathname [Function]

    + +

    translate-pathname source from-wildcard to-wildcard &key
    + ⇒ translated-pathname +

    +

    Arguments and Values::

    + +

    source—a pathname designator. +

    +

    from-wildcard—a pathname designator. +

    +

    to-wildcard—a pathname designator. +

    +

    translated-pathname—a pathname. +

    +

    Description::

    + +

    translate-pathname translates source +(that matches from-wildcard) into a corresponding pathname +that matches to-wildcard, and returns the corresponding pathname. +

    +

    The resulting pathname is to-wildcard with each wildcard or missing +field replaced by a portion of source. A “wildcard field” is a +pathname component with a value of :wild, a :wild element of a +list-valued directory component, or an implementation-defined portion +of a component, such as the "*" in the complex wildcard string +"foo*bar" that some implementations support. An implementation that +adds other wildcard features, such as regular expressions, must define +how translate-pathname extends to those features. +A “missing field” is a pathname component with a value of nil. +

    +

    The portion of source +that is copied into the resulting pathname is +implementation-defined. Typically +it is determined by the user interface conventions + of the file systems involved. Usually it is the portion of source + that matches a wildcard field of +from-wildcard that is in the same + position as the wildcard or missing field of +to-wildcard. If there + is no wildcard field in +from-wildcard at that position, then usually + it is the entire corresponding +pathname component of source, or in + the case of a +list-valued directory component, the entire corresponding + list element. +

    +

    During the copying of a portion of source into +the resulting pathname, additional + implementation-defined translations of case or file naming + conventions might occur, especially when +from-wildcard and + to-wildcard are for different hosts. +

    +

    It is valid for + source to be a wild +pathname; in general this will produce a wild + result. It +is valid for from-wildcard and/or to-wildcard to be + non-wild pathnames. +

    +

    There are no specified keyword arguments for +translate-pathname, but + implementations are permitted to extend it by adding keyword arguments. +

    +

    translate-pathname maps customary case in +source into customary case in the output pathname. +

    +

    Examples::

    + +
    +
     ;; The results of the following five forms are all implementation-dependent.
+ ;; The second item in particular is shown with multiple results just to 
+ ;; emphasize one of many particular variations which commonly occurs.
+ (pathname-name (translate-pathname "foobar" "foo*" "*baz")) ⇒  "barbaz"
+ (pathname-name (translate-pathname "foobar" "foo*" "*"))
+⇒  "foobar"
+OR⇒ "bar"
+ (pathname-name (translate-pathname "foobar" "*"    "foo*")) ⇒  "foofoobar"
+ (pathname-name (translate-pathname "bar"    "*"    "foo*")) ⇒  "foobar"
+ (pathname-name (translate-pathname "foobar" "foo*" "baz*")) ⇒  "bazbar"
+
+ (defun translate-logical-pathname-1 (pathname rules)
+   (let ((rule (assoc pathname rules :test #'pathname-match-p)))
+     (unless rule (error "No translation rule for ~A" pathname))
+     (translate-pathname pathname (first rule) (second rule))))
+ (translate-logical-pathname-1 "FOO:CODE;BASIC.LISP"
+                       '(("FOO:DOCUMENTATION;" "MY-UNIX:/doc/foo/")
+                         ("FOO:CODE;"          "MY-UNIX:/lib/foo/")
+                         ("FOO:PATCHES;*;"     "MY-UNIX:/lib/foo/patch/*/")))
+⇒  #P"MY-UNIX:/lib/foo/basic.l"
+
+;;;This example assumes one particular set of wildcard conventions
+;;;Not all file systems will run this example exactly as written
+ (defun rename-files (from to)
+   (dolist (file (directory from))
+     (rename-file file (translate-pathname file from to))))
+ (rename-files "/usr/me/*.lisp" "/dev/her/*.l")
+   ;Renames /usr/me/init.lisp to /dev/her/init.l
+ (rename-files "/usr/me/pcl*/*" "/sys/pcl/*/")
+   ;Renames /usr/me/pcl-5-may/low.lisp to /sys/pcl/pcl-5-may/low.lisp
+   ;In some file systems the result might be /sys/pcl/5-may/low.lisp
+ (rename-files "/usr/me/pcl*/*" "/sys/library/*/")
+   ;Renames /usr/me/pcl-5-may/low.lisp to /sys/library/pcl-5-may/low.lisp
+   ;In some file systems the result might be /sys/library/5-may/low.lisp
+ (rename-files "/usr/me/foo.bar" "/usr/me2/")
+   ;Renames /usr/me/foo.bar to /usr/me2/foo.bar
+ (rename-files "/usr/joe/*-recipes.text" "/usr/jim/cookbook/joe's-*-rec.text")
+   ;Renames /usr/joe/lamb-recipes.text to /usr/jim/cookbook/joe's-lamb-rec.text
+   ;Renames /usr/joe/pork-recipes.text to /usr/jim/cookbook/joe's-pork-rec.text
+   ;Renames /usr/joe/veg-recipes.text to /usr/jim/cookbook/joe's-veg-rec.text
+
    + +

    Exceptional Situations::

    + +

    If any of source, from-wildcard, or to-wildcard +is not a pathname, a string, or a stream associated with a file +an error of type type-error is signaled. +

    +

    (pathname-match-p source from-wildcard) must +be true or an error of type error is signaled. +

    +

    See Also::

    + +

    namestring +, +pathname-host +, +

    +

    pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    The exact behavior of translate-pathname cannot be dictated +by the Common Lisp language and must be allowed to vary, depending on the +user interface conventions of the file systems involved. +

    +

    The following is an implementation guideline. +One file system performs this operation by + examining each piece of the three +pathnames in turn, where a piece is a + pathname component or a +list element of a structured component such as + a hierarchical directory. Hierarchical directory elements in + from-wildcard and +to-wildcard are matched by whether they are + wildcards, not by depth in the directory hierarchy. If the piece in +to-wildcard is present and not wild, it is copied into the result. + If the piece in to-wildcard is +:wild or nil, the piece in source is + copied into the result. Otherwise, the piece in +to-wildcard might be + a complex wildcard such as "foo*bar" and the piece in +from-wildcard + should be wild; the portion of the piece in +source that matches the + wildcard portion of the piece in +from-wildcard replaces the wildcard + portion of the piece in +to-wildcard and the value produced is used in + the result. +

    +
    +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    + + + + + diff --git a/info/gcl/tree_002dequal.html b/info/gcl/tree_002dequal.html new file mode 100644 index 0000000..36f6768 --- /dev/null +++ b/info/gcl/tree_002dequal.html @@ -0,0 +1,118 @@ + + + + + +tree-equal (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.13 tree-equal [Function]

    + +

    tree-equal tree-1 tree-2 &key test test-not ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    tree-1—a tree. +

    +

    tree-2—a tree. +

    +

    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. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    tree-equal tests whether two trees are of the same shape +and have the same leaves. +tree-equal returns true if tree-1 and tree-2 are +both atoms and satisfy the test, +or if they are both conses and +the car of tree-1 is tree-equal to +the car of tree-2 and +the cdr of tree-1 is tree-equal to +the cdr of tree-2. +Otherwise, tree-equal returns false. +

    +

    tree-equal recursively compares conses but not any +other objects that have components. +

    +

    The first argument to the :test or :test-not +function is tree-1 or a car or cdr of tree-1; +the second argument is tree-2 or a car +or cdr of tree-2. +

    +

    Examples::

    + +
    +
     (setq tree1 '(1 (1 2))
+       tree2 '(1 (1 2))) ⇒  (1 (1 2))
+ (tree-equal tree1 tree2) ⇒  true
+ (eql tree1 tree2) ⇒  false
+ (setq tree1 '('a ('b 'c))
+       tree2 '('a ('b 'c))) ⇒  ('a ('b 'c)) 
+⇒  ((QUOTE A) ((QUOTE B) (QUOTE C)))
+ (tree-equal tree1 tree2 :test 'eq) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    The consequences are undefined +if both tree-1 and tree-2 are circular. +

    +

    See Also::

    + +

    equal +, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    + + + + + diff --git a/info/gcl/truename.html b/info/gcl/truename.html new file mode 100644 index 0000000..2614301 --- /dev/null +++ b/info/gcl/truename.html @@ -0,0 +1,132 @@ + + + + + +truename (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    +
    +

    20.2.4 truename [Function]

    + +

    truename filespec ⇒ truename +

    +

    Arguments and Values::

    + +

    filespec—a pathname designator. +

    +

    truename—a physical pathname. +

    +

    Description::

    + +

    truename tries to find the file indicated by +filespec and returns its truename. +If the filespec designator is an open stream, +its associated file is used. +

    +

    If filespec is a stream, +truename can be used whether the stream +is open or closed. It is permissible for truename +to return more specific information after the stream +is closed than when the stream was open. +

    +

    If filespec is a pathname +it represents the name used to open the file. This may be, but is +not required to be, the actual name of the file. +

    +

    Examples::

    + +
    +
    ;; An example involving version numbers.  Note that the precise nature of
+;; the truename is implementation-dependent while the file is still open.
+ (with-open-file (stream ">vistor>test.text.newest")
+   (values (pathname stream)
+           (truename stream)))
+⇒  #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.1"
+OR⇒ #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.newest"
+OR⇒ #P"S:>vistor>test.text.newest", #P"S:>vistor>_temp_._temp_.1"
+
+;; In this case, the file is closed when the truename is tried, so the
+;; truename information is reliable.
+ (with-open-file (stream ">vistor>test.text.newest")
+   (close stream)
+   (values (pathname stream)
+           (truename stream)))
+⇒  #P"S:>vistor>test.text.newest", #P"S:>vistor>test.text.1"
+
+;; An example involving TOP-20's implementation-dependent concept 
+;; of logical devices -- in this case, "DOC:" is shorthand for
+;; "PS:<DOCUMENTATION>" ...
+ (with-open-file (stream "CMUC::DOC:DUMPER.HLP")
+   (values (pathname stream)
+           (truename stream)))
+⇒  #P"CMUC::DOC:DUMPER.HLP", #P"CMUC::PS:<DOCUMENTATION>DUMPER.HLP.13"
+
    + +

    Exceptional Situations::

    + +

    An error of type file-error is signaled if an appropriate file +cannot be located within the file system for the given filespec, +

    +

    or if the file system cannot perform the requested operation. +

    +

    An error of type file-error is signaled if pathname is wild. +

    +

    See Also::

    + +

    pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    truename may be used to account for any filename translations +performed by the file system. +

    +
    +
    +

    +Next: , Previous: , Up: Files Dictionary  

    +
    + + + + + diff --git a/info/gcl/two_002dway_002dstream.html b/info/gcl/two_002dway_002dstream.html new file mode 100644 index 0000000..c437d39 --- /dev/null +++ b/info/gcl/two_002dway_002dstream.html @@ -0,0 +1,71 @@ + + + + + +two-way-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.8 two-way-stream [System Class]

    + +

    Class Precedence List::

    + +

    two-way-stream, +stream, +t +

    +

    Description::

    + +

    A bidirectional composite stream that + receives its input from an associated input stream + and sends its output to an associated output stream. +

    +

    See Also::

    + +

    make-two-way-stream +, +two-way-stream-input-stream +, +two-way-stream-output-stream +

    + + + + + diff --git a/info/gcl/two_002dway_002dstream_002dinput_002dstream.html b/info/gcl/two_002dway_002dstream_002dinput_002dstream.html new file mode 100644 index 0000000..c681149 --- /dev/null +++ b/info/gcl/two_002dway_002dstream_002dinput_002dstream.html @@ -0,0 +1,72 @@ + + + + + +two-way-stream-input-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.43 two-way-stream-input-stream, two-way-stream-output-stream

    +

    [Function] +

    +

    two-way-stream-input-stream two-way-stream ⇒ input-stream +

    +

    two-way-stream-output-stream two-way-stream ⇒ output-stream +

    +

    Arguments and Values::

    + +

    two-way-stream—a two-way stream. +

    +

    input-stream—an input stream. +

    +

    output-stream—an output stream. +

    +

    Description::

    + +

    two-way-stream-input-stream returns the stream +from which two-way-stream receives input. +

    +

    two-way-stream-output-stream returns the stream +to which two-way-stream sends output. +

    + + + + + diff --git a/info/gcl/type.html b/info/gcl/type.html new file mode 100644 index 0000000..417be7a --- /dev/null +++ b/info/gcl/type.html @@ -0,0 +1,283 @@ + + + + + +type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    +
    +

    3.8.21 type [Declaration]

    + +

    Syntax::

    + +

    (type typespec {var}*) +

    +

    (typespec {var}*) +

    +

    Arguments::

    + +

    typespec—a type specifier. +

    +

    var—a variable name. +

    +

    Valid Context::

    + +

    declaration or proclamation +

    +

    Binding Types Affected::

    + +

    variable +

    +

    Description::

    + +

    Affects +only variable bindings and specifies that the +vars take on +values only of the specified typespec. +In particular, values assigned to the variables by setq, +as well as the initial values of the vars must be of +the specified typespec. +type declarations never apply to function bindings (see ftype). +

    +

    A type declaration of a symbol +defined by symbol-macrolet is equivalent +to wrapping a the +expression around the expansion of that symbol, +

    +

    although the symbol’s macro expansion is not actually affected. +

    +

    The meaning of a type declaration + is equivalent to changing each reference to +a variable (var) within the scope of the + declaration to (the typespec var), +changing each expression assigned to the + variable (new-value) within the scope of the declaration to +(the typespec new-value), + and executing +(the typespec var) at the moment the scope of the declaration + is entered. +

    +

    A type declaration is valid in all declarations. The interpretation + of a type declaration is as follows: +

    +
    1.
    +

    During the execution of any reference to the + declared variable within the scope of the declaration, the consequences +are +undefined +if + the value of the declared variable is not of the declared type. +

    +
    +
    2.
    +

    During the execution of any +setq of the declared variable within the scope + of the declaration, the consequences are +undefined +if the newly assigned value of the + declared variable is not of the declared type. +

    +
    +
    3.
    +

    At the moment the + scope of the declaration is entered, the consequences are +undefined +if the value of the + declared variable is not of the declared type. +

    +
    + +

    A type declaration affects only variable references within +its scope. +

    +

    If nested type declarations refer to the same variable, + then the value of the variable must be a member of the intersection of + the declared types. +

    +

    If there is a local type declaration for a dynamic + variable, and there is also a global type proclamation for that same + variable, then the value of the variable within the scope of the local + declaration must be a member of the intersection of the two declared + types. +

    +

    type declarations can be free declarations +or bound declarations. +

    +

    A symbol cannot be both the name of a type and the name of a +declaration. Defining a symbol as the name of a class, +structure, condition, or type, when the symbol +has been declared as a declaration name, or vice versa, signals an error. +

    +

    Within the lexical scope of an array type declaration, +all references to array elements are assumed to satisfy the +expressed array element type (as opposed to the upgraded array element type). +A compiler can treat +the code within the scope of the array type declaration as if each +access of an array element were surrounded by an appropriate +the form. +

    +

    Examples::

    + +
    +
     (defun f (x y)
+   (declare (type fixnum x y))
+   (let ((z (+ x y)))
+     (declare (type fixnum z))
+     z)) ⇒  F
+ (f 1 2) ⇒  3
+ ;; The previous definition of F is equivalent to
+ (defun f (x y)
+   ;; This declaration is a shorthand form of the TYPE declaration
+   (declare (fixnum x y))
+   ;; To declare the type of a return value, it's not necessary to
+   ;; create a named variable.  A THE special form can be used instead.
+   (the fixnum (+ x y))) ⇒  F
+ (f 1 2) ⇒  3
+
    + +
    +
     (defvar *one-array* (make-array 10 :element-type '(signed-byte 5)))
+ (defvar *another-array* (make-array 10 :element-type '(signed-byte 8)))
+
+ (defun frob (an-array)
+   (declare (type (array (signed-byte 5) 1) an-array))
+   (setf (aref an-array 1) 31)
+   (setf (aref an-array 2) 127)
+   (setf (aref an-array 3) (* 2 (aref an-array 3)))
+   (let ((foo 0))
+     (declare (type (signed-byte 5) foo))
+     (setf foo (aref an-array 0))))
+
+ (frob *one-array*)
+ (frob *another-array*)
+
    + +

    The above definition of frob is equivalent to: +

    +
    +
     (defun frob (an-array)
+   (setf (the (signed-byte 5) (aref an-array 1)) 31)
+   (setf (the (signed-byte 5) (aref an-array 2)) 127)
+   (setf (the (signed-byte 5) (aref an-array 3))
+         (* 2 (the (signed-byte 5) (aref an-array 3))))
+   (let ((foo 0))
+     (declare (type (signed-byte 5) foo))
+     (setf foo (the (signed-byte 5) (aref an-array 0)))))
+
    + +

    Given an implementation in which +fixnums are 29 bits but fixnum arrays +are upgraded to signed 32-bit arrays, +the following +could be compiled with all fixnum arithmetic: +

    +
    +
     (defun bump-counters (counters)
+   (declare (type (array fixnum *) bump-counters))
+   (dotimes (i (length counters))
+     (incf (aref counters i))))
+
    + +

    See Also::

    + +

    declare, +declaim +, +proclaim +

    +

    Notes::

    + +

    (typespec {var}*) +is an abbreviation for (type typespec {var}*). +

    +

    A type declaration for the arguments to a function does not +necessarily imply anything about the type of the result. The following +function is not permitted to be compiled using implementation-dependent +fixnum-only arithmetic: +

    +
    +
     (defun f (x y) (declare (fixnum x y)) (+ x y))
+
    + +

    To see why, consider (f most-positive-fixnum 1). +Common Lisp defines that F must return a bignum here, rather +than signal an error or produce a mathematically incorrect result. +If you have special knowledge such “fixnum overflow” cases will +not come up, you can declare the result value to be in the fixnum +range, enabling some compilers to use more efficient arithmetic: +

    +
    +
     (defun f (x y)
+   (declare (fixnum x y))
+   (the fixnum (+ x y)))
+
    + +

    Note, however, that in the three-argument case, because of the possibility +of an implicit intermediate value growing too large, the following will not +cause implementation-dependent fixnum-only arithmetic to be used: +

    +
    +
     (defun f (x y)
+   (declare (fixnum x y z))
+   (the fixnum (+ x y z)))
+
    + +

    To see why, consider (f most-positive-fixnum 1 -1). +Although the arguments and the result are all fixnums, an intermediate +value is not a fixnum. If it is important that +implementation-dependent fixnum-only arithmetic be selected +in implementations that provide it, +consider writing something like this instead: +

    +
    +
     (defun f (x y)
+   (declare (fixnum x y z))
+   (the fixnum (+ (the fixnum (+ x y)) z)))
+
    + +
    +
    +

    +Next: , Previous: , Up: Evaluation and Compilation Dictionary  

    +
    + + + + + diff --git a/info/gcl/type_002derror.html b/info/gcl/type_002derror.html new file mode 100644 index 0000000..22ea3f9 --- /dev/null +++ b/info/gcl/type_002derror.html @@ -0,0 +1,71 @@ + + + + + +type-error (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.29 type-error [Condition Type]

    + +

    Class Precedence List::

    +

    type-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type type-error represents a situation in which an object is not +of the expected type. The “offending datum” and “expected type” are initialized +by the initialization arguments named :datum and :expected-type to make-condition, +and are accessed by the functions +type-error-datum and type-error-expected-type. +

    +

    See Also::

    + +

    type-error-datum +, type-error-expected-type +

    + + + + + diff --git a/info/gcl/type_002derror_002ddatum.html b/info/gcl/type_002derror_002ddatum.html new file mode 100644 index 0000000..9b5fd63 --- /dev/null +++ b/info/gcl/type_002derror_002ddatum.html @@ -0,0 +1,96 @@ + + + + + +type-error-datum (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.30 type-error-datum, type-error-expected-type [Function]

    + +

    type-error-datum condition ⇒ datum +

    +

    type-error-expected-type condition ⇒ expected-type +

    +

    Arguments and Values::

    + +

    condition—a condition of type type-error. +

    +

    datum—an object. +

    +

    expected-type—a type specifier. +

    +

    Description::

    + +

    type-error-datum returns the offending datum in the situation +represented by the condition. +

    +

    type-error-expected-type returns the expected type of the +offending datum in the situation represented by the condition. +

    +

    Examples::

    + +
    +
     (defun fix-digits (condition)
+   (check-type condition type-error)
+   (let* ((digits '(zero one two three four
+                   five six seven eight nine))
+         (val (position (type-error-datum condition) digits)))
+     (if (and val (subtypep 'fixnum (type-error-expected-type condition)))
+         (store-value 7))))
+
+ (defun foo (x)
+   (handler-bind ((type-error #'fix-digits))
+     (check-type x number)
+     (+ x 3)))
+
+ (foo 'seven)
+⇒  10
+
    + +

    See Also::

    + +

    type-error, +Conditions +

    + + + + + diff --git a/info/gcl/type_002dof.html b/info/gcl/type_002dof.html new file mode 100644 index 0000000..5902673 --- /dev/null +++ b/info/gcl/type_002dof.html @@ -0,0 +1,187 @@ + + + + + +type-of (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.27 type-of [Function]

    + +

    type-of object ⇒ typespec +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    typespec—a type specifier. +

    +

    Description::

    + +

    Returns a type specifier, typespec, for a type +that has the object as an element. +The typespec satisfies the following: +

    +
    +
    1.
    +

    For any object that is an element of some built-in type: +

    +
    +
    a.
    +

    the type returned is a recognizable subtype of that built-in type. +

    +
    +
    b.
    +

    the type returned does not involve + and, + eql, + member, + not, + or, + satisfies, + or values. +

    +
    + +
    +
    2.
    +

    For all objects, (typep object (type-of object)) +returns true. +Implicit in this is that type specifiers which are +not valid for use with typep, such as the list form of the +function type specifier, are never returned by type-of. +

    +
    +
    3.
    +

    The type returned by type-of is always a recognizable subtype +of the class returned by class-of. That is, +

    +
    +
     (subtypep (type-of object) (class-of object)) ⇒  true, true
+
    + +
    +
    4.
    +

    For objects of metaclass structure-class or standard-class, +

    +

    and for conditions, +

    +

    type-of returns the proper name of the class returned +by class-of if it has a proper name, +and otherwise returns the class itself. +In particular, for objects created by the constructor function +of a structure defined with defstruct without a :type option, +type-of returns the structure name; and for objects created +by make-condition, the typespec is the name of the +condition type. +

    +
    +
    5.
    +

    For each of the types + short-float, + single-float, + double-float, + or long-float +of which the object is an element, +the typespec is a recognizable subtype of that type. +

    +
    +
    + +

    Examples::

    + + +
    +
     (type-of 'a) ⇒  SYMBOL          
+ (type-of '(1 . 2))
+⇒  CONS
+OR⇒ (CONS FIXNUM FIXNUM)
+ (type-of #c(0 1))
+⇒  COMPLEX
+OR⇒ (COMPLEX INTEGER)
+ (defstruct temp-struct x y z) ⇒  TEMP-STRUCT
+ (type-of (make-temp-struct)) ⇒  TEMP-STRUCT
+ (type-of "abc")
+⇒  STRING
+OR⇒ (STRING 3)
+ (subtypep (type-of "abc") 'string) ⇒  true, true
+ (type-of (expt 2 40))
+⇒  BIGNUM
+OR⇒ INTEGER
+OR⇒ (INTEGER 1099511627776 1099511627776)
+OR⇒ SYSTEM::TWO-WORD-BIGNUM
+OR⇒ FIXNUM
+ (subtypep (type-of 112312) 'integer) ⇒  true, true
+ (defvar *foo* (make-array 5 :element-type t)) ⇒  *FOO*
+ (class-name (class-of *foo*)) ⇒  VECTOR
+ (type-of *foo*)
+⇒  VECTOR
+OR⇒ (VECTOR T 5)
+
    + +

    See Also::

    + +

    array-element-type +, +class-of +, +defstruct +, +typecase +, +typep +, +Types +

    +

    Notes::

    + +

    Implementors are encouraged to arrange for type-of to return +

    +

    a portable value. +

    +
    +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    + + + + + diff --git a/info/gcl/typecase.html b/info/gcl/typecase.html new file mode 100644 index 0000000..fc68340 --- /dev/null +++ b/info/gcl/typecase.html @@ -0,0 +1,235 @@ + + + + + +typecase (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.47 typecase, ctypecase, etypecase [Macro]

    + +

    typecase keyform {!normal-clause}* [!otherwise-clause] ⇒ {result}* +

    +

    ctypecase keyplace {!normal-clause}* ⇒ {result}* +

    +

    etypecase keyform {!normal-clause}* ⇒ {result}* +

    +

    normal-clause ::=(type {form}*) +

    +

    otherwise-clause ::=({otherwise | t} {form}*) +

    +

    clause ::=normal-clause | otherwise-clause +

    + + + + +

    Arguments and Values::

    + +

    keyform—a form; evaluated to produce a test-key. +

    +

    keyplace—a form; evaluated initially to produce a test-key. + Possibly also used later as a place if no types match. +

    +

    test-key—an object produced by evaluating keyform or keyplace. +

    +

    type—a type specifier. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms + in the matching clause. +

    +

    Description::

    + +

    These macros allow the conditional execution of a body of forms +in a clause that is selected by matching the test-key on the basis +of its type. +

    +

    The keyform or keyplace is evaluated to produce the +test-key. +

    +

    Each of the normal-clauses is then considered in turn. +If the test-key is of the type +given by the clauses’s type, +the forms in that clause are +evaluated as an implicit progn, and the values +it returns are returned as the value of the typecase, +ctypecase, or etypecase form. +

    +

    These macros differ only in their behavior when +no normal-clause matches; specifically: +

    +
    +
    typecase
    +

    If no normal-clause matches, and there is an otherwise-clause, +then that otherwise-clause automatically matches; the forms in +that clause are evaluated as an implicit progn, +and the values it returns are returned as the value of the typecase. +

    +

    If there is no otherwise-clause, typecase returns nil. +

    +
    +
    ctypecase
    +

    If no normal-clause matches, +a correctable error of type type-error is signaled. +The offending datum is the test-key and +the expected type is type equivalent to (or type1 type2 ...). +The store-value restart can be used to correct the error. +

    +

    If the store-value restart is invoked, its argument becomes the +new test-key, and is stored in keyplace as if by +(setf keyplace test-key). +Then ctypecase starts over, considering each clause anew. +

    +

    If the store-value restart is invoked interactively, +the user is prompted for a new test-key to use. +

    +

    The subforms of keyplace might be evaluated again if +none of the cases holds. +

    +
    +
    etypecase
    +

    If no normal-clause matches, +a non-correctable error of type type-error is signaled. +The offending datum is the test-key and +the expected type is type equivalent to (or type1 type2 ...). +

    +

    Note that in contrast with ctypecase, +the caller of etypecase may rely on the fact that etypecase +does not return if a normal-clause does not match. +

    +
    +
    + +

    In all three cases, is permissible for more than one clause to specify a +matching type, particularly if one is a subtype of another; +the earliest applicable clause is chosen. +

    +

    Examples::

    + +
    +
    ;;; (Note that the parts of this example which use TYPE-OF 
+;;;  are implementation-dependent.)
+ (defun what-is-it (x)
+   (format t "~&~S is ~A.~
+           x (typecase x
+               (float "a float")
+               (null "a symbol, boolean false, or the empty list")
+               (list "a list")
+               (t (format nil "a(n) ~(~A~)" (type-of x))))))
+⇒  WHAT-IS-IT
+ (map 'nil #'what-is-it '(nil (a b) 7.0 7 box))
+ |>  NIL is a symbol, boolean false, or the empty list.
+ |>  (A B) is a list.
+ |>  7.0 is a float.
+ |>  7 is a(n) integer.
+ |>  BOX is a(n) symbol.
+⇒  NIL
+ (setq x 1/3)
+⇒  1/3
+ (ctypecase x
+     (integer (* x 4))
+     (symbol  (symbol-value x)))
+ |>  Error: The value of X, 1/3, is neither an integer nor a symbol.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a value to use instead.
+ |>   2: Return to Lisp Toplevel.
+ |>  Debug> |>>:CONTINUE 1<<|
+ |>  Use value: |>>3.7<<|
+ |>  Error: The value of X, 3.7, is neither an integer nor a symbol.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a value to use instead.
+ |>   2: Return to Lisp Toplevel.
+ |>  Debug> |>>:CONTINUE 1<<|
+ |>  Use value: |>>12<<|
+⇒  48
+ x ⇒  12
+
    + +

    Affected By::

    + +

    ctypecase and etypecase, since they might signal an error, +are potentially affected by existing handlers and *debug-io*. +

    +

    Exceptional Situations::

    + +

    ctypecase and etypecase signal an error of type type-error +if no normal-clause matches. +

    +

    The compiler may choose to issue a warning of type style-warning +if a clause will never be selected because it is completely +shadowed by earlier clauses. +

    +

    See Also::

    + +

    case +, +cond +, +setf +, +Generalized Reference +

    +

    Notes::

    + +
    +
    (typecase test-key
+  {(type {form}*)}*)
+≡
+(let ((#1=#:g0001 test-key))
+  (cond {((typep #1# 'type) {form}*)}*))
+
    + +

    The specific error message used by etypecase and ctypecase can vary +between implementations. In situations where control of the specific wording +of the error message is important, it is better to use typecase with an +otherwise-clause that explicitly signals an error with an appropriate +message. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/typep.html b/info/gcl/typep.html new file mode 100644 index 0000000..39eaaad --- /dev/null +++ b/info/gcl/typep.html @@ -0,0 +1,178 @@ + + + + + +typep (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.28 typep [Function]

    + +

    typep object type-specifier &optional environment ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    type-specifier—any type specifier except +

    +

    values, or a type specifier list +whose first element is either function or values. +

    +

    environment—an environment object. + The default is nil, denoting the null lexical environment + and the and current global environment. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of the type specified by type-specifier; +otherwise, returns false. +

    +

    A type-specifier of the form (satisfies fn) +is handled by applying the function fn to object. +

    +

    (typep object '(array type-specifier)), +where type-specifier is not *, +returns true if and only if object is an array +that could be the result +of supplying type-specifier +as the :element-type argument to make-array. +(array *) refers to all arrays +regardless of element type, while (array type-specifier) +refers only to those arrays +that can result from giving type-specifier as the +:element-type argument to make-array. +A similar interpretation applies to (simple-array type-specifier) +and (vector type-specifier). +See Array Upgrading. +

    +

    (typep object '(complex type-specifier)) +returns true for all complex numbers that can result from +giving numbers of type type-specifier +to the function complex, plus all other complex numbers +of the same specialized representation. +Both the real and the imaginary parts of any such +complex number must satisfy: +

    +
    +
     (typep realpart 'type-specifier)
+ (typep imagpart 'type-specifier)
+
    + +

    See the function upgraded-complex-part-type. +

    +

    Examples::

    + +
    +
     (typep 12 'integer) ⇒  true
+ (typep (1+ most-positive-fixnum) 'fixnum) ⇒  false
+ (typep nil t) ⇒  true
+ (typep nil nil) ⇒  false
+ (typep 1 '(mod 2)) ⇒  true
+ (typep #c(1 1) '(complex (eql 1))) ⇒  true
+;; To understand this next example, you might need to refer to
+;; Rule of Canonical Representation for Complex Rationals.
+ (typep #c(0 0) '(complex (eql 0))) ⇒  false
+
    + +

    Let A_x and A_y be two type specifiers that +denote different types, but for which +

    +
    +
     (upgraded-array-element-type 'A_x)
+
    + +

    and +

    +
    +
     (upgraded-array-element-type 'A_y)
+
    + +

    denote the same type. Notice that +

    +
    +
     (typep (make-array 0 :element-type 'A_x) '(array A_x)) ⇒  true
+ (typep (make-array 0 :element-type 'A_y) '(array A_y)) ⇒  true
+ (typep (make-array 0 :element-type 'A_x) '(array A_y)) ⇒  true
+ (typep (make-array 0 :element-type 'A_y) '(array A_x)) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    An error of type error is signaled if type-specifier is values, +or a type specifier list whose first element is either +function or values. +

    +

    The consequences are undefined if +the type-specifier is not a type specifier. +

    +

    See Also::

    + +

    type-of +, +upgraded-array-element-type +, +upgraded-complex-part-type +, +Type Specifiers +

    +

    Notes::

    + +

    Implementations are encouraged to recognize and optimize the case of +(typep x (the class y)), +since it does not involve any need for expansion +of deftype information at runtime. +

    +
    +
    +
+
    + +
    +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    + + + + + diff --git a/info/gcl/unbound_002dslot.html b/info/gcl/unbound_002dslot.html new file mode 100644 index 0000000..01a605e --- /dev/null +++ b/info/gcl/unbound_002dslot.html @@ -0,0 +1,74 @@ + + + + + +unbound-slot (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.40 unbound-slot [Condition Type]

    + +

    Class Precedence List::

    +

    unbound-slot, +cell-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The object having the unbound slot is initialized by +the :instance initialization argument to make-condition, +and is accessed by the function unbound-slot-instance. +

    +

    The name of the cell (see cell-error) is the name of the slot. +

    +

    See Also::

    + +

    cell-error-name +, +unbound-slot-object, +Condition System Concepts +

    + + + + + diff --git a/info/gcl/unbound_002dslot_002dinstance.html b/info/gcl/unbound_002dslot_002dinstance.html new file mode 100644 index 0000000..30c6f3d --- /dev/null +++ b/info/gcl/unbound_002dslot_002dinstance.html @@ -0,0 +1,76 @@ + + + + + +unbound-slot-instance (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.41 unbound-slot-instance [Function]

    + +

    unbound-slot-instance condition ⇒ instance +

    +

    Arguments and Values::

    + +

    condition—a condition of type unbound-slot. +

    +

    instance—an object. +

    +

    Description::

    + +

    Returns the instance which had the unbound slot in the situation +represented by the condition. +

    +

    See Also::

    + +

    cell-error-name +, +unbound-slot, +Condition System Concepts +

    + + + + + + + + + + diff --git a/info/gcl/unbound_002dvariable.html b/info/gcl/unbound_002dvariable.html new file mode 100644 index 0000000..e24c900 --- /dev/null +++ b/info/gcl/unbound_002dvariable.html @@ -0,0 +1,76 @@ + + + + + +unbound-variable (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Symbols Dictionary  

    +
    +
    +

    10.2.20 unbound-variable [Condition Type]

    + +

    Class Precedence List::

    +

    unbound-variable, +cell-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type unbound-variable consists of error conditions +that represent attempts to read the value of an unbound variable. +

    +

    The name of the cell (see cell-error) is the name of the +variable that was unbound. +

    +

    See Also::

    + +

    cell-error-name +

    + + + + + + + + + + diff --git a/info/gcl/undefined_002dfunction.html b/info/gcl/undefined_002dfunction.html new file mode 100644 index 0000000..62f7679 --- /dev/null +++ b/info/gcl/undefined_002dfunction.html @@ -0,0 +1,76 @@ + + + + + +undefined-function (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.69 undefined-function [Condition Type]

    + +

    Class Precedence List::

    +

    undefined-function, +cell-error, +error, +serious-condition, +condition, +t +

    +

    Description::

    + +

    The type undefined-function consists of error conditions +that represent attempts to read the definition of an undefined function. +

    +

    The name of the cell (see cell-error) is the function name +which was funbound. +

    +

    See Also::

    + +

    cell-error-name +

    + + + + + + + + + + diff --git a/info/gcl/unexport.html b/info/gcl/unexport.html new file mode 100644 index 0000000..0536c35 --- /dev/null +++ b/info/gcl/unexport.html @@ -0,0 +1,107 @@ + + + + + +unexport (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.14 unexport [Function]

    + +

    unexport symbols &optional package ⇒ t +

    +

    Arguments and Values::

    + +

    symbols—a designator for a list of symbols. +

    +

    package—a package designator. +

    +

    The default is the current package. +

    +

    Description::

    + +

    unexport reverts external symbols in package to +internal status; it undoes the effect of export. +

    +

    unexport works only on symbols +present +in package, switching them back to internal status. +If unexport is given a symbol that is +already accessible as an internal symbol in package, +it does nothing. +

    +

    Examples::

    + +
    +
     (in-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (export (intern "CONTRABAND" (make-package 'temp)) 'temp) ⇒  T
+ (find-symbol "CONTRABAND") ⇒  NIL, NIL 
+ (use-package 'temp) ⇒  T 
+ (find-symbol "CONTRABAND") ⇒  CONTRABAND, :INHERITED
+ (unexport 'contraband 'temp) ⇒  T
+ (find-symbol "CONTRABAND") ⇒  NIL, NIL
+
    + +

    Side Effects::

    + +

    Package system is modified. +

    +

    Affected By::

    + +

    Current state of the package system. +

    +

    Exceptional Situations::

    + +

    If unexport is given a symbol +not accessible in package at all, +an error of type package-error is signaled. +

    +

    The consequences are undefined if package is the KEYWORD package +or the COMMON-LISP package. +

    +

    See Also::

    + +

    export +, Package Concepts +

    + + + + + diff --git a/info/gcl/unintern.html b/info/gcl/unintern.html new file mode 100644 index 0000000..4670664 --- /dev/null +++ b/info/gcl/unintern.html @@ -0,0 +1,121 @@ + + + + + +unintern (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.15 unintern [Function]

    + +

    unintern symbol &optional package ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    symbol—a symbol. +

    +

    package—a package designator. +

    +

    The default is the current package. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    +

    unintern removes symbol from package. +If symbol is present in package, it is +removed from package and also from package’s +shadowing symbols list if it is present there. If package is the +home package for symbol, symbol is made to have no +home package. +Symbol may continue to be accessible +in package by inheritance. +

    +

    Use of unintern can result in a symbol +that has no +recorded home package, +but that in fact is accessible in some package. +Common Lisp does not check for this pathological case, +and such symbols +are always printed preceded by #:. +

    +

    unintern returns true if it removes symbol, and nil otherwise. +

    +

    Examples::

    + +
    +
     (in-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (setq temps-unpack (intern "UNPACK" (make-package 'temp))) ⇒  TEMP::UNPACK 
+ (unintern temps-unpack 'temp) ⇒  T
+ (find-symbol "UNPACK" 'temp) ⇒  NIL, NIL 
+ temps-unpack ⇒  #:UNPACK 
+
    + +

    Side Effects::

    + +

    unintern changes the state of the +package system in such a way that the consistency rules do not hold +across the change. +

    +

    Affected By::

    +

    Current state of the package system. +

    +

    Exceptional Situations::

    +

    Giving a shadowing symbol to unintern +can uncover a name conflict that had +previously been resolved by the shadowing. If package A uses packages +B and C, A contains a shadowing symbol x, and B and C each contain external +symbols named x, then removing the shadowing symbol x +from A will reveal a name +conflict between b:x and c:x if those two symbols are distinct. +In this case unintern will signal an error. +

    +

    See Also::

    + +

    Package Concepts +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/union.html b/info/gcl/union.html new file mode 100644 index 0000000..d7aef3a --- /dev/null +++ b/info/gcl/union.html @@ -0,0 +1,170 @@ + + + + + +union (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Conses Dictionary  

    +
    +
    +

    14.2.49 union, nunion [Function]

    + +

    union list-1 list-2 &key key test test-not ⇒ result-list +

    +

    nunion list-1 list-2 &key key test test-not ⇒ result-list +

    +

    Arguments and Values::

    + +

    list-1—a proper list. +

    +

    list-2—a proper list. +

    +

    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. +

    +

    result-list—a list. +

    +

    Description::

    + +

    union and nunion return a list +that contains every element that occurs in either list-1 +or list-2. +

    +

    For all possible ordered pairs consisting of one +element from list-1 +and one element from list-2, :test or :test-not is used +to determine whether they satisfy the test. +The first argument to the :test or :test-not +function is the part of the element of list-1 extracted by the +:key function (if supplied); the second argument +is the part of the element of list-2 extracted by the +:key function (if supplied). +

    +

    The argument to the :key function is an element of +list-1 or list-2; the return value is part of the supplied +element. +If :key is not supplied or nil, +the element of list-1 or list-2 +itself is supplied to the :test or :test-not function. +

    +

    For every matching pair, +one of the two elements of the pair will be in the result. Any +element from either list-1 or list-2 +that matches no element of the other will appear +in the result. +

    +

    If there is a duplication between list-1 +and list-2, +only one of the duplicate instances will be in the result. +If either list-1 +or list-2 has duplicate entries within it, +the redundant entries +might or might not appear in the result. +

    +

    The order of elements in the result do not have to +reflect the ordering of list-1 or list-2 in any way. +The result list may be eq to either +list-1 or list-2 if appropriate. +

    +

    Examples::

    + +
    +
     (union '(a b c) '(f a d))
+⇒  (A B C F D)
+OR⇒ (B C F A D)
+OR⇒ (D F A B C)
+ (union '((x 5) (y 6)) '((z 2) (x 4)) :key #'car)
+⇒  ((X 5) (Y 6) (Z 2))
+OR⇒ ((X 4) (Y 6) (Z 2))
+
+ (setq lst1 (list 1 2 '(1 2) "a" "b")
+       lst2 (list 2 3 '(2 3) "B" "C"))
+⇒  (2 3 (2 3) "B" "C")
+ (nunion lst1 lst2)
+⇒  (1 (1 2) "a" "b" 2 3 (2 3) "B" "C") 
+OR⇒ (1 2 (1 2) "a" "b" "C" "B" (2 3) 3)
+
    + +

    Side Effects::

    + +

    nunion is permitted to modify any part, car or cdr, +of the list structure of list-1 or list-2. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if list-1 and list-2 are not proper lists. +

    +

    See Also::

    + +

    intersection +, +

    +

    Compiler Terminology, +

    +

    Traversal Rules and Side Effects +

    +

    Notes::

    + +

    The :test-not parameter is deprecated. +

    +

    Since the nunion side effect is not required, +it should not be used in for-effect-only positions in portable code. +

    + + + + + +
    +
    +

    +Previous: , Up: Conses Dictionary  

    +
    + + + + + diff --git a/info/gcl/unread_002dchar.html b/info/gcl/unread_002dchar.html new file mode 100644 index 0000000..4131a76 --- /dev/null +++ b/info/gcl/unread_002dchar.html @@ -0,0 +1,126 @@ + + + + + +unread-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.20 unread-char [Function]

    + +

    unread-char character &optional input-stream ⇒ nil +

    +

    Arguments and Values::

    + +

    character—a character; + must be the last character that was read from input-stream. +

    +

    input-stream—an input stream designator. + The default is standard input. +

    +

    Description::

    + +

    unread-char places character back onto the front of +input-stream so that it will again be the next character +in input-stream. +

    +

    When input-stream is an echo stream, +no attempt is made to undo any echoing of the character that might already +have been done on input-stream. However, characters placed on +input-stream by unread-char are marked in such a way +as to inhibit later re-echo by read-char. +

    +

    It is an error to invoke unread-char +twice consecutively on the same stream +without an intervening call to read-char +(or some other input operation which implicitly reads characters) +on that stream. +

    +

    Invoking peek-char or read-char commits all previous characters. +The consequences of invoking unread-char +on any character preceding that which is returned by +peek-char (including those passed over by +peek-char that has a non-nil peek-type) +are unspecified. +In particular, the consequences of +invoking unread-char after peek-char +are unspecified. +

    +

    Examples::

    + +
    +
     (with-input-from-string (is "0123")
+    (dotimes (i 6)
+      (let ((c (read-char is)))
+        (if (evenp i) (format t "~&~S ~S~
+ |>  0 #\0
+ |>  2 #\1
+ |>  4 #\2
+⇒  NIL
+
    + +

    Affected By::

    + +

    *standard-input*, +*terminal-io*. +

    +

    See Also::

    + +

    peek-char +, +read-char +, +Stream Concepts +

    +

    Notes::

    + +

    unread-char is intended to be an efficient mechanism for allowing +the Lisp reader and other parsers to perform one-character lookahead +in input-stream. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/unsigned_002dbyte.html b/info/gcl/unsigned_002dbyte.html new file mode 100644 index 0000000..f54056c --- /dev/null +++ b/info/gcl/unsigned_002dbyte.html @@ -0,0 +1,95 @@ + + + + + +unsigned-byte (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.10 unsigned-byte [Type]

    + +

    Supertypes::

    + +

    unsigned-byte, +signed-byte, +integer, +rational, +

    +

    real, +

    +

    number, +t +

    +

    Description::

    + +

    The atomic type specifier unsigned-byte denotes the same +type as is denoted by the type specifier (integer 0 *). +

    +

    Compound Type Specifier Kind::

    + +

    Abbreviating. +

    +

    Compound Type Specifier Syntax::

    + +

    (unsigned-byte{[s | *]}) +

    +

    Compound Type Specifier Arguments::

    + +

    s—a positive integer. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of non-negative integers that can be +represented in a byte of size s (bits). +This is equivalent +to (mod m) for m=2^s, or +to (integer 0 n) for n=2^s-1. +The type unsigned-byte or +the type (unsigned-byte *) is the same as +the type (integer 0 *), the set of non-negative integers. +

    +

    Notes::

    + +

    The type (unsigned-byte 1) is also called bit. +

    + + + + + diff --git a/info/gcl/unuse_002dpackage.html b/info/gcl/unuse_002dpackage.html new file mode 100644 index 0000000..51e61d8 --- /dev/null +++ b/info/gcl/unuse_002dpackage.html @@ -0,0 +1,99 @@ + + + + + +unuse-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.17 unuse-package [Function]

    + +

    unuse-package packages-to-unuse &optional package ⇒ t +

    +

    Arguments and Values::

    + +

    packages-to-unuse—a designator for + a list of package designators. +

    +

    package—a package designator. + The default is the current package. +

    +

    Description::

    + +

    unuse-package causes package to cease inheriting +all the external symbols of +packages-to-unuse; unuse-package undoes +the effects of use-package. The +packages-to-unuse +are removed from the use list of package. +

    +

    Any symbols that have been +imported into package continue to be present in package. +

    +

    Examples::

    + +
    +
     (in-package "COMMON-LISP-USER") ⇒  #<PACKAGE "COMMON-LISP-USER">
+ (export (intern "SHOES" (make-package 'temp)) 'temp) ⇒  T
+ (find-symbol "SHOES") ⇒  NIL, NIL
+ (use-package 'temp) ⇒  T
+ (find-symbol "SHOES") ⇒  SHOES, :INHERITED
+ (find (find-package 'temp) (package-use-list 'common-lisp-user)) ⇒  #<PACKAGE "TEMP">
+ (unuse-package 'temp) ⇒  T
+ (find-symbol "SHOES") ⇒  NIL, NIL
+
    + +

    Side Effects::

    + +

    The use list of package is modified. +

    +

    Affected By::

    +

    Current state of the package system. +

    +

    See Also::

    + +

    use-package +, +package-use-list +

    + + + + + diff --git a/info/gcl/unwind_002dprotect.html b/info/gcl/unwind_002dprotect.html new file mode 100644 index 0000000..f5e32da --- /dev/null +++ b/info/gcl/unwind_002dprotect.html @@ -0,0 +1,237 @@ + + + + + +unwind-protect (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.29 unwind-protect [Special Operator]

    + +

    unwind-protect protected-form {cleanup-form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    protected-form—a form. +

    +

    cleanup-form—a form. +

    +

    results—the values of the protected-form. +

    +

    Description::

    +

    unwind-protect evaluates protected-form +and guarantees that cleanup-forms are executed +before unwind-protect exits, +whether it terminates +normally or is aborted by a control transfer of some kind. +unwind-protect is intended to be used +to make sure that +certain side effects take place after the evaluation of +protected-form. +

    +

    If a non-local exit occurs during execution of cleanup-forms, +no special action is taken. The cleanup-forms of +unwind-protect +are not protected by that unwind-protect. +

    +

    unwind-protect protects against all attempts to exit +from protected-form, including + go, + handler-case, + ignore-errors, + restart-case, + return-from, + throw, + and with-simple-restart. +

    +

    Undoing of handler and restart bindings during an exit +happens in parallel with the undoing of the bindings of dynamic variables +and catch tags, in the reverse order in which they were established. +The effect of this is that cleanup-form sees the same handler +and restart bindings, as well as dynamic variable bindings +and catch tags, as were visible when the unwind-protect was entered. +

    +

    Examples::

    +
    +
     (tagbody
+   (let ((x 3))
+     (unwind-protect
+       (if (numberp x) (go out))
+       (print x)))
+  out
+   ...)
+
    + +

    When go is executed, the call to print is executed first, +and then the transfer of control to the tag out is completed. +

    +
    +
     (defun dummy-function (x)
+    (setq state 'running)
+    (unless (numberp x) (throw 'abort 'not-a-number))
+    (setq state (1+ x))) ⇒  DUMMY-FUNCTION
+ (catch 'abort (dummy-function 1)) ⇒  2
+ state ⇒  2
+ (catch 'abort (dummy-function 'trash)) ⇒  NOT-A-NUMBER
+ state ⇒  RUNNING
+ (catch 'abort (unwind-protect (dummy-function 'trash) 
+                  (setq state 'aborted))) ⇒  NOT-A-NUMBER
+ state ⇒  ABORTED
+
    + +

    The following code +is not correct: +

    +
    +
     (unwind-protect
+   (progn (incf *access-count*)
+          (perform-access))
+   (decf *access-count*))
+
    + +

    If an exit occurs before completion of incf, +the decf form is executed anyway, resulting in an +incorrect value for *access-count*. +The correct way to code this is as follows: +

    +
    +
     (let ((old-count *access-count*))
+   (unwind-protect
+     (progn (incf *access-count*)
+            (perform-access))
+     (setq *access-count* old-count)))
+
    + +
    +
    ;;; The following returns 2.
+ (block nil   
+   (unwind-protect (return 1)
+     (return 2)))
+
+;;; The following has undefined consequences.
+ (block a    
+   (block b
+     (unwind-protect (return-from a 1)
+       (return-from b 2))))
+
+;;; The following returns 2.
+ (catch nil 
+   (unwind-protect (throw nil 1)
+     (throw nil 2)))
+
+;;; The following has undefined consequences because the catch of B is 
+;;; passed over by the first THROW, hence portable programs must assume 
+;;; its dynamic extent is terminated.  The binding of the catch tag is not
+;;; yet disestablished and therefore it is the target of the second throw.
+ (catch 'a
+   (catch 'b
+     (unwind-protect (throw 'a 1)
+       (throw 'b 2))))
+
+;;; The following prints "The inner catch returns :SECOND-THROW"
+;;; and then returns :OUTER-CATCH.
+ (catch 'foo
+         (format t "The inner catch returns ~s.~
+                 (catch 'foo
+                     (unwind-protect (throw 'foo :first-throw)
+                         (throw 'foo :second-throw))))
+         :outer-catch)
+
+;;; The following returns 10. The inner CATCH of A is passed over, but 
+;;; because that CATCH is disestablished before the THROW to A is executed,
+;;; it isn't seen.
+ (catch 'a
+   (catch 'b
+     (unwind-protect (1+ (catch 'a (throw 'b 1)))
+       (throw 'a 10))))
+
+;;; The following has undefined consequences because the extent of
+;;; the (CATCH 'BAR ...) exit ends when the (THROW 'FOO ...)
+;;; commences.
+ (catch 'foo
+   (catch 'bar
+       (unwind-protect (throw 'foo 3)
+         (throw 'bar 4)
+         (print 'xxx))))
+
+;;; The following returns 4; XXX is not printed.
+;;; The (THROW 'FOO ...) has no effect on the scope of the BAR
+;;; catch tag or the extent of the (CATCH 'BAR ...) exit.
+ (catch 'bar
+   (catch 'foo
+       (unwind-protect (throw 'foo 3)
+         (throw 'bar 4)
+         (print 'xxx))))
+
+;;; The following prints 5.
+ (block nil
+   (let ((x 5))
+     (declare (special x))
+     (unwind-protect (return)
+       (print x))))          
+
    + +

    See Also::

    + +

    catch +, +go +, +handler-case +, +restart-case +, +return +, +return-from +, +throw +, +Evaluation +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/update_002dinstance_002dfor_002ddifferent_002dclass.html b/info/gcl/update_002dinstance_002dfor_002ddifferent_002dclass.html new file mode 100644 index 0000000..b964118 --- /dev/null +++ b/info/gcl/update_002dinstance_002dfor_002ddifferent_002dclass.html @@ -0,0 +1,157 @@ + + + + + +update-instance-for-different-class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.6 update-instance-for-different-class [Standard Generic Function]

    + +

    Syntax::

    + +

    update-instance-for-different-class previous current + &rest initargs + &key &allow-other-keys ⇒ implementation-dependent +

    +

    Method Signatures::

    + +

    update-instance-for-different-class (previous standard-object) + (current standard-object) + &rest initargs +

    +

    Arguments and Values::

    + +

    previous—a copy of the original instance. +

    +

    current—the original instance (altered). +

    +

    initargs—an initialization argument list. +

    +

    Description::

    + +

    The generic function update-instance-for-different-class is not +intended to be called by programmers. Programmers may write +methods for it. The function update-instance-for-different-class +is called only by the function change-class. +

    +

    The system-supplied primary method on +update-instance-for-different-class checks the validity of +initargs and signals an error if an initarg +is supplied that is not declared as valid. This method then +initializes slots with values according to the initargs, +and initializes the newly added slots with values according +to their :initform forms. It does this by calling the generic +function shared-initialize with the following arguments: the +instance (current), +a list of names of the newly added slots, and the initargs +it received. Newly added slots are those local slots for which +no slot of the same name exists in the previous class. +

    +

    Methods for update-instance-for-different-class can be defined to +specify actions to be taken when an instance is updated. If only +after methods for update-instance-for-different-class are +defined, they will be run after the system-supplied primary method for +initialization and therefore will not interfere with the default +behavior of update-instance-for-different-class. +

    +

    Methods on update-instance-for-different-class can be defined to +initialize slots differently from change-class. The default +behavior of change-class is described in +Changing the Class of an Instance. +

    +

    The arguments to update-instance-for-different-class are +computed by change-class. When change-class is invoked on +an instance, a copy of that instance is made; change-class then +destructively alters the original instance. The first argument to +update-instance-for-different-class, previous, is that +copy; it holds the old slot values temporarily. This argument has +dynamic extent within change-class; if it is referenced in any +way once update-instance-for-different-class returns, the +results are undefined. The second argument to +update-instance-for-different-class, current, is the altered +original instance. +The intended use of previous is to extract old slot values by using +slot-value or with-slots or by invoking +a reader generic function, or to run other methods that were applicable to +instances of +the original class. +

    +

    Examples::

    + +

    See the example for the function change-class. +

    +

    Exceptional Situations::

    +

    The system-supplied primary method on +update-instance-for-different-class signals an error if an +initialization argument is supplied that is not declared as valid. +

    +

    See Also::

    + +

    change-class +, +Shared-Initialize +, +Changing the Class of an Instance, +Rules for Initialization Arguments, +Declaring the Validity of Initialization Arguments +

    +

    Notes::

    + +

    Initargs are declared as valid by using the :initarg +option to defclass, or by defining methods +for update-instance-for-different-class or shared-initialize. +The keyword name of each keyword parameter specifier in the lambda list of +any method defined on update-instance-for-different-class +or shared-initialize is declared as a valid initarg name +for all classes for which that method is applicable. +

    +

    The value returned by update-instance-for-different-class is +ignored by change-class. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/update_002dinstance_002dfor_002dredefined_002dclass.html b/info/gcl/update_002dinstance_002dfor_002dredefined_002dclass.html new file mode 100644 index 0000000..5484f70 --- /dev/null +++ b/info/gcl/update_002dinstance_002dfor_002dredefined_002dclass.html @@ -0,0 +1,205 @@ + + + + + +update-instance-for-redefined-class (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.7 update-instance-for-redefined-class [Standard Generic Function]

    + +

    Syntax::

    + +

    update-instance-for-redefined-class instance + added-slots discarded-slots + property-list + &rest initargs &key &allow-other-keys
    + ⇒ {result}* +

    +

    Method Signatures::

    + +

    update-instance-for-redefined-class (instance standard-object) + added-slots discarded-slots + property-list + &rest initargs +

    +

    Arguments and Values::

    + +

    instance—an object. +

    +

    added-slots—a list. +

    +

    discarded-slots—a list. +

    +

    property-list—a list. +

    +

    initargs—an initialization argument list. +

    +

    result—an object. +

    +

    Description::

    + +

    The generic function update-instance-for-redefined-class +is not intended to be called by programmers. Programmers may write +methods for it. The generic function +update-instance-for-redefined-class is called by the mechanism +activated by make-instances-obsolete. +

    +

    The system-supplied primary method on +update-instance-for-redefined-class checks the validity of +initargs and signals an error if an initarg +is supplied that is not declared as valid. This method then +initializes slots with values according to the initargs, +and initializes the newly added-slots with values according +to their :initform forms. It does this by calling the generic +function shared-initialize with the following arguments: +the instance, +a list of names of the newly added-slots to instance, +and the initargs +it received. Newly added-slots are those local slots for which +no slot of the same name exists in the old version of the class. +

    +

    When make-instances-obsolete is invoked or when a class has been +redefined and an instance is being updated, a property-list is created +that captures the slot names and values of all the discarded-slots with +values in the original instance. The structure of the +instance is +transformed so that it conforms to the current class definition. The +arguments to update-instance-for-redefined-class are this +transformed instance, a list of added-slots to the +instance, a list discarded-slots from the +instance, and the property-list +containing the slot names and values for +slots that were discarded and had values. Included in this list of +discarded slots are slots that were local in the old class and are +shared in the new class. +

    +

    The value returned by update-instance-for-redefined-class is ignored. +

    +

    Examples::

    + +
    +
    +
+ (defclass position () ())
+
+ (defclass x-y-position (position)
+     ((x :initform 0 :accessor position-x)
+      (y :initform 0 :accessor position-y)))
+
+;;; It turns out polar coordinates are used more than Cartesian 
+;;; coordinates, so the representation is altered and some new
+;;; accessor methods are added.
+
+ (defmethod update-instance-for-redefined-class :before
+    ((pos x-y-position) added deleted plist &key)
+   ;; Transform the x-y coordinates to polar coordinates
+   ;; and store into the new slots.
+   (let ((x (getf plist 'x))
+         (y (getf plist 'y)))
+     (setf (position-rho pos) (sqrt (+ (* x x) (* y y)))
+           (position-theta pos) (atan y x))))
+
+ (defclass x-y-position (position)
+     ((rho :initform 0 :accessor position-rho)
+      (theta :initform 0 :accessor position-theta)))
+
+;;; All instances of the old x-y-position class will be updated
+;;; automatically.
+
+;;; The new representation is given the look and feel of the old one.
+
+ (defmethod position-x ((pos x-y-position))  
+    (with-slots (rho theta) pos (* rho (cos theta))))
+
+ (defmethod (setf position-x) (new-x (pos x-y-position))
+    (with-slots (rho theta) pos
+      (let ((y (position-y pos)))
+        (setq rho (sqrt (+ (* new-x new-x) (* y y)))
+              theta (atan y new-x))
+        new-x)))
+
+ (defmethod position-y ((pos x-y-position))
+    (with-slots (rho theta) pos (* rho (sin theta))))
+
+ (defmethod (setf position-y) (new-y (pos x-y-position))
+    (with-slots (rho theta) pos
+      (let ((x (position-x pos)))
+        (setq rho (sqrt (+ (* x x) (* new-y new-y)))
+              theta (atan new-y x))
+        new-y)))
+
+
    + +

    Exceptional Situations::

    +

    The system-supplied primary method on +update-instance-for-redefined-class signals an error if an +initarg is supplied that is not declared as valid. +

    +

    See Also::

    + +

    make-instances-obsolete +, +Shared-Initialize +, +Redefining Classes, +Rules for Initialization Arguments, +Declaring the Validity of Initialization Arguments +

    +

    Notes::

    + +

    Initargs are declared as valid by using the :initarg +option to defclass, or by defining methods for +update-instance-for-redefined-class or shared-initialize. +The keyword name of each keyword parameter specifier in the lambda list of +any method defined on +update-instance-for-redefined-class or +shared-initialize is declared as a valid initarg name +for all classes for which that method is applicable. +

    +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/upgraded_002darray_002delement_002dtype.html b/info/gcl/upgraded_002darray_002delement_002dtype.html new file mode 100644 index 0000000..ec37f24 --- /dev/null +++ b/info/gcl/upgraded_002darray_002delement_002dtype.html @@ -0,0 +1,105 @@ + + + + + +upgraded-array-element-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.23 upgraded-array-element-type [Function]

    + +

    upgraded-array-element-type typespec &optional environment ⇒ upgraded-typespec +

    +

    Arguments and Values::

    + +

    typespec—a type specifier. +

    +

    environment—an environment object. + The default is nil, denoting the null lexical environment + and the current global environment. +

    +

    upgraded-typespec—a type specifier. +

    +

    Description::

    + +

    Returns the element type of +the most specialized array representation capable of +holding items of the type denoted by typespec. +

    +

    The typespec is a subtype of +(and possibly type equivalent to) +the upgraded-typespec. +

    +

    If typespec is bit, + the result is type equivalent to bit. +

    +

    If typespec is base-char, + the result is type equivalent to base-char. +

    +

    If typespec is character, + the result is type equivalent to character. +

    +

    The purpose of upgraded-array-element-type is to reveal how +an implementation does its upgrading. +

    +

    The environment is used to expand any derived type specifiers +that are mentioned in the typespec. +

    +

    See Also::

    + +

    array-element-type +, +make-array +

    +

    Notes::

    + +

    Except for storage allocation consequences and dealing correctly with the +optional environment argument, +upgraded-array-element-type could be defined as: +

    +
    +
     (defun upgraded-array-element-type (type &optional environment)
+   (array-element-type (make-array 0 :element-type type)))
+
    + + + + + + diff --git a/info/gcl/upgraded_002dcomplex_002dpart_002dtype.html b/info/gcl/upgraded_002dcomplex_002dpart_002dtype.html new file mode 100644 index 0000000..3b1b6f5 --- /dev/null +++ b/info/gcl/upgraded_002dcomplex_002dpart_002dtype.html @@ -0,0 +1,83 @@ + + + + + +upgraded-complex-part-type (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.51 upgraded-complex-part-type [Function]

    + +

    upgraded-complex-part-type typespec &optional environment ⇒ upgraded-typespec +

    +

    Arguments and Values::

    + +

    typespec—a type specifier. +

    +

    environment—an environment object. + The default is nil, denoting the null lexical environment + and the and current global environment. +

    +

    upgraded-typespec—a type specifier. +

    +

    Description::

    + +

    upgraded-complex-part-type returns the part type of the +most specialized complex number representation that can +hold parts of type typespec. +

    +

    The typespec is a subtype of +(and possibly type equivalent to) +the upgraded-typespec. +

    +

    The purpose of upgraded-complex-part-type +is to reveal how an implementation does its upgrading. +

    +

    See Also::

    + +

    complex + (function and type) +

    +

    Notes::

    + + + + + + diff --git a/info/gcl/upper_002dcase_002dp.html b/info/gcl/upper_002dcase_002dp.html new file mode 100644 index 0000000..c53d788 --- /dev/null +++ b/info/gcl/upper_002dcase_002dp.html @@ -0,0 +1,103 @@ + + + + + +upper-case-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Characters Dictionary  

    +
    +
    +

    13.2.15 upper-case-p, lower-case-p, both-case-p [Function]

    + +

    upper-case-p character ⇒ generalized-boolean +

    +

    lower-case-p character ⇒ generalized-boolean +

    +

    both-case-p character ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    These functions test the case of a given character. +

    +

    upper-case-p returns true if character is an uppercase character; +otherwise, returns false. +

    +

    lower-case-p returns true if character is a lowercase character; +otherwise, returns false. +

    +

    both-case-p returns true if character is a character with case; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (upper-case-p #\A) ⇒  true
+ (upper-case-p #\a) ⇒  false
+ (both-case-p #\a) ⇒  true
+ (both-case-p #\5) ⇒  false
+ (lower-case-p #\5) ⇒  false
+ (upper-case-p #\5) ⇒  false
+ ;; This next example presupposes an implementation 
+ ;; in which #\Bell is an implementation-defined character.
+ (lower-case-p #\Bell) ⇒  false
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if character is not a character. +

    +

    See Also::

    + +

    char-upcase +, +char-downcase, +Characters With Case, +Documentation of Implementation-Defined Scripts +

    + + + + + diff --git a/info/gcl/use_002dpackage.html b/info/gcl/use_002dpackage.html new file mode 100644 index 0000000..106ad19 --- /dev/null +++ b/info/gcl/use_002dpackage.html @@ -0,0 +1,123 @@ + + + + + +use-package (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.18 use-package [Function]

    + +

    use-package packages-to-use &optional package ⇒ t +

    +

    Arguments and Values::

    + +

    packages-to-use—a designator for + a list of package designators. + The KEYWORD package may not be supplied. +

    +

    package—a package designator. + The KEYWORD package cannot be supplied. + The default is the current package. +

    +

    Description::

    + +

    use-package causes package to inherit all the +external symbols of packages-to-use. +The inherited symbols become accessible as +internal symbols of package. +

    +

    Packages-to-use are added to the use list of package +if they are not there already. All external symbols in +packages-to-use become accessible in package +as internal symbols. +use-package does not cause any new symbols to be present +in package but only makes them accessible by inheritance. +

    +

    use-package checks for +name conflicts between the newly imported symbols and those already +accessible in package. +A name conflict in use-package +between two external symbols inherited +by package from packages-to-use may be resolved in favor of +either symbol +by importing one of them into package and making it a +shadowing symbol. +

    +

    Examples::

    + +
    +
     (export (intern "LAND-FILL" (make-package 'trash)) 'trash) ⇒  T
+ (find-symbol "LAND-FILL" (make-package 'temp)) ⇒  NIL, NIL
+ (package-use-list 'temp) ⇒  (#<PACKAGE "TEMP">)
+ (use-package 'trash 'temp) ⇒  T
+ (package-use-list 'temp) ⇒  (#<PACKAGE "TEMP"> #<PACKAGE "TRASH">)
+ (find-symbol "LAND-FILL" 'temp) ⇒  TRASH:LAND-FILL, :INHERITED
+
    + +

    Side Effects::

    + +

    The use list of package may be modified. +

    +

    See Also::

    + +

    unuse-package +, +package-use-list +, +Package Concepts +

    +

    Notes::

    + +

    It is permissible for a package P_1 +to use a package P_2 +even if P_2 already uses P_1. +The using of packages is not transitive, +so no problem results from the apparent circularity. +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/use_002dvalue.html b/info/gcl/use_002dvalue.html new file mode 100644 index 0000000..9dda870 --- /dev/null +++ b/info/gcl/use_002dvalue.html @@ -0,0 +1,72 @@ + + + + + +use-value (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.45 use-value [Restart]

    + +

    Data Arguments Required::

    + +

    a value to use instead (once). +

    +

    Description::

    + +

    The use-value restart is generally used by handlers trying +to recover from errors of types such as cell-error, +where the handler may wish to supply a replacement datum for one-time use. +

    +

    See Also::

    + +

    Restarts, +Interfaces to Restarts, +invoke-restart +, +use-value + (function), +store-value + (function and restart) +

    + + + + + diff --git a/info/gcl/user_002dhomedir_002dpathname.html b/info/gcl/user_002dhomedir_002dpathname.html new file mode 100644 index 0000000..8979f3e --- /dev/null +++ b/info/gcl/user_002dhomedir_002dpathname.html @@ -0,0 +1,95 @@ + + + + + +user-homedir-pathname (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Previous: , Up: Environment Dictionary  

    +
    +
    +

    25.2.30 user-homedir-pathname [Function]

    + +

    user-homedir-pathname &optional host ⇒ pathname +

    +

    Arguments and Values::

    + +

    host—a string, a list of strings, or :unspecific. +

    +

    pathname—a pathname, or nil. +

    +

    Description::

    + +

    user-homedir-pathname determines the pathname that corresponds +to the user’s home directory on host. +If host is not supplied, its value is implementation-dependent. +

    +

    For a description of :unspecific, see Pathname Components. +

    +

    The definition of home directory is implementation-dependent, +but defined in Common Lisp to mean the directory where the user +keeps personal files such as initialization files and mail. +

    +

    user-homedir-pathname returns a pathname without any name, +type, or version component (those components are all nil) +for the user’s home directory on host. +

    +

    If it is impossible to determine the user’s home directory on host, +then nil is returned. +user-homedir-pathname never returns nil if host is not supplied. +

    +

    Examples::

    + +
    +
     (pathnamep (user-homedir-pathname)) ⇒  true
+
    + +

    Affected By::

    + +

    The host computer’s file system, +and the implementation. +

    + + + + + + + + + + diff --git a/info/gcl/values-_0028Type-Specifier_0029.html b/info/gcl/values-_0028Type-Specifier_0029.html new file mode 100644 index 0000000..6cfdb4e --- /dev/null +++ b/info/gcl/values-_0028Type-Specifier_0029.html @@ -0,0 +1,83 @@ + + + + + +values (Type Specifier) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Types and Classes Dictionary  

    +
    +
    +

    4.4.22 values [Type Specifier]

    + +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (values{!value-typespec}) +

    +

    [Reviewer Note by Barmar: Missing &key] +

    +

    value-typespec ::={typespec}* [&optional {typespec}*] [&rest typespec ] [&allow-other-keys] +

    +

    Compound Type Specifier Arguments::

    + +

    typespec—a type specifier. +

    +

    Compound Type Specifier Description::

    + +

    This type specifier can be used only as the value-type in a +function type specifier or a the +special form. It is used to specify individual types +when multiple values are involved. +The &optional and &rest markers can appear in the value-type list; +they indicate the parameter list of a function that, +when given to multiple-value-call along with the values, +would correctly receive those values. +

    +

    The symbol * may not be among the value-types. +

    +

    The symbol values is not valid as a type specifier; +and, specifically, it is not an abbreviation for (values). +

    + + + + + diff --git a/info/gcl/values.html b/info/gcl/values.html new file mode 100644 index 0000000..d211ef7 --- /dev/null +++ b/info/gcl/values.html @@ -0,0 +1,133 @@ + + + + + +values (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.53 values [Accessor]

    + +

    values &rest object ⇒ {object}* +

    +

    (setf ( values &rest place) new-values)
    +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    place—a place. +

    +

    new-value—an object. +

    +

    Description::

    + +

    values +returns the objects as multiple values_2. +

    +

    setf of values is used to store the +multiple values_2 new-values into the places. +See VALUES Forms as Places. +

    +

    Examples::

    + +
    +
     (values) ⇒  <no values>
+ (values 1) ⇒  1
+ (values 1 2) ⇒  1, 2
+ (values 1 2 3) ⇒  1, 2, 3
+ (values (values 1 2 3) 4 5) ⇒  1, 4, 5
+ (defun polar (x y)
+   (values (sqrt (+ (* x x) (* y y))) (atan y x))) ⇒  POLAR
+ (multiple-value-bind (r theta) (polar 3.0 4.0)
+   (vector r theta))
+⇒  #(5.0 0.927295)
+
    + +

    Sometimes it is desirable to indicate explicitly that a function returns +exactly one value. For example, the function +

    +
    +
     (defun foo (x y)
+   (floor (+ x y) y)) ⇒  FOO
+
    + +

    returns two values because floor returns +two values. It may be that the second value makes no sense, +or that for efficiency reasons it is desired not to compute the +second value. values is the standard idiom +for indicating that only one value is to be returned: +

    +
    +
     (defun foo (x y)
+   (values (floor (+ x y) y))) ⇒  FOO
+
    + +

    This works because values +returns exactly one value for each of +args; as for any function call, +if any of args produces more than one value, all but the +first are discarded. +

    +

    See Also::

    + +

    values-list +, +multiple-value-bind +, +multiple-values-limit +, +Evaluation +

    +

    Notes::

    + +

    Since values is a function, not a macro or special form, +it receives as arguments only the primary values of +its argument forms. +

    +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/values_002dlist.html b/info/gcl/values_002dlist.html new file mode 100644 index 0000000..807d8ac --- /dev/null +++ b/info/gcl/values_002dlist.html @@ -0,0 +1,95 @@ + + + + + +values-list (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.54 values-list [Function]

    + +

    values-list list ⇒ {element}* +

    +

    Arguments and Values::

    + +

    list—a list. +

    +

    elements—the elements of the list. +

    +

    Description::

    + +

    Returns the elements of the list as multiple values_2. +

    +

    Examples::

    + +
    +
     (values-list nil) ⇒  <no values>
+ (values-list '(1)) ⇒  1
+ (values-list '(1 2)) ⇒  1, 2
+ (values-list '(1 2 3)) ⇒  1, 2, 3
+
    + +

    Exceptional Situations::

    + +

    Should signal type-error if its argument is not a proper list. +

    +

    See Also::

    + +

    multiple-value-bind +, +multiple-value-list +, +multiple-values-limit +, +values +

    +

    Notes::

    + +
    +
     (values-list list) ≡ (apply #'values list)
+
    + +

    (equal x (multiple-value-list (values-list x))) +returns true for all lists x. +

    + + + + + diff --git a/info/gcl/vector-_0028System-Class_0029.html b/info/gcl/vector-_0028System-Class_0029.html new file mode 100644 index 0000000..70d15f4 --- /dev/null +++ b/info/gcl/vector-_0028System-Class_0029.html @@ -0,0 +1,129 @@ + + + + + +vector (System Class) (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.3 vector [System Class]

    + +

    Class Precedence List::

    +

    vector, +array, +sequence, +t +

    +

    Description::

    + +

    Any one-dimensional array is a vector. +

    +

    The type vector is a subtype of type array; +for all types x, (vector x) is the same as (array x (*)). +

    +

    The type (vector t), the type string, and the type bit-vector +are disjoint subtypes of type vector. +

    +

    Compound Type Specifier Kind::

    + +

    Specializing. +

    +

    Compound Type Specifier Syntax::

    + +

    (vector{[{element-type | *} [{size | *}]]}) +

    +

    Compound Type Specifier Arguments::

    + +

    size—a non-negative fixnum. +

    +

    element-type—a type specifier. +

    +

    Compound Type Specifier Description::

    + +

    This denotes the set of specialized vectors +whose element type and dimension match the specified values. +Specifically: +

    +

    If element-type is the symbol *, +vectors are not excluded on the basis of their element type. +Otherwise, only those vectors are included whose actual array element type +

    +

    is the result of upgrading element-type; +see Array Upgrading. +

    +

    If a size is specified, +the set includes only those vectors whose only dimension +is size. +If the symbol * is specified instead of a size, +the set is not restricted on the basis of dimension. +

    +

    See Also::

    + +

    Required Kinds of Specialized Arrays, +Sharpsign Left-Parenthesis, +Printing Other Vectors, +Sharpsign A +

    +

    Notes::

    + +

    The type (vector e s) +is equivalent to the type (array e (s)). +

    +

    The type (vector bit) has the name bit-vector. +

    +

    The union of all types (vector C), +where C is any subtype of character, +has the name string. +

    +

    (vector *) refers to all vectors +regardless of element type, (vector type-specifier) +refers only to those vectors +that can result from giving type-specifier as the +:element-type argument to make-array. +

    +
    +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    + + + + + diff --git a/info/gcl/vector.html b/info/gcl/vector.html new file mode 100644 index 0000000..c9f3666 --- /dev/null +++ b/info/gcl/vector.html @@ -0,0 +1,90 @@ + + + + + +vector (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.29 vector [Function]

    + +

    vector &rest objects ⇒ vector +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    vector—a vector of type (vector t *). +

    +

    Description::

    + +

    Creates a fresh simple general vector whose size +corresponds to the number of objects. +

    +

    The vector is initialized to contain the objects. +

    +

    Examples::

    + +
    +
     (arrayp (setq v (vector 1 2 'sirens))) ⇒  true
+ (vectorp v) ⇒  true
+ (simple-vector-p v) ⇒  true         
+ (length v) ⇒  3
+
    + +

    See Also::

    + +

    make-array +

    +

    Notes::

    + +

    vector is analogous to list. +

    +
    +
     (vector a_1 a_2 ... a_n)
+  ≡ (make-array (list n) :element-type t
+                          :initial-contents 
+                            (list a_1 a_2 ... a_n))
+
    + + + + + + diff --git a/info/gcl/vector_002dpop.html b/info/gcl/vector_002dpop.html new file mode 100644 index 0000000..4afe094 --- /dev/null +++ b/info/gcl/vector_002dpop.html @@ -0,0 +1,98 @@ + + + + + +vector-pop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.30 vector-pop [Function]

    + +

    vector-pop vector ⇒ element +

    +

    Arguments and Values::

    + +

    vector—a vector with a fill pointer. +

    +

    element—an object. +

    +

    Description::

    + +

    Decreases the fill pointer of vector by one, +and retrieves the element of vector that is +designated by the new fill pointer. +

    +

    Examples::

    + +
    +
     (vector-push (setq fable (list 'fable))
+              (setq fa (make-array 8
+                                   :fill-pointer 2
+                                   :initial-element 'sisyphus))) ⇒  2 
+ (fill-pointer fa) ⇒  3 
+ (eq (vector-pop fa) fable) ⇒  true
+ (vector-pop fa) ⇒  SISYPHUS 
+ (fill-pointer fa) ⇒  1 
+
    + +

    Side Effects::

    + +

    The fill pointer is decreased by one. +

    +

    Affected By::

    + +

    The value of the fill pointer. +

    +

    Exceptional Situations::

    + +

    An error of type type-error is signaled if vector does not have a fill pointer. +

    +

    If the fill pointer is zero, vector-pop signals an error of type error. +

    +

    See Also::

    + +

    vector-push +, vector-push-extend, +fill-pointer +

    + + + + + diff --git a/info/gcl/vector_002dpush.html b/info/gcl/vector_002dpush.html new file mode 100644 index 0000000..8321a5e --- /dev/null +++ b/info/gcl/vector_002dpush.html @@ -0,0 +1,143 @@ + + + + + +vector-push (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.31 vector-push, vector-push-extend [Function]

    + +

    vector-push new-element vector ⇒ new-index-p +

    +

    vector-push-extend new-element vector &optional extension ⇒ new-index +

    +

    Arguments and Values::

    + +

    new-element—an object. +

    +

    vector—a vector with a fill pointer. +

    +

    extension—a positive integer. + The default is implementation-dependent. +

    +

    new-index-p—a valid array index for vector, or nil. +

    +

    new-index—a valid array index for vector. +

    +

    Description::

    + +

    vector-push and vector-push-extend store +new-element in vector. +vector-push attempts to store +new-element +in the element of vector designated by the fill pointer, +and to increase the fill pointer by one. If the +(>= (fill-pointer vector) (array-dimension vector 0)), +neither vector nor its fill pointer are affected. +Otherwise, the store and increment take +place and vector-push +returns the former value of the fill pointer +which is one less than the one it leaves in vector. +

    +

    vector-push-extend is just like vector-push except +that if the fill pointer gets too large, vector is extended using +adjust-array so that it can contain more elements. +Extension +is the minimum number of elements to be added to vector if it +must be extended. +

    +

    vector-push and +vector-push-extend return the index of new-element in vector. +If (>= (fill-pointer vector) (array-dimension vector 0)), +vector-push returns nil. +

    +

    Examples::

    + +
    +
     (vector-push (setq fable (list 'fable))
+              (setq fa (make-array 8 
+                                   :fill-pointer 2
+                                   :initial-element 'first-one))) ⇒  2 
+ (fill-pointer fa) ⇒  3 
+ (eq (aref fa 2) fable) ⇒  true
+ (vector-push-extend #\X
+                    (setq aa 
+                          (make-array 5
+                                      :element-type 'character
+                                      :adjustable t
+                                      :fill-pointer 3))) ⇒  3 
+ (fill-pointer aa) ⇒  4 
+ (vector-push-extend #\Y aa 4) ⇒  4 
+ (array-total-size aa) ⇒  at least 5 
+ (vector-push-extend #\Z aa 4) ⇒  5 
+ (array-total-size aa) ⇒  9 ;(or more)
+
    + +

    Affected By::

    +

    The value of the fill pointer. +

    +

    How vector was created. +

    +

    Exceptional Situations::

    + +

    An error of type error is signaled by vector-push-extend +if it tries to extend vector and vector is not actually adjustable. +

    +

    An error of type error is signaled if vector does not +have a fill pointer. +

    +

    See Also::

    + +

    adjustable-array-p +, +fill-pointer +, +vector-pop +

    +
    +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    + + + + + diff --git a/info/gcl/vectorp.html b/info/gcl/vectorp.html new file mode 100644 index 0000000..df816df --- /dev/null +++ b/info/gcl/vectorp.html @@ -0,0 +1,79 @@ + + + + + +vectorp (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Arrays Dictionary  

    +
    +
    +

    15.2.32 vectorp [Function]

    + +

    vectorp object ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if object is of type vector; +otherwise, returns false. +

    +

    Examples::

    + +
    +
     (vectorp "aaaaaa") ⇒  true
+ (vectorp (make-array 6 :fill-pointer t)) ⇒  true
+ (vectorp (make-array '(2 3 4))) ⇒  false
+ (vectorp #*11) ⇒  true
+ (vectorp #b11) ⇒  false
+
    + +

    Notes::

    +
    +
     (vectorp object) ≡ (typep object 'vector)
+
    + + + + + + diff --git a/info/gcl/warn.html b/info/gcl/warn.html new file mode 100644 index 0000000..c175769 --- /dev/null +++ b/info/gcl/warn.html @@ -0,0 +1,149 @@ + + + + + +warn (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.20 warn [Function]

    + +

    warn datum &rest arguments ⇒ nil +

    +

    Arguments and Values::

    + +

    datum, arguments—designators for a condition + of default type simple-warning. +

    +

    Description::

    + +

    Signals a condition of type warning. +If the condition is not handled, +reports the condition to error output. +

    +

    The precise mechanism for warning is as follows: +

    +
    +
    The warning condition is signaled
    +

    While the warning condition is being signaled, +the muffle-warning restart is established for use by a handler. +If invoked, this restart bypasses further action by warn, +which in turn causes warn to immediately return nil. +

    +
    +
    If no handler for the warning condition is found
    +

    If no handlers for the warning condition are found, +or if all such handlers decline, +then the condition is reported to error output +by warn in an implementation-dependent format. +

    +
    +
    nil is returned
    +

    The value returned by warn if it returns is nil. +

    +
    + +

    Examples::

    + +
    +
      (defun foo (x)
+    (let ((result (* x 2)))
+      (if (not (typep result 'fixnum))
+          (warn "You're using very big numbers."))
+      result))
+⇒  FOO
+
+  (foo 3)
+⇒  6
+
+  (foo most-positive-fixnum)
+ |>  Warning: You're using very big numbers.
+⇒  4294967294
+
+  (setq *break-on-signals* t)
+⇒  T
+
+  (foo most-positive-fixnum)
+ |>  Break: Caveat emptor.
+ |>  To continue, type :CONTINUE followed by an option number.
+ |>   1: Return from Break.
+ |>   2: Abort to Lisp Toplevel.
+ |>  Debug> :continue 1
+ |>  Warning: You're using very big numbers.
+⇒  4294967294
+
    + +

    Side Effects::

    + +

    A warning is issued. The debugger might be entered. +

    +

    Affected By::

    + +

    Existing handler bindings. +

    +

    *break-on-signals*, +*error-output*. +

    +

    Exceptional Situations::

    + +

    If datum is a condition +and if the condition is not of type warning, +or arguments is non-nil, an error of type type-error is signaled. +

    +

    If datum is a condition type, +the result of (apply #'make-condition datum arguments) +must be of type warning or an error of type type-error is signaled. +

    +

    See Also::

    + +

    *break-on-signals*, +muffle-warning +, +signal +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/warning.html b/info/gcl/warning.html new file mode 100644 index 0000000..9f8abce --- /dev/null +++ b/info/gcl/warning.html @@ -0,0 +1,64 @@ + + + + + +warning (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.2 warning [Condition Type]

    + +

    Class Precedence List::

    +

    warning, +condition, +t +

    +

    Description::

    + +

    The type warning consists of all types of warnings. +

    +

    See Also::

    + +

    style-warning +

    + + + + + diff --git a/info/gcl/when.html b/info/gcl/when.html new file mode 100644 index 0000000..f6a5114 --- /dev/null +++ b/info/gcl/when.html @@ -0,0 +1,145 @@ + + + + + +when (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    +
    +

    5.3.45 when, unless [Macro]

    + +

    when test-form {form}* ⇒ {result}* +

    +

    unless test-form {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    test-form—a form. +

    +

    forms—an implicit progn. +

    +

    results—the values of the forms + in a when form if the test-form yields true + or in an unless form if the test-form yields false; + otherwise nil. +

    +

    Description::

    + +

    when and unless allow the execution of forms +to be dependent on a single test-form. +

    +

    In a when form, +if the test-form yields true, +the forms are evaluated in order from left to right +and the values returned by the forms +are returned from the when form. +Otherwise, if the test-form yields false, +the forms are not evaluated, +and the when form returns nil. +

    +

    In an unless form, +if the test-form yields false, +the forms are evaluated in order from left to right +and the values returned by the forms +are returned from the unless form. +Otherwise, if the test-form yields false, +the forms are not evaluated, +and the unless form returns nil. +

    +

    Examples::

    + +
    +
     (when t 'hello) ⇒  HELLO
+ (unless t 'hello) ⇒  NIL
+ (when nil 'hello) ⇒  NIL
+ (unless nil 'hello) ⇒  HELLO
+ (when t) ⇒  NIL
+ (unless nil) ⇒  NIL
+ (when t (prin1 1) (prin1 2) (prin1 3))
+ |>  123
+⇒  3
+ (unless t (prin1 1) (prin1 2) (prin1 3)) ⇒  NIL
+ (when nil (prin1 1) (prin1 2) (prin1 3)) ⇒  NIL
+ (unless nil (prin1 1) (prin1 2) (prin1 3))
+ |>  123
+⇒  3
+ (let ((x 3))
+   (list (when (oddp x) (incf x) (list x))
+         (when (oddp x) (incf x) (list x))
+         (unless (oddp x) (incf x) (list x))
+         (unless (oddp x) (incf x) (list x))
+         (if (oddp x) (incf x) (list x)) 
+         (if (oddp x) (incf x) (list x)) 
+         (if (not (oddp x)) (incf x) (list x)) 
+         (if (not (oddp x)) (incf x) (list x))))
+⇒  ((4) NIL (5) NIL 6 (6) 7 (7))
+
    + +

    See Also::

    + +

    and +, +cond +, +if +, +or +

    +

    Notes::

    + +
    +
     (when test {form}^+) ≡ (and test (progn {form}^+))
+ (when test {form}^+) ≡ (cond (test {form}^+))
+ (when test {form}^+) ≡ (if test (progn {form}^+) nil)
+ (when test {form}^+) ≡ (unless (not test) {form}^+)
+ (unless test {form}^+) ≡ (cond ((not test) {form}^+))
+ (unless test {form}^+) ≡ (if test nil (progn {form}^+))
+ (unless test {form}^+) ≡ (when (not test) {form}^+)
+
    + +
    +
    +

    +Next: , Previous: , Up: Data and Control Flow Dictionary  

    +
    + + + + + diff --git a/info/gcl/wild_002dpathname_002dp.html b/info/gcl/wild_002dpathname_002dp.html new file mode 100644 index 0000000..d00b23d --- /dev/null +++ b/info/gcl/wild_002dpathname_002dp.html @@ -0,0 +1,114 @@ + + + + + +wild-pathname-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Filenames Dictionary  

    +
    +
    +

    19.4.13 wild-pathname-p [Function]

    + +

    wild-pathname-p pathname &optional field-key ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    pathname—a pathname designator. +

    +

    Field-key—one of :host, + :device + :directory, + :name, + :type, + :version, + or nil. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    wild-pathname-p tests pathname for the presence of wildcard components. +

    +

    If pathname is a pathname (as returned by pathname) +it represents the name used to open the file. This may be, but is +not required to be, the actual name of the file. +

    +

    If field-key is not supplied or nil, wild-pathname-p +returns true if pathname has any wildcard components, nil +if pathname has none. +If field-key is non-nil, wild-pathname-p +returns true if the indicated component of pathname is a wildcard, +nil if the component is not a wildcard. +

    +

    Examples::

    +
    +
     ;;;The following examples are not portable.  They are written to run
+ ;;;with particular file systems and particular wildcard conventions.
+ ;;;Other implementations will behave differently.  These examples are
+ ;;;intended to be illustrative, not to be prescriptive.
+
+ (wild-pathname-p (make-pathname :name :wild)) ⇒  true
+ (wild-pathname-p (make-pathname :name :wild) :name) ⇒  true
+ (wild-pathname-p (make-pathname :name :wild) :type) ⇒  false
+ (wild-pathname-p (pathname "s:>foo>**>")) ⇒  true ;Lispm
+ (wild-pathname-p (pathname :name "F*O")) ⇒  true ;Most places
+
    + +

    Exceptional Situations::

    + +

    If pathname is not a pathname, a string, +or a stream associated with a file an error of type type-error is signaled. +

    +

    See Also::

    + +

    pathname, +logical-pathname, +File System Concepts, +

    +

    Pathnames as Filenames +

    +

    Notes::

    + +

    Not all implementations support wildcards in all fields. +See ->WILD as a Component Value and Restrictions on Wildcard Pathnames. +

    + + + + + diff --git a/info/gcl/with_002daccessors.html b/info/gcl/with_002daccessors.html new file mode 100644 index 0000000..485daf9 --- /dev/null +++ b/info/gcl/with_002daccessors.html @@ -0,0 +1,165 @@ + + + + + +with-accessors (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.23 with-accessors [Macro]

    + +

    with-accessors ({slot-entry}*) + instance-form + {declaration}* {form}*
    + ⇒ {result}* +

    +

    slot-entry ::=(variable-name accessor-name ) +

    +

    Arguments and Values::

    + +

    variable-name—a variable name; not evaluated. +

    +

    accessor-name—a function name; not evaluated. +

    +

    instance-form—a form; evaluated. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    Creates a lexical environment in which +the slots specified by +slot-entry are lexically available through their accessors as if +they were variables. The macro with-accessors invokes the +appropriate accessors to access the slots specified +by slot-entry. Both setf +and setq can be used to set the value of the slot. +

    +

    Examples::

    + +
    +
     (defclass thing ()
+           ((x :initarg :x :accessor thing-x)
+            (y :initarg :y :accessor thing-y)))
+⇒  #<STANDARD-CLASS THING 250020173>
+ (defmethod (setf thing-x) :before (new-x (thing thing))
+   (format t "~&Changing X from ~D to ~D in ~S.~
+           (thing-x thing) new-x thing))
+ (setq thing1 (make-instance 'thing :x 1 :y 2)) ⇒  #<THING 43135676>
+ (setq thing2 (make-instance 'thing :x 7 :y 8)) ⇒  #<THING 43147374>
+ (with-accessors ((x1 thing-x) (y1 thing-y))
+                 thing1
+   (with-accessors ((x2 thing-x) (y2 thing-y))
+                   thing2
+     (list (list x1 (thing-x thing1) y1 (thing-y thing1)
+                 x2 (thing-x thing2) y2 (thing-y thing2))
+           (setq x1 (+ y1 x2))
+           (list x1 (thing-x thing1) y1 (thing-y thing1)
+                 x2 (thing-x thing2) y2 (thing-y thing2))
+           (setf (thing-x thing2) (list x1))
+           (list x1 (thing-x thing1) y1 (thing-y thing1)
+                 x2 (thing-x thing2) y2 (thing-y thing2)))))
+ |>  Changing X from 1 to 9 in #<THING 43135676>.
+ |>  Changing X from 7 to (9) in #<THING 43147374>.
+⇒  ((1 1 2 2 7 7 8 8)
+     9
+     (9 9 2 2 7 7 8 8) 
+     (9)
+     (9 9 2 2 (9) (9) 8 8))
+
    + +

    Affected By::

    + +

    defclass +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if any accessor-name is not the name +of an accessor for the instance. +

    +

    See Also::

    + +

    with-slots +, +symbol-macrolet +

    +

    Notes::

    + +

    A with-accessors expression of the form: +

    +
    +
    +
+(with-accessors (slot-entry_1 ...slot-entry_n) instance-form form_1 ...form_k)
+
+
    + +

    expands into the equivalent of +

    +
    +
    +
+(let ((in instance-form))
+
+ (symbol-macrolet (Q_1... Q_n) form_1 ...form_k))
+
+
    + +

    where Q_i is +

    +
    +
    (variable-name_i () 
+(accessor-name_i in))
+
    + + +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dcompilation_002dunit.html b/info/gcl/with_002dcompilation_002dunit.html new file mode 100644 index 0000000..90a1e45 --- /dev/null +++ b/info/gcl/with_002dcompilation_002dunit.html @@ -0,0 +1,124 @@ + + + + + +with-compilation-unit (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    +
    +

    24.2.4 with-compilation-unit [Macro]

    + +

    with-compilation-unit ([[!option]]) + {form}* ⇒ {result}* +

    +

    option ::=:override override +

    +

    Arguments and Values::

    + +

    override—a generalized boolean; evaluated. + The default is nil. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    Executes forms from left to right. +Within the dynamic environment of with-compilation-unit, +actions deferred by the compiler until the end of compilation will be +deferred until the end of the outermost call to with-compilation-unit. +

    +

    The set of options permitted may be extended by the implementation, +but the only standardized keyword is :override. +

    +

    If nested dynamically only the outer call to +with-compilation-unit has any effect unless the value +associated with :override is true, in which case warnings are +deferred only to the end of the innermost call for which override is true. +

    +

    The function compile-file +provides the effect of +

    +
    +
     (with-compilation-unit (:override nil) ...)
+
    + +

    around its code. +

    +

    Any implementation-dependent extensions can only be provided as the +result of an explicit programmer request by use of an +implementation-dependent keyword. Implementations are forbidden +from attaching additional meaning to a use of this macro which involves either +no keywords or just the keyword :override. +

    +

    Examples::

    + +

    If an implementation would normally defer certain kinds of warnings, +such as warnings about undefined functions, to the end of a compilation +unit (such as a file), the following example shows how to cause those +warnings to be deferred to the end of the compilation of several files. +

    +
    +
     (defun compile-files (&rest files)
+   (with-compilation-unit ()
+     (mapcar #'(lambda (file) (compile-file file)) files)))
+
+ (compile-files "A" "B" "C")
+
    + +

    Note however that if the implementation does not normally defer any warnings, +use of with-compilation-unit might not have any effect. +

    +

    See Also::

    + +

    compile +, +compile-file +

    +
    +
    +

    +Next: , Previous: , Up: System Construction Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dcondition_002drestarts.html b/info/gcl/with_002dcondition_002drestarts.html new file mode 100644 index 0000000..5e29890 --- /dev/null +++ b/info/gcl/with_002dcondition_002drestarts.html @@ -0,0 +1,91 @@ + + + + + +with-condition-restarts (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.39 with-condition-restarts [Macro]

    + +

    with-condition-restarts condition-form restarts-form {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    condition-form—a form; evaluated to produce a condition. +

    +

    condition—a condition object resulting from the + evaluation of condition-form. +

    +

    restart-form—a form; evaluated to produce a restart-list. +

    +

    restart-list—a list of restart objects resulting + from the evaluation of restart-form. +

    +

    forms—an implicit progn; evaluated. +

    +

    results—the values returned by forms. +

    +

    Description::

    + +

    First, the condition-form and restarts-form are evaluated +in normal left-to-right order; the primary values yielded by these +evaluations are respectively called the condition +and the restart-list. +

    +

    Next, the forms are evaluated in a dynamic environment +in which each restart in restart-list is associated with +the condition. See Associating a Restart with a Condition. +

    +

    See Also::

    + +

    restart-case +

    +

    Notes::

    + +

    Usually this macro is not used explicitly in code, +since restart-case handles most of the common cases +in a way that is syntactically more concise. +

    + + + + + diff --git a/info/gcl/with_002dhash_002dtable_002diterator.html b/info/gcl/with_002dhash_002dtable_002diterator.html new file mode 100644 index 0000000..7b39f40 --- /dev/null +++ b/info/gcl/with_002dhash_002dtable_002diterator.html @@ -0,0 +1,155 @@ + + + + + +with-hash-table-iterator (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    +
    +

    18.2.12 with-hash-table-iterator [Macro]

    + +

    with-hash-table-iterator (name hash-table) + {declaration}* {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    name—a name suitable for the first argument to macrolet. +

    +

    hash-table—a form, evaluated once, that should produce a hash table. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by forms. +

    +

    Description::

    + +

    Within the lexical scope of the body, name is defined via macrolet +such that successive invocations of (name) return the items, +one by one, from the hash table that is obtained by evaluating +hash-table only once. +

    +

    An invocation (name) returns three values as follows: +

    +
    +
    1.
    +

    A generalized boolean that is true if an entry is returned. +

    +
    2.
    +

    The key from the hash-table entry. +

    +
    3.
    +

    The value from the hash-table entry. +

    +
    + +

    After all entries have been returned by successive invocations of +(name), then only one value is returned, namely nil. +

    +

    It is unspecified what happens if any of the implicit interior state +of an iteration is returned outside the dynamic extent of the +with-hash-table-iterator form +such as by returning some closure over the invocation form. +

    +

    Any number of invocations of with-hash-table-iterator +can be nested, and the body of the innermost one can invoke all of the +locally established macros, provided all of those macros +have distinct names. +

    +

    Examples::

    + +

    The following function should return t on any +hash table, and signal +an error if the usage of with-hash-table-iterator does not agree +with the corresponding usage of maphash. +

    +
    +
     (defun test-hash-table-iterator (hash-table)
+   (let ((all-entries '())
+         (generated-entries '())
+         (unique (list nil)))
+     (maphash #'(lambda (key value) (push (list key value) all-entries))
+              hash-table)
+     (with-hash-table-iterator (generator-fn hash-table)
+       (loop     
+         (multiple-value-bind (more? key value) (generator-fn)
+           (unless more? (return))
+           (unless (eql value (gethash key hash-table unique))
+             (error "Key ~S not found for value ~S" key value))
+           (push (list key value) generated-entries))))
+     (unless (= (length all-entries)
+                (length generated-entries)
+                (length (union all-entries generated-entries
+                               :key #'car :test (hash-table-test hash-table))))
+       (error "Generated entries and Maphash entries don't correspond"))
+     t))
+
    + +

    The following could be an acceptable definition of +maphash, implemented by with-hash-table-iterator. +

    +
    +
     (defun maphash (function hash-table)
+   (with-hash-table-iterator (next-entry hash-table)
+     (loop (multiple-value-bind (more key value) (next-entry)
+             (unless more (return nil))
+             (funcall function key value)))))
+
    + +

    Exceptional Situations::

    + +

    The consequences are undefined if the local function named name +established by with-hash-table-iterator is called after it has +returned false as its primary value. +

    +

    See Also::

    + +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Hash Tables Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dinput_002dfrom_002dstring.html b/info/gcl/with_002dinput_002dfrom_002dstring.html new file mode 100644 index 0000000..d6bcda5 --- /dev/null +++ b/info/gcl/with_002dinput_002dfrom_002dstring.html @@ -0,0 +1,142 @@ + + + + + +with-input-from-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.51 with-input-from-string [Macro]

    + +

    with-input-from-string (var string &key index start end) + {declaration}* + {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a variable name. +

    +

    string—a form; evaluated to produce a string. +

    +

    index—a place. +

    +

    start, end—bounding index designators of string. + The defaults for start and end are 0 and nil, respectively. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    result—the values returned by the forms. +

    +

    Description::

    + +

    Creates an +

    +

    input string stream, +

    +

    provides an opportunity to perform operations on the stream + (returning zero or more values), +and then closes the string stream. +

    +

    String is evaluated first, and var is bound to +a character input string stream that supplies +characters from the subsequence of the resulting string bounded by +start and end. +The body is executed as an implicit progn. +

    +

    The input string stream is automatically closed on exit from +with-input-from-string, no matter whether the exit is normal or abnormal. +

    +

    The input string stream to which the variable var +is bound has dynamic extent; +its extent ends when the form is exited. +

    +

    The index is a pointer within the string to be advanced. +If with-input-from-string +is exited normally, then index will have +as its value +the index into the string indicating the first character not read +which is (length string) if all characters were used. +The place specified by index +is not updated as reading progresses, but only at the +end of the operation. +

    +

    start and index may both specify the same variable, +which is a pointer within the string to be advanced, +perhaps repeatedly by some containing loop. +

    +

    The consequences are undefined if an attempt is made to assign +the variable var. +

    +

    Examples::

    +
    +
     (with-input-from-string (s "XXX1 2 3 4xxx"
+                             :index ind
+                             :start 3 :end 10)
+    (+ (read s) (read s) (read s))) ⇒  6
+ ind ⇒  9
+ (with-input-from-string (s "Animal Crackers" :index j :start 6)
+   (read s)) ⇒  CRACKERS
+
    + +

    The variable j is set to 15. +

    +

    Side Effects::

    + +

    The value of the place named by index, if any, is modified. +

    +

    See Also::

    + +

    make-string-input-stream +, +

    +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dopen_002dfile.html b/info/gcl/with_002dopen_002dfile.html new file mode 100644 index 0000000..e77ae5d --- /dev/null +++ b/info/gcl/with_002dopen_002dfile.html @@ -0,0 +1,170 @@ + + + + + +with-open-file (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.31 with-open-file [macro]

    + +

    Syntax::

    + +

    with-open-file (stream filespec {options}*) + {declaration}* + {form}*
    + ⇒ results +

    +

    Arguments and Values::

    + +

    stream – a variable. +

    +

    filespec—a pathname designator. +

    +

    options – forms; evaluated. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    with-open-file uses open to create a file stream +

    +

    to file named by filespec. +Filespec is the name of the file to be opened. +Options are used as keyword arguments to open. +

    +

    The stream object to which the stream variable +is bound has dynamic extent; +its extent ends when the form is exited. +

    +

    with-open-file evaluates the forms as an implicit progn +with stream bound to +

    +

    the value returned by open. +

    +

    When control leaves the body, either normally or abnormally (such as by +use of throw), the file is automatically closed. If a new +output file is being written, and control leaves abnormally, the file is +aborted and the file system is left, so far as possible, as if the file +had never been opened. +

    +

    It is possible by the use of :if-exists nil +or :if-does-not-exist nil for +stream to be bound to nil. +

    +

    Users of :if-does-not-exist nil should check for a valid stream. +

    +

    The consequences are undefined if an attempt is made to assign the +stream variable. The compiler may choose to issue a +warning if such an attempt is detected. +

    +

    Examples::

    + +
    +
     (setq p (merge-pathnames "test"))
+⇒  #<PATHNAME :HOST NIL :DEVICE device-name :DIRECTORY directory-name
+    :NAME "test" :TYPE NIL :VERSION :NEWEST>
+ (with-open-file (s p :direction :output :if-exists :supersede)
+    (format s "Here are a couple~
+ (with-open-file (s p)
+    (do ((l (read-line s) (read-line s nil 'eof)))
+        ((eq l 'eof) "Reached end of file.")
+     (format t "~&*** ~A~
+ |>  *** Here are a couple
+ |>  *** of test data lines
+⇒  "Reached end of file."
+
    + +
    +
    ;; Normally one would not do this intentionally because it is
+;; not perspicuous, but beware when using :IF-DOES-NOT-EXIST NIL
+;; that this doesn't happen to you accidentally...
+ (with-open-file (foo "no-such-file" :if-does-not-exist nil)
+   (read foo))
+ |>  |>>hello?<<|
+⇒  HELLO? ;This value was read from the terminal, not a file!
+
+;; Here's another bug to avoid...
+ (with-open-file (foo "no-such-file" :direction :output :if-does-not-exist nil)
+   (format foo "Hello"))
+⇒  "Hello" ;FORMAT got an argument of NIL!
+
    + +

    Side Effects::

    + +

    Creates a stream to the file named by filename (upon entry), +and closes the stream (upon exit). +In some implementations, +the file might be locked in some way while it is open. +If the stream is an output stream, +a file might be created. +

    +

    Affected By::

    + +

    The host computer’s file system. +

    +

    Exceptional Situations::

    + +

    See the function open. +

    +

    See Also::

    + +

    open +, +close +, +pathname, +logical-pathname, +

    +

    Pathnames as Filenames +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dopen_002dstream.html b/info/gcl/with_002dopen_002dstream.html new file mode 100644 index 0000000..a8bb5cd --- /dev/null +++ b/info/gcl/with_002dopen_002dstream.html @@ -0,0 +1,101 @@ + + + + + +with-open-stream (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.33 with-open-stream [Macro]

    + +

    with-open-stream (var stream) + {declaration}* + {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a variable name. +

    +

    stream—a form; evaluated to produce a stream. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    with-open-stream performs a series of operations on +stream, returns a value, and then closes the stream. +

    +

    Var is bound to the value of stream, +and then forms are executed +as an implicit progn. +stream +is automatically closed on exit from with-open-stream, +no matter whether the exit is normal or abnormal. +

    +

    The stream has dynamic extent; +its extent ends when the form is exited. +

    +

    The consequences are undefined if an attempt is made to assign the +the variable var with the forms. +

    +

    Examples::

    + +
    +
     (with-open-stream (s (make-string-input-stream "1 2 3 4"))
+    (+ (read s) (read s) (read s))) ⇒  6
+
    + +

    Side Effects::

    + +

    The stream is closed (upon exit). +

    +

    See Also::

    + +

    close +

    + + + + + diff --git a/info/gcl/with_002doutput_002dto_002dstring.html b/info/gcl/with_002doutput_002dto_002dstring.html new file mode 100644 index 0000000..7090dca --- /dev/null +++ b/info/gcl/with_002doutput_002dto_002dstring.html @@ -0,0 +1,147 @@ + + + + + +with-output-to-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.52 with-output-to-string [Macro]

    + +

    with-output-to-string (var &optional string-form &key element-type) + {declaration}* + {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    var—a variable name. +

    +

    string-form—a form or nil; + if non-nil, evaluated to produce string. +

    +

    string—a string that has a fill pointer. +

    +

    element-type—a type specifier; evaluated. +

    +

    The default is character. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—If a string-form is not supplied or nil, + a string; otherwise, + the values returned by the forms. +

    +

    Description::

    + +

    with-output-to-string creates a +

    +

    character output stream, performs a series of operations +that may send results to this stream, and then closes the stream. +

    +

    The element-type names the type of the elements +of the stream; a stream is constructed of the most specialized +type that can accommodate elements of the given type. +

    +

    The body is executed as an implicit progn with var +bound to an output string stream. +All output to that string stream is saved in a string. +

    +

    If string is supplied, element-type is ignored, +and the output is incrementally appended to string as +if by use of vector-push-extend. +

    +

    The output stream +is automatically closed on exit from with-output-from-string, +no matter whether the exit is normal or abnormal. +

    +

    The output string stream to which the variable var +is bound has dynamic extent; +its extent ends when the form is exited. +

    +

    If no string is provided, then with-output-from-string +

    +

    produces a stream that accepts characters and returns a string +of the indicated element-type. +

    +

    If string is provided, +with-output-to-string returns the results of evaluating the last form. +

    +

    The consequences are undefined if an attempt is made to assign +the variable var. +

    +

    Examples::

    +
    +
     (setq fstr (make-array '(0) :element-type 'base-char
+                             :fill-pointer 0 :adjustable t)) ⇒  ""
+ (with-output-to-string (s fstr)
+    (format s "here's some output")
+    (input-stream-p s)) ⇒  false
+ fstr ⇒  "here's some output"
+
    + +

    Side Effects::

    + +

    The string is modified. +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if destructive modifications are performed +directly on the string during the dynamic extent of the call. +

    +

    See Also::

    + +

    make-string-output-stream +, +vector-push-extend, +

    +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dpackage_002diterator.html b/info/gcl/with_002dpackage_002diterator.html new file mode 100644 index 0000000..517dc35 --- /dev/null +++ b/info/gcl/with_002dpackage_002diterator.html @@ -0,0 +1,234 @@ + + + + + +with-package-iterator (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    +
    +

    11.2.13 with-package-iterator [Macro]

    + +

    with-package-iterator (name package-list-form &rest symbol-types) + {declaration}* {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    name—a symbol. +

    +

    package-list-form—a form; evaluated once to produce a package-list. +

    +

    package-list—a designator for a list of package designators. +

    +

    symbol-type—one of the symbols + :internal, :external, or :inherited. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values of the forms. +

    +

    Description::

    + +

    Within the lexical scope of the body forms, +the name is defined via macrolet +such that successive invocations of (name) +will return the symbols, one by one, +from the packages in package-list. +

    +

    It is unspecified whether symbols inherited from +multiple packages are returned more than once. +The order of symbols returned does not necessarily reflect the order +of packages in package-list. When package-list has +more than one element, it is unspecified whether duplicate symbols are +returned once or more than once. +

    +

    Symbol-types controls which symbols that are accessible +in a package are returned as follows: +

    +
    +
    :internal
    +

    The symbols that are present in the package, + but that are not exported. +

    +
    +
    :external
    +

    The symbols that are present in the package + and are exported. +

    +
    +
    :inherited
    +

    The symbols that are exported by used packages + and that are not shadowed. +

    +
    + +

    When more than one argument is supplied for symbol-types, +a symbol is returned if its accessibility matches +any one of the symbol-types supplied. +Implementations may extend this syntax by recognizing additional +symbol accessibility types. +

    +

    An invocation of (name) returns four values as follows: +

    +
    +
    1.
    +

    A flag that indicates whether a symbol is returned + (true means that a symbol is returned). +

    +
    2.
    +

    A symbol that is accessible in one the + indicated packages. +

    +
    3.
    +

    The accessibility type for that symbol; + i.e., one of the symbols :internal, :external, or :inherited. +

    +
    4.
    +

    The package from which the symbol was obtained. + The package is one of the packages present + or named in package-list. +

    +
    + +

    After all symbols have been returned by successive invocations of +(name), then only one value is returned, namely nil. +

    +

    The meaning of the second, third, and fourth values is that the returned +symbol is accessible in the returned package +in the way indicated by the second return value as follows: +

    +
    +
    :internal
    +

    Means present and not exported. +

    +
    +
    :external
    +

    Means present and exported. +

    +
    +
    :inherited
    +

    Means not present (thus not shadowed) but inherited +from some used package. +

    +
    + +

    It is unspecified what happens if any of the implicit interior state +of an iteration is returned outside the dynamic extent of the +with-package-iterator +form such as by returning some closure over the invocation form. +

    +

    Any number of invocations of with-package-iterator +can be nested, and the body of the innermost one can invoke all of the +locally established macros, provided all those macros +have distinct names. +

    +

    Examples::

    + +

    The following function should return t on any package, and signal +an error if the usage of with-package-iterator does not agree +with the corresponding usage of do-symbols. +

    +
    +
     (defun test-package-iterator (package)
+   (unless (packagep package)
+     (setq package (find-package package)))
+   (let ((all-entries '())
+         (generated-entries '()))
+     (do-symbols (x package) 
+       (multiple-value-bind (symbol accessibility) 
+           (find-symbol (symbol-name x) package)
+         (push (list symbol accessibility) all-entries)))
+     (with-package-iterator (generator-fn package 
+                             :internal :external :inherited)
+       (loop     
+         (multiple-value-bind (more? symbol accessibility pkg)
+             (generator-fn)
+           (unless more? (return))
+           (let ((l (multiple-value-list (find-symbol (symbol-name symbol) 
+                                                      package))))
+             (unless (equal l (list symbol accessibility))
+               (error "Symbol ~S not found as ~S in package ~A [~S]"
+                      symbol accessibility (package-name package) l))
+             (push l generated-entries)))))
+     (unless (and (subsetp all-entries generated-entries :test #'equal)
+                  (subsetp generated-entries all-entries :test #'equal))
+      (error "Generated entries and Do-Symbols entries don't correspond"))
+     t))
+
    + +

    The following function prints out every present symbol +(possibly more than once): +

    +
    +
     (defun print-all-symbols () 
+   (with-package-iterator (next-symbol (list-all-packages)
+                           :internal :external)
+     (loop
+       (multiple-value-bind (more? symbol) (next-symbol)
+         (if more? 
+            (print symbol)
+            (return))))))
+
    + +

    Exceptional Situations::

    + +

    with-package-iterator signals an error of type program-error if +no symbol-types are supplied or if a symbol-type is not +recognized by the implementation is supplied. +

    +

    The consequences are undefined if the local function named name +established by with-package-iterator is called after it +has returned false as its primary value. +

    +

    See Also::

    + +

    Traversal Rules and Side Effects +

    +
    +
    +

    +Next: , Previous: , Up: Packages Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dsimple_002drestart.html b/info/gcl/with_002dsimple_002drestart.html new file mode 100644 index 0000000..c55794b --- /dev/null +++ b/info/gcl/with_002dsimple_002drestart.html @@ -0,0 +1,161 @@ + + + + + +with-simple-restart (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    +
    +

    9.2.40 with-simple-restart [Macro]

    + +

    with-simple-restart (name format-control {format-argument}*) + {form}*
    + ⇒ {result}* +

    +

    Arguments and Values::

    + +

    name—a symbol. +

    +

    format-control—a format control. +

    +

    format-argument—an object (i.e., a format argument). +

    +

    forms—an implicit progn. +

    +

    results—in the normal situation, + the values returned by the forms; + in the exceptional situation where the restart named name is invoked, + two values—nil and t. +

    +

    Description::

    + +

    with-simple-restart establishes a restart. +

    +

    If the restart designated by name is not invoked while executing forms, +all values returned by the last of forms are returned. +If the restart designated by name is invoked, +control is transferred to with-simple-restart, +which returns two values, nil and t. +

    +

    If name is nil, an anonymous restart is established. +

    +

    The format-control and format-arguments are used +report the restart. +

    +

    Examples::

    + +
    +
     (defun read-eval-print-loop (level)
+   (with-simple-restart (abort "Exit command level ~D." level)
+     (loop
+       (with-simple-restart (abort "Return to command level ~D." level)
+         (let ((form (prog2 (fresh-line) (read) (fresh-line))))
+           (prin1 (eval form)))))))
+⇒  READ-EVAL-PRINT-LOOP
+ (read-eval-print-loop 1)
+ (+ 'a 3)
+ |>  Error: The argument, A, to the function + was of the wrong type.
+ |>         The function expected a number.
+ |>  To continue, type :CONTINUE followed by an option number:
+ |>   1: Specify a value to use this time.
+ |>   2: Return to command level 1.
+ |>   3: Exit command level 1.
+ |>   4: Return to Lisp Toplevel.
+
    + +
    +
     (defun compute-fixnum-power-of-2 (x)
+   (with-simple-restart (nil "Give up on computing 2^~D." x)
+     (let ((result 1))
+       (dotimes (i x result)
+         (setq result (* 2 result))
+         (unless (fixnump result)
+           (error "Power of 2 is too large."))))))
+COMPUTE-FIXNUM-POWER-OF-2
+ (defun compute-power-of-2 (x)
+   (or (compute-fixnum-power-of-2 x) 'something big))
+COMPUTE-POWER-OF-2
+ (compute-power-of-2 10)
+1024
+ (compute-power-of-2 10000)
+ |>  Error: Power of 2 is too large.
+ |>  To continue, type :CONTINUE followed by an option number.
+ |>   1: Give up on computing 2^10000.
+ |>   2: Return to Lisp Toplevel
+ |>  Debug> |>>:continue 1<<|
+⇒  SOMETHING-BIG
+
    + +

    See Also::

    + +

    restart-case +

    +

    Notes::

    + +

    with-simple-restart is shorthand for one of the most +common uses of restart-case. +

    +

    with-simple-restart could be defined by: +

    +
    +
     (defmacro with-simple-restart ((restart-name format-control
+                                              &rest format-arguments)
+                                &body forms)
+   `(restart-case (progn ,@forms)
+      (,restart-name ()
+          :report (lambda (stream)
+                    (format stream ,format-control ,@format-arguments))
+         (values nil t))))
+
    + +

    Because the second return value is t in the exceptional case, +it is common (but not required) to arrange for the second return value +in the normal case to be missing or nil so that the two situations +can be distinguished. +

    +
    +
    +

    +Next: , Previous: , Up: Conditions Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dslots.html b/info/gcl/with_002dslots.html new file mode 100644 index 0000000..421dfba --- /dev/null +++ b/info/gcl/with_002dslots.html @@ -0,0 +1,191 @@ + + + + + +with-slots (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    +
    +

    7.7.24 with-slots [Macro]

    + +

    with-slots ({slot-entry}*) + instance-form + {declaration}* {form}*
    + ⇒ {result}* +

    +

    slot-entry ::=slot-name | (variable-name slot-name) +

    +

    Arguments and Values::

    + +

    slot-name—a slot name; not evaluated. +

    +

    variable-name—a variable name; not evaluated. +

    +

    instance-form—a form; evaluted to produce instance. +

    +

    instance—an object. +

    +

    declaration—a declare expression; not evaluated. +

    +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    The macro with-slots establishes a +lexical environment +for referring to the slots in the instance +named by the given slot-names +as though they were variables. Within such a context +the value of the slot can be specified by using its slot name, as if +it were a lexically bound variable. Both setf and setq +can be used to set the value of the slot. +

    +

    The macro with-slots translates an appearance of the slot +name as a variable into a call to slot-value. +

    +

    Examples::

    + +
    +
     (defclass thing ()
+           ((x :initarg :x :accessor thing-x)
+            (y :initarg :y :accessor thing-y)))
+⇒  #<STANDARD-CLASS THING 250020173>
+ (defmethod (setf thing-x) :before (new-x (thing thing))
+   (format t "~&Changing X from ~D to ~D in ~S.~
+           (thing-x thing) new-x thing))
+ (setq thing (make-instance 'thing :x 0 :y 1)) ⇒  #<THING 62310540>
+ (with-slots (x y) thing (incf x) (incf y)) ⇒  2
+ (values (thing-x thing) (thing-y thing)) ⇒  1, 2
+ (setq thing1 (make-instance 'thing :x 1 :y 2)) ⇒  #<THING 43135676>
+ (setq thing2 (make-instance 'thing :x 7 :y 8)) ⇒  #<THING 43147374>
+ (with-slots ((x1 x) (y1 y))
+             thing1
+   (with-slots ((x2 x) (y2 y))
+               thing2
+     (list (list x1 (thing-x thing1) y1 (thing-y thing1)
+                 x2 (thing-x thing2) y2 (thing-y thing2))
+           (setq x1 (+ y1 x2))
+           (list x1 (thing-x thing1) y1 (thing-y thing1)
+                 x2 (thing-x thing2) y2 (thing-y thing2))
+           (setf (thing-x thing2) (list x1))
+           (list x1 (thing-x thing1) y1 (thing-y thing1)
+                 x2 (thing-x thing2) y2 (thing-y thing2)))))
+ |>  Changing X from 7 to (9) in #<THING 43147374>.
+⇒  ((1 1 2 2 7 7 8 8)
+     9
+     (9 9 2 2 7 7 8 8) 
+     (9)
+     (9 9 2 2 (9) (9) 8 8))
+
    + +

    Affected By::

    + +

    defclass +

    +

    Exceptional Situations::

    + +

    The consequences are undefined if any slot-name is not the name +of a slot in the instance. +

    +

    See Also::

    + +

    with-accessors +, +slot-value +, +symbol-macrolet +

    +

    Notes::

    + +

    A with-slots expression of the form: +

    +
    +
    +
+(with-slots (slot-entry_1 ...slot-entry_n) instance-form form_1 ...form_k)
+
+
    + +

    expands into the equivalent of +

    +
    +
    +
+(let ((in instance-form))
+
+ (symbol-macrolet (Q_1... Q_n) form_1 ...form_k))
+
+
    + +

    where Q_i is +

    +
    +
    (slot-entry_i () 
+(slot-value in 'slot-entry_i))
+
    + +

    if slot-entry_i is a symbol +and is +

    +
    +
    (variable-name_i () 
+(slot-value in 'slot-name_i))
+
    + + +

    if slot-entry_i +is of the form +

    +
    +
    (variable-name_i 
+slot-name_i)
+
    + +
    +
    +

    +Next: , Previous: , Up: Objects Dictionary  

    +
    + + + + + diff --git a/info/gcl/with_002dstandard_002dio_002dsyntax.html b/info/gcl/with_002dstandard_002dio_002dsyntax.html new file mode 100644 index 0000000..d08aa06 --- /dev/null +++ b/info/gcl/with_002dstandard_002dio_002dsyntax.html @@ -0,0 +1,111 @@ + + + + + +with-standard-io-syntax (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Reader Dictionary  

    +
    +
    +

    23.2.12 with-standard-io-syntax [Macro]

    + +

    with-standard-io-syntax {form}* ⇒ {result}* +

    +

    Arguments and Values::

    + +

    forms—an implicit progn. +

    +

    results—the values returned by the forms. +

    +

    Description::

    + +

    Within the dynamic extent of the body of forms, all reader/printer control +variables, including any implementation-defined ones not specified by +this standard, are bound to values that produce standard read/print +behavior. The values for the variables specified by this standard are listed in +Figure 23–1. +

    +

    [Reviewer Note by Barrett: *print-pprint-dispatch* should probably be mentioned here, too.] +

    +
    +
      Variable                     Value                               
+  *package*                    The CL-USER package                 
+  *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*      The standard pprint dispatch table  
+  *print-pretty*               nil                                 
+  *print-radix*                nil                                 
+  *print-readably*             t                                   
+  *print-right-margin*         nil                                 
+  *read-base*                  10                                  
+  *read-default-float-format*  single-float                        
+  *read-eval*                  t                                   
+  *read-suppress*              nil                                 
+  *readtable*                  The standard readtable              
+
+         Figure 23–1: Values of standard control variables        
+
+
    + +

    Examples::

    + +
    +
     (with-open-file (file pathname :direction :output)
+   (with-standard-io-syntax
+     (print data file)))
+
+;;; ... Later, in another Lisp:
+
+ (with-open-file (file pathname :direction :input)
+   (with-standard-io-syntax
+     (setq data (read file))))
+
    + + + + + + diff --git a/info/gcl/write.html b/info/gcl/write.html new file mode 100644 index 0000000..3e513dc --- /dev/null +++ b/info/gcl/write.html @@ -0,0 +1,207 @@ + + + + + +write (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.14 write, prin1, print, pprint, princ [Function]

    + +

    write object &key \writekeysstream
    + ⇒ object +

    +

    prin 1 ⇒ object &optional output-stream + object +princ object &optional output-stream ⇒ object +

    +

    print object &optional output-stream ⇒ object +

    +

    pprint object &optional output-stream ⇒ <no values> +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    output-stream—an output stream designator. + The default is standard output. +

    +

    \writekeydescriptionsstream—an output stream designator. +The default is standard output. +

    +

    Description::

    + +

    write, prin1, princ, print, and pprint +write the printed representation of object to output-stream. +

    +

    write is the general entry point to the Lisp printer. +For each explicitly supplied keyword parameter named in Figure 22–6, +the corresponding printer control variable is dynamically bound to its value +while printing goes on; +for each keyword parameter in Figure 22–6 that is not explicitly supplied, +the value of the corresponding printer control variable is the same as it was +at the time write was invoked. +Once the appropriate bindings are established, +the object is output by the Lisp printer. +

    +
    +
      Parameter        Corresponding Dynamic Variable  
+  array            *print-array*                   
+  base             *print-base*                    
+  case             *print-case*                    
+  circle           *print-circle*                  
+  escape           *print-escape*                  
+  gensym           *print-gensym*                  
+  length           *print-length*                  
+  level            *print-level*                   
+  lines            *print-lines*                   
+  miser-width      *print-miser-width*             
+  pprint-dispatch  *print-pprint-dispatch*         
+  pretty           *print-pretty*                  
+  radix            *print-radix*                   
+  readably         *print-readably*                
+  right-margin     *print-right-margin*            
+
+  Figure 22–6: Argument correspondences for the WRITE function.
+
+
    + +

    prin1, princ, print, and pprint implicitly +bind certain print parameters to particular values. The remaining parameter +values are taken from + *print-array*, + *print-base*, + *print-case*, + *print-circle*, + *print-escape*, + *print-gensym*, + *print-length*, + *print-level*, + *print-lines*, + *print-miser-width*, + *print-pprint-dispatch*, + *print-pretty*, + *print-radix*, + and *print-right-margin*. +

    +

    prin1 produces output suitable for input to read. +It binds *print-escape* to true. +

    +

    princ is just like prin1 except that the +output has no escape characters. +It binds *print-escape* to false +

    +

    and *print-readably* to false. +

    +

    The general rule is that output from princ is intended to look +good to people, while output from prin1 is intended to +be acceptable to read. +

    +

    print is just like prin1 +except that the printed representation +of object is preceded by a newline +and followed by a space. +

    +

    pprint is just like print except that the trailing +space is omitted and +object is printed with the *print-pretty* flag non-nil +to produce pretty output. +

    +

    Output-stream specifies the stream to which +output is to be sent. +

    +

    Affected By::

    + +

    *standard-output*, +*terminal-io*, +*print-escape*, +*print-radix*, +*print-base*, +*print-circle*, +*print-pretty*, +*print-level*, +*print-length*, +*print-case*, +*print-gensym*, +*print-array*, +*read-default-float-format*. +

    +

    See Also::

    + +

    readtable-case +, +FORMAT Printer Operations +

    +

    Notes::

    + +

    The functions prin1 and print do not bind *print-readably*. +

    +
    +
     (prin1 object output-stream)
+≡ (write object :stream output-stream :escape t)
+
    + +
    +
     (princ object output-stream)
+≡ (write object stream output-stream :escape nil :readably nil)
+
    + +
    +
     (print object output-stream)
+≡ (progn (terpri output-stream)
+           (write object :stream output-stream
+                         :escape t)
+           (write-char #\space output-stream))
+
    + +
    +
     (pprint object output-stream)
+≡ (write object :stream output-stream :escape t :pretty t)
+
    + +
    +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    + + + + + diff --git a/info/gcl/write_002dbyte.html b/info/gcl/write_002dbyte.html new file mode 100644 index 0000000..b3b1fd1 --- /dev/null +++ b/info/gcl/write_002dbyte.html @@ -0,0 +1,100 @@ + + + + + +write-byte (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.15 write-byte [Function]

    + +

    write-byte byte stream ⇒ byte +

    +

    Arguments and Values::

    + +

    byte—an integer of the stream element type + of stream. +

    +

    stream—a binary output stream. +

    +

    Description::

    + +

    write-byte writes one byte, byte, to stream. +

    +

    Examples::

    + +
    +
     (with-open-file (s "temp-bytes" 
+                    :direction :output
+                    :element-type 'unsigned-byte)
+    (write-byte 101 s)) ⇒  101
+
    + +

    Side Effects::

    + +

    stream is modified. +

    +

    Affected By::

    + +

    The element type of the stream. +

    +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if stream is not a stream. +Should signal an error of type error +if stream is not a binary output stream. +

    +

    Might signal an error of type type-error if byte is not +an integer of the stream element type of stream. +

    +

    See Also::

    + +

    read-byte +, +write-char +, +

    +

    write-sequence +

    + + + + + diff --git a/info/gcl/write_002dchar.html b/info/gcl/write_002dchar.html new file mode 100644 index 0000000..bf52460 --- /dev/null +++ b/info/gcl/write_002dchar.html @@ -0,0 +1,94 @@ + + + + + +write-char (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.21 write-char [Function]

    + +

    write-char character &optional output-stream ⇒ character +

    +

    Arguments and Values::

    + +

    character—a character. +

    +

    output-stream – an output stream designator. + The default is standard output. +

    +

    Description::

    + +

    write-char outputs character to output-stream. +

    +

    Examples::

    +
    +
     (write-char #\a)
+ |>  a
+⇒  #\a
+ (with-output-to-string (s) 
+   (write-char #\a s)
+   (write-char #\Space s)
+   (write-char #\b s))
+⇒  "a b"
+
    + +

    Side Effects::

    + +

    The output-stream is modified. +

    +

    Affected By::

    + +

    *standard-output*, +*terminal-io*. +

    +

    See Also::

    + +

    read-char +, +write-byte +, +

    +

    write-sequence +

    + + + + + diff --git a/info/gcl/write_002dsequence.html b/info/gcl/write_002dsequence.html new file mode 100644 index 0000000..9075bde --- /dev/null +++ b/info/gcl/write_002dsequence.html @@ -0,0 +1,108 @@ + + + + + +write-sequence (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.25 write-sequence [Function]

    + +

    write-sequence sequence stream &key start end ⇒ sequence +

    +

    sequence—a sequence. +

    +

    stream—an output stream. +

    +

    start, end—bounding index designators of + sequence. The defaults for start and end are 0 and nil, respectively. +

    +

    Description::

    + +

    write-sequence writes the elements of the subsequence +of sequence bounded by start and end to +stream. +

    +

    Examples::

    + +
    +
     (write-sequence "bookworms" *standard-output* :end 4)
+  |>  book
+ ⇒  "bookworms"
+
    + +

    Side Effects::

    + +

    Modifies stream. +

    +

    Exceptional Situations::

    + +

    Should be prepared to signal an error of type type-error + if sequence is not a proper sequence. +Should signal an error of type type-error + if start is not a non-negative integer. +Should signal an error of type type-error + if end is not a non-negative integer or nil. +

    +

    Might signal an error of type type-error if an element of the +bounded sequence is not a member of the +stream element type of the stream. +

    +

    See Also::

    + +

    Compiler Terminology, +read-sequence +, +write-string +, +write-line +

    +

    Notes::

    + +

    write-sequence is identical in effect to iterating over the indicated +subsequence and writing one element at a time to stream, but +may be more efficient than the equivalent loop. An efficient implementation +is more likely to exist for the case where the sequence is a +vector with the same element type as the stream. +

    + + + + + diff --git a/info/gcl/write_002dstring.html b/info/gcl/write_002dstring.html new file mode 100644 index 0000000..cbf4c60 --- /dev/null +++ b/info/gcl/write_002dstring.html @@ -0,0 +1,115 @@ + + + + + +write-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.23 write-string, write-line [Function]

    + +

    write-string string &optional output-stream &key start end ⇒ string +

    +

    write-line string &optional output-stream &key start end ⇒ string +

    +

    Arguments and Values::

    + +

    string—a string. +

    +

    output-stream – an output stream designator. + The default is standard output. +

    +

    start, end—bounding index designators of string. + The defaults for start and end are 0 and nil, respectively. +

    +

    Description::

    + +

    write-string writes the characters of +the subsequence of string bounded by start and end +to output-stream. +write-line does the same thing, +but then outputs a newline afterwards. +

    +

    Examples::

    + +
    +
     (prog1 (write-string "books" nil :end 4) (write-string "worms"))
+ |>  bookworms
+⇒  "books"
+ (progn (write-char #\*)
+        (write-line "test12" *standard-output* :end 5) 
+        (write-line "*test2")
+        (write-char #\*)
+        nil)
+ |>  *test1
+ |>  *test2
+ |>  *
+⇒  NIL
+
    + +

    Affected By::

    + +

    *standard-output*, +*terminal-io*. +

    +

    See Also::

    + +

    read-line +, +write-char +

    +

    Notes::

    + +

    write-line and write-string return string, +not the substring bounded by start and end. +

    +
    +
     (write-string string)
+≡ (dotimes (i (length string)
+      (write-char (char string i)))
+
+ (write-line string)
+≡ (prog1 (write-string string) (terpri))
+
    + + + + + + diff --git a/info/gcl/write_002dto_002dstring.html b/info/gcl/write_002dto_002dstring.html new file mode 100644 index 0000000..1b8edb3 --- /dev/null +++ b/info/gcl/write_002dto_002dstring.html @@ -0,0 +1,138 @@ + + + + + +write-to-string (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Printer Dictionary  

    +
    +
    +

    22.4.15 write-to-string, prin1-to-string, princ-to-string [Function]

    + +

    write-to-string object &key \writekeys
    + ⇒ string +

    +

    prin 1 ⇒ -to-string + object string +

    +

    princ-to-string object ⇒ string +

    +

    Arguments and Values::

    + +

    object—an object. +

    +

    \writekeydescriptions +

    +

    string—a string. +

    +

    Description::

    + +

    write-to-string, prin1-to-string, and princ-to-string +are used to create a string consisting of the printed representation +of object. +Object is effectively printed as if by write, +prin1, or princ, respectively, +and the characters that would be output are made +into a string. +

    +

    write-to-string is the general output function. +It has the ability to specify all the parameters applicable +to the printing of object. +

    +

    prin1-to-string acts like write-to-string with +:escape t, that is, escape characters are written where appropriate. +

    +

    princ-to-string acts like write-to-string with +

    +

    :escape nil :readably nil. +

    +

    Thus no escape characters are written. +

    +

    All other keywords that would be specified to write-to-string +are default values when prin1-to-string +or princ-to-string is invoked. +

    +

    The meanings and defaults for the keyword arguments to write-to-string +are the same as those for write. +

    +

    Examples::

    + +
    +
     (prin1-to-string "abc") ⇒  "\"abc\""
+ (princ-to-string "abc") ⇒  "abc"
+
    + +

    Affected By::

    + +

    *print-escape*, +*print-radix*, +*print-base*, +*print-circle*, +*print-pretty*, +*print-level*, +*print-length*, +*print-case*, +*print-gensym*, +*print-array*, +*read-default-float-format*. +

    +

    See Also::

    + +

    write +

    +

    Notes::

    + +
    +
     (write-to-string object {key argument}*)
+≡ (with-output-to-string (#1=#:string-stream) 
+     (write object :stream #1# {key argument}*))
+
+ (princ-to-string object)
+≡ (with-output-to-string (string-stream)
+     (princ object string-stream))
+
+ (prin1-to-string object)
+≡ (with-output-to-string (string-stream)
+     (prin1 object string-stream))
+
    + + + + + + diff --git a/info/gcl/y_002dor_002dn_002dp.html b/info/gcl/y_002dor_002dn_002dp.html new file mode 100644 index 0000000..904b262 --- /dev/null +++ b/info/gcl/y_002dor_002dn_002dp.html @@ -0,0 +1,136 @@ + + + + + +y-or-n-p (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    +
    +

    21.2.37 y-or-n-p, yes-or-no-p [Function]

    + +

    y-or-n-p &optional control &rest arguments ⇒ generalized-boolean +

    +

    yes-or-no-p &optional control &rest arguments ⇒ generalized-boolean +

    +

    Arguments and Values::

    + +

    control—a format control. +

    +

    arguments—format arguments for control. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    These functions ask a question and parse a response from the user. +They return true if the answer is affirmative, +or false if the answer is negative. +

    +

    y-or-n-p is for asking the user a question whose answer is either +“yes” or “no.” +It is intended that the reply require +the user to answer a yes-or-no question with a single +character. +yes-or-no-p is also for asking the user a question +whose answer is either “Yes” or “No.” +It is intended that the reply require +the user to take more action than just a single keystroke, such as typing +the full word yes or no followed by a newline. +

    +

    y-or-n-p types out a message (if supplied), reads an answer +in some implementation-dependent manner (intended to be short and simple, +such as reading a single character such as Y or N). +yes-or-no-p types out a message (if supplied), +attracts the user’s attention (for example, by ringing +the terminal’s bell), +and reads an answer +in some implementation-dependent manner (intended to be multiple characters, +such as YES or NO). +

    +

    If format-control is supplied and not nil, +then a fresh-line operation is performed; then +a message is printed as if format-control and arguments +were given to format. +In any case, yes-or-no-p and y-or-n-p will provide +a prompt such as “(Y or N)” or “(Yes or No)” if appropriate. +

    +

    All input and output are performed using query I/O. +

    +

    Examples::

    +
    +
     (y-or-n-p "(t or nil) given by")
+ |>  (t or nil) given by (Y or N) |>>Y<<|
+⇒  true
+ (yes-or-no-p "a ~S message" 'frightening) 
+ |>  a FRIGHTENING message (Yes or No) |>>no<<|
+⇒  false
+ (y-or-n-p "Produce listing file?") 
+ |>  Produce listing file?
+ |>  Please respond with Y or N. |>>n<<|
+⇒  false
+
    + +

    Side Effects::

    + +

    Output to and input from query I/O will occur. +

    +

    Affected By::

    + +

    *query-io*. +

    +

    See Also::

    + +

    format +

    +

    Notes::

    + +

    yes-or-no-p and yes-or-no-p do not add question marks +to the end of the prompt string, so any desired question mark or other +punctuation should be explicitly included in the text query. +

    +
    +
    +

    +Next: , Previous: , Up: Streams Dictionary  

    +
    + + + + + diff --git a/info/gcl/zerop.html b/info/gcl/zerop.html new file mode 100644 index 0000000..194d9d4 --- /dev/null +++ b/info/gcl/zerop.html @@ -0,0 +1,93 @@ + + + + + +zerop (ANSI and GNU Common Lisp Document) + + + + + + + + + + + + + + + + +
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +
    +
    +

    12.2.18 zerop [Function]

    + +

    zerop number ⇒ generalized-boolean +

    +

    Pronunciation::

    + +

    pronounced ’z\=e (, )r\=o(, )p\=e +

    +

    Arguments and Values::

    + +

    number—a number. +

    +

    generalized-boolean—a generalized boolean. +

    +

    Description::

    + +

    Returns true if number is zero (integer, float, or complex); +otherwise, returns false. +

    +

    Regardless of whether an implementation provides distinct representations +for positive and negative floating-point zeros, (zerop -0.0) +always returns true. +

    +

    Examples::

    + +
    +
     (zerop 0) ⇒  true
+ (zerop 1) ⇒  false
+ (zerop -0.0) ⇒  true
+ (zerop 0/100) ⇒  true
+ (zerop #c(0 0.0)) ⇒  true
+
    + +

    Exceptional Situations::

    + +

    Should signal an error of type type-error + if number is not a number. +

    +

    Notes::

    + +
    +
     (zerop number) ≡ (= number 0)
+
    + + + + + + diff --git a/info/general.texi b/info/general.texi new file mode 100755 index 0000000..e58b3a3 --- /dev/null +++ b/info/general.texi @@ -0,0 +1,687 @@ +@c Copyright (c) 1994 William Schelter. + +@node General, Widgets, Top, Top +@chapter General + +@menu +* Introduction:: +* Getting Started:: +* Common Features of Widgets:: +* Return Values:: +* Argument Lists:: +* Lisp Functions Invoked from Graphics:: +* Linked Variables:: +* tkconnect:: +@end menu + +@node Introduction, Getting Started, General, General +@section Introduction + +@b{GCL-TK} is a windowing interface for @b{GNU Common Lisp}. It provides the +functionality of the @b{TK} widget set, which in turn implements a widget +set which has the look and feel of @b{Motif}. + +The interface allows the user to draw graphics, get input from menus, +make regions mouse sensitive, and bind lisp commands to regions. It +communicates over a socket with a @file{gcltksrv} process, which speaks to the +display via the @b{TK} library. The displaying process may run on +a machine which is closer to the display, and so involves less +communication. It also may remain active even though the lisp is +involved in a separate user computation. The display server can, however, +interrupt the lisp at will, to inquire about variables and run +commands. + +The user may also interface with existing @code{TCL/TK} programs, +binding some buttons, or tracking some objects. + +The size of the program is moderate. In its current form it adds only +about 45K bytes to the lisp image, and the @file{gcltksrv} program uses shared +libraries, and is on the order of 150Kbytes on a sparc. + +This chapter describes some of the common features of the command +structure of widgets, and of control functions. The actual functions +for construction of windows +are discussed in @ref{Widgets}, and more general functions +for making them appear, lowering them, querying about them in @ref{Control}. + +@node Getting Started, Common Features of Widgets, Introduction, General +@section Getting Started + +Once @b{GCL} has been properly installed you should be able to do the +following simple example: + +@example +(in-package "TK") +(tkconnect) +(button '.hello :text "Hello World" :command '(print "hi")) +==>.HELLO +(pack '.hello) +@end example +We first switched to the "TK" package, so that functions like button +and pack would be found. +After doing the tkconnect, a window should appear on your screen, see @xref{tkconnect}. +The invocation of the function @code{button} creates a new function +called @code{.hello} which is a @i{widget function}. It is then +made visible in the window by using the @code{pack} function. + +You may now click on the little window, and you should see the command +executed in your lisp. Thus "hi" should be printed in the lisp +window. This will happen whether or not you have a job running in +the lisp, that is lisp will be interrupted and your command will run, +and then return the control to your program. + +The function @code{button} is called a widget constructor, and the +function @code{.hello} is called a widget. If you have managed to +accomplish the above, then @b{GCL} is probably installed correctly, and you +can graduate to the next section! If you dont like reading but prefer +to look at demos and code, then you should look in the demos directory, +where you will find a number of examples. A monitor for the garbage +collector (mkgcmonitor), a demonstration of canvas widgets (mkitems), +a sample listbox with scrolling (mklistbox). + +@node Common Features of Widgets, Return Values, Getting Started, General +@section Common Features of Widgets + +A @i{widget} is a lisp symbol which has a function binding. The +first argument is always a keyword and is called the @i{option}. +The argument pattern for the remaining arguments depends on the +@i{option}. The most common @i{option} is @code{:configure} in +which case the remaining arguments are alternating keyword/value +pairs, with the same keywords being permitted as at the creation +of the widget. + +A @i{widget} is created by means of a @i{widget constructor}, of +which there are currently 15, each of them appearing as the title of a +section in @ref{Widgets}. They live in the @code{"TK"} package, and for +the moment we will assume we have switched to this package. Thus for +example @code{button} is such a widget constructor function. Of course +this is lisp, and you can make your own widget constructors, but when +you do so it is a good idea to follow the standard argument patterns +that are outlined in this section. + +@example +(button '.hello) +==> .HELLO +@end example +@noindent +creates a @i{widget} whose name is @code{.hello}. There is a parent child +hierarchy among widgets which is implicit in the name used for the +widget. This is much like the pathname structure on a Unix or Dos +file system, except that @code{'.'} is used as the separator rather +than a @code{/} or @code{\}. For this reason the widget instances +are sometimes referred to as @i{pathnames}. A child of the +parent widget @code{.hello} might be called @code{.hello.joe}, and +a child of this last might be @code{.hello.joe.bar}. The parent of +everyone is called @code{.} . Multiple top level windows are created +using the @code{toplevel} command (@pxref{toplevel}). + +The widget constructor functions take keyword and value pairs, which +allow you to specify attributes at the time of creation: + +@example +(button '.hello :text "Hello World" :width 20) +==>.HELLO +@end example +@noindent +indicating that we want the text in the button window to be +@code{Hello World} and the width of the window to be 20 characters +wide. Other types of windows allow specification in centimeters +@code{2c}, or in inches (@code{2i}) or in millimeters @code{2m} +or in pixels @code{2}. But text windows usually have their +dimensions specified as multiples of a character width and height. +This latter concept is called a grid. + +Once the window has been created, if you want to change the +text you do NOT do: +@example +(button '.hello :text "Bye World" :width 20) +@end example +This would be in error, because the window .hello already exists. +You would either have to first call + +@example +(destroy '.hello) +@end example + +But usually you just want to change an attribute. @code{.hello} is +actually a function, as we mentioned earlier, and it is this function +that you use: + +@example +(.hello :configure :text "Bye World") +@end example + +This would simply change the text, and not change where the window had +been placed on the screen (if it had), or how it had been packed +into the window hierarchy. Here the argument @code{:configure} is +called an @i{option}, and it specifies which types of keywords can +follow it. For example + +@example +(.hello :flash) +@end example +@noindent +is also valid, but in this case the @code{:text} keyword is not permitted +after flash. If it were, then it would mean something else besides +what it means in the above. For example one might have defined + +@example +(.hello :flash :text "PUSH ME") +@end example +@noindent +so here the same keyword @code{:text} would mean something else, eg +to flash a subliminal message on the screen. + +We often refer to calls to the widget functions +as messages. One reason for this is that they actually turn into +messages to the graphics process @file{gcltksrv}. To actually see these +messages you can do +@example +(debugging t). +@end example + +@node Return Values, Argument Lists, Common Features of Widgets, General +@section Return Values + +@subsection Widget Constructor Return Values + +On successful completion, the widget constructor functions return the +symbol passed in as the first argument. It will now have a functional +binding. It is an error to pass in a symbol which already corresponds +to a widget, without first calling the @code{destroy} command. On failure, +an error is signalled. + +@subsection Widget Return Values + +The @i{widget} functions themselves, do not normally return any value. +Indeed the lisp process does not wait for them to return, but merely +dispatches the commands, such as to change the text in themselves. +Sometimes however you either wish to wait, in order to synchronize, or +you wish to see if your command fails or succeeds. You request values +by passing the keyword :return and a value indicating the type. + +@example +(.hello :configure :text "Bye World" :return 'string) +==> "" +==> T +@end example +@noindent +the empty string is returned as first value, and the second value +@code{T} indicates that the new text value was successfully set. LISP +will not continue until the tkclsrv process indicates back that the +function call has succeeded. While waiting of course LISP will continue +to process other graphics events which arrive, since otherwise a +deadlock would arise: the user for instance might click on a mouse, just after +we had decided to wait for a return value from the @code{.hello} function. +More generally a user program may be running in @b{GCL} and be interrupted +to receive and act on communications from the @file{gcltksrv} +process. If an error occurred then the second return value of the +lisp function will be NIL. In this case the first value, the string +is usually an informative message about the type of error. + +A special variable @code{tk::*break-on-errors*} which if not +@code{nil}, requests that that @b{LISP} signal an error when a message +is received indicating a function failed. Whenever a command fails, +whether a return value was requested or not, @file{gcltksrv} returns a +message indicating failure. The default is to not go into the +debugger. When debugging your windows it may be convenient however to +set this variable to @code{T} to track down incorrect messages. + +The @file{gcltksrv} process always returns strings as values. +If @code{:return} @i{type} is specified, then conversion to @i{type} +is accomplished by calling + +@example +(coerce-result @i{return-string} @i{type}) +@end example + +Here @i{type} must be a symbol with a @code{coercion-functions} +property. +The builtin return types which may be requested are: + +@table @code +@item T +in which case +the string passed back from the @file{gcltksrv} process, will be read by the +lisp reader. +@item number +the string is converted to a number using the current *read-base* +@item list-strings + +@example +(coerce-result "a b @{c d@} e" 'list-strings) +==> ("a" "b" "c d" "e") +@end example +@item boolean +(coerce-result "1" 'boolean) +==> T +(coerce-result "0" 'boolean) +==> NIL +@end table + +The above symbols are in the @code{TK} or @code{LISP} package. +It would be possible to add new types just as the @code{:return t} +is done: + +@example +(setf (get 't 'coercion-functions) + (cons #'(lambda (x) (our-read-from-string x 0)) + #'(lambda (x) (format nil "~s" x)))) +@end example + +The @code{coercion-functions} property of a symbol, is a cons whose +@code{car} is the coercion form from a string to some possibly different +lisp object, and whose @code{cdr} is a function which builds a string +to send to the graphics server. Often the two functions are inverse +functions one of the other up to equal. + +@subsection Control Function Return Values + +The @i{control} functions (@pxref{Control}) do not return a value +or wait unless requested to do so, using the @code{:return} keyword. +The types and method of specification are the same as for the +Widget Functions in the previous section. + +@example +(winfo :width '.hello :return 'number) +==> 120 +@end example +@noindent +indicates that the @code{.hello} button is actually 120 pixels +wide. + +@node Argument Lists, Lisp Functions Invoked from Graphics, Return Values, General +@section Argument Lists + +@subsection Widget Functions + +The rule is that the first argument for a widget function is a keyword, +called the @i{option}. The pattern of the remaining arguments depends +completely +on the @i{option} argument. Thus + +@example +(.hello @i{option} ?arg1? ?arg2? ...) +@end example + +One @i{option} which is permitted for every widget function is +@code{:configure}. The argument pattern following it is the same +keyword/value pair list which is used in widget creation. For a +@code{button} widget, the other valid options are @code{:deactivate}, +@code{:flash}, and @code{:invoke}. To find these, since +@code{.hello} was constructed with the @code{button} constructor, you +should see @xref{button}. +The argument pattern for other options depends completely on the option +and the widget function. +For example if @code{.scrollbar} is a scroll bar window, then the option +@code{:set} must be followed by 4 numeric arguments, which indicate how +the scrollbar should be displayed, see @xref{scrollbar}. + +@example +(.scrollbar :set a1 a2 a3 a4) +@end example + +If on the other hand @code{.scale} is a scale (@pxref{scale}), then we have + +@example +(.scale :set a1 ) +@end example +@noindent +only one numeric argument should be supplied, in order to position the +scale. + +@subsection Widget Constructor Argument Lists + +These are + +@example +(widget-constructor @i{pathname} :keyword1 value1 :keyword2 value2 ...) +@end example + +@noindent +to create the widget whose name is @i{pathname}. The possible keywords +allowed are specified in the corresponding section of @xref{Widgets}. + +@subsection Concatenation Using `:' in Argument List + +What has been said so far about arguments is not quite true. A +special string concatenation construction is allowed in argument lists +for widgets, widget constructors and control functions. + +First we introduce the function @code{tk-conc} which takes an arbitrary +number of arguments, which may be symbols, strings or numbers, and +concatenates these into a string. The print names of symbols are +converted to lower case, and package names are ignored. + +@example +(tk-conc "a" 1 :b 'cd "e") ==> "a1bcde" +@end example + +One could use @code{tk-conc} to construct arguments for widget +functions. But even though @code{tk-conc} has been made quite +efficient, it still would involve the creation of a string. The +@code{:} construct avoids this. In a call to a widget function, +a widget constructor, or a control function you may remove the call to +@code{tk-conc} and place @code{:} in between each of its arguments. +Those functions are able to understand this and treat the extra +arguments as if they were glued together in one string, but without +the extra cost of actually forming that string. + +@example +(tk-conc a b c .. w) <==> a : b : c : ... w +(setq i 10) +(.hello :configure :text i : " pies") +(.hello :configure :text (tk-conc i " pies")) +(.hello :configure :text (format nil "~a pies" i)) +@end example + +The last three examples would all result in the text string being +@code{"10 pies"}, but the first method is the most efficient. +That call will be made with no string or cons creation. The +@b{GC Monitor} example, is written in such a way that there is no +creation of @code{cons} or @code{string} types during normal operation. +This is particularly useful in that case, since one is trying to +monitor usage of conses by other programs, not its own usage. + +@node Lisp Functions Invoked from Graphics, Linked Variables, Argument Lists, General +@section Lisp Functions Invoked from Graphics + + +It is possible to make certain areas of a window mouse sensitive, +or to run commands on reception of certain events such as keystrokes, +while the focus is in a certain window. This is done by having +a lisp function invoked or some lisp form evaluated. We shall +refer to such a lisp function or form as a @emph{command}. + +For example + +@example +(button '.button :text "Hello" :command '(print "hi")) +(button '.jim :text "Call Jim" :command 'call-jim) +@end example + +In the first case when the window @code{.button} is clicked on, the +word "hi" will be printed in the lisp to standard output. In the +second case @code{call-jim} will be funcalled with no arguments. + +A command must be one of the following three types. What happens +depends on which type it is: + +@table @samp +@item function +If the value satisfies @code{functionp} then it will be called with +a number of arguments which is dependent on the way it was bound, +to graphics. +@item string +If the command is a string, then it is passed directly to @b{TCL/TK} +for evaluation on that side. Lisp will not be required for the +evaluation when the command is invoked. +@item lisp form +Any other lisp object is regarded as a lisp form to be eval'd, and +this will be done when the command is invoked. +@end table + +The following keywords accept as their value a command: + +@example + :command + :yscroll :yscrollcommand + :xscroll :xscrollcommand + :scrollcommand + :bind +@end example + +@noindent +and in addition @code{bind} takes a command as its third argument, +see @xref{bind}. + +@c todo!! +Below we give three different examples using the 3 possibilities for +a command: functionp, string, and lisp form. They all accomplish +exactly the same thing. +For given a frame @code{.frame} we could construct a listbox +in it as: + +@example +(listbox '.frame.listbox :yscroll 'joe) +@end example + +Then whenever the listbox view position changes, or text is inserted, +so that something changes, the function @code{joe} will be invoked with 4 +arguments giving the totalsize of the text, maximum number of units +the window can display, the index of the top unit, and finally the +index of the bottom unit. What these arguments are is specific +to the widget @code{listbox} and is documented @xref{listbox}. + +@code{joe} might be used to do anything, but a common usage is to have +@code{joe} alter the position of some other window, such as a scroll +bar window. Indeed if @code{.scrollbar} is a scrollbar then +the function + +@example +(defun joe (a b c d) + (.scrollbar :set a b c d)) +@end example + +@noindent +would look after sizing the scrollbar appropriately for the percentage +of the window visible, and positioning it. + +A second method of accomplishing this identical, using a string (the +second type of command), + + +@example +(listbox '.frame.listbox :yscroll ".scrollbar set") +@end example + +@noindent +and this will not involve a call back to lisp. It uses the fact that +the @b{TK} graphics side understands the window name @code{.scrollbar} and +that it takes the @i{option} @code{set}. Note that it does not get +the @code{:} before the keyword in this case. + +In the case of a command which is a @i{lisp form} but is not installed +via @code{bind} or @code{:bind}, then the form will be installed as + +@example +#'(lambda (&rest *arglist*) @i{lisp-form}) +@end example + +@noindent +where the @i{lisp-form} might wish to access the elements of the special +variable @code{*arglist*}. Most often this list will be empty, but for +example if the command was setup for @code{.scale} which is a @i{scale}, +then the command will be supplied one argument which is the new numeric +value which is the scale position. A third way of accomplishing the +scrollbar setting using a lisp form is: + +@example +(listbox '.frame.listbox :yscroll '(apply '.scrollbar :set *arglist*)) +@end example + +The @code{bind} command and @code{:bind} keyword, have an additional +wrinkle, see @xref{bind}. These are associated to an event in a +particular window, and the lisp function or form to be evaled must have +access to that information. For example the x y position, the window +name, the key pressed, etc. This is done via @i{percent symbols} which +are specified, see @xref{bind}. + +@example +(bind "Entry" "" '(emacs-move %W %A )) +@end example + +@noindent +will cause the function emacs-move to be be invoked whenever a control +key is pressed (unless there are more key specific or window specific +bindings of said key). It will be invoked with two arguments, the +first %W indicating the window in which it was invoked, and the second +being a string which is the ascii keysym which was pressed at the same +time as the control key. + +These @i{percent constructs} are only permitted in commands which are +invoked via @code{bind} or @code{:bind}. The lisp form which is passed +as the command, is searched for the percent constructs, and then a +function + +@example +#'(lambda (%W %A) (emacs-move %W %A)) +@end example + +@noindent +will be invoked with two arguments, which will be supplied by the +@b{TK} graphics server, at the time the command is invoked. The +@code{*arglist*} construct is not available for these commands. + +@node Linked Variables, tkconnect, Lisp Functions Invoked from Graphics, General +@section Linked Variables + +It is possible to link lisp variables to @b{TK} variables. In general +when the @b{TK} variable is changed, by for instance clicking on a +radiobutton, the linked lisp variable will be changed. Conversely +changing the lisp variable will be noticed by the @b{TK} graphics side, if +one does the assignment in lisp using @code{setk} instead of +@code{setq}. + +@example +(button '.hello :textvariable '*message* :text "hi there") +(pack '.hello) +@end example + +This causes linking of the global variable @code{*message*} in lisp +to a corresponding variable in @b{TK}. Moreover the message that is in +the button @code{.hello} will be whatever the value of this global +variable is (so long as the @b{TK} side is notified of the change!). + +Thus if one does + +@example +(setk *message* "good bye") +@end example + +@noindent +then the button will change to have @i{good bye} as its text. +The lisp macro @code{setk} expands into + +@example +(prog1 (setf *message* "good bye") (notice-text-variables)) +@end example + +@noindent +which does the assignment, and then goes thru the linked variables +checking for those that have changed, and updating the @b{TK} side should +there be any. Thus if you have a more complex program which might +have done the assignment of your global variable, you may include +the call to @code{notice-text-variables} at the end, to assure that +the graphics side knows about the changes. + +A variable which is linked using the keyword @code{:textvariable} is +always a variable containing a string. + +However it is possible to have other types of variables. + +@example +(checkbutton '.checkbutton1 :text "A button" :variable '(boolean *joe*)) +(checkbutton '.checkbutton2 :text "A button" :variable '*joe*) +(checkbutton '.checkbutton3 :text "Debugging" :variable '(t *debug*) + :onvalue 100 :offvalue -1) +@end example + +The first two examples are the same in that the default variable type +for a checkbutton is @code{boolean}. Notice that the specification of a +variable type is by @code{(@i{type} variable)}. The types which are +permissible are those which have coercion-fucntions, @xref{Return +Values}. In the first example a variable @code{*joe*} will be linked, and +its default initial value will be set to nil, since the default initial +state of the check button is off, and the default off value is nil. +Actually on the @b{TK} side, the corresponding boolean values are @code{"1"} +and @code{"0"}, but the @code{boolean} type makes these become @code{t} +and @code{nil}. + +In the third example the variable *debug* may have any lisp value (here +@i{type} is @code{t}). The initial value will be made to be @code{-1}, +since the checkbutton is off. Clicking on @code{.checkbutton3} will +result in the value of @code{*debug*} being changed to 100, and the light +in the button will be toggled to on, @xref{checkbutton}. You may +set the variable to be another value besides 100. + +You may also call + +@example +(link-text-variable '*joe* 'boolean) +@end example + +@noindent +to cause the linking of a variable named *joe*. This is done +automatically +whenever the variable is specified after one of the keys + +@example +:variable :textvariable. +@end example + +Just as one must be cautious about using global variables in lisp, one +must be cautious in making such linked variables. In particular note +that the @b{TK} side, uses variables for various purposes. If you make a +checkbutton with pathname @code{.a.b.c} then unless you specify a +@code{:variable} option, the variable @code{c} will become associated to +the @b{TK} value of the checkbutton. We do NOT link this variable by +default, feeling that one might inadvertently alter global variables, +and that they would not typically use the lisp convention of being of +the form @code{*c*}. You must specify the @code{:variable} option, or +call @code{link-variable}. + + +@node tkconnect, , Linked Variables, General +@section tkconnect + +@example +@i{tkconnect} &key host display can-rsh gcltksrv +@end example + +This function provides a connection to a graphics server process, which +in turn connects to possibly several graphics display screens. The +graphics server process, called @file{gcltksrv} may or may not run +on the same machine as the lisp to which it is attached. +@code{display} +indicates the name of the default display to connect to, and this +in turn defaults to the value of the environment variable @code{DISPLAY}. + +When @i{tkconnect} is invoked, a socket is opened and it waits for +a graphics process to connect to it. If the host argument is not +supplied, then a process will be spawned which will connect back to +the lisp process. The name of the command for invoking the process +is the value of the @file{gcltksrv} argument, which defaults to +the value of the environment variable @code{GCL_TK_SERVER}. If that variable +is not set, then the lisp @code{*lib-directory*} is searched for +an entry @file{gcl-tk/gcltksrv}. + +If @code{host} is supplied, then a command to run on the remote machine +will be printed on standard output. If @code{can-rsh} is not nil, +then the command will not be printed, but rather an attempt will be +made to rsh to the machine, and to run the command. + +Thus + +@example +(tkconnect) +@end example + +@noindent +would start the process on the local machine, and use for @code{display} +the value of the environment variable @code{DISPLAY}. + +@example +(tkconnect :host "max.ma.utexas.edu" :can-rsh t) +@end example + +@noindent +would cause an attempt to rsh to @code{max} and to run the command +there, to connect back to the appropriate port on the localhost. + +You may indicate that different @i{toplevel} windows be on different +displays, by using the @code{:display} argument when creating the +window, @xref{toplevel}. + +Clearly you must have a copy of the program @file{gcltksrv} and @b{TK} +libraries installed on the machine where you wish to run the server. diff --git a/info/internal.texi b/info/internal.texi new file mode 100755 index 0000000..3b46ac5 --- /dev/null +++ b/info/internal.texi @@ -0,0 +1,361 @@ +@node GCL Specific, C Interface, Type, Top +@chapter GCL Specific + +@defun SYSTEM (string) +Package:LISP + +GCL specific: Executes a Shell command as if STRING is an input to the +Shell. Not all versions of GCL support this function. At least on +POSIX systems, this call should return two integers represeting the +exit status and any possible terminating signal respectively. + + +@end defun + +@defvar *TMP-DIR* +Package:COMPILER +GCL specific: Directory in which temporary ``gazonk'' files used by the +compiler are to be created. + + +@end defvar + +@defvar *IGNORE-MAXIMUM-PAGES* +Package:SI +GCL specific: Tells the GCL memory manager whether (non-NIL) or not (NIL) it +should expand memory whenever the maximum allocatable pages have been used +up. + + +@end defvar + +@defvar *OPTIMIZE-MAXIMUM-PAGES* +Package:SI + +GCL specific: Tells the GCL memory manager whether to attempt to +adjust the maximum allowable pages for each type to approximately +optimize the garbage collection load in the current process. Defaults +to T. Set to NIL if you care more about memory usage than runtime. + + +@end defvar + +@defun MACHINE-VERSION () +Package:LISP + +Returns a string that identifies the machine version of the machine +on which GCL is currently running. + + +@end defun + +@defun BY () +Package:LISP + +GCL specific: Exits from GCL. + + +@end defun + +@deffn {Macro} DEFCFUN +Package:LISP + +Syntax: +@example +(defcfun header n @{element@}*) +@end example + + +GCL specific: Defines a C-language function which calls Lisp functions +and/or handles Lisp objects. HEADER gives the header of the C +function as a string. Non-negative-integer is the number of the main +stack entries used by the C function, primarily for protecting Lisp +objects from being garbage-collected. Each ELEMENT may give a C code +fragment as a string, or it may be a list + ((symbol @{arg@}*) @{place@}*) +which, when executed, calls the Lisp function named by SYMBOL with the +specified arguments and saves the value(s) to the specified places. +The DEFCFUN form has the above meanings only after compiled; The GCL +interpreter simply ignores this form. + +An example which defines a C function list2 of two arguments, but which +calls the 'lisp' function CONS by name, and refers to the constant 'NIL. +Note to be loaded by @code{load} the function should be static. + + +(defCfun "static object list2(x,y) object x,y;" 0 + "object z;" + ('NIL z) + ((CONS y z) z) + ((CONS x z) z) + "return(z);" +) + +In lisp the operations in the body would be + (setq z 'nil) + (setq z (cons y z)) + (setq z (cons x z)) + + + +Syntax: +@example + + (defCfun header non-negative-integer + @{ string + | ( function-symbol @{ value @}* ) + | (( function-symbol @{ value @}* ) @{ place @}* ) @}) + + +value: +place: + @{ C-expr | ( C-type C-expr ) @} + +C-function-name: +C-expr: + @{ string | symbol @} + +C-type: + @{ object | int | char | float | double @} + +@end example + + + + +@end deffn + +@deffn {Macro} CLINES +Package:LISP + +Syntax: +@example +(clines @{string@}*) +@end example + +GCL specific: The GCL compiler embeds STRINGs into the intermediate C +language code. The interpreter ignores this form. + + +@end deffn + +@defun ALLOCATE (type number &optional (really-allocate nil)) +Package:LISP + +GCL specific: Sets the maximum number of pages for the type class of the +GCL implementation type TYPE to NUMBER. If REALLY-ALLOCATE is given a +non-NIL value, then the specified number of pages will be allocated +immediately. + + +@end defun + +@defun GBC (x) +Package:LISP + +GCL specific: Invokes the garbage collector (GC) with the collection level +specified by X. NIL as the argument causes GC to collect cells only. T as +the argument causes GC to collect everything. + + +@end defun + +@defun SAVE (pathname) +Package:LISP + +GCL specific: Saves the current GCL core image into a program file specified +by PATHNAME. This function depends on the version of GCL. The function +si::save-system is to be preferred in almost all circumstances. Unlike +save, it makes the relocatable section permanent, and causes no future gc of +currently loaded .o files. + +@end defun + +@defun HELP* (string &optional (package 'lisp)) +Package:LISP + +GCL specific: Prints the documentation associated with those symbols in the +specified package whose print names contain STRING as substring. STRING may +be a symbol, in which case the print-name of that symbol is used. If PACKAGE +is NIL, then all packages are searched. + + +@end defun + +@deffn {Macro} DEFLA +Package:LISP + +Syntax: +@example +(defla name lambda-list @{decl | doc@}* @{form@}*) +@end example + +GCL specific: Used to DEFine Lisp Alternative. For the interpreter, DEFLA is +equivalent to DEFUN, but the compiler ignores this form. + + +@end deffn + +@defun PROCLAMATION (decl-spec) +Package:LISP + +GCL specific: Returns T if the specified declaration is globally in effect; +NIL otherwise. See the doc of DECLARE for possible DECL-SPECs. + + +@end defun + +@deffn {Macro} DEFENTRY +Package:LISP + +Syntax: +@example +(defentry name arg-types c-function) +@end example + + +GCL specific: The compiler defines a Lisp function whose body consists of a +calling sequence to the C language function specified by C-FUNCTION. The +interpreter ignores this form. The ARG-TYPES specifies the C types of the +arguments which C-FUNCTION requires. The list of allowed types is (object +char int float double string). Code will be produced to coerce from a lisp +object to the appropriate type before passing the argument to the C-FUNCTION. +The c-function should be of the form (c-result-type c-fname) where +c-result-type is a member of (void object char int float double string). +c-fname may be a symbol (in which case it will be downcased) or a string. If +c-function is not a list, then (object c-function) is assumed. In order +for C code to be loaded in by @code{load} you should declare any +variables and functions to be static. If you will link them in +at build time, of course you are allowed to define new externals. + +@example + Sample usage: +--File begin----- +;; JOE takes X a lisp string and Y a fixnum and returns a character. +(clines "#include \"foo.ch\"") +(defentry joe (string int) (char "our_c_fun")) +---File end------ +---File foo.ch--- +/* C function for extracting the i'th element of a string */ +static char our_c_fun(p,i) +char *p; +int i; + @{ + return p[i]; + @} +-----File end--- +@end example + +One must be careful of storage allocation issues when passing a string. +If the C code invokes storage allocation (either by calling @code{malloc} +or @code{make_cons} etc), then there is a possibility of a garbage +collection, so that if the string passed was not constructed with +@code{:static t} when its array was constructed, then it could move. +If the C function may allocate storage, then you should pass a copy: +@example +(defun safe-c-string (x) + (let* ((n (length x)) + (a (make-array (+ n 1) :element-type 'string-char + :static t :fill-pointer n))) + (si::copy-array-portion x y 0 0 n) + (setf (aref a n) (code-char 0))) + a) + +@end example + + +@end deffn +@defun COPY-ARRAY-PORTION (x,y,i1,i2,n1) +Package:SI +Copy elements from X to Y starting at X[i1] to Y[i2] and doing N1 +elements if N1 is supplied otherwise, doing the length of X - I1 +elements. If the types of the arrays are not the same, this has +implementation dependent results. +@end defun + +@defun BYE ( &optional (exit-status 0)) +Package:LISP + +GCL specific: Exits from GCL with exit-status. + + +@end defun + +@defun USE-FAST-LINKS (turn-on) +Package:LISP + +GCL specific: If TURN-ON is not nil, the fast link mechanism is enabled, +so that ordinary function calls will not appear in the invocation stack, +and calls will be much faster. This is the default. If you anticipate +needing to see a stack trace in the debugger, then you should turn this +off. + + +@end defun + +@menu +* Bignums:: +@end menu + +@node Bignums, , GCL Specific, GCL Specific +@section Bignums + +A directory mp was added to hold the new multi precision arithmetic +code. The layout and a fair amount of code in the mp directory is an +enhanced version of gpari version 34. The gpari c code was rewritten +to be more efficient, and gcc assembler macros were added to allow +inlining of operations not possible to do in C. On a 68K machine, +this allows the C version to be as efficient as the very carefully +written assembler in the gpari distribution. For the main machines, +an assembler file (produced by gcc) based on this new method, is +included. This is for sites which do not have gcc, or do not +wish to compile the whole system with gcc. + +Bignum arithmetic is much faster now. Many changes were made to +cmpnew also, to add 'integer' as a new type. It differs from +variables of other types, in that storage is associated to each such +variable, and assignments mean copying the storage. This allows a +function which does a good deal of bignum arithmetic, to do very +little consing in the heap. An example is the computation of PI-INV +in scratchpad, which calculates the inverse of pi to a prescribed +number of bits accuracy. That function is now about 20 times faster, +and no longer causes garbage collection. In versions of GCL where +HAVE_ALLOCA is defined, the temporary storage growth is on the C +stack, although this often not so critical (for example it makes +virtually no difference in the PI-INV example, since in spite of the +many operations, only one storage allocation takes place. + +Below is the actual code for PI-INV + +On a sun3/280 (cli.com) + +Here is the comparison of lucid and gcl before and after +on that pi-inv. Times are in seconds with multiples of the +gcl/akcl time in parentheses. + +On a sun3/280 (cli.com) + +@example + +pi-inv akcl-566 franz lucid old kcl/akcl +---------------------------------------- +10000 3.3 9.2(2.8 X) 15.3 (4.6X) 92.7 (29.5 X) +20000 12.7 31.0(2.4 X) 62.2 (4.9X) 580.0 (45.5 X) + + +(defun pi-inv (bits &aux (m 0)) + (declare (integer bits m)) + (let* ((n (+ bits (integer-length bits) 11)) + (tt (truncate (ash 1 n) 882)) + (d (* 4 882 882)) + (s 0)) + (declare (integer s d tt n)) + (do ((i 2 (+ i 2)) + (j 1123 (+ j 21460))) + ((zerop tt) (cons s (- (+ n 2)))) + (declare (integer i j)) + (setq s (+ s (* j tt)) + m (- (* (- i 1) (- (* 2 i) 1) (- (* 2 i) 3))) + tt (truncate (* m tt) (* d (the integer (expt i 3)))))))) + +@end example diff --git a/info/io.texi b/info/io.texi new file mode 100755 index 0000000..426b48d --- /dev/null +++ b/info/io.texi @@ -0,0 +1,1008 @@ +@node Streams and Reading, Special Forms and Functions, Lists, Top +@chapter Streams and Reading + +@defun MAKE-ECHO-STREAM (input-stream output-stream) +Package:LISP + +Returns a bidirectional stream which gets its input from INPUT-STREAM and +sends its output to OUTPUT-STREAM. In addition, all input is echoed to +OUTPUT-STREAM. + + +@end defun + +@defvar *READTABLE* +Package:LISP +The current readtable. + + +@end defvar + +@defun LOAD (filename &key (verbose *load-verbose*) (print nil) (if-does-not-exist :error)) +Package:LISP + +Loads the file named by FILENAME into GCL. + + +@end defun + +@defun OPEN (filename &key (direction :input) (element-type 'string-char) (if-exists :error) (if-does-not-exist :error)) +Package:LISP + +Opens the file specified by FILENAME, which may be a string, a pathname, +or a stream. Returns a stream for the open file. +DIRECTION is :INPUT, :OUTPUT, :IO or :PROBE. +ELEMENT-TYPE is STRING-CHAR, (UNSIGNED-BYTE n), +UNSIGNED-BYTE, (SIGNED-BYTE n), SIGNED-BYTE, CHARACTER, BIT, (MOD n), or +:DEFAULT. +IF-EXISTS is :ERROR, :NEW-VERSION, :RENAME, +:RENAME-AND-DELETE, :OVERWRITE, :APPEND, :SUPERSEDE, or NIL. +IF-DOES-NOT-EXIST is :ERROR, :CREATE, or NIL. + +If FILENAME begins with a vertical pipe sign: '|' then the resulting +stream is actually a one way pipe. It will be open for reading +or writing depending on the direction given. The rest +of FILENAME in this case is passed to the /bin/sh command. See +the posix description of popen for more details. +@example +(setq pipe (open "| wc < /tmp/jim")) +(format t "File has ~%d lines" (read pipe)) +(close pipe) +@end example + +@end defun + +@defvar *PRINT-BASE* +Package:LISP +The radix in which the GCL printer prints integers and rationals. +The value must be an integer from 2 to 36, inclusive. + + +@end defvar + +@defun MAKE-STRING-INPUT-STREAM (string &optional (start 0) (end (length string))) +Package:LISP + +Returns an input stream which will supply the characters of String between +Start and End in order. + + +@end defun + +@defun PPRINT (object &optional (stream *standard-output*)) +Package:LISP + +Pretty-prints OBJECT. Returns OBJECT. Equivalent to + (WRITE :STREAM STREAM :PRETTY T) +The SI:PRETTY-PRINT-FORMAT property N (which must be a non-negative integer) +of a symbol SYMBOL controls the pretty-printing of form + (SYMBOL f1 ... fN fN+1 ... fM) +in such a way that the subforms fN+1, ..., fM are regarded as the 'body' of +the entire form. For instance, the property value of 2 is initially given +to the symbol DO. + + +@end defun + +@defvar *READ-DEFAULT-FLOAT-FORMAT* +Package:LISP +The floating-point format the GCL reader uses when reading floating-point +numbers that have no exponent marker or have e or E for an exponent marker. +Must be one of SHORT-FLOAT, SINGLE-FLOAT, DOUBLE-FLOAT, and LONG-FLOAT. + + +@end defvar + +@defun READ-PRESERVING-WHITESPACE (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)) +Package:LISP + +Reads an object from STREAM, preserving the whitespace that followed the +object. + + +@end defun + +@defun STREAMP (x) +Package:LISP + +Returns T if X is a stream object; NIL otherwise. + + +@end defun + + +@defun SET-DISPATCH-MACRO-CHARACTER (disp-char sub-char function &optional (readtable *readtable*)) +Package:LISP + +Causes FUNCTION to be called when the DISP-CHAR followed by SUB-CHAR is +read. + + +@end defun + +@deffn {Macro} WITH-OUTPUT-TO-STRING +Package:LISP + +Syntax: +@example +(with-output-to-string (var [string]) @{decl@}* @{form@}*) +@end example + +Binds VAR to a string output stream that puts characters into STRING, which +defaults to a new string. The stream is automatically closed on exit and +the string is returned. + + +@end deffn + +@defun FILE-LENGTH (file-stream) +Package:LISP + +Returns the length of the specified file stream. + + +@end defun + +@defvar *PRINT-CASE* +Package:LISP +The case in which the GCL printer should print ordinary symbols. +The value must be one of the keywords :UPCASE, :DOWNCASE, and :CAPITALIZE. + + +@end defvar + +@defun PRINT (object &optional (stream *standard-output*)) +Package:LISP + +Outputs a newline character, and then prints OBJECT in the mostly readable +representation. Returns OBJECT. Equivalent to + (PROGN (TERPRI STREAM) (WRITE OBJECT :STREAM STREAM :ESCAPE T)). + + +@end defun + +@defun SET-MACRO-CHARACTER (char function &optional (non-terminating-p nil) (readtable *readtable*)) +Package:LISP + +Causes CHAR to be a macro character that, when seen by READ, causes FUNCTION +to be called. + + +@end defun + +@defun FORCE-OUTPUT (&optional (stream *standard-output*)) +Package:LISP + +Attempts to force any buffered output to be sent. + + +@end defun + +@defvar *PRINT-ARRAY* +Package:LISP +Whether the GCL printer should print array elements. + + +@end defvar + +@defun STREAM-ELEMENT-TYPE (stream) +Package:LISP + +Returns a type specifier for the kind of object returned by STREAM. + + +@end defun + +@defun WRITE-BYTE (integer stream) +Package:LISP + +Outputs INTEGER to the binary stream STREAM. Returns INTEGER. + + +@end defun + +@defun MAKE-CONCATENATED-STREAM (&rest streams) +Package:LISP + +Returns a stream which takes its input from each of the STREAMs in turn, +going on to the next at end of stream. + + +@end defun + +@defun PRIN1 (object &optional (stream *standard-output*)) +Package:LISP + +Prints OBJECT in the mostly readable representation. Returns OBJECT. +Equivalent to (WRITE OBJECT :STREAM STREAM :ESCAPE T). + + +@end defun + +@defun PRINC (object &optional (stream *standard-output*)) +Package:LISP + +Prints OBJECT without escape characters. Returns OBJECT. Equivalent to + (WRITE OBJECT :STREAM STREAM :ESCAPE NIL). + + +@end defun + +@defun CLEAR-OUTPUT (&optional (stream *standard-output*)) +Package:LISP + +Clears the output stream STREAM. + + +@end defun + +@defun TERPRI (&optional (stream *standard-output*)) +Package:LISP + +Outputs a newline character. + + +@end defun + +@defun FINISH-OUTPUT (&optional (stream *standard-output*)) +Package:LISP + +Attempts to ensure that all output sent to STREAM has reached its destination, +and only then returns. + + +@end defun + +@deffn {Macro} WITH-OPEN-FILE +Package:LISP + +Syntax: +@example +(with-open-file (stream filename @{options@}*) @{decl@}* @{form@}*) +@end example + +Opens the file whose name is FILENAME, using OPTIONs, and binds the variable +STREAM to a stream to/from the file. Then evaluates FORMs as a PROGN. +The file is automatically closed on exit. + + +@end deffn + +@deffn {Special Form} DO +Package:LISP + +Syntax: +@example +(do (@{(var [init [step]])@}*) (endtest @{result@}*) + @{decl@}* @{tag | statement@}*) +@end example + +Creates a NIL block, binds each VAR to the value of the corresponding INIT, +and then executes STATEMENTs repeatedly until ENDTEST is satisfied. After +each iteration, assigns to each VAR the value of the corresponding STEP. When +ENDTEST is satisfied, evaluates RESULTs as a PROGN and returns the value(s) of +the last RESULT (or NIL if no RESULTs are supplied). Performs variable +bindings and assignments all at once, just like LET and PSETQ do. + + +@end deffn + +@defun READ-FROM-STRING (string &optional (eof-error-p t) (eof-value nil) &key (start 0) (end (length string)) (preserve-whitespace nil)) +Package:LISP + +Reads an object from STRING. + + +@end defun + +@defun WRITE-STRING (string &optional (stream *standard-output*) &key (start 0) (end (length string))) +Package:LISP + +Outputs STRING and returns it. + + +@end defun + +@defvar *PRINT-LEVEL* +Package:LISP +How many levels deep the GCL printer should print. Unlimited if NIL. + + +@end defvar + +@defvar *PRINT-RADIX* +Package:LISP +Whether the GCL printer should print the radix indicator when printing +integers and rationals. + + +@end defvar + +@defun Y-OR-N-P (&optional (format-string nil) &rest args) +Package:LISP + +Asks the user a question whose answer is either 'Y' or 'N'. If FORMAT-STRING +is non-NIL, then FRESH-LINE operation is performed, a message is printed as +if FORMAT-STRING and ARGs were given to FORMAT, and then a prompt +"(Y or N)" is printed. Otherwise, no prompt will appear. + + +@end defun + +@defun MAKE-BROADCAST-STREAM (&rest streams) +Package:LISP + +Returns an output stream which sends its output to all of the given streams. + + +@end defun + +@defun READ-CHAR (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)) +Package:LISP + +Reads a character from STREAM. + + +@end defun + +@defun PEEK-CHAR (&optional (peek-type nil) (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)) +Package:LISP + +Peeks at the next character in the input stream STREAM. + + +@end defun + +@defun OUTPUT-STREAM-P (stream) +Package:LISP + +Returns non-nil if STREAM can handle output operations; NIL otherwise. + + +@end defun + +@defvar *QUERY-IO* +Package:LISP +The query I/O stream. + + +@end defvar + +@defvar *READ-BASE* +Package:LISP +The radix that the GCL reader reads numbers in. + + +@end defvar + +@deffn {Macro} WITH-OPEN-STREAM +Package:LISP + +Syntax: +@example +(with-open-stream (var stream) @{decl@}* @{form@}*) +@end example + +Evaluates FORMs as a PROGN with VAR bound to the value of STREAM. The stream +is automatically closed on exit. + + +@end deffn + +@deffn {Macro} WITH-INPUT-FROM-STRING +Package:LISP + +Syntax: +@example +(with-input-from-string (var string @{keyword value@}*) @{decl@}* +@{form@}*) +@end example + +Binds VAR to an input stream that returns characters from STRING and evaluates +the FORMs. The stream is automatically closed on exit. Allowed keywords are +:INDEX, :START, and :END. + + +@end deffn + +@defun CLEAR-INPUT (&optional (stream *standard-input*)) +Package:LISP + Clears the input +stream STREAM. + + +@end defun + +@defvar *TERMINAL-IO* +Package:LISP +The terminal I/O stream. + + +@end defvar + +@defun LISTEN (&optional (stream *standard-input*)) +Package:LISP + +Returns T if a character is available on STREAM; NIL otherwise. This function +does not correctly work in some versions of GCL because of the lack of such +mechanism in the underlying operating system. + + +@end defun + +@defun MAKE-PATHNAME (&key (defaults (parse-namestring "" (pathname-host *default-pathname-defaults*))) (host (pathname-host defaults)) (device (pathname-device defaults)) (directory (pathname-directory defaults)) (name (pathname-name defaults)) (type (pathname-type defaults)) (version (pathname-version defaults))) +Package:LISP + +Create a pathname from HOST, DEVICE, DIRECTORY, NAME, TYPE and VERSION. + + +@end defun + +@defun PATHNAME-TYPE (pathname) +Package:LISP + +Returns the type slot of PATHNAME. + + +@end defun + +@defvar *PRINT-GENSYM* +Package:LISP +Whether the GCL printer should prefix symbols with no home package +with "#:". + + +@end defvar + +@defun READ-LINE (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)) +Package:LISP + +Returns a line of text read from STREAM as a string, discarding the newline +character. + +Note that when using line at a time input under unix, +input forms will always be followed by a #\newline. Thus if you +do + +>(read-line) +"" +nil + +the empty string will be returned. After lisp reads the (read-line) +it then invokes (read-line). This happens before it does anything +else and so happens before the newline character immediately following +(read-line) has been read. Thus read-line immediately encounters a +#\newline and so returns the empty string. If there had been other +characters before the #\newline it would have been different: + +>(read-line) how are you +" how are you" +nil + +If you want to throw away "" input, you can do that with +the following: + +(sloop::sloop while (equal (setq input (read-line)) "")) + +You may also want to use character at a time input, but that +makes input editing harder. +nicolas% stty cbreak +nicolas% gcl +GCL (GNU Common Lisp) Version(1.1.2) Mon Jan 9 12:58:22 MET 1995 +Licensed under GNU Public Library License +Contains Enhancements by W. Schelter + +>(let ((ifilename nil)) + (format t "~%Input file name: ") + (setq ifilename (read-line))) +Input file name: /tmp/myfile +"/tmp/myfile" + +>(bye)Bye. + + + + +@end defun + +@defun WRITE-TO-STRING (object &key (escape *print-escape*) (radix *print-radix*) (base *print-base*) (circle *print-circle*) (pretty *print-pretty*) (level *print-level*) (length *print-length*) (case *print-case*) (array *print-array*) (gensym *print-gensym*)) +Package:LISP + +Returns as a string the printed representation of OBJECT in the specified +mode. See the variable docs of *PRINT-...* for the mode. + + +@end defun + +@defun PATHNAMEP (x) +Package:LISP + +Returns T if X is a pathname object; NIL otherwise. + + +@end defun + +@defun READTABLEP (x) +Package:LISP + +Returns T if X is a readtable object; NIL otherwise. + + +@end defun + +@defun READ (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursivep nil)) +Package:LISP + +Reads in the next object from STREAM. + + +@end defun + +@defun NAMESTRING (pathname) +Package:LISP + +Returns the full form of PATHNAME as a string. + + +@end defun + +@defun UNREAD-CHAR (character &optional (stream *standard-input*)) +Package:LISP + +Puts CHARACTER back on the front of the input stream STREAM. + + +@end defun + +@defun CLOSE (stream &key (abort nil)) +Package:LISP + +Closes STREAM. A non-NIL value of :ABORT indicates an abnormal termination. + + +@end defun + +@defvar *PRINT-LENGTH* +Package:LISP +How many elements the GCL printer should print at each level of nested data +object. Unlimited if NIL. + + +@end defvar + +@defun SET-SYNTAX-FROM-CHAR (to-char from-char &optional (to-readtable *readtable*) (from-readtable nil)) +Package:LISP + +Makes the syntax of TO-CHAR in TO-READTABLE be the same as the syntax of +FROM-CHAR in FROM-READTABLE. + + +@end defun + +@defun INPUT-STREAM-P (stream) +Package:LISP + +Returns non-NIL if STREAM can handle input operations; NIL otherwise. + + +@end defun + +@defun PATHNAME (x) +Package:LISP + +Turns X into a pathname. X may be a string, symbol, stream, or pathname. + + +@end defun + +@defun FILE-NAMESTRING (pathname) +Package:LISP + +Returns the written representation of PATHNAME as a string. + + +@end defun + +@defun MAKE-DISPATCH-MACRO-CHARACTER (char &optional (non-terminating-p nil) (readtable *readtable*)) +Package:LISP + +Causes the character CHAR to be a dispatching macro character in READTABLE. + + +@end defun + +@defvar *STANDARD-OUTPUT* +Package:LISP +The default output stream used by the GCL printer. + + +@end defvar + +@defun MAKE-TWO-WAY-STREAM (input-stream output-stream) +Package:LISP + +Returns a bidirectional stream which gets its input from INPUT-STREAM and +sends its output to OUTPUT-STREAM. + + +@end defun + +@defvar *PRINT-ESCAPE* +Package:LISP +Whether the GCL printer should put escape characters whenever appropriate. + + +@end defvar + +@defun COPY-READTABLE (&optional (from-readtable *readtable*) (to-readtable nil)) +Package:LISP + +Returns a copy of the readtable FROM-READTABLE. If TO-READTABLE is non-NIL, +then copies into TO-READTABLE. Otherwise, creates a new readtable. + + +@end defun + +@defun DIRECTORY-NAMESTRING (pathname) +Package:LISP + +Returns the directory part of PATHNAME as a string. + + +@end defun + +@defun TRUENAME (pathname) +Package:LISP + +Returns the pathname for the actual file described by PATHNAME. + + +@end defun + +@defvar *READ-SUPPRESS* +Package:LISP +When the value of this variable is NIL, the GCL reader operates normally. +When it is non-NIL, then the reader parses input characters but much of what +is read is not interpreted. + + +@end defvar + +@defun GET-DISPATCH-MACRO-CHARACTER (disp-char sub-char &optional (readtable *readtable*)) +Package:LISP + +Returns the macro-character function for SUB-CHAR under DISP-CHAR. + + +@end defun + +@defun PATHNAME-DEVICE (pathname) +Package:LISP + +Returns the device slot of PATHNAME. + + +@end defun + +@defun READ-CHAR-NO-HANG (&optional (stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil)) +Package:LISP + +Returns the next character from STREAM if one is available; NIL otherwise. + + +@end defun + +@defun FRESH-LINE (&optional (stream *standard-output*)) +Package:LISP + +Outputs a newline if it is not positioned at the beginning of a line. Returns +T if it output a newline; NIL otherwise. + + +@end defun + +@defun WRITE-CHAR (char &optional (stream *standard-output*)) +Package:LISP + +Outputs CHAR and returns it. + + +@end defun + +@defun PARSE-NAMESTRING (thing &optional host (defaults *default-pathname-defaults*) &key (start 0) (end (length thing)) (junk-allowed nil)) +Package:LISP + +Parses a string representation of a pathname into a pathname. HOST +is ignored. + + +@end defun + +@defun PATHNAME-DIRECTORY (pathname) +Package:LISP + +Returns the directory slot of PATHNAME. + + +@end defun + +@defun GET-MACRO-CHARACTER (char &optional (readtable *readtable*)) +Package:LISP + +Returns the function associated with CHAR and, as a second value, returns +the non-terminating-p flag. + + +@end defun + +@defun FORMAT (destination control-string &rest arguments) +Package:LISP + +Provides various facilities for formatting output. +DESTINATION controls where the result will go. If DESTINATION is T, then +the output is sent to the standard output stream. If it is NIL, then the +output is returned in a string as the value of the call. Otherwise, +DESTINATION must be a stream to which the output will be sent. + +CONTROL-STRING is a string to be output, possibly with embedded +formatting directives, which are flagged with the escape character +"~". Directives generally expand into additional text to be output, +usually consuming one or more of ARGUMENTs in the process. + + + +A few useful directives are: +@example + +~A, ~nA, ~n@@A Prints one argument as if by PRINC +~S, ~nS, ~n@@S Prints one argument as if by PRIN1 +~D, ~B, ~O, ~X Prints one integer in decimal, binary, octal, and hexa +~% Does TERPRI +~& Does FRESH-LINE +@end example + +where n is the minimal width of the field in which the object is printed. +~nA and ~nS put padding spaces on the right; ~n@@A and ~n@@S put on the left. + +@example +~R is for printing numbers in various formats. + + ~nR prints arg in radix n. + ~R prints arg as a cardinal english number: two + ~:R prints arg as an ordinal english number: third + ~@@R prints arg as an a Roman Numeral: VII + ~:@@R prints arg as an old Roman Numeral: IIII + +~C prints a character. + ~:C represents non printing characters by their pretty names,eg Space + ~@@C uses the #\ syntax to allow the reader to read it. + +~F prints a floating point number arg. + The full form is ~w,d,k,overflowchar,padcharF + w represents the total width of the printed representation (variable if + not present) + d the number of fractional digits to display + (format nil "~,2f" 10010.0314) --> "10010.03" + k arg is multiplied by 10^k before printing it as a decimal number. + overflowchar width w characters copies of the overflow character will + be printed. eg(format t "X>~5,2,,'?F X>?????~10,2,1,'?,'bFX>bbb1000.34 "BIL" + (format nil "~@@[x = ~d ~]~a" 8) --> "x = 8 BIL" +@end example + + +@end defun + +@defun PATHNAME-NAME (pathname) +Package:LISP + +Returns the name slot of PATHNAME. + + +@end defun + +@defun MAKE-STRING-OUTPUT-STREAM () +Package:LISP + +Returns an output stream which will accumulate all output given it for +the benefit of the function GET-OUTPUT-STREAM-STRING. + + +@end defun + +@defun MAKE-SYNONYM-STREAM (symbol) +Package:LISP + +Returns a stream which performs its operations on the stream which is the +value of the dynamic variable named by SYMBOL. + + +@end defun + +@defvar *LOAD-VERBOSE* +Package:LISP +The default for the VERBOSE argument to LOAD. + + +@end defvar + +@defvar *PRINT-CIRCLE* +Package:LISP +Whether the GCL printer should take care of circular lists. + + +@end defvar + +@defvar *PRINT-PRETTY* +Package:LISP +Whether the GCL printer should pretty-print. See the function doc of PPRINT +for more information about pretty-printing. + + +@end defvar + +@defun FILE-WRITE-DATE (file) +Package:LISP + +Returns the time at which the specified file is written, as an integer in +universal time format. FILE may be a string or a stream. + + +@end defun + +@defun PRIN1-TO-STRING (object) +Package:LISP + +Returns as a string the printed representation of OBJECT in the mostly +readable representation. +Equivalent to (WRITE-TO-STRING OBJECT :ESCAPE T). + + +@end defun + +@defun MERGE-PATHNAMES (pathname &optional (defaults *default-pathname-defaults*) default-version) +Package:LISP + +Fills in unspecified slots of PATHNAME from DEFAULTS. DEFAULT-VERSION +is ignored in GCL. + + +@end defun + +@defun READ-BYTE (stream &optional (eof-error-p t) (eof-value nil)) +Package:LISP + +Reads the next byte from STREAM. + + +@end defun + +@defun PRINC-TO-STRING (object) +Package:LISP + +Returns as a string the printed representation of OBJECT without escape +characters. Equivalent to + (WRITE-TO-STRING OBJECT :ESCAPE NIL). + + +@end defun + +@defvar *STANDARD-INPUT* +Package:LISP +The default input stream used by the GCL reader. + + +@end defvar + +@defun PROBE-FILE (file) +Package:LISP + +Returns the truename of file if the file exists. +Returns NIL otherwise. + + +@end defun + +@defun PATHNAME-VERSION (pathname) +Package:LISP + +Returns the version slot of PATHNAME. + + +@end defun + +@defun WRITE-LINE (string &optional (stream *standard-output*) &key (start 0) (end (length string))) +Package:LISP + +Outputs STRING and then outputs a newline character. Returns STRING. + + +@end defun + +@defun WRITE (object &key (stream *standard-output*) (escape *print-escape*) (radix *print-radix*) (base *print-base*) (circle *print-circle*) (pretty *print-pretty*) (level *print-level*) (length *print-length*) (case *print-case*) (array *print-array*) (gensym *print-gensym*)) +Package:LISP + +Prints OBJECT in the specified mode. See the variable docs of *PRINT-...* +for the mode. + + +@end defun + +@defun GET-OUTPUT-STREAM-STRING (stream) +Package:LISP + +Returns a string of all the characters sent to STREAM made by +MAKE-STRING-OUTPUT-STREAM since the last call to this function. + + +@end defun + +@defun READ-DELIMITED-LIST (char &optional (stream *standard-input*) (recursive-p nil)) +Package:LISP + +Reads objects from STREAM until the next character after an object's +representation is CHAR. Returns a list of the objects read. + + +@end defun + +@defun READLINE-ON () +Package:SI + +Begins readline command editing mode when possible. In addition to +the basic readline editing features, command word completion is +implemented according to the following scheme: + +[[pkg]:[:]]txt + +pkg -- an optional package specifier. Defaults to the current +package. The symbols in this package and those in the packages in +this package's use list will be searched. + +:[:] -- an optional internal/external specifier. Defaults to +external. The keyword package is denoted by a single colon at the +beginning of the token. Only symbols of this type will be searched +for completion. + +txt -- a string. Symbol names beginning with this string are +completed. The comparison is case insensitive. + + +@end defun + +@defun READLINE-OFF () +Package:SI + +Disables readline command editing mode. + +@end defun + +@defvar *READLINE-PREFIX* +Package:SI + +A string implicitly prepended to input text for use in readline +command completion. If this string contains one or more colons, it is +used to specify the default package and internal/external setting for +searched symbols in the case that the supplied text itself contains no +explicit package specification. If this string contains characters +after the colon(s), or contains no colons at all, it is treated as a +symbol name prefix. In this case, the prefix is matched first, then +the supplied text, and the completion returned is relative to the +supplied text itself, i.e. contains no prefix. For example, the +setting ``maxima::$'' will complete input text ``int'' according to +the internal symbols in the maxima package of the form +``maxima::$int...'', and return suggestions to the user of the form +``int...''. + +@end defvar + diff --git a/info/iteration.texi b/info/iteration.texi new file mode 100755 index 0000000..fab87a2 --- /dev/null +++ b/info/iteration.texi @@ -0,0 +1,149 @@ +@node Iteration and Tests, User Interface, Structures, Top +@chapter Iteration and Tests + +@deffn {Macro} DO-EXTERNAL-SYMBOLS +Package:LISP + +Syntax: +@example +(do-external-symbols (var [package [result-form]]) + @{decl@}* @{tag | statement@}*) +@end example + +Executes STATEMENTs once for each external symbol in the PACKAGE (which +defaults to the current package), with VAR bound to the current symbol. +Then evaluates RESULT-FORM (which defaults to NIL) and returns the value(s). + + +@end deffn + +@deffn {Special Form} DO* +Package:LISP + +Syntax: +@example +(do* (@{(var [init [step]])@}*) (endtest @{result@}*) + @{decl@}* @{tag | statement@}*) +@end example + +Just like DO, but performs variable bindings and assignments in serial, just +like LET* and SETQ do. + + +@end deffn + +@deffn {Macro} DO-ALL-SYMBOLS +Package:LISP + +Syntax: +@example +(do-all-symbols (var [result-form]) @{decl@}* @{tag | statement@}*) +@end example + +Executes STATEMENTs once for each symbol in each package, with VAR bound to +the current symbol. Then evaluates RESULT-FORM (which defaults to NIL) and +returns the value(s). + + +@end deffn + +@defun YES-OR-NO-P (&optional (format-string nil) &rest args) +Package:LISP + +Asks the user a question whose answer is either 'YES' or 'NO'. If FORMAT- +STRING is non-NIL, then FRESH-LINE operation is performed, a message is +printed as if FORMAT-STRING and ARGs were given to FORMAT, and then a prompt +"(Yes or No)" is printed. Otherwise, no prompt will appear. + + +@end defun + +@defun MAPHASH #'hash-table +Package:LISP + +For each entry in HASH-TABLE, calls FUNCTION on the key and value of the +entry; returns NIL. + + +@end defun + +@defun MAPCAR (fun list &rest more-lists) +Package:LISP + +Applies FUN to successive cars of LISTs and returns the results as a list. + + +@end defun + +@deffn {Special Form} DOLIST +Package:LISP + +Syntax: +@example +(dolist (var listform [result]) @{decl@}* @{tag | statement@}*) +@end example + +Executes STATEMENTs, with VAR bound to each member of the list value of +LISTFORM. Then returns the value(s) of RESULT (which defaults to NIL). + + +@end deffn + +@defun EQ (x y) +Package:LISP + +Returns T if X and Y are the same identical object; NIL otherwise. + + +@end defun + +@defun EQUALP (x y) +Package:LISP + +Returns T if X and Y are EQUAL, if they are characters and satisfy CHAR-EQUAL, +if they are numbers and have the same numerical value, or if they have +components that are all EQUALP. Returns NIL otherwise. + + +@end defun + +@defun EQUAL (x y) +Package:LISP + +Returns T if X and Y are EQL or if they are of the same type and corresponding +components are EQUAL. Returns NIL otherwise. Strings and bit-vectors are +EQUAL if they are the same length and have identical components. Other +arrays must be EQ to be EQUAL. + + +@end defun + +@deffn {Macro} DO-SYMBOLS +Package:LISP + +Syntax: +@example +(do-symbols (var [package [result-form]]) @{decl@}* @{tag | +statement@}*) +@end example + +Executes STATEMENTs once for each symbol in the PACKAGE (which defaults to +the current package), with VAR bound to the current symbol. Then evaluates +RESULT-FORM (which defaults to NIL) and returns the value(s). + + +@end deffn + +@deffn {Special Form} LOOP +Package:LISP + +Syntax: +@example +(loop @{form@}*) +@end example + +Executes FORMs repeatedly until exited by a THROW or RETURN. The FORMs are +surrounded by an implicit NIL block. + + +@end deffn diff --git a/info/list.texi b/info/list.texi new file mode 100755 index 0000000..12c5889 --- /dev/null +++ b/info/list.texi @@ -0,0 +1,899 @@ +@node Lists, Streams and Reading, Characters, Top +@chapter Lists + +@defun NINTERSECTION (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns the intersection of LIST1 and LIST2. LIST1 may be destroyed. + + +@end defun + +@defun RASSOC-IF (predicate alist) +Package:LISP + +Returns the first cons in ALIST whose cdr satisfies PREDICATE. + + +@end defun + +@defun MAKE-LIST (size &key (initial-element nil)) +Package:LISP + +Creates and returns a list containing SIZE elements, each of which is +initialized to INITIAL-ELEMENT. + + +@end defun + +@defun NTH (n list) +Package:LISP + +Returns the N-th element of LIST, where the car of LIST is the zeroth +element. + + +@end defun + +@defun CAAR (x) +Package:LISP + +Equivalent to (CAR (CAR X)). + + +@end defun + +@defun NULL (x) +Package:LISP + +Returns T if X is NIL; NIL otherwise. + + +@end defun + +@defun FIFTH (x) +Package:LISP + +Equivalent to (CAR (CDDDDR X)). + + +@end defun + +@defun NCONC (&rest lists) +Package:LISP + +Concatenates LISTs by destructively modifying them. + + +@end defun + +@defun TAILP (sublist list) +Package:LISP + +Returns T if SUBLIST is one of the conses in LIST; NIL otherwise. + + +@end defun + +@defun CONSP (x) +Package:LISP + +Returns T if X is a cons; NIL otherwise. + + +@end defun + +@defun TENTH (x) +Package:LISP + +Equivalent to (CADR (CDDDDR (CDDDDR X))). + + +@end defun + +@defun LISTP (x) +Package:LISP + +Returns T if X is either a cons or NIL; NIL otherwise. + + +@end defun + +@defun MAPCAN (fun list &rest more-lists) +Package:LISP + +Applies FUN to successive cars of LISTs, NCONCs the results, and returns it. + + +@end defun + +@defun EIGHTH (x) +Package:LISP + +Equivalent to (CADDDR (CDDDDR X)). + + +@end defun + +@defun LENGTH (sequence) +Package:LISP + +Returns the length of SEQUENCE. + + +@end defun + +@defun RASSOC (item alist &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns the first cons in ALIST whose cdr is equal to ITEM. + + +@end defun + +@defun NSUBST-IF-NOT (new test tree &key (key #'identity)) +Package:LISP + +Substitutes NEW for subtrees of TREE that do not satisfy TEST. + + +@end defun + +@defun NBUTLAST (list &optional (n 1)) +Package:LISP + +Changes the cdr of the N+1 th cons from the end of the list LIST to NIL. +Returns the whole list. + + +@end defun + + + +@defun CDR (list) +Package:LISP + +Returns the cdr of LIST. Returns NIL if LIST is NIL. + + +@end defun + +@defun MAPC (fun list &rest more-lists) +Package:LISP + +Applies FUN to successive cars of LISTs. Returns the first LIST. + + +@end defun + +@defun MAPL (fun list &rest more-lists) +Package:LISP + +Applies FUN to successive cdrs of LISTs. Returns the first LIST. + + +@end defun + +@defun CONS (x y) +Package:LISP + +Returns a new cons whose car and cdr are X and Y, respectively. + + +@end defun + +@defun LIST (&rest args) +Package:LISP + +Returns a list of its arguments + + +@end defun + + +@defun THIRD (x) +Package:LISP + +Equivalent to (CADDR X). + + +@end defun + +@defun CDDAAR (x) +Package:LISP + +Equivalent to (CDR (CDR (CAR (CAR X)))). + + +@end defun + +@defun CDADAR (x) +Package:LISP + +Equivalent to (CDR (CAR (CDR (CAR X)))). + + +@end defun + +@defun CDAADR (x) +Package:LISP + +Equivalent to (CDR (CAR (CAR (CDR X)))). + + +@end defun + +@defun CADDAR (x) +Package:LISP + +Equivalent to (CAR (CDR (CDR (CAR X)))). + + +@end defun + +@defun CADADR (x) +Package:LISP + +Equivalent to (CAR (CDR (CAR (CDR X)))). + + +@end defun + +@defun CAADDR (x) +Package:LISP + +Equivalent to (CAR (CAR (CDR (CDR X)))). + + +@end defun + +@defun NTHCDR (n list) +Package:LISP + +Returns the result of performing the CDR operation N times on LIST. + + +@end defun + +@defun PAIRLIS (keys data &optional (alist nil)) +Package:LISP + +Constructs an association list from KEYS and DATA adding to ALIST. + + +@end defun + +@defun SEVENTH (x) +Package:LISP + +Equivalent to (CADDR (CDDDDR X)). + + +@end defun + +@defun SUBSETP (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns T if every element of LIST1 appears in LIST2; NIL otherwise. + + +@end defun + +@defun NSUBST-IF (new test tree &key (key #'identity)) +Package:LISP + +Substitutes NEW for subtrees of TREE that satisfy TEST. + + +@end defun + +@defun COPY-LIST (list) +Package:LISP + +Returns a new copy of LIST. + + +@end defun + +@defun LAST (list) +Package:LISP + +Returns the last cons in LIST + + +@end defun + +@defun CAAAR (x) +Package:LISP + +Equivalent to (CAR (CAR (CAR X))). + + +@end defun + +@defun LIST-LENGTH (list) +Package:LISP + +Returns the length of LIST, or NIL if LIST is circular. + + +@end defun + +@defun CDDDR (x) +Package:LISP + +Equivalent to (CDR (CDR (CDR X))). + + +@end defun + +@defun INTERSECTION (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns the intersection of List1 and List2. + + +@end defun + +@defun NSUBST (new old tree &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Substitutes NEW for subtrees in TREE that match OLD. + + +@end defun + +@defun REVAPPEND (x y) +Package:LISP + +Equivalent to (APPEND (REVERSE X) Y) + + +@end defun + +@defun CDAR (x) +Package:LISP + +Equivalent to (CDR (CAR X)). + + +@end defun + +@defun CADR (x) +Package:LISP + +Equivalent to (CAR (CDR X)). + + +@end defun + +@defun REST (x) +Package:LISP + +Equivalent to (CDR X). + + +@end defun + +@defun NSET-EXCLUSIVE-OR (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns a list with elements which appear but once in LIST1 and LIST2. + + +@end defun + +@defun ACONS (key datum alist) +Package:LISP + +Constructs a new alist by adding the pair (KEY . DATUM) to ALIST. + + +@end defun + +@defun SUBST-IF-NOT (new test tree &key (key #'identity)) +Package:LISP + +Substitutes NEW for subtrees of TREE that do not satisfy TEST. + + +@end defun + +@defun RPLACA (x y) +Package:LISP + +Replaces the car of X with Y, and returns the modified X. + + +@end defun + +@defun SECOND (x) +Package:LISP + +Equivalent to (CADR X). + + +@end defun + +@defun NUNION (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns the union of LIST1 and LIST2. LIST1 and/or LIST2 may be destroyed. + + +@end defun + +@defun BUTLAST (list &optional (n 1)) +Package:LISP + +Creates and returns a list with the same elements as LIST but without the +last N elements. + + +@end defun + +@defun COPY-ALIST (alist) +Package:LISP + Returns a new copy of ALIST. + + +@end defun + +@defun SIXTH (x) +Package:LISP + Equivalent to (CADR (CDDDDR X)). + + +@end defun + +@defun CAAAAR (x) +Package:LISP + +Equivalent to (CAR (CAR (CAR (CAR X)))). + + +@end defun + +@defun CDDDAR (x) +Package:LISP + +Equivalent to (CDR (CDR (CDR (CAR X)))). + + +@end defun + +@defun CDDADR (x) +Package:LISP + +Equivalent to (CDR (CDR (CAR (CDR X)))). + + +@end defun + +@defun CDADDR (x) +Package:LISP + +Equivalent to (CDR (CAR (CDR (CDR X)))). + + +@end defun + +@defun CADDDR (x) +Package:LISP + +Equivalent to (CAR (CDR (CDR (CDR X)))). + + +@end defun + +@defun FOURTH (x) +Package:LISP + +Equivalent to (CADDDR X). + + +@end defun + +@defun NSUBLIS (alist tree &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Substitutes from ALIST for subtrees of TREE. + + +@end defun + +@defun SUBST-IF (new test tree &key (key #'identity)) +Package:LISP + +Substitutes NEW for subtrees of TREE that satisfy TEST. + + +@end defun + +@defun NSET-DIFFERENCE (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns a list of elements of LIST1 that do not appear in LIST2. LIST1 may +be destroyed. + + +@end defun + +@deffn {Special Form} POP +Package:LISP + +Syntax: +@example +(pop place) +@end example + +Pops one item off the front of the list in PLACE and returns it. + + +@end deffn + +@deffn {Special Form} PUSH +Package:LISP + +Syntax: +@example +(push item place) +@end example + +Conses ITEM onto the list in PLACE, and returns the new list. + + +@end deffn + +@defun CDAAR (x) +Package:LISP + +Equivalent to (CDR (CAR (CAR X))). + + +@end defun + +@defun CADAR (x) +Package:LISP + +Equivalent to (CAR (CDR (CAR X))). + + +@end defun + +@defun CAADR (x) +Package:LISP + +Equivalent to (CAR (CAR (CDR X))). + + +@end defun + +@defun FIRST (x) +Package:LISP + +Equivalent to (CAR X). + + +@end defun + +@defun SUBST (new old tree &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Substitutes NEW for subtrees of TREE that match OLD. + + +@end defun + +@defun ADJOIN (item list &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Adds ITEM to LIST unless ITEM is already a member of LIST. + + +@end defun + +@defun MAPCON (fun list &rest more-lists) +Package:LISP + +Applies FUN to successive cdrs of LISTs, NCONCs the results, and returns it. + + +@end defun + +@deffn {Macro} PUSHNEW +Package:LISP + +Syntax: +@example +(pushnew item place @{keyword value@}*) +@end example + +If ITEM is already in the list stored in PLACE, does nothing. Else, conses +ITEM onto the list. Returns NIL. If no KEYWORDs are supplied, each element +in the list is compared with ITEM by EQL, but the comparison can be controlled +by supplying keywords :TEST, :TEST-NOT, and/or :KEY. + + +@end deffn + +@defun SET-EXCLUSIVE-OR (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns a list of elements appearing exactly once in LIST1 and LIST2. + + +@end defun + +@defun TREE-EQUAL (x y &key (test #'eql) test-not) +Package:LISP + +Returns T if X and Y are isomorphic trees with identical leaves. + + +@end defun + +@defun CDDR (x) +Package:LISP + +Equivalent to (CDR (CDR X)). + + +@end defun + +@defun GETF (place indicator &optional (default nil)) +Package:LISP + +Searches the property list stored in Place for an indicator EQ to Indicator. +If one is found, the corresponding value is returned, else the Default is +returned. + + +@end defun + +@defun LDIFF (list sublist) +Package:LISP + +Returns a new list, whose elements are those of LIST that appear before +SUBLIST. If SUBLIST is not a tail of LIST, a copy of LIST is returned. + + +@end defun + +@defun UNION (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns the union of LIST1 and LIST2. + + +@end defun + +@defun ASSOC-IF-NOT (test alist) +Package:LISP + +Returns the first pair in ALIST whose car does not satisfy TEST. + + +@end defun + +@defun RPLACD (x y) +Package:LISP + +Replaces the cdr of X with Y, and returns the modified X. + + +@end defun + +@defun MEMBER-IF-NOT (test list &key (key #'identity)) +Package:LISP + +Returns the tail of LIST beginning with the first element not satisfying +TEST. + + +@end defun + +@defun CAR (list) +Package:LISP + +Returns the car of LIST. Returns NIL if LIST is NIL. + + +@end defun + +@defun ENDP (x) +Package:LISP + +Returns T if X is NIL. Returns NIL if X is a cons. Otherwise, signals an +error. + + +@end defun + +@defun LIST* (arg &rest others) +Package:LISP + +Returns a list of its arguments with the last cons being a dotted pair of +the next to the last argument and the last argument. + + +@end defun + +@defun NINTH (x) +Package:LISP + +Equivalent to (CAR (CDDDDR (CDDDDR X))). + + +@end defun + +@defun CDAAAR (x) +Package:LISP + +Equivalent to (CDR (CAR (CAR (CAR X)))). + + +@end defun + +@defun CADAAR (x) +Package:LISP + +Equivalent to (CAR (CDR (CAR (CAR X)))). + + +@end defun + +@defun CAADAR (x) +Package:LISP + +Equivalent to (CAR (CAR (CDR (CAR X)))). + + +@end defun + +@defun CAAADR (x) +Package:LISP + +Equivalent to (CAR (CAR (CAR (CDR X)))). + + +@end defun + +@defun CDDDDR (x) +Package:LISP + +Equivalent to (CDR (CDR (CDR (CDR X)))). + + +@end defun + +@defun SUBLIS (alist tree &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Substitutes from ALIST for subtrees of TREE nondestructively. + + +@end defun + +@defun RASSOC-IF-NOT (predicate alist) +Package:LISP + +Returns the first cons in ALIST whose cdr does not satisfy PREDICATE. + + +@end defun + +@defun NRECONC (x y) +Package:LISP + +Equivalent to (NCONC (NREVERSE X) Y). + + +@end defun + +@defun MAPLIST (fun list &rest more-lists) +Package:LISP + +Applies FUN to successive cdrs of LISTs and returns the results as a list. + + +@end defun + +@defun SET-DIFFERENCE (list1 list2 &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns a list of elements of LIST1 that do not appear in LIST2. + + +@end defun + +@defun ASSOC-IF (test alist) +Package:LISP + +Returns the first pair in ALIST whose car satisfies TEST. + + +@end defun + +@defun GET-PROPERTIES (place indicator-list) +Package:LISP + +Looks for the elements of INDICATOR-LIST in the property list stored in PLACE. +If found, returns the indicator, the value, and T as multiple-values. If not, +returns NILs as its three values. + + +@end defun + +@defun MEMBER-IF (test list &key (key #'identity)) +Package:LISP + +Returns the tail of LIST beginning with the first element satisfying TEST. + + +@end defun + +@defun COPY-TREE (object) +Package:LISP + +Recursively copies conses in OBJECT and returns the result. + + +@end defun + +@defun ATOM (x) +Package:LISP + +Returns T if X is not a cons; NIL otherwise. + + +@end defun + +@defun CDDAR (x) +Package:LISP + +Equivalent to (CDR (CDR (CAR X))). + + +@end defun + +@defun CDADR (x) +Package:LISP + +Equivalent to (CDR (CAR (CDR X))). + + +@end defun + +@defun CADDR (x) +Package:LISP + +Equivalent to (CAR (CDR (CDR X))). + + +@end defun + +@defun ASSOC (item alist &key (test #'eql) test-not) +Package:LISP + +Returns the first pair in ALIST whose car is equal (in the sense of TEST) to +ITEM. + + +@end defun + +@defun APPEND (&rest lists) +Package:LISP + +Constructs a new list by concatenating its arguments. + + +@end defun + +@defun MEMBER (item list &key (test #'eql) test-not (key #'identity)) +Package:LISP + +Returns the tail of LIST beginning with the first ITEM. + + +@end defun diff --git a/info/makefile b/info/makefile new file mode 100644 index 0000000..490b319 --- /dev/null +++ b/info/makefile @@ -0,0 +1,126 @@ +.SUFFIXES: +.SUFFIXES: .info .pdf .texi + +INFO_DIR=/usr/local/lib/info + +GCL_PDF=gcl-tk.pdf gcl-si.pdf gcl.pdf +#GCL_DVI=gcl-tk.dvi gcl-si.dvi #gcl.dvi +#GCL_HTML=gcl-si_toc.html gcl-tk_toc.html gcl_toc.html +GCL_HTML=gcl-si/index.html gcl-tk/index.html gcl/index.html + +-include ../makedefs + +#HTML_CMD=texi2html -split_chapter +HTML_CMD=$(MAKEINFO) --html + +all: gcl-tk.info gcl-si.info $(GCL_PDF) $(GCL_HTML) gcl.info + +.texi.info: + rm -f $*.*gz + -$(MAKEINFO) $*.texi + - gzip $*.info-* + +GCL_SI= number.texi sequence.texi character.texi list.texi io.texi \ + form.texi compile.texi symbol.texi system.texi structure.texi \ + iteration.texi user-interface.texi doc.texi type.texi internal.texi \ + c-interface.texi si-defs.texi debug.texi misc.texi compiler-defs.texi \ + gcl-si-index.texi +GCL_TK= general.texi widgets.texi control.texi +GCL_MAN= chap-1.texi chap-2.texi chap-3.texi chap-4.texi chap-5.texi \ + chap-6.texi chap-7.texi chap-8.texi chap-9.texi chap-10.texi chap-11.texi \ + chap-12.texi chap-13.texi chap-14.texi chap-15.texi chap-16.texi chap-17.texi \ + chap-18.texi chap-19.texi chap-20.texi chap-21.texi chap-22.texi chap-23.texi \ + chap-24.texi chap-25.texi chap-26.texi chap-a.texi + +%.pdf: %.dvi + -dvipdfm $< + +gcl-si.dvi: ${GCL_SI} gcl-si.texi + -TEXINPUTS=.:$$TEXINPUTS tex --interaction nonstopmode gcl-si.texi || true + rm -f *.cp *.ky *.vr *.tp *.pg *.toc *.aux *.log *.fn + +gcl-si.info: ${GCL_SI} gcl-si.texi + -$(MAKEINFO) gcl-si.texi + +gcl-tk.dvi: ${GCL_TK} gcl-tk.texi + -TEXINPUTS=.:$$TEXINPUTS tex --interaction nonstopmode gcl-tk.texi || true + rm -f *.cp *.ky *.vr *.tp *.pg *.toc *.aux *.log *.fn + +gcl-tk.info: ${GCL_TK} gcl-tk.texi + -$(MAKEINFO) gcl-tk.texi + +gcl.dvi: ${GCL_MAN} gcl.texi + -TEXINPUTS=.:$$TEXINPUTS tex --interaction nonstopmode gcl.texi || true + rm -f *.cp *.ky *.vr *.tp *.pg *.toc *.aux *.log *.fn + +gcl.info: ${GCL_MAN} gcl.texi + -$(MAKEINFO) gcl.texi + +#gcl-si_toc.html: ${GCL_SI} gcl-si.texi +# $(HTML_CMD) gcl-si.texi + +#gcl-tk_toc.html: ${GCL_TK} gcl-tk.texi +# $(HTML_CMD) gcl-tk.texi + +#gcl_toc.html: +# $(HTML_CMD) gcl.texi + +gcl-si/index.html: ${GCL_SI} gcl-si.texi + mkdir -p $(@D) + touch $@ + -$(HTML_CMD) gcl-si.texi + +gcl-tk/index.html: ${GCL_TK} gcl-tk.texi + mkdir -p $(@D) + touch $@ + -$(HTML_CMD) gcl-tk.texi + +gcl/index.html: gcl.texi + mkdir -p $(@D) + touch $@ + -$(HTML_CMD) gcl.texi + +install: #$(GCL_PDF) $(GCL_HTML) + mkdir -p $(DESTDIR)${INFO_DIR} + [ -f $(DESTDIR)$(INFO_DIR)dir ] || touch $(DESTDIR)$(INFO_DIR)dir + grep gcl-si $(DESTDIR)${INFO_DIR}dir >/dev/null 2>&1 || \ + echo "* GCL Doc: (gcl-si.info). GNU Common Lisp specific Documentation." >> $(DESTDIR)${INFO_DIR}dir + grep gcl-tk $(DESTDIR)${INFO_DIR}dir >/dev/null 2>&1 || \ + echo "* GCL TK Doc: (gcl-tk.info). TK window GCL interface." >> $(DESTDIR)${INFO_DIR}dir + grep gcl.info $(DESTDIR)${INFO_DIR}dir >/dev/null 2>&1 || \ + echo "* GCL Ansi Doc: (gcl.info). Ansi Common Lisp Specification." >> $(DESTDIR)${INFO_DIR}dir + -cp *.info* $(DESTDIR)${INFO_DIR} +# -mkdir -p $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl.html +# -mkdir -p $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl-si.html +# -mkdir -p $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl-tk.html +# -cp gcl_*html gcl.html $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl.html +# -cp gcl-si*html $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl-si.html +# -cp gcl-tk*html $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl-tk.html +# -cp gcl/* $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl.html +# -cp gcl-si/* $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl-si.html +# -cp gcl-tk/* $(DESTDIR)$(INFO_DIR)../doc/gcl-doc/gcl-tk.html + -mkdir -p $(DESTDIR)$(INFO_DIR)../doc +# -cp -r gcl-si gcl gcl-tk $(DESTDIR)$(INFO_DIR)../doc + -cp -r gcl gcl-si gcl-tk $(DESTDIR)$(INFO_DIR)../doc + -cp *pdf $(DESTDIR)$(INFO_DIR)../doc + +FILE=gcl-si.texi +srcs: + fgrep '.texi' ${FILE} | sed -e "/@c/d" | \ + awk '{ i++; printf("%s ",$$2); if ((i%5) == 0) printf("\\\n")}' + +tex: + -TEXINPUTS=.:$$TEXINPUTS tex gcl-si.texi + -TEXINPUTS=.:$$TEXINPUTS tex gcl-tk.texi + -TEXINPUTS=.:$$TEXINPUTS tex gcl.texi + @echo must do twice to get indices correct... + @echo so do '$(MAKE) tex' again + +dist-clean: clean + rm -f *.info* *.html *.pdf + rm -rf gcl gcl-si gcl-tk + +clean: + rm -rf gcl.IC gcl.IE gcl.IG gcl.IP gcl.IR gcl.IT gcl.fu + +.INTERMEDIATE: gcl-tk.dvi gcl-si.dvi gcl.dvi diff --git a/info/misc.texi b/info/misc.texi new file mode 100755 index 0000000..8e5140d --- /dev/null +++ b/info/misc.texi @@ -0,0 +1,47 @@ + +@node Miscellaneous, Compiler Definitions, Debugging, Top +@chapter Miscellaneous + +@menu +* Environment:: +* Inititialization:: +* Low Level X Interface:: +@end menu + +@node Environment, Inititialization, Miscellaneous, Miscellaneous +@section Environment + +The environment in GCL which is passed to macroexpand and +other functions requesting an environment, should be a +list of 3 lists. The first list looks like ((v1 val1) (v2 val2) ..) +where vi are variables and vali are their values. +The second is a list of ((fname1 . fbody1) (fname2 . fbody2) ...) +where fbody1 is either (macro lambda-list lambda-body) or +(lambda-list lambda-body) depending on whether this is a macro +or a function. The third list contains tags and blocks. + +@node Inititialization, Low Level X Interface, Environment, Miscellaneous +@section Initialization + +If the file init.lsp exists in the current directory, it is +loaded at startup. The first argument passed to the executable image +should be the system directory. Normally this would be gcl/unixport. +This directory is stored in the si::*system-directory* variable. If +the file sys-init.lsp exists in the system directory, it is loaded +before init.lsp. See also si::*TOP-LEVEL-HOOK*. + +@node Low Level X Interface, , Inititialization, Miscellaneous +@section Low Level X Interface + +A sample program for drawing things on X windows from lisp +is included in the file gcl/lsp/littleXlsp.lsp + +That routine invokes the corresponding C routines in XLIB. +So in order to use it you must `faslink' in the X routines. +Directions are given at the beginning of the lisp file, +for either building them into the image or using faslink. + +This program is also a good tutorial on invoking C from lisp. + +See also defentry and faslink. + diff --git a/info/number.texi b/info/number.texi new file mode 100755 index 0000000..bafc2ac --- /dev/null +++ b/info/number.texi @@ -0,0 +1,1332 @@ +@node Numbers, Sequences and Arrays and Hash Tables, Top, Top +@chapter Numbers + + +@defun SIGNUM (number) +Package:LISP + +If NUMBER is zero, returns NUMBER; else returns (/ NUMBER (ABS NUMBER)). + + +@end defun + +@defun LOGNOT (integer) +Package:LISP + +Returns the bit-wise logical NOT of INTEGER. + + +@end defun + +@defvr {Constant} MOST-POSITIVE-SHORT-FLOAT +Package:LISP +The short-float closest in value to positive infinity. + + +@end defvr + +@defun INTEGER-DECODE-FLOAT (float) +Package:LISP + +Returns, as three values, the integer interpretation of significand F, +the exponent E, and the sign S of the given float, so that + E + FLOAT = S * F * B where B = (FLOAT-RADIX FLOAT) + +F is a non-negative integer, E is an integer, and S is either 1 or -1. + + +@end defun + +@defun MINUSP (number) +Package:LISP + +Returns T if NUMBER < 0; NIL otherwise. + + +@end defun + +@defun LOGORC1 (integer1 integer2) +Package:LISP + +Returns the logical OR of (LOGNOT INTEGER1) and INTEGER2. + + +@end defun + +@defvr {Constant} MOST-NEGATIVE-SINGLE-FLOAT +Package:LISP +Same as MOST-NEGATIVE-LONG-FLOAT. + + +@end defvr + +@defvr {Constant} BOOLE-C1 +Package:LISP +Makes BOOLE return the complement of INTEGER1. + + +@end defvr + +@defvr {Constant} LEAST-POSITIVE-SHORT-FLOAT +Package:LISP +The positive short-float closest in value to zero. + + +@end defvr + +@defun BIT-NAND (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical NAND on the elements of BIT-ARRAY1 and +BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + +@end defun + +@defun INT-CHAR (integer) +Package:LISP + +Performs the inverse of CHAR-INT. Equivalent to CODE-CHAR in GCL. + + +@end defun + +@defun CHAR-INT (char) +Package:LISP + +Returns the font, bits, and code attributes as a single non-negative integer. +Equivalent to CHAR-CODE in GCL. + + +@end defun + +@defvr {Constant} LEAST-NEGATIVE-SINGLE-FLOAT +Package:LISP +Same as LEAST-NEGATIVE-LONG-FLOAT. + + +@end defvr + +@defun /= (number &rest more-numbers) +Package:LISP + +Returns T if no two of its arguments are numerically equal; NIL otherwise. + + +@end defun + +@defun LDB-TEST (bytespec integer) +Package:LISP + +Returns T if at least one of the bits in the specified bytes of INTEGER is 1; +NIL otherwise. + + +@end defun + +@defvr {Constant} CHAR-CODE-LIMIT +Package:LISP +The upper exclusive bound on values produced by CHAR-CODE. + + +@end defvr + +@defun RATIONAL (number) +Package:LISP + +Converts NUMBER into rational accurately and returns it. + + +@end defun + +@defvr {Constant} PI +Package:LISP +The floating-point number that is appropriately equal to the ratio of the +circumference of the circle to the diameter. + + +@end defvr + +@defun SIN (radians) +Package:LISP + +Returns the sine of RADIANS. + + +@end defun + +@defvr {Constant} BOOLE-ORC2 +Package:LISP +Makes BOOLE return LOGORC2 of INTEGER1 and INTEGER2. + + +@end defvr + +@defun NUMERATOR (rational) +Package:LISP + +Returns as an integer the numerator of the given rational number. + + +@end defun + +@defun MASK-FIELD (bytespec integer) +Package:LISP + +Extracts the specified byte from INTEGER. + + +@end defun + +@deffn {Special Form} INCF +Package:LISP + +Syntax: +@example +(incf place [delta]) +@end example + +Adds the number produced by DELTA (which defaults to 1) to the number +in PLACE. + + +@end deffn + +@defun SINH (number) +Package:LISP + +Returns the hyperbolic sine of NUMBER. + + +@end defun + +@defun PHASE (number) +Package:LISP + +Returns the angle part of the polar representation of a complex number. +For non-complex numbers, this is 0. + + +@end defun + +@defun BOOLE (op integer1 integer2) +Package:LISP + +Returns an integer produced by performing the logical operation specified by +OP on the two integers. OP must be the value of one of the following +constants: + BOOLE-CLR BOOLE-C1 BOOLE-XOR BOOLE-ANDC1 + BOOLE-SET BOOLE-C2 BOOLE-EQV BOOLE-ANDC2 + BOOLE-1 BOOLE-AND BOOLE-NAND BOOLE-ORC1 + BOOLE-2 BOOLE-IOR BOOLE-NOR BOOLE-ORC2 +See the variable docs of these constants for their operations. + + +@end defun + +@defvr {Constant} SHORT-FLOAT-EPSILON +Package:LISP +The smallest positive short-float that satisfies + (not (= (float 1 e) (+ (float 1 e) e))). + + +@end defvr + +@defun LOGORC2 (integer1 integer2) +Package:LISP + +Returns the logical OR of INTEGER1 and (LOGNOT INTEGER2). + + +@end defun + +@defvr {Constant} BOOLE-C2 +Package:LISP +Makes BOOLE return the complement of INTEGER2. + + +@end defvr + +@defun REALPART (number) +Package:LISP + +Extracts the real part of NUMBER. + + +@end defun + + +@defvr {Constant} BOOLE-CLR +Package:LISP +Makes BOOLE return 0. + + +@end defvr + +@defvr {Constant} BOOLE-IOR +Package:LISP +Makes BOOLE return LOGIOR of INTEGER1 and INTEGER2. + + +@end defvr + +@defun FTRUNCATE (number &optional (divisor 1)) +Package:LISP + +Values: (quotient remainder) +Same as TRUNCATE, but returns first value as a float. + + +@end defun + +@defun EQL (x y) +Package:LISP + +Returns T if X and Y are EQ, or if they are numbers of the same type with +the same value, or if they are character objects that represent the same +character. Returns NIL otherwise. + + +@end defun + +@defun LOG (number &optional base) +Package:LISP + +Returns the logarithm of NUMBER in the base BASE. BASE defaults to the base +of natural logarithms. + + +@end defun + +@defvr {Constant} DOUBLE-FLOAT-NEGATIVE-EPSILON +Package:LISP +Same as LONG-FLOAT-NEGATIVE-EPSILON. + + +@end defvr + +@defun LOGIOR (&rest integers) +Package:LISP + +Returns the bit-wise INCLUSIVE OR of its arguments. + + +@end defun + +@defvr {Constant} MOST-NEGATIVE-DOUBLE-FLOAT +Package:LISP +Same as MOST-NEGATIVE-LONG-FLOAT. + + +@end defvr + +@defun / (number &rest more-numbers) +Package:LISP + +Divides the first NUMBER by each of the subsequent NUMBERS. +With one arg, returns the reciprocal of the number. + + +@end defun + +@defvar *RANDOM-STATE* +Package:LISP +The default random-state object used by RAMDOM. + + +@end defvar + +@defun 1+ (number) +Package:LISP + +Returns NUMBER + 1. + + +@end defun + +@defvr {Constant} LEAST-NEGATIVE-DOUBLE-FLOAT +Package:LISP +Same as LEAST-NEGATIVE-LONG-FLOAT. + + +@end defvr + +@defun FCEILING (number &optional (divisor 1)) +Package:LISP + +Same as CEILING, but returns a float as the first value. + + +@end defun + +@defvr {Constant} MOST-POSITIVE-FIXNUM +Package:LISP +The fixnum closest in value to positive infinity. + + +@end defvr + +@defun BIT-ANDC1 (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical ANDC1 on the elements of BIT-ARRAY1 and +BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun TAN (radians) +Package:LISP + +Returns the tangent of RADIANS. + + +@end defun + +@defvr {Constant} BOOLE-NAND +Package:LISP +Makes BOOLE return LOGNAND of INTEGER1 and INTEGER2. + + +@end defvr + +@defun TANH (number) +Package:LISP + +Returns the hyperbolic tangent of NUMBER. + + +@end defun + +@defun ASIN (number) +Package:LISP + +Returns the arc sine of NUMBER. + + +@end defun + +@defun BYTE (size position) +Package:LISP + +Returns a byte specifier. In GCL, a byte specifier is represented by +a dotted pair ( . ). + + +@end defun + +@defun ASINH (number) +Package:LISP + +Returns the hyperbolic arc sine of NUMBER. + + +@end defun + +@defvr {Constant} MOST-POSITIVE-LONG-FLOAT +Package:LISP +The long-float closest in value to positive infinity. + + +@end defvr + +@deffn {Macro} SHIFTF +Package:LISP + +Syntax: +@example +(shiftf @{place@}+ newvalue) +@end example + +Evaluates all PLACEs and NEWVALUE in turn, then assigns the value of each +form to the PLACE on its left. Returns the original value of the leftmost +form. + + +@end deffn + +@defvr {Constant} LEAST-POSITIVE-LONG-FLOAT +Package:LISP +The positive long-float closest in value to zero. + + +@end defvr + +@defun DEPOSIT-FIELD (newbyte bytespec integer) +Package:LISP + +Returns an integer computed by replacing the specified byte of INTEGER with +the specified byte of NEWBYTE. + + +@end defun + +@defun BIT-AND (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical AND on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun LOGNAND (integer1 integer2) +Package:LISP + +Returns the complement of the logical AND of INTEGER1 and INTEGER2. + + +@end defun + +@defun BYTE-POSITION (bytespec) +Package:LISP + +Returns the position part (in GCL, the cdr part) of the byte specifier. + + +@end defun + +@deffn {Macro} ROTATEF +Package:LISP + +Syntax: +@example +(rotatef @{place@}*) +@end example + +Evaluates PLACEs in turn, then assigns to each PLACE the value of the form to +its right. The rightmost PLACE gets the value of the leftmost PLACE. +Returns NIL always. + + +@end deffn + +@defun BIT-ANDC2 (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical ANDC2 on the elements of BIT-ARRAY1 and +BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun TRUNCATE (number &optional (divisor 1)) +Package:LISP + +Values: (quotient remainder) +Returns NUMBER/DIVISOR as an integer, rounded toward 0. The second returned +value is the remainder. + + +@end defun + +@defvr {Constant} BOOLE-EQV +Package:LISP +Makes BOOLE return LOGEQV of INTEGER1 and INTEGER2. + + +@end defvr + +@defvr {Constant} BOOLE-SET +Package:LISP +Makes BOOLE return -1. + + +@end defvr + +@defun LDB (bytespec integer) +Package:LISP + +Extracts and right-justifies the specified byte of INTEGER, and returns the +result. + + +@end defun + +@defun BYTE-SIZE (bytespec) +Package:LISP + +Returns the size part (in GCL, the car part) of the byte specifier. + + +@end defun + +@defvr {Constant} SHORT-FLOAT-NEGATIVE-EPSILON +Package:LISP +The smallest positive short-float that satisfies + (not (= (float 1 e) (- (float 1 e) e))). + + +@end defvr + +@defun REM (number divisor) +Package:LISP + +Returns the second value of (TRUNCATE NUMBER DIVISOR). + + +@end defun + +@defun MIN (number &rest more-numbers) +Package:LISP + +Returns the least of its arguments. + + +@end defun + +@defun EXP (number) +Package:LISP + +Calculates e raised to the power NUMBER, where e is the base of natural +logarithms. + + +@end defun + +@defun DECODE-FLOAT (float) +Package:LISP + +Returns, as three values, the significand F, the exponent E, and the sign S +of the given float, so that + E + FLOAT = S * F * B where B = (FLOAT-RADIX FLOAT) + +S and F are floating-point numbers of the same float format as FLOAT, and E +is an integer. + + + +@end defun + +@defvr {Constant} LONG-FLOAT-EPSILON +Package:LISP +The smallest positive long-float that satisfies + (not (= (float 1 e) (+ (float 1 e) e))). + + +@end defvr + +@defun FROUND (number &optional (divisor 1)) +Package:LISP + +Same as ROUND, but returns first value as a float. + + +@end defun + +@defun LOGEQV (&rest integers) +Package:LISP + +Returns the bit-wise EQUIVALENCE of its arguments. + + +@end defun + +@defvr {Constant} MOST-NEGATIVE-SHORT-FLOAT +Package:LISP +The short-float closest in value to negative infinity. + + +@end defvr + +@defun BIT-NOR (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical NOR on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun CEILING (number &optional (divisor 1)) +Package:LISP + +Returns the smallest integer not less than or NUMBER/DIVISOR. Returns the +remainder as the second value. + + +@end defun + +@defvr {Constant} LEAST-NEGATIVE-SHORT-FLOAT +Package:LISP +The negative short-float closest in value to zero. + + +@end defvr + +@defun 1- (number) +Package:LISP + +Returns NUMBER - 1. + + +@end defun + +@defun <= (number &rest more-numbers) +Package:LISP + +Returns T if arguments are in strictly non-decreasing order; NIL otherwise. + + +@end defun + +@defun IMAGPART (number) +Package:LISP + +Extracts the imaginary part of NUMBER. + + +@end defun + +@defun INTEGERP (x) +Package:LISP + +Returns T if X is an integer (fixnum or bignum); NIL otherwise. + + +@end defun + +@defun ASH (integer count) +Package:LISP + +Shifts INTEGER left by COUNT places. Shifts right if COUNT is negative. + + +@end defun + +@defun LCM (integer &rest more-integers) +Package:LISP + +Returns the least common multiple of the arguments. + + +@end defun + +@defun COS (radians) +Package:LISP + +Returns the cosine of RADIANS. + + +@end defun + +@deffn {Special Form} DECF +Package:LISP + +Syntax: +@example +(decf place [delta]) +@end example +Subtracts the number +produced by DELTA (which defaults to 1) from the number in +PLACE. + + +@end deffn + +@defun ATAN (x &optional (y 1)) +Package:LISP + Returns the arc tangent of +X/Y. + + +@end defun + +@defvr {Constant} BOOLE-ANDC1 +Package:LISP +Makes BOOLE return LOGANDC1 of INTEGER1 and INTEGER2. + + +@end defvr + +@defun COSH (number) +Package:LISP + Returns the hyperbolic cosine of +NUMBER. + + +@end defun + +@defun FLOAT-RADIX (float) +Package:LISP + +Returns the representation radix (or base) of the floating-point +number. + + +@end defun + +@defun ATANH (number) +Package:LISP + +Returns the hyperbolic arc tangent of NUMBER. + + +@end defun + +@defun EVENP (integer) +Package:LISP + Returns T +if INTEGER is even. Returns NIL if INTEGER is odd. + + +@end defun + +@defun ZEROP (number) +Package:LISP + Returns T if NUMBER = 0; NIL +otherwise. + + +@end defun + +@defun FLOATP (x) +Package:LISP + +Returns T if X is a floating-point number; NIL otherwise. + + +@end defun + +@defun SXHASH (object) +Package:LISP + +Computes a hash code for OBJECT and returns it as an integer. + + +@end defun + +@defvr {Constant} BOOLE-1 +Package:LISP +Makes BOOLE return INTEGER1. + + +@end defvr + +@defvr {Constant} MOST-POSITIVE-SINGLE-FLOAT +Package:LISP +Same as MOST-POSITIVE-LONG-FLOAT. + + +@end defvr + +@defun LOGANDC1 (integer1 integer2) +Package:LISP + +Returns the logical AND of (LOGNOT INTEGER1) and INTEGER2. + + +@end defun + +@defvr {Constant} LEAST-POSITIVE-SINGLE-FLOAT +Package:LISP +Same as LEAST-POSITIVE-LONG-FLOAT. + + +@end defvr + +@defun COMPLEXP (x) +Package:LISP + +Returns T if X is a complex number; NIL otherwise. + + +@end defun + +@defvr {Constant} BOOLE-AND +Package:LISP +Makes BOOLE return LOGAND of INTEGER1 and INTEGER2. + + +@end defvr + +@defun MAX (number &rest more-numbers) +Package:LISP + +Returns the greatest of its arguments. + + +@end defun + +@defun FLOAT-SIGN (float1 &optional (float2 (float 1 float1))) +Package:LISP + +Returns a floating-point number with the same sign as FLOAT1 and with the +same absolute value as FLOAT2. + + +@end defun + +@defvr {Constant} BOOLE-ANDC2 +Package:LISP +Makes BOOLE return LOGANDC2 of INTEGER1 and INTEGER2. + + +@end defvr + +@defun DENOMINATOR (rational) +Package:LISP + +Returns the denominator of RATIONAL as an integer. + + +@end defun + +@defun FLOAT (number &optional other) +Package:LISP + +Converts a non-complex number to a floating-point number. If NUMBER is +already a float, FLOAT simply returns NUMBER. Otherwise, the format of +the returned float depends on OTHER; If OTHER is not provided, FLOAT returns +a SINGLE-FLOAT. If OTHER is provided, the result is in the same float format +as OTHER's. + + +@end defun + +@defun ROUND (number &optional (divisor 1)) +Package:LISP + +Rounds NUMBER/DIVISOR to nearest integer. The second returned value is the +remainder. + + +@end defun + +@defun LOGAND (&rest integers) +Package:LISP + +Returns the bit-wise AND of its arguments. + + +@end defun + +@defvr {Constant} BOOLE-2 +Package:LISP +Makes BOOLE return INTEGER2. + + +@end defvr + +@defun * (&rest numbers) +Package:LISP + +Returns the product of its arguments. With no args, returns 1. + + +@end defun + +@defun < (number &rest more-numbers) +Package:LISP + +Returns T if its arguments are in strictly increasing order; NIL otherwise. + + +@end defun + +@defun COMPLEX (realpart &optional (imagpart 0)) +Package:LISP + +Returns a complex number with the given real and imaginary parts. + + +@end defun + +@defvr {Constant} SINGLE-FLOAT-EPSILON +Package:LISP +Same as LONG-FLOAT-EPSILON. + + +@end defvr + +@defun LOGANDC2 (integer1 integer2) +Package:LISP + +Returns the logical AND of INTEGER1 and (LOGNOT INTEGER2). + + +@end defun + +@defun INTEGER-LENGTH (integer) +Package:LISP + +Returns the number of significant bits in the absolute value of INTEGER. + + +@end defun + +@defvr {Constant} MOST-NEGATIVE-FIXNUM +Package:LISP +The fixnum closest in value to negative infinity. + + +@end defvr + +@defvr {Constant} LONG-FLOAT-NEGATIVE-EPSILON +Package:LISP +The smallest positive long-float that satisfies + (not (= (float 1 e) (- (float 1 e) e))). + + +@end defvr + +@defun >= (number &rest more-numbers) +Package:LISP + +Returns T if arguments are in strictly non-increasing order; NIL otherwise. + + +@end defun + +@defvr {Constant} BOOLE-NOR +Package:LISP +Makes BOOLE return LOGNOR of INTEGER1 and INTEGER2. + + +@end defvr + +@defun ACOS (number) +Package:LISP + +Returns the arc cosine of NUMBER. + + +@end defun + +@defun MAKE-RANDOM-STATE (&optional (state *random-state*)) +Package:LISP + +Creates and returns a copy of the specified random state. If STATE is NIL, +then the value of *RANDOM-STATE* is used. If STATE is T, then returns a +random state object generated from the universal time. + + +@end defun + +@defun EXPT (base-number power-number) +Package:LISP + +Returns BASE-NUMBER raised to the power POWER-NUMBER. + + +@end defun + +@defun SQRT (number) +Package:LISP + +Returns the principal square root of NUMBER. + + +@end defun + +@defun SCALE-FLOAT (float integer) +Package:LISP + +Returns (* FLOAT (expt (float-radix FLOAT) INTEGER)). + + +@end defun + +@defun ACOSH (number) +Package:LISP + +Returns the hyperbolic arc cosine of NUMBER. + + +@end defun + +@defvr {Constant} MOST-NEGATIVE-LONG-FLOAT +Package:LISP +The long-float closest in value to negative infinity. + + +@end defvr + +@defvr {Constant} LEAST-NEGATIVE-LONG-FLOAT +Package:LISP +The negative long-float closest in value to zero. + + +@end defvr + +@defun FFLOOR (number &optional (divisor 1)) +Package:LISP + +Same as FLOOR, but returns a float as the first value. + + +@end defun + +@defun LOGNOR (integer1 integer2) +Package:LISP + +Returns the complement of the logical OR of INTEGER1 and INTEGER2. + + +@end defun + +@defun PARSE-INTEGER (string &key (start 0) (end (length string)) (radix 10) (junk-allowed nil)) +Package:LISP + +Parses STRING for an integer and returns it. + + +@end defun + +@defun + (&rest numbers) +Package:LISP + +Returns the sum of its arguments. With no args, returns 0. + + +@end defun + +@defun = (number &rest more-numbers) +Package:LISP + +Returns T if all of its arguments are numerically equal; NIL otherwise. + + +@end defun + +@defun NUMBERP (x) +Package:LISP + +Returns T if X is any kind of number; NIL otherwise. + + +@end defun + +@defvr {Constant} MOST-POSITIVE-DOUBLE-FLOAT +Package:LISP +Same as MOST-POSITIVE-LONG-FLOAT. + + +@end defvr + +@defun LOGTEST (integer1 integer2) +Package:LISP + +Returns T if LOGAND of INTEGER1 and INTEGER2 is not zero; NIL otherwise. + + +@end defun + +@defun RANDOM-STATE-P (x) +Package:LISP + +Returns T if X is a random-state object; NIL otherwise. + + +@end defun + +@defvr {Constant} LEAST-POSITIVE-DOUBLE-FLOAT +Package:LISP +Same as LEAST-POSITIVE-LONG-FLOAT. + + +@end defvr + +@defun FLOAT-PRECISION (float) +Package:LISP + +Returns the number of significant radix-B digits used to represent the +significand F of the floating-point number, where B = (FLOAT-RADIX FLOAT). + + +@end defun + +@defvr {Constant} BOOLE-XOR +Package:LISP +Makes BOOLE return LOGXOR of INTEGER1 and INTEGER2. + + +@end defvr + +@defun DPB (newbyte bytespec integer) +Package:LISP + +Returns an integer computed by replacing the specified byte of INTEGER with +NEWBYTE. + + +@end defun + +@defun ABS (number) +Package:LISP + +Returns the absolute value of NUMBER. + + +@end defun + +@defun CONJUGATE (number) +Package:LISP + +Returns the complex conjugate of NUMBER. + + +@end defun + +@defun CIS (radians) +Package:LISP + +Returns e raised to i*RADIANS. + + +@end defun + +@defun ODDP (integer) +Package:LISP + +Returns T if INTEGER is odd; NIL otherwise. + + +@end defun + +@defun RATIONALIZE (number) +Package:LISP + +Converts NUMBER into rational approximately and returns it. + + +@end defun + +@defun ISQRT (integer) +Package:LISP + +Returns the greatest integer less than or equal to the square root of the +given non-negative integer. + + +@end defun + +@defun LOGXOR (&rest integers) +Package:LISP + +Returns the bit-wise EXCLUSIVE OR of its arguments. + + +@end defun + +@defun > (number &rest more-numbers) +Package:LISP + +Returns T if its arguments are in strictly decreasing order; NIL otherwise. + + +@end defun + +@defun LOGBITP (index integer) +Package:LISP + +Returns T if the INDEX-th bit of INTEGER is 1. + + +@end defun + +@defvr {Constant} DOUBLE-FLOAT-EPSILON +Package:LISP +Same as LONG-FLOAT-EPSILON. + + +@end defvr + +@defun LOGCOUNT (integer) +Package:LISP + +If INTEGER is negative, returns the number of 0 bits. Otherwise, returns +the number of 1 bits. + + +@end defun + +@defun GCD (&rest integers) +Package:LISP + +Returns the greatest common divisor of INTEGERs. + + +@end defun + +@defun RATIONALP (x) +Package:LISP + +Returns T if X is an integer or a ratio; NIL otherwise. + + +@end defun + +@defun MOD (number divisor) +Package:LISP + +Returns the second result of (FLOOR NUMBER DIVISOR). + + +@end defun + +@defun MODF (number) +Package:SYSTEM + +Returns the integer and fractional part of a floating point number mod 1.0. + + +@end defun + +@defvr {Constant} BOOLE-ORC1 +Package:LISP +Makes BOOLE return LOGORC1 of INTEGER1 and INTEGER2. + + +@end defvr + +@defvr {Constant} SINGLE-FLOAT-NEGATIVE-EPSILON +Package:LISP +Same as LONG-FLOAT-NEGATIVE-EPSILON. + + +@end defvr + +@defun FLOOR (number &optional (divisor 1)) +Package:LISP + +Returns the largest integer not larger than the NUMBER divided by DIVISOR. +The second returned value is (- NUMBER (* first-value DIVISOR)). + + +@end defun + +@defun PLUSP (number) +Package:LISP + +Returns T if NUMBER > 0; NIL otherwise. + + +@end defun + +@defun FLOAT-DIGITS (float) +Package:LISP + +Returns the number of radix-B digits used to represent the significand F of +the floating-point number, where B = (FLOAT-RADIX FLOAT). + + +@end defun + +@defun RANDOM (number &optional (state *random-state*)) +Package:LISP + +Generates a uniformly distributed pseudo-random number between zero +(inclusive) and NUMBER (exclusive), by using the random state object STATE. + + +@end defun diff --git a/info/sequence.texi b/info/sequence.texi new file mode 100755 index 0000000..c67bd94 --- /dev/null +++ b/info/sequence.texi @@ -0,0 +1,985 @@ +@node Sequences and Arrays and Hash Tables, Characters, Numbers, Top +@chapter Sequences and Arrays and Hash Tables + +@defun VECTOR (&rest objects) +Package:LISP + +Constructs a Simple-Vector from the given objects. + + +@end defun + +@defun SUBSEQ (sequence start &optional (end (length sequence))) +Package:LISP + +Returns a copy of a subsequence of SEQUENCE between START (inclusive) and +END (exclusive). + + +@end defun + +@defun COPY-SEQ (sequence) +Package:LISP + +Returns a copy of SEQUENCE. + + +@end defun + +@defun POSITION (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the index of the first element in SEQUENCE that satisfies TEST with +ITEM; NIL if no such element exists. + + +@end defun + +@defun ARRAY-RANK (array) +Package:LISP + +Returns the number of dimensions of ARRAY. + + +@end defun + +@defun SBIT (simple-bit-array &rest subscripts) +Package:LISP + +Returns the bit from SIMPLE-BIT-ARRAY at SUBSCRIPTS. + + +@end defun + +@defun STRING-CAPITALIZE (string &key (start 0) (end (length string))) +Package:LISP + +Returns a copy of STRING with the first character of each word converted to +upper-case, and remaining characters in the word converted to lower case. + + +@end defun + +@defun NSUBSTITUTE-IF-NOT (new test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence of the same kind as SEQUENCE with the same elements + +except that all elements not satisfying TEST are replaced with NEWITEM. +SEQUENCE may be destroyed. + + +@end defun + +@defun FIND-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the index of the first element in SEQUENCE that satisfies TEST; NIL if +no such element exists. + + +@end defun + +@defun BIT-EQV (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical EQV on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun STRING< (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +If STRING1 is lexicographically less than STRING2, then returns the longest +common prefix of the strings. Otherwise, returns NIL. + + +@end defun + +@defun REVERSE (sequence) +Package:LISP + +Returns a new sequence containing the same elements as SEQUENCE but in +reverse order. + + +@end defun + +@defun NSTRING-UPCASE (string &key (start 0) (end (length string))) +Package:LISP + +Returns STRING with all lower case characters converted to uppercase. + + +@end defun + +@defun STRING>= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +If STRING1 is lexicographically greater than or equal to STRING2, then returns +the longest common prefix of the strings. Otherwise, returns NIL. + + +@end defun + +@defun ARRAY-ROW-MAJOR-INDEX (array &rest subscripts) +Package:LISP + +Returns the index into the data vector of ARRAY for the element of ARRAY +specified by SUBSCRIPTS. + + +@end defun + + +@defun ARRAY-DIMENSION (array axis-number) +Package:LISP + +Returns the length of AXIS-NUMBER of ARRAY. + + +@end defun + +@defun FIND (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the first element in SEQUENCE satisfying TEST with ITEM; NIL if no +such element exists. + + +@end defun + +@defun STRING-NOT-EQUAL (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Similar to STRING=, but ignores cases. + + +@end defun + +@defun STRING-RIGHT-TRIM (char-bag string) +Package:LISP + +Returns a copy of STRING with the characters in CHAR-BAG removed from the +right end. + + +@end defun + +@defun DELETE-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence formed by destructively removing the elements not +satisfying TEST from SEQUENCE. + + +@end defun + +@defun REMOVE-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a copy of SEQUENCE with elements not satisfying TEST removed. + + +@end defun + +@defun STRING= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Returns T if the two strings are character-wise CHAR=; NIL otherwise. + + +@end defun + +@defun NSUBSTITUTE-IF (new test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence of the same kind as SEQUENCE with the same elements +except that all elements satisfying TEST are replaced with NEWITEM. SEQUENCE +may be destroyed. + + +@end defun + +@defun SOME (predicate sequence &rest more-sequences) +Package:LISP + +Returns T if at least one of the elements in SEQUENCEs satisfies PREDICATE; +NIL otherwise. + + +@end defun + +@defun MAKE-STRING (size &key (initial-element #\Space)) +Package:LISP + +Creates and returns a new string of SIZE length whose elements are all +INITIAL-ELEMENT. + + +@end defun + +@defun NSUBSTITUTE (newitem olditem sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence of the same kind as SEQUENCE with the same elements +except that OLDITEMs are replaced with NEWITEM. SEQUENCE may be destroyed. + + +@end defun + +@defun STRING-EQUAL (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Given two strings (string1 and string2), and optional integers start1, +start2, end1 and end2, compares characters in string1 to characters in +string2 (using char-equal). + + +@end defun + +@defun STRING-NOT-GREATERP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Similar to STRING<=, but ignores cases. + + +@end defun + +@defun STRING> (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +If STRING1 is lexicographically greater than STRING2, then returns the +longest common prefix of the strings. Otherwise, returns NIL. + + +@end defun + +@defun STRINGP (x) +Package:LISP + +Returns T if X is a string; NIL otherwise. + + +@end defun + +@defun DELETE-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence formed by removing the elements satisfying TEST +destructively from SEQUENCE. + + +@end defun + +@defun SIMPLE-STRING-P (x) +Package:LISP + +Returns T if X is a simple string; NIL otherwise. + + +@end defun + +@defun REMOVE-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a copy of SEQUENCE with elements satisfying TEST removed. + + +@end defun + +@defun HASH-TABLE-COUNT (hash-table) +Package:LISP + +Returns the number of entries in the given Hash-Table. + + +@end defun + +@defun ARRAY-DIMENSIONS (array) +Package:LISP + +Returns a list whose elements are the dimensions of ARRAY + + +@end defun + +@defun SUBSTITUTE-IF-NOT (new test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence of the same kind as SEQUENCE with the same elements +except that all elements not satisfying TEST are replaced with NEWITEM. + + +@end defun + +@defun ADJUSTABLE-ARRAY-P (array) +Package:LISP + +Returns T if ARRAY is adjustable; NIL otherwise. + + +@end defun + +@defun SVREF (simple-vector index) +Package:LISP + +Returns the INDEX-th element of SIMPLE-VECTOR. + + +@end defun + +@defun VECTOR-PUSH-EXTEND (new-element vector &optional (extension (length vector))) +Package:LISP + +Similar to VECTOR-PUSH except that, if the fill pointer gets too large, +extends VECTOR rather then simply returns NIL. + + +@end defun + +@defun DELETE (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence formed by removing the specified ITEM destructively from +SEQUENCE. + + +@end defun + +@defun REMOVE (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a copy of SEQUENCE with ITEM removed. + + +@end defun + +@defun STRING (x) +Package:LISP + +Coerces X into a string. If X is a string, then returns X itself. If X is a +symbol, then returns X's print name. If X is a character, then returns a one +element string containing that character. Signals an error if X cannot be +coerced into a string. + + +@end defun + +@defun STRING-UPCASE (string &key (start 0) (end (length string))) +Package:LISP + +Returns a copy of STRING with all lower case characters converted to +uppercase. + + +@end defun + +@defun GETHASH (key hash-table &optional (default nil)) +Package:LISP + +Finds the entry in HASH-TABLE whose key is KEY and returns the associated +value and T, as multiple values. Returns DEFAULT and NIL if there is no +such entry. + + +@end defun + +@defun MAKE-HASH-TABLE (&key (test 'eql) (size 1024) (rehash-size 1.5) (rehash-threshold 0.7)) +Package:LISP + +Creates and returns a hash table. + + +@end defun + +@defun STRING/= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Returns NIL if STRING1 and STRING2 are character-wise CHAR=. Otherwise, +returns the index to the longest common prefix of the strings. + + +@end defun + +@defun STRING-GREATERP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Similar to STRING>, but ignores cases. + + +@end defun + +@defun ELT (sequence index) +Package:LISP + +Returns the INDEX-th element of SEQUENCE. + + +@end defun + +@defun MAKE-ARRAY (dimensions &key (element-type t) initial-element (initial-contents nil) (adjustable nil) (fill-pointer nil) (displaced-to nil) (displaced-index-offset 0) static) +Package:LISP + +Creates an array of the specified DIMENSIONS. The default for INITIAL- +ELEMENT depends on ELEMENT-TYPE. +MAKE-ARRAY will always try to find the `best' array to +accommodate the element-type specified. For example on a SUN element-type +(mod 1) --> bit +(integer 0 10) --> unsigned-char +(integer -3 10) --> signed-char +si::best-array-element-type is the function doing this. It +is also used by the compiler, for coercing array element types. +If you are going to declare an array you should use the same +element type as was used in making it. eg +(setq my-array (make-array 4 :element-type '(integer 0 10))) +(the (array (integer 0 10)) my-array) + When wanting to optimize references to an array you need to +declare the array eg: (the (array (integer -3 10)) my-array) if ar +were constructed using the (integer -3 10) element-type. You could of +course have used signed-char, but since the ranges may be +implementation dependent it is better to use -3 10 range. MAKE-ARRAY +needs to do some calculation with the element-type if you don't +provide a primitive data-type. One way of doing this in a machine +independent fashion: + + (defvar *my-elt-type* #. + (array-element-type (make-array 1 :element-type '(integer -3 10)))) + +Then calls to (make-array n :element-type *my-elt-type*) will not have to go +through a type inclusion computation. The keyword STATIC (GCL specific) if non +nil, will cause the array body to be non relocatable. + + + +@end defun + +@defun NSTRING-DOWNCASE (string &key (start 0) (end (length string))) +Package:LISP + Returns STRING with all upper case +characters converted to lowercase. + + +@end defun + +@defun ARRAY-IN-BOUNDS-P (array &rest subscripts) +Package:LISP + Returns T if SUBSCRIPTS are valid subscripts for +ARRAY; NIL otherwise. + + +@end defun + +@defun SORT (sequence predicate &key (key #'identity)) +Package:LISP + Destructively sorts SEQUENCE. +PREDICATE should return non-NIL if its first argument is to precede +its second argument. + + +@end defun + +@defun HASH-TABLE-P (x) +Package:LISP + +Returns T if X is a hash table object; NIL +otherwise. + + +@end defun + +@defun COUNT-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the number of elements in SEQUENCE not satisfying TEST. + + +@end defun + +@defun FILL-POINTER (vector) +Package:LISP + +Returns the fill pointer of VECTOR. + + +@end defun + + +@defun ARRAYP (x) +Package:LISP + +Returns T if X is an array; NIL otherwise. + + +@end defun + +@defun REPLACE (sequence1 sequence2 &key (start1 0) (end1 (length sequence1)) (start2 0) (end2 (length sequence2))) +Package:LISP + +Destructively modifies SEQUENCE1 by copying successive elements into it from +SEQUENCE2. + + +@end defun + +@defun BIT-XOR (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical XOR on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun CLRHASH (hash-table) +Package:LISP + +Removes all entries of HASH-TABLE and returns the hash table itself. + + +@end defun + +@defun SUBSTITUTE-IF (newitem test sequence &key (from-end nil) (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence of the same kind as SEQUENCE with the same elements +except that all elements satisfying TEST are replaced with NEWITEM. + + +@end defun + +@defun MISMATCH (sequence1 sequence2 &key (from-end nil) (test #'eql) test-not (start1 0) (start2 0) (end1 (length sequence1)) (end2 (length sequence2)) (key #'identity)) +Package:LISP + +The specified subsequences of SEQUENCE1 and SEQUENCE2 are compared +element-wise. If they are of equal length and match in every element, the +result is NIL. Otherwise, the result is a non-negative integer, the index +within SEQUENCE1 of the leftmost position at which they fail to match; or, if +one is shorter than and a matching prefix of the other, the index within +SEQUENCE1 beyond the last position tested is returned. + + +@end defun + +@defvr {Constant} ARRAY-TOTAL-SIZE-LIMIT +Package:LISP +The exclusive upper bound on the total number of elements of an array. + + +@end defvr + +@defun VECTOR-POP (vector) +Package:LISP + +Attempts to decrease the fill-pointer of VECTOR by 1 and returns the element +pointed to by the new fill pointer. Signals an error if the old value of +the fill pointer is 0. + + +@end defun + +@defun SUBSTITUTE (newitem olditem sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (count most-positive-fixnum) (key #'identity)) +Package:LISP + +Returns a sequence of the same kind as SEQUENCE with the same elements +except that OLDITEMs are replaced with NEWITEM. + + +@end defun + +@defun ARRAY-HAS-FILL-POINTER-P (array) +Package:LISP + +Returns T if ARRAY has a fill pointer; NIL otherwise. + + +@end defun + +@defun CONCATENATE (result-type &rest sequences) +Package:LISP + +Returns a new sequence of the specified RESULT-TYPE, consisting of all +elements in SEQUENCEs. + + +@end defun + +@defun VECTOR-PUSH (new-element vector) +Package:LISP + +Attempts to set the element of ARRAY designated by its fill pointer to +NEW-ELEMENT and increments the fill pointer by one. Returns NIL if the fill +pointer is too large. Otherwise, returns the new fill pointer value. + + +@end defun + +@defun STRING-TRIM (char-bag string) +Package:LISP + +Returns a copy of STRING with the characters in CHAR-BAG removed from both +ends. + + +@end defun + +@defun ARRAY-ELEMENT-TYPE (array) +Package:LISP + +Returns the type of the elements of ARRAY + + +@end defun + +@defun NOTANY (predicate sequence &rest more-sequences) +Package:LISP + +Returns T if none of the elements in SEQUENCEs satisfies PREDICATE; NIL +otherwise. + + +@end defun + +@defun BIT-NOT (bit-array &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical NOT in the elements of BIT-ARRAY. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun BIT-ORC1 (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical ORC1 on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun COUNT-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the number of elements in SEQUENCE satisfying TEST. + + +@end defun + +@defun MAP (result-type function sequence &rest more-sequences) +Package:LISP + +FUNCTION must take as many arguments as there are sequences provided. The +result is a sequence such that the i-th element is the result of applying +FUNCTION to the i-th elements of the SEQUENCEs. + + +@end defun + +@defvr {Constant} ARRAY-RANK-LIMIT +Package:LISP +The exclusive upper bound on the rank of an array. + + +@end defvr + +@defun COUNT (item sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the number of elements in SEQUENCE satisfying TEST with ITEM. + + +@end defun + +@defun BIT-VECTOR-P (x) +Package:LISP + +Returns T if X is a bit vector; NIL otherwise. + + +@end defun + +@defun NSTRING-CAPITALIZE (string &key (start 0) (end (length string))) +Package:LISP + +Returns STRING with the first character of each word converted to upper-case, +and remaining characters in the word converted to lower case. + + +@end defun + +@defun ADJUST-ARRAY (array dimensions &key (element-type (array-element-type array)) initial-element (initial-contents nil) (fill-pointer nil) (displaced-to nil) (displaced-index-offset 0)) +Package:LISP + +Adjusts the dimensions of ARRAY to the given DIMENSIONS. The default value +of INITIAL-ELEMENT depends on ELEMENT-TYPE. + + +@end defun + +@defun SEARCH (sequence1 sequence2 &key (from-end nil) (test #'eql) test-not (start1 0) (start2 0) (end1 (length sequence1)) (end2 (length sequence2)) (key #'identity)) +Package:LISP + +A search is conducted for the first subsequence of SEQUENCE2 which +element-wise matches SEQUENCE1. If there is such a subsequence in SEQUENCE2, +the index of the its leftmost element is returned; otherwise, NIL is +returned. + + +@end defun + +@defun SIMPLE-BIT-VECTOR-P (x) +Package:LISP + +Returns T if X is a simple bit-vector; NIL otherwise. + + +@end defun + +@defun MAKE-SEQUENCE (type length &key initial-element) +Package:LISP + +Returns a sequence of the given TYPE and LENGTH, with elements initialized +to INITIAL-ELEMENT. The default value of INITIAL-ELEMENT depends on TYPE. + + +@end defun + +@defun BIT-ORC2 (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical ORC2 on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun NREVERSE (sequence) +Package:LISP + +Returns a sequence of the same elements as SEQUENCE but in reverse order. +SEQUENCE may be destroyed. + + +@end defun + +@defvr {Constant} ARRAY-DIMENSION-LIMIT +Package:LISP +The exclusive upper bound of the array dimension. + + +@end defvr + +@defun NOTEVERY (predicate sequence &rest more-sequences) +Package:LISP + +Returns T if at least one of the elements in SEQUENCEs does not satisfy +PREDICATE; NIL otherwise. + + +@end defun + +@defun POSITION-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the index of the first element in SEQUENCE that does not satisfy TEST; +NIL if no such element exists. + + +@end defun + +@defun STRING-DOWNCASE (string &key (start 0) (end (length string))) +Package:LISP + +Returns a copy of STRING with all upper case characters converted to +lowercase. + + +@end defun + +@defun BIT (bit-array &rest subscripts) +Package:LISP + +Returns the bit from BIT-ARRAY at SUBSCRIPTS. + + +@end defun + +@defun STRING-NOT-LESSP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Similar to STRING>=, but ignores cases. + + +@end defun + +@defun CHAR (string index) +Package:LISP + +Returns the INDEX-th character in STRING. + + +@end defun + +@defun AREF (array &rest subscripts) +Package:LISP + +Returns the element of ARRAY specified by SUBSCRIPTS. + + +@end defun + +@defun FILL (sequence item &key (start 0) (end (length sequence))) +Package:LISP + +Replaces the specified elements of SEQUENCE all with ITEM. + + +@end defun + +@defun STABLE-SORT (sequence predicate &key (key #'identity)) +Package:LISP + +Destructively sorts SEQUENCE. PREDICATE should return non-NIL if its first +argument is to precede its second argument. + + +@end defun + +@defun BIT-IOR (bit-array1 bit-array2 &optional (result-bit-array nil)) +Package:LISP + +Performs a bit-wise logical IOR on the elements of BIT-ARRAY1 and BIT-ARRAY2. +Puts the results into a new bit array if RESULT-BIT-ARRAY is NIL, into +BIT-ARRAY1 if RESULT-BIT-ARRAY is T, or into RESULT-BIT-ARRAY otherwise. + + +@end defun + +@defun REMHASH (key hash-table) +Package:LISP + +Removes any entry for KEY in HASH-TABLE. Returns T if such an entry +existed; NIL otherwise. + + +@end defun + +@defun VECTORP (x) +Package:LISP + +Returns T if X is a vector; NIL otherwise. + + +@end defun + +@defun STRING<= (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +If STRING1 is lexicographically less than or equal to STRING2, then returns +the longest common prefix of the two strings. Otherwise, returns NIL. + + +@end defun + +@defun SIMPLE-VECTOR-P (x) +Package:LISP + +Returns T if X is a simple vector; NIL otherwise. + + +@end defun + +@defun STRING-LEFT-TRIM (char-bag string) +Package:LISP + +Returns a copy of STRING with the characters in CHAR-BAG removed from the +left end. + + +@end defun + +@defun ARRAY-TOTAL-SIZE (array) +Package:LISP + +Returns the total number of elements of ARRAY. + + +@end defun + +@defun FIND-IF-NOT (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the index of the first element in SEQUENCE that does not satisfy +TEST; NIL if no such element exists. + + +@end defun + +@defun DELETE-DUPLICATES (sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns a sequence formed by removing duplicated elements destructively from +SEQUENCE. + + +@end defun + +@defun REMOVE-DUPLICATES (sequence &key (from-end nil) (test #'eql) test-not (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +The elements of SEQUENCE are examined, and if any two match, one is discarded. +Returns the resulting sequence. + + +@end defun + +@defun POSITION-IF (test sequence &key (from-end nil) (start 0) (end (length sequence)) (key #'identity)) +Package:LISP + +Returns the index of the first element in SEQUENCE that satisfies TEST; NIL +if no such element exists. + + +@end defun + +@defun MERGE (result-type sequence1 sequence2 predicate &key (key #'identity)) +Package:LISP + +SEQUENCE1 and SEQUENCE2 are destructively merged into a sequence of type +RESULT-TYPE using PREDICATE to order the elements. + + +@end defun + +@defun EVERY (predicate sequence &rest more-sequences) +Package:LISP + +Returns T if every elements of SEQUENCEs satisfy PREDICATE; NIL otherwise. + + +@end defun + +@defun REDUCE (function sequence &key (from-end nil) (start 0) (end (length sequence)) initial-value) +Package:LISP + +Combines all the elements of SEQUENCE using a binary operation FUNCTION. +If INITIAL-VALUE is supplied, it is logically placed before the SEQUENCE. + + +@end defun + +@defun STRING-LESSP (string1 string2 &key (start1 0) (end1 (length string1)) (start2 0) (end2 (length string2))) +Package:LISP + +Similar to STRING<, but ignores cases. + + +@end defun diff --git a/info/si-defs.texi b/info/si-defs.texi new file mode 100755 index 0000000..da6ced2 --- /dev/null +++ b/info/si-defs.texi @@ -0,0 +1,1157 @@ + +@node System Definitions, Debugging, C Interface, Top +@chapter System Definitions + + +@defun ALLOCATE-CONTIGUOUS-PAGES (number &optional (really-allocate nil)) +Package:SI + +GCL specific: Sets the maximum number of pages for contiguous blocks to +NUMBER. If REALLY-ALLOCATE is non-NIL, then the specified +number of pages will be allocated immediately. + + +@end defun +@defun FREEZE-DEFSTRUCT (name) +Package:SI + +The inline defstruct type checker will be made more efficient, in that +it will only check for types which currently include NAME. After +calling this the defstruct should not be altered. + + +@end defun +@defun MAXIMUM-ALLOCATABLE-PAGES (type) +Package:SI + +GCL specific: Returns the current maximum number of pages for the type class +of the GCL implementation type TYPE. + + +@end defun +@defun ALLOCATED-RELOCATABLE-PAGES () +Package:SI + +GCL specific: Returns the number of pages currently allocated for relocatable +blocks. + + +@end defun +@defun PUTPROP (symbol value indicator) +Package:SI + +Give SYMBOL the VALUE on INDICATOR property. + + +@end defun +@defun ALLOCATED-PAGES (type) +Package:SI + +GCL specific: Returns the number of pages currently allocated for the type +class of the GCL implementation type TYPE. + + +@end defun +@defun ALLOCATE-RELOCATABLE-PAGES (number) +Package:SI + +GCL specific: Sets the maximum number of pages for relocatable blocks to +NUMBER. + + +@end defun +@defun ALLOCATED-CONTIGUOUS-PAGES () +Package:SI + +GCL specific: Returns the number of pages currently allocated for contiguous +blocks. + + +@end defun +@defun MAXIMUM-CONTIGUOUS-PAGES () +Package:SI + +GCL specific: Returns the current maximum number of pages for contiguous +blocks. + + +@end defun +@defun GET-HOLE-SIZE () +Package:SI + +GCL specific: Returns as a fixnum the size of the memory hole (in pages). + + +@end defun +@defun SPECIALP (symbol) +Package:SI + +GCL specific: Returns T if the SYMBOL is a globally special variable; NIL +otherwise. + + +@end defun +@defun OUTPUT-STREAM-STRING (string-output-stream) +Package:SI + +GCL specific: Returns the string corresponding to the STRING-OUTPUT-STREAM. + + +@end defun +@defun GET-STRING-INPUT-STREAM-INDEX (string-input-stream) +Package:SI + +GCL specific: Returns the current index of the STRING-INPUT-STREAM. + + +@end defun +@defun STRING-CONCATENATE (&rest strings) +Package:SI + +GCL specific: Returns the result of concatenating the given STRINGS. + + +@end defun +@defun BDS-VAR (i) +Package:SI + +GCL specific: Returns the symbol of the i-th entity in the bind stack. + + +@end defun +@defun ERROR-SET (form) +Package:SI + +GCL specific: Evaluates the FORM in the null environment. If the evaluation +of the FORM has successfully completed, SI:ERROR-SET returns NIL as the first +value and the result of the evaluation as the rest of the values. If, in the +course of the evaluation, a non-local jump from the FORM is atempted, +SI:ERROR-SET traps the jump and returns the corresponding jump tag as its +value. + + +@end defun +@defun COMPILED-FUNCTION-NAME (compiled-function-object) +Package:SI + +GCL specific: Returns the name of the COMPILED-FUNCTION-OBJECT. + + +@end defun +@defun STRUCTUREP (object) +Package:SI + +GCL specific: Returns T if the OBJECT is a structure; NIL otherwise. + + +@end defun +@defun IHS-VS (i) +Package:SI + +GCL specific: Returns the value stack index of the i-th entity in the +invocation history stack. + + +@end defun +@defun UNIVERSAL-ERROR-HANDLER (error-name correctable function-name continue-format-string error-format-string &rest args) +Package:SI + +GCL specific: Starts the error handler of GCL. When an error is detected, +GCL calls SI:UNIVERSAL-ERROR-HANDLER with the specified arguments. +ERROR-NAME is the name of the error. CORRECTABLE is T for a correctable +error and NIL for a fatal error. FUNCTION-NAME is the name of the function +that caused the error. CONTINUE-FORMAT-STRING and ERROR-FORMAT-STRING are +the format strings of the error message. ARGS are the arguments to the +format strings. + To change the error handler of GCL, redefine SI:UNIVERSAL-ERROR- +HANDLER. + + +@end defun +@defvar *INTERRUPT-ENABLE* +Package:SI +GCL specific: If the value of SI:*INTERRUPT-ENABLE* is non-NIL, GCL signals +an error on the terminal interrupt (this is the default case). If it is NIL, +GCL ignores the interrupt and assigns T to SI:*INTERRUPT-ENABLE*. + + +@end defvar +@defun CHDIR (pathname) +Package:SI + +GCL/UNIX specific: Changes the current working directory to the specified +pathname. + + +@end defun +@defun COPY-STREAM (in-stream out-stream) +Package:SI + +GCL specific: Copies IN-STREAM to OUT-STREAM until the end-of-file on IN- +STREAM. + + +@end defun +@defun INIT-SYSTEM () +Package:SI + +GCL specific: Initializes the library and the compiler of GCL. Since they +have already been initialized in the standard image of GCL, calling SI:INIT- +SYSTEM will cause an error. + + +@end defun +@defvar *INDENT-FORMATTED-OUTPUT* +Package:SI +GCL specific: The FORMAT directive ~% indents the next line if the value of +this variable is non-NIL. If NIL, ~% simply does Newline. + + +@end defvar +@defun SET-HOLE-SIZE (fixnum) +Package:SI + +GCL specific: Sets the size of the memory hole (in pages). + + +@end defun +@defun FRS-BDS (i) +Package:SI + +GCL specific: Returns the bind stack index of the i-th entity in the frame +stack. + + +@end defun +@defun IHS-FUN (i) +Package:SI + +GCL specific: Returns the function value of the i-th entity in the invocation +history stack. + + +@end defun +@defun *MAKE-CONSTANT (symbol value) +Package:SI + +GCL specific: Makes the SYMBOL a constant with the specified VALUE. + + +@end defun +@defun FIXNUMP (object) +Package:SI + +GCL specific: Returns T if the OBJECT is a fixnum; NIL otherwise. + + +@end defun +@defun BDS-VAL (i) +Package:SI + +GCL specific: Returns the value of the i-th entity in the bind stack. + + +@end defun +@defun STRING-TO-OBJECT (string) +Package:SI + +GCL specific: (SI:STRING-TO-OBJECT STRING) is equivalent to +(READ-FROM-STRING STRING), but much faster. + + +@end defun +@defvar *SYSTEM-DIRECTORY* +Package:SI +GCL specific: Holds the name of the system directory of GCL. + + +@end defvar +@defun FRS-IHS (i) +Package:SI + +GCL specific: Returns the invocation history stack index of the i-th entity +in the frame stack. + + +@end defun +@defun RESET-GBC-COUNT () +Package:SI + +GCL specific: Resets the counter of the garbage collector that records how +many times the garbage collector has been called for each implementation +type. + + +@end defun +@defun CATCH-BAD-SIGNALS () +Package:SI + +GCL/BSD specific: Installs a signal catcher for bad signals: + SIGILL, SIGIOT, SIGEMT, SIGBUS, SIGSEGV, SIGSYS. +The signal catcher, upon catching the signal, signals an error (and enter +the break-level). Since the internal memory of GCL may be broken, the user +should check the signal and exit from GCL if necessary. When the signal +is caught during garbage collection, GCL terminates immediately. + + +@end defun +@defun RESET-STACK-LIMITS () +Package:SI + +GCL specific: Resets the stack limits to the normal state. When a stack has +overflowed, GCL extends the limit for the stack in order to execute the error +handler. After processing the error, GCL resets the stack limit by calling +SI:RESET-STACK-LIMITS. + + +@end defun +@defvar *GBC-MESSAGE* +Package:SI +GCL specific: If the value of SI:*GBC-MESSAGE* is non-NIL, the garbage +collector prints some information on the terminal. Usually SI:*GBC-MESSAGE* +should be set NIL. + + +@end defvar +@defvar *GBC-NOTIFY* +Package:SI +GCL specific: If the value is non-NIL, the garbage +collector prints a very brief one line message about the area causing the collection, +and the time spent in internal time units. + + +@end defvar +@defvar *AFTER-GBC-HOOK* +Package:SI +Defaults to nil, but may be set to a function of one argument TYPE which is +a lisp variable indicating the TYPE which caused the current collection. + + +@end defvar +@deffn {Funcition} ALLOCATED (type) +Package:SI + +Returns 6 values: +@table @asis +@item nfree +number free +@item npages +number of pages +@item maxpage +number of pages to grow to +@item nppage +number per page +@item gbccount +number of gc's due to running out of items of this size +@item nused +number of items used +@end table + +Note that all items of the same size are stored on similar pages. +Thus for example on a 486 under linux the following basic types are +all the same size and so will share the same allocated information: +CONS BIGNUM RATIO COMPLEX STRUCTURE. + + + +@end deffn + +@defun *MAKE-SPECIAL (symbol) +Package:SI + +GCL specific: Makes the SYMBOL globally special. + + +@end defun +@defun MAKE-STRING-OUTPUT-STREAM-FROM-STRING (string) +Package:SI + +GCL specific: Creates a string-output-stream corresponding to the STRING and +returns it. The STRING should have a fill-pointer. + + +@end defun +@defvar *IGNORE-EOF-ON-TERMINAL-IO* +Package:SI +GCL specific: If the value of SI:*IGNORE-EOF-ON-TERMINAL-IO* is non-NIL, GCL +ignores the eof-character (usually ^D) on the terminal and the terminal never +becomes end-of-file. The default value of SI:*IGNORE-EOF-ON-TERMINAL-IO* is +NIL. + + +@end defvar +@defun ADDRESS (object) +Package:SI + +GCL specific: Returns the address of the OBJECT as a fixnum. The address of +an object depends on the version of GCL. E.g. (SI:ADDRESS NIL) returns +1879062044 on GCL/AOSVS dated March 14, 1986. + + +@end defun +@defvar *LISP-MAXPAGES* +Package:SI +GCL specific: Holds the maximum number of pages (1 page = 2048 bytes) for the +GCL process. The result of changing the value of SI:*LISP-MAXPAGES* is +unpredictable. + + +@end defvar +@defun ARGC () +Package:SI + +GCL specific: Returns the number of arguments on the command line that invoked +the GCL process. + + +@end defun +@defun NANI (fixnum) +Package:SI + +GCL specific: Returns the object in the address FIXNUM. This function is +the inverse of SI:ADDRESS. Although SI:ADDRESS is a harmless operation, +SI:NANI is quite dangerous and should be used with care. + + +@end defun +@defvar *NOTIFY-GBC* +Package:SI +GCL specific: If the value of this variable is non-NIL, then the garbage +collector notifies that it begins to run whenever it is invoked. Otherwise, +garbage collection begins silently. + + +@end defvar +@defun SAVE-SYSTEM (pathname) +Package:SI + +GCL specific: Saves the current GCL core imange into a program file specified +by PATHNAME. This function differs from SAVE in that the contiguous and +relocatable areas are made permanent in the saved image. Usually the +standard image of GCL interpreter/compiler is saved by SI:SAVE-SYSTEM. +This function causes an exit from lisp. Various changes are made +to the memory of the running system, such as closing files and +resetting io streams. It would not be possible to continue normally. + + +@end defun +@defun UNCATCH-BAD-SIGNALS () +Package:SI + +GCL/BSD specific: Undoes the effect of SI:CATCH-BAD-SIGNALS. + + +@end defun +@defun VS (i) +Package:SI + +GCL specific: Returns the i-th entity in the value stack. + + +@end defun +@defun DISPLACED-ARRAY-P (array) +Package:SI + +GCL specific: Returns T if the ARRAY is a displaced array; NIL otherwise. + + +@end defun +@defun ARGV (fixnum) +Package:SI + +GCL specific: Returns the FIXNUM-th argument on the command line that invoked +the GCL process. + + +@end defun +@defvar *DEFAULT-TIME-ZONE* +Package:SI +GCL specific: Holds the default time zone. The initial value of SI:*DEFAULT- +TIME-ZONE* is 6 (the time zone of Austin, Texas). + + +@end defvar +@defun GETENV (string) +Package:SI + +GCL/UNIX specific: Returns the environment with the name STRING as a string; +if the environment specified by STRING is not found, returns NIL. + + +@end defun +@defun FASLINK (file string) +Package:SI + +GCL/BSD specific: Loads the FASL file FILE while linking the object files and +libraries specified by STRING. For example, + (faslink "foo.o" "bar.o boo.o -lpixrect") +loads foo.o while linking two object files (bar.o and boo.o) and the library +pixrect. Usually, foo.o consists of the C language interface for the +functions defined in the object files or the libraries. + +A more portable way of making references to C code, is to build it +in at the time of the original make. If foo.c references things +in -lpixrect, and foo.o is its compilation in the gcl/unixport directory + +(cd gcl/unixport ; make "EXTRAS= foo.o -lpixrect ") + +should add them. If EXTRAS was already joe.o in the unixport/makefile +you should of course add joe.o to the above "EXTRAS= joe.o foo.o.." + +Faslink does not work on most UNIX systems which are derived from SYS V or AIX. + + + + +@end defun +@defun TOP-LEVEL () +Package:SI + +GCL specific: Starts the standard top-level listner of GCL. When the GCL +process is invoked, it calls SI:TOP-LEVEL by (FUNCALL 'SI:TOP-LEVEL). + To change the top-level of GCL, redefine SI:TOP-LEVEL and save the core +imange in a file. When the saved imange is invoked, it will start the +redefined top-level. + + +@end defun +@defun FRS-VS (i) +Package:SI + +GCL specific: Returns the value stack index of the i-th entity in the frame +stack. + + +@end defun +@defun WRITE-DEBUG-SYMBOLS (start file &key (main-file "/usr/local/schelter/xgcl/unixport/raw_gcl") (output-file "debug-symbols.o" )) +Package:SI + +Write out a file of debug-symbols using address START as the place +where FILE will be loaded into the running executable MAIN-FILE. The +last is a keyword argument. + + + + +@end defun +@defun PROF (x y) +Package:SI + +These functions in the SI package are GCL specific, and allow monitoring +the run time of functions loaded into GCL, as well as the basic functions. + Sample Usage: + (si::set-up-profile 1000000) (si::prof 0 90) + run program + (si::prof 0 0) ;; turn off profile + (si::display-prof) + (si::clear-profile) + (si::prof 0 90) ;; start profile again + run program + .. + Profile can be stopped with (si::prof 0 0) and restarted with (si::prof 0 90) +The START-ADDRESS will correspond to the beginning of the profile array, and +the SCALE will mean that 256 bytes of code correspond to SCALE bytes in the +profile array. + +Thus if the profile array is 1,000,000 bytes long and the code segment is +5 megabytes long you can profile the whole thing using a scale of 50 +Note that long runs may result in overflow, and so an understating of the +time in a function. + +You must run intensively however since, with a scale of 128 it takes +6,000,000 times through a loop to overflow the sampling in one part of +the code. + + +@end defun +@defun CATCH-FATAL (i) +Package:SI + + +Sets the value of the C variable catch_fatal to I which should be an integer. +If catch_fatal is 1, then most unrecoverable fatal errors will be caught. +Upon catching such an error catch_fatal becomes -1, to avoid recursive errors. +The top level loop automatically sets catch_fatal to 1, if the value is less +than zero. Catching can be turned off by making catch_fatal = 0. + + + + +@end defun +@defvar *MULTIPLY-STACKS* +Package:SI + +If this variable is set to a positive fixnum, then the next time through the +TOP-LEVEL loop, the loop will be exited. The size of the stacks will be +multiplied by the value of *multiply-stacks*, and the TOP-LEVEL will be called +again. Thus to double the size of the stacks: + +>(setq si::*multiply-stacks* 2) +[exits top level and reinvokes it, with the new stacks in place] +> + +We must exit TOP-LEVEL, because it and any other lisp functions +maintain many pointers into the stacks, which would be incorrect when the +stacks have been moved. Interrupting the process of growing the stacks, +can leave you in an inconsistent state. + + +@end defvar +@defun GBC-TIME (&optional x) +Package:SI + +Sets the internal C variable gc_time to X if X is supplied and then +returns gc_time. If gc_time is greater or equal to 0, then gc_time is +incremented by the garbage collector, according to the number of +internal time units spent there. The initial value of gc_time is -1. + + + +@end defun +@defun FWRITE (string start count stream) +Package:SI + +Write from STRING starting at char START (or 0 if it is nil) COUNT characters +(or to end if COUNT is nil) to STREAM. STREAM must be a stream such as +returned by FP-OUTPUT-STREAM. Returns nil if it fails. + + + +@end defun +@defun FREAD (string start count stream) +Package:SI + +Read characters into STRING starting at char START (or 0 if it is nil) COUNT +characters (or from start to length of STRING if COUNT is nil). Characters +are read from STREAM. STREAM must be a stream such as returned by +FP-INPUT-STREAM. Returns nil if it fails. Return number of characters read +if it succeeds. + + +@end defun +@defun SGC-ON (&optional ON) +Package:SI + +If ON is not nil then SGC (stratified garbage collection) is turned +on. If ON is supplied and is nil, then SGC is turned off. +If ON is not supplied, then it returns T if SGC is on, and NIL if +SGC is off. + +The purpose of SGC is to prevent paging activity during garbage +collection. It is efficient if the actual number of pages being +written to form a small percentage of the total image size. The image +should be built as compactly as possible. This can be accomplished by +using a settings such as (si::allocate-growth 'cons 1 10 50 20) to limit +the growth in the cons maxpage to 10 pages per time. Then +just before calling si::save-system to save your image you can +do something like: + +(si::set-hole-size 500)(gbc nil) (si::sgc-on t) (si::save-system ..) + +This makes the saved image come up with SGC on. We have set a +reasonably large hole size. This is so that allocation of pages +either because they fill up, or through specific calls to +si::allocate, will not need to move all the relocatable data. Moving +relocatable data requires turning SGC off, performing a full gc, and +then turning it back on. New relocatable data is collected by SGC, +but moving the old requires going through all pages of memory to +change pointers into it. + +Using si::*notify-gbc* gives information about the number of pages +used by SGC. + +Note that SGC is only available on operating systems which provide +the mprotect system call, to write protect pages. Otherwise we +cannot tell which pages have been written too. + + + +@end defun +@defun ALLOCATE-SGC (type min-pages max-pages percent-free) +Package:SI + +If MIN-PAGES is 0, then this type will not be swept by SGC. Otherwise +this is the minimum number of pages to make available to SGC. MAX-PAGES +is the upper limit of such pages. Only pages with PERCENT-FREE objects +on them, will be assigned to SGC. +A list of the previous values for min, max and percent are returned. + + +@end defun +@defun ALLOCATE-GROWTH (type min max percent percent-free) +Package:SI + + +The next time after a garbage collection for TYPE, if PERCENT-FREE of +the objects of this TYPE are not actually free, and if the maximum +number of pages for this type has already been allocated, then the +maximum number will be increased by PERCENT of the old maximum, +subject to the condition that this increment be at least MIN pages and +at most MAX pages. A list of the previous values for min, max, +percent, and percent-free for the type TYPE is returned. A value +of 0 means use the system default, and if an argument is out of range +then the current values are returned with no change made. + +Examples: +(si::allocate-growth 'cons 1 10 50 10) +would insist that after a garbage collection for cons, there be at least +10% cons's free. If not the number of cons pages would be grown by +50% or 10 pages which ever was smaller. This might be reasonable if you +were trying to build an image which was `full', ie had few free objects +of this type. + +(si::allocate-growth 'fixnum 0 10000 30 40) +would grow space till there were normally 40% free fixnums, usually +growing by 30% per time. + +(si::allocate-growth 'cons 0 0 0 40) would require 40% free conses after +garbage collection for conses, and would use system defaults for the the rate +to grow towards this goal. + +(si::allocate-growth 'cons -1 0 0 0) +would return the current values, but not make any changes. + + +@end defun +@defun OPEN-FASD (stream direction eof-value table) +Package:SI + +Given file STREAM open for input or output in DIRECTION, +set it up to start writing or reading in fasd format. When +reading from this stream the EOF-VALUE will be returned when +the end a fasd end of dump marker is encountered. TABLE should +be an eq hashtable on output, a vector on input, or nil. In this +last case a default one will be constructed. + +We shall refer to the result as a `fasd stream'. It is +suitable as the arg to CLOSE-FASD, READ-FASD-TOP, and as the second +second arg to WRITE-FASD. As a lisp object it is actually a vector, +whose body coincides with: + +struct fasd @{ + object stream; /* lisp object of type stream */ + object table; /* hash table used in dumping or vector on input*/ + object eof; /* lisp object to be returned on coming to eof mark */ + object direction; /* holds Cnil or Kinput or Koutput */ + object package; /* the package symbols are in by default */ + object index; /* integer. The current_dump index on write */ + object filepos; /* nil or the position of the start */ + object table_length; /* On read it is set to the size dump array needed + or 0 + */ + object macro ; @} + +We did not use a defstruct for this, because we want the compiler to use this +and it makes bootstrapping more difficult. It is in "cmpnew/fasdmacros.lsp" + + + +@end defun +@defun WRITE-FASD-TOP (X FASD-STREAM) +Package:SI + +Write X to FASD-STREAM. + + +@end defun +@defun READ-FASD-TOP (FASD-STREAM) +Package:SI + +Read the next object from FASD-STREAM. Return the eof-value of FASD-STREAM if we +encounter an eof marker put out by CLOSE-FASD. Encountering end of actual file +stream causes an error. + + +@end defun +@defun CLOSE-FASD (FASD-STREAM) +Package:SI + +On output write an eof marker to the associated file stream, and then +make FASD-STREAM invalid for further output. It also attempts to write +information to the stream on the size of the index table needed to read from the +stream from the last open. This is useful in growing the array. +It does not alter the file stream, other than for writing this information to it. +The file stream may be reopened for further use. It is an error +to OPEN-FASD the same file or file stream again with out first calling CLOSE-FASD. + + + + + +@end defun +@defun FIND-SHARING-TOP (x table) +Package:SI + +X is any lisp object and TABLE is an eq hash table. This walks through X +making entries to indicate the frequency of symbols,lists, and arrays. +Initially items get -1 when they are first met, and this is decremented by 1 +each time the object occurs. Call this function on all the objects in a fasd +file, which you wish to share structure. + + +@end defun +@defvar *LOAD-PATHNAME* +Package:SI +Load binds this to the pathname of the file being loaded. + + +@end defvar +@deffn {Macro} DEFINE-INLINE-FUNCTION (fname vars &body body) +Package:SI + +This is equivalent to defun except that VARS may not contain +&optional, &rest, &key or &aux. Also a compiler property is +added, which essentially saves the body and turns this into +a let of the VARS and then execution of the body. This +last is done using si::DEFINE-COMPILER-MACRO +Example: +(si::define-inline-function myplus (a b c) (+ a b c)) + + +@end deffn +@deffn {Macro} DEFINE-COMPILER-MACRO (fname vars &body body) +Package:SI + +FNAME may be the name of a function, but at compile time the macro +expansion given by this is used. + +(si::define-compiler-macro mycar (a) `(car ,a)) + + +@end deffn +@defun DBL () +Package:SI + +Invoke a top level loop, in which debug commands may be entered. +These commands may also be entered at breaks, or in the error +handler. +See SOURCE-LEVEL-DEBUG + + +@end defun +@defun NLOAD (file) +Package:SI + +Load a file with the readtable bound to a special readtable, which +permits tracking of source line information as the file is loaded. +see SOURCE-LEVEL-DEBUG + + +@end defun +@defun BREAK-FUNCTION (function &optional line absolute) +Package:SI + +Set a breakpoint for a FUNCTION at LINE if the function has source +information loaded. If ABSOLUTE is not nil, then the line is understood to be +relative to the beginning of the buffer. See also dbl-break-function, the +emacs command. + + +@end defun +@defun XDR-OPEN (stream) +Package:SI + +Returns an object suitable for passing to XDR-READ if the stream +is an input stream, and XDR-WRITE if it was an output stream. +Note the stream must be a unix stream, on which si::fp-input-stream +or si::fp-output-stream would act as the identity. + + + +@end defun +@defun FP-INPUT-STREAM (stream) +Package:SI + +Return a unix stream for input associated to STREAM if possible, +otherwise return nil. + + +@end defun +@defun FP-OUTPUT-STREAM (stream) +Package:SI + +Return a unix stream for output associated to STREAM if possible, +otherwise return nil. + + + +@end defun +@defun XDR-READ (stream element) +Package:SI + +Read one item from STREAM of type the type of ELEMENT. The representation +of the elements is machine independent. The xdr routines are what is +used by the basic unix rpc calls. + + +@end defun +@defun XDR-WRITE (stream element) +Package:SI + +Write to STREAM the given ELEMENT. + + + + +@end defun +@defvar *TOP-LEVEL-HOOK* +Package:SI +If this variable is has a function as its value at start up time, then +it is run immediately after the init.lsp file is loaded. This is useful +for starting up an alternate top level loop. + + +@end defvar +@defun RUN-PROCESS (string arglist) +Package:SI + + +Execute the command STRING in a subshell passing the strings in the +list ARGLIST as arguments to the command. Return a two way stream +associated to this. Use si::fp-output-stream to get an associated +output stream or si::fp-input-stream. + +Bugs: It does not properly deallocate everything, so that it will fail +if you call it too many times. + + +@end defun + +@defvar *CASE-FOLD-SEARCH* +Package: SI +Non nil means that a string-match should ignore case +@end defvar + +@defun STRING-MATCH (pattern string &optional start end) +Package: SI +Match regexp PATTERN in STRING starting in string starting at START +and ending at END. Return -1 if match not found, otherwise +return the start index of the first matchs. The variable +*MATCH-DATA* will be set to a fixnum array of sufficient size to hold +the matches, to be obtained with match-beginning and match-end. +If it already contains such an array, then the contents of it will +be over written. + +The form of a regexp pattern is discussed in @xref{Regular Expressions}. + +@end defun + +@defun MATCH-BEGINNING (index) +Returns the beginning of the I'th match from the previous STRING-MATCH, +where the 0th is for the whole regexp and the subsequent ones match parenthetical expressions. -1 is returned if there is no match, or if the *match-data* +vector is not a fixnum array. +@end defun + +@defun MATCH-END (index) + Returns the end of the I'th match from the previous STRING-MATCH +@end defun + +@defun SOCKET (port &key host server async myaddr myport daemon) + +Establishes a socket connection to the specified PORT under a variety +of circumstances. + +If HOST is specified, then it is a string designating the IP address +of the server to which we are the client. ASYNC specifies that the +connection should be made asynchronously, and the call return +immediately. MYADDR and MYPORT can specify the IP address and port +respectively of a client connection, for example when the running +machine has several network interfaces. + +If SERVER is specified, then it is a function which will handle +incoming connections to this PORT. DAEMON specifies that the running +process should be forked to handle incoming connections in the +background. If DAEMON is set to the keyword PERSISTENT, then the +backgrounded process will survive when the parent process exits, and +the SOCKET call returns NIL. Any other non-NIL setting of DAEMON +causes the socket call to return the process id of the backgrounded +process. DAEMON currently only works on BSD and Linux based systems. + +If DAEMON is not set or nil, or if the socket is not a SERVER socket, +then the SOCKET call returns a two way stream. In this case, the +running process is responsible for all I/O operations on the stream. +Specifically, if a SERVER socket is created as a non-DAEMON, then the +running process must LISTEN for connections, ACCEPT them when present, +and call the SERVER function on the stream returned by ACCEPT. + +@end defun + +@defun ACCEPT (stream) + +Creates a new two-way stream to handle an individual incoming +connection to STREAM, which must have been created with the SOCKET +function with the SERVER keyword set. ACCEPT should only be invoked +when LISTEN on STREAM returns T. If the STREAM was created with the +DAEMON keyword set in the call to SOCKET, ACCEPT is unnecessary and +will be called automatically as needed. + +@end defun + +@menu +* Regular Expressions:: +@end menu + +@node Regular Expressions, , System Definitions, System Definitions +@section Regular Expressions + +The function @code{string-match} (*Index string-match::) is used to +match a regular expression against a string. If the variable +@code{*case-fold-search*} is not nil, case is ignored in the match. +To determine the extent of the match use *Index match-beginning:: and +*Index match-end::. + +Regular expressions are implemented using Henry Spencer's package +(thank you Henry!), and much of the description of regular expressions +below is copied verbatim from his manual entry. Code for delimited +searches, case insensitive searches, and speedups to allow fast +searching of long files was contributed by W. Schelter. The speedups +use an adaptation by Schelter of the Boyer and Moore string search +algorithm to the case of branched regular expressions. These allow +such expressions as 'not_there|really_not' to be searched for 30 times +faster than in GNU emacs (1995), and 200 times faster than in the +original Spencer method. Expressions such as [a-u]bcdex get a speedup +of 60 and 194 times respectively. This is based on searching a string +of 50000 characters (such as the file tk.lisp). + +@itemize @bullet +@item +A regular expression is a string containing zero or more @i{branches} which are separated by @code{|}. A match of the regular expression against a string is simply a match of the string with one of the branches. +@item +Each branch consists of zero or more @i{pieces}, concatenated. A matching +string must contain an initial substring matching the first piece, immediately +followed by a second substring matching the second piece and so on. +@item +Each piece is an @i{atom} optionally followed by @code{+}, @code{*}, or @code{?}. +@item +An atom followed by @code{+} matches a sequence of 1 or more matches of the atom. +@item +An atom followed by @code{*} matches a sequence of 0 or more matches of the atom. +@item +An atom followed by @code{?} matches a match of the atom, or the null string. +@item +An atom is +@itemize @minus +@item +a regular expression in parentheses matching a match for the regular expression +@item +a @i{range} see below +@item +a @code{.} matching any single character +@item +a @code{^} matching the null string at the beginning of the input string +@item +a @code{$} matching the null string at the end of the input string +@item +a @code{\} followed by a single character matching that character +@item +a single character with no other significance +(matching that character). +@end itemize +@item +A @i{range} is a sequence of characters enclosed in @code{[]}. +It normally matches any single character from the sequence. +@itemize @minus +@item +If the sequence begins with @code{^}, +it matches any single character @i{not} from the rest of the sequence. +@item +If two characters in the sequence are separated by @code{-}, this is shorthand +for the full list of ASCII characters between them +(e.g. @code{[0-9]} matches any decimal digit). +@item +To include a literal @code{]} in the sequence, make it the first character +(following a possible @code{^}). +@item +To include a literal @code{-}, make it the first or last character. +@end itemize +@end itemize + +@unnumberedsubsec Ordering Multiple Matches + +In general there may be more than one way to match a regular expression +to an input string. For example, consider the command + +@example + (string-match "(a*)b*" "aabaaabb") +@end example + +Considering only the rules given so far, the value of (list-matches 0 1) +might be @code{("aabb" "aa")} or @code{("aaab" "aaa")} or @code{("ab" "a")} +or any of several other combinations. +To resolve this potential ambiguity @b{string-match} chooses among +alternatives using the rule @i{first then longest}. +In other words, it considers the possible matches in order working +from left to right across the input string and the pattern, and it +attempts to match longer pieces of the input string before shorter +ones. More specifically, the following rules apply in decreasing +order of priority: +@itemize @asis{} +@item +[1] +If a regular expression could match two different parts of an input string +then it will match the one that begins earliest. +@item +[2] +If a regular expression contains @b{|} operators then the leftmost +matching sub-expression is chosen. +@item +[3] +In @b{*}@r{, }@b{+}@r{, and }@b{?} constructs, longer matches are chosen +in preference to shorter ones. +@item +[4] +In sequences of expression components the components are considered +from left to right. +@end itemize + +In the example from above, @b{(a*)b*}@r{ matches }@b{aab}@r{: the }@b{(a*)} +portion of the pattern is matched first and it consumes the leading +@b{aa}@r{; then the }@b{b*} portion of the pattern consumes the +next @b{b}. Or, consider the following example: + +@example + (string-match "(ab|a)(b*)c" "xabc") ==> 1 + (list-matches 0 1 2 3) ==> ("abc" "ab" "" NIL) + (match-beginning 0) ==> 1 + (match-end 0) ==> 4 + (match-beginning 1) ==> 1 + (match-end 1) ==> 3 + (match-beginning 2) ==> 3 + (match-end 2) ==> 3 + (match-beginning 3) ==> -1 + (match-end 3) ==> -1 + +@end example + +In the above example the return value of @code{1} (which is @code{> -1}) +indicates that a match was found. The entire match runs from +1 to 4. +Rule 4 specifies that @b{(ab|a)} gets first shot at the input +string and Rule 2 specifies that the @b{ab} sub-expression +is checked before the @b{a} sub-expression. +Thus the @b{b}@r{ has already been claimed before the }@b{(b*)} +component is checked and @b{(b*)} must match an empty string. + +The special characters in the string @code{"\()[]+.*|^$?"}, +must be quoted, if a simple string search is desired. The function +re-quote-string is provided for this purpose. +@example +(re-quote-string "*standard*") ==> "\\*standard\\*" + +(string-match (re-quote-string "*standard*") "X *standard* ") + ==> 2 + +(string-match "*standard*" "X *standard* ") +Error: Regexp Error: ?+* follows nothing +@end example +Note there is actually just one @code{\} before the @code{*} +but the printer makes two so that the string can be read, since +@code{\} is also the lisp quote character. In the last example +an error is signalled since the special character @code{*} must +follow an atom if it is interpreted as a regular expression. + + + + + + diff --git a/info/structure.texi b/info/structure.texi new file mode 100755 index 0000000..a3794d7 --- /dev/null +++ b/info/structure.texi @@ -0,0 +1,43 @@ +@node Structures, Iteration and Tests, Operating System, Top +@chapter Structures + +@deffn {Macro} DEFSTRUCT +Package:LISP + +Syntax: +@example +(defstruct + @{name | (name @{:conc-name | (:conc-name prefix-string) | + :constructor | (:constructor symbol [lambda-list]) | + :copier | (:copier symbol) | + :predicate | (:predicate symbol) | + (:include symbol) | + (:print-function function) | + (:type @{vector | (vector type) | list@}) | + :named | (:static @{ nil | t@}) + (:initial-offset number)@}*)@} + [doc] + @{slot-name | + (slot-name [default-value-form] @{:type type | :read-only flag@}*) @}* + ) +@end example + +Defines a structure. The doc-string DOC, if supplied, is saved as a STRUCTURE +doc and can be retrieved by (documentation 'NAME 'structure). +STATIC is gcl specific and makes the body non relocatable. + +See the files misc/rusage.lsp misc/cstruct.lsp, for examples of making +a lisp structure correspond to a C structure. + + + +@end deffn + +@defun HELP (&optional symbol) +Package:LISP + +GCL specific: Prints the documentation associated with SYMBOL. With no +argument, this function prints the greeting message to GCL beginners. + + +@end defun diff --git a/info/symbol.texi b/info/symbol.texi new file mode 100755 index 0000000..a7608cf --- /dev/null +++ b/info/symbol.texi @@ -0,0 +1,461 @@ +@node Symbols, Operating System, Compilation, Top +@chapter Symbols + +@defun GENSYM (&optional (x nil)) +Package:LISP + +Creates and returns a new uninterned symbol whose name is a prefix string +(defaults to "G"), followed by a decimal number. The number is incremented +by each call to GENSYM. X, if an integer, resets the counter. If X is a +string, it becomes the new prefix. + + +@end defun + +@defun KEYWORDP (x) +Package:LISP + +Returns T if X is a symbol and it belongs to the KEYWORD package; NIL +otherwise. + + +@end defun + +@defun REMPROP (symbol indicator) +Package:LISP + +Look on property list of SYMBOL for property with specified +INDICATOR. If found, splice this indicator and its value out of +the plist, and return T. If not found, returns NIL with no side effects. + +@end defun + +@defun SYMBOL-PACKAGE (symbol) +Package:LISP + +Returns the contents of the package cell of the symbol SYMBOL. + + +@end defun + +@defvar *PACKAGE* +Package:LISP +The current package. + + +@end defvar + + +@defun SHADOWING-IMPORT (symbols &optional (package *package*)) +Package:LISP + +Imports SYMBOLS into PACKAGE, disregarding any name conflict. If a symbol +of the same name is already present, then it is uninterned. SYMBOLS must +be a list of symbols or a symbol. + + +@end defun + +@deffn {Macro} REMF +Package:LISP + +Syntax: +@example +(remf place indicator) +@end example + +PLACE may be any place expression acceptable to SETF, and is expected +to hold a property list or NIL. This list is destructively altered to +remove the property specified by INDICATOR. Returns T if such a +property was present; NIL otherwise. + + +@end deffn + +@defun MAKUNBOUND (symbol) +Package:LISP + +Makes empty the value slot of SYMBOL. Returns SYMBOL. + + +@end defun + +@defun USE-PACKAGE (packages-to-use &optional (package *package*)) +Package:LISP + +Adds all packages in PACKAGE-TO-USE list to the use list for PACKAGE so that +the external symbols of the used packages are available as internal symbols +in PACKAGE. + + +@end defun + +@defun MAKE-SYMBOL (string) +Package:LISP + +Creates and returns a new uninterned symbol whose print name is STRING. + + +@end defun + +@deffn {Special Form} PSETQ +Package:LISP + +Syntax: +@example +(psetq @{var form@}*) +@end example + +Similar to SETQ, but evaluates all FORMs first, and then assigns each value to +the corresponding VAR. Returns NIL always. + + +@end deffn + +@defun PACKAGE-USED-BY-LIST (package) +Package:LISP + +Returns the list of packages that use PACKAGE. + + +@end defun + +@defun SYMBOLP (x) +Package:LISP + +Returns T if X is a symbol; NIL otherwise. + + +@end defun + +@defvr {Constant} NIL +Package:LISP +Holds NIL. + + +@end defvr + +@defun SET (symbol value) +Package:LISP + +Assigns the value of VALUE to the dynamic variable named by SYMBOL, and +returns the value assigned. + + +@end defun + +@deffn {Special Form} SETQ +Package:LISP + +Syntax: +@example +(setq @{var form@}*) +@end example + +VARs are not evaluated and must be symbols. Assigns the value of the first +FORM to the first VAR, then assigns the value of the second FORM to the second +VAR, and so on. Returns the last value assigned. + + +@end deffn + +@defun UNUSE-PACKAGE (packages-to-unuse &optional (package *package*)) +Package:LISP + +Removes PACKAGES-TO-UNUSE from the use list for PACKAGE. + + +@end defun + +@defvr {Constant} T +Package:LISP +Holds T. + + +@end defvr + +@defun PACKAGE-USE-LIST (package) +Package:LISP + +Returns the list of packages used by PACKAGE. + + +@end defun + +@defun LIST-ALL-PACKAGES () +Package:LISP + +Returns a list of all existing packages. + + +@end defun + +@defun COPY-SYMBOL (symbol &optional (copy-props nil)) +Package:LISP + +Returns a new uninterned symbol with the same print name as SYMBOL. +If COPY-PROPS is NIL, the function, the variable, and the property slots +of the new symbol have no value. Otherwise, these slots are given the +values of the corresponding slots of SYMBOL. + + +@end defun + +@defun SYMBOL-PLIST (symbol) +Package:LISP + +Returns the property list of SYMBOL. + + +@end defun + +@defun SYMBOL-NAME (symbol) +Package:LISP + +Returns the print name of the symbol SYMBOL. + + +@end defun + +@defun FIND-SYMBOL (name &optional (package *package*)) +Package:LISP + +Returns the symbol named NAME in +PACKAGE. If such a symbol is found, then the second value is :INTERN, +:EXTERNAL, or :INHERITED to indicate how the symbol is accessible. If +no symbol is found then both values are NIL. + + +@end defun + +@defun SHADOW (symbols &optional (package *package*)) +Package:LISP + +Creates an internal symbol in PACKAGE with the same name as each of the +specified SYMBOLS. SYMBOLS must be a list of symbols or a symbol. + + +@end defun + + +@defun FBOUNDP (symbol) +Package:LISP + +Returns T if SYMBOL has a global function definition or if SYMBOL names a +special form or a macro; NIL otherwise. + + +@end defun + +@defun MACRO-FUNCTION (symbol) +Package:LISP + +If SYMBOL globally names a macro, then returns the expansion function. +Returns NIL otherwise. + + +@end defun + +@defun IN-PACKAGE (package-name &key (nicknames nil) (use '(lisp))) +Package:LISP + +Sets *PACKAGE* to the package with PACKAGE-NAME, creating the package if +it does not exist. If the package already exists then it is modified +to agree with USE and NICKNAMES arguments. Any new nicknames are added +without removing any old ones not specified. If any package in the USE list +is not currently used, then it is added to the use list. + + +@end defun + +@defun MAKE-PACKAGE (package-name &key (nicknames nil) (use '(lisp))) +Package:LISP + +Makes a new package having the specified PACKAGE-NAME and NICKNAMES. The +package will inherit all external symbols from each package in the USE list. + + +@end defun + +@defun PACKAGE-SHADOWING-SYMBOLS (package) +Package:LISP + +Returns the list of symbols that have been declared as shadowing symbols +in PACKAGE. + + +@end defun + +@defun INTERN (name &optional (package *package*)) +Package:LISP + +Returns a symbol having the specified name, creating it if necessary. +Returns as the second value one of the symbols :INTERNAL, :EXTERNAL, +:INHERITED, and NIL. + + +@end defun + +@defun EXPORT (symbols &optional (package *package*)) +Package:LISP + +Makes SYMBOLS external symbols of PACKAGE. SYMBOLS must be a list of symbols +or a symbol. + + +@end defun + +@defun PACKAGEP (x) +Package:LISP + +Returns T if X is a package; NIL otherwise. + + +@end defun + +@defun SYMBOL-FUNCTION (symbol) +Package:LISP + +Returns the current global function definition named by SYMBOL. + + +@end defun + +@defun SYMBOL-VALUE (symbol) +Package:LISP + +Returns the current value of the dynamic (special) variable named by SYMBOL. + + +@end defun + +@defun BOUNDP (symbol) +Package:LISP + +Returns T if the global variable named by SYMBOL has a value; NIL otherwise. + + +@end defun + +@defun DOCUMENTATION (symbol doc-type) +Package:LISP + +Returns the doc-string of DOC-TYPE for SYMBOL; NIL if none exists. +Possible doc-types are: + FUNCTION (special forms, macros, and functions) + VARIABLE (dynamic variables, including constants) + TYPE (types defined by DEFTYPE) + STRUCTURE (structures defined by DEFSTRUCT) + SETF (SETF methods defined by DEFSETF, DEFINE-SETF-METHOD, and + DEFINE-MODIFY-MACRO) +All built-in special forms, macros, functions, and variables have their +doc-strings. + + +@end defun + +@defun GENTEMP (&optional (prefix "t") (package *package*)) +Package:LISP + +Creates a new symbol interned in the package PACKAGE with the given PREFIX. + + +@end defun + +@defun RENAME-PACKAGE (package new-name &optional (new-nicknames nil)) +Package:LISP + +Replaces the old name and nicknames of PACKAGE with NEW-NAME and +NEW-NICKNAMES. + + +@end defun + +@defun UNINTERN (symbol &optional (package *package*)) +Package:LISP + +Makes SYMBOL no longer present in PACKAGE. Returns T if SYMBOL was present; +NIL otherwise. If PACKAGE is the home package of SYMBOL, then makes SYMBOL +uninterned. + + +@end defun + +@defun UNEXPORT (symbols &optional (package *package*)) +Package:LISP + +Makes SYMBOLS no longer accessible as external symbols in PACKAGE. SYMBOLS +must be a list of symbols or a symbol. + + +@end defun + +@defun PACKAGE-NICKNAMES (package) +Package:LISP + +Returns as a list the nickname strings for the specified PACKAGE. + + +@end defun + +@defun IMPORT (symbols &optional (package *package*)) +Package:LISP + +Makes SYMBOLS internal symbols of PACKAGE. SYMBOLS must be a list of symbols +or a symbol. + + +@end defun + +@defun GET (symbol indicator &optional (default nil)) +Package:LISP + +Looks on the property list of SYMBOL for the specified INDICATOR. If this +is found, returns the associated value. Otherwise, returns DEFAULT. + + +@end defun + +@defun FIND-ALL-SYMBOLS (string-or-symbol) +Package:LISP + +Returns a list of all symbols that have the specified name. + + +@end defun + +@defun FMAKUNBOUND (symbol) +Package:LISP + +Discards the global function definition named by SYMBOL. Returns SYMBOL. + + +@end defun + +@defun PACKAGE-NAME (package) +Package:LISP + +Returns the string that names the specified PACKAGE. + + +@end defun + +@defun FIND-PACKAGE (name) +Package:LISP + +Returns the specified package if it already exists; NIL otherwise. NAME may +be a string that is the name or nickname of the package. NAME may also be +a symbol, in which case the symbol's print name is used. + + +@end defun + + +@defun APROPOS-LIST (string &optional (package nil)) +Package:LISP + +Returns, as a list, all symbols whose print-names contain STRING as substring. +If PACKAGE is non-NIL, then only the specified package is searched. + + +@end defun diff --git a/info/system.texi b/info/system.texi new file mode 100755 index 0000000..06989ea --- /dev/null +++ b/info/system.texi @@ -0,0 +1,458 @@ + + +@node Operating System, Structures, Symbols, Top +@chapter Operating System + +@menu +* Command Line:: +* Operating System Definitions:: +@end menu + +@node Command Line, Operating System Definitions, Operating System, Operating System +@section Command Line + +The variable si::*command-args* is set to the list of strings passed +in when gcl is invoked. + +Various flags are understood. +@vtable @code +@item -eval +Call read and then eval on the command argument following @code{-eval} +@item -load +Load the file whose pathname is specified after @code{-load}. +@item -f +Replace si::*command-args* by the the list starting after @code{-f}. +Open the file following @code{-f} for input, skip the first line, and then +read and eval the rest of the forms in the file. This can be used +as with the shells to write small shell programs: +@example +#!/usr/local/bin/gcl.exe -f +(format t "hello world ~a~%" (nth 1 si::*command-args*)) +@end example +The value si::*command-args* will have the appropriate value. +Thus if the above 2 line file is made executable and called @file{foo} +then +@example +tutorial% foo billy +hello world billy +@end example +@noindent +NOTE: On many systems (eg SunOs) the first line of an executable script file +such as: +@example +#!/usr/local/bin/gcl.exe -f +@end example +only reads the first 32 characters! So if your pathname where the executable +together with the '-f' amount to more than 32 characters the file will not +be recognized. Also the executable must be the actual large binary file, +[or a link to it], +and not just a @code{/bin/sh} script. In latter case the +@code{/bin/sh} interpreter would get invoked on the file. + +Alternately one could invoke the file @file{foo} without making it +executable: +@example +tutorial% gcl -f foo "from bill" +hello world from bill +@end example + +Finally perhaps the best way (why do we save the best for last.. +I guess because we only figure it out after all the others..) +The following file @file{myhello} has 4 lines: +@example +#!/bin/sh +#| Lisp will skip the next 2 lines on reading +exec gcl -f "$0" $@ +|# +(format t "hello world ~a~%" (nth 1 si::*command-args*)) +@end example + +@example +marie% chmod a+x myhello +marie% myhello bill +hello world bill +@end example + +The advantage of this method is that @file{gcl} can itself +be a shell script, which sets up environment and +so on. Also the normal path will be searched to find @file{gcl} +The disadvantage is that this would cause 2 invocations of @file{sh} +and one invocation of @file{gcl}. The plan using @file{gcl.exe} +bypasses the @file{sh} entirely. Inded invoking @file{gcl.exe} to +print @file{hello world} is faster on most systems than a similar +@file{csh} or @file{bash} script, but slightly slower than the old +@file{sh}. + + +@item -batch +Do not enter the command print loop. Useful if the other command line +arguments do something. Do not print the License and acknowledgement +information. Note if your program does print any License information, +it must print the GCL header information also. +@item -dir +Directory where the executable binary that is running is located. +Needed by save and friends. This gets set as si::*system-directory* +@item -libdir +@example + -libdir @file{/d/wfs/gcl-2.0/} +@end example +would mean that the files like gcl-tk/tk.o would be found by +concatting the path to the libdir path, ie in +@example +@file{/d/wfs/gcl-2.0/gcl-tk/tk.o} +@end example +@item -compile +Invoke the compiler on the filename following @code{-compile}. +Other flags affect compilation. +@item -o-file +If nil follows @code{-o-file} then do not produce an @code{.o} file. +@item -c-file +If @code{-c-file} is specified, leave the intermediate @code{.c} file there. +@item -h-file +If @code{-h-file} is specified, leave the intermediate @code{.h} file there. +@item -data-file +If @code{-data-file} is specified, leave the intermediate @code{.data} file there. +@item -system-p +If @code{-system-p} is specified then invoke @code{compile-file} with the +@code{:system-p t} keyword argument, meaning that the C init function +will bear a name based on the name of the file, so that it may be invoked +by name by C code. +@end vtable + +@node Operating System Definitions, , Command Line, Operating System +@section Operating System Definitions + +@defun GET-DECODED-TIME () +Package:LISP + +Returns the current time in decoded time format. Returns nine values: second, +minute, hour, date, month, year, day-of-week, daylight-saving-time-p, and +time-zone. + + +@end defun + +@defun HOST-NAMESTRING (pathname) +Package:LISP + +Returns the host part of PATHNAME as a string. + + +@end defun + +@defun RENAME-FILE (file new-name) +Package:LISP + +Renames the file FILE to NEW-NAME. FILE may be a string, a pathname, or +a stream. + + +@end defun + +@defun FILE-AUTHOR (file) +Package:LISP + +Returns the author name of the specified file, as a string. +FILE may be a string or a stream + + +@end defun + +@defun PATHNAME-HOST (pathname) +Package:LISP + +Returns the host slot of PATHNAME. + + +@end defun + +@defun FILE-POSITION (file-stream &optional position) +Package:LISP + +Sets the file pointer of the specified file to POSITION, if POSITION is given. +Otherwise, returns the current file position of the specified file. + + +@end defun + +@defun DECODE-UNIVERSAL-TIME (universal-time &optional (timezone -9)) +Package:LISP + +Converts UNIVERSAL-TIME into a decoded time at the TIMEZONE. +Returns nine values: second, minute, hour, date, month (1 - 12), year, +day-of-week (0 - 6), daylight-saving-time-p, and time-zone. +TIMEZONE in GCL defaults to 6, the time zone of Austin, Texas. + + +@end defun + +@defun USER-HOMEDIR-PATHNAME (&optional host) +Package:LISP + +Returns the home directory of the logged in user as a pathname. HOST +is ignored. + + +@end defun + + +@defvar *MODULES* +Package:LISP +A list of names of the modules that have been loaded into GCL. + + +@end defvar + +@defun SHORT-SITE-NAME () +Package:LISP + +Returns a string that identifies the physical location of the current GCL. + + +@end defun + +@defun DIRECTORY (name) +Package:LISP + +Returns a list of files that match NAME. NAME may be a string, a pathname, +or a file stream. + + +@end defun + +@defun SOFTWARE-VERSION () +Package:LISP + +Returns a string that identifies the software version of the software +under which GCL is currently running. + + +@end defun + +@defvr {Constant} INTERNAL-TIME-UNITS-PER-SECOND +Package:LISP +The number of internal time units that fit into a second. + + +@end defvr + +@defun ENOUGH-NAMESTRING (pathname &optional (defaults *default-pathname-defaults*)) +Package:LISP + +Returns a string which uniquely identifies PATHNAME with respect to +DEFAULTS. + + +@end defun + +@defun REQUIRE (module-name &optional (pathname)) +Package:LISP + +If the specified module is not present, then loads the appropriate file(s). +PATHNAME may be a single pathname or it may be a list of pathnames. + + +@end defun + +@defun ENCODE-UNIVERSAL-TIME (second minute hour date month year &optional (timezone )) +Package:LISP + +Does the inverse operation of DECODE-UNIVERSAL-TIME. + + +@end defun + +@defun LISP-IMPLEMENTATION-VERSION () +Package:LISP + +Returns a string that tells you when the current GCL implementation is +brought up. + + +@end defun + +@defun MACHINE-INSTANCE () +Package:LISP + +Returns a string that identifies the machine instance of the machine +on which GCL is currently running. + + +@end defun + +@defun ROOM (&optional (x t)) +Package:LISP + +Displays information about storage allocation in the following format. + +@itemize @asis{} + +@item +for each type class +@itemize @asis{} +@item +the number of pages so-far allocated for the type class +@item +the maximum number of pages for the type class +@item +the percentage of used cells to cells so-far allocated +@item +the number of times the garbage collector has been called to + collect cells of the type class +@item +the implementation types that belongs to the type class +@end itemize +@item +the number of pages actually allocated for contiguous blocks +@item +the maximum number of pages for contiguous blocks +@item +the number of times the garbage collector has been called to collect + contiguous blocks +@item +the number of pages in the hole +@item +the maximum number of pages for relocatable blocks +@item +the number of times the garbage collector has been called to collect + relocatable blocks +@item +the total number of pages allocated for cells +@item +the total number of pages allocated +@item +the number of available pages +@item +the number of pages GCL can use. + +The number of times the garbage collector has been called is not shown, +if the number is zero. The optional X is ignored. +@end itemize + +@end defun + +@defun GET-UNIVERSAL-TIME () +Package:LISP + +Returns the current time as a single integer in universal time format. + + +@end defun + +@defun GET-INTERNAL-RUN-TIME () +Package:LISP + +Returns the run time in the internal time format. This is useful for +finding CPU usage. If the operating system allows, a second value +containing CPU usage of child processes is returned. + + +@end defun + +@defvar *DEFAULT-PATHNAME-DEFAULTS* +Package:LISP +The default pathname-defaults pathname. + + +@end defvar + +@defun LONG-SITE-NAME () +Package:LISP + +Returns a string that identifies the physical location of the current GCL. + + +@end defun + +@defun DELETE-FILE (file) +Package:LISP + Deletes FILE. + + +@end defun + +@defun GET-INTERNAL-REAL-TIME () +Package:LISP + +Returns the real time in the internal time format. This is useful for +finding elapsed time. + + +@end defun + +@defun MACHINE-TYPE () +Package:LISP + +Returns a string that identifies the machine type of the machine +on which GCL is currently running. + + +@end defun + +@deffn {Macro} TIME +Package:LISP + +Syntax: +@example +(time form) +@end example + +Evaluates FORM and outputs timing statistics on *TRACE-OUTPUT*. + + +@end deffn + +@defun SOFTWARE-TYPE () +Package:LISP + +Returns a string that identifies the software type of the software +under which GCL is currently running. + + +@end defun + +@defun LISP-IMPLEMENTATION-TYPE () +Package:LISP + +Returns a string that tells you that you are using a version of GCL. + + +@end defun + +@defun SLEEP (n) +Package:LISP + +This function causes execution to be suspended for N seconds. N may +be any non-negative, non-complex number. + + +@end defun + +@defun BREAK-ON-FLOATING-POINT-EXCEPTIONS (&key division-by-zero + floating-point-invalid-operation + floating-point-overflow + floating-point-underflow + floating-point-inexact) +Package:SI + +Break on the specified IEEE floating point error conditions. With no +arguments, report the exceptions currently trapped. Disable the break +by setting the key to nil, e.g. + + > (break-on-floaing-point-exceptions :division-by-zero t) + (DIVISION-BY-ZERO) + + > (break-on-floaing-point-exceptions) + (DIVISION-BY-ZERO) + + > (break-on-floaing-point-exceptions :division-by-zero nil) + NIL + +On some of the most common platforms, the offending instruction will be +disassembled, and the register arguments looked up in the saved context +and reported in as operands. Within the error handler, addresses may be +disassembled, and other registers inspected, using the functions defined +in gcl_fpe.lsp. + +@end defun + diff --git a/info/type.texi b/info/type.texi new file mode 100755 index 0000000..2602f99 --- /dev/null +++ b/info/type.texi @@ -0,0 +1,119 @@ +@node Type, GCL Specific, Doc, Top +@chapter Type + +@defun COERCE (x type) +Package:LISP + +Coerces X to an object of the type TYPE. + + +@end defun + +@defun TYPE-OF (x) +Package:LISP + +Returns the type of X. + + +@end defun + +@defun CONSTANTP (symbol) +Package:LISP + +Returns T if the variable named by SYMBOL is a constant; NIL otherwise. + + +@end defun + +@defun TYPEP (x type) +Package:LISP + +Returns T if X is of the type TYPE; NIL otherwise. + + +@end defun + +@defun COMMONP (x) +Package:LISP + +Returns T if X is a Common Lisp object; NIL otherwise. + + +@end defun + +@defun SUBTYPEP (type1 type2) +Package:LISP + +Returns T if TYPE1 is a subtype of TYPE2; NIL otherwise. If it could not +determine, then returns NIL as the second value. Otherwise, the second value +is T. + + +@end defun + +@deffn {Macro} CHECK-TYPE +Package:LISP + +Syntax: +@example +(check-type place typespec [string]) +@end example + +Signals an error, if the contents of PLACE are not of the specified type. + + +@end deffn + +@deffn {Macro} ASSERT +Package:LISP + +Syntax: +@example +(assert test-form [(@{place@}*) [string @{arg@}*]]) +@end example + +Signals an error if the value of TEST-FORM is NIL. STRING is an format string +used as the error message. ARGs are arguments to the format string. + + +@end deffn + +@deffn {Macro} DEFTYPE +Package:LISP + +Syntax: +@example +(deftype name lambda-list @{decl | doc@}* @{form@}*) +@end example + +Defines a new type-specifier abbreviation in terms of an 'expansion' function + (lambda lambda-list1 @{decl@}* @{form@}*) +where lambda-list1 is identical to LAMBDA-LIST except that all optional +parameters with no default value specified in LAMBDA-LIST defaults to the +symbol '*', but not to NIL. When the type system of GCL encounters a +type specifier (NAME arg1 ... argn), it calls the expansion function with +the arguments arg1 ... argn, and uses the returned value instead of the +original type specifier. When the symbol NAME is used as a type specifier, +the expansion function is called with no argument. The doc-string DOC, if +supplied, is saved as the TYPE doc of NAME, and is retrieved by +(documentation 'NAME 'type). + + +@end deffn + +@defvr {Declaration} DYNAMIC-EXTENT +Package:LISP +Declaration to allow locals to be cons'd on the C stack. +For example +(defun foo (&rest l) (declare (:dynamic-extent l)) ...) +will cause l to be a list formed on the C stack of the foo function +frame. +Of course passing L out as a value of foo will cause havoc. +(setq x (make-list n)) +(setq x (cons a b)) +(setq x (list a b c ..)) +also are handled on the stack, for dynamic-extent x. + + + +@end defvr diff --git a/info/user-interface.texi b/info/user-interface.texi new file mode 100755 index 0000000..0224253 --- /dev/null +++ b/info/user-interface.texi @@ -0,0 +1,383 @@ +@node User Interface, Doc, Iteration and Tests, Top +@chapter User Interface + +@defvr {Special Variable} - +Package:LISP +Holds the top-level form that GCL is currently evaluating. + + +@end defvr + +@defun - (number &rest more-numbers) +Package:LISP + +Subtracts the second and all subsequent NUMBERs from the first NUMBER. +With one arg, negates it. + + +@end defun + +@deffn {Macro} UNTRACE +Package:LISP + +Syntax: +@example +(untrace @{function-name@}*) +@end example + +Removes tracing from the specified functions. With no FUNCTION-NAMEs, +untraces all functions. + + +@end deffn + +@defvar *** +Package:LISP +Gets the previous value of ** when GCL evaluates a top-level form. + + +@end defvar + +@defun MAKE-STRING-INPUT-STREAM (string &optional (start 0) (end (length string))) +Package:LISP + +Returns an input stream which will supply the characters of String between +Start and End in order. + + +@end defun + +@deffn {Macro} STEP +Package:LISP + +Syntax: +@example +(step form) +@end example + +Evaluates FORM in the single-step mode and returns the value. + + +@end deffn + +@defvar *BREAK-ENABLE* +Package:LISP +GCL specific: When an error occurrs, control enters to the break loop only +if the value of this variable is non-NIL. + + +@end defvar + +@defvr {Special Variable} / +Package:LISP +Holds a list of the values of the last top-level form. + + +@end defvr + +@defun DESCRIBE (x) +Package:LISP + +Prints a description of the object X. + + +@end defun + +@defun ED (&optional x) +Package:LISP + +Invokes the editor. The action depends on the version of GCL. + + +@end defun + +@defvar *DEBUG-IO* +Package:LISP +Holds the I/O stream used by the GCL debugger. + + +@end defvar + +@defvar *BREAK-ON-WARNINGS* +Package:LISP +When the function WARN is called, control enters to the break loop only +if the value of this varialbe is non-NIL. + + +@end defvar + +@defun CERROR (continue-format-string error-format-string &rest args) +Package:LISP + +Signals a correctable error. + + +@end defun + +@defvar ** +Package:LISP +Gets the previous value of * when GCL evaluates a top-level form. + + +@end defvar + +@defvr {Special Variable} +++ +Package:LISP +Gets the previous value of ++ when GCL evaluates a top-level form. + + +@end defvr + +@defun INSPECT (x) +Package:LISP + +Shows the information about the object X in an interactive manner + + +@end defun + +@defvr {Special Variable} // +Package:LISP +Gets the previous value of / when GCL evaluates a top-level form. + + +@end defvr + +@defvar *TRACE-OUTPUT* +Package:LISP +The trace output stream. + + +@end defvar + +@defvr {Special Variable} ++ +Package:LISP +Gets the previous value of + when GCL evaluates a top-level form. + + +@end defvr + +@defvar *ERROR-OUTPUT* +Package:LISP +Holds the output stream for error messages. + + +@end defvar + +@defun DRIBBLE (&optional pathname) +Package:LISP + +If PATHNAME is given, begins to record the interaction to the specified file. +If PATHNAME is not given, ends the recording. + + +@end defun + +@defvar * +Package:LISP +Holds the value of the last top-level form. + + +@end defvar + +@defvr {Special Variable} /// +Package:LISP +Gets the previous value of // when GCL evaluates a top-level form. + + +@end defvr + +@defun WARN (format-string &rest args) +Package:LISP + +Formats FORMAT-STRING and ARGs to *ERROR-OUTPUT* as a warning message. + + +@end defun + +@defun BREAK (&optional (format-string nil) &rest args) +Package:LISP + +Enters a break loop. If FORMAT-STRING is non-NIL, formats FORMAT-STRING +and ARGS to *ERROR-OUTPUT* before entering a break loop. +Typing :HELP at the break loop will list the break-loop commands. + + +@end defun + +@defvr {Special Variable} + +Package:LISP +Holds the last top-level form. + + +@end defvr + +@deffn {Macro} TRACE +Package:LISP + +Syntax: +@example +(trace @{function-name@}*) +@end example + +Traces the specified functions. With no FUNCTION-NAMEs, returns a list of +functions currently being traced. + +Additional Keywords are allowed in GCL with the +syntax (trace @{fn | (fn @{:kw form@}*)@}*) + +For each FN naming a function, traces that function. Each :KW should +be one of the ones listed below, and FORM should have the +corresponding form. No :KW may be given more than once for the same +FN. Returns a list of all FNs now traced which weren't already +traced. + + +EXAMPLE (Try this with your favorite factorial function FACT): + +@example +;; print entry args and exit values + +(trace FACT) + +;; Break coming out of FACT if the value is bigger than 1000. + +(trace (fact :exit + (progn + (if (> (car values) 1000)(break "big result")) + (car values)))) + +;; Hairy example: + +;;make arglist available without the si:: prefix +(import 'si::arglist) + +(trace (fact + :DECLARATIONS + ((in-string "Here comes input: ") + (out-string "Here comes output: ") + all-values + (silly (+ 3 4))) + :COND + (equal (rem (car arglist) 2) 0) + :ENTRY + (progn + (cond + ((equal (car arglist) 8) + (princ "Entering FACT on input 8!! ") + (setq out-string "Here comes output from inside (FACT 8): ")) + (t + (princ in-string))) + (car arglist)) + :EXIT + (progn + (setq all-values (cons (car values) all-values)) + (princ out-string) + (when (equal (car arglist) 8) + ;; reset out-string + (setq out-string "Here comes output: ")) + (cons 'fact values)) + :ENTRYCOND + (not (= (car arglist) 6)) + :EXITCOND + (not (= (car values) (* 6 (car arglist)))) + :DEPTH + 5)) +@end example + +Syntax is @code{:keyword} @i{form1} @code{:keyword} @i{form2} ... + +@table @code +@item :declarations +@example +DEFAULT: NIL +@end example + +FORM is ((var1 form1 )(var2 form2 )...), where +the var_i are symbols distinct from each other and from +all symbols which are similarly declared for currently +traced functions. Each form is evaluated immediately. +Upon any invocation of a traced function when not already +inside a traced function call, each var is bound to +that value of form . + +@item :COND +@example +DEFAULT: T +@end example + +Here, FORM is any Lisp form to be evaluated (by EVAL) +upon entering a call of FN, in the environment where si::ARGLIST +is bound to the current list of arguments of FN. Note that +even if the evaluation of FORM changes the value of SI::ARGLIST +(e.g. by evaluation of (SETQ si::ARGLIST ...)), the list of +arguments passed to FN is unchanged. Users may alter args passed +by destructively modifying the list structure of SI::ARGLIST +however. The call is traced +(thus invoking the :ENTRYCOND and :EXITCOND forms, at least) +if and only if FORM does not evaluate to NIL. + +@item :ENTRYCOND +@example +DEFAULT: T +@end example + +This is evaluated (by EVAL) if the :COND form evaluates to +non-NIL, both in an environment where SI::ARGLIST is bound to the +current list of arguments of FN. If non-NIL, the :ENTRY form +is then evaluated and printed with the trace "prompt". + +@item :ENTRY +@example +DEFAULT: (CONS (QUOTE x) SI::ARGLIST), +@end example + +where x is the symbol we call FN +If the :COND and :ENTRYCOND forms evaluate to non-NIL, +then the trace "prompt" is printed and then this FORM is +evaluated (by EVAL) in an environment where SI::ARGLIST is bound +to the current list of arguments of FN. The result is then +printed. + +@item :EXITCOND +@example +DEFAULT: T +@end example + +This is evaluated (by EVAL) in the environment described +below for the :EXIT form. The :EXIT form is then evaluated +and printed with the "prompt" if and only if the result here +is non-NIL. + +@item :EXIT +@example +DEFAULT: (CONS (QUOTE x) VALUES), +@end example + +where x is the symbol we call FN +Upon exit from tracing a given call, this FORM is +evaluated (after the appropriate trace "prompt" is printed), +using EVAL in an environment where SI::ARGLIST is bound to the +current list of arguments of FN and VALUES is bound to the +list of values returned by FN (recalling that Common Lisp +functions may return multiple values). + +@item :DEPTH +@example +DEFAULT: No depth limit +@end example + +FORM is simply a positive integer specifying the maximum +nesting of traced calls of FN, i.e. of calls of FN in which +the :COND form evaluated to non-NIL. For calls of FN in +which this limit is exceeded, even the :COND form is not +evaluated, and the call is not traced. + +@end table + +@end deffn + + + + + diff --git a/info/widgets.texi b/info/widgets.texi new file mode 100755 index 0000000..21a2e89 --- /dev/null +++ b/info/widgets.texi @@ -0,0 +1,5033 @@ +@c Copyright (c) 1994 William Schelter. + + +@c Copyright (c) 1990 The Regents of the University of California. +@c All rights reserved. +@c +@c Permission is hereby granted, without written agreement and without +@c license or royalty fees, to use, copy, modify, and distribute this +@c documentation for any purpose, provided that the above copyright +@c notice and the following two paragraphs appear in all copies. +@c +@c IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY +@c FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +@c ARISING OUT OF THE USE OF THIS DOCUMENTATION, EVEN IF THE UNIVERSITY OF +@c CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +@c +@c THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, +@c INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY +@c AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS +@c ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO +@c PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. + +@node Widgets, Control, General, Top +@chapter Widgets + +@menu +* button:: +* listbox:: +* scale:: +* canvas:: +* menu:: +* scrollbar:: +* checkbutton:: +* menubutton:: +* text:: +* entry:: +* message:: +* frame:: +* label:: +* radiobutton:: +* toplevel:: +@end menu + +@node button, listbox, Widgets, Widgets +@section button +@c @cartouche + +button \- Create and manipulate button widgets +@unnumberedsubsec Synopsis +@b{button}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +activeBackground bitmap font relief +activeForeground borderWidth foreground text +anchor cursor padX textVariable +background disabledForeground padY +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Button + + +@table @asis +@item @code{@b{:command}} +@flushright +Name=@code{"@b{command}@r{"} Class=@code{"}@b{Command}"} +@end flushright +@sp 1 + +Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is released over the button +window. +@end table + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies a desired height for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in lines of text. +If this option isn't specified, the button's desired height is computed +from the size of the bitmap or text being displayed in it. +@end table + + +@table @asis +@item @code{@b{:state}} +@flushright +Name=@code{"@b{state}@r{"} Class=@code{"}@b{State}"} +@end flushright +@sp 1 + +Specifies one of three states for the button: @b{normal}@r{, }@b{active}, +or @b{disabled}. In normal state the button is displayed using the +@b{foreground}@r{ and }@b{background} options. The active state is +typically used when the pointer is over the button. In active state +the button is displayed using the @b{activeForeground} and +@b{activeBackground} options. Disabled state means that the button +is insensitive: it doesn't activate and doesn't respond to mouse +button presses. In this state the @b{disabledForeground} and +@b{background} options determine how the button is displayed. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies a desired width for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in characters. +If this option isn't specified, the button's desired width is computed +from the size of the bitmap or text being displayed in it. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{button} command creates a new window (given by the +@i{pathName} argument) and makes it into a button widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the button such as its colors, font, +text, and initial relief. The @b{button} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A button is a widget +that displays a textual string or bitmap. +It can display itself in either of three different ways, according +to +the @b{state} option; +it can be made to appear raised, sunken, or flat; +and it can be made to flash. When a user invokes the +button (by pressing mouse button 1 with the cursor over the +button), then the Tcl command specified in the @b{:command} +option is invoked. + +@unnumberedsubsec A Button Widget's Arguments + +The @b{button} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for button widgets: + +@table @asis +@item @i{pathName }@b{:activate} +Change the button's state to @b{active} and redisplay the button +using its active foreground and background colors instead of normal +colors. +This command is ignored if the button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state active}'' instead. +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{button} +command. +@item @i{pathName }@b{:deactivate} +Change the button's state to @b{normal} and redisplay the button +using its normal foreground and background colors. +This command is ignored if the button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state normal}'' instead. +@item @i{pathName }@b{:flash} +Flash the button. This is accomplished by redisplaying the button +several times, alternating between active and normal colors. At +the end of the flash the button is left in the same normal/active +state as when the command was invoked. +This command is ignored if the button's state is @b{disabled}. +@item @i{pathName }@b{:invoke} +Invoke the Tcl command associated with the button, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the button. +This command is ignored if the button's state is @b{disabled}. + +@end table +@unnumberedsubsec "Default Bindings" + +Tk automatically creates class bindings for buttons that give them +the following default behavior: +@itemize @asis{} +@item +[1] +The button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves the button. +@item +[2] +The button's relief is changed to sunken whenever mouse button 1 is +pressed over the button, and the relief is restored to its original +value when button 1 is later released. +@item +[3] +If mouse button 1 is pressed over the button and later released over +the button, the button is invoked. However, if the mouse is not +over the button when button 1 is released, then no invocation occurs. +@end itemize + +If the button's state is @b{disabled} then none of the above +actions occur: the button is completely non-responsive. + +The behavior of buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +@unnumberedsubsec Keywords +button, widget +@node listbox, scale, button, Widgets +@section listbox +@c @cartouche + +listbox \- Create and manipulate listbox widgets +@unnumberedsubsec Synopsis +@b{listbox}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +background foreground selectBackground xScrollCommand +borderWidth font selectBorderWidth yScrollCommand +cursor geometry selectForeground +exportSelection relief setGrid +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Listbox + + +None. +@c @end cartouche + +@unnumberedsubsec Description + +The @b{listbox} command creates a new window (given by the +@i{pathName} argument) and makes it into a listbox widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the listbox such as its colors, font, +text, and relief. The @b{listbox} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A listbox is a widget that displays a list of strings, one per line. +When first created, a new listbox has no elements in its list. +Elements may be added or deleted using widget commands described +below. In addition, one or more elements may be selected as described +below. +If a listbox is exporting its selection (see @b{exportSelection} +option), then it will observe the standard X11 protocols +for handling the selection; listbox selections are available +as type @b{STRING}, consisting of a Tcl list with one entry +for each selected element. + +For large lists only a subset of the list elements will be +displayed in the listbox window at once; commands described below +may be used to change the view in the window. Listboxes allow +scrolling in both directions using the standard @b{xScrollCommand} +and @b{yScrollCommand} options. +They also support scanning, as described below. + +@unnumberedsubsec A Listbox's Arguments + +The @b{listbox} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for listbox widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{listbox} +command. +@item @i{pathName }@b{:curselection} +Returns a list containing the indices of +all of the elements in the listbox that are currently selected. +If there are no elements selected in the listbox then an empty +string is returned. +@item @i{pathName }@b{:delete }@i{first }@r{?}@i{last}? +Delete one or more elements of the listbox. @i{First}@r{ and }@i{last} +give the integer indices of the first and last elements in the range +to be deleted. If @i{last} isn't specified it defaults to +@i{first}, i.e. a single element is deleted. An index of +@b{0} corresponds to the first element in the listbox. Either +@i{first}@r{ or }@i{last}@r{ may be specified as }@b{end}, in which +case it refers to the last element of the listbox. This command +returns an empty string +@item @i{pathName }@b{:get }@i{index} +Return the contents of the listbox element indicated by @i{index}. +@i{Index} must be a non-negative integer (0 corresponds to +the first element in the listbox), or it may also be specified as +@b{end} to indicate the last element in the listbox. +@item @i{pathName }@b{:insert }@i{index }@r{?}@i{element element ...}? +Insert zero or more new elements in the list just before the +element given by @i{index}@r{. If }@i{index} is specified as +@b{end} then the new elements are added to the end of the +list. Returns an empty string. +@item @i{pathName }@b{:nearest }@i{y} +Given a y-coordinate within the listbox window, this command returns +the index of the (visible) listbox element nearest to that y-coordinate. +@item @i{pathName }@b{:scan}@r{ }@i{option args} +This command is used to implement scanning on listboxes. It has +two forms, depending on @i{option}: +@table @asis +@item @i{pathName }@b{:scan :mark }@i{x y} +Records @i{x}@r{ and }@i{y} and the current view in the listbox +window; used in conjunction with later @b{scan dragto} commands. +Typically this command is associated with a mouse button press in +the widget. It returns an empty string. +@item @i{pathName }@b{:scan :dragto }@i{x y}. +This command computes the difference between its @i{x}@r{ and }@i{y} +arguments and the @i{x}@r{ and }@i{y} arguments to the last +@b{scan mark} command for the widget. +It then adjusts the view by 10 times the +difference in coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the list at high speed through the window. The return +value is an empty string. +@end table +@item @i{pathName }@b{:select }@i{option arg} +This command is used to adjust the selection within a listbox. It +has several forms, depending on @i{option}. In all of the forms +the index @b{end} refers to the last element in the listbox. +@table @asis +@item @i{pathName }@b{:select :adjust }@i{index} +Locate the end of the selection nearest to the element given by +@i{index}@r{, and adjust that end of the selection to be at }@i{index} +(i.e including but not going beyond @i{index}). The other +end of the selection is made the anchor point for future +@b{select to} commands. If the selection +isn't currently in the listbox, then this command is identical to +the @b{select from} widget command. +Returns an empty string. +@item @i{pathName }@b{:select :clear} +If the selection is in this listbox then it is cleared so that +none of the listbox's elements are selected anymore. +@item @i{pathName }@b{:select :from }@i{index} +Set the selection to consist of element @i{index}, and make +@i{index}@r{ the anchor point for future }@b{select to} widget +commands. Returns an empty string. +@item @i{pathName }@b{:select :to }@i{index} +Set the selection to consist of the elements from the anchor +point to element @i{index}, inclusive. The anchor point is +determined by the most recent @b{select from}@r{ or }@b{select adjust} +command in this widget. If the selection isn't in this widget, +this command is identical to @b{select from}. +Returns an empty string. +@end table + +@item @i{pathName }@b{:size} +Returns a decimal string indicating the total number of elements +in the listbox. +@item @i{pathName }@b{:xview }@i{index} +Adjust the view in the listbox so that character position @i{index} +is displayed at the left edge of the widget. +Returns an empty string. +@item @i{pathName }@b{:yview }@i{index} +Adjust the view in the listbox so that element @i{index} is +displayed at the top of the widget. +If @i{index}@r{ is specified as }@b{end} it indicates the last +element of the listbox. Returns an empty string. + +@end table +@unnumberedsubsec "Default Bindings" + +Tk automatically creates class bindings for listboxes that give them +the following default behavior: +@itemize @asis{} +@item +[1] +When button 1 is pressed over a listbox, the element underneath the +mouse cursor is selected. The mouse can be dragged to select a +range of elements. +@item +[2] +The ends of the selection can be adjusted by dragging with mouse +button 1 while the shift key is down; this will adjust the end +of the selection that was nearest to the mouse cursor when button +1 was pressed. +@item +[3] +The view in the listbox can be adjusted by dragging with mouse button 2. +@end itemize + +The behavior of listboxes can be changed by defining new bindings for +individual widgets or by redefining the class bindings. +In addition, the procedure @b{tk_listboxSingleSelect} may be +invoked to change listbox behavior so that only a single element +may be selected at once. + +@unnumberedsubsec Keywords +listbox, widget +@node scale, canvas, listbox, Widgets +@section scale +@c @cartouche + +scale \- Create and manipulate scale widgets +@unnumberedsubsec Synopsis +@b{scale}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +activeForeground borderWidth font orient +background cursor foreground relief +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Scale + + +@table @asis +@item @code{@b{:command}} +@flushright +Name=@code{"@b{command}@r{"} Class=@code{"}@b{Command}"} +@end flushright +@sp 1 + +Specifies the prefix of a Tcl command to invoke whenever the value of +the scale is changed interactively. The actual command consists +of this option followed by +a space and a number. The number indicates the new value of the +scale. +@end table + + +@table @asis +@item @code{@b{:from}} +@flushright +Name=@code{"@b{from}@r{"} Class=@code{"}@b{From}"} +@end flushright +@sp 1 + +Specifies the value corresponding to the left or top end of the +scale. Must be an integer. +@end table + + +@table @asis +@item @code{@b{:label}} +@flushright +Name=@code{"@b{label}@r{"} Class=@code{"}@b{Label}"} +@end flushright +@sp 1 + +Specifies a string to displayed as a label for the scale. For +vertical scales the label is displayed just to the right of the +top end of the scale. For horizontal scales the label is displayed +just above the left end of the scale. +@end table + + +@table @asis +@item @code{@b{:length}} +@flushright +Name=@code{"@b{length}@r{"} Class=@code{"}@b{Length}"} +@end flushright +@sp 1 + +Specifies the desired long dimension of the scale in screen units, +that is in any of the forms acceptable to @b{Tk_GetPixels}. +For vertical scales this is the scale's height; for horizontal scales +it is the scale's width. +@end table + + +@table @asis +@item @code{@b{:showvalue}} +@flushright +Name=@code{"@b{showValue}@r{"} Class=@code{"}@b{ShowValue}"} +@end flushright +@sp 1 + +Specifies a boolean value indicating whether or not the current +value of the scale is to be displayed. +@end table + + +@table @asis +@item @code{@b{:sliderforeground}} +@flushright +Name=@code{"@b{sliderForeground}@r{"} Class=@code{"}@b{sliderForeground}"} +@end flushright +@sp 1 + +Specifies the color to use for drawing the slider under normal conditions. +When the mouse is in the slider window then the slider's color is +determined by the @b{activeForeground} option. +@end table + + +@table @asis +@item @code{@b{:sliderlength}} +@flushright +Name=@code{"@b{sliderLength}@r{"} Class=@code{"}@b{SliderLength}"} +@end flushright +@sp 1 + +Specfies the size of the slider, measured in screen units along the slider's +long dimension. The value may be specified in any of the forms acceptable +to @b{Tk_GetPixels}. +@end table + + +@table @asis +@item @code{@b{:state}} +@flushright +Name=@code{"@b{state}@r{"} Class=@code{"}@b{State}"} +@end flushright +@sp 1 + +Specifies one of two states for the scale: @b{normal}@r{ or }@b{disabled}. +If the scale is disabled then the value may not be changed and the scale +won't activate when the mouse enters it. +@end table + + +@table @asis +@item @code{@b{:tickinterval}} +@flushright +Name=@code{"@b{tickInterval}@r{"} Class=@code{"}@b{TickInterval}"} +@end flushright +@sp 1 + +Must be an integer value. Determines the spacing between numerical +tick-marks displayed below or to the left of the slider. If specified +as 0, then no tick-marks will be displayed. +@end table + + +@table @asis +@item @code{@b{:to}} +@flushright +Name=@code{"@b{to}@r{"} Class=@code{"}@b{To}"} +@end flushright +@sp 1 + +Specifies the value corresponding to the right or bottom end of the +scale. Must be an integer. This value may be either less than or +greater than the @b{from} option. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies the desired narrow dimension of the scale in screen units +(i.e. any of the forms acceptable to @b{Tk_GetPixels}). +For vertical scales this is the scale's width; for horizontal scales +this is the scale's height. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{scale} command creates a new window (given by the +@i{pathName} argument) and makes it into a scale widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the scale such as its colors, orientation, +and relief. The @b{scale} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A scale is a widget that displays a rectangular region and a +small @i{slider}. The rectangular region corresponds to a range +of integer values (determined by the @b{from}@r{ and }@b{to} options), +and the position of the slider selects a particular integer value. +The slider's position (and hence the scale's value) may be adjusted +by clicking or dragging with the mouse as described in the BINDINGS +section below. Whenever the scale's value is changed, a Tcl +command is invoked (using the @b{command} option) to notify +other interested widgets of the change. + +Three annotations may be displayed in a scale widget: a label +appearing at the top-left of the widget (top-right for vertical +scales), a number displayed just underneath the slider +(just to the left of the slider for vertical scales), and a collection +of numerical tick-marks just underneath the current value (just to the left of +the current value for vertical scales). Each of these three +annotations may be selectively enabled or disabled using the +configuration options. + +@unnumberedsubsec A Scale's"Argumentsommand" + +The @b{scale} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for scale widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{scale} +command. +@item @i{pathName }@b{:get} +Returns a decimal string giving the current value of the scale. +@item @i{pathName }@b{:set}@r{ }@i{value} +This command is invoked to change the current value of the scale, +and hence the position at which the slider is displayed. @i{Value} +gives the new value for the scale. + +@end table +@unnumberedsubsec Bindings + +When a new scale is created, it is given the following initial +behavior by default: + +@table @asis +@item @b{} +Change the slider display to use @b{activeForeground} instead of +@b{sliderForeground}. +@item @b{} +Reset the slider display to use @b{sliderForeground} instead of +@b{activeForeground}. +@item @b{} +Change the slider display so that the slider appears sunken rather +than raised. Move the slider (and adjust the scale's value) +to correspond to the current mouse position. +@item @b{} +Move the slider (and adjust the scale's value) to correspond to +the current mouse position. +@item @b{} +Reset the slider display so that the slider appears raised again. + +@end table +@unnumberedsubsec Keywords +scale, widget +@node canvas, menu, scale, Widgets +@section canvas +@c @cartouche + +canvas \- Create and manipulate canvas widgets +@unnumberedsubsec Synopsis +@b{canvas}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +background insertBorderWidth relief xScrollCommand +borderWidth insertOffTime selectBackground yScrollCommand +cursor insertOnTime selectBorderWidth +insertBackground insertWidth selectForeground +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Canvas + + +@table @asis +@item @code{@b{:closeenough}} +@flushright +Name=@code{"@b{closeEnough}@r{"} Class=@code{"}@b{CloseEnough}"} +@end flushright +@sp 1 + +Specifies a floating-point value indicating how close the mouse cursor +must be to an item before it is considered to be ``inside'' the item. +Defaults to 1.0. +@end table + + +@table @asis +@item @code{@b{:confine}} +@flushright +Name=@code{"@b{confine}@r{"} Class=@code{"}@b{Confine}"} +@end flushright +@sp 1 + +Specifies a boolean value that indicates whether or not it should be +allowable to set the canvas's view outside the region defined by the +@b{scrollRegion} argument. +Defaults to true, which means that the view will +be constrained within the scroll region. +@end table + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies a desired window height that the canvas widget should request from +its geometry manager. The value may be specified in any +of the forms described in the COORDINATES section below. +@end table + + +@table @asis +@item @code{@b{:scrollincrement}} +@flushright +Name=@code{"@b{scrollIncrement}@r{"} Class=@code{"}@b{ScrollIncrement}"} +@end flushright +@sp 1 + +Specifies a distance used as increment during scrolling: when one of +the arrow buttons on an associated scrollbar is pressed, the picture +will shift by this distance. The distance may be specified in any +of the forms described in the COORDINATES section below. +@end table + + +@table @asis +@item @code{@b{:scrollregion}} +@flushright +Name=@code{"@b{scrollRegion}@r{"} Class=@code{"}@b{ScrollRegion}"} +@end flushright +@sp 1 + +Specifies a list with four coordinates describing the left, top, right, and +bottom coordinates of a rectangular region. +This region is used for scrolling purposes and is considered to be +the boundary of the information in the canvas. +Each of the coordinates may be specified +in any of the forms given in the COORDINATES section below. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{width}"} +@end flushright +@sp 1 + +Specifies a desired window width that the canvas widget should request from +its geometry manager. The value may be specified in any +of the forms described in the COORDINATES section below. +@end table +@c @end cartouche + +@unnumberedsubsec Introduction + +The @b{canvas} command creates a new window (given +by the @i{pathName} argument) and makes it into a canvas widget. +Additional options, described above, may be specified on the +command line or in the option database +to configure aspects of the canvas such as its colors and 3-D relief. +The @b{canvas} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +Canvas widgets implement structured graphics. +A canvas displays any number of @i{items}, which may be things like +rectangles, circles, lines, and text. +Items may be manipulated (e.g. moved or re-colored) and commands may +be associated with items in much the same way that the @b{bind} +command allows commands to be bound to widgets. For example, +a particular command may be associated with the event +so that the command is invoked whenever button 1 is pressed with +the mouse cursor over an item. +This means that items in a canvas can have behaviors defined by +the Tcl scripts bound to them. + +@unnumberedsubsec Display List + +The items in a canvas are ordered for purposes of display, +with the first item in the display list being displayed +first, followed by the next item in the list, and so on. +Items later in the display list obscure those that are +earlier in the display list and are sometimes referred to +as being ``on top'' of earlier items. +When a new item is created it is placed at the end of the +display list, on top of everything else. +Widget commands may be used to re-arrange the order of the +display list. + +@unnumberedsubsec Item Ids And Tags + +Items in a canvas widget may be named in either of two ways: +by id or by tag. +Each item has a unique identifying number which is assigned to +that item when it is created. The id of an item never changes +and id numbers are never re-used within the lifetime of a +canvas widget. + +Each item may also have any number of @i{tags} associated +with it. A tag is just a string of characters, and it may +take any form except that of an integer. +For example, ``x123'' is OK but ``123'' isn't. +The same tag may be associated with many different items. +This is commonly done to group items in various interesting +ways; for example, all selected items might be given the +tag ``selected''. + +The tag @b{all} is implicitly associated with every item +in the canvas; it may be used to invoke operations on +all the items in the canvas. + +The tag @b{current} is managed automatically by Tk; +it applies to the @i{current item}, which is the +topmost item whose drawn area covers the position of +the mouse cursor. +If the mouse is not in the canvas widget or is not over +an item, then no item has the @b{current} tag. + +When specifying items in canvas widget commands, if the +specifier is an integer then it is assumed to refer to +the single item with that id. +If the specifier is not an integer, then it is assumed to +refer to all of the items in the canvas that have a tag +matching the specifier. +The symbol @i{tagOrId} is used below to indicate that +an argument specifies either an id that selects a single +item or a tag that selects zero or more items. +Some widget commands only operate on a single item at a +time; if @i{tagOrId} is specified in a way that +names multiple items, then the normal behavior is for +the command to use the first (lowest) of these items in +the display list that is suitable for the command. +Exceptions are noted in the widget command descriptions +below. + +@unnumberedsubsec Coordinates + +All coordinates related to canvases are stored as floating-point +numbers. +Coordinates and distances are specified in screen units, +which are floating-point numbers optionally followed +by one of several letters. +If no letter is supplied then the distance is in pixels. +If the letter is @b{m} then the distance is in millimeters on +the screen; if it is @b{c} then the distance is in centimeters; +@b{i}@r{ means inches, and }@b{p} means printers points (1/72 inch). +Larger y-coordinates refer to points lower on the screen; larger +x-coordinates refer to points farther to the right. + +@unnumberedsubsec Transformations + +Normally the origin of the canvas coordinate system is at the +upper-left corner of the window containing the canvas. +It is possible to adjust the origin of the canvas +coordinate system relative to the origin of the window using the +@b{xview}@r{ and }@b{yview} widget commands; this is typically used +for scrolling. +Canvases do not support scaling or rotation of the canvas coordinate +system relative to the window coordinate system. + +Indidividual items may be moved or scaled using widget commands +described below, but they may not be rotated. + +@unnumberedsubsec Indices + +Text items support the notion of an @i{index} for identifying +particular positions within the item. +Indices are used for commands such as inserting text, deleting +a range of characters, and setting the insertion cursor position. +An index may be specified in any of a number of ways, and +different types of items may support different forms for +specifying indices. +Text items support the following forms for an index; if you +define new types of text-like items, it would be advisable to +support as many of these forms as practical. +Note that it is possible to refer to the character just after +the last one in the text item; this is necessary for such +tasks as inserting new text at the end of the item. + +@table @asis +@item @i{number} +A decimal number giving the position of the desired character +within the text item. +0 refers to the first character, 1 to the next character, and +so on. +A number less than 0 is treated as if it were zero, and a +number greater than the length of the text item is treated +as if it were equal to the length of the text item. +@item @b{end} +Refers to the character just after the last one in the item +(same as the number of characters in the item). +@item @b{insert} +Refers to the character just before which the insertion cursor +is drawn in this item. +@item @b{sel.first} +Refers to the first selected character in the item. +If the selection isn't in this item then this form is illegal. +@item @b{sel.last} +Refers to the last selected character in the item. +If the selection isn't in this item then this form is illegal. +@item @b{@@}@i{x,y} +Refers to the character at the point given by @i{x} and +@i{y}@r{, where }@i{x}@r{ and }@i{y} are specified in the coordinate +system of the canvas. +If @i{x}@r{ and }@i{y} lie outside the coordinates covered by the +text item, then they refer to the first or last character in the +line that is closest to the given point. + +@end table +@unnumberedsubsec A Canvas Widget's Arguments + +The @b{canvas} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. +The following widget commands are possible for canvas widgets: + +@table @asis +@item @i{pathName }@b{:addtag }@i{tag searchSpec }@r{?}@i{arg arg ...}? +For each item that meets the constraints specified by +@i{searchSpec}@r{ and the }@i{arg}s, add +@i{tag} to the list of tags associated with the item if it +isn't already present on that list. +It is possible that no items will satisfy the constraints +given by @i{searchSpec and }@i{arg}s, in which case the +command has no effect. +This command returns an empty string as result. +@i{SearchSpec}@r{ and }@i{arg}'s may take any of the following +forms: + +@table @asis +@item @b{above }@i{tagOrId} +Selects the item just after (above) the one given by @i{tagOrId} +in the display list. +If @i{tagOrId} denotes more than one item, then the last (topmost) +of these items in the display list is used. +@item @b{all} +Selects all the items in the canvas. +@item @b{below }@i{tagOrId} +Selects the item just before (below) the one given by @i{tagOrId} +in the display list. +If @i{tagOrId} denotes more than one item, then the first (lowest) +of these items in the display list is used. +@item @b{closest }@i{x y }@r{?}@i{halo}@r{? ?}@i{start}? +Selects the item closest to the point given by @i{x}@r{ and }@i{y}. +If more than one item is at the same closest distance (e.g. two +items overlap the point), then the top-most of these items (the +last one in the display list) is used. +If @i{halo} is specified, then it must be a non-negative +value. +Any item closer than @i{halo} to the point is considered to +overlap it. +The @i{start} argument may be used to step circularly through +all the closest items. +If @i{start} is specified, it names an item using a tag or id +(if by tag, it selects the first item in the display list with +the given tag). +Instead of selecting the topmost closest item, this form will +select the topmost closest item that is below @i{start} in +the display list; if no such item exists, then the selection +behaves as if the @i{start} argument had not been specified. +@item @b{enclosed}@r{ }@i{x1}@r{ }@i{y1}@r{ }@i{x2}@r{ }@i{y2} +Selects all the items completely enclosed within the rectangular +region given by @i{x1}@r{, }@i{y1}@r{, }@i{x2}@r{, and }@i{y2}. +@i{X1}@r{ must be no greater then }@i{x2}@r{ and }@i{y1} must be +no greater than @i{y2}. +@item @b{overlapping}@r{ }@i{x1}@r{ }@i{y1}@r{ }@i{x2}@r{ }@i{y2} +Selects all the items that overlap or are enclosed within the +rectangular region given by @i{x1}@r{, }@i{y1}@r{, }@i{x2}, +and @i{y2}. +@i{X1}@r{ must be no greater then }@i{x2}@r{ and }@i{y1} must be +no greater than @i{y2}. +@item @b{withtag }@i{tagOrId} +Selects all the items given by @i{tagOrId}. +@end table + +@item @i{pathName }@b{:bbox }@i{tagOrId}@r{ ?}@i{tagOrId tagOrId ...}? +Returns a list with four elements giving an approximate bounding box +for all the items named by the @i{tagOrId} arguments. +The list has the form ``@i{x1 y1 x2 y2}'' such that the drawn +areas of all the named elements are within the region bounded by +@i{x1}@r{ on the left, }@i{x2}@r{ on the right, }@i{y1} on the top, +and @i{y2} on the bottom. +The return value may overestimate the actual bounding box by +a few pixels. +If no items match any of the @i{tagOrId} arguments then an +empty string is returned. +@item @i{pathName }@b{:bind }@i{tagOrId}@r{ ?}@i{sequence}@r{? ?}@i{command}? +This command associates @i{command} with all the items given by +@i{tagOrId} such that whenever the event sequence given by +@i{sequence} occurs for one of the items the command will +be invoked. +This widget command is similar to the @b{bind} command except that +it operates on items in a canvas rather than entire widgets. +See the @b{bind} manual entry for complete details +on the syntax of @i{sequence} and the substitutions performed +on @i{command} before invoking it. +If all arguments are specified then a new binding is created, replacing +any existing binding for the same @i{sequence}@r{ and }@i{tagOrId} +(if the first character of @i{command}@r{ is ``+'' then }@i{command} +augments an existing binding rather than replacing it). +In this case the return value is an empty string. +If @i{command}@r{ is omitted then the command returns the }@i{command} +associated with @i{tagOrId}@r{ and }@i{sequence} (an error occurs +if there is no such binding). +If both @i{command}@r{ and }@i{sequence} are omitted then the command +returns a list of all the sequences for which bindings have been +defined for @i{tagOrId}. +@end table + + +The only events for which bindings may be specified are those related +to the mouse and keyboard, such as @b{Enter}@r{, }@b{Leave}, +@b{ButtonPress}@r{, }@b{Motion}@r{, and }@b{KeyPress}. +The handling of events in canvases uses the current item defined +in ITEM IDS AND TAGS above. +@b{Enter}@r{ and }@b{Leave} events trigger for an item when it +becomes the current item or ceases to be the current item; note +that these events are different than @b{Enter}@r{ and }@b{Leave} +events for windows. +Mouse-related events are directed to the current item, if any. +Keyboard-related events are directed to the focus item, if any +(see the @b{focus} widget command below for more on this). + + +It is possible for multiple commands to be bound to a single +event sequence for a single object. +This occurs, for example, if one command is associated with the +item's id and another is associated with one of the item's tags. +When this occurs, the first matching binding is used. +A binding for the item's id has highest priority, followed by +the oldest tag for the item and proceeding through all of the +item's tags up through the most-recently-added one. +If a binding is associated with the tag @b{all}, the binding +will have lower priority than all other bindings associated +with the item. + +@table @asis +@item @i{pathName }@b{:canvasx }@i{screenx}@r{ ?}@i{gridspacing}? +Given a screen x-coordinate @i{screenx} this command returns +the canvas x-coordinate that is displayed at that location. +If @i{gridspacing} is specified, then the canvas coordinate is +rounded to the nearest multiple of @i{gridspacing} units. +@item @i{pathName }@b{:canvasy }@i{screeny}@r{ ?}@i{gridspacing}? +Given a screen y-coordinate @i{screeny} this command returns +the canvas y-coordinate that is displayed at that location. +If @i{gridspacing} is specified, then the canvas coordinate is +rounded to the nearest multiple of @i{gridspacing} units. +@item @i{pathName }@b{:configure ?}@i{option}@r{? ?}@i{value}@r{? ?}@i{option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{canvas} +command. +@item @i{pathName}@r{ }@b{:coords }@i{tagOrId }@r{?}@i{x0 y0 ...}? +Query or modify the coordinates that define an item. +If no coordinates are specified, this command returns a list +whose elements are the coordinates of the item named by +@i{tagOrId}. +If coordinates are specified, then they replace the current +coordinates for the named item. +If @i{tagOrId} refers to multiple items, then +the first one in the display list is used. +@item @i{pathName }@b{:create }@i{type x y }@r{?}@i{x y ...}@r{? ?}@i{option value ...}? +Create a new item in @i{pathName}@r{ of type }@i{type}. +The exact format of the arguments after @b{type} depends +on @b{type}, but usually they consist of the coordinates for +one or more points, followed by specifications for zero or +more item options. +See the subsections on individual item types below for more +on the syntax of this command. +This command returns the id for the new item. +@item @i{pathName }@b{:dchars }@i{tagOrId first }@r{?}@i{last}? +For each item given by @i{tagOrId}, delete the characters +in the range given by @i{first}@r{ and }@i{last}, +inclusive. +If some of the items given by @i{tagOrId} don't support +text operations, then they are ignored. +@i{First}@r{ and }@i{last} are indices of characters +within the item(s) as described in INDICES above. +If @i{last}@r{ is omitted, it defaults to }@i{first}. +This command returns an empty string. +@item @i{pathName }@b{:delete }@r{?}@i{tagOrId tagOrId ...}? +Delete each of the items given by each @i{tagOrId}, and return +an empty string. +@item @i{pathName }@b{:dtag }@i{tagOrId }@r{?tagToDelete}? +For each of the items given by @i{tagOrId}, delete the +tag given by @i{tagToDelete} from the list of those +associated with the item. +If an item doesn't have the tag @i{tagToDelete} then +the item is unaffected by the command. +If @i{tagToDelete}@r{ is omitted then it defaults to }@i{tagOrId}. +This command returns an empty string. +@item @i{pathName }@b{:find }@i{searchCommand }@r{?}@i{arg arg ...}? +This command returns a list consisting of all the items that +meet the constraints specified by @i{searchCommand} and +@i{arg}'s. +@i{SearchCommand}@r{ and }@i{args} have any of the forms +accepted by the @b{addtag} command. +@item @i{pathName }@b{:focus }@r{?}@i{tagOrId}? +Set the keyboard focus for the canvas widget to the item given by +@i{tagOrId}. +If @i{tagOrId} refers to several items, then the focus is set +to the first such item in the display list that supports the +insertion cursor. +If @i{tagOrId} doesn't refer to any items, or if none of them +support the insertion cursor, then the focus isn't changed. +If @i{tagOrId} is an empty +string, then the focus item is reset so that no item has the focus. +If @i{tagOrId} is not specified then the command returns the +id for the item that currently has the focus, or an empty string +if no item has the focus. +@end table + + +Once the focus has been set to an item, the item will display +the insertion cursor and all keyboard events will be directed +to that item. +The focus item within a canvas and the focus window on the +screen (set with the @b{focus} command) are totally independent: +a given item doesn't actually have the input focus unless (a) +its canvas is the focus window and (b) the item is the focus item +within the canvas. +In most cases it is advisable to follow the @b{focus} widget +command with the @b{focus} command to set the focus window to +the canvas (if it wasn't there already). + +@table @asis +@item @i{pathName }@b{:gettags}@r{ }@i{tagOrId} +Return a list whose elements are the tags associated with the +item given by @i{tagOrId}. +If @i{tagOrId} refers to more than one item, then the tags +are returned from the first such item in the display list. +If @i{tagOrId} doesn't refer to any items, or if the item +contains no tags, then an empty string is returned. +@item @i{pathName }@b{:icursor }@i{tagOrId index} +Set the position of the insertion cursor for the item(s) +given by @i{tagOrId} +to just before the character whose position is given by @i{index}. +If some or all of the items given by @i{tagOrId} don't support +an insertion cursor then this command has no effect on them. +See INDICES above for a description of the +legal forms for @i{index}. +Note: the insertion cursor is only displayed in an item if +that item currently has the keyboard focus (see the widget +command @b{focus}, below), but the cursor position may +be set even when the item doesn't have the focus. +This command returns an empty string. +@item @i{pathName }@b{:index }@i{tagOrId index} +This command returns a decimal string giving the numerical index +within @i{tagOrId}@r{ corresponding to }@i{index}. +@i{Index} gives a textual description of the desired position +as described in INDICES above. +The return value is guaranteed to lie between 0 and the number +of characters within the item, inclusive. +If @i{tagOrId} refers to multiple items, then the index +is processed in the first of these items that supports indexing +operations (in display list order). +@item @i{pathName }@b{:insert }@i{tagOrId beforeThis string} +For each of the items given by @i{tagOrId}, if the item supports +text insertion then @i{string} is inserted into the item's +text just before the character whose index is @i{beforeThis}. +See INDICES above for information about the forms allowed +for @i{beforeThis}. +This command returns an empty string. +@item @i{pathName }@b{:itemconfigure }@i{tagOrId}@r{ ?}@i{option}@r{? ?}@i{value}@r{? ?}@i{option value ...}? +This command is similar to the @b{configure} widget command except +that it modifies item-specific options for the items given by +@i{tagOrId} instead of modifying options for the overall +canvas widget. +If no @i{option} is specified, returns a list describing all of +the available options for the first item given by @i{tagOrId} +(see @b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s) in +each of the items given by @i{tagOrId}; in +this case the command returns an empty string. +The @i{option}@r{s and }@i{value}s are the same as those permissible +in the @b{create} widget command when the item(s) were created; +see the sections describing individual item types below for details +on the legal options. +@item @i{pathName }@b{:lower }@i{tagOrId }@r{?}@i{belowThis}? +Move all of the items given by @i{tagOrId} to a new position +in the display list just before the item given by @i{belowThis}. +If @i{tagOrId} refers to more than one item then all are moved +but the relative order of the moved items will not be changed. +@i{BelowThis} is a tag or id; if it refers to more than one +item then the first (lowest) of these items in the display list is used +as the destination location for the moved items. +This command returns an empty string. +@item @i{pathName }@b{:move }@i{tagOrId xAmount yAmount} +Move each of the items given by @i{tagOrId} in the canvas coordinate +space by adding @i{xAmount} to the x-coordinate of each point +associated with the item and @i{yAmount} to the y-coordinate of +each point associated with the item. +This command returns an empty string. +@item @i{pathName }@b{:postscript }@r{?}@i{option value option value ...}? +Generate a Postscript representation for part or all of the canvas. +If the @b{:file} option is specified then the Postscript is written +to a file and an empty string is returned; otherwise the Postscript +is returned as the result of the command. +The Postscript is created in Encapsulated Postscript form using +version 3.0 of the Document Structuring Conventions. +The @i{option}\-@i{value} argument pairs provide additional +information to control the generation of Postscript. The following +options are supported: + +@table @asis +@item @b{:colormap }@i{varName} +@i{VarName} must be the name of a global array variable +that specifies a color mapping to use in the Postscript. +Each element of @i{varName} must consist of Postscript +code to set a particular color value (e.g. ``@b{1.0 1.0 0.0 setrgbcolor}''). +When outputting color information in the Postscript, Tk checks +to see if there is an element of @i{varName} with the same +name as the color. +If so, Tk uses the value of the element as the Postscript command +to set the color. +If this option hasn't been specified, or if there isn't an entry +in @i{varName} for a given color, then Tk uses the red, green, +and blue intensities from the X color. +@item @b{:colormode }@i{mode} +Specifies how to output color information. @i{Mode} must be either +@b{color}@r{ (for full color output), }@b{gray} (convert all colors +to their gray-scale equivalents) or @b{mono} (convert all colors +to black or white). +@item @b{:file }@i{fileName} +Specifies the name of the file in which to write the Postscript. +If this option isn't specified then the Postscript is returned as the +result of the command instead of being written to a file. +@item @b{:fontmap }@i{varName} +@i{VarName} must be the name of a global array variable +that specifies a font mapping to use in the Postscript. +Each element of @i{varName} must consist of a Tcl list with +two elements, which are the name and point size of a Postscript font. +When outputting Postscript commands for a particular font, Tk +checks to see if @i{varName} contains an element with the same +name as the font. +If there is such an element, then the font information contained in +that element is used in the Postscript. +Otherwise Tk attempts to guess what Postscript font to use. +Tk's guesses generally only work for well-known fonts such as +Times and Helvetica and Courier, and only if the X font name does not +omit any dashes up through the point size. +For example, \fB\-*\-Courier\-Bold\-R\-Normal\-\-*\-120\-* will work but +\fB*Courier\-Bold\-R\-Normal*120* will not; Tk needs the dashes to +parse the font name). +@item @b{:height }@i{size} +Specifies the height of the area of the canvas to print. +Defaults to the height of the canvas window. +@item @b{:pageanchor }@i{anchor} +Specifies which point of the printed area should be appear over +the positioning point on the page (which is given by the @b{:pagex} +and @b{:pagey} options). +For example, @b{:pageanchor n} means that the top center of the +printed area should be over the positioning point. +Defaults to @b{center}. +@item @b{:pageheight }@i{size} +Specifies that the Postscript should be scaled in both x and y so +that the printed area is @i{size} high on the Postscript page. +@i{Size} consists of a floating-point number followed by +@b{c}@r{ for centimeters, }@b{i}@r{ for inches, }@b{m} for millimeters, +or @b{p} or nothing for printer's points (1/72 inch). +Defaults to the height of the printed area on the screen. +If both @b{:pageheight}@r{ and }@b{:pagewidth} are specified then +the scale factor from the later option is used (non-uniform scaling +is not implemented). +@item @b{:pagewidth }@i{size} +Specifies that the Postscript should be scaled in both x and y so +that the printed area is @i{size} wide on the Postscript page. +@i{Size}@r{ has the same form as for }@b{:pageheight}. +Defaults to the width of the printed area on the screen. +If both @b{:pageheight}@r{ and }@b{:pagewidth} are specified then +the scale factor from the later option is used (non-uniform scaling +is not implemented). +@item @b{:pagex }@i{position} +@i{Position} gives the x-coordinate of the positioning point on +the Postscript page, using any of the forms allowed for @b{:pageheight}. +Used in conjunction with the @b{:pagey}@r{ and }@b{:pageanchor} options +to determine where the printed area appears on the Postscript page. +Defaults to the center of the page. +@item @b{:pagey }@i{position} +@i{Position} gives the y-coordinate of the positioning point on +the Postscript page, using any of the forms allowed for @b{:pageheight}. +Used in conjunction with the @b{:pagex}@r{ and }@b{:pageanchor} options +to determine where the printed area appears on the Postscript page. +Defaults to the center of the page. +@item @b{:rotate }@i{boolean} +@i{Boolean} specifies whether the printed area is to be rotated 90 +degrees. +In non-rotated output the x-axis of the printed area runs along +the short dimension of the page (``portrait'' orientation); +in rotated output the x-axis runs along the long dimension of the +page (``landscape'' orientation). +Defaults to non-rotated. +@item @b{:width }@i{size} +Specifies the width of the area of the canvas to print. +Defaults to the width of the canvas window. +@item @b{:x }@i{position} +Specifies the x-coordinate of the left edge of the area of the +canvas that is to be printed, in canvas coordinates, not window +coordinates. +Defaults to the coordinate of the left edge of the window. +@item @b{:y }@i{position} +Specifies the y-coordinate of the top edge of the area of the +canvas that is to be printed, in canvas coordinates, not window +coordinates. +Defaults to the coordinate of the top edge of the window. +@end table + +@item @i{pathName }@b{:raise }@i{tagOrId }@r{?}@i{aboveThis}? +Move all of the items given by @i{tagOrId} to a new position +in the display list just after the item given by @i{aboveThis}. +If @i{tagOrId} refers to more than one item then all are moved +but the relative order of the moved items will not be changed. +@i{AboveThis} is a tag or id; if it refers to more than one +item then the last (topmost) of these items in the display list is used +as the destination location for the moved items. +This command returns an empty string. +@item @i{pathName }@b{:scale }@i{tagOrId xOrigin yOrigin xScale yScale} +Rescale all of the items given by @i{tagOrId} in canvas coordinate +space. +@i{XOrigin}@r{ and }@i{yOrigin} identify the origin for the scaling +operation and @i{xScale}@r{ and }@i{yScale} identify the scale +factors for x- and y-coordinates, respectively (a scale factor of +1.0 implies no change to that coordinate). +For each of the points defining each item, the x-coordinate is +adjusted to change the distance from @i{xOrigin} by a factor +of @i{xScale}. +Similarly, each y-coordinate is adjusted to change the distance +from @i{yOrigin}@r{ by a factor of }@i{yScale}. +This command returns an empty string. +@item @i{pathName }@b{:scan}@r{ }@i{option args} +This command is used to implement scanning on canvases. It has +two forms, depending on @i{option}: + +@table @asis +@item @i{pathName }@b{:scan :mark }@i{x y} +Records @i{x}@r{ and }@i{y} and the canvas's current view; used +in conjunction with later @b{scan dragto} commands. +Typically this command is associated with a mouse button press in +the widget and @i{x}@r{ and }@i{y} are the coordinates of the +mouse. It returns an empty string. +@item @i{pathName }@b{:scan :dragto }@i{x y}. +This command computes the difference between its @i{x}@r{ and }@i{y} +arguments (which are typically mouse coordinates) and the @i{x} and +@i{y}@r{ arguments to the last }@b{scan mark} command for the widget. +It then adjusts the view by 10 times the +difference in coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the canvas at high speed through its window. The return +value is an empty string. +@end table + +@item @i{pathName }@b{:select }@i{option}@r{ ?}@i{tagOrId arg}? +Manipulates the selection in one of several ways, depending on +@i{option}. +The command may take any of the forms described below. +In all of the descriptions below, @i{tagOrId} must refer to +an item that supports indexing and selection; if it refers to +multiple items then the first of +these that supports indexing and the selection is used. +@i{Index} gives a textual description of a position +within @i{tagOrId}, as described in INDICES above. + +@table @asis +@item @i{pathName }@b{:select :adjust }@i{tagOrId index} +Locate the end of the selection in @i{tagOrId} nearest +to the character given by @i{index}, and adjust that +end of the selection to be at @i{index} (i.e. including +but not going beyond @i{index}). +The other end of the selection is made the anchor point +for future @b{select to} commands. +If the selection isn't currently in @i{tagOrId} then +this command behaves the same as the @b{select to} widget +command. +Returns an empty string. +@item @i{pathName }@b{:select :clear} +Clear the selection if it is in this widget. +If the selection isn't in this widget then the command +has no effect. +Returns an empty string. +@item @i{pathName }@b{:select :from }@i{tagOrId index} +Set the selection anchor point for the widget to be just +before the character +given by @i{index}@r{ in the item given by }@i{tagOrId}. +This command doesn't change the selection; it just sets +the fixed end of the selection for future @b{select to} +commands. +Returns an empty string. +@item @i{pathName }@b{:select :item} +Returns the id of the selected item, if the selection is in an +item in this canvas. +If the selection is not in this canvas then an empty string +is returned. +@item @i{pathName }@b{:select :to }@i{tagOrId index} +Set the selection to consist of those characters of @i{tagOrId} +between the selection anchor point and +@i{index}. +The new selection will include the character given by @i{index}; +it will include the character given by the anchor point only if +@i{index} is greater than or equal to the anchor point. +The anchor point is determined by the most recent @b{select adjust} +or @b{select from} command for this widget. +If the selection anchor point for the widget isn't currently in +@i{tagOrId}, then it is set to the same character given +by @i{index}. +Returns an empty string. +@end table + +@item @i{pathName }@b{:type}@i{ tagOrId} +Returns the type of the item given by @i{tagOrId}, such as +@b{rectangle}@r{ or }@b{text}. +If @i{tagOrId} refers to more than one item, then the type +of the first item in the display list is returned. +If @i{tagOrId} doesn't refer to any items at all then +an empty string is returned. +@item @i{pathName }@b{:xview}@i{ index} +Change the view in the canvas so that the canvas position given by +@i{index} appears at the left edge of the window. +This command is typically used by scrollbars to scroll the +canvas. +@i{Index} counts in units of scroll increments (the value of the +@b{scrollIncrement} option): a value of 0 corresponds to the left +edge of the scroll region (as defined by the @b{scrollRegion} +option), a value of 1 means one scroll unit to the right of this, +and so on. The return value is an empty string. +@item @i{pathName }@b{:yview}@i{ index} +Change the view in the canvas so that the canvas position given by +@i{index} appears at the top edge of the window. +This command is typically used by scrollbars to scroll the +canvas. +@i{Index} counts in units of scroll increments (the value of the +@b{scrollIncrement} option): a value of 0 corresponds to the top +edge of the scroll region (as defined by the @b{scrollRegion} +option), a value of 1 means one scroll unit below this, +and so on. The return value is an empty string. + +@end table +@unnumberedsubsec Overview Of Item Types + +The sections below describe the various types of items supported +by canvas widgets. Each item type is characterized by two things: +first, the form of the @b{create} command used to create +instances of the type; and second, a set of configuration options +for items of that type, which may be used in the +@b{create}@r{ and }@b{itemconfigure} widget commands. +Most items don't support indexing or selection or the commands +related to them, such as @b{index}@r{ and }@b{insert}. +Where items do support these facilities, it is noted explicitly +in the descriptions below (at present, only text items provide +this support). + +@unnumberedsubsec Arc Items + +Items of type @b{arc} appear on the display as arc-shaped regions. +An arc is a section of an oval delimited by two angles (specified +by the @b{:start}@r{ and }@b{:extent} options) and displayed in +one of several ways (specified by the @b{:style} option). +Arcs are created with widget commands of the following form: + +@table @asis +@item @i{pathName }@b{:create arc }@i{x1 y1 x2 y2 }@r{?}@i{option value option value ...}? +The arguments @i{x1}@r{, }@i{y1}@r{, }@i{x2}@r{, and }@i{y2} give +the coordinates of two diagonally opposite corners of a +rectangular region enclosing the oval that defines the arc. +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for arcs: + +@table @asis +@item @b{:extent }@i{degrees} +Specifies the size of the angular range occupied by the arc. +The arc's range extends for @i{degrees} degrees counter-clockwise +from the starting angle given by the @b{:start} option. +@i{Degrees} may be negative. +@item @b{:fill }@i{color} +Fill the region of the arc with @i{color}. +@i{Color}@r{ may have any of the forms accepted by }@b{Tk_GetColor}. +If @i{color} is an empty string (the default), then +then the arc will not be filled. +@item @b{:outline }@i{color} +@i{Color} specifies a color to use for drawing the arc's +outline; it may have any of the forms accepted by @b{Tk_GetColor}. +This option defaults to @b{black}. If the arc's style is +@b{arc} then this option is ignored (the section of perimeter is +filled using the @b{:fill}@r{ option). If }@i{color} is specified +as an empty string then no outline is drawn for the arc. +@item @b{:start }@i{degrees} +Specifies the beginning of the angular range occupied by the +arc. +@i{Degrees} is given in units of degrees measured counter-clockwise +from the 3-o'clock position; it may be either positive or negative. +@item @b{:stipple }@i{bitmap} +Indicates that the arc should be filled in a stipple pattern; +@i{bitmap} specifies the stipple pattern to use, in any of the +forms accepted by @b{Tk_GetBitmap}. +If the @b{:fill} option hasn't been specified then this option +has no effect. +If @i{bitmap} is an empty string (the default), then filling is done +in a solid fashion. +@item @b{:style }@i{type} +Specifies how to draw the arc. If @i{type}@r{ is }@b{pieslice} +(the default) then the arc's region is defined by a section +of the oval's perimeter plus two line segments, one between the center +of the oval and each end of the perimeter section. +If @i{type}@r{ is }@b{chord} then the arc's region is defined +by a section of the oval's perimeter plus a single line segment +connecting the two end points of the perimeter section. +If @i{type}@r{ is }@b{arc} then the arc's region consists of +a section of the perimeter alone. In this last case there is +no outline for the arc and the @b{:outline} option is ignored. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@item @b{:width }@i{outlineWidth} +Specifies the width of the outline to be drawn around +the arc's region, in any of the forms described in the COORDINATES +section above. +If the @b{:outline} option has been specified as an empty string +then this option has no effect. +Wide outlines will be drawn centered on the edges of the arc's region. +This option defaults to 1.0. +@end table +@end table + +@unnumberedsubsec Bitmap Items + +Items of type @b{bitmap} appear on the display as images with +two colors, foreground and background. +Bitmaps are created with widget commands of the following form: + +@table @asis +@item @i{pathName }@b{:create bitmap }@i{x y }@r{?}@i{option value option value ...}? +The arguments @i{x}@r{ and }@i{y} specify the coordinates of a +point used to position the bitmap on the display (see the @b{:anchor} +option below for more information on how bitmaps are displayed). +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for bitmaps: + +@table @asis +@item @b{:anchor }@i{anchorPos} +@i{AnchorPos} tells how to position the bitmap relative to the +positioning point for the item; it may have any of the forms +accepted by @b{Tk_GetAnchor}@r{. For example, if }@i{anchorPos} +is @b{center} then the bitmap is centered on the point; if +@i{anchorPos}@r{ is }@b{n} then the bitmap will be drawn so that +its top center point is at the positioning point. +This option defaults to @b{center}. +@item @b{:background }@i{color} +Specifies a color to use for each of the bitmap pixels +whose value is 0. +@i{Color}@r{ may have any of the forms accepted by }@b{Tk_GetColor}. +If this option isn't specified, or if it is specified as an empty +string, then the background color for the canvas is used. +@item @b{:bitmap }@i{bitmap} +Specifies the bitmap to display in the item. +@i{Bitmap}@r{ may have any of the forms accepted by }@b{Tk_GetBitmap}. +@item @b{:foreground }@i{color} +Specifies a color to use for each of the bitmap pixels +whose value is 1. +@i{Color}@r{ may have any of the forms accepted by }@b{Tk_GetColor} and +defaults to @b{black}. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@end table +@end table +@unnumberedsubsec Line Items + +Items of type @b{line} appear on the display as one or more connected +line segments or curves. +Lines are created with widget commands of the following form: + +@table @asis +@item @i{pathName }@b{:create line }@i{x1 y1... xn yn }@r{?}@i{option value option value ...}? + +The arguments @i{x1}@r{ through }@i{yn} give +the coordinates for a series of two or more points that describe +a series of connected line segments. +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for lines: + +@table @asis +@item @b{:arrow }@i{where} +Indicates whether or not arrowheads are to be drawn at one or both +ends of the line. +@i{Where}@r{ must have one of the values }@b{none} (for no arrowheads), +@b{first} (for an arrowhead at the first point of the line), +@b{last} (for an arrowhead at the last point of the line), or +@b{both} (for arrowheads at both ends). +This option defaults to @b{none}. +@item @b{:arrowshape }@i{shape} +This option indicates how to draw arrowheads. +The @i{shape} argument must be a list with three elements, each +specifying a distance in any of the forms described in +the COORDINATES section above. +The first element of the list gives the distance along the line +from the neck of the arrowhead to its tip. +The second element gives the distance along the line from the +trailing points of the arrowhead to the tip, and the third +element gives the distance from the outside edge of the line to the +trailing points. +If this option isn't specified then Tk picks a ``reasonable'' shape. +@item @b{:capstyle }@i{style} +Specifies the ways in which caps are to be drawn at the endpoints +of the line. +@i{Style}@r{ may have any of the forms accepted by }@b{Tk_GetCapStyle} +(@b{butt}@r{, }@b{projecting}@r{, or }@b{round}). +If this option isn't specified then it defaults to @b{butt}. +Where arrowheads are drawn the cap style is ignored. +@item @b{:fill }@i{color} +@i{Color} specifies a color to use for drawing the line; it may have +any of the forms acceptable to @b{Tk_GetColor}. It may also be an +empty string, in which case the line will be transparent. +This option defaults to @b{black}. +@item @b{:joinstyle }@i{style} +Specifies the ways in which joints are to be drawn at the vertices +of the line. +@i{Style}@r{ may have any of the forms accepted by }@b{Tk_GetCapStyle} +(@b{bevel}@r{, }@b{miter}@r{, or }@b{round}). +If this option isn't specified then it defaults to @b{miter}. +If the line only contains two points then this option is +irrelevant. +@item @b{:smooth }@i{boolean} +@i{Boolean}@r{ must have one of the forms accepted by }@b{Tk_GetBoolean}. +It indicates whether or not the line should be drawn as a curve. +If so, the line is rendered as a set of Bezier splines: one spline +is drawn for the first and second line segments, one for the second +and third, and so on. Straight-line segments can be generated within +a curve by duplicating the end-points of the desired line segment. +@item @b{:splinesteps }@i{number} +Specifies the degree of smoothness desired for curves: each spline +will be approximated with @i{number} line segments. This +option is ignored unless the @b{:smooth} option is true. +@item @b{:stipple }@i{bitmap} +Indicates that the line should be filled in a stipple pattern; +@i{bitmap} specifies the stipple pattern to use, in any of the +forms accepted by @b{Tk_GetBitmap}. +If @i{bitmap} is an empty string (the default), then filling is +done in a solid fashion. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@item @b{:width }@i{lineWidth} +@i{LineWidth} specifies the width of the line, in any of the forms +described in the COORDINATES section above. +Wide lines will be drawn centered on the path specified by the +points. +If this option isn't specified then it defaults to 1.0. +@end table +@end table +@unnumberedsubsec Oval Items + +Items of type @b{oval} appear as circular or oval regions on +the display. Each oval may have an outline, a fill, or +both. Ovals are created with widget commands of the +following form: + +@table @asis +@item @i{pathName }@b{:create oval }@i{x1 y1 x2 y2 }@r{?}@i{option value option value ...}? + +The arguments @i{x1}@r{, }@i{y1}@r{, }@i{x2}@r{, and }@i{y2} give +the coordinates of two diagonally opposite corners of a +rectangular region enclosing the oval. +The oval will include the top and left edges of the rectangle +not the lower or right edges. +If the region is square then the resulting oval is circular; +otherwise it is elongated in shape. +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for ovals: + +@table @asis +@item @b{:fill }@i{color} +Fill the area of the oval with @i{color}. +@i{Color}@r{ may have any of the forms accepted by }@b{Tk_GetColor}. +If @i{color} is an empty string (the default), then +then the oval will not be filled. +@item @b{:outline }@i{color} +@i{Color} specifies a color to use for drawing the oval's +outline; it may have any of the forms accepted by @b{Tk_GetColor}. +This option defaults to @b{black}. +If @i{color} is an empty string then no outline will be +drawn for the oval. +@item @b{:stipple }@i{bitmap} +Indicates that the oval should be filled in a stipple pattern; +@i{bitmap} specifies the stipple pattern to use, in any of the +forms accepted by @b{Tk_GetBitmap}. +If the @b{:fill} option hasn't been specified then this option +has no effect. +If @i{bitmap} is an empty string (the default), then filling is done +in a solid fashion. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@item @b{:width }@i{outlineWidth} +@i{outlineWidth} specifies the width of the outline to be drawn around +the oval, in any of the forms described in the COORDINATES section above. +If the @b{:outline} option hasn't been specified then this option +has no effect. +Wide outlines are drawn centered on the oval path defined by +@i{x1}@r{, }@i{y1}@r{, }@i{x2}@r{, and }@i{y2}. +This option defaults to 1.0. +@end table +@end table +@unnumberedsubsec Polygon Items + +Items of type @b{polygon} appear as polygonal or curved filled regions +on the display. +Polygons are created with widget commands of the following form: + +@table @asis +@item @i{pathName }@b{:create polygon }@i{x1 y1 ... xn yn }@r{?}@i{option value option value ...}? + + +The arguments @i{x1}@r{ through }@i{yn} specify the coordinates for +three or more points that define a closed polygon. +The first and last points may be the same; whether they are or not, +Tk will draw the polygon as a closed polygon. +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for polygons: + +@table @asis +@item @b{:fill }@i{color} +@i{Color} specifies a color to use for filling the area of the +polygon; it may have any of the forms acceptable to @b{Tk_GetColor}. +If @i{color} is an empty string then the polygon will be +transparent. +This option defaults to @b{black}. +@item @b{:smooth }@i{boolean} +@i{Boolean}@r{ must have one of the forms accepted by }@b{Tk_GetBoolean} +It indicates whether or not the polygon should be drawn with a +curved perimeter. +If so, the outline of the polygon becomes a set of Bezier splines, +one spline for the first and second line segments, one for the second +and third, and so on. Straight-line segments can be generated in a +smoothed polygon by duplicating the end-points of the desired line segment. +@item @b{:splinesteps }@i{number} +Specifies the degree of smoothness desired for curves: each spline +will be approximated with @i{number} line segments. This +option is ignored unless the @b{:smooth} option is true. +@item @b{:stipple }@i{bitmap} +Indicates that the polygon should be filled in a stipple pattern; +@i{bitmap} specifies the stipple pattern to use, in any of the +forms accepted by @b{Tk_GetBitmap}. +If @i{bitmap} is an empty string (the default), then filling is +done in a solid fashion. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@end table +@end table + +@unnumberedsubsec Rectangle Items + +Items of type @b{rectangle} appear as rectangular regions on +the display. Each rectangle may have an outline, a fill, or +both. Rectangles are created with widget commands of the +following form: + +@table @asis +@item @i{pathName }@b{:create rectangle }@i{x1 y1 x2 y2 }@r{?}@i{option value option value ...}? + +The arguments @i{x1}@r{, }@i{y1}@r{, }@i{x2}@r{, and }@i{y2} give +the coordinates of two diagonally opposite corners of the rectangle +(the rectangle will include its upper and left edges but not +its lower or right edges). +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for rectangles: + +@table @asis +@item @b{:fill }@i{color} +Fill the area of the rectangle with @i{color}, which may be +specified in any of the forms accepted by @b{Tk_GetColor}. +If @i{color} is an empty string (the default), then +then the rectangle will not be filled. +@item @b{:outline }@i{color} +Draw an outline around the edge of the rectangle in @i{color}. +@i{Color}@r{ may have any of the forms accepted by }@b{Tk_GetColor}. +This option defaults to @b{black}. +If @i{color} is an empty string then no outline will be +drawn for the rectangle. +@item @b{:stipple }@i{bitmap} +Indicates that the rectangle should be filled in a stipple pattern; +@i{bitmap} specifies the stipple pattern to use, in any of the +forms accepted by @b{Tk_GetBitmap}. +If the @b{:fill} option hasn't been specified then this option +has no effect. +If @i{bitmap} is an empty string (the default), then filling +is done in a solid fashion. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@item @b{:width }@i{outlineWidth} +@i{OutlineWidth} specifies the width of the outline to be drawn around +the rectangle, in any of the forms described in the COORDINATES section above. +If the @b{:outline} option hasn't been specified then this option +has no effect. +Wide outlines are drawn centered on the rectangular path +defined by @i{x1}@r{, }@i{y1}@r{, }@i{x2}@r{, and }@i{y2}. +This option defaults to 1.0. +@end table +@end table +@unnumberedsubsec Text Items + +A text item displays a string of characters on the screen in one +or more lines. +Text items support indexing and selection, along with the +following text-related canvas widget commands: @b{dchars}, +@b{focus}@r{, }@b{icursor}@r{, }@b{index}@r{, }@b{insert}, +@b{select}. +Text items are created with widget commands of the following +form: + +@table @asis +@item @i{pathName }@b{:create text }@i{x y }@r{?}@i{option value option value ...}? + +The arguments @i{x}@r{ and }@i{y} specify the coordinates of a +point used to position the text on the display (see the options +below for more information on how text is displayed). +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for text items: + +@table @asis +@item @b{:anchor }@i{anchorPos} +@i{AnchorPos} tells how to position the text relative to the +positioning point for the text; it may have any of the forms +accepted by @b{Tk_GetAnchor}@r{. For example, if }@i{anchorPos} +is @b{center} then the text is centered on the point; if +@i{anchorPos}@r{ is }@b{n} then the text will be drawn such that +the top center point of the rectangular region occupied by the +text will be at the positioning point. +This option defaults to @b{center}. +@item @b{:fill }@i{color} +@i{Color} specifies a color to use for filling the text characters; +it may have any of the forms accepted by @b{Tk_GetColor}. +If this option isn't specified then it defaults to @b{black}. +@item @b{:font }@i{fontName} +Specifies the font to use for the text item. +@i{FontName}@r{ may be any string acceptable to }@b{Tk_GetFontStruct}. +If this option isn't specified, it defaults to a system-dependent +font. +@item @b{:justify }@i{how} +Specifies how to justify the text within its bounding region. +@i{How}@r{ must be one of the values }@b{left}@r{, }@b{right}, +or @b{center}. +This option will only matter if the text is displayed as multiple +lines. +If the option is omitted, it defaults to @b{left}. +@item @b{:stipple }@i{bitmap} +Indicates that the text should be drawn in a stippled pattern +rather than solid; +@i{bitmap} specifies the stipple pattern to use, in any of the +forms accepted by @b{Tk_GetBitmap}. +If @i{bitmap} is an empty string (the default) then the text +is drawn in a solid fashion. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@item @b{:text }@i{string} +@i{String} specifies the characters to be displayed in the text item. +Newline characters cause line breaks. +The characters in the item may also be changed with the +@b{insert}@r{ and }@b{delete} widget commands. +This option defaults to an empty string. +@item @b{:width }@i{lineLength} +Specifies a maximum line length for the text, in any of the forms +described in the COORDINATES section abov. +If this option is zero (the default) the text is broken into +lines only at newline characters. +However, if this option is non-zero then any line that would +be longer than @i{lineLength} is broken just before a space +character to make the line shorter than @i{lineLength}; the +space character is treated as if it were a newline +character. + +@end table +@end table +@unnumberedsubsec Window Items + +Items of type @b{window} cause a particular window to be displayed +at a given position on the canvas. +Window items are created with widget commands of the following form: + +@example +@i{pathName }@b{:create window }@i{x y }@r{?}@i{option value option value ...}? +@end example + +The arguments @i{x}@r{ and }@i{y} specify the coordinates of a +point used to position the window on the display (see the @b{:anchor} +option below for more information on how bitmaps are displayed). +After the coordinates there may be any number of @i{option}@r{-}@i{value} +pairs, each of which sets one of the configuration options +for the item. These same @i{option}\-@i{value} pairs may be +used in @b{itemconfigure} widget commands to change the item's +configuration. +The following options are supported for window items: + +@table @asis +@item @b{:anchor }@i{anchorPos} +@i{AnchorPos} tells how to position the window relative to the +positioning point for the item; it may have any of the forms +accepted by @b{Tk_GetAnchor}@r{. For example, if }@i{anchorPos} +is @b{center} then the window is centered on the point; if +@i{anchorPos}@r{ is }@b{n} then the window will be drawn so that +its top center point is at the positioning point. +This option defaults to @b{center}. +@item @b{:height }@i{pixels} +Specifies the height to assign to the item's window. +@i{Pixels} may have any of the +forms described in the COORDINATES section above. +If this option isn't specified, or if it is specified as an empty +string, then the window is given whatever height it requests internally. +@item @b{:tags }@i{tagList} +Specifies a set of tags to apply to the item. +@i{TagList} consists of a list of tag names, which replace any +existing tags for the item. +@i{TagList} may be an empty list. +@item @b{:width }@i{pixels} +Specifies the width to assign to the item's window. +@i{Pixels} may have any of the +forms described in the COORDINATES section above. +If this option isn't specified, or if it is specified as an empty +string, then the window is given whatever width it requests internally. +@item @b{:window }@i{pathName} +Specifies the window to associate with this item. +The window specified by @i{pathName} must either be a child of +the canvas widget or a child of some ancestor of the canvas widget. +@i{PathName} may not refer to a top-level window. + +@end table +@unnumberedsubsec Application-Defined Item Types + +It is possible for individual applications to define new item +types for canvas widgets using C code. +The interfaces for this mechanism are not presently documented, +and it's possible they may change, but you should be able to +see how they work by examining the code for some of the existing +item types. + +@unnumberedsubsec Bindings + +In the current implementation, new canvases are not given any +default behavior: you'll have to execute explicit Tcl commands +to give the canvas its behavior. + +@unnumberedsubsec Credits + +Tk's canvas widget is a blatant ripoff of ideas from Joel Bartlett's +@i{ezd}@r{ program. }@i{Ezd} provides structured graphics in a Scheme +environment and preceded canvases by a year or two. Its simple +mechanisms for placing and animating graphical objects inspired the +functions of canvases. + +@unnumberedsubsec Keywords +canvas, widget +@node menu, scrollbar, canvas, Widgets +@section menu +@c @cartouche + +menu \- Create and manipulate menu widgets +@unnumberedsubsec Synopsis +@b{menu}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +activeBackground background disabledForeground +activeBorderWidth borderWidth font +activeForeground cursor foreground +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Menu + + +@table @asis +@item @code{@b{:postcommand}} +@flushright +Name=@code{"@b{postCommand}@r{"} Class=@code{"}@b{Command}"} +@end flushright +@sp 1 + +If this option is specified then it provides a Tcl command to execute +each time the menu is posted. The command is invoked by the @b{post} +widget command before posting the menu. +@end table + + +@table @asis +@item @code{@b{:selector}} +@flushright +Name=@code{"@b{selector}@r{"} Class=@code{"}@b{Foreground}"} +@end flushright +@sp 1 + +For menu entries that are check buttons or radio buttons, this option +specifies the color to display in the selector when the check button +or radio button is selected. +@end table +@c @end cartouche + +@unnumberedsubsec Introduction + +The @b{menu} command creates a new top-level window (given +by the @i{pathName} argument) and makes it into a menu widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the menu such as its colors and font. +The @b{menu} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A menu is a widget that displays a collection of one-line entries arranged +in a column. There exist several different types of entries, +each with different properties. Entries of different types may be +combined in a single menu. Menu entries are not the same as +entry widgets. In fact, menu entries are not even distinct widgets; +the entire menu is one widget. + +Menu entries are displayed with up to three +separate fields. The main field is a label in the form of text or +a bitmap, which is determined by the @b{:label}@r{ or }@b{:bitmap} +option for the entry. +If the @b{:accelerator} option is specified for an entry then a second +textual field is displayed to the right of the label. The accelerator +typically describes a keystroke sequence that may be typed in the +application to cause the same result as invoking the menu entry. +The third field is a @i{selector}. The selector is present only for +check-button or radio-button entries. It indicates whether the entry +is selected or not, and is displayed to the left of the entry's +string. + +In normal use, an entry becomes active (displays itself differently) +whenever the mouse pointer is over the entry. If a mouse +button is released over the entry then the entry is @i{invoked}. +The effect of invocation is different for each type of entry; +these effects are described below in the sections on individual +entries. + +Entries may be @i{disabled}, which causes their labels +and accelerators to be displayed +with dimmer colors. A disabled entry cannot be activated or invoked. +Disabled entries may be re-enabled, at which point it becomes +possible to activate and invoke them again. + +@unnumberedsubsec Command Entries + +The most common kind of menu entry is a command entry, which +behaves much like a button widget. When a command entry is +invoked, a Tcl command is executed. The Tcl +command is specified with the @b{:command} option. + +@unnumberedsubsec Separator Entries + +A separator is an entry that is displayed as a horizontal dividing +line. A separator may not be activated or invoked, and it has +no behavior other than its display appearance. + +@unnumberedsubsec Check-Button Entries + +A check-button menu entry behaves much like a check-button widget. +When it is invoked it toggles back and forth between the selected +and deselected states. When the entry is selected, a particular +value is stored in a particular global variable (as determined by +the @b{:onvalue}@r{ and }@b{:variable} options for the entry); when +the entry is deselected another value (determined by the +@b{:offvalue} option) is stored in the global variable. +A selector box is displayed to the left of the label in a check-button +entry. If the entry is selected then the box's center is displayed +in the color given by the @b{selector} option for the menu; +otherwise the box's center is displayed in the background color for +the menu. If a @b{:command} option is specified for a check-button +entry, then its value is evaluated as a Tcl command each time the entry +is invoked; this happens after toggling the entry's +selected state. + +@unnumberedsubsec Radio-Button Entries + +A radio-button menu entry behaves much like a radio-button widget. +Radio-button entries are organized in groups of which only one +entry may be selected at a time. Whenever a particular entry +becomes selected it stores a particular value into a particular +global variable (as determined by the @b{:value} and +@b{:variable} options for the entry). This action +causes any previously-selected entry in the same group +to deselect itself. +Once an entry has become selected, any change to the entry's +associated variable will cause the entry to deselect itself. +Grouping of radio-button entries is determined by their +associated variables: if two entries have the same associated +variable then they are in the same group. +A selector diamond is displayed to the left of the label in each +radio-button entry. If the entry is selected then the diamond's +center is displayed in the color given by the @b{selector} option +for the menu; +otherwise the diamond's center is displayed in the background color for +the menu. If a @b{:command} option is specified for a radio-button +entry, then its value is evaluated as a Tcl command each time the entry +is invoked; this happens after selecting the entry. + +@unnumberedsubsec Cascade Entries + +A cascade entry is one with an associated menu (determined +by the @b{:menu} option). Cascade entries allow the construction +of cascading menus. When the entry is activated, the +associated menu is posted just to the right of the entry; +that menu remains posted until the higher-level menu is unposted or +until some other entry is activated in the higher-level menu. +The associated menu should normally be a child of the menu containing +the cascade entry, in order for menu traversal to work correctly. + +A cascade entry posts its associated menu by invoking a +Tcl command of the form + +@table @asis +@item @i{menu}@b{ :post }@i{x y} + + + +where @i{menu}@r{ is the path name of the associated menu, }@i{x} +and @i{y} are the root-window coordinates of the upper-right +corner of the cascade entry, and @i{group} is the name of the +menu's group (as determined in its last @b{post} widget command). +The lower-level menu is unposted by executing a Tcl command with +the form + +@item @i{menu}@b{:unpost} +where @i{menu} is the name of the associated menu. +@end table + +If a @b{:command} option is specified for a cascade entry then it is +evaluated as a Tcl command each time the associated menu is posted (the +evaluation occurs before the menu is posted). + +@unnumberedsubsec A Menu Widget's Arguments + +The @b{menu} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@table @asis +@item @i{pathName option }@r{?}@i{arg arg ...}? +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. +@end table + +Many of the widget commands for a menu take as one argument an +indicator of which entry of the menu to operate on. These +indicators are called @i{index}es and may be specified in +any of the following forms: + +@table @asis +@item @i{number} +Specifies the entry numerically, where 0 corresponds +to the top-most entry of the menu, 1 to the entry below it, and +so on. +@item @b{active} +Indicates the entry that is currently active. If no entry is +active then this form is equivalent to @b{none}. This form may +not be abbreviated. +@item @b{last} +Indicates the bottommost entry in the menu. If there are no +entries in the menu then this form is equivalent to @b{none}. +This form may not be abbreviated. +@item @b{none} +Indicates ``no entry at all''; this is used most commonly with +the @b{activate} option to deactivate all the entries in the +menu. In most cases the specification of @b{none} causes +nothing to happen in the widget command. +This form may not be abbreviated. +@item @b{@@}@i{number} +In this form, @i{number} is treated as a y-coordinate in the +menu's window; the entry spanning that y-coordinate is used. +For example, ``@b{@@0}'' indicates the top-most entry in the +window. If @i{number} is outside the range of the window +then this form is equivalent to @b{none}. +@item @i{pattern} +If the index doesn't satisfy one of the above forms then this +form is used. @i{Pattern} is pattern-matched against the label of +each entry in the menu, in order from the top down, until a +matching entry is found. The rules of @b{Tcl_StringMatch} +are used. + +The following widget commands are possible for menu widgets: +@item @i{pathName }@b{:activate }@i{index} +Change the state of the entry indicated by @i{index}@r{ to }@b{active} +and redisplay it using its active colors. +Any previously-active entry is deactivated. If @i{index} +is specified as @b{none}, or if the specified entry is +disabled, then the menu ends up with no active entry. +Returns an empty string. +@item @i{pathName }@b{:add }@i{type }@r{?}@i{option value option value ...}? +Add a new entry to the bottom of the menu. The new entry's type +is given by @i{type}@r{ and must be one of }@b{cascade}, +@b{checkbutton}@r{, }@b{command}@r{, }@b{radiobutton}@r{, or }@b{separator}, +or a unique abbreviation of one of the above. If additional arguments +are present, they specify any of the following options: + +@table @asis +@item @b{:activebackground }@i{value} +Specifies a background color to use for displaying this entry when it +is active. +If this option is specified as an empty string (the default), then the +@b{activeBackground} option for the overall menu is used. +This option is not available for separator entries. +@item @b{:accelerator }@i{value} +Specifies a string to display at the right side of the menu entry. +Normally describes an accelerator keystroke sequence that may be +typed to invoke the same function as the menu entry. This option +is not available for separator entries. +@item @b{:background }@i{value} +Specifies a background color to use for displaying this entry when it +is in the normal state (neither active nor disabled). +If this option is specified as an empty string (the default), then the +@b{background} option for the overall menu is used. +This option is not available for separator entries. +@item @b{:bitmap }@i{value} +Specifies a bitmap to display in the menu instead of a textual +label, in any of the forms accepted by @b{Tk_GetBitmap}. +This option overrides the @b{:label} option but may be reset +to an empty string to enable a textual label to be displayed. +This option is not available for separator entries. +@item @b{:command }@i{value} +For command, checkbutton, and radiobutton entries, specifies a +Tcl command to execute when the menu entry is invoked. +For cascade entries, specifies a Tcl command to execute +when the entry is activated (i.e. just before its submenu is +posted). +Not available for separator entries. +@item @b{:font }@i{value} +Specifies the font to use when drawing the label or accelerator +string in this entry. +If this option is specified as an empty string (the default) then +the @b{font} option for the overall menu is used. +This option is not available for separator entries. +@item @b{:label }@i{value} +Specifies a string to display as an identifying label in the menu +entry. Not available for separator entries. +@item @b{:menu }@i{value} +Available only for cascade entries. Specifies the path name of +the menu associated with this entry. +@item @b{:offvalue }@i{value} +Available only for check-button entries. Specifies the value to +store in the entry's associated variable when the entry is +deselected. +@item @b{:onvalue }@i{value} +Available only for check-button entries. Specifies the value to +store in the entry's associated variable when the entry is selected. +@item @b{:state }@i{value} +Specifies one of three states for the entry: @b{normal}@r{, }@b{active}, +or @b{disabled}. In normal state the entry is displayed using the +@b{foreground}@r{ option for the menu and the }@b{background} +option from the entry or the menu. +The active state is typically used when the pointer is over the entry. +In active state the entry is displayed using the @b{activeForeground} +option for the menu along with the @b{activebackground} option from +the entry. +Disabled state means that the entry is insensitive: it doesn't activate +and doesn't respond to mouse button presses or releases. +In this state the entry is displayed according to the +@b{disabledForeground} option for the menu and the +@b{background} option from the entry. +This option is not available for separator entries. +@item @b{:underline }@i{value} +Specifies the integer index of a character to underline in the entry. +This option is typically used to indicate keyboard traversal characters. +0 corresponds to the first character of the text displayed in the entry, +1 to the next character, and so on. +If a bitmap is displayed in the entry then this option is ignored. +This option is not available for separator entries. +@item @b{:value }@i{value} +Available only for radio-button entries. Specifies the value to +store in the entry's associated variable when the entry is selected. +@item @b{:variable }@i{value} +Available only for check-button and radio-button entries. Specifies +the name of a global value to set when the entry is selected. +For check-button entries the variable is also set when the entry +is deselected. For radio-button entries, changing the variable +causes the currently-selected entry to deselect itself. +@end table +@end table + +The @b{add} widget command returns an empty string. + + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{menu} +command. +@item @i{pathName }@b{:delete }@i{index1}@r{ ?}@i{index2}? +Delete all of the menu entries between @i{index1} and +@i{index2} inclusive. +If @i{index2}@r{ is omitted then it defaults to }@i{index1}. +Returns an empty string. +@item @i{pathName }@b{:disable }@i{index} +Change the state of the entry given by @i{index}@r{ to }@b{disabled} +and redisplay the entry using its disabled colors. +Returns an empty string. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:entryconfigure }@i{index}@r{ :state disabled}'' instead. +@item @i{pathName }@b{:enable }@i{index} +Change the state of the entry given by @i{index}@r{ to }@b{normal} +and redisplay the entry using its normal colors. +Returns an empty string. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:entryconfigure }@i{index}@r{ :state normal}'' instead. +@item @i{pathName }@b{:entryconfigure }@i{index}@r{ }@r{?}@i{options}? +This command is similar to the @b{configure} command, except that +it applies to the options for an individual entry, whereas @b{configure} +applies to the options for the menu as a whole. +@i{Options}@r{ may have any of the values accepted by the }@b{add} +widget command. If @i{options} are specified, options are modified +as indicated +in the command and the command returns an empty string. +If no @i{options} are specified, returns a list describing +the current options for entry @i{index}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). +@item @i{pathName }@b{:index }@i{index} +Returns the numerical index corresponding to @i{index}, or +@b{none}@r{ if }@i{index}@r{ was specified as }@b{none}. +@item @i{pathName }@b{:invoke }@i{index} +Invoke the action of the menu entry. See the sections on the +individual entries above for details on what happens. If the +menu entry is disabled then nothing happens. If the +entry has a command associated with it then the result of that +command is returned as the result of the @b{invoke} widget +command. Otherwise the result is an empty string. Note: invoking +a menu entry does not automatically unpost the menu. Normally +the associated menubutton will take care of unposting the menu. +@item @i{pathName }@b{:post }@i{x y} +Arrange for the menu to be displayed on the screen at the root-window +coordinates given by @i{x}@r{ and }@i{y}. These coordinates are +adjusted if necessary to guarantee that the entire menu is visible on +the screen. This command normally returns an empty string. +If the @b{:postcommand} option has been specified, then its value is +executed as a Tcl script before posting the menu and the result of +that script is returned as the result of the @b{post} widget +command. +If an error returns while executing the command, then the error is +returned without posting the menu. +@item @i{pathName }@b{:unpost} +Unmap the window so that it is no longer displayed. If a +lower-level cascaded menu is posted, unpost that menu. Returns an +empty string. +@item @i{pathName }@b{:yposition }@i{index} +Returns a decimal string giving the y-coordinate within the menu +window of the topmost pixel in the entry specified by @i{index}. + + +@end table +@unnumberedsubsec Default Bindings + + +Tk automatically creates class bindings for menus that give them +the following default behavior: +@itemize @asis{} +@item +[1] +When the mouse cursor enters a menu, the entry underneath the mouse +cursor is activated; as the mouse moves around the menu, the active +entry changes to track the mouse. +@item +[2] +When button 1 is released over a menu, the active entry (if any) is invoked. +@item +[3] +A menu can be repositioned on the screen by dragging it with mouse +button 2. +@item +[4] +A number of other bindings are created to support keyboard menu traversal. +See the manual entry for @b{tk_bindForTraversal} for details on these +bindings. +@end itemize + +Disabled menu entries are non-responsive: they don't activate and +ignore mouse button presses and releases. + +The behavior of menus can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +@unnumberedsubsec Bugs + +At present it isn't possible to use the +option database to specify values for the options to individual +entries. + +@unnumberedsubsec Keywords +menu, widget +@node scrollbar, checkbutton, menu, Widgets +@section scrollbar +@c @cartouche + +scrollbar \- Create and manipulate scrollbar widgets +@unnumberedsubsec Synopsis +@b{scrollbar}@i{ pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +activeForeground cursor relief +background foreground repeatDelay +borderWidth orient repeatInterval +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Scrollbar + + +@table @asis +@item @code{@b{:command}} +@flushright +Name=@code{"@b{command}@r{"} Class=@code{"}@b{Command}"} +@end flushright +@sp 1 + +Specifies the prefix of a Tcl command to invoke to change the view +in the widget associated with the scrollbar. When a user requests +a view change by manipulating the scrollbar, a Tcl command is +invoked. The actual command consists of this option followed by +a space and a number. The number indicates the logical unit that +should appear at the top of the associated window. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies the desired narrow dimension of the scrollbar window, +not including 3-D border, if any. For vertical +scrollbars this will be the width and for horizontal scrollbars +this will be the height. +The value may have any of the forms acceptable to @b{Tk_GetPixels}. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{scrollbar} command creates a new window (given by the +@i{pathName} argument) and makes it into a scrollbar widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the scrollbar such as its colors, orientation, +and relief. The @b{scrollbar} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A scrollbar is a widget that displays two arrows, one at each end of +the scrollbar, and a @i{slider} in the middle portion of the +scrollbar. A scrollbar is used to provide information about what +is visible in an @i{associated window} that displays an object +of some sort (such as a file being edited or a drawing). +The position and size of the slider indicate which portion of the +object is visible in the associated window. For example, if the +slider in a vertical scrollbar covers the top third of the area +between the two arrows, it means that the associated window displays +the top third of its object. + +Scrollbars can be used to adjust the view in the associated window +by clicking or dragging with the mouse. See the BINDINGS section +below for details. + +@unnumberedsubsec A Scrollbar Widget's Arguments + +The @b{scrollbar} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for scrollbar widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{scrollbar} +command. +@item @i{pathName }@b{:get} +Returns a Tcl list containing four decimal values, which are +the current @i{totalUnits}@r{, }@i{widnowUnits}@r{, }@i{firstUnit}, +and @i{lastUnit} values for the scrollbar. These are the values +from the most recent @b{set} widget command on the scrollbar. +@item @i{pathName }@b{:set}@r{ }@i{totalUnits windowUnits firstUnit lastUnit} +This command is invoked to give the scrollbar information about the +widget associated with the scrollbar. @i{TotalUnits} is an integer +value giving the total size of the object being displayed in the +associated widget. The meaning of one unit depends on the associated +widget; for example, in a text editor widget units might +correspond to lines of +text. @i{WindowUnits} indicates the total number of units that +can fit in the associated window at one time. @i{FirstUnit} +and @i{lastUnit} give the indices of the first and last units +currently visible in the associated window (zero corresponds to the +first unit of the object). This command should +be invoked by the associated widget whenever its object or window +changes size and whenever it changes the view in its window. + +@end table +@unnumberedsubsec Bindings + +The description below assumes a vertically-oriented scrollbar. +For a horizontally-oriented scrollbar replace the words ``up'', ``down'', +``top'', and ``bottom'' with ``left'', ``right'', ``left'', +and ``right'', respectively + +A scrollbar widget is divided into five distinct areas. From top +to bottom, they are: the top arrow, the top gap (the empty space +between the arrow and the slider), the slider, the bottom gap, +and the bottom arrow. Pressing mouse button 1 in each area has +a different effect: + +@table @asis +@item @b{top arrow} +Causes the view in the associated window to shift up by one unit +(i.e. the object appears to move down one unit in its window). +If the button is held down the action will auto-repeat. +@item @b{top gap} +Causes the view in the associated window to shift up by one +less than the number of units in the window +(i.e. the portion of the object that used to appear at the very +top of the window will now appear at the very bottom). +If the button is held down the action will auto-repeat. +@item @b{slider} +Pressing button 1 in this area has no immediate effect except to +cause the slider to appear sunken rather than raised. However, +if the mouse is moved with the button down then the slider will +be dragged, adjusting the view as the mouse is moved. +@item @b{bottom gap} +Causes the view in the associated window to shift down by one +less than the number of units in the window +(i.e. the portion of the object that used to appear at the very +bottom of the window will now appear at the very top). +If the button is held down the action will auto-repeat. +@item @b{bottom arrow} +Causes the view in the associated window to shift down by one unit +(i.e. the object appears to move up one unit in its window). +If the button is held down the action will auto-repeat. + +Note: none of the actions described above has an immediate impact +on the position of the slider in the scrollbar. It simply invokes +the command specified in the @b{command} option to notify the +associated widget that a change in view is desired. If the view is +actually changed then the associated widget must invoke the +scrollbar's @b{set} widget command to change what is displayed in +the scrollbar. + +@end table +@unnumberedsubsec Keywords +scrollbar, widget +@node checkbutton, menubutton, scrollbar, Widgets +@section checkbutton +@c @cartouche + +checkbutton \- Create and manipulate check-button widgets +@unnumberedsubsec Synopsis +@b{checkbutton}@i{ pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +activeBackground bitmap font relief +activeForeground borderWidth foreground text +anchor cursor padX textVariable +background disabledForeground padY +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Checkbutton + + +@table @asis +@item @code{@b{:command}} +@flushright +Name=@code{"@b{command}@r{"} Class=@code{"}@b{Command}"} +@end flushright +@sp 1 + +Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is released over the button +window. The button's global variable (@b{:variable} option) will +be updated before the command is invoked. +@end table + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies a desired height for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in lines of text. +If this option isn't specified, the button's desired height is computed +from the size of the bitmap or text being displayed in it. +@end table + + +@table @asis +@item @code{@b{:offvalue}} +@flushright +Name=@code{"@b{offValue}@r{"} Class=@code{"}@b{Value}"} +@end flushright +@sp 1 + +Specifies value to store in the button's associated variable whenever +this button is deselected. Defaults to ``0''. +@end table + + +@table @asis +@item @code{@b{:onvalue}} +@flushright +Name=@code{"@b{onValue}@r{"} Class=@code{"}@b{Value}"} +@end flushright +@sp 1 + +Specifies value to store in the button's associated variable whenever +this button is selected. Defaults to ``1''. +@end table + + +@table @asis +@item @code{@b{:selector}} +@flushright +Name=@code{"@b{selector}@r{"} Class=@code{"}@b{Foreground}"} +@end flushright +@sp 1 + +Specifies the color to draw in the selector when this button is +selected. +If specified as an empty string then no selector is +drawn for the button. +@end table + + +@table @asis +@item @code{@b{:state}} +@flushright +Name=@code{"@b{state}@r{"} Class=@code{"}@b{State}"} +@end flushright +@sp 1 + +Specifies one of three states for the check button: @b{normal}@r{, }@b{active}, +or @b{disabled}. In normal state the check button is displayed using the +@b{foreground}@r{ and }@b{background} options. The active state is +typically used when the pointer is over the check button. In active state +the check button is displayed using the @b{activeForeground} and +@b{activeBackground} options. Disabled state means that the check button +is insensitive: it doesn't activate and doesn't respond to mouse +button presses. In this state the @b{disabledForeground} and +@b{background} options determine how the check button is displayed. +@end table + + +@table @asis +@item @code{@b{:variable}} +@flushright +Name=@code{"@b{variable}@r{"} Class=@code{"}@b{Variable}"} +@end flushright +@sp 1 + +Specifies name of global variable to set to indicate whether +or not this button is selected. Defaults to the name of the +button within its parent (i.e. the last element of the button +window's path name). +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies a desired width for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in characters. +If this option isn't specified, the button's desired width is computed +from the size of the bitmap or text being displayed in it. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{checkbutton} command creates a new window (given by the +@i{pathName} argument) and makes it into a check-button widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the check button such as its colors, font, +text, and initial relief. The @b{checkbutton} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A check button is a widget +that displays a textual string or bitmap +and a square called a @i{selector}. +A check button has +all of the behavior of a simple button, including the +following: it can display itself in either of three different +ways, according to the @b{state} option; +it can be made to appear +raised, sunken, or flat; it can be made to flash; and it invokes +a Tcl command whenever mouse button 1 is clicked over the +check button. + +In addition, check buttons can be @i{selected}. If a check button is +selected then a special highlight appears in the selector, and +a Tcl variable associated with the check button is set to a particular +value (normally 1). If the check button is not selected, then +the selector is drawn in a different fashion and the associated +variable is set to a different value (typically 0). By default, +the name of the variable associated with a check button is the +same as the @i{name} used to create the check button. The +variable name, and the ``on'' and ``off'' values stored in it, +may be modified with options on the command line or in the option +database. By default a check button is configured to select and deselect +itself on alternate button clicks. +In addition, each check button monitors its associated variable and +automatically selects and deselects itself when the variables value +changes to and from the button's ``on'' value. + +@unnumberedsubsec A Checkbutton Widget's Arguments + +The @b{checkbutton} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for check button widgets: + +@table @asis +@item @i{pathName }@b{:activate} +Change the check button's state to @b{active} and redisplay the button +using its active foreground and background colors instead of normal +colors. +This command is ignored if the check button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state active}'' instead. +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{checkbutton} +command. +@item @i{pathName }@b{:deactivate} +Change the check button's state to @b{normal} and redisplay the button +using its normal foreground and background colors. +This command is ignored if the check button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state normal}'' instead. +@item @i{pathName }@b{:deselect} +Deselect the check button: redisplay it without a highlight in +the selector and set the associated variable to its ``off'' +value. +@item @i{pathName }@b{:flash} +Flash the check button. This is accomplished by redisplaying the check button +several times, alternating between active and normal colors. At +the end of the flash the check button is left in the same normal/active +state as when the command was invoked. +This command is ignored if the check button's state is @b{disabled}. +@item @i{pathName }@b{:invoke} +Does just what would have happened if the user invoked the check button +with the mouse: toggle the selection state of the button and invoke +the Tcl command associated with the check button, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the check button. +This command is ignored if the check button's state is @b{disabled}. +@item @i{pathName }@b{:select} +Select the check button: display it with a highlighted +selector and set the associated variable to its ``on'' +value. +@item @i{pathName }@b{:toggle} +Toggle the selection state of the button, redisplaying it and +modifying its associated variable to reflect the new state. + +@end table +@unnumberedsubsec Bindings + +Tk automatically creates class bindings for check buttons that give them +the following default behavior: +@itemize @asis{} +@item +[1] +The check button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves the check button. +@item +[2] +The check button's relief is changed to sunken whenever mouse button 1 is +pressed over it, and the relief is restored to its original +value when button 1 is later released. +@item +[3] +If mouse button 1 is pressed over the check button and later released over +the check button, the check button is invoked (i.e. its selection +state toggles and the command associated with the button is invoked, +if there is one). However, if the mouse is not +over the check button when button 1 is released, then no invocation occurs. +@end itemize + +If the check button's state is @b{disabled} then none of the above +actions occur: the check button is completely non-responsive. + +The behavior of check buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +@unnumberedsubsec Keywords +check button, widget +@node menubutton, text, checkbutton, Widgets +@section menubutton +@c @cartouche + +menubutton \- Create and manipulate menubutton widgets +@unnumberedsubsec Synopsis +@b{menubutton}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +activeBackground bitmap font relief +activeForeground borderWidth foreground text +anchor cursor padX textVariable +background disabledForeground padY underline +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Menubutton + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies a desired height for the menu button. +If a bitmap is being displayed in the menu button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in lines of text. +If this option isn't specified, the menu button's desired height is computed +from the size of the bitmap or text being displayed in it. +@end table + + +@table @asis +@item @code{@b{:menu}} +@flushright +Name=@code{"@b{menu}@r{"} Class=@code{"}@b{MenuName}"} +@end flushright +@sp 1 + +Specifies the path name of the menu associated with this menubutton. +The menu must be a descendant of the menubutton in order for normal pull-down +operation to work via the mouse. +@end table + + +@table @asis +@item @code{@b{:state}} +@flushright +Name=@code{"@b{state}@r{"} Class=@code{"}@b{State}"} +@end flushright +@sp 1 + +Specifies one of three states for the menu button: @b{normal}@r{, }@b{active}, +or @b{disabled}. In normal state the menu button is displayed using the +@b{foreground}@r{ and }@b{background} options. The active state is +typically used when the pointer is over the menu button. In active state +the menu button is displayed using the @b{activeForeground} and +@b{activeBackground} options. Disabled state means that the menu button +is insensitive: it doesn't activate and doesn't respond to mouse +button presses. In this state the @b{disabledForeground} and +@b{background} options determine how the button is displayed. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies a desired width for the menu button. +If a bitmap is being displayed in the menu button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in characters. +If this option isn't specified, the menu button's desired width is computed +from the size of the bitmap or text being displayed in it. +@end table +@c @end cartouche + +@unnumberedsubsec Introduction + +The @b{menubutton} command creates a new window (given by the +@i{pathName} argument) and makes it into a menubutton widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the menubutton such as its colors, font, +text, and initial relief. The @b{menubutton} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A menubutton is a widget that displays a +textual string or bitmap +and is associated with a menu widget. In normal usage, pressing +mouse button 1 over the menubutton causes the associated menu to +be posted just underneath the menubutton. If the mouse is moved over +the menu before releasing the mouse button, the button release +causes the underlying menu entry to be invoked. When the button +is released, the menu is unposted. + +Menubuttons are typically organized into groups called menu bars +that allow scanning: +if the mouse button is pressed over one menubutton (causing it +to post its menu) and the mouse is moved over another menubutton +in the same menu bar without releasing the mouse button, then the +menu of the first menubutton is unposted and the menu of the +new menubutton is posted instead. +The @b{tk-menu-bar} procedure is used to set up menu bars for +scanning; see that procedure for more details. + +@unnumberedsubsec A Menubutton Widget's Arguments + +The @b{menubutton} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for menubutton widgets: + +@table @asis +@item @i{pathName }@b{:activate} +Change the menu button's state to @b{active} and redisplay the menu +button using its active foreground and background colors instead of normal +colors. +The command returns an empty string. +This command is ignored if the menu button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state active}'' instead. +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{menubutton} +command. +@item @i{pathName }@b{:deactivate} +Change the menu button's state to @b{normal} and redisplay the menu +button using its normal foreground and background colors. +The command returns an empty string. +This command is ignored if the menu button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state normal}'' instead. + +@end table +@unnumberedsubsec "Default Bindings" + + +Tk automatically creates class bindings for menu buttons that give them +the following default behavior: +@itemize @asis{} +@item +[1] +A menu button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves it. +@item +[2] +A menu button's relief is changed to raised whenever mouse button 1 is +pressed over it, and the relief is restored to its original value +when button 1 is later released or the mouse is dragged into another +menu button in the same menu bar. +@item +[3] +When mouse button 1 is pressed over a menu button, or when the mouse +is dragged into a menu button with mouse button 1 pressed, the associated +menu is posted; the mouse can be dragged across the menu and released +over an entry in the menu to invoke that entry. The menu is unposted +when button 1 is released outside either the menu or the menu button. +The menu is also unposted when the mouse is dragged into another +menu button in the same menu bar. +@item +[4] +If mouse button 1 is pressed and released within the menu button, +then the menu stays posted and keyboard traversal is possible as +described in the manual entry for @b{tk-menu-bar}. +@item +[5] +Menubuttons may also be posted by typing characters on the keyboard. +See the manual entry for @b{tk-menu-bar} for full details on keyboard +menu traversal. +@item +[6] +If mouse button 2 is pressed over a menu button then the associated +menu is posted and also @i{torn off}: it can then be dragged around on +the screen with button 2 and the menu will not automatically unpost when +entries in it are invoked. +To close a torn off menu, click mouse button 1 over the associated +menu button. +@end itemize + +If the menu button's state is @b{disabled} then none of the above +actions occur: the menu button is completely non-responsive. + +The behavior of menu buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +@unnumberedsubsec Keywords +menubutton, widget +@node text, entry, menubutton, Widgets +@section text +@c @cartouche + +text \- Create and manipulate text widgets +@unnumberedsubsec Synopsis +@b{text}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +background foreground insertWidth selectBorderWidth +borderWidth insertBackground padX selectForeground +cursor insertBorderWidth padY setGrid +exportSelection insertOffTime relief yScrollCommand +font insertOnTime selectBackground +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Text + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies the desired height for the window, in units of characters. +Must be at least one. +@end table + + +@table @asis +@item @code{@b{:state}} +@flushright +Name=@code{"@b{state}@r{"} Class=@code{"}@b{State}"} +@end flushright +@sp 1 + +Specifies one of two states for the text: @b{normal}@r{ or }@b{disabled}. +If the text is disabled then characters may not be inserted or deleted +and no insertion cursor will be displayed, even if the input focus is +in the widget. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies the desired width for the window in units of characters. +If the font doesn't have a uniform width then the width of the +character ``0'' is used in translating from character units to +screen units. +@end table + + +@table @asis +@item @code{@b{:wrap}} +@flushright +Name=@code{"@b{wrap}@r{"} Class=@code{"}@b{Wrap}"} +@end flushright +@sp 1 + +Specifies how to handle lines in the text that are too long to be +displayed in a single line of the text's window. +The value must be @b{none}@r{ or }@b{char}@r{ or }@b{word}. +A wrap mode of @b{none} means that each line of text appears as +exactly one line on the screen; extra characters that don't fit +on the screen are not displayed. +In the other modes each line of text will be broken up into several +screen lines if necessary to keep all the characters visible. +In @b{char} mode a screen line break may occur after any character; +in @b{word} mode a line break will only be made at word boundaries. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{text} command creates a new window (given by the +@i{pathName} argument) and makes it into a text widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the text such as its default background color +and relief. The @b{text} command returns the +path name of the new window. + +A text widget displays one or more lines of text and allows that +text to be edited. +Text widgets support three different kinds of annotations on the +text, called tags, marks, and windows. +Tags allow different portions of the text +to be displayed with different fonts and colors. +In addition, Tcl commands can be associated with tags so +that commands are invoked when particular actions such as keystrokes +and mouse button presses occur in particular ranges of the text. +See TAGS below for more details. + +The second form of annotation consists of marks, which are floating +markers in the text. +Marks are used to keep track of various interesting positions in the +text as it is edited. +See MARKS below for more details. + +The third form of annotation allows arbitrary windows to be displayed +in the text widget. +See WINDOWS below for more details. + +@unnumberedsubsec Indices + +Many of the widget commands for texts take one or more indices +as arguments. +An index is a string used to indicate a particular place within +a text, such as a place to insert characters or one endpoint of a +range of characters to delete. +Indices have the syntax + +@i{base modifier modifier modifier ...} + + +Where @i{base}@r{ gives a starting point and the }@i{modifier}s +adjust the index from the starting point (e.g. move forward or +backward one character). Every index must contain a @i{base}, +but the @i{modifier}s are optional. + + +The @i{base} for an index must have one of the following forms: + +@table @asis +@item @i{line}@b{.}@i{char} +Indicates @i{char}@r{'th character on line }@i{line}. +Lines are numbered from 1 for consistency with other UNIX programs +that use this numbering scheme. +Within a line, characters are numbered from 0. +@item @b{@@}@i{x}@b{,}@i{y} +Indicates the character that covers the pixel whose x and y coordinates +within the text's window are @i{x}@r{ and }@i{y}. +@item @b{end} +Indicates the last character in the text, which is always a newline +character. +@item @i{mark} +Indicates the character just after the mark whose name is @i{mark}. +@item @i{tag}@b{.first} +Indicates the first character in the text that has been tagged with +@i{tag}. +This form generates an error if no characters are currently tagged +with @i{tag}. +@item @i{tag}@b{.last} +Indicates the character just after the last one in the text that has +been tagged with @i{tag}. +This form generates an error if no characters are currently tagged +with @i{tag}. +@end table + + +If modifiers follow the base index, each one of them must have one +of the forms listed below. Keywords such as @b{chars}@r{ and }@b{wordend} +may be abbreviated as long as the abbreviation is unambiguous. + +@table @asis +@item @b{+ }@i{count}@b{ chars} +Adjust the index forward by @i{count} characters, moving to later +lines in the text if necessary. If there are fewer than @i{count} +characters in the text after the current index, then set the index +to the last character in the text. +Spaces on either side of @i{count} are optional. +@item @b{-} @i{count}@b{ chars} +Adjust the index backward by @i{count} characters, moving to earlier +lines in the text if necessary. If there are fewer than @i{count} +characters in the text before the current index, then set the index +to the first character in the text. +Spaces on either side of @i{count} are optional. +@item @b{+ }@i{count}@b{ lines} +Adjust the index forward by @i{count} lines, retaining the same +character position within the line. If there are fewer than @i{count} +lines after the line containing the current index, then set the index +to refer to the same character position on the last line of the text. +Then, if the line is not long enough to contain a character at the indicated +character position, adjust the character position to refer to the last +character of the line (the newline). +Spaces on either side of @i{count} are optional. +@item @b{-} @i{count}@b{ lines} +Adjust the index backward by @i{count} lines, retaining the same +character position within the line. If there are fewer than @i{count} +lines before the line containing the current index, then set the index +to refer to the same character position on the first line of the text. +Then, if the line is not long enough to contain a character at the indicated +character position, adjust the character position to refer to the last +character of the line (the newline). +Spaces on either side of @i{count} are optional. +@item @b{linestart} +Adjust the index to refer to the first character on the line. +@item @b{lineend} +Adjust the index to refer to the last character on the line (the newline). +@item @b{wordstart} +Adjust the index to refer to the first character of the word containing +the current index. A word consists of any number of adjacent characters +that are letters, digits, or underscores, or a single character that +is not one of these. +@item @b{wordend} +Adjust the index to refer to the character just after the last one of the +word containing the current index. If the current index refers to the last +character of the text then it is not modified. +@end table + + +If more than one modifier is present then they are applied in +left-to-right order. For example, the index ``\fBend \- 1 chars'' +refers to the next-to-last character in the text and +``\fBinsert wordstart \- 1 c'' refers to the character just before +the first one in the word containing the insertion cursor. + +@unnumberedsubsec Tags + +The first form of annotation in text widgets is a tag. +A tag is a textual string that is associated with some of the characters +in a text. +There may be any number of tags associated with characters in a +text. +Each tag may refer to a single character, a range of characters, or +several ranges of characters. +An individual character may have any number of tags associated with it. + +A priority order is defined among tags, and this order is used in +implementing some of the tag-related functions described below. +When a tag is defined (by associating it with characters or setting +its display options or binding commands to it), it is given +a priority higher than any existing tag. +The priority order of tags may be redefined using the +``@i{pathName }@b{:tag :raise}@r{'' and ``}@i{pathName }@b{:tag :lower}'' +widget commands. + +Tags serve three purposes in text widgets. +First, they control the way information is displayed on the screen. +By default, characters are displayed as determined by the +@b{background}@r{, }@b{font}@r{, and }@b{foreground} options for the +text widget. +However, display options may be associated with individual tags +using the ``@i{pathName }@b{:tag configure}'' widget command. +If a character has been tagged, then the display options associated +with the tag override the default display style. +The following options are currently supported for tags: + +@table @asis +@item @b{:background }@i{color} +@i{Color} specifies the background color to use for characters +associated with the tag. +It may have any of the forms accepted by @b{Tk_GetColor}. +@item @b{:bgstipple }@i{bitmap} +@i{Bitmap} specifies a bitmap that is used as a stipple pattern +for the background. +It may have any of the forms accepted by @b{Tk_GetBitmap}. +If @i{bitmap} hasn't been specified, or if it is specified +as an empty string, then a solid fill will be used for the +background. +@item @b{:borderwidth }@i{pixels} +@i{Pixels} specifies the width of a 3-D border to draw around +the background. +It may have any of the forms accepted by @b{Tk_GetPixels}. +This option is used in conjunction with the @b{:relief} +option to give a 3-D appearance to the background for characters; +it is ignored unless the @b{:background} option +has been set for the tag. +@item @b{:fgstipple }@i{bitmap} +@i{Bitmap} specifies a bitmap that is used as a stipple pattern +when drawing text and other foreground information such as +underlines. +It may have any of the forms accepted by @b{Tk_GetBitmap}. +If @i{bitmap} hasn't been specified, or if it is specified +as an empty string, then a solid fill will be used. +@item @b{:font }@i{fontName} +@i{FontName} is the name of a font to use for drawing characters. +It may have any of the forms accepted by @b{Tk_GetFontStruct}. +@item @b{:foreground }@i{color} +@i{Color} specifies the color to use when drawing text and other +foreground information such as underlines. +It may have any of the forms accepted by @b{Tk_GetColor}. +@item @b{:relief }@i{relief} +\fIRelief specifies the 3-D relief to use for drawing backgrounds, +in any of the forms accepted by @b{Tk_GetRelief}. +This option is used in conjunction with the @b{:borderwidth} +option to give a 3-D appearance to the background for characters; +it is ignored unless the @b{:background} option +has been set for the tag. +@item @b{:underline }@i{boolean} +@i{Boolean} specifies whether or not to draw an underline underneath +characters. +It may have any of the forms accepted by @b{Tk_GetBoolean}. + +If a character has several tags associated with it, and if their +display options conflict, then the options of the highest priority +tag are used. +If a particular display option hasn't been specified for a +particular tag, or if it is specified as an empty string, then +that option will never be used; the next-highest-priority +tag's option will used instead. +If no tag specifies a particular display optionl, then the default +style for the widget will be used. + +The second purpose for tags is event bindings. +You can associate bindings with a tag in much the same way you can +associate bindings with a widget class: whenever particular X +events occur on characters with the given tag, a given +Tcl command will be executed. +Tag bindings can be used to give behaviors to ranges of characters; +among other things, this allows hypertext-like +features to be implemented. +For details, see the description of the @b{tag bind} widget +command below. + +The third use for tags is in managing the selection. +See THE SELECTION below. + +@end table +@unnumberedsubsec Marks + +The second form of annotation in text widgets is a mark. +Marks are used for remembering particular places in a text. +They are something like tags, in that they have names and +they refer to places in the file, but a mark isn't associated +with particular characters. +Instead, a mark is associated with the gap between two characters. +Only a single position may be associated with a mark at any given +time. +If the characters around a mark are deleted the mark will still +remain; it will just have new neighbor characters. +In contrast, if the characters containing a tag are deleted then +the tag will no longer have an association with characters in +the file. +Marks may be manipulated with the ``@i{pathName }@b{:mark}'' widget +command, and their current locations may be determined by using the +mark name as an index in widget commands. + +The name space for marks is different from that for tags: the +same name may be used for both a mark and a tag, but they will refer +to different things. + +Two marks have special significance. +First, the mark @b{insert} is associated with the insertion cursor, +as described under THE INSERTION CURSOR below. +Second, the mark @b{current} is associated with the character +closest to the mouse and is adjusted automatically to track the +mouse position and any changes to the text in the widget (one +exception: @b{current} is not updated in response to mouse +motions if a mouse button is down; the update will be deferred +until all mouse buttons have been released). +Neither of these special marks may be unset. + +@unnumberedsubsec Windows + +The third form of annotation in text widgets is a window. +Window support isn't implemented yet, but when it is it will be +described here. + +@unnumberedsubsec The Selection + +Text widgets support the standard X selection. +Selection support is implemented via tags. +If the @b{exportSelection} option for the text widget is true +then the @b{sel} tag will be associated with the selection: +@itemize @asis{} +@item +[1] +Whenever characters are tagged with @b{sel} the text widget +will claim ownership of the selection. +@item +[2] +Attempts to retrieve the +selection will be serviced by the text widget, returning all the +charaters with the @b{sel} tag. +@item +[3] +If the selection is claimed away by another application or by another +window within this application, then the @b{sel} tag will be removed +from all characters in the text. +@end itemize + +The @b{sel} tag is automatically defined when a text widget is +created, and it may not be deleted with the ``@i{pathName }@b{:tag delete}'' +widget command. Furthermore, the @b{selectBackground}, +@b{selectBorderWidth}@r{, and }@b{selectForeground} options for +the text widget are tied to the @b{:background}, +@b{:borderwidth}@r{, and }@b{:foreground}@r{ options for the }@b{sel} +tag: changes in either will automatically be reflected in the +other. + +@unnumberedsubsec The Insertion Cursor + +The mark named @b{insert} has special significance in text widgets. +It is defined automatically when a text widget is created and it +may not be unset with the ``@i{pathName }@b{:mark unset}'' widget +command. +The @b{insert} mark represents the position of the insertion +cursor, and the insertion cursor will automatically be drawn at +this point whenever the text widget has the input focus. + +@unnumberedsubsec A Text Widget's Arguments + +The @b{text} command creates a new Tcl command whose +name is the same as the path name of the text's window. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{PathName} is the name of the command, which is the same as +the text widget's path name. @i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for text widgets: + +@table @asis +@item @i{pathName }@b{:compare}@r{ }@i{index1 op index2} +Compares the indices given by @i{index1}@r{ and }@i{index2} according +to the relational operator given by @i{op}, and returns 1 if +the relationship is satisfied and 0 if it isn't. +@i{Op} must be one of the operators <, <=, ==, >=, >, or !=. +If @i{op} is == then 1 is returned if the two indices refer to +the same character, if @i{op}@r{ is < then 1 is returned if }@i{index1} +refers to an earlier character in the text than @i{index2}, and +so on. +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? }@i{?value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{text} +command. +@item @i{pathName }@b{:debug }@r{?}@i{boolean}? +If @i{boolean} is specified, then it must have one of the true or +false values accepted by Tcl_GetBoolean. +If the value is a true one then internal consistency checks will be +turned on in the B-tree code associated with text widgets. +If @i{boolean} has a false value then the debugging checks will +be turned off. +In either case the command returns an empty string. +If @i{boolean}@r{ is not specified then the command returns }@b{on} +or @b{off} to indicate whether or not debugging is turned on. +There is a single debugging switch shared by all text widgets: turning +debugging on or off in any widget turns it on or off for all widgets. +For widgets with large amounts of text, the consistency checks may +cause a noticeable slow-down. +@item @i{pathName }@b{:delete }@i{index1 }@r{?}@i{index2}? +Delete a range of characters from the text. +If both @i{index1}@r{ and }@i{index2} are specified, then delete +all the characters starting with the one given by @i{index1} +and stopping just before @i{index2} (i.e. the character at +@i{index2} is not deleted). +If @i{index2} doesn't specify a position later in the text +than @i{index1} then no characters are deleted. +If @i{index2} isn't specified then the single character at +@i{index1} is deleted. +It is not allowable to delete characters in a way that would leave +the text without a newline as the last character. +The command returns an empty string. +@item @i{pathName }@b{:get }@i{index1 }@r{?}@i{index2}? +Return a range of characters from the text. +The return value will be all the characters in the text starting +with the one whose index is @i{index1} and ending just before +the one whose index is @i{index2}@r{ (the character at }@i{index2} +will not be returned). +If @i{index2}@r{ is omitted then the single character at }@i{index1} +is returned. +If there are no characters in the specified range (e.g. @i{index1} +is past the end of the file or @i{index2} is less than or equal +to @i{index1}) then an empty string is returned. +@item @i{pathName }@b{:index }@i{index} +Returns the position corresponding to @i{index} in the form +@i{line.char}@r{ where }@i{line}@r{ is the line number and }@i{char} +is the character number. +@i{Index} may have any of the forms described under INDICES above. +@item @i{pathName }@b{:insert }\fIindex chars +Inserts @i{chars} into the text just before the character at +@i{index} and returns an empty string. +It is not possible to insert characters after the last newline +of the text. +@item @i{pathName }@b{:mark }@i{option }@r{?}@i{arg arg ...}? +This command is used to manipulate marks. The exact behavior of +the command depends on the @i{option} argument that follows +the @b{mark} argument. The following forms of the command +are currently supported: +@table @asis +@item @i{pathName }@b{:mark :names} +Returns a list whose elements are the names of all the marks that +are currently set. +@item @i{pathName }@b{:mark :set }@i{markName index} +Sets the mark named @i{markName} to a position just before the +character at @i{index}. +If @i{markName} already exists, it is moved from its old position; +if it doesn't exist, a new mark is created. +This command returns an empty string. +@item @i{pathName }@b{:mark :unset }@i{markName }@r{?}@i{markName markName ...}? +Remove the mark corresponding to each of the @i{markName} arguments. +The removed marks will not be usable in indices and will not be +returned by future calls to ``@i{pathName }@b{:mark names}''. +This command returns an empty string. +@end table + +@item @i{pathName }@b{:scan}@r{ }@i{option args} +This command is used to implement scanning on texts. It has +two forms, depending on @i{option}: +@table @asis +@item @i{pathName }@b{:scan :mark }@i{y} +Records @i{y} and the current view in the text window; used in +conjunction with later @b{scan dragto} commands. Typically this +command is associated with a mouse button press in the widget. It +returns an empty string. +@item @i{pathName }@b{:scan :dragto }@i{y} +This command computes the difference between its @i{y} argument +and the @i{y}@r{ argument to the last }@b{scan mark} command for +the widget. It then adjusts the view up or down by 10 times the +difference in y-coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the text at high speed through the window. The return +value is an empty string. +@end table + +@item @i{pathName }@b{:tag }@i{option }@r{?}@i{arg arg ...}? +This command is used to manipulate tags. The exact behavior of the +command depends on the @i{option} argument that follows the +@b{tag} argument. The following forms of the command are currently +supported: + +@table @asis +@item @i{pathName }@b{:tag :add }@i{tagName index1 }@r{?}@i{index2}? +Associate the tag @i{tagName} with all of the characters starting +with @i{index1} and ending just before +@i{index2}@r{ (the character at }@i{index2} isn't tagged). +If @i{index2} is omitted then the single character at +@i{index1} is tagged. +If there are no characters in the specified range (e.g. @i{index1} +is past the end of the file or @i{index2} is less than or equal +to @i{index1}) then the command has no effect. +This command returns an empty string. +@item @i{pathName }@b{:tag :bind }@i{tagName}@r{ ?}@i{sequence}@r{? ?}@i{command}? +This command associates @i{command} with the tag given by +@i{tagName}. +Whenever the event sequence given by @i{sequence} occurs for a +character that has been tagged with @i{tagName}, +the command will be invoked. +This widget command is similar to the @b{bind} command except that +it operates on characters in a text rather than entire widgets. +See the @b{bind} manual entry for complete details +on the syntax of @i{sequence} and the substitutions performed +on @i{command} before invoking it. +If all arguments are specified then a new binding is created, replacing +any existing binding for the same @i{sequence}@r{ and }@i{tagName} +(if the first character of @i{command}@r{ is ``+'' then }@i{command} +augments an existing binding rather than replacing it). +In this case the return value is an empty string. +If @i{command}@r{ is omitted then the command returns the }@i{command} +associated with @i{tagName}@r{ and }@i{sequence} (an error occurs +if there is no such binding). +If both @i{command}@r{ and }@i{sequence} are omitted then the command +returns a list of all the sequences for which bindings have been +defined for @i{tagName}. + + +The only events for which bindings may be specified are those related +to the mouse and keyboard, such as @b{Enter}@r{, }@b{Leave}, +@b{ButtonPress}@r{, }@b{Motion}@r{, and }@b{KeyPress}. +Event bindings for a text widget use the @b{current} mark +described under MARKS above. +@b{Enter} events trigger for a character when it +becomes the current character (i.e. the @b{current} mark moves +to just in front of that character). +@b{Leave} events trigger for a character when it ceases to be +the current item (i.e. the @b{current} mark moves away from +that character, or the character is deleted). +These events are different than @b{Enter}@r{ and }@b{Leave} +events for windows. +Mouse and keyboard events are directed to the current character. + + +It is possible for the current character to have multiple tags, +and for each of them to have a binding for a particular event +sequence. +When this occurs, the binding from the highest priority tag is +used. +If a particular tag doesn't have a binding that matches an +event, then the tag is ignored and tags with lower priority +will be checked. + + +If bindings are created for the widget as a whole using the +@b{bind} command, then those bindings will supplement the +tag bindings. +This means that a single event can trigger two Tcl scripts, +one for a widget-level binding and one for a tag-level +binding. + + +@item @i{pathName }@b{:tag :configure }@i{tagName}@r{ ?}@i{option}@r{? ?}@i{value}@r{? ?}@i{option value ...}? +This command is similar to the @b{configure} widget command except +that it modifies options associated with the tag given by @i{tagName} +instead of modifying options for the overall text widget. +If no @i{option} is specified, the command returns a list describing +all of the available options for @i{tagName}@r{ (see }@b{Tk_ConfigureInfo} +for information on the format of this list). +If @i{option}@r{ is specified with no }@i{value}, then the command returns +a list describing the one named option (this list will be identical to +the corresponding sublist of the value returned if no @i{option} +is specified). +If one or more @i{option:value} pairs are specified, then the command +modifies the given option(s) to have the given value(s) in @i{tagName}; +in this case the command returns an empty string. +See TAGS above for details on the options available for tags. +@item @i{pathName }@b{:tag :delete }@i{tagName }@r{?}@i{tagName ...}? +Deletes all tag information for each of the @i{tagName} +arguments. +The command removes the tags from all characters in the file +and also deletes any other information associated with the tags, +such as bindings and display information. +The command returns an empty string. +@item @i{pathName }@b{:tag :lower }@i{tagName }@r{?}@i{belowThis}? +Changes the priority of tag @i{tagName} so that it is just lower +in priority than the tag whose name is @i{belowThis}. +If @i{belowThis}@r{ is omitted, then }@i{tagName}'s priority +is changed to make it lowest priority of all tags. +@item @i{pathName }@b{:tag :names }@r{?}@i{index}? +Returns a list whose elements are the names of all the tags that +are active at the character position given by @i{index}. +If @i{index} is omitted, then the return value will describe +all of the tags that exist for the text (this includes all tags +that have been named in a ``@i{pathName }@b{:tag}'' widget +command but haven't been deleted by a ``@i{pathName }@b{:tag :delete}'' +widget command, even if no characters are currently marked with +the tag). +The list will be sorted in order from lowest priority to highest +priority. +@item @i{pathName }@b{:tag :nextrange }@i{tagName index1 }@r{?}@i{index2}? +This command searches the text for a range of characters tagged +with @i{tagName} where the first character of the range is +no earlier than the character at @i{index1} and no later than +the character just before @i{index2} (a range starting at +@i{index2} will not be considered). +If several matching ranges exist, the first one is chosen. +The command's return value is a list containing +two elements, which are the index of the first character of the +range and the index of the character just after the last one in +the range. +If no matching range is found then the return value is an +empty string. +If @i{index2} is not given then it defaults to the end of the text. +@item @i{pathName }@b{:tag :raise }@i{tagName }@r{?}@i{aboveThis}? +Changes the priority of tag @i{tagName} so that it is just higher +in priority than the tag whose name is @i{aboveThis}. +If @i{aboveThis}@r{ is omitted, then }@i{tagName}'s priority +is changed to make it highest priority of all tags. +@item @i{pathName }@b{:tag :ranges }@i{tagName} +Returns a list describing all of the ranges of text that have been +tagged with @i{tagName}. +The first two elements of the list describe the first tagged range +in the text, the next two elements describe the second range, and +so on. +The first element of each pair contains the index of the first +character of the range, and the second element of the pair contains +the index of the character just after the last one in the +range. +If there are no characters tagged with @i{tag} then an +empty string is returned. +@item @i{pathName }@b{:tag :remove }@i{tagName index1 }@r{?}@i{index2}? +Remove the tag @i{tagName} from all of the characters starting +at @i{index1} and ending just before +@i{index2}@r{ (the character at }@i{index2} isn't affected). +If @i{index2} is omitted then the single character at +@i{index1} is untagged. +If there are no characters in the specified range (e.g. @i{index1} +is past the end of the file or @i{index2} is less than or equal +to @i{index1}) then the command has no effect. +This command returns an empty string. + +@end table +@item @i{pathName }@b{:yview }@r{?}@b{:pickplace}@r{? }@i{what} +This command changes the view in the widget's window so that the line +given by @i{what} is visible in the window. +@i{What} may be either an absolute line number, where 0 corresponds +to the first line of the file, or an index with any of the forms +described under INDICES above. +The first form (absolute line number) is used in the commands issued +by scrollbars to control the widget's view. +If the @b{:pickplace}@r{ option isn't specified then }@i{what} will +appear at the top of the window. +If @b{:pickplace} is specified then the widget chooses where +@i{what} appears in the window: +@itemize @asis{} +@item +[1] +If @i{what} is already visible somewhere in the window then the +command does nothing. +@item +[2] +If @i{what} is only a few lines off-screen above the window then +it will be positioned at the top of the window. +@item +[3] +If @i{what} is only a few lines off-screen below the window then +it will be positioned at the bottom of the window. +@item +[4] +Otherwise, @i{what} will be centered in the window. +@end itemize + +The @b{:pickplace} option is typically used after inserting text +to make sure that the insertion cursor is still visible on the screen. +This command returns an empty string. +@end table + + +@unnumberedsubsec Bindings + +Tk automatically creates class bindings for texts that give them +the following default behavior: +@itemize @asis{} +@item +[1] +Pressing mouse button 1 in an text positions the insertion cursor +just before the character underneath the mouse cursor and sets the +input focus to this widget. +@item +[2] +Dragging with mouse button 1 strokes out a selection between +the insertion cursor and the character under the mouse. +@item +[3] +If you double-press mouse button 1 then the word under the mouse cursor +will be selected, the insertion cursor will be positioned at the +beginning of the word, and dragging the mouse will stroke out a selection +whole words at a time. +@item +[4] +If you triple-press mouse button 1 then the line under the mouse cursor +will be selected, the insertion cursor will be positioned at the +beginning of the line, and dragging the mouse will stroke out a selection +whole line at a time. +@item +[5] +The ends of the selection can be adjusted by dragging with mouse +button 1 while the shift key is down; this will adjust the end +of the selection that was nearest to the mouse cursor when button +1 was pressed. If the selection was made in word or line mode then +it will be adjusted in this same mode. +@item +[6] +The view in the text can be adjusted by dragging with mouse button 2. +@item +[7] +If the input focus is in a text widget and characters are typed on the +keyboard, the characters are inserted just before the insertion cursor. +@item +[8] +Control+h and the Backspace and Delete keys erase the character just +before the insertion cursor. +@item +[9] +Control+v inserts the current selection just before the insertion cursor. +@item +[10] +Control+d deletes the selected characters; an error occurs if the selection +is not in this widget. +@end itemize + +If the text is disabled using the @b{state} option, then the text's +view can still be adjusted and text in the text can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. + +The behavior of texts can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +@unnumberedsubsec "Performance Issues" + +Text widgets should run efficiently under a variety +of conditions. The text widget uses about 2-3 bytes of +main memory for each byte of text, so texts containing a megabyte +or more should be practical on most workstations. +Text is represented internally with a modified B-tree structure +that makes operations relatively efficient even with large texts. +Tags are included in the B-tree structure in a way that allows +tags to span large ranges or have many disjoint smaller ranges +without loss of efficiency. +Marks are also implemented in a way that allows large numbers of +marks. +The only known mode of operation where a text widget may not run +efficiently is if it has a very large number of different tags. +Hundreds of tags should be fine, or even a thousand, +but tens of thousands of tags will make texts consume a lot of +memory and run slowly. + +@unnumberedsubsec Keywords +text, widget +@node entry, message, text, Widgets +@section entry +@c @cartouche + +entry \- Create and manipulate entry widgets +@unnumberedsubsec Synopsis +@b{entry}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +background foreground insertWidth selectForeground +borderWidth insertBackground relief textVariable +cursor insertBorderWidth scrollCommand +exportSelection insertOffTime selectBackground +font insertOnTime selectBorderWidth +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Entry + + +@table @asis +@item @code{@b{:state}} +@flushright +Name=@code{"@b{state}@r{"} Class=@code{"}@b{State}"} +@end flushright +@sp 1 + +Specifies one of two states for the entry: @b{normal}@r{ or }@b{disabled}. +If the entry is disabled then the value may not be changed using widget +commands and no insertion cursor will be displayed, even if the input focus is +in the widget. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies an integer value indicating the desired width of the entry window, +in average-size characters of the widget's font. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{entry} command creates a new window (given by the +@i{pathName} argument) and makes it into an entry widget. +Additional options, described above, may be specified on the +command line or in the option database +to configure aspects of the entry such as its colors, font, +and relief. The @b{entry} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +An entry is a widget that displays a one-line text string and +allows that string to be edited using widget commands described below, which +are typically bound to keystrokes and mouse actions. +When first created, an entry's string is empty. +A portion of the entry may be selected as described below. +If an entry is exporting its selection (see the @b{exportSelection} +option), then it will observe the standard X11 protocols for handling the +selection; entry selections are available as type @b{STRING}. +Entries also observe the standard Tk rules for dealing with the +input focus. When an entry has the input focus it displays an +@i{insertion cursor} to indicate where new characters will be +inserted. + +Entries are capable of displaying strings that are too long to +fit entirely within the widget's window. In this case, only a +portion of the string will be displayed; commands described below +may be used to change the view in the window. Entries use +the standard @b{scrollCommand} mechanism for interacting with +scrollbars (see the description of the @b{scrollCommand} option +for details). They also support scanning, as described below. + +@unnumberedsubsec A Entry Widget's Arguments + +The @b{entry} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. + +Many of the widget commands for entries take one or more indices as +arguments. An index specifies a particular character in the entry's +string, in any of the following ways: + +@table @asis +@item @i{number} +Specifies the character as a numerical index, where 0 corresponds +to the first character in the string. +@item @b{end} +Indicates the character just after the last one in the entry's string. +This is equivalent to specifying a numerical index equal to the length +of the entry's string. +@item @b{insert} +Indicates the character adjacent to and immediately following the +insertion cursor. +@item @b{sel.first} +Indicates the first character in the selection. It is an error to +use this form if the selection isn't in the entry window. +@item @b{sel.last} +Indicates the last character in the selection. It is an error to +use this form if the selection isn't in the entry window. +@item @b{@@}@i{number} +In this form, @i{number} is treated as an x-coordinate in the +entry's window; the character spanning that x-coordinate is used. +For example, ``@b{@@0}'' indicates the left-most character in the +window. +@end table + + +Abbreviations may be used for any of the forms above, e.g. ``@b{e}'' +or ``@b{sel.f}''. In general, out-of-range indices are automatically +rounded to the nearest legal value. + +The following commands are possible for entry widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{entry} +command. +@item @i{pathName }@b{:delete }@i{first }@r{?}@i{last}? +Delete one or more elements of the entry. @i{First}@r{ and }@i{last} +are indices of of the first and last characters in the range to +be deleted. If @i{last} isn't specified it defaults to +@i{first}, i.e. a single character is deleted. This command +returns an empty string. +@item @i{pathName }@b{:get} +Returns the entry's string. +@item @i{pathName }@b{:icursor }@i{index} +Arrange for the insertion cursor to be displayed just before the character +given by @i{index}. Returns an empty string. +@item @i{pathName }@b{:index}@i{ index} +Returns the numerical index corresponding to @i{index}. +@item @i{pathName }@b{:insert }@i{index string} +Insert the characters of @i{string} just before the character +indicated by @i{index}. Returns an empty string. +@item @i{pathName }@b{:scan}@r{ }@i{option args} +This command is used to implement scanning on entries. It has +two forms, depending on @i{option}: +@table @asis +@item @i{pathName }@b{:scan :mark }@i{x} +Records @i{x} and the current view in the entry window; used in +conjunction with later @b{scan dragto} commands. Typically this +command is associated with a mouse button press in the widget. It +returns an empty string. +@item @i{pathName }@b{:scan :dragto }@i{x} +This command computes the difference between its @i{x} argument +and the @i{x}@r{ argument to the last }@b{scan mark} command for +the widget. It then adjusts the view left or right by 10 times the +difference in x-coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the entry at high speed through the window. The return +value is an empty string. +@end table +@item @i{pathName }@b{:select }@i{option arg} +This command is used to adjust the selection within an entry. It +has several forms, depending on @i{option}: +@table @asis +@item @i{pathName }@b{:select :adjust }@i{index} +Locate the end of the selection nearest to the character given by +@i{index}@r{, and adjust that end of the selection to be at }@i{index} +(i.e including but not going beyond @i{index}). The other +end of the selection is made the anchor point for future +@b{select to} commands. If the selection +isn't currently in the entry, then a new selection is created to +include the characters between @i{index} and the most recent +selection anchor point, inclusive. +Returns an empty string. +@item @i{pathName }@b{:select :clear} +Clear the selection if it is currently in this widget. If the +selection isn't in this widget then the command has no effect. +Returns an empty string. +@item @i{pathName }@b{:select :from }@i{index} +Set the selection anchor point to just before the character +given by @i{index}. Doesn't change the selection. +Returns an empty string. +@item @i{pathName }@b{:select :to }@i{index} +Set the selection to consist of the elements from the anchor +point to element @i{index}, inclusive. The anchor point is +determined by the most recent @b{select from}@r{ or }@b{select adjust} +command in this widget. If the selection isn't in this widget +then a new selection is created using the most recent anchor point +specified for the widget. Returns an empty string. +@end table +@item @i{pathName }@b{:view }@i{index} +Adjust the view in the entry so that element @i{index} is +at the left edge of the window. Returns an empty string. + +@end table +@unnumberedsubsec "Default Bindings" + +Tk automatically creates class bindings for entries that give them +the following default behavior: + +@itemize @asis{} +@item +[1] +Clicking mouse button 1 in an entry positions the insertion cursor +just before the character underneath the mouse cursor and sets the +input focus to this widget. +@item +[2] +Dragging with mouse button 1 strokes out a selection between +the insertion cursor and the character under the mouse. +@item +[3] +The ends of the selection can be adjusted by dragging with mouse +button 1 while the shift key is down; this will adjust the end +of the selection that was nearest to the mouse cursor when button +1 was pressed. +@item +[4] +The view in the entry can be adjusted by dragging with mouse button 2. +@item +[5] +If the input focus is in an entry widget and characters are typed on the +keyboard, the characters are inserted just before the insertion cursor. +@item +[6] +Control-h and the Backspace and Delete keys erase the character just +before the insertion cursor. +@item +[7] +Control-w erases the word just before the insertion cursor. +@item +[8] +Control-u clears the entry to an empty string. +@item +[9] +Control-v inserts the current selection just before the insertion cursor. +@item +[10] +Control-d deletes the selected characters; an error occurs if the selection +is not in this widget. +@end itemize + +If the entry is disabled using the @b{state} option, then the entry's +view can still be adjusted and text in the entry can still be selected, +but no insertion cursor will be displayed and no text modifications will +take place. + +The behavior of entries can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +@unnumberedsubsec Keywords +entry, widget +@node message, frame, entry, Widgets +@section message +@c @cartouche + +message \- Create and manipulate message widgets +@unnumberedsubsec Synopsis +@b{message}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +anchor cursor padX text +background font padY textVariable +borderWidth foreground relief width +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Message + + +@table @asis +@item @code{@b{:aspect}} +@flushright +Name=@code{"@b{aspect}@r{"} Class=@code{"}@b{Aspect}"} +@end flushright +@sp 1 + +Specifies a non-negative integer value indicating desired +aspect ratio for the text. The aspect ratio is specified as +100*width/height. 100 means the text should +be as wide as it is tall, 200 means the text should +be twice as wide as it is tall, 50 means the text should +be twice as tall as it is wide, and so on. +Used to choose line length for text if @b{width} option +isn't specified. +Defaults to 150. +@end table + + +@table @asis +@item @code{@b{:justify}} +@flushright +Name=@code{"@b{justify}@r{"} Class=@code{"}@b{Justify}"} +@end flushright +@sp 1 + +Specifies how to justify lines of text. +Must be one of @b{left}@r{, }@b{center}@r{, or }@b{right}. Defaults +to @b{left}. +This option works together with the @b{anchor}@r{, }@b{aspect}, +@b{padX}@r{, }@b{padY}@r{, and }@b{width} options to provide a variety +of arrangements of the text within the window. +The @b{aspect}@r{ and }@b{width} options determine the amount of +screen space needed to display the text. +The @b{anchor}@r{, }@b{padX}@r{, and }@b{padY} options determine where this +rectangular area is displayed within the widget's window, and the +@b{justify} option determines how each line is displayed within that +rectangular region. +For example, suppose @b{anchor}@r{ is }@b{e}@r{ and }@b{justify} is +@b{left}, and that the message window is much larger than needed +for the text. +The the text will displayed so that the left edges of all the lines +line up and the right edge of the longest line is @b{padX} from +the right side of the window; the entire text block will be centered +in the vertical span of the window. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies the length of lines in the window. +The value may have any of the forms acceptable to @b{Tk_GetPixels}. +If this option has a value greater than zero then the @b{aspect} +option is ignored and the @b{width} option determines the line +length. +If this option has a value less than or equal to zero, then +the @b{aspect} option determines the line length. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{message} command creates a new window (given by the +@i{pathName} argument) and makes it into a message widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the message such as its colors, font, +text, and initial relief. The @b{message} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A message is a widget that displays a textual string. A message +widget has three special features. First, it breaks up +its string into lines in order to produce a given aspect ratio +for the window. The line breaks are chosen at word boundaries +wherever possible (if not even a single word would fit on a +line, then the word will be split across lines). Newline characters +in the string will force line breaks; they can be used, for example, +to leave blank lines in the display. + +The second feature of a message widget is justification. The text +may be displayed left-justified (each line starts at the left side of +the window), centered on a line-by-line basis, or right-justified +(each line ends at the right side of the window). + +The third feature of a message widget is that it handles control +characters and non-printing characters specially. Tab characters +are replaced with enough blank space to line up on the next +8-character boundary. Newlines cause line breaks. Other control +characters (ASCII code less than 0x20) and characters not defined +in the font are displayed as a four-character sequence \fB\ex@i{hh} where +@i{hh} is the two-digit hexadecimal number corresponding to +the character. In the unusual case where the font doesn't contain +all of the characters in ``0123456789abcdef\ex'' then control +characters and undefined characters are not displayed at all. + +@unnumberedsubsec A Message Widget's Arguments + +The @b{message} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for message widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{message} +command. + +@end table +@unnumberedsubsec "Default Bindings" + +When a new message is created, it has no default event bindings: +messages are intended for output purposes only. + +@unnumberedsubsec Bugs + +Tabs don't work very well with text that is centered or right-justified. +The most common result is that the line is justified wrong. + +@unnumberedsubsec Keywords +message, widget +@node frame, label, message, Widgets +@section frame +@c @cartouche + +frame \- Create and manipulate frame widgets +@unnumberedsubsec Synopsis +@b{frame}@i{ }@i{pathName }@r{?}@b{:class }@i{className}@r{? ?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +background cursor relief +borderWidth geometry +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Frame + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies the desired height for the window in any of the forms +acceptable to @b{Tk_GetPixels}. +This option is only used if the @b{:geometry} option is +unspecified. +If this option is less than or equal to zero (and @b{:geometry} +is not specified) then the window will not request any size at +all. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies the desired width for the window in any of the forms +acceptable to @b{Tk_GetPixels}. +This option is only used if the @b{:geometry} option is +unspecified. +If this option is less than or equal to zero (and @b{:geometry} +is not specified) then the window will not request any size at +all. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{frame} command creates a new window (given by the +@i{pathName} argument) and makes it into a frame widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the frame such as its background color +and relief. The @b{frame} command returns the +path name of the new window. + +A frame is a simple widget. Its primary purpose is to act as a +spacer or container for complex window layouts. The only features +of a frame are its background color and an optional 3-D border to make the +frame appear raised or sunken. + +In addition to the standard options listed above, a @b{:class} +option may be specified on the command line. If it is specified, then +the new widget's class will be set to @i{className} instead of +@b{Frame}. Changing the class of a frame widget may be useful +in order to use a special class name in database options referring +to this widget and its children. Note: @b{:class} is handled +differently than other command-line options and cannot be specified +using the option database (it has to be processed +before the other options are even looked up, since the new class +name will affect the lookup of the other options). In addition, +the @b{:class} option may not be queried or changed using the +@b{config} command described below. + +@unnumberedsubsec A Frame Widget's Arguments + +The @b{frame} command creates a new Tcl command whose +name is the same as the path name of the frame's window. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{PathName} is the name of the command, which is the same as +the frame widget's path name. @i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for frame widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? }@i{?value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{frame} +command. + +@end table +@unnumberedsubsec Bindings + +When a new frame is created, it has no default event bindings: +frames are not intended to be interactive. + +@unnumberedsubsec Keywords +frame, widget +@node label, radiobutton, frame, Widgets +@section label +@c @cartouche + +label \- Create and manipulate label widgets +@unnumberedsubsec Synopsis +@b{label}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +anchor borderWidth foreground relief +background cursor padX text +bitmap font padY textVariable +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Label + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies a desired height for the label. +If a bitmap is being displayed in the label then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in lines of text. +If this option isn't specified, the label's desired height is computed +from the size of the bitmap or text being displayed in it. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies a desired width for the label. +If a bitmap is being displayed in the label then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in characters. +If this option isn't specified, the label's desired width is computed +from the size of the bitmap or text being displayed in it. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{label} command creates a new window (given by the +@i{pathName} argument) and makes it into a label widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the label such as its colors, font, +text, and initial relief. The @b{label} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A label is a widget +that displays a textual string or bitmap. +The label can be manipulated in a few simple ways, such as +changing its relief or text, using the commands described below. + +@unnumberedsubsec A Label Widget's Arguments + +The @b{label} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for label widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{label} +command. + +@end table +@unnumberedsubsec Bindings + +When a new label is created, it has no default event bindings: +labels are not intended to be interactive. + +@unnumberedsubsec Keywords +label, widget +@node radiobutton, toplevel, label, Widgets +@section radiobutton +@c @cartouche + +radiobutton \- Create and manipulate radio-button widgets +@unnumberedsubsec Synopsis +@b{radiobutton}@i{ }@i{pathName }@r{?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +activeBackground bitmap font relief +activeForeground borderWidth foreground text +anchor cursor padX textVariable +background disabledForeground padX +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Radiobutton + + +@table @asis +@item @code{@b{:command}} +@flushright +Name=@code{"@b{command}@r{"} Class=@code{"}@b{Command}"} +@end flushright +@sp 1 + +Specifies a Tcl command to associate with the button. This command +is typically invoked when mouse button 1 is released over the button +window. The button's global variable (@b{:variable} option) will +be updated before the command is invoked. +@end table + + +@table @asis +@item @code{@b{:height}} +@flushright +Name=@code{"@b{height}@r{"} Class=@code{"}@b{Height}"} +@end flushright +@sp 1 + +Specifies a desired height for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in lines of text. +If this option isn't specified, the button's desired height is computed +from the size of the bitmap or text being displayed in it. +@end table + + +@table @asis +@item @code{@b{:selector}} +@flushright +Name=@code{"@b{selector}@r{"} Class=@code{"}@b{Foreground}"} +@end flushright +@sp 1 + +Specifies the color to draw in the selector when this button is +selected. +If specified as an empty string then no selector is drawn for the button. +@end table + + +@table @asis +@item @code{@b{:state}} +@flushright +Name=@code{"@b{state}@r{"} Class=@code{"}@b{State}"} +@end flushright +@sp 1 + +Specifies one of three states for the radio button: @b{normal}@r{, }@b{active}, +or @b{disabled}. In normal state the radio button is displayed using the +@b{foreground}@r{ and }@b{background} options. The active state is +typically used when the pointer is over the radio button. In active state +the radio button is displayed using the @b{activeForeground} and +@b{activeBackground} options. Disabled state means that the radio button +is insensitive: it doesn't activate and doesn't respond to mouse +button presses. In this state the @b{disabledForeground} and +@b{background} options determine how the radio button is displayed. +@end table + + +@table @asis +@item @code{@b{:value}} +@flushright +Name=@code{"@b{value}@r{"} Class=@code{"}@b{Value}"} +@end flushright +@sp 1 + +Specifies value to store in the button's associated variable whenever +this button is selected. Defaults to the name of the radio button. +@end table + + +@table @asis +@item @code{@b{:variable}} +@flushright +Name=@code{"@b{variable}@r{"} Class=@code{"}@b{Variable}"} +@end flushright +@sp 1 + +Specifies name of global variable to set whenever this button is +selected. Changes in this variable also cause the button to select +or deselect itself. +Defaults to the value @b{selectedButton}. +@end table + + +@table @asis +@item @code{@b{:width}} +@flushright +Name=@code{"@b{width}@r{"} Class=@code{"}@b{Width}"} +@end flushright +@sp 1 + +Specifies a desired width for the button. +If a bitmap is being displayed in the button then the value is in +screen units (i.e. any of the forms acceptable to @b{Tk_GetPixels}); +for text it is in characters. +If this option isn't specified, the button's desired width is computed +from the size of the bitmap or text being displayed in it. +@end table +@c @end cartouche + +@unnumberedsubsec Description + +The @b{radiobutton} command creates a new window (given by the +@i{pathName} argument) and makes it into a radiobutton widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the radio button such as its colors, font, +text, and initial relief. The @b{radiobutton} command returns its +@i{pathName} argument. At the time this command is invoked, +there must not exist a window named @i{pathName}, but +@i{pathName}'s parent must exist. + +A radio button is a widget +that displays a textual string or bitmap +and a diamond called a @i{selector}. +A radio button has +all of the behavior of a simple button: it can display itself in either +of three different ways, according to the @b{state} option; +it can be made to appear +raised, sunken, or flat; it can be made to flash; and it invokes +a Tcl command whenever mouse button 1 is clicked over the +check button. + +In addition, radio buttons can be @i{selected}. +If a radio button is selected then a special highlight appears +in the selector and a Tcl variable associated with the radio button +is set to a particular value. +If the radio button is not selected then the selector is drawn +in a different fashion. +Typically, several radio buttons share a single variable and the +value of the variable indicates which radio button is to be selected. +When a radio button is selected it sets the value of the variable to +indicate that fact; each radio button also monitors the value of +the variable and automatically selects and deselects itself when the +variable's value changes. +By default the variable @b{selectedButton} +is used; its contents give the name of the button that is +selected, or the empty string if no button associated with that +variable is selected. +The name of the variable for a radio button, +plus the variable to be stored into it, may be modified with options +on the command line or in the option database. By default a radio +button is configured to select itself on button clicks. + +@unnumberedsubsec A Radiobutton Widget's Arguments + +The @b{radiobutton} command creates a new Tcl command whose +name is @i{pathName}. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for radio-button widgets: + +@table @asis +@item @i{pathName }@b{:activate} +Change the radio button's state to @b{active} and redisplay the button +using its active foreground and background colors instead of normal +colors. +This command is ignored if the radio button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state active}'' instead. +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{radiobutton} +command. +@item @i{pathName }@b{:deactivate} +Change the radio button's state to @b{normal} and redisplay the button +using its normal foreground and background colors. +This command is ignored if the radio button's state is @b{disabled}. +This command is obsolete and will eventually be removed; +use ``@i{pathName }@b{:configure :state normal}'' instead. +@item @i{pathName }@b{:deselect} +Deselect the radio button: redisplay it without a highlight in +the selector and set the associated variable to an empty string. If +this radio button was not currently selected, then the command has +no effect. +@item @i{pathName }@b{:flash} +Flash the radio button. This is accomplished by redisplaying the radio button +several times, alternating between active and normal colors. At +the end of the flash the radio button is left in the same normal/active +state as when the command was invoked. +This command is ignored if the radio button's state is @b{disabled}. +@item @i{pathName }@b{:invoke} +Does just what would have happened if the user invoked the radio button +with the mouse: select the button and invoke +its associated Tcl command, if there is one. +The return value is the return value from the Tcl command, or an +empty string if there is no command associated with the radio button. +This command is ignored if the radio button's state is @b{disabled}. +@item @i{pathName }@b{:select} +Select the radio button: display it with a highlighted +selector and set the associated variable to the value corresponding +to this widget. + +@end table +@unnumberedsubsec Bindings + +Tk automatically creates class bindings for radio buttons that give them +the following default behavior: +@itemize @asis{} +@item +[1] +The radio button activates whenever the mouse passes over it and deactivates +whenever the mouse leaves the radio button. +@item +[2] +The radio button's relief is changed to sunken whenever mouse button 1 is +pressed over it, and the relief is restored to its original +value when button 1 is later released. +@item +[3] +If mouse button 1 is pressed over the radio button and later released over +the radio button, the radio button is invoked (i.e. it is selected +and the command associated with the button is invoked, +if there is one). However, if the mouse is not +over the radio button when button 1 is released, then no invocation occurs. +@end itemize + +The behavior of radio buttons can be changed by defining new bindings for +individual widgets or by redefining the class bindings. + +@unnumberedsubsec Keywords +radio button, widget +@node toplevel, , radiobutton, Widgets +@section toplevel +@c @cartouche + +toplevel \- Create and manipulate toplevel widgets +@unnumberedsubsec Synopsis +@b{toplevel}@i{ }@i{pathName }@r{?}@b{:screen }@i{screenName}@r{? ?}@b{:class }@i{className}@r{? ?}@i{options}? +@unnumberedsubsec Standard Options + + +@example +background geometry +borderWidth relief +@end example + + +@xref{options}, for more information. +@unnumberedsubsec Arguments for Toplevel +@c @end cartouche + +@unnumberedsubsec Description + +The @b{toplevel} command creates a new toplevel widget (given +by the @i{pathName} argument). Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the toplevel such as its background color +and relief. The @b{toplevel} command returns the +path name of the new window. + +A toplevel is similar to a frame except that it is created as a +top-level window: its X parent is the root window of a screen +rather than the logical parent from its path name. The primary +purpose of a toplevel is to serve as a container for dialog boxes +and other collections of widgets. The only features +of a toplevel are its background color and an optional 3-D border +to make the toplevel appear raised or sunken. + +Two special command-line options may be provided to the @b{toplevel} +command: @b{:class}@r{ and }@b{:screen}@r{. If }@b{:class} +is specified, then the new widget's class will be set to +@i{className}@r{ instead of }@b{Toplevel}. Changing the class of +a toplevel widget may be useful +in order to use a special class name in database options referring +to this widget and its children. The @b{:screen} option +may be used to place the window on a different screen than the +window's logical parent. Any valid screen name may be used, even +one associated with a different display. + +Note: @b{:class}@r{ and }@b{:screen} are handled +differently than other command-line options. They may not be specified +using the option database (these options must have been processed +before the new window has been created enough to use the option database; +in particular, the new class name will affect the lookup of options +in the database). In addition, @b{:class}@r{ and }@b{:screen} +may not be queried or changed using the @b{config} command described +below. However, the @b{winfo :class} command may be used to query +the class of a window, and @b{winfo :screen} may be used to query +its screen. + +@unnumberedsubsec A Toplevel Widget's Arguments + +The @b{toplevel} command creates a new Tcl command whose +name is the same as the path name of the toplevel's window. This +command may be used to invoke various +operations on the widget. It has the following general form: + +@example +@i{pathName option }@r{?}@i{arg arg ...}? +@end example + +@i{PathName} is the name of the command, which is the same as +the toplevel widget's path name. @i{Option}@r{ and the }@i{arg}s +determine the exact behavior of the command. The following +commands are possible for toplevel widgets: + +@table @asis +@item @i{pathName }@b{:configure}@r{ ?}@i{option}@r{? ?}@i{value option value ...}? +Query or modify the configuration options of the widget. +If no @i{option} is specified, returns a list describing all of +the available options for @i{pathName}@r{ (see }@b{Tk_ConfigureInfo} for +information on the format of this list). If @i{option} is specified +with no @i{value}, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no @i{option} is specified). If +one or more @i{option:value} pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +@i{Option}@r{ may have any of the values accepted by the }@b{toplevel} +command. + +@end table +@unnumberedsubsec Bindings + +When a new toplevel is created, it has no default event bindings: +toplevels are not intended to be interactive. + +@unnumberedsubsec Keywords +toplevel, widget diff --git a/install.sh b/install.sh new file mode 100644 index 0000000..2c212cc --- /dev/null +++ b/install.sh @@ -0,0 +1,250 @@ +#! /bin/sh +# +# install - install a program, script, or datafile +# This comes from X11R5 (mit/util/scripts/install.sh). +# +# Copyright 1991 by the Massachusetts Institute of Technology +# +# Permission to use, copy, modify, distribute, and sell this software and its +# documentation for any purpose is hereby granted without fee, provided that +# the above copyright notice appear in all copies and that both that +# copyright notice and this permission notice appear in supporting +# documentation, and that the name of M.I.T. not be used in advertising or +# publicity pertaining to distribution of the software without specific, +# written prior permission. M.I.T. makes no representations about the +# suitability of this software for any purpose. It is provided "as is" +# without express or implied warranty. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. +# + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" +mkdirprog="${MKDIRPROG-mkdir}" + +transformbasename="" +transform_arg="" +instcmd="$mvprog" +chmodcmd="$chmodprog 0755" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" +dir_arg="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -d) dir_arg=true + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + -t=*) transformarg=`echo $1 | sed 's/-t=//'` + shift + continue;; + + -b=*) transformbasename=`echo $1 | sed 's/-b=//'` + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + # this colon is to work around a 386BSD /bin/sh bug + : + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +else + true +fi + +if [ x"$dir_arg" != x ]; then + dst=$src + src="" + + if [ -d $dst ]; then + instcmd=: + else + instcmd=mkdir + fi +else + +# Waiting for this to be detected by the "$instcmd $src $dsttmp" command +# might cause directories to be created, which would be especially bad +# if $src (and thus $dsttmp) contains '*'. + + if [ -f $src -o -d $src ] + then + true + else + echo "install: $src does not exist" + exit 1 + fi + + if [ x"$dst" = x ] + then + echo "install: no destination specified" + exit 1 + else + true + fi + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + + if [ -d $dst ] + then + dst="$dst"/`basename $src` + else + true + fi +fi + +## this sed command emulates the dirname command +dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` + +# Make sure that the destination directory exists. +# this part is taken from Noah Friedman's mkinstalldirs script + +# Skip lots of stat calls in the usual case. +if [ ! -d "$dstdir" ]; then +defaultIFS=' +' +IFS="${IFS-${defaultIFS}}" + +oIFS="${IFS}" +# Some sh's can't handle IFS=/ for some reason. +IFS='%' +set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` +IFS="${oIFS}" + +pathcomp='' + +while [ $# -ne 0 ] ; do + pathcomp="${pathcomp}${1}" + shift + + if [ ! -d "${pathcomp}" ] ; + then + $mkdirprog "${pathcomp}" + else + true + fi + + pathcomp="${pathcomp}/" +done +fi + +if [ x"$dir_arg" != x ] +then + $doit $instcmd $dst && + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi +else + +# If we're going to rename the final executable, determine the name now. + + if [ x"$transformarg" = x ] + then + dstfile=`basename $dst` + else + dstfile=`basename $dst $transformbasename | + sed $transformarg`$transformbasename + fi + +# don't allow the sed command to completely eliminate the filename + + if [ x"$dstfile" = x ] + then + dstfile=`basename $dst` + else + true + fi + +# Make a temp file name in the proper directory. + + dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + + $doit $instcmd $src $dsttmp && + + trap "rm -f ${dsttmp}" 0 && + +# and set any options; do chmod last to preserve setuid bits + +# If any of these fail, we abort the whole thing. If we want to +# ignore errors from any of these, just make sure not to ignore +# errors from the above "$doit $instcmd $src $dsttmp" command. + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && + +# Now rename the file to the real destination. + + $doit $rmcmd -f $dstdir/$dstfile && + $doit $mvcmd $dsttmp $dstdir/$dstfile + +fi && + + +exit 0 diff --git a/japitest.lsp b/japitest.lsp new file mode 100644 index 0000000..0db67f0 --- /dev/null +++ b/japitest.lsp @@ -0,0 +1,369 @@ +;;; +;;; Japi is a cross-platform, easy to use (rough and ready) Java based GUI library +;;; Download a library and headers for your platform, and get the C examples +;;; and documentation from: +;;; +;;; http://www.japi.de/ +;;; +;;; This file shows how to use some of the available functions. You may assume +;;; that the only functions tested so far in the binding are those which appear +;;; below, as this file doubles as the test program. The binding is so simple +;;; however that so far no binding (APART FROM J_PRINT) has gone wrong of those +;;; tested so far! +;;; +;;; +;;; HOW TO USE THIS FILE +;;; +;;; (compile-file "c:/cvs/gcl/japitest.lsp") (load "c:/cvs/gcl/japitest.o") +;;; +;;; Requires either "java" or "jre" in the path to work. +;;; + +(in-package :japi-primitives) + +;; Start up the Japi server (needs to find either "java" or "jre" in your path +(defmacro with-server ((app-name debug-level) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(if (= 0 (jpr::j_start)) + (format t (format nil "~S can't connect to the Japi GUI server." ,app-name)) + (progn + (j_setdebug ,debug-level) + ,@ds + (unwind-protect + (progn ,@b) + (j_quit)))))) + +;; Use a frame and clean up afterwards even if trouble ensues +(defmacro with-frame ((frame-var-name title) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,frame-var-name (j_frame ,title))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,frame-var-name))))) + +;; Use a canvas and clean up afterwards even if trouble ensues +(defmacro with-canvas ((canvas-var-name frame-obj x-size y-size) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,canvas-var-name (j_canvas ,frame-obj ,x-size ,y-size))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,canvas-var-name))))) + +;; Use a text area and clean up afterwards even if trouble ensues +(defmacro with-text-area ((text-area-var-name panel-obj x-size y-size) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,text-area-var-name (j_textarea ,panel-obj ,x-size ,y-size))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,text-area-var-name))))) + +;; Use a pulldown menu bar and clean up afterwards even if trouble ensues +(defmacro with-menu-bar ((bar-var-name frame-obj) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,bar-var-name (j_menubar ,frame-obj))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,bar-var-name))))) + +;; Add a pulldown menu and clean up afterwards even if trouble ensues +(defmacro with-menu ((menu-var-name bar-obj title) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,menu-var-name (j_menu ,bar-obj ,title))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,menu-var-name))))) + +;; Add a pulldown menu item and clean up afterwards even if trouble ensues +(defmacro with-menu-item ((item-var-name menu-obj title) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,item-var-name (j_menuitem ,menu-obj ,title))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,item-var-name))))) + +;; Add a mouse listener and clean up afterwards even if trouble ensues +(defmacro with-mouse-listener ((var-name obj type) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,var-name (j_mouselistener ,obj ,type))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,var-name))))) + +;; Use a panel and clean up afterwards even if trouble ensues +(defmacro with-panel ((panel-var-name frame-obj) . body) + (multiple-value-bind (ds b) + (si::find-declarations body) + `(let ((,panel-var-name (j_panel ,frame-obj))) + ,@ds + (unwind-protect + (progn ,@b) + (j_dispose ,panel-var-name))))) + + +;; Run a five second frame in a Japi server +(with-server ("GCL Japi library test GUI 1" 0) + (with-frame (frame "Five Second Blank Test Frame") + (j_show frame) + (j_sleep 5000))) + +;; Get a pointer to an array of ints +(defCfun "static void* inta_ptr(object s)" 0 + " return(s->fixa.fixa_self);") +(defentry inta-ptr (object) (int "inta_ptr")) + +;; Draw function +(defun drawgraphics (drawable xmin ymin xmax ymax) + (let* ((fntsize 10) + (tmpstrx (format nil "XMax = ~D" xmax)) + (tmpstry (format nil "YMax = ~D" ymax)) + (tmpstrwidx (j_getstringwidth drawable tmpstrx))) + (j_setfontsize drawable fntsize) + (j_setnamedcolor drawable J_RED) + + (j_drawline drawable xmin ymin (- xmax 1) (- ymax 1)) + (j_drawline drawable xmin (- ymax 1) (- xmax 1) ymin) + (j_drawrect drawable xmin ymin (- xmax xmin 1) (- ymax xmin 1)) + + (j_setnamedcolor drawable J_BLACK) + (j_drawline drawable xmin (- ymax 30) (- xmax 1) (- ymax 30)) + (j_drawstring drawable (- (/ xmax 2) (/ tmpstrwidx 2)) (- ymax 40) tmpstrx) + + (j_drawline drawable (+ xmin 30) ymin (+ xmin 30) (- ymax 1)) + (j_drawstring drawable (+ xmin 50) 40 tmpstry) + + (j_setnamedcolor drawable J_MAGENTA) + (loop for i from 1 to 10 + do (j_drawoval drawable + (+ xmin (/ (- xmax xmin) 2)) + (+ ymin (/ (- ymax ymin) 2)) + (* (/ (- xmax xmin) 20) i) + (* (/ (- ymax ymin) 20) i))) + + (j_setnamedcolor drawable J_BLUE) + (let ((y ymin) + (teststr "JAPI Test Text")) + (loop for i from 5 to 21 do + (j_setfontsize drawable i) + (let ((x (- xmax (j_getstringwidth drawable teststr)))) + (setf y (+ y (j_getfontheight drawable))) + (j_drawstring drawable x y teststr)))))) + +;; Run some more extensive tests +(with-server + ("GCL Japi library test GUI 2" 0) + (with-frame + (frame "Draw") + (j_show frame) + (let ((alert (j_messagebox frame "Two second alert box" "label"))) + (j_sleep 2000) + (j_dispose alert)) + (let ((result1 (j_alertbox frame "label1" "label2" "OK")) + (result2 (j_choicebox2 frame "label1" "label2" "Yes" "No")) + (result3 (j_choicebox3 frame "label1" "label2" "Yes" "No" "Cancel"))) + (format t "Requestor results were: ~D, ~D, ~D~%" result1 result2 result3)) + (j_setborderlayout frame) + (with-menu-bar + (menubar frame) + (with-menu + (file menubar "File") + (with-menu-item + (print file "Print") + (with-menu-item + (save file "Save BMP") + (with-menu-item + (quit file "Quit") + (with-canvas + (canvas frame 400 600) + (j_pack frame) + (drawgraphics canvas 0 0 (j_getwidth canvas) (j_getheight canvas)) + (j_show frame) + (do ((obj (j_nextaction) (j_nextaction))) + ((or (= obj frame) (= obj quit)) t) + (when (= obj canvas) + (j_setnamedcolorbg canvas J_WHITE) + (drawgraphics canvas 10 10 + (- (j_getwidth canvas) 10) + (- (j_getheight canvas) 10))) + (when (= obj print) + (let ((printer (j_printer frame))) + (when (> 0 printer) + (drawgraphics printer 40 40 + (- (j_getwidth printer) 80) + (- (j_getheight printer) 80)) + (j_print printer)))) + (when (= obj save) + (let ((image (j_image 600 800))) + (drawgraphics image 0 0 600 800) + (when (= 0 (j_saveimage image "test.bmp" J_BMP)) + (j_alertbox frame "Problems" "Can't save the image" "OK"))))))))))))) +;; Try some mouse handling +(with-server + ("GCL Japi library test GUI 3" 0) + (with-frame + (frame "Move and drag the mouse") + (j_setsize frame 430 240) + (j_setnamedcolorbg frame J_LIGHT_GRAY) + (with-canvas + (canvas1 frame 200 200) + (with-canvas + (canvas2 frame 200 200) + (j_setpos canvas1 10 30) + (j_setpos canvas2 220 30) + (with-mouse-listener + (pressed canvas1 J_PRESSED) + (with-mouse-listener + (dragged canvas1 J_DRAGGED) + (with-mouse-listener + (released canvas1 J_RELEASED) + (with-mouse-listener + (entered canvas2 J_ENTERERD) + (with-mouse-listener + (moved canvas2 J_MOVED) + (with-mouse-listener + (exited canvas2 J_EXITED) + (j_show frame) + ;; Allocate immovable storage for passing data back from C land. + ;; Uses the GCL only make-array keyword :static + (let* ((xa (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) + (ya (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) + (pxa (inta-ptr xa)) + (pya (inta-ptr ya)) + (x 0) + (y 0) + (get-mouse-xy (lambda (obj) + (progn (j_getmousepos obj pxa pya) + (setf x (aref xa 0)) + (setf y (aref ya 0))))) + (startx 0) + (starty 0)) + (do ((obj (j_nextaction) (j_nextaction))) + ((= obj frame) t) + (when (= obj pressed) + (funcall get-mouse-xy pressed) + (setf startx x) + (setf starty y)) + (when (= obj dragged) + (funcall get-mouse-xy dragged) + (j_drawrect canvas1 startx starty (- x startx) (- y starty))) + (when (= obj released) + (funcall get-mouse-xy released) + (j_drawrect canvas1 startx starty (- x startx) (- y starty))) + (when (= obj entered) + (funcall get-mouse-xy entered) + (setf startx x) + (setf starty y)) + (when (= obj moved) + (funcall get-mouse-xy moved) + (j_drawline canvas2 startx starty x y)) + (setf startx x) + (setf starty y) + (when (= obj exited) + (funcall get-mouse-xy exited) + (j_drawline canvas2 startx starty x y)))))))))))))) + +;; Text editor demo +(with-server + ("GCL Japi library test text editor" 0) + (with-frame + (frame "A simple editor") + (j_setgridlayout frame 1 1) + (with-panel + (panel frame) + (j_setgridlayout panel 1 1) + (with-menu-bar + (menubar frame) + (with-menu + (file-mi menubar "File") + (with-menu-item + (new-mi file-mi "New") + (with-menu-item + (save-mi file-mi "Save") + (j_seperator file-mi) + (with-menu-item + (quit-mi file-mi "Quit") + + (with-menu + (edit-mi menubar "Edit") + (with-menu-item + (select-all-mi edit-mi "Select All") + (j_seperator edit-mi) + (with-menu-item + (cut-mi edit-mi "Cut") + (with-menu-item + (copy-mi edit-mi "Copy") + (with-menu-item + (paste-mi edit-mi "Paste") + + (with-text-area + (text panel 15 4) + (j_setfont text J_DIALOGIN J_BOLD 18) + (let ((new-text (format nil "JAPI (Java Application~%Programming Interface)~%a platform and language~%independent API"))) + (j_settext text new-text) + (j_show frame) + (j_pack frame) + (j_setrows text 4) + (j_setcolumns text 15) + (j_pack frame) + ;; Allocate immovable storage for passing data back from C land. + ;; Uses the GCL only make-array keyword :static + (let* ((xa (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) + (ya (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) + (pxa (inta-ptr xa)) + (pya (inta-ptr ya)) + (x 0) + (y 0) + (get-mouse-xy (lambda (obj) + (progn (j_getmousepos obj pxa pya) + (setf x (aref xa 0)) + (setf y (aref ya 0))))) + (startx 0) + (starty 0) + (selstart 0) + (selend 0) + (text-buffer (make-array 64000 :initial-element 0 :element-type 'character :static t)) +; (text-buffer (make-string 64000 :initial-element #\0)) + (p-text-buffer (inta-ptr text-buffer))) + (do ((obj (j_nextaction) (j_nextaction))) + ((or (= obj frame) (= obj quit-mi))t) + (when (= obj panel) + (format t "Size changed to ~D rows ~D columns~%" (j_getrows text) (j_getcolumns text)) + (format t "Size changed to ~D x ~D pixels~%" (j_getwidth text) (j_getheight text))) + (when (= obj text) (format t "Text changed (len=~D)~%" (j_getlength text) )) + (when (= obj new-mi) (j_settext new-text)) + (when (= obj save-mi) (j_gettext text text-buffer)) + (when (= obj select-all-mi) (j_selectall text)) + (when (or (= obj cut-mi) + (= obj copy-mi) + (= obj paste-mi)) + (setf selstart (1- (j_getselstart text))) + (setf selend (1- (j_getselend text)))) + (when (= obj cut-mi) + (j_getseltext text p-text-buffer) + (j_delete text (1- (j_getselstart text)) (1- (j_getselend text))) + (setf selend selstart)) + (when (= obj copy-mi) + (j_getseltext text p-text-buffer)) + (when (= obj paste-mi) + (if (= selstart selend) + (j_inserttext text p-text-buffer (1- (j_getcurpos text))) + (j_replacetext text p-text-buffer (1- (j_getselstart text)) (1- (j_getselend text)))) + )))))))))))))))))) + + + + \ No newline at end of file diff --git a/lsp/.gitignore b/lsp/.gitignore new file mode 100644 index 0000000..cd29327 --- /dev/null +++ b/lsp/.gitignore @@ -0,0 +1,3 @@ +*.c +*.h +gcl_recompile.lsp diff --git a/lsp/dbind.lisp b/lsp/dbind.lisp new file mode 100755 index 0000000..e0d2505 --- /dev/null +++ b/lsp/dbind.lisp @@ -0,0 +1,15 @@ +(in-package 'si) + +;(defun joe () +; (dbind ((a) b) (foo) (print (list a b)))) + +(defmacro destructuring-bind + (al val &body body &aux *dl* (*key-check* nil) + (*arg-check* nil) (sym (gensym))) + (dm-vl al sym t) + `(compiler::stack-let + ((,sym (cons nil ,val))) + (let* (,@ (nreverse *dl*)) + ,@body))) + + diff --git a/lsp/dummy.lisp b/lsp/dummy.lisp new file mode 100755 index 0000000..8b13789 --- /dev/null +++ b/lsp/dummy.lisp @@ -0,0 +1 @@ + diff --git a/lsp/fasd.lisp b/lsp/fasd.lisp new file mode 100755 index 0000000..ad0a89c --- /dev/null +++ b/lsp/fasd.lisp @@ -0,0 +1,151 @@ +(in-package 'si) + +(require "FASDMACROS" "../cmpnew/fasdmacros.lsp") +;; (test '(a (1)) 2 12.0) --> ((a (1)) 2 12.0) + +(defmacro dprint (x) + `(if (and (boundp 'debug) debug) + (format t "~%The value of ~a is ~s" ',x ,x))) + + + +(defun keep (x) (setq sil x)) +(defun test (&rest l &aux tab) + (with-open-file (st "/tmp/foo.l" + :direction :output ) + (let* ((fd (open-fasd st :output nil (setq tab (make-hash-table :test 'eq))))) + (declare (special *fd*)) + (si::find-sharing-top l tab) +; (preprocess l tab) + (sloop::sloop for v in l + do + (write-fasd-top v fd) + finally (close-fasd fd)))) + (test-in)) + +(defun preprocess1(lis table) + (cond ((symbolp lis) + (and lis + (let ((tem (gethash lis table))) + (cond (tem + (if (< (the fixnum tem) 0) + (setf (gethash lis table) (the fixnum (+ (the fixnum tem) -1))))) + (t (setf (gethash lis table) -1)))))) + ((consp lis) + (preprocess1 (car lis) table) + (preprocess1 (cdr lis) table)) + ((and (arrayp lis) + (eq (array-element-type lis) t)) + (sloop::sloop for i below (length lis) + do (preprocess1 (aref (the (array t) lis) i) table))) + ((and (arrayp lis) + (eq (array-element-type lis) t)) + (sloop::sloop for i below (length lis) + do (preprocess1 (aref (the (array t) lis) i) table))) + (t nil))) + +(defun preprocess (lis table &aux freq) + (preprocess1 lis table) + (sloop:sloop for (ke val) in-table table + with m = 0 declare (fixnum m) + do ;(print (list ke val)) + (cond((> (the fixnum val) 0) + (SETQ m (the fixnum (+ 1 m)))) + ((< (the fixnum val) -1) + (remhash ke table) + (push (cons val ke) freq))) + finally (sloop::loop-return + (sort freq '> :key 'car )))) + +(defun test-in () + (with-open-file (st "/tmp/foo.l" :direction :input) + (let ((fdin (open-fasd st :input (setq eof '(nil)) (keep (make-array 10))))) + (sloop while (not (eq eof (setq tem (read-fasd-top fdin)))) + collect tem + finally + (dprint fdin) + (close-fasd fdin))))) + +(defun try-write (file &aux (tab (make-hash-table :test 'eq)) (eof '(nil))) + (with-open-file (st file) + (with-open-file (st1 "/tmp/foo.l" :direction :output) + (sloop while (not (eq eof (setq tem (read st nil eof)))) with fd + collect (file-position st1) + do(clrhash tab) + + (setq fd (open-fasd st1 :output nil tab)) +; (let ((prp (preprocess tem tab))) +; (dprint prp)) + (write-fasd-top tem fd) + (close-fasd fd) + (dprint tab) + )))) +(defvar *differed* nil) + +(defun try-read (file pos &aux (tab (make-array 10)) (eof '(nil))) + (with-open-file (st file) + (with-open-file (st1 "/tmp/foo.l") + (sloop while (not (eq eof (setq tem (read st nil eof)))) with fd with re + for u in pos + do (file-position st1 u) + (setq fd (open-fasd st1 :input eof tab)) + (sloop::sloop for i below (length tab) do (setf (aref (the (array (t)) tab) i) nil)) + (setq re (read-fasd-top fd)) + (dprint re) + (unless (equalp tem re) + (push (list tem re) *differed*)) + ; (assert (eq eof (read-fasd-top fd))) + (close-fasd fd))))) + +(defun try (file) + (let ((pos (try-write file))) + (try-read file pos) + (print file) + (system (format nil "cat ~a | wc ; cat /tmp/foo.l | wc " (namestring file))) + )) + +(defvar *table* (make-hash-table :test 'eq)) +(defun do-share (x) + (si::find-sharing x *table*)) + + + + +(defun read-data-file (file) + (let ((pack-ops)) + (set-dispatch-macro-character #\# #\! + #'(lambda (st a b ) (setq pack-ops (read st nil nil) ))) + (with-open-file (st file) + (let ((tem (read st nil nil))) + (list pack-ops tem))))) + + +(defun write-out-data (lis fil) + (with-open-file (st fil :direction :output) + (let ((fd (open-fasd st :output nil (setq tab (make-hash-table :test 'eq))))) + (find-sharing-top lis (fasd-table fd)) + (write-fasd-top (car lis) fd) + (write-fasd-top (second lis) fd) +; (close-fasd fd) + fd))) + +;; To convert an ascii .data file to a fasd one. +;(setq bil (si::read-data-file "vmlisp.data") her nil) +;(SI::WRITE-OUT-DATA1 (SECOND BIL) (FIRST BIL) "/tmp/foo.l") +(defun write-out-data1 (data-vec pack-ops fil) + (with-open-file (st fil :direction :output) + (let ((compiler::*data* (list data-vec nil pack-ops)) + (compiler::*compiler-output-data* st) + (compiler::*fasd-data* (list (open-fasd st :output nil nil)))) + (compiler::wt-fasd-data-file) + (car compiler::*fasd-data*)))) + + + + + + +;(setq dirs (directory "/public/spad/libraries/A*/index.KAF*")) +;(mapcar 'try dirs) + + diff --git a/lsp/fast-mv.lisp b/lsp/fast-mv.lisp new file mode 100755 index 0000000..a4d1b0b --- /dev/null +++ b/lsp/fast-mv.lisp @@ -0,0 +1,41 @@ +(in-package 'compiler) + +;; Author W. Schelter + +;; Using fast-values in place of values, and fast-multiple-setq +;; allow functions to still be declared to have only 1 value, while +;; in effect returning several. This allows a great speed up in +;; returning extra values. Eventually we may incorporate this system +;; to allow similar code to be put out where multiple values are proclaimed +;; for the function. + +;; The primitives set-mv and mv-ref provide access to 10 storage places +;; directly by address, without the indirection of going through an array +;; or symbol. + +;; Sample usage: + +;;(proclaim '(function goo-fast-mv () t)) +;;(proclaim '(function foo-fast-mv (t) t)) +;; +;;(defun foo-fast-mv (n) +;; (let (x y z) +;; (sloop for i below n +;; do (fast-multiple-value-setq (x y z) (goo-fast-mv))) +;; (list x y z))) +;; +;;(defun goo-fast-mv () (fast-values 1 2 7)) + +(defmacro fast-values (a &rest l) + (or (< (length l) 10) (error "too many values")) + `(prog1 ,a ,@ (sloop::sloop for v in l + for i below 10 + collect `(si::set-mv ,i ,v)))) + +(defmacro fast-multiple-value-setq ((x &rest l) form) + (or (< (length l) 10) (error "too many values")) + `(prog1 (setq ,x ,form) + ,@ (sloop::sloop for i below 10 + for v in l + collect `(setq ,v (si::mv-ref ,i))))) + diff --git a/lsp/gcl_arraylib.lsp b/lsp/gcl_arraylib.lsp new file mode 100755 index 0000000..b3dd480 --- /dev/null +++ b/lsp/gcl_arraylib.lsp @@ -0,0 +1,302 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; arraylib.lsp +;;;; +;;;; array routines + + +(in-package :si) + +(proclaim '(optimize (safety 2) (space 3))) + +(defvar *baet-hash* (make-hash-table :test 'equal)) +(defun best-array-element-type (type &aux + (tps '(character bit signed-char unsigned-char signed-short unsigned-short + fixnum short-float long-float t))) + (if type + (or (car (member type tps)) + (gethash type *baet-hash*) + (setf (gethash type *baet-hash*) (car (member type tps :test 'subtypep)))) t)) + +(defun upgraded-array-element-type (type &optional environment) + (declare (ignore environment)) + (best-array-element-type type)) + +;(defun array-displacement (array) +; (let ((x (si:array-displacement1 array))) +; (values (car x) (cdr x))) +; ) + +(defun make-array (dimensions + &key (element-type t) + (initial-element nil) + (initial-contents nil initial-contents-supplied-p) + adjustable fill-pointer + displaced-to (displaced-index-offset 0) + static) + (when (integerp dimensions) (setq dimensions (list dimensions))) + (setq element-type (best-array-element-type element-type)) + (cond ((= (length dimensions) 1) + (let ((x (si:make-vector element-type (car dimensions) + adjustable fill-pointer + displaced-to displaced-index-offset + static initial-element))) + (when initial-contents-supplied-p + (do ((n (car dimensions)) + (lic (listp initial-contents) lic) + (ic initial-contents (if lic (cdr ic) ic)) + (i 0 (1+ i))) + ((>= i n)) + (declare (fixnum n i)) + (si:aset x i (if lic (car ic) (aref ic i))))) + x)) + (t + (let ((x + (make-array1 + (the fixnum(get-aelttype element-type)) + static initial-element + displaced-to (the fixnum displaced-index-offset) + dimensions))) + (if fill-pointer (error "fill pointer for 1 dimensional arrays only")) + (unless (member 0 dimensions) + (when initial-contents-supplied-p + (do ((cursor + (make-list (length dimensions) + :initial-element 0))) + (nil) + (declare (:dynamic-extent cursor)) + (aset-by-cursor x + (sequence-cursor initial-contents + cursor) + cursor) + (when (increment-cursor cursor dimensions) + (return nil))))) + x)))) + +(defun increment-cursor (cursor dimensions) + (if (null cursor) + t + (let ((carry (increment-cursor (cdr cursor) (cdr dimensions)))) + (if carry + (cond ((>= (the fixnum (1+ (the fixnum (car cursor)))) + (the fixnum (car dimensions))) + (rplaca cursor 0) + t) + (t + (rplaca cursor + (the fixnum (1+ (the fixnum (car cursor))))) + nil)) + nil)))) + + +(defun sequence-cursor (sequence cursor) + (if (null cursor) + sequence + (sequence-cursor (elt sequence (the fixnum (car cursor))) + (cdr cursor)))) + + +(defun vector (&rest objects &aux (l (list (length objects)))) + (declare (:dynamic-extent objects l)) + (make-array l + :element-type t + :initial-contents objects)) + + +(defun array-dimensions (array) + (do ((i (array-rank array)) + (d nil)) + ((= i 0) d) + (setq i (1- i)) + (setq d (cons (array-dimension array i) d)))) + + +(defun array-in-bounds-p (array &rest indices &aux (r (array-rank array))) + (declare (:dynamic-extent indices)) + (when (/= r (length indices)) + (error "The rank of the array is ~R,~%~ + ~7@Tbut ~R ~:*~[indices are~;index is~:;indices are~] ~ + supplied." + r (length indices))) + (do ((i 0 (1+ i)) + (s indices (cdr s))) + ((>= i r) t) + (when (or (< (car s) 0) + (>= (car s) (array-dimension array i))) + (return nil)))) + + +(defun array-row-major-index (array &rest indices) + (declare (:dynamic-extent indices)) + (do ((i 0 (1+ i)) + (j 0 (+ (* j (array-dimension array i)) (car s))) + (s indices (cdr s))) + ((null s) j))) + + +(defun bit (bit-array &rest indices) + (declare (:dynamic-extent indices)) + (apply #'aref bit-array indices)) + + +(defun sbit (bit-array &rest indices) + (declare (:dynamic-extent indices)) + (apply #'aref bit-array indices)) + + +(defun bit-and (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-and bit-array1 bit-array2 result-bit-array)) + + +(defun bit-ior (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-ior bit-array1 bit-array2 result-bit-array)) + + +(defun bit-xor (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-xor bit-array1 bit-array2 result-bit-array)) + + +(defun bit-eqv (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-eqv bit-array1 bit-array2 result-bit-array)) + + +(defun bit-nand (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-nand bit-array1 bit-array2 result-bit-array)) + + +(defun bit-nor (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-nor bit-array1 bit-array2 result-bit-array)) + + +(defun bit-andc1 (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-andc1 bit-array1 bit-array2 result-bit-array)) + + +(defun bit-andc2 (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-andc2 bit-array1 bit-array2 result-bit-array)) + + +(defun bit-orc1 (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-orc1 bit-array1 bit-array2 result-bit-array)) + + +(defun bit-orc2 (bit-array1 bit-array2 &optional result-bit-array) + (bit-array-op boole-orc2 bit-array1 bit-array2 result-bit-array)) + + +(defun bit-not (bit-array &optional result-bit-array) + (bit-array-op boole-c1 bit-array bit-array result-bit-array)) + + +(defun vector-push (new-element vector) + (let ((fp (fill-pointer vector))) + (declare (fixnum fp)) + (cond ((< fp (the fixnum (array-dimension vector 0))) + (si:aset vector fp new-element) + (si:fill-pointer-set vector (the fixnum (1+ fp))) + fp) + (t nil)))) + + +(defun vector-push-extend (new-element vector &optional extension) + (let ((fp (fill-pointer vector))) + (declare (fixnum fp)) + (cond ((< fp (the fixnum (array-dimension vector 0))) + (si:aset vector fp new-element) + (si:fill-pointer-set vector (the fixnum (1+ fp))) + fp) + (t + (adjust-array vector + (list (+ (array-dimension vector 0) + (or extension + (if (> (array-dimension vector 0) 0) + (array-dimension vector 0) + 5)))) + :element-type (array-element-type vector) + :fill-pointer fp) + (si:aset vector fp new-element) + (si:fill-pointer-set vector (the fixnum (1+ fp))) + fp)))) + + +(defun vector-pop (vector) + (let ((fp (fill-pointer vector))) + (declare (fixnum fp)) + (when (= fp 0) + (error "The fill pointer of the vector ~S zero." vector)) + (si:fill-pointer-set vector (the fixnum (1- fp))) + (aref vector (the fixnum (1- fp))))) + + +(defun maset (array x dim &optional (cx (cons x -1)) (cur (make-list (length dim) :initial-element 0)) (ind cur)) + (declare (dynamic-extent cur)) + (cond (dim (dotimes (i (pop dim)) (setf (car cur) i) (maset array x dim cx (cdr cur) ind))) + ((incf (cdr cx)) + (when (apply 'array-in-bounds-p array ind) + (row-major-aset (apply 'aref array ind) (car cx) (cdr cx)))))) + +(defun adjust-array (array new-dimensions + &key element-type + initial-element + (initial-contents nil initial-contents-supplied-p) + fill-pointer + displaced-to + (displaced-index-offset 0) + (static (staticp array)) + &aux (fill-pointer (or fill-pointer (when (array-has-fill-pointer-p array) (fill-pointer array))))) + + (let ((x (if initial-contents-supplied-p + (make-array new-dimensions + :adjustable t + :static static + :element-type (array-element-type array) + :fill-pointer fill-pointer + :initial-contents initial-contents + :displaced-to displaced-to + :displaced-index-offset displaced-index-offset) + (make-array new-dimensions + :adjustable t + :static static + :element-type (array-element-type array) + :fill-pointer fill-pointer + :initial-element initial-element + :displaced-to displaced-to + :displaced-index-offset displaced-index-offset)))) + + (unless (or displaced-to initial-contents-supplied-p) + + (cond ((or (atom new-dimensions) + (null (cdr new-dimensions)) + (when (equal (cdr new-dimensions) (cdr (array-dimensions array))) + (or (not (eq element-type 'bit)) + (eql 0 (the fixnum (mod (the fixnum (car (last new-dimensions))) char-size)))))) + (copy-array-portion array x 0 0 (min (array-total-size x) (array-total-size array)))) + ((maset array x new-dimensions)))) + + (si:replace-array array x) + + (when fill-pointer + (setf (fill-pointer array) (if (eq fill-pointer t) (array-total-size array) fill-pointer))) + array)) + + + + + diff --git a/lsp/gcl_assert.lsp b/lsp/gcl_assert.lsp new file mode 100755 index 0000000..cf1ecfc --- /dev/null +++ b/lsp/gcl_assert.lsp @@ -0,0 +1,81 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; assert.lsp + + +(in-package :si) + +(defun read-evaluated-form nil + (format *query-io* "~&type a form to be evaluated:~%") + (list (eval (read *query-io*)))) + +(defun check-type-symbol (symbol value type &optional type-string + &aux (type-string (when type-string (concatenate 'string ": need a " type-string)))) + (restart-case + (cerror "Check type again." 'type-error :datum value :expected-type type) + (store-value (v) + :report (lambda (stream) (format stream "Supply a new value of ~s. ~a" symbol (or type-string ""))) + :interactive read-evaluated-form + (setf value v))) + (if (typep value type) value (check-type-symbol symbol value type type-string))) + +(defmacro check-type (place typespec &optional string) + (declare (optimize (safety 2))) + `(progn (,(if (symbolp place) 'setq 'setf) ,place + (the ,typespec (if (typep ,place ',typespec) ,place (check-type-symbol ',place ,place ',typespec ',string)))) nil)) + + +(defmacro assert (test-form &optional places string &rest args) + `(do nil;(*print-level* 4) (*print-length* 4) + (,test-form nil) + ,(if string + `(cerror "" ,string ,@args) + `(cerror "" "The assertion ~:@(~S~) is failed." ',test-form)) + ,@(mapcan (lambda (place) + `((format *error-output* + "Please input the new value for the place ~:@(~S~): " + ',place) + (finish-output *error-output*) + (setf ,place (read)))) places))) + +(defmacro typecase (keyform &rest clauses &aux (key (if (symbolp keyform) keyform (sgen "TYPECASE")))) + (declare (optimize (safety 2))) + (labels ((l (x &aux (c (pop x))(tp (pop c))(fm (if (cdr c) (cons 'progn c) (car c)))(y (when x (l x)))) + (if (or (eq tp t) (eq tp 'otherwise)) fm `(if (typep ,key ',tp) ,fm ,y)))) + (let ((x (l clauses))) + (if (eq key keyform) x `(let ((,key ,keyform)) ,x))))) + +(defmacro ctypecase (keyform &rest clauses &aux (key (sgen "CTYPECASE"))) + (declare (optimize (safety 2))) +; (check-type clauses (list-of proper-list)) + `(do nil (nil) + (typecase ,keyform + ,@(mapcar (lambda (l) + `(,(car l) (return (progn ,@(subst key keyform (cdr l)))))) + clauses)) + (check-type ,keyform (or ,@(mapcar 'car clauses))))) + +(defmacro etypecase (keyform &rest clauses &aux (key (if (symbolp keyform) keyform (sgen "ETYPECASE")))) + (declare (optimize (safety 2))) +; (check-type clauses (list-of proper-list)) + (let ((tp `(or ,@(mapcar 'car clauses)))) + `(let ((,key ,keyform)) (typecase ,key ,@clauses (t (error 'type-error :datum ,key :expected-type ',tp)))))) + + diff --git a/lsp/gcl_auto.lsp b/lsp/gcl_auto.lsp new file mode 100755 index 0000000..b6e1f6a --- /dev/null +++ b/lsp/gcl_auto.lsp @@ -0,0 +1,217 @@ +(in-package :si) +;;; Autoloaders. + + +;;; DEFAUTOLOAD definitions. for lsp directory files normally loaded. +(if (fboundp 'abs) (push :numlib *features*)) +;;hack to avoid interning all the :symbols if the files are loaded.. +#-numlib +(progn +(autoload 'abs '|numlib|) +(autoload 'acos '|numlib|) +(autoload 'acosh '|numlib|) +(autoload 'adjust-array '|arraylib|) +(autoload 'apropos '|packlib|) +(autoload 'apropos-list '|packlib|) +(autoload 'array-dimensions '|arraylib|) +(autoload 'array-in-bounds-p '|arraylib|) +(autoload 'array-row-major-index '|arraylib|) +(autoload 'asin '|numlib|) +(autoload 'asinh '|numlib|) +(autoload 'atanh '|numlib|) +(autoload 'best-array-element-type '|arraylib|) +(autoload 'bit '|arraylib|) +(autoload 'bit-and '|arraylib|) +(autoload 'bit-andc1 '|arraylib|) +(autoload 'bit-andc2 '|arraylib|) +(autoload 'bit-eqv '|arraylib|) +(autoload 'bit-ior '|arraylib|) +(autoload 'bit-nand '|arraylib|) +(autoload 'bit-nor '|arraylib|) +(autoload 'bit-not '|arraylib|) +(autoload 'bit-orc1 '|arraylib|) +(autoload 'bit-orc2 '|arraylib|) +(autoload 'bit-xor '|arraylib|) +(autoload 'byte '|numlib|) +(autoload 'byte-position '|numlib|) +(autoload 'byte-size '|numlib|) +(autoload 'cis '|numlib|) +(autoload 'coerce '|predlib|) +(autoload 'compile-file '|loadcmp|) +(autoload 'compile '|loadcmp|) +(autoload 'disassemble '|loadcmp|) +(autoload 'concatenate '|seq|) +(autoload 'cosh '|numlib|) +(autoload 'count '|seqlib|) +(autoload 'count-if '|seqlib|) +(autoload 'count-if-not '|seqlib|) +(autoload 'decode-universal-time '|mislib|) +(autoload 'delete '|seqlib|) +(autoload 'delete-duplicates '|seqlib|) +(autoload 'delete-if '|seqlib|) +(autoload 'delete-if-not '|seqlib|) +(autoload 'deposit-field '|numlib|) +(autoload 'describe '|describe|) +(autoload 'dpb '|numlib|) +(autoload 'dribble '|iolib|) +(autoload 'encode-universal-time '|mislib|) +(autoload 'every '|seq|) +(autoload 'fceiling '|numlib|) +(autoload 'ffloor '|numlib|) +(autoload 'fill '|seqlib|) +(autoload 'find '|seqlib|) +(autoload 'find-all-symbols '|packlib|) +(autoload 'find-if '|seqlib|) +(autoload 'find-if-not '|seqlib|) +(autoload 'fround '|numlib|) +(autoload 'ftruncate '|numlib|) +#-unix (autoload 'get-decoded-time '|mislib|) +#+aosvs (autoload 'get-universal-time '|mislib|) +(autoload 'get-setf-method '|setf|) +(autoload 'get-setf-method-multiple-value '|setf|) +(autoload 'inspect '|describe|) +(autoload 'intersection '|listlib|) +(autoload 'isqrt '|numlib|) +(autoload 'ldb '|numlib|) +(autoload 'ldb-test '|numlib|) +(autoload 'logandc1 '|numlib|) +(autoload 'logandc2 '|numlib|) +(autoload 'lognand '|numlib|) +(autoload 'lognor '|numlib|) +(autoload 'lognot '|numlib|) +(autoload 'logorc1 '|numlib|) +(autoload 'logorc2 '|numlib|) +(autoload 'logtest '|numlib|) +(autoload 'make-array '|arraylib|) +(autoload 'make-sequence '|seq|) +(autoload 'map '|seq|) +(autoload 'mask-field '|numlib|) +(autoload 'merge '|seqlib|) +(autoload 'mismatch '|seqlib|) +(autoload 'nintersection '|listlib|) +(autoload 'notany '|seq|) +(autoload 'notevery '|seq|) +(autoload 'si::normalize-type ':predlib) +(autoload 'nset-difference '|listlib|) +(autoload 'nset-exclusive-or '|listlib|) +(autoload 'nsubstitute '|seqlib|) +(autoload 'nsubstitute-if '|seqlib|) +(autoload 'nsubstitute-if-not '|seqlib|) +(autoload 'nunion '|listlib|) +(autoload 'phase '|numlib|) +(autoload 'position '|seqlib|) +(autoload 'position-if '|seqlib|) +(autoload 'position-if-not '|seqlib|) +(autoload 'prin1-to-string '|iolib|) +(autoload 'princ-to-string '|iolib|) +(autoload 'rational '|numlib|) +(autoload 'rationalize '|numlib|) +(autoload 'read-from-string '|iolib|) +(autoload 'reduce '|seqlib|) +(autoload 'remove '|seqlib|) +(autoload 'remove-duplicates '|seqlib|) +(autoload 'remove-if '|seqlib|) +(autoload 'remove-if-not '|seqlib|) +(autoload 'replace '|seqlib|) +(autoload 'sbit '|arraylib|) +(autoload 'search '|seqlib|) +(autoload 'set-difference '|listlib|) +(autoload 'set-exclusive-or '|listlib|) +(autoload 'signum '|numlib|) +(autoload 'sinh '|numlib|) +(autoload 'some '|seq|) +(autoload 'sort '|seqlib|) +(autoload 'stable-sort '|seqlib|) +(autoload 'subsetp '|listlib|) +(autoload 'substitute '|seqlib|) +(autoload 'substitute-if '|seqlib|) +(autoload 'substitute-if-not '|seqlib|) +(autoload 'subtypep '|predlib|) +(autoload 'tanh '|numlib|) +(autoload 'typep '|predlib|) +(autoload 'union '|listlib|) +(autoload 'vector '|arraylib|) +(autoload 'vector-pop '|arraylib|) +(autoload 'vector-push '|arraylib|) +(autoload 'vector-extend '|arraylib|) +(autoload 'write-to-string '|iolib|) +(autoload 'y-or-n-p '|iolib|) +(autoload 'yes-or-no-p '|iolib|) + + +(set-dispatch-macro-character #\# #\a 'si::sharp-a-reader) +(set-dispatch-macro-character #\# #\A 'si::sharp-a-reader) +(autoload 'si::sharp-a-reader '"iolib") +(set-dispatch-macro-character #\# #\s 'si::sharp-s-reader) +(set-dispatch-macro-character #\# #\S 'si::sharp-s-reader) +(autoload 'si::sharp-s-reader '|iolib|) + + +;;; DEFAUTOLOADMACRO definitions. + +(autoload-macro 'assert '|assert|) +(autoload-macro 'ccase '|assert|) +(autoload-macro 'check-type '|assert|) +(autoload-macro 'ctypecase '|assert|) +(autoload-macro 'decf '|setf|) +(autoload-macro 'define-modify-macro '|setf|) +(autoload-macro 'define-setf-method '|setf|) +(autoload-macro 'defsetf '|setf|) +(autoload-macro 'defstruct '|defstruct|) +(autoload-macro 'si::define-structure '|defstruct|) +(autoload-macro 'deftype '|predlib|) +(autoload-macro 'do-all-symbols '|packlib|) +(autoload-macro 'do-external-symbols '|packlib|) +(autoload-macro 'do-symbols '|packlib|) +(autoload-macro 'ecase '|assert|) +(autoload-macro 'etypecase '|assert|) +(autoload-macro 'incf '|setf|) +(autoload-macro 'pop '|setf|) +(autoload-macro 'push '|setf|) +(autoload-macro 'pushnew '|setf|) +(autoload-macro 'remf '|setf|) +(autoload-macro 'rotatef '|setf|) +(autoload-macro 'setf '|setf|) +(autoload-macro 'shiftf '|setf|) +(autoload-macro 'step '|trace|) +(autoload-macro 'time '|mislib|) +(autoload-macro 'trace '|trace|) +(autoload-macro 'typecase '|assert|) +(autoload-macro 'untrace '|trace|) +(autoload-macro 'with-input-from-string '|iolib|) +(autoload-macro 'with-open-file '|iolib|) +(autoload-macro 'with-open-stream '|iolib|) +(autoload-macro 'with-output-to-string '|iolib|) +) ;;end autoloads of normally loaded files.j +(if (find-package "COMPILER") (push :compiler *features*)) +#+compiler +(autoload 'compiler::emit-fn '|../cmpnew/gcl_collectfn|) +(autoload 'compiler::init-fn '|../cmpnew/gcl_collectfn|) +(autoload 'si::monstartup '"gprof") +(autoload 'si::set-up-profile '"profile") + +(AUTOLOAD 'IDESCRIBE '|info|) +(AUTOLOAD 'INFO '|info|) +(AUTOLOAD 'LIST-MATCHES '|info|) +(AUTOLOAD 'get-match '|info|) +(AUTOLOAD 'print-node '|tinfo|) +(AUTOLOAD 'offer-choices '|tinfo|) +(AUTOLOAD 'tkconnect '|tkl|) + + + + +;; the sun has a broken ypbind business, if one wants to save. +;; So to stop users from invoking this +#+sun +(defun user-homedir-pathname () + (let* ((tem (si::getenv "HOME")) + (l (- (length tem) 1))) + (cond ((null tem) nil) + (t + (or (and (>= l 0) + (eql (aref tem l) #\/)) + (setq tem (concatenate 'string tem "/"))) + (pathname tem))))) + + diff --git a/lsp/gcl_auto_new.lsp b/lsp/gcl_auto_new.lsp new file mode 100755 index 0000000..07fcc15 --- /dev/null +++ b/lsp/gcl_auto_new.lsp @@ -0,0 +1,213 @@ +(in-package :si) +;;; Autoloaders. + + +;;; DEFAUTOLOAD definitions. for lsp directory files normally loaded. +(if (fboundp 'abs) (push :numlib *features*)) +;;hack to avoid interning all the :symbols if the files are loaded.. +#-numlib +(progn +(autoload 'abs '|gcl_numlib|) +(autoload 'acos '|gcl_numlib|) +(autoload 'acosh '|gcl_numlib|) +(autoload 'adjust-array '|gcl_arraylib|) +(autoload 'apropos '|gcl_packlib|) +(autoload 'apropos-list '|gcl_packlib|) +(autoload 'array-dimensions '|gcl_arraylib|) +(autoload 'array-in-bounds-p '|gcl_arraylib|) +(autoload 'array-row-major-index '|gcl_arraylib|) +(autoload 'asin '|gcl_numlib|) +(autoload 'asinh '|gcl_numlib|) +(autoload 'atanh '|gcl_numlib|) +(autoload 'best-array-element-type '|gcl_arraylib|) +(autoload 'bit '|gcl_arraylib|) +(autoload 'bit-and '|gcl_arraylib|) +(autoload 'bit-andc1 '|gcl_arraylib|) +(autoload 'bit-andc2 '|gcl_arraylib|) +(autoload 'bit-eqv '|gcl_arraylib|) +(autoload 'bit-ior '|gcl_arraylib|) +(autoload 'bit-nand '|gcl_arraylib|) +(autoload 'bit-nor '|gcl_arraylib|) +(autoload 'bit-not '|gcl_arraylib|) +(autoload 'bit-orc1 '|gcl_arraylib|) +(autoload 'bit-orc2 '|gcl_arraylib|) +(autoload 'bit-xor '|gcl_arraylib|) +(autoload 'byte '|gcl_numlib|) +(autoload 'byte-position '|gcl_numlib|) +(autoload 'byte-size '|gcl_numlib|) +(autoload 'cis '|gcl_numlib|) +(autoload 'coerce '|gcl_predlib|) +(autoload 'compile-file '|gcl_loadcmp|) +(autoload 'compile '|gcl_loadcmp|) +(autoload 'disassemble '|gcl_loadcmp|) +(autoload 'concatenate '|gcl_seq|) +(autoload 'cosh '|gcl_numlib|) +(autoload 'count '|gcl_seqlib|) +(autoload 'count-if '|gcl_seqlib|) +(autoload 'count-if-not '|gcl_seqlib|) +(autoload 'decode-universal-time '|gcl_mislib|) +(autoload 'delete '|gcl_seqlib|) +(autoload 'delete-duplicates '|gcl_seqlib|) +(autoload 'delete-if '|gcl_seqlib|) +(autoload 'delete-if-not '|gcl_seqlib|) +(autoload 'deposit-field '|gcl_numlib|) +(autoload 'describe '|gcl_describe|) +(autoload 'dpb '|gcl_numlib|) +(autoload 'dribble '|gcl_iolib|) +(autoload 'encode-universal-time '|gcl_mislib|) +(autoload 'every '|gcl_seq|) +(autoload 'fceiling '|gcl_numlib|) +(autoload 'ffloor '|gcl_numlib|) +(autoload 'fill '|gcl_seqlib|) +(autoload 'find '|gcl_seqlib|) +(autoload 'find-all-symbols '|gcl_packlib|) +(autoload 'find-if '|gcl_seqlib|) +(autoload 'find-if-not '|gcl_seqlib|) +(autoload 'fround '|gcl_numlib|) +(autoload 'ftruncate '|gcl_numlib|) +#-unix (autoload 'get-decoded-time '|gcl_mislib|) +#+aosvs (autoload 'get-universal-time '|gcl_mislib|) +(autoload 'get-setf-expansion '|gcl_setf|) +(autoload 'inspect '|gcl_describe|) +(autoload 'intersection '|gcl_listlib|) +(autoload 'isqrt '|gcl_numlib|) +(autoload 'ldb '|gcl_numlib|) +(autoload 'ldb-test '|gcl_numlib|) +(autoload 'logandc1 '|gcl_numlib|) +(autoload 'logandc2 '|gcl_numlib|) +(autoload 'lognand '|gcl_numlib|) +(autoload 'lognor '|gcl_numlib|) +(autoload 'lognot '|gcl_numlib|) +(autoload 'logorc1 '|gcl_numlib|) +(autoload 'logorc2 '|gcl_numlib|) +(autoload 'logtest '|gcl_numlib|) +(autoload 'make-array '|gcl_arraylib|) +(autoload 'make-sequence '|gcl_seq|) +(autoload 'map '|gcl_seq|) +(autoload 'mask-field '|gcl_numlib|) +(autoload 'merge '|gcl_seqlib|) +(autoload 'mismatch '|gcl_seqlib|) +(autoload 'nintersection '|gcl_listlib|) +(autoload 'notany '|gcl_seq|) +(autoload 'notevery '|gcl_seq|) +(autoload 'si::normalize-type ':predlib) +(autoload 'nset-difference '|gcl_listlib|) +(autoload 'nset-exclusive-or '|gcl_listlib|) +(autoload 'nsubstitute '|gcl_seqlib|) +(autoload 'nsubstitute-if '|gcl_seqlib|) +(autoload 'nsubstitute-if-not '|gcl_seqlib|) +(autoload 'nunion '|gcl_listlib|) +(autoload 'phase '|gcl_numlib|) +(autoload 'position '|gcl_seqlib|) +(autoload 'position-if '|gcl_seqlib|) +(autoload 'position-if-not '|gcl_seqlib|) +(autoload 'prin1-to-string '|gcl_iolib|) +(autoload 'princ-to-string '|gcl_iolib|) +(autoload 'rational '|gcl_numlib|) +(autoload 'rationalize '|gcl_numlib|) +(autoload 'read-from-string '|gcl_iolib|) +(autoload 'reduce '|gcl_seqlib|) +(autoload 'remove '|gcl_seqlib|) +(autoload 'remove-duplicates '|gcl_seqlib|) +(autoload 'remove-if '|gcl_seqlib|) +(autoload 'remove-if-not '|gcl_seqlib|) +(autoload 'replace '|gcl_seqlib|) +(autoload 'sbit '|gcl_arraylib|) +(autoload 'search '|gcl_seqlib|) +(autoload 'set-difference '|gcl_listlib|) +(autoload 'set-exclusive-or '|gcl_listlib|) +(autoload 'signum '|gcl_numlib|) +(autoload 'sinh '|gcl_numlib|) +(autoload 'some '|gcl_seq|) +(autoload 'sort '|gcl_seqlib|) +(autoload 'stable-sort '|gcl_seqlib|) +(autoload 'subsetp '|gcl_listlib|) +(autoload 'substitute '|gcl_seqlib|) +(autoload 'substitute-if '|gcl_seqlib|) +(autoload 'substitute-if-not '|gcl_seqlib|) +(autoload 'subtypep '|gcl_predlib|) +(autoload 'tanh '|gcl_numlib|) +(autoload 'typep '|gcl_predlib|) +(autoload 'union '|gcl_listlib|) +(autoload 'vector '|gcl_arraylib|) +(autoload 'vector-pop '|gcl_arraylib|) +(autoload 'vector-push '|gcl_arraylib|) +(autoload 'vector-extend '|gcl_arraylib|) +(autoload 'write-to-string '|gcl_iolib|) +(autoload 'y-or-n-p '|gcl_iolib|) +(autoload 'yes-or-no-p '|gcl_iolib|) + + +(set-dispatch-macro-character #\# #\a 'si::sharp-a-reader) +(set-dispatch-macro-character #\# #\A 'si::sharp-a-reader) +(autoload 'si::sharp-a-reader '"iolib") +(set-dispatch-macro-character #\# #\s 'si::sharp-s-reader) +(set-dispatch-macro-character #\# #\S 'si::sharp-s-reader) +(autoload 'si::sharp-s-reader '|gcl_iolib|) + + +;;; DEFAUTOLOADMACRO definitions. + +(autoload-macro 'assert '|gcl_assert|) +(autoload-macro 'ccase '|gcl_assert|) +(autoload-macro 'check-type '|gcl_assert|) +(autoload-macro 'ctypecase '|gcl_assert|) +(autoload-macro 'decf '|gcl_setf|) +(autoload-macro 'define-modify-macro '|gcl_setf|) +(autoload-macro 'define-setf-method '|gcl_setf|) +(autoload-macro 'defsetf '|gcl_setf|) +(autoload-macro 'defstruct '|gcl_defstruct|) +(autoload-macro 'si::define-structure '|gcl_defstruct|) +(autoload-macro 'deftype '|gcl_predlib|) +(autoload-macro 'do-all-symbols '|gcl_packlib|) +(autoload-macro 'do-external-symbols '|gcl_packlib|) +(autoload-macro 'do-symbols '|gcl_packlib|) +(autoload-macro 'ecase '|gcl_assert|) +(autoload-macro 'etypecase '|gcl_assert|) +(autoload-macro 'incf '|gcl_setf|) +(autoload-macro 'pop '|gcl_setf|) +(autoload-macro 'push '|gcl_setf|) +(autoload-macro 'pushnew '|gcl_setf|) +(autoload-macro 'remf '|gcl_setf|) +(autoload-macro 'rotatef '|gcl_setf|) +(autoload-macro 'setf '|gcl_setf|) +(autoload-macro 'shiftf '|gcl_setf|) +(autoload-macro 'step '|gcl_trace|) +(autoload-macro 'time '|gcl_mislib|) +(autoload-macro 'trace '|gcl_trace|) +(autoload-macro 'typecase '|gcl_assert|) +(autoload-macro 'untrace '|gcl_trace|) +(autoload-macro 'with-input-from-string '|gcl_iolib|) +(autoload-macro 'with-open-file '|gcl_iolib|) +(autoload-macro 'with-open-stream '|gcl_iolib|) +(autoload-macro 'with-output-to-string '|gcl_iolib|) +) ;;end autoloads of normally loaded files.j +(if (find-package "COMPILER") (push :compiler *features*)) +#+compiler +(autoload 'compiler::emit-fn '|../cmpnew/gcl_collectfn|) +(autoload 'compiler::init-fn '|../cmpnew/gcl_collectfn|) +(autoload 'si::monstartup '"gprof") +(autoload 'si::set-up-profile '"profile") + +(AUTOLOAD 'IDESCRIBE '|gcl_info|) +(AUTOLOAD 'INFO '|gcl_info|) +(AUTOLOAD 'LIST-MATCHES '|gcl_info|) +(AUTOLOAD 'get-match '|gcl_info|) +(AUTOLOAD 'print-node '|tinfo|) +(AUTOLOAD 'offer-choices '|tinfo|) +(AUTOLOAD 'tkconnect '|tkl|) + +(AUTOLOAD 'user::xgcl-demo '|gcl_dwtest|) +(defun user::xgcl nil + (use-package :xlib) + (format t "Welcome to xgcl! Try (xgcl-demo) for a demonstration.")) + +;; the sun has a broken ypbind business, if one wants to save. +;; So to stop users from invoking this +#+sun +(defun user-homedir-pathname () + (let* ((tem (si::getenv "HOME"))) + (when tem + (pathname (coerce-slash-terminated tem))))) + +(AUTOLOAD 'init-readline '|gcl_readline|) diff --git a/lsp/gcl_autocmp.lsp b/lsp/gcl_autocmp.lsp new file mode 100755 index 0000000..a12c52e --- /dev/null +++ b/lsp/gcl_autocmp.lsp @@ -0,0 +1,51 @@ +;;SAMPLE USAGE: +;;(def-autocomp foo (a b) (+ a b)) +;;(def-autocomp goo (a b) (- a b)) +;; +;;(foo 3 4) ==> 7 (after compiling foo and goo together..) +;; +;;Note: Might want to have a *use-count* which only compiles +;;after *use-count* gets above say 10. Thus it would only compile +;;the set of *new-definitions* when there were more than 10. +;;Would need to change the following slightly. Instead of storing the defun +;;store the lambda form, and have the autocomp do an apply of the lambda +;;form while incrementing the *use-count*. This is probably much better, +;;since the *use-count* much more accurately reflects the cost of not compiling +;;This code is obsolete before being used!! But I have to go now.. + +(require "SLOOP") +(use-package "SLOOP") + + +(defvar *new-definitions* nil) + +(defun compile-new-definitions (name) + (and name + (or (member name *new-definitions*) + (error "~a is not in *new-definitions*" name))) + (let ((lisp-file "cmptemp.lisp")(o-file "cmptemp.o")) + ;;in case somehow order matters.. + (setq *new-definitions* (nreverse *new-definitions*)) + (with-open-file (st lisp-file :direction :output) + (sloop for v in *new-definitions* + do (princ (get v 'new-definition) st))) + (compile-file lisp-file :output-file o-file) + (load o-file) + (setq *new-definitions* nil))) + +(defun autocomp (name args) + (compile-new-definitions name) + (apply name args)) + +(defmacro def-autocomp (fun args &rest body) + (let ((defn (list* 'defun fun args body))) + `(progn (push ',fun *new-definitions*) + (setf (get ',fun 'new-definition) ',defn) + (defun ,fun (&rest args) + (autocomp ',fun args))))) + + + + + + diff --git a/lsp/gcl_autoload.lsp b/lsp/gcl_autoload.lsp new file mode 100755 index 0000000..5da26a5 --- /dev/null +++ b/lsp/gcl_autoload.lsp @@ -0,0 +1,412 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + + +;;;; AUTOLOAD + + +(in-package :si) + +(export '(clines defentry defcfun object void int double)) + +;(defvar *features*) + +(defun lisp-implementation-type () "GNU Common Lisp (GCL)") + +(defun machine-type () #+sun "SUN" + #+hp-ux "HP-UX" + #+eclipse "ECLIPSE" + #+vax "VAX" + ) + +;(defun machine-type () "DEC VAX11/780") + +(defun machine-version () (machine-type)) +;(defun machine-version () nil) + +(defun machine-instance () (machine-type)) +;(defun machine-instance () nil) + +(defun software-type () + #+aosv "AOS/VS" + #+bsd "BSD" + #+system-v "SYSTEM-V" + #+hp-ux "HP-UX") + +;(defun software-type () "UNIX BSD") + +(defun software-version () (software-type)) +;(defun software-version () "4.2BSD") + +;(defun short-site-name () "RIMS") +(defun short-site-name () nil) + +;(defun long-site-name () +; "Research Institute for Mathematical Sciences, Kyoto University") +(defun long-site-name () nil) + + + +;;; Compiler functions. + +(defun proclaim (d) + (when (eq (car d) 'special) (mapc #'si:*make-special (cdr d)))) + +(defun proclamation (d) + (and (eq (car d) 'special) + (dolist (var (cdr d) t) + (unless (si:specialp var) (return nil))))) + +(defun compile-file (&rest args) + (error "COMPILE-FILE is not defined in this load module.")) +(defun compile (&rest args) + (error "COMPILE is not defined in this load module.")) +(defun disassemble (&rest args) + (error "DISASSEMBLE is not defined in this load module.")) + + +;;; Editor. + +; +(defun get-decoded-time () + (decode-universal-time (get-universal-time))) + +#+never +(defun get-universal-time () + (multiple-value-bind (sec min h d m y dow dstp tz) + (get-decoded-time) + (encode-universal-time sec min h d m y tz))) + + +; Set the default system editor to a fairly certain bet. +#-winnt(defvar *gcl-editor* "vi") +#+winnt(defvar *gcl-editor* "notepad") + +(defun new-ed (editor-name) + "Change the editor called by (ed) held in *gcl-editor*." + (setf *gcl-editor* editor-name)) + +(defun ed (&optional name) + "Edit a file using the editor named in *gcl-editor*; customise with new-ed()." + (if (null name) + (system *gcl-editor*) + (cond ((stringp name) + (system (format nil "~A ~A" *gcl-editor* name))) ; If string, assume file name. + ((pathnamep name) + (system (format nil "~A ~A" *gcl-editor* (namestring name)))) ; If pathname. + (t + (let ((body (symbol-function name))) + (cond ((compiled-function-p body) (error "You can't edit compiled functions.")) + ((and body + (consp body) + (eq (car body) 'lambda-block)) ; If lambda block, save file and edit. + (let ((ed-file (concatenate 'string + (temp-dir) + (format nil "~A" (cadr body)) + ".lisp"))) + (with-open-file + (st ed-file :direction :output) + (print `(defun ,name ,@ (cddr body)) st)) + (system (format nil "~A ~A" *gcl-editor* ed-file)))) + (t (system (format nil "~A ~A" *gcl-editor* name))))))))) ; Use symbol as filename + +;;; Allocator. + +;(import 'si::allocate) +;(export '(allocate + ;allocated-pages maximum-allocatable-pages + ;allocate-contiguous-pages + ;allocated-contiguous-pages maximum-contiguous-pages + ;allocate-relocatable-pages allocated-relocatable-pages +; sfun gfun cfun cclosure spice structure)) + +;(defvar type-character-alist +; '((cons . #\.) +; (fixnum . #\N) +; (bignum . #\B) +; (ratio . #\R) +; (short-float . #\F) +; (long-float . #\L) +; (complex . #\C) +; (character . #\#) +; (symbol . #\|) +; (package . #\:) +; (hash-table . #\h) +; (array . #\a) +; (vector . #\v) +; (string . #\") +; (bit-vector . #\b) +; (structure . #\S) +; (sfun . #\g) +; (stream . #\s) +; (random-state . #\$) +; (readtable . #\r) +; (pathname . #\p) +; (cfun . #\f) +; (vfun . #\V) +; (cclosure . #\c) +; (spice . #\!))) +; +;(defun get-type-character (type) +; (let ((a (assoc type type-character-alist))) +; (unless a +; (error "~S is not an implementation type.~%~ +; It should be one of:~%~ +; ~{~10T~S~^~30T~S~^~50T~S~%~}~%" +; type +; (mapcar #'car type-character-alist))) +; (cdr a))) + +;(defun allocate (type quantity &optional really-allocate) +; (si:alloc (get-type-character type) quantity really-allocate)) + +;(defun allocated-pages (type) +; (si:npage (get-type-character type))) + +;(defun maximum-allocatable-pages (type) +; (si:maxpage (get-type-character type))) + +;(defun allocate-contiguous-pages (quantity &optional really-allocate) +; (si::alloc-contpage quantity really-allocate)) + +;(defun allocated-contiguous-pages () +; (si:ncbpage)) + +;(defun maximum-contiguous-pages () +; (si::maxcbpage)) + +;(defun allocate-relocatable-pages (quantity &optional really-allocate) +; (si::alloc-relpage quantity)) + +;(defun allocated-relocatable-pages () +; (si::nrbpage)) + +;; FIXME This has to come straight from enum.h. CM 20050114 +(defvar *type-list* + '(cons + fixnum bignum ratio short-float long-float complex + character symbol package hash-table + array vector string bit-vector + structure stream random-state readtable pathname + cfun cclosure sfun gfun vfun afun closure cfdata spice)) + +(defun heaprep nil + + (let ((f (list + "word size: ~a bits~%" + "page size: ~a bytes~%" + "heap start: 0x~x~%" + "heap max : 0x~x~%" + "shared library start: 0x~x~%" + "cstack start: 0x~x~%" + "cstack mark offset: ~a bytes~%" + "cstack direction: ~[downward~;upward~;~]~%" + "cstack alignment: ~a bytes~%" + "cstack max: ~a bytes~%" + "immfix start: 0x~x~%" + "immfix size: ~a fixnums~%" + "physical memory: ~a pages~%")) + (v (multiple-value-list (si::heap-report)))) + + (do ((v v (cdr v)) (f f (cdr f))) ((not (car v))) + (format t (car f) + (let ((x (car v))) + (cond ((>= x 0) x) + ((+ x (* 2 (1+ most-positive-fixnum)))))))))) + +(defun room (&optional x) + (let ((l (multiple-value-list (si:room-report))) + maxpage leftpage ncbpage maxcbpage ncb cbgbccount npage maxnpage + rbused rbfree nrbpage maxrbpage + info-list link-alist) + (setq maxpage (nth 0 l) leftpage (nth 1 l) + ncbpage (nth 2 l) maxcbpage (nth 3 l) ncb (nth 4 l) + cbgbccount (nth 5 l) + holepage (nth 6 l) + rbused (nth 7 l) rbfree (nth 8 l) nrbpage (nth 9 l) + maxrbpage (nth 10 l) + rbgbccount (nth 11 l) + l (nthcdr 12 l)) + (do ((l l (nthcdr 5 l)) + (tl *type-list* (cdr tl)) + (j 0 (+ j (if (nth 3 l) (nth 3 l) 0))) + (i 0 (+ i (if (nth 2 l) (nth 2 l) 0)))) + ((null l) (setq npage i maxnpage j)) + (let ((typename (car tl)) + (nused (nth 0 l)) + (nfree (nth 1 l)) + (npage (nth 2 l)) + (maxpage (nth 3 l)) + (gbccount (nth 4 l))) + (if nused + (push (list typename npage maxpage + (if (zerop (+ nused nfree)) + 0 + (/ nused 0.01 (+ nused nfree))) + (if (zerop gbccount) nil gbccount)) + info-list) + (let ((a (assoc (nth nfree *type-list*) link-alist))) + (if a + (nconc a (list typename)) + (push (list (nth nfree *type-list*) typename) + link-alist)))))) + (terpri) + (dolist (info (nreverse info-list)) + (apply #'format t "~8D/~D~19T~6,1F%~@[~8D~]~35T~{~A~^ ~}" + (append (cdr info) + (if (assoc (car info) link-alist) + (list (assoc (car info) link-alist)) + (list (list (car info)))))) + (terpri) + ) + (terpri) + (format t "~8D/~D~26T~@[~8D~]~35Tcontiguous (~D blocks)~%" + ncbpage maxcbpage (if (zerop cbgbccount) nil cbgbccount) ncb) + (format t "~9T~D~35Thole~%" holepage) + (format t "~8D/~D~19T~6,1F%~@[~8D~]~35Trelocatable~%~%" + nrbpage maxrbpage (if (zerop (+ rbused rbfree)) 0.0 (/ rbused 0.01 (+ rbused rbfree))) + (if (zerop rbgbccount) nil rbgbccount)) + (format t "~10D pages for cells~%~%" npage) + (format t "~10D total pages in core~%" (+ npage ncbpage nrbpage)) + (format t "~10D current core maximum pages~%" (+ maxnpage maxcbpage maxrbpage)) + (format t "~10D pages reserved for gc~%" nrbpage) + (format t "~10D pages available for adding to core~%" leftpage) + (format t "~10D pages reserved for core exhaustion~%~%" (- maxpage (+ maxnpage maxcbpage (ash maxrbpage 1) leftpage))) + (format t "~10D maximum pages~%" maxpage) + (values) + ) + + (when x + (format t "~%~%") + (format t "Key:~%~%WS: words per struct~%UP: allocated pages~%MP: maximum pages~%FI: fraction of cells in use on allocated pages~%GC: number of gc triggers allocating this type~%~%") + (heaprep)) + + (values)) + + +;;; C Interface. + +(defmacro Clines (&rest r) nil) +(defmacro defCfun (&rest r) nil) +(defmacro defentry (&rest r) nil) + +(defmacro defla (&rest r) (cons 'defun r)) + +;;; Help. + +(export '(help help*)) + +(defun help (&optional (symbol nil s)) + (if s (si::print-doc symbol) + (progn + (princ " +Welcome to GNU Common Lisp (GCL for short). +Here are some functions you should learn first. + + (HELP symbol) prints the online documentation associated with the + symbol. For example, (HELP 'CONS) will print the useful information + about the CONS function, the CONS data type, and so on. + + (HELP* string) prints the online documentation associated with those + symbols whose print-names have the string as substring. For example, + (HELP* \"PROG\") will print the documentation of the symbols such as + PROG, PROGN, and MULTIPLE-VALUE-PROG1. + + (SI::INFO ) chooses from a list of all references in the + on-line documentation to . + + (APROPOS ) or (APROPOS ') list + all symbols containing . + + (DESCRIBE ') or (HELP ') describe particular symbols. + + (BYE) or (BY) ends the current GCL session. + +Good luck! The GCL Development Team") + (values)))) + +(defun help* (string &optional (package (find-package "LISP"))) + (si::apropos-doc string package)) + +;;; Pretty-print-formats. +;;; +;;; The number N as the property of a symbol SYMBOL indicates that, +;;; in the form (SYMBOL f1 ... fN fN+1 ... fM), the subforms fN+1,...,fM +;;; are the 'body' of the form and thus are treated in a special way by +;;; the KCL pretty-printer. + +(setf (get 'lambda 'si:pretty-print-format) 1) +(setf (get 'lambda-block 'si:pretty-print-format) 2) +(setf (get 'lambda-closure 'si:pretty-print-format) 4) +(setf (get 'lambda-block-closure 'si:pretty-print-format) 5) + +(setf (get 'block 'si:pretty-print-format) 1) +(setf (get 'case 'si:pretty-print-format) 1) +(setf (get 'catch 'si:pretty-print-format) 1) +(setf (get 'ccase 'si:pretty-print-format) 1) +(setf (get 'clines 'si:pretty-print-format) 0) +(setf (get 'compiler-let 'si:pretty-print-format) 1) +(setf (get 'cond 'si:pretty-print-format) 0) +(setf (get 'ctypecase 'si:pretty-print-format) 1) +(setf (get 'defcfun 'si:pretty-print-format) 2) +(setf (get 'define-setf-method 'si:pretty-print-format) 2) +(setf (get 'defla 'si:pretty-print-format) 2) +(setf (get 'defmacro 'si:pretty-print-format) 2) +(setf (get 'defsetf 'si:pretty-print-format) 3) +(setf (get 'defstruct 'si:pretty-print-format) 1) +(setf (get 'deftype 'si:pretty-print-format) 2) +(setf (get 'defun 'si:pretty-print-format) 2) +(setf (get 'do 'si:pretty-print-format) 2) +(setf (get 'do* 'si:pretty-print-format) 2) +(setf (get 'do-symbols 'si:pretty-print-format) 1) +(setf (get 'do-all-symbols 'si:pretty-print-format) 1) +(setf (get 'do-external-symbols 'si:pretty-print-format) 1) +(setf (get 'dolist 'si:pretty-print-format) 1) +(setf (get 'dotimes 'si:pretty-print-format) 1) +(setf (get 'ecase 'si:pretty-print-format) 1) +(setf (get 'etypecase 'si:pretty-print-format) 1) +(setf (get 'eval-when 'si:pretty-print-format) 1) +(setf (get 'flet 'si:pretty-print-format) 1) +(setf (get 'labels 'si:pretty-print-format) 1) +(setf (get 'let 'si:pretty-print-format) 1) +(setf (get 'let* 'si:pretty-print-format) 1) +(setf (get 'locally 'si:pretty-print-format) 0) +(setf (get 'loop 'si:pretty-print-format) 0) +(setf (get 'macrolet 'si:pretty-print-format) 1) +(setf (get 'multiple-value-bind 'si:pretty-print-format) 2) +(setf (get 'multiple-value-prog1 'si:pretty-print-format) 1) +(setf (get 'prog 'si:pretty-print-format) 1) +(setf (get 'prog* 'si:pretty-print-format) 1) +(setf (get 'prog1 'si:pretty-print-format) 1) +(setf (get 'prog2 'si:pretty-print-format) 2) +(setf (get 'progn 'si:pretty-print-format) 0) +(setf (get 'progv 'si:pretty-print-format) 2) +(setf (get 'return 'si:pretty-print-format) 0) +(setf (get 'return-from 'si:pretty-print-format) 1) +(setf (get 'tagbody 'si:pretty-print-format) 0) +(setf (get 'the 'si:pretty-print-format) 1) +(setf (get 'throw 'si:pretty-print-format) 1) +(setf (get 'typecase 'si:pretty-print-format) 1) +(setf (get 'unless 'si:pretty-print-format) 1) +(setf (get 'unwind-protect 'si:pretty-print-format) 0) +(setf (get 'when 'si:pretty-print-format) 1) +(setf (get 'with-input-from-string 'si:pretty-print-format) 1) +(setf (get 'with-open-file 'si:pretty-print-format) 1) +(setf (get 'with-open-stream 'si:pretty-print-format) 1) +(setf (get 'with-output-to-string 'si:pretty-print-format) 1) diff --git a/lsp/gcl_cmpinit.lsp b/lsp/gcl_cmpinit.lsp new file mode 100755 index 0000000..37a521e --- /dev/null +++ b/lsp/gcl_cmpinit.lsp @@ -0,0 +1,11 @@ +;(proclaim '(optimize (safety 2) (space 3))) + +(setq compiler::*eval-when-defaults* '(compile eval load)) +(or (fboundp 'si::get-&environment) (load "gcl_defmacro.lsp")) +;(or (get 'si::s-data 'si::s-data) +; (progn (load "../lsp/setf.lsp") (load "../lsp/defstruct.lsp"))) +(if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp")) + + + +;;;;; diff --git a/lsp/gcl_debug.lsp b/lsp/gcl_debug.lsp new file mode 100755 index 0000000..8015b5c --- /dev/null +++ b/lsp/gcl_debug.lsp @@ -0,0 +1,823 @@ +;;Copyright William F. Schelter 1990, All Rights Reserved + + +(In-package :si) +(import '(sloop::sloop)) + +(eval-when (compile eval) + (proclaim '(optimize (safety 2) (space 3))) + +(defmacro f (op &rest args) + `(the fixnum (,op ,@ (mapcar #'(lambda (x) `(the fixnum ,x)) args) ))) + +(defmacro fb (op &rest args) + `(,op ,@ (mapcar #'(lambda (x) `(the fixnum ,x)) args) )) + + ) + +;;; Some debugging features: +;;; Search-stack : +;;; (:s "cal") or (:s 'cal) searches the stack for a frame whose function or +;;; special form has a name containing "cal", moves there to display the local +;;; data. +;;; +;;; Break-locals : +;;; :bl displays the args and locals of the current function. +;;; (:bl 4) does this for 4 functions. +;;; +;;; (si:loc i) accesses the local(i): slot. +;;; the *print-level* and *print-depth* are bound to *debug-print-level* + +;;; Note you must have space < 3 in your optimize proclamation, in order for +;;; the local variable names to be saved by the compiler. + +;;; With BSD You may also use the function write-debug-symbols to +;;; obtain an object file with the correct symbol information for using a +;;; c debugger, on translated lisp code. You should have used the :debug +;;; t keyword when compiling the file. + +;;; To Do: add setf method for si:loc. +;;; add restart capability from various spots on the stack. + +(defun show-break-variables (&optional (n 1)) + (loop + ;(break-current) + (dolist (v (reverse(car *break-env*))) + (format *debug-io* "~%~9a: ~s" (car v) (second v))) + (or (fb > (incf n -1) 0) (return (values))) + (break-previous) + )) + +(defun show-environment (ihs) + (let ((lis (vs (ihs-vs ihs)))) + (if (listp lis) + (dolist (v (reverse (vs (ihs-vs ihs)))) + (format *debug-io* "~%~9a: ~s" (car v) (second v)))))) + +(putprop :a 'show-break-variables 'break-command) + +;;make hack in compiler to remember the local variable names for the +;;vs variables and associate it with the function name + +(defun search-stack (sym &aux string) + (setq string (cond((symbolp sym)(symbol-name sym)) + (t sym))) + (sloop + for ihs downfrom (ihs-top) above 2 + for fun = (ihs-fun ihs) with name + do + (cond ((compiled-function-p fun) + (setq name (compiled-function-name fun))) + ((symbolp fun ) (setq name fun)) + ((and (listp fun) + (member (car fun) '(lambda lambda-block))) + (setq name (second fun))) + (t (setq name '||))) + when (search string (symbol-name name) :test 'equal) + do (return (progn (break-go ihs)(terpri) (break-locals))) + finally (format *debug-io* "~%Search for ~a failed" string) + )) + +(defvar *debug-print-level* 3) + +(defun break-locals (&optional (n 1) + &aux (ihs *current-ihs*) + (base (ihs-vs ihs)) + (*print-level* *debug-print-level*) + *print-circle* + (*print-length* *debug-print-level*) + (current-ihs *current-ihs*) + (fun (ihs-fun ihs)) name args) + (cond ((fb > n 1) + (sloop for i below n + for ihs downfrom current-ihs above 2 + do (let ((*current-ihs* ihs)) + (break-locals) (terpri)(terpri) + ))) + (t + (cond ((compiled-function-p fun) + (setq name (compiled-function-name fun))) + (t (setq name fun))) + (if (symbolp name)(setq args (get name 'debugger))) + (let ((next (ihs-vs (f + 1 *current-ihs*)))) + (cond (next + (format *debug-io* ">> ~a():" name) + (cond ((symbolp name) + (sloop for i from base below next for j from 0 + for u = nil + do + (cond ((member 0 args);;old debug info. + (setf u (getf args j))) + (t (setf u (nth j args)))) + (cond (u + (format t + "~%Local~a(~a): ~a" j u (vs i))) + (t + (format *debug-io* "~%Local(~d): ~a" + j (vs i)))))) + ((listp name) + (show-environment ihs)) + (t (format *debug-io* "~%Which case is this??"))))))))) + +(defun loc (&optional (n 0)) + (let ((base (ihs-vs *current-ihs*))) + (unless (and (fb >= n 0) + (fb < n (f - (ihs-vs + (min (ihs-top) (f + 1 *current-ihs*))) + base))) + (error "Not in current function")) + (vs (f + n base)))) + +(putprop :bl 'break-locals 'break-command) +(putprop :s 'search-stack 'break-command) + +(defvar *record-line-info* (make-hash-table :test 'eq)) + +(defvar *at-newline* nil) + +(defvar *standard-readtable* *readtable*) + +(defvar *line-info-readtable* (copy-readtable)) + +(defvar *left-parenthesis-reader* (get-macro-character #\( )) + +(defvar *quotation-reader* (get-macro-character #\" )) + +(defvar *stream-alist* nil) + +(defvar *break-point-vector* (make-array 10 :fill-pointer 0 :adjustable t)) + +(defvar *step-next* nil) + +(defvar *last-dbl-break* nil) + +#-gcl +(eval-when (compile eval load) + +(defvar *places* '(|*mv0*| |*mv1*| |*mv2*| |*mv3*| |*mv4*| |*mv5*| |*mv6*| |*mv7*| + |*mv8*| |*mv9*|)) + +(defmacro set-mv (i val) `(setf ,(nth i *places*) ,val)) + +(defmacro mv-ref (i) (nth i *places*)) + ) + +(defmacro mv-setq (lis form) + `(prog1 (setf ,(car lis) ,form) + ,@ (do ((v (cdr lis) (cdr v)) + (i 0 (1+ i)) + (res)) + ((null v)(nreverse res)) + (push `(setf ,(car v) (mv-ref ,i)) res)))) + +(defmacro mv-values (&rest lis) + `(prog1 ,(car lis) + ,@ (do ((v (cdr lis) (cdr v)) + (i 0 (1+ i)) + (res)) + ((null v)(nreverse res)) + (push `(set-mv ,i ,(car v)) res)))) + +;;start a lisp debugger loop. Exit it by using :step + +(defun dbl () + (break-level nil nil)) + +(defstruct instream stream (line 0 :type fixnum) stream-name) + + +(eval-when (eval compile) + +(defstruct (bkpt (:type list)) form file file-line function) + ) + +(defun cleanup () + (dolist (v *stream-alist*) + (if (closedp (instream-stream v)) + (setq *stream-alist* (delete v *stream-alist*))))) + +(defun get-instream (str) + (or (dolist (v *stream-alist*) + (cond ((eq str (instream-stream v)) + (return v)))) + (car (setq *stream-alist* + (cons (make-instream :stream str + :stream-name (if (streamp str) + (stream-name str)) + ) *stream-alist*))))) + +(defun newline (str ch) ch + (let ((in (get-instream str))) + (setf (instream-line in) (the fixnum (f + 1 (instream-line in))))) + ;; if the next line begins with '(', then record all cons's eg arglist ) + (setq *at-newline* (if (eql (peek-char nil str nil) #\() :all t)) + (values)) + +(defun quotation-reader (str ch) + (let ((tem (funcall *quotation-reader* str ch)) + (instr (get-instream str))) + (incf (instream-line instr) (count #\newline tem)) + tem)) + +(defvar *old-semicolon-reader* (get-macro-character #\;)) + +(defun new-semi-colon-reader (str ch) + (let ((in (get-instream str)) + (next (peek-char nil str nil nil))) + (setf (instream-line in) (the fixnum (f + 1 (instream-line in)))) + (cond ((eql next #\!) + (read-char str) + (let* ((*readtable* *standard-readtable*) + (command (read-from-string (read-line str nil nil)))) + (cond ((and (consp command) + (eq (car command) :line) + (stringp (second command)) + (typep (third command) 'fixnum)) + (setf (instream-stream-name in) (second command)) + (setf (instream-line in) (third command)))) + )) + (t (funcall *old-semicolon-reader* str ch))) + (setq *at-newline* (if (eql (peek-char nil str nil) #\() :all t)) + (values))) + +(defun setup-lineinfo () + (set-macro-character #\newline #'newline nil *line-info-readtable*) + (set-macro-character #\; #'new-semi-colon-reader nil *line-info-readtable*) + (set-macro-character #\( 'left-parenthesis-reader nil *line-info-readtable*) + (set-macro-character #\" 'quotation-reader nil *line-info-readtable*) + + ) + +(defun nload (file &rest args ) + (clrhash *record-line-info*) + (cleanup) + (setq file (truename file)) + (setup-lineinfo) + (let ((*readtable* *line-info-readtable*)) + (apply 'load file args))) + +(eval-when (compile eval) + +(defmacro break-data (name line) `(cons ,name ,line)) + ) + +(defun left-parenthesis-reader (str ch &aux line(flag *at-newline*)) + (if (eq *at-newline* t) (setq *at-newline* nil)) + (when flag + (setq flag (get-instream str)) + (setq line (instream-line flag)) + ) + (let ((tem (funcall *left-parenthesis-reader* str ch))) + (when flag + (setf (gethash tem *record-line-info*) + (break-data (instream-name flag) + line))) + tem)) + +(defvar *fun-array* (make-array 50 :fill-pointer 0 :adjustable t)) + +(defun walk-through (body &aux tem) + (tagbody + top + (cond ((consp body) + (when (setq tem (gethash body *record-line-info*)) + ;; lines beginning with ((< u v)..) + ;; aren't eval'd but are part of a special form + (cond ((and (consp (car body)) + (not (eq (caar body) 'lambda))) + (remhash body *record-line-info*) + (setf (gethash (car body) *record-line-info*) + tem)) + (t (vector-push-extend (cons tem body) *fun-array*)))) + (walk-through (car body)) + (setq body (cdr body)) + (go top)) + (t nil)))) + +(defun compiler::compiler-def-hook (name body &aux (ar *fun-array*) + (min most-positive-fixnum) + (max -1)) + (declare (fixnum min max)) + ;; (cond ((and (boundp '*do-it*) + ;; (eq (car body) 'lambda-block)) + ;; (setf (cdr body) (cdr (walk-top body))))) + + (cond ((atom body) + (remprop name 'line-info)) + ((eq *readtable* *line-info-readtable*) + (setf (fill-pointer *fun-array*) 0) + (walk-through body) + (dotimes (i (length ar)) + (declare (fixnum i)) + (let ((n (cdar (aref ar i)))) + (declare (fixnum n)) + (if (fb > n max) (setf max n)) + (if (fb < n min) (setf min n)))) + (cond ((fb > (length *fun-array*) 0) + (let ((new (make-array (f + (f - max min) 2) + :initial-element :blank-line)) + (old-info (get name 'line-info))) + (setf (aref new 0) + (cons (caar (aref ar 0)) min)) + (setq min (f - min 1)) + (dotimes (i (length ar)) + (let ((y (aref ar i))) + (setf (aref new (f - (cdar y) min)) + (cdr y)))) + (setf (get name 'line-info) new) + (when + old-info + (let ((tem (get name 'break-points)) + (old-begin (cdr (aref old-info 0)))) + (dolist (bptno tem) + (let* ((bpt (aref *break-points* bptno)) + (fun (bkpt-function bpt)) + (li (f - (bkpt-file-line bpt) old-begin))) + (setf (aref *break-points* bptno) + (make-break-point fun new li)))))))) + (t (let ((tem (get name 'break-points))) + (iterate-over-bkpts tem :delete))))))) + +(defun instream-name (instr) + (or (instream-stream-name instr) + (stream-name (instream-stream instr)))) + +(eval-when (eval) + +(defun stream-name (str) (namestring (pathname str)))) +(clines "object stream_name(str) object str;{ + if (str->sm.sm_object1 != 0 && type_of(str->sm.sm_object1)==t_string) + return str->sm.sm_object1; else return Cnil;}") + +(defentry stream-name (object) (object "stream_name")) + +(clines "object closedp(str) object str;{return (str->sm.sm_fp==0 ? Ct :Cnil);}") + +(defentry closedp (object) (object "closedp")) + +(defun find-line-in-fun (form env fun counter &aux tem) + (setq tem (get fun 'line-info)) + (if tem + (let ((ar tem)) + (declare (type (array (t)) ar)) + (when ar + (dotimes + (i (length ar)) + (cond ((eq form (aref ar i)) + (when counter + (decf (car counter)) + (cond ((fb > (car counter) 0) + ;silent + (return-from find-line-in-fun :break)))) + (break-level + (setq *last-dbl-break* (make-break-point fun ar i)) env + ) + (return-from find-line-in-fun :break)))))))) + +;; get the most recent function on the stack with step info. + +(defun current-step-fun ( &optional (ihs (ihs-top)) ) + (do ((i (1- ihs) (f - i 1))) + ((fb <= i 0)) + (let ((na (ihs-fname i))) + (if (get na 'line-info) (return na))))) + +(defun init-break-points () + (setf (fill-pointer *break-point-vector*) 0) + (setf *break-points* *break-point-vector*)) + +(defun step-into (&optional (n 1)) +;(defun step-into () + (declare (ignore n)) + ;;FORM is the next form about to be evaluated. + (or *break-points* (init-break-points)) + (setq *break-step* 'break-step-into) + :resume) + +(defun step-next ( &optional (n 1)) + (let ((fun (current-step-fun))) + (setq *step-next* (cons n fun)) + (or *break-points* (init-break-points)) + (setq *break-step* 'break-step-next) + :resume)) + +(defun maybe-break (form line-info fun env &aux pos) + (cond ((setq pos (position form line-info)) + (setq *break-step* nil) + (or (> (length *break-points*) 0) + (setf *break-points* nil)) + (break-level (make-break-point fun line-info pos) env) + t))) + +;; These following functions, when they are the value of *break-step* +;; are invoked by an inner hook in eval. They may choose to stop +;; things. + +(defun break-step-into (form env) + (let ((fun (current-step-fun))) + (let ((line-info (get fun 'line-info))) + (maybe-break form line-info fun env)))) + +(defun break-step-next (form env) + (let ((fun (current-step-fun))) + (cond ((eql (cdr *step-next*) fun) + (let ((line-info (get fun 'line-info))) + (maybe-break form line-info fun env)))))) + +(setf (get :next 'break-command) 'step-next) +(setf (get :step 'break-command) 'step-into) +(setf (get :loc 'break-command) 'loc) + + +(defun *break-points* (form env) + (let ((pos(position form *break-points* :key 'car))) + (format t "Bkpt ~a:" pos) + (break-level (aref *break-points* pos) env))) + + +(defun dwim (fun) + (dolist (v (list-all-packages)) + (multiple-value-bind + (sym there) + (intern (symbol-name fun) v) + (cond ((get sym 'line-info) + (return-from dwim sym)) + (t (or there (unintern sym)))))) + (format t "~a has no line information" fun)) + +(defun break-function (fun &optional (li 1) absolute &aux fun1) + (let ((ar (get fun 'line-info))) + (when (null ar) (setq fun1 (dwim fun)) + (if fun1 (return-from break-function + (break-function fun1 li absolute)))) + (or (arrayp ar)(progn (format t "~%No line info for ~a" fun) + (return-from break-function nil))) + (let ((beg (cdr (aref ar 0)))) + (if absolute (setq li (f - li beg))) + (or (and (fb >= li 1) (fb < li (length ar))) + (progn (format t "~%line out of bounds for ~a" fun)) + (return-from break-function nil)) + (if (eql li 1) + (let ((tem (symbol-function fun))) + (cond ((and (consp tem) + (eq (car tem) 'lambda-block) + (third tem)) + (setq li 2))))) + (dotimes (i (f - (length ar) li)) + (when (not (eq (aref ar i) :blank-line)) + (show-break-point (insert-break-point + (make-break-point fun ar (f + li i)))) + (return-from break-function (values)))) + (format t "~%Beyond code for ~a ")))) + +(defun insert-break-point (bpt &aux at) + (or *break-points* (init-break-points)) + (setq at (or (position nil *break-points*) + (prog1 (length *break-points*) + (vector-push-extend nil *break-points*) + ))) + (let ((fun (bkpt-function bpt))) + (push at (get fun 'break-points))) + (setf (aref *break-points* at) bpt) + at) + +(defun short-name (name) + (let ((Pos (position #\/ name :from-end t))) + (if pos (subseq name (f + 1 pos)) name))) + +(defun show-break-point (n &aux disabled) + (let ((bpt (aref *break-points* n))) + (when bpt + (when (eq (car bpt) nil) + (setq disabled t) + (setq bpt (cdr bpt))) + (format t "Bkpt ~a:(~a line ~a)~@[(disabled)~]" + n (short-name (second bpt)) + (third bpt) disabled) + (let ((fun (fourth bpt))) + (format t "(line ~a of ~a)" (relative-line fun (nth 2 bpt)) + fun + ))))) + +(defun iterate-over-bkpts (l action) + (dotimes (i (length *break-points*)) + (if (or (member i l) + (null l)) + (let ((tem (aref *break-points* i))) + (setf (aref *break-points* i) + (case action + (:delete + (if tem (setf (get (bkpt-function tem) 'break-points) + (delete i (get (bkpt-function tem) 'break-points)))) + nil) + (:enable + (if (eq (car tem) nil) (cdr tem) nil)) + (:disable + (if (and tem (not (eq (car tem) nil))) + (cons nil tem) + tem)) + (:show + (when tem (show-break-point i) + (terpri)) + tem + ))))))) + +(setf (get :info 'break-command) + '(lambda (type) + (case type + (:bkpt (iterate-over-bkpts nil :show)) + (otherwise + (format t "usage: :info :bkpt -- show breakpoints") + )))) + +(defun complete-prop (sym package prop &optional return-list) + (cond ((and (symbolp sym)(get sym prop)(equal (symbol-package sym) + (find-package package))) + (return-from complete-prop sym))) + (sloop for v in-package package + when (and (get v prop) + (eql (string-match sym v) 0)) + collect v into all + finally + + (cond (return-list (return-from complete-prop all)) + ((> (length all) 1) + (format t "~&Not unique with property ~(~a: ~{~s~^, ~}~)." + prop all)) + + ((null all) + (format t "~& ~a is not break command" sym)) + (t (return-from complete-prop + (car all)))))) + +(setf (get :delete 'break-command) + '(lambda (&rest l) (iterate-over-bkpts l :delete)(values))) +(setf (get :disable 'break-command) + '(lambda (&rest l) (iterate-over-bkpts l :disable)(values))) +(setf (get :enable 'break-command) + '(lambda (&rest l) (iterate-over-bkpts l :enable)(values))) +(setf (get :break 'break-command) + '(lambda (&rest l) + (print l) + (cond (l + (apply 'si::break-function l)) + (*last-dbl-break* + (let ((fun (nth 3 *last-dbl-break*))) + (si::break-function fun (nth 2 *last-dbl-break*) t)))))) + +(setf (get :fr 'break-command) + '(lambda (&rest l ) + (dbl-up (or (car l) 0) *ihs-top*) + (values))) + +(setf (get :up 'break-command) + '(lambda (&rest l ) + (dbl-up (or (car l) 1) *current-ihs*) + (values))) + +(setf (get :down 'break-command) + '(lambda (&rest l ) + (dbl-up ( - (or (car l) 1)) *current-ihs*) + (values))) + +;; in other common lisps this should be a string output stream. + +(defvar *display-string* + (make-array 100 :element-type 'character :fill-pointer 0 :adjustable t)) + +(defun display-env (n env) + (do ((v (reverse env) (cdr v))) + ((or (not (consp v)) (fb > (fill-pointer *display-string*) n))) + (or (and (consp (car v)) + (listp (cdar v))) + (return)) + (format *display-string* "~s=~s~@[,~]" (caar v) (cadar v) (cdr v)))) + +(defun apply-display-fun (display-fun n lis) + (let ((*print-length* *debug-print-level*) + (*print-level* *debug-print-level*) + (*print-pretty* nil) + (*PRINT-CASE* :downcase) + (*print-circle* t) + ) + (setf (fill-pointer *display-string*) 0) + (format *display-string* "{") + (funcall display-fun n lis) + (when (fb > (fill-pointer *display-string*) n) + (setf (fill-pointer *display-string*) n) + (format *display-string* "...")) + + (format *display-string* "}") + ) + *display-string* + ) + +(setf (get :bt 'break-command) 'dbl-backtrace) +(setf (get '*break-points* 'dbl-invisible) t) + +(defun get-line-of-form (form line-info) + (let ((pos (position form line-info))) + (if pos (f + pos (cdr (aref line-info 0)))))) + +(defun get-next-visible-fun (ihs) + (do ((j ihs (f - j 1))) + ((fb < j *ihs-base*) + (mv-values nil j)) + (let + ((na (ihs-fname j))) + (cond ((special-operator-p na)) + ((get na 'dbl-invisible)) + ((fboundp na)(return (mv-values na j))))))) + +(defun dbl-what-frame (ihs &aux (j *ihs-top*) (i 0) na) + (declare (fixnum ihs j i)) + (loop + (mv-setq (na j) (get-next-visible-fun j)) + (cond ((fb <= j ihs) (return i))) + (setq i (f + i 1)) + (setq j (f - j 1)))) + +(defun dbl-up (n ihs &aux m fun line file env ) + (setq m (dbl-what-frame ihs)) + (cond ((fb >= n 0) + (mv-setq (*current-ihs* n fun line file env) + (nth-stack-frame n ihs)) + (set-env) + (print-stack-frame (f + m n) t *current-ihs* fun line file env)) + (t (setq n (f + m n)) + (or (fb >= n 0) (setq n 0)) + (dbl-up n *ihs-top*)))) + +(dolist (v '( break-level universal-error-handler terminal-interrupt + break-level evalhook find-line-in-fun)) + (setf (get v 'dbl-invisible) t)) + +(defun next-stack-frame (ihs &aux line-info li i k na) + (cond + ((fb < ihs *ihs-base*) (mv-values nil nil nil nil nil )) + (t (let (fun) + ;; next lower visible ihs + (mv-setq (fun i) (get-next-visible-fun ihs)) + (setq na fun) + (cond + ((and + (setq line-info (get fun 'line-info)) + (do ((j (f + ihs 1) (f - j 1)) + (form )) + ((<= j i) nil) + (setq form (ihs-fun j)) + (cond ((setq li (get-line-of-form (ihs-fun j) line-info)) + (return-from next-stack-frame + (mv-values + i fun li + ;; filename + (car (aref line-info 0)) + ;;environment + (list (vs (setq k (ihs-vs j))) + (vs (1+ k)) + (vs (+ k 2))) + ))))))) + ((special-operator-p na) nil) + ((get na 'dbl-invisible)) + ((fboundp na) + (mv-values i na nil nil + (if (ihs-not-interpreted-env i) + nil + (let ((i (ihs-vs i))) + (list (vs i) (vs (1+ i)) (vs (f + i 2)))))))) + )))) + +(defun nth-stack-frame (n &optional (ihs *ihs-top*) + &aux name line file env next) + (or (fb >= n 0) (setq n 0)) + (dotimes (i (f + n 1)) + (setq next (next-stack-frame ihs)) + (cond (next + (mv-setq (ihs name line file env) next) + (setq ihs (f - next 1))) + (t (return (setq n (f - i 1)))))) + + (setq ihs (f + ihs 1) name (ihs-fname ihs)) + (mv-values ihs n name line file env )) + +(defun dbl-backtrace (&optional (m 1000) (ihs *ihs-top*) &aux fun file + line env (i 0)) + (loop + (mv-setq (ihs fun line file env) (next-stack-frame ihs)) + (or (and ihs fun) (return nil)) + (print-stack-frame i nil ihs fun line file env) + (incf i) + (cond ((fb >= i m) (return (values)))) + (setq ihs (f - ihs 1)) + ) + (values)) + +(defun display-compiled-env ( plength ihs &aux + (base (ihs-vs ihs)) + (end (min (ihs-vs (1+ ihs)) (vs-top)))) + (format *display-string* "") + (do ((i base ) + (v (get (ihs-fname ihs) 'debugger) (cdr v))) + ((or (fb >= i end)(fb > (fill-pointer *display-string*) plength))) + (format *display-string* "~a~@[~d~]=~s~@[,~]" + (or (car v) 'loc) (if (not (car v)) (f - i base)) (vs i) + (fb < (setq i (f + i 1)) end))) + ) + +(defun computing-args-p (ihs) + ;; When running interpreted we want a line like + ;; (list joe jane) to get recorded in the invocation + ;; history while joe and jane are being evaluated, + ;; even though list has not yet been invoked. We put + ;; it in the history, but with the previous lexical environment. + (and (consp (ihs-fun ihs)) + (> ihs 3) + (not (member (car (ihs-fun ihs)) '(lambda-block lambda))) + ;(<= (ihs-vs ihs) (ihs-vs (- ihs 1))) + ) + ) + + +(defun print-stack-frame (i auto-display ihs fun &optional line file env) + (declare (ignore env)) + (when (and auto-display line) + (format *debug-io* "~a:~a:0:beg~%" file line)) + (let ((computing-args (computing-args-p ihs))) + (format *debug-io* "~&#~d ~@[~a~] ~a ~@[~a~] " i + (and computing-args "Computing args for ") + fun + (if (not (ihs-not-interpreted-env ihs)) + (apply-display-fun 'display-env 80 + (car (vs (ihs-vs ihs)))) + (apply-display-fun 'display-compiled-env 80 ihs))) + (if file (format *debug-io* "(~a line ~a)" file line)) + (format *debug-io* "[ihs=~a]" ihs) + )) + +(defun make-break-point (fun ar i) + (list ;make-bkpt ;:form + (aref ar i) + ;:file + (car (aref ar 0)) + ;:file-line + (f + (cdr (aref ar 0)) i) + ;:function + fun) + ) + +(defun relative-line (fun l) + (let ((info (get fun 'line-info))) + (if info (f - l (cdr (aref info 0))) + 0))) + +(defvar *step-display* nil) + +(defvar *null-io* (make-broadcast-stream)) +;; should really use serror to evaluate this inside. +;; rather than just quietening it. It prints a long stack +;; which is time consuming. + +(defun safe-eval (form env &aux *break-enable*) + (let ((*error-output* *null-io*) + (*debug-io* *null-io*)) + (cond ((symbolp form) + (unless (or (boundp form) + (assoc form (car env))) + (return-from safe-eval :)))) + (multiple-value-bind (er val) + (si::error-set + `(evalhook ',form nil nil ',env)) + (if er : val)))) + +(defvar *no-prompt* nil) + +(defun set-back (at env &aux (i *current-ihs*)) + (setq *no-prompt* nil) + (setq *current-ihs* i) + (cond (env (setq *break-env* env)) + (t (list (vs (ihs-vs i))))) + + (when (consp at) + (format *debug-io* "~a:~a:0:beg~%" (second at) (third at)) + (format *debug-io* "(~a line ~a) " + (second at) (third at)) + ) + (dolist (v *step-display*) + (let ((res (safe-eval v env))) + (or (eq res :) + (format t "(~s=~s)" v res))))) + + +(eval-when (load eval) + (pushnew :sdebug *features* ) + ;(use-fast-links nil) + ) + + + + + + + + + diff --git a/lsp/gcl_defmacro.lsp b/lsp/gcl_defmacro.lsp new file mode 100755 index 0000000..8794bf2 --- /dev/null +++ b/lsp/gcl_defmacro.lsp @@ -0,0 +1,267 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; defmacro.lsp +;;;; +;;;; defines SI:DEFMACRO*, the defmacro preprocessor + + +(in-package :si) + + +(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) + + +;;; valid lambda-list to DEFMACRO is: +;;; +;;; ( [ &whole sym ] +;;; [ &environment sym ] +;;; { v }* +;;; [ &optional { sym | ( v [ init [ v ] ] ) }* ] +;;; { [ { &rest | &body } v ] +;;; [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }* +;;; [ &allow-other-keys ]] +;;; [ &aux { sym | ( v [ init ] ) }* ] +;;; | . sym } +;;; ) +;;; +;;; where v is short for { defmacro-lambda-list | sym }. +;;; A symbol may be accepted as a DEFMACRO lambda-list, in which case +;;; (DEFMACRO ... ) is equivalent to +;;; (DEFMACRO (&REST ) ...). +;;; Defamcro-lambda-list is defined as: +;;; +;;; ( { v }* +;;; [ &optional { sym | ( v [ init [ v ] ] ) }* ] +;;; { [ { &rest | &body } v ] +;;; [ &key { sym | ( { sym | ( key v ) } [ init [ v ]] ) }* +;;; [ &allow-other-keys ]] +;;; [ &aux { sym | ( v [ init ] ) }* ] +;;; | . sym } +;;; ) + +;; defvar is not yet available. +(mapc '*make-special '(*dl* *key-check* *arg-check*)) + + +(defun get-&environment(vl &aux env) + (let ((env-m + (and (listp vl) + (do ((tail vl (cdr tail))) + ((not (consp tail)) nil) + (when (eq '&environment (car tail)) + (return tail)))))) + (cond (env-m + (setq env (cadr env-m)) + (setq vl (append (ldiff vl env-m) (cddr env-m))))) + (values vl env))) + + + +(defun si:defmacro* (name vl body + &aux *dl* (*key-check* nil) + (*arg-check* nil) + doc decls whole ppn (env nil) envp) + (cond ((listp vl)) + ((symbolp vl) (setq vl (list '&rest vl))) + (t (error "The defmacro-lambda-list ~s is not a list." vl))) + (multiple-value-setq (doc decls body) (find-doc body nil)) + (cond ((and (listp vl) (eq (car vl) '&whole)) + (setq whole (cadr vl)) (setq vl (cddr vl))) + (t (setq whole (gensym)))) + (multiple-value-setq (vl env) + (get-&environment vl)) + (setq envp env) + (or env (setq env (gensym))) + (setq *dl* `(&aux ,env ,whole)) + (setq ppn (dm-vl vl whole t)) + (dolist (kc *key-check*) + (push `(unless (getf ,(car kc) :allow-other-keys) + (do ((vl ,(car kc) (cddr vl))) + ((endp vl)) + (unless (member (car vl) ',(cdr kc)) + (dm-key-not-allowed (car vl)) + ))) + body)) + (dolist (ac *arg-check*) + (push `(unless (endp ,(dm-nth-cdr (cdr ac) (car ac))) + (dm-too-many-arguments)) body)) + (unless envp (push `(declare (ignore ,env)) body)) + (list doc ppn `(lambda-block ,name ,(nreverse *dl*) ,@(append decls body))) + ) + +(defun dm-vl (vl whole top) + (do ((optionalp nil) (restp nil) (keyp nil) + (allow-other-keys-p nil) (auxp nil) + (rest nil) (allow-other-keys nil) (keys nil) (no-check nil) + (n (if top 1 0)) (ppn nil) + ) + ((not (consp vl)) + (when vl + (when restp (dm-bad-key '&rest)) + (push (list vl (dm-nth-cdr n whole)) *dl*) + (setq no-check t)) + (when (and rest (not allow-other-keys)) + (push (cons rest keys) *key-check*)) + (unless no-check (push (cons whole n) *arg-check*)) + ppn + ) + (let ((v (car vl))) + (cond + ((eq v '&optional) + (when optionalp (dm-bad-key '&optional)) + (setq optionalp t) + (pop vl)) + ((or (eq v '&rest) (eq v '&body)) + (when restp (dm-bad-key v)) + (dm-v (cadr vl) (dm-nth-cdr n whole)) + (setq restp t optionalp t no-check t) + (setq vl (cddr vl)) + (when (eq v '&body) (setq ppn (if top (1- n) n)))) + ((eq v '&key) + (when keyp (dm-bad-key '&key)) + (setq rest (gensym)) + (push (list rest (dm-nth-cdr n whole)) *dl*) + (setq keyp t restp t optionalp t no-check t) + (pop vl)) + ((eq v '&allow-other-keys) + (when (or (not keyp) allow-other-keys-p) + (dm-bad-key '&allow-other-keys)) + (setq allow-other-keys-p t) + (setq allow-other-keys t) + (pop vl)) + ((eq v '&aux) + (when auxp (dm-bad-key '&aux)) + (setq auxp t allow-other-keys-p t keyp t restp t optionalp t) + (pop vl)) + (auxp + (let (x (init nil)) + (cond ((symbolp v) (setq x v)) + (t (setq x (car v)) + (unless (endp (cdr v)) (setq init (cadr v))))) + (dm-v x init)) + (pop vl)) + (keyp + (let ((temp (gensym)) x k (init nil) (sv nil)) + (cond ((symbolp v) (setq x v k (intern (string v) 'keyword))) + (t (if (symbolp (car v)) + (setq x (car v) + k (intern (string (car v)) 'keyword)) + (setq x (cadar v) k (caar v))) + (unless (endp (cdr v)) + (setq init (cadr v)) + (unless (endp (cddr v)) + (setq sv (caddr v)))))) + (dm-v temp `(getf ,rest ,k 'failed)) + (dm-v x `(if (eq ,temp 'failed) ,init ,temp)) + (when sv (dm-v sv `(not (eq ,temp 'failed)))) + (push k keys)) + (pop vl)) + (optionalp + (let (x (init nil) (sv nil)) + (cond ((symbolp v) (setq x v)) + (t (setq x (car v)) + (unless (endp (cdr v)) + (setq init (cadr v)) + (unless (endp (cddr v)) + (setq sv (caddr v)))))) + (dm-v x `(if ,(dm-nth-cdr n whole) ,(dm-nth n whole) ,init)) + (when sv (dm-v sv `(not (null ,(dm-nth-cdr n whole)))))) + (incf n) + (pop vl) + ) + (t (dm-v v `(if ,(dm-nth-cdr n whole) + ,(dm-nth n whole) + (dm-too-few-arguments))) + (incf n) + (pop vl)) + )))) + +(defun dm-v (v init) + (if (symbolp v) + (push (if init (list v init) v) *dl*) + (let ((temp (gensym))) + (push (if init (list temp init) temp) *dl*) + (dm-vl v temp nil)))) + +(defun dm-nth (n v) + (multiple-value-bind (q r) (floor n 4) + (dotimes (i q) (setq v (list 'cddddr v))) + (case r + (0 (list 'car v)) + (1 (list 'cadr v)) + (2 (list 'caddr v)) + (3 (list 'cadddr v)) + ))) + +(defun dm-nth-cdr (n v) + (multiple-value-bind (q r) (floor n 4) + (dotimes (i q) (setq v (list 'cddddr v))) + (case r + (0 v) + (1 (list 'cdr v)) + (2 (list 'cddr v)) + (3 (list 'cdddr v)) + ))) + +(defun dm-bad-key (key) + (error "Defmacro-lambda-list contains illegal use of ~s." key)) + +(defun dm-too-few-arguments () + (error "Too few arguments are supplied to defmacro-lambda-list.")) + +(defun dm-too-many-arguments () + (error "Too many arguments are supplied to defmacro-lambda-list.")) + +(defun dm-key-not-allowed (key) + (error "The key ~s is not allowed." key)) + +(defun find-doc (body ignore-doc) + (if (endp body) + (values nil nil nil) + (let ((d (macroexpand (car body)))) + (cond ((stringp d) + (if (or (endp (cdr body)) ignore-doc) + (values nil nil (cons d (cdr body))) + (multiple-value-bind (doc decls b) (find-doc (cdr body) t) + (declare (ignore doc)) + (values d decls b)))) + ((and (consp d) (eq (car d) 'declare)) + (multiple-value-bind (doc decls b) + (find-doc (cdr body) ignore-doc) + (values doc (cons d decls) b))) + (t (values nil nil (cons d (cdr body)))))))) + +(defun find-declarations (body) + (if (endp body) + (values nil nil) + (let ((d (macroexpand (car body)))) + (cond ((stringp d) + (if (endp (cdr body)) + (values nil (list d)) + (multiple-value-bind (ds b) + (find-declarations (cdr body)) + (values (cons d ds) b)))) + ((and (consp d) (eq (car d) 'declare)) + (multiple-value-bind (ds b) + (find-declarations (cdr body)) + (values (cons d ds) b))) + (t + (values nil (cons d (cdr body)))))))) + diff --git a/lsp/gcl_defpackage.lsp b/lsp/gcl_defpackage.lsp new file mode 100644 index 0000000..fb8e8a2 --- /dev/null +++ b/lsp/gcl_defpackage.lsp @@ -0,0 +1,339 @@ +;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Package: (DEFPACKAGE :COLON-MODE :EXTERNAL) -*- +;;; +;;; THE BOEING COMPANY +;;; BOEING COMPUTER SERVICES +;;; RESEARCH AND TECHNOLOGY +;;; COMPUTER SCIENCE +;;; P.O. BOX 24346, MS 7L-64 +;;; SEATTLE, WA 98124-0346 +;;; +;;; +;;; Copyright (c) 1990, 1991 The Boeing Company, All Rights Reserved. +;;; +;;; Permission is granted to any individual or institution to use, +;;; copy, modify, and distribute this software, provided that this +;;; complete copyright and permission notice is maintained, intact, in +;;; all copies and supporting documentation and that modifications are +;;; appropriately documented with date, author and description of the +;;; change. +;;; +;;; Stephen L. Nicoud (snicoud@boeing.com) provides this software "as +;;; is" without express or implied warranty by him or The Boeing +;;; Company. +;;; +;;; This software is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY. No author or distributor accepts +;;; responsibility to anyone for the consequences of using it or for +;;; whether it serves any particular purpose or works at all. +;;; +;;; Author: Stephen L. Nicoud +;;; +;;; ----------------------------------------------------------------- +;;; +;;; Read-Time Conditionals used in this file. +;;; +;;; #+LISPM +;;; #+EXCL +;;; #+SYMBOLICS +;;; #+TI +;;; +;;; ----------------------------------------------------------------- + +;;; ----------------------------------------------------------------- +;;; +;;; DEFPACKAGE - This files attempts to define a portable +;;; implementation for DEFPACKAGE, as defined in "Common LISP, The +;;; Language", by Guy L. Steele, Jr., Second Edition, 1990, Digital +;;; Press. +;;; +;;; Send comments, suggestions, and/or questions to: +;;; +;;; Stephen L Nicoud +;;; +;;; An early version of this file was tested in Symbolics Common +;;; Lisp (Genera 7.2 & 8.0 on a Symbolics 3650 Lisp Machine), +;;; Franz's Allegro Common Lisp (Release 3.1.13 on a Sun 4, SunOS +;;; 4.1), and Sun Common Lisp (Lucid Common Lisp 3.0.2 on a Sun 3, +;;; SunOS 4.1). +;;; +;;; 91/5/23 (SLN) - Since the initial testing, modifications have +;;; been made to reflect new understandings of what DEFPACKAGE +;;; should do. These new understandings are the result of +;;; discussions appearing on the X3J13 and Common Lisp mailing +;;; lists. Cursory testing was done on the modified version only +;;; in Allegro Common Lisp (Release 3.1.13 on a Sun 4, SunOS 4.1). +;;; +;;; ----------------------------------------------------------------- + + +(lisp:in-package :DEFPACKAGE) + +(export '(defpackage)) +;(provide :defpackage) + +(use-package :SLOOP) +;(use-package :DEFPACKAGE) + +(proclaim '(declaration values arglist)) + + +;#-gcl +;(eval-when (compile load eval) +; #-lispm +; (unless (member :loop *features*) +; (require :loop #+excl (merge-pathnames "loop" excl::*library-code-fasl-pathname*))) +; +; (unless (find-package :common-lisp) +; (rename-package :lisp :common-lisp (union '("CL" "LISP") (package-nicknames (find-package :lisp)) :test #'string=))) +; (unless (find-package :common-lisp-user) +; (rename-package :user :common-lisp-user (union '("CL-USER" "USER") (package-nicknames (find-package :user)) :test #'string=))) +; +; #+lispm +; (shadow (intern "DEFPACKAGE" #+symbolics :scl #+ti :ticl) 'defpackage) +; (proclaim '(declaration values arglist)) +; (export 'defpackage 'defpackage) +; ) + +(defmacro DEFPACKAGE (name &rest options) + (declare (type (or symbol string) name) + (arglist defined-package-name &rest options) + (values package)) + "DEFPACKAGE - DEFINED-PACKAGE-NAME {OPTION}* [Macro] + + This creates a new package, or modifies an existing one, whose name is + DEFINED-PACKAGE-NAME. The DEFINED-PACKAGE-NAME may be a string or a + symbol; if it is a symbol, only its print name matters, and not what + package, if any, the symbol happens to be in. The newly created or + modified package is returned as the value of the DEFPACKAGE form. + + Each standard OPTION is a list of keyword (the name of the option) + and associated arguments. No part of a DEFPACKAGE form is evaluated. + Except for the :SIZE and :DOCUMENTATION options, more than one option + of the same kind may occur within the same DEFPACKAGE form. + + Valid Options: + (:documentation string) + (:size integer) + (:nicknames {package-name}*) + (:shadow {symbol-name}*) + (:shadowing-import-from package-name {symbol-name}*) + (:use {package-name}*) + (:import-from package-name {symbol-name}*) + (:intern {symbol-name}*) + (:export {symbol-name}*) + (:export-from {package-name}*) + + [Note: :EXPORT-FROM is an extension to DEFPACKAGE. + If a symbol is interned in the package being created and + if a symbol with the same print name appears as an external + symbol of one of the packages in the :EXPORT-FROM option, + then the symbol is exported from the package being created. + + :DOCUMENTATION is an extension to DEFPACKAGE. + + :SIZE is used only in Genera and Allegro.]" + + (sloop for option in options + unless (member + (first option) + '(:documentation :size :nicknames :shadow + :shadowing-import-from :use :import-from + :intern :export :export-from)) + do (cerror "Proceed, ignoring this option." "~s is not a valid option." option)) + (labels ((option-test (arg1 arg2) (when (consp arg2) (equal (car arg2) arg1))) + (option-values-list (option options) + (sloop for result = (member option options + ':test #'option-test) + then (member option (rest result) + ':test #'option-test) + until (null result) when result collect + (rest (first result)))) + (option-values (option options) + (sloop for result = (member option options ':test #'option-test) + then (member option (rest result) ':test #'option-test) + until (null result) when result append + (rest (first result))))) + (sloop for option in '(:size :documentation) + when (<= 2 (count option options ':key #'car)) + do (error 'program-error :format-control "DEFPACKAGE option ~s specified more than once." + :format-arguments (list option))) + (setq name (string name)) + (let ((nicknames (mapcar #'string (option-values ':nicknames options))) + (documentation (first (option-values ':documentation options))) + (size (first (option-values ':size options))) + (shadowed-symbol-names (mapcar #'string (option-values ':shadow options))) + (interned-symbol-names (mapcar #'string (option-values ':intern options))) + (exported-symbol-names (mapcar #'string (option-values ':export options))) + (shadowing-imported-from-symbol-names-list + (sloop for list in (option-values-list ':shadowing-import-from options) + collect (cons (string (first list)) (mapcar #'string (rest list))))) + (imported-from-symbol-names-list + (sloop for list in (option-values-list ':import-from options) + collect (cons (string (first list)) (mapcar #'string (rest list))))) + (exported-from-package-names + (mapcar #'string (option-values ':export-from options)))) + (flet ((find-duplicates + (&rest lists) + (let (results) + (sloop for list in lists + for more on (cdr lists) + for i from 1 + do + (sloop for elt in list + as entry = (find elt results :key #'car :test #'string=) + unless (member i entry) + do + (sloop for l2 in more + for j from (1+ i) + do + (if (member elt l2 :test #'string=) + (if entry + (nconc entry (list j)) + (setq entry + (car (push + (list elt i j) results)))))))) + results))) + (sloop for duplicate in + (find-duplicates + shadowed-symbol-names + interned-symbol-names + (sloop for list in shadowing-imported-from-symbol-names-list + append (rest list)) + (sloop for list in imported-from-symbol-names-list + append (rest list))) + do + (error + 'program-error + :format-control "The symbol ~s cannot coexist in these lists:~{ ~s~}" + :format-arguments + (list (first duplicate) + (sloop for num in (rest duplicate) + collect + (case num + (1 :SHADOW) + (2 :INTERN) + (3 :SHADOWING-IMPORT-FROM) + (4 :IMPORT-FROM)))))) + (sloop for duplicate in + (find-duplicates exported-symbol-names interned-symbol-names) + do + (error + 'program-error + :format-control "The symbol ~s cannot coexist in these lists:~{ ~s~}" + :format-arguments + (list (first duplicate) + (sloop for num in + (rest duplicate) + collect (case num + (1 :EXPORT) + (2 :INTERN))))))) + `(eval-when (load eval compile) + (if (find-package ,name) + (progn (rename-package ,name ,name) + ,@(when nicknames + `((rename-package ,name ,name ',nicknames))) + #+(or symbolics excl) + ,@(when size + #+symbolics + `((when (> ,size (pkg-max-number-of-symbols + (find-package ,name))) + (pkg-rehash (find-package ,name) ,size))) + #+excl `((let + ((tab (excl::package-internal-symbols + (find-package ,name)))) + (when (hash-table-p tab) + (setf (excl::ha_rehash-size tab) ,size))))) + ,@(when (not (null (member ':use options ':key #'car))) + `((unuse-package + (package-use-list (find-package ,name)) ,name)))) + (make-package + ,name + ':use 'nil + ':nicknames + ',nicknames + ,@(when size + #+lispm `(:size ,size) + #+excl `(:internal-symbols ,size)))) + ,@(progn + `((setf (get ',(intern name :keyword) + 'si::package-documentation) + ,documentation)) + ) + (let ((*package* (find-package ,name))) + ,@(when SHADOWed-symbol-names + `((SHADOW (mapcar #'intern ',SHADOWed-symbol-names)))) + ,@(when SHADOWING-IMPORTed-from-symbol-names-list + (mapcar #'(lambda (list) + `(SHADOWING-IMPORT + (mapcar #'(lambda (symbol) + (unless (multiple-value-bind (s p) (find-symbol symbol ,(first list)) p) + (cerror "Continue anyway" 'package-error + :package (first list) + :format-control "~%Symbol ~a not present" + :format-arguments (list symbol))) + (intern symbol ,(first list))) + ',(rest list)))) + SHADOWING-IMPORTed-from-symbol-names-list)) + (USE-PACKAGE ',(if (member ':USE options ':test #'option-test) + (mapcar #'string (option-values ':USE options)) + "LISP")) + ,@(when IMPORTed-from-symbol-names-list + (mapcar #'(lambda (list) + `(IMPORT (mapcar #'(lambda (symbol) + (unless (multiple-value-bind (s p) (find-symbol symbol ,(first list)) p) + (cerror "Continue anyway" 'package-error + :package (first list) + :format-control "~%Symbol ~a not present" + :format-arguments (list symbol))) + (intern symbol ,(first list))) + ',(rest list)))) + IMPORTed-from-symbol-names-list)) + ,@(when INTERNed-symbol-names + `((mapcar #'INTERN ',INTERNed-symbol-names))) + ,@(when EXPORTed-symbol-names + `((EXPORT (mapcar #'intern ',EXPORTed-symbol-names)))) + ,@(when EXPORTed-from-package-names + `((dolist (package ',EXPORTed-from-package-names) + (do-external-symbols + (symbol (find-package package)) + (when (nth 1 (multiple-value-list + (find-symbol (string symbol)))) + (EXPORT (list (intern (string symbol))))))))) + ) + (find-package ,name))))) + +;#+excl +;(excl::defadvice cl:documentation (look-for-package-type :around) +; (let ((symbol (first excl::arglist)) +; (type (second excl::arglist))) +; (if (or (eq ':package (intern (string type) :keyword)) +; (eq ':defpackage (intern (string type) :keyword))) +; (or (get symbol 'excl::%package-documentation) +; (get (intern (string symbol) :keyword) 'excl::%package-documentation)) +; (values :do-it)))) + +;#+symbolics +;(scl::advise cl:documentation :around look-for-package-type nil +; (let ((symbol (first scl::arglist)) +; (type (second scl::arglist))) +; (if (or (eq ':package (intern (string type) :keyword)) +; (eq ':defpackage (intern (string type) :keyword))) +; (or (get symbol ':package-documentation) +; (get (intern (string symbol) :keyword) ':package-documentation)) +; (values :do-it)))) + +;(pushnew :defpackage *features*) +;(unintern 'defpackage 'user) + +(provide :defpackage) +(pushnew :defpackage *features*) + +(eval-when (load) + (in-package "USER") + (unintern 'defpackage 'user) + (use-package "DEFPACKAGE")) + +;;;; ------------------------------------------------------------ +;;;; End of File +;;;; ------------------------------------------------------------ + diff --git a/lsp/gcl_defstruct.lsp b/lsp/gcl_defstruct.lsp new file mode 100755 index 0000000..8b429e8 --- /dev/null +++ b/lsp/gcl_defstruct.lsp @@ -0,0 +1,881 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; DEFSTRUCT.LSP +;;;; +;;;; The structure routines. + + +(in-package :si) + + +(proclaim '(optimize (safety 2) (space 3))) + + + +(defvar *accessors* (make-array 10 :adjustable t)) +(defvar *list-accessors* (make-array 2 :adjustable t)) +(defvar *vector-accessors* (make-array 2 :adjustable t)) + +(or (fboundp 'record-fn) (setf (symbol-function 'record-fn) + #'(lambda (&rest l) l nil))) + +(defun make-access-function (name conc-name no-conc type named include no-fun + ;; from apply + slot-name default-init slot-type read-only + offset &optional predicate ) + (declare (ignore named default-init predicate )) + + (let ((access-function + (if no-conc + slot-name + (intern (si:string-concatenate (string conc-name) + (string slot-name))))) + accsrs dont-overwrite) + (ecase type + ((nil) + (setf accsrs *accessors*)) + (list + (setf accsrs *list-accessors*)) + (vector + (setf accsrs *vector-accessors*))) + (or (> (length accsrs) offset) + (adjust-array accsrs (+ offset 10))) + (unless + dont-overwrite + (record-fn access-function 'defun '(t) slot-type) + (or no-fun + (and (fboundp access-function) + (eq (aref accsrs offset) (symbol-function access-function))) + (setf (symbol-function access-function) + (or (aref accsrs offset) + (setf (aref accsrs offset) + (cond ((eq accsrs *accessors*) + #'(lambda (x) + (or (structurep x) + (error "~a is not a structure" x)) + (structure-ref1 x offset))) + ((eq accsrs *list-accessors*) + #'(lambda(x) + (si:list-nth offset x))) + ((eq accsrs *vector-accessors*) + #'(lambda(x) + (aref x offset))))))))) + (cond (read-only + (remprop access-function 'structure-access) + (setf (get access-function 'struct-read-only) t)) + (t (remprop access-function 'setf-update-fn) + (remprop access-function 'setf-lambda) + (remprop access-function 'setf-documentation) + (let ((tem (get access-function 'structure-access))) + (cond ((and (consp tem) include + (subtypep include (car tem)) + (eql (cdr tem) offset)) + ;; don't change overwrite accessor of subtype. + (setq dont-overwrite t) + ) + (t (setf (get access-function 'structure-access) + (cons (if type type name) offset)) + (when slot-type + (proclaim `(ftype (function (,name) ,slot-type) ,access-function))) + ))))) + nil)) + + +(defun make-constructor (name constructor type named + slot-descriptions) + (declare (ignore named)) + (let ((slot-names + ;; Collect the slot-names. + (mapcar #'(lambda (x) + (cond ((null x) + ;; If the slot-description is NIL, + ;; it is in the padding of initial-offset. + nil) + ((null (car x)) + ;; If the slot name is NIL, + ;; it is the structure name. + ;; This is for typed structures with names. + (list 'quote (cadr x))) + (t (car x)))) + slot-descriptions)) + (keys + ;; Make the keyword parameters. + (mapcan #'(lambda (x) + (cond ((null x) nil) + ((null (car x)) nil) + ((null (cadr x)) (list (car x))) + (t (list (list (car x) (cadr x)))))) + slot-descriptions))) + (cond ((consp constructor) + ;; The case for a BOA constructor. + ;; Dirty code!! + ;; We must add an initial value for an optional parameter, + ;; if the default value is not specified + ;; in the given parameter list and yet the initial value + ;; is supplied in the slot description. + (do ((a (cadr constructor) (cdr a)) (l nil) (vs nil)) + ((endp a) + ;; Add those options that do not appear in the parameter list + ;; as auxiliary paramters. + ;; The parameters are accumulated in the variable VS. + (setq keys + (nreconc (cons '&aux l) + (mapcan #'(lambda (k) + (if (member (if (atom k) k (car k)) + vs) + nil + (list k))) + keys)))) + ;; Skip until &OPTIONAL appears. + (when (member (car a) lambda-list-keywords) + (or (eq (car a) '&optional) (push '&optional a))) + (cond ((eq (car a) '&optional) + (setq l (cons '&optional l)) + (do ((aa (cdr a) (cdr aa)) (ov) (y)) + ((endp aa) + ;; Add those options that do not appear in the + ;; parameter list. + (setq keys + (nreconc (cons '&aux l) + (mapcan #'(lambda (k) + (if (member (if (atom k) + k + (car k)) + vs) + nil + (list k))) + keys))) + (return nil)) + (when (member (car aa) lambda-list-keywords) + (when (eq (car aa) '&rest) + ;; &REST is found. + (setq l (cons '&rest l)) + (setq aa (cdr aa)) + (unless (and (not (endp aa)) + (symbolp (car aa))) + (illegal-boa)) + (setq vs (cons (car aa) vs)) + (setq l (cons (car aa) l)) + (setq aa (cdr aa)) + (when (endp aa) + (setq keys + (nreconc + (cons '&aux l) + (mapcan + #'(lambda (k) + (if (member (if (atom k) + k + (car k)) + vs) + nil + (list k))) + keys))) + (return nil))) + ;; &AUX should follow. + (unless (eq (car aa) '&aux) + (illegal-boa)) + (setq l (cons '&aux l)) + (do ((aaa (cdr aa) (cdr aaa))) + ((endp aaa)) + (setq l (cons (car aaa) l)) + (cond ((and (atom (car aaa)) + (symbolp (car aaa))) + (setq vs (cons (car aaa) vs))) + ((and (symbolp (caar aaa)) + (or (endp (cdar aaa)) + (endp (cddar aaa)))) + (setq vs (cons (caar aaa) vs))) + (t (illegal-boa)))) + ;; End of the parameter list. + (setq keys + (nreconc l + (mapcan + #'(lambda (k) + (if (member (if (atom k) + k + (car k)) + vs) + nil + (list k))) + keys))) + (return nil)) + ;; Checks if the optional paramter without a default + ;; value has a default value in the slot-description. + (if (and (cond ((atom (car aa)) (setq ov (car aa)) t) + ((endp (cdar aa)) (setq ov (caar aa)) t) + (t nil)) + (setq y (member ov + keys + :key + #'(lambda (x) + (if (consp x) + ;; With default value. + (car x)))))) + ;; If no default value is supplied for + ;; the optional parameter and yet appears + ;; in KEYS with a default value, + ;; then cons the pair to L, + (setq l (cons (car y) l)) + ;; otherwise cons just the parameter to L. + (setq l (cons (car aa) l))) + ;; Checks the form of the optional parameter. + (cond ((atom (car aa)) + (unless (symbolp (car aa)) + (illegal-boa)) + (setq vs (cons (car aa) vs))) + ((not (symbolp (caar aa))) + (illegal-boa)) + ((or (endp (cdar aa)) (endp (cddar aa))) + (setq vs (cons (caar aa) vs))) + ((not (symbolp (caddar aa))) + (illegal-boa)) + ((not (endp (cdddar aa))) + (illegal-boa)) + (t + (setq vs (cons (caar aa) vs)) + (setq vs (cons (caddar aa) vs))))) + ;; RETURN from the outside DO. + (return nil)) + (t + (unless (symbolp (car a)) + (illegal-boa)) + (setq l (cons (car a) l)) + (setq vs (cons (car a) vs))))) + (setq constructor (car constructor))) + (t + ;; If not a BOA constructor, just cons &KEY. + (setq keys (cons '&key keys)))) + (cond ((null type) + `(defun ,constructor ,keys + (si:make-structure ',name ,@slot-names))) + ((or (eq type 'vector) + (and (consp type) (eq (car type) 'vector))) + `(defun ,constructor ,keys + (vector ,@slot-names))) + ((eq type 'list) + `(defun ,constructor ,keys + (list ,@slot-names))) + ((error "~S is an illegal structure type" type))))) + +(defun illegal-boa () + (error "An illegal BOA constructor.")) + +(defun make-predicate (name predicate type named name-offset) + (cond ((null type)) + ; done in define-structure + ((or (eq type 'vector) + (and (consp type) (eq (car type) 'vector))) + ;; The name is at the NAME-OFFSET in the vector. + (unless named (error "The structure should be named.")) + `(defun ,predicate (x) + (and (vectorp x) + (> (the fixnum (length x)) ,name-offset) + (eq (aref (the (vector t) x) ,name-offset) ',name)))) + ((eq type 'list) + ;; The name is at the NAME-OFFSET in the list. + (unless named (error "The structure should be named.")) + (if (= name-offset 0) + `(defun ,predicate (x) + (and (consp x) + (eq (car x) ',name))) + `(defun ,predicate (x) + (do ((i ,name-offset (1- i)) + (z x (cdr z))) + ((= i 0) (and (consp z) (eq (car z) ',name))) + (declare (fixnum i)) + (unless (consp z) (return nil)))))) + ((error "~S is an illegal structure type.")))) + + +;;; PARSE-SLOT-DESCRIPTION parses the given slot-description +;;; and returns a list of the form: +;;; (slot-name default-init slot-type read-only offset) + +(defun parse-slot-description (slot-description offset) + (let (slot-name default-init slot-type read-only) + (cond ((atom slot-description) + (setq slot-name slot-description)) + ((endp (cdr slot-description)) + (setq slot-name (car slot-description))) + (t + (setq slot-name (car slot-description)) + (setq default-init (cadr slot-description)) + (do ((os (cddr slot-description) (cddr os)) (o) (v)) + ((endp os)) + (setq o (car os)) + (when (endp (cdr os)) + (error "~S is an illegal structure slot option." + os)) + (setq v (cadr os)) + (case o + (:type (setq slot-type v)) + (:read-only (setq read-only v)) + (t + (error "~S is an illegal structure slot option." + os)))))) + (list slot-name default-init slot-type read-only offset))) + + +;;; OVERWRITE-SLOT-DESCRIPTIONS overwrites the old slot-descriptions +;;; with the new descriptions which are specified in the +;;; :include defstruct option. + +(defun overwrite-slot-descriptions (news olds) + (if (null olds) + nil + (let ((sds (member (caar olds) news :key #'car))) + (cond (sds + (when (and (null (cadddr (car sds))) + (cadddr (car olds))) + ;; If read-only is true in the old + ;; and false in the new, signal an error. + (error "~S is an illegal include slot-description." + sds)) + ;; If + (setf (caddr (car sds)) + (best-array-element-type (caddr (car sds)))) + (when (not (equal (normalize-type (or (caddr (car sds)) t)) + (normalize-type (or (caddr (car olds)) t)))) + (error "Type mismmatch for included slot ~a" (car sds))) + (cons (list (caar sds) + (cadar sds) + (caddar sds) + (cadddr (car sds)) + ;; The offset if from the old. + (car (cddddr (car olds)))) + (overwrite-slot-descriptions news (cdr olds)))) + (t + (cons (car olds) + (overwrite-slot-descriptions news (cdr olds)))))))) + +(defvar *all-t-s-type* (make-array 50 :element-type 'unsigned-char :static t)) +(defvar *alignment-t* (alignment t)) + +(defun make-t-type (n include slot-descriptions &aux i) + (let ((res (make-array n :element-type 'unsigned-char :static t))) + (when include + (let ((tem (get include 's-data))raw) + (or tem (error "Included structure undefined ~a" include)) + (setq raw (s-data-raw tem)) + (dotimes (i (min n (length raw))) + (setf (aref res i) (aref raw i))))) + (dolist (v slot-descriptions) + (setq i (nth 4 v)) + (let ((type (third v))) + (cond ((<= (the fixnum (alignment type)) *alignment-t*) + (setf (aref res i) (aet-type type)))))) + (cond ((< n (length *all-t-s-type*)) + (dotimes (i n) + (cond ((not (eql (the fixnum (aref res i)) 0)) + (return-from make-t-type res)))) + *all-t-s-type*) + (t res)))) + +(defvar *standard-slot-positions* + (let ((ar (make-array 50 :element-type 'unsigned-short + :static t))) + (dotimes (i 50) + (declare (fixnum i)) + (setf (aref ar i)(* (size-of t) i))) + ar)) + +(eval-when (compile ) +(proclaim '(function round-up (fixnum fixnum ) fixnum)) +) + +(defun round-up (a b) + (declare (fixnum a b)) + (setq a (ceiling a b)) + (the fixnum (* a b))) + + +(defun get-slot-pos (leng include slot-descriptions &aux type small-types + has-holes) + (declare (special *standard-slot-positions*)) include + (dolist (v slot-descriptions) + (when (and v (car v)) + (setf type + (best-array-element-type (caddr v)) + (caddr v) type) + (let ((val (second v))) + (unless (typep val type) + (if (and (symbolp val) + (constantp val)) + (setf val (symbol-value val))) + (and (constantp val) + (setf (cadr v) (coerce val type))))) + (cond ((memq type '(signed-char unsigned-char + short unsigned-short + long-float + bit)) + (setq small-types t))))) + (cond ((and (null small-types) + (< leng (length *standard-slot-positions*)) + (list *standard-slot-positions* (* leng (size-of t)) nil))) + (t (let ((ar (make-array leng :element-type 'unsigned-short + :static t)) + (pos 0)(i 0)(align 0)type (next-pos 0)) + (declare (fixnum pos i align next-pos)) + ;; A default array. + + (dolist + (v slot-descriptions) + (setq type (caddr v)) + (setq align (alignment type)) + (unless (<= align *alignment-t*) + (setq type t) + (setf (caddr v) t) + (setq align *alignment-t*) + (setq v (nconc v '(t)))) + (setq next-pos (round-up pos align)) + (or (eql pos next-pos) (setq has-holes t)) + (setq pos next-pos) + (setf (aref ar i) pos) + (incf pos (size-of type)) + (incf i)) + (list ar (round-up pos (size-of t)) has-holes) + )))) + + + + + + + + + + + + + + + + + + + + + + + +(defun define-structure (name conc-name no-conc type named slot-descriptions copier + static include print-function constructors + offset predicate &optional documentation no-funs + &aux def leng) + (and (consp type) (eq (car type) 'vector)(setq type 'vector)) + (setq leng(length slot-descriptions)) + (dolist (x slot-descriptions) + (and x (car x) + (apply #'make-access-function + name conc-name no-conc type named include no-funs + x ))) + (when (and copier (not no-funs)) + (setf (symbol-function copier) + (ecase type + ((nil) #'si::copy-structure) + (list #'copy-list) + (vector #'copy-seq)))) + + + (cond ((and (null type) + (eq name 's-data)) + ;bootstrapping code! + (setq def (make-s-data-structure + (make-array (* leng (size-of t)) + :element-type 'character :static t) + (make-t-type leng nil slot-descriptions) + *standard-slot-positions* + slot-descriptions + t + )) + ) + (t + (let (slot-position + (size 0) has-holes + (include-str (and include + (get include 's-data)))) + (when include-str + (cond ((and (s-data-frozen include-str) + (or (not (s-data-included include-str)) + (not (let ((te (get name 's-data))) + (and te + (eq (s-data-includes + te) + include-str)))))) + (warn " ~a was frozen but now included" + include))) + (pushnew name (s-data-included include-str))) + (when (null type) + (setf slot-position + (get-slot-pos leng include slot-descriptions)) + (setf size (cadr slot-position) + has-holes (caddr slot-position) + slot-position (car slot-position) + )) + (setf def (make-s-data + :name name + :length leng + :raw + (and (null type) + (make-t-type leng include slot-descriptions)) + :slot-position slot-position + :size size + :has-holes has-holes + :staticp static + :includes include-str + :print-function print-function + :slot-descriptions slot-descriptions + :constructors constructors + :offset offset + :type type + :named named + :documentation documentation + :conc-name conc-name))))) + (let ((tem (get name 's-data))) + (cond ((eq name 's-data) + (if tem (warn "not replacing s-data property")) + (or tem (setf (get name 's-data) def))) + (tem + (check-s-data tem def name)) + (t (setf (get name 's-data) def))) + (when documentation + (setf (get name 'structure-documentation) + documentation)) + (when (and (null type) predicate) + (record-fn predicate 'defun '(t) t) + (or no-funs + (setf (symbol-function predicate) + #'(lambda (x) + (si::structure-subtype-p x name)))) + (proclaim `(ftype (function (,name) t) ,predicate));FIXME boolean is unboxed + ) + ) nil) + + +(defmacro defstruct (name &rest slots) + (let ((slot-descriptions slots) + options + conc-name + constructors default-constructor no-constructor + copier + predicate predicate-specified + include + print-function type named initial-offset + offset name-offset + documentation + static + (no-conc nil)) + + (when (consp name) + ;; The defstruct options are supplied. + (setq options (cdr name)) + (setq name (car name))) + + ;; The default conc-name. + (setq conc-name (si:string-concatenate (string name) "-")) + + ;; The default constructor. + (setq default-constructor + (intern (si:string-concatenate "MAKE-" (string name)))) + + ;; The default copier and predicate. + (setq copier + (intern (si:string-concatenate "COPY-" (string name))) + predicate + (intern (si:string-concatenate (string name) "-P"))) + + ;; Parse the defstruct options. + (do ((os options (cdr os)) (o) (v)) + ((endp os)) + (cond ((and (consp (car os)) (not (endp (cdar os)))) + (setq o (caar os) v (cadar os)) + (case o + (:conc-name + (if (null v) + (progn + (setq conc-name "") + (setq no-conc t)) + (setq conc-name v))) + (:constructor + (if (null v) + (setq no-constructor t) + (if (endp (cddar os)) + (setq constructors (cons v constructors)) + (setq constructors (cons (cdar os) constructors))))) + (:copier (setq copier v)) + (:static (setq static v)) + (:predicate + (setq predicate v) + (setq predicate-specified t)) + (:include + (setq include (cdar os)) + (unless (get v 's-data) + (error "~S is an illegal included structure." v))) + (:print-function + (and (consp v) (eq (car v) 'function) + (setq v (second v))) + (setq print-function v)) + (:type (setq type v)) + (:initial-offset (setq initial-offset v)) + (t (error "~S is an illegal defstruct option." o)))) + (t + (if (consp (car os)) + (setq o (caar os)) + (setq o (car os))) + (case o + (:constructor + (setq constructors + (cons default-constructor constructors))) + ((:copier :predicate :print-function)) + (:conc-name + (progn + (setq conc-name "") + (setq no-conc t))) + (:named (setq named t)) + (t (error "~S is an illegal defstruct option." o)))))) + + (setq conc-name (intern (string conc-name))) + + (and include (not print-function) + (setq print-function (s-data-print-function (get (car include) 's-data)))) + + ;; Skip the documentation string. + (when (and (not (endp slot-descriptions)) + (stringp (car slot-descriptions))) + (setq documentation (car slot-descriptions)) + (setq slot-descriptions (cdr slot-descriptions))) + + ;; Check the include option. + (when include + (unless (equal type + (s-data-type (get (car include) 's-data))) + (error "~S is an illegal structure include." + (car include)))) + + ;; Set OFFSET. + (cond ((null include) + (setq offset 0)) + (t + (setq offset (s-data-offset (get (car include) 's-data))))) + + ;; Increment OFFSET. + (when (and type initial-offset) + (setq offset (+ offset initial-offset))) + (when (and type named) + (setq name-offset offset) + (setq offset (1+ offset))) + + ;; Parse slot-descriptions, incrementing OFFSET for each one. + (do ((ds slot-descriptions (cdr ds)) + (sds nil)) + ((endp ds) + (setq slot-descriptions (nreverse sds))) + (setq sds (cons (parse-slot-description (car ds) offset) sds)) + (setq offset (1+ offset))) + + ;; If TYPE is non-NIL and structure is named, + ;; add the slot for the structure-name to the slot-descriptions. + (when (and type named) + (setq slot-descriptions + (cons (list nil name) slot-descriptions))) + + ;; Pad the slot-descriptions with the initial-offset number of NILs. + (when (and type initial-offset) + (setq slot-descriptions + (append (make-list initial-offset) slot-descriptions))) + + ;; Append the slot-descriptions of the included structure. + ;; The slot-descriptions in the include option are also counted. + (cond ((null include)) + ((endp (cdr include)) + (setq slot-descriptions + (append (s-data-slot-descriptions + (get (car include) 's-data)) + slot-descriptions))) + (t + (setq slot-descriptions + (append (overwrite-slot-descriptions + (mapcar #'(lambda (sd) + (parse-slot-description sd 0)) + (cdr include)) + (s-data-slot-descriptions + (get (car include) 's-data) + )) + slot-descriptions)))) + + (cond (no-constructor + ;; If a constructor option is NIL, + ;; no constructor should have been specified. + (when constructors + (error "Contradictory constructor options."))) + ((null constructors) + ;; If no constructor is specified, + ;; the default-constructor is made. + (setq constructors (list default-constructor)))) + + ;; We need a default constructor for the sharp-s-reader + (or (member t (mapcar 'symbolp constructors)) + (push (intern (string-concatenate "__si::" default-constructor)) + constructors)) + + ;; Check the named option and set the predicate. + (when (and type (not named)) + (when predicate-specified + (error "~S is an illegal structure predicate." + predicate)) + (setq predicate nil)) + + (when include (setq include (car include))) + + ;; Check the print-function. + (when (and print-function type) + (error "A print function is supplied to a typed structure.")) + + `(progn + (define-structure ',name ',conc-name ',no-conc ',type + ',named ',slot-descriptions ',copier ',static ',include ',print-function ',constructors + ',offset ',predicate ',documentation + ) + + ,@(mapcar #'(lambda (constructor) + (make-constructor name constructor type named + slot-descriptions)) + constructors) + ,@(if (and type predicate) + (list (make-predicate name predicate type named + name-offset))) + ',name + ))) + +;; First several fields of this must coincide with the C structure +;; s_data (see object.h). + + +(defstruct s-data name + (length 0 :type fixnum) + raw + included + includes + staticp + print-function + slot-descriptions + slot-position + (size 0 :type fixnum) + has-holes + frozen + documentation + constructors + offset + named + type + conc-name + ) + + +(defun check-s-data (tem def name) + (cond ((s-data-included tem) + (setf (s-data-included def)(s-data-included tem)))) + (cond ((s-data-frozen tem) + (setf (s-data-frozen def) t))) + (unless (equalp def tem) + (warn "structure ~a is changing" name) + (setf (get name 's-data) def))) +(defun freeze-defstruct (name) + (let ((tem (and (symbolp name) (get name 's-data)))) + (if tem (setf (s-data-frozen tem) t)))) + + +;;; The #S reader. + +(defun sharp-s-reader (stream subchar arg) + (declare (ignore subchar)) + (when (and arg (null *read-suppress*)) + (error "An extra argument was supplied for the #S readmacro.")) + (let* ((l (prog1 (read stream t nil t) + (if *read-suppress* + (return-from sharp-s-reader nil)))) + (sd + (or (get (car l) 's-data) + + (error "~S is not a structure." (car l))))) + + ;; Intern keywords in the keyword package. + (do ((ll (cdr l) (cddr ll))) + ((endp ll) + ;; Find an appropriate construtor. + (do ((cs (s-data-constructors sd) (cdr cs))) + ((endp cs) + (error "The structure ~S has no structure constructor." + (car l))) + (when (symbolp (car cs)) + (return (apply (car cs) (cdr l)))))) + (rplaca ll (intern (string (car ll)) 'keyword))))) + + +;; Set the dispatch macro. +(set-dispatch-macro-character #\# #\s 'sharp-s-reader) +(set-dispatch-macro-character #\# #\S 'sharp-s-reader) + +;; Examples from Common Lisp Reference Manual. + +#| +(defstruct ship + x-position + y-position + x-velocity + y-velocity + mass) + +(defstruct person name (age 20 :type signed-char) (eyes 2 :type signed-char) + sex) +(defstruct person name (age 20 :type signed-char) (eyes 2 :type signed-char) + sex) +(defstruct person1 name (age 20 :type fixnum) + sex) + +(defstruct joe a (a1 0 :type (mod 30)) (a2 0 :type (mod 30)) + (a3 0 :type (mod 30)) (a4 0 :type (mod 30)) ) + +;(defstruct person name age sex) + +(defstruct (astronaut (:include person (age 45 :type fixnum)) + (:conc-name astro-)) + helmet-size + (favorite-beverage 'tang)) + +(defstruct (foo (:constructor create-foo (a + &optional b (c 'sea) + &rest d + &aux e (f 'eff)))) + a (b 'bee) c d e f) + +(defstruct (binop (:type list) :named (:initial-offset 2)) + (operator '?) + operand-1 + operand-2) + +(defstruct (annotated-binop (:type list) + (:initial-offset 3) + (:include binop)) + commutative + associative + identity) + +|# diff --git a/lsp/gcl_describe.lsp b/lsp/gcl_describe.lsp new file mode 100755 index 0000000..2c94e38 --- /dev/null +++ b/lsp/gcl_describe.lsp @@ -0,0 +1,448 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; describe.lsp +;;;; +;;;; DESCRIBE and INSPECT + + +(in-package :si) + + +(proclaim '(optimize (safety 2) (space 3))) + + +(defvar *inspect-level* 0) +(defvar *inspect-history* nil) +(defvar *inspect-mode* nil) + +(defvar *old-print-level* nil) +(defvar *old-print-length* nil) + + +(defun inspect-read-line () + (do ((char (read-char *query-io*) (read-char *query-io*))) + ((or (char= char #\Newline) (char= char #\Return))))) + +(defun read-inspect-command (label object allow-recursive) + (unless *inspect-mode* + (inspect-indent-1) + (if allow-recursive + (progn (princ label) (inspect-object object)) + (format t label object)) + (return-from read-inspect-command nil)) + (loop + (inspect-indent-1) + (if allow-recursive + (progn (princ label) + (inspect-indent) + (prin1 object)) + (format t label object)) + (write-char #\Space) + (force-output) + (case (do ((char (read-char *query-io*) (read-char *query-io*))) + ((and (char/= char #\Space) (char/= #\Tab)) char)) + ((#\Newline #\Return) + (when allow-recursive (inspect-object object)) + (return nil)) + ((#\n #\N) + (inspect-read-line) + (when allow-recursive (inspect-object object)) + (return nil)) + ((#\s #\S) (inspect-read-line) (return nil)) + ((#\p #\P) + (inspect-read-line) + (let ((*print-pretty* t) (*print-level* nil) (*print-length* nil)) + (prin1 object) + (terpri))) + ((#\a #\A) (inspect-read-line) (throw 'abort-inspect nil)) + ((#\u #\U) + (return (values t (prog1 + (eval (read-preserving-whitespace *query-io*)) + (inspect-read-line))))) + ((#\e #\E) + (dolist (x (multiple-value-list + (multiple-value-prog1 + (eval (read-preserving-whitespace *query-io*)) + (inspect-read-line)))) + (write x + :level *old-print-level* + :length *old-print-length*) + (terpri))) + ((#\q #\Q) (inspect-read-line) (throw 'quit-inspect nil)) + (t (inspect-read-line) + (terpri) + (format t + "Inspect commands:~%~ + n (or N or Newline): inspects the field (recursively).~%~ + s (or S): skips the field.~%~ + p (or P): pretty-prints the field.~%~ + a (or A): aborts the inspection ~ + of the rest of the fields.~%~ + u (or U) form: updates the field ~ + with the value of the form.~%~ + e (or E) form: evaluates and prints the form.~%~ + q (or Q): quits the inspection.~%~ + ?: prints this.~%~%"))))) + +(defmacro inspect-recursively (label object &optional place) + (if place + `(multiple-value-bind (update-flag new-value) + (read-inspect-command ,label ,object t) + (when update-flag (setf ,place new-value))) + `(when (read-inspect-command ,label ,object t) + (princ "Not updated.") + (terpri)))) + +(defmacro inspect-print (label object &optional place) + (if place + `(multiple-value-bind (update-flag new-value) + (read-inspect-command ,label ,object nil) + (when update-flag (setf ,place new-value))) + `(when (read-inspect-command ,label ,object nil) + (princ "Not updated.") + (terpri)))) + +(defun inspect-indent () + (fresh-line) + (format t "~V@T" + (* 4 (if (< *inspect-level* 8) *inspect-level* 8)))) + +(defun inspect-indent-1 () + (fresh-line) + (format t "~V@T" + (- (* 4 (if (< *inspect-level* 8) *inspect-level* 8)) 3))) + + +(defun inspect-symbol (symbol) + (let ((p (symbol-package symbol))) + (cond ((null p) + (format t "~:@(~S~) - uninterned symbol" symbol)) + ((eq p (find-package "KEYWORD")) + (format t "~:@(~S~) - keyword" symbol)) + (t + (format t "~:@(~S~) - ~:[internal~;external~] symbol in ~A package" + symbol + (multiple-value-bind (b f) + (find-symbol (symbol-name symbol) p) + (declare (ignore b)) + (eq f :external)) + (package-name p))))) + + (when (boundp symbol) + (if *inspect-mode* + (inspect-recursively "value:" + (symbol-value symbol) + (symbol-value symbol)) + (inspect-print "value:~% ~S" + (symbol-value symbol) + (symbol-value symbol)))) + + (do ((pl (symbol-plist symbol) (cddr pl))) + ((endp pl)) + (unless (and (symbolp (car pl)) + (or (eq (symbol-package (car pl)) (find-package 'system)) + (eq (symbol-package (car pl)) (find-package 'compiler)))) + (if *inspect-mode* + (inspect-recursively (format nil "property ~S:" (car pl)) + (cadr pl) + (get symbol (car pl))) + (inspect-print (format nil "property ~:@(~S~):~% ~~S" (car pl)) + (cadr pl) + (get symbol (car pl)))))) + + (when (print-doc symbol t) + (format t "~&-----------------------------------------------------------------------------~%")) + ) + +(defun inspect-package (package) + (format t "~S - package" package) + (when (package-nicknames package) + (inspect-print "nicknames: ~S" (package-nicknames package))) + (when (package-use-list package) + (inspect-print "use list: ~S" (package-use-list package))) + (when (package-used-by-list package) + (inspect-print "used-by list: ~S" (package-used-by-list package))) + (when (package-shadowing-symbols package) + (inspect-print "shadowing symbols: ~S" + (package-shadowing-symbols package)))) + +(defun inspect-character (character) + (format t + (cond ((standard-char-p character) "~S - standard character") + (t "~S - character")) + character) + (inspect-print "code: #x~X" (char-code character)) + (inspect-print "bits: ~D" (char-bits character)) + (inspect-print "font: ~D" (char-font character))) + +(defun inspect-number (number) + (case (type-of number) + (fixnum (format t "~S - fixnum (32 bits)" number)) + (bignum (format t "~S - bignum" number)) + (ratio + (format t "~S - ratio" number) + (inspect-recursively "numerator:" (numerator number)) + (inspect-recursively "denominator:" (denominator number))) + (complex + (format t "~S - complex" number) + (inspect-recursively "real part:" (realpart number)) + (inspect-recursively "imaginary part:" (imagpart number))) + ((short-float single-float) + (format t "~S - short-float" number) + (multiple-value-bind (signif expon sign) + (integer-decode-float number) + (declare (ignore sign)) + (inspect-print "exponent: ~D" expon) + (inspect-print "mantissa: ~D" signif))) + ((long-float double-float) + (format t "~S - long-float" number) + (multiple-value-bind (signif expon sign) + (integer-decode-float number) + (declare (ignore sign)) + (inspect-print "exponent: ~D" expon) + (inspect-print "mantissa: ~D" signif))))) + +(defun inspect-cons (cons) + (format t + (case (car cons) + ((lambda lambda-block lambda-closure lambda-block-closure) + "~S - function") + (quote "~S - constant") + (t "~S - cons")) + cons) + (when *inspect-mode* + (do ((i 0 (1+ i)) + (l cons (cdr l))) + ((atom l) + (inspect-recursively (format nil "nthcdr ~D:" i) + l (cdr (nthcdr (1- i) cons)))) + (inspect-recursively (format nil "nth ~D:" i) + (car l) (nth i cons))))) + +(defun inspect-string (string) + (format t (if (simple-string-p string) "~S - simple string" "~S - string") + string) + (inspect-print "dimension: ~D"(array-dimension string 0)) + (when (array-has-fill-pointer-p string) + (inspect-print "fill pointer: ~D" + (fill-pointer string) + (fill-pointer string))) + (when *inspect-mode* + (dotimes (i (array-dimension string 0)) + (inspect-recursively (format nil "aref ~D:" i) + (char string i) + (char string i))))) + +(defun inspect-vector (vector) + (format t (if (simple-vector-p vector) "~S - simple vector" "~S - vector") + vector) + (inspect-print "dimension: ~D" (array-dimension vector 0)) + (when (array-has-fill-pointer-p vector) + (inspect-print "fill pointer: ~D" + (fill-pointer vector) + (fill-pointer vector))) + (when *inspect-mode* + (dotimes (i (array-dimension vector 0)) + (inspect-recursively (format nil "aref ~D:" i) + (aref vector i) + (aref vector i))))) + +(defun inspect-array (array) + (format t (if (adjustable-array-p array) + "~S - adjustable aray" + "~S - array") + array) + (inspect-print "rank: ~D" (array-rank array)) + (inspect-print "dimensions: ~D" (array-dimensions array)) + (inspect-print "total size: ~D" (array-total-size array))) + +(defun inspect-structure (x &aux name) + (format t "Structure of type ~a ~%Byte:[Slot Type]Slot Name :Slot Value" + (setq name (type-of x))) + (let* ((sd (get name 'si::s-data)) + (spos (s-data-slot-position sd))) + (dolist (v (s-data-slot-descriptions sd)) + (format t "~%~4d:~@[[~s] ~]~20a:~s" + (aref spos (nth 4 v)) + (let ((type (nth 2 v))) + (if (eq t type) nil type)) + (car v) + (structure-ref1 x (nth 4 v)))))) + + +(defun inspect-object (object &aux (*inspect-level* *inspect-level*)) + (inspect-indent) + (when (and (not *inspect-mode*) + (or (> *inspect-level* 5) + (member object *inspect-history*))) + (prin1 object) + (return-from inspect-object)) + (incf *inspect-level*) + (push object *inspect-history*) + (catch 'abort-inspect + (cond ((symbolp object) (inspect-symbol object)) + ((packagep object) (inspect-package object)) + ((characterp object) (inspect-character object)) + ((numberp object) (inspect-number object)) + ((consp object) (inspect-cons object)) + ((stringp object) (inspect-string object)) + ((vectorp object) (inspect-vector object)) + ((arrayp object) (inspect-array object)) + ((structurep object)(inspect-structure object)) + (t (format t "~S - ~S" object (type-of object)))))) + + +(defun describe (object &aux (*inspect-mode* nil) + (*inspect-level* 0) + (*inspect-history* nil) + (*print-level* nil) + (*print-length* nil)) +; "The lisp function DESCRIBE." + (terpri) + (catch 'quit-inspect (inspect-object object)) + (terpri) + (values)) + +(defun inspect (object &aux (*inspect-mode* t) + (*inspect-level* 0) + (*inspect-history* nil) + (*old-print-level* *print-level*) + (*old-print-length* *print-length*) + (*print-level* 3) + (*print-length* 3)) +; "The lisp function INSPECT." + (read-line) + (princ "Type ? and a newline for help.") + (terpri) + (catch 'quit-inspect (inspect-object object)) + (terpri) + (values)) + +(defun print-doc (symbol &optional (called-from-apropos-doc-p nil) + &aux (f nil) x) + (flet ((doc1 (doc ind) + (setq f t) + (format t + "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A" + symbol ind doc)) + (good-package () + (if (eq (symbol-package symbol) (find-package "LISP")) + (find-package "SYSTEM") + *package*))) + + (cond ((special-operator-p symbol) + (doc1 (or (documentation symbol 'function) "") + (if (macro-function symbol) + "[Special form and Macro]" + "[Special form]"))) + ((macro-function symbol) + (doc1 (or (documentation symbol 'function) "") "[Macro]")) + ((fboundp symbol) + (doc1 + (or (documentation symbol 'function) + (if (consp (setq x (symbol-function symbol))) + (case (car x) + (lambda (format nil "~%Args: ~S" (cadr x))) + (lambda-block (format nil "~%Args: ~S" (caddr x))) + (lambda-closure + (format nil "~%Args: ~S" (car (cddddr x)))) + (lambda-block-closure + (format nil "~%Args: ~S" (cadr (cddddr x)))) + (t "")) + "")) + "[Function]")) + ((setq x (documentation symbol 'function)) + (doc1 x "[Macro or Function]"))) + + (cond ((constantp symbol) + (unless (and (eq (symbol-package symbol) (find-package "KEYWORD")) + (null (documentation symbol 'variable))) + (doc1 (or (documentation symbol 'variable) "") "[Constant]"))) + ((si:specialp symbol) + (doc1 (or (documentation symbol 'variable) "") + "[Special variable]")) + ((or (setq x (documentation symbol 'variable)) (boundp symbol)) + (doc1 (or x "") "[Variable]"))) + + (cond ((setq x (documentation symbol 'type)) + (doc1 x "[Type]")) + ((setq x (get symbol 'deftype-form)) + (let ((*package* (good-package))) + (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFTYPE." x) + "[Type]")))) + + (cond ((setq x (documentation symbol 'structure)) + (doc1 x "[Structure]")) + ((setq x (get symbol 'defstruct-form)) + (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFSTRUCT." x) + "[Structure]"))) + + (cond ((setq x (documentation symbol 'setf)) + (doc1 x "[Setf]")) + ((setq x (get symbol 'setf-update-fn)) + (let ((*package* (good-package))) + (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFSETF." + `(defsetf ,symbol ,(get symbol 'setf-update-fn))) + "[Setf]"))) + ((setq x (get symbol 'setf-lambda)) + (let ((*package* (good-package))) + (doc1 (format nil "~%Defined as: ~S~%See the doc of DEFSETF." + `(defsetf ,symbol ,@(get symbol 'setf-lambda))) + "[Setf]"))) + ((setq x (get symbol 'setf-method)) + (let ((*package* (good-package))) + (doc1 + (format nil + "~@[~%Defined as: ~S~%See the doc of DEFINE-SETF-METHOD.~]" + (if (consp x) + (case (car x) + (lambda `(define-setf-method ,@(cdr x))) + (lambda-block `(define-setf-method ,@(cddr x))) + (lambda-closure `(define-setf-method ,@(cddddr x))) + (lambda-block-closure + `(define-setf-method ,@(cdr (cddddr x)))) + (t nil)) + nil)) + "[Setf]")))) + ) + (idescribe (symbol-name symbol)) + (if called-from-apropos-doc-p + f + (progn (if f + (format t "~&-----------------------------------------------------------------------------") + (format t "~&No documentation for ~:@(~S~)." symbol)) + (values)))) + +(defun apropos-doc (string &optional (package 'lisp) &aux (f nil)) + (setq string (string string)) + (if package + (do-symbols (symbol package) + (when (substringp string (string symbol)) + (setq f (or (print-doc symbol t) f)))) + (do-all-symbols (symbol) + (when (substringp string (string symbol)) + (setq f (or (print-doc symbol t) f))))) + (if f + (format t "~&-----------------------------------------------------------------------------") + (format t "~&No documentation for ~S in ~:[any~;~A~] package." + string package + (and package (package-name (coerce-to-package package))))) + (values)) + diff --git a/lsp/gcl_desetq.lsp b/lsp/gcl_desetq.lsp new file mode 100755 index 0000000..e9a2edd --- /dev/null +++ b/lsp/gcl_desetq.lsp @@ -0,0 +1,25 @@ + + + + +(defun desetq-consp-check (val) + (or (consp val) (error "~a is not a cons" val))) + +(defun desetq1 (form val) + (cond ((symbolp form) + (cond (form ;(push form *desetq-binds*) + `(setf ,form ,val)))) + ((consp form) + `(progn + (desetq-consp-check ,val) + ,(desetq1 (car form) `(car ,val)) + ,@ (if (consp (cdr form)) + (list(desetq1 (cdr form) `(cdr ,val))) + (and (cdr form) `((setf ,(cdr form) (cdr ,val))))))) + (t (error "")))) + + +(defmacro desetq (form val) + (cond ((atom val) (desetq1 form val)) + (t (let ((value (gensym))) + `(let ((,value ,val)) , (desetq1 form value)))))) diff --git a/lsp/gcl_destructuring_bind.lsp b/lsp/gcl_destructuring_bind.lsp new file mode 100644 index 0000000..f8b9963 --- /dev/null +++ b/lsp/gcl_destructuring_bind.lsp @@ -0,0 +1,403 @@ +;;;; From CMULISP + +;;;; From defmacro.lisp + +;;;; Some variable definitions. + +;;; Variables for amassing the results of parsing a defmacro. Declarations +;;; in DEFMACRO are the reason this isn't as easy as it sounds. +;;; + +(in-package :si) + +(defvar *arg-tests* () + "A list of tests that do argument counting at expansion time.") + +(defvar *system-lets* nil) +;(defvar *system-lets* () +; "Let bindings that are done to make lambda-list parsing possible.") + +(defvar *user-lets* () + "Let bindings that the user has explicitly supplied.") + +(defvar *default-default* nil + "Unsupplied optional and keyword arguments get this value defaultly.") + +;; Temps that we introduce and might not reference. +(defvar *ignorable-vars*) + +;;;; Stuff to parse DEFMACRO, MACROLET, DEFINE-SETF-METHOD, and DEFTYPE. + +;;; We save space in macro definitions by callig this function. +;;; +(defun do-arg-count-error (error-kind name arg lambda-list minimum maximum) + (error "Error in do-arg-count-error: ~S ~S ~S ~S ~S ~S~%" + error-kind + name + arg + lambda-list + minimum + maximum)) + +;;; PARSE-DEFMACRO returns, as multiple-values, a body, possibly a declare +;;; form to put where this code is inserted, and the documentation for the +;;; parsed body. +;;; +(defun parse-defmacro (lambda-list arg-list-name code name error-kind + &key (annonymousp nil) + (doc-string-allowed t) + ((:environment env-arg-name)) + ((:default-default *default-default*)) + (error-fun 'error)) + "Returns as multiple-values a parsed body, any local-declarations that + should be made where this body is inserted, and a doc-string if there is + one." + (multiple-value-bind (body declarations documentation) + (parse-body code nil doc-string-allowed) + (let* ((*arg-tests* ()) + (*user-lets* ()) + (*system-lets* ()) + (*ignorable-vars* ())) + (multiple-value-bind + (env-arg-used minimum maximum) + (parse-defmacro-lambda-list lambda-list arg-list-name name + error-kind error-fun (not annonymousp) + nil env-arg-name) + (values + `(let* ,(nreverse *system-lets*) + ,@(when *ignorable-vars* + `((declare (ignorable ,@*ignorable-vars*)))) + ,@*arg-tests* + (let* ,(nreverse *user-lets*) + ,@declarations + ,@body)) + `(,@(when (and env-arg-name (not env-arg-used)) + `((declare (ignore ,env-arg-name))))) + documentation + minimum + maximum))))) + +(defun make-keyword (symbol) + "Takes a non-keyword symbol, symbol, and returns the corresponding keyword." + (intern (symbol-name symbol) (find-package "KEYWORD"))) + +(defun verify-keywords (key-list valid-keys allow-other-keys) + (do ((already-processed nil) + (unknown-keyword nil) + (remaining key-list (cddr remaining))) + ((null remaining) + (if (and unknown-keyword + (not allow-other-keys) + (not (lookup-keyword :allow-other-keys key-list))) + (values :unknown-keyword (list unknown-keyword valid-keys)) + (values nil nil))) + (cond ((not (and (consp remaining) (listp (cdr remaining)))) + (return (values :dotted-list key-list))) + ((null (cdr remaining)) + (return (values :odd-length key-list))) + #+nil ;; Not ANSI compliant to disallow duplicate keywords. + ((member (car remaining) already-processed) + (return (values :duplicate (car remaining)))) + ((or (eq (car remaining) :allow-other-keys) + (member (car remaining) valid-keys)) + (push (car remaining) already-processed)) + (t + (setf unknown-keyword (car remaining)))))) + +(defun lookup-keyword (keyword key-list) + (do ((remaining key-list (cddr remaining))) + ((endp remaining)) + (when (eq keyword (car remaining)) + (return (cadr remaining))))) +;;; +(defun keyword-supplied-p (keyword key-list) + (do ((remaining key-list (cddr remaining))) + ((endp remaining)) + (when (eq keyword (car remaining)) + (return t)))) + + + +;(defun make-keyword (a) +; (error "Need to write make-keyword ~S" a)) + +;(defun defmacro-error (a b c) +; (error "Need to write defmacro-error ~S ~S ~S" a b c)) + +(defun parse-defmacro-lambda-list + (lambda-list arg-list-name name error-kind error-fun + &optional top-level env-illegal env-arg-name) + (let ((path (if top-level `(cdr ,arg-list-name) arg-list-name)) + (now-processing :required) + (maximum 0) + (minimum 0) + (keys ()) + rest-name restp allow-other-keys-p env-arg-used) + ;; This really strange way to test for '&whole is neccessary because member + ;; does not have to work on dotted lists, and dotted lists are legal + ;; in lambda-lists. + (when (and (do ((list lambda-list (cdr list))) + ((atom list) nil) + (when (eq (car list) '&whole) (return t))) + (not (eq (car lambda-list) '&whole))) + (error "&Whole must appear first in ~S lambda-list." error-kind)) + (do ((rest-of-args lambda-list (cdr rest-of-args))) + ((atom rest-of-args) + (cond ((null rest-of-args) nil) + ;; Varlist is dotted, treat as &rest arg and exit. + (t (push-let-binding rest-of-args path nil) + (setf restp t)))) + (let ((var (car rest-of-args))) + (cond ((eq var '&whole) + (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args))) + (setf rest-of-args (cdr rest-of-args)) + (push-let-binding (car rest-of-args) arg-list-name nil)) + (t (error "Bad &WHOLE")))) + ((eq var '&environment) + (cond (env-illegal + (error "&Environment not valid with ~S." error-kind)) + ((not top-level) + (error "&Environment only valid at top level of ~ + lambda-list."))) + (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args))) + (setf rest-of-args (cdr rest-of-args)) + (push-let-binding (car rest-of-args) env-arg-name nil) + (setf env-arg-used t)) + (t (error "Bad &ENVIRONMENT")))) + ((or (eq var '&rest) (eq var '&body)) + (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args))) + (setf rest-of-args (cdr rest-of-args)) + (setf restp t) + (push-let-binding (car rest-of-args) path nil)) + ;; + ;; This branch implements an incompatible extension to + ;; Common Lisp. In place of a symbol following &body, + ;; there may be a list of up to three elements which will + ;; be bound to the body, declarations, and doc-string of + ;; the body. + ((and (cdr rest-of-args) + (consp (cadr rest-of-args)) + (symbolp (caadr rest-of-args))) + (setf rest-of-args (cdr rest-of-args)) + (setf restp t) + (let ((body-name (caar rest-of-args)) + (declarations-name (cadar rest-of-args)) + (doc-string-name (caddar rest-of-args)) + (parse-body-values (gensym))) + (push-let-binding + parse-body-values + `(multiple-value-list + (parse-body ,path ,env-arg-name + ,(not (null doc-string-name)))) + t) + (setf env-arg-used t) + (when body-name + (push-let-binding body-name + `(car ,parse-body-values) nil)) + (when declarations-name + (push-let-binding declarations-name + `(cadr ,parse-body-values) nil)) + (when doc-string-name + (push-let-binding doc-string-name + `(caddr ,parse-body-values) nil)))) + (t (error "Bad lambda list")))) + ((eq var '&optional) + (setf now-processing :optionals)) + ((eq var '&key) + (setf now-processing :keywords) + (setf rest-name (gensym "KEYWORDS-")) + (push rest-name *ignorable-vars*) + (setf restp t) + (push-let-binding rest-name path t)) + ((eq var '&allow-other-keys) + (setf allow-other-keys-p t)) + ((eq var '&aux) + (setf now-processing :auxs)) + ((listp var) + (case now-processing + (:required + (let ((sub-list-name (gensym "SUBLIST-"))) + (push-sub-list-binding sub-list-name `(car ,path) var + name error-kind error-fun) + (parse-defmacro-lambda-list var sub-list-name name + error-kind error-fun)) + (setf path `(cdr ,path)) + (incf minimum) + (incf maximum)) + (:optionals + (when (> (length var) 3) + (cerror "Ignore extra noise." + "More than variable, initform, and suppliedp ~ + in &optional binding - ~S" + var)) + (push-optional-binding (car var) (cadr var) (caddr var) + `(not (null ,path)) `(car ,path) + name error-kind error-fun) + (setf path `(cdr ,path)) + (incf maximum)) + (:keywords + (let* ((keyword-given (consp (car var))) + (variable (if keyword-given + (cadar var) + (car var))) + (keyword (if keyword-given + (caar var) + (make-keyword variable))) + (supplied-p (caddr var))) + (push-optional-binding variable (cadr var) supplied-p + `(keyword-supplied-p ',keyword + ,rest-name) + `(lookup-keyword ',keyword + ,rest-name) + name error-kind error-fun) + (push keyword keys))) + (:auxs (push-let-binding (car var) (cadr var) nil)))) + ((symbolp var) + (case now-processing + (:required + (incf minimum) + (incf maximum) + (push-let-binding var `(car ,path) nil) + (setf path `(cdr ,path))) + (:optionals + (incf maximum) + (push-let-binding var `(car ,path) nil `(not (null ,path))) + (setf path `(cdr ,path))) + (:keywords + (let ((key (make-keyword var))) + (push-let-binding var `(lookup-keyword ,key ,rest-name) + nil) + (push key keys))) + (:auxs + (push-let-binding var nil nil)))) + (t + (error "Non-symbol in lambda-list - ~S." var))))) + ;; Generate code to check the number of arguments, unless dotted + ;; in which case length will not work. + (unless restp + (push `(unless (<= ,minimum + (length (the list ,(if top-level + `(cdr ,arg-list-name) + arg-list-name))) + ,@(unless restp + (list maximum))) + ,(let ((arg (if top-level + `(cdr ,arg-list-name) + arg-list-name))) + (if (eq error-fun 'error) + `(do-arg-count-error ',error-kind ',name ,arg + ',lambda-list ,minimum + ,(unless restp maximum)) + `(,error-fun 'defmacro-ll-arg-count-error + :kind ',error-kind + ,@(when name `(:name ',name)) + :argument ,arg + :lambda-list ',lambda-list + :minimum ,minimum + ,@(unless restp `(:maximum ,maximum)))))) + *arg-tests*)) + (if keys + (let ((problem (gensym "KEY-PROBLEM-")) + (info (gensym "INFO-"))) + (push `(multiple-value-bind + (,problem ,info) + (verify-keywords ,rest-name ',keys ',allow-other-keys-p) + (when ,problem + (,error-fun + 'defmacro-ll-broken-key-list-error + :kind ',error-kind + ,@(when name `(:name ',name)) + :problem ,problem + :info ,info))) + *arg-tests*))) + (values env-arg-used minimum (if (null restp) maximum nil)))) + + +(defun push-sub-list-binding (variable path object name error-kind error-fun) + (let ((var (gensym "TEMP-"))) + (push `(,variable + (let ((,var ,path)) + (if (listp ,var) + ,var + (,error-fun 'defmacro-bogus-sublist-error + :kind ',error-kind + ,@(when name `(:name ',name)) + :object ,var + :lambda-list ',object)))) + *system-lets*))) + +(defun push-let-binding (variable path systemp &optional condition + (init-form *default-default*)) + (let ((let-form (if condition + `(,variable (if ,condition ,path ,init-form)) + `(,variable ,path)))) + (if systemp + (push let-form *system-lets*) + (push let-form *user-lets*)))) + +(defun push-optional-binding (value-var init-form supplied-var condition path + name error-kind error-fun) + (unless supplied-var + (setf supplied-var (gensym "SUPLIEDP-"))) + (push-let-binding supplied-var condition t) + (cond ((consp value-var) + (let ((whole-thing (gensym "OPTIONAL-SUBLIST-"))) + (push-sub-list-binding whole-thing + `(if ,supplied-var ,path ,init-form) + value-var name error-kind error-fun) + (parse-defmacro-lambda-list value-var whole-thing name + error-kind error-fun))) + ((symbolp value-var) + (push-let-binding value-var path nil supplied-var init-form)) + (t + (error "Illegal optional variable name: ~S" value-var)))) + +;;;; From macros.lisp + +;;; Parse-Body -- Public +;;; +;;; Parse out declarations and doc strings, *not* expanding macros. +;;; Eventually the environment arg should be flushed, since macros can't expand +;;; into declarations anymore. +;;; +(defun parse-body (body environment &optional (doc-string-allowed t)) + "This function is to parse the declarations and doc-string out of the body of + a defun-like form. Body is the list of stuff which is to be parsed. + Environment is ignored. If Doc-String-Allowed is true, then a doc string + will be parsed out of the body and returned. If it is false then a string + will terminate the search for declarations. Three values are returned: the + tail of Body after the declarations and doc strings, a list of declare forms, + and the doc-string, or NIL if none." + (declare (ignore environment)) + (let ((decls ()) + (doc nil)) + (do ((tail body (cdr tail))) + ((endp tail) + (values tail (nreverse decls) doc)) + (let ((form (car tail))) + (cond ((and (stringp form) (cdr tail)) + (if doc-string-allowed + (setq doc form + ;; Only one doc string is allowed. + doc-string-allowed nil) + (return (values tail (nreverse decls) doc)))) + ((not (and (consp form) (symbolp (car form)))) + (return (values tail (nreverse decls) doc))) + ((eq (car form) 'declare) + (push form decls)) + (t + (return (values tail (nreverse decls) doc)))))))) + +;;;; Destructuring-bind + +(defmacro destructuring-bind (lambda-list arg-list &rest body) + "Bind the variables in LAMBDA-LIST to the contents of ARG-LIST." + (let* ((arg-list-name (gensym "ARG-LIST-"))) + (multiple-value-bind + (body local-decls) + (parse-defmacro lambda-list arg-list-name body nil 'destructuring-bind + :annonymousp t :doc-string-allowed nil) + `(let ((,arg-list-name ,arg-list)) + ,@local-decls + ,body)))) + diff --git a/lsp/gcl_directory.lsp b/lsp/gcl_directory.lsp new file mode 100644 index 0000000..7d9c816 --- /dev/null +++ b/lsp/gcl_directory.lsp @@ -0,0 +1,85 @@ +(in-package :si) + +(defconstant +d-type-alist+ (d-type-list)) + +(defun ?push (x tp) + (when (and x (eq tp :directory)) (vector-push-extend #\/ x)) + x) + +(defun wreaddir (x s &optional y (ls (length s) lsp) &aux (y (if (rassoc y +d-type-alist+) y :unknown))) + (when lsp (setf (fill-pointer s) ls)) + (let ((r (readdir x (car (rassoc y +d-type-alist+)) s))) + (typecase r + (fixnum (wreaddir x (adjust-array s (+ 100 (ash (array-dimension s 0) 1))) y)) + (cons (let ((tp (cdr (assoc (cdr r) +d-type-alist+)))) (cons (?push (car r) tp) tp))) + (otherwise (?push r y))))) + +(defun dot-dir-p (r l) (member-if (lambda (x) (string= x r :start2 l)) '("./" "../"))) + +(defun vector-push-string (x s &optional (ss 0) (lx (length x)) &aux (ls (- (length s) ss))) + (let ((x (if (> ls (- (array-dimension x 0) lx)) (adjust-array x (+ ls (ash lx 1))) x))) + (setf (fill-pointer x) (+ lx ls)) + (replace x s :start1 lx :start2 ss))) + +(defun walk-dir (s e f &optional (y :unknown) (d (opendir s)) (l (length s)) (le (length e)) + &aux (r (wreaddir d s y l))) + (cond (r (unless (dot-dir-p r l) (funcall f r (vector-push-string e r l le) l)) + (walk-dir s e f y d l le)) + ((setf (fill-pointer s) l (fill-pointer e) le) (closedir d)))) + +(defun recurse-dir (x y f) + (funcall f x y) + (walk-dir x y (lambda (x y l) (declare (ignore l)) (recurse-dir x y f)) :directory)) + +(defun make-frame (s &aux (l (length s))) + (replace (make-array l :element-type 'character :adjustable t :fill-pointer l) s)) + +(defun expand-wild-directory (d l f zz &optional (yy (make-frame zz))) + (let* ((x (member-if 'wild-dir-element-p l)) + (s (namestring (make-pathname :device d :directory (ldiff l x)))) + (z (vector-push-string zz s)) + (l (length yy)) + (y (link-expand (vector-push-string yy s) l)) + (y (if (eq y yy) y (make-frame y)))) + (when (or (eq (stat1 z) :directory) (zerop (length z))) + (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) + (x (walk-dir z y (lambda (q e l) + (declare (ignore l)) + (expand-wild-directory d (cons :relative (cdr x)) f q e)) :directory));FIXME + ((funcall f z y)))))) + +(defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) + (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) + (lc (when c (length c))) + (filesp (or (pathname-name p) (pathname-type p))) + (v (compile-regexp (to-regexp p)))(*up-key* :back) r) + (expand-wild-directory (pathname-device p) d + (lambda (dir exp &aux (pexp (pathname (if c (vector-push-string c exp 0 lc) exp)))) + (if filesp + (walk-dir dir exp + (lambda (dir exp pos) + (declare (ignore exp)) + (when (pathname-match-p dir v) + (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) + :file) + (when (pathname-match-p dir v) (push (pathname (copy-seq (namestring pexp))) r)))) + (make-frame "")) + r) + +(defun chdir (s) + (when (chdir1 (namestring (pathname s)));to expand ~/ + (setq *current-directory* (current-directory-pathname)))) + +(defun which (s) + (let ((r (with-open-file (s (apply 'string-concatenate "|" #-winnt "command -v " + #+winnt "for %i in (" s #+winnt ".exe) do @echo.%~$PATH:i" nil)) + (read-line s nil 'eof)))) + (unless (eq r 'eof) + (string-downcase r)))) + +(defun get-path (s &aux + (e (unless (minusp (string-match #v"([^\n\t\r ]+)([\n\t\r ]|$)" s))(match-end 1))) + (w (when e (which (pathname-name (subseq s (match-beginning 1) e)))))) + (when w + (string-concatenate w (subseq s e)))) + diff --git a/lsp/gcl_doc-file.lsp b/lsp/gcl_doc-file.lsp new file mode 100755 index 0000000..d1176b6 --- /dev/null +++ b/lsp/gcl_doc-file.lsp @@ -0,0 +1,24 @@ +(defun doc-file (file packages) +;;Write FILE of doc strings for all symbols in PACKAGES +;;This file is suitable for use with the find-doc function. + #+kcl + (and (member 'lisp packages) + (not (documentation 'setq 'function)) + (load (format nil "~a../lsp/setdoc.lsp" si::*system-directory*))) + (with-open-file (st file :direction :output) + (sloop:sloop + for v in packages + do (setq v (if (packagep v) (package-name v) v)) + do (sloop:sloop + for w in-package v + when (setq doc (documentation w 'function)) + do (format st "F~a~%~ain ~a package:~a" w + (cond ((special-operator-p w) "Special Form ") + ((functionp w) "Function ") + ((macro-function w) "Macro ") + (t "")) + v + doc) + when (setq doc (documentation w 'variable)) + do (format st "V~a~%Variable in ~a package:~a" w v doc) + )))) diff --git a/lsp/gcl_evalmacros.lsp b/lsp/gcl_evalmacros.lsp new file mode 100755 index 0000000..5601bfe --- /dev/null +++ b/lsp/gcl_evalmacros.lsp @@ -0,0 +1,277 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; evalmacros.lsp + + +(in-package :si) + + +;(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) +;(eval-when (eval compile) (defun si:clear-compiler-properties (symbol))) +(eval-when (eval compile) + (setq si:*inhibit-macro-special* nil) + (defmacro ?cons (f x &aux (s (sgen "?CONS"))) `(let ((,s ,x)) (if (cdr ,s) (cons ,f ,s) (car ,s)))) + (defmacro ?list (x &aux (s (sgen "?LIST"))) `(let ((,s ,x)) (when ,s (list ,s)))) + (defmacro collect (v r rp np &aux (s (sgen "COLLECT"))) + `(let ((,s ,v)) (setf rp (if rp (rplacd rp (list ,s)) (setq r ,s)) rp np))) + (defmacro ?let (k kf r) `(let ((r ,r)) (if (eq ,k ,kf) r `(let ((,,k ,,kf)) (declare (ignorable ,,k)) ,r)))) + (defmacro ?key (x &aux (s (sgen "?KEY"))) `(if (or (constantp ,x) (symbolp ,x)) ,x ',s))) + +(defmacro sgen (&optional (pref "G")) `(load-time-value (gensym ,pref))) + +(defmacro defvar (var &optional (form nil form-sp) doc-string) + (declare (optimize (safety 1))) + `(progn (*make-special ',var) + ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) + ,@(when form-sp `((unless (boundp ',var) (setq ,var ,form)))) + ',var)) + +(defmacro defparameter (var form &optional doc-string) + (declare (optimize (safety 1))) + `(progn (*make-special ',var) + ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) + (setq ,var ,form) + ',var)) + +(defmacro defconstant (var form &optional doc-string) + (declare (optimize (safety 1))) + `(progn (*make-constant ',var ,form) + ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) + ',var)) + + +;;; Each of the following macros is also defined as a special form. +;;; Thus their names need not be exported. + +(defmacro and (&rest forms &aux r rp np) + (declare (optimize (safety 1))) + (do ((y forms))((endp y) (if forms r t)) + (let ((x (pop y))) + (if (constantp x) (unless (if (eval x) y) (collect x r rp np) (setq y nil)) + (if y (collect `(if ,@(setq np (list x))) r rp np) + (collect x r rp np)))))) + +(defmacro or (&rest forms &aux r rp np (s (sgen "OR"))) + (declare (optimize (safety 1))) + (do ((y forms))((endp y) r) + (let ((x (pop y))) + (if (constantp x) (when (eval x) (collect x r rp np) (setq y nil)) + (if (symbolp x) (collect `(if ,x ,@(setq np (list x))) r rp np) + (if y (collect `(let ((,s ,x)) (if ,s ,@(setq np (list s)))) r rp np) + (collect x r rp np))))))) + +(defun parse-body-header (x) + (let* ((doc x)(x (or (when (stringp (car x)) (cdr x)) x)) + (dec x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'declare))) x)) + (ctp x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'check-type))) x))) + (values (car (ldiff doc dec)) (ldiff dec ctp) (ldiff ctp x) x))) + +(defmacro locally (&rest body) + (multiple-value-bind + (doc dec) + (parse-body-header body) + (declare (ignore doc)) + `(let (,@(mapcan (lambda (x &aux (z (pop x))(z (if (eq z 'type) (pop x) z))) + (case z + ((ftype inline notinline optimize) nil) + (otherwise (mapcar (lambda (x) (list x x)) x)))) + (apply 'append (mapcar 'cdr dec)))) + ,@body))) + +(defmacro loop (&rest body &aux (tag (sgen "LOOP"))) + `(block nil (tagbody ,tag ,(?cons 'progn body) (go ,tag)))) + +(defmacro while (test &rest forms) + `(loop (unless ,test (return)) ,@forms)) + +(defmacro defmacro (name vl &rest body) + `(si:define-macro ',name (si:defmacro* ',name ',vl ',body))) + +(defmacro defun (name lambda-list &rest body) + (multiple-value-bind + (doc dec ctp body) + (parse-body-header body) + `(progn ,@(when doc `((setf (get ',name 'function-documentation) ,doc))) + (setf (symbol-function ',name) (lambda ,lambda-list ,@dec ,@ctp (block ,name ,@body))) + ',name))) + +; assignment + +(defmacro psetq (&rest args) + (declare (optimize (safety 1))) + (assert (evenp (length args))) + (let ((x (let ((i 0)) (mapcon (lambda (x) (when (oddp (incf i)) `((,(cadr x) ,(car x) ,(gensym))))) args)))) + (when x + `(let* ,(mapcar (lambda (x) `(,(caddr x) ,(car x))) x) + (setq ,@(mapcan 'cdr x)) + nil)))) + +; conditionals +(defmacro cond (&rest clauses &aux r rp np (s (sgen "COND"))) + (declare (optimize (safety 1))) + (do ((y clauses))((endp y) r) + (let* ((x (pop y))(z (pop x))) + (if (constantp z) (when (eval z) (collect (if x (?cons 'progn x) z) r rp np) (setq y nil)) + (if x (collect `(if ,z ,@(setq np (list (?cons 'progn x)))) r rp np) + (if (symbolp z) (collect `(if ,z ,@(setq np (list z))) r rp np) + (if y (collect `(let ((,s ,z)) (if ,s ,@(setq np (list s)))) r rp np) + (collect `(values ,z) r rp np)))))))) + +(defmacro when (pred &rest body &aux (x (?cons 'progn body))) + (declare (optimize (safety 1))) + (if (constantp pred) (if (eval pred) x) `(if ,pred ,x))) + +(defmacro unless (pred &rest body &aux (x (?cons 'progn body))) + (declare (optimize (safety 1))) + (if (constantp pred) (if (not (eval pred)) x) `(if (not ,pred) ,x))) + +; program feature + +(defun prog?* (let?* vl body) + (multiple-value-bind + (doc dec ctp body) + (parse-body-header body) + (declare (ignore doc)) + `(block nil (,let?* ,vl ,@dec (tagbody ,@(append ctp body)))))) + +(defmacro prog (vl &rest body) + (prog?* 'let vl body)) + +(defmacro prog* (vl &rest body) + (prog?* 'let* vl body)) + +; sequencing + +(defmacro prog1 (first &rest body &aux (sym (sgen "PROG1"))) + `(let ((,sym ,first)) ,@body ,sym)) + +(defmacro prog2 (first second &rest body &aux (sym (sgen "PROG2"))) + `(progn ,first (let ((,sym ,second)) ,@body ,sym))) + +; multiple values + +(defmacro multiple-value-list (form) + `(multiple-value-call 'list ,form)) + +(defmacro multiple-value-setq (vars form) + (declare (optimize (safety 1))) + (let ((syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) (or vars (list nil))))) + `(multiple-value-bind ,syms ,form ,@(?list (?cons 'setq (mapcan 'list vars syms))) ,(car syms)))) + +(defmacro multiple-value-bind (vars form &rest body &aux (sym (sgen "MULTIPLE-VALUE-BIND"))) + (declare (optimize (safety 1))) + `(let* ((,sym (multiple-value-list ,form)) + ,@(mapcon (lambda (x) `((,(car x) (car ,sym)) ,@(when (cdr x) `((,sym (cdr ,sym)))))) vars)) + (declare (ignorable ,sym)) + ,@body)) + +(defun do?* (?* control test result body &aux (label (sgen "DO"))) + (multiple-value-bind + (doc dec ctp body) + (parse-body-header body) + (declare (ignore doc)) + (labels ((?let (vl dec body) (if (or vl dec) `(,(if ?* 'let* 'let) ,vl ,@dec ,body) body)) + (?tagbody (l x y &aux (x (macroexpand x))) (if x `(tagbody ,l ,x ,@(?list (when (eq (car x) 'if) y))) y))) + `(block nil + ,(?let + (mapcar (lambda (x) (if (listp x) (ldiff x (cddr x)) x)) control) + dec + (?tagbody + label + `(unless ,test + ,@(?list (?cons 'tagbody (append ctp body))) + ,@(?list (?cons (if ?* 'setq 'psetq) (mapcan (lambda (x) (when (and (listp x) (cddr x)) (list (car x) (caddr x)))) control))) + (go ,label)) + `(return ,(?cons 'progn result)))))))) + +(defmacro do (control (test . result) &rest body) + (do?* nil control test result body)) + +(defmacro do* (control (test . result) &rest body) + (do?* t control test result body)) + +(defmacro case (keyform &rest clauses &aux r rp np (key (?key keyform))) + (declare (optimize (safety 1))) + (labels ((sw (x) `(eql ,key ,(if (constantp x) x `',x)))) + (do ((y clauses))((endp y) (?let key keyform r)) + (let* ((x (pop y))(z (pop x))) + (if (member z '(t otherwise)) + (if y (error "default case must be last") (collect (?cons 'progn x) r rp np)) + (when z + (if (constantp key) + (let ((key (eval key))) (when (if (listp z) (member key z) (eql key z)) (collect (?cons 'progn x) r rp np) (setq y nil))) + (collect `(if ,(if (listp z) (?cons 'or (mapcar #'sw z)) (sw z)) + ,@(setq np (list (?cons 'progn x)))) r rp np)))))))) + +(defmacro ecase (keyform &rest clauses &aux (key (?key keyform))) + (declare (optimize (safety 1))) + (?let key keyform + `(case ,key + ,@(mapcar (lambda (x) (if (member (car x) '(t otherwise)) (cons (list (car x)) (cdr x)) x)) clauses) + (otherwise + (error 'type-error :datum ,key + :expected-type '(member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses)))))))) + +(defmacro ccase (keyform &rest clauses &aux (key (?key keyform))) + (declare (optimize (safety 1))) + (?let key keyform + `(do nil (nil) + (case ,key + ,@(mapcar (lambda (x &aux (k (pop x))) + `(,(if (member k '(t otherwise)) (list k) k) (return ,(?cons 'progn x)))) clauses) + (otherwise + (check-type ,key (member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses))))))))) + + +(defmacro return (&optional val) `(return-from nil ,val)) + +(defmacro dolist ((var form &optional (val nil)) &rest body &aux (temp (sgen "DOLIST"))) + `(do* ((,temp ,form (cdr ,temp))(,var (car ,temp) (car ,temp))) + ((endp ,temp) ,val) + ,@body)) + +;; In principle, a more complete job could be done here by trying to +;; capture fixnum type declarations from the surrounding context or +;; environment, or from within the compiler's internal structures at +;; compile time. See gcl-devel archives for examples. This +;; implementation relies on the fact that the gcc optimizer will +;; eliminate the bignum branch if the supplied form is a symbol +;; declared to be fixnum, as the comparison of a long integer variable +;; with most-positive-fixnum is then vacuous. Care must be taken in +;; making comparisons with most-negative-fixnum, as the C environment +;; appears to treat this as positive or negative depending on the sign +;; of the other argument in the comparison, apparently to symmetrize +;; the long integer range. 20040403 CM. +(defmacro dotimes ((var form &optional val) &rest body &aux (s (sgen "DOTIMES"))(m (sgen "DOTIMES"))) + `(let* ((,s (block nil ,form))(,m (min ,s most-positive-fixnum))) + (declare (fixnum ,m)) + (do ((,var 0 (1+ ,var))) + ((>= ,var ,m) (if (eql ,s ,m) ,val (do ((,var ,m (1+ ,var)))((>= ,var ,s) ,val) ,@body))) + (declare (fixnum ,var)) + ,@body))) + +(defmacro declaim (&rest l) + `(eval-when (compile eval load) + ,@(mapcar (lambda (x) `(proclaim ',x)) l))) + +(defmacro lambda (&rest l) `(function (lambda ,@l))) + +(defun compiler-macro-function (name) + (get name 'compiler-macro)) diff --git a/lsp/gcl_export.lsp b/lsp/gcl_export.lsp new file mode 100755 index 0000000..4b21c8d --- /dev/null +++ b/lsp/gcl_export.lsp @@ -0,0 +1,488 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; export.lsp +;;;; +;;;; Exporting external symbols of LISP package + +(in-package :common-lisp) + +(export '( + &allow-other-keys *print-miser-width* + &aux *print-pprint-dispatch* + &body *print-pretty* + &environment *print-radix* + &key *print-readably* + &optional *print-right-margin* + &rest *query-io* + &whole *random-state* + * *read-base* + ** *read-default-float-format* + *** *read-eval* + *break-on-signals* *read-suppress* + *compile-file-pathname* *readtable* + *compile-file-truename* *standard-input* + *compile-print* *standard-output* + *compile-verbose* *terminal-io* + *debug-io* *trace-output* + *debugger-hook* + + *default-pathname-defaults* ++ + *error-output* +++ + *features* - + *gensym-counter* / + *load-pathname* // + *load-print* /// + *load-truename* /= + *load-verbose* 1+ + *macroexpand-hook* 1- + *modules* < + *package* <= + *print-array* = + *print-base* > + *print-case* >= + *print-circle* abort + *print-escape* abs + *print-gensym* acons + *print-length* acos + *print-level* acosh + *print-lines* add-method + + adjoin atom boundp + adjust-array base-char break + adjustable-array-p base-string broadcast-stream + allocate-instance bignum broadcast-stream-streams + alpha-char-p bit built-in-class + alphanumericp bit-and butlast + and bit-andc1 byte + append bit-andc2 byte-position + apply bit-eqv byte-size + apropos bit-ior caaaar + apropos-list bit-nand caaadr + aref bit-nor caaar + arithmetic-error bit-not caadar + arithmetic-error-operands bit-orc1 caaddr + arithmetic-error-operation bit-orc2 caadr + array bit-vector caar + array-dimension bit-vector-p cadaar + array-dimension-limit bit-xor cadadr + array-dimensions block cadar + array-displacement boole caddar + array-element-type boole-1 cadddr + array-has-fill-pointer-p boole-2 caddr + array-in-bounds-p boole-and cadr + array-rank boole-andc1 call-arguments-limit + array-rank-limit boole-andc2 call-method + array-row-major-index boole-c1 call-next-method + array-total-size boole-c2 car + array-total-size-limit boole-clr case + arrayp boole-eqv catch + ash boole-ior ccase + asin boole-nand cdaaar + asinh boole-nor cdaadr + assert boole-orc1 cdaar + assoc boole-orc2 cdadar + assoc-if boole-set cdaddr + assoc-if-not boole-xor cdadr + atan boolean cdar + atanh both-case-p cddaar + + cddadr clear-input copy-tree + cddar clear-output cos + cdddar close cosh + cddddr clrhash count + cdddr code-char count-if + cddr coerce count-if-not + cdr compilation-speed ctypecase + ceiling compile debug + cell-error compile-file decf + cell-error-name compile-file-pathname declaim + cerror compiled-function declaration + change-class compiled-function-p declare + char compiler-macro decode-float + char-code compiler-macro-function decode-universal-time + char-code-limit complement defclass + char-downcase complex defconstant + char-equal complexp defgeneric + char-greaterp compute-applicable-methods define-compiler-macro + char-int compute-restarts define-condition + char-lessp concatenate define-method-combination + char-name concatenated-stream define-modify-macro + char-not-equal concatenated-stream-streams define-setf-expander + char-not-greaterp cond define-symbol-macro + char-not-lessp condition defmacro + char-upcase conjugate defmethod + char/= cons defpackage + char< consp defparameter + char<= constantly defsetf + char= constantp defstruct + char> continue deftype + char>= control-error defun + character copy-alist defvar + characterp copy-list delete + check-type copy-pprint-dispatch delete-duplicates + cis copy-readtable delete-file + class copy-seq delete-if + class-name copy-structure delete-if-not + class-of copy-symbol delete-package + + denominator eq + deposit-field eql + describe equal + describe-object equalp + destructuring-bind error + digit-char etypecase + digit-char-p eval + directory eval-when + directory-namestring evenp + disassemble every + division-by-zero exp + do export + do* expt + do-all-symbols extended-char + do-external-symbols fboundp + do-symbols fceiling + documentation fdefinition + dolist ffloor + dotimes fifth + double-float file-author + double-float-epsilon file-error + double-float-negative-epsilon file-error-pathname + dpb file-length + dribble file-namestring + dynamic-extent file-position + ecase file-stream + echo-stream file-string-length + echo-stream-input-stream file-write-date + echo-stream-output-stream fill + ed fill-pointer + eighth find + elt find-all-symbols + encode-universal-time find-class + end-of-file find-if + endp find-if-not + enough-namestring find-method + ensure-directories-exist find-package + ensure-generic-function find-restart + + find-symbol get-internal-run-time + finish-output get-macro-character + first get-output-stream-string + fixnum get-properties + flet get-setf-expansion + float get-universal-time + float-digits getf + float-precision gethash + float-radix go + float-sign graphic-char-p + floating-point-inexact handler-bind + floating-point-invalid-operation handler-case + floating-point-overflow hash-table + floating-point-underflow hash-table-count + floatp hash-table-p + floor hash-table-rehash-size + fmakunbound hash-table-rehash-threshold + force-output hash-table-size + format hash-table-test + formatter host-namestring + fourth identity + fresh-line if + fround ignorable + ftruncate ignore + ftype ignore-errors + funcall imagpart + function import + function-keywords in-package + function-lambda-expression incf + functionp initialize-instance + gcd inline + generic-function input-stream-p + gensym inspect + gentemp integer + get integer-decode-float + get-decoded-time integer-length + get-dispatch-macro-character integerp + get-internal-real-time interactive-stream-p + + intern lisp-implementation-type + internal-time-units-per-second lisp-implementation-version + intersection list + invalid-method-error list* + invoke-debugger list-all-packages + invoke-restart list-length + invoke-restart-interactively listen + isqrt listp + keyword load + keywordp load-logical-pathname-translations + labels load-time-value + lambda locally + lambda-list-keywords log + lambda-parameters-limit logand + last logandc1 + lcm logandc2 + ldb logbitp + ldb-test logcount + ldiff logeqv + least-negative-double-float logical-pathname + least-negative-long-float logical-pathname-translations + least-negative-normalized-double-float logior + least-negative-normalized-long-float lognand + least-negative-normalized-short-float lognor + least-negative-normalized-single-float lognot + least-negative-short-float logorc1 + least-negative-single-float logorc2 + least-positive-double-float logtest + least-positive-long-float logxor + least-positive-normalized-double-float long-float + least-positive-normalized-long-float long-float-epsilon + least-positive-normalized-short-float long-float-negative-epsilon + least-positive-normalized-single-float long-site-name + least-positive-short-float loop + least-positive-single-float loop-finish + length lower-case-p + let machine-instance + let* machine-type + + machine-version mask-field + macro-function max + macroexpand member + macroexpand-1 member-if + macrolet member-if-not + make-array merge + make-broadcast-stream merge-pathnames + make-concatenated-stream method + make-condition method-combination + make-dispatch-macro-character method-combination-error + make-echo-stream method-qualifiers + make-hash-table min + make-instance minusp + make-instances-obsolete mismatch + make-list mod + make-load-form most-negative-double-float + make-load-form-saving-slots most-negative-fixnum + make-method most-negative-long-float + make-package most-negative-short-float + make-pathname most-negative-single-float + make-random-state most-positive-double-float + make-sequence most-positive-fixnum + make-string most-positive-long-float + make-string-input-stream most-positive-short-float + make-string-output-stream most-positive-single-float + make-symbol muffle-warning + make-synonym-stream multiple-value-bind + make-two-way-stream multiple-value-call + makunbound multiple-value-list + map multiple-value-prog1 + map-into multiple-value-setq + mapc multiple-values-limit + mapcan name-char + mapcar namestring + mapcon nbutlast + maphash nconc + mapl next-method-p + maplist nil + + nintersection package-error + ninth package-error-package + no-applicable-method package-name + no-next-method package-nicknames + not package-shadowing-symbols + notany package-use-list + notevery package-used-by-list + notinline packagep + nreconc pairlis + nreverse parse-error + nset-difference parse-integer + nset-exclusive-or parse-namestring + nstring-capitalize pathname + nstring-downcase pathname-device + nstring-upcase pathname-directory + nsublis pathname-host + nsubst pathname-match-p + nsubst-if pathname-name + nsubst-if-not pathname-type + nsubstitute pathname-version + nsubstitute-if pathnamep + nsubstitute-if-not peek-char + nth phase + nth-value pi + nthcdr plusp + null pop + number position + numberp position-if + numerator position-if-not + nunion pprint + oddp pprint-dispatch + open pprint-exit-if-list-exhausted + open-stream-p pprint-fill + optimize pprint-indent + or pprint-linear + otherwise pprint-logical-block + output-stream-p pprint-newline + package pprint-pop + + pprint-tab read-char + pprint-tabular read-char-no-hang + prin1 read-delimited-list + prin1-to-string read-from-string + princ read-line + princ-to-string read-preserving-whitespace + print read-sequence + print-not-readable reader-error + print-not-readable-object readtable + print-object readtable-case + print-unreadable-object readtablep + probe-file real + proclaim realp + prog realpart + prog* reduce + prog1 reinitialize-instance + prog2 rem + progn remf + program-error remhash + progv remove + provide remove-duplicates + psetf remove-if + psetq remove-if-not + push remove-method + pushnew remprop + quote rename-file + random rename-package + random-state replace + random-state-p require + rassoc rest + rassoc-if restart + rassoc-if-not restart-bind + ratio restart-case + rational restart-name + rationalize return + rationalp return-from + read revappend + read-byte reverse + + room simple-bit-vector + rotatef simple-bit-vector-p + round simple-condition + row-major-aref simple-condition-format-arguments + rplaca simple-condition-format-control + rplacd simple-error + safety simple-string + satisfies simple-string-p + sbit simple-type-error + scale-float simple-vector + schar simple-vector-p + search simple-warning + second sin + sequence single-float + serious-condition single-float-epsilon + set single-float-negative-epsilon + set-difference sinh + set-dispatch-macro-character sixth + set-exclusive-or sleep + set-macro-character slot-boundp + set-pprint-dispatch slot-exists-p + set-syntax-from-char slot-makunbound + setf slot-missing + setq slot-unbound + seventh slot-value + shadow software-type + shadowing-import software-version + shared-initialize some + shiftf sort + short-float space + short-float-epsilon special + short-float-negative-epsilon special-operator-p + short-site-name speed + signal sqrt + signed-byte stable-sort + signum standard + simple-array standard-char + simple-base-string standard-char-p + + standard-class sublis + standard-generic-function subseq + standard-method subsetp + standard-object subst + step subst-if + storage-condition subst-if-not + store-value substitute + stream substitute-if + stream-element-type substitute-if-not + stream-error subtypep + stream-error-stream svref + stream-external-format sxhash + streamp symbol + string symbol-function + string-capitalize symbol-macrolet + string-downcase symbol-name + string-equal symbol-package + string-greaterp symbol-plist + string-left-trim symbol-value + string-lessp symbolp + string-not-equal synonym-stream + string-not-greaterp synonym-stream-symbol + string-not-lessp t + string-right-trim tagbody + string-stream tailp + string-trim tan + string-upcase tanh + string/= tenth + string< terpri + string<= the + string= third + string> throw + string>= time + stringp trace + structure translate-logical-pathname + structure-class translate-pathname + structure-object tree-equal + style-warning truename + + truncate values-list + two-way-stream variable + two-way-stream-input-stream vector + two-way-stream-output-stream vector-pop + type vector-push + type-error vector-push-extend + type-error-datum vectorp + type-error-expected-type warn + type-of warning + typecase when + typep wild-pathname-p + unbound-slot with-accessors + unbound-slot-instance with-compilation-unit + unbound-variable with-condition-restarts + undefined-function with-hash-table-iterator + unexport with-input-from-string + unintern with-open-file + union with-open-stream + unless with-output-to-string + unread-char with-package-iterator + unsigned-byte with-simple-restart + untrace with-slots + unuse-package with-standard-io-syntax + unwind-protect write + update-instance-for-different-class write-byte + update-instance-for-redefined-class write-char + upgraded-array-element-type write-line + upgraded-complex-part-type write-sequence + upper-case-p write-string + use-package write-to-string + use-value y-or-n-p + user-homedir-pathname yes-or-no-p + values zerop)) diff --git a/lsp/gcl_fdecl.lsp b/lsp/gcl_fdecl.lsp new file mode 100755 index 0000000..a10a7f9 --- /dev/null +++ b/lsp/gcl_fdecl.lsp @@ -0,0 +1,93 @@ +(in-package 'si) + +;; by William F. Schelter + +;; Conveniently and economically make operators which declare the type +;; and result of numerical operations. For example (def-op f+ fixnum +) +;; defines a macro f+ which will give optimal code for calling + on +;; several fixnum args expecting a fixnum result. + +;; Details: +;; Note these will be macros and cannot be `funcalled'. If you add the +;; feature :debug, then code to check the types of the arguments and +;; result will be inserted, and generic operations will be used. This is +;; useful for checking that you did not insert the wrong type +;; declarations. The code will continue running if *dbreak* is nil, +;; returning the correct result but printing out the type mismatch, as +;; well as the actual args given so that you may more easily locate the +;; bad call in the editor. + +;; It is economical, beause all the macros defined are just variations +;; of one closure, and so code is not duplicated. + +;; Sample usage (with :debug in *features*): +;; The call will generate warning messages if the args or result are bad. + +;; (defun foo (x a) (f+ (* 2 x) a)) +;; SYSTEM>(foo 7.0 9) + +;; Bad call (F+ (* 2 X) A) types:(LONG-FLOAT FIXNUM) +;; 23.0 + +;; Without debug (f+ a b c) becomes +;; (the fixnum (+ (the fixnum a) (the fixnum +;; (+ (the fixnum b) (the fixnum c))))) +;; which is painful to write by hand, but which will give the best code. + + +(defmacro def-op (name type op &optional return-type) + `(setf (macro-function ',name) (make-operation ',type ',op + ',return-type))) + +(defun make-operation (.type .op .return) + (or .return (setf .return .type)) + #'(lambda (bod env) env + (sloop for v in (cdr bod) + when (eq t .type) collect v into body + else + collect `(the , .type ,v) into body + finally (setq body `(, .op ,@ body)) + (return + (if (eq t .return) body + `(the , .return ,body)))))) + +#+debug +(progn + ;; Enable this to insert type error checking code. +(defvar *dbreak* t) +(defun callchk-type (lis old na typ sho return-type &aux result) + (setq result (apply old lis)) + (or (and (sloop for v in lis + always (typep v typ)) + (or (null return-type) (typep result return-type))) + (format t "~%Bad call ~a types:~a" (cons na sho) + (sloop:sloop for v in lis collect (type-of v))) + (and *dbreak* (break "hi"))) + result) + +;; debug version: +(defmacro def-op (name type old &optional return-type) + `(defmacro ,name (&rest l) + `(callchk-type (list ,@ l) ',',old ',',name ',',type ',l ',',return-type + ))) +) + +(def-op f+ fixnum +) +(def-op f* fixnum *) +(def-op f- fixnum -) +(def-op +$ double-float +) +(def-op *$ double-float *) +(def-op -$ double-float -) +(def-op 1-$ double-float 1-) +(def-op 1+$ double-float 1+) +(def-op f1- fixnum 1-) +(def-op f1+ fixnum 1+) +(def-op //$ double-float quot) +(def-op ^ fixnum expt) +(def-op ^$ double-float expt) +(def-op f> fixnum > t) +(def-op f< fixnum < t) +(def-op f= fixnum = t) +(def-op lsh fixnum ash) +(def-op fixnum-remainder fixnum rem) + diff --git a/lsp/gcl_fpe.lsp b/lsp/gcl_fpe.lsp new file mode 100644 index 0000000..cd7bdc3 --- /dev/null +++ b/lsp/gcl_fpe.lsp @@ -0,0 +1,147 @@ +(in-package :fpe) + +(import 'si::(disassemble-instruction feenableexcept fedisableexcept fld *fixnum *float *double + +fe-list+ +mc-context-offsets+ floating-point-error + function-by-address clines defentry)) +(export '(break-on-floating-point-exceptions read-instruction)) + +(eval-when + (eval compile) + + (defconstant +feallexcept+ (reduce 'logior (mapcar 'caddr +fe-list+))) + + + (defun moff (i r) (* i (cdr r))) + + (defun stl (s &aux (s (if (stringp s) (make-string-input-stream s) s))(x (read s nil 'eof))) + (unless (eq x 'eof) (cons x (stl s)))) + + (defun ml (r) (when r (make-list (truncate (car r) (cdr r))))) + + (defun mcgr (r &aux (i -1)) + (mapcar (lambda (x y) `(defconstant ,x ,(moff (incf i) r))) (when r (stl (pop r))) (ml r))) + + (defun mcr (p r &aux (i -1)) + (mapcar (lambda (x) `(defconstant ,(intern (concatenate 'string p (write-to-string (incf i))) :fpe) ,(moff i r))) + (ml r))) + + (defmacro deft (n rt args &rest code) + `(progn + (clines ,(nstring-downcase + (apply 'concatenate 'string + (symbol-name rt) " " (symbol-name n) "(" + (apply 'concatenate 'string + (mapcon (lambda (x) (list* (symbol-name (caar x)) " " (symbol-name (cadar x)) + (when (cdr x) (list ", ")))) args)) + ") " + code))) + (defentry ,n ,(mapcar 'car args) (,rt ,(string-downcase (symbol-name n))))))) + +#.`(progn ,@(mcgr (first +mc-context-offsets+))) +#.`(progn ,@(mcr "ST" (second +mc-context-offsets+))) +#.`(progn ,@(mcr "XMM" (third +mc-context-offsets+))) + + +(defconstant +top-readtable+ (let ((*readtable* (copy-readtable))) + (set-syntax-from-char #\, #\Space) + (set-syntax-from-char #\; #\a) + (set-macro-character #\0 '0-reader) + (set-macro-character #\$ '0-reader) + (set-macro-character #\- '0-reader) + (set-macro-character #\% '%-reader) + (set-macro-character #\( 'paren-reader) + *readtable*)) +(defconstant +sub-readtable+ (let ((*readtable* (copy-readtable +top-readtable+))) + (set-syntax-from-char #\0 #\a) + *readtable*)) +(defvar *offset* 0) +(defvar *insn* nil) +(defvar *context* nil) + + +(defun rf (addr w) + (ecase w (4 (*float addr 0 nil nil)) (8 (*double addr 0 nil nil)))) + +(defun ref (addr p w &aux (i -1)) + (if p + (map-into (make-list (truncate 16 w)) (lambda nil (rf (+ addr (* w (incf i))) w))) + (rf addr w))) + +(defun gref (addr &aux (z (symbol-name *insn*))(lz (length z))(lz (if (eql (aref z (- lz 3)) #\2) (- lz 3) lz)) + (f (eql #\F (aref z 0)))) + (ref addr (unless f (eql (aref z (- lz 2)) #\P)) (if (or f (eql (aref z (1- lz)) #\D)) 8 4))) + +(defun reg-lookup (x) (*fixnum (+ (car *context*) (symbol-value x)) 0 nil nil)) + +(defun st-lookup (x) (fld (+ (cadr *context*) (symbol-value x)))) +(defun xmm-lookup (x) (gref (+ (caddr *context*) (symbol-value x)))) + + +(defun lookup (x &aux (z (symbol-name x))) + (case (aref z 0) + (#\X (xmm-lookup x)) + (#\S (st-lookup x)) + (otherwise (reg-lookup x)))) + +(defun %-reader (stream subchar &aux (*readtable* +sub-readtable+)(*package* (find-package :fpe))) + (declare (ignore subchar)) + (let ((x (read stream))) + (lookup (if (eq x 'st) + (intern (concatenate 'string (symbol-name x) + (write-to-string + (if (eql (peek-char nil stream nil 'eof) #\() + (let ((ch (read-char stream))(x (read stream))(ch (read-char stream))) + (declare (ignore ch)) + x) + 0))) :fpe) x)))) + +(defun 0-reader (stream subchar &aux a (s 1)(*readtable* +sub-readtable+)) + + (when (eql subchar #\$) (setq a t subchar (read-char stream))) + (when (eql subchar #\-) (setq s -1 subchar (read-char stream))) + (assert (eql subchar #\0)) + (assert (eql (read-char stream) #\x)) + + (let* ((*read-base* 16)(x (* s (read stream)))) + (if a x (let ((*offset* x)) (read stream))))) + +(defun paren-reader (stream subchar &aux (*readtable* +sub-readtable+)) + (declare (ignore subchar)) + (let* ((x (read-delimited-list #\) stream))) + (gref (+ *offset* (pop x) (if x (* (pop x) (car x)) 0))))) + +(defun read-operands (s context &aux (*context* context)) + (read-delimited-list #\; s)) + +(defun read-instruction (addr context &aux (*readtable* +top-readtable+) + (i (car (disassemble-instruction addr)))(s (make-string-input-stream i)) + (*insn* (read s))) + (cons i (cons *insn* (when context (read-operands s context))))) + + +(defun fe-enable (a) + (declare (fixnum a)) + (fedisableexcept) + (feenableexcept a)) + + +#.`(let ((fpe-enabled 0)) + (defun break-on-floating-point-exceptions + (&key suspend ,@(mapcar (lambda (x) `(,(car x) (logtest ,(caddr x) fpe-enabled))) +fe-list+) &aux r) + (fe-enable + (if suspend 0 + (setq fpe-enabled + (logior + ,@(mapcar (lambda (x) + `(cond (,(car x) (push ,(intern (symbol-name (car x)) :keyword) r) ,(caddr x)) + (0))) +fe-list+))))) + r)) + +(defun floating-point-error (code addr context) + (break-on-floating-point-exceptions :suspend t) + (unwind-protect + (let* ((fun (function-by-address addr))(m (read-instruction addr context))) + ((lambda (&rest r) (apply 'error (if (find-package :conditions) r (list (format nil "~s" r))))) + (or (caar (member code +fe-list+ :key 'cadr)) 'arithmetic-error) + :operation (list :insn (pop m) :op (pop m) :fun fun :addr addr) :operands m)) + (break-on-floating-point-exceptions))) diff --git a/lsp/gcl_fpe_test.lsp b/lsp/gcl_fpe_test.lsp new file mode 100644 index 0000000..1bb27c5 --- /dev/null +++ b/lsp/gcl_fpe_test.lsp @@ -0,0 +1,212 @@ +#.`(defun test-fpe (f a r &optional chk &aux cc (o (mapcan (lambda (x) (list x t)) (break-on-floating-point-exceptions)))) + (flet ((set-break (x) (when (keywordp r) + (apply 'break-on-floating-point-exceptions (append (unless x o) (list r x)))))) + (let* ((rr (handler-case (unwind-protect (progn (set-break t) (apply f a)) (set-break nil)) + ,@(mapcar (lambda (x &aux (x (car x))) `(,x (c) (setq cc c) ,(intern (symbol-name x) :keyword))) + (append si::+fe-list+ '((arithmetic-error)(error))))))) + (print (list* f a r rr (when cc (list cc (arithmetic-error-operation cc) (arithmetic-error-operands cc))))) + (assert (eql r rr)) + (when (and chk cc) + (unless (eq 'fnop (cadr (member :op (arithmetic-error-operation cc)))) + (assert (eq (symbol-function f) (cadr (member :fun (arithmetic-error-operation cc))))) + (assert (or (every 'equalp (mapcar (lambda (x) (if (numberp x) x (coerce x 'list))) a) + (arithmetic-error-operands cc)) + (every 'equalp (nreverse (mapcar (lambda (x) (if (numberp x) x (coerce x 'list))) a)) + (arithmetic-error-operands cc))))))))) + +#+(or x86_64 i386) +(progn + (eval-when + (compile eval) + (defmacro deft (n rt args &rest code) + `(progn + (clines ,(nstring-downcase + (apply 'concatenate 'string + (symbol-name rt) " " (symbol-name n) "(" + (apply 'concatenate 'string + (mapcon (lambda (x) (list* (symbol-name (caar x)) " " (symbol-name (cadar x)) + (when (cdr x) (list ", ")))) args)) ") " code))) + (defentry ,n ,(mapcar 'car args) (,rt ,(string-downcase (symbol-name n))))))) + + (deft fdivp object ((object x) (object y)) + "{volatile double a=lf(x),b=lf(y),c;" + "__asm__ __volatile__ (\"fldl %1;fldl %0;fdivp %%st,%%st(1);fstpl %2;fwait\" " + ": \"=m\" (a), \"=m\" (b) : \"m\" (c));" + "return make_longfloat(c);}") + + (deft divpd object ((object x) (object y) (object z)) + "{__asm__ __volatile__ (\"movapd %0,%%xmm0;movapd %1,%%xmm1;divpd %%xmm0,%%xmm1;movapd %%xmm1,%2\" " + ": \"=m\" (*(char *)x->a.a_self), \"=m\" (*(char *)y->a.a_self) : \"m\" (*(char *)z->a.a_self));" + "return z;}") + + (deft divpdm object ((object x) (object y) (object z)) + "{__asm__ __volatile__ (\"movapd %1,%%xmm1;divpd %0,%%xmm1;movapd %%xmm1,%2\" " + ": \"=m\" (*(char *)x->a.a_self), \"=m\" (*(char *)y->a.a_self) : \"m\" (*(char *)z->a.a_self));" + "return z;}") + + (deft divps object ((object x) (object y) (object z)) + "{__asm__ __volatile__ (\"movaps %0,%%xmm0;movaps %1,%%xmm1;divps %%xmm0,%%xmm1;movaps %%xmm1,%2\" " + ": \"=m\" (*(char *)x->a.a_self), \"=m\" (*(char *)y->a.a_self) : \"m\" (*(char *)z->a.a_self));" + "return z;}") + + (deft divpsm object ((object x) (object y) (object z)) + "{__asm__ __volatile__ (\"movaps %1,%%xmm1;divps %0,%%xmm1;movaps %%xmm1,%2\" " + ": \"=m\" (*(char *)x->a.a_self), \"=m\" (*(char *)y->a.a_self) : \"m\" (*(char *)z->a.a_self));" + "return z;}") + + (deft divsd object ((object x) (object y)) + "{volatile double a=lf(x),b=lf(y),c;" + "__asm__ __volatile__ (\"movsd %0,%%xmm0;movsd %1,%%xmm1;divsd %%xmm1,%%xmm0;movsd %%xmm0,%2\" " + ": \"=m\" (a), \"=m\" (b) : \"m\" (c));" + "return make_longfloat(c);}") + + (deft divsdm object ((object x) (object y)) + "{volatile double a=lf(x),b=lf(y),c;" + "__asm__ __volatile__ (\"movsd %0,%%xmm0;divsd %1,%%xmm0;movsd %%xmm0,%2\" " + ": \"=m\" (a), \"=m\" (b) : \"m\" (c));" + "return make_longfloat(c);}") + + (deft divss object ((object x) (object y)) + "{volatile float a=sf(x),b=sf(y),c;" + "__asm__ __volatile__ (\"movss %0,%%xmm0;movss %1,%%xmm1;divss %%xmm1,%%xmm0;movss %%xmm0,%2\" " + ": \"=m\" (a), \"=m\" (b) : \"m\" (c));" + "return make_shortfloat(c);}") + + (deft divssm object ((object x) (object y)) + "{volatile float a=sf(x),b=sf(y),c;" + "__asm__ __volatile__ (\"movss %0,%%xmm0;divss %1,%%xmm0;movss %%xmm0,%2\" " + ": \"=m\" (a), \"=m\" (b) : \"m\" (c));" + "return make_shortfloat(c);}") + + (deft sqrtpd object ((object x) (object y) (object z)) + "{__asm__ __volatile__ (\"movapd %0,%%xmm0;movapd %1,%%xmm1;sqrtpd %%xmm0,%%xmm1;movapd %%xmm1,%2\" " + ": \"=m\" (*(char *)x->a.a_self), \"=m\" (*(char *)y->a.a_self) : \"m\" (*(char *)z->a.a_self));" + "return z;}") + + (eval-when + (compile load eval) + (deft c_array_self fixnum ((object x)) "{return (fixnum)x->a.a_self;}") + (defun c-array-eltsize (x) (ecase (array-element-type x) (short-float 4) (long-float 8))) + (defun make-aligned-array (alignment size &rest r + &aux (ic (member :initial-contents r)) y + (c (cadr ic)) + (r (append (ldiff r ic) (cddr ic))) + (a (apply 'make-array (+ alignment size) (list* :static t r)))) + (setq y (map-into + (apply 'make-array size + :displaced-to a + :displaced-index-offset (truncate (- alignment (mod (c_array_self a) alignment)) (c-array-eltsize a)) + r) + 'identity c)) + (assert (zerop (mod (c_array_self y) 16))) + y)) + + (setq fa (make-aligned-array 16 4 :element-type 'short-float :initial-contents '(1.2s0 2.3s0 3.4s0 4.1s0)) + fb (make-aligned-array 16 4 :element-type 'short-float) + fc (make-aligned-array 16 4 :element-type 'short-float :initial-contents '(1.3s0 2.4s0 3.5s0 4.6s0)) + fx (make-aligned-array 16 4 :element-type 'short-float :initial-contents (make-list 4 :initial-element most-positive-short-float)) + fm (make-aligned-array 16 4 :element-type 'short-float :initial-contents (make-list 4 :initial-element least-positive-normalized-short-float)) + fn (make-aligned-array 16 4 :element-type 'short-float :initial-contents (make-list 4 :initial-element -1.0s0)) + fr (make-aligned-array 16 4 :element-type 'short-float)) + + (setq da (make-aligned-array 16 2 :element-type 'long-float :initial-contents '(1.2 2.3)) + db (make-aligned-array 16 2 :element-type 'long-float) + dc (make-aligned-array 16 2 :element-type 'long-float :initial-contents '(1.3 2.4)) + dx (make-aligned-array 16 2 :element-type 'long-float :initial-contents (make-list 2 :initial-element most-positive-long-float)) + dm (make-aligned-array 16 2 :element-type 'long-float :initial-contents (make-list 2 :initial-element least-positive-normalized-long-float)) + dn (make-aligned-array 16 2 :element-type 'long-float :initial-contents (make-list 2 :initial-element -1.0)) + dr (make-aligned-array 16 2 :element-type 'long-float)) + + (test-fpe 'fdivp (list 1.0 2.0) 0.5 t) + (test-fpe 'fdivp (list 1.0 0.0) :division-by-zero t) + (test-fpe 'fdivp (list 0.0 0.0) :floating-point-invalid-operation t) + (test-fpe 'fdivp (list most-positive-long-float least-positive-normalized-long-float) :floating-point-overflow);fstpl + (test-fpe 'fdivp (list least-positive-normalized-long-float most-positive-long-float) :floating-point-underflow);fstpl + (test-fpe 'fdivp (list 1.2 1.3) :floating-point-inexact);post args + + (test-fpe 'divpd (list da da dr) dr t) + (test-fpe 'divpd (list db da dr) :division-by-zero t) + (test-fpe 'divpd (list db db dr) :floating-point-invalid-operation t) + (test-fpe 'divpd (list dm dx dr) :floating-point-overflow t) + (test-fpe 'divpd (list dx dm dr) :floating-point-underflow t) + (test-fpe 'divpd (list da dc dr) :floating-point-inexact t) + + (test-fpe 'divpdm (list da da dr) dr t) + (test-fpe 'divpdm (list db da dr) :division-by-zero t) + (test-fpe 'divpdm (list db db dr) :floating-point-invalid-operation t) + (test-fpe 'divpdm (list dm dx dr) :floating-point-overflow t) + (test-fpe 'divpdm (list dx dm dr) :floating-point-underflow t) + (test-fpe 'divpdm (list da dc dr) :floating-point-inexact t) + + + (test-fpe 'divps (list fa fa fr) fr t) + (test-fpe 'divps (list fb fa fr) :division-by-zero t) + (test-fpe 'divps (list fb fb fr) :floating-point-invalid-operation t) + (test-fpe 'divps (list fm fx fr) :floating-point-overflow t) + (test-fpe 'divps (list fx fm fr) :floating-point-underflow t) + (test-fpe 'divps (list fa fc fr) :floating-point-inexact t) + + (test-fpe 'divpsm (list fa fa fr) fr t) + (test-fpe 'divpsm (list fb fa fr) :division-by-zero t) + (test-fpe 'divpsm (list fb fb fr) :floating-point-invalid-operation t) + (test-fpe 'divpsm (list fm fx fr) :floating-point-overflow t) + (test-fpe 'divpsm (list fx fm fr) :floating-point-underflow t) + (test-fpe 'divpsm (list fa fc fr) :floating-point-inexact t) + + + + (test-fpe 'divsd (list 1.0 2.0) 0.5 t) + (test-fpe 'divsd (list 1.0 0.0) :division-by-zero t) + (test-fpe 'divsd (list 0.0 0.0) :floating-point-invalid-operation t) + (test-fpe 'divsd (list most-positive-long-float least-positive-normalized-long-float) :floating-point-overflow t) + (test-fpe 'divsd (list least-positive-normalized-long-float most-positive-long-float) :floating-point-underflow t) + (test-fpe 'divsd (list 1.2 2.3) :floating-point-inexact t) + + (test-fpe 'divsdm (list 1.0 2.0) 0.5 t) + (test-fpe 'divsdm (list 1.0 0.0) :division-by-zero t) + (test-fpe 'divsdm (list 0.0 0.0) :floating-point-invalid-operation t) + (test-fpe 'divsdm (list most-positive-long-float least-positive-normalized-long-float) :floating-point-overflow t) + (test-fpe 'divsdm (list least-positive-normalized-long-float most-positive-long-float) :floating-point-underflow t) + (test-fpe 'divsdm (list 1.2 2.3) :floating-point-inexact t) + + (test-fpe 'divss (list 1.0s0 2.0s0) 0.5s0 t) + (test-fpe 'divss (list 1.0s0 0.0s0) :division-by-zero t) + (test-fpe 'divss (list 0.0s0 0.0s0) :floating-point-invalid-operation t) + (test-fpe 'divss (list most-positive-short-float least-positive-normalized-short-float) :floating-point-overflow t) + (test-fpe 'divss (list least-positive-normalized-short-float most-positive-short-float) :floating-point-underflow t) + (test-fpe 'divss (list 1.2s0 2.3s0) :floating-point-inexact t) + + (test-fpe 'divssm (list 1.0s0 2.0s0) 0.5s0 t) + (test-fpe 'divssm (list 1.0s0 0.0s0) :division-by-zero t) + (test-fpe 'divssm (list 0.0s0 0.0s0) :floating-point-invalid-operation t) + (test-fpe 'divssm (list most-positive-short-float least-positive-normalized-short-float) :floating-point-overflow t) + (test-fpe 'divssm (list least-positive-normalized-short-float most-positive-short-float) :floating-point-underflow t) + (test-fpe 'divssm (list 1.2s0 2.3s0) :floating-point-inexact t) + + (test-fpe 'sqrtpd (list da db dr) dr t) + (test-fpe 'sqrtpd (list dn db dr) :floating-point-invalid-operation t) + (test-fpe 'sqrtpd (list da db dr) :floating-point-inexact t)) + + +(defun l/ (x y) (declare (long-float x y)) (/ x y)) +(defun s/ (x y) (declare (short-float x y)) (/ x y)) +(defun lsqrt (x) (declare (long-float x)) (the long-float (sqrt x))) + + +(test-fpe 'l/ (list 1.0 2.0) 0.5 t) +(test-fpe 'l/ (list 1.0 0.0) :division-by-zero t) +(test-fpe 'l/ (list 0.0 0.0) :floating-point-invalid-operation t) +(test-fpe 'l/ (list most-positive-long-float least-positive-normalized-long-float) :floating-point-overflow t) +(test-fpe 'l/ (list least-positive-normalized-long-float most-positive-long-float) :floating-point-underflow t) +(test-fpe 'l/ (list 1.2 1.3) :floating-point-inexact t) + +(test-fpe 's/ (list 1.0s0 2.0s0) 0.5s0 t) +(test-fpe 's/ (list 1.0s0 0.0s0) :division-by-zero t) +(test-fpe 's/ (list 0.0s0 0.0s0) :floating-point-invalid-operation t) +(test-fpe 's/ (list most-positive-short-float least-positive-normalized-short-float) :floating-point-overflow t) +(test-fpe 's/ (list least-positive-normalized-short-float most-positive-short-float) :floating-point-underflow t) +(test-fpe 's/ (list 1.2s0 1.3s0) :floating-point-inexact t) + +(test-fpe 'lsqrt (list 4.0) 2.0 t) +(test-fpe 'lsqrt (list -1.0) :floating-point-invalid-operation t) +(test-fpe 'lsqrt (list 1.2) :floating-point-inexact t) diff --git a/lsp/gcl_gprof.lsp b/lsp/gcl_gprof.lsp new file mode 100755 index 0000000..796e62e --- /dev/null +++ b/lsp/gcl_gprof.lsp @@ -0,0 +1,133 @@ +(in-package 'si) + +;; (load "gprof.o") +;; You must have a kcl image with profiling information and monstartup +;; typically saved_kcp. NOTE: if monstartup calls sbrk (true in +;; most 4.3bsd's except sun >= OS 4.0) you must be very careful to +;; allocate all the space you will use prior to calling monstartup. +;; If subsequent storage allocation causes the hole to move you will +;; most certainly lose. See below for instructions +;; on how to construct saved_kcp. + +;; If you want function invocation counts to be kept do +;; (setq compiler::*cc* (concatentate 'string compiler::*cc* " -pg ")) +;; before compiling the relevant files. (This is done when you load +;; lsp/gprof.o) + +;; In the image saved_kcp Load in your files. Load in gprof.o: (load +;; "lsp/gprof.o") Invoke monstartup once to setup buffers: (monstartup +;; lowpc highpc) eg. (monstartup #x800 3000000) [highpc should be a bit +;; bigger than the highest address you have seen when loading your files] +;; Use moncontrol to toggle profiling on and off: (moncontrol 0) to turn +;; profiling off, and (moncontrol 1) to turn it on. Use +;; (wrtie-gmons+syms) to terminate with writing a gmon.out and syms.out +;; in the current directory. I know of no way of clearing the buffers, +;; since secret routines set up the buffers, and we don't know where they +;; are or how large. Thus all information is cumulative. + +;; % gprof syms.out +;; will display the output (add -b) to make it briefer. + +;; A sample session on rascal: +#| +/usr2/skcl/unixport/saved_kcp +GCL (Austin Kyoto Common Lisp) Version(1.147) Sun May 14 15:26:07 CDT 1989 +Contains Enhancements by W. Schelter + +>(load "/tmp/fo") +Loading /tmp/fo.o +start address -T 1d04e0 Finished loading /tmp/fo.o +528 + +>(load "/usr2/skcl/lsp/gprof") +Loading gprof.o + + Adding -pg to the *cc* commandstart address -T 1d0800 +Finished loading gprof.o +2112 + +;; NOTE: If the following calls sbrk [eg 4.3bsd or sun OS3 ] but not Sun OS4, +;; then you MUST make sure to allocate sufficient memory before doing +;; monstartup, so that the hole will not have to be moved. +>(si::monstartup #x800 2000000) +2584576 + +>(si::goo)(si::goo) ;;defined in /tmp/foo.lisp +NIL + +>NIL + +>(si::write-gmon+syms) +writing syms.. +0 +[NOTE: The safest way to exit the lisp is to stop it with Ctrl-Z +and then kill it. We do NOT want to run the exit code which +normally writes out a monitoring file]. + +rascal% gprof -b syms.out +... + called/total parents +index %time self descendents called+self name index + called/total children + + 0.00 0.00 1/200 _call_or_link [8] + 0.02 0.02 199/200 GOO [2] +[1] 49.6 0.02 0.02 200 FOO [1] + 0.02 0.00 200/203 _make_cons [4] + +... Interpretation: Foo is called 199 times by (parent) goo and once +by (parent) call_or_link (the setting up of the fast link). Foo +itself calls (child) make_cons 200 of the 203 times that make_cons is +called... Lower down we would see that goo is called twice. + +-- /tmp/fo.lisp -- + (defun foo () (cons nil nil)) + (defun goo () (sloop::sloop for i below 100 do (foo))) +-- end of file -- + +|# + +;; Creating saved_gcp +;; +;; cd gcl +;; make go +;; (cd unixport ; make gcp-sun) +;; (cd go ; ln -s ../o/makefile ../o/*.o ../o/*.c ../o/*.d ../o/*.ini .) +;; remove a few .o files and do +;; (cd go ; make "CFLAGS = -I../h -I../gcl-tk -pg -g -c") + +;; then (cd unixport ; make kcp) + +(clines + #-aix3 "#include \"gprof.hc\"" + #+aix3 "#include \"aix_gprof.hc\"" + ) + +(eval-when (load) +(progn (setq compiler::*cc* (CONCATENATE 'string compiler::*cc* " -pg ")) + (format t "~% Adding -pg to the *cc* command")) +) +(defun write-gmon+syms() + (monitor2 0 0 0 0) + (princ "writing syms..") + (set-up-combined) + (write_outsyms) + ) + + +(defentry monstartup (int int) (int "mymonstartup")) + +(defentry monitor2 (int int int int) (int "mymonitor")) + +(defentry moncontrol (int) (int "moncontrol")) + +(defentry write_outsyms () (int "write_outsyms")) + + + + + + + + + diff --git a/lsp/gcl_info.lsp b/lsp/gcl_info.lsp new file mode 100755 index 0000000..0cc4fa2 --- /dev/null +++ b/lsp/gcl_info.lsp @@ -0,0 +1,525 @@ +(in-package :si) + +(eval-when (compile eval) +(defmacro while (test &body body) + `(slooP::sloop while ,test do ,@ body)) + (defmacro f (op x y) + `(the ,(if (get op 'compiler::predicate) 't 'fixnum) + (,op (the fixnum ,x) (the fixnum ,y)))) +(defmacro fcr (x) `(load-time-value (compile-regexp ,x)))) + +(defconstant +crlu+ (compile-regexp #u"")) +(defconstant +crnp+ (compile-regexp #u"[ ]")) + +(defvar *info-data* nil) +(defvar *current-info-data* nil) + +(defun file-to-string (file &optional (start 0) + &aux (si::*ALLOW-GZIPPED-FILE* t)(len 0)) + (with-open-file + (st file) + (setq len (file-length st)) + (or (and (<= 0 start ) (<= start len)) + (error "illegal file start ~a" start)) + (let ((tem (make-array (- len start) + :element-type 'character))) + (if (> start 0) (file-position st start)) + (si::fread tem 0 (length tem) st) tem))) + +(defun atoi (string start &aux (ans 0) (ch 0)(len (length string))) + (declare (string string)) + (declare (fixnum start ans ch len) ) + (while (< start len) + (setq ch (char-code (aref string start))) + (setq start (+ start 1)) + (setq ch (- ch #.(char-code #\0))) + (cond ((and (>= ch 0) (< ch 10)) + (setq ans (+ ch (* 10 ans)))) + (t (return nil)))) + ans)) + +(defun info-get-tags (file &aux (lim 0) *match-data* tags files + (*case-fold-search* t)) + (declare (fixnum lim)) + (let ((s (file-to-string file)) (i 0)) + (declare (fixnum i) (string s)) + (cond ((f >= (string-match (fcr #u"[ \n]+Indirect:") s 0) 0) + (setq i (match-end 0)) + (setq lim (string-match +crlu+ s i)) + (while + (f >= (string-match (fcr #u"\n([^\n]+): ([0-9]+)") s i lim) 0) + (setq i (match-end 0)) + (setq files + (cons(cons + (atoi s (match-beginning 2)) + (get-match s 1) + ) + files))))) + (cond ((f >= (si::string-match (fcr #u"[\n ]+Tag Table:") s i) 0) + (setq i (si::match-end 0)) + (cond ((f >= (si::string-match +crlu+ s i) 0) + (setq tags (subseq s i (si::match-end 0))))))) + (if files (or tags (info-error "Need tags if have multiple files"))) + (list* tags (nreverse files)))) + +(defun re-quote-string (x &aux (i 0) ch (extra 0)) + (declare (fixnum i extra)) + (let ((x (if (stringp x) x (string x)))) + (declare (string x)) + (let (tem (len (length x))) + (declare (fixnum len)) + (tagbody + AGAIN + (while (< i len) + (setq ch (aref x i)) + (cond ((position ch "\\()[]+.*|^$?") + (cond (tem + (vector-push-extend #\\ tem)) + (t (incf extra))))) + (if tem + (vector-push-extend ch tem)) + (setq i (+ i 1))) + (cond (tem ) + ((> extra 0) + (setq tem + (make-array (f + (length x) extra) + :element-type 'character :fill-pointer 0)) + (setq i 0) + (go AGAIN)) + (t (setq tem x))) + ) + tem))) + +(defun get-match (string i) + (subseq string (match-beginning i) (match-end i))) + +(defun get-nodes (pat node-string &aux (i 0) ans + (*case-fold-search* t) *match-data*) + (declare (fixnum i)) + (when node-string + (setq pat + (si::string-concatenate "Node: ([^]*" (re-quote-string + pat) "[^]*)")) + (while (f >= (string-match pat node-string i) 0) + (setq i (match-end 0)) + (setq ans (cons (get-match node-string 1) + ans)) + ) + (nreverse ans))) + +(defun get-index-node () + (or (third *current-info-data*) + (let* ( + s + (node-string (car (nth 1 *current-info-data*))) + (node + (and node-string (car (get-nodes "index" node-string))))) + (when node + (setq s (show-info + node + nil + nil + )) + (setf (third *current-info-data*) s))))) + +(defun nodes-from-index (pat &aux (i 0) ans + (*case-fold-search* t) *match-data*) + (let ((index-string (get-index-node))) + (when index-string + (setq pat + (si::string-concatenate #u"\n\\* ([^:\n]*" (re-quote-string + pat) + #u"[^:\n]*):[ \t]+([^\t\n,.]+)")) + (while (f >= (string-match pat index-string i) 0) + (setq i (match-end 0)) + (setq ans (cons (cons (get-match index-string 1) + (get-match index-string 2)) + + + ans)) + ) + (nreverse ans)))) + +(defun get-node-index (pat node-string &aux (node pat) *match-data*) + (cond ((null node-string) 0) + (t + (setq pat + (si::string-concatenate "Node: " + (re-quote-string pat) "([0-9]+)")) + (cond ((f >= (string-match pat node-string) 0) + (atoi node-string (match-beginning 1))) + (t (info-error "cant find node ~s" node) 0))))) + +(defun all-matches (pat st &aux (start 0) *match-data*) + (declare (fixnum start)) + (sloop::sloop while (>= (setq start (si::string-match pat st start)) 0) + do nil;(print start) + collect (list start (setq start (si::match-end 0))))) + + + +(defmacro node (prop x) + `(nth ,(position prop '(string begin end header name + info-subfile + file tags)) ,x)) + +(defun node-offset (node) + (+ (car (node info-subfile node)) (node begin node))) + +(defvar *info-paths* + '("" "/usr/info/" "/usr/local/lib/info/" "/usr/local/info/" + "/usr/local/gnu/info/" "/usr/share/info/")) + +(defvar *old-lib-directory* nil) +(defun setup-info (name &aux tem file) + + (unless (eq *old-lib-directory* *lib-directory*) + (setq *old-lib-directory* *lib-directory*) + (push (string-concatenate *lib-directory* "info/") *info-paths*) + (setq *info-paths* (fix-load-path *info-paths*))) + + (when (equal name "DIR") + (setq name "dir")) + + ;; compressed info reading -- search for gzipped files, and open with base filename +;; relying on si::*allow-gzipped-files* to uncompress + (setq file (file-search name *info-paths* '("" ".info" ".gz") nil)) + (let ((ext (search ".gz" file))) + (when ext + (setq file (subseq file 0 ext)))) + + (unless file + (unless (equal name "dir") + (let* ((tem (show-info "(dir)Top" nil nil)) + *case-fold-search*) + (cond ((<= 0 (string-match + (string-concatenate "\\(([^(]*" (re-quote-string name) "(.info)?)\\)") + tem)) + (setq file (get-match tem 1))))))) + + (IF file + (let* ((na (namestring file )));(truename file) + (cond ((setq tem (assoc na *info-data* :test 'equal)) + (setq *current-info-data* tem)) + (t (setq *current-info-data* + (list na (info-get-tags na) nil)) + (setq *info-data* (cons *current-info-data* *info-data*) + )))) + (format t "(not found ~s)" name)) + nil) + +(defun get-info-choices (pat type) + (if (eql type 'index) + (nodes-from-index pat ) + (get-nodes pat (car (nth 1 *current-info-data*)))))) + +(defun add-file (v file &aux (lis v)) + (while lis + (setf (car lis) (list (car lis) file)) + (setq lis (cdr lis))) + v) + +(defvar *info-window* nil) +(defvar *tk-connection* nil) + +(defun info-error (&rest l) + (if *tk-connection* + (tk::tkerror (apply 'format nil l)) + (apply 'error l))) + +(defvar *last-info-file* nil) +;; cache last file read to speed up lookup since may be gzipped.. +(defun info-get-file (pathname) + (setq pathname + (merge-pathnames pathname + (car *current-info-data*))) + (cdr + (cond ((equal (car *last-info-file*) pathname) + *last-info-file*) + (t (setq *last-info-file* + (cons pathname (file-to-string pathname))))))) + +(defun waiting (win) + (and *tk-connection* + (fboundp win) + (winfo :exists win :return 'boolean) + (funcall win :configure :cursor "watch"))) + +(defun end-waiting (win) (and (fboundp win) + (funcall win :configure :cursor ""))) + +(defun info-subfile (n &aux ) +; "For an index N return (START . FILE) for info subfile +; which contains N. A second value bounding the limit if known +; is returned. At last file this limit is nil." + (let ((lis (cdr (nth 1 *current-info-data*))) + ans lim) + (and lis (>= n 0) + (dolist (v lis) + (cond ((> (car v) n ) + (setq lim (car v)) + (return nil))) + (setq ans v) + )) + (values (or ans (cons 0 (car *current-info-data*))) lim))) + +;;used by search +(defun info-node-from-position (n &aux (i 0)) + (let* ((info-subfile (info-subfile n)) + (s (info-get-file (cdr info-subfile))) + (end (- n (car info-subfile)))) + (while (f >= (string-match +crlu+ s i end) 0) + (setq i (match-end 0))) + (setq i (- i 1)) + (if (f >= (string-match + (fcr #u"[\n ][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n") s i) 0) + (let* ((i (match-beginning 0)) + (beg (match-end 0)) + (name (get-match s 1)) + (end(if (f >= (string-match +crnp+ s beg) 0) + (match-beginning 0) + (length s))) + (node (list* s beg end i name info-subfile + *current-info-data*))) + node)))) + +(defun show-info (name &optional position-pattern + (use-tk *tk-connection*) + &aux info-subfile *match-data* + file + (initial-offset 0)(subnode -1)) + (declare (fixnum subnode initial-offset)) +;;; (pat . node) +;;; node +;;; (node file) +;;; ((pat . node) file) +; (print (list name position-pattern use-tk)) + (progn ;decode name + (cond ((and (consp name) (consp (cdr name))) + (setq file (cadr name) + name (car name)))) + (cond ((consp name) + (setq position-pattern (car name) name (cdr name))))) + (or (stringp name) (info-error "bad arg")) + (waiting *info-window*) + (cond ((f >= (string-match (fcr "^\\(([^(]+)\\)([^)]*)") name) 0) + ;; (file)node + (setq file (get-match name 1)) + (setq name (get-match name 2)) + (if (equal name "")(setq name "Top")))) + (if file (setup-info file)) + (let ((indirect-index (get-node-index name + (car (nth 1 *current-info-data*))))) + (cond ((null indirect-index) + (format t"~%Sorry, Can't find node ~a" name) + (return-from show-info nil))) + + (setq info-subfile (info-subfile indirect-index)) + (let* ((s + (info-get-file (cdr info-subfile))) + (start (- indirect-index (car info-subfile)))) + (cond ((f >= (string-match + ;; to do fix this ;; see (info)Add for description; + ;; the + (si::string-concatenate + #u"[\n ][^\n]*Node:[ \t]+" + (re-quote-string name) #u"[,\t\n][^\n]*\n") + s start) 0) + (let* ((i (match-beginning 0)) + (beg (match-end 0)) + (end(if (f >= (string-match +crnp+ s beg) 0) + (match-beginning 0) + (length s))) + (node (list* s beg end i name info-subfile + *current-info-data*))) + + (cond + (position-pattern + (setq position-pattern (re-quote-string position-pattern)) + + (let (*case-fold-search* ) + (if (or + (f >= (setq subnode + (string-match + (si::string-concatenate + #u"\n -+ [A-Za-z ]+: " + position-pattern #u"[ \n]") + s beg end)) 0) + (f >= (string-match position-pattern s beg end) 0)) + (setq initial-offset + (- (match-beginning 0) beg)) + )))) + (cond ( use-tk + (prog1 (print-node node initial-offset) + (end-waiting *info-window*)) + ) + (t + (let ((e + (if (and (>= subnode 0) + (f >= + (string-match + (fcr #u"\n -+ [a-zA-Z]") + s + (let* ((bg (+ beg 1 initial-offset)) + (sd (string-match (fcr #u"\n ") s bg end)) + (nb (if (minusp sd) bg sd))) + nb) + end) + 0)) + (match-beginning 0) + end))) + ;(print (list beg initial-offset e end)) + (subseq s (+ initial-offset beg) e ) + ;s + ))))) + (t (info-error "Cant find node ~a?" name) + (end-waiting *info-window*) + )) + ))) + +(defvar *default-info-files* '( "gcl-si.info" "gcl-tk.info" "gcl.info")) + +(defun info-aux (x dirs) + (sloop for v in dirs + do (setup-info v) + append (add-file (get-info-choices x 'node) v) + append (add-file (get-info-choices x 'index) v))) + +(defun info-search (pattern &optional start end &aux limit) +; "search for PATTERN from START up to END where these are indices in +;the general info file. The search goes over all files." + (or start (setq start 0)) + (while start + (multiple-value-bind + (file lim) + (info-subfile start) + (setq limit lim) + (and end limit (< end limit) (setq limit end)) + + (let* ((s (info-get-file (cdr file))) + (beg (car file)) + (i (- start beg)) + (leng (length s))) + (cond ((f >= (string-match pattern s i (if limit (- limit beg) leng)) 0) + (return-from info-search (+ beg (match-beginning 0)))))) + (setq start lim))) + -1) + +#+debug ; try searching +(defun try (pat &aux (tem 0) s ) + (while (>= tem 0) + (cond ((>= (setq tem (info-search pat tem)) 0) + (setq s (cdr *last-info-file*)) + (print (list + tem + (list-matches s 0 1 2) + (car *last-info-file*) + (subseq s + (max 0 (- (match-beginning 0) 50)) + (min (+ (match-end 0) 50) (length s))))) + (setq tem (+ tem (- (match-end 0) (match-beginning 0)))))))) + +(defun idescribe (name) + (let* ((items (info-aux name *default-info-files*))) + (dolist (v items) + (when (cond ((consp (car v)) + (equalp (caar v) name)) + (t (equalp (car v) name))) + (format t "~%From ~a:~%" v) + (princ (show-info v nil nil)))))) + +(defun info (x &optional (dirs *default-info-files*) &aux wanted + *current-info-data* file position-pattern) + (unless (consp dirs) + (setq dirs *default-info-files*)) + (let ((tem (info-aux x dirs))) + (cond + (*tk-connection* + (offer-choices tem dirs) + ) + (t + + (when tem + (let ((nitems (length tem))) + (sloop for i from 0 for name in tem with prev + do (setq file nil position-pattern nil) + (progn ;decode name + (cond ((and (consp name) (consp (cdr name))) + (setq file (cadr name) + name (car name)))) + (cond ((consp name) + (setq position-pattern (car name) name (cdr name))))) + (format t "~% ~d: ~@[~a :~]~@[(~a)~]~a." i + position-pattern + (if (eq file prev) nil (setq prev file)) name)) + (if (> (length tem) 1) + (format t "~%Enter n, all, none, or multiple choices eg 1 3 : ") + (terpri)) + (let ((line (if (> (length tem) 1) (read-line) "0")) + (start 0) + val) + (while (equal line "") (setq line (read-line))) + (while (multiple-value-setq + (val start) + (read-from-string line nil nil :start start)) + (cond ((numberp val) + (setq wanted (cons val wanted))) + (t (setq wanted val) (return nil)))) + (cond ((consp wanted)(setq wanted (nreverse wanted))) + ((symbolp wanted) + (setq wanted (and + (equal (symbol-name wanted) "ALL") + (sloop for i below (length tem) collect i))))) + (when wanted + ;; Remove invalid (numerical) answers + (setf wanted (remove-if #'(lambda (x) + (and (integerp x) (>= x nitems))) + wanted)) + (format t "~%Info from file ~a:" (car *current-info-data*))) + (sloop for i in wanted + do (princ(show-info (nth i tem))))))))))) + + +;; idea make info_text window have previous,next,up bindings on keys +;; and on menu bar. Have it bring up apropos menu. allow selection +;; to say spawn another info_text window. The symbol that is the window +;; will carry on its plist the prev,next etc nodes, and the string-to-file +;; cache the last read file as well. Add look up in index file, so that can +;; search an indtqex as well. Could be an optional arg to show-node +;; + + + +(defun default-info-hotlist() + (namestring (merge-pathnames "hotlist" (user-homedir-pathname)))) + +(defvar *info-window* nil) + +(defun add-to-hotlist (node ) + (if (symbolp node) (setq node (get node 'node))) + (cond + (node + (with-open-file + (st (default-info-hotlist) + :direction :output + :if-exists :append + :if-does-not-exist :create) + (cond ((< (file-position st) 10) + (princ #u"\nFile:\thotlist\tNode: Top\n\n* Menu: Hot list of favrite info items.\n\n" st))) + (format st "* (~a)~a::~%" + (node file node)(node name node)))))) + +(defun list-matches (s &rest l) + (sloop for i in l + collect + (and (f >= (match-beginning i) 0) + (get-match s i)))) + +;;; Local Variables: *** +;;; mode:lisp *** +;;; version-control:t *** +;;; comment-column:0 *** +;;; comment-start: ";;; " *** +;;; End: *** + + diff --git a/lsp/gcl_iolib.lsp b/lsp/gcl_iolib.lsp new file mode 100755 index 0000000..0da9091 --- /dev/null +++ b/lsp/gcl_iolib.lsp @@ -0,0 +1,537 @@ +;; -*-Lisp-*- +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; iolib.lsp +;;;; +;;;; The IO library. + + +(in-package :si) + +(defun concatenated-stream-streams (stream) + (declare (optimize (safety 2))) + (check-type stream concatenated-stream) + (c-stream-object0 stream)) +(defun broadcast-stream-streams (stream) + (declare (optimize (safety 2))) + (check-type stream broadcast-stream) + (c-stream-object0 stream)) +(defun two-way-stream-input-stream (stream) + (declare (optimize (safety 2))) + (check-type stream two-way-stream) + (c-stream-object0 stream)) +(defun echo-stream-input-stream (stream) + (declare (optimize (safety 2))) + (check-type stream echo-stream) + (c-stream-object0 stream)) +(defun two-way-stream-output-stream (stream) + (declare (optimize (safety 2))) + (check-type stream two-way-stream) + (c-stream-object1 stream)) +(defun echo-stream-output-stream (stream) + (declare (optimize (safety 2))) + (check-type stream echo-stream) + (c-stream-object1 stream)) +(defun synonym-stream-symbol (stream) + (declare (optimize (safety 2))) + (check-type stream synonym-stream) + (c-stream-object0 stream)) + +(defun maybe-clear-input (&optional (x *standard-input*)) + (typecase x + (synonym-stream (maybe-clear-input (symbol-value (synonym-stream-symbol x)))) + (two-way-stream (maybe-clear-input (two-way-stream-input-stream x))) + (stream (when (terminal-input-stream-p x) (clear-input t))))) + +(defmacro with-open-stream ((var stream) . body) + (declare (optimize (safety 1))) + (multiple-value-bind (ds b) (find-declarations body) + `(let ((,var ,stream)) + ,@ds + (unwind-protect + (progn ,@b) + (close ,var))))) + +(defun make-string-input-stream (string &optional (start 0) end) + (declare (optimize (safety 1))) + (check-type string string) + (check-type start seqind) + (check-type end (or null seqind)) + (let ((l (- (or end (length string)) start))) + (make-string-input-stream-int + (make-array l :element-type (array-element-type string) :displaced-to string :displaced-index-offset start :fill-pointer 0) + 0 l))) + +(defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream))) + (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) (declare (ignore a)) b))) + +(defmacro with-input-from-string ((var string &key index (start 0) end) . body) + (declare (optimize (safety 1))) + (multiple-value-bind (ds b) (find-declarations body) + `(let ((,var (make-string-input-stream ,string ,start ,end))) + ,@ds + (unwind-protect + (multiple-value-prog1 + (progn ,@b) + ,@(when index + `((setf ,index (get-string-input-stream-index ,var))))) + (close ,var))))) + +(defmacro with-output-to-string ((var &optional string &key element-type) . body) + (declare (optimize (safety 1))) + (let ((s (sgen "STRING"))) + (multiple-value-bind (ds b) (find-declarations body) + `(let* ((,s ,string) + (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,element-type)))) + ,@ds + (unwind-protect + (block nil + (multiple-value-prog1 + (progn ,@b) + (unless ,s (return (get-output-stream-string ,var))))) + (close ,var)))))) + + +(defun read-from-string (string &optional (eof-error-p t) eof-value + &key (start 0) end preserve-whitespace) + (declare (optimize (safety 1))) + (check-type string string) + (check-type start seqind) + (check-type end (or null seqind)) + (let ((stream (make-string-input-stream string start (or end (length string))))) + (values (if preserve-whitespace + (read-preserving-whitespace stream eof-error-p eof-value) + (read stream eof-error-p eof-value)) + (get-string-input-stream-index stream)))) + +;; (defun write (x &key stream +;; (array *print-array*) +;; (base *print-base*) +;; (case *print-case*) +;; (circle *print-circle*) +;; (escape *print-escape*) +;; (gensym *print-gensym*) +;; (length *print-length*) +;; (level *print-level*) +;; (lines *print-lines*) +;; (miser-width *print-miser-width*) +;; (pprint-dispatch *print-pprint-dispatch*) +;; (pretty *print-pretty*) +;; (radix *print-radix*) +;; (readably *print-readably*) +;; (right-margin *print-right-margin*)) +;; (write-int x stream array base case circle escape gensym +;; length level lines miser-width pprint-dispatch +;; pretty radix readably right-margin)) + +(defun write-to-string (object &rest rest + &key (escape *print-escape*)(radix *print-radix*)(base *print-base*) + (circle *print-circle*)(pretty *print-pretty*)(level *print-level*) + (length *print-length*)(case *print-case*)(gensym *print-gensym*) + (array *print-array*)(lines *print-lines*)(miser-width *print-miser-width*) + (pprint-dispatch *print-pprint-dispatch*)(readably *print-readably*) + (right-margin *print-right-margin*) + &aux (stream (make-string-output-stream)) + (*print-escape* escape)(*print-radix* radix)(*print-base* base) + (*print-circle* circle)(*print-pretty* pretty)(*print-level* level) + (*print-length* length)(*print-case* case)(*print-gensym* gensym) + (*print-array* array)(*print-lines* lines)(*print-miser-width* miser-width) + (*print-pprint-dispatch* pprint-dispatch)(*print-readably* readably ) + (*print-right-margin* right-margin)) + (declare (optimize (safety 1))(dynamic-extent rest)) + (apply #'write object :stream stream rest) + (get-output-stream-string stream)) + +(defun prin1-to-string (object &aux (stream (make-string-output-stream))) + (declare (optimize (safety 1))) + (prin1 object stream) + (get-output-stream-string stream)) + +(defun princ-to-string (object &aux (stream (make-string-output-stream))) + (declare (optimize (safety 1))) + (princ object stream) + (get-output-stream-string stream)) + +;; (defun file-string-length (ostream object) +;; (declare (optimize (safety 2))) +;; (let ((ostream (if (typep ostream 'broadcast-stream) +;; (car (last (broadcast-stream-streams ostream))) +;; ostream))) +;; (cond ((not ostream) 1) +;; ((subtypep1 (stream-element-type ostream) 'character) +;; (length (let ((*print-escape* nil)) (write-to-string object))))))) + +;; (defmacro with-temp-file ((s pn) (tmp ext) &rest body) +;; (multiple-value-bind +;; (doc decls ctps body) +;; (parse-body-header body) +;; (declare (ignore doc)) +;; `(let* ((,s (temp-stream ,tmp ,ext)) +;; (,pn (stream-object1 ,s))) +;; ,@decls +;; ,@ctps +;; (unwind-protect (progn ,@body) (progn (close ,s) (delete-file ,s)))))) + + +(defmacro with-open-file ((stream . filespec) . body) + (declare (optimize (safety 1))) + (multiple-value-bind (ds b) (find-declarations body) + `(let ((,stream (open ,@filespec))) + ,@ds + (unwind-protect + (progn ,@b) + (when ,stream (close ,stream)))))) + +;; (defun pprint-dispatch (obj &optional (table *print-pprint-dispatch*)) +;; (declare (optimize (safety 2))) +;; (let ((fun (si:get-pprint-dispatch obj table))) +;; (if fun (values fun t) (values 'si:default-pprint-object nil)))) + +;; (setq *print-pprint-dispatch* '(pprint-dispatch . nil)) + +;; (defun set-pprint-dispatch (type-spec function &optional +;; (priority 0) +;; (table *print-pprint-dispatch*)) +;; (declare (optimize (safety 2))) +;; (unless (typep priority 'real) +;; (error 'type-error :datum priority :expected-type 'real)) +;; (let ((a (assoc type-spec (cdr table) :test 'equal))) +;; (if a (setf (cdr a) (list function priority)) +;; (rplacd (last table) `((,type-spec ,function ,priority))))) +;; nil) + +;; (defun copy-pprint-dispatch (&optional table) +;; (declare (optimize (safety 2))) +;; (unless table +;; (setq table *print-pprint-dispatch*)) +;; (unless (and (eq (type-of table) 'cons) +;; (eq (car table) 'pprint-dispatch)) +;; (error 'type-error :datum table :expected-type 'pprint-dispatch)) +;; (copy-seq table )) + + +(defun y-or-n-p (&optional string &rest args) + (declare (optimize (safety 1))) + (when string (format *query-io* "~&~? (Y or N) " string args)) + (let ((reply (symbol-name (read *query-io*)))) + (cond ((string-equal reply "Y") t) + ((string-equal reply "N") nil) + ((apply 'y-or-n-p string args))))) + +(defun yes-or-no-p (&optional string &rest args) + (declare (optimize (safety 1))) + (when string (format *query-io* "~&~? (Yes or No) " string args)) + (let ((reply (symbol-name (read *query-io*)))) + (cond ((string-equal reply "YES") t) + ((string-equal reply "NO") nil) + ((apply 'yes-or-no-p string args))))) + +(defun sharp-a-reader (stream subchar arg) + (declare (ignore subchar)) + (let ((initial-contents (read stream nil nil t))) + (unless *read-suppress* + (do ((i 0 (1+ i)) + (d nil (cons (length ic) d)) + (ic initial-contents (if (zerop (length ic)) ic (elt ic 0)))) + ((>= i arg) (make-array (nreverse d) :initial-contents initial-contents)))))) + +(set-dispatch-macro-character #\# #\a 'sharp-a-reader) +(set-dispatch-macro-character #\# #\a 'sharp-a-reader (standard-readtable)) +(set-dispatch-macro-character #\# #\A 'sharp-a-reader) +(set-dispatch-macro-character #\# #\A 'sharp-a-reader (standard-readtable)) + +;; defined in defstruct.lsp +(set-dispatch-macro-character #\# #\s 'sharp-s-reader) +(set-dispatch-macro-character #\# #\s 'sharp-s-reader (standard-readtable)) +(set-dispatch-macro-character #\# #\S 'sharp-s-reader) +(set-dispatch-macro-character #\# #\S 'sharp-s-reader (standard-readtable)) + +(defvar *dribble-stream* nil) +(defvar *dribble-io* nil) +(defvar *dribble-namestring* nil) +(defvar *dribble-saved-terminal-io* nil) + +(defun dribble (&optional (pathname "DRIBBLE.LOG" psp) (f :supersede)) + (declare (optimize (safety 1))) + (cond ((not psp) + (when (null *dribble-stream*) (error "Not in dribble.")) + (if (eq *dribble-io* *terminal-io*) + (setq *terminal-io* *dribble-saved-terminal-io*) + (warn "*TERMINAL-IO* was rebound while DRIBBLE is on.~%~ + You may miss some dribble output.")) + (close *dribble-stream*) + (setq *dribble-stream* nil) + (format t "~&Finished dribbling to ~A." *dribble-namestring*)) + (*dribble-stream* + (error "Already in dribble (to ~A)." *dribble-namestring*)) + (t + (let* ((namestring (namestring pathname)) + (stream (open pathname :direction :output + :if-exists f + :if-does-not-exist :create))) + (setq *dribble-namestring* namestring + *dribble-stream* stream + *dribble-saved-terminal-io* *terminal-io* + *dribble-io* (make-two-way-stream + (make-echo-stream *terminal-io* stream) + (make-broadcast-stream *terminal-io* stream)) + *terminal-io* *dribble-io*) + (multiple-value-bind (sec min hour day month year) + (get-decoded-time) + (format t "~&Starts dribbling to ~A (~d/~d/~d, ~d:~d:~d)." + namestring year month day hour min sec)))))) + +;; (defmacro formatter ( control-string ) +;; (declare (optimize (safety 2))) +;; `(progn +;; (lambda (*standard-output* &rest arguments) +;; (let ((*format-unused-args* nil)) +;; (apply 'format t ,control-string arguments) +;; *format-unused-args*)))) + +(defun stream-external-format (s) + (declare (optimize (safety 1))) + (check-type s stream) + :default) + +(defvar *print-lines* nil) +(defvar *print-miser-width* nil) +(defvar *print-pprint-dispatch* nil) +(defvar *print-right-margin* nil) + +(defmacro with-standard-io-syntax (&body body) + (declare (optimize (safety 1))) + `(let* ((*package* (find-package :cl-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* *print-pprint-dispatch*);FIXME + (*print-pretty* nil) + (*print-radix* nil) + (*print-readably* t) + (*print-right-margin* nil) + (*read-base* 10) + (*read-default-float-format* 'single-float) + (*read-eval* t) + (*read-suppress* nil) + (*readtable* (copy-readtable (standard-readtable)))) + ,@body)) + +;; (defmacro print-unreadable-object +;; ((object stream &key type identity) &body body) +;; (declare (optimize (safety 2))) +;; (let ((q `(princ " " ,stream))) +;; `(if *print-readably* +;; (error 'print-not-readable :object ,object) +;; (progn +;; (princ "#<" ,stream) +;; ,@(when type `((prin1 (type-of ,object) ,stream) ,q)) +;; ,@body +;; ,@(when identity +;; (let ((z `(princ (address ,object) ,stream))) +;; (if (and (not body) type) (list z) (list q z)))) +;; (princ ">" ,stream) +;; nil)))) + +;; (defmacro with-compile-file-syntax (&body body) +;; `(let ((*print-radix* nil) +;; (*print-base* 10) +;; (*print-circle* t) +;; (*print-pretty* nil) +;; (*print-level* nil) +;; (*print-length* nil) +;; (*print-case* :downcase) +;; (*print-gensym* t) +;; (*print-array* t) +;; (*print-package* t) +;; (*print-structure* t)) +;; ,@body)) + +(defmacro with-compilation-unit (opt &rest body) + (declare (optimize (safety 1))) + (declare (ignore opt)) + `(progn ,@body)) + +(defconstant char-length 8) + +(defun get-byte-stream-nchars (s) + (let* ((tp (stream-element-type s))) + (values (ceiling (if (consp tp) (cadr tp) char-length) char-length)))) + +;; (defun parse-integer (s &key start end (radix 10) junk-allowed) +;; (declare (optimize (safety 1))) +;; (parse-integer-int s start end radix junk-allowed)) + +(defun write-byte (j s &aux (i j)) + (declare (optimize (safety 1))) + (check-type j integer) + (check-type s stream) + (dotimes (k (get-byte-stream-nchars s) j) + (write-char (code-char (logand i #.(1- (ash 1 char-length)))) s) + (setq i (ash i #.(- char-length))))) + + +(defun read-byte (s &optional (eof-error-p t) eof-value &aux (i 0)) + (declare (optimize (safety 1))) + (check-type s stream) + (dotimes (k (get-byte-stream-nchars s) i) + (setq i (logior i (ash (let ((ch (read-char s eof-error-p eof-value))) + (if (eq ch eof-value) (return ch) (char-code ch))) + (* k char-length)))))) + + +(defun read-sequence (seq strm &rest r &key (start 0) end + &aux (l (listp seq))(seqp (when l (nthcdr start seq))) + (cp (eq (stream-element-type strm) 'character))) + (declare (optimize (safety 1))(dynamic-extent r)) + (check-type seq sequence) + (check-type strm stream) + (check-type start (integer 0)) + (check-type end (or null (integer 0))) + (apply 'reduce (lambda (y x &aux (z (if cp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) + (declare (seqind y)(ignorable x)) + (when (eq z 'eof) (return-from read-sequence y)) + (if l (setf (car seqp) z seqp (cdr seqp)) (setf (aref seq y) z)) + (1+ y)) seq :initial-value start r)) + + +(defun write-sequence (seq strm &rest r &key (start 0) end + &aux (cp (eq (stream-element-type strm) 'character))) + (declare (optimize (safety 1))(dynamic-extent r)) + (check-type seq sequence) + (check-type strm stream) + (check-type start (integer 0)) + (check-type end (or null (integer 0))) + (apply 'reduce (lambda (y x) + (declare (seqind y)) + (if cp (write-char x strm) (write-byte x strm)) + (1+ y)) seq :initial-value start r) + seq) + +(defun restrict-stream-element-type (tp) + (cond ((or (member tp '(character :default)) (subtypep tp 'character)) 'character) + ((subtypep tp 'integer) + (let* ((ntp (car (expand-ranges (normalize-type tp)))) + (min (or (cadr ntp) '*))(max (or (caddr ntp) '*)) + (s (if (or (eq min '*) (< min 0)) 'signed-byte 'unsigned-byte)) + (lim (unless (or (eq min '*) (eq max '*)) (max (integer-length min) (integer-length max)))) + (lim (if (and lim (eq s 'signed-byte)) (1+ lim) lim))) + (if lim `(,s ,lim) s))) + ((check-type tp (member character integer))))) + +(defun open (f &key (direction :input) + (element-type 'character) + (if-exists nil iesp) + (if-does-not-exist nil idnesp) + (external-format :default) &aux (pf (pathname f))) + (declare (optimize (safety 1))) + (check-type f pathname-designator) + (when (wild-pathname-p pf) + (error 'file-error :pathname pf :format-control "Pathname is wild.")) + (let* ((s (open-int (namestring (translate-logical-pathname pf)) direction + (restrict-stream-element-type element-type) + if-exists iesp if-does-not-exist idnesp external-format))) + (when (typep s 'stream) (c-set-stream-object1 s pf) s))) + +(defun load-pathname-exists (z) + (or (probe-file z) + (when *allow-gzipped-file* + (when (probe-file (string-concatenate (namestring z) ".gz")) + z)))) + +(defun load-pathname (p print if-does-not-exist external-format + &aux (pp (merge-pathnames p)) + (epp (reduce (lambda (y x) (or y (load-pathname-exists (translate-pathname x "" p)))) + '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? + (if epp + (let* ((*load-pathname* pp)(*load-truename* epp)) + (with-open-file + (s epp :external-format external-format) + (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xcf #xce #x4c #x64))) + (load-fasl s print) + (let ((*standard-input* s)) (load-stream s print))))) + (when if-does-not-exist + (error 'file-error :pathname pp :format-control "File does not exist.")))) + +(defun load (p &key (verbose *load-verbose*) (print *load-print*) (if-does-not-exist :error) + (external-format :default) &aux (*readtable* *readtable*)(*package* *package*)) + (declare (optimize (safety 1))) + (check-type p (or stream pathname-designator)) + (when verbose (format t ";; Loading ~s~%" p)) + (prog1 + (typecase p + (pathname-designator (load-pathname (pathname p) print if-does-not-exist external-format)) + (stream (load-stream p print))) + (when verbose (format t ";; Finished loading ~s~%" p)))) + +(defun ensure-directories-exist (ps &key verbose) + (declare (optimize (safety 1))) + (check-type ps pathname-designator) + (when (wild-pathname-p ps) + (error 'file-error :pathname ps :format-control "Pathname is wild")) + (let ((pd (pathname-directory ps)) ls) + (dotimes (i (length pd)) + (let ((s (namestring (make-pathname :directory (if (zerop i) pd (ldiff pd (last pd i))))))) + (if (eq (stat1 s) :directory) (return) (push s ls)))) + (dolist (s ls) + (mkdir s) + (when verbose (format *standard-output* "Creating directory ~s~%" s))) + (values ps (if ls t)))) + +(defun file-length (x) + (declare (optimize (safety 1))) + (check-type x (or broadcast-stream file-stream)) + (if (typep x 'broadcast-stream) + (let ((s (broadcast-stream-streams x))) (if s (file-length (car (last s))) 0)) + (multiple-value-bind (tp sz) (stat x) + (declare (ignore tp)) + (values (truncate sz (get-byte-stream-nchars x)))))) + +(defun file-position (x &optional (pos :start pos-p)) + (declare (optimize (safety 1))) + (check-type x (or broadcast-stream file-stream string-stream)) + (check-type pos (or (member :start :end) (integer 0))) + (typecase x + (broadcast-stream + (let ((s (car (last (broadcast-stream-streams x))))) + (if s (if pos-p (file-position s pos) (file-position s)) 0))) + (string-stream + (let* ((st (c-stream-object0 x))(l (length st))(d (array-dimension st 0)) + (p (case pos (:start 0) (:end l) (otherwise pos)))) + (if pos-p (when (<= p d) (setf (fill-pointer st) p)) l))) + (otherwise + (let ((n (get-byte-stream-nchars x)) + (p (case pos (:start 0) (:end (file-length x)) (otherwise pos)))) + (if pos-p (when (fseek x (* p n)) p) (/ (ftell x) n)))))) + +(defun file-string-length (strm obj) + (let* ((pos (file-position strm)) + (w (write obj :stream strm :escape nil :readably nil)) + (pos1 (file-position strm)));(break) + (declare (ignore w)) + (file-position strm pos) + (- pos1 pos))) diff --git a/lsp/gcl_japi.lsp b/lsp/gcl_japi.lsp new file mode 100644 index 0000000..a415931 --- /dev/null +++ b/lsp/gcl_japi.lsp @@ -0,0 +1,308 @@ +;;; Binding to the cross platform Japi GUI library from http://www.japi.de/ + +(eval-when (load eval) + (make-package :japi-primitives :nicknames '(jpr) :use '(lisp))) +(in-package :japi-primitives) + + +(clines "#include ") + +;; BOOLEAN +(defconstant J_TRUE 1) +(defconstant J_FALSE 0) + +;; ALIGNMENT +(defconstant J_LEFT 0) +(defconstant J_CENTER 1) +(defconstant J_RIGHT 2) +(defconstant J_TOP 3) +(defconstant J_BOTTOM 4) +(defconstant J_TOPLEFT 5) +(defconstant J_TOPRIGHT 6) +(defconstant J_BOTTOMLEFT 7) +(defconstant J_BOTTOMRIGHT 8) + +;; CURSOR +(defconstant J_DEFAULT_CURSOR 0) +(defconstant J_CROSSHAIR_CURSOR 1) +(defconstant J_TEXT_CURSOR 2) +(defconstant J_WAIT_CURSOR 3) +(defconstant J_SW_RESIZE_CURSOR 4) +(defconstant J_SE_RESIZE_CURSOR 5) +(defconstant J_NW_RESIZE_CURSOR 6) +(defconstant J_NE_RESIZE_CURSOR 7) +(defconstant J_N_RESIZE_CURSOR 8) +(defconstant J_S_RESIZE_CURSOR 9) +(defconstant J_W_RESIZE_CURSOR 10) +(defconstant J_E_RESIZE_CURSOR 11) +(defconstant J_HAND_CURSOR 12) +(defconstant J_MOVE_CURSOR 13) + +;; ORIENTATION +(defconstant J_HORIZONTAL 0) +(defconstant J_VERTICAL 1) + +;; FONTS +(defconstant J_PLAIN 0) +(defconstant J_BOLD 1) +(defconstant J_ITALIC 2) +(defconstant J_COURIER 1) +(defconstant J_HELVETIA 2) +(defconstant J_TIMES 3) +(defconstant J_DIALOGIN 4) +(defconstant J_DIALOGOUT 5) + +;; COLORS +(defconstant J_BLACK 0) +(defconstant J_WHITE 1) +(defconstant J_RED 2) +(defconstant J_GREEN 3) +(defconstant J_BLUE 4) +(defconstant J_CYAN 5) +(defconstant J_MAGENTA 6) +(defconstant J_YELLOW 7) +(defconstant J_ORANGE 8) +(defconstant J_GREEN_YELLOW 9) +(defconstant J_GREEN_CYAN 10) +(defconstant J_BLUE_CYAN 11) +(defconstant J_BLUE_MAGENTA 12) +(defconstant J_RED_MAGENTA 13) +(defconstant J_DARK_GRAY 14) +(defconstant J_LIGHT_GRAY 15) +(defconstant J_GRAY 16) + +;; BORDERSTYLE +(defconstant J_NONE 0) +(defconstant J_LINEDOWN 1) +(defconstant J_LINEUP 2) +(defconstant J_AREADOWN 3) +(defconstant J_AREAUP 4) + +;; MOUSELISTENER +(defconstant J_MOVED 0) +(defconstant J_DRAGGED 1) +(defconstant J_PRESSED 2) +(defconstant J_RELEASED 3) +(defconstant J_ENTERERD 4) +(defconstant J_EXITED 5) +(defconstant J_DOUBLECLICK 6) + +;; J_MOVED +(defconstant J_RESIZED 1) +(defconstant J_HIDDEN 2) +(defconstant J_SHOWN 3) + +;; WINDOWLISTENER +(defconstant J_ACTIVATED 0) +(defconstant J_DEACTIVATED 1) +(defconstant J_OPENED 2) +(defconstant J_CLOSED 3) +(defconstant J_ICONIFIED 4) +(defconstant J_DEICONIFIED 5) +(defconstant J_CLOSING 6) + +;; IMAGEFILEFORMAT +(defconstant J_GIF 0) +(defconstant J_JPG 1) +(defconstant J_PPM 2) +(defconstant J_BMP 3) + +(defentry j_start () ( int "j_start" )) +(defentry j_connect ( string ) ( int "j_connect" )) +(defentry j_setdebug ( int ) ( void "j_setdebug" )) +(defentry j_frame ( string ) ( int "j_frame" )) +(defentry j_button ( int string ) ( int "j_button" )) +(defentry j_graphicbutton ( int string ) ( int "j_graphicbutton" )) +(defentry j_checkbox ( int string ) ( int "j_checkbox" )) +(defentry j_label ( int string ) ( int "j_label" )) +(defentry j_graphiclabel ( int string ) ( int "j_graphiclabel" )) +(defentry j_canvas ( int int int ) ( int "j_canvas" )) +(defentry j_panel ( int ) ( int "j_panel" )) +(defentry j_borderpanel ( int int ) ( int "j_borderpanel" )) +(defentry j_radiogroup ( int ) ( int "j_radiogroup" )) +(defentry j_radiobutton ( int string ) ( int "j_radiobutton" )) +(defentry j_list ( int int ) ( int "j_list" )) +(defentry j_choice ( int ) ( int "j_choice" )) +(defentry j_dialog ( int string ) ( int "j_dialog" )) +(defentry j_window ( int ) ( int "j_window" )) +(defentry j_popupmenu ( int string ) ( int "j_popupmenu" )) +(defentry j_scrollpane ( int ) ( int "j_scrollpane" )) +(defentry j_hscrollbar ( int ) ( int "j_hscrollbar" )) +(defentry j_vscrollbar ( int ) ( int "j_vscrollbar" )) +(defentry j_line ( int int int int ) ( int "j_line" )) +(defentry j_printer ( int ) ( int "j_printer" )) +(defentry j_image ( int int ) ( int "j_image" )) +(defentry j_filedialog ( int string string string ) ( string "j_filedialog" )) +(defentry j_fileselect ( int string string string ) ( string "j_fileselect" )) +(defentry j_messagebox ( int string string ) ( int "j_messagebox" )) +(defentry j_alertbox ( int string string string ) ( int "j_alertbox" )) +(defentry j_choicebox2 ( int string string string string ) ( int "j_choicebox2" )) +(defentry j_choicebox3 ( int string string string string string ) ( int "j_choicebox3" )) +(defentry j_additem ( int string ) ( void "j_additem" )) +(defentry j_textfield ( int int ) ( int "j_textfield" )) +(defentry j_textarea ( int int int ) ( int "j_textarea" )) +(defentry j_menubar ( int ) ( int "j_menubar" )) +(defentry j_menu ( int string ) ( int "j_menu" )) +(defentry j_helpmenu ( int string ) ( int "j_helpmenu" )) +(defentry j_menuitem ( int string ) ( int "j_menuitem" )) +(defentry j_checkmenuitem ( int string ) ( int "j_checkmenuitem" )) +(defentry j_pack ( int ) ( void "j_pack" )) +(defentry j_print ( int ) ( void "j_print" )) +(defentry j_playsoundfile ( string ) ( void "j_playsoundfile" )) +(defentry j_play ( int ) ( void "j_play" )) +(defentry j_sound ( string ) ( int "j_sound" )) +(defentry j_setfont ( int int int int ) ( void "j_setfont" )) +(defentry j_setfontname ( int int ) ( void "j_setfontname" )) +(defentry j_setfontsize ( int int ) ( void "j_setfontsize" )) +(defentry j_setfontstyle ( int int ) ( void "j_setfontstyle" )) +(defentry j_seperator ( int ) ( void "j_seperator" )) +(defentry j_disable ( int ) ( void "j_disable" )) +(defentry j_enable ( int ) ( void "j_enable" )) +(defentry j_getstate ( int ) ( int "j_getstate" )) +(defentry j_getrows ( int ) ( int "j_getrows" )) +(defentry j_getcolumns ( int ) ( int "j_getcolumns" )) +(defentry j_getselect ( int ) ( int "j_getselect" )) +(defentry j_isselect ( int int ) ( int "j_isselect" )) +(defentry j_isvisible ( int ) ( int "j_isvisible" )) +(defentry j_isparent ( int int ) ( int "j_isparent" )) +(defentry j_isresizable ( int ) ( int "j_isresizable" )) +(defentry j_select ( int int ) ( void "j_select" )) +(defentry j_deselect ( int int ) ( void "j_deselect" )) +(defentry j_multiplemode ( int int ) ( void "j_multiplemode" )) +(defentry j_insert ( int int string ) ( void "j_insert" )) +(defentry j_remove ( int int ) ( void "j_remove" )) +(defentry j_removeitem ( int string ) ( void "j_removeitem" )) +(defentry j_removeall ( int ) ( void "j_removeall" )) +(defentry j_setstate ( int int ) ( void "j_setstate" )) +(defentry j_setrows ( int int ) ( void "j_setrows" )) +(defentry j_setcolumns ( int int ) ( void "j_setcolumns" )) +(defentry j_seticon ( int int ) ( void "j_seticon" )) +(defentry j_setimage ( int int ) ( void "j_setimage" )) +(defentry j_setvalue ( int int ) ( void "j_setvalue" )) +(defentry j_setradiogroup ( int int ) ( void "j_setradiogroup" )) +(defentry j_setunitinc ( int int ) ( void "j_setunitinc" )) +(defentry j_setblockinc ( int int ) ( void "j_setblockinc" )) +(defentry j_setmin ( int int ) ( void "j_setmin" )) +(defentry j_setmax ( int int ) ( void "j_setmax" )) +(defentry j_setslidesize ( int int ) ( void "j_setslidesize" )) +(defentry j_setcursor ( int int ) ( void "j_setcursor" )) +(defentry j_setresizable ( int int ) ( void "j_setresizable" )) +(defentry j_getlength ( int ) ( int "j_getlength" )) +(defentry j_getvalue ( int ) ( int "j_getvalue" )) +(defentry j_getscreenheight () ( int "j_getscreenheight" )) +(defentry j_getscreenwidth () ( int "j_getscreenwidth" )) +(defentry j_getheight ( int ) ( int "j_getheight" )) +(defentry j_getwidth ( int ) ( int "j_getwidth" )) +(defentry j_getinsets ( int int ) ( int "j_getinsets" )) +(defentry j_getlayoutid ( int ) ( int "j_getlayoutid" )) +(defentry j_getinheight ( int ) ( int "j_getinheight" )) +(defentry j_getinwidth ( int ) ( int "j_getinwidth" )) +(defentry j_gettext ( int string ) ( string "j_gettext" )) +(defentry j_getitem ( int int string ) ( string "j_getitem" )) +(defentry j_getitemcount ( int ) ( int "j_getitemcount" )) +(defentry j_delete ( int int int ) ( void "j_delete" )) +(defentry j_replacetext ( int int int int ) ( void "j_replacetext" )) +(defentry j_appendtext ( int int ) ( void "j_appendtext" )) +(defentry j_inserttext ( int int int ) ( void "j_inserttext" )) +(defentry j_settext ( int string ) ( void "j_settext" )) +(defentry j_selectall ( int ) ( void "j_selectall" )) +(defentry j_selecttext ( int int int ) ( void "j_selecttext" )) +(defentry j_getselstart ( int ) ( int "j_getselstart" )) +(defentry j_getselend ( int ) ( int "j_getselend" )) +;(defentry j_getseltext ( int string ) ( string "j_getseltext" )) +(defentry j_getseltext ( int int ) ( int "j_getseltext" )) +(defentry j_getcurpos ( int ) ( int "j_getcurpos" )) +(defentry j_setcurpos ( int int ) ( void "j_setcurpos" )) +(defentry j_setechochar ( int char ) ( void "j_setechochar" )) +(defentry j_seteditable ( int int ) ( void "j_seteditable" )) +(defentry j_setshortcut ( int char ) ( void "j_setshortcut" )) +(defentry j_quit () ( void "j_quit" )) +(defentry j_kill () ( void "j_kill" )) +(defentry j_setsize ( int int int ) ( void "j_setsize" )) +(defentry j_getaction () ( int "j_getaction" )) +(defentry j_nextaction () ( int "j_nextaction" )) +(defentry j_show ( int ) ( void "j_show" )) +(defentry j_showpopup ( int int int ) ( void "j_showpopup" )) +(defentry j_add ( int int ) ( void "j_add" )) +(defentry j_release ( int ) ( void "j_release" )) +(defentry j_releaseall ( int ) ( void "j_releaseall" )) +(defentry j_hide ( int ) ( void "j_hide" )) +(defentry j_dispose ( int ) ( void "j_dispose" )) +(defentry j_setpos ( int int int ) ( void "j_setpos" )) +(defentry j_getviewportheight ( int ) ( int "j_getviewportheight" )) +(defentry j_getviewportwidth ( int ) ( int "j_getviewportwidth" )) +(defentry j_getxpos ( int ) ( int "j_getxpos" )) +(defentry j_getypos ( int ) ( int "j_getypos" )) +;(defentry j_getpos ( int int* int* ) ( void "j_getpos" )) +(defentry j_getpos ( int int int ) ( void "j_getpos" )) +(defentry j_getparentid ( int ) ( int "j_getparentid" )) +(defentry j_setfocus ( int ) ( void "j_setfocus" )) +(defentry j_hasfocus ( int ) ( int "j_hasfocus" )) +(defentry j_getstringwidth ( int string ) ( int "j_getstringwidth" )) +(defentry j_getfontheight ( int ) ( int "j_getfontheight" )) +(defentry j_getfontascent ( int ) ( int "j_getfontascent" )) +(defentry j_keylistener ( int ) ( int "j_keylistener" )) +(defentry j_getkeycode ( int ) ( int "j_getkeycode" )) +(defentry j_getkeychar ( int ) ( int "j_getkeychar" )) +(defentry j_mouselistener ( int int ) ( int "j_mouselistener" )) +(defentry j_getmousex ( int ) ( int "j_getmousex" )) +(defentry j_getmousey ( int ) ( int "j_getmousey" )) +;(defentry j_getmousepos ( int int* int* ) ( void "j_getmousepos" )) +(defentry j_getmousepos ( int int int ) ( void "j_getmousepos" )) +(defentry j_getmousebutton ( int ) ( int "j_getmousebutton" )) +(defentry j_focuslistener ( int ) ( int "j_focuslistener" )) +(defentry j_componentlistener ( int int ) ( int "j_componentlistener" )) +(defentry j_windowlistener ( int int ) ( int "j_windowlistener" )) +(defentry j_setflowlayout ( int int ) ( void "j_setflowlayout" )) +(defentry j_setborderlayout ( int ) ( void "j_setborderlayout" )) +(defentry j_setgridlayout ( int int int ) ( void "j_setgridlayout" )) +(defentry j_setfixlayout ( int ) ( void "j_setfixlayout" )) +(defentry j_setnolayout ( int ) ( void "j_setnolayout" )) +(defentry j_setborderpos ( int int ) ( void "j_setborderpos" )) +(defentry j_sethgap ( int int ) ( void "j_sethgap" )) +(defentry j_setvgap ( int int ) ( void "j_setvgap" )) +(defentry j_setinsets ( int int int int int ) ( void "j_setinsets" )) +(defentry j_setalign ( int int ) ( void "j_setalign" )) +(defentry j_setflowfill ( int int ) ( void "j_setflowfill" )) +(defentry j_translate ( int int int ) ( void "j_translate" )) +(defentry j_cliprect ( int int int int int ) ( void "j_cliprect" )) +(defentry j_drawrect ( int int int int int ) ( void "j_drawrect" )) +(defentry j_fillrect ( int int int int int ) ( void "j_fillrect" )) +(defentry j_drawroundrect ( int int int int int int int ) ( void "j_drawroundrect" )) +(defentry j_fillroundrect ( int int int int int int int ) ( void "j_fillroundrect" )) +(defentry j_drawoval ( int int int int int ) ( void "j_drawoval" )) +(defentry j_filloval ( int int int int int ) ( void "j_filloval" )) +(defentry j_drawcircle ( int int int int ) ( void "j_drawcircle" )) +(defentry j_fillcircle ( int int int int ) ( void "j_fillcircle" )) +(defentry j_drawarc ( int int int int int int int ) ( void "j_drawarc" )) +(defentry j_fillarc ( int int int int int int int ) ( void "j_fillarc" )) +(defentry j_drawline ( int int int int int ) ( void "j_drawline" )) +;(defentry j_drawpolyline ( int int int* int* ) ( void "j_drawpolyline" )) +;(defentry j_drawpolygon ( int int int* int* ) ( void "j_drawpolygon" )) +;(defentry j_fillpolygon ( int int int* int* ) ( void "j_fillpolygon" )) +(defentry j_drawpolyline ( int int int int ) ( void "j_drawpolyline" )) +(defentry j_drawpolygon ( int int int int ) ( void "j_drawpolygon" )) +(defentry j_fillpolygon ( int int int int ) ( void "j_fillpolygon" )) +(defentry j_drawpixel ( int int int ) ( void "j_drawpixel" )) +(defentry j_drawstring ( int int int string ) ( void "j_drawstring" )) +(defentry j_setxor ( int int ) ( void "j_setxor" )) +(defentry j_getimage ( int ) ( int "j_getimage" )) +;(defentry j_getimagesource ( int int int int int int* int* int* ) ( void "j_getimagesource" )) +;(defentry j_drawimagesource ( int int int int int int* int* int* ) ( void "j_drawimagesource" )) +(defentry j_getimagesource ( int int int int int int int int ) ( void "j_getimagesource" )) +(defentry j_drawimagesource ( int int int int int int int int ) ( void "j_drawimagesource" )) +(defentry j_getscaledimage ( int int int int int int int ) ( int "j_getscaledimage" )) +(defentry j_drawimage ( int int int int ) ( void "j_drawimage" )) +(defentry j_drawscaledimage ( int int int int int int int int int int ) ( void "j_drawscaledimage" )) +(defentry j_setcolor ( int int int int ) ( void "j_setcolor" )) +(defentry j_setcolorbg ( int int int int ) ( void "j_setcolorbg" )) +(defentry j_setnamedcolor ( int int ) ( void "j_setnamedcolor" )) +(defentry j_setnamedcolorbg ( int int ) ( void "j_setnamedcolorbg" )) +(defentry j_loadimage ( string ) ( int "j_loadimage" )) +(defentry j_saveimage ( int string int ) ( int "j_saveimage" )) +(defentry j_sync () ( void "j_sync" )) +(defentry j_beep () ( void "j_beep" )) +(defentry j_random () ( int "j_random" )) +(defentry j_sleep ( int ) ( void "j_sleep" )) + + diff --git a/lsp/gcl_listlib.lsp b/lsp/gcl_listlib.lsp new file mode 100755 index 0000000..b93d2fe --- /dev/null +++ b/lsp/gcl_listlib.lsp @@ -0,0 +1,213 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; listlib.lsp +;;;; +;;;; list manipulating routines + +; Rewritten 11 Feb 1993 by William Schelter and Gordon Novak to use iteration +; rather than recursion, as needed for large data sets. + + +(in-package :si) + +(eval-when (compile) + (proclaim '(optimize (safety 0) (space 3))) + ) + + +(macrolet + ((defl2fn (n &rest body) `(defun ,n (list1 list2 &key key test test-not &aux r rp + (key (when key (coerce key 'function))) + (test (when test (coerce test 'function))) + (test-not (when test-not (coerce test-not 'function)))) + (macrolet + ((check-list (list) `(do ((l ,list (cdr l))) + ((not (consp l)) + (when l (error 'type-error :datum l :expected-type 'list))))) + (apply-to-stack (form list) `(let (r rp) + (dolist (l ,list r) + (let ((tmp (cons ,(if form `(,@form l) `l) nil))) + (declare (dynamic-extent tmp)) + (setq rp (if rp (cdr (rplacd rp tmp)) (setq r tmp))))))) + (collect (x) `(let ((temp ,x)) + (setq rp (if rp (cdr (rplacd rp temp)) (setq r temp))))) + (do-test (x z) `(cond (test (funcall test ,x ,z)) + (test-not (not (funcall test-not ,x ,z))) + ((eql ,x ,z)))) + (memb (item list &optional rev) `(do ((item ,item)(l ,list (cdr l))) ((not l)) + (let ((cl (car l))) + (when (do-test ,@(if rev `(cl item) `(item cl))) + (return l)))))) + (check-list list1)(check-list list2) + (let ((klist2 (if key (apply-to-stack (funcall key) list2) list2))) + ,@body))))) + + (defl2fn intersection + (dolist (l1 list1 r) + (when (memb (if key (funcall key l1) l1) klist2) + (collect (cons l1 nil))))) + + (defl2fn union + (dolist (l1 list1) + (unless (memb (if key (funcall key l1) l1) klist2) + (collect (cons l1 nil)))) + (when rp (rplacd rp list2)) + (or r list2)) + + (defl2fn set-difference + (dolist (l1 list1 r) + (unless (memb (if key (funcall key l1) l1) klist2) + (collect (cons l1 nil))))) + + (defl2fn set-exclusive-or + (let ((klist1 (if key (apply-to-stack (funcall key) list1) list1))) + (do ((kl1 klist1 (cdr kl1))(l1 list1 (cdr l1))) ((not kl1)) + (unless (memb (car kl1) klist2) + (collect (cons (car l1) nil)))) + (do ((kl2 klist2 (cdr kl2))(l2 list2 (cdr l2))) ((not kl2) r) + (unless (memb (car kl2) klist1 t) + (collect (cons (car l2) nil)))))) + + (defl2fn nintersection + (do ((l1 list1 (cdr l1)))((not l1) (when rp (rplacd rp nil)) r) + (let ((cl1 (car l1))) + (when (memb (if key (funcall key cl1) cl1) klist2) + (collect l1))))) + + (defl2fn nunion + (do ((l1 list1 (cdr l1)))((not l1) (when rp (rplacd rp list2)) (or r list2)) + (let ((cl1 (car l1))) + (unless (memb (if key (funcall key cl1) cl1) klist2) + (collect l1))))) + + (defl2fn nset-difference + (do ((l1 list1 (cdr l1)))((not l1) (when rp (rplacd rp nil)) r) + (let ((cl1 (car l1))) + (unless (memb (if key (funcall key cl1) cl1) klist2) + (collect l1))))) + + (defl2fn nset-exclusive-or + (let ((klist1 (if key (apply-to-stack (funcall key) list1) (apply-to-stack nil list1)))) + (do ((kl1 klist1 (cdr kl1))(l1 list1 (cdr l1))) ((not kl1)) + (unless (memb (car kl1) klist2) + (collect l1))) + (do ((kl2 klist2 (cdr kl2))(l2 list2 (cdr l2))) ((not kl2) (when rp (rplacd rp nil)) r) + (unless (memb (car kl2) klist1 t) + (collect l2))))) + + (defl2fn subsetp r rp + (dolist (l1 list1 t) + (unless (memb (if key (funcall key l1) l1) klist2) + (return nil))))) + + +(defmacro tp-error (x y) + `(error 'type-error :datum ,x :expected-type ',y)) + +(defun smallnthcdr (n x) + (declare (fixnum n)) + (cond ((= n 0) x) + ((atom x) (when x (tp-error x proper-list))) + ((smallnthcdr (1- n) (cdr x))))) + +(defun bignthcdr (n i s f) + (declare (fixnum i)) + (cond ((atom f) (when f (tp-error f proper-list))) + ((atom (cdr f)) (when (cdr f) (tp-error (cdr f) proper-list))) + ((eq s f) (smallnthcdr (mod n i) s)) + ((bignthcdr n (1+ i) (cdr s) (cddr f))))) + +(defun nthcdr (n x) + (declare (optimize (safety 1))) + (cond ((or (not (integerp n)) (minusp n)) (tp-error n (integer 0))) + ((< n array-dimension-limit) (smallnthcdr n x)) + ((atom x) (when x (tp-error x proper-list))) + ((atom (cdr x)) (when (cdr x) (tp-error (cdr x) proper-list))) + ((bignthcdr n 1 (cdr x) (cddr x))))) + +(defun nth (n x) + (declare (optimize (safety 2))) + (car (nthcdr n x))) +(defun first (x) + (declare (optimize (safety 2))) + (car x)) +(defun second (x) + (declare (optimize (safety 2))) + (cadr x)) +(defun third (x) + (declare (optimize (safety 2))) + (caddr x)) +(defun fourth (x) + (declare (optimize (safety 2))) + (cadddr x)) +(defun fifth (x) + (declare (optimize (safety 2))) + (car (cddddr x))) +(defun sixth (x) + (declare (optimize (safety 2))) + (cadr (cddddr x))) +(defun seventh (x) + (declare (optimize (safety 2))) + (caddr (cddddr x))) +(defun eighth (x) + (declare (optimize (safety 2))) + (cadddr (cddddr x))) +(defun ninth (x) + (declare (optimize (safety 2))) + (car (cddddr (cddddr x)))) +(defun tenth (x) + (declare (optimize (safety 2))) + (cadr (cddddr (cddddr x)))) + +; Courtesy Paul Dietz +(defmacro nth-value (n expr) + (declare (optimize (safety 1))) + `(nth ,n (multiple-value-list ,expr))) + +(eval-when (compile eval) + + (defmacro repl-if (tc) `(labels ((l (tr &aux (k (if kf (funcall kf tr) tr))) + (cond (,tc n) + ((atom tr) tr) + ((let* ((ca (car tr))(a (l ca))(cd (cdr tr))(d (l cd))) + (if (and (eq a ca) (eq d cd)) tr (cons a d))))))) + (declare (ftype (function (t) t) l)) + (l tr)))) + +(defun subst (n o tr &key key test test-not + &aux (kf (when key (coerce key 'function))) + (tf (when test (coerce test 'function))) + (ntf (when test-not (coerce test-not 'function)))) + (declare (optimize (safety 1))) + (check-type key (or null function)) + (check-type test (or null function)) + (check-type test-not (or null function)) + (repl-if (cond (tf (funcall tf o k))(ntf (not (funcall ntf o k)))((eql o k))))) + +(defun subst-if (n p tr &key key &aux (kf (when key (coerce key 'function)))) + (declare (optimize (safety 1))) + (check-type p function) + (check-type key (or null function)) + (repl-if (funcall p k))) +(defun subst-if-not (n p tr &key key &aux (kf (when key (coerce key 'function)))) + (declare (optimize (safety 1))) + (check-type p function) + (check-type key (or null function)) + (repl-if (not (funcall p k))))) diff --git a/lsp/gcl_littleXlsp.lsp b/lsp/gcl_littleXlsp.lsp new file mode 100755 index 0000000000000000000000000000000000000000..966d8fc30e4edaa8d45d9bb47f6494f795d5eb8c GIT binary patch literal 6572 zcmeHLZExGi5$CZ`dN7u4g5QQZ^{*;FGQ%&NN=klLuD+ zlm=mUD>z(LGbPi*MXC;!Ssf~AtrEBRb)*C8ZR=)pEsK$+NZrOUex?D8y3v%p*D`|) zHocL&UdnXI@Z}Xgl`w`@y0pnmiDxuevmvues*KODnb3k{4uhN_taFlOgIBjV*XM7) z{QZxwFR!kD?rAaj_Ufy*U$QRv&hfn%z@f})d6*~ZQWj#AiMe@3rO5mSI7Yk#NZkH2 z2WlzuwXj%WP-J>N95(Bdo%K=}`GcqlX&uvK zJf`?~j3ZlH6Pi39(`0fCrC3ZfOVYbVsVl@9&ILdYE)G*AlCtIJMMra8ikdc>^{e>@%nF*2y#uk=>xxDv?I1P~6*1>d6mwrvlzQu~bM!!IOVXo*j&DyFUZ3c08`_?*0O$!L#qR2^PJN`+kGN z*~Pm+ITMpIrS+tCBYP~2oa1V!hlG`O%(fzgGl#F z8tKqkLY#G15d1$q;j+co-5I?`$-<50>2arC3tN>%{Wo1*y6d^XwP?jcl!!wy$L)%W z*r|0C0vCz=5IE|{=xNRpYB_Fw zM-Xb@#uCO%q6tV*7PuQ2{Su*_V%igm^(~>7@E2sddW!B~gX3e;82K&&6Cj|(+#;2X zrF*E2ke5YbxwGh#9)Z;Am8X3880B+N`bd17>oI6&+FG6OVca_1)e2{=^Edmv^Idy~ ziKa}%6^+$@#U;IgX5)ee&?p zsNN2qe_NcbWoBKWGViLS+>Kg}uchF!$eH;8q7x7qo0OJ&td%yBhk;Y{fD1I!Xs=x8 z9G#9)`nC;wfuo{u&Fc0+zN%f!c{a^i=kX>_x;X;cCPgl|gM$#~_DL{Y{ViDY?(YUH4zRaq!pOiG^6By+RG%sf^q&@UE}E zopRM5HM?>D0&-R`H6<-aa63rK6)FqeMHGznkJP+HzIj`OQOq;8y@Al z7vhecTTSHl1;IC;Ypn6egzIJJIK%Xb9T@jjdpj^Z;B4AscNwt22=@>7NP6~nk#5?h z?lr(vZZyLSR>8N@<}8K2WyY<@N~1A+a3j@*0L*KOaDibgjcP*wF?0v&Cd}V34uanO zvV%kq$erE)G>*QqJ_@Aoq;`;OPk#u?mf{y+`Bqpi(|+(p3gF@CjTEFyy5L!L2Q-HC z;LX)5rZ~9x=JoYuCsMk@E_CQ*19rGhOnJWU1xWV@g&4dejh4iZ$(Xq1oI>%Ay6g3L z&e2uBW;FUkB<9Bb8)Kevoi*RNq+fAwmR1U_ihFNy3E7?P_FC>p3(R^Qqno*z4fdH) zX9PB;e4uA(*9}oRj&d#!}~Ol@UarmMWOSsC^{a zXogK8H)jEjkv9RJuldO&G|?Z89T__{Ld}O~0rvROs(CNzvYB>a+ardZcK8&p;QZ`e z@o?hnKVIvL3J=|wKyvpwkkQjaCj +;;;> Portions of LOOP are Copyright (c) 1986 by the Massachusetts Institute of Technology. +;;;> All Rights Reserved. +;;;> +;;;> Permission to use, copy, modify and distribute this software and its +;;;> documentation for any purpose and without fee is hereby granted, +;;;> provided that the M.I.T. copyright notice appear in all copies and that +;;;> both that copyright notice and this permission notice appear in +;;;> supporting documentation. The names "M.I.T." and "Massachusetts +;;;> Institute of Technology" may not be used in advertising or publicity +;;;> pertaining to distribution of the software without specific, written +;;;> prior permission. Notice must be given in supporting documentation that +;;;> copying distribution is by permission of M.I.T. M.I.T. makes no +;;;> representations about the suitability of this software for any purpose. +;;;> It is provided "as is" without express or implied warranty. +;;;> +;;;> Massachusetts Institute of Technology +;;;> 77 Massachusetts Avenue +;;;> Cambridge, Massachusetts 02139 +;;;> United States of America +;;;> +1-617-253-1000 +;;;> +;;;> Portions of LOOP are Copyright (c) 1989, 1990, 1991, 1992 by Symbolics, Inc. +;;;> All Rights Reserved. +;;;> +;;;> Permission to use, copy, modify and distribute this software and its +;;;> documentation for any purpose and without fee is hereby granted, +;;;> provided that the Symbolics copyright notice appear in all copies and +;;;> that both that copyright notice and this permission notice appear in +;;;> supporting documentation. The name "Symbolics" may not be used in +;;;> advertising or publicity pertaining to distribution of the software +;;;> without specific, written prior permission. Notice must be given in +;;;> supporting documentation that copying distribution is by permission of +;;;> Symbolics. Symbolics makes no representations about the suitability of +;;;> this software for any purpose. It is provided "as is" without express +;;;> or implied warranty. +;;;> +;;;> Symbolics, CLOE Runtime, and Minima are trademarks, and CLOE, Genera, +;;;> and Zetalisp are registered trademarks of Symbolics, Inc. +;;;> +;;;> Symbolics, Inc. +;;;> 8 New England Executive Park, East +;;;> Burlington, Massachusetts 01803 +;;;> United States of America +;;;> +1-617-221-1000 + +;; $aclHeader: loop.cl,v 1.5 91/12/04 01:13:48 cox acl4_1 $ + +#+cmu +(ext:file-comment + "$Header$") + +;;;; LOOP Iteration Macro + +#+allegro +(in-package :excl) +#+ecls +(in-package "SI") + +#-(or allegro ecls) +(in-package :ansi-loop) + +(export '(loop loop-finish)) + +#-ecls +(provide :loop) + +#+Cloe-Runtime ;Don't ask. +(car (push "%Z% %M% %I% %E% %U%" system::*module-identifications*)) + +;;; Technology. +;;; +;;; The LOOP iteration macro is one of a number of pieces of code +;;; originally developed at MIT for which free distribution has been +;;; permitted, as long as the code is not sold for profit, and as long +;;; as notification of MIT's interest in the code is preserved. +;;; +;;; This version of LOOP, which is almost entirely rewritten both as +;;; clean-up and to conform with the ANSI Lisp LOOP standard, started +;;; life as MIT LOOP version 829 (which was a part of NIL, possibly +;;; never released). +;;; +;;; A "light revision" was performed by me (Glenn Burke) while at +;;; Palladian Software in April 1986, to make the code run in Common +;;; Lisp. This revision was informally distributed to a number of +;;; people, and was sort of the "MIT" version of LOOP for running in +;;; Common Lisp. +;;; +;;; A later more drastic revision was performed at Palladian perhaps a +;;; year later. This version was more thoroughly Common Lisp in style, +;;; with a few miscellaneous internal improvements and extensions. I +;;; have lost track of this source, apparently never having moved it to +;;; the MIT distribution point. I do not remember if it was ever +;;; distributed. +;;; +;;; This revision for the ANSI standard is based on the code of my April +;;; 1986 version, with almost everything redesigned and/or rewritten. + + +;;; The design of this LOOP is intended to permit, using mostly the same +;;; kernel of code, up to three different "loop" macros: +;;; +;;; (1) The unextended, unextensible ANSI standard LOOP; +;;; +;;; (2) A clean "superset" extension of the ANSI LOOP which provides +;;; functionality similar to that of the old LOOP, but "in the style of" +;;; the ANSI LOOP. For instance, user-definable iteration paths, with a +;;; somewhat cleaned-up interface. +;;; +;;; (3) Extensions provided in another file which can make this LOOP +;;; kernel behave largely compatibly with the Genera-vintage LOOP macro, +;;; with only a small addition of code (instead of two whole, separate, +;;; LOOP macros). +;;; +;;; Each of the above three LOOP variations can coexist in the same LISP +;;; environment. +;;; + + +;;;; Miscellaneous Environment Things + + + +;;;The LOOP-Prefer-POP feature makes LOOP generate code which "prefers" to use POP or +;;; its obvious expansion (prog1 (car x) (setq x (cdr x))). Usually this involves +;;; shifting fenceposts in an iteration or series of carcdr operations. This is +;;; primarily recognized in the list iterators (FOR .. {IN,ON}), and LOOP's +;;; destructuring setq code. +(eval-when (compile load eval) + #+(or Genera Minima) (pushnew :LOOP-Prefer-POP *features*) + ) + + +;;; The uses of this macro are retained in the CL version of loop, in +;;; case they are needed in a particular implementation. Originally +;;; dating from the use of the Zetalisp COPYLIST* function, this is used +;;; in situations where, were cdr-coding in use, having cdr-NIL at the +;;; end of the list might be suboptimal because the end of the list will +;;; probably be RPLACDed and so cdr-normal should be used instead. +(defmacro loop-copylist* (l) + #+Genera `(lisp:copy-list ,l nil t) ; arglist = (list &optional area force-dotted) + ;;Explorer?? + #-Genera `(copy-list ,l) + ) + + +(defvar *loop-gentemp* + nil) + +(defun loop-gentemp (&optional (pref 'loopvar-)) + (if *loop-gentemp* + (gentemp (string pref)) + (gensym))) + + + +(defvar *loop-real-data-type* 'real) + + +(defun loop-optimization-quantities (env) + ;; The ANSI conditionalization here is for those lisps that implement + ;; DECLARATION-INFORMATION (from cleanup SYNTACTIC-ENVIRONMENT-ACCESS). + ;; It is really commentary on how this code could be written. I don't + ;; actually expect there to be an ANSI #+-conditional -- it should be + ;; replaced with the appropriate conditional name for your + ;; implementation/dialect. + (declare #-ANSI (ignore env) + #+Genera (values speed space safety compilation-speed debug)) + #+ANSI (let ((stuff (declaration-information 'optimize env))) + (values (or (cdr (assoc 'speed stuff)) 1) + (or (cdr (assoc 'space stuff)) 1) + (or (cdr (assoc 'safety stuff)) 1) + (or (cdr (assoc 'compilation-speed stuff)) 1) + (or (cdr (assoc 'debug stuff)) 1))) + #+CLOE-Runtime (values compiler::time compiler::space + compiler::safety compiler::compilation-speed 1) + #-(or ANSI CLOE-Runtime) (values 1 1 1 1 1)) + + +;;; The following form takes a list of variables and a form which presumably +;;; references those variables, and wraps it somehow so that the compiler does not +;;; consider those variables have been referenced. The intent of this is that +;;; iteration variables can be flagged as unused by the compiler, e.g. I in +;;; (loop for i from 1 to 10 do (print t)), since we will tell it when a usage +;;; of it is "invisible" or "not to be considered". +;;;We implicitly assume that a setq does not count as a reference. That is, the +;;; kind of form generated for the above loop construct to step I, simplified, is +;;; `(SETQ I ,(HIDE-VARIABLE-REFERENCES '(I) '(1+ I))). +(defun hide-variable-references (variable-list form) + (declare #-Genera (ignore variable-list)) + #+Genera (if variable-list `(compiler:invisible-references ,variable-list ,form) form) + #-Genera form) + + +;;; The following function takes a flag, a variable, and a form which presumably +;;; references that variable, and wraps it somehow so that the compiler does not +;;; consider that variable to have been referenced. The intent of this is that +;;; iteration variables can be flagged as unused by the compiler, e.g. I in +;;; (loop for i from 1 to 10 do (print t)), since we will tell it when a usage +;;; of it is "invisible" or "not to be considered". +;;;We implicitly assume that a setq does not count as a reference. That is, the +;;; kind of form generated for the above loop construct to step I, simplified, is +;;; `(SETQ I ,(HIDE-VARIABLE-REFERENCES T 'I '(1+ I))). +;;;Certain cases require that the "invisibility" of the reference be conditional upon +;;; something. This occurs in cases of "named" variables (the USING clause). For instance, +;;; we want IDX in (LOOP FOR E BEING THE VECTOR-ELEMENTS OF V USING (INDEX IDX) ...) +;;; to be "invisible" when it is stepped, so that the user gets informed if IDX is +;;; not referenced. However, if no USING clause is present, we definitely do not +;;; want to be informed that some random gensym is not used. +;;;It is easier for the caller to do this conditionally by passing a flag (which +;;; happens to be the second value of NAMED-VARIABLE, q.v.) to this function than +;;; for all callers to contain the conditional invisibility construction. +(defun hide-variable-reference (really-hide variable form) + (declare #-Genera (ignore really-hide variable)) + #+Genera (if (and really-hide variable (atom variable)) ;Punt on destructuring patterns + `(compiler:invisible-references (,variable) ,form) + form) + #-Genera form) + + +;;;; List Collection Macrology + + +(defmacro with-loop-list-collection-head ((head-var tail-var &optional user-head-var) + &body body) + ;; TI? Exploder? + #+LISPM (let ((head-place (or user-head-var head-var))) + `(let* ((,head-place nil) + (,tail-var + ,(hide-variable-reference + user-head-var user-head-var + `(progn #+Genera (scl:locf ,head-place) + #-Genera (system:variable-location ,head-place))))) + ,@body)) + #-LISPM (let ((l (and user-head-var (list (list user-head-var nil))))) + #+CLOE `(sys::with-stack-list* (,head-var nil nil) + (let ((,tail-var ,head-var) ,@l) + ,@body)) + #-CLOE `(let* ((,head-var (list nil)) (,tail-var ,head-var) ,@l) + ,@body))) + + +(defmacro loop-collect-rplacd (&environment env + (head-var tail-var &optional user-head-var) form) + (declare + #+LISPM (ignore head-var user-head-var) ;use locatives, unconditionally update through the tail. + ) + (setq form (macroexpand form env)) + (flet ((cdr-wrap (form n) + (declare (fixnum n)) + (do () ((<= n 4) (setq form `(,(case n + (1 'cdr) + (2 'cddr) + (3 'cdddr) + (4 'cddddr)) + ,form))) + (setq form `(cddddr ,form) n (- n 4))))) + (let ((tail-form form) (ncdrs nil)) + ;;Determine if the form being constructed is a list of known length. + (when (consp form) + (cond ((eq (car form) 'list) + (setq ncdrs (1- (length (cdr form)))) + ;; Because the last element is going to be RPLACDed, + ;; we don't want the cdr-coded implementations to use + ;; cdr-nil at the end (which would just force copying + ;; the whole list again). + #+LISPM (setq tail-form `(list* ,@(cdr form) nil))) + ((member (car form) '(list* cons)) + (when (and (cddr form) (member (car (last form)) '(nil 'nil))) + (setq ncdrs (- (length (cdr form)) 2)))))) + (let ((answer + (cond ((null ncdrs) + `(when (setf (cdr ,tail-var) ,tail-form) + (setq ,tail-var (last (cdr ,tail-var))))) + ((< ncdrs 0) (return-from loop-collect-rplacd nil)) + ((= ncdrs 0) + ;; Here we have a choice of two idioms: + ;; (rplacd tail (setq tail tail-form)) + ;; (setq tail (setf (cdr tail) tail-form)). + ;;Genera and most others I have seen do better with the former. + `(rplacd ,tail-var (setq ,tail-var ,tail-form))) + (t `(setq ,tail-var ,(cdr-wrap `(setf (cdr ,tail-var) ,tail-form) + ncdrs)))))) + ;;If not using locatives or something similar to update the user's + ;; head variable, we've got to set it... It's harmless to repeatedly set it + ;; unconditionally, and probably faster than checking. + #-LISPM (when user-head-var + (setq answer `(progn ,answer (setq ,user-head-var (cdr ,head-var))))) + answer)))) + + +(defmacro loop-collect-answer (head-var &optional user-head-var) + (or user-head-var + (progn + ;;If we use locatives to get tail-updating to update the head var, + ;; then the head var itself contains the answer. Otherwise we + ;; have to cdr it. + #+LISPM head-var + #-LISPM `(cdr ,head-var)))) + + +;;;; Maximization Technology + + +#| +The basic idea of all this minimax randomness here is that we have to +have constructed all uses of maximize and minimize to a particular +"destination" before we can decide how to code them. The goal is to not +have to have any kinds of flags, by knowing both that (1) the type is +something which we can provide an initial minimum or maximum value for +and (2) know that a MAXIMIZE and MINIMIZE are not being combined. + +SO, we have a datastructure which we annotate with all sorts of things, +incrementally updating it as we generate loop body code, and then use +a wrapper and internal macros to do the coding when the loop has been +constructed. +|# + + +(defstruct (loop-minimax + #+ecls (:type vector) + (:constructor make-loop-minimax-internal) + #+nil (:copier nil) + #+nil (:predicate nil)) + answer-variable + type + temp-variable + flag-variable + operations + infinity-data) + + +(defvar *loop-minimax-type-infinities-alist* + ;; This is the sort of value this should take on for a Lisp that has + ;; "eminently usable" infinities. n.b. there are neither constants nor + ;; printed representations for infinities defined by CL. + ;; This grotesque read-from-string below is to help implementations + ;; which croak on the infinity character when it appears in a token, even + ;; conditionalized out. +; #+Genera +; '#.(read-from-string +; "((fixnum most-positive-fixnum most-negative-fixnum) +; (short-float +1s -1s) +; (single-float +1f -1f) +; (double-float +1d -1d) +; (long-float +1l -1l))") + ;;This is how the alist should look for a lisp that has no infinities. In + ;; that case, MOST-POSITIVE-x-FLOAT really IS the most positive. + #+(or CLOE-Runtime Minima) + '((fixnum most-positive-fixnum most-negative-fixnum) + (short-float most-positive-short-float most-negative-short-float) + (single-float most-positive-single-float most-negative-single-float) + (double-float most-positive-double-float most-negative-double-float) + (long-float most-positive-long-float most-negative-long-float)) + ;; CMUCL has infinities so let's use them. + #+CMU + '((fixnum most-positive-fixnum most-negative-fixnum) + (short-float ext:single-float-positive-infinity ext:single-float-negative-infinity) + (single-float ext:single-float-positive-infinity ext:single-float-negative-infinity) + (double-float ext:double-float-positive-infinity ext:double-float-negative-infinity) + (long-float ext:long-float-positive-infinity ext:long-float-negative-infinity)) + ;; If we don't know, then we cannot provide "infinite" initial values for any of the + ;; types but FIXNUM: + #-(or Genera CLOE-Runtime Minima CMU) + '((fixnum most-positive-fixnum most-negative-fixnum)) + ) + + +(defun make-loop-minimax (answer-variable type) + (let ((infinity-data (cdr (assoc type *loop-minimax-type-infinities-alist* :test #'subtypep)))) + (make-loop-minimax-internal + :answer-variable answer-variable + :type type + :temp-variable (loop-gentemp 'loop-maxmin-temp-) + :flag-variable (and (not infinity-data) (loop-gentemp 'loop-maxmin-flag-)) + :operations nil + :infinity-data infinity-data))) + + +(defun loop-note-minimax-operation (operation minimax) + (pushnew (the symbol operation) (loop-minimax-operations minimax)) + (when (and (cdr (loop-minimax-operations minimax)) + (not (loop-minimax-flag-variable minimax))) + (setf (loop-minimax-flag-variable minimax) (loop-gentemp 'loop-maxmin-flag-))) + operation) + + +(defmacro with-minimax-value (lm &body body) + (let ((init (loop-typed-init (loop-minimax-type lm))) + (which (car (loop-minimax-operations lm))) + (infinity-data (loop-minimax-infinity-data lm)) + (answer-var (loop-minimax-answer-variable lm)) + (temp-var (loop-minimax-temp-variable lm)) + (flag-var (loop-minimax-flag-variable lm)) + (type (loop-minimax-type lm))) + (if flag-var + `(let ((,answer-var ,init) (,temp-var ,init) (,flag-var nil)) + (declare (type ,type ,answer-var ,temp-var)) + ,@body) + `(let ((,answer-var ,(if (eq which 'min) (first infinity-data) (second infinity-data))) + (,temp-var ,init)) + (declare (type ,type ,answer-var ,temp-var)) + ,@body)))) + + +(defmacro loop-accumulate-minimax-value (lm operation form) + (let* ((answer-var (loop-minimax-answer-variable lm)) + (temp-var (loop-minimax-temp-variable lm)) + (flag-var (loop-minimax-flag-variable lm)) + (test + (hide-variable-reference + t (loop-minimax-answer-variable lm) + `(,(ecase operation + (min '<) + (max '>)) + ,temp-var ,answer-var)))) + `(progn + (setq ,temp-var ,form) + (when ,(if flag-var `(or (not ,flag-var) ,test) test) + (setq ,@(and flag-var `(,flag-var t)) + ,answer-var ,temp-var))))) + + + +;;;; Loop Keyword Tables + + +#| +LOOP keyword tables are hash tables string keys and a test of EQUAL. + +The actual descriptive/dispatch structure used by LOOP is called a "loop +universe" contains a few tables and parameterizations. The basic idea is +that we can provide a non-extensible ANSI-compatible loop environment, +an extensible ANSI-superset loop environment, and (for such environments +as CLOE) one which is "sufficiently close" to the old Genera-vintage +LOOP for use by old user programs without requiring all of the old LOOP +code to be loaded. +|# + + +;;;; Token Hackery + + +;;;Compare two "tokens". The first is the frob out of *LOOP-SOURCE-CODE*, +;;; the second a symbol to check against. +(defun loop-tequal (x1 x2) + (and (symbolp x1) (string= x1 x2))) + + +(defun loop-tassoc (kwd alist) + (and (symbolp kwd) (assoc kwd alist :test #'string=))) + + +(defun loop-tmember (kwd list) + (and (symbolp kwd) (member kwd list :test #'string=))) + + +(defun loop-lookup-keyword (loop-token table) + (and (symbolp loop-token) + (values (gethash (symbol-name loop-token) table)))) + + +(defmacro loop-store-table-data (symbol table datum) + `(setf (gethash (symbol-name ,symbol) ,table) ,datum)) + + +(defstruct (loop-universe + #+ecls (:type vector) + #-ecls (:print-function print-loop-universe) + #+nil (:copier nil) + #+nil (:predicate nil)) + keywords ;hash table, value = (fn-name . extra-data). + iteration-keywords ;hash table, value = (fn-name . extra-data). + for-keywords ;hash table, value = (fn-name . extra-data). + path-keywords ;hash table, value = (fn-name . extra-data). + type-symbols ;hash table of type SYMBOLS, test EQ, value = CL type specifier. + type-keywords ;hash table of type STRINGS, test EQUAL, value = CL type spec. + ansi ;NIL, T, or :EXTENDED. + implicit-for-required ;see loop-hack-iteration + ) + + +#-ecls +(defun print-loop-universe (u stream level) + (declare (ignore level)) + (let ((str (case (loop-universe-ansi u) + ((nil) "Non-ANSI") + ((t) "ANSI") + (:extended "Extended-ANSI") + (t (loop-universe-ansi u))))) + ;;Cloe could be done with the above except for bootstrap lossage... + #+CLOE + (format stream "#<~S ~A ~X>" (type-of u) str (sys::address-of u)) + #+Genera ; This is reallly the ANSI definition. + (print-unreadable-object (u stream :type t :identity t) + (princ str stream)) + #-(or Genera CLOE) + (format stream "#<~S ~A>" (type-of u) str) + )) + + +;;;This is the "current" loop context in use when we are expanding a +;;;loop. It gets bound on each invocation of LOOP. +(defvar *loop-universe*) + + +(defun make-standard-loop-universe (&key keywords for-keywords iteration-keywords path-keywords + type-keywords type-symbols ansi) + #-(and CLOE Source-Bootstrap ecls) (check-type ansi (member nil t :extended)) + (flet ((maketable (entries) + (let* ((size (length entries)) + (ht (make-hash-table :size (if (< size 10) 10 size) :test #'equal))) + (dolist (x entries) (setf (gethash (symbol-name (car x)) ht) (cadr x))) + ht))) + (make-loop-universe + :keywords (maketable keywords) + :for-keywords (maketable for-keywords) + :iteration-keywords (maketable iteration-keywords) + :path-keywords (maketable path-keywords) + :ansi ansi + :implicit-for-required (not (null ansi)) + :type-keywords (maketable type-keywords) + :type-symbols (let* ((size (length type-symbols)) + (ht (make-hash-table :size (if (< size 10) 10 size) :test #'eq))) + (dolist (x type-symbols) + (if (atom x) (setf (gethash x ht) x) (setf (gethash (car x) ht) (cadr x)))) + ht)))) + + +;;;; Setq Hackery + + +(defvar *loop-destructuring-hooks* + nil + "If not NIL, this must be a list of two things: +a LET-like macro, and a SETQ-like macro, which perform LOOP-style destructuring.") + + +(defun loop-make-psetq (frobs) + (and frobs + (loop-make-desetq + (list (car frobs) + (if (null (cddr frobs)) (cadr frobs) + `(prog1 ,(cadr frobs) + ,(loop-make-psetq (cddr frobs)))))))) + + +(defun loop-make-desetq (var-val-pairs) + (if (null var-val-pairs) + nil + (cons (if *loop-destructuring-hooks* + (cadr *loop-destructuring-hooks*) + 'loop-really-desetq) + var-val-pairs))) + + +(defvar *loop-desetq-temporary* + (make-symbol "LOOP-DESETQ-TEMP")) + + +(defmacro loop-really-desetq (&environment env &rest var-val-pairs) + (labels ((find-non-null (var) + ;; see if there's any non-null thing here + ;; recurse if the list element is itself a list + (do ((tail var)) ((not (consp tail)) tail) + (when (find-non-null (pop tail)) (return t)))) + (loop-desetq-internal (var val &optional temp) + ;; returns a list of actions to be performed + (typecase var + (null + (when (consp val) + ;; don't lose possible side-effects + (if (eq (car val) 'prog1) + ;; these can come from psetq or desetq below. + ;; throw away the value, keep the side-effects. + ;;Special case is for handling an expanded POP. + (mapcan #'(lambda (x) + (and (consp x) + (or (not (eq (car x) 'car)) + (not (symbolp (cadr x))) + (not (symbolp (setq x (macroexpand x env))))) + (cons x nil))) + (cdr val)) + `(,val)))) + (cons + (let* ((car (car var)) + (cdr (cdr var)) + (car-non-null (find-non-null car)) + (cdr-non-null (find-non-null cdr))) + (when (or car-non-null cdr-non-null) + (if cdr-non-null + (let* ((temp-p temp) + (temp (or temp *loop-desetq-temporary*)) + (body #+LOOP-Prefer-POP `(,@(loop-desetq-internal + car + `(prog1 (car ,temp) + (setq ,temp (cdr ,temp)))) + ,@(loop-desetq-internal cdr temp temp)) + #-LOOP-Prefer-POP `(,@(loop-desetq-internal car `(car ,temp)) + (setq ,temp (cdr ,temp)) + ,@(loop-desetq-internal cdr temp temp)))) + (if temp-p + `(,@(unless (eq temp val) + `((setq ,temp ,val))) + ,@body) + `((let ((,temp ,val)) + ,@body)))) + ;; no cdring to do + (loop-desetq-internal car `(car ,val) temp))))) + (otherwise + (unless (eq var val) + `((setq ,var ,val))))))) + (do ((actions)) + ((null var-val-pairs) + (if (null (cdr actions)) (car actions) `(progn ,@(nreverse actions)))) + (setq actions (nreconc;revappend + (loop-desetq-internal (pop var-val-pairs) (pop var-val-pairs)) + actions))))) + + +;;;; LOOP-local variables + +;;;This is the "current" pointer into the LOOP source code. +(defvar *loop-source-code*) + + +;;;This is the pointer to the original, for things like NAMED that +;;;insist on being in a particular position +(defvar *loop-original-source-code*) + + +;;;This is *loop-source-code* as of the "last" clause. It is used +;;;primarily for generating error messages (see loop-error, loop-warn). +(defvar *loop-source-context*) + + +;;;List of names for the LOOP, supplied by the NAMED clause. +(defvar *loop-names*) + +;;;The macroexpansion environment given to the macro. +(defvar *loop-macro-environment*) + +;;;This holds variable names specified with the USING clause. +;;; See LOOP-NAMED-VARIABLE. +(defvar *loop-named-variables*) + +;;; LETlist-like list being accumulated for one group of parallel bindings. +(defvar *loop-variables*) + +;;;List of declarations being accumulated in parallel with +;;;*loop-variables*. +(defvar *loop-declarations*) + +;;;Used by LOOP for destructuring binding, if it is doing that itself. +;;; See loop-make-variable. +(defvar *loop-desetq-crocks*) + +;;; List of wrapping forms, innermost first, which go immediately inside +;;; the current set of parallel bindings being accumulated in +;;; *loop-variables*. The wrappers are appended onto a body. E.g., +;;; this list could conceivably has as its value ((with-open-file (g0001 +;;; g0002 ...))), with g0002 being one of the bindings in +;;; *loop-variables* (this is why the wrappers go inside of the variable +;;; bindings). +(defvar *loop-wrappers*) + +;;;This accumulates lists of previous values of *loop-variables* and the +;;;other lists above, for each new nesting of bindings. See +;;;loop-bind-block. +(defvar *loop-bind-stack*) + +;;;This is a LOOP-global variable for the (obsolete) NODECLARE clause +;;;which inhibits LOOP from actually outputting a type declaration for +;;;an iteration (or any) variable. +(defvar *loop-nodeclare*) + +;;;This is simply a list of LOOP iteration variables, used for checking +;;;for duplications. +(defvar *loop-iteration-variables*) + + +;;;List of prologue forms of the loop, accumulated in reverse order. +(defvar *loop-prologue*) + +(defvar *loop-before-loop*) +(defvar *loop-body*) +(defvar *loop-after-body*) + +;;;This is T if we have emitted any body code, so that iteration driving +;;;clauses can be disallowed. This is not strictly the same as +;;;checking *loop-body*, because we permit some clauses such as RETURN +;;;to not be considered "real" body (so as to permit the user to "code" +;;;an abnormal return value "in loop"). +(defvar *loop-emitted-body*) + + +;;;List of epilogue forms (supplied by FINALLY generally), accumulated +;;; in reverse order. +(defvar *loop-epilogue*) + +;;;List of epilogue forms which are supplied after the above "user" +;;;epilogue. "normal" termination return values are provide by putting +;;;the return form in here. Normally this is done using +;;;loop-emit-final-value, q.v. +(defvar *loop-after-epilogue*) + +;;;The "culprit" responsible for supplying a final value from the loop. +;;;This is so loop-emit-final-value can moan about multiple return +;;;values being supplied. +(defvar *loop-final-value-culprit*) + +;;;If not NIL, we are in some branch of a conditional. Some clauses may +;;;be disallowed. +(defvar *loop-inside-conditional*) + +;;;If not NIL, this is a temporary bound around the loop for holding the +;;;temporary value for "it" in things like "when (f) collect it". It +;;;may be used as a supertemporary by some other things. +(defvar *loop-when-it-variable*) + +;;;Sometimes we decide we need to fold together parts of the loop, but +;;;some part of the generated iteration code is different for the first +;;;and remaining iterations. This variable will be the temporary which +;;;is the flag used in the loop to tell whether we are in the first or +;;;remaining iterations. +(defvar *loop-never-stepped-variable*) + +;;;List of all the value-accumulation descriptor structures in the loop. +;;; See loop-get-collection-info. +(defvar *loop-collection-cruft*) ; for multiple COLLECTs (etc) + +;;;Flag indicating value accumulation without into +(defvar *loop-collection-no-into*) + + + + + +;;;; Code Analysis Stuff + + +(defun loop-constant-fold-if-possible (form &optional expected-type) + #+Genera (declare (values new-form constantp constant-value)) + (let ((new-form form) (constantp nil) (constant-value nil)) + #+Genera (setq new-form (compiler:optimize-form form *loop-macro-environment* + :repeat t + :do-macro-expansion t + :do-named-constants t + :do-inline-forms t + :do-optimizers t + :do-constant-folding t + :do-function-args t) + constantp (constantp new-form *loop-macro-environment*) + constant-value (and constantp (lt:evaluate-constant new-form *loop-macro-environment*))) + #-Genera (when (setq constantp (constantp new-form)) + (setq constant-value (eval new-form))) + (when (and constantp expected-type) + (unless (typep constant-value expected-type) + (loop-warn "The form ~S evaluated to ~S, which was not of the anticipated type ~S." + form constant-value expected-type) + (setq constantp nil constant-value nil))) + (values new-form constantp constant-value))) + + +(defun loop-constantp (form) + #+Genera (constantp form *loop-macro-environment*) + #-Genera (constantp form)) + + +;;;; LOOP Iteration Optimization + +(defvar *loop-duplicate-code* + nil) + + +(defvar *loop-iteration-flag-variable* + (make-symbol "LOOP-NOT-FIRST-TIME")) + + +(defun loop-code-duplication-threshold (env) + (multiple-value-bind (speed space) (loop-optimization-quantities env) + (+ 40 (* (- speed space) 10)))) + + +(defmacro loop-body (&environment env + prologue + before-loop + main-body + after-loop + epilogue + &aux rbefore rafter flagvar) + (unless (= (length before-loop) (length after-loop)) + (error "LOOP-BODY called with non-synched before- and after-loop lists.")) + ;;All our work is done from these copies, working backwards from the end: + (when (equal before-loop after-loop) + (setq main-body (append before-loop main-body) before-loop nil after-loop nil));accelerator + (setq rbefore (reverse before-loop) rafter (reverse after-loop)) + (labels ((psimp (l) + (let ((ans nil)) + (dolist (x l) + (when x + (push x ans) + (when (and (consp x) (member (car x) '(go return return-from))) + (return nil)))) + (nreverse ans))) + (pify (l) (if (null (cdr l)) (car l) `(progn ,@l))) + (makebody () + (let ((form `(tagbody + ,@(psimp (append prologue (nreverse rbefore))) + next-loop + ,@(psimp (append main-body (nreconc rafter `((go next-loop))))) + end-loop + ,@(psimp epilogue)))) + (if flagvar `(let ((,flagvar nil)) ,form) form)))) + (when (or *loop-duplicate-code* (not rbefore)) + (return-from loop-body (makebody))) + ;; This outer loop iterates once for each not-first-time flag test generated + ;; plus once more for the forms that don't need a flag test + (do ((threshold (loop-code-duplication-threshold env))) (nil) + (declare (fixnum threshold)) + ;; Go backwards from the ends of before-loop and after-loop merging all the equivalent + ;; forms into the body. + (do () ((or (null rbefore) (not (equal (car rbefore) (car rafter))))) + (push (pop rbefore) main-body) + (pop rafter)) + (unless rbefore (return (makebody))) + ;; The first forms in rbefore & rafter (which are the chronologically + ;; last forms in the list) differ, therefore they cannot be moved + ;; into the main body. If everything that chronologically precedes + ;; them either differs or is equal but is okay to duplicate, we can + ;; just put all of rbefore in the prologue and all of rafter after + ;; the body. Otherwise, there is something that is not okay to + ;; duplicate, so it and everything chronologically after it in + ;; rbefore and rafter must go into the body, with a flag test to + ;; distinguish the first time around the loop from later times. + ;; What chronologically precedes the non-duplicatable form will + ;; be handled the next time around the outer loop. + (do ((bb rbefore (cdr bb)) (aa rafter (cdr aa)) (lastdiff nil) (count 0) (inc nil)) + ((null bb) (return-from loop-body (makebody))) ;Did it. + (cond ((not (equal (car bb) (car aa))) (setq lastdiff bb count 0)) + ((or (not (setq inc (estimate-code-size (car bb) env))) + (> (incf count inc) threshold)) + ;; Ok, we have found a non-duplicatable piece of code. Everything + ;; chronologically after it must be in the central body. + ;; Everything chronologically at and after lastdiff goes into the + ;; central body under a flag test. + (let ((then nil) (else nil)) + (do () (nil) + (push (pop rbefore) else) + (push (pop rafter) then) + (when (eq rbefore (cdr lastdiff)) (return))) + (unless flagvar + (push `(setq ,(setq flagvar *loop-iteration-flag-variable*) t) else)) + (push `(if ,flagvar ,(pify (psimp then)) ,(pify (psimp else))) + main-body)) + ;; Everything chronologically before lastdiff until the non-duplicatable form (car bb) + ;; is the same in rbefore and rafter so just copy it into the body + (do () (nil) + (pop rafter) + (push (pop rbefore) main-body) + (when (eq rbefore (cdr bb)) (return))) + (return))))))) + + + +(defun duplicatable-code-p (expr env) + (if (null expr) 0 + (let ((ans (estimate-code-size expr env))) + (declare (fixnum ans)) + ;; Use (DECLARATION-INFORMATION 'OPTIMIZE ENV) here to get an alist of + ;; optimize quantities back to help quantify how much code we are willing to + ;; duplicate. + ans))) + + +(defvar *special-code-sizes* + '((return 0) (progn 0) + (null 1) (not 1) (eq 1) (car 1) (cdr 1) + (when 1) (unless 1) (if 1) + (caar 2) (cadr 2) (cdar 2) (cddr 2) + (caaar 3) (caadr 3) (cadar 3) (caddr 3) (cdaar 3) (cdadr 3) (cddar 3) (cdddr 3) + (caaaar 4) (caaadr 4) (caadar 4) (caaddr 4) + (cadaar 4) (cadadr 4) (caddar 4) (cadddr 4) + (cdaaar 4) (cdaadr 4) (cdadar 4) (cdaddr 4) + (cddaar 4) (cddadr 4) (cdddar 4) (cddddr 4))) + + +(defvar *estimate-code-size-punt* + '(block + do do* dolist + flet + labels lambda let let* locally + macrolet multiple-value-bind + prog prog* + symbol-macrolet + tagbody + unwind-protect + with-open-file)) + + +(defun destructuring-size (x) + (do ((x x (cdr x)) (n 0 (+ (destructuring-size (car x)) n))) + ((atom x) (+ n (if (null x) 0 1))))) + + +(defun estimate-code-size (x env) + (catch 'estimate-code-size + (estimate-code-size-1 x env))) + + +(defun estimate-code-size-1 (x env) + (flet ((list-size (l) + (let ((n 0)) + (declare (fixnum n)) + (dolist (x l n) (incf n (estimate-code-size-1 x env)))))) + ;; ???? (declare (function list-size (list) fixnum)) + (cond ((constantp x #+Genera env) 1) + ((symbolp x) (multiple-value-bind (new-form expanded-p) (macroexpand-1 x env) + (if expanded-p (estimate-code-size-1 new-form env) 1))) + ((atom x) 1) ;??? self-evaluating??? + ((symbolp (car x)) + (let ((fn (car x)) (tem nil) (n 0)) + (declare (symbol fn) (fixnum n)) + (macrolet ((f (overhead &optional (args nil args-p)) + `(the fixnum (+ (the fixnum ,overhead) + (the fixnum (list-size ,(if args-p args '(cdr x)))))))) + (cond ((setq tem (get fn 'estimate-code-size)) + (typecase tem + (fixnum (f tem)) + (t (funcall tem x env)))) + ((setq tem (assoc fn *special-code-sizes*)) (f (second tem))) + #+Genera + ((eq fn 'compiler:invisible-references) (list-size (cddr x))) + ((eq fn 'cond) + (dolist (clause (cdr x) n) (incf n (list-size clause)) (incf n))) + ((eq fn 'desetq) + (do ((l (cdr x) (cdr l))) ((null l) n) + (setq n (+ n (destructuring-size (car l)) (estimate-code-size-1 (cadr l) env))))) + ((member fn '(setq psetq)) + (do ((l (cdr x) (cdr l))) ((null l) n) + (setq n (+ n (estimate-code-size-1 (cadr l) env) 1)))) + ((eq fn 'go) 1) + ((eq fn 'function) + ;;This skirts the issue of implementationally-defined lambda macros + ;; by recognizing CL function names and nothing else. + (if (or (symbolp (cadr x)) + (and (consp (cadr x)) (eq (caadr x) 'setf))) + 1 + (throw 'duplicatable-code-p nil))) + ((eq fn 'multiple-value-setq) (f (length (second x)) (cddr x))) + ((eq fn 'return-from) (1+ (estimate-code-size-1 (third x) env))) + ((or (special-operator-p fn) (member fn *estimate-code-size-punt*)) + (throw 'estimate-code-size nil)) + (t (multiple-value-bind (new-form expanded-p) (macroexpand-1 x env) + (if expanded-p + (estimate-code-size-1 new-form env) + (f 3)))))))) + (t (throw 'estimate-code-size nil))))) + + +;;;; Loop Errors + + +(defun loop-context () + (do ((l *loop-source-context* (cdr l)) (new nil (cons (car l) new))) + ((eq l (cdr *loop-source-code*)) (nreverse new)))) + + +(defun loop-error (format-string &rest format-args) + #+(or Genera CLOE) (declare (dbg:error-reporter)) + #+Genera (setq format-args (copy-list format-args)) ;Don't ask. + (error 'program-error :format-control "~?~%Current LOOP context:~{ ~S~}." + :format-arguments (list format-string format-args (loop-context)))) + + +(defun loop-warn (format-string &rest format-args) + (warn "~?~%Current LOOP context:~{ ~S~}." format-string format-args (loop-context))) + + +(defun loop-check-data-type (specified-type required-type + &optional (default-type required-type)) + (if (null specified-type) + default-type + (multiple-value-bind (a b) (subtypep specified-type required-type) + (cond ((not b) + (loop-warn "LOOP couldn't verify that ~S is a subtype of the required type ~S." + specified-type required-type)) + ((not a) + (loop-error "Specified data type ~S is not a subtype of ~S." + specified-type required-type))) + specified-type))) + + +;;;INTERFACE: Traditional, ANSI, Lucid. +(defmacro loop-finish () + "Causes the iteration to terminate \"normally\", the same as implicit +termination by an iteration driving clause, or by use of WHILE or +UNTIL -- the epilogue code (if any) will be run, and any implicitly +collected result will be returned as the value of the LOOP." + '(go end-loop)) + + + + +(defun loop-translate (*loop-source-code* *loop-macro-environment* *loop-universe*) + (let ((*loop-original-source-code* *loop-source-code*) + (*loop-source-context* nil) + (*loop-iteration-variables* nil) + (*loop-variables* nil) + (*loop-nodeclare* nil) + (*loop-named-variables* nil) + (*loop-declarations* nil) + (*loop-desetq-crocks* nil) + (*loop-bind-stack* nil) + (*loop-prologue* nil) + (*loop-wrappers* nil) + (*loop-before-loop* nil) + (*loop-body* nil) + (*loop-emitted-body* nil) + (*loop-after-body* nil) + (*loop-epilogue* nil) + (*loop-after-epilogue* nil) + (*loop-final-value-culprit* nil) + (*loop-inside-conditional* nil) + (*loop-when-it-variable* nil) + (*loop-never-stepped-variable* nil) + (*loop-names* nil) + (*loop-collection-no-into* nil) + (*loop-collection-cruft* nil)) + (loop-iteration-driver) + (loop-bind-block) + (let ((answer `(loop-body + ,(nreverse *loop-prologue*) + ,(nreverse *loop-before-loop*) + ,(nreverse *loop-body*) + ,(nreverse *loop-after-body*) + ,(nreconc *loop-epilogue* (nreverse *loop-after-epilogue*))))) +; (do () (nil) +; (setq answer `(block ,(pop *loop-names*) ,answer)) +; (unless *loop-names* (return nil))) +; (setq answer `(block ,(car *loop-names*) ,answer)) + (dolist (entry *loop-bind-stack*) + (let ((vars (first entry)) + (dcls (second entry)) + (crocks (third entry)) + (wrappers (fourth entry))) + (dolist (w wrappers) + (setq answer (append w (list answer)))) + (when (or vars dcls crocks) + (let ((forms (list answer))) + ;;(when crocks (push crocks forms)) + (when dcls (push `(declare ,@dcls) forms)) + (setq answer `(,(cond ((not vars) 'locally) + (*loop-destructuring-hooks* (first *loop-destructuring-hooks*)) + (t 'let)) + ,vars + ,@(if crocks + `((destructuring-bind ,@crocks + ,@forms)) + forms))))))) + (setq answer `(block ,(car *loop-names*) ,answer)) + answer))) + + +(defun loop-iteration-driver () + (do () ((null *loop-source-code*)) + (let ((keyword (car *loop-source-code*)) (tem nil)) + (cond ((not (symbolp keyword)) + (loop-error "~S found where LOOP keyword expected." keyword)) + (t (setq *loop-source-context* *loop-source-code*) + (loop-pop-source) + (cond ((setq tem (loop-lookup-keyword keyword (loop-universe-keywords *loop-universe*))) + ;;It's a "miscellaneous" toplevel LOOP keyword (do, collect, named, etc.) + (apply (symbol-function (first tem)) (rest tem))) + ((setq tem (loop-lookup-keyword keyword (loop-universe-iteration-keywords *loop-universe*))) + (loop-hack-iteration tem)) + ((loop-tmember keyword '(and else)) + ;; Alternative is to ignore it, ie let it go around to the next keyword... + (loop-error "Secondary clause misplaced at top level in LOOP macro: ~S ~S ~S ..." + keyword (car *loop-source-code*) (cadr *loop-source-code*))) + (t (loop-error "~S is an unknown keyword in LOOP macro." keyword)))))))) + + + +(defun loop-pop-source () + (if *loop-source-code* + (pop *loop-source-code*) + (loop-error "LOOP source code ran out when another token was expected."))) + + +(defun loop-get-progn () + (do ((forms (list (loop-pop-source)) (cons (loop-pop-source) forms)) + (nextform (car *loop-source-code*) (car *loop-source-code*))) + ((atom nextform) + (if (null (cdr forms)) (car forms) (cons 'progn (nreverse forms)))))) + + +(defun loop-get-form () + (if *loop-source-code* + (loop-pop-source) + (loop-error "LOOP code ran out where a form was expected."))) + + +(defun loop-construct-return (form) + `(return-from ,(car *loop-names*) ,form)) + + +(defun loop-pseudo-body (form) + (cond ((or *loop-emitted-body* *loop-inside-conditional*) (push form *loop-body*)) + (t (push form *loop-before-loop*) (push form *loop-after-body*)))) + +(defun loop-emit-body (form) + (setq *loop-emitted-body* t) + (loop-pseudo-body form)) + +(defun loop-emit-final-value (form) + (push (loop-construct-return form) *loop-after-epilogue*) + (when *loop-final-value-culprit* + (if *loop-collection-no-into* + (error 'program-error :format-control "LOOP clause is providing a value for the iteration,~@ + however one was already established by a ~S clause." + :format-arguments (list *loop-final-value-culprit*)) + (loop-warn "LOOP clause is providing a value for the iteration,~@ + however one was already established by a ~S clause." + *loop-final-value-culprit*))) + (setq *loop-final-value-culprit* (car *loop-source-context*))) + + +(defun loop-disallow-conditional (&optional kwd) + #+(or Genera CLOE) (declare (dbg:error-reporter)) + (when *loop-inside-conditional* + (loop-error "~:[This LOOP~;The LOOP ~:*~S~] clause is not permitted inside a conditional." kwd))) + + +;;;; Loop Types + + +(defun loop-typed-init (data-type) + (when (and data-type (subtypep data-type 'number)) + (if (or (subtypep data-type 'float) (subtypep data-type '(complex float))) + (coerce 0 data-type) + 0))) + + +(defun loop-optional-type (&optional variable) + ;;No variable specified implies that no destructuring is permissible. + (and *loop-source-code* ;Don't get confused by NILs... + (let ((z (car *loop-source-code*))) + (cond ((loop-tequal z 'of-type) + ;;This is the syntactically unambigous form in that the form of the + ;; type specifier does not matter. Also, it is assumed that the + ;; type specifier is unambiguously, and without need of translation, + ;; a common lisp type specifier or pattern (matching the variable) thereof. + (loop-pop-source) + (loop-pop-source)) + + ((symbolp z) + ;;This is the (sort of) "old" syntax, even though we didn't used to support all of + ;; these type symbols. + (let ((type-spec (or (gethash z (loop-universe-type-symbols *loop-universe*)) + (gethash (symbol-name z) (loop-universe-type-keywords *loop-universe*))))) + (when type-spec + (loop-pop-source) + type-spec))) + (t + ;;This is our sort-of old syntax. But this is only valid for when we are destructuring, + ;; so we will be compulsive (should we really be?) and require that we in fact be + ;; doing variable destructuring here. We must translate the old keyword pattern typespec + ;; into a fully-specified pattern of real type specifiers here. + (if (consp variable) + (unless (consp z) + (loop-error + "~S found where a LOOP keyword, LOOP type keyword, or LOOP type pattern expected." + z)) + (loop-error "~S found where a LOOP keyword or LOOP type keyword expected." z)) + (loop-pop-source) + (labels ((translate (k v) + (cond ((null k) nil) + ((atom k) + (replicate + (or (gethash k (loop-universe-type-symbols *loop-universe*)) + (gethash (symbol-name k) (loop-universe-type-keywords *loop-universe*)) + (loop-error + "Destructuring type pattern ~S contains unrecognized type keyword ~S." + z k)) + v)) + ((atom v) + (loop-error + "Destructuring type pattern ~S doesn't match variable pattern ~S." + z variable)) + (t (cons (translate (car k) (car v)) (translate (cdr k) (cdr v)))))) + (replicate (typ v) + (if (atom v) typ (cons (replicate typ (car v)) (replicate typ (cdr v)))))) + (translate z variable))))))) + + + +;;;; Loop Variables + + +(defun loop-bind-block () + (when (or *loop-variables* *loop-declarations* *loop-wrappers*) + (push (list (nreverse *loop-variables*) *loop-declarations* *loop-desetq-crocks* *loop-wrappers*) + *loop-bind-stack*) + (setq *loop-variables* nil + *loop-declarations* nil + *loop-desetq-crocks* nil + *loop-wrappers* nil))) + + +(defun loop-make-variable (name initialization dtype &optional iteration-variable-p) + (cond ((null name) + (cond ((not (null initialization)) + (push (list (setq name (loop-gentemp 'loop-ignore-)) + initialization) + *loop-variables*) + (push `(ignore ,name) *loop-declarations*)))) + ((atom name) + (cond (iteration-variable-p + (if (member name *loop-iteration-variables*) + (loop-error "Duplicated LOOP iteration variable ~S." name) + (push name *loop-iteration-variables*))) + ((assoc name *loop-variables*) + (loop-error "Duplicated variable ~S in LOOP parallel binding." name))) + (unless (symbolp name) + (loop-error "Bad variable ~S somewhere in LOOP." name)) + (loop-declare-variable name dtype) + ;; We use ASSOC on this list to check for duplications (above), + ;; so don't optimize out this list: + (push (list name (or initialization (loop-typed-init dtype))) + *loop-variables*)) + (initialization + (cond (*loop-destructuring-hooks* + (loop-declare-variable name dtype) + (push (list name initialization) *loop-variables*)) + (t (let ((newvar (loop-gentemp 'loop-destructure-))) + (push (list newvar initialization) *loop-variables*) + ;; *LOOP-DESETQ-CROCKS* gathered in reverse order. + (setq *loop-desetq-crocks* + (list* name newvar *loop-desetq-crocks*)) + #+ignore + (loop-make-variable name nil dtype iteration-variable-p))))) + (t (let ((tcar nil) (tcdr nil)) + (if (atom dtype) (setq tcar (setq tcdr dtype)) + (setq tcar (car dtype) tcdr (cdr dtype))) + (loop-make-variable (car name) nil tcar iteration-variable-p) + (loop-make-variable (cdr name) nil tcdr iteration-variable-p)))) + name) + + +(defun loop-make-iteration-variable (name initialization dtype) + (loop-make-variable name initialization dtype t)) + + +(defun loop-declare-variable (name dtype) + (cond ((or (null name) (null dtype) (eq dtype t)) nil) + ((symbolp name) + (unless (or (eq dtype t) (member (the symbol name) *loop-nodeclare*)) + (let ((dtype #-cmu dtype + #+cmu + (let ((init (loop-typed-init dtype))) + (if (typep init dtype) + dtype + `(or (member ,init) ,dtype))))) + (push `(type ,dtype ,name) *loop-declarations*)))) + ((consp name) + (cond ((consp dtype) + (loop-declare-variable (car name) (car dtype)) + (loop-declare-variable (cdr name) (cdr dtype))) + (t (loop-declare-variable (car name) dtype) + (loop-declare-variable (cdr name) dtype)))) + (t (error "Invalid LOOP variable passed in: ~S." name)))) + + +(defun loop-maybe-bind-form (form data-type) + (if (loop-constantp form) + form + (loop-make-variable (loop-gentemp 'loop-bind-) form data-type))) + + + +(defun loop-do-if (for negatep) + (let ((form (loop-get-form)) (*loop-inside-conditional* t) (it-p nil)) + (flet ((get-clause (for) + (do ((body nil)) (nil) + (let ((key (car *loop-source-code*)) (*loop-body* nil) data) + (cond ((not (symbolp key)) + (loop-error + "~S found where keyword expected getting LOOP clause after ~S." + key for)) + (t (setq *loop-source-context* *loop-source-code*) + (loop-pop-source) + (when (loop-tequal (car *loop-source-code*) 'it) + (setq *loop-source-code* + (cons (or it-p (setq it-p (loop-when-it-variable))) + (cdr *loop-source-code*)))) + (cond ((or (not (setq data (loop-lookup-keyword + key (loop-universe-keywords *loop-universe*)))) + (progn (apply (symbol-function (car data)) (cdr data)) + (null *loop-body*))) + (loop-error + "~S does not introduce a LOOP clause that can follow ~S." + key for)) + (t (setq body (nreconc *loop-body* body))))))) + (if (loop-tequal (car *loop-source-code*) :and) + (loop-pop-source) + (return (if (cdr body) `(progn ,@(nreverse body)) (car body))))))) + (let ((then (get-clause for)) + (else (when (loop-tequal (car *loop-source-code*) :else) + (loop-pop-source) + (list (get-clause :else))))) + (when (loop-tequal (car *loop-source-code*) :end) + (loop-pop-source)) + (when it-p (setq form `(setq ,it-p ,form))) + (loop-pseudo-body + `(if ,(if negatep `(not ,form) form) + ,then + ,@else)))))) + + +(defun loop-do-initially () + (loop-disallow-conditional :initially) + (push (loop-get-progn) *loop-prologue*)) + +(defun loop-do-finally () + (loop-disallow-conditional :finally) + (push (loop-get-progn) *loop-epilogue*)) + +(defun loop-do-do () + (loop-emit-body (loop-get-progn))) + +(defun loop-do-named () + (let ((name (loop-pop-source))) + (unless (symbolp name) + (loop-error "~S is an invalid name for your LOOP." name)) + (when (or *loop-before-loop* *loop-body* *loop-after-epilogue* *loop-inside-conditional*) + (loop-error "The NAMED ~S clause occurs too late." name)) + (when *loop-names* + (loop-error "You may only use one NAMED clause in your loop: NAMED ~S ... NAMED ~S." + (car *loop-names*) name)) + (setq *loop-names* (list name nil)))) + +(defun loop-do-return () + (loop-pseudo-body (loop-construct-return (loop-get-form)))) + + +;;;; Value Accumulation: List + + +(defstruct (loop-collector + #+ecls (:type vector) + #+nil (:copier nil) + #+nil (:predicate nil)) + name + class + (history nil) + (tempvars nil) + dtype + (data nil)) ;collector-specific data + + +(defun loop-get-collection-info (collector class default-type) + (unless (loop-tequal (car *loop-source-code*)'into) + (setq *loop-collection-no-into* t)) + (let ((form (loop-get-form)) + (dtype (and (not (loop-universe-ansi *loop-universe*)) (loop-optional-type))) + (name (when (loop-tequal (car *loop-source-code*) 'into) + (loop-pop-source) + (loop-pop-source)))) + (when (not (symbolp name)) + (loop-error "Value accumulation recipient name, ~S, is not a symbol." name)) + (unless dtype + (setq dtype (or (loop-optional-type) default-type))) + (let ((cruft (find (the symbol name) *loop-collection-cruft* + :key #'loop-collector-name))) + (cond ((not cruft) + (push (setq cruft (make-loop-collector + :name name :class class + :history (list collector) :dtype dtype)) + *loop-collection-cruft*)) + (t (unless (eq (loop-collector-class cruft) class) + (loop-error + "Incompatible kinds of LOOP value accumulation specified for collecting~@ + ~:[as the value of the LOOP~;~:*INTO ~S~]: ~S and ~S." + name (car (loop-collector-history cruft)) collector)) + (unless (equal dtype (loop-collector-dtype cruft)) + (loop-warn + "Unequal datatypes specified in different LOOP value accumulations~@ + into ~S: ~S and ~S." + name dtype (loop-collector-dtype cruft)) + (when (eq (loop-collector-dtype cruft) t) + (setf (loop-collector-dtype cruft) dtype))) + (push collector (loop-collector-history cruft)))) + (values cruft form)))) + + +(defun loop-list-collection (specifically) ;NCONC, LIST, or APPEND + (multiple-value-bind (lc form) (loop-get-collection-info specifically 'list 'list) + (let ((tempvars (loop-collector-tempvars lc))) + (unless tempvars + (setf (loop-collector-tempvars lc) + (setq tempvars (list* (loop-gentemp 'loop-list-head-) + (loop-gentemp 'loop-list-tail-) + (and (loop-collector-name lc) + (list (loop-collector-name lc)))))) + (push `(with-loop-list-collection-head ,tempvars) *loop-wrappers*) + (unless (loop-collector-name lc) + (loop-emit-final-value `(loop-collect-answer ,(car tempvars) ,@(cddr tempvars))))) + (ecase specifically + (list (setq form `(list ,form))) + (nconc nil) + (append (unless (and (consp form) (eq (car form) 'list)) + (setq form `(loop-copylist* ,form))))) + (loop-emit-body `(loop-collect-rplacd ,tempvars ,form))))) + + +;;;; Value Accumulation: max, min, sum, count. + + + +(defun loop-sum-collection (specifically required-type default-type) ;SUM, COUNT + (multiple-value-bind (lc form) + (loop-get-collection-info specifically 'sum default-type) + (loop-check-data-type (loop-collector-dtype lc) required-type) + (let ((tempvars (loop-collector-tempvars lc))) + (unless tempvars + (setf (loop-collector-tempvars lc) + (setq tempvars (list (loop-make-variable + (or (loop-collector-name lc) + (loop-gentemp 'loop-sum-)) + nil (loop-collector-dtype lc))))) + (unless (loop-collector-name lc) + (loop-emit-final-value (car (loop-collector-tempvars lc))))) + (loop-emit-body + (if (eq specifically 'count) + `(when ,form + (setq ,(car tempvars) + ,(hide-variable-reference t (car tempvars) `(1+ ,(car tempvars))))) + `(setq ,(car tempvars) + (+ ,(hide-variable-reference t (car tempvars) (car tempvars)) + ,form))))))) + + + +(defun loop-maxmin-collection (specifically) + (multiple-value-bind (lc form) + (loop-get-collection-info specifically 'maxmin *loop-real-data-type*) + (loop-check-data-type (loop-collector-dtype lc) *loop-real-data-type*) + (let ((data (loop-collector-data lc))) + (unless data + (setf (loop-collector-data lc) + (setq data (make-loop-minimax + (or (loop-collector-name lc) (loop-gentemp 'loop-maxmin-)) + (loop-collector-dtype lc)))) + (unless (loop-collector-name lc) + (loop-emit-final-value (loop-minimax-answer-variable data)))) + (loop-note-minimax-operation specifically data) + (push `(with-minimax-value ,data) *loop-wrappers*) + (loop-emit-body `(loop-accumulate-minimax-value ,data ,specifically ,form)) + ))) + + +;;;; Value Accumulation: Aggregate Booleans + +;;;ALWAYS and NEVER. +;;; Under ANSI these are not permitted to appear under conditionalization. +(defun loop-do-always (restrictive negate) + (let ((form (loop-get-form))) + (when restrictive (loop-disallow-conditional)) + (loop-emit-body `(,(if negate 'when 'unless) ,form + ,(loop-construct-return nil))) + (loop-emit-final-value t))) + + + +;;;THERIS. +;;; Under ANSI this is not permitted to appear under conditionalization. +(defun loop-do-thereis (restrictive) + (when restrictive (loop-disallow-conditional)) + (loop-emit-body `(when (setq ,(loop-when-it-variable) ,(loop-get-form)) + ,(loop-construct-return *loop-when-it-variable*))) + (loop-emit-final-value nil)) + + +(defun loop-do-while (negate kwd &aux (form (loop-get-form))) + (loop-disallow-conditional kwd) + (loop-pseudo-body `(,(if negate 'when 'unless) ,form (go end-loop)))) + + +(defun loop-do-with () + (loop-disallow-conditional :with) + (do ((var) (val) (dtype)) (nil) + (setq var (loop-pop-source) + dtype (loop-optional-type var) + val (cond ((loop-tequal (car *loop-source-code*) :=) + (loop-pop-source) + (loop-get-form)) + (t nil))) + (loop-make-variable var val dtype) + (if (loop-tequal (car *loop-source-code*) :and) + (loop-pop-source) + (return (loop-bind-block))))) + + +;;;; The iteration driver + +(defun loop-hack-iteration (entry) + (flet ((make-endtest (list-of-forms) + (cond ((null list-of-forms) nil) + ((member t list-of-forms) '(go end-loop)) + (t `(when ,(if (null (cdr (setq list-of-forms (nreverse list-of-forms)))) + (car list-of-forms) + (cons 'or list-of-forms)) + (go end-loop)))))) + (do ((pre-step-tests nil) + (steps nil) + (post-step-tests nil) + (pseudo-steps nil) + (pre-loop-pre-step-tests nil) + (pre-loop-steps nil) + (pre-loop-post-step-tests nil) + (pre-loop-pseudo-steps nil) + (tem) (data)) + (nil) + ;; Note we collect endtests in reverse order, but steps in correct + ;; order. MAKE-ENDTEST does the nreverse for us. + (setq tem (setq data (apply (symbol-function (first entry)) (rest entry)))) + (and (car tem) (push (car tem) pre-step-tests)) + (setq steps (nconc steps (loop-copylist* (car (setq tem (cdr tem)))))) + (and (car (setq tem (cdr tem))) (push (car tem) post-step-tests)) + (setq pseudo-steps (nconc pseudo-steps (loop-copylist* (car (setq tem (cdr tem)))))) + (setq tem (cdr tem)) + (when *loop-emitted-body* + (loop-error "Iteration in LOOP follows body code.")) + (unless tem (setq tem data)) + (when (car tem) (push (car tem) pre-loop-pre-step-tests)) + (setq pre-loop-steps (nconc pre-loop-steps (loop-copylist* (car (setq tem (cdr tem)))))) + (when (car (setq tem (cdr tem))) (push (car tem) pre-loop-post-step-tests)) + (setq pre-loop-pseudo-steps (nconc pre-loop-pseudo-steps (loop-copylist* (cadr tem)))) + (unless (loop-tequal (car *loop-source-code*) :and) + (setq *loop-before-loop* (list* (loop-make-desetq pre-loop-pseudo-steps) + (make-endtest pre-loop-post-step-tests) + (loop-make-psetq pre-loop-steps) + (make-endtest pre-loop-pre-step-tests) + *loop-before-loop*) + *loop-after-body* (list* (loop-make-desetq pseudo-steps) + (make-endtest post-step-tests) + (loop-make-psetq steps) + (make-endtest pre-step-tests) + *loop-after-body*)) + (loop-bind-block) + (return nil)) + (loop-pop-source) ; flush the "AND" + (when (and (not (loop-universe-implicit-for-required *loop-universe*)) + (setq tem (loop-lookup-keyword + (car *loop-source-code*) + (loop-universe-iteration-keywords *loop-universe*)))) + ;;Latest ANSI clarification is that the FOR/AS after the AND must NOT be supplied. + (loop-pop-source) + (setq entry tem))))) + + +;;;; Main Iteration Drivers + + +;FOR variable keyword ..args.. +(defun loop-do-for () + (let* ((var (loop-pop-source)) + (data-type (loop-optional-type var)) + (keyword (loop-pop-source)) + (first-arg nil) + (tem nil)) + (setq first-arg (loop-get-form)) + (unless (and (symbolp keyword) + (setq tem (loop-lookup-keyword + keyword + (loop-universe-for-keywords *loop-universe*)))) + (loop-error "~S is an unknown keyword in FOR or AS clause in LOOP." keyword)) + (apply (car tem) var first-arg data-type (cdr tem)))) + + +(defun loop-do-repeat () + (let ((form (loop-get-form)) + (type (loop-check-data-type (loop-optional-type) *loop-real-data-type*))) + (when (and (consp form) (eq (car form) 'the) (subtypep (second form) type)) + (setq type (second form))) + (multiple-value-bind (number constantp value) + (loop-constant-fold-if-possible form type) + (cond ((and constantp (<= value 1)) `(t () () () ,(<= value 0) () () ())) + (t (let ((var (loop-make-variable (loop-gentemp 'loop-repeat-) number type))) + (if constantp + `((not (plusp (setq ,var (1- ,var)))) () () () () () () ()) + `((minusp (setq ,var (1- ,var))) () () ())))))))) + + +(defun loop-when-it-variable () + (or *loop-when-it-variable* + (setq *loop-when-it-variable* + (loop-make-variable (loop-gentemp 'loop-it-) nil nil)))) + + +;;;; Various FOR/AS Subdispatches + + +;;;ANSI "FOR x = y [THEN z]" is sort of like the old Genera one when the THEN +;;; is omitted (other than being more stringent in its placement), and like +;;; the old "FOR x FIRST y THEN z" when the THEN is present. I.e., the first +;;; initialization occurs in the loop body (first-step), not in the variable binding +;;; phase. +(defun loop-ansi-for-equals (var val data-type) + (loop-make-iteration-variable var nil data-type) + (cond ((loop-tequal (car *loop-source-code*) :then) + ;;Then we are the same as "FOR x FIRST y THEN z". + (loop-pop-source) + `(() (,var ,(loop-get-form)) () () + () (,var ,val) () ())) + (t ;;We are the same as "FOR x = y". + `(() (,var ,val) () ())))) + + +(defun loop-for-across (var val data-type) + (loop-make-iteration-variable var nil data-type) + (let ((vector-var (loop-gentemp 'loop-across-vector-)) + (index-var (loop-gentemp 'loop-across-index-))) + (multiple-value-bind (vector-form constantp vector-value) + (loop-constant-fold-if-possible val 'vector) + (loop-make-variable + vector-var vector-form + (if (and (consp vector-form) (eq (car vector-form) 'the)) + (cadr vector-form) + 'vector)) + #+Genera (push `(system:array-register ,vector-var) *loop-declarations*) + (loop-make-variable index-var 0 'fixnum) + (let* ((length 0) + (length-form (cond ((not constantp) + (let ((v (loop-gentemp 'loop-across-limit-))) + (push `(setq ,v (length ,vector-var)) *loop-prologue*) + (loop-make-variable v 0 'fixnum))) + (t (setq length (length vector-value))))) + (first-test `(>= ,index-var ,length-form)) + (other-test first-test) + (step `(,var (aref ,vector-var ,index-var))) + (pstep `(,index-var (1+ ,index-var)))) + (declare (fixnum length)) + (when constantp + (setq first-test (= length 0)) + (when (<= length 1) + (setq other-test t))) + `(,other-test ,step () ,pstep + ,@(and (not (eq first-test other-test)) `(,first-test ,step () ,pstep))))))) + + + +;;;; List Iteration + + +(defun loop-list-step (listvar) + ;;We are not equipped to analyze whether 'FOO is the same as #'FOO here in any + ;; sensible fashion, so let's give an obnoxious warning whenever 'FOO is used + ;; as the stepping function. + ;;While a Discerning Compiler may deal intelligently with (funcall 'foo ...), not + ;; recognizing FOO may defeat some LOOP optimizations. + (let ((stepper (cond ((loop-tequal (car *loop-source-code*) :by) + (loop-pop-source) + (loop-get-form)) + (t '(function cdr))))) + (cond ((and (consp stepper) (eq (car stepper) 'quote)) + (loop-warn "Use of QUOTE around stepping function in LOOP will be left verbatim.") + (values `(funcall ,stepper ,listvar) nil)) + ((and (consp stepper) (eq (car stepper) 'function)) + (values (list (cadr stepper) listvar) (cadr stepper))) + (t (values `(funcall ,(loop-make-variable (loop-gentemp 'loop-fn-) stepper 'function) + ,listvar) + nil))))) + + +(defun loop-for-on (var val data-type) + (multiple-value-bind (list constantp list-value) (loop-constant-fold-if-possible val) + (let ((listvar var)) + (cond ((and var (symbolp var)) (loop-make-iteration-variable var list data-type)) + (t (loop-make-variable (setq listvar (loop-gentemp)) list 'list) + (loop-make-iteration-variable var nil data-type))) + (multiple-value-bind (list-step step-function) (loop-list-step listvar) + (declare #+(and (not LOOP-Prefer-POP) (not CLOE)) (ignore step-function)) + ;; The CLOE problem above has to do with bug in macroexpansion of multiple-value-bind. + (let* ((first-endtest + (hide-variable-reference + (eq var listvar) + listvar + ;; the following should use `atom' instead of `endp', per + ;; [bug2428] + `(atom ,listvar))) + (other-endtest first-endtest)) + (when (and constantp (listp list-value)) + (setq first-endtest (null list-value))) + (cond ((eq var listvar) + ;;Contour of the loop is different because we use the user's variable... + `(() (,listvar ,(hide-variable-reference t listvar list-step)) ,other-endtest + () () () ,first-endtest ())) + #+LOOP-Prefer-POP + ((and step-function + (let ((n (cdr (assoc step-function '((cdr . 1) (cddr . 2) + (cdddr . 3) (cddddr . 4)))))) + (and n (do ((l var (cdr l)) (i 0 (1+ i))) + ((atom l) (and (null l) (= i n))) + (declare (fixnum i)))))) + (let ((step (mapcan #'(lambda (x) (list x `(pop ,listvar))) var))) + `(,other-endtest () () ,step ,first-endtest () () ,step))) + (t (let ((step `(,var ,listvar)) (pseudo `(,listvar ,list-step))) + `(,other-endtest ,step () ,pseudo + ,@(and (not (eq first-endtest other-endtest)) + `(,first-endtest ,step () ,pseudo))))))))))) + + +(defun loop-for-in (var val data-type) + (multiple-value-bind (list constantp list-value) (loop-constant-fold-if-possible val) + (let ((listvar (loop-gentemp 'loop-list-))) + (loop-make-iteration-variable var nil data-type) + (loop-make-variable listvar list 'list) + (multiple-value-bind (list-step step-function) (loop-list-step listvar) + #-LOOP-Prefer-POP (declare (ignore step-function)) + (let* ((first-endtest `(endp ,listvar)) + (other-endtest first-endtest) + (step `(,var (car ,listvar))) + (pseudo-step `(,listvar ,list-step))) + (when (and constantp (listp list-value)) + (setq first-endtest (null list-value))) + #+LOOP-Prefer-POP (when (eq step-function 'cdr) + (setq step `(,var (pop ,listvar)) pseudo-step nil)) + `(,other-endtest ,step () ,pseudo-step + ,@(and (not (eq first-endtest other-endtest)) + `(,first-endtest ,step () ,pseudo-step)))))))) + + +;;;; Iteration Paths + + +(defstruct (loop-path + #+ecls (:type vector) + #+nil (:copier nil) + #+nil (:predicate nil)) + names + preposition-groups + inclusive-permitted + function + user-data) + + +(defun add-loop-path (names function universe &key preposition-groups inclusive-permitted user-data) + (unless (listp names) (setq names (list names))) + ;; Can't do this due to CLOS bootstrapping problems. + #-(or Genera (and CLOE Source-Bootstrap) ecls) (check-type universe loop-universe) + (let ((ht (loop-universe-path-keywords universe)) + (lp (make-loop-path + :names (mapcar #'symbol-name names) + :function function + :user-data user-data + :preposition-groups (mapcar #'(lambda (x) (if (listp x) x (list x))) preposition-groups) + :inclusive-permitted inclusive-permitted))) + (dolist (name names) (setf (gethash (symbol-name name) ht) lp)) + lp)) + + +;;; Note: path functions are allowed to use loop-make-variable, hack +;;; the prologue, etc. +(defun loop-for-being (var val data-type) + ;; FOR var BEING each/the pathname prep-phrases using-stuff... + ;; each/the = EACH or THE. Not clear if it is optional, so I guess we'll warn. + (let ((path nil) + (data nil) + (inclusive nil) + (stuff nil) + (initial-prepositions nil)) + (cond ((loop-tmember val '(:each :the)) (setq path (loop-pop-source))) + ((loop-tequal (car *loop-source-code*) :and) + (loop-pop-source) + (setq inclusive t) + (unless (loop-tmember (car *loop-source-code*) '(:its :each :his :her)) + (loop-error "~S found where ITS or EACH expected in LOOP iteration path syntax." + (car *loop-source-code*))) + (loop-pop-source) + (setq path (loop-pop-source)) + (setq initial-prepositions `((:in ,val)))) + (t (loop-error "Unrecognizable LOOP iteration path syntax. Missing EACH or THE?"))) + (cond ((not (symbolp path)) + (loop-error "~S found where a LOOP iteration path name was expected." path)) + ((not (setq data (loop-lookup-keyword path (loop-universe-path-keywords *loop-universe*)))) + (loop-error "~S is not the name of a LOOP iteration path." path)) + ((and inclusive (not (loop-path-inclusive-permitted data))) + (loop-error "\"Inclusive\" iteration is not possible with the ~S LOOP iteration path." path))) + (let ((fun (loop-path-function data)) + (preps (nconc initial-prepositions + (loop-collect-prepositional-phrases (loop-path-preposition-groups data) t))) + (user-data (loop-path-user-data data))) + (when (symbolp fun) (setq fun (symbol-function fun))) + (setq stuff (if inclusive + (apply fun var data-type preps :inclusive t user-data) + (apply fun var data-type preps user-data)))) + (when *loop-named-variables* + (loop-error "Unused USING variables: ~S." *loop-named-variables*)) + ;; STUFF is now (bindings prologue-forms . stuff-to-pass-back). Protect the system from the user + ;; and the user from himself. + (unless (member (length stuff) '(6 10)) + (loop-error "Value passed back by LOOP iteration path function for path ~S has invalid length." + path)) + (do ((l (car stuff) (cdr l)) (x)) ((null l)) + (if (atom (setq x (car l))) + (loop-make-iteration-variable x nil nil) + (loop-make-iteration-variable (car x) (cadr x) (caddr x)))) + (setq *loop-prologue* (nconc (reverse (cadr stuff)) *loop-prologue*)) + (cddr stuff))) + + + +;;;INTERFACE: Lucid, exported. +;;; i.e., this is part of our extended ansi-loop interface. +(defun named-variable (name) + (let ((tem (loop-tassoc name *loop-named-variables*))) + (declare (list tem)) + (cond ((null tem) (values (loop-gentemp) nil)) + (t (setq *loop-named-variables* (delete tem *loop-named-variables*)) + (values (cdr tem) t))))) + + +(defun loop-collect-prepositional-phrases (preposition-groups &optional USING-allowed initial-phrases) + (flet ((in-group-p (x group) (car (loop-tmember x group)))) + (do ((token nil) + (prepositional-phrases initial-phrases) + (this-group nil nil) + (this-prep nil nil) + (disallowed-prepositions + (mapcan #'(lambda (x) + (loop-copylist* + (find (car x) preposition-groups :test #'in-group-p))) + initial-phrases)) + (used-prepositions (mapcar #'car initial-phrases))) + ((null *loop-source-code*) (nreverse prepositional-phrases)) + (declare (symbol this-prep)) + (setq token (car *loop-source-code*)) + (dolist (group preposition-groups) + (when (setq this-prep (in-group-p token group)) + (return (setq this-group group)))) + (cond (this-group + (when (member this-prep disallowed-prepositions) + (loop-error + (if (member this-prep used-prepositions) + "A ~S prepositional phrase occurs multiply for some LOOP clause." + "Preposition ~S used when some other preposition has subsumed it.") + token)) + (setq used-prepositions (if (listp this-group) + (append this-group used-prepositions) + (cons this-group used-prepositions))) + (loop-pop-source) + (push (list this-prep (loop-get-form)) prepositional-phrases)) + ((and USING-allowed (loop-tequal token 'using)) + (loop-pop-source) + (do ((z (loop-pop-source) (loop-pop-source)) (tem)) (nil) + (when (or (atom z) + (atom (cdr z)) + (not (null (cddr z))) + (not (symbolp (car z))) + (and (cadr z) (not (symbolp (cadr z))))) + (loop-error "~S bad variable pair in path USING phrase." z)) + (when (cadr z) + (if (setq tem (loop-tassoc (car z) *loop-named-variables*)) + (loop-error + "The variable substitution for ~S occurs twice in a USING phrase,~@ + with ~S and ~S." + (car z) (cadr z) (cadr tem)) + (push (cons (car z) (cadr z)) *loop-named-variables*))) + (when (or (null *loop-source-code*) (symbolp (car *loop-source-code*))) + (return nil)))) + (t (return (nreverse prepositional-phrases))))))) + + +;;;; Master Sequencer Function + + +(defun loop-sequencer (indexv indexv-type indexv-user-specified-p + variable variable-type + sequence-variable sequence-type + step-hack default-top + prep-phrases) + (let ((endform nil) ;Form (constant or variable) with limit value. + (sequencep nil) ;T if sequence arg has been provided. + (testfn nil) ;endtest function + (test nil) ;endtest form. + (stepby (1+ (or (loop-typed-init indexv-type) 0))) ;Our increment. + (stepby-constantp t) + (step nil) ;step form. + (dir nil) ;Direction of stepping: NIL, :UP, :DOWN. + (inclusive-iteration nil) ;T if include last index. + (start-given nil) ;T when prep phrase has specified start + (start-value nil) + (start-constantp nil) + (limit-given nil) ;T when prep phrase has specified end + (limit-constantp nil) + (limit-value nil) + ) + (when variable (loop-make-iteration-variable variable nil variable-type)) + (do ((l prep-phrases (cdr l)) (prep) (form) (odir)) ((null l)) + (setq prep (caar l) form (cadar l)) + (case prep + ((:of :in) + (setq sequencep t) + (loop-make-variable sequence-variable form sequence-type)) + ((:from :downfrom :upfrom) + (setq start-given t) + (cond ((eq prep :downfrom) (setq dir ':down)) + ((eq prep :upfrom) (setq dir ':up))) + (multiple-value-setq (form start-constantp start-value) + (loop-constant-fold-if-possible form indexv-type)) + (loop-make-iteration-variable indexv form indexv-type)) + ((:upto :to :downto :above :below) + (cond ((loop-tequal prep :upto) (setq inclusive-iteration (setq dir ':up))) + ((loop-tequal prep :to) (setq inclusive-iteration t)) + ((loop-tequal prep :downto) (setq inclusive-iteration (setq dir ':down))) + ((loop-tequal prep :above) (setq dir ':down)) + ((loop-tequal prep :below) (setq dir ':up))) + (setq limit-given t) + (multiple-value-setq (form limit-constantp limit-value) + (loop-constant-fold-if-possible form indexv-type)) + (setq endform (if limit-constantp + `',limit-value + (loop-make-variable + (loop-gentemp 'loop-limit-) form indexv-type)))) + (:by + (multiple-value-setq (form stepby-constantp stepby) + (loop-constant-fold-if-possible form indexv-type)) + (unless stepby-constantp + (loop-make-variable (setq stepby (loop-gentemp 'loop-step-by-)) form indexv-type))) + (t (loop-error + "~S invalid preposition in sequencing or sequence path.~@ + Invalid prepositions specified in iteration path descriptor or something?" + prep))) + (when (and odir dir (not (eq dir odir))) + (loop-error "Conflicting stepping directions in LOOP sequencing path")) + (setq odir dir)) + (when (and sequence-variable (not sequencep)) + (loop-error "Missing OF or IN phrase in sequence path")) + ;; Now fill in the defaults. + (unless start-given + (loop-make-iteration-variable + indexv + (setq start-constantp t start-value (or (loop-typed-init indexv-type) 0)) + indexv-type)) + (cond ((member dir '(nil :up)) + (when (or limit-given default-top) + (unless limit-given + (loop-make-variable (setq endform (loop-gentemp 'loop-seq-limit-)) + nil indexv-type) + (push `(setq ,endform ,default-top) *loop-prologue*)) + (setq testfn (if inclusive-iteration '> '>=))) + (setq step (if (eql stepby 1) `(1+ ,indexv) `(+ ,indexv ,stepby)))) + (t (unless start-given + (unless default-top + (loop-error "Don't know where to start stepping.")) + (push `(setq ,indexv (1- ,default-top)) *loop-prologue*)) + (when (and default-top (not endform)) + (setq endform (loop-typed-init indexv-type) inclusive-iteration t)) + (when endform (setq testfn (if inclusive-iteration '< '<=))) + (setq step (if (eql stepby 1) `(1- ,indexv) `(- ,indexv ,stepby))))) + (when testfn (setq test (hide-variable-reference t indexv `(,testfn ,indexv ,endform)))) + (when step-hack + (setq step-hack `(,variable ,(hide-variable-reference indexv-user-specified-p indexv step-hack)))) + (let ((first-test test) (remaining-tests test)) + (when (and stepby-constantp start-constantp limit-constantp) + (when (setq first-test (funcall (symbol-function testfn) start-value limit-value)) + (setq remaining-tests t))) + `(() (,indexv ,(hide-variable-reference t indexv step)) ,remaining-tests ,step-hack + () () ,first-test ,step-hack)))) + + +;;;; Interfaces to the Master Sequencer + + + +(defun loop-for-arithmetic (var val data-type kwd) + (loop-sequencer + var (loop-check-data-type data-type *loop-real-data-type*) t + nil nil nil nil nil nil + (loop-collect-prepositional-phrases + '((:from :upfrom :downfrom) (:to :upto :downto :above :below) (:by)) + nil (list (list kwd val))))) + + +(defun loop-sequence-elements-path (variable data-type prep-phrases + &key fetch-function size-function sequence-type element-type) + (multiple-value-bind (indexv indexv-user-specified-p) (named-variable 'index) + (let ((sequencev (named-variable 'sequence))) + #+Genera (when (and sequencev + (symbolp sequencev) + sequence-type + (subtypep sequence-type 'vector) + (not (member (the symbol sequencev) *loop-nodeclare*))) + (push `(sys:array-register ,sequencev) *loop-declarations*)) + (list* nil nil ; dummy bindings and prologue + (loop-sequencer + indexv 'fixnum indexv-user-specified-p + variable (or data-type element-type) + sequencev sequence-type + `(,fetch-function ,sequencev ,indexv) `(,size-function ,sequencev) + prep-phrases))))) + + +;;;; Builtin LOOP Iteration Paths + + +#|| +(loop for v being the hash-values of ht do (print v)) +(loop for k being the hash-keys of ht do (print k)) +(loop for v being the hash-values of ht using (hash-key k) do (print (list k v))) +(loop for k being the hash-keys of ht using (hash-value v) do (print (list k v))) +||# + +(defun loop-hash-table-iteration-path (variable data-type prep-phrases &key which) + (check-type which (member hash-key hash-value)) + (cond ((or (cdr prep-phrases) (not (member (caar prep-phrases) '(:in :of)))) + (loop-error "Too many prepositions!")) + ((null prep-phrases) (loop-error "Missing OF or IN in ~S iteration path."))) + (let ((ht-var (loop-gentemp 'loop-hashtab-)) + (next-fn (loop-gentemp 'loop-hashtab-next-)) + (dummy-predicate-var nil) + (post-steps nil)) + (multiple-value-bind (other-var other-p) + (named-variable (if (eq which 'hash-key) 'hash-value 'hash-key)) + ;; named-variable returns a second value of T if the name was actually + ;; specified, so clever code can throw away the gensym'ed up variable if + ;; it isn't really needed. + ;;The following is for those implementations in which we cannot put dummy NILs + ;; into multiple-value-setq variable lists. + #-Genera (setq other-p t + dummy-predicate-var (loop-when-it-variable)) + (let ((key-var nil) + (val-var nil) + (bindings `((,variable nil ,data-type) + (,ht-var ,(cadar prep-phrases)) + ,@(and other-p other-var `((,other-var nil)))))) + (if (eq which 'hash-key) + (setq key-var variable val-var (and other-p other-var)) + (setq key-var (and other-p other-var) val-var variable)) + (push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*) + (when (consp key-var) + (setq post-steps `(,key-var ,(setq key-var (loop-gentemp 'loop-hash-key-temp-)) + ,@post-steps)) + (push `(,key-var nil) bindings)) + (when (consp val-var) + (setq post-steps `(,val-var ,(setq val-var (loop-gentemp 'loop-hash-val-temp-)) + ,@post-steps)) + (push `(,val-var nil) bindings)) + `(,bindings ;bindings + () ;prologue + () ;pre-test + () ;parallel steps + (not (multiple-value-setq (,dummy-predicate-var ,key-var ,val-var) (,next-fn))) ;post-test + ,post-steps))))) + + +(defun loop-package-symbols-iteration-path (variable data-type prep-phrases &key symbol-types) + (cond ((or (cdr prep-phrases) (not (member (caar prep-phrases) '(:in :of)))) + (loop-error "Too many prepositions!")) + ((null prep-phrases) (loop-error "Missing OF or IN in ~S iteration path."))) + (unless (symbolp variable) + (loop-error "Destructuring is not valid for package symbol iteration.")) + (let ((pkg-var (loop-gentemp 'loop-pkgsym-)) + (next-fn (loop-gentemp 'loop-pkgsym-next-))) + (push `(lisp::with-package-iterator (,next-fn ,pkg-var ,@symbol-types)) *loop-wrappers*) + `(((,variable nil ,data-type) (,pkg-var ,(cadar prep-phrases))) + () + () + () + (not (multiple-value-setq (,(progn + ;; If an implementation can get away without actually + ;; using a variable here, so much the better. + #+Genera NIL + #-Genera (loop-when-it-variable)) + ,variable) + (,next-fn))) + ()))) + +;;;; ANSI Loop + +(defun make-ansi-loop-universe (extended-p) + (let ((w (make-standard-loop-universe + :keywords `((named (loop-do-named)) + (initially (loop-do-initially)) + (finally (loop-do-finally)) + (do (loop-do-do)) + (doing (loop-do-do)) + (return (loop-do-return)) + (collect (loop-list-collection list)) + (collecting (loop-list-collection list)) + (append (loop-list-collection append)) + (appending (loop-list-collection append)) + (nconc (loop-list-collection nconc)) + (nconcing (loop-list-collection nconc)) + (count (loop-sum-collection count ,*loop-real-data-type* fixnum)) + (counting (loop-sum-collection count ,*loop-real-data-type* fixnum)) + (sum (loop-sum-collection sum number number)) + (summing (loop-sum-collection sum number number)) + (maximize (loop-maxmin-collection max)) + (minimize (loop-maxmin-collection min)) + (maximizing (loop-maxmin-collection max)) + (minimizing (loop-maxmin-collection min)) + (always (loop-do-always t nil)) ; Normal, do always + (never (loop-do-always t t)) ; Negate the test on always. + (thereis (loop-do-thereis t)) + (while (loop-do-while nil :while)) ; Normal, do while + (until (loop-do-while t :until)) ; Negate the test on while + (when (loop-do-if when nil)) ; Normal, do when + (if (loop-do-if if nil)) ; synonymous + (unless (loop-do-if unless t)) ; Negate the test on when + (with (loop-do-with))) + :for-keywords '((= (loop-ansi-for-equals)) + (across (loop-for-across)) + (in (loop-for-in)) + (on (loop-for-on)) + (from (loop-for-arithmetic :from)) + (downfrom (loop-for-arithmetic :downfrom)) + (upfrom (loop-for-arithmetic :upfrom)) + (below (loop-for-arithmetic :below)) + (above (loop-for-arithmetic :above)) + (by (loop-for-arithmetic :by)) + (to (loop-for-arithmetic :to)) + (upto (loop-for-arithmetic :upto)) + (being (loop-for-being))) + :iteration-keywords '((for (loop-do-for)) + (as (loop-do-for)) + (repeat (loop-do-repeat))) + :type-symbols '(array atom bignum bit bit-vector character compiled-function + complex cons double-float fixnum float + function hash-table integer keyword list long-float + nil null number package pathname random-state + ratio rational readtable sequence short-float + simple-array simple-bit-vector simple-string + simple-vector single-float standard-char + stream string base-char + symbol t vector) + :type-keywords nil + :ansi (if extended-p :extended t)))) + (add-loop-path '(hash-key hash-keys) 'loop-hash-table-iteration-path w + :preposition-groups '((:of :in)) + :inclusive-permitted nil + :user-data '(:which hash-key)) + (add-loop-path '(hash-value hash-values) 'loop-hash-table-iteration-path w + :preposition-groups '((:of :in)) + :inclusive-permitted nil + :user-data '(:which hash-value)) + (add-loop-path '(symbol symbols) 'loop-package-symbols-iteration-path w + :preposition-groups '((:of :in)) + :inclusive-permitted nil + :user-data '(:symbol-types (:internal :external :inherited))) + (add-loop-path '(external-symbol external-symbols) 'loop-package-symbols-iteration-path w + :preposition-groups '((:of :in)) + :inclusive-permitted nil + :user-data '(:symbol-types (:external))) + (add-loop-path '(present-symbol present-symbols) 'loop-package-symbols-iteration-path w + :preposition-groups '((:of :in)) + :inclusive-permitted nil + :user-data '(:symbol-types (:internal))) + w)) + + +(defparameter *loop-ansi-universe* + (make-ansi-loop-universe nil)) + + +(defun loop-standard-expansion (keywords-and-forms environment universe) + (if (and keywords-and-forms (symbolp (car keywords-and-forms))) + (loop-translate keywords-and-forms environment universe) + (let ((tag (gensym))) + `(block nil (tagbody ,tag (progn ,@keywords-and-forms) (go ,tag)))))) + + +;;;INTERFACE: ANSI +(defmacro loop (&environment env &rest keywords-and-forms) + #+Genera (declare (compiler:do-not-record-macroexpansions) + (zwei:indentation . zwei:indent-loop)) + (loop-standard-expansion keywords-and-forms env *loop-ansi-universe*)) + +#+allegro +(defun excl::complex-loop-expander (body env) + (loop-standard-expansion body env *loop-ansi-universe*)) diff --git a/lsp/gcl_make-declare.lsp b/lsp/gcl_make-declare.lsp new file mode 100755 index 0000000..4d06ced --- /dev/null +++ b/lsp/gcl_make-declare.lsp @@ -0,0 +1,80 @@ +;; By W. Schelter +;; Usage: (si::proclaim-file "foo.lsp") (compile-file "foo.lsp") + +(in-package 'si) + +;; You may wish to adjust the following to output the proclamations +;; for inclusion in a file. All fixed arg functions should be proclaimed +;; before their references for maximum efficiency. + +;; CAVEAT: The following code only checks for fixed args, it does +;; not check for single valuedness BUT does make a proclamation +;; to that effect. Unfortunately it is impossible to tell about +;; multiple values without doing a full compiler type pass over +;; all files in the relevant system. However the GCL compiler should +;; warn if you inadvertantly proclaim foo to be single valued and then try +;; to use more than one value. + +(DEFVAR *DECLARE-T-ONLY* NIL) +(DEFUN PROCLAIM-FILE (NAME &OPTIONAL *DECLARE-T-ONLY*) + (WITH-OPEN-FILE + (FILE NAME + :DIRECTION :INPUT) + (LET ((EOF (CONS NIL NIL))) + (LOOP + (LET ((FORM (READ FILE NIL EOF))) + (COND ((EQ EOF FORM) (RETURN NIL)) + ((MAKE-DECLARE-FORM FORM )))))))) + +(DEFVAR *DEFUNS* '(DEFUN)) + +(DEFUN MAKE-DECLARE-FORM (FORM) +; !!! + (WHEN + (LISTP FORM) + (COND ((MEMBER (CAR FORM) '(EVAL-WHEN )) + (DOLIST (V (CDDR FORM)) (MAKE-DECLARE-FORM V))) + ((MEMBER (CAR FORM) '(PROGN )) + (DOLIST (V (CDR FORM)) (MAKE-DECLARE-FORM V))) + ((MEMBER (CAR FORM) '(IN-PACKAGE DEFCONSTANT)) + (EVAL FORM)) + ((MEMBER (CAR FORM) *DEFUNS*) + (COND + ((AND + (CONSP (CADDR FORM)) + (NOT (MEMBER '&REST (CADDR FORM))) + (NOT (MEMBER '&BODY (CADDR FORM))) + (NOT (MEMBER '&KEY (CADDR FORM))) + (NOT (MEMBER '&OPTIONAL (CADDR FORM)))) + ;;could print declarations here. + ;(print (list (cadr form)(ARG-DECLARES (THIRD FORM)(cdddr FORM)))) + (FUNCALL 'PROCLAIM + (LIST 'FUNCTION + (CADR FORM) + (ARG-DECLARES (THIRD FORM) (cdddr FORM)) + T)))))))) + +(DEFUN ARG-DECLARES (ARGS DECLS &AUX ANS) + (COND ((STRINGP (CAR DECLS)) (SETQ DECLS (CADR DECLS))) + (T (SETQ DECLS (CAR DECLS)))) + (COND ((AND (not *declare-t-only*) + (CONSP DECLS) (EQ (CAR DECLS ) 'DECLARE)) + (DO ((V ARGS (CDR V))) + ((OR (EQ (CAR V) '&AUX) + (NULL V)) + (NREVERSE ANS)) + (PUSH (DECL-TYPE (CAR V) DECLS) ANS))) + (T (MAKE-LIST (- (LENGTH args) + (LENGTH (MEMBER '&AUX args))) + :INITIAL-ELEMENT T)))) + +(DEFUN DECL-TYPE (V DECLS) + (DOLIST (D (CDR DECLS)) + (CASE (CAR D) + (TYPE (IF (MEMBER V (CDDR D)) + (RETURN-FROM DECL-TYPE (SECOND D)))) + ((FIXNUM CHARACTER FLOAT LONG-FLOAT SHORT-FLOAT ) + (IF (MEMBER V (CDR D)) (RETURN-FROM DECL-TYPE (CAR D)))))) + T) + + \ No newline at end of file diff --git a/lsp/gcl_make_defpackage.lsp b/lsp/gcl_make_defpackage.lsp new file mode 100644 index 0000000..dc83054 --- /dev/null +++ b/lsp/gcl_make_defpackage.lsp @@ -0,0 +1,52 @@ +;;; Thu Aug 12 14:22:09 1993 by Mark Kantrowitz +;;; make-defpackage.lisp -- 1961 bytes + +;;; **************************************************************** +;;; Make a Defpackage Form From Package State ********************** +;;; **************************************************************** + +(in-package :si) + +(defun make-defpackage-form (package-name) + "Given a package, returns a defpackage form that could recreate the + current state of the package, more or less." + (let ((package (find-package package-name))) + (let* ((name (package-name package)) + (nicknames (package-nicknames package)) + (package-use-list (package-use-list package)) + (use-list (mapcar #'package-name package-use-list)) + (externs nil) + (shadowed-symbols (package-shadowing-symbols package)) + (imports nil) + (shadow-imports nil) + (pure-shadow nil) + (pure-import nil)) + (do-external-symbols (sym package) (push (symbol-name sym) externs)) + (do-symbols (sym package) + (unless (or (eq package (symbol-package sym)) + (find (symbol-package sym) package-use-list)) + (push sym imports))) + (setq shadow-imports (intersection shadowed-symbols imports)) + (setq pure-shadow (set-difference shadowed-symbols shadow-imports)) + (setq pure-import (set-difference imports shadow-imports)) + `(defpackage ,name + ,@(when nicknames `((:nicknames ,@nicknames))) + ,@(when use-list `((:use ,@use-list))) + ,@(when externs `((:export ,@externs))) + ;; skip :intern + ,@(when pure-shadow + `((:shadow ,@(mapcar #'symbol-name pure-shadow)))) + ,@(when shadow-imports + (mapcar #'(lambda (symbol) + `((:shadowing-import-from + ,(package-name (symbol-package symbol)) + ,(symbol-name symbol)))) + shadow-imports)) + ,@(when pure-import + (mapcar #'(lambda (symbol) + `((:import-from + ,(package-name (symbol-package symbol)) + ,(symbol-name symbol)))) + pure-import)))))) + +;;; *EOF* diff --git a/lsp/gcl_make_pathname.lsp b/lsp/gcl_make_pathname.lsp new file mode 100644 index 0000000..68808f6 --- /dev/null +++ b/lsp/gcl_make_pathname.lsp @@ -0,0 +1,179 @@ +(in-package :si) + +;; (defun pathnamep (x) +;; (declare (optimize (safety 1))) +;; (when (typep x 'pathname) t)) + + +(eval-when (compile eval) + (defun add-dir-sep (s &optional (i 0) (bp 0) (l (length s))) + (when (< i l) + (let ((x (aref s i))) + (append + (if (eql x #\/) + (if (zerop bp) (list #\[ x #\\ #\]) (list x #\\)) + (list x)) + (add-dir-sep s (1+ i) (case x (#\[ (1+ bp))(#\] (1- bp))(otherwise bp)) l))))) + + (defun ads (s) #+winnt (coerce (add-dir-sep s) 'string) #-winnt s)) + +(defconstant +dirsep+ (compile-regexp #.(ads "/"))) + +(defconstant +glob-to-regexp-alist+ (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) + (cons #v"\\[[^\\]*\\]" + (lambda (x) + (string-concatenate "(" (substitute #\^ #\! (subseq x 0 2)) (subseq x 2) ")"))) + (cons #v"\\*" (lambda (x) #.(ads "([^/.]*)"))) + (cons #v"\\?" (lambda (x) #.(ads "([^/.])"))) + (cons #v"\\." (lambda (x) "\\.")))) + +(defconstant +physical-pathname-defaults+ '(("" "" "") + #+winnt("" "([A-Za-z]:)?" ":") #-winnt("" "()" "") + ("" #.(ads "(/?([^/]*/)*)") "" "" #.(ads "([^/]*/)") "/") + ("" #.(ads "([^/.]*)") "") + ("." #.(ads "(\\.[^/]*)?") "") + ("" "" ""))) + +(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") + ("" "" "") + ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") + ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") + ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") + ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) + +(defun msub (a x) (if a (msub (cdr a) (substitute (caar a) (cdar a) x)) x)) + + +(defun mglist (x &optional (b 0)) + (let* ((y (mapcan (lambda (z &aux (w (string-match (car z) x b))) + (unless (eql w -1) + (list (list w (match-end 0) z)))) + +glob-to-regexp-alist+)) + (z (when y (reduce (lambda (y x) (if (< (car x) (car y)) x y)) y)))) + (when z + (cons z (mglist x (cadr z)))))) + +(defun mgsub (x &optional (l (mglist x)) (b 0) &aux (w (pop l))) + (if w + (string-concatenate + (subseq x b (car w)) + (funcall (cdaddr w) (subseq x (car w) (cadr w))) + (mgsub x l (cadr w))) + (subseq x b))) + + +(defun elsub (el x rp lp &aux (y x) (pref (pop y))(dflt (pop y))(post (pop y))) +; (destructuring-bind (pref dflt post &rest y) x + (etypecase el + (string (let ((x (list pref el post))) (unless (zerop (length dflt)) (if rp (mapcar 'mgsub x) x)))) + (integer (elsub (write-to-string el) x rp lp)) + ((eql :wild-inferiors) (if rp (list "(" dflt "*)") (elsub "**" x rp lp))) + ((eql :wild) (if rp (list dflt) (elsub "*" x rp lp))) + ((eql :newest) (elsub (if rp "(newest|NEWEST)" "NEWEST") x rp lp)) + ((member :up :back) (elsub ".." x rp lp)) + ((member nil :unspecific) (when rp (list dflt))) + (cons (cons + (if (eq (car el) :absolute) (if lp "" "/") (if lp ";" "")) + (mapcan (lambda (z) (elsub z y rp lp)) (cdr el))))) +; ) +) + + + +(defun to-regexp-or-namestring (x rp lp) + (apply 'string-concatenate + (mapcan (lambda (x y) (elsub x y rp lp)) + x (if lp +logical-pathname-defaults+ +physical-pathname-defaults+)))) + +(defun directory-list-check (l) + (when (listp l) + (when (member (car l) '(:absolute :relative)) + (mapl (lambda (x &aux (c (car x))(d (cadr x))) + (when (and (member d '(:up :back)) (member c '(:absolute :wild-inferiors))) + (return-from directory-list-check nil))) l)))) + +(defun canonicalize-pathname-directory (l &aux x) + (cond ((eq l :wild) (canonicalize-pathname-directory '(:absolute :wild-inferiors))) + ((stringp l) (canonicalize-pathname-directory (list :absolute l))) + ((and (eq (car l) :relative) (stringp (cadr l)) (plusp (length (cadr l))) (eql #\~ (aref (cadr l) 0))) + (canonicalize-pathname-directory (nconc (dir-parse (home-namestring (cadr l))) (cddr l)))) + ((setq x (member-if (lambda (x) (or (string-equal "" x) (string-equal "." x))) l)) + (canonicalize-pathname-directory (nconc (ldiff l x) (cdr x)))) + ((setq x (member :back l)) + (let* ((y (ldiff l x))(ll (car (last y)))) + (canonicalize-pathname-directory (if (or (stringp ll) (eq ll :wild)) (nconc (butlast y) (cdr x)) (nconc y (cons :up (cdr x))))))) + (l))) + +(defvar *default-pathname-defaults* (init-pathname nil nil nil nil nil nil "")) +(declaim (type pathname *default-pathname-defaults*)) + +(defun toggle-case (x) + (cond ((symbolp x) x) + ((listp x) (mapcar 'toggle-case x)) + ((find-if 'upper-case-p x) (if (find-if 'lower-case-p x) x (string-downcase x))) + ((find-if 'lower-case-p x) (string-upcase x)) + (x))) + +(defun logical-pathname (spec &aux (p (pathname spec))) + (declare (optimize (safety 1))) + (check-type spec pathname-designator) + (check-type p logical-pathname) + p) + +(eval-when (compile eval) + (defun strsym (p &rest r) + (declare (:dynamic-extent r)) + (intern (apply 'string-concatenate (mapcar 'string-upcase r)) p))) + +#.`(defun make-pathname (&key (host nil hostp) (device nil devicep) (directory nil directoryp) + (name nil namep) (type nil typep) (version nil versionp) + defaults (case :local) namestring &aux defaulted (def (when defaults (pathname defaults)))) + (declare (optimize (safety 1))) + (check-type host (or (member nil :unspecific) string)) + (check-type device (or (member nil :unspecific) string)) + (check-type directory (or (member nil :unspecific :wild) string list)) + (check-type name (or string (member nil :unspecific :wild))) + (check-type type (or string (member nil :unspecific :wild))) + (check-type version (or (integer 1) (member nil :unspecific :wild :newest))) + (check-type defaults (or null pathname-designator)) + (check-type case (member :common :local)) + ,(flet ((def? (k) `(let* (,@(when (eq k 'host) `((def (or def *default-pathname-defaults*)))) + (nk (if ,(strsym :si k "P") ,k (when def (,(strsym :si "C-PATHNAME-" k) def)))) + (nk (unless (equal "" nk) nk)) + (nk (progn (unless (eq ,k nk) (setq defaulted t)) nk)) + (nk (if (eq case :local) nk (progn (setq defaulted t) (toggle-case nk))))) + nk))) + `(let* ((h ,(def? 'host)) + (h (cond ((logical-pathname-host-p h) h)(h (setq defaulted t) nil))) + (dev ,(def? 'device)) + (d ,(def? 'directory)) + (d (let ((d1 (canonicalize-pathname-directory d))) (unless (eq d d1) (setq defaulted t)) d1)) + (n ,(def? 'name)) + (typ ,(def? 'type)) + (v ,(def? 'version)) + (p (init-pathname h dev d n typ v + (or (unless defaulted namestring) (to-regexp-or-namestring (list h dev d n typ v) nil h))))) + (when h (c-set-t-tt p 1)) + (unless (eq d (directory-list-check d)) + (error 'file-error :pathname p :format-control "Bad directory list")) + p))) + +(macrolet ((pn-accessor (k &aux (f (strsym :si "PATHNAME-" k)) (c (strsym :si "C-PATHNAME-" k))) + `(defun ,f (p &key (case :local) &aux (pn (pathname p))) + (declare (optimize (safety 1))) + (check-type p pathname-designator) + (let ((x (,c pn))) (if (eq case :local) x (toggle-case x)))))) + (pn-accessor host) + (pn-accessor device) + (pn-accessor directory) + (pn-accessor name) + (pn-accessor type) + (pn-accessor version)) + +(defconstant +pathname-keys+ '(:host :device :directory :name :type :version)) + +#.`(defun mlp (p) + (list ,@(mapcar (lambda (x) `(,(strsym :si "C-PATHNAME-" x) p)) +pathname-keys+))) + +(defun pnl1 (x) (list* (pop x) (pop x) (append (pop x) x))) +(defun lnp (x) (list* (pop x) (pop x) (let ((q (last x 3))) (cons (ldiff x q) q)))) diff --git a/lsp/gcl_merge_pathnames.lsp b/lsp/gcl_merge_pathnames.lsp new file mode 100644 index 0000000..a64f945 --- /dev/null +++ b/lsp/gcl_merge_pathnames.lsp @@ -0,0 +1,18 @@ +(in-package :si) + +(defun merge-pathnames (p &optional (def *default-pathname-defaults*) (def-v :newest) + &aux dflt (pn (pathname p))(def-pn (pathname def))) + (declare (optimize (safety 1))) + (check-type p pathname-designator) + (check-type def pathname-designator) + (check-type def-v (or null (eql :newest) seqind)) + (labels ((def (x) (when x (setq dflt t) x))) + (make-pathname + :host (or (pathname-host pn) (def (pathname-host def-pn))) + :device (or (pathname-device pn) (def (pathname-device def-pn))) + :directory (let ((d (pathname-directory pn))(defd (pathname-directory def-pn))) + (or (def (when (and defd (eq (car d) :relative)) (append defd (cdr d)))) d (def defd))) + :name (or (pathname-name pn) (def (pathname-name def-pn))) + :type (or (pathname-type pn) (def (pathname-type def-pn))) + :version (or (pathname-version pn) (def (unless (pathname-name pn) (pathname-version def-pn))) (def def-v)) + :version (unless dflt (return-from merge-pathnames pn))))) diff --git a/lsp/gcl_mislib.lsp b/lsp/gcl_mislib.lsp new file mode 100755 index 0000000..7ea572f --- /dev/null +++ b/lsp/gcl_mislib.lsp @@ -0,0 +1,213 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; This file is IMPLEMENTATION-DEPENDENT. + + +(in-package :si) + +(proclaim '(optimize (safety 2) (space 3))) + + +(defmacro time (form) + (let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym)) + (gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym)) + (child-run-start (gensym)) (child-run-end (gensym))) + `(let (,real-start ,real-end (,gbc-time-start (gbc-time)) ,gbc-time ,x) + (setq ,real-start (get-internal-real-time)) + (multiple-value-bind (,run-start ,child-run-start) (get-internal-run-time) + (gbc-time 0) + (setq ,x (multiple-value-list ,form)) + (setq ,gbc-time (gbc-time)) + (gbc-time (+ ,gbc-time-start ,gbc-time)) + (multiple-value-bind (,run-end ,child-run-end) (get-internal-run-time) + (setq ,real-end (get-internal-real-time)) + (fresh-line *trace-output*) + (format *trace-output* + "real time : ~10,3F secs~%~ + run-gbc time : ~10,3F secs~%~ + child run time : ~10,3F secs~%~ + gbc time : ~10,3F secs~%" + (/ (- ,real-end ,real-start) internal-time-units-per-second) + (/ (- (- ,run-end ,run-start) ,gbc-time) internal-time-units-per-second) + (/ (- ,child-run-end ,child-run-start) internal-time-units-per-second) + (/ ,gbc-time internal-time-units-per-second)))) + (values-list ,x)))) + +(defconstant seconds-per-day #.(* 24 3600)) + +(defun leap-year-p (y) + (and (zerop (mod y 4)) + (or (not (zerop (mod y 100))) (zerop (mod y 400))))) + +(defun number-of-days-from-1900 (y) + (let ((y1 (1- y))) + (+ (* (- y 1900) 365) + (floor y1 4) (- (floor y1 100)) (floor y1 400) + -460))) + +(eval-when + (compile eval) + (defmacro mmd (n &optional lp + &aux (l '(31 28 31 30 31 30 31 31 30 31 30 31)) + (l (if lp (cons (pop l) (cons (1+ (pop l)) l)) l))(r 0)(s (mapcar (lambda (x) (incf r x)) l))) + `(defconstant ,n (make-array ,(length s) :element-type '(integer ,(car s) ,(car (last s))) :initial-contents ',s)))) + +(mmd +md+) +(mmd +lmd+ t) + +(defun decode-universal-time (ut &optional (tz (current-timezone) tzp) + &aux (dstp (unless tzp (current-dstp))) (ut (- ut (* tz 3600)))) + (declare (optimize (safety 2))) + (check-type ut integer) + (check-type tz rational) + (multiple-value-bind + (d ut) (floor ut seconds-per-day) + (let* ((dow (mod d 7))(y (+ 1900 (floor d 366)))) + (labels ((l (y dd &aux (lyp (leap-year-p y))(td (if lyp 366 365))(x (- d dd))) + (if (< x td) (values (1+ x) y lyp) (l (1+ y) (+ dd td))))) + (multiple-value-bind + (d y lyp) (l y (number-of-days-from-1900 y)) + (let* ((l (if lyp +lmd+ +md+)) + (m (position d l :test '<=)) + (d (if (> m 0) (- d (aref l (1- m))) d))) + (multiple-value-bind + (h ut) (floor ut 3600) + (multiple-value-bind + (min sec) (floor ut 60) + (values sec min h d (1+ m) y dow dstp tz))))))))) + +(defun encode-universal-time (sec min h d m y &optional (tz (current-timezone))) + (declare (optimize (safety 2))) + (check-type sec (integer 0 59)) + (check-type min (integer 0 59)) + (check-type h (integer 0 23)) + (check-type d (integer 1 31)) + (check-type m (integer 1 12)) + (check-type y integer) + (check-type tz rational) + (when (<= 0 y 99) + (multiple-value-bind + (sec min h d m y1 dow dstp tz) (get-decoded-time) + (declare (ignore sec min h d m dow dstp tz)) + (incf y (- y1 (mod y1 100))) + (cond ((< (- y y1) -50) (incf y 100)) + ((>= (- y y1) 50) (decf y 100))))) + (+ (* (+ (1- d) (number-of-days-from-1900 y) (if (> m 1) (aref (if (leap-year-p y) +lmd+ +md+) (- m 2)) 0)) + seconds-per-day) + (* (+ h tz) 3600) (* min 60) sec)) + +(defun compile-file-pathname (pathname) + (make-pathname :defaults pathname :type "o")) + +(defun constantly (x) + (lambda (&rest args) + (declare (ignore args) (:dynamic-extent args)) + x)) + +(defun complement (fn) + (lambda (&rest args) (not (apply fn args)))) + +(defun default-system-banner () + (let (gpled-modules) + (dolist (l '(:unexec :bfd :readline :xgcl)) + (when (member l *features*) + (push l gpled-modules))) + (format nil "GCL (GNU Common Lisp) ~a.~a.~a ~a ~a ~a git: ~a~%~a~%~a ~a~%~a~%~a~%~%~a~%" + *gcl-major-version* *gcl-minor-version* *gcl-extra-version* *gcl-release-date* + (if (member :ansi-cl *features*) "ANSI" "CLtL1") + (if (member :gprof *features*) "profiling" "") + *gcl-git-tag* + "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)" + "Binary License: " + (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules) + "LGPL") + "Modifications of this banner must retain notice of a compatible license" + "Dedicated to the memory of W. Schelter" + "Use (help) to get some basic information on how to use GCL."))) + + (defun lisp-implementation-version nil + (format nil "GCL ~a.~a.~a git tag ~a" + *gcl-major-version* + *gcl-minor-version* + *gcl-extra-version* + *gcl-git-tag*)) + +(defun objlt (x y) + (declare (object x y)) + (let ((x (address x)) (y (address y))) + (declare (fixnum x y)) + (if (< y 0) + (if (< x 0) (< x y) t) + (if (< x 0) nil (< x y))))) + +(defun reset-sys-paths (s) + (declare (string s)) + (setq *lib-directory* s) + (setq *system-directory* (string-concatenate s "unixport/")) + (let (nl) + (dolist (l '("cmpnew/" "gcl-tk/" "lsp/" "xgcl-2/")) + (push (string-concatenate s l) nl)) + (setq *load-path* nl)) + nil) + +(defun gprof-output (symtab gmon) + (with-open-file + (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon)) + (copy-stream s *standard-output*))) + +(defun write-symtab (symtab start end &aux (*package* (find-package "KEYWORD"))) + + (with-open-file + (s symtab :direction :output :if-exists :supersede) + + (format s "~16,'0x T ~a~%" start "GCL_MONSTART") + + (dolist (p (list-all-packages)) + (do-symbols (x p) + (when (and (eq (symbol-package x) p) (fboundp x)) + (let* ((y (symbol-function x)) + (y (if (and (consp y) (eq 'macro (car y))) (cdr y) y)) + (y (if (compiled-function-p y) (function-start y) 0))) + (when (<= start y end) + (format s "~16,'0x T ~s~%" y x)))))) + + (let ((string-register "")) + (dotimes (i (ptable-alloc-length)) + (multiple-value-bind + (x y) (ptable i string-register) + (when (<= start x end) + (format s "~16,'0x T ~a~%" x y))))) + + (format s "~16,'0x T ~a~%" end "GCL_MONEND")) + + symtab) + +(defun gprof-start (&optional (symtab "gcl_symtab") (adrs (gprof-addresses)) + &aux (start (car adrs))(end (cdr adrs))) + (let ((symtab (write-symtab symtab start end))) + (when (monstartup start end) + symtab))) + +(defun gprof-quit (&optional (symtab "gcl_symtab") &aux (gmon (mcleanup))) + (when gmon + (gprof-output symtab gmon))) + + + diff --git a/lsp/gcl_module.lsp b/lsp/gcl_module.lsp new file mode 100755 index 0000000..2962344 --- /dev/null +++ b/lsp/gcl_module.lsp @@ -0,0 +1,117 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; module.lsp +;;;; +;;;; module routines + + +(in-package :si) + + +(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) + + +(defvar *modules* nil) + + +(defun provide (module-name) + (setq *modules* + (adjoin (string module-name) + *modules* + :test #'string=))) + + +(defun require (module-name + &optional (pathname (string-downcase (string module-name)))) + (let ((*default-pathname-defaults* (make-pathname))) + (unless (member (string module-name) + *modules* + :test #'string=) + (if (atom pathname) + (load pathname) + (do ((p pathname (cdr p))) + ((endp p)) + (load (car p))))))) + + +(defun documentation (symbol doc-type) + (case doc-type + (variable (get symbol 'variable-documentation)) + (function (get symbol 'function-documentation)) + (structure (get symbol 'structure-documentation)) + (type (get symbol 'type-documentation)) + (setf (get symbol 'setf-documentation)) + (t + (if (packagep symbol) + (get (find-symbol (package-name symbol) :keyword) 'package-documentation) + (error "~S is an illegal documentation type." doc-type))))) + + +(defun find-documentation (body) + (if (or (endp body) (endp (cdr body))) + nil + (let ((form (macroexpand (car body)))) + (if (stringp form) + form + (if (and (consp form) + (eq (car form) 'declare)) + (find-documentation (cdr body)) + nil))))) + + +(defun eval-feature (x) + (cond ((atom x) + (member x *features* + :test #'(lambda (a b) + (cond ((symbolp a) + (and (symbolp b) + (string-equal (symbol-name a) + (symbol-name b)))) + (t (eql a b)))))) + ((eq (car x) 'and) + (dolist (x (cdr x) t) (unless (eval-feature x) (return nil)))) + ((eq (car x) 'or) + (dolist (x (cdr x) nil) (when (eval-feature x) (return t)))) + ((eq (car x) 'not) + (not (eval-feature (cadr x)))) + (t (error "~S is not a feature expression." x)))) + +(defun sharp-+-reader (stream subchar arg) + (declare (ignore subchar arg)) + (if (eval-feature (let ((*read-suppress* nil) (*read-base* 10.)) + (read stream t nil t))) + (values (read stream t nil t)) + (let ((*read-suppress* t)) (read stream t nil t) (values)))) + +(set-dispatch-macro-character #\# #\+ 'sharp-+-reader) +(set-dispatch-macro-character #\# #\+ 'sharp-+-reader + (si::standard-readtable)) + +(defun sharp---reader (stream subchar arg) + (declare (ignore subchar arg)) + (if (eval-feature (let ((*read-suppress* nil) (*read-base* 10.)) + (read stream t nil t))) + (let ((*read-suppress* t)) (read stream t nil t) (values)) + (values (read stream t nil t)))) + +(set-dispatch-macro-character #\# #\- 'sharp---reader) +(set-dispatch-macro-character #\# #\- 'sharp---reader + (si::standard-readtable)) + diff --git a/lsp/gcl_namestring.lsp b/lsp/gcl_namestring.lsp new file mode 100644 index 0000000..d575f36 --- /dev/null +++ b/lsp/gcl_namestring.lsp @@ -0,0 +1,39 @@ +(in-package :si) + +(defun namestring (x) + (declare (optimize (safety 1))) + (check-type x pathname-designator) + (typecase x + (string x) + (pathname (c-pathname-namestring x)) + (stream (namestring (c-stream-object1 x))))) + +(defun file-namestring (x &aux (px (pathname x))) + (declare (optimize (safety 1))) + (check-type x pathname-designator) + (namestring (make-pathname :name (pathname-name px) :type (pathname-type px) :version (pathname-version px)))) + +(defun directory-namestring (x &aux (px (pathname x))) + (declare (optimize (safety 1))) + (check-type x pathname-designator) + (namestring (make-pathname :directory (pathname-directory px)))) + +(defun host-namestring (x &aux (px (pathname x))) + (declare (optimize (safety 1))) + (check-type x pathname-designator) + (or (pathname-host px) "")) + +#.`(defun enough-namestring (x &optional (def *default-pathname-defaults*) &aux (px (pathname x))(pdef (pathname def))) + (declare (optimize (safety 1))) + (check-type x pathname-designator) + (check-type def pathname-designator) + ,(labels ((new? (k &aux (f (intern (string-concatenate "PATHNAME-" (string k)) :si))) + `(let ((k (,f px))) (unless (equal k (,f pdef)) k)))) + `(namestring (make-pathname + ,@(mapcan (lambda (x) (list x (new? x))) +pathname-keys+))))) + +(defun faslink (file name &aux (pfile (namestring (merge-pathnames (make-pathname :type "o") (pathname file))))(*package* *package*));FIXME + (declare (optimize (safety 1))) + (check-type file pathname-designator) + (check-type name string) + (faslink-int pfile name)) diff --git a/lsp/gcl_numlib.lsp b/lsp/gcl_numlib.lsp new file mode 100755 index 0000000..e05d138 --- /dev/null +++ b/lsp/gcl_numlib.lsp @@ -0,0 +1,280 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; numlib.lsp +;;;; +;;;; number routines + + +(in-package :si) + + +(proclaim '(optimize (safety 2) (space 3))) + + +(defconstant imag-one #C(0.0d0 1.0d0)) + + +(defun isqrt (i) + (unless (and (integerp i) (>= i 0)) + (error "~S is not a non-negative integer." i)) + (if (zerop i) + 0 + (let ((n (integer-length i))) + (do ((x (ash 1 (ceiling n 2))) + (y)) + (nil) + (setq y (floor i x)) + (when (<= x y) + (return x)) + (setq x (floor (+ x y) 2)))))) + + +(defun abs (z) + (cond ((complexp z) + ;; Compute (sqrt (+ (* x x) (* y y))) carefully to prevent + ;; overflow! + (let* ((x (abs (realpart z))) + (y (abs (imagpart z)))) + (if (< x y) + (rotatef x y)) + (if (zerop x) + x + (let ((r (/ y x))) + (* x (sqrt (+ 1 (* r r)))))))) + (t ; Should this be (realp z) instead of t? + (if (minusp z) + (- z) + z)))) + + +(defun phase (x) + (atan (imagpart x) (realpart x))) + +(defun signum (x) (if (zerop x) x (/ x (abs x)))) + +(defun cis (x) (exp (* imag-one x))) + +(defun real-asinh (x) + (declare (real x)) + (float (log (+ x (sqrt (+ 1.0 (* x x))))) (float x))) + +(defun asin (z) + (declare (optimize (safety 1))) + (check-type z number) + (if (unless (complexp z) (<= -1 z 1)) + (atan z (sqrt (- 1 (* z z)))) + (let* ((a (sqrt (- 1 z))) + (b (sqrt (+ 1 z)))) + (complex (atan (realpart z) (realpart (* a b))) + (real-asinh (imagpart (* (conjugate a) b))))))) + +(defun acos (z) + (declare (optimize (safety 1))) + (check-type z number) + (if (unless (complexp z) (<= -1 z 1)) + (* 2 (atan (- 1 z) (sqrt (- 1 (* z z))))) + (let* ((a (sqrt (- 1 z))) + (b (sqrt (+ 1 z)))) + (complex (* 2 (atan (realpart a) (realpart b))) + (real-asinh (imagpart (* (conjugate b) a))))))) + +(defun asinh (x) + (declare (optimize (safety 1))) + (check-type x number) + (if (realp x) + (real-asinh x) + (let* ((r (asin (complex (- (imagpart x)) (realpart x))))) + (complex (imagpart r) (- (realpart r)))))) + +(defun acosh (z) + (declare (optimize (safety 1))) + (check-type z number) + (if (unless (complexp z) (>= z 1)) + (real-asinh (sqrt (- (* z z) 1))) + (let* ((a (sqrt (- z 1))) + (b (sqrt (+ z 1)))) + (complex (real-asinh (realpart (* (conjugate a) b))) (* 2 (atan (imagpart a) (realpart b))))))) + +(defun atanh (x) + (declare (optimize (safety 1))) + (check-type x number) + (if (unless (complexp x) (< -1 x 1)) + (/ (log (/ (+ 1 x) (- 1 x))) 2) + (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) + + +(defun sinh (z) + (cond ((complexp z) + ;; For complex Z, compute the real and imaginary parts + ;; separately to get better precision. + (let ((x (realpart z)) + (y (imagpart z))) + (complex (* (sinh x) (cos y)) + (* (cosh x) (sin y))))) + (t ; Should this be (realp z) instead of t? + (let ((limit #.(expt (* double-float-epsilon 45/2) 1/5))) + (if (< (- limit) z limit) + ;; For this region, write use the fact that sinh z = + ;; z*exp(z)*[(1 - exp(-2z))/(2z)]. Then use the first + ;; 4 terms in the Taylor series expansion of + ;; (1-exp(-2z))/2/z. series expansion of (1 - + ;; exp(2*x)). This is needed because there is severe + ;; roundoff error calculating (1 - exp(-2z)) for z near + ;; 0. + (* z (exp z) + (- 1 (* z + (- 1 (* z + (- 2/3 (* z + (- 1/3 (* 2/15 z))))))))) + (let ((e (exp z))) + (* 1/2 (- e (/ e))))))))) + +;(defun sinh (x) (/ (- (exp x) (exp (- x))) 2.0d0)) + +(defun cosh (z) + (cond ((complexp z) + ;; For complex Z, compute the real and imaginary parts + ;; separately to get better precision. + (let ((x (realpart z)) + (y (imagpart z))) + (complex (* (cosh x) (cos y)) + (* (sinh x) (sin y))))) + (t ; Should this be (realp z) instead of t? + ;; For real Z, there's no chance of round-off error, so + ;; direct evaluation is ok. + (let ((e (exp z))) + (* 1/2 (+ e (/ e))))))) +;(defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0d0)) +(defun tanh (x) (/ (sinh x) (cosh x))) + + +(defun rational (x) + (etypecase x + (float + (multiple-value-bind (i e s) (integer-decode-float x) + (if (>= s 0) + (* i (expt (float-radix x) e)) + (- (* i (expt (float-radix x) e)))))) + (rational x))) + + +(setf (symbol-function 'rationalize) (symbol-function 'rational)) + +;; although the following is correct code in that it approximates the +;; x to within eps, it does not preserve (eql (float (rationalize x) x) x) +;; since the test for eql is more strict than the float-epsilon + +;;; Rationalize originally by Skef Wholey. +;;; Obtained from Daniel L. Weinreb. +;(defun rationalize (x) +; (typecase x +; (rational x) +; (short-float (rationalize-float x short-float-epsilon 1.0s0)) +; (long-float (rationalize-float x long-float-epsilon 1.0d0)) +; (otherwise (error "~S is neither rational nor float." x)))) +; +;(defun rationalize-float (x eps one) +; (cond ((minusp x) (- (rationalize (- x)))) +; ((zerop x) 0) +; (t (let ((y ()) +; (a ())) +; (do ((xx x (setq y (/ one +; (- xx (float a x))))) +; (num (setq a (truncate x)) +; (+ (* (setq a (truncate y)) num) onum)) +; (den 1 (+ (* a den) oden)) +; (onum 1 num) +; (oden 0 den)) +; ((and (not (zerop den)) +; (not (> (abs (/ (- x (/ (float num x) +; (float den x))) +; x)) +; eps))) +; (/ num den))))))) + + +(defun ffloor (x &optional (y 1.0s0)) + (multiple-value-bind (i r) (floor (float x) (float y)) + (values (float i r) r))) + +(defun fceiling (x &optional (y 1.0s0)) + (multiple-value-bind (i r) (ceiling (float x) (float y)) + (values (float i r) r))) + +(defun ftruncate (x &optional (y 1.0s0)) + (multiple-value-bind (i r) (truncate (float x) (float y)) + (values (float i r) r))) + +(defun fround (x &optional (y 1.0s0)) + (multiple-value-bind (i r) (round (float x) (float y)) + (values (float i r) r))) + + +(defun lognand (x y) (boole boole-nand x y)) +(defun lognor (x y) (boole boole-nor x y)) +(defun logandc1 (x y) (boole boole-andc1 x y)) +(defun logandc2 (x y) (boole boole-andc2 x y)) +(defun logorc1 (x y) (boole boole-orc1 x y)) +(defun logorc2 (x y) (boole boole-orc2 x y)) + +(defun lognot (x) (logxor -1 x)) +(defun logtest (x y) (not (zerop (logand x y)))) + + +(defun byte (size position) + (cons size position)) + +(defun byte-size (bytespec) + (car bytespec)) + +(defun byte-position (bytespec) + (cdr bytespec)) + +;; (defun ldb (bytespec integer) +;; (logandc2 (ash integer (- (byte-position bytespec))) +;; (- (ash 1 (byte-size bytespec))))) + +;; (defun ldb-test (bytespec integer) +;; (not (zerop (ldb bytespec integer)))) + +;; (defun mask-field (bytespec integer) +;; (ash (ldb bytespec integer) (byte-position bytespec))) + +;; (defun dpb (newbyte bytespec integer) +;; (logxor integer +;; (mask-field bytespec integer) +;; (ash (logandc2 newbyte +;; (- (ash 1 (byte-size bytespec)))) +;; (byte-position bytespec)))) + +;; (defun deposit-field (newbyte bytespec integer) +;; (dpb (ash newbyte (- (byte-position bytespec))) bytespec integer)) + + +(defun ldb (bytespec integer) + (logand (ash integer (- (byte-position bytespec))) + (1- (ash 1 (byte-size bytespec))))) +(defun ldb-test (bytespec integer) + (not (zerop (ldb bytespec integer)))) +(defun dpb (newbyte bytespec integer &aux (z (1- (ash 1 (byte-size bytespec))))) + (logior (logandc2 integer (ash z (byte-position bytespec))) + (ash (logand newbyte z) (byte-position bytespec)))) +(defun deposit-field (newbyte bytespec integer &aux (z (ash (1- (ash 1 (byte-size bytespec))) (byte-position bytespec)))) + (logior (logandc2 integer z) (logand newbyte z))) diff --git a/lsp/gcl_packages.lsp b/lsp/gcl_packages.lsp new file mode 100755 index 0000000..8b13789 --- /dev/null +++ b/lsp/gcl_packages.lsp @@ -0,0 +1 @@ + diff --git a/lsp/gcl_packlib.lsp b/lsp/gcl_packlib.lsp new file mode 100755 index 0000000..8419871 --- /dev/null +++ b/lsp/gcl_packlib.lsp @@ -0,0 +1,218 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; packlib.lsp +;;;; +;;;; package routines + + +(in-package :si) + + +(proclaim '(optimize (safety 2) (space 3))) + + +(defmacro coerce-to-package (p) + (if (eq p '*package*) + p + (let ((g (gensym))) + `(let ((,g ,p)) + (if (packagep ,g) + ,g + (find-package (string ,g))))))) + +(defun find-all-symbols (string-or-symbol) + (when (symbolp string-or-symbol) + (setq string-or-symbol (symbol-name string-or-symbol))) + (mapcan #'(lambda (p) + (multiple-value-bind (s i) + (find-symbol string-or-symbol p) + (if (or (eq i :internal) (eq i :external)) + (list s) + nil))) + (list-all-packages))) + + +(defmacro do-symbols ((var &optional (package '*package*) (result-form nil)) + . body) + (let ((p (gensym)) (i (gensym)) (l (gensym)) (q (gensym)) + (loop (gensym)) (x (gensym))(y (gensym)) (break (gensym)) declaration) + (multiple-value-setq (declaration body) (find-declarations body)) + `(let ((,p (coerce-to-package ,package)) ,var ,l ) + ,@declaration + (dolist (,q (cons ,p (package-use-list ,p)) (progn (setq ,var nil) ,result-form)) + (multiple-value-bind + (,y ,x) (package-size ,q) + (declare (fixnum ,x ,y)) + (if (not (eq ,p ,q)) (setq ,x 0)) + (dotimes (,i (+ ,x ,y)) + (setq ,l (if (< ,i ,x) + (si:package-internal ,q ,i) + (si:package-external ,q (- ,i ,x)))) + ,loop + (when (null ,l) (go ,break)) + (setq ,var (car ,l)) + (if (or (eq ,q ,p) + (eq :inherited (car (last (multiple-value-list + (find-symbol (symbol-name ,var) ,p)))))) + (tagbody ,@body)) + (setq ,l (cdr ,l)) + (go ,loop) + ,break)))))) + + +(defmacro do-external-symbols + ((var &optional (package '*package*) (result-form nil)) . body) + (let ((p (gensym)) (i (gensym)) (l (gensym)) + (loop (gensym)) (break (gensym)) declaration) + (multiple-value-setq (declaration body) + (find-declarations body)) + `(let ((,p (coerce-to-package ,package)) ,var ,l) + + ,@declaration + (dotimes (,i (package-size ,p) (progn (setq ,var nil) ,result-form)) + (setq ,l (si:package-external ,p ,i)) + ,loop + (when (null ,l) (go ,break)) + (setq ,var (car ,l)) + ,@body + (setq ,l (cdr ,l)) + (go ,loop) + ,break)))) + +(defmacro do-all-symbols((var &optional (result-form nil)) . body) + `(dolist (.v (list-all-packages) ,result-form) + (do-symbols (,var .v) + (tagbody ,@ body)))) + + +(defun substringp (sub str) + (do ((i (- (length str) (length sub))) + (l (length sub)) + (j 0 (1+ j))) + ((> j i) nil) + (when (string-equal sub str :start2 j :end2 (+ j l)) + (return t)))) + + +(defun print-symbol-apropos (symbol) + (prin1 symbol) + (when (fboundp symbol) + (if (special-operator-p symbol) + (princ " Special form") + (if (macro-function symbol) + (princ " Macro") + (princ " Function")))) + (when (boundp symbol) + (if (constantp symbol) + (princ " Constant: ") + (princ " has value: ")) + (prin1 (symbol-value symbol))) + (terpri)) + + +;(defun apropos (string &optional package) +; (setq string (string string)) +; (cond (package +; (do-symbols (symbol package) +; (when (substringp string (string symbol)) +; (print-symbol-apropos symbol))) +; (do ((p (package-use-list package) (cdr p))) +; ((null p)) +; (do-external-symbols (symbol (car p)) +; (when (substringp string (string symbol)) +; (print-symbol-apropos symbol))))) +; (t +; (do-all-symbols (symbol) +; (when (substringp string (string symbol)) +; (print-symbol-apropos symbol))))) +; (values)) + + +(defun apropos-list (string &optional package &aux list) + (setq list nil) + (setq string (string string)) + (cond (package + (do-symbols (symbol package) + (when (substringp string (string symbol)) + (setq list (cons symbol list)))) + (do ((p (package-use-list package) (cdr p))) + ((null p)) + (do-external-symbols (symbol (car p)) + (when (substringp string (string symbol)) + (setq list (cons symbol list)))))) + (t + (do-all-symbols (symbol) + (when (substringp string (string symbol)) + (setq list (cons symbol list)))))) + (stable-sort (delete-duplicates list :test #'eq) + #'string< :key #'symbol-name)) + +(defun apropos (string &optional package) + (dolist (symbol (apropos-list string package)) + (print-symbol-apropos symbol)) + (values)) + +(defmacro with-package-iterator ((name plist &rest symbol-types) . body) + (let ((p (gensym)) (i (gensym)) (l (gensym)) (q (gensym)) (dum (gensym)) + (x (gensym))(y (gensym)) (access (gensym)) declaration) + (multiple-value-setq (declaration body) (si::find-declarations body)) + (if (null symbol-types) + (error 'program-error :format-control "Symbol type specifiers must be supplied")) + `(let ((,p (cons t (if (atom ,plist) (list ,plist) ,plist))) (,q nil) (,l nil) + (,i -1) (,x 0) (,y 0) (,dum nil) (,access nil)) + (declare (fixnum ,x ,y)) + (flet ((,name () + (tagbody ,name + (when (null (setq ,l (cdr ,l))) + (when (eql (incf ,i) (+ ,x ,y)) + (when (null (setq ,q (cdr ,q))) + (when (null (setq ,p (cdr ,p))) + (return-from ,name nil)) + (rplaca ,p (coerce-to-package (car ,p))) + (setq ,q (list + (si::coerce-to-package (car ,p)))) + (when (member :inherited (list ,@symbol-types)) + (rplacd ,q (package-use-list (car ,q))))) + (multiple-value-setq (,y ,x) (si::package-size (car ,q))) + (when (or (not (member :internal (list ,@symbol-types))) + (not (eq (car ,p) (car ,q)))) + (setq ,x 0)) + (when (and (not (member :external (list ,@symbol-types))) + (eq (car ,p) (car ,q))) + (setq ,y 0)) + (when (zerop (+ ,x ,y)) + (setq ,i -1) + (go ,name)) + (setq ,i 0)) + (setq ,l (if (< ,i ,x) + (si::package-internal (car ,q) ,i) + (si::package-external (car ,q) (- ,i ,x))))) + (when (null ,l) + (go ,name)) + (multiple-value-setq (,dum ,access) + (find-symbol + (symbol-name (car ,l)) (car ,p))) + (when (and (not (eq ,access :inherited)) + (not (eq (car ,p) (car ,q)))) + (go ,name))) + (values 't (car ,l) ,access (car ,p)))) + ,@declaration + ,@body)))) + diff --git a/lsp/gcl_parse_namestring.lsp b/lsp/gcl_parse_namestring.lsp new file mode 100644 index 0000000..4463488 --- /dev/null +++ b/lsp/gcl_parse_namestring.lsp @@ -0,0 +1,123 @@ +(in-package :si) + +(deftype seqind nil `fixnum) + +(defun dir-conj (x) (if (eq x :relative) :absolute :relative)) + +(defvar *up-key* :up) + +(defun element (x b i key &optional def) + (let* ((z (if (> i b) (subseq x b i) def));(make-array (- i b) :element-type 'character :displaced-to x :displaced-index-offset b) + (w (assoc key '((:host . nil) + (:device . nil) + (:directory . ((".." . :up)("*" . :wild)("**" . :wild-inferiors))) + (:name . (("*" . :wild))) + (:type . (("*" . :wild))) + (:version . (("*" . :wild)("NEWEST" . :newest)))))) + (w (assoc z (cdr w) :test 'string-equal)) + (z (if w (cdr w) z))) + (if (eq z :up) *up-key* z))) + +(defun dir-parse (x &optional lp (b 0)) + (when (stringp x) + (let ((i (string-match (if lp #v";" +dirsep+) x b))) + (unless (minusp i) + (let ((y (cons (element x b i :directory "") (dir-parse x lp (1+ i))))) + (if (zerop b) + (if (if lp (plusp i) (zerop i)) + (cons :absolute (cdr y)) + (cons :relative y)) + y)))))) + +(defun match-component (x i k &optional (boff 0) (eoff 0)) + (element x (+ (match-beginning i) boff) (+ (match-end i) eoff) k)) + +(defun version-parse (x) + (typecase x + (string (when (plusp (length x)) (version-parse (parse-integer x)))) + (otherwise x))) + +(defconstant +generic-logical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +logical-pathname-defaults+)) t t))) + +(defun logical-pathname-parse (x &optional host def (b 0) (e (length x))) + (when *pathname-logical* ;;accelerator + (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) + (let ((mhost (match-component x 1 :host 0 -1))) + (when (and host mhost) + (unless (string-equal host mhost) + (error 'error :format-control "Host part of ~s does not match ~s" :format-arguments (list x host)))) + (let ((host (or host mhost (pathname-host def)))) + (when (logical-pathname-host-p host) + (make-pathname :host host + :device :unspecific + :name (match-component x 6 :name) + :type (match-component x 8 :type 1) + :version (version-parse (match-component x 11 :version 1)) + :directory (dir-parse (match-component x 2 :none) t);must be last + :namestring (when (and mhost (eql b 0) (eql e (length x))) x)))))))) + +(defconstant +generic-physical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +physical-pathname-defaults+)) t nil))) + +(defun expand-home-dir (dir) + (if (and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) + (prog1 (append (dir-parse (home-namestring (cadr dir))) (cddr dir)) (setq *canonicalized* t)) + dir)) + +(defun pathname-parse (x b e) + (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) + (make-pathname :device (match-component x 1 :none 0 -1) + :name (match-component x 4 :name) + :type (match-component x 5 :type 1) + :directory (dir-parse (match-component x 2 :none));must be last + :namestring (when (and (eql b 0) (eql e (length x))) x)))) + +(defun path-stream-name (x) + (check-type x pathname-designator) + (typecase x + (synonym-stream (path-stream-name (symbol-value (synonym-stream-symbol x)))) + (stream (path-stream-name (c-stream-object1 x))) + (otherwise x))) + +(defun parse-namestring (thing &optional host (default-pathname *default-pathname-defaults*) &rest r &key (start 0) end junk-allowed) + (declare (optimize (safety 1))(dynamic-extent r)) + (check-type thing pathname-designator) + (check-type host (or null (satisfies logical-pathname-translations))) + (check-type default-pathname pathname-designator) + (check-type start seqind) + (check-type end (or null seqind)) + + (typecase thing + (string (let* ((e (or end (length thing))) + (l (logical-pathname-parse thing host default-pathname start e)) + (l (or l (unless host (pathname-parse thing start e))))) + (cond (junk-allowed (values l (max 0 (match-end 0)))) + (l (values l e)) + ((error 'parse-error :format-control "~s is not a valid pathname on host ~s" :format-arguments (list thing host)))))) + (stream (apply 'parse-namestring (path-stream-name thing) host default-pathname r)) + (pathname + (when host + (unless (string-equal host (pathname-host thing)) + (error 'file-error :pathname thing :format-control "Host does not match ~s" :format-arguments (list host)))) + (values thing start)))) + +(defun pathname (spec) + (declare (optimize (safety 1))) + (check-type spec pathname-designator) + (if (typep spec 'pathname) spec (values (parse-namestring spec)))) + +(defun sharp-p-reader (stream subchar arg) + (declare (ignore subchar arg)) + (let ((x (parse-namestring (read stream)))) x)) + +(defun sharp-dq-reader (stream subchar arg);FIXME arg && read-suppress + (declare (ignore subchar arg)) + (unread-char #\" stream) + (let ((x (parse-namestring (read stream)))) x)) + +(set-dispatch-macro-character #\# #\p 'sharp-p-reader) +(set-dispatch-macro-character #\# #\p 'sharp-p-reader (standard-readtable)) +(set-dispatch-macro-character #\# #\P 'sharp-p-reader) +(set-dispatch-macro-character #\# #\P 'sharp-p-reader (standard-readtable)) +(set-dispatch-macro-character #\# #\" 'sharp-dq-reader) +(set-dispatch-macro-character #\# #\" 'sharp-dq-reader (standard-readtable)) + diff --git a/lsp/gcl_pathname_match_p.lsp b/lsp/gcl_pathname_match_p.lsp new file mode 100644 index 0000000..242cdef --- /dev/null +++ b/lsp/gcl_pathname_match_p.lsp @@ -0,0 +1,14 @@ +(in-package :si) + +(defun to-regexp (x &optional (rp t) &aux (px (pathname x))(lp (typep px 'logical-pathname))) + (to-regexp-or-namestring (mlp px) rp lp)) + +(deftype compiled-regexp nil `(vector unsigned-char)) + +(defun pathname-match-p (p w &aux (s (namestring p))) + (declare (optimize (safety 1))) + (check-type p pathname-designator) + (check-type w (or compiled-regexp pathname-designator)) + (and (zerop (string-match (if (typep w 'compiled-regexp) w (to-regexp w)) s)) + (eql (match-end 0) (length s)))) + diff --git a/lsp/gcl_predlib.lsp b/lsp/gcl_predlib.lsp new file mode 100755 index 0000000..c1e2c09 --- /dev/null +++ b/lsp/gcl_predlib.lsp @@ -0,0 +1,839 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; predlib.lsp +;;;; +;;;; predicate routines + + +(in-package :si) + +(eval-when (compile) +(proclaim '(optimize (safety 2) (space 3))) +) + +;;; DEFTYPE macro. +(defmacro deftype (name lambda-list &rest body) + ;; Replace undefaultized optional parameter X by (X '*). + (do ((l lambda-list (cdr l)) + (m nil (cons (car l) m))) + ((null l)) + (when (member (car l) lambda-list-keywords) + (unless (eq (car l) '&optional) (return nil)) + (setq m (cons '&optional m)) + (setq l (cdr l)) + (do () + ((or (null l) (member (car l) lambda-list-keywords))) + (if (symbolp (car l)) + (setq m (cons (list (car l) ''*) m)) + (setq m (cons (car l) m))) + (setq l (cdr l))) + (setq lambda-list (nreconc m l)) + (return nil))) + `(eval-when (compile eval load) + (si:putprop ',name + '(deftype ,name ,lambda-list ,@body) + 'deftype-form) + (si:putprop ',name + #'(lambda ,lambda-list ,@body) + 'deftype-definition) + (si:putprop ',name + ,(find-documentation body) + 'type-documentation) + ',name)) + + +;;; Some DEFTYPE definitions. +(deftype string-stream nil `(or (satisfies string-input-stream-p) (satisfies string-output-stream-p))) +(deftype spice nil `(satisfies spice-p)) +(deftype fixnum () + `(integer ,most-negative-fixnum ,most-positive-fixnum)) +(deftype bit () '(integer 0 1)) +(deftype mod (n) + `(integer 0 ,(1- n))) +(deftype signed-byte (&optional s) + (if (eq s '*) + `(integer * *) + `(integer ,(- (expt 2 (1- s))) ,(1- (expt 2 (1- s)))))) +(deftype unsigned-byte (&optional s) + (if (eq s '*) + `(integer 0 *) + `(integer 0 ,(1- (expt 2 s))))) +(deftype signed-char ()`(signed-byte ,char-size)) +(deftype unsigned-char ()`(unsigned-byte ,char-size)) +(deftype signed-short ()`(signed-byte ,short-size)) +(deftype unsigned-short ()`(unsigned-byte ,short-size)) + + + +(deftype vector (&optional element-type size) + `(array ,element-type (,size))) +(deftype string (&optional size) + `(vector character ,size)) +(deftype base-string (&optional size) + `(vector base-char ,size)) +(deftype bit-vector (&optional size) + `(vector bit ,size)) + +(deftype simple-vector (&optional size) + `(simple-array t (,size))) +(deftype simple-string (&optional size) + `(simple-array character (,size))) +(deftype simple-base-string (&optional size) + `(simple-array base-char (,size))) +(deftype simple-bit-vector (&optional size) + `(simple-array bit (,size))) + + + +(defun simple-array-p (x) + (and (arrayp x) + ;; should be (not (expressly-adjustable-p x)) + ;; since the following will always return T + ;; (not (adjustable-array-p x)) + (not (array-has-fill-pointer-p x)) + (not (si:displaced-array-p x)))) + +(defun logical-pathnamep (x) (when (pathnamep x) (eql (c-t-tt x) 1))) + +(do ((l '((null . null) + (symbol . symbolp) + (keyword . keywordp) + (atom . atom) + (cons . consp) + (list . listp) + (fixnum . fixnump) + (integer . integerp) + (rational . rationalp) + (number . numberp) + (character . characterp) + (package . packagep) + (stream . streamp) + (string-input-stream . string-input-stream-p) + (string-output-stream . string-output-stream-p) + (file-stream . file-stream-p) + (synonym-stream . synonym-stream-p) + (broadcast-stream . broadcast-stream-p) + (concatenated-stream . concatenated-stream-p) + (two-way-stream . two-way-stream-p) + (echo-stream . echo-stream-p) + (pathname . pathnamep) + (pathname-designator . pathname-designatorp) + (logical-pathname . logical-pathnamep) + (readtable . readtablep) + (hash-table . hash-table-p) + (random-state . random-state-p) + (structure . si:structurep) + (function . functionp) + (vector . vectorp) + (bit-vector . bit-vector-p) + (array . arrayp) + (string . stringp) + (float . floatp) + (complex . complexp) + (real . realp) + (simple-array . simple-array-p) + (simple-vector . simple-vector-p) + (simple-string . simple-string-p) + (simple-bit-vector . simple-bit-vector-p) + (compiled-function . compiled-function-p) + (common . commonp) + ) + (cdr l))) + ((endp l)) + (si:putprop (caar l) (cdar l) 'type-predicate) + (si:putprop (cdar l) (caar l) 'predicate-type)) + + +(eval-when + (compile eval) + (defmacro clh nil + `(progn + ,@(mapcar (lambda (x &aux (f (when (equal x "FIND-CLASS") `(&optional ep))) (z (intern (string-concatenate "SI-" x)))) + `(defun ,z (o ,@f &aux e (x (find-symbol ,x :user))) + (cond ((and x (fboundp x) (fboundp (find-symbol "CLASSP" :user))) + (prog1 (funcall x o ,@(cdr f)) + (fset ',z (symbol-function x)))) + ((setq e (get ',z 'early)) (values (funcall e o ,@(cdr f))))))) + '("CLASSP" "CLASS-PRECEDENCE-LIST" "FIND-CLASS" "CLASS-OF" "CLASS-NAME"))))) +(clh) + +;; (defun class-of (object) +;; (declare (ignore object)) +;; nil) +;; (defun classp (object) +;; (declare (ignore object)) +;; nil) +;; (defun class-precedence-list (object) +;; (declare (ignore object)) +;; nil) +;; (defun find-class (object) +;; (declare (ignore object)) +;; nil) + +;;; TYPEP predicate. +;;; FIXME --optimize with most likely cases first +(defun typep (object type &optional env &aux tp i tem) + (declare (ignore env)) + (if (atom type) + (setq tp type i nil) + (setq tp (car type) i (cdr type))) + (if (eq tp 'structure-object) (setq tp 'structure)) + (case tp + (member (member object i)) + (not (not (typep object (car i)))) + (or + (do ((l i (cdr l))) + ((null l) nil) + (when (typep object (car l)) (return t)))) + (and + (do ((l i (cdr l))) + ((null l) t) + (unless (typep object (car l)) (return nil)))) + (satisfies (funcall (car i) object)) + (eql (eql (car i) object)) + (member (member object i)) + ((t) t) + ((nil) nil) + (boolean (or (eq object 't) (eq object 'nil))) + (fixnum (eq (type-of object) 'fixnum)) + (bignum (eq (type-of object) 'bignum)) + (ratio (eq (type-of object) 'ratio)) + (standard-char + (and (characterp object) (standard-char-p object))) + ((base-char character) + (characterp object)) + (integer + (and (integerp object) (in-interval-p object i))) + (rational + (and (rationalp object) (in-interval-p object i))) + (real + (and (realp object) (in-interval-p object i))) + (float + (and (floatp object) (in-interval-p object i))) + ((short-float) + (and (eq (type-of object) 'short-float) (in-interval-p object i))) + ((single-float double-float long-float) + (and (eq (type-of object) 'long-float) (in-interval-p object i))) + (complex + (and (complexp object) + (or (null i) + (and (typep (realpart object) (car i)) + ;;wfs--should only have to check one. + ;;Illegal to mix real and imaginary types! + (typep (imagpart object) (car i)))) + )) + (sequence (or (listp object) (vectorp object))) + ((base-string string) ;FIXME + (and (stringp object) + (or (endp i) (match-dimensions (array-dimensions object) i)))) + (bit-vector + (and (bit-vector-p object) + (or (endp i) (match-dimensions (array-dimensions object) i)))) + ((simple-base-string simple-string) ;FIXME + (and (simple-string-p object) + (or (endp i) (match-dimensions (array-dimensions object) i)))) + (simple-bit-vector + (and (simple-bit-vector-p object) + (or (endp i) (match-dimensions (array-dimensions object) i)))) + (simple-vector + (and (simple-vector-p object) + (or (endp i) + (and (not (stringp object)) (not (bit-vector-p object))) + (equal (best-array-element-type (array-element-type object)) t)) + (or (endp i) (match-dimensions (array-dimensions object) i)))) + (vector + (and (vectorp object) + (or (endp i) (eq (car i) '*) + (and (eq (car i) t) (not (stringp object)) (not (bit-vector-p object))) + (equal (array-element-type object) (best-array-element-type (car i)))) + (or (endp (cdr i)) (match-dimensions (array-dimensions object) (cdr i))))) + (simple-array + (and (simple-array-p object) + (or (endp i) (eq (car i) '*) + (equal (array-element-type object) (best-array-element-type (car i)))) + (or (endp (cdr i)) (eq (cadr i) '*) + (if (listp (cadr i)) + (match-dimensions (array-dimensions object) (cadr i)) + (eql (array-rank object) (cadr i)))))) + (array + (and (arrayp object) + (or (endp i) (eq (car i) '*) + ;; Or the element type of object should be EQUAL to (car i). + ;; Is this too strict? + (equal (array-element-type object) (best-array-element-type (car i)))) + (or (endp (cdr i)) (eq (cadr i) '*) + (if (listp (cadr i)) + (match-dimensions (array-dimensions object) (cadr i)) + (eql (array-rank object) (cadr i)))))) + (t + (cond ((si-classp tp) + (if (member type (si-class-precedence-list (si-class-of object))) t nil)) + ((setq tem (if (structurep tp) tp (get tp 'si::s-data))) + (structure-subtype-p object tem)) + ((setq tem (get tp 'type-predicate)) + (funcall tem object)) + ((setq tem (get tp 'deftype-definition)) + (typep object (apply tem i))))))) + + + +(defun minmax (i1 i2 low-p e &aux (fn (if low-p (if e '< '>) (if e '> '<)))) + (cond ((eq i1 '*) (if e i1 i2)) + ((eq i2 '*) (if e i2 i1)) + ((funcall fn i1 i2) i1) + (i2))) + +(defun expand-range (low high bottom top) + (let ((low (minmax low bottom t t))(high (minmax high top nil t))) + (when (or (eq low '*) (eq high '*) (<= low high)) (list low high)))) + +(defun nc (tp) + (when (consp tp) + (case (car tp) + ;; (immfix (let ((m (cadr tp))(x (caddr tp)) + ;; (list (list 'integer (if (eq m '*) most-negative-immfix m) (if (eq x '*) most-positive-immfix x))))) + ;; (bfix (let* ((m (cadr tp))(x (caddr tp))(m (if (eq m '*) most-negative-fixnum m))(x (if (eq x '*) most-positive-fixnum x))) + ;; (if (< (* m x) 0) + ;; `((integer ,m ,(1- most-negative-immfix))(integer ,(1+ most-positive-immfix) ,x)) + ;; `((integer ,m ,x))))) + ;; (bignum (let* ((m (cadr tp))(x (caddr tp))(sm (or (eq m '*) (< m 0)))(sx (or (eq x '*) (>= x 0)))) + ;; (if (and sm sx) + ;; `((integer ,m ,(1- most-negative-fixnum))(integer ,(1+ most-positive-fixnum) ,x)) + ;; `((integer ,m ,x))))) + ((integer ratio short-float long-float) (list tp)) + (otherwise (append (nc (car tp)) (nc (cdr tp))))))) + + +(defun expand-ranges (type) + (reduce (lambda (y x &aux (z (assoc (car x) y))) + (if z (subst (cons (car z) (apply 'expand-range (cadr x) (caddr x) (cdr z))) z y) + (cons x y))) (nc type) :initial-value nil)) + + +;;; NORMALIZE-TYPE normalizes the type using the DEFTYPE definitions. +;;; The result is always a list. +(defun normalize-type (type &aux tp i ) + ;; Loops until the car of type has no DEFTYPE definition. + (when (and (consp type) (eq (car type) 'satisfies)) + (when (setq tp (get (cadr type) 'predicate-type)) + (setq type tp))) + (loop + (if (atom type) + (setq tp type i nil) + (setq tp (car type) i (cdr type))) + (cond ((si-classp tp) (return-from normalize-type (list (si-class-name tp)))) + ((get tp 'deftype-definition) (setq type (apply (get tp 'deftype-definition) i))) + ((return-from normalize-type (if (atom type) (list type) type)))))) + + +;;; KNOWN-TYPE-P answers if the given type is a known base type. +;;; The type may not be normalized. +;; FIXME this needs to be more robust +(defun known-type-p (type) + (when (consp type) (setq type (car type))) + (if (or (member type + '(t nil boolean null symbol keyword atom cons list sequence + signed-char unsigned-char signed-short unsigned-short + number integer bignum rational ratio float method-combination + short-float single-float double-float long-float complex + character standard-char character real + package stream pathname readtable hash-table random-state + structure array simple-array function compiled-function + arithmetic-error base-char base-string broadcast-stream + built-in-class cell-error class concatenated-stream condition + control-error division-by-zero echo-stream end-of-file error + extended-char file-error file-stream floating-point-inexact + floating-point-invalid-operation floating-point-overflow + floating-point-underflow generic-function logical-pathname method + package-error parse-error print-not-readable program-error + reader-error serious-condition simple-base-string simple-condition + simple-type-error simple-warning standard-class + standard-generic-function standard-method standard-object + storage-condition stream-error string-stream structure-class + style-warning synonym-stream two-way-stream structure-object + type-error unbound-slot unbound-variable undefined-function + warning) :test 'eq) + (get type 's-data) + (equal (string type) "ERROR")) + t + nil)) + + +;;; SUBTYPEP predicate. +(defun subtypep (type1 type2 &optional env &aux t1 t2 i1 i2 ntp1 ntp2 tem) + (declare (ignore env)) + (let ((c1 (si-classp type1)) (c2 (si-classp type2))) + (when (and c1 c2) + (return-from subtypep + (if (member type2 (si-class-precedence-list type1)) + (values t t) (values nil t)))) + (when (and c1 (or (eq type2 'structure-object) (eq type2 'standard-object))) + (return-from subtypep + (if (member (si-find-class type2) (si-class-precedence-list type1)) + (values t t) (values nil t)))) + (when (or c1 c2) + (return-from subtypep (values nil t)))) + (setq type1 (normalize-type type1)) + (setq type2 (normalize-type type2)) + (when (equal type1 type2) + (return-from subtypep (values t t))) + (setq t1 (car type1) t2 (car type2)) + (setq i1 (cdr type1) i2 (cdr type2)) + (cond ((eq t1 'member) + (dolist (e i1) + (unless (typep e type2) (return-from subtypep (values nil t)))) + (return-from subtypep (values t t))) + ((eq t1 'or) + (dolist (tt i1) + (multiple-value-bind (tv flag) (subtypep tt type2) + (unless tv (return-from subtypep (values tv flag))))) + (return-from subtypep (values t t))) + ((eq t1 'and) + (dolist (tt i1) + (let ((tv (subtypep tt type2))) + (when tv (return-from subtypep (values t t))))) + (return-from subtypep (values nil nil))) + ((eq t1 'not) + ;; + (return-from subtypep + (if (eq t2 'not) + (subtypep (car i2) (car i1)) + (subtypep t `(or ,type2 ,(car i1))))))) + (cond ((eq t2 'member) + (return-from subtypep (values nil nil))) + ((eq t2 'or) + (dolist (tt i2) + (let ((tv (subtypep type1 tt))) + (when tv (return-from subtypep (values t t))))) + (return-from subtypep (values nil nil))) + ((eq t2 'and) + (dolist (tt i2) + (multiple-value-bind (tv flag) (subtypep type1 tt) + (unless tv (return-from subtypep (values tv flag))))) + (return-from subtypep (values t t))) + ((eq t2 'not) + (return-from subtypep (subtypep `(and ,type1 ,(car i2)) nil)))) + + (setq ntp1 (known-type-p type1) ntp2 (known-type-p type2)) + (cond ((or (eq t1 'nil) (eq t2 't) (eq t2 'common)) (values t t)) + ((eq t2 'nil) (values nil ntp1)) + ((eq t1 't) (values nil ntp2)) + ((eq t1 'common) (values nil ntp2)) + ((eq t2 'list) + (cond ((member t1 '(null cons)) (values t t)) + (t (values nil ntp1)))) + ((eq t2 'sequence) + (cond ((member t1 '(null cons list)) + (values t t)) + ((or (eq t1 'simple-array) (eq t1 'array)) + (if (and (cdr i1) (consp (cadr i1)) (null (cdadr i1))) + (values t t) + (values nil t))) + (t (values nil ntp1)))) + ((eq t1 'list) (values nil ntp2)) + ((eq t1 'sequence) (values nil ntp2)) + ((eq t2 'atom) + (cond ((member t1 '(cons list)) (values nil t)) + (ntp1 (values t t)) + (t (values nil nil)))) + ((eq t1 'atom) (values nil ntp2)) + ((eq t2 'symbol) + (if (member t1 '(keyword boolean null)) + (values t t) + (values nil ntp1))) + ((eq t2 'function) + (if (member t1 '(compiled-function generic-function standard-generic-function)) + (values t t) + (values nil ntp1))) + ((eq t2 'generic-function) + (if (eq t1 'standard-generic-function) + (values t t) + (values nil ntp1))) + ((eq t2 'boolean) + (if (eq t1 'null) + (values t t) + (values nil ntp1))) + ((eq t2 'standard-object) + (if (member t1 '(class built-in-class structure-class standard-class + method standard-method)) + (values t t) + (values nil ntp1))) + ((eq t2 'class) + (if (member t1 '(built-in-class structure-class standard-class )) + (values t t) + (values nil ntp1))) + ((eq t2 'condition) + (if (or (equal (string t1) "ERROR") + (member t1 '(serious-condition error type-error simple-type-error + parse-error cell-error unbound-slot + warning style-warning storage-condition + simple-warning unbound-variable control-error + program-error undefined-function + package-error arithmetic-error + division-by-zero simple-condition + floating-point-invalid-operation + floating-point-inexact + floating-point-overflow + floating-point-underflow + file-error stream-error end-of-file + print-not-readable + reader-error))) + (values t t) + (values nil ntp1))) + ((eq t2 'serious-condition) + (if (or (equal (string t1) "ERROR") + (member t1 '( error type-error simple-type-error + parse-error cell-error unbound-slot + storage-condition + unbound-variable control-error + program-error undefined-function + package-error arithmetic-error + division-by-zero simple-type-error + floating-point-invalid-operation + floating-point-inexact + floating-point-overflow + floating-point-underflow + file-error stream-error end-of-file + print-not-readable + reader-error))) + (values t t) + (values nil ntp1))) + ((eq t2 'type-error) + (if (eq t1 'simple-type-error) + (values t t) + (values nil ntp1))) + ((eq t2 'parse-error) + (if (eq t1 'reader-error) + (values t t) + (values nil ntp1))) + ((eq t2 'stream-error) + (if (member t1 '(reader-error end-of-file)) + (values t t) + (values nil ntp1))) + ((or (equal (string t2) "ERROR") (eq t2 'error)) + (if (member t1 '(simple-type-error type-error + parse-error cell-error unbound-slot + unbound-variable control-error + program-error undefined-function + package-error arithmetic-error + division-by-zero simple-type-error + floating-point-invalid-operation + floating-point-inexact + floating-point-overflow + floating-point-underflow + file-error stream-error end-of-file print-not-readable + reader-error )) + (values t t) + (values nil ntp1))) + ((eq t2 'stream) + (if (member t1 '(broadcast-stream concatenated-stream echo-stream file-stream + string-stream synonym-stream two-way-stream)) + (values t t) + (values nil ntp1))) + ((eq t2 'pathname) + (if (eq t1 'logical-pathname) + (values t t) + (values nil ntp1))) + ((eq t2 'method) + (if (eq t1 'standard-method) + (values t t) + (values nil ntp1))) + ((eq t2 'simple-condition) + (if (member t1 '(simple-type-error simple-warning)) + (values t t) + (values nil ntp1))) + ((eq t2 'simple-condition) + (if (member t1 '(simple-type-error simple-warning)) + (values t t) + (values nil ntp1))) + ((eq t2 'cell-error) + (if (member t1 '(unbound-slot unbound-variable undefined-function)) + (values t t) + (values nil ntp1))) + ((eq t2 'warning) + (if (member t1 '(style-warning simple-warning)) + (values t t) + (values nil ntp1))) + ((eq t2 'arithmetic-error) + (if (member t1 '(division-by-zero + floating-point-invalid-operation + floating-point-inexact + floating-point-overflow + floating-point-underflow )) + (values t t) + (values nil ntp1))) + ((eq t2 'keyword) + (if (eq t1 'keyword) (values t t) (values nil ntp1))) + ((eq t2 'null) + (if (eq t1 'null) (values t t) (values nil ntp1))) + ((eq t2 'number) + (cond ((member t1 '(bignum integer ratio rational float real + short-float single-float double-float long-float + complex number)) + (values t t)) + (t (values nil ntp1)))) + ((eq t1 'number) (values nil ntp2)) + ((or (eq t2 'structure) (eq t2 'structure-object)) + (if (or (eq t1 'structure) (get t1 'si::s-data)) + (values t t) + (values nil ntp1))) + ((eq t1 'structure) (values nil ntp2)) + ((setq tem (get t1 'si::s-data)) + (let ((tem2 (get t2 'si::s-data))) + (cond (tem2 + (do ((tp1 tem (s-data-includes tp1)) (tp2 tem2)) + ((null tp1)(values nil t)) + (when (eq tp1 tp2) (return (values t t))))) + (t (values nil ntp2))))) + ((eq t2 'real) + (cond ((and + (member t1 '(fixnum integer bignum float short-float + single-float double-float long-float + real ratio + rational)) + (sub-interval-p i1 i2)) + (values t t)) + (t (values nil ntp1)))) + ((get t2 'si::s-data) (values nil ntp1)) + (t + (case t1 + (bignum + (case t2 + (bignum (values t t)) + ((integer rational) + (if (sub-interval-p '(* *) i2) + (values t t) + (values nil t))) + (t (values nil ntp2)))) + (ratio + (case t2 + (rational + (if (sub-interval-p '(* *) i2) (values t t) (values nil t))) + (t (values nil ntp2)))) + (standard-char + (if (member t2 '(base-char character character)) + (values t t) + (values nil ntp2))) + (base-char + (if (member t2 '(character character)) + (values t t) + (values nil ntp2))) + (extended-char + (if (member t2 '(character character)) + (values t t) + (values nil ntp2))) + (character + (if (eq t2 'character) + (values t t) + (values nil ntp2))) + (character + (if (eq t2 'character) + (values t t) + (values nil ntp2))) + (integer + (if (member t2 '(integer rational)) + (values (sub-interval-p i1 i2) t) + (values nil ntp2))) + (rational + (if (eq t2 'rational) + (values (sub-interval-p i1 i2) t) + (values nil ntp2))) + (float + (if (eq t2 'float) + (values (sub-interval-p i1 i2) t) + (values nil ntp2))) + ((short-float) + (if (member t2 '(short-float float)) + (values (sub-interval-p i1 i2) t) + (values nil ntp2))) + ((single-float double-float long-float) + (if (member t2 '(single-float double-float long-float float)) + (values (sub-interval-p i1 i2) t) + (values nil ntp2))) + (complex + (if (eq t2 'complex) + (subtypep (or (car i1) t) (or (car i2) t)) + (values nil ntp2))) + (simple-array + (cond ((or (eq t2 'simple-array) (eq t2 'array)) + (if (or (endp i1) (eq (car i1) '*)) + (unless (or (endp i2) (eq (car i2) '*)) + (return-from subtypep (values nil t))) + (unless (or (endp i2) (eq (car i2) '*)) + (unless (or (equal (car i1) (car i2)) + ; FIXME + (and (eq (car i1) 'base-char) + (eq (car i2) 'character))) + ;; Unless the element type matches, + ;; return NIL T. + ;; Is this too strict? + (return-from subtypep + (values nil t))))) + (when (or (endp (cdr i1)) (eq (cadr i1) '*)) + (if (or (endp (cdr i2)) (eq (cadr i2) '*)) + (return-from subtypep (values t t)) + (return-from subtypep (values nil t)))) + (when (or (endp (cdr i2)) (eq (cadr i2) '*)) + (return-from subtypep (values t t))) + (values (match-dimensions (cadr i1) (cadr i2)) t)) + (t (values nil ntp2)))) + (array + (cond ((eq t2 'array) + (if (or (endp i1) (eq (car i1) '*)) + (unless (or (endp i2) (eq (car i2) '*)) + (return-from subtypep (values nil t))) + (unless (or (endp i2) (eq (car i2) '*)) + (unless (or (equal (car i1) (car i2)) + ; FIXME + (and (eq (car i1) 'base-char) + (eq (car i2) 'character))) + (return-from subtypep + (values nil t))))) + (when (or (endp (cdr i1)) (eq (cadr i1) '*)) + (if (or (endp (cdr i2)) (eq (cadr i2) '*)) + (return-from subtypep (values t t)) + (return-from subtypep (values nil t)))) + (when (or (endp (cdr i2)) (eq (cadr i2) '*)) + (return-from subtypep (values t t))) + (values (match-dimensions (cadr i1) (cadr i2)) t)) + (t (values nil ntp2)))) + (t (if ntp1 (values (eq t1 t2) t) (values nil nil))))))) + + +(defun sub-interval-p (i1 i2) + (let (low1 high1 low2 high2) + (if (endp i1) + (setq low1 '* high1 '*) + (if (endp (cdr i1)) + (setq low1 (car i1) high1 '*) + (setq low1 (car i1) high1 (cadr i1)))) + (if (endp i2) + (setq low2 '* high2 '*) + (if (endp (cdr i2)) + (setq low2 (car i2) high2 '*) + (setq low2 (car i2) high2 (cadr i2)))) + (cond ((eq low1 '*) + (unless (eq low2 '*) + (return-from sub-interval-p nil))) + ((eq low2 '*)) + ((consp low1) + (if (consp low2) + (when (< (car low1) (car low2)) + (return-from sub-interval-p nil)) + (when (< (car low1) low2) + (return-from sub-interval-p nil)))) + ((if (consp low2) + (when (<= low1 (car low2)) + (return-from sub-interval-p nil)) + (when (< low1 low2) + (return-from sub-interval-p nil))))) + (cond ((eq high1 '*) + (unless (eq high2 '*) + (return-from sub-interval-p nil))) + ((eq high2 '*)) + ((consp high1) + (if (consp high2) + (when (> (car high1) (car high2)) + (return-from sub-interval-p nil)) + (when (> (car high1) high2) + (return-from sub-interval-p nil)))) + ((if (consp high2) + (when (>= high1 (car high2)) + (return-from sub-interval-p nil)) + (when (> high1 high2) + (return-from sub-interval-p nil))))) + (return-from sub-interval-p t))) + +(defun in-interval-p (x interval) + (let (low high) + (if (endp interval) + (setq low '* high '*) + (if (endp (cdr interval)) + (setq low (car interval) high '*) + (setq low (car interval) high (cadr interval)))) + (cond ((eq low '*)) + ((consp low) + (when (<= x (car low)) (return-from in-interval-p nil))) + ((when (< x low) (return-from in-interval-p nil)))) + (cond ((eq high '*)) + ((consp high) + (when (>= x (car high)) (return-from in-interval-p nil))) + ((when (> x high) (return-from in-interval-p nil)))) + (return-from in-interval-p t))) + +(defun match-dimensions (dim pat) + (if (null dim) + (null pat) + (and (or (eq (car pat) '*) + (eql (car dim) (car pat))) + (match-dimensions (cdr dim) (cdr pat))))) + + +(defmacro check-type-eval (place type) + `(values (assert (typep ,place ,type) (,place) 'type-error :datum ,place :expected-type ,type))) + +(deftype simple-array (&optional (et '*) (dims '*)) `(array ,et ,(if (not dims) 0 dims))) +(deftype null nil `(member nil)) +(deftype single-float (&optional (low '*) (high '*)) `(long-float ,low ,high)) +(deftype double-float (&optional (low '*) (high '*)) `(long-float ,low ,high)) + + +#.`(defun coerce (object type &aux (l (listp type))(ctp (if l (car type) type))(i (when l (cdr type)))) + (when + (case type + ,@(mapcar (lambda (x) `(,x (,(get x 'type-predicate) object))) + '(string list vector bit-vector array character float cons)) + (function (unless (symbolp object) (functionp object)));FIXME + (otherwise (typep object type))) + (return-from coerce object)) + (case ctp + ((string list vector bit-vector simple-string simple-vector simple-bit-vector array cons null member) + (replace (make-sequence type (length object)) object)) + (function (symbol-function object)) + (character (character object)) + (float (float object)) + ((short-float) (float object 0.0S0)) + ((single-float double-float long-float) (float object 0.0L0)) + (complex + (let* ((re (realpart object))(im (imagpart object)) + (rt (car i))(rt (unless (eq rt '*) rt)) + (re (if rt (coerce re rt) re))(im (if rt (coerce im rt) im))) + (complex re im))) + (t (cond ((let ((nt (normalize-type type))) (unless (eq nt type) (coerce object nt)))) + (t (error "Cannot coerce ~S to ~S." object type)))))) + +;; set by unixport/init_kcl.lsp +;; warn if a file was comopiled in another version +(defvar *gcl-extra-version* nil) +(defvar *gcl-minor-version* nil) +(defvar *gcl-major-version* nil) +(defvar *gcl-git-tag* nil) +(defvar *gcl-release-date* nil) + +(defun warn-version (majvers minvers extvers) + (and *gcl-major-version* *gcl-minor-version* *gcl-extra-version* + (or (not (eql extvers *gcl-extra-version*)) + (not (eql minvers *gcl-minor-version*)) + (not (eql majvers *gcl-major-version*))) + *load-verbose* + (format t "[compiled in GCL ~a.~a.~a] " majvers minvers extvers))) + + + diff --git a/lsp/gcl_profile.lsp b/lsp/gcl_profile.lsp new file mode 100755 index 0000000..166ae10 --- /dev/null +++ b/lsp/gcl_profile.lsp @@ -0,0 +1,110 @@ + +(in-package :si) +(use-package "SLOOP") + +;; Sample Usage: +;; (si::set-up-profile 1000000) (si::prof 0 90) +;; run program +;; (si::display-prof) +;; (si::clear-profile) +;; profile can be stopped with (si::prof 0 0) and restarted with +;;start-address will correspond to the beginning of the profile array, and +;;the scale will mean that 256 bytes of code correspond to scale bytes in the +;;profile array. +;;Thus if the profile array is 1,000,000 bytes long and the code segment is +;;5 megabytes long you can profile the whole thing using a scale of 50 +;;Note that long runs may result in overflow, and so an understating of the +;;time in a function. With a scale of 128 it takes 6,000,000 times through +;;a loop to overflow the sampling in one part of the code. + + + +;(defun sort-funs (package) +; (sloop for v in-package package with tem +; when (and (fboundp v) (compiled-function-p +; (setq tem (symbol-function v)))) +; collect (cons (function-start v) v) into all +; finally (loop-return (sort all #'(lambda (x y) +; (< (the fixnum (car x)) +; (the fixnum (car y)))))))) +(defvar si::*profile-array* + (make-array 20000 :element-type 'string-char + :static t + :initial-element + (code-char 0))) + +(defun create-profile-array (&optional (n 100000)) + (if *profile-array* (profile 0 0)) + (setq *profile-array* (make-array n :element-type 'string-char + :static t + :initial-element + (code-char 0))) + n + ) + + +(defvar *current-profile* nil) + +(defun pr (&optional n) + (sloop + with ar = si::*profile-array* declare (string ar) + for i below (if n (min n (array-total-size ar)) (array-total-size ar)) + + do + (cond ((not (= 0 i))(if (= 0 (mod i 20)) (terpri)))) + (princ (char-code (aref ar i))) (princ " ")) + (values)) + +(defun fprofile(fun &optional (fract 1000) offset) + (setq *current-profile* (list (+ (function-start (symbol-function fun)) + (or offset 0)) + fract)) + (apply 'profile *current-profile* )) + +;(defun foo (n) (sloop for i below n do nil)) + +;;problem: the counter will wrap around at 256, so that it really is not valid +;;for long runs if the functions are heavily used. This means that +;;Remove all previous ticks from the profile array. + +(defun clear-profile () (sloop with ar = *profile-array* + declare (string ar) + for i below (array-total-size ar) + do (setf (aref ar i) (code-char 0)))) + + +(defun prof-offset (addr) (* (/ (float (cadr *current-profile*)) #x10000) + (- addr (car *current-profile*)))) + +(defun prof (a b) + (setf *current-profile* (list a b)) + (profile a b)) + +(defun display-prof() + (profile 0 0) + (apply 'display-profile *current-profile*) + (apply 'profile *current-profile*)) + + +(defun set-up-profile (&optional (array-size 100000)(max-funs 6000) +; (name "saved_kcl")(dir *system-directory*)&aux sym + ) +; (compiler::safe-system (format nil "(cd ~a ; rsym ~a \"#sym\")" dir name)) +; (or (probe-file (setq sym (format nil "~a#sym" dir))) (error "could not find ~a" sym)) +; (read-externals sym) + (set-up-combined max-funs) + (unless (and *profile-array* + (>= (array-total-size *profile-array*) array-size)) + (print "making new array") + (setq *profile-array* (make-array array-size + :element-type 'string-char + :static t + :initial-element + (code-char 0)))) + (format t "~%Loaded c and other function addresses~ + ~%Using profile-array length ~a ~ + ~%Use (si::prof 0 90) to start and (prof 0 0) to stop:~ + ~%This starts monitoring at address 0 ~ + ~%thru byte (256/90)*(length *profile-array*)~ + ~%(si::display-prof) displays the results" (length *profile-array*))) + diff --git a/lsp/gcl_readline.lsp b/lsp/gcl_readline.lsp new file mode 100644 index 0000000..dce4787 --- /dev/null +++ b/lsp/gcl_readline.lsp @@ -0,0 +1,12 @@ +(in-package "SI" ) +(defun init-readline () + ; init Readline word completion list for Gcl + (if (fboundp 'si::readline-init) + (let (l) + (sloop::sloop for v in-package 'lisp do + (if (or (boundp v) (fboundp v)) + (setq l (cons (symbol-name v) l)))) + (sloop::sloop for v in-package 'keyword do + (if (or (boundp v) (fboundp v)) + (setq l (cons (format nil ":~A" v) l)))) + (si::readline-init t "Gcl" 1 l)))) diff --git a/lsp/gcl_rename_file.lsp b/lsp/gcl_rename_file.lsp new file mode 100644 index 0000000..e9fe385 --- /dev/null +++ b/lsp/gcl_rename_file.lsp @@ -0,0 +1,49 @@ +(in-package :si) + +(defun set-path-stream-name (x y) + (check-type x pathname-designator) + (typecase x + (synonym-stream (set-path-stream-name (symbol-value (synonym-stream-symbol x)) y)) + (stream (c-set-stream-object1 x y)))) + +(defun rename-file (f n &aux (pf (pathname f))(pn (merge-pathnames n pf nil)) + (tpf (truename pf))(nf (namestring tpf)) + (tpn (translate-logical-pathname pn))(nn (namestring tpn))) + (declare (optimize (safety 1))) + (check-type f pathname-designator) + (check-type n (and pathname-designator (not stream))) + (unless (rename nf nn) + (error 'file-error :pathname pf :format-control "Cannot rename ~s to ~s." :format-arguments (list nf nn))) + (set-path-stream-name f pn) + (values pn tpf (truename tpn))) + +(defun user-homedir-pathname (&optional (host :unspecific hostp)) + (declare (optimize (safety 1))) + (check-type host (or string list (eql :unspecific))) + (unless hostp + (pathname (home-namestring "~")))) + +(defun delete-file (f &aux (pf (truename f))(nf (namestring pf))) + (declare (optimize (safety 1))) + (check-type f pathname-designator) + (unless (if (eq :directory (stat1 nf)) (rmdir nf) (unlink nf)) + (error 'file-error :pathname (pathname nf) :format-control "Cannot delete pathname.")) + t) + +(defun file-write-date (spec) + (declare (optimize (safety 1))) + (check-type spec pathname-designator) + (multiple-value-bind + (tp sz tm) (stat (namestring (truename spec))) + (declare (ignore tp sz)) + (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) + + +(defun file-author (spec) + (declare (optimize (safety 1))) + (check-type spec pathname-designator) + (multiple-value-bind + (tp sz tm uid) (stat (namestring (truename spec))) + (declare (ignore tp sz tm)) + (uid-to-name uid))) + diff --git a/lsp/gcl_restart.lsp b/lsp/gcl_restart.lsp new file mode 100644 index 0000000..0c9aa35 --- /dev/null +++ b/lsp/gcl_restart.lsp @@ -0,0 +1,196 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: "CONDITIONS"; Base: 10 -*- + +(in-package :si) + +(defvar *restarts* nil) +(defvar *restart-condition* nil) + +(defmacro restart-bind (bindings &body forms) + (declare (optimize (safety 2))) + `(let ((*restarts* + (list* ,@(mapcar (lambda (x) `(cons (make-restart :name ',(pop x) :function ,(pop x) ,@x) *restart-condition*)) bindings) + *restarts*))) + ,@forms)) + + +(defmacro with-condition-restarts (condition-form restarts-form &body body) + (declare (optimize (safety 1))) + (let ((n-cond (gensym))) + `(let* ((,n-cond ,condition-form) + (*restarts* (nconc (mapcar (lambda (x) (cons x ,n-cond)) ,restarts-form) *restarts*))) + ,@body))) + +(defun condition-pass (condition restart &aux b (f (restart-test-function restart))) + (when (if f (funcall f condition) t) + (mapc (lambda (x) + (when (eq (pop x) restart) + (if (if condition (eq x condition) t) + (return-from condition-pass t) + (setq b (or b x))))) *restarts*) + (not b))) + +(defvar *kcl-top-restarts* nil) + +(defun make-kcl-top-restart (quit-tag) + (make-restart :name 'gcl-top-restart + :function (lambda () (throw (car (list quit-tag)) quit-tag)) + :report-function + (lambda (stream) + (let ((b-l (if (eq quit-tag si::*quit-tag*) + si::*break-level* + (car (or (find quit-tag si::*quit-tags* + :key #'cdr) + '(:not-found)))))) + (cond ((eq b-l :not-found) + (format stream "Return to ? level.")) + ((null b-l) + (format stream "Return to top level.")) + (t + (format stream "Return to break level ~D." + (length b-l)))))))) + +(defun find-kcl-top-restart (quit-tag) + (cdr (or (assoc quit-tag *kcl-top-restarts*) + (car (push (cons quit-tag (make-kcl-top-restart quit-tag)) + *kcl-top-restarts*))))) + +(defun kcl-top-restarts () + (let* (;(old-tags (ldiff si::*quit-tags* (member nil si::*quit-tags* :key 'cdr))) + (old-tags si::*quit-tags*) + (old-tags (mapcan (lambda (e) (when (cdr e) (list (cdr e)))) old-tags)) + (tags (if si::*quit-tag* (cons si::*quit-tag* old-tags) old-tags)) + (restarts (mapcar 'find-kcl-top-restart tags))) + (setq *kcl-top-restarts* (mapcar 'cons tags restarts)) + restarts)) + +(defun compute-restarts (&optional condition) + (remove-if-not (lambda (x) (condition-pass condition x)) (remove-duplicates (nconc (mapcar 'car *restarts*) (kcl-top-restarts))))) + +(defun find-restart (name &optional condition &aux (sn (symbolp name))) + (car (member name (compute-restarts condition) :key (lambda (x) (if sn (restart-name x) x))))) + +(defun transform-keywords (&key report interactive test + &aux rr (report (if (stringp report) `(lambda (s) (write-string ,report s)) report))) + (macrolet ((do-setf (x) + `(when ,x + (setf (getf rr ,(intern (string-concatenate (symbol-name x) "-FUNCTION") :keyword)) + (list 'function ,x))))) + (do-setf report) + (do-setf interactive) + (do-setf test) + rr)) + +(defun rewrite-restart-case-clause (r &aux (name (pop r))(ll (pop r))) + (labels ((l (r) (if (member (car r) '(:report :interactive :test)) (l (cddr r)) r))) + (let ((rd (l r))) + (list* name (gensym) (apply 'transform-keywords (ldiff r rd)) ll rd)))) + + +(defun restart-case-expression-condition (expression env c &aux (e (macroexpand expression env))(n (when (listp e) (pop e)))) + (case n + (cerror (let ((ca (pop e))) `((process-error ,(pop e) (list ,@e)) (,n ,ca ,c)))) + (error `((process-error ,(pop e) (list ,@e)) (,n ,c))) + (warn `((process-error ,(pop e) (list ,@e) 'simple-warning) (,n ,c))) + (signal `((coerce-to-condition ,(pop e) (list ,@e) 'simple-condition ',n) (,n ,c))))) + + +(defmacro restart-case (expression &body clauses &environment env) + (declare (optimize (safety 2))) + (let* ((block-tag (gensym))(args (gensym))(c (gensym)) + (data (mapcar 'rewrite-restart-case-clause clauses)) + (e (restart-case-expression-condition expression env c))) + `(block + ,block-tag + (let* (,args (,c ,(car e)) (*restart-condition* ,c)) + (tagbody + (restart-bind + ,(mapcar (lambda (x) `(,(pop x) (lambda (&rest r) (setq ,args r) (go ,(pop x))) ,@(pop x))) data) + (return-from ,block-tag ,(or (cadr e) expression))) + ,@(mapcan (lambda (x &aux (x (cdr x))) + `(,(pop x) (return-from ,block-tag (apply (lambda ,(progn (pop x)(pop x)) ,@x) ,args)))) data)))))) + + +(defvar *unique-id-table* (make-hash-table)) +(defvar *unique-id-count* -1) + +(defun unique-id (obj) + "generates a unique integer id for its argument." + (or (gethash obj *unique-id-table*) + (setf (gethash obj *unique-id-table*) (incf *unique-id-count*)))) + +(defun restart-print (restart stream depth) + (declare (ignore depth)) + (if *print-escape* + (format stream "#<~s.~d>" (type-of restart) (unique-id restart)) + (restart-report restart stream))) + +(defstruct (restart (:print-function restart-print)) + name + function + report-function + interactive-function + (test-function (lambda (c) (declare (ignore c)) t))) + +(defun restart-report (restart stream &aux (f (restart-report-function restart))) + (if f (funcall f stream) + (format stream "~s" (or (restart-name restart) restart)))) + +(defun invoke-restart (restart &rest values) + (let ((real-restart (or (find-restart restart) + (error 'control-error :format-control "restart ~s is not active." :format-arguments (list restart))))) + (apply (restart-function real-restart) values))) + +(defun invoke-restart-interactively (restart) + (let ((real-restart (or (find-restart restart) + (error "restart ~s is not active." restart)))) + (apply (restart-function real-restart) + (let ((interactive-function (restart-interactive-function real-restart))) + (when interactive-function + (funcall interactive-function)))))) + + +(defmacro with-simple-restart ((restart-name format-control &rest format-arguments) + &body forms) + (declare (optimize (safety 1))) + `(restart-case (progn ,@forms) + (,restart-name nil + :report (lambda (stream) (format stream ,format-control ,@format-arguments)) + (values nil t)))) + +(defun abort (&optional condition) + "Transfers control to a restart named abort, signalling a control-error if + none exists." + (invoke-restart (find-restart 'abort condition)) + (error 'abort-failure)) + + +(defun muffle-warning (&optional condition) + "Transfers control to a restart named muffle-warning, signalling a + control-error if none exists." + (invoke-restart (find-restart 'muffle-warning condition))) + +(macrolet ((define-nil-returning-restart (name args doc) + (let ((restart (gensym))) + `(defun ,name (,@args &optional condition) + ,doc + (declare (optimize (safety 1))) + (let ((,restart (find-restart ',name condition))) (when ,restart (invoke-restart ,restart ,@args))))))) + + (define-nil-returning-restart continue nil + "Transfer control to a restart named continue, returning nil if none exists.") + + (define-nil-returning-restart store-value (value) + "Transfer control and value to a restart named store-value, returning nil if + none exists.") + + (define-nil-returning-restart use-value (value) + "Transfer control and value to a restart named use-value, returning nil if + none exists.")) + +(defun show-restarts (&aux (i 0)) + (mapc (lambda (x) + (format t "~& ~4d ~a ~a ~%" + (incf i) + (cond ((eq x *debug-abort*) "(abort)") ((eq x *debug-continue*) "(continue)") ("")) + x)) *debug-restarts*) + nil) diff --git a/lsp/gcl_seq.lsp b/lsp/gcl_seq.lsp new file mode 100755 index 0000000..6ce5aa2 --- /dev/null +++ b/lsp/gcl_seq.lsp @@ -0,0 +1,134 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; seq.lsp +;;;; +;;;; sequence routines + + +(in-package :si) + + +(proclaim '(optimize (safety 2) (space 3))) + + +(defun make-sequence (type size &key (initial-element nil iesp) + &aux element-type sequence) + (setq element-type + (cond ((eq type 'list) + (return-from make-sequence + (if iesp + (make-list size :initial-element initial-element) + (make-list size)))) + ((or (eq type 'simple-string) (eq type 'string)) 'character) + ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit) + ((or (eq type 'simple-vector) (eq type 'vector)) t) + (t + (setq type (normalize-type type)) + (when (subtypep (car type) 'list) + (if (or (and (eq 'null (car type)) (not (equal size 0))) + (and (eq 'cons (car type)) (equal size 0))) + (error 'type-error :datum type :expected-type (format nil "list (size ~S)" size))) + (return-from make-sequence + (if iesp + (make-list size :initial-element initial-element) + (make-list size)))) + (unless (or (eq (car type) 'array) + (eq (car type) 'simple-array)) + (error 'type-error :datum type :expected-type 'sequence)) + (let ((ssize (caddr type))) + (if (listp ssize) (setq ssize (car ssize))) + (if (not (si::fixnump ssize)) (setq ssize size)) + (unless (equal ssize size) + (error 'type-error :datum type :expected-type (format nil "~S (size ~S)" type size)))) + (or (cadr type) t)))) + (setq element-type (si::best-array-element-type element-type)) + (setq sequence (si:make-vector element-type size nil nil nil nil nil)) + (when iesp + (do ((i 0 (1+ i)) + (size size)) + ((>= i size)) + (declare (fixnum i size)) + (setf (elt sequence i) initial-element))) + sequence) + + +(defun concatenate (result-type &rest sequences) + (do ((x (make-sequence result-type + (apply #'+ (mapcar #'length sequences)))) + (s sequences (cdr s)) + (i 0)) + ((null s) x) + (declare (fixnum i)) + (do ((j 0 (1+ j)) + (n (length (car s)))) + ((>= j n)) + (declare (fixnum j n)) + (setf (elt x i) (elt (car s) j)) + (incf i)))) + + +(defun map (result-type function sequence &rest more-sequences) + (setq more-sequences (cons sequence more-sequences)) + (let ((l (apply #'min (mapcar #'length more-sequences)))) + (if (null result-type) + (do ((i 0 (1+ i)) + (l l)) + ((>= i l) nil) + (declare (fixnum i l)) + (apply function (mapcar #'(lambda (z) (elt z i)) + more-sequences))) + (let ((x (make-sequence result-type l))) + (do ((i 0 (1+ i)) + (l l)) + ((>= i l) x) + (declare (fixnum i l)) + (setf (elt x i) + (apply function (mapcar #'(lambda (z) (elt z i)) + more-sequences)))))))) + + +(defun some (predicate sequence &rest more-sequences) + (setq more-sequences (cons sequence more-sequences)) + (do ((i 0 (1+ i)) + (l (apply #'min (mapcar #'length more-sequences)))) + ((>= i l) nil) + (declare (fixnum i l)) + (let ((that-value + (apply predicate + (mapcar #'(lambda (z) (elt z i)) more-sequences)))) + (when that-value (return that-value))))) + + +(defun every (predicate sequence &rest more-sequences) + (setq more-sequences (cons sequence more-sequences)) + (do ((i 0 (1+ i)) + (l (apply #'min (mapcar #'length more-sequences)))) + ((>= i l) t) + (declare (fixnum i l)) + (unless (apply predicate (mapcar #'(lambda (z) (elt z i)) more-sequences)) + (return nil)))) + + +(defun notany (predicate sequence &rest more-sequences) + (not (apply #'some predicate sequence more-sequences))) + + +(defun notevery (predicate sequence &rest more-sequences) + (not (apply #'every predicate sequence more-sequences))) diff --git a/lsp/gcl_seqlib.lsp b/lsp/gcl_seqlib.lsp new file mode 100755 index 0000000..34f40fb --- /dev/null +++ b/lsp/gcl_seqlib.lsp @@ -0,0 +1,808 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; seqlib.lsp +;;;; +;;;; sequence routines + + +(in-package :si) + + +;(proclaim '(optimize (safety 2) (space 3))) + + +(proclaim '(function seqtype (t) t)) +(defun seqtype (sequence) + (cond ((listp sequence) 'list) + ((stringp sequence) 'string) + ((bit-vector-p sequence) 'bit-vector) + ((vectorp sequence) (list 'array (array-element-type sequence))) + (t (error "~S is not a sequence." sequence)))) + +(proclaim '(function call-test (t t t t) t)) +(defun call-test (test test-not item keyx) + (cond (test (funcall test item keyx)) + (test-not (not (funcall test-not item keyx))) + (t (eql item keyx)))) + + +(proclaim '(function check-seq-start-end (t t) t)) +(defun check-seq-start-end (start end) + (unless (and (si:fixnump start) (si:fixnump end)) + (error "Fixnum expected.")) + (when (> (the fixnum start) (the fixnum end)) + (error "START is greater than END."))) + +(proclaim '(function test-error() t)) +(defun test-error() + (error "both test and test not supplied")) + +(defun bad-seq-limit (x &optional y) + (error 'type-error :datum (if y (list x y) x) :expected-type 'sequence-limit));FIXME + + +(eval-when (compile eval) +(proclaim '(function the-start (t) fixnum)) +(proclaim '(function the-end (t t) fixnum)) +(defmacro f+ (x y) `(the fixnum (+ (the fixnum ,x) (the fixnum ,y)))) +(defmacro f- (x y) `(the fixnum (- (the fixnum ,x) (the fixnum ,y)))) + +(defmacro with-start-end ( start end seq &body body) + `(let ((,start (if ,start (the-start ,start) 0))) + (declare (fixnum ,start)) + (let ((,end (the-end ,end ,seq))) + (declare (fixnum ,end)) + (or (<= ,start ,end) (bad-seq-limit ,start ,end)) + ,@ body))) +) + +(defun the-end (x y) + (cond ((fixnump x) + (or (<= (the fixnum x) (the fixnum (length y))) + (bad-seq-limit x)) + x) + ((null x) + (length y)) + (t (bad-seq-limit x)))) + +(defun the-start (x) + (cond ((fixnump x) + (or (>= (the fixnum x) 0) + (bad-seq-limit x)) + (the fixnum x)) + ((null x) 0) + (t (bad-seq-limit x)))) + + + +(defun reduce (function sequence + &key from-end + start + end + (initial-value nil ivsp) + (key #'identity)) + (with-start-end start end sequence + (cond ((not from-end) + (when (null ivsp) + (when (>= start end) + (return-from reduce (funcall function))) + (setq initial-value (funcall key (elt sequence start))) + (setf start (f+ 1 start)) + ) + (do ((x initial-value + (funcall function x (funcall key (prog1 (elt sequence start) + (setf start (f+ 1 start)) + ))))) + ((>= start end) x))) + (t + (when (null ivsp) + (when (>= start end) + (return-from reduce (funcall function))) + (setf end (f+ end -1)) + (setq initial-value (funcall key (elt sequence end))) + ) + (do ((x initial-value (funcall function (funcall key (elt sequence end)) x))) + ((>= start end) x) + (setf end (f+ -1 end))))))) + + +(defun fill (sequence item + &key start end ) + (with-start-end start end sequence + (do ((i start (f+ 1 i))) + ((>= i end) sequence) + (declare (fixnum i)) + (setf (elt sequence i) item)))) + +(defun replace (s1 s2 &key (start1 0) end1 (start2 0) end2 &aux (os1 s1) s3) + (declare (optimize (safety 1))(:dynamic-extent s3)) + (when (and (eq s1 s2) (> start1 start2)) + (setq s3 (make-list (length s2)) s2 (replace s3 s2))) + (let* ((lp1 (listp s1)) (lp2 (listp s2))(start1 start1)(start2 start2) + (e1 (or end1 (if lp1 array-dimension-limit (length s1)))) + (e2 (or end2 (if lp2 array-dimension-limit (length s2))))) + (declare (fixnum start1 start2 e1 e2)) + (do ((i1 start1 (1+ i1))(i2 start2 (1+ i2)) + (s1 (if (when lp1 (> start1 0)) (nthcdr start1 s1) s1) (if lp1 (cdr s1) s1)) + (s2 (if (when lp2 (> start2 0)) (nthcdr start2 s2) s2) (if lp2 (cdr s2) s2))) + ((or (not s1) (>= i1 e1) (not s2) (>= i2 e2)) os1) + (declare (fixnum i1 i2)) + (let ((e2 (if lp2 (car s2) (aref s2 i2)))) + (if lp1 (setf (car s1) e2) (setf (aref s1 i1) e2)))))) + +;; (defun replace (sequence1 sequence2 +;; &key start1 end1 +;; start2 end2 ) +;; (with-start-end start1 end1 sequence1 +;; (with-start-end start2 end2 sequence2 +;; (if (and (eq sequence1 sequence2) +;; (> start1 start2)) +;; (do* ((i 0 (f+ 1 i)) +;; (l (if (< (f- end1 start1) +;; (f- end2 start2)) +;; (f- end1 start1) +;; (f- end2 start2))) +;; (s1 (f+ start1 (f+ -1 l)) (f+ -1 s1)) +;; (s2 (f+ start2 (f+ -1 l)) (f+ -1 s2))) +;; ((>= i l) sequence1) +;; (declare (fixnum i l s1 s2)) +;; (setf (elt sequence1 s1) (elt sequence2 s2))) +;; (do ((i 0 (f+ 1 i)) +;; (l (if (< (f- end1 start1) +;; (f- end2 start2)) +;; (f- end1 start1) +;; (f- end2 start2))) +;; (s1 start1 (f+ 1 s1)) +;; (s2 start2 (f+ 1 s2))) +;; ((>= i l) sequence1) +;; (declare (fixnum i l s1 s2)) +;; (setf (elt sequence1 s1) (elt sequence2 s2))))))) + + +;;; DEFSEQ macro. +;;; Usage: +;;; +;;; (DEFSEQ function-name argument-list countp everywherep body) +;;; +;;; The arguments ITEM and SEQUENCE (PREDICATE and SEQUENCE) +;;; and the keyword arguments are automatically supplied. +;;; If the function has the :COUNT argument, set COUNTP T. + +(eval-when (eval compile) +(defmacro defseq + (f args countp everywherep body + &aux (*macroexpand-hook* 'funcall)) + (setq *body* body) + (list 'progn + (let* ((from-end nil) + (iterate-i '(i start (f+ 1 i))) + (iterate-i-from-end '(i (f+ -1 end) (f+ -1 i))) + (endp-i '(>= i end)) + (endp-i-from-end '(< i start)) + (iterate-i-everywhere '(i 0 (f+ 1 i))) + (iterate-i-everywhere-from-end '(i (f+ -1 l) (f+ -1 i))) + (endp-i-everywhere '(>= i l)) + (endp-i-everywhere-from-end '(< i 0)) + (i-in-range '(and (<= start i) (< i end))) + (x '(elt sequence i)) + (keyx `(funcall key ,x)) + (satisfies-the-test `(call-test test test-not item ,keyx)) + (number-satisfied + `(n (internal-count item sequence + :from-end from-end + :test test :test-not test-not + :start start :end end + ,@(if countp '(:count count)) + :key key))) + (within-count '(< k count)) + (kount-0 '(k 0)) + (kount-up '(setq k (f+ 1 k)))) + `(defun ,f (,@args item sequence + &key from-end test test-not + start end + ,@(if countp '(count)) + (key #'identity) + ,@(if everywherep + (list '&aux '(l (length sequence))) + nil)) + ,@(if everywherep '((declare (fixnum l)))) + (if (eq key nil) (setq key #'identity)) + (with-start-end start end sequence + (let ,@(if countp + '(((count + (cond ((null count) most-positive-fixnum) + ((< count 0) 0) + ((> count most-positive-fixnum) most-positive-fixnum) + (t count)))))) + ,@(if countp '((declare (fixnum count)))) + nil + (and test test-not (test-error)) + (if (not from-end) + ,(eval-body) + ,(progn (setq from-end t + iterate-i iterate-i-from-end + endp-i endp-i-from-end + iterate-i-everywhere + iterate-i-everywhere-from-end + endp-i-everywhere + endp-i-everywhere-from-end) + (eval-body))))))) + `(defun ,(intern (si:string-concatenate (string f) "-IF") + (symbol-package f)) + (,@args predicate sequence + &key from-end + start end + ,@(if countp '(count)) + (key #'identity)) + (if (eq key nil) (setq key #'identity)) + (,f ,@args predicate sequence + :from-end from-end + :test #'funcall + :start start :end end + ,@(if countp '(:count count)) + :key key)) + `(defun ,(intern (si:string-concatenate (string f) "-IF-NOT") + (symbol-package f)) + (,@args predicate sequence + &key from-end start end + ,@(if countp '(count)) + (key #'identity)) + (if (eq key nil) (setq key #'identity)) + (,f ,@args predicate sequence + :from-end from-end + :test-not #'funcall + :start start :end end + ,@(if countp '(:count count)) + :key key)) + (list 'quote f))) + +(defmacro eval-body () *body*) +(defmacro mcf (x) `(when ,x (coerce ,x 'function))) +(deftype function-designator nil `(or (and symbol (not boolean)) function)) +(defmacro rcollect (r rp form) + `(let ((tmp ,form)) + (setq ,rp (last (if ,rp (rplacd ,rp tmp) (setq ,r tmp)))))) + + (defmacro dcollect (r rp form) + `(let ((tmp ,form)) + (declare (dynamic-extent tmp)) + (setq ,rp (cond (,rp (rplacd ,rp tmp) tmp) ((setq ,r tmp)))))) + +) + +(defun remove (item sequence &key key test test-not from-end count (start 0) end + &aux (kf (mcf key))(tf (mcf test))(tnf (mcf test-not)) r rp q qp xz (from-end (when count from-end)) + (l (listp sequence))(ln (if l array-dimension-limit (length sequence))) + (e (if end (min ln (max 0 end)) ln)) + (c (if count (min ln (max 0 count)) ln))) + + (declare (optimize (safety 1))(dynamic-extent q)(fixnum c e)) + + (check-type sequence sequence) + (check-type start seqind) + (check-type end (or null seqind)) + (check-type count (or null integer)) + (check-type key (or null function-designator)) + (check-type test (or null function-designator)) + (check-type test-not (or null function-designator)) + + (cond ((unless from-end l) + (do ((i start (1+ i))(j 0)(s (if (zerop start) sequence (nthcdr start sequence)) (cdr s))) + ((or (endp s) (>= i e) (>= j c)) (rcollect r rp sequence) r) + (declare (fixnum i j)) + (let* ((x (car s))(kx (if kf (funcall kf x) x))) + (when (cond (tf (funcall tf item kx))(tnf (not (funcall tnf item kx)))((eql item kx))) + (do nil ((eq sequence s) (setq sequence (cdr sequence))) (rcollect r rp (cons (pop sequence) nil))) + (incf j))))) + (t + (do* ((j 0 (1+ j))) + ((not (when (< j c) + (setq xz (position item sequence + :start (if (unless from-end xz) (1+ xz) start) + :end (if (when from-end xz) xz end) + :key kf :test tf :test-not tnf :from-end from-end))))) + (declare (fixnum j)) + (if from-end (push xz q) (dcollect q qp (cons xz nil)))) +; (print q) + (cond ((not q) sequence) + (l (do* ((lq -1 (car q))(q q (cdr q))(v sequence (cdr v)))((not q) (rcollect r rp v) r) + (declare (fixnum lq)) + (dotimes (i (the fixnum (- (car q) lq 1))) (declare (fixnum i))(rcollect r rp (cons (pop v) nil))))) + ((let ((r (make-array (- (length sequence) (length q)) :element-type (array-element-type sequence)))) + (do* ((j 0 (+ j (- (car q) lq 1)))(lq -1 (car q))(q q (cdr q))) + ((when (replace r sequence :start1 j :start2 (1+ lq) :end2 (car q)) (not q)) r))))))) +) + +(defun remove-if (p s &key key from-end count (start 0) end &aux (kf (mcf key))) + + (declare (optimize (safety 1))) + + (check-type p function-designator) + (check-type s sequence) + (check-type start seqind) + (check-type end (or null seqind)) + (check-type count (or null integer)) + (check-type key (or null function-designator)) + + (remove p s :key kf :test #'funcall :start start :end end :count count :from-end from-end)) + +(defun remove-if-not (p s &key key from-end count (start 0) end &aux (kf (mcf key))) + + (declare (optimize (safety 1))) + + (check-type p function-designator) + (check-type s sequence) + (check-type start seqind) + (check-type end (or null seqind)) + (check-type count (or null integer)) + (check-type key (or null function-designator)) + + (remove p s :key kf :test-not #'funcall :start start :end end :count count :from-end from-end)) + + +(defseq delete () t t + (if (not from-end) + `(if (listp sequence) + (let* ((l0 (cons nil sequence)) (l l0)) + (do ((i 0 (f+ 1 i))) + ((>= i start)) + (declare (fixnum i)) + (pop l)) + (do ((i start (f+ 1 i)) (j 0)) + ((or (>= i end) (>= j count) (endp (cdr l))) (cdr l0)) + (declare (fixnum i j)) + (cond ((call-test test test-not item (funcall key (cadr l))) + (setf j (f+ 1 j)) + (rplacd l (cddr l))) + (t (setq l (cdr l)))))) + (let (,number-satisfied) + (declare (fixnum n)) + (when (< n count) (setq count n)) + (do ((newseq + (make-sequence (seqtype sequence) + (the fixnum (f- l count)))) + ,iterate-i-everywhere + (j 0) + ,kount-0) + (,endp-i-everywhere newseq) + (declare (fixnum i j k)) + (cond ((and ,i-in-range ,within-count ,satisfies-the-test) + ,kount-up) + (t (setf (elt newseq j) ,x) + (setf j (f+ 1 j))))))) + `(let (,number-satisfied) + (declare (fixnum n)) + (when (< n count) (setq count n)) + (do ((newseq + (make-sequence (seqtype sequence) (the fixnum (f- l count)))) + ,iterate-i-everywhere + (j (f+ -1 (the fixnum (f- l count)))) +; (j (f- (the fixnum (f+ -1 end)) n)) + ,kount-0) + (,endp-i-everywhere newseq) + (declare (fixnum i j k)) + (cond ((and ,i-in-range ,within-count ,satisfies-the-test) + ,kount-up) + (t (setf (elt newseq j) ,x) + (setq j (f+ -1 j)))))))) + + +(defseq count () nil nil + `(do (,iterate-i ,kount-0) + (,endp-i k) + (declare (fixnum i k)) + (when (and ,satisfies-the-test) + ,kount-up))) + + +(defseq internal-count () t nil + `(do (,iterate-i ,kount-0) + (,endp-i k) + (declare (fixnum i k)) + (when (and ,within-count ,satisfies-the-test) + ,kount-up))) + + +(defseq substitute (newitem) t t + `(do ((newseq (make-sequence (seqtype sequence) l)) + ,iterate-i-everywhere + ,kount-0) + (,endp-i-everywhere newseq) + (declare (fixnum i k)) + (cond ((and ,i-in-range ,within-count ,satisfies-the-test) + (setf (elt newseq i) newitem) + ,kount-up) + (t (setf (elt newseq i) ,x)))))) + + +(defseq nsubstitute (newitem) t nil + `(do (,iterate-i ,kount-0) + (,endp-i sequence) + (declare (fixnum i k)) + (when (and ,within-count ,satisfies-the-test) + (setf ,x newitem) + ,kount-up))) + + +(defseq find () nil nil + `(do (,iterate-i) + (,endp-i nil) + (declare (fixnum i)) + (when ,satisfies-the-test (return ,x)))) + + +(defseq position () nil nil + `(do (,iterate-i) + (,endp-i nil) + (declare (fixnum i)) + (when ,satisfies-the-test (return i)))) + + +(defun remove-duplicates (sequence + &key from-end + test test-not + start end + (key #'identity)) + (and test test-not (test-error)) + (when (and (listp sequence) (not from-end) (null start) + (null end)) + (when (endp sequence) (return-from remove-duplicates nil)) + (do ((l sequence (cdr l)) (l1 nil)) + ((endp (cdr l)) + (return-from remove-duplicates (nreconc l1 l))) + (unless (member1 (car l) (cdr l) + :test test :test-not test-not + :key key) + (setq l1 (cons (car l) l1))))) + (delete-duplicates sequence + :from-end from-end + :test test :test-not test-not + :start start :end end + :key key)) + + +(defun delete-duplicates (sequence + &key from-end + test test-not + start + end + (key #'identity) + &aux (l (length sequence))) + (declare (fixnum l)) + (and test test-not (test-error)) + (when (and (listp sequence) (not from-end) (null start) + (null end)) + (when (endp sequence) (return-from delete-duplicates nil)) + (do ((l sequence)) + ((endp (cdr l)) + (return-from delete-duplicates sequence)) + (cond ((member1 (car l) (cdr l) + :test test :test-not test-not + :key key) + (rplaca l (cadr l)) + (rplacd l (cddr l))) + (t (setq l (cdr l)))))) + (with-start-end start end sequence + (if (not from-end) + (do ((n 0) + (i start (f+ 1 i))) + ((>= i end) + (do ((newseq (make-sequence (seqtype sequence) + (the fixnum (f- l n)))) + (i 0 (f+ 1 i)) + (j 0)) + ((>= i l) newseq) + (declare (fixnum i j)) + (cond ((and (<= start i) + (< i end) + (position (funcall key (elt sequence i)) + sequence + :test test + :test-not test-not + :start (the fixnum (f+ 1 i)) + :end end + :key key))) + (t + (setf (elt newseq j) (elt sequence i)) + (setf j (f+ 1 j)))))) + (declare (fixnum n i)) + (when (position (funcall key (elt sequence i)) + sequence + :test test + :test-not test-not + :start (the fixnum (f+ 1 i)) + :end end + :key key) + (setf n (f+ 1 n)))) + (do ((n 0) + (i (f+ -1 end) (f+ -1 i))) + ((< i start) + (do ((newseq (make-sequence (seqtype sequence) + (the fixnum (f- l n)))) + (i (f+ -1 l) (f+ -1 i)) + (j (f- (the fixnum (f+ -1 l)) n))) + ((< i 0) newseq) + (declare (fixnum i j)) + (cond ((and (<= start i) + (< i end) + (position (funcall key (elt sequence i)) + sequence + :from-end t + :test test + :test-not test-not + :start start + :end i + :key key))) + (t + (setf (elt newseq j) (elt sequence i)) + (setq j (f+ -1 j)))))) + (declare (fixnum n i)) + (when (position (funcall key (elt sequence i)) + sequence + :from-end t + :test test + :test-not test-not + :start start + :end i + :key key) + (setf n (f+ 1 n))))))) + + +(defun mismatch (sequence1 sequence2 + &key from-end test test-not + (key #'identity) + start1 start2 + end1 end2) + (and test test-not (test-error)) + (with-start-end start1 end1 sequence1 + (with-start-end start2 end2 sequence2 + (if (not from-end) + (do ((i1 start1 (f+ 1 i1)) + (i2 start2 (f+ 1 i2))) + ((or (>= i1 end1) (>= i2 end2)) + (if (and (>= i1 end1) (>= i2 end2)) nil i1)) + (declare (fixnum i1 i2)) + (unless (call-test test test-not + (funcall key (elt sequence1 i1)) + (funcall key (elt sequence2 i2))) + (return i1))) + (do ((i1 (f+ -1 end1) (f+ -1 i1)) + (i2 (f+ -1 end2) (f+ -1 i2))) + ((or (< i1 start1) (< i2 start2)) + (if (and (< i1 start1) (< i2 start2)) nil (f+ 1 i1))) + (declare (fixnum i1 i2)) + (unless (call-test test test-not + (funcall key (elt sequence1 i1)) + (funcall key (elt sequence2 i2))) + (return (f+ 1 i1)))))))) + + +(defun search (sequence1 sequence2 + &key from-end test test-not + (key #'identity) + start1 start2 + end1 end2) + (and test test-not (test-error)) + (with-start-end start1 end1 sequence1 + (with-start-end start2 end2 sequence2 + (if (not from-end) + (loop + (do ((i1 start1 (f+ 1 i1)) + (i2 start2 (f+ 1 i2))) + ((>= i1 end1) (return-from search start2)) + (declare (fixnum i1 i2)) + (when (>= i2 end2) (return-from search nil)) + (unless (call-test test test-not + (funcall key (elt sequence1 i1)) + (funcall key (elt sequence2 i2))) + (return nil))) + (setf start2 (f+ 1 start2))) + (loop + (do ((i1 (f+ -1 end1) (f+ -1 i1)) + (i2 (f+ -1 end2) (f+ -1 i2))) + ((< i1 start1) (return-from search (the fixnum (f+ 1 i2)))) + (declare (fixnum i1 i2)) + (when (< i2 start2) (return-from search nil)) + (unless (call-test test test-not + (funcall key (elt sequence1 i1)) + (funcall key (elt sequence2 i2))) + (return nil))) + (setq end2 (f+ -1 end2))))))) + + +(defun sort (sequence predicate &key (key #'identity)) + (if (listp sequence) + (list-merge-sort sequence predicate key) + (quick-sort sequence 0 (the fixnum (length sequence)) predicate key))) + + +(defun list-merge-sort (l predicate key) + (labels + ((sort (l) + (prog ((i 0) left right l0 l1 key-left key-right) + (declare (fixnum i)) + (setq i (length l)) + (cond ((< i 2) (return l)) + ((= i 2) + (setq key-left (funcall key (car l))) + (setq key-right (funcall key (cadr l))) + (cond ((funcall predicate key-left key-right) (return l)) + ((funcall predicate key-right key-left) + (return (nreverse l))) + (t (return l))))) + (setq i (floor i 2)) + (do ((j 1 (f+ 1 j)) (l1 l (cdr l1))) + ((>= j i) + (setq left l) + (setq right (cdr l1)) + (rplacd l1 nil)) + (declare (fixnum j))) + (setq left (sort left)) + (setq right (sort right)) + (cond ((endp left) (return right)) + ((endp right) (return left))) + (setq l0 (cons nil nil)) + (setq l1 l0) + (setq key-left (funcall key (car left))) + (setq key-right (funcall key (car right))) + loop + (cond ((funcall predicate key-left key-right) (go left)) + ((funcall predicate key-right key-left) (go right)) + (t (go left))) + left + (rplacd l1 left) + (setq l1 (cdr l1)) + (setq left (cdr left)) + (when (endp left) + (rplacd l1 right) + (return (cdr l0))) + (setq key-left (funcall key (car left))) + (go loop) + right + (rplacd l1 right) + (setq l1 (cdr l1)) + (setq right (cdr right)) + (when (endp right) + (rplacd l1 left) + (return (cdr l0))) + (setq key-right (funcall key (car right))) + (go loop)))) + (sort l))) + + +#| +(defun list-quick-sort (l predicate key) + (if (or (endp l) (endp (cdr l))) + l + (multiple-value-bind (x y) + (list-quick-sort-partition (car l) (cdr l) predicate key) + (nconc (list-quick-sort x predicate key) + (list (car l)) + (list-quick-sort y predicate key))))) + +(defun list-quick-sort-partition (k l predicate key) + (do ((l l (cdr l)) (x nil) (y nil)) + ((endp l) (values (nreverse x) (nreverse y))) + (if (funcall predicate (funcall key (car l)) (funcall key k)) + (setq x (cons (car l) x)) + (setq y (cons (car l) y))))) +|# + + +(proclaim '(function quick-sort (t fixnum fixnum t t) t)) + +(defun quick-sort (seq start end pred key) + (declare (fixnum start end)) + (if (<= end (the fixnum (f+ 1 start))) + seq + (let* ((j start) (k end) (d (elt seq start)) (kd (funcall key d))) + (declare (fixnum j k)) + (block outer-loop + (loop (loop (setq k (f+ -1 k)) + (unless (< j k) (return-from outer-loop)) + (when (funcall pred (funcall key (elt seq k)) kd) + (return))) + (loop (setf j (f+ 1 j)) + (unless (< j k) (return-from outer-loop)) + (unless (funcall pred (funcall key (elt seq j)) kd) + (return))) + (let ((temp (elt seq j))) + (setf (elt seq j) (elt seq k) + (elt seq k) temp)))) + (setf (elt seq start) (elt seq j) + (elt seq j) d) + (quick-sort seq start j pred key) + (quick-sort seq (f+ 1 j) end pred key)))) + +(defun stable-sort (sequence predicate &key (key #'identity)) + (if (listp sequence) + (list-merge-sort sequence predicate key) + (if (or (stringp sequence) (bit-vector-p sequence)) + (sort sequence predicate :key key) + (coerce (list-merge-sort (coerce sequence 'list) + predicate + key) + (seqtype sequence))))) + + +(defun merge (result-type sequence1 sequence2 predicate + &key (key #'identity) + &aux (l1 (length sequence1)) (l2 (length sequence2))) + (declare (fixnum l1 l2)) + (when (equal key 'nil) (setq key #'identity)) + (do ((newseq (make-sequence result-type (the fixnum (f+ l1 l2)))) + (j 0 (f+ 1 j)) + (i1 0) + (i2 0)) + ((and (= i1 l1) (= i2 l2)) newseq) + (declare (fixnum j i1 i2)) + (cond ((and (< i1 l1) (< i2 l2)) + (cond ((funcall predicate + (funcall key (elt sequence1 i1)) + (funcall key (elt sequence2 i2))) + (setf (elt newseq j) (elt sequence1 i1)) + (setf i1 (f+ 1 i1))) + ((funcall predicate + (funcall key (elt sequence2 i2)) + (funcall key (elt sequence1 i1))) + (setf (elt newseq j) (elt sequence2 i2)) + (setf i2 (f+ 1 i2))) + (t + (setf (elt newseq j) (elt sequence1 i1)) + (setf i1 (f+ 1 i1))))) + ((< i1 l1) + (setf (elt newseq j) (elt sequence1 i1)) + (setf i1 (f+ 1 i1))) + (t + (setf (elt newseq j) (elt sequence2 i2)) + (setf i2 (f+ 1 i2)))))) + +(defun map-into (result-sequence function &rest sequences) +; "map-into: (result-sequence function &rest sequences)" + (let ((nel (apply #'min (if (subtypep (type-of result-sequence) 'vector) + (array-dimension result-sequence 0) + (length result-sequence)) + (mapcar #'length sequences)))) + ;; Set the fill pointer to the number of iterations + (when (and (subtypep (type-of result-sequence) 'vector) + (array-has-fill-pointer-p result-sequence)) + (setf (fill-pointer result-sequence) nel)) + ;; Perform mapping + (dotimes (k nel result-sequence) + (setf (elt result-sequence k) + (apply function (mapcar #'(lambda (v) (elt v k)) sequences)))))) + + +(defmacro with-hash-table-iterator ((name hash-table) &body body) + (let ((table (gensym )) + (ind (gensym "ind"))) + `(let ((,table ,hash-table) + (,ind 0)) + (macrolet ((,name () + `(multiple-value-bind + (more key val) + (si::next-hash-table-entry ,',table ,',ind) + (cond ((>= (the fixnum more) 0) + (setq ,',ind more) + (values t key val)) + (t (values nil nil nil)))))) + ,@body)))) + + diff --git a/lsp/gcl_serror.lsp b/lsp/gcl_serror.lsp new file mode 100755 index 0000000..95f0c9a --- /dev/null +++ b/lsp/gcl_serror.lsp @@ -0,0 +1,282 @@ +;; -*-Lisp-*- +(in-package :si) + +(macrolet + ((make-conditionp (condition &aux (n (intern (string-concatenate (string condition) "P")))) + `(defun ,n (x &aux (z (si-find-class ',condition))) + (when z + (funcall (setf (symbol-function ',n) (lambda (x) (typep x z))) x)))) + (make-condition-classp (class &aux (n (intern (string-concatenate (string class) "-CLASS-P")))) + `(defun ,n (x &aux (s (si-find-class 'standard-class)) (z (si-find-class ',class))) + (when (and s z) + (funcall (setf (symbol-function ',n) + (lambda (x &aux (x (if (symbolp x) (si-find-class x) x))) + (when (typep x s) + (member z (si-class-precedence-list x))))) x))))) + (make-conditionp condition) + (make-conditionp warning) + (make-condition-classp condition) + (make-condition-classp simple-condition)) + +(proclaim '(ftype (function (t *) t) make-condition)) + +(defun coerce-to-condition (datum arguments default-type function-name) + (cond ((conditionp datum) + (if arguments + (cerror "ignore the additional arguments." + 'simple-type-error + :datum arguments + :expected-type 'null + :format-control "you may not supply additional arguments ~ + when giving ~s to ~s." + :format-arguments (list datum function-name))) + datum) + ((condition-class-p datum) + (apply #'make-condition datum arguments)) + ((when (condition-class-p default-type) (or (stringp datum) (functionp datum))) + (make-condition default-type :format-control datum :format-arguments arguments)) + ((coerce-to-string datum arguments)))) + +(defvar *handler-clusters* nil) +(defvar *break-on-signals* nil) + +(defun signal (datum &rest arguments) + (declare (optimize (safety 1))) + (let ((*handler-clusters* *handler-clusters*) + (condition (coerce-to-condition datum arguments 'simple-condition 'signal))) + (if (typep condition *break-on-signals*) + (break "~a~%break entered because of *break-on-signals*." condition)) + (do nil ((not *handler-clusters*)) + (dolist (handler (pop *handler-clusters*)) + (when (typep condition (car handler)) + (funcall (cdr handler) condition)))) + nil)) + +(defvar *debugger-hook* nil) +(defvar *debug-level* 1) +(defvar *debug-restarts* nil) +(defvar *debug-abort* nil) +(defvar *debug-continue* nil) +(defvar *abort-restarts* nil) + +(defun break-level-invoke-restart (n) + (cond ((when (plusp n) (< n (+ (length *debug-restarts*) 1))) + (invoke-restart-interactively (nth (1- n) *debug-restarts*))) + ((format t "~&no such restart.")))) + +(defun find-ihs (s i &optional (j i)) + (cond ((eq (ihs-fname i) s) i) + ((and (> i 0) (find-ihs s (1- i) j))) + (j))) + +(defmacro without-interrupts (&rest forms) + `(let (*quit-tag* *quit-tags* *restarts*) + ,@forms)) + +(defun process-args (args &aux (control (member :format-control args))) + (labels ((r (x &aux (z (member-if (lambda (x) (member x '(:format-control :format-arguments))) x))) + (if z (nconc (ldiff x z) (r (cddr z))) x))) + (if control + (nconc (r args) (list (apply 'format nil (cadr control) (cadr (member :format-arguments args))))) + args))) + +(defun coerce-to-string (datum args) + (cond ((stringp datum) + (if args + (let ((*print-pretty* nil) + (*print-level* *debug-print-level*) + (*print-length* *debug-print-level*) + (*print-case* :upcase)) + (apply 'format nil datum args)) + datum)) + ((symbolp datum) + (let ((args (process-args args))) + (substitute + #\^ #\~ + (coerce-to-string + (if args + (apply 'string-concatenate (cons datum (make-list (length args) :initial-element " ~s"))) + (string datum)) + args)))) + ("unknown error"))) + +(defvar *break-on-warnings* nil) + +(defun warn (datum &rest arguments) + (declare (optimize (safety 2))) + (let ((c (process-error datum arguments 'simple-warning))) + (check-type c (or string (satisfies warningp)) "a warning condition") + (when *break-on-warnings* + (break "~A~%break entered because of *break-on-warnings*." c)) + (restart-case + (signal c) + (muffle-warning nil :report "Skip warning." (return-from warn nil))) + (format *error-output* "~&Warning: ~a~%" c) + nil)) + +(dolist (l '(break cerror error universal-error-handler ihs-top get-sig-fn-name next-stack-frame check-type-symbol)) + (setf (get l 'dbl-invisible) t)) + +(defvar *sig-fn-name* nil) + +(defun get-sig-fn-name (&aux (p (ihs-top))(p (next-stack-frame p))) + (when p (ihs-fname p))) + +(defun process-error (datum args &optional (default-type 'simple-error)) + (let ((internal (cond ((simple-condition-class-p datum) + (find-symbol (string-concatenate "INTERNAL-" (string datum)) :conditions)) + ((condition-class-p datum) + (find-symbol (string-concatenate "INTERNAL-SIMPLE-" (string datum)) :conditions))))) + (coerce-to-condition (or internal datum) (if internal (list* :function-name *sig-fn-name* args) args) default-type 'process-error))) + +(defun universal-error-handler (n cp fn cs es &rest args &aux (*sig-fn-name* fn)) + (declare (ignore es)) + (if cp (apply #'cerror cs n args) (apply #'error n args))) + +(defun cerror (continue-string datum &rest args &aux (*sig-fn-name* (or *sig-fn-name* (get-sig-fn-name)))) + (values + (with-simple-restart + (continue continue-string args) + (apply #'error datum args)))) +(putprop 'cerror t 'compiler::cmp-notinline) + + +(defun error (datum &rest args &aux (*sig-fn-name* (or *sig-fn-name* (get-sig-fn-name)))) + (let ((c (process-error datum args))(q (or *quit-tag* +top-level-quit-tag+))) + (signal c) + (invoke-debugger c) + (throw q q))) +(putprop 'error t 'compiler::cmp-notinline) + + +(defun invoke-debugger (condition) + + (when *debugger-hook* + (let ((hook *debugger-hook*) *debugger-hook*) + (funcall hook condition hook))) + + (maybe-clear-input) + + (let ((correctable (find-restart 'continue)) + *print-pretty* + (*print-level* *debug-print-level*) + (*print-length* *debug-print-level*) + (*print-case* :upcase)) + (terpri *error-output*) + (format *error-output* (if (and correctable *break-enable*) "~&Correctable error: " "~&Error: ")) + (let ((*indent-formatted-output* t)) + (when (stringp condition) (format *error-output* condition))) + (terpri *error-output*) + (if (> (length *link-array*) 0) + (format *error-output* "Fast links are on: do (si::use-fast-links nil) for debugging~%")) + (format *error-output* "Signalled by ~:@(~S~).~%" (or *sig-fn-name* "an anonymous function")) + (when (and correctable *break-enable*) + (format *error-output* "~&If continued: ") + (funcall (restart-report-function correctable) *error-output*)) + (force-output *error-output*) + (when *break-enable* (break-level condition)))) + + +(defun dbl-eval (- &aux (break-command t)) + (let ((val-list (multiple-value-list + (cond + ((keywordp -) (break-call - nil 'break-command)) + ((and (consp -) (keywordp (car -))) (break-call (car -) (cdr -) 'break-command)) + ((integerp -) (break-level-invoke-restart -)) + (t (setq break-command nil) (evalhook - nil nil *break-env*)))))) + (cons break-command val-list))) + +(defun dbl-rpl-loop (p-e-p) + + (setq +++ ++ ++ + + -) + + (if *no-prompt* + (setq *no-prompt* nil) + (format *debug-io* "~&~a~a>~{~*>~}" + (if p-e-p "" "dbl:") + (if (eq *package* (find-package 'user)) "" (package-name *package*)) + *break-level*)) + (force-output *error-output*) + + (setq - (dbl-read *debug-io* nil *top-eof*)) + (when (eq - *top-eof*) (bye -1)) + (let* ((ev (dbl-eval -)) + (break-command (car ev)) + (values (cdr ev))) + (unless (and break-command (eq (car values) :resume)) + (setq /// // // / / values *** ** ** * * (car /)) + (fresh-line *debug-io*) + (dolist (val /) + (prin1 val *debug-io*) + (terpri *debug-io*)) + (dbl-rpl-loop p-e-p)))) + +(defun do-break-level (at env p-e-p debug-level); break-level + + (unless + (with-simple-restart + (abort "Return to debug level ~D." debug-level) + + (catch-fatal 1) + (setq *interrupt-enable* t) + (cond (p-e-p + (format *debug-io* "~&~A~2%" at) + (set-current) + (setq *no-prompt* nil) + (show-restarts)) + ((set-back at env))) + + (not (catch 'step-continue (dbl-rpl-loop p-e-p)))) + + (terpri *debug-io*) + (break-current) + (do-break-level at env p-e-p debug-level))) + + +(defun break-level (at &optional env) + (let* ((p-e-p (unless (listp at) t)) + (+ +) (++ ++) (+++ +++) + (- -) + (* *) (** **) (*** ***) + (/ /) (// //) (/// ///) + (debug-level *debug-level*) + (*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*)) + *quit-tag* + (*break-level* (if p-e-p (cons t *break-level*) *break-level*)) + (*ihs-base* (1+ *ihs-top*)) + (*ihs-top* (ihs-top)) + (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top)))) + (*frs-top* (frs-top)) + (*current-ihs* *ihs-top*) + (*debug-level* (1+ *debug-level*)) + (*debug-restarts* (compute-restarts)) + (*debug-abort* (find-restart 'abort)) + (*debug-continue* (find-restart 'continue)) + (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*)) + (*readtable* (or *break-readtable* *readtable*)) + *break-env* *read-suppress*) + + (do-break-level at env p-e-p debug-level))) + +(putprop 'break-level t 'compiler::cmp-notinline) + +(defun break (&optional format-string &rest args &aux message (*sig-fn-name* (or *sig-fn-name* (get-sig-fn-name)))) + + (let ((*print-pretty* nil) + (*print-level* 4) + (*print-length* 4) + (*print-case* :upcase)) + (terpri *error-output*) + (cond (format-string + (format *error-output* "~&Break: ") + (let ((*indent-formatted-output* t)) + (apply 'format *error-output* format-string args)) + (terpri *error-output*) + (setq message (apply 'format nil format-string args))) + (t (format *error-output* "~&Break.~%") + (setq message "")))) + (with-simple-restart + (continue "Return from break.") + (break-level message)) + nil) +(putprop 'break t 'compiler::cmp-notinline) diff --git a/lsp/gcl_setf.lsp b/lsp/gcl_setf.lsp new file mode 100755 index 0000000..59e05b0 --- /dev/null +++ b/lsp/gcl_setf.lsp @@ -0,0 +1,536 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; setf.lsp +;;;; +;;;; setf routines + + +(in-package :si) + + +(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) +;(eval-when (eval compile) (defun si:clear-compiler-properties (symbol))) +(eval-when (eval compile) (setq si:*inhibit-macro-special* nil)) + + +;;; DEFSETF macro. +(defmacro defsetf (access-fn &rest rest) + (cond ((and (car rest) (or (symbolp (car rest)) (functionp (car rest)))) + `(eval-when(compile eval load) + (si:putprop ',access-fn ',(car rest) 'setf-update-fn) + (remprop ',access-fn 'setf-lambda) + (remprop ',access-fn 'setf-method) + (si:putprop ',access-fn + ,(when (not (endp (cdr rest))) + (unless (stringp (cadr rest)) + (error "A doc-string expected.")) + (unless (endp (cddr rest)) + (error "Extra arguments.")) + (cadr rest)) + 'setf-documentation) + ',access-fn)) + (t + (unless (= (list-length (cadr rest)) 1) + (error "(store-variable) expected.")) + `(eval-when (compile eval load) + (si:putprop ',access-fn ',rest 'setf-lambda) + (remprop ',access-fn 'setf-update-fn) + (remprop ',access-fn 'setf-method) + (si:putprop ',access-fn + ,(find-documentation (cddr rest)) + 'setf-documentation) + ',access-fn)))) + + +;;; DEFINE-SETF-METHOD macro. +(defmacro define-setf-method (access-fn &rest rest &aux args env body) + (multiple-value-setq (args env) + (get-&environment (car rest))) + (setq body (cdr rest)) + (cond (env (setq args (cons env args))) + (t (setq args (cons (gensym) args)) + (push `(declare (ignore ,(car args))) body))) + `(eval-when (compile eval load) + (si:putprop ',access-fn #'(lambda ,args ,@ body) 'setf-method) + (remprop ',access-fn 'setf-lambda) + (remprop ',access-fn 'setf-update-fn) + (si:putprop ',access-fn + ,(find-documentation (cdr rest)) + 'setf-documentation) + ',access-fn)) + + +;;; GET-SETF-EXPANSION. +;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE +;;; and checks the number of the store variable. +(defun get-setf-expansion (form &optional env) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-method-multiple-value form env) + (unless (= (list-length stores) 1) + (error "Multiple store-variables are not allowed.")) + (values vars vals stores store-form access-form))) + + +;;;; GET-SETF-METHOD-MULTIPLE-VALUE. + +(defun get-setf-method-multiple-value (form &optional env &aux tem) + (cond ((symbolp form) + (let ((store (gensym))) + (values nil nil (list store) `(setq ,form ,store) form))) + ((or (not (consp form)) (not (symbolp (car form)))) + (error "Cannot get the setf-method of ~S." form)) + ((and env (setq tem (assoc (car form) (second env)))) + (setq tem (macroexpand form env)) + (if (eq form tem) (error "Cannot get setf-method for ~a" form)) + (return-from get-setf-method-multiple-value + (get-setf-method-multiple-value tem env))) + ((get (car form) 'setf-method) + (apply (get (car form) 'setf-method) env (cdr form))) + ((or (get (car form) 'setf-update-fn) + (setq tem (get (car form) 'si::structure-access))) + (let ((vars (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (cdr form))) + (store (gensym))) + (values vars (cdr form) (list store) + (cond (tem + (setf-structure-access (car vars) (car tem) + (cdr tem) store)) + (t + `(,(get (car form) 'setf-update-fn) + ,@vars ,store))) + (cons (car form) vars)))) + ((get (car form) 'setf-lambda) + (let* ((vars (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (cdr form))) + (store (gensym)) + (l (get (car form) 'setf-lambda)) + ;; this looks bogus to me. What if l is compiled?--wfs + (f `(lambda ,(car l) #'(lambda ,(cadr l) ,@(cddr l))))) + (values vars (cdr form) (list store) + (funcall (apply f vars) store) + (cons (car form) vars)))) + ((macro-function (car form)) + (get-setf-method-multiple-value (macroexpand form))) + (t + (error 'program-error :format-control "Cannot expand the SETF form ~S." :format-arguments (list form))))) + + +;;;; SETF definitions. + +(defsetf car (x) (y) `(progn (rplaca ,x ,y) ,y)) +(defsetf cdr (x) (y) `(progn (rplacd ,x ,y), y)) +(defsetf caar (x) (y) `(progn (rplaca (car ,x) ,y) ,y)) +(defsetf cdar (x) (y) `(progn (rplacd (car ,x) ,y) ,y)) +(defsetf cadr (x) (y) `(progn (rplaca (cdr ,x) ,y) ,y)) +(defsetf cddr (x) (y) `(progn (rplacd (cdr ,x) ,y) ,y)) +(defsetf caaar (x) (y) `(progn (rplaca (caar ,x) ,y) ,y)) +(defsetf cdaar (x) (y) `(progn (rplacd (caar ,x) ,y) ,y)) +(defsetf cadar (x) (y) `(progn (rplaca (cdar ,x) ,y) ,y)) +(defsetf cddar (x) (y) `(progn (rplacd (cdar ,x) ,y) ,y)) +(defsetf caadr (x) (y) `(progn (rplaca (cadr ,x) ,y) ,y)) +(defsetf cdadr (x) (y) `(progn (rplacd (cadr ,x) ,y) ,y)) +(defsetf caddr (x) (y) `(progn (rplaca (cddr ,x) ,y) ,y)) +(defsetf cdddr (x) (y) `(progn (rplacd (cddr ,x) ,y) ,y)) +(defsetf caaaar (x) (y) `(progn (rplaca (caaar ,x) ,y) ,y)) +(defsetf cdaaar (x) (y) `(progn (rplacd (caaar ,x) ,y) ,y)) +(defsetf cadaar (x) (y) `(progn (rplaca (cdaar ,x) ,y) ,y)) +(defsetf cddaar (x) (y) `(progn (rplacd (cdaar ,x) ,y) ,y)) +(defsetf caadar (x) (y) `(progn (rplaca (cadar ,x) ,y) ,y)) +(defsetf cdadar (x) (y) `(progn (rplacd (cadar ,x) ,y) ,y)) +(defsetf caddar (x) (y) `(progn (rplaca (cddar ,x) ,y) ,y)) +(defsetf cdddar (x) (y) `(progn (rplacd (cddar ,x) ,y) ,y)) +(defsetf caaadr (x) (y) `(progn (rplaca (caadr ,x) ,y) ,y)) +(defsetf cdaadr (x) (y) `(progn (rplacd (caadr ,x) ,y) ,y)) +(defsetf cadadr (x) (y) `(progn (rplaca (cdadr ,x) ,y) ,y)) +(defsetf cddadr (x) (y) `(progn (rplacd (cdadr ,x) ,y) ,y)) +(defsetf caaddr (x) (y) `(progn (rplaca (caddr ,x) ,y) ,y)) +(defsetf cdaddr (x) (y) `(progn (rplacd (caddr ,x) ,y) ,y)) +(defsetf cadddr (x) (y) `(progn (rplaca (cdddr ,x) ,y) ,y)) +(defsetf cddddr (x) (y) `(progn (rplacd (cdddr ,x) ,y) ,y)) +(defsetf first (x) (y) `(progn (rplaca ,x ,y) ,y)) +(defsetf second (x) (y) `(progn (rplaca (cdr ,x) ,y) ,y)) +(defsetf third (x) (y) `(progn (rplaca (cddr ,x) ,y) ,y)) +(defsetf fourth (x) (y) `(progn (rplaca (cdddr ,x) ,y) ,y)) +(defsetf fifth (x) (y) `(progn (rplaca (cddddr ,x) ,y) ,y)) +(defsetf sixth (x) (y) `(progn (rplaca (nthcdr 5 ,x) ,y) ,y)) +(defsetf seventh (x) (y) `(progn (rplaca (nthcdr 6 ,x) ,y) ,y)) +(defsetf eighth (x) (y) `(progn (rplaca (nthcdr 7 ,x) ,y) ,y)) +(defsetf ninth (x) (y) `(progn (rplaca (nthcdr 8 ,x) ,y) ,y)) +(defsetf tenth (x) (y) `(progn (rplaca (nthcdr 9 ,x) ,y) ,y)) +(defsetf rest (x) (y) `(progn (rplacd ,x ,y) ,y)) +(defsetf svref si:svset) +(defsetf elt si:elt-set) +(defsetf symbol-value set) +(defsetf symbol-function si:fset) +(defsetf macro-function (s) (v) `(progn (si:fset ,s (cons 'macro ,v)) ,v)) +(defsetf aref si:aset) +(defsetf get put-aux) +(defmacro put-aux (a b &rest l) + `(si::sputprop ,a ,b ,(car (last l)))) +(defsetf nth (n l) (v) `(progn (rplaca (nthcdr ,n ,l) ,v) ,v)) +(defsetf char si:char-set) +(defsetf schar si:schar-set) +(defsetf bit si:aset) +(defsetf sbit si:aset) +(defsetf fill-pointer si:fill-pointer-set) +(defsetf symbol-plist si:set-symbol-plist) +(defsetf gethash (k h &optional d) (v) `(si:hash-set ,k ,h ,v)) +(defsetf row-major-aref si:aset1) +(defsetf readtable-case si::set-readtable-case) +(defsetf compiler-macro-function (x) (y) `(setf (get ,x 'compiler-macro) ,y)) +(defsetf documentation (s d) (v) + `(case ,d + (variable (si:putprop ,s ,v 'variable-documentation)) + (function (si:putprop ,s ,v 'function-documentation)) + (structure (si:putprop ,s ,v 'structure-documentation)) + (type (si:putprop ,s ,v 'type-documentation)) + (setf (si:putprop ,s ,v 'setf-documentation)) + (t (error "~S is an illegal documentation type." ,d)))) + + +(define-setf-method getf (&environment env place indicator &optional default) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion place env) + (let ((itemp (gensym)) (store (gensym))) + (values `(,@vars ,itemp) + `(,@vals ,indicator) + (list store) + `(let ((,(car stores) (si:put-f ,access-form ,store ,itemp))) + ,store-form + ,store) + `(getf ,access-form ,itemp ,default))))) + +(defsetf subseq (sequence1 start1 &optional end1) + (sequence2) + `(replace ,sequence1 ,sequence2 :start1 ,start1 :end1 ,end1)) + +(define-setf-method the (&environment env type form) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion form env) + (let ((store (gensym))) + (values vars vals (list store) + `(let ((,(car stores) (the ,type ,store))) ,store-form) + `(the ,type ,access-form))))) + +#| +(define-setf-method apply (&environment env fn &rest rest) + (unless (and (consp fn) (eq (car fn) 'function) (symbolp (cadr fn)) + (null (cddr fn))) + (error "Can't get the setf-method of ~S." fn)) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion (cons (cadr fn) rest) env) + (unless (eq (car (last store-form)) (car (last vars))) + (error "Can't get the setf-method of ~S." fn)) + (values vars vals stores + `(apply #',(car store-form) ,@(cdr store-form)) + `(apply #',(cadr fn) ,@(cdr access-form))))) +|# + +(define-setf-method apply (&environment env fn &rest rest) + (unless (and (consp fn) + (or (eq (car fn) 'function) (eq (car fn) 'quote)) + (symbolp (cadr fn)) + (null (cddr fn))) + (error "Can't get the setf-method of ~S." fn)) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion (cons (cadr fn) rest) env) + (cond ((eq (car (last store-form)) (car (last vars))) + (values vars vals stores + `(apply #',(car store-form) ,@(cdr store-form)) + `(apply #',(cadr fn) ,@(cdr access-form)))) + ((eq (car (last (butlast store-form))) (car (last vars))) + (values vars vals stores + `(apply #',(car store-form) + ,@(cdr (butlast store-form 2)) + (append ,(car (last (butlast store-form))) + (list ,(car (last store-form))))) + `(apply #',(cadr fn) ,@(cdr access-form)))) + (t (error "Can't get the setf-method of ~S." fn))))) + +(define-setf-method char-bit (&environment env char name) + (multiple-value-bind (temps vals stores store-form access-form) + (get-setf-expansion char env) + (let ((ntemp (gensym)) + (store (gensym)) + (stemp (first stores))) + (values `(,ntemp ,@temps) + `(,name ,@vals) + (list store) + `(let ((,stemp (set-char-bit ,access-form ,ntemp ,store))) + ,store-form ,store) + `(char-bit ,access-form ,ntemp))))) + +(define-setf-method ldb (&environment env bytespec int) + (multiple-value-bind (temps vals stores store-form access-form) + (get-setf-expansion int env) + (let ((btemp (gensym)) + (store (gensym)) + (stemp (first stores))) + (values `(,btemp ,@temps) + `(,bytespec ,@vals) + (list store) + `(let ((,stemp (dpb ,store ,btemp ,access-form))) + ,store-form ,store) + `(ldb ,btemp ,access-form))))) + +(define-setf-method mask-field (&environment env bytespec int) + (multiple-value-bind (temps vals stores store-form access-form) + (get-setf-expansion int env) + (let ((btemp (gensym)) + (store (gensym)) + (stemp (first stores))) + (values `(,btemp ,@temps) + `(,bytespec ,@vals) + (list store) + `(let ((,stemp (deposit-field ,store ,btemp ,access-form))) + ,store-form ,store) + `(mask-field ,btemp ,access-form))))) + + +;;; The expansion function for SETF. +(defun setf-expand-1 (place newvalue env &aux g) + (when (and (consp place) (eq (car place) 'the)) + (return-from setf-expand-1 + (setf-expand-1 (caddr place) `(the ,(cadr place) ,newvalue) env))) + (when (and (consp place) (eq (car place) 'values)) + (do ((vl (cdr place) (cdr vl)) + (sym (gensym)) + (forms nil) + (n 0 (1+ n))) + ((endp vl) (return-from setf-expand-1 + `(let ((,sym (multiple-value-list ,newvalue))) + (values ,@(nreverse forms))))) + (declare (fixnum n) (object vl)) + (let ((method (if (symbolp (car vl)) 'setq 'setf))) + (push `(,method ,(car vl) (nth ,n ,sym)) forms)))) + (when (symbolp place) + (return-from setf-expand-1 `(setq ,place ,newvalue))) + (when (and (consp place) + (not (or (get (car place) 'setf-lambda) + (get (car place) 'setf-update-fn)))) + (multiple-value-setq (place g) (macroexpand place env)) + (if g (return-from setf-expand-1 (setf-expand-1 place newvalue env)))) + (when (and (symbolp (car place)) (setq g (get (car place) 'setf-update-fn))) + (return-from setf-expand-1 `(,g ,@(cdr place) ,newvalue))) + (cond ((and (symbolp (car place)) + (setq g (get (car place) 'structure-access))) + (return-from setf-expand-1 + (setf-structure-access (cadr place) (car g) (cdr g) newvalue)))) + + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion place env) + (declare (ignore access-form)) + `(let* ,(mapcar #'list + (append vars stores) + (append vals (list newvalue))) + ,store-form))) + +(defun setf-structure-access (struct type index newvalue) + (case type + (list `(si:rplaca-nthcdr ,struct ,index ,newvalue)) + (vector `(si:elt-set ,struct ,index ,newvalue)) + (t `(si::structure-set ,struct ',type ,index ,newvalue)))) + +(defun setf-expand (l env) + (cond ((endp l) nil) + ((endp (cdr l)) (error "~S is an illegal SETF form." l)) + (t + (cons (setf-expand-1 (car l) (cadr l) env) + (setf-expand (cddr l) env))))) + + +;;; SETF macro. + +(defun setf-helper (rest env) + (setq rest (cdr rest)) + (cond ((endp rest) nil) + ((endp (cdr rest)) (error "~S is an illegal SETF form." rest)) + ((endp (cddr rest)) (setf-expand-1 (car rest) (cadr rest) env)) + (t (cons 'progn (setf-expand rest env))))) + +;(setf (macro-function 'setf) 'setf-help) +(si::fset 'setf (cons 'macro (symbol-function 'setf-helper))) + +;;; PSETF macro. + +(defmacro psetf (&environment env &rest rest) + (cond ((endp rest) nil) + ((endp (cdr rest)) (error "~S is an illegal PSETF form." rest)) + ((endp (cddr rest)) + `(progn ,(setf-expand-1 (car rest) (cadr rest) env) + nil)) + (t + (do ((r rest (cddr r)) + (pairs nil) + (store-forms nil)) + ((endp r) + `(let* ,pairs + ,@(nreverse store-forms) + nil)) + (when (endp (cdr r)) (error "~S is an illegal PSETF form." rest)) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion (car r) env) + (declare (ignore access-form)) + (setq store-forms (cons store-form store-forms)) + (setq pairs + (nconc pairs + (mapcar #'list + (append vars stores) + (append vals (list (cadr r))))))))))) + + +;;; SHIFTF macro. +(defmacro shiftf (&environment env &rest rest ) + (do ((r rest (cdr r)) + (pairs nil) + (stores nil) + (store-forms nil) + (g (gensym)) + (access-forms nil)) + ((endp (cdr r)) + (setq stores (nreverse stores)) + (setq store-forms (nreverse store-forms)) + (setq access-forms (nreverse access-forms)) + `(let* ,(nconc pairs + (list (list g (car access-forms))) + (mapcar #'list stores (cdr access-forms)) + (list (list (car (last stores)) (car r)))) + ,@store-forms + ,g)) + (multiple-value-bind (vars vals stores1 store-form access-form) + (get-setf-expansion (car r) env) + (setq pairs (nconc pairs (mapcar #'list vars vals))) + (setq stores (cons (car stores1) stores)) + (setq store-forms (cons store-form store-forms)) + (setq access-forms (cons access-form access-forms))))) + + +;;; ROTATEF macro. +(defmacro rotatef (&environment env &rest rest ) + (do ((r rest (cdr r)) + (pairs nil) + (stores nil) + (store-forms nil) + (access-forms nil)) + ((endp r) + (setq stores (nreverse stores)) + (setq store-forms (nreverse store-forms)) + (setq access-forms (nreverse access-forms)) + `(let* ,(nconc pairs + (mapcar #'list stores (cdr access-forms)) + (list (list (car (last stores)) (car access-forms)))) + ,@store-forms + nil + )) + (multiple-value-bind (vars vals stores1 store-form access-form) + (get-setf-expansion (car r) env) + (setq pairs (nconc pairs (mapcar #'list vars vals))) + (setq stores (cons (car stores1) stores)) + (setq store-forms (cons store-form store-forms)) + (setq access-forms (cons access-form access-forms))))) + + +;;; DEFINE-MODIFY-MACRO macro. +(defmacro define-modify-macro (name lambda-list function &optional doc-string) + (let ((update-form + (do ((l lambda-list (cdr l)) + (vs nil)) + ((null l) `(list ',function access-form ,@(nreverse vs))) + (unless (eq (car l) '&optional) + (if (eq (car l) '&rest) + (return `(list* ',function + access-form + ,@(nreverse vs) + ,(cadr l)))) + (if (symbolp (car l)) + (setq vs (cons (car l) vs)) + (setq vs (cons (caar l) vs))))))) + `(defmacro ,name (&environment env reference . ,lambda-list) + ,@(if doc-string (list doc-string)) + (when (symbolp reference) + (return-from ,name + (let ((access-form reference)) + (list 'setq reference ,update-form)))) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion reference env) + (list 'let* + (mapcar #'list + (append vars stores) + (append vals (list ,update-form))) + store-form)))))))))))))))))))) + + +;;; Some macro definitions. + +(defmacro remf (&environment env place indicator) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion place env) + `(let* ,(mapcar #'list vars vals) + (multiple-value-bind (,(car stores) flag) + (si:rem-f ,access-form ,indicator) + ,store-form + flag)))) + +(define-modify-macro incf (&optional (delta 1)) +) +(define-modify-macro decf (&optional (delta 1)) -) + +(defmacro push (&environment env item place) + (let ((myitem (gensym))) + (when (symbolp place) + (return-from push `(let* ((,myitem ,item)) + (setq ,place (cons ,myitem ,place))))) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion place env) + `(let* ,(mapcar #'list + (append (list myitem) vars stores) + (append (list item) vals (list (list 'cons myitem access-form)))) + ,store-form)))) + +(defmacro pushnew (&environment env item place &rest rest) + (let ((myitem (gensym))) + (cond ((symbolp place) + (return-from pushnew `(let* ((,myitem ,item)) + (setq ,place (adjoin ,myitem ,place ,@rest)))))) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion place env) + `(let* ,(mapcar #'list + (append (list myitem) vars stores) + (append (list item) vals + (list (list* 'adjoin myitem access-form rest)))) + ,store-form)))) + +(defmacro pop (&environment env place) + (when (symbolp place) + (return-from pop + (let ((temp (gensym))) + `(let ((,temp (car ,place))) + (setq ,place (cdr ,place)) + ,temp)))) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-expansion place env) + `(let* ,(mapcar #'list + (append vars stores) + (append vals (list (list 'cdr access-form)))) + (prog1 (car ,access-form) + ,store-form)))) diff --git a/lsp/gcl_sharp.lsp b/lsp/gcl_sharp.lsp new file mode 100644 index 0000000..a6a2115 --- /dev/null +++ b/lsp/gcl_sharp.lsp @@ -0,0 +1,66 @@ +(in-package :si) + +(defstruct + context + (vec (make-array 0 :adjustable t :fill-pointer t) :type (vector t)) + (hash nil :type (or null hash-table)) + (spice (make-hash-table :test 'eq :rehash-size 2.0) :type hash-table)) + +(defun get-context (i) + (declare (fixnum i)) + (when *sharp-eq-context* + (let ((v (context-vec *sharp-eq-context*))) + (if (< i (length v)) (aref v i) + (let ((h (context-hash *sharp-eq-context*))) + (when h (gethash1 i h))))))) + +(defun push-context (i) + (declare (fixnum i)) + (unless *sharp-eq-context* (setq *sharp-eq-context* (make-context))) + (let* ((v (context-vec *sharp-eq-context*))(l (length v))(x (cons nil nil))) + (cond ((< i l) (error "#~s= multiply defined" i)) + ((= i l) (vector-push-extend x v (1+ l)) x) + ((let ((h (context-hash *sharp-eq-context*))) + (if h (when (gethash1 i h) (error "#~s= multiply defined" i)) + (setf (context-hash *sharp-eq-context*) (setq h (make-hash-table :test 'eql :rehash-size 2.0)))) + (setf (gethash i h) x)))))) + +(defconstant +nil-proxy+ (cons nil nil)) + +(defun sharp-eq-reader (stream subchar i &aux (x (push-context i))) + (declare (ignore subchar)(fixnum i)) + (let ((y (read stream t 'eof t))) + (when (when y (eq y (cdr x))) (error "#= circularly defined")) + (setf (car x) (or y +nil-proxy+)) + y)) + +(defun sharp-sharp-reader (stream subchar i &aux (x (get-context i))) + (declare (ignore stream subchar)(fixnum i)) + (unless x (error "#~s# without preceding #~s=" i i)) + (or (cdr x) (let ((s (alloc-spice))) (setf (gethash s (context-spice *sharp-eq-context*)) x (cdr x) s)))) + +(defun patch-sharp (x) + (typecase + x + (cons (setf (car x) (patch-sharp (car x)) (cdr x) (patch-sharp (cdr x))) x) + ((vector t) + (dotimes (i (length x) x) + (setf (aref x i) (patch-sharp (aref x i))))) + ((array t) + (dotimes (i (array-total-size x) x) + (aset1 x i (patch-sharp (row-major-aref x i))))) + (structure + (let ((d (structure-def x))) + (dotimes (i (structure-length x) x) + (declare (fixnum i)) + (structure-set x d i (patch-sharp (structure-ref x d i)))))) + (spice (let* ((y (gethash1 x (context-spice *sharp-eq-context*))) + (z (car y))) + (unless y (error "Spice ~s not defined" x)) + (unless (eq z +nil-proxy+) z))) + (otherwise x))) + +(set-dispatch-macro-character #\# #\= #'sharp-eq-reader) +(set-dispatch-macro-character #\# #\= #'sharp-eq-reader (standard-readtable)) +(set-dispatch-macro-character #\# #\# #'sharp-sharp-reader) +(set-dispatch-macro-character #\# #\# #'sharp-sharp-reader (standard-readtable)) diff --git a/lsp/gcl_sharp_uv.lsp b/lsp/gcl_sharp_uv.lsp new file mode 100644 index 0000000..f054bc8 --- /dev/null +++ b/lsp/gcl_sharp_uv.lsp @@ -0,0 +1,29 @@ +(in-package :si) + +(defun regexp-conv (stream) + + (let ((tem (make-array 10 :element-type 'character :fill-pointer 0))) + (or (eql (read-char stream) #\") + (error "sharp-u-reader reader needs a \" right after it")) + (loop + (let ((ch (read-char stream))) + (cond ((eql ch #\") (return tem)) + ((eql ch #\\) + (setq ch (read-char stream)) + (setq ch (or (cdr (assoc ch '((#\n . #\newline) + (#\t . #\tab) + (#\r . #\return)))) + ch)))) + (vector-push-extend ch tem))) + tem)) + +(defun sharp-u-reader (stream subchar arg) + (declare (ignore subchar arg)) + (regexp-conv stream)) + +(defun sharp-v-reader (stream subchar arg) + (declare (ignore subchar arg)) + `(load-time-value (compile-regexp ,(regexp-conv stream)))) + +(set-dispatch-macro-character #\# #\u 'sharp-u-reader) +(set-dispatch-macro-character #\# #\v 'sharp-v-reader) diff --git a/lsp/gcl_sloop.lsp b/lsp/gcl_sloop.lsp new file mode 100755 index 0000000..fa6783e --- /dev/null +++ b/lsp/gcl_sloop.lsp @@ -0,0 +1,1230 @@ +;;; -*- Mode:LISP; Package:(SLOOP LISP);Syntax:COMMON-LISP;Base:10 -*- ;;;;; +;;; ;;;;; +;;; Copyright (c) 1985,86 by William Schelter, ;;;;; +;;; All rights reserved ;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;; Report bugs to wfs@carl.ma.utexas.edu +;;; It comes with ABSOLUTELY NO WARRANTY but we hope it is useful. + + +;;; The following code is meant to run in COMMON LISP and to provide +;;; extensive iteration facilities, with very high backwards compatibility +;;; with the traditional loop macro. It is meant to be publicly available! +;;; Anyone is hereby given permission to copy it provided he does not make +;;; ANY changes to the file unless he is William Schelter. He may change +;;; the behavior after loading it by resetting the global variables such +;;; as like *Use-locatives*, *automatic-declarations*,.. listed at the +;;; beginning of this file. + +;;; The original of this file is on +;;; rascal.ics.utexas.edu:/usr2/ftp/pub/sloop.lisp. I am happy to accept +;;; suggestions for different defaults for various implementations, or for +;;; improvements. + + +;;If you want to redefine the common lisp loop you may include in your code: +;;; (defmacro loop (&body body) (parse-loop body)) + +;; Principal New Features + +;;; Sloop is extremely user extensible so that you may easily redefine +;;; most behavior, or add additional collections, and paths. There are a +;;; number of such examples defined in this file, including such +;;; constructs as + +;;; .. FOR v IN-FRINGE x .. (iterate through the fringe of a tree x) +;;; .. SUM v .. (add the v) +;;; .. AVERAGING v .. +;;; .. FOR sym IN-PACKAGE y (iterate through symbols in a package y) +;;; .. COLLATE v .. (for collecting X into an ordered list), +;;; .. FOR (elt i) IN-ARRAY ar (iterate through array ar, with index i) +;;; .. FOR (key elt) IN-TABLE foo.. (if foo is a hash table) + +;;; you can combine any collection method with any path. +;;; Also there is iteration over products so that you may write +;;; (SLOOP FOR i BELOW k +;;; SLOOP (FOR j BELOW i +;;; COLLECTING (foo i j))) + +;;; Declare is fully supported. The syntax would be +;;; (sloop for u in l with v = 0 +;;; declare (fixnum u v) +;;; do .... + +;;; This extensibility is gained by the ability to define a "loop-macro", +;;; which plays a role analagous to an ordiary lisp macro. See eg. +;;; definitions near that of "averaging". Essentially a "loop-macro" +;;; takes some arguments (supplied from the body of the loop following its +;;; occurrence, and returns a new form to be stuffed onto the front of the +;;; loop form, in place of it and its arguments). + +;;; Compile notes: For dec-20 clisp load the lisp file before compiling. + + +;;; there seems to be no unanimity about what in-package etc. does on +;;; loading and compiling a file. The following is as close to the +;;; examples in the Common Lisp manual, as we could make it. The user +;;; should put (require "SLOOP") and then (use-package "SLOOP") early in +;;; his init file. Note use of the string to avoid interning 'sloop in +;;; some other package. + + +(in-package "SLOOP" :use '(:LISP)) +(eval-when (compile eval load) + +(export '(loop-return sloop def-loop-collect def-loop-map + def-loop-for def-loop-macro local-finish + sloop-finish) (find-package "SLOOP")) + +) + +;;; some variables that may be changed to suit different implementations: + +(eval-when (compile load eval) + +(defvar *use-locatives* nil "See sloop.lisp") ;#+lispm t #-lispm nil +;;; If t should have locf, such that if we do +;;; (setf b nil) (setq a (locf b)) +;;; then the command +;;; (setf (cdr a) (cons 3 nil)) means that b==>(3). +;;; This is useful for building lists starting with a variable pointing to +;;; nil, since otherwise we must check each time if the list has really +;;; been started, before we do a (setf (cdr b) ..) + +(defvar *Automatic-declarations* #+lispm nil #-lispm + '(:from fixnum) "See sloop.lisp") + +;;; some other reasonable ones would be :count fixnum :max fixnum +;;; Automatic declarations for variables in the stepping and collecting, +;;; so for i below n, gives i and n a :from declaration (here fixnum) + + +;;valid keys in *automatic-declarations* +(defvar *auto-type* '(:from :in :collect)) +;;give automatic register declaration to these variables +(defvar *auto-register* '(:from :in :collect)) +(eval-when (compile eval load) +(proclaim '(declaration :register)) +) + + +(defvar *type-check* t "If t adds a type check on bounds of from loop +if there is and automatic declare") + +(defvar *macroexpand-hook-for-no-copy* #-(or lmi ti) 'funcall #+(or lmi ti) t) +;;; some lisps remember a macro so that (loop-return) will expand eq forms +;;; always in the same manner, even if the form is in a macrolet! To +;;; defeat this feature we copy all macro expansions unless +;;; *macro-expand-hook* = *macroexpand-hook-for-no-copy* +) + + +;;; *****ONLY CONDITIONALIZATIONS BELOW HERE SHOULD BE FOR BUG FIXES****** +;;; eg. some kcls don't return nil from a prog by default! + +;;; all macros here in here. +(eval-when (compile eval load) + +(defparameter *sloop-translations* '((appending . append) + ((collecting collect) . collect) + ((maximizing maximize) . maximize) + ((minimizing minimize) . minimize) + (nconcing . nconc) + ((count counting) . count) + (summing . sum) + (if . when) + (as . for) + (in-fringe . in-fringe) + (collate . collate) + (in-table . in-table) + (in-carefully . in-carefully) + (averaging . averaging) + (repeat . repeat) + (first-use . first-use) + (in-array . in-array)) + "A list of cons's where the translation is the cdr, and the car +is a list of names or name to be translated. Essentially allows 'globalizing' +a symbol for the purposes of being a keyword in a sloop") + + +(defparameter *additional-collections* nil) + +(defmacro lcase (item &body body) + (let (bod last-case tem) + (do ((rest body (cdr rest)) (v)) + ((or last-case (null rest))) + (setq v (car rest)) + (push + (cond ((eql (car v) t) (setq last-case t) v) + ((eql (car v) :collect) + `((loop-collect-keyword-p .item.) ,@ (cdr v))) + ((eql (car v) :no-body) + `((parse-no-body .item.) ,@ (cdr v))) + ((setq tem + (member (car v) '(sloop-macro sloop-for sloop-map))) + `((and (symbolp .item.)(get .item. ',(car tem))) ,@ (cdr v))) + (t + `((l-equal .item. ',(car v)) ,@ (cdr v)))) + bod)) + (or last-case (push `(t (error "lcase fell off end ~a " .item.)) bod)) + `(let ((.item. (translate-name ,item))) + (cond ,@ (nreverse bod))))) + +(defun desetq1 (form val) + (cond ((symbolp form) + (and form `(setf ,form ,val))) + ((consp form) + `(progn ,(desetq1 (car form) `(car ,val)) + ,@ (if (consp (cdr form)) + (list(desetq1 (cdr form) `(cdr ,val))) + (and (cdr form) `((setf ,(cdr form) (cdr ,val))))))) + (t (error "")))) + +(defmacro desetq (form val) + (cond ((atom val) (desetq1 form val)) + (t (let ((value (gensym))) + `(let ((,value ,val)) , (desetq1 form value)))))) + +(defmacro loop-return (&rest vals) + (cond ((<= (length vals) 1) + `(return ,@ vals)) + (t`(return (values ,@ vals))))) + +(defmacro sloop-finish () + `(go finish-loop)) + +(defmacro local-finish () + `(go finish-loop)) + +(defmacro sloop (&body body) + (parse-loop body)) + +(defmacro def-loop-map (name args &body body) + (def-loop-internal name args body 'map)) +(defmacro def-loop-for (name args &body body ) + (def-loop-internal name args body 'for nil 1)) +(defmacro def-loop-macro (name args &body body) + (def-loop-internal name args body 'macro)) +(defmacro def-loop-collect (name arglist &body body ) + "Define function of 2 args arglist= (collect-var value-to-collect)" + (def-loop-internal name arglist body 'collect '*additional-collections* 2 2)) + +(defmacro sloop-swap () + `(progn (rotatef a *loop-bindings*) + (rotatef b *loop-prologue*) + (rotatef c *loop-epilogue*) + (rotatef e *loop-end-test*) + (rotatef f *loop-increment*) + (setf *inner-sloop* (not *inner-sloop*)) + )) + +) ;;end of macros + +(defun l-equal (a b) + (and (symbolp a) + (cond ((symbolp b) + (equal (symbol-name a) (symbol-name b))) + ((listp b) + (member a b :test 'l-equal))))) + +(defun loop-collect-keyword-p (command) + (or (member command '(collect append nconc sum count) :test 'l-equal) + (find command *additional-collections* :test 'l-equal))) + +(defun translate-name (name) + (cond ((and (symbolp name) + (cdar (member name *sloop-translations* + :test 'l-equal :key 'car)))) + (t name))) + +(defun loop-pop () + (declare (special *last-val* *loop-form*)) + (cond (*loop-form* + (setq *last-val* (pop *loop-form*))) + (t (setq *last-val* 'empty-form) nil))) + +(defun loop-un-pop () (declare (special *last-val* *loop-form*)) + (case *last-val* + (empty-form nil) + (already-un-popped (error "you are un-popping without popping")) + (t (push *last-val* *loop-form*) + (setf *last-val* 'alread-un-popped)))) + +(defun loop-peek () (declare (special *last-val* *loop-form*)) + (car *loop-form*)) + +(defun loop-let-bindings(binds) + (do ((v (car binds) (cdr v))) + ((null v) (nreverse (car binds))) + (or (cdar v) (setf (car v) (caar v))))) + +(defun parse-loop (form &aux inner-body) + (let ((*loop-form* form) + (*Automatic-declarations* *Automatic-declarations*) + *last-val* *loop-map* + *loop-body* + *loop-name* + *loop-prologue* *inner-sloop* + *loop-epilogue* *loop-increment* + *loop-collect-pointers* *loop-map-declares* + *loop-collect-var* *no-declare* + *loop-end-test* + *loop-bindings* + *product-for* + *type-test-limit* + local-macros + (finish-loop 'finish-loop) + ) + (declare (special *loop-form* *last-val* *loop-map* + *loop-collect-pointers* + *loop-name* *inner-sloop* + *loop-body* + *loop-prologue* + *no-declare* + *loop-bindings* + *loop-collect-var* *loop-map-declares* + *loop-epilogue* *loop-increment* + *loop-end-test* *product-for* + *type-test-limit* + )) + (unless (and (symbolp (car *loop-form*)) (car *loop-form*)) + (push 'do *loop-form*)) ;compatible with common lisp loop.. + (parse-loop1) + (when (or *loop-map* *product-for*) + (or *loop-name* (setf *loop-name* (gensym "SLOOP"))) + (and (eql 'finish-loop finish-loop) + (setf finish-loop (gensym "FINISH")))) +;;; some one might use local-finish,local-return or sloop-finish, so they might +;;; be bound at an outer level. WE have to always include this since +;;; loop-return may be being bound outside. + (and ; *loop-name* + (push + `(loop-return (&rest vals) + `(return-from ,',*loop-name* (values ,@ vals))) + local-macros)) + (when t;; (or (> *loop-level* 1) (not (eql finish-loop 'finish-loop))) + (push `(sloop-finish () `(go ,',finish-loop)) local-macros) + (push `(local-finish () `(go ,',finish-loop)) local-macros)) + (and *loop-collect-var* + (push `(return-from ,*loop-name* , *loop-collect-var*) + *loop-epilogue*)) + (setq inner-body (append *loop-end-test* + (nreverse *loop-body*) + (nreverse *loop-increment*))) + (cond (*loop-map* + (setq inner-body (substitute-sloop-body inner-body))) + (t (setf inner-body (cons 'next-loop + (append inner-body '((go next-loop))))))) + (let ((bod + `(macrolet ,local-macros + (block ,*loop-name* + (tagbody + ,@ (append + (nreverse *loop-prologue*) + inner-body + `(,finish-loop) + (nreverse *loop-epilogue*) + #+kcl '((loop-return nil)))))) + + )) +;;; temp-fix..should not be necessary but some lisps cache macro +;;; expansions. and ignore the macrolet!! + (unless (eql *macroexpand-hook* *macroexpand-hook-for-no-copy*) + (setf bod (copy-tree bod))) + (dolist (v *loop-bindings*) + (setf bod + `(let ,(loop-let-bindings v) + ,@(and (cdr v) `(,(cons 'declare (cdr v)))) + ,bod))) + bod + ))) + +(defun parse-loop1 () + (declare (special *loop-form* + *loop-body* *loop-increment* + *no-declare* *loop-end-test* + *loop-name* )) + (lcase (loop-peek) + (named (loop-pop) (setq *loop-name* (loop-pop))) + (t nil)) + (do ((v (loop-pop) (loop-pop))) + ((and (null v) (null *loop-form*))) + (lcase v + (:no-body) + (for (parse-loop-for)) + (while (push + `(or ,(loop-pop) (local-finish)) *loop-body*)) + (until (push + `(and ,(loop-pop) (local-finish)) *loop-body*)) + (do (setq *loop-body* (append (parse-loop-do) *loop-body*))) + ((when unless) (setq *loop-body* + (append (parse-loop-when) *loop-body*))) + (:collect (setq *loop-body* + (append (parse-loop-collect) *loop-body*))) + ))) + + +(defun parse-no-body (com &aux (found t) (first t)) + "Reads successive no-body-contribution type forms, like declare, +initially, etc. which can occur anywhere. Returns t if it finds some +otherwise nil" + (declare (special *loop-form* + *loop-body* + *loop-increment* + *no-declare* *loop-end-test* + *loop-name* )) + (do ((v com (loop-pop))) + ((null (or first *loop-form*))) + (lcase v + ((initially finally)(parse-loop-initially v)) + (nil nil) + (with (parse-loop-with)) + (declare (parse-loop-declare (loop-pop) t)) + (nodeclare (setq *no-declare* (loop-pop))) + ;take argument to be consistent. + (increment (setq *loop-increment* + (append (parse-loop-do) *loop-increment*))) + (end-test (setq *loop-end-test* + (append (parse-loop-do) *loop-end-test*))) + (with-unique (parse-loop-with nil t)) + (sloop-macro (parse-loop-macro v 'sloop-macro)) + (t + (cond (first + (setf found nil)) + (t (loop-un-pop))) + (return 'done))) + (setf first nil)) + found) + +(defun parse-loop-with (&optional and-with only-if-not-there) + (let ((var (loop-pop))) + (lcase (loop-peek) + (= (loop-pop) + (or (symbolp var) (error "Not a variable ~a" var)) + (loop-add-binding var (loop-pop) + (not and-with) nil nil t only-if-not-there)) + (t (loop-add-temps var nil nil (not and-with) only-if-not-there))) + (lcase (loop-peek) + (and (loop-pop) + (lcase (loop-pop) + (with (parse-loop-with t )) + (with-unique (parse-loop-with t t)) + (t (loop-un-pop) (parse-loop-with t)) + )) + (t nil)))) + +(defun parse-loop-do (&aux result) + (declare (special *loop-form*)) + (do ((v (loop-pop) (loop-pop)) ) + (()) + (cond + ((listp v) + (push v result) + (or *loop-form* (return 'done))) + (t (loop-un-pop) (return 'done)))) + (or result (error "empty clause")) + result) + +(defun parse-loop-initially (command ) + (declare (special *loop-prologue* *loop-epilogue* *loop-bindings*)) + (lcase + command + (initially + (let ((form (parse-loop-do))) + (dolist (v (nreverse form)) + (cond ((and (listp v) + (member (car v) '(setf setq)) + (eql (length v) 3) + (symbolp (second v)) + (constantp (third v)) + (assoc (second v) (caar *loop-bindings*)) + (loop-add-binding (second v) (third v) + nil nil nil t t) + )) + (t (setf *loop-prologue* + (cons v *loop-prologue*))))))) + (finally + (setf *loop-epilogue* (append (parse-loop-do) *loop-epilogue*))))) + +(defun parse-one-when-clause ( &aux this-case (want 'body) v) + (declare (special *loop-form*)) + (prog + nil + next-loop + (and (null *loop-form*) (return 'done)) + (setq v (loop-pop)) + (lcase v + (:no-body) + (:collect (or (eql 'body want) (go finish)) + (setq this-case (append (parse-loop-collect) this-case)) + (setq want 'and)) + (when (or (eql 'body want) (go finish)) + (setq this-case (append (parse-loop-when) this-case)) + (setq want 'and)) + (do (or (eql 'body want) (go finish)) + (setq this-case (append (parse-loop-do) this-case)) + (setq want 'and)) + (and (or (eql 'and want) (error "Premature AND")) + (setq want 'body)) + (t (loop-un-pop)(return 'done))) + (go next-loop) + finish + (loop-un-pop)) + (or this-case (error "Hanging conditional")) + this-case) + + +(defun parse-loop-when (&aux initial else else-clause) + (declare (special *last-val* )) + (let ((test (cond ((l-equal *last-val* 'unless) `(not , (loop-pop))) + (t (loop-pop))))) + (setq initial (parse-one-when-clause)) + (lcase (loop-peek) + (else + (loop-pop) + (setq else t) + (setq else-clause (parse-one-when-clause))) + (t nil)) + `((cond (,test ,@ (nreverse initial)) + ,@ (and else `((t ,@ (nreverse else-clause)))))))) + +(defun pointer-for-collect (collect-var) + (declare (special *loop-collect-pointers*)) + (or (cdr (assoc collect-var *loop-collect-pointers*)) + (let ((sym(loop-add-binding (gensym "POIN") nil nil :collect ))) + (push (cons collect-var sym) + *loop-collect-pointers*) + sym))) + +(defun parse-loop-collect ( &aux collect-var pointer name-val) + (declare (special *last-val* *loop-body* *loop-collect-var* + *loop-collect-pointers* *inner-sloop* + *loop-prologue* )) + (and *inner-sloop* (throw 'collect nil)) + (let ((command *last-val*) + (val (loop-pop))) + (lcase + (loop-pop) + (into (loop-add-binding (setq collect-var (loop-pop)) nil nil t nil t )) + (t (loop-un-pop) + (cond (*loop-collect-var* (setf collect-var *loop-collect-var*)) + (t (setf collect-var + (setf *loop-collect-var* + (loop-add-binding (gensym "COLL") nil ))))))) + (lcase command + ((append nconc collect) + (setf pointer (pointer-for-collect collect-var)) + (cond (*use-locatives* + (pushnew `(setf ,pointer + (locf ,collect-var)) + *loop-prologue* :test 'equal))) + (lcase command + ( append + (unless (and (listp val) (eql (car val) 'list)) + (setf val `(copy-list ,val)))) + (t nil))) + (t nil)) + (cond ((and (listp val) (not *use-locatives*)) + (setq name-val (loop-add-binding (gensym "VAL") nil nil))) + (t (setf name-val val))) + (let + ((result + (lcase + command + ((nconc append) + (let ((set-pointer + `(and (setf (cdr ,pointer) ,name-val) + (setf ,pointer (last (cdr ,pointer)))))) + (cond (*use-locatives* + (list set-pointer)) + (t + `((cond (,pointer ,set-pointer) + (t (setf ,pointer + (last (setf + ,collect-var + ,name-val)))))))))) + (collect + (cond (*use-locatives* + `((setf (cdr ,pointer) + (setf ,pointer (cons ,name-val nil))))) + (t `((cond (,pointer + (setf (cdr ,pointer) + (setf ,pointer (cons ,name-val nil)))) + (t (setf ,collect-var + (setf ,pointer + (cons ,name-val nil))))))))) + (t (setq command (translate-name command)) + (cond ((find command *additional-collections* :test 'l-equal) + (loop-parse-additional-collections + command collect-var name-val)) + (t (error "loop fell off end ~a" command))))))) + (cond ((eql name-val val) + result) + (t (nconc result `((setf ,name-val ,val) ))))))) + +(defun loop-parse-additional-collections + (command collect-var name-val &aux eachtime) + (declare (special *loop-prologue* *last-val* + *loop-collect-var* *loop-epilogue* )) + (let* ((com (find command *additional-collections* :test 'l-equal)) + (helper (get com 'sloop-collect))) + (let ((form (funcall helper collect-var name-val))) + (let ((*loop-form* form) *last-val*) + (declare (special *loop-form* *last-val*)) + (do ((v (loop-pop) (loop-pop))) + ((null *loop-form*)) + (lcase v + (:no-body) + (do (setq eachtime (parse-loop-do))))) + eachtime)))) + +(defun the-type (symbol type) + (declare (special *no-declare*)) + (and *no-declare* (setf type nil)) + (and type (setf type (or (getf *Automatic-declarations* type) + (and (not (keywordp type)) type)))) + (and (consp type) (eq (car type) 'type) (setf type (second type))) + (cond (type (list 'the type symbol )) + (t symbol))) + +(defun type-error () + (error "While checking a bound of a sloop, I found the wrong type +for something in sloop::*automatic-declarations*. + Perhaps your limit is wrong? +If not either use nodeclare t or set sloop::*automatic-declarations* to nil. +recompile.")) + + +;;; this puts down code to check that automatic declarations induced by +;;; :from are indeed valid! It checks both ends of the interval, and so +;;; need not check the numbers in between. + +(defun make-value (value type-key &aux type ) + (declare (special *no-declare* *type-test-limit*)) + (cond ((and + (not *no-declare*) + *type-check* + (eq type-key :from) + (setq type (getf *Automatic-declarations* type-key))) + (setq type + (cond ((and (consp type) + (eq (car type) 'type)) + (second type)) + (t type))) + (cond ((constantp value) + (let ((test-value + (cond (*type-test-limit* + (eval (subst value + 'the-value *type-test-limit*))) + (t (eval value))))) + (or (typep test-value type) + (error + "~&Sloop found the type of ~a was not type ~a,~%~ + Maybe you want to insert SLOOP NODECLARE T ..." + value + type)) + (list value))) + (t (let (chk) + `((let ,(cond ((atom value) + nil) + (t `((,(setq chk(gensym)) ,value)))) + (or + (typep + ,(if *type-test-limit* + (subst (or chk value) + 'the-value *type-test-limit*) + (or chk value)) + ',type) + (type-error)) + ,(or chk value))))))) + (t (list value)))) + + +;;; keep track of the bindings in a list *loop-bindings* each element of +;;; the list will give rise to a different let. the car will be the +;;; variable bindings, the cdr the declarations. + + +(defun loop-add-binding + (variable value &optional (new-level t) type force-type (force-new-value t) + only-if-not-there &aux tem) +;;; Add a variable binding to the current or new level. If FORCE-TYPE, +;;; ignore a *no-declare*. If ONLY-IF-NOT-THERE, check all levels. + (declare (special *loop-bindings*)) + (when (or new-level (null *loop-bindings*)) + (push (cons nil nil) *loop-bindings*)) + (cond ((setq tem (assoc variable (caar *loop-bindings*) )) + (and force-new-value + (setf (cdr tem) (and value (make-value value type))))) + ((and (or only-if-not-there (and (null (symbol-package variable)) + (constantp value))) + (dolist (v (cdr *loop-bindings*)) + (cond ((setq tem (assoc variable (car v))) + (and force-new-value + (setf (cdr tem) + (and value (make-value value type)))) + (return t)))))) + (t (push (cons variable (and value (make-value value type))) + (caar *loop-bindings*)))) + (and type (loop-declare-binding variable type force-type)) + variable) + +;(defmacro nth-level (n) `(nth ,n *loop-bindings*)) +;if x = (nth i *loop-bindings*) +;(defmacro binding-declares (x) `(cdr ,x)) ;(cons 'declare (binding-declares x)) to get honest declare statement +;(defmacro binding-values (x) `(car ,x)) ;(let (binding-values x) ) to get let. + +(defun loop-declare-binding (var type force-type &optional odd-type + &aux found ) + (declare (special *loop-bindings* *automatic-declarations* + *no-declare* *loop-map*)) + odd-type ;;ignored + (and type + (member type *auto-type*) + (setf type (getf *automatic-declarations* type)) + *auto-register* + (loop-declare-binding var :register force-type)) + (when (and type(or force-type (null *no-declare*))) + (dolist (v *loop-bindings*) + (cond ((assoc var (car v)) (setf found t) + (pushnew + (if (and (consp type) + (eq (car type) 'type)) + (list 'type (second type) var) + (if odd-type (list 'type type var) + + (list type var))) + (cdr v) :test 'equal) + (return 'done) + ))) + (or found *loop-map* (error "Could not find variable ~a in bindings" var))) + var) + +(defun parse-loop-declare (&optional (decl-list (loop-pop)) (force t)) + (let ((type (car decl-list)) odd-type) + (cond ((eq type 'type) + (setf decl-list (cdr decl-list) type (car decl-list) odd-type t))) + (dolist (v (cdr decl-list)) + (loop-declare-binding v (car decl-list) force odd-type)))) + +(defun loop-add-temps (form &optional val type new-level only-if-not-there) + (cond ((null form)) + ((symbolp form) + (loop-add-binding form val new-level type nil t only-if-not-there)) + ((listp form) + (loop-add-temps (car form)) + (loop-add-temps (cdr form))))) + + +(defun add-from-data (data &rest args) + "rest = var begin end incr direction or-eql" + (or data (setq data (copy-list '(nil 0 nil 1 + nil)))) + (do ((l data (cdr l)) + (v args (cdr v))) + ((null v) l) + (and (car v) (setf (car l) (car v)))) + data) + +(defun parse-loop-for ( &aux inc from-data) + (declare (special *loop-form* *loop-map-declares* *loop-map* + *loop-body* *loop-increment* *no-declare* + *loop-prologue* + *loop-epilogue* + *loop-end-test* + *loop-bindings* + )) + (let* ((var (loop-pop)) test incr) + (do ((v (loop-pop) (loop-pop))) + (()) + (lcase v + (in (let ((lis (gensym "LIS"))) + (loop-add-temps var nil :in t) + (loop-add-binding lis (loop-pop) nil) + (push `(desetq ,var (car ,lis)) *loop-body*) + (setf incr `(setf ,lis (cdr ,lis))) + (setq test `(null ,lis) ) + )) + (on (let ((lis + (cond ((symbolp var) var) + (t (gensym "LIS"))))) + (loop-add-temps var nil :in t) + (loop-add-binding lis (loop-pop) nil) + (setf incr `(setf ,lis (cdr ,lis))) + (unless (eql lis var) + (push `(desetq ,var ,lis) *loop-body*)) + (setf test `(null ,lis)))) + + ((upfrom from) + (setq from-data (add-from-data from-data + var (loop-pop) nil nil '+))) + (downfrom + (setq from-data (add-from-data + from-data var (loop-pop) nil nil '-))) + (by + (setq inc (loop-pop)) + (cond (from-data + (setq from-data (add-from-data + from-data nil nil nil inc))) + (t (assert (eq (car (third incr)) 'cdr)) + (setq incr + `(setf ,(second incr) + ,(if (and (consp inc) + (member (car inc) '(quote function))) + `(,(second inc) ,(second incr)) + `(funcall + ,inc ,(second incr)))))))) + (below + (setq from-data (add-from-data from-data + var nil (loop-pop) nil '+))) + (above + (setq from-data (add-from-data from-data + var nil (loop-pop) nil '-))) + (to + (setq from-data (add-from-data from-data + var nil (loop-pop) nil nil t))) + (sloop-for (parse-loop-macro (translate-name v) + 'sloop-for var ) + (return 'done)) + (sloop-map (parse-loop-map (translate-name v) var ) + (return nil)) + (t(or + (loop-un-pop)) + (return 'done)))) + + ;;whew finished parsing a for clause.. + + (cond (from-data + (let + ((op (nth 4 from-data)) + (or-eql (nth 5 from-data)) + (var (car from-data)) + (end (third from-data)) + (inc (fourth from-data)) + type) + (loop-add-binding var (second from-data) t :from) + (or (constantp inc) (setq *no-declare* t)) + (setf incr `(setf ,var ,(the-type `(,op ,var ,inc) :from))) + (cond (end + (let ((lim (gensym "LIM")) + (*type-test-limit* + (cond ((and (eql inc 1) + (null (nth 5 from-data))) + nil) + (t `(,op + the-value , inc))))) + (declare (special *type-test-limit*)) + (loop-add-binding lim end nil :from nil nil) + (setq test `(,(cond (or-eql + (if (eq op '+) '> '<)) + (t (if (eq op '+) '>= '<=))) + ,var ,lim)))) + ((and (not *no-declare*) + *type-check* + (setq type (getf *automatic-declarations* :from)) + (progn (if (and (consp type)(eq (car type) 'type)) + (setf type (second type))) + (subtypep type 'fixnum))) + (or (constantp inc) (error "increment must be constant.")) + (push + `(or + ,(cond ((eq op '+) + `(< ,var ,(- most-positive-fixnum + (or inc 1)))) + (t `(> ,var ,(+ most-negative-fixnum + (or inc 1))))) + (type-error)) + *loop-increment*) + ))))) + + (and test (push (copy-tree `(and ,test (local-finish))) *loop-end-test*)) + (and incr (push incr *loop-increment*)) + )) + + +(defun parse-loop-macro (v type &optional initial &aux result) + (declare (special *loop-form*)) + (let ((helper (get v type)) args) + (setq args + (ecase type + (sloop-for + (let ((tem (get v 'sloop-for-args))) + (or (cdr tem) (error "sloop-for macro needs at least one arg")) + (cdr tem))) + (sloop-macro(get v 'sloop-macro-args)))) + (let ((last-helper-apply-arg + (cond ((member '&rest args) + (prog1 *loop-form* (setf *loop-form* nil))) + (t (dotimes (i (length args) (nreverse result)) + (push (car *loop-form*) result) + (setf *loop-form* (cdr *loop-form*))))))) + (setq *loop-form* + (append + (case type + (sloop-for (apply helper initial last-helper-apply-arg)) + (sloop-macro(apply helper last-helper-apply-arg))) + *loop-form*))))) + +(defun parse-loop-map (v var) + (declare (special *loop-map* *loop-map-declares* *loop-form*)) + (and *loop-map* (error "Sorry only one allowed loop-map per sloop")) + (let ((helper (get v 'sloop-map)) + (args (get v 'sloop-map-args))) + (or args (error "map needs one arg before the key word")) + (cond ((member '&rest args) + (error "Build this in two steps if you want &rest"))) + (let* (result + (last-helper-apply-arg + (dotimes (i (1- (length args)) (nreverse result)) + (push (car *loop-form*) result) + (setf *loop-form* (cdr *loop-form*))))) + (setq *loop-map-declares* + (do ((v (loop-pop)(loop-pop)) (result)) + ((null (l-equal v 'declare)) + (loop-un-pop) + (and result (cons 'declare result))) + (push (loop-pop) result))) + (setq *loop-map* (apply helper var last-helper-apply-arg)) + nil))) + +(defun substitute-sloop-body (inner-body) + (declare (special *loop-map* *loop-map-declares*)) + (cond (*loop-map* + (setf inner-body (list (subst (cons 'progn inner-body) + :sloop-body *loop-map*))) + (and *loop-map-declares* + (setf inner-body(subst *loop-map-declares* + :sloop-map-declares inner-body))))) + inner-body) + +;;; **User Extensible Iteration Facility** + +(eval-when (compile eval load) +(defun def-loop-internal (name args body type + &optional list min-args max-args + &aux (*print-case* :upcase) + (helper (intern + (format nil "~a-SLOOP-~a" name type)))) + (and min-args (or (>= (length args) min-args)(error "need more args"))) + (and max-args (or (<= (length args) max-args)(error "need less args"))) + `(eval-when (load compile eval) + (defun ,helper ,args + ,@ body) + ,@ (and list `((pushnew ',name ,list))) + (setf (get ',name ',(intern (format nil "SLOOP-~a" type) + (find-package 'sloop))) ',helper) + (setf (get ',name ',(intern (format nil "SLOOP-~a-ARGS" type) + (find-package 'sloop))) ',args))) +) + + +;;; DEF-LOOP-COLLECT lets you get a handle on the collection var. exactly +;;; two args. First arg=collection-variable. Second arg=value this time +;;; thru the loop. + +(def-loop-collect sum (ans val) + `(initially (setq ,ans 0) + do (setq ,ans (+ ,ans ,val)))) +(def-loop-collect logxor (ans val) + `(initially (setf ,ans 0) + do (setf ,ans (logxor ,ans ,val)) + declare (fixnum ,ans ,val))) +(def-loop-collect maximize (ans val) + `(initially (setq ,ans nil) + do (if ,ans (setf ,ans (max ,ans ,val)) (setf ,ans ,val)))) + +(def-loop-collect minimize (ans val) + `(initially (setq ,ans nil) + do (if ,ans (setf ,ans (min ,ans ,val)) (setf ,ans ,val)))) + +(def-loop-collect count (ans val) + `(initially (setq ,ans 0) + do (and ,val (setf ,ans (1+ ,ans))))) + +(def-loop-collect thereis (ans val)(declare(ignore ans)) + `(do (if ,val (loop-return ,val)))) +(def-loop-collect always (ans val) + `(initially (setq ,ans t) do (and (null ,val)(loop-return nil)))) +(def-loop-collect never (ans val) + `(initially (setq ,ans t) do (and ,val (loop-return nil)))) + + +;;; DEF-LOOP-MACRO +;;; If we have done +;;; (def-loop-macro averaging (x) +;;; `(sum ,x into .tot. and count t into .how-many. +;;; finally (loop-return (/ .tot. (float .how-many.))))) + +;;; (def-loop-collect average (ans val) +;;; `(initially (setf ,ans 0.0) +;;; with-unique .how-many. = 0 +;;; do (setf ,ans (/ (+ (* .how-many. ,ans) ,val) (incf .how-many.))) +;;; )) + +;;; Finally we show how to provide averaging with +;;; current value the acutal average. + +(def-loop-macro averaging (x) + `(with-unique .average. = 0.0 + and with-unique .n-to-average. = 0 + declare (float .average. ) declare (fixnum .n-to-average.) + do (setf .average. (/ + (+ (* .n-to-average. .average.) ,x) + (incf .n-to-average.))) + finally (loop-return .average.))) + +(def-loop-macro repeat (x) + (let ((ind (gensym))) + `(for ,ind below ,x))) + +(def-loop-macro return (x) + `(do (loop-return ,@ (if (and (consp x) (eq (car x) 'values)) + (cdr x) + (list x))))) + +;;; then we can write: +;;; (sloop for x in l when (oddp x) averaging x) + + +;;; DEF-LOOP-FOR def-loop-for and def-loop-macro are almost identical +;;; except that the def-loop-for construct can only occur after a for: + +;;; (def-loop-for in-array (vars array) +;;; (let ((elt (car vars)) +;;; (ind (second vars))) +;;; `(for ,ind below (length ,array) do (setf ,elt (aref ,array ,ind))))) + +;;; (sloop for (elt ind) in-array ar when (oddp elt) collecting ind) + +;;; You are just building something understandable by loop but minus the +;;; for. Since this is almost like a "macro", and users may want to +;;; customize their own, the comparsion of tokens uses eq, ie. you must +;;; import IN-ARRAY to your package if you define it in another one. +;;; Actually we make a fancier in-array below which understands from, to, +;;; below, downfrom,.. and can have either (elt ind) or elt as the +;;; argument vars. + +;;; DEF-LOOP-MAP A rather general iteration construct which allows you to +;;; map over things It can only occur after FOR. There can only be one +;;; loop-map for a given loop, so you want to only use them for +;;; complicated iterations. + +(def-loop-map in-table (var table) + `(maphash #'(lambda ,var :sloop-map-declares :sloop-body) ,table)) + +;;; Usage (sloop for (key elt) in-table table +;;; declare (fixnum elt) +;;; when (oddp elt) collecting (cons key elt)) + + +(def-loop-map in-package (var pkg) + `(do-symbols (,var (find-package ,pkg)) :sloop-body)) + +;;; Usage: +;;; (defun te() +;;; (sloop for sym in-package 'sloop when (fboundp sym) count t)) + +;;; IN-ARRAY that understands from,downfrowm,to, below, above,etc. I used +;;; a do for the macro iteration to be able include it here. + +(def-loop-for in-array (vars array &rest args) + (let (elt ind to) + (cond ((listp vars) (setf elt (car vars) ind (second vars))) + (t (setf elt vars ind (gensym "INDEX" )))) + (let ((skip (do ((v args (cddr v)) (result)) + (()) + (lcase (car v) + ((from downfrom) ) + ((to below above) (setf to t)) + (by) + (t (setq args (copy-list v)) + (return (nreverse result)))) + (push (car v) result) (push (second v) result)))) + (or to (setf skip (nconc `(below (length ,array)) skip))) + `(for ,ind + ,@ skip + with ,elt + do (setf ,elt (aref ,array ,ind)) ,@ args)))) + +;;; usage: IN-ARRAY +;;; (sloop for (elt i) in-array ar from 4 +;;; when (oddp i) +;;; collecting elt) + +;;; (sloop for elt in-array ar below 10 by 2 +;;; do (print elt)) + +(def-loop-for = (var val) + (lcase (loop-peek) + (then (loop-pop) `(with ,var initially (desetq ,var ,val) increment (desetq ,var ,(loop-pop)))) + (t `(with ,var do (desetq ,var ,val))))) + +(def-loop-macro sloop (for-loop) + (lcase (car for-loop) + (for)) + (let (*inner-sloop* *loop-body* *loop-map* inner-body + (finish-loop (gensym "FINISH")) + a b c e f (*loop-form* for-loop)) + (declare (special *inner-sloop* *loop-end-test* *loop-increment* + *product-for* *loop-map* + *loop-form* *loop-body* *loop-prologue* + *loop-epilogue* *loop-end-test* + *loop-bindings* + )) + (setf *product-for* t) + (loop-pop) + (sloop-swap) + (parse-loop-for) + (sloop-swap) + (do () + ((null *loop-form*)) + (cond ((catch 'collect (parse-loop1))) + ((null *loop-form*)(return 'done)) + (t ;(fsignal "hi") + (print *loop-form*) + (sloop-swap) + (parse-loop-collect) + (sloop-swap) + (print *loop-form*) + ))) + (sloop-swap) + (setf inner-body (nreverse *loop-body*)) + (and *loop-map* (setf inner-body (substitute-sloop-body inner-body))) + (let ((bod + `(macrolet ((local-finish () `(go ,',finish-loop))) + (tagbody + ,@ (nreverse *loop-prologue*) + ,@ (and (null *loop-map*) '(next-loop)) + ,@ (nreverse *loop-end-test*) + ,@ inner-body + ,@ (nreverse *loop-increment*) + ,@ (and (null *loop-map*) '((go next-loop))) + ,finish-loop + ,@ (nreverse *loop-epilogue*))))) + (dolist (v *loop-bindings*) + (setf bod + `(let ,(loop-let-bindings v) ,@(and (cdr v) `(,(cons 'declare (cdr v)))) + ,bod))) + (sloop-swap) + `(do ,bod)))) + +;;; Usage: SLOOP (FOR +;;; (defun te () +;;; (sloop for i below 5 +;;; sloop (for j to i collecting (list i j)))) + +(def-loop-for in-carefully (var lis) + "Path with var in lis except lis may end with a non nil cdr" + (let ((point (gensym "POINT"))) + `(with ,point and with ,var initially (setf ,point ,lis) + do(desetq ,var (car ,point)) + end-test (and (atom ,point)(local-finish)) + increment (setf ,point (cdr ,point))))) + +;;; Usage: IN-CAREFULLY +;;; (defun te (l) +;;; (sloop for v in-carefully l collecting v)) + +;;; Note the following is much like the mit for i first expr1 then expr2 +;;; but it is not identical, in that if expr1 refers to paralell for loop +;;; it will not get the correct initialization. But since we have such +;;; generality in the our definition of a for construct, it is unlikely +;;; that all people who define This is why we use a different name + +(def-loop-for first-use (var expr1 then expr2) + (or (l-equal then 'then) (error "First must be followed by then")) + `(with ,var initially (desetq ,var ,expr1) increment (desetq ,var ,expr2))) + +;;; I believe the following is what the original loop does with the FIRST +;;; THEN construction. + +(def-loop-for first (var expr1 then expr2) + (declare (special *loop-increment*)) + (or (l-equal then 'then) (error "First must be followed by then")) + ;; If this is the first for, then we don't need the flag, but can + ;; move the FIRST setting into the INITIALLY section + (cond ((null *loop-increment*) + `(with ,var initially (desetq ,var ,expr1) + increment (desetq ,var ,expr2))) + (t + (let ((flag (gensym))) + `(with ,var with ,flag + do (cond (,flag (desetq ,var ,expr2)) + (t (desetq ,var ,expr1))) + increment (desetq ,flag t)))))) + + +(defvar *collate-order* #'<) + +;;; of course this should be a search of the list based on the order and +;;; splitting into halves (binary search). I was too lazy to include one +;;; here, but it should be done. + +(defun find-in-ordered-list + (it list &optional (order-function *collate-order*) &aux prev) + (do ((v list (cdr v))) + ((null v) (values prev nil)) + (cond ((eql (car v) it) (return (values v t))) + ((funcall order-function it (car v)) + (return (values prev nil)))) + (setq prev v))) + +(def-loop-collect collate (ans val) + "Collects values into a sorted list without duplicates. +Order based order function *collate-order*" + `(do (multiple-value-bind + (after already-there ) + (find-in-ordered-list ,val ,ans) + (unless already-there + (cond (after (setf (cdr after) (cons ,val (cdr after)))) + (t (setf ,ans (cons ,val ,ans)))))))) + +;;; Usage: COLLATE +;;; (defun te () +;;; (let ((res +;;; (sloop for i below 10 +;;; sloop (for j downfrom 8 to 0 +;;; collate (* i (mod j (max i 1)) (random 2))))) +;;; + +;;; Two implementations of slooping over the fringe of a tree + +;;;(defun map-fringe (fun tree) +;;; (do ((v tree)) +;;; (()) +;;; (cond ((atom v) +;;; (and v (funcall fun v))(return 'done)) +;;; ((atom (car v)) +;;; (funcall fun (car v))) +;;; (t (map-fringe fun (car v) ))) +;;; (setf v (cdr v)))) +;;; +;;;(def-loop-map in-fringe (var tree) +;;; "Map over the non nil atoms in the fringe of tree" +;;; `(map-fringe #'(lambda (,var) :sloop-map-declares :sloop-body) ,tree)) + +;;; The next version is equivalent to the previous but uses labels and so +;;; avoids having to funcall an anonymous function. [as suggested +;;; by M. Ballantyne] + +(def-loop-map in-fringe (var tree) + "Map over the non nil atoms in the fringe of tree" + (let ((v (gensym))) + `(let (,var) + (labels + ((map-fringe-aux (.xtree.) + (do ((,v .xtree.)) + ((null ,v)) + (cond ((atom ,v) (setf ,var ,v) (setf ,v nil)) + (t (setf ,var (car ,v))(setf ,v (cdr ,v)))) + (cond ((null ,var)) + ((atom ,var) + :sloop-map-declares :sloop-body) + (t (map-fringe-aux ,var )))))) + (map-fringe-aux ,tree))))) + +;;; Usage: IN-FRINGE +;;; (sloop for v in-fringe '(1 2 (3 (4 5) . 6) 8 1 2) +;;; declare (fixnum v) +;;; maximize v) diff --git a/lsp/gcl_stack-problem.lsp b/lsp/gcl_stack-problem.lsp new file mode 100755 index 0000000..4ad95a1 --- /dev/null +++ b/lsp/gcl_stack-problem.lsp @@ -0,0 +1,29 @@ +(in-package :si) + +(defvar *old-handler* #'si::universal-error-handler) + +(defentry ihs_function_name (object) (object "ihs_function_name")) + + +(defun new-universal-error-handler + (a b c d e &rest l &aux (i 0) (top (si::ihs-top))) + (declare (fixnum i top)) + (if (search "stack overflow" e) + (progn (format t "~a in ~a" e d) + (format t "invocation stack:") + (loop (cond ((or (> i 20) + (< top 10)) + (return nil))) + (setq i (+ i 1)) + (setq top (- top 1)) + (format t "< ~s " (ihs_function_name (si::ihs-fun top)))) + (format t "Jumping to top") + (throw *quit-tag* nil) + ) + (apply *old-handler* a b c d e l))) + + +(setf (symbol-function 'si::universal-error-handler) + #'new-universal-error-handler) + + diff --git a/lsp/gcl_stdlisp.lsp b/lsp/gcl_stdlisp.lsp new file mode 100755 index 0000000..2e72c9e --- /dev/null +++ b/lsp/gcl_stdlisp.lsp @@ -0,0 +1,61 @@ + +;; Loading the following causes these non standard symbols in the LISP +;; package, to no longer be automatically exported to packages which +;; use LISP. For example BYE will no longer be accessible from package +;; USER. You will need to type (lisp::bye) to quit. Of course references +;; to BYE before this file was loaded will mean the symbol BYE in the lisp +;; package. + +;; Someday this file may be loaded by default in GCL, so you should +;; probably use the LISP:: prefix for these symbols, as protection +;; against that day. + +(unexport + '(LISP::LAMBDA-BLOCK-CLOSURE + LISP::BYE LISP::QUIT LISP::EXIT LISP::IEEE-FLOATING-POINT + LISP::DEFENTRY LISP::VOID LISP::ALLOCATE-CONTIGUOUS-PAGES + LISP::UNSIGNED-SHORT + LISP::DOUBLE + LISP::BY + LISP::GBC + LISP::DEFCFUN + LISP::SAVE + LISP::MAXIMUM-CONTIGUOUS-PAGES + LISP::SPICE + LISP::DEFLA + LISP::ALLOCATED-PAGES + LISP::SUN + LISP::INT + LISP::USE-FAST-LINKS + LISP::CFUN + LISP::UNSIGNED-CHAR + LISP::HELP + LISP::HELP* + LISP::MACRO + LISP::*BREAK-ENABLE* + LISP::CLINES + LISP::LAMBDA-CLOSURE + LISP::OBJECT + LISP::FAT-STRING + LISP::SIGNED-SHORT + LISP::MC68020 + LISP::LAMBDA-BLOCK + LISP::TAG + LISP::PROCLAMATION + LISP::ALLOCATED-CONTIGUOUS-PAGES + LISP::*EVAL-WHEN-COMPILE* + LISP::SIGNED-CHAR + LISP::*IGNORE-MAXIMUM-PAGES* + LISP::*LINK-ARRAY* + LISP::KCL + LISP::BSD + LISP::ALLOCATE-RELOCATABLE-PAGES + LISP::ALLOCATE + LISP::UNIX + LISP::MAXIMUM-ALLOCATABLE-PAGES + LISP::ALLOCATED-RELOCATABLE-PAGES + LISP::SYSTEM + LISP::KYOTO + LISP::CCLOSURE) + 'LISP + ) \ No newline at end of file diff --git a/lsp/gcl_top.lsp b/lsp/gcl_top.lsp new file mode 100755 index 0000000..ee33cc8 --- /dev/null +++ b/lsp/gcl_top.lsp @@ -0,0 +1,645 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; top.lsp +;;;; +;;;; Top-level loop, break loop, and error handlers +;;;; +;;;; Revised on July 11, by Carl Hoffman. + + +(in-package :si) + +(export '*break-readtable*) +(export '(loc *debug-print-level*)) + +(export '(vs ihs-vs ihs-fun frs-vs frs-bds frs-ihs bds-var bds-val super-go)) + +(defvar *command-args* nil) + +(defvar +) +(defvar ++) +(defvar +++) +(defvar -) +(defvar *) +(defvar **) +(defvar ***) +(defvar /) +(defvar //) +(defvar ///) + + +;; setup file search and autoload + +(defvar *fixed-load-path* nil) +(defvar *load-path* nil) +(defvar *load-types* '(".o" ".lsp" ".lisp")) + +(defvar *lisp-initialized* nil) +(defconstant +top-level-quit-tag+ (cons nil nil)) +(defvar *quit-tag* +top-level-quit-tag+) +(defvar *quit-tags* nil) +(defvar *break-level* '()) +(defvar *break-env* nil) +(defvar *ihs-base* 1) +(defvar *ihs-top* 1) +(defvar *current-ihs* 1) +(defvar *frs-base* 0) +(defvar *frs-top* 0) +(defvar *break-enable* t) +(defvar *break-message* "") + +(defvar *break-readtable* nil) + +(defvar *top-level-hook* nil) + + +(defvar *top-eof* (cons nil nil)) +(defvar *no-prompt* nil) + +(defun top-level () + (let ((+ nil) (++ nil) (+++ nil) + (- nil) + (* nil) (** nil) (*** nil) + (/ nil) (// nil) (/// nil)) + (setq *lisp-initialized* t) + (catch *quit-tag* + (progn + (cond + (*multiply-stacks* (setq *multiply-stacks* nil)) + ((when (fboundp 'probe-file) (probe-file "init.lsp")) (load "init.lsp")))) + (when (if (symbolp *top-level-hook*) (fboundp *top-level-hook*) (functionp *top-level-hook*)) + (funcall *top-level-hook*))) + + (when (boundp '*system-banner*) + (format t *system-banner*) + (format t "Temporary directory for compiler files:~%~a~%" *tmp-dir*)) + + (loop + (setq +++ ++ ++ + + -) + (if *no-prompt* (setq *no-prompt* nil) + (format t "~%~a>" + (if (eq *package* (find-package 'user)) "" + (package-name *package*)))) + (reset-stack-limits) + ;; have to exit and re-enter to multiply stacks + (cond (*multiply-stacks* (Return-from top-level))) + (when (catch *quit-tag* + (setq - (locally (declare (notinline read)) + (read *standard-input* nil *top-eof*))) + (when (eq - *top-eof*) (bye)) + (let ((values (multiple-value-list + (locally (declare (notinline eval)) (eval -))))) + (setq /// // // / / values *** ** ** * * (car /)) + (fresh-line) + (dolist (val /) + (locally (declare (notinline prin1)) (prin1 val)) + (terpri)) + nil)) + (setq *evalhook* nil *applyhook* nil) + (terpri *error-output*) + (break-current))))) + +(defun set-dir (sym val) + (let ((tem (or val (and (boundp sym) (symbol-value sym))))) + (if tem (set sym (coerce-slash-terminated tem))))) + +(defvar *error-p* nil) + +(defvar *lib-directory* nil) + +(defun process-some-args (args &optional compile &aux *load-verbose*) + (when args + (let ((x (pop args))) + (cond ((equal x "-load") (load (pop args))) + ((equal x "-eval") (eval (read-from-string (pop args)))) + ((equal x "-batch") (setq *top-level-hook* 'bye)) + ((equal x "-o-file") (unless (read-from-string (car args)) + (push (cons :o-file nil) compile) + (pop args))) + ((equal x "-h-file") (push (cons :h-file t) compile)) + ((equal x "-data-file") (push (cons :data-file t) compile)) + ((equal x "-c-file") (push (cons :c-file t) compile)) + ((equal x "-system-p") (push (cons :system-p t) compile)) + ((equal x "-compile") (push (cons :compile (pop args)) compile)) + ((equal x "-o") (push (cons :o (pop args)) compile)) + ((equal x "-libdir") (set-dir '*lib-directory* (pop args))) + ((equal x "-dir") (set-dir '*system-directory* (pop args))) + ((equal x "-f") (do-f (car (setq *command-args* args)))) + ((equal x "--") (setq *command-args* args args nil)))) + (process-some-args args compile)) + + (when compile + (let* (*break-enable* + (file (cdr (assoc :compile compile))) + (o (cdr (assoc :o compile))) + (compile (remove :o (remove :compile compile :key 'car) :key 'car)) ++ (compile (cons (cons :output-file (or o (merge-pathnames ".o" file))) compile)) + (result (system:error-set `(apply 'compile-file ,file ',(mapcan (lambda (x) (list (car x) (cdr x))) compile))))) + (bye (if (or *error-p* (equal result '(nil))) 1 0))))) + +(defun dbl-read (&optional (stream *standard-input*) (eof-error-p t) + (eof-value nil) &aux tem ch) + (tagbody + top + (setq ch (read-char stream eof-error-p eof-value)) + (cond ((eql ch #\newline) (go top)) + ((eq ch eof-value) (return-from dbl-read eof-value))) + (unread-char ch stream)) + + (cond ((eql #\: ch) + (setq tem + (string-concatenate + "(" + (read-line stream eof-error-p eof-value)")")) + (read (make-string-input-stream tem) + eof-error-p eof-value)) + (t (read stream eof-error-p eof-value)))) + + +(defvar *debug-print-level* 3) + +(defun terminal-interrupt (correctablep) + (let ((*break-enable* t)) + (if correctablep + (cerror "Type :r to resume execution, or :q to quit to top level." + "Console interrupt.") + (error "Console interrupt -- cannot continue.")))) + + +(defun break-call (key args &optional (prop 'si::break-command) &aux fun) + (setq fun (complete-prop key 'keyword prop)) + (or fun (return-from break-call nil)) + (setq fun (get fun prop)) + (cond (fun + (setq args (cons fun args)) + (or (symbolp fun) (setq args (cons 'funcall args))) + (evalhook args nil nil *break-env*) + ) + (t (format *debug-io* "~&~S is undefined break command.~%" key)))) + +(defun break-quit (&optional (level 0) + &aux (current-level (length *break-level*))) + (when (and (>= level 0) (< level current-level)) + (let ((x (nthcdr (- current-level level 1) *quit-tags*)) + (y (member nil *quit-tags* :key 'cdr))) + (if (tailp x y) + (format *debug-io* "The *quit-tag* is disabled at level ~s.~%" (length y)) + (throw (cdar x) (cdar x))))) + (break-current)) + +(defun break-previous (&optional (offset 1)) + (do ((i (1- *current-ihs*) (1- i))) + ((or (< i *ihs-base*) (<= offset 0)) + (set-env) + (break-current)) + (when (ihs-visible i) + (setq *current-ihs* i) + (setq offset (1- offset))))) + +(defun set-current () + (do ((i *current-ihs* (1- i))) + ((or (ihs-visible i) (<= i *ihs-base*)) + (setq *current-ihs* i) + (set-env) + (format *debug-io* "Broken at ~:@(~S~).~:[ Type :H for Help.~;~]" + (ihs-fname *current-ihs*) + (cdr *break-level*))))) + +(defun break-next (&optional (offset 1)) + (do ((i *current-ihs* (1+ i))) + ((or (> i *ihs-top*) (< offset 0)) + (set-env) + (break-current)) + (when (ihs-visible i) + (setq *current-ihs* i) + (setq offset (1- offset))))) + +(defun break-go (ihs-index) + (setq *current-ihs* (min (max ihs-index *ihs-base*) *ihs-top*)) + (if (ihs-visible *current-ihs*) + (progn (set-env) (break-current)) + (break-previous))) + +(defun break-message () + (princ *break-message* *debug-io*) + (terpri *debug-io*) + (values)) + +(defun describe-environment (&optional (env *break-env*) (str *debug-io*)) + (or (eql (length env) 3) (error "bad env")) + (let ((fmt "~a~#[none~;~S~;~S and ~S~ + ~:;~@{~#[~;and ~]~S~^, ~}~].~%")) + (apply 'format str fmt "Local variables: " + (mapcar #'car (car *break-env*))) + (apply 'format str fmt "Local functions: " + (mapcar #'car (cadr *break-env*))) + (apply 'format str fmt "Local blocks: " + (mapcan #'(lambda (x) (when (eq (cadr x) 'block) (list (car x)))) + (caddr *break-env*))) + (apply 'format str fmt "Local tags: " + (mapcan #'(lambda (x) (when (eq (cadr x) 'tag) (list (car x)))) + (caddr *break-env*))))) + +(defun break-vs (&optional (x (ihs-vs *ihs-base*)) (y (ihs-vs *ihs-top*))) + (setq x (max x (ihs-vs *ihs-base*))) + (setq y (min y (1- (ihs-vs (1+ *ihs-top*))))) + (do ((ii *ihs-base* (1+ ii))) + ((or (>= ii *ihs-top*) (>= (ihs-vs ii) x)) + (do ((vi x (1+ vi))) + ((> vi y) (values)) + (do () + ((> (ihs-vs ii) vi)) + (when (ihs-visible ii) (print-ihs ii)) + (incf ii)) + (format *debug-io* "~&VS[~d]: ~s" vi (vs vi)))))) + +(defun break-local (&optional (n 0) &aux (x (+ (ihs-vs *current-ihs*) n))) + (break-vs x x)) + +(defun break-bds (&rest vars &aux (fi *frs-base*)) + (do ((bi (1+ (frs-bds (1- *frs-base*))) (1+ bi)) + (last (frs-bds (1+ *frs-top*)))) + ((> bi last) (values)) + (when (or (null vars) (member (bds-var bi) vars)) + (do () + ((or (> fi *frs-top*) (> (frs-bds fi) bi))) + (print-frs fi) + (incf fi)) + (format *debug-io* "~&BDS[~d]: ~s = ~s" + bi (bds-var bi) (bds-val bi))))) + +(defun simple-backtrace () + (princ "Backtrace: " *debug-io*) + (do* ((i *ihs-base* (1+ i)) + (b nil t)) + ((> i *ihs-top*) (terpri *debug-io*) (values)) + (when (ihs-visible i) + (when b (princ " > " *debug-io*)) + (write (ihs-fname i) :stream *debug-io* :escape t + :case (if (= i *current-ihs*) :upcase :downcase))))) + +(defun ihs-backtrace (&optional (from *ihs-base*) (to *ihs-top*)) + (setq from (max from *ihs-base*)) + (setq to (min to *ihs-top*)) + (do* ((i from (1+ i)) + (j (or (sch-frs-base *frs-base* from) (1+ *frs-top*)))) + ((> i to) (values)) + (when (ihs-visible i) (print-ihs i)) + (do () ((or (> j *frs-top*) (> (frs-ihs j) i))) + (print-frs j) + (incf j)))) + +(defun print-ihs (i &aux (*print-level* 2) (*print-length* 4)) + (format t "~&~:[ ~;@ ~]IHS[~d]: ~s ---> VS[~d]" + (= i *current-ihs*) + i + (let ((fun (ihs-fun i))) + (cond ((or (symbolp fun) (compiled-function-p fun)) fun) + ((consp fun) + (case (car fun) + (lambda fun) + ((lambda-block lambda-block-expanded) (cdr fun)) + (lambda-closure (cons 'lambda (cddddr fun))) + (lambda-block-closure (cddddr fun)) + (t (cond + ((and (symbolp (car fun)) + (or (special-operator-p(car fun)) + (fboundp (car fun)))) + (car fun)) + (t '(:zombi)))))) + (t (print fun) + :zombi))) + (ihs-vs i))) + +(defun print-frs (i) + (format *debug-io* "~& FRS[~d]: ~s ---> IHS[~d],VS[~d],BDS[~d]" + i (frs-kind i) (frs-ihs i) (frs-vs i) (frs-bds i))) + +(defun frs-kind (i &aux x) + (case (frs-class i) + (:catch + (if (spicep (frs-tag i)) + (or (and (setq x (member (frs-tag i) (vs (+ (frs-vs i) 2)) + :key #'caddr :test #'eq)) + (if (eq (cadar x) 'block) + `(block ,(caar x) ***) + `(tagbody ,@(reverse (mapcar #'car + (remove (frs-tag i) x + :test-not #'eq + :key #'caddr))) + ***))) + `(block/tagbody ,(frs-tag i))) + `(catch ',(frs-tag i) ***))) + (:protect '(unwind-protect ***)) + (t `(system-internal-catcher ,(frs-tag i))))) + +(defun break-current () + (if *break-level* + (format *debug-io* "Broken at ~:@(~S~)." (ihs-fname *current-ihs*)) + (format *debug-io* "~&Top level.")) + (values)) + + + +(defvar *break-hidden-packages* nil) + +(defun ihs-visible (i &aux (tem (ihs-fname i))) + (and tem (not (member tem *break-hidden-packages*)))) + + +(defun ihs-fname (ihs-index) + (let ((fun (ihs-fun ihs-index))) + (cond ((symbolp fun) fun) + ((consp fun) + (case (car fun) + (lambda 'lambda) + ((lambda-block lambda-block-expanded) (cadr fun)) + (lambda-block-closure (nth 4 fun)) + (lambda-closure 'lambda-closure) + (t (if (and (symbolp (car fun)) + (or (special-operator-p (car fun)) + (fboundp (car fun)))) + (car fun) :zombi) + ))) + ((compiled-function-p fun) + (compiled-function-name fun)) + (t :zombi)))) + +(defun ihs-not-interpreted-env (ihs-index) + (let ((fun (ihs-fun ihs-index))) + (cond ((and (consp fun) + (> ihs-index 3) + ;(<= (ihs-vs ihs-index) (ihs-vs (- ihs-index 1))) + ) + nil) + (t t)))) + +(defun set-env () + (setq *break-env* + (if (ihs-not-interpreted-env *current-ihs*) + nil + (let ((i (ihs-vs *current-ihs*))) + (list (vs i) (vs (1+ i)) (vs (+ i 2))))))) + +(defun list-delq (x l) + (cond ((null l) nil) + ((eq x (car l)) (cdr l)) + (t (rplacd l (list-delq x (cdr l)))))) + +(defun super-go (i tag &aux x) + (when (and (>= i *frs-base*) (<= i *frs-top*) (spicep (frs-tag i))) + (if (setq x (member (frs-tag i) (vs (+ (frs-vs i) 2)) + :key #'caddr :test #'eq)) + ; Interpreted TAGBODY. + (when (and (eq (cadar x) 'tag) + (member tag (mapcar #'car (remove (frs-tag i) x + :test-not #'eq + :key #'caddr)))) + (internal-super-go (frs-tag i) tag t)) + ; Maybe, compiled cross-closure TAGBODY. + ; But, it may also be compiled cross-closure BLOCK, in which case + ; SUPER-GO just RETURN-FROMs with zero values. + (internal-super-go (frs-tag i) tag nil))) + (format *debug-io* "~s is invalid tagbody identification for ~s." i tag)) + +(defun break-backward-search-stack (sym &aux string) + (setq string (string sym)) + (do* ((ihs (1- *current-ihs*) (1- ihs)) + (fname (ihs-fname ihs) (ihs-fname ihs))) + ((< ihs *ihs-base*) + (format *debug-io* "Search for ~a failed.~%" string)) + (when (and (ihs-visible ihs) + (search string (symbol-name fname) :test #'char-equal)) + (break-go ihs) + (return)))) + +(defun break-forward-search-stack (sym &aux string) + (setq string (string sym)) + (do* ((ihs (1+ *current-ihs*) (1+ ihs)) + (fname (ihs-fname ihs) (ihs-fname ihs))) + ((> ihs *ihs-top*) + (format *debug-io* "Search for ~a failed.~%" string)) + (when (and (ihs-visible ihs) + (search string (symbol-name fname) :test #'char-equal)) + (break-go ihs) + (return)))) + +(defun break-resume () + (if *debug-continue* + (invoke-restart *debug-continue*) + :resume)) + +(putprop :b 'simple-backtrace 'break-command) +(putprop :r 'break-resume 'break-command) +(putprop :resume (get :r 'break-command) 'break-command) +(putprop :bds 'break-bds 'break-command) +(putprop :blocks 'break-blocks 'break-command) +(putprop :bs 'break-backward-search-stack 'break-command) +(putprop :c 'break-current 'break-command) +(putprop :fs 'break-forward-search-stack 'break-command) +(putprop :functions 'break-functions 'break-command) +(putprop :go 'break-go 'break-command) +(putprop :h 'break-help 'break-command) +(putprop :help 'break-help 'break-command) +(putprop :ihs 'ihs-backtrace 'break-command) +(putprop :env '(lambda () (describe-environment *break-env*)) 'break-command) +(putprop :m 'break-message 'break-command) +(putprop :n 'break-next 'break-command) +(putprop :p 'break-previous 'break-command) +(putprop :q 'break-quit 'break-command) +(putprop :s 'break-backward-search-stack 'break-command) +(putprop :vs 'break-vs 'break-command) + +(defun break-help () + (dolist (v '( " +Break-loop Command Summary ([] indicates optional arg) +-------------------------- + +:bl [j] show local variables and their values, or segment of vs if compiled + in j stack frames starting at the current one. +:bt [n] BACKTRACE [n steps] +:down [i] DOWN i frames (one if no i) +:env describe ENVIRONMENT of this stack frame (for interpreted). +:fr [n] show frame n +:loc [i] return i'th local of this frame if its function is compiled (si::loc i) +" +":r RESUME (return from the current break loop). +:up [i] UP i frames (one if no i) + +Example: print a bactrace of the last 4 frames + +>>:bt 4 + +Note: (use-fast-links nil) makes all non system function calls +be recorded in the stack. (use-fast-links t) is the default + +Low level commands: +------------------ +:p [i] make current the i'th PREVIOUS frame (in list show by :b) +:n [i] make current the i'th NEXT frame (in list show by :b) +:go [ihs-index] make current the frame corresponding ihs-index +" +":m print the last break message. +:c show function of the current ihs frame. +:q [i] quit to top level +:r resume from this break loop. +:b full backtrace of all functions and special forms. +:bs [name] backward search for frame named 'name' +:fs [name] search for frame named 'name' +:vs [from] [to] Show value stack between FROM and TO +:ihs [from] [to] Show Invocation History Stack +" +" +:bds ['v1 'v2 ..]Show previous special bindings of v1, v2,.. or all if no v1 + +")) (format *debug-io* v)) + (format *debug-io* "~%Here is a COMPLETE list of bindings. Too +add a new one, add a 'si::break-command property:") + (do-symbols (v (find-package "KEYWORD")) + (cond ((get v 'si::break-command) + (format *debug-io* + "~%~(~a -- ~a~)" v (get v 'si::break-command))))) + (values) + ) + + +;;make sure '/' terminated + +(defun coerce-slash-terminated (v) + (let ((n (length v))) + (if (and (> n 0) (eql (aref v (1- n)) #\/)) + v + (string-concatenate v "/")))) + +(defun fix-load-path (l) + (when (not (equal l *fixed-load-path*)) + (do ((x l (cdr x)) ) + ((atom x)) + (setf (car x) (coerce-slash-terminated (car x)))) + (do ((v l (cdr v))) + ((atom v)) + (do ((w v (cdr w))) + ((atom (cdr w))) + (cond ((equal (cadr w) (car v)) + (setf (cdr w)(cddr w))))))) + (setq *fixed-load-path* l)) + +(defun file-search (NAME &optional (dirs *load-path*) + (extensions *load-types*) (fail-p t) &aux tem) + "Search for NAMME in DIRS with EXTENSIONS. +First directory is checked for first name and all extensions etc." + (fix-load-path dirs) + (dolist (v dirs) + (dolist (e extensions) + (if (probe-file (setq tem (si::string-concatenate v name e))) + (return-from file-search tem)))) + (if fail-p + (let ((*path* nil)) + (declare (special *path*)) + (cerror + "Do (setq si::*path* \"pathname\") for path to use then :r to continue" + "Lookup failed in directories:~s for name ~s with extensions ~s" + dirs name extensions) + *path*))) + +(defun aload (path) + (load (file-search path *load-path* *load-types*))) + +(defun autoload (sym path &aux (si::*ALLOW-GZIPPED-FILE* t)) + (or (fboundp sym) + (setf (symbol-function sym) + #'(lambda (&rest l) + (aload path) + (apply sym l))))) + +(defun autoload-macro (sym path &aux (si::*ALLOW-GZIPPED-FILE* t)) + (or (fboundp sym) + (setf (macro-function sym) + #'(lambda (form env) + (aload path) + (funcall sym form env))))) + +(eval-when (compile) (proclaim '(optimize (safety 0))) ) +(defvar si::*command-args* nil) + +(defvar *tmp-dir*) + +(defun ensure-dir-string (str) + (if (eq (stat1 str) :directory) + (coerce-slash-terminated str) + str)) + +(defun get-temp-dir () + (dolist (x `(,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) + (when x + (let ((x (coerce-slash-terminated x))) + (when (eq (stat1 x) :directory) + (return-from get-temp-dir x)))))) + + + +(defvar *cc* "cc") +(defvar *ld* "ld") +(defvar *objdump* nil) + +(defvar *current-directory* *system-directory*) + +(defun current-directory-pathname nil (pathname (coerce-slash-terminated (getcwd)))) + +(defun set-up-top-level (&aux (i (argc)) tem) + (declare (fixnum i)) + (setq *current-directory* (current-directory-pathname)) + (setq *tmp-dir* (get-temp-dir) + *cc* (or (get-path *cc*) *cc*) + *ld* (or (get-path *ld*) *ld*) + *objdump* (get-path "objdump --source ")) + (dotimes (j i) (push (argv j) tem)) + (setq *command-args* (nreverse tem)) + (setq tem *lib-directory*) + (process-some-args *command-args*) + (unless *lib-directory* + (let ((dir (getenv "GCL_LIBDIR"))) + (when dir + (setq *lib-directory* (coerce-slash-terminated dir))))) + (unless (and *load-path* (equal tem *lib-directory*)) + (mapc (lambda (x) (push (string-concatenate *lib-directory* x) *load-path*)) '("lsp/" "gcl-tk/" "xgcl-2/"))) + (unless (boundp '*system-directory*) + (setq *system-directory* (namestring (truename (make-pathname :name nil :type nil :defaults (argv 0)))))))) + +(defvar *old-top-level* #'top-level) + +(defun gcl-top-level nil + + (set-up-top-level) + + (in-package :user) + (setq *ihs-top* (ihs-top)) + (funcall *old-top-level*)) + +(defun do-f (file &aux *break-enable*) + (catch *quit-tag* + (labels ((read-loop (st &aux (tem (read st nil 'eof))) (when (eq tem 'eof) (bye)) (eval tem) (read-loop st)) + (read-file (st) (read-line st nil 'eof) (read-loop st))) + (if file + (with-open-file + (st file) + (read-file st)) + (read-file *standard-input*)))) + (bye 1)) diff --git a/lsp/gcl_trace.lsp b/lsp/gcl_trace.lsp new file mode 100755 index 0000000..cbfae16 --- /dev/null +++ b/lsp/gcl_trace.lsp @@ -0,0 +1,447 @@ +;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +;; This file is part of GNU Common Lisp, herein referred to as GCL +;; +;; GCL is free software; you can redistribute it and/or modify it under +;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GCL 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 Library General Public +;; License for more details. +;; +;; You should have received a copy of the GNU Library General Public License +;; along with GCL; see the file COPYING. If not, write to the Free Software +;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; trace.lsp +;;;; +;;;; Tracer package for Common Lisp + +;;;;;; Modified by Matt Kaufmann to allow tracing options. + + +;; If you are working in another package you should (import 'si::arglist) +;; to avoid typing the si:: + +(in-package :si) + +;;(proclaim '(optimize (safety 2) (space 3))) + + +(defvar *trace-level* 0) +(defvar *trace-list* nil) + + +(defmacro trace (&rest r) + (if (null r) + '(mapcar #'car *trace-list*) + `(let ((old (copy-list *trace-list*)) finish-flg) + (unwind-protect + (prog1 (mapcan #'trace-one ',r) + (setq finish-flg t)) + (when (null finish-flg) + (format *standard-output* "~%Newly traced functions: ~S" + (mapcar #'car (set-difference *trace-list* old :test #'equal)))))))) + +(defmacro untrace (&rest r) + (if (null r) + '(mapcan #'untrace-one (mapcar #'car *trace-list*)) + `(mapcan #'untrace-one ',r))) + +(defun trace-one-preprocess (x) + (cond + ((symbolp x) + (trace-one-preprocess (list x))) + (t ; We've checked for CONSP with null last CDR + (do ((tail (cdr x) (cddr tail)) + (declarations) + (entryform `(cons (quote ,(car x)) arglist)) + (exitform `(cons (quote ,(car x)) values)) + (condform t) + (entrycondform t) + (exitcondform t) + (depth) (depthvar)) + ((null tail) + (when depth + ;; Modify the :cond so that it first checks depth, and then + ;; modify the :entry so that it first increments depth. Notice + ;; that :cond will be fully evaluated before depth is incremented. + (setq depthvar (gensym)) + ;; now reset the condform + (if + (eq condform t) + (setq condform + `(< ,depthvar ,depth)) + (setq condform `(if (< ,depthvar ,depth) ,condform nil))) + (setq declarations (cons (cons depthvar 0) declarations)) + ;; I'll have the depth be incremented for all the entry stuff and no exit stuff, + ;; since I don't see any more uniform, logical way to do this. + (setq entrycondform + `(progn + (setq ,depthvar (1+ ,depthvar)) + ,entrycondform)) + (setq exitcondform + `(progn + (setq ,depthvar (1- ,depthvar)) + ,exitcondform))) + `(,(car x) ,declarations + (quote ,condform) + (quote ,entrycondform) (quote ,entryform) + (quote ,exitcondform) (quote ,exitform))) + (case (car tail) + (:declarations + (setq declarations + (do ((decls (cadr tail) (cdr decls)) + (result)) + ((null decls) result) + (setq result + (cons (if (symbolp (car decls)) + (cons (car decls) nil) + (cons (caar decls) (eval (cadar decls)))) + result))))) + (:cond (setq condform (cadr tail))) + (:entrycond (setq entrycondform (cadr tail))) + (:entry (setq entryform (cadr tail))) + (:exitcond (setq exitcondform (cadr tail))) + (:exit (setq exitform (cadr tail))) + (:depth (setq depth (cadr tail))) + (otherwise nil)))))) + +(defun check-trace-spec (form) + (or (symbolp form) + (if (and (consp form) (null (cdr (last form)))) + (check-trace-args form (cdr form) nil) + (error "Each trace spec must be a symbol or a list terminating in NIL, but ~S is not~&." + form)))) + +(defun check-declarations (declarations &aux decl) + (when (consp declarations) + (setq decl (if (consp (car declarations)) (car declarations) (list (car declarations) nil))) + (when (not (symbolp (car decl))) + (error "Declarations are supposed to be of symbols, but ~S is not a symbol.~&" + (car decl))) + (when (cddr decl) + (error "Expected a CDDR of NIL in ~S.~&" + decl)) + (when (assoc (car decl) (all-trace-declarations)) + (error "The variable ~A is already declared for tracing" + (car decl))))) + +(defun check-trace-args (form args acc-keywords) + (when args + (cond + ((null (cdr args)) + (error "A trace spec must have odd length, but ~S does not.~&" + form)) + ((member (car args) acc-keywords) + (error "The keyword ~A occurred twice in the spec ~S~&" + (car args) form)) + (t + (case (car args) + ((:entry :exit :cond :entrycond :exitcond) + (check-trace-args form (cddr args) (cons (car args) acc-keywords))) + (:depth + (when (not (and (integerp (cadr args)) + (> (cadr args) 0))) + (error + "~&Specified depth should be a positive integer, but~&~S is not.~&" + (cadr args))) + (check-trace-args form (cddr args) (cons :depth acc-keywords))) + (:declarations + (check-declarations (cadr args)) + (check-trace-args form (cddr args) (cons :declarations acc-keywords))) + (otherwise + (error "Expected :entry, :exit, :cond, :depth, or :declarations~&~ + in ~S where instead there was ~S~&" + form (car args)))))))) + +(defun trace-one (form &aux f (fname (if (consp form) (car form) form))) + (when (null (fboundp fname)) + (format *trace-output* "The function ~S is not defined.~%" fname) + (return-from trace-one nil)) + (when (special-operator-p fname) + (format *trace-output* "~S is a special form.~%" fname) + (return-from trace-one nil)) + (when (macro-function fname) + (format *trace-output* "~S is a macro.~%" fname) + (return-from trace-one nil)) + (when (get fname 'traced) + (untrace-one fname)) + (check-trace-spec form) + (setq form (trace-one-preprocess form)) + (si:fset (setq f (gensym)) (symbol-function fname)) + (eval `(defun ,fname (&rest args) + (trace-call ',f args + ,@(cddr form)))) + (si:putprop fname f 'traced) + (setq *trace-list* (cons (cons fname (cadr form)) *trace-list*)) + (list fname)) + +(defun reset-trace-declarations (declarations) + (when declarations + (set (caar declarations) (cdar declarations)) + (reset-trace-declarations (cdr declarations)))) + +(defun all-trace-declarations ( &aux result) + (dolist (v *trace-list*) + (setq result (append result (cdr v)))) + result) + +(defun trace-call (temp-name args cond entrycond entry exitcond exit + &aux (*trace-level* *trace-level*) vals indent) + (when (= *trace-level* 0) + (reset-trace-declarations (all-trace-declarations))) + (cond + ((eval `(let ((arglist (quote ,args))) ,cond)) + (setq *trace-level* (1+ *trace-level*)) + (setq indent (min (* *trace-level* 2) 20)) + (fresh-line *trace-output*) + (when (or (eq entrycond t) ;optimization for common value + (eval `(let ((arglist (quote ,args))) ,entrycond))) + ;; put out the prompt before evaluating + (format *trace-output* + "~V@T~D> " + indent *trace-level*) + (format *trace-output* + "~S~%" + (eval `(let ((arglist (quote ,args))) ,entry))) + (fresh-line *trace-output*)) + (setq vals (multiple-value-list (apply temp-name args))) + (when (or (eq exitcond t) ;optimization for common value + (eval `(let ((arglist (quote ,args)) (values (quote ,vals))) + ,exitcond))) + ;; put out the prompt before evaluating + (format *trace-output* + "~V@T<~D " + indent + *trace-level*) + (format *trace-output* + "~S~%" + (eval `(let ((arglist (quote ,args)) (values (quote ,vals))) ,exit)))) + (setq *trace-level* (1- *trace-level*)) + (values-list vals)) + (t (apply temp-name args)))) + +(defun untrace-one (fname &aux sym) + (cond ((setq sym (get fname 'traced)) + (remprop fname 'traced) + (cond + ((not (fboundp fname)) + (format *trace-output* + "The function ~S was traced, but is no longer defined.~%" + fname)) + + ;;(LAMBDA-BLOCK block-name lambda-list (TRACE-CALL ... )) + ((and (consp (symbol-function fname)) + (consp (nth 3 (symbol-function fname))) + (eq (car (nth 3 (symbol-function fname))) 'trace-call)) + (si:fset fname (symbol-function sym))) + (t + (format *trace-output* + "The function ~S was traced, but redefined.~%" + fname))) + (setq *trace-list* + (delete-if #'(lambda (u) (eq (car u) fname)) + *trace-list* :count 1)) + (list fname)) + (t + (format *trace-output* "The function ~S is not traced.~%" fname) + nil))) + +#| Example of tracing a function "fact" so that only the outermost call is traced. + +(defun fact (n) (if (= n 0) 1 (* n (fact (1- n))))) + +;(defvar in-fact nil) +(trace (fact :declarations ((in-fact nil)) + :cond + (null in-fact) + :entry + (progn + (setq in-fact t) + (princ "Here comes input ") + (cons 'fact arglist)) + :exit + (progn (setq in-fact nil) + (princ "Here comes output ") + (cons 'fact values)))) + +; Example of tracing fact so that only three levels are traced + +(trace (fact :declarations + ((fact-depth 0)) + :cond + (and (< fact-depth 3) + (setq fact-depth (1+ fact-depth))) + :exit + (progn (setq fact-depth (1- fact-depth)) (cons 'fact values)))) +|# + + + +(defvar *step-level* 0) +(defvar *step-quit* nil) +(defvar *step-function* nil) + +(defvar *old-print-level* nil) +(defvar *old-print-length* nil) + + +(defun step-read-line () + (do ((char (read-char *debug-io*) (read-char *debug-io*))) + ((or (char= char #\Newline) (char= char #\Return))))) + +(defmacro if-error (error-form form) + (let ((v (gensym)) (f (gensym)) (b (gensym))) + `(let (,v ,f) + (block ,b + (unwind-protect (setq ,v ,form ,f t) + (return-from ,b (if ,f ,v ,error-form))))))) + +(defmacro step (form) + `(let* ((*old-print-level* *print-level*) + (*old-print-length* *print-length*) + (*print-level* 2) + (*print-length* 2)) + (read-line) + (format *debug-io* "Type ? and a newline for help.~%") + (setq *step-quit* nil) + (stepper ',form nil))) + +(defun stepper (form &optional env + &aux values (*step-level* *step-level*) indent) + (when (eq *step-quit* t) + (return-from stepper (evalhook form nil nil env))) + (when (numberp *step-quit*) + (if (>= (1+ *step-level*) *step-quit*) + (return-from stepper (evalhook form nil nil env)) + (setq *step-quit* nil))) + (when *step-function* + (if (and (consp form) (eq (car form) *step-function*)) + (let ((*step-function* nil)) + (return-from stepper (stepper form env))) + (return-from stepper (evalhook form #'stepper nil env)))) + (setq *step-level* (1+ *step-level*)) + (setq indent (min (* *step-level* 2) 20)) + (loop + (format *debug-io* "~VT~S " indent form) + (finish-output *debug-io*) + (case (do ((char (read-char *debug-io*) (read-char *debug-io*))) + ((and (char/= char #\Space) (char/= char #\Tab)) char)) + ((#\Newline #\Return) + (setq values + (multiple-value-list + (evalhook form #'stepper nil env))) + (return)) + ((#\n #\N) + (step-read-line) + (setq values + (multiple-value-list + (evalhook form #'stepper nil env))) + (return)) + ((#\s #\S) + (step-read-line) + (setq values + (multiple-value-list + (evalhook form nil nil env))) + (return)) + ((#\p #\P) + (step-read-line) + (write form + :stream *debug-io* + :pretty t :level nil :length nil) + (terpri)) + ((#\f #\F) + (let ((*step-function* + (if-error nil + (prog1 (read-preserving-whitespace *debug-io*) + (step-read-line))))) + (setq values + (multiple-value-list + (evalhook form #'stepper nil env))) + (return))) + ((#\q #\Q) + (step-read-line) + (setq *step-quit* t) + (setq values + (multiple-value-list + (evalhook form nil nil env))) + (return)) + ((#\u #\U) + (step-read-line) + (setq *step-quit* *step-level*) + (setq values + (multiple-value-list + (evalhook form nil nil env))) + (return)) + ((#\e #\E) + (let ((env1 env)) + (dolist (x + (if-error nil + (multiple-value-list + (evalhook + (if-error nil + (prog1 + (read-preserving-whitespace + *debug-io*) + (step-read-line))) + nil nil env1)))) + (write x + :stream *debug-io* + :level *old-print-level* + :length *old-print-length*) + (terpri *debug-io*)))) + ((#\r #\R) + (let ((env1 env)) + (setq values + (if-error nil + (multiple-value-list + (evalhook + (if-error nil + (prog1 + (read-preserving-whitespace + *debug-io*) + (step-read-line))) + nil nil env1))))) + (return)) + ((#\b #\B) + (step-read-line) + (let ((*ihs-base* (1+ *ihs-top*)) + (*ihs-top* (1- (ihs-top))) + (*current-ihs* *ihs-top*)) + (simple-backtrace))) + (t + (step-read-line) + (terpri) + (format *debug-io* + "Stepper commands:~%~ + n (or N or Newline): advances to the next form.~%~ + s (or S): skips the form.~%~ + p (or P): pretty-prints the form.~%~ + f (or F) FUNCTION: skips until the FUNCTION is called.~%~ + q (or Q): quits.~%~ + u (or U): goes up to the enclosing form.~%~ + e (or E) FORM: evaluates the FORM ~ + and prints the value(s).~%~ + r (or R) FORM: evaluates the FORM ~ + and returns the value(s).~%~ + b (or B): prints backtrace.~%~ + ?: prints this.~%") + (terpri)))) + (when (or (constantp form) (and (consp form) (eq (car form) 'quote))) + (return-from stepper (car values))) + (if (endp values) + (format *debug-io* "~V@T=~%" indent) + (do ((l values (cdr l)) + (b t nil)) + ((endp l)) + (if b + (format *debug-io* "~V@T= ~S~%" indent (car l)) + (format *debug-io* "~V@T& ~S~%" indent (car l))))) + (setq *step-level* (- *step-level* 1)) + (values-list values)) + diff --git a/lsp/gcl_translate_pathname.lsp b/lsp/gcl_translate_pathname.lsp new file mode 100644 index 0000000..1ee475b --- /dev/null +++ b/lsp/gcl_translate_pathname.lsp @@ -0,0 +1,90 @@ +(in-package :si) + +(defun lenel (x lp) + (case x (:wild 1)(:wild-inferiors 2)(:absolute (if lp -1 0))(:relative (if lp 0 -1)) + ((:unspecific nil :newest) -1)(otherwise (length x)))) + +(defun next-match (&optional (i 1) (k -1) (m (1- (ash (length *match-data*) -1)))) + (cond ((< k (match-beginning i) (match-end i)) i) + ((< i m) (next-match (1+ i) k m)) + (i))) + +(defun mme2 (s lel lp &optional (b 0) (i (next-match)) r el + &aux (e (+ b (lenel (car lel) lp)))(j (match-beginning i))(k (match-end i))) + (cond + ((< (- b 2) j k (+ e 2)) + (let* ((z (car lel))(b1 (max b j))(e1 (min k e)) + (z (if (or (< b b1) (< e1 e)) (subseq z (- b1 b) (- e1 b)) z)) + (r (if el r (cons nil r)))) + (mme2 s lel lp b (next-match i k) (cons (cons z (car r)) (cdr r)) (or el (car lel))))) + ((< (1- j) b e (1+ k)) + (let ((r (if el r (cons nil r)))) + (mme2 s (cdr lel) lp (1+ e) i (cons (cons (car lel) (car r)) (cdr r)) (or el (list (car lel)))))) + ((consp el) + (let* ((cr (nreverse (car r)))) + (mme2 s lel lp b (next-match i k) (cons (cons (car el) (list cr)) (cdr r))))) + (el + (let* ((cr (nreverse (car r)))) + (mme2 s (cdr lel) lp (1+ e) i (cons (cons el cr) (cdr r))))) + (lel (mme2 s (cdr lel) lp (1+ e) i (cons (car lel) r))) + ((nreverse r)))) + +(defun do-repl (x y) + (labels ((r (x l &optional (b 0) &aux (f (string-match #v"\\*" x b))) + (if (eql f -1) (if (eql b 0) x (subseq x b)) + (string-concatenate (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) + (r y x))) + +(defun dir-p (x) (when (consp x) (member (car x) '(:absolute :relative)))) + +(defun source-portion (x y) + (cond + ((or (dir-p x) (dir-p y)) + (mapcan (lambda (z &aux (w (source-portion + (if y (when (wild-dir-element-p z) (setf x (member-if 'listp x)) (pop x)) z) + (when y z)))) + (if (listp w) w (list w))) (or y x))) + ((if y (eq y :wild-inferiors) t) (if (listp x) (if (listp (cadr x)) (cadr x) (car x)) x));(or y) + ((eq y :wild) (if (listp x) (car x) x));(or y) + ((stringp y) (do-repl (when (listp x) (unless (listp (cadr x)) (cdr x))) y)) + (y))) + +(defun list-toggle-case (x f) + (typecase x + (string (values (funcall f x))) + (cons (mapcar (lambda (x) (list-toggle-case x f)) x)) + (otherwise x))) + +(defun mme3 (sx px flp tlp) + (list-toggle-case + (lnp (mme2 sx (pnl1 (mlp px)) flp)) + (cond ((eq flp tlp) 'identity) + (flp 'string-downcase) + (tlp 'string-upcase)))) + +(defun translate-pathname (source from to &key + &aux (psource (pathname source)) + (pto (pathname to)) + (match (pathname-match-p source from))) + (declare (optimize (safety 1))) + (check-type source pathname-designator) + (check-type from pathname-designator) + (check-type to pathname-designator) + (check-type match (not null)) + (apply 'make-pathname :host (pathname-host pto) :device (pathname-device pto) + (mapcan 'list +pathname-keys+ + (mapcar 'source-portion + (mme3 (namestring source) psource (typep psource 'logical-pathname) (typep pto 'logical-pathname)) + (mlp pto))))) + +(defun translate-logical-pathname (spec &key &aux (p (pathname spec))) + (declare (optimize (safety 1))) + (check-type spec pathname-designator) + (typecase p + (logical-pathname + (let ((rules (assoc p (logical-pathname-translations (pathname-host p)) :test 'pathname-match-p))) + (unless rules + (error 'file-error :pathname p :format-control "No matching translations")) + (translate-logical-pathname (apply 'translate-pathname p rules)))) + (otherwise p))) + diff --git a/lsp/gcl_truename.lsp b/lsp/gcl_truename.lsp new file mode 100644 index 0000000..a0d6928 --- /dev/null +++ b/lsp/gcl_truename.lsp @@ -0,0 +1,42 @@ +(in-package :si) + +(defun link-expand (str &optional (b 0) (n (length str)) fr) + (labels ((frame (b e) (make-array (- n b) :element-type 'character + :displaced-to str :displaced-index-offset b :fill-pointer (- e b))) + (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) + (let* ((i (string-match +dirsep+ str b)) + (fr (set-fr fr (if (eql i -1) n i))) + (l (when (eq (stat1 fr) :link) (readlinkat 0 fr)))) + (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) + (link-expand (string-concatenate (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) + ((eql i -1) str) + ((link-expand str (1+ i) n fr)))))) + +(defun logical-pathname-designator-p (x) + (typecase x + (string (logical-pathname-parse x)) + (pathname (typep x 'logical-pathname)) + (stream (logical-pathname-designator-p (pathname x))))) + +(defun truename (pd &aux (ns (namestring (translate-logical-pathname pd)))) + (declare (optimize (safety 1))) + (check-type pd pathname-designator) + (when (wild-pathname-p ns) + (error 'file-error :pathname pd :format-control "Pathname is wild")) + (let* ((ns (ensure-dir-string (link-expand ns))) + (ppd (if (eq (namestring pd) ns) pd (pathname ns)))) + (unless (or (zerop (length ns)) (stat1 ns)) + (error 'file-error :pathname ns :format-control "Pathname does not exist")) + (let* ((d (pathname-directory ppd)) + (d1 (subst :back :up d)) + (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) + (if (eq (car d) :absolute) ppd (merge-pathnames ppd *current-directory* nil))))) + + +(defun probe-file (pd &aux (pn (translate-logical-pathname pd))) + (declare (optimize (safety 1))) + (check-type pd pathname-designator) + (when (wild-pathname-p pn) + (error 'file-error :pathname pn :format-control "Pathname is wild")) + (when (eq (stat1 (link-expand (namestring pn))) :file) + (truename pn))) diff --git a/lsp/gcl_wild_pathname_p.lsp b/lsp/gcl_wild_pathname_p.lsp new file mode 100644 index 0000000..f119eec --- /dev/null +++ b/lsp/gcl_wild_pathname_p.lsp @@ -0,0 +1,28 @@ +(in-package :si) + +(defun wild-namestring-p (x) + (when (stringp x) (>= (string-match #v"(\\*|\\?|\\[|\\{)" x) 0))) + +(defun wild-dir-element-p (x) + (or (eq x :wild) (eq x :wild-inferiors) (wild-namestring-p x))) + +(defun wild-path-element-p (x) + (or (eq x :wild) (wild-namestring-p x))) + +#.`(defun wild-pathname-p (pd &optional f) + (declare (optimize (safety 1))) + (check-type pd pathname-designator) + (check-type f (or null (member ,@+pathname-keys+))) + (case f + ((nil) (or (wild-namestring-p (namestring pd)) + (when (typep pd 'pathname);FIXME stream + (eq :wild (pathname-version pd))))) + ;; ((nil) (if (stringp pd) (wild-namestring-p pd) + ;; (let ((p (pathname pd))) + ;; (when (member-if (lambda (x) (wild-pathname-p p x)) +pathname-keys+) t)))) + ((:host :device) nil) + (:directory (when (member-if 'wild-dir-element-p (pathname-directory pd)) t)) + (:name (wild-path-element-p (pathname-name pd))) + (:type (wild-path-element-p (pathname-type pd))) + (:version (wild-path-element-p (pathname-version pd))))) + diff --git a/lsp/gprof.hc b/lsp/gprof.hc new file mode 100755 index 0000000..c408fb0 --- /dev/null +++ b/lsp/gprof.hc @@ -0,0 +1,122 @@ +#include +#include +#define CF_FLAG (1 << 31) + +static +/* +mymonitor(low,high,x) + int low,high; + object x; +{ if (0 == x) {monitor(0); return 0;} + if (type_of(x)!=t_string) FEerror("expected string",0); + monitor(low,high,x->ust.ust_self,x->ust.ust_dim,1000); +} +*/ +mymonitor(low,high,x,leng) + int low,high; + object x; +{ if (0 == x) {monitor(0); return 0;} + monitor(low,high,x,leng); +} + + +char *sbrk(); + +static +mymonstartup(low,high) +int low,high; +{char *buf; +buf = sbrk(0); +monstartup(low,high); +return buf; +} + +char *kcl_self; + +#include +#include "../h/ext_sym.h" +#define syment nlist +#define fileheader exec + +static char symname [200]; + + +static +sym_leng_and_copy(ux,copy) + unsigned int ux; + int copy; +{ char *from; + int leng=0; + if (ux & CF_FLAG) + {object x = (object) (ux & ~CF_FLAG); + if (x->cf.cf_name ==0) + from="ZUNDEF"; + else {leng = x->cf.cf_name->s.s_fillp; + from = x->cf.cf_name->s.s_self;}} + else if (ux) + { from= (char *)(ux);} + else {from="UNDEF";} + if (leng==0) leng=strlen(from); + if (leng >= sizeof(symname)) FEerror("Too long symbol",0); + if(copy) bcopy(from,symname,leng); + symname[leng]='0'; + return leng; +} + + + + + + + + +extern char *core_end; + +static +write_outsyms() +{FILE *fdout,*fdin; + static struct syment sym; + struct fileheader hdr; + fdout= fopen("syms.out","w"); + fdin=fopen(kcl_self,"r"); + if (fdin == 0) FEerror("Can't find akcl image",0); + fread(&hdr,sizeof(hdr),1,fdin); + if (fdout == 0) FEerror("Can't open syms.out",0); + fclose(fdin); + sym.n_type= (N_TEXT | N_EXT); + hdr.a_text=sizeof(hdr); + hdr.a_data=0; + hdr.a_bss=0; + hdr.a_trsize=0; + hdr.a_drsize=0; + hdr.a_syms= (1 + combined_table.length)*sizeof (struct syment); + fwrite(&hdr,sizeof(hdr),1,fdout); + fseek(fdout,N_SYMOFF(hdr),0); + {int i=0; int pos=4; + while (i < combined_table.length) + { /* printf("%d %d",i,SYM_STRING(combined_table,i)); + fflush(stdout); */ + + sym.n_un.n_strx = pos; + sym.n_value=SYM_ADDRESS(combined_table,i); + fwrite(&sym,sizeof(sym),1,fdout); + pos=pos+ sym_leng_and_copy(SYM_STRING(combined_table,i),1)+1; +/* printf("%s\n",symname); */ + i++; + } + + sym.n_un.n_strx = pos; + sym.n_value=(int)core_end; + fwrite(&sym,sizeof(sym),1,fdout); + pos=pos+ strlen("_ENDSYM")+1; + + + fwrite(&pos,sizeof(pos),1,fdout); + for (i=0; i< combined_table.length ; i++) + {int leng=sym_leng_and_copy(SYM_STRING(combined_table,i),1); + fwrite(symname,leng,1,fdout); + putc(0,fdout);} + } + fwrite("_ENDSYM",8,1,fdout); + fclose(fdout); +} diff --git a/lsp/gprof1.lisp b/lsp/gprof1.lisp new file mode 100755 index 0000000..a2ae0f7 --- /dev/null +++ b/lsp/gprof1.lisp @@ -0,0 +1,53 @@ +(in-package 'si) + +;; (load "gprof.o") +;; On a sun in sun0S 3 or 4.0 +;; make a modified copy of /lib/gcrt0.o called gcrt0-mod.o +;; then (cd unixport ; make "EXTRAS=../lsp/gcrt0-mod.o") +;; after compiling some .o files with +;; (cd o ; make "CFLAGS = -I../h -pg -g -c") +;; (invoke gprof-setup) +;; and (monitor #x800 3000000) +;; (monitor 0 0) to start and stop respectively +;; on suns the buffersize = (highpc- lowpc)/2 +6 + + +(clines "#include \"gprof.hc\"") + +(defun gprof-setup (&optional (n 800000) (m 1000000)) + (mymonstartup #x800 n) + (set-up-monitor-array m) +(format t" ;; and (monitor #x800 3000000) + ;; (monitor 0 0) to start and stop respectively + ") + nil) + +(defentry mymonstartup (int int) (int "mymonstartup")) +;(defentry monitor1 (int int object) (int "mymonitor")) +(defentry monitor2 (int int int int) (int "mymonitor")) + +(defentry write_outsyms () (int "write_outsyms")) + +(defvar *monitor-array* nil) + +(defun set-up-monitor-array (&optional (n 1000000)) + (unless *monitor-array* (setf *monitor-array* + (make-array n :element-type 'string-char + :static t)) + ;(mymonstartup 0 2000000) + nil + )) + +(defun monitor (low high) + (monitor1 low high *monitor-array*)) + +(defun write-syms.out () + (set-up-combined) + (write_outsyms)) + + + + + + + diff --git a/lsp/gprof_aix.hc b/lsp/gprof_aix.hc new file mode 100755 index 0000000..44a0949 --- /dev/null +++ b/lsp/gprof_aix.hc @@ -0,0 +1,255 @@ +#include +#include +#include +extern struct monglobal _mondata; +static struct desc { /*function descriptor fields*/ + caddr_t begin; /*initial code address*/ + caddr_t toc; /*table of contents address*/ + caddr_t env; /*environment pointer*/ + } ; /*function descriptor structure*/ +static struct desc *fd; /*pointer to function descriptor*/ + +#include "../h/config.h" +#include "../h/ext_sym.h" +#define CF_FLAG (1 << 31) +extern char *kcl_self; + +#define function_address(f) (((struct desc *)(f))->begin) + +mymonitor(low,high,x,leng) + int low,high; + object x; +{ if (0 == x) {monitor(0); return 0;} + monitor(low,high,x,leng); +} + +static int newmonstartup(); + +mymonstartup(low,high) +caddr_t low,high; +{ +/* static struct frag f[3]; + + f[0].p_low = function_address(&__start); + f[0].p_high = function_address(&init_cmpwt); + f[1].p_low = low; + f[1].p_high = high; + f[2].p_low = 0; + f[3].p_high = 0; + newmonstartup(-1,f); +*/ + _mondata.prof_type = _PROF_TYPE_IS_PG; + return monstartup(low,high); +} + + +/* +symbol table address + &__start == the real address +[if the ld is done with -T0 ] +*/ + + /* +The format of symbol table entries. +[144] m 0x0001486c .text 2 extern void() .Foo +[145] a2 0 60 188239 152 + + */ +/* the monstartup code in aix3.1 is broken: */ + + + + +static size1(f) + struct frag *f; +{ int range; + int fromsize; + int total = 0; + int tonum; + while (f->p_high) + {range = f->p_high - f->p_low; + fromsize = FROM_STG_SIZE(range); + tonum = TO_NUM_ELEMENTS(range); + if ( tonum < MINARCS ) tonum = MINARCS; + else + if ( tonum > TO_MAX-1 ) tonum = TO_MAX-1; + tonum = tonum * sizeof( struct tostruct ); + total += fromsize + tonum + sizeof(struct gfctl); + f++; + } + return total; +} + +static int +newmonstartup(a,f) + struct frag *f; +{struct prof *pb = malloc(3*sizeof(struct prof)); + struct frag *ff =f; + int i = 0 ; + int nranges = 0; + int total = 0; + int range; + caddr_t buffer ; + int callcntsize; + bzero(pb,3*sizeof(struct prof)); + + while(ff->p_high) + { + pb[i].p_high = (caddr_t) ROUNDUP((int)f[i].p_high, INST_CNT_SIZE); + pb[i].p_low = (caddr_t) ROUNDDOWN((int)f[i].p_low, INST_CNT_SIZE); + range = pb[i].p_high - pb[i].p_low; + total += HIST_STG_SIZE(range); + ff++; + i++; + } + nranges = i; + callcntsize = size1(f); + total += callcntsize; + + buffer = (caddr_t) malloc(total); + + + _mondata.monstubuf = buffer; + + for (i=0; i < nranges; i++) + {pb[i].p_buff = (HISTCOUNTER *)buffer; + pb[i].p_scale = HIST_SCALE_1_TO_1; + pb[i].p_bufsize = HIST_NUM_COUNTERS(pb[i].p_high-pb[i].p_low); + if (i == 0) { + pb[i].p_bufsize += + (((callcntsize + HIST_COUNTER_SIZE -1)/HIST_COUNTER_SIZE) + ); + } + buffer += pb[i].p_bufsize * HIST_COUNTER_SIZE; + + } + monitor(1,1,pb,-1, callcntsize); +} + + + + + + + + + + + + + + +static char symname [200]; + +static +sym_leng_and_copy(ux,copy) + unsigned int ux; + int copy; +{ char *from; + int leng=0; + if (ux & CF_FLAG) + {object x = (object) (ux & ~CF_FLAG); + if (x->cf.cf_name ==0) + from="ZUNDEF"; + else {leng = x->cf.cf_name->s.s_fillp; + from = x->cf.cf_name->s.s_self;}} + else if (ux) + { from= (char *)(ux);} + else {from="UNDEF";} + if (leng==0) leng=strlen(from); + if (leng >= sizeof(symname)) FEerror("Too long symbol",0); + if(copy) bcopy(from,symname,leng); + symname[leng]='0'; + return leng; +} + + + +extern char * __start; +extern char *core_end; +extern int bzero(); + +static +write_outsyms() +{FILE *fdout,*fdin; + static struct syment sym; + static struct syment symaux; + struct filehdr Eheader; + struct aouthdr header; + struct scnhdr shdrs[15]; + fdout= fopen("syms.out","w"); + fdin=fopen(kcl_self,"r"); + if (fdin == 0) FEerror("Can't find akcl image"); + fread(&Eheader,1,sizeof(Eheader), fdin); + fread(&header,1,Eheader.f_opthdr,fdin); + fclose(fdin); + if (fdout == 0) FEerror("Can't open syms.out"); + Eheader.f_nscns = 2; + Eheader.f_symptr = sizeof(Eheader) + sizeof(header) + + Eheader.f_nscns*sizeof(struct scnhdr); + Eheader.f_nsyms = 2*(1+ combined_table.length); + bzero(&shdrs[0],10*sizeof(struct scnhdr)); + bzero(&symaux,1*SYMESZ); + bzero(&sym,1*SYMESZ); + + header.tsize=0; + header.dsize=0; + header.bsize=0; + header.o_snentry=1; + header.o_sntext=1; + header.o_sndata=1; + header.o_sntoc=1; + header.o_snbss=1; + header.o_snloader=2; + + + fwrite(&Eheader,1,sizeof(Eheader), fdout); + fwrite(&header,1,Eheader.f_opthdr,fdout); + fwrite(&shdrs[1],Eheader.f_nscns,sizeof(struct scnhdr),fdout); + fseek(fdout,Eheader.f_symptr,0); + + sym.n_scnum == header.o_sntext; + sym.n_sclass = 0x2 ; + sym.n_type = 0x20; + sym.n_numaux = 1; + printf("(&__start = 0x%x)",function_address(&__start)); + {int i=0; int pos=4; + while (i < combined_table.length) + { unsigned int adr = (unsigned int)(SYM_ADDRESS(combined_table,i)); + /* printf("%d %d",i,SYM_STRING(combined_table,i)); + fflush(stdout); */ + + sym.n_offset = pos; + + sym.n_value= + (adr > 0x20000000 ? + (unsigned int) function_address(SYM_ADDRESS(combined_table,i)) + - 0x10000e00 + : adr - 0x10000e00); +/* printf("\n %d %s 0x%x %x ",i,SYM_STRING(combined_table,i), adr, adr); */ + fwrite(&sym,SYMESZ,1,fdout); + fwrite(&symaux,SYMESZ,1,fdout); + pos=pos+ sym_leng_and_copy(SYM_STRING(combined_table,i),1)+1; +/* printf("%s\n",symname); */ + i++; + } + + sym.n_offset = pos; + sym.n_value=(int)core_end - (int) & __start; + fwrite(&sym,SYMESZ,1,fdout); + fwrite(&symaux,SYMESZ,1,fdout); + pos=pos+ strlen("_ENDSYM")+1; + + + fwrite(&pos,sizeof(pos),1,fdout); + printf("(at %d)",ftell(fdout)); + for (i=0; i< combined_table.length ; i++) + {int leng=sym_leng_and_copy(SYM_STRING(combined_table,i),1); + fwrite(symname,leng,1,fdout); + putc(0,fdout);} + } + fwrite("_ENDSYM",8,1,fdout); + fclose(fdout); +} + + + diff --git a/lsp/make.lisp b/lsp/make.lisp new file mode 100755 index 0000000..7a4cb69 --- /dev/null +++ b/lsp/make.lisp @@ -0,0 +1,409 @@ +;;; -*- Mode: Lisp; Package: MAKE; Syntax: Common-Lisp; Base: 10 -*- ;;;; +;; Copyright William F. Schelter 1989. + +;; The author expressly permits copying and alteration of this file, +;; provided any modifications are clearly labeled, and this notice is +;; preserved. The author provides no warranty and this software is +;; provided on an 'as is' basis. +(in-package "MAKE" :use '("LISP") #+gcl :external #+gcl 11 + #+gcl :internal #+gcl 79) + +(export '(make system-load system-compile)) +(provide "MAKE") +;;; ******* Description of Make Facility ************ +;; We provide a simple MAKE facility to allow +;;compiling and loading of a tree of files +;;If the tree is '(a b (d e g h) i) +;; a will be loaded before b is compiled, +;; b will be loaded before d, e, g, h are compiled +;; d e g h will be loaded before i is compiled. + +;; A record is kept of write dates of loaded compiled files, and a file +;;won't be reloaded if it is the same version (unless a force flag is t). + +;;Thus if you do (make :uinfor) twice in a row, the second one would not +;;load anything. NOTE: If you change a, and a macro in it would affect +;;b, b still will not be recompiled. You must choose the :recompile t +;;option, to force the recompiling if you change macro files. +;;Alternately you may specify dependency information (see :depends below). + + +;;****** Sample file which when loaded causes system ALGEBRA +;; to be compiled and loaded ****** + +;;(require "MAKE") +;;(use-package "MAKE") +;;(setf (get :algebra :make) '(a b (d e) l)) +;;(setf (get :algebra :source-path) "/usr2/wfs/algebra/foo.lisp") +;;(setf (get :algebra :object-path) "/usr2/wfs/algebra/o/foo.o") +;;(make :algebra :compile t) + +;; More complex systems may need to do some special operations +;;at certain points of the make. +;;the tree of files may contain some keywords which have special meaning. +;;eg. '(a b (:progn (gbc) (if make::*compile* +;; (format t "A and B finally compiled"))) +;; (:load-source h i) +;; (d e) l) + +;;then during the load and compile phases the function (gbc) will be +;;called after a and b have been acted on, and during the compile phase +;;the message about "A and B finally.." will be printed. +;;the lisp files h and i will be loaded after merging the paths with +;;the source directory. This feature is extensible: see the definitions +;;of :load-source and :progn. + +;; The keyword feature is extensible, and you may specify what +;;happens during the load or compile phase for your favorite keyword. +;;To do this look at the definition of :progn, and :load-source +;;in the source for make. + + +;;Dependency feature: + +;; This make NEVER loads or compiles files in an order different from +;;that specified by the tree. It will omit loading files which are +;;loaded and up to date, but if two files are out of date, the first (in +;;the printed representation of the tree), will always be loaded before +;;the second. A consequence of this is that circular dependencies can +;;never occur. +;; +;; If the :make tree contains (a b c d (:depends (c d) (a b))) then c +;;and d depend on a and b, so that if a or b need recompilation then c +;;and d will also be recompiled. Thus the general form of a :depends +;;clause is (:depends later earlier) where LATER and EARLIER are either +;;a single file or a list of files. Read it as LATER depends on EARLIER. +;;A declaration of a (:depends (c) (d)) would have no effect, since the +;;order in the tree already rules out such a dependence. + +;; An easy way of specifying a linear dependence is by using :serial. +;;The tree (a (:serial b c d) e) is completely equivalent to the tree +;;(a b c d e (:depends c b)(:depends d (b c))), but with a long list of +;;serial files, it is inconvenient to specify them in the +;;latter representation. + +;;A common case is a set of macros whose dependence is serial followed by a set +;;of files whose order is unimportant. A conventient way of building that +;;tree is +;; +;;(let ((macros '(a b c d)) +;; (files '(c d e f g))) +;; `((:serial ,@ macros) +;; ,files +;; (:depends ,files ,macros))) + +;; The depends clause may occur anywhere within the tree, since +;;an initial pass collects all dependency information. + +;; Make takes a SHOW keyword argument. It is almost impossible to simulate +;;all the possible features of make, for show. Nonetheless, it is good +;;to get an idea of the compiling and loading sequence for a new system. +;;As a byproduct, you could use the output, as a simple sequence of calls +;;to compile-file and load, to do the required work, when make is not around +;;to help. + + +;;***** Definitions ******** +(defvar *files-loaded* nil) +(defvar *show-files-loaded* nil) ;only for show option +(defvar *load* nil "Will be non nil inside load-files") +(defvar *compile* nil "Bound by compile-files to t") +(defvar *depends* nil) +(defvar *depends-new* nil) +(defvar *force* nil) +(defvar *when-compile* nil "Each compile-file evals things in this list and sets it to nil") +#+kcl(defvar *system-p* nil) +(defvar *compile-file-function* 'make-compile-file) +(defvar *load-function* 'make-load-file) +(defvar show nil) +(defvar *cflags* #-kcl nil + #+kcl '(:system-p *system-p*)) + + +;;this is the main entry point + +(defun make (system &key recompile compile batch object-path source-path + show proclaims + &aux files *depends* *when-compile* + *show-files-loaded* + #+gcl (*load-fn-too* proclaims) + + ) + + "SYSTEM is a tree of files, or a symbol with :make property. It +loads all file files in system. If COMPILE it will try to compile +files with newer source versions than object versions, before loading. +If RECOMPILE it will recompile all files. This is equivalent to deleting all +objects and using :compile t. SOURCE-PATH is merged with the name given +in the files list, when looking for a file to compile. OBJECT-PATH is +merged with the name in the files list, when looking for a file to +load. If SYSTEM is a symbol, then a null OBJECT-PATH would be set to +the :object-path property of SYSTEM. Similarly for :source-path" + + (declare (special object-path source-path show)) batch + (cond ((symbolp system) + (or object-path (setf object-path (get system :object-path))) + (or source-path (setf source-path (get system :source-path))) + (setf files (get system :make)) + (or files + (if (get system :files) + (error "Use :make property, :files property is obssolet{!"))) + ) + (t (setf files system))) + #+gcl (when proclaims (compiler::emit-fn t) (compiler::setup-sys-proclaims)) + (let (#+lispm ( si::inhibit-fdefine-warnings + (if batch :just-warn si::inhibit-fdefine-warnings))) + (let ((*depends* (if (or compile recompile) (get-depends system))) + *depends-new*) + (dolist (v files) + (when (or compile recompile) + (compile-files v recompile)) + (load-files v recompile))) + #+gcl + (if proclaims (compiler::write-sys-proclaims)) + )) + +(defun system-load (system-name &rest names) + "If :infor is a system, (system-load :uinfor joe betty) will load +joe and betty from the object-path for :uinfor" + (load-files names t (get system-name :object-path))) + +(defun system-compile (system-name &rest names) + + "If :iunfor is a system, (system-compile :uinfor joe) will in the +source path for joe and compile him into the object path for :uinfor" + (compile-files names t :source-path + (get system-name :source-path) :object-path + (get system-name :object-path))) + +(defun get-depends (system-name &aux result) + (dolist (v (get system-name :make)) + (cond ((atom v) ) + ((eq (car v) :serial) + (do ((w (reverse (cdr v))(cdr w))) + ((null (cdr w))) + (push (list (car w) (cdr w)) result))) + ((eq (car v) :depends) + (push (cdr v) result )))) + result) + +#+kcl +(setq si::*default-time-zone* 6) +#+winnt +(setq SYSTEM:*DEFAULT-TIME-ZONE* (GET-SYSTEM-TIME-ZONE)) + +(defun print-date (&optional(stream *standard-output*) + (time (get-universal-time))) + (multiple-value-bind (sec min hr day mon yr wkday) + (decode-universal-time time) + (format stream "~a ~a ~a ~d:~2,'0d:~2,'0d ~a" + (nth wkday '( "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")) + (nth (1- mon) '("Jan" "Feb" "Mar" "Apr" "May" "Jun" + "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) + day + hr min sec yr))) + +;;This is an awfully roundabout downcase, but some machines +;;like symbolics swap cases on the pathname, so we have to do an extra +;;swap!! +(defun lowcase (na &aux (*print-case* :downcase)) + (pathname-name (pathname (format nil "~a" na)))) + +(defun our-merge (name path &optional ign ) ign + #+lispm (setq name (string-upcase (string name))) + (make-pathname :name (string name) + :type (pathname-type path) + :version (pathname-version path) + :host (pathname-host path) + :directory (pathname-directory path))) + + +#+kcl +(setf (get :link 'load) + #'(lambda (path to-link) + (declare (special object-path)) + (si::faslink (our-merge (lowcase path) object-path) + to-link))) + +(setf (get :link 'compile) + #'(lambda (path to-link) + to-link + (compile-files path *force*))) + +(setf (get :progn 'load) + #'(lambda (&rest args) + (eval (cons 'progn args)))) + +(setf (get :progn 'compile) (get :progn 'load)) + +(setf (get :load-source 'load) + #'(lambda (&rest args) + (declare (special source-path)) + (load-files args *force* source-path))) + +(setf (get :load-source-when-compile 'compile) + (get :load-source 'load)) + +;;should nott use :lisp anymore +(setf (get :lisp 'load) + #'(lambda (x) (error "please replace :lisp by :load-source"))) + +(setf (get :serial 'load) #'(lambda (&rest l)(load-files l))) +(setf (get :serial 'compile) + #'(lambda (&rest l) + (dolist (v l) + (compile-files v) + (load-files v)))) + + +(defun load-files (files &optional (*force* *force*) (object-path object-path) + &aux path tem (*load* t)) + (declare (special object-path source-path *force* show)) + (cond ((atom files) + (setq path (object files)) + (cond (show + (unless (member path *show-files-loaded* :test 'equalp) + (push path *show-files-loaded*) + (format t "~%(LOAD ~s)" (namestring path)))) + ((null *load-function*)) + ((or *force* + (or (not (setq tem + (member path *files-loaded* + :test 'equalp :key 'car))) + (> (file-write-date path) (cdr (car tem))))) + (funcall *load-function* files) + (push (cons path (file-write-date path)) *files-loaded*)))) + ((keywordp (car files)) + (let ((fun (get (car files) 'load))) + (cond (fun (apply fun (cdr files)))))) + (t (dolist (v files) (load-files v *force* object-path))))) + + +(defun file-date (file) + (if (probe-file file) (or (file-write-date file) 0) 0)) + +(defun source (file) + (declare (special source-path)) + (our-merge (lowcase file) source-path)) + +(defun object (file) + (declare (special object-path)) + (our-merge (lowcase file) object-path)) + + +;;for lisp machines, and others where checking date is slow, this +;;we should try to cache some dates, and then remove them as we do +;;things like compile files... + +(defun file-out-dated (file) + (let ((obj-date (file-date (object file)))) + (or (<= obj-date (file-date (source file))) + (dolist (v *depends*) + (cond ((or (and (consp (car v)) + (member file (car v))) + (eq (car v) file)) + (dolist (w (if (consp (second v)) + (second v) (cdr v))) + (cond ((or (<= obj-date (file-date (source w))) + (member w *depends-new*)) + (return-from file-out-dated t)))))))))) + + +(defun make-compile-file ( l) + (format t "~&Begin compile ~a at ~a~%" l (print-date nil)) + (dolist (v *when-compile*) (eval v)) + (setq *when-compile* nil) + ;;Franz excl needs pathnames quoted, and some other lisp + ;;would not allow an apply here. Sad. + (eval `(compile-file ',(source l) :output-file ',(object l) + ,@ *cflags*)) + (format t "~&End compile ~a at ~a~%" l (print-date nil)) + + ) + +(defvar *load-fn-too* nil) +(defun make-load-file (l) + (let ((na (object l))) + (load na) + (if (and *load-fn-too* + (probe-file + (setq na + (our-merge (lowcase l) (merge-pathnames "foo.fn" na))))) + (load na)) + + + )) + +;;these are versions which don't really compile or load files, but +;;do create a new "compiled file" and "fake load" to test date mechanism. +#+debug +(defun make-compile-file (file) + (format t "~%Fake Compile ~a" (namestring (source file))) + (dolist (v *when-compile*) (eval v)) (setq *when-compile* nil) + (with-open-file (st (object file) :direction :output) + (format st "(print (list 'hi))"))) +#+debug +(defun make-load-file (l) + (format t "~%Fake loading ~a" (namestring(object l)))) + + + + +(defun compile-files (files &optional (*force* *force*) + &key (source-path source-path) + (object-path object-path) + &aux + (*compile* t) ) + (declare (special object-path source-path *force* show)) + (cond ((atom files) + (when (or *force* (file-out-dated files)) + (push files *depends-new*) + (cond + (show + (format t "~%(COMPILE-FILE ~s)" (namestring (source files)))) + (t + (and *compile-file-function* + (funcall *compile-file-function* files)) + )))) + ((keywordp (car files)) + (let ((fun (get (car files) 'compile))) + (if fun (apply fun (cdr files))))) + (t (dolist (v files) (compile-files v *force*))))) + +;;Return the files for SYSTEM + +(defun system-files (system &aux *files*) + (declare (special *files*)) + (let ((sys (get system :make))) + (get-files1 sys)) + (nreverse *files*)) + + +(defun get-files1 (sys) + (declare (special *files*)) + (cond ((and sys (atom sys) )(pushnew sys *files*)) + ((eq (car sys) :serial) (get-files1 (cdr sys))) + ((keywordp (car sys))) + (t (dolist (v sys) (get-files1 v))))) + + +(defmacro make-user-init (files &aux (object-path + (if (boundp 'object-path) object-path + "foo.o"))) + (declare (special object-path)) + `(progn + (clines "void gcl_init_or_load1 (); +#define init_or_load(fn,file) do {extern int fn(); gcl_init_or_load1(fn,file);} while(0) + +user_init{") ,@ + (sloop::sloop for x in files + for f = (substitute #\- #\_ (lowcase x)) + for ff = (namestring (truename (object x))) + collect + `(clines ,(Format nil "init_or_load(init_~a,\"~a\");" f ff))) + (clines "}"))) + + + + + diff --git a/lsp/makefile b/lsp/makefile new file mode 100644 index 0000000..de872b9 --- /dev/null +++ b/lsp/makefile @@ -0,0 +1,62 @@ + +.SUFFIXES: +.SUFFIXES: .fn .o .c .lsp + +-include ../makedefs + + +PORTDIR = ../unixport +CAT=cat +APPEND=../xbin/append + +OBJS = gcl_sharp.o gcl_arraylib.o gcl_assert.o gcl_defmacro.o gcl_defstruct.o \ + gcl_describe.o gcl_evalmacros.o gcl_fpe.o \ + gcl_iolib.o gcl_listlib.o gcl_mislib.o gcl_module.o gcl_numlib.o \ + gcl_packlib.o gcl_predlib.o \ + gcl_parse_namestring.o gcl_make_pathname.o gcl_namestring.o gcl_translate_pathname.o\ + gcl_logical_pathname_translations.o gcl_directory.o gcl_merge_pathnames.o gcl_truename.o gcl_sharp_uv.o\ + gcl_seq.o gcl_seqlib.o gcl_setf.o gcl_top.o gcl_trace.o gcl_sloop.o \ + gcl_debug.o gcl_info.o gcl_serror.o gcl_restart.o \ + gcl_rename_file.o gcl_pathname_match_p.o gcl_wild_pathname_p.o \ + gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o $(EXTRA_LOBJS) +# export.o autoload.o auto_new.o + +LISP=$(PORTDIR)/saved_pre_gcl$(EXE) +COMPILE_FILE=$(LISP) $(PORTDIR) -system-p -c-file -data-file -h-file -compile + +%.o: $(PORTDIR)/saved_pre_gcl$(EXE) %.lsp + $(COMPILE_FILE) $* + +all: $(OBJS) #$(RL_OBJS) + +.lsp.fn: ../cmpnew/gcl_collectfn.o + ../xbin/make-fn $*.lsp $(LISP) + +all: $(OBJS) + +fns1: $(FNS) + +fns: ../cmpnew/gcl_collectfn.o + $(MAKE) fns1 -e "FNS=`echo ${OBJS} | sed -e 's:\.o:\.fn:g'`" + +#../cmpnew/gcl_collectfn.o: ../cmpnew/gcl_collectfn.lsp +# (cd ../cmpnew ; $(PORTDIR)/saved_gcl $(PORTDIR)/ gcl_collectfn.lisp gcl_collectfn S1000) + + +clean: + rm -f *.o core a.out *.fn *.c *.data *.h +allclean: + rm -f *.h *.data *.c + +dummy3 $(NEWCFILES): sys-proclaim.lisp + +sys-proclaim.lisp: fns + echo '(in-package "SYSTEM")' \ + '(load "../cmpnew/gcl_collectfn")'\ + '(compiler::make-all-proclaims "*.fn")' | ../xbin/gcl + + +newc: + $(MAKE) $(OBJS) -e "NEWCFILES=`echo $(OBJS) | sed -e 's:\.o:.c:g'`" + + diff --git a/lsp/sys-proclaim.lisp b/lsp/sys-proclaim.lisp new file mode 100755 index 0000000..c5e4ca8 --- /dev/null +++ b/lsp/sys-proclaim.lisp @@ -0,0 +1,666 @@ + +(COMMON-LISP::IN-PACKAGE "SYSTEM") +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) + COMMON-LISP::YES-OR-NO-P SYSTEM::GPROF-START + SYSTEM::BREAK-LOCALS ANSI-LOOP::MAKE-LOOP-UNIVERSE + SYSTEM::MAKE-CONTEXT SYSTEM::MAYBE-CLEAR-INPUT + COMMON-LISP::Y-OR-N-P SLOOP::PARSE-LOOP-DECLARE + SYSTEM::STEP-INTO SYSTEM::STEP-NEXT + COMMON-LISP::USER-HOMEDIR-PATHNAME COMMON-LISP::ABORT + SYSTEM::MAKE-INSTREAM COMMON-LISP::COMPUTE-RESTARTS + SYSTEM::LOC SYSTEM::NEXT-MATCH SLOOP::PARSE-LOOP-WITH + ANSI-LOOP::LOOP-GENTEMP SYSTEM::CURRENT-STEP-FUN + COMMON-LISP::BREAK ANSI-LOOP::MAKE-LOOP-COLLECTOR + SYSTEM::MAKE-RESTART COMMON-LISP::MAKE-PATHNAME + ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE SYSTEM::MAKE-S-DATA + SYSTEM::GPROF-QUIT SYSTEM::TRANSFORM-KEYWORDS + COMMON-LISP::DRIBBLE SYSTEM::DESCRIBE-ENVIRONMENT + COMMON-LISP::VECTOR SYSTEM::DBL-READ + ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL + ANSI-LOOP::MAKE-LOOP-PATH + ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) + SYSTEM::BREAK-GO SYSTEM::END-WAITING ANSI-LOOP::NAMED-VARIABLE + ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::INSPECT-OBJECT + SYSTEM::GET-&ENVIRONMENT SYSTEM::BREAK-LEVEL-INVOKE-RESTART + COMMON-LISP::INSPECT SYSTEM::DO-F COMMON-LISP::DESCRIBE + SYSTEM::WAITING SYSTEM::FIND-DECLARATIONS + COMMON-LISP::PRIN1-TO-STRING ANSI-LOOP::LOOP-LIST-STEP + SYSTEM::REWRITE-RESTART-CASE-CLAUSE SYSTEM::EXPAND-RANGES + SYSTEM::PARSE-BODY-HEADER + COMMON-LISP::INVOKE-RESTART-INTERACTIVELY SYSTEM::INFO-SUBFILE + COMMON-LISP::PRINC-TO-STRING SYSTEM::INSTREAM-NAME)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::SMALLNTHCDR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::QUICK-SORT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::BIGNTHCDR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) + ANSI-LOOP::LOOP-DO-RETURN SLOOP::PARSE-LOOP-COLLECT + SYSTEM::READ-EVALUATED-FORM SYSTEM::INSPECT-INDENT-1 + SLOOP::PARSE-LOOP-WHEN SYSTEM::TEST-ERROR SLOOP::LOOP-POP + SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::INSPECT-READ-LINE + SYSTEM::GET-SIG-FN-NAME SLOOP::LOOP-PEEK + COMMON-LISP::TYPE-ERROR SYSTEM::SET-UP-TOP-LEVEL + ANSI-LOOP::LOOP-DO-REPEAT ANSI-LOOP::LOOP-GET-PROGN + SYSTEM::GET-TEMP-DIR SLOOP::PARSE-LOOP1 SYSTEM::SHOW-RESTARTS + SYSTEM::KCL-TOP-RESTARTS + COMMON-LISP::LISP-IMPLEMENTATION-VERSION SYSTEM::SET-ENV + SLOOP::PARSE-ONE-WHEN-CLAUSE SYSTEM::GET-INDEX-NODE + ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::INSPECT-INDENT + ANSI-LOOP::LOOP-BIND-BLOCK ANSI-LOOP::LOOP-WHEN-IT-VARIABLE + SYSTEM::INIT-BREAK-POINTS SYSTEM::DEFAULT-INFO-HOTLIST + SYSTEM::ILLEGAL-BOA ANSI-LOOP::LOOP-DO-FINALLY + ANSI-LOOP::LOOP-GET-FORM SYSTEM::CURRENT-DIRECTORY-PATHNAME + ANSI-LOOP::LOOP-ITERATION-DRIVER ANSI-LOOP::LOOP-DO-WITH + SLOOP::PARSE-LOOP-FOR SLOOP::LOOP-UN-POP + ANSI-LOOP::LOOP-CONTEXT SYSTEM::DBL ANSI-LOOP::LOOP-DO-DO + SYSTEM::CLEANUP SYSTEM::DEFAULT-SYSTEM-BANNER + SYSTEM::STEP-READ-LINE SYSTEM::ALL-TRACE-DECLARATIONS + SLOOP::PARSE-LOOP-DO SYSTEM::SET-CURRENT + SYSTEM::DM-TOO-MANY-ARGUMENTS ANSI-LOOP::LOOP-DO-NAMED + ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::SETUP-LINEINFO + SYSTEM::TOP-LEVEL)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + COMMON-LISP::LOGORC2 COMMON-LISP::WITH-PACKAGE-ITERATOR + ANSI-LOOP::LOOP-DO-WHILE SLOOP::THEREIS-SLOOP-COLLECT + SYSTEM::ADD-FILE SLOOP::IN-CAREFULLY-SLOOP-FOR + SLOOP::IN-PACKAGE-SLOOP-MAP SYSTEM::MV-SETQ SYSTEM::IF-ERROR + SYSTEM::WITHOUT-INTERRUPTS SYSTEM::DM-NTH COMMON-LISP::CASE + ANSI-LOOP::LOOP-ACCUMULATE-MINIMAX-VALUE + COMMON-LISP::DEFINE-MODIFY-MACRO SLOOP::COUNT-SLOOP-COLLECT + SYSTEM::GET-MATCH COMMON-LISP::SHIFTF SYSTEM::*BREAK-POINTS* + COMMON-LISP::RETURN COMMON-LISP::LDB + COMMON-LISP::WITH-SIMPLE-RESTART COMMON-LISP::LOGORC1 + COMMON-LISP::MULTIPLE-VALUE-BIND FPE::RF + COMMON-LISP::WITH-STANDARD-IO-SYNTAX + SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::DEFINE-SETF-METHOD + COMMON-LISP::ECASE COMMON-LISP::DOTIMES + SLOOP::DEF-LOOP-COLLECT COMMON-LISP::PROG1 + ANSI-LOOP::LOOP-LOOKUP-KEYWORD SYSTEM::SET-BACK + COMMON-LISP::LDB-TEST SYSTEM::OBJLT SLOOP::NEVER-SLOOP-COLLECT + COMMON-LISP::VECTOR-PUSH SYSTEM::DBL-UP COMMON-LISP::ASSERT + SYSTEM::MSUB ANSI-LOOP::LOOP-BODY SYSTEM::COERCE-TO-STRING + SYSTEM::GET-INFO-CHOICES SLOOP::IN-FRINGE-SLOOP-MAP + COMMON-LISP::PSETF SYSTEM::ALL-MATCHES COMMON-LISP::DO + ANSI-LOOP::MAKE-LOOP-MINIMAX SYSTEM::PARSE-SLOT-DESCRIPTION + SYSTEM::SET-PATH-STREAM-NAME COMMON-LISP::LOOP-FINISH + COMMON-LISP::NTHCDR COMMON-LISP::DO-ALL-SYMBOLS SYSTEM::SGEN + SYSTEM::PUT-AUX COMMON-LISP::CCASE SYSTEM::DM-V + COMMON-LISP::LOCALLY SLOOP::ALWAYS-SLOOP-COLLECT + COMMON-LISP::LAMBDA COMMON-LISP::DEFMACRO + ANSI-LOOP::LOOP-TMEMBER COMMON-LISP::WITH-OPEN-STREAM + SLOOP::MAXIMIZE-SLOOP-COLLECT SLOOP::DESETQ1 + COMMON-LISP::TRACE SYSTEM::CHECK-SEQ-START-END + COMMON-LISP::DEFTYPE SLOOP::MAKE-VALUE COMMON-LISP::TYPECASE + ANSI-LOOP::LOOP-TEQUAL ANSI-LOOP::LOOP-DO-ALWAYS + ANSI-LOOP::WITH-LOOP-LIST-COLLECTION-HEAD SYSTEM::INFO-AUX + COMMON-LISP::WITH-OPEN-FILE COMMON-LISP::PROG2 + COMMON-LISP::DEFSTRUCT SLOOP::DESETQ SYSTEM::QUOTATION-READER + SYSTEM::DM-NTH-CDR SYSTEM::MATCH-DIMENSIONS COMMON-LISP::BYTE + FPE::READ-OPERANDS COMMON-LISP::TIME COMMON-LISP::COND + COMMON-LISP::DO-EXTERNAL-SYMBOLS + COMMON-LISP::WITH-HASH-TABLE-ITERATOR + COMMON-LISP::MULTIPLE-VALUE-SETQ COMMON-LISP::DEFCONSTANT + ANSI-LOOP::LOOP-DECLARE-VARIABLE COMMON-LISP::LOGNOR + ANSI-LOOP::LOOP-COLLECT-ANSWER COMMON-LISP::DEFVAR + SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS + SYSTEM::LOOKUP-KEYWORD SYSTEM::SEQUENCE-CURSOR + SLOOP::LOGXOR-SLOOP-COLLECT FPE::%-READER SLOOP::DEF-LOOP-FOR + COMMON-LISP::PSETQ SLOOP::COLLATE-SLOOP-COLLECT + SLOOP::PARSE-LOOP-MAP COMMON-LISP::NTH SYSTEM::SUBSTRINGP + SYSTEM::GET-NODES SYSTEM::COERCE-TO-PACKAGE + COMMON-LISP::PATHNAME-MATCH-P + ANSI-LOOP::HIDE-VARIABLE-REFERENCES + SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ANSI-LOOP::LOOP-DO-IF + SYSTEM::INSPECT-PRINT SYSTEM::DOT-DIR-P SYSTEM::SETF-HELPER + COMMON-LISP::ROTATEF COMMON-LISP::FILE-STRING-LENGTH + COMMON-LISP::POP COMMON-LISP::DO-SYMBOLS + ANSI-LOOP::LOOP-MAYBE-BIND-FORM + COMMON-LISP::WITH-INPUT-FROM-STRING COMMON-LISP::PROG + SLOOP::=-SLOOP-FOR ANSI-LOOP::LOOP-COLLECT-RPLACD + COMMON-LISP::DOLIST SYSTEM::SET-DIR COMMON-LISP::WHEN + FPE::READ-INSTRUCTION SYSTEM::ITERATE-OVER-BKPTS + COMMON-LISP::OR COMMON-LISP::DEFPACKAGE COMMON-LISP::UNTRACE + COMMON-LISP::ETYPECASE COMMON-LISP::DO* COMMON-LISP::LOGTEST + SYSTEM::IN-INTERVAL-P SYSTEM::LEFT-PARENTHESIS-READER + SLOOP::DEF-LOOP-MACRO SLOOP::SLOOP SLOOP::L-EQUAL + SYSTEM::BREAK-STEP-NEXT COMMON-LISP::COERCE + SYSTEM::GPROF-OUTPUT SLOOP::SUM-SLOOP-COLLECT + COMMON-LISP::REMF ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION + SLOOP::LOCAL-FINISH COMMON-LISP::CHECK-TYPE + ANSI-LOOP::LOOP-COPYLIST* COMMON-LISP::WITH-OUTPUT-TO-STRING + SYSTEM::CONDITION-PASS SLOOP::DEF-LOOP-MAP + COMMON-LISP::DOCUMENTATION COMMON-LISP::DECF + COMMON-LISP::WRITE-BYTE COMMON-LISP::WITH-CONDITION-RESTARTS + SYSTEM::INSPECT-RECURSIVELY COMMON-LISP::PUSH + COMMON-LISP::MULTIPLE-VALUE-LIST + ANSI-LOOP::LOOP-STORE-TABLE-DATA SYSTEM::DISPLAY-ENV + SYSTEM::LIST-DELQ COMPILER::COMPILER-DEF-HOOK + SLOOP::LOOP-RETURN COMMON-LISP::PROG* SYSTEM::TP-ERROR + SYSTEM::LIST-TOGGLE-CASE COMMON-LISP::DECLAIM + SYSTEM::SAFE-EVAL COMMON-LISP::DEFSETF COMMON-LISP::LOGANDC1 + SYSTEM::SUPER-GO COMMON-LISP::LOGNAND SYSTEM::WHILE + SYSTEM::DISPLAY-COMPILED-ENV COMMON-LISP::AND + COMMON-LISP::PUSHNEW SYSTEM::INCREMENT-CURSOR + COMMON-LISP::INCF COMMON-LISP::NTH-VALUE FPE::0-READER + COMMON-LISP::DEFPARAMETER SYSTEM::?PUSH SYSTEM::NODE + FPE::PAREN-READER SLOOP::THE-TYPE COMMON-LISP::UNLESS + ANSI-LOOP::LOOP-TASSOC COMMON-LISP::LOOP + SYSTEM::GET-LINE-OF-FORM SLOOP::IN-TABLE-SLOOP-MAP + COMMON-LISP::RESTART-BIND SYSTEM::CHECK-TYPE-EVAL + COMMON-LISP::LOGANDC2 COMMON-LISP::STEP + SYSTEM::KEYWORD-SUPPLIED-P SLOOP::SLOOP-FINISH SLOOP::LCASE + ANSI-LOOP::WITH-MINIMAX-VALUE COMMON-LISP::DEFUN + COMMON-LISP::CTYPECASE COMMON-LISP::RESTART-CASE + SYSTEM::BREAK-STEP-INTO SLOOP::SLOOP-SWAP + COMMON-LISP::DESTRUCTURING-BIND SYSTEM::SUB-INTERVAL-P + SYSTEM::MV-VALUES COMMON-LISP::WITH-COMPILATION-UNIT + SYSTEM::SETF-EXPAND)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + COMMON-LISP::FCEILING COMMON-LISP::WRITE-TO-STRING + COMMON-LISP::USE-VALUE COMMON-LISP::INVOKE-RESTART + COMMON-LISP::FROUND COMMON-LISP::ENSURE-DIRECTORIES-EXIST + COMMON-LISP::DECODE-UNIVERSAL-TIME SYSTEM::SHOW-INFO + SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE + COMMON-LISP::STORE-VALUE COMMON-LISP::PARSE-NAMESTRING + SYSTEM::BREAK-FUNCTION SYSTEM::INFO COMMON-LISP::APROPOS + COMMON-LISP::APROPOS-LIST + ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE + COMMON-LISP::READ-FROM-STRING COMMON-LISP::FFLOOR + SYSTEM::STEPPER COMMON-LISP::FTRUNCATE + COMMON-LISP::GET-SETF-EXPANSION SYSTEM::APROPOS-DOC + SYSTEM::PRINT-DOC)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER + COMMON-LISP::*) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::FIXNUM) + SYSTEM::ATOI)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::FIXNUM) + SYSTEM::RELATIVE-LINE ANSI-LOOP::DUPLICATABLE-CODE-P + SYSTEM::FASLINK SYSTEM::LENEL SYSTEM::THE-END + SYSTEM::GET-NODE-INDEX)) +(COMMON-LISP::MAPC + (COMMON-LISP::LAMBDA (COMPILER::X) + (COMMON-LISP::SETF + (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) + COMMON-LISP::T)) + '(SYSTEM::CONDITIONP SYSTEM::TRACE-ONE SYSTEM::SI-FIND-CLASS + SYSTEM::SI-CLASS-OF SYSTEM::CONDITION-CLASS-P + FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS + SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::AUTOLOAD + SYSTEM::UNTRACE-ONE SYSTEM::MAKE-ACCESS-FUNCTION + SYSTEM::SI-CLASSP SYSTEM::AUTOLOAD-MACRO SYSTEM::WARNINGP + SYSTEM::SI-CLASS-NAME SYSTEM::SIMPLE-CONDITION-CLASS-P + SYSTEM::RECORD-FN SYSTEM::DEFINE-STRUCTURE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + SLOOP::FIND-IN-ORDERED-LIST COMMON-LISP::STABLE-SORT + COMMON-LISP::SUBTYPEP SYSTEM::PARSE-BODY COMMON-LISP::REDUCE + COMMON-LISP::SORT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::*) + COMMON-LISP::SUBST-IF COMMON-LISP::SUBST-IF-NOT + COMMON-LISP::SUBST SYSTEM::MASET)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + SYSTEM::SHARP---READER SYSTEM::LIST-MERGE-SORT + SYSTEM::RESTART-PRINT ANSI-LOOP::LOOP-GET-COLLECTION-INFO + SYSTEM::VERIFY-KEYWORDS SYSTEM::SHARP-+-READER + SYSTEM::READ-INSPECT-COMMAND SYSTEM::SHARP-S-READER)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) + SYSTEM::TRACE-CALL)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + SYSTEM::PUSH-OPTIONAL-BINDING)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER + COMMON-LISP::*)) + COMMON-LISP::T) + SYSTEM::RESET-SYS-PATHS)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) + (COMMON-LISP::VECTOR COMMON-LISP::T)) + SYSTEM::CONTEXT-VEC)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + COMMON-LISP::MAKE-STRING-INPUT-STREAM SYSTEM::FILE-TO-STRING + SYSTEM::LINK-EXPAND COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE + COMMON-LISP::DELETE-DUPLICATES COMMON-LISP::PATHNAME-HOST + COMMON-LISP::ARRAY-ROW-MAJOR-INDEX SYSTEM::BAD-SEQ-LIMIT + SYSTEM::LOGICAL-PATHNAME-PARSE COMMON-LISP::OPEN + SYSTEM::BREAK-LEVEL COMMON-LISP::DIRECTORY + SLOOP::LOOP-ADD-TEMPS SYSTEM::DIR-PARSE + COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME SYSTEM::MGSUB + COMMON-LISP::MERGE-PATHNAMES SYSTEM::MGLIST + SYSTEM::FILE-SEARCH SYSTEM::PROCESS-SOME-ARGS + COMMON-LISP::ARRAY-IN-BOUNDS-P COMMON-LISP::SBIT + COMMON-LISP::FILE-POSITION COMMON-LISP::PATHNAME-VERSION + COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::PATHNAME-DEVICE + SYSTEM::NLOAD COMMON-LISP::WARN COMMON-LISP::ENOUGH-NAMESTRING + SYSTEM::NTH-STACK-FRAME + ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES COMMON-LISP::BIT + COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::READ-BYTE + COMMON-LISP::BIT-NOT COMMON-LISP::REQUIRE + ANSI-LOOP::LOOP-ERROR ANSI-LOOP::LOOP-WARN + COMMON-LISP::PATHNAME-NAME COMMON-LISP::MAKE-ARRAY + COMMON-LISP::REMOVE-DUPLICATES SYSTEM::INFO-SEARCH + SLOOP::ADD-FROM-DATA SYSTEM::TO-REGEXP COMMON-LISP::LOAD + COMMON-LISP::SIGNAL COMMON-LISP::PATHNAME-TYPE + COMMON-LISP::FIND-RESTART SYSTEM::LIST-MATCHES + COMMON-LISP::CONCATENATE COMMON-LISP::ERROR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + SYSTEM::FIND-DOC COMMON-LISP::RENAME-FILE SYSTEM::DO-REPL + SYSTEM::RESTART-REPORT ANSI-LOOP::ESTIMATE-CODE-SIZE + ANSI-LOOP::LOOP-REALLY-DESETQ ANSI-LOOP::ESTIMATE-CODE-SIZE-1 + SYSTEM::NEW-SEMI-COLON-READER SYSTEM::SOURCE-PORTION + SYSTEM::NEWLINE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) + SYSTEM::BREAK-MESSAGE SYSTEM::GCL-TOP-LEVEL + SYSTEM::SIMPLE-BACKTRACE SYSTEM::BREAK-RESUME + ANSI-LOOP::LOOP-DO-FOR SYSTEM::BREAK-CURRENT + SYSTEM::BREAK-HELP)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::FIXNUM) + SYSTEM::ROUND-UP)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::FIXNUM) + SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) + (COMMON-LISP::OR COMMON-LISP::NULL + COMMON-LISP::HASH-TABLE)) + SYSTEM::CONTEXT-HASH)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) + COMMON-LISP::HASH-TABLE) + SYSTEM::CONTEXT-SPICE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::T) + SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::EXPAND-RANGE SYSTEM::SETF-STRUCTURE-ACCESS + SYSTEM::MME3 SYSTEM::FIND-LINE-IN-FUN SYSTEM::LOAD-PATHNAME + SYSTEM::MINMAX SYSTEM::ELSUB SYSTEM::COERCE-TO-CONDITION + SYSTEM::DO-BREAK-LEVEL ANSI-LOOP::LOOP-FOR-ARITHMETIC + SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::CALL-TEST + SLOOP::FIRST-SLOOP-FOR SYSTEM::MAYBE-BREAK)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::T) + SYSTEM::WALK-DIR SYSTEM::PUSH-LET-BINDING SYSTEM::MME2 + ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH + COMMON-LISP::SUBSTITUTE-IF-NOT + ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH SYSTEM::MATCH-COMPONENT + SYSTEM::COMPLETE-PROP COMMON-LISP::NSUBSTITUTE-IF-NOT + COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE + ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH + SYSTEM::CHECK-TYPE-SYMBOL COMMON-LISP::MAP + COMMON-LISP::TRANSLATE-PATHNAME COMMON-LISP::SUBSTITUTE + ANSI-LOOP::ADD-LOOP-PATH ANSI-LOOP::LOOP-MAKE-VARIABLE + SLOOP::LOOP-DECLARE-BINDING COMMON-LISP::NSUBSTITUTE-IF)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::SHARP-V-READER COMMON-LISP::DEPOSIT-FIELD + ANSI-LOOP::LOOP-FOR-ON SYSTEM::SETF-EXPAND-1 + SYSTEM::SHARP-DQ-READER SYSTEM::CHECK-TRACE-ARGS + SYSTEM::PROG?* SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS + ANSI-LOOP::PRINT-LOOP-UNIVERSE ANSI-LOOP::LOOP-FOR-IN + SYSTEM::CHECK-S-DATA SYSTEM::WARN-VERSION + ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE SYSTEM::DEFMACRO* + ANSI-LOOP::LOOP-SUM-COLLECTION SYSTEM::PATHNAME-PARSE + SYSTEM::GET-SLOT-POS SYSTEM::MAKE-T-TYPE + SYSTEM::SHARP-A-READER + SYSTEM::RESTART-CASE-EXPRESSION-CONDITION SYSTEM::RECURSE-DIR + SYSTEM::SHARP-U-READER SYSTEM::APPLY-DISPLAY-FUN SYSTEM::DM-VL + ANSI-LOOP::HIDE-VARIABLE-REFERENCE SYSTEM::MAKE-BREAK-POINT + SYSTEM::TO-REGEXP-OR-NAMESTRING ANSI-LOOP::LOOP-FOR-BEING + SYSTEM::FLOATING-POINT-ERROR SYSTEM::SHARP-P-READER + ANSI-LOOP::LOOP-TRANSLATE COMMON-LISP::DPB + ANSI-LOOP::LOOP-FOR-ACROSS FPE::REF SYSTEM::WRITE-SYMTAB + ANSI-LOOP::LOOP-STANDARD-EXPANSION + ANSI-LOOP::LOOP-ANSI-FOR-EQUALS)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::DO?* SYSTEM::MAKE-PREDICATE SYSTEM::MAKE-CONSTRUCTOR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + COMMON-LISP::NSET-DIFFERENCE COMMON-LISP::COUNT-IF + COMMON-LISP::FIND-IF-NOT SYSTEM::INTERNAL-COUNT-IF + COMMON-LISP::INTERSECTION COMMON-LISP::REMOVE-IF-NOT + SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::EVERY + COMMON-LISP::POSITION COMMON-LISP::POSITION-IF-NOT + SYSTEM::FIND-IHS SYSTEM::INTERNAL-COUNT COMMON-LISP::BIT-ANDC2 + COMMON-LISP::DELETE-IF-NOT COMMON-LISP::BIT-ANDC1 + COMMON-LISP::UNION COMMON-LISP::NSET-EXCLUSIVE-OR + COMMON-LISP::BIT-XOR SYSTEM::WREADDIR COMMON-LISP::MISMATCH + COMMON-LISP::FIND-IF COMMON-LISP::BIT-ORC1 + COMMON-LISP::MAKE-SEQUENCE COMMON-LISP::REMOVE + COMMON-LISP::COUNT COMMON-LISP::BIT-NOR COMMON-LISP::MAP-INTO + COMMON-LISP::NOTEVERY SLOOP::PARSE-LOOP-MACRO + COMMON-LISP::FIND COMMON-LISP::BIT-AND COMMON-LISP::CERROR + ANSI-LOOP::LOOP-CHECK-DATA-TYPE COMMON-LISP::READ-SEQUENCE + COMMON-LISP::BIT-ORC2 COMMON-LISP::FILL COMMON-LISP::SOME + COMMON-LISP::NUNION SYSTEM::INTERNAL-COUNT-IF-NOT + COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::REPLACE + SLOOP::LOOP-ADD-BINDING COMMON-LISP::NOTANY + COMMON-LISP::SET-EXCLUSIVE-OR COMMON-LISP::ADJUST-ARRAY + COMMON-LISP::SET-DIFFERENCE COMMON-LISP::BIT-NAND + COMMON-LISP::DELETE COMMON-LISP::POSITION-IF + COMMON-LISP::SUBSETP COMMON-LISP::DELETE-IF SYSTEM::BREAK-CALL + COMMON-LISP::REMOVE-IF COMMON-LISP::WRITE-SEQUENCE + COMMON-LISP::BIT-IOR SLOOP::IN-ARRAY-SLOOP-FOR + COMMON-LISP::SEARCH COMMON-LISP::COUNT-IF-NOT + COMMON-LISP::TYPEP COMMON-LISP::NINTERSECTION + COMMON-LISP::BIT-EQV SYSTEM::PROCESS-ERROR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + SYSTEM::PRINT-STACK-FRAME COMMON-LISP::MERGE + SYSTEM::EXPAND-WILD-DIRECTORY SLOOP::DEF-LOOP-INTERNAL + SYSTEM::ELEMENT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::T) + SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::T) + COMMON-LISP::ENCODE-UNIVERSAL-TIME)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::T) + ANSI-LOOP::LOOP-SEQUENCER)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + SYSTEM::UNIVERSAL-ERROR-HANDLER)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) + ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS SYSTEM::CHECK-DECLARATIONS + COMMON-LISP::RESTART-NAME ANSI-LOOP::LOOP-COLLECTOR-P + COMMON-LISP::LOGNOT ANSI-LOOP::LOOP-CONSTANTP + COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::IDESCRIBE + COMMON-LISP::FIRST ANSI-LOOP::LOOP-MAKE-DESETQ + ANSI-LOOP::LOOP-COLLECTOR-DTYPE SYSTEM::S-DATA-CONC-NAME + SYSTEM::VERSION-PARSE SYSTEM::IHS-NOT-INTERPRETED-ENV + SYSTEM::EXPAND-HOME-DIR SYSTEM::LOAD-PATHNAME-EXISTS + ANSI-LOOP::LOOP-UNIVERSE-P SYSTEM::SIMPLE-ARRAY-P + COMMON-LISP::FIFTH SYSTEM::BKPT-FILE-LINE + SYSTEM::TRACE-ONE-PREPROCESS + SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY + COMMON-LISP::PROBE-FILE COMMON-LISP::TRUENAME + COMMON-LISP::CONCATENATED-STREAM-STREAMS + SYSTEM::SHOW-ENVIRONMENT COMMON-LISP::NINTH + SYSTEM::INSPECT-NUMBER SYSTEM::DBL-RPL-LOOP + COMMON-LISP::PROVIDE SYSTEM::SETUP-INFO + SLOOP::AVERAGING-SLOOP-MACRO COMMON-LISP::ACOS SYSTEM::LNP + SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::FIND-KCL-TOP-RESTART + ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::S-DATA-OFFSET + COMMON-LISP::SECOND COMMON-LISP::PHASE SYSTEM::EVAL-FEATURE + ANSI-LOOP::LOOP-PATH-USER-DATA + ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS + ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE SYSTEM::PATCH-SHARP + ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS + COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::DIR-P + SYSTEM::PATH-STREAM-NAME COMMON-LISP::CIS SYSTEM::S-DATA-RAW + SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::RESTART-TEST-FUNCTION + SYSTEM::KNOWN-TYPE-P + ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED + COMMON-LISP::FILE-WRITE-DATE COMMON-LISP::RATIONAL + ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS + SYSTEM::GET-NEXT-VISIBLE-FUN SLOOP::PARSE-LOOP-INITIALLY + SYSTEM::S-DATA-STATICP COMMON-LISP::BYTE-SIZE + COMMON-LISP::VECTOR-POP COMMON-LISP::PATHNAME + SYSTEM::DIRECTORY-LIST-CHECK + COMMON-LISP::BROADCAST-STREAM-STREAMS + COMMON-LISP::SYNONYM-STREAM-SYMBOL SYSTEM::PNL1 + COMMON-LISP::SEVENTH SYSTEM::INFO-GET-TAGS + ANSI-LOOP::LOOP-TYPED-INIT SYSTEM::WALK-THROUGH + SYSTEM::NUMBER-OF-DAYS-FROM-1900 + ANSI-LOOP::LOOP-EMIT-FINAL-VALUE COMMON-LISP::ASINH + SYSTEM::S-DATA-FROZEN SYSTEM::GET-STRING-INPUT-STREAM-INDEX + SYSTEM::INSTREAM-STREAM SLOOP::LOOP-LET-BINDINGS + COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM + ANSI-LOOP::LOOP-COLLECTOR-CLASS COMMON-LISP::DELETE-FILE + SYSTEM::GET-PATH SYSTEM::LEAP-YEAR-P SYSTEM::REGEXP-CONV + COMMON-LISP::SIXTH COMMON-LISP::ATANH SYSTEM::INFO-GET-FILE + SYSTEM::S-DATA-PRINT-FUNCTION + COMMON-LISP::DIRECTORY-NAMESTRING SYSTEM::INSPECT-CHARACTER + SYSTEM::S-DATA-CONSTRUCTORS ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE + SYSTEM::INSPECT-VECTOR ANSI-LOOP::LOOP-MINIMAX-TYPE + SYSTEM::BKPT-FILE SLOOP::REPEAT-SLOOP-MACRO COMMON-LISP::ABS + COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS + COMMON-LISP::SINH COMMON-LISP::TANH SYSTEM::RESTART-FUNCTION + SLOOP::POINTER-FOR-COLLECT + COMMON-LISP::ECHO-STREAM-INPUT-STREAM + SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::CHDIR SYSTEM::MLP + ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE FPE::GREF + COMMON-LISP::BYTE-POSITION SYSTEM::INSTREAM-STREAM-NAME + SYSTEM::BKPT-FUNCTION ANSI-LOOP::DESTRUCTURING-SIZE + SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-EMIT-BODY + SYSTEM::SEARCH-STACK SYSTEM::INSERT-BREAK-POINT + SYSTEM::S-DATA-INCLUDES COMMON-LISP::FOURTH + COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM FPE::ST-LOOKUP + SYSTEM::NODE-OFFSET SYSTEM::S-DATA-TYPE SYSTEM::INSPECT-SYMBOL + SLOOP::TRANSLATE-NAME SYSTEM::S-DATA-NAMED SYSTEM::REAL-ASINH + SYSTEM::TOGGLE-CASE SLOOP::SLOOP-SLOOP-MACRO + ANSI-LOOP::LOOP-DO-THEREIS FPE::LOOKUP SYSTEM::S-DATA-NAME + ANSI-LOOP::LOOP-COLLECTOR-DATA + SYSTEM::BREAK-FORWARD-SEARCH-STACK COMMON-LISP::EIGHTH + ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE + SYSTEM::S-DATA-SLOT-POSITION SYSTEM::INFO-NODE-FROM-POSITION + COMMON-LISP::THIRD SYSTEM::FRS-KIND + SYSTEM::WILD-PATH-ELEMENT-P ANSI-LOOP::LOOP-MAXMIN-COLLECTION + SYSTEM::PRINT-FRS SYSTEM::GET-INSTREAM + SLOOP::SUBSTITUTE-SLOOP-BODY SYSTEM::RESTART-P + COMMON-LISP::FILE-AUTHOR SYSTEM::ADD-TO-HOTLIST + SYSTEM::COMPUTING-ARGS-P COMMON-LISP::FILE-NAMESTRING + SYSTEM::ENSURE-DIR-STRING COMMON-LISP::FIND-ALL-SYMBOLS + SYSTEM::S-DATA-P SYSTEM::BREAK-BACKWARD-SEARCH-STACK + SYSTEM::GET-BYTE-STREAM-NCHARS ANSI-LOOP::LOOP-MAKE-PSETQ + SYSTEM::ALOAD ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA + SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::ASIN + SYSTEM::WILD-DIR-ELEMENT-P SYSTEM::MAKE-FRAME + ANSI-LOOP::LOOP-PSEUDO-BODY SYSTEM::DIR-CONJ SYSTEM::DBL-EVAL + ANSI-LOOP::LOOP-COLLECTOR-NAME SYSTEM::INSPECT-ARRAY + SYSTEM::DM-KEY-NOT-ALLOWED COMMON-LISP::ARRAY-DIMENSIONS + ANSI-LOOP::LOOP-CONSTRUCT-RETURN COMMON-LISP::LOGICAL-PATHNAME + COMMON-LISP::ACOSH ANSI-LOOP::LOOP-PATH-NAMES + ANSI-LOOP::LOOP-PATH-FUNCTION SYSTEM::CHECK-TRACE-SPEC + COMMON-LISP::ISQRT SYSTEM::NODES-FROM-INDEX SYSTEM::PRINT-IHS + SYSTEM::INSPECT-CONS COMMON-LISP::CONSTANTLY + ANSI-LOOP::LOOP-PATH-P SYSTEM::WILD-NAMESTRING-P + SYSTEM::DM-BAD-KEY ANSI-LOOP::LOOP-MINIMAX-P SYSTEM::SEQTYPE + FPE::XMM-LOOKUP SYSTEM::LOGICAL-PATHNAME-HOST-P + COMMON-LISP::INVOKE-DEBUGGER + ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS SYSTEM::INSPECT-STRING + SYSTEM::NEXT-STACK-FRAME ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS + SYSTEM::LOGICAL-PATHNAMEP + ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED + SLOOP::LOOP-COLLECT-KEYWORD-P COMMON-LISP::SIGNUM + SYSTEM::WHICH ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD + SYSTEM::SHORT-NAME SYSTEM::SHOW-BREAK-POINT + SYSTEM::INSPECT-STRUCTURE SYSTEM::S-DATA-INCLUDED + SYSTEM::INSTREAM-P SYSTEM::RE-QUOTE-STRING + SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE + SYSTEM::RESTART-INTERACTIVE-FUNCTION + ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::UNIQUE-ID + SYSTEM::FIX-LOAD-PATH SLOOP::RETURN-SLOOP-MACRO + ANSI-LOOP::LOOP-COLLECTOR-HISTORY SYSTEM::S-DATA-DOCUMENTATION + SYSTEM::TERMINAL-INTERRUPT COMMON-LISP::TENTH + COMMON-LISP::COMPLEMENT SYSTEM::BEST-ARRAY-ELEMENT-TYPE + SYSTEM::IHS-VISIBLE SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P + COMMON-LISP::COSH COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS + SYSTEM::BKPT-FORM SYSTEM::FREEZE-DEFSTRUCT + SYSTEM::INSPECT-PACKAGE ANSI-LOOP::LOOP-UNIVERSE-ANSI + SLOOP::PARSE-NO-BODY ANSI-LOOP::LOOP-MINIMAX-OPERATIONS + ANSI-LOOP::LOOP-LIST-COLLECTION SYSTEM::NC + SYSTEM::FIND-DOCUMENTATION SYSTEM::S-DATA-HAS-HOLES + COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM + COMMON-LISP::NAMESTRING COMMON-LISP::HOST-NAMESTRING + SYSTEM::DWIM SYSTEM::MAKE-KCL-TOP-RESTART SLOOP::PARSE-LOOP + SYSTEM::IHS-FNAME COMMON-LISP::STREAM-EXTERNAL-FORMAT + SYSTEM::RESTART-REPORT-FUNCTION COMMON-LISP::FILE-LENGTH + SYSTEM::PROCESS-ARGS ANSI-LOOP::LOOP-HACK-ITERATION + SYSTEM::CONTEXT-P SYSTEM::RESET-TRACE-DECLARATIONS)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) + SYSTEM::BREAK-LOCAL SYSTEM::BREAK-VS + ANSI-LOOP::LOOP-OPTIONAL-TYPE COMMON-LISP::CONTINUE + SYSTEM::BREAK-QUIT SYSTEM::BREAK-PREVIOUS + SYSTEM::DBL-BACKTRACE SYSTEM::INFO-ERROR + COMMON-LISP::MUFFLE-WARNING SYSTEM::SHOW-BREAK-VARIABLES + SYSTEM::BREAK-BDS SYSTEM::IHS-BACKTRACE SYSTEM::BREAK-NEXT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) + (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) + SYSTEM::MAKE-KEYWORD)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) + SYSTEM::THE-START FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE + SYSTEM::S-DATA-LENGTH SYSTEM::S-DATA-SIZE)) \ No newline at end of file diff --git a/lsp/ucall.lisp b/lsp/ucall.lisp new file mode 100755 index 0000000..8999b4a --- /dev/null +++ b/lsp/ucall.lisp @@ -0,0 +1,143 @@ +(in-package 'compiler) +(import 'si::switch) +(import 'sloop::sloop) +(provide "UCALL") + +;;ucall is like funcall, except it assumes +;;1) its first arg has an inline-always property. +;;2) the order of evaluation of the remaining args is unimportant. + +;;This can be useful when we know that the side effects caused by evaluating +;;the args do not affect the order of evaluation. +;;It also returns an indeterminate value. + +(defun c1ucall (args &aux funob (info (compiler::make-info))) + (setq funob (compiler::c1funob (car args))) + (compiler::add-info info (cadr funob)) + (list 'ucall info funob (compiler::c1args (cdr args) info)) + ) + +(defun c2ucall (funob args &aux (*inline-blocks* 0)(*vs* *vs*)) + (let* ((fname (caddr funob)) + (props (car (get fname 'inline-always))) + new-args + ) + (or props (error "no inline-always prop")) + (do ((v args (cdr v)) + (types (car props) (cdr types))) + ((null v) (setq new-args (nreverse new-args))) + (setq new-args + (append (inline-args (list (car v)) (list (car types))) + new-args))) + (wt-nl) + (wt-inline-loc (nth 4 props) new-args) + (wt ";") + (unwind-exit "Cnil") + (close-inline-blocks) + )) + + +;;Usage (comment "hi there") ; will insert a comment at that point in +;;the program. +(defun c1comment (args) + (list 'comment (make-info) args)) +(defun c2comment (args) + (let ((string (car args))) + (if (find #\/ string) (setq string (remove #\/ string))) + (wt "/* "string " */"))) + +(defmacro comment (a) a nil) + +;;Usage: (tlet (char *) jack ....) +;;--> {char * V1; ...V1.. + +(defun c1tlet (args &aux (info (make-info)) (*vars* *vars*)) + (let ((sym (cadr args)) + (type (car args)) + form ) + (let ((var (c1make-var sym nil nil nil))) + (cond ((subtypep type 'fixnum) + (setf (var-type var) 'fixnum))) + (push var *vars*) + (setq form (c1expr* (cons 'progn (cddr args)) info)) + (list 'tlet (second form) type var form)))) + +(defun c2tlet (type var orig &aux (stype type)) + (setf (var-loc var) (next-cvar)) + (or (stringp type) (setq stype (format nil "~(~a~)" type))) + (setf (var-kind var) + (cond ((subtypep type 'fixnum) + (setf (var-type var) 'fixnum)) + (t 'object))) + (if (listp type) (setq stype (string-trim "()" stype))) + (wt-nl "{" stype " V" (var-loc var) ";" ) + (c2expr orig) + (wt "}")) + +(si::putprop 'tlet 'c1tlet 'c1special) +(si::putprop 'tlet 'c2tlet 'c2) + + +(defun c1clet (args) + (let ((string (car args)) + (form (c1expr (cons 'progn (cdr args))))) + (list 'clet (second form) string form))) + +(defun c2clet (string orig ) + (wt-nl "{" string) + (c2expr orig) + (wt "}")) + +;;Usage: Takes a STRING and BODY. Acts like progn +;;on the body, but the c code will have {string . c code for body} +;;Sample (clet "int jack; char *jane;" ....) +(defmacro clet (string &rest body) string `(progn ,@ body)) + +(si::putprop 'clet 'c1clet 'c1special) +(si::putprop 'clet 'c2clet 'c2) + + +(si::putprop 'comment 'c1comment 'c1special) +(si::putprop 'comment 'c2comment 'c2) + + + + + +(si::putprop 'ucall 'c1ucall 'c1) +(si::putprop 'ucall 'c2ucall 'c2) + + + +(defmacro def-inline (name args return-type &rest bod) + (let* ((side-effect-p (if (member (car bod) + '(:side-effect nil t)) + (prog1 (and (car bod) t) (setq bod (cdr bod))) + nil)) + (inline (list args return-type side-effect-p nil (car bod)))) + `(car (push ',inline + (get ',name 'inline-always))))) + + + + +(defmacro defun-inline (name args return-type &rest bod) + (let* ((sym (gensym)) + (named-args + (nthcdr (- 10 (length args)) '(X9 X8 X7 X6 X5 X4 X3 X2 X1 X0))) + (inline (eval `(def-inline ,sym ,args ,return-type ,@ bod)))) + `(progn + (defun ,name ,named-args + (declare ,@ (sloop for v in named-args for w in args + when (not (eq t v)) + collect (list w v))) + (the ,return-type (,sym ,@ named-args))) + (push ',inline + (get ',name 'inline-always))))) + +(defmacro def-ucall (fun args string) + (let ((sym (gensym))) + `(progn + (def-inline ,sym ,args t t ,string) + (defmacro ,fun (&rest args) `(ucall ',',sym ,@ args))))) + diff --git a/lsp/ustreams.lisp b/lsp/ustreams.lisp new file mode 100755 index 0000000..0703fac --- /dev/null +++ b/lsp/ustreams.lisp @@ -0,0 +1,81 @@ + +;;; +;;; This file contains some macros for user defined streams +;;; +;;; +;;; probably need to add some fields to "define-user-stream-type" +;;; +;;; +;;; we probably need the ability for user-defined streams to declare +;;; whether they are input/output or both +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(in-package 'lisp) + +(export '(make-user-stream define-user-stream-type *user-defined-stream-types*)) + +(defvar *user-defined-stream-types* nil) ;;; list of user defined stream types + +(defun make-user-stream (str-type) + (let (struct) + (unless (member str-type *user-defined-stream-types*) + (error "Make-user-stream: ~a undefined stream type" str-type)) + (setq struct (funcall (get str-type 'lisp::str-conc-name))) + (allocate-stream-object str-type struct))) + +(defmacro define-user-stream-type (str-name + str-data + str-read-char + str-write-char + str-peek-char + str-force-output + str-close + str-type + &optional str-unread-char) + (let ((conc-name (intern (concatenate 'string "KCL-" + (symbol-name str-name))))) + nil + `(progn + (setf (get ',str-name 'str-conc-name) ',conc-name) + (setf (get ',str-name 'stream) t) + (format t "Constructor ") + (setq lisp::*user-defined-stream-types* (cons ',str-name lisp::*user-defined-stream-types*)) + (defstruct (,str-name (:constructor ,conc-name)) + (str-data ,str-data) ;0 + (str-read-char ,str-read-char) ;1 + (str-write-char ,str-write-char) ;2 + (str-peek-char ,str-peek-char) ;3 + (str-force-output ,str-force-output) ;4 + (str-close ,str-close) ;5 + (str-type ,str-type) ;6 + (str-unread-char ,str-unread-char) ;7 + (str-name ',str-name))))) ;8 + + +;;; +;;; allocate a stream-object and patch in the struct which holds +;;; the goodies +;;; +(Clines + +" object allocate_stream_object (stream_type, new_struct) + + object stream_type; + object new_struct; + { + object x; + x = alloc_object(t_stream); + x->sm.sm_mode = smm_user_defined; + x->sm.sm_object1 = new_struct; + x->sm.sm_object0 = stream_type; + x->sm.sm_int0 = 0; + x->sm.sm_fp = 0; + x->sm.sm_int1 = 0; + return x; +}" +) + +(defentry allocate-stream-object (object object) (object allocate_stream_object)) + + + diff --git a/ltmain.sh b/ltmain.sh new file mode 100644 index 0000000..c2383bb --- /dev/null +++ b/ltmain.sh @@ -0,0 +1,5476 @@ +# ltmain.sh - Provide generalized library-building support services. +# NOTE: Changing this file will not affect anything until you rerun ltconfig. +# +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +# Free Software Foundation, Inc. +# Originally by Gordon Matzigkeit , 1996 +# +# 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 of the License, 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, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# Check that we have a working $echo. +if test "X$1" = X--no-reexec; then + # Discard the --no-reexec flag, and continue. + shift +elif test "X$1" = X--fallback-echo; then + # Avoid inline document here, it may be left over + : +elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then + # Yippee, $echo works! + : +else + # Restart under the correct shell, and then maybe $echo will work. + exec $SHELL "$0" --no-reexec ${1+"$@"} +fi + +if test "X$1" = X--fallback-echo; then + # used as fallback echo + shift + cat <&2 + echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 + exit 1 +fi + +if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then + echo "$modename: not configured to build any kind of library" 1>&2 + echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 + exit 1 +fi + +# Global variables. +mode=$default_mode +nonopt= +prev= +prevopt= +run= +show="$echo" +show_help= +execute_dlfiles= +lo2o="s/\\.lo\$/.${objext}/" +o2lo="s/\\.${objext}\$/.lo/" +taglist= + +# Parse our command line options once, thoroughly. +while test $# -gt 0 +do + arg="$1" + shift + + case $arg in + -*=*) optarg=`$echo "X$arg" | $Xsed -e 's/[-_a-zA-Z0-9]*=//'` ;; + *) optarg= ;; + esac + + # If the previous option needs an argument, assign it. + if test -n "$prev"; then + case $prev in + execute_dlfiles) + execute_dlfiles="$execute_dlfiles $arg" + ;; + tag) + tagname="$arg" + + # Check whether tagname contains only valid characters + case $tagname in + *[!-_A-Za-z0-9,/]*) + echo "$progname: invalid tag name: $tagname" 1>&2 + exit 1 + ;; + esac + + case $tagname in + CC) + # Don't test for the "default" C tag, as we know, it's there, but + # not specially marked. + taglist="$taglist $tagname" + ;; + *) + if grep "^### BEGIN LIBTOOL TAG CONFIG: $tagname$" < "$0" > /dev/null; then + taglist="$taglist $tagname" + # Evaluate the configuration. + eval "`sed -n -e '/^### BEGIN LIBTOOL TAG CONFIG: '$tagname'$/,/^### END LIBTOOL TAG CONFIG: '$tagname'$/p' < $0`" + else + echo "$progname: ignoring unknown tag $tagname" 1>&2 + fi + ;; + esac + ;; + *) + eval "$prev=\$arg" + ;; + esac + + prev= + prevopt= + continue + fi + + # Have we seen a non-optional argument yet? + case $arg in + --help) + show_help=yes + ;; + + --version) + echo "$PROGRAM (GNU $PACKAGE) $VERSION$TIMESTAMP" + exit 0 + ;; + + --config) + sed -n -e '/^### BEGIN LIBTOOL CONFIG/,/^### END LIBTOOL CONFIG/p' < "$0" + # Now print the configurations for the tags. + for tagname in $taglist; do + sed -n -e "/^### BEGIN LIBTOOL TAG CONFIG: $tagname$/,/^### END LIBTOOL TAG CONFIG: $tagname$/p" < "$0" + done + exit 0 + ;; + + --debug) + echo "$progname: enabling shell trace mode" + set -x + ;; + + --dry-run | -n) + run=: + ;; + + --features) + echo "host: $host" + if test "$build_libtool_libs" = yes; then + echo "enable shared libraries" + else + echo "disable shared libraries" + fi + if test "$build_old_libs" = yes; then + echo "enable static libraries" + else + echo "disable static libraries" + fi + exit 0 + ;; + + --finish) mode="finish" ;; + + --mode) prevopt="--mode" prev=mode ;; + --mode=*) mode="$optarg" ;; + + --quiet | --silent) + show=: + ;; + + --tag) prevopt="--tag" prev=tag ;; + --tag=*) + set tag "$optarg" ${1+"$@"} + shift + prev=tag + ;; + + -dlopen) + prevopt="-dlopen" + prev=execute_dlfiles + ;; + + -*) + $echo "$modename: unrecognized option \`$arg'" 1>&2 + $echo "$help" 1>&2 + exit 1 + ;; + + *) + nonopt="$arg" + break + ;; + esac +done + +if test -n "$prevopt"; then + $echo "$modename: option \`$prevopt' requires an argument" 1>&2 + $echo "$help" 1>&2 + exit 1 +fi + +# If this variable is set in any of the actions, the command in it +# will be execed at the end. This prevents here-documents from being +# left over by shells. +exec_cmd= + +if test -z "$show_help"; then + + # Infer the operation mode. + if test -z "$mode"; then + case $nonopt in + *cc | *++ | gcc* | *-gcc*) + mode=link + for arg + do + case $arg in + -c) + mode=compile + break + ;; + esac + done + ;; + *db | *dbx | *strace | *truss) + mode=execute + ;; + *install*|cp|mv) + mode=install + ;; + *rm) + mode=uninstall + ;; + *) + # If we have no mode, but dlfiles were specified, then do execute mode. + test -n "$execute_dlfiles" && mode=execute + + # Just use the default operation mode. + if test -z "$mode"; then + if test -n "$nonopt"; then + $echo "$modename: warning: cannot infer operation mode from \`$nonopt'" 1>&2 + else + $echo "$modename: warning: cannot infer operation mode without MODE-ARGS" 1>&2 + fi + fi + ;; + esac + fi + + # Only execute mode is allowed to have -dlopen flags. + if test -n "$execute_dlfiles" && test "$mode" != execute; then + $echo "$modename: unrecognized option \`-dlopen'" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + # Change the help message to a mode-specific one. + generic_help="$help" + help="Try \`$modename --help --mode=$mode' for more information." + + # These modes are in order of execution frequency so that they run quickly. + case $mode in + # libtool compile mode + compile) + modename="$modename: compile" + # Get the compilation command and the source file. + base_compile= + prev= + lastarg= + srcfile="$nonopt" + suppress_output= + + user_target=no + for arg + do + case $prev in + "") ;; + xcompiler) + # Aesthetically quote the previous argument. + prev= + lastarg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` + + case $arg in + # Double-quote args containing other shell metacharacters. + # Many Bourne shells cannot handle close brackets correctly + # in scan sets, so we specify it separately. + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + arg="\"$arg\"" + ;; + esac + + # Add the previous argument to base_compile. + if test -z "$base_compile"; then + base_compile="$lastarg" + else + base_compile="$base_compile $lastarg" + fi + continue + ;; + esac + + # Accept any command-line options. + case $arg in + -o) + if test "$user_target" != "no"; then + $echo "$modename: you cannot specify \`-o' more than once" 1>&2 + exit 1 + fi + user_target=next + ;; + + -static) + build_old_libs=yes + continue + ;; + + -prefer-pic) + pic_mode=yes + continue + ;; + + -prefer-non-pic) + pic_mode=no + continue + ;; + + -Xcompiler) + prev=xcompiler + continue + ;; + + -Wc,*) + args=`$echo "X$arg" | $Xsed -e "s/^-Wc,//"` + lastarg= + IFS="${IFS= }"; save_ifs="$IFS"; IFS=',' + for arg in $args; do + IFS="$save_ifs" + + # Double-quote args containing other shell metacharacters. + # Many Bourne shells cannot handle close brackets correctly + # in scan sets, so we specify it separately. + case $arg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + arg="\"$arg\"" + ;; + esac + lastarg="$lastarg $arg" + done + IFS="$save_ifs" + lastarg=`$echo "X$lastarg" | $Xsed -e "s/^ //"` + + # Add the arguments to base_compile. + if test -z "$base_compile"; then + base_compile="$lastarg" + else + base_compile="$base_compile $lastarg" + fi + continue + ;; + esac + + case $user_target in + next) + # The next one is the -o target name + user_target=yes + continue + ;; + yes) + # We got the output file + user_target=set + libobj="$arg" + continue + ;; + esac + + # Accept the current argument as the source file. + lastarg="$srcfile" + srcfile="$arg" + + # Aesthetically quote the previous argument. + + # Backslashify any backslashes, double quotes, and dollar signs. + # These are the only characters that are still specially + # interpreted inside of double-quoted scrings. + lastarg=`$echo "X$lastarg" | $Xsed -e "$sed_quote_subst"` + + # Double-quote args containing other shell metacharacters. + # Many Bourne shells cannot handle close brackets correctly + # in scan sets, so we specify it separately. + case $lastarg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + lastarg="\"$lastarg\"" + ;; + esac + + # Add the previous argument to base_compile. + if test -z "$base_compile"; then + base_compile="$lastarg" + else + base_compile="$base_compile $lastarg" + fi + done + + case $user_target in + set) + ;; + no) + # Get the name of the library object. + libobj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%'` + ;; + *) + $echo "$modename: you must specify a target with \`-o'" 1>&2 + exit 1 + ;; + esac + + # Recognize several different file suffixes. + # If the user specifies -o file.o, it is replaced with file.lo + xform='[cCFSfmso]' + case $libobj in + *.ada) xform=ada ;; + *.adb) xform=adb ;; + *.ads) xform=ads ;; + *.asm) xform=asm ;; + *.c++) xform=c++ ;; + *.cc) xform=cc ;; + *.class) xform=class ;; + *.cpp) xform=cpp ;; + *.cxx) xform=cxx ;; + *.f90) xform=f90 ;; + *.for) xform=for ;; + *.java) xform=java ;; + esac + + libobj=`$echo "X$libobj" | $Xsed -e "s/\.$xform$/.lo/"` + + case $libobj in + *.lo) obj=`$echo "X$libobj" | $Xsed -e "$lo2o"` ;; + *) + $echo "$modename: cannot determine name of library object from \`$libobj'" 1>&2 + exit 1 + ;; + esac + + # Infer tagged configuration to use if any are available and + # if one wasn't chosen via the "--tag" command line option. + # Only attempt this if the compiler in the base compile + # command doesn't match the default compiler. + if test -n "$available_tags" && test -z "$tagname"; then + case $base_compile in + "$CC "*) ;; + # Blanks in the command may have been stripped by the calling shell, + # but not from the CC environment variable when ltconfig was run. + "`$echo $CC` "*) ;; + *) + for z in $available_tags; do + if grep "^### BEGIN LIBTOOL TAG CONFIG: $z$" < "$0" > /dev/null; then + # Evaluate the configuration. + eval "`sed -n -e '/^### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^### END LIBTOOL TAG CONFIG: '$z'$/p' < $0`" + case $base_compile in + "$CC "*) + # The compiler in the base compile command matches + # the one in the tagged configuration. + # Assume this is the tagged configuration we want. + tagname=$z + break + ;; + "`$echo $CC` "*) + tagname=$z + break + ;; + esac + fi + done + # If $tagname still isn't set, then no tagged configuration + # was found and let the user know that the "--tag" command + # line option must be used. + if test -z "$tagname"; then + echo "$modename: unable to infer tagged configuration" + echo "$modename: specify a tag with \`--tag'" 1>&2 + exit 1 +# else +# echo "$modename: using $tagname tagged configuration" + fi + ;; + esac + fi + + objname=`$echo "X$obj" | $Xsed -e 's%^.*/%%'` + xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'` + if test "X$xdir" = "X$obj"; then + xdir= + else + xdir=$xdir/ + fi + lobj=${xdir}$objdir/$objname + + if test -z "$base_compile"; then + $echo "$modename: you must specify a compilation command" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + # Delete any leftover library objects. + if test "$build_old_libs" = yes; then + removelist="$obj $lobj $libobj ${libobj}T" + else + removelist="$lobj $libobj ${libobj}T" + fi + + $run $rm $removelist + trap "$run $rm $removelist; exit 1" 1 2 15 + + # On Cygwin there's no "real" PIC flag so we must build both object types + case $host_os in + cygwin* | mingw* | pw32* | os2*) + pic_mode=default + ;; + esac + if test $pic_mode = no && test "$deplibs_check_method" != pass_all; then + # non-PIC code in shared libraries is not supported + pic_mode=default + fi + + # Calculate the filename of the output object if compiler does + # not support -o with -c + if test "$compiler_c_o" = no; then + output_obj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%' -e 's%\.[^.]*$%%'`.${objext} + lockfile="$output_obj.lock" + removelist="$removelist $output_obj $lockfile" + trap "$run $rm $removelist; exit 1" 1 2 15 + else + output_obj= + need_locks=no + lockfile= + fi + + # Lock this critical section if it is needed + # We use this script file to make the link, it avoids creating a new file + if test "$need_locks" = yes; then + until $run ln "$0" "$lockfile" 2>/dev/null; do + $show "Waiting for $lockfile to be removed" + sleep 2 + done + elif test "$need_locks" = warn; then + if test -f "$lockfile"; then + echo "\ +*** ERROR, $lockfile exists and contains: +`cat $lockfile 2>/dev/null` + +This indicates that another process is trying to use the same +temporary object file, and libtool could not work around it because +your compiler does not support \`-c' and \`-o' together. If you +repeat this compilation, it may succeed, by chance, but you had better +avoid parallel builds (make -j) in this platform, or get a better +compiler." + + $run $rm $removelist + exit 1 + fi + echo $srcfile > "$lockfile" + fi + + if test -n "$fix_srcfile_path"; then + eval srcfile=\"$fix_srcfile_path\" + fi + + $run $rm "$libobj" "${libobj}T" + + # Create a libtool object file (analogous to a ".la" file), + # but don't create it if we're doing a dry run. + test -z "$run" && cat > ${libobj}T </dev/null`" != x"$srcfile"; then + echo "\ +*** ERROR, $lockfile contains: +`cat $lockfile 2>/dev/null` + +but it should contain: +$srcfile + +This indicates that another process is trying to use the same +temporary object file, and libtool could not work around it because +your compiler does not support \`-c' and \`-o' together. If you +repeat this compilation, it may succeed, by chance, but you had better +avoid parallel builds (make -j) in this platform, or get a better +compiler." + + $run $rm $removelist + exit 1 + fi + + # Just move the object if needed, then go on to compile the next one + if test -n "$output_obj" && test "x$output_obj" != "x$lobj"; then + $show "$mv $output_obj $lobj" + if $run $mv $output_obj $lobj; then : + else + error=$? + $run $rm $removelist + exit $error + fi + fi + + # Append the name of the PIC object to the libtool object file. + test -z "$run" && cat >> ${libobj}T <> ${libobj}T </dev/null`" != x"$srcfile"; then + echo "\ +*** ERROR, $lockfile contains: +`cat $lockfile 2>/dev/null` + +but it should contain: +$srcfile + +This indicates that another process is trying to use the same +temporary object file, and libtool could not work around it because +your compiler does not support \`-c' and \`-o' together. If you +repeat this compilation, it may succeed, by chance, but you had better +avoid parallel builds (make -j) in this platform, or get a better +compiler." + + $run $rm $removelist + exit 1 + fi + + # Just move the object if needed + if test -n "$output_obj" && test "x$output_obj" != "x$obj"; then + $show "$mv $output_obj $obj" + if $run $mv $output_obj $obj; then : + else + error=$? + $run $rm $removelist + exit $error + fi + fi + + # Append the name of the non-PIC object the libtool object file. + # Only append if the libtool object file exists. + test -z "$run" && cat >> ${libobj}T <> ${libobj}T <&2 + fi + if test -n "$link_static_flag"; then + dlopen_self=$dlopen_self_static + fi + else + if test -z "$pic_flag" && test -n "$link_static_flag"; then + dlopen_self=$dlopen_self_static + fi + fi + build_libtool_libs=no + build_old_libs=yes + prefer_static_libs=yes + break + ;; + esac + done + + # See if our shared archives depend on static archives. + test -n "$old_archive_from_new_cmds" && build_old_libs=yes + + # Go through the arguments, transforming them on the way. + while test $# -gt 0; do + arg="$1" + base_compile="$base_compile $arg" + shift + case $arg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + qarg=\"`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`\" ### testsuite: skip nested quoting test + ;; + *) qarg=$arg ;; + esac + libtool_args="$libtool_args $qarg" + + # If the previous option needs an argument, assign it. + if test -n "$prev"; then + case $prev in + output) + compile_command="$compile_command @OUTPUT@" + finalize_command="$finalize_command @OUTPUT@" + ;; + esac + + case $prev in + dlfiles|dlprefiles) + if test "$preload" = no; then + # Add the symbol object into the linking commands. + compile_command="$compile_command @SYMFILE@" + finalize_command="$finalize_command @SYMFILE@" + preload=yes + fi + case $arg in + *.la | *.lo) ;; # We handle these cases below. + force) + if test "$dlself" = no; then + dlself=needless + export_dynamic=yes + fi + prev= + continue + ;; + self) + if test "$prev" = dlprefiles; then + dlself=yes + elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then + dlself=yes + else + dlself=needless + export_dynamic=yes + fi + prev= + continue + ;; + *) + if test "$prev" = dlfiles; then + dlfiles="$dlfiles $arg" + else + dlprefiles="$dlprefiles $arg" + fi + prev= + continue + ;; + esac + ;; + expsyms) + export_symbols="$arg" + if test ! -f "$arg"; then + $echo "$modename: symbol file \`$arg' does not exist" + exit 1 + fi + prev= + continue + ;; + expsyms_regex) + export_symbols_regex="$arg" + prev= + continue + ;; + release) + release="-$arg" + prev= + continue + ;; + objectlist) + if test -f "$arg"; then + save_arg=$arg + moreargs= + for fil in `cat $save_arg` + do +# moreargs="$moreargs $fil" + arg=$fil + # A libtool-controlled object. + + # Check to see that this really is a libtool object. + if (sed -e '2q' $arg | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then + pic_object= + non_pic_object= + + # Read the .lo file + # If there is no directory component, then add one. + case $arg in + */* | *\\*) . $arg ;; + *) . ./$arg ;; + esac + + if test -z "$pic_object" || \ + test -z "$non_pic_object" || + test "$pic_object" = none && \ + test "$non_pic_object" = none; then + $echo "$modename: cannot find name of object for \`$arg'" 1>&2 + exit 1 + fi + + # Extract subdirectory from the argument. + xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` + if test "X$xdir" = "X$arg"; then + xdir= + else + xdir="$xdir/" + fi + + if test "$pic_object" != none; then + # Prepend the subdirectory the object is found in. + pic_object="$xdir$pic_object" + + if test "$prev" = dlfiles; then + if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then + dlfiles="$dlfiles $pic_object" + prev= + continue + else + # If libtool objects are unsupported, then we need to preload. + prev=dlprefiles + fi + fi + + # CHECK ME: I think I busted this. -Ossama + if test "$prev" = dlprefiles; then + # Preload the old-style object. + dlprefiles="$dlprefiles $pic_object" + prev= + fi + + # A PIC object. + libobjs="$libobjs $pic_object" + arg="$pic_object" + fi + + # Non-PIC object. + if test "$non_pic_object" != none; then + # Prepend the subdirectory the object is found in. + non_pic_object="$xdir$non_pic_object" + + # A standard non-PIC object + non_pic_objects="$non_pic_objects $non_pic_object" + if test -z "$pic_object" || test "$pic_object" = none ; then + arg="$non_pic_object" + fi + fi + else + # Only an error if not doing a dry-run. + if test -z "$run"; then + $echo "$modename: \`$arg' is not a valid libtool object" 1>&2 + exit 1 + else + # Dry-run case. + + # Extract subdirectory from the argument. + xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` + if test "X$xdir" = "X$arg"; then + xdir= + else + xdir="$xdir/" + fi + + pic_object=`$echo "X${xdir}${objdir}/${arg}" | $Xsed -e "$lo2o"` + non_pic_object=`$echo "X${xdir}${arg}" | $Xsed -e "$lo2o"` + libobjs="$libobjs $pic_object" + non_pic_objects="$non_pic_objects $non_pic_object" + fi + fi + done + else + $echo "$modename: link input file \`$save_arg' does not exist" + exit 1 + fi + arg=$save_arg + prev= + continue + ;; + rpath | xrpath) + # We need an absolute path. + case $arg in + [\\/]* | [A-Za-z]:[\\/]*) ;; + *) + $echo "$modename: only absolute run-paths are allowed" 1>&2 + exit 1 + ;; + esac + if test "$prev" = rpath; then + case "$rpath " in + *" $arg "*) ;; + *) rpath="$rpath $arg" ;; + esac + else + case "$xrpath " in + *" $arg "*) ;; + *) xrpath="$xrpath $arg" ;; + esac + fi + prev= + continue + ;; + xcompiler) + compiler_flags="$compiler_flags $qarg" + prev= + compile_command="$compile_command $qarg" + finalize_command="$finalize_command $qarg" + continue + ;; + xlinker) + linker_flags="$linker_flags $qarg" + compiler_flags="$compiler_flags $wl$qarg" + prev= + compile_command="$compile_command $wl$qarg" + finalize_command="$finalize_command $wl$qarg" + continue + ;; + *) + eval "$prev=\"\$arg\"" + prev= + continue + ;; + esac + fi # test -n $prev + + prevarg="$arg" + + case $arg in + -all-static) + if test -n "$link_static_flag"; then + compile_command="$compile_command $link_static_flag" + finalize_command="$finalize_command $link_static_flag" + fi + continue + ;; + + -allow-undefined) + # FIXME: remove this flag sometime in the future. + $echo "$modename: \`-allow-undefined' is deprecated because it is the default" 1>&2 + continue + ;; + + -avoid-version) + avoid_version=yes + continue + ;; + + -dlopen) + prev=dlfiles + continue + ;; + + -dlpreopen) + prev=dlprefiles + continue + ;; + + -export-dynamic) + export_dynamic=yes + continue + ;; + + -export-symbols | -export-symbols-regex) + if test -n "$export_symbols" || test -n "$export_symbols_regex"; then + $echo "$modename: more than one -exported-symbols argument is not allowed" + exit 1 + fi + if test "X$arg" = "X-export-symbols"; then + prev=expsyms + else + prev=expsyms_regex + fi + continue + ;; + + # The native IRIX linker understands -LANG:*, -LIST:* and -LNO:* + # so, if we see these flags be careful not to treat them like -L + -L[A-Z][A-Z]*:*) + case $with_gcc/$host in + no/*-*-irix*) + compile_command="$compile_command $arg" + finalize_command="$finalize_command $arg" + ;; + esac + continue + ;; + + -L*) + dir=`$echo "X$arg" | $Xsed -e 's/^-L//'` + # We need an absolute path. + case $dir in + [\\/]* | [A-Za-z]:[\\/]*) ;; + *) + absdir=`cd "$dir" && pwd` + if test -z "$absdir"; then + $echo "$modename: cannot determine absolute directory name of \`$dir'" 1>&2 + exit 1 + fi + dir="$absdir" + ;; + esac + case "$deplibs " in + *" -L$dir "*) ;; + *) + deplibs="$deplibs -L$dir" + lib_search_path="$lib_search_path $dir" + ;; + esac + case $host in + *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*) + case :$dllsearchpath: in + *":$dir:"*) ;; + *) dllsearchpath="$dllsearchpath:$dir";; + esac + ;; + esac + continue + ;; + + -l*) + if test "X$arg" = "X-lc" || test "X$arg" = "X-lm"; then + case $host in + *-*-cygwin* | *-*-pw32* | *-*-beos*) + # These systems don't actually have a C or math library (as such) + continue + ;; + *-*-mingw* | *-*-os2*) + # These systems don't actually have a C library (as such) + test "X$arg" = "X-lc" && continue + ;; + esac + fi + deplibs="$deplibs $arg" + continue + ;; + + -module) + module=yes + continue + ;; + + -no-fast-install) + fast_install=no + continue + ;; + + -no-install) + case $host in + *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*) + # The PATH hackery in wrapper scripts is required on Windows + # in order for the loader to find any dlls it needs. + $echo "$modename: warning: \`-no-install' is ignored for $host" 1>&2 + $echo "$modename: warning: assuming \`-no-fast-install' instead" 1>&2 + fast_install=no + ;; + *) no_install=yes ;; + esac + continue + ;; + + -no-undefined) + allow_undefined=no + continue + ;; + + -objectlist) + prev=objectlist + continue + ;; + + -o) prev=output ;; + + -release) + prev=release + continue + ;; + + -rpath) + prev=rpath + continue + ;; + + -R) + prev=xrpath + continue + ;; + + -R*) + dir=`$echo "X$arg" | $Xsed -e 's/^-R//'` + # We need an absolute path. + case $dir in + [\\/]* | [A-Za-z]:[\\/]*) ;; + *) + $echo "$modename: only absolute run-paths are allowed" 1>&2 + exit 1 + ;; + esac + case "$xrpath " in + *" $dir "*) ;; + *) xrpath="$xrpath $dir" ;; + esac + continue + ;; + + -static) + # The effects of -static are defined in a previous loop. + # We used to do the same as -all-static on platforms that + # didn't have a PIC flag, but the assumption that the effects + # would be equivalent was wrong. It would break on at least + # Digital Unix and AIX. + continue + ;; + + -thread-safe) + thread_safe=yes + continue + ;; + + -version-info) + prev=vinfo + continue + ;; + + -Wc,*) + args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wc,//'` + arg= + IFS="${IFS= }"; save_ifs="$IFS"; IFS=',' + for flag in $args; do + IFS="$save_ifs" + case $flag in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + flag="\"$flag\"" + ;; + esac + arg="$arg $wl$flag" + compiler_flags="$compiler_flags $flag" + done + IFS="$save_ifs" + arg=`$echo "X$arg" | $Xsed -e "s/^ //"` + ;; + + -Wl,*) + args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wl,//'` + arg= + IFS="${IFS= }"; save_ifs="$IFS"; IFS=',' + for flag in $args; do + IFS="$save_ifs" + case $flag in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + flag="\"$flag\"" + ;; + esac + arg="$arg $wl$flag" + compiler_flags="$compiler_flags $wl$flag" + linker_flags="$linker_flags $flag" + done + IFS="$save_ifs" + arg=`$echo "X$arg" | $Xsed -e "s/^ //"` + ;; + + -Xcompiler) + prev=xcompiler + continue + ;; + + -Xlinker) + prev=xlinker + continue + ;; + + # Some other compiler flag. + -* | +*) + # Unknown arguments in both finalize_command and compile_command need + # to be aesthetically quoted because they are evaled later. + arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` + case $arg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + arg="\"$arg\"" + ;; + esac + ;; + + *.$objext) + # A standard object. + objs="$objs $arg" + ;; + + *.lo) + # A libtool-controlled object. + + # Check to see that this really is a libtool object. + if (sed -e '2q' $arg | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then + pic_object= + non_pic_object= + + # Read the .lo file + # If there is no directory component, then add one. + case $arg in + */* | *\\*) . $arg ;; + *) . ./$arg ;; + esac + + if test -z "$pic_object" || \ + test -z "$non_pic_object" || + test "$pic_object" = none && \ + test "$non_pic_object" = none; then + $echo "$modename: cannot find name of object for \`$arg'" 1>&2 + exit 1 + fi + + # Extract subdirectory from the argument. + xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` + if test "X$xdir" = "X$arg"; then + xdir= + else + xdir="$xdir/" + fi + + if test "$pic_object" != none; then + # Prepend the subdirectory the object is found in. + pic_object="$xdir$pic_object" + + if test "$prev" = dlfiles; then + if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then + dlfiles="$dlfiles $pic_object" + prev= + continue + else + # If libtool objects are unsupported, then we need to preload. + prev=dlprefiles + fi + fi + + # CHECK ME: I think I busted this. -Ossama + if test "$prev" = dlprefiles; then + # Preload the old-style object. + dlprefiles="$dlprefiles $pic_object" + prev= + fi + + # A PIC object. + libobjs="$libobjs $pic_object" + arg="$pic_object" + fi + + # Non-PIC object. + if test "$non_pic_object" != none; then + # Prepend the subdirectory the object is found in. + non_pic_object="$xdir$non_pic_object" + + # A standard non-PIC object + non_pic_objects="$non_pic_objects $non_pic_object" + if test -z "$pic_object" || test "$pic_object" = none ; then + arg="$non_pic_object" + fi + fi + else + # Only an error if not doing a dry-run. + if test -z "$run"; then + $echo "$modename: \`$arg' is not a valid libtool object" 1>&2 + exit 1 + else + # Dry-run case. + + # Extract subdirectory from the argument. + xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` + if test "X$xdir" = "X$arg"; then + xdir= + else + xdir="$xdir/" + fi + + pic_object=`$echo "X${xdir}${objdir}/${arg}" | $Xsed -e "$lo2o"` + non_pic_object=`$echo "X${xdir}${arg}" | $Xsed -e "$lo2o"` + libobjs="$libobjs $pic_object" + non_pic_objects="$non_pic_objects $non_pic_object" + fi + fi + ;; + + *.$libext) + # An archive. + deplibs="$deplibs $arg" + old_deplibs="$old_deplibs $arg" + continue + ;; + + *.la) + # A libtool-controlled library. + + if test "$prev" = dlfiles; then + # This library was specified with -dlopen. + dlfiles="$dlfiles $arg" + prev= + elif test "$prev" = dlprefiles; then + # The library was specified with -dlpreopen. + dlprefiles="$dlprefiles $arg" + prev= + else + deplibs="$deplibs $arg" + fi + continue + ;; + + # Some other compiler argument. + *) + # Unknown arguments in both finalize_command and compile_command need + # to be aesthetically quoted because they are evaled later. + arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` + case $arg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") + arg="\"$arg\"" + ;; + esac + ;; + esac # arg + + # Now actually substitute the argument into the commands. + if test -n "$arg"; then + compile_command="$compile_command $arg" + finalize_command="$finalize_command $arg" + fi + done # argument parsing loop + + if test -n "$prev"; then + $echo "$modename: the \`$prevarg' option requires an argument" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + # Infer tagged configuration to use if any are available and + # if one wasn't chosen via the "--tag" command line option. + # Only attempt this if the compiler in the base link + # command doesn't match the default compiler. + if test -n "$available_tags" && test -z "$tagname"; then + case $base_compile in + "$CC "*) ;; + # Blanks in the command may have been stripped by the calling shell, + # but not from the CC environment variable when ltconfig was run. + "`$echo $CC` "*) ;; + *) + for z in $available_tags; do + if grep "^### BEGIN LIBTOOL TAG CONFIG: $z$" < "$0" > /dev/null; then + # Evaluate the configuration. + eval "`sed -n -e '/^### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^### END LIBTOOL TAG CONFIG: '$z'$/p' < $0`" + case $base_compile in + "$CC "*) + # The compiler in $compile_command matches + # the one in the tagged configuration. + # Assume this is the tagged configuration we want. + tagname=$z + break + ;; + "`$echo $CC` "*) + tagname=$z + break + ;; + esac + fi + done + # If $tagname still isn't set, then no tagged configuration + # was found and let the user know that the "--tag" command + # line option must be used. + if test -z "$tagname"; then + echo "$modename: unable to infer tagged configuration" + echo "$modename: specify a tag with \`--tag'" 1>&2 + exit 1 +# else +# echo "$modename: using $tagname tagged configuration" + fi + ;; + esac + fi + + if test "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then + eval arg=\"$export_dynamic_flag_spec\" + compile_command="$compile_command $arg" + finalize_command="$finalize_command $arg" + fi + + # calculate the name of the file, without its directory + outputname=`$echo "X$output" | $Xsed -e 's%^.*/%%'` + libobjs_save="$libobjs" + + if test -n "$shlibpath_var"; then + # get the directories listed in $shlibpath_var + eval shlib_search_path=\`\$echo \"X\${$shlibpath_var}\" \| \$Xsed -e \'s/:/ /g\'\` + else + shlib_search_path= + fi + eval sys_lib_search_path=\"$sys_lib_search_path_spec\" + eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\" + + output_objdir=`$echo "X$output" | $Xsed -e 's%/[^/]*$%%'` + if test "X$output_objdir" = "X$output"; then + output_objdir="$objdir" + else + output_objdir="$output_objdir/$objdir" + fi + # Create the object directory. + if test ! -d $output_objdir; then + $show "$mkdir $output_objdir" + $run $mkdir $output_objdir + status=$? + if test $status -ne 0 && test ! -d $output_objdir; then + exit $status + fi + fi + + # Determine the type of output + case $output in + "") + $echo "$modename: you must specify an output file" 1>&2 + $echo "$help" 1>&2 + exit 1 + ;; + *.$libext) linkmode=oldlib ;; + *.lo | *.$objext) linkmode=obj ;; + *.la) linkmode=lib ;; + *) linkmode=prog ;; # Anything else should be a program. + esac + + specialdeplibs= + libs= + # Find all interdependent deplibs by searching for libraries + # that are linked more than once (e.g. -la -lb -la) + for deplib in $deplibs; do + case "$libs " in + *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; + esac + libs="$libs $deplib" + done + + if test $linkmode = lib; then + libs="$predeps $libs $compiler_lib_search_path $postdeps" + + # Compute libraries that are listed more than once in $predeps + # $postdeps and mark them as special (i.e., whose duplicates are + # not to be eliminated). + pre_post_deps= + for pre_post_dep in $predeps $postdeps; do + case "$pre_post_deps " in + *" $pre_post_dep "*) specialdeplibs="$specialdeplibs $pre_post_deps" ;; + esac + pre_post_deps="$pre_post_deps $pre_post_dep" + done + pre_post_deps= + fi + + deplibs= + newdependency_libs= + newlib_search_path= + need_relink=no # whether we're linking any uninstalled libtool libraries + notinst_deplibs= # not-installed libtool libraries + notinst_path= # paths that contain not-installed libtool libraries + case $linkmode in + lib) + passes="conv link" + for file in $dlfiles $dlprefiles; do + case $file in + *.la) ;; + *) + $echo "$modename: libraries can \`-dlopen' only libtool libraries: $file" 1>&2 + exit 1 + ;; + esac + done + ;; + prog) + compile_deplibs= + finalize_deplibs= + alldeplibs=no + newdlfiles= + newdlprefiles= + passes="conv scan dlopen dlpreopen link" + ;; + *) passes="conv" + ;; + esac + for pass in $passes; do + if test $linkmode = prog; then + # Determine which files to process + case $pass in + dlopen) + libs="$dlfiles" + save_deplibs="$deplibs" # Collect dlpreopened libraries + deplibs= + ;; + dlpreopen) libs="$dlprefiles" ;; + link) libs="$deplibs %DEPLIBS% $dependency_libs" ;; + esac + fi + for deplib in $libs; do + lib= + found=no + case $deplib in + -l*) + if test $linkmode = oldlib && test $linkmode = obj; then + $echo "$modename: warning: \`-l' is ignored for archives/objects: $deplib" 1>&2 + continue + fi + if test $pass = conv; then + deplibs="$deplib $deplibs" + continue + fi + name=`$echo "X$deplib" | $Xsed -e 's/^-l//'` + for searchdir in $newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path; do + # Search the libtool library + lib="$searchdir/lib${name}.la" + if test -f "$lib"; then + found=yes + break + fi + done + if test "$found" != yes; then + # deplib doesn't seem to be a libtool library + if test "$linkmode,$pass" = "prog,link"; then + compile_deplibs="$deplib $compile_deplibs" + finalize_deplibs="$deplib $finalize_deplibs" + else + deplibs="$deplib $deplibs" + test $linkmode = lib && newdependency_libs="$deplib $newdependency_libs" + fi + continue + fi + ;; # -l + -L*) + case $linkmode in + lib) + deplibs="$deplib $deplibs" + test $pass = conv && continue + newdependency_libs="$deplib $newdependency_libs" + newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'` + ;; + prog) + if test $pass = conv; then + deplibs="$deplib $deplibs" + continue + fi + if test $pass = scan; then + deplibs="$deplib $deplibs" + newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'` + else + compile_deplibs="$deplib $compile_deplibs" + finalize_deplibs="$deplib $finalize_deplibs" + fi + ;; + *) + $echo "$modename: warning: \`-L' is ignored for archives/objects: $deplib" 1>&2 + ;; + esac # linkmode + continue + ;; # -L + -R*) + if test $pass = link; then + dir=`$echo "X$deplib" | $Xsed -e 's/^-R//'` + # Make sure the xrpath contains only unique directories. + case "$xrpath " in + *" $dir "*) ;; + *) xrpath="$xrpath $dir" ;; + esac + fi + deplibs="$deplib $deplibs" + continue + ;; + *.la) lib="$deplib" ;; + *.$libext) + if test $pass = conv; then + deplibs="$deplib $deplibs" + continue + fi + case $linkmode in + lib) + if test "$deplibs_check_method" != pass_all; then + echo + echo "*** Warning: This library needs some functionality provided by $deplib." + echo "*** I have the capability to make that library automatically link in when" + echo "*** you link to this library. But I can only do this if you have a" + echo "*** shared version of the library, which you do not appear to have." + else + echo + echo "*** Warning: Linking the shared library $output against the" + echo "*** static library $deplib is not portable!" + deplibs="$deplib $deplibs" + fi + continue + ;; + prog) + if test $pass != link; then + deplibs="$deplib $deplibs" + else + compile_deplibs="$deplib $compile_deplibs" + finalize_deplibs="$deplib $finalize_deplibs" + fi + continue + ;; + esac # linkmode + ;; # *.$libext + *.lo | *.$objext) + if test $pass = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then + # If there is no dlopen support or we're linking statically, + # we need to preload. + newdlprefiles="$newdlprefiles $deplib" + compile_deplibs="$deplib $compile_deplibs" + finalize_deplibs="$deplib $finalize_deplibs" + else + newdlfiles="$newdlfiles $deplib" + fi + continue + ;; + %DEPLIBS%) + alldeplibs=yes + continue + ;; + esac # case $deplib + if test $found = yes || test -f "$lib"; then : + else + $echo "$modename: cannot find the library \`$lib'" 1>&2 + exit 1 + fi + + # Check to see that this really is a libtool archive. + if (sed -e '2q' $lib | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then : + else + $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 + exit 1 + fi + + ladir=`$echo "X$lib" | $Xsed -e 's%/[^/]*$%%'` + test "X$ladir" = "X$lib" && ladir="." + + dlname= + dlopen= + dlpreopen= + libdir= + library_names= + old_library= + # If the library was installed with an old release of libtool, + # it will not redefine variable installed. + installed=yes + + # Read the .la file + case $lib in + */* | *\\*) . $lib ;; + *) . ./$lib ;; + esac + + if test "$linkmode,$pass" = "lib,link" || + test "$linkmode,$pass" = "prog,scan" || + { test $linkmode = oldlib && test $linkmode = obj; }; then + # Add dl[pre]opened files of deplib + test -n "$dlopen" && dlfiles="$dlfiles $dlopen" + test -n "$dlpreopen" && dlprefiles="$dlprefiles $dlpreopen" + fi + + if test $pass = conv; then + # Only check for convenience libraries + deplibs="$lib $deplibs" + if test -z "$libdir"; then + if test -z "$old_library"; then + $echo "$modename: cannot find name of link library for \`$lib'" 1>&2 + exit 1 + fi + # It is a libtool convenience library, so add in its objects. + convenience="$convenience $ladir/$objdir/$old_library" + old_convenience="$old_convenience $ladir/$objdir/$old_library" + tmp_libs= + for deplib in $dependency_libs; do + deplibs="$deplib $deplibs" + case "$tmp_libs " in + *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; + esac + tmp_libs="$tmp_libs $deplib" + done + elif test $linkmode != prog && test $linkmode != lib; then + $echo "$modename: \`$lib' is not a convenience library" 1>&2 + exit 1 + fi + continue + fi # $pass = conv + + # Get the name of the library we link against. + linklib= + for l in $old_library $library_names; do + linklib="$l" + done + if test -z "$linklib"; then + $echo "$modename: cannot find name of link library for \`$lib'" 1>&2 + exit 1 + fi + + # This library was specified with -dlopen. + if test $pass = dlopen; then + if test -z "$libdir"; then + $echo "$modename: cannot -dlopen a convenience library: \`$lib'" 1>&2 + exit 1 + fi + if test -z "$dlname" || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then + # If there is no dlname, no dlopen support or we're linking + # statically, we need to preload. + dlprefiles="$dlprefiles $lib" + else + newdlfiles="$newdlfiles $lib" + fi + continue + fi # $pass = dlopen + + # We need an absolute path. + case $ladir in + [\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;; + *) + abs_ladir=`cd "$ladir" && pwd` + if test -z "$abs_ladir"; then + $echo "$modename: warning: cannot determine absolute directory name of \`$ladir'" 1>&2 + $echo "$modename: passing it literally to the linker, although it might fail" 1>&2 + abs_ladir="$ladir" + fi + ;; + esac + laname=`$echo "X$lib" | $Xsed -e 's%^.*/%%'` + + # Find the relevant object directory and library name. + if test "X$installed" = Xyes; then + if test ! -f "$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then + $echo "$modename: warning: library \`$lib' was moved." 1>&2 + dir="$ladir" + absdir="$abs_ladir" + libdir="$abs_ladir" + else + dir="$libdir" + absdir="$libdir" + fi + else + dir="$ladir/$objdir" + absdir="$abs_ladir/$objdir" + # Remove this search path later + notinst_path="$notinst_path $abs_ladir" + fi # $installed = yes + name=`$echo "X$laname" | $Xsed -e 's/\.la$//' -e 's/^lib//'` + + # This library was specified with -dlpreopen. + if test $pass = dlpreopen; then + if test -z "$libdir"; then + $echo "$modename: cannot -dlpreopen a convenience library: \`$lib'" 1>&2 + exit 1 + fi + # Prefer using a static library (so that no silly _DYNAMIC symbols + # are required to link). + if test -n "$old_library"; then + newdlprefiles="$newdlprefiles $dir/$old_library" + # Otherwise, use the dlname, so that lt_dlopen finds it. + elif test -n "$dlname"; then + newdlprefiles="$newdlprefiles $dir/$dlname" + else + newdlprefiles="$newdlprefiles $dir/$linklib" + fi + fi # $pass = dlpreopen + + if test -z "$libdir"; then + # Link the convenience library + if test $linkmode = lib; then + deplibs="$dir/$old_library $deplibs" + elif test "$linkmode,$pass" = "prog,link"; then + compile_deplibs="$dir/$old_library $compile_deplibs" + finalize_deplibs="$dir/$old_library $finalize_deplibs" + else + deplibs="$lib $deplibs" + fi + continue + fi + + if test $linkmode = prog && test $pass != link; then + newlib_search_path="$newlib_search_path $ladir" + deplibs="$lib $deplibs" + + linkalldeplibs=no + if test "$link_all_deplibs" != no || test -z "$library_names" || + test "$build_libtool_libs" = no; then + linkalldeplibs=yes + fi + + tmp_libs= + for deplib in $dependency_libs; do + case $deplib in + -L*) newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`;; ### testsuite: skip nested quoting test + esac + # Need to link against all dependency_libs? + if test $linkalldeplibs = yes; then + deplibs="$deplib $deplibs" + else + # Need to hardcode shared library paths + # or/and link against static libraries + newdependency_libs="$deplib $newdependency_libs" + fi + case "$tmp_libs " in + *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; + esac + tmp_libs="$tmp_libs $deplib" + done # for deplib + continue + fi # $linkmode = prog... + + link_static=no # Whether the deplib will be linked statically + if test -n "$library_names" && + { test "$prefer_static_libs" = no || test -z "$old_library"; }; then + # Link against this shared library + + if test "$linkmode,$pass" = "prog,link" || + { test $linkmode = lib && test $hardcode_into_libs = yes; }; then + # Hardcode the library path. + # Skip directories that are in the system default run-time + # search path. + case " $sys_lib_dlsearch_path " in + *" $absdir "*) ;; + *) + case "$compile_rpath " in + *" $absdir "*) ;; + *) compile_rpath="$compile_rpath $absdir" + esac + ;; + esac + case " $sys_lib_dlsearch_path " in + *" $libdir "*) ;; + *) + case "$finalize_rpath " in + *" $libdir "*) ;; + *) finalize_rpath="$finalize_rpath $libdir" + esac + ;; + esac + if test $linkmode = prog; then + # We need to hardcode the library path + if test -n "$shlibpath_var"; then + # Make sure the rpath contains only unique directories. + case "$temp_rpath " in + *" $dir "*) ;; + *" $absdir "*) ;; + *) temp_rpath="$temp_rpath $dir" ;; + esac + fi + fi + fi # $linkmode,$pass = prog,link... + + if test "$alldeplibs" = yes && + { test "$deplibs_check_method" = pass_all || + { test "$build_libtool_libs" = yes && + test -n "$library_names"; }; }; then + # We only need to search for static libraries + continue + fi + + if test "$installed" = no; then + notinst_deplibs="$notinst_deplibs $lib" + need_relink=yes + fi + + if test -n "$old_archive_from_expsyms_cmds"; then + # figure out the soname + set dummy $library_names + realname="$2" + shift; shift + libname=`eval \\$echo \"$libname_spec\"` + # use dlname if we got it. it's perfectly good, no? + if test -n "$dlname"; then + soname="$dlname" + elif test -n "$soname_spec"; then + # bleh windows + case $host in + *cygwin*) + major=`expr $current - $age` + versuffix="-$major" + ;; + esac + eval soname=\"$soname_spec\" + else + soname="$realname" + fi + + # Make a new name for the extract_expsyms_cmds to use + soroot="$soname" + soname=`echo $soroot | sed -e 's/^.*\///'` + newlib="libimp-`echo $soname | sed 's/^lib//;s/\.dll$//'`.a" + + # If the library has no export list, then create one now + if test -f "$output_objdir/$soname-def"; then : + else + $show "extracting exported symbol list from \`$soname'" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + eval cmds=\"$extract_expsyms_cmds\" + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + fi + + # Create $newlib + if test -f "$output_objdir/$newlib"; then :; else + $show "generating import library for \`$soname'" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + eval cmds=\"$old_archive_from_expsyms_cmds\" + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + fi + # make sure the library variables are pointing to the new library + dir=$output_objdir + linklib=$newlib + fi # test -n $old_archive_from_expsyms_cmds + + if test $linkmode = prog || test "$mode" != relink; then + add_shlibpath= + add_dir= + add= + lib_linked=yes + case $hardcode_action in + immediate | unsupported) + if test "$hardcode_direct" = no; then + add="$dir/$linklib" + elif test "$hardcode_minus_L" = no; then + case $host in + *-*-sunos*) add_shlibpath="$dir" ;; + esac + add_dir="-L$dir" + add="-l$name" + elif test "$hardcode_shlibpath_var" = no; then + add_shlibpath="$dir" + add="-l$name" + else + lib_linked=no + fi + ;; + relink) + if test "$hardcode_direct" = yes; then + add="$dir/$linklib" + elif test "$hardcode_minus_L" = yes; then + add_dir="-L$dir" + add="-l$name" + elif test "$hardcode_shlibpath_var" = yes; then + add_shlibpath="$dir" + add="-l$name" + else + lib_linked=no + fi + ;; + *) lib_linked=no ;; + esac + + if test "$lib_linked" != yes; then + $echo "$modename: configuration error: unsupported hardcode properties" + exit 1 + fi + + if test -n "$add_shlibpath"; then + case :$compile_shlibpath: in + *":$add_shlibpath:"*) ;; + *) compile_shlibpath="$compile_shlibpath$add_shlibpath:" ;; + esac + fi + if test $linkmode = prog; then + test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs" + test -n "$add" && compile_deplibs="$add $compile_deplibs" + else + test -n "$add_dir" && deplibs="$add_dir $deplibs" + test -n "$add" && deplibs="$add $deplibs" + if test "$hardcode_direct" != yes && \ + test "$hardcode_minus_L" != yes && \ + test "$hardcode_shlibpath_var" = yes; then + case :$finalize_shlibpath: in + *":$libdir:"*) ;; + *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;; + esac + fi + fi + fi + + if test $linkmode = prog || test "$mode" = relink; then + add_shlibpath= + add_dir= + add= + # Finalize command for both is simple: just hardcode it. + if test "$hardcode_direct" = yes; then + add="$libdir/$linklib" + elif test "$hardcode_minus_L" = yes; then + add_dir="-L$libdir" + add="-l$name" + elif test "$hardcode_shlibpath_var" = yes; then + case :$finalize_shlibpath: in + *":$libdir:"*) ;; + *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;; + esac + add="-l$name" + else + # We cannot seem to hardcode it, guess we'll fake it. + add_dir="-L$libdir" + add="-l$name" + fi + + if test $linkmode = prog; then + test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs" + test -n "$add" && finalize_deplibs="$add $finalize_deplibs" + else + test -n "$add_dir" && deplibs="$add_dir $deplibs" + test -n "$add" && deplibs="$add $deplibs" + fi + fi + elif test $linkmode = prog; then + if test "$alldeplibs" = yes && + { test "$deplibs_check_method" = pass_all || + { test "$build_libtool_libs" = yes && + test -n "$library_names"; }; }; then + # We only need to search for static libraries + continue + fi + + # Try to link the static library + # Here we assume that one of hardcode_direct or hardcode_minus_L + # is not unsupported. This is valid on all known static and + # shared platforms. + if test "$hardcode_direct" != unsupported; then + test -n "$old_library" && linklib="$old_library" + compile_deplibs="$dir/$linklib $compile_deplibs" + finalize_deplibs="$dir/$linklib $finalize_deplibs" + else + compile_deplibs="-l$name -L$dir $compile_deplibs" + finalize_deplibs="-l$name -L$dir $finalize_deplibs" + fi + elif test "$build_libtool_libs" = yes; then + # Not a shared library + if test "$deplibs_check_method" != pass_all; then + # We're trying link a shared library against a static one + # but the system doesn't support it. + + # Just print a warning and add the library to dependency_libs so + # that the program can be linked against the static library. + echo + echo "*** Warning: This library needs some functionality provided by $lib." + echo "*** I have the capability to make that library automatically link in when" + echo "*** you link to this library. But I can only do this if you have a" + echo "*** shared version of the library, which you do not appear to have." + if test "$module" = yes; then + echo "*** Therefore, libtool will create a static module, that should work " + echo "*** as long as the dlopening application is linked with the -dlopen flag." + if test -z "$global_symbol_pipe"; then + echo + echo "*** However, this would only work if libtool was able to extract symbol" + echo "*** lists from a program, using \`nm' or equivalent, but libtool could" + echo "*** not find such a program. So, this module is probably useless." + echo "*** \`nm' from GNU binutils and a full rebuild may help." + fi + if test "$build_old_libs" = no; then + build_libtool_libs=module + build_old_libs=yes + else + build_libtool_libs=no + fi + fi + else + convenience="$convenience $dir/$old_library" + old_convenience="$old_convenience $dir/$old_library" + deplibs="$dir/$old_library $deplibs" + link_static=yes + fi + fi # link shared/static library? + + if test $linkmode = lib; then + if test -n "$dependency_libs" && + { test $hardcode_into_libs != yes || test $build_old_libs = yes || + test $link_static = yes; }; then + # Extract -R from dependency_libs + temp_deplibs= + for libdir in $dependency_libs; do + case $libdir in + -R*) temp_xrpath=`$echo "X$libdir" | $Xsed -e 's/^-R//'` + case " $xrpath " in + *" $temp_xrpath "*) ;; + *) xrpath="$xrpath $temp_xrpath";; + esac;; + *) temp_deplibs="$temp_deplibs $libdir";; + esac + done + dependency_libs="$temp_deplibs" + fi + + newlib_search_path="$newlib_search_path $absdir" + # Link against this library + test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs" + # ... and its dependency_libs + tmp_libs= + for deplib in $dependency_libs; do + newdependency_libs="$deplib $newdependency_libs" + case "$tmp_libs " in + *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; + esac + tmp_libs="$tmp_libs $deplib" + done + + if test $link_all_deplibs != no; then + # Add the search paths of all dependency libraries + for deplib in $dependency_libs; do + case $deplib in + -L*) path="$deplib" ;; + *.la) + dir=`$echo "X$deplib" | $Xsed -e 's%/[^/]*$%%'` + test "X$dir" = "X$deplib" && dir="." + # We need an absolute path. + case $dir in + [\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;; + *) + absdir=`cd "$dir" && pwd` + if test -z "$absdir"; then + $echo "$modename: warning: cannot determine absolute directory name of \`$dir'" 1>&2 + absdir="$dir" + fi + ;; + esac + if grep "^installed=no" $deplib > /dev/null; then + path="-L$absdir/$objdir" + else + eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib` + if test -z "$libdir"; then + $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2 + exit 1 + fi + if test "$absdir" != "$libdir"; then + $echo "$modename: warning: \`$deplib' seems to be moved" 1>&2 + fi + path="-L$absdir" + fi + ;; + *) continue ;; + esac + case " $deplibs " in + *" $path "*) ;; + *) deplibs="$path $deplibs" ;; + esac + done + fi # link_all_deplibs != no + fi # linkmode = lib + done # for deplib in $libs + if test $pass = dlpreopen; then + # Link the dlpreopened libraries before other libraries + for deplib in $save_deplibs; do + deplibs="$deplib $deplibs" + done + fi + if test $pass != dlopen; then + test $pass != scan && dependency_libs="$newdependency_libs" + if test $pass != conv; then + # Make sure lib_search_path contains only unique directories. + lib_search_path= + for dir in $newlib_search_path; do + case "$lib_search_path " in + *" $dir "*) ;; + *) lib_search_path="$lib_search_path $dir" ;; + esac + done + newlib_search_path= + fi + + if test "$linkmode,$pass" != "prog,link"; then + vars="deplibs" + else + vars="compile_deplibs finalize_deplibs" + fi + for var in $vars dependency_libs; do + # Add libraries to $var in reverse order + eval tmp_libs=\"\$$var\" + new_libs= + for deplib in $tmp_libs; do + case $deplib in + -L*) new_libs="$deplib $new_libs" ;; + *) + case " $specialdeplibs " in + *" $deplib "*) new_libs="$deplib $new_libs" ;; + *) + case " $new_libs " in + *" $deplib "*) ;; + *) new_libs="$deplib $new_libs" ;; + esac + ;; + esac + ;; + esac + done + tmp_libs= + for deplib in $new_libs; do + case $deplib in + -L*) + case " $tmp_libs " in + *" $deplib "*) ;; + *) tmp_libs="$tmp_libs $deplib" ;; + esac + ;; + *) tmp_libs="$tmp_libs $deplib" ;; + esac + done + eval $var=\"$tmp_libs\" + done # for var + fi + if test "$pass" = "conv" && + { test "$linkmode" = "lib" || test "$linkmode" = "prog"; }; then + libs="$deplibs" # reset libs + deplibs= + fi + done # for pass + if test $linkmode = prog; then + dlfiles="$newdlfiles" + dlprefiles="$newdlprefiles" + fi + + case $linkmode in + oldlib) + if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then + $echo "$modename: warning: \`-dlopen' is ignored for archives" 1>&2 + fi + + if test -n "$rpath"; then + $echo "$modename: warning: \`-rpath' is ignored for archives" 1>&2 + fi + + if test -n "$xrpath"; then + $echo "$modename: warning: \`-R' is ignored for archives" 1>&2 + fi + + if test -n "$vinfo"; then + $echo "$modename: warning: \`-version-info' is ignored for archives" 1>&2 + fi + + if test -n "$release"; then + $echo "$modename: warning: \`-release' is ignored for archives" 1>&2 + fi + + if test -n "$export_symbols" || test -n "$export_symbols_regex"; then + $echo "$modename: warning: \`-export-symbols' is ignored for archives" 1>&2 + fi + + # Now set the variables for building old libraries. + build_libtool_libs=no + oldlibs="$output" + objs="$objs$old_deplibs" + ;; + + lib) + # Make sure we only generate libraries of the form `libNAME.la'. + case $outputname in + lib*) + name=`$echo "X$outputname" | $Xsed -e 's/\.la$//' -e 's/^lib//'` + eval libname=\"$libname_spec\" + ;; + *) + if test "$module" = no; then + $echo "$modename: libtool library \`$output' must begin with \`lib'" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + if test "$need_lib_prefix" != no; then + # Add the "lib" prefix for modules if required + name=`$echo "X$outputname" | $Xsed -e 's/\.la$//'` + eval libname=\"$libname_spec\" + else + libname=`$echo "X$outputname" | $Xsed -e 's/\.la$//'` + fi + ;; + esac + + if test -n "$objs"; then + if test "$deplibs_check_method" != pass_all; then + $echo "$modename: cannot build libtool library \`$output' from non-libtool objects on this host:$objs" 2>&1 + exit 1 + else + echo + echo "*** Warning: Linking the shared library $output against the non-libtool" + echo "*** objects $objs is not portable!" + libobjs="$libobjs $objs" + fi + fi + + if test "$dlself" != no; then + $echo "$modename: warning: \`-dlopen self' is ignored for libtool libraries" 1>&2 + fi + + set dummy $rpath + if test $# -gt 2; then + $echo "$modename: warning: ignoring multiple \`-rpath's for a libtool library" 1>&2 + fi + install_libdir="$2" + + oldlibs= + if test -z "$rpath"; then + if test "$build_libtool_libs" = yes; then + # Building a libtool convenience library. + # Some compilers have problems with a `.al' extension so + # convenience libraries should have the same extension an + # archive normally would. + oldlibs="$output_objdir/$libname.$libext $oldlibs" + build_libtool_libs=convenience + build_old_libs=yes + fi + + if test -n "$vinfo"; then + $echo "$modename: warning: \`-version-info' is ignored for convenience libraries" 1>&2 + fi + + if test -n "$release"; then + $echo "$modename: warning: \`-release' is ignored for convenience libraries" 1>&2 + fi + else + + # Parse the version information argument. + IFS="${IFS= }"; save_ifs="$IFS"; IFS=':' + set dummy $vinfo 0 0 0 + IFS="$save_ifs" + + if test -n "$8"; then + $echo "$modename: too many parameters to \`-version-info'" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + current="$2" + revision="$3" + age="$4" + + # Check that each of the things are valid numbers. + case $current in + 0 | [1-9] | [1-9][0-9] | [1-9][0-9][0-9]) ;; + *) + $echo "$modename: CURRENT \`$current' is not a nonnegative integer" 1>&2 + $echo "$modename: \`$vinfo' is not valid version information" 1>&2 + exit 1 + ;; + esac + + case $revision in + 0 | [1-9] | [1-9][0-9] | [1-9][0-9][0-9]) ;; + *) + $echo "$modename: REVISION \`$revision' is not a nonnegative integer" 1>&2 + $echo "$modename: \`$vinfo' is not valid version information" 1>&2 + exit 1 + ;; + esac + + case $age in + 0 | [1-9] | [1-9][0-9] | [1-9][0-9][0-9]) ;; + *) + $echo "$modename: AGE \`$age' is not a nonnegative integer" 1>&2 + $echo "$modename: \`$vinfo' is not valid version information" 1>&2 + exit 1 + ;; + esac + + if test $age -gt $current; then + $echo "$modename: AGE \`$age' is greater than the current interface number \`$current'" 1>&2 + $echo "$modename: \`$vinfo' is not valid version information" 1>&2 + exit 1 + fi + + # Calculate the version variables. + major= + versuffix= + verstring= + case $version_type in + none) ;; + + darwin) + # Like Linux, but with the current version available in + # verstring for coding it into the library header + major=.`expr $current - $age` + versuffix="$major.$age.$revision" + # Darwin ld doesn't like 0 for these options... + minor_current=`expr $current + 1` + verstring="-compatibility_version $minor_current -current_version $minor_current.$revision" + ;; + + freebsd-aout) + major=".$current" + versuffix=".$current.$revision"; + ;; + + freebsd-elf) + major=".$current" + versuffix=".$current"; + ;; + + irix) + major=`expr $current - $age + 1` + verstring="sgi$major.$revision" + + # Add in all the interfaces that we are compatible with. + loop=$revision + while test $loop != 0; do + iface=`expr $revision - $loop` + loop=`expr $loop - 1` + verstring="sgi$major.$iface:$verstring" + done + + # Before this point, $major must not contain `.'. + major=.$major + versuffix="$major.$revision" + ;; + + linux) + major=.`expr $current - $age` + versuffix="$major.$age.$revision" + ;; + + osf) + major=`expr $current - $age` + versuffix=".$current.$age.$revision" + verstring="$current.$age.$revision" + + # Add in all the interfaces that we are compatible with. + loop=$age + while test $loop != 0; do + iface=`expr $current - $loop` + loop=`expr $loop - 1` + verstring="$verstring:${iface}.0" + done + + # Make executables depend on our current version. + verstring="$verstring:${current}.0" + ;; + + sunos) + major=".$current" + versuffix=".$current.$revision" + ;; + + windows) + # Use '-' rather than '.', since we only want one + # extension on DOS 8.3 filesystems. + major=`expr $current - $age` + versuffix="-$major" + ;; + + *) + $echo "$modename: unknown library version type \`$version_type'" 1>&2 + echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 + exit 1 + ;; + esac + + # Clear the version info if we defaulted, and they specified a release. + if test -z "$vinfo" && test -n "$release"; then + major= + verstring="0.0" + if test "$need_version" = no; then + versuffix= + else + versuffix=".0.0" + fi + fi + + # Remove version info from name if versioning should be avoided + if test "$avoid_version" = yes && test "$need_version" = no; then + major= + versuffix= + verstring="" + fi + + # Check to see if the archive will have undefined symbols. + if test "$allow_undefined" = yes; then + if test "$allow_undefined_flag" = unsupported; then + $echo "$modename: warning: undefined symbols not allowed in $host shared libraries" 1>&2 + build_libtool_libs=no + build_old_libs=yes + fi + else + # Don't allow undefined symbols. + allow_undefined_flag="$no_undefined_flag" + fi + fi + + if test "$mode" != relink; then + # Remove our outputs, but don't remove object files since they + # may have been created when compiling PIC objects. + removelist= + tempremovelist=`echo "$output_objdir/*"` + for p in $tempremovelist; do + case $p in + *.$objext) + ;; + $output_objdir/$outputname | $output_objdir/$libname.* | $output_objdir/${libname}${release}.*) + removelist="$removelist $p" + ;; + *) ;; + esac + done + if test -n "$removelist"; then + $show "${rm}r $removelist" + $run ${rm}r $removelist + fi + fi + + # Now set the variables for building old libraries. + if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then + oldlibs="$oldlibs $output_objdir/$libname.$libext" + + # Transform .lo files to .o files. + oldobjs="$objs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e "$lo2o" | $NL2SP` + fi + + # Eliminate all temporary directories. + for path in $notinst_path; do + lib_search_path=`echo "$lib_search_path " | sed -e 's% $path % %g'` + deplibs=`echo "$deplibs " | sed -e 's% -L$path % %g'` + dependency_libs=`echo "$dependency_libs " | sed -e 's% -L$path % %g'` + done + + if test -n "$xrpath"; then + # If the user specified any rpath flags, then add them. + temp_xrpath= + for libdir in $xrpath; do + temp_xrpath="$temp_xrpath -R$libdir" + case "$finalize_rpath " in + *" $libdir "*) ;; + *) finalize_rpath="$finalize_rpath $libdir" ;; + esac + done + if test $hardcode_into_libs != yes || test $build_old_libs = yes; then + dependency_libs="$temp_xrpath $dependency_libs" + fi + fi + + # Make sure dlfiles contains only unique files that won't be dlpreopened + old_dlfiles="$dlfiles" + dlfiles= + for lib in $old_dlfiles; do + case " $dlprefiles $dlfiles " in + *" $lib "*) ;; + *) dlfiles="$dlfiles $lib" ;; + esac + done + + # Make sure dlprefiles contains only unique files + old_dlprefiles="$dlprefiles" + dlprefiles= + for lib in $old_dlprefiles; do + case "$dlprefiles " in + *" $lib "*) ;; + *) dlprefiles="$dlprefiles $lib" ;; + esac + done + + if test "$build_libtool_libs" = yes; then + if test -n "$rpath"; then + case $host in + *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos*) + # these systems don't actually have a c library (as such)! + ;; + *-*-rhapsody* | *-*-darwin1.[012]) + # Rhapsody C library is in the System framework + deplibs="$deplibs -framework System" + ;; + *-*-netbsd*) + # Don't link with libc until the a.out ld.so is fixed. + ;; + *) + # Add libc to deplibs on all other systems if necessary. + if test $build_libtool_need_lc = "yes"; then + deplibs="$deplibs -lc" + fi + ;; + esac + fi + + # Transform deplibs into only deplibs that can be linked in shared. + name_save=$name + libname_save=$libname + release_save=$release + versuffix_save=$versuffix + major_save=$major + # I'm not sure if I'm treating the release correctly. I think + # release should show up in the -l (ie -lgmp5) so we don't want to + # add it in twice. Is that correct? + release="" + versuffix="" + major="" + newdeplibs= + droppeddeps=no + case $deplibs_check_method in + pass_all) + # Don't check for shared/static. Everything works. + # This might be a little naive. We might want to check + # whether the library exists or not. But this is on + # osf3 & osf4 and I'm not really sure... Just + # implementing what was already the behaviour. + newdeplibs=$deplibs + ;; + test_compile) + # This code stresses the "libraries are programs" paradigm to its + # limits. Maybe even breaks it. We compile a program, linking it + # against the deplibs as a proxy for the library. Then we can check + # whether they linked in statically or dynamically with ldd. + $rm conftest.c + cat > conftest.c </dev/null` + for potent_lib in $potential_libs; do + # Follow soft links. + if ls -lLd "$potent_lib" 2>/dev/null \ + | grep " -> " >/dev/null; then + continue + fi + # The statement above tries to avoid entering an + # endless loop below, in case of cyclic links. + # We might still enter an endless loop, since a link + # loop can be closed while we follow links, + # but so what? + potlib="$potent_lib" + while test -h "$potlib" 2>/dev/null; do + potliblink=`ls -ld $potlib | sed 's/.* -> //'` + case $potliblink in + [\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";; + *) potlib=`$echo "X$potlib" | $Xsed -e 's,[^/]*$,,'`"$potliblink";; + esac + done + # It is ok to link against an archive when + # building a shared library. + if $AR -t $potlib > /dev/null 2>&1; then + newdeplibs="$newdeplibs $a_deplib" + a_deplib="" + break 2 + fi + if eval $file_magic_cmd \"\$potlib\" 2>/dev/null \ + | sed 10q \ + | egrep "$file_magic_regex" > /dev/null; then + newdeplibs="$newdeplibs $a_deplib" + a_deplib="" + break 2 + fi + done + done + if test -n "$a_deplib" ; then + droppeddeps=yes + echo + echo "*** Warning: This library needs some functionality provided by $a_deplib." + echo "*** I have the capability to make that library automatically link in when" + echo "*** you link to this library. But I can only do this if you have a" + echo "*** shared version of the library, which you do not appear to have." + fi + else + # Add a -L argument. + newdeplibs="$newdeplibs $a_deplib" + fi + done # Gone through all deplibs. + ;; + match_pattern*) + set dummy $deplibs_check_method + match_pattern_regex=`expr "$deplibs_check_method" : "$2 \(.*\)"` + for a_deplib in $deplibs; do + name="`expr $a_deplib : '-l\(.*\)'`" + # If $name is empty we are operating on a -L argument. + if test -n "$name" && test "$name" != "0"; then + libname=`eval \\$echo \"$libname_spec\"` + for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do + potential_libs=`ls $i/$libname[.-]* 2>/dev/null` + for potent_lib in $potential_libs; do + if eval echo \"$potent_lib\" 2>/dev/null \ + | sed 10q \ + | egrep "$match_pattern_regex" > /dev/null; then + newdeplibs="$newdeplibs $a_deplib" + a_deplib="" + break 2 + fi + done + done + if test -n "$a_deplib" ; then + droppeddeps=yes + echo + echo "*** Warning: This library needs some functionality provided by $a_deplib." + echo "*** I have the capability to make that library automatically link in when" + echo "*** you link to this library. But I can only do this if you have a" + echo "*** shared version of the library, which you do not appear to have." + fi + else + # Add a -L argument. + newdeplibs="$newdeplibs $a_deplib" + fi + done # Gone through all deplibs. + ;; + none | unknown | *) + newdeplibs="" + if $echo "X $deplibs" | $Xsed -e 's/ -lc$//' \ + -e 's/ -[LR][^ ]*//g' -e 's/[ ]//g' | + grep . >/dev/null; then + echo + if test "X$deplibs_check_method" = "Xnone"; then + echo "*** Warning: inter-library dependencies are not supported in this platform." + else + echo "*** Warning: inter-library dependencies are not known to be supported." + fi + echo "*** All declared inter-library dependencies are being dropped." + droppeddeps=yes + fi + ;; + esac + versuffix=$versuffix_save + major=$major_save + release=$release_save + libname=$libname_save + name=$name_save + + case $host in + *-*-rhapsody* | *-*-darwin1.[012]) + # On Rhapsody replace the C library is the System framework + newdeplibs=`$echo "X $newdeplibs" | $Xsed -e 's/ -lc / -framework System /'` + ;; + esac + + if test "$droppeddeps" = yes; then + if test "$module" = yes; then + echo + echo "*** Warning: libtool could not satisfy all declared inter-library" + echo "*** dependencies of module $libname. Therefore, libtool will create" + echo "*** a static module, that should work as long as the dlopening" + echo "*** application is linked with the -dlopen flag." + if test -z "$global_symbol_pipe"; then + echo + echo "*** However, this would only work if libtool was able to extract symbol" + echo "*** lists from a program, using \`nm' or equivalent, but libtool could" + echo "*** not find such a program. So, this module is probably useless." + echo "*** \`nm' from GNU binutils and a full rebuild may help." + fi + if test "$build_old_libs" = no; then + oldlibs="$output_objdir/$libname.$libext" + build_libtool_libs=module + build_old_libs=yes + else + build_libtool_libs=no + fi + else + echo "*** The inter-library dependencies that have been dropped here will be" + echo "*** automatically added whenever a program is linked with this library" + echo "*** or is declared to -dlopen it." + + if test $allow_undefined = no; then + echo + echo "*** Since this library must not contain undefined symbols," + echo "*** because either the platform does not support them or" + echo "*** it was explicitly requested with -no-undefined," + echo "*** libtool will only create a static version of it." + if test "$build_old_libs" = no; then + oldlibs="$output_objdir/$libname.$libext" + build_libtool_libs=module + build_old_libs=yes + else + build_libtool_libs=no + fi + fi + fi + fi + # Done checking deplibs! + deplibs=$newdeplibs + fi + + # All the library-specific variables (install_libdir is set above). + library_names= + old_library= + dlname= + + # Test again, we may have decided not to build it any more + if test "$build_libtool_libs" = yes; then + if test $hardcode_into_libs = yes; then + # Hardcode the library paths + hardcode_libdirs= + dep_rpath= + rpath="$finalize_rpath" + test "$mode" != relink && rpath="$compile_rpath$rpath" + for libdir in $rpath; do + if test -n "$hardcode_libdir_flag_spec"; then + if test -n "$hardcode_libdir_separator"; then + if test -z "$hardcode_libdirs"; then + hardcode_libdirs="$libdir" + else + # Just accumulate the unique libdirs. + case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in + *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) + ;; + *) + hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" + ;; + esac + fi + else + eval flag=\"$hardcode_libdir_flag_spec\" + dep_rpath="$dep_rpath $flag" + fi + elif test -n "$runpath_var"; then + case "$perm_rpath " in + *" $libdir "*) ;; + *) perm_rpath="$perm_rpath $libdir" ;; + esac + fi + done + # Substitute the hardcoded libdirs into the rpath. + if test -n "$hardcode_libdir_separator" && + test -n "$hardcode_libdirs"; then + libdir="$hardcode_libdirs" + eval dep_rpath=\"$hardcode_libdir_flag_spec\" + fi + if test -n "$runpath_var" && test -n "$perm_rpath"; then + # We should set the runpath_var. + rpath= + for dir in $perm_rpath; do + rpath="$rpath$dir:" + done + eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var" + fi + test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs" + fi + + shlibpath="$finalize_shlibpath" + test "$mode" != relink && shlibpath="$compile_shlibpath$shlibpath" + if test -n "$shlibpath"; then + eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var" + fi + + # Get the real and link names of the library. + eval library_names=\"$library_names_spec\" + set dummy $library_names + realname="$2" + shift; shift + + if test -n "$soname_spec"; then + eval soname=\"$soname_spec\" + else + soname="$realname" + fi + test -z "$dlname" && dlname=$soname + + lib="$output_objdir/$realname" + for link + do + linknames="$linknames $link" + done + +# # Ensure that we have .o objects for linkers which dislike .lo +# # (e.g. aix) in case we are running --disable-static +# for obj in $libobjs; do +# xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'` +# if test "X$xdir" = "X$obj"; then +# xdir="." +# else +# xdir="$xdir" +# fi +# baseobj=`$echo "X$obj" | $Xsed -e 's%^.*/%%'` +# oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"` +# if test ! -f $xdir/$oldobj && test "$baseobj" != "$oldobj"; then +# $show "(cd $xdir && ${LN_S} $baseobj $oldobj)" +# $run eval '(cd $xdir && ${LN_S} $baseobj $oldobj)' || exit $? +# fi +# done + + # Use standard objects if they are pic + test -z "$pic_flag" && libobjs=`$echo "X$libobjs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP` + + # Prepare the list of exported symbols + if test -z "$export_symbols"; then + if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then + $show "generating symbol list for \`$libname.la'" + export_symbols="$output_objdir/$libname.exp" + $run $rm $export_symbols + eval cmds=\"$export_symbols_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + if test -n "$export_symbols_regex"; then + $show "egrep -e \"$export_symbols_regex\" \"$export_symbols\" > \"${export_symbols}T\"" + $run eval 'egrep -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"' + $show "$mv \"${export_symbols}T\" \"$export_symbols\"" + $run eval '$mv "${export_symbols}T" "$export_symbols"' + fi + fi + fi + + if test -n "$export_symbols" && test -n "$include_expsyms"; then + $run eval '$echo "X$include_expsyms" | $SP2NL >> "$export_symbols"' + fi + + if test -n "$convenience"; then + if test -n "$whole_archive_flag_spec"; then + save_libobjs=$libobjs + eval libobjs=\"\$libobjs $whole_archive_flag_spec\" + else + gentop="$output_objdir/${outputname}x" + $show "${rm}r $gentop" + $run ${rm}r "$gentop" + $show "$mkdir $gentop" + $run $mkdir "$gentop" + status=$? + if test $status -ne 0 && test ! -d "$gentop"; then + exit $status + fi + generated="$generated $gentop" + + for xlib in $convenience; do + # Extract the objects. + case $xlib in + [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;; + *) xabs=`pwd`"/$xlib" ;; + esac + xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'` + xdir="$gentop/$xlib" + + $show "${rm}r $xdir" + $run ${rm}r "$xdir" + $show "$mkdir $xdir" + $run $mkdir "$xdir" + status=$? + if test $status -ne 0 && test ! -d "$xdir"; then + exit $status + fi + $show "(cd $xdir && $AR x $xabs)" + $run eval "(cd \$xdir && $AR x \$xabs)" || exit $? + + libobjs="$libobjs "`find $xdir -name \*.$objext -print -o -name \*.lo -print | $NL2SP` + done + fi + fi + + if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then + eval flag=\"$thread_safe_flag_spec\" + linker_flags="$linker_flags $flag" + fi + + # Make a backup of the uninstalled library when relinking + if test "$mode" = relink; then + $run eval '(cd $output_objdir && $rm ${realname}U && $mv $realname ${realname}U)' || exit $? + fi + + # Do each of the archive commands. + if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then + eval cmds=\"$archive_expsym_cmds\" + else + eval cmds=\"$archive_cmds\" + fi + if len=`expr "X$cmds" : ".*"` && + test $len -le $max_cmd_len; then + : + else + # The command line is too long to link in one step, link piecewise. + $echo "creating reloadable object files..." + + # Save the value of $output and $libobjs because we want to + # use them later. If we have whole_archive_flag_spec, we + # want to use save_libobjs as it was before + # whole_archive_flag_spec was expanded, because we can't + # assume the linker understands whole_archive_flag_spec. + # This may have to be revisited, in case too many + # convenience libraries get linked in and end up exceeding + # the spec. + if test -z "$convenience" || test -z "$whole_archive_flag_spec"; then + save_libobjs=$libobjs + fi + save_output=$output + + # Clear the reloadable object creation command queue and + # initialize k to one. + test_cmds= + concat_cmds= + objlist= + delfiles= + last_robj= + k=1 + output=$output_objdir/$save_output-${k}.$objext + # Loop over the list of objects to be linked. + for obj in $save_libobjs + do + eval test_cmds=\"$reload_cmds $objlist $last_robj\" + if test "X$objlist" = X || + { len=`expr "X$test_cmds" : ".*"` && + test $len -le $max_cmd_len; }; then + objlist="$objlist $obj" + else + # The command $test_cmds is almost too long, add a + # command to the queue. + if test $k -eq 1 ; then + # The first file doesn't have a previous command to add. + eval concat_cmds=\"$reload_cmds $objlist $last_robj\" + else + # All subsequent reloadable object files will link in + # the last one created. + eval concat_cmds=\"\$concat_cmds~$reload_cmds $objlist $last_robj\" + fi + last_robj=$output_objdir/$save_output-${k}.$objext + k=`expr $k + 1` + output=$output_objdir/$save_output-${k}.$objext + objlist=$obj + len=1 + fi + done + # Handle the remaining objects by creating one last + # reloadable object file. All subsequent reloadable object + # files will link in the last one created. + test -z "$concat_cmds" || concat_cmds=$concat_cmds~ + eval concat_cmds=\"\${concat_cmds}$reload_cmds $objlist $last_robj\" + + # Set up a command to remove the reloadale object files + # after they are used. + i=0 + while test $i -lt $k + do + i=`expr $i + 1` + delfiles="$delfiles $output_objdir/$save_output-${i}.$objext" + done + + $echo "creating a temporary reloadable object file: $output" + + # Loop through the commands generated above and execute them. + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $concat_cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + + libobjs=$output + # Restore the value of output. + output=$save_output + + if test -n "$convenience" && test -n "$whole_archive_flag_spec"; then + eval libobjs=\"\$libobjs $whole_archive_flag_spec\" + fi + # Expand the library linking commands again to reset the + # value of $libobjs for piecewise linking. + + # Do each of the archive commands. + if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then + eval cmds=\"$archive_expsym_cmds\" + else + eval cmds=\"$archive_cmds\" + fi + + # Append the command to remove the reloadable object files + # to the just-reset $cmds. + eval cmds=\"\$cmds~$rm $delfiles\" + fi + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + + # Restore the uninstalled library and exit + if test "$mode" = relink; then + $run eval '(cd $output_objdir && $rm ${realname}T && $mv $realname ${realname}T && $mv "$realname"U $realname)' || exit $? + exit 0 + fi + + # Create links to the real library. + for linkname in $linknames; do + if test "$realname" != "$linkname"; then + $show "(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)" + $run eval '(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)' || exit $? + fi + done + + # If -module or -export-dynamic was specified, set the dlname. + if test "$module" = yes || test "$export_dynamic" = yes; then + # On all known operating systems, these are identical. + dlname="$soname" + fi + fi + ;; + + obj) + if test -n "$deplibs"; then + $echo "$modename: warning: \`-l' and \`-L' are ignored for objects" 1>&2 + fi + + if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then + $echo "$modename: warning: \`-dlopen' is ignored for objects" 1>&2 + fi + + if test -n "$rpath"; then + $echo "$modename: warning: \`-rpath' is ignored for objects" 1>&2 + fi + + if test -n "$xrpath"; then + $echo "$modename: warning: \`-R' is ignored for objects" 1>&2 + fi + + if test -n "$vinfo"; then + $echo "$modename: warning: \`-version-info' is ignored for objects" 1>&2 + fi + + if test -n "$release"; then + $echo "$modename: warning: \`-release' is ignored for objects" 1>&2 + fi + + case $output in + *.lo) + if test -n "$objs$old_deplibs"; then + $echo "$modename: cannot build library object \`$output' from non-libtool objects" 1>&2 + exit 1 + fi + libobj="$output" + obj=`$echo "X$output" | $Xsed -e "$lo2o"` + ;; + *) + libobj= + obj="$output" + ;; + esac + + # Delete the old objects. + $run $rm $obj $libobj + + # Objects from convenience libraries. This assumes + # single-version convenience libraries. Whenever we create + # different ones for PIC/non-PIC, this we'll have to duplicate + # the extraction. + reload_conv_objs= + gentop= + # reload_cmds runs $LD directly, so let us get rid of + # -Wl from whole_archive_flag_spec + wl= + + if test -n "$convenience"; then + if test -n "$whole_archive_flag_spec"; then + eval reload_conv_objs=\"\$reload_objs $whole_archive_flag_spec\" + else + gentop="$output_objdir/${obj}x" + $show "${rm}r $gentop" + $run ${rm}r "$gentop" + $show "$mkdir $gentop" + $run $mkdir "$gentop" + status=$? + if test $status -ne 0 && test ! -d "$gentop"; then + exit $status + fi + generated="$generated $gentop" + + for xlib in $convenience; do + # Extract the objects. + case $xlib in + [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;; + *) xabs=`pwd`"/$xlib" ;; + esac + xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'` + xdir="$gentop/$xlib" + + $show "${rm}r $xdir" + $run ${rm}r "$xdir" + $show "$mkdir $xdir" + $run $mkdir "$xdir" + status=$? + if test $status -ne 0 && test ! -d "$xdir"; then + exit $status + fi + $show "(cd $xdir && $AR x $xabs)" + $run eval "(cd \$xdir && $AR x \$xabs)" || exit $? + + reload_conv_objs="$reload_objs "`find $xdir -name \*.$objext -print -o -name \*.lo -print | $NL2SP` + done + fi + fi + + # Create the old-style object. + reload_objs="$objs$old_deplibs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}$'/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test + + output="$obj" + eval cmds=\"$reload_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + + # Exit if we aren't doing a library object file. + if test -z "$libobj"; then + if test -n "$gentop"; then + $show "${rm}r $gentop" + $run ${rm}r $gentop + fi + + exit 0 + fi + + if test "$build_libtool_libs" != yes; then + if test -n "$gentop"; then + $show "${rm}r $gentop" + $run ${rm}r $gentop + fi + + # Create an invalid libtool object if no PIC, so that we don't + # accidentally link it into a program. + # $show "echo timestamp > $libobj" + # $run eval "echo timestamp > $libobj" || exit $? + exit 0 + fi + + if test -n "$pic_flag" || test "$pic_mode" != default; then + # Only do commands if we really have different PIC objects. + reload_objs="$libobjs $reload_conv_objs" + output="$libobj" + eval cmds=\"$reload_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" +# else +# # Just create a symlink. +# $show $rm $libobj +# $run $rm $libobj +# xdir=`$echo "X$libobj" | $Xsed -e 's%/[^/]*$%%'` +# if test "X$xdir" = "X$libobj"; then +# xdir="." +# else +# xdir="$xdir" +# fi +# baseobj=`$echo "X$libobj" | $Xsed -e 's%^.*/%%'` +# oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"` +# $show "(cd $xdir && $LN_S $oldobj $baseobj)" +# $run eval '(cd $xdir && $LN_S $oldobj $baseobj)' || exit $? + fi + + if test -n "$gentop"; then + $show "${rm}r $gentop" + $run ${rm}r $gentop + fi + + exit 0 + ;; + + prog) + case $host in + *cygwin*) output=`echo $output | sed -e 's,.exe$,,;s,$,.exe,'` ;; + esac + if test -n "$vinfo"; then + $echo "$modename: warning: \`-version-info' is ignored for programs" 1>&2 + fi + + if test -n "$release"; then + $echo "$modename: warning: \`-release' is ignored for programs" 1>&2 + fi + + if test "$preload" = yes; then + if test "$dlopen_support" = unknown && test "$dlopen_self" = unknown && + test "$dlopen_self_static" = unknown; then + $echo "$modename: warning: \`AC_LIBTOOL_DLOPEN' not used. Assuming no dlopen support." + fi + fi + + case $host in + *-*-rhapsody* | *-*-darwin1.[012]) + # On Rhapsody replace the C library is the System framework + compile_deplibs=`$echo "X $compile_deplibs" | $Xsed -e 's/ -lc / -framework System /'` + finalize_deplibs=`$echo "X $finalize_deplibs" | $Xsed -e 's/ -lc / -framework System /'` + ;; + esac + + compile_command="$compile_command $compile_deplibs" + finalize_command="$finalize_command $finalize_deplibs" + + if test -n "$rpath$xrpath"; then + # If the user specified any rpath flags, then add them. + for libdir in $rpath $xrpath; do + # This is the magic to use -rpath. + case "$finalize_rpath " in + *" $libdir "*) ;; + *) finalize_rpath="$finalize_rpath $libdir" ;; + esac + done + fi + + # Now hardcode the library paths + rpath= + hardcode_libdirs= + for libdir in $compile_rpath $finalize_rpath; do + if test -n "$hardcode_libdir_flag_spec"; then + if test -n "$hardcode_libdir_separator"; then + if test -z "$hardcode_libdirs"; then + hardcode_libdirs="$libdir" + else + # Just accumulate the unique libdirs. + case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in + *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) + ;; + *) + hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" + ;; + esac + fi + else + eval flag=\"$hardcode_libdir_flag_spec\" + rpath="$rpath $flag" + fi + elif test -n "$runpath_var"; then + case "$perm_rpath " in + *" $libdir "*) ;; + *) perm_rpath="$perm_rpath $libdir" ;; + esac + fi + case $host in + *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*) + case :$dllsearchpath: in + *":$libdir:"*) ;; + *) dllsearchpath="$dllsearchpath:$libdir";; + esac + ;; + esac + done + # Substitute the hardcoded libdirs into the rpath. + if test -n "$hardcode_libdir_separator" && + test -n "$hardcode_libdirs"; then + libdir="$hardcode_libdirs" + eval rpath=\" $hardcode_libdir_flag_spec\" + fi + compile_rpath="$rpath" + + rpath= + hardcode_libdirs= + for libdir in $finalize_rpath; do + if test -n "$hardcode_libdir_flag_spec"; then + if test -n "$hardcode_libdir_separator"; then + if test -z "$hardcode_libdirs"; then + hardcode_libdirs="$libdir" + else + # Just accumulate the unique libdirs. + case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in + *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) + ;; + *) + hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" + ;; + esac + fi + else + eval flag=\"$hardcode_libdir_flag_spec\" + rpath="$rpath $flag" + fi + elif test -n "$runpath_var"; then + case "$finalize_perm_rpath " in + *" $libdir "*) ;; + *) finalize_perm_rpath="$finalize_perm_rpath $libdir" ;; + esac + fi + done + # Substitute the hardcoded libdirs into the rpath. + if test -n "$hardcode_libdir_separator" && + test -n "$hardcode_libdirs"; then + libdir="$hardcode_libdirs" + eval rpath=\" $hardcode_libdir_flag_spec\" + fi + finalize_rpath="$rpath" + + dlsyms= + if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then + if test -n "$NM" && test -n "$global_symbol_pipe"; then + dlsyms="${outputname}S.c" + else + $echo "$modename: not configured to extract global symbols from dlpreopened files" 1>&2 + fi + fi + + if test -n "$dlsyms"; then + case $dlsyms in + "") ;; + *.c) + # Discover the nlist of each of the dlfiles. + nlist="$output_objdir/${outputname}.nm" + + $show "$rm $nlist ${nlist}S ${nlist}T" + $run $rm "$nlist" "${nlist}S" "${nlist}T" + + # Parse the name list into a source file. + $show "creating $output_objdir/$dlsyms" + + test -z "$run" && $echo > "$output_objdir/$dlsyms" "\ +/* $dlsyms - symbol resolution table for \`$outputname' dlsym emulation. */ +/* Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP */ + +#ifdef __cplusplus +extern \"C\" { +#endif + +/* Prevent the only kind of declaration conflicts we can make. */ +#define lt_preloaded_symbols some_other_symbol + +/* External symbol declarations for the compiler. */\ +" + + if test "$dlself" = yes; then + $show "generating symbol list for \`$output'" + + test -z "$run" && $echo ': @PROGRAM@ ' > "$nlist" + + # Add our own program objects to the symbol list. + progfiles="$objs$old_deplibs" + for arg in $progfiles; do + $show "extracting global C symbols from \`$arg'" + $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'" + done + + if test -n "$exclude_expsyms"; then + $run eval 'egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T' + $run eval '$mv "$nlist"T "$nlist"' + fi + + if test -n "$export_symbols_regex"; then + $run eval 'egrep -e "$export_symbols_regex" "$nlist" > "$nlist"T' + $run eval '$mv "$nlist"T "$nlist"' + fi + + # Prepare the list of exported symbols + if test -z "$export_symbols"; then + export_symbols="$output_objdir/$output.exp" + $run $rm $export_symbols + $run eval "sed -n -e '/^: @PROGRAM@$/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"' + else + $run eval "sed -e 's/\([][.*^$]\)/\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$output.exp"' + $run eval 'grep -f "$output_objdir/$output.exp" < "$nlist" > "$nlist"T' + $run eval 'mv "$nlist"T "$nlist"' + fi + fi + + for arg in $dlprefiles; do + $show "extracting global C symbols from \`$arg'" + name=`echo "$arg" | sed -e 's%^.*/%%'` + $run eval 'echo ": $name " >> "$nlist"' + $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'" + done + + if test -z "$run"; then + # Make sure we have at least an empty file. + test -f "$nlist" || : > "$nlist" + + if test -n "$exclude_expsyms"; then + egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T + $mv "$nlist"T "$nlist" + fi + + # Try sorting and uniquifying the output. + if grep -v "^: " < "$nlist" | sort +2 | uniq > "$nlist"S; then + : + else + grep -v "^: " < "$nlist" > "$nlist"S + fi + + if test -f "$nlist"S; then + eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$dlsyms"' + else + echo '/* NONE */' >> "$output_objdir/$dlsyms" + fi + + $echo >> "$output_objdir/$dlsyms" "\ + +#undef lt_preloaded_symbols + +#if defined (__STDC__) && __STDC__ +# define lt_ptr_t void * +#else +# define lt_ptr_t char * +# define const +#endif + +/* The mapping between symbol names and symbols. */ +const struct { + const char *name; + lt_ptr_t address; +} +lt_preloaded_symbols[] = +{\ +" + + sed -n -e 's/^: \([^ ]*\) $/ {\"\1\", (lt_ptr_t) 0},/p' \ + -e 's/^. \([^ ]*\) \([^ ]*\)$/ {"\2", (lt_ptr_t) \&\2},/p' \ + < "$nlist" >> "$output_objdir/$dlsyms" + + $echo >> "$output_objdir/$dlsyms" "\ + {0, (lt_ptr_t) 0} +}; + +/* This works around a problem in FreeBSD linker */ +#ifdef FREEBSD_WORKAROUND +static const void *lt_preloaded_setup() { + return lt_preloaded_symbols; +} +#endif + +#ifdef __cplusplus +} +#endif\ +" + fi + + pic_flag_for_symtable= + case $host in + # compiling the symbol table file with pic_flag works around + # a FreeBSD bug that causes programs to crash when -lm is + # linked before any other PIC object. But we must not use + # pic_flag when linking with -static. The problem exists in + # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1. + *-*-freebsd2*|*-*-freebsd3.0*|*-*-freebsdelf3.0*) + case "$compile_command " in + *" -static "*) ;; + *) pic_flag_for_symtable=" $pic_flag -DFREEBSD_WORKAROUND";; + esac;; + *-*-hpux*) + case "$compile_command " in + *" -static "*) ;; + *) pic_flag_for_symtable=" $pic_flag";; + esac + esac + + # Now compile the dynamic symbol file. + $show "(cd $output_objdir && $LTCC -c$no_builtin_flag$pic_flag_for_symtable \"$dlsyms\")" + $run eval '(cd $output_objdir && $LTCC -c$no_builtin_flag$pic_flag_for_symtable "$dlsyms")' || exit $? + + # Clean up the generated files. + $show "$rm $output_objdir/$dlsyms $nlist ${nlist}S ${nlist}T" + $run $rm "$output_objdir/$dlsyms" "$nlist" "${nlist}S" "${nlist}T" + + # Transform the symbol file into the correct name. + compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"` + finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"` + ;; + *) + $echo "$modename: unknown suffix for \`$dlsyms'" 1>&2 + exit 1 + ;; + esac + else + # We keep going just in case the user didn't refer to + # lt_preloaded_symbols. The linker will fail if global_symbol_pipe + # really was required. + + # Nullify the symbol file. + compile_command=`$echo "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"` + finalize_command=`$echo "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"` + fi + + if test $need_relink = no || test "$build_libtool_libs" != yes; then + # Replace the output file specification. + compile_command=`$echo "X$compile_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'` + link_command="$compile_command$compile_rpath" + + # We have no uninstalled library dependencies, so finalize right now. + $show "$link_command" + $run eval "$link_command" + status=$? + + # Delete the generated files. + if test -n "$dlsyms"; then + $show "$rm $output_objdir/${outputname}S.${objext}" + $run $rm "$output_objdir/${outputname}S.${objext}" + fi + + exit $status + fi + + if test -n "$shlibpath_var"; then + # We should set the shlibpath_var + rpath= + for dir in $temp_rpath; do + case $dir in + [\\/]* | [A-Za-z]:[\\/]*) + # Absolute path. + rpath="$rpath$dir:" + ;; + *) + # Relative path: add a thisdir entry. + rpath="$rpath\$thisdir/$dir:" + ;; + esac + done + temp_rpath="$rpath" + fi + + if test -n "$compile_shlibpath$finalize_shlibpath"; then + compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command" + fi + if test -n "$finalize_shlibpath"; then + finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command" + fi + + compile_var= + finalize_var= + if test -n "$runpath_var"; then + if test -n "$perm_rpath"; then + # We should set the runpath_var. + rpath= + for dir in $perm_rpath; do + rpath="$rpath$dir:" + done + compile_var="$runpath_var=\"$rpath\$$runpath_var\" " + fi + if test -n "$finalize_perm_rpath"; then + # We should set the runpath_var. + rpath= + for dir in $finalize_perm_rpath; do + rpath="$rpath$dir:" + done + finalize_var="$runpath_var=\"$rpath\$$runpath_var\" " + fi + fi + + if test "$no_install" = yes; then + # We don't need to create a wrapper script. + link_command="$compile_var$compile_command$compile_rpath" + # Replace the output file specification. + link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'` + # Delete the old output file. + $run $rm $output + # Link the executable and exit + $show "$link_command" + $run eval "$link_command" || exit $? + exit 0 + fi + + if test "$hardcode_action" = relink; then + # Fast installation is not supported + link_command="$compile_var$compile_command$compile_rpath" + relink_command="$finalize_var$finalize_command$finalize_rpath" + + $echo "$modename: warning: this platform does not like uninstalled shared libraries" 1>&2 + $echo "$modename: \`$output' will be relinked during installation" 1>&2 + else + if test "$fast_install" != no; then + link_command="$finalize_var$compile_command$finalize_rpath" + if test "$fast_install" = yes; then + relink_command=`$echo "X$compile_var$compile_command$compile_rpath" | $Xsed -e 's%@OUTPUT@%\$progdir/\$file%g'` + else + # fast_install is set to needless + relink_command= + fi + else + link_command="$compile_var$compile_command$compile_rpath" + relink_command="$finalize_var$finalize_command$finalize_rpath" + fi + fi + + # Replace the output file specification. + link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'` + + # Delete the old output files. + $run $rm $output $output_objdir/$outputname $output_objdir/lt-$outputname + + $show "$link_command" + $run eval "$link_command" || exit $? + + # Now create the wrapper script. + $show "creating $output" + + # Quote the relink command for shipping. + if test -n "$relink_command"; then + # Preserve any variables that may affect compiler behavior + for var in $variables_saved_for_relink; do + if eval test -z \"\${$var+set}\"; then + relink_command="{ test -z \"\${$var+set}\" || unset $var || { $var=; export $var; }; }; $relink_command" + elif eval var_value=\$$var; test -z "$var_value"; then + relink_command="$var=; export $var; $relink_command" + else + var_value=`$echo "X$var_value" | $Xsed -e "$sed_quote_subst"` + relink_command="$var=\"$var_value\"; export $var; $relink_command" + fi + done + relink_command="cd `pwd`; $relink_command" + relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"` + fi + + # Quote $echo for shipping. + if test "X$echo" = "X$SHELL $0 --fallback-echo"; then + case $0 in + [\\/]* | [A-Za-z]:[\\/]*) qecho="$SHELL $0 --fallback-echo";; + *) qecho="$SHELL `pwd`/$0 --fallback-echo";; + esac + qecho=`$echo "X$qecho" | $Xsed -e "$sed_quote_subst"` + else + qecho=`$echo "X$echo" | $Xsed -e "$sed_quote_subst"` + fi + + # Only actually do things if our run command is non-null. + if test -z "$run"; then + # win32 will think the script is a binary if it has + # a .exe suffix, so we strip it off here. + case $output in + *.exe) output=`echo $output|sed 's,.exe$,,'` ;; + esac + # test for cygwin because mv fails w/o .exe extensions + case $host in + *cygwin*) exeext=.exe ;; + *) exeext= ;; + esac + $rm $output + trap "$rm $output; exit 1" 1 2 15 + + $echo > $output "\ +#! $SHELL + +# $output - temporary wrapper script for $objdir/$outputname +# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP +# +# The $output program cannot be directly executed until all the libtool +# libraries that it depends on are installed. +# +# This wrapper script should never be moved out of the build directory. +# If it is, it will not operate correctly. + +# Sed substitution that helps us do robust quoting. It backslashifies +# metacharacters that are still active within double-quoted strings. +Xsed='sed -e 1s/^X//' +sed_quote_subst='$sed_quote_subst' + +# The HP-UX ksh and POSIX shell print the target directory to stdout +# if CDPATH is set. +if test \"\${CDPATH+set}\" = set; then CDPATH=:; export CDPATH; fi + +relink_command=\"$relink_command > /dev/null 2>&1\" + +# This environment variable determines our operation mode. +if test \"\$libtool_install_magic\" = \"$magic\"; then + # install mode needs the following variable: + notinst_deplibs='$notinst_deplibs' +else + # When we are sourced in execute mode, \$file and \$echo are already set. + if test \"\$libtool_execute_magic\" != \"$magic\"; then + echo=\"$qecho\" + file=\"\$0\" + # Make sure echo works. + if test \"X\$1\" = X--no-reexec; then + # Discard the --no-reexec flag, and continue. + shift + elif test \"X\`(\$echo '\t') 2>/dev/null\`\" = 'X\t'; then + # Yippee, \$echo works! + : + else + # Restart under the correct shell, and then maybe \$echo will work. + exec $SHELL \"\$0\" --no-reexec \${1+\"\$@\"} + fi + fi\ +" + $echo >> $output "\ + + # Find the directory that this script lives in. + thisdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*$%%'\` + test \"x\$thisdir\" = \"x\$file\" && thisdir=. + + # Follow symbolic links until we get to the real thisdir. + file=\`ls -ld \"\$file\" | sed -n 's/.*-> //p'\` + while test -n \"\$file\"; do + destdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*\$%%'\` + + # If there was a directory component, then change thisdir. + if test \"x\$destdir\" != \"x\$file\"; then + case \"\$destdir\" in + [\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;; + *) thisdir=\"\$thisdir/\$destdir\" ;; + esac + fi + + file=\`\$echo \"X\$file\" | \$Xsed -e 's%^.*/%%'\` + file=\`ls -ld \"\$thisdir/\$file\" | sed -n 's/.*-> //p'\` + done + + # Try to get the absolute directory name. + absdir=\`cd \"\$thisdir\" && pwd\` + test -n \"\$absdir\" && thisdir=\"\$absdir\" +" + + if test "$fast_install" = yes; then + echo >> $output "\ + program=lt-'$outputname'$exeext + progdir=\"\$thisdir/$objdir\" + + if test ! -f \"\$progdir/\$program\" || \\ + { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | sed 1q\`; \\ + test \"X\$file\" != \"X\$progdir/\$program\"; }; then + + file=\"\$\$-\$program\" + + if test ! -d \"\$progdir\"; then + $mkdir \"\$progdir\" + else + $rm \"\$progdir/\$file\" + fi" + + echo >> $output "\ + + # relink executable if necessary + if test -n \"\$relink_command\"; then + if relink_command_output=\`eval \$relink_command 2>&1\`; then : + else + $echo \"\$relink_command_output\" >&2 + $rm \"\$progdir/\$file\" + exit 1 + fi + fi + + $mv \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null || + { $rm \"\$progdir/\$program\"; + $mv \"\$progdir/\$file\" \"\$progdir/\$program\"; } + $rm \"\$progdir/\$file\" + fi" + else + echo >> $output "\ + program='$outputname' + progdir=\"\$thisdir/$objdir\" +" + fi + + echo >> $output "\ + + if test -f \"\$progdir/\$program\"; then" + + # Export our shlibpath_var if we have one. + if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then + $echo >> $output "\ + # Add our own library path to $shlibpath_var + $shlibpath_var=\"$temp_rpath\$$shlibpath_var\" + + # Some systems cannot cope with colon-terminated $shlibpath_var + # The second colon is a workaround for a bug in BeOS R4 sed + $shlibpath_var=\`\$echo \"X\$$shlibpath_var\" | \$Xsed -e 's/::*\$//'\` + + export $shlibpath_var +" + fi + + # fixup the dll searchpath if we need to. + if test -n "$dllsearchpath"; then + $echo >> $output "\ + # Add the dll search path components to the executable PATH + PATH=$dllsearchpath:\$PATH +" + fi + + $echo >> $output "\ + if test \"\$libtool_execute_magic\" != \"$magic\"; then + # Run the actual program with our arguments. +" + case $host in + # win32 systems need to use the prog path for dll + # lookup to work + *-*-cygwin* | *-*-pw32*) + $echo >> $output "\ + exec \$progdir/\$program \${1+\"\$@\"} +" + ;; + + # Backslashes separate directories on plain windows + *-*-mingw | *-*-os2*) + $echo >> $output "\ + exec \$progdir\\\\\$program \${1+\"\$@\"} +" + ;; + + *) + $echo >> $output "\ + # Export the path to the program. + PATH=\"\$progdir:\$PATH\" + export PATH + + exec \$program \${1+\"\$@\"} +" + ;; + esac + $echo >> $output "\ + \$echo \"\$0: cannot exec \$program \${1+\"\$@\"}\" + exit 1 + fi + else + # The program doesn't exist. + \$echo \"\$0: error: \$progdir/\$program does not exist\" 1>&2 + \$echo \"This script is just a wrapper for \$program.\" 1>&2 + echo \"See the $PACKAGE documentation for more information.\" 1>&2 + exit 1 + fi +fi\ +" + chmod +x $output + fi + exit 0 + ;; + esac + + # See if we need to build an old-fashioned archive. + for oldlib in $oldlibs; do + + if test "$build_libtool_libs" = convenience; then + oldobjs="$libobjs_save" + addlibs="$convenience" + build_libtool_libs=no + else + if test "$build_libtool_libs" = module; then + oldobjs="$libobjs_save" + build_libtool_libs=no + else + oldobjs="$objs$old_deplibs $non_pic_objects" + fi + addlibs="$old_convenience" + fi + + if test -n "$addlibs"; then + gentop="$output_objdir/${outputname}x" + $show "${rm}r $gentop" + $run ${rm}r "$gentop" + $show "$mkdir $gentop" + $run $mkdir "$gentop" + status=$? + if test $status -ne 0 && test ! -d "$gentop"; then + exit $status + fi + generated="$generated $gentop" + + # Add in members from convenience archives. + for xlib in $addlibs; do + # Extract the objects. + case $xlib in + [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;; + *) xabs=`pwd`"/$xlib" ;; + esac + xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'` + xdir="$gentop/$xlib" + + $show "${rm}r $xdir" + $run ${rm}r "$xdir" + $show "$mkdir $xdir" + $run $mkdir "$xdir" + status=$? + if test $status -ne 0 && test ! -d "$xdir"; then + exit $status + fi + $show "(cd $xdir && $AR x $xabs)" + $run eval "(cd \$xdir && $AR x \$xabs)" || exit $? + + oldobjs="$oldobjs "`find $xdir -name \*.${objext} -print | $NL2SP` + done + fi + + # Do each command in the archive commands. + if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then + eval cmds=\"$old_archive_from_new_cmds\" + else +# # Ensure that we have .o objects in place in case we decided +# # not to build a shared library, and have fallen back to building +# # static libs even though --disable-static was passed! +# for oldobj in $oldobjs; do +# if test ! -f $oldobj; then +# xdir=`$echo "X$oldobj" | $Xsed -e 's%/[^/]*$%%'` +# if test "X$xdir" = "X$oldobj"; then +# xdir="." +# else +# xdir="$xdir" +# fi +# baseobj=`$echo "X$oldobj" | $Xsed -e 's%^.*/%%'` +# obj=`$echo "X$baseobj" | $Xsed -e "$o2lo"` +# $show "(cd $xdir && ${LN_S} $obj $baseobj)" +# $run eval '(cd $xdir && ${LN_S} $obj $baseobj)' || exit $? +# fi +# done + + eval cmds=\"$old_archive_cmds\" + + if len=`expr "X$cmds" : ".*"` && + test $len -le $max_cmd_len; then + : + else + # the command line is too long to link in one step, link in parts + $echo "using piecewise archive linking..." + save_RANLIB=$RANLIB + RANLIB=: + objlist= + concat_cmds= + save_oldobjs=$oldobjs + for obj in $save_oldobjs + do + oldobjs="$objlist $obj" + objlist="$objlist $obj" + eval test_cmds=\"$old_archive_cmds\" + if len=`expr "X$test_cmds" : ".*"` && + test $len -le $max_cmd_len; then + : + else + # the above command should be used before it gets too long + oldobjs=$objlist + test -z "$concat_cmds" || concat_cmds=$concat_cmds~ + eval concat_cmds=\"\${concat_cmds}$old_archive_cmds\" + objlist= + fi + done + RANLIB=$save_RANLIB + oldobjs=$objlist + eval cmds=\"\$concat_cmds~$old_archive_cmds\" + fi + fi + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + done + + if test -n "$generated"; then + $show "${rm}r$generated" + $run ${rm}r$generated + fi + + # Now create the libtool archive. + case $output in + *.la) + old_library= + test "$build_old_libs" = yes && old_library="$libname.$libext" + $show "creating $output" + + # Preserve any variables that may affect compiler behavior + for var in $variables_saved_for_relink; do + if eval test -z \"\${$var+set}\"; then + relink_command="{ test -z \"\${$var+set}\" || unset $var || { $var=; export $var; }; }; $relink_command" + elif eval var_value=\$$var; test -z "$var_value"; then + relink_command="$var=; export $var; $relink_command" + else + var_value=`$echo "X$var_value" | $Xsed -e "$sed_quote_subst"` + relink_command="$var=\"$var_value\"; export $var; $relink_command" + fi + done + # Quote the link command for shipping. + tagopts= + for tag in $taglist; do + tagopts="$tagopts --tag $tag" + done + relink_command="(cd `pwd`; $SHELL $0$tagopts --mode=relink $libtool_args)" + relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"` + + # Only create the output if not a dry run. + if test -z "$run"; then + for installed in no yes; do + if test "$installed" = yes; then + if test -z "$install_libdir"; then + break + fi + output="$output_objdir/$outputname"i + # Replace all uninstalled libtool libraries with the installed ones + newdependency_libs= + for deplib in $dependency_libs; do + case $deplib in + *.la) + name=`$echo "X$deplib" | $Xsed -e 's%^.*/%%'` + eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib` + if test -z "$libdir"; then + $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2 + exit 1 + fi + newdependency_libs="$newdependency_libs $libdir/$name" + ;; + *) newdependency_libs="$newdependency_libs $deplib" ;; + esac + done + dependency_libs="$newdependency_libs" + newdlfiles= + for lib in $dlfiles; do + name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'` + eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib` + if test -z "$libdir"; then + $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 + exit 1 + fi + newdlfiles="$newdlfiles $libdir/$name" + done + dlfiles="$newdlfiles" + newdlprefiles= + for lib in $dlprefiles; do + name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'` + eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib` + if test -z "$libdir"; then + $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 + exit 1 + fi + newdlprefiles="$newdlprefiles $libdir/$name" + done + dlprefiles="$newdlprefiles" + fi + $rm $output + # place dlname in correct position for cygwin + tdlname=$dlname + case $host,$output,$installed,$module,$dlname in + *cygwin*,*lai,yes,no,*.dll) tdlname=../bin/$dlname ;; + esac + $echo > $output "\ +# $outputname - a libtool library file +# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP +# +# Please DO NOT delete this file! +# It is necessary for linking the library. + +# The name that we can dlopen(3). +dlname='$tdlname' + +# Names of this library. +library_names='$library_names' + +# The name of the static archive. +old_library='$old_library' + +# Libraries that this one depends upon. +dependency_libs='$dependency_libs' + +# Version information for $libname. +current=$current +age=$age +revision=$revision + +# Is this an already installed library? +installed=$installed + +# Files to dlopen/dlpreopen +dlopen='$dlfiles' +dlpreopen='$dlprefiles' + +# Directory that this library needs to be installed in: +libdir='$install_libdir'" + if test "$installed" = no && test $need_relink = yes; then + $echo >> $output "\ +relink_command=\"$relink_command\"" + fi + done + fi + + # Do a symbolic link so that the libtool archive can be found in + # LD_LIBRARY_PATH before the program is installed. + $show "(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)" + $run eval '(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)' || exit $? + ;; + esac + exit 0 + ;; + + # libtool install mode + install) + modename="$modename: install" + + # There may be an optional sh(1) argument at the beginning of + # install_prog (especially on Windows NT). + if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh || + # Allow the use of GNU shtool's install command. + $echo "X$nonopt" | $Xsed | grep shtool > /dev/null; then + # Aesthetically quote it. + arg=`$echo "X$nonopt" | $Xsed -e "$sed_quote_subst"` + case $arg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) + arg="\"$arg\"" + ;; + esac + install_prog="$arg " + arg="$1" + shift + else + install_prog= + arg="$nonopt" + fi + + # The real first argument should be the name of the installation program. + # Aesthetically quote it. + arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` + case $arg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) + arg="\"$arg\"" + ;; + esac + install_prog="$install_prog$arg" + + # We need to accept at least all the BSD install flags. + dest= + files= + opts= + prev= + install_type= + isdir=no + stripme= + for arg + do + if test -n "$dest"; then + files="$files $dest" + dest="$arg" + continue + fi + + case $arg in + -d) isdir=yes ;; + -f) prev="-f" ;; + -g) prev="-g" ;; + -m) prev="-m" ;; + -o) prev="-o" ;; + -s) + stripme=" -s" + continue + ;; + -*) ;; + + *) + # If the previous option needed an argument, then skip it. + if test -n "$prev"; then + prev= + else + dest="$arg" + continue + fi + ;; + esac + + # Aesthetically quote the argument. + arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` + case $arg in + *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) + arg="\"$arg\"" + ;; + esac + install_prog="$install_prog $arg" + done + + if test -z "$install_prog"; then + $echo "$modename: you must specify an install program" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + if test -n "$prev"; then + $echo "$modename: the \`$prev' option requires an argument" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + if test -z "$files"; then + if test -z "$dest"; then + $echo "$modename: no file or destination specified" 1>&2 + else + $echo "$modename: you must specify a destination" 1>&2 + fi + $echo "$help" 1>&2 + exit 1 + fi + + # Strip any trailing slash from the destination. + dest=`$echo "X$dest" | $Xsed -e 's%/$%%'` + + # Check to see that the destination is a directory. + test -d "$dest" && isdir=yes + if test "$isdir" = yes; then + destdir="$dest" + destname= + else + destdir=`$echo "X$dest" | $Xsed -e 's%/[^/]*$%%'` + test "X$destdir" = "X$dest" && destdir=. + destname=`$echo "X$dest" | $Xsed -e 's%^.*/%%'` + + # Not a directory, so check to see that there is only one file specified. + set dummy $files + if test $# -gt 2; then + $echo "$modename: \`$dest' is not a directory" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + fi + case $destdir in + [\\/]* | [A-Za-z]:[\\/]*) ;; + *) + for file in $files; do + case $file in + *.lo) ;; + *) + $echo "$modename: \`$destdir' must be an absolute directory name" 1>&2 + $echo "$help" 1>&2 + exit 1 + ;; + esac + done + ;; + esac + + # This variable tells wrapper scripts just to set variables rather + # than running their programs. + libtool_install_magic="$magic" + + staticlibs= + future_libdirs= + current_libdirs= + for file in $files; do + + # Do each installation. + case $file in + *.$libext) + # Do the static libraries later. + staticlibs="$staticlibs $file" + ;; + + *.la) + # Check to see that this really is a libtool archive. + if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then : + else + $echo "$modename: \`$file' is not a valid libtool archive" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + library_names= + old_library= + relink_command= + # If there is no directory component, then add one. + case $file in + */* | *\\*) . $file ;; + *) . ./$file ;; + esac + + # Add the libdir to current_libdirs if it is the destination. + if test "X$destdir" = "X$libdir"; then + case "$current_libdirs " in + *" $libdir "*) ;; + *) current_libdirs="$current_libdirs $libdir" ;; + esac + else + # Note the libdir as a future libdir. + case "$future_libdirs " in + *" $libdir "*) ;; + *) future_libdirs="$future_libdirs $libdir" ;; + esac + fi + + dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`/ + test "X$dir" = "X$file/" && dir= + dir="$dir$objdir" + + if test -n "$relink_command"; then + $echo "$modename: warning: relinking \`$file'" 1>&2 + $show "$relink_command" + if $run eval "$relink_command"; then : + else + $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2 + exit 1 + fi + fi + + # See the names of the shared library. + set dummy $library_names + if test -n "$2"; then + realname="$2" + shift + shift + + srcname="$realname" + test -n "$relink_command" && srcname="$realname"T + + # Install the shared library and build the symlinks. + $show "$install_prog $dir/$srcname $destdir/$realname" + $run eval "$install_prog $dir/$srcname $destdir/$realname" || exit $? + if test -n "$stripme" && test -n "$striplib"; then + $show "$striplib $destdir/$realname" + $run eval "$striplib $destdir/$realname" || exit $? + fi + + if test $# -gt 0; then + # Delete the old symlinks, and create new ones. + for linkname + do + if test "$linkname" != "$realname"; then + $show "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)" + $run eval "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)" + fi + done + fi + + # Do each command in the postinstall commands. + lib="$destdir/$realname" + eval cmds=\"$postinstall_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + fi + + # Install the pseudo-library for information purposes. + name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` + instname="$dir/$name"i + $show "$install_prog $instname $destdir/$name" + $run eval "$install_prog $instname $destdir/$name" || exit $? + + # Maybe install the static library, too. + test -n "$old_library" && staticlibs="$staticlibs $dir/$old_library" + ;; + + *.lo) + # Install (i.e. copy) a libtool object. + + # Figure out destination file name, if it wasn't already specified. + if test -n "$destname"; then + destfile="$destdir/$destname" + else + destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'` + destfile="$destdir/$destfile" + fi + + # Deduce the name of the destination old-style object file. + case $destfile in + *.lo) + staticdest=`$echo "X$destfile" | $Xsed -e "$lo2o"` + ;; + *.$objext) + staticdest="$destfile" + destfile= + ;; + *) + $echo "$modename: cannot copy a libtool object to \`$destfile'" 1>&2 + $echo "$help" 1>&2 + exit 1 + ;; + esac + + # Install the libtool object if requested. + if test -n "$destfile"; then + $show "$install_prog $file $destfile" + $run eval "$install_prog $file $destfile" || exit $? + fi + + # Install the old object if enabled. + if test "$build_old_libs" = yes; then + # Deduce the name of the old-style object file. + staticobj=`$echo "X$file" | $Xsed -e "$lo2o"` + + $show "$install_prog $staticobj $staticdest" + $run eval "$install_prog \$staticobj \$staticdest" || exit $? + fi + exit 0 + ;; + + *) + # Figure out destination file name, if it wasn't already specified. + if test -n "$destname"; then + destfile="$destdir/$destname" + else + destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'` + destfile="$destdir/$destfile" + fi + + # Do a test to see if this is really a libtool program. + if (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then + notinst_deplibs= + relink_command= + + # If there is no directory component, then add one. + case $file in + */* | *\\*) . $file ;; + *) . ./$file ;; + esac + + # Check the variables that should have been set. + if test -z "$notinst_deplibs"; then + $echo "$modename: invalid libtool wrapper script \`$file'" 1>&2 + exit 1 + fi + + finalize=yes + for lib in $notinst_deplibs; do + # Check to see that each library is installed. + libdir= + if test -f "$lib"; then + # If there is no directory component, then add one. + case $lib in + */* | *\\*) . $lib ;; + *) . ./$lib ;; + esac + fi + libfile="$libdir/"`$echo "X$lib" | $Xsed -e 's%^.*/%%g'` ### testsuite: skip nested quoting test + if test -n "$libdir" && test ! -f "$libfile"; then + $echo "$modename: warning: \`$lib' has not been installed in \`$libdir'" 1>&2 + finalize=no + fi + done + + relink_command= + # If there is no directory component, then add one. + case $file in + */* | *\\*) . $file ;; + *) . ./$file ;; + esac + + outputname= + if test "$fast_install" = no && test -n "$relink_command"; then + if test "$finalize" = yes && test -z "$run"; then + tmpdir="/tmp" + test -n "$TMPDIR" && tmpdir="$TMPDIR" + tmpdir="$tmpdir/libtool-$$" + if $mkdir -p "$tmpdir" && chmod 700 "$tmpdir"; then : + else + $echo "$modename: error: cannot create temporary directory \`$tmpdir'" 1>&2 + continue + fi + file=`$echo "X$file" | $Xsed -e 's%^.*/%%'` + outputname="$tmpdir/$file" + # Replace the output file specification. + relink_command=`$echo "X$relink_command" | $Xsed -e 's%@OUTPUT@%'"$outputname"'%g'` + + $show "$relink_command" + if $run eval "$relink_command"; then : + else + $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2 + ${rm}r "$tmpdir" + continue + fi + file="$outputname" + else + $echo "$modename: warning: cannot relink \`$file'" 1>&2 + fi + else + # Install the binary that we compiled earlier. + file=`$echo "X$file" | $Xsed -e "s%\([^/]*\)$%$objdir/\1%"` + fi + fi + + + # remove .exe since cygwin /usr/bin/install will append another + # one anyways + case $install_prog,$host in + */usr/bin/install*,*cygwin*) + case $file:$destfile in + *.exe:*.exe) + # this is ok + ;; + *.exe:*) + destfile=$destfile.exe + ;; + *:*.exe) + destfile=`echo $destfile | sed -e 's,.exe$,,'` + ;; + esac + ;; + esac + + $show "$install_prog$stripme $file $destfile" + $run eval "$install_prog\$stripme \$file \$destfile" || exit $? + test -n "$outputname" && ${rm}r "$tmpdir" + ;; + esac + done + + for file in $staticlibs; do + name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` + + # Set up the ranlib parameters. + oldlib="$destdir/$name" + + $show "$install_prog $file $oldlib" + $run eval "$install_prog \$file \$oldlib" || exit $? + + if test -n "$stripme" && test -n "$striplib"; then + $show "$old_striplib $oldlib" + $run eval "$old_striplib $oldlib" || exit $? + fi + + # Do each command in the postinstall commands. + eval cmds=\"$old_postinstall_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || exit $? + done + IFS="$save_ifs" + done + + if test -n "$future_libdirs"; then + $echo "$modename: warning: remember to run \`$progname --finish$future_libdirs'" 1>&2 + fi + + if test -n "$current_libdirs"; then + # Maybe just do a dry run. + test -n "$run" && current_libdirs=" -n$current_libdirs" + exec_cmd='$SHELL $0 --finish$current_libdirs' + else + exit 0 + fi + ;; + + # libtool finish mode + finish) + modename="$modename: finish" + libdirs="$nonopt" + admincmds= + + if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then + for dir + do + libdirs="$libdirs $dir" + done + + for libdir in $libdirs; do + if test -n "$finish_cmds"; then + # Do each command in the finish commands. + eval cmds=\"$finish_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" || admincmds="$admincmds + $cmd" + done + IFS="$save_ifs" + fi + if test -n "$finish_eval"; then + # Do the single finish_eval. + eval cmds=\"$finish_eval\" + $run eval "$cmds" || admincmds="$admincmds + $cmds" + fi + done + fi + + # Exit here if they wanted silent mode. + test "$show" = ":" && exit 0 + + echo "----------------------------------------------------------------------" + echo "Libraries have been installed in:" + for libdir in $libdirs; do + echo " $libdir" + done + echo + echo "If you ever happen to want to link against installed libraries" + echo "in a given directory, LIBDIR, you must either use libtool, and" + echo "specify the full pathname of the library, or use the \`-LLIBDIR'" + echo "flag during linking and do at least one of the following:" + if test -n "$shlibpath_var"; then + echo " - add LIBDIR to the \`$shlibpath_var' environment variable" + echo " during execution" + fi + if test -n "$runpath_var"; then + echo " - add LIBDIR to the \`$runpath_var' environment variable" + echo " during linking" + fi + if test -n "$hardcode_libdir_flag_spec"; then + libdir=LIBDIR + eval flag=\"$hardcode_libdir_flag_spec\" + + echo " - use the \`$flag' linker flag" + fi + if test -n "$admincmds"; then + echo " - have your system administrator run these commands:$admincmds" + fi + if test -f /etc/ld.so.conf; then + echo " - have your system administrator add LIBDIR to \`/etc/ld.so.conf'" + fi + echo + echo "See any operating system documentation about shared libraries for" + echo "more information, such as the ld(1) and ld.so(8) manual pages." + echo "----------------------------------------------------------------------" + exit 0 + ;; + + # libtool execute mode + execute) + modename="$modename: execute" + + # The first argument is the command name. + cmd="$nonopt" + if test -z "$cmd"; then + $echo "$modename: you must specify a COMMAND" 1>&2 + $echo "$help" + exit 1 + fi + + # Handle -dlopen flags immediately. + for file in $execute_dlfiles; do + if test ! -f "$file"; then + $echo "$modename: \`$file' is not a file" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + dir= + case $file in + *.la) + # Check to see that this really is a libtool archive. + if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then : + else + $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + # Read the libtool library. + dlname= + library_names= + + # If there is no directory component, then add one. + case $file in + */* | *\\*) . $file ;; + *) . ./$file ;; + esac + + # Skip this library if it cannot be dlopened. + if test -z "$dlname"; then + # Warn if it was a shared library. + test -n "$library_names" && $echo "$modename: warning: \`$file' was not linked with \`-export-dynamic'" + continue + fi + + dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` + test "X$dir" = "X$file" && dir=. + + if test -f "$dir/$objdir/$dlname"; then + dir="$dir/$objdir" + else + $echo "$modename: cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'" 1>&2 + exit 1 + fi + ;; + + *.lo) + # Just add the directory containing the .lo file. + dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` + test "X$dir" = "X$file" && dir=. + ;; + + *) + $echo "$modename: warning \`-dlopen' is ignored for non-libtool libraries and objects" 1>&2 + continue + ;; + esac + + # Get the absolute pathname. + absdir=`cd "$dir" && pwd` + test -n "$absdir" && dir="$absdir" + + # Now add the directory to shlibpath_var. + if eval "test -z \"\$$shlibpath_var\""; then + eval "$shlibpath_var=\"\$dir\"" + else + eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\"" + fi + done + + # This variable tells wrapper scripts just to set shlibpath_var + # rather than running their programs. + libtool_execute_magic="$magic" + + # Check if any of the arguments is a wrapper script. + args= + for file + do + case $file in + -*) ;; + *) + # Do a test to see if this is really a libtool program. + if (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then + # If there is no directory component, then add one. + case $file in + */* | *\\*) . $file ;; + *) . ./$file ;; + esac + + # Transform arg to wrapped name. + file="$progdir/$program" + fi + ;; + esac + # Quote arguments (to preserve shell metacharacters). + file=`$echo "X$file" | $Xsed -e "$sed_quote_subst"` + args="$args \"$file\"" + done + + if test -z "$run"; then + if test -n "$shlibpath_var"; then + # Export the shlibpath_var. + eval "export $shlibpath_var" + fi + + # Restore saved enviroment variables + if test "${save_LC_ALL+set}" = set; then + LC_ALL="$save_LC_ALL"; export LC_ALL + fi + if test "${save_LANG+set}" = set; then + LANG="$save_LANG"; export LANG + fi + + # Now prepare to actually exec the command. + exec_cmd='"$cmd"$args' + else + # Display what would be done. + if test -n "$shlibpath_var"; then + eval "\$echo \"\$shlibpath_var=\$$shlibpath_var\"" + $echo "export $shlibpath_var" + fi + $echo "$cmd$args" + exit 0 + fi + ;; + + # libtool clean and uninstall mode + clean | uninstall) + modename="$modename: $mode" + rm="$nonopt" + files= + rmforce= + exit_status=0 + + # This variable tells wrapper scripts just to set variables rather + # than running their programs. + libtool_install_magic="$magic" + + for arg + do + case $arg in + -f) rm="$rm $arg"; rmforce=yes ;; + -*) rm="$rm $arg" ;; + *) files="$files $arg" ;; + esac + done + + if test -z "$rm"; then + $echo "$modename: you must specify an RM program" 1>&2 + $echo "$help" 1>&2 + exit 1 + fi + + rmdirs= + + for file in $files; do + dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` + if test "X$dir" = "X$file"; then + dir=. + objdir="$objdir" + else + objdir="$dir/$objdir" + fi + name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` + test $mode = uninstall && objdir="$dir" + + # Remember objdir for removal later, being careful to avoid duplicates + if test $mode = clean; then + case " $rmdirs " in + *" $objdir "*) ;; + *) rmdirs="$rmdirs $objdir" ;; + esac + fi + + # Don't error if the file doesn't exist and rm -f was used. + if (test -L "$file") >/dev/null 2>&1 \ + || (test -h "$file") >/dev/null 2>&1 \ + || test -f "$file"; then + : + elif test -d "$file"; then + exit_status=1 + continue + elif test "$rmforce" = yes; then + continue + fi + + rmfiles="$file" + + case $name in + *.la) + # Possibly a libtool archive, so verify it. + if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then + . $dir/$name + + # Delete the libtool libraries and symlinks. + for n in $library_names; do + rmfiles="$rmfiles $objdir/$n" + done + test -n "$old_library" && rmfiles="$rmfiles $objdir/$old_library" + test $mode = clean && rmfiles="$rmfiles $objdir/$name $objdir/${name}i" + + if test $mode = uninstall; then + if test -n "$library_names"; then + # Do each command in the postuninstall commands. + eval cmds=\"$postuninstall_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" + if test $? != 0 && test "$rmforce" != yes; then + exit_status=1 + fi + done + IFS="$save_ifs" + fi + + if test -n "$old_library"; then + # Do each command in the old_postuninstall commands. + eval cmds=\"$old_postuninstall_cmds\" + IFS="${IFS= }"; save_ifs="$IFS"; IFS='~' + for cmd in $cmds; do + IFS="$save_ifs" + $show "$cmd" + $run eval "$cmd" + if test $? != 0 && test "$rmforce" != yes; then + exit_status=1 + fi + done + IFS="$save_ifs" + fi + # FIXME: should reinstall the best remaining shared library. + fi + fi + ;; + + *.lo) + # Possibly a libtool object, so verify it. + if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then + + # Read the .lo file + . $dir/$name + + # Add PIC object to the list of files to remove. + if test -n "$pic_object" \ + && test "$pic_object" != none; then + rmfiles="$rmfiles $dir/$pic_object" + fi + + # Add non-PIC object to the list of files to remove. + if test -n "$non_pic_object" \ + && test "$non_pic_object" != none; then + rmfiles="$rmfiles $dir/$non_pic_object" + fi + fi + ;; + + *) + # Do a test to see if this is a libtool program. + if test $mode = clean && + (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then + relink_command= + . $dir/$file + + rmfiles="$rmfiles $objdir/$name $objdir/${name}S.${objext}" + if test "$fast_install" = yes && test -n "$relink_command"; then + rmfiles="$rmfiles $objdir/lt-$name" + fi + fi + ;; + esac + $show "$rm $rmfiles" + $run $rm $rmfiles || exit_status=1 + done + + # Try to remove the ${objdir}s in the directories where we deleted files + for dir in $rmdirs; do + if test -d "$dir"; then + $show "rmdir $dir" + $run rmdir $dir >/dev/null 2>&1 + fi + done + + exit $exit_status + ;; + + "") + $echo "$modename: you must specify a MODE" 1>&2 + $echo "$generic_help" 1>&2 + exit 1 + ;; + esac + + if test -z "$exec_cmd"; then + $echo "$modename: invalid operation mode \`$mode'" 1>&2 + $echo "$generic_help" 1>&2 + exit 1 + fi +fi # test -z "$show_help" + +if test -n "$exec_cmd"; then + eval exec $exec_cmd + exit 1 +fi + +# We need to display help for each of the modes. +case $mode in +"") $echo \ +"Usage: $modename [OPTION]... [MODE-ARG]... + +Provide generalized library-building support services. + + --config show all configuration variables + --debug enable verbose shell tracing +-n, --dry-run display commands without modifying any files + --features display basic configuration information and exit + --finish same as \`--mode=finish' + --help display this help message and exit + --mode=MODE use operation mode MODE [default=inferred from MODE-ARGS] + --quiet same as \`--silent' + --silent don't print informational messages + --tag=TAG use configuration variables from tag TAG + --version print version information + +MODE must be one of the following: + + clean remove files from the build directory + compile compile a source file into a libtool object + execute automatically set library path, then run a program + finish complete the installation of libtool libraries + install install libraries or executables + link create a library or an executable + uninstall remove libraries from an installed directory + +MODE-ARGS vary depending on the MODE. Try \`$modename --help --mode=MODE' for +a more detailed description of MODE." + exit 0 + ;; + +clean) + $echo \ +"Usage: $modename [OPTION]... --mode=clean RM [RM-OPTION]... FILE... + +Remove files from the build directory. + +RM is the name of the program to use to delete files associated with each FILE +(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed +to RM. + +If FILE is a libtool library, object or program, all the files associated +with it are deleted. Otherwise, only FILE itself is deleted using RM." + ;; + +compile) + $echo \ +"Usage: $modename [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE + +Compile a source file into a libtool library object. + +This mode accepts the following additional options: + + -o OUTPUT-FILE set the output file name to OUTPUT-FILE + -prefer-pic try to building PIC objects only + -prefer-non-pic try to building non-PIC objects only + -static always build a \`.o' file suitable for static linking + +COMPILE-COMMAND is a command to be used in creating a \`standard' object file +from the given SOURCEFILE. + +The output file name is determined by removing the directory component from +SOURCEFILE, then substituting the C source code suffix \`.c' with the +library object suffix, \`.lo'." + ;; + +execute) + $echo \ +"Usage: $modename [OPTION]... --mode=execute COMMAND [ARGS]... + +Automatically set library path, then run a program. + +This mode accepts the following additional options: + + -dlopen FILE add the directory containing FILE to the library path + +This mode sets the library path environment variable according to \`-dlopen' +flags. + +If any of the ARGS are libtool executable wrappers, then they are translated +into their corresponding uninstalled binary, and any of their required library +directories are added to the library path. + +Then, COMMAND is executed, with ARGS as arguments." + ;; + +finish) + $echo \ +"Usage: $modename [OPTION]... --mode=finish [LIBDIR]... + +Complete the installation of libtool libraries. + +Each LIBDIR is a directory that contains libtool libraries. + +The commands that this mode executes may require superuser privileges. Use +the \`--dry-run' option if you just want to see what would be executed." + ;; + +install) + $echo \ +"Usage: $modename [OPTION]... --mode=install INSTALL-COMMAND... + +Install executables or libraries. + +INSTALL-COMMAND is the installation command. The first component should be +either the \`install' or \`cp' program. + +The rest of the components are interpreted as arguments to that command (only +BSD-compatible install options are recognized)." + ;; + +link) + $echo \ +"Usage: $modename [OPTION]... --mode=link LINK-COMMAND... + +Link object files or libraries together to form another library, or to +create an executable program. + +LINK-COMMAND is a command using the C compiler that you would use to create +a program from several object files. + +The following components of LINK-COMMAND are treated specially: + + -all-static do not do any dynamic linking at all + -avoid-version do not add a version suffix if possible + -dlopen FILE \`-dlpreopen' FILE if it cannot be dlopened at runtime + -dlpreopen FILE link in FILE and add its symbols to lt_preloaded_symbols + -export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3) + -export-symbols SYMFILE + try to export only the symbols listed in SYMFILE + -export-symbols-regex REGEX + try to export only the symbols matching REGEX + -LLIBDIR search LIBDIR for required installed libraries + -lNAME OUTPUT-FILE requires the installed library libNAME + -module build a library that can dlopened + -no-fast-install disable the fast-install mode + -no-install link a not-installable executable + -no-undefined declare that a library does not refer to external symbols + -o OUTPUT-FILE create OUTPUT-FILE from the specified objects + -objectlist FILE Use a list of object files found in FILE to specify objects + -release RELEASE specify package release information + -rpath LIBDIR the created library will eventually be installed in LIBDIR + -R[ ]LIBDIR add LIBDIR to the runtime path of programs and libraries + -static do not do any dynamic linking of libtool libraries + -version-info CURRENT[:REVISION[:AGE]] + specify library version info [each variable defaults to 0] + +All other options (arguments beginning with \`-') are ignored. + +Every other argument is treated as a filename. Files ending in \`.la' are +treated as uninstalled libtool libraries, other files are standard or library +object files. + +If the OUTPUT-FILE ends in \`.la', then a libtool library is created, +only library objects (\`.lo' files) may be specified, and \`-rpath' is +required, except when creating a convenience library. + +If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created +using \`ar' and \`ranlib', or on Windows using \`lib'. + +If OUTPUT-FILE ends in \`.lo' or \`.${objext}', then a reloadable object file +is created, otherwise an executable program is created." + ;; + +uninstall) + $echo \ +"Usage: $modename [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE... + +Remove libraries from an installation directory. + +RM is the name of the program to use to delete files associated with each FILE +(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed +to RM. + +If FILE is a libtool library, all the files associated with it are deleted. +Otherwise, only FILE itself is deleted using RM." + ;; + +*) + $echo "$modename: invalid operation mode \`$mode'" 1>&2 + $echo "$help" 1>&2 + exit 1 + ;; +esac + +echo +$echo "Try \`$modename --help' for more information about other modes." + +exit 0 + +# The TAGs below are defined such that we never get into a situation +# in which we disable both kinds of libraries. Given conflicting +# choices, we go for a static library, that is the most portable, +# since we can't tell whether shared libraries were disabled because +# the user asked for that or because the platform doesn't support +# them. This is particularly important on AIX, because we don't +# support having both static and shared libraries enabled at the same +# time on that platform, so we default to a shared-only configuration. +# If a disable-shared tag is given, we'll fallback to a static-only +# configuration. But we'll never go from static-only to shared-only. + +### BEGIN LIBTOOL TAG CONFIG: disable-shared +build_libtool_libs=no +build_old_libs=yes +### END LIBTOOL TAG CONFIG: disable-shared + +### BEGIN LIBTOOL TAG CONFIG: disable-static +build_old_libs=`case $build_libtool_libs in yes) echo no;; *) echo yes;; esac` +### END LIBTOOL TAG CONFIG: disable-static + +# Local Variables: +# mode:shell-script +# sh-indentation:2 +# End: diff --git a/machines b/machines new file mode 100755 index 0000000..feea6c5 --- /dev/null +++ b/machines @@ -0,0 +1,36 @@ + +names for various supported machines. + +* 386-linux: 386 or 486 running linux (a.out or elf) +* 386-bsd: 386 or 486 running bsd +* alpha-osf1: Dec alpha DEC OSF/1 V3.2 Worksystem Software (Rev. 214) +* dec3100: Decstation 3100,5000, OS=Ultrix V3.1C-0 (Rev. 42) [akcl 505] + ULTRIX V4.2 (Rev. 96)[akcl 602] (VOL= ) +* hp300-bsd: Hp 350, 370 [motorola 68K] under 4.3 BSD (mt xinu) +* hp300: Hp 350, 370 under HPUX. +* hp800: Hp 720,730 under HPUX (version 8). Possibly hp 800 also +* mac2: Macintosh under AUX (unix) +* mingw: Windows built with MSYS hosted Mingw32 gcc +* mp386: intel 386 under System V 3 (eg microport,interactive) +* NeXT30-m68k: NeXT (M68K) under NeXTSTEP 3.0 +* NeXT32-m68k: NeXT (M68K) under NeXTSTEP 3.2, 3.3 (gcc-2.6.3 is required) +* NeXT32-i386: NeXT (I386) under NeXTSTEP 3.2, 3.3 (gcc-2.6.3 is required) +* ncr: intel 386 under System V 4 (loader sfasl not done). +* ps2_aix: ibm ps2 under aix +* rios: Ibm risc 6000 under aix3. +* rios: Ibm risc 6000 under aix4.3 but load does not yet work. +* rt_aix: ibm rt under aix release 2. +* sgi4d: 4d silicon graphics (IRIX System V Release 3.3.1)[akcl 600] +* sgi: silicon graphics 3d versions +* irix5: silicon graphics (IRIX Rel 5.2) /*cant save dynamically loaded*/ +* sun3-os4: sun3 under os 4.03, 4.1, 4.1.1 +* sun3: Sun 3 (motorola 68K) Sun OS 3.5 +* sun4: Sun 4,(sparc) sparctations, sun os 4.03, 4.1.x +* solaris: Sun 4,(sparc) sparctations, sun os 5 (solaris 2.5,2.6) use gcc +* solaris-i386: Intel x86 processors running sun os 5 (solaris 2.5) +* sparc-linux: sparc processor running linux +* symmetry: sequent symmetry (386 chips) DYNIX-3.0.12+ +* u370: IBM 370 (3090's) under AIX +* vax: Vax under 4.3 bsd., also ultrix + + diff --git a/majvers b/majvers new file mode 100755 index 0000000..0cfbf08 --- /dev/null +++ b/majvers @@ -0,0 +1 @@ +2 diff --git a/makdefs b/makdefs new file mode 100755 index 0000000..f5182df --- /dev/null +++ b/makdefs @@ -0,0 +1,42 @@ +# constructed by wfs using: ./add-defs 386-linux +# constructed by wfs using: ./add-defs 386-linux /usr/local +# constructed by wfs using: ./add-defs 386-linux /usr/local +# constructed by wfs using: ./add-defs 386-linux /usr/local +# constructed by wfs using: ./add-defs 386-linux +# constructed by wfs using: add-defs 386-linux /usr/local/lib +# constructed by wfs using: add-defs 386-linux /usr/local +# constructed by wfs using: ./add-defs 386-linux /usr/local +# constructed by wfs using: add-defs 386-linux /usr/local +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin cygwin +# constructed by wfs using: ./add-defs cygwin cygwin +# constructed by wfs using: ./add-defs cygwin cygwin +# constructed by wfs using: ./add-defs cygwin cygwin +# constructed by wfs using: ./add-defs cygwin cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by wfs using: ./add-defs cygwin +# constructed by using: ./add-defs cygwinb +# constructed by using: ./add-defs cygwinb +# constructed by using: add-defs cygwinb +# constructed by using: ./add-defs cygwinb +# constructed by using: ./add-defs cygwinb +# constructed by using: ./add-defs cygwinb +# constructed by using: ./add-defs cygwinb +# constructed by using: ./add-defs cygwinb +# constructed by using: add-defs cygwinb +# constructed by using: add-defs cygwinb +# constructed by using: ./add-defs gnuwin95 +# constructed by using: ./add-defs gnuwin95 +# constructed by using: ./add-defs gnuwin95 +# constructed by using: add-defs gnuwin95 +# constructed by using: ./add-defs gnuwin95 +# constructed by wfs using: ./add-defs 386-linux +# constructed by wfs using: ./add-defs 386-linux diff --git a/makedefc.in b/makedefc.in new file mode 100644 index 0000000..4570d09 --- /dev/null +++ b/makedefc.in @@ -0,0 +1,72 @@ + +# begin makedefs + +# use=@use@ + +# for main link of raw_gcl +LIBS=@LIBS@ + +# root for the installation, eg /usr/local +# This would cause make install to create /usr/local/bin/gcl and +# /usr/local/lib/gcl-2-??/* with some basic files. +prefix=@prefix@ + +# where to place the info files +INFO_DIR=@INFO_DIR@ + +# where to put emacs lisp files. +EMACS_SITE_LISP=@EMACS_SITE_LISP@ + +# the default.el file +EMACS_DEFAULT_EL=@EMACS_DEFAULT_EL@ + +# numerous TCL/TK variables culled from the tkConfig.sh and tclConfig.sh +# if these are found. +TK_CONFIG_PREFIX=@TK_CONFIG_PREFIX@ +TK_LIBRARY=@TK_LIBRARY@ +TCL_LIBRARY=@TCL_LIBRARY@ +TK_XINCLUDES=@TK_XINCLUDES@ +TK_INCLUDE=@TK_INCLUDE@ +TCL_INCLUDE=@TCL_INCLUDE@ +TK_LIB_SPEC=@TK_LIB_SPEC@ +TK_BUILD_LIB_SPEC=@TK_BUILD_LIB_SPEC@ +TK_XLIBSW=@TK_XLIBSW@ +TK_XINCLUDES=@TK_XINCLUDES@ +TCL_LIB_SPEC=@TCL_LIB_SPEC@ +TCL_DL_LIBS=@TCL_DL_LIBS@ +TCL_LIBS=@TCL_LIBS@ + +PRELINK_CHECK=@PRELINK_CHECK@ + + +NOTIFY=@NOTIFY@ +CC=@CC@ +GCL_CC=@GCL_CC@ +CFLAGS=@CFLAGS@ +LDFLAGS=@LDFLAGS@ +FINAL_CFLAGS=@FINAL_CFLAGS@ +NIFLAGS=@NIFLAGS@ +O3FLAGS=@O3FLAGS@ +O2FLAGS=@O2FLAGS@ + +RL_OBJS=@RL_OBJS@ + +RL_LIB=@RL_LIB@ + +MAKEINFO=@MAKEINFO@ + +FLISP=@FLISP@ +SYSTEM=@SYSTEM@ +BUILD_BFD=@BUILD_BFD@ +GMPDIR=@GMPDIR@ +X_LIBS=@X_LIBS@ +X_CFLAGS=@X_CFLAGS@ + +PROCESSOR_FLAGS=@PROCESSOR_FLAGS@ + +EXTRA_LOBJS=@EXTRA_LOBJS@ +LEADING_UNDERSCORE=@LEADING_UNDERSCORE@ +GNU_LD=@GNU_LD@ +AWK=@AWK@ +LIBBFD=@LIBBFD@ +LIBIBERTY=@LIBIBERTY@ diff --git a/makefile b/makefile new file mode 100644 index 0000000..77ddbf0 --- /dev/null +++ b/makefile @@ -0,0 +1,298 @@ +# Compiling gcl: +# ./configure +# make +# For more details see the file readme + +prefix=/usr/local +# This would cause make install to create /usr/local/bin/gcl and +# /usr/local/lib/gcl-x.yy/* with some basic files. +# This prefix may be overridden e.g. with +# ./configure --prefix=/usr/share + +# Allow platform defs file to override this. +TK_LISP_LIB=gcl-tk/tkl.o gcl-tk/tinfo.o gcl-tk/decode.tcl gcl-tk/demos/*.lsp gcl-tk/demos/*.lisp gcl-tk/demos/*.o +TCL_EXES=gcl-tk/gcl.tcl gcl-tk/gcltkaux$(EXE) + +GCL_DVI=gcl-tk.dvi gcl-si.dvi gcl.dvi +GCL_HTML=gcl-si_toc.html gcl-tk_toc.html gcl_toc.html + +-include makedefs + + +BINDIR = bin +HDIR = h/ +CDIR = c +ODIR = o +LSPDIR = lsp +CMPDIR = cmpnew +PORTDIR = unixport +CLCSDIR = clcs +PCLDIR = pcl +MPDIR = mp +TESTDIR = ansi-tests +#GMP_DIR = gmp3/ + +VERSION=`cat majvers`.`cat minvers` + +all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk release do-info + +ASRC:=$(shell ls -1 o/*.c lsp/*.lsp cmpnew/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h +TAGS: $(ASRC) + etags --regex='/\#.`(defun[ \n\t]+\([^ \n\t]+\)/' $^ + +system: $(PORTDIR)/$(FLISP) +# [ "$(X_LIBS)" == "" ] || (cd xgcl-2 && make saved_xgcl LISP=../$< && mv saved_xgcl ../$(PORTDIR)/$(FLISP)) + touch $@ + +release: majvers minvers + date >$@ + +xgcl: $(PORTDIR)/saved_xgcl + +$(PORTDIR)/saved_xgcl: $(PORTDIR)/saved_gcl + cd xgcl-2 && $(MAKE) + +#binutils/intl/libintl.a: +# cd $(@D) && $(MAKE) + +#binutils/bfd/libbfd.a binutils/libiberty/libiberty.a: binutils/intl/libintl.a +# cd $(@D) && $(MAKE) + +copy_iberty: $(LIBIBERTY) + mkdir -p binutils/libiberty && cd binutils/libiberty && ar x $< + +copy_bfd: $(LIBBFD) copy_iberty + mkdir -p binutils/bfd && cd binutils/bfd && ar x $< + +#h/bfd.h: binutils/bfd/libbfd.a binutils/libiberty/libiberty.a +# cp $(&1 |tee $(@F) & j=$$! ; \ + tail -f --pid=$$j --retry $@ & wait $$j + +#$(PCLDIR)/saved_gcl_pcl: $(PORTDIR)/saved_gcl +# cd $(@D) && $(MAKE) compile LISP="../$<" && $(MAKE) $(@F) LISP="../$<" + +#$(CLCSDIR)/saved_full_gcl: $(PCLDIR)/saved_gcl_pcl +# cd $(@D) && $(MAKE) compile LISP="../$<" && $(MAKE) $(@F) LISP="../$<" + +#$(PORTDIR)/saved_ansi_gcl: $(CLCSDIR)/saved_full_gcl +# cd $(@D) && $(MAKE) $(@F) + +cmpnew/gcl_collectfn.o lsp/gcl_info.o: + cd $(@D) && $(MAKE) $(@F) + +do-gcl-tk: + if [ -d "$(TK_CONFIG_PREFIX)" ] ; then \ + cd gcl-tk && $(MAKE) ; \ + else \ + echo "gcl-tk not made..missing include or lib" ; \ + fi + +do-info: + cd info && $(MAKE) + +mpfiles: $(MPFILES) + +$(MPDIR)/libmport.a: + (cd mp ; $(MAKE) all) + +$(GMPDIR)/libgmp.a: $(GMPDIR)/Makefile + cd $(GMPDIR) && $(MAKE) && rm -f libgmp.a && ar qc libgmp.a *.o */*.o + +PWD_CMD?=pwd + +gmp_all: $(GMPDIR)/Makefile + cd $(GMPDIR) && echo '#include ' >> gmp.h && echo "#include \"`$(PWD_CMD)`/../h/prelink.h\"" >> gmp.h && $(MAKE) + touch $@ + +$(GMPDIR)/mpn/mul_n.o $(GMPDIR)/mpn/lshift.o $(GMPDIR)/mpn/rshift.o: $(GMPDIR)/Makefile + cd $(@D) && $(MAKE) $(@F) + +command: + rm -f bin/gcl xbin/gcl + MGCLDIR=`echo $(GCLDIR) | sed -e 'sX^\([a-z]\):X/\1Xg'` ; \ + GCLDIR=`echo $(GCLDIR)` ; \ + $(MAKE) install-command "INSTALL_LIB_DIR=$$GCLDIR" "prefix=$$GCLDIR" "BINDIR=$$MGCLDIR/$(PORTDIR)" + (cd xbin ; cp ../bin/gcl .) + +# GCLDIR=`echo $(GCLDIR) | sed -e 'sX^/cygdrive/\([a-z]\)X\1!Xg' -e 'sX^//\([a-z]\)X\1!Xg'` ; \ + +merge: + $(CC) -o merge merge.c + +LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/package.lisp pcl/package.lisp clcs/package.lisp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew xgcl-2 pcl clcs) unixport/gcl.script + +install-command: + rm -f $(DESTDIR)$(prefix)/bin/gcl + (echo '#!/bin/sh' ; \ + echo exec $(BINDIR)/$(FLISP)$(EXE) \\ ; \ + echo ' -dir' $(INSTALL_LIB_DIR)/unixport/ \\ ; \ + echo ' -libdir' $(INSTALL_LIB_DIR)/ \\ ; \ + echo ' -eval '\''(setq si::*allow-gzipped-file* t)'\' \\ ;\ + ! [ -d "$(TK_CONFIG_PREFIX)" ] || echo ' -eval '\''(setq si::*tk-library* '\"$(TK_LIBRARY)\"')'\' \\;\ + echo ' '\"\$$@\" ) > $(DESTDIR)$(prefix)/bin/gcl; + echo '#' other options: -load "/tmp/foo.o" -load "jo.lsp" -eval '"(joe 3)"' >> $(DESTDIR)$(prefix)/bin/gcl + chmod a+x $(DESTDIR)$(prefix)/bin/gcl + rm -f $(DESTDIR)$(prefix)/bin/gclm.bat + if gcc --version | grep mingw >/dev/null 2>&1 ; then (echo '@SET cd='; \ + echo '@SET promp$=%prompt%'; \ + echo '@PROMPT SET cd$Q$P'; \ + echo '@CALL>%temp%.\setdir.bat'; \ + echo '@'; \ + echo '% do not delete this line %'; \ + echo '@ECHO off'; \ + echo 'PROMPT %promp$%'; \ + echo 'FOR %%c IN (CALL DEL) DO %%c %temp%.\setdir.bat'; \ + echo 'set cwd=%cd%'; \ + echo 'set libdir=%cd%\..\lib\gcl-$(VERSION)'; \ + echo 'set unixportdir=%libdir%\unixport'; \ + echo 'path %cd%\..\mingw\bin;%PATH%'; \ + echo "start %unixportdir%\$(FLISP).exe -dir %unixportdir% -libdir %libdir% -eval \"(setq si::*allow-gzipped-file* t)\" %1 %2 %3 %4 %5 %6 %7 %8 %9" ) > $(DESTDIR)$(prefix)/bin/gclm.bat ; fi + rm -f $(DESTDIR)$(prefix)/bin/gclfinal.bat + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then (echo 'ECHO path %1\mingw\bin;%PATH% > gcli.bat'; \ + echo "ECHO start %1\lib\gcl-$(VERSION)\unixport\$(FLISP).exe -dir %1\lib\gcl-$(VERSION)\unixport -libdir %1\lib\gcl-$(VERSION) -eval \"(setq si::*allow-gzipped-file* t)\" %1 %2 %3 %4 %5 %6 %7 %8 %9 >> gcli.bat" ) > $(DESTDIR)$(prefix)/bin/gclfinal.bat ; fi + +install: + $(MAKE) install1 "INSTALL_LIB_DIR=$(prefix)/lib/gcl-`cat majvers`.`cat minvers`" "prefix=$(prefix)" "DESTDIR=$(DESTDIR)" +INSTALL_LIB_DIR= +install1: + mkdir -p $(DESTDIR)$(prefix)/lib + mkdir -p $(DESTDIR)$(prefix)/bin + mkdir -p $(DESTDIR)$(prefix)/share + cp -a man $(DESTDIR)$(prefix)/share/ + mkdir -p $(DESTDIR)$(INSTALL_LIB_DIR) + MINSTALL_LIB_DIR=`echo $(INSTALL_LIB_DIR) | sed -e 'sX^\([a-z]\):X/\1Xg'` ; \ + $(MAKE) install-command "INSTALL_LIB_DIR=$(INSTALL_LIB_DIR)" "prefix=$(prefix)" "DESTDIR=$(DESTDIR)" "BINDIR=$$MINSTALL_LIB_DIR/unixport" + rm -f $(DESTDIR)$(prefix)/bin/gcl.exe + tar cf - $(PORTDIR)/$(FLISP)$(EXE) info/*.info* $(LISP_LIB) \ + $(TCL_EXES) | (cd $(DESTDIR)$(INSTALL_LIB_DIR) ;tar xf -) + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then if grep -i oncrpc makedefs >/dev/null 2>&1 ; then cp /mingw/bin/oncrpc.dll $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR); fi ; fi + cd $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR) && \ + mv $(FLISP)$(EXE) temp$(EXE) && \ + echo '(si::reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ + rm -f temp$(EXE) + if [ -e "unixport/rsym$(EXE)" ] ; then cp unixport/rsym$(EXE) $(DESTDIR)$(INSTALL_LIB_DIR)/unixport/ ; fi +# ln $(SYMB) $(INSTALL_LIB_DIR)/$(PORTDIR)/$(FLISP)$(EXE) \ +# $(DESTDIR)$(prefix)/bin/gcl.exe + if [ -d "$(TK_CONFIG_PREFIX)" ] ; then \ + cat gcl-tk/gcltksrv$(BAT) | \ + sed -e "s!GCL_TK_DIR=.*!GCL_TK_DIR=$(INSTALL_LIB_DIR)/gcl-tk!g" \ + -e "s!TK_LIBRARY=.*!TK_LIBRARY=$(TK_LIBRARY)!g" > \ + $(DESTDIR)$(INSTALL_LIB_DIR)/gcl-tk/gcltksrv$(BAT) ; \ + chmod a+x $(DESTDIR)$(INSTALL_LIB_DIR)/gcl-tk/gcltksrv$(BAT) ; fi +# if [ -d "$(TK_CONFIG_PREFIX)" ] ; then \ +# (cd $(DESTDIR)$(INSTALL_LIB_DIR)/gcl-tk/demos ; \ +# echo '(load "../tkl.o")(TK::GET-AUTOLOADS (directory "*.lisp"))' | ../../$(PORTDIR)/$(FLISP)$(EXE)) ; fi + if test "$(EMACS_SITE_LISP)" != "" ; then (cd elisp ; $(MAKE) install DESTDIR=$(DESTDIR)) ; fi + if test "$(INFO_DIR)" != "unknown"; then (cd info ; $(MAKE) install DESTDIR=$(DESTDIR)) ; fi + if test "$(INFO_DIR)" != "unknown"; then (cd xgcl-2 ; $(MAKE) install DESTDIR=$(DESTDIR)) ; fi + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then cp COPYING.LIB-2.0 readme-bin.mingw $(prefix) ; fi + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then cp gcl.ico $(prefix)/bin ; fi + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then rm -rf $(prefix)/install; mkdir $(prefix)/install ; cp windows/install.lsp $(prefix)/install ; windows/instdos.sh windows/sysdir.bat $(prefix)/bin/sysdir.bat ; fi + -if gcc --version | grep -i mingw >/dev/null 2>&1 ; then rm -rf $(prefix)/doc; mkdir $(prefix)/doc; cp info/*.html $(prefix)/doc ; fi + -if gcc --version | grep -i mingw >/dev/null 2>&1 ; then rm -rf $(prefix)/doc; mkdir $(prefix)/doc; cp -rp info/gcl info/gcl-si info/gcl-tk $(prefix)/doc ; fi + +gclclean: + + (cd $(BINDIR); $(MAKE) clean) + (cd mp ; $(MAKE) clean) + (cd $(ODIR); $(MAKE) clean) + (cd $(LSPDIR); $(MAKE) clean) + (cd $(CMPDIR); $(MAKE) clean) + (cd $(PORTDIR); $(MAKE) clean) + (cd gcl-tk ; $(MAKE) clean) + cd $(CLCSDIR) && $(MAKE) clean + cd $(PCLDIR) && $(MAKE) clean + cd xgcl-2 && $(MAKE) clean + (cd $(TESTDIR); $(MAKE) clean) + (cd info ; $(MAKE) clean) +# find binutils -name "*.o" -exec rm {} \; + rm -rf binutils + rm -f foo.tcl config.log makedefs makedefsafter config.cache config.status makedefc + rm -f h/config.h h/gclincl.h h/cmpinclude.h h/gmp.h + rm -f xbin/gcl foo foo.c bin/gclm.bat gmp_all + rm -f h/*-linux.defs h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h + rm -f windows/gcl.iss bin/gcl.bat windows/gcl.ansi.iss windows/install.ansi.lsp \ + windows/install.lsp windows/sysdir.bat + rm -rf windows/Output + rm -f ansi-tests/test_results ansi-tests/gazonk*lsp + rm -rf autom4te.cache h/mcompdefs.h + rm -f config.log config.cache config.status tmpx $(PORTDIR)/gmon.out gcl.script machine system + +clean: gclclean + -[ -z "$(GMPDIR)" ] || (cd $(GMPDIR) && $(MAKE) distclean) + -[ -z "$(GMPDIR)" ] || rm -rf $(GMPDIR)/.deps $(GMPDIR)/libgmp.a +# -cd binutils/intl && $(MAKE) distclean +# -cd binutils/bfd && $(MAKE) distclean +# -cd binutils/libiberty && $(MAKE) distclean + +CMPINCLUDE_FILES=$(HDIR)cmpincl1.h $(HDIR)gclincl.h $(HDIR)compbas.h $(HDIR)type.h $(HDIR)mgmp.h \ + $(HDIR)lu.h $(HDIR)globals.h $(HDIR)vs.h \ + $(HDIR)bds.h $(HDIR)frame.h \ + $(HDIR)lex.h \ + $(HDIR)compprotos.h $(HDIR)immnum.h + +OTHERS=$(HDIR)notcomp.h $(HDIR)rgbc.h $(HDIR)stacks.h + +$(HDIR)new_decl.h: + (cd o && $(MAKE) ../$@) + +$(HDIR)mcompdefs.h: $(HDIR)compdefs.h $(HDIR)new_decl.h + cat $< |\ + $(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"cmponly.h\"";print "---"} {a=$$1;gsub("\\.\\.\\.","",a);print "\"#define " $$1 "\" " a}' |\ + $(CC) -E -P -I./$(HDIR) - |\ + $(AWK) '/^\-\-\-$$/ {i=1;next} {if (!i) next} {gsub("\"","");print}' >$@ + +$(HDIR)cmpinclude.h: $(HDIR)mcompdefs.h $(CMPINCLUDE_FILES) $(HDIR)config.h + cp $< $(@F) + cat $(CMPINCLUDE_FILES) | $(CC) -E -I./$(HDIR) - | $(AWK) '/^# |^$$|^#pragma/ {next}{print}' >> $(@F) + ./xbin/move-if-changed mv $(@F) $@ + ./xbin/move-if-changed cp $@ o/$(@F) + +go: + mkdir go + (cd go ; cp -s ../o/makefile ../o/*.o ../o/*.c ../o/*.d ../o/*.ini .) + (cd go ; $(MAKE) go) + +tar: + rm -f gcl-`cat majvers`.`cat minvers` + xbin/distribute ../ngcl-`cat majvers`.`cat minvers`-beta.tgz + +configure: configure.in + autoconf configure.in > configure + chmod a+rx configure + +kcp: + (cd go ; $(MAKE) "CFLAGS = -I../h -pg -c -g ") + (cd unixport ; $(MAKE) gcp) + +.INTERMEDIATE: $(HDIR)mcompdefs.h diff --git a/man/man1/gcl.1 b/man/man1/gcl.1 new file mode 100755 index 0000000..7a086c5 --- /dev/null +++ b/man/man1/gcl.1 @@ -0,0 +1,248 @@ +.TH GCL 1L "17 March 1997" +.SH NAME +gcl \- GCL Common Lisp interpreter/compiler, CVS snapshot +.SH SYNOPSIS +.B gcl +[ +.B options +] + +.SH DESCRIPTION + +The program +.I gcl +is an implementation of a subset of the Common Lisp Ansi standard. +It is written in C and in Common Lisp, and is highly portable. It +includes those features in the original definition of Common Lisp, +(Guy Steele version 1.), as well as some features from the proposed +new standard. +.LP +The best documentation is available in +.I texinfo/info +form, with there being three groups of information. +.I gcl\-si +for basic common lisp descriptions, and features unique to +.I gcl +The +.I gcl\-tk +info refers to the connection with +.I tk +window system, allowing all the power of the +.I tcl/tk +interaction system to be used from lisp. +The third info file +.I gcl +details the Ansi standard for common lisp, to which this subset +tries to adhere. It is highly recommended to write programs, +which will be in the intersection of gcl and ansi common lisp. +Unfortunately the Ansi standard is huge, and will require a substantial +effort, and increase in the size of gcl, to include all of it. +.LP +When +.I gcl +is invoked from the shell, the variable +.I si::*command\-args* +is set to the list of command line arguments. +Various +.I options +are understood: +.TP +.BR \-eval\ command +.RB +Call read and then eval on the +.I command passed in. +.TP +.B \-\- +.RB +Stop processing arguments, setting si::*command\-args* to a list +containing the arguments after the +.BR \-\- . +.TP +.BR \-load\ pathname +.RB +Load the file whose +.I pathname +is specified after +.BR \-load . +.TP +.BR \-f +.RB +Open the file following +.BR \-f +for input, skip the first line, and +then read and eval the rest of the forms in the file. +Replaces si::*command\-args* by the the list starting after +.BR \-f . +This can be used as with the shells to write small shell programs: + +.LP +.br +#!/usr/local/bin/gcl.exe \-f +.br +(format t "hello world ~a~%" (nth 1 si::*command\-args*)) + +.BR +The value +.I si::*command\-args* +will have the appropriate value. +Thus if the above 2 line file is made executable and called +.I foo +then + +.LP +.LP +.br +tutorial% foo billy +.br +hello world billy + +.BR +NOTE: On many systems (eg SunOs) the first line of an executable +script file such as: +.BR +#!/usr/local/bin/gcl.exe \-f +only reads the first 32 characters! So if your pathname where +the executable together with the '\-f' amount to more than 32 +characters the file will not be recognized. Also the executable +must be the actual large binary file, [or a link to it], and not +just a +.I /bin/sh +script. In latter case the +.I /bin/sh +interpreter would get invoked on the file. + +Alternately one could invoke the file +.I foo +without making it +executable: +.LP +.LP +.br +tutorial% gcl \-f foo "from bill" +.br +hello world from bill + +.TP +.B \-batch +.RB +Do not enter the command print loop. Useful if the other command +line arguments do something. Do not print the License and +acknowledgement information. Note if your program does print any +License information, it must print the GCL header information also. + +.TP +.B \-dir +.RB +Directory where the executable binary that is running is located. +Needed by save and friends. This gets set as +si::*system\-directory* + +.TP +.B \-libdir +.RB +.BR \-libdir +.I /d/wfs/gcl\-2.0/ +.RB + +would mean that the files like gcl\-tk/tk.o would be found by +concatting the path to the libdir path, ie in +.RB /d/wfs/gcl\-2.0/gcl\-tk/tk.o + +.TP +.B \-compile +.RB +Invoke the compiler on the filename following +.BR \-compile +. +Other flags affect compilation. + +.TP +.B \-o\-file +.RB +If nil follows +.BR \-o\-file +then do not produce an +.I .o +file. + +.TP +.B \-c\-file +.RB +If +.BR \-c\-file +is specified, leave the intermediate +.I .c +file there. + +.TP +.B \-h\-file +.RB If +.BR \-h\-file +is specified, leave the intermediate +.I .h +file there. + +.TP +.B \-data\-file +.RB If +.BR \-data\-file +is specified, leave the intermediate +.I .data +file +there. + +.TP +.B \-system\-p +.RB If +.BR \-system\-p +is specified then invoke +.I compile\-file +with the +.I :system\-p t +keyword argument, meaning that the C init function +will bear a name based on the name of the file, so that it may be +invoked by name by C code. + +This GNU package should not be confused with the proprietary program +distributed by FRANZ, Inc. Nor should it be confused with any public +domain or proprietary lisp system. + +For anything other than program development, use of the lisp compiler +is strongly recommended in preference to use of the interpreter, due +to much higher speed. +.\".LP +.\"This program may be used in conjunction with the UCSF +.\".I batchqueue +.\"system. +.\".SH "LOCAL ACCESS" +.\"Locally, access to all LISP systems is made through a shared +.\"interactive front\-end which assumes that the job is be run in batch mode +.\"unless the \fB\-i\fP option is activated, which starts an interactive session. +.\"Interactive sessions are limited to 30 cpu minutes. +.SH FILES +.TP +\fI/usr/bin/gcl +executable shell script wrapper +.TP +\fI/usr/lib/gcl\-version/unixport/saved[_flavor]_gcl +executable lisp images +.SH "SEE ALSO" +.sp +\fICommon LISP: The Language\fP, Guy L. Steele, Jr., Digital Press, Bedford, MA, +1984. +.sp +\fICommon LISPcraft\fP, Robert Wilensky, W. W. Norton & Co., New York, 1984. +.SH AUTHORS + +The GCL system contains C and Lisp source files to build a Common Lisp +system. +CGL is derived from Kyoto Common LISP (\fIkcl\fP), +which was written in 1984 by T. Yuasa and M. Hagiya +(working under Professor R. Nakajima at the Research +Institute for Mathematical Sciences, Kyoto University). +The AKCL system work was begun in 1987 by +William Schelter at the University of Texas, Austin, and continued through 1994. +In 1994 AKCL was released as GCL (GNU Common Lisp) under the +GNU public library license. +.\" + diff --git a/merge.c b/merge.c new file mode 100755 index 0000000..cf77a0c --- /dev/null +++ b/merge.c @@ -0,0 +1,450 @@ +/* Copyright William F. Schelter, University of Texas 1987 */ + +/* This file may be copied by anyone, but changes may not +be made without permission of the author. The author hopes it will be +useful but cannot assume any responsibility for its use or problems +caused by its use. The program is provided as is. */ + +/* The program takes two files file1 = orig and file2 = orig.V + +tutorial% merge orig orig.V > foo + +and copies orig according to the recipe in orig.V. The advantage of +this program is that it does this according to the context of orig. +Thus even though orig might change slightly (eg some one added an +extra line to the copyright notice), the same change file will +probably still be valid. + +If the first argument is - then the orig is standard input. +If a third argument is supplied, it is the name of a file to use +instead of standard output. + + +tutorial% merge orig orig.V | merge - change2 final + +would take the result of merge of orig and orig.V and use it to merge +with change2 to produce the file final. + + +The format of a change (.V) file is very simple: There is only ONE +type of command in a change file. REPLACE X by Y. Here X represents +a chunk of text in the orig file, and Y the substitution which you +wish to make for this occurrence. The Y appears explicitly in the +change file, while the text X may be specified fully and explicitly, +OR by giving sufficient context from the beginning and end of X. Thus +in general it takes three things to specify a change. The beginning +of X (Xbegin), the end of X (Xend), and all of Y. These three pieces +of text are separated by four delimiters. The delimiters are not +single characters, but rather sequences of four characters. This is +done so as to avoid having to quote the delimiter (see QUOTING below). +The delimiters are "\n@s[" "\n@s," "\n@s|" and "\n@s]". +NOTE: The \n (Newline) Character IS PART OF THE DELIMITER in ALL CASES. + +@s[X +@s|Y +@s] + +Thus in the above case the X text is only "X" it does not have any +newlines in it! They belong to the delimiters. For "X\n" we would see + + +@s[X + +@s|Y +@s] + + +The general case where X is a very long chunk of text, or perhaps something +sensitive to copyright, so that you cannot include several pages, you +could make Xbegin be the first few lines, and Xend the last few lines. +All intervening lines (including the Xbegin and the Xend, would be ripped +out, and replaced by Y. + +@s[Xbegin +@s,Xend +@s|Y +@s] + + +One cycle of the merge may be thought of as: +The merge program looks in the change (.V) file for the next \ns[, +in order to determine the next values for Xbegin,Xend,and Y. +Having determined these, its position in the (.V) file will have +advanced to after the \n@s]. + +The merge program then starts at its current position in the original +file and searches for the next occurrence of Xbegin, marking its +beginning, then for the end of Xend. The inclusive interval so +marked, is deleted and Y is substituted. The current position in the +original file is now at the end of the Xend text. The next Xbegin +text must occur after that point. Only one pass is made through the +files. + +It is an error if the start of Xend does not follow +the end of Xbegin. Thus Xbegin and Xend may NOT overlap. A common +case will be that Xbegin is the entire interval and Xend = "" +In this case the merge program, if it finds \n@s| before \n@s, +will assume you want Xend="". + +EXAMPLES: + +@s[Hi bill +@s, +@s|new body +@s] + +would delete the string "Hi bill" replacing it with "new body" +Xbegin="Hi bill" +Xend="" +Interval = "Hi bill" +Equivalently since the E interval is empty, we could have just +omitted the \@s, + +@s[Hi bill +@s|new body +@s] + + +Example of change file with two changes: +**************** + +@s[(defmacro lcase (item &body body) +@s, (setq v (car rest)) +@s|(defmacro lcase (items &body body) + (setq v (cadr rest)) +@s] + +Comments are allowed in change files. In fact anything not between +matching "\ns[" and "\ns]" is a comment. + + +@s[How is he +@s, +He is fine. +@s|He is sick. +@s] + +******* +end of change file + +The first change would replace the interval of the original file +"(defmacro.... (setq v (car rest))" +by +"(defmacro lcase (items &body body) + (setq v (cadr rest))" + +If the program could not find the interval "(defmacro.... (setq v +(car rest))" in the orignal file it would warn you. + +The intervals in the change file, must occur in the same order as in +the original file. There is an emacs program merge.el which can +mechanically produce a changes file from an original and an edited +version. + +Note: For convenience we pretend that the change file starts with +a new line, even if it does not. Thus if @s[ are the first three +characters of the file and CHSTART1 = \n@s[, we count this as a +CHSTART1. Since it is in the first column, it "appears" to have +the new line there. + + +QUOTING: + +In order to have a change which involves one of the four letter +delimiters given above, we use the convention that "\n@@" in the first +column translates to "\n@". You need not perform this quoting of @ +unless the merger would be confused. For example \n@(defun .. would +be ok, since this can't be mistaken for one of our delimiters. +Nonetheless \n@@(defun or \n@@s[ would translate to have one @ sign, +in the merge output. The reason for not doubling all @ signs, is that +it is very easy to scan (visually) a change you are constructing, to +see that there are no @ signs in the first column, or at least none +which could be confused for the four letter change delimiters +"\n@s[","\n@s," ... A poor human constructing a change (.V) file +should not have to sort through the X or Y text adding quoting +characters. + +Note on length: Y may be any length, but Xbegin or Xend, may only be +CONTEXT_LIMIT long. + +*/ + + + + + + + + + + +/****************** THE CODE ********************/ + + +#include + + +#define CONTEXT_LIMIT 3000 /* size of the longest delimiter or replacement */ + +char *malloc(); +void copy_rest(); +char ssearch_for_string(); + +#define NULL_OUT (FILE *)0 + +#define CHSTART1 "\n@s[" +#define CHSTART2 "\n@s," +#define CHSTART3 "\n@s|" +#define CHSTART4 "\n@s]" +#define ACCEPT ",|" +#define NOACCEPT (char *) 0 +#define NUL '\0' +#define TRUE 1 +#define FALSE 0 +#define eofch(ch) ((unsigned char)ch == (unsigned char) EOF) + +char filenames[600]; + +#define myerror(string,arg) {(void)fprintf(stderr,string,arg); exit(-1);} + +main(argc,argv) +int argc; +char *argv[]; +{FILE *orig,*changes,*out; + char *context,*endcontext; + char *origname,*altername,*outname; + char found; + context=malloc(CONTEXT_LIMIT+2); + endcontext=malloc(CONTEXT_LIMIT+2); + + outname=(char *)0; + + if (argc==1) + {int tem; + origname=filenames; altername=filenames+200; outname=filenames+400; + /* get names from stdin */ + if (tem=scanf("%s %s %s",origname,altername,outname)); + else myerror("Three args weren't supplied: scanf returned %d\n",tem); + } + else{ if (!((argc==3) || (argc==4))) + { myerror("Usage: merge file-orig file-changes [out-file]\n %d args given",argc-1);} + else + { origname=argv[1]; + altername=argv[2]; + if (argc >= 4) outname=argv[3];}}; + + +/* now we have the names either from command or stdin, so open files */ + +if(origname[0]=='-' && origname[1]==NULL) + orig=stdin; + else{ + orig=fopen(origname,"r"); + if (!orig) {perror(origname); exit(-1);}; +} + + changes=fopen(altername,"r"); + if (!changes) {perror(origname); exit(-1);}; + if (outname) + {out=fopen(outname,"w"); + if (out); else {perror(outname); exit(-1);}} + else out=stdout; + +/* check if the file starts with chstart1 - newline. to avoid +people thinking that starting file with @s[ is ok. */ + {char *str = CHSTART1; + int ch; + while(*(++str)) /* skip the newline start */ + { (ch=getc(changes)); + if (ch == *str) ; + else + { ungetc(ch,changes); goto not_found;} + } + goto got_one; + not_found:;} + + {while(search_for_string(changes,CHSTART1,NULL_OUT,FALSE) > 0) + { got_one: + if (found= + ssearch_for_string(changes,CHSTART2,context,CONTEXT_LIMIT,TRUE, + ACCEPT)); + else + {myerror("\nNo end for start change context in change file:\n`%s'\n",context);}; + if (found==ACCEPT[1]) + *endcontext=NUL; + else + { + if /* there is probably a non null endcontext */ + (ssearch_for_string(changes,CHSTART3,endcontext, + CONTEXT_LIMIT,TRUE,NOACCEPT)); + else + {myerror("No %s at beginning of line to denote end of change context", + CHSTART3);}}; +/* skip in orig down to the end of the context,copying thru begin context */ + if (search_for_string(orig,context,out,FALSE)>0); + else{myerror("\nCould not find the change start in original:\n`%s'\n" + ,context);}; + if /* copy out the changed version */ + (search_for_string(changes,CHSTART4,out,TRUE)>0); + else + {myerror("No %s at beginning of line to denote end of change context", + CHSTART4);}; + +/*finish skipping over the region to be deleted in orig */ + {if( search_for_string(orig,endcontext,NULL_OUT,FALSE) > 0); + else + {myerror("\nCould not find the end of the change in original:\n`%s'\n", + endcontext);}} + } + copy_rest(orig,out); + return 0; + }} + + +string_match(sta,stb) +char *sta, *stb; +{while(*sta!=0) + {if (*(sta++) != *(stb++)) return 0;} + if (*stb==0) return 1; else return 0; + } + +void +copy_rest(file,out) +FILE *file,*out; +{register int ch; +while(1) + { + ch=getc(file); + if (eofch(ch) && feof(file)) break; + putc(ch,out);}} + +/* advance file to end of first occurrence of string, copying to out +until the beginning of string */ + +#define USE_UNQUOTE 1 + +search_for_string(file,string,out,unquoting) +FILE *file,*out; +char *string; +int unquoting; +{int result; + result=search_for_string1(file,string,out,USE_UNQUOTE && unquoting); + return result;} + + +char *nxt,*lim,*ungetlim,*bp; +char buffer[CONTEXT_LIMIT]; + +/* +void +myungetc(ch) +char ch; +{*bp++ = ch;} + +char +mygetc(file) +FILE *file; +{char x=((bp==buffer)? getc(file) : *--bp); + return x; +} +*/ + +#define mygetc(file) ((bp==buffer)? getc(file) : *--bp) +#define myungetc(ch) *bp++ = ch + +search_for_string1(file,string,out,unquoting) +FILE *file,*out; +char *string; +int unquoting; +{ /* char *nxt,*lim; */ + char *s; + int ch; + nxt=lim=(char *)0; + bp=buffer; + if (*string==NUL) return 1; unquoting; + while(1) + {begin: + ch=mygetc(file); + if ((eofch(ch)) &&(feof(file))) return 0; + if( ch==*string) + { /* loop for checking */ + s = string; + while(*(++s)!=0) + {(ch=mygetc(file)); + if (eofch(ch) && feof(file)) + {char *cp=string;while (cp++<=s) + {putc(*cp,file) ; return 0;}}; + if (*s!=ch) + { if (out) putc(*string,out); + {char *cp=s; + if (!(unquoting && ch==string[1] && (s-string ==2))) + myungetc(ch); + while (--cp > string) + myungetc(*cp); + goto begin;}} + } + return 1; + /* printf(""); */ + } + else if (out) putc(ch,out);}; + } + + + +#define PUTC(ch,out) {if(ind++ < outlim) ((*(out++))=(ch));\ + else return -1;} + +char +ssearch_for_string1(file,string,out,outlim,unquoting,accept) +int outlim,unquoting; +FILE *file; +char *out; +char *string,*accept; +{register int ch; + char *s; int ind=0; + if (*string==NUL) return 'a'; + while(1) + {ch = getc(file); + begin: + if (feof(file)) return (char) 0; + if (ch==(*string)) + {s=string; ind=0; + while(*(++s)!=0) + {if ((*s==(ch=getc(file))) + || (accept && *s==*accept && ch == *(accept+1))); + else + {if (out) + {char *cp; cp=string; + if (unquoting && ch==string[1] && (s-string ==2)) s--; + while (cp!=s) + {PUTC(*cp,out);cp++;} + } + break;}} + if(*s==0) + {PUTC(((char) 0),out); + /* found a match */ + return(ch);} + else goto begin;} + else if (out) PUTC(ch,out); + } +} + +char +ssearch_for_string(file,string,out1,outlim,unquoting,accept) +int outlim; +FILE *file; +char *out1; +char *string,*accept; +int unquoting; +{char result; + result=ssearch_for_string1(file,string,out1,outlim,unquoting,accept); + return result;} + +/* +* +* To do: +* 1)The buffering for mygetc could be more efficient (in local variable). +* 2)Eliminate the double function calls used during debugging. +* 3)Improve error message, for help in finding context if a change +* is not found. +*/ diff --git a/minvers b/minvers new file mode 100755 index 0000000..cea7a6e --- /dev/null +++ b/minvers @@ -0,0 +1 @@ +6.13 diff --git a/misc/check.c b/misc/check.c new file mode 100755 index 0000000..09a97ca --- /dev/null +++ b/misc/check.c @@ -0,0 +1,45 @@ +#include "include.h" + + +#define CHECK(a,b)\ +do{ i++; if (((void *) a) != (void *) b) printf("differed %d %d\n",i, (long ) a - (long) b);}while(0) + + + +main() +{object x; + int i=0; +/* 1 2 */ +CHECK(&x->s.s_sfdef,&x->c.c_car); +CHECK(&x->s.s_dbind,&x->c.c_cdr); + +/* 3 4 5 6 */ +CHECK(&x->s.s_fillp,&x->ust.ust_fillp); +CHECK(&x->v.v_fillp,&x->ust.ust_fillp); +CHECK(&x->st.st_fillp,&x->ust.ust_fillp); +CHECK(&x->bv.bv_fillp,&x->ust.ust_fillp); + +/* 7 8 9 10 11 12 */ +CHECK(&x->st.st_dim,&x->ust.ust_dim); +CHECK(&x->v.v_dim,&x->ust.ust_dim); +CHECK(&x->bv.bv_dim,&x->ust.ust_dim); +CHECK(&x->a.a_dim,&x->ust.ust_dim); +CHECK(&x->lfa.lfa_dim,&x->ust.ust_dim); +CHECK(&x->sfa.sfa_dim,&x->ust.ust_dim); +CHECK(&x->fixa.fixa_dim,&x->ust.ust_dim); + +CHECK(&x->st.st_self,&x->ust.ust_self); +CHECK(&x->v.v_self,&x->ust.ust_self); +CHECK(&x->bv.bv_self,&x->ust.ust_self); +CHECK(&x->a.a_self,&x->ust.ust_self); +CHECK(&x->lfa.lfa_self,&x->ust.ust_self); +CHECK(&x->sfa.sfa_self,&x->ust.ust_self); +CHECK(&x->fixa.fixa_self,&x->ust.ust_self); +CHECK(&x->s.s_self,&x->ust.ust_self); + +CHECK(&x->v.v_elttype,&x->a.a_elttype); + + +} + + diff --git a/misc/check_obj.c b/misc/check_obj.c new file mode 100755 index 0000000..eef77cc --- /dev/null +++ b/misc/check_obj.c @@ -0,0 +1,14 @@ + +#include "include.h" +#define CHECK(a,b) \ +do{ i++; if ((void *) a != (void *) b) printf("differed %d\n",i);}while(0) + +main() +{object x; + int i=0; +CHECK(&x->s.s_self,&x->ust.ust_self); +CHECK(&x->s.s_fillp,&x->ust.ust_fillp); +CHECK(&x->v.v_fillp,&x->ust.ust_fillp); +CHECK(&x->v.v_dim,&x->ust.ust_dim); +CHECK(&x->cfn.,&x->ust.ust_dim); +} diff --git a/misc/cstruct.lsp b/misc/cstruct.lsp new file mode 100755 index 0000000..222d7b1 --- /dev/null +++ b/misc/cstruct.lsp @@ -0,0 +1,157 @@ +;; Sample usage: Create lisp defstructs corresponding to C structures: +(use-package "SLOOP") +;; How to: Create a file foo.c which contains just structures +;; and possibly some externs. +;; cc -E /tmp/foo1.c > /tmp/fo2.c +;; ../xbin/strip-ifdef /tmp/fo2.c > /tmp/fo3.c +;; then (parse-file "/tmp/fo3.c") +;; will return a list of defstructs and appropriate slot offsets. + + +(defun white-space (ch) (member ch '(#\space #\linefeed #\return #\newline #\tab))) + +(defvar *eof* (code-char 255)) +(defun delimiter(ch) (or (white-space ch) + (member ch '(#\, #\; #\{ #\} #\*)))) +(defun next-char (st) + (let ((char (read-char st nil *eof*))) + + (case char + (#\{ char) + ( + #\/ (cond ((eql (peek-char nil st nil) #\*) + (read-char st) + (sloop when (eql (read-char st) #\*) + do (cond ((eql (read-char st) #\/ ) + (return-from next-char (next-char st)))))) + (t char))) + ((#\tab #\linefeed #\return #\newline ) + (cond ((member (peek-char nil st nil) '(#\space #\tab #\linefeed #\return #\newline )) + (return-from next-char (next-char st)))) + #\space) + (t char)))) + +(defun get-token (st &aux tem) + (sloop while (white-space (peek-char nil st nil)) + do (read-char st)) + (cond ((member (setq tem (peek-char nil st nil)) '(#\, #\; #\* #\{ #\} )) + (return-from get-token (coerce (list (next-char st)) 'string)))) + (sloop with x = (make-array 10 :element-type 'character :fill-pointer 0 + :adjustable t) + when (delimiter (setq tem (next-char st))) + do (cond ((> (length x) 0) + (or (white-space tem) (unread-char tem st)) + (return x))) + else + do + (cond ((eql tem *eof*) (return *eof*)) + (t (vector-push-extend tem x))))) +(defvar *parse-list* nil) +(defvar *structs* nil) +(defun parse-file (fi &optional *structs*) + (with-open-file (st fi) + (let ((*parse-list* + (sloop while (not (eql *eof* (setq tem (get-token st)))) + collect (intern tem)))) + (print *parse-list*) + (let ((structs + (sloop while (setq tem (parse-struct)) + do (push tem *structs*) + collect tem))) + (get-sizes fi structs) + (with-open-file (st "gaz3.lsp") + (prog1 + (list structs (read st)) + (delete-file "gaz3.lsp"))))))) + + + + + +(defparameter *type-alist* '((|short| . signed-short) + (|unsigned short| . unsigned-short) + (|char| . signed-char) + (|unsigned char| . unsigned-char) + (|int| . fixnum) + (|long| . fixnum) + (|object| . t))) + + +(defun parse-type( &aux top) + (setq top (pop *parse-list*)) + (cond ((member top '(|unsigned| |signed|)) + (push (intern (format nil "~a-~a" (pop *parse-list*))) *parse-list*) + (parse-type)) + ((eq '* (car *parse-list*)) (pop *parse-list*) 'fixnum) + ((eq top '|struct|) + (prog1 + (cond ((car (member (car *parse-list*) *STRUCTS* :key 'cadr))) + (t (error "unknown struct ~a " (car *parse-list*)))) + (pop *parse-list*) + )) + ((cdr (assoc top *type-alist*))) + (t (error "unknown type ~a " top)))) +(defun expect (x) (or (eql (car *parse-list*) x) + (error "expected ~a at beginning of ~s" x *parse-list*)) + (pop *parse-list*)) +(defun parse-field ( &aux tem) + (cond ((eql (car *parse-list*) '|}|) + (pop *parse-list*) + (expect '|;|) + nil) + (t + (let ((type (parse-type))) + + (sloop until (eql (setq tem (pop *parse-list*)) '|;|) + append (get-field tem type) + + do (or (eq (car *parse-list*) '|;|) (expect '|,|))))))) +(deftype pointer () `(integer ,most-negative-fixnum most-positive-fixnum)) +(defun get-field (name type) + (cond ((eq name '|*|)(get-field (pop *parse-list*) 'pointer)) + ((and (consp type) (eq (car type) 'defstruct)) + (sloop for w in (cddr type) + append (get-field + (intern (format nil "~a.~a" name (car w))) + (fourth w)))) + (t + `((,name ,(if (eq type t) nil 0) :type ,type))))) + +(defun parse-struct () + (cond ((null *parse-list*) (return-from parse-struct nil))) + (cond ((not (eq (car *parse-list*) '|struct|)) + (sloop until (eq (pop *parse-list*) '|;|)) + (return-from parse-struct (parse-struct)))) + (expect '|struct|) + (let* ((name (prog1 (pop *parse-list*)(expect '|{|)))) + `(defstruct ,name ,@ + (sloop while (setq tem (parse-field)) + append tem)))) + +(defun printf (st x &rest y) + (format st "~%printf(\"~a\"" x) + (sloop for w in y do (princ "," st) (princ y st)) + (princ ");" st)) + +(defun get-sizes (file structs) + (with-open-file (st "gaz0" :direction :output) + (sloop for i from 1 + for u in structs + do (format st "struct ~a SSS~a;~%" (second u) i)) + (format st "~%main() {~%") + (printf st "(") + (sloop for i from 1 + for u in structs + do + (printf st (format nil "(|~a| " (second u))) + (sloop for w in (cddr u) + do + (printf st " %d " + (format nil "(char *)&SSS~a.~a - (char *)&SSS~a" + i (car w) i))) + (printf st ")")) + (printf st ")") + (princ " ;}" st)) + (system + (format nil "cat ~a gaz0 > tmpx.c ; cc tmpx.c -o tmpx ; (tmpx > gaz3.lsp) ; rm -f gaz0" file))) + diff --git a/misc/foreign.lsp b/misc/foreign.lsp new file mode 100755 index 0000000..e26b3de --- /dev/null +++ b/misc/foreign.lsp @@ -0,0 +1,121 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; -*- Mode: Lisp; -*- +;;; File: foreign-interface.lisp +;;; Author: Paul Viola (viola@ai.mit.edu) +;;; Copyright (C) Paul Viola, 1993 +;;;*---------------------------------------------------------------------------- +;;;* FUNCTION: Code to support foreign function call interface in GCL. +;;;* +;;;* CLASSES: +;;;* +;;;* RELATED PACKAGES: +;;;* +;;;* HISTORY: +;;;* Last edited: May 7 17:55 1993 (viola) +;;;* Created: Thu May 6 11:36:49 1993 (viola) +;;;*---------------------------------------------------------------------------- + +(in-package "USER") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Code that makes some lucid foreign function definitions work in GCL. + +(defparameter *lucid-to-gcl-c-types* + '((:signed-32bit int) + (:unsigned-32bit int) ;I hope this is right. + (:double-float double) + (:single-float float) + (:simple-string string) + ((:pointer :signed-32bit) vector-int) + ((:pointer :single-float) vector-single-float) + ((:pointer :double-float) vector-double-float) + (:null void))) + +(defmacro def-foreign-function ((lisp-name . key-params) . c-params) + "I wrote this so that lucid calls to foreign functions could be used directly in +GCL. " + (progn (print lisp-name) + `(defentry-2 ,lisp-name + ,(loop for param in c-params + collect (cadr (assoc (cadr param) *lucid-to-gcl-c-types* + :test #'equal))) + ,(list (cadr (assoc (lucid-return-type key-params) *lucid-to-gcl-c-types* + :test #'equal)) + (lucid-c-name key-params))))) + +(defun lucid-return-type (key-params) + (cadar (member :return-type key-params :key #'car))) + +(defun lucid-c-name (key-params) + (intern + (string-upcase + (subseq (cadar (member :name key-params :key #'car)) 1)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Using lisp strings in C is a pain. First they need to be NULL terminated +;;; then they need to be converted into a C object. The code below returns a +;;; C-string from a lisp routine. This is pretty dangerous - I don't know what +;;; would happen if you tried to operate on it. + +;;; For an array of ints. +(defCfun "object get_c_ints(s) object s;" 0 + " return(s->fixa.fixa_self);" + ) + +(defentry get-c-ints (object) (object get_c_ints)) + +;;; For an array of single-floats. +(defCfun "object get_c_single_floats(s) object s;" 0 + " return(s->sfa.sfa_self);" + ) + +(defentry get-c-single-floats (object) (object get_c_single_floats)) + +;;; For an array of double-floats. +(defCfun "object get_c_double_floats(s) object s;" 0 + " return(s->lfa.lfa_self);" + ) + +(defentry get-c-double-floats (object) (object get_c_double_floats)) + +;;; For a string. +(defCfun "object get_c_string(s) object s;" 0 + " return(s->st.st_self);" + ) +(defentry get_c_string_2 (object) (object get_c_string)) + +;; make sure string is null terminated +(defun get-c-string (string) + (get_c_string_2 (concatenate 'string string " + + +(defparameter *gcl-to-c-types* + '((int int nil) + (char char nil) + (float float nil) + (double double nil) + (object object nil) + (string object get-c-string) + (vector-int object get-c-ints) + (vector-single-float object get-c-single-floats) + (vector-double-float object get-c-double-floats))) + +(defmacro defentry-2 (func-name param-types declaration) + "Macro enhances defentry so that composite types can be passed to C functions. +For a list of types look at *gcl-to-c-types*" + (let ((f-name (intern (concatenate 'string (symbol-name func-name) "-2"))) + (new-types (mapcar #'(lambda (a) (cadr (assoc a *gcl-to-c-types*))) param-types)) + (param-list (mapcar #'(lambda (a) (gensym)) param-types))) + `(progn + (defentry ,f-name ,new-types ,declaration) + (defmacro ,func-name ,param-list + (list ',f-name + ,@(loop for p in param-list + for type in param-types + for (ntype new-type converter-func) = (assoc type *gcl-to-c-types*) + collect (if (null converter-func) + p + `(list ',converter-func ,p)))))))) + diff --git a/misc/mprotect.ch b/misc/mprotect.ch new file mode 100755 index 0000000..0d7cea0 --- /dev/null +++ b/misc/mprotect.ch @@ -0,0 +1,197 @@ +In this file are all changes necessary to implement the 4.3BSD system +call mprotect, and the changes to make sigreturn pass back the address +where a fault occurred as the `code' arg. Note that sun passes the +address as a 4'th arg. This might be preferable, but would involve +changes to locore.s. + +This has been tested on an hp370 running 4.3 BSD from MT Xinu. + +A man page entry for the call as implemented below. + +Inserting file /usr/man/man2/mprotect.2 +---Begin File /usr/man/man2/mprotect.2--- +.\" @(#)mprotect.2 +.TH MPROTECT 2 "9 December 1989" +.SH NAME +mprotect \- specify protection of data section memory +.SH SYNOPSIS +.nf +.ft B +#include +.ft +.LP +.ft B +mprotect(addr, len, prot) +caddr_t addr; +int len, prot; +.ft +.fi +.IX mprotect "" \fLmprotect\fP +.IX "memory management" mprotect "" \fLmprotect\fP +.IX "change protections \(em \fLmprotect\fP" +.SH DESCRIPTION +.LP +.B mprotect(\|) +changes the access protections on the mappings specified +by +the range +[\fIaddr, addr + len\fP\^) +to be that specified by +.IR prot . +Legitimate values for +.I prot +are PROT_READ and (PROT_WRITE | PROT_READ). +.SH RETURN VALUE +.LP +.B mprotect(\|) +returns 0 on success, \-1 on failure. +.SH ERRORS +.B mprotect(\|) +will fail if: +.TP 15 +.SM EINVAL +.I addr +is not a multiple of the page size as returned +by +.BR getpagesize (2). +.TP +.SM ENOMEM +Addresses in the range +[\fIaddr, addr + len\fP) +are not in the data section of a process. +.LP +.SH SEE ALSO +.BR getpagesize (2), + +---End File /usr/man/man2/mprotect.2--- + + +You need to compile the following and add it to /lib/libc.a + +Inserting file /usr/src/lib/libc/hp300/sys/mprotect.c +---Begin File /usr/src/lib/libc/hp300/sys/mprotect.c--- +#ifdef SYSLIBC_SCCS +_sccsid:.asciz "@(#)mprotect.c" +#endif SYSLIBC_SCCS + +#include "SYS.h" + +SYSCALL(mprotect) + rts +---End File /usr/src/lib/libc/hp300/sys/mprotect.c--- + + + +*** hp300/machdep.c.orig Tue Aug 29 13:09:56 1989 +--- hp300/machdep.c Mon Dec 11 17:07:18 1989 +*************** +*** 560,566 **** + #endif + sigf.sf_signum = sig; + sigf.sf_code = 0; +! if (sig == SIGILL || sig == SIGFPE) { + sigf.sf_code = u.u_code; + u.u_code = 0; + } +--- 560,566 ---- + #endif + sigf.sf_signum = sig; + sigf.sf_code = 0; +! if (sig == SIGILL || sig == SIGFPE || sig == SIGBUS) { + sigf.sf_code = u.u_code; + u.u_code = 0; + } +*** sys/kern_mman.c.orig Tue Aug 29 13:16:29 1989 +--- sys/kern_mman.c Thu Dec 14 10:07:39 1989 +*************** +*** 249,257 **** + u.u_pofile[fd] &= ~UF_MAPPED; + } + + mprotect() +! { + + } + + madvise() +--- 249,296 ---- + u.u_pofile[fd] &= ~UF_MAPPED; + } + ++ + mprotect() +! { struct a { +! caddr_t addr; +! int len; +! int prot; +! } *uap = (struct a *)u.u_ap; +! int fv,off; +! int tprot; +! register struct pte *pte; +! struct cmap *c; +! int s; + ++ u.u_r.r_val1 = -1; ++ ++ if ((uap->len < 0 || ++ (int)uap->addr & CLOFSET)) { ++ u.u_error = EINVAL; ++ return; ++ } ++ ++ ++ if ((uap->prot & PROT_WRITE) == 0) ++ tprot= PG_RO; ++ else tprot=PG_RW; ++ /* check the pages are in data section */ ++ if (!(isadsv(u.u_procp, btoc(uap->addr)) ++ &&isadsv(u.u_procp ,btoc(uap->addr+uap->len) -1))) ++ { u.u_error = ENOMEM; ++ return;} ++ ++ ++ fv = btop(uap->addr); ++ pte = vtopte(u.u_procp, fv); ++ for (off = 0; off < uap->len; off += NBPG) { ++ ++ *(u_int *)pte &= ~PG_PROT; ++ *(u_int *)pte |= tprot; ++ pte++;} ++ ++ newptes(vtopte(u.u_procp, fv), fv, btoc(uap->len)); ++ u.u_r.r_val1 = 0; + } + + madvise() +*** hp300/trap.c.orig Tue Aug 29 13:09:59 1989 +--- hp300/trap.c Mon Dec 11 17:48:59 1989 +*************** +*** 112,117 **** +--- 112,118 ---- + + case T_BUSERR+USER: /* bus error */ + case T_ADDRERR+USER: /* address error */ ++ u.u_code=v; + i = SIGBUS; + break; + +*************** +*** 293,298 **** +--- 294,300 ---- + printf("PTF|WPF...\n"); + if (type == T_MMUFLT) + goto copyfault; ++ u.u_code=v; + i = SIGBUS; + break; + } +*************** +*** 346,351 **** +--- 348,354 ---- + #endif + if (type == T_MMUFLT) + goto copyfault; ++ u.u_code=v; + i = SIGBUS; + break; + } diff --git a/misc/rusage.lsp b/misc/rusage.lsp new file mode 100755 index 0000000..e75ee1c --- /dev/null +++ b/misc/rusage.lsp @@ -0,0 +1,44 @@ +;; sun release 4 getrusage interface. (constructed using structs.lsp) +(in-package 'si) +(DEFSTRUCT (|rusage| (:static t)) + (|ru_utime.tv_sec| 0 :TYPE FIXNUM) + (|ru_utime.tv_usec| 0 :TYPE FIXNUM) + (|ru_stime.tv_sec| 0 :TYPE FIXNUM) + (|ru_stime.tv_usec| 0 :TYPE FIXNUM) + (|ru_maxrss| 0 :TYPE FIXNUM) + (|ru_ixrss| 0 :TYPE FIXNUM) + (|ru_idrss| 0 :TYPE FIXNUM) + (|ru_isrss| 0 :TYPE FIXNUM) + (|ru_minflt| 0 :TYPE FIXNUM) + (|ru_majflt| 0 :TYPE FIXNUM) + (|ru_nswap| 0 :TYPE FIXNUM) + (|ru_inblock| 0 :TYPE FIXNUM) + (|ru_oublock| 0 :TYPE FIXNUM) + (|ru_msgsnd| 0 :TYPE FIXNUM) + (|ru_msgrcv| 0 :TYPE FIXNUM) + (|ru_nsignals| 0 :TYPE FIXNUM) + (|ru_nvcsw| 0 :TYPE FIXNUM) + (|ru_nivcsw| 0 :TYPE FIXNUM)) +(clines "static mygetrusage(x,y) int x; object y;{return getrusage(x,y->str.str_self);}") +(defentry GETRUSAGE1 (int object) (int "mygetrusage")) + +(defun get-usage (self usage) + (or (typep usage '|rusage|) (setq usage (make-|rusage|))) + (getrusage1 (if self 0 -1) usage) + usage) + +(defmacro with-change-displayed (form) + `(let ((.beg (get-usage t nil))) + (prog1 ,form + (let ((.end (get-usage t nil))) + (let ((sd (s-data-slot-descriptions (get '|rusage| 's-data)))) + (sloop for i from 0 + for v in(s-data-slot-descriptions (get '|rusage| 's-data)) + for dif = + (- (structure-ref1 .end i ) (structure-ref1 .beg i ) ) + when (not (zerop dif)) + do(print (list (car v) dif)))))))) + + + + diff --git a/misc/test-seek.c b/misc/test-seek.c new file mode 100755 index 0000000..e119d9c --- /dev/null +++ b/misc/test-seek.c @@ -0,0 +1,37 @@ +#include +#include "include.h" +#ifdef HAVE_AOUT +#include HAVE_AOUT +#endif +#ifdef HAVE_ELF +#include +#endif + +#define OUR_MAX(a,b) (a > b ? a : b) + +#define SEEK_TO_END_OFILE(fp)\ + do{ int m; \ + Elf32_Ehdr eheader; \ + Elf32_Shdr shdr; \ + fseek(fp,0,SEEK_SET); \ + fread(&eheader,sizeof(eheader),1,fp); \ + fseek(fp,eheader.e_shoff+(eheader.e_shnum -1) \ + *eheader.e_shentsize,0); \ + fread(&shdr,eheader.e_shentsize,1,fp); \ + fseek(fp,OUR_MAX(shdr.sh_offset+ shdr.sh_size, \ + eheader.e_shoff+(eheader.e_shnum) \ + *eheader.e_shentsize) \ + , SEEK_SET);\ + }while(0) + + + +main(argc,argv) + char *argv[]; +{ FILE *fp; + fp = fopen (argv[1],"r"); + + SEEK_TO_END_OFILE(fp); + printf("end = %d\n",ftell(fp)); +} + diff --git a/misc/test-sgc.lsp b/misc/test-sgc.lsp new file mode 100755 index 0000000..014ffda --- /dev/null +++ b/misc/test-sgc.lsp @@ -0,0 +1,58 @@ +(in-package 'si) +(or (fboundp 'get-usage) (load "/public/gcl/misc/rusage")) +(gbc-time 0) +(defun cv (x) (/ x (float INTERNAL-TIME-UNITS-PER-SECOND))) +(defvar *all-times* nil) +(defmacro with-timing (&rest forms) + `(let ((usg0 (get-usage t nil)) + (t1 (gbc-time)) + (t2 (get-internal-run-time)) + (t3 (get-internal-real-time))) + (prog1 ,@forms + (setq t1 (- (gbc-time ) t1)) + (setq t2 (- (get-internal-run-time) t2)) + (setq t3 (- (get-internal-real-time) t3)) + (let ((usg (get-usage t nil))) + (let ((ans + (format nil + "Run= ~3,2f Elap= ~3,2f Gc= ~3,2f Fault= ~3d" + (cv t2) (cv t3) (cv t1) + (- (|rusage|-|ru_majflt| usg) (|rusage|-|ru_majflt| usg0))))) + (push (list ',(car forms) ans ) *all-times*) + (print ans)))))) + + +(setq si::*notify-gbc* t) +(allocate 'cons 520 t) +(allocate 'fixnum 40) + +(si::sgc-on nil) +(si::allocate-sgc 'symbol 20 30 30) +(si::allocate-sgc 'cons 50 3000 40) + +(si::allocate-sgc 'vector 1 10 30) +(si::allocate-sgc 'string 1 10 30) +(gbc nil) +(si::sgc-on t) +(print (in-package "MAXIMA")) +(setq $joe #$expand((x+y+z)^20)$) + + +(defun test (form) + (gbc nil) + (eval form) + (push (list form 'cons-pages (si::allocated-pages 'cons)) si::*all-times*) + + (gbc nil) + (si::with-timing (sloop for i below 3 do (displa ($factor $joe)))) + ) + +(test '(si::sgc-on nil)) +(test '(si::sgc-on t)) +(test '(si::sgc-on nil)) +(test '(si::sgc-on t)) + +(print si::*all-times*) + + + diff --git a/misc/warn-slow.lsp b/misc/warn-slow.lsp new file mode 100755 index 0000000..7a99388 --- /dev/null +++ b/misc/warn-slow.lsp @@ -0,0 +1,50 @@ +;; Warn of some slow calls. +(in-package 'compiler) + +;; slow if the result type is type T +(dolist (v '(+ * / mod - float 1- 1+)) + (setf (get v 'slow-test) + #'(lambda (name x) (or (null x) (eql (cadar x) t))))) + +;; slow if the first arg is type T +(dolist (v '(aref si::aset < <= > >=)) + (setf (get v 'slow-test) + #'(lambda (name x) (or (null x) (eql (caar x) t))))) + +(dolist (v '(typep)) + (setf (get v 'slow-test) + #'(lambda (name x) (null x)))) + + +;; turn the compiler expressions back into something vaguely +;; readable. +(defun lispify (x) + (let ((tem (car x))) + (cond ((equal tem 'var) + (var-name (car (third x)))) + ((eq tem 'call-global) + (cons (third x) + (mapcar 'lispify (fourth x)))) + ((eq tem 'fixnum-value) + (third x)) + ((eq tem 'location) + (lispify (third x))) + (t x)))) + +(eval-when (load eval) + (trace (get-inline-info :entry nil + :entrycond nil + :exitcond + (and (not (equal (car values) nil)) + (let ((s (get (car si::arglist) 'slow-test))) + (and s (funcall s (car si::arglist) (car values)))) + (progn + (cmpwarn "Slow code: ~a: " + (cons (car si::arglist) + (mapcar 'lispify (second si::arglist)))) + (format t " ~a --> ~a~%" + (mapcar #'(lambda (form) (info-type (cadr form))) + (second si::arglist)) + (third si::arglist))) + nil))) +) \ No newline at end of file diff --git a/mp/fplus.c b/mp/fplus.c new file mode 100755 index 0000000..9c76576 --- /dev/null +++ b/mp/fplus.c @@ -0,0 +1,104 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* #include "include.h" */ +#include "config.h" +/* #include "cmpinclude.h" */ +/* #include "genpari.h" */ +#include "arith.h" +object make_integer(); + + +static unsigned plong small_pos_int[3]={0x1000003,0x01000003,0}; +static unsigned plong small_neg_int[3]={0x1000003,0xff000003,0}; +static unsigned plong s4_neg_int[4]={0x1000004,0xff000004,1,0}; + +object +fplus(a,b) + int a,b; +{ int z ; + int x; + if (a >= 0) + { if (b >= 0) + { x = a + b; + if (x == 0) return small_fixnum(0); + small_pos_int[2]=x; + return make_integer(small_pos_int); + } + else + { /* b neg */ + x = a + b; + return make_fixnum(x); + }} + else + { /* a neg */ + if (b >= 0) + { x = a + b; + return make_fixnum(x);} + else + { /* both neg */ + { unsigned plong Xtx,Xty,overflow,Xtres; + Xtres = addll(-a,-b); + if (overflow) + { + s4_neg_int[3]=Xtres; + return make_integer(s4_neg_int);} + else + { small_neg_int[2]=Xtres; + return make_integer(small_neg_int);} + }}} +} + + +object +fminus(a,b) + int a,b; +{ int z ; + int x; + if (a >= 0) + { if (b >= 0) + { x = a - b; + return make_fixnum(x); + } + else + { /* b neg */ + x = a - b; + if (x==0) return small_fixnum(0); + small_pos_int[2]=x; + return make_integer(small_pos_int); + }} + else + { /* a neg */ + if (b <= 0) + { x = a - b; + return make_fixnum(x);} + else + { /* b positive */ + { unsigned plong Xtx,Xty,overflow,Xtres; + unsigned plong t[4]; + Xtres = addll(-a,b); + if (overflow) + { s4_neg_int[3]=Xtres; + return make_integer(s4_neg_int);} + else + { small_neg_int[2]=Xtres; + return make_integer(small_neg_int);} + }}} +} diff --git a/mp/gcclab b/mp/gcclab new file mode 100755 index 0000000..83d4a7a --- /dev/null +++ b/mp/gcclab @@ -0,0 +1,29 @@ +#!/bin/sh +TEMP=/tmp/gcc$$tmp +BIL="$@" + +while [ $# -gt 0 ] +do + case "$1" in + -S) + Sflag=1;; + -o) + OUT=$2; shift ;; + + *.c) + FILE=$1;; + esac + shift +done + +FILE=`echo "${FILE}" | sed -e 's:\.c$::g'` +gcc -o ${TEMP}.s ${BIL} -S +cat ${TEMP}.s | awk -f gcclab.awk > ${TEMP}1.s + +if [ "${Sflag}" = "1" ] ; then + mv ${TEMP}1.s ${FILE}.s +else +as -o ${FILE}.o ${TEMP}1.s +fi +rm -f ${TEMP}.s ${TEMP}1.s + diff --git a/mp/gcclab.awk b/mp/gcclab.awk new file mode 100755 index 0000000..742a073 --- /dev/null +++ b/mp/gcclab.awk @@ -0,0 +1,13 @@ + + /NEW_LABEL/ { lab++; next;} + /Lmylabel/ { at = index($0,"Lmylabel"); + printf("%s%d%s\n", substr($0,1,at),lab,substr($0,at+1)); + next;} + + {print} + + + + + + \ No newline at end of file diff --git a/mp/gnulib1.c b/mp/gnulib1.c new file mode 100755 index 0000000..e9816bb --- /dev/null +++ b/mp/gnulib1.c @@ -0,0 +1,51 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + + +double +__adddf3 (a, b) + double a, b; +{ + return a + b; +} + +double +__floatsidf (a) + int a; +{ + return (double) a; +} +#ifndef __GO32__ +int +__fixdfsi (a) + double a; +{ + return (int) a; +} +#endif + +double +__muldf3 (a, b) + double a, b; +{ + return a * b; +} + + diff --git a/mp/lo-ibmrt.s b/mp/lo-ibmrt.s new file mode 100755 index 0000000..9a56874 --- /dev/null +++ b/mp/lo-ibmrt.s @@ -0,0 +1,67 @@ + # Copyright W. Schelter 1991 + # untested + .file "foo.c" + .data + .text + .globl .mulul3 + .align 1 +.nmulul3: + .text + .set L.1F,0x00000000 + .set L.1L,0x00000000 + .set L.1R,10 + .set L.1A,0x00000004-(4*L.1R-100)-16 + stm L.1R,4*L.1R-100(1) + cal 1,-(16+L.1A)(1) + lr 14,0 + lr 12,2 + lr 11,3 + lr 10,4 +# line 5, file "foo.c" + mts 10,12 + s 13,13 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + m 13,11 + # 86 + # 46 +# line 6, file "foo.c" + ci 12,0# 47 + bge L.13 +# line 7, file "foo.c" + a 13,11# 63 +L.13: +# line 8, file "foo.c" + ci 11,0# 47 + bge L.14 +# line 9, file "foo.c" + a 13,12# 63 +L.14: +# line 10, file "foo.c" + st 13,0(10)# 17 + mfs 10,2 +# line 11, file "foo.c" +#clrcb 15,8 # DMAsync + lm L.1R,(16+L.1A)+(4*L.1R-100)(1) + brx 15 + cal 1,16+L.1A(1) + .short 0xdf01,L.1R*16+0xdf00,L.1A+16 + .data 3 + .globl _mulul3 +_mulul3: + .long .mulul3 + .text + .data diff --git a/mp/lo-rios.s b/mp/lo-rios.s new file mode 100755 index 0000000..fd4a2b9 --- /dev/null +++ b/mp/lo-rios.s @@ -0,0 +1,106 @@ +.file "lo-rios.s" + # Copyright W. Schelter 1991 +######MULUL3####### +#unfortunately the mul operation on rios is signed, +# so we have to go to a bit of work to get the unsigned op. +.toc +.globl mulul3[ds] +.csect mulul3[ds] + .long .mulul3[PR] + .long TOC[tc0] + .long 0 + .toc +# MULUL3(x,y,hi) +T.mulul3: .tc .mulul3[tc],mulul3[ds] + .globl .mulul3[PR] + .csect .mulul3[PR] + mul. 0,3,4 # hp = r0 + cmpi 0,4,0 # + bge Ypos # branch if reg4 >=0 + a 0,3,0 +Ypos: + cmpi 0,3,0 + bge Xpos + a 0,4,0 +Xpos: + mfmq 3 + st 0,0x0(5) + br +######### DIVSL3 ############ +# a divide just like divul3, except that +# it assumes that x,y are signed numbers. +.toc +.globl divsl3[ds] +.csect divsl3[ds] + .long .divsl3[PR] + .long TOC[tc0] + .long 0 + .toc +# DIVSL3(lo,divisor,rem) +# long h,divisor,*rem +T.divsl3: .tc .divsl3[tc],divsl3[ds] + .globl .divsl3[PR] + .csect .divsl3[PR] + mtmq 3 # move lo to q reg + l 3,0x0(5) # put hi in reg3 + div 3,3,4 # r3 = (r3:qreg)/r4 + mfmq 4 # move remainder to reg6 + st 4,0x0(5) # store 6 in *rem + br +#########Xdivul3################# +# Below is a broken attempt to do a divul3 which +# does the test and branches to the slow one if necessary. +.globl .slowdivul3[PR] + .toc +.globl Xdivul3[ds] +.csect Xdivul3[ds] + .long .Xdivul3[PR] + .long TOC[tc0] + .long 0 + .toc +# old(D,H,L,QP,RP) +# XDIVUL3(lo,divisor,rem) +# long h,divisor,*rem +# +T.Xdivul3: .tc .Xdivul3[tc],Xdivul3[ds] + .globl .Xdivul3[PR] + .csect .Xdivul3[PR] + cmpi 0,4,0 # + l 6,0x0(5) + blt Lslow + a 0,6,6 + cmp 1,4,0 + bgt Ldivsl # branch if reg4 >=0 +Lslow: + b .slowdivul3[PR] +Ldivsl: mtmq 3 # move lo to q reg + div 3,6,4 # r3 = (r6:qreg)/r4 + mfmq 4 # move remainder to reg4 + st 4,0x0(5) # store 6 in *rem + br +##### Flush the instruction cache. Necessary for loading. +.toc +#T.myics.s:.tc myics.s[tc],myics.s[rw] + .globl myics[ds] +.csect myics[ds] + .long .myics[PR] + .long TOC[tc0] + .long 0 + .toc +T.myics: .tc .myics[tc],myics[ds] + .globl .myics[PR] + .csect .myics[PR] + dcs + ics + brl + +#### Allocate lots of space for toc entries during dynamic loading. +.globl akcltoc[ds] + .csect akcltoc[ds] + .long .akcltoc[tc] + .csect .akcltoc[tc] + .space 24000 +.globl toc_start[ds] + .csect toc_start[ds] + .long TOC[tc0] + diff --git a/mp/lo-rios1.s b/mp/lo-rios1.s new file mode 100644 index 0000000..f6472ea --- /dev/null +++ b/mp/lo-rios1.s @@ -0,0 +1,26 @@ +##### Flush the instruction cache. Necessary for loading. +.toc +#T.myics.s:.tc myics.s[tc],myics.s[rw] + .globl myics[ds] +.csect myics[ds] + .long .myics[PR] + .long TOC[tc0] + .long 0 + .toc +T.myics: .tc .myics[tc],myics[ds] + .globl .myics[PR] + .csect .myics[PR] + dcs + ics + brl + +#### Allocate lots of space for toc entries during dynamic loading. +.globl akcltoc[ds] + .csect akcltoc[ds] + .long .akcltoc[tc] + .csect .akcltoc[tc] + .space 24000 +.globl toc_start[ds] + .csect toc_start[ds] + .long TOC[tc0] + diff --git a/mp/lo-sgi4d.s b/mp/lo-sgi4d.s new file mode 100755 index 0000000..1a196d2 --- /dev/null +++ b/mp/lo-sgi4d.s @@ -0,0 +1,58 @@ + # Copyright W. Schelter 1991 +#ifdef sgi +#include +#else +#include +#endif + + .text + .align 2 + + .globl mulul3 + # MULUL3(x,y,hi) + .ent mulul3 +mulul3: + .frame sp, 0, ra + + multu a0, a1 # [hi:lo] = d * q + mfhi a1 + mflo v0 + sw a1,0(a2) + j ra + .end mulul3 + + .globl Xdivul3 + # EXTENDED_DIV(D,H,L,QP,RP) + # divul3(x, y, hi) + # unsigned int x,h,*hi; +#define lo a0 +#define q t7 +#define y a1 +#define h v1 + + .ent Xdivul3 +Xdivul3: + .frame sp, 0, ra + + lw h, 0(a2) + li v0, 32 # v0 holds number of shifts +loop: + + srl q, lo, 31 + sll h, 1 + or h, q + sll lo, 1 + subu q, h, y # t = h - d + bltz q, underflow + move h, q + or lo, 1 +underflow: + subu v0, 1 + bnez v0, loop + move q,a0 + sw h, 0(a2) # *rp = h + # } + j ra + .end Xdivul3 + + diff --git a/mp/lo-u370_aix.s b/mp/lo-u370_aix.s new file mode 100755 index 0000000..ae53e15 --- /dev/null +++ b/mp/lo-u370_aix.s @@ -0,0 +1,77 @@ +* --- Copyright W. Schelter 1991 --# + file_ lo-aix370.c + entry $oVhc2_1r +$oVhc2_1r equ 0 + entry $oVO +$oVO equ 0 +L$$C0 csect + ds 0d +L00$TEXT equ * + entry _divsl3 +* -------------| divsl3 |-----------------------# + ds 0f + dc al2(0) arglength in words + dc xl2'FFFF' argument regs unknown + dc al4(LE$1-_divsl3) code size + dc xl2'0000' no flags currently defined + dc al1(3) parmlength in words + dc al1(1) format +_divsl3 ds 0h +LX$011 equ * + using LX$011,12 + stm LR$1,15,x'10'+LV$1(13) + lr 12,13 + la 11,x'60' + slr 13,11 + st 12,4(,13) + lr 12,15 + lr 15,0 + l 14,0(,2) + dr 14,1 + lr 0,15 + st 14,0(,2) + lm LR$1,14,x'70'+LV$1(13) + br 14 +LE$1 equ * +LR$1 equ 2 +LV$1 equ 0 + entry _mulul3 +* -------------| mulul3 |-----------------------# + ds 0f + dc al2(0) arglength in words + dc xl2'FFFF' argument regs unknown + dc al4(LE$2-_mulul3) code size + dc xl2'0000' no flags currently defined + dc al1(3) parmlength in words + dc al1(1) format +_mulul3 ds 0h +LX$021 equ * + using LX$021,12 + stm LR$2,15,x'10'+LV$2(13) + lr 12,13 + la 11,x'60' + slr 13,11 + st 12,4(,13) + lr 12,15 + lr 11,0 + lr 15,1 + mr 14,11 + lr 0,14 + ltr 11,11 + bnm LF$024 + ar 0,1 +L0$023 equ * +LF$024 equ * + ltr 1,1 + bnm LF$025 + ar 0,11 +L0$025 equ * +LF$025 equ * + st 0,0(,2) + lr 0,15 + lm LR$2,14,x'70'+LV$2(13) + br 14 +LE$2 equ * +LR$2 equ 2 +LV$2 equ 0 + end diff --git a/mp/make.defs b/mp/make.defs new file mode 100755 index 0000000..4607cbb --- /dev/null +++ b/mp/make.defs @@ -0,0 +1,37 @@ +h/dec3100.defs: +MPFILES= ${MPDIR}/mpi.o ${MPDIR}/lo-sgi4d.o ${MPDIR}/libmport.a +h/hp300-bsd.defs: +MPFILES= $(MPDIR)/mpi-bsd68k.o $(MPDIR)/libmport.a +h/hp300.defs: +# MPFILES=${MPDIR}/mpi-gcc.o ${MPDIR}/libmport.a +MPFILES=${MPDIR}/mpi.o ${MPDIR}/libmport.a +h/hp800.defs: +# MPFILES=${MPDIR}/mpi-gcc.o ${MPDIR}/libmport.a +MPFILES=${MPDIR}/mpi.o ${MPDIR}/libmport.a +h/mp386.defs: +MPFILES= $(MPDIR)/mpi-386.o $(MPDIR)/libmport.a +h/ncr.defs: +#:MPFILES= $(MPDIR)/mpi-386.o $(MPDIR)/libmport.a +h/ps2_aix.defs: +MPFILES= $(MPDIR)/mpi-386.o $(MPDIR)/libmport.a +h/rios.defs: +MPFILES=${MPDIR}/mpi.o ${MPDIR}/lo-rios.o ${MPDIR}/mp_divul3_word.o ${MPDIR}/libmport.a +h/rt_aix.defs: +h/rt_aos.defs: +h/sgi.defs: +h/sgi4d.defs: +MPFILES= ${MPDIR}/mpi.o ${MPDIR}/lo-sgi4d.o ${MPDIR}/libmport.a +h/sig.defs: +h/sun2r3.defs: +h/sun3-os4.defs: +MPFILES= $(MPDIR)/mpi-bsd68k.o $(MPDIR)/libmport.a +h/sun3.defs: +MPFILES= $(MPDIR)/mpi-bsd68k.o $(MPDIR)/libmport.a +h/sun386i.defs: +h/sun4.defs: +MPFILES=$(MPDIR)/mpi-sparc.o $(MPDIR)/sparcdivul3.o $(MPDIR)/libmport.a +h/symmetry.defs: +h/u370_aix.defs: +MPFILES=${MPDIR}/mpi.o ${MPDIR}/lo-u370_aix.o ${MPDIR}/mp_sl3todivul3.o ${MPDIR}/libmport.a +# MPFILES=${MPDIR}/mpi.o ${MPDIR}/libmport.a +h/vax.defs: diff --git a/mp/makefile b/mp/makefile new file mode 100644 index 0000000..af6a67e --- /dev/null +++ b/mp/makefile @@ -0,0 +1,76 @@ +AR = ar qc +MPDIR=. +RANLIB=ranlib +# if you are using gcc for the main link you probably dont need this: +GNULIB1= ${MPDIR}/gnulib1.o +NATIVE_CC=cc + +# default mp files (overridden by machine.defs) +MPFILES= $(MPDIR)/mpi.o $(MPDIR)/mp2.o $(MPDIR)/libmport.a + +-include ../makedefs + +OBJS= mp_divul3.o mp_bfffo.o mp_mulul3.o mp2.o mp_dblrsl3.o mp_dblrul3.o ${GNULIB1} + +all: + $(MAKE) all1 "MPFILES=$(MPFILES)" + +all1: ${MPFILES} + +$(MPDIR)/libmport.a: $(OBJS) + rm -f libmport.a + $(AR) libmport.a ${OBJS} + ${RANLIB} libmport.a + +.s.o: + $(AS) $*.s -o $*.o + +.c.o: + $(CC) -c $(OFLAG) -I../h -I. $(CFLAGS) $(ODIR_DEBUG) $*.c + +mpi-386_no_under.o: mpi-386_no_under.s + gcc -traditional -c $*.s -o $*.o + +mpi-386d.o: mpi-386d.S + gcc -traditional -c $*.S -o $*.o + +mpi-bsd68k.s: mpi.c + gcc -S -I../h -O mpi.c -o mpi-bsd68k.s + +mpi-sparc.s: mpi.c + gcc -S -I../h -O mpi.c -o mpi-sparc.s + +mpi-sol-sparc.s: mpi.c + gcc -S -I../h -O mpi.c -o mpi-sol-sparc.s + +${MPDIR}/mpi-386.o: ${MPDIR}/mpi-386.s + $(AS) $*.s -o $*.o + +${MPDIR}/mpi-386.s: mpi.c + gcc -S -I../h -O mpi.c -o mpi-386.s + +${MPDIR}/mpi-gcc.o: mpi.c + gcc -c -O -I../h mpi.c -o mpi-gcc.o + +${MPDIR}/gnulib1.o: + ${NATIVE_CC} -c -O gnulib1.c + +$(MPDIR)/mpi-386-winnt.o: $(MPDIR)/mpi-386-winnt.s + $(AS) $*.s -o $*.o + +clean: + rm -f *.o *.a + +make.defs: + (cd .. ; for v in h/*.defs; do echo $$v: ; fgrep MPFILES $$v ; done ; true) > make.defs + + +tar: + (cd .. ; ls mp/*.c mp/*.s h/*.h h/*.defs mp/makefile mp/make.defs) | sed -e '/foo/d' > tmpx + (cd .. ; tar cvf - `cat mp/tmpx`) | compress -c > ${HOME}/tmp/mp.tar.Z + rm -f tmpx + + + + + diff --git a/mp/mp2.c b/mp/mp2.c new file mode 100755 index 0000000..0af336c --- /dev/null +++ b/mp/mp2.c @@ -0,0 +1,619 @@ + +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ +/*~ ~*/ +/*~ OPERATIONS DE BASE (NOYAU) ~*/ +/*~ Functions which can be efficient in plain C ~*/ +/*~ ~*/ +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ + + +#include "config.h" +#include "genpari.h" +#include "arith.h" + +/* -2147483648 */ + +unsigned plong MOST_NEGS[3]={0x01ff0003, 0xff000003,1<<31}; + +/* +2147483648 */ + +unsigned plong ABS_MOST_NEGS[3]={0x01ff0003, 0x01000003,1<<31}; + + +GEN stoi(x) + plong x; +{ + GEN y; + + if(!x) return gzero; + y=cgeti(3); + if(x>0) {y[1]=0x1000003;y[2]=x;} + else{y[1]=0xff000003;y[2]= -x;} + return y; +} + + +GEN cgetg(x,y) + plong x,y; +{ + unsigned plong p1; + GEN z; + + p1=avma-(((unsigned short)x)<<2);if(p13) err(affer2); + p1=x[2];if(p1>=0x80000000) err(affer2); + p2=(s>0)?p1:(-((plong)p1));return p2; +} + + +void affsi(s,x) + plong s; + GEN x; +{ + plong lx; + + if(!s) {x[1]=2;return;} + lx=lg(x);if(lx<3) err(affer1); + if(s>0) {x[1]=0x1000003;x[2]=s;} + else { s = -s; + if (s < 0) /* s = -2^31 */ + { if(lx<4) err(affer1); + x[1]=0xff000004; + x[2]= 0; + x[3]= 1; + } + else + {x[1]=0xff000003;x[2]= s;} + } +} + + +void affii(x,y) + GEN x,y; +{ + plong lx=lgef(x),i; + + if(x==y) return; + if(lg(y)0) {t[1]=0x1000003;t[2]=x;} + else {t[1]=0xff000003;t[2]= -x;} + return shifti(t,y); +} + + +GEN shifti(x,n) + GEN x; + plong n; +{ + plong lx=lgef(x),i,s=signe(x),d,m,p1,p2,k; + GEN y; TEMPVARS2 + ulong hiremainder; + + if(!s) return gzero; + if(!n) return icopy(x); + if(n>0) + { + d=n>>5;m=n&31; + if(m) + { + p1=shiftl(x[2],m);p2=hiremainder;k=0; + if(p2) + { + y=cgeti(lx+d+1);for(i=lx+1;i<=lx+d;i++) y[i]=0; + for(i=lx;i>=4;i--) {y[i]=shiftl(x[i-1],m)+k;k=hiremainder;} + y[3]=p1+k;y[2]=p2; + } + else + { + y=cgeti(lx+d);for(i=lx;i=3;i--) {y[i]=shiftl(x[i],m)+k;k=hiremainder;} + y[2]=p1+k; + } + } + else + { + y=cgeti(lx+d);for(i=lx;i=2;i--) y[i]=x[i]; + } + } + else + { + n= -n;d=n>>5;m=n&31;if(lx>5;m=e&31;if(d>=lx-2) err(truer2); + y=cgeti(d+3);y[1]=y[0];setsigne(y,s); + if(m==31) for(i=2;i<=d+2;i++) y[i]=x[i]; + else + { + m++;p1=0; + for(i=2;i<=d+2;i++) + { + p2=shiftl(x[i],m);y[i]=hiremainder+p1;p1=p2; + } + } + return y; +} + + +GEN mpent(x) + GEN x; +{ + plong e,i,lx=lg(x),m,f,p1,p2; + unsigned plong d;ulong hiremainder; + GEN y,z; TEMPVARS2 + + if(typ(x)==1) return icopy(x); + if(signe(x)>=0) return mptrunc(x); + e=expo(x);if(e<0) {y=cgeti(3);y[2]=1;y[1]=0xff000003;return y;} + d=e>>5;m=e&31;if(d>=lx-2) err(truer2); + y=cgeti(d+3);y[1]=0xff000003+d; + if(m==31) + { + for(i=2;i<=d+2;i++) y[i]=x[i]; + while((i=2)&&(y[i]==0xffffffff);i--) y[i]=0; + if(i>=2) y[i]++; + else + { + z=y;y=cgeti(1);*y=(*z)+1;y[1]=z[1]+1; + } + } + return y; +} + + +int cmpsi(x,y) + plong x; + GEN y; +{ + ulong p; + + if(!x) return -signe(y); + if(x>0) + { + if(signe(y)<=0) return 1; + if(lgef(y)>3) return -1; + p=y[2];if(p==x) return 0; + return (p<(ulong)x) ? 1 : -1; + } + else + { /* x <= 0 */ + if(signe(y)>=0) return -1; + if(lgef(y)>3) + { if (-x < 0) + { /* x = -2^31 */ + if (lgef(y)==4 && + y[2] == 0 && + y[3] == 1) + return 0; + else + return 1;}} + p=y[2];if(p== -x) return 0; + return (p<(ulong)(-x)) ? -1 : 1; + } +} + + +int cmpii(x,y) + GEN x,y; +{ + plong sx=signe(x),sy=signe(y),lx,ly,i; + + if(sxsy) return 1; + if(!sx) return 0; + lx=lgef(x);ly=lgef(y); + if(lx>ly) return sx; + if(lx(ulong)y[i]) ? sx : -sx; +} + + +GEN addss(x,y) + plong x,y; +{ + plong t[3]; + + if(!x) return stoi(y); + t[0]=0x1010003; + if(x>0) {t[1]=0x1000003;t[2]=x;} else {t[1]=0xff000003;t[2]= -x;} + return addsi(y,t); +} + + +GEN subii(x,y) + GEN x,y; +{ + plong s=signe(y); + GEN z; + + if(x==y) return gzero; + setsigne(y,-s);z=addii(x,y);setsigne(y,s); + return z; +} + + +GEN subsi(x,y) + plong x; + GEN y; +{ + plong s=signe(y); + GEN z; + + setsigne(y,-s);z=addsi(x,y);setsigne(y,s);return z; +} + + +GEN subss(x,y) + plong x,y; +{ + if (y == (1<<31)) + return addsi(x,ABS_MOST_NEGS); + return addss(-y,x); +} + + +GEN convi(x) + GEN x; +{ + plong lx,av=avma,lz; + GEN z,p1,p2; + + if(!signe(x)) + { + z=cgeti(3);z[1]= -1;z[2]=0;avma=av;return z+3; + } + p1=absi(x);lx=lgef(p1);lz=((lx-2)*15)/14+3;z=cgeti(lz);z[1]= -1; + for(p2=z+2;signe(p1);p2++) *p2=divisii(p1,1000000000,p1); + avma=av;return p2; +} + + + +void mulsii(x,y,z) + plong x; + GEN y,z; +{ + plong av=avma; + GEN p1; + + p1=mulsi(x,y);affii(p1,z);avma=av; +} + + +void addsii(x,y,z) + plong x; + GEN y,z; +{ + plong av=avma; + GEN p1; + + p1=addsi(x,y);affii(p1,z);avma=av; +} + + +plong divisii(x,y,z) + plong y; + GEN x,z; +{ + plong av=avma,k; + GEN p1; + + p1=divis(x,y);affii(p1,z);avma=av; + k=hiremainder;return k; +} + + +plong vals(x) + plong x; +{ + unsigned short int y,z; + int s; + + if(!x) return -1; + y=x;if(!y) {s=16;y=((ulong)x)>>16;} else s=0; + z=y&255;if(!z) {s+=8;z=y>>8;} + y=z&15;if(!y) {s+=4;y=z>>4;} + z=y&3;if(!z) {s+=2;z=y>>2;} + return (z&1) ? s : s+1; +} + + +plong vali(x) + GEN x; +{ + plong i,lx=lgef(x); + + if(!signe(x)) return -1; + for(i=lx-1;(i>=2)&&(!x[i]);i--); + return ((lx-1-i)<<5)+vals(x[i]); +} + +GEN dvmdss(x,y,z) + plong x,y; + GEN *z; +{ + GEN p1; + + p1=divss(x,y);*z=stoi(hiremainder); + return p1; +} + + +GEN dvmdsi(x,y,z) + plong x; + GEN y,*z; +{ + GEN p1; + p1=divsi(x,y);*z=stoi(hiremainder); + return p1; +} + + +GEN dvmdis(x,y,z) + plong y; + GEN x,*z; +{ + GEN p1; + p1=divis(x,y);*z=stoi(hiremainder); + return p1; +} + + +GEN ressi(x,y) + plong x; + GEN y; +{ + divsi(x,y);return stoi(hiremainder); +} + + +GEN modsi(x,y) + plong x; + GEN y; +{ + plong s; + GEN p1; + + divsi(x,y); + if(!hiremainder) return gzero; + if(x>0) return stoi(hiremainder); + else + { + s=signe(y);setsigne(y,1);p1=addsi(hiremainder,y); + setsigne(y,s);return p1; + } +} + + +GEN modis(x,y) + plong y; + GEN x; +{ + divis(x,y);if(!hiremainder) return gzero; + return (signe(x)>0) ? stoi(hiremainder) : stoi(abs(y)+hiremainder); +} + + +GEN resis(x,y) + plong y; + GEN x; +{ + divis(x,y);return stoi(hiremainder); +} + + +GEN modii(x,y) + GEN x,y; +{ + plong av=avma,tetpil; + GEN p1; + + p1=dvmdii(x,y,-1); + if(signe(p1)>=0) return p1; + tetpil=avma;p1=(signe(y)>0) ? addii(p1,y) : subii(p1,y); + return gerepile(av,tetpil,p1); +} + +int +mpdivis(x,y,z) + GEN x,y,z; +{ + plong av=avma; + GEN p1,p2; + + p1=dvmdii(x,y,&p2); + if(signe(p2)) {avma=av;return 0;} + affii(p1,z);avma=av;return 1; +} + +int +divise(x,y) + GEN x,y; +{ + plong av=avma; + GEN p1; + + p1=dvmdii(x,y,-1);avma=av; + return signe(p1) ? 0 : 1; +} + + +GEN gerepile(l,p,q) + GEN l,p,q; + +{ + plong av,declg,tl; + GEN ll,pp,l1,l2,l3; + + declg=(plong)l-(plong)p;if(declg<=0) return q; + for(ll=l,pp=p;pp>(GEN)avma;) *--ll= *--pp; + av=(plong)ll; + while((llll) l3=l2;} + else {ll+=lg(ll);l3=ll;} + for(;l2=(GEN)avma)) + { + if(l1=(GEN)avma))) + { + avma=av;return q+(declg>>2); + } + else {avma=av;return q;} +} + + +void cgiv(x) + GEN x; +{ + plong p; + + if((p=pere(x))==255) return; + if((x!=(GEN)avma)||(p>1)) {setpere(x,p-1);return;} + do x+=lg(x);while(!pere(x)); + avma=(plong)x; + return; +} diff --git a/mp/mp_addmul.c b/mp/mp_addmul.c new file mode 100755 index 0000000..101aca9 --- /dev/null +++ b/mp/mp_addmul.c @@ -0,0 +1,40 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +#include "include.h" +#include "arith.h" +/* + (h = hiremainder, y = addmul(a,b), hiremainder:y == a*b + h) is true +*/ + +int addmul(x,y) + ulong x,y; +{ + ulong xlo,xhi,ylo,yhi; + ulong z,z2; TEMPVARS + + xlo=x&65535;xhi=x>>16;ylo=y&65535;yhi=y>>16; + z=addll(xlo*yhi,xhi*ylo); + z2=(overflow)?xhi*yhi+65536+(z>>16):xhi*yhi+(z>>16); + z=addll(xlo*ylo,(z<<16));z2+=overflow; + z=addll(z,hiremainder);hiremainder=z2+overflow; + return z; +} + diff --git a/mp/mp_bfffo.c b/mp/mp_bfffo.c new file mode 100755 index 0000000..6aced00 --- /dev/null +++ b/mp/mp_bfffo.c @@ -0,0 +1,64 @@ + + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + double i; ulong x; + index of the first non zero bit numbering from left + Bit position measured from most significant end + to the first non zero bit of x + if (x == 2^i) bfffo(x) == (31 - truncate(i)) + else if (x==0) 32 + + [truncate (i) chops off the decimal places] + + bfffo(0) == 32 + bfffo(1) == 31 + bfffo(2) == 30 + bfffo(3) == 30 + bfffo(4) == 29 + bfffo(5) == 29 + .. + +*/ + +#include "include.h" + +#ifndef bfffo +int bfffo(x) + unsigned plong x; +{ + int sc; + static int tabshi[16]={4,3,2,2,1,1,1,1,0,0,0,0,0,0,0,0}; + + if(x&(0xffff0000)) sc=0;else {sc=16;x<<=16;} + if(!(x&(0xff000000))) {sc+=8;x<<=8;} + if(x&(0xf0000000)) x>>=28;else {sc+=4;x>>=24;} + sc+=tabshi[x];return sc; +} + +#else +static dummy () {;} +#endif + + + + + diff --git a/mp/mp_dblrsl3.c b/mp/mp_dblrsl3.c new file mode 100755 index 0000000..c61bd28 --- /dev/null +++ b/mp/mp_dblrsl3.c @@ -0,0 +1,45 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +#include "config.h" +#include "genpari.h" +#include "arith.h" + +int dblremsl3(x,y,z) + int x,y,z; +{ unsigned plong h; + unsigned plong w; + if (x>= 0 && y>= 0 && z>0) + {w = mulul(x,y,h); + divul(x,z,h); + return h;} + else + { plong save = avma; + GEN yy = stoi(y); + GEN xx = stoi(x); + GEN ans = mulii(xx,yy); + ans = dvmdii(ans,stoi(z),-1); + avma = save; + if (signe(ans) > 0) return ans[2]; + if (signe(ans) < 0) return -ans[2]; + return 0;} +} + + diff --git a/mp/mp_dblrul3.c b/mp/mp_dblrul3.c new file mode 100755 index 0000000..0e7e2b7 --- /dev/null +++ b/mp/mp_dblrul3.c @@ -0,0 +1,39 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +#include "config.h" +#include "genpari.h" +#include "arith.h" + + +unsigned plong dblremul3(x,y,z) + int x,y,z; +{ unsigned plong h; + unsigned plong w = mulul(x,y,h); + w; /* ignore quotient */ + divul(x,z,h); + return h; +} + + + + + + diff --git a/mp/mp_divul3.c b/mp/mp_divul3.c new file mode 100755 index 0000000..41ffbce --- /dev/null +++ b/mp/mp_divul3.c @@ -0,0 +1,65 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + ulong low,divisor,h,q; + if divisor!= 0 and if (hiremainder:low)/divisor (ie q) + is expressible in 32 bits, + then + (h = hiremainder, q = divll(low,divisor), + h:low == q * divisor + hiremainder && 0<= hiremainder && hiremainder < divisor) + is TRUE. + [the arithmetic is ordinary arithmetic among unsigned 64 bit integers] + A sufficient criteria for (hiremainder:low)/divisor + to be expressible in 32 bits, + is bfffo(divisor)-bfffo(hiremainder) <= 0 + +*/ + +#include "include.h" +#include "arith.h" + +#define WORD_SIZE 32 +/* SHIFT1BIT: shift h and l left by 1 as 64 bits. We don't care what + is coming into the bottom word */ + +#define shift1bit(h,l) \ + l = (h = h << 1, ( l & (1<<(WORD_SIZE -1)) ? h +=1 : 0), l<<1) + +ulong +divul3(x,y,hi) + ulong x,y,*hi; +{ulong q =0; + ulong h = *hi,l=x,hibit; + int count = WORD_SIZE; +/* if (y<=h) printf("error: the quotient will be more than 32 bits"); */ +#ifdef QUICK_DIV + QUICK_DIV(x,y,h,hi) +#endif + do { q = q << 1; + hibit = h & (1 << (WORD_SIZE -1)); + shift1bit(h,l); + if (hibit || (y <= h)) + { q += 1; h -= y;} + } while(--count > 0); + *hi = h; + return q; +} + diff --git a/mp/mp_divul3_word.c b/mp/mp_divul3_word.c new file mode 100755 index 0000000..20cc1f0 --- /dev/null +++ b/mp/mp_divul3_word.c @@ -0,0 +1,80 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +#include "include.h" +#include "arith.h" + + + +our_ulong +divul3(x,y,hi) + our_ulong x,y,*hi; +{ +#define HIBIT 0x80000000 +#define HIMASK 0xffff0000 +#define LOMASK 0xffff +#define HIWORD(a) (a >> 16) +/* si le compilateur est bugge, il faut mettre (a >> 16) & LOMASK) */ +#define LOWORD(a) (a & LOMASK) +#define GLUE(hi, lo) ((hi << 16) + lo) +#define SPLIT(a, b, c) b = HIWORD(a); c = LOWORD(a) + + our_ulong v1, v2, u3, u4, q1, q2, aux, aux1, aux2,hiremainder=*hi; + int k; + + for(k = 0; !(y & HIBIT); k++) + { + hiremainder <<= 1; + if (x & HIBIT) hiremainder++; + x <<= 1; + y <<= 1; + } + + SPLIT(y, v1, v2); + SPLIT(x, u3, u4); + + q1 = hiremainder / v1; if (q1 & HIMASK) q1 = LOMASK; + hiremainder -= q1 * v1; + aux = v2 * q1; +again: + SPLIT(aux, aux1, aux2); + if (aux2 > u3) aux1++; + if (aux1 > hiremainder) {q1--; hiremainder += v1; aux -= v2; goto again;} + u3 -= aux2; + hiremainder -= aux1; + hiremainder <<= 16; hiremainder += u3 & LOMASK; + + q2 = hiremainder / v1; if (q2 & HIMASK) q2 = LOMASK; + hiremainder -= q2 * v1; + aux = v2 * q2; +again2: + SPLIT(aux, aux1, aux2); + if (aux2 > u4) aux1++; + if (aux1 > hiremainder) {q2--; hiremainder += v1; aux -= v2; goto again2;} + u4 -= aux2; + hiremainder -= aux1; + hiremainder <<= 16; hiremainder += u4 & LOMASK; + hiremainder >>= k; + *hi = hiremainder; + return GLUE(q1, q2); +} + + + diff --git a/mp/mp_mulul3.c b/mp/mp_mulul3.c new file mode 100755 index 0000000..bb939e7 --- /dev/null +++ b/mp/mp_mulul3.c @@ -0,0 +1,69 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + + + +#include "include.h" +#include "arith.h" + +/* ulong a,b,y; + (y = mulul3(a,b,&hiremainder), hiremainder:y == a*b) is TRUE. +*/ +#ifdef USE_WORD_MULUL3 + +int mulul3(x,y,hiremainder) + ulong x,y,*hiremainder; +{ + ulong xlo,xhi,ylo,yhi; + ulong z; TEMPVARS + + xlo=x&65535;xhi=x>>16;ylo=y&65535;yhi=y>>16; + z=addll(xlo*yhi,xhi*ylo); + *hiremainder=(overflow)?xhi*yhi+65536+(z>>16):xhi*yhi+(z>>16); + z=addll(xlo*ylo,(z<<16));*hiremainder+=overflow; + return z; +} + +#else +ulong +mulul3(a,b,h) +unsigned int a,b, *h; +{unsigned int temph,templ,ah,al,i; + ah=0; + al=0; + /* in case the shift by 32 does not zero an unsigned int.. + we separate out the first step.*/ + {if (b & 1) + {temph=0;templ=a; + lladd(temph,templ,ah,al);} + /* printf("\n%d b=%d a=%d (%d:%d)",i,b,a,ah,al); */ + b=b>>1; + } + i=1; + while(b) + {if (b & 1) + {llshift(a,i,temph,templ); + lladd(temph,templ,ah,al);} + i++;b=b>>1; + } + *h=ah; + return al; +} +#endif diff --git a/mp/mp_shiftl.c b/mp/mp_shiftl.c new file mode 100755 index 0000000..4b0b2cd --- /dev/null +++ b/mp/mp_shiftl.c @@ -0,0 +1,34 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +typedef unsigned plong ulong; +ulong hiremainder,overflow; + +int shiftl(x,y) + ulong x,y; +{ + hiremainder=x>>(32-y);return (x<>y); +} diff --git a/mp/mp_sl3todivul3.c b/mp/mp_sl3todivul3.c new file mode 100755 index 0000000..c6bf75d --- /dev/null +++ b/mp/mp_sl3todivul3.c @@ -0,0 +1,110 @@ + +/* Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 library general public +license along with GCL; see the file COPYING. If not, write to the +Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +#define ulong unsigned plong +#define shift1BitRight(h,l) \ + (l = l >> 1 , (h & 1 ? l = l | (1 << (WORD_SIZE -1)) : 0), h = h >> 1) + +#define shift2BitRight(h,l) \ + (l = l >> 2 , (h & 3 ? l = l | ((h & 3) << (WORD_SIZE -2)) : 0), h = h >> 2) + +#define addll(x,y) \ + (Xtx=(x),Xty=(y), Xtres = Xtx+Xty, \ + (Xtres < Xtx ? overflow = 1 :0), Xtres) + +/* the following defines divul3 in terms of divsl3. + */ + + +#define WORD_SIZE 32 +divul3(x, y, hi) + ulong x, y, *hi; +{ + ulong q = 0,Xtx,Xty,Xtres,addy,overflow; + ulong h = *hi, l = x, hibit; + ulong dd; + /* if (y<=h) printf("error: the quotient will be more than 32 bits"); */ + + if ((int) y > 0) { + dd = y >> 1; + if (dd <= h) { + unsigned int ll = l; + shift1BitRight(h, ll); + q = divsl3(ll, y, &h); + h = h + h + (l & 1); + q = q + q; + if (h >= y) { + q++; + h -= y; + } + *hi = h; + return q; + } else { + return divsl3(x, y, hi); + } + } + /* negative */ + { + ulong ll; + ulong rem; + ll = l; + shift2BitRight(h, ll); + dd = y >> 1; + q = divsl3(ll, dd, &h); + rem = h + h; + overflow = 0; + rem = addll(rem, rem); + rem += l & 3; + q = q + q; + addy = 0; + if (y & 1) { + if (overflow==0 && rem < q) + { addy = 1; + rem = addll(rem, y); + if (overflow==0 && rem < q) + { addy = 2; + rem +=y; + } + } + if (q > rem ) overflow = 0; + rem -= q; + } + if (addy > 0) + { q -= addy; } + else + { if (overflow || (rem >= y)) + { rem -= y; + q++; + } + } + + *hi = rem; + return q; + } +} + + +/* + ;;- Local variables: + ;;- mode:c + ;;- version-control:t + ;;- End: + + */ diff --git a/mp/mpi-386_no_under.s b/mp/mpi-386_no_under.s new file mode 100644 index 0000000..14727d8 --- /dev/null +++ b/mp/mpi-386_no_under.s @@ -0,0 +1,2337 @@ + .file "mpi.c" + .version "01.01" +gcc2_compiled.: +.text + .align 16 +.globl mulsi + .type mulsi,@function +mulsi: + pushl %ebp + movl %esp,%ebp + subl $20,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 12(%ebp),%ebx + movl 4(%ebx),%edx + sarl $24,%edx + movl %edx,-8(%ebp) + movzwl 4(%ebx),%ecx + movl %ecx,-12(%ebp) + cmpl $0,8(%ebp) + je .L3 + testl %edx,%edx + jne .L2 +.L3: + movl gzero,%eax + jmp .L14 + .align 16 +.L2: + cmpl $0,8(%ebp) + jge .L4 + negl -8(%ebp) + negl 8(%ebp) + jns .L4 + pushl %ebx + pushl $-2147483648 + call stoi + addl $4,%esp + pushl %eax + call mulii + jmp .L14 + .align 16 +.L4: + movl -12(%ebp),%eax + incl %eax + pushl %eax + call cgeti + movl %eax,-16(%ebp) + movl $0,-4(%ebp) + movl -12(%ebp),%edx + leal 0(,%edx,4),%eax + addl %eax,%ebx + movl %ebx,-20(%ebp) + movl -16(%ebp),%ecx + leal 4(%eax,%ecx),%esi + addl $4,%esp + movl %edx,%edi + addl $-2,%edi + je .L7 + .align 4 +.L8: + addl $-4,%esi + movl -4(%ebp),%ebx + leal -4(%ebp),%eax + pushl %eax + addl $-4,-20(%ebp) + movl -20(%ebp),%edx + movl (%edx),%eax + pushl %eax + movl 8(%ebp),%ecx + pushl %ecx + call mulul3 + addl %ebx,%eax + addl $12,%esp + cmpl %ebx,%eax + jae .L10 + incl -4(%ebp) +.L10: + movl %eax,(%esi) + decl %edi + jne .L8 +.L7: + cmpl $0,-4(%ebp) + je .L12 + movl -4(%ebp),%eax + movl %eax,-4(%esi) + movl -16(%ebp),%edx + movl 4(%edx),%eax + andl $-65536,%eax + movl -12(%ebp),%ecx + leal 1(%ecx,%eax),%eax + movl %eax,4(%edx) + jmp .L13 + .align 16 +.L12: + addl $4,avma + movl -16(%ebp),%edx + movl (%edx),%ecx + decl %ecx + movl %ecx,4(%edx) + addl $4,%edx + movl %edx,-16(%ebp) + movw -12(%ebp),%cx + movw %cx,4(%edx) +.L13: + movb -8(%ebp),%dl + movl -16(%ebp),%ecx + movb %dl,7(%ecx) + movl -16(%ebp),%eax +.L14: + leal -32(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe1: + .size mulsi,.Lfe1-mulsi + .align 16 +.globl expi + .type expi,@function +expi: + pushl %ebp + movl %esp,%ebp + pushl %ebx + movl 8(%ebp),%eax + movzwl 4(%eax),%ebx + cmpl $2,%ebx + je .L16 + movl 8(%eax),%eax + pushl %eax + call bfffo + movl %eax,%edx + leal -2(%ebx),%eax + sall $5,%eax + subl %edx,%eax + decl %eax + jmp .L17 + .align 16 +.L16: + movl $-8388608,%eax +.L17: + movl -4(%ebp),%ebx + movl %ebp,%esp + popl %ebp + ret +.Lfe2: + .size expi,.Lfe2-expi + .align 16 +.globl addsi + .type addsi,@function +addsi: + pushl %ebp + movl %esp,%ebp + subl $12,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 12(%ebp),%edi + testl %esi,%esi + jne .L19 + pushl %edi + call icopy + jmp .L68 + .align 16 +.L19: + movl 4(%edi),%ebx + sarl $24,%ebx + movl %ebx,-8(%ebp) + jne .L20 + pushl %esi + call stoi + jmp .L68 + .align 16 +.L20: + testl %esi,%esi + jge .L21 + movl $-1,-4(%ebp) + negl %esi + jns .L23 + pushl %edi + pushl $MOST_NEGS + call addii + jmp .L68 + .align 16 +.L21: + movl $1,-4(%ebp) +.L23: + movzwl 4(%edi),%ebx + movl %ebx,-12(%ebp) + movl -8(%ebp),%ebx + cmpl %ebx,-4(%ebp) + jne .L24 + movl %esi,%edx + movl %edx,%eax + movl -12(%ebp),%ebx + addl -4(%edi,%ebx,4),%eax + movl %eax,%esi + cmpl %edx,%eax + jae .L25 + movl %ebx,%eax + incl %eax + pushl %eax + call cgeti + movl %eax,%ecx + movl %esi,(%ecx,%ebx,4) + movl -12(%ebp),%edx + decl %edx + cmpl $2,%edx + jle .L32 + .align 4 +.L31: + cmpl $-1,-4(%edi,%edx,4) + jne .L27 + movl $0,(%ecx,%edx,4) + decl %edx + cmpl $2,%edx + jg .L31 +.L27: + cmpl $2,%edx + jle .L32 + movl -4(%edi,%edx,4),%ebx + incl %ebx + movl %ebx,(%ecx,%edx,4) + jmp .L69 + .align 16 + .align 4 +.L35: + movl -4(%edi,%edx,4),%eax + movl %eax,(%ecx,%edx,4) +.L69: + decl %edx + cmpl $2,%edx + jg .L35 + movl (%ecx),%eax + decl %eax + movl %eax,4(%ecx) + movl %eax,8(%ecx) + addl $4,%ecx + addl $4,avma + jmp .L38 + .align 16 +.L32: + movl $1,8(%ecx) + movl (%ecx),%eax + movl %eax,4(%ecx) + jmp .L38 + .align 16 +.L25: + movl -12(%ebp),%ebx + pushl %ebx + call cgeti + movl %eax,%ecx + movl %esi,-4(%ecx,%ebx,4) + movl $1,%edx + movl -12(%ebp),%eax + decl %eax + movl %eax,%esi + cmpl %eax,%edx + jge .L38 + .align 4 +.L42: + movl (%edi,%edx,4),%eax + movl %eax,(%ecx,%edx,4) + incl %edx + cmpl %esi,%edx + jl .L42 +.L38: + movb -4(%ebp),%bl + movb %bl,7(%ecx) + jmp .L44 + .align 16 +.L24: + cmpl $3,-12(%ebp) + jne .L45 + cmpl %esi,8(%edi) + jbe .L46 + pushl $3 + call cgeti + movl %eax,%ecx + movl -8(%ebp),%eax + sall $24,%eax + addl $3,%eax + movl %eax,4(%ecx) + movl 8(%edi),%edi + subl %esi,%edi + movl %edi,8(%ecx) + jmp .L44 + .align 16 +.L46: + cmpl %esi,8(%edi) + jne .L47 + movl gzero,%eax + jmp .L68 + .align 16 +.L47: + pushl $3 + call cgeti + movl %eax,%ecx + movl -8(%ebp),%eax + negl %eax + sall $24,%eax + addl $3,%eax + movl %eax,4(%ecx) + subl 8(%edi),%esi + movl %esi,8(%ecx) + jmp .L44 + .align 16 +.L45: + movl -12(%ebp),%ebx + movl -4(%edi,%ebx,4),%edx + movl %esi,%eax + movl %edx,%esi + subl %eax,%esi + cmpl %eax,%edx + jae .L48 + pushl %ebx + call cgeti + movl %eax,%ecx + movl %esi,-4(%ecx,%ebx,4) + movl -12(%ebp),%edx + addl $-2,%edx + cmpl $0,(%edi,%edx,4) + jne .L50 + .align 4 +.L52: + movl $-1,(%ecx,%edx,4) + decl %edx + cmpl $0,(%edi,%edx,4) + je .L52 +.L50: + movl (%edi,%edx,4),%eax + decl %eax + movl %eax,(%ecx,%edx,4) + cmpl $2,%edx + jg .L55 + testl %eax,%eax + je .L54 +.L55: + decl %edx + testl %edx,%edx + jle .L44 + .align 4 +.L59: + movl (%edi,%edx,4),%eax + movl %eax,(%ecx,%edx,4) + decl %edx + testl %edx,%edx + jg .L59 + jmp .L44 + .align 16 +.L54: + movl (%ecx),%eax + decl %eax + movl %eax,4(%ecx) + movl %eax,8(%ecx) + addl $4,%ecx + addl $4,avma + movb -8(%ebp),%bl + movb %bl,7(%ecx) + jmp .L44 + .align 16 +.L48: + movl -12(%ebp),%ebx + pushl %ebx + call cgeti + movl %eax,%ecx + movl %esi,-4(%ecx,%ebx,4) + movl $1,%edx + movl -12(%ebp),%eax + decl %eax + movl %eax,%esi + cmpl %eax,%edx + jge .L44 + .align 4 +.L66: + movl (%edi,%edx,4),%eax + movl %eax,(%ecx,%edx,4) + incl %edx + cmpl %esi,%edx + jl .L66 +.L44: + movl %ecx,%eax +.L68: + leal -24(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe3: + .size addsi,.Lfe3-addsi + .align 16 +.globl addii + .type addii,@function +addii: + pushl %ebp + movl %esp,%ebp + subl $32,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%ecx + movzwl 4(%ecx),%ecx + movl %ecx,-8(%ebp) + movl 12(%ebp),%edi + movzwl 4(%edi),%edi + movl %edi,-12(%ebp) + cmpl %edi,%ecx + jge .L71 + movl 8(%ebp),%ecx + movl %ecx,-16(%ebp) + movl 12(%ebp),%edi + movl %edi,8(%ebp) + movl %ecx,12(%ebp) + movl -8(%ebp),%ecx + movl %ecx,-4(%ebp) + movl -12(%ebp),%edi + movl %edi,-8(%ebp) + movl %ecx,-12(%ebp) +.L71: + movl 12(%ebp),%ecx + movl 4(%ecx),%esi + sarl $24,%esi + jne .L72 + movl 8(%ebp),%edi + pushl %edi + call icopy + jmp .L135 + .align 16 +.L72: + movl 8(%ebp),%ecx + movl 4(%ecx),%ecx + sarl $24,%ecx + movl %ecx,-4(%ebp) + cmpl %esi,%ecx + jne .L73 + movl -8(%ebp),%eax + incl %eax + pushl %eax + call cgeti + movl %eax,-16(%ebp) + movl $0,-24(%ebp) + movl -8(%ebp),%edi + leal 0(,%edi,4),%eax + movl -16(%ebp),%ecx + leal 4(%eax,%ecx),%esi + movl 8(%ebp),%ebx + addl %eax,%ebx + movl -12(%ebp),%edi + movl 12(%ebp),%ecx + leal (%ecx,%edi,4),%edi + movl %edi,-20(%ebp) + movl -12(%ebp),%ecx + addl $-2,%ecx + movl %ecx,-32(%ebp) + je .L75 + .align 4 +.L76: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%edi + movl %edi,-28(%ebp) + addl $-4,-20(%ebp) + movl %edi,%edx + movl -20(%ebp),%ecx + addl (%ecx),%edx + cmpl %edi,%edx + jae .L77 + addl -24(%ebp),%edx + movl $1,-24(%ebp) + jmp .L137 + .align 16 +.L77: + addl -24(%ebp),%edx + cmpl %edx,-24(%ebp) + seta %al + andl $255,%eax + movl %eax,-24(%ebp) +.L137: + movl %edx,(%esi) + decl -32(%ebp) + jne .L76 +.L75: + cmpl $0,-24(%ebp) + je .L80 + movl 8(%ebp),%edx + addl $8,%edx +.L81: + addl $-4,%ebx + movl %ebx,%eax + cmpl %edx,%ebx + jb .L82 + cmpl $-1,(%ebx) + jne .L83 + addl $-4,%esi + movl $0,(%esi) + jmp .L81 + .align 16 +.L83: + addl $-4,%esi + movl (%eax),%eax + incl %eax + jmp .L138 + .align 16 + .align 4 +.L87: + addl $-4,%esi + movl (%eax),%eax +.L138: + movl %eax,(%esi) + addl $-4,%ebx + movl %ebx,%eax + cmpl %edx,%ebx + jae .L87 + jmp .L92 + .align 16 +.L82: + movl -16(%ebp),%edi + movl $1,8(%edi) + movl 8(%ebp),%ecx + movl 4(%ecx),%ecx + incl %ecx + movl %ecx,4(%edi) + jmp .L95 + .align 16 +.L80: + movl -8(%ebp),%edx + subl -12(%ebp),%edx + je .L92 + .align 4 +.L93: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%eax + movl %eax,(%esi) + decl %edx + jne .L93 +.L92: + movl -16(%ebp),%edi + movl (%edi),%ecx + decl %ecx + movl %ecx,4(%edi) + movl 8(%ebp),%edi + movl 4(%edi),%eax + movl -16(%ebp),%ecx + movl %eax,8(%ecx) + addl $4,%ecx + movl %ecx,-16(%ebp) + addl $4,avma + jmp .L95 + .align 16 +.L73: + movl -12(%ebp),%edi + cmpl %edi,-8(%ebp) + jne .L96 + movl 8(%ebp),%ebx + addl $8,%ebx + movl 12(%ebp),%ecx + addl $8,%ecx + movl %ecx,-20(%ebp) + movl -8(%ebp),%edx + addl $-2,%edx + je .L105 + .align 4 +.L99: + movl (%ebx),%edi + movl %edi,-28(%ebp) + addl $4,%ebx + movl -20(%ebp),%ecx + movl (%ecx),%eax + addl $4,%ecx + movl %ecx,-20(%ebp) + cmpl %edi,%eax + ja .L136 + cmpl %eax,%edi + ja .L96 + decl %edx + jne .L99 +.L105: + movl gzero,%eax + jmp .L135 + .align 16 +.L136: + movl 8(%ebp),%edi + movl %edi,-16(%ebp) + movl 12(%ebp),%ecx + movl %ecx,8(%ebp) + movl %edi,12(%ebp) + movl %esi,-4(%ebp) +.L96: + movl -8(%ebp),%edi + pushl %edi + call cgeti + movl %eax,-16(%ebp) + movl $0,-24(%ebp) + leal 0(,%edi,4),%eax + movl 8(%ebp),%ebx + addl %eax,%ebx + movl -12(%ebp),%ecx + movl 12(%ebp),%edi + leal (%edi,%ecx,4),%ecx + movl %ecx,-20(%ebp) + movl -16(%ebp),%esi + addl %eax,%esi + movl -12(%ebp),%edi + addl $-2,%edi + movl %edi,-32(%ebp) + je .L107 + .align 4 +.L108: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%ecx + movl %ecx,-28(%ebp) + addl $-4,-20(%ebp) + movl -20(%ebp),%edi + movl (%edi),%eax + movl %ecx,%edx + subl %eax,%edx + subl -24(%ebp),%edx + cmpl %ecx,%eax + jbe .L109 + movl $1,-24(%ebp) + jmp .L110 + .align 16 +.L109: + cmpl %eax,-28(%ebp) + jbe .L110 + movl $0,-24(%ebp) +.L110: + movl %edx,(%esi) + decl -32(%ebp) + jne .L108 +.L107: + cmpl $0,-24(%ebp) + je .L114 + jmp .L139 + .align 16 + .align 4 +.L117: + addl $-4,%esi + movl $-1,(%esi) +.L139: + addl $-4,%ebx + movl (%ebx),%eax + testl %eax,%eax + je .L117 + movl 8(%ebp),%edx + addl $8,%edx + cmpl %edx,%ebx + jb .L124 + addl $-4,%esi + decl %eax + movl %eax,(%esi) + addl $-4,%ebx + movl %ebx,%eax + cmpl %edx,%ebx + jb .L124 + .align 4 +.L122: + addl $-4,%esi + movl (%eax),%eax + movl %eax,(%esi) + addl $-4,%ebx + movl %ebx,%eax + cmpl %edx,%ebx + jae .L122 + jmp .L124 + .align 16 +.L114: + movl -8(%ebp),%ecx + subl -12(%ebp),%ecx + movl %ecx,-32(%ebp) + je .L124 + .align 4 +.L127: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%eax + movl %eax,(%esi) + decl -32(%ebp) + jne .L127 +.L124: + movl -16(%ebp),%edi + cmpl $0,8(%edi) + je .L129 + movl 8(%ebp),%ecx + movl 4(%ecx),%eax + movl %eax,4(%edi) + jmp .L95 + .align 16 +.L129: + movl -16(%ebp),%esi + addl $12,%esi + movl -16(%ebp),%edi + cmpl $0,12(%edi) + jne .L132 + .align 4 +.L133: + addl $4,%esi + cmpl $0,(%esi) + je .L133 +.L132: + addl $-8,%esi + movl %esi,%ecx + subl -16(%ebp),%ecx + sarl $2,%ecx + movl %ecx,-32(%ebp) + movl -16(%ebp),%edi + movl (%edi),%eax + subl %ecx,%eax + movl %eax,(%esi) + movl %eax,4(%esi) + movl %esi,-16(%ebp) + movb -4(%ebp),%cl + movb %cl,7(%esi) + movl -32(%ebp),%edi + leal 0(,%edi,4),%eax + addl %eax,avma +.L95: + movl -16(%ebp),%eax +.L135: + leal -44(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe4: + .size addii,.Lfe4-addii + .align 16 +.globl mulss + .type mulss,@function +mulss: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + pushl %esi + pushl %ebx + movl 8(%ebp),%edx + movl 12(%ebp),%ebx + testl %edx,%edx + je .L142 + testl %ebx,%ebx + jne .L141 +.L142: + movl gzero,%eax + jmp .L150 + .align 16 +.L141: + movl $1,%esi + testl %edx,%edx + jge .L143 + movl $-1,%esi + negl %edx + jns .L143 + pushl %edx + call stoi + pushl %eax + pushl %ebx + call mulsi + jmp .L150 + .align 16 +.L143: + testl %ebx,%ebx + jge .L145 + negl %esi + negl %ebx + jns .L145 + pushl $ABS_MOST_NEGS + movl %edx,%eax + testl %esi,%esi + jg .L147 + negl %eax +.L147: + pushl %eax + call mulsi + jmp .L150 + .align 16 +.L145: + leal -4(%ebp),%eax + pushl %eax + pushl %ebx + pushl %edx + call mulul3 + movl %eax,%ebx + addl $12,%esp + cmpl $0,-4(%ebp) + je .L148 + pushl $4 + call cgeti + movl %eax,%edx + movl -4(%ebp),%eax + movl %eax,8(%edx) + movl %ebx,12(%edx) + jmp .L149 + .align 16 +.L148: + pushl $3 + call cgeti + movl %eax,%edx + movl %ebx,8(%edx) +.L149: + movl (%edx),%eax + movl %eax,4(%edx) + movl %esi,%ecx + movb %cl,7(%edx) + movl %edx,%eax +.L150: + leal -12(%ebp),%esp + popl %ebx + popl %esi + movl %ebp,%esp + popl %ebp + ret +.Lfe5: + .size mulss,.Lfe5-mulss + .align 16 +.globl mulii + .type mulii,@function +mulii: + pushl %ebp + movl %esp,%ebp + subl $48,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movzwl 4(%esi),%ecx + movl %ecx,-8(%ebp) + movl 12(%ebp),%edi + movzwl 4(%edi),%edi + movl %edi,-12(%ebp) + movl 4(%esi),%ebx + sarl $24,%ebx + je .L177 + movl 12(%ebp),%ecx + movl 4(%ecx),%eax + sarl $24,%eax + jne .L153 +.L177: + movl gzero,%eax + jmp .L176 + .align 16 +.L153: + testl %eax,%eax + jge .L154 + negl %ebx +.L154: + movl -12(%ebp),%edi + cmpl %edi,-8(%ebp) + jle .L155 + movl %esi,-24(%ebp) + movl 12(%ebp),%esi + movl -24(%ebp),%ecx + movl %ecx,12(%ebp) + movl -8(%ebp),%edi + movl %edi,-16(%ebp) + movl -12(%ebp),%ecx + movl %ecx,-8(%ebp) + movl %edi,-12(%ebp) +.L155: + movl -8(%ebp),%edi + movl -12(%ebp),%ecx + leal -2(%ecx,%edi),%edi + movl %edi,-16(%ebp) + cmpl $65535,%edi + jle .L156 + pushl $17 + call err + addl $4,%esp +.L156: + movl -16(%ebp),%edi + pushl %edi + call cgeti + movl %eax,-24(%ebp) + movl (%eax),%eax + movl -24(%ebp),%ecx + movl %eax,4(%ecx) + movb %bl,7(%ecx) + movl -8(%ebp),%edi + leal -4(%esi,%edi,4),%esi + movl %esi,-32(%ebp) + movl (%esi),%ecx + movl %ecx,-20(%ebp) + movl $0,-4(%ebp) + movl -12(%ebp),%edi + movl 12(%ebp),%ecx + leal (%ecx,%edi,4),%edi + movl %edi,-48(%ebp) + movl -16(%ebp),%ecx + movl -24(%ebp),%edi + leal (%edi,%ecx,4),%ecx + movl %ecx,-28(%ebp) + addl $4,%esp + movl -12(%ebp),%esi + addl $-2,%esi + je .L158 + .align 4 +.L159: + addl $-4,-28(%ebp) + movl -4(%ebp),%ebx + leal -4(%ebp),%eax + pushl %eax + addl $-4,-48(%ebp) + movl -48(%ebp),%edi + movl (%edi),%eax + pushl %eax + movl -20(%ebp),%ecx + pushl %ecx + call mulul3 + addl %ebx,%eax + addl $12,%esp + cmpl %ebx,%eax + jae .L161 + incl -4(%ebp) +.L161: + movl -28(%ebp),%edi + movl %eax,(%edi) + decl %esi + jne .L159 +.L158: + movl -4(%ebp),%eax + movl -28(%ebp),%ecx + movl %eax,-4(%ecx) + movl -16(%ebp),%edi + movl -24(%ebp),%ecx + leal (%ecx,%edi,4),%edi + movl %edi,-28(%ebp) + movl -12(%ebp),%ecx + movl 12(%ebp),%edi + leal (%edi,%ecx,4),%ecx + movl %ecx,-36(%ebp) + decl -12(%ebp) + addl $-3,-8(%ebp) + cmpl $0,-8(%ebp) + jle .L164 + .align 4 +.L165: + addl $-4,-32(%ebp) + movl -32(%ebp),%edi + movl (%edi),%edi + movl %edi,-44(%ebp) + movl -36(%ebp),%ecx + movl %ecx,-48(%ebp) + movl -28(%ebp),%ebx + addl $-4,%ebx + movl %ebx,-28(%ebp) + movl $0,-40(%ebp) + movl -12(%ebp),%esi + jmp .L178 + .align 16 + .align 4 +.L168: + addl $-4,-48(%ebp) + movl -48(%ebp),%edi + movl (%edi),%edx + leal -4(%ebp),%eax + pushl %eax + movl -44(%ebp),%ecx + pushl %ecx + pushl %edx + call mulul3 + movl %eax,%edx + addl $-4,%ebx + addl (%ebx),%eax + addl $12,%esp + cmpl %edx,%eax + jae .L170 + incl -4(%ebp) +.L170: + movl %eax,%edx + movl -40(%ebp),%eax + addl %edx,%eax + cmpl %edx,%eax + jae .L172 + incl -4(%ebp) +.L172: + movl %eax,(%ebx) + movl -4(%ebp),%edi + movl %edi,-40(%ebp) +.L178: + decl %esi + jne .L168 + movl -4(%ebp),%eax + movl %eax,-4(%ebx) + decl -8(%ebp) + cmpl $0,-8(%ebp) + jg .L165 +.L164: + movl -24(%ebp),%ecx + cmpl $0,8(%ecx) + jne .L175 + movl -24(%ebp),%ecx + movl 4(%ecx),%edi + decl %edi + movl %edi,8(%ecx) + movl -24(%ebp),%ecx + movl (%ecx),%edi + decl %edi + movl %edi,4(%ecx) + addl $4,%ecx + movl %ecx,-24(%ebp) + addl $4,avma +.L175: + movl -24(%ebp),%eax +.L176: + leal -60(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe6: + .size mulii,.Lfe6-mulii +.section .rodata + .align 4 +.LC0: + .long 0x55475a32,0x3fd34413 +.text + .align 16 +.globl confrac + .type confrac,@function +confrac: + pushl %ebp + movl %esp,%ebp + subl $76,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%eax + movzwl (%eax),%eax + movl %eax,-16(%ebp) + movl 8(%ebp),%edx + movl 4(%edx),%edx + andl $16777215,%edx + movl $8388607,%ecx + subl %edx,%ecx + movl %ecx,-20(%ebp) + movl avma,%eax + movl %eax,-24(%ebp) + movl -16(%ebp),%edx + sall $5,%edx + leal -64(%ecx,%edx),%edx + movl %edx,-32(%ebp) + addl $63,%edx + sarl $5,%edx + movl %edx,-28(%ebp) + pushl %edx + call cgeti + movl %eax,-44(%ebp) + movl -20(%ebp),%esi + sarl $5,%esi + xorl %ebx,%ebx + addl $4,%esp + cmpl %esi,%ebx + jge .L181 + .align 4 +.L183: + movl -44(%ebp),%ecx + movl $0,(%ecx,%ebx,4) + incl %ebx + cmpl %esi,%ebx + jl .L183 +.L181: + andl $31,-20(%ebp) + jne .L185 + movl $2,%edi + cmpl %edi,-16(%ebp) + jle .L191 + .align 4 +.L189: + movl 8(%ebp),%eax + movl (%eax,%edi,4),%eax + movl -44(%ebp),%edx + movl %eax,(%edx,%ebx,4) + incl %ebx + incl %edi + cmpl %edi,-16(%ebp) + jg .L189 + jmp .L191 + .align 16 +.L185: + movl $0,-40(%ebp) + movl $2,%edi + cmpl %edi,-16(%ebp) + jle .L193 + movl $32,%ecx + subl -20(%ebp),%ecx + movl %ecx,-52(%ebp) + .align 4 +.L195: + movl %ebx,-60(%ebp) + movl 8(%ebp),%eax + movl (%eax,%edi,4),%esi + incl %ebx + movl %esi,%eax + movl -52(%ebp),%ecx + sall %cl,%eax + movl %eax,-64(%ebp) + movl %eax,-12(%ebp) + movl -20(%ebp),%ecx + shrl %cl,%esi + movl %esi,%ecx + addl -40(%ebp),%ecx + movl -60(%ebp),%eax + movl -44(%ebp),%edx + movl %ecx,(%edx,%eax,4) + movl -64(%ebp),%eax + movl %eax,-40(%ebp) + incl %edi + cmpl %edi,-16(%ebp) + jg .L195 +.L193: + movl -40(%ebp),%eax + movl -28(%ebp),%edx + movl -44(%ebp),%ecx + movl %eax,-8(%ecx,%edx,4) +.L191: + movl -28(%ebp),%edx + movl -44(%ebp),%ecx + movl $0,-4(%ecx,%edx,4) + fldl .LC0 + fimull -32(%ebp) + fld1 + faddp %st,%st(1) + fnstcw -4(%ebp) + movl -4(%ebp),%eax + movb $12,%ah + movl %eax,-8(%ebp) + fldcw -8(%ebp) + subl $4,%esp + fistpl (%esp) + popl %ebx + fldcw -4(%ebp) + leal 17(%ebx),%edx + movl %edx,-36(%ebp) + movl -36(%ebp),%eax + movl $9,%ecx + cltd + idivl %ecx + movl %eax,-36(%ebp) + pushl %eax + call cgeti + movl %eax,-48(%ebp) + movl %ebx,(%eax) + movl $1,%edi + addl $4,%esp + cmpl %edi,-36(%ebp) + jle .L198 + .align 4 +.L200: + movl $0,-12(%ebp) + movl -28(%ebp),%ebx + decl %ebx + js .L202 + .align 4 +.L204: + movl -12(%ebp),%esi + leal -12(%ebp),%eax + pushl %eax + pushl $1000000000 + movl -44(%ebp),%edx + movl (%edx,%ebx,4),%edx + pushl %edx + call mulul3 + movl %eax,-64(%ebp) + addl %esi,-64(%ebp) + addl $12,%esp + cmpl %esi,-64(%ebp) + jae .L206 + incl -12(%ebp) +.L206: + movl -64(%ebp),%eax + movl -44(%ebp),%ecx + movl %eax,(%ecx,%ebx,4) + decl %ebx + jns .L204 +.L202: + movl -12(%ebp),%edx + movl -48(%ebp),%ecx + movl %edx,(%ecx,%edi,4) + incl %edi + cmpl %edi,-36(%ebp) + jg .L200 +.L198: + movl -24(%ebp),%eax + movl %eax,avma + movl -48(%ebp),%eax + leal -88(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe7: + .size confrac,.Lfe7-confrac + .align 16 +.globl divss + .type divss,@function +divss: + pushl %ebp + movl %esp,%ebp + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 12(%ebp),%ebx + testl %ebx,%ebx + jne .L210 + pushl $23 + call err + addl $4,%esp +.L210: + cmpl $-2147483648,%esi + jne .L211 + pushl %ebx + pushl $-2147483648 + call stoi + addl $4,%esp + pushl %eax + call divis + jmp .L216 + .align 16 +.L211: + movl $0,hiremainder + pushl $hiremainder + movl %ebx,%eax + testl %ebx,%ebx + jge .L212 + negl %eax +.L212: + pushl %eax + movl %esi,%eax + testl %esi,%esi + jge .L213 + negl %eax +.L213: + pushl %eax + call divul3 + addl $12,%esp + testl %ebx,%ebx + jge .L214 + negl hiremainder + negl %eax +.L214: + testl %esi,%esi + jge .L215 + negl %eax +.L215: + pushl %eax + call stoi +.L216: + leal -8(%ebp),%esp + popl %ebx + popl %esi + movl %ebp,%esp + popl %ebp + ret +.Lfe8: + .size divss,.Lfe8-divss + .align 16 +.globl modss + .type modss,@function +modss: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 12(%ebp),%ebx + testl %ebx,%ebx + jne .L218 + pushl $38 + call err + addl $4,%esp +.L218: + cmpl $-2147483648,%esi + jne .L219 + pushl %ebx + pushl $-2147483648 + call stoi + addl $4,%esp + pushl %eax + call modis + jmp .L225 + .align 16 +.L219: + movl $0,-4(%ebp) + leal -4(%ebp),%eax + pushl %eax + testl %ebx,%ebx + jge .L220 + negl %ebx +.L220: + pushl %ebx + movl %esi,%eax + testl %eax,%eax + jge .L221 + negl %eax +.L221: + pushl %eax + call divul3 + addl $12,%esp + cmpl $0,-4(%ebp) + jne .L222 + movl gzero,%eax + jmp .L225 + .align 16 +.L222: + cmpl $0,-4(%ebp) + jge .L223 + movl %ebx,%eax + subl -4(%ebp),%eax + jmp .L226 + .align 16 +.L223: + movl -4(%ebp),%eax +.L226: + pushl %eax + call stoi +.L225: + leal -12(%ebp),%esp + popl %ebx + popl %esi + movl %ebp,%esp + popl %ebp + ret +.Lfe9: + .size modss,.Lfe9-modss + .align 16 +.globl resss + .type resss,@function +resss: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + pushl %ebx + movl 12(%ebp),%ebx + testl %ebx,%ebx + jne .L228 + pushl $40 + call err + addl $4,%esp +.L228: + movl $0,-4(%ebp) + leal -4(%ebp),%eax + pushl %eax + movl %ebx,%eax + testl %ebx,%ebx + jge .L229 + negl %eax +.L229: + pushl %eax + movl 8(%ebp),%eax + testl %eax,%eax + jge .L230 + negl %eax +.L230: + pushl %eax + call divul3 + addl $12,%esp + testl %ebx,%ebx + jge .L231 + movl -4(%ebp),%eax + negl %eax + jmp .L233 + .align 16 +.L231: + movl -4(%ebp),%eax +.L233: + pushl %eax + call stoi + movl -8(%ebp),%ebx + movl %ebp,%esp + popl %ebp + ret +.Lfe10: + .size resss,.Lfe10-resss + .align 16 +.globl divsi + .type divsi,@function +divsi: + pushl %ebp + movl %esp,%ebp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%ebx + movl 12(%ebp),%esi + movzwl 4(%esi),%edi + cmpb $0,7(%esi) + jne .L235 + pushl $24 + call err + addl $4,%esp +.L235: + testl %ebx,%ebx + je .L237 + cmpl $3,%edi + jg .L237 + cmpl $0,8(%esi) + jge .L236 +.L237: + movl %ebx,hiremainder + movl gzero,%eax + jmp .L242 + .align 16 +.L236: + cmpl $-2147483648,%ebx + jne .L238 + pushl $0 + pushl %esi + pushl $-2147483648 + call stoi + addl $4,%esp + pushl %eax + call dvmdii + jmp .L242 + .align 16 +.L238: + movl $0,hiremainder + pushl $hiremainder + movl 8(%esi),%eax + pushl %eax + movl %ebx,%eax + testl %ebx,%ebx + jge .L239 + negl %eax +.L239: + pushl %eax + call divul3 + addl $12,%esp + cmpl $0,4(%esi) + jge .L240 + negl hiremainder + negl %eax +.L240: + testl %ebx,%ebx + jge .L241 + negl %eax +.L241: + pushl %eax + call stoi +.L242: + leal -12(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe11: + .size divsi,.Lfe11-divsi + .align 16 +.globl divis + .type divis,@function +divis: + pushl %ebp + movl %esp,%ebp + subl $24,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 12(%ebp),%edi + movl 8(%ebp),%edx + movl 4(%edx),%edx + sarl $24,%edx + movl %edx,-8(%ebp) + movl 8(%ebp),%ecx + movzwl 4(%ecx),%ecx + movl %ecx,-12(%ebp) + testl %edi,%edi + jne .L244 + pushl $26 + call err + addl $4,%esp +.L244: + cmpl $0,-8(%ebp) + jne .L245 + movl $0,hiremainder + movl gzero,%eax + jmp .L259 + .align 16 +.L245: + testl %edi,%edi + jge .L246 + negl -8(%ebp) + negl %edi + jns .L246 + pushl $0 + pushl %edi + call stoi + addl $4,%esp + pushl %eax + movl 8(%ebp),%edx + pushl %edx + call dvmdii + jmp .L259 + .align 16 +.L246: + movl 8(%ebp),%ecx + cmpl %edi,8(%ecx) + jae .L248 + cmpl $3,-12(%ebp) + jne .L249 + pushl %ecx + call itos + movl %eax,hiremainder + movl gzero,%eax + jmp .L259 + .align 16 +.L249: + movl -12(%ebp),%eax + decl %eax + pushl %eax + call cgeti + movl %eax,%esi + movl $1,-16(%ebp) + movl 8(%ebp),%edx + movl 8(%edx),%eax + movl %eax,-4(%ebp) + jmp .L260 + .align 16 +.L248: + movl -12(%ebp),%ecx + pushl %ecx + call cgeti + movl %eax,%esi + movl $0,-16(%ebp) + movl $0,-4(%ebp) +.L260: + addl $4,%esp + movl -16(%ebp),%ebx + addl $2,%ebx + cmpl %ebx,-12(%ebp) + jle .L253 + leal -4(%ebp),%edx + movl %edx,-20(%ebp) + .align 4 +.L255: + movl -20(%ebp),%ecx + pushl %ecx + pushl %edi + movl 8(%ebp),%edx + movl (%edx,%ebx,4),%eax + pushl %eax + call divul3 + movl %eax,-24(%ebp) + movl %ebx,%eax + subl -16(%ebp),%eax + movl -24(%ebp),%ecx + movl %ecx,(%esi,%eax,4) + addl $12,%esp + incl %ebx + cmpl %ebx,-12(%ebp) + jg .L255 +.L253: + movl (%esi),%eax + movl %eax,4(%esi) + movb -8(%ebp),%dl + movb %dl,7(%esi) + cmpl $0,-8(%ebp) + jge .L257 + movl -4(%ebp),%ecx + negl %ecx + movl %ecx,hiremainder + jmp .L258 + .align 16 +.L257: + movl -4(%ebp),%eax + movl %eax,hiremainder +.L258: + movl %esi,%eax +.L259: + leal -36(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe12: + .size divis,.Lfe12-divis + .align 16 +.globl dvmdii + .type dvmdii,@function +dvmdii: + pushl %ebp + movl %esp,%ebp + subl $88,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 4(%esi),%ecx + sarl $24,%ecx + movl %ecx,-36(%ebp) + movl 12(%ebp),%edi + movl 4(%edi),%edi + sarl $24,%edi + movl %edi,-40(%ebp) + jne .L262 + pushl $36 + call err + addl $4,%esp +.L262: + cmpl $0,-36(%ebp) + jne .L263 + cmpl $-1,16(%ebp) + je .L372 + cmpl $0,16(%ebp) + je .L372 + movl gzero,%eax + movl 16(%ebp),%ecx + movl %eax,(%ecx) +.L372: + movl gzero,%eax + jmp .L367 + .align 16 +.L263: + movzwl 4(%esi),%edi + movl %edi,-12(%ebp) + movl 12(%ebp),%ecx + movzwl 4(%ecx),%ecx + movl %ecx,-16(%ebp) + subl %ecx,%edi + movl %edi,-20(%ebp) + jns .L266 + cmpl $-1,16(%ebp) + jne .L267 + pushl %esi + call icopy + jmp .L367 + .align 16 +.L267: + cmpl $0,16(%ebp) + je .L372 + pushl %esi + call icopy + movl 16(%ebp),%edi + movl %eax,(%edi) + jmp .L372 + .align 16 +.L266: + movl avma,%ecx + movl %ecx,-8(%ebp) + cmpl $0,-36(%ebp) + jge .L269 + negl -40(%ebp) +.L269: + cmpl $3,-16(%ebp) + jne .L270 + movl 12(%ebp),%edi + movl 8(%edi),%edi + movl %edi,-48(%ebp) + leal 8(%esi),%ecx + movl %ecx,-88(%ebp) + cmpl %edi,8(%esi) + jae .L271 + movl -12(%ebp),%ebx + decl %ebx + movl 8(%esi),%eax + movl %eax,-4(%ebp) + addl $12,%esi + movl %esi,-88(%ebp) + jmp .L272 + .align 16 +.L271: + movl -12(%ebp),%ebx + movl $0,-4(%ebp) +.L272: + pushl %ebx + call cgeti + movl %eax,-56(%ebp) + movl %eax,%edi + addl $8,%edi + movl %edi,-72(%ebp) + addl $4,%esp + leal -2(%ebx),%ecx + movl %ecx,-24(%ebp) + testl %ecx,%ecx + je .L274 + leal -4(%ebp),%esi + .align 4 +.L275: + pushl %esi + movl -48(%ebp),%edi + pushl %edi + movl -88(%ebp),%ecx + movl (%ecx),%eax + pushl %eax + addl $4,%ecx + movl %ecx,-88(%ebp) + call divul3 + movl -72(%ebp),%edi + movl %eax,(%edi) + addl $4,%edi + movl %edi,-72(%ebp) + addl $12,%esp + decl -24(%ebp) + jne .L275 +.L274: + cmpl $-1,16(%ebp) + jne .L277 + movl -8(%ebp),%ecx + movl %ecx,avma + cmpl $0,-4(%ebp) + je .L372 + pushl $3 + call cgeti + movl %eax,-60(%ebp) + movl -36(%ebp),%eax + sall $24,%eax + addl $3,%eax + movl -60(%ebp),%edi + movl %eax,4(%edi) + movl -4(%ebp),%eax + movl %eax,8(%edi) + movl -60(%ebp),%eax + jmp .L367 + .align 16 +.L277: + cmpl $2,%ebx + je .L279 + movl -56(%ebp),%ecx + movl (%ecx),%eax + movl %eax,4(%ecx) + movb -40(%ebp),%cl + movl -56(%ebp),%edi + movb %cl,7(%edi) + jmp .L280 + .align 16 +.L279: + movl -8(%ebp),%ecx + movl %ecx,avma + movl gzero,%edi + movl %edi,-56(%ebp) +.L280: + cmpl $0,16(%ebp) + jne .L281 +.L370: + movl -56(%ebp),%eax + jmp .L367 + .align 16 +.L281: + cmpl $0,-4(%ebp) + jne .L282 + movl gzero,%eax + movl 16(%ebp),%ecx + movl %eax,(%ecx) + jmp .L370 + .align 16 +.L282: + pushl $3 + call cgeti + movl %eax,-60(%ebp) + movl -36(%ebp),%eax + sall $24,%eax + addl $3,%eax + movl -60(%ebp),%edi + movl %eax,4(%edi) + movl -4(%ebp),%eax + movl %eax,8(%edi) + movl 16(%ebp),%ecx + movl %edi,(%ecx) + jmp .L370 + .align 16 +.L270: + movl -12(%ebp),%edi + pushl %edi + call cgeti + movl %eax,-56(%ebp) + movl 12(%ebp),%ecx + movl 8(%ecx),%eax + pushl %eax + call bfffo + movl %eax,-28(%ebp) + addl $8,%esp + testl %eax,%eax + je .L285 + movl -16(%ebp),%edi + pushl %edi + call cgeti + movl %eax,-60(%ebp) + movl 12(%ebp),%ecx + movl 8(%ecx),%ebx + movl %ecx,%edx + addl $12,%edx + movl $32,%eax + subl -28(%ebp),%eax + movl %ebx,%edi + movl %eax,%ecx + shrl %cl,%edi + movl %edi,-4(%ebp) + movl -28(%ebp),%ecx + sall %cl,%ebx + movl %ebx,-32(%ebp) + movl -60(%ebp),%eax + addl $8,%eax + addl $4,%esp + movl -16(%ebp),%edi + addl $-3,%edi + movl %edi,-24(%ebp) + je .L287 + movl $32,%edi + subl %ecx,%edi + movl %edi,-88(%ebp) + .align 4 +.L288: + movl (%edx),%ebx + addl $4,%edx + movl %ebx,%edi + movl -88(%ebp),%ecx + shrl %cl,%edi + movl %edi,-4(%ebp) + movl -32(%ebp),%ecx + addl %edi,%ecx + movl %ecx,(%eax) + addl $4,%eax + movl -28(%ebp),%ecx + sall %cl,%ebx + movl %ebx,-32(%ebp) + decl -24(%ebp) + jne .L288 +.L287: + movl -32(%ebp),%edi + movl %edi,(%eax) + movl $0,-32(%ebp) + addl $8,%esi + movl %esi,-88(%ebp) + movl -56(%ebp),%ecx + addl $4,%ecx + movl %ecx,-72(%ebp) + movl -12(%ebp),%edi + addl $-2,%edi + movl %edi,-24(%ebp) + je .L291 + movl $32,%eax + subl -28(%ebp),%eax + .align 4 +.L292: + movl -88(%ebp),%ecx + movl (%ecx),%ebx + addl $4,%ecx + movl %ecx,-88(%ebp) + movl %ebx,%edi + movl %eax,%ecx + shrl %cl,%edi + movl %edi,-4(%ebp) + movl -32(%ebp),%ecx + addl -4(%ebp),%ecx + movl -72(%ebp),%edi + movl %ecx,(%edi) + addl $4,%edi + movl %edi,-72(%ebp) + movl -28(%ebp),%ecx + sall %cl,%ebx + movl %ebx,-32(%ebp) + decl -24(%ebp) + jne .L292 +.L291: + movl -32(%ebp),%ecx + movl -72(%ebp),%edi + movl %ecx,(%edi) + jmp .L294 + .align 16 +.L285: + addl $8,%esi + movl %esi,-88(%ebp) + movl -56(%ebp),%edi + movl $0,4(%edi) + addl $8,%edi + movl %edi,-72(%ebp) + movl -12(%ebp),%esi + addl $-2,%esi + je .L296 + .align 4 +.L297: + movl -88(%ebp),%ecx + movl (%ecx),%eax + movl -72(%ebp),%edi + movl %eax,(%edi) + addl $4,%ecx + movl %ecx,-88(%ebp) + addl $4,%edi + movl %edi,-72(%ebp) + decl %esi + jne .L297 +.L296: + movl 12(%ebp),%ecx + movl %ecx,-60(%ebp) +.L294: + movl -60(%ebp),%edi + movl 8(%edi),%edi + movl %edi,-48(%ebp) + movl -60(%ebp),%ecx + movl 12(%ecx),%ecx + movl %ecx,-44(%ebp) + movl -56(%ebp),%edi + addl $4,%edi + movl %edi,-72(%ebp) + movl -20(%ebp),%ecx + incl %ecx + movl %ecx,-24(%ebp) + je .L300 + movl -16(%ebp),%edi + sall $2,%edi + movl %edi,-80(%ebp) + .align 4 +.L301: + movl -72(%ebp),%ecx + movl (%ecx),%eax + addl $4,%ecx + movl %ecx,-72(%ebp) + cmpl %eax,-48(%ebp) + jne .L302 + movl $-1,-52(%ebp) + movl -48(%ebp),%ebx + movl %ebx,%edi + addl (%ecx),%edi + movl %edi,-84(%ebp) + cmpl %ebx,%edi + setb %al + andl $255,%eax + movl %edi,-32(%ebp) + jmp .L303 + .align 16 +.L302: + movl -72(%ebp),%ecx + movl -4(%ecx),%eax + movl %eax,-4(%ebp) + leal -4(%ebp),%eax + pushl %eax + movl -48(%ebp),%edi + pushl %edi + movl (%ecx),%eax + pushl %eax + call divul3 + movl %eax,-52(%ebp) + xorl %eax,%eax + movl -4(%ebp),%ecx + movl %ecx,-32(%ebp) + addl $12,%esp +.L303: + testl %eax,%eax + jne .L304 + leal -4(%ebp),%eax + pushl %eax + movl -44(%ebp),%edi + pushl %edi + movl -52(%ebp),%ecx + pushl %ecx + call mulul3 + movl %eax,%ebx + movl -72(%ebp),%edi + movl 4(%edi),%edx + addl $12,%esp + cmpl %edx,%ebx + setb %al + andl $255,%eax + movl %ebx,%esi + subl %edx,%esi + movl -4(%ebp),%ebx + movl -32(%ebp),%edx + movl %ebx,%ecx + subl %edx,%ecx + subl %eax,%ecx + movl %ecx,-84(%ebp) + cmpl %ebx,%edx + ja .L373 + jmp .L313 + .align 16 + .align 4 +.L317: + cmpl $0,-88(%ebp) + je .L304 + decl -52(%ebp) + movl %esi,%ebx + movl -44(%ebp),%edx + cmpl %edx,%ebx + setb %al + andl $255,%eax + subl %edx,%esi + movl -88(%ebp),%ebx + movl -48(%ebp),%edx + movl %ebx,%ecx + subl %edx,%ecx + subl %eax,%ecx + movl %ecx,-84(%ebp) + cmpl %ebx,%edx + jbe .L313 +.L373: + movl $1,%eax + jmp .L314 + .align 16 +.L313: + cmpl %ebx,%edx + jae .L314 + xorl %eax,%eax +.L314: + movl -84(%ebp),%edi + movl %edi,-88(%ebp) + testl %eax,%eax + je .L317 +.L304: + movl $0,-4(%ebp) + movl -72(%ebp),%ecx + movl -80(%ebp),%edi + leal -8(%edi,%ecx),%ecx + movl %ecx,-88(%ebp) + movl -60(%ebp),%ecx + addl %edi,%ecx + movl %ecx,-76(%ebp) + movl -16(%ebp),%esi + addl $-2,%esi + je .L319 + .align 4 +.L320: + movl -4(%ebp),%ebx + leal -4(%ebp),%eax + pushl %eax + addl $-4,-76(%ebp) + movl -76(%ebp),%edi + movl (%edi),%eax + pushl %eax + movl -52(%ebp),%ecx + pushl %ecx + call mulul3 + movl %eax,-84(%ebp) + addl %ebx,-84(%ebp) + addl $12,%esp + cmpl %ebx,-84(%ebp) + jae .L322 + incl -4(%ebp) +.L322: + movl -84(%ebp),%edx + addl $-4,-88(%ebp) + movl -88(%ebp),%edi + movl (%edi),%ebx + cmpl %edx,%ebx + setb %al + andl $255,%eax + subl %edx,%ebx + movl %ebx,(%edi) + addl %eax,-4(%ebp) + decl %esi + jne .L320 +.L319: + movl -72(%ebp),%ecx + movl -4(%ecx),%eax + cmpl %eax,-4(%ebp) + jbe .L324 + xorl %eax,%eax + decl -52(%ebp) + movl -80(%ebp),%edi + leal -8(%edi,%ecx),%edi + movl %edi,-88(%ebp) + movl -60(%ebp),%ecx + addl -80(%ebp),%ecx + movl %ecx,-76(%ebp) + movl -16(%ebp),%esi + addl $-2,%esi + je .L324 + .align 4 +.L327: + movl -88(%ebp),%edx + addl $-4,%edx + movl %edx,-88(%ebp) + movl (%edx),%ebx + addl $-4,-76(%ebp) + movl %ebx,%ecx + movl -76(%ebp),%edi + addl (%edi),%ecx + movl %ecx,-84(%ebp) + cmpl %ebx,%ecx + jae .L328 + addl %eax,%ecx + movl %ecx,-84(%ebp) + movl $1,%eax + movl %ecx,(%edx) + jmp .L325 + .align 16 +.L328: + addl %eax,-84(%ebp) + cmpl %eax,-84(%ebp) + setb %al + andl $255,%eax + movl -84(%ebp),%edi + movl %edi,(%edx) +.L325: + decl %esi + jne .L327 +.L324: + movl -52(%ebp),%edi + movl -72(%ebp),%ecx + movl %edi,-4(%ecx) + decl -24(%ebp) + jne .L301 +.L300: + movl avma,%ecx + movl %ecx,-88(%ebp) + cmpl $-1,16(%ebp) + je .L332 + movl -20(%ebp),%ebx + addl $2,%ebx + movl -56(%ebp),%edi + leal (%edi,%ebx,4),%edi + movl %edi,-72(%ebp) + movl -56(%ebp),%ecx + cmpl $0,4(%ecx) + je .L333 + movl -20(%ebp),%ebx + addl $3,%ebx + jmp .L334 + .align 16 +.L333: + cmpl $0,-20(%ebp) + jne .L334 + movl $0,-40(%ebp) +.L334: + pushl %ebx + call cgeti + movl %eax,-64(%ebp) + leal (%eax,%ebx,4),%edx + addl $4,%esp + leal -2(%ebx),%esi + testl %esi,%esi + je .L337 + .align 4 +.L338: + addl $-4,%edx + addl $-4,-72(%ebp) + movl -72(%ebp),%edi + movl (%edi),%eax + movl %eax,(%edx) + decl %esi + jne .L338 +.L337: + cmpl $2,%ebx + ja .L340 + movl -64(%ebp),%ecx + movl $2,4(%ecx) + jmp .L332 + .align 16 +.L340: + movl -64(%ebp),%edi + movl (%edi),%eax + movl %eax,4(%edi) + movb -40(%ebp),%cl + movb %cl,7(%edi) +.L332: + cmpl $0,16(%ebp) + je .L342 + movl -20(%ebp),%esi + addl $2,%esi + cmpl %esi,-12(%ebp) + jle .L344 + movl -56(%ebp),%edi + cmpl $0,(%edi,%esi,4) + jne .L344 + movl -20(%ebp),%esi + addl $3,%esi + cmpl %esi,-12(%ebp) + jle .L344 + cmpl $0,(%edi,%esi,4) + jne .L344 + .align 4 +.L345: + incl %esi + cmpl %esi,-12(%ebp) + jle .L344 + movl -56(%ebp),%ecx + cmpl $0,(%ecx,%esi,4) + je .L345 +.L344: + cmpl %esi,-12(%ebp) + jne .L349 + movl gzero,%eax + pushl %eax + call icopy + movl %eax,-68(%ebp) + addl $4,%esp + jmp .L342 + .align 16 +.L349: + movl -12(%ebp),%eax + subl %esi,%eax + addl $2,%eax + pushl %eax + call cgeti + movl %eax,-68(%ebp) + movl (%eax),%eax + movl -68(%ebp),%edi + movl %eax,4(%edi) + addl $4,%esp + cmpl $0,-28(%ebp) + jne .L351 + movl $2,-24(%ebp) + cmpl %esi,-12(%ebp) + jle .L357 + .align 4 +.L355: + movl -56(%ebp),%ecx + movl (%ecx,%esi,4),%eax + movl -24(%ebp),%edi + movl -68(%ebp),%ecx + movl %eax,(%ecx,%edi,4) + incl %esi + incl %edi + movl %edi,-24(%ebp) + cmpl %esi,-12(%ebp) + jg .L355 + jmp .L357 + .align 16 +.L351: + movl $0,-4(%ebp) + movl -56(%ebp),%edi + movl (%edi,%esi,4),%ebx + incl %esi + movl $32,%eax + subl -28(%ebp),%eax + movl %ebx,%edi + movl %eax,%ecx + sall %cl,%edi + movl %edi,%eax + movl %eax,-4(%ebp) + movl %ebx,%edx + movl -28(%ebp),%ecx + shrl %cl,%edx + movl %eax,-32(%ebp) + testl %edx,%edx + je .L358 + movl -68(%ebp),%edi + movl %edx,8(%edi) + movl $1,%eax + jmp .L359 + .align 16 +.L358: + movl -68(%ebp),%ecx + movl (%ecx),%edi + decl %edi + movl %edi,4(%ecx) + addl $4,%ecx + movl %ecx,-68(%ebp) + addl $4,avma + movl (%ecx),%eax + movl %eax,4(%ecx) + xorl %eax,%eax +.L359: + addl $2,%eax + movl %eax,-24(%ebp) + cmpl %esi,-12(%ebp) + jle .L357 + movl $32,%ecx + subl -28(%ebp),%ecx + movl %ecx,-84(%ebp) + .align 4 +.L363: + movl -56(%ebp),%edi + movl (%edi,%esi,4),%ebx + movl %ebx,%edx + movl -84(%ebp),%ecx + sall %cl,%edx + movl %edx,-4(%ebp) + movl %ebx,%eax + movl -28(%ebp),%ecx + shrl %cl,%eax + addl -32(%ebp),%eax + movl -24(%ebp),%edi + movl -68(%ebp),%ecx + movl %eax,(%ecx,%edi,4) + movl %edx,-32(%ebp) + incl %esi + incl %edi + movl %edi,-24(%ebp) + cmpl %esi,-12(%ebp) + jg .L363 +.L357: + movb -36(%ebp),%cl + movl -68(%ebp),%edi + movb %cl,7(%edi) +.L342: + cmpl $-1,16(%ebp) + jne .L365 + movl -68(%ebp),%ecx + pushl %ecx + movl -88(%ebp),%edi + pushl %edi + movl -8(%ebp),%ecx + pushl %ecx + jmp .L371 + .align 16 +.L365: + cmpl $0,16(%ebp) + je .L366 + pushl $0 + movl -88(%ebp),%edi + pushl %edi + movl -8(%ebp),%ecx + pushl %ecx + call gerepile + andb $252,%al + movl -68(%ebp),%ecx + addl %eax,%ecx + movl 16(%ebp),%edi + movl %ecx,(%edi) + addl -64(%ebp),%eax + jmp .L367 + .align 16 +.L366: + movl -64(%ebp),%edi + pushl %edi + movl -88(%ebp),%ecx + pushl %ecx + movl -8(%ebp),%edi + pushl %edi +.L371: + call gerepile +.L367: + leal -100(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.Lfe13: + .size dvmdii,.Lfe13-dvmdii + .ident "GCC: (GNU) 2.7.2.1" diff --git a/mp/mpi-386d.S b/mp/mpi-386d.S new file mode 100755 index 0000000..5985053 --- /dev/null +++ b/mp/mpi-386d.S @@ -0,0 +1,2323 @@ +# 1 "../mp/mpi-386d.S" + + +# 11 "../mp/mpi-386d.S" + + + + + + + + + + + +# 30 "../mp/mpi-386d.S" + + + + + + + + + + + + + + + + + + .file "mpi.c" +gcc2_compiled.: +___gnu_compiled_c: +.text + .align 4 +.globl _mulsi ; .align 4,0x90 ; _mulsi: + pushl %ebp + movl %esp,%ebp + subl $20,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 12(%ebp),%ebx + movl 4(%ebx),%ecx + sarl $24,%ecx + movl %ecx,-8(%ebp) + movzwl 4(%ebx),%edx + movl %edx,-12(%ebp) + cmpl $0,8(%ebp) + je L3 + testl %ecx,%ecx + jne L2 +L3: + movl _gzero ,%eax + jmp L13 + .align 4,0x90 +L2: + cmpl $0,8(%ebp) + jge L4 + negl -8(%ebp) + negl 8(%ebp) + jns L4 + pushl %ebx + pushl $-2147483648 + call _stoi + addl $4,%esp + pushl %eax + call _mulii + jmp L13 + .align 4,0x90 +L4: + movl -12(%ebp),%eax + incl %eax + pushl %eax + call _cgeti + movl %eax,-16(%ebp) + movl $0,-4(%ebp) + movl -12(%ebp),%ecx + leal 0(,%ecx,4),%eax + addl %eax,%ebx + movl %ebx,-20(%ebp) + movl -16(%ebp),%edx + leal 4(%eax,%edx),%esi + addl $4,%esp + movl %ecx,%edi + addl $-2,%edi + je L7 + .align 2,0x90 +L10: + addl $-4,%esi + movl -4(%ebp),%ebx + leal -4(%ebp),%eax + pushl %eax + addl $-4,-20(%ebp) + movl -20(%ebp),%ecx + movl (%ecx),%ecx + pushl %ecx + movl 8(%ebp),%edx + pushl %edx + call _mulul3 + addl %ebx,%eax + cmpl %ebx,%eax + jae L9 + incl -4(%ebp) +L9: + movl %eax,(%esi) + addl $12,%esp + decl %edi + jne L10 +L7: + cmpl $0,-4(%ebp) + je L11 + movl -4(%ebp),%ecx + movl %ecx,-4(%esi) + movl -16(%ebp),%edx + movl 4(%edx),%eax + andl $-65536,%eax + movl -12(%ebp),%ecx + leal 1(%ecx,%eax),%eax + movl %eax,4(%edx) + jmp L12 + .align 4,0x90 +L11: + addl $4,_avma + movl -16(%ebp),%edx + movl (%edx),%ecx + decl %ecx + movl %ecx,4(%edx) + addl $4,%edx + movl %edx,-16(%ebp) + movw -12(%ebp),%cx + movw %cx,4(%edx) +L12: + movb -8(%ebp),%dl + movl -16(%ebp),%ecx + movb %dl,7(%ecx) + movl -16(%ebp),%eax +L13: + leal -32(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _expi ; .align 4,0x90 ; _expi: + pushl %ebp + movl %esp,%ebp + pushl %ebx + movl 8(%ebp),%eax + movzwl 4(%eax),%ebx + cmpl $2,%ebx + je L15 + movl 8(%eax),%eax + pushl %eax + call _bfffo + leal -2(%ebx),%edx + sall $5,%edx + subl %eax,%edx + decl %edx + jmp L16 + .align 4,0x90 +L15: + movl $-8388608,%edx +L16: + movl %edx,%eax + movl -4(%ebp),%ebx + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _addsi ; .align 4,0x90 ; _addsi: + pushl %ebp + movl %esp,%ebp + subl $12,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 12(%ebp),%edi + testl %esi,%esi + jne L18 + pushl %edi + call _icopy + jmp L60 + .align 4,0x90 +L18: + movl 4(%edi),%ebx + sarl $24,%ebx + movl %ebx,-8(%ebp) + jne L19 + pushl %esi + call _stoi + jmp L60 + .align 4,0x90 +L19: + testl %esi,%esi + jge L20 + movl $-1,-4(%ebp) + negl %esi + jns L22 + pushl %edi + pushl $ _MOST_NEGS + call _addii + jmp L60 + .align 4,0x90 +L20: + movl $1,-4(%ebp) +L22: + movzwl 4(%edi),%ebx + movl %ebx,-12(%ebp) + movl -8(%ebp),%ebx + cmpl %ebx,-4(%ebp) + jne L23 + movl %esi,%edx + movl %edx,%eax + movl -12(%ebp),%ebx + addl -4(%edi,%ebx,4),%eax + movl %eax,%esi + cmpl %edx,%eax + jae L24 + movl %ebx,%eax + incl %eax + pushl %eax + call _cgeti + movl %eax,%ecx + movl %esi,(%ecx,%ebx,4) + movl %ebx,%edx + jmp L61 + .align 4,0x90 + .align 2,0x90 +L28: + movl $0,(%ecx,%edx,4) +L61: + decl %edx + cmpl $2,%edx + jle L29 + cmpl $-1,-4(%edi,%edx,4) + je L28 + cmpl $2,%edx + jle L29 + movl -4(%edi,%edx,4),%ebx + incl %ebx + jmp L62 + .align 4,0x90 + .align 2,0x90 +L32: + movl -4(%edi,%edx,4),%ebx +L62: + movl %ebx,(%ecx,%edx,4) + decl %edx + cmpl $2,%edx + jg L32 + movl (%ecx),%eax + decl %eax + movl %eax,4(%ecx) + movl %eax,8(%ecx) + addl $4,%ecx + addl $4,_avma + jmp L34 + .align 4,0x90 +L29: + movl $1,8(%ecx) + movl (%ecx),%ebx + movl %ebx,4(%ecx) + jmp L34 + .align 4,0x90 +L24: + movl -12(%ebp),%ebx + pushl %ebx + call _cgeti + movl %eax,%ecx + movl %esi,-4(%ecx,%ebx,4) + movl $1,%edx + movl %ebx,%eax + decl %eax + movl %eax,%esi + cmpl %eax,%edx + jge L34 + .align 2,0x90 +L38: + movl (%edi,%edx,4),%ebx + movl %ebx,(%ecx,%edx,4) + incl %edx + cmpl %esi,%edx + jl L38 +L34: + movb -4(%ebp),%bl + movb %bl,7(%ecx) + jmp L39 + .align 4,0x90 +L23: + cmpl $3,-12(%ebp) + jne L40 + cmpl %esi,8(%edi) + jbe L41 + pushl $3 + call _cgeti + movl %eax,%ecx + movl -8(%ebp),%eax + sall $24,%eax + addl $3,%eax + movl %eax,4(%ecx) + movl 8(%edi),%edi + subl %esi,%edi + movl %edi,8(%ecx) + jmp L39 + .align 4,0x90 +L41: + cmpl %esi,8(%edi) + jne L42 + movl _gzero ,%eax + jmp L60 + .align 4,0x90 +L42: + pushl $3 + call _cgeti + movl %eax,%ecx + movl -8(%ebp),%eax + negl %eax + sall $24,%eax + addl $3,%eax + movl %eax,4(%ecx) + subl 8(%edi),%esi + movl %esi,8(%ecx) + jmp L39 + .align 4,0x90 +L40: + movl -12(%ebp),%ebx + movl -4(%edi,%ebx,4),%edx + movl %esi,%eax + movl %edx,%esi + subl %eax,%esi + cmpl %eax,%edx + jae L43 + pushl %ebx + call _cgeti + movl %eax,%ecx + movl %esi,-4(%ecx,%ebx,4) + movl %ebx,%edx + addl $-2,%edx + cmpl $0,(%edi,%edx,4) + jne L45 + .align 2,0x90 +L47: + movl $-1,(%ecx,%edx,4) + decl %edx + cmpl $0,(%edi,%edx,4) + je L47 +L45: + movl (%edi,%edx,4),%eax + decl %eax + movl %eax,(%ecx,%edx,4) + cmpl $2,%edx + jg L49 + testl %eax,%eax + je L48 +L49: + decl %edx + testl %edx,%edx + jle L39 + .align 2,0x90 +L53: + movl (%edi,%edx,4),%ebx + movl %ebx,(%ecx,%edx,4) + decl %edx + testl %edx,%edx + jg L53 + jmp L39 + .align 4,0x90 +L48: + movl (%ecx),%eax + decl %eax + movl %eax,4(%ecx) + movl %eax,8(%ecx) + addl $4,%ecx + addl $4,_avma + movb -8(%ebp),%bl + movb %bl,7(%ecx) + jmp L39 + .align 4,0x90 +L43: + movl -12(%ebp),%ebx + pushl %ebx + call _cgeti + movl %eax,%ecx + movl %esi,-4(%ecx,%ebx,4) + movl $1,%edx + movl %ebx,%eax + decl %eax + movl %eax,%esi + cmpl %eax,%edx + jge L39 + .align 2,0x90 +L59: + movl (%edi,%edx,4),%ebx + movl %ebx,(%ecx,%edx,4) + incl %edx + cmpl %esi,%edx + jl L59 +L39: + movl %ecx,%eax +L60: + leal -24(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _addii ; .align 4,0x90 ; _addii: + pushl %ebp + movl %esp,%ebp + subl $32,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 12(%ebp),%edi + movl 8(%ebp),%edx + movzwl 4(%edx),%edx + movl %edx,-8(%ebp) + movzwl 4(%edi),%ecx + movl %ecx,-12(%ebp) + cmpl %ecx,%edx + jge L64 + movl 8(%ebp),%edx + movl %edx,-16(%ebp) + movl %edi,8(%ebp) + movl -16(%ebp),%edi + movl -8(%ebp),%ecx + movl %ecx,-4(%ebp) + movl -12(%ebp),%edx + movl %edx,-8(%ebp) + movl %ecx,-12(%ebp) +L64: + movl 4(%edi),%esi + sarl $24,%esi + jne L65 + movl 8(%ebp),%ecx + pushl %ecx + call _icopy + jmp L119 + .align 4,0x90 +L65: + movl 8(%ebp),%edx + movl 4(%edx),%ecx + sarl $24,%ecx + movl %ecx,-4(%ebp) + cmpl %esi,%ecx + jne L66 + movl -8(%ebp),%eax + incl %eax + pushl %eax + call _cgeti + movl %eax,-16(%ebp) + movl $0,-24(%ebp) + movl -8(%ebp),%edx + leal 0(,%edx,4),%eax + movl -16(%ebp),%ecx + leal 4(%eax,%ecx),%esi + movl 8(%ebp),%ebx + addl %eax,%ebx + movl -12(%ebp),%edx + leal (%edi,%edx,4),%edi + movl %edi,-20(%ebp) + movl %edx,%edi + addl $-2,%edi + je L68 + .align 2,0x90 +L71: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%ecx + movl %ecx,-28(%ebp) + addl $-4,-20(%ebp) + movl -20(%ebp),%edx + addl (%edx),%ecx + movl %ecx,-32(%ebp) + movl -28(%ebp),%edx + cmpl %edx,%ecx + jae L69 + movl -24(%ebp),%edx + addl %edx,%ecx + movl %ecx,-32(%ebp) + movl $1,-24(%ebp) + movl %ecx,(%esi) + jmp L67 + .align 4,0x90 +L69: + movl -24(%ebp),%ecx + addl %ecx,-32(%ebp) + cmpl %ecx,-32(%ebp) + setb %al + andl $255,%eax + movl %eax,-24(%ebp) + movl -32(%ebp),%edx + movl %edx,(%esi) +L67: + decl %edi + jne L71 +L68: + cmpl $0,-24(%ebp) + je L72 + movl 8(%ebp),%edi + addl $8,%edi +L73: + addl $-4,%ebx + movl %ebx,%eax + cmpl %edi,%ebx + jb L74 + cmpl $-1,(%ebx) + jne L75 + addl $-4,%esi + movl $0,(%esi) + jmp L73 + .align 4,0x90 +L75: + addl $-4,%esi + movl (%eax),%eax + incl %eax + jmp L121 + .align 4,0x90 + .align 2,0x90 +L79: + addl $-4,%esi + movl (%eax),%eax +L121: + movl %eax,(%esi) + addl $-4,%ebx + movl %ebx,%eax + cmpl %edi,%ebx + jae L79 + movl -16(%ebp),%ecx + movl (%ecx),%edx + decl %edx + movl %edx,4(%ecx) + movl 8(%ebp),%ecx + movl 4(%ecx),%edx + movl -16(%ebp),%ecx + movl %edx,8(%ecx) + addl $4,%ecx + movl %ecx,-16(%ebp) + addl $4,_avma + jmp L85 + .align 4,0x90 +L74: + movl -16(%ebp),%ecx + movl $1,8(%ecx) + movl 8(%ebp),%ecx + movl 4(%ecx),%edx + incl %edx + movl -16(%ebp),%ecx + movl %edx,4(%ecx) + jmp L85 + .align 4,0x90 +L72: + movl -8(%ebp),%eax + subl -12(%ebp),%eax + je L83 + .align 2,0x90 +L84: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%ecx + movl %ecx,(%esi) + decl %eax + jne L84 +L83: + movl -16(%ebp),%edx + movl (%edx),%ecx + decl %ecx + movl %ecx,4(%edx) + movl 8(%ebp),%edx + movl 4(%edx),%ecx + movl -16(%ebp),%edx + movl %ecx,8(%edx) + addl $4,%edx + movl %edx,-16(%ebp) + addl $4,_avma + jmp L85 + .align 4,0x90 +L66: + movl -12(%ebp),%edx + cmpl %edx,-8(%ebp) + jne L86 + movl 8(%ebp),%ebx + addl $8,%ebx + leal 8(%edi),%ecx + movl %ecx,-20(%ebp) + movl -8(%ebp),%eax + addl $-2,%eax + je L94 + .align 2,0x90 +L93: + movl (%ebx),%edx + movl %edx,-28(%ebp) + addl $4,%ebx + movl -20(%ebp),%ecx + movl (%ecx),%ecx + movl %ecx,-32(%ebp) + addl $4,-20(%ebp) + cmpl %edx,%ecx + ja L120 + cmpl %ecx,%edx + ja L86 + decl %eax + jne L93 +L94: + movl _gzero ,%eax + jmp L119 + .align 4,0x90 +L120: + movl 8(%ebp),%edx + movl %edx,-16(%ebp) + movl %edi,8(%ebp) + movl -16(%ebp),%edi + movl %esi,-4(%ebp) +L86: + movl -8(%ebp),%ecx + pushl %ecx + call _cgeti + movl %eax,-16(%ebp) + movl $0,-24(%ebp) + movl -8(%ebp),%edx + leal 0(,%edx,4),%eax + movl 8(%ebp),%ebx + addl %eax,%ebx + movl -12(%ebp),%ecx + leal (%edi,%ecx,4),%edi + movl %edi,-20(%ebp) + movl -16(%ebp),%esi + addl %eax,%esi + movl %ecx,%edi + addl $-2,%edi + je L96 + .align 2,0x90 +L101: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%edx + movl %edx,-28(%ebp) + addl $-4,-20(%ebp) + movl -20(%ebp),%ecx + movl (%ecx),%eax + subl %eax,%edx + movl -24(%ebp),%ecx + subl %ecx,%edx + movl %edx,-32(%ebp) + cmpl %eax,-28(%ebp) + jae L97 + movl $1,-24(%ebp) + jmp L98 + .align 4,0x90 +L97: + cmpl %eax,-28(%ebp) + jbe L98 + movl $0,-24(%ebp) +L98: + movl -32(%ebp),%edx + movl %edx,(%esi) + decl %edi + jne L101 +L96: + cmpl $0,-24(%ebp) + je L102 + jmp L122 + .align 4,0x90 + .align 2,0x90 +L105: + addl $-4,%esi + movl $-1,(%esi) +L122: + addl $-4,%ebx + movl (%ebx),%eax + testl %eax,%eax + je L105 + movl 8(%ebp),%edi + addl $8,%edi + cmpl %edi,%ebx + jb L110 + addl $-4,%esi + decl %eax + movl %eax,(%esi) + addl $-4,%ebx + movl %ebx,%eax + cmpl %edi,%ebx + jb L110 + .align 2,0x90 +L109: + addl $-4,%esi + movl (%eax),%eax + movl %eax,(%esi) + addl $-4,%ebx + movl %ebx,%eax + cmpl %edi,%ebx + jae L109 + jmp L110 + .align 4,0x90 +L102: + movl -8(%ebp),%edi + subl -12(%ebp),%edi + je L110 + .align 2,0x90 +L113: + addl $-4,%esi + addl $-4,%ebx + movl (%ebx),%ecx + movl %ecx,(%esi) + decl %edi + jne L113 +L110: + movl -16(%ebp),%edx + cmpl $0,8(%edx) + je L114 + movl 8(%ebp),%ecx + movl 4(%ecx),%ecx + movl %ecx,4(%edx) + jmp L85 + .align 4,0x90 +L114: + movl -16(%ebp),%esi + addl $12,%esi + movl -16(%ebp),%edx + cmpl $0,12(%edx) + jne L117 + .align 2,0x90 +L118: + addl $4,%esi + cmpl $0,(%esi) + je L118 +L117: + addl $-8,%esi + movl %esi,%edi + subl -16(%ebp),%edi + sarl $2,%edi + movl -16(%ebp),%ecx + movl (%ecx),%eax + subl %edi,%eax + movl %eax,(%esi) + movl %eax,4(%esi) + movl %esi,-16(%ebp) + movb -4(%ebp),%dl + movb %dl,7(%esi) + leal 0(,%edi,4),%eax + addl %eax,_avma +L85: + movl -16(%ebp),%eax +L119: + leal -44(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _mulss ; .align 4,0x90 ; _mulss: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + pushl %esi + pushl %ebx + movl 8(%ebp),%edx + movl 12(%ebp),%ebx + testl %edx,%edx + je L125 + testl %ebx,%ebx + jne L124 +L125: + movl _gzero ,%eax + jmp L133 + .align 4,0x90 +L124: + movl $1,%esi + testl %edx,%edx + jge L126 + movl $-1,%esi + negl %edx + jns L126 + pushl %edx + call _stoi + pushl %eax + pushl %ebx + call _mulsi + jmp L133 + .align 4,0x90 +L126: + testl %ebx,%ebx + jge L128 + negl %esi + negl %ebx + jns L128 + pushl $ _ABS_MOST_NEGS + movl %edx,%eax + testl %esi,%esi + jg L130 + negl %eax +L130: + pushl %eax + call _mulsi + jmp L133 + .align 4,0x90 +L128: + leal -4(%ebp),%eax + pushl %eax + pushl %ebx + pushl %edx + call _mulul3 + movl %eax,%ebx + addl $12,%esp + cmpl $0,-4(%ebp) + je L131 + pushl $4 + call _cgeti + movl -4(%ebp),%ecx + movl %ecx,8(%eax) + movl %ebx,12(%eax) + jmp L132 + .align 4,0x90 +L131: + pushl $3 + call _cgeti + movl %ebx,8(%eax) +L132: + movl (%eax),%ecx + movl %ecx,4(%eax) + movl %esi,%ecx + movb %cl,7(%eax) +L133: + leal -12(%ebp),%esp + popl %ebx + popl %esi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _mulii ; .align 4,0x90 ; _mulii: + pushl %ebp + movl %esp,%ebp + subl $48,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movzwl 4(%esi),%edi + movl %edi,-8(%ebp) + movl 12(%ebp),%ecx + movzwl 4(%ecx),%ecx + movl %ecx,-12(%ebp) + movl 4(%esi),%ebx + sarl $24,%ebx + je L157 + movl 12(%ebp),%edi + movl 4(%edi),%eax + sarl $24,%eax + jne L136 +L157: + movl _gzero ,%eax + jmp L156 + .align 4,0x90 +L136: + testl %eax,%eax + jge L137 + negl %ebx +L137: + movl -12(%ebp),%ecx + cmpl %ecx,-8(%ebp) + jle L138 + movl %esi,-24(%ebp) + movl 12(%ebp),%esi + movl -24(%ebp),%edi + movl %edi,12(%ebp) + movl -8(%ebp),%ecx + movl %ecx,-16(%ebp) + movl -12(%ebp),%edi + movl %edi,-8(%ebp) + movl %ecx,-12(%ebp) +L138: + movl -8(%ebp),%ecx + movl -12(%ebp),%edi + leal -2(%edi,%ecx),%ecx + movl %ecx,-16(%ebp) + cmpl $65535,%ecx + jle L139 + pushl $17 + call _err + addl $4,%esp +L139: + movl -16(%ebp),%ecx + pushl %ecx + call _cgeti + movl %eax,-24(%ebp) + movl (%eax),%edi + movl %edi,4(%eax) + movb %bl,7(%eax) + movl -8(%ebp),%ecx + leal -4(%esi,%ecx,4),%esi + movl %esi,-32(%ebp) + movl (%esi),%edi + movl %edi,-20(%ebp) + movl $0,-4(%ebp) + movl -12(%ebp),%ecx + movl 12(%ebp),%edi + leal (%edi,%ecx,4),%ecx + movl %ecx,-48(%ebp) + movl -16(%ebp),%edi + leal (%eax,%edi,4),%edi + movl %edi,-28(%ebp) + addl $4,%esp + movl -12(%ebp),%esi + addl $-2,%esi + je L141 + .align 2,0x90 +L144: + addl $-4,-28(%ebp) + movl -4(%ebp),%ebx + leal -4(%ebp),%eax + pushl %eax + addl $-4,-48(%ebp) + movl -48(%ebp),%ecx + movl (%ecx),%ecx + pushl %ecx + movl -20(%ebp),%edi + pushl %edi + call _mulul3 + movl %eax,%edx + addl %ebx,%edx + cmpl %ebx,%edx + jae L143 + incl -4(%ebp) +L143: + movl -28(%ebp),%ecx + movl %edx,(%ecx) + addl $12,%esp + decl %esi + jne L144 +L141: + movl -4(%ebp),%ecx + movl -28(%ebp),%edi + movl %ecx,-4(%edi) + movl -16(%ebp),%edi + movl -24(%ebp),%ecx + leal (%ecx,%edi,4),%edi + movl %edi,-28(%ebp) + movl -12(%ebp),%ecx + movl 12(%ebp),%edi + leal (%edi,%ecx,4),%ecx + movl %ecx,-36(%ebp) + decl -12(%ebp) + addl $-3,-8(%ebp) + cmpl $0,-8(%ebp) + jle L146 + .align 2,0x90 +L154: + addl $-4,-32(%ebp) + movl -32(%ebp),%edi + movl (%edi),%edi + movl %edi,-44(%ebp) + movl -36(%ebp),%ecx + movl %ecx,-48(%ebp) + movl -28(%ebp),%ebx + addl $-4,%ebx + movl %ebx,-28(%ebp) + movl $0,-40(%ebp) + movl -12(%ebp),%esi + jmp L158 + .align 4,0x90 + .align 2,0x90 +L153: + addl $-4,-48(%ebp) + leal -4(%ebp),%eax + pushl %eax + movl -44(%ebp),%edi + pushl %edi + movl -48(%ebp),%ecx + movl (%ecx),%ecx + pushl %ecx + call _mulul3 + addl $-4,%ebx + movl %eax,%edx + addl (%ebx),%edx + cmpl %eax,%edx + jae L150 + incl -4(%ebp) +L150: + movl %edx,%eax + movl -40(%ebp),%edx + addl %eax,%edx + cmpl %eax,%edx + jae L152 + incl -4(%ebp) +L152: + movl %edx,(%ebx) + movl -4(%ebp),%edi + movl %edi,-40(%ebp) + addl $12,%esp +L158: + decl %esi + jne L153 + movl -4(%ebp),%ecx + movl %ecx,-4(%ebx) + decl -8(%ebp) + cmpl $0,-8(%ebp) + jg L154 +L146: + movl -24(%ebp),%edi + cmpl $0,8(%edi) + jne L155 + movl -24(%ebp),%edi + movl 4(%edi),%ecx + decl %ecx + movl %ecx,8(%edi) + movl -24(%ebp),%edi + movl (%edi),%ecx + decl %ecx + movl %ecx,4(%edi) + addl $4,%edi + movl %edi,-24(%ebp) + addl $4,_avma +L155: + movl -24(%ebp),%eax +L156: + leal -60(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret + .align 2 +LC0: + .long 0x55475a32,0x3fd34413 + .align 4 +.globl _confrac ; .align 4,0x90 ; _confrac: + pushl %ebp + movl %esp,%ebp + subl $68,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%edx + movzwl (%edx),%edx + movl %edx,-16(%ebp) + movl 8(%ebp),%ecx + movl 4(%ecx),%eax + andl $16777215,%eax + movl $8388607,%edx + subl %eax,%edx + movl %edx,-20(%ebp) + movl _avma ,%ecx + movl %ecx,-24(%ebp) + movl -16(%ebp),%eax + sall $5,%eax + leal -64(%edx,%eax),%eax + movl %eax,-32(%ebp) + addl $63,%eax + sarl $5,%eax + movl %eax,-28(%ebp) + pushl %eax + call _cgeti + movl %eax,-44(%ebp) + movl -20(%ebp),%esi + sarl $5,%esi + xorl %ebx,%ebx + addl $4,%esp + cmpl %esi,%ebx + jge L161 + .align 2,0x90 +L163: + movl -44(%ebp),%edx + movl $0,(%edx,%ebx,4) + incl %ebx + cmpl %esi,%ebx + jl L163 +L161: + andl $31,-20(%ebp) + jne L164 + movl $2,%edi + cmpl %edi,-16(%ebp) + jle L169 + .align 2,0x90 +L168: + movl 8(%ebp),%ecx + movl (%ecx,%edi,4),%eax + movl -44(%ebp),%ecx + movl %eax,(%ecx,%ebx,4) + incl %ebx + incl %edi + cmpl %edi,-16(%ebp) + jg L168 + jmp L169 + .align 4,0x90 +L164: + movl $0,-40(%ebp) + movl $2,%edi + cmpl %edi,-16(%ebp) + jle L171 + movl $32,%edx + subl -20(%ebp),%edx + movl %edx,-52(%ebp) + .align 2,0x90 +L173: + movl %ebx,-64(%ebp) + movl 8(%ebp),%ecx + movl (%ecx,%edi,4),%esi + incl %ebx + movl %esi,%eax + movl -52(%ebp),%ecx + sall %cl,%eax + movl %eax,-68(%ebp) + movl %eax,-12(%ebp) + movl -20(%ebp),%ecx + shrl %cl,%esi + movl %esi,%ecx + addl -40(%ebp),%ecx + movl -64(%ebp),%eax + movl -44(%ebp),%edx + movl %ecx,(%edx,%eax,4) + movl -68(%ebp),%eax + movl %eax,-40(%ebp) + incl %edi + cmpl %edi,-16(%ebp) + jg L173 +L171: + movl -40(%ebp),%eax + movl -28(%ebp),%edx + movl -44(%ebp),%ecx + movl %eax,-8(%ecx,%edx,4) +L169: + movl -28(%ebp),%edx + movl -44(%ebp),%ecx + movl $0,-4(%ecx,%edx,4) + fldl LC0 + fimull -32(%ebp) + fld1 + faddp %st,%st(1) + fnstcw -4(%ebp) + movl -4(%ebp),%eax + movb $12,%ah + movl %eax,-8(%ebp) + fldcw -8(%ebp) + subl $4,%esp + fistpl (%esp) + popl %ebx + fldcw -4(%ebp) + leal 17(%ebx),%edx + movl %edx,-36(%ebp) + movl -36(%ebp),%eax + movl $9,%ecx + cltd + idivl %ecx + movl %eax,-36(%ebp) + pushl %eax + call _cgeti + movl %eax,-48(%ebp) + movl %ebx,(%eax) + movl $1,%edi + addl $4,%esp + cmpl %edi,-36(%ebp) + jle L175 + leal -12(%ebp),%eax + movl %eax,-56(%ebp) + .align 2,0x90 +L183: + movl $0,-12(%ebp) + movl -28(%ebp),%ebx + jmp L184 + .align 4,0x90 + .align 2,0x90 +L182: + movl -12(%ebp),%esi + movl -56(%ebp),%edx + pushl %edx + pushl $1000000000 + movl -44(%ebp),%ecx + movl (%ecx,%ebx,4),%ecx + pushl %ecx + call _mulul3 + movl %eax,-68(%ebp) + addl %esi,-68(%ebp) + cmpl %esi,-68(%ebp) + jae L181 + incl -12(%ebp) +L181: + movl -68(%ebp),%edx + movl -44(%ebp),%eax + movl %edx,(%eax,%ebx,4) + addl $12,%esp +L184: + decl %ebx + jns L182 + movl -12(%ebp),%eax + movl -48(%ebp),%ecx + movl %eax,(%ecx,%edi,4) + incl %edi + cmpl %edi,-36(%ebp) + jg L183 +L175: + movl -24(%ebp),%edx + movl %edx,_avma + movl -48(%ebp),%eax + leal -80(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _divss ; .align 4,0x90 ; _divss: + pushl %ebp + movl %esp,%ebp + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 12(%ebp),%ebx + testl %ebx,%ebx + jne L186 + pushl $23 + call _err + addl $4,%esp +L186: + cmpl $-2147483648,%esi + jne L187 + pushl %ebx + pushl $-2147483648 + call _stoi + addl $4,%esp + pushl %eax + call _divis + jmp L192 + .align 4,0x90 +L187: + movl $0,_hiremainder + pushl $ _hiremainder + movl %ebx,%eax + testl %ebx,%ebx + jge L188 + negl %eax +L188: + pushl %eax + movl %esi,%eax + testl %esi,%esi + jge L189 + negl %eax +L189: + pushl %eax + call _divul3 + addl $12,%esp + testl %ebx,%ebx + jge L190 + negl _hiremainder + negl %eax +L190: + testl %esi,%esi + jge L191 + negl %eax +L191: + pushl %eax + call _stoi +L192: + leal -8(%ebp),%esp + popl %ebx + popl %esi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _modss ; .align 4,0x90 ; _modss: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 12(%ebp),%ebx + testl %ebx,%ebx + jne L194 + pushl $38 + call _err + addl $4,%esp +L194: + cmpl $-2147483648,%esi + jne L195 + pushl %ebx + pushl $-2147483648 + call _stoi + addl $4,%esp + pushl %eax + call _modis + jmp L201 + .align 4,0x90 +L195: + movl $0,-4(%ebp) + leal -4(%ebp),%eax + pushl %eax + testl %ebx,%ebx + jge L196 + negl %ebx +L196: + pushl %ebx + movl %esi,%eax + testl %eax,%eax + jge L197 + negl %eax +L197: + pushl %eax + call _divul3 + addl $12,%esp + cmpl $0,-4(%ebp) + jne L198 + movl _gzero ,%eax + jmp L201 + .align 4,0x90 +L198: + cmpl $0,-4(%ebp) + jge L199 + movl %ebx,%eax + subl -4(%ebp),%eax + pushl %eax + jmp L202 + .align 4,0x90 +L199: + movl -4(%ebp),%edx + pushl %edx +L202: + call _stoi +L201: + leal -12(%ebp),%esp + popl %ebx + popl %esi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _resss ; .align 4,0x90 ; _resss: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + pushl %ebx + movl 12(%ebp),%ebx + testl %ebx,%ebx + jne L204 + pushl $40 + call _err + addl $4,%esp +L204: + movl $0,-4(%ebp) + leal -4(%ebp),%eax + pushl %eax + movl %ebx,%eax + testl %ebx,%ebx + jge L205 + negl %eax +L205: + pushl %eax + movl 8(%ebp),%eax + testl %eax,%eax + jge L206 + negl %eax +L206: + pushl %eax + call _divul3 + testl %ebx,%ebx + jge L207 + movl -4(%ebp),%eax + negl %eax + pushl %eax + jmp L209 + .align 4,0x90 +L207: + movl -4(%ebp),%edx + pushl %edx +L209: + call _stoi + movl -8(%ebp),%ebx + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _divsi ; .align 4,0x90 ; _divsi: + pushl %ebp + movl %esp,%ebp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%ebx + movl 12(%ebp),%esi + movzwl 4(%esi),%edi + cmpb $0,7(%esi) + jne L211 + pushl $24 + call _err + addl $4,%esp +L211: + testl %ebx,%ebx + je L213 + cmpl $3,%edi + jg L213 + cmpl $0,8(%esi) + jge L212 +L213: + movl %ebx,_hiremainder + movl _gzero ,%eax + jmp L218 + .align 4,0x90 +L212: + cmpl $-2147483648,%ebx + jne L214 + pushl $0 + pushl %esi + pushl $-2147483648 + call _stoi + addl $4,%esp + pushl %eax + call _dvmdii + jmp L218 + .align 4,0x90 +L214: + movl $0,_hiremainder + pushl $ _hiremainder + movl 8(%esi),%edx + pushl %edx + movl %ebx,%eax + testl %ebx,%ebx + jge L215 + negl %eax +L215: + pushl %eax + call _divul3 + addl $12,%esp + cmpl $0,4(%esi) + jge L216 + negl _hiremainder + negl %eax +L216: + testl %ebx,%ebx + jge L217 + negl %eax +L217: + pushl %eax + call _stoi +L218: + leal -12(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _divis ; .align 4,0x90 ; _divis: + pushl %ebp + movl %esp,%ebp + subl $24,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 12(%ebp),%edi + movl 8(%ebp),%edx + movl 4(%edx),%ecx + sarl $24,%ecx + movl %ecx,-8(%ebp) + movzwl 4(%edx),%edx + movl %edx,-12(%ebp) + testl %edi,%edi + jne L220 + pushl $26 + call _err + addl $4,%esp +L220: + cmpl $0,-8(%ebp) + jne L221 + movl $0,_hiremainder + movl _gzero ,%eax + jmp L234 + .align 4,0x90 +L221: + testl %edi,%edi + jge L222 + negl -8(%ebp) + negl %edi + jns L222 + pushl $0 + pushl %edi + call _stoi + addl $4,%esp + pushl %eax + movl 8(%ebp),%ecx + pushl %ecx + call _dvmdii + jmp L234 + .align 4,0x90 +L222: + movl 8(%ebp),%edx + cmpl %edi,8(%edx) + jae L224 + cmpl $3,-12(%ebp) + jne L225 + pushl %edx + call _itos + movl %eax,_hiremainder + movl _gzero ,%eax + jmp L234 + .align 4,0x90 +L225: + movl -12(%ebp),%eax + decl %eax + pushl %eax + call _cgeti + movl %eax,%esi + movl $1,-16(%ebp) + movl 8(%ebp),%ecx + movl 8(%ecx),%ecx + movl %ecx,-4(%ebp) + jmp L235 + .align 4,0x90 +L224: + movl -12(%ebp),%edx + pushl %edx + call _cgeti + movl %eax,%esi + movl $0,-16(%ebp) + movl $0,-4(%ebp) +L235: + addl $4,%esp + movl -16(%ebp),%ebx + addl $2,%ebx + cmpl %ebx,-12(%ebp) + jle L229 + leal -4(%ebp),%ecx + movl %ecx,-20(%ebp) + .align 2,0x90 +L231: + movl -20(%ebp),%edx + pushl %edx + pushl %edi + movl 8(%ebp),%ecx + movl (%ecx,%ebx,4),%ecx + pushl %ecx + call _divul3 + movl %ebx,%edx + subl -16(%ebp),%edx + movl %eax,(%esi,%edx,4) + addl $12,%esp + incl %ebx + cmpl %ebx,-12(%ebp) + jg L231 +L229: + movl (%esi),%ecx + movl %ecx,4(%esi) + movb -8(%ebp),%dl + movb %dl,7(%esi) + cmpl $0,-8(%ebp) + jge L232 + movl -4(%ebp),%ecx + negl %ecx + movl %ecx,_hiremainder + jmp L233 + .align 4,0x90 +L232: + movl -4(%ebp),%edx + movl %edx,_hiremainder +L233: + movl %esi,%eax +L234: + leal -36(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret + .align 4 +.globl _dvmdii ; .align 4,0x90 ; _dvmdii: + pushl %ebp + movl %esp,%ebp + subl $92,%esp + pushl %edi + pushl %esi + pushl %ebx + movl 8(%ebp),%esi + movl 4(%esi),%edx + sarl $24,%edx + movl %edx,-36(%ebp) + movl 12(%ebp),%ecx + movl 4(%ecx),%edi + sarl $24,%edi + movl %edi,-40(%ebp) + jne L237 + pushl $36 + call _err + addl $4,%esp +L237: + cmpl $0,-36(%ebp) + jne L238 + cmpl $-1,16(%ebp) + je L333 + cmpl $0,16(%ebp) + je L333 + movl _gzero ,%ecx + movl 16(%ebp),%edx + movl %ecx,(%edx) +L333: + movl _gzero ,%eax + jmp L328 + .align 4,0x90 +L238: + movzwl 4(%esi),%edi + movl %edi,-12(%ebp) + movl 12(%ebp),%edx + movzwl 4(%edx),%edx + movl %edx,-16(%ebp) + subl %edx,%edi + movl %edi,-20(%ebp) + jns L241 + cmpl $-1,16(%ebp) + jne L242 + pushl %esi + call _icopy + jmp L328 + .align 4,0x90 +L242: + cmpl $0,16(%ebp) + je L333 + pushl %esi + call _icopy + movl 16(%ebp),%ecx + movl %eax,(%ecx) + jmp L333 + .align 4,0x90 +L241: + movl _avma ,%edi + movl %edi,-8(%ebp) + cmpl $0,-36(%ebp) + jge L244 + negl -40(%ebp) +L244: + cmpl $3,-16(%ebp) + jne L245 + movl 12(%ebp),%edx + movl 8(%edx),%edx + movl %edx,-48(%ebp) + leal 8(%esi),%ecx + movl %ecx,-88(%ebp) + cmpl %edx,8(%esi) + jae L246 + movl -12(%ebp),%ebx + decl %ebx + movl 8(%esi),%edi + movl %edi,-4(%ebp) + addl $12,%esi + movl %esi,-88(%ebp) + jmp L247 + .align 4,0x90 +L246: + movl -12(%ebp),%ebx + movl $0,-4(%ebp) +L247: + pushl %ebx + call _cgeti + movl %eax,-56(%ebp) + movl %eax,%edx + addl $8,%edx + movl %edx,-72(%ebp) + addl $4,%esp + leal -2(%ebx),%ecx + movl %ecx,-24(%ebp) + testl %ecx,%ecx + je L249 + leal -4(%ebp),%esi + .align 2,0x90 +L250: + pushl %esi + movl -48(%ebp),%edi + pushl %edi + movl -88(%ebp),%edx + movl (%edx),%edx + pushl %edx + addl $4,-88(%ebp) + call _divul3 + movl -72(%ebp),%ecx + movl %eax,(%ecx) + addl $4,%ecx + movl %ecx,-72(%ebp) + addl $12,%esp + decl -24(%ebp) + jne L250 +L249: + cmpl $-1,16(%ebp) + jne L251 + movl -8(%ebp),%edi + movl %edi,_avma + cmpl $0,-4(%ebp) + je L333 + pushl $3 + call _cgeti + movl %eax,-60(%ebp) + movl -36(%ebp),%eax + sall $24,%eax + addl $3,%eax + movl -60(%ebp),%edx + movl %eax,4(%edx) + movl -4(%ebp),%ecx + movl %ecx,8(%edx) + movl -60(%ebp),%eax + jmp L328 + .align 4,0x90 +L251: + cmpl $2,%ebx + je L253 + movl -56(%ebp),%edi + movl (%edi),%edx + movl %edx,4(%edi) + movb -40(%ebp),%cl + movb %cl,7(%edi) + jmp L254 + .align 4,0x90 +L253: + movl -8(%ebp),%edi + movl %edi,_avma + movl _gzero ,%edx + movl %edx,-56(%ebp) +L254: + cmpl $0,16(%ebp) + jne L255 +L331: + movl -56(%ebp),%eax + jmp L328 + .align 4,0x90 +L255: + cmpl $0,-4(%ebp) + jne L256 + movl _gzero ,%edi + movl 16(%ebp),%ecx + movl %edi,(%ecx) + jmp L331 + .align 4,0x90 +L256: + pushl $3 + call _cgeti + movl %eax,-60(%ebp) + movl -36(%ebp),%eax + sall $24,%eax + addl $3,%eax + movl -60(%ebp),%edx + movl %eax,4(%edx) + movl -4(%ebp),%ecx + movl %ecx,8(%edx) + movl 16(%ebp),%edi + movl %edx,(%edi) + jmp L331 + .align 4,0x90 +L245: + movl -12(%ebp),%edx + pushl %edx + call _cgeti + movl %eax,-56(%ebp) + movl 12(%ebp),%ecx + movl 8(%ecx),%ecx + pushl %ecx + call _bfffo + movl %eax,-28(%ebp) + addl $8,%esp + testl %eax,%eax + je L259 + movl -16(%ebp),%edi + pushl %edi + call _cgeti + movl %eax,-60(%ebp) + movl 12(%ebp),%edx + movl 8(%edx),%ebx + addl $12,%edx + movl %edx,-92(%ebp) + movl $32,%eax + subl -28(%ebp),%eax + movl %ebx,%edi + movl %eax,%ecx + shrl %cl,%edi + movl %edi,-4(%ebp) + movl -28(%ebp),%ecx + sall %cl,%ebx + movl %ebx,-32(%ebp) + movl -60(%ebp),%eax + addl $8,%eax + addl $4,%esp + movl -16(%ebp),%edi + addl $-3,%edi + movl %edi,-24(%ebp) + je L261 + movl $32,%edx + subl %ecx,%edx + movl %edx,-88(%ebp) + .align 2,0x90 +L262: + movl -92(%ebp),%ecx + movl (%ecx),%ebx + addl $4,%ecx + movl %ecx,-92(%ebp) + movl %ebx,%edi + movl -88(%ebp),%ecx + shrl %cl,%edi + movl %edi,-4(%ebp) + movl -32(%ebp),%edx + addl %edi,%edx + movl %edx,(%eax) + addl $4,%eax + movl -28(%ebp),%ecx + sall %cl,%ebx + movl %ebx,-32(%ebp) + decl -24(%ebp) + jne L262 +L261: + movl -32(%ebp),%edi + movl %edi,(%eax) + movl $0,-32(%ebp) + addl $8,%esi + movl %esi,-88(%ebp) + movl -56(%ebp),%edx + addl $4,%edx + movl %edx,-72(%ebp) + movl -12(%ebp),%ecx + addl $-2,%ecx + movl %ecx,-24(%ebp) + je L264 + movl $32,%eax + subl -28(%ebp),%eax + .align 2,0x90 +L265: + movl -88(%ebp),%edi + movl (%edi),%ebx + addl $4,%edi + movl %edi,-88(%ebp) + movl %ebx,%edi + movl %eax,%ecx + shrl %cl,%edi + movl %edi,-4(%ebp) + movl -32(%ebp),%ecx + addl %edi,%ecx + movl -72(%ebp),%edx + movl %ecx,(%edx) + addl $4,%edx + movl %edx,-72(%ebp) + movl -28(%ebp),%ecx + sall %cl,%ebx + movl %ebx,-32(%ebp) + decl -24(%ebp) + jne L265 +L264: + movl -32(%ebp),%edx + movl -72(%ebp),%edi + movl %edx,(%edi) + jmp L266 + .align 4,0x90 +L259: + addl $8,%esi + movl %esi,-88(%ebp) + movl -56(%ebp),%ecx + movl $0,4(%ecx) + addl $8,%ecx + movl %ecx,-72(%ebp) + movl -12(%ebp),%esi + addl $-2,%esi + je L268 + .align 2,0x90 +L269: + movl -88(%ebp),%edi + movl (%edi),%edx + movl -72(%ebp),%edi + movl %edx,(%edi) + addl $4,-88(%ebp) + addl $4,%edi + movl %edi,-72(%ebp) + decl %esi + jne L269 +L268: + movl 12(%ebp),%ecx + movl %ecx,-60(%ebp) +L266: + movl -60(%ebp),%edi + movl 8(%edi),%edi + movl %edi,-48(%ebp) + movl -60(%ebp),%edx + movl 12(%edx),%edx + movl %edx,-44(%ebp) + movl -56(%ebp),%ecx + addl $4,%ecx + movl %ecx,-72(%ebp) + movl -20(%ebp),%edi + incl %edi + movl %edi,-24(%ebp) + je L271 + movl -16(%ebp),%edx + sall $2,%edx + movl %edx,-80(%ebp) + .align 2,0x90 +L297: + movl -72(%ebp),%ecx + movl (%ecx),%eax + addl $4,%ecx + movl %ecx,-72(%ebp) + cmpl %eax,-48(%ebp) + jne L272 + movl $-1,-52(%ebp) + movl -48(%ebp),%ebx + movl %ebx,%edi + addl (%ecx),%edi + movl %edi,-84(%ebp) + cmpl %ebx,%edi + setb %al + andl $255,%eax + movl %edi,-32(%ebp) + jmp L273 + .align 4,0x90 +L272: + movl -72(%ebp),%edx + movl -4(%edx),%edx + movl %edx,-4(%ebp) + leal -4(%ebp),%eax + pushl %eax + movl -48(%ebp),%ecx + pushl %ecx + movl -72(%ebp),%edi + movl (%edi),%edi + pushl %edi + call _divul3 + movl %eax,-52(%ebp) + xorl %eax,%eax + movl -4(%ebp),%edx + movl %edx,-32(%ebp) + addl $12,%esp +L273: + testl %eax,%eax + jne L274 + leal -4(%ebp),%eax + pushl %eax + movl -44(%ebp),%ecx + pushl %ecx + movl -52(%ebp),%edi + pushl %edi + call _mulul3 + movl %eax,%ebx + movl -72(%ebp),%edx + movl 4(%edx),%edx + movl %edx,-92(%ebp) + addl $12,%esp + cmpl %edx,%ebx + setb %al + andl $255,%eax + subl %edx,%ebx + movl %ebx,-88(%ebp) + movl -4(%ebp),%ebx + movl -32(%ebp),%ecx + movl %ecx,-92(%ebp) + movl %ebx,%edi + subl %ecx,%edi + subl %eax,%edi + movl %edi,-84(%ebp) + cmpl %ebx,%ecx + ja L334 + jmp L281 + .align 4,0x90 + .align 2,0x90 +L285: + decl -52(%ebp) + movl -88(%ebp),%ebx + movl -44(%ebp),%edx + movl %edx,-92(%ebp) + cmpl %edx,%ebx + setb %al + andl $255,%eax + subl %edx,%ebx + movl %ebx,-88(%ebp) + movl %esi,%ebx + movl -48(%ebp),%ecx + movl %ecx,-92(%ebp) + movl %ebx,%edi + subl %ecx,%edi + subl %eax,%edi + movl %edi,-84(%ebp) + cmpl %ebx,%ecx + jbe L281 +L334: + movl $1,%eax + jmp L282 + .align 4,0x90 +L281: + cmpl %ebx,-92(%ebp) + jae L282 + xorl %eax,%eax +L282: + movl -84(%ebp),%esi + testl %eax,%eax + jne L274 + testl %esi,%esi + jne L285 +L274: + movl $0,-4(%ebp) + movl -72(%ebp),%edx + movl -80(%ebp),%ecx + leal -8(%ecx,%edx),%edx + movl %edx,-88(%ebp) + movl -60(%ebp),%edi + addl %ecx,%edi + movl %edi,-76(%ebp) + movl -16(%ebp),%esi + addl $-2,%esi + je L287 + .align 2,0x90 +L290: + movl -4(%ebp),%ebx + leal -4(%ebp),%eax + pushl %eax + addl $-4,-76(%ebp) + movl -76(%ebp),%edx + movl (%edx),%edx + pushl %edx + movl -52(%ebp),%ecx + pushl %ecx + call _mulul3 + movl %eax,-84(%ebp) + addl %ebx,-84(%ebp) + cmpl %ebx,-84(%ebp) + jae L289 + incl -4(%ebp) +L289: + movl -84(%ebp),%edi + movl %edi,-92(%ebp) + addl $-4,-88(%ebp) + addl $12,%esp + movl -88(%ebp),%edx + movl (%edx),%ebx + cmpl %edi,%ebx + setb %al + andl $255,%eax + subl %edi,%ebx + movl %ebx,(%edx) + addl %eax,-4(%ebp) + decl %esi + jne L290 +L287: + movl -72(%ebp),%ecx + movl -4(%ecx),%eax + cmpl %eax,-4(%ebp) + jbe L291 + xorl %eax,%eax + decl -52(%ebp) + movl -80(%ebp),%edi + leal -8(%edi,%ecx),%edi + movl %edi,-88(%ebp) + movl -60(%ebp),%edx + addl -80(%ebp),%edx + movl %edx,-76(%ebp) + movl -16(%ebp),%esi + addl $-2,%esi + je L291 + .align 2,0x90 +L296: + movl -88(%ebp),%ecx + addl $-4,%ecx + movl %ecx,-92(%ebp) + movl %ecx,-88(%ebp) + movl (%ecx),%ebx + addl $-4,-76(%ebp) + movl %ebx,%edx + movl -76(%ebp),%edi + addl (%edi),%edx + movl %edx,-84(%ebp) + cmpl %ebx,%edx + jae L294 + addl %eax,%edx + movl %edx,-84(%ebp) + movl $1,%eax + movl %edx,(%ecx) + jmp L292 + .align 4,0x90 +L294: + addl %eax,-84(%ebp) + cmpl %eax,-84(%ebp) + setb %al + andl $255,%eax + movl -84(%ebp),%edi + movl -92(%ebp),%ecx + movl %edi,(%ecx) +L292: + decl %esi + jne L296 +L291: + movl -52(%ebp),%ecx + movl -72(%ebp),%edx + movl %ecx,-4(%edx) + decl -24(%ebp) + jne L297 +L271: + movl _avma ,%edi + movl %edi,-88(%ebp) + cmpl $-1,16(%ebp) + je L298 + movl -20(%ebp),%ebx + addl $2,%ebx + movl -56(%ebp),%edx + leal (%edx,%ebx,4),%edx + movl %edx,-72(%ebp) + movl -56(%ebp),%ecx + cmpl $0,4(%ecx) + je L299 + movl -20(%ebp),%ebx + addl $3,%ebx + jmp L300 + .align 4,0x90 +L299: + cmpl $0,-20(%ebp) + jne L300 + movl $0,-40(%ebp) +L300: + pushl %ebx + call _cgeti + movl %eax,-64(%ebp) + leal (%eax,%ebx,4),%eax + addl $4,%esp + leal -2(%ebx),%esi + testl %esi,%esi + je L303 + .align 2,0x90 +L304: + addl $-4,%eax + addl $-4,-72(%ebp) + movl -72(%ebp),%edi + movl (%edi),%edi + movl %edi,(%eax) + decl %esi + jne L304 +L303: + cmpl $2,%ebx + ja L305 + movl -64(%ebp),%edx + movl $2,4(%edx) + jmp L298 + .align 4,0x90 +L305: + movl -64(%ebp),%ecx + movl (%ecx),%edi + movl %edi,4(%ecx) + movb -40(%ebp),%dl + movb %dl,7(%ecx) +L298: + cmpl $0,16(%ebp) + je L307 + movl -20(%ebp),%esi + addl $2,%esi + cmpl %esi,-12(%ebp) + jle L309 + movl -56(%ebp),%ecx + cmpl $0,(%ecx,%esi,4) + jne L309 + .align 2,0x90 +L310: + incl %esi + cmpl %esi,-12(%ebp) + jle L309 + movl -56(%ebp),%edi + cmpl $0,(%edi,%esi,4) + je L310 +L309: + cmpl %esi,-12(%ebp) + jne L312 + movl _gzero ,%edx + pushl %edx + call _icopy + movl %eax,-68(%ebp) + addl $4,%esp + jmp L307 + .align 4,0x90 +L312: + movl -12(%ebp),%eax + subl %esi,%eax + addl $2,%eax + pushl %eax + call _cgeti + movl %eax,-68(%ebp) + movl (%eax),%ecx + movl %ecx,4(%eax) + addl $4,%esp + cmpl $0,-28(%ebp) + jne L314 + movl $2,-24(%ebp) + cmpl %esi,-12(%ebp) + jle L319 + .align 2,0x90 +L318: + movl -56(%ebp),%edi + movl (%edi,%esi,4),%ecx + movl -24(%ebp),%edi + movl -68(%ebp),%edx + movl %ecx,(%edx,%edi,4) + incl %esi + incl %edi + movl %edi,-24(%ebp) + cmpl %esi,-12(%ebp) + jg L318 + jmp L319 + .align 4,0x90 +L314: + movl $0,-4(%ebp) + movl -56(%ebp),%edi + movl (%edi,%esi,4),%ebx + incl %esi + movl $32,%eax + subl -28(%ebp),%eax + movl %ebx,%edi + movl %eax,%ecx + sall %cl,%edi + movl %edi,%eax + movl %eax,-4(%ebp) + movl -28(%ebp),%ecx + shrl %cl,%ebx + movl %ebx,-92(%ebp) + movl %eax,-32(%ebp) + testl %ebx,%ebx + je L320 + movl -68(%ebp),%edi + movl %ebx,8(%edi) + movl $1,%eax + jmp L321 + .align 4,0x90 +L320: + movl -68(%ebp),%edx + movl (%edx),%ecx + decl %ecx + movl %ecx,4(%edx) + addl $4,%edx + movl %edx,-68(%ebp) + addl $4,_avma + movl -68(%ebp),%edx + movl (%edx),%edi + movl %edi,4(%edx) + xorl %eax,%eax +L321: + addl $2,%eax + movl %eax,-24(%ebp) + cmpl %esi,-12(%ebp) + jle L319 + movl $32,%edx + subl -28(%ebp),%edx + movl %edx,-84(%ebp) + .align 2,0x90 +L325: + movl -56(%ebp),%ecx + movl (%ecx,%esi,4),%ebx + movl %ebx,%edi + movl -84(%ebp),%ecx + sall %cl,%edi + movl %edi,-92(%ebp) + movl %edi,-4(%ebp) + movl %ebx,%eax + movl -28(%ebp),%ecx + shrl %cl,%eax + addl -32(%ebp),%eax + movl -24(%ebp),%edi + movl -68(%ebp),%edx + movl %eax,(%edx,%edi,4) + movl -92(%ebp),%ecx + movl %ecx,-32(%ebp) + incl %esi + incl %edi + movl %edi,-24(%ebp) + cmpl %esi,-12(%ebp) + jg L325 +L319: + movb -36(%ebp),%dl + movl -68(%ebp),%ecx + movb %dl,7(%ecx) +L307: + cmpl $-1,16(%ebp) + jne L326 + movl -68(%ebp),%edi + pushl %edi + movl -88(%ebp),%edx + pushl %edx + movl -8(%ebp),%ecx + pushl %ecx + jmp L332 + .align 4,0x90 +L326: + cmpl $0,16(%ebp) + je L327 + pushl $0 + movl -88(%ebp),%edi + pushl %edi + movl -8(%ebp),%edx + pushl %edx + call _gerepile + andb $252,%al + movl -68(%ebp),%edi + addl %eax,%edi + movl 16(%ebp),%ecx + movl %edi,(%ecx) + addl -64(%ebp),%eax + jmp L328 + .align 4,0x90 +L327: + movl -64(%ebp),%edx + pushl %edx + movl -88(%ebp),%ecx + pushl %ecx + movl -8(%ebp),%edi + pushl %edi +L332: + call _gerepile +L328: + leal -104(%ebp),%esp + popl %ebx + popl %esi + popl %edi + movl %ebp,%esp + popl %ebp + ret +.comm _in_saved_avma ,4 diff --git a/mp/mpi-bsd68k.s b/mp/mpi-bsd68k.s new file mode 100755 index 0000000..e0f10e1 --- /dev/null +++ b/mp/mpi-bsd68k.s @@ -0,0 +1,2164 @@ +#NO_APP +gcc_compiled.: +.text + .even +.globl _mulsi +_mulsi: + link a6,#0 + moveml #0x3f30,sp@- + movel a6@(8),d4 + movel a6@(12),a2 + moveb a2@(4),d6 + extbl d6 + movel a2@(4),d5 + andl #65535,d5 + tstl d4 + jeq L3 + tstl d6 + jne L2 +L3: + movel _gzero,d0 + jra L1 +L2: + tstl d4 + jge L4 + negl d6 + negl d4 + jpl L4 + movel a2,sp@- + movel #-2147483648,sp@- + jbsr _stoi + addqw #4,sp + movel d0,sp@- + jbsr _mulii + jra L1 +L4: + movel d5,a3 + pea a3@(1) + jbsr _cgeti + movel d0,a1 + clrl d2 + movel d5,d0 + asll #2,d0 + addl d0,a2 + lea a1@(4,d0:l),a0 + movel d5,d3 + subql #2,d3 + jra L6 +L8: + movel d2,d0 + movel d4,d1 +#APP + mulul a2@-,d2:d1 +#NO_APP + addl d1,d0 + clrl d7 +#APP + addxl d7,d2 +#NO_APP + movel d0,a0@- +L6: + dbra d3,L8 + clrw d3 + subql #1,d3 + jcc L8 + tstl d2 + jeq L9 + movel d2,a0@- + movel a1@(4),d0 + clrw d0 + movel d0,a3 + lea a3@(1,d5:l),a3 + movel a3,a1@(4) + jra L10 +L9: + addql #4,_avma + movel a1@,d7 + subql #1,d7 + movel d7,a1@(4) + addqw #4,a1 + movel a1@(4),d0 + clrw d0 + addl d5,d0 + movel d0,a1@(4) +L10: + movel a1@(4),d0 + andl #16777215,d0 + movel d6,d1 + moveq #24,d7 + asll d7,d1 + addl d1,d0 + movel d0,a1@(4) + movel a1,d0 +L1: + moveml a6@(-32),#0xcfc + unlk a6 + rts + .even +.globl _expi +_expi: + link a6,#0 + movel d2,sp@- + movel a6@(8),a0 + movel a0@(4),d0 + andl #65535,d0 + moveq #2,d2 + cmpl d0,d2 + jne L12 + movel #-8388608,d0 + jra L13 +L12: + subql #2,d0 + asll #5,d0 +#APP + bfffo a0@(8){#0:#0},d1 +#NO_APP + subl d1,d0 + subql #1,d0 +L13: + movel a6@(-4),d2 + unlk a6 + rts + .even +.globl _addsi +_addsi: + link a6,#0 + moveml #0x3e20,sp@- + movel a6@(8),d3 + movel a6@(12),a2 + jne L15 + movel a2,sp@- + jbsr _icopy + jra L14 +L15: + moveb a2@(4),d4 + extbl d4 + jne L16 + movel d3,sp@- + jbsr _stoi + jra L14 +L16: + tstl d3 + jge L17 + moveq #-1,d5 + negl d3 + jpl L19 + movel a2,sp@- + pea _MOST_NEGS + jbsr _addii + jra L14 +L17: + moveq #1,d5 +L19: + movel a2@(4),d2 + andl #65535,d2 + cmpl d5,d4 + jne L20 + movel d3,d1 + addl a2@(-4,d2:l:4),d3 + cmpl d3,d1 + jls L21 + moveq #1,d0 + jra L22 +L21: + clrl d0 +L22: + tstl d0 + jeq L23 + movel d2,a1 + pea a1@(1) + jbsr _cgeti + movel d0,a0 + movel d3,a0@(d2:l:4) + movel d2,d0 + jra L65 +L27: + moveq #-1,d6 + cmpl a2@(-4,d0:l:4),d6 + jne L25 + clrl a0@(d0:l:4) +L65: + subql #1,d0 + moveq #2,d6 + cmpl d0,d6 + jlt L27 +L25: + moveq #2,d6 + cmpl d0,d6 + jge L28 + movel a2@(-4,d0:l:4),d6 + addql #1,d6 + movel d6,a0@(d0:l:4) + jra L66 +L31: + movel a2@(-4,d0:l:4),a0@(d0:l:4) +L66: + subql #1,d0 + moveq #2,d6 + cmpl d0,d6 + jlt L31 + movel a0@,d0 + subql #1,d0 + movel d0,a0@(4) + movel d0,a0@(8) + addqw #4,a0 + addql #4,_avma + jra L33 +L28: + moveq #1,d6 + movel d6,a0@(8) + movel a0@,a0@(4) + jra L33 +L23: + movel d2,sp@- + jbsr _cgeti + movel d0,a0 + movel d3,a0@(-4,d2:l:4) + moveq #1,d0 + movel d2,d1 + subql #1,d1 + jra L34 +L37: + movel a2@(d0:l:4),a0@(d0:l:4) + addql #1,d0 +L34: + cmpl d0,d1 + jgt L37 +L33: + movel a0@(4),d0 + andl #16777215,d0 + movel d5,d1 + jra L67 +L20: + moveq #3,d6 + cmpl d2,d6 + jne L39 + cmpl a2@(8),d3 + jcc L40 + pea 3:w + jbsr _cgeti + movel d0,a0 + movel d4,d0 + moveq #24,d6 + asll d6,d0 + addql #3,d0 + movel d0,a0@(4) + movel a2@(8),d6 + subl d3,d6 + movel d6,a0@(8) + jra L38 +L40: + cmpl a2@(8),d3 + jne L41 + movel _gzero,d0 + jra L14 +L41: + pea 3:w + jbsr _cgeti + movel d0,a0 + movel d4,d0 + negl d0 + moveq #24,d6 + asll d6,d0 + addql #3,d0 + movel d0,a0@(4) + subl a2@(8),d3 + movel d3,a0@(8) + jra L38 +L39: + movel a2@(-4,d2:l:4),d1 + movel d3,d0 + movel d1,d3 + subl d0,d3 + cmpl d1,d0 + jhi L42 + clrl d0 + jra L43 +L42: + moveq #1,d0 +L43: + tstl d0 + jeq L44 + movel d2,sp@- + jbsr _cgeti + movel d0,a0 + movel d3,a0@(-4,d2:l:4) + movel d2,d0 + subql #2,d0 + tstl a2@(d0:l:4) + jne L62 +L48: + moveq #-1,d6 + movel d6,a0@(d0:l:4) + subql #1,d0 + tstl a2@(d0:l:4) + jeq L48 +L62: + movel a2@(d0:l:4),d1 + subql #1,d1 + movel d1,a0@(d0:l:4) + moveq #2,d6 + cmpl d0,d6 + jlt L50 + tstl d1 + jeq L49 +L50: + subql #1,d0 + tstl d0 + jle L38 +L54: + movel a2@(d0:l:4),a0@(d0:l:4) + subql #1,d0 + tstl d0 + jgt L54 + jra L38 +L49: + movel a0@,d0 + subql #1,d0 + movel d0,a0@(4) + movel d0,a0@(8) + addqw #4,a0 + addql #4,_avma + movel a0@(4),d0 + andl #16777215,d0 + movel d4,d1 +L67: + moveq #24,d6 + asll d6,d1 + addl d1,d0 + movel d0,a0@(4) + jra L38 +L44: + movel d2,sp@- + jbsr _cgeti + movel d0,a0 + movel d3,a0@(-4,d2:l:4) + moveq #1,d0 + movel d2,d1 + subql #1,d1 + jra L57 +L60: + movel a2@(d0:l:4),a0@(d0:l:4) + addql #1,d0 +L57: + cmpl d0,d1 + jgt L60 +L38: + movel a0,d0 +L14: + moveml a6@(-24),#0x47c + unlk a6 + rts + .even +.globl _addii +_addii: + link a6,#-4 + moveml #0x3f3c,sp@- + movel a6@(8),a5 + movel a6@(12),a6@(-4) + movel a5@(4),d4 + andl #65535,d4 + movel a6@(-4),a4 + movel a4@(4),d5 + andl #65535,d5 + cmpl d4,d5 + jle L69 + movel a5,a3 + movel a6@(-4),a5 + movel a3,a6@(-4) + movel d4,d6 + movel d5,d4 + movel d6,d5 +L69: + movel a6@(-4),a4 + moveb a4@(4),d7 + extbl d7 + movel d7,a2 + tstl a2 + jne L70 + movel a5,sp@- + jbsr _icopy + jra L68 +L70: + moveb a5@(4),d6 + extbl d6 + cmpl d6,a2 + jne L71 + movel d4,a4 + pea a4@(1) + jbsr _cgeti + movel d0,a3 + clrl d1 + movel d4,d0 + asll #2,d0 + lea a3@(4,d0:l),a2 + lea a5@(0,d0:l),a1 + movel a6@(-4),a4 + lea a4@(d5:l:4),a0 + movel d5,d2 + subql #2,d2 +L72: +#APP + addl #-1,d1 +#NO_APP + moveq #16,d7 + cmpl d7,d2 + jhi L77 +LI94: + movew pc@(L94-LI94-2:b,d2:l:2),d7 + jmp pc@(2,d7:w) +L94: + .word L93-L94 + .word L92-L94 + .word L91-L94 + .word L90-L94 + .word L89-L94 + .word L88-L94 + .word L87-L94 + .word L86-L94 + .word L85-L94 + .word L84-L94 + .word L83-L94 + .word L82-L94 + .word L81-L94 + .word L80-L94 + .word L79-L94 + .word L78-L94 + .word L77-L94 +L77: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L78: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L79: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L80: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L81: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L82: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L83: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L84: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L85: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L86: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L87: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L88: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L89: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L90: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L91: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L92: + movel a1@-,d7 + movel a0@-,d3 +#APP + addxl d3,d7 +#NO_APP + movel d7,a2@- +L93: +#APP + clrl d1 + addxl d1,d1 +#NO_APP + moveq #-16,d7 + addl d7,d2 + tstl d2 + jgt L72 + tstl d1 + jeq L95 + movel a5,d0 + addql #8,d0 +L96: + subqw #4,a1 + movel a1,a0 + cmpl a1,d0 + jhi L97 + moveq #-1,d7 + cmpl a1@,d7 + jne L98 + clrl a2@- + jra L96 +L98: + movel a0@,d7 + addql #1,d7 + movel d7,a2@- + jra L100 +L102: + movel a0@,a2@- +L100: + subqw #4,a1 + movel a1,a0 + cmpl a1,d0 + jls L102 + jra L160 +L97: + moveq #1,d7 + movel d7,a3@(8) + movel a5@(4),d7 + addql #1,d7 + movel d7,a3@(4) + jra L108 +L95: + movel d4,d1 + subl d5,d1 + jra L105 +L107: + movel a1@-,a2@- +L105: + dbra d1,L107 + clrw d1 + subql #1,d1 + jcc L107 +L160: + movel a3@,d7 + subql #1,d7 + movel d7,a3@(4) + movel a5@(4),a3@(8) + addqw #4,a3 + addql #4,_avma + jra L108 +L71: + cmpl d4,d5 + jne L109 + movel d4,d1 + subql #2,d1 + lea a5@(8),a1 + movel a6@(-4),a0 + addqw #8,a0 + jra L110 +L116: + movel a1@+,d2 + movel a0@+,d0 + cmpl d0,d2 + jcc L112 + movel a5,a3 + movel a6@(-4),a5 + movel a3,a6@(-4) + movel a2,d6 + jra L109 +L112: + cmpl d2,d0 + jcs L109 +L110: + dbra d1,L116 + clrw d1 + subql #1,d1 + jcc L116 + movel _gzero,d0 + jra L68 +L109: + movel d4,sp@- + jbsr _cgeti + movel d0,a3 + clrl d1 + movel d4,d0 + asll #2,d0 + lea a5@(0,d0:l),a1 + movel a6@(-4),a4 + lea a4@(d5:l:4),a0 + lea a3@(0,d0:l),a2 + movel d5,d2 + subql #2,d2 +L118: +#APP + addl #-1,d1 +#NO_APP + moveq #16,d7 + cmpl d7,d2 + jhi L123 +LI140: + movew pc@(L140-LI140-2:b,d2:l:2),d7 + jmp pc@(2,d7:w) +L140: + .word L139-L140 + .word L138-L140 + .word L137-L140 + .word L136-L140 + .word L135-L140 + .word L134-L140 + .word L133-L140 + .word L132-L140 + .word L131-L140 + .word L130-L140 + .word L129-L140 + .word L128-L140 + .word L127-L140 + .word L126-L140 + .word L125-L140 + .word L124-L140 + .word L123-L140 +L123: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L124: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L125: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L126: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L127: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L128: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L129: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L130: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L131: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L132: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L133: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L134: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L135: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L136: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L137: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L138: + movel a1@-,d7 + movel a0@-,d3 +#APP + subxl d3,d7 +#NO_APP + movel d7,a2@- +L139: +#APP + clrl d1 + addxl d1,d1 +#NO_APP + moveq #-16,d7 + addl d7,d2 + tstl d2 + jgt L118 + tstl d1 + jeq L141 + jra L142 +L144: + moveq #-1,d7 + movel d7,a2@- +L142: + movel a1@-,d0 + jeq L144 + movel a5,d1 + addql #8,d1 + cmpl a1,d1 + jhi L149 + subql #1,d0 + movel d0,a2@- + jra L146 +L148: + movel a0@,a2@- +L146: + subqw #4,a1 + movel a1,a0 + cmpl a1,d1 + jls L148 + jra L149 +L141: + movel d4,d2 + subl d5,d2 + jra L150 +L152: + movel a1@-,a2@- +L150: + dbra d2,L152 + clrw d2 + subql #1,d2 + jcc L152 +L149: + tstl a3@(8) + jeq L153 + movel a5@(4),a3@(4) + jra L108 +L153: + lea a3@(12),a2 + tstl a2@ + jne L159 +L157: + addqw #4,a2 + tstl a2@ + jeq L157 +L159: + subqw #8,a2 + movel a2,d2 + subl a3,d2 + jpl L158 + addql #3,d2 +L158: + asrl #2,d2 + movel a3@,d0 + subl d2,d0 + movel d0,a2@ + movel d0,a2@(4) + movel a2,a3 + movel a3@(4),d0 + andl #16777215,d0 + movel d6,d1 + moveq #24,d7 + asll d7,d1 + addl d1,d0 + movel d0,a3@(4) + movel d2,d0 + asll #2,d0 + addl d0,_avma +L108: + movel a3,d0 +L68: + moveml a6@(-44),#0x3cfc + unlk a6 + rts + .even +.globl _mulss +_mulss: + link a6,#0 + moveml #0x3c00,sp@- + movel a6@(8),d0 + movel a6@(12),d2 + tstl d0 + jeq L163 + tstl d2 + jne L162 +L163: + movel _gzero,d0 + jra L161 +L162: + moveq #1,d4 + tstl d0 + jge L164 + moveq #-1,d4 + negl d0 + jpl L164 + movel d0,sp@- + jbsr _stoi + movel d0,sp@- + movel d2,sp@- + jbsr _mulsi + jra L161 +L164: + tstl d2 + jge L166 + negl d4 + negl d2 + jpl L166 + pea _ABS_MOST_NEGS + tstl d4 + jgt L169 + negl d0 +L169: + movel d0,sp@- + jbsr _mulsi + jra L161 +L166: +#APP + mulul d2,d3:d0 +#NO_APP + movel d0,d2 + tstl d3 + jeq L170 + pea 4:w + jbsr _cgeti + movel d0,a0 + movel d3,a0@(8) + movel d2,a0@(12) + jra L171 +L170: + pea 3:w + jbsr _cgeti + movel d0,a0 + movel d2,a0@(8) +L171: + movel a0@,a0@(4) + movel a0@(4),d0 + andl #16777215,d0 + movel d4,d1 + moveq #24,d5 + asll d5,d1 + addl d1,d0 + movel d0,a0@(4) + movel a0,d0 +L161: + moveml a6@(-16),#0x3c + unlk a6 + rts + .even +.globl _mulii +_mulii: + link a6,#-8 + moveml #0x3f3c,sp@- + movel a6@(8),a3 + movel a6@(12),d7 + movel a3@(4),d5 + andl #65535,d5 + movel d7,a5 + movel a5@(4),d6 + andl #65535,d6 + movel d6,a6@(-4) + moveb a3@(4),d2 + extbl d2 + jeq L188 + movel d7,a5 + moveb a5@(4),d0 + extbl d0 + jne L174 +L188: + movel _gzero,d0 + jra L172 +L174: + tstl d0 + jge L175 + negl d2 +L175: + cmpl a6@(-4),d5 + jle L176 + movel a3,a2 + movel d7,a3 + movel a2,d7 + movel d5,a4 + movel a6@(-4),d5 + movel a4,a6@(-4) +L176: + movel a6@(-4),a5 + lea a5@(-2,d5:l),a4 + cmpl #65535,a4 + jle L177 + pea 17:w + jbsr _err + addqw #4,sp +L177: + movel a4,sp@- + jbsr _cgeti + movel d0,a2 + movel a2@,a2@(4) + movel a2@(4),d0 + andl #16777215,d0 + movel d2,d1 + moveq #24,d6 + asll d6,d1 + addl d1,d0 + movel d0,a2@(4) + lea a3@(d5:l:4),a5 + movel a5,a6@(-8) + movel a6@(-8),a5 + subqw #4,a5 + movel a5,a6@(-8) + movel a5@,d4 + clrl d2 + movel a6@(-4),d3 + subql #2,d3 + movel d7,a5 + movel a6@(-4),d6 + lea a5@(d6:l:4),a1 + lea a2@(a4:l:4),a3 + jra L178 +L180: + movel d2,d0 + movel d4,d1 +#APP + mulul a1@-,d2:d1 +#NO_APP + addl d1,d0 + clrl d6 +#APP + addxl d6,d2 +#NO_APP + movel d0,a3@- +L178: + dbra d3,L180 + clrw d3 + subql #1,d3 + jcc L180 + movel d2,a3@- + lea a2@(a4:l:4),a3 + movel d7,a5 + movel a6@(-4),d6 + lea a5@(d6:l:4),a4 + subql #2,a6@(-4) + subql #2,d5 + clrl d7 + jra L181 +L186: + movel a6@(-8),a5 + subqw #4,a5 + movel a5,a6@(-8) + movel a5@,d4 + movel a6@(-4),d3 + movel a4,a1 + lea a3@(-4),a0 + movel a0,a3 + clrl d1 + jra L183 +L185: + movel a1@-,d0 +#APP + mulul d4,d2:d0 +#NO_APP + addl a0@-,d0 +#APP + addxl d7,d2 +#NO_APP + addl d1,d0 +#APP + addxl d7,d2 +#NO_APP + movel d0,a0@ + movel d2,d1 +L183: + dbra d3,L185 + clrw d3 + subql #1,d3 + jcc L185 + movel d2,a0@- +L181: + subql #1,d5 + tstl d5 + jgt L186 + tstl a2@(8) + jne L187 + movel a2@(4),d6 + subql #1,d6 + movel d6,a2@(8) + movel a2@,d6 + subql #1,d6 + movel d6,a2@(4) + addqw #4,a2 + addql #4,_avma +L187: + movel a2,d0 +L172: + moveml a6@(-48),#0x3cfc + unlk a6 + rts + .even +.globl _confrac +_confrac: + link a6,#-8 + moveml #0x3f3c,sp@- + movel a6@(8),a5 + movel a5@,d7 + andl #65535,d7 + movel d7,a6@(-8) + movel a5@(4),d5 + andl #16777215,d5 + addl #-8388608,d5 + moveq #-1,d7 + subl d5,d7 + movel d7,d5 + movel _avma,a6@(-4) + movel a6@(-8),a4 + subqw #2,a4 + movel a4,d7 + asll #5,d7 + movel d7,a4 + addl d5,a4 + lea a4@(63),a3 + movel a3,d7 + asrl #5,d7 + movel d7,a3 + movel a3,sp@- + jbsr _cgeti + movel d0,a2 + movel d5,d0 + asrl #5,d0 + clrl d3 + addqw #4,sp + cmpl d3,d0 + jle L216 +L193: + clrl a2@(d3:l:4) + addql #1,d3 + cmpl d3,d0 + jgt L193 +L216: + moveq #31,d7 + andl d7,d5 + jne L194 + moveq #2,d4 + cmpl a6@(-8),d4 + jge L199 +L198: + movel a5@(d4:l:4),a2@(d3:l:4) + addql #1,d3 + addql #1,d4 + cmpl a6@(-8),d4 + jlt L198 + jra L199 +L194: + clrl d6 + moveq #2,d4 + cmpl a6@(-8),d4 + jge L214 + moveq #32,d7 + subl d5,d7 + movel d7,a0 +L203: + movel d3,d0 + movel a5@(d4:l:4),d2 + addql #1,d3 + movel d2,d1 + lsrl d5,d1 + addl d6,d1 + movel d1,a2@(d0:l:4) + movel d2,d6 + movel a0,d7 + lsll d7,d6 + addql #1,d4 + cmpl a6@(-8),d4 + jlt L203 +L214: + movel d6,a2@(-8,a3:l:4) +L199: + clrl a2@(-4,a3:l:4) + movel a4,d7 + fmovel d7,fp0 + fmuld #0r.30102999999999999758,fp0 + fmovecr #0x32,fp1 + faddx fp1,fp0 + fintrzx fp0,fp0 + fmovel fp0,d2 + moveq #17,d5 + addl d2,d5 + moveq #9,d7 + divsl d7,d5 + movel d5,sp@- + jbsr _cgeti + movel d0,a0 + movel d2,a0@ + moveq #1,d4 + cmpl d4,d5 + jle L213 + movel #1000000000,d6 +L211: + clrl d1 + movel a3,d3 + jra L217 +L210: + movel d1,d2 + movel a2@(d3:l:4),d0 +#APP + mulul d6,d1:d0 +#NO_APP + addl d2,d0 + clrl d7 +#APP + addxl d7,d1 +#NO_APP + movel d0,a2@(d3:l:4) +L217: + subql #1,d3 + jpl L210 + movel d1,a0@(d4:l:4) + addql #1,d4 + cmpl d4,d5 + jgt L211 +L213: + movel a6@(-4),_avma + movel a0,d0 + moveml a6@(-48),#0x3cfc + unlk a6 + rts + .even +.globl _divss +_divss: + link a6,#0 + moveml #0x3820,sp@- + movel a6@(8),d4 + movel a6@(12),d3 + jne L219 + pea 23:w + jbsr _err + addqw #4,sp +L219: + cmpl #-2147483648,d4 + jne L220 + movel d3,sp@- + movel d4,sp@- + jbsr _stoi + addqw #4,sp + movel d0,sp@- + jbsr _divis + jra L218 +L220: + clrl _hiremainder + movel d4,sp@- + lea _abs,a2 + jbsr a2@ + movel d0,d2 + movel d3,sp@- + jbsr a2@ + movel _hiremainder,d1 +#APP + divul d0,d1:d2 +#NO_APP + movel d1,_hiremainder + movel d2,d0 + addqw #8,sp + tstl d3 + jge L221 + negl _hiremainder + negl d0 +L221: + tstl d4 + jge L222 + negl d0 +L222: + movel d0,sp@- + jbsr _stoi +L218: + moveml a6@(-16),#0x41c + unlk a6 + rts + .even +.globl _modss +_modss: + link a6,#0 + moveml #0x3820,sp@- + movel a6@(8),d2 + movel a6@(12),d4 + jne L224 + pea 38:w + jbsr _err + addqw #4,sp +L224: + cmpl #-2147483648,d2 + jne L225 + movel d4,sp@- + movel d2,sp@- + jbsr _stoi + addqw #4,sp + movel d0,sp@- + jbsr _modis + jra L223 +L225: + clrl d3 + movel d2,sp@- + lea _abs,a2 + jbsr a2@ + movel d0,d2 + movel d4,sp@- + jbsr a2@ +#APP + divul d0,d3:d2 +#NO_APP + addqw #8,sp + tstl d3 + jne L226 + movel _gzero,d0 + jra L223 +L226: + tstl d3 + jge L227 + subl d3,d0 + movel d0,sp@- + jra L229 +L227: + movel d3,sp@- +L229: + jbsr _stoi +L223: + moveml a6@(-16),#0x41c + unlk a6 + rts + .even +.globl _resss +_resss: + link a6,#0 + moveml #0x3820,sp@- + movel a6@(12),d4 + jne L231 + pea 40:w + jbsr _err + addqw #4,sp +L231: + clrl d3 + movel a6@(8),sp@- + lea _abs,a2 + jbsr a2@ + movel d0,d2 + movel d4,sp@- + jbsr a2@ +#APP + divul d0,d3:d2 +#NO_APP + addqw #8,sp + tstl d4 + jge L232 + negl d3 +L232: + movel d3,sp@- + jbsr _stoi + moveml a6@(-16),#0x41c + unlk a6 + rts + .even +.globl _divsi +_divsi: + link a6,#0 + moveml #0x3820,sp@- + movel a6@(8),d3 + movel a6@(12),a2 + moveb a2@(4),d0 + extbl d0 + movel a2@(4),d2 + andl #65535,d2 + tstl d0 + jne L235 + pea 24:w + jbsr _err + addqw #4,sp +L235: + tstl d3 + jeq L237 + moveq #3,d4 + cmpl d2,d4 + jlt L237 + tstl a2@(8) + jge L236 +L237: + movel d3,_hiremainder + movel _gzero,d0 + jra L234 +L236: + cmpl #-2147483648,d3 + jne L238 + clrl sp@- + movel a2,sp@- + movel d3,sp@- + jbsr _stoi + addqw #4,sp + movel d0,sp@- + jbsr _dvmdii + jra L234 +L238: + clrl _hiremainder + movel d3,sp@- + jbsr _abs + movel _hiremainder,d4 +#APP + divul a2@(8),d4:d0 +#NO_APP + movel d4,_hiremainder + movel d0,d1 + moveb a2@(4),d0 + extbl d0 + addqw #4,sp + jpl L239 + negl _hiremainder + negl d1 +L239: + tstl d3 + jge L240 + negl d1 +L240: + movel d1,sp@- + jbsr _stoi +L234: + moveml a6@(-16),#0x41c + unlk a6 + rts + .even +.globl _divis +_divis: + link a6,#0 + moveml #0x3f30,sp@- + movel a6@(8),a2 + movel a6@(12),d3 + moveb a2@(4),d7 + extbl d7 + movel a2@(4),d6 + andl #65535,d6 + tstl d3 + jne L242 + pea 26:w + jbsr _err + addqw #4,sp +L242: + tstl d7 + jne L243 + clrl _hiremainder + movel _gzero,d0 + jra L241 +L243: + tstl d3 + jge L244 + negl d7 + negl d3 + jpl L244 + clrl sp@- + movel d3,sp@- + jbsr _stoi + addqw #4,sp + movel d0,sp@- + movel a2,sp@- + jbsr _dvmdii + jra L241 +L244: + cmpl a2@(8),d3 + jls L246 + moveq #3,d5 + cmpl d6,d5 + jne L247 + movel a2,sp@- + jbsr _itos + movel d0,_hiremainder + movel _gzero,d0 + jra L241 +L247: + movel d6,a1 + pea a1@(-1) + jbsr _cgeti + movel d0,a0 + movew #1,a3 + movel a2@(8),d4 + jra L249 +L246: + movel d6,sp@- + jbsr _cgeti + movel d0,a0 + subl a3,a3 + clrl d4 +L249: + movel a3,d2 + addql #2,d2 + cmpl d2,d6 + jle L256 +L253: + movel d2,d1 + subl a3,d1 + movel a2@(d2:l:4),d0 +#APP + divul d3,d4:d0 +#NO_APP + movel d0,a0@(d1:l:4) + addql #1,d2 + cmpl d2,d6 + jgt L253 +L256: + movel a0@,a0@(4) + movel a0@(4),d0 + andl #16777215,d0 + movel d7,d1 + moveq #24,d5 + asll d5,d1 + addl d1,d0 + movel d0,a0@(4) + tstl d7 + jge L254 + movel d4,d0 + negl d0 + jra L255 +L254: + movel d4,d0 +L255: + movel d0,_hiremainder + movel a0,d0 +L241: + moveml a6@(-32),#0xcfc + unlk a6 + rts + .even +.globl _dvmdii +_dvmdii: + link a6,#-60 + moveml #0x3f3c,sp@- + movel a6@(8),a4 + moveb a4@(4),d6 + extbl d6 + movel d6,a6@(-24) + movel a6@(12),a1 + moveb a1@(4),d6 + extbl d6 + movel d6,a6@(-28) + jne L258 + pea 36:w + jbsr _err + addqw #4,sp +L258: + tstl a6@(-24) + jne L259 + moveq #-1,d6 + cmpl a6@(16),d6 + jeq L361 + tstl a6@(16) + jeq L361 + movel a6@(16),a1 + movel _gzero,a1@ +L361: + movel _gzero,d0 + jra L257 +L259: + movel a4@(4),d6 + andl #65535,d6 + movel d6,a6@(-8) + movel a6@(12),a1 + movel a1@(4),d6 + andl #65535,d6 + movel d6,a6@(-12) + movel a6@(-8),d6 + subl a6@(-12),d6 + movel d6,a6@(-16) + jge L262 + moveq #-1,d6 + cmpl a6@(16),d6 + jne L263 + movel a4,sp@- + jbsr _icopy + jra L257 +L263: + tstl a6@(16) + jeq L361 + movel a4,sp@- + jbsr _icopy + movel a6@(16),a1 + movel d0,a1@ + jra L361 +L262: + movel _avma,a6@(-4) + tstl a6@(-24) + jge L265 + negl a6@(-28) +L265: + moveq #3,d6 + cmpl a6@(-12),d6 + jne L266 + movel a6@(12),a1 + movel a1@(8),a6@(-60) + lea a4@(8),a3 + movel a6@(-60),d6 + cmpl a4@(8),d6 + jls L267 + movel a6@(-8),d2 + subql #1,d2 + movel a3@+,d5 + jra L268 +L267: + movel a6@(-8),d2 + clrl d5 +L268: + movel d2,sp@- + jbsr _cgeti + movel d0,a6@(-36) + movel d2,d7 + subql #2,d7 + movel d0,a2 + addqw #8,a2 + addqw #4,sp + jra L269 +L271: + movel a3@+,d0 +#APP + divul a6@(-60),d5:d0 +#NO_APP + movel d0,a2@+ +L269: + dbra d7,L271 + clrw d7 + subql #1,d7 + jcc L271 + moveq #-1,d6 + cmpl a6@(16),d6 + jne L272 + movel a6@(-4),_avma + tstl d5 + jeq L361 + pea 3:w + jbsr _cgeti + movel d0,a6@(-40) + movel a6@(-24),d0 + moveq #24,d6 + asll d6,d0 + movel a6@(-40),a1 + addql #3,d0 + movel d0,a1@(4) + movel d5,a1@(8) + movel a1,d0 + jra L257 +L272: + moveq #2,d6 + cmpl d2,d6 + jeq L274 + movel a6@(-36),a1 + movel a1@,a1@(4) + movel a1@(4),d0 + andl #16777215,d0 + movel a6@(-28),d1 + moveq #24,d6 + asll d6,d1 + addl d1,d0 + movel d0,a1@(4) + jra L275 +L274: + movel a6@(-4),_avma + movel _gzero,a6@(-36) +L275: + tstl a6@(16) + jne L276 +L359: + movel a6@(-36),d0 + jra L257 +L276: + tstl d5 + jne L277 + movel a6@(16),a1 + movel _gzero,a1@ + jra L359 +L277: + pea 3:w + jbsr _cgeti + movel d0,a6@(-40) + movel a6@(-24),d0 + moveq #24,d6 + asll d6,d0 + movel a6@(-40),a1 + addql #3,d0 + movel d0,a1@(4) + movel d5,a1@(8) + movel a6@(16),a1 + movel a6@(-40),a1@ + jra L359 +L266: + movel a6@(-8),sp@- + lea _cgeti,a3 + jbsr a3@ + movel d0,a6@(-36) + movel a6@(12),a1 +#APP + bfffo a1@(8){#0:#0},d6 +#NO_APP + movel d6,a6@(-20) + addqw #4,sp + jeq L280 + movel a1,a2 + addqw #8,a2 + movel a6@(-12),sp@- + jbsr a3@ + movel d0,a6@(-40) + movel a2@+,d1 + moveq #32,d0 + subl d6,d0 + movel d1,d5 + lsrl d0,d5 + lsll d6,d1 + movel d1,a6@(-56) + movel a6@(-40),a0 + addqw #8,a0 + movel a6@(-12),d7 + subql #3,d7 + addqw #4,sp + moveq #32,d0 + subl d6,d0 + jra L281 +L283: + movel a2@+,d1 + movel d1,d5 + lsrl d0,d5 + movel a6@(-56),d6 + addl d5,d6 + movel d6,a0@+ + movel a6@(-20),d6 + lsll d6,d1 + movel d1,a6@(-56) +L281: + dbra d7,L283 + clrw d7 + subql #1,d7 + jcc L283 + movel a6@(-56),a0@ + clrl a6@(-56) + lea a4@(8),a3 + movel a6@(-36),a2 + addqw #4,a2 + movel a6@(-8),d7 + subql #2,d7 + moveq #32,d0 + subl a6@(-20),d0 + jra L284 +L286: + movel a3@+,d1 + movel d1,d5 + lsrl d0,d5 + movel a6@(-56),d6 + addl d5,d6 + movel d6,a2@+ + movel a6@(-20),d6 + lsll d6,d1 + movel d1,a6@(-56) +L284: + dbra d7,L286 + clrw d7 + subql #1,d7 + jcc L286 + movel a6@(-56),a2@ + jra L287 +L280: + lea a4@(8),a3 + movel a6@(-36),a2 + addqw #4,a2 + clrl a2@+ + movel a6@(-8),d4 + subql #2,d4 + jra L288 +L290: + movel a3@+,a2@+ +L288: + dbra d4,L290 + clrw d4 + subql #1,d4 + jcc L290 + movel a6@(12),a6@(-40) +L287: + movel a6@(-40),a1 + movel a1@(8),a6@(-60) + movel a1@(12),a6@(-32) + movel a6@(-36),a2 + addqw #4,a2 + movel a6@(-16),d7 + addql #1,d7 + movel a6@(-12),d6 + asll #2,d6 + movel d6,a6@(-52) + jra L291 +L322: + movel a2@+,d6 + cmpl a6@(-60),d6 + jne L293 + movew #-1,a4 + movel a6@(-60),d1 + movel d1,d3 + addl a2@,d3 + cmpl d3,d1 + jls L294 + moveq #1,d2 + jra L295 +L294: + clrl d2 +L295: + movel d3,a6@(-56) + jra L296 +L293: + movel a2@,d0 + movel a2@(-4),d5 +#APP + divul a6@(-60),d5:d0 +#NO_APP + movel d0,a4 + clrl d2 + movel d5,a6@(-56) +L296: + tstl d2 + jne L297 + movel a4,d0 +#APP + mulul a6@(-32),d5:d0 +#NO_APP + movel d0,d1 + movel a2@(4),d0 + movel d1,d3 + subl d0,d3 + cmpl d1,d0 + jhi L298 + clrl d2 + jra L299 +L298: + moveq #1,d2 +L299: + movel d3,a0 + movel d5,d1 + movel a6@(-56),d0 + movel d5,d3 + subl a6@(-56),d3 + subl d2,d3 + cmpl a6@(-56),d5 + jcs L362 + jra L308 +L312: + tstl d4 + jeq L297 + subqw #1,a4 + movel a0,d1 + movel a6@(-32),d0 + movel d1,d3 + subl d0,d3 + cmpl d1,d0 + jhi L306 + clrl d2 + jra L307 +L306: + moveq #1,d2 +L307: + movel d3,a0 + movel d4,d1 + movel a6@(-60),d0 + movel d1,d3 + subl d0,d3 + subl d2,d3 + cmpl d0,d1 + jcc L308 +L362: + moveq #1,d2 + jra L309 +L308: + cmpl d0,d1 + jls L309 + clrl d2 +L309: + movel d3,d4 + tstl d2 + jeq L312 +L297: + clrl d5 + movel a6@(-12),d4 + subql #2,d4 + movel a6@(-52),d6 + lea a2@(-8,d6:l),a0 + movel a6@(-40),d6 + addl a6@(-52),d6 + movel d6,a6@(-56) + jra L313 +L317: + movel d5,d1 + movel a6@(-56),a1 + subqw #4,a1 + movel a1,a6@(-56) + movel a4,d0 +#APP + mulul a1@,d5:d0 +#NO_APP + movel d0,d3 + movel d1,d0 + addl d3,d0 + clrl d6 +#APP + addxl d6,d5 +#NO_APP + movel d0,d2 + subqw #4,a0 + movel a0,a3 + movel a0@,d1 + movel d1,d3 + subl d2,d3 + cmpl d1,d2 + jhi L315 + clrl d2 + jra L316 +L315: + moveq #1,d2 +L316: + movel d3,a3@ + addl d2,d5 +L313: + dbra d4,L317 + clrw d4 + subql #1,d4 + jcc L317 + cmpl a2@(-4),d5 + jls L318 + clrl d2 + subqw #1,a4 + movel a6@(-12),d4 + subql #2,d4 + movel a6@(-52),d6 + lea a2@(-8,d6:l),a0 + movel a6@(-40),d6 + addl a6@(-52),d6 + movel d6,a6@(-56) + jra L319 +L321: +#APP + addl #-1,d2 +#NO_APP + movel a6@(-56),a1 + subqw #4,a1 + movel a1,a6@(-56) + movel a0@-,d0 + movel a1@,d6 +#APP + addxl d6,d0 +#NO_APP + movel d0,a0@ +#APP + clrl d2 + addxl d2,d2 +#NO_APP +L319: + dbra d4,L321 + clrw d4 + subql #1,d4 + jcc L321 +L318: + movel a4,a2@(-4) +L291: + dbra d7,L322 + clrw d7 + subql #1,d7 + jcc L322 + movel _avma,d3 + moveq #-1,d6 + cmpl a6@(16),d6 + jeq L323 + movel a6@(-16),d2 + addql #2,d2 + movel a6@(-36),a1 + lea a1@(d2:l:4),a2 + tstl a1@(4) + jeq L324 + addql #1,d2 + jra L325 +L324: + tstl a6@(-16) + jne L325 + clrl a6@(-28) +L325: + movel d2,sp@- + jbsr _cgeti + movel d0,a6@(-44) + movel d0,a1 + lea a1@(d2:l:4),a0 + movel d2,d4 + subql #2,d4 + addqw #4,sp + jra L327 +L329: + movel a2@-,a0@- +L327: + dbra d4,L329 + clrw d4 + subql #1,d4 + jcc L329 + moveq #2,d6 + cmpl d2,d6 + jcs L330 + movel a6@(-44),a1 + moveq #2,d6 + movel d6,a1@(4) + jra L323 +L330: + movel a6@(-44),a1 + movel a1@,a1@(4) + movel a1@(4),d0 + andl #16777215,d0 + movel a6@(-28),d1 + moveq #24,d6 + asll d6,d1 + addl d1,d0 + movel d0,a1@(4) +L323: + tstl a6@(16) + jeq L332 + movel a6@(-16),d4 + addql #2,d4 + cmpl a6@(-8),d4 + jge L334 +L336: + movel a6@(-36),a1 + tstl a1@(d4:l:4) + jne L334 + addql #1,d4 + cmpl a6@(-8),d4 + jlt L336 +L334: + cmpl a6@(-8),d4 + jne L337 + movel _gzero,sp@- + jbsr _icopy + movel d0,a6@(-48) + addqw #4,sp + jra L332 +L337: + movel a6@(-8),a0 + subl d4,a0 + pea a0@(2) + jbsr _cgeti + movel d0,a6@(-48) + movel d0,a1 + movel a1@,a1@(4) + addqw #4,sp + tstl a6@(-20) + jne L339 + moveq #2,d7 + cmpl a6@(-8),d4 + jge L344 +L343: + movel a6@(-48),a1 + movel a6@(-36),a5 + movel a5@(d4:l:4),a1@(d7:l:4) + addql #1,d4 + addql #1,d7 + cmpl a6@(-8),d4 + jlt L343 + jra L344 +L339: + movel a6@(-36),a1 + movel a1@(d4:l:4),d1 + addql #1,d4 + moveq #32,d0 + subl a6@(-20),d0 + movel d1,d2 + movel a6@(-20),d6 + lsrl d6,d2 + lsll d0,d1 + movel d1,a6@(-56) + tstl d2 + jeq L345 + movel a6@(-48),a1 + movel d2,a1@(8) + moveq #1,d0 + jra L346 +L345: + movel a6@(-48),a1 + movel a1@,d6 + subql #1,d6 + movel d6,a1@(4) + addql #4,a6@(-48) + addql #4,_avma + movel a6@(-48),a1 + movel a1@,a1@(4) + clrl d0 +L346: + movel d0,d7 + addql #2,d7 + cmpl a6@(-8),d4 + jge L344 + moveq #32,d2 + subl a6@(-20),d2 +L350: + movel a6@(-36),a1 + movel a1@(d4:l:4),d1 + movel d1,d0 + movel a6@(-20),d6 + lsrl d6,d0 + movel a6@(-48),a1 + addl a6@(-56),d0 + movel d0,a1@(d7:l:4) + lsll d2,d1 + movel d1,a6@(-56) + addql #1,d4 + addql #1,d7 + cmpl a6@(-8),d4 + jlt L350 +L344: + movel a6@(-48),a1 + movel a1@(4),d0 + andl #16777215,d0 + movel a6@(-24),d1 + moveq #24,d6 + asll d6,d1 + addl d1,d0 + movel d0,a1@(4) +L332: + moveq #-1,d6 + cmpl a6@(16),d6 + jne L351 + movel a6@(-48),sp@- + jra L360 +L351: + tstl a6@(16) + jne L352 + movel a6@(-44),sp@- +L360: + movel d3,sp@- + movel a6@(-4),sp@- + jbsr _gerepile + jra L257 +L352: + clrl sp@- + movel d3,sp@- + movel a6@(-4),sp@- + jbsr _gerepile + moveq #-4,d6 + andl d6,d0 + movel a6@(16),a1 + movel a6@(-48),d6 + addl d0,d6 + movel d6,a1@ + addl a6@(-44),d0 +L257: + moveml a6@(-100),#0x3cfc + unlk a6 + rts + .even +.globl _mulul3 +_mulul3: + link a6,#0 + movel a6@(16),a0 + movel a6@(8),d0 + movel a0@,d1 +#APP + mulul a6@(12),d1:d0 +#NO_APP + movel d1,a0@ + unlk a6 + rts + .even +.globl _divul3 +_divul3: + link a6,#0 + movel a6@(16),a0 + movel a6@(8),d0 + movel a0@,d1 +#APP + divul a6@(12),d1:d0 +#NO_APP + movel d1,a0@ + unlk a6 + rts +.comm _in_saved_avma,4 diff --git a/mp/mpi-sol-sparc.s b/mp/mpi-sol-sparc.s new file mode 100755 index 0000000..65a5942 --- /dev/null +++ b/mp/mpi-sol-sparc.s @@ -0,0 +1,2848 @@ + .file "mpi.c" +gcc2_compiled.: +.section ".text" + .align 4 + .global mulsi + .type mulsi,#function + .proc 0104 +mulsi: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + ld [%i1+4],%o1 + sra %o1,24,%l1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + cmp %i0,0 + be .LL3 + and %o1,%o0,%l0 + cmp %l1,0 + bne .LL2 + cmp %i0,0 +.LL3: + sethi %hi(gzero),%o0 + b .LL12 + ld [%o0+%lo(gzero)],%i0 +.LL2: + bge .LL4 + nop + subcc %g0,%i0,%i0 + bpos .LL4 + sub %g0,%l1,%l1 + call stoi,0 + sethi %hi(-2147483648),%o0 + call mulii,0 + mov %i1,%o1 + b .LL12 + mov %o0,%i0 +.LL4: + call cgeti,0 + add %l0,1,%o0 + mov %o0,%g3 + mov 0,%o2 + sll %l0,2,%o0 + add %i1,%o0,%i1 + add %g3,%o0,%g2 + addcc %l0,-2,%o3 + be .LL7 + add %g2,4,%g2 +.LL8: + add %g2,-4,%g2 + mov %o2,%o1 + add %i1,-4,%i1 + mov %i0,%o0 + ld [%i1],%l2 + + or %o0,%l2,%o4 + mov %o0,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%g0,%o4 + tst %l2 + bl,a 1f + add %o4,%o0,%o4 +1: mov %o4,%o2 + b 3f + rd %y,%o0 +2: clr %o2 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%l2,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o0 +3: + + addcc %o1,%o0,%l2 + addx %o2,%g0,%o2 + addcc %o3,-1,%o3 + bne .LL8 + st %l2,[%g2] +.LL7: + cmp %o2,0 + be .LL10 + sethi %hi(-65536),%o1 + st %o2,[%g2-4] + ld [%g3+4],%o0 + and %o0,%o1,%o0 + add %o0,%l0,%o0 + b .LL13 + add %o0,1,%o0 +.LL10: + sethi %hi(avma),%o1 + ld [%o1+%lo(avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(avma)] + ld [%g3],%o0 + add %o0,-1,%o0 + st %o0,[%g3+4] + add %g3,4,%g3 + ld [%g3+4],%o0 + sethi %hi(-65536),%o1 + and %o0,%o1,%o0 + add %o0,%l0,%o0 +.LL13: + st %o0,[%g3+4] + ld [%g3+4],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l1,24,%o0 + add %o1,%o0,%o1 + st %o1,[%g3+4] + mov %g3,%i0 +.LL12: + ret + restore +.LLfe1: + .size mulsi,.LLfe1-mulsi + .align 4 + .global expi + .type expi,#function + .proc 04 +expi: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + mov %i0,%o2 + ld [%o2+4],%o1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + and %o1,%o0,%i0 + cmp %i0,2 + be,a .LL15 + sethi %hi(-8388608),%i0 + call bfffo,0 + ld [%o2+8],%o0 + add %i0,-2,%i0 + sll %i0,5,%i0 + sub %i0,%o0,%i0 + add %i0,-1,%i0 +.LL15: + ret + restore +.LLfe2: + .size expi,.LLfe2-expi + .align 4 + .global addsi + .type addsi,#function + .proc 0104 +addsi: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + orcc %i0,0,%l1 + bne,a .LL18 + ldsb [%i1+4],%l3 + call icopy,0 + mov %i1,%o0 + b .LL67 + mov %o0,%i0 +.LL18: + cmp %l3,0 + bne .LL19 + cmp %l1,0 + call stoi,0 + mov %l1,%o0 + b .LL67 + mov %o0,%i0 +.LL19: + bge .LL20 + mov 1,%l4 + subcc %g0,%l1,%l1 + bpos .LL22 + mov -1,%l4 + sethi %hi(MOST_NEGS),%o0 + or %o0,%lo(MOST_NEGS),%o0 + call addii,0 + mov %i1,%o1 + b .LL67 + mov %o0,%i0 +.LL20: +.LL22: + ld [%i1+4],%o1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + cmp %l4,%l3 + bne .LL23 + and %o1,%o0,%l0 + mov %l1,%o1 + sll %l0,2,%l2 + add %l2,%i1,%o0 + ld [%o0-4],%o0 + add %o1,%o0,%o0 + cmp %o0,%o1 + bgeu .LL24 + mov %o0,%l1 + call cgeti,0 + add %l0,1,%o0 + mov %o0,%i0 + add %l0,-1,%o2 + cmp %o2,2 + ble .LL69 + st %l1,[%i0+%l2] +.LL30: + sll %o2,2,%o1 + add %o1,%i1,%o0 + ld [%o0-4],%o0 + cmp %o0,-1 + bne .LL69 + cmp %o2,2 + add %o2,-1,%o2 + cmp %o2,2 + bg .LL30 + st %g0,[%i0+%o1] + cmp %o2,2 +.LL69: + ble .LL31 + sll %o2,2,%o1 + add %o1,%i1,%o0 + ld [%o0-4],%o0 + add %o0,1,%o0 + b .LL68 + st %o0,[%i0+%o1] +.LL34: + add %o0,%i1,%o1 + ld [%o1-4],%o1 + st %o1,[%i0+%o0] +.LL68: + add %o2,-1,%o2 + cmp %o2,2 + bg .LL34 + sll %o2,2,%o0 + ld [%i0],%o0 + add %o0,-1,%o0 + st %o0,[%i0+4] + st %o0,[%i0+8] + add %i0,4,%i0 + sethi %hi(avma),%o1 + ld [%o1+%lo(avma)],%o0 + add %o0,4,%o0 + b .LL37 + st %o0,[%o1+%lo(avma)] +.LL31: + mov 1,%o0 + st %o0,[%i0+8] + ld [%i0],%o0 + b .LL37 + st %o0,[%i0+4] +.LL24: + call cgeti,0 + mov %l0,%o0 + mov %o0,%i0 + sll %l0,2,%o0 + add %o0,%i0,%o0 + st %l1,[%o0-4] + mov 1,%o2 + add %l0,-1,%o0 + cmp %o2,%o0 + bge .LL37 + mov %o0,%o3 +.LL41: + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + add %o2,1,%o2 + cmp %o2,%o3 + bl .LL41 + st %o0,[%i0+%o1] +.LL37: + ld [%i0+4],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l4,24,%o0 + add %o1,%o0,%o1 + b .LL67 + st %o1,[%i0+4] +.LL23: + cmp %l0,3 + bne .LL44 + sll %l0,2,%l2 + ld [%i1+8],%o0 + cmp %o0,%l1 + bleu .LL45 + nop + call cgeti,0 + mov 3,%o0 + mov %o0,%i0 + sll %l3,24,%o0 + add %o0,3,%o0 + st %o0,[%i0+4] + ld [%i1+8],%o0 + sub %o0,%l1,%o0 + b .LL67 + st %o0,[%i0+8] +.LL45: + bne .LL46 + sethi %hi(gzero),%o0 + b .LL67 + ld [%o0+%lo(gzero)],%i0 +.LL46: + call cgeti,0 + mov 3,%o0 + mov %o0,%i0 + sub %g0,%l3,%o0 + sll %o0,24,%o0 + add %o0,3,%o0 + st %o0,[%i0+4] + ld [%i1+8],%o0 + sub %l1,%o0,%o0 + b .LL67 + st %o0,[%i0+8] +.LL44: + add %l2,%i1,%o0 + ld [%o0-4],%o1 + mov %l1,%o0 + cmp %o1,%o0 + bgeu .LL47 + sub %o1,%o0,%l1 + call cgeti,0 + mov %l0,%o0 + mov %o0,%i0 + add %l2,%i0,%o0 + st %l1,[%o0-4] + add %l0,-2,%o2 + sll %o2,2,%o0 + mov %o0,%o1 + ld [%i1+%o0],%o0 + cmp %o0,0 + bne,a .LL70 + sll %o2,2,%o1 + mov -1,%o3 + st %o3,[%i0+%o1] +.LL71: + add %o2,-1,%o2 + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + cmp %o0,0 + be,a .LL71 + st %o3,[%i0+%o1] + sll %o2,2,%o1 +.LL70: + ld [%i1+%o1],%o0 + add %o0,-1,%o0 + cmp %o2,2 + bg .LL54 + st %o0,[%i0+%o1] + cmp %o0,0 + be,a .LL53 + ld [%i0],%o0 +.LL54: + add %o2,-1,%o2 + cmp %o2,0 + ble .LL67 + nop +.LL58: + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + add %o2,-1,%o2 + cmp %o2,0 + bg .LL58 + st %o0,[%i0+%o1] + b,a .LL67 +.LL53: + add %o0,-1,%o0 + st %o0,[%i0+4] + st %o0,[%i0+8] + add %i0,4,%i0 + sethi %hi(avma),%o1 + ld [%o1+%lo(avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(avma)] + ld [%i0+4],%o1 + sethi %hi(-16777216),%o0 + andn %o1,%o0,%o0 + sll %l3,24,%o1 + add %o0,%o1,%o0 + b .LL67 + st %o0,[%i0+4] +.LL47: + call cgeti,0 + mov %l0,%o0 + mov %o0,%i0 + sll %l0,2,%o0 + add %o0,%i0,%o0 + st %l1,[%o0-4] + mov 1,%o2 + add %l0,-1,%o0 + cmp %o2,%o0 + bge .LL67 + mov %o0,%o3 +.LL65: + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + add %o2,1,%o2 + cmp %o2,%o3 + bl .LL65 + st %o0,[%i0+%o1] +.LL67: + ret + restore +.LLfe3: + .size addsi,.LLfe3-addsi + .align 4 + .global addii + .type addii,#function + .proc 0104 +addii: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + mov %i0,%l0 + ld [%l0+4],%o0 + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + and %o0,%o1,%l1 + ld [%i1+4],%o0 + and %o0,%o1,%l2 + cmp %l1,%l2 + bge,a .LL236 + ldsb [%i1+4],%o5 + mov %i1,%l0 + mov %i0,%i1 + mov %l1,%l3 + mov %l2,%l1 + mov %l3,%l2 + ldsb [%i1+4],%o5 +.LL236: + cmp %o5,0 + bne,a .LL74 + ldsb [%l0+4],%l3 + call icopy,0 + mov %l0,%o0 + b .LL201 + mov %o0,%i0 +.LL74: + cmp %l3,%o5 + bne .LL75 + cmp %l1,%l2 + call cgeti,0 + add %l1,1,%o0 + mov %o0,%i0 + mov 0,%o2 + sll %l1,2,%o0 + add %i0,%o0,%o4 + add %o4,4,%o4 + add %l0,%o0,%o3 + sll %l2,2,%o0 + add %i1,%o0,%o1 + add %l2,-2,%o5 + sethi %hi(.LL113),%o0 + or %o0,%lo(.LL113),%g2 + add %o5,-1,%o0 +.LL237: + cmp %o0,15 + bgu .LL81 + sll %o0,2,%o0 + ld [%g2+%o0],%o0 + jmp %o0 + nop + .align 4 +.LL113: + .word .LL111 + .word .LL109 + .word .LL107 + .word .LL105 + .word .LL103 + .word .LL101 + .word .LL99 + .word .LL97 + .word .LL95 + .word .LL93 + .word .LL91 + .word .LL89 + .word .LL87 + .word .LL85 + .word .LL83 + .word .LL81 +.LL81: + subcc %g0,%o2,%g0 + b .LL82 + add %o4,-4,%o4 +.LL83: + subcc %g0,%o2,%g0 + b .LL204 + add %o4,-4,%o4 +.LL85: + subcc %g0,%o2,%g0 + b .LL205 + add %o4,-4,%o4 +.LL87: + subcc %g0,%o2,%g0 + b .LL206 + add %o4,-4,%o4 +.LL89: + subcc %g0,%o2,%g0 + b .LL207 + add %o4,-4,%o4 +.LL91: + subcc %g0,%o2,%g0 + b .LL208 + add %o4,-4,%o4 +.LL93: + subcc %g0,%o2,%g0 + b .LL209 + add %o4,-4,%o4 +.LL95: + subcc %g0,%o2,%g0 + b .LL210 + add %o4,-4,%o4 +.LL97: + subcc %g0,%o2,%g0 + b .LL211 + add %o4,-4,%o4 +.LL99: + subcc %g0,%o2,%g0 + b .LL212 + add %o4,-4,%o4 +.LL101: + subcc %g0,%o2,%g0 + b .LL213 + add %o4,-4,%o4 +.LL103: + subcc %g0,%o2,%g0 + b .LL214 + add %o4,-4,%o4 +.LL105: + subcc %g0,%o2,%g0 + b .LL215 + add %o4,-4,%o4 +.LL107: + subcc %g0,%o2,%g0 + b .LL216 + add %o4,-4,%o4 +.LL109: + subcc %g0,%o2,%g0 + b .LL217 + add %o4,-4,%o4 +.LL111: + subcc %g0,%o2,%g0 + b .LL218 + add %o4,-4,%o4 +.LL82: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL204: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL205: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL206: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL207: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL208: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL209: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL210: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL211: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL212: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL213: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL214: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL215: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL216: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL217: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL218: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + addxcc %g3,%l4,%g3 + st %g3,[%o4] + addx %g0,%g0,%o2 + add %o5,-16,%o5 + cmp %o5,0 + bg .LL237 + add %o5,-1,%o0 + cmp %o2,0 + be .LL115 + add %l0,8,%o2 +.LL116: + add %o3,-4,%o3 + cmp %o3,%o2 + blu .LL117 + mov %o3,%o1 + ld [%o3],%o0 + cmp %o0,-1 + bne .LL118 + add %o4,-4,%o4 + b .LL116 + st %g0,[%o4] +.LL118: + ld [%o1],%o0 + b .LL203 + add %o0,1,%o0 +.LL122: + add %o4,-4,%o4 + ld [%o1],%o0 +.LL203: + st %o0,[%o4] + add %o3,-4,%o3 + cmp %o3,%o2 + bgeu .LL122 + mov %o3,%o1 + b .LL219 + ld [%i0],%o0 +.LL117: + mov 1,%o0 + st %o0,[%i0+8] + ld [%l0+4],%o0 + add %o0,1,%o0 + b .LL201 + st %o0,[%i0+4] +.LL115: + subcc %l1,%l2,%o2 + be,a .LL219 + ld [%i0],%o0 +.LL128: + add %o4,-4,%o4 + add %o3,-4,%o3 + ld [%o3],%o0 + addcc %o2,-1,%o2 + bne .LL128 + st %o0,[%o4] + ld [%i0],%o0 +.LL219: + add %o0,-1,%o0 + st %o0,[%i0+4] + ld [%l0+4],%o0 + st %o0,[%i0+8] + add %i0,4,%i0 + sethi %hi(avma),%o1 + ld [%o1+%lo(avma)],%o0 + add %o0,4,%o0 + b .LL201 + st %o0,[%o1+%lo(avma)] +.LL75: + bne .LL131 + add %l0,8,%o3 + addcc %l1,-2,%o2 + be .LL140 + add %i1,8,%o1 + ld [%o3],%o4 +.LL238: + add %o3,4,%o3 + ld [%o1],%o0 + cmp %o0,%o4 + bgu .LL202 + add %o1,4,%o1 + cmp %o4,%o0 + bgu .LL131 + addcc %o2,-1,%o2 + bne,a .LL238 + ld [%o3],%o4 +.LL140: + sethi %hi(gzero),%o0 + b .LL201 + ld [%o0+%lo(gzero)],%i0 +.LL202: + mov %l0,%i0 + mov %i1,%l0 + mov %i0,%i1 + mov %o5,%l3 +.LL131: + call cgeti,0 + mov %l1,%o0 + mov %o0,%i0 + mov 0,%o2 + sll %l1,2,%o0 + add %l0,%o0,%o3 + sll %l2,2,%o1 + add %i1,%o1,%o1 + add %i0,%o0,%o4 + add %l2,-2,%o5 + sethi %hi(.LL178),%o0 + or %o0,%lo(.LL178),%g2 + add %o5,-1,%o0 +.LL239: + cmp %o0,15 + bgu .LL146 + sll %o0,2,%o0 + ld [%g2+%o0],%o0 + jmp %o0 + nop + .align 4 +.LL178: + .word .LL176 + .word .LL174 + .word .LL172 + .word .LL170 + .word .LL168 + .word .LL166 + .word .LL164 + .word .LL162 + .word .LL160 + .word .LL158 + .word .LL156 + .word .LL154 + .word .LL152 + .word .LL150 + .word .LL148 + .word .LL146 +.LL146: + subcc %g0,%o2,%g0 + b .LL147 + add %o4,-4,%o4 +.LL148: + subcc %g0,%o2,%g0 + b .LL220 + add %o4,-4,%o4 +.LL150: + subcc %g0,%o2,%g0 + b .LL221 + add %o4,-4,%o4 +.LL152: + subcc %g0,%o2,%g0 + b .LL222 + add %o4,-4,%o4 +.LL154: + subcc %g0,%o2,%g0 + b .LL223 + add %o4,-4,%o4 +.LL156: + subcc %g0,%o2,%g0 + b .LL224 + add %o4,-4,%o4 +.LL158: + subcc %g0,%o2,%g0 + b .LL225 + add %o4,-4,%o4 +.LL160: + subcc %g0,%o2,%g0 + b .LL226 + add %o4,-4,%o4 +.LL162: + subcc %g0,%o2,%g0 + b .LL227 + add %o4,-4,%o4 +.LL164: + subcc %g0,%o2,%g0 + b .LL228 + add %o4,-4,%o4 +.LL166: + subcc %g0,%o2,%g0 + b .LL229 + add %o4,-4,%o4 +.LL168: + subcc %g0,%o2,%g0 + b .LL230 + add %o4,-4,%o4 +.LL170: + subcc %g0,%o2,%g0 + b .LL231 + add %o4,-4,%o4 +.LL172: + subcc %g0,%o2,%g0 + b .LL232 + add %o4,-4,%o4 +.LL174: + subcc %g0,%o2,%g0 + b .LL233 + add %o4,-4,%o4 +.LL176: + subcc %g0,%o2,%g0 + b .LL234 + add %o4,-4,%o4 +.LL147: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL220: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL221: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL222: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL223: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL224: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL225: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL226: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL227: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL228: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL229: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL230: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL231: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL232: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL233: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + add %o4,-4,%o4 +.LL234: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%g3 + ld [%o1],%l4 + subxcc %g3,%l4,%g3 + st %g3,[%o4] + addx %g0,%g0,%o2 + add %o5,-16,%o5 + cmp %o5,0 + bg .LL239 + add %o5,-1,%o0 + cmp %o2,0 + be,a .LL180 + subcc %l1,%l2,%o5 + add %o3,-4,%o3 + ld [%o3],%o0 + cmp %o0,0 + bne .LL240 + add %l0,8,%o1 + mov -1,%o1 + add %o4,-4,%o4 +.LL241: + st %o1,[%o4] + add %o3,-4,%o3 + ld [%o3],%o0 + cmp %o0,0 + be,a .LL241 + add %o4,-4,%o4 + add %l0,8,%o1 +.LL240: + cmp %o3,%o1 + blu .LL190 + add %o0,-1,%o0 + add %o4,-4,%o4 + st %o0,[%o4] + add %o3,-4,%o3 + cmp %o3,%o1 + blu .LL190 + mov %o3,%o0 +.LL188: + add %o4,-4,%o4 + ld [%o0],%o0 + st %o0,[%o4] + add %o3,-4,%o3 + cmp %o3,%o1 + bgeu .LL188 + mov %o3,%o0 + b .LL235 + ld [%i0+8],%o0 +.LL180: + be,a .LL235 + ld [%i0+8],%o0 +.LL193: + add %o4,-4,%o4 + add %o3,-4,%o3 + ld [%o3],%o0 + addcc %o5,-1,%o5 + bne .LL193 + st %o0,[%o4] +.LL190: + ld [%i0+8],%o0 +.LL235: + cmp %o0,0 + be,a .LL195 + ld [%i0+12],%o0 + ld [%l0+4],%o0 + b .LL201 + st %o0,[%i0+4] +.LL195: + cmp %o0,0 + bne .LL198 + add %i0,12,%o4 + add %o4,4,%o4 +.LL242: + ld [%o4],%o0 + cmp %o0,0 + be,a .LL242 + add %o4,4,%o4 +.LL198: + add %o4,-8,%o4 + sub %o4,%i0,%o5 + sra %o5,2,%o5 + ld [%i0],%o1 + sub %o1,%o5,%o1 + st %o1,[%o4] + st %o1,[%o4+4] + mov %o4,%i0 + sethi %hi(-16777216),%o0 + andn %o1,%o0,%o0 + sll %l3,24,%o1 + add %o0,%o1,%o0 + st %o0,[%i0+4] + sethi %hi(avma),%o2 + sll %o5,2,%o0 + ld [%o2+%lo(avma)],%o1 + add %o0,%o1,%o0 + st %o0,[%o2+%lo(avma)] +.LL201: + ret + restore +.LLfe4: + .size addii,.LLfe4-addii + .align 4 + .global mulss + .type mulss,#function + .proc 0104 +mulss: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + orcc %i0,0,%o0 + be .LL245 + cmp %i1,0 + bne .LL244 + cmp %o0,0 +.LL245: + sethi %hi(gzero),%o0 + b .LL253 + ld [%o0+%lo(gzero)],%i0 +.LL244: + bge .LL246 + mov 1,%l0 + subcc %g0,%o0,%o0 + bpos .LL246 + mov -1,%l0 + call stoi,0 + nop + mov %o0,%o1 + b .LL254 + mov %i1,%o0 +.LL246: + cmp %i1,0 + bge .LL255 + mov %o0,%l1 + subcc %g0,%i1,%i1 + bpos .LL255 + sub %g0,%l0,%l0 + cmp %l0,0 + bg .LL250 + mov %o0,%o1 + sub %g0,%o0,%o1 +.LL250: + mov %o1,%o0 + sethi %hi(ABS_MOST_NEGS),%o1 + or %o1,%lo(ABS_MOST_NEGS),%o1 +.LL254: + call mulsi,0 + nop + b .LL253 + mov %o0,%i0 +.LL255: + + or %l1,%i1,%o4 + mov %l1,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + tst %i1 + bl,a 1f + add %o4,%l1,%o4 +1: mov %o4,%o2 + b 3f + rd %y,%l1 +2: clr %o2 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%l1 +3: + + orcc %o2,0,%i1 + be .LL251 + nop + call cgeti,0 + mov 4,%o0 + mov %o0,%i0 + st %i1,[%i0+8] + b .LL252 + st %l1,[%i0+12] +.LL251: + call cgeti,0 + mov 3,%o0 + mov %o0,%i0 + st %l1,[%i0+8] +.LL252: + ld [%i0],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l0,24,%o0 + add %o1,%o0,%o1 + st %o1,[%i0+4] +.LL253: + ret + restore +.LLfe5: + .size mulss,.LLfe5-mulss + .align 4 + .global mulii + .type mulii,#function + .proc 0104 +mulii: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + mov %i0,%l4 + ld [%l4+4],%o0 + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + and %o0,%o1,%l0 + ld [%i1+4],%o2 + sra %o0,24,%l3 + cmp %l3,0 + be .LL276 + and %o2,%o1,%l2 + ldsb [%i1+4],%o0 + cmp %o0,0 + bne .LL258 + nop +.LL276: + sethi %hi(gzero),%o0 + b .LL275 + ld [%o0+%lo(gzero)],%i0 +.LL258: + bl,a .LL259 + sub %g0,%l3,%l3 +.LL259: + cmp %l0,%l2 + ble .LL260 + mov %l4,%i0 + mov %i1,%l4 + mov %i0,%i1 + mov %l0,%l1 + mov %l2,%l0 + mov %l1,%l2 +.LL260: + add %l0,%l2,%l1 + add %l1,-2,%l1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + cmp %l1,%o0 + ble .LL261 + nop + call err,0 + mov 17,%o0 +.LL261: + call cgeti,0 + mov %l1,%o0 + mov %o0,%i0 + ld [%i0],%o1 + sethi %hi(-16777216),%o0 + andn %o1,%o0,%o0 + sll %l3,24,%o1 + add %o0,%o1,%o0 + st %o0,[%i0+4] + sll %l0,2,%o0 + add %l4,%o0,%g4 + add %g4,-4,%g4 + ld [%g4],%g2 + mov 0,%o2 + sll %l2,2,%o0 + add %i1,%o0,%g3 + sll %l1,2,%o0 + addcc %l2,-2,%o3 + be .LL263 + add %i0,%o0,%g1 +.LL264: + add %g1,-4,%g1 + mov %o2,%o1 + add %g3,-4,%g3 + mov %g2,%o0 + ld [%g3],%l5 + + or %o0,%l5,%o4 + mov %o0,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%g0,%o4 + tst %l5 + bl,a 1f + add %o4,%o0,%o4 +1: mov %o4,%o2 + b 3f + rd %y,%o0 +2: clr %o2 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%l5,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o0 +3: + + addcc %o1,%o0,%l5 + addx %o2,%g0,%o2 + addcc %o3,-1,%o3 + bne .LL264 + st %l5,[%g1] +.LL263: + st %o2,[%g1-4] + sll %l1,2,%o0 + add %i0,%o0,%g1 + sll %l2,2,%o0 + add %i1,%o0,%i1 + add %l0,-3,%l0 + cmp %l0,0 + ble .LL267 + add %l2,-1,%l2 +.LL268: + add %g4,-4,%g4 + ld [%g4],%o7 + mov %i1,%g3 + add %g1,-4,%o1 + mov %o1,%g1 + addcc %l2,-1,%o3 + be .LL270 + mov 0,%g2 +.LL271: + add %g3,-4,%g3 + ld [%g3],%o0 + + or %o0,%o7,%o4 + mov %o0,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%g0,%o4 + tst %o7 + bl,a 1f + add %o4,%o0,%o4 +1: mov %o4,%o2 + b 3f + rd %y,%o0 +2: clr %o2 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o0 +3: + + add %o1,-4,%o1 + ld [%o1],%l5 + addcc %o0,%l5,%o0 + addx %o2,%g0,%o2 + addcc %o0,%g2,%l5 + addx %o2,%g0,%o2 + st %l5,[%o1] + addcc %o3,-1,%o3 + bne .LL271 + mov %o2,%g2 +.LL270: + add %l0,-1,%l0 + cmp %l0,0 + bg .LL268 + st %o2,[%o1-4] +.LL267: + ld [%i0+8],%o0 + cmp %o0,0 + bne .LL275 + sethi %hi(avma),%o1 + ld [%i0+4],%o0 + add %o0,-1,%o0 + st %o0,[%i0+8] + ld [%i0],%o0 + add %o0,-1,%o0 + st %o0,[%i0+4] + add %i0,4,%i0 + ld [%o1+%lo(avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(avma)] +.LL275: + ret + restore +.LLfe6: + .size mulii,.LLfe6-mulii + .global .div +.section ".rodata" + .align 8 +.LLC0: + .uaword 0x3fd34413 ! ~3.01030000000000019789e-1 + .uaword 0x55475a32 + .align 8 +.LLC1: + .uaword 0x3ff00000 ! ~1.00000000000000000000e0 + .uaword 0x0 +.section ".text" + .align 4 + .global confrac + .type confrac,#function + .proc 0104 +confrac: + !#PROLOGUE# 0 + save %sp,-120,%sp + !#PROLOGUE# 1 + ld [%i0],%o1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + and %o1,%o0,%l2 + ld [%i0+4],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sethi %hi(8388607),%o0 + or %o0,%lo(8388607),%o0 + sub %o0,%o1,%l0 + sethi %hi(avma),%o0 + ld [%o0+%lo(avma)],%l5 + add %l2,-2,%l4 + sll %l4,5,%l4 + add %l4,%l0,%l4 + add %l4,63,%l3 + sra %l3,5,%l3 + call cgeti,0 + mov %l3,%o0 + sra %l0,5,%o1 + mov 0,%g2 + cmp %g2,%o1 + bge .LL279 + mov %o0,%l1 +.LL281: + sll %g2,2,%o0 + add %g2,1,%g2 + cmp %g2,%o1 + bl .LL281 + st %g0,[%l1+%o0] +.LL279: + andcc %l0,31,%l0 + bne .LL283 + mov 2,%g3 + cmp %g3,%l2 + bge .LL305 + sll %l3,2,%o0 +.LL287: + sll %g2,2,%o0 + sll %g3,2,%o1 + ld [%i0+%o1],%o1 + st %o1,[%l1+%o0] + add %g3,1,%g3 + cmp %g3,%l2 + bl .LL287 + add %g2,1,%g2 + b .LL305 + sll %l3,2,%o0 +.LL283: + cmp %g3,%l2 + bge .LL291 + mov 0,%o3 + mov 32,%o0 + sub %o0,%l0,%o4 +.LL293: + sll %g2,2,%o1 + sll %g3,2,%o0 + ld [%i0+%o0],%o2 + add %g2,1,%g2 + srl %o2,%l0,%o0 + add %o0,%o3,%o0 + st %o0,[%l1+%o1] + add %g3,1,%g3 + cmp %g3,%l2 + bl .LL293 + sll %o2,%o4,%o3 +.LL291: + sll %l3,2,%o0 + add %o0,%l1,%o0 + st %o3,[%o0-8] + sll %l3,2,%o0 +.LL305: + add %o0,%l1,%o0 + st %g0,[%o0-4] + st %l4,[%fp-20] + ld [%fp-20],%f6 + fitod %f6,%f2 + sethi %hi(.LLC0),%l6 + ldd [%l6+%lo(.LLC0)],%f4 + fmuld %f2,%f4,%f2 + sethi %hi(.LLC1),%l6 + ldd [%l6+%lo(.LLC1)],%f4 + faddd %f2,%f4,%f2 + fdtoi %f2,%f2 + st %f2,[%fp-20] + ld [%fp-20],%l0 + add %l0,17,%l2 + mov %l2,%o0 + call .div,0 + mov 9,%o1 + call cgeti,0 + mov %o0,%l2 + mov %o0,%i0 + mov 1,%g3 + cmp %g3,%l2 + bge .LL296 + st %l0,[%i0] +.LL298: + addcc %l3,-1,%g2 + bneg .LL300 + mov 0,%o3 + sethi %hi(1000000000),%o0 + or %o0,%lo(1000000000),%o7 +.LL302: + sll %g2,2,%o1 + mov %o3,%o2 + ld [%l1+%o1],%o0 + + or %o0,%o7,%o4 + mov %o0,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%g0,%o4 + tst %o7 + bl,a 1f + add %o4,%o0,%o4 +1: mov %o4,%o3 + b 3f + rd %y,%o0 +2: clr %o3 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o0 +3: + + addcc %o2,%o0,%l6 + addx %o3,%g0,%o3 + addcc %g2,-1,%g2 + bpos .LL302 + st %l6,[%l1+%o1] +.LL300: + sll %g3,2,%o0 + add %g3,1,%g3 + cmp %g3,%l2 + bl .LL298 + st %o3,[%i0+%o0] +.LL296: + sethi %hi(avma),%o0 + st %l5,[%o0+%lo(avma)] + ret + restore +.LLfe7: + .size confrac,.LLfe7-confrac + .align 4 + .global divss + .type divss,#function + .proc 0104 +divss: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + cmp %i1,0 + bne .LL315 + sethi %hi(-2147483648),%o0 + call err,0 + mov 23,%o0 + sethi %hi(-2147483648),%o0 +.LL315: + cmp %i0,%o0 + bne .LL308 + sethi %hi(hiremainder),%o0 + call stoi,0 + mov %i0,%o0 + call divis,0 + mov %i1,%o1 + b,a .LL314 +.LL308: + st %g0,[%o0+%lo(hiremainder)] + cmp %i0,0 + bge .LL309 + mov %i0,%o0 + sub %g0,%i0,%o0 +.LL309: + cmp %i1,0 + bge .LL310 + mov %i1,%o1 + sub %g0,%i1,%o1 +.LL310: + sethi %hi(hiremainder),%l0 + call divul3,0 + or %l0,%lo(hiremainder),%o2 + cmp %i1,0 + bge .LL311 + mov %o0,%o1 + ld [%l0+%lo(hiremainder)],%o0 + sub %g0,%o0,%o0 + st %o0,[%l0+%lo(hiremainder)] + sub %g0,%o1,%o1 +.LL311: + cmp %i0,0 + bl,a .LL312 + sub %g0,%o1,%o1 +.LL312: + call stoi,0 + mov %o1,%o0 +.LL314: + ret + restore %g0,%o0,%o0 +.LLfe8: + .size divss,.LLfe8-divss + .align 4 + .global modss + .type modss,#function + .proc 0104 +modss: + !#PROLOGUE# 0 + save %sp,-120,%sp + !#PROLOGUE# 1 + cmp %i1,0 + bne .LL326 + sethi %hi(-2147483648),%o0 + call err,0 + mov 38,%o0 + sethi %hi(-2147483648),%o0 +.LL326: + cmp %i0,%o0 + bne .LL318 + mov %i0,%o0 + call stoi,0 + mov %i0,%o0 + call modis,0 + mov %i1,%o1 + b .LL323 + mov %o0,%i0 +.LL318: + cmp %o0,0 + bge .LL319 + st %g0,[%fp-20] + sub %g0,%o0,%o0 +.LL319: + cmp %i1,0 + bl,a .LL320 + sub %g0,%i1,%i1 +.LL320: + mov %i1,%o1 + call divul3,0 + add %fp,-20,%o2 + ld [%fp-20],%o0 + cmp %o0,0 + bne .LL321 + nop + sethi %hi(gzero),%o0 + b .LL323 + ld [%o0+%lo(gzero)],%i0 +.LL321: + bge .LL325 + nop + ld [%fp-20],%o0 + sub %i1,%o0,%o0 +.LL325: + call stoi,0 + nop + mov %o0,%i0 +.LL323: + ret + restore +.LLfe9: + .size modss,.LLfe9-modss + .align 4 + .global resss + .type resss,#function + .proc 0104 +resss: + !#PROLOGUE# 0 + save %sp,-120,%sp + !#PROLOGUE# 1 + cmp %i1,0 + bne .LL334 + mov %i0,%o0 + call err,0 + mov 40,%o0 + mov %i0,%o0 +.LL334: + cmp %o0,0 + bge .LL329 + st %g0,[%fp-20] + sub %g0,%o0,%o0 +.LL329: + cmp %i1,0 + bge .LL330 + mov %i1,%o1 + sub %g0,%i1,%o1 +.LL330: + call divul3,0 + add %fp,-20,%o2 + cmp %i1,0 + bge .LL333 + ld [%fp-20],%o0 + sub %g0,%o0,%o0 +.LL333: + call stoi,0 + nop + ret + restore %g0,%o0,%o0 +.LLfe10: + .size resss,.LLfe10-resss + .align 4 + .global divsi + .type divsi,#function + .proc 0104 +divsi: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + ld [%i1+4],%o0 + sra %o0,24,%o2 + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + cmp %o2,0 + bne .LL336 + and %o0,%o1,%l0 + call err,0 + mov 24,%o0 +.LL336: + cmp %i0,0 + be .LL338 + cmp %l0,3 + bg .LL345 + sethi %hi(hiremainder),%o0 + ld [%i1+8],%o0 + cmp %o0,0 + bge .LL337 + sethi %hi(-2147483648),%o0 +.LL338: + sethi %hi(hiremainder),%o0 +.LL345: + st %i0,[%o0+%lo(hiremainder)] + sethi %hi(gzero),%o0 + b .LL343 + ld [%o0+%lo(gzero)],%i0 +.LL337: + cmp %i0,%o0 + bne .LL339 + sethi %hi(hiremainder),%o0 + call stoi,0 + mov %i0,%o0 + mov %i1,%o1 + call dvmdii,0 + mov 0,%o2 + b .LL343 + mov %o0,%i0 +.LL339: + st %g0,[%o0+%lo(hiremainder)] + cmp %i0,0 + bge .LL340 + mov %i0,%o0 + sub %g0,%i0,%o0 +.LL340: + ld [%i1+8],%o1 + sethi %hi(hiremainder),%l0 + call divul3,0 + or %l0,%lo(hiremainder),%o2 + mov %o0,%o1 + ldsb [%i1+4],%o0 + cmp %o0,0 + bge .LL346 + cmp %i0,0 + ld [%l0+%lo(hiremainder)],%o0 + sub %g0,%o0,%o0 + st %o0,[%l0+%lo(hiremainder)] + sub %g0,%o1,%o1 +.LL346: + bl,a .LL342 + sub %g0,%o1,%o1 +.LL342: + call stoi,0 + mov %o1,%o0 + mov %o0,%i0 +.LL343: + ret + restore +.LLfe11: + .size divsi,.LLfe11-divsi + .align 4 + .global divis + .type divis,#function + .proc 0104 +divis: + !#PROLOGUE# 0 + save %sp,-120,%sp + !#PROLOGUE# 1 + mov %i0,%l3 + ld [%l3+4],%o1 + sra %o1,24,%l4 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + cmp %i1,0 + bne .LL348 + and %o1,%o0,%l2 + call err,0 + mov 26,%o0 +.LL348: + cmp %l4,0 + bne .LL349 + cmp %i1,0 + sethi %hi(hiremainder),%o0 + b .LL364 + st %g0,[%o0+%lo(hiremainder)] +.LL349: + bge,a .LL365 + ld [%l3+8],%o0 + subcc %g0,%i1,%i1 + bpos .LL350 + sub %g0,%l4,%l4 + call stoi,0 + mov %i1,%o0 + mov %o0,%o1 + mov %l3,%o0 + call dvmdii,0 + mov 0,%o2 + b .LL363 + mov %o0,%i0 +.LL350: + ld [%l3+8],%o0 +.LL365: + cmp %i1,%o0 + bleu .LL352 + cmp %l2,3 + bne .LL353 + sethi %hi(hiremainder),%l0 + call itos,0 + mov %l3,%o0 + st %o0,[%l0+%lo(hiremainder)] +.LL364: + sethi %hi(gzero),%o0 + b .LL363 + ld [%o0+%lo(gzero)],%i0 +.LL353: + call cgeti,0 + add %l2,-1,%o0 + mov %o0,%i0 + mov 1,%l1 + ld [%l3+8],%o0 + b .LL355 + st %o0,[%fp-20] +.LL352: + call cgeti,0 + mov %l2,%o0 + mov %o0,%i0 + mov 0,%l1 + st %l1,[%fp-20] +.LL355: + add %l1,2,%l0 + cmp %l0,%l2 + bge,a .LL366 + ld [%i0],%o0 +.LL359: + sll %l0,2,%o0 + ld [%l3+%o0],%o0 + mov %i1,%o1 + call divul3,0 + add %fp,-20,%o2 + sub %l0,%l1,%o1 + sll %o1,2,%o1 + add %l0,1,%l0 + cmp %l0,%l2 + bl .LL359 + st %o0,[%i0+%o1] + ld [%i0],%o0 +.LL366: + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l4,24,%o0 + add %o1,%o0,%o1 + st %o1,[%i0+4] + sethi %hi(hiremainder),%o1 + cmp %l4,0 + bge .LL361 + or %o1,%lo(hiremainder),%o2 + ld [%fp-20],%o0 + sub %g0,%o0,%o0 + b .LL363 + st %o0,[%o1+%lo(hiremainder)] +.LL361: + ld [%fp-20],%o0 + st %o0,[%o2] +.LL363: + ret + restore +.LLfe12: + .size divis,.LLfe12-divis + .align 4 + .global dvmdii + .type dvmdii,#function + .proc 0104 +dvmdii: + !#PROLOGUE# 0 + save %sp,-136,%sp + !#PROLOGUE# 1 + mov %i0,%l2 + mov %i2,%i5 + ldsb [%l2+4],%g1 + st %g1,[%fp-28] + ldsb [%i1+4],%g4 + cmp %g4,0 + bne .LL368 + st %g4,[%fp-32] + call err,0 + mov 36,%o0 +.LL368: + ld [%fp-28],%g1 + cmp %g1,0 + bne,a .LL369 + ld [%l2+4],%o0 + cmp %i5,-1 + be .LL470 + cmp %i5,0 + be .LL470 + sethi %hi(gzero),%o1 + ld [%o1+%lo(gzero)],%o0 + st %o0,[%i5] + b .LL469 + ld [%o1+%lo(gzero)],%i0 +.LL369: + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + and %o0,%o1,%l5 + ld [%i1+4],%o0 + and %o0,%o1,%i3 + subcc %l5,%i3,%i4 + bpos .LL372 + sethi %hi(avma),%o0 + cmp %i5,-1 + bne .LL373 + cmp %i5,0 + call icopy,0 + mov %l2,%o0 + b .LL469 + mov %o0,%i0 +.LL373: + be .LL478 + sethi %hi(gzero),%o0 + call icopy,0 + mov %l2,%o0 + b .LL470 + st %o0,[%i5] +.LL372: + ld [%o0+%lo(avma)],%o0 + st %o0,[%fp-24] + ld [%fp-28],%g4 + cmp %g4,0 + bge .LL479 + cmp %i3,3 + ld [%fp-32],%g1 + sub %g0,%g1,%g1 + st %g1,[%fp-32] +.LL479: + bne .LL376 + nop + ld [%i1+8],%i1 + ld [%l2+8],%o0 + cmp %i1,%o0 + bleu .LL377 + add %l2,8,%l1 + add %l5,-1,%l0 + st %o0,[%fp-20] + b .LL378 + add %l2,12,%l1 +.LL377: + mov %l5,%l0 + st %g0,[%fp-20] +.LL378: + call cgeti,0 + mov %l0,%o0 + mov %o0,%l4 + addcc %l0,-2,%l3 + be .LL380 + add %l4,8,%l2 +.LL381: + ld [%l1],%o0 + add %l1,4,%l1 + mov %i1,%o1 + call divul3,0 + add %fp,-20,%o2 + st %o0,[%l2] + addcc %l3,-1,%l3 + bne .LL381 + add %l2,4,%l2 +.LL380: + cmp %i5,-1 + bne .LL383 + cmp %l0,2 + sethi %hi(avma),%o0 + ld [%fp-24],%g4 + st %g4,[%o0+%lo(avma)] + ld [%fp-20],%o0 + cmp %o0,0 + bne .LL384 + nop +.LL470: + sethi %hi(gzero),%o0 +.LL478: + b .LL469 + ld [%o0+%lo(gzero)],%i0 +.LL384: + call cgeti,0 + mov 3,%o0 + mov %o0,%i0 + ld [%fp-28],%g1 + sll %g1,24,%o0 + add %o0,3,%o0 + st %o0,[%i0+4] + ld [%fp-20],%o0 + b .LL469 + st %o0,[%i0+8] +.LL383: + be .LL385 + sethi %hi(-16777216),%o1 + ld [%l4],%o0 + andn %o0,%o1,%o1 + ld [%fp-32],%g4 + sll %g4,24,%o0 + add %o1,%o0,%o1 + b .LL386 + st %o1,[%l4+4] +.LL385: + sethi %hi(avma),%o0 + ld [%fp-24],%g1 + st %g1,[%o0+%lo(avma)] + sethi %hi(gzero),%o0 + ld [%o0+%lo(gzero)],%l4 +.LL386: + cmp %i5,0 + bne .LL387 + ld [%fp-20],%o0 +.LL472: + b .LL469 + mov %l4,%i0 +.LL387: + cmp %o0,0 + bne .LL388 + sethi %hi(gzero),%o0 + ld [%o0+%lo(gzero)],%o0 + b .LL472 + st %o0,[%i5] +.LL388: + call cgeti,0 + mov 3,%o0 + mov %o0,%i0 + ld [%fp-28],%g4 + sll %g4,24,%o0 + add %o0,3,%o0 + st %o0,[%i0+4] + ld [%fp-20],%o0 + st %o0,[%i0+8] + b .LL472 + st %i0,[%i5] +.LL376: + call cgeti,0 + mov %l5,%o0 + mov %o0,%l4 + call bfffo,0 + ld [%i1+8],%o0 + orcc %o0,0,%l7 + be .LL391 + add %l2,8,%l1 + call cgeti,0 + mov %i3,%o0 + mov %o0,%i0 + ld [%i1+8],%o2 + add %i1,12,%o1 + mov 32,%o0 + sub %o0,%l7,%o0 + srl %o2,%o0,%o0 + st %o0,[%fp-20] + sll %o2,%l7,%g2 + addcc %i3,-3,%l3 + be .LL393 + add %i0,8,%o3 + mov 32,%o0 + sub %o0,%l7,%o4 +.LL394: + ld [%o1],%o2 + add %o1,4,%o1 + srl %o2,%o4,%o0 + st %o0,[%fp-20] + add %g2,%o0,%o0 + st %o0,[%o3] + add %o3,4,%o3 + addcc %l3,-1,%l3 + bne .LL394 + sll %o2,%l7,%g2 +.LL393: + st %g2,[%o3] + mov 0,%g2 + add %l2,8,%l1 + addcc %l5,-2,%l3 + be .LL397 + add %l4,4,%l2 + mov 32,%o0 + sub %o0,%l7,%o1 +.LL398: + ld [%l1],%o2 + add %l1,4,%l1 + srl %o2,%o1,%o0 + st %o0,[%fp-20] + add %g2,%o0,%o0 + st %o0,[%l2] + add %l2,4,%l2 + addcc %l3,-1,%l3 + bne .LL398 + sll %o2,%l7,%g2 +.LL397: + b .LL400 + st %g2,[%l2] +.LL391: + st %g0,[%l4+4] + addcc %l5,-2,%l0 + be .LL402 + add %l4,8,%l2 +.LL403: + ld [%l1],%o0 + st %o0,[%l2] + add %l1,4,%l1 + addcc %l0,-1,%l0 + bne .LL403 + add %l2,4,%l2 +.LL402: + mov %i1,%i0 +.LL400: + ld [%i0+8],%i1 + ld [%i0+12],%i2 + addcc %i4,1,%l3 + be .LL406 + add %l4,4,%l2 + sll %i3,2,%l1 +.LL407: + ld [%l2],%o0 + cmp %o0,%i1 + bne .LL408 + add %l2,4,%l2 + mov -1,%o7 + mov %i1,%o2 + ld [%l2],%o0 + add %o2,%o0,%o1 + cmp %o1,%o2 + addx %g0,0,%o3 + b .LL409 + mov %o1,%g2 +.LL408: + ld [%l2-4],%o0 + st %o0,[%fp-20] + ld [%l2],%o0 + mov %i1,%o1 + call divul3,0 + add %fp,-20,%o2 + mov %o0,%o7 + mov 0,%o3 + ld [%fp-20],%g2 +.LL409: + cmp %o3,0 + bne,a .LL480 + st %g0,[%fp-20] + mov %o7,%o2 + + or %o2,%i2,%o4 + mov %o2,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%g0,%o4 + tst %i2 + bl,a 1f + add %o4,%o2,%o4 +1: mov %o4,%g1 + b 3f + rd %y,%o2 +2: clr %g1 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%i2,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o2 +3: + + st %g1,[%fp-20] + ld [%l2+4],%o0 + cmp %o2,%o0 + addx %g0,0,%o3 + sub %o2,%o0,%o4 + mov %g1,%o2 + mov %g2,%o0 + sub %o2,%g2,%o1 + cmp %g2,%o2 + bgu .LL475 + sub %o1,%o3,%o1 + b .LL476 + cmp %o0,%o2 +.LL423: + be .LL410 + mov %o4,%o2 + add %o7,-1,%o7 + mov %i2,%o0 + cmp %o2,%o0 + addx %g0,0,%o3 + sub %o2,%o0,%o4 + mov %o1,%o2 + mov %i1,%o0 + sub %o2,%o0,%o1 + cmp %o0,%o2 + bleu .LL476 + sub %o1,%o3,%o1 +.LL475: + b .LL420 + mov 1,%o3 +.LL476: + blu,a .LL420 + mov 0,%o3 +.LL420: + cmp %o3,0 + be .LL423 + cmp %o1,0 +.LL410: + st %g0,[%fp-20] +.LL480: + add %l2,%l1,%g2 + add %g2,-8,%g2 + addcc %i3,-2,%l0 + be .LL425 + add %i0,%l1,%g3 +.LL426: + ld [%fp-20],%o2 + add %g3,-4,%g3 + mov %o7,%o1 + ld [%g3],%g1 + + or %o1,%g1,%o4 + mov %o1,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g0,%o4 + tst %g1 + bl,a 1f + add %o4,%o1,%o4 +1: mov %o4,%g4 + b 3f + rd %y,%o1 +2: clr %g4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o1 +3: + + st %g4,[%fp-20] + addcc %o2,%o1,%o3 + addx %g4,%g0,%g4 + st %g4,[%fp-20] + add %g2,-4,%g2 + ld [%g2],%o2 + sub %o2,%o3,%o1 + cmp %o2,%o3 + st %o1,[%g2] + ld [%fp-20],%o0 + addx %g0,%o0,%o0 + addcc %l0,-1,%l0 + bne .LL426 + st %o0,[%fp-20] +.LL425: + ld [%l2-4],%o1 + ld [%fp-20],%o0 + cmp %o1,%o0 + bgeu,a .LL481 + addcc %l3,-1,%l3 + mov 0,%o3 + add %o7,-1,%o7 + add %l2,%l1,%g2 + add %g2,-8,%g2 + addcc %i3,-2,%l0 + be .LL428 + add %i0,%l1,%g3 + add %g2,-4,%g2 +.LL482: + subcc %g0,%o3,%g0 + add %g3,-4,%g3 + ld [%g2],%g1 + ld [%g3],%g4 + addxcc %g1,%g4,%g1 + st %g1,[%g2] + addx %g0,%g0,%o3 + addcc %l0,-1,%l0 + bne,a .LL482 + add %g2,-4,%g2 +.LL428: + addcc %l3,-1,%l3 +.LL481: + bne .LL407 + st %o7,[%l2-4] +.LL406: + sethi %hi(avma),%o0 + cmp %i5,-1 + be .LL434 + ld [%o0+%lo(avma)],%i0 + add %i4,2,%l1 + sll %l1,2,%o0 + add %l4,%o0,%l2 + ld [%l4+4],%o0 + cmp %o0,0 + be .LL435 + cmp %i4,0 + b .LL436 + add %i4,3,%l1 +.LL435: + be,a .LL436 + st %g0,[%fp-32] +.LL436: + call cgeti,0 + mov %l1,%o0 + st %o0,[%fp-36] + sll %l1,2,%o0 + ld [%fp-36],%g1 + addcc %l1,-2,%l0 + be .LL439 + add %g1,%o0,%o1 +.LL440: + add %o1,-4,%o1 + add %l2,-4,%l2 + ld [%l2],%o0 + addcc %l0,-1,%l0 + bne .LL440 + st %o0,[%o1] +.LL439: + cmp %l1,2 + bgu .LL442 + mov 2,%o0 + ld [%fp-36],%g4 + b .LL434 + st %o0,[%g4+4] +.LL442: + ld [%fp-36],%g1 + ld [%g1],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + ld [%fp-32],%g4 + sll %g4,24,%o0 + add %o1,%o0,%o1 + st %o1,[%g1+4] +.LL434: + cmp %i5,0 + be .LL483 + cmp %i5,-1 + add %i4,2,%l0 + cmp %l0,%l5 + bge .LL484 + sll %l0,2,%o0 + ld [%l4+%o0],%o0 + cmp %o0,0 + bne .LL484 + cmp %l0,%l5 + add %i4,3,%l0 +.LL447: + cmp %l0,%l5 + bge .LL484 + sll %l0,2,%o0 + ld [%l4+%o0],%o0 + cmp %o0,0 + be,a .LL447 + add %l0,1,%l0 + cmp %l0,%l5 +.LL484: + bne .LL451 + sub %l5,%l0,%o0 + sethi %hi(gzero),%o0 + call icopy,0 + ld [%o0+%lo(gzero)],%o0 + b .LL444 + mov %o0,%l6 +.LL451: + call cgeti,0 + add %o0,2,%o0 + mov %o0,%l6 + ld [%l6],%o0 + cmp %l7,0 + bne .LL453 + st %o0,[%l6+4] + cmp %l0,%l5 + bge .LL459 + mov 2,%l3 +.LL457: + sll %l3,2,%o0 + sll %l0,2,%o1 + ld [%l4+%o1],%o1 + st %o1,[%l6+%o0] + add %l0,1,%l0 + cmp %l0,%l5 + bl .LL457 + add %l3,1,%l3 + b .LL477 + ld [%l6+4],%o0 +.LL453: + st %g0,[%fp-20] + sll %l0,2,%o0 + ld [%l4+%o0],%o2 + add %l0,1,%l0 + mov 32,%o0 + sub %o0,%l7,%o0 + sll %o2,%o0,%o0 + st %o0,[%fp-20] + srl %o2,%l7,%o3 + cmp %o3,0 + be .LL460 + mov %o0,%g2 + st %o3,[%l6+8] + b .LL461 + mov 1,%o0 +.LL460: + ld [%l6],%o0 + add %o0,-1,%o0 + st %o0,[%l6+4] + add %l6,4,%l6 + sethi %hi(avma),%o1 + ld [%o1+%lo(avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(avma)] + ld [%l6],%o0 + st %o0,[%l6+4] + mov 0,%o0 +.LL461: + cmp %l0,%l5 + bge .LL459 + add %o0,2,%l3 + mov 32,%o0 + sub %o0,%l7,%o3 +.LL465: + sll %l3,2,%o1 + sll %l0,2,%o0 + ld [%l4+%o0],%o2 + sll %o2,%o3,%o0 + st %o0,[%fp-20] + srl %o2,%l7,%o0 + add %o0,%g2,%o0 + st %o0,[%l6+%o1] + ld [%fp-20],%g2 + add %l0,1,%l0 + cmp %l0,%l5 + bl .LL465 + add %l3,1,%l3 +.LL459: + ld [%l6+4],%o0 +.LL477: + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + ld [%fp-28],%g1 + sll %g1,24,%o0 + add %o1,%o0,%o1 + st %o1,[%l6+4] +.LL444: + cmp %i5,-1 +.LL483: + bne .LL467 + cmp %i5,0 + ld [%fp-24],%o0 + mov %i0,%o1 + b .LL474 + mov %l6,%o2 +.LL467: + be .LL468 + ld [%fp-24],%o0 + mov %i0,%o1 + call gerepile,0 + mov 0,%o2 + and %o0,-4,%o0 + add %l6,%o0,%o1 + st %o1,[%i5] + ld [%fp-36],%g4 + b .LL469 + add %g4,%o0,%i0 +.LL468: + mov %i0,%o1 + ld [%fp-36],%o2 +.LL474: + call gerepile,0 + nop + mov %o0,%i0 +.LL469: + ret + restore +.LLfe13: + .size dvmdii,.LLfe13-dvmdii + .align 4 + .global mulul3 + .type mulul3,#function + .proc 016 +mulul3: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + + or %i0,%i1,%o4 + mov %i0,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + tst %i1 + bl,a 1f + add %o4,%i0,%o4 +1: mov %o4,%g2 + b 3f + rd %y,%i0 +2: clr %g2 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%i0 +3: + + st %g2,[%i2] + ret + restore +.LLfe14: + .size mulul3,.LLfe14-mulul3 + .ident "GCC: (GNU) 2.8.1" diff --git a/mp/mpi-sparc.s b/mp/mpi-sparc.s new file mode 100755 index 0000000..d787dc7 --- /dev/null +++ b/mp/mpi-sparc.s @@ -0,0 +1,2808 @@ +gcc2_compiled.: +___gnu_compiled_c: +.text + .align 4 + .global _mulsi + .proc 0104 +_mulsi: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + ld [%i1+4],%o1 + sra %o1,24,%l1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + cmp %i0,0 + be L3 + and %o1,%o0,%l0 + cmp %l1,0 + bne L2 + cmp %i0,0 +L3: + sethi %hi(_gzero),%o0 + b L12 + ld [%o0+%lo(_gzero)],%i0 +L2: + bge L4 + nop + subcc %g0,%i0,%i0 + bpos L4 + sub %g0,%l1,%l1 + call _stoi,0 + sethi %hi(-2147483648),%o0 + call _mulii,0 + mov %i1,%o1 + b L12 + mov %o0,%i0 +L4: + call _cgeti,0 + add %l0,1,%o0 + mov %o0,%g3 + mov 0,%o2 + sll %l0,2,%o0 + add %i1,%o0,%i1 + add %g3,%o0,%g2 + addcc %l0,-2,%o3 + be L7 + add %g2,4,%g2 +L8: + add %g2,-4,%g2 + mov %o2,%o0 + add %i1,-4,%i1 + ld [%i1],%o1 + mov %i0,%l2 + + or %l2,%o1,%o4 + mov %l2,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%g0,%o4 + tst %o1 + bl,a 1f + add %o4,%l2,%o4 +1: mov %o4,%o2 + b 3f + rd %y,%l2 +2: clr %o2 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%l2 +3: + + mov %l2,%o1 + addcc %o0,%o1,%l2 + addx %o2,%g0,%o2 + addcc %o3,-1,%o3 + bne L8 + st %l2,[%g2] +L7: + cmp %o2,0 + be L10 + sethi %hi(-65536),%o1 + st %o2,[%g2-4] + ld [%g3+4],%o0 + and %o0,%o1,%o0 + add %o0,%l0,%o0 + b L13 + add %o0,1,%o0 +L10: + sethi %hi(_avma),%o1 + ld [%o1+%lo(_avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(_avma)] + ld [%g3],%o0 + add %o0,-1,%o0 + st %o0,[%g3+4] + add %g3,4,%g3 + ld [%g3+4],%o0 + sethi %hi(-65536),%o1 + and %o0,%o1,%o0 + add %o0,%l0,%o0 +L13: + st %o0,[%g3+4] + ld [%g3+4],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l1,24,%o0 + add %o1,%o0,%o1 + st %o1,[%g3+4] + mov %g3,%i0 +L12: + ret + restore + .align 4 + .global _expi + .proc 04 +_expi: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + mov %i0,%o2 + ld [%o2+4],%o1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + and %o1,%o0,%i0 + cmp %i0,2 + be,a L16 + sethi %hi(-8388608),%i0 + call _bfffo,0 + ld [%o2+8],%o0 + add %i0,-2,%i0 + sll %i0,5,%i0 + sub %i0,%o0,%i0 + add %i0,-1,%i0 +L16: + ret + restore + .align 4 + .global _addsi + .proc 0104 +_addsi: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + orcc %i0,%g0,%l1 + bne,a L18 + ldsb [%i1+4],%l3 + call _icopy,0 + mov %i1,%o0 + b L67 + mov %o0,%i0 +L18: + cmp %l3,0 + bne L19 + cmp %l1,0 + call _stoi,0 + mov %l1,%o0 + b L67 + mov %o0,%i0 +L19: + bge,a L22 + mov 1,%l4 + subcc %g0,%l1,%l1 + bpos L22 + mov -1,%l4 + sethi %hi(_MOST_NEGS),%o0 + or %o0,%lo(_MOST_NEGS),%o0 + call _addii,0 + mov %i1,%o1 + b L67 + mov %o0,%i0 +L22: + ld [%i1+4],%o1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + cmp %l4,%l3 + bne L23 + and %o1,%o0,%l0 + mov %l1,%o1 + sll %l0,2,%l2 + add %l2,%i1,%o0 + ld [%o0-4],%o0 + add %o1,%o0,%o0 + cmp %o0,%o1 + bgeu L24 + mov %o0,%l1 + call _cgeti,0 + add %l0,1,%o0 + mov %o0,%i0 + add %l0,-1,%o2 + cmp %o2,2 + ble L69 + st %l1,[%i0+%l2] +L30: + sll %o2,2,%o1 + add %o1,%i1,%o0 + ld [%o0-4],%o0 + cmp %o0,-1 + bne L69 + cmp %o2,2 + add %o2,-1,%o2 + cmp %o2,2 + bg L30 + st %g0,[%i0+%o1] + cmp %o2,2 +L69: + ble L31 + sll %o2,2,%o1 + add %o1,%i1,%o0 + ld [%o0-4],%o0 + add %o0,1,%o0 + b L68 + st %o0,[%i0+%o1] +L34: + add %o0,%i1,%o1 + ld [%o1-4],%o1 + st %o1,[%i0+%o0] +L68: + add %o2,-1,%o2 + cmp %o2,2 + bg L34 + sll %o2,2,%o0 + ld [%i0],%o0 + add %o0,-1,%o0 + st %o0,[%i0+4] + st %o0,[%i0+8] + add %i0,4,%i0 + sethi %hi(_avma),%o1 + ld [%o1+%lo(_avma)],%o0 + add %o0,4,%o0 + b L37 + st %o0,[%o1+%lo(_avma)] +L31: + mov 1,%o0 + st %o0,[%i0+8] + ld [%i0],%o0 + b L37 + st %o0,[%i0+4] +L24: + call _cgeti,0 + mov %l0,%o0 + mov %o0,%i0 + sll %l0,2,%o0 + add %o0,%i0,%o0 + st %l1,[%o0-4] + mov 1,%o2 + add %l0,-1,%o0 + cmp %o2,%o0 + bge L37 + mov %o0,%o3 +L41: + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + add %o2,1,%o2 + cmp %o2,%o3 + bl L41 + st %o0,[%i0+%o1] +L37: + ld [%i0+4],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l4,24,%o0 + add %o1,%o0,%o1 + b L67 + st %o1,[%i0+4] +L23: + cmp %l0,3 + bne L44 + sll %l0,2,%l2 + ld [%i1+8],%o0 + cmp %o0,%l1 + bleu L45 + nop + call _cgeti,0 + mov 3,%o0 + mov %o0,%i0 + sll %l3,24,%o0 + add %o0,3,%o0 + st %o0,[%i0+4] + ld [%i1+8],%o0 + sub %o0,%l1,%o0 + b L67 + st %o0,[%i0+8] +L45: + bne L46 + sethi %hi(_gzero),%o0 + b L67 + ld [%o0+%lo(_gzero)],%i0 +L46: + call _cgeti,0 + mov 3,%o0 + mov %o0,%i0 + sub %g0,%l3,%o0 + sll %o0,24,%o0 + add %o0,3,%o0 + st %o0,[%i0+4] + ld [%i1+8],%o0 + sub %l1,%o0,%o0 + b L67 + st %o0,[%i0+8] +L44: + add %l2,%i1,%o0 + ld [%o0-4],%o1 + mov %l1,%o0 + cmp %o1,%o0 + bgeu L47 + sub %o1,%o0,%l1 + call _cgeti,0 + mov %l0,%o0 + mov %o0,%i0 + add %l2,%i0,%o0 + st %l1,[%o0-4] + add %l0,-2,%o2 + sll %o2,2,%o0 + mov %o0,%o1 + ld [%i1+%o0],%o0 + cmp %o0,0 + bne,a L70 + sll %o2,2,%o1 + mov -1,%o3 + st %o3,[%i0+%o1] +L71: + add %o2,-1,%o2 + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + cmp %o0,0 + be,a L71 + st %o3,[%i0+%o1] + sll %o2,2,%o1 +L70: + ld [%i1+%o1],%o0 + add %o0,-1,%o0 + cmp %o2,2 + bg L54 + st %o0,[%i0+%o1] + cmp %o0,0 + be,a L53 + ld [%i0],%o0 +L54: + add %o2,-1,%o2 + cmp %o2,0 + ble L67 + nop +L58: + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + add %o2,-1,%o2 + cmp %o2,0 + bg L58 + st %o0,[%i0+%o1] + b,a L67 +L53: + add %o0,-1,%o0 + st %o0,[%i0+4] + st %o0,[%i0+8] + add %i0,4,%i0 + sethi %hi(_avma),%o1 + ld [%o1+%lo(_avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(_avma)] + ld [%i0+4],%o1 + sethi %hi(-16777216),%o0 + andn %o1,%o0,%o0 + sll %l3,24,%o1 + add %o0,%o1,%o0 + b L67 + st %o0,[%i0+4] +L47: + call _cgeti,0 + mov %l0,%o0 + mov %o0,%i0 + sll %l0,2,%o0 + add %o0,%i0,%o0 + st %l1,[%o0-4] + mov 1,%o2 + add %l0,-1,%o0 + cmp %o2,%o0 + bge L67 + mov %o0,%o3 +L65: + sll %o2,2,%o1 + ld [%i1+%o1],%o0 + add %o2,1,%o2 + cmp %o2,%o3 + bl L65 + st %o0,[%i0+%o1] +L67: + ret + restore + .align 4 + .global _addii + .proc 0104 +_addii: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + mov %i0,%l0 + ld [%l0+4],%o0 + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + and %o0,%o1,%l1 + ld [%i1+4],%o0 + and %o0,%o1,%l2 + cmp %l1,%l2 + bge,a L204 + ldsb [%i1+4],%o5 + mov %i1,%l0 + mov %i0,%i1 + mov %l1,%l3 + mov %l2,%l1 + mov %l3,%l2 + ldsb [%i1+4],%o5 +L204: + cmp %o5,0 + bne,a L74 + ldsb [%l0+4],%l3 + call _icopy,0 + mov %l0,%o0 + b L201 + mov %o0,%i0 +L74: + cmp %l3,%o5 + bne L75 + cmp %l1,%l2 + call _cgeti,0 + add %l1,1,%o0 + mov %o0,%i0 + mov 0,%o2 + sll %l1,2,%o0 + add %i0,%o0,%o4 + add %o4,4,%o4 + add %l0,%o0,%o3 + sll %l2,2,%o0 + add %i1,%o0,%o1 + add %l2,-2,%o5 + sethi %hi(L113),%o0 + or %o0,%lo(L113),%g2 + add %o5,-1,%o0 +L220: + cmp %o0,15 + bgu L81 + sll %o0,2,%o0 + ld [%o0+%g2],%o0 + jmp %o0 + nop +L113: + .word L111 + .word L109 + .word L107 + .word L105 + .word L103 + .word L101 + .word L99 + .word L97 + .word L95 + .word L93 + .word L91 + .word L89 + .word L87 + .word L85 + .word L83 + .word L81 +L81: + subcc %g0,%o2,%g0 + b L82 + add %o4,-4,%o4 +L83: + subcc %g0,%o2,%g0 + b L205 + add %o4,-4,%o4 +L85: + subcc %g0,%o2,%g0 + b L206 + add %o4,-4,%o4 +L87: + subcc %g0,%o2,%g0 + b L207 + add %o4,-4,%o4 +L89: + subcc %g0,%o2,%g0 + b L208 + add %o4,-4,%o4 +L91: + subcc %g0,%o2,%g0 + b L209 + add %o4,-4,%o4 +L93: + subcc %g0,%o2,%g0 + b L210 + add %o4,-4,%o4 +L95: + subcc %g0,%o2,%g0 + b L211 + add %o4,-4,%o4 +L97: + subcc %g0,%o2,%g0 + b L212 + add %o4,-4,%o4 +L99: + subcc %g0,%o2,%g0 + b L213 + add %o4,-4,%o4 +L101: + subcc %g0,%o2,%g0 + b L214 + add %o4,-4,%o4 +L103: + subcc %g0,%o2,%g0 + b L215 + add %o4,-4,%o4 +L105: + subcc %g0,%o2,%g0 + b L216 + add %o4,-4,%o4 +L107: + subcc %g0,%o2,%g0 + b L217 + add %o4,-4,%o4 +L109: + subcc %g0,%o2,%g0 + b L218 + add %o4,-4,%o4 +L111: + subcc %g0,%o2,%g0 + b L219 + add %o4,-4,%o4 +L82: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L205: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L206: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L207: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L208: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L209: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L210: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L211: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L212: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L213: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L214: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L215: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L216: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L217: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L218: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L219: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + addxcc %l4,%g3,%o0 + st %o0,[%o4] + addx %g0,%g0,%o2 + add %o5,-16,%o5 + cmp %o5,0 + bg,a L220 + add %o5,-1,%o0 + cmp %o2,0 + be L115 + add %l0,8,%o2 +L116: + add %o3,-4,%o3 + cmp %o3,%o2 + blu L117 + mov %o3,%o1 + ld [%o3],%o0 + cmp %o0,-1 + bne L118 + add %o4,-4,%o4 + b L116 + st %g0,[%o4] +L118: + ld [%o1],%o0 + b L203 + add %o0,1,%o0 +L122: + add %o4,-4,%o4 + ld [%o1],%o0 +L203: + st %o0,[%o4] + add %o3,-4,%o3 + cmp %o3,%o2 + bgeu L122 + mov %o3,%o1 + b L221 + ld [%i0],%o0 +L117: + mov 1,%o0 + st %o0,[%i0+8] + ld [%l0+4],%o0 + add %o0,1,%o0 + b L201 + st %o0,[%i0+4] +L115: + subcc %l1,%l2,%o2 + be,a L221 + ld [%i0],%o0 +L128: + add %o4,-4,%o4 + add %o3,-4,%o3 + ld [%o3],%o0 + addcc %o2,-1,%o2 + bne L128 + st %o0,[%o4] + ld [%i0],%o0 +L221: + add %o0,-1,%o0 + st %o0,[%i0+4] + ld [%l0+4],%o0 + st %o0,[%i0+8] + add %i0,4,%i0 + sethi %hi(_avma),%o1 + ld [%o1+%lo(_avma)],%o0 + add %o0,4,%o0 + b L201 + st %o0,[%o1+%lo(_avma)] +L75: + bne L131 + add %l0,8,%o3 + addcc %l1,-2,%o2 + be L140 + add %i1,8,%o1 + ld [%o3],%o4 +L222: + add %o3,4,%o3 + ld [%o1],%o0 + cmp %o0,%o4 + bgu L202 + add %o1,4,%o1 + cmp %o4,%o0 + bgu L131 + addcc %o2,-1,%o2 + bne,a L222 + ld [%o3],%o4 +L140: + sethi %hi(_gzero),%o0 + b L201 + ld [%o0+%lo(_gzero)],%i0 +L202: + mov %l0,%i0 + mov %i1,%l0 + mov %i0,%i1 + mov %o5,%l3 +L131: + call _cgeti,0 + mov %l1,%o0 + mov %o0,%i0 + mov 0,%o2 + sll %l1,2,%o0 + add %l0,%o0,%o3 + sll %l2,2,%o1 + add %i1,%o1,%o1 + add %i0,%o0,%o4 + add %l2,-2,%o5 + sethi %hi(L178),%o0 + or %o0,%lo(L178),%g2 + add %o5,-1,%o0 +L238: + cmp %o0,15 + bgu L146 + sll %o0,2,%o0 + ld [%o0+%g2],%o0 + jmp %o0 + nop +L178: + .word L176 + .word L174 + .word L172 + .word L170 + .word L168 + .word L166 + .word L164 + .word L162 + .word L160 + .word L158 + .word L156 + .word L154 + .word L152 + .word L150 + .word L148 + .word L146 +L146: + subcc %g0,%o2,%g0 + b L147 + add %o4,-4,%o4 +L148: + subcc %g0,%o2,%g0 + b L223 + add %o4,-4,%o4 +L150: + subcc %g0,%o2,%g0 + b L224 + add %o4,-4,%o4 +L152: + subcc %g0,%o2,%g0 + b L225 + add %o4,-4,%o4 +L154: + subcc %g0,%o2,%g0 + b L226 + add %o4,-4,%o4 +L156: + subcc %g0,%o2,%g0 + b L227 + add %o4,-4,%o4 +L158: + subcc %g0,%o2,%g0 + b L228 + add %o4,-4,%o4 +L160: + subcc %g0,%o2,%g0 + b L229 + add %o4,-4,%o4 +L162: + subcc %g0,%o2,%g0 + b L230 + add %o4,-4,%o4 +L164: + subcc %g0,%o2,%g0 + b L231 + add %o4,-4,%o4 +L166: + subcc %g0,%o2,%g0 + b L232 + add %o4,-4,%o4 +L168: + subcc %g0,%o2,%g0 + b L233 + add %o4,-4,%o4 +L170: + subcc %g0,%o2,%g0 + b L234 + add %o4,-4,%o4 +L172: + subcc %g0,%o2,%g0 + b L235 + add %o4,-4,%o4 +L174: + subcc %g0,%o2,%g0 + b L236 + add %o4,-4,%o4 +L176: + subcc %g0,%o2,%g0 + b L237 + add %o4,-4,%o4 +L147: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L223: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L224: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L225: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L226: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L227: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L228: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L229: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L230: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L231: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L232: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L233: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L234: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L235: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L236: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + add %o4,-4,%o4 +L237: + add %o3,-4,%o3 + add %o1,-4,%o1 + ld [%o3],%l4 + ld [%o1],%g3 + subxcc %l4,%g3,%o0 + st %o0,[%o4] + addx %g0,%g0,%o2 + add %o5,-16,%o5 + cmp %o5,0 + bg,a L238 + add %o5,-1,%o0 + cmp %o2,0 + be,a L180 + subcc %l1,%l2,%o5 + add %o3,-4,%o3 + ld [%o3],%o0 + cmp %o0,0 + bne L239 + add %l0,8,%o1 + mov -1,%o1 + add %o4,-4,%o4 +L240: + st %o1,[%o4] + add %o3,-4,%o3 + ld [%o3],%o0 + cmp %o0,0 + be,a L240 + add %o4,-4,%o4 + add %l0,8,%o1 +L239: + cmp %o3,%o1 + blu L190 + add %o0,-1,%o0 + add %o4,-4,%o4 + st %o0,[%o4] + add %o3,-4,%o3 + cmp %o3,%o1 + blu L190 + mov %o3,%o0 +L188: + add %o4,-4,%o4 + ld [%o0],%o0 + st %o0,[%o4] + add %o3,-4,%o3 + cmp %o3,%o1 + bgeu L188 + mov %o3,%o0 + b L241 + ld [%i0+8],%o0 +L180: + be,a L241 + ld [%i0+8],%o0 +L193: + add %o4,-4,%o4 + add %o3,-4,%o3 + ld [%o3],%o0 + addcc %o5,-1,%o5 + bne L193 + st %o0,[%o4] +L190: + ld [%i0+8],%o0 +L241: + cmp %o0,0 + be,a L195 + ld [%i0+12],%o0 + ld [%l0+4],%o0 + b L201 + st %o0,[%i0+4] +L195: + cmp %o0,0 + bne L198 + add %i0,12,%o4 + add %o4,4,%o4 +L242: + ld [%o4],%o0 + cmp %o0,0 + be,a L242 + add %o4,4,%o4 +L198: + add %o4,-8,%o4 + sub %o4,%i0,%o5 + sra %o5,2,%o5 + ld [%i0],%o1 + sub %o1,%o5,%o1 + st %o1,[%o4] + st %o1,[%o4+4] + mov %o4,%i0 + sethi %hi(-16777216),%o0 + andn %o1,%o0,%o0 + sll %l3,24,%o1 + add %o0,%o1,%o0 + st %o0,[%i0+4] + sethi %hi(_avma),%o2 + sll %o5,2,%o0 + ld [%o2+%lo(_avma)],%o1 + add %o0,%o1,%o0 + st %o0,[%o2+%lo(_avma)] +L201: + ret + restore + .align 4 + .global _mulss + .proc 0104 +_mulss: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + orcc %i0,%g0,%o0 + be L245 + cmp %i1,0 + bne L244 + cmp %o0,0 +L245: + sethi %hi(_gzero),%o0 + b L253 + ld [%o0+%lo(_gzero)],%i0 +L244: + bge L246 + mov 1,%l0 + subcc %g0,%o0,%o0 + bpos L246 + mov -1,%l0 + call _stoi,0 + nop + mov %o0,%o1 + b L254 + mov %i1,%o0 +L246: + cmp %i1,0 + bge L255 + mov %o0,%l1 + subcc %g0,%i1,%i1 + bpos L255 + sub %g0,%l0,%l0 + cmp %l0,0 + bg L250 + mov %o0,%o1 + sub %g0,%o0,%o1 +L250: + mov %o1,%o0 + sethi %hi(_ABS_MOST_NEGS),%o1 + or %o1,%lo(_ABS_MOST_NEGS),%o1 +L254: + call _mulsi,0 + nop + b L253 + mov %o0,%i0 +L255: + + or %l1,%i1,%o4 + mov %l1,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + tst %i1 + bl,a 1f + add %o4,%l1,%o4 +1: mov %o4,%o2 + b 3f + rd %y,%l1 +2: clr %o2 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%l1 +3: + + orcc %o2,%g0,%i1 + be L251 + nop + call _cgeti,0 + mov 4,%o0 + mov %o0,%i0 + st %i1,[%i0+8] + b L252 + st %l1,[%i0+12] +L251: + call _cgeti,0 + mov 3,%o0 + mov %o0,%i0 + st %l1,[%i0+8] +L252: + ld [%i0],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l0,24,%o0 + add %o1,%o0,%o1 + st %o1,[%i0+4] +L253: + ret + restore + .align 4 + .global _mulii + .proc 0104 +_mulii: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + mov %i0,%l4 + ld [%l4+4],%o0 + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + and %o0,%o1,%l0 + ld [%i1+4],%o2 + sra %o0,24,%l2 + cmp %l2,0 + be L276 + and %o2,%o1,%l3 + ldsb [%i1+4],%o0 + cmp %o0,0 + bne L258 + nop +L276: + sethi %hi(_gzero),%o0 + b L275 + ld [%o0+%lo(_gzero)],%i0 +L258: + bl,a L259 + sub %g0,%l2,%l2 +L259: + cmp %l0,%l3 + ble L260 + sethi %hi(65535),%o0 + mov %l4,%i0 + mov %i1,%l4 + mov %i0,%i1 + mov %l0,%l1 + mov %l3,%l0 + mov %l1,%l3 +L260: + add %l0,%l3,%l1 + add %l1,-2,%l1 + or %o0,%lo(65535),%o0 + cmp %l1,%o0 + ble L261 + nop + call _err,0 + mov 17,%o0 +L261: + call _cgeti,0 + mov %l1,%o0 + mov %o0,%i0 + ld [%i0],%o1 + sethi %hi(-16777216),%o0 + andn %o1,%o0,%o0 + sll %l2,24,%o1 + add %o0,%o1,%o0 + st %o0,[%i0+4] + sll %l0,2,%o0 + add %l4,%o0,%l2 + add %l2,-4,%l2 + ld [%l2],%o2 + mov 0,%o3 + sll %l3,2,%o0 + add %i1,%o0,%o7 + sll %l1,2,%o0 + addcc %l3,-2,%g2 + be L263 + add %i0,%o0,%g4 +L264: + add %g4,-4,%g4 + mov %o3,%o0 + add %o7,-4,%o7 + ld [%o7],%o1 + mov %o2,%l5 + + or %l5,%o1,%o4 + mov %l5,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%g0,%o4 + tst %o1 + bl,a 1f + add %o4,%l5,%o4 +1: mov %o4,%o3 + b 3f + rd %y,%l5 +2: clr %o3 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%o1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%l5 +3: + + mov %l5,%o1 + addcc %o0,%o1,%l5 + addx %o3,%g0,%o3 + addcc %g2,-1,%g2 + bne L264 + st %l5,[%g4] +L263: + st %o3,[%g4-4] + sll %l1,2,%o0 + add %i0,%o0,%g4 + sll %l3,2,%o0 + add %i1,%o0,%i1 + add %l0,-3,%l0 + cmp %l0,0 + ble L267 + add %l3,-1,%l3 +L268: + add %l2,-4,%l2 + ld [%l2],%g1 + mov %i1,%o7 + add %g4,-4,%o2 + mov %o2,%g4 + addcc %l3,-1,%g2 + be L270 + mov 0,%g3 +L271: + add %o7,-4,%o7 + ld [%o7],%o0 + mov %o0,%o1 + + or %o1,%g1,%o4 + mov %o1,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g0,%o4 + tst %g1 + bl,a 1f + add %o4,%o1,%o4 +1: mov %o4,%o3 + b 3f + rd %y,%o1 +2: clr %o3 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o1 +3: + + add %o2,-4,%o2 + ld [%o2],%o0 + addcc %o1,%o0,%o0 + addx %o3,%g0,%o3 + addcc %o0,%g3,%l5 + addx %o3,%g0,%o3 + st %l5,[%o2] + addcc %g2,-1,%g2 + bne L271 + mov %o3,%g3 +L270: + add %l0,-1,%l0 + cmp %l0,0 + bg L268 + st %o3,[%o2-4] +L267: + ld [%i0+8],%o0 + cmp %o0,0 + bne L275 + sethi %hi(_avma),%o1 + ld [%i0+4],%o0 + add %o0,-1,%o0 + st %o0,[%i0+8] + ld [%i0],%o0 + add %o0,-1,%o0 + st %o0,[%i0+4] + add %i0,4,%i0 + ld [%o1+%lo(_avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(_avma)] +L275: + ret + restore +.data + .align 8 +LC0: + .word 0x3fd34413 + .word 0x55475a32 + .align 8 +LC1: + .word 0x3ff00000 + .word 0x0 +.text + .align 4 + .global _confrac + .proc 0104 +_confrac: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + ld [%i0],%o1 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + and %o1,%o0,%l2 + ld [%i0+4],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sethi %hi(8388607),%o0 + or %o0,%lo(8388607),%o0 + sub %o0,%o1,%l0 + sethi %hi(_avma),%o0 + ld [%o0+%lo(_avma)],%l5 + add %l2,-2,%l4 + sll %l4,5,%l4 + add %l4,%l0,%l4 + add %l4,63,%l3 + sra %l3,5,%l3 + call _cgeti,0 + mov %l3,%o0 + sra %l0,5,%o1 + mov 0,%g2 + cmp %g2,%o1 + bge L279 + mov %o0,%l1 +L281: + sll %g2,2,%o0 + add %g2,1,%g2 + cmp %g2,%o1 + bl L281 + st %g0,[%l1+%o0] +L279: + andcc %l0,31,%l0 + bne L283 + mov 2,%g3 + cmp %g3,%l2 + bge L305 + sll %l3,2,%o0 +L287: + sll %g2,2,%o0 + sll %g3,2,%o1 + ld [%i0+%o1],%o1 + st %o1,[%l1+%o0] + add %g3,1,%g3 + cmp %g3,%l2 + bl L287 + add %g2,1,%g2 + b L305 + sll %l3,2,%o0 +L283: + cmp %g3,%l2 + bge L291 + mov 0,%o3 + mov 32,%o0 + sub %o0,%l0,%o4 +L293: + sll %g2,2,%o1 + sll %g3,2,%o0 + ld [%i0+%o0],%o2 + add %g2,1,%g2 + srl %o2,%l0,%o0 + add %o0,%o3,%o0 + st %o0,[%l1+%o1] + add %g3,1,%g3 + cmp %g3,%l2 + bl L293 + sll %o2,%o4,%o3 +L291: + sll %l3,2,%o0 + add %o0,%l1,%o0 + st %o3,[%o0-8] + sll %l3,2,%o0 +L305: + add %o0,%l1,%o0 + st %g0,[%o0-4] + st %l4,[%fp-12] + ld [%fp-12],%f6 + fitod %f6,%f2 + sethi %hi(LC0),%l6 + ldd [%l6+%lo(LC0)],%f4 + fmuld %f2,%f4,%f2 + sethi %hi(LC1),%l6 + ldd [%l6+%lo(LC1)],%f4 + faddd %f2,%f4,%f2 + fdtoi %f2,%f2 + st %f2,[%fp-12] + ld [%fp-12],%l0 + add %l0,17,%l2 + mov %l2,%o0 + call .div,0 + mov 9,%o1 + call _cgeti,0 + mov %o0,%l2 + mov %o0,%i0 + mov 1,%g3 + cmp %g3,%l2 + bge L296 + st %l0,[%i0] +L298: + addcc %l3,-1,%g2 + bneg L300 + mov 0,%o3 + sethi %hi(1000000000),%o0 + or %o0,%lo(1000000000),%o7 +L302: + sll %g2,2,%o1 + mov %o3,%o2 + ld [%l1+%o1],%o0 + + or %o0,%o7,%o4 + mov %o0,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%g0,%o4 + tst %o7 + bl,a 1f + add %o4,%o0,%o4 +1: mov %o4,%o3 + b 3f + rd %y,%o0 +2: clr %o3 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%o7,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o0 +3: + + addcc %o2,%o0,%l6 + addx %o3,%g0,%o3 + addcc %g2,-1,%g2 + bpos L302 + st %l6,[%l1+%o1] +L300: + sll %g3,2,%o0 + add %g3,1,%g3 + cmp %g3,%l2 + bl L298 + st %o3,[%i0+%o0] +L296: + sethi %hi(_avma),%o0 + st %l5,[%o0+%lo(_avma)] + ret + restore + .align 4 + .global _divss + .proc 0104 +_divss: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + cmp %i1,0 + bne L315 + sethi %hi(-2147483648),%o0 + call _err,0 + mov 23,%o0 + sethi %hi(-2147483648),%o0 +L315: + cmp %i0,%o0 + bne L308 + sethi %hi(_hiremainder),%o0 + call _stoi,0 + mov %i0,%o0 + call _divis,0 + mov %i1,%o1 + b L316 + mov %o0,%i0 +L308: + st %g0,[%o0+%lo(_hiremainder)] + cmp %i0,0 + bge L309 + mov %i0,%o0 + sub %g0,%i0,%o0 +L309: + cmp %i1,0 + bge L310 + mov %i1,%o1 + sub %g0,%i1,%o1 +L310: + sethi %hi(_hiremainder),%l0 + call _divul3,0 + or %l0,%lo(_hiremainder),%o2 + cmp %i1,0 + bge L311 + mov %o0,%o1 + ld [%l0+%lo(_hiremainder)],%o0 + sub %g0,%o0,%o0 + st %o0,[%l0+%lo(_hiremainder)] + sub %g0,%o1,%o1 +L311: + cmp %i0,0 + bl,a L312 + sub %g0,%o1,%o1 +L312: + call _stoi,0 + mov %o1,%o0 + mov %o0,%i0 +L316: + ret + restore + .align 4 + .global _modss + .proc 0104 +_modss: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + cmp %i1,0 + bne L327 + sethi %hi(-2147483648),%o0 + call _err,0 + mov 38,%o0 + sethi %hi(-2147483648),%o0 +L327: + cmp %i0,%o0 + bne L319 + mov %i0,%o0 + call _stoi,0 + mov %i0,%o0 + call _modis,0 + mov %i1,%o1 + b L325 + mov %o0,%i0 +L319: + cmp %o0,0 + bge L320 + st %g0,[%fp-12] + sub %g0,%o0,%o0 +L320: + cmp %i1,0 + bl,a L321 + sub %g0,%i1,%i1 +L321: + mov %i1,%o1 + call _divul3,0 + add %fp,-12,%o2 + ld [%fp-12],%o0 + cmp %o0,0 + bne L322 + nop + sethi %hi(_gzero),%o0 + b L325 + ld [%o0+%lo(_gzero)],%i0 +L322: + bge,a L326 + ld [%fp-12],%o0 + sub %i1,%o0,%o0 +L326: + call _stoi,0 + nop + mov %o0,%i0 +L325: + ret + restore + .align 4 + .global _resss + .proc 0104 +_resss: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + cmp %i1,0 + bne L335 + mov %i0,%o0 + call _err,0 + mov 40,%o0 + mov %i0,%o0 +L335: + cmp %o0,0 + bge L330 + st %g0,[%fp-12] + sub %g0,%o0,%o0 +L330: + cmp %i1,0 + bge L331 + mov %i1,%o1 + sub %g0,%i1,%o1 +L331: + call _divul3,0 + add %fp,-12,%o2 + cmp %i1,0 + bge L334 + ld [%fp-12],%o0 + sub %g0,%o0,%o0 +L334: + call _stoi,0 + nop + mov %o0,%i0 + ret + restore + .align 4 + .global _divsi + .proc 0104 +_divsi: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + ld [%i1+4],%o0 + sra %o0,24,%o2 + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + cmp %o2,0 + bne L337 + and %o0,%o1,%l0 + call _err,0 + mov 24,%o0 +L337: + cmp %i0,0 + be L339 + cmp %l0,3 + bg L346 + sethi %hi(_hiremainder),%o0 + ld [%i1+8],%o0 + cmp %o0,0 + bge L338 + sethi %hi(-2147483648),%o0 +L339: + sethi %hi(_hiremainder),%o0 +L346: + st %i0,[%o0+%lo(_hiremainder)] + sethi %hi(_gzero),%o0 + b L344 + ld [%o0+%lo(_gzero)],%i0 +L338: + cmp %i0,%o0 + bne L340 + sethi %hi(_hiremainder),%o0 + call _stoi,0 + mov %i0,%o0 + mov %i1,%o1 + call _dvmdii,0 + mov 0,%o2 + b L344 + mov %o0,%i0 +L340: + st %g0,[%o0+%lo(_hiremainder)] + cmp %i0,0 + bge L341 + mov %i0,%o0 + sub %g0,%i0,%o0 +L341: + ld [%i1+8],%o1 + sethi %hi(_hiremainder),%l0 + call _divul3,0 + or %l0,%lo(_hiremainder),%o2 + mov %o0,%o1 + ldsb [%i1+4],%o0 + cmp %o0,0 + bge L347 + cmp %i0,0 + ld [%l0+%lo(_hiremainder)],%o0 + sub %g0,%o0,%o0 + st %o0,[%l0+%lo(_hiremainder)] + sub %g0,%o1,%o1 +L347: + bl,a L343 + sub %g0,%o1,%o1 +L343: + call _stoi,0 + mov %o1,%o0 + mov %o0,%i0 +L344: + ret + restore + .align 4 + .global _divis + .proc 0104 +_divis: + !#PROLOGUE# 0 + save %sp,-112,%sp + !#PROLOGUE# 1 + ld [%i0+4],%o1 + sra %o1,24,%l4 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + cmp %i1,0 + bne L349 + and %o1,%o0,%l3 + call _err,0 + mov 26,%o0 +L349: + cmp %l4,0 + bne L350 + cmp %i1,0 + sethi %hi(_hiremainder),%o0 + b L365 + st %g0,[%o0+%lo(_hiremainder)] +L350: + bge,a L366 + ld [%i0+8],%o0 + subcc %g0,%i1,%i1 + bpos L351 + sub %g0,%l4,%l4 + call _stoi,0 + mov %i1,%o0 + mov %o0,%o1 + mov %i0,%o0 + call _dvmdii,0 + mov 0,%o2 + b L364 + mov %o0,%i0 +L351: + ld [%i0+8],%o0 +L366: + cmp %i1,%o0 + bleu L353 + cmp %l3,3 + bne L354 + sethi %hi(_hiremainder),%l0 + call _itos,0 + mov %i0,%o0 + st %o0,[%l0+%lo(_hiremainder)] +L365: + sethi %hi(_gzero),%o0 + b L364 + ld [%o0+%lo(_gzero)],%i0 +L354: + call _cgeti,0 + add %l3,-1,%o0 + mov %o0,%l2 + mov 1,%l1 + ld [%i0+8],%o0 + b L356 + st %o0,[%fp-12] +L353: + call _cgeti,0 + mov %l3,%o0 + mov %o0,%l2 + mov 0,%l1 + st %g0,[%fp-12] +L356: + add %l1,2,%l0 + cmp %l0,%l3 + bge,a L367 + ld [%l2],%o0 +L360: + sll %l0,2,%o0 + ld [%i0+%o0],%o0 + mov %i1,%o1 + call _divul3,0 + add %fp,-12,%o2 + sub %l0,%l1,%o1 + sll %o1,2,%o1 + add %l0,1,%l0 + cmp %l0,%l3 + bl L360 + st %o0,[%l2+%o1] + ld [%l2],%o0 +L367: + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + sll %l4,24,%o0 + add %o1,%o0,%o1 + st %o1,[%l2+4] + sethi %hi(_hiremainder),%o1 + cmp %l4,0 + bge L362 + or %o1,%lo(_hiremainder),%o2 + ld [%fp-12],%o0 + sub %g0,%o0,%o0 + b L363 + st %o0,[%o1+%lo(_hiremainder)] +L362: + ld [%fp-12],%o0 + st %o0,[%o2] +L363: + mov %l2,%i0 +L364: + ret + restore + .align 4 + .global _dvmdii + .proc 0104 +_dvmdii: + !#PROLOGUE# 0 + save %sp,-144,%sp + !#PROLOGUE# 1 + mov %i2,%i4 + ldsb [%i0+4],%g4 + st %g4,[%fp-28] + ldsb [%i1+4],%g1 + cmp %g1,0 + bne L369 + st %g1,[%fp-36] + call _err,0 + mov 36,%o0 +L369: + ld [%fp-28],%g4 + cmp %g4,0 + bne,a L370 + ld [%i0+4],%o0 + cmp %i4,-1 + be L471 + cmp %i4,0 + be L471 + sethi %hi(_gzero),%o1 + ld [%o1+%lo(_gzero)],%o0 + st %o0,[%i4] + b L470 + ld [%o1+%lo(_gzero)],%i0 +L370: + sethi %hi(65535),%o1 + or %o1,%lo(65535),%o1 + and %o0,%o1,%l6 + ld [%i1+4],%o0 + and %o0,%o1,%i3 + subcc %l6,%i3,%i5 + bpos,a L373 + sethi %hi(_avma),%o0 + cmp %i4,-1 + bne L374 + cmp %i4,0 + call _icopy,0 + mov %i0,%o0 + b L470 + mov %o0,%i0 +L374: + be L477 + sethi %hi(_gzero),%o0 + call _icopy,0 + mov %i0,%o0 + b L471 + st %o0,[%i4] +L373: + ld [%o0+%lo(_avma)],%o0 + st %o0,[%fp-20] + ld [%fp-28],%g1 + cmp %g1,0 + bge L478 + cmp %i3,3 + ld [%fp-36],%g4 + sub %g0,%g4,%g4 + st %g4,[%fp-36] +L478: + bne L377 + nop + ld [%i1+8],%i1 + ld [%i0+8],%o0 + cmp %i1,%o0 + bleu L378 + add %i0,8,%l1 + add %l6,-1,%l0 + st %o0,[%fp-12] + b L379 + add %i0,12,%l1 +L378: + mov %l6,%l0 + st %g0,[%fp-12] +L379: + call _cgeti,0 + mov %l0,%o0 + mov %o0,%l5 + addcc %l0,-2,%l3 + be L381 + add %l5,8,%l2 +L382: + ld [%l1],%o0 + add %l1,4,%l1 + mov %i1,%o1 + call _divul3,0 + add %fp,-12,%o2 + st %o0,[%l2] + addcc %l3,-1,%l3 + bne L382 + add %l2,4,%l2 +L381: + cmp %i4,-1 + bne L384 + cmp %l0,2 + sethi %hi(_avma),%o0 + ld [%fp-20],%g1 + st %g1,[%o0+%lo(_avma)] + ld [%fp-12],%o0 + cmp %o0,0 + bne L385 + nop +L471: + sethi %hi(_gzero),%o0 +L477: + b L470 + ld [%o0+%lo(_gzero)],%i0 +L385: + call _cgeti,0 + mov 3,%o0 + mov %o0,%l4 + ld [%fp-28],%g4 + sll %g4,24,%o0 + add %o0,3,%o0 + st %o0,[%l4+4] + ld [%fp-12],%o0 + st %o0,[%l4+8] + b L470 + mov %l4,%i0 +L384: + be L386 + sethi %hi(-16777216),%o1 + ld [%l5],%o0 + andn %o0,%o1,%o1 + ld [%fp-36],%g1 + sll %g1,24,%o0 + add %o1,%o0,%o1 + b L387 + st %o1,[%l5+4] +L386: + sethi %hi(_avma),%o0 + ld [%fp-20],%g4 + st %g4,[%o0+%lo(_avma)] + sethi %hi(_gzero),%o0 + ld [%o0+%lo(_gzero)],%l5 +L387: + cmp %i4,0 + bne L388 + ld [%fp-12],%o0 +L473: + b L470 + mov %l5,%i0 +L388: + cmp %o0,0 + bne L389 + sethi %hi(_gzero),%o0 + ld [%o0+%lo(_gzero)],%o0 + b L473 + st %o0,[%i4] +L389: + call _cgeti,0 + mov 3,%o0 + mov %o0,%l4 + ld [%fp-28],%g1 + sll %g1,24,%o0 + add %o0,3,%o0 + st %o0,[%l4+4] + ld [%fp-12],%o0 + st %o0,[%l4+8] + b L473 + st %l4,[%i4] +L377: + call _cgeti,0 + mov %l6,%o0 + mov %o0,%l5 + call _bfffo,0 + ld [%i1+8],%o0 + orcc %o0,%g0,%i2 + be L392 + add %i0,8,%l1 + call _cgeti,0 + mov %i3,%o0 + mov %o0,%l4 + ld [%i1+8],%o3 + add %i1,12,%o1 + mov 32,%o0 + sub %o0,%i2,%o0 + srl %o3,%o0,%o0 + st %o0,[%fp-12] + sll %o3,%i2,%g2 + addcc %i3,-3,%l3 + be L394 + add %l4,8,%o2 + mov 32,%o0 + sub %o0,%i2,%o4 +L395: + ld [%o1],%o3 + add %o1,4,%o1 + srl %o3,%o4,%o0 + st %o0,[%fp-12] + add %g2,%o0,%o0 + st %o0,[%o2] + add %o2,4,%o2 + addcc %l3,-1,%l3 + bne L395 + sll %o3,%i2,%g2 +L394: + st %g2,[%o2] + mov 0,%g2 + add %i0,8,%l1 + addcc %l6,-2,%l3 + be L398 + add %l5,4,%l2 + mov 32,%o0 + sub %o0,%i2,%o1 +L399: + ld [%l1],%o3 + add %l1,4,%l1 + srl %o3,%o1,%o0 + st %o0,[%fp-12] + add %g2,%o0,%o0 + st %o0,[%l2] + add %l2,4,%l2 + addcc %l3,-1,%l3 + bne L399 + sll %o3,%i2,%g2 +L398: + b L401 + st %g2,[%l2] +L392: + st %g0,[%l5+4] + addcc %l6,-2,%l0 + be L403 + add %l5,8,%l2 +L404: + ld [%l1],%o0 + st %o0,[%l2] + add %l1,4,%l1 + addcc %l0,-1,%l0 + bne L404 + add %l2,4,%l2 +L403: + mov %i1,%l4 +L401: + ld [%l4+8],%i1 + ld [%l4+12],%i0 + addcc %i5,1,%l3 + be L407 + add %l5,4,%l2 + sll %i3,2,%l1 +L408: + ld [%l2],%o0 + cmp %o0,%i1 + bne L409 + add %l2,4,%l2 + mov -1,%o7 + mov %i1,%o3 + ld [%l2],%o0 + add %o3,%o0,%o1 + cmp %o1,%o3 + addx %g0,0,%o2 + b L410 + mov %o1,%g2 +L409: + ld [%l2-4],%o0 + st %o0,[%fp-12] + ld [%l2],%o0 + mov %i1,%o1 + call _divul3,0 + add %fp,-12,%o2 + mov %o0,%o7 + mov 0,%o2 + ld [%fp-12],%g2 +L410: + cmp %o2,0 + bne,a L479 + st %g0,[%fp-12] + mov %o7,%o3 + + or %o3,%i0,%o4 + mov %o3,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%g0,%o4 + tst %i0 + bl,a 1f + add %o4,%o3,%o4 +1: mov %o4,%g4 + b 3f + rd %y,%o3 +2: clr %g4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%i0,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o3 +3: + + st %g4,[%fp-12] + ld [%l2+4],%o0 + cmp %o3,%o0 + addx %g0,0,%o2 + sub %o3,%o0,%o4 + ld [%fp-12],%o3 + mov %g2,%o0 + sub %o3,%g2,%o1 + cmp %g2,%o3 + bgu L476 + sub %o1,%o2,%o1 + b L480 + cmp %o0,%o3 +L424: + be L411 + mov %o4,%o3 + add %o7,-1,%o7 + mov %i0,%o0 + cmp %o3,%o0 + addx %g0,0,%o2 + sub %o3,%o0,%o4 + mov %o1,%o3 + mov %i1,%o0 + sub %o3,%o0,%o1 + cmp %o0,%o3 + bleu L480 + sub %o1,%o2,%o1 +L476: + b L421 + mov 1,%o2 +L480: + blu,a L421 + mov 0,%o2 +L421: + cmp %o2,0 + be L424 + cmp %o1,0 +L411: + st %g0,[%fp-12] +L479: + add %l2,%l1,%g2 + add %g2,-8,%g2 + addcc %i3,-2,%l0 + be L426 + add %l4,%l1,%g3 +L427: + ld [%fp-12],%o3 + add %g3,-4,%g3 + ld [%g3],%o0 + mov %o7,%o1 + + or %o1,%o0,%o4 + mov %o1,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%g0,%o4 + tst %o0 + bl,a 1f + add %o4,%o1,%o4 +1: mov %o4,%g1 + b 3f + rd %y,%o1 +2: clr %g1 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%o0,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%o1 +3: + + st %g1,[%fp-12] + mov %g1,%g4 + addcc %o3,%o1,%o2 + addx %g4,%g0,%g4 + st %g4,[%fp-12] + add %g2,-4,%g2 + ld [%g2],%o3 + sub %o3,%o2,%o1 + cmp %o3,%o2 + st %o1,[%g2] + ld [%fp-12],%o0 + addx %g0,%o0,%o0 + addcc %l0,-1,%l0 + bne L427 + st %o0,[%fp-12] +L426: + ld [%l2-4],%o1 + ld [%fp-12],%o0 + cmp %o1,%o0 + bgeu,a L481 + addcc %l3,-1,%l3 + mov 0,%o2 + add %o7,-1,%o7 + add %l2,%l1,%g2 + add %g2,-8,%g2 + addcc %i3,-2,%l0 + be L429 + add %l4,%l1,%g3 + add %g2,-4,%g2 +L482: + subcc %g0,%o2,%g0 + add %g3,-4,%g3 + ld [%g2],%g1 + ld [%g3],%g4 + addxcc %g1,%g4,%o0 + st %o0,[%g2] + addx %g0,%g0,%o2 + addcc %l0,-1,%l0 + bne,a L482 + add %g2,-4,%g2 +L429: + addcc %l3,-1,%l3 +L481: + bne L408 + st %o7,[%l2-4] +L407: + sethi %hi(_avma),%o0 + cmp %i4,-1 + be L435 + ld [%o0+%lo(_avma)],%l4 + add %i5,2,%l1 + sll %l1,2,%o0 + add %l5,%o0,%l2 + ld [%l5+4],%o0 + cmp %o0,0 + be L436 + cmp %i5,0 + b L437 + add %i5,3,%l1 +L436: + be,a L437 + st %g0,[%fp-36] +L437: + call _cgeti,0 + mov %l1,%o0 + st %o0,[%fp-44] + sll %l1,2,%o0 + ld [%fp-44],%g1 + addcc %l1,-2,%l0 + be L440 + add %g1,%o0,%o1 +L441: + add %o1,-4,%o1 + add %l2,-4,%l2 + ld [%l2],%o0 + addcc %l0,-1,%l0 + bne L441 + st %o0,[%o1] +L440: + cmp %l1,2 + bgu L443 + mov 2,%o0 + ld [%fp-44],%g4 + b L435 + st %o0,[%g4+4] +L443: + ld [%fp-44],%g1 + ld [%g1],%o0 + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + ld [%fp-36],%g4 + sll %g4,24,%o0 + add %o1,%o0,%o1 + st %o1,[%g1+4] +L435: + cmp %i4,0 + be L483 + cmp %i4,-1 + add %i5,2,%l0 + cmp %l0,%l6 + bge L484 + sll %l0,2,%o0 + ld [%l5+%o0],%o0 + cmp %o0,0 + bne L484 + cmp %l0,%l6 + add %i5,3,%l0 +L448: + cmp %l0,%l6 + bge L484 + sll %l0,2,%o0 + ld [%l5+%o0],%o0 + cmp %o0,0 + be,a L448 + add %l0,1,%l0 + cmp %l0,%l6 +L484: + bne L452 + sub %l6,%l0,%o0 + sethi %hi(_gzero),%o0 + call _icopy,0 + ld [%o0+%lo(_gzero)],%o0 + b L445 + mov %o0,%l7 +L452: + call _cgeti,0 + add %o0,2,%o0 + mov %o0,%l7 + ld [%l7],%o0 + cmp %i2,0 + bne L454 + st %o0,[%l7+4] + cmp %l0,%l6 + bge L460 + mov 2,%l3 +L458: + sll %l3,2,%o0 + sll %l0,2,%o1 + ld [%l5+%o1],%o1 + st %o1,[%l7+%o0] + add %l0,1,%l0 + cmp %l0,%l6 + bl L458 + add %l3,1,%l3 + b L485 + ld [%l7+4],%o0 +L454: + st %g0,[%fp-12] + sll %l0,2,%o0 + ld [%l5+%o0],%o3 + add %l0,1,%l0 + mov 32,%o0 + sub %o0,%i2,%o0 + sll %o3,%o0,%o0 + st %o0,[%fp-12] + srl %o3,%i2,%o2 + cmp %o2,0 + be L461 + mov %o0,%g2 + st %o2,[%l7+8] + b L462 + mov 1,%o0 +L461: + ld [%l7],%o0 + add %o0,-1,%o0 + st %o0,[%l7+4] + add %l7,4,%l7 + sethi %hi(_avma),%o1 + ld [%o1+%lo(_avma)],%o0 + add %o0,4,%o0 + st %o0,[%o1+%lo(_avma)] + ld [%l7],%o0 + st %o0,[%l7+4] + mov 0,%o0 +L462: + cmp %l0,%l6 + bge L460 + add %o0,2,%l3 + mov 32,%o0 + sub %o0,%i2,%o4 +L466: + sll %l3,2,%o2 + sll %l0,2,%o0 + ld [%l5+%o0],%o3 + sll %o3,%o4,%o1 + st %o1,[%fp-12] + srl %o3,%i2,%o0 + add %o0,%g2,%o0 + st %o0,[%l7+%o2] + mov %o1,%g2 + add %l0,1,%l0 + cmp %l0,%l6 + bl L466 + add %l3,1,%l3 +L460: + ld [%l7+4],%o0 +L485: + sethi %hi(-16777216),%o1 + andn %o0,%o1,%o1 + ld [%fp-28],%g1 + sll %g1,24,%o0 + add %o1,%o0,%o1 + st %o1,[%l7+4] +L445: + cmp %i4,-1 +L483: + bne L468 + cmp %i4,0 + ld [%fp-20],%o0 + mov %l4,%o1 + b L475 + mov %l7,%o2 +L468: + be L469 + ld [%fp-20],%o0 + mov %l4,%o1 + call _gerepile,0 + mov 0,%o2 + and %o0,-4,%o0 + add %l7,%o0,%o1 + st %o1,[%i4] + ld [%fp-44],%g4 + b L470 + add %g4,%o0,%i0 +L469: + mov %l4,%o1 + ld [%fp-44],%o2 +L475: + call _gerepile,0 + nop + mov %o0,%i0 +L470: + ret + restore + .align 4 + .global _mulul3 + .proc 016 +_mulul3: + !#PROLOGUE# 0 + save %sp,-104,%sp + !#PROLOGUE# 1 + + or %i0,%i1,%o4 + mov %i0,%y + andncc %o4,0xfff,%g0 + be 2f + andcc %g0,%g0,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + tst %i1 + bl,a 1f + add %o4,%i0,%o4 +1: mov %o4,%g2 + b 3f + rd %y,%i0 +2: clr %g2 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%i1,%o4 + mulscc %o4,%g0,%o4 + rd %y,%o5 + sll %o4,12,%o4 + srl %o5,20,%o5 + or %o5,%o4,%i0 +3: + + st %g2,[%i2] + ret + restore diff --git a/mp/mpi.c b/mp/mpi.c new file mode 100755 index 0000000..b81eac0 --- /dev/null +++ b/mp/mpi.c @@ -0,0 +1,649 @@ + +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ +/*~ ~*/ +/*~ OPERATIONS DE BASE (NOYAU) ~*/ +/*~ ~*/ +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ +/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ +/* This file was modified by W. Schelter to be suitable for optimization + and inlining of assembler for maximum speed + */ + +#include "config.h" +#include "genpari.h" +#include "arith.h" + +GEN mulsi(x,y) + plong x; + GEN y; +{ TEMPVARS + plong s=signe(y),ly=lgef(y),i; + GEN z,zp,yp; ulong hiremainder; + + if((!x)||(!s)) return gzero; + if(x<0) {s= -s; + x= -x; + if (x < 0) /* -2^31 */ + {return mulii(stoi(1<<31),y);} + } + z=cgeti(ly+1); + hiremainder=0; + MP_START_LOW(yp,y,ly); MP_START_LOW(zp,z,ly+1); + i = MP_COUNT_LG(ly); + WHILE_COUNT(--i) { MP_NEXT_UP(zp) = addmul(x,MP_NEXT_UP(yp));} + if(hiremainder) {MP_NEXT_UP(zp)=hiremainder; + setlgef(z,ly+1);} + else {avma+=4;z[1]=z[0]-1;z++;setlgef(z,ly);} + setsigne(z,s);return z; +} + +int expi(x) + GEN x; +{ + plong lx=x[1]&0xffff; + + return lx==2 ? -8388608 : ((lx-2)<<5)-bfffo(x[2])-1; +} + +GEN addsi(x,y) + plong x; + GEN y; +{ + plong sx,sy,ly,p,i; + ulong overflow; + GEN z; TEMPVARS + + + if(!x) return icopy(y); + sy=signe(y);if(!sy) return stoi(x); + if(x<0) {sx= -1; + x= -x; + if (x < 0) /* x=-2^31 */ + return addii(MOST_NEGS,y); + } else sx=1; + ly=lgef(y); + if(sx==sy) + { + p=addll(x,y[ly-1]); + if(overflow) + { + z=cgeti(ly+1);z[ly]=p; + for(i=ly-1;(i>2)&&(y[i-1]==0xffffffff);i--) z[i]=0; + if(i>2) + { + z[i]=y[i-1]+1;i--;while(i>=3) {z[i]=y[i-1];i--;} + z[2]=z[1]=z[0]-1;z++;avma+=4; + } + else {z[2]=1;z[1]=z[0];} + } + else + { + z=cgeti(ly);z[ly-1]=p;for(i=1;i(ulong)x) + { + z=cgeti(3);z[1]=(sy<<24)+3;z[2]=y[2]-x;return z; + } + if(y[2]==x) return gzero; + z=cgeti(3);z[1]=((-sy)<<24)+3;z[2]=x-y[2];return z; + } + p=subll(y[ly-1],x); + if(overflow) + { + z=cgeti(ly);z[ly-1]=p; + for(i=ly-2;!(y[i]);i--) z[i]=0xffffffff; + z[i]=y[i]-1; + if((i>2)||z[i]) {i--;for(;i>=1;i--) z[i]=y[i];} + else + { + z[2]=z[1]=z[0]-1;z++;avma+=4;setsigne(z,sy); + } + } + else + { + z=cgeti(ly);z[ly-1]=p;for(i=1;i=ly so sx==0 ==> sy==0 */ + + if (0 == (sy=signe(y))) return icopy(x); + sx = signe(x); + + if(sx==sy) + { + z=cgeti(lx+1);overflow=0; + MP_START_LOW(zp,z,lx+1); + MP_START_LOW(xp,x,lx); + MP_START_LOW(yp,y,ly); + +#ifdef QUICK_LOOP + i = ly - 2; + QUICK_LOOP(i,ADDXCC); +#else + i = MP_COUNT_LG(ly); + WHILE_COUNT(--i) + {ADDLLX(MP_NEXT_UP(xp),MP_NEXT_UP(yp),MP_NEXT_UP(zp));} +#endif + + + if(overflow) + { GEN xhigh = &MP_HIGH(x,lx); + again: + { GEN xpp = &MP_NEXT_UP(xp); + if (xpp >= xhigh) + { if (*xpp == 0xffffffff) + { MP_NEXT_UP(zp)=0; + goto again;} + + else + { MP_NEXT_UP(zp) = *xpp + 1; + while ((xpp = &MP_NEXT_UP(xp)) >= xhigh) + { MP_NEXT_UP(zp) = *xpp ;} + z[1]=z[0]-1;z[2]=x[1];z++;avma+=4;}} + else {z[2]=1;z[1]=x[1]+1;} + }} + else + { j = COUNT(lx - ly); + WHILE_COUNT( --j) + { MP_NEXT_UP(zp) = MP_NEXT_UP(xp);} + z[1]=z[0]-1;z[2]=x[1];z++;avma+=4; + } + } + else + { + if(lx==ly) + /* we have to compare x and y */ + { j = MP_COUNT_LG(lx); + MP_START_HIGH(xp,x,lx); + MP_START_HIGH(yp,y,lx); + WHILE_COUNT(--j) + { ulong tx = MP_NEXT_DOWN(xp); + ulong ty = MP_NEXT_DOWN(yp); + if ( ty > tx) + {z=x;x=y;y=z;sz=sx;sx=sy;sy=sz; + goto DIFFER;} + else + if ( tx > ty) + {goto DIFFER;}} + SAME: return gzero; + DIFFER:; + } + + z=cgeti(lx);overflow=0; + MP_START_LOW(xp,x,lx);MP_START_LOW(yp,y,ly);MP_START_LOW(zp,z,lx); + i = MP_COUNT_LG(ly); + +#ifdef QUICK_LOOP + i = ly - 2; + QUICK_LOOP(i,SUBXCC); +#else + i = MP_COUNT_LG(ly); + WHILE_COUNT(--i) + {SUBLLX(MP_NEXT_UP(xp),MP_NEXT_UP(yp),MP_NEXT_UP(zp));} +#endif + + if(overflow) + { ulong tx ; + while((tx=MP_NEXT_UP(xp)) == 0) + MP_NEXT_UP(zp) = 0xffffffff; + if (xp >= (xhigh = &MP_HIGH(x,lx))) + { MP_NEXT_UP(zp) = tx -1; + while ((xpp = &MP_NEXT_UP(xp)) >= xhigh) + { MP_NEXT_UP(zp) = *xpp;}} + } + else + { i = COUNT(lx - ly); + WHILE_COUNT(--i) + MP_NEXT_UP(zp) = MP_NEXT_UP(xp); + } + if(z[2]) z[1]=x[1]; + else + { zp = &z[3]; + while (*zp ==0){zp++;} /* x was != y by above */ + zp -= 2; + i = zp - z; + zp[1] = (zp[0] = z[0]-i); + z = zp; + setsigne(z,sx); + avma+=(i<<2); + } + } + return z; +} + +GEN mulss(x,y) + plong x,y; +{ + plong s,p1; + GEN z; ulong hiremainder; + + if((!x)||(!y)) return gzero; + s=1; + if(x<0) + {s= -1; + x= -x; + if (x<0) + return mulsi(y,stoi(x)); + } + if(y<0) {s= -s; + y= -y; + if(y<0) + return mulsi((s > 0 ? x : -x),ABS_MOST_NEGS); + } + p1=mulll(x,y); + if(hiremainder) {z=cgeti(4);z[2]=hiremainder;z[3]=p1;} + else {z=cgeti(3);z[2]=p1;} + z[1]=z[0];setsigne(z,s);return z; +} + + +GEN mulii(x,y) + GEN x,y; +{ + plong i,j,lx=lgef(x),ly=lgef(y),sx,sy,lz,p1,p2; + GEN z; TEMPVARS + + GEN zz,yy,zp,xx; + GEN ylow; + ulong hiremainder; + ulong overflow; + + sx=signe(x);if(!sx) return gzero; + sy=signe(y);if(!sy) return gzero; + if(sy<0) sx= -sx; + if(lx>ly) {z=x;x=y;y=z;lz=lx;lx=ly;ly=lz;} + lz=lx+ly-2;if(lz>=0x10000) err(muler1); + z=cgeti(lz);z[1]=z[0];setsigne(z,sx); + + MP_START_LOW(xx,x,lx); + p1 = MP_NEXT_UP(xx); + + hiremainder=0; + i = COUNT(ly-2); + MP_START_LOW(yy,y,ly); + MP_START_LOW(zz,z,lz); + + WHILE_COUNT (--i) + { MP_NEXT_UP(zz) = addmul(p1,MP_NEXT_UP(yy));} + + MP_NEXT_UP(zz) = hiremainder; + + /* restart zz one above bottom */ + MP_START_LOW(zz,z,lz); + + MP_START_LOW(ylow,y,ly); + ly = COUNT(ly - MP_CODE_WORDS); + lx -= MP_CODE_WORDS; + while (--lx > 0) /* one less iteration first term of x, already used */ + { plong tem; + register plong p11; + p11 = MP_NEXT_UP(xx); + i = ly; + yy = ylow; + zp = &MP_NEXT_UP(zz); /* *zp = second from low word of z first time through */ + tem = 0; + /* ZerO is just a 68k kludge to getit to keep 0 in a reg during this loop*/ +#undef ZERO +#define ZERO ZerO + { int ZerO = 0; + WHILE_COUNT(--i) + { p2 = MP_NEXT_UP(yy); + p2 = mulul(p2,p11,hiremainder); + MP_NEXT_UP(zp); + p2 = add_carry(p2,*zp,hiremainder); + p2 = add_carry(p2,tem,hiremainder); + *zp = p2; + tem = hiremainder; + } + } + MP_NEXT_UP(zp) = hiremainder; + +#undef ZERO +#define ZERO 0 + + } + if(!MP_HIGH(z,lz)) + { /* shift header one along decreasing lg and lgef */ + z[2]=z[1]-1;z[1]=z[0]-1;z++;avma+=4; + } + return z; +} + +GEN confrac(x) + GEN x; +{ + plong lx=lg(x),ex= -expo(x)-1,ex1,av=avma,ly,ey; + plong lr,nbdec,k,i,j; ulong hiremainder; + GEN y,res; TEMPVARS + + ey=((lx-2)<<5)+ex;ly=(ey+63)>>5;y=cgeti(ly);ex1=ex>>5; /* 95 dans mp.s faux? */ + for(i=0;i=0;i--) y[i]=addmul(y[i],1000000000); + res[j]=hiremainder; + } + avma=av;return res; +} + +/* x/y : uses hiremainder for return */ +GEN divss(x,y) + plong x,y; +{ + plong p1; + + if(!y) err(diver1); + if (x == (1<<31)) + return divis(stoi(x),y); + hiremainder=0;p1=divll((ulong)abs(x),(ulong)abs(y)); + if(y<0) {hiremainder= -((plong)hiremainder);p1= -p1;} + if(x<0) p1= -p1; + return stoi(p1); +} + +GEN modss(x,y) + plong x,y; +{ + plong y1; ulong hiremainder; + + if(!y) err(moder1); + if (x == (1<<31)) + return modis(stoi(x),y); + hiremainder=0;divll(abs(x),y1=abs(y)); + if(!hiremainder) return gzero; + return (((plong)hiremainder)<0) ? stoi(y1-hiremainder) : stoi(hiremainder); +} + +GEN resss(x,y) + plong x,y; +{ ulong hiremainder; + if(!y) err(reser1); + hiremainder=0;divll(abs(x),abs(y)); + return (y<0) ? stoi(-((plong)hiremainder)) : stoi(hiremainder); +} + +/* uses hiremainder for return */ +GEN divsi(x,y) + plong x; + GEN y; +{ + plong s=signe(y),ly=lgef(y),p1; + + if(!s) err(diver2); + if((!x)||(ly>3)||(y[2]<0)) {hiremainder=x;return gzero;} + if (x== 1<<31) + return divii(stoi(x),y); + hiremainder=0;p1=divll(abs(x),y[2]); + if(signe(y)<0) {hiremainder= -((plong)hiremainder);p1= -p1;} + if(x<0) p1= -p1; + return stoi(p1); +} + +/* this uses the GLOBAL hiremainder to return its remainder + We cannot make it a local. + */ +GEN divis(y,x) + plong x; + GEN y; +{ ulong hi; + plong s=signe(y),ly=lgef(y),i,d; + GEN z; + + if(!x) err(diver4); + if(!s) {hiremainder=0;return gzero;} + if(x<0) {s= -s;x= -x; + if (x < 0) + return divii(y,stoi(x)); + } + if((ulong)x>(ulong)y[2]) + { + if(ly==3) {hiremainder=itos(y);return gzero;} + else {z=cgeti(ly-1);d=1;hi=y[2];} + } + else {z=cgeti(ly);d=0;hi=0;} + for(i=d+2;i (ulong)MP_HIGH(x,lx)) + { lgp1=lx-1; hiremainder= MP_NEXT_DOWN(xp);} + else { lgp1=lx; hiremainder=0;} + p1 = cgeti(lgp1); i = MP_COUNT_LG(lgp1); + MP_START_HIGH(p1p,p1,lgp1); + WHILE_COUNT(--i) { MP_NEXT_DOWN(p1p) = divll(MP_NEXT_DOWN(xp),si);} + + if((plong)z==0xffffffff) + { + avma=av;if(!hiremainder) return gzero; + p2=cgeti(3);p2[1]=(sx<<24)+3;p2[2]=hiremainder;return p2; + } + if(lgp1!= 2) {p1[1]=p1[0];setsigne(p1,sy);} else {avma=av;p1=gzero;} + if(z==0) return p1; + if(!hiremainder) *z=gzero; + else {p2=cgeti(3);p2[1]=(sx<<24)+3;p2[2]=hiremainder;*z=p2;} + return p1; + } + else + { + p1=cgeti(lx); + sh=bfffo(y[2]); + if(sh) + { GEN p2p,yp; + MP_START_HIGH(yp,y,ly); + p2=cgeti(ly); + k=shiftl(MP_NEXT_DOWN(yp),sh); + MP_START_HIGH(p2p,p2,ly); + i = MP_COUNT_LG(ly-1); + WHILE_COUNT(--i) + { + k1=shiftl(MP_NEXT_DOWN(yp),sh); + MP_NEXT_DOWN(p2p) = k + hiremainder; + k = k1; + } + MP_NEXT_DOWN(p2p) = k ; k=0; + + MP_START_HIGH(xp,x,lx); + MP_START_HIGH(p1p,p1,lx); + MP_NEXT_UP(p1p) ; /* yes go out of range !! */ + i = MP_COUNT_LG(lx); + WHILE_COUNT (--i) + { k1 = shiftl(MP_NEXT_DOWN(xp),sh); + MP_NEXT_DOWN(p1p) = k + hiremainder; k = k1; + } + MP_NEXT_DOWN(p1p) = k; + } + else { + MP_START_HIGH(xp,x,lx); + MP_START_HIGH(p1p,p1,lx); + MP_NEXT_UP(p1p) ; /* yes go out of range !! */ + MP_NEXT_DOWN(p1p) = 0; + j = MP_COUNT_LG(lx); + WHILE_COUNT (-- j) + { MP_NEXT_DOWN(p1p) = MP_NEXT_DOWN(xp);} + p2 = y;} + si=p2[2];saux=p2[3]; + MP_START_HIGH(p1p,p1,lx); MP_NEXT_UP(p1p) ; /* out of bound */ + i = COUNT(lz+1); + WHILE_COUNT(--i) + + { GEN pp; + if(MP_NEXT_DOWN(p1p)==si) + { /* Using fact that next_down does post increment */ + qp=0xffffffff;k=addll(si,*p1p); + + } + else + { + hiremainder=p1p[-1];qp=divll(*p1p,si); + overflow=0;k=hiremainder; + } + if(!overflow) + { +/* k1=mulll(qp,saux);k3=subll(k1,p1p[1]);k+=overflow; + flk4=((ulong)hiremainder>(ulong)k);k4=subll(hiremainder,k); + while(flk4) {qp--;k3=subll(k3,saux); + k4-=overflow;flk4=((ulong)k4>(ulong)si); + k4=subll(k4,si);} +*/ + k1=mulll(qp,saux);k3=subll(k1,p1p[1]); + k4=subllx(hiremainder,k); + while((!overflow)&&k4) {qp--;k3=subll(k3,saux);k4=subllx(k4,si);} + + } + hiremainder=0; + + j = MP_COUNT_LG(ly); + MP_START_LOW(pp,p1p,ly-2); + MP_START_LOW(p2p,p2,ly); + WHILE_COUNT(--j) + { GEN ppp; + k1=addmul(qp,MP_NEXT_UP(p2p)); + ppp = &MP_NEXT_UP(pp); + *ppp =subll(*ppp,k1);hiremainder+=overflow; + } + if((ulong)p1p[-1]<(ulong)hiremainder) + { + overflow=0;qp--; + j = MP_COUNT_LG(ly); + MP_START_LOW(pp,p1p,ly-2); + MP_START_LOW(p2p,p2,ly); + WHILE_COUNT(--j){ GEN ppp = &MP_NEXT_UP(pp); + ADDLLX(*ppp,MP_NEXT_UP(p2p),*ppp);} + + } + p1p[-1] = qp; + } + av1=avma; + if((plong)z!=0xffffffff) + {ulong lgp3 = lz + 2; + MP_START_LOW(p1p,p1,lgp3); + if (p1[1]) {lgp3++;} + else if (lz==0) sy=0; + p3 = cgeti(lgp3); + MP_START_LOW(pp,p3,lgp3); + j = MP_COUNT_LG(lgp3); + WHILE_COUNT(--j) + {MP_NEXT_UP(pp) = MP_NEXT_UP(p1p) ;} + if(lgp3<3) {p3[1]=2;} else {p3[1]=p3[0];setsigne(p3,sy);} + } + if(z!=0) + { + for(j=lz+2;(j>2;*z=p4+dec;return p3+dec; + } +} +/* machines which provide an inline version of mulul need + to provide a function for calls where that inlining can't take place + */ +#ifdef NEED_MULUL3 +ulong +mulul3(a,b,c) + ulong a,b,*c; +{ return mulul(a,b,*c);} +#endif + +#ifdef NEED_DIVUL3 +ulong +divul3(a,b,c) + ulong a,b,*c; +{ return divul(a,b,*c);} +#endif + +/* +;;- Local variables: +;;- version-control:t +;;- End: +*/ diff --git a/mp/readme b/mp/readme new file mode 100755 index 0000000..b10c562 --- /dev/null +++ b/mp/readme @@ -0,0 +1,85 @@ +README for multiprecision arithmetic directory. +README by W. Schelter + +The files in this directory + +gencom.h mp.s sparc.s +erreurs.h genport.h + +are from the PARI distribution version 1.34 written by C. Batut, D. +Bernardi, H. Cohen and M. Olivier. + +The file mp.c from the 1.34 distribution has been divided into +mpi.c: The functions benefiting from assembler or assembler macros. +mp2.c: Additional integer arithmetic routines. + +In addition the functions in mpi.c have been somewhat rewritten by +Schelter, to improve the efficiency on machines unable to use the 68k +assembler in the pari file mp.s. By using gcc and assembler macros, +we were able to equal the speed of the excellent pari assembler, on +multiply and addition of 100 word bignums. This distribution +contains .s files produced by gcc for machines where this has +been available. For other machines the functions divul3 +and mulul3 may be provided as assembler functions, or they may +use the code in the libmport.a which is plain C. + +mp_mulul3.c: 64 bit multiply in C +mp_divul3.c: 64 bit multiply in C +mp_bfffo.c: position of first non zero bit in C + +mpi-*.s: are assembler produced by gcc for several machines. + +Full sources for PARI/GP are available by anonymous ftp from (Internet +number 192.33.148.32). + +Authors address: + + Prof. Henri COHEN (re: PARI) + UFR de Mathematiques et Informatique + Universite Bordeaux I + 351 Cours de la Liberation + 33405 TALENCE CEDEX + FRANCE + +e-mail: pari@mizar.greco-prog.fr (Internet number 192.33.148.32) + +The integration of the pari code into AKCL was done by W. Schelter. + +--------------------------------------------------------------------------- +Excerpt from letter from Henri Cohen giving us permission to +redistribute this code with AKCL. + +Received-Date: Fri, 25 Jan 91 12:38:02 -0600 +Date: Fri, 25 Jan 91 19:17:34 +0100 +From: pari@mizar.greco-prog.fr (Systeme PARI) +To: wfs@nicolas.ma.utexas.edu +Subject: Re: AKCL + +Thank you for the clarifications. + +1) -2^31: it was mainly a matter of convenience to exclude that value, so that +in effect I don't know which programs should be affected if one allows it. If +necessary, I can look into it. + +2) Yes, go ahead means that you may modify and rearrange things in your own +way, +and redistribute it, of course keeping us informed. On the other hand, please +tell us as soon as possible of any bug that you discover that we should +eliminate from the main system itself. + +.. + +Sincerely, + +Henri Cohen + + + + + + + + + + + diff --git a/mp/sparcdivul3.s b/mp/sparcdivul3.s new file mode 100755 index 0000000..2cbf0fa --- /dev/null +++ b/mp/sparcdivul3.s @@ -0,0 +1,283 @@ +#ifdef __svr4__ +#define _err err +#define _divul3 divul3 +#endif + .seg "text" + .global _divul3 + +#define SS0(label) \ + addx %o2,%o2,%o2;\ + subcc %o2,%o1,%o3;\ + bcc label;\ + addxcc %o0,%o0,%o0 + +#define SS1(label) \ + addx %o3,%o3,%o3;\ + subcc %o3,%o1,%o2;\ + bcc label;\ + addxcc %o0,%o0,%o0 +_divul3: mov %o2,%o4 + ld [%o2],%o2 + subcc %o2,%o1,%g0 + blu 1f + addcc %o1,%o1,%g0 + mov 0x2f,%o0 + call _err,1 + nop +1: bcc Lsmalldiv + andcc %o1,1,%g0 + be Levendiv + srl %o1,1,%o1 + add %o1,1,%o1 + subcc %o2,%o1,%o3 + bcc Lb01 + addxcc %o0,%o0,%o0 +La01: SS0(Lb02) +La02: SS0(Lb03) +La03: SS0(Lb04) +La04: SS0(Lb05) +La05: SS0(Lb06) +La06: SS0(Lb07) +La07: SS0(Lb08) +La08: SS0(Lb09) +La09: SS0(Lb10) +La10: SS0(Lb11) +La11: SS0(Lb12) +La12: SS0(Lb13) +La13: SS0(Lb14) +La14: SS0(Lb15) +La15: SS0(Lb16) +La16: SS0(Lb17) +La17: SS0(Lb18) +La18: SS0(Lb19) +La19: SS0(Lb20) +La20: SS0(Lb21) +La21: SS0(Lb22) +La22: SS0(Lb23) +La23: SS0(Lb24) +La24: SS0(Lb25) +La25: SS0(Lb26) +La26: SS0(Lb27) +La27: SS0(Lb28) +La28: SS0(Lb29) +La29: SS0(Lb30) +La30: SS0(Lb31) +La31: SS0(Lb32) +La32: addx %o2,%o2,%o2 + xor %o0,-1,%o0 + add %o1,%o1,%o1 + sub %o1,1,%o1 + addcc %o0,%o2,%o2 + bcc 1f + subcc %o2,%o1,%o3 + subcc %o3,%o1,%o2 + bcs 2f + add %o0,1,%o0 + add %o0,1,%o0 +3: retl + st %o2,[%o4] +1: bcs 3b + nop + add %o0,1,%o0 +2: retl + st %o3,[%o4] + +Lb01: SS1(La02) +Lb02: SS1(La03) +Lb03: SS1(La04) +Lb04: SS1(La05) +Lb05: SS1(La06) +Lb06: SS1(La07) +Lb07: SS1(La08) +Lb08: SS1(La09) +Lb09: SS1(La10) +Lb10: SS1(La11) +Lb11: SS1(La12) +Lb12: SS1(La13) +Lb13: SS1(La14) +Lb14: SS1(La15) +Lb15: SS1(La16) +Lb16: SS1(La17) +Lb17: SS1(La18) +Lb18: SS1(La19) +Lb19: SS1(La20) +Lb20: SS1(La21) +Lb21: SS1(La22) +Lb22: SS1(La23) +Lb23: SS1(La24) +Lb24: SS1(La25) +Lb25: SS1(La26) +Lb26: SS1(La27) +Lb27: SS1(La28) +Lb28: SS1(La29) +Lb29: SS1(La30) +Lb30: SS1(La31) +Lb31: SS1(La32) +Lb32: addx %o3,%o3,%o2 + xor %o0,-1,%o0 + add %o1,%o1,%o1 + sub %o1,1,%o1 + addcc %o0,%o2,%o2 + bcc 1f + subcc %o2,%o1,%o3 + subcc %o3,%o1,%o2 + bcs 2f + add %o0,1,%o0 + add %o0,1,%o0 +3: retl + st %o2,[%o4] +1: bcs 3b + nop + add %o0,1,%o0 +2: retl + st %o3,[%o4] + +Lsmalldiv: + addcc %o0,%o0,%o0 +Lc00: SS0(Ld01) +Lc01: SS0(Ld02) +Lc02: SS0(Ld03) +Lc03: SS0(Ld04) +Lc04: SS0(Ld05) +Lc05: SS0(Ld06) +Lc06: SS0(Ld07) +Lc07: SS0(Ld08) +Lc08: SS0(Ld09) +Lc09: SS0(Ld10) +Lc10: SS0(Ld11) +Lc11: SS0(Ld12) +Lc12: SS0(Ld13) +Lc13: SS0(Ld14) +Lc14: SS0(Ld15) +Lc15: SS0(Ld16) +Lc16: SS0(Ld17) +Lc17: SS0(Ld18) +Lc18: SS0(Ld19) +Lc19: SS0(Ld20) +Lc20: SS0(Ld21) +Lc21: SS0(Ld22) +Lc22: SS0(Ld23) +Lc23: SS0(Ld24) +Lc24: SS0(Ld25) +Lc25: SS0(Ld26) +Lc26: SS0(Ld27) +Lc27: SS0(Ld28) +Lc28: SS0(Ld29) +Lc29: SS0(Ld30) +Lc30: SS0(Ld31) +Lc31: SS0(Ld32) +Lc32: xor %o0,-1,%o0 + retl + st %o2,[%o4] + +Ld01: SS1(Lc02) +Ld02: SS1(Lc03) +Ld03: SS1(Lc04) +Ld04: SS1(Lc05) +Ld05: SS1(Lc06) +Ld06: SS1(Lc07) +Ld07: SS1(Lc08) +Ld08: SS1(Lc09) +Ld09: SS1(Lc10) +Ld10: SS1(Lc11) +Ld11: SS1(Lc12) +Ld12: SS1(Lc13) +Ld13: SS1(Lc14) +Ld14: SS1(Lc15) +Ld15: SS1(Lc16) +Ld16: SS1(Lc17) +Ld17: SS1(Lc18) +Ld18: SS1(Lc19) +Ld19: SS1(Lc20) +Ld20: SS1(Lc21) +Ld21: SS1(Lc22) +Ld22: SS1(Lc23) +Ld23: SS1(Lc24) +Ld24: SS1(Lc25) +Ld25: SS1(Lc26) +Ld26: SS1(Lc27) +Ld27: SS1(Lc28) +Ld28: SS1(Lc29) +Ld29: SS1(Lc30) +Ld30: SS1(Lc31) +Ld31: SS1(Lc32) +Ld32: xor %o0,-1,%o0 + retl + st %o3,[%o4] + + +Levendiv: + subcc %o2,%o1,%o3 + bcc Lf01 + addxcc %o0,%o0,%o0 +Le01: SS0(Lf02) +Le02: SS0(Lf03) +Le03: SS0(Lf04) +Le04: SS0(Lf05) +Le05: SS0(Lf06) +Le06: SS0(Lf07) +Le07: SS0(Lf08) +Le08: SS0(Lf09) +Le09: SS0(Lf10) +Le10: SS0(Lf11) +Le11: SS0(Lf12) +Le12: SS0(Lf13) +Le13: SS0(Lf14) +Le14: SS0(Lf15) +Le15: SS0(Lf16) +Le16: SS0(Lf17) +Le17: SS0(Lf18) +Le18: SS0(Lf19) +Le19: SS0(Lf20) +Le20: SS0(Lf21) +Le21: SS0(Lf22) +Le22: SS0(Lf23) +Le23: SS0(Lf24) +Le24: SS0(Lf25) +Le25: SS0(Lf26) +Le26: SS0(Lf27) +Le27: SS0(Lf28) +Le28: SS0(Lf29) +Le29: SS0(Lf30) +Le30: SS0(Lf31) +Le31: SS0(Lf32) +Le32: addx %o2,%o2,%o2 + xor %o0,-1,%o0 + retl + st %o2,[%o4] + +Lf01: SS1(Le02) +Lf02: SS1(Le03) +Lf03: SS1(Le04) +Lf04: SS1(Le05) +Lf05: SS1(Le06) +Lf06: SS1(Le07) +Lf07: SS1(Le08) +Lf08: SS1(Le09) +Lf09: SS1(Le10) +Lf10: SS1(Le11) +Lf11: SS1(Le12) +Lf12: SS1(Le13) +Lf13: SS1(Le14) +Lf14: SS1(Le15) +Lf15: SS1(Le16) +Lf16: SS1(Le17) +Lf17: SS1(Le18) +Lf18: SS1(Le19) +Lf19: SS1(Le20) +Lf20: SS1(Le21) +Lf21: SS1(Le22) +Lf22: SS1(Le23) +Lf23: SS1(Le24) +Lf24: SS1(Le25) +Lf25: SS1(Le26) +Lf26: SS1(Le27) +Lf27: SS1(Le28) +Lf28: SS1(Le29) +Lf29: SS1(Le30) +Lf30: SS1(Le31) +Lf31: SS1(Le32) +Lf32: addx %o3,%o3,%o3 + xor %o0,-1,%o0 + retl + st %o3,[%o4] diff --git a/o/.gitignore b/o/.gitignore new file mode 100644 index 0000000..93cb0d3 --- /dev/null +++ b/o/.gitignore @@ -0,0 +1,6 @@ +boot.h +gcllib.a +grab_defs +new_init.c + + diff --git a/o/ChangeLog b/o/ChangeLog new file mode 100755 index 0000000..5008433 --- /dev/null +++ b/o/ChangeLog @@ -0,0 +1,1385 @@ +Fri Nov 24 18:42:46 1995 Bill Schelter + + * alloc.c (ONCE_MORE): + * DEFUN("STATICP",.. had accidentally been included in a section + which was '#ifdef'ed out on nexts..., making it not be there + at link time: moved it to where it is always there. + * + + +Nov 11 1995 bill schelter + * gcl-2.2 released + + +Sun Oct 1 19:52:45 1995 Bill Schelter + + * Many changes to gcl 2.1 to support 64 bit machines (eg Dec + alpha). Layout of structures etc changed. + * a gcl-2.2 beta was released in the summer. + since then there have been several bugs fixed. One in cmpfun.lsp + affecting write, and another in init_gcl.lsp to make sure the + link array is a string array (changed from fixnum which are no + longer sufficient to hold pointers). + * changes to fix for PA risc hpux in the hp800.h + * changes to unexec-19.27.c to allow MUCH faster saving in NFS + environment. + * testing with maxima 5.1 + * reworking makefiles + + +Sat Apr 29 08:48:06 1994 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Changed to release under GNU Public Library license. There + have been a number of other fixes including fixes to bignums. + + +Thu Jan 20 10:38:00 1994 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * version 624 made. + * contains just changes so that compiles on solaris 5.2. The + 623 version compiled on solaris 5.3, but the earlier 5.2 version of solaris + had some differences which needed patches. These are contained + in 624. + +Fri Dec 10 15:02:14 1993 Bill Schelter (wfs at nicolas.ma.utexas.edu) + * version 623 made. + + * the check on string-trim for a list of chars is fixed. + Much earlier the (string-trim '(2) "ab") would run forever. + Then string-trim was broken. + + +Sun Dec 5 15:34:44 1993 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * add solaris version: changes to several C files + and new version of sfasl for elf. + * linux port added. + +Thu Oct 29 13:20:17 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * make sure the signal stack is 8 byte aligned. Needed on sun os 4.1.2 + and higher. + +Thu Jun 4 06:18:20 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix allocation of copy space during an sgc for relocatable + +Wed Apr 29 09:02:59 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + *cmpnew/lfuns.lsp make load,open, error-set go through lisp + symbol, so users can redefine them (eg when loaded common lisp + condition code stuff). + * defstruct.lsp: put the conc-name in the current package, + so that programs can discover the package in effect when + the defstruct was done, in order to reconstruct accessors. + +Sun Apr 26 23:28:42 1992 Bill Schelter (wfs@sonia.ma.utexas.edu) + + * predicate.c: contains_sharp_comma handle non type t arrays + * co1typep optimize for the '(satifies fun) type. + * cmpinline.lsp, cmplabel.lsp, cmploc.lsp + inline-integer (set-loc unwind-exit get-inline-loc) + fixes by r harris. + +Thu Apr 23 15:09:44 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * cmpenv.lsp fix function return integer proclamation. + +Sat Apr 11 09:25:05 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * numlib.lsp: changes to ensure double accuracy not lost. + +Thu Apr 9 11:21:25 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * log,exp,.. get more accuracy if given a fixnum[don't use short-float] + * cmptop.lsp empty keyword list bug (defun foo(&key) nil) + * many files add hooks for dos port. + +Fri Mar 27 15:59:24 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * (cmpinline.lsp) inline-args of a closure var which changed later, + signalled a compiler error. + +Wed Mar 25 14:38:41 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * (read.d) make read listen to when ':' is a read macro. in read_object + * (cmpfun.lsp,cmpopt.lsp): Fix optimizer for (typep x 'ratio) + * (predicate.c): fix equalp so (equalp (format nil "hi") "hi") -->t + +Wed Mar 11 14:16:59 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * (read.d): fix failure of (read-string "#b1"). Handle eof in + read_constituent + + +Wed Feb 26 21:38:04 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * cmpfun.lsp change read-char optimizer so as to avoid + a C compiler bug on dec3100, which causes an unaligned access + on that machine in calls to read-char. + +Wed Jan 29 08:30:09 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * hp800.{h,defs} changes to run incrementally loaded text in a + separate segment (at 4zillion). Without this hp will only let + you run one image at a time. Unfortunately there will be a slight + degradation in indirect calls (which includes all calls between + user functions). Why do they need to have segments.... + +Thu Jan 23 17:01:37 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * add some save and retore around the terminal interrupt, to + prevent some possible lossage when continuing from an interrupt. + You still may lose if there is a gc during an interrupt. + + +Wed Jan 22 19:08:11 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * support for mac under AUX. Files mac2.h, mac2.defs [by weigert] + * misc small changes to other files for mac. + +Sun Jan 5 21:35:21 1992 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * new definitions for fplus and fminus in cmac.c The ones for + the 68020 were incorrect (since the changeover of the bignum code). + These were only used by maxima. + +Fri Nov 22 08:39:42 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Change proclaim of function so to turn integer + proclained args into type T. It is not possible to + pass raw integer type since this would cause a problem + with gc. Also currently it would have generated C which + broke the C compilation. + +Tue Oct 29 07:59:02 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * add misc/warn-slow.lsp. If this file is loaded, then the compiler + warns of certain slow constructs, like undeclared arithmetic, + and slow array references. + +Thu Oct 24 21:34:55 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * funlink.c to handle misproclaimed functions better. + * big.c correct one source of "bad length" warning + +Sun Oct 20 12:55:35 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * gbc.c change position of where the C stack is marked from. + This is relevant for sparcs with the register windows, which + are dumped at interrupts. + * cfun,gbc changes as per PCL mods for turbo closures. + * read.d use 1000000000.0 rather than 1/ this , since it gives + more accurate value in read of float. + * cmpfun.lsp add hook for (typep x 'foo) so that can expand + this differently according to a property of 'foo. + * cmpcall.lsp, add a hook so that special code can be emitted + for calls where a super_funcall_no_event would have been emitted. + This code might be used where we expect closures (cf PCL) + + + +Wed Oct 9 21:31:03 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * read.d to make 0.7 and (/ 7.0 10) produce identical results. + when read (at least on 68k,sparc, rios). + We have left the default number of digits printed out as 17, + in spite of the fact that IEE has only 15.95 significant digits. + The reason is that correct rounding to 15 or 16 digits, will + commonly cause things like most-positive-long-float to print + in a form which is not even readable (since it is rounded up above + the most-positive-long-float). + +Mon Oct 7 20:54:35 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix LD_COMMAND typo in hp800.h + * fix replace_array to make the new array not live + beyond the call, so that gc won't accidentally mark two + copy two identical array bodies (so maybe overstepping the + the new relblock) + +Fri Oct 4 10:58:59 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * close to work on already closed streams. + * make_pure_array arg fixed (num_log.c) + * estack_buf put in static area on machines like rios. + + +Sun Sep 29 12:43:54 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix to relblock allocation in sgc_start + * fix for paths with "~/" + * change default pagesize on sun3 to 4k + + +Sat Sep 7 13:51:24 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix bit-array-op to make correct call to si::make-array-pure + (num_log.c) + +Mon Aug 5 18:06:35 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * wt-cvars add declaration for VXXalloc variables + +Tue Jul 30 16:48:09 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * interpreted mapcar not gc protecting when given more than 2 args. + +Sat Jul 27 12:32:35 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * changes to subtypep to make (subtypep 'cons '(and t cons)) + and (subtypep 'simple-array '(not vector)) correct. + +Fri Jul 26 09:25:56 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * change equal and hash_equal not to descend into structures. + A ruling in CLTL2, clarifies that this should be the case. + * alter get-setf-method and friends to accept environment as second + argument. Alter all the complex setf methods to pass the environment + so that local functional and macro bindings can alter the behaviour + of the setf macro. + +Tue Jul 23 06:25:39 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * sharing for fasd files for package operations was disabled. + Otherwise the symbol in a shadow would be shared with the symbol's + later occurrence in the file--It is still a good idea to put + package operations in a separate lisp file at the beginning of + system load. + * adjustable arrays brought into conformance with changes in CLTL + II. You + may now adjust non adjustable arrays, and the fill-pointer argument + to adjust-array does not change the property of having or not having + a fill pointer for the array. + + + +Sun Jul 21 12:44:04 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix cmac.c for maxima (error in dblrem) + + * sloop for v on l by 'joe + changed to allow for the possibility that joe is a macro. + [used by maxima]. + +Wed Jul 10 10:45:54 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * littleXlsp is included which provides an interface to some + simple X windows routines. It is not in the image by default + See the file lsp/littleXlsp.lsp for directions. + +Tue Jul 9 16:29:23 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * add VOL declarations for setjmps in format.c to allow to work + with gcc on the sparc. + * add stuff to cmplam.lsp for VOL declarations of &aux variables. + + +Wed Jun 26 20:59:04 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Change to gc mark of c stack to make sure register windows + are flushed, by calling recursively. + * add special bignum code for rs 6000 and aix 370 + * fix for read suppress and the defstruct reader. + * Source level debugging improved (see doc/DOC and doc/dbl.el) + * Catch infinite recursion of proclaimed functions. Handle + segmentation faults on an alternate stack--so don't play around + to much after a segmentation fault before quitting to top level. + * support for hp800 (and hp700) added. + + +Wed May 22 14:54:29 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * added new slot to struct stream, to hold the buffer. + gbc.c and file.d had been referencing the field in FILE + directly, but that is not reliable on att Sys V 4. + +Thu Apr 11 17:04:54 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * add conc-name to the s-data structure so users may get at + it (defstruct.lsp). + * add install_segmentation_catcher() and also in error() + (ususually arises from real segmentation faults), then turn + off sgc, if it's on, to avoid having the error handler stall + on trying to alter pages which are write protected (since + we are still within the memprotect_handler. + +Thu Apr 4 08:37:50 1991 Bill Schelter (wfs at max.ma.utexas.edu) + + * If HAVE_YP_UNBIND is defined, added to c/main.c the + unbinding of the default yp domain. In sun os 4.1 + we were getting a segmentation fault in _yp_dobind_soft() + on a restarted system. + + +Sat Mar 30 09:01:57 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Fix listen and clear-input (file.d and read.d). + macros LISTEN_FOR_INPUT and HAVE_IOCTL are defined in + att.h, bsd.h, and for the aix systems. I have tested + it under aix, sun, 4.3bsd, sgi4d and hpux. Not sure about + vannilla sysv (may have to be #undef'd there). + * fixed pathnames such as "~wfs/foo.lisp" to work. + (see unixfsys.c). + + +Mon Mar 25 12:25:34 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Make sure that long float arrays get allocated on multiple of + sizeof(double ) alignment array.c,gbc.c.. Also unixfasl.c + + * Add to Smakefile an initial execution of xbin/{machine}-fixes + if that file exists. Use this for correction of temporary bug + fixes, such as the bad sgi4d c compiler. + + +Mon Mar 18 12:06:26 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * The structure of bignums and the underlying code was changed + completely. This affected many files including big.c,num_co.c + print.d, read.d, predicate.c, num_arith.c,.. See the file doc/bignum + for a discussion. The compiler was also changed to include + integer as a primitive type with storage allocated on the stack. + * A notion of deducing result type from argument types was + added to the compiler. Initially we are just doing that for + the basic integer functions, but it can be extended to others + * The optimization in cmpopt.lsp have been changed to allow more + flags to accommodate things like the result-type-from-args. + The compiler will normally warn (for the time being) if you + give it old style optimizations. Because of the extensive + changes to the compiler I have changed the default safety + for compiling the cmpnew directory back to 2. + +Thu Feb 14 16:06:42 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * debug.lsp, eval.c: fix break-step-next and break-step-into to pass + the correct environment back so that evaluating variables or + local functions will be done correctly in the debugger. + +Mon Feb 11 16:24:15 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Fixed *break-points* function to bind the correct enviroment + so that variables will get the right values. + +Mon Jan 7 21:21:22 1991 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * make inline string adjustable (cmptop.lsp) + * multiple changes to lsp/debug.lsp and lsp/top.lsp + to allow source line debugging using si::nload. + * debugger largely redone. :bt new backtrace + function (:b still there). see DOC file + * add xdr-open xdr-write xdr-read to the si package. + * akcl 532 compatible with maxima 4-153 + + +Wed Dec 5 01:49:50 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * check_alist should allow nil, since the CLTL allows nil + in place of a cons in an alist. + * many changes to debug.lsp, eval.c and top.lsp to allow + source level debugging. The emacs file dbl.el was added. + It and the DOC file contain more information, but basically + there is automatic source display when broken in the debugger + (for lisp files loaded with nload). + +Tue Nov 20 20:07:02 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Changes to all places where function assignments are made + to allow the hook compiler-def-hook, to be run. This hook + is used by the new source code debugger dbl. + * dbl allows debugging of lisp code with a display of an + arrow in the window opposite the line currently broken at + or being executed. + * The safety on the cmpnew files has been changed to safety 0. + Please notify of any places where this causes a problem! It + should result in significantly faster compilation. The error + checks should be in the source. + +Thu Nov 8 05:31:34 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix aix3_mprotect/mprotect.c [wrong calculation of overflow] + * fix memory_protect in sgbc.c + + +Wed Nov 7 09:56:30 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Change compiler-clear-compiler-properties, to take 2 args. This + is to provide compiler-def-hook, which lets you get the code just + before it is installed. + + * Misc support for IBM 370 mainframe running under AIX. (u370) + * change malloc at startup to use some static space, since + the gc may not be initialized before some startup routines need + to malloc (aix3). + + * fix to cmptag.lsp. Tags in cross closure tagobdies were sometimes not + being written out. (bug had been there forever). C compiler would + fail when the tag was not there. + + +Fri Oct 26 15:00:37 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * change call_proc, the routine used to link proclaimed functions. + It was not incrementing vs_top soon enough, so that with args + (t t fixnum), with fast links off, the make_fixnum caused by + the last arg, might cause a gc which zeroed the vs stack above + vs_top, so eliminating arg1. Symptom was an passed + as second arg. This could only happen when functions were proclaimed, + and had type not = t. + +Sat Oct 6 08:08:47 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * change assoc in list.d so (assoc nil '(nil (nil . a))) --> (nil + . a) + also change cmpfun.lsp in the compiler for this. (bug rep mccain) + * Allow #' in the (:print-function #'(lambda (..)) defstruct option + (bug report baxter) + +Thu Sep 20 19:05:05 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Fix cmpthrow in cmpcatch.lsp so that handles + lexical closures correctly. + + * Fix cmpeval.lsp for incrementing a structure slot + which is fixnum. + * Fix cmpmain.lsp adding support for the floating point + save ops on rios. + + +Sun Sep 2 16:44:24 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Fix perm_writable. It was leaving out the last page! (Vignaux) + +Mon Aug 20 15:15:03 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix acos and asin in numlib.lsp (bug was (acos .5) was complex!) + +Wed Aug 15 14:01:06 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * to fasdump.c: close_fasd was munging the array handed + to it to cleanup. This could cause gc problems later. + + * Several changes to gc. The alloc_relblock function fixed + to take into acount that rb_start - heap_end may not be + holepage anymore [since if sgc_enabled we have a second + `sgc' rb_start after the first]. We ensure that nrbpage + is actually the combined number of pages for relblock, + for sgc and regular gc. (alloc.c) + +Tue Aug 14 16:04:19 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + * changes to sgc to the way memory protection is turned on. + + * There may be problems with saving an image with (sgc-on t) + These have not been resolved, at least under rios, and perhaps + other machines. + + * many changes for aix 3, for rios + + * for sgi, change the Init_links to come before doinit + * the sgi4d does not need the links stuff. + +Wed Aug 8 21:59:37 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Change to h/secondary_sun_magic to make it have 8 characters. + * fix use-package so that allows using a package with an external + symbol, if that symbol is shadowed by the current package. + * Several fixes for sun os 4.1 (secondary magic stuff). + +Wed May 23 11:47:34 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Make traced functions stay traced after redefinition + [change clear_compiler_properties, and its many callers] + * Fix two bugs introduced in trace.lsp when its functionality + was increased. + * fasdump.c (fix coercion). + +Thu Apr 12 15:28:49 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Change behaviour of proclaimed, compiled keyword argument functions, so that + duplicate keys are allowed, and the leftmost takes precedence. + [bind.c:parse_key_new] + +Mon Apr 9 14:48:43 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * make subtypep (predlib.lsp) handle types of form '(not p) correctly. This + in turn influences compiler optimizer handling of (typep x '(not p)) + * fix read (read.d) so that it allows eof to occur during reading of a semicolon + comment line. + * fix c1values (cmpmulti.lsp) so that (values (truncate a b)) does just + return one value. + +Sun Apr 1 22:11:46 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * make float-digits and float-precision return the significant + digits in terms of float-radix. + * If si::*print-nans* is not nil, then the C printing of Nan's + and infinity surrounded by #< > will be used. + +Fri Mar 30 10:24:35 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * gbc.c, sgbc.c: displaced arrays have been a real headache. + (dotimes (i 5000) (make-array 1 :element-type 'string-char :displaced-to + (format nil "0"))) + would cause bad things to happen in kcl and akcl. I finally decided + that the link between an array and the array it is displaced to should + be made firm. If A is displaced to B, the user can always do adjust-array + on A to destroy the displacement. But from now on, as long as the + displacement exists then if B is marked this will cause marking of A, + and vice versa. + +Wed Mar 28 16:41:17 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * cmpeval.lsp co1structure-predicate: + (defstruct foo a b ..) then foo-p was less efficient + than it had been in some earlier release. + Note:after (si::freeze-defstruct 'foo) you get the fastest foo-p, + since this declares the hierarchy of structures including + foo to be frozen. + + +Wed Mar 7 13:30:57 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fixed copying of relblock in gc, so that if an array body + is allocated on C stack [the read_fasd does this for a temp array + it needs] then this array will not be copied. In some cases this + could have caused the copied relblock to exceed nrbpage size, which + is all that sbrk had provided. + + * read-fasd could not be recursively entered from the lisp_eval calls which + were possible [from things like require or other package ops]. + Fixed in fasdump.c + + +Mon Mar 5 11:54:49 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Increase BDSGETA to allow some freedom in the debugger after + a bds overflow. + +Tue Feb 27 09:19:49 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * fix printing NIL relative to a package not using LISP. + +Tue Feb 20 00:10:58 1990 Bill Schelter (wfs at fireant.ma.utexas.edu) + + * Add compiler::*split-files*, to allow convenient splittling of + large lisp files, for C compilers which can't handle infinitely + long C files. See doc/DOC file. + * Fix to fasdump.c. Broke when a .o file was loaded during compilation. + +Fri Feb 16 09:11:08 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * si::*load-pathname* is now bound to the pathname of the current file + being loaded. + + +Sat Feb 10 13:36:44 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Add the co1special prop check in c1symbol-fun, for fixing macros which + expand into declares in do, do*, prog, prog* (see also cmpfun.lsp) + * Fix level in c2call-local (bug report by harris). + +Tue Jan 23 18:37:58 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * change to siLreplace_array, so that the first word of the old + array header is preserved, so that in case sgc is on, the + array won't be marked SGC_RECENT, and so garbage collected if + there were no pointers to it. + +Sun Jan 21 20:30:48 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Many changes to the compiler: Only defuns and defmacros are + compiled by default. A flag compiler::*compile-ordinaries* if + t means all forms will be compiled (use this for pcl at the moment). + See doc under compile-file. + * eval-when default behaviour changed to be in line with the X3j13 + CL standard. See compile-file doc. + files: fasdump.c,cmpaux.c,cfun.c, cmptop, cmpwt,cmpenv, cmpspecial, + cmpflet. + * some advantages of the new init scheme. Some files can be substantially + smaller, and there is more flexibility in writing out the init. Things + like closures which are constant, can be set in as constants. + +Thu Jan 4 23:24:46 1990 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * make sublis for eql equal and eq be substantially more efficient. + [list.d, and cmpfun.lsp] + * fix file_exists for AIX (stat returns 0 there even if file + ending in slash is not a directory (ie /u/all/bmt/.login/ would + have existed. + * make boolean be a real type, so that we can distinguish between + calls to a function which want only a boolean reply or calls + which need more. An example is probe-file which can be 30 + times faster when only a boolean reply is needed, not the truename. + This required changes to cmptype,cmpif cmpinline. + * add additional optimizations to cmpopt.lsp. + * fix vector-push-extend optimization [cmpfun, cmpopt] + * various fixes to sgc + + + +Sat Dec 23 18:30:03 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Fix multiple-value-prog1 in cmpmulti.lsp + (eval-when (compile) (proclaim '(function foo (t t) t))) + (defun jil () (multiple-value-prog1 (values 1 2) (foo 3 4))) + (defun foo (a b) (joe a b) (cons a b)) + (defun joe (a b) (list a b)) + would have (jil) --> 3 4 until this fix. This dates from original kcl. + + +Tue Dec 5 20:22:58 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * changes to alloc.c, gbc.c, page.h, object.h to allow stratified + garbage collection [SGC]. This should help systems with + a large amount of relatively static data. Only pages written + to since sgc-on need be marked and swept. See DOC file. + +Sat Nov 11 07:08:27 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Add various va_end(ap)'s to match unmatched va_start's. + * add in some changes for hp300's faslink. + * add additional support for cmpnew/collectfn.lsp See the + documentation in the DOC file for emit-fn and friends. + Basically it is for getting proclamation info, who-calls info, + undefined info, from a pass of the compiler on a system. + * add additional undefined warnings for undefined lisp package + functions in addition to the list-undefined-functions. + + + +Tue Oct 31 06:02:18 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * add support of Iris 4d machine. + * Fix COERCE_VA_LIST for non standard machines, to + take the argument n. + * Make sure defun, defmacro,.. clear the accessor property + for defstruct slots. + +Sat Oct 28 11:06:25 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * remove an abort() from rel_sun4.c. This type + of relocation now occurs, and our method has been tested. + + +Fri Oct 27 23:01:42 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * if the *system-directory* directory contains the file sys-init.lsp + then this file will be loaded at startup. This facility + is used for printing the warning message at startup, but + can be used for local modifications. Also by having two + system directories [via links and different commands] + different startups could be loaded. All this is in + addition to the regular init.lsp. The purpose of this + is to allow patches to be loaded, without requiring a + resaving of the image. [Recall the system directory + is the first argument to invoking a saved_kcl, or + the first part of the pathname if there is not a first arg + Typically it is the unixport directory if you use the + xbin/kcl command] + +Tue Oct 24 20:23:56 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * Add packlib to the unixport/boots file so that help* + gets compiled using the new do-symbols macro. + * Add alternate malloc.c file from gnu emacs, if you + define GNU_MALLOC. This runs much faster (15X) if you are + incorporating lots of C code with mallocs. + + +Thu Oct 19 21:28:25 1989 Bill Schelter (wfs at nicolas.ma.utexas.edu) + + * add si::fwrite and si::fread for doing io on file streams. + * Eliminate the need for the separate compiler file cmpinclude.h + This means that only one file is now needed for an executable, + and there won't be confusion over which cmpinclude.h goes with + which version. We store the file as a string, and write it + into the c files as they are compiled [if *cmpinclude-string* is + a string and :system-p t is not given to compile]. The time + difference for doing the extra write is not measurable, even + with tiny compiles. + +Wed Oct 4 23:41:17 1989 Bill Schelter (wfs at rascal) + + * co1eql was causing a double evaluation + in some special circumstances. + + +Mon Oct 2 08:48:30 1989 Bill Schelter (wfs at rascal) + + * Many changes to the compiler to support &optional, &rest + &key args to be passed on the C stack. This is still limited + to functions proclaimed to return one value. + * Allow user to grow the stacks from top level [see *multiply-stacks* + doc] + * Code for making proclamation files and collecting + cross referencing data in cmpnew/collectfn.lisp. This + is to allow a second compile of a system to take advantage + of information obtained in the first compile. + * catch-fatal added. + * read.d float read fixed for little endian machines. + * do,prog,prog* and do* compilation fixed so that declare's + at the beginnning of the bodies which are hidden by macros, are + detected and processed. + * :dynamic-extent declaration recognized to allow &rest + * proclaimed functions with one return value, will now be + compiled to use the C stack even if they have more than 10 args. + + + + +Tue Sep 5 22:15:23 1989 Bill Schelter (wfs at rascal) + + * Change add-function-proclamation to be more efficient + when handed long lists of proclaims. Maxima for example + generates 3871 proclaims of functions. This now takes + 4 seconds instead of 2 minutes. + +Mon Sep 4 00:25:29 1989 Bill Schelter (wfs at rascal) + * cfun_to_combined fixed for t_sfun,t_gfun. + + * ihs_function_name fixed for t_sfun,t_gfun + Mainly used in error handling and printing. + + * compiled-function-name fixed to handle t_sfun,t_gfun + [this is used in the error handler] + +Thu Aug 31 09:57:09 1989 Bill Schelter (wfs at rascal) + + * fix reduce in seqlib.lsp. + +Wed Aug 30 16:44:05 1989 Bill Schelter (wfs at rascal) + + * change cmpeval.lsp,cmploc.lsp to make small fixnums + write out without the indirection through VV + + + + ---------Version 206------------- + +Mon Aug 28 13:44:49 1989 Bill Schelter (wfs at rascal) + + * cmptag.lsp:add-reg changed to handle dotted list case + + * Added new types t_sfun, t_gfun of compiled function + objects to save space and speed funcall. See doc/funcall + for details. Many c files changed as well as compiler. + + * cmpeval.lsp: made #, have the c1special property, + instead of c1, so these will compile properly on safety 3 + + * add si::set-mv, si::mv-ref, to allow people to implement + faster version of multiple values. Someday this way will + be the default [see doc/multiple-values and lsp/fast-mv.lisp] + + + +Thu Aug 10 11:51:05 1989 Bill Schelter (wfs at rascal) + + * Fixed prev fix to print in print.d so that ok if stream = t. + + +Mon Aug 7 10:19:11 1989 Bill Schelter (wfs at rascal) + + * Support for HP300bsd (bsd from mt xinu) added. + * print fixed to add space after printing. + * describe modified to print more information on structures + +Fri Jul 28 09:18:15 1989 Bill Schelter (wfs at rascal) + + * trace.lsp Add keyword args allowing special + entry, exit, conditional and other handling of + traced forms. You can for example specially print + args, or break if args or values are inappropriate. + See file doc/trace. + + * c1decl-body: recognize safety level on first pass. + +Sat Jul 8 15:21:42 1989 Bill Schelter (wfs at rascal) + + * defstruct.lsp and read.d: + Fix patch_sharp to handle structures, and sharp-s-reader + to do its reads recursively. + Allows constructs such as #1=#S(joe a #1#) to work. + + +Fri Jul 7 13:40:45 1989 Bill Schelter (wfs at rascal) + + * make sure the co1 properties are cleared when functions + are defined. + +Mon Jul 3 15:05:51 1989 Bill Schelter (wfs at rascal) + + * Fix sharp-s-reader in defstruct.lsp and remove it + from iolib.lsp + * remove =* and =- from gbc.c package.d + * fix c1value to behave correctly when one value supplied + in cmpmulti.lsp + * change #. and #, to interact correctly when called + after #+ or #- + +Fri Jun 2 20:48:06 1989 Bill Schelter (wfs at rascal) + + * sfasl.c gbc.c change error messages from using stderr + to stdout. Note the first file descriptor the user + opens is typically stderr, so these error messages (which + rarely occurred) did not appear on the screen but rather + caused resetting the file pointer of the user's stream! + +Wed May 31 20:31:04 1989 Bill Schelter (wfs at rascal) + + * package.d,symbol.d, packlib.lsp: Changes + to package hashing and intern. Allow flexibly + sized packages instead of insisting that all + internal and external packages use table with 512 elts. + I recommend a prime number as size. The size of + the internals table is automatically grown when there are 2 x + as many symbols as the table size. + For the byte-reader.im-test file (580K) the read time + went from 24 seconds to 16.8 seconds. (had been 53 seconds). + in-package and make-package take keyword args + :external and :internal to allow specification of the + size of the table for a new package. + +Tue May 30 23:00:46 1989 Bill Schelter (wfs at rascal) + + * fix writing of small and large double floats + in cmpeval.lsp, so that all numbers from smallest + double to largest may be included as constants + in compiled code. + + +Sun May 28 16:22:07 1989 Bill Schelter (wfs at rascal) + + * array.c:array_allocself takes an additional argument, + specifying the default value, or NULL if no initial + value is to be given. + si::make-vector has an additional optional arg of the + default value. + * seqlib also has calls to array_allocself, which take + a 0 final arg, indicating that the initialization + is not to be done. + * array.c: siLcopy_array_portion added, to allow quick copying + from one array to another. + * In top.lsp the *eof* is changed to a local, so as not + to conflict with the si::*eof* which is the value returned + by the system when doing getc. + g + + +Fri May 12 10:57:39 1989 Bill Schelter (wfs at rascal) + + * Add optimization for (type x 'foo) where + foo is a structure. This also affects foo-p. + If you (setq compiler::*frozen-defstructs* t) + this allows the compiler to assume that a given + defstruct will not be extended (by including + it in more structures) by new defstructs loaded + in later files. This can significantly speed + up type checking. + + +Thu May 11 07:43:52 1989 Bill Schelter (wfs at rascal) + + * Fix omission of the extended mul for sun4 in 1.22 + Now a new dependent feature EMUL lets you specify + an assembler file in the o directory, which will + be loaded in at the end. + + * AKCL added to the *features* list. This is + now necessary because of internal differences in structures + between the standard kcl and akcl. + + Structure changes are pretty well complete. + +Wed May 3 12:11:54 1989 Bill Schelter (wfs at rascal) + + * Fix ceiling and floor (num_co.c) by riley + +Mon May 1 08:05:55 1989 Bill Schelter (wfs at rascal) + + * fix to gc of displaced arrays. (bug report + and partial fix by riley). Files gbc.c array.c + undisplace was referrring to possibly freed list + structure. + + * Structures are being completely reworked. + There are two reasons: + + To use much less overhead at compile time of the + original defstruct. + + To allow raw types in defstructs, and allow packing + of these. For example a slot (x 0 :type (mod 50)) will + only require 1 byte. These structs may be made to + coincide with C structs more closely. All ptr or full + fixnum fields will be aligned on a multiple of the size + of ptr however for speed of reference and portability. + + Needless to say recompilation is necessary for most files. + System files affected gbc.c, defstruct.c, predicate.c, print.d + defstruct.lsp cmpfun.lsp cmputil.lsp cmpeval.lsp predlib.lsp + and maybe some other small changes. + + Naturally significant speedups will be gained if one can + keep integers in raw form: + (defstruct ja1 (a #\a :type character)(b 0 :type fixnum)) + (defun joe (x n) (sloop::sloop for i below n do (setf (ja1-b x) i))) + Then (joe (make-ja1) 1000000) takes less than 1 second now, + as opposed to over 50 seconds prior to these changes. + + +Wed Apr 26 11:59:43 1989 Bill Schelter (wfs at rascal) + + * Add message feature for AKCL start up. If unixport/message + exists and unixport/message-suppress does not, then + the file unixport/message will be printed on start up. (top.lsp) + + * make o/akcllib.a, a library containing bcmp .. and other + common functions which are not present in all versions of unix. + The main link puts this after -lc, so that faster implementation + dependent versions will be used if they exist. + +Mon Apr 24 20:28:49 1989 Bill Schelter (wfs at rascal) + + * Change to eliminate char_table.s assembler code. + This change will unfortunately require users to recompile + their object code for use with this system. + + * Fix bug in cmpinline.lsp, which was allowing + (rplacd (cons a b) nil) to give the wrong code. + + * Add timing for gc, and allow have the si::*notify-gbc* + flag cause printing the type of gc. + To time gc's. do (si::gbc-time 0), to set the timer to + 0, (si::gbc-time -1) to reset and turn it off. It + returns an integer in internal time units, similar + to get-internal-run-time. + + * Speed up the lisp reader and intern. On a large file the + read is 2.4 times faster than it was. + + * Many small changes to the include files, to eliminate duplicate + definitions of symbols, (not allowed by some compilers) + and also adding COMM_LENG, which can be null for most compilers + but should be a small integer for the IBM c compiler (it + does not accept external declarations int foo[], so we do + foo[COMM_LENG]; + + +Fri Apr 21 18:13:23 1989 Bill Schelter (wfs at rascal) + + * Fix bug with the new fast read-byte,.... + If the stream argument was supplied, and was not a stream + but rather T or NIL, there was a problem. If you declare + the arg to be of type stream, then you will get identical + code to before; otherwise a typecheck for type stream + will be supplied, branching into the slower code for + non streams. + Files cmpopt.lsp and cmptype.lsp + + +Tue Apr 18 22:56:54 1989 Bill Schelter (wfs at rascal) + + * More changes to read-byte, write-byte, read-char and + write-char. I have removed the :in-file and :out-file + declarations, and the speed up for the undeclared streams + should be virtually the same as obtained with the declarations. + This will affect mainly file streams. Files cmpfun.lsp, + cmpopt.lsp, cmpinclude.h, read.d + + Note that on read-byte it is still advantageous to use an + eof which is a fixnum. + + reads where the eof-error-p arg is not nil are not speeded up. + + It is still the case that two way streams are not speeded up, + however if (si::fp-input-stream str) returns non nil, then + you can use the resulting stream for fast input. + +Thu Apr 13 00:20:11 1989 Bill Schelter (wfs at rascal) + + * fixes to subtypep (as reported by riley) + + * changes to allow faster operation of read-char,write-char, + read-byte and write-byte, when operating on file streams. + In order to use these you should declare the stream + to be :in-file or :out-file. + You can use (typep str :in-file) to + check if it is really valid. + + (defun myread (str) + (declare (:in-file str)) + (the fixnum (read-byte str nil -100))) + + The above changes should work for ansi C style stdio, + in particular for unix io. At the moment it is conditionalized + for +unix. + files: cmpfun.lsp, cmpopt.lsp, cmtype.lsp, file.d, cmpenv.lsp + + The difference in reading speed is substantial: eg 3 microseconds + as opposed to 60 microseconds for read-byte. + + To make your code portable do + (proclaim '(declaration :in-file)) + + In order for the optimizations to cut in, + the read functions must be supplied with 3 args and the + write functions with 2. The second of the read args + must be nil. + Note with read-byte, using an eof value which is a fixnum, + allows you to declare the location you will pass to as a fixnum. + + + +Wed Mar 22 17:19:03 1989 Bill Schelter (wfs at rascal) + + * Change c1fmla-constant in cmpif.lsp. + (if (null 2) x y ) was yielding x not y! + +Sun Mar 19 12:26:21 1989 Bill Schelter (wfs at rascal) + + * fix stream_at_end, so that a stream opened for `io' + does the check, when reading, so that read can + return eof properly. + +Sun Mar 12 01:40:53 1989 Bill Schelter (wfs at rascal) + + * speed up the intern of symbol in pack_hash + computation. + + * psetf bug in case of two args (psetf a 3) + not passing the environment. setf.lsp + + +Fri Feb 24 22:27:22 1989 Bill Schelter (wfs at rascal) + + * add fixes for &environment to allow it to come + anywhere in the lambda list. defmacro.lsp and cmplam + (change from R. Harris). + +Wed Feb 22 17:24:30 1989 Bill Schelter (wfs at rascal) + + * fix tree-equal to save the previous test in list.d + (assoc '(c) '((a b) ((c) d)) :test #'tree-equal) failed. + (by Cooperman) + +Sun Feb 19 17:42:31 1989 Bill Schelter (wfs at rascal) + + * Fix hash_equal in hash.d. It was broken for circular + structures or lists. This would affect sxhash as well + as equal hash tables. + + * Fix obscure bug in compiler in cmptop.lsp, which could + possibly leave out a sup declaration. The c compiler + would catch this. + + * Fix comparison of arrays under equalp in c/predicate.c + It had been broken for rank different from 1. + * Fix the assembler for the sun4 in sun4_chtab.s for + multiply. (bug report by Harris). + +Fri Dec 9 00:47:46 1988 Bill Schelter (wfs at rascal) + + * Made changes to sfasl to make it more portable. + * added structures and characters to the types + handled by fasdump.c + * changed the c stack check in gbc.c to use cs_check. + +Sun Nov 27 12:31:13 1988 Bill Schelter (wfs at rascal) + + * Add si::fp-input-stream, si::fp-output-stream, + Which take one arg a stream, and return a stream + with an strm->sm.sm_fp slot suitable for use with fread and fwrite. + If this is not possible nil is returned. + + +Wed Nov 2 16:09:17 1988 Bill Schelter (wfs at rascal) + + * inline-args fix: + (defun x (c s i) + (declare (optimize (safety 2))) + (declare (fixnum i)) + (setf (char s (setq i (1+ i))) c)) + made c, not just i a fixnum in the char compilation, + fixed in inline-args (by E. Wang) edward@ucbarpa.Berkeley.EDU + file cmpinline.lsp + +Wed Oct 12 17:01:06 1988 Bill Schelter (wfs at rascal) + + * Added new array types: files cmptype,array.c,typespec.c,cmpopt, + predlib.lsp, gbc.c, and maybe some others. + Purpose of the change was to allow programs like CLX which + use lots of numerical arrays, to be much more economical. + Also make-array now coerces the element-type in a reasonable + way, and the same handling is used in the compiler. + + New array element types: + signed-char, unsigned-char, signed-short, unsigned-short + The ranges on a SUN are + ((INTEGER -128 127) (INTEGER 0 255) (INTEGER -32768 32767) + (INTEGER 0 65535)) respectively. + Note that now + make-array will always try to find the `best' array to + accommodate the element-type specified. For example on a SUN + (mod 1) --> bit + (integer 0 10) --> unsigned-char + (integer -3 10) --> signed-char + si::best-array-element-type is the function doing this. It + is also used by the compiler, for coercing array element types. + If you are going to declare an array you should use the same + element type as was used in making it. eg + (setq my-array (make-array 4 :element-type '(integer 0 10))) + (the (array (integer 0 10)) my-array) + + + + .. When wanting to optimize you need to make a reference: + (the fixnum (aref (the (array (integer -3 10)) ar) (the fixnum i))) + if ar were constructed using the (integer -3 10) element-type. + You could of course used signed-char, but since the ranges + may be implementation dependent it is better to use -3 10 range. + make-array needs to do some calculation with the element-type + if you don't provide a primitive data-type. One way of doing + this in a machine independent fashion: + (defvar *my-elt-type* #. (array-element-type (make-array 1 + :element-type '(integer -3 10)))) + Then calls to (make-array n :element-type *my-elt-type*) + will not have to go through a type inclusion computation. + + + +Tue Oct 11 09:52:13 1988 Bill Schelter (wfs at rascal) + + * When using gcc, it could happen that there was + a string in in the init function, which got placed + before the init function. Had to add -fwritable-strings + to stop this. + +Sun Oct 2 13:35:11 1988 Bill Schelter (wfs at rascal) + + * Fix MP386 and att port bugs, introduced with the + new mp386.h, att.h and mp386.defs files. + * Fix unixtime at least for bsd, so that get-internal-real-time + does not wrap every few hours, but will not wrap below 400 days. + * Fix directory problems with compiling in other than the current + directory, in the name of the file specified in the include. + The command on most systems cd 's to the directory to run the + cc, and so the .h file needed to use an unprefixed name. + + +Sat Sep 24 16:02:22 1988 Bill Schelter (wfs at rascal) + + * Changes to the computation of double-float-epsilon + and more generally XX-epsilon. First they did not + satisfy the condition of + (defun fo (e) (not (= (float 1 e) (+ (float 1 e) e)))) + (fo double-float-epsilon) --> t + as per CLtL. As it stands they at least satisfy the + test, although there may be floats slightly smaller which + also do. + + Second on some machines (eg HP) the calculation done + in line, carried more precision than that which would + be normal when passed through eql, so that we changed + the test == in constructing the double float epsilon + to use a function call. Otherwise the epsilon was + ~10^-20 instead of the correct ~10^-16. + +Thu Sep 22 14:08:07 1988 Bill Schelter (wfs at rascal) + + * Fixed hash_equal not to use the cast to int, + in computing hash of a symbol name + since this made sun4's unhappy (file hash.d ). + +Wed Sep 14 12:02:35 1988 Bill Schelter (wfs at rascal) + + * fix to setf to make sure that + (defmacro joe (x) `(progn t (car ,x))) + (defsetf joe rplaca) + work correctly. files changed are assignment.c and setf.lsp + The defsetf'd definition takes precedence in the macroexpansion. + The bad order was introduced when the evaluation of the macros including + their environments was introduced (see below). + +Mon Sep 12 10:09:56 1988 Bill Schelter (wfs at rascal) + + * use varargs.h for bind.c and list.d where + variable length args are passed. We only use + va_arg(ap,object) to access the next arg now. + There are no more indexed references, since that + is less portable. + + * A major change for porting: Each machine type + now has a .h file of its own, and things like alloc.c, + main.c, unixsave.c no longer should be modified for + individual machines. The file config.h is a link + from `your-machine`.h and things like the VSSIZE, + are also specified in that file. There are also + files such as bsd.h , att.h (for system V) which + can be included by the various special machine files. + + * c support for extended_div was added, and will + be used if USE_C_EXTENDED_DIV is defined. The only + function which does not have a C definition on the sun4 + version is extended_mul. Note that the c version + of extended_div is included in big.c rather than earith.c + since the latter is not compiled with the optimize switch. + + * The assembler functions of bitop.c had been being redefined + by macros in gbc.c in an earlier change (this was actually + 4 times faster on a sun3), and now those functions have + dummy definitions, which will go away soon. + +Wed Aug 31 23:38:08 1988 Bill Schelter (wfs at rascal) + + * use varargs for the funlink of proclaimed functions, + This affects cmpcall.lsp, funlink.c and requires + to be included by cmpinclude. + The old variable arg business was not portable to risc + architectures, where args are passed in registers. + + * make print return a value in print.d + Hope there are not more `implicit returns' hidden away. + +Fri Aug 19 15:13:06 1988 Bill Schelter (wfs at rascal) + + * Make (subtypep 'string-char 'character) --> t + +Wed Aug 3 11:33:20 1988 Bill Schelter (wfs at rascal) + + * I have removed the dynamic growing of the special binding + stack which I had added a few months ago (cf bds.h,main.c,bds.c.) + It had ignored + the fact that some functions eg, Levalhook grab a pointer + into the bds rather than just an index. These could easily have + been changed, but until we allow the other stacks to grow + dynamically, it is of questionable value. + +Fri Jul 1 09:41:36 1988 Bill Schelter (wfs at rascal) + + * allow assoc to take key in c/list.d as per mail + 442 23-Jun pc%linus@mitre-bedford.ar KCL Bug: assoc doesn't take :key + + +Wed Jun 15 16:46:40 1988 Bill Schelter (wfs at rascal) + + * Added support for switch construct (see cmpnew/cmptag.lsp + for documentation) + This will allow compiling into the c switch construct + if (the test variable is declared to be a subtype of + fixnum) which can then allow much faster switching on + cases. To do:Should optimize some of case constructs into + switch, where applicable. + +Wed Jun 8 11:43:00 1988 Bill Schelter (wfs at rascal) + + * Altered the marking of the c stack in gbc.c. + Now the current location for the c stack is taken + in a separate function from the one where the environment + is forced onto the stack, so that we don't have to + depend on the c compilers doing things in the expected + order. See mark_stack_carefully. Also added a flag + C_GC_OFFSET which if defined to 2, will mark + the stack twice once on 4m and once on 4m+2. + + * changed the initialization in main.c of bds_org + and bds_limit. + + This is to fit in with the earlier change to + bds_overflow, to allow the bds to grow. bds_org + is now a pointer rather than a hardwired value. + + +Tue Jun 7 04:44:15 1988 Bill Schelter (wfs at rascal) + + * Fix equalp to use the fill-pointer as a limit + when comparing strings,vectors and bitvectors. + + +Mon Jun 6 11:29:08 1988 Bill Schelter (wfs at rascal) + + * Fix rotatef in setf.lsp to return NIL per CLtL + * Fix handling of &rest arg in cmplam.lsp + c2lambda-expr-without-key as per bug fix of Yuasa + 12-Nov yuasa%kurims.kurims.kyoto A bug fix + * Add the fix to quick-sort as per + 67 12-Jan yuasa%tutics.tut.junet%ut Re: sort bug + * Add fix for shadowing-import per + 68 12-Jan yuasa%tutics.tut.junet%ut Re: SHADOWING-IMPORT doesn't + * Fix (random 0) bug, adding TSpositive_number type. as per + 69 12-Jan yuasa%.. Re: (random 0) => losing error message + * Fix (make-array 2 0) bug per + 70 13-Jan yuasa%tutics.tut.junet%ut Re: Nil is a sequence + * Add bogus value (*READ-DEFAULT-FLOAT-FORMAT* t) when + printing a float in a compiled file, so that it will always + add the type in the printing, and we won't get a float + type different from that used at compile time + cf. 80 28-Jan yuasa%tutics.tut.junet%ut Re: float numbers + * Add fix for bug + setf (aref x (decf i)) (aref x 1)) -> + "base[2]= aset1(base[0],V1,fix(base[1]));" + to cmpinline.lsp, as per + 92 8-Feb yuasa%tutics.tut.junet%ut Re: compiler bug? + *All fixes by yuasa in the kcl-mail-archive thru Jun 88 + are now incorporated in akcl + * Altered cmp-macroexpand-1 to use the local macro environment + + + + +Wed Jun 1 13:29:57 1988 Bill Schelter (wfs at rascal) + + * Altered macros.c to pass the function-macro environment + if it is non nil. This is needed so that macro expansion + functions can be called in the correct environment. + Altered cmputil.lsp so that cmp-macroexpand and cmp-macro-expand + both use the current compiler macro environment. + Finally altered setf, so that it looks at the macro + environment when it expands the place. + + Deleted treatment of setf as special form by the compiler, + (introduced yesterday!) + now that macros are handled correctly, and it is defined + correctly as a macro. + + Things like + (macrolet ((ab nil 'a)) (setf (the fixnum (ab)) 3)) + Now work to give (set 'a (the fixnum 3)) as expected. + + + +Mon May 30 11:40:47 1988 Bill Schelter (wfs at rascal) + + * Altered setf to macroexpand the place in the current + lexical environment so that + (macrolet ((joe nil 'bil))(setf (joe) n)) + would behave correctly. This change was in assignment.c + in `setf' and also in cmputils.lsp adding c1setf, to + get analagous treatment for compiler. + To do: + It is still not totally correct: I don't handle + (macrolet ((joe nil 'bil))(setf (the fixnum (joe)) n)) + but + (macrolet ((joe nil '(the fixnum bil)))(setf (joe) n)) + is ok. + +Tue May 24 09:38:58 1988 Bill Schelter (wfs at rascal) + + * Changed float to return single-float if given only one + arg, as per CLtL. + + * Added a dynamic growth feature the bds stack, changing + bds_org to be a variable rather than a macro, and altering + bds_overflow. + + *Enforce substantial constraints on downward closures ,to be relaxed + at a future date: Currently no args, and no cross references + to other types of closures. This is done in check-downward + in t1defun. + + + + + + + + diff --git a/o/NeXTunixfasl.c b/o/NeXTunixfasl.c new file mode 100755 index 0000000..4503172 --- /dev/null +++ b/o/NeXTunixfasl.c @@ -0,0 +1,469 @@ +/* + * FASL loader using rld() for NeXT + * + * Written by Noritake YONEZAWA (yonezawa@lsi.tmg.nec.co.jp) + * February 14, 1992 + * + * Modified by Noritake YONEZAWA (yonezawa@lsi.tmg.nec.co.jp) + * May 1, 1995 + * June 5, 1995 + * June 6, 1995 + */ + +#include +#include +#include + +#include +#include +#include +#include +#include + +static unsigned long object_size, object_start; + +static unsigned long +my_address_func(size, headers_size) + unsigned long size; + unsigned long headers_size; +{ + return (object_start = + (unsigned long)alloc_contblock(object_size = size + headers_size)); +} + +static void +load_mach_o(filename) + char *filename; +{ + FILE *fp; + struct mach_header header; + char *hdrbuf; + struct load_command *load_command; + struct segment_command *segment_command; + struct section *section; + int len, cmd, seg; + + if ((fp = fopen(filename, "r")) == NULL) + FEerror("Can't read Mach-O object file", 0); + len = fread((char *)&header, sizeof(struct mach_header), 1, fp); + if (len == 1 && header.magic == MH_MAGIC) { + hdrbuf = (char *)malloc(header.sizeofcmds); + len = fread(hdrbuf, header.sizeofcmds, 1, fp); + if (len != 1) + FEerror("failure reading Mach-O load commands", 0); + load_command = (struct load_command *) hdrbuf; + for (cmd = 0; cmd < header.ncmds; ++cmd) { + if (load_command->cmd == LC_SEGMENT) { + segment_command = (struct segment_command *) load_command; + section = (struct section *) ((char *)(segment_command + 1)); + for (seg = 0; seg < segment_command->nsects; ++seg, ++section) { + if (section->size != 0 && section->offset != 0) { +#ifdef DEBUG + fprintf(stderr, "section: %s, addr: 0x%08x, size: %d\n", + section->sectname, section->addr, section->size); + fflush(stderr); +#endif + fseek(fp, section->offset, 0); + fread((char *)section->addr, section->size, 1, fp); + } + } + } + load_command = (struct load_command *) + ((char *)load_command + load_command->cmdsize); + } + free(hdrbuf); + } + (void)fclose(fp); +} + +int +seek_to_end_ofile(fp) + FILE *fp; +{ + struct mach_header mach_header; + char *hdrbuf; + struct load_command *load_command; + struct segment_command *segment_command; + struct section *section; + struct symtab_command *symtab_command; + struct symseg_command *symseg_command; + int len, cmd, seg; + int end_sec, end_ofile; + + end_ofile = 0; + fseek(fp, 0L, 0); + len = fread((char *)&mach_header, sizeof(struct mach_header), 1, fp); + if (len == 1 && mach_header.magic == MH_MAGIC) { + hdrbuf = (char *)malloc(mach_header.sizeofcmds); + len = fread(hdrbuf, mach_header.sizeofcmds, 1, fp); + if (len != 1) { + fprintf(stderr, "seek_to_end_ofile(): failure reading Mach-O load commands\n"); + return 0; + } + load_command = (struct load_command *) hdrbuf; + for (cmd = 0; cmd < mach_header.ncmds; ++cmd) { + switch (load_command->cmd) { + case LC_SEGMENT: + segment_command = (struct segment_command *) load_command; + section = (struct section *) ((char *)(segment_command + 1)); + for (seg = 0; seg < segment_command->nsects; ++seg, ++section) { + end_sec = section->offset + section->size; + if (end_sec > end_ofile) + end_ofile = end_sec; + } + break; + case LC_SYMTAB: + symtab_command = (struct symtab_command *) load_command; + end_sec = symtab_command->symoff + symtab_command->nsyms * sizeof(struct nlist); + if (end_sec > end_ofile) + end_ofile = end_sec; + end_sec = symtab_command->stroff + symtab_command->strsize; + if (end_sec > end_ofile) + end_ofile = end_sec; + break; + case LC_SYMSEG: + symseg_command = (struct symseg_command *) load_command; + end_sec = symseg_command->offset + symseg_command->size; + if (end_sec > end_ofile) + end_ofile = end_sec; + break; + } + load_command = (struct load_command *) + ((char *)load_command + load_command->cmdsize); + } + free(hdrbuf); + fseek(fp, end_ofile, 0); + return 1; + } + return 0; +} + +static char *library_search_path[] = +{"/lib", "/usr/lib", "/usr/local/lib", NULL}; + +#define strdup(string) strcpy((char *)malloc(strlen(string)+1),(string)) + +static char * +expand_library_filename(filename) + char *filename; +{ + int fd; + char **dir; + char libname[256]; + char fullname[256]; + + if (filename[0] == '-' && filename[1] == 'l') { + filename++; + filename++; + strcpy(libname, "lib"); + strcat(libname, filename); + strcat(libname, ".a"); + for (dir = library_search_path; *dir; dir++) { + strcpy(fullname, *dir); + strcat(fullname, "/"); + strcat(fullname, libname); +#ifdef DEBUG + fprintf(stderr, "%s\n", fullname); + fflush(stderr); +#endif + if ((fd = open(fullname, O_RDONLY, 0)) > 0) { + close(fd); + return (strdup(fullname)); + } + } + return (strdup(libname)); + } + return (strdup(filename)); +} + +static char ** +make_ofile_list(faslfile, argstr) + char *faslfile, *argstr; +{ + char filename[256]; + char *dst; + int i; + char **ofile_list; + + ofile_list = (char **)calloc(1, sizeof(char *)); + ofile_list[0] = strdup(faslfile); + i = 1; + if (argstr != NULL) { + for (;; i++) { + while ((*argstr == ' ') && (*argstr != '\0')) + argstr++; + if (*argstr == '\0') + break; + dst = filename; + while ((*argstr != ' ') && (*argstr != '\0')) + *dst++ = *argstr++; + *dst = '\0'; + ofile_list = (char **)realloc((void *)ofile_list, + (i + 1) * sizeof(char *)); + ofile_list[i] = expand_library_filename(filename); + } + } + ofile_list = (char **)realloc((void *)ofile_list, (i + 1) * sizeof(char *)); + ofile_list[i] = NULL; + return (ofile_list); +} + +static void +free_ofile_list(ofile_list) + char **ofile_list; +{ + int i; + + for (i = 1;; i++) { + if (ofile_list[i] == NULL) + break; + (void)free(ofile_list[i]); + } + (void)free(ofile_list); +} + +#ifdef DEBUG +static void +print_ofile_list(ofile_list) + char **ofile_list; +{ + int i; + + if (ofile_list == NULL) + return; + fprintf(stderr, "ofiles: "); + for (i = 0;; i++) { + if (ofile_list[i] == NULL) + break; + fprintf(stderr, "(%s)", ofile_list[i]); + } + fprintf(stderr, "\n"); + fflush(stderr); +} + +#endif + +int +fasload(pathname) + object pathname; +{ + FILE *fp; + object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + object memory; + object fasl_data; + object stream; + char entryname[100]; + char filename[256]; + char tempfilename[40]; + char **ofiles; + NXStream *err_stream; + void (*entry) (); + struct mach_header *hdr; + + stream = open_stream(pathname, smm_input, Cnil, sKerror); + fp = stream->sm.sm_fp; + + seek_to_end_ofile(fp); + fasl_data = read_fasl_vector(stream); + vs_push(fasl_data); + + pathname = coerce_to_pathname(stream); + coerce_to_filename(stream, filename); + + if ((err_stream = NXOpenFile(fileno(stderr), NX_WRITEONLY)) == 0) + FEerror("NXOpenFile() failed", 0); + + sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); + rld_address_func(my_address_func); + ofiles = make_ofile_list(filename, NULL); +#ifdef DEBUG + print_ofile_list(ofiles); +#endif + if (!rld_load(err_stream, &hdr, ofiles, tempfilename)) { + free_ofile_list(ofiles); + NXFlush(err_stream); + NXClose(err_stream); + FEerror("rld_load() failed", 0); + } + free_ofile_list(ofiles); + load_mach_o(tempfilename); + unlink(tempfilename); + + strcpy(entryname, "_init_code"); + if (!rld_lookup(err_stream, entryname, (unsigned long *)&entry)) { + strcpy(entryname, "_init_"); + bcopy(pathname->pn.pn_name->st.st_self, + entryname + 6, pathname->pn.pn_name->st.st_fillp); + entryname[6 + pathname->pn.pn_name->st.st_fillp] = 0; + if (!rld_lookup(err_stream, entryname, (unsigned long *)&entry)) { + NXFlush(err_stream); + NXClose(err_stream); + FEerror("Can't find init code", 0); + } + } + (void)rld_unload_all(err_stream, 0); + NXFlush(err_stream); + NXClose(err_stream); + + +#ifdef DEBUG + { + extern char *mach_brkpt, *mach_maplimit, *core_end; + + fprintf(stderr, "mach_brkpt : 0x%08x\n", mach_brkpt); + fprintf(stderr, "mach_maplimit : 0x%08x\n", mach_maplimit); + fprintf(stderr, "core_end : 0x%08x\n", core_end); + fprintf(stderr, "hdr : 0x%08x\n", hdr); + fprintf(stderr, "object_start : 0x%08x\n", object_start); + fprintf(stderr, "object_size : %d\n", object_size); + fprintf(stderr, "&%s : 0x%08x\n", entryname, entry); + fflush(stderr); + } +#endif + + memory = alloc_object(t_cfdata); + memory->cfd.cfd_self = 0; + memory->cfd.cfd_fillp = 0; + memory->cfd.cfd_size = object_size; + memory->cfd.cfd_start = (char *)object_start; + vs_push(memory); + +#ifdef CLEAR_CACHE + CLEAR_CACHE; +#endif + call_init(entry - object_start, memory, fasl_data,0); + + if (symbol_value(sLAload_verboseA) != Cnil) + printf("start address -T 0x%08x ", entry); + + vs_base = old_vs_base; + vs_top = old_vs_top; + close_stream(stream); + return object_size; +} + +int +faslink(pathname, ldargstring) + object pathname, ldargstring; +{ + FILE *fp; + object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + object memory; + object fasl_data; + object stream; + char entryname[100]; + char filename[256]; + char ldargstr[256]; + char tempfilename[40]; + char **ofiles; + NXStream *err_stream; + void (*entry) (); + struct mach_header *hdr; + + stream = open_stream(pathname, smm_input, Cnil, sKerror); + fp = stream->sm.sm_fp; + + seek_to_end_ofile(fp); + fasl_data = read_fasl_vector(stream); + vs_push(fasl_data); + + pathname = coerce_to_pathname(stream); + coerce_to_filename(stream, filename); + coerce_to_filename(ldargstring, ldargstr); + + if ((err_stream = NXOpenFile(fileno(stderr), NX_WRITEONLY)) == 0) + FEerror("NXOpenFile() failed", 0); + + sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); + rld_address_func(my_address_func); + ofiles = make_ofile_list(filename, ldargstr); +#ifdef DEBUG + print_ofile_list(ofiles); +#endif + if (!rld_load(err_stream, &hdr, ofiles, tempfilename)) { + free_ofile_list(ofiles); + NXFlush(err_stream); + NXClose(err_stream); + FEerror("rld_load() failed", 0); + } + free_ofile_list(ofiles); + load_mach_o(tempfilename); + unlink(tempfilename); + + strcpy(entryname, "_init_code"); + if (!rld_lookup(err_stream, entryname, (unsigned long *)&entry)) { + strcpy(entryname, "_init_"); + bcopy(pathname->pn.pn_name->st.st_self, + entryname + 6, pathname->pn.pn_name->st.st_fillp); + entryname[6 + pathname->pn.pn_name->st.st_fillp] = 0; + if (!rld_lookup(err_stream, entryname, (unsigned long *)&entry)) { + NXFlush(err_stream); + NXClose(err_stream); + FEerror("Can't find init code", 0); + } + } + (void)rld_unload_all(err_stream, 0); + NXFlush(err_stream); + NXClose(err_stream); + + +#ifdef DEBUG + { + extern char *mach_brkpt, *mach_maplimit, *core_end; + + fprintf(stderr, "mach_brkpt : 0x%08x\n", mach_brkpt); + fprintf(stderr, "mach_maplimit : 0x%08x\n", mach_maplimit); + fprintf(stderr, "core_end : 0x%08x\n", core_end); + fprintf(stderr, "hdr : 0x%08x\n", hdr); + fprintf(stderr, "object_start : 0x%08x\n", object_start); + fprintf(stderr, "object_size : %d\n", object_size); + fprintf(stderr, "&%s : 0x%08x\n", entryname, entry); + fflush(stderr); + } +#endif + + memory = alloc_object(t_cfdata); + memory->cfd.cfd_self = 0; + memory->cfd.cfd_fillp = 0; + memory->cfd.cfd_size = object_size; + memory->cfd.cfd_start = (char *)object_start; + vs_push(memory); + +#ifdef CLEAR_CACHE + CLEAR_CACHE; +#endif + call_init(entry - object_start, memory, fasl_data,0); + + if (symbol_value(sLAload_verboseA) != Cnil) + printf("start address -T 0x%08x \n", entry); + + vs_base = old_vs_base; + vs_top = old_vs_top; + close_stream(stream); + return object_size; +} + +siLfaslink() +{ + bds_ptr old_bds_top; + int i; + object package; + + check_arg(2); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + check_type_string(&vs_base[1]); + vs_base[0] = coerce_to_pathname(vs_base[0]); + vs_base[0]->pn.pn_type = FASL_string; + vs_base[0] = namestring(vs_base[0]); + package = symbol_value(sLApackageA); + old_bds_top = bds_top; + bds_bind(sLApackageA, package); + i = faslink(vs_base[0], vs_base[1]); + bds_unwind(old_bds_top); + vs_top = vs_base; + vs_push(make_fixnum(i)); +} + +#define FASLINK diff --git a/o/NeXTunixsave.c b/o/NeXTunixsave.c new file mode 100755 index 0000000..dde9ed0 --- /dev/null +++ b/o/NeXTunixsave.c @@ -0,0 +1,499 @@ +/* + * unexec for the NeXT Mach environment. + * + * Bradley Taylor (btaylor@NeXT.COM) + * February 28, 1990 + * + * Modified by Noritake YONEZAWA (yonezawa@cs.uiuc.edu) + * July 28, 1991 + * + * Modified by Noritake YONEZAWA (yonezawa@lsi.tmg.nec.co.jp) + * February 16, 1992 + * + * Modified by Noritake YONEZAWA (yonezawa@lsi.tmg.nec.co.jp) + * May 1, 1995 + */ +#undef __STRICT_BSD__ + +#include +#include +#include +#include +#include +#include +#include + +#define CEIL(x,quantum) ((((int)(x))+(quantum)-1)&~((quantum)-1)) + +#ifndef BIG_HEAP_SIZE +#define BIG_HEAP_SIZE 0x1000000 +#endif + +int big_heap = BIG_HEAP_SIZE; + +char *mach_maplimit = 0; +char *mach_brkpt = 0; + + +typedef struct region_t { + vm_address_t address; + vm_size_t size; + vm_prot_t protection; + vm_prot_t max_protection; + vm_inherit_t inheritance; + boolean_t shared; + port_t object_name; + vm_offset_t offset; +} region_t; + +char * +my_sbrk(incr) + int incr; +{ + char *temp, *ptr; + kern_return_t rtn; + + if (mach_brkpt == 0) { + if ((rtn = vm_allocate(task_self(), (vm_address_t *) & mach_brkpt, + big_heap, 1)) != KERN_SUCCESS) { + mach_error("my_sbrk(): vm_allocate() failed", rtn); + return ((char *)-1); + } + mach_maplimit = mach_brkpt + big_heap; + } + if (incr == 0) { + return (mach_brkpt); + } else { + ptr = mach_brkpt + incr; + if (ptr <= mach_maplimit) { + temp = mach_brkpt; + mach_brkpt = ptr; + return (temp); + } else { + fprintf(stderr, "my_sbrk(): no more memory\n"); + fflush(stderr); + return ((char *)-1); + } + } +} + +static void +grow( + struct load_command ***the_commands, + unsigned *the_commands_len + ) +{ + if (*the_commands == NULL) { + *the_commands_len = 1; + *the_commands = malloc(sizeof(*the_commands)); + } else { + (*the_commands_len)++; + *the_commands = realloc(*the_commands, + (*the_commands_len * + sizeof(**the_commands))); + } +} + + +static void +save_command( + struct load_command *command, + struct load_command ***the_commands, + unsigned *the_commands_len + ) +{ + struct load_command **tmp; + + grow(the_commands, the_commands_len); + tmp = &(*the_commands)[*the_commands_len - 1]; + *tmp = malloc(command->cmdsize); + bcopy(command, *tmp, command->cmdsize); +} + +static void +fatal_unexec(char *format) +{ + fprintf(stderr, "unexec: "); + fprintf(stderr, format); + fprintf(stderr, "\n"); +} + +static void +fatal_unexec2( + char *format, + char *arg1 + ) +{ + fprintf(stderr, "unexec: "); + fprintf(stderr, format, arg1); + fprintf(stderr, "\n"); +} + +static void +fatal_unexec3( + char *format, + char *arg1, + char *arg2 + ) +{ + fprintf(stderr, "unexec: "); + fprintf(stderr, format, arg1, arg2); + fprintf(stderr, "\n"); +} + +static int +read_macho( + int fd, + struct mach_header *the_header, + struct load_command ***the_commands, + unsigned *the_commands_len + ) +{ + struct load_command command; + struct load_command *buf; + int i; + int size; + + if (read(fd, the_header, sizeof(*the_header)) != sizeof(*the_header)) { + fatal_unexec("cannot read macho header"); + return (0); + } + for (i = 0; i < the_header->ncmds; i++) { + if (read(fd, &command, sizeof(struct load_command)) != + sizeof(struct load_command)) { + fatal_unexec("cannot read macho load command header"); + return (0); + } + size = command.cmdsize - sizeof(struct load_command); + if (size < 0) { + fatal_unexec("bogus load command size"); + return (0); + } + buf = malloc(command.cmdsize); + buf->cmd = command.cmd; + buf->cmdsize = command.cmdsize; + if (read(fd, ((char *)buf + + sizeof(struct load_command)), + size) != size) { + fatal_unexec("cannot read load command data"); + return (0); + } + save_command(buf, the_commands, the_commands_len); + } + return (1); +} + +static int +filldatagap( + vm_address_t start_address, + vm_size_t *size, + vm_address_t end_address + ) +{ + vm_address_t address; + vm_size_t gapsize; + + address = (start_address + *size); + gapsize = end_address - address; + *size += gapsize; + if (vm_allocate(task_self(), &address, gapsize, + FALSE) != KERN_SUCCESS) { + fatal_unexec("cannot vm_allocate"); + return (0); + } + return (1); +} + +static int +get_data_region( + vm_address_t *address, + vm_size_t *size + ) +{ + region_t region; + kern_return_t ret; + struct section *sect; + + sect = getsectbyname(SEG_DATA, SECT_DATA); + region.address = 0; + *address = 0; + for (;;) { + ret = vm_region(task_self(), + ®ion.address, + ®ion.size, + ®ion.protection, + ®ion.max_protection, + ®ion.inheritance, + ®ion.shared, + ®ion.object_name, + ®ion.offset); + if (ret != KERN_SUCCESS || region.address >= mach_maplimit) { + break; + } + if (*address != 0) { + if (region.address > *address + *size) { + if (!filldatagap(*address, size, + region.address)) { + return (0); + } + } + *size += region.size; + } else { + if (region.address == sect->addr) { + *address = region.address; + *size = region.size; + } + } + region.address += region.size; + } + return (1); +} + +static char * +my_malloc( + vm_size_t size + ) +{ + vm_address_t address; + + if (vm_allocate(task_self(), &address, size, TRUE) != KERN_SUCCESS) { + return (NULL); + } + return ((char *)address); +} + +static void +my_free( + char *buf, + vm_size_t size + ) +{ + vm_deallocate(task_self(), (vm_address_t)buf, size); +} + +static int +unexec_doit( + int infd, + int outfd + ) +{ + int i; + struct load_command **the_commands = NULL; + unsigned the_commands_len; + struct mach_header the_header; + int fgrowth; + int fdatastart; + int fdatasize; + int size; + int seg; + struct stat st; + char *buf; + vm_address_t data_address; + vm_size_t data_size, bss_size; + + struct segment_command *segment; + struct section *section; + + if (!read_macho(infd, &the_header, &the_commands, &the_commands_len)) { + return (0); + } + + if (!get_data_region(&data_address, &data_size)) { + return (0); + } + + /* + * DO NOT USE MALLOC IN THIS SECTION + */ + { + /* + * Fix offsets + */ + for (i = 0; i < the_commands_len; i++) { + switch (the_commands[i]->cmd) { + case LC_SEGMENT: + segment = ((struct segment_command *) + the_commands[i]); + if (strcmp(segment->segname, SEG_DATA) == 0) { +/* + data_address = segment->vmaddr; +*/ + data_size = CEIL(mach_brkpt - data_address, getpagesize()); + bss_size = mach_maplimit - mach_brkpt; + fdatastart = segment->fileoff; + fdatasize = segment->filesize; + fgrowth = (data_size - + segment->filesize); + segment->vmsize = data_size + bss_size; + segment->filesize = data_size; + + section = (struct section *) ((char *) (segment + 1)); + for (seg = 0; seg < segment->nsects; ++seg, ++section) { + if (strcmp(section->sectname, SECT_DATA) == 0) { + section->size = data_size; + } + else if (strcmp(section->sectname, SECT_BSS) == 0) { + section->addr = data_address + data_size; + section->size = bss_size; + section->flags = S_ZEROFILL; + } + else if (strcmp(section->sectname, SECT_COMMON) == 0) { + section->addr = data_address + data_size + bss_size; + } + } + } + if (strcmp(segment->segname, SEG_LINKEDIT) == 0) { + segment->vmaddr += CEIL(fgrowth + bss_size, getpagesize()); + segment->fileoff += fgrowth; + } + break; + case LC_SYMTAB: + ((struct symtab_command *) + the_commands[i])->symoff += fgrowth; + ((struct symtab_command *) + the_commands[i])->stroff += fgrowth; + break; + case LC_SYMSEG: + ((struct symseg_command *) + the_commands[i])->offset += fgrowth; + break; + default: + break; + } + } + + /* + * Write header + */ + if (write(outfd, &the_header, + sizeof(the_header)) != sizeof(the_header)) { + fatal_unexec("cannot write header"); + return (0); + } + + /* + * Write commands + */ + for (i = 0; i < the_commands_len; i++) { + if (write(outfd, the_commands[i], + the_commands[i]->cmdsize) != + the_commands[i]->cmdsize) { + fatal_unexec("cannot write commands"); + return (0); + } + } + + /* + * Write original text + */ + if (lseek(infd, the_header.sizeofcmds + sizeof(the_header), + L_SET) < 0) { + fatal_unexec("cannot seek input file"); + return (0); + } + size = fdatastart - (sizeof(the_header) + + the_header.sizeofcmds); + buf = my_malloc(size); + if (read(infd, buf, size) != size) { + my_free(buf, size); + fatal_unexec("cannot read input file"); + } + if (write(outfd, buf, size) != size) { + my_free(buf, size); + fatal_unexec("cannot write original text"); + return (0); + } + my_free(buf, size); + + + /* + * Write new data + */ + if (write(outfd, (char *)data_address, + data_size) != data_size) { + fatal_unexec("cannot write new data"); + return (0); + } + + } + + /* + * OKAY TO USE MALLOC NOW + */ + + /* + * Write rest of file + */ + fstat(infd, &st); + if (lseek(infd, fdatasize, L_INCR) < 0) { + fatal_unexec("cannot seek input file"); + return (0); + } + size = st.st_size - lseek(infd, 0, L_INCR); + + buf = malloc(size); + if (read(infd, buf, size) != size) { + free(buf); + fatal_unexec("cannot read input file"); + return (0); + } + if (write(outfd, buf, size) != size) { + free(buf); + fatal_unexec("cannot write reset of file"); + return (0); + } + free(buf); + return (1); +} + +void +unexec( + char *outfile, + char *infile, + int dummy1, + int dummy2, + int dummy3 + ) +{ + int infd; + int outfd; + char tmpbuf[L_tmpnam]; + char *tmpfile; + + infd = open(infile, O_RDONLY, 0); + if (infd < 0) { + fatal_unexec2("cannot open input file `%s'", infile); + exit(1); + } + + tmpnam(tmpbuf); + tmpfile = rindex(tmpbuf, '/'); + if (tmpfile == NULL) { + tmpfile = tmpbuf; + } else { + tmpfile++; + } + outfd = open(tmpfile, O_WRONLY|O_TRUNC|O_CREAT, 0755); + if (outfd < 0) { + close(infd); + fatal_unexec2("cannot open tmp file `%s'", tmpfile); + exit(1); + } + if (!unexec_doit(infd, outfd)) { + close(infd); + close(outfd); + unlink(tmpfile); + exit(1); + } + close(infd); + close(outfd); + if (rename(tmpfile, outfile) < 0) { + unlink(tmpfile); + fatal_unexec3("cannot rename `%s' to `%s'", tmpfile, outfile); + exit(1); + } +} + +#ifdef UNIXSAVE +#include "save.c" +#endif diff --git a/o/Vmalloc.c b/o/Vmalloc.c new file mode 100755 index 0000000..19caff2 --- /dev/null +++ b/o/Vmalloc.c @@ -0,0 +1,101 @@ +Changes file for /usr/local/src/kcl/c/malloc.c +Created on Tue Oct 24 20:01:59 1989 +Usage \n@s[Original text\n@s|Replacement Text\n@s] +See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c +for a program to merge change files. Anything not between +"\n@s[" and "\n@s]" is a simply a comment. +This file was constructed using emacs and merge.el +Enhancements Copyright (c) W. Schelter All rights reserved. + by (Bill Schelter) wfs@carl.ma.utexas.edu + + +****Change:(orig (131 131 c)) +@s[ * if the power of 2 is correct. + */ + + +@s| * if the power of 2 is correct. + */ +/* Oct 89: wfs@cs.utexas.edu: Created V/ merge file for + * changes for GCL. + * Calls to sbrk replaced by alloc_page. Remove some of the + * additions for emacs. + * NB: According to the gnu license you may only distribute the + * verbatim copy of the gnumalloc.c. Thus we only distribute + * an abbreviated diffs file from that verbatim copy. +*/ + +@s] + + +****Change:(orig (162 162 c)) +@s[#include "getpagesize.h" + +@s|#define getpagesize() 2048 + +@s] + + +****Change:(orig (170 170 c)) +@s[#include + +@s|/* #include */ + +@s] + + +****Change:(orig (202 202 a)) +@s[static char *data_space_start; + + +@s|static char *data_space_start; + +#define PAGEWIDTH 11 +char *alloc_page(); +#define sbrk our_sbrk +char * +our_sbrk(x) +int x; +{return alloc_page((x >> PAGEWIDTH));} + + + + + +@s] + + +****Change:(orig (338 378 d)) +@s[#ifndef VMS + /* Maximum virtual memory on VMS is difficult to calculate since it + * depends on several dynmacially changing things. Also, alignment + * isn't that important. That is why much of the code here is ifdef'ed + +@s, sbrk (1024 - ((int) cp & 0x3ff)); +#endif /* not VMS */ + + +@s| +@s] + + +****Change:(orig (385 385 c)) +@s[ if ((cp = sbrk (1 << (siz + 3))) == (char *) -1) + +@s| if ((cp = sbrk (1 << (siz + 3)))==0) + +@s] + + +****Change:(orig (387 393 d)) +@s[#ifndef VMS + if ((int) cp & 7) + { /* shouldn't happen, but just in case */ + cp = (char *) (((int) cp + 8) & ~7); + +@s, } +#endif /* not VMS */ + +@s| +@s] + diff --git a/o/alloc.c b/o/alloc.c new file mode 100644 index 0000000..1e1350a --- /dev/null +++ b/o/alloc.c @@ -0,0 +1,1785 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + alloc.c + IMPLEMENTATION-DEPENDENT +*/ + +#include +#include +#include + +#include "include.h" +#include "page.h" + +#ifdef HAVE_MPROTECT +#include +#endif + +static int +t_from_type(object); + +#include "pool.h" + + +DEFVAR("*AFTER-GBC-HOOK*",sSAafter_gbc_hookA,SI,sLnil,""); +DEFVAR("*IGNORE-MAXIMUM-PAGES*",sSAignore_maximum_pagesA,SI,sLt,""); +#define IGNORE_MAX_PAGES (sSAignore_maximum_pagesA ==0 || sSAignore_maximum_pagesA->s.s_dbind !=sLnil) + +static void call_after_gbc_hook(int t); + +#ifdef DEBUG_SBRK +int debug; +char * +sbrk1(n) + int n; +{char *ans; + if (debug){ + printf("\n{sbrk(%d)",n); + fflush(stdout);} + ans= (char *)sbrk(n); + if (debug){ + printf("->[0x%x]", ans); + fflush(stdout); + printf("core_end=0x%x,sbrk(0)=0x%x}",core_end,sbrk(0)); + fflush(stdout);} + return ans; +} +#define sbrk sbrk1 +#endif /* DEBUG_SBRK */ + +long starting_hole_div=10; +long starting_relb_heap_mult=2; +long resv_pages=0; + +#ifdef BSD +#include +#include +#ifdef RLIMIT_STACK +struct rlimit data_rlimit; +#endif +#endif + +static inline void * +bsearchleq(void *i,void *v1,size_t n,size_t s,int (*c)(const void *,const void *)) { + + ufixnum nn=n>>1; + void *v=v1+nn*s; + int j=c(i,v); + + if (nn) + return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c)); + else + return j<=0 ? v : v+s; + +} + + +object contblock_array=Cnil; + +static inline void +expand_contblock_array(void) { + + if (contblock_array==Cnil) { + contblock_array=fSmake_vector1_2(16,aet_fix,Cnil,make_fixnum(0)); + contblock_array->v.v_self[0]=(object)&cb_pointer; + enter_mark_origin(&contblock_array); + } + + if (contblock_array->v.v_fillp==contblock_array->v.v_dim) { + + void *v=alloc_relblock(2*contblock_array->v.v_dim*sizeof(fixnum)); + + memcpy(v,contblock_array->v.v_self,contblock_array->v.v_dim*sizeof(fixnum)); + contblock_array->v.v_self=v; + contblock_array->v.v_dim*=2; + + } + +} + +static void +contblock_array_push(void *p) { + + expand_contblock_array(); + contblock_array->v.v_self[contblock_array->v.v_fillp]=p; + contblock_array->v.v_fillp++; + +} + +static inline int +acomp(const void *v1,const void *v2) { + + void *p1=*(void * const *)v1,*p2=*(void * const *)v2; + + return p1v.v_self,contblock_array->v.v_fillp,sizeof(*contblock_array->v.v_self),acomp); + struct pageinfo *p=(void *)pp>(void *)contblock_array->v.v_self ? pp[-1] : NULL; + + return p && (void *)p+p->in_use*PAGESIZE>x ? p : NULL; + +} + +static inline void +add_page_to_contblock_list(void *p,fixnum m) { + + struct pageinfo *pp=pageinfo(p); + + bzero(pp,sizeof(*pp)); + pp->type=t_contiguous; + pp->in_use=m; + massert(pp->in_use==m); + pp->magic=PAGE_MAGIC; + + contblock_array_push(p); + + bzero(pagetochar(page(pp)),CB_DATA_START(pp)-(void *)pagetochar(page(pp))); +#ifdef SGC + if (sgc_enabled && tm_table[t_contiguous].tm_sgc) { + memset(CB_SGCF_START(pp),-1,CB_DATA_START(pp)-CB_SGCF_START(pp)); + pp->sgc_flags=SGC_PAGE_FLAG; + } +#endif + + ncbpage+=m; + insert_contblock(CB_DATA_START(pp),CB_DATA_END(pp)-CB_DATA_START(pp)); + +} + +int +icomp(const void *v1,const void *v2) { + const fixnum *f1=v1,*f2=v2; + return *f1<*f2 ? -1 : *f1==*f2 ? 0 : +1; +} + + +void +add_page_to_freelist(char *p, struct typemanager *tm) { + + short t,size; + long fw; + object x,xe,f; + struct pageinfo *pp; + + t=tm->tm_type; + + size=tm->tm_size; + pp=pageinfo(p); + bzero(pp,sizeof(*pp)); + pp->type=t; + pp->magic=PAGE_MAGIC; + + if (cell_list_head==NULL) + cell_list_tail=cell_list_head=pp; + else if (pp > cell_list_tail) { + cell_list_tail->next=pp; + cell_list_tail=pp; + } + + x= (object)pagetochar(page(p)); + /* set_type_of(x,t); */ + make_free(x); + +#ifdef SGC + + if (sgc_enabled && tm->tm_sgc) + pp->sgc_flags=SGC_PAGE_FLAG; + +#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pp->type)) + x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; +#endif + + /* array headers must be always writable, since a write to the + body does not touch the header. It may be desirable if there + are many arrays in a system to make the headers not writable, + but just SGC_TOUCH the header each time you write to it. this + is what is done with t_structure */ + if (t==(tm_of(t_array)->tm_type)) + pp->sgc_flags|=SGC_PERM_WRITABLE; + +#endif + + f=FREELIST_TAIL(tm); + fw=x->fw; + xe=(object)((void *)x+tm->tm_nppage*size); + for (;xfw=fw; + SET_LINK(f,x); + } + + SET_LINK(f,OBJNULL); + tm->tm_tail=f; + tm->tm_nfree+=tm->tm_nppage; + tm->tm_npage++; + +} + +static inline void +maybe_reallocate_page(struct typemanager *ntm,ufixnum count) { + + void **y,**n; + fixnum *pp,*pp1,*ppe,yp; + struct typemanager *tm; + fixnum i,j,e[t_end]; + struct pageinfo *v; + + massert(pp1=pp=alloca(count*sizeof(*pp1))); + ppe=pp1+count; + + for (v=cell_list_head;v && ppnext) { + + if (v->type>=t_end || + (tm=tm_of(v->type))==ntm || +#ifdef SGC + (sgc_enabled && tm->tm_sgc && v->sgc_flags!=SGC_PAGE_FLAG) || +#endif + v->in_use) + continue; + + count--; + *pp++=page(v); + + } + +#define NEXT_LINK(a_) (void *)&((struct freelist *)*(a_))->f_link +#define FREE_PAGE_P(yp_) bsearch(&(yp_),pp1,ppe-pp1,sizeof(*pp1),icomp) + + ppe=pp; + bzero(e,sizeof(e)); + for (pp=pp1;pptype]++; + for (i=0;itm_nfree-=(j=tm->tm_nppage*e[i]); + tm->tm_npage-=e[i]; + set_tm_maxpage(tm,tm->tm_maxpage-e[i]); + set_tm_maxpage(ntm,ntm->tm_maxpage+e[i]); + for (y=(void *)&tm->tm_free;*y!=OBJNULL && j;) { + for (;*y!=OBJNULL && (yp=page(*y)) && !FREE_PAGE_P(yp);y=NEXT_LINK(y)); + if (*y!=OBJNULL) { + for (n=NEXT_LINK(y),j--;*n!=OBJNULL && (yp=page(*n)) && FREE_PAGE_P(yp);n=NEXT_LINK(n),j--); + *y=*n; + } + } + massert(!j); + } + + for (pp=pp1;ppnext; + add_page_to_freelist(pagetochar(*pp),ntm); + pagetoinfo(*pp)->next=pn; + } + +} + + +int reserve_pages_for_signal_handler=30; + +/* If (n >= 0 ) return pointer to n pages starting at heap end, + These must come from the hole, so if that is exhausted you have + to gc and move the hole. + if (n < 0) return pointer to n pages starting at heap end, + but don't worry about the hole. Basically just make sure + the space is available from the Operating system. + If not in_signal_handler then try to keep a minimum of + reserve_pages_for_signal_handler pages on hand in the hole + */ + +void +empty_relblock(void) { + + object o=sSAleaf_collection_thresholdA->s.s_dbind; + + sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); + for (;!rb_emptyp();) { + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + sSAleaf_collection_thresholdA->s.s_dbind=o; + +} + +void +setup_rb(bool preserve_rb_pointerp) { + + int lowp=rb_high(); + + update_pool(2*(nrbpage-page(rb_size()))); + rb_start=new_rb_start; + rb_end=rb_start+(nrbpage<>PAGEWIDTH))); + +} + +void +resize_hole(ufixnum hp,enum type tp,bool in_placep) { + + char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE; + ufixnum size=rb_pointer-start; + +#define OVERLAP(c_,t_,s_) ((t_)<(c_)+(s_) && (c_)<(t_)+(s_)) + if (!in_placep && (rb_high() ? + OVERLAP(start,new_start,size) : + OVERLAP(start,new_start+(nrbpage<s.s_dbind != Cnil) + emsg("[GC Toggling relblock when resizing hole to %lu]\n",hp); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + return resize_hole(hp,tp,in_placep); + } + + new_rb_start=new_start; + + if (!size || in_placep) + setup_rb(in_placep); + else { + tm_of(tp)->tm_adjgbccnt--; + GBC(tp); + } + +} + +void * +alloc_page(long n) { + + bool s=n<0; + ufixnum nn=s ? -n : n; + void *v,*e; + + if (!s) { + + if (nn>((rb_start-heap_end)>>PAGEWIDTH)) { + + + fixnum d=available_pages-nn; + + d*=0.2; + d=d<0.01*real_maxpage ? available_pages-nn : d; + d=d<0 ? 0 : d; + d=(available_pages/3)s.s_dbind != Cnil) + emsg("[GC Hole overrun]\n"); + + resize_hole(d+nn,t_relocatable,0); + + } + } + + e=heap_end; + v=e+nn*PAGESIZE; + + if (!s) { + + heap_end=v; + update_pool(nn); + pool_check(); + + } else if (v>(void *)core_end) { + + massert(!mbrk(v)); + core_end=v; + + } + + return(e); + +} + + +#define MAX(a_,b_) ({fixnum _a=(a_),_b=(b_);_a<_b ? _b : _a;}) +#define MIN(a_,b_) ({fixnum _a=(a_),_b=(b_);_a<_b ? _a : _b;}) + +struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;; + +ufixnum +sum_maxpages(void) { + + ufixnum i,j; + + for (i=t_start,j=0;itm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1); + if (z>available_pages) return 0; + available_pages-=z; + tm->tm_adjgbccnt*=((double)j+1)/(n+1); + tm->tm_maxpage=n; + /* massert(!check_avail_pages()); */ + return 1; +} + +object +type_name(int t) { + return make_simple_string(tm_table[(int)t].tm_name+1); +} + + +static void +call_after_gbc_hook(int t) { + if (sSAafter_gbc_hookA && sSAafter_gbc_hookA->s.s_dbind!= Cnil) { + set_up_string_register(tm_table[(int)t].tm_name+1); + ifuncall1(sSAafter_gbc_hookA->s.s_dbind,intern(string_register,system_package)); + } +} + +static fixnum +grow_linear(fixnum old, fixnum fract, fixnum grow_min, fixnum grow_max,fixnum max_delt) { + + fixnum delt; + + delt=(old*(fract ? fract : 50))/100; + + delt= (grow_min && delt < grow_min ? grow_min: + grow_max && delt > grow_max ? grow_max: + delt); + + delt=delt>max_delt ? max_delt : delt; + + return old + delt; + +} + +/* GCL's traditional garbage collecting algorithm placed heavy emphasis + on conserving memory. Maximum page allocations of each object type + were only increased when the objects in use after GBC exceeded a + certain percentage threshold of the current maximum. This allowed + a situation in which a growing heap would experience significant + performance degradation due to GBC runs triggered by types making + only temporary allocations -- the rate of GBC calls would be + constant while the cost for each GBC would grow with the size of + the heap. + + We implement here a strategy designed to approximately optimize the + product of the total GBC call rate times the cost or time taken for + each GBC. The rate is approximated from the actual gbccounts so + far experienced, while the cost is taken to be simply proportional + to the heap size at present. This can be further tuned by taking + into account the number of pointers in each object type in the + future, but at present objects of several different types but + having the same size are grouped together in the type manager + table, so this step becomes more involved. + + After each GBC, we calculate the maximum of the function + (gbc_rate_other_types + gbc_rate_this_type * + current_maxpage/new_maxpage)*(sum_all_maxpages-current_maxpage+new_maxpage). + If the benefit in the product from adopting the new_maxpage is + greater than 5%, we adopt it, and adjust the gbccount for the new + basis. Corrections are put in place for small GBC counts, and the + possibility that GBC calls of only a single type are ever + triggered, in which case the optimum new_maxpage would diverge in + the simple analysis above. + + 20040403 CM */ + +DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,""); +#define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) +DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,""); + +static object +exhausted_report(enum type t,struct typemanager *tm) { + + available_pages+=resv_pages; + resv_pages=0; + CEerror("Continues execution.", + "The storage for ~A is exhausted. ~D pages allocated. Use ALLOCATE to expand the space.", + 2, type_name(t), make_fixnum(tm->tm_npage)); + + call_after_gbc_hook(t); + + return alloc_object(t); + +} + +#ifdef SGC +#define TOTAL_THIS_TYPE(tm) (tm->tm_nppage * (sgc_enabled ? sgc_count_type(tm->tm_type) : tm->tm_npage)) +#else +#define TOTAL_THIS_TYPE(tm) (tm->tm_nppage * tm->tm_npage) +#endif + +static object cbv=Cnil; +#define cbsrch1 ((struct contblock ***)cbv->v.v_self) +#define cbsrche (cbsrch1+cbv->v.v_fillp) + +static inline void +expand_contblock_index_space(void) { + + if (cbv==Cnil) { + cbv=fSmake_vector1_2(16,aet_fix,Cnil,make_fixnum(0)); + cbv->v.v_self[0]=(object)&cb_pointer; + enter_mark_origin(&cbv); + } + + if (cbv->v.v_fillp+1==cbv->v.v_dim) { + + void *v; + object o=sSAleaf_collection_thresholdA->s.s_dbind; + + sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); + v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); + sSAleaf_collection_thresholdA->s.s_dbind=o; + + memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum)); + cbv->v.v_self=v; + cbv->v.v_dim*=2; + + } + +} + +static inline void * +expand_contblock_index(struct contblock ***cbppp) { + + ufixnum i=cbppp-cbsrch1; + + expand_contblock_index_space(); + + cbppp=cbsrch1+i; + memmove(cbppp+1,cbppp,(cbsrche-cbppp+1)*sizeof(*cbppp)); + cbv->v.v_fillp++; + + return cbppp; + +} + +static inline void +contract_contblock_index(struct contblock ***cbppp) { + + memmove(cbppp+1,cbppp+2,(cbsrche-cbppp-1)*sizeof(*cbppp)); + cbv->v.v_fillp--; + +} + +static inline int +cbcomp(const void *v1,const void *v2) { + + ufixnum u1=(**(struct contblock ** const *)v1)->cb_size; + ufixnum u2=(**(struct contblock ** const *)v2)->cb_size; + + return u1cb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); + if (print) + emsg("%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); + } + massert(cbppp==cbsrche); + massert(*cbppp==cbpp); + massert(!**cbppp); + +} + +void +insert_contblock(void *p,ufixnum s) { + + struct contblock *cbp=p,**cbpp,***cbppp; + + cbpp=find_contblock(s,(void **)&cbppp); + + cbp->cb_size=s; + cbp->cb_link=*cbpp; + + if ((!cbp->cb_link || cbp->cb_link->cb_size!=s)) { + cbppp=expand_contblock_index(cbppp); + cbppp[1]=&cbp->cb_link; + } + + *cbpp=cbp; + +} + +static inline void +delete_contblock(void *p,struct contblock **cbpp) { + + struct contblock ***cbppp=p; + ufixnum s=(*cbpp)->cb_size; + + (*cbpp)=(*cbpp)->cb_link; + + if ((!(*cbpp) || (*cbpp)->cb_size!=s)) + contract_contblock_index(cbppp); + +} + +void +reset_contblock_freelist(void) { + + cb_pointer=NULL; + cbv->v.v_fillp=0; + +} + +static inline void * +alloc_from_freelist(struct typemanager *tm,fixnum n) { + + void *p; + + switch (tm->tm_type) { + + case t_contiguous: + { + void *pp; + struct contblock **cbpp=find_contblock(n,&pp); + + if ((p=*cbpp)) { + ufixnum s=(*cbpp)->cb_size; + delete_contblock(pp,cbpp); + if (nrb_end && rb_pointer+n>rb_limit && rb_pointer+nn) + return ((rb_pointer+=n)-n); + break; + + default: + if ((p=tm->tm_free)!=OBJNULL) { + tm->tm_free = OBJ_LINK(p); + tm->tm_nfree--; + return(p); + } + break; + } + + return NULL; + +} + +static inline void +grow_linear1(struct typemanager *tm) { + + if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) { + + fixnum maxgro=resv_pages ? available_pages : 0; + + if (tm->tm_type==t_relocatable) maxgro>>=1; + + set_tm_maxpage(tm,grow_linear(tm->tm_npage,tm->tm_growth_percent,tm->tm_min_grow, tm->tm_max_grow,maxgro)); + + } + +} + +static inline int +too_full_p(struct typemanager *tm) { + + fixnum i,j,k,pf=tm->tm_percent_free ? tm->tm_percent_free : 30; + struct contblock *cbp; + struct pageinfo *pi; + + switch (tm->tm_type) { + case t_relocatable: + return 100*(rb_limit-rb_pointer)cb_link) k+=cbp->cb_size; + for (i=j=0;iv.v_fillp;i++) { + pi=(void *)contblock_array->v.v_self[i]; +#ifdef SGC + if (!sgc_enabled || pi->sgc_flags&SGC_PAGE_FLAG) +#endif + j+=pi->in_use; + } + return 100*ktm_nfrees.s_dbind==Cnil) + return tm->tm_npage+tpage(tm,n)>tm->tm_maxpage; + + if ((cpool=get_pool())<=gc_page_min*phys_pages) + return FALSE; + + pp=gc_page_max*phys_pages; + + return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages() || + 2*tpage(tm,n)>available_pages; + +} + + +static inline void * +alloc_after_gc(struct typemanager *tm,fixnum n) { + + if (do_gc_p(tm,n)) { + + switch (jmp_gmp) { + case 0: /* not in gmp call*/ + GBC(tm->tm_type); + break; + case 1: /* non-in-place gmp call*/ + longjmp(gmp_jmp,tm->tm_type); + break; + case -1: /* in-place gmp call */ + jmp_gmp=-tm->tm_type; + break; + default: + break; + } + + if (IGNORE_MAX_PAGES && too_full_p(tm)) + grow_linear1(tm); + + call_after_gbc_hook(tm->tm_type); + + return alloc_from_freelist(tm,n); + + } else + + return NULL; + +} + +void +add_pages(struct typemanager *tm,fixnum m) { + + switch (tm->tm_type) { + case t_contiguous: + + add_page_to_contblock_list(alloc_page(m),m); + + break; + + case t_relocatable: + + if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { + if (sSAnotify_gbcA->s.s_dbind != Cnil) + emsg("[GC Moving relblock low before expanding relblock pages]\n"); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + nrbpage+=m; + resize_hole(page(rb_start-heap_end)-(rb_high() ? m : 0),t_relocatable,1); + break; + + default: + + { + void *p=alloc_page(m),*pe=p+m*PAGESIZE; + for (;ptm_npage+m>tm->tm_maxpage) { + + if (!IGNORE_MAX_PAGES) return NULL; + + grow_linear1(tm); + + if (tm->tm_npage+m>tm->tm_maxpage && !set_tm_maxpage(tm,tm->tm_npage+m)) + return NULL; + + } + + add_pages(tm,m); + + return alloc_from_freelist(tm,n); + +} + +static inline void * +alloc_after_reclaiming_pages(struct typemanager *tm,fixnum n) { + + fixnum m=tpage(tm,n),reloc_min; + + if (tm->tm_type>t_end) return NULL; + + reloc_min=npage(rb_pointer-rb_start); + + if (m<2*(nrbpage-reloc_min)) { + + set_tm_maxpage(tm_table+t_relocatable,reloc_min); + nrbpage=reloc_min; + + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + + return alloc_after_adding_pages(tm,n); + + } + + if (tm->tm_type>=t_end) return NULL; + + maybe_reallocate_page(tm,tm->tm_percent_free*tm->tm_npage); + + return alloc_from_freelist(tm,n); + +} + +static inline void *alloc_mem(struct typemanager *,fixnum); + +#ifdef SGC +static inline void * +alloc_after_turning_off_sgc(struct typemanager *tm,fixnum n) { + + if (!sgc_enabled) return NULL; + sgc_quit(); + return alloc_mem(tm,n); + +} +#endif + +static inline void * +alloc_mem(struct typemanager *tm,fixnum n) { + + void *p; + + CHECK_INTERRUPT; + + recent_allocation+=n; + + if ((p=alloc_from_freelist(tm,n))) + return p; + if ((p=alloc_after_gc(tm,n))) + return p; + if ((p=alloc_after_adding_pages(tm,n))) + return p; +#ifdef SGC + if ((p=alloc_after_turning_off_sgc(tm,n))) + return p; +#endif + if ((p=alloc_after_reclaiming_pages(tm,n))) + return p; + return exhausted_report(tm->tm_type,tm); +} + +object +alloc_object(enum type t) { + + object obj; + struct typemanager *tm=tm_of(t); + + obj=alloc_mem(tm,tm->tm_size); + set_type_of(obj,t); + + pageinfo(obj)->in_use++; + + return(obj); + +} + +void * +alloc_contblock(size_t n) { + return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE)); +} + +void * +alloc_contblock_no_gc(size_t n,char *limit) { + + struct typemanager *tm=tm_of(t_contiguous); + void *p; + + n=CEI(n,CPTR_SIZE); + + if ((p=alloc_from_freelist(tm,n))) + return p; + + if (tpage(tm,n)<(limit-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) + return p; + + return NULL; + +} + +void * +alloc_code_space(size_t sz,ufixnum max_code_address) { + + void *v; + + sz=CEI(sz,CPTR_SIZE); + + if (sSAcode_block_reserveA && + sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) { + + v=sSAcode_block_reserveA->s.s_dbind->st.st_self; + sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz; + sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz; + sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim; + + } else + v=alloc_contblock(sz); + + if (v && (unsigned long)(v+sz)s.s_dbind); + + return v; + +} + +void * +alloc_relblock(size_t n) { + + return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN)); + +} + +static inline void +load_cons(object p,object a,object d) { +#ifdef WIDE_CONS + set_type_of(p,t_cons); +#endif + p->c.c_cdr=SAFE_CDR(d); + p->c.c_car=a; +} + +object +make_cons(object a,object d) { + + static struct typemanager *tm=tm_table+t_cons;/*FIXME*/ + object obj=alloc_mem(tm,tm->tm_size); + + load_cons(obj,a,d); + + pageinfo(obj)->in_use++; + + return(obj); + +} + +object +on_stack_cons(object x, object y) { + object p = (object) alloca_val; + load_cons(p,x,y); + return p; +} + +DEFUNM_NEW("ALLOCATED",object,fSallocated,SI,1,1,NONE,OO,OO,OO,OO,(object typ),"") +{ struct typemanager *tm=(&tm_table[t_from_type(typ)]); + tm = & tm_table[tm->tm_type]; + if (tm->tm_type == t_relocatable) + { tm->tm_npage = page(rb_size()); + tm->tm_nfree = rb_limit -rb_pointer; + } + else if (tm->tm_type == t_contiguous) + { int cbfree =0; + struct contblock **cbpp; + for(cbpp= &cb_pointer; (*cbpp)!=NULL; cbpp= &(*cbpp)->cb_link) + cbfree += (*cbpp)->cb_size ; + tm->tm_nfree = cbfree; + } + + RETURN(6,object,make_fixnum(tm->tm_nfree), + (RV(make_fixnum(tm->tm_npage)), + RV(make_fixnum(tm->tm_maxpage)), + RV(make_fixnum(tm->tm_nppage)), + RV(make_fixnum(tm->tm_gbccount)), + RV(make_fixnum(tm->tm_npage*tm->tm_nppage-tm->tm_nfree)))); +} + +#ifdef SGC_CONT_DEBUG +extern void overlap_check(struct contblock *,struct contblock *); +#endif + +DEFUN_NEW("PRINT-FREE-CONTBLOCK-LIST",object,fSprint_free_contblock_list,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + + struct contblock *cbp,*cbp1; + + for (cbp=cb_pointer;cbp;cbp=cbp->cb_link) { + printf("%p %lu\n",cbp,cbp->cb_size); + for (cbp1=cbp;cbp1;cbp1=cbp1->cb_link) + if ((void *)cbp+cbp->cb_size==(void *)cbp1 || + (void *)cbp1+cbp1->cb_size==(void *)cbp) + printf(" adjacent to %p %lu\n",cbp1,cbp1->cb_size); + } + + return Cnil; + +} + +/* Add a tm_distinct field to prevent page type sharing if desired. + Not used now, as its never desirable from an efficiency point of + view, and as the only known place one must separate is cons and + fixnum, which are of different sizes unless PTR_ALIGN is set too + high (e.g. 16 on a 32bit machine). See the ordering of init_tm + calls for these types below -- reversing would wind up merging the + types with the current algorithm. CM 20030827 */ + +static void +init_tm(enum type t, char *name, int elsize, int nelts, int sgc,int distinct) { + + int i, j; + int maxpage; + /* round up to next number of pages */ + maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE); + tm_table[(int)t].tm_name = name; + j=-1; + if (!distinct) + for (i = 0; i < t_end; i++) + if (tm_table[i].tm_size != 0 && + tm_table[i].tm_size >= elsize && + !tm_table[i].tm_distinct && + (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size)) + j = i; + if (j >= 0) { + tm_table[(int)t].tm_type = (enum type)j; + set_tm_maxpage(tm_table+j,tm_table[j].tm_maxpage+maxpage); +#ifdef SGC + tm_table[j].tm_sgc += sgc; +#endif + return; + } + tm_table[(int)t].tm_type = t; + tm_table[(int)t].tm_size = elsize ? CEI(elsize,PTR_ALIGN) : 1; + tm_table[(int)t].tm_nppage = (PAGESIZE-sizeof(struct pageinfo))/tm_table[(int)t].tm_size; + tm_table[(int)t].tm_free = OBJNULL; + tm_table[(int)t].tm_nfree = 0; + /* tm_table[(int)t].tm_nused = 0; */ + /*tm_table[(int)t].tm_npage = 0; */ /* dont zero nrbpage.. */ + set_tm_maxpage(tm_table+t,maxpage); + tm_table[(int)t].tm_gbccount = 0; + tm_table[(int)t].tm_adjgbccnt = 0; + tm_table[(int)t].tm_opt_maxpage = 0; + tm_table[(int)t].tm_distinct=distinct; + +#ifdef SGC + tm_table[(int)t].tm_sgc = sgc; + tm_table[(int)t].tm_sgc_max = 3000; + tm_table[(int)t].tm_sgc_minfree = (0.4 * tm_table[(int)t].tm_nppage); +#endif + +} + +/* FIXME this is a work-around for the special MacOSX memory + initialization sequence, which sets heap_end, traditionally + initialized in gcl_init_alloc. Mac and windows have non-std + sbrk-emulating memory subsystems, and their internals need to be + homogenized and integrated into the traditional unix sequence for + simplicity. set_maxpage is overloaded, and the positioning of its + call is too fragile. 20050115 CM*/ +static int gcl_alloc_initialized; + +object malloc_list=Cnil; + +#include + +void +maybe_set_hole_from_maxpages(void) { + if (rb_pointer==rb_begin()) + resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0); +} + +void +gcl_init_alloc(void *cs_start) { + + fixnum cssize=(1L<<23); + + prelink_init(); + +#ifdef RECREATE_HEAP + if (!raw_image) RECREATE_HEAP; +#endif + +#if defined(DARWIN) + init_darwin_zone_compat (); +#endif + +#if defined(BSD) && defined(RLIMIT_STACK) + { + struct rlimit rl; + + /* Maybe the soft limit for data segment size is lower than the + * hard limit. In that case, we want as much as possible. + */ + massert(!getrlimit(RLIMIT_DATA, &rl)); + if (rl.rlim_cur != RLIM_INFINITY && (rl.rlim_max == RLIM_INFINITY || rl.rlim_max > rl.rlim_cur)) { + rl.rlim_cur = rl.rlim_max; + massert(!setrlimit(RLIMIT_DATA, &rl)); + } + + massert(!getrlimit(RLIMIT_STACK, &rl)); + if (rl.rlim_cur!=RLIM_INFINITY && (rl.rlim_max == RLIM_INFINITY || rl.rlim_max > rl.rlim_cur)) { + rl.rlim_cur = rl.rlim_max; + massert(!setrlimit(RLIMIT_STACK,&rl)); + } + cssize = rl.rlim_cur/sizeof(*cs_org) - sizeof(*cs_org)*CSGETA; + + } +#endif + + cs_org = cs_base = cs_start; + cs_limit = cs_org + CSTACK_DIRECTION*cssize; + +#ifdef __ia64__ + { + extern void * __libc_ia64_register_backing_store_base; + cs_org2=cs_base2=__libc_ia64_register_backing_store_base; + } +#endif + +#ifdef HAVE_SIGALTSTACK + { + /* make sure the stack is 8 byte aligned */ + static double estack_buf[32*SIGSTKSZ]; + static stack_t estack; + + estack.ss_sp = estack_buf; + estack.ss_flags = 0; + estack.ss_size = sizeof(estack_buf); + massert(sigaltstack(&estack, 0)>=0); + } +#endif + + install_segmentation_catcher(); + +#ifdef HAVE_MPROTECT + if (data_start) + massert(!gcl_mprotect(data_start,(void *)core_end-data_start,PROT_READ|PROT_WRITE|PROT_EXEC)); +#endif + +#ifdef SGC + + massert(getpagesize()<=PAGESIZE); + memprotect_test_reset(); + if (sgc_enabled) + if (memory_protect(1)) + sgc_quit(); + +#endif + + update_real_maxpage(); + + if (gcl_alloc_initialized) { + maybe_set_hole_from_maxpages(); + return; + } + +#ifdef INIT_ALLOC + INIT_ALLOC; +#endif + + initial_sbrk=data_start=heap_end; + first_data_page=page(data_start); + + /* Unused (at present) tm_distinct flag added. Note that if cons + and fixnum share page types, errors will be introduced. + + Gave each page type at least some sgc pages by default. Of + course changeable by allocate-sgc. CM 20030827 */ + + init_tm(t_cons, ".CONS", sizeof(struct cons), 0 ,50,0 ); + init_tm(t_fixnum, "NFIXNUM",sizeof(struct fixnum_struct), 0,20,0); + init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure),0,1,0 ); + init_tm(t_cfun, "fCFUN", sizeof(struct cfun),0,1,0 ); + init_tm(t_sfun, "gSFUN", sizeof(struct sfun),0,1,0 ); + init_tm(t_string, "\"STRING", sizeof(struct string),0,1,0 ); + init_tm(t_array, "aARRAY", sizeof(struct array),0,1,0 ); + init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol),0,1,0 ); + init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum),0,1,0 ); + init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio),0,1,0 ); + init_tm(t_shortfloat, "FSHORT-FLOAT",sizeof(struct shortfloat_struct),0 ,1,0); + init_tm(t_longfloat, "LLONG-FLOAT",sizeof(struct longfloat_struct),0 ,1,0); + init_tm(t_complex, "CCOMPLEX", sizeof(struct ocomplex),0 ,1,0); + init_tm(t_character,"#CHARACTER",sizeof(struct character),0 ,1,0); + init_tm(t_package, ":PACKAGE", sizeof(struct package),0,1,0); + init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable),0,1,0 ); + init_tm(t_vector, "vVECTOR", sizeof(struct vector),0 ,1,0); + init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector),0 ,1,0); + init_tm(t_stream, "sSTREAM", sizeof(struct stream),0 ,1,0); + init_tm(t_random, "$RANDOM-STATE", sizeof(struct random),0 ,1,0); + init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable),0 ,1,0); + init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname),0 ,1,0); + init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure),0 ,1,0); + init_tm(t_closure, "cCLOSURE", sizeof(struct closure),0 ,1,0); + init_tm(t_vfun, "VVFUN", sizeof(struct vfun),0 ,1,0); + init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0); + init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0); + init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata),0 ,1,0); + init_tm(t_spice, "!SPICE", sizeof(struct spice),0 ,1,0); + init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 0,0,20,1); + init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 0,0,20,1); + + + ncbpage = 0; + tm_table[t_contiguous].tm_min_grow=256; + set_tm_maxpage(tm_table+t_contiguous,1); + + set_tm_maxpage(tm_table+t_relocatable,1); + nrbpage=0; + + maybe_set_hole_from_maxpages(); +#ifdef SGC + tm_table[(int)t_relocatable].tm_sgc = 50; +#endif + + expand_contblock_index_space(); + + gcl_alloc_initialized=1; + +} + +DEFUN_NEW("STATICP",object,fSstaticp,SI,1,1,NONE,OO,OO,OO,OO,(object x),"Tell if the string or vector is static") { + RETURN1((inheap(x->ust.ust_self) ? sLt : sLnil)); +} + +/* static void */ +/* cant_get_a_type(void) { */ +/* FEerror("Can't get a type.", 0); */ +/* } */ + +static int +t_from_type(object type) { + + int i; + check_type_or_symbol_string(&type); + for (i= t_start ; i < t_other ; i++) + {struct typemanager *tm = &tm_table[i]; + if(tm->tm_name && + 0==strncmp((tm->tm_name)+1,type->st.st_self,type->st.st_fillp) + ) + return i;} + FEerror("Unrecognized type",0); + return i; + +} +/* When sgc is enabled the TYPE should have at least MIN pages of sgc type, + and at most MAX of them. Each page should be FREE_PERCENT free + when the sgc is turned on. FREE_PERCENT is an integer between 0 and 100. + */ + +DEFUN_NEW("ALLOCATE-SGC",object,fSallocate_sgc,SI + ,4,4,NONE,OO,II,II,OO,(object type,fixnum min,fixnum max,fixnum free_percent),"") { + + int t=t_from_type(type); + struct typemanager *tm; + object res,x,x1,x2; + tm=tm_of(t); + x=make_fixnum(tm->tm_sgc); + x1=make_fixnum(tm->tm_sgc_max); + x2=make_fixnum((100*tm->tm_sgc_minfree)/tm->tm_nppage); + res= list(3,x,x1,x2); + + if(min<0 || max< min || free_percent < 0 || free_percent > 100) + goto END; + tm->tm_sgc_max=max; + tm->tm_sgc=min; + tm->tm_sgc_minfree= (tm->tm_nppage *free_percent) /100; + END: + RETURN1(res); + +} + +/* Growth of TYPE will be by at least MIN pages and at most MAX pages. + It will try to grow PERCENT of the current pages. + */ +DEFUN_NEW("ALLOCATE-GROWTH",object,fSallocate_growth,SI,5,5,NONE,OO,II,II,OO, + (object type,fixnum min,fixnum max,fixnum percent,fixnum percent_free),"") +{int t=t_from_type(type); + struct typemanager *tm=tm_of(t); + object res,x,x1,x2,x3; + x=make_fixnum(tm->tm_min_grow); + x1=make_fixnum(tm->tm_max_grow); + x2=make_fixnum(tm->tm_growth_percent); + x3=make_fixnum(tm->tm_percent_free); + res= list(4,x,x1,x2,x3); + + if(min<0 || max< min || min > 3000 || percent < 0 || percent > 500 + || percent_free <0 || percent_free > 100 + ) + goto END; + tm->tm_max_grow=max; + tm->tm_min_grow=min; + tm->tm_growth_percent=percent; + tm->tm_percent_free=percent_free; + END: + RETURN1(res); +} + + + +DEFUN_NEW("ALLOCATE-CONTIGUOUS-PAGES",object,fSallocate_contiguous_pages,SI,1,2,NONE,OO,OO,OO,OO,(object onpages,...),"") { + + int nargs=VFUN_NARGS; + object really_do; + va_list ap; + fixnum npages=fixint(onpages); + + really_do=Cnil; + if (nargs>=2) { + va_start(ap,onpages); + really_do=va_arg(ap,object); + va_end(ap); + } + + CHECK_ARG_RANGE(1,2); + if (npages < 0) + FEerror("Allocate requires positive argument.", 0); + if (ncbpage > npages) + npages=ncbpage; + if (!set_tm_maxpage(tm_table+t_contiguous,npages)) + FEerror("Can't allocate ~D pages for contiguous blocks.", 1, make_fixnum(npages)); + if (really_do == Cnil) + RETURN1(Ct); + add_pages(tm_of(t_contiguous),npages - ncbpage); + + RETURN1(make_fixnum(npages)); + +} + + +DEFUN_NEW("ALLOCATED-CONTIGUOUS-PAGES",object,fSallocated_contiguous_pages,SI + ,0,0,NONE,OO,OO,OO,OO,(void),"") +{ + /* 0 args */ + RETURN1((make_fixnum(ncbpage))); +} + +DEFUN_NEW("MAXIMUM-CONTIGUOUS-PAGES",object,fSmaximum_contiguous_pages,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + /* 0 args */ + RETURN1((make_fixnum(maxcbpage))); +} + + +DEFUN_NEW("ALLOCATE-RELOCATABLE-PAGES",object,fSallocate_relocatable_pages,SI,1,2,NONE,OO,OO,OO,OO,(object onpages,...),"") { + + int nargs=VFUN_NARGS; + object really_do; + va_list ap; + fixnum npages=fixint(onpages); + + really_do=Cnil; + if (nargs>=2) { + va_start(ap,onpages); + really_do=va_arg(ap,object); + va_end(ap); + } + + CHECK_ARG_RANGE(1,2); + if (npages <= 0) + FEerror("Requires positive arg",0); + if (npages=3) { + va_start(ap,onpages); + really_do=va_arg(ap,object); + va_end(ap); + } + + CHECK_ARG_RANGE(2,3); + t= t_from_type(type); + if (t == t_contiguous) + RETURN1(FUNCALL(2,FFN(fSallocate_contiguous_pages)(make_fixnum(npages),really_do))); + else if (t==t_relocatable) + RETURN1(FUNCALL(2,FFN(fSallocate_relocatable_pages)(make_fixnum(npages),really_do))); + + + if (npages <= 0) + FEerror("Allocate takes positive argument.", 1,make_fixnum(npages)); + tm = tm_of(t); + if (tm->tm_npage > npages) {npages=tm->tm_npage;} + if (!set_tm_maxpage(tm,npages)) + FEerror("Can't allocate ~D pages for ~A.", 2, make_fixnum(npages), (make_simple_string(tm->tm_name+1))); + if (really_do == Cnil) + RETURN1(Ct); + add_pages(tm,npages - tm->tm_npage); + RETURN1(make_fixnum(npages)); + +} + +DEFUN_NEW("ALLOCATED-RELOCATABLE-PAGES",object,fSallocated_relocatable_pages,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + /* 0 args */ + RETURN1(make_fixnum(nrbpage)); +} + +DEFUN_NEW("GET-HOLE-SIZE",object,fSget_hole_size,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + /* 0 args */ + RETURN1(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); +} + +DEFUN_NEW("SET-STARTING-HOLE-DIVISOR",object,fSset_starting_hole_divisor,SI,1,1,NONE,II,OO,OO,OO,(fixnum div),"") { + if (div>0 && div <100) + starting_hole_div=div; + return (object)starting_hole_div; +} + +DEFUN_NEW("SET-STARTING-RELBLOCK-HEAP-MULTIPLE",object,fSset_starting_relb_heap_multiple,SI,1,1,NONE,II,OO,OO,OO,(fixnum mult),"") { + if (mult>=0) + starting_relb_heap_mult=mult; + return (object)starting_relb_heap_mult; +} + +DEFUNM_NEW("SET-HOLE-SIZE",object,fSset_hole_size,SI,1,2,NONE,OO,OO,OO,OO,(object onpages,...),"") { + + RETURN2(make_fixnum((rb_start-heap_end)>>PAGEWIDTH),make_fixnum(reserve_pages_for_signal_handler)); + +} + + +void +gcl_init_alloc_function(void) { + + enter_mark_origin(&malloc_list); + +} + + +#ifndef DONT_NEED_MALLOC + +/* + UNIX malloc simulator. + + Used by + getwd, popen, etc. +*/ + + + +/* If this is defined, substitute the fast gnu malloc for the slower + version below. If you have many calls to malloc this is worth + your while. I have only tested it slightly under 4.3Bsd. There + the difference in a test run with 120K mallocs and frees, + was 29 seconds to 1.9 seconds */ + +#ifdef GNU_MALLOC +#include "malloc.c" +#else + +/* a very young malloc may use this simple baby malloc, for the init + code before we even get to main.c. If this is not defined, then + malloc will try to run the init code which will work on many machines + but some such as WindowsNT under cygwin need this. + + */ +#ifdef BABY_MALLOC_SIZE + +/* by giving an initialization, make it not be in bss, since + bss may not get loaded until main is reached. We may + not even know our own name at this stage. */ +static char baby_malloc_data[BABY_MALLOC_SIZE]={1,0}; +static char *last_baby= baby_malloc_data; + +static char *baby_malloc(n) + int n; +{ + char *res= last_baby; + int m; + n = CEI(n,PTR_ALIGN); + m = n+ sizeof(int); + if ((res +m-baby_malloc_data) > sizeof(baby_malloc_data)) + { + printf("failed in baby malloc"); + do_gcl_abort(); + } + last_baby += m; + *((int *)res)=n; + return res+sizeof(int); +} +#endif + +/* #ifdef HAVE_LIBBFD */ + +/* int in_bfd_init=0; */ + +/* configure size, static init ? */ +/* static char bfd_buf[32768]; */ +/* static char *bfd_buf_p=bfd_buf; */ + +/* static void * */ +/* bfd_malloc(int n) { */ + +/* char *c; */ + +/* c=bfd_buf_p; */ +/* n+=7; */ +/* n>>=3; */ +/* n<<=3; */ +/* if (c+n>bfd_buf+sizeof(bfd_buf)) { */ +/* fprintf(stderr,"Not enough space in bfd_buf %d %d\n",n,sizeof(bfd_buf)-(bfd_buf_p-bfd_buf)); */ +/* exit(1); */ +/* } */ +/* bfd_buf_p+=n; */ +/* return (void *)c; */ + +/* } */ +/* #endif */ + +bool writable_malloc=0; + +static void * +malloc_internal(size_t size) { + +#ifdef CAN_UNRANDOMIZE_SBRK + if (core_end && core_end!=sbrk(0))/*malloc before main in saved_image*/ + return sbrk(size);/*will never get to gcl_init_alloc, so brk point irrelevant*/ +#endif + if (!gcl_alloc_initialized) { + static bool recursive_malloc; + if (recursive_malloc) + error("Bad malloc"); + recursive_malloc=1; + gcl_init_alloc(&size); + recursive_malloc=0; + } + + CHECK_INTERRUPT; + + malloc_list = make_cons(alloc_simple_string(size), malloc_list); + malloc_list->c.c_car->st.st_self = alloc_contblock(size); + malloc_list->c.c_car->st.st_adjustable=writable_malloc; + + return(malloc_list->c.c_car->st.st_self); + +} + +void * +malloc(size_t size) { + + return malloc_internal(size); + +} + + +void +free(void *ptr) { + + object *p,pp; + + if (ptr == 0) + return; + + for (p = &malloc_list,pp=*p; pp && !endp(pp); p = &((pp)->c.c_cdr),pp=pp->c.c_cdr) + if ((pp)->c.c_car->st.st_self == ptr) { + (pp)->c.c_car->st.st_self = NULL; + *p = pp->c.c_cdr; + return; + } + { + static void *old_ptr; + if (old_ptr==ptr) return; + old_ptr=ptr; +#ifndef NOFREE_ERR + FEerror("free(3) error.",0); +#endif + } + return; +} + +void * +realloc(void *ptr, size_t size) { + + object x; + int i; + /* was allocated by baby_malloc */ +#ifdef BABY_MALLOC_SIZE + if (ptr >= (void*)baby_malloc_data && ptr - (void*)baby_malloc_data size) + return ptr; + else + { char *new= malloc(size); + bcopy(ptr,new,dim); + return new; + } + + } +#endif /* BABY_MALLOC_SIZE */ + + + if(ptr == NULL) return malloc(size); + for (x = malloc_list; !endp(x); x = x->c.c_cdr) + if (x->c.c_car->st.st_self == ptr) { + x = x->c.c_car; + if (x->st.st_dim >= size) { + x->st.st_fillp = size; + return(ptr); + } else { + x->st.st_self = alloc_contblock(size); + x->st.st_fillp = x->st.st_dim = size; + for (i = 0; i < size; i++) + x->st.st_self[i] = ((char *)ptr)[i]; + return(x->st.st_self); + } + } + FEerror("realloc(3) error.", 0); + + return NULL; + +} + +#endif /* gnumalloc */ + + +void * +calloc(size_t nelem, size_t elsize) +{ + char *ptr; + long i; + + ptr = malloc(i = nelem*elsize); + while (--i >= 0) + ptr[i] = 0; + return(ptr); +} + + +void +cfree(void *ptr) { + free(ptr); +} + +#endif + + +#ifndef GNUMALLOC +#ifdef WANT_VALLOC +static void * +memalign(size_t align,size_t size) { + object x = alloc_simple_string(size); + x->st.st_self = ALLOC_ALIGNED(alloc_contblock,size,align); + malloc_list = make_cons(x, malloc_list); + return x->st.st_self; +} +void * +valloc(size_t size) +{ return memalign(getpagesize(),size);} +#endif + +#endif diff --git a/o/array.c b/o/array.c new file mode 100755 index 0000000..a16c012 --- /dev/null +++ b/o/array.c @@ -0,0 +1,1536 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include +#include +#include "include.h" + +static void +displace(object, object, int); + +static enum aelttype +Iarray_element_type(object); + + +/* #define ARRAY_DIMENSION_LIMIT MOST_POSITIVE_FIXNUM */ + +DEFCONST("ARRAY-RANK-LIMIT", sLarray_rank_limit, LISP, + make_fixnum(ARRAY_RANK_LIMIT),""); + +DEFCONST("ARRAY-DIMENSION-LIMIT", sLarray_dimension_limit, + LISP, make_fixnum(MOST_POSITIVE_FIX),""); +DEFCONST("ARRAY-TOTAL-SIZE-LIMIT", sLarray_total_size_limit, + LISP, make_fixnum(MOST_POSITIVE_FIX),""); + +DEF_ORDINARY("BIT",sLbit,LISP,""); + +/* number of bits in unit of storage of x->bv.bv_self[0] */ + +#define BV_BITS 8 + +#define BITREF(x,i) \ + ((((1 << (BV_BITS -1)) >> (i % BV_BITS)) & (x->bv.bv_self[i/BV_BITS])) \ + ? 1 : 0) + +#define SET_BITREF(x,i) \ + (x->bv.bv_self[i/BV_BITS]) |= ((1 << (BV_BITS -1)) >> (i % BV_BITS)) +#define CLEAR_BITREF(x,i) \ + (x->bv.bv_self[i/BV_BITS]) &= ~(((1 << (BV_BITS -1)) >> (i % BV_BITS))) + +extern short aet_sizes[]; + +#define ARRAY_BODY_PTR(ar,n) \ + (void *)(ar->ust.ust_self + aet_sizes[Iarray_element_type(ar)]*n) + +#define N_FIXNUM_ARGS 6 + +DEFUNO_NEW("AREF", object, fLaref, LISP, 1, ARRAY_RANK_LIMIT, + NONE, OO, OO, OO, OO,void,Laref,(object x,object oi, ...),"") +{ int n = VFUN_NARGS; + int i1; + fixnum i=n>1 ? fix(oi) : 0; + va_list ap; + if (type_of(x) == t_array) + {int m ; + unsigned int k; + int rank = n - 1; + if (x->a.a_rank != rank) + FEerror(" ~a has wrong rank",1,x); + if (rank == 1) return fLrow_major_aref(x,i); + if (rank == 0) return fLrow_major_aref(x,0); + va_start(ap,oi); + m = 0; + k = i; + /* index into 1 dimensional array */ + i1 = 0; + rank-- ; + while(1) + { + if ( k >= x->a.a_dims[m]) + FEerror("Index ~a to array is too large",1,make_fixnum (m)); + i1 += k; + m ++; + if (m <= rank) + { i1 = i1 * x->a.a_dims[m]; + if (m < N_FIXNUM_ARGS) + { k = fixint(va_arg(ap,object));} + else {object x = va_arg(ap,object); + check_type(x,t_fixnum); + k = Mfix(x);} + + } + else break;} + va_end(ap); + return fLrow_major_aref(x,i1); + } + if (n > 2) + { FEerror("Too many args (~a) to aref",1,make_fixnum(n));} + return fLrow_major_aref(x,i); + +} + +static void +fScheck_bounds_bounds(object x, int i) +{ + switch (type_of(x)) { + case t_array: + case t_vector: + case t_bitvector: + case t_string: + if ((unsigned int) i >= x->a.a_dim) + FEerror("Array index ~a out of bounds for ~a", 2, make_fixnum(i),x); + default: + FEerror("not an array",0); + } +} + +DEFUNO_NEW("SVREF", object, fLsvref, LISP, 2, 2, + ONE_VAL, OO, IO, OO,OO,void,Lsvref,(object x,ufixnum i), + "For array X and index I it returns (aref x i) ") +{ + if (type_of(x)==t_vector + && (enum aelttype)x->v.v_elttype == aet_object + && x->v.v_dim > i) + RETURN1(x->v.v_self[i]); + if (x->v.v_dim > i) illegal_index(x,make_fixnum(i)); + FEerror("Bad simple vector ~a",1,x); + return(Cnil); +} + +DEFUN_NEW("ROW-MAJOR-AREF", object, fLrow_major_aref, LISP, 2, 2, + NONE, OO, IO, OO,OO,(object x,fixnum i), + "For array X and index I it returns (aref x i) as if x were \ +1 dimensional, even though its rank may be bigger than 1") +{ + switch (type_of(x)) { + case t_array: + case t_vector: + case t_bitvector: + if (x->v.v_dim <= (unsigned int)i) + /* i = */fScheck_bounds_bounds(x, i); + switch (x->v.v_elttype) { + case aet_object: + return x->v.v_self[i]; + case aet_ch: + return code_char(x->st.st_self[i]); + case aet_bit: + i += BV_OFFSET(x); + return make_fixnum(BITREF(x, i)); + case aet_fix: + return make_fixnum(x->fixa.fixa_self[i]); + case aet_sf: + return make_shortfloat(x->sfa.sfa_self[i]); + case aet_lf: + return make_longfloat(x->lfa.lfa_self[i]); + case aet_char: + return small_fixnum(x->st.st_self[i]); + case aet_uchar: + return small_fixnum(x->ust.ust_self[i]); + case aet_short: + return make_fixnum(SHORT_GCL(x, i)); + case aet_ushort: + return make_fixnum(USHORT_GCL(x, i)); + + default: + FEerror("unknown array type",0); + } + case t_string: + if (x->v.v_dim <= i) + /* i = */fScheck_bounds_bounds(x, i); + return code_char(x->st.st_self[i]); + default: + FEerror("not an array",0); + return(Cnil); + } +} +#ifdef STATIC_FUNCTION_POINTERS +object +fLrow_major_aref(object x,fixnum i) { + return FFN(fLrow_major_aref)(x,i); +} +#endif + +object +aset1(object x,fixnum i,object val) { + return fSaset1(x,i,val); +} + +DEFUN_NEW("ASET1", object, fSaset1, SI, 3, 3, NONE, OO, IO, OO,OO,(object x, fixnum i,object val),"") +{ + switch (type_of(x)) { + case t_array: + case t_vector: + case t_bitvector: + if (x->v.v_dim <= i) + /* i = */fScheck_bounds_bounds(x, i); + switch (x->v.v_elttype) { + case aet_object: + x->v.v_self[i] = val; + break; + case aet_ch: + ASSURE_TYPE(val,t_character); + x->st.st_self[i] = char_code(val); + break; + case aet_bit: + i += BV_OFFSET(x); + ASSURE_TYPE(val,t_fixnum); + switch (Mfix(val)) { + case 0: + CLEAR_BITREF(x,i); + break; + case 1: + SET_BITREF(x,i); + break; + default: + TYPE_ERROR(val,sLbit); + } + break; + case aet_fix: + ASSURE_TYPE(val,t_fixnum); + (x->fixa.fixa_self[i]) = Mfix(val); + break; + case aet_sf: + ASSURE_TYPE(val,t_shortfloat); + (x->sfa.sfa_self[i]) = Msf(val); + break; + case aet_lf: + ASSURE_TYPE(val,t_longfloat); + (x->lfa.lfa_self[i]) = Mlf(val); + break; + case aet_char: + ASSURE_TYPE(val,t_fixnum); + x->st.st_self[i] = Mfix(val); + break; + case aet_uchar: + ASSURE_TYPE(val,t_fixnum); + (x->ust.ust_self[i])= Mfix(val); + break; + case aet_short: + ASSURE_TYPE(val,t_fixnum); + SHORT_GCL(x, i) = Mfix(val); + break; + case aet_ushort: + ASSURE_TYPE(val,t_fixnum); + USHORT_GCL(x, i) = Mfix(val); + break; + default: + FEerror("unknown array type",0); + } + break; + case t_string: + if (x->v.v_dim <= i) + /* i = */fScheck_bounds_bounds(x, i); + ASSURE_TYPE(val,t_character); + x->st.st_self[i] = char_code(val); + break; + default: + FEerror("not an array",0); + } + return val; +} +#ifdef STATIC_FUNCTION_POINTERS +object +fSaset1(object x, fixnum i,object val) { + return FFN(fSaset1)(x,i,val); +} +#endif + +DEFUNO_NEW("ASET", object, fSaset, SI, 1, ARG_LIMIT, NONE, OO, + OO, OO, OO,void,siLaset,(object x,object ii,object y, ...),"") +{ int i,i1; + int n = VFUN_NARGS; + va_list ap; + if (type_of(x) == t_array) + {int m ; + unsigned int k; + int rank = n - 2; + if (x->a.a_rank != rank) + FEerror(" ~a has wrong rank",1,x); + if (rank == 0) return fSaset1(x,0,ii); + ASSURE_TYPE(ii,t_fixnum); + i = fix(ii); + if (rank == 1) + return fSaset1(x,i,y); + va_start(ap,y); + m = 0; + k = i; + /* index into 1 dimensional array body */ + i1 = 0; + rank-- ; + while(1) + { + if (k >= x->a.a_dims[m]) { + object x,x1; + x=make_fixnum(m); + x1=make_fixnum(k); + FEerror("Index number ~a: ~a to array is out of bounds", + 2,x,x1); + } + i1 += k; + if (m < rank) + {object u; + if (m == 0) + { u = y;} + else + { u = va_arg(ap,object);} + check_type(u,t_fixnum); + k = Mfix(u); + m++ ; + i1 = i1 * x->a.a_dims[m]; + + } + else + { y = va_arg(ap,object); + break ;} + } + va_end(ap); + return fSaset1(x,i1,y); + } + else + { + ASSURE_TYPE(ii,t_fixnum); + i = fix(ii); + return fSaset1(x,i,y); + } + +} + + +DEFUNO_NEW("SVSET", object, fSsvset, SI, 3, 3, NONE, OO, IO, OO, + OO,void,siLsvset,(object x,fixnum i,object val),"") +{ if (TYPE_OF(x) != t_vector + || DISPLACED_TO(x) != Cnil) + Wrong_type_error("simple array",0); + if (i > x->v.v_dim) + { FEerror("out of bounds",0); + } + return x->v.v_self[i] = val; +} + +/* +(proclaim '(ftype (function (fixnum fixnum t *)) make-vector1)) +(defun make-vector1 (n elt-type staticp &optional fillp initial-element + displaced-to (displaced-index-offset 0)) + (declare (fixnum n elt-type displaced-index-offset)) +*/ + + +DEFUN_NEW("MAKE-VECTOR1",object,fSmake_vector1,SI,3,8,NONE,OO, + OO,OO,OO,(object on,object oelt_type,object staticp,...),"") + +{ + int displaced_index_offset=0; + int Inargs = VFUN_NARGS - 3; + fixnum n=fixint(on),elt_type=fixint(oelt_type); + va_list Iap;object fillp;object initial_element;object displaced_to;object V9; + Inargs = VFUN_NARGS - 3 ; + { object x; + BEGIN_NO_INTERRUPT; + switch(elt_type) { + case aet_ch: + x = alloc_object(t_string); + x->ust.ust_adjustable=1; + goto a_string; + break; + case aet_bit: + x = alloc_object(t_bitvector); + x->v.v_elttype = elt_type; + x->v.v_adjustable=1; + break; + default: + x = alloc_object(t_vector);} + x->v.v_elttype = elt_type; + x->v.v_adjustable=1; + a_string: + x->v.v_dim = n; + x->v.v_self = 0; + x->v.v_displaced = Cnil; + + if( --Inargs < 0)goto LA1; + else { + va_start(Iap,staticp); + fillp=va_arg(Iap,object); + if (fillp == Cnil) + {x->v.v_hasfillp = 0; + x->v.v_fillp = n; + } + else + if(type_of(fillp) == t_fixnum) + { + x->v.v_fillp = Mfix(fillp); + if (x->v.v_fillp > n || x->v.v_fillp < 0) FEerror("bad fillp",0); + x->v.v_hasfillp = 1; + } + else + { + x->v.v_fillp = n; + x->v.v_hasfillp = 1; + } + + } + + if( --Inargs < 0)goto LA2; + else { + initial_element=va_arg(Iap,object);} + + if( --Inargs < 0)goto LA4; + else { + displaced_to=va_arg(Iap,object);} + + if( --Inargs < 0)goto LA5; + else { + V9=va_arg(Iap,object); + if (displaced_to != Cnil) + { + ASSURE_TYPE(V9,t_fixnum); + displaced_index_offset=Mfix(V9);}} + goto LA6; + + LA1: + x->v.v_hasfillp = 0; + x->v.v_fillp = n; + LA2: + initial_element=Cnil; + LA4: + displaced_to=Cnil; + LA5: + displaced_index_offset= 0; + LA6: + va_end(Iap); + { if (displaced_to == Cnil) + array_allocself(x,staticp!=Cnil,initial_element); + else { displace(x,displaced_to,displaced_index_offset);} + END_NO_INTERRUPT; + + return x; + } + } + } +object +fSmake_vector1_1(fixnum n,fixnum elt_type,object staticp) { + VFUN_NARGS=3; + return FFN(fSmake_vector1)(make_fixnum(n),make_fixnum(elt_type),staticp); +} +object +fSmake_vector1_2(fixnum n,fixnum elt_type,object staticp,object fillp) { + VFUN_NARGS=4; + return FFN(fSmake_vector1)(make_fixnum(n),make_fixnum(elt_type),staticp,fillp); +} + + +static object DFLT_aet_object = Cnil; +static char DFLT_aet_ch = ' '; +static char DFLT_aet_char = 0; +static fixnum DFLT_aet_fix = 0 ; +static short DFLT_aet_short = 0; +static shortfloat DFLT_aet_sf = 0.0; +static longfloat DFLT_aet_lf = 0.0; +static object Iname_t = sLt; +static struct { char * dflt; object *namep;} aet_types[] = +{ {(char *) &DFLT_aet_object, &Iname_t,}, /* t */ + {(char *) &DFLT_aet_ch, &sLcharacter,},/* character */ + {(char *) &DFLT_aet_fix, &sLbit,}, /* bit */ + {(char *) &DFLT_aet_fix, &sLfixnum,}, /* fixnum */ + {(char *) &DFLT_aet_sf, &sLshort_float,}, /* short-float */ + {(char *) &DFLT_aet_lf, &sLlong_float,}, /* long-float */ + {(char *) &DFLT_aet_char,&sSsigned_char,}, /* signed char */ + {(char *) &DFLT_aet_char,&sSunsigned_char,}, /* unsigned char */ + {(char *) &DFLT_aet_short,&sSsigned_short,}, /* signed short */ + {(char *) &DFLT_aet_short, &sSunsigned_short}, /* unsigned short */ + }; + +DEFUN_NEW("GET-AELTTYPE",object,fSget_aelttype,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ int i; + for (i=0 ; i < aet_last ; i++) + if (x == * aet_types[i].namep) + return make_fixnum((enum aelttype) i); + if (x == sLlong_float || x == sLsingle_float || x == sLdouble_float) + return make_fixnum(aet_lf); + return make_fixnum(aet_object); +} +#ifdef STATIC_FUNCTION_POINTERS +object +fSget_aelttype(object x) { + return FFN(fSget_aelttype)(x); +} +#endif + +/* backward compatibility only: + (si:make-vector element-type 0 + dimension 1 + adjustable 2 + fill-pointer 3 + displaced-to 4 + displaced-index-offset 5 + static 6 &optional initial-element) +*/ +DEFUNO_NEW("MAKE-VECTOR",object,fSmake_vector,SI,7,8,NONE, + OO,OO,OO,OO,void,siLmake_vector,(object x0,object x1,object x2,object x3,object x4,object x5,object x6,...),"") +{int narg=VFUN_NARGS; + object initial_elt; + va_list ap; + object x; + {va_start(ap,x6); + if (narg>=8) initial_elt=va_arg(ap,object);else goto LDEFAULT8; + goto LEND_VARARG; + LDEFAULT8: initial_elt = Cnil ; + LEND_VARARG: va_end(ap);} + + /* 8 args */ + + VFUN_NARGS = 8; + x = FFN(fSmake_vector1)(x1, /* n */ + fSget_aelttype(x0), /*aelt type */ + x6, /* staticp */ + x3, /* fillp */ + initial_elt, /* initial element */ + x4, /*displaced to */ + x5); /* displaced-index offset */ + x0 = x; + RETURN1(x0); +} + +/* +(proclaim '(ftype (function (fixnum t *)) make-array1)) +(defun make-array1 ( elt-type staticp initial-element + displaced-to displaced-index-offset &optional dim1 dim2 .. ) + (declare (fixnum n elt-type displaced-index-offset)) +*/ + +DEFUN_NEW("MAKE-ARRAY1",object,fSmake_array1,SI,6,6, + NONE,OI,OO,OI,OO, + (fixnum elt_type,object staticp,object initial_element,object displaced_to,fixnum displaced_index_offset, + object dimensions),"") +{ + int rank = length(dimensions); + if (rank > ARRAY_RANK_LIMIT) + FEerror("Array rank limit exceeded.",0); + { object x,v; + char *tmp_alloc; + int dim =1,i; + BEGIN_NO_INTERRUPT; + x = alloc_object(t_array); + x->a.a_elttype = elt_type; + x->a.a_self = 0; + x->a.a_rank = rank; + x->a.a_displaced = Cnil; + x->a.a_dims = AR_ALLOC(alloc_relblock,rank,int); + i = 0; + v = dimensions; + while (i < rank) + { x->a.a_dims[i] = FIX_CHECK(Mcar(v)); + if (x->a.a_dims[i] < 0) + { FEerror("Dimension must be non negative",0);} + if (dim && x->a.a_dims[i]>((1UL<<(sizeof(dim)*8-1))-1)/dim) + FEerror("Total dimension overflow on dimensions ~s",1,dimensions); + dim *= x->a.a_dims[i++]; + v = Mcdr(v);} + x->a.a_dim = dim; + x->a.a_adjustable = 1; + { if (displaced_to == Cnil) + array_allocself(x,staticp!=Cnil,initial_element); + else { displace(x,displaced_to,displaced_index_offset);} + END_NO_INTERRUPT; + return x; + } + }} +#ifdef STATIC_FUNCTION_POINTERS +object +fSmake_array1(fixnum elt_type,object staticp,object initial_element,object displaced_to, + fixnum displaced_index_offset,object dimensions) { + return FFN(fSmake_array1)(elt_type,staticp,initial_element, + displaced_to,displaced_index_offset,dimensions); +} +#endif + + +/* +(proclaim '(ftype (function (object t *)) array-displacement1)) +(defun array-displacement1 ( array ) +*/ + +/* DEFUNO_NEW("ARRAY-DISPLACEMENT1",object,fSarray_displacement,SI,1,1, */ +/* NONE,OO,OO,OO,OO,void,siLarray_displacement,"") */ +/* (object array) { */ + +/* object a; */ +/* int s,n; */ + +/* BEGIN_NO_INTERRUPT; */ +/* if (type_of(array)!=t_array && type_of(array)!=t_vector) */ +/* FEerror("Argument is not an array",0); */ +/* a=array->a.a_displaced->c.c_car; */ +/* if (a==Cnil) { */ +/* END_NO_INTERRUPT; */ +/* return make_cons(Cnil,make_fixnum(0)); */ +/* } */ +/* s=aet_sizes[Iarray_element_type(a)]; */ +/* n=(void *)array->a.a_self-(void *)a->a.a_self; */ +/* if (n%s) */ +/* FEerror("Array is displaced by fractional elements",0); */ +/* END_NO_INTERRUPT; */ +/* return make_cons(a,make_fixnum(n/s)); */ + +/* } */ + +static void +FFN(Larray_displacement)(void) { + + object array,a; + int s,n; + + BEGIN_NO_INTERRUPT; + + n = vs_top - vs_base; + if (n < 1) + FEtoo_few_arguments(vs_base,vs_top); + if (n > 1) + FEtoo_many_arguments(vs_base,vs_top); + array = vs_base[0]; + vs_base=vs_top; + +/* if (type_of(array)!=t_array && type_of(array)!=t_vector && */ +/* type_of(array)!=t_bitvector && type_of(array)!=t_string) */ +/* FEwrong_type_argument(sLarray,array); */ + IisArray(array); + a=array->a.a_displaced->c.c_car; + + if (a==Cnil) { + + vs_push(Cnil); + vs_push(make_fixnum(0)); + END_NO_INTERRUPT; + + return; + + } + + s=aet_sizes[Iarray_element_type(a)]; + n=(void *)array->a.a_self-(void *)a->a.a_self; + if (n%s) + FEerror("Array is displaced by fractional elements",0); + + vs_push(a); + vs_push(make_fixnum(n/s)); + END_NO_INTERRUPT; + + return; + +} + +/* + For the X->a.a_displaced field, the CAR is an array which X + 's body is displaced to (ie body of X is part of Another array) + and the (CDR) is the LIST of arrays whose bodies are displaced + to X + (setq a (make-array 2 :displaced-to (setq b (make-array 4 )))) + ;{ A->displ = (B), B->displ=(nil A)} +(setq w (make-array 3)) ;; w->displaced= (nil y u) +(setq y (make-array 2 :displaced-to w)) ;; y->displaced=(w z z2) +(setq u (make-array 2 :displaced-to w)) ;; u->displaced = (w) +(setq z (make-array 2 :displaced-to y)) ;; z->displaced = (y) +(setq z2 (make-array 2 :displaced-to y)) ;; z2->displaced= (y) +*/ + +static void +displace(object from_array, object dest_array, int offset) +{ + enum aelttype typ; + IisArray(from_array); + IisArray(dest_array); + typ =Iarray_element_type(from_array); + if (typ != Iarray_element_type(dest_array)) + { Wrong_type_error("same element type",0); + } + if (offset + from_array->a.a_dim > dest_array->a.a_dim) + { FEerror("Destination array too small to hold other array",0); + } + /* ensure that we have a cons */ + if (dest_array->a.a_displaced == Cnil) + { dest_array->a.a_displaced = list(2,Cnil,from_array);} + else + Mcdr(dest_array->a.a_displaced) = make_cons(from_array, + Mcdr(dest_array->a.a_displaced)); + from_array->a.a_displaced = make_cons(dest_array,sLnil); + + /* now set the actual body of from_array to be the address + of body in dest_array. If it is a bit array, this cannot carry the + offset information, since the body is only recorded as multiples of + BV_BITS + */ + + + if (typ == aet_bit) + { offset += BV_OFFSET(dest_array); + from_array->bv.bv_self = dest_array->bv.bv_self + offset/BV_BITS; + SET_BV_OFFSET(from_array,offset % BV_BITS); + } + else + from_array->a.a_self = ARRAY_BODY_PTR(dest_array,offset); + +} + + + +static enum aelttype +Iarray_element_type(object x) +{enum aelttype t=aet_last; + switch(TYPE_OF(x)) + { case t_array: + t = (enum aelttype) x->a.a_elttype; + break; + case t_vector: + t = (enum aelttype) x->v.v_elttype; + break; + case t_bitvector: + t = aet_bit; + break; + case t_string: + t = aet_ch; + break; + default: + FEerror("Not an array ~a ",1,x); + } + return t; +} + + /* Make the body of FROM array point to the body of TO + at the DISPLACED_INDEX_OFFSET + */ + +/* static void */ +/* Idisplace_array(object from, object to, int displaced_index_offset) */ +/* { */ +/* enum aelttype t1,t2; */ +/* t1 = Iarray_element_type(from); */ +/* t2 = Iarray_element_type(to); */ +/* if (t1 != t2) */ +/* FEerror("Attempt to displace arrays of one type to arrays of another type",0); */ +/* if (to->a.a_dim > from->a.a_dim - displaced_index_offset) */ +/* FEerror("To array not large enough for displacement",0); */ +/* {BEGIN_NO_INTERRUPT; */ +/* from->a.a_displaced = make_cons(to,Cnil); */ +/* if (to->a.a_displaced == Cnil) */ +/* to->a.a_displaced = make_cons(Cnil,Cnil); */ +/* DISPLACED_FROM(to) = make_cons(from,DISPLACED_FROM(to)); */ + +/* if (t1 == aet_bit) { */ +/* displaced_index_offset += BV_OFFSET(to); */ +/* from->bv.bv_self = to->bv.bv_self + displaced_index_offset/BV_BITS; */ +/* SET_BV_OFFSET(from, displaced_index_offset%BV_BITS); */ +/* } */ +/* else */ +/* from->st.st_self = ARRAY_BODY_PTR(to,displaced_index_offset); */ +/* END_NO_INTERRUPT; */ +/* } */ + +/* } */ + +/* add diff to body of x and arrays diisplaced to it */ + +void +adjust_displaced(object x, long diff) +{ + if (x->ust.ust_self != NULL) + x->ust.ust_self = (unsigned char *)((long)(x->a.a_self) + diff); + for (x = Scdr(x->ust.ust_displaced); x != Cnil; x = Scdr(x)) + adjust_displaced(Mcar(x), diff); +} + + + + + /* RAW_AET_PTR returns a pointer to something of raw type obtained from X + suitable for using GSET for an array of elt type TYP. + If x is the null pointer, return a default for that array element + type. + */ + +static char * +raw_aet_ptr(object x, short int typ) +{ /* doubles are the largest raw type */ + + static union{ + object o;char c;fixnum i;shortfloat f;longfloat d; + unsigned char uc;short s;unsigned short us;} u; + + if (x==Cnil) + return aet_types[typ].dflt; + + switch (typ){ +/* #define STORE_TYPED(pl,type,val) *((type *) pl) = (type) val; break; */ + case aet_object: + /* STORE_TYPED(&u,object,x); */ + u.o=x; + break; + case aet_ch: + /* STORE_TYPED(&u,char, char_code(x)); */ + u.c=char_code(x); + break; + case aet_bit: + /* STORE_TYPED(&u,fixnum, -Mfix(x)); */ + u.i=-Mfix(x); + break; + case aet_fix: + /* STORE_TYPED(&u,fixnum, Mfix(x)); */ + u.i=Mfix(x); + break; + case aet_sf: + /* STORE_TYPED(&u,shortfloat, Msf(x)); */ + u.f=Msf(x); + break; + case aet_lf: + /* STORE_TYPED(&u,longfloat, Mlf(x)); */ + u.d=Mlf(x); + break; + case aet_char: + /* STORE_TYPED(&u, char, Mfix(x)); */ + u.c=(char)Mfix(x); + break; + case aet_uchar: + /* STORE_TYPED(&u, unsigned char, Mfix(x)); */ + u.uc=(unsigned char)Mfix(x); + break; + case aet_short: + /* STORE_TYPED(&u, short, Mfix(x)); */ + u.s=(short)Mfix(x); + break; + case aet_ushort: + /* STORE_TYPED(&u,unsigned short,Mfix(x)); */ + u.us=(unsigned short)Mfix(x); + break; + default: + FEerror("bad elttype",0); + break; + } + return (char *)&u; +} + + + /* GSET copies into array ptr P1, the value + pointed to by the ptr VAL into the next N slots. The + array type is typ. If VAL is the null ptr, use + the default for that element type + NOTE: for type aet_bit n is the number of Words + ie (nbits +WSIZE-1)/WSIZE and the words are set. + */ + +void +gset(void *p1, void *val, int n, int typ) { + + if (val==0) + val = aet_types[typ].dflt; + + switch (typ){ + +#define GSET(p,n,typ,val) {typ x = *((typ *) val); GSET1(p,n,typ,x)} +#define GSET1(p,n,typ,val) while (n-- > 0) \ + { *((typ *) p) = val; \ + p = p + sizeof(typ); \ + } break; + + case aet_object: GSET(p1,n,object,val); + case aet_ch: GSET(p1,n,char,val); + /* Note n is number of fixnum WORDS for bit */ + case aet_bit: GSET(p1,n,fixnum,val); + case aet_fix: GSET(p1,n,fixnum,val); + case aet_sf: GSET(p1,n,shortfloat,val); + case aet_lf: GSET(p1,n,longfloat,val); + case aet_char: GSET(p1,n,char,val); + case aet_uchar: GSET(p1,n,unsigned char,val); + case aet_short: GSET(p1,n,short,val); + case aet_ushort: GSET(p1,n,unsigned short,val); + default: FEerror("bad elttype",0); + } +} + + +#define W_SIZE (BV_BITS*sizeof(fixnum)) + + /* + */ + +DEFUN_NEW("COPY-ARRAY-PORTION",object,fScopy_array_portion,SI,4, + 5,NONE,OO,OO,OO,OO,(object x,object y,object oi1,object oi2,object n1o), + "Copy elements from X to Y starting at x[i1] to x[i2] and doing N1 \ +elements if N1 is supplied otherwise, doing the length of X - I1 \ +elements. If the types of the arrays are not the same, this has \ +implementation dependent results.") +{ fixnum i1=fix(oi1),i2=fix(oi2); + enum aelttype typ1=Iarray_element_type(x); + enum aelttype typ2=Iarray_element_type(y); + int n1=fix(n1o),nc; + if (VFUN_NARGS==4) + { n1 = x->v.v_dim - i1;} + if (typ1==aet_bit) { + if (i1 % CHAR_SIZE) + badcopy: + FEerror("Bit copies only if aligned",0); + else { + int rest=n1%CHAR_SIZE; + if (rest!=0) { + if (typ2!=aet_bit) + goto badcopy; + while(rest> 0) { + fSaset1(y,i2+n1-rest,(fLrow_major_aref(x,i1+n1-rest))); + rest--; + } + } + i1=i1/CHAR_SIZE ; + n1=n1/CHAR_SIZE; + typ1=aet_char; + } + } + + if (typ2==aet_bit) { + if (i2 % CHAR_SIZE) + goto badcopy; + i2=i2/CHAR_SIZE ; + } + + if ((typ1 ==aet_object || typ2 ==aet_object) && typ1 != typ2) + FEerror("Can't copy between different array types",0); + nc=n1 * aet_sizes[(int)typ1]; + if (i1+n1 > x->a.a_dim || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) + FEerror("Copy out of bounds",0); + bcopy(x->ust.ust_self + (i1*aet_sizes[(int)typ1]), + y->ust.ust_self + (i2*aet_sizes[(int)typ2]), + nc); + + return x; + +} + +/* X is the header of an array. This supplies the body which + will not be relocatable if STATICP. If DFLT is 0, do not + initialize (the caller promises to reset these before the + next gc!). If DFLT == Cnil then initialize to default type + for this array type. Otherwise DFLT is an object and its + value is used to init the array */ + +void +array_allocself(object x, int staticp, object dflt) +{ + int n; + void *(*fun)(size_t),*tmp_alloc; + enum aelttype typ; + fun = (staticp ? alloc_contblock : alloc_relblock); + { /* this must be called from within no interrupt code */ + n = x->a.a_dim; + typ = Iarray_element_type(x); + switch (typ) { + case aet_object: + x->a.a_self = AR_ALLOC(*fun,n,object); + break; + case aet_ch: + case aet_char: + case aet_uchar: + x->st.st_self = AR_ALLOC(*fun,n,char); + break; + case aet_short: + case aet_ushort: + x->ust.ust_self = (unsigned char *) AR_ALLOC(*fun,n,short); + break; + case aet_bit: + n = (n+W_SIZE-1)/W_SIZE; + SET_BV_OFFSET(x,0); + case aet_fix: + x->fixa.fixa_self = AR_ALLOC(*fun,n,fixnum); + break; + case aet_sf: + x->sfa.sfa_self = AR_ALLOC(*fun,n,shortfloat); + break; + case aet_lf: + x->lfa.lfa_self = AR_ALLOC(*fun,n,longfloat); + break; + default: + break; + } + if(dflt!=OBJNULL) gset(x->st.st_self,raw_aet_ptr(dflt,typ),n,typ); + } + +} + +DEFUNO_NEW("FILL-POINTER-SET",object,fSfill_pointer_set,SI,2,2, + NONE,OO,IO,OO,OO,void,siLfill_pointer_set,(object x,fixnum i),"") +{ + + if (!(TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string)))) + goto no_fillp; + if (x->v.v_hasfillp == 0) + { goto no_fillp;} + if (i < 0 || i > x->a.a_dim) + { FEerror("~a is not suitable for a fill pointer for ~a",2,make_fixnum(i),x);} + x->v.v_fillp = i; + return make_fixnum(i); + + no_fillp: + FEerror("~a does not have a fill pointer",1,x); + + return make_fixnum(0); +} + +DEFUNO_NEW("FILL-POINTER",object,fLfill_pointer,LISP,1,1,NONE,OO, + OO,OO,OO,void,Lfill_pointer,(object x),"") +{ + if (!(TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string)))) + goto no_fillp; + if (x->v.v_hasfillp == 0) + { goto no_fillp;} + return make_fixnum(x->v.v_fillp) ; + + no_fillp: + FEwrong_type_argument(sLvector,x); + return make_fixnum(0); +} + +DEFUN_NEW("ARRAY-HAS-FILL-POINTER-P",object, + fLarray_has_fill_pointer_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ + if (TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string))) + return (x->v.v_hasfillp == 0 ? Cnil : sLt); + else + if (TYPE_OF(x) == t_array) + { return Cnil;} + else IisArray(x); + return Cnil; +} + + + +/* DEFUN_NEW("MAKE-ARRAY-INTERNAL",object,fSmake_array_internal,SI,0,0,NONE,OO,OO,OO,OO) + (element_type,adjustable,displaced_to,displaced_index_offset,static,initial_element,dimensions) + object element_type,adjustable,displaced_to,displaced_index_offset,static,initial_element,dimensions; + +*/ + +DEFUNO_NEW("ARRAY-ELEMENT-TYPE",object,fLarray_element_type, + LISP,1,1,NONE,OO,OO,OO,OO,void,Larray_element_type,(object x),"") +{ enum aelttype t; + t = Iarray_element_type(x); + return * aet_types[(int)t].namep; +} + +DEFUNO_NEW("ADJUSTABLE-ARRAY-P",object,fLadjustable_array_p, + LISP,1,1,NONE,OO,OO,OO,OO,void,Ladjustable_array_p,(object x),"") +{ + IisArray(x); + return sLt; +} + +DEFUNO_NEW("DISPLACED-ARRAY-P",object,fSdisplaced_array_p,SI,1, + 1,NONE,OO,OO,OO,OO,void,siLdisplaced_array_p,(object x),"") +{ IisArray(x); + return (x->a.a_displaced == Cnil ? Cnil : sLt); +} + +DEFUNO_NEW("ARRAY-RANK",object,fLarray_rank,LISP,1,1,NONE,OO,OO,OO, + OO,void,Larray_rank,(object x),"") +{ if (type_of(x) == t_array) + return make_fixnum(x->a.a_rank); + IisArray(x); + return make_fixnum(1); +} + +DEFUNO_NEW("ARRAY-DIMENSION",object,fLarray_dimension,LISP,2,2, + NONE,OO,IO,OO,OO,void,Larray_dimension,(object x,fixnum i),"") +{ + if (type_of(x) == t_array) + { if ((unsigned int)i >= x->a.a_rank) + FEerror("Index ~a out of bounds for array-dimension",1 + ,make_fixnum(i)); + else { return make_fixnum(x->a.a_dims[i]);}} + IisArray(x); + return make_fixnum(x->v.v_dim); +} + +static void +Icheck_displaced(object displaced_list, object ar, int dim) +{ + while (displaced_list!=Cnil) + { object u = Mcar(displaced_list); + displaced_list = Mcdr(displaced_list); + if (u->a.a_self == NULL) continue; + if ((Iarray_element_type(u) == aet_bit && + (u->bv.bv_self - ar->bv.bv_self)*BV_BITS +u->bv.bv_dim -dim + + BV_OFFSET(u) - BV_OFFSET(ar) > 0) + || (ARRAY_BODY_PTR(u,u->a.a_dim) > ARRAY_BODY_PTR(ar,dim))) + FEerror("Bad displacement",0); + Icheck_displaced(DISPLACED_FROM(u),ar,dim); + } +} + +/* + (setq a (make-array 2 :displaced-to (setq b (make-array 4 )))) + { A->displ = (B), B->displ=(nil A)} +(setq w (make-array 3)) ;; w->displaced= (nil y u) +(setq y (make-array 2 :displaced-to w)) ;; y->displaced=(w z z2) +(setq u (make-array 2 :displaced-to w)) ;; u->displaced = (w) +(setq z (make-array 2 :displaced-to y)) ;; z->displaced = (y) +(setq z2 (make-array 2 :displaced-to y)) ;; z2->displaced= (y) + + + Destroy the displacement from AR + + */ +/* static void */ +/* Iundisplace(object ar) */ +/* { object *p,x; */ + +/* if ((x = DISPLACED_TO(ar)) == Cnil || */ +/* ar->a.a_displaced->d.m == FREE) */ +/* return; */ +/* {BEGIN_NO_INTERRUPT; */ +/* DISPLACED_TO(ar) = Cnil; */ +/* p = &(DISPLACED_FROM(x)) ; */ + /* walk through the displaced from list and delete AR */ +/* while(1) */ +/* { if ((*p)->d.m == FREE */ +/* || *p == Cnil) */ +/* goto retur; */ +/* if((Mcar(*p) == ar)) */ +/* { *p = Mcdr(*p); */ +/* goto retur;} */ +/* p = &(Mcdr(*p)); */ +/* } */ +/* retur: */ +/* END_NO_INTERRUPT; */ +/* return; */ +/* } */ +/* } */ + +DEFUN_NEW("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE,OO,OO,OO,OO,(object old,object new),"") { + + struct dummy fw; + fw = old->d; + + old = IisArray(old); + + if (TYPE_OF(old) != TYPE_OF(new) + || (TYPE_OF(old) == t_array && old->a.a_rank != new->a.a_rank)) + { + FEerror("Cannot do array replacement ~a by ~a",2,old,new); + } + { int offset = new->ust.ust_self - old->ust.ust_self; + object displaced = make_cons(DISPLACED_TO(new),DISPLACED_FROM(old)); + Icheck_displaced(DISPLACED_FROM(old),old,new->a.a_dim); + adjust_displaced(old,offset); +/* Iundisplace(old); */ + if (TYPE_OF(old) == t_vector && old->v.v_hasfillp) + { new->v.v_hasfillp = 1; + new->v.v_fillp = old->v.v_fillp;} + if (TYPE_OF(old) == t_string) + old->st = new->st; + else + old->a = new ->a; + + /* prevent having two arrays with the same body--which are not related + that would cause the gc to try to copy both arrays and there might + not be enough space. */ + new->a.a_dim = 0; + new->a.a_self = 0; + old->d = fw; + old->a.a_displaced = displaced; + } + return old; +} + +DEFUN_NEW("ARRAY-TOTAL-SIZE",object,fLarray_total_size,LISP,1,1,NONE,IO,OO,OO,OO,(object x),"") +{ x = IisArray(x); + return (object)(fixnum)x->a.a_dim; +} + + + + +DEFUN_NEW("ASET-BY-CURSOR",object,fSaset_by_cursor,SI,3,3, + NONE,OO,OO,OO,OO,(object array,object val,object cursor),"") +{ + object x; + int i; + object ind[ARRAY_RANK_LIMIT]; + /* 3 args */ + ind[0]=array; + if (cursor==sLnil) {fSaset1(array,0,val); RETURN1(array);} + ind[1]=MMcar(cursor); + ASSURE_TYPE(ind[1],t_fixnum); + i = 2; + for (x = MMcdr(cursor); !endp(x); x = MMcdr(x)) + { ind[i++] = MMcar(x);} + ind[i]=val; + VFUN_NARGS=i+1; + + /* FIXME do this with C macros */ + switch(i+1){ + case 3: (*FFN(fSaset))(ind[0],ind[1],ind[2]);break; + case 4: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3]);break; + case 5: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4]);break; + case 6: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5]);break; + case 7: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6]);break; + case 8: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7]);break; + case 9: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8]);break; + case 10: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9]);break; + case 11: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10]);break; + case 12: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11]);break; + case 13: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12]);break; + case 14: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13]);break; + case 15: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14]);break; + case 16: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15]);break; + case 17: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16]);break; + case 18: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17]);break; + case 19: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18]);break; + case 20: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19]);break; + case 21: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20]);break; + case 22: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21]);break; + case 23: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22]);break; + case 24: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23]);break; + case 25: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24]);break; + case 26: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25]);break; + case 27: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26]);break; + case 28: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27]);break; + case 29: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28]);break; + case 30: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29]);break; + case 31: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30]);break; + case 32: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31]);break; + case 33: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32]);break; + case 34: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33]);break; + case 35: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34]);break; + case 36: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35]);break; + case 37: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36]);break; + case 38: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37]);break; + case 39: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38]);break; + case 40: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39]);break; + case 41: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40]);break; + case 42: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41]);break; + case 43: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42]);break; + case 44: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43]);break; + case 45: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44]);break; + case 46: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45]);break; + case 47: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46]);break; + case 48: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47]);break; + case 49: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48]);break; + case 50: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49]);break; + case 51: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50]);break; + case 52: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51]);break; + case 53: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52]);break; + case 54: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53]);break; + case 55: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54]);break; + case 56: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55]);break; + case 57: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56]);break; + case 58: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], + ind[57]);break; + case 59: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], + ind[57],ind[58]);break; + case 60: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], + ind[57],ind[58],ind[59]);break; + case 61: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], + ind[57],ind[58],ind[59],ind[60]);break; + case 62: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], + ind[57],ind[58],ind[59],ind[60],ind[61]);break; + case 63: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], + ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], + ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], + ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], + ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], + ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], + ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], + ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], + ind[57],ind[58],ind[59],ind[60],ind[61],ind[62]);break; +/* case 64: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], */ +/* ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], */ +/* ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], */ +/* ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], */ +/* ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], */ +/* ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], */ +/* ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], */ +/* ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], */ +/* ind[57],ind[58],ind[59],ind[60],ind[61],ind[62],ind[63]);break; */ + default: FEerror("Exceeded call-arguments-limit ",0); + } + + RETURN1(array); +} + +void +gcl_init_array_function(void) { + make_function("ARRAY-DISPLACEMENT", Larray_displacement); +} + + + + diff --git a/o/array.c.prev b/o/array.c.prev new file mode 100755 index 0000000..522beba --- /dev/null +++ b/o/array.c.prev @@ -0,0 +1,1064 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include "include.h" + + +#define ARRAY_DIMENSION_LIMIT MOST_POSITIVE_FIXNUM + +DEFCONST("ARRAY-RANK-LIMIT", sLarray_rank_limit, LISP, + make_fixnum(ARRAY_RANK_LIMIT),""); + +DEFCONST("ARRAY-DIMENSION-LIMIT", sLarray_dimension_limit, + LISP, make_fixnum(MOST_POSITIVE_FIX),""); +DEFCONST("ARRAY-TOTAL-SIZE-LIMIT", sLarray_total_size_limit, + LISP, sLarray_dimension_limit,""); + +DEF_ORDINARY("BIT",sLbit,LISP,""); + +/* number of bits in unit of storage of x->bv.bv_self[0] */ + +#define BV_BITS 8 + +#define BITREF(x,i) \ + ((((1 << (BV_BITS -1)) >> (i % BV_BITS)) & (x->bv.bv_self[i/BV_BITS])) \ + ? 1 : 0) + +#define SET_BITREF(x,i) \ + (x->bv.bv_self[i/BV_BITS]) |= ((1 << (BV_BITS -1)) >> (i % BV_BITS)) +#define CLEAR_BITREF(x,i) \ + (x->bv.bv_self[i/BV_BITS]) &= ~(((1 << (BV_BITS -1)) >> (i % BV_BITS))) + +extern short aet_sizes[]; + +#define ARRAY_BODY_PTR(ar,n) \ + (void *)(ar->ust.ust_self + aet_sizes[Iarray_element_type(ar)]*n) + +#define N_FIXNUM_ARGS 6 + +DEFUNO("AREF", object, fLaref, LISP, 2, ARRAY_RANK_LIMIT, + NONE, OO, II, II, II,Laref,"") +(x, i, va_alist) + object x; + int i; + +{ int n = VFUN_NARGS; + int i1; + va_list ap; + if (type_of(x) == t_array) + {int m,k ; + int rank = n - 1; + if (x->a.a_rank != rank) + FEerror(" ~a has wrong rank",x); + if (rank == 1) return fSaref1(x,i); + va_start(ap); + m = 0; + k = i; + /* index into 1 dimensional array */ + i1 = 0; + rank-- ; + while(1) + { + if (k > x->a.a_dims[m]) + FEerror("Index ~a to array is too large",1,make_fixnum (m)); + i1 += k; + if (m < rank) + { i1 = i1 * x->a.a_dims[m]; + if (m < N_FIXNUM_ARGS) + { k = va_arg(ap,int);} + else {object x = va_arg(ap,object); + check_type(x,t_fixnum); + k = Mfix(x);} + m++;} + else break;} + va_end(ap); + return fSaref1(x,i); + } + if (n > 2) + { FEerror("Too many args (~a) to aref",1,make_fixnum(n));} + return fSaref1(x,i); + +} + +int +fScheck_bounds_bounds(x, i) + object x; + int i; +{ + switch (type_of(x)) { + case t_array: + case t_vector: + case t_string: + if ((unsigned int) i >= x->a.a_dim) + FEerror("Array ref out of bounds ~a ~a", 2, x, make_fixnum(i)); + default: + FEerror("not an array"); + } +} + +DEFUN("SVREF", object, fLsvref, LISP, 2, 2, + ONE_VAL, OO, IO, OO,OO, + "For array X and index I it returns (aref x i) ") + (x, i) + object x; + unsigned int i; +{ + if (type_of(x)==t_vector + && (enum aelttype)x->v.v_elttype == aet_object + && x->v.v_dim > i) + RETURN1(x->v.v_self[i]); + if (x->v.v_dim > i) illegal_index(x,make_fixnum(i)); + FEerror("Bad simple vector ~a",1,x); +} + +DEFUN("AREF1", object, fSaref1, SI, 2, 2, + ONE_VAL, OO, IO, OO,OO, + "For array X and index I it returns (aref x i) as if x were \ +1 dimensional, even though its rank may be bigger than 1") +(x, i) + object x; + int i; +{ + switch (type_of(x)) { + case t_array: + case t_vector: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + switch (x->v.v_elttype) { + case aet_object: + return x->v.v_self[i]; + case aet_ch: + return code_char(x->st.st_self[i]); + case aet_bit: + i += x->bv.bv_offset; + return make_fixnum(BITREF(x, i)); + case aet_fix: + return make_fixnum(x->fixa.fixa_self[i]); + case aet_sf: + return make_longfloat(x->sfa.sfa_self[i]); + case aet_lf: + return make_longfloat(x->lfa.lfa_self[i]); + case aet_char: + return make_fixnum(x->st.st_self[i]); + case aet_uchar: + return make_fixnum(x->ust.ust_self[i]); + case aet_short: + return make_fixnum(SHORT(x, i)); + case aet_ushort: + return make_fixnum(USHORT(x, i)); + + default: + FEerror("unknown array type"); + } + case t_string: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + return code_char(x->st.st_self[i]); + default: + FEerror("not an array"); + + ; + } +} + +DEFUN("ASET1", object, fSaset1, SI, 3, 3, NONE, OO, IO, OO,OO,"") +(x, i,val) + object x; + int i; + object val; +{ + switch (type_of(x)) { + case t_array: + case t_vector: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + switch (x->v.v_elttype) { + case aet_object: + x->v.v_self[i] = val; + break; + case aet_ch: + ASSURE_TYPE(val,t_character); + x->st.st_self[i] = char_code(val); + break; + case aet_bit: + i += x->bv.bv_offset; + AGAIN_BIT: + ASSURE_TYPE(val,t_fixnum); + {int v = Mfix(val); + if (v == 0) CLEAR_BITREF(x,i); + else if (v == 1) SET_BITREF(x,i); + else {val= fSincorrect_type(val,sLbit); + goto AGAIN_BIT;} + break;} + case aet_fix: + ASSURE_TYPE(val,t_fixnum); + (x->fixa.fixa_self[i]) = Mfix(val); + break; + case aet_sf: + ASSURE_TYPE(val,t_shortfloat); + (x->sfa.sfa_self[i]) = Msf(val); + break; + case aet_lf: + ASSURE_TYPE(val,t_longfloat); + (x->lfa.lfa_self[i]) = Mlf(val); + break; + case aet_char: + ASSURE_TYPE(val,t_fixnum); + x->st.st_self[i] = Mfix(val); + break; + case aet_uchar: + ASSURE_TYPE(val,t_fixnum); + (x->ust.ust_self[i])= Mfix(val); + break; + case aet_short: + ASSURE_TYPE(val,t_fixnum); + SHORT(x, i) = Mfix(val); + break; + case aet_ushort: + ASSURE_TYPE(val,t_fixnum); + USHORT(x, i) = Mfix(val); + break; + default: + FEerror("unknown array type"); + } + break; + case t_string: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + ASSURE_TYPE(val,t_character); + x->st.st_self[i] = char_code(val); + break; + default: + FEerror("not an array",0); + } + return val; +} + +DEFUNO("ASET", object, fSaset, SI, 3, ARG_LIMIT, NONE, OO, + IO, OO, OO,siLaset,"") + (x,i,y, va_alist) + object x,y; + int i; + va_dcl +{ int i1; + int n = VFUN_NARGS; + va_list ap; + if (type_of(x) == t_array) + {int m,k ; + int rank = n - 2; + if (x->a.a_rank != rank) + FEerror(" ~a has wrong rank",x); + if (rank == 1) return fSaset1(x,i,y); + va_start(ap); + m = 0; + k = i; + /* index into 1 dimensional array body */ + i1 = 0; + rank-- ; + while(1) + { + if (k >= x->a.a_dims[m]) + FEerror("Index ~a to array is too large",1,make_fixnum (m)); + i1 += k; + if (m < rank) + {object u; + if (m == 0) + { u = y;} + else + { u = va_arg(ap,object);} + check_type(u,t_fixnum); + k = Mfix(u); + m++ ; + i1 = i1 * x->a.a_dims[m]; + + } + else + { y = va_arg(ap,object); + break ;} + } + va_end(ap); + } + else + { i1 = i ;} + return fSaset1(x,i1,y); + +} + +DEFUNO("SVSET", object, fSsvset, SI, 3, 3, NONE, OO, IO, OO, + OO,siLsvset,"") + (x,i,val) + object x,val; + int i; +{ if (TYPE_OF(x) != t_vector + || DISPLACED_TO(x) != Cnil) + Wrong_type_error("simple array",0); + if (i > x->v.v_dim) + { FEerror("out of bounds",0); + } + return x->v.v_self[i] = val; +} + +/* +(proclaim '(ftype (function (fixnum fixnum t *)) make-vector1)) +(defun make-vector1 (n elt-type staticp &optional fillp initial-element + displaced-to (displaced-index-offset 0)) + (declare (fixnum n elt-type displaced-index-offset)) +*/ + + +DEFUN("MAKE-VECTOR1",object,fSmake_vector1,SI,3,8,NONE,OI, + IO,OO,OO,"") + (n,elt_type,staticp,va_alist) +int n;int elt_type;object staticp;va_dcl +{ + int displaced_index_offset; + int Inargs = VFUN_NARGS - 3; + va_list Iap;object fillp;object initial_element;object displaced_to;object V9; + object V10,V11,V12,V13,V14; + Inargs = VFUN_NARGS - 3 ; + { object x; + BEGIN_NO_INTERRUPT; + switch(elt_type) { + case aet_ch: + x = alloc_object(t_string); + goto a_string; + break; + case aet_bit: + x = alloc_object(t_bitvector); + break; + default: + x = alloc_object(t_vector);} + x->v.v_elttype = elt_type; + a_string: + x->v.v_dim = n; + x->v.v_self = 0; + x->v.v_displaced = Cnil; + + if( --Inargs < 0)goto LA1; + else { + va_start(Iap); + fillp=va_arg(Iap,object); + if (fillp == Cnil) + {x->v.v_hasfillp = 0; + x->v.v_fillp = n; } + else { + ASSURE_TYPE(fillp,t_fixnum); + x->v.v_fillp = Mfix(fillp); + x->v.v_hasfillp = 1; + if (x->v.v_fillp > n) FEerror("bad fillp",0); + } + va_end(Iap); + } + + if( --Inargs < 0)goto LA2; + else { + initial_element=va_arg(Iap,object);} + + if( --Inargs < 0)goto LA4; + else { + displaced_to=va_arg(Iap,object);} + + if( --Inargs < 0)goto LA5; + else { + V9=va_arg(Iap,object); + if (displaced_to != Cnil) + { + ASSURE_TYPE(V9,t_fixnum); + displaced_index_offset=Mfix(V9);}} + goto LA6; + + LA1: + x->v.v_hasfillp = 0; + x->v.v_fillp = n; + LA2: + initial_element=Cnil; + LA4: + displaced_to=Cnil; + LA5: + displaced_index_offset= 0; + LA6: + x->v.v_adjustable = 1; + + { if (displaced_to == Cnil) + array_allocself(x,staticp!=Cnil,initial_element); + else { displace(x,displaced_to,displaced_index_offset);} + END_NO_INTERRUPT; + return x; + } + } + } + + + +static object DFLT_aet_object = Cnil; +static char DFLT_aet_ch = ' '; +static char DFLT_aet_char = 0; +static int DFLT_aet_fix = 0 ; +static short DFLT_aet_short = 0; +static shortfloat DFLT_aet_sf = 0.0; +static longfloat DFLT_aet_lf = 0.0; +static object Iname_t = sLt; +struct { char * dflt; object *namep;} aet_types[] = +{ (char *) &DFLT_aet_object, &Iname_t, /* t */ + (char *) &DFLT_aet_ch, &sLstring_char,/* string-char */ + (char *) &DFLT_aet_fix, &sLbit, /* bit */ + (char *) &DFLT_aet_fix, &sLfixnum, /* fixnum */ + (char *) &DFLT_aet_sf, &sLshort_float, /* short-float */ + (char *) &DFLT_aet_lf, &sLlong_float, /* long-float */ + (char *) &DFLT_aet_char,&sLsigned_char, /* signed char */ + (char *) &DFLT_aet_char,&sLunsigned_char, /* unsigned char */ + (char *) &DFLT_aet_short,&sLsigned_short, /* signed short */ + (char *) &DFLT_aet_short, &sLunsigned_short /* unsigned short */ + }; + +DEFUN("GET-AELTTYPE",enum aelttype,fSget_aelttype,SI,1,1,NONE,IO,OO,OO,OO,"") + (x) +object x; +{ int i; + for (i=0 ; i < aet_last ; i++) + if (x == * aet_types[i].namep) + return (enum aelttype) i; + if (x == sLlong_float || x == sLsingle_float || x == sLdouble_float) + return aet_lf; + return aet_object; +} + +/* backward compatibility only: + (si:make-vector element-type 0 + dimension 1 + adjustable 2 + fill-pointer 3 + displaced-to 4 + displaced-index-offset 5 + static 6 &optional initial-element) +*/ +DEFUNO("MAKE-VECTOR",object,fSmake_vector,SI,7,8,NONE, + OO,OO,OO,OO,siLmake_vector,"")(x0,x1,x2,x3,x4,x5,x6,va_alist) +object x0,x1,x2,x3,x4,x5,x6; +va_dcl +{int narg=VFUN_NARGS; + object initial_elt; + va_list ap; + object x; + {va_start(ap); + if (narg>=8) initial_elt=va_arg(ap,object);else goto LDEFAULT8; + goto LEND_VARARG; + LDEFAULT8: initial_elt = Cnil ; + LEND_VARARG: va_end(ap);} + + /* 8 args */ + + VFUN_NARGS = 8; + x = fSmake_vector1(Mfix(x1), /* n */ + fSget_aelttype(x0), /*aelt type */ + x6, /* staticp */ + x3, /* fillp */ + initial_elt, /* initial element */ + x4, /*displaced to */ + x5); /* displaced-index offset */ + x0 = x; + RETURN1(x0); +} + +/* +(proclaim '(ftype (function (fixnum t *)) make-array1)) +(defun make-array1 ( elt-type staticp initial-element + displaced-to displaced-index-offset &optional dim1 dim2 .. ) + (declare (fixnum n elt-type displaced-index-offset)) +*/ + +DEFUN("MAKE-ARRAY1",object,fSmake_array1,SI,6,6, + NONE,OI,OO,OI,OO,"") + (elt_type,staticp,initial_element,displaced_to, displaced_index_offset, + dimensions) + int elt_type; + object staticp,initial_element,displaced_to; + int displaced_index_offset; + object dimensions; +{ + int rank = length(dimensions); + { object x,v; + char *tmp_alloc; + int dim =1,i; + BEGIN_NO_INTERRUPT; + x = alloc_object(t_array); + x->a.a_elttype = elt_type; + x->a.a_self = 0; + x->a.a_rank = rank; + x->a.a_displaced = Cnil; + x->a.a_dims = AR_ALLOC(alloc_relblock,rank,int); + i = 0; + v = dimensions; + while (i < rank) + { x->a.a_dims[i] = FIX_CHECK(Mcar(v)); + dim *= x->a.a_dims[i++]; + v = Mcdr(v);} + x->a.a_dim = dim; + x->a.a_adjustable = 1; + { if (displaced_to == Cnil) + array_allocself(x,staticp!=Cnil,initial_element); + else { displace(x,displaced_to,displaced_index_offset);} + END_NO_INTERRUPT; + return x; + } + }} + + + + + + + + +/* + (setq a (make-array 2 :displaced-to (setq b (make-array 4 )))) + ;{ A->displ = (B), B->displ=(nil A)} +(setq w (make-array 3)) ;; w->displaced= (nil y u) +(setq y (make-array 2 :displaced-to w)) ;; y->displaced=(w z z2) +(setq u (make-array 2 :displaced-to w)) ;; u->displaced = (w) +(setq z (make-array 2 :displaced-to y)) ;; z->displaced = (y) +(setq z2 (make-array 2 :displaced-to y)) ;; z2->displaced= (y) +*/ + +displace(from_array,dest_array,offset) + object from_array,dest_array; + int offset; +{ + enum aelttype typ; + IisArray(from_array); + IisArray(dest_array); + typ =Iarray_element_type(from_array); + if (typ != Iarray_element_type(dest_array)) + { Wrong_type_error("same element type",0); + } + if (offset + from_array->a.a_dim > dest_array->a.a_dim) + { FEerror("Destination array too small to hold other array",0); + } + /* ensure that we have a cons */ + if (dest_array->a.a_displaced == Cnil) + { dest_array->a.a_displaced = list(2,Cnil,from_array);} + else + Mcdr(dest_array->a.a_displaced) = make_cons(from_array, + Mcdr(dest_array->a.a_displaced)); + from_array->a.a_displaced = make_cons(dest_array,sLnil); + + /* now set the actual body of from_array to be the address + of body in dest_array. If it is a bit array, this cannot carry the + offset information, since the body is only recorded as multiples of + BV_BITS + */ + + + if (typ == aet_bit) + { offset += dest_array->bv.bv_offset; + from_array->bv.bv_self = dest_array->bv.bv_self + offset/BV_BITS; + from_array->bv.bv_offset = offset % BV_BITS; + } + else + from_array->a.a_self = ARRAY_BODY_PTR(dest_array,offset); + +} + + + +enum aelttype +Iarray_element_type(x) + object x; +{enum aelttype t; + switch(TYPE_OF(x)) + { case t_array: + t = (enum aelttype) x->a.a_elttype; + break; + case t_vector: + t = (enum aelttype) x->v.v_elttype; + break; + case t_bitvector: + t = aet_bit; + break; + case t_string: + t = aet_ch; + break; + default: + FEerror("Not an array ~a ",1,x); + } + return t; +} + + /* Make the body of FROM array point to the body of TO + at the DISPLACED_INDEX_OFFSET + */ + +Idisplace_array(from,to,displaced_index_offset) + object from,to; + int displaced_index_offset; +{ + enum aelttype t1,t2; + object tail; + t1 = Iarray_element_type(from); + t2 = Iarray_element_type(to); + if (t1 != t2) + FEerror("Attempt to displace arrays of one type to arrays of another type",0); + if (to->a.a_dim > from->a.a_dim - displaced_index_offset) + FEerror("To array not large enough for displacement",0); + {BEGIN_NO_INTERRUPT; + from->a.a_displaced = make_cons(to,Cnil); + if (to->a.a_displaced == Cnil) + to->a.a_displaced = make_cons(Cnil,Cnil); + DISPLACED_FROM(to) = make_cons(from,DISPLACED_FROM(to)); + + if (t1 == aet_bit) { + displaced_index_offset += to->bv.bv_offset; + from->bv.bv_self = to->bv.bv_self + displaced_index_offset/BV_BITS; + from->bv.bv_offset = displaced_index_offset%BV_BITS; + } + else + from->st.st_self = ARRAY_BODY_PTR(to,displaced_index_offset); + END_NO_INTERRUPT; + } + +} + +/* add diff to body of x and arrays diisplaced to it */ + +adjust_displaced(x, diff) +object x; +int diff; +{ + if (x->ust.ust_self != NULL) + x->ust.ust_self = (char *)((int)(x->a.a_self) + diff); + for (x = Mcdr(x->ust.ust_displaced); x != Cnil; x = Mcdr(x)) + adjust_displaced(Mcar(x), diff); +} + + + + + /* RAW_AET_PTR returns a pointer to something of raw type obtained from X + suitable for using GSET for an array of elt type TYP. + If x is the null pointer, return a default for that array element + type. + */ + +char * +raw_aet_ptr(x,typ) + short typ; + object x; +{ /* doubles are the largest raw type */ + static double u; + if (x==Cnil) return aet_types[typ].dflt; + switch (typ){ +#define STORE_TYPED(pl,type,val) *((type *) pl) = (type) val; break; + case aet_object: STORE_TYPED(&u,object,x); + case aet_ch: STORE_TYPED(&u,char, char_code(x)); + case aet_bit: STORE_TYPED(&u,fixnum, -Mfix(x)); + case aet_fix: STORE_TYPED(&u,fixnum, Mfix(x)); + case aet_sf: STORE_TYPED(&u,shortfloat, Msf(x)); + case aet_lf: STORE_TYPED(&u,longfloat, Mlf(x)); + case aet_char: STORE_TYPED(&u, char, Mfix(x)); + case aet_uchar: STORE_TYPED(&u, unsigned char, Mfix(x)); + case aet_short: STORE_TYPED(&u, short, Mfix(x)); + case aet_ushort: STORE_TYPED(&u,unsigned short,Mfix(x)); + default: FEerror("bad elttype",0); + } + return (char *)&u; +} + + + /* GSET copies into array ptr P1, the value + pointed to by the ptr VAL into the next N slots. The + array type is typ. If VAL is the null ptr, use + the default for that element type + NOTE: for type aet_bit n is the number of Words + ie (nbits +WSIZE-1)/WSIZE and the words are set. + */ + +gset(p1,val,n,typ) + char *p1,*val; + int n; + int typ; +{ if (val==0) + val = aet_types[typ].dflt; + switch (typ){ + +#define GSET(p,n,typ,val) {typ x = *((typ *) val); GSET1(p,n,typ,x)} +#define GSET1(p,n,typ,val) while (n-- > 0) \ + { *((typ *) p) = val; \ + p = p + sizeof(typ); \ + } break; + + case aet_object: GSET(p1,n,object,val); + case aet_ch: GSET(p1,n,char,val); + /* Note n is number of fixnum WORDS for bit */ + case aet_bit: GSET(p1,n,fixnum,val); + case aet_fix: GSET(p1,n,fixnum,val); + case aet_sf: GSET(p1,n,shortfloat,val); + case aet_lf: GSET(p1,n,longfloat,val); + case aet_char: GSET(p1,n,char,val); + case aet_uchar: GSET(p1,n,unsigned char,val); + case aet_short: GSET(p1,n,short,val); + case aet_ushort: GSET(p1,n,unsigned short,val); + default: FEerror("bad elttype",0); + } + } + + +#define W_SIZE (BV_BITS*sizeof(fixnum)) + + /* + */ + +DEFUN("COPY-ARRAY-PORTION",object,fScopy_array_portion,SI,4, + 5,NONE,OO,OI,II,OO, + "Copy elements from X to Y starting at x[i1] to x[i2] and doing N1 \ +elements if N1 is supplied otherwise, doing the length of X - I1 \ +elements. If the types of the arrays are not the same, this has \ +implementation dependent results.") + (x,y,i1,i2,n1) + object x,y; int i1,i2,n1; +{ enum aelttype typ1=Iarray_element_type(x); + enum aelttype typ2=Iarray_element_type(y); + int nc; + if (VFUN_NARGS==4) + { n1 = x->v.v_dim - i1;} + if (typ1==aet_bit) + {if (i1 % CHAR_SIZE) + badcopy: + FEerror("Bit copies only if aligned"); + else + {int rest=n1%CHAR_SIZE; + if (rest!=0 ) + {if (typ2!=aet_bit) + goto badcopy; + {while(rest> 0) + { fSaset1(y,i2+n1-rest,(fSaref1(x,i1+n1-rest))); + rest--;} + }} + i1=i1/CHAR_SIZE ; + n1=n1/CHAR_SIZE; + typ1=aet_char; + }}; + if (typ2==aet_bit) + {if (i2 % CHAR_SIZE) + goto badcopy; + i2=i2/CHAR_SIZE ;} + if ((typ1 ==aet_object || + typ2 ==aet_object) && typ1 != typ2) + FEerror("Can't copy between different array types"); + nc=n1 * aet_sizes[(int)typ1]; + if (i1+n1 > x->a.a_dim + || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) + FEerror("Copy out of bounds"); + bcopy(x->ust.ust_self + (i1*aet_sizes[(int)typ1]), + y->ust.ust_self + (i2*aet_sizes[(int)typ2]), + nc); + return x; +} + +/* X is the header of an array. This supplies the body which + will not be relocatable if STATICP. If DFLT is 0, do not + initialize (the caller promises to reset these before the + next gc!). If DFLT == Cnil then initialize to default type + for this array type. Otherwise DFLT is an object and its + value is used to init the array */ + +array_allocself(x, staticp, dflt) +object x,dflt; +int staticp; +{ + int i, d,n; + char *(*fun)(),*tmp_alloc; + enum aelttype typ; + fun = (staticp ? alloc_contblock : alloc_relblock); + { /* this must be called from within no interrupt code */ + n = x->a.a_dim; + typ = Iarray_element_type(x); + switch (typ) { + case aet_object: + x->a.a_self = AR_ALLOC(*fun,n,object); + break; + case aet_ch: + case aet_char: + case aet_uchar: + x->st.st_self = AR_ALLOC(*fun,n,char); + break; + case aet_short: + case aet_ushort: + x->ust.ust_self = (unsigned char *) AR_ALLOC(*fun,n,short); + break; + case aet_bit: + n = (n+W_SIZE-1)/W_SIZE; + x->bv.bv_offset = 0; + case aet_fix: + x->fixa.fixa_self = AR_ALLOC(*fun,n,fixnum); + break; + case aet_sf: + x->sfa.sfa_self = AR_ALLOC(*fun,n,shortfloat); + break; + case aet_lf: + x->lfa.lfa_self = AR_ALLOC(*fun,n,longfloat); + break; + } + if(dflt!=0) gset(x->st.st_self,raw_aet_ptr(dflt,typ),n,typ); + } + +} + +DEFUNO("FILL-POINTER-SET",int,fSfill_pointer_set,SI,2,2, + NONE,IO,IO,OO,OO,siLfill_pointer_set,"") + (x,i) + object x; + int i; +{ + + if (!(TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string)))) + goto no_fillp; + if (x->v.v_hasfillp == 0) + { goto no_fillp;} + if (i < 0 || i > x->a.a_dim) + { FEerror("~a is not suitable for a fill pointer for ~a",2,make_fixnum(i),x);} + x->v.v_fillp = i; + return i; + + no_fillp: + FEerror("~a does not have a fill pointer",1,x); + + return 0; +} + +DEFUNO("FILL-POINTER",int,fLfill_pointer,LISP,1,1,NONE,IO, + OO,OO,OO,Lfill_pointer,"") + (x) + object x; +{ + if (!(TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string)))) + goto no_fillp; + if (x->v.v_hasfillp == 0) + { goto no_fillp;} + return x->v.v_fillp ; + + no_fillp: + FEerror("~a does not have a fill pointer",1,x); + return 0; +} + +DEFUN("ARRAY-HAS-FILL-POINTER-P",object, + fLarray_has_fill_pointer_p,LISP,1,1,NONE,OO,OO,OO,OO,"") + (x) + object x; +{ + if (TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string))) + return (x->v.v_hasfillp == 0 ? Cnil : sLt); + else + if (TYPE_OF(x) == t_array) + { return Cnil;} + else IisArray(x); + return Cnil; +} + + + +/* DEFUN("MAKE-ARRAY-INTERNAL",object,fSmake_array_internal,SI,0,0,NONE,OO,OO,OO,OO) + (element_type,adjustable,displaced_to,displaced_index_offset,static,initial_element,dimensions) + object element_type,adjustable,displaced_to,displaced_index_offset,static,initial_element,dimensions; + +*/ + +DEFUNO("ARRAY-ELEMENT-TYPE",object,fLarray_element_type, + LISP,1,1,NONE,OO,OO,OO,OO,Larray_element_type,"") + (x) + object x; +{ enum aelttype t; + t = Iarray_element_type(x); + return * aet_types[(int)t].namep; +} + +DEFUNO("ADJUSTABLE-ARRAY-P",object,fLadjustable_array_p, + LISP,1,1,NONE,OO,OO,OO,OO,Ladjustable_array_p,"") + (x) + object x; +{ return sLt; +} + +DEFUNO("DISPLACED-ARRAY-P",object,fSdisplaced_array_p,SI,1, + 1,NONE,OO,OO,OO,OO,siLdisplaced_array_p,"") + (x) + object x; +{ IisArray(x); + return (x->a.a_displaced == Cnil ? Cnil : sLt); +} + +DEFUNO("ARRAY-RANK",int,fLarray_rank,LISP,1,1,NONE,IO,OO,OO, + OO,Larray_rank,"") + (x) + object x; +{ if (type_of(x) == t_array) + return x->a.a_rank; + IisArray(x); + return 1; +} + +DEFUNO("ARRAY-DIMENSION",int,fLarray_dimension,LISP,2,2, + NONE,IO,IO,OO,OO,Larray_dimension,"") + (x,i) + object x; int i; +{ + if (type_of(x) == t_array) + { if (i >= x->a.a_rank) FEerror("Index to large for array-dimension"); + else { return x->a.a_dims[i];}} + IisArray(x); + return x->v.v_dim; +} + +Icheck_displaced(displaced_list,ar,dim) + object displaced_list,ar; + int dim; +{ + while (displaced_list!=Cnil) + { object u = Mcar(displaced_list); + if (u->a.a_self == NULL) continue; + if ((Iarray_element_type(u) == aet_bit && + (u->bv.bv_self - ar->bv.bv_self)*BV_BITS +u->bv.bv_dim -dim + + u->bv.bv_offset - ar->bv.bv_offset > 0) + || (ARRAY_BODY_PTR(u,u->a.a_dim) > ARRAY_BODY_PTR(ar,dim))) + FEerror("Bad displacement",0); + Icheck_displaced(DISPLACED_FROM(u),ar,dim); + displaced_list = Mcdr(displaced_list); + } +} + +/* + (setq a (make-array 2 :displaced-to (setq b (make-array 4 )))) + { A->displ = (B), B->displ=(nil A)} +(setq w (make-array 3)) ;; w->displaced= (nil y u) +(setq y (make-array 2 :displaced-to w)) ;; y->displaced=(w z z2) +(setq u (make-array 2 :displaced-to w)) ;; u->displaced = (w) +(setq z (make-array 2 :displaced-to y)) ;; z->displaced = (y) +(setq z2 (make-array 2 :displaced-to y)) ;; z2->displaced= (y) + + + Destroy the displacement from AR + + */ +Iundisplace(ar) +object ar; +{ object *p,x; + + if ((x = DISPLACED_TO(ar)) == Cnil || + ar->a.a_displaced->d.m == FREE) + return; + {BEGIN_NO_INTERRUPT; + DISPLACED_TO(ar) = Cnil; + p = &(DISPLACED_FROM(x)) ; + /* walk through the displaced from list and delete AR */ + while(1) + { if ((*p)->d.m == FREE + || *p == Cnil) + goto retur; + if((Mcar(*p) == ar)) + { *p = Mcdr(*p); + goto retur;} + p = &(Mcdr(*p)); + } + retur: + END_NO_INTERRUPT; + return; + } +} + +DEFUNO("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE, + OO,OO,OO,OO,siLreplace_array,"") + (old,new) + object old,new; +{ struct dummy fw ; + fw = old->d; + + old = IisArray(old); + + if (TYPE_OF(old) != TYPE_OF(new) + || (TYPE_OF(old) == t_array && old->a.a_rank != new->a.a_rank)) + { FAIL: + FEerror("Cannot do array replacement ~a by ~a",2,old,new); + } + { int offset = new->ust.ust_self - old->ust.ust_self; + object old_list = DISPLACED_FROM(old); + object displaced = make_cons(DISPLACED_TO(new),DISPLACED_FROM(old)); + Icheck_displaced(DISPLACED_FROM(old),old,new->a.a_dim); + adjust_displaced(old,offset); +/* Iundisplace(old); */ + if (old->v.v_hasfillp) + { new->v.v_hasfillp = 1; + new->v.v_fillp = old->v.v_fillp;} + if (TYPE_OF(old) == t_string) + old->st = new->st; + else + old->a = new ->a; + + /* prevent having two arrays with the same body--which are not related + that would cause the gc to try to copy both arrays and there might + not be enough space. */ + new->a.a_dim = 0; + new->a.a_self = 0; + old->d = fw; + old->a.a_displaced = displaced; + } + return old; +} + +DEFUNO("ARRAY-TOTAL-SIZE",int,fLarray_total_size,LISP,1,1, + NONE,IO,OO,OO,OO,Larray_total_size,"") + (x) + object x; +{ x = IisArray(x); + return x->a.a_dim; +} + + +DEFUNO("ASET-BY-CURSOR",object,fSaset_by_cursor,SI,3,3, + NONE,OO,OO,OO,OO,siLaset_by_cursor,"")(array,val,cursor) +object array,val,cursor; +{ + object endp_temp; + object x; + int i; + object ind[ARRAY_RANK_LIMIT]; + /* 3 args */ + ind[0]=array; + ind[1]=(object) Mfix(MMcar(cursor)); + i = 2; + for (x = MMcdr(cursor); !endp(x); x = MMcdr(x)) + { ind[i++] = MMcar(x);} + ind[i]=val; + VFUN_NARGS=i+1; + c_apply_n(fSaset,i+1,ind); + RETURN1(array); +} + +init_array_function(){;} + + + + diff --git a/o/array.c1 b/o/array.c1 new file mode 100755 index 0000000..26a9641 --- /dev/null +++ b/o/array.c1 @@ -0,0 +1,1085 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include "include.h" + + +#define ARRAY_DIMENSION_LIMIT MOST_POSITIVE_FIXNUM + +DEFCONST("ARRAY-RANK-LIMIT", sLarray_rank_limit, LISP, + make_fixnum(ARRAY_RANK_LIMIT),""); + +DEFCONST("ARRAY-DIMENSION-LIMIT", sLarray_dimension_limit, + LISP, make_fixnum(MOST_POSITIVE_FIX),""); +DEFCONST("ARRAY-TOTAL-SIZE-LIMIT", sLarray_total_size_limit, + LISP, sLarray_dimension_limit,""); + +DEF_ORDINARY("BIT",sLbit,LISP,""); + +/* number of bits in unit of storage of x->bv.bv_self[0] */ + +#define BV_BITS 8 + +#define BITREF(x,i) \ + ((((1 << (BV_BITS -1)) >> (i % BV_BITS)) & (x->bv.bv_self[i/BV_BITS])) \ + ? 1 : 0) + +#define SET_BITREF(x,i) \ + (x->bv.bv_self[i/BV_BITS]) |= ((1 << (BV_BITS -1)) >> (i % BV_BITS)) +#define CLEAR_BITREF(x,i) \ + (x->bv.bv_self[i/BV_BITS]) &= ~(((1 << (BV_BITS -1)) >> (i % BV_BITS))) + +extern short aet_sizes[]; + +#define ARRAY_BODY_PTR(ar,n) \ + (void *)(ar->ust.ust_self + aet_sizes[Iarray_element_type(ar)]*n) + +#define N_FIXNUM_ARGS 6 + +DEFUNO("AREF", object, fLaref, LISP, 1, ARRAY_RANK_LIMIT, + NONE, OO, II, II, II,Laref,"") +(x, i, va_alist) + object x; + int i; + va_dcl +{ int n = VFUN_NARGS; + int i1; + va_list ap; + if (type_of(x) == t_array) + {int m,k ; + int rank = n - 1; + if (x->a.a_rank != rank) + FEerror(" ~a has wrong rank",1,x); + if (rank == 1) return fSaref1(x,i); + if (rank == 0) return fSaref1(x,0); + va_start(ap); + m = 0; + k = i; + /* index into 1 dimensional array */ + i1 = 0; + rank-- ; + while(1) + { + if (k >= x->a.a_dims[m]) + FEerror("Index ~a to array is too large",1,make_fixnum (m)); + i1 += k; + m ++; + if (m <= rank) + { i1 = i1 * x->a.a_dims[m]; + if (m < N_FIXNUM_ARGS) + { k = va_arg(ap,int);} + else {object x = va_arg(ap,object); + check_type(x,t_fixnum); + k = Mfix(x);} + + } + else break;} + va_end(ap); + return fSaref1(x,i1); + } + if (n > 2) + { FEerror("Too many args (~a) to aref",1,make_fixnum(n));} + return fSaref1(x,i); + +} + +int +fScheck_bounds_bounds(x, i) + object x; + int i; +{ + switch (type_of(x)) { + case t_array: + case t_vector: + case t_string: + if ((unsigned int) i >= x->a.a_dim) + FEerror("Array ref out of bounds ~a ~a", 2, x, make_fixnum(i)); + default: + FEerror("not an array"); + } +} + +DEFUN("SVREF", object, fLsvref, LISP, 2, 2, + ONE_VAL, OO, IO, OO,OO, + "For array X and index I it returns (aref x i) ") + (x, i) + object x; + unsigned int i; +{ + if (type_of(x)==t_vector + && (enum aelttype)x->v.v_elttype == aet_object + && x->v.v_dim > i) + RETURN1(x->v.v_self[i]); + if (x->v.v_dim > i) illegal_index(x,make_fixnum(i)); + FEerror("Bad simple vector ~a",1,x); +} + +DEFUN("AREF1", object, fSaref1, SI, 2, 2, + NONE, OO, IO, OO,OO, + "For array X and index I it returns (aref x i) as if x were \ +1 dimensional, even though its rank may be bigger than 1") +(x, i) + object x; + int i; +{ + switch (type_of(x)) { + case t_array: + case t_vector: + case t_bitvector: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + switch (x->v.v_elttype) { + case aet_object: + return x->v.v_self[i]; + case aet_ch: + return code_char(x->st.st_self[i]); + case aet_bit: + i += x->bv.bv_offset; + return make_fixnum(BITREF(x, i)); + case aet_fix: + return make_fixnum(x->fixa.fixa_self[i]); + case aet_sf: + return make_longfloat(x->sfa.sfa_self[i]); + case aet_lf: + return make_longfloat(x->lfa.lfa_self[i]); + case aet_char: + return make_fixnum(x->st.st_self[i]); + case aet_uchar: + return make_fixnum(x->ust.ust_self[i]); + case aet_short: + return make_fixnum(SHORT(x, i)); + case aet_ushort: + return make_fixnum(USHORT(x, i)); + + default: + FEerror("unknown array type"); + } + case t_string: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + return code_char(x->st.st_self[i]); + default: + FEerror("not an array"); + + ; + } +} + +DEFUN("ASET1", object, fSaset1, SI, 3, 3, NONE, OO, IO, OO,OO,"") +(x, i,val) + object x; + int i; + object val; +{ + switch (type_of(x)) { + case t_array: + case t_vector: + case t_bitvector: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + switch (x->v.v_elttype) { + case aet_object: + x->v.v_self[i] = val; + break; + case aet_ch: + ASSURE_TYPE(val,t_character); + x->st.st_self[i] = char_code(val); + break; + case aet_bit: + i += x->bv.bv_offset; + AGAIN_BIT: + ASSURE_TYPE(val,t_fixnum); + {int v = Mfix(val); + if (v == 0) CLEAR_BITREF(x,i); + else if (v == 1) SET_BITREF(x,i); + else {val= fSincorrect_type(val,sLbit); + goto AGAIN_BIT;} + break;} + case aet_fix: + ASSURE_TYPE(val,t_fixnum); + (x->fixa.fixa_self[i]) = Mfix(val); + break; + case aet_sf: + ASSURE_TYPE(val,t_shortfloat); + (x->sfa.sfa_self[i]) = Msf(val); + break; + case aet_lf: + ASSURE_TYPE(val,t_longfloat); + (x->lfa.lfa_self[i]) = Mlf(val); + break; + case aet_char: + ASSURE_TYPE(val,t_fixnum); + x->st.st_self[i] = Mfix(val); + break; + case aet_uchar: + ASSURE_TYPE(val,t_fixnum); + (x->ust.ust_self[i])= Mfix(val); + break; + case aet_short: + ASSURE_TYPE(val,t_fixnum); + SHORT(x, i) = Mfix(val); + break; + case aet_ushort: + ASSURE_TYPE(val,t_fixnum); + USHORT(x, i) = Mfix(val); + break; + default: + FEerror("unknown array type"); + } + break; + case t_string: + if (x->v.v_dim <= i) + i = fScheck_bounds_bounds(x, i); + ASSURE_TYPE(val,t_character); + x->st.st_self[i] = char_code(val); + break; + default: + FEerror("not an array",0); + } + return val; +} + +DEFUNO("ASET", object, fSaset, SI, 1, ARG_LIMIT, NONE, OO, + OO, OO, OO,siLaset,"") + (x,ii,y, va_alist) + object x,y; + object ii; + va_dcl +{ int i1; + int n = VFUN_NARGS; + int i; + va_list ap; + if (type_of(x) == t_array) + {int m,k ; + int rank = n - 2; + if (x->a.a_rank != rank) + FEerror(" ~a has wrong rank",x); + if (rank == 0) return fSaset1(x,0,ii); + ASSURE_TYPE(ii,t_fixnum); + i = fix(ii); + if (rank == 1) + return fSaset1(x,i,y); + va_start(ap); + m = 0; + k = i; + /* index into 1 dimensional array body */ + i1 = 0; + rank-- ; + while(1) + { + if (k >= x->a.a_dims[m]) + FEerror("Index ~a to array is too large",1,make_fixnum (m)); + i1 += k; + if (m < rank) + {object u; + if (m == 0) + { u = y;} + else + { u = va_arg(ap,object);} + check_type(u,t_fixnum); + k = Mfix(u); + m++ ; + i1 = i1 * x->a.a_dims[m]; + + } + else + { y = va_arg(ap,object); + break ;} + } + va_end(ap); + } + else + { ASSURE_TYPE(ii,t_fixnum); + i1 = fix(ii); + } + return fSaset1(x,i1,y); + +} + +DEFUNO("SVSET", object, fSsvset, SI, 3, 3, NONE, OO, IO, OO, + OO,siLsvset,"") + (x,i,val) + object x,val; + int i; +{ if (TYPE_OF(x) != t_vector + || DISPLACED_TO(x) != Cnil) + Wrong_type_error("simple array",0); + if (i > x->v.v_dim) + { FEerror("out of bounds",0); + } + return x->v.v_self[i] = val; +} + +/* +(proclaim '(ftype (function (fixnum fixnum t *)) make-vector1)) +(defun make-vector1 (n elt-type staticp &optional fillp initial-element + displaced-to (displaced-index-offset 0)) + (declare (fixnum n elt-type displaced-index-offset)) +*/ + + +DEFUN("MAKE-VECTOR1",object,fSmake_vector1,SI,3,8,NONE,OI, + IO,OO,OO,"") + (n,elt_type,staticp,va_alist) +int n;int elt_type;object staticp;va_dcl +{ + int displaced_index_offset; + int Inargs = VFUN_NARGS - 3; + va_list Iap;object fillp;object initial_element;object displaced_to;object V9; + object V10,V11,V12,V13,V14; + Inargs = VFUN_NARGS - 3 ; + { object x; + BEGIN_NO_INTERRUPT; + switch(elt_type) { + case aet_ch: + x = alloc_object(t_string); + goto a_string; + break; + case aet_bit: + x = alloc_object(t_bitvector); + break; + default: + x = alloc_object(t_vector);} + x->v.v_elttype = elt_type; + a_string: + x->v.v_dim = n; + x->v.v_self = 0; + x->v.v_displaced = Cnil; + + if( --Inargs < 0)goto LA1; + else { + va_start(Iap); + fillp=va_arg(Iap,object); + if (fillp == Cnil) + {x->v.v_hasfillp = 0; + x->v.v_fillp = n; + } + else + if(type_of(fillp) == t_fixnum) + { + x->v.v_fillp = Mfix(fillp); + if (x->v.v_fillp > n) FEerror("bad fillp",0); + x->v.v_hasfillp = 1; + } + else + { + x->v.v_fillp = n; + x->v.v_hasfillp = 1; + } + + } + + if( --Inargs < 0)goto LA2; + else { + initial_element=va_arg(Iap,object);} + + if( --Inargs < 0)goto LA4; + else { + displaced_to=va_arg(Iap,object);} + + if( --Inargs < 0)goto LA5; + else { + V9=va_arg(Iap,object); + if (displaced_to != Cnil) + { + ASSURE_TYPE(V9,t_fixnum); + displaced_index_offset=Mfix(V9);}} + goto LA6; + + LA1: + x->v.v_hasfillp = 0; + x->v.v_fillp = n; + LA2: + initial_element=Cnil; + LA4: + displaced_to=Cnil; + LA5: + displaced_index_offset= 0; + LA6: + x->v.v_adjustable = 1; + va_end(Iap); + { if (displaced_to == Cnil) + array_allocself(x,staticp!=Cnil,initial_element); + else { displace(x,displaced_to,displaced_index_offset);} + END_NO_INTERRUPT; + + return x; + } + } + } + + + +static object DFLT_aet_object = Cnil; +static char DFLT_aet_ch = ' '; +static char DFLT_aet_char = 0; +static int DFLT_aet_fix = 0 ; +static short DFLT_aet_short = 0; +static shortfloat DFLT_aet_sf = 0.0; +static longfloat DFLT_aet_lf = 0.0; +static object Iname_t = sLt; +struct { char * dflt; object *namep;} aet_types[] = +{ (char *) &DFLT_aet_object, &Iname_t, /* t */ + (char *) &DFLT_aet_ch, &sLstring_char,/* string-char */ + (char *) &DFLT_aet_fix, &sLbit, /* bit */ + (char *) &DFLT_aet_fix, &sLfixnum, /* fixnum */ + (char *) &DFLT_aet_sf, &sLshort_float, /* short-float */ + (char *) &DFLT_aet_lf, &sLlong_float, /* long-float */ + (char *) &DFLT_aet_char,&sLsigned_char, /* signed char */ + (char *) &DFLT_aet_char,&sLunsigned_char, /* unsigned char */ + (char *) &DFLT_aet_short,&sLsigned_short, /* signed short */ + (char *) &DFLT_aet_short, &sLunsigned_short /* unsigned short */ + }; + +DEFUN("GET-AELTTYPE",enum aelttype,fSget_aelttype,SI,1,1,NONE,IO,OO,OO,OO,"") + (x) +object x; +{ int i; + for (i=0 ; i < aet_last ; i++) + if (x == * aet_types[i].namep) + return (enum aelttype) i; + if (x == sLlong_float || x == sLsingle_float || x == sLdouble_float) + return aet_lf; + return aet_object; +} + +/* backward compatibility only: + (si:make-vector element-type 0 + dimension 1 + adjustable 2 + fill-pointer 3 + displaced-to 4 + displaced-index-offset 5 + static 6 &optional initial-element) +*/ +DEFUNO("MAKE-VECTOR",object,fSmake_vector,SI,7,8,NONE, + OO,OO,OO,OO,siLmake_vector,"")(x0,x1,x2,x3,x4,x5,x6,va_alist) +object x0,x1,x2,x3,x4,x5,x6; +va_dcl +{int narg=VFUN_NARGS; + object initial_elt; + va_list ap; + object x; + {va_start(ap); + if (narg>=8) initial_elt=va_arg(ap,object);else goto LDEFAULT8; + goto LEND_VARARG; + LDEFAULT8: initial_elt = Cnil ; + LEND_VARARG: va_end(ap);} + + /* 8 args */ + + VFUN_NARGS = 8; + x = fSmake_vector1(Mfix(x1), /* n */ + fSget_aelttype(x0), /*aelt type */ + x6, /* staticp */ + x3, /* fillp */ + initial_elt, /* initial element */ + x4, /*displaced to */ + x5); /* displaced-index offset */ + x0 = x; + RETURN1(x0); +} + +/* +(proclaim '(ftype (function (fixnum t *)) make-array1)) +(defun make-array1 ( elt-type staticp initial-element + displaced-to displaced-index-offset &optional dim1 dim2 .. ) + (declare (fixnum n elt-type displaced-index-offset)) +*/ + +DEFUN("MAKE-ARRAY1",object,fSmake_array1,SI,6,6, + NONE,OI,OO,OI,OO,"") + (elt_type,staticp,initial_element,displaced_to, displaced_index_offset, + dimensions) + int elt_type; + object staticp,initial_element,displaced_to; + int displaced_index_offset; + object dimensions; +{ + int rank = length(dimensions); + { object x,v; + char *tmp_alloc; + int dim =1,i; + BEGIN_NO_INTERRUPT; + x = alloc_object(t_array); + x->a.a_elttype = elt_type; + x->a.a_self = 0; + x->a.a_rank = rank; + x->a.a_displaced = Cnil; + x->a.a_dims = AR_ALLOC(alloc_relblock,rank,int); + i = 0; + v = dimensions; + while (i < rank) + { x->a.a_dims[i] = FIX_CHECK(Mcar(v)); + dim *= x->a.a_dims[i++]; + v = Mcdr(v);} + x->a.a_dim = dim; + x->a.a_adjustable = 1; + { if (displaced_to == Cnil) + array_allocself(x,staticp!=Cnil,initial_element); + else { displace(x,displaced_to,displaced_index_offset);} + END_NO_INTERRUPT; + return x; + } + }} + + + + + + + + +/* + (setq a (make-array 2 :displaced-to (setq b (make-array 4 )))) + ;{ A->displ = (B), B->displ=(nil A)} +(setq w (make-array 3)) ;; w->displaced= (nil y u) +(setq y (make-array 2 :displaced-to w)) ;; y->displaced=(w z z2) +(setq u (make-array 2 :displaced-to w)) ;; u->displaced = (w) +(setq z (make-array 2 :displaced-to y)) ;; z->displaced = (y) +(setq z2 (make-array 2 :displaced-to y)) ;; z2->displaced= (y) +*/ + +displace(from_array,dest_array,offset) + object from_array,dest_array; + int offset; +{ + enum aelttype typ; + IisArray(from_array); + IisArray(dest_array); + typ =Iarray_element_type(from_array); + if (typ != Iarray_element_type(dest_array)) + { Wrong_type_error("same element type",0); + } + if (offset + from_array->a.a_dim > dest_array->a.a_dim) + { FEerror("Destination array too small to hold other array",0); + } + /* ensure that we have a cons */ + if (dest_array->a.a_displaced == Cnil) + { dest_array->a.a_displaced = list(2,Cnil,from_array);} + else + Mcdr(dest_array->a.a_displaced) = make_cons(from_array, + Mcdr(dest_array->a.a_displaced)); + from_array->a.a_displaced = make_cons(dest_array,sLnil); + + /* now set the actual body of from_array to be the address + of body in dest_array. If it is a bit array, this cannot carry the + offset information, since the body is only recorded as multiples of + BV_BITS + */ + + + if (typ == aet_bit) + { offset += dest_array->bv.bv_offset; + from_array->bv.bv_self = dest_array->bv.bv_self + offset/BV_BITS; + from_array->bv.bv_offset = offset % BV_BITS; + } + else + from_array->a.a_self = ARRAY_BODY_PTR(dest_array,offset); + +} + + + +enum aelttype +Iarray_element_type(x) + object x; +{enum aelttype t; + switch(TYPE_OF(x)) + { case t_array: + t = (enum aelttype) x->a.a_elttype; + break; + case t_vector: + t = (enum aelttype) x->v.v_elttype; + break; + case t_bitvector: + t = aet_bit; + break; + case t_string: + t = aet_ch; + break; + default: + FEerror("Not an array ~a ",1,x); + } + return t; +} + + /* Make the body of FROM array point to the body of TO + at the DISPLACED_INDEX_OFFSET + */ + +Idisplace_array(from,to,displaced_index_offset) + object from,to; + int displaced_index_offset; +{ + enum aelttype t1,t2; + object tail; + t1 = Iarray_element_type(from); + t2 = Iarray_element_type(to); + if (t1 != t2) + FEerror("Attempt to displace arrays of one type to arrays of another type",0); + if (to->a.a_dim > from->a.a_dim - displaced_index_offset) + FEerror("To array not large enough for displacement",0); + {BEGIN_NO_INTERRUPT; + from->a.a_displaced = make_cons(to,Cnil); + if (to->a.a_displaced == Cnil) + to->a.a_displaced = make_cons(Cnil,Cnil); + DISPLACED_FROM(to) = make_cons(from,DISPLACED_FROM(to)); + + if (t1 == aet_bit) { + displaced_index_offset += to->bv.bv_offset; + from->bv.bv_self = to->bv.bv_self + displaced_index_offset/BV_BITS; + from->bv.bv_offset = displaced_index_offset%BV_BITS; + } + else + from->st.st_self = ARRAY_BODY_PTR(to,displaced_index_offset); + END_NO_INTERRUPT; + } + +} + +/* add diff to body of x and arrays diisplaced to it */ + +adjust_displaced(x, diff) +object x; +int diff; +{ + if (x->ust.ust_self != NULL) + x->ust.ust_self = (char *)((int)(x->a.a_self) + diff); + for (x = Mcdr(x->ust.ust_displaced); x != Cnil; x = Mcdr(x)) + adjust_displaced(Mcar(x), diff); +} + + + + + /* RAW_AET_PTR returns a pointer to something of raw type obtained from X + suitable for using GSET for an array of elt type TYP. + If x is the null pointer, return a default for that array element + type. + */ + +char * +raw_aet_ptr(x,typ) + short typ; + object x; +{ /* doubles are the largest raw type */ + static double u; + if (x==Cnil) return aet_types[typ].dflt; + switch (typ){ +#define STORE_TYPED(pl,type,val) *((type *) pl) = (type) val; break; + case aet_object: STORE_TYPED(&u,object,x); + case aet_ch: STORE_TYPED(&u,char, char_code(x)); + case aet_bit: STORE_TYPED(&u,fixnum, -Mfix(x)); + case aet_fix: STORE_TYPED(&u,fixnum, Mfix(x)); + case aet_sf: STORE_TYPED(&u,shortfloat, Msf(x)); + case aet_lf: STORE_TYPED(&u,longfloat, Mlf(x)); + case aet_char: STORE_TYPED(&u, char, Mfix(x)); + case aet_uchar: STORE_TYPED(&u, unsigned char, Mfix(x)); + case aet_short: STORE_TYPED(&u, short, Mfix(x)); + case aet_ushort: STORE_TYPED(&u,unsigned short,Mfix(x)); + default: FEerror("bad elttype",0); + } + return (char *)&u; +} + + + /* GSET copies into array ptr P1, the value + pointed to by the ptr VAL into the next N slots. The + array type is typ. If VAL is the null ptr, use + the default for that element type + NOTE: for type aet_bit n is the number of Words + ie (nbits +WSIZE-1)/WSIZE and the words are set. + */ + +gset(p1,val,n,typ) + char *p1,*val; + int n; + int typ; +{ if (val==0) + val = aet_types[typ].dflt; + switch (typ){ + +#define GSET(p,n,typ,val) {typ x = *((typ *) val); GSET1(p,n,typ,x)} +#define GSET1(p,n,typ,val) while (n-- > 0) \ + { *((typ *) p) = val; \ + p = p + sizeof(typ); \ + } break; + + case aet_object: GSET(p1,n,object,val); + case aet_ch: GSET(p1,n,char,val); + /* Note n is number of fixnum WORDS for bit */ + case aet_bit: GSET(p1,n,fixnum,val); + case aet_fix: GSET(p1,n,fixnum,val); + case aet_sf: GSET(p1,n,shortfloat,val); + case aet_lf: GSET(p1,n,longfloat,val); + case aet_char: GSET(p1,n,char,val); + case aet_uchar: GSET(p1,n,unsigned char,val); + case aet_short: GSET(p1,n,short,val); + case aet_ushort: GSET(p1,n,unsigned short,val); + default: FEerror("bad elttype",0); + } + } + + +#define W_SIZE (BV_BITS*sizeof(fixnum)) + + /* + */ + +DEFUN("COPY-ARRAY-PORTION",object,fScopy_array_portion,SI,4, + 5,NONE,OO,OI,II,OO, + "Copy elements from X to Y starting at x[i1] to x[i2] and doing N1 \ +elements if N1 is supplied otherwise, doing the length of X - I1 \ +elements. If the types of the arrays are not the same, this has \ +implementation dependent results.") + (x,y,i1,i2,n1) + object x,y; int i1,i2,n1; +{ enum aelttype typ1=Iarray_element_type(x); + enum aelttype typ2=Iarray_element_type(y); + int nc; + if (VFUN_NARGS==4) + { n1 = x->v.v_dim - i1;} + if (typ1==aet_bit) + {if (i1 % CHAR_SIZE) + badcopy: + FEerror("Bit copies only if aligned"); + else + {int rest=n1%CHAR_SIZE; + if (rest!=0 ) + {if (typ2!=aet_bit) + goto badcopy; + {while(rest> 0) + { fSaset1(y,i2+n1-rest,(fSaref1(x,i1+n1-rest))); + rest--;} + }} + i1=i1/CHAR_SIZE ; + n1=n1/CHAR_SIZE; + typ1=aet_char; + }}; + if (typ2==aet_bit) + {if (i2 % CHAR_SIZE) + goto badcopy; + i2=i2/CHAR_SIZE ;} + if ((typ1 ==aet_object || + typ2 ==aet_object) && typ1 != typ2) + FEerror("Can't copy between different array types"); + nc=n1 * aet_sizes[(int)typ1]; + if (i1+n1 > x->a.a_dim + || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) + FEerror("Copy out of bounds"); + bcopy(x->ust.ust_self + (i1*aet_sizes[(int)typ1]), + y->ust.ust_self + (i2*aet_sizes[(int)typ2]), + nc); + return x; +} + +/* X is the header of an array. This supplies the body which + will not be relocatable if STATICP. If DFLT is 0, do not + initialize (the caller promises to reset these before the + next gc!). If DFLT == Cnil then initialize to default type + for this array type. Otherwise DFLT is an object and its + value is used to init the array */ + +array_allocself(x, staticp, dflt) +object x,dflt; +int staticp; +{ + int i, d,n; + char *(*fun)(),*tmp_alloc; + enum aelttype typ; + fun = (staticp ? alloc_contblock : alloc_relblock); + { /* this must be called from within no interrupt code */ + n = x->a.a_dim; + typ = Iarray_element_type(x); + switch (typ) { + case aet_object: + x->a.a_self = AR_ALLOC(*fun,n,object); + break; + case aet_ch: + case aet_char: + case aet_uchar: + x->st.st_self = AR_ALLOC(*fun,n,char); + break; + case aet_short: + case aet_ushort: + x->ust.ust_self = (unsigned char *) AR_ALLOC(*fun,n,short); + break; + case aet_bit: + n = (n+W_SIZE-1)/W_SIZE; + x->bv.bv_offset = 0; + case aet_fix: + x->fixa.fixa_self = AR_ALLOC(*fun,n,fixnum); + break; + case aet_sf: + x->sfa.sfa_self = AR_ALLOC(*fun,n,shortfloat); + break; + case aet_lf: + x->lfa.lfa_self = AR_ALLOC(*fun,n,longfloat); + break; + } + if(dflt!=0) gset(x->st.st_self,raw_aet_ptr(dflt,typ),n,typ); + } + +} + +DEFUNO("FILL-POINTER-SET",int,fSfill_pointer_set,SI,2,2, + NONE,IO,IO,OO,OO,siLfill_pointer_set,"") + (x,i) + object x; + int i; +{ + + if (!(TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string)))) + goto no_fillp; + if (x->v.v_hasfillp == 0) + { goto no_fillp;} + if (i < 0 || i > x->a.a_dim) + { FEerror("~a is not suitable for a fill pointer for ~a",2,make_fixnum(i),x);} + x->v.v_fillp = i; + return i; + + no_fillp: + FEerror("~a does not have a fill pointer",1,x); + + return 0; +} + +DEFUNO("FILL-POINTER",int,fLfill_pointer,LISP,1,1,NONE,IO, + OO,OO,OO,Lfill_pointer,"") + (x) + object x; +{ + if (!(TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string)))) + goto no_fillp; + if (x->v.v_hasfillp == 0) + { goto no_fillp;} + return x->v.v_fillp ; + + no_fillp: + FEerror("~a does not have a fill pointer",1,x); + return 0; +} + +DEFUN("ARRAY-HAS-FILL-POINTER-P",object, + fLarray_has_fill_pointer_p,LISP,1,1,NONE,OO,OO,OO,OO,"") + (x) + object x; +{ + if (TS_MEMBER(type_of(x),TS(t_vector)| + TS(t_bitvector)| + TS(t_string))) + return (x->v.v_hasfillp == 0 ? Cnil : sLt); + else + if (TYPE_OF(x) == t_array) + { return Cnil;} + else IisArray(x); + return Cnil; +} + + + +/* DEFUN("MAKE-ARRAY-INTERNAL",object,fSmake_array_internal,SI,0,0,NONE,OO,OO,OO,OO) + (element_type,adjustable,displaced_to,displaced_index_offset,static,initial_element,dimensions) + object element_type,adjustable,displaced_to,displaced_index_offset,static,initial_element,dimensions; + +*/ + +DEFUNO("ARRAY-ELEMENT-TYPE",object,fLarray_element_type, + LISP,1,1,NONE,OO,OO,OO,OO,Larray_element_type,"") + (x) + object x; +{ enum aelttype t; + t = Iarray_element_type(x); + return * aet_types[(int)t].namep; +} + +DEFUNO("ADJUSTABLE-ARRAY-P",object,fLadjustable_array_p, + LISP,1,1,NONE,OO,OO,OO,OO,Ladjustable_array_p,"") + (x) + object x; +{ return sLt; +} + +DEFUNO("DISPLACED-ARRAY-P",object,fSdisplaced_array_p,SI,1, + 1,NONE,OO,OO,OO,OO,siLdisplaced_array_p,"") + (x) + object x; +{ IisArray(x); + return (x->a.a_displaced == Cnil ? Cnil : sLt); +} + +DEFUNO("ARRAY-RANK",int,fLarray_rank,LISP,1,1,NONE,IO,OO,OO, + OO,Larray_rank,"") + (x) + object x; +{ if (type_of(x) == t_array) + return x->a.a_rank; + IisArray(x); + return 1; +} + +DEFUNO("ARRAY-DIMENSION",int,fLarray_dimension,LISP,2,2, + NONE,IO,IO,OO,OO,Larray_dimension,"") + (x,i) + object x; int i; +{ + if (type_of(x) == t_array) + { if (i >= x->a.a_rank) FEerror("Index to large for array-dimension"); + else { return x->a.a_dims[i];}} + IisArray(x); + return x->v.v_dim; +} + +Icheck_displaced(displaced_list,ar,dim) + object displaced_list,ar; + int dim; +{ + while (displaced_list!=Cnil) + { object u = Mcar(displaced_list); + if (u->a.a_self == NULL) continue; + if ((Iarray_element_type(u) == aet_bit && + (u->bv.bv_self - ar->bv.bv_self)*BV_BITS +u->bv.bv_dim -dim + + u->bv.bv_offset - ar->bv.bv_offset > 0) + || (ARRAY_BODY_PTR(u,u->a.a_dim) > ARRAY_BODY_PTR(ar,dim))) + FEerror("Bad displacement",0); + Icheck_displaced(DISPLACED_FROM(u),ar,dim); + displaced_list = Mcdr(displaced_list); + } +} + +/* + (setq a (make-array 2 :displaced-to (setq b (make-array 4 )))) + { A->displ = (B), B->displ=(nil A)} +(setq w (make-array 3)) ;; w->displaced= (nil y u) +(setq y (make-array 2 :displaced-to w)) ;; y->displaced=(w z z2) +(setq u (make-array 2 :displaced-to w)) ;; u->displaced = (w) +(setq z (make-array 2 :displaced-to y)) ;; z->displaced = (y) +(setq z2 (make-array 2 :displaced-to y)) ;; z2->displaced= (y) + + + Destroy the displacement from AR + + */ +Iundisplace(ar) +object ar; +{ object *p,x; + + if ((x = DISPLACED_TO(ar)) == Cnil || + ar->a.a_displaced->d.m == FREE) + return; + {BEGIN_NO_INTERRUPT; + DISPLACED_TO(ar) = Cnil; + p = &(DISPLACED_FROM(x)) ; + /* walk through the displaced from list and delete AR */ + while(1) + { if ((*p)->d.m == FREE + || *p == Cnil) + goto retur; + if((Mcar(*p) == ar)) + { *p = Mcdr(*p); + goto retur;} + p = &(Mcdr(*p)); + } + retur: + END_NO_INTERRUPT; + return; + } +} + +DEFUNO("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE, + OO,OO,OO,OO,siLreplace_array,"") + (old,new) + object old,new; +{ struct dummy fw ; + fw = old->d; + + old = IisArray(old); + + if (TYPE_OF(old) != TYPE_OF(new) + || (TYPE_OF(old) == t_array && old->a.a_rank != new->a.a_rank)) + { FAIL: + FEerror("Cannot do array replacement ~a by ~a",2,old,new); + } + { int offset = new->ust.ust_self - old->ust.ust_self; + object old_list = DISPLACED_FROM(old); + object displaced = make_cons(DISPLACED_TO(new),DISPLACED_FROM(old)); + Icheck_displaced(DISPLACED_FROM(old),old,new->a.a_dim); + adjust_displaced(old,offset); +/* Iundisplace(old); */ + if (old->v.v_hasfillp) + { new->v.v_hasfillp = 1; + new->v.v_fillp = old->v.v_fillp;} + if (TYPE_OF(old) == t_string) + old->st = new->st; + else + old->a = new ->a; + + /* prevent having two arrays with the same body--which are not related + that would cause the gc to try to copy both arrays and there might + not be enough space. */ + new->a.a_dim = 0; + new->a.a_self = 0; + old->d = fw; + old->a.a_displaced = displaced; + } + return old; +} + +DEFUNO("ARRAY-TOTAL-SIZE",int,fLarray_total_size,LISP,1,1, + NONE,IO,OO,OO,OO,Larray_total_size,"") + (x) + object x; +{ x = IisArray(x); + return x->a.a_dim; +} + + +DEFUNO("ASET-BY-CURSOR",object,fSaset_by_cursor,SI,3,3, + NONE,OO,OO,OO,OO,siLaset_by_cursor,"")(array,val,cursor) +object array,val,cursor; +{ + object endp_temp; + object x; + int i; + object ind[ARRAY_RANK_LIMIT]; + /* 3 args */ + ind[0]=array; + if (cursor==sLnil) {fSaset1(array,0,val); RETURN1(array);} + ind[1]=MMcar(cursor); + i = 2; + for (x = MMcdr(cursor); !endp(x); x = MMcdr(x)) + { ind[i++] = MMcar(x);} + ind[i]=val; + VFUN_NARGS=i+1; + c_apply_n(fSaset,i+1,ind); + RETURN1(array); +} + +init_array_function(){;} + + + + diff --git a/o/assignment.c b/o/assignment.c new file mode 100755 index 0000000..ed11205 --- /dev/null +++ b/o/assignment.c @@ -0,0 +1,589 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + assignment.c + + Assignment +*/ + +#include "include.h" + +static object +setf(object,object); + +object sLsetf; + +object sLget; +object sLgetf; +object sLaref; +object sLsvref; +object sLelt; +object sLchar; +object sLschar; +object sLfill_pointer; +object sLgethash; +object sLcar; +object sLcdr; + +object sLpush; +object sLpop; +object sLincf; +object sLdecf; + +object sSstructure_access; +object sSsetf_lambda; + + + +object sSclear_compiler_properties; + +object sLwarn; + +object sSAinhibit_macro_specialA; + +void +setq(object sym, object val) +{ + object vd; + enum stype type; + + if(type_of(sym) != t_symbol) + not_a_symbol(sym); + type = (enum stype)sym->s.s_stype; + if(type == stp_special) + sym->s.s_dbind = val; + else + if (type == stp_constant) + FEinvalid_variable("Cannot assign to the constant ~S.", sym); + else { + vd = lex_var_sch(sym); + if(MMnull(vd) || endp(MMcdr(vd))) + sym->s.s_dbind = val; + else + MMcadr(vd) = val; + } +} + +static void +FFN(Fsetq)(object form) +{ + object ans; + if (endp(form)) { + vs_base = vs_top; + vs_push(Cnil); + } else { + object *top = vs_top; + do { + vs_top = top; + if (endp(MMcdr(form))) + FEinvalid_form("No value for ~S.", form->c.c_car); + setq(MMcar(form),ans=Ieval(MMcadr(form))); + form = MMcddr(form); + } while (!endp(form)); + top[0]=ans; + vs_base=top; + vs_top= top+1; + } +} + +static void +FFN(Fpsetq)(object arg) +{ + object *old_top = vs_top; + object *top; + object argsv = arg; + for (top = old_top; !endp(arg); arg = MMcddr(arg), top++) { + if(endp(MMcdr(arg))) + FEinvalid_form("No value for ~S.", arg->c.c_car); + + top[0] = Ieval(MMcadr(arg)); + vs_top = top + 1; + } + for (arg = argsv, top = old_top; !endp(arg); arg = MMcddr(arg), top++) + setq(MMcar(arg),top[0]); + vs_base = vs_top = old_top; + vs_push(Cnil); +} + +DEFUNO_NEW("SET",object,fLset,LISP + ,2,2,NONE,OO,OO,OO,OO,void,Lset,(object symbol,object value),"") + +{ + /* 2 args */ + if (type_of(symbol) != t_symbol) + not_a_symbol(symbol); + if ((enum stype)symbol->s.s_stype == stp_constant) + FEinvalid_variable("Cannot assign to the constant ~S.", + symbol); + symbol->s.s_dbind = value; + RETURN1(value); +} + +DEFUNO_NEW("FSET",object,fSfset,SI + ,2,2,NONE,OO,OO,OO,OO,void,siLfset,(object sym,object function),"") + +{ + /* 2 args */ + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL) { + if (sym->s.s_mflag) { + if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + sym->s.s_sfdef = NOT_SPECIAL; + } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + FEerror("~S, a special form, cannot be redefined.", + 1, sym); + } + sym = clear_compiler_properties(sym,function); + if (sym->s.s_hpack == lisp_package && + sym->s.s_gfdef != OBJNULL && !raw_image) { + ifuncall2(sLwarn,make_simple_string("~S is being redefined."), + sym); + } + if (type_of(function) == t_cfun || + type_of(function) == t_sfun || + type_of(function) == t_vfun || + type_of(function) == t_gfun || + type_of(function) == t_cclosure|| + type_of(function) == t_closure || + type_of(function) == t_afun + ) { + sym->s.s_gfdef = function; + sym->s.s_mflag = FALSE; + } else if (car(function) == sLspecial) + FEerror("Cannot define a special form.", 0); + else if (function->c.c_car == sSmacro) { + sym->s.s_gfdef = function->c.c_cdr; + sym->s.s_mflag = TRUE; + } else { + sym->s.s_gfdef = function; + sym->s.s_mflag = FALSE; + } + + RETURN1(function); +} +#ifdef STATIC_FUNCTION_POINTERS +object +fSfset(object sym,object function) { + return FFN(fSfset)(sym,function); +} +#endif + +static void +FFN(Fmultiple_value_setq)(object form) +{ + object vars; + int n, i; + + if (endp(form) || endp(form->c.c_cdr) || + !endp(form->c.c_cdr->c.c_cdr)) + FEinvalid_form("~S is an illegal argument to MULTIPLE-VALUE-SETQ", + form); + vars = form->c.c_car; + + fcall.values[0]=Ieval(form->c.c_cdr->c.c_car); + n = fcall.nvalues; + + for (i = 0; !endp(vars); i++, vars = vars->c.c_cdr) + if (i < n) + setq(vars->c.c_car, fcall.values[i]); + else + setq(vars->c.c_car, Cnil); + vs_base[0]=fcall.values[0]; + vs_top = vs_base+1; +} + +DEFUNO_NEW("MAKUNBOUND",object,fLmakunbound,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lmakunbound,(object sym),"") + +{ + /* 1 args */ + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if ((enum stype)sym->s.s_stype == stp_constant) + FEinvalid_variable("Cannot unbind the constant ~S.", + sym); + sym->s.s_dbind = OBJNULL; + RETURN1(sym); +} + +object sStraced; + +DEFUNO_NEW("FMAKUNBOUND",object,fLfmakunbound,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lfmakunbound,(object sym),"") + +{ + /* 1 args */ + if(type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL) { + if (sym->s.s_mflag) { + if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + sym->s.s_sfdef = NOT_SPECIAL; + } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + FEerror("~S, a special form, cannot be redefined.", + 1, sym); + } + remf(&(sym->s.s_plist),sStraced); + clear_compiler_properties(sym,Cnil); + if (sym->s.s_hpack == lisp_package && + sym->s.s_gfdef != OBJNULL && !raw_image) { + ifuncall2(sLwarn, make_simple_string( + "~S is being redefined."), sym); + } + sym->s.s_gfdef = OBJNULL; + sym->s.s_mflag = FALSE; + RETURN1(sym); +} + +static void +FFN(Fsetf)(object form) +{ + object *t,*t1; + if (endp(form)) { + vs_base = vs_top; + vs_push(Cnil); + } else { + object *top = vs_top; + do { + vs_top = top; + if (endp(MMcdr(form))) + FEinvalid_form("No value for ~S.", form->c.c_car); + setf(MMcar(form), MMcadr(form)); + form = MMcddr(form); + } while (!endp(form)); + t=vs_base; + t1=vs_top; + vs_top = vs_base = top; + for (;tc.c_car; + if (type_of(fun) != t_symbol) + goto OTHERWISE; + args = place->c.c_cdr; + if (fun == sLget) { + object sym,val,key; + sym = Ieval(car(args)); + key = Ieval(car(Mcdr(args))); + val = Ieval(form); + return putprop(sym,val,key); + } + if (fun == sLgetf) + Ieval(Mcaddr(args)); + if (fun == sLaref) { f = siLaset; goto EVAL; } + if (fun == sLsvref) { f = siLsvset; goto EVAL; } + if (fun == sLelt) { f = siLelt_set; goto EVAL; } + if (fun == sLchar) { f = siLchar_set; goto EVAL; } + if (fun == sLschar) { f = siLchar_set; goto EVAL; } + if (fun == sLfill_pointer) { f = siLfill_pointer_set; goto EVAL; } + if (fun == sLgethash) { f = siLhash_set; goto EVAL; } + if (fun == sLcar) { + x = Ieval(Mcar(args)); + result = Ieval(form); + if (type_of(x) != t_cons) + FEerror("~S is not a cons.", 1, x); + Mcar(x) = result; + return result; + } + if (fun == sLcdr) { + x = Ieval(Mcar(args)); + result = Ieval(form); + if (type_of(x) != t_cons) + FEerror("~S is not a cons.", 1, x); + Mcdr(x) = result; + return result; + } + + x = getf(fun->s.s_plist, sSstructure_access, Cnil); + if (x == Cnil || type_of(x) != t_cons) + goto OTHERWISE; + if (getf(fun->s.s_plist, sSsetf_lambda, Cnil) == Cnil) + goto OTHERWISE; + if (type_of(x->c.c_cdr) != t_fixnum) + goto OTHERWISE; + i = fix(x->c.c_cdr); +/* + if (i < 0) + goto OTHERWISE; +*/ + x = x->c.c_car; + y = Ieval(Mcar(args)); + result = Ieval(form); + if (x == sLvector) { + if (type_of(y) != t_vector || i >= y->v.v_fillp) + goto OTHERWISE; + y->v.v_self[i] = result; + } else if (x == sLlist) { + for (x = y; i > 0; --i) + x = cdr(x); + if (type_of(x) != t_cons) + goto OTHERWISE; + x->c.c_car = result; + } else { + structure_set(y, x, i, result); + } + return result; + +EVAL: + for (; !endp(args); args = args->c.c_cdr) { + eval_push(args->c.c_car); + } + eval_push(form); + vs_base = vs; + (*f)(); + return vs_base[0]; + +OTHERWISE: + vs_base = vs_top; + vs_push(list(3,sLsetf,place,result=form)); +/***/ +#define VS_PUSH_ENV \ + if(lex_env[1]){ \ + vs_push(list(3,lex_env[0],lex_env[1],lex_env[2]));} \ + else {vs_push(Cnil);} + VS_PUSH_ENV ; +/***/ + if (!sLsetf->s.s_mflag || sLsetf->s.s_gfdef == OBJNULL) + FEerror("Where is SETF?", 0); + funcall(sLsetf->s.s_gfdef); + return Ieval(vs_base[0]); +} + +static void +FFN(Fpush)(object form) +{ + object var; + + if (endp(form) || endp(MMcdr(form))) + FEtoo_few_argumentsF(form); + if (!endp(MMcddr(form))) + FEtoo_many_argumentsF(form); + var = MMcadr(form); + if (type_of(var) != t_cons) { + eval(MMcar(form)); + form = vs_base[0]; + eval(var); + vs_base[0] = MMcons(form, vs_base[0]); + setq(var, vs_base[0]); + return; + } + vs_base = vs_top; + vs_push(make_cons(sLpush,form)); +/***/ + VS_PUSH_ENV ; +/***/ + if (!sLpush->s.s_mflag || sLpush->s.s_gfdef == OBJNULL) + FEerror("Where is PUSH?", 0); + funcall(sLpush->s.s_gfdef); + eval(vs_base[0]); +} + +static void +FFN(Fpop)(object form) +{ + object var; + + if (endp(form)) + FEtoo_few_argumentsF(form); + if (!endp(MMcdr(form))) + FEtoo_many_argumentsF(form); + var = MMcar(form); + if (type_of(var) != t_cons) { + eval(var); + setq(var, cdr(vs_base[0])); + vs_base[0] = car(vs_base[0]); + return; + } + vs_base = vs_top; + vs_push(make_cons(sLpop,form)); +/***/ + VS_PUSH_ENV ; +/***/ + if (!sLpop->s.s_mflag || sLpop->s.s_gfdef == OBJNULL) + FEerror("Where is POP?", 0); + funcall(sLpop->s.s_gfdef); + eval(vs_base[0]); +} + +static void +FFN(Fincf)(object form) +{ + object var; + object one_plus(object x), number_plus(object x, object y); + + if (endp(form)) + FEtoo_few_argumentsF(form); + if (!endp(MMcdr(form)) && !endp(MMcddr(form))) + FEtoo_many_argumentsF(form); + var = MMcar(form); + if (type_of(var) != t_cons) { + if (endp(MMcdr(form))) { + eval(var); + vs_base[0] = one_plus(vs_base[0]); + setq(var, vs_base[0]); + return; + } + eval(MMcadr(form)); + form = vs_base[0]; + eval(var); + vs_base[0] = number_plus(vs_base[0], form); + setq(var, vs_base[0]); + return; + } + vs_base = vs_top; + vs_push(make_cons(sLincf,form)); +/***/ + VS_PUSH_ENV ; +/***/ + if (!sLincf->s.s_mflag || sLincf->s.s_gfdef == OBJNULL) + FEerror("Where is INCF?", 0); + funcall(sLincf->s.s_gfdef); + eval(vs_base[0]); +} + +static void +FFN(Fdecf)(object form) +{ + object var; + object one_minus(object x), number_minus(object x, object y); + + if (endp(form)) + FEtoo_few_argumentsF(form); + if (!endp(MMcdr(form)) && !endp(MMcddr(form))) + FEtoo_many_argumentsF(form); + var = MMcar(form); + if (type_of(var) != t_cons) { + if (endp(MMcdr(form))) { + eval(var); + vs_base[0] = one_minus(vs_base[0]); + setq(var, vs_base[0]); + return; + } + eval(MMcadr(form)); + form = vs_base[0]; + eval(var); + vs_base[0] = number_minus(vs_base[0], form); + setq(var, vs_base[0]); + return; + } + vs_base = vs_top; + vs_push(make_cons(sLdecf,form)); +/***/ + VS_PUSH_ENV ; +/***/ + if (!sLdecf->s.s_mflag || sLdecf->s.s_gfdef == OBJNULL) + FEerror("Where is DECF?", 0); + funcall(sLdecf->s.s_gfdef); + eval(vs_base[0]); +} + + +/* object */ +/* clear_compiler_properties(object sym, object code) */ +/* { object tem; */ +/* VFUN_NARGS=2; fSuse_fast_links(Cnil,sym); */ +/* tem = getf(sym->s.s_plist,sStraced,Cnil); */ +/* if (sSAinhibit_macro_specialA && sSAinhibit_macro_specialA->s.s_dbind != Cnil) */ +/* (void)ifuncall2(sSclear_compiler_properties, sym,code); */ +/* if (tem != Cnil) return tem; */ +/* return sym; */ + +/* } */ + +DEF_ORDINARY("CLEAR-COMPILER-PROPERTIES",sSclear_compiler_properties,SI,""); + +DEFUN_NEW("CLEAR-COMPILER-PROPERTIES",object,fSclear_compiler_properties,SI + ,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") + +{ + /* 2 args */ + RETURN1(Cnil); +} + +DEF_ORDINARY("AREF",sLaref,LISP,""); +DEF_ORDINARY("CAR",sLcar,LISP,""); +DEF_ORDINARY("CDR",sLcdr,LISP,""); +DEF_ORDINARY("CHAR",sLchar,LISP,""); +DEF_ORDINARY("DECF",sLdecf,LISP,""); +DEF_ORDINARY("ELT",sLelt,LISP,""); +DEF_ORDINARY("FILL-POINTER",sLfill_pointer,LISP,""); +DEF_ORDINARY("GET",sLget,LISP,""); +DEF_ORDINARY("GETF",sLgetf,LISP,""); +DEF_ORDINARY("GETHASH",sLgethash,LISP,""); +DEF_ORDINARY("INCF",sLincf,LISP,""); +DEF_ORDINARY("POP",sLpop,LISP,""); +DEF_ORDINARY("PUSH",sLpush,LISP,""); +DEF_ORDINARY("SCHAR",sLschar,LISP,""); +DEF_ORDINARY("SETF",sLsetf,LISP,""); +DEF_ORDINARY("SETF-LAMBDA",sSsetf_lambda,SI,""); +DEF_ORDINARY("STRUCTURE-ACCESS",sSstructure_access,SI,""); +DEF_ORDINARY("SVREF",sLsvref,LISP,""); +DEF_ORDINARY("TRACED",sStraced,SI,""); +DEF_ORDINARY("VECTOR",sLvector,LISP,""); + +void +gcl_init_assignment(void) +{ + make_special_form("SETQ", Fsetq); + make_special_form("PSETQ", Fpsetq); + make_special_form("MULTIPLE-VALUE-SETQ", Fmultiple_value_setq); + sLsetf=make_special_form("SETF", Fsetf); + sLpush=make_special_form("PUSH", Fpush); + sLpop=make_special_form("POP", Fpop); + sLincf=make_special_form("INCF", Fincf); + sLdecf=make_special_form("DECF", Fdecf); + +} diff --git a/o/backq.c b/o/backq.c new file mode 100755 index 0000000..8f3f75d --- /dev/null +++ b/o/backq.c @@ -0,0 +1,383 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include "include.h" + +#define attach(x) (vs_head = make_cons(x, vs_head)) +#define make_list (vs_popp,vs_head=list(2,vs_head,*vs_top)) + + +#define QUOTE 1 +#define EVAL 2 +#define LIST 3 +#define LISTA 4 +#define APPEND 5 +#define NCONC 6 + +#define siScomma_at sSYB +#define siScomma_dot sSYZ +object sSYB; +object sSYZ; + +static void +kwote_cdr(void) +{ + object x; + + x = vs_head; + if (type_of(x) == t_symbol) { + if ((enum stype)x->s.s_stype == stp_constant && + x->s.s_dbind == x) + return; + goto KWOTE; + } else if (type_of(x) == t_cons || type_of(x) == t_vector) + goto KWOTE; + return; + +KWOTE: + vs_head = make_cons(vs_head, Cnil); + vs_head = make_cons(sLquote, vs_head); +} + +static void +kwote_car(void) +{ + object x; + + x = vs_top[-2]; + if (type_of(x) == t_symbol) { + if ((enum stype)x->s.s_stype == stp_constant && + x->s.s_dbind == x) + return; + goto KWOTE; + } else if (type_of(x) == t_cons || type_of(x) == t_vector) + goto KWOTE; + return; + +KWOTE: + vs_top[-2] = make_cons(vs_top[-2], Cnil); + vs_top[-2] = make_cons(sLquote, vs_top[-2]); +} + +/* + Backq_cdr(x) pushes a form on vs and returns one of + + QUOTE the form should be quoted + EVAL the form should be evaluated + LIST the form should be applied to LIST + LISTA the form should be applied to LIST* + APPEND the form should be applied to APPEND + NCONC the form should be applied to NCONC +*/ +static int +backq_cdr(object x) +{ + int a, d; + + cs_check(x); + + if (type_of(x) != t_cons) { + vs_push(x); + return(QUOTE); + } + if (x->c.c_car == siScomma) { + vs_push(x->c.c_cdr); + return(EVAL); + } + if (x->c.c_car == siScomma_at || x->c.c_car == siScomma_dot) + FEerror(",@ or ,. has appeared in an illegal position.", 0); + a = backq_car(x->c.c_car); + d = backq_cdr(x->c.c_cdr); + if (d == QUOTE) + switch (a) { + case QUOTE: + vs_popp; + vs_head = x; + return(QUOTE); + + case EVAL: + if (vs_head == Cnil) { + stack_cons(); + return(LIST); + } + if (type_of(vs_head) == t_cons && + vs_head->c.c_cdr == Cnil) { + vs_head = vs_head->c.c_car; + kwote_cdr(); + make_list; + return(LIST); + } + kwote_cdr(); + make_list; + return(LISTA); + + case APPEND: + if (vs_head == Cnil) { + vs_popp; + return(EVAL); + } + kwote_cdr(); + make_list; + return(APPEND); + + case NCONC: + if (vs_head == Cnil) { + vs_popp; + return(EVAL); + } + kwote_cdr(); + make_list; + return(NCONC); + + default: + error("backquote botch"); + } + if (d == EVAL) + switch (a) { + case QUOTE: + kwote_car(); + make_list; + return(LISTA); + + case EVAL: + make_list; + return(LISTA); + + case APPEND: + make_list; + return(APPEND); + + case NCONC: + make_list; + return(NCONC); + + default: + error("backquote botch"); + } + if (a == d) { + stack_cons(); + return(d); + } + switch (d) { + case LIST: + if (a == QUOTE) { + kwote_car(); + stack_cons(); + return(d); + } + if (a == EVAL) { + stack_cons(); + return(d); + } + attach(sLlist); + break; + + case LISTA: + if (a == QUOTE) { + kwote_car(); + stack_cons(); + return(d); + } + if (a == EVAL) { + stack_cons(); + return(d); + } + attach(sLlistA); + break; + + case APPEND: + attach(sLappend); + break; + + case NCONC: + attach(sLnconc); + break; + + default: + error("backquote botch"); + } + switch (a) { + case QUOTE: + kwote_car(); + make_list; + return(LISTA); + + case EVAL: + make_list; + return(LISTA); + + case APPEND: + make_list; + return(APPEND); + + case NCONC: + make_list; + return(NCONC); + + default: + error("backquote botch"); + return(0); + } +} + +/* + Backq_car(x) pushes a form on vs and returns one of + + QUOTE the form should be quoted + EVAL the form should be evaluated + APPEND the form should be appended + into the outer form + NCONC the form should be nconc'ed + into the outer form +*/ +int +backq_car(object x) +{ + int d; + + cs_check(x); + + if (type_of(x) != t_cons) { + vs_push(x); + return(QUOTE); + } + if (x->c.c_car == siScomma) { + vs_push(x->c.c_cdr); + return(EVAL); + } + if (x->c.c_car == siScomma_at) { + vs_push(x->c.c_cdr); + return(APPEND); + } + if (x->c.c_car == siScomma_dot) { + vs_push(x->c.c_cdr); + return(NCONC); + } + d = backq_cdr(x); + switch (d) { + case QUOTE: + return(QUOTE); + + case EVAL: + return(EVAL); + + case LIST: + attach(sLlist); + break; + + case LISTA: + attach(sLlistA); + break; + + case APPEND: + attach(sLappend); + break; + + case NCONC: + attach(sLnconc); + break; + + default: + error("backquote botch"); + } + return(EVAL); +} + +static object +backq(object x) +{ + int a; + + a = backq_car(x); + if (a == APPEND || a == NCONC) + FEerror(",@ or ,. has appeared in an illegal position.", 0); + if (a == QUOTE) + kwote_cdr(); + return(vs_pop); +} + +static object fLcomma_reader(object x0, object x1) +{ object w; + object in, c; + + /* 2 args */ + + in = x0; + if (backq_level <= 0) + FEerror("A comma has appeared out of a backquote.", 0); + c = peek_char(FALSE, in); + if (c == code_char('@')) { + w = siScomma_at; + read_char(in); + } else if (c == code_char('.')) { + w=siScomma_dot; + read_char(in); + } else + w=siScomma; + --backq_level; + x0 = make_cons(w,read_object(in)); + backq_level++; + RETURN1(x0); +} + +static object fLbackquote_reader(object x0, object x1) +{ + object in; + + /* 2 args */ + in = x0; + backq_level++; + x0 = read_object(in); + --backq_level; + x0 = backq(x0); + RETURN1(x0); +} + +#define make_cf(f) make_cfun((f), Cnil, Cnil, NULL, 0); +#define MAKE_AFUN(addr,n) MakeAfun(addr,F_ARGD(n,n,NONE,ARGTYPES(OO,OO,OO,OO)),0); + + +DEF_ORDINARY("Y",sSY,SI,""); +DEF_ORDINARY("YB",sSYB,SI,""); + +DEF_ORDINARY("YZ",sSYZ,SI,""); +DEF_ORDINARY("LIST*",sLlistA,LISP,""); + +DEF_ORDINARY("APPEND",sLappend,LISP,""); +DEF_ORDINARY("NCONC",sLnconc,LISP,""); +DEF_ORDINARY("APPLY",sLapply,LISP,""); +DEF_ORDINARY("VECTOR",sLvector,LISP,""); + + +void +gcl_init_backq(void) +{ + object r; + + + r = standard_readtable; + r->rt.rt_self['`'].rte_chattrib = cat_terminating; + r->rt.rt_self['`'].rte_macro = MAKE_AFUN(fLbackquote_reader,2); + r->rt.rt_self[','].rte_chattrib = cat_terminating; + r->rt.rt_self[','].rte_macro = MAKE_AFUN(fLcomma_reader,2); + + backq_level = 0; +} diff --git a/o/bcmp.c b/o/bcmp.c new file mode 100755 index 0000000..81706f6 --- /dev/null +++ b/o/bcmp.c @@ -0,0 +1,11 @@ +#include +int bcmp(const void *s1, const void *s2, size_t n) +{ const char *c1=s1,*c2=s2; + while (n-- > 0) + {if (*c1++ != *c2++) + return 1;} + return 0; + } + + + diff --git a/o/bcopy.c b/o/bcopy.c new file mode 100755 index 0000000..4b60093 --- /dev/null +++ b/o/bcopy.c @@ -0,0 +1,10 @@ +#include +void bcopy(const void *s1, void *s2, size_t n) +{ const char *c1=s1; + char *c2=s2; + while (n-- > 0) { + *c2++ = *c1++; +} +} + + diff --git a/o/bds.c b/o/bds.c new file mode 100755 index 0000000..24ad1d4 --- /dev/null +++ b/o/bds.c @@ -0,0 +1,37 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + bds.c + + bind stack routines +*/ + +#include "include.h" + +void +bds_unwind(bds_ptr new_bds_top) +{ + for (; bds_top > new_bds_top; bds_top--) + (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val; +} + + diff --git a/o/before_init.c b/o/before_init.c new file mode 100755 index 0000000..e0a3eda --- /dev/null +++ b/o/before_init.c @@ -0,0 +1,53 @@ +#include "all.h" +#include "funlink.h" +#define SI 0 +#define LISP 1 +#define KEYWORD 2 + +#define NONE 0 + +void SI_makefun(),LISP_makefun(),error(); + +#define MAKEFUN(pack,string,fname,argd) \ + (pack == SI ? SI_makefun : pack == LISP ? LISP_makefun : error)(string,fname,argd) + +#undef DEFUN +#define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56) \ + {extern ret fname(); \ + MAKEFUN(pack,string,fname,F_ARGD(min,max,flags,ARGTYPES(ret0a0,a12,a34,a56)));} + +#undef DEFUNO +#define DEFUNO(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,old) \ + {extern ret fname(); \ + MAKEFUN(pack,string,fname,F_ARGD(min,max,flags,ARGTYPES(ret0a0,a12,a34,a56)));} + +#undef DEFCOMP +#define DEFCOMP(type, fun) Ineed_in_image(fun); + + +#undef DEFVAR +#define DEFVAR(name,cname,pack,val) \ + { extern obj cname; \ + cname = (pack == LISP ? make_special(name,val) : \ + pack == SI ? make_si_special(name,val): \ + (error(name,val),(obj)0));} + +#undef DEFCONST +#define DEFCONST(name,cname,pack,val) \ + { extern obj cname; \ + cname = (pack == LISP ? make_constant(name,val) : \ + pack == SI ? make_si_constant(name,val): \ + (error(name,val),(obj)0));} + + +#undef DEF_ORDINARY +#define DEF_ORDINARY(name,cname,pack) \ + { extern obj cname ; cname = (pack == LISP ? make_ordinary(name) : \ + pack == SI ? make_si_ordinary(name): \ + pack == KEYWORD ? make_keyword(name): \ + (error(name),(obj)0));} + + +#undef DEF_INIT +#define DEF_INIT(x) x + diff --git a/o/big.c b/o/big.c new file mode 100755 index 0000000..0d1b4b9 --- /dev/null +++ b/o/big.c @@ -0,0 +1,188 @@ + /* Copyright William F. Schelter 1991 + Bignum routines. + + + +num_arith.c: add_int_big +num_arith.c: big_minus +num_arith.c: big_plus +num_arith.c: big_quotient_remainder +num_arith.c: big_sign +num_arith.c: big_times +num_arith.c: complement_big +num_arith.c: copy_big +num_arith.c: div_int_big +num_arith.c: mul_int_big +num_arith.c: normalize_big +num_arith.c: normalize_big_to_object +num_arith.c: stretch_big +num_arith.c: sub_int_big +num_comp.c: big_compare +num_comp.c: big_sign +num_log.c: big_sign +num_log.c: copy_to_big +num_log.c: normalize_big +num_log.c: normalize_big_to_object +num_log.c: stretch_big +num_pred.c: big_sign +number.c: big_to_double +predicate.c: big_compare +typespec.c: big_sign +print.d: big_minus +print.d: big_sign +print.d: big_zerop +print.d: copy_big +print.d: div_int_big +read.d: add_int_big +read.d: big_to_double +read.d: complement_big +read.d: mul_int_big +read.d: normalize_big +read.d: normalize_big_to_object + + */ + +#define remainder gclremainder +#define NEED_MP_H +#include +#include +#include "include.h" + +#ifdef STATIC_FUNCTION_POINTERS +static void* alloc_relblock_static (size_t n) {return alloc_relblock (n);} +static void* alloc_contblock_static(size_t n) {return alloc_contblock(n);} +#endif + +void* (*gcl_gmp_allocfun)(size_t)=FFN(alloc_relblock); +int gmp_relocatable=1; + + +DEFUN_NEW("SET-GMP-ALLOCATE-RELOCATABLE",object,fSset_gmp_allocate_relocatable,SI,1,1,NONE,OO,OO,OO,OO, + (object flag),"Set the allocation to be relocatble ") +{ + if (flag == Ct) { + gcl_gmp_allocfun = FFN(alloc_relblock); + gmp_relocatable=1; + } else { + gcl_gmp_allocfun = FFN(alloc_contblock); + gmp_relocatable=0; + } + RETURN1(flag); +} + +#ifndef GMP_USE_MALLOC +object big_gcprotect; +object big_fixnum1; + +#include "gmp.c" + +void +gcl_init_big1(void) { + + mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free); + jmp_gmp=0; + +#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) + Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt; + Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt; + Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt; +#endif + +} + +#else +gcl_init_big1() +{ +} +#endif + +#ifdef GMP +#include "gmp_big.c" +#else +#include "pari_big.c" +#endif + + + +int big_sign(object x) +{ + return BIG_SIGN(x); +} + +void set_big_sign(object x, int sign) +{ + SET_BIG_SIGN(x,sign); +} + +void zero_big(object x) +{ + ZERO_BIG(x); +} + +#ifndef HAVE_MP_COERCE_TO_STRING + +double digitsPerBit[37]={ 0,0, +1.0, /* 2 */ +0.6309297535714574, /* 3 */ +0.5, /* 4 */ +0.4306765580733931, /* 5 */ +0.3868528072345416, /* 6 */ +0.3562071871080222, /* 7 */ +0.3333333333333334, /* 8 */ +0.3154648767857287, /* 9 */ +0.3010299956639811, /* 10 */ +0.2890648263178878, /* 11 */ +0.2789429456511298, /* 12 */ +0.2702381544273197, /* 13 */ +0.2626495350371936, /* 14 */ +0.2559580248098155, /* 15 */ +0.25, /* 16 */ +0.244650542118226, /* 17 */ +0.2398124665681315, /* 18 */ +0.2354089133666382, /* 19 */ +0.2313782131597592, /* 20 */ +0.227670248696953, /* 21 */ +0.2242438242175754, /* 22 */ +0.2210647294575037, /* 23 */ +0.2181042919855316, /* 24 */ +0.2153382790366965, /* 25 */ +0.2127460535533632, /* 26 */ +0.2103099178571525, /* 27 */ +0.2080145976765095, /* 28 */ +0.2058468324604345, /* 29 */ +0.2037950470905062, /* 30 */ +0.2018490865820999, /* 31 */ +0.2, /* 32 */ +0.1982398631705605, /* 33 */ +0.1965616322328226, /* 34 */ +0.1949590218937863, /* 35 */ +0.1934264036172708, /* 36 */ +}; + +object +coerce_big_to_string(x,printbase) + int printbase; + object x; +{ int i; + int sign=big_sign(x); + object b; + int size = (int)((ceil(MP_SIZE_IN_BASE2(MP(x))* digitsPerBit[printbase]))+.01); + char *q,*p = alloca(size+5); + q=p; + if(sign<=0) { + *q++ = '-'; + b=big_minus(x); + } else { + b=copy_big(x); + } + while (!big_zerop(b)) + *q++=digit_weight(div_int_big(printbase, b),printbase); + *q++=0; + object ans = alloc_simple_string(q-p); + ans->ust.ust_self=alloc_relblock(ans->ust.ust_dim); + bcopy(ans->ust.ust_self,p,ans->ust.ust_dim); + ans->ust.ust_fillp=ans->ust.ust_dim-1; + return ans; +} + +#endif diff --git a/o/bind.c b/o/bind.c new file mode 100755 index 0000000..c1a1d42 --- /dev/null +++ b/o/bind.c @@ -0,0 +1,1158 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + bind.c +*/ + +#include + +#include "include.h" + +static void +illegal_lambda(void); + + +struct nil3 { object nil3_self[3]; } three_nils; +struct nil6 { object nil6_self[6]; } six_nils; + +struct required { + object req_var; + object req_spp; +}; + +struct optional { + object opt_var; + object opt_spp; + object opt_init; + object opt_svar; + object opt_svar_spp; +}; + +struct rest { + object rest_var; + object rest_spp; +}; + +struct keyword { + object key_word; + object key_var; + object key_spp; + object key_init; + object key_svar; + object key_svar_spp; + object key_val; + object key_svar_val; +}; + +struct aux { + object aux_var; + object aux_spp; + object aux_init; +}; + + + + + +#define isdeclare(x) ((x) == sLdeclare) + +void +lambda_bind(object *arg_top) +{ + + object temporary; + object lambda, lambda_list, body, form=Cnil, x, ds, vs, v; + int narg, i, j; + object *base = vs_base; + struct required *required; + int nreq; + struct optional *optional=NULL; + int nopt; + struct rest *rest=NULL; + bool rest_flag; + struct keyword *keyword=NULL; + bool key_flag; + bool allow_other_keys_flag, other_keys_appeared; + int nkey; + struct aux *aux=NULL; + int naux; + bool special_processed; + object s[1],ss; + vs_mark; + + bds_check; + lambda = vs_head; + if (!consp(lambda)) + FEerror("No lambda list.", 0); + lambda_list = lambda->c.c_car; + body = lambda->c.c_cdr; + + required = (struct required *)vs_top; + nreq = 0; + s[0]=Cnil; + for (;;) { + if (endp(lambda_list)) + goto REQUIRED_ONLY; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; + check_symbol(x); + if (x == ANDallow_other_keys) + illegal_lambda(); + if (x == ANDoptional) { + nopt = nkey = naux = 0; + rest_flag = key_flag = allow_other_keys_flag + = FALSE; + goto OPTIONAL; + } + if (x == ANDrest) { + nopt = nkey = naux = 0; + key_flag = allow_other_keys_flag + = FALSE; + goto REST; + } + if (x == ANDkey) { + nopt = nkey = naux = 0; + rest_flag = allow_other_keys_flag + = FALSE; + goto KEYWORD; + } + if (x == ANDaux) { + nopt = nkey = naux = 0; + rest_flag = key_flag = allow_other_keys_flag + = FALSE; + goto AUX_L; + } + if ((enum stype)x->s.s_stype == stp_constant) + FEerror("~S is not a variable.", 1, x); + vs_push(x); + vs_push(Cnil); + nreq++; + } + +OPTIONAL: + optional = (struct optional *)vs_top; + for (;; nopt++) { + if (endp(lambda_list)) + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; + if (consp(x)) { + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); + x = x->c.c_cdr; + vs_push(Cnil); + if (endp(x)) { + *(struct nil3 *)vs_top = three_nils; + vs_top += 3; + continue; + } + vs_push(x->c.c_car); + x = x->c.c_cdr; + if (endp(x)) { + vs_push(Cnil); + vs_push(Cnil); + continue; + } + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); + vs_push(Cnil); + if (!endp(x->c.c_cdr)) + illegal_lambda(); + } else { + check_symbol(x); + if (x == ANDoptional || + x == ANDallow_other_keys) + illegal_lambda(); + if (x == ANDrest) + goto REST; + if (x == ANDkey) + goto KEYWORD; + if (x == ANDaux) + goto AUX_L; + check_var(x); + vs_push(x); + *(struct nil6 *)vs_top = six_nils; + vs_top += 4; + } + } + +REST: + rest = (struct rest *)vs_top; + if (endp(lambda_list)) + illegal_lambda(); + check_symbol(lambda_list->c.c_car); + check_var(lambda_list->c.c_car); + rest_flag = TRUE; + vs_push(lambda_list->c.c_car); + vs_push(Cnil); + lambda_list = lambda_list->c.c_cdr; + if (endp(lambda_list)) + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; + check_symbol(x); + if (x == ANDoptional || x == ANDrest || + x == ANDallow_other_keys) + illegal_lambda(); + if (x == ANDkey) + goto KEYWORD; + if (x == ANDaux) + goto AUX_L; + illegal_lambda(); + +KEYWORD: + keyword = (struct keyword *)vs_top; + key_flag = TRUE; + for (;; nkey++) { + if (endp(lambda_list)) + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; + if (consp(x)) { + if (consp(x->c.c_car)) { + if (type_of(x->c.c_car->c.c_car)!=t_symbol) + /* FIXME better message */ + FEunexpected_keyword(x->c.c_car->c.c_car); + vs_push(x->c.c_car->c.c_car); + if (endp(x->c.c_car->c.c_cdr)) + illegal_lambda(); + check_symbol(x->c.c_car + ->c.c_cdr->c.c_car); + vs_push(x->c.c_car->c.c_cdr->c.c_car); + if (!endp(x->c.c_car->c.c_cdr->c.c_cdr)) + illegal_lambda(); + } else { + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(intern(x->c.c_car, keyword_package)); + vs_push(x->c.c_car); + } + vs_push(Cnil); + x = x->c.c_cdr; + if (endp(x)) { + *(struct nil6 *)vs_top = six_nils; + vs_top += 5; + continue; + } + vs_push(x->c.c_car); + x = x->c.c_cdr; + if (endp(x)) { + *(struct nil6 *)vs_top = six_nils; + vs_top += 4; + continue; + } + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); + vs_push(Cnil); + if (!endp(x->c.c_cdr)) + illegal_lambda(); + vs_push(Cnil); + vs_push(Cnil); + } else { + check_symbol(x); + if (x == ANDallow_other_keys) { + allow_other_keys_flag = TRUE; + if (endp(lambda_list)) + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; + } + if (x == ANDoptional || x == ANDrest || + x == ANDkey || x == ANDallow_other_keys) + illegal_lambda(); + if (x == ANDaux) + goto AUX_L; + check_var(x); + vs_push(intern(x, keyword_package)); + vs_push(x); + *(struct nil6 *)vs_top = six_nils; + vs_top += 6; + } + } + +AUX_L: + aux = (struct aux *)vs_top; + for (;; naux++) { + if (endp(lambda_list)) + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; + if (consp(x)) { + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); + vs_push(Cnil); + x = x->c.c_cdr; + if (endp(x)) { + vs_push(Cnil); + continue; + } + vs_push(x->c.c_car); + if (!endp(x->c.c_cdr)) + illegal_lambda(); + } else { + check_symbol(x); + if (x == ANDoptional || x == ANDrest || + x == ANDkey || x == ANDallow_other_keys || + x == ANDaux) + illegal_lambda(); + check_var(x); + vs_push(x); + vs_push(Cnil); + vs_push(Cnil); + } + } + +SEARCH_DECLARE: + vs_push(Cnil); + for (; !endp(body); body = body->c.c_cdr) { + form = body->c.c_car; + + /* MACRO EXPANSION */ + form = macro_expand(form); + vs_head = form; + + if (type_of(form) == t_string) { + if (endp(body->c.c_cdr)) + break; + continue; + } + if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { + if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; + for (; !endp(vs); vs = vs->c.c_cdr) { + v = vs->c.c_car; + check_symbol(v); +/**/ + + special_processed = FALSE; + for (i = 0; i < nreq; i++) + if (required[i].req_var == v) { + required[i].req_spp = Ct; + special_processed = TRUE; + } + for (i = 0; i < nopt; i++) + if (optional[i].opt_var == v) { + optional[i].opt_spp = Ct; + special_processed = TRUE; + } else if (optional[i].opt_svar == v) { + optional[i].opt_svar_spp = Ct; + special_processed = TRUE; + } + if (rest_flag && rest->rest_var == v) { + rest->rest_spp = Ct; + special_processed = TRUE; + } + for (i = 0; i < nkey; i++) + if (keyword[i].key_var == v) { + keyword[i].key_spp = Ct; + special_processed = TRUE; + } else if (keyword[i].key_svar == v) { + keyword[i].key_svar_spp = Ct; + special_processed = TRUE; + } + for (i = 0; i < naux; i++) + if (aux[i].aux_var == v) { + aux[i].aux_spp = Ct; + special_processed = TRUE; + } + if (special_processed) + continue; + s[0] = MMcons(MMcons(v, Cnil), s[0]); + +/**/ + } + } + } + } + + narg = arg_top - base; + if (narg < nreq) { + if (nopt == 0 && !rest_flag && !key_flag) { + vs_base = base; + vs_top = arg_top; + check_arg_failed(nreq); + } + FEtoo_few_arguments(base, arg_top); + } + if (!rest_flag && !key_flag && narg > nreq+nopt) { + if (nopt == 0) { + vs_base = base; + vs_top = arg_top; + check_arg_failed(nreq); + } + FEtoo_many_arguments(base, arg_top); + } + for (i = 0; i < nreq; i++) + bind_var(required[i].req_var, + base[i], + required[i].req_spp); + for (i = 0; i < nopt; i++) + if (nreq+i < narg) { + bind_var(optional[i].opt_var, + base[nreq+i], + optional[i].opt_spp); + if (optional[i].opt_svar != Cnil) + bind_var(optional[i].opt_svar, + Ct, + optional[i].opt_svar_spp); + } else { + eval_assign(temporary, optional[i].opt_init); + bind_var(optional[i].opt_var, + temporary, + optional[i].opt_spp); + if (optional[i].opt_svar != Cnil) + bind_var(optional[i].opt_svar, + Cnil, + optional[i].opt_svar_spp); + } + if (rest_flag) { + object *l=vs_top++; + for (i=nreq+nopt;irest_var, vs_head, rest->rest_spp); + } + if (key_flag) { + int allow_other_keys_found=0; + i = narg - nreq - nopt; + if (i >= 0 && i%2 != 0) + /* FIXME better message */ + FEunexpected_keyword(Cnil); + other_keys_appeared = FALSE; + for (i = nreq + nopt; i < narg; i += 2) { + if (type_of(base[i])!=t_symbol) + FEunexpected_keyword(base[i]); + if (base[i] == sKallow_other_keys && !allow_other_keys_found) { + allow_other_keys_found=1; + if (base[i+1] != Cnil) + allow_other_keys_flag = TRUE; + } + for (j = 0; j < nkey; j++) { + if (keyword[j].key_word == base[i]) { + if (keyword[j].key_svar_val + != Cnil) + goto NEXT_ARG; + keyword[j].key_val + = base[i+1]; + keyword[j].key_svar_val + = Ct; + goto NEXT_ARG; + } + } + if (base[i] != sKallow_other_keys) + other_keys_appeared = TRUE; + + NEXT_ARG: + continue; + } + if (other_keys_appeared && !allow_other_keys_flag) + /* FIXME better message */ + FEunexpected_keyword(Ct); + } + for (i = 0; i < nkey; i++) + if (keyword[i].key_svar_val != Cnil) { + bind_var(keyword[i].key_var, + keyword[i].key_val, + keyword[i].key_spp); + if (keyword[i].key_svar != Cnil) + bind_var(keyword[i].key_svar, + keyword[i].key_svar_val, + keyword[i].key_svar_spp); + } else { + eval_assign(temporary, keyword[i].key_init); + bind_var(keyword[i].key_var, + temporary, + keyword[i].key_spp); + if (keyword[i].key_svar != Cnil) + bind_var(keyword[i].key_svar, + keyword[i].key_svar_val, + keyword[i].key_svar_spp); + } + for (i = 0; i < naux; i++) { + eval_assign(temporary, aux[i].aux_init); + bind_var(aux[i].aux_var, temporary, aux[i].aux_spp); + } + if (!consp(body) || body->c.c_car == form) { + vs_reset; + vs_head = body; + } else { + body = make_cons(form, body->c.c_cdr); + vs_reset; + vs_head = body; + } + + if (s[0]!=Cnil) { + for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); + ss->c.c_cdr=lex_env[0]; + lex_env[0]=s[0]; + } + + return; + +REQUIRED_ONLY: + vs_push(Cnil); + for (; !endp(body); body = body->c.c_cdr) { + form = body->c.c_car; + + /* MACRO EXPANSION */ + vs_head = form = macro_expand(form); + + if (type_of(form) == t_string) { + if (endp(body->c.c_cdr)) + break; + continue; + } + if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { + if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; + for (; !endp(vs); vs = vs->c.c_cdr) { + v = vs->c.c_car; + check_symbol(v); +/**/ + + special_processed = FALSE; + for (i = 0; i < nreq; i++) + if (required[i].req_var == v) { + required[i].req_spp = Ct; + special_processed = TRUE; + } + if (special_processed) + continue; + /* lex_special_bind(v); */ + temporary = MMcons(v, Cnil); + s[0] = MMcons(temporary, s[0]); + +/**/ + } + } + } + } + + narg = arg_top - base; + if (narg != nreq) { + vs_base = base; + vs_top = arg_top; + check_arg_failed(nreq); + } + for (i = 0; i < nreq; i++) + bind_var(required[i].req_var, + base[i], + required[i].req_spp); + if (!consp(body) || body->c.c_car == form) { + vs_reset; + vs_head = body; + } else { + body = make_cons(form, body->c.c_cdr); + vs_reset; + vs_head = body; + } + + if (s[0]!=Cnil) { + for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); + ss->c.c_cdr=lex_env[0]; + lex_env[0]=s[0]; + } + +} + +void +bind_var(object var, object val, object spp) +{ + object temporary; + vs_mark; + + switch (var->s.s_stype) { + case stp_constant: + FEerror("Cannot bind the constant ~S.", 1, var); + + case stp_special: + bds_bind(var, val); + break; + + default: + if (spp != Cnil) { + /* lex_special_bind(var); */ + temporary = MMcons(var, Cnil); + lex_env[0] = MMcons(temporary, lex_env[0]); + bds_bind(var, val); + } else { + /* lex_local_bind(var, val); */ + temporary = MMcons(val, Cnil); + temporary = MMcons(var, temporary); + lex_env[0] = MMcons(temporary, lex_env[0]); + } + break; + } + vs_reset; +} + +static void +illegal_lambda(void) +{ + FEerror("Illegal lambda expression.", 0); +} + +/* +struct bind_temp { + object bt_var; + object bt_spp; + object bt_init; + object bt_aux; +}; +*/ + +object +find_special(object body, struct bind_temp *start, struct bind_temp *end,object *s) +{ + object temporary; + object form=Cnil; + object ds, vs, v; + struct bind_temp *bt; + bool special_processed; + vs_mark; + + vs_push(Cnil); + s=s ? s : lex_env; + for (; !endp(body); body = body->c.c_cdr) { + form = body->c.c_car; + + /* MACRO EXPANSION */ + form = macro_expand(form); + vs_head = form; + + if (type_of(form) == t_string) { + if (endp(body->c.c_cdr)) + break; + continue; + } + if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { + if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; + for (; !endp(vs); vs = vs->c.c_cdr) { + v = vs->c.c_car; + check_symbol(v); +/**/ + special_processed = FALSE; + for (bt = start; bt < end; bt++) + if (bt->bt_var == v) { + bt->bt_spp = Ct; + special_processed = TRUE; + } + if (special_processed) + continue; + /* lex_special_bind(v); */ + temporary = MMcons(v, Cnil); + s[0] = MMcons(temporary, s[0]); +/**/ + } + } + } + } + + if (body != Cnil && body->c.c_car != form && type_of(form)==t_cons && isdeclare(form->c.c_car))/*FIXME*/ + body = make_cons(form, body->c.c_cdr); + vs_reset; + return(body); +} + +object +let_bind(object body, struct bind_temp *start, struct bind_temp *end) +{ + struct bind_temp *bt; + + bds_check; + for (bt = start; bt < end; bt++) { + eval_assign(bt->bt_init, bt->bt_init); + } + vs_push(find_special(body, start, end,NULL)); + for (bt = start; bt < end; bt++) { + bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); + } + return(vs_pop); +} + +object +letA_bind(object body, struct bind_temp *start, struct bind_temp *end) +{ + struct bind_temp *bt; + object s[1],ss; + + bds_check; + s[0]=Cnil; + vs_push(find_special(body, start, end,s)); + for (bt = start; bt < end; bt++) { + eval_assign(bt->bt_init, bt->bt_init); + bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); + } + if (s[0]!=Cnil) { + for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); + ss->c.c_cdr=lex_env[0]; + lex_env[0]=s[0]; + } + return(vs_pop); +} + + +#ifdef MV + +#endif + +#define NOT_YET stp_ordinary +#define FOUND stp_special +#define NOT_KEYWORD 1 + +void +parse_key(object *base, bool rest, bool allow_other_keys, int n, ...) +{ + object temporary; + va_list ap; + object other_key = OBJNULL; + int narg, error_flag = 0, allow_other_keys_found=0; + object *v, k, *top; + register int i; + + narg = vs_top - base; + if (narg <= 0) { + if (rest) { + base[0] = Cnil; + base++; + } + top = base + n; + for (i = 0; i < n; i++) { + base[i] = Cnil; + top[i] = Cnil; + } + return; + } + if (narg%2 != 0) + /* FIXME better message */ + FEunexpected_keyword(Cnil); + if (narg == 2) { + k = base[0]; + if (type_of(k)!=t_symbol) + FEunexpected_keyword(k); + if (k == sKallow_other_keys && ! allow_other_keys_found) { + allow_other_keys_found=1; + if (base[1]!=Cnil) + allow_other_keys=TRUE; + } + temporary = base[1]; + if (rest) + base++; + top = base + n; + other_key = k == sKallow_other_keys ? OBJNULL : k; + va_start(ap,n); + for (i = 0; i < n; i++) { + + if (va_arg(ap,object) == k) { + base[i] = temporary; + top[i] = Ct; + other_key = OBJNULL; + } else { + base[i] = Cnil; + top[i] = Cnil; + } + } + va_end(ap); + if (rest) { + temporary = make_cons(temporary, Cnil); + base[-1] = make_cons(k, temporary); + } + if (other_key != OBJNULL && !allow_other_keys) + FEunexpected_keyword(other_key); + return; + } + va_start(ap,n); + for (i = 0; i < n; i++) { + k = va_arg(ap,object); + k->s.s_stype = NOT_YET; + k->s.s_dbind = Cnil; + } + va_end(ap); + for (v = base; v < vs_top; v += 2) { + k = v[0]; + if (type_of(k)!=t_symbol) { + error_flag = NOT_KEYWORD; + other_key = k; + continue; + } + if (k->s.s_stype == NOT_YET) { + k->s.s_dbind = v[1]; + k->s.s_stype = FOUND; + } else if (k->s.s_stype == FOUND) { + ; + } else if (other_key == OBJNULL && k!=sKallow_other_keys) + other_key = k; + if (k == sKallow_other_keys && !allow_other_keys_found) { + allow_other_keys_found=1; + if (v[1] != Cnil) + allow_other_keys = TRUE; + } + } + if (rest) { + object *a,*l; + for (l=a=base;as.s_dbind; + top[i] = k->s.s_stype == FOUND ? Ct : Cnil; + k->s.s_dbind = k; + k->s.s_stype = (short)stp_constant; + } + va_end(ap); + if (error_flag == NOT_KEYWORD) + FEunexpected_keyword(other_key); + if (other_key != OBJNULL && !allow_other_keys) + FEunexpected_keyword(other_key); +} + +void +check_other_key(object l, int n, ...) +{ + va_list ap; + object other_key = OBJNULL; + object k; + int i; + bool allow_other_keys = FALSE; + int allow_other_keys_found=0; + + for (; !endp(l); l = l->c.c_cdr->c.c_cdr) { + k = l->c.c_car; + if (type_of(k)!=t_symbol) + FEunexpected_keyword(k); + if (endp(l->c.c_cdr)) + /* FIXME better message */ + FEunexpected_keyword(Cnil); + if (k == sKallow_other_keys && !allow_other_keys_found) { + allow_other_keys_found=1; + if (l->c.c_cdr->c.c_car != Cnil) + allow_other_keys = TRUE; + } else { + char buf [100]; + bzero(buf,n); + va_start(ap,n); + for (i = 0; i < n; i++) + { if (va_arg(ap,object) == k && + buf[i] ==0) {buf[i]=1; break;}} + va_end(ap); + if (i >= n) other_key = k; + } + } + if (other_key != OBJNULL && !allow_other_keys) + FEunexpected_keyword(other_key); +} + + +/* struct key {short n,allow_other_keys; */ +/* iobject *defaults; */ +/* iobject keys[1]; */ +/* }; */ + + +object Cstd_key_defaults[15]={Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil, + Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil}; + +/* FIXME rewrite this */ +/* static int */ +/* parse_key_new(int n, object *base, struct key *keys, va_list ap) */ +/* {object *new; */ +/* COERCE_VA_LIST(new,ap,n); */ + +/* new = new + n ; */ +/* {int j=keys->n; */ +/* object *p= (object *)(keys->defaults); */ +/* while (--j >=0) base[j]=p[j]; */ +/* } */ +/* {if (n==0){ return 0;} */ +/* {int allow = keys->allow_other_keys; */ +/* object k; */ + +/* if (!allow) { */ +/* int i; */ +/* for (i=n;i>0 && new[-i]!=sKallow_other_keys;i-=2); */ +/* if (i>0 && new[-i+1]!=Cnil) */ +/* allow=1; */ +/* } */ + +/* top: */ +/* while (n>=2) */ +/* {int i= keys->n; */ +/* iobject *ke=keys->keys ; */ +/* new = new -2; */ +/* k = *new; */ +/* while(--i >= 0) */ +/* {if ((*(ke++)).o == k) */ +/* {base[i]= new[1]; */ +/* n=n-2; */ +/* goto top; */ +/* }} */ + /* the key is a new one */ +/* if (allow || k==sKallow_other_keys) */ +/* n=n-2; */ +/* else */ +/* goto error; */ +/* } */ + /* FIXME better message */ +/* if (n!=0) FEunexpected_keyword(Cnil); */ +/* return 0; */ +/* error: */ +/* FEunexpected_keyword(k); */ +/* return -1; */ +/* }}} */ + +int +parse_key_new_new(int n, object *base, struct key *keys, object first, va_list ap) +{object *new; + COERCE_VA_LIST_KR_NEW(new,first,ap,n); + + /* from here down identical to parse_key_rest */ + new = new + n ; + {int j=keys->n; + object **p= (object **)(keys->defaults); + while (--j >=0) base[j]=*(p[j]); + } + {if (n==0){ return 0;} + {int allow = keys->allow_other_keys; + object k; + + if (!allow) { + int i; + for (i=n;i>0 && new[-i]!=sKallow_other_keys;i-=2); + if (i>0 && new[-i+1]!=Cnil) + allow=1; + } + + top: + while (n>=2) + {int i= keys->n; + iobject *ke=keys->keys ; + new = new -2; + k = *new; + while(--i >= 0) + {if (*(*(ke++)).o == k) + {base[i]= new[1]; + n=n-2; + goto top; + }} + /* the key is a new one */ + if (allow || k==sKallow_other_keys) + n=n-2; + else + goto error; + } + /* FIXME better message */ + if (n!=0) FEunexpected_keyword(Cnil); + return 0; + error: + FEunexpected_keyword(k); + return -1; +}}} + +/* static int */ +/* parse_key_rest(object rest, int n, object *base, struct key *keys, va_list ap) */ +/* {object *new; */ +/* COERCE_VA_LIST(new,ap,n); */ + + /* copy the rest arg */ +/* {object *p = new; */ +/* int m = n; */ +/* while (--m >= 0) */ +/* {rest->c.c_car = *p++; */ +/* rest = rest->c.c_cdr;}} */ + +/* new = new + n ; */ +/* {int j=keys->n; */ +/* object *p= (object *)(keys->defaults); */ +/* while (--j >=0) base[j]=p[j]; */ +/* } */ +/* {if (n==0){ return 0;} */ +/* {int allow = keys->allow_other_keys; */ +/* object k; */ + +/* if (!allow) { */ +/* int i; */ +/* for (i=n;i>0 && new[-i]!=sKallow_other_keys;i-=2); */ +/* if (i>0 && new[-i+1]!=Cnil) */ +/* allow=1; */ +/* } */ + +/* top: */ +/* while (n>=2) */ +/* {int i= keys->n; */ +/* iobject *ke=keys->keys ; */ +/* new = new -2; */ +/* k = *new; */ +/* while(--i >= 0) */ +/* {if ((*(ke++)).o == k) */ +/* {base[i]= new[1]; */ +/* n=n-2; */ +/* goto top; */ +/* }} */ + /* the key is a new one */ +/* if (allow || k==sKallow_other_keys) */ +/* n=n-2; */ +/* else */ +/* goto error; */ +/* } */ + /* FIXME better message */ +/* if (n!=0) FEunexpected_keyword(Cnil); */ +/* return 0; */ +/* error: */ +/* FEunexpected_keyword(k); */ +/* return -1; */ +/* }}} */ + +int +parse_key_rest_new(object rest, int n, object *base, struct key *keys, object first,va_list ap) +{object *new; + COERCE_VA_LIST_KR_NEW(new,first,ap,n); + + /* copy the rest arg */ + {object *p = new; + int m = n; + while (--m >= 0) + {rest->c.c_car = *p++; + rest = rest->c.c_cdr;}} + + new = new + n ; + {int j=keys->n; + while (--j >=0) base[j]=*keys->defaults[j].o; + } + {if (n==0){ return 0;} + {int allow = keys->allow_other_keys; + object k; + + if (!allow) { + int i; + for (i=n;i>0 && new[-i]!=sKallow_other_keys;i-=2); + if (i>0 && new[-i+1]!=Cnil) + allow=1; + } + + top: + while (n>=2) + {int i= keys->n; + iobject *ke=keys->keys ; + new = new -2; + k = *new; + while(--i >= 0) + {if (*(*(ke++)).o == k) + {base[i]= new[1]; + n=n-2; + goto top; + }} + /* the key is a new one */ + if (allow || k==sKallow_other_keys) + n=n-2; + else + goto error; + } + /* FIXME better message */ + if (n!=0) FEunexpected_keyword(Cnil); + return 0; + error: + FEunexpected_keyword(k); + return -1; +}}} + +static object foo[2]={Cnil,OBJNULL}; + +void +set_key_struct(struct key *ks, object data) +{int i=ks->n; + while (--i >=0) + {ks->keys[i].o = data->cfd.cfd_self+ks->keys[i].i; + if (ks->defaults != (void *)Cstd_key_defaults) + {fixnum m=ks->defaults[i].i; + ks->defaults[i].o= + (m==-2 ? foo : + m==-1 ? foo+1 : + data->cfd.cfd_self+m);} +}} + +#undef AUX + +DEF_ORDINARY("ALLOW-OTHER-KEYS",sKallow_other_keys,KEYWORD,""); + + +void +gcl_init_bind(void) +{ + ANDoptional = make_ordinary("&OPTIONAL"); + enter_mark_origin(&ANDoptional); + ANDrest = make_ordinary("&REST"); + enter_mark_origin(&ANDrest); + ANDkey = make_ordinary("&KEY"); + enter_mark_origin(&ANDkey); + ANDallow_other_keys = make_ordinary("&ALLOW-OTHER-KEYS"); + enter_mark_origin(&ANDallow_other_keys); + ANDaux = make_ordinary("&AUX"); + enter_mark_origin(&ANDaux); + + make_constant("LAMBDA-LIST-KEYWORDS", + make_cons(ANDoptional, + make_cons(ANDrest, + make_cons(ANDkey, + make_cons(ANDallow_other_keys, + make_cons(ANDaux, + make_cons(make_ordinary("&WHOLE"), + make_cons(make_ordinary("&ENVIRONMENT"), + make_cons(make_ordinary("&BODY"), Cnil))))))))); + + make_constant("LAMBDA-PARAMETERS-LIMIT", + make_fixnum(MAX_ARGS+1)); + + + + three_nils.nil3_self[0] = Cnil; + three_nils.nil3_self[1] = Cnil; + three_nils.nil3_self[2] = Cnil; + + six_nils.nil6_self[0] = Cnil; + six_nils.nil6_self[1] = Cnil; + six_nils.nil6_self[2] = Cnil; + six_nils.nil6_self[3] = Cnil; + six_nils.nil6_self[4] = Cnil; + six_nils.nil6_self[5] = Cnil; +} diff --git a/o/bind.texi b/o/bind.texi new file mode 100755 index 0000000..7b12edd --- /dev/null +++ b/o/bind.texi @@ -0,0 +1 @@ +@setfilename foo.info diff --git a/o/bitop.c b/o/bitop.c new file mode 100755 index 0000000..39911d2 --- /dev/null +++ b/o/bitop.c @@ -0,0 +1,47 @@ +#include "include.h" +/* static void */ +/* get_mark_bit(void) */ +/* {error("get_mark_bit called");} */ +/* static void */ +/* set_mark_bit(void) */ +/* {error("set_mark_bit called");} */ +/* static void */ +/* get_set_mark_bit(void) */ +/* {error("get_set_mark_bit called");} */ + + +/* + These have all been replaced by macros + +extern int *mark_table; +static +get_mark_bit(x) +int x; +{ + int y; + + y = (*(mark_table+(x/4/32)) >> (x/4%32)) & 1; + return(y); +} +static +set_mark_bit(x) +int x; +{ + int y; + + y = 1 << (x/4%32); + y = (*(mark_table+(x/4/32))) | y; + *(mark_table+ (x/4/32))=y; +} +static +get_set_mark_bit(x) +int x; +{ + int y; + + y = get_mark_bit(x); + set_mark_bit(x); + return(y); +} + +*/ diff --git a/o/block.c b/o/block.c new file mode 100755 index 0000000..c466a36 --- /dev/null +++ b/o/block.c @@ -0,0 +1,123 @@ +/* + Copyright (C) 1994 M. Hagiya, W. sLchelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + block.c + + blocks and exits +*/ + +#include "include.h" + +static void +FFN(Fblock)(VOL object args) +{ + object *oldlex = lex_env; + object id; + object body; + object *top; + + if(endp(args)) + FEtoo_few_argumentsF(args); + lex_copy(); + id = alloc_frame_id(); + vs_push(id); + lex_block_bind(MMcar(args), id); + vs_popp; + frs_push(FRS_CATCH, id); + if (nlj_active) + nlj_active = FALSE; + else { + body = MMcdr(args); + if (endp(body)) { + vs_base = vs_top; + vs_push(Cnil); + } else { + top = vs_top; + do { + vs_top = top; + eval(MMcar(body)); + body = MMcdr(body); + } while (!endp(body)); + } + } + frs_pop(); + lex_env = oldlex; +} + +static void +FFN(Freturn_from)(object args) +{ + object lex_block; + frame_ptr fr; + + if (endp(args)) + FEtoo_few_argumentsF(args); + if (!endp(MMcdr(args)) && !endp(MMcddr(args))) + FEtoo_many_argumentsF(args); + lex_block = lex_block_sch(MMcar(args)); + if (MMnull(lex_block)) + FEerror("The block name ~S is undefined.", 1, MMcar(args)); + fr = frs_sch(MMcaddr(lex_block)); + if(fr == NULL) + FEerror("The block ~S is missing.", 1, MMcar(args)); + if(endp(MMcdr(args))) { + vs_base = vs_top; + vs_push(Cnil); + } + else + eval(MMcadr(args)); + unwind(fr, MMcaddr(lex_block)); + /* never reached */ +} + +static void +FFN(Freturn)(object args) +{ + object lex_block; + frame_ptr fr; + + if(!endp(args) && !endp(MMcdr(args))) + FEtoo_many_argumentsF(args); + lex_block = lex_block_sch(Cnil); + if (MMnull(lex_block)) + FEerror("The block name ~S is undefined.", 1, Cnil); + fr = frs_sch(MMcaddr(lex_block)); + if (fr == NULL) + FEerror("The block ~S is missing.", 1, Cnil); + if(endp(args)) { + vs_base = vs_top; + vs_push(Cnil); + } else + eval(MMcar(args)); + unwind(fr, MMcaddr(lex_block)); + /* never reached */ +} + +void +gcl_init_block(void) +{ + sLblock = make_special_form("BLOCK", Fblock); + enter_mark_origin(&sLblock); + make_special_form("RETURN-FROM", Freturn_from); + make_special_form("RETURN", Freturn); +} diff --git a/o/bsearch.c b/o/bsearch.c new file mode 100755 index 0000000..6f47c8f --- /dev/null +++ b/o/bsearch.c @@ -0,0 +1,30 @@ +#include +void * +bsearch(const void *key, const void *base, size_t nel, size_t keysize, int (*compar)(const void *, const void *)) +{ + char *beg=base; + char *end=base+keysize*(nel-1); + char *mid; + int cmp,tem; + if (nel==0) return 0; + cmp=(*compar)(beg,key); + if (cmp==0) return beg; + if (cmp> 0) return 0; + cmp= (*compar)(key,end); + if (cmp==0) return end; + if (cmp> 0)return 0; + /* key is in range from here on */ + start: + if (nel<=2) return 0; + tem=nel; + nel=nel/2; + mid=beg+(nel)*keysize; + cmp= (*compar)(key,mid); + if (cmp==0) return mid; + if (cmp< 0) {end=mid; nel++; + goto start;; + } + beg=mid; + nel=tem-(nel); + goto start; +} diff --git a/o/bzero.c b/o/bzero.c new file mode 100755 index 0000000..ba045a1 --- /dev/null +++ b/o/bzero.c @@ -0,0 +1,7 @@ +#include +void bzero(void *b, size_t length) +{ char *c=b; + + while(length-->0) + *c++ = 0; +} diff --git a/o/catch.c b/o/catch.c new file mode 100755 index 0000000..7897300 --- /dev/null +++ b/o/catch.c @@ -0,0 +1,165 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + catch.c + + dynamic non-local exit +*/ + +#include "include.h" + +static void +FFN(Fcatch)(VOL object args) +{ + + object *top = vs_top; + + if (endp(args)) + FEtoo_few_argumentsF(args); + eval(MMcar(args)); + vs_top = top; + vs_push(vs_base[0]); + frs_push(FRS_CATCH, vs_base[0]); + if (nlj_active) + nlj_active = FALSE; + else + Fprogn(MMcdr(args)); + frs_pop(); +} + +DEFUNM_NEW("ERROR-SET",object,fSerror_set,SI + ,1,1,NONE,OO,OO,OO,OO,(volatile object x0), + "Evaluates the FORM in the null environment. If the evaluation \ +of the FORM has successfully completed, SI:ERROR-SET returns NIL as the first \ +value and the result of the evaluation as the rest of the values. If, in the \ +course of the evaluation, a non-local jump from the FORM is atempted, \ +SI:ERROR-SET traps the jump and returns the corresponding jump tag as its \ +value.") + +{ + object *old_lex = lex_env; + + /* 1 args */ + vs_push(Cnil); + frs_push(FRS_CATCHALL, Cnil); + if (nlj_active) { + nlj_active = FALSE; + x0 = nlj_tag; + frs_pop(); + lex_env = old_lex; + RETURN1(x0); + } else { + lex_env = vs_top; + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + x0 = Ieval(x0); + } + frs_pop(); + lex_env = old_lex; + {int i = fcall.nvalues; + if (i+1>=sizeof(fcall.values)/sizeof(*fcall.values)) + FEerror("Too many function call values",0); + while (i > 0) + { fcall.values[i+1] = fcall.values[i]; + i--;} + fcall.nvalues++; + fcall.values[1] = x0;} + return Cnil; +} + +static void +FFN(Funwind_protect)(VOL object args) +{ + + object *top = vs_top; + object *value_top; + if (endp(args)) + FEtoo_few_argumentsF(args); + frs_push(FRS_PROTECT, Cnil); + if (nlj_active) { + object tag = nlj_tag; + frame_ptr fr = nlj_fr; + + value_top = vs_top; + vs_top = top; + while(vs_bases.s_dbind->v.v_self[fix(i)])) +object sSPinit,sSPmemory; + +object +make_cfun(void (*self)(), object name, object data, char *start, int size) +{ + object cf; + + cf = alloc_object(t_cfun); + cf->cf.cf_self = self; + cf->cf.cf_name = name; + cf->cf.cf_data = data; + if(data && type_of(data)==t_cfdata) + { data->cfd.cfd_start=start; + data->cfd.cfd_size=size;} + else if(size) FEerror("Bad call to make_cfun",0); + return(cf); +} +object +make_sfun(object name, object (*self)(), int argd, object data) + + +/* object (*self)(); */ + +{object sfn; + + sfn = alloc_object(t_sfun); + if(argd >15) sfn->d.t = (int)t_gfun; + sfn->sfn.sfn_self = self; + sfn->sfn.sfn_name = name; + sfn->sfn.sfn_data = data; + sfn->sfn.sfn_argd = argd; + return(sfn); +} + +#define VFUN_MIN_ARGS(argd) (argd & 0xff) +#define VFUN_MAX_ARGS(argd) ((argd) >> 8) + +static object +make_vfun(object name, object (*self)(), int argd, object data) +{object vfn; + + vfn = alloc_object(t_vfun); + vfn->vfn.vfn_self = self; + vfn->vfn.vfn_name = name; + vfn->vfn.vfn_minargs = VFUN_MIN_ARGS(argd); + vfn->vfn.vfn_maxargs = VFUN_MAX_ARGS(argd); + vfn->vfn.vfn_data = data; + return(vfn); +} + +object +make_cclosure_new(void (*self)(), object name, object env, object data) +{ + object cc; + + cc = alloc_object(t_cclosure); + cc->cc.cc_self = self; + cc->cc.cc_name = name; + cc->cc.cc_env = env; + cc->cc.cc_data = data; + cc->cc.cc_turbo = NULL; + turbo_closure(cc); + return(cc); +} + + +object +make_cclosure(void (*self)(), object name, object env, object data, char *start, int size) +{ + if(data && type_of(data)==t_cfdata) + { data->cfd.cfd_start=start; + data->cfd.cfd_size=size;} + else if(size) FEerror("Bad call to make_cclosure",0); + return make_cclosure_new(self,name,env,data); + +} + + +DEFUN_NEW("MC",object,fSmc,SI + ,2,2,NONE,OO,OO,OO,OO,(object name,object address),"") +{ /* 2 args */ + dcheck_type(name,t_symbol); + dcheck_type(address,t_fixnum); + dcheck_type(sSPmemory->s.s_dbind,t_cfdata); + name=make_cclosure_new(PADDR(address),name,Cnil, + sSPmemory->s.s_dbind); + RETURN1(name); +} + +static object +MFsfun(object sym, object (*self)(), int argd, object data) +{object sfn; + if (type_of(sym)!=t_symbol) not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL && sym->s.s_mflag) + sym->s.s_sfdef = NOT_SPECIAL; + sfn = make_sfun(sym,self,argd,data); + sym = clear_compiler_properties(sym,sfn); + sym->s.s_gfdef = sfn; + sym->s.s_mflag = FALSE; + return sym; +} + +DEFUN_NEW("MFSFUN",object,fSmfsfun,SI + ,3,3,NONE,OO,OO,OO,OO,(object name,object address,object argd),"") +{ /* 3 args */ + dcheck_type(address,t_fixnum); + return MFsfun(name,PADDR(address),fix(argd),sSPmemory->s.s_dbind);RETURN1(name); +} + + +static object +MFvfun(object sym, object (*self)(), int argd, object data) +{object vfn; + if (type_of(sym)!=t_symbol) not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL && sym->s.s_mflag) + sym->s.s_sfdef = NOT_SPECIAL; + dcheck_type(data,t_cfdata); + vfn = make_vfun(sym,self,argd,data); + sym = clear_compiler_properties(sym,vfn); + sym->s.s_gfdef = vfn; + sym->s.s_mflag = FALSE; + return sym; +} + +DEFUN_NEW("MFVFUN",object,fSmfvfun,SI + ,3,3,NONE,OO,OO,OO,OO,(object name,object address,object argd),"") + +{ /* 3 args */ + MFvfun(name,PADDR(address),fix(argd),sSPmemory->s.s_dbind); + RETURN1(name); +} + + + +static object +MFvfun_key(object sym, object (*self)(), int argd, object data, struct key *keys) +{if (data) set_key_struct(keys,data); + return MFvfun(sym,self,argd,data); +} + +DEFUN_NEW("MFVFUN-KEY",object,fSmfvfun_key,SI + ,4,4,NONE,OO,OO,OO,OO,(object symbol,object address,object argd,object keys),"") +{ /* 4 args */ + MFvfun_key(symbol,PADDR(address),fix(argd),sSPmemory->s.s_dbind,PADDR(keys)); + RETURN1(symbol); +} + + +static object MFnew(object sym, void (*self)(), object data) +{ + object cf; + + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL && sym->s.s_mflag) + sym->s.s_sfdef = NOT_SPECIAL; + cf = alloc_object(t_cfun); + cf->cf.cf_self = self; + cf->cf.cf_name = sym; + cf->cf.cf_data = data; + sym = clear_compiler_properties(sym,cf); + sym->s.s_gfdef = cf; + sym->s.s_mflag = FALSE; + return sym; +} + +DEFUN_NEW("MF",object,fSmf,SI + ,2,2,NONE,OO,OO,OO,OO,(object name,object addr),"") + +{ /* 2 args */ + MFnew(name,PADDR(addr),sSPmemory->s.s_dbind); + RETURN1(name); +} + + +/* static object */ +/* MF(object sym, void (*self)(), char *start, int size, object data) */ +/* { if(data && type_of(data)==t_cfdata) */ +/* { data->cfd.cfd_start=start; */ +/* data->cfd.cfd_size=size;} */ +/* else if(size) FEerror("Bad call to make_cfun",0); */ +/* return(MFnew(sym,self,data)); */ +/* } */ + +static object +MM(object sym, void (*self)(), char *start, int size, object data) +{ + object sfn; + + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL && sym->s.s_mflag) + sym->s.s_sfdef = NOT_SPECIAL; + sfn = alloc_object(t_sfun); + sfn->sfn.sfn_self = (void *)self;/*FIXME*/ + sfn->sfn.sfn_name = sym; + sfn->sfn.sfn_data = data; + sfn->sfn.sfn_argd=2; + data->cfd.cfd_start=start; + data->cfd.cfd_size=size; + sym = clear_compiler_properties(sym,sfn); + sym->s.s_gfdef = sfn; + sym->s.s_mflag = TRUE; + return sym; +} + +DEFUN_NEW("MM",object,fSmm,SI + ,2,2,NONE,OO,OO,OO,OO,(object name,object addr),"") + +{ /* 2 args */ + MM(name,PADDR(addr), + /* bit wasteful to pass these in just to be reset to themselves..*/ + sSPmemory->s.s_dbind->cfd.cfd_start, + sSPmemory->s.s_dbind->cfd.cfd_size, + sSPmemory->s.s_dbind + );RETURN1(name); +} + + + +object +make_function_internal(char *s, void (*f)()) +{ + object x; + vs_mark; + + x = make_ordinary(s); + vs_push(x); + x->s.s_gfdef = make_cfun(f, x, Cnil, NULL, 0); + x->s.s_mflag = FALSE; + vs_reset; + return(x); +} + +object +make_si_sfun_internal(char *s, object (*f) (), int argd) { + object x= make_si_ordinary(s); + x->s.s_gfdef = make_sfun( x,f,argd, Cnil); + x->s.s_mflag = FALSE; + return(x); +} + +/* static object */ +/* make_si_vfun1(char *s, object (*f)(), int argd) */ +/* { object x= make_si_ordinary(s); */ +/* x->s.s_gfdef = make_vfun( x,f,argd, Cnil); */ +/* x->s.s_mflag = FALSE; */ +/* return(x); */ +/* } */ + + +object +make_si_function_internal(char *s, void (*f)()) +{ + object x; + vs_mark; + + x = make_si_ordinary(s); + vs_push(x); + x->s.s_gfdef = make_cfun(f, x, Cnil, NULL, 0); + x->s.s_mflag = FALSE; + vs_reset; + return(x); +} + + + + +object +make_special_form_internal(char *s, void (*f)()) +{ + object x; + x = make_ordinary(s); + x->s.s_sfdef = f; + return(x); +} + +object +make_si_special_form_internal(char *s, void (*f)()) +{ + object x; + x = make_si_ordinary(s); + x->s.s_sfdef = f; + return(x); +} + +object +make_macro_internal(char *s, void (*f)()) +{ + object x; + x = make_ordinary(s); + x->s.s_gfdef = make_cfun(f, x, Cnil, NULL, 0); + x->s.s_mflag=TRUE; + return(x); +} + +DEFUN_NEW("COMPILED-FUNCTION-NAME",object,fScompiled_function_name,SI + ,1,1,NONE,OO,OO,OO,OO,(object fun),"") + +{ + /* 1 args */ + switch(type_of(fun)) { + case t_cfun: + case t_afun: + case t_closure: + case t_sfun: + case t_vfun: + case t_cclosure: + case t_gfun: + fun = fun->cf.cf_name; + break; + default: + FEerror("~S is not a compiled-function.", 1, fun); + }RETURN1(fun); +} + +void +turbo_closure(object fun) +{ + object l,*block; + int n; + + if(1)/*(fun->cc.cc_turbo==NULL)*/ + {BEGIN_NO_INTERRUPT; + for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) + ; + { + block= AR_ALLOC(alloc_relblock,(1+n),object); + *block=make_fixnum(n); + fun->cc.cc_turbo = block+1; /* equivalent to &block[1] */ + for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) + fun->cc.cc_turbo[n] = l;} + END_NO_INTERRUPT; + } +} + +DEFUN_NEW("TURBO-CLOSURE",object,fSturbo_closure,SI + ,1,1,NONE,OO,OO,OO,OO,(object funobj),"") + +{ + /* 1 args */ + if (type_of(funobj) == t_cclosure) + turbo_closure(funobj); + RETURN1(funobj); +} + + + +void +gcl_init_cfun(void) +{ + +} + diff --git a/o/character.d b/o/character.d new file mode 100755 index 0000000..27156d4 --- /dev/null +++ b/o/character.d @@ -0,0 +1,669 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + character.d + + character routines +*/ + +#include "include.h" + +@(defun standard_char_p (c) + int i; +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + i = char_code(c); + if ((' ' <= i && i < '\177') || i == '\n') + @(return Ct) + @(return Cnil) +@) + +@(defun graphic_char_p (c) + int i; +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + i = char_code(c); + if (' ' <= i && i < '\177') + @(return Ct) + @(return Cnil) +@) + +@(defun alpha_char_p (c) + int i; +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + i = char_code(c); + if (isalpha(i)) + @(return Ct) + else + @(return Cnil) +@) + +@(defun upper_case_p (c) +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + if (isUpper(char_code(c))) + @(return Ct) + @(return Cnil) +@) + +@(defun lower_case_p (c) +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + if (isLower(char_code(c))) + @(return Ct) + @(return Cnil) +@) + +@(defun both_case_p (c) +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + if (isUpper(char_code(c)) || isLower(char_code(c))) + @(return Ct) + else + @(return Cnil) +@) + +/* + Digitp(i, r) returns the weight of code i + as a digit of radix r. + If r > 36 or i is not a digit, -1 is returned. +*/ +int +digitp(i, r) +int i, r; +{ + if ('0' <= i && i <= '9' && 1 < r && i < '0' + r) + return(i - '0'); + if ('A' <= i && 10 < r && r <= 36 && i < 'A' + (r - 10)) + return(i - 'A' + 10); + if ('a' <= i && 10 < r && r <= 36 && i < 'a' + (r - 10)) + return(i - 'a' + 10); + return(-1); +} + +@(defun digit_char_p (c &optional (r `make_fixnum(10)`)) + int d; +@ + check_type_character(&c); + check_type_non_negative_integer(&r); + if (type_of(r) == t_bignum) + @(return Cnil) + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + d = digitp(char_code(c), fix(r)); + if (d < 0) + @(return Cnil) + @(return `make_fixnum(d)`) +@) + +@(defun alphanumericp (c) + int i; +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + i = char_code(c); + if (isalphanum(i)) + @(return Ct) + else + @(return Cnil) +@) + +bool +char_eq(x, y) +object x, y; +{ + return(char_code(x) == char_code(y) + && char_bits(x) == char_bits(y) + && char_font(x) == char_font(y)); +} + +@(defun char_eq (c &rest) + int i; +@ + check_type_character(&c); + for (i = 0; i < narg; i++) + check_type_character(&vs_base[i]); + for (i = 1; i < narg; i++) + if (!char_eq(vs_base[i-1], vs_base[i])) + @(return Cnil) + @(return Ct) +@) + +@(defun char_neq (c &rest) + int i, j; +@ + check_type_character(&c); + for (i = 0; i < narg; i++) + check_type_character(&vs_base[i]); + if (narg == 0) + @(return Ct) + for (i = 1; i < narg; i++) + for (j = 0; j < i; j++) + if (char_eq(vs_base[j], vs_base[i])) + @(return Cnil) + @(return Ct) +@) + + +static int +char_cmp(x, y) +object x, y; +{ + if (char_font(x) < char_font(y)) + return(-1); + if (char_font(x) > char_font(y)) + return(1); + if (char_bits(x) < char_bits(y)) + return(-1); + if (char_bits(x) > char_bits(y)) + return(1); + if (char_code(x) < char_code(y)) + return(-1); + if (char_code(x) > char_code(y)) + return(1); + return(0); +} + +static void +Lchar_cmp(s, t) +int s, t; +{ + int narg, i; + + narg = vs_top - vs_base; + if (narg == 0) + too_few_arguments(); + for (i = 0; i < narg; i++) + check_type_character(&vs_base[i]); + for (i = 1; i < narg; i++) + if (s*char_cmp(vs_base[i], vs_base[i-1]) < t) { + vs_top = vs_base+1; + vs_base[0] = Cnil; + return; + } + vs_top = vs_base+1; + vs_base[0] = Ct; +} + +LFD(Lchar_l)() { Lchar_cmp( 1, 1); } +LFD(Lchar_g)() { Lchar_cmp(-1, 1); } +LFD(Lchar_le)() { Lchar_cmp( 1, 0); } +LFD(Lchar_ge)() { Lchar_cmp(-1, 0); } + + +bool +char_equal(x, y) +object x, y; +{ + int i, j; + + i = char_code(x); + j = char_code(y); + if (isLower(i)) + i -= 'a' - 'A'; + if (isLower(j)) + j -= 'a' - 'A'; + return(i == j); +} + +@(defun char_equal (c &rest) + int i; +@ + check_type_character(&c); + for (i = 0; i < narg; i++) + check_type_character(&vs_base[i]); + for (i = 1; i < narg; i++) + if (!char_equal(vs_base[i-1], vs_base[i])) + @(return Cnil) + @(return Ct) +@) + +@(defun char_not_equal (c &rest) + int i, j; +@ + check_type_character(&c); + for (i = 0; i < narg; i++) + check_type_character(&vs_base[i]); + for (i = 1; i < narg; i++) + for (j = 0; j < i; j++) + if (char_equal(vs_base[j], vs_base[i])) + @(return Cnil) + @(return Ct) +@) + + +static int +char_compare(x, y) +object x, y; +{ + int i, j; + + i = char_code(x); + j = char_code(y); + if (isLower(i)) + i -= 'a' - 'A'; + if (isLower(j)) + j -= 'a' - 'A'; + if (i < j) + return(-1); + else if (i == j) + return(0); + else + return(1); +} + +static void +Lchar_compare(s, t) +int s, t; +{ + int narg, i; + + narg = vs_top - vs_base; + if (narg == 0) + too_few_arguments(); + for (i = 0; i < narg; i++) + check_type_character(&vs_base[i]); + for (i = 1; i < narg; i++) + if (s*char_compare(vs_base[i], vs_base[i-1]) < t) { + vs_top = vs_base+1; + vs_base[0] = Cnil; + return; + } + vs_top = vs_base+1; + vs_base[0] = Ct; +} + +LFD(Lchar_lessp)() { Lchar_compare( 1, 1); } +LFD(Lchar_greaterp)() { Lchar_compare(-1, 1); } +LFD(Lchar_not_greaterp)() { Lchar_compare( 1, 0); } +LFD(Lchar_not_lessp)() { Lchar_compare(-1, 0); } + + +object +coerce_to_character(x) +object x; +{ +BEGIN: + switch (type_of(x)) { + case t_fixnum: + if (0 <= fix(x) && fix(x) < CHCODELIM) + return(code_char(fix(x))); + break; + + case t_character: + return(x); + + case t_symbol: + case t_string: + if (x->st.st_fillp == 1) + return(code_char(x->ust.ust_self[0])); + break; + default: + break; + } + vs_push(x); + x = wrong_type_argument(sLcharacter, x); + vs_popp; + goto BEGIN; +} + +@(defun character (x) +@ + @(return `coerce_to_character(x)`) +@) + +@(defun char_code (c) +@ + check_type_character(&c); + @(return `make_fixnum(char_code(c))`) +@) + +@(defun code_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) + object x; +@ + check_type_non_negative_integer(&c); + check_type_non_negative_integer(&b); + check_type_non_negative_integer(&f); + if (type_of(c) == t_bignum) + @(return Cnil) + if (type_of(b) == t_bignum) + @(return Cnil) + if (type_of(f) == t_bignum) + @(return Cnil) + if (fix(c)>=CHCODELIM || fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM) + @(return Cnil) + if (fix(b) == 0 && fix(f) == 0) + @(return `code_char(fix(c))`) + x = alloc_object(t_character); + char_code(x) = fix(c); + char_bits(x) = fix(b); + char_font(x) = fix(f); + @(return x) +@) + +@(defun char_upcase (c) +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return c) + if (isLower(char_code(c))) + @(return `code_char(char_code(c) - ('a' - 'A'))`) + else + @(return c) +@) + +@(defun char_downcase (c) +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + if (isUpper(char_code(c))) + @(return `code_char(char_code(c) + ('a' - 'A'))`) + else + @(return c) +@) + +int +digit_weight(w, r) +int w, r; +{ + if (r < 2 || r > 36 || w < 0 || w >= r) + return(-1); + if (w < 10) + return(w + '0'); + else + return(w - 10 + 'A'); +} + +@(defun digit_char (w + &optional + (r `make_fixnum(10)`) + (f `make_fixnum(0)`)) + object x; + int dw; +@ + check_type_non_negative_integer(&w); + check_type_non_negative_integer(&r); + check_type_non_negative_integer(&f); + if (type_of(w) == t_bignum) + @(return Cnil) + if (type_of(r) == t_bignum) + @(return Cnil) + if (type_of(f) == t_bignum) + @(return Cnil) + dw = digit_weight(fix(w), fix(r)); + if (dw < 0) + @(return Cnil) + if (fix(f) >= CHFONTLIM) + @(return Cnil) + if (fix(f) == 0) + @(return `code_char(dw)`) + x = alloc_object(t_character); + char_code(x) = dw; + char_bits(x) = 0; + char_font(x) = fix(f); + @(return x) +@) + +@(defun char_int (c) + int i; +@ + check_type_character(&c); + i = (char_font(c)*CHBITSLIM + char_bits(c))*CHCODELIM + + char_code(c); + @(return `make_fixnum(i)`) +@) + +@(defun char_name (c) +@ + check_type_character(&c); + if (char_bits(c) != 0 || char_font(c) != 0) + @(return Cnil) + switch (char_code(c)) { + case '\r': + @(return STreturn) + + case ' ': + @(return STspace) + + case '\177': + @(return STrubout) + + case '\f': + @(return STpage) + + case '\t': + @(return STtab) + + case '\b': + @(return STbackspace) + + case '\n': + @(return STnewline) + } + @(return Cnil) +@) + +@(defun name_char (s) +@ + s = coerce_to_string(s); + if (string_equal(s, STreturn)) + @(return `code_char('\r')`) + if (string_equal(s, STspace)) + @(return `code_char(' ')`) + if (string_equal(s, STrubout)) + @(return `code_char('\177')`) + if (string_equal(s, STpage)) + @(return `code_char('\f')`) + if (string_equal(s, STtab)) + @(return `code_char('\t')`) + if (string_equal(s, STbackspace)) + @(return `code_char('\b')`) + if (string_equal(s, STlinefeed) || string_equal(s, STnewline)) + @(return `code_char('\n')`) + @(return Cnil) +@) + +void +gcl_init_character() +{ + int i; + + for (i = 0; i < CHCODELIM; i++) { + object x=(object)(character_table+i); + x->fw=0; + set_type_of(x,t_character); + /* character_table[i].ch.t = (short)t_character; */ + character_table[i].ch.ch_code = i; + character_table[i].ch.ch_font = 0; + character_table[i].ch.ch_bits = 0; + } +#ifdef AV + for (i = -128; i < 0; i++) { + character_table[i].ch.t = (short)t_character; + character_table[i].ch.ch_code = i+CHCODELIM; + character_table[i].ch.ch_font = 0; + character_table[i].ch.ch_bits = 0; + } +#endif + + make_constant("CHAR-CODE-LIMIT", make_fixnum(CHCODELIM)); + make_si_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM)); + make_si_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM)); + + STreturn = make_simple_string("Return"); + enter_mark_origin(&STreturn); + STspace = make_simple_string("Space"); + enter_mark_origin(&STspace); + STrubout = make_simple_string("Rubout"); + enter_mark_origin(&STrubout); + STpage = make_simple_string("Page"); + enter_mark_origin(&STpage); + STtab = make_simple_string("Tab"); + enter_mark_origin(&STtab); + STbackspace = make_simple_string("Backspace"); + enter_mark_origin(&STbackspace); + STlinefeed = make_simple_string("Linefeed"); + enter_mark_origin(&STlinefeed); + + STnewline = make_simple_string("Newline"); + enter_mark_origin(&STnewline); + + make_si_constant("CHAR-CONTROL-BIT", make_fixnum(0)); + make_si_constant("CHAR-META-BIT", make_fixnum(0)); + make_si_constant("CHAR-SUPER-BIT", make_fixnum(0)); + make_si_constant("CHAR-HYPER-BIT", make_fixnum(0)); + +} + +@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) + object x; + int code; +@ + check_type_character(&c); + code = char_code(c); + check_type_non_negative_integer(&b); + check_type_non_negative_integer(&f); + if (type_of(b) == t_bignum) + @(return Cnil) + if (type_of(f) == t_bignum) + @(return Cnil) + if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM) + @(return Cnil) + if (fix(b) == 0 && fix(f) == 0) + @(return `code_char(code)`) + x = alloc_object(t_character); + char_code(x) = code; + char_bits(x) = fix(b); + char_font(x) = fix(f); + @(return x) +@) + +@(defun char_bits (c) +@ + check_type_character(&c); + @(return `small_fixnum(char_bits(c))`) +@) + +@(defun char_font (c) +@ + check_type_character(&c); + @(return `small_fixnum(char_font(c))`) +@) + +@(defun char_bit (c n) +@ + check_type_character(&c); + FEerror("Cannot get char-bit of ~S.", 1, c); +@) + +@(defun set_char_bit (c n v) +@ + check_type_character(&c); + FEerror("Cannot set char-bit of ~S.", 1, c); +@) + +@(defun string_char_p (c) +@ + check_type_character(&c); + if (char_font(c) != 0 || char_bits(c) != 0) + @(return Cnil) + @(return Ct) +@) + +@(defun int_char (x) + int i, c, b, f; +@ + check_type_non_negative_integer(&x); + if (type_of(x) == t_bignum) + @(return Cnil) + i = fix(x); + c = i % CHCODELIM; + i /= CHCODELIM; + b = i % CHBITSLIM; + i /= CHBITSLIM; + f = i % CHFONTLIM; + i /= CHFONTLIM; + if (i > 0) + @(return Cnil) + if (b == 0 && f == 0) + @(return `code_char(c)`) + x = alloc_object(t_character); + char_code(x) = c; + char_bits(x) = b; + char_font(x) = f; + @(return x) +@) + +void +gcl_init_character_function() +{ + make_function("STANDARD-CHAR-P", Lstandard_char_p); + make_function("GRAPHIC-CHAR-P", Lgraphic_char_p); + make_function("ALPHA-CHAR-P", Lalpha_char_p); + make_function("UPPER-CASE-P", Lupper_case_p); + make_function("LOWER-CASE-P", Llower_case_p); + make_function("BOTH-CASE-P", Lboth_case_p); + make_function("DIGIT-CHAR-P", Ldigit_char_p); + make_function("ALPHANUMERICP", Lalphanumericp); + make_function("CHAR=", Lchar_eq); + make_function("CHAR/=", Lchar_neq); + make_function("CHAR<", Lchar_l); + make_function("CHAR>", Lchar_g); + make_function("CHAR<=", Lchar_le); + make_function("CHAR>=", Lchar_ge); + make_function("CHAR-EQUAL", Lchar_equal); + make_function("CHAR-NOT-EQUAL", Lchar_not_equal); + make_function("CHAR-LESSP", Lchar_lessp); + make_function("CHAR-GREATERP", Lchar_greaterp); + make_function("CHAR-NOT-GREATERP", Lchar_not_greaterp); + make_function("CHAR-NOT-LESSP", Lchar_not_lessp); + make_function("CHARACTER", Lcharacter); + make_function("CHAR-CODE", Lchar_code); + make_function("CODE-CHAR", Lcode_char); + make_function("CHAR-UPCASE", Lchar_upcase); + make_function("CHAR-DOWNCASE", Lchar_downcase); + make_function("DIGIT-CHAR", Ldigit_char); + make_function("CHAR-INT", Lchar_int); + make_function("CHAR-NAME", Lchar_name); + make_function("NAME-CHAR", Lname_char); + make_si_function("INT-CHAR", Lint_char); + make_si_function("MAKE-CHAR", Lmake_char); + make_si_function("CHAR-BITS", Lchar_bits); + make_si_function("CHAR-FONT", Lchar_font); + make_si_function("CHAR-BIT", Lchar_bit); + make_si_function("SET-CHAR-BIT", Lset_char_bit); + make_si_function("STRING-CHAR-P", Lstring_char_p); +} diff --git a/o/clxsocket.c b/o/clxsocket.c new file mode 100755 index 0000000..a54c72a --- /dev/null +++ b/o/clxsocket.c @@ -0,0 +1,166 @@ +/* Copyright Massachusetts Institute of Technology 1988 */ +/* + * THIS IS AN OS DEPENDENT FILE! It should work on 4.2BSD derived + * systems. VMS and System V should plan to have their own version. + * + * This code was cribbed from lib/X/XConnDis.c. + * Compile using + * % cc -c socket.c -DUNIXCONN + */ + +#include "include.h" + +#ifdef HAVE_X11 + + +#undef PAGESIZE +#undef MAXPATHLEN +#ifndef NO_UNIXCONN +#define UNIXCONN +#endif + +#include +#include +#include +#include +#include + +#include +#include +#include +#include + +#ifndef hpux +#include +#endif + +extern int errno; /* Certain (broken) OS's don't have this */ + /* decl in errno.h */ + +#ifdef UNIXCONN +#include +#ifndef X_UNIX_PATH +#ifdef hpux +#define X_UNIX_PATH "/usr/spool/sockets/X11/" +#define OLD_UNIX_PATH "/tmp/.X11-unix/X" +#else /* hpux */ +#define X_UNIX_PATH "/tmp/.X11-unix/X" +#endif /* hpux */ +#endif /* X_UNIX_PATH */ +#endif /* UNIXCONN */ + + + +/* + * Attempts to connect to server, given host and display. Returns file + * descriptor (network socket) or 0 if connection fails. + */ + +int connect_to_server (host, display) + char *host; + int display; +{ + struct sockaddr_in inaddr; /* INET socket address. */ + struct sockaddr *addr; /* address to connect to */ + struct hostent *host_ptr; + int addrlen; /* length of address */ +#ifdef UNIXCONN + struct sockaddr_un unaddr; /* UNIX socket address. */ +#endif + extern char *getenv(); + extern struct hostent *gethostbyname(); + int fd; /* Network socket */ + { +#ifdef UNIXCONN + if ((host[0] == '\0') || (strcmp("unix", host) == 0)) { + /* Connect locally using Unix domain. */ + unaddr.sun_family = AF_UNIX; + (void) strcpy(unaddr.sun_path, X_UNIX_PATH); + (void) sprintf(&unaddr.sun_path[strlen(unaddr.sun_path)], "%d", display); + addr = (struct sockaddr *) &unaddr; + addrlen = strlen(unaddr.sun_path) + 2; + /* + * Open the network connection. + */ + if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) { +#ifdef hpux /* this is disgusting */ /* cribbed from X11R4 xlib source */ + if (errno == ENOENT) { /* No such file or directory */ + (void) sprintf(unaddr.sun_path, "%s%d", OLD_UNIX_PATH, display); + addrlen = strlen(unaddr.sun_path) + 2; + if ((fd = socket ((int) addr->sa_family, SOCK_STREAM, 0)) < 0) + return(-1); /* errno set by most recent system call. */ + } else +#endif /* hpux */ + return(-1); /* errno set by system call. */ + } + } else +#endif /* UNIXCONN */ + { + /* Get the statistics on the specified host. */ + if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) + { + if ((host_ptr = gethostbyname(host)) == NULL) + { + /* No such host! */ + errno = EINVAL; + return(-1); + } + /* Check the address type for an internet host. */ + if (host_ptr->h_addrtype != AF_INET) + { + /* Not an Internet host! */ + errno = EPROTOTYPE; + return(-1); + } + /* Set up the socket data. */ + inaddr.sin_family = host_ptr->h_addrtype; +#ifdef hpux + (void) memcpy((char *)&inaddr.sin_addr, + (char *)host_ptr->h_addr, + sizeof(inaddr.sin_addr)); +#else /* hpux */ + (void) bcopy((char *)host_ptr->h_addr, + (char *)&inaddr.sin_addr, + sizeof(inaddr.sin_addr)); +#endif /* hpux */ + } + else + { + inaddr.sin_family = AF_INET; + } + addr = (struct sockaddr *) &inaddr; + addrlen = sizeof (struct sockaddr_in); + inaddr.sin_port = display + X_TCP_PORT; + inaddr.sin_port = htons(inaddr.sin_port); + /* + * Open the network connection. + */ + if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0){ + return(-1); /* errno set by system call. */} + /* make sure to turn off TCP coalescence */ +#ifdef TCP_NODELAY + { + int mi = 1; + setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int)); + } +#endif + } + + /* + * Changed 9/89 to retry connection if system call was interrupted. This + * is necessary for multiprocessing implementations that use timers, + * since the timer results in a SIGALRM. -- jdi + */ + while (connect(fd, addr, addrlen) == -1) { + if (errno != EINTR) { + (void) close (fd); + return(-1); /* errno set by system call. */ + } + } + } + /* + * Return the id if the connection succeeded. + */ + return(fd); +} +#endif diff --git a/o/cmac.c b/o/cmac.c new file mode 100755 index 0000000..b597b6c --- /dev/null +++ b/o/cmac.c @@ -0,0 +1,249 @@ +#define NEED_MP_H +#ifndef FIRSTWORD +#include "include.h" +#endif +#include "num_include.h" + +/* #include "arith.h" */ + + + +/* I believe the instructions used here are ok for 68010.. */ + +#ifdef MC68K +#define MC68020 +#endif + +/* static for gnuwin95 the save routine is not saving statics... */ + +object *gclModulus; +#define FIXNUMP(x) (type_of(x)==t_fixnum) + +/* Note: the gclModulus is guaranteed > 0 */ + +#define FIX_MOD(X,MOD) { \ + register fixnum MOD_2; \ + if (X > (MOD_2=(MOD>>1))) \ + X=X-MOD; \ + else \ + if (X < -MOD_2) \ + X=X+MOD; \ + else \ + if (X == -MOD_2 && (MOD&0x1)==0) \ + X=X+MOD; \ + } + + +object ctimes(object a, object b),cplus(object a, object b),cdifference(object a, object b),cmod(object x); + +object make_integer(__mpz_struct *u); + +#define our_minus(a,b) ((FIXNUMP(a)&&FIXNUMP(b))?fixnum_sub(fix(a),fix(b)): \ + number_minus(a,b)) +#define our_plus(a,b) ((FIXNUMP(a)&&FIXNUMP(b))?fixnum_add(fix(a),fix(b)): \ + number_plus(a,b)) +#define our_times(a,b) number_times(a,b) + +/* fix (and check) this on 64 bit machines, where long is the long long */ +#ifdef HAVE_LONG_LONG +static int +dblrem(int a, int b, int mod) +{ + return (int)(((long long int)a*(long long int)b)%(long long int) mod); +} +#else + +static int +dblrem(a,b,mod) +int a,b,mod; +{int h,sign; + if (a<0) + {a= -a; sign= (b<0)? (b= -b,1) :-1;} + else { sign= (b<0) ? (b= -b,-1) : 1;} + { mp_limb_t ar[2],q[2],aa; + aa = a; + ar[1]=mpn_mul_1(ar,&aa,1,b); + h = mpn_divrem_1(q,0,ar,2,mod); + return ((sign<0) ? -h :h); + } +} +#endif + +/* #if sizeof(fixnum) != sizeof(mp_limb_t) */ +/* #error fixnum mp_limb_t size mismatch */ +/* #endif */ + +static fixnum +fdblrem(fixnum a,fixnum b,fixnum mod) { + + fixnum h,sign; + mp_limb_t ar[2],q[2],aa; + + if (a<0) { + a= -a; + sign= (b<0) ? (b= -b,1) : -1; + } else + sign= (b<0) ? (b= -b,-1) : 1; + + aa = a; + ar[1]=mpn_mul_1(ar,&aa,1,b); + h = mpn_divrem_1(q,0,ar,2,mod); + + return ((sign<0) ? -h :h); + +} + +object +cmod(object x) { + + register object mod = *gclModulus; + + if (mod==Cnil) + return(x); + + else if ((type_of(mod)==t_fixnum && type_of(x)==t_fixnum)) { + + register fixnum xx,mm=fix(mod); + + if (mm==2) + return small_fixnum((fix(x)&1)); + + xx=(fix(x)%mm); + FIX_MOD(xx,mm); + return make_fixnum(xx); + + } else { + + object rp,mod2; + int compare; + + integer_quotient_remainder_1(x,mod,NULL,&rp,0);/*FIXME*/ + mod2=integer_fix_shift(mod,-1); + compare = number_compare(rp,small_fixnum(0)); + if (compare >= 0) { + + compare=number_compare(rp,mod2); + if (compare > 0) rp=number_minus(rp,mod); + + } else if (number_compare(number_negate(mod2), rp) > 0) + rp = number_plus(rp,mod); + + return rp; + + } + +} + + +object +ctimes(object a, object b) { + + object mod = *gclModulus; + + if (FIXNUMP(mod)) { + + register fixnum res, m=fix(mod); + + if (sizeof(fixnum)==sizeof(int) || (m>>(sizeof(int)*8)==(m>>(sizeof(fixnum)*8-1)))) + + res=dblrem(fix(a),fix(b),m); + + else + + res=fdblrem(fix(a),fix(b),m); + + FIX_MOD(res,m); + return make_fixnum(res); + + } else if (mod==Cnil) + return(our_times(a,b)); + + return cmod(number_times(a,b)); + +} + + +#define SMALL_MODULUS_P(mod) (FIXNUMP(mod) && (fix(mod) < (MOST_POSITIVE_FIX)/2)) + +object +cdifference(object a, object b) { + + object mod = *gclModulus; + + if (SMALL_MODULUS_P(mod)) { + + register fixnum res,m; + + res=((fix(a)-fix(b))%(m=fix(mod))); + FIX_MOD(res,m); + return make_fixnum(res); + + } else if (mod==Cnil) + return (our_minus(a,b)); + + else return(cmod(number_minus(a,b))); + +} + +object +cplus(object a, object b) { + + object mod = *gclModulus; + + if (SMALL_MODULUS_P(mod)) { + + register fixnum res,m; + + res=((fix(a)+fix(b))%(m=fix(mod))); + FIX_MOD(res,m); + return make_fixnum(res); + + } else if (mod==Cnil) + return (our_plus(a,b)); + + return(cmod(number_plus(a,b))); + +} + + +DEFUN_NEW("CMOD",object,fScmod,SI,1,1,NONE,OO,OO,OO,OO,(object num),"") { + + /* 1 args */ + num=cmod(num); + RETURN1(num); + +} + + +DEFUN_NEW("CPLUS",object,fScplus,SI,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + + /* 2 args */ + + x0 = cplus(x0,x1); + RETURN1( x0 ); + +} + + +DEFUN_NEW("CTIMES",object,fSctimes,SI,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + + /* 2 args */ + x0=ctimes(x0,x1); + RETURN1(x0); +} + + +DEFUN_NEW("CDIFFERENCE",object,fScdifference,SI,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + + /* 2 args */ + x0=cdifference(x0,x1); + RETURN1(x0); + +} + +void +gcl_init_cmac(void) { + + gclModulus = (&((make_si_special("MODULUS",Cnil))->s.s_dbind)); + +} diff --git a/o/cmpaux.c b/o/cmpaux.c new file mode 100755 index 0000000..907cd68 --- /dev/null +++ b/o/cmpaux.c @@ -0,0 +1,579 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + cmpaux.c +*/ + +#include +#include + +#include +#include +#include +#define NEED_MP_H +#include "include.h" +#define dcheck_type(a,b) check_type(a,b) + +#include "page.h" + +#ifdef HAVE_AOUT +#undef ATT +#undef BSD +#ifndef HAVE_ELF +#ifndef HAVE_FILEHDR +#define BSD +#endif +#endif +#include HAVE_AOUT +#endif + +DEFUNO_NEW("SPECIALP",object,fSspecialp,SI + ,1,1,NONE,OO,OO,OO,OO,void,siLspecialp,(object sym),"") +{ + /* 1 args */ + if (type_of(sym) == t_symbol && + (enum stype)sym->s.s_stype == stp_special) + sym = Ct; + else + sym = Cnil; + RETURN1(sym); +} + +DEF_ORDINARY("DEBUGGER",sSdebugger,SI,""); + +DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI + ,2,3,NONE,OO,OO,OO,OO,(object sym,object val,...),"") +{ int n=VFUN_NARGS; + object doc; + va_list ap; + { va_start(ap,val); + if (n>=3) doc=va_arg(ap,object);else goto LDEFAULT3; + goto LEND_VARARG; + LDEFAULT3: doc = Cnil; + LEND_VARARG: va_end(ap);} + + CHECK_ARG_RANGE(2,3); + if(sym->s.s_dbind==0 && n > 1) + sym->s.s_dbind= val; + sym->s.s_stype=(short)stp_special; + if(n > 2) + putprop(sym,doc,sSvariable_documentation); + RETURN1(sym); + } + + +DEFUN_NEW("DEBUG",object,fLdebug,LISP + ,2,2,NONE,OO,OO,OO,OO,(object sym,object val),"") +{ /* 2 args */ + putprop(sym,val,sSdebugger); + RETURN1(sym); +} + + +DEFUN_NEW("SETVV",object,fSsetvv,SI + ,2,2,NONE,OO,OO,OO,OO,(object index,object val),"") +{ /* 2 args */ + if(type_of(sSPmemory->s.s_dbind)==t_cfdata) + sSPmemory->s.s_dbind->cfd.cfd_self[fix(index)]=val; + else FEerror("setvv called outside %init",0); + RETURN1(index); +} + +DEF_ORDINARY("%MEMORY",sSPmemory,SI,""); +DEF_ORDINARY("%INIT",sSPinit,SI,""); + +/* void Lidentity(void); */ +void +gcl_init_cmpaux(void) +{ + + + /* real one defined in predlib.lsp, need this for bootstrap */ +/* make_si_function("WARN-VERSION",Lidentity); */ + +} + + +/* Now inlined directly by optimizer */ +/* int */ +/* ifloor(int x, int y) */ +/* { */ +/* if (y == 0) { */ +/* FEerror("Zero divizor", 0); */ +/* return 0; */ +/* } */ +/* if (y > 0) { */ +/* if (x >= 0) */ +/* return(x/y); */ +/* else */ + /* FIXME, deal with possible overflow here*/ +/* return(-((-x-1))/y-1); */ +/* } */ +/* if (x >= 0) */ + /* FIXME, deal with possible overflow here*/ +/* return(-((x-1)/(-y))-1); */ +/* else */ +/* return((-x)/(-y)); */ +/* } */ + +/* int */ +/* imod(int x, int y) */ +/* { */ +/* return(x - ifloor(x, y)*y); */ +/* } */ + +/* static void */ +/* set_VV(object *, int, object); */ + +/* static void */ +/* set_VV_data(object *VV, int n, object data, char *start, int size) */ +/* {set_VV(VV,n,data); */ +/* data->cfd.cfd_start=start; */ +/* data->cfd.cfd_size = size; */ +/* } */ + +/* static void */ +/* set_VV(object *VV, int n, object data) */ +/* { */ +/* object *p, *q; */ + +/* p = VV; */ +/* q = data->v.v_self; */ +/* while (n-- > 0) */ +/* *p++ = *q++; */ +/* data->cfd.cfd_self = VV; */ +/* } */ + +/* + Conversions to C +*/ + +char +object_to_char(object x) +{ + int c=0; + switch (type_of(x)) { + case t_fixnum: + c = fix(x); break; + case t_bignum: + {object *to = vs_top; + vs_push(x); + vs_push(small_fixnum(0xff)); + Llogand(); + x = vs_base[0]; + vs_top = to; + c = (char) fix(x); + break; + } + case t_character: + c = char_code(x); break; + default: + FEerror("~S cannot be coerce to a C char.", 1, x); + } + return(c); +} + +int +object_to_int(object x) +{ + int i=0; + + switch (type_of(x)) { + case t_character: + i = char_code(x); break; + case t_fixnum: + i = fix(x); break; + case t_bignum: + i = number_to_double(x); + break; + case t_ratio: + i = number_to_double(x); break; + case t_shortfloat: + i = sf(x); break; + case t_longfloat: + i = lf(x); break; + default: + FEerror("~S cannot be coerce to a C int.", 1, x); + } + return(i); +} + +fixnum +object_to_fixnum(object x) +{ + fixnum i=0; + + switch (type_of(x)) { + case t_character: + i = char_code(x); break; + case t_fixnum: + i = fix(x); break; + case t_bignum: + i = number_to_double(x); + break; + case t_ratio: + i = number_to_double(x); break; + case t_shortfloat: + i = sf(x); break; + case t_longfloat: + i = lf(x); break; + default: + FEerror("~S cannot be coerce to a C int.", 1, x); + } + return(i); +} + +float +object_to_float(object x) +{ + float f=0.0; + + switch (type_of(x)) { + case t_character: + f = char_code(x); break; + case t_fixnum: + f = fix(x); break; + case t_bignum: + case t_ratio: + f = number_to_double(x); break; + case t_shortfloat: + f = sf(x); break; + case t_longfloat: + f = lf(x); break; + default: + FEerror("~S cannot be coerce to a C float.", 1, x); + } + return(f); +} + +double +object_to_double(object x) +{ + double d=0.0; + + switch (type_of(x)) { + case t_character: + d = char_code(x); break; + case t_fixnum: + d = fix(x); break; + case t_bignum: + case t_ratio: + d = number_to_double(x); break; + case t_shortfloat: + d = sf(x); break; + case t_longfloat: + d = lf(x); break; + default: + FEerror("~S cannot be coerce to a C double.", 1, x); + } + return(d); +} + +/* this may allocate storage. The user can prevent this + by providing a string will fillpointer < length and + have a null character in the fillpointer position. */ + +char * +object_to_string(object x) { + + unsigned int leng; + char *res; + + if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x); + leng= x->st.st_fillp; + /* user has thoughtfully provided a null terminated string ! */ + if (leng > 0 && leng < x->st.st_dim && x->st.st_self[leng]==0) + return x->st.st_self; + + if (x->st.st_dim == leng && leng % sizeof(object) && MAYBE_DATA_P(x->st.st_self)) { + x->st.st_self[leng] = 0; + return x->st.st_self; + } + + res=malloc(leng+1); + bcopy(x->st.st_self,res,leng); + res[leng]=0; + return res; + +} + +/* typedef int (*FUNC)(); */ + +/* perform the actual invocation of the init function durint a fasload + init_address is the offset from the place in memory where the code is loaded + in. In most systems this will be 0. + The new style fasl vector MUST end with an entry (si::%init f1 f2 .....) + where f1 f2 are forms to be evaled. +*/ + +/* #ifdef CLEAR_CACHE */ +/* static int */ +/* sigh(int sig,long code,void *scp, char *addr) { */ + +/* fprintf(stderr,"Received SIGILL at %p\n",((siginfo_t *)code)->si_addr); */ +/* exit(1); */ +/* } */ +/* #endif */ + + +void +call_init(int init_address,object memory,object faslfile) { + + bds_bind(sSPmemory,memory); + bds_bind(sSPinit,faslfile); + ((FUNC)(memory->cfd.cfd_start+init_address))(); + bds_unwind1; + bds_unwind1; + +} + + +/* statVV is the address of some static storage, which is used by the + cfunctions to refer to global variables,.. + Initially it holds a number of addresses. We also have sSPmemory->s.s_dbind + which points to a vector of lisp constants. We switch the + fn addresses and lisp constants. We follow this convoluted path, + since we don't wish to have a separate block of data space allocated + in the object module simply to temporarily have access to the + actual function addresses during load. + + */ + +object *min_cfd_self=NULL; + +void +do_init(object *statVV) { + + object faslfile=sSPinit->s.s_dbind; + object data=sSPmemory->s.s_dbind; + object *p,*q,y; + int i,n; + object fasl_vec; + char ch; + + ch=readc_stream(faslfile); + unreadc_stream(ch,faslfile); + + if (ch!='\n') { + struct fasd * fd; + faslfile=fSopen_fasd(faslfile,sKinput,OBJNULL,Cnil); + fd=(struct fasd *)faslfile->v.v_self; + n=fix(fd->table_length); + fd->table->v.v_self=alloca(n*sizeof(object)); + memset(fd->table->v.v_self,0,n*sizeof(object)); + fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n; + } + + n=fix(READ_STREAM_OR_FASD(faslfile)); + sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil); + + /* switch SPinit to point to a vector of function addresses */ + + fasl_vec->v.v_elttype = aet_fix; + + /* swap the entries */ + for (i=0,p=fasl_vec->v.v_self,q=statVV;icfd.cfd_self = statVV; + if (!min_cfd_self || data->cfd.cfd_selfcfd.cfd_self; + data->cfd.cfd_fillp= n; + statVV[n-1] = data; + + /* So now the fasl_vec is a fixnum array, containing random addresses of c + functions and other stuff from the compiled code. + data is what it wants to be for the init + */ + /* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */ + + fSload_stream(faslfile,Cnil); + if (type_of(faslfile)!=t_stream) + fSclose_fasd(faslfile); + +} + +DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, + NONE,OO,OO,OO,OO,(void),"") { + + sSPmemory->s.s_dbind->cfd.cfd_prof=1; + + return Cnil; + +} + +#ifdef DOS +#define PATH_LIM 8 +#define TYPE_LIM 3 +char * +fix_path_string_dos(s) +char *s; +{char buf[200]; + char *p=s,*q=buf; + int i=PATH_LIM; + while(*p) + { + if (IS_DIR_SEPARATOR(*p)) i=PATH_LIM; + else if (*p == '.') i = TYPE_LIM; + else i--; + if (i>=0) *q++ = *p; + p++;} + *q = 0; + strcpy(s,buf); + return s; +} + +#endif + +object +new_cfdata(void) { + + object memory=alloc_object(t_cfdata); + + memory->cfd.cfd_size=0; + memory->cfd.cfd_fillp=0; + memory->cfd.cfd_prof=0; + memory->cfd.cfd_self=0; + memory->cfd.cfd_start=0; + + return memory; + +} + + +void +gcl_init_or_load1(void (*fn)(void),const char *file) { + + if (file[strlen(file)-1]=='o') { + + object memory; + object faslfile; + file=FIX_PATH_STRING(file); + + memory=new_cfdata(); + memory->cfd.cfd_start= (char *)fn; + printf("Initializing %s\n",file); fflush(stdout); + faslfile=open_stream(make_simple_string(file),smm_input,Cnil,sKerror); + SEEK_TO_END_OFILE(faslfile->sm.sm_fp); + call_init(0,memory,faslfile); + close_stream(faslfile); + + } else { + printf("loading %s\n",file); + fflush(stdout); + load(file); + } + +} + +DEFUN_NEW("INIT-CMP-ANON", object, fSinit_cmp_anon, SI, 0, 0, + NONE, OO, OO, OO,OO,(void), + "Initialize previously compiled and linked anonymous function from the \ +.text section of the running executable. This function is inherently \ +dangerous, and is meant as a work-around to facilitate the production \ +of an ansi GCL image on systems which must currently link using \ +dlopen. On such systems, it is imposible to compile and load \ +anonymous functions as part of the initialization sequence of the lisp \ +image, as is done in pcl, and preserve that function across a \ +save-system call. The approach here is to provide a flag to GCL's \ +compile function which will direct the algorithm to forgo \ +recompilation and loading in favor of initialization via this \ +function.") +{ + + int i; + + i=gcl_init_cmp_anon(); + if (i<0) + FEerror("No such anonymous function",0); + + return i ? Cnil : Ct; + +} + +object +find_init_name1(char *s,unsigned len) { + +#ifdef _WIN32 + + char *tmp; + + if (len) { + tmp=alloca(len+1); + memcpy(tmp,s,len); + tmp[len]=0; + } else + tmp=s; + + return find_init_string(tmp); + +#else +/* These functions have no relevance on Windows + * as dlopen and friends don't exist in that part of Cyberspace. */ + + struct stat ss; + char *tmp,*q; + FILE *f; + + if (len) { + tmp=alloca(len+1); + memcpy(tmp,s,len); + tmp[len]=0; + } else + tmp=s; + if (stat(tmp,&ss)) + FEerror("File ~a does not exist",1,make_simple_string(tmp)); + if (!(f=fopen(tmp,"rb"))) + FEerror("Cannot open ~a for binary reading",1,make_simple_string(tmp)); + tmp=alloca(ss.st_size+1); + if (fread(tmp,1,ss.st_size,f)!=ss.st_size) + FEerror("Error reading binary file",0); + fclose(f); + for (s=tmp+1;stmp && (s[-1]=='_' ? (s>tmp+1 && s[-2]) : s[-1]))); + q=strstr(s+1,"init_"),s=q ? q : s+strlen(s)+1); + if (strncmp(s,"init_",5)) + FEerror("Init name not found",0); + return make_simple_string(s); +#endif /* _WIN32 */ + +} + + +DEFUN_NEW("FIND-INIT-NAME", object, fSfind_init_name, SI, 1, 1, + NONE, OO, OO, OO,OO,(object namestring),"") +{ + + check_type_string(&namestring); + return find_init_name1(namestring->st.st_self,namestring->st.st_dim); + +} + +DEFUN_NEW("SEEK-TO-END-OFILE",object,fSseek_to_end_ofile,SI,1,1,NONE,OO,OO,OO,OO,(object sm),"") { + check_type_stream(&sm); + SEEK_TO_END_OFILE(sm->sm.sm_fp); + RETURN1(sm); +} diff --git a/o/conditional.c b/o/conditional.c new file mode 100755 index 0000000..bee5a05 --- /dev/null +++ b/o/conditional.c @@ -0,0 +1,205 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + conditional.c + + conditionals +*/ + +#include "include.h" + +object sLotherwise; + +static void +FFN(Fif)(object form) +{ + + object *top = vs_top; + + if (endp(form) || endp(MMcdr(form))) + FEtoo_few_argumentsF(form); + if (!endp(MMcddr(form)) && !endp(MMcdddr(form))) + FEtoo_many_argumentsF(form); + eval(MMcar(form)); + if (vs_base[0] == Cnil) + if (endp(MMcddr(form))) { + vs_top = vs_base = top; + vs_push(Cnil); + } else { + vs_top = top; + eval(MMcaddr(form)); + } + else { + vs_top = top; + eval(MMcadr(form)); + } +} + +static void +FFN(Fcond)(object args) +{ + + object *top = vs_top; + object clause; + object conseq; + + while (!endp(args)) { + clause = MMcar(args); + if (type_of(clause) != t_cons) + FEerror("~S is an illegal COND clause.",1,clause); + eval(MMcar(clause)); + if (vs_base[0] != Cnil) { + conseq = MMcdr(clause); + if (endp(conseq)) { + vs_top = vs_base+1; + return; + } + while (!endp(conseq)) { + vs_top = top; + eval(MMcar(conseq)); + conseq = MMcdr(conseq); + } + return; + } + vs_top = top; + args = MMcdr(args); + } + vs_base = vs_top = top; + vs_push(Cnil); +} + +static void +FFN(Fcase)(object arg) +{ + + object *top = vs_top; + object clause; + object key; + object conseq; + + if (endp(arg)) + FEtoo_few_argumentsF(arg); + eval(MMcar(arg)); + vs_top = top; + vs_push(vs_base[0]); + arg = MMcdr(arg); + while (!endp(arg)) { + clause = MMcar(arg); + if (type_of(clause) != t_cons) + FEerror("~S is an illegal CASE clause.",1,clause); + key = MMcar(clause); + conseq = MMcdr(clause); + if (type_of(key) == t_cons) + do { + if (eql(MMcar(key),top[0])) + goto FOUND; + key = MMcdr(key); + } while (!endp(key)); + else if (key == Cnil) + ; + else if (key == Ct || key == sLotherwise || eql(key,top[0])) + goto FOUND; + arg = MMcdr(arg); + } + vs_base = vs_top = top; + vs_push(Cnil); + return; + +FOUND: + if (endp(conseq)) { + vs_base = vs_top = top; + vs_push(Cnil); + } else + do { + vs_top = top; + eval(MMcar(conseq)); + conseq = MMcdr(conseq); + } while (!endp(conseq)); + return; +} + +static void +FFN(Fwhen)(object form) +{ + + object *top = vs_top; + + if (endp(form)) + FEtoo_few_argumentsF(form); + eval(MMcar(form)); + if (vs_base[0] == Cnil) { + vs_base = vs_top = top; + vs_push(Cnil); + } else { + form = MMcdr(form); + if (endp(form)) { + vs_base = vs_top = top; + vs_push(Cnil); + } else + do { + vs_top = top; + eval(MMcar(form)); + form = MMcdr(form); + } while (!endp(form)); + } +} + +static void +FFN(Funless)(object form) +{ + + object *top = vs_top; + + if (endp(form)) + FEtoo_few_argumentsF(form); + eval(MMcar(form)); + if (vs_base[0] == Cnil) { + vs_top = top; + form = MMcdr(form); + if (endp(form)) { + vs_base = vs_top = top; + vs_push(Cnil); + } else + do { + vs_top = top; + eval(MMcar(form)); + form = MMcdr(form); + } while (!endp(form)); + } else { + vs_base = vs_top = top; + vs_push(Cnil); + } +} + +void +gcl_init_conditional(void) +{ + make_special_form("IF",Fif); + make_special_form("COND",Fcond); + make_special_form("CASE",Fcase); + make_special_form("WHEN",Fwhen); + make_special_form("UNLESS",Funless); + + sLotherwise = make_ordinary("OTHERWISE"); + enter_mark_origin(&sLotherwise); +} diff --git a/o/earith.c b/o/earith.c new file mode 100755 index 0000000..62ebf7f --- /dev/null +++ b/o/earith.c @@ -0,0 +1,6 @@ +#define NEED_MP_H +#include "include.h" + +#ifdef CMAC +#include "cmac.c" +#endif diff --git a/o/egrep-def b/o/egrep-def new file mode 100755 index 0000000..fe863c0 --- /dev/null +++ b/o/egrep-def @@ -0,0 +1,5 @@ +#!/bin/sh +egrep '^(DEFUN\()|^(DEFUNO\()|^(DEFCOMP\()|^(DEFVAR\()|^(DO_INIT\()|^(DEF_ORDINARY\()' $1 +exit 0 + + diff --git a/o/error.c b/o/error.c new file mode 100755 index 0000000..98834fa --- /dev/null +++ b/o/error.c @@ -0,0 +1,598 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + error.c + + Errors +*/ + +#include +#include +#include "include.h" +object siSuniversal_error_handler; + +object sSterminal_interrupt; + +void +assert_error(const char *a,unsigned l,const char *f,const char *n) { + + if (!raw_image && core_end && core_end==sbrk(0)) + FEerror("The assertion ~a on line ~a of ~a in function ~a failed: ~a",5, + make_simple_string(a),make_fixnum(l), + make_simple_string(f),make_simple_string(n),make_simple_string(strerror(errno))); + else { + emsg("The assertion %s on line %d of %s in function %s failed: %s",a,l,f,n,strerror(errno)); + do_gcl_abort(); + } + +} + + +void +terminal_interrupt(int correctable) +{ + signals_allowed = sig_normal; + ifuncall1(sSterminal_interrupt, correctable?Ct:Cnil); +} + +static object +ihs_function_name(object x) +{ + object y; + + switch (type_of(x)) { + case t_symbol: + return(x); + + case t_cons: + y = x->c.c_car; + if (y == sLlambda) + return(sLlambda); + if (y == sSlambda_closure) + return(sSlambda_closure); + if (y == sSlambda_block || y == sSlambda_block_expanded) { + x = x->c.c_cdr; + if (type_of(x) != t_cons) + return(sSlambda_block); + return(x->c.c_car); + } + if (y == sSlambda_block_closure) { + x = x->c.c_cdr; + if (type_of(x) != t_cons) + return(sSlambda_block_closure); + x = x->c.c_cdr; + if (type_of(x) != t_cons) + return(sSlambda_block_closure); + x = x->c.c_cdr; + if (type_of(x) != t_cons) + return(sSlambda_block_closure); + x = x->c.c_cdr; + if (type_of(x) != t_cons) + return(sSlambda_block_closure); + return(x->c.c_car); + } + /* a general special form */ + if (y->s.s_sfdef != NOT_SPECIAL) + return y; + return(Cnil); + + case t_afun: + case t_closure: + case t_cfun: + case t_sfun: + case t_vfun: + case t_cclosure: + case t_gfun: + + return(x->cf.cf_name); + + default: + return(Cnil); + } +} + +object +ihs_top_function_name(ihs_ptr h) +{ + object x; + + + while (h >= ihs_org) { + x = ihs_function_name(h->ihs_function); + if (x != Cnil) + return(x); + h--; + } + return(Cnil); +} + +static object +Icall_gen_error_handler_ap(object ci,object cs,object en,object es,ufixnum n,va_list ap) { + + object *b; + ufixnum i; + + n+=5; + b=alloca(n*sizeof(*b)); + b[0]= en; + b[1]= ci; + b[2] = ihs_top_function_name(ihs_top); + b[3] = cs; + b[4] = es; + + for (i=5;iihs_top ? ihs_top : p; + return p; + ILLEGAL: + FEerror("~S is an illegal ihs index.", 1, x); + return(NULL); + +} + +DEFUN_NEW("IHS-TOP",object,fSihs_top,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + /* 0 args */ + RETURN1(make_fixnum(ihs_top - ihs_org)); +} + +DEFUN_NEW("IHS-FUN",object,fSihs_fun,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 = get_ihs_ptr(x0)->ihs_function; + RETURN1(x0); +} + +DEFUN_NEW("IHS-VS",object,fSihs_vs,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 = make_fixnum(get_ihs_ptr(x0)->ihs_base - vs_org); + RETURN1(x0); +} + +static frame_ptr get_frame_ptr(object x) { + + frame_ptr p; + + if (type_of(x) != t_fixnum) + goto ILLEGAL; + p = frs_org + fix(x); + if (fix(x)==0) return p; + p=pfrs_top ? frs_top : p; + return p; + ILLEGAL: + FEerror("~S is an illegal frs index.", 1, x); + return NULL; + +} + +DEFUN_NEW("FRS-TOP",object,fSfrs_top,SI + ,0,0,NONE,OO,OO,OO,OO,(void),"") + +{ + /* 0 args */ + RETURN1((make_fixnum(frs_top - frs_org))); +} + +DEFUN_NEW("FRS-VS",object,fSfrs_vs,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 = make_fixnum(get_frame_ptr(x0)->frs_lex - vs_org); + RETURN1(x0); +} + +DEFUN_NEW("FRS-BDS",object,fSfrs_bds,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 + = make_fixnum(get_frame_ptr(x0)->frs_bds_top - bds_org); + RETURN1(x0); +} + +DEFUN_NEW("FRS-CLASS",object,fSfrs_class,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + enum fr_class c; + + /* 1 args */ + + c = get_frame_ptr(x0)->frs_class; + if (c == FRS_CATCH) x0 = sKcatch; + else if (c == FRS_PROTECT) x0 = sKprotect; + else if (c == FRS_CATCHALL) x0 = sKcatchall; + else FEerror("Unknown frs class was detected.", 0); + RETURN1(x0); +} + +DEFUN_NEW("FRS-TAG",object,fSfrs_tag,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 = get_frame_ptr(x0)->frs_val; + RETURN1(x0); +} + +DEFUN_NEW("FRS-IHS",object,fSfrs_ihs,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 + = make_fixnum(get_frame_ptr(x0)->frs_ihs - ihs_org); + RETURN1(x0); +} + +static bds_ptr get_bds_ptr(object x) { + + bds_ptr p; + + if (type_of(x) != t_fixnum) + goto ILLEGAL; + p = bds_org + fix(x); + if (0 == fix(x)) return p; + p=pbds_top ? bds_top : p; + return p; + ILLEGAL: + FEerror("~S is an illegal bds index.", 1, x); + return NULL; + +} + +DEFUN_NEW("BDS-TOP",object,fSbds_top,SI + ,0,0,NONE,OO,OO,OO,OO,(void),"") + +{ + /* 0 args */ + RETURN1((make_fixnum(bds_top - bds_org))); +} + +DEFUN_NEW("BDS-VAR",object,fSbds_var,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 = get_bds_ptr(x0)->bds_sym; + RETURN1(x0); +} + +DEFUN_NEW("BDS-VAL",object,fSbds_val,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 = get_bds_ptr(x0)->bds_val; + RETURN1(x0); +} + +static object *get_vs_ptr(object x) { + + object *p; + + if (type_of(x) != t_fixnum) + goto ILLEGAL; + p = vs_org + fix(x); + p=p=vs_top ? vs_top-1 : p; + return p; + ILLEGAL: + FEerror("~S is an illegal vs index.", 1, x); + return NULL; + +} + +DEFUN_NEW("VS-TOP",object,fSvs_top,SI + ,0,0,NONE,OO,OO,OO,OO,(void),"") +{ + object x; + /* 0 args */ + x = (make_fixnum(vs_top - vs_org)); + RETURN1(x); +} + +DEFUN_NEW("VS",object,fSvs,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + /* 1 args */ + x0 = *get_vs_ptr(x0); + RETURN1(x0); +} + +DEFUN_NEW("SCH-FRS-BASE",object,fSsch_frs_base,SI + ,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") +{ + frame_ptr x; + ihs_ptr y; + + /* 2 args */ + y = get_ihs_ptr(x1); + for (x = get_frame_ptr(x0); + x <= frs_top && x->frs_ihs < y; + x++); + if (x > frs_top) x0 = Cnil; + else x0 = make_fixnum(x - frs_org); + + RETURN1(x0); +} + +DEFUNM_NEW("INTERNAL-SUPER-GO",object,fSinternal_super_go,SI + ,3,3,NONE,OO,OO,OO,OO,(object tag,object x1,object x2),"") +{ + frame_ptr fr; + + /* 3 args */ + + fr = frs_sch(tag); + if (fr == NULL) + FEerror("The tag ~S is missing.", 1, tag); + if (x2 == Cnil) + tag = x1; + else + tag = MMcons(tag, x1); + unwind(fr,tag); + RETURN0 ; +} + +DEF_ORDINARY("UNIVERSAL-ERROR-HANDLER",sSuniversal_error_handler,SI + ,"Redefined in lisp, this is the function called by the \ +internal error handling mechanism. \ + Args: (error-name correctable function-name \ + continue-format-string error-format-string \ + &rest args)"); +DEFUN_NEW("UNIVERSAL-ERROR-HANDLER",object,fSuniversal_error_handler,SI + ,5,F_ARG_LIMIT,NONE,OO,OO,OO,OO,(object x0,object x1,object x2,object x3,object error_fmt_string),"") +{ + int i; + /* 5 args */ + for (i = 0; i < error_fmt_string->st.st_fillp; i++) + fputc(error_fmt_string->st.st_self[i],stderr); + printf("\nLisp initialization failed.\n"); + do_gcl_abort(); + RETURN1(x0); +} + +void +check_arg_failed(int n) +{ + if (n 0; n--, x = x->c.c_cdr) + if(endp(x)) + FEerror("APPLY sent too few arguments to LAMBDA.", 0); +} + +void +ck_larg_exactly(int n, object x) { + for(; n > 0; n--, x = x->c.c_cdr) + if(endp(x)) + FEerror("APPLY sent too few arguments to LAMBDA.", 0); + if(!endp(x)) FEerror("APPLY sent too many arguments to LAMBDA.", 0); +} + +void +invalid_macro_call(void) +{ + FEinvalid_macro_call(); +} + +object +wrong_type_argument(object typ, object obj) +{ + FEwrong_type_argument(typ, obj); + /* no return */ + return(Cnil); +} + +void +illegal_declare(object form) +{ + FEinvalid_form("~S is an illegal declaration form.", form); +} + +void +not_a_string_or_symbol(object x) +{ + FEerror("~S is not a string or symbol.", 1, x); +} + +void +not_a_symbol(object obj) +{ +/* FEinvalid_variable("~S is not a symbol.", obj); */ + FEwrong_type_argument(sLsymbol,obj); +} + +int +not_a_variable(object obj) +{ + FEinvalid_variable("~S is not a variable.", obj); + return -1; +} + +void +illegal_index(object x, object i) +{ + FEerror("~S is an illegal index to ~S.", 2, i, x); +} + +void +check_stream(object strm) +{ +if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); +} + +void +vfun_wrong_number_of_args(object x) +{ + + FEerror("Expected ~S args but received ~S args",2, + x,make_fixnum(VFUN_NARGS)); +} + + +void +check_arg_range(int n, int m) { + + if (VFUN_NARGS < n) + FEtoo_few_arguments(0,VFUN_NARGS); + if (VFUN_NARGS > m) + FEtoo_many_arguments(0,VFUN_NARGS); + +} + + +DEF_ORDINARY("TERMINAL-INTERRUPT",sSterminal_interrupt,SI,""); +DEF_ORDINARY("CATCH",sKcatch,KEYWORD,""); +DEF_ORDINARY("PROTECT",sKprotect,KEYWORD,""); +DEF_ORDINARY("CATCHALL",sKcatchall,KEYWORD,""); + + +DEF_ORDINARY("CONDITION",sLcondition,LISP,""); +DEF_ORDINARY("SERIOUS-CONDITION",sLserious_condition,LISP,""); +DEF_ORDINARY("SIMPLE-CONDITION",sLsimple_condition,LISP,""); + +DEF_ORDINARY("ERROR",sLerror,LISP,""); +DEF_ORDINARY("SIMPLE-ERROR",sLsimple_error,LISP,""); +DEF_ORDINARY("FORMAT-CONTROL",sKformat_control,KEYWORD,""); +DEF_ORDINARY("FORMAT-ARGUMENTS",sKformat_arguments,KEYWORD,""); + +DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,""); +DEF_ORDINARY("DATUM",sKdatum,KEYWORD,""); +DEF_ORDINARY("EXPECTED-TYPE",sKexpected_type,KEYWORD,""); +DEF_ORDINARY("SIMPLE-TYPE-ERROR",sLsimple_type_error,LISP,""); + +DEF_ORDINARY("PROGRAM-ERROR",sLprogram_error,LISP,""); +DEF_ORDINARY("CONTROL-ERROR",sLcontrol_error,LISP,""); +DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,""); +DEF_ORDINARY("PACKAGE",sKpackage,KEYWORD,""); + +DEF_ORDINARY("STREAM-ERROR",sLstream_error,LISP,""); +DEF_ORDINARY("STREAM",sKstream,KEYWORD,""); +DEF_ORDINARY("END-OF-FILE",sLend_of_file,LISP,""); + +DEF_ORDINARY("FILE-ERROR",sLfile_error,LISP,""); +DEF_ORDINARY("PATHNAME",sKpathname,KEYWORD,""); + +DEF_ORDINARY("CELL-ERROR",sLcell_error,LISP,""); +DEF_ORDINARY("NAME",sKname,KEYWORD,""); +DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,""); +DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,""); +DEF_ORDINARY("UNDEFINED-FUNCTION",sLundefined_function,LISP,""); + +DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,""); +DEF_ORDINARY("OPERATION",sKoperation,KEYWORD,""); +DEF_ORDINARY("OPERANDS",sKoperands,KEYWORD,""); +DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,""); +DEF_ORDINARY("FLOATING-POINT-OVERFLOW",sLfloating_point_overflow,LISP,""); +DEF_ORDINARY("FLOATING-POINT-UNDERFLOW",sLfloating_point_underflow,LISP,""); +DEF_ORDINARY("FLOATING-POINT-INEXACT",sLfloating_point_inexact,LISP,""); +DEF_ORDINARY("FLOATING-POINT-INVALID-OPERATION",sLfloating_point_invalid_operation,LISP,""); + +DEF_ORDINARY("PARSE-ERROR",sLparse_error,LISP,""); + +DEF_ORDINARY("PRINT-NOT-READABLE",sLprint_not_readable,LISP,""); + +DEF_ORDINARY("READER-ERROR",sLreader_error,LISP,""); +DEF_ORDINARY("PATHNAME-ERROR",sLpathname_error,SI,""); + +DEF_ORDINARY("STORAGE-CONDITION",sLstorage_condition,LISP,""); + +DEF_ORDINARY("WARNING",sLwarning,LISP,""); +DEF_ORDINARY("SIMPLE-WARNING",sLsimple_warning,LISP,""); +DEF_ORDINARY("STYLE-WARNING",sLstyle_warning,LISP,""); + +void +gcl_init_error(void) { + null_string = make_simple_string(""); + enter_mark_origin(&null_string); +} diff --git a/o/eval.c b/o/eval.c new file mode 100755 index 0000000..c7b8e0b --- /dev/null +++ b/o/eval.c @@ -0,0 +1,1400 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + eval.c +*/ + +#include "include.h" +#include "sfun_argd.h" + +static void +call_applyhook(object); + + +struct nil3 { object nil3_self[3]; } three_nils; + +#ifdef DEBUG_AVMA +#undef DEBUG_AVMA +unsigned long avma,bot; +#define DEBUG_AVMA unsigned long saved_avma = avma; +warn_avma() +{ + print(list(2,make_simple_string("avma changed"),ihs_top_function_name(ihs_top)), + sLAstandard_outputA->s.s_dbind); +} +#define CHECK_AVMA if(avma!= saved_avma) warn_avma(); +#define DEBUGGING_AVMA +#else +#define DEBUG_AVMA +#define CHECK_AVMA +#endif + + + +/* object c_apply_n(long int (*fn)(), int n, object *x); */ + +object sSAbreak_pointsA; +object sSAbreak_stepA; + +#include "apply_n.h" + +/* for t_sfun,t_gfun with args on vs stack */ + +static void +quick_call_sfun(object fun) { + + DEBUG_AVMA + int i=fun->sfn.sfn_argd,n=SFUN_NARGS(i); + enum ftype restype; + object *x,*base; + + if (n!=vs_top-vs_base) + check_arg_failed(n); + + restype = SFUN_RETURN_TYPE(i); + SFUN_START_ARG_TYPES(i); +#define COERCE_ARG(a,type) (type==f_object ? a : (object)(fix(a))) + + x=vs_base; + if (i) { + int j; + x=alloca(n*sizeof(object)); + for (j=0;jvfn.vfn_minargs) + {FEtoo_few_arguments(base,vs_top); return;} + if (n > fun->vfn.vfn_maxargs) + {FEtoo_many_arguments(base,vs_top); return;} + VFUN_NARGS = n; + base[0]=c_apply_n_fun(fun,n,base); + vs_top=(vs_base=base)+1; + CHECK_AVMA; + return; +} + + +void +funcall(object fun) +{ + object temporary; + object x; + object * VOL top; + object *lex; + bds_ptr old_bds_top; + VOL bool b; + bool c; + DEBUG_AVMA + TOP: + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + MMcall(fun); + CHECK_AVMA; return; + case t_gfun: + case t_sfun: + { + extern int Rset; + int rset=Rset; + if (!rset) {ihs_check;ihs_push(fun);} + quick_call_sfun(fun); + if (!rset) ihs_pop(); + } + return; + case t_vfun: + { + extern int Rset; + int rset=Rset; + if (!rset) {ihs_check;ihs_push(fun);} + call_vfun(fun); + if (!rset) ihs_pop(); + } + return; + case t_afun: + case t_closure: + { object res,*b = vs_base; + int n = vs_top - b; + res = (object)IapplyVector(fun,n,b); + n = fcall.nvalues; + vs_base = b; + vs_top = b+ n; + while (--n> 0 ) b[n] = fcall.values[n]; + b[0] = res; + return;} + + case t_cclosure: + + MMccall(fun); + CHECK_AVMA; + return; + + case t_symbol: + {object x = fun->s.s_gfdef; + if (x) { fun = x; goto TOP;} + else + FEundefined_function(fun); + } + + case t_cons: + break; + + default: + FEinvalid_function(fun); + } + + /* + This part is the same as that of funcall_no_event. + */ + + /* we may have pushed the calling form if this is called invoked from + eval. A lambda call requires vs_push's, so we can tell + if we pushed by vs_base being the same. + */ + { VOL int not_pushed = 0; + if (vs_base != ihs_top->ihs_base){ + ihs_check; + ihs_push(fun); + } + else + not_pushed = 1; + + ihs_top->ihs_base = lex_env; + x = MMcar(fun); + top = vs_top; + lex = lex_env; + old_bds_top = bds_top; + + /* maybe digest this lambda expression + (lambda-block-expand name ..) has already been + expanded. The value of lambda-block-expand may + be a compiled function in which case we say expand + with it) + */ + + if (x == sSlambda_block_expanded) { + + b = TRUE; + c = FALSE; + fun = fun->c.c_cdr; + + }else if (x == sSlambda_block) { + b = TRUE; + c = FALSE; + if(sSlambda_block_expanded->s.s_dbind!=OBJNULL) + fun = ifuncall1(sSlambda_block_expanded->s.s_dbind,fun); + + fun = fun->c.c_cdr; + + + + } else if (x == sSlambda_closure) { + b = FALSE; + c = TRUE; + fun = fun->c.c_cdr; + } else if (x == sLlambda) { + b = c = FALSE; + fun = fun->c.c_cdr; + } else if (x == sSlambda_block_closure) { + b = c = TRUE; + fun = fun->c.c_cdr; + } else + b = c = TRUE; + if (c) { + vs_push(kar(fun)); + fun = fun->c.c_cdr; + vs_push(kar(fun)); + fun = fun->c.c_cdr; + vs_push(kar(fun)); + fun = fun->c.c_cdr; + } else { + *(struct nil3 *)vs_top = three_nils; + vs_top += 3; + } + if (b) { + x = kar(fun); /* block name */ + fun = fun->c.c_cdr; + } + lex_env = top; + vs_push(fun); + lambda_bind(top); + ihs_top->ihs_base = lex_env; + if (b) { + fun = temporary = alloc_frame_id(); + /* lex_block_bind(x, temporary); */ + temporary = MMcons(temporary, Cnil); + temporary = MMcons(sLblock, temporary); + temporary = MMcons(x, temporary); + lex_env[2] = MMcons(temporary, lex_env[2]); + frs_push(FRS_CATCH, fun); + if (nlj_active) { + nlj_active = FALSE; + goto END; + } + } + x = top[3]; /* body */ + if(endp(x)) { + vs_base = vs_top; + vs_push(Cnil); + } else { + top = vs_top; + for (;;) { + eval(MMcar(x)); + x = MMcdr(x); + if (endp(x)) + break; + vs_top = top; + } + } +END: + if (b) + frs_pop(); + bds_unwind(old_bds_top); + lex_env = lex; + if (not_pushed == 0) {ihs_pop();} + CHECK_AVMA; +}} + +void +funcall_no_event(object fun) +{ + DEBUG_AVMA + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + (*fun->cf.cf_self)(); + break; + + case t_cclosure: + (*fun->cc.cc_self)(fun); + break; + + case t_sfun: +/* call_sfun_no_check(fun); return; */ + case t_gfun: + quick_call_sfun(fun); return; + case t_vfun: + call_vfun(fun); return; + + default: + funcall(fun); + + } +} + +void +lispcall(object *funp, int narg) +{ + DEBUG_AVMA + object fun = *funp; + + vs_base = funp + 1; + vs_top = vs_base + narg; + + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + MMcall(fun); + break; + + case t_cclosure: + MMccall(fun); + break; + + default: + funcall(fun); + + } + CHECK_AVMA; +} + +void +lispcall_no_event(object *funp, int narg) +{ + DEBUG_AVMA + object fun = *funp; + + vs_base = funp + 1; + vs_top = vs_base + narg; + + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + (*fun->cf.cf_self)(); + break; + + case t_cclosure: + + (*fun->cc.cc_self)(fun); + break; + + default: + funcall(fun); + + } + CHECK_AVMA; +} + +void +symlispcall(object sym, object *base, int narg) +{ + DEBUG_AVMA + object fun = symbol_function(sym); + + vs_base = base; + vs_top = vs_base + narg; + + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + MMcall(fun); + break; + + case t_cclosure: + MMccall(fun); + break; + + default: + funcall(fun); + } + CHECK_AVMA; +} + +void +symlispcall_no_event(object sym, object *base, int narg) +{ + DEBUG_AVMA + object fun = symbol_function(sym); + + vs_base = base; + vs_top = vs_base + narg; + + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + (*fun->cf.cf_self)(); + break; + + case t_cclosure: + (*fun->cc.cc_self)(fun); + break; + + default: + funcall(fun); + + } + CHECK_AVMA; +} + +object +simple_lispcall(object *funp, int narg) +{ + DEBUG_AVMA + object fun = *funp; + object *sup = vs_top; + + vs_base = funp + 1; + vs_top = vs_base + narg; + + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + MMcall(fun); + break; + + case t_cclosure: + MMccall(fun); + break; + + default: + funcall(fun); + + } + vs_top = sup; + CHECK_AVMA; + return(vs_base[0]); + +} + +/* static object */ +/* simple_lispcall_no_event(object *funp, int narg) */ +/* { */ +/* DEBUG_AVMA */ +/* object fun = *funp; */ +/* object *sup = vs_top; */ + +/* vs_base = funp + 1; */ +/* vs_top = vs_base + narg; */ + +/* if (fun == OBJNULL) */ +/* FEerror("Undefined function.", 0); */ +/* switch (type_of(fun)) { */ +/* case t_cfun: */ +/* (*fun->cf.cf_self)(); */ +/* break; */ + +/* case t_cclosure: */ +/* { */ +/* object *top, *base, l; */ + +/* if (fun->cc.cc_turbo != NULL) { */ +/* (*fun->cc.cc_self)(fun->cc.cc_turbo); */ +/* break; */ +/* } */ +/* top = vs_top; */ +/* base = vs_base; */ +/* for (l = fun->cc.cc_env; !endp(l); l = l->c.c_cdr) */ +/* vs_push(l); */ +/* vs_base = vs_top; */ +/* while (base < top) */ +/* vs_push(*base++); */ +/* (*fun->cc.cc_self)(top); */ +/* break; */ +/* } */ + +/* default: */ +/* funcall(fun); */ + +/* } */ +/* vs_top = sup; */ +/* CHECK_AVMA; */ +/* return(vs_base[0]); */ +/* } */ + +object +simple_symlispcall(object sym, object *base, int narg) +{ + DEBUG_AVMA + object fun = symbol_function(sym); + object *sup = vs_top; + + vs_base = base; + vs_top = vs_base + narg; + + if (fun == OBJNULL) + FEerror("Undefined function.", 0); + switch (type_of(fun)) { + case t_cfun: + MMcall(fun); + break; + + case t_cclosure: + MMccall(fun); + break; + + default: + funcall(fun); + + } + vs_top = sup; + CHECK_AVMA; + return(vs_base[0]); +} + +/* static object */ +/* simple_symlispcall_no_event(object sym, object *base, int narg) */ +/* { */ +/* DEBUG_AVMA */ +/* object fun = symbol_function(sym); */ +/* object *sup = vs_top; */ + +/* vs_base = base; */ +/* vs_top = vs_base + narg; */ + +/* if (fun == OBJNULL) */ +/* FEerror("Undefined function.", 0); */ +/* switch (type_of(fun)) { */ +/* case t_cfun: */ +/* (*fun->cf.cf_self)(); */ +/* break; */ + +/* case t_cclosure: */ +/* { */ +/* object *top, *base, l; */ + +/* if (fun->cc.cc_turbo != NULL) { */ +/* (*fun->cc.cc_self)(fun->cc.cc_turbo); */ +/* break; */ +/* } */ +/* top = vs_top; */ +/* base = vs_base; */ +/* for (l = fun->cc.cc_env; !endp(l); l = l->c.c_cdr) */ +/* vs_push(l); */ +/* vs_base = vs_top; */ +/* while (base < top) */ +/* vs_push(*base++); */ +/* (*fun->cc.cc_self)(top); */ +/* break; */ +/* } */ + +/* default: */ +/* funcall(fun); */ +/* } */ +/* vs_top = sup; */ +/* CHECK_AVMA; */ +/* return(vs_base[0]); */ +/* } */ + +void +super_funcall(object fun) +{ + if (type_of(fun) == t_symbol) { + if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) + FEinvalid_function(fun); + if (fun->s.s_gfdef == OBJNULL) + FEundefined_function(fun); + fun = fun->s.s_gfdef; + } + funcall(fun); +} + +void +super_funcall_no_event(object fun) { + +#ifdef DEBUGGING_AVMA + funcall_no_event(fun); return; +#endif + + switch(type_of(fun)) { + case t_cfun: + (*fun->cf.cf_self)(); return; + case t_cclosure: + (*fun->cc.cc_self)(fun); return; + case t_sfun: + /* call_sfun_no_check(fun); return; */ + case t_gfun: + quick_call_sfun(fun); return; + case t_vfun: + call_vfun(fun); return; + case t_symbol: + if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) + FEinvalid_function(fun); + if (fun->s.s_gfdef == OBJNULL) + FEundefined_function(fun); + super_funcall_no_event(fun->s.s_gfdef); + return; + default: + funcall(fun); + } + +} + +#ifdef USE_BROKEN_IEVAL +object +Ieval(form) +object form; +{ + DEBUG_AVMA + object fun, x; + object *top; + object *base; + object orig_form; + + cs_check(form); + +EVAL: + + vs_check; + + if (siVevalhook->s.s_dbind != Cnil && eval1 == 0) + { + bds_ptr old_bds_top = bds_top; + object hookfun = symbol_value(siVevalhook); + /* check if Vevalhook is unbound */ + + bds_bind(siVevalhook, Cnil); + form = Ifuncall_n(hookfun,2,form,list(3,lex_env[0],lex_env[1],lex_env[2])); + bds_unwind(old_bds_top); + return form; + } else + eval1 = 0; + + if (type_of(form) == t_cons) + goto APPLICATION; + + if (type_of(form) != t_symbol) RETURN1(form); + + switch (form->s.s_stype) { + case stp_constant: + RETURN1((form->s.s_dbind)); + + case stp_special: + if(form->s.s_dbind == OBJNULL) + FEunbound_variable(form); + RETURN1((form->s.s_dbind)); + + default: + /* x = lex_var_sch(form); */ + for (x = lex_env[0]; type_of(x) == t_cons; x = x->c.c_cdr) + if (x->c.c_car->c.c_car == form) { + x = x->c.c_car->c.c_cdr; + if (endp(x)) + break; + RETURN1((x->c.c_car)); + } + if(form->s.s_dbind == OBJNULL) + FEunbound_variable(form); + RETURN1((form->s.s_dbind)); + } + +APPLICATION: + /* Hook for possibly stopping at forms in the break point + list. Also for stepping. We only want to check + one form each time round, so we do *breakpoints* + */ + if (sSAbreak_pointsA->s.s_dbind != Cnil) + { if (sSAbreak_stepA->s.s_dbind == Cnil || + ifuncall2(sSAbreak_stepA->s.s_dbind,form, + list(3,lex_env[0],lex_env[1],lex_env[2])) == Cnil) + {object* bpts = sSAbreak_pointsA->s.s_dbind->v.v_self; + int i = sSAbreak_pointsA->s.s_dbind->v.v_fillp; + while (--i >= 0) + { if((*bpts)->c.c_car == form) + {ifuncall2(sSAbreak_pointsA->s.s_gfdef,form, + list(3,lex_env[0],lex_env[1],lex_env[2])); + + break;} + bpts++;} + }} + + fun = MMcar(form); + if (type_of(fun) != t_symbol) + goto LAMBDA; + if (fun->s.s_sfdef != NOT_SPECIAL) { + ihs_check; + ihs_push(form); + ihs_top->ihs_base = lex_env; + (*fun->s.s_sfdef)(MMcdr(form)); + CHECK_AVMA; + ihs_pop(); + return Ivs_values(); + } + /* x = lex_fd_sch(fun); */ + for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr) + if (x->c.c_car->c.c_car == fun) { + x = x->c.c_car; + if (MMcadr(x) == sSmacro) { + x = MMcaddr(x); + goto EVAL_MACRO; + } + x = MMcaddr(x); + goto EVAL_ARGS; + } + + if ((x = fun->s.s_gfdef) == OBJNULL) + FEundefined_function(fun); + + if (fun->s.s_mflag) { + EVAL_MACRO: + + form = Imacro_expand1(x, form); + goto EVAL; + } + + + +EVAL_ARGS: + { int n ; + ihs_check; + ihs_push(form); + ihs_top->ihs_base = lex_env; + form = form->c.c_cdr; + base = vs_top; + top = base ; + while(!endp(form)) { + object ans = Ieval(MMcar(form)); + top[0] = ans; + vs_top = ++top; + form = MMcdr(form);} + n =top - base; /* number of args */ + if (siVapplyhook->s.s_dbind != Cnil) { + base[0]= (object)n; + base[0] = c_apply_n(list,n+1,base); + x = Ifuncall_n(siVapplyhook->s.s_dbind,3, + x, /* the function */ + base[0], /* the arg list */ + list(3,lex_env[0],lex_env[1],lex_env[2])); + vs_top = base; return x; + } + ihs_top->ihs_function = x; + ihs_top->ihs_base = vs_base; + x=IapplyVector(x,n,base+1); + CHECK_AVMA; + ihs_pop(); + vs_top = base; + return x; + } + +LAMBDA: + if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) { + x = listA(4,sSlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun)); + goto EVAL_ARGS; + } + FEinvalid_function(fun); +} + +#else + +object +Ieval(object form) +{ eval(form); + return Ivs_values(); +} +#endif + +void +eval(object form) +{ + object temporary; + DEBUG_AVMA + object fun, x; + object *top; + object *base; + + cs_check(form); + +EVAL: + + vs_check; + + if (siVevalhook->s.s_dbind != Cnil && eval1 == 0) + { + bds_ptr old_bds_top = bds_top; + object hookfun = symbol_value(siVevalhook); + /* check if siVevalhook is unbound */ + + bds_bind(siVevalhook, Cnil); + vs_base = vs_top; + vs_push(form); + vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); + super_funcall(hookfun); + bds_unwind(old_bds_top); + return; + } else + eval1 = 0; + + if (type_of(form) == t_cons) + goto APPLICATION; + + if (type_of(form) != t_symbol) { + vs_base = vs_top; + vs_push(form); + return; + } + + switch (form->s.s_stype) { + case stp_constant: + vs_base = vs_top; + vs_push(form->s.s_dbind); + return; + + case stp_special: + if(form->s.s_dbind == OBJNULL) + FEunbound_variable(form); + vs_base = vs_top; + vs_push(form->s.s_dbind); + return; + + default: + /* x = lex_var_sch(form); */ + for (x = lex_env[0]; type_of(x) == t_cons; x = x->c.c_cdr) + if (x->c.c_car->c.c_car == form) { + x = x->c.c_car->c.c_cdr; + if (endp(x)) + break; + vs_base = vs_top; + vs_push(x->c.c_car); + return; + } + if(form->s.s_dbind == OBJNULL) + FEunbound_variable(form); + vs_base = vs_top; + vs_push(form->s.s_dbind); + return; + } + +APPLICATION: + /* Hook for possibly stopping at forms in the break point + list. Also for stepping. We only want to check + one form each time round, so we do *breakpoints* + */ + if (sSAbreak_pointsA->s.s_dbind != Cnil) + { if (sSAbreak_stepA->s.s_dbind == Cnil || + ifuncall2(sSAbreak_stepA->s.s_dbind,form, + list(3,lex_env[0],lex_env[1],lex_env[2])) == Cnil) + {object* bpts = sSAbreak_pointsA->s.s_dbind->v.v_self; + int i = sSAbreak_pointsA->s.s_dbind->v.v_fillp; + while (--i >= 0) + { if((*bpts)->c.c_car == form) + {ifuncall2(sSAbreak_pointsA->s.s_gfdef,form, + list(3,lex_env[0],lex_env[1],lex_env[2])); + + break;} + bpts++;} + }} + + fun = MMcar(form); + if (type_of(fun) != t_symbol) + goto LAMBDA; + if (fun->s.s_sfdef != NOT_SPECIAL) { + ihs_check; + ihs_push(form); + ihs_top->ihs_base = lex_env; + (*fun->s.s_sfdef)(MMcdr(form)); + CHECK_AVMA; + ihs_pop(); + return; + } + /* x = lex_fd_sch(fun); */ + for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr) + if (x->c.c_car->c.c_car == fun) { + x = x->c.c_car; + if (MMcadr(x) == sSmacro) { + x = MMcaddr(x); + goto EVAL_MACRO; + } + x = MMcaddr(x); + goto EVAL_ARGS; + } + + if ((x = fun->s.s_gfdef) == OBJNULL) + FEundefined_function(fun); + + if (fun->s.s_mflag) { + EVAL_MACRO: + top = vs_top; + form=Imacro_expand1(x, form); + vs_top = top; + vs_push(form); + goto EVAL; + } + + + +EVAL_ARGS: + vs_push(x); + ihs_check; + ihs_push(form); + ihs_top->ihs_base = lex_env; + form = form->c.c_cdr; + base = vs_top; + top = vs_top; + while(!endp(form)) { + eval(MMcar(form)); + top[0] = vs_base[0]; + vs_top = ++top; + form = MMcdr(form); + } + vs_base = base; + if (siVapplyhook->s.s_dbind != Cnil) { + call_applyhook(fun); + return; + } + ihs_top->ihs_function = x; + ihs_top->ihs_base = vs_base; + if (type_of(x) == t_cfun) + (*(x)->cf.cf_self)(); + else + funcall_no_event(x); + CHECK_AVMA; + ihs_pop(); + return; + +LAMBDA: + if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) { + temporary = make_cons(lex_env[2], fun->c.c_cdr); + temporary = make_cons(lex_env[1], temporary); + temporary = make_cons(lex_env[0], temporary); + x = make_cons(sSlambda_closure, temporary); + vs_push(x); + goto EVAL_ARGS; + } + FEinvalid_function(fun); +} + +static void +call_applyhook(object fun) +{ + object ah; + + ah = symbol_value(siVapplyhook); + Llist(); + vs_push(vs_base[0]); + vs_base[0] = fun; + vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); + super_funcall(ah); +} + + +DEFUNOM_NEW("FUNCALL",object,fLfuncall,LISP + ,1,MAX_ARGS,NONE,OO,OO,OO,OO,void,Lfuncall,(object fun,...),"") +{ va_list ap; + object *new; + int n = VFUN_NARGS; + va_start(ap,fun); + {COERCE_VA_LIST(new,ap,n); + return IapplyVector(fun,n-1,new); + va_end(ap); + } +} + + +DEFUNOM_NEW("APPLY",object,fLapply,LISP + ,2,MAX_ARGS,NONE,OO,OO,OO,OO,void,Lapply,(object fun,...),"") +{ int m,n=VFUN_NARGS; + object l; + object buf[MAX_ARGS]; + object *base=buf; + va_list ap; + va_start(ap,fun); + m = n-1; + while (--m >0) + {*base++ = va_arg(ap,object); + } + m = n-2; + l = va_arg(ap,object); + va_end(ap); + while (!endp(l)) + { if (m >= MAX_ARGS) FEerror(" Lisps arglist maximum surpassed",0); + *base++ = Mcar(l); + l = Mcdr(l); + m++;} + return IapplyVector(fun,m,buf); + } + + +DEFUNOM_NEW("EVAL",object,fLeval,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Leval,(object x0),"") +{ + object *lex = lex_env; + + /* 1 args */ + lex_new(); + /* eval(vs_base[0]); */ + eval(x0); + lex_env = lex; + return Ivs_values(); +} + +LFD(siLevalhook)(void) +{ + object env; + bds_ptr old_bds_top = bds_top; + object *lex = lex_env; + int n = vs_top - vs_base; + + lex_env = vs_top; + if (n < 3) + too_few_arguments(); + else if (n == 3) { + *(struct nil3 *)vs_top = three_nils; + vs_top += 3; + } else if (n == 4) { + env = vs_base[3]; + vs_push(car(env)); + env = cdr(env); + vs_push(car(env)); + env = cdr(env); + vs_push(car(env)); + } else + too_many_arguments(); + bds_bind(siVevalhook, vs_base[1]); + bds_bind(siVapplyhook, vs_base[2]); + eval1 = 1; + eval(vs_base[0]); + lex_env = lex; + bds_unwind(old_bds_top); +} + +LFD(siLapplyhook)(void) +{ + + object env; + bds_ptr old_bds_top = bds_top; + object *lex = lex_env; + int n = vs_top - vs_base; + object l, *z; + + lex_env = vs_top; + if (n < 4) + too_few_arguments(); + else if (n == 4) { + *(struct nil3 *)vs_top = three_nils; + vs_top += 3; + } else if (n == 5) { + env = vs_base[4]; + vs_push(car(env)); + env = cdr(env); + vs_push(car(env)); + env = cdr(env); + vs_push(car(env)); + } else + too_many_arguments(); + bds_bind(siVevalhook, vs_base[2]); + bds_bind(siVapplyhook, vs_base[3]); + z = vs_top; + for (l = vs_base[1]; !endp(l); l = l->c.c_cdr) + vs_push(l->c.c_car); + l = vs_base[0]; + vs_base = z; + super_funcall(l); + lex_env = lex; + bds_unwind(old_bds_top); +} + +DEFUNO_NEW("CONSTANTP",object,fLconstantp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lconstantp,(object x0),"") +{ + enum type x; + /* 1 args */ + + x = type_of(x0); + if(x == t_cons) + if(x0->c.c_car == sLquote) + x0 = Ct; + else x0 = Cnil; + else if(x == t_symbol) + if((enum stype)x0->s.s_stype == stp_constant) + x0 = Ct; + else + x0 = Cnil; + else + x0 = Ct; + RETURN1(x0); +} + +object +ieval(object x) +{ + object *old_vs_base; + object *old_vs_top; + + old_vs_base = vs_base; + old_vs_top = vs_top; + eval(x); + x = vs_base[0]; + vs_base = old_vs_base; + vs_top = old_vs_top; + return(x); +} + +object +ifuncall1(object fun, object arg1) +{ + object *old_vs_base; + object *old_vs_top; + object x; + + old_vs_base = vs_base; + old_vs_top = vs_top; + vs_base = vs_top; + vs_push(arg1); + super_funcall(fun); + x = vs_base[0]; + vs_top = old_vs_top; + vs_base = old_vs_base; + return(x); +} + +object +ifuncall2(object fun, object arg1, object arg2) +{ + object *old_vs_base; + object *old_vs_top; + object x; + + old_vs_base = vs_base; + old_vs_top = vs_top; + vs_base = vs_top; + vs_push(arg1); + vs_push(arg2); + super_funcall(fun); + x = vs_base[0]; + vs_top = old_vs_top; + vs_base = old_vs_base; + return(x); +} + +object +ifuncall3(object fun, object arg1, object arg2, object arg3) +{ + object *old_vs_base; + object *old_vs_top; + object x; + + old_vs_base = vs_base; + old_vs_top = vs_top; + vs_base = vs_top; + vs_push(arg1); + vs_push(arg2); + vs_push(arg3); + super_funcall(fun); + x = vs_base[0]; + vs_top = old_vs_top; + vs_base = old_vs_base; + return(x); +} + +void +funcall_with_catcher(object fname, object fun) +{ + int n = vs_top - vs_base; + if (n > 64) n = 64; + frs_push(FRS_CATCH, make_cons(fname, make_fixnum(n))); + if (nlj_active) + nlj_active = FALSE; + else + funcall(fun); + frs_pop(); +} + +static object +fcalln_cclosure(object first,va_list ap) +{ +int i=fcall.argd; + {object *base=vs_top,*old_base=base; + DEBUG_AVMA + vs_base=base; + if (i) { + *(base++)=first; + i--; + } + switch(i){ + case 10: *(base++)=va_arg(ap,object); + case 9: *(base++)=va_arg(ap,object); + case 8: *(base++)=va_arg(ap,object); + case 7: *(base++)=va_arg(ap,object); + case 6: *(base++)=va_arg(ap,object); + case 5: *(base++)=va_arg(ap,object); + case 4: *(base++)=va_arg(ap,object); + case 3: *(base++)=va_arg(ap,object); + case 2: *(base++)=va_arg(ap,object); + case 1: *(base++)=va_arg(ap,object); + case 0: break; + default: + FEerror("bad args",0); + } vs_top=base; + base=old_base; + do{object fun=fcall.fun; + object *top, *base, l; + + massert(fun->cc.cc_turbo); + if (fun->cc.cc_turbo != NULL) { + (*fun->cc.cc_self)(fun); + break; + } + top = vs_top; + base = vs_base; + for (l = fun->cc.cc_env; !endp(l); l = l->c.c_cdr) + vs_push(l); + vs_base = vs_top; + while (base < top) + vs_push(*base++); + (*fcall.fun->cc.cc_self)(top); + break; + }while (0); + vs_top=base; + CHECK_AVMA; + return(vs_base[0]); +}} + +static object +fcalln_general(object first,va_list ap) { + int i=fcall.argd; + + { + int n= SFUN_NARGS(i); + /* object *old_vs_base=vs_base; */ + object *old_vs_top=vs_top; + object x; + enum ftype typ,restype=SFUN_RETURN_TYPE(i); + vs_top = vs_base = old_vs_top; + SFUN_START_ARG_TYPES(i); + if (i==0) { + int jj=0; + while (n-- > 0) { + typ= SFUN_NEXT_TYPE(i); + x = + (typ==f_object ? (jj ? va_arg(ap,object) : first): + typ==f_fixnum ? make_fixnum((jj ? va_arg(ap,fixnum) : (fixnum)first)): + (object) (FEerror("bad type",0),Cnil)); + *(vs_top++) = x; + jj++; + } + } else { + object *base=vs_top; + *(base++)=first; + n--; + while (n-- > 0) + *(base++) = va_arg(ap,object); + vs_top=base; + } + funcall(fcall.fun); + x= vs_base[0]; + vs_top=old_vs_top; + /* vs_base=old_vs_base; */ + return (restype== f_object ? x : + restype== f_fixnum ? (object) (fix(x)): + (object) (FEerror("bad type",0),Cnil)); + } +} + +static object +fcalln_vfun(object first,va_list vl) +{object *new,res; + DEBUG_AVMA + COERCE_VA_LIST_NEW(new,first,vl,fcall.argd); + res = c_apply_n_fun(fcall.fun,fcall.argd,new); + CHECK_AVMA; + return res; +} + +object +fcalln1(object first,...) +{ va_list ap; + object fun=fcall.fun; + DEBUG_AVMA + va_start(ap,first); + if(type_of(fun)==t_cfun) + {object *base=vs_top,*old_base=base; + int i=fcall.argd; + vs_base=base; + if (i) { + *(base++)=first; + i--; + } + switch(i){ + case 10: *(base++)=va_arg(ap,object); + case 9: *(base++)=va_arg(ap,object); + case 8: *(base++)=va_arg(ap,object); + case 7: *(base++)=va_arg(ap,object); + case 6: *(base++)=va_arg(ap,object); + case 5: *(base++)=va_arg(ap,object); + case 4: *(base++)=va_arg(ap,object); + case 3: *(base++)=va_arg(ap,object); + case 2: *(base++)=va_arg(ap,object); + case 1: *(base++)=va_arg(ap,object); + case 0: break; + default: + FEerror("bad args",0); + } vs_top=base; + base=old_base; + (*fcall.fun->cf.cf_self)(); + vs_top=base; + CHECK_AVMA; + return(vs_base[0]); + } + if(type_of(fun)==t_cclosure) + return(fcalln_cclosure(first,ap)); + if(type_of(fun)==t_vfun) + return(fcalln_vfun(first,ap)); + return(fcalln_general(first,ap)); + va_end(ap); + } + +/* call a cfun eg funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) */ +/* typedef void (*funcvoid)(); */ + +object +funcall_cfun(funcvoid fn,int n,...) +{object *old_top = vs_top; + object *old_base= vs_base; + object result; + va_list ap; + DEBUG_AVMA + vs_base=vs_top; + va_start(ap,n); + while(n-->0) vs_push(va_arg(ap,object)); + va_end(ap); + (*fn)(); + if(vs_top>vs_base) result=vs_base[0]; + else result=Cnil; + vs_top=old_top; + vs_base=old_base; + CHECK_AVMA; + return result;} + +DEF_ORDINARY("LAMBDA-BLOCK-EXPANDED",sSlambda_block_expanded,SI,""); +DEFVAR("*BREAK-POINTS*",sSAbreak_pointsA,SI,Cnil,""); +DEFVAR("*BREAK-STEP*",sSAbreak_stepA,SI,Cnil,""); + +void +gcl_init_eval(void) +{ + + + + + make_constant("CALL-ARGUMENTS-LIMIT", make_fixnum(64)); + + + siVevalhook = make_si_special("*EVALHOOK*", Cnil); + siVapplyhook = make_si_special("*APPLYHOOK*", Cnil); + + + three_nils.nil3_self[0] = Cnil; + three_nils.nil3_self[1] = Cnil; + three_nils.nil3_self[2] = Cnil; + + make_si_function("EVALHOOK", siLevalhook); + make_si_function("APPLYHOOK", siLapplyhook); + +} diff --git a/o/external_funs.h b/o/external_funs.h new file mode 100755 index 0000000..d3b51c3 --- /dev/null +++ b/o/external_funs.h @@ -0,0 +1,423 @@ +/* for file nfunlink.X */ + +extern object Icall_proc GPR((object fun_name, int link_desk, object (**link_loc) ( ), ...));; +extern float Icall_proc_float GPR((object fun_name, int link_desk, object (**link_loc) ( ), ...));; +extern object IapplyVector GPR((object fun, int nargs, object *base));; +extern int Iinvoke_c_function_from_value_stack GPR((int f, int fargd));; + +/* for file alloc.X */ + +extern char *alloc_page GPR((int n));; +extern void add_page_to_freelist GPR((char *p, struct typemanager *tm));; +extern object alloc_object GPR((enum type t));; +extern int grow_linear GPR((int old, int fract, int grow_min, int grow_max));; +extern object make_cons GPR((object a, object d));; +extern object on_stack_cons GPR((object x, object y));; +extern void call_after_gbc_hook GPR((int t));; +extern object fSallocated GPR((object typ));; +extern char *alloc_contblock GPR((int n));; +extern int insert_contblock GPR((char *p, int s));; +extern int insert_maybe_sgc_contblock GPR((char *p, int s));; +extern char *alloc_relblock GPR((int n));; +extern int init_tm GPR((enum type t, char *name, int elsize, int nelts, int sgc));; +extern int set_maxpage GPR((void));; +extern int init_alloc GPR((void));; +extern int cant_get_a_type GPR((void));; +extern int siLallocate GPR((void));; +extern int t_from_type GPR((object type));; +extern object siSallocate_sgc GPR((object type, int min, int max, int free_percent));; +extern object siSallocate_growth GPR((object type, int min, int max, int percent, int percent_free));; +extern int siLallocated_pages GPR((void));; +extern int siLmaxpage GPR((void));; +extern int siLalloc_contpage GPR((void));; +extern int siLncbpage GPR((void));; +extern int siLmaxcbpage GPR((void));; +extern int siLalloc_relpage GPR((void));; +extern int siLnrbpage GPR((void));; +extern int siLget_hole_size GPR((void));; +extern int siLset_hole_size GPR((void));; +extern int init_alloc_function GPR((void));; +extern char *malloc GPR((int size));; +extern void free GPR((void *ptr));; +extern char *realloc GPR((char *ptr, int size));; +extern char *calloc GPR((int nelem, int elsize));; +extern int cfree GPR((char *ptr));; +extern char *memalign GPR((int align, int size));; +extern char *valloc GPR((int size));; + +/* for file array.X */ + +extern enum aelttype get_aelttype GPR((object x));; +extern enum aelttype array_elttype GPR((object x));; +extern char *array_address GPR((object x, int inc));; +extern char *raw_aet_ptr GPR((object x, short int typ));; +extern int gset GPR((char *p1, char *val, int n, int typ));; +extern int copy_array_portion GPR((object x, object y, int i1, int i2, int n1));; +extern int siLcopy_array_portion GPR((void));; +extern int array_allocself GPR((object x, bool staticp, object dflt));; +extern object aref GPR((object x, int index));; +extern object aset GPR((object x, int index, object value));; +extern object aref1 GPR((object v, int index));; +extern object aset1 GPR((object v, int index, object val));; +extern int displace GPR((object from, object to, object offset));; +extern int undisplace GPR((object from));; +extern int check_displaced GPR((object dlist, object orig, int newdim));; +extern int adjust_displaced GPR((object x, int diff));; +extern int setup_fillp GPR((object x, object fillp));; +extern int siLmake_pure_array GPR((void));; +extern int siLmake_vector GPR((void));; +extern int Laref GPR((void));; +extern int siLaset GPR((void));; +extern int Larray_element_type GPR((void));; +extern int Larray_rank GPR((void));; +extern int Larray_dimension GPR((void));; +extern int Larray_total_size GPR((void));; +extern int Ladjustable_array_p GPR((void));; +extern int siLdisplaced_array_p GPR((void));; +extern int Lsvref GPR((void));; +extern int siLsvset GPR((void));; +extern int Larray_has_fill_pointer_p GPR((void));; +extern int Lfill_pointer GPR((void));; +extern int siLfill_pointer_set GPR((void));; +extern int siLreplace_array GPR((void));; +extern int siLaset_by_cursor GPR((void));; +extern int init_array_function GPR((void));; + +/* for file assignment.X */ + +extern int setq GPR((object sym, object val));; +extern int Fsetq GPR((object form));; +extern int Fpsetq GPR((object arg));; +extern int Lset GPR((void));; +extern int siLfset GPR((void));; +extern int Fmultiple_value_setq GPR((object form));; +extern int Lmakunbound GPR((void));; +extern int Lfmakunbound GPR((void));; +extern int Fsetf GPR((object form));; +extern int setf GPR((object place, object form));; +extern int Fpush GPR((object form));; +extern int Fpop GPR((object form));; +extern int Fincf GPR((object form));; +extern int Fdecf GPR((object form));; +extern object clear_compiler_properties GPR((object sym, object code));; +extern int siLclear_compiler_properties GPR((void));; +extern int init_assignment GPR((void));; + +/* for file backq.X */ + +extern int kwote_cdr GPR((void));; +extern int kwote_car GPR((void));; +extern int backq_cdr GPR((object x));; +extern int backq_car GPR((object x));; +extern object backq GPR((object x));; +extern int Lcomma_reader GPR((void));; +extern int Lbackquote_reader GPR((void));; +extern int init_backq GPR((void));; + +/* for file bcmp.X */ + +extern int bcmp GPR((char *s1, char *s2, int n));; + +/* for file bcopy.X */ + +extern void bcopy GPR((char *s1, char *s2, int n));; + +/* for file bds.X */ + +extern int bds_unwind GPR((bds_ptr new_bds_top));; + +/* for file big.X */ + +extern int bcopy_body GPR((GEN x, GEN y));; +extern object make_integer GPR((GEN u));; +extern object make_bignum GPR((GEN u));; +extern int big_zerop GPR((object x));; +extern int big_compare GPR((object x, object y));; +extern object big_minus GPR((object x));; +extern int gcopy_to_big GPR((GEN res, object x));; +extern int add_int_big GPR((int i, object x));; +extern int sub_int_big GPR((int i, object x));; +extern int mul_int_big GPR((int i, object x));; +extern int div_int_big GPR((int i, object x));; +extern object big_plus GPR((object x, object y));; +extern object big_times GPR((object x, object y));; +extern int big_quotient_remainder GPR((object x0, object y0, object *qp, object *rp));; +extern double big_to_double GPR((object x));; +extern object normalize_big_to_object GPR((object x));; +extern object copy_big GPR((object x));; +extern object copy_to_big GPR((object x));; +extern GEN powerii GPR((GEN x, GEN y));; +extern int replace_copy1 GPR((GEN x, GEN y));; +extern GEN replace_copy2 GPR((GEN x, GEN y));; +extern int obj_replace_copy1 GPR((object x, GEN y));; +extern GEN obj_replace_copy2 GPR((object x, GEN y));; +extern GEN1 otoi GPR((object x));; +extern object alloc_bignum_static GPR((int len));; +extern GEN1 setq_io GPR((GEN x, object *all, object val));; +extern GEN1 setq_ii GPR((GEN x, object *all, GEN val));; +extern void isetq_fix GPR((GEN var, int s));; +extern GEN icopy_bignum GPR((object a, GEN y));; +extern GEN icopy_fixnum GPR((object a, GEN y));; + +/* for file bind.X */ + +extern int lambda_bind GPR((object *arg_top));; +extern int bind_var GPR((object var, object val, object spp));; +extern int illegal_lambda GPR((void));; +extern object find_special GPR((object body, struct bind_temp *start, struct bind_temp *end));; +extern object let_bind GPR((object body, struct bind_temp *start, struct bind_temp *end));; +extern object letA_bind GPR((object body, struct bind_temp *start, struct bind_temp *end));; +extern int parse_key GPR((object *base, bool rest, bool allow_other_keys, register int n, int __builtin_va_alist));; +extern int check_other_key GPR((object l, int n, int __builtin_va_alist));; +extern int parse_key_new GPR((int n, object *base, struct key *keys, ...));; +extern int parse_key_rest GPR((object rest, int n, object *base, struct key *keys, ...));; +extern int set_key_struct GPR((struct key *ks, object data));; +extern int init_bind GPR((void));; + +/* for file bitop.X */ + +extern int get_mark_bit GPR((void));; +extern int set_mark_bit GPR((void));; +extern int get_set_mark_bit GPR((void));; + +/* for file block.X */ + +extern int Fblock GPR((object args));; +extern int Freturn_from GPR((object args));; +extern int Freturn GPR((object args));; +extern int init_block GPR((void));; + +/* for file bzero.X */ + +extern int bzero GPR((char *b, int length));; + +/* for file catch.X */ + +extern int Fcatch GPR((object args));; +extern int siLerror_set GPR((void));; +extern int Funwind_protect GPR((object args));; +extern int Fthrow GPR((object args));; +extern int init_catch GPR((void));; + +/* for file cfun.X */ + +extern object make_cfun GPR((int (*self) ( ), object name, object data, char *start, int size));; +extern object make_sfun GPR((object name, int (*self) ( ), int argd, object data));; +extern object make_vfun GPR((object name, int (*self) ( ), int argd, object data));; +extern object make_cclosure_new GPR((int (*self) ( ), object name, object env, object data));; +extern object make_cclosure GPR((int (*self) ( ), object name, object env, object data, char *start, int size));; +extern int siLmc GPR((void));; +extern object MFsfun GPR((object sym, int (*self) ( ), int argd, object data));; +extern int siLmfsfun GPR((void));; +extern object MFvfun GPR((object sym, int (*self) ( ), int argd, object data));; +extern int siLmfvfun GPR((void));; +extern object MFvfun_key GPR((object sym, int (*self) ( ), int argd, object data, char *keys));; +extern int siLmfvfun_key GPR((void));; +extern object MFnew GPR((object sym, int (*self) ( ), object data));; +extern int siLmf GPR((void));; +extern object MF GPR((object sym, int (*self) ( ), char *start, int size, object data));; +extern object MM GPR((object sym, int (*self) ( ), char *start, int size, object data));; +extern int siLmm GPR((void));; +extern object make_function GPR((char *s, int (*f) ( )));; +extern object make_si_sfun GPR((char *s, int (*f) ( ), int argd));; +extern object make_si_vfun1 GPR((char *s, int (*f) ( ), int argd));; +extern object make_si_function GPR((char *s, int (*f) ( )));; +extern object make_special_form GPR((char *s, int (*f) ( )));; +extern int siLcompiled_function_name GPR((void));; +extern int turbo_closure GPR((object fun));; +extern int siLturbo_closure GPR((void));; +extern int init_cfun GPR((void));; + +/* for file character.X */ + +extern int Lstandard_char_p GPR((void));; +extern int Lgraphic_char_p GPR((void));; +extern int Lstring_char_p GPR((void));; +extern int Lalpha_char_p GPR((void));; +extern int Lupper_case_p GPR((void));; +extern int Llower_case_p GPR((void));; +extern int Lboth_case_p GPR((void));; +extern int digitp GPR((int i, int r));; +extern int Ldigit_char_p GPR((void));; +extern int Lalphanumericp GPR((void));; +extern bool char_eq GPR((object x, object y));; +extern int Lchar_eq GPR((void));; +extern int Lchar_neq GPR((void));; +extern int char_cmp GPR((object x, object y));; +extern int Lchar_cmp GPR((int s, int t));; +extern int Lchar_l GPR((void));; +extern int Lchar_g GPR((void));; +extern int Lchar_le GPR((void));; +extern int Lchar_ge GPR((void));; +extern bool char_equal GPR((object x, object y));; +extern int Lchar_equal GPR((void));; +extern int Lchar_not_equal GPR((void));; +extern int char_compare GPR((object x, object y));; +extern int Lchar_compare GPR((int s, int t));; +extern int Lchar_lessp GPR((void));; +extern int Lchar_greaterp GPR((void));; +extern int Lchar_not_greaterp GPR((void));; +extern int Lchar_not_lessp GPR((void));; +extern object coerce_to_character GPR((object x));; +extern int Lcharacter GPR((void));; +extern int Lchar_code GPR((void));; +extern int Lchar_bits GPR((void));; +extern int Lchar_font GPR((void));; +extern int Lcode_char GPR((void));; +extern int Lmake_char GPR((void));; +extern int Lchar_upcase GPR((void));; +extern int Lchar_downcase GPR((void));; +extern int digit_weight GPR((int w, int r));; +extern int Ldigit_char GPR((void));; +extern int Lchar_int GPR((void));; +extern int Lint_char GPR((void));; +extern int Lchar_name GPR((void));; +extern int Lname_char GPR((void));; +extern int Lchar_bit GPR((void));; +extern int Lset_char_bit GPR((void));; +extern int init_character GPR((void));; +extern int init_character_function GPR((void));; + +/* for file cmpaux.X */ + +extern int siLspecialp GPR((void));; +extern void siLdefvar1 GPR((void));; +extern void siLdebug GPR((void));; +extern void siLsetvv GPR((void));; +extern int init_cmpaux GPR((void));; +extern int ifloor GPR((int x, int y));; +extern int imod GPR((int x, int y));; +extern int set_VV_data GPR((object *VV, int n, object data, char *start, int size));; +extern int set_VV GPR((object *VV, int n, object data));; +extern char object_to_char GPR((object x));; +extern int object_to_int GPR((object x));; +extern float object_to_float GPR((object x));; +extern double object_to_double GPR((object x));; +extern char *object_to_string GPR((object x));; +extern int call_init GPR((int init_address, object memory, object fasl_vec));; +extern int do_init GPR((object *statVV));; +extern void init_or_load1 GPR((int (*fn) ( ), char *file));; + +/* for file conditional.X */ + +extern int Fif GPR((object form));; +extern int Fcond GPR((object args));; +extern int Fcase GPR((object arg));; +extern int Fwhen GPR((object form));; +extern int Funless GPR((object form));; +extern int init_conditional GPR((void));; + +/* for file earith.X */ + +extern int init_cmac GPR((void));; +extern object signed_bignum2 GPR((int hi, int lo));; +extern object fplus GPR((int a, int b));; +extern object fminus GPR((int a, int b));; +extern int dblrem GPR((int a, int b, int mod));; +extern object cmod GPR((object x));; +extern object ctimes GPR((object a, object b));; +extern object cdifference GPR((object a, object b));; +extern object cplus GPR((object a, object b));; +extern void siLcmod GPR((void));; +extern void siLcplus GPR((void));; +extern void siLctimes GPR((void));; +extern void siLcdifference GPR((void));; +extern object memq GPR((register object a, register object b));; + +/* for file error.X */ + +extern int terminal_interrupt GPR((int correctable));; +extern object ihs_function_name GPR((object x));; +extern object ihs_top_function_name GPR((void));; +extern int call_error_handler GPR((void));; +extern int FEerror GPR((char *s, int num, object arg1, object arg2, object arg3, object arg4));; +extern int FEwrong_type_argument GPR((object type, object value));; +extern int FEtoo_few_arguments GPR((object *base, object *top));; +extern int FEtoo_few_argumentsF GPR((object args));; +extern int FEtoo_many_arguments GPR((object *base, object *top));; +extern int FEtoo_many_argumentsF GPR((object args));; +extern int FEinvalid_macro_call GPR((void));; +extern int FEunexpected_keyword GPR((object key));; +extern int FEinvalid_form GPR((char *s, object form));; +extern int FEunbound_variable GPR((object sym));; +extern int FEinvalid_variable GPR((char *s, object obj));; +extern int FEundefined_function GPR((object fname));; +extern int FEinvalid_function GPR((object obj));; +extern int CEerror GPR((char *err_str, char *cont_str, int num, object arg1, object arg2, object arg3, object arg4));; +extern ihs_ptr get_ihs_ptr GPR((object x));; +extern int siLihs_top GPR((void));; +extern int siLihs_fun GPR((void));; +extern int siLihs_vs GPR((void));; +extern frame_ptr get_frame_ptr GPR((object x));; +extern int siLfrs_top GPR((void));; +extern int siLfrs_vs GPR((void));; +extern int siLfrs_bds GPR((void));; +extern int siLfrs_class GPR((void));; +extern int siLfrs_tag GPR((void));; +extern int siLfrs_ihs GPR((void));; +extern bds_ptr get_bds_ptr GPR((object x));; +extern int siLbds_top GPR((void));; +extern int siLbds_var GPR((void));; +extern int siLbds_val GPR((void));; +extern object *get_vs_ptr GPR((object x));; +extern int siLvs_top GPR((void));; +extern int siLvs GPR((void));; +extern int siLsch_frs_base GPR((void));; +extern int siLinternal_super_go GPR((void));; +extern int siLuniversal_error_handler GPR((void));; +extern int check_arg_failed GPR((int n));; +extern int too_few_arguments GPR((void));; +extern int too_many_arguments GPR((void));; +extern int ck_larg_at_least GPR((int n, object x));; +extern int ck_larg_exactly GPR((int n, object x));; +extern int invalid_macro_call GPR((void));; +extern int keyword_value_mismatch GPR((void));; +extern int not_a_keyword GPR((object x));; +extern int unexpected_keyword GPR((object key));; +extern object wrong_type_argument GPR((object typ, object obj));; +extern int illegal_declare GPR((int form));; +extern int not_a_symbol GPR((int obj));; +extern int not_a_variable GPR((int obj));; +extern int illegal_index GPR((object x, object i));; +extern int Lerror GPR((void));; +extern object LVerror GPR((int __builtin_va_alist));; +extern int Lcerror GPR((void));; +extern int vfun_wrong_number_of_args GPR((object x));; +extern int init_error GPR((void));; + +/* for file eval.X */ + +extern int quick_call_sfun GPR((object fun));; +extern int call_sfun_no_check GPR((object fun));; +extern int call_vfun GPR((object fun));; +extern int funcall GPR((object fun));; +extern int funcall_no_event GPR((object fun));; +extern int lispcall GPR((object *funp, int narg));; +extern int lispcall_no_event GPR((object *funp, int narg));; +extern int symlispcall GPR((object sym, object *base, int narg));; +extern int symlispcall_no_event GPR((object sym, object *base, int narg));; +extern object simple_lispcall GPR((object *funp, int narg));; +extern object simple_lispcall_no_event GPR((object *funp, int narg));; +extern object simple_symlispcall GPR((object sym, object *base, int narg));; +extern object simple_symlispcall_no_event GPR((object sym, object *base, int narg));; +extern int super_funcall GPR((object fun));; +extern int super_funcall_no_event GPR((object fun));; +extern int eval GPR((object form));; +extern int call_applyhook GPR((object fun));; +extern int Lfuncall GPR((void));; +extern int Lapply GPR((void));; +extern int Leval GPR((void));; +extern int Levalhook GPR((void));; +extern int Lapplyhook GPR((void));; +extern int Lconstantp GPR((void));; +extern object ieval GPR((object x));; +extern object ifuncall1 GPR((object fun, object arg1));; +extern object ifuncall2 GPR((object fun, object arg1, object arg2));; +extern object ifuncall3 GPR((object fun, object arg1, object arg2, object arg3));; +extern int funcall_with_catcher GPR((object fname, object fun));; +extern object fcalln_cclosure GPR((...));; +extern object fcalln_general GPR((...));; +extern object fcalln_vfun GPR((va_list vl));; +extern object fcalln GPR((int __builtin_va_alist));; +extern object funcall_cfun GPR((funcvoid fn, int n, int __builtin_va_alist));; +extern int init_eval GPR((void));; diff --git a/o/fasdump.c b/o/fasdump.c new file mode 100755 index 0000000..c5b1673 --- /dev/null +++ b/o/fasdump.c @@ -0,0 +1,1451 @@ + /* Copyright William F. Schelter All Rights Reserved. + + Utility for writing out lisp objects and reading them in: + Basically it attempts to write out only those things which could + be written out using princ and reread. It just uses less space + and is faster. + + + Primitives for dealing with a `fasd stream'. + Such a stream is really an array containing some state and a lisp file stream. + Note that having *print-circle* == nil wil make this faster. gensyms will + still be dumped correctly in that case. + + open_fasd + write_fasd_top + read_fasd_top + close_fasd + + */ + + + +#ifndef FAT_STRING +#include "include.h" +#endif + +static void +clrhash(object); + + +object coerce_stream(); +static object fasd_patch_sharp(object x, int depth); +object make_pathname (); + + +static int needs_patching; + +struct fasd current_fasd; + + +enum circ_ind { + LATER_INDEX, + NOT_INDEXED, + FIRST_INDEX, + }; + +enum dump_type { + d_nil, /* dnil: nil */ + d_eval_skip, /* deval o1: evaluate o1 after reading it */ + d_delimiter, /* occurs after d_list,d_general and d_new_indexed_items */ + d_enter_vector, /* d_enter_vector o1 o2 .. on d_delimiter , make a cf_data with + this length. Used internally by akcl. Just make + an array in other lisps */ + d_cons, /* d_cons o1 o2: (o1 . o2) */ + d_dot, + d_list, /* list* delimited by d_delimiter d_list,o1,o2, ... ,d_dot,on + for (o1 o2 . on) + or d_list,o1,o2, ... ,on,d_delimiter for (o1 o2 ... on) + */ + d_list1, /* nil terminated length 1 d_list1,o1 */ + d_list2, /* nil terminated length 2 */ + d_list3, + d_list4, + d_eval, + d_short_symbol, + d_short_string, + d_short_fixnum, + d_short_symbol_and_package, + d_bignum, + d_fixnum, + d_string, + d_objnull, + d_structure, + d_package, + d_symbol, + d_symbol_and_package, + d_end_of_file, + d_standard_character, + d_vector, + d_array, + d_begin_dump, + d_general_type, + d_sharp_equals, /* define a sharp */ + d_sharp_value, + d_sharp_value2, + d_new_indexed_item, + d_new_indexed_items, + d_reset_index, + d_macro, + d_reserve1, + d_reserve2, + d_reserve3, + d_reserve4, + d_indexed_item3, /* d_indexed_item3 followed by 3bytes to give index */ + d_indexed_item2, /* d_indexed_item2 followed by 2bytes to give index */ + d_indexed_item1, + d_indexed_item0 /* This must occur last ! */ + +}; + +/* set whole structures! */ +#define SETUP_FASD_IN(fd) do{ \ + fas_stream= (fd)->stream->sm.sm_fp; \ + dump_index = fix((fd)->index) ; \ + current_fasd= * (fd);}while(0) + +#define SAVE_CURRENT_FASD \ + struct fasd old_fd; \ + int old_dump_index = dump_index; \ + FILE *old_fas_stream = fas_stream; \ + int old_needs_patching = needs_patching; \ + old_fd = current_fasd; + + +#define RESTORE_FASD \ + current_fasd =old_fd ; \ + dump_index= old_dump_index ; \ + needs_patching = old_needs_patching ; \ + fas_stream = old_fas_stream + + +#define FASD_SHARP_LIMIT 250 /* less than short_max */ +#define SETUP_FASD_OUT(fasd) SETUP_FASD_IN(fasd) + +#define dump_hash_table (current_fasd.table) + +#define SIZE_D_CODE 8 +#define SIZE_BYTE 8 +#define SIZE_SHORT ((2*SIZE_BYTE) - SIZE_D_CODE) +/* this is not! the maximum short !! It is shorter */ +#define SHORT_MAX ((1<< SIZE_SHORT) -1) + + +/* given SHORT extract top code (say 4 bits) and bottom byte */ +#define TOP(i) (i >> SIZE_BYTE) +#define BOTTOM(i) (i & ~(~0UL << SIZE_BYTE)) + +#define FASD_VERSION 2 + +FILE *fas_stream; +int dump_index; +struct htent *gethash(); +static void read_fasd1(int i, object *loc); +object extended_read(); + +/* to enable debugging define the following, + and set debug=1 or debug=2 +*/ +/* #define DEBUG */ + +#ifdef DEBUG + +#define PUT(x) putc1((char)x,fas_stream) +#define GET() getc1() +#define D_FWRITE fwrite1 +#define D_FREAD fread1 + +char *dump_type_names[]={ "d_nil", + "d_eval_skip", + "d_delimiter", + "d_enter_vector", + "d_cons", + "d_dot", + "d_list", + "d_list1", + "d_list2", + "d_list3", + "d_list4", + "d_eval", + "d_short_symbol", + "d_short_string", + "d_short_fixnum", + "d_short_symbol_and_package", + "d_bignum", + "d_fixnum", + "d_string", + "d_objnull", + "d_structure", + "d_package", + "d_symbol", + "d_symbol_and_package", + "d_end_of_file", + "d_standard_character", + "d_vector", + "d_array", + "d_begin_dump", + "d_general_type", + "d_sharp_equals", + "d_sharp_value", + "d_sharp_value2", + "d_new_indexed_item", + "d_new_indexed_items", + "d_reset_index", + "d_macro", + "d_reserve1", + "d_reserve2", + "d_reserve3", + "d_reserve4", + "d_indexed_item3", + "d_indexed_item2", + "d_indexed_item1", + "d_indexed_item0"}; + +int debug; +int +print_op(i) +{if (debug) + {if (i < d_indexed_item0 & i >= 0) + {printf("\n<%s>",dump_type_names[i]);} + else {printf("\n",i -d_indexed_item0);}} + return i; +} + +#define PUTD(str,i) putd(str,i) +void +putd(str,i) +char *str; + int i; +{if (debug) + {printf("{"); + printf(str,i); + printf("}");} + putc(i,fas_stream);} + +void +putc1(x) +int x; +{ if (debug) printf("(%x,%d,%c)",x,x,x); + putc(x,fas_stream); + fflush(stdout); + } + +int +getc1() +{ int x; + x= getc(fas_stream); + if (debug) printf("(%x,%d,%c)",x,x,x); + fflush(stdout); + return x; + } + +int +fread1(p,n1,n2,st) + FILE* st; + char *p; + int n1; + int n2; +{int i,j; + j=SAFE_FREAD(p,n1,n2,st); + if(debug) + {printf("["); + n1=n1*n2; + for(i=0;i> (SIZE_D_CODE)) + /* takes two bytes and reconstructs the SIZE_SHORT int from them after + dropping the code */ + + +/* takes two bytes i and j and returns the SHORT associated */ +#define LENGTH(i,j) MAKE_SHORT(E_TYPE_OF(i),(j)) + +#define MAKE_SHORT(top,bot) (((top)<< SIZE_BYTE) + (bot)) + +#define READ_BYTE1() getc(fas_stream) + +#define GET8(varx ) \ + do{unsigned long long var=READ_BYTE1(); \ + var |= ((unsigned long long)READ_BYTE1() << SIZE_BYTE); \ + var |= ((unsigned long long)READ_BYTE1() << (2*SIZE_BYTE)); \ + var |= ((unsigned long long)READ_BYTE1() << (3*SIZE_BYTE)); \ + var |= ((unsigned long long)READ_BYTE1() << (4*SIZE_BYTE)); \ + var |= ((unsigned long long)READ_BYTE1() << (5*SIZE_BYTE)); \ + var |= ((unsigned long long)READ_BYTE1() << (6*SIZE_BYTE)); \ + var |= ((unsigned long long)READ_BYTE1() << (7*SIZE_BYTE)); \ + DPRINTF("{8byte:varx= %ld}", var); \ + varx=var;} while (0) + +#define GET4(varx ) \ + do{int var=READ_BYTE1(); \ + var |= (READ_BYTE1() << SIZE_BYTE); \ + var |= (READ_BYTE1() << (2*SIZE_BYTE)); \ + var |= (READ_BYTE1() << (3*SIZE_BYTE)); \ + DPRINTF("{4byte:varx= %d}", var); \ + varx=var;} while (0) + +#define GET2(varx ) \ + do{int var=READ_BYTE1(); \ + var |= (READ_BYTE1() << SIZE_BYTE); \ + DPRINTF("{2byte:varx= %d}", var); \ + varx=var;} while (0) + +#define GET3(varx ) \ + do{int var=READ_BYTE1(); \ + var |= (READ_BYTE1() << SIZE_BYTE); \ + var |= (READ_BYTE1() << (2*SIZE_BYTE)); \ + DPRINTF("{3byte:varx= %d}", var); \ + varx=var;} while (0) + + + +#define MASK ~(~0UL << 8) +#define WRITE_BYTEI(x,i) putc((((x) >> (i*SIZE_BYTE)) & MASK),fas_stream) + +#define PUTFIX(v_) Join(PUT,SIZEOF_LONG)(v_) +#define GETFIX(v_) Join(GET,SIZEOF_LONG)(v_) + +#define PUT8(varx ) \ + do{unsigned long long var= varx ; \ + DPRINTF("{8byte:varx= %ld}", var); \ + WRITE_BYTEI(var,0); \ + WRITE_BYTEI(var,1); \ + WRITE_BYTEI(var,2); \ + WRITE_BYTEI(var,3); \ + WRITE_BYTEI(var,4); \ + WRITE_BYTEI(var,5); \ + WRITE_BYTEI(var,6); \ + WRITE_BYTEI(var,7);} while(0) + +#define PUT4(varx ) \ + do{unsigned long var= varx ; \ + DPRINTF("{4byte:varx= %d}", var); \ + WRITE_BYTEI(var,0); \ + WRITE_BYTEI(var,1); \ + WRITE_BYTEI(var,2); \ + WRITE_BYTEI(var,3);} while(0) + +#define PUT2(var ) \ + do{unsigned long v=var; \ + DPRINTF("{2byte:var= %d}", v); \ + WRITE_BYTEI(v,0); \ + WRITE_BYTEI(v,1); \ + } while(0) + +#define PUT3(var ) \ + do{unsigned long v=var; \ + DPRINTF("{3byte:var= %d}", v); \ + WRITE_BYTEI(v,0); \ + WRITE_BYTEI(v,1); \ + WRITE_BYTEI(v,2); \ + } while(0) + + + + + /* constructs the first byte containing ecode and top + top either stands for something in extended codes, or for something + the top part of a SIZE_SHORT int + */ +#define MAKE_CODE(CODE,Top) \ + ((unsigned int)(CODE) | ((unsigned int)(Top) << SIZE_D_CODE)) + + +/* write out two bytes encoding the enum d_code CODE and SHORT SH. */ + + + +#define PUT_CODE_AND_SHORT(CODE,SH) \ + PUT(MAKE_CODE(CODE,TOP(SH))); \ + PUT(BOTTOM(SH)); + +#define READ_SYMBOL(leng,pack,to) \ + do { BEGIN_NO_INTERRUPT;{char *p=alloc_relblock(leng);\ + D_FREAD(p,1,leng,fas_stream); \ + string_register->st.st_fillp = \ + string_register->st.st_dim = leng; \ + string_register->st.st_self = p; \ + to=(pack==Cnil ? make_symbol(string_register) : intern(string_register,pack)); \ + END_NO_INTERRUPT;} \ + }while(0) + +#define READ_STRING(leng,loc) do {BEGIN_NO_INTERRUPT; \ + *loc = alloc_simple_string(leng); \ + (*loc)->st.st_self=alloc_relblock(leng); END_NO_INTERRUPT; \ +/* Now handled in SAFE_FREAD -- CM 20040210 */ \ +/* memset((*loc)->st.st_self,0,leng); */ /* fread won't restart if it triggers an SGC segfault -- CM */ \ + D_FREAD((*loc)->st.st_self,1,leng,fas_stream);} while(0) + +/* if try_hash finds it we don't need to write the object + Otherwise we write the index type and the object + */ +#define NUMBER_ZERO_ITEMS (SHORT_MAX - (int) d_indexed_item0) + + + +static enum circ_ind +do_hash(object obj, int dot) +{ struct htent *e; + int i; + e=gethash(obj,dump_hash_table); + if (e->hte_key==OBJNULL) +/* We won't index things unless they have < -2 in the hash table */ + { if(type_of(obj)!=t_package) return NOT_INDEXED; + sethash(obj,dump_hash_table,make_fixnum(dump_index)); + e=gethash(obj,dump_hash_table); + PUT_OP(d_new_indexed_item); + DPRINTF("{dump_index=%d}",dump_index); + dump_index++; + return FIRST_INDEX;} + + i = fix(e->hte_value); + if (i == -1) return NOT_INDEXED; /* don't want to index this baby */ + + if (dot) PUT_OP(dot); + if ( i < -1) + { e->hte_value = make_fixnum(dump_index); + PUT_OP(d_new_indexed_item); + DPRINTF("{dump_index=%d}",dump_index); + dump_index++; + return FIRST_INDEX; + } + if (i < (NUMBER_ZERO_ITEMS)) + {PUT_OP(i+(int)d_indexed_item0); return LATER_INDEX;} + if (i < (2*SHORT_MAX - (int)d_indexed_item0)) + {PUT_OP((int)d_indexed_item1); + PUTD("n=%d",i- NUMBER_ZERO_ITEMS); + return LATER_INDEX; + } + if (i < SHORT_MAX*SHORT_MAX) + {PUT_OP((int)d_indexed_item2); + PUT2(i); + return LATER_INDEX; + } + if (i < SHORT_MAX*SHORT_MAX*SHORT_MAX) + {PUT_OP((int)d_indexed_item3); + PUT3(i); + return LATER_INDEX; + } + else + FEerror("too large an index",0); + return LATER_INDEX; + } + +static void write_fasd(object obj); +DEFUN_NEW("WRITE-FASD-TOP",object,fSwrite_fasd_top,SI,2,2,NONE,OO,OO,OO,OO,(object obj, object x),"") +/* static object */ +/* FFN(write_fasd_top)(object obj, object x) */ +{struct fasd *fd = (struct fasd *) x->v.v_self; + if (fd->direction == sKoutput) + SETUP_FASD_IN(fd); + else FEerror("bad value for open slot of fasd",0); + + write_fasd(obj); + /* we could really allocate a fixnum and then smash its field if this + is to costly */ + (fd)->index = make_fixnum(dump_index); + return obj; +} + +/* It is assumed that anything passed to eval should be first + sharp patched, and that there will be no more patching afterwards. + The object returned might have arbitrary complexity. +*/ + +#define MAYBE_PATCH(result) \ + if (needs_patching) result =fasd_patch_sharp(result,0) + +DEFUN_NEW("READ-FASD-TOP",object,fSread_fasd_top,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") +/* static object */ +/* FFN(read_fasd_top)(object x) */ +{ struct fasd *fd = (struct fasd *) x->v.v_self; + VOL int e=0; + object result; + SAVE_CURRENT_FASD; + + SETUP_FASD_IN(fd); + + frs_push(FRS_PROTECT, Cnil); + if (nlj_active) { + e = TRUE; + goto L; + } + needs_patching=0; + if (current_fasd.direction == sKinput) + {read_fasd1(GET_OP(),&result); + MAYBE_PATCH(result); + (fd)->index = make_fixnum(dump_index); + fd->direction=current_fasd.direction; + + } + else + if(current_fasd.direction== Cnil) result= current_fasd.eof; + else + FEerror("Stream not open for input",0); + L: + + frs_pop(); + + if (e) { + nlj_active = FALSE; + unwind(nlj_fr, nlj_tag); + fd->direction=Cnil; + RESTORE_FASD; + return Cnil; + } + else + { RESTORE_FASD; + return result;} + } +#ifdef STATIC_FUNCTION_POINTERS +object +fSread_fasd_top(object x) { + return FFN(fSread_fasd_top)(x); +} +#endif + + +object sLeq; +object sSPinit; +void Lmake_hash_table(); + +DEFUN_NEW("OPEN-FASD",object,fSopen_fasd,SI,4,4,NONE,OO,OO,OO,OO,(object stream, object direction, object eof, object tabl),"") +/* static object */ +/* FFN(open_fasd)(object stream, object direction, object eof, object tabl) */ +{ object str=Cnil; + object result; + if(direction==sKinput) + {str=coerce_stream(stream,0); + if (tabl==Cnil) + tabl=alloc_simple_vector(0,aet_object); + else + check_type(tabl,t_vector);} + if(direction==sKoutput) + {str=coerce_stream(stream,1); + if(tabl==Cnil) tabl=gcl_make_hash_table(sLeq); + else + check_type(tabl,t_hashtable);} + massert(str==stream); + result=alloc_simple_vector(sizeof(struct fasd)/sizeof(object),aet_object); + array_allocself(result,1,Cnil); + {struct fasd *fd= (struct fasd *)result->v.v_self; + fd->table=tabl; + fd->stream=stream; + fd->direction=direction; + fd->eof=eof; + fd->index=small_fixnum(0); + fd->package=symbol_value(sLApackageA); + fd->filepos = make_fixnum(ftell(stream->sm.sm_fp)); + + SETUP_FASD_IN(fd); + if (direction==sKoutput){ + PUT_OP((int)d_begin_dump); + PUTD("version=%d",FASD_VERSION); + PUT4(0); /* reserve space for the size of index array needed */ + /* equivalent to: write_fasd(current_fasd.package); + except we don't want to index this, so that we can open + with an empty array. + */ + PUT_OP(d_package); + write_fasd(current_fasd.package->p.p_name); + + } + else /* input */ + { object tem; + read_fasd1(GET_OP(),&tem); + if(tem!=current_fasd.table) FEerror("not positioned at beginning of a dump",0); + } + fd->index=make_fixnum(dump_index); + fd->filepos=current_fasd.filepos; + fd->package=current_fasd.package; + fd->table_length=current_fasd.table_length; + return result; + }} +#ifdef STATIC_FUNCTION_POINTERS +object +fSopen_fasd(object stream, object direction, object eof, object tabl) { + return FFN(fSopen_fasd)(stream,direction,eof,tabl); +} +#endif + +DEFUN_NEW("CLOSE-FASD",object,fSclose_fasd,SI,1,1,NONE,OO,OO,OO,OO,(object ar),"") +/* static object */ +/* FFN(close_fasd)(object ar) */ +{ struct fasd *fd= (struct fasd *)(ar->v.v_self); + check_type(ar,t_vector); + if (type_of(fd->table)==t_vector) + /* input uses a vector */ + {if (fd->table->v.v_self) + gset(fd->table->v.v_self,0,fix(fd->index),aet_object); + } + else + if(fd->direction==sKoutput) + {clrhash(fd->table); + SETUP_FASD_IN(fd); + PUT_OP(d_end_of_file); + {int i = ftell(fd->stream->sm.sm_fp); + if(type_of(fd->filepos) == t_fixnum) + { fseek(fd->stream->sm.sm_fp,fix(fd->filepos)+2,SEEK_SET); + /* record the length of array needed to read the indices */ + PUT4(fix(fd->index)); + /* move back to where we were */ + fseek(fd->stream->sm.sm_fp,i,SEEK_SET); + }} + + } + /* else FEerror("bad fasd stream",0); */ + fd->direction=Cnil; + return ar; + + } +#ifdef STATIC_FUNCTION_POINTERS +object +fSclose_fasd(object ar) { + return FFN(fSclose_fasd)(ar); +} +#endif + + +#define HASHP(x) 1 +#define TRY_HASH \ + if(do_hash(obj,0)==LATER_INDEX) return; + +static void +write_fasd(object obj) +{ fixnum j,leng; + + /* hook for writing other data in fasd file */ + + + + /* check if we have already output the object in a hash table. + If so just record the index */ + { + /* if dump_index is too large or the object has not been written before + we output it now */ + + switch(type_of(obj)){ + + case DP(t_cons:) + TRY_HASH; + + /* decide how long we think this list is */ + + {object x=obj->c.c_cdr; + int l=0; + if (obj->c.c_car == siSsharp_comma) + { PUT_OP(d_eval); + write_fasd(x); + break;} + while(1) + { if(x==Cnil) + {PUT_OP(d_list1+l); + break;} + if(type_of(x)==t_cons) + {if ((int) d_list1 + ++l > (int) d_list4) + {PUT_OP(d_list); + break;} + else {x=x->c.c_cdr; + continue;}} + /* 1 to 4 done */ + if(l==0) + {PUT_OP(d_cons); + write_fasd(obj->c.c_car); + write_fasd(obj->c.c_cdr); + return;} + else + {PUT_OP(d_list); + break; + }}} + + /* WRITE_LIST: */ + + write_fasd(obj->c.c_car); + obj=obj->c.c_cdr; + {int l=0; + while(1) + {if (type_of(obj)==t_cons) + { enum circ_ind is_indexed=LATER_INDEX; + if(HASHP(t_cons)){ + is_indexed=do_hash(obj,d_dot); + if (is_indexed == LATER_INDEX) + return; + if (is_indexed==FIRST_INDEX) + { PUT_OP(d_cons); + write_fasd(obj->c.c_car); + write_fasd(obj->c.c_cdr); + return;}} + write_fasd(obj->c.c_car); + l++; + obj=obj->c.c_cdr;} + else + if(obj==Cnil) + {if (l> ((int) d_list4- (int) d_list1)) + {PUT_OP(d_delimiter);} + return;} + else + {PUT_OP(d_dot); + write_fasd(obj); + return;}}} + + case DP(t_symbol:) + + if (obj==Cnil) + {PUT_OP(d_nil); return;} + TRY_HASH; + leng=obj->s.s_fillp; + if (current_fasd.package!=obj->s.s_hpack) + {{ + if (leng< SHORT_MAX) + {PUT_OP(d_short_symbol_and_package); + PUTD("leng=%d",leng);} + else + { j=leng; + PUT_OP(d_symbol_and_package); + PUT4(j);}} + + write_fasd(obj->s.s_hpack);} + else + { if (leng< SHORT_MAX) + { PUT_OP(d_short_symbol); + PUTD("leng=%d",leng);} + else + { j=leng; + PUT_OP(d_symbol); + PUT4(j);} + } + D_FWRITE(obj->s.s_self,1,leng,fas_stream); + break; + case DP(t_fixnum:) + leng=fix(obj); + if ((leng< (SHORT_MAX/2)) + && (leng > -(SHORT_MAX/2))) + {PUT_OP(d_short_fixnum); + PUTD("leng=%d",leng);} + else + {PUT_OP(d_fixnum); + j=leng; + PUTFIX(j);} + break; + case DP(t_character:) + PUT_OP(d_standard_character); + PUTD("char=%c",char_code(obj)); + break; + case DP(t_string:) + leng=(obj)->st.st_fillp; + if (leng< SHORT_MAX) + {PUT_OP(d_short_string); + PUTD("leng=%d",leng);} + else + {j=leng; + PUT_OP(d_string); + PUT4(j);} + D_FWRITE(obj->st.st_self,1,leng,fas_stream); + break; + case DP(t_bignum:) + PUT_OP(d_bignum); +#ifdef GMP + {int l = MP(obj)->_mp_size; + int m = (l >= 0 ? l : -l); + + mp_limb_t *u = MP(obj)->_mp_d; + /* fix this */ + /* if (sizeof(mp_limb_t) != 4) { FEerror("fix for gmp",0);} */ + PUT4(l); + while (-- m >=0) { +#if MP_LIMB_BYTES == 8 + PUT8(*u); +#elif MP_LIMB_BYTES == 4 + PUT4(*u); +#else +#error Bad MP_LIMB_BYTES +#endif + u++; + } + break;} +#else + {int l = obj->big.big_length; + plong *u = obj->big.big_self; + PUT4(l); + while (-- l >=0) + {PUT4(*u) ; u++;} + break;} +#endif + case DP(t_package:) + TRY_HASH; + PUT_OP(d_package); + write_fasd(obj->p.p_name); + break; + case DP(t_structure:) + + TRY_HASH; + {int narg=S_DATA(obj->str.str_def)->length; + int i; + object name= S_DATA(obj->str.str_def)->name; + if(narg >= SHORT_MAX) + FEerror("Only dump structures whose length < ~a",1,make_fixnum(SHORT_MAX)); + PUT_OP(d_structure); + PUTD("narg=%d",narg); + write_fasd(name); + for (i = 0; i < narg; i++) + write_fasd(structure_ref(obj,name,i));} + + break; + + case DP(t_array:) + TRY_HASH; + PUT_OP(d_array); + { int leng=obj->a.a_dim; + int i; + PUT4(leng); + PUTD("elttype=%d",obj->a.a_elttype); + PUTD("rank=%d",obj->a.a_rank); + {int i; + if (obj->a.a_rank > 1) + { + for (i=0; ia.a_rank ; i++) + PUT4(obj->a.a_dims[i]);}} + for(i=0; i< leng ; i++) + write_fasd(aref(obj,i));} + break; + + case DP(t_vector:) + TRY_HASH; + PUT_OP(d_vector); + { int leng=obj->v.v_fillp; + PUT4 (leng); + PUTD("eltype=%d",obj->v.v_elttype); + {int i; + for(i=0; i< leng ; i++) + {write_fasd(aref(obj,i));}}} + break; + + + default: + PUT_OP(d_general_type); + prin1(obj,current_fasd.stream); + PUTD("close general:%c",')'); + + }} + } + + +static void +fasd_patch_sharp_cons(object x, int depth) +{ + for (;;) { + x->c.c_car = fasd_patch_sharp(x->c.c_car,depth+1); + if (type_of(x->c.c_cdr) == t_cons) + x = x->c.c_cdr; + else { + x->c.c_cdr = SAFE_CDR(fasd_patch_sharp(x->c.c_cdr,depth+1)); + break; + } + } +} + +static object +fasd_patch_sharp(object x, int depth) +{ + cs_check(x); + if (++depth > 1000) + { object *p = current_fasd.table->v.v_self; + while(*p) + { if (x== *p++ && type_of(x)!=t_spice) return x;}} + /* eval'd forms are already patched, and they might contain + circular structure */ + { object p = current_fasd.evald_items; + while (p != Cnil) + { if (p->c.c_car == x) return x; + p = p->c.c_cdr;}} + + switch (type_of(x)) { + case DP(t_spice:) + { if (x->spc.spc_dummy >= current_fasd.table->v.v_dim) + FEerror("bad spice ref",0); + return current_fasd.table->v.v_self[x->spc.spc_dummy ]; + + } + case DP(t_cons:) + /* + x->c.c_car = fasd_patch_sharp(x->c.c_car,depth); + x->c.c_cdr = fasd_patch_sharp(x->c.c_cdr,depth); + */ + fasd_patch_sharp_cons(x,depth); + break; + + case DP(t_vector:) + { + int i; + + if ((enum aelttype)x->v.v_elttype != aet_object) + break; + + for (i = 0; i < x->v.v_fillp; i++) + x->v.v_self[i] = fasd_patch_sharp(x->v.v_self[i],depth); + break; + } + case DP(t_array:) + { + int i, j; + + if ((enum aelttype)x->a.a_elttype != aet_object) + break; + + for (i = 0, j = 1; i < x->a.a_rank; i++) + j *= x->a.a_dims[i]; + for (i = 0; i < j; i++) + x->a.a_self[i] = fasd_patch_sharp(x->a.a_self[i],depth); + break; + } + case DP(t_structure:) + {object def = x->str.str_def; + int i; + i=S_DATA(def)->length; + while (i--> 0) + structure_set(x,def,i,fasd_patch_sharp(structure_ref(x,def,i),depth)); + break; + + } + default: + /* dont have to walk other objs */ + break; + + } + return(x); +} + +object sharing_table; + +DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") { + sharing_table=table; + travel_find_sharing(x,table); + return Ct; +} + +/* static object */ +/* read_fasd(int i) */ +/* {object tem; */ +/* read_fasd1(i,&tem); */ +/* return tem;} */ + + + /* I am not sure if saving vs_top,vs_base is necessary */ +static object +lisp_eval(object x) +{ object *b,*t; + SAVE_CURRENT_FASD; + b=vs_base; + t=vs_top; + vs_base=vs_top; + vs_push(x); + Leval(); + x=vs_base[0]; + vs_base=b; + vs_top=t; + RESTORE_FASD; + return x; + } + + + +#define CHECK_CH(i) do{if ((i)==EOF && feof(fas_stream)) bad_eof();}while (0) +/* grow vector AR of general type */ +static void +grow_vector(object ar) +{ int len=ar->v.v_dim; + int nl=(int) (1.5*len); + {BEGIN_NO_INTERRUPT; + {char *p= (char *)AR_ALLOC(alloc_contblock,nl,object); + bcopy(ar->v.v_self,p,sizeof(object)* len); + ar->v.v_self= (object *)p; + ar->v.v_dim= ar->v.v_fillp=nl; + while(--nl >=len) + ar->v.v_self[nl]=Cnil; + END_NO_INTERRUPT;}} + } + +static void +bad_eof(void) +{ FEerror("Unexpected end of file",0);} + + + +/* read one starting with byte i into location loc */ +static void +read_fasd1(int i, object *loc) +{ object tem; + int leng; + BEGIN: + CHECK_CH(i); + switch(D_TYPE_OF(i)) + {case DP(d_nil:) + *loc=Cnil;return; + case DP(d_cons:) + read_fasd1(GET_OP(),&tem); + collect(loc,make_cons(tem,Cnil)); + i=GET_OP(); + goto BEGIN; + case DP(d_list1:) i=1;goto READ_LIST; + case DP(d_list2:) i=2;goto READ_LIST; + case DP(d_list3:) i=3;goto READ_LIST; + case DP(d_list4:) i=4;goto READ_LIST; + case DP(d_list:) i=(1<<30) ; goto READ_LIST; + + READ_LIST: + while(1) + {int j; + if (--i < 0) {*loc=Cnil; return;} + j=GET_OP(); + CHECK_CH(j); + if (j==d_delimiter) + {*loc=Cnil; + DPRINTF("{Read end of list(%d)}",i); + return;} + else + if(j==d_dot) + { DPRINTF("{Read end of dotted list(%d)}",i); + read_fasd1(GET_OP(),loc); + + return;} + else + {object tem; + DPRINTF("{Read next item in list(%d)}",i); + read_fasd1(j,&tem); + DPRINTF("{Item=",(debug >= 2 ? pp(tem) : 0)); + DPRINTF("}",0); + collect(loc,make_cons(tem,Cnil));}} + + case DP(d_delimiter:) + case DP(d_dot:) + FEerror("Illegal op at top level",0); + break; + case DP(d_eval_skip:) + read_fasd1(GET_OP(),loc); + MAYBE_PATCH(*loc); + lisp_eval(*loc); + read_fasd1(GET_OP(),loc); + break; + + case d_reserve1: + case d_reserve2: + case d_reserve3: + case d_reserve4: + + FEerror("Op reserved for future use",0); + break; + + case DP(d_reset_index:) + dump_index=0; + break; + + case DP(d_short_symbol:) + leng=GETD("leng=%d"); + leng = LENGTH(i,leng); + READ_SYMBOL(leng,current_fasd.package,tem); + *loc=tem; + return ; + case DP(d_short_symbol_and_package:) + {object pack; + leng=GETD("leng=%d"); + leng = LENGTH(i,leng); + read_fasd1(GET_OP(),&pack); + READ_SYMBOL(leng,pack,tem); + *loc=tem; + return;} + case DP(d_short_string:) + leng=GETD("leng=%d"); + leng = LENGTH(i,leng); + READ_STRING(leng,loc); + return; + case DP(d_string:) + {int j; + GET4(j); + READ_STRING(j,loc); + return;} + + case DP(d_indexed_item3:) + GET3(i);goto INDEXED; + case DP(d_indexed_item2:) + GET2(i);goto INDEXED; + case DP(d_indexed_item1:) + i=GET()+ NUMBER_ZERO_ITEMS ; goto INDEXED; + default: + case DP(d_indexed_item0:) + i = i - (int) d_indexed_item0; goto INDEXED; + + INDEXED: + + *loc= current_fasd.table->v.v_self[i]; + /* if object not yet built make pointer to it */ + if(*loc==0) + {*loc=current_fasd.table->v.v_self[i]= alloc_object(t_spice); + (*loc)->spc.spc_dummy= i; + needs_patching=1;} + return; + + /* the item`s' case does not return a value but is simply + a facility to allow convenient dumping of a list of registers + at the beginning, follwed by a delimiter. read continues on. */ + + case DP(d_new_indexed_items:) + case DP(d_new_indexed_item:) + + { + int cindex,k; + k=GET_OP(); + MORE: + cindex =dump_index; + DPRINTF("{dump_index=%d}",dump_index); + if (dump_index >= current_fasd.table->v.v_dim) + grow_vector(current_fasd.table); + /* grow the array */ + current_fasd.table->v.v_self[dump_index++] = 0; + read_fasd1(k,loc); + current_fasd.table->v.v_self[cindex] = *loc; + + if (i==d_new_indexed_items) + {int k=GET_OP(); + if (k==d_delimiter) + { DPRINTF("{Reading last of new indexed items}",0); + read_fasd1(GET_OP(),loc); + return;} + else { + goto MORE; + }} + return; + } + case DP(d_short_fixnum:) + {int leng=GETD("n=%d"); + if (leng & (1 << (SIZE_SHORT -1))) + leng= leng - (1 << (SIZE_SHORT)); + *loc=SAFE_CDR(make_fixnum(leng)); + return;} + + case DP(d_fixnum:) + {fixnum j; + GETFIX(j); + *loc=SAFE_CDR(make_fixnum(j)); + return;} + case DP( d_bignum:) + {int j,m; + object tem; + mp_limb_t *u; + GET4(j); +#ifdef GMP + tem = new_bignum(); + m = (j >= 0 ? j : -j); + _mpz_realloc(MP(tem),m); + MP(tem)->_mp_size = j; + j = m; + u = MP(tem)->_mp_d; +#else + { BEGIN_NO_INTERRUPT; + tem = alloc_object(t_bignum); + tem->big.big_length = j; + tem-> big.big_self = 0; + u = tem-> big.big_self = (plong *) alloc_relblock(j*sizeof(plong)); + END_NO_INTERRUPT; + } + +#endif + while ( --j >=0) { +#if MP_LIMB_BYTES == 8 + GET8(*u); +#elif MP_LIMB_BYTES == 4 + GET4(*u); +#else +#error Bad MP_LIMB_BYTES +#endif + u++; + } + *loc=tem; return;} + case DP(d_objnull:) + + *loc=0; return; + + case DP(d_structure:) + { int narg,i; + object name; + narg=GETD("narg=%d"); + read_fasd1(GET_OP(),& name); + { object *base=vs_top; + object *p = base; + vs_base=base; + vs_top = base + 1 + narg; + *p++ = name; + for (i=0; i < narg ; i++) + read_fasd1(GET_OP(),p++); + vs_base=base; + vs_top = p; + siLmake_structure(); + *loc = vs_base[0]; + vs_top=vs_base=base; + return; + }} + + case DP(d_symbol:) + {int i; object tem; + GET4(i); + READ_SYMBOL(i,current_fasd.package,tem); + *loc=tem; + return ;} + case DP(d_symbol_and_package:) + {int i; object pack; + GET4(i); + read_fasd1(GET_OP(),&pack); + READ_SYMBOL(i,pack,*loc); + return;} + case DP(d_package:) + {object pack,tem; + read_fasd1(GET_OP(),&tem); + pack=find_package(tem); + if (pack==Cnil) FEerror("The package named ~a, does not exist",1,tem); + *loc=pack; + return ;} + case DP(d_standard_character:) + *loc=(code_char(GETD("char=%c"))); + return; + case DP(d_vector:) + {int leng,j; + object y; + object x=alloc_object(t_vector); + GET4(leng); + x->v.v_elttype = GETD("v_elttype=%d"); + x->v.v_dim=x->v.v_fillp=leng; + x->v.v_self=0; + x->v.v_displaced=Cnil; + x->v.v_hasfillp=x->v.v_adjustable=0; + array_allocself(x,0,Cnil); + for (j=0; j< leng ; j++) + { DPRINTF("{vector_elt=%d}",j); + read_fasd1(GET_OP(),&y); + aset(x,j,y);} + *loc=x; + DPRINTF("{End of length %d vector}",leng); + return;} + + + case DP(d_array:) + {BEGIN_NO_INTERRUPT; + + {int leng,i; + object y; + object x=alloc_object(t_array); + GET4(leng); + + x->a.a_elttype = GETD("a_elttype=%d"); + x->a.a_dim=leng; + x->a.a_rank= GETD("a_rank=%d"); + x->a.a_self=0; + x->a.a_displaced=Cnil; + x->a.a_adjustable=0; + if (x->a.a_rank > 0) + { x->a.a_dims = (int *)alloc_relblock(sizeof(int)*(x->a.a_rank)); } + for (i=0; i< x->a.a_rank ; i++) + GET4(x->a.a_dims[i]); + array_allocself(x,0,Cnil); + END_NO_INTERRUPT; + for (i=0; i< leng ; i++) + { read_fasd1(GET_OP(),&y); + aset(x,i,y);} + *loc=x; + return;}} + + case DP(d_end_of_file:) + current_fasd.direction =Cnil; + *loc=current_fasd.eof; + return; + + case DP(d_begin_dump:) + {int vers=GETD("version=%d"); + if(vers!=FASD_VERSION) { + object x,x1; + x=make_fixnum(vers); + x1=make_fixnum(FASD_VERSION); + FEerror("This file was dumped with FASD version ~a not ~a.", + 2,x,x1);}} + {int leng; + GET4(leng); + current_fasd.table_length=make_fixnum(leng);} + read_fasd1(GET_OP(),&tem); + if (type_of(tem)==t_package || tem==Cnil) + {current_fasd.package = tem; + *loc=current_fasd.table;} + else FEerror("expected package",0); + return; + + case DP(d_general_type:) + *loc=read_object_non_recursive(current_fasd.stream); + if(GETD("close general:%c")!=')') FEerror("general type not followed by ')'",0); + return; + + + /* Special type, the forms have been sharp patched separately + It is also arranged that it does not + */ + + case DP(d_enter_vector:) + { + extern object sSPmemory; + int print_only=0; + int n = 0; + object vv = sSPmemory->s.s_dbind,tem; + if (vv == Cnil) print_only = 1; + else + if (type_of(vv)!=t_cfdata) FEerror("bad VectorToEnter",0); + while ((i=GET_OP()) !=d_delimiter) + {int eval=(i==d_eval_skip); + if (print_only) + { if (eval) princ_str("#!",Ct); + else if (i== d_eval) + princ_str("#.",Ct);} + if(eval) i=GET_OP(); + read_fasd1(i, &tem); + MAYBE_PATCH(tem); + /* the eval entries don't enter it */ + + if (print_only) {princ(tem,Ct); + princ_str(";",Ct); + princ(make_fixnum(n),Ct); + if (eval==0) n++; + princ_str("\n",Ct);} + else + { + if(eval) + lisp_eval(tem); + else + {if (n >= vv->cfd.cfd_fillp) FEerror("cfd too small",0); + vv->cfd.cfd_self[n++]=tem;}}} + if (print_only==0) vv->cfd.cfd_fillp = n; + *loc=vv; + return; + } + + case DP(d_eval:) + {object tem; + read_fasd1(GET_OP(),&tem); + MAYBE_PATCH(tem); + *loc = lisp_eval(tem); + current_fasd.evald_items = make_cons(*loc,current_fasd.evald_items); + return; + } + + }} + +static void +clrhash(object table) +{int i; + if (table->ht.ht_nent > 0 ) + for(i = 0; i < table->ht.ht_size; i++) { + table->ht.ht_self[i].hte_key = OBJNULL; + table->ht.ht_self[i].hte_value = OBJNULL;} + table->ht.ht_nent =0;} + +object IfaslInStream; +/* static void */ +/* IreadFasdData(void) */ + + /* While executing this the siPMemory should be bound to the cfdata + and the sSPinit to a vector of addresses. */ +/* {object ar=open_fasd(IfaslInStream,sKinput,0,Cnil); */ +/* int n=fix(current_fasd.table_length); */ +/* object result; */ +/* {BEGIN_NO_INTERRUPT; */ +/* #ifdef HAVE_ALLOCA */ +/* current_fasd.table->v.v_self */ +/* = (object *)alloca(n*sizeof(object)); */ +/* #else */ +/* current_fasd.table->v.v_self */ +/* = (object *)alloc_relblock(n*sizeof(object)); */ +/* #endif */ +/* current_fasd.table->v.v_dim=n; */ +/* current_fasd.table->v.v_fillp=n; */ +/* gset( current_fasd.table->v.v_self,0,n,aet_object); */ +/* END_NO_INTERRUPT; */ +/* } */ +/* result=read_fasd_top(ar); */ + /* make sure there is nothing still pointing into the stack */ +/* current_fasd.table->v.v_self = 0; */ +/* current_fasd.table->v.v_dim=0; */ +/* current_fasd.table->v.v_fillp=0; */ + +/* } */ + + + + +static void +init_fasdump(void) +{ +/* make_si_sfun("READ-FASD-TOP",read_fasd_top,1); */ +/* make_si_sfun("WRITE-FASD-TOP",write_fasd_top,2); */ +/* make_si_sfun("OPEN-FASD",open_fasd,4); */ +/* make_si_sfun("CLOSE-FASD",close_fasd,1); */ +/* /\* make_si_sfun("FASD-I-DATA",fasd_i_macro,1); *\/ */ +/* make_si_sfun("FIND-SHARING-TOP",find_sharing_top,2); */ +} diff --git a/o/fasldlsym.c b/o/fasldlsym.c new file mode 100755 index 0000000..7967e4b --- /dev/null +++ b/o/fasldlsym.c @@ -0,0 +1,118 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + + +#include +#include +#include +#include +#include +#ifdef HAVE_AOUT +#include HAVE_AOUT +#endif +#if defined(HAVE_ELF_H) +#include +#elif defined(HAVE_ELF_ABI_H) +#include +#endif + +struct name_list { + struct name_list *next; + char name[1]; +}; +static struct name_list *loaded_files; + +static void +unlink_loaded_files(void) { + + while(loaded_files) { + unlink(loaded_files->name); + loaded_files= loaded_files->next; + } + +} + +int +fasload(object faslfile) { + + void *dlp ; + int (*fptr)(); + char buf[MAXPATHLEN],b[MAXPATHLEN],filename[MAXPATHLEN]; + static int count; + object memory,data,faslstream; + struct name_list *nl; + object x; + + bzero(buf,sizeof(buf)); /*GC partial stack hole closing*/ + bzero(b,sizeof(b)); + bzero(filename,sizeof(filename)); + + /* this is just to allow reloading in the same file twice. + */ + coerce_to_filename(truename(faslfile), filename); + if (!count) + count=time(0); + massert(snprintf(buf,sizeof(buf),"/tmp/ufas%dxXXXXXX",count++)>0); + massert(mkstemp(buf)>=0); + + massert((nl=(void *) malloc(strlen(buf)+1+sizeof(nl)))); + massert(loaded_files || !atexit(unlink_loaded_files)); + nl->next = loaded_files; + loaded_files = nl; + strcpy(nl->name,buf); + + faslstream = open_stream(faslfile, smm_input, Cnil, sKerror); + massert(snprintf(b,sizeof(b),"cc -shared %s -o %s",filename,buf)>0); + massert(!psystem(b)); + + if (!(dlp = dlopen(buf,RTLD_NOW))) { + emsg(dlerror()); + FEerror("Cannot open for dynamic link ~a",1,make_simple_string(filename)); + } + + + x=find_init_name1(buf,0); + massert(x->st.st_fillp+1st.st_self,x->st.st_fillp); + b[x->st.st_fillp]=0; + if (!(fptr=dlsym(dlp,b))) { + emsg(dlerror()); + FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(filename)); + } + + SEEK_TO_END_OFILE(faslstream->sm.sm_fp); + + data = read_fasl_vector(faslstream); + memory=new_cfdata(); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf(" start address (dynamic) %p ",fptr); + + call_init(0,memory,data,fptr); + + unlink(buf); + close_stream(faslstream); + + return memory->cfd.cfd_size; + +} + +#include "sfasli.c" diff --git a/o/fasldlsym.c.link b/o/fasldlsym.c.link new file mode 100755 index 0000000..e337d43 --- /dev/null +++ b/o/fasldlsym.c.link @@ -0,0 +1,73 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + + +#include +#ifdef HAVE_ELF +#include +#endif + +/* cc -DVOL=volatile -G 0 -c foo.c ; ld -shared foo.o -o jim.o ; cat foo.data >> jim.o */ +int did_a_dynamic_load; + +fasload(faslfile) + object faslfile; +{ void *dlp ; + int (*fptr)(); + char buf[200]; + static count=0; + object memory; + object data; + char filename[MAXPATHLEN]; + coerce_to_filename(truename(faslfile), filename); + sprintf(buf,"./ufas%dxXXXXXX",count++); + /* this is just to allow reloading in the same file twice. + */ + mktemp(buf); + link(filename,buf); + dlp = dlopen(buf,RTLD_NOW); + if (dlp ==0) + FEerror("Cant open for dynamic link ~a",1,faslfile); + fptr = (int (*)())dlsym(dlp, "init_code"); + if (fptr == 0) + { FEerror("Cant find init_code in ~a",1,make_simple_string(faslfile));} + faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + SEEK_TO_END_OFILE(faslfile->sm.sm_fp); + data = read_fasl_vector(faslfile); + memory = alloc_object(t_cfdata); + memory->cfd.cfd_self = NULL; + memory->cfd.cfd_start = NULL; + memory->cfd.cfd_size = 0; + if(symbol_value(sLAload_verboseA)!=Cnil) + printf(" start address (dynamic) 0x%x ",fptr); + call_init(0,memory,data,fptr); + /* unlink(buf); */ + did_a_dynamic_load = 1; + return memory->cfd.cfd_size; +} + + + + + + + + diff --git a/o/faslhp800.c b/o/faslhp800.c new file mode 100755 index 0000000..1ffa36f --- /dev/null +++ b/o/faslhp800.c @@ -0,0 +1,163 @@ +/* round up i to be a multiple of (n) */ +#define ROUND_UP(i,n) ((((int) (i) + n-1)/(n)) *(n)) + +#define MAXPATHLEN 512 +int init_address = 0; + +#ifdef HPUX_SOM +#include + + +#define GET_HEADERS(fp) \ + struct header hdr; \ + struct som_exec_auxhdr somhdr; \ + if (sizeof(hdr) !=fread(&hdr,1,sizeof(hdr),fp)) \ + {FEerror("could not read header",0);} \ + if (hdr.aux_header_size) \ + {fseek(fp,hdr.aux_header_location,0); \ + if (sizeof(somhdr) != fread(&somhdr,1,sizeof(somhdr),fp)) \ + {FEerror("could not read header",0);}} \ + else { somhdr.exec_tsize=0;somhdr.exec_dsize=0;somhdr.exec_bsize=0;} + + + +#define SET_TOTAL_SPACE(total,fp) \ + total= ROUND_UP(somhdr.exec_tsize,sizeof(double)) \ + + somhdr.exec_dsize + somhdr.exec_bsize;\ + +#define READ_FASL_TO_MEMORY(memory,fp) \ +do{ char *p = memory->cfd.cfd_start; \ + init_address = ((char *)somhdr.exec_entry - p); \ + if (init_address > 1000) printf("entry is offset at %x(%d)",init_address); \ + fseek(fp,somhdr.exec_tfile,0) ; \ + fread(p,1,somhdr.exec_tsize,fp); \ + fseek(fp,somhdr.exec_dfile,0) ; \ + if ((int)(p + *data_off) != somhdr.exec_dmem) \ + FEerror("bad data offset",0);\ + fread(p+ *data_off,1, \ + somhdr.exec_dsize,fp); \ +}while(0) + +#define TXT_ALIGN 4096 + +#undef BSD +#endif + + +#ifdef BSD +#include +#define GET_HEADERS(fp) \ + struct exec hdr; fseek(fp,0,0);\ + fread(&hdr,1,sizeof(hdr),fp); \ +#define SET_TOTAL_SPACE(total,fp) \ + total = hdr.a_txtsize + hdr.a_datasize + header.a_bss; +#define READ_FASL_TO_MEMORY(memory,fp) \ + fseek(fp,sizeof(struct header) ,0); \ + fread(memory->cfd.cfd_start,1,memory->cfd.cfd_size,fp); \ + +#endif + + + + +read_text_and_data(memory,fp,data_off) + object memory; + FILE *fp; + int *data_off; +{ int total; + GET_HEADERS(fp); + SET_TOTAL_SPACE(total,fp); + *data_off = ROUND_UP(somhdr.exec_tsize,sizeof(double)); + if (total > memory->cfd.cfd_size) + { memory->cfd.cfd_size = total; return 0;} + + READ_FASL_TO_MEMORY(memory,fp); + return 1; +} + +#ifndef TXT_ALIGN +#define TXT_ALIGN sizeof(double) +#endif + +static +fasload_help(faslfile,lib_string) +object faslfile; +char *lib_string; +{ char filename[MAXPATHLEN],tmpfile[MAXPATHLEN]; + char command [2*MAXPATHLEN]; + int total; + object memory ; + FILE *fp; + + faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + fp = faslfile->sm.sm_fp; + + + { int data_off = 0; + GET_HEADERS(fp); + SET_TOTAL_SPACE(total,fp); + memory=alloc_object(t_cfdata); + memory->cfd.cfd_self = 0; + memory->cfd.cfd_start = 0; + memory->cfd.cfd_size = total; + sprintf(tmpfile,"/tmp/fasl%d",getpid()); + + AGAIN: + + memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, + memory->cfd.cfd_size,TXT_ALIGN); + + + coerce_to_filename(faslfile, filename); + LD_COMMAND(command, + kcl_self, + memory->cfd.cfd_start, + filename, + (lib_string ? lib_string : " "), + tmpfile); + if (system(command) != 0) + { FEerror("The linkage editor failed.", 0);} + if(symbol_value(sLAload_verboseA)==sLAload_verboseA) + { printf("%s\n",command); fflush(stdout);} + + {FILE *fp1 = fopen(tmpfile,"r"); + if (fp1==0) {FEerror("Couldn't open tmpfile",0);} + if(read_text_and_data(memory,fp1,&data_off) ==0) + {fclose(fp1); goto AGAIN;} + fclose(fp1); + }} + unlink(tmpfile); + SEEK_TO_END_OFILE(fp); + call_init(init_address,memory,read_fasl_vector(faslfile),0); + close_stream (faslfile); + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %x ",memory->cfd.cfd_start); + return(memory->cfd.cfd_size); +} + +fasload(faslfile) + object faslfile; +{return fasload_help(faslfile,0);} + +#define FASLINK + +siLfaslink() +{ object *base = vs_base; + check_arg(2); + vs_base[0] = make_fixnum(fasload_help(base[0],object_to_string(base[1]))); + printf("done link"); fflush(stdout); + vs_top = vs_base+1; + return ; +} + + + + + + + +int +faslink(faslfile, ldargstring) +object faslfile, ldargstring; +{printf("later");} + diff --git a/o/faslnt.c b/o/faslnt.c new file mode 100755 index 0000000..777552f --- /dev/null +++ b/o/faslnt.c @@ -0,0 +1,6 @@ +int +fasload(object o) +{ + printf("this is a dummy\n"); + +} diff --git a/o/faslsgi4.c b/o/faslsgi4.c new file mode 100755 index 0000000..072fdd7 --- /dev/null +++ b/o/faslsgi4.c @@ -0,0 +1,463 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + + +/* make sure we do allocate aligned for double */ +/* actually I understand that ld -A wants alignment on + the page. ie multiple of 0x1000 +*/ + +#define ALIGN 12 +char * +alloc_contblock_aligned(size) +int size; +{ + char *tmp_alloc = ALLOC_ALIGNED(alloc_contblock,size,(1<<12)); + bzero(tmp_alloc, size); + return(tmp_alloc); + } + +#define alloc_contblock alloc_contblock_aligned + + + +#ifdef BSD +#include +#endif + +#ifdef ATT +#ifdef mips +#include +#include +#endif +#include +#include +#include +#endif + + + +#define MAXPATHLEN 1024 + + + +#ifdef HAVE_ELF +#include +#endif + + +int +fasload(faslfile) +object faslfile; +{ + +#ifdef BSD + struct exec header, newheader; +#define textsize header.a_text +#define datasize header.a_data +#define bsssize header.a_bss +#define textstart sizeof(header) +#define newbsssize newheader.a_bss +#endif + +#ifdef ATT + struct filehdr fileheader; + struct scnhdr sectionheader; +#ifdef mips + struct aouthdr aouthdr, newaouthdr; + HDRR symhdr; +# define textsize aouthdr.tsize +# define datasize aouthdr.dsize +# define bsssize aouthdr.bsize +# define textstart sectionheader.s_scnptr +# define newdatasize newaouthdr.dsize +# define newbsssize newaouthdr.bsize +#else + int textsize, datasize, bsssize; + int textstart; +#endif /* mips */ +#endif + +#ifdef E15 + struct exec header; +#define textsize header.a_text +#define datasize header.a_data +#define bsssize header.a_bss +#define textstart sizeof(header) +#endif + + object memory, data, tempfile; + FILE *fp; + char filename[MAXPATHLEN]; + char tempfilename[32]; + char command[MAXPATHLEN * 2]; + int i; + object *old_vs_base = vs_base; + object *old_vs_top = vs_top; +#ifdef IBMRT + +#endif + + coerce_to_filename(faslfile, filename); + + faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + vs_push(faslfile); + fp = faslfile->sm.sm_fp; + +#ifdef BSD + fread(&header, sizeof(header), 1, fp); +#endif +#ifdef ATT + fread(&fileheader, sizeof(fileheader), 1, fp); +#ifdef mips + fread(&aouthdr, AOUTHSZ, 1, fp); +#else +#ifdef S3000 + if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1); +#endif + fread(§ionheader, sizeof(sectionheader), 1, fp); + textsize = sectionheader.s_size; + textstart = sectionheader.s_scnptr; + fread(§ionheader, sizeof(sectionheader), 1, fp); + datasize = sectionheader.s_size; + fread(§ionheader, sizeof(sectionheader), 1, fp); + if (strcmp(sectionheader.s_name, ".bss") == 0) + bsssize = sectionheader.s_size; + else + bsssize = 0; +#endif /* mips */ +#endif +#ifdef E15 + fread(&header, sizeof(header), 1, fp); +#endif + + memory = alloc_object(t_cfdata); + memory->cfd.cfd_self = NULL; + memory->cfd.cfd_start = NULL; + memory->cfd.cfd_size = textsize + datasize + bsssize; +#ifdef mips +#define MIPS_ROUND 0xC + memory->cfd.cfd_size += MIPS_ROUND; /* room for 'ld' to round text upward */ +#endif + vs_push(memory); + memory->cfd.cfd_start = alloc_contblock(memory->cfd.cfd_size); + +#ifdef BSD + fseek(fp, + header.a_text+header.a_data+ + header.a_syms+header.a_trsize+header.a_drsize, + 1); + fread(&i, sizeof(i), 1, fp); + fseek(fp, i - sizeof(i), 1); +#endif + +#ifdef SYSTYPE_SVR4 + SEEK_TO_END_OFILE(fp); +#else +#ifdef ATT +#ifdef mips + fseek(fp, fileheader.f_symptr, SEEK_SET); + fread(&symhdr, cbHDRR, 1, fp); + fseek(fp, symhdr.cbExtOffset + symhdr.iextMax * cbEXTR, SEEK_SET); +#else + fseek(fp, + fileheader.f_symptr + SYMESZ*fileheader.f_nsyms, + 0); + fread(&i, sizeof(i), 1, fp); + fseek(fp, i - sizeof(i), 1); + while ((i = getc(fp)) == 0) + ; + ungetc(i, fp); +#endif /* mips */ +#endif +#endif + + data = read_fasl_vector(faslfile); + vs_push(data); + close_stream(faslfile); + + sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); + +AGAIN: + +#ifdef BSD + sprintf(command, + "ld -d -N -x -A %s -T %x %s -o %s", + kcl_self, + memory->cfd.cfd_start, + filename, + tempfilename); +#endif +#ifdef ATT +#ifdef mips + sprintf(command, + "ld -s -A %s -N -T %x %s -o %s", + kcl_self, + (long)memory->cfd.cfd_start+SCNROUND-1&~(SCNROUND-1), + filename, + tempfilename); +#else + coerce_to_filename(symbol_value(sSAsystem_directoryA), + system_directory); + sprintf(command, + "%sild %s %d %s %s", + system_directory, + kcl_self, + memory->cfd.cfd_start, + filename, + tempfilename); +#endif /* mips */ +#endif +#ifdef E15 + coerce_to_filename(symbol_value(sSAsystem_directoryA), + system_directory); + sprintf(command, + "%sild %s %d %s %s", + system_directory, + kcl_self, + memory->cfd.cfd_start, + filename, + tempfilename); +#endif + + if (system(command) != 0) + FEerror("The linkage editor failed.", 0); + + tempfile = make_simple_string(tempfilename); + vs_push(tempfile); + tempfile = open_stream(tempfile, smm_input, Cnil, sKerror); + vs_push(tempfile); + fp = tempfile->sm.sm_fp; + +#ifdef BSD + fread(&newheader, sizeof(header), 1, fp); + if (newbsssize != bsssize) { + insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size); + bsssize = newbsssize; + memory->cfd.cfd_start = NULL; + memory->cfd.cfd_size = textsize + datasize + bsssize; + memory->cfd.cfd_start = alloc_contblock(memory->cfd.cfd_size); + close_stream(tempfile, TRUE); + unlink(tempfilename); + goto AGAIN; + } +#endif +#ifdef mips + fseek(fp, FILHSZ, SEEK_CUR); + fread(&newaouthdr, AOUTHSZ, 1, fp); + if (newdatasize + newbsssize > datasize + bsssize) { + insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size); + datasize = newdatasize; + bsssize = newbsssize; + memory->cfd.cfd_start = NULL; + memory->cfd.cfd_size = textsize + datasize + bsssize + MIPS_ROUND; + memory->cfd.cfd_start = alloc_contblock(memory->cfd.cfd_size); + close_stream(tempfile); + unlink(tempfilename); + goto AGAIN; + } + fread(§ionheader, sizeof sectionheader, 1, fp); +#endif + if (fseek(fp, textstart, 0) < 0) + error("file seek error"); +#ifdef mips + printf("start address -T %x ",memory->cfd.cfd_start); + bzero(memory->cfd.cfd_start, MIPS_ROUND); + fread((void *)sectionheader.s_vaddr, textsize + datasize, 1, fp); +#else + fread(memory->cfd.cfd_start, textsize + datasize, 1, fp); +#endif + close_stream(tempfile); + + unlink(tempfilename); + + call_init(0,memory,data,0); + + vs_base = old_vs_base; + vs_top = old_vs_top; + + return(memory->cfd.cfd_size); +} + +#if defined BSD || defined mips + +int +faslink(faslfile, ldargstring) +object faslfile, ldargstring; +{ +#ifdef mips + struct filehdr faslheader; + struct aouthdr aouthdr; + struct scnhdr sectionheader; + HDRR symhdr; +#define ldcmdfmt "ld -s -A %s -N -T %x %s %s -o %s" +#else + struct exec header, faslheader; +#define textsize header.a_text +#define datasize header.a_data +#define bsssize header.a_bss +#define textstart sizeof(header) +#define ldcmdfmt "ld -d -N -x -A %s -T %x %s %s -o %s" +#endif + + object memory, data, tempfile; + FILE *fp; + char filename[MAXPATHLEN]; + char ldargstr[MAXPATHLEN]; + char tempfilename[32]; + char command[MAXPATHLEN * 2]; + char buf[BUFSIZ]; + int i; + object *old_vs_base = vs_base; + object *old_vs_top = vs_top; +#ifdef IBMRT + +#endif + + coerce_to_filename(ldargstring, ldargstr); + coerce_to_filename(faslfile, filename); + + sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); + + sprintf(command, + ldcmdfmt, + kcl_self, + (int)core_end, + filename, + ldargstr, + tempfilename); + + if (system(command) != 0) + FEerror("The linkage editor failed.", 0); + + fp = fopen(tempfilename, "r"); + setbuf(fp, buf); +#ifdef mips + fseek(fp, FILHSZ, SEEK_CUR); + fread(&aouthdr, AOUTHSZ, 1, fp); +#else + fread(&header, sizeof(header), 1, fp); +#endif + memory = alloc_object(t_cfdata); + memory->cfd.cfd_self = NULL; + memory->cfd.cfd_start = NULL; + memory->cfd.cfd_size = textsize + datasize + bsssize; +#ifdef mips + memory->cfd.cfd_size += MIPS_ROUND; +#endif + vs_push(memory); + memory->cfd.cfd_start = alloc_contblock(memory->cfd.cfd_size); + fclose(fp); + + faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + vs_push(faslfile); + fp = faslfile->sm.sm_fp; + fread(&faslheader, sizeof(faslheader), 1, fp); +#ifdef mips + fseek(fp, AOUTHSZ, SEEK_CUR); + fread(§ionheader, SCNHSZ, 1, fp); + fseek(fp, faslheader.f_symptr, SEEK_SET); + fread(&symhdr, cbHDRR, 1, fp); + fseek(fp, symhdr.cbExtOffset + symhdr.iextMax * cbEXTR, SEEK_SET); +#else + fseek(fp, + faslheader.a_text+faslheader.a_data+ + faslheader.a_syms+faslheader.a_trsize+faslheader.a_drsize, + 1); + fread(&i, sizeof(i), 1, fp); + fseek(fp, i - sizeof(i), 1); +#endif + data = read_fasl_vector(faslfile); + vs_push(data); + close_stream(faslfile); + + sprintf(command, + ldcmdfmt, + kcl_self, +#ifdef mips + (long)memory->cfd.cfd_start+SCNROUND-1&~(SCNROUND-1), +#else + memory->cfd.cfd_start, +#endif + filename, + ldargstr, + tempfilename); + + if (system(command) != 0) + FEerror("The linkage editor failed.", 0); + + tempfile = make_simple_string(tempfilename); + vs_push(tempfile); + tempfile = open_stream(tempfile, smm_input, Cnil, sKerror); + vs_push(tempfile); + fp = tempfile->sm.sm_fp; + +#ifdef mips + fseek(fp, FILHSZ, SEEK_CUR); + fread(&aouthdr, AOUTHSZ, 1, fp); + fread(§ionheader, sizeof sectionheader, 1, fp); +#endif + + if (fseek(fp, textstart, 0) < 0) + error("file seek error"); +#ifdef mips + printf("start address -T %x ",memory->cfd.cfd_start); + bzero(memory->cfd.cfd_start, MIPS_ROUND); + fread((void *)sectionheader.s_vaddr, textsize + datasize, 1, fp); +#else + fread(memory->cfd.cfd_start, textsize + datasize, 1, fp); +#endif + close_stream(tempfile); + + unlink(tempfilename); + + call_init(0,memory,data,0); + + vs_base = old_vs_base; + vs_top = old_vs_top; + + return(memory->cfd.cfd_size); +} + +siLfaslink() +{ + bds_ptr old_bds_top; + int i; + object package; + + check_arg(2); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + check_type_string(&vs_base[1]); + vs_base[0] = coerce_to_pathname(vs_base[0]); + vs_base[0]->pn.pn_type = FASL_string; + vs_base[0] = namestring(vs_base[0]); + package = symbol_value(sLApackageA); + old_bds_top = bds_top; + bds_bind(sLApackageA, package); + i = faslink(vs_base[0], vs_base[1]); + bds_unwind(old_bds_top); + vs_top = vs_base; + vs_push(make_fixnum(i)); +} + +#endif + +#define FASLINK diff --git a/o/fat_string.c b/o/fat_string.c new file mode 100755 index 0000000..66fffb3 --- /dev/null +++ b/o/fat_string.c @@ -0,0 +1,404 @@ +/* +(c) Copyright W. Schelter 1988, All rights reserved. +*/ + +#include +#include +#include + +#include "include.h" +#include "page.h" + +#ifdef HAVE_LIBBFD +#ifdef NEED_CONST +#define CONST const +#endif +#define IN_GCC +#include +#include +#endif + +#define FAT_STRING + + +enum type what_to_collect; + +/* start fasdump stuff */ +#include "fasdump.c" + + + +object sSAprofile_arrayA; +#ifdef NO_PROFILE +#ifdef DARWIN/*FIXME macosx10.8 has a prototype (which must match here) but unlinkable function in 64bit*/ +int profil(char *buf, size_t bufsiz, unsigned long offset, unsigned int scale){return 0;} +#else +void profil(void){;} +#endif +#endif + + +#ifndef NO_PROFILE +DEFUN_NEW("PROFILE",object,fSprofile,SI + ,2,2,NONE,OO,OO,OO,OO,(object start_address,object scale), + "Sets up profiling with START-ADDRESS and SCALE where scale is \ + between 0 and 256") +{ /* 2 args */ + + object ar=sSAprofile_arrayA->s.s_dbind; + void *x; + fixnum a,s; + + if (type_of(ar)!=t_string) + FEerror("si:*Profile-array* not a string",0); + if( type_of(start_address)!=t_fixnum || type_of(scale)!=t_fixnum) + FEerror("Needs start address and scale as args",0); + + massert((a=fix(start_address))>=0); + massert((s=fix(scale))>=0); + + x=a&&s ? (void *) (ar->ust.ust_self) : NULL; + profil(x, (ar->ust.ust_dim),fix(start_address),fix(scale) << 8); + RETURN1(start_address); +} + +#endif +DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI,1,1,NONE,OO,OO,OO,OO,(object funobj),"") { + + switch (type_of(funobj)) { + case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun:case t_closure:case t_cclosure: + return make_fixnum((long) (funobj->cf.cf_self)); + default: + TYPE_ERROR(funobj,sLcompiled_function); + return Cnil; + } + +} + +/* begin fasl stuff*/ +/* this is for windows to not include all of windows.h for this..*/ + +#include "ptable.h" +#ifdef AIX3 +#include +char *data_load_addr =0; +#endif + +#define CFUN_LIM 10000 + +int maxpage; +object sScdefn; + +#define CF_FLAG ((unsigned long)1 << (sizeof(long)*8-1)) + +static void +cfuns_to_combined_table(unsigned int n) /* non zero n will ensure new table length */ + +{int ii=0; + STATIC int j; + STATIC object x; + STATIC char *p,*cf_addr; + STATIC struct typemanager *tm; + if (! (n || combined_table.ptable)) n=CFUN_LIM; + if (n && combined_table.alloc_length < n) + { + (combined_table.ptable)=NULL; + (combined_table.ptable)= (struct node *)malloc(n* sizeof(struct node)); + if(!combined_table.ptable) + FEerror("unable to allocate",0); + combined_table.alloc_length=n;} + + { + struct pageinfo *v; + for (v=cell_list_head;v;v=v->next) { + enum type tp=v->type; + if (tp!=tm_table[(short)t_cfun].tm_type && + tp!=tm_table[(short)t_gfun].tm_type && + tp!=tm_table[(short)t_sfun].tm_type && + tp!=tm_table[(short)t_vfun].tm_type + ) + continue; + tm = tm_of(tp); + p = pagetochar(page(v)); + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; + if (type_of(x)!=t_cfun && + type_of(x)!=t_sfun && + type_of(x)!=t_vfun && + type_of(x)!=t_gfun + ) continue; + if (is_free(x) || x->cf.cf_self == NULL) + continue; + /* the cdefn things are the proclaimed call types. */ + cf_addr=(char * ) ((unsigned long)(x->cf.cf_self)); + + SYM_ADDRESS(combined_table,ii)=(unsigned long)cf_addr; + SYM_STRING(combined_table,ii)= (char *)(CF_FLAG | (unsigned long)x) ; + /* (x->cf.cf_name ? x->cf.cf_name->s.st_self : NULL) ; */ + combined_table.length = ++ii; + if (ii >= combined_table.alloc_length) + FEerror("Need a larger combined_table",0); + } + } + } +} + +static int +address_node_compare(const void *node1, const void *node2) +{unsigned int a1,a2; + a1=((struct node *)node1)->address; + a2=((struct node *)node2)->address; + if (a1> a2) return 1; + if (a1< a2) return -1; + return 0; +} + + +#if defined(HAVE_LIBBFD) && ! defined(SPECIAL_RSYM) + +static int bfd_update; + +static MY_BFD_BOOLEAN +bfd_combined_table_update(struct bfd_link_hash_entry *h,PTR ct) { + + if (ct!=&combined_table) + return MY_BFD_FALSE; + + if (h->type!=bfd_link_hash_defined) + return MY_BFD_TRUE; + + if (!h->u.def.section) { + FEerror("Symbol without section",0); + return MY_BFD_FALSE; + } + + if (bfd_update) { + if (combined_table.length>=combined_table.alloc_length) + FEerror("combined table overflow", 0); + + SYM_ADDRESS(combined_table,combined_table.length)=h->u.def.value+h->u.def.section->vma; + SYM_STRING(combined_table,combined_table.length)=(char *)h->root.string; + } + + combined_table.length++; + + return MY_BFD_TRUE; + +} +#endif + + +DEFUN_NEW("SET-UP-COMBINED",object,fSset_up_combined,SI + ,0,1,NONE,OO,OO,OO,OO,(object first,...),"") +{ + int nargs=VFUN_NARGS; + unsigned int n; + object siz; + + if (nargs>=1) + siz=first; + else + siz = small_fixnum(0); + + CHECK_ARG_RANGE(0,1); + n = (unsigned int) fix(siz); + cfuns_to_combined_table(n); + +#if !defined(HAVE_LIBBFD) && !defined(SPECIAL_RSYM) +#error Need either BFD or SPECIAL_RSYM +#endif + +#if defined(SPECIAL_RSYM) + if (c_table.ptable) { + + int j,k; + + if((k=combined_table.length)+c_table.length >= combined_table.alloc_length) + cfuns_to_combined_table(combined_table.length+c_table.length+20); + + for(j = 0; j < c_table.length;) { + SYM_ADDRESS(combined_table,k) =SYM_ADDRESS(c_table,j); + SYM_STRING(combined_table,k) =SYM_STRING(c_table,j); + k++; + j++; + } + + combined_table.length += c_table.length ; + + } + +#else +#if defined(HAVE_LIBBFD) + if (link_info.hash) { + + bfd_update=0; + bfd_link_hash_traverse(link_info.hash, + bfd_combined_table_update,&combined_table); + + if (combined_table.length >=combined_table.alloc_length) + cfuns_to_combined_table(combined_table.length); + + bfd_update=1; + bfd_link_hash_traverse(link_info.hash, + bfd_combined_table_update,&combined_table); + bfd_update=0; + + } +#endif +#endif + + qsort(combined_table.ptable,combined_table.length,sizeof(*combined_table.ptable),address_node_compare); + + RETURN1(siz); + +} + +static int prof_start; +static int +prof_ind(unsigned int address, int scale) +{address = address - prof_start ; + if (address > 0) return ((address * scale) >> 8) ; + return 0; +} + +/* sum entries AAR up to DIM entries */ +static int +string_sum(register unsigned char *aar, unsigned int dim) +{register unsigned char *endar; + register unsigned int count = 0; +endar=aar+dim; + for ( ; aar< endar; aar++) + count += *aar; + return count; +} + + +DEFUN_NEW("DISPLAY-PROFILE",object,fSdisplay_profile,SI + ,2,2,NONE,OO,OO,OO,OO,(object start_addr,object scal),"") { + + if (!combined_table.ptable) + FEerror("must symbols first",0); + /* 2 args */ + { + unsigned int prev,next,upto,dim,total; + int j,scale,count; + unsigned char *ar; + object obj_ar; + obj_ar=sSAprofile_arrayA->s.s_dbind; + if (type_of(obj_ar)!=t_string) + FEerror("si:*Profile-array* not a string",0); + ar=obj_ar->ust.ust_self; + scale=fix(scal); + prof_start=fix(start_addr); + vs_top=vs_base; + dim= (obj_ar->ust.ust_dim); + + total=string_sum(ar,dim); + + j=0; + { + int i, finish = combined_table.length-1; + for(i =0,prev=SYM_ADDRESS(combined_table,i); i< finish;prev=next) { + ++i; + next=SYM_ADDRESS(combined_table,i); + if (prev= dim) + upto=dim; + { + const char *name; unsigned long uname; + count=0; + for(;j 0) { + name=SYM_STRING(combined_table,i-1); + uname = (unsigned long) name; + printf("\n%6.2f%% (%5d): ",(100.0*count)/total, count); + fflush(stdout); + if (CF_FLAG & uname) { + if (~CF_FLAG & uname) + prin1( ((object) (~CF_FLAG & uname))->cf.cf_name,Cnil); + } else if (name ) + printf("%s",name);}; + if (upto==dim) goto TOTALS ; + + } + } + } + TOTALS: + printf("\nTotal ticks %d",total);fflush(stdout); + } + RETURN1(start_addr); +} + + + +/* end fasl stuff*/ + + +/* These are some low level hacks to allow determining the address + of an array body, and to allow jumping to inside the body + of the array */ + +DEFUN_NEW("ARRAY-ADRESS",object,fSarray_adress,SI + ,1,1,NONE,OO,OO,OO,OO,(object array),"") +{/* 1 args */ + array=make_fixnum((long) (&(array->st.st_self[0]))); + RETURN1(array); +} + +/* This is some very low level code for hacking invokation of + m68k instructions in a lisp array. The index used should be + a byte index. So invoke(ar,3) jmps to byte ar+3. + */ + +#ifdef CLI + +invoke(ar) +char *ar; +{asm("movel a6@(8),a0"); + asm("jmp a0@"); +} +/* save regs (2 3 4 5 6 7 10 11 12 13 14) and invoke restoring them */ +save_regs_invoke(ar) +char *ar; +{asm("moveml #0x3f3e,sp@-"); + invoke(ar); + asm("moveml a6@(-44),#0x7cfc"); +} + +/* DEFUNO_NEW("SAVE-REGS-INVOKE",object,fSsave_regs_invoke,SI + ,2,2,NONE,OO,OO,OO,OO,void,siLsave_regs_invoke,"",(x0,x1)) +object x0,x1; +{int x; + check_type_integer(&x1); + x=save_regs_invoke((x0->st.st_self)+fix(x1)); + x0=make_fixnum(x); + RETURN1(x0); +} +*/ + +#endif + +DEFVAR("*PROFILE-ARRAY*",sSAprofile_arrayA,SI,Cnil,""); +void +gcl_init_fat_string(void) +{ + + make_si_constant("*ASH->>*",(-1==(((int)-1) >> 20))? Ct :Cnil); +/* #ifdef SFASL */ +/* make_si_function("BUILD-SYMBOL-TABLE",build_symbol_table); */ +/* #endif */ + + + init_fasdump(); + +} + + + + + + + diff --git a/o/file.d b/o/file.d new file mode 100755 index 0000000..b0f7528 --- /dev/null +++ b/o/file.d @@ -0,0 +1,2404 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + file.d + IMPLEMENTATION-DEPENDENT + + The specification of printf may be dependent on the C library, + especially for read-write access, append access, etc. + The file also contains the code to reclaim the I/O buffer + by accessing the FILE structure of C. + It also contains read_fasl_data. +*/ + +#include +#include +#include +#include +#include + +#define IN_FILE +#include "include.h" + +#ifdef USE_READLINE +#define kclgetc(FP) rl_getc_em(((FILE *)FP)) +#define kclungetc(C, FP) rl_ungetc_em(C, ((FILE *)FP)) +#define kclputc(C, FP) rl_putc_em(C, ((FILE *)FP)) +#else +#define kclgetc(FP) getc(((FILE *)FP)) +#define kclungetc(C, FP) ungetc(C, ((FILE *)FP)) +#define kclputc(C, FP) putc(C, ((FILE *)FP)) +#endif /* USE_READLINE */ + +#define xkclfeof(c,FP) feof(((FILE *)FP)) + +#ifdef HAVE_AOUT +#undef ATT +#undef BSD +#ifndef HAVE_ELF +#ifndef HAVE_FILEHDR +#define BSD +#endif +#endif +#include HAVE_AOUT +#endif + +#ifdef ATT +#include +#include +#define HAVE_FILEHDR +#endif + +#ifdef E15 +#include +#define exec bhdr +#define a_text tsize +#define a_data dsize +#define a_bss bsize +#define a_syms ssize +#define a_trsize rtsize +#define a_drsize rdsize +#endif + +#if defined(HAVE_ELF_H) +#include +#elif defined(HAVE_ELF_ABI_H) +#include +#endif + +#ifndef __MINGW32__ +# include +# include +# include +#else +# include +# include +#endif +#include + +extern void tcpCloseSocket (int fd); + +object terminal_io; + +object Vverbose; +object LSP_string; + + +object sSAignore_eof_on_terminal_ioA; + +static bool +feof1(fp) +FILE *fp; +{ + +#ifdef USE_READLINE + if (rl_stream_p(fp) && rl_eof_p(fp)) + return TRUE; +#endif + if (!feof(fp)) + return(FALSE); + if (fp == terminal_io->sm.sm_object0->sm.sm_fp) { + if (symbol_value(sSAignore_eof_on_terminal_ioA) == Cnil) + return(TRUE); +#ifdef UNIX + fp = freopen("/dev/tty", "r", fp); +#endif +#ifdef AOSVS + +#endif + if (fp == NULL) + error("can't reopen the console"); + return(FALSE); + } + return(TRUE); +} + +#undef feof +#define feof feof1 + +void +end_of_stream(strm) +object strm; +{ + END_OF_FILE(strm); +} + +/* + Input_stream_p(strm) answers + if stream strm is an input stream or not. + It does not check if it really is possible to read + from the stream, + but only checks the mode of the stream (sm_mode). +*/ +static bool +input_stream_p(strm) +object strm; +{ +BEGIN: + switch (strm->sm.sm_mode) { + case smm_input: + return(TRUE); + + case smm_output: + return(FALSE); + + case smm_io: + case smm_socket: + return(TRUE); + + case smm_probe: + return(FALSE); + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_broadcast: + return(FALSE); + + case smm_concatenated: + return(TRUE); + + case smm_two_way: + return(TRUE); + + case smm_echo: + return(TRUE); + + case smm_string_input: + return(TRUE); + + case smm_string_output: + return(FALSE); + + default: + error("illegal stream mode"); + return(FALSE); + } +} + +/* + Output_stream_p(strm) answers + if stream strm is an output stream. + It does not check if it really is possible to write + to the stream, + but only checks the mode of the stream (sm_mode). +*/ +static bool +output_stream_p(strm) +object strm; +{ +BEGIN: + switch (strm->sm.sm_mode) { + case smm_input: + return(FALSE); + + case smm_output: + return(TRUE); + + case smm_io: + case smm_socket: + return(TRUE); + + case smm_probe: + return(FALSE); + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_broadcast: + return(TRUE); + + case smm_concatenated: + return(FALSE); + + case smm_two_way: + return(TRUE); + + case smm_echo: + return(TRUE); + + case smm_string_input: + return(FALSE); + + case smm_string_output: + return(TRUE); + + default: + error("illegal stream mode"); + return(FALSE); + } +} + +static object +stream_element_type(strm) +object strm; +{ + object x; + +BEGIN: + switch (strm->sm.sm_mode) { + case smm_input: + case smm_output: + case smm_io: + case smm_probe: + return(strm->sm.sm_object0); + + case smm_socket: + return (sLcharacter); + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_broadcast: + x = strm->sm.sm_object0; + if (endp(x)) + return(Ct); + return(stream_element_type(x->c.c_car)); + + case smm_concatenated: + x = strm->sm.sm_object0; + if (endp(x)) + return(Ct); + return(stream_element_type(x->c.c_car)); + + case smm_two_way: + return(stream_element_type(STREAM_INPUT_STREAM(strm))); + + case smm_echo: + return(stream_element_type(STREAM_INPUT_STREAM(strm))); + + case smm_string_input: + return(sLcharacter); + + case smm_string_output: + return(sLcharacter); + + default: + error("illegal stream mode"); + return(FALSE); + } +} + +void +setup_stream_buffer(object x) { +#ifdef NO_SETBUF + massert(!setvbuf(x->sm.sm_fp,x->sm.sm_buffer=NULL,_IONBF,0)); +#else + massert(!setvbuf(x->sm.sm_fp,x->sm.sm_buffer=writable_malloc_wrap(malloc,void *,BUFSIZ),_IOFBF,BUFSIZ)); +#endif +} + +static void +deallocate_stream_buffer(object strm) { + + if (strm->sm.sm_buffer==NULL) + return; + + free(strm->sm.sm_buffer); + + massert(!setvbuf(strm->sm.sm_fp,strm->sm.sm_buffer=NULL,_IONBF,0)); + +} + +DEFVAR("*ALLOW-GZIPPED-FILE*",sSAallow_gzipped_fileA,SI,sLnil,""); + +/* static void */ +/* too_long_file_name(object); */ +static void +cannot_open(object); +static void +cannot_create(object); +/* + Open_stream(fn, smm, if_exists, if_does_not_exist) + opens file fn with mode smm. + Fn is a namestring. +*/ +object +open_stream(object fn,enum smmode smm, object if_exists, object if_does_not_exist) { + + object x; + FILE *fp=NULL; + vs_mark; + + coerce_to_filename(fn,FN1); + + switch(smm) { + + case smm_input: + case smm_probe: + + if (!(fp=*FN1=='|' ? popen(FN1+1,"r") : fopen_not_dir(FN1,"r")) && sSAallow_gzipped_fileA->s.s_dbind!=Cnil) { + + struct stat ss; + massert(snprintf(FN2,sizeof(FN2),"%s.gz",FN1)>0); + + if (!stat(FN2,&ss)) { + + FILE *pp; + int n; + + massert((fp=tmpfile())); + massert(snprintf(FN3,sizeof(FN2),"zcat %s",FN2)>0); + massert(pp=popen(FN3,"r")); + while ((n=fread(FN4,1,sizeof(FN3),pp))) + massert(fwrite(FN4,1,n,fp)==n); + massert(pclose(pp)>=0); + massert(!fseek(fp,0,SEEK_SET)); + + } + + } + + if (!fp) { + + if (if_does_not_exist==sKerror) cannot_open(fn); + else if (if_does_not_exist==sKcreate) { + if (!(fp=fopen_not_dir(FN1,"w"))) cannot_create(fn); + fclose(fp); + if (!(fp=fopen_not_dir(FN1,"r"))) cannot_open(fn); + } else if (if_does_not_exist==Cnil) return(Cnil); + else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); + + } + break; + + case smm_output: + case smm_io: + + if ((fp=*FN1=='|' ? NULL : fopen_not_dir(FN1,"r"))) { + + fclose(fp); + if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); + else if (if_exists==sKrename) { + massert(snprintf(FN2,sizeof(FN2),"%-*.*s~",(int)strlen(FN1)-1,(int)strlen(FN1)-1,FN1)>=0); + massert(!unlink(FN2));/*MinGW*/ + massert(!rename(FN1,FN2)); + if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); + } else if (if_exists==sKrename_and_delete || + if_exists==sKnew_version || + if_exists==sKsupersede) { + if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); + } else if (if_exists==sKoverwrite) { + if (!(fp=fopen_not_dir(FN1,"r+"))) cannot_open(fn); + } else if (if_exists==sKappend) { + if (!(fp = fopen_not_dir(FN1,smm==smm_output ? "a" : "a+"))) + FEerror("Cannot append to the file ~A.",1,fn); + } else if (if_exists == Cnil) return(Cnil); + else FEerror("~S is an illegal IF-EXISTS option.",1,if_exists); + + } else { + + if (if_does_not_exist == sKerror) + FILE_ERROR(fn,"The file does not exist"); + else if (if_does_not_exist == sKcreate) { + if (!(fp=smm==smm_output ? (*FN1=='|' ? popen(FN1+1,"w") : fopen_not_dir(FN1, "w")) : fopen_not_dir(FN1, "w+"))) + cannot_create(fn); + } else if (if_does_not_exist==Cnil) return(Cnil); + else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); + } + break; + + default: + FEerror("Illegal open mode for ~S.",1,fn); + break; + } + + vs_push(make_simple_string(FN1)); + x = alloc_object(t_stream); + x->sm.sm_mode = (short)smm; + x->sm.sm_fp = fp; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLcharacter; + x->sm.sm_object1 = vs_head; + x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_push(x); + + setup_stream_buffer(x); + vs_reset; + + if (smm==smm_probe) + close_stream(x); + + return(x); + +} + +static void +gclFlushSocket(object); + +DEFUN_NEW("OPEN-INT",object,fSopen_int,SI,8,8,NONE,OO,OO,OO,OO, + (object fn,object direction,object element_type,object if_exists, + object iesp,object if_does_not_exist,object idnesp, + object external_format),"") { + + enum smmode smm=0; + vs_mark; + object strm,filename; + + filename=fn; + if (direction == sKinput) { + smm = smm_input; + if (idnesp==Cnil) + if_does_not_exist = sKerror; + } else if (direction == sKoutput) { + smm = smm_output; + if (iesp==Cnil) + if_exists = sKnew_version; + if (idnesp==Cnil) { + if (if_exists == sKoverwrite || + if_exists == sKappend) + if_does_not_exist = sKerror; + else + if_does_not_exist = sKcreate; + } + } else if (direction == sKio) { + smm = smm_io; + if (iesp==Cnil) + if_exists = sKnew_version; + if (idnesp==Cnil) { + if (if_exists == sKoverwrite || + if_exists == sKappend) + if_does_not_exist = sKerror; + else + if_does_not_exist = sKcreate; + } + } else if (direction == sKprobe) { + smm = smm_probe; + if (idnesp==Cnil) + if_does_not_exist = Cnil; + } else + FEerror("~S is an illegal DIRECTION for OPEN.", 1, direction); + strm = open_stream(filename, smm, if_exists, if_does_not_exist); + if (type_of(strm) == t_stream) { + strm->sm.sm_object0 = element_type; + strm->sm.sm_object1 = fn; + } + vs_reset; + RETURN1(strm); +} + +DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + check_type_stream(&x); + + return GET_STREAM_FLAG(x,gcl_sm_closed) ? Cnil : Ct; + +} + /* + Close_stream(strm) closes stream strm. + The abort_flag is not used now. +*/ + +static int +pipe_designator_p(object x) { + + if (x==OBJNULL||x==Cnil) + return 0; + coerce_to_filename(x,FN1); + return FN1[0]=='|' ? 1 : 0; + +} + +void +close_stream(object strm) { + + if (FFN(fLopen_stream_p)(strm)==Cnil) + return; + + switch (strm->sm.sm_mode) { + case smm_output: + if (strm->sm.sm_fp == stdout || strm->sm.sm_fp == stderr) + FEerror("Cannot close the standard output.", 0); + fflush(strm->sm.sm_fp); + deallocate_stream_buffer(strm); + if (pipe_designator_p(strm->sm.sm_object1)) + pclose(strm->sm.sm_fp); + else + fclose(strm->sm.sm_fp); + strm->sm.sm_fp = NULL; + strm->sm.sm_fd = -1; + break; + + case smm_socket: + if (SOCKET_STREAM_FD(strm) < 2) + emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); + else { +#ifdef HAVE_NSOCKET + if (GET_STREAM_FLAG(strm,gcl_sm_output)) { + gclFlushSocket(strm); + /* there are two for one fd so close only one */ + tcpCloseSocket(SOCKET_STREAM_FD(strm)); + } +#endif + SOCKET_STREAM_FD(strm)=-1; + } + + case smm_input: + if (strm->sm.sm_fp == stdin) + FEerror("Cannot close the standard input.", 0); + + case smm_io: + case smm_probe: + deallocate_stream_buffer(strm); + if (pipe_designator_p(strm->sm.sm_object1)) + pclose(strm->sm.sm_fp); + else + fclose(strm->sm.sm_fp); + strm->sm.sm_fp = NULL; + strm->sm.sm_fd = -1; + break; + + case smm_synonym: + break; + + case smm_broadcast: + case smm_concatenated: + break; + + case smm_two_way: + case smm_echo: + break; + + case smm_string_input: + case smm_string_output: + break; + + default: + error("Illegal stream mode"); + } + + SET_STREAM_FLAG(strm,gcl_sm_closed,1); + +} + +DEFUN_NEW("INTERACTIVE-STREAM-P",object,fLinteractive_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object strm),"") { + + check_type_stream(&strm); + + switch (strm->sm.sm_mode) { + case smm_output: + case smm_input: + case smm_io: + case smm_probe: + if ((strm->sm.sm_fp == stdin) || + (strm->sm.sm_fp == stdout) || + (strm->sm.sm_fp == stderr)) + return Ct; + return Cnil; + break; + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + break; + + case smm_broadcast: + case smm_concatenated: + if (( consp(strm->sm.sm_object0) ) && + ( type_of(strm->sm.sm_object0->c.c_car) == t_stream )) + strm=strm->sm.sm_object0->c.c_car; + else + return Cnil; + break; + + case smm_two_way: + case smm_echo: + strm=STREAM_INPUT_STREAM(strm); + break; + default: + return Cnil; + } + + return Cnil; + +} + +object +make_two_way_stream(istrm, ostrm) +object istrm, ostrm; +{ + object strm; + + strm = alloc_object(t_stream); + strm->sm.sm_mode = (short)smm_two_way; + strm->sm.sm_fp = NULL; + strm->sm.sm_buffer = 0; + STREAM_INPUT_STREAM(strm) = istrm; + STREAM_OUTPUT_STREAM(strm) = ostrm; + strm->sm.sm_int = 0; + strm->sm.sm_flags=0; + return(strm); +} + +static object +make_echo_stream(istrm, ostrm) +object istrm, ostrm; +{ + object strm; + + strm = make_two_way_stream(istrm, ostrm); + strm->sm.sm_mode = (short)smm_echo; + return(strm); +} + +DEFUN_NEW("MAKE-STRING-INPUT-STREAM-INT",object,fSmake_string_input_stream_int,SI,3,3,NONE,OO,II,OO,OO, + (object strng,fixnum istart,fixnum iend),"") { + + object strm; + + strm = alloc_object(t_stream); + strm->sm.sm_mode = (short)smm_string_input; + strm->sm.sm_fp = NULL; + strm->sm.sm_buffer = 0; + STRING_STREAM_STRING(strm) = strng; + strm->sm.sm_object1 = OBJNULL; + STRING_INPUT_STREAM_NEXT(strm)= istart; + STRING_INPUT_STREAM_END(strm)= iend; + strm->sm.sm_flags=0; + + RETURN1(strm); + +} +#ifdef STATIC_FUNCTION_POINTERS +object +fSmake_string_input_stream_int(object x,fixnum y,fixnum z) { + return FFN(fSmake_string_input_stream_int)(x,y,z); +} +#endif + +DEFUN_NEW("STRING-INPUT-STREAM-P",object,fSstring_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + return type_of(x)==t_stream && x->sm.sm_mode == (short)smm_string_input ? Ct : Cnil; +} +DEFUN_NEW("STRING-OUTPUT-STREAM-P",object,fSstring_output_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + return type_of(x)==t_stream && x->sm.sm_mode == (short)smm_string_output ? Ct : Cnil; +} + +object +make_string_output_stream(line_length) +int line_length; +{ + object strng, strm; + vs_mark; + + strng = alloc_object(t_string); + strng->st.st_hasfillp = TRUE; + strng->st.st_adjustable = TRUE; + strng->st.st_displaced = Cnil; + strng->st.st_dim = line_length; + strng->st.st_fillp = 0; + strng->st.st_self = NULL; + /* For GBC not to go mad. */ + vs_push(strng); + /* Saving for GBC. */ + strng->st.st_self = alloc_relblock(line_length); + strm = alloc_object(t_stream); + strm->sm.sm_mode = (short)smm_string_output; + strm->sm.sm_fp = NULL; + strm->sm.sm_buffer = 0; + STRING_STREAM_STRING(strm) = strng; + strm->sm.sm_object1 = OBJNULL; + strm->sm.sm_int = 0; + strm->sm.sm_flags=0; + vs_reset; + return(strm); +} + +static object +get_output_stream_string(strm) +object strm; +{ + object strng; + + strng = copy_simple_string(STRING_STREAM_STRING(strm)); + STRING_STREAM_STRING(strm)->st.st_fillp = 0; + return(strng); +} + +static void +cannot_read(object); + +static void +closed_stream(object); + int +readc_stream(strm) +object strm; +{ + int c; + +BEGIN: + switch (strm->sm.sm_mode) { +#ifdef HAVE_NSOCKET + case smm_socket: + return (getCharGclSocket(strm,Ct)); +#endif + case smm_input: + case smm_io: + + if (strm->sm.sm_fp == NULL) + closed_stream(strm); + #if (1) + c = kclgetc(strm->sm.sm_fp); + #else + c = getOneChar(strm->sm.sm_fp); + #endif +/* if (c == EOF) { */ +/* if (xkclfeof(c,strm->sm.sm_fp)) */ +/* end_of_stream(strm); */ +/* else c = getOneChar(strm->sm.sm_fp); */ +/* if (c == EOF) end_of_stream(strm); */ +/* } */ + +/* c &= 0377; */ + /* strm->sm.sm_int0++; */ + return(c==EOF ? c : (c&0377)); + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_concatenated: + CONCATENATED: + if (endp(strm->sm.sm_object0)) { + end_of_stream(strm); + } + if (stream_at_end(strm->sm.sm_object0->c.c_car)) { + strm->sm.sm_object0 + = strm->sm.sm_object0->c.c_cdr; + goto CONCATENATED; + } + c = readc_stream(strm->sm.sm_object0->c.c_car); + return(c); + + case smm_two_way: +#ifdef UNIX + if (strm == terminal_io) + flush_stream(STREAM_OUTPUT_STREAM(terminal_io)); +#endif + /* strm->sm.sm_int1 = 0; */ + strm = STREAM_INPUT_STREAM(strm); + goto BEGIN; + + case smm_echo: + c = readc_stream(STREAM_INPUT_STREAM(strm)); + if (ECHO_STREAM_N_UNREAD(strm) == 0) + writec_stream(c, STREAM_OUTPUT_STREAM(strm)); + else + --(ECHO_STREAM_N_UNREAD(strm)); + return(c); + + case smm_string_input: + if (STRING_INPUT_STREAM_NEXT(strm)>= STRING_INPUT_STREAM_END(strm)) + end_of_stream(strm); + return(STRING_STREAM_STRING(strm)->st.st_self + [STRING_INPUT_STREAM_NEXT(strm)++]); + + case smm_output: + case smm_probe: + case smm_broadcast: + case smm_string_output: + cannot_read(strm); +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: +#define STM_DATA_STRUCT 0 +#define STM_READ_CHAR 1 +#define STM_WRITE_CHAR 2 +#define STM_UNREAD_CHAR 7 +#define STM_FORCE_OUTPUT 4 +#define STM_PEEK_CHAR 3 +#define STM_CLOSE 5 +#define STM_TYPE 6 +#define STM_NAME 8 +{object val; + object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + vs_base = vs_top; + vs_push(strm); + super_funcall(strm->sm.sm_object1->str.str_self[STM_READ_CHAR]); + val = vs_base[0]; + vs_base = old_vs_base; + vs_top = old_vs_top; + if (type_of(val) == t_fixnum) + return (fix(val)); + if (type_of(val) == t_character) + return (char_code(val)); + } + +#endif + + default: + error("illegal stream mode"); + return(0); + } +} + +int +rl_ungetc_em(int, FILE *); + +void +unreadc_stream(int c, object strm) { +BEGIN: + switch (strm->sm.sm_mode) { + case smm_socket: +#ifdef HAVE_NSOCKET + ungetCharGclSocket(c,strm); + return; +#endif + case smm_input: + case smm_io: + + if (strm->sm.sm_fp == NULL) + closed_stream(strm); + kclungetc(c, strm->sm.sm_fp); + /* --strm->sm.sm_int0; */ /* use ftell now for position */ + break; + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_concatenated: + if (endp(strm->sm.sm_object0)) + goto UNREAD_ERROR; + strm = strm->sm.sm_object0->c.c_car; + goto BEGIN; + + case smm_two_way: + strm = STREAM_INPUT_STREAM(strm); + goto BEGIN; + + case smm_echo: + unreadc_stream(c, STREAM_INPUT_STREAM(strm)); + ECHO_STREAM_N_UNREAD(strm)++; + break; + + case smm_string_input: + if (STRING_INPUT_STREAM_NEXT(strm)<= 0) + goto UNREAD_ERROR; + --STRING_INPUT_STREAM_NEXT(strm); + break; + + case smm_output: + case smm_probe: + case smm_broadcast: + case smm_string_output: + goto UNREAD_ERROR; + +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: + {object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + vs_base = vs_top; + vs_push(strm); + /* if there is a file pointer and no define unget function, + * then call ungetc */ + if ((strm->sm.sm_fp != NULL ) && + strm->sm.sm_object1->str.str_self[STM_UNREAD_CHAR] == Cnil) + kclungetc(c, strm->sm.sm_fp); + else + super_funcall(strm->sm.sm_object1->str.str_self[STM_UNREAD_CHAR]); + vs_top = old_vs_top; + vs_base = old_vs_base; + } + break; +#endif + default: + error("illegal stream mode"); + } + return; + +UNREAD_ERROR: + FEerror("Cannot unread the stream ~S.", 1, strm); +} + +static void +putCharGclSocket(object,int); +int +rl_putc_em(int, FILE *); +static void +cannot_write(object); + +int +writec_stream(int c, object strm) { + object x; + char *p; + int i; + +BEGIN: + switch (strm->sm.sm_mode) { + case smm_output: + case smm_io: + case smm_socket: + /* strm->sm.sm_int0++; */ + if (c == '\n') + STREAM_FILE_COLUMN(strm) = 0; + else if (c == '\t') + STREAM_FILE_COLUMN(strm) = (STREAM_FILE_COLUMN(strm)&~07) + 8; + else + STREAM_FILE_COLUMN(strm)++; + if (strm->sm.sm_fp == NULL) + { +#ifdef HAVE_NSOCKET + if (strm->sm.sm_mode == smm_socket && strm->sm.sm_fd>=0) + putCharGclSocket(strm,c); + else +#endif + if (!GET_STREAM_FLAG(strm,gcl_sm_had_error)) + closed_stream(strm); + } else { + + kclputc(c, strm->sm.sm_fp); + } + + break; + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_broadcast: + for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) + writec_stream(c, x->c.c_car); + break; + + case smm_two_way: + /* this should be on the actual streams + strm->sm.sm_int0++; + if (c == '\n') + strm->sm.sm_int1 = 0; + else if (c == '\t') + strm->sm.sm_int1 = (strm->sm.sm_int1&~07) + 8; + else + strm->sm.sm_int1++; + */ + strm = STREAM_OUTPUT_STREAM(strm); + goto BEGIN; + + case smm_echo: + strm = STREAM_OUTPUT_STREAM(strm); + goto BEGIN; + + case smm_string_output: + /* strm->sm.sm_int0++; */ + if (c == '\n') + STREAM_FILE_COLUMN(strm) = 0; + else if (c == '\t') + STREAM_FILE_COLUMN(strm) = (STREAM_FILE_COLUMN(strm)&~07) + 8; + else + STREAM_FILE_COLUMN(strm)++; + x = STRING_STREAM_STRING(strm); + if (x->st.st_fillp >= x->st.st_dim) { + if (!x->st.st_adjustable) + FEerror("The string ~S is not adjustable.", + 1, x); + p = (inheap((long)x->st.st_self) ? alloc_contblock : alloc_relblock) + (x->st.st_dim * 2 + 16); + for (i = 0; i < x->st.st_dim; i++) + p[i] = x->st.st_self[i]; + i = x->st.st_dim * 2 + 16; +#define ADIMLIM 16*1024*1024 + if (i >= ADIMLIM) + FEerror("Can't extend the string.", 0); + x->st.st_dim = i; + adjust_displaced(x, p - x->st.st_self); + } + x->st.st_self[x->st.st_fillp++] = c; + break; + + case smm_input: + case smm_probe: + case smm_concatenated: + case smm_string_input: + cannot_write(strm); + +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: + {object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + vs_base = vs_top; + vs_push(strm); + vs_push(code_char(c)); + super_funcall(strm->sm.sm_object1->str.str_self[2]); + vs_base = old_vs_base; + vs_top = old_vs_top; + break; + } + +#endif + default: + error("illegal stream mode"); + } + return(c); +} + +void +writestr_stream(s, strm) +char *s; +object strm; +{ + while (*s != '\0') + writec_stream(*s++, strm); +} + +void +flush_stream(object strm) { + object x; + +BEGIN: + switch (strm->sm.sm_mode) { + case smm_output: + case smm_io: + if (strm->sm.sm_fp == NULL) + closed_stream(strm); + fflush(strm->sm.sm_fp); + break; + case smm_socket: +#ifdef HAVE_NSOCKET + if (SOCKET_STREAM_FD(strm) >0) + gclFlushSocket(strm); + else +#endif + closed_stream(strm); + break; + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_broadcast: + for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) + flush_stream(x->c.c_car); + break; + + case smm_echo: + case smm_two_way: + strm = STREAM_OUTPUT_STREAM(strm); + goto BEGIN; + + + case smm_string_output: + break; + + case smm_input: + case smm_probe: + case smm_concatenated: + case smm_string_input: + FEerror("Cannot flush the stream ~S.", 1, strm); +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: + {object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + vs_base = vs_top; + vs_push(strm); + super_funcall(strm->sm.sm_object1->str.str_self[4]); + vs_base = old_vs_base; + vs_top = old_vs_top; + break; + } + +#endif + + default: + error("illegal stream mode"); + } +} + + +bool +stream_at_end(object strm) { +#define NON_CHAR -1000 + VOL int c = NON_CHAR; + +BEGIN: + switch (strm->sm.sm_mode) { + case smm_socket: + listen_stream(strm); + if (SOCKET_STREAM_FD(strm)>=0) + return(FALSE); + else return(TRUE); + case smm_io: + case smm_input: + if (strm->sm.sm_fp == NULL) + closed_stream(strm); + if (isatty(fileno((FILE *)strm->sm.sm_fp)) && !listen_stream(strm)) + return(feof(strm->sm.sm_fp) ? TRUE : FALSE); + {int prev_signals_allowed = signals_allowed; + AGAIN: + signals_allowed= sig_at_read; + c = kclgetc(strm->sm.sm_fp); + /* blocking getchar for sockets */ + /* if (c==EOF && (strm)->sm.sm_mode ==smm_socket) + c = getOneChar(strm->sm.sm_fp); */ + + + if (c == NON_CHAR) goto AGAIN; + signals_allowed=prev_signals_allowed;} + + if (xkclfeof(c,strm->sm.sm_fp)) + return(TRUE); + else { + if (c>=0) kclungetc(c, strm->sm.sm_fp); + return(FALSE); + } + + case smm_output: + return(FALSE); + + case smm_probe: + return(FALSE); + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + check_stream(strm); + goto BEGIN; + + case smm_broadcast: + return(FALSE); + + case smm_concatenated: + CONCATENATED: + if (endp(strm->sm.sm_object0)) + return(TRUE); + if (stream_at_end(strm->sm.sm_object0->c.c_car)) { + strm->sm.sm_object0 + = strm->sm.sm_object0->c.c_cdr; + goto CONCATENATED; + } else + return(FALSE); + + case smm_two_way: +#ifdef UNIX + if (strm == terminal_io) /**/ + flush_stream(terminal_io->sm.sm_object1); /**/ +#endif + strm = STREAM_INPUT_STREAM(strm); + goto BEGIN; + + case smm_echo: + strm = STREAM_INPUT_STREAM(strm); + goto BEGIN; + + case smm_string_input: + if (STRING_INPUT_STREAM_NEXT(strm)>= STRING_INPUT_STREAM_END(strm)) + return(TRUE); + else + return(FALSE); + + case smm_string_output: + return(FALSE); + +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: + return(FALSE); +#endif + default: + error("illegal stream mode"); + return(FALSE); + } +} + + +#ifdef HAVE_SYS_IOCTL_H +#include +#endif + + +#ifdef LISTEN_USE_FCNTL +#include +#endif + +bool +listen_stream(object strm) { + +BEGIN: + + switch (strm->sm.sm_mode) { +#ifdef HAVE_NSOCKET + case smm_socket: + + if (SOCKET_STREAM_BUFFER(strm)->ust.ust_fillp>0) return TRUE; + + /* { */ + /* fd_set fds; */ + /* struct timeval tv; */ + /* FD_ZERO(&fds); */ + /* FD_SET(SOCKET_STREAM_FD(strm),&fds); */ + /* memset(&tv,0,sizeof(tv)); */ + /* return select(SOCKET_STREAM_FD(strm)+1,&fds,NULL,NULL,&tv)>0 ? TRUE : FALSE; */ + /* } */ + { int ch = getCharGclSocket(strm,Cnil); + if (ch == EOF) return FALSE; + else unreadc_stream(ch,strm); + return TRUE; + } +#endif + + case smm_input: + case smm_io: + +#ifdef USE_READLINE + if (rl_stream_p(strm->sm.sm_fp)) + return rl_pending_buffered_input_p(strm->sm.sm_fp); +#endif + if (strm->sm.sm_fp == NULL) + closed_stream(strm); + if (feof(strm->sm.sm_fp)) + return(FALSE); +#ifdef LISTEN_FOR_INPUT + LISTEN_FOR_INPUT(strm->sm.sm_fp); +#else +#ifdef LISTEN_USE_FCNTL + do { int c = 0; + FILE *fp = strm->sm.sm_fp; + int orig; + int res; + if (feof(fp)) return TRUE; + orig = fcntl(fileno(fp), F_GETFL); + if (! (orig & O_NONBLOCK ) ) { + res=fcntl(fileno(fp),F_SETFL,orig | O_NONBLOCK); + } + c = getc(fp); + if (! (orig & O_NONBLOCK ) ){ + fcntl(fileno(fp),F_SETFL,orig ); + } + if (c != EOF) + { + ungetc(c,fp); + return TRUE; + } + return FALSE; + } while (0); +#endif +#endif + return TRUE; + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_concatenated: + if (endp(strm->sm.sm_object0)) + return(FALSE); + strm = strm->sm.sm_object0->c.c_car; /* Incomplete! */ + goto BEGIN; + + case smm_two_way: + case smm_echo: + strm = STREAM_INPUT_STREAM(strm); + goto BEGIN; + + case smm_string_input: + if (STRING_INPUT_STREAM_NEXT(strm)< STRING_INPUT_STREAM_END(strm)) + return(TRUE); + else + return(FALSE); + + case smm_output: + case smm_probe: + case smm_broadcast: + case smm_string_output: + FEerror("Can't listen to ~S.", 1, strm); + return(FALSE); + default: + error("illegal stream mode"); + return(FALSE); + } +} + +int +file_column(object strm) { + int i; + object x; + +BEGIN: + switch (strm->sm.sm_mode) { + case smm_output: + case smm_io: + case smm_socket: + case smm_string_output: + return(STREAM_FILE_COLUMN(strm)); + + case smm_echo: + case smm_two_way: + strm=STREAM_OUTPUT_STREAM(strm); + goto BEGIN; + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + + case smm_input: + case smm_probe: + case smm_string_input: + return(-1); + + case smm_concatenated: + if (endp(strm->sm.sm_object0)) + return(-1); + strm = strm->sm.sm_object0->c.c_car; + goto BEGIN; + + case smm_broadcast: + for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) { + i = file_column(x->c.c_car); + if (i >= 0) + return(i); + } + return(-1); + +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: /* not right but what is? */ + return(-1); + +#endif + default: + error("illegal stream mode"); + return(-1); + } +} + +void +load(const char *s) { + + object filename, strm, x; + vs_mark; + + if (user_match(s,strlen(s))) + return; + filename = make_simple_string(s); + vs_push(filename); + strm = open_stream(filename, smm_input, Cnil, sKerror); + vs_push(strm); + for (;;) { + preserving_whitespace_flag = FALSE; + detect_eos_flag = TRUE; + x = read_object_non_recursive(strm); + if (x == OBJNULL) + break; + vs_push(x); + ieval(x); + vs_popp; + } + close_stream(strm); + vs_reset; + +} + + + +LFD(Lmake_synonym_stream)() +{ + object x; + + check_arg(1); + check_type_sym(&vs_base[0]); + x = alloc_object(t_stream); + x->sm.sm_mode = (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; +} + +LFD(Lmake_broadcast_stream)() { + + object x; + int narg, i; + + narg = vs_top - vs_base; + for (i = 0; i < narg; i++) + if (type_of(vs_base[i]) != t_stream || + !output_stream_p(vs_base[i])) + cannot_write(vs_base[i]); + + Llist(); + + x = alloc_object(t_stream); + x->sm.sm_mode = (short)smm_broadcast; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + +} + +LFD(Lmake_concatenated_stream)() { + + object x; + int narg, i; + + narg = vs_top - vs_base; + for (i = 0; i < narg; i++) + if (type_of(vs_base[i]) != t_stream || + !input_stream_p(vs_base[i])) + cannot_read(vs_base[i]); + + Llist(); + + x = alloc_object(t_stream); + x->sm.sm_mode = (short)smm_concatenated; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + +} + +LFD(Lmake_two_way_stream)() +{ + check_arg(2); + + if (type_of(vs_base[0]) != t_stream || + !input_stream_p(vs_base[0])) + cannot_read(vs_base[0]); + if (type_of(vs_base[1]) != t_stream || + !output_stream_p(vs_base[1])) + cannot_write(vs_base[1]); + vs_base[0] = make_two_way_stream(vs_base[0], vs_base[1]); + vs_popp; +} + +LFD(Lmake_echo_stream)() +{ + check_arg(2); + + if (type_of(vs_base[0]) != t_stream || + !input_stream_p(vs_base[0])) + cannot_read(vs_base[0]); + if (type_of(vs_base[1]) != t_stream || + !output_stream_p(vs_base[1])) + cannot_write(vs_base[1]); + vs_base[0] = make_echo_stream(vs_base[0], vs_base[1]); + vs_popp; +} + +@(static defun make_string_output_stream (&k element_type) +@ + element_type=Cnil;/*FIXME*/ + @(return `make_string_output_stream(64)`) +@) + +LFD(Lget_output_stream_string)() +{ + check_arg(1); + + if (type_of(vs_base[0]) != t_stream || + (enum smmode)vs_base[0]->sm.sm_mode != smm_string_output) + FEerror("~S is not a string-output stream.", 1, vs_base[0]); + vs_base[0] = get_output_stream_string(vs_base[0]); +} + +/* + (SI:OUTPUT-STREAM-STRING string-output-stream) + + extracts the string associated with the given + string-output-stream. +*/ +LFD(siLoutput_stream_string)() +{ + check_arg(1); + if (type_of(vs_base[0]) != t_stream || + (enum smmode)vs_base[0]->sm.sm_mode != smm_string_output) + FEerror("~S is not a string-output stream.", 1, vs_base[0]); + vs_base[0] = vs_base[0]->sm.sm_object0; +} + +object +file_stream(object x) { + if (type_of(x)==t_stream) + switch(x->sm.sm_mode) { + case smm_input: + case smm_output: + case smm_io: + case smm_probe: + return x; + case smm_synonym: + return file_stream(x->sm.sm_object0->s.s_dbind); + default: + break; + } + return Cnil; +} + +DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(file_stream(x)!=Cnil ? Ct : Cnil); +} + +DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_synonym ? Ct : Cnil); +} + +DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_input && x->sm.sm_fp && isatty(fileno((FILE *)x->sm.sm_fp)) ? Ct : Cnil); +} + +DEFUN_NEW("BROADCAST-STREAM-P",object,fSbroadcast_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_broadcast ? Ct : Cnil); +} + +DEFUN_NEW("ECHO-STREAM-P",object,fSecho_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_echo ? Ct : Cnil); +} + +DEFUN_NEW("TWO-WAY-STREAM-P",object,fStwo_way_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_two_way ? Ct : Cnil); +} + +DEFUN_NEW("CONCATENATED-STREAM-P",object,fSconcatenated_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_concatenated ? Ct : Cnil); +} + + + +LFD(Lstreamp)() +{ + check_arg(1); + + if (type_of(vs_base[0]) == t_stream) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Linput_stream_p)() +{ + check_arg(1); + + check_type_stream(&vs_base[0]); + if (input_stream_p(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Loutput_stream_p)() +{ + check_arg(1); + + check_type_stream(&vs_base[0]); + if (output_stream_p(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Lstream_element_type)() +{ + check_arg(1); + + check_type_stream(&vs_base[0]); + vs_base[0] = stream_element_type(vs_base[0]); +} + +@(defun close (strm &key abort) +@ + check_type_stream(&strm); + close_stream(strm); + @(return Ct) +@) + + + +object sLAload_pathnameA; +DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); +DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,""); + +DEFUN_NEW("LOAD-STREAM",object,fSload_stream,SI,2,2,NONE,OO,OO,OO,OO,(object strm,object print),"") { + + object x; + + for (;;) { + preserving_whitespace_flag = FALSE; + detect_eos_flag = TRUE; + if ((x = READ_STREAM_OR_FASD(strm))==OBJNULL) + break; + { + object *base = vs_base, *top = vs_top, *lex = lex_env; + object xx; + + lex_new(); + eval(x); + xx = vs_base[0]; + lex_env = lex; + vs_top = top; + vs_base = base; + x = xx; + } + if (print != Cnil) { + SETUP_PRINT_DEFAULT(x); + write_object(x, 0); + write_str("\n"); + CLEANUP_PRINT_DEFAULT; + flush_stream(PRINTstream); + } + } + + RETURN1(Ct); + +} +#ifdef STATIC_FUNCTION_POINTERS +object +fSload_stream(object strm,object print) { + return FFN(fSload_stream)(strm,print); +} +#endif + +DEFUN_NEW("LOAD-FASL",object,fSload_fasl,SI,2,2,NONE,OO,OO,OO,OO,(object fasl_filename,object print),"") { + + int i; + + if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { + object _x=sSAbinary_modulesA->s.s_dbind; + object _y=Cnil; + while (_x!=Cnil) { + _y=_x; + _x=_x->c.c_cdr; + } + if (_y==Cnil) + sSAbinary_modulesA->s.s_dbind=make_cons(fasl_filename,Cnil); + else + _y->c.c_cdr=make_cons(fasl_filename,Cnil); + } + i = fasload(fasl_filename); + if (print != Cnil) { + SETUP_PRINT_DEFAULT(Cnil); + vs_top = PRINTvs_top; + if (file_column(PRINTstream) != 0) + write_str("\n"); + write_str(";; Fasload successfully ended."); + write_str("\n"); + CLEANUP_PRINT_DEFAULT; + flush_stream(PRINTstream); + } + + RETURN1(make_fixnum(i)); + +} + +LFD(siLmake_string_output_stream_from_string)() +{ + object strng, strm; + + check_arg(1); + strng = vs_base[0]; + if (type_of(strng) != t_string || !strng->st.st_hasfillp) + FEerror("~S is not a string with a fill-pointer.", 1, strng); + strm = alloc_object(t_stream); + strm->sm.sm_mode = (short)smm_string_output; + strm->sm.sm_fp = NULL; + strm->sm.sm_buffer = 0; + STRING_STREAM_STRING(strm) = strng; + strm->sm.sm_object1 = OBJNULL; + /* strm->sm.sm_int0 = strng->st.st_fillp; */ + STREAM_FILE_COLUMN(strm) = 0; + strm->sm.sm_flags=0; + vs_base[0] = strm; +} + +LFD(siLcopy_stream)() +{ + object in, out; + + check_arg(2); + check_type_stream(&vs_base[0]); + check_type_stream(&vs_base[1]); + in = vs_base[0]; + out = vs_base[1]; + while (!stream_at_end(in)) + writec_stream(readc_stream(in), out); + flush_stream(out); + vs_base[0] = Ct; + vs_popp; +#ifdef AOSVS + +#endif +} + +/* static void */ +/* too_long_file_name(fn) */ +/* object fn; */ +/* { */ +/* FEerror("~S is a too long file name.", 1, fn); */ +/* } */ + +static void +cannot_open(fn) +object fn; +{ + FILE_ERROR(fn,"Cannot open"); +} + +static void +cannot_create(fn) +object fn; +{ + FILE_ERROR(fn,"Cannot create"); +} + +static void +cannot_read(strm) +object strm; +{ + FEerror("Cannot read the stream ~S.", 1, strm); +} + +static void +cannot_write(strm) +object strm; +{ + FEerror("Cannot write to the stream ~S.", 1, strm); +} + +#ifdef USER_DEFINED_STREAMS +/* more support for user defined streams */ +static void +FFN(siLuser_stream_state)() +{ + check_arg(1); + + if(vs_base[0]->sm.sm_object1) + vs_base[0] = vs_base[0]->sm.sm_object1->str.str_self[0]; + else + FEerror("sLtream data NULL ~S", 1, vs_base[0]); +} +#endif + +static void +closed_stream(strm) +object strm; +{ + if (!GET_STREAM_FLAG(strm,gcl_sm_had_error)) + { + SET_STREAM_FLAG(strm,gcl_sm_had_error,1); + FEerror("The stream ~S is already closed.", 1, strm); + } + +} + + + +/* returns a stream with which one can safely do fwrite to the x->sm.sm_fp + or nil. + */ + + +/* coerce stream to one so that x->sm.sm_fp is suitable for fread and fwrite, + Return nil if this is not possible. + */ + +object +coerce_stream(strm,out) +object strm; +int out; +{ + BEGIN: + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + switch (strm->sm.sm_mode){ + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + goto BEGIN; + + case smm_two_way: + case smm_echo: + if (out)strm = STREAM_OUTPUT_STREAM(strm); + else strm = STREAM_INPUT_STREAM(strm); + goto BEGIN; + case smm_output: + if (!out) cannot_read(strm); + break; + case smm_input: + if (out) cannot_write(strm); + break; + case smm_io: + /* case smm_socket: */ + break; + + default: + strm=Cnil; + } + if (strm!=Cnil + && (strm->sm.sm_fp == NULL)) + closed_stream(strm); + return(strm); +} + +static void +FFN(siLfp_output_stream)() +{check_arg(1); + vs_base[0]=coerce_stream(vs_base[0],1); +} + +static void +FFN(siLfp_input_stream)() +{check_arg(1); + vs_base[0]=coerce_stream(vs_base[0],0); +} + + +@(static defun fwrite (vector start count stream) + unsigned char *p; + int n,beg; +@ + stream=coerce_stream(stream,1); + if (stream==Cnil) @(return Cnil); + p = vector->ust.ust_self; + beg = ((type_of(start)==t_fixnum) ? fix(start) : 0); + n = ((type_of(count)==t_fixnum) ? fix(count) : (vector->st.st_fillp - beg)); + if (fwrite(p+beg,1,n,stream->sm.sm_fp)) @(return Ct); + @(return Cnil); +@) + +@(static defun fread (vector start count stream) + char *p; + int n,beg; +@ + stream=coerce_stream(stream,0); + if (stream==Cnil) @(return Cnil); + p = vector->st.st_self; + beg = ((type_of(start)==t_fixnum) ? fix(start) : 0); + n = ((type_of(count)==t_fixnum) ? fix(count) : (vector->st.st_fillp - beg)); + if ((n=SAFE_FREAD(p+beg,1,n,stream->sm.sm_fp))) + @(return `make_fixnum(n)`); + @(return Cnil); +@) + +#ifdef HAVE_NSOCKET + +#ifdef DODEBUG +#define dprintf(s,arg) emsg(s,arg) +#else +#define dprintf(s,arg) +#endif + + + +/* + putCharGclSocket(strm,ch) -- put one character to a socket + stream. + Results: + Side Effects: The buffer may be filled, and the fill pointer + of the buffer may be changed. + */ +static void +putCharGclSocket(strm,ch) + object strm; + int ch; +{ + object bufp = SOCKET_STREAM_BUFFER(strm); + + AGAIN: + if (bufp->ust.ust_fillp < bufp->ust.ust_dim) { + dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); + bufp->ust.ust_self[(bufp->ust.ust_fillp)++]=ch; + return; + } + else { + gclFlushSocket(strm); + goto AGAIN; + } +} + +static void +gclFlushSocket(strm) + object strm; + +{ + int fd = SOCKET_STREAM_FD(strm); + object bufp = SOCKET_STREAM_BUFFER(strm); + int i=0; + int err; + int wrote; + if (!GET_STREAM_FLAG(strm,gcl_sm_output) + || GET_STREAM_FLAG(strm,gcl_sm_had_error)) + return; +#define AMT_TO_WRITE 500 + while(i< bufp->ust.ust_fillp) { + wrote =TcpOutputProc ( fd, + &(bufp->st.st_self[i]), + bufp->ust.ust_fillp-i > AMT_TO_WRITE ? AMT_TO_WRITE : bufp->ust.ust_fillp-i, + &err +#ifdef __MINGW32__ + , TRUE /* Wild guess as to whether it should block or not */ +#endif +); + if (wrote < 0) { + SET_STREAM_FLAG(strm,gcl_sm_had_error,1); + close_stream(strm); + FEerror("error writing to socket: errno= ~a",1,make_fixnum(err)); + + } + i+= wrote; + } + bufp->ust.ust_fillp=0; +} + +static +object +make_socket_stream(fd,mode,server,host,port,async) +int fd; +enum gcl_sm_flags mode; +object server; +object host; +object port; +object async; +{ + object x; + if (fd < 0 ) + { + FEerror("Could not connect",0); + } + x = alloc_object(t_stream); + x->sm.sm_mode = smm_socket; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = list(3,server,host,port); + x->sm.sm_object1 = 0; + x->sm.sm_int = 0; + x->sm.sm_flags=0; + SOCKET_STREAM_FD(x)= fd; + SET_STREAM_FLAG(x,mode,1); + SET_STREAM_FLAG(x,gcl_sm_tcp_async,(async!=Cnil)); + /* + if (mode == gcl_sm_output) + { fp=fdopen(fd,(mode==gcl_sm_input ? "r" : "w")); + if (fp==NULL) FEerror("Could not connect",0); + x->sm.sm_fp = fp; + setup_stream_buffer(x); + } else + */ + { + object buffer; + x->sm.sm_fp = NULL; + buffer=alloc_simple_string((BUFSIZ < 4096 ? 4096 : BUFSIZ)); + SOCKET_STREAM_BUFFER(x) =buffer; + buffer->ust.ust_self = alloc_contblock(buffer->st.st_dim); + buffer->ust.ust_fillp = 0; + } + return x; +} + +static object +maccept(object x) { + + int fd; + socklen_t n; + struct sockaddr_in addr; + object server,host,port; + + if (type_of(x) != t_stream) + FEerror("~S is not a steam~%",1,x); + if (x->sm.sm_mode!=smm_two_way) + FEerror("~S is not a two-way steam~%",1,x); + fd=accept(SOCKET_STREAM_FD(STREAM_INPUT_STREAM(x)),(struct sockaddr *)&addr,&n); + if (fd <0) { + FEerror("Error ~S on accepting connection to ~S~%",2,make_simple_string(strerror(errno)),x); + x=Cnil; + } else { + server=STREAM_INPUT_STREAM(x)->sm.sm_object0->c.c_car; + host=STREAM_INPUT_STREAM(x)->sm.sm_object0->c.c_cdr->c.c_car; + port=STREAM_INPUT_STREAM(x)->sm.sm_object0->c.c_cdr->c.c_cdr->c.c_car; + x = make_two_way_stream + (make_socket_stream(fd,gcl_sm_input,server,host,port,Cnil), + make_socket_stream(fd,gcl_sm_output,server,host,port,Cnil)); + } + return x; + +} + +#ifdef BSD +#include +#include +#include + +#if defined(DARWIN) +#define on_exit(a,b) +#else +static void +rmc(int e,void *pid) { + + kill((long)pid,SIGTERM); + +} +#endif +#endif + +@(static defun socket (port &key host server async myaddr myport daemon) + /* + HOST is a string then connection is made to that + ip or domain address. + SERVER A function to call if this is to be a server + + ASYNC socket returned immideiately. read or flush + will block till open if in non blocking mode + MYADDR client's ip address. Useful if have several + net interfaces + MYPORT port to use on client side + */ +int fd; +int isServer = 0; +int inPort; +char buf1[500]; +char buf2[500]; +char *myaddrPtr=buf1,*hostPtr=buf2; +object x=Cnil; +@ + if (type_of(host) == t_string) { + hostPtr=lisp_copy_to_null_terminated(host,hostPtr,sizeof(buf1)); + } else { hostPtr = NULL; } + + if (fLfunctionp(server) == Ct) { + isServer=1; + } + + if (myaddr != Cnil) { + myaddrPtr=lisp_copy_to_null_terminated(myaddr,myaddrPtr,sizeof(buf2)); + } else { myaddrPtr = NULL; } + if (isServer == 0 && hostPtr == NULL) { + FEerror("You must supply at least one of :host hostname or :server function",0); + } + Iis_fixnum(port); + inPort = (myport == Cnil ? 0 : fix(Iis_fixnum(myport))); + +#ifdef BSD + + if (isServer && daemon != Cnil) { + + long pid,i; + struct rlimit r; + struct sigaction sa,osa; + + sa.sa_handler=SIG_IGN; + sa.sa_flags=SA_NOCLDWAIT; + sigemptyset(&sa.sa_mask); + + massert(!sigaction(SIGCHLD,&sa,&osa)); + + switch((pid=pvfork())) { + case -1: + FEerror("Cannot fork", 0); + break; + case 0: + + massert(setsid()>=0); + + if (daemon == sKpersistent) + switch(pvfork()) { + case -1: + FEerror("daemon fork error", 0); + break; + case 0: + break; + default: + exit(0); + break; + } + + massert(!chdir("/")); + + memset(&r,0,sizeof(r)); + massert(!getrlimit(RLIMIT_NOFILE,&r)); + + for (i=0;i=0); + massert((i=dup(i))>=0); + massert((i=dup(i))>=0); + + umask(0); + + fd = CreateSocket(fix(port),hostPtr,isServer,myaddrPtr,inPort,(async!=Cnil)); + + x = make_two_way_stream + (make_socket_stream(fd,gcl_sm_input,server,host,port,async), + make_socket_stream(fd,gcl_sm_output,server,host,port,async)); + + for (;;) { + + fd_set fds; + object y; + + FD_ZERO(&fds); + FD_SET(fd,&fds); + + if (select(fd+1,&fds,NULL,NULL,NULL)>0) { + + y=maccept(x); + + switch((pid=pvfork())) { + case 0: + massert(!sigaction(SIGCHLD,&osa,NULL)); + ifuncall1(server,y); + exit(0); + break; + case -1: + do_gcl_abort(); + break; + default: + close_stream(y); + break; + } + + } + } + break; + default: + if (daemon != sKpersistent) { + on_exit(rmc,(void *)pid); + x=make_fixnum(pid); + } else + x=Cnil; + break; + } + + massert(!sigaction(SIGCHLD,&osa,NULL)); + + } else + +#endif + + { + fd = CreateSocket(fix(port),hostPtr,isServer,myaddrPtr,inPort,(async!=Cnil)); + + x = make_two_way_stream + (make_socket_stream(fd,gcl_sm_input,server,host,port,async), + make_socket_stream(fd,gcl_sm_output,server,host,port,async)); + + } + + @(return `x`); + +@) + +DEF_ORDINARY("MYADDR",sKmyaddr,KEYWORD,""); +DEF_ORDINARY("MYPORT",sKmyport,KEYWORD,""); +DEF_ORDINARY("ASYNC",sKasync,KEYWORD,""); +DEF_ORDINARY("HOST",sKhost,KEYWORD,""); +DEF_ORDINARY("SERVER",sKserver,KEYWORD,""); +DEF_ORDINARY("DAEMON",sKdaemon,KEYWORD,""); +DEF_ORDINARY("PERSISTENT",sKpersistent,KEYWORD,""); +DEF_ORDINARY("SOCKET",sSsocket,SI,""); + + +@(static defun accept (x) +@ + x=maccept(x); + @(return `x`); +@) + +#endif /* HAVE_NSOCKET */ + +object standard_io; +object standard_error; +DEFVAR("*STANDARD-INPUT*",sLAstandard_inputA,LISP,(gcl_init_file(),standard_io),""); +DEFVAR("*STANDARD-OUTPUT*",sLAstandard_outputA,LISP,standard_io,""); +DEFVAR("*ERROR-OUTPUT*",sLAerror_outputA,LISP,standard_error,""); +DEFVAR("*TERMINAL-IO*",sLAterminal_ioA,LISP,terminal_io,""); +DEFVAR("*QUERY-IO*",sLAquery_ioA,LISP, + (standard_io->sm.sm_object0 = sLAterminal_ioA, + standard_io),""); +DEFVAR("*DEBUG-IO*",sLAdebug_ioA,LISP,standard_io,""); +DEFVAR("*TRACE-OUTPUT*",sLAtrace_outputA,LISP,standard_io,""); + + +void +gcl_init_file(void) +{ + object standard_input; + object standard_output; + object standard; + object x; + standard_input = alloc_object(t_stream); + standard_input->sm.sm_mode = (short)smm_input; + standard_input->sm.sm_fp = stdin; + standard_input->sm.sm_buffer = 0; + standard_input->sm.sm_object0 = sLcharacter; + standard_input->sm.sm_object1 +#ifdef UNIX + = make_simple_string("stdin"); +#endif + standard_input->sm.sm_int = 0; /* unused */ + standard_input->sm.sm_flags=0; + + standard_output = alloc_object(t_stream); + standard_output->sm.sm_mode = (short)smm_output; + standard_output->sm.sm_fp = stdout; + standard_output->sm.sm_buffer = 0; + standard_output->sm.sm_object0 = sLcharacter; + standard_output->sm.sm_object1 +#ifdef UNIX + = make_simple_string("stdout"); +#endif + standard_output->sm.sm_int = 0; /* unused */ + standard_output->sm.sm_flags=0; + + standard_error = alloc_object(t_stream); + standard_error->sm.sm_mode = (short)smm_output; + standard_error->sm.sm_fp = stderr; + standard_error->sm.sm_buffer = 0; + standard_error->sm.sm_object0 = sLcharacter; + standard_error->sm.sm_object1 +#ifdef UNIX + = make_simple_string("stderr"); +#endif + standard_error->sm.sm_int = 0; /* unused */ + standard_error->sm.sm_flags=0; + enter_mark_origin(&standard_error); + + terminal_io = standard + = make_two_way_stream(standard_input, standard_output); + enter_mark_origin(&terminal_io); + + x = alloc_object(t_stream); + x->sm.sm_mode = (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLAterminal_ioA; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int = 0; /* unused */ + x->sm.sm_flags=0; + standard_io = x; + enter_mark_origin(&standard_io); + +} + +DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,""); +DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,""); +DEFVAR("*LOAD-TRUENAME*",sSAload_truenameA,LISP,Cnil,""); +DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,""); +DEFVAR("*LOAD-PRINT*",sLAload_printA,LISP,Cnil,""); + +DEF_ORDINARY("ABORT",sKabort,KEYWORD,""); +DEF_ORDINARY("APPEND",sKappend,KEYWORD,""); +DEF_ORDINARY("CREATE",sKcreate,KEYWORD,""); +DEF_ORDINARY("DEFAULT",sKdefault,KEYWORD,""); +DEF_ORDINARY("DIRECTION",sKdirection,KEYWORD,""); +DEF_ORDINARY("ELEMENT-TYPE",sKelement_type,KEYWORD,""); +DEF_ORDINARY("ERROR",sKerror,KEYWORD,""); +DEF_ORDINARY("IF-DOES-NOT-EXIST",sKif_does_not_exist,KEYWORD,""); +DEF_ORDINARY("IF-EXISTS",sKif_exists,KEYWORD,""); +DEF_ORDINARY("INPUT",sKinput,KEYWORD,""); +DEF_ORDINARY("IO",sKio,KEYWORD,""); +DEF_ORDINARY("NEW-VERSION",sKnew_version,KEYWORD,""); +DEF_ORDINARY("OUTPUT",sKoutput,KEYWORD,""); +DEF_ORDINARY("OVERWRITE",sKoverwrite,KEYWORD,""); +DEF_ORDINARY("PRINT",sKprint,KEYWORD,""); +DEF_ORDINARY("PROBE",sKprobe,KEYWORD,""); +DEF_ORDINARY("RENAME",sKrename,KEYWORD,""); +DEF_ORDINARY("RENAME-AND-DELETE",sKrename_and_delete,KEYWORD,""); +DEF_ORDINARY("SET-DEFAULT-PATHNAME",sKset_default_pathname,KEYWORD,""); +DEF_ORDINARY("SUPERSEDE",sKsupersede,KEYWORD,""); +DEF_ORDINARY("VERBOSE",sKverbose,KEYWORD,""); + + +DEF_ORDINARY("DELETE-FILE",sLdelete_file,LISP,""); + + +void +gcl_init_file_function() +{ + + +#ifdef UNIX + FASL_string = make_simple_string("o"); + make_si_constant("*EOF*",make_fixnum(EOF)); +#endif +#ifdef AOSVS + +#endif + enter_mark_origin(&FASL_string); +#ifdef UNIX + LSP_string = make_simple_string("lsp"); +#endif +#ifdef AOSVS + +#endif + enter_mark_origin(&LSP_string); + make_si_function("FP-INPUT-STREAM", siLfp_input_stream); + make_si_function("FP-OUTPUT-STREAM", siLfp_output_stream); + + make_function("MAKE-SYNONYM-STREAM", Lmake_synonym_stream); + make_function("MAKE-BROADCAST-STREAM", Lmake_broadcast_stream); + make_function("MAKE-CONCATENATED-STREAM", + Lmake_concatenated_stream); + make_function("MAKE-TWO-WAY-STREAM", Lmake_two_way_stream); + make_function("MAKE-ECHO-STREAM", Lmake_echo_stream); + make_function("MAKE-STRING-OUTPUT-STREAM", + Lmake_string_output_stream); + make_function("GET-OUTPUT-STREAM-STRING", + Lget_output_stream_string); + + make_si_function("OUTPUT-STREAM-STRING", siLoutput_stream_string); + make_si_function("FWRITE",Lfwrite); + make_si_function("FREAD",Lfread); +#ifdef HAVE_NSOCKET + make_si_function("SOCKET",Lsocket); + make_si_function("ACCEPT",Laccept); +#endif + make_function("STREAMP", Lstreamp); + make_function("INPUT-STREAM-P", Linput_stream_p); + make_function("OUTPUT-STREAM-P", Loutput_stream_p); + make_function("STREAM-ELEMENT-TYPE", Lstream_element_type); + make_function("CLOSE", Lclose); + + make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING", + siLmake_string_output_stream_from_string); + make_si_function("COPY-STREAM", siLcopy_stream); + +#ifdef USER_DEFINED_STREAMS + make_si_function("USER-STREAM-STATE", siLuser_stream_state); +#endif + +#ifdef USE_READLINE + gcl_init_readline_function(); +#endif +} diff --git a/o/firstfile.c b/o/firstfile.c new file mode 100755 index 0000000..4cc5537 --- /dev/null +++ b/o/firstfile.c @@ -0,0 +1,34 @@ +/* Mark beginning of data space to dump as pure, for GNU Emacs. + Copyright (C) 1985 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +#include "config.h" + +/* See comments in lastfile.c. */ +char my_begdata[] = "Beginning of Emacs initialized data"; +char my_begbss[1]; /* Do not initialize this variable. */ +static char _my_begbss[1]; +char * my_begbss_static = _my_begbss; + +/* Add a dummy reference to ensure emacs.obj is linked in. */ +#ifdef emacs +extern int initialized; +static int * dummy = &initialized; +#endif diff --git a/o/fix-structref.el b/o/fix-structref.el new file mode 100755 index 0000000..33c546a --- /dev/null +++ b/o/fix-structref.el @@ -0,0 +1,17 @@ +(defun fix-struct-ref () + (interactive) + (while (re-search-forward "->\\([a-z]+\\)+[.]\\([A-Z][a-zA-Z]+\\)") + (sit-for 0) + (cond ((y-or-n-p "do it?") + (downcase-region (match-beginning 2) (match-end 2)) + (let ((xx (buffer-substring (match-beginning 2) (match-end 2))) + (tem (buffer-substring (match-beginning 1) (match-end 1)))) + (delete-region (match-beginning 2) (match-end 2)) + (goto-char (match-beginning 2)) + (insert tem "_") + (let ((u (assoc xx '(("bind" . "dbind") + ("body" . "self") + )))) + (insert (or (cdr u) xx)))))))) + + diff --git a/o/format.c b/o/format.c new file mode 100755 index 0000000..f62da47 --- /dev/null +++ b/o/format.c @@ -0,0 +1,2323 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + format.c +*/ + +#include "include.h" + +static int +fmt_thousand(int,int,bool,bool,int); + +static void +fmt_exponent1(int); + +static void +fmt_write_numeral(int,int); + +static void +fmt_write_ordinal(int,int); + +static int +fmt_nonillion(int,int,bool,bool,int); + +static void +fmt_roman(int,int,int,int,int); + +static void +fmt_integer(object,bool,bool,int,int,int,int); + +static void +fmt_semicolon(bool,bool); + +static void +fmt_up_and_out(bool,bool); + +static void +fmt_justification(volatile bool,bool); + +static void +fmt_iteration(bool,bool); + +static void +fmt_conditional(bool,bool); + +static void +fmt_case(bool,bool); + +static void +fmt_indirection(bool,bool); + +static void +fmt_asterisk(bool,bool); + +static void +fmt_tabulate(bool,bool); + +static void +fmt_newline(bool,bool); + +static void +fmt_tilde(bool,bool); + +static void +fmt_bar(bool,bool); + +static void +fmt_ampersand(bool,bool); + +static void +fmt_percent(bool,bool); + +static void +fmt_dollars_float(bool,bool); + +static void +fmt_general_float(bool,bool); + +static void +fmt_exponential_float(bool,bool); + +static void +fmt_fix_float(bool,bool); + +static void +fmt_character(bool,bool); + +static void +fmt_plural(bool,bool); + +static void +fmt_radix(bool,bool); + +static void +fmt_hexadecimal(bool,bool); + +static void +fmt_octal(bool,bool); + +static void +fmt_binary(bool,bool); + +static void +fmt_error(char *); + +static void +fmt_ascii(bool, bool); + +static void +fmt_S_expression(bool, bool); + +static void +fmt_decimal(bool, bool); + + +object sSAindent_formatted_outputA; + + +#define ctl_string (fmt_string->st.st_self + ctl_origin) + +#define fmt_old VOL object old_fmt_stream; \ + VOL int old_ctl_origin; \ + VOL int old_ctl_index; \ + VOL int old_ctl_end; \ + object * VOL old_fmt_base; \ + VOL int old_fmt_index; \ + VOL int old_fmt_end; \ + jmp_bufp VOL old_fmt_jmp_bufp; \ + VOL int old_fmt_indents; \ + VOL object old_fmt_string ; \ + VOL format_parameter *old_fmt_paramp +#define fmt_save old_fmt_stream = fmt_stream; \ + old_ctl_origin = ctl_origin; \ + old_ctl_index = ctl_index; \ + old_ctl_end = ctl_end; \ + old_fmt_base = fmt_base; \ + old_fmt_index = fmt_index; \ + old_fmt_end = fmt_end; \ + old_fmt_jmp_bufp = fmt_jmp_bufp; \ + old_fmt_indents = fmt_indents; \ + old_fmt_string = fmt_string ; \ + old_fmt_paramp = fmt_paramp +#define fmt_restore fmt_stream = old_fmt_stream; \ + ctl_origin = old_ctl_origin; \ + ctl_index = old_ctl_index; \ + ctl_end = old_ctl_end; \ + fmt_base = old_fmt_base; \ + fmt_index = old_fmt_index; \ + fmt_end = old_fmt_end; \ + fmt_jmp_bufp = old_fmt_jmp_bufp; \ + fmt_indents = old_fmt_indents; \ + fmt_string = old_fmt_string ; \ + fmt_paramp = old_fmt_paramp + +#define fmt_old1 VOL object old_fmt_stream; \ + VOL int old_ctl_origin; \ + VOL int old_ctl_index; \ + VOL int old_ctl_end; \ + jmp_bufp VOL old_fmt_jmp_bufp; \ + VOL int old_fmt_indents; \ + VOL object old_fmt_string ; \ + VOL format_parameter *old_fmt_paramp +#define fmt_save1 old_fmt_stream = fmt_stream; \ + old_ctl_origin = ctl_origin; \ + old_ctl_index = ctl_index; \ + old_ctl_end = ctl_end; \ + old_fmt_jmp_bufp = fmt_jmp_bufp; \ + old_fmt_indents = fmt_indents; \ + old_fmt_string = fmt_string ; \ + old_fmt_paramp = fmt_paramp +#define fmt_restore1 fmt_stream = old_fmt_stream; \ + ctl_origin = old_ctl_origin; \ + ctl_index = old_ctl_index; \ + ctl_end = old_ctl_end; \ + fmt_jmp_bufp = old_fmt_jmp_bufp; \ + fmt_indents = old_fmt_indents; \ + fmt_string = old_fmt_string ; \ + fmt_paramp = old_fmt_paramp + +typedef struct { + int fmt_param_type; + int fmt_param_value; + } format_parameter; + +format_parameter fmt_param[100]; +VOL format_parameter *fmt_paramp; +#define FMT_PARAM (fmt_paramp) + +#ifndef WRITEC_NEWLINE +#define WRITEC_NEWLINE(strm) (writec_stream('\n',strm)) +#endif + +object fmt_temporary_stream; +object fmt_temporary_string; + +int fmt_nparam; +enum fmt_types { + fmt_null, + fmt_int, + fmt_char}; + +char *fmt_big_numeral[] = { + "thousand", + "million", + "billion", + "trillion", + "quadrillion", + "quintillion", + "sextillion", + "septillion", + "octillion" +}; + +char *fmt_numeral[] = { + "zero", "one", "two", "three", "four", + "five", "six", "seven", "eight", "nine", + "ten", "eleven", "twelve", "thirteen", "fourteen", + "fifteen", "sixteen", "seventeen", "eighteen", "nineteen", + "zero", "ten", "twenty", "thirty", "forty", + "fifty", "sixty", "seventy", "eighty", "ninety" +}; + +char *fmt_ordinal[] = { + "zeroth", "first", "second", "third", "fourth", + "fifth", "sixth", "seventh", "eighth", "ninth", + "tenth", "eleventh", "twelfth", "thirteenth", "fourteenth", + "fifteenth", "sixteenth", "seventeenth", "eighteenth", "nineteenth", + "zeroth", "tenth", "twentieth", "thirtieth", "fortieth", + "fiftieth", "sixtieth", "seventieth", "eightieth", "ninetieth" +}; + + +int fmt_spare_spaces; +int fmt_line_length; + + +static int +fmt_tempstr(int s) +{ + return(fmt_temporary_string->st.st_self[s]); +} + +static int +ctl_advance(void) +{ + if (ctl_index >= ctl_end) + fmt_error("unexpected end of control string"); + return(ctl_string[ctl_index++]); +} + +static object +fmt_advance(void) +{ + if (fmt_index >= fmt_end) + fmt_error("arguments exhausted"); + return(fmt_base[fmt_index++]); +} + + +static void +format(object fmt_stream0, int ctl_origin0, int ctl_end0) +{ + int c, i, n; + bool colon, atsign; + object x; + fmt_paramp = fmt_param; + + /* could eliminate the no interrupt if made the + temporary stream on the stack... */ + {BEGIN_NO_INTERRUPT; + fmt_stream = fmt_stream0; + ctl_origin = ctl_origin0; + ctl_index = 0; + ctl_end = ctl_end0; + +LOOP: + if (ctl_index >= ctl_end) + { END_NO_INTERRUPT; + return;} + if ((c = ctl_advance()) != '~') { + writec_stream(c, fmt_stream); + goto LOOP; + } + n = 0; + for (;;) { + switch (c = ctl_advance()) { + case ',': + fmt_param[n].fmt_param_type = fmt_null; + break; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + DIGIT: + i = 0; + do { + i = i*10 + (c - '0'); + c = ctl_advance(); + } while (isDigit(c)); + fmt_param[n].fmt_param_type = fmt_int; + fmt_param[n].fmt_param_value = i; + break; + + case '+': + c = ctl_advance(); + if (!isDigit(c)) + fmt_error("digit expected"); + goto DIGIT; + + case '-': + c = ctl_advance(); + if (!isDigit(c)) + fmt_error("digit expected"); + i = 0; + do { + i = i*10 + (c - '0'); + c = ctl_advance(); + } while (isDigit(c)); + fmt_param[n].fmt_param_type = fmt_int; + fmt_param[n].fmt_param_value = -i; + break; + + case '\'': + fmt_param[n].fmt_param_type = fmt_char; + fmt_param[n].fmt_param_value = ctl_advance(); + c = ctl_advance(); + break; + + case 'v': case 'V': + x = fmt_advance(); + if (type_of(x) == t_fixnum) { + fmt_param[n].fmt_param_type = fmt_int; + fmt_param[n].fmt_param_value = fix(x); + } else if (type_of(x) == t_character) { + fmt_param[n].fmt_param_type = fmt_char; + fmt_param[n].fmt_param_value = x->ch.ch_code; + } else if (x == Cnil) { + fmt_param[n].fmt_param_type = fmt_null; + } else + fmt_error("illegal V parameter"); + c = ctl_advance(); + break; + + case '#': + fmt_param[n].fmt_param_type = fmt_int; + fmt_param[n].fmt_param_value = fmt_end - fmt_index; + c = ctl_advance(); + break; + + default: +/* if (n > 0) + fmt_error("illegal ,"); + else +*/ + /* allow (FORMAT NIL "~5,,X" 10) ; ie ,just before directive */ + + goto DIRECTIVE; + } + n++; + if (c != ',') + break; + } + +DIRECTIVE: + colon = atsign = FALSE; + if (c == ':') { + colon = TRUE; + c = ctl_advance(); + } + if (c == '@') { + atsign = TRUE; + c = ctl_advance(); + } + fmt_nparam = n; + switch (c) { + case 'a': case 'A': + fmt_ascii(colon, atsign); + break; + + case 's': case 'S': + fmt_S_expression(colon, atsign); + break; + + case 'd': case 'D': + fmt_decimal(colon, atsign); + break; + + case 'b': case 'B': + fmt_binary(colon, atsign); + break; + + case 'o': case 'O': + fmt_octal(colon, atsign); + break; + + case 'x': case 'X': + fmt_hexadecimal(colon, atsign); + break; + + case 'r': case 'R': + fmt_radix(colon, atsign); + break; + + case 'p': case 'P': + fmt_plural(colon, atsign); + break; + + case 'c': case 'C': + fmt_character(colon, atsign); + break; + + case 'f': case 'F': + fmt_fix_float(colon, atsign); + break; + + case 'e': case 'E': + fmt_exponential_float(colon, atsign); + break; + + case 'g': case 'G': + fmt_general_float(colon, atsign); + break; + + case '$': + fmt_dollars_float(colon, atsign); + break; + + case '%': + fmt_percent(colon, atsign); + break; + + case '&': + fmt_ampersand(colon, atsign); + break; + + case '|': + fmt_bar(colon, atsign); + break; + + case '~': + fmt_tilde(colon, atsign); + break; + + case '\n': + case '\r': + fmt_newline(colon, atsign); + break; + + case 't': case 'T': + fmt_tabulate(colon, atsign); + break; + + case '*': + fmt_asterisk(colon, atsign); + break; + + case '?': + fmt_indirection(colon, atsign); + break; + + case '(': + fmt_case(colon, atsign); + break; + + case '[': + fmt_conditional(colon, atsign); + break; + + case '{': + fmt_iteration(colon, atsign); + break; + + case '<': + fmt_justification(colon, atsign); + break; + + case '^': + fmt_up_and_out(colon, atsign); + break; + + case ';': + fmt_semicolon(colon, atsign); + break; + + default: + {object user_fmt=getf(sSAindent_formatted_outputA->s.s_plist,make_fixnum(c),Cnil); + + if (user_fmt!=Cnil) + {object *oldbase=vs_base; + object *oldtop=vs_top; + vs_base=vs_top; + vs_push(fmt_advance()); + vs_push(fmt_stream); + vs_push(make_fixnum(colon)); + vs_push(make_fixnum(atsign)); + if (type_of(user_fmt)==t_symbol) user_fmt=symbol_function(user_fmt); + funcall(user_fmt); + vs_base=oldbase; vs_top=oldtop; break;}} + fmt_error("illegal directive"); + } + goto LOOP; +}} + + + +static int +fmt_skip(void) +{ + int c, level = 0; + +LOOP: + if (ctl_advance() != '~') + goto LOOP; + for (;;) + switch (c = ctl_advance()) { + case '\'': + ctl_advance(); + + case ',': + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + case '+': + case '-': + case 'v': case 'V': + case '#': + case ':': case '@': + continue; + + default: + goto DIRECTIVE; + } + +DIRECTIVE: + switch (c) { + case '(': case '[': case '<': case '{': + level++; + break; + + case ')': case ']': case '>': case '}': + if (level == 0) + return(ctl_index); + else + --level; + break; + + case ';': + if (level == 0) + return(ctl_index); + break; + } + goto LOOP; +} + + +static void +fmt_max_param(int n) +{ + if (fmt_nparam > n) + fmt_error("too many parameters"); +} + +static void +fmt_not_colon(bool colon) +{ + if (colon) + fmt_error("illegal :"); +} + +static void +fmt_not_atsign(bool atsign) +{ + if (atsign) + fmt_error("illegal @"); +} + +static void +fmt_not_colon_atsign(bool colon, bool atsign) +{ + if (colon && atsign) + fmt_error("illegal :@"); +} + +static void +fmt_set_param(int i, int *p, int t, int v) +{ + if (i >= fmt_nparam || FMT_PARAM[i].fmt_param_type == fmt_null) + *p = v; + else if (FMT_PARAM[i].fmt_param_type != t) + fmt_error("illegal parameter type"); + else + *p = FMT_PARAM[i].fmt_param_value; +} + + +static void +fmt_ascii(bool colon, bool atsign) +{ + int mincol=0, colinc=0, minpad=0, padchar=0; + object x; + int l, i; + + fmt_max_param(4); + fmt_set_param(0, &mincol, fmt_int, 0); + fmt_set_param(1, &colinc, fmt_int, 1); + fmt_set_param(2, &minpad, fmt_int, 0); + fmt_set_param(3, &padchar, fmt_char, ' '); + + fmt_temporary_string->st.st_fillp = 0; + /* fmt_temporary_stream->sm.sm_int0 = file_column(fmt_stream); */ + STREAM_FILE_COLUMN(fmt_temporary_stream) = file_column(fmt_stream); + x = fmt_advance(); + if (colon && x == Cnil) + writestr_stream("()", fmt_temporary_stream); + else if (mincol == 0 && minpad == 0) { + princ(x, fmt_stream); + return; + } else + princ(x, fmt_temporary_stream); + l = fmt_temporary_string->st.st_fillp; + for (i = minpad; l + i < mincol; i += colinc) + ; + if (!atsign) { + write_string(fmt_temporary_string, fmt_stream); + while (i-- > 0) + writec_stream(padchar, fmt_stream); + } else { + while (i-- > 0) + writec_stream(padchar, fmt_stream); + write_string(fmt_temporary_string, fmt_stream); + } +} + +static void +fmt_S_expression(bool colon, bool atsign) +{ + int mincol=0, colinc=0, minpad=0, padchar=0; + object x; + int l, i; + + fmt_max_param(4); + fmt_set_param(0, &mincol, fmt_int, 0); + fmt_set_param(1, &colinc, fmt_int, 1); + fmt_set_param(2, &minpad, fmt_int, 0); + fmt_set_param(3, &padchar, fmt_char, ' '); + + fmt_temporary_string->st.st_fillp = 0; + /* fmt_temporary_stream->sm.sm_int0 = file_column(fmt_stream); */ + STREAM_FILE_COLUMN(fmt_temporary_stream) = file_column(fmt_stream); + x = fmt_advance(); + if (colon && x == Cnil) + writestr_stream("()", fmt_temporary_stream); + else if (mincol == 0 && minpad == 0) { + prin1(x, fmt_stream); + return; + } else + prin1(x, fmt_temporary_stream); + l = fmt_temporary_string->st.st_fillp; + for (i = minpad; l + i < mincol; i += colinc) + ; + if (!atsign) { + write_string(fmt_temporary_string, fmt_stream); + while (i-- > 0) + writec_stream(padchar, fmt_stream); + } else { + while (i-- > 0) + writec_stream(padchar, fmt_stream); + write_string(fmt_temporary_string, fmt_stream); + } +} + +static void +fmt_decimal(bool colon, bool atsign) +{ + int mincol=0, padchar=0, commachar=0; + + fmt_max_param(3); + fmt_set_param(0, &mincol, fmt_int, 0); + fmt_set_param(1, &padchar, fmt_char, ' '); + fmt_set_param(2, &commachar, fmt_char, ','); + fmt_integer(fmt_advance(), colon, atsign, + 10, mincol, padchar, commachar); +} + +static void +fmt_binary(bool colon, bool atsign) +{ + int mincol=0, padchar=0, commachar=0; + + fmt_max_param(3); + fmt_set_param(0, &mincol, fmt_int, 0); + fmt_set_param(1, &padchar, fmt_char, ' '); + fmt_set_param(2, &commachar, fmt_char, ','); + fmt_integer(fmt_advance(), colon, atsign, + 2, mincol, padchar, commachar); +} + +static void +fmt_octal(bool colon, bool atsign) +{ + int mincol=0, padchar=0, commachar=0; + + fmt_max_param(3); + fmt_set_param(0, &mincol, fmt_int, 0); + fmt_set_param(1, &padchar, fmt_char, ' '); + fmt_set_param(2, &commachar, fmt_char, ','); + fmt_integer(fmt_advance(), colon, atsign, + 8, mincol, padchar, commachar); +} + +static void +fmt_hexadecimal(bool colon, bool atsign) +{ + int mincol=0, padchar=0, commachar=0; + + fmt_max_param(3); + fmt_set_param(0, &mincol, fmt_int, 0); + fmt_set_param(1, &padchar, fmt_char, ' '); + fmt_set_param(2, &commachar, fmt_char, ','); + fmt_integer(fmt_advance(), colon, atsign, + 16, mincol, padchar, commachar); +} + +static void +fmt_radix(bool colon, bool atsign) +{ + int radix=0, mincol=0, padchar=0, commachar=0; + object x; + int i, j, k; + int s, t; + bool b; + extern void (*write_ch_fun)(int), writec_PRINTstream(int); + + if (fmt_nparam == 0) { + x = fmt_advance(); + check_type_integer(&x); + if (atsign) { + if (type_of(x) == t_fixnum) + i = fix(x); + else + i = -1; + if ((!colon && (i <= 0 || i >= 4000)) || + (colon && (i <= 0 || i >= 5000))) { + fmt_integer(x, FALSE, FALSE, 10, 0, ' ', ','); + return; + } + fmt_roman(i/1000, 'M', '*', '*', colon); + fmt_roman(i%1000/100, 'C', 'D', 'M', colon); + fmt_roman(i%100/10, 'X', 'L', 'C', colon); + fmt_roman(i%10, 'I', 'V', 'X', colon); + return; + } + fmt_temporary_string->st.st_fillp = 0; + /* fmt_temporary_stream->sm.sm_int0 = file_column(fmt_stream); */ + STREAM_FILE_COLUMN(fmt_temporary_stream) = file_column(fmt_stream); + PRINTstream = fmt_temporary_stream; + PRINTradix = FALSE; + PRINTbase = 10; + write_ch_fun = writec_PRINTstream; + write_object(x, 0); + s = 0; + i = fmt_temporary_string->st.st_fillp; + if (i == 1 && fmt_tempstr(s) == '0') { + writestr_stream("zero", fmt_stream); + if (colon) + writestr_stream("th", fmt_stream); + return; + } else if (fmt_tempstr(s) == '-') { + writestr_stream("minus ", fmt_stream); + --i; + s++; + } + t = fmt_temporary_string->st.st_fillp; + for (;;) + if (fmt_tempstr(--t) != '0') + break; + for (b = FALSE; i > 0; i -= j) { + b = fmt_nonillion(s, j = (i+29)%30+1, b, + i<=30&&colon, t); + s += j; + if (b && i > 30) { + for (k = (i - 1)/30; k > 0; --k) + writestr_stream(" nonillion", + fmt_stream); + if (colon && s > t) + writestr_stream("th", fmt_stream); + } + } + return; + } + fmt_max_param(4); + fmt_set_param(0, &radix, fmt_int, 10); + fmt_set_param(1, &mincol, fmt_int, 0); + fmt_set_param(2, &padchar, fmt_char, ' '); + fmt_set_param(3, &commachar, fmt_char, ','); + x = fmt_advance(); + check_type_integer(&x); + if (radix < 0 || radix > 36) { + vs_push(make_fixnum(radix)); + FEerror("~D is illegal as a radix.", 1, vs_head); + } + fmt_integer(x, colon, atsign, radix, mincol, padchar, commachar); +} + +static void +fmt_integer(object x, bool colon, bool atsign, int radix, int mincol, int padchar, int commachar) +{ + int l, l1; + int s; + extern void (*write_ch_fun)(int), writec_PRINTstream(int); + + if (type_of(x) != t_fixnum && type_of(x) != t_bignum) { + fmt_temporary_string->st.st_fillp = 0; + /* fmt_temporary_stream->sm.sm_int0 = file_column(fmt_stream); */ + STREAM_FILE_COLUMN(fmt_temporary_stream) = file_column(fmt_stream); + {SETUP_PRINT_DEFAULT(x); + PRINTstream = fmt_temporary_stream; + PRINTescape = FALSE; + PRINTbase = radix; + write_ch_fun = writec_PRINTstream; + write_object(x, 0); + CLEANUP_PRINT_DEFAULT;} + l = fmt_temporary_string->st.st_fillp; + mincol -= l; + while (mincol-- > 0) + writec_stream(padchar, fmt_stream); + for (s = 0; l > 0; --l, s++) + writec_stream(fmt_tempstr(s), fmt_stream); + return; + } + fmt_temporary_string->st.st_fillp = 0; + /* fmt_temporary_stream->sm.sm_int0 = file_column(fmt_stream);*/ + STREAM_FILE_COLUMN(fmt_temporary_stream) = file_column(fmt_stream); + PRINTstream = fmt_temporary_stream; + PRINTradix = FALSE; + PRINTbase = radix; + write_ch_fun = writec_PRINTstream; + write_object(x, 0); + l = l1 = fmt_temporary_string->st.st_fillp; + s = 0; + if (fmt_tempstr(s) == '-') + --l1; + mincol -= l; + if (colon) + mincol -= (l1 - 1)/3; + if (atsign && fmt_tempstr(s) != '-') + --mincol; + while (mincol-- > 0) + writec_stream(padchar, fmt_stream); + if (fmt_tempstr(s) == '-') { + s++; + writec_stream('-', fmt_stream); + } else if (atsign) + writec_stream('+', fmt_stream); + while (l1-- > 0) { + writec_stream(fmt_tempstr(s++), fmt_stream); + if (colon && l1 > 0 && l1%3 == 0) + writec_stream(commachar, fmt_stream); + } +} + +static int +fmt_nonillion(int s, int i, bool b, bool o, int t) +{ + int j; + + for (; i > 3; i -= j) { + b = fmt_thousand(s, j = (i+2)%3+1, b, FALSE, t); + if (j != 3 || fmt_tempstr(s) != '0' || + fmt_tempstr(s+1) != '0' || fmt_tempstr(s+2) != '0') { + writec_stream(' ', fmt_stream); + writestr_stream(fmt_big_numeral[(i - 1)/3 - 1], + fmt_stream); + s += j; + if (o && s > t) + writestr_stream("th", fmt_stream); + } else + s += j; + } + return(fmt_thousand(s, i, b, o, t)); +} + +static int +fmt_thousand(int s, int i, bool b, bool o, int t) +{ + if (i == 3 && fmt_tempstr(s) > '0') { + if (b) + writec_stream(' ', fmt_stream); + fmt_write_numeral(s, 0); + writestr_stream(" hundred", fmt_stream); + --i; + s++; + b = TRUE; + if (o && s > t) + writestr_stream("th", fmt_stream); + } + if (i == 3) { + --i; + s++; + } + if (i == 2 && fmt_tempstr(s) > '0') { + if (b) + writec_stream(' ', fmt_stream); + if (fmt_tempstr(s) == '1') { + if (o && s + 2 > t) + fmt_write_ordinal(++s, 10); + else + fmt_write_numeral(++s, 10); + return(TRUE); + } else { + if (o && s + 1 > t) + fmt_write_ordinal(s, 20); + else + fmt_write_numeral(s, 20); + s++; + if (fmt_tempstr(s) > '0') { + writec_stream('-', fmt_stream); + if (o && s + 1 > t) + fmt_write_ordinal(s, 0); + else + fmt_write_numeral(s, 0); + } + return(TRUE); + } + } + if (i == 2) + s++; + if (fmt_tempstr(s) > '0') { + if (b) + writec_stream(' ', fmt_stream); + if (o && s + 1 > t) + fmt_write_ordinal(s, 0); + else + fmt_write_numeral(s, 0); + return(TRUE); + } + return(b); +} + +static void +fmt_write_numeral(int s, int i) +{ + writestr_stream(fmt_numeral[fmt_tempstr(s) - '0' + i], fmt_stream); +} + +static void +fmt_write_ordinal(int s, int i) +{ + writestr_stream(fmt_ordinal[fmt_tempstr(s) - '0' + i], fmt_stream); +} + +static void +fmt_roman(int i, int one, int five, int ten, int colon) +{ + int j; + + if (i == 0) + return; + if ((!colon && i < 4) || (colon && i < 5)) + for (j = 0; j < i; j++) + writec_stream(one, fmt_stream); + else if (!colon && i == 4) { + writec_stream(one, fmt_stream); + writec_stream(five, fmt_stream); + } else if ((!colon && i < 9) || colon) { + writec_stream(five, fmt_stream); + for (j = 5; j < i; j++) + writec_stream(one, fmt_stream); + } else if (!colon && i == 9) { + writec_stream(one, fmt_stream); + writec_stream(ten, fmt_stream); + } +} + +static void +fmt_plural(bool colon, bool atsign) +{ + fmt_max_param(0); + if (colon) { + if (fmt_index == 0) + fmt_error("can't back up"); + --fmt_index; + } + if (eql(fmt_advance(), make_fixnum(1))) + if (atsign) + writec_stream('y', fmt_stream); + else + ; + else + if (atsign) + writestr_stream("ies", fmt_stream); + else + writec_stream('s', fmt_stream); +} + +static void +fmt_character(bool colon, bool atsign) +{ + object x; + int i; + + fmt_max_param(0); + fmt_temporary_string->st.st_fillp = 0; + /* fmt_temporary_stream->sm.sm_int0 = 0;*/ + STREAM_FILE_COLUMN(fmt_temporary_stream) = 0; + x = fmt_advance(); + check_type_character(&x); + prin1(x, fmt_temporary_stream); + if (!colon && atsign) + i = 0; + else + i = 2; + for (; i < fmt_temporary_string->st.st_fillp; i++) + writec_stream(fmt_tempstr(i), fmt_stream); +} + +static void +fmt_fix_float(bool colon, bool atsign) +{ + int w=0, d=0, k=0, overflowchar=0, padchar=0,dp; + double f; + int sign; + char *buff, *b, *buff1; + int exp; + int i, j; + object x; + int n, m; + vs_mark; + + massert(buff=alloca(256)); /*from automatic array -- work around for persistent gcc alpha bug*/ + massert(buff1=alloca(256)); + + b = buff1 + 1; + + fmt_not_colon(colon); + fmt_max_param(5); + fmt_set_param(0, &w, fmt_int, 0); + if (w < 0) + fmt_error("illegal width"); + fmt_set_param(0, &w, fmt_int, -1); + fmt_set_param(1, &d, fmt_int, 0); + if (d < 0) + fmt_error("illegal number of digits"); + fmt_set_param(1, &d, fmt_int, -1); + fmt_set_param(2, &k, fmt_int, 0); + fmt_set_param(3, &overflowchar, fmt_char, -1); + fmt_set_param(4, &padchar, fmt_char, ' '); + + x = fmt_advance(); + if (type_of(x) == t_fixnum || + type_of(x) == t_bignum || + type_of(x) == t_ratio) { + x = make_shortfloat((shortfloat)number_to_double(x)); + vs_push(x); + } + if (type_of(x) == t_complex) { + if (w < 0) + prin1(x, fmt_stream); + else { + fmt_nparam = 1; + --fmt_index; + fmt_decimal(colon, atsign); + } + vs_reset; + return; + } + if (type_of(x) == t_longfloat) { + n = 17; + dp=1; + } else { + n = 8; + dp=0; + } + f = number_to_double(x); + edit_double(n, f, &sign, buff, &exp, dp); + if (sign==2) { + prin1(x, fmt_stream); + vs_reset; + return; + } + if (d >= 0) + m = d + exp + k + 1; + else if (w >= 0) { + if (exp + k >= 0) + m = w - 1; + else + m = w + exp + k - 2; + if (sign < 0 || atsign) + --m; + if (m == 0) + m = 1; + } else + m = n; + if (m <= 0) { + if (m == 0 && buff[0] >= '5') { + exp++; + n = m = 1; + buff[0] = '1'; + } else + n = m = 0; + } else if (m < n) { + n = m; + edit_double(n, f, &sign, buff, &exp, dp); + } + while (n >= 0) + if (buff[n - 1] == '0') + --n; + else + break; + exp += k; + j = 0; + if (exp >= 0) { + for (i = 0; i <= exp; i++) + b[j++] = i < n ? buff[i] : '0'; + b[j++] = '.'; + if (d >= 0) + for (m = i + d; i < m; i++) + b[j++] = i < n ? buff[i] : '0'; + else + for (; i < n; i++) + b[j++] = buff[i]; + } else { + b[j++] = '.'; + if (d >= 0) { + for (i = 0; i < (-exp) - 1 && i < d; i++) + b[j++] = '0'; + for (m = d - i, i = 0; i < m; i++) + b[j++] = i < n ? buff[i] : '0'; + } else if (n > 0) { + for (i = 0; i < (-exp) - 1; i++) + b[j++] = '0'; + for (i = 0; i < n; i++) + b[j++] = buff[i]; + } + } + b[j] = '\0'; + if (w >= 0) { + if (sign < 0 || atsign) + --w; + if (j > w && overflowchar >= 0) + goto OVER; + if (j < w && b[j-1] == '.' && d) { + b[j++] = '0'; + b[j] = '\0'; + } + if (j < w && b[0] == '.') { + *--b = '0'; + j++; + } + for (i = j; i < w; i++) + writec_stream(padchar, fmt_stream); + } else { + if (b[0] == '.') { + *--b = '0'; + j++; + } + if (d < 0 && b[j-1] == '.') { + b[j++] = '0'; + b[j] = '\0'; + } + } + if (sign < 0) + writec_stream('-', fmt_stream); + else if (atsign) + writec_stream('+', fmt_stream); + writestr_stream(b, fmt_stream); + vs_reset; + return; + +OVER: + fmt_set_param(0, &w, fmt_int, 0); + for (i = 0; i < w; i++) + writec_stream(overflowchar, fmt_stream); + vs_reset; + return; +} + +static int +fmt_exponent_length(int e) +{ + int i; + + if (e == 0) + return(1); + if (e < 0) + e = -e; + for (i = 0; e > 0; i++, e /= 10) + ; + return(i); +} + +static void +fmt_exponent(int e) +{ + if (e == 0) { + writec_stream('0', fmt_stream); + return; + } + if (e < 0) + e = -e; + fmt_exponent1(e); +} + +static void +fmt_exponent1(int e) +{ + if (e == 0) + return; + fmt_exponent1(e/10); + writec_stream('0' + e%10, fmt_stream); +} + +static void +fmt_exponential_float(bool colon, bool atsign) +{ + int w=0, d=0, e=0, k=0, overflowchar=0, padchar=0, exponentchar=0,dp; + double f; + int sign; + char buff[256], *b, buff1[256]; + int exp; + int i, j; + object x, y; + int n, m; + enum type t; + vs_mark; + + b = buff1 + 1; + + fmt_not_colon(colon); + fmt_max_param(7); + fmt_set_param(0, &w, fmt_int, 0); + if (w < 0) + fmt_error("illegal width"); + fmt_set_param(0, &w, fmt_int, -1); + fmt_set_param(1, &d, fmt_int, 0); + if (d < 0) + fmt_error("illegal number of digits"); + fmt_set_param(1, &d, fmt_int, -1); + fmt_set_param(2, &e, fmt_int, 0); + if (e < 0) + fmt_error("illegal number of digits in exponent"); + fmt_set_param(2, &e, fmt_int, -1); + fmt_set_param(3, &k, fmt_int, 1); + fmt_set_param(4, &overflowchar, fmt_char, -1); + fmt_set_param(5, &padchar, fmt_char, ' '); + fmt_set_param(6, &exponentchar, fmt_char, -1); + + x = fmt_advance(); + if (type_of(x) == t_fixnum || + type_of(x) == t_bignum || + type_of(x) == t_ratio) { + x = make_shortfloat((shortfloat)number_to_double(x)); + vs_push(x); + } + if (type_of(x) == t_complex) { + if (w < 0) + prin1(x, fmt_stream); + else { + fmt_nparam = 1; + --fmt_index; + fmt_decimal(colon, atsign); + } + vs_reset; + return; + } + if (type_of(x) == t_longfloat) { + n = 17; + dp=1; + } else { + n = 8; + dp=0; + } + f = number_to_double(x); + edit_double(n, f, &sign, buff, &exp, dp); + if (sign==2) { + prin1(x, fmt_stream); + vs_reset; + return; + } + if (d >= 0) { + if (k > 0) { + if (!(k < d + 2)) + fmt_error("illegal scale factor"); + m = d + 1; + } else { + if (!(k > -d)) + fmt_error("illegal scale factor"); + m = d + k; + } + } else if (w >= 0) { + if (k > 0) + m = w - 1; + else + m = w + k - 1; + if (sign < 0 || atsign) + --m; + if (e >= 0) + m -= e + 2; + else + m -= fmt_exponent_length(e - k + 1) + 2; + } else + m = n; + if (m <= 0) { + if (m == 0 && buff[0] >= '5') { + exp++; + n = m = 1; + buff[0] = '1'; + } else + n = m = 0; + } else if (m < n) { + n = m; + edit_double(n, f, &sign, buff, &exp, dp); + } + while (n >= 0) + if (buff[n - 1] == '0') + --n; + else + break; + exp = exp - k + 1; + j = 0; + if (k > 0) { + for (i = 0; i < k; i++) + b[j++] = i < n ? buff[i] : '0'; + b[j++] = '.'; + if (d >= 0) + for (m = i + (d - k + 1); i < m; i++) + b[j++] = i < n ? buff[i] : '0'; + else + for (; i < n; i++) + b[j++] = buff[i]; + } else { + b[j++] = '.'; + if (d >= 0) { + for (i = 0; i < -k && i < d; i++) + b[j++] = '0'; + for (m = d - i, i = 0; i < m; i++) + b[j++] = i < n ? buff[i] : '0'; + } else if (n > 0) { + for (i = 0; i < -k; i++) + b[j++] = '0'; + for (i = 0; i < n; i++) + b[j++] = buff[i]; + } + } + b[j] = '\0'; + if (w >= 0) { + if (sign < 0 || atsign) + --w; + i = fmt_exponent_length(exp); + if (e >= 0) { + if (i > e) { + if (overflowchar >= 0) + goto OVER; + else + e = i; + } + w -= e + 2; + } else + w -= i + 2; + if (j > w && overflowchar >= 0) + goto OVER; + if (j < w && b[j-1] == '.') { + b[j++] = '0'; + b[j] = '\0'; + } + if (j < w && b[0] == '.') { + *--b = '0'; + j++; + } + for (i = j; i < w; i++) + writec_stream(padchar, fmt_stream); + } else { + if (b[j-1] == '.') { + b[j++] = '0'; + b[j] = '\0'; + } + if (d < 0 && b[0] == '.') { + *--b = '0'; + j++; + } + } + if (sign < 0) + writec_stream('-', fmt_stream); + else if (atsign) + writec_stream('+', fmt_stream); + writestr_stream(b, fmt_stream); + y = symbol_value(sLAread_default_float_formatA); + if (exponentchar < 0) { + if (y == sLlong_float || y == sLdouble_float + || y == sLsingle_float + + ) + t = t_longfloat; + else + t = t_shortfloat; + if (type_of(x) == t) + exponentchar = 'E'; + else if (type_of(x) == t_shortfloat) + exponentchar = 'S'; + else + exponentchar = 'L'; + } + writec_stream(exponentchar, fmt_stream); + if (exp < 0) + writec_stream('-', fmt_stream); + else + writec_stream('+', fmt_stream); + if (e >= 0) + for (i = e - fmt_exponent_length(exp); i > 0; --i) + writec_stream('0', fmt_stream); + fmt_exponent(exp); + vs_reset; + return; + +OVER: + fmt_set_param(0, &w, fmt_int, -1); + for (i = 0; i < w; i++) + writec_stream(overflowchar, fmt_stream); + vs_reset; + return; +} + +static void +fmt_general_float(bool colon, bool atsign) +{ + int w=0, d=0, e=0, k, overflowchar, padchar=0, exponentchar,dp; + int sign, exp; + char buff[256]; + object x; + int n, ee, ww, q, dd; + vs_mark; + + fmt_not_colon(colon); + fmt_max_param(7); + fmt_set_param(0, &w, fmt_int, 0); + if (w < 0) + fmt_error("illegal width"); + fmt_set_param(0, &w, fmt_int, -1); + fmt_set_param(1, &d, fmt_int, 0); + if (d < 0) + fmt_error("illegal number of digits"); + fmt_set_param(1, &d, fmt_int, -1); + fmt_set_param(2, &e, fmt_int, 0); + if (e < 0) + fmt_error("illegal number of digits in exponent"); + fmt_set_param(2, &e, fmt_int, -1); + fmt_set_param(3, &k, fmt_int, 1); + fmt_set_param(4, &overflowchar, fmt_char, -1); + fmt_set_param(5, &padchar, fmt_char, ' '); + fmt_set_param(6, &exponentchar, fmt_char, -1); + + x = fmt_advance(); + if (type_of(x) == t_complex) { + if (w < 0) + prin1(x, fmt_stream); + else { + fmt_nparam = 1; + --fmt_index; + fmt_decimal(colon, atsign); + } + vs_reset; + return; + } + if (type_of(x) == t_longfloat) { + q = 17; + dp=1; + } else { + q = 8; + dp=0; + } + edit_double(q, number_to_double(x), &sign, buff, &exp, dp); + n = exp + 1; + while (q > 0) + if (buff[q - 1] == '0') + --q; + else + break; + if (e >= 0) + ee = e + 2; + else + ee = 4; + ww = w - ee; + if (d < 0) { + d = n < 7 ? n : 7; + d = q > d ? q : d; + } + dd = d - n; + if (0 <= dd && dd <= d) { + FMT_PARAM[0].fmt_param_value = ww; + if (w < 0) FMT_PARAM[0].fmt_param_type = fmt_null; + FMT_PARAM[1].fmt_param_value = dd; + FMT_PARAM[1].fmt_param_type = fmt_int; + FMT_PARAM[2].fmt_param_type = fmt_null; + if (fmt_nparam > 4) + {FMT_PARAM[3] = FMT_PARAM[4]; } + else FMT_PARAM[3].fmt_param_type = fmt_null; + if (fmt_nparam > 5) + {FMT_PARAM[4] = FMT_PARAM[5];} + else FMT_PARAM[4].fmt_param_type = fmt_null; + fmt_nparam = 5; + --fmt_index; + fmt_fix_float(colon, atsign); + if (w >= 0) + while (ww++ < w) + writec_stream(padchar, fmt_stream); + vs_reset; + return; + } + FMT_PARAM[1].fmt_param_value = d; + FMT_PARAM[1].fmt_param_type = fmt_int; + --fmt_index; + fmt_exponential_float(colon, atsign); + vs_reset; +} + +static void +fmt_dollars_float(bool colon, bool atsign) +{ + int d=0, n=0, w=0, padchar=0,dp; + double f; + int sign; + char buff[256]; + int exp; + int q, i; + object x; + vs_mark; + + fmt_max_param(4); + fmt_set_param(0, &d, fmt_int, 2); + if (d < 0) + fmt_error("illegal number of digits"); + fmt_set_param(1, &n, fmt_int, 1); + if (n < 0) + fmt_error("illegal number of digits"); + fmt_set_param(2, &w, fmt_int, 0); + if (w < 0) + fmt_error("illegal width"); + fmt_set_param(3, &padchar, fmt_char, ' '); + x = fmt_advance(); + if (type_of(x) == t_complex) { + if (w < 0) + prin1(x, fmt_stream); + else { + fmt_nparam = 1; + FMT_PARAM[0] = FMT_PARAM[2]; + --fmt_index; + fmt_decimal(colon, atsign); + } + vs_reset; + return; + } + q = 8; + dp=0; + if (type_of(x) == t_longfloat) { + q = 17; + dp=1; + } + f = number_to_double(x); + edit_double(q, f, &sign, buff, &exp, dp); + if ((q = exp + d + 1) > 0) + edit_double(q, f, &sign, buff, &exp, dp); + exp++; + if (w > 100 || exp > 100 || exp < -100) { + fmt_nparam = 6; + FMT_PARAM[0] = FMT_PARAM[2]; + FMT_PARAM[1].fmt_param_value = d + n - 1; + FMT_PARAM[1].fmt_param_type = fmt_int; + FMT_PARAM[2].fmt_param_type = + FMT_PARAM[3].fmt_param_type = + FMT_PARAM[4].fmt_param_type = fmt_null; + FMT_PARAM[5] = FMT_PARAM[3]; + --fmt_index; + fmt_exponential_float(colon, atsign); + } + if (exp > n) + n = exp; + if (sign < 0 || atsign) + --w; + if (colon) { + if (sign < 0) + writec_stream('-', fmt_stream); + else if (atsign) + writec_stream('+', fmt_stream); + while (--w > n + d) + writec_stream(padchar, fmt_stream); + } else { + while (--w > n + d) + writec_stream(padchar, fmt_stream); + if (sign < 0) + writec_stream('-', fmt_stream); + else if (atsign) + writec_stream('+', fmt_stream); + } + for (i = n - exp; i > 0; --i) + writec_stream('0', fmt_stream); + for (i = 0; i < exp; i++) + writec_stream((i < q ? buff[i] : '0'), fmt_stream); + writec_stream('.', fmt_stream); + for (d += i; i < d; i++) + writec_stream((i < q ? buff[i] : '0'), fmt_stream); + vs_reset; +} + +static void +fmt_percent(bool colon, bool atsign) +{ + int n=0, i; + + fmt_max_param(1); + fmt_set_param(0, &n, fmt_int, 1); + fmt_not_colon(colon); + fmt_not_atsign(atsign); + while (n-- > 0) { + WRITEC_NEWLINE(fmt_stream); + if (n == 0) + for (i = fmt_indents; i > 0; --i) + writec_stream(' ', fmt_stream); + } +} + +static void +fmt_ampersand(bool colon, bool atsign) +{ + int n=0; + + fmt_max_param(1); + fmt_set_param(0, &n, fmt_int, 1); + fmt_not_colon(colon); + fmt_not_atsign(atsign); + if (n == 0) + return; + if (file_column(fmt_stream) != 0) + WRITEC_NEWLINE(fmt_stream); + while (--n > 0) + WRITEC_NEWLINE(fmt_stream); + fmt_indents = 0; +} + +static void +fmt_bar(bool colon, bool atsign) +{ + int n=0; + + fmt_max_param(1); + fmt_set_param(0, &n, fmt_int, 1); + fmt_not_colon(colon); + fmt_not_atsign(atsign); + while (n-- > 0) + writec_stream('\f', fmt_stream); +} + +static void +fmt_tilde(bool colon, bool atsign) +{ + int n=0; + + fmt_max_param(1); + fmt_set_param(0, &n, fmt_int, 1); + fmt_not_colon(colon); + fmt_not_atsign(atsign); + while (n-- > 0) + writec_stream('~', fmt_stream); +} + +static void +fmt_newline(bool colon, bool atsign) +{ + + fmt_max_param(0); + fmt_not_colon_atsign(colon, atsign); + if (atsign) + WRITEC_NEWLINE(fmt_stream); + while (ctl_index < ctl_end && isspace((int)ctl_string[ctl_index])) { + if (colon) + writec_stream(ctl_string[ctl_index], fmt_stream); + ctl_index++; + } +} + +static void +fmt_tabulate(bool colon, bool atsign) +{ + int colnum=0, colinc=0; + int c, i; + + fmt_max_param(2); + fmt_not_colon(colon); + fmt_set_param(0, &colnum, fmt_int, 1); + fmt_set_param(1, &colinc, fmt_int, 1); + if (!atsign) { + c = file_column(fmt_stream); + if (c < 0) { + writestr_stream(" ", fmt_stream); + return; + } + if (c > colnum && colinc <= 0) + return; + while (c > colnum) + colnum += colinc; + for (i = colnum - c; i > 0; --i) + writec_stream(' ', fmt_stream); + } else { + for (i = colnum; i > 0; --i) + writec_stream(' ', fmt_stream); + c = file_column(fmt_stream); + if (c < 0 || colinc <= 0) + return; + colnum = 0; + while (c > colnum) + colnum += colinc; + for (i = colnum - c; i > 0; --i) + writec_stream(' ', fmt_stream); + } +} + +static void +fmt_asterisk(bool colon, bool atsign) +{ + int n=0; + + fmt_max_param(1); + fmt_not_colon_atsign(colon, atsign); + if (atsign) { + fmt_set_param(0, &n, fmt_int, 0); + if (n < 0 || n >= fmt_end) + fmt_error("can't goto"); + fmt_index = n; + } else if (colon) { + fmt_set_param(0, &n, fmt_int, 1); + if (n > fmt_index) + fmt_error("can't back up"); + fmt_index -= n; + } else { + fmt_set_param(0, &n, fmt_int, 1); + while (n-- > 0) + fmt_advance(); + } +} + +static void +fmt_indirection(bool colon, bool atsign) { + object s, l; + fmt_old; + jmp_buf fmt_jmp_buf0; + int up_colon; + + /* to prevent longjmp clobber */ + up_colon=(long)&old_fmt_paramp; + fmt_max_param(0); + fmt_not_colon(colon); + s = fmt_advance(); + if (type_of(s) != t_string) + fmt_error("control string expected"); + if (atsign) { + fmt_save; + fmt_jmp_bufp = &fmt_jmp_buf0; + fmt_string = s; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + if (--up_colon) + fmt_error("illegal ~:^"); + } else + format(fmt_stream, 0, s->st.st_fillp); + fmt_restore1; + } else { + l = fmt_advance(); + fmt_save; + fmt_base = vs_top; + fmt_index = 0; + for (fmt_end = 0; !endp(l); fmt_end++, l = l->c.c_cdr) + vs_check_push(l->c.c_car); + fmt_jmp_bufp = &fmt_jmp_buf0; + fmt_string = s; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + if (--up_colon) + fmt_error("illegal ~:^"); + } else + format(fmt_stream, 0, s->st.st_fillp); + vs_top = fmt_base; + fmt_restore; + } +} + +static void +fmt_case(bool colon, bool atsign) +{ + VOL object x; + VOL int i, j; + fmt_old1; + jmp_buf fmt_jmp_buf0; + int up_colon; + bool b; + + x = make_string_output_stream(64); + vs_push(x); + i = ctl_index; + j = fmt_skip(); + if (ctl_string[--j] != ')' || ctl_string[--j] != '~') + fmt_error("~) expected"); + fmt_save1; + fmt_jmp_bufp = &fmt_jmp_buf0; + if ((up_colon = setjmp(*fmt_jmp_bufp))) + ; + else + format(x, ctl_origin + i, j - i); + fmt_restore1; + x = x->sm.sm_object0; + if (!colon && !atsign) + for (i = 0; i < x->st.st_fillp; i++) { + j = x->st.st_self[i]; + if (isUpper(j)) + j += 'a' - 'A'; + writec_stream(j, fmt_stream); + } + else if (colon && !atsign) + for (b = TRUE, i = 0; i < x->st.st_fillp; i++) { + j = x->st.st_self[i]; + if (isLower(j)) { + if (b) + j -= 'a' - 'A'; + b = FALSE; + } else if (isUpper(j)) { + if (!b) + j += 'a' - 'A'; + b = FALSE; + } else if (!isDigit(j)) + b = TRUE; + writec_stream(j, fmt_stream); + } + else if (!colon && atsign) + for (b = TRUE, i = 0; i < x->st.st_fillp; i++) { + j = x->st.st_self[i]; + if (isLower(j)) { + if (b) + j -= 'a' - 'A'; + b = FALSE; + } else if (isUpper(j)) { + if (!b) + j += 'a' - 'A'; + b = FALSE; + } + writec_stream(j, fmt_stream); + } + else + for (i = 0; i < x->st.st_fillp; i++) { + j = x->st.st_self[i]; + if (isLower(j)) + j -= 'a' - 'A'; + writec_stream(j, fmt_stream); + } + vs_popp; + if (up_colon) + longjmp(*fmt_jmp_bufp, up_colon); +} + +static void +fmt_conditional(bool colon, bool atsign) +{ + int i, j, k; + object x; + int n=0; + bool done; + fmt_old1; + + fmt_not_colon_atsign(colon, atsign); + if (colon) { + fmt_max_param(0); + i = ctl_index; + j = fmt_skip(); + if (ctl_string[--j] != ';' || ctl_string[--j] != '~') + fmt_error("~; expected"); + k = fmt_skip(); + if (ctl_string[--k] != ']' || ctl_string[--k] != '~') + fmt_error("~] expected"); + if (fmt_advance() == Cnil) { + fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } else { + fmt_save1; + format(fmt_stream, ctl_origin + j + 2, k - (j + 2)); + fmt_restore1; + } + } else if (atsign) { + i = ctl_index; + j = fmt_skip(); + if (ctl_string[--j] != ']' || ctl_string[--j] != '~') + fmt_error("~] expected"); + if (fmt_advance() == Cnil) + ; + else { + --fmt_index; + fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } + } else { + fmt_max_param(1); + if (fmt_nparam == 0) { + x = fmt_advance(); + if (type_of(x) != t_fixnum) + fmt_error("illegal argument for conditional"); + n = fix(x); + } else + fmt_set_param(0, &n, fmt_int, 0); + i = ctl_index; + for (done = FALSE;; --n) { + j = fmt_skip(); + for (k = j; ctl_string[--k] != '~';) + ; + if (n == 0) { + fmt_save1; + format(fmt_stream, ctl_origin + i, k - i); + fmt_restore1; + done = TRUE; + } + i = j; + if (ctl_string[--j] == ']') { + if (ctl_string[--j] != '~') + fmt_error("~] expected"); + return; + } + if (ctl_string[j] == ';') { + if (ctl_string[--j] == '~') + continue; + if (ctl_string[j] == ':') + goto ELSE; + } + fmt_error("~; or ~] expected"); + } + ELSE: + if (ctl_string[--j] != '~') + fmt_error("~:; expected"); + j = fmt_skip(); + if (ctl_string[--j] != ']' || ctl_string[--j] != '~') + fmt_error("~] expected"); + if (!done) { + fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } + } +} + +static void +fmt_iteration(bool colon, bool atsign) { + int i,n=0; + VOL int j; + int o; + bool colon_close = FALSE; + object l; + VOL object l0; + fmt_old; + jmp_buf fmt_jmp_buf0; + int up_colon; + + /* to prevent longjmp clobber */ + up_colon=(long)&old_fmt_paramp; + fmt_max_param(1); + fmt_set_param(0, &n, fmt_int, 1000000); + i = ctl_index; + j = fmt_skip(); + if (ctl_string[--j] != '}') + fmt_error("~} expected"); + if (ctl_string[--j] == ':') { + colon_close = TRUE; + --j; + } + if (ctl_string[j] != '~') + fmt_error("syntax error"); + o = ctl_origin; + if (!colon && !atsign) { + l = fmt_advance(); + fmt_save; + fmt_base = vs_top; + fmt_index = 0; + for (fmt_end = 0; !endp(l); fmt_end++, l = l->c.c_cdr) + vs_check_push(l->c.c_car); + fmt_jmp_bufp = &fmt_jmp_buf0; + if (colon_close) + goto L1; + while (fmt_index < fmt_end) { + L1: + if (n-- <= 0) + break; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + if (--up_colon) + fmt_error("illegal ~:^"); + break; + } + format(fmt_stream, o + i, j - i); + } + vs_top = fmt_base; + fmt_restore; + } else if (colon && !atsign) { + l0 = fmt_advance(); + fmt_save; + fmt_base = vs_top; + fmt_jmp_bufp = &fmt_jmp_buf0; + if (colon_close) + goto L2; + while (!endp(l0)) { + L2: + if (n-- <= 0) + break; + l = l0->c.c_car; + l0 = l0->c.c_cdr; + fmt_index = 0; + for (fmt_end = 0; !endp(l); fmt_end++, l = l->c.c_cdr) + vs_check_push(l->c.c_car); + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + vs_top = fmt_base; + if (--up_colon) + break; + else + continue; + } + format(fmt_stream, o + i, j - i); + vs_top = fmt_base; + } + fmt_restore; + } else if (!colon && atsign) { + fmt_save; + fmt_jmp_bufp = &fmt_jmp_buf0; + if (colon_close) + goto L3; + while (fmt_index < fmt_end) { + L3: + if (n-- <= 0) + break; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + if (--up_colon) + fmt_error("illegal ~:^"); + break; + } + format(fmt_stream, o + i, j - i); + } + fmt_restore1; + } else if (colon && atsign) { + if (colon_close) + goto L4; + while (fmt_index < fmt_end) { + L4: + if (n-- <= 0) + break; + l = fmt_advance(); + fmt_save; + fmt_base = vs_top; + fmt_index = 0; + for (fmt_end = 0; !endp(l); fmt_end++, l = l->c.c_cdr) + vs_check_push(l->c.c_car); + fmt_jmp_bufp = &fmt_jmp_buf0; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + vs_top = fmt_base; + fmt_restore; + if (--up_colon) + break; + else + continue; + } + format(fmt_stream, o + i, j - i); + vs_top = fmt_base; + fmt_restore; + } + } +} + +#define FORMAT_DIRECTIVE_LIMIT 100 + +static void +fmt_justification(volatile bool colon, bool atsign) +{ + int mincol=0, colinc=0, minpad=0, padchar=0; + object fields[FORMAT_DIRECTIVE_LIMIT]; + fmt_old1; + jmp_buf fmt_jmp_buf0; + VOL int i,j,n,j0; + int k,l,m,l0; + int up_colon; + VOL int special = 0; + volatile int spare_spaces=0, line_length=0; + vs_mark; + + /* to prevent longjmp clobber */ + up_colon=(long)&old_fmt_paramp; + fmt_max_param(4); + fmt_set_param(0, &mincol, fmt_int, 0); + fmt_set_param(1, &colinc, fmt_int, 1); + fmt_set_param(2, &minpad, fmt_int, 0); + fmt_set_param(3, &padchar, fmt_char, ' '); + + n = 0; + for (;;) { + if (n >= FORMAT_DIRECTIVE_LIMIT) + fmt_error("too many fields"); + i = ctl_index; + j0 = j = fmt_skip(); + while (ctl_string[--j] != '~') + ; + fields[n] = make_string_output_stream(64); + vs_push(fields[n]); + fmt_save1; + fmt_jmp_bufp = &fmt_jmp_buf0; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + --n; + if (--up_colon) + fmt_error("illegal ~:^"); + fmt_restore1; + while (ctl_string[--j0] != '>') + j0 = fmt_skip(); + if (ctl_string[--j0] != '~') + fmt_error("~> expected"); + break; + } + format(fields[n++], ctl_origin + i, j - i); + fmt_restore1; + if (ctl_string[--j0] == '>') { + if (ctl_string[--j0] != '~') + fmt_error("~> expected"); + break; + } else if (ctl_string[j0] != ';') + fmt_error("~; expected"); + else if (ctl_string[--j0] == ':') { + if (n != 1) + fmt_error("illegal ~:;"); + special = 1; + for (j = j0; ctl_string[j] != '~'; --j) + ; + fmt_save1; + format(fmt_stream, ctl_origin + j, j0 - j + 2); + fmt_restore1; + spare_spaces = fmt_spare_spaces; + line_length = fmt_line_length; + } else if (ctl_string[j0] != '~') + fmt_error("~; expected"); + } + for (i = special, l = 0; i < n; i++) + l += fields[i]->sm.sm_object0->st.st_fillp; + m = n - 1 - special; + if (m <= 0 && !colon && !atsign) { + m = 0; + colon = TRUE; + } + if (colon) + m++; + if (atsign) + m++; + l0 = l; + l += minpad * m; + for (k = 0; mincol + k * colinc < l; k++) + ; + l = mincol + k * colinc; + if (special != 0 && + file_column(fmt_stream) + l + spare_spaces >= line_length) + princ(fields[0]->sm.sm_object0, fmt_stream); + l -= l0; + for (i = special; i < n; i++) { + if (m > 0 && (i > 0 || colon)) + for (j = l / m, l -= j, --m; j > 0; --j) + writec_stream(padchar, fmt_stream); + princ(fields[i]->sm.sm_object0, fmt_stream); + } + if (atsign) + for (j = l; j > 0; --j) + writec_stream(padchar, fmt_stream); + vs_reset; +} + + +static void +fmt_up_and_out(bool colon, bool atsign) +{ + int i=0, j=0, k=0; + + fmt_max_param(3); + fmt_not_atsign(atsign); + if (fmt_nparam == 0) { + if (fmt_index >= fmt_end) + longjmp(*fmt_jmp_bufp, ++colon); + } else if (fmt_nparam == 1) { + fmt_set_param(0, &i, fmt_int, 0); + if (i == 0) + longjmp(*fmt_jmp_bufp, ++colon); + } else if (fmt_nparam == 2) { + fmt_set_param(0, &i, fmt_int, 0); + fmt_set_param(1, &j, fmt_int, 0); + if (i == j) + longjmp(*fmt_jmp_bufp, ++colon); + } else { + fmt_set_param(0, &i, fmt_int, 0); + fmt_set_param(1, &j, fmt_int, 0); + fmt_set_param(2, &k, fmt_int, 0); + if (i <= j && j <= k) + longjmp(*fmt_jmp_bufp, ++colon); + } +} + + +static void +fmt_semicolon(bool colon, bool atsign) +{ + fmt_not_atsign(atsign); + if (!colon) + fmt_error("~:; expected"); + fmt_max_param(2); + fmt_set_param(0, &fmt_spare_spaces, fmt_int, 0); + fmt_set_param(1, &fmt_line_length, fmt_int, 72); +} + +DEFUNO_NEW("FORMAT",object,fLformat,LISP + ,2,F_ARG_LIMIT,NONE,OO,OO,OO,OO,void,Lformat,(object strm, object control,...),"") +{ va_list ap; + VOL int nargs= VFUN_NARGS; + VOL object x = OBJNULL; + jmp_buf fmt_jmp_buf0; + bool colon, e; + fmt_old; + nargs=nargs-2; + if (nargs < 0) + too_few_arguments(); + if (strm == Cnil) { + strm = make_string_output_stream(64); + x = strm->sm.sm_object0; + } else if (strm == Ct) + strm = symbol_value(sLAstandard_outputA); + else if (type_of(strm) == t_string) { + x = strm; + if (!x->st.st_hasfillp) + FEerror("The string ~S doesn't have a fill-pointer.", 1, x); + strm = make_string_output_stream(0); + strm->sm.sm_object0 = x; + } else + check_type_stream(&strm); + check_type_string(&control); + fmt_save; + frs_push(FRS_PROTECT, Cnil); + if (nlj_active) { + e = TRUE; + goto L; + } + + va_start(ap,control); + {object *l; + COERCE_VA_LIST(l,ap,nargs); + fmt_base = l; + fmt_index = 0; + fmt_end = nargs; + fmt_jmp_bufp = & fmt_jmp_buf0; + if (symbol_value(sSAindent_formatted_outputA) != Cnil) + fmt_indents = file_column(strm); + else + fmt_indents = 0; + fmt_string = control; + if ((colon = setjmp(*fmt_jmp_bufp))) { + if (--colon) + fmt_error("illegal ~:^"); + vs_base = vs_top; + if (x != OBJNULL) + vs_push(x); + else + vs_push(Cnil); + e = FALSE; + goto L; + } + format(strm, 0, control->st.st_fillp); + flush_stream(strm); + } + va_end(ap); + e = FALSE; +L: + frs_pop(); + fmt_restore; + if (e) { + nlj_active = FALSE; + unwind(nlj_fr, nlj_tag); + } + RETURN1 (x ==0 ? Cnil : x); +} +object +fLformat_1(object strm, object control,object x) { + VFUN_NARGS=3; + return FFN(fLformat)(strm,control,x); + +} + +/* object c_apply_n(long int (*fn) (), int n, object *x); */ + +static void +fmt_error(char *s) +{ + vs_push(make_simple_string(s)); + vs_push(make_fixnum(&ctl_string[ctl_index] - fmt_string->st.st_self)); + FEerror("Format error: ~A.~%~V@TV~%\"~A\"~%", + 3, vs_top[-2], vs_top[-1], fmt_string); +} + +DEFVAR("*INDENT-FORMATTED-OUTPUT*",sSAindent_formatted_outputA,SI,Cnil,""); +void +gcl_init_format(void) +{ + fmt_temporary_stream = make_string_output_stream(64); + enter_mark_origin(&fmt_temporary_stream); + fmt_temporary_string = fmt_temporary_stream->sm.sm_object0; + + + + +} diff --git a/o/frame.c b/o/frame.c new file mode 100755 index 0000000..8dfc9c1 --- /dev/null +++ b/o/frame.c @@ -0,0 +1,84 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + frame.c + + frame and non-local jump +*/ + +#include "include.h" + +void +unwind(frame_ptr fr, object tag) +{ + signals_allowed = 0; + nlj_fr = fr; + nlj_tag = tag; + nlj_active = TRUE; + while (frs_top != fr + && frs_top->frs_class == FRS_CATCH + && frs_top >= frs_org + /* + && frs_top->frs_class != FRS_PROTECT + && frs_top->frs_class != FRS_CATCHALL + */ + ) { + --frs_top; + } + if (frs_topfrs_lex; + ihs_top = frs_top->frs_ihs; + bds_unwind(frs_top->frs_bds_top); + in_signal_handler = frs_top->frs_in_signal_handler; + signals_allowed=sig_normal; + longjmp((void *)frs_top->frs_jmpbuf, 0); + /* never reached */ +} + +frame_ptr frs_sch (object frame_id) +{ + frame_ptr top; + + for (top = frs_top; top >= frs_org; top--) + if (top->frs_val == frame_id && top->frs_class == FRS_CATCH) + return(top); + return(NULL); +} + +frame_ptr frs_sch_catch(object frame_id) +{ + frame_ptr top; + + for(top = frs_top; top >= frs_org ;top--) + if ((top->frs_val == frame_id && top->frs_class == FRS_CATCH) + || top->frs_class == FRS_CATCHALL + ) + return(top); + return(NULL); +} + + + diff --git a/o/funlink.c b/o/funlink.c new file mode 100755 index 0000000..94c21a2 --- /dev/null +++ b/o/funlink.c @@ -0,0 +1,622 @@ +/* Copyright William Schelter. All rights reserved. +Fast linking method for kcl by W. Schelter University of Texas + Note there are also changes to + cmpcall.lsp and cmptop.lsp */ + + +#include +#include +#include "include.h" +#include "sfun_argd.h" +#include "page.h" + +static int +clean_link_array(object *,object *); + +object sScdefn; +typedef object (*object_func)(); + +static int +vpush_extend(void *,object); + +object sSAlink_arrayA; +int Rset = 0; + +DEFVAR("*LINK-LIST*",sSAlink_listA,SI,0,""); + +static inline void +append_link_list(object sym,int n) { + + object x; + int i; + + if (!Rset || !sSAlink_listA->s.s_dbind) return; + for (x=sSAlink_listA->s.s_dbind;x!=Cnil && x->c.c_car->c.c_car!=sym;x=x->c.c_cdr); + if (x==Cnil) + sSAlink_listA->s.s_dbind=MMcons((x=list(7,sym,make_fixnum(0),make_fixnum(0),make_fixnum(0),make_fixnum(0),make_fixnum(0),make_fixnum(0))),sSAlink_listA->s.s_dbind); + else + x=x->c.c_car; + x=x->c.c_cdr; + if (listp(sym->s.s_gfdef)) + x->c.c_car=one_plus(x->c.c_car); + for (x=x->c.c_cdr,i=0;ic.c_cdr); + x->c.c_car=one_plus(x->c.c_car); +} + + +/* cleanup link */ +void +call_or_link(object sym, void **link) { + + object fun; + + fun = sym->s.s_gfdef; + if (fun == OBJNULL) { + FEinvalid_function(sym); + return; + } + + if (type_of(fun) == t_cclosure && (fun->cc.cc_turbo)) { + if (Rset==0) + MMccall(fun); + else + fun->cf.cf_self(fun); + return; + } + + if (Rset==0) + funcall(fun); + else if (type_of(fun) == t_cfun) { + (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind); + (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind); + *link = (void *) (fun->cf.cf_self); + (*(void (*)())(fun->cf.cf_self))(); + } else { + append_link_list(sym,0); + funcall(fun); + } + +} + +void +call_or_link_closure(object sym, void **link, void **ptr) { + + object fun; + fun = sym->s.s_gfdef; + if (fun == OBJNULL) { + FEinvalid_function(sym); + return; + } + if (type_of(fun) == t_cclosure && (fun->cc.cc_turbo)) { + if (Rset) { + (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind); + (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind); + *ptr = (void *)fun; + *link = (void *) (fun->cf.cf_self); + MMccall(fun); + } else { + append_link_list(sym,1); + MMccall(fun); + } + return; + } + if (Rset==0) + funcall(fun); + /* can't do this if invoking foo(a) is illegal when foo is not defined + to take any arguments. In the majority of C's this is legal */ + else if (type_of(fun) == t_cfun) { + (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); + (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); + *link = (void *)fun->cf.cf_self; + (*(void (*)())fun->cf.cf_self)(); + } else { + append_link_list(sym,2); + funcall(fun); + } +} + +/* for pushing item into an array, where item is an address if array-type = t +or a fixnum if array-type = fixnum */ + +#define SET_ITEM(ar,ind,val) (*((object *)(&((ar)->ust.ust_self[ind]))))= val +static int +vpush_extend(void *item, object ar) +{ register int ind = ar->ust.ust_fillp; + AGAIN: + if (ind < ar->ust.ust_dim) + {SET_ITEM(ar,ind,item); + ind += sizeof(void *); + return(ar->v.v_fillp = ind);} + else + { + int newdim= CEI((2 + (int) (1.3 * ind)),PTR_ALIGN); + unsigned char *newself; + newself = (void *)alloc_relblock(newdim); + bcopy(ar->ust.ust_self,newself,ind); + ar->ust.ust_dim=newdim; + ar->ust.ust_self=newself; + goto AGAIN; + }} + + +/* if we unlink a bunch of functions, this will mean there are some + holes in the link array, and we should probably go through it and + push them back */ +static int number_unlinked=0; + +static void +delete_link(void *address, object link_ar) +{object *ar,*ar_end,*p; + p=0; + ar = link_ar->v.v_self; + ar_end = (object *)&(link_ar->ust.ust_self[link_ar->v.v_fillp]); + while (ar < ar_end) + { if (*ar && *((void **)*ar)==address) + { p = (object *) *ar; + *ar=0; + *p = *(ar+1); + number_unlinked++;} + ar=ar+2;} + if (number_unlinked > 40) + link_ar->v.v_fillp= + clean_link_array(link_ar->v.v_self,ar_end); } + + +DEFUN_NEW("USE-FAST-LINKS",object,fSuse_fast_links,SI,1,2,NONE,OO,OO,OO,OO,(object flag,...), + "Usage: (use-fast-links {nil,t} &optional fun) turns on or off \ +the fast linking depending on FLAG, so that things will either go \ +faster, or turns it off so that stack information is kept. If SYMBOL \ +is supplied and FLAG is nil, then this function is deleted from the fast links") +{int n = VFUN_NARGS; + object sym; + va_list ap; + object *p,*ar,*ar_end; + object link_ar; + object fun=Cnil; + +{ va_start(ap,flag); + if (n>=2) sym=va_arg(ap,object);else goto LDEFAULT2; + goto LEND_VARARG; + LDEFAULT2: sym = Cnil ; + LEND_VARARG: va_end(ap);} + + if (sSAlink_arrayA ==0) RETURN1(Cnil); + link_ar = sSAlink_arrayA->s.s_dbind; + if (link_ar==Cnil && flag==Cnil) RETURN1(Cnil); + check_type_array(&link_ar); + if (type_of(link_ar) != t_string) + { FEerror("*LINK-ARRAY* must be a string",0);} + ar = link_ar->v.v_self; + ar_end = (object *)&(link_ar->ust.ust_self[link_ar->v.v_fillp]); + switch (n) + { + case 1: + if (flag==Cnil) + { Rset=0; + while ( ar < ar_end) + /* set the link variables back to initial state */ + { + p = (object *) *ar; + if (p) *p = (ar++, *ar); else ar++; + ar++; + } + link_ar->v.v_fillp = 0; + } + else + { Rset=1;} + break; + case 2: + + if ((type_of(sym)==t_symbol)) + fun = sym->s.s_gfdef; + else + if (type_of(sym)==t_cclosure) + fun = sym; + else {FEerror("Second arg: ~a must be symbol or closure",0,sym); + } + if(Rset) + { + if(!fun) RETURN1(Cnil); + switch(type_of(fun)){ + case t_cfun: + case t_sfun: + case t_vfun: + case t_gfun: + case t_cclosure: + case t_closure: + case t_afun: + delete_link(fun->cf.cf_self,link_ar); + /* becoming obsolete + y=getf(sym->s.s_plist,sScdefn,Cnil); + if (y!=Cnil) + delete_link(fix(y),link_ar); + */ + + break; + default: + /* no link for uncompiled functions*/ + break; + } + } + break; + default: + FEerror("Usage: (use-fast-links {nil,t} &optional fun)",0); +} + RETURN1(Cnil); +} +object +fSuse_fast_links_2(object flag,object res) { + VFUN_NARGS=2; + return FFN(fSuse_fast_links)(flag,res); +} + + +object +clear_compiler_properties(object sym, object code) { + object tem; + extern object sSclear_compiler_properties; + + if (sSclear_compiler_properties && sSclear_compiler_properties->s.s_gfdef!=OBJNULL) + if ((sSAinhibit_macro_specialA && sSAinhibit_macro_specialA->s.s_dbind != Cnil) || + sym->s.s_sfdef == NOT_SPECIAL) + (void)ifuncall2(sSclear_compiler_properties,sym,code); + tem = getf(sym->s.s_plist,sStraced,Cnil); + + VFUN_NARGS=2; + FFN(fSuse_fast_links)(Cnil,sym); + return tem!=Cnil ? tem : sym; + +} + +static int +clean_link_array(object *ar, object *ar_end) +{int i=0; + object *orig; + orig=ar; + number_unlinked=0; + while( ars.s_gfdef; + if (fun && (type_of(fun)==t_sfun + || type_of(fun)==t_gfun + || type_of(fun)==t_afun + || type_of(fun)== t_vfun) + && Rset) {/* the && Rset is to allow tracing */ + + object (*fn)()=fun->sfn.sfn_self; + + if (type_of(fun)==t_vfun) { + + /* argd=VFUN_NARGS; */ /*remove this! */ + nargs=SFUN_NARGS(argd); + if (nargs < fun->vfn.vfn_minargs || nargs > fun->vfn.vfn_maxargs + || (argd & (SFUN_ARG_TYPE_MASK | SFUN_RETURN_MASK))) + goto WRONG_ARGS; + if ((VFUN_NARG_BIT & argd) == 0) { + /* don't link */ + VFUN_NARGS = nargs; + goto AFTER_LINK; + } + + } else if (type_of(fun)==t_afun) { + + ufixnum ad=fun->sfn.sfn_argd; + ufixnum at=F_TYPES(ad)>>F_TYPE_WIDTH; + ufixnum ma=F_MIN_ARGS(ad); + ufixnum xa=F_MAX_ARGS(ad); + ufixnum rt=F_RESULT_TYPE(ad); + + nargs=SFUN_NARGS(argd); + if (nargs xa || ((argd>>8)&0x3)!=rt || (argd>>12)!=at) + goto WRONG_ARGS; + + } else {/* t_gfun,t_sfun */ + + nargs= SFUN_NARGS(argd); + if ((argd & (~VFUN_NARG_BIT)) != fun->sfn.sfn_argd) + goto WRONG_ARGS; + + } + + (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); + (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); + *link = (void *)fn; + + AFTER_LINK: + + { + object *new; + COERCE_VA_LIST(new,ll,nargs); + return(c_apply_n_fun(fun,nargs,new)); + } + + } else /* there is no cdefn property */ + WRONG_ARGS: + { + /* regular_call: */ + object fun; + register object *base; + enum ftype result_type; + int i; + /* we check they are valid functions before calling this */ + + append_link_list(sym,3); + + fun=type_of(sym)==t_symbol ? symbol_function(sym) : sym; + vs_base=base=vs_top; + if (fun==OBJNULL) + FEinvalid_function(sym); + + nargs=SFUN_NARGS(argd); + result_type=SFUN_RETURN_TYPE(argd); + SFUN_START_ARG_TYPES(argd); + + + if (argd==0) + for (i=0;is.s_gfdef; + + if (fun && (type_of(fun)==t_sfun + || type_of(fun)==t_gfun + || type_of(fun)==t_afun + || type_of(fun)== t_vfun) + && Rset) {/* the && Rset is to allow tracing */ + + object (*fn)()=fun->sfn.sfn_self; + if (type_of(fun)==t_vfun) { + + nargs=SFUN_NARGS(argd); + if (nargs < fun->vfn.vfn_minargs || nargs > fun->vfn.vfn_maxargs + || (argd & (SFUN_ARG_TYPE_MASK | SFUN_RETURN_MASK))) + goto WRONG_ARGS; + if ((VFUN_NARG_BIT & argd) == 0) { + VFUN_NARGS = nargs; + goto AFTER_LINK; + } + + } else if (type_of(fun)==t_afun) { + + ufixnum at=F_TYPES(fun->sfn.sfn_argd)>>F_TYPE_WIDTH; + ufixnum ma=F_MIN_ARGS(fun->sfn.sfn_argd); + ufixnum xa=F_MAX_ARGS(fun->sfn.sfn_argd); + ufixnum rt=F_RESULT_TYPE(fun->sfn.sfn_argd); + + nargs=SFUN_NARGS(argd); + if (nargs xa || ((argd>>8)&0x3)!=rt || (argd>>12)!=at) + goto WRONG_ARGS; + + } else { /* t_gfun,t_sfun */ + + nargs= SFUN_NARGS(argd); + if ((argd & (~VFUN_NARG_BIT)) != fun->sfn.sfn_argd) + goto WRONG_ARGS; + + } + + (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); + (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); + *link = (void *)fn; + + AFTER_LINK: + + { + object *new; + COERCE_VA_LIST_NEW(new,first,ll,nargs); + return(c_apply_n_fun(fun,nargs,new)); + } + + } else /* there is no cdefn property */ + WRONG_ARGS: + { + /* regular_call: */ + object fun; + register object *base; + enum ftype result_type; + int i; + + append_link_list(sym,4); + + /* we check they are valid functions before calling this */ + fun=type_of(sym)==t_symbol ? symbol_function(sym) : sym; + vs_base=base=vs_top; + if (fun==OBJNULL) + FEinvalid_function(sym); + + nargs=SFUN_NARGS(argd); + result_type=SFUN_RETURN_TYPE(argd); + SFUN_START_ARG_TYPES(argd); + + if (argd==0) + for (i=0;is.s_gfdef)==t_cfun) + (*(sym->s.s_gfdef)->cf.cf_self)(); + else super_funcall(sym); + x = vs_base[0]; + vs_top = old_vs_top; + vs_base = old_vs_base; + return(x); +} + + +/* static object */ +/* imfuncall(object sym,int n,...) */ +/* { va_list ap; */ +/* int i; */ +/* object *old_vs_top; */ +/* old_vs_top = vs_top; */ +/* vs_base = old_vs_top; */ +/* vs_top=old_vs_top+n; */ +/* vs_check; */ +/* va_start(ap,n); */ +/* for(i=0;is.s_gfdef)==t_cfun) */ +/* (*(sym->s.s_gfdef)->cf.cf_self)(); */ +/* else super_funcall(sym); */ +/* return(vs_base[0]); */ +/* } */ + +/* go from beg+1 below limit setting entries equal to 0 until you + come to FRESH 0's . */ + +#define FRESH 40 + +int +clear_stack(object *beg, object *limit) +{int i=0; + while (++beg < limit) + {if (*beg==0) i++; + if (i > FRESH) return 0; + ;*beg=0;} return 0;} + +static object +FFN(set_mv)(int i, object val) +{ if (i >= (sizeof(MVloc)/sizeof(object))) + FEerror("Bad mv index",0); + return(MVloc[i]=val); +} + + +static object +FFN(mv_ref)(unsigned int i) +{ object x; + if (i >= (sizeof(MVloc)/sizeof(object))) + FEerror("Bad mv index",0); + x = MVloc[i]; + return x; +} + + +#include "xdrfuns.c" + +DEF_ORDINARY("CDEFN",sScdefn,SI,""); +DEFVAR("*LINK-ARRAY*",sSAlink_arrayA,SI,Cnil,""); + +void +gcl_init_links(void) +{ + + make_si_sfun("SET-MV",set_mv, ARGTYPE2(f_fixnum,f_object) | + RESTYPE(f_object)); + make_si_sfun("MV-REF",mv_ref, ARGTYPE1(f_fixnum) | RESTYPE(f_object)); + gcl_init_xdrfuns(); + } + diff --git a/o/funs b/o/funs new file mode 100755 index 0000000..f7ae0e4 --- /dev/null +++ b/o/funs @@ -0,0 +1,24 @@ +array.c:Iarray_element_type(x) +array.c:Idisplace_array(from,to,displaced_index_offset) +array.c:Icheck_displaced(displaced_list,ar,dim) +array.c:Iundisplace(ar) +error.c:Icall_error_handler(error_name,error_format_string,nfmt_args,va_alist) +eval.c:Ieval(form) +fasdump.c:IreadFasdData() +makefun.c:ImakeClosure(addr,argd,n,va_alist) +makefun.c:IsetClosure(x,n,ap) +nfunlink.c:Icall_proc(fun_name,link_desk,link_loc,ap) +nfunlink.c:Icall_proc_float(fun_name,link_desk,link_loc,ap) +nfunlink.c:IapplyVector(fun,nargs,base) +nfunlink.c:Iinvoke_c_function_from_value_stack(fLaref,F_ARGD(2,2,0,ARGTYPES(oo,io,oo,oo))); +nfunlink.c:Iinvoke_c_function_from_value_stack(f,fargd) +utils.c:IisSymbol(f) +utils.c:IisFboundp(f) +utils.c:IisArray(f) +utils.c:Iis_fixnum(f) +utils.c:Iapply_ap(f,ap) +utils.c:Ifuncall_n(fun,n,va_alist) +utils.c:Iapply_fun_n(fun,n,m,va_alist) +utils.c:ImakeStructure(n,p) +utils.c:Icheck_one_type(x,t) +utils.c:Ineed_in_image(foo) diff --git a/o/gbc.c b/o/gbc.c new file mode 100755 index 0000000..f68eafe --- /dev/null +++ b/o/gbc.c @@ -0,0 +1,1552 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + + This file is part of GNU Common Lisp, herein referred to as GCL + + GCL is free software; you can redistribute it and/or modify it under + the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + GCL 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 Library General Public + License for more details. + + You should have received a copy of the GNU Library General Public License + along with GCL; see the file COPYING. If not, write to the Free Software + Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + GBC.c + IMPLEMENTATION-DEPENDENT +*/ + +#define DEBUG + +#define IN_GBC +#define NEED_MP_H +#include +#include +#include "include.h" +#include "page.h" + + +#ifdef SGC +static void +sgc_sweep_phase(void); + +static void +sgc_mark_phase(void); + +static fixnum +sgc_count_read_only(void); + +#endif + +static void +mark_c_stack(jmp_buf, int, void (*)(void *,void *,int)); + +static void +mark_contblock(void *, int); + +/* the following in line definitions seem to be twice as fast (at + least on mc68020) as going to the assembly function calls in bitop.c so + since this is more portable and faster lets use them --W. Schelter + These assume that DBEGIN is divisible by 32, or else we should have + #define Shamt(x) (((((int) x -DBEGIN) >> 2) & ~(~0 << 5))) +*/ +#define LOG_BITS_CHAR 3 + +#if CPTR_SIZE == 8 +#define LOG_BYTES_CONTBLOCK 3 +#elif CPTR_SIZE == 16 +#define LOG_BYTES_CONTBLOCK 4 +#else +#error Do not recognize CPTR_SIZE +#endif + +void * +cb_in(void *p) { + struct contblock **cbpp; + int i; + + for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { + if ((void *)*cbpp<=p && ((void *)(*cbpp)+(*cbpp)->cb_size) >p) + return *cbpp; + } + return NULL; +} + +int +cb_print(void) { + struct contblock **cbpp; + int i; + + for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) + emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); + emsg("%u blocks\n",i); + return 0; +} + +#ifdef CONTBLOCK_MARK_DEBUG +int +cb_check(void) { + struct contblock **cbpp; + struct pageinfo *v; + void *cbe; + + for (cbpp=&cb_pointer;*cbpp;cbpp=&((*cbpp)->cb_link)) { + v=get_pageinfo(*cbpp); + cbe=((void *)(*cbpp)+(*cbpp)->cb_size-1); + if (cbe>(void *)v+v->in_use*PAGESIZE) + return 1; + } + return 0; +} + +int +m_check(void) { + struct contblock **cbpp; + void *v,*ve,*p,*pe; + extern object malloc_list; + object l; + + for (l=malloc_list;l!=Cnil;l=l->c.c_cdr) { + p=l->c.c_car->st.st_self; + pe=p+l->c.c_car->st.st_dim; + for (cbpp=&cb_pointer;*cbpp;cbpp=&((*cbpp)->cb_link)) { + v=(void *)(*cbpp); + ve=(v+(*cbpp)->cb_size-1); + printf("%p %p %p %p\n",p,pe,v,ve); + if ((v<=p && p < ve)||(v=0); + massert(v+i<(void *)pi+pi->in_use*PAGESIZE); + massert(i<(ve-v)); + return 0; +} +#endif + +static inline bool +pageinfo_p(void *v) { + + struct pageinfo *pi=v; + + return pi->magic==PAGE_MAGIC && pi->type<=t_contiguous && + (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE); + +} + +static inline char +get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); + fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1; +} + +#define bit_get(v,i,s) ((v[i]>>s)&0x1) +#define bit_set(v,i,s) (v[i]|=(1UL<>LOG_BYTES_CONTBLOCK;i=_o>>LOG_BITS_CHAR;s=_o&~(~0UL<++i1) memset(v+i1,-1,(i2-i1)); + for (;--s2>=0;) + bit_set(v,i2,s2); + +} + +static inline void * +get_bits(char *v,struct pageinfo *pi,void *x) { + + void *ds=CB_DATA_START(pi),*de=CB_DATA_END(pi); + fixnum i,s,ie=mbytes(pi->in_use); + bool z; + char cz; + + ptr_set(x,ds,i,s); + z=bit_get(v,i,s); + cz=z?-1:0; + + for (;++s= MARK_ORIGIN_MAX) + error("too many mark origins"); + + mark_origin[mark_origin_max++] = p; + +} + +/* Whenever two arrays are linked together by displacement, + if one is live, the other will be made live */ +#define mark_displaced_field(ar) mark_object(ar->a.a_displaced) + +#define LINK_ARRAY_MARKED(x_) ((*(unsigned long *)(x_))&0x1) +#define MARK_LINK_ARRAY(x_) ((*(unsigned long *)(x_))|=1UL) +#define CLEAR_LINK_ARRAY(x_) ((*(unsigned long *)(x_))&=~(1UL)) + +/* #define COLLECT_RELBLOCK_P (what_to_collect == t_relocatable || what_to_collect == t_contiguous) */ +bool collect_both=0; + +#define COLLECT_RELBLOCK_P (what_to_collect == t_relocatable || collect_both) + +static void +mark_link_array(void *v,void *ve) { + + void **p,**pe; + + if (NULL_OR_ON_C_STACK(v)) + return; + + if (sSAlink_arrayA->s.s_dbind==Cnil) + return; + + p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; + pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; + + for (;p=v && *ps.s_dbind==Cnil) + return; + + ne=n=p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; + pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; + + while (ps.s_dbind->v.v_fillp=(ne-n)*sizeof(*n); + +} + + +static void +sweep_link_array(void) { + + void ***p,***pe; + + if (sSAlink_arrayA->s.s_dbind==Cnil) + return; + + p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; + pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; + for (;pd.st>=ngc_thresh && + (dp=alloc_contblock_no_gc(s,static_promotion_limit))) { + + *pp=memcpy(dp,p,s); + x->d.st=0; + + return; + + } + + if (x && x->d.std.st++; + + if (p>=(void *)heap_end) + *pp=(void *)copy_relblock(p,s); + else + mark_contblock(p,s); + +} + +static void mark_object1(object); +#define mark_object(x) if (marking(x)) mark_object1(x) + +static inline void +mark_object_address(object *o,int f) { + + static ufixnum lp; + static ufixnum lr; + extern object *min_cfd_self; + + ufixnum p=page(o); + + if (lp!=p || !f) { + lp=p; + lr= +#ifdef SGC + sgc_enabled ? WRITABLE_PAGE_P(lp) : +#endif + (o>=min_cfd_self && o<((object *)core_end)); + } + + if (lr) + mark_object(*o); + +} + +static inline void +mark_object_array(object *o,object *oe) { + int f=0; + + if (o) + for (;oc.c_car); + mark_object(Scdr(x));/*FIXME*/ + break; + + case t_fixnum: + break; + + case t_bignum: + MARK_LEAF_DATA(x,MP_SELF(x),MP_ALLOCATED(x)*MP_LIMB_SIZE); + break; + + case t_ratio: + mark_object(x->rat.rat_num); + mark_object(x->rat.rat_den); + + case t_shortfloat: + break; + + case t_longfloat: + break; + + case t_complex: + mark_object(x->cmp.cmp_imag); + mark_object(x->cmp.cmp_real); + + case t_character: + break; + + case t_symbol: + mark_object(x->s.s_plist); + mark_object(x->s.s_gfdef); + mark_object(x->s.s_dbind); + MARK_LEAF_DATA(x,x->s.s_self,x->s.s_fillp); + break; + + case t_package: + mark_object(x->p.p_name); + mark_object(x->p.p_nicknames); + mark_object(x->p.p_shadowings); + mark_object(x->p.p_uselist); + mark_object(x->p.p_usedbylist); + mark_object_array(x->p.p_internal,x->p.p_internal+x->p.p_internal_size); + MARK_LEAF_DATA(x,x->p.p_internal,x->p.p_internal_size*sizeof(object)); + mark_object_array(x->p.p_external,x->p.p_external+x->p.p_external_size); + MARK_LEAF_DATA(x,x->p.p_external,x->p.p_external_size*sizeof(object)); + break; + + case t_hashtable: + mark_object(x->ht.ht_rhsize); + mark_object(x->ht.ht_rhthresh); + if (x->ht.ht_self) + for (i=0;iht.ht_size;i++) + if (x->ht.ht_self[i].hte_key!=OBJNULL) { + mark_object_address(&x->ht.ht_self[i].hte_key,i); + mark_object_address(&x->ht.ht_self[i].hte_value,i+1); + } + i=x->ht.ht_cache-x->ht.ht_self; + MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self)); + if (x->ht.ht_cache) x->ht.ht_cache=x->ht.ht_self+i; + break; + + case t_array: + MARK_LEAF_DATA(x,x->a.a_dims,sizeof(*x->a.a_dims)*x->a.a_rank); + + case t_vector: + case t_bitvector: + + switch(j ? j : (enum aelttype)x->v.v_elttype) { + + case aet_lf: + j= sizeof(longfloat)*x->v.v_dim; + if ((COLLECT_RELBLOCK_P) && (void *)x->v.v_self>=(void *)heap_end) + rb_pointer=PCEI(rb_pointer,sizeof(double)); /*FIXME GC space violation*/ + break; + + case aet_bit: +#define W_SIZE (8*sizeof(fixnum)) + j= sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); + break; + + case aet_char: + case aet_uchar: + j=sizeof(char)*x->v.v_dim; + break; + + case aet_short: + case aet_ushort: + j=sizeof(short)*x->v.v_dim; + break; + + case aet_object: + if (x->v.v_displaced->c.c_car==Cnil) + mark_object_array(x->v.v_self,x->v.v_self+x->v.v_dim); + + default: + j=sizeof(fixnum)*x->v.v_dim; + + } + + case t_string:/*FIXME*/ + j=j ? j : x->st.st_dim; + + if (x->v.v_displaced->c.c_car==Cnil) { + void *p=x->v.v_self; + MARK_LEAF_DATA(x,x->v.v_self,j); + if (x->v.v_displaced!=Cnil) { + j=(void *)x->v.v_self-p; + x->v.v_self=p; + adjust_displaced(x,j); + } + } + mark_object(x->v.v_displaced); + break; + + case t_structure: + { + object def=x->str.str_def; + unsigned char *s_type= &SLOT_TYPE(def,0); + unsigned short *s_pos= &SLOT_POS(def,0); + mark_object(x->str.str_def); + if (x->str.str_self) + for (i=0,j=S_DATA(def)->length;istr.str_self,S_DATA(def)->size); + } + break; + + case t_stream: + switch (x->sm.sm_mode) { + case smm_input: + case smm_output: + case smm_io: + case smm_socket: + case smm_probe: + mark_object(x->sm.sm_object0); + mark_object(x->sm.sm_object1); + if (x->sm.sm_fp) { + MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ); + } + break; + + case smm_synonym: + mark_object(x->sm.sm_object0); + break; + + case smm_broadcast: + case smm_concatenated: + mark_object(x->sm.sm_object0); + break; + + case smm_two_way: + case smm_echo: + mark_object(x->sm.sm_object0); + mark_object(x->sm.sm_object1); + break; + + case smm_string_input: + case smm_string_output: + mark_object(x->sm.sm_object0); + break; +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: + mark_object(x->sm.sm_object0); + mark_object(x->sm.sm_object1); + break; +#endif + default: + error("mark stream botch"); + } + break; + + case t_random: + MARK_LEAF_DATA_ALIGNED(x,x->rnd.rnd_state._mp_seed->_mp_d,x->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE,MP_LIMB_SIZE); + break; + + case t_readtable: + mark_object(x->rt.rt_case); + if (x->rt.rt_self) { + for (i=0;irt.rt_self[i].rte_macro,i); + for (i=0;irt.rt_self[i].rte_dtab,x->rt.rt_self[i].rte_dtab+RTABSIZE); + MARK_LEAF_DATA(x,x->rt.rt_self[i].rte_dtab,RTABSIZE*sizeof(object)); + } + } + MARK_LEAF_DATA(x,x->rt.rt_self,RTABSIZE*sizeof(struct rtent)); + break; + + case t_pathname: + mark_object(x->pn.pn_host); + mark_object(x->pn.pn_device); + mark_object(x->pn.pn_directory); + mark_object(x->pn.pn_name); + mark_object(x->pn.pn_type); + mark_object(x->pn.pn_version); + mark_object(x->pn.pn_namestring); + break; + + case t_closure: + mark_object_array(x->cl.cl_env,x->cl.cl_env+x->cl.cl_envdim); + MARK_LEAF_DATA(x,x->cl.cl_env,x->cl.cl_envdim*sizeof(object)); + + case t_cfun: + case t_sfun: + case t_vfun: + case t_afun: + case t_gfun: + mark_object(x->cf.cf_name); + mark_object(x->cf.cf_data); + break; + + case t_cfdata: + + mark_object_array(x->cfd.cfd_self,x->cfd.cfd_self+x->cfd.cfd_fillp); + if (what_to_collect == t_contiguous) + mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size); + MARK_LEAF_DATA(NULL,x->cfd.cfd_start,x->cfd.cfd_size);/*Code cannot move*/ + break; + + case t_cclosure: + mark_object(x->cc.cc_name); + mark_object(x->cc.cc_env); + mark_object(x->cc.cc_data); + if (x->cc.cc_turbo) { + x->cc.cc_turbo--; + mark_object_array(x->cc.cc_turbo,x->cc.cc_turbo+fix(x->cc.cc_turbo[0])); + MARK_LEAF_DATA(x,x->cc.cc_turbo,(1+fix(x->cc.cc_turbo[0]))*sizeof(*x->cc.cc_turbo)); + x->cc.cc_turbo++; + } + break; + + case t_spice: + break; + + default: +#ifdef DEBUG + if (debug) + printf("\ttype = %d\n", type_of(x)); +#endif + error("mark botch"); + + } + +} + +static long *c_stack_where; + +static void +mark_stack_carefully(void *topv, void *bottomv, int offset) { + + long pageoffset; + long p; + object x; + struct typemanager *tm; + register long *j; + long *top=topv,*bottom=bottomv; + + /* if either of these happens we are marking the C stack + and need to use a local */ + + if (top==0) top = c_stack_where; + if (bottom==0) bottom= c_stack_where; + + /* On machines which align local pointers on multiple of 2 rather + than 4 we need to mark twice + */ + + if (offset) + mark_stack_carefully((((char *) top) +offset),bottom,0); + + for (j=top ; j >= bottom ; j--) { + + void *v=(void *)(*j); + struct pageinfo *pi; + + if (!VALID_DATA_ADDRESS_P(v)) continue; + + if ((p=page(v))type); + if (tm->tm_type>=t_end) continue; + + if (pageoffset<0 || pageoffset>=tm->tm_size*tm->tm_nppage) continue; + + x=(object)(v-pageoffset%tm->tm_size); + + if (is_marked_or_free(x)) continue; + + mark_object(x); + + } + +} + + +static void +mark_phase(void) { + + STATIC fixnum i, j; + STATIC struct package *pp; + STATIC bds_ptr bdp; + STATIC frame_ptr frp; + STATIC ihs_ptr ihsp; + + mark_object(Cnil->s.s_plist); + mark_object(Ct->s.s_plist); + + mark_stack_carefully(vs_top-1,vs_org,0); + mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0); + +#ifdef DEBUG + if (debug) { + printf("value stack marked\n"); + fflush(stdout); + } +#endif + + for (bdp = bds_org; bdp<=bds_top; bdp++) { + mark_object(bdp->bds_sym); + mark_object(bdp->bds_val); + } + + for (frp = frs_org; frp <= frs_top; frp++) + mark_object(frp->frs_val); + + for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++) + mark_object(ihsp->ihs_function); + + for (i = 0; i < mark_origin_max; i++) + mark_object(*mark_origin[i]); + for (i = 0; i < mark_origin_block_max; i++) + for (j = 0; j < mark_origin_block[i].mob_size; j++) + mark_object(mark_origin_block[i].mob_addr[j]); + + for (pp = pack_pointer; pp != NULL; pp = pp->p_link) + mark_object((object)pp); + +#ifdef DEBUG + if (debug) { + printf("symbol navigation\n"); + fflush(stdout); + } +#endif + + /* mark the c stack */ +#ifndef N_RECURSION_REQD +#define N_RECURSION_REQD 2 +#endif + mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); + +} + +#if defined(__ia64__) + asm(" .text"); + asm(" .psr abi64"); + asm(" .psr lsb"); + asm(" .lsb"); + asm(""); + asm(" .text"); + asm(" .align 16"); + asm(" .global GC_save_regs_in_stack"); + asm(" .proc GC_save_regs_in_stack"); + asm("GC_save_regs_in_stack:"); + asm(" .body"); + asm(" flushrs"); + asm(" ;;"); + asm(" mov r8=ar.bsp"); + asm(" br.ret.sptk.few rp"); + asm(" .endp GC_save_regs_in_stack"); + +void * GC_save_regs_in_stack(); +#endif + +#if defined(__hppa__) /* Courtesy of Lamont Jones */ +/* the calling sequence */ +struct regs { + void *callee_saves[16]; +}; +void hppa_save_regs(struct regs); + +/* the code */ + + asm(".code"); + asm(".export hppa_save_regs, entry"); + asm(".label hppa_save_regs"); + asm(".proc"); + asm(".callinfo"); + asm(".entry"); + + asm("stw %r3,0(%arg0)"); + asm("stw %r4,4(%arg0)"); + asm("stw %r5,8(%arg0)"); + asm("stw %r6,12(%arg0)"); + asm("stw %r7,16(%arg0)"); + asm("stw %r8,20(%arg0)"); + asm("stw %r9,24(%arg0)"); + asm("stw %r10,28(%arg0)"); + asm("stw %r11,32(%arg0)"); + asm("stw %r12,36(%arg0)"); + asm("stw %r13,40(%arg0)"); + asm("stw %r14,44(%arg0)"); + asm("stw %r15,48(%arg0)"); + asm("stw %r16,52(%arg0)"); + asm("stw %r17,56(%arg0)"); + asm("bv 0(%rp)"); + asm("stw %r18,60(%arg0)"); + + asm(".exit"); + asm(".procend"); + asm(".end"); +#endif + +static void +mark_c_stack(jmp_buf env1, int n, void (*fn)(void *,void *,int)) { + +#if defined(__hppa__) + struct regs hppa_regs; +#endif + jmp_buf env; + int where; + if (n== N_RECURSION_REQD) + c_stack_where = (long *) (void *) &env; + if (n > 0 ) { +#if defined(__hppa__) + hppa_save_regs(hppa_regs); +#else + setjmp(env); +#endif + mark_c_stack(env,n - 1,fn); + } else { + + /* If the locals of type object in a C function could be + aligned other than on multiples of sizeof (char *) + then define this. At the moment 2 is the only other + legitimate value besides 0 */ + +#ifndef C_GC_OFFSET +#define C_GC_OFFSET 0 +#endif + if (&where > cs_org) + (*fn)(0,cs_org,C_GC_OFFSET); + else + (*fn)(cs_org,0,C_GC_OFFSET); + + } + +#if defined(__ia64__) + { + extern void * __libc_ia64_register_backing_store_base; + void * bst=GC_save_regs_in_stack(); + void * bsb=__libc_ia64_register_backing_store_base; + + if (bsb>bst) + (*fn)(bsb,bst,C_GC_OFFSET); + else + (*fn)(bst,bsb,C_GC_OFFSET); + + } +#endif + +} + +static void +sweep_phase(void) { + + STATIC long j, k, l; + STATIC object x; + STATIC char *p; + STATIC struct typemanager *tm; + STATIC object f; + STATIC struct pageinfo *v; + + for (j= t_start; j < t_contiguous ; j++) { + tm_of(j)->tm_free=OBJNULL; + tm_of(j)->tm_nfree=0; + } + + for (v=cell_list_head;v;v=v->next) { + + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); + f = FREELIST_TAIL(tm); + l = k = 0; + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; + + if (is_marked(x)) { + unmark(x); + l++; + continue; + } + + k++; + + make_free(x); + SET_LINK(f,x); + f = x; + + } + + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; + pagetoinfo(page(v))->in_use=l; + + } + +} + +static void +contblock_sweep_phase(void) { + + struct pageinfo *v; + STATIC char *s, *e, *p, *q; + ufixnum i; + + reset_contblock_freelist(); + + for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { + + bool z; + +#ifdef SGC + if (sgc_enabled && !(v->sgc_flags&SGC_PAGE_FLAG)) continue; +#endif + + s=CB_DATA_START(v); + e=(void *)v+v->in_use*PAGESIZE; + + z=get_mark_bit(v,s); + for (p=s;pcb_link,ncb++); + + return ncb; + +} + + +void +GBC(enum type t) { + +#ifdef DEBUG + int tm=0; +#endif + + BEGIN_NO_INTERRUPT; + + if (t==t_other) { + collect_both=1; + t=t_contiguous; + } + + ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); + recent_allocation=0; + + if (in_signal_handler && t == t_relocatable) + error("cant gc relocatable in signal handler"); + + if (GBC_enter_hook != NULL) + (*GBC_enter_hook)(); + + if (!GBC_enable) + error("GBC is not enabled"); + interrupt_enable = FALSE; + + if (saving_system) { + + struct pageinfo *v; + void *x; + struct typemanager *tm=tm_of(t_stream); + unsigned j; + + for (v=cell_list_head;v;v=v->next) + if (tm->tm_type==v->type) + for (x=pagetochar(page(v)),j=tm->tm_nppage;j--;x+=tm->tm_size) { + object o=x; + if (type_of(o)==t_stream && !is_free(o) && o->sm.sm_fp && o->sm.sm_fp!=stdin && o->sm.sm_fp!=stdout && o->sm.sm_fp!=stderr) + close_stream(o); + } + + gc_time = -1; + } + + +#ifdef DEBUG + debug = symbol_value(sSAgbc_messageA) != Cnil; +#endif + + what_to_collect = t; + + tm_table[(int)t].tm_gbccount++; + tm_table[(int)t].tm_adjgbccnt++; + + if (sSAnotify_gbcA->s.s_dbind != Cnil +#ifdef DEBUG + || debug +#endif + ) { + + if (gc_time < 0) + gc_time=0; + +#ifdef SGC + emsg("[%s for %ld %s pages..", + (sgc_enabled ? "SGC" : "GC"), + (sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage), + (tm_table[(int)t].tm_name)+1); +#else + emsg("[%s for %ld %s pages..", + ("GC"), + (tm_of(t)->tm_npage), + (tm_table[(int)t].tm_name)+1); +#endif + +#ifdef SGC + if(sgc_enabled) + printf("(%ld faulted pages, %ld writable, %ld read only)..", + fault_pages,(page(core_end)-first_data_page)-(page(rb_start)-page(heap_end))-sgc_count_read_only(), + sgc_count_read_only()); +#endif + + fflush(stdout); + + } + + if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} + + if (COLLECT_RELBLOCK_P) { + static_promotion_limit=rb_starts.s_dbind->v.v_self; +#endif + + } + + if (t == t_contiguous) { +#ifdef DEBUG + if (debug) { + printf("contblock sweep phase\n"); + fflush(stdout); + tm = runtime(); + } +#endif + + contblock_sweep_phase(); +#ifdef DEBUG + if (debug) + printf("contblock sweep ended (%d)\n", + runtime() - tm); +#endif + } + +#ifdef DEBUG + if (debug) { + int i,j; + for (i = 0, j = 0; i < (int)t_end; i++) { + if (tm_table[i].tm_type == (enum type)i) { + printf("%13s: %8ld used %8ld free %4ld/%ld pages\n", + tm_table[i].tm_name, + TM_NUSED(tm_table[i]), + tm_table[i].tm_nfree, + tm_table[i].tm_npage, + tm_table[i].tm_maxpage); + j += tm_table[i].tm_npage; + } else + printf("%13s: linked to %s\n", + tm_table[i].tm_name, + tm_table[(int)tm_table[i].tm_type].tm_name); + } + printf("contblock: %ld blocks %ld pages\n", count_contblocks(), ncbpage); + printf("hole: %lu pages\n", (ufixnum)page(rb_start-heap_end)); + printf("relblock: %ld bytes used %ld bytes free %ld pages\n", + (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); + printf("GBC ended\n"); + fflush(stdout); + } +#endif + + interrupt_enable = TRUE; + + if (GBC_exit_hook != NULL) + (*GBC_exit_hook)(); + + if(gc_time>=0 && !--gc_recursive) {gc_time=gc_time+(gc_start=(runtime()-gc_start));} + + if (sSAnotify_gbcA->s.s_dbind != Cnil) { + + if (gc_recursive) + emsg("(T=...).GC finished]\n"); + else + emsg("(T=%d).GC finished]\n",gc_start); + + } + + collect_both=0; + + END_NO_INTERRUPT; + + CHECK_INTERRUPT; + +} + +static void +FFN(siLheap_report)(void) { + + int i; + + check_arg(0); + + vs_check_push(make_fixnum(sizeof(fixnum)*CHAR_SIZE)); + vs_push(make_fixnum(PAGESIZE)); + vs_push(make_fixnum((ufixnum)data_start)); + vs_push(make_fixnum((ufixnum)data_start+(real_maxpage<>1)); + vs_push(make_fixnum(CSTACK_ALIGNMENT)); + vs_push(make_fixnum(labs(cs_limit-cs_org)));/*CSSIZE*/ +#if defined(IM_FIX_BASE) && defined(IM_FIX_LIM) +#ifdef LOW_IM_FIX + vs_push(make_fixnum(-LOW_IM_FIX)); + vs_push(make_fixnum(1UL<>PAGEWIDTH)); + vs_push(make_fixnum(rb_pointer - rb_begin())); + vs_push(make_fixnum((rb_begin()+rb_size()) - rb_pointer)); + vs_push(make_fixnum(nrbpage)); + vs_push(make_fixnum(maxrbpage)); + vs_push(make_fixnum(rbgbccount)); + for (i = 0; i < (int)t_end; i++) { + if (tm_table[i].tm_type == (enum type)i) { + vs_check_push(make_fixnum(TM_NUSED(tm_table[i]))); + vs_push(make_fixnum(tm_table[i].tm_nfree+tm_table[i].tm_alt_nfree)); + vs_push(make_fixnum(tm_table[i].tm_npage)); + vs_push(make_fixnum(tm_table[i].tm_maxpage)); + vs_push(make_fixnum(tm_table[i].tm_gbccount)); + } else { + vs_check_push(Cnil); + vs_push(make_fixnum(tm_table[i].tm_type)); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + } + } +} + +static void +FFN(siLreset_gbc_count)(void) { + + int i; + + check_arg(0); + + for (i = 0; i < t_other; i++) + tm_table[i].tm_gbccount = tm_table[i].tm_adjgbccnt = tm_table[i].tm_opt_maxpage = 0; +} + +/* copy S bytes starting at P to beyond rb_pointer1 (temporarily) + but return a pointer to where this will be copied back to, + when gc is done. alignment of rb_pointer is kept at a multiple + of sizeof(char *); +*/ + +static char * +copy_relblock(char *p, int s) { + char *q = rb_pointer; + + s = CEI(s,PTR_ALIGN); + rb_pointer += s; + memmove(q,p,s);/*FIXME memcpy*/ + + return q; + +} + + +static void +mark_contblock(void *p, int s) { + + STATIC char *q; + STATIC char *x, *y; + struct pageinfo *v; + + if (NULL_OR_ON_C_STACK(p)) + return; + + q = p + s; + /* SGC cont pages: contblock pages must be no smaller than + sizeof(struct contblock). CM 20030827 */ + x = (char *)PFLR(p,CPTR_SIZE); + y = (char *)PCEI(q,CPTR_SIZE); + massert(v=get_pageinfo(x)); +#ifdef SGC + if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG)) +#endif + set_mark_bits(v,x,y); + } + +DEFUN_NEW("CONTIGUOUS-REPORT",object,fScontiguous_report,SI,1,1,NONE,OO,OO,OO,OO,(void),"") { + + struct contblock **cbpp; + struct pageinfo *v; + ufixnum i,j,k,s; + struct typemanager *tm=tm_of(t_cfdata); + void *p; + + for (i=j=0,cbpp=&cb_pointer;(*cbpp);) { + for (k=0,s=(*cbpp)->cb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); + emsg("%lu %lu starting at %p\n",k,s,p); + } + emsg("\nTotal free %lu in %lu pieces\n\n",i,j); + + for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) + emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); + emsg("\nTotal pages %lu in %lu pieces\n\n",i,j); + + for (i=j=0,v=cell_list_head;v;v=v->next) + if (tm->tm_type==v->type) { + void *p; + ufixnum k; + for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { + object o=p; + if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) { + emsg("%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start); + i+=o->cfd.cfd_size; + j++; + } + } + } + emsg("\nTotal code bytes %lu in %lu pieces\n",i,j); + + for (i=j=0,v=cell_list_head;v;v=v->next) { + struct typemanager *tm=tm_of(v->type); + void *p; + ufixnum k; + for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { + object o=p; + void *d=NULL; + ufixnum s=0; + if (!is_free(o)) { + switch (type_of(o)) { + case t_array: + case t_vector: + d=o->a.a_self; + s=o->a.a_dim*sizeof(object); + break; + case t_hashtable: + d=o->ht.ht_self; + s=o->ht.ht_size*sizeof(object)*2; + break; + case t_symbol: + d=o->s.s_self; + s=o->s.s_fillp; + break; + case t_string: + case t_bitvector: + d=o->a.a_self; + s=o->a.a_dim; + break; + case t_package: + d=o->p.p_external; + s=(o->p.p_external_size+o->p.p_internal_size)*sizeof(object); + break; + case t_bignum: + d=o->big.big_mpz_t._mp_d; + s=o->big.big_mpz_t._mp_alloc*MP_LIMB_SIZE; + break; + case t_structure: + d=o->str.str_self; + s=S_DATA(o->str.str_def)->length*sizeof(object); + break; + case t_random: + d=o->rnd.rnd_state._mp_seed->_mp_d; + s=o->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE; + break; + case t_cclosure: + d=o->cc.cc_turbo; + s=fix(o->cc.cc_turbo[-1]); + break; + case t_cfdata: + d=o->cfd.cfd_start; + s=o->cfd.cfd_size; + break; + case t_readtable: + d=o->rt.rt_self; + s=RTABSIZE*(sizeof(struct rtent));/*FIXME*/ + break; + default: + break; + } + if (d>=data_start && d<(void *)heap_end && s) { + emsg("%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d); + i+=s; + j++; + } + } + } + } + emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); + + return Cnil; + +} + +DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") { + + if (x0 == Ct) { + tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_other); + } else if (x0 == Cnil) { + tm_table[t_cons].tm_adjgbccnt--; + GBC(t_cons); + } else if (eql(small_fixnum(0),x0)) { + tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_contiguous); + } else { + x0 = small_fixnum(1); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + RETURN1(x0); +} + +static void +FFN(siLgbc_time)(void) { + if (vs_top>vs_base) + gc_time=fix(vs_base[0]); + else { + vs_base[0]=make_fixnum(gc_time); + vs_top=vs_base+1; + } +} + +#ifdef SGC +#include "sgbc.c" +#endif + +DEFVAR("*NOTIFY-GBC*",sSAnotify_gbcA,SI,Cnil,""); +#ifdef DEBUG +DEFVAR("*GBC-MESSAGE*",sSAgbc_messageA,SI,Cnil,""); +#endif + +void +gcl_init_GBC(void) { + + make_si_function("HEAP-REPORT", siLheap_report); + make_si_function("ROOM-REPORT", siLroom_report); + make_si_function("RESET-GBC-COUNT", siLreset_gbc_count); + make_si_function("GBC-TIME",siLgbc_time); +#ifdef SGC + make_si_function("SGC-ON",siLsgc_on); +#endif + +} diff --git a/o/gcl_readline.d b/o/gcl_readline.d new file mode 100644 index 0000000..a947028 --- /dev/null +++ b/o/gcl_readline.d @@ -0,0 +1,394 @@ +/* + Copyright (C) 2000 Tuukka Toivonen + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + readline.d + + Here we have GNU Readline 4.0 library interface. +*/ + +#define IN_READLINE +#include "include.h" + +#ifdef USE_READLINE + +/* Here begins GNU Readline support. It was designed for Maxima, + * but it works with GCL fine too. If you want to include word completion + * code, define RL_COMPLETION, else undefine it. + * Todo: context sensitive completion, optional keywords. + * To support Readline, we define wrappers (emulation) for putc/ungetc. + * by Tuukka Toivonen 2000-07-25, 2000-10-2. + */ + +#define RL_COMPLETION + +#include +#include +#include +#include +#include +#include +#include + +int readline_on = 0; /* On (1) or off (0) */ +static int rl_ungetc_em_char = -1; +static char *rl_putc_em_line = NULL; + +#ifdef RL_COMPLETION + + +/* New completion generator avoids malloc excet where required, and + dynamically searches current package lists -- 20040102 CM */ + +/* FIXME -- consider mapping malloc to alloca for this function only */ + +DEFVAR("*READLINE-PREFIX*",sSAreadline_prefixA,SI,Cnil,""); + +static char * +rl_completion_words(const char *text, int state) { + + static int i,len,internal,size,prefl; + static object package,use,tp,*base,l; + static const char *ftext,*wtext,*pref; + + if (state==0) { + const char *mch,*fmch,*temp,*temp1,*fpref; + int fprefl; + + fpref=pref=fmch=NULL; + fprefl=prefl=0; + if (type_of(sSAreadline_prefixA->s.s_dbind)==t_string) { + pref=fpref=sSAreadline_prefixA->s.s_dbind->st.st_self; + prefl=fprefl=sSAreadline_prefixA->s.s_dbind->st.st_fillp; + if ((fmch=memchr(fpref,':',fprefl))) { + pref=fmch[1]==':' ? fmch+2 : fmch+1; + prefl-=pref-fpref; + } + } + + mch=strchr(text,':'); + if (!mch) { + temp=fmch; + temp1=fpref; + } else { + temp=mch; + temp1=text; + pref=NULL; + prefl=0; + } + + if (!temp) + package=sLApackageA->s.s_dbind; + else { + if (temp==temp1) + package=(temp[1]==':') ? sLApackageA->s.s_dbind : keyword_package; + else { + static struct string st; + set_type_of(&st,t_string); + st.st_self=(char *)temp1; + st.st_fillp=st.st_dim=temp-temp1; + st.st_hasfillp=1; + package=find_package((object)&st); + } + } + + package=package ? package : user_package; + use=package->p.p_uselist; + internal=temp && temp[1]==':' ? 1 : 0; + ftext=text; + wtext=mch ? mch+1 : ftext; + wtext=*wtext==':' ? wtext+1 : wtext; + len=strlen(wtext); + tp=package; + i=0; + base=internal ? tp->p.p_internal : tp->p.p_external; + size=internal ? tp->p.p_internal_size : tp->p.p_external_size; + l=base[i]; + + } + + while (tp && tp != Cnil) { + + while (1) { + while (type_of(l)==t_cons) { + struct symbol sym=l->c.c_car->s; + l=l->c.c_cdr; + if (pref) { + if (sym.s_fillp=len && + !strncasecmp(wtext,sym.s_self,len)) { + static char *c; + c=malloc((wtext-ftext)+sym.s_fillp+1); + memcpy(c,ftext,wtext-ftext); + memcpy(c+(wtext-ftext),sym.s_self,sym.s_fillp); + c[(wtext-ftext)+sym.s_fillp]=0; + return c; + } + } + if (++i==size) + break; + l=base[i]; + } + + tp=use->c.c_car; + use=use->c.c_cdr; + base=internal ? tp->p.p_internal : tp->p.p_external; + size=internal ? tp->p.p_internal_size : tp->p.p_external_size; + i=0; + l=base[i]; + + } + + return NULL; + +} + +#ifndef HAVE_DECL_RL_COMPLETION_MATCHES +/* readline 4.3 has it, readline 4.1 has completion_matches instead */ +#define rl_completion_matches completion_matches +#endif + +#ifndef HAVE_RL_COMPENTRY_FUNC_T +/* same here */ +typedef char *rl_compentry_func_t(const char *, int); +#endif + +#endif + +static int +my_getc(FILE *f) { + int c; + BEGIN_NO_INTERRUPT; + c=getc(f); + END_NO_INTERRUPT; + return c; +} + +static int +my_putc(int c,FILE *f) { + BEGIN_NO_INTERRUPT; + c=putc(c,f); + END_NO_INTERRUPT; + return c; +} + + +int rl_putc_em(int c, FILE *f) { + + static int allocated_length = 0; + static int current_length = 0; + char *old_line; + + if (f!=stdout || !isatty(fileno(f)) ) goto tail; + + if (c=='\r' || c=='\n') { + current_length = 0; + if (allocated_length>0) rl_putc_em_line[0] = 0; + goto tail; + } + + if (current_length+2 > allocated_length) { + allocated_length = (current_length+8)*2; + old_line = rl_putc_em_line; + rl_putc_em_line = realloc(old_line, allocated_length); + if (rl_putc_em_line==NULL) { + free(old_line); + allocated_length = 0; + current_length = 0; + goto tail; + } + } + + rl_putc_em_line[current_length++] = (unsigned char)c; + rl_putc_em_line[current_length] = 0; + + tail: + return my_putc(c, f); + +} + +#include + +static jmp_buf readline_jmp_buf; + +static void +readline_sigint_handler(int c,siginfo_t *i,void *v) { + longjmp(readline_jmp_buf,1); +} + +static char * +call_readline() { + + struct sigaction siga,old_siga; + char *line; + + sigaction(SIGINT,NULL,&old_siga); + siga=old_siga; + siga.sa_sigaction=readline_sigint_handler; + if (setjmp(readline_jmp_buf)) { + sigaction(SIGINT,&old_siga,NULL); + sigint(); + line=malloc(1); + line[0]=0; + } else { + my_putc('\r', stdout); + sigaction(SIGINT,&siga,&old_siga); + line=readline(rl_putc_em_line); + sigaction(SIGINT,&old_siga,NULL); + rl_putc_em('\r', stdout); + } + return line; + +} + +static int line_eof_p,line_eol_p; + +int rl_getc_em(FILE *f) { + + static char *line; + static int linepos; + + if (f!=stdin || !isatty(fileno(f))) return my_getc(f); + + if (rl_ungetc_em_char!=-1) { + int r = rl_ungetc_em_char; + rl_ungetc_em_char = -1; + return r; + } + + line_eof_p=line_eol_p=0; + if (line==NULL) { + + if (readline_on==1) { + + line = call_readline(); + if (line==NULL) {line_eof_p=1;return EOF;} + if (line[0] != 0) add_history(line); + + } else { + + static int c,nlp; + + if (!nlp) { + fd_set fds; + int n=fileno(f); + FD_ZERO(&fds); + FD_SET(n,&fds); + while (select(n+1,&fds,NULL,NULL,NULL)<=0); + nlp=1; + } + + c=my_getc(f); + + if (c==10) nlp=0; + + return c; + + } + } + + if (line[linepos]==0) { + free(line); + line = NULL; + linepos = 0; + line_eol_p=1; + return '\n'; + } + + return line[linepos++]; + +} + +int +rl_stream_p(FILE *f) { + return readline_on && f==stdin && isatty(fileno(f)); +} + +int +rl_pending_buffered_input_p(FILE *f) { + return line_eof_p||line_eol_p ? FALSE :TRUE; +} + +int +rl_eof_p(FILE *f) { + return line_eof_p ? TRUE : FALSE; +} + +int rl_ungetc_em(int c, FILE *f) { + + if (f!=stdin || !isatty(fileno(f)) ) return ungetc(c, f); + rl_ungetc_em_char = ((unsigned char)c); + return c; + +} + +static void +FFN(siLreadline_on)() { + + const char *cp; + + if (!isatty(0)) { + FEerror("GCL is not being run from a terminal", 0); + return; + } + + if ((cp=getenv("TERM")) && !strcmp(cp,"dumb")) { + FEerror("Controlling terminal is not readline capable", 0); + return; + } + + readline_on=1; + return; + +} + +static void +FFN(siLreadline_off)() { + + readline_on=0; + return; + +} + +void +gcl_init_readline_function(void) { + char *cp=getenv("TERM"); + + *my_rl_readline_name_ptr="GCL"; +#ifdef RL_COMPLETION + *my_rl_completion_entry_function_ptr = rl_completion_words; +#endif + if (isatty(0) && (!cp || strcmp(cp,"dumb"))) + readline_on=1; + +} + +void +gcl_init_readline(void) { + make_si_function("READLINE-ON", siLreadline_on); + make_si_function("READLINE-OFF", siLreadline_off); +} + +#endif /* USE_READLINE */ diff --git a/o/gdb_commands b/o/gdb_commands new file mode 100755 index 0000000..a839183 --- /dev/null +++ b/o/gdb_commands @@ -0,0 +1,45 @@ +# $ma break in main_signal_handler +# $ra break in raise_pending_signals + +command $ma +silent +echo (main_..)signo= +output signo +echo allowed= +output (enum signals_allowed_values) allowed +echo , +seePending +echo ,\n called in: +fr 2 +continue +end + +define seePending +echo signals_pending= +output (unsigned long)signals_pending +echo [ +output /t signals_pending +echo ] +end + +command $ra +silent +echo (raise..)signo= +output *p +echo ,allowed= +output (enum signals_allowed_values) cond +seePending +echo ,\n called in: +fr 1 +continue +end + +command $in +silent +echo for invoke... +frame 1 +frame 2 +frame 3 +echo ...done\n +continue +end diff --git a/o/gmp.c b/o/gmp.c new file mode 100644 index 0000000..1609375 --- /dev/null +++ b/o/gmp.c @@ -0,0 +1,34 @@ +#define ALLOCATE(n) (*gcl_gmp_allocfun)(n) + +void *gcl_gmp_alloc(size_t size) +{ + return (void *) ALLOCATE(size); +} + +static void *gcl_gmp_realloc(void *oldmem, size_t oldsize, size_t newsize) +{ + unsigned int *old,*new; + if (!jmp_gmp) { /* No gc in alloc if jmp_gmp */ + if (MP_SELF(big_gcprotect)) do_gcl_abort(); + MP_SELF(big_gcprotect)=oldmem; + MP_ALLOCATED(big_gcprotect)=oldsize/MP_LIMB_SIZE; + } + new = (void *)ALLOCATE(newsize); + old = jmp_gmp ? oldmem : MP_SELF(big_gcprotect); + MP_SELF(big_gcprotect)=0; + bcopy(old,new,oldsize); +/* SGC contblock pages: Its possible this is on an old page CM 20030827 */ +/* if (inheap(oldmem)) */ +/* #ifdef SGC */ +/* insert_maybe_sgc_contblock(oldmem,oldsize); */ +/* #else */ +/* insert_contblock(oldmem,oldsize); */ +/* #endif */ + + return new; +} + +static void gcl_gmp_free(void *old, size_t oldsize) +{ +} + diff --git a/o/gmp_big.c b/o/gmp_big.c new file mode 100755 index 0000000..ddcb41e --- /dev/null +++ b/o/gmp_big.c @@ -0,0 +1,567 @@ + /* Copyright William F. Schelter 1991 + Bignum routines. + + + +num_arith.c: add_int_big +num_arith.c: big_minus +num_arith.c: big_plus +num_arith.c: big_quotient_remainder +num_arith.c: big_sign +num_arith.c: big_times +num_arith.c: complement_big +num_arith.c: copy_big +num_arith.c: div_int_big +num_arith.c: mul_int_big +num_arith.c: normalize_big +num_arith.c: normalize_big_to_object +num_arith.c: stretch_big +num_arith.c: sub_int_big +num_comp.c: big_compare +num_comp.c: big_sign +num_log.c: big_sign +num_log.c: copy_to_big +num_log.c: normalize_big +num_log.c: normalize_big_to_object +num_log.c: stretch_big +num_pred.c: big_sign +number.c: big_to_double +predicate.c: big_compare +typespec.c: big_sign +print.d: big_minus +print.d: big_sign +print.d: big_zerop +print.d: copy_big +print.d: div_int_big +read.d: add_int_big +read.d: big_to_double +read.d: complement_big +read.d: mul_int_big +read.d: normalize_big +read.d: normalize_big_to_object + + */ + + +#include + +#define DEBUG_GMP +#ifdef DEBUG_GMP +#define ABS(x) ((x) < 0 ? -(x) : (x)) +/* static object */ +/* verify_big(object big) */ +/* { int size; */ +/* if(type_of(big)!=t_bignum) FEerror("Not a bignum",0); */ +/* size = MP_SIZE(big); */ +/* if ( size ==0 || (MP_SELF(big))[ABS(size)-1]==0) */ +/* FEerror("badly formed",0); */ +/* return big; */ +/* } */ + +static object verify_big_or_zero(object big) +{ int size; + if(type_of(big)!=t_bignum) FEerror("Not a bignum",0); + size = MP_SIZE(big); + if ( size && (MP_SELF(big))[ABS(size)-1]==0) + FEerror("badly formed",0); + return big; +} + +/* static */ +/* MP_INT* */ +/* verify_mp(MP_INT *u) */ +/* { int size = u->_mp_size; */ +/* if (size != 0 && u->_mp_d[ABS(size)] == 0) */ +/* FEerror("bad mp",0); */ +/* return u; */ +/* } */ +#else +#define verify_mp(x) +#define verify_big(x) +#define verify_big_or_zero(x) +#endif + +object +new_bignum(void) +{ object ans; + {BEGIN_NO_INTERRUPT; + ans = alloc_object(t_bignum); + MP_SELF(ans) = 0; + mpz_init(MP(ans)); + END_NO_INTERRUPT; + } + return ans; +} + +/* we have to store the body of a u in a bignum object + so that the garbage collecter will move it and save + it, and then we can copy it back +*/ +#define GCPROTECT(u) \ + MP_INT * __u = MP(big_gcprotect); \ + (__u)->_mp_d = (u)->_mp_d; \ + (__u)->_mp_alloc = (u)->_mp_alloc +#define GC_PROTECTED_SELF (__u)->_mp_d +#define END_GCPROTECT (__u)->_mp_d = 0 + +static object +make_bignum(__mpz_struct *u) { + object ans=alloc_object(t_bignum); + memset(MP(ans),0,sizeof(*MP(ans))); + mpz_init_set(MP(ans),u); + return ans; +} + +/* static object */ +/* make_bignum(__mpz_struct *u) */ +/* { object ans ; */ +/* int size; */ +/* {BEGIN_NO_INTERRUPT; */ +/* /\* make sure we follow the bignum body of u if it gets moved... *\/ */ +/* { GCPROTECT(u); */ +/* ans = alloc_object(t_bignum); */ +/* size = u->_mp_size; */ +/* MP(ans)->_mp_d = 0; */ +/* if (size == 0 ) */ +/* size = 1; */ +/* else if (size < 0) size= -size; */ +/* MP(ans)->_mp_d = (mp_ptr) gcl_gmp_alloc (size*MP_LIMB_SIZE); */ +/* MP(ans)->_mp_alloc = size; */ +/* MP(ans)->_mp_size = u->_mp_size; */ +/* memcpy(MP(ans)->_mp_d,GC_PROTECTED_SELF,size*MP_LIMB_SIZE); */ +/* END_GCPROTECT; */ +/* } */ +/* END_NO_INTERRUPT; */ +/* return ans; */ +/* } */ +/* } */ + +/* coerce a mpz_t to a bignum or fixnum */ + +object +make_integer(__mpz_struct *u) +{ + if ((u)->_mp_size == 0) return small_fixnum(0); + if (mpz_fits_slong_p(u)) { + return make_fixnum(mpz_get_si(u)); + } + return make_bignum(u); +} + +/* like make_integer except that the storage of u is cleared + if it is a fixnum, and if not the storage of u is actually + copied to the new bignum +*/ +#ifdef OBSOLETE +object +make_integer_clear(u) +mpz_t u; +{ object ans; + if ((u)->_mp_size == 0) return small_fixnum(0); + if (mpz_fits_slong_p(u)) { + fixnum x = mpz_get_si(u); + mpz_clear(u); + return make_fixnum(x); + } + {BEGIN_NO_INTERRUPT; + { GCPROTECT(u); + ans = alloc_object(t_bignum); + MP(ans)->_mp_alloc = u->_mp_alloc; + MP(ans)->_mp_size = u->_mp_size; + /* the u->_mp_d may have moved */ + MP_SELF(ans) = GC_PROTECTED_SELF; + mpz_clear(u); + END_GCPROTECT; + } + END_NO_INTERRUPT; + } + return ans; +} +#endif /* obsolete */ + +/* static int */ +/* big_zerop(object x) */ +/* { return (mpz_sgn(MP(x))== 0);} */ + +int +big_compare(object x, object y) +{return mpz_cmp(MP(x),MP(y)); +} + + +object +normalize_big_to_object(object x) +{ + return maybe_replace_big(x); +} + + +/* static void */ +/* gcopy_to_big(__mpz_struct *res, object x) */ +/* { */ +/* mpz_set(MP(x),res); */ +/* } */ + +/* destructively modifies x = i - x; */ +void +add_int_big(int i, object x) +{ + MPOP_DEST(x,addsi,i,MP(x)); +} + +/* static void */ +/* sub_int_big(int i, object x) */ +/* { */ /* SI_TEMP_DECL(mpz_int_temp); */ +/* MPOP_DEST(x,subsi,i,MP(x)); */ +/* } */ + +void +mul_int_big(int i, object x) +{ MPOP_DEST(x,mulsi,i,MP(x)); +} + + + +/* + Div_int_big(i, x) destructively divides non-negative bignum x + by positive int i. + X will hold the quotient from the division. + Div_int_big(i, x) returns the remainder of the division. + I should be positive. + X should be non-negative. +*/ + +/* static int */ +/* div_int_big(int i, object x) */ +/* { */ +/* return mpz_tdiv_q_ui(MP(x),MP(x),i); */ +/* } */ + + +/* static object */ +/* big_plus(object x, object y) */ +/* { */ +/* MPOP(return,addii,MP(x),MP(y)); */ +/* } */ + +/* static object */ +/* big_times(object x, object y) */ +/* { */ +/* MPOP(return,mulii,MP(x),MP(y)); */ + +/* } */ + +/* x is a big, and it is coerced to a fixnum (and the big is cleared) + or it is smashed + +*/ +object +normalize_big(object x) +{ + if (MP_SIZE(x) == 0) return small_fixnum(0); + if (mpz_fits_slong_p(MP(x))) { + MP_INT *u = MP(x); + return make_fixnum(mpz_get_si(u)); + } + else return x; +} + +object +big_minus(object x) +{ object y = new_bignum(); + mpz_neg(MP(y),MP(x)); + return normalize_big(y); +} + + +/* static void */ +/* big_quotient_remainder(object x0, object y0, object *qp, object *rp) */ +/* { */ +/* object res,quot; */ +/* res = new_bignum(); */ +/* quot = new_bignum(); */ +/* mpz_tdiv_qr(MP(quot),MP(res),MP(x0),MP(y0)); */ +/* *qp = normalize_big(quot); */ +/* *rp = normalize_big(res); */ +/* return; */ +/* } */ + + +#ifndef IEEEFLOAT +#error big_to_double requires IEEEFLOAT +#endif + + +static int +double_exponent(double d) { + + union {double d;int i[2];} u; + + if (d == 0.0) + return(0); + + u.d=d; + return (((u.i[HIND] & 0x7ff00000) >> 20) - 1022); + +} + +static double +set_exponent(double d, int e) { + + union {double d;int i[2];} u; + + if (d == 0.0) + return(0.0); + + u.d=d; + u.i[HIND]= (u.i[HIND] & 0x800fffff) | (((e + 1022) << 20) & 0x7ff00000); + return(u.d); + +} + +double +big_to_double(object x) { + + double d=mpz_get_d(MP(x)); + int s=mpz_sizeinbase(MP(x),2); + if (s>=54 && mpz_tstbit(MP(x),s-54)) { + + union {double d;int i[2];} u; + + u.i[HIND]=0; + u.i[LIND]=1; + + d+=(d>0.0 ? 1.0 : -1.0)*set_exponent(u.d,double_exponent(d)-53); + + } + + return d; + +} + + +/* static object copy_big(object x) */ +/* { */ +/* if (type_of(x)==t_bignum) */ +/* return make_bignum(MP(x)); */ +/* else FEerror("bignum expected",0); */ +/* return Cnil; */ + +/* } */ + +/* this differes from old copy_to_big in that it does not alter + copy a bignum. +*/ +/* static object */ +/* copy_to_big(object x) { */ +/* if (type_of(x) == t_fixnum) { */ +/* object ans = new_bignum(); */ +/* mpz_set_si(MP(ans),fix(x)); */ +/* return ans; */ +/* } else { */ +/* return x; */ +/* } */ +/* } */ + + +/* put in to get (declare integer working with existing setup. + should be optimized at some point, as we're just converting + and reconverting integer data, it appears -- CM */ + +int +obj_to_mpz(object x,MP_INT * y) { + + switch(type_of(x)) { + case t_fixnum: + mpz_set_si(y,fix(x)); + break; + case t_bignum: + if (abs(MP(x)->_mp_size)<=y->_mp_alloc) + mpz_set(y,MP(x)); + else + return abs(MP(x)->_mp_size)*sizeof(*y->_mp_d); + break; + default: + FEerror("fixnum or bignum expected",0); + break; + } + + return 0; + +} + +int +obj_to_mpz1(object x,MP_INT * y,void *v) { + + switch(type_of(x)) { + case t_fixnum: + mpz_set_si(y,fix(x)); + break; + case t_bignum: + y->_mp_alloc=abs(MP(x)->_mp_size); + y->_mp_d=v; + mpz_set(y,MP(x)); + break; + default: + FEerror("fixnum or bignum expected",0); + break; + } + + return 0; + +} + +int +mpz_to_mpz(MP_INT * x,MP_INT * y) { + + if (abs(x->_mp_size)<=y->_mp_alloc) + mpz_set(y,x); + else + return abs(x->_mp_size)*sizeof(*y->_mp_d); + + return 0; + +} + +int +mpz_to_mpz1(MP_INT * x,MP_INT * y,void *v) { + + y->_mp_alloc=abs(x->_mp_size); + y->_mp_d=v; + mpz_set(y,x); + return 0; + +} + +void +isetq_fix(MP_INT * var,int s) +{ + mpz_set_si(var,s); +} + +MP_INT * +otoi(object x) { + if (type_of(x)==t_fixnum) { + object y = new_bignum(); + mpz_set_si(MP(y),fix(x)); + return MP(y); + } + if (type_of(x)==t_bignum) + return (MP(x)); + FEwrong_type_argument(sLinteger,x); + return NULL; +} +/* end added section for declare integer -- CM */ + + + + +/* return object like *xpt coercing to a fixnum if necessary, + or return the actual bignum replacing it with another +*/ +object +maybe_replace_big(object x) +{ +/* note mpz_fits_sint_p(MP(x)) returns arbitrary result if + passed 0 in bignum form. + bug or feature of gmp.. +*/ + if (MP_SIZE(x) == 0) return small_fixnum(0); + if (mpz_fits_slong_p(MP(x))) { + MP_INT *u = MP(x); + return make_fixnum(mpz_get_si(u)); + } + return make_bignum(MP(x)); +} + + +object +bignum2(unsigned int h, unsigned int l) +{ + object x = new_bignum(); + mpz_set_ui(MP(x),h); + mpz_mul_2exp(MP(x),MP(x),32); + mpz_add_ui(MP(x),MP(x),l); + return normalize_big(x); +} + +void +integer_quotient_remainder_1(object x, object y, object *qp, object *rp,fixnum d) { + + if (type_of(x)==t_fixnum && type_of(y)==t_fixnum) { + fixnum fx=fix(x),fy=fix(y); + if (fx!=-fx) {/*MOST_NEGATIVE_FIX*/ + if (qp) { + fixnum z=fixnum_div(fx,fy,d); + if (rp) *rp=make_fixnum(fx-fy*z); + *qp=make_fixnum(z); + } else if (rp) + *rp=make_fixnum(fixnum_rem(fx,fy,d)); + return; + } + } + + { + + __mpz_struct *b1=INTEGER_TO_MP(x,big_fixnum1),*b2=INTEGER_TO_MP(y,big_fixnum2); + + if (qp) { + if (rp) { + void (*f)()=d<0 ? mpz_fdiv_qr : (d>0 ? mpz_cdiv_qr : mpz_tdiv_qr); + f(MP(big_fixnum3),MP(big_fixnum4),b1,b2); + *rp=maybe_replace_big(big_fixnum4); + } else { + void (*f)()=d<0 ? mpz_fdiv_q : (d>0 ? mpz_cdiv_q : mpz_tdiv_q); + f(MP(big_fixnum3),b1,b2); + } + *qp=maybe_replace_big(big_fixnum3); + } else if (rp) { + void (*f)()=d<0 ? mpz_fdiv_r : (d>0 ? mpz_cdiv_r : mpz_tdiv_r); + f(MP(big_fixnum4),b1,b2); + *rp=maybe_replace_big(big_fixnum4); + } + + } + +} + + +#define HAVE_MP_COERCE_TO_STRING + +object +coerce_big_to_string(object x, int printbase) +{ int i; + int sign = BIG_SIGN(x); + int ss = mpz_sizeinbase(MP(x),printbase); + char *p; + object ans = alloc_simple_string(ss+2+(sign<0? 1: 0)); + ans->st.st_self=p=alloc_relblock(ans->st.st_dim); + /* if (sign < 0) *p++='-'; */ + mpz_get_str(p, printbase,MP(x)); + i = ans->st.st_dim-5; + if (i <0 ) i=0; + while(ans->st.st_self[i]) { i++;} + ans->st.st_fillp=i; + return ans; +} + + +void +gcl_init_big(void) +{ + gcl_init_big1(); + big_gcprotect=alloc_object(t_bignum); + MP_SELF(big_gcprotect)=0; + MP_ALLOCATED(big_gcprotect)=0; + big_fixnum1=new_bignum(); + big_fixnum2=new_bignum(); + big_fixnum3=new_bignum(); + big_fixnum4=new_bignum(); + enter_mark_origin(&big_fixnum1); + enter_mark_origin(&big_gcprotect); + enter_mark_origin(&big_fixnum2); + enter_mark_origin(&big_fixnum3); + enter_mark_origin(&big_fixnum4); + + +} diff --git a/o/gmp_num_log.c b/o/gmp_num_log.c new file mode 100644 index 0000000..3916fa9 --- /dev/null +++ b/o/gmp_num_log.c @@ -0,0 +1,117 @@ +/* + x : fixnum or bignum (may be not normalized) + y : integer + returns + fixnum or bignum ( not normalized ) +*/ + +object big_log_op(); +object normalize_big(object); + +static fixnum +fixnum_log_op2(fixnum op,fixnum x,fixnum y) { + + return fixnum_boole(op,x,y); + +} + +static object +integer_log_op2(fixnum op,object x,enum type tx,object y,enum type ty) { + + object u=big_fixnum1; + object ux=tx==t_bignum ? x : (mpz_set_si(MP(big_fixnum2),fix(x)), big_fixnum2); + object uy=ty==t_bignum ? y : (mpz_set_si(MP(big_fixnum3),fix(y)), big_fixnum3); + + switch(op) { + case BOOLCLR: mpz_set_si(MP(u),0);break; + case BOOLSET: mpz_set_si(MP(u),-1);break; + case BOOL1: mpz_set(MP(u),MP(ux));break; + case BOOL2: mpz_set(MP(u),MP(uy));break; + case BOOLC1: mpz_com(MP(u),MP(ux));break; + case BOOLC2: mpz_com(MP(u),MP(uy));break; + case BOOLAND: mpz_and(MP(u),MP(ux),MP(uy));break; + case BOOLIOR: mpz_ior(MP(u),MP(ux),MP(uy));break; + case BOOLXOR: mpz_xor(MP(u),MP(ux),MP(uy));break; + case BOOLEQV: mpz_xor(MP(u),MP(ux),MP(uy));mpz_com(MP(u),MP(u));break; + case BOOLNAND: mpz_and(MP(u),MP(ux),MP(uy));mpz_com(MP(u),MP(u));break; + case BOOLNOR: mpz_ior(MP(u),MP(ux),MP(uy));mpz_com(MP(u),MP(u));break; + case BOOLANDC1:mpz_com(MP(u),MP(ux));mpz_and(MP(u),MP(u),MP(uy));break; + case BOOLANDC2:mpz_com(MP(u),MP(uy));mpz_and(MP(u),MP(ux),MP(u));break; + case BOOLORC1: mpz_com(MP(u),MP(ux));mpz_ior(MP(u),MP(u),MP(uy));break; + case BOOLORC2: mpz_com(MP(u),MP(uy));mpz_ior(MP(u),MP(ux),MP(u));break; + default:break;/*FIXME error*/ + } + + return u; + +} + +object +log_op2(fixnum op,object x,object y) { + + enum type tx=type_of(x),ty=type_of(y); + + if (tx==t_fixnum && ty==t_fixnum) + return make_fixnum(fixnum_log_op2(op,fix(x),fix(y))); + else + return maybe_replace_big(integer_log_op2(op,x,tx,y,ty)); +} + +static object +log_op(fixnum op) { + + fixnum i,n=vs_top-vs_base,fx=0; + enum type tx,ty; + object x,y; + + if ((tx=type_of(x=vs_base[0]))==t_fixnum) {fx=fix(x);x=OBJNULL;} + for (i=1;i= 0) { + return mpz_popcount(x); + } else { + object u = new_bignum(); + mpz_com(MP(u),x); + return mpz_popcount(MP(u)); + } +} + + +static int +mpz_bitlength(__mpz_struct *x) +{ + if (mpz_sgn(x) >= 0) { + return mpz_sizeinbase(x,2); + } else { + object u = new_bignum(); + mpz_com(MP(u),x); + return mpz_sizeinbase(MP(u),2); + } +} + + + diff --git a/o/gnumalloc.c b/o/gnumalloc.c new file mode 100755 index 0000000..c7c2759 --- /dev/null +++ b/o/gnumalloc.c @@ -0,0 +1,815 @@ +/* dynamic memory allocation for GNU. + Copyright (C) 1985, 1987 Free Software Foundation, Inc. + + NO WARRANTY + + BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY +NO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW. EXCEPT +WHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC, +RICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS" +WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, +BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY +AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE +DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR +CORRECTION. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M. +STALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY +WHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE +LIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR +OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR +DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR +A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS +PROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. + + GENERAL PUBLIC LICENSE TO COPY + + 1. You may copy and distribute verbatim copies of this source file +as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy a valid copyright notice "Copyright +(C) 1985 Free Software Foundation, Inc."; and include following the +copyright notice a verbatim copy of the above disclaimer of warranty +and of this License. You may charge a distribution fee for the +physical act of transferring a copy. + + 2. You may modify your copy or copies of this source file or +any portion of it, and copy and distribute such modifications under +the terms of Paragraph 1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating + that you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, + that in whole or in part contains or is a derivative of this + program or any part thereof, to be licensed at no charge to all + third parties on terms identical to those contained in this + License Agreement (except that you may choose to grant more extensive + warranty protection to some or all third parties, at your option). + + c) You may charge a distribution fee for the physical act of + transferring a copy, and you may at your option offer warranty + protection in exchange for a fee. + +Mere aggregation of another unrelated program with this program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other program under the scope of these terms. + + 3. You may copy and distribute this program (or a portion or derivative +of it, under Paragraph 2) in object code or executable form under the terms +of Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal + shipping charge) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +For an executable file, complete source code means all the source code for +all modules it contains; but, as a special exception, it need not include +source code for modules which are standard libraries that accompany the +operating system on which the executable file runs. + + 4. You may not copy, sublicense, distribute or transfer this program +except as expressly provided under this License Agreement. Any attempt +otherwise to copy, sublicense, distribute or transfer this program is void and +your rights to use the program under this License agreement shall be +automatically terminated. However, parties who have received computer +software programs from you with this License Agreement will not have +their licenses terminated so long as such parties remain in full compliance. + + 5. If you wish to incorporate parts of this program into other free +programs whose distribution conditions are different, write to the Free +Software Foundation at 675 Mass Ave, Cambridge, MA 02139. We have not yet +worked out a simple rule that can be stated here, but we will often permit +this. We will be guided by the two goals of preserving the free status of +all derivatives of our free software and of promoting the sharing and reuse of +software. + + +In other words, you are welcome to use, share and improve this program. +You are forbidden to forbid anyone else to use, share and improve +what you give them. Help stamp out software-hoarding! */ + + +/* + * @(#)nmalloc.c 1 (Caltech) 2/21/82 + * + * U of M Modified: 20 Jun 1983 ACT: strange hacks for Emacs + * + * Nov 1983, Mike@BRL, Added support for 4.1C/4.2 BSD. + * + * This is a very fast storage allocator. It allocates blocks of a small + * number of different sizes, and keeps free lists of each size. Blocks + * that don't exactly fit are passed up to the next larger size. In this + * implementation, the available sizes are (2^n)-4 (or -16) bytes long. + * This is designed for use in a program that uses vast quantities of + * memory, but bombs when it runs out. To make it a little better, it + * warns the user when he starts to get near the end. + * + * June 84, ACT: modified rcheck code to check the range given to malloc, + * rather than the range determined by the 2-power used. + * + * Jan 85, RMS: calls malloc_warning to issue warning on nearly full. + * No longer Emacs-specific; can serve as all-purpose malloc for GNU. + * You should call malloc_init to reinitialize after loading dumped Emacs. + * Call malloc_stats to get info on memory stats if MSTATS turned on. + * realloc knows how to return same block given, just changing its size, + * if the power of 2 is correct. + */ + +/* + * nextf[i] is the pointer to the next free block of size 2^(i+3). The + * smallest allocatable block is 8 bytes. The overhead information will + * go in the first int of the block, and the returned pointer will point + * to the second. + * +#ifdef MSTATS + * nmalloc[i] is the difference between the number of mallocs and frees + * for a given block size. +#endif /* MSTATS */ + +#ifdef emacs +#include "config.h" +#endif /* emacs */ + +/* Determine which kind of system this is. */ +#include +#ifndef SIGTSTP +#ifndef VMS +#ifndef USG +#define USG +#endif +#endif /* not VMS */ +#else /* SIGTSTP */ +#ifdef SIGIO +#define BSD42 +#endif /* SIGIO */ +#endif /* SIGTSTP */ + +/* Define getpagesize () if the system does not. */ +#include "getpagesize.h" + +#ifndef BSD42 +#ifndef USG +#include /* warn the user when near the end */ +#endif /* not USG */ +#else /* if BSD42 */ +#include +#include +#endif /* BSD42 */ + +extern char *start_of_data (); + +#ifdef BSD +#ifndef DATA_SEG_BITS +#define start_of_data() &etext +#endif +#endif + +#ifndef emacs +#define start_of_data() &etext +#endif + +#define ISALLOC ((char) 0xf7) /* magic byte that implies allocation */ +#define ISFREE ((char) 0x54) /* magic byte that implies free block */ + /* this is for error checking only */ +#define ISMEMALIGN ((char) 0xd6) /* Stored before the value returned by + memalign, with the rest of the word + being the distance to the true + beginning of the block. */ + +extern char etext; + +/* These two are for user programs to look at, when they are interested. */ + +unsigned int malloc_sbrk_used; /* amount of data space used now */ +unsigned int malloc_sbrk_unused; /* amount more we can have */ + +/* start of data space; can be changed by calling init_malloc */ +static char *data_space_start; + +#ifdef MSTATS +static int nmalloc[30]; +static int nmal, nfre; +#endif /* MSTATS */ + +/* If range checking is not turned on, all we have is a flag indicating + whether memory is allocated, an index in nextf[], and a size field; to + realloc() memory we copy either size bytes or 1<<(index+3) bytes depending + on whether the former can hold the exact size (given the value of + 'index'). If range checking is on, we always need to know how much space + is allocated, so the 'size' field is never used. */ + +struct mhead { + char mh_alloc; /* ISALLOC or ISFREE */ + char mh_index; /* index in nextf[] */ +/* Remainder are valid only when block is allocated */ + unsigned short mh_size; /* size, if < 0x10000 */ +#ifdef rcheck + unsigned mh_nbytes; /* number of bytes allocated */ + int mh_magic4; /* should be == MAGIC4 */ +#endif /* rcheck */ +}; + +/* Access free-list pointer of a block. + It is stored at block + 4. + This is not a field in the mhead structure + because we want sizeof (struct mhead) + to describe the overhead for when the block is in use, + and we do not want the free-list pointer to count in that. */ + +#define CHAIN(a) \ + (*(struct mhead **) (sizeof (char *) + (char *) (a))) + +#ifdef rcheck + +/* To implement range checking, we write magic values in at the beginning and + end of each allocated block, and make sure they are undisturbed whenever a + free or a realloc occurs. */ +/* Written in each of the 4 bytes following the block's real space */ +#define MAGIC1 0x55 +/* Written in the 4 bytes before the block's real space */ +#define MAGIC4 0x55555555 +#define ASSERT(p) if (!(p)) botch("p"); else +#define EXTRA 4 /* 4 bytes extra for MAGIC1s */ +#else +#define ASSERT(p) +#define EXTRA 0 +#endif /* rcheck */ + + +/* nextf[i] is free list of blocks of size 2**(i + 3) */ + +static struct mhead *nextf[30]; + +/* busy[i] is nonzero while allocation of block size i is in progress. */ + +static char busy[30]; + +/* Number of bytes of writable memory we can expect to be able to get */ +static unsigned int lim_data; + +/* Level number of warnings already issued. + 0 -- no warnings issued. + 1 -- 75% warning already issued. + 2 -- 85% warning already issued. +*/ +static int warnlevel; + +/* Function to call to issue a warning; + 0 means don't issue them. */ +static void (*warnfunction) (); + +/* nonzero once initial bunch of free blocks made */ +static int gotpool; + +char *_malloc_base; + +static void getpool (void); + +/* Cause reinitialization based on job parameters; + also declare where the end of pure storage is. */ +void +malloc_init (char *start, void (*warnfun) (/* ??? */)) +{ + if (start) + data_space_start = start; + lim_data = 0; + warnlevel = 0; + warnfunction = warnfun; +} + +/* Return the maximum size to which MEM can be realloc'd + without actually requiring copying. */ + +int +malloc_usable_size (char *mem) +{ + int blocksize = 8 << (((struct mhead *) mem) - 1) -> mh_index; + + return blocksize - sizeof (struct mhead) - EXTRA; +} + +static void +morecore (register int nu) /* ask system for more memory */ + /* size index to get more of */ +{ + char *sbrk (int n); + register char *cp; + register int nblks; + register unsigned int siz; + int oldmask; + + #ifdef BSD +#ifndef BSD4_1 +#ifdef SGC + oldmask = sigsetmask (-1 & ~(sigmask(SIGPROTV))); +#else + oldmask = sigsetmask (-1); +#endif +#endif +#endif + + + if (!data_space_start) + { + data_space_start = start_of_data (); + } + + if (lim_data == 0) + get_lim_data (); + + /* On initial startup, get two blocks of each size up to 1k bytes */ + if (!gotpool) + { getpool (); getpool (); gotpool = 1; } + + /* Find current end of memory and issue warning if getting near max */ + +#ifndef VMS + /* Maximum virtual memory on VMS is difficult to calculate since it + * depends on several dynmacially changing things. Also, alignment + * isn't that important. That is why much of the code here is ifdef'ed + * out for VMS systems. + */ + cp = sbrk (0); + siz = cp - data_space_start; + malloc_sbrk_used = siz; + malloc_sbrk_unused = lim_data - siz; + + if (warnfunction) + switch (warnlevel) + { + case 0: + if (siz > (lim_data / 4) * 3) + { + warnlevel++; + (*warnfunction) ("Warning: past 75% of memory limit"); + } + break; + case 1: + if (siz > (lim_data / 20) * 17) + { + warnlevel++; + (*warnfunction) ("Warning: past 85% of memory limit"); + } + break; + case 2: + if (siz > (lim_data / 20) * 19) + { + warnlevel++; + (*warnfunction) ("Warning: past 95% of memory limit"); + } + break; + } + + if ((int) cp & 0x3ff) /* land on 1K boundaries */ + sbrk (1024 - ((int) cp & 0x3ff)); +#endif /* not VMS */ + + /* Take at least 2k, and figure out how many blocks of the desired size + we're about to get */ + nblks = 1; + if ((siz = nu) < 8) + nblks = 1 << ((siz = 8) - nu); + + if ((cp = sbrk (1 << (siz + 3))) == (char *) -1) + return; /* no more room! */ +#ifndef VMS + if ((int) cp & 7) + { /* shouldn't happen, but just in case */ + cp = (char *) (((int) cp + 8) & ~7); + nblks--; + } +#endif /* not VMS */ + + /* save new header and link the nblks blocks together */ + nextf[nu] = (struct mhead *) cp; + siz = 1 << (nu + 3); + while (1) + { + ((struct mhead *) cp) -> mh_alloc = ISFREE; + ((struct mhead *) cp) -> mh_index = nu; + if (--nblks <= 0) break; + CHAIN ((struct mhead *) cp) = (struct mhead *) (cp + siz); + cp += siz; + } + CHAIN ((struct mhead *) cp) = 0; + +#ifdef BSD +#ifndef BSD4_1 + sigsetmask (oldmask); +#endif +#endif +} + +static void +getpool (void) +{ + register int nu; + char * sbrk (int n); + register char *cp = sbrk (0); + + if ((int) cp & 0x3ff) /* land on 1K boundaries */ + sbrk (1024 - ((int) cp & 0x3ff)); + + /* Record address of start of space allocated by malloc. */ + if (_malloc_base == 0) + _malloc_base = cp; + + /* Get 2k of storage */ + + cp = sbrk (04000); + if (cp == (char *) -1) + return; + + /* Divide it into an initial 8-word block + plus one block of size 2**nu for nu = 3 ... 10. */ + + CHAIN (cp) = nextf[0]; + nextf[0] = (struct mhead *) cp; + ((struct mhead *) cp) -> mh_alloc = ISFREE; + ((struct mhead *) cp) -> mh_index = 0; + cp += 8; + + for (nu = 0; nu < 7; nu++) + { + CHAIN (cp) = nextf[nu]; + nextf[nu] = (struct mhead *) cp; + ((struct mhead *) cp) -> mh_alloc = ISFREE; + ((struct mhead *) cp) -> mh_index = nu; + cp += 8 << nu; + } +} + +voi * +malloc(size_t n) /* get a block */ + +{ + register struct mhead *p; + register unsigned int nbytes; + register int nunits = 0; + + /* Figure out how many bytes are required, rounding up to the nearest + multiple of 4, then figure out which nextf[] area to use */ + nbytes = (n + sizeof *p + EXTRA + 3) & ~3; + { + register unsigned int shiftr = (nbytes - 1) >> 2; + + while (shiftr >>= 1) + nunits++; + } + + /* In case this is reentrant use of malloc from signal handler, + pick a block size that no other malloc level is currently + trying to allocate. That's the easiest harmless way not to + interfere with the other level of execution. */ + while (busy[nunits]) nunits++; + busy[nunits] = 1; + + /* If there are no blocks of the appropriate size, go get some */ + /* COULD SPLIT UP A LARGER BLOCK HERE ... ACT */ + if (nextf[nunits] == 0) + morecore (nunits); + + /* Get one block off the list, and set the new list head */ + if ((p = nextf[nunits]) == 0) + { + busy[nunits] = 0; + return 0; + } + nextf[nunits] = CHAIN (p); + busy[nunits] = 0; + + /* Check for free block clobbered */ + /* If not for this check, we would gobble a clobbered free chain ptr */ + /* and bomb out on the NEXT allocate of this size block */ + if (p -> mh_alloc != ISFREE || p -> mh_index != nunits) +#ifdef rcheck + botch ("block on free list clobbered"); +#else /* not rcheck */ + abort (); +#endif /* not rcheck */ + + /* Fill in the info, and if range checking, set up the magic numbers */ + p -> mh_alloc = ISALLOC; +#ifdef rcheck + p -> mh_nbytes = n; + p -> mh_magic4 = MAGIC4; + { + register char *m = (char *) (p + 1) + n; + + *m++ = MAGIC1, *m++ = MAGIC1, *m++ = MAGIC1, *m = MAGIC1; + } +#else /* not rcheck */ + p -> mh_size = n; +#endif /* not rcheck */ +#ifdef MSTATS + nmalloc[nunits]++; + nmal++; +#endif /* MSTATS */ + return (char *) (p + 1); +} + +void +free (void *mem) +{ + register struct mhead *p; + { + register char *ap = mem; + + if (ap == 0) + return; + + p = (struct mhead *) ap - 1; + if (p -> mh_alloc == ISMEMALIGN) + { + ap -= p->mh_size; + p = (struct mhead *) ap - 1; + } + + if (p -> mh_alloc != ISALLOC) + abort (); + +#ifdef rcheck + ASSERT (p -> mh_magic4 == MAGIC4); + ap += p -> mh_nbytes; + ASSERT (*ap++ == MAGIC1); ASSERT (*ap++ == MAGIC1); + ASSERT (*ap++ == MAGIC1); ASSERT (*ap == MAGIC1); +#endif /* rcheck */ + } + { + register int nunits = p -> mh_index; + + ASSERT (nunits <= 29); + p -> mh_alloc = ISFREE; + + /* Protect against signal handlers calling malloc. */ + busy[nunits] = 1; + /* Put this block on the free list. */ + CHAIN (p) = nextf[nunits]; + nextf[nunits] = p; + busy[nunits] = 0; + +#ifdef MSTATS + nmalloc[nunits]--; + nfre++; +#endif /* MSTATS */ + } +} + +void * +realloc (void *mem, register size_t n) +{ + register struct mhead *p; + register unsigned int tocopy; + register unsigned int nbytes; + register int nunits; + + if ((p = (struct mhead *) mem) == 0) + return malloc (n); + p--; + nunits = p -> mh_index; + ASSERT (p -> mh_alloc == ISALLOC); +#ifdef rcheck + ASSERT (p -> mh_magic4 == MAGIC4); + { + register char *m = mem + (tocopy = p -> mh_nbytes); + ASSERT (*m++ == MAGIC1); ASSERT (*m++ == MAGIC1); + ASSERT (*m++ == MAGIC1); ASSERT (*m == MAGIC1); + } +#else /* not rcheck */ + if (p -> mh_index >= 13) + tocopy = (1 << (p -> mh_index + 3)) - sizeof *p; + else + tocopy = p -> mh_size; +#endif /* not rcheck */ + + /* See if desired size rounds to same power of 2 as actual size. */ + nbytes = (n + sizeof *p + EXTRA + 7) & ~7; + + /* If ok, use the same block, just marking its size as changed. */ + if (nbytes > (4 << nunits) && nbytes <= (8 << nunits)) + { +#ifdef rcheck + register char *m = mem + tocopy; + *m++ = 0; *m++ = 0; *m++ = 0; *m++ = 0; + p-> mh_nbytes = n; + m = mem + n; + *m++ = MAGIC1; *m++ = MAGIC1; *m++ = MAGIC1; *m++ = MAGIC1; +#else /* not rcheck */ + p -> mh_size = n; +#endif /* not rcheck */ + return mem; + } + + if (n < tocopy) + tocopy = n; + { + register char *new; + + if ((new = malloc (n)) == 0) + return 0; + bcopy (mem, new, tocopy); + free (mem); + return new; + } +} + +#ifndef VMS + +void * +memalign (long alignment, size_t size) +{ + register char *ptr = malloc (size + alignment); + register char *aligned; + register struct mhead *p; + + if (ptr == 0) + return 0; + /* If entire block has the desired alignment, just accept it. */ + if (((int) ptr & (alignment - 1)) == 0) + return ptr; + /* Otherwise, get address of byte in the block that has that alignment. */ + aligned = (char *) (((int) ptr + alignment - 1) & -alignment); + + /* Store a suitable indication of how to free the block, + so that free can find the true beginning of it. */ + p = (struct mhead *) aligned - 1; + p -> mh_size = aligned - ptr; + p -> mh_alloc = ISMEMALIGN; + return aligned; +} + +#ifndef HPUX +/* This runs into trouble with getpagesize on HPUX. + Patching out seems cleaner than the ugly fix needed. */ +char * +valloc (int size) +{ + return memalign (getpagesize (), size); +} +#endif /* not HPUX */ +#endif /* not VMS */ + +#ifdef MSTATS +/* Return statistics describing allocation of blocks of size 2**n. */ + +struct mstats_value + { + int blocksize; + int nfree; + int nused; + }; + +struct mstats_value +malloc_stats (size) + int size; +{ + struct mstats_value v; + register int i; + register struct mhead *p; + + v.nfree = 0; + + if (size < 0 || size >= 30) + { + v.blocksize = 0; + v.nused = 0; + return v; + } + + v.blocksize = 1 << (size + 3); + v.nused = nmalloc[size]; + + for (p = nextf[size]; p; p = CHAIN (p)) + v.nfree++; + + return v; +} +#endif /* MSTATS */ + +/* + * This function returns the total number of bytes that the process + * will be allowed to allocate via the sbrk(2) system call. On + * BSD systems this is the total space allocatable to stack and + * data. On USG systems this is the data space only. + */ + +#ifdef USG + +get_lim_data () +{ + extern long ulimit (); + + lim_data = ulimit (3, 0); + lim_data -= (long) data_space_start; +} + +#else /* not USG */ +#ifndef BSD42 + +get_lim_data () +{ + lim_data = vlimit (LIM_DATA, -1); +} + +#else /* BSD42 */ + +get_lim_data (void) +{ + struct rlimit XXrlimit; + + getrlimit (RLIMIT_DATA, &XXrlimit); +#ifdef RLIM_INFINITY + lim_data = XXrlimit.rlim_cur & RLIM_INFINITY; /* soft limit */ +#else + lim_data = XXrlimit.rlim_cur; /* soft limit */ +#endif +} + +#endif /* BSD42 */ +#endif /* not USG */ + +#ifdef VMS +/* There is a problem when dumping and restoring things on VMS. Calls + * to SBRK don't necessarily result in contiguous allocation. Dumping + * doesn't work when it isn't. Therefore, we make the initial + * allocation contiguous by allocating a big chunk, and do SBRKs from + * there. Once Emacs has dumped there is no reason to continue + * contiguous allocation, malloc doesn't depend on it. + * + * There is a further problem of using brk and sbrk while using VMS C + * run time library routines malloc, calloc, etc. The documentation + * says that this is a no-no, although I'm not sure why this would be + * a problem. In any case, we remove the necessity to call brk and + * sbrk, by calling calloc (to assure zero filled data) rather than + * sbrk. + * + * VMS_ALLOCATION_SIZE is the size of the allocation array. This + * should be larger than the malloc size before dumping. Making this + * too large will result in the startup procedure slowing down since + * it will require more space and time to map it in. + * + * The value for VMS_ALLOCATION_SIZE in the following define was determined + * by running emacs linked (and a large allocation) with the debugger and + * looking to see how much storage was used. The allocation was 201 pages, + * so I rounded it up to a power of two. + */ +#ifndef VMS_ALLOCATION_SIZE +#define VMS_ALLOCATION_SIZE (512*256) +#endif + +/* Use VMS RTL definitions */ +#undef sbrk +#undef brk +#undef malloc +int vms_out_initial = 0; +char vms_initial_buffer[VMS_ALLOCATION_SIZE]; +static char *vms_current_brk = &vms_initial_buffer; +static char *vms_end_brk = &vms_initial_buffer[VMS_ALLOCATION_SIZE-1]; + +#include + +char * +sys_sbrk (incr) + int incr; +{ + char *sbrk(), *temp, *ptr; + + if (vms_out_initial) + { + /* out of initial allocation... */ + if (!(temp = malloc (incr))) + temp = (char *) -1; + } + else + { + /* otherwise, go out of our area */ + ptr = vms_current_brk + incr; /* new current_brk */ + if (ptr <= vms_end_brk) + { + temp = vms_current_brk; + vms_current_brk = ptr; + } + else + { + vms_out_initial = 1; /* mark as out of initial allocation */ + if (!(temp = malloc (incr))) + temp = (char *) -1; + } + } + return temp; +} +#endif /* VMS */ diff --git a/o/gprof.c b/o/gprof.c new file mode 100644 index 0000000..9c2960f --- /dev/null +++ b/o/gprof.c @@ -0,0 +1,112 @@ +#include + +#include "include.h" +#include "page.h" +#include "ptable.h" + + +static unsigned long gprof_on; + +#ifdef DARWIN +void _mcleanup() {} +#endif + +DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + + extern void _mcleanup(void); + + if (!gprof_on) + return Cnil; + + massert((_mcleanup(),1)); + gprof_on=0; + + return make_simple_string("gmon.out"); + +} + +static inline int +my_monstartup(unsigned long start,unsigned long end) { + + extern void monstartup(unsigned long,unsigned long); + + monstartup(start,end); + + return 0; + +} + +DEFUN_NEW("MONSTARTUP",object,fSmonstartup,SI,2,2,NONE,OI,IO,OO,OO,(ufixnum start,ufixnum end),"") { + + if (gprof_on) + return Cnil; + + writable_malloc_wrap(my_monstartup,int,start,end); + gprof_on=1; + + return Ct; + +} + +void +gprof_cleanup(void) { + + FFN(fSmcleanup)(); + +} + +DEFUN_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + + void *min=heap_end,*max=data_start,*c; + static void *mintext; + struct pageinfo *v; + object x; + fixnum i; + struct typemanager *tm=tm_of(t_cfdata); + + for (v=cell_list_head;v;v=v->next) + if (v->type==tm->tm_type) + for (c=pagetochar(page(v)),i=0;itm_nppage;i++,c+=tm->tm_size) + if (!is_free((x=c)) && type_of(x)==t_cfdata && x->cfd.cfd_prof) { + min=(void *)x->cfd.cfd_startcfd.cfd_start : min; + max=(void *)x->cfd.cfd_start+x->cfd.cfd_size>max ? x->cfd.cfd_start+x->cfd.cfd_size : max; + } + + if (maxst.st_self=(void *)c_table.ptable[i].string; + s->st.st_fillp=s->st.st_dim=strlen(s->st.st_self); + RETURN2(make_fixnum(c_table.ptable[i].address),s); +} diff --git a/o/grab_defs.c b/o/grab_defs.c new file mode 100755 index 0000000..5ca65f8 --- /dev/null +++ b/o/grab_defs.c @@ -0,0 +1,98 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + +#include +#include +#include + +/* recognize \nDEF ......... ") and output it to stdout + [ie '")' is a two character sequence which ends the def + recognize \nDO_ [^\n]\n and output it to stdout + + Thus the DEF's MUST contain a doc string as last component. + +*/ +int pos = 0; +#define GETC(x) (pos++,getc(x)) +int +read_some(char *buf, int n, int start_ch, int copy) + /* if copy is not 0 then copy characters to stdout while scanning + to find start_ch. When you find it, read n characters into buf, + return the number of characters read into buf, but these characters + MUST be free of start_ch. + */ + + +{ int ch; + int prev = 0; + while (1) + { ch =GETC(stdin); + if (ch == EOF) return -1; + if (copy) {putc(ch,stdout); + if (prev == '\n' && ch == '{') + { fprintf(stderr,"Error(at char %d):found \\n{ inside section to copy\n",pos) ; + exit(1);} + prev = ch; + } + AGAIN: + if (ch == start_ch) + { int i = 0; + while (i < n) + { ch = GETC(stdin); + if (ch == EOF) return i; + if (copy) {putc(ch,stdout); + if (prev == '\n' && ch == '{') + { fprintf(stderr,"Error(at char %d):found \\n{ inside section to copy",pos) ; + exit(1);} + prev = ch; + } + + if (ch == start_ch) goto AGAIN; + buf[i++] = ch; + } + return i; + }}} + + + +int +main(void) +{ + char buf[20]; + while (3==read_some(buf,3,'\n',0)) + { buf[3] = 0; + if (strcmp(buf,"DEF") ==0) + { printf("\n%s",buf); + while(1==read_some(buf,1,'\"',1)) + { if (buf[0] == ')') + break; + }} + if (strcmp(buf,"DO_") ==0) + {printf("\n%s",buf); + read_some(buf,0,'\n',1); + ungetc('\n',stdin); + } + } + printf("\n"); + exit(0); + +} + + + + + diff --git a/o/grab_defs.u b/o/grab_defs.u new file mode 100755 index 0000000..2bbae9f --- /dev/null +++ b/o/grab_defs.u @@ -0,0 +1 @@ +€ diff --git a/o/hash.d b/o/hash.d new file mode 100755 index 0000000..ff208f0 --- /dev/null +++ b/o/hash.d @@ -0,0 +1,744 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +#define NEED_MP_H +#include +#include "include.h" + + +object sLeq; +object sLeql; +object sLequal; +object sLequalp; + +object sKsize; +object sKrehash_size; +object sKrehash_threshold; +object sKstatic; + +#define MHSH(a_) ((a_) & ~(1UL<<(sizeof(a_)*CHAR_SIZE-1))) + +typedef union {/*FIXME size checks*/ + float f; + unsigned int ul; +} F2ul; + +typedef union { + double d; + unsigned int ul[2]; +} D2ul; + +typedef unsigned char uchar; + +static ufixnum rtb[256]; + +#define MASK(n) (~(~0UL << (n))) + +static ufixnum +ufixhash(ufixnum g) { + ufixnum i,h; + for (h=i=0;i>=CHAR_SIZE,i++) + h^=rtb[g&MASK(CHAR_SIZE)]; + return h; +} + +static ufixnum +uarrhash(void *v,void *ve,uchar off,uchar bits) { + + uchar *c=v,*ce=ve-(bits+(off ? off : CHAR_SIZE)>CHAR_SIZE ? 1 : 0),i; + ufixnum h=0,*u=v,*ue=u+(ce-c)/sizeof(*u); + + if (!off) + for (;u>(CHAR_SIZE*sizeof(*c)-off) : 0))]; + + for (i=off;bits--;i=(i+1)%CHAR_SIZE,c=i ? c : c+1) + h^=rtb[((*c)>>(CHAR_SIZE-1-i))&0x1]; + + return h; + +} + +#define hash_eq1(x) ufixhash((ufixnum)x/sizeof(x)) +#define hash_eq(x) MHSH(hash_eq1(x)) + + +static ufixnum +hash_eql(object x) { + + ufixnum h; + + switch (type_of(x)) { + + case t_fixnum: + h=ufixhash(fix(x)); + break; + + case t_character: + h = rtb[char_code(x)]; + break; + + case t_bignum: + { + MP_INT *mp = MP(x); + void *v1=mp->_mp_d,*ve=v1+mpz_size(mp); + + h=uarrhash(v1,ve,0,0); + } + break; + + case t_ratio: + h=hash_eql(x->rat.rat_num) + hash_eql(x->rat.rat_den); + break; + + case t_shortfloat: /*FIXME, sizeof int = sizeof float*/ + { + F2ul u; + u.f=sf(x); + h=ufixhash(u.ul); + } + break; + + case t_longfloat: + { + D2ul u; + u.d=lf(x); + h=ufixhash(u.ul[0])^ufixhash(u.ul[1]); + } + break; + + case t_complex: + h=hash_eql(x->cmp.cmp_real) + hash_eql(x->cmp.cmp_imag); + break; + + default: + h=hash_eq1(x); + break; + + } + + return MHSH(h); + +} + + +ufixnum +ihash_equal(object x,int depth) { + + enum type tx; + ufixnum h=0; + + cs_check(x); + +BEGIN: + if (depth++ <=3) + switch ((tx=type_of(x))) { + case t_cons: + h^=ihash_equal(x->c.c_car,depth)^rtb[abs((int)(depth%(sizeof(rtb)/sizeof(*rtb))))];/*FIXME: clang faulty warning*/ + x = x->c.c_cdr; + goto BEGIN; + break; + case t_symbol: + case t_string: + h^=uarrhash(x->st.st_self,x->st.st_self+x->st.st_fillp,0,0); + break; + case t_package: + break; + case t_bitvector: + { + ufixnum l=x->bv.bv_offset+x->bv.bv_fillp; + void *v1=x->bv.bv_self+x->bv.bv_offset/CHAR_SIZE,*ve=v1+l/CHAR_SIZE+(x->bv.bv_fillp && l%CHAR_SIZE ? 1 : 0); + h^=uarrhash(v1,ve,x->bv.bv_offset%CHAR_SIZE,x->bv.bv_fillp%CHAR_SIZE); + } + break; + case t_pathname: + h^=ihash_equal(x->pn.pn_host,depth); + h^=ihash_equal(x->pn.pn_device,depth); + h^=ihash_equal(x->pn.pn_directory,depth); + h^=ihash_equal(x->pn.pn_name,depth); + h^=ihash_equal(x->pn.pn_type,depth); + /* version is ignored unless logical host */ + /* if ((type_of(x->pn.pn_host) == t_string) && */ + /* (pathname_lookup(x->pn.pn_host,sSApathname_logicalA) != Cnil)) */ + /* h^=ihash_equal(x->pn.pn_version,depth); */ + h^=ihash_equal(x->pn.pn_version,depth); + break; + default: + h^=hash_eql(x); + break; + } + + return MHSH(h); + +} + +DEFUN_NEW("HASH-EQUAL",object,fShash_equal,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum depth),"") { + RETURN1(make_fixnum(ihash_equal(x,depth))); +} + +unsigned long +ihash_equalp(object x,int depth) { + + enum type tx; + unsigned long h = 0,j; + long i; + + cs_check(x); + +BEGIN: + if (depth++ <=3) + switch ((tx=type_of(x))) { + case t_cons: + h += ihash_equalp(x->c.c_car,depth); + x = x->c.c_cdr; + goto BEGIN; + break; + case t_symbol: + /* x=coerce_to_string(x); */ + { + ufixnum len=x->st.st_fillp; + uchar *s=(void *)x->st.st_self; + for (;len--;) + h^=rtb[toupper(*s++)]; + } + break; + + case t_package: + break; + + /* case t_simple_string: */ + case t_string: + /* case t_simple_bitvector: */ + /* case t_simple_vector: */ + case t_bitvector: + case t_vector: + h^=ufixhash(j=x->st.st_fillp); + j=j>10 ? 10 : j; + for (i=0;ia.a_rank); + for (i=0;ia.a_dims[i]); + j=x->a.a_dim; + j=j>10 ? 10 : j; + for (i=0;iht.ht_nent); + h^=ufixhash(x->ht.ht_test); + j=j>10 ? 10 : j; + for (i=0;iht.ht_self[i].hte_key!=OBJNULL) + switch (x->ht.ht_test) { + case htt_eq: + h^=(((unsigned long)x->ht.ht_self[i].hte_key)>>3) ^ + ihash_equalp(x->ht.ht_self[i].hte_value,depth); + break; + case htt_eql: + h^=hash_eql(x->ht.ht_self[i].hte_key) ^ + ihash_equalp(x->ht.ht_self[i].hte_value,depth); + break; + case htt_equal: + h^=ihash_equal(x->ht.ht_self[i].hte_key,depth) ^ + ihash_equalp(x->ht.ht_self[i].hte_value,depth); + break; + case htt_equalp: + h^=ihash_equalp(x->ht.ht_self[i].hte_key,depth) ^ + ihash_equalp(x->ht.ht_self[i].hte_value,depth); + break; + } + break; + + case t_pathname: + h^=ihash_equalp(x->pn.pn_host,depth); + h^=ihash_equalp(x->pn.pn_device,depth); + h^=ihash_equalp(x->pn.pn_directory,depth); + h^=ihash_equalp(x->pn.pn_name,depth); + h^=ihash_equalp(x->pn.pn_type,depth); + h^=ihash_equalp(x->pn.pn_version,depth); + break; + + case t_structure: + { + unsigned char *s_type; + struct s_data *def; + def=S_DATA(x->str.str_def); + s_type= & SLOT_TYPE(x->str.str_def,0); + h^=ihash_equalp(def->name,depth); + for (i=0;ilength;i++) + if (s_type[i]==aet_object) + h^=ihash_equalp(x->str.str_self[i],depth); + else + h^=ufixhash((long)x->str.str_self[i]); + break; + } + + case t_character: + { + vs_mark; /*FIXME*/ + object *base=vs_base; + vs_base=vs_top; + vs_push(x); + Lchar_upcase(); + x=vs_base[0]; + vs_base=base; + vs_reset; + h^=hash_eql(x); + break; + } + + case t_fixnum: + case t_bignum: + case t_ratio: + case t_shortfloat: + case t_longfloat: + + h^=hash_eql(make_longfloat(number_to_double(x))); + break; + + default: + h^=hash_eql(x); + break; + } + + return MHSH(h); + +} + + +DEFUN_NEW("HASH-EQUALP",object,fShash_equalp,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum depth),"") { + RETURN1(make_fixnum(ihash_equalp(x,depth))); +} + +struct htent * +gethash(object key, object ht) { + + long s,q; + struct htent *e,*ee,*first_open=NULL; + static struct htent dummy={OBJNULL,OBJNULL}; + + if (ht->ht.ht_cache && ht->ht.ht_cache->hte_key==key) + return ht->ht.ht_cache; + ht->ht.ht_cache=NULL; + +#define eq(x,y) x==y +#define hash_loop(t_,i_) \ + for (q=ht->ht.ht_size,s=i_%q;s>=0;q=s,s=s?0:-1) \ + for (e=ht->ht.ht_self,ee=e+q,e+=s;ehte_key; \ + if (hkey==OBJNULL) { \ + if (e->hte_value==OBJNULL) return first_open ? first_open : e; \ + if (!first_open) first_open=e; \ + } else if (t_(key,hkey)) return ht->ht.ht_cache=e; \ + } + + switch (ht->ht.ht_test) { + case htt_eq: + hash_loop(eq,hash_eq(key)); + break; + case htt_eql: + hash_loop(eql,hash_eql(key)); + break; + case htt_equal: + hash_loop(equal,ihash_equal(key,0)); + break; + case htt_equalp: + hash_loop(equalp,ihash_equalp(key,0)); + break; + default: + FEerror( "gethash: Hash table not of type EQ, EQL, or EQUAL." ,0); + return &dummy; + } + + return first_open ? first_open : (FEerror("No free spot in hashtable ~S.", 1, ht),&dummy); + +} + +static void +extend_hashtable(object); + +void +sethash(key, hashtable, value) +object key, hashtable, value; +{ + int i; + bool over=FALSE; + struct htent *e; + + i = hashtable->ht.ht_nent + 1; + if (type_of(hashtable->ht.ht_rhthresh) == t_fixnum) + over = i >= fix(hashtable->ht.ht_rhthresh); + else if (type_of(hashtable->ht.ht_rhthresh) == t_shortfloat) + over = + i >= hashtable->ht.ht_size * sf(hashtable->ht.ht_rhthresh); + else if (type_of(hashtable->ht.ht_rhthresh) == t_longfloat) + over = + i >= hashtable->ht.ht_size * lf(hashtable->ht.ht_rhthresh); + if (over) + extend_hashtable(hashtable); + e = gethash(key, hashtable); + if (e->hte_key == OBJNULL) + hashtable->ht.ht_nent++; + e->hte_key = key; + e->hte_value = value; +} + +static void +extend_hashtable(hashtable) +object hashtable; +{ + object old; + int new_size=0, i; + + if (type_of(hashtable->ht.ht_rhsize) == t_fixnum) + new_size = + hashtable->ht.ht_size + fix(hashtable->ht.ht_rhsize); + else if (type_of(hashtable->ht.ht_rhsize) == t_shortfloat) + new_size = + hashtable->ht.ht_size * sf(hashtable->ht.ht_rhsize); + else if (type_of(hashtable->ht.ht_rhsize) == t_longfloat) + new_size = + hashtable->ht.ht_size * lf(hashtable->ht.ht_rhsize); + {BEGIN_NO_INTERRUPT; + old = alloc_object(t_hashtable); + old->ht = hashtable->ht; + vs_push(old); + hashtable->ht.ht_cache=hashtable->ht.ht_self = NULL; + hashtable->ht.ht_size = new_size; + if (type_of(hashtable->ht.ht_rhthresh) == t_fixnum) + hashtable->ht.ht_rhthresh = + make_fixnum(fix(hashtable->ht.ht_rhthresh) + + (new_size - old->ht.ht_size)); + hashtable->ht.ht_self = hashtable->ht.ht_static ? + (struct htent *)alloc_contblock(new_size * sizeof(struct htent)) : + (struct htent *)alloc_relblock(new_size * sizeof(struct htent)); + for (i = 0; i < new_size; i++) { + hashtable->ht.ht_self[i].hte_key = OBJNULL; + hashtable->ht.ht_self[i].hte_value = OBJNULL; + } + for (i = 0; i < old->ht.ht_size; i++) { + if (old->ht.ht_self[i].hte_key != OBJNULL) + sethash(old->ht.ht_self[i].hte_key, + hashtable, + old->ht.ht_self[i].hte_value); + } + hashtable->ht.ht_nent = old->ht.ht_nent; + vs_popp; + END_NO_INTERRUPT;} +} + +DEFVAR("*DEFAULT-HASH-TABLE-SIZE*",sSAdefault_hash_table_sizeA,SI,make_fixnum(1024),""); +DEFVAR("*DEFAULT-HASH-TABLE-REHASH-SIZE*",sSAdefault_hash_table_rehash_sizeA,SI,make_shortfloat((shortfloat)1.5),""); +DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRESHOLD*",sSAdefault_hash_table_rehash_thresholdA,SI,make_shortfloat((shortfloat)0.7),""); + +DEFUN_NEW("MAKE-HASH-TABLE",object,fLmake_hash_table,LISP,0,63,NONE,OO,OO,OO,OO,(object first,...),"") { + + int i=0,nargs=VFUN_NARGS; + object *base=vs_top,test,size,rehash_size,rehash_threshold,staticp,h; + enum httest htt=0; + va_list ap; + + if (nargs>0) { + vs_push(first); + va_start(ap,first); + for (i++;is.s_dbind : *base;base++; + rehash_size=base[5]==Cnil ? sSAdefault_hash_table_rehash_sizeA->s.s_dbind : *base;base++; + rehash_threshold=base[5]==Cnil ? sSAdefault_hash_table_rehash_thresholdA->s.s_dbind : *base;base++; + staticp=base[5]==Cnil ? Cnil : *base; + vs_top=base; + + if (test == sLeq || test == sLeq->s.s_gfdef) + htt = htt_eq; + else if (test == sLeql || test == sLeql->s.s_gfdef) + htt = htt_eql; + else if (test == sLequal || test == sLequal->s.s_gfdef) + htt = htt_equal; + else if (test == sLequalp || test == sLequalp->s.s_gfdef) + htt = htt_equalp; + else + FEerror("~S is an illegal hash-table test function.", + 1, test); + if (type_of(size) != t_fixnum || 0 < fix(size)) + ; + else + FEerror("~S is an illegal hash-table size.", 1, size); + if ((type_of(rehash_size) == t_fixnum && 0 < fix(rehash_size)) || + (type_of(rehash_size) == t_shortfloat && 1.0 < sf(rehash_size)) || + (type_of(rehash_size) == t_longfloat && 1.0 < lf(rehash_size))) + ; + else + FEerror("~S is an illegal hash-table rehash-size.", + 1, rehash_size); + if ((type_of(rehash_threshold) == t_fixnum && + 0 < fix(rehash_threshold) && fix(rehash_threshold) < fix(size)) || + (type_of(rehash_threshold) == t_shortfloat && + 0.0 < sf(rehash_threshold) && sf(rehash_threshold) < 1.0) || + (type_of(rehash_threshold) == t_longfloat && + 0.0 < lf(rehash_threshold) && lf(rehash_threshold) < 1.0)) + ; + else + FEerror("~S is an illegal hash-table rehash-threshold.", + 1, rehash_threshold); + {BEGIN_NO_INTERRUPT; + h = alloc_object(t_hashtable); + h->ht.ht_test = (short)htt; + h->ht.ht_size = fix(size); + h->ht.ht_rhsize = rehash_size; + h->ht.ht_rhthresh = rehash_threshold; + h->ht.ht_cache=NULL; + h->ht.ht_nent = 0; + h->ht.ht_static = staticp!=Cnil ? 1 : 0; + h->ht.ht_self = NULL; + h->ht.ht_self = h->ht.ht_static ? + (struct htent *)alloc_contblock(fix(size) * sizeof(struct htent)) : + (struct htent *)alloc_relblock(fix(size) * sizeof(struct htent)); + for(i = 0; i < fix(size); i++) { + h->ht.ht_self[i].hte_key = OBJNULL; + h->ht.ht_self[i].hte_value = OBJNULL; + } + END_NO_INTERRUPT;} + + RETURN1(h); + +} + +object +gcl_make_hash_table(object test) { + return (VFUN_NARGS=2,FFN(fLmake_hash_table)(sKtest,test)); +} + + +LFD(Lhash_table_p)(void) +{ + check_arg(1); + + if(type_of(vs_base[0]) == t_hashtable) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Lgethash)() +{ + int narg; + struct htent *e; + + narg = vs_top - vs_base; + if (narg < 2) + too_few_arguments(); + else if (narg == 2) + vs_push(Cnil); + else if (narg > 3) + too_many_arguments(); + check_type_hash_table(&vs_base[1]); + e = gethash(vs_base[0], vs_base[1]); + if (e->hte_key != OBJNULL) { + vs_base[0] = e->hte_value; + vs_base[1] = Ct; + } else { + vs_base[0] = vs_base[2]; + vs_base[1] = Cnil; + } + vs_popp; +} + +DEFUN_NEW("GETHASH1",object,fSgethash1,SI,2,2,NONE,OO,OO,OO,OO,(object k,object h),"") { + + struct htent *e; + + check_type_hash_table(&h); + e = gethash(k,h); + return e->hte_key != OBJNULL ? e->hte_value : Cnil; + +} + + +LFD(siLhash_set)() +{ + check_arg(3); + + check_type_hash_table(&vs_base[1]); + sethash(vs_base[0], vs_base[1], vs_base[2]); + vs_base += 2; +} + +LFD(Lremhash)() +{ + struct htent *e; + + check_arg(2); + check_type_hash_table(&vs_base[1]); + e = gethash(vs_base[0], vs_base[1]); + if (e->hte_key != OBJNULL) { + e->hte_key = OBJNULL; + e->hte_value = Cnil; + vs_base[1]->ht.ht_nent--; + vs_base[0] = Ct; + } else + vs_base[0] = Cnil; + vs_top = vs_base + 1; +} + +LFD(Lclrhash)() +{ + int i; + + check_arg(1); + check_type_hash_table(&vs_base[0]); + for(i = 0; i < vs_base[0]->ht.ht_size; i++) { + vs_base[0]->ht.ht_self[i].hte_key = OBJNULL; + vs_base[0]->ht.ht_self[i].hte_value = OBJNULL; + } + vs_base[0]->ht.ht_nent = 0; +} + +LFD(Lhash_table_count)() +{ + + check_arg(1); + check_type_hash_table(&vs_base[0]); + vs_base[0] = make_fixnum(vs_base[0]->ht.ht_nent); +} + + +LFD(Lsxhash)() +{ + check_arg(1); + + vs_base[0] = make_fixnum((ihash_equal(vs_base[0],0) & 0x7fffffff)); +} + +LFD(Lmaphash)() +{ + object *base = vs_base; + object hashtable; + int i; + + check_arg(2); + check_type_hash_table(&vs_base[1]); + hashtable = vs_base[1]; + for (i = 0; i < hashtable->ht.ht_size; i++) { + if(hashtable->ht.ht_self[i].hte_key != OBJNULL) + ifuncall2(base[0], + hashtable->ht.ht_self[i].hte_key, + hashtable->ht.ht_self[i].hte_value); + } + vs_base[0] = Cnil; + vs_popp; +} + +DEFUNM_NEW("NEXT-HASH-TABLE-ENTRY",object,fSnext_hash_table_entry,SI,2,2,NONE,OO,OO,OO,OO,(object table,object ind),"For HASH-TABLE and for index I return three values: NEXT-START, the next KEY and its VALUE. NEXT-START will be -1 if there are no more entries, otherwise it will be a value suitable for passing as an index") +{ int i = fix(ind); + check_type_hash_table(&table); + if ( i < 0) { FEerror("needs non negative index",0);} + while ( i < table->ht.ht_size) { + if (table->ht.ht_self[i].hte_key != OBJNULL) { + RETURN(3,object,make_fixnum(i+1), + (RV(table->ht.ht_self[i].hte_key), + RV(table->ht.ht_self[i].hte_value)));} + i++;} + RETURN(3,object,small_fixnum(-1),(RV(sLnil),RV(sLnil))); +} + +DEFUN_NEW("HASH-TABLE-TEST",object,fLhash_table_test,LISP,1,1,NONE,OO,OO,OO,OO,(object table), + "Given a HASH-TABLE return a symbol which specifies the function used in its test") +{ + check_type_hash_table(&table); + switch(table->ht.ht_test) { + case htt_equalp: RETURN1(sLequalp); + case htt_equal: RETURN1(sLequal); + case htt_eq: RETURN1(sLeq); + case htt_eql: RETURN1(sLeql); + } + FEerror("not able to get hash table test for ~a",1,table); + RETURN1(sLnil); +} + +DEFUN_NEW("HASH-TABLE-SIZE",object,fLhash_table_size,LISP,1,1,NONE,OO,OO,OO,OO,(object table),"") +{ + check_type_hash_table(&table); + RETURN1(make_fixnum(table->ht.ht_size)); + +} + +DEFUN_NEW("HASH-TABLE-REHASH-SIZE",object,fLhash_table_rehash_size,LISP,1,1,NONE,OO,OO,OO,OO,(object table),"") +{ + check_type_hash_table(&table); + RETURN1(table->ht.ht_rhsize); +} + +DEFUN_NEW("HASH-TABLE-REHASH-THRESHOLD",object,fLhash_table_rehash_threshold,LISP,1,1,NONE,OO,OO,OO,OO,(object table),"") +{ + check_type_hash_table(&table); + RETURN1(table->ht.ht_rhthresh); +} + + + +void +gcl_init_hash() +{ + sLeq = make_ordinary("EQ"); + sLeql = make_ordinary("EQL"); + sLequal = make_ordinary("EQUAL"); + sLequalp = make_ordinary("EQUALP"); + sKsize = make_keyword("SIZE"); + sKtest = make_keyword("TEST"); + sKrehash_size = make_keyword("REHASH-SIZE"); + sKrehash_threshold = make_keyword("REHASH-THRESHOLD"); + sKstatic = make_keyword("STATIC"); + + make_function("HASH-TABLE-P", Lhash_table_p); + make_function("GETHASH", Lgethash); + make_function("REMHASH", Lremhash); + make_function("MAPHASH", Lmaphash); + make_function("CLRHASH", Lclrhash); + make_function("HASH-TABLE-COUNT", Lhash_table_count); + make_function("SXHASH", Lsxhash); + /* make_si_sfun("HASH-EQUAL",hash_equal,ARGTYPE2(f_object,f_fixnum) */ + /* | RESTYPE(f_object)); */ + make_si_function("HASH-SET", siLhash_set); + + { + object x=find_symbol(make_simple_string("MOST-NEGATIVE-FIXNUM"),find_package(make_simple_string("SI"))); + int i; + x=number_negate(x->s.s_dbind); + for (i=0;i= (setq i (- i 1)) 0) + (setq tem (cdr (assoc (aref x i) *subs*))) + (if tem (aset x i tem))) + x)) + +(defun defu (x) + (interactive "sc function name: ") + (insert "DEFUN(\"") + (let (pack name beg) + (cond ((eql (aref x 1) ?L) + (setq pack "LISP")) + ((eql (aref x 1 ) ?S) + (setq pack "SI")) + (t (barf))) + (setq name (upcase (mysub (substring x 2 nil)))) + (insert name "\",object," x "," pack ",0,0,NONE,OO,OO,OO,OO,\"\")") + )) + +(defun insert-vararg-preamble () + (interactive) + (let (min beg) + (beginning-of-line) + (looking-at "DEFUN") + (save-excursion + (search-forward "(") + (forward-sexp 5)(forward-sexp -1) + (setq min (string-to-int (buffer-substring (point) (+ (point) 3)))) + (forward-sexp 1)(forward-sexp -1) + (setq max (string-to-int (buffer-substring (point) (+ (point) 3)))) + ) + (forward-sexp 3) + (forward-char -1) + (insert + (if (eql (char-after (- (point) 1)) ?\( ) "" ",") + "va_alist") + (search-forward "\n{" ) + (forward-char -1) + (open-line 1) + (insert "va_dcl") + (search-forward "\n{" ) + (let ((n (read-string "name for n : " "n")) + (vars (read-minibuffer "names for args: ")) + defaults + (beg (point)) + ) + (insert "\tint " n "=VFUN_NARGS;") + (setq vars (mapcar 'symbol-name vars)) + (let ((tem vars)) + (while tem + (insert "\nobject " (car tem) ";") + (setq tem (cdr tem))) + (setq tem vars) + (insert "\nva_list ap;\n{ va_start(ap);\n") + (let ((i (+ min 1))) + (while tem + (setq defaults (cons (format "LDEFAULT%d" i) defaults)) + (insert " if (" n + (format ">=%d) " i) + (car tem) "=va_arg(ap,object);else goto " + (car defaults)";\n") + (setq i (+ i 1)) + (setq tem (cdr tem))) + (insert " goto LEND_VARARG;\n") + (setq tem vars) + (setq defaults (nreverse defaults)) + (while tem + (insert " "(car defaults) ": " (car tem) " = Cnil;\n") + (setq tem (cdr tem)) (setq defaults (cdr defaults))) + (insert " LEND_VARARG: va_end(ap);}\n")) + (c-indent-region beg (point)) + vars)))) + + + + +(defun get-name-from-point () + (beginning-of-line) + (let (name) + (save-excursion + (cond ((looking-at "\\(siL\\|L\\)\\([a-zA-Z0-9_]*\\)") + (setq name (buffer-substring (match-beginning 2) + (match-end 2))) + + (concat (if (looking-at "si") "fS" + "fL") + name)))))) + +;(grep "grep -n '^siL[a-zA-Z_]*()' *.c *.d") +;(grep "grep -n '^L[a-zA-Z_]*()' *.c *.d") +;(grep "grep -n 'make_keywo' *.c *.d") +;(setq-default case-fold-search nil) +;(let (case-fold-search case-replace)(tags-query-replace "\\b[K]\\([a-z]\\)" "sK\\1")) +;(let (case-fold-search case-replace) (tags-query-replace "\\([^a-zA-Z_]\\)[S]\\([a-z]\\)" "\\1sL\\2")) +;(query-replace-regexp "\\([^a-zA-Z_]\\)[S]\\([a-z]\\)" "\\1sL\\2" nil) +;(setq-default case-fold-search nil) + +(defun defo (&optional x n max) + (interactive) + (beginning-of-line) + (let ((old-name (buffer-substring (point) + (save-excursion + (forward-sexp 1)(point))))) + (or x (setq x (read-string "C function name: " + (get-name-from-point)))) + (insert "DEFUNO(\"") + (let (pack name) + (cond ((eql (aref x 1) ?L) + (setq pack "LISP")) + ((eql (aref x 1 ) ?S) + (setq pack "SI")) + (t (barf))) + (setq name (upcase (mysub (substring x 2 nil)))) + (insert name "\",object," x "," pack + (format "\n ,%d,%d" (or n 0) (or max n 0)) + ",NONE,OO,OO,OO,OO," old-name + ",\"\")") + ) + old-name)) + +(defvar end-def (make-marker)) +(setq standard-args '(x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12)) + +(defun convert-one-def () + (interactive) + (make-local-variable 'version-control) + (setq version-control t) + (let ((here (point)) old-name) + (mark-c-function) + (let ((end (region-end)) n max) + (set-marker end-def end) + (save-restriction + (narrow-to-region (region-beginning) (region-end)) + (save-excursion + (cond ((re-search-forward "check_arg(\\([0-9]+\\));" end t) + (setq n (string-to-int + (buffer-substring (match-beginning 1) + (match-end 1)))) + (delete-region (match-beginning 0) + (match-end 0)) + (insert (format "/* %d args */" n))) + ((or (re-search-forward + "if (vs_top - vs_base < \\([0-9]+\\))[ \t\n]+too_few_arguments();[ \t\n]+if (vs_top - vs_base > \\([0-9]+\\))[ \t\n]+too_many_arguments();" nil t) + (re-search-forward "CHECK_ARG_RANGE(\\([0-9]+\\),\\([0-9]+\\));" nil t)) + (setq n (string-to-int + (buffer-substring (match-beginning 1) + (match-end 1)))) + (setq max (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2)))) + + (delete-region (match-beginning 0) + (match-end 0)) + (insert (format "CHECK_ARG_RANGE(%s,%s);" n max)) + )) + (goto-char here) + (setq old-name (defo nil n max)) + (kill-sexp 1) + (search-forward "(") + (or n (setq n 0)) + (let ((i 0) (args "") ok + (standard-args standard-args) + new) + (while (< i n) + (setq new (cons (car standard-args) new)) + (setq standard-args (cdr standard-args)) + (setq i (+ i 1))) + (setq new (reverse new)) + (save-excursion + (while (not ok) + (setq standard-args + (read-minibuffer "New args: " (format "%s" new))) + (setq ok t) + (setq standard-args (mapcar 'symbol-name standard-args)) + (setq i 0) + (while (and ok (< i n)) + (setq args (format "%s%s" args (nth i standard-args))) + (while (search-forward (nth i standard-args) nil t) + (message "conflict %s? space for ok" (nth i standard-args)) + (cond ((member (read-char) '(?y ?\ ))) + (t (setq ok nil)))) + (setq i (+ i 1)) + (if (< i n) (setq args (concat args ",")))) + )) + + (insert args) + (forward-line 1) + (beginning-of-line) + (and standard-args (insert "object " args ";\n")) + (cond (max + (save-excursion + (search-backward "\nDEFUN") + (forward-char 1) + (setq standard-args + (append standard-args + (insert-vararg-preamble)))))) + (goto-char (point-min)) + (while (re-search-forward + "\\(vs_base\\|base\\)[[]\\([0-9]+\\)[]]" nil t) + (let ((m (string-to-int (buffer-substring (match-beginning 2) + (match-end 2))))) + (cond ((and (nth m standard-args) + (my-y-or-n-p (format "replace-> %s" (nth m standard-args)))) + (delete-region (match-beginning 0) + (match-end 0)) + (insert (nth m standard-args)))))) + (goto-char (point-max)) + (search-backward "}") + (open-line 1) + (insert "RETURN1(" (or (nth 0 standard-args) "vs_base[0]") ");") + (c-indent-command) + (goto-char here) + (widen) + (save-excursion + (goto-char (point-max)) + (cond ((search-backward old-name nil t) + (cond ((my-y-or-n-p "Delete line?") + (beginning-of-line) + (delete-region (point) + (progn (forward-line 1) (point))) + (sit-for 1) + ) + + )))) + )))))) + +(defun next-sexp () + (let (beg) + (forward-sexp 1) + (forward-sexp -1) + (setq beg (point)) + (forward-sexp 1) + (buffer-substring beg (point)))) + +(defun mangle-string (v) + (let ((beg (point)) end ans) + (insert v) + (setq end (point)) + (downcase-region beg end) + (do-replace '(("[*]" "A") + ("[---]" "_") + ("[+]" "Q") + ("[*]" "A") + ("[%]" "P") + ("[;]" "X") + ("[.]" "Z") + ("[,]" "Y") + ("[]" "E") + ("[@]" "B") + + ) beg end) + (setq ans (buffer-substring beg end)) + (delete-region beg end) + ans + )) + +(defun do-replace (lis &optional beg end) + (save-excursion + (let ((ma (make-marker))) + (set-marker ma (or end (point-max))) + (setq beg (or beg (point-min))) + (while lis + (goto-char beg) + (setq x (car lis) ) (setq lis (cdr lis)) + (while (re-search-forward (car x) ma t) + (replace-match (nth 1 x) t))) + (set-marker ma nil)))) + +(defun do-var () + (interactive) + (let (na beg old (m (make-marker))) + (save-excursion + (setq beg (point)) + (setq old (next-sexp)) + (cond ((search-forward "(\"" nil t) + (setq pt (point)) + (forward-char -1) + (setq na (next-sexp)) + (cond ((looking-at ")")) + (t + (forward-sexp 1) + (forward-sexp -1) + (setq val (buffer-substring (point) + (progn (search-forward ");") + (- (point) 2)))) + ;(setq val (next-sexp)) + )))) + (let ((pack "L")) + (goto-char beg) + (cond ((search-forward "make_si" pt t) + (setq pack "S")) + ((search-forward "make_keyw" pt t) + (setq pack "K") + )) + (setq na (concat "s" pack + (mangle-string (substring na 1 (- (length na) 1))))) + (goto-char beg) + (open-line 1) + (defva na val) + ) + + ) + (set-marker m (point)) + (save-excursion + (search-forward ");" nil t) + (delete-region m (point))) + (let ((buf (current-buffer))) + (unwind-protect + (cond ((and (not (equal old na)) + (y-or-n-p (format "Replace %s--> %s :" old na))) + (goto-char (point-min)) + (tags-query-replace old na nil))) + (switch-to-buffer buf) + (goto-char m) + (set-marker m nil) +)))) + + + + +(defun my-y-or-n-p (string) + (message (format "%s (Y or Space for yes): " string)) + (member (read-char) '(?y ?\ ))) + + +(defun defva (x &optional val) + (interactive "sc Variable name: ") + (let (pack name special) + (cond ((eql (aref x 1) ?L) + (setq pack "LISP")) + ((eql (aref x 1 ) ?S) + (setq pack "SI")) + ((eql (aref x 1 ) ?K) + (setq pack "KEYWORD")) + (t (barf))) + (cond ((eql (aref x 2) ?A) + (setq special t))) + (insert (if special "DEFVAR(\"" "DEF_ORDINARY(\"")) + (setq name (upcase (mysub (substring x 2 nil)))) + (insert name "\"," x "," pack) + (if special (insert "," (or val "sLnil"))) + (insert ",\"\");") +; (insert "\n#define " x " S" (substring x 2 nil)) + + )) + +;(tags-search "BEGIN_NO_INTERRUPT") +(global-set-key "\C-x'" 'check-interrupt) +(global-set-key "\C-xp" '(lambda()(interactive) (insert "END_NO_INTERRUPT;"))) +(global-set-key "\C-xa" + '(lambda()(interactive) (insert "{BEGIN_NO_INTERRUPT;") + (save-excursion (beginning-of-line) (forward-sexp 1) (insert "}")))) + +(defun check-interrupt ( ) + (interactive) + (let (found at (bil (make-marker)) (ok t)) + (forward-sexp -1) + (setq at (point)) + (mark-c-function) + (goto-char at) + (set-marker bil (region-end)) + (while (and ok (re-search-forward "\\(return\\)\\|\\(END_NO_INTERRUPT\\)" + bil t)) + (cond ((match-beginning 1) + (setq found t) + (if (my-y-or-n-p "replace?") + (replace-match "goto END_INTER " t))) + ((match-beginning 2) + (setq ok nil) + (if (and found (my-y-or-n-p "replace?")) + (replace-match "END_INTER: END_NO_INTERRUPT;\n return " t))) + )) + (set-marker bil nil) + (or found (message "was ok")) + (if ok (message "problem")) + )) + + + +(defun foo() + (interactive) + (let (p tem) + (end-of-line) + (setq p (point)) + (forward-sexp -1) + (forward-char 1) + (setq tem (buffer-substring (point) p)) + (save-excursion + (set-buffer (get-buffer "usig2.c<2>")) + (insert "\t&" tem ",\n")) + (forward-line 1))) + +(defun fa () + (interactive) + (let (p tem) + (end-of-line) + (setq p (point)) + (forward-sexp -1) + (forward-char 1) + (setq tem (buffer-substring (point) p)) + (grep (concat "grep -n " tem " o/*.c o/*.d mp/*.c h/*.h ")))) + +;(let ((case-fold-search nil)) (tags-query-replace "NONE" "VARARG")) + +(defun fa () + (interactive) + (re-search-forward "&\\([a-zA-Z0-9_]+\\)," nil t) + (grep (concat "grep -n " (buffer-substring (match-beginning 1) + (match-end 1)) + " ../o/*c ../o/*.d ../h/*.h ../mp/*.c"))) + +(defun my-grep () + (interactive) + (let (end ) + (save-excursion + (forward-sexp 1) (setq end (point)) + (forward-sexp -1) + (let ((tem (buffer-substring (point) end))) + (setq tem (read-string "Grep: " (concat "grep -n " tem " ../o/*.c ../o/*.d ../h/*.h ../mp/*.c"))) + (grep tem))))) diff --git a/o/init_pari.c b/o/init_pari.c new file mode 100755 index 0000000..f48ab7d --- /dev/null +++ b/o/init_pari.c @@ -0,0 +1,96 @@ +#define IN_INIT_PARI + +#define NEED_MP_H +#ifndef STANDALONE +#include "include.h" +#endif + +#ifdef GMP +/* static void */ +/* init_pari(void) */ +/* { */ +/* ; */ +/* } */ +#else +GEN gnil,gzero,gun,gdeux,ghalf,gi; +plong lontyp[30]={0,0x10000,0x10000,1,1,1,1,2,1,0,2,2,1,1,1,0,1,1,1,1}; +unsigned plong hiremainder,overflow; + +#ifdef STANDALONE +#define FEerror printf +#define make_si_sfun(a,b,c) +#endif + +#define INITIAL_PARI_STACK 400 +char initial_pari_stack[400]; + +our_ulong bot= (our_ulong) initial_pari_stack; +our_ulong top = (our_ulong)(initial_pari_stack+INITIAL_PARI_STACK); +/* not initted */ +our_ulong avma= 0; + + +void +err(s) + int s; +{ switch (s) { + case errpile: + FEerror("Out of bignum stack space, (si::MULTIPLY-BIGNUM-STACK n) to grow",0); + case dvmer1: + case diver4: + case diver2: + case diver1: + FEerror("Divide by zero",0); + case muler1: + FEerror("Multiply overflow",0); + case moder1: + FEerror("Mod by 0",0); + default: + FEerror("Integer Arithmetic error",0); +}} + + + + +multiply_bignum_stack(n) + int n; +{ int parisize = n* (top - bot); + in_saved_avma = 0; + if (n> 1) + { if (bot != (our_ulong)initial_pari_stack) free(bot); + set_pari_stack(parisize); + } + return parisize; +} + +set_pari_stack(parisize) + int parisize; +{ + bot=(plong)malloc(parisize); + top = avma = bot + parisize; +} + +static +init_pari() +{ + if (avma==0) + { + make_si_sfun("MULTIPLY-BIGNUM-STACK",multiply_bignum_stack, + ARGTYPE1(f_fixnum) | RESTYPE(f_fixnum)); + avma = top; + } + /* room for the permanent things */ + + gnil = cgeti(2);gnil[1]=2; setpere(gnil,255); + gzero = cgeti(2);gzero[1]=2; setpere(gzero, 255); + gun = stoi(1); setpere(gun, 255); + gdeux = stoi(2); setpere(gdeux, 255); + ghalf = cgetg(3,4);ghalf[1]=un;ghalf[2]=deux; setpere(ghalf, 255); + gi = cgetg(3,6); gi[1] = zero; gi[2] = un; setpere(gi, 255); + + /* set_pari_stack(BIGNUM_STACK_SIZE);*/ + } + + + +#endif diff --git a/o/internal-calls.lisp b/o/internal-calls.lisp new file mode 100755 index 0000000..eb230e5 --- /dev/null +++ b/o/internal-calls.lisp @@ -0,0 +1,3227 @@ +(setq all-references ( + +;;/* for file nfunlink.X */ + +( "nfunlink.X" +"FEerror" +"FEinvalid_function" +"vpush_extend" +"FEerror" +"vs_overflow" +"ihs_punsh_base" +"ihs_overflow" +"funcall" +"FEerror" +) + +;;/* for file alloc.X */ + +( "alloc.X" +"sgc_quit" +"GBC" +"sgc_start" +"error" +"error" +"alarm" +"terminal_interrupt" +"GBC" +"sgc_count_type" +"call_after_gbc_hook" +"CEerror" +"alarm" +"terminal_interrupt" +"GBC" +"sgc_count_type" +"call_after_gbc_hook" +"CEerror" +"set_up_string_register" +"t_from_type" +"terminal_interrupt" +"insert_contblock" +"GBC" +"CEerror" +"insert_contblock" +"terminal_interrupt" +"GBC" +"FEerror" +"error" +"CEerror" +"getpagesize" +"error" +"bzero" +"getrlimit" +"enter_mark_origin" +"FEerror" +"too_few_arguments" +"too_many_arguments" +"t_from_type" +"FEerror" +"strncmp" +"FEerror" +"check_arg_failed" +"check_arg_failed" +"too_few_arguments" +"too_many_arguments" +"FEerror" +"printf" +"check_arg_failed" +"check_arg_failed" +"too_few_arguments" +"too_many_arguments" +"FEerror" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"fixint" +"FEerror" +"endp1" +"FEerror" +"endp1" +"FEerror" +"getpagesize" +) + +;;/* for file array.X */ + +( "array.X" +"FEwrong_type_argument" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"bcopy" +"check_arg_failed" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"fixint" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"fixnnint" +"FEerror" +"FEerror" +"FEerror" +"fixnnint" +"FEerror" +"too_few_arguments" +"FEerror" +"fixnnint" +"FEerror" +"FEerror" +"check_arg_failed" +"fixnnint" +"FEerror" +"too_few_arguments" +"FEerror" +"fixnnint" +"fixnnint" +"FEwrong_type_argument" +"too_few_arguments" +"FEerror" +"fixnnint" +"fixnnint" +"FEwrong_type_argument" +"check_arg_failed" +"check_arg_failed" +"check_type_array" +"check_arg_failed" +"check_type_array" +"fixnnint" +"FEerror" +"check_arg_failed" +"check_type_array" +"check_arg_failed" +"check_type_array" +"check_arg_failed" +"check_type_array" +"check_arg_failed" +"FEerror" +"illegal_index" +"check_arg_failed" +"FEerror" +"fixnnint" +"illegal_index" +"check_arg_failed" +"check_type_array" +"check_arg_failed" +"check_type_vector" +"FEerror" +"check_arg_failed" +"check_type_vector" +"fixnnint" +"FEerror" +"check_arg_failed" +"FEerror" +"check_arg_failed" +"endp1" +) + +;;/* for file assignment.X */ + +( "assignment.X" +"not_a_symbol" +"FEinvalid_variable" +"endp1" +"endp1" +"FEinvalid_form" +"eval" +"endp1" +"FEinvalid_form" +"eval" +"check_arg_failed" +"not_a_symbol" +"FEinvalid_variable" +"check_arg_failed" +"not_a_symbol" +"FEerror" +"FEerror" +"endp1" +"FEinvalid_form" +"eval" +"check_arg_failed" +"not_a_symbol" +"FEinvalid_variable" +"check_arg_failed" +"not_a_symbol" +"FEerror" +"remf" +"endp1" +"FEinvalid_form" +"setf" +"eval" +"eval" +"eval" +"eval" +"siLputprop" +"eval" +"eval" +"FEerror" +"eval" +"eval" +"FEerror" +"eval" +"eval" +"eval" +"eval" +"eval" +"eval" +"endp1" +"eval" +"eval" +"stack_cons" +"FEerror" +"funcall" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"stack_cons" +"FEerror" +"funcall" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"stack_cons" +"FEerror" +"funcall" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"eval" +"stack_cons" +"FEerror" +"funcall" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"eval" +"stack_cons" +"FEerror" +"funcall" +"eval" +"use_fast_links" +"check_arg_failed" +"enter_mark_origin" +) + +;;/* for file backq.X */ + +( "backq.X" +"FEerror" +"backq_car" +"stack_cons" +"stack_cons" +"stack_cons" +"error" +"stack_cons" +"error" +"stack_cons" +"stack_cons" +"stack_cons" +"stack_cons" +"stack_cons" +"error" +"stack_cons" +"error" +"error" +"FEerror" +"check_arg_failed" +"FEerror" +"stack_cons" +"check_arg_failed" +"enter_mark_origin" +) + +;;/* for file bcmp.X */ + +( "bcmp.X" +) + +;;/* for file bcopy.X */ + +( "bcopy.X" +) + +;;/* for file bds.X */ + +( "bds.X" +) + +;;/* for file big.X */ + +( "big.X" +"cmpii" +"FEerror" +"FEerror" +"FEerror" +"FEwrong_type_argument" +) + +;;/* for file bind.X */ + +( "bind.X" +"bds_overflow" +"FEerror" +"endp1" +"not_a_symbol" +"illegal_lambda" +"endp1" +"not_a_symbol" +"not_a_variable" +"illegal_lambda" +"not_a_symbol" +"illegal_lambda" +"not_a_variable" +"endp1" +"illegal_lambda" +"not_a_symbol" +"not_a_variable" +"keywordp" +"illegal_declare" +"check_arg_failed" +"FEtoo_few_arguments" +"check_arg_failed" +"FEtoo_many_arguments" +"bind_var" +"eval" +"keywordp" +"eval" +"eval" +"illegal_declare" +"check_arg_failed" +"FEerror" +"FEerror" +"endp1" +"illegal_declare" +"not_a_symbol" +"bds_overflow" +"eval" +"bds_overflow" +"eval" +"FEerror" +"keywordp" +"keywordp" +"stack_cons" +"endp1" +"keywordp" +"FEerror" +"bzero" +"FEerror" +"FEerror" +"FEerror" +"enter_mark_origin" +) + +;;/* for file bitop.X */ + +( "bitop.X" +"error" +"error" +"error" +) + +;;/* for file block.X */ + +( "block.X" +"endp1" +"FEtoo_few_argumentsF" +"lex_block_bind" +"frs_overflow" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"FEerror" +"eval" +"unwind" +"endp1" +"FEtoo_many_argumentsF" +"FEerror" +"eval" +"unwind" +"enter_mark_origin" +) + +;;/* for file bzero.X */ + +( "bzero.X" +) + +;;/* for file catch.X */ + +( "catch.X" +"endp1" +"FEtoo_few_argumentsF" +"eval" +"frs_overflow" +"Fprogn" +"check_arg_failed" +"frs_overflow" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"frs_overflow" +"Fprogn" +"unwind" +"eval" +"Fprogn" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"FEerror" +"unwind" +) + +;;/* for file cfun.X */ + +( "cfun.X" +"FEerror" +"FEerror" +"check_type" +"error" +"error" +"error" +"not_a_symbol" +"check_type" +"error" +"not_a_symbol" +"check_type" +"error" +"set_key_struct" +"not_a_symbol" +"FEerror" +"not_a_symbol" +"check_arg_failed" +"FEerror" +"endp1" +"check_arg_failed" +) + +;;/* for file character.X */ + +( "character.X" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_non_negative_integer" +"check_arg_failed" +"check_type_character" +"too_few_arguments" +"check_type_character" +"too_few_arguments" +"check_type_character" +"too_few_arguments" +"check_type_character" +"too_few_arguments" +"check_type_character" +"too_few_arguments" +"check_type_character" +"too_few_arguments" +"check_type_character" +"check_arg_failed" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"too_few_arguments" +"too_many_arguments" +"check_type_non_negative_integer" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_non_negative_integer" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_character" +"too_few_arguments" +"too_many_arguments" +"check_type_non_negative_integer" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"check_type_non_negative_integer" +"check_arg_failed" +"check_type_character" +"check_arg_failed" +"string_equal" +"check_arg_failed" +"check_type_character" +"FEerror" +"check_arg_failed" +"check_type_character" +"FEerror" +"enter_mark_origin" +) + +;;/* for file cmpaux.X */ + +( "cmpaux.X" +"check_arg_failed" +"FEerror" +"FEerror" +"set_VV" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"FEwrong_type_argument" +"bcopy" +"check_type" +"check_type" +"eval" +"printf" +"fflush" +"printf" +"fflush" +"load" +) + +;;/* for file conditional.X */ + +( "conditional.X" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"endp1" +"FEerror" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"eval" +"FEerror" +"eql" +"eql" +"endp1" +"FEtoo_few_argumentsF" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"eval" +"enter_mark_origin" +) + +;;/* for file earith.X */ + +( "earith.X" +"divul3" +"integer_quotient_remainder_1" +"number_compare" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +) + +;;/* for file error.X */ + +( "error.X" +"super_funcall" +"keywordp" +"not_a_keyword" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"unwind" +"_flsbuf" +"printf" +"endp1" +"endp1" +"fcalln_general" +"super_funcall" +"enter_mark_origin" +) + +;;/* for file eval.X */ + +( "eval.X" +"check_arg_failed" +"FEerror" +"FEtoo_few_arguments" +"FEtoo_many_arguments" +"FEerror" +"ihs_overflow" +"FEwrong_type_argument" +"FEundefined_function" +"FEinvalid_function" +"ihs_overflow" +"lambda_bind" +"frs_overflow" +"FEwrong_type_argument" +"eval" +"bds_unwind" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"ihs_overflow" +"FEwrong_type_argument" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"ihs_overflow" +"FEwrong_type_argument" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"ihs_overflow" +"FEwrong_type_argument" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"ihs_overflow" +"FEwrong_type_argument" +"FEerror" +"FEwrong_type_argument" +"FEinvalid_function" +"FEundefined_function" +"FEinvalid_function" +"FEundefined_function" +"vs_overflow" +"stack_cons" +"bds_unwind" +"FEunbound_variable" +"FEwrong_type_argument" +"ihs_overflow" +"FEundefined_function" +"macro_expand1" +"ihs_overflow" +"FEwrong_type_argument" +"call_applyhook" +"FEinvalid_function" +"stack_cons" +"too_few_arguments" +"too_few_arguments" +"FEwrong_type_argument" +"check_arg_failed" +"too_few_arguments" +"too_many_arguments" +"bds_unwind" +"too_few_arguments" +"too_many_arguments" +"FEwrong_type_argument" +"bds_unwind" +"check_arg_failed" +"frs_overflow" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"FEerror" +"FEerror" +"enter_mark_origin" +) + +;;/* for file fat_string.X */ + +( "fat_string.X" +"error" +"printf" +"printf" +"printf" +"_flsbuf" +"printf" +"_flsbuf" +"fflush" +"_filbuf" +"printf" +"fflush" +"fread" +"printf" +"_flsbuf" +"fflush" +"fwrite" +"printf" +"_flsbuf" +"_filbuf" +"printf" +"sethash" +"fputc" +"printf" +"fputc" +"printf" +"printf" +"_flsbuf" +"printf" +"_flsbuf" +"FEerror" +"FEerror" +"write_fasd" +"frs_overflow" +"_filbuf" +"FEerror" +"unwind" +"check_type" +"check_type" +"check_type" +"array_allocself" +"file_position" +"fputc" +"printf" +"_flsbuf" +"write_fasd" +"_filbuf" +"FEerror" +"check_type" +"gset" +"clrhash" +"fputc" +"file_position" +"file_position_set" +"printf" +"_flsbuf" +"fputc" +"fputc" +"fputc" +"fputc" +"fputc" +"fputc" +"fputc" +"fputc" +"fputc" +"fputc" +"fputc" +"printf" +"_flsbuf" +"fputc" +"fputc" +"printf" +"_flsbuf" +"fputc" +"fputc" +"printf" +"_flsbuf" +"fputc" +"printf" +"_flsbuf" +"printf" +"_flsbuf" +"printf" +"_flsbuf" +"FEerror" +"printf" +"_flsbuf" +"printf" +"_flsbuf" +"printf" +"_flsbuf" +"FEerror" +"sethash" +"find_sharing" +"Leval" +"bcopy" +"FEerror" +"_filbuf" +"printf" +"printf" +"printf" +"printf" +"pp" +"printf" +"FEerror" +"printf" +"printf" +"printf" +"printf" +"printf" +"printf" +"printf" +"printf" +"siLmake_structure" +"printf" +"printf" +"printf" +"array_allocself" +"printf" +"printf" +"printf" +"printf" +"array_allocself" +"printf" +"princ_str" +"princ_str" +"_filbuf" +"FEerror" +"ungetc" +"readc_stream" +"unreadc_stream" +"unreadc_stream" +"gset" +"close_stream" +"FEerror" +"gset" +"FEerror" +"profil" +"check_arg_failed" +"FEerror" +"perror" +"fread" +"FEerror" +"perror" +"_filbuf" +"fclose" +"check_arg_failed" +"check_type_string" +"strncpy" +"qsort" +"free" +"FEerror" +"FEerror" +"qsort" +"FEerror" +"check_arg_failed" +"printf" +"fflush" +"printf" +"fflush" +"check_arg_failed" +"enter_mark_origin" +) + +;;/* for file file.X */ + +( "file.X" +"error" +"FEerror" +"FEwrong_type_argument" +"error" +"FEwrong_type_argument" +"error" +"FEwrong_type_argument" +"endp1" +"error" +"perm_writable" +"setbuf" +"insert_contblock" +"printf" +"too_long_file_name" +"cannot_open" +"cannot_create" +"fclose" +"FEerror" +"fclose" +"FEerror" +"cannot_create" +"cannot_create" +"cannot_open" +"FEerror" +"cannot_create" +"error" +"FEerror" +"fflush" +"fclose" +"FEwrong_type_argument" +"endp1" +"error" +"closed_stream" +"_filbuf" +"FEwrong_type_argument" +"endp1" +"stream_at_end" +"flush_stream" +"writec_stream" +"cannot_read" +"super_funcall" +"error" +"closed_stream" +"ungetc" +"FEwrong_type_argument" +"endp1" +"super_funcall" +"error" +"FEerror" +"closed_stream" +"_flsbuf" +"FEwrong_type_argument" +"endp1" +"FEerror" +"adjust_displaced" +"cannot_write" +"super_funcall" +"error" +"closed_stream" +"fflush" +"FEwrong_type_argument" +"endp1" +"FEerror" +"super_funcall" +"error" +"closed_stream" +"_filbuf" +"ungetc" +"FEwrong_type_argument" +"endp1" +"error" +"closed_stream" +"ioctl" +"FEwrong_type_argument" +"endp1" +"FEerror" +"error" +"closed_stream" +"FEwrong_type_argument" +"error" +"closed_stream" +"fseek" +"FEwrong_type_argument" +"error" +"closed_stream" +"file_len" +"FEwrong_type_argument" +"error" +"FEwrong_type_argument" +"endp1" +"error" +"check_arg_failed" +"check_type_symbol" +"cannot_write" +"stack_cons" +"cannot_read" +"stack_cons" +"check_arg_failed" +"cannot_read" +"cannot_write" +"check_arg_failed" +"cannot_read" +"cannot_write" +"too_few_arguments" +"too_many_arguments" +"check_type_string" +"FEerror" +"check_arg_failed" +"check_arg_failed" +"FEerror" +"check_arg_failed" +"FEerror" +"check_arg_failed" +"check_arg_failed" +"check_type_stream" +"check_arg_failed" +"check_type_stream" +"check_arg_failed" +"check_type_stream" +"too_few_arguments" +"parse_key" +"check_type_stream" +"too_few_arguments" +"parse_key" +"check_type_or_pathname_string_symbol_stream" +"FEerror" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"FEerror" +"check_arg_failed" +"check_type_stream" +"too_few_arguments" +"parse_key" +"check_type_or_pathname_string_symbol_stream" +"string_eq" +"file_exists" +"setupPRINTdefault" +"write_str" +"write_object" +"cleanupPRINT" +"fasload" +"setupPRINTdefault" +"write_str" +"cleanupPRINT" +"bds_unwind" +"setupPRINTdefault" +"write_str" +"write_object" +"cleanupPRINT" +"setupPRINTdefault" +"write_str" +"write_object" +"cleanupPRINT" +"frs_overflow" +"bds_unwind" +"unwind" +"eval" +"setupPRINTdefault" +"write_object" +"write_str" +"cleanupPRINT" +"bds_unwind" +"setupPRINTdefault" +"write_str" +"write_object" +"cleanupPRINT" +"check_arg_failed" +"check_type_stream" +"FEerror" +"check_arg_failed" +"FEerror" +"check_arg_failed" +"check_type_stream" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"check_arg_failed" +"FEerror" +"FEerror" +"FEwrong_type_argument" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"fwrite" +"check_arg_failed" +"fread" +"enter_mark_origin" +"enter_mark_origin" +"fread" +"fseek" +) + +;;/* for file format.X */ + +( "format.X" +"fmt_error" +"fmt_error" +"writec_stream" +"fmt_error" +"fmt_ascii" +"fmt_S_expression" +"fmt_decimal" +"fmt_binary" +"fmt_octal" +"fmt_hexadecimal" +"fmt_radix" +"fmt_plural" +"fmt_character" +"fmt_fix_float" +"fmt_exponential_float" +"fmt_general_float" +"fmt_dollars_float" +"fmt_percent" +"fmt_ampersand" +"fmt_bar" +"fmt_tilde" +"fmt_newline" +"fmt_tabulate" +"fmt_asterisk" +"fmt_indirection" +"fmt_case" +"fmt_conditional" +"fmt_iteration" +"fmt_justification" +"fmt_up_and_out" +"fmt_semicolon" +"funcall" +"fmt_error" +"fmt_error" +"fmt_error" +"fmt_error" +"fmt_error" +"fmt_error" +"file_column" +"writestr_stream" +"write_string" +"writec_stream" +"writec_stream" +"write_string" +"file_column" +"writestr_stream" +"write_string" +"writec_stream" +"writec_stream" +"write_string" +"fmt_integer" +"fmt_integer" +"fmt_integer" +"fmt_integer" +"check_type_integer" +"fmt_integer" +"fmt_roman" +"file_column" +"write_object" +"writestr_stream" +"writestr_stream" +"fmt_nonillion" +"writestr_stream" +"check_type_integer" +"FEerror" +"fmt_integer" +"file_column" +"setupPRINTdefault" +"write_object" +"cleanupPRINT" +"writec_stream" +"file_column" +"write_object" +"writec_stream" +"fmt_thousand" +"writec_stream" +"writestr_stream" +"fmt_thousand" +"writec_stream" +"fmt_write_numeral" +"writestr_stream" +"writec_stream" +"fmt_write_ordinal" +"fmt_write_numeral" +"fmt_write_ordinal" +"fmt_write_numeral" +"writec_stream" +"fmt_write_ordinal" +"fmt_write_numeral" +"writestr_stream" +"writestr_stream" +"writec_stream" +"fmt_error" +"eql" +"writec_stream" +"writestr_stream" +"check_type_character" +"writec_stream" +"fmt_error" +"edit_double" +"writec_stream" +"writec_stream" +"writestr_stream" +"writec_stream" +"fmt_exponent1" +"writec_stream" +"fmt_error" +"edit_double" +"writec_stream" +"writec_stream" +"writestr_stream" +"fmt_error" +"edit_double" +"writec_stream" +"fmt_error" +"edit_double" +"writec_stream" +"writec_stream" +"writec_stream" +"writec_stream" +"file_column" +"writec_stream" +"writec_stream" +"writec_stream" +"writec_stream" +"file_column" +"writestr_stream" +"writec_stream" +"writec_stream" +"file_column" +"fmt_error" +"fmt_error" +"fmt_error" +"endp1" +"vs_overflow" +"fmt_error" +"writec_stream" +"writec_stream" +"writec_stream" +"writec_stream" +"fmt_error" +"fmt_error" +"fmt_error" +"fmt_error" +"fmt_error" +"fmt_error" +"fmt_error" +"endp1" +"vs_overflow" +"endp1" +"vs_overflow" +"endp1" +"vs_overflow" +"fmt_error" +"file_column" +"writec_stream" +"writec_stream" +"fmt_error" +"too_few_arguments" +"FEerror" +"check_type_stream" +"check_type_string" +"frs_overflow" +"file_column" +"fmt_error" +"flush_stream" +"unwind" +"FEerror" +"enter_mark_origin" +) + +;;/* for file frame.X */ + +( "frame.X" +"bds_unwind" +) + +;;/* for file funlink.X */ + +( "funlink.X" +"FEinvalid_function" +"ihs_overflow" +"funcall" +"vpush_extend" +"FEinvalid_function" +"vpush_extend" +"ihs_overflow" +"ihs_overflow" +"funcall" +"vpush_extend" +"use_fast_links" +"clean_link_array" +"check_type_array" +"not_a_symbol" +"FEerror" +"FEerror" +"check_type_symbol" +"FEerror" +"FEinvalid_function" +"vs_overflow" +"funcall" +"vs_overflow" +"super_funcall" +"vs_overflow" +"super_funcall" +"FEerror" +"FEerror" +"array_allocself" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +) + +;;/* for file gbc.X */ + +( "gbc.X" +"error" +"error" +"mark_object" +"mark_contblock" +"mark_contblock" +"adjust_displaced" +"printf" +"adjust_displaced" +"fclose" +"error" +"printf" +"error" +"fprintf" +"fflush" +"clear_stack" +"printf" +"fflush" +"printf" +"fflush" +"mark_c_stack" +"printf" +"_flsbuf" +"fflush" +"insert_contblock" +"printf" +"fflush" +"error" +"sgc_quit" +"printf" +"sgc_count_type" +"sgc_count_writable" +"fflush" +"printf" +"fflush" +"sgc_quit" +"fprintf" +"fflush" +"sgc_mark_phase" +"printf" +"fflush" +"printf" +"fflush" +"sgc_sweep_phase" +"printf" +"fflush" +"printf" +"fflush" +"sgc_contblock_sweep_phase" +"printf" +"printf" +"printf" +"printf" +"fflush" +"sgc_start" +"fprintf" +"fflush" +"sigint" +"check_arg_failed" +"vs_overflow" +"check_arg_failed" +"check_arg_failed" +"sgc_mark_object1" +"sgc_mark_object1" +"adjust_displaced" +"printf" +"adjust_displaced" +"fclose" +"error" +"printf" +"error" +"fprintf" +"fflush" +"clear_stack" +"printf" +"fflush" +"printf" +"fflush" +"printf" +"_flsbuf" +"fflush" +"insert_contblock" +"printf" +"fflush" +"bzero" +"printf" +"fflush" +"add_page_to_freelist" +"printf" +"fflush" +"printf" +"fflush" +"sgc_mprotect" +"mprotect" +"mprotect" +"FEerror" +"check_arg_failed" +"FEerror" +"perror" +) + +;;/* for file hash.X */ + +( "hash.X" +"bzero" +"eql" +"equal" +"extend_hashtable" +"too_few_arguments" +"parse_key" +"FEerror" +"check_arg_failed" +"too_few_arguments" +"too_many_arguments" +"check_type_hash_table" +"check_arg_failed" +"check_type_hash_table" +"check_arg_failed" +"check_type_hash_table" +"check_arg_failed" +"check_type_hash_table" +"check_arg_failed" +"check_type_hash_table" +"check_arg_failed" +"check_arg_failed" +"check_type_hash_table" +) + +;;/* for file init_pari.X */ + +( "init_pari.X" +"FEerror" +"free" +"set_pari_stack" +"malloc" +) + +;;/* for file iteration.X */ + +( "iteration.X" +"lex_block_bind" +"frs_overflow" +"endp1" +"eval" +"eval" +"endp1" +"FEinvalid_form" +"not_a_variable" +"FEerror" +"endp1" +"FEtoo_few_argumentsF" +"FEinvalid_form" +"lex_block_bind" +"frs_overflow" +"eval" +"Ftagbody" +"bds_unwind" +"endp1" +"FEtoo_few_argumentsF" +"FEinvalid_form" +"lex_block_bind" +"frs_overflow" +"eval" +"Ftagbody" +"bds_unwind" +"endp1" +"FEtoo_few_argumentsF" +"FEerror" +"lex_block_bind" +"frs_overflow" +"eval" +"bind_var" +"eval" +"Ftagbody" +"bds_unwind" +"endp1" +"FEtoo_few_argumentsF" +"FEerror" +"lex_block_bind" +"frs_overflow" +"eval" +"FEwrong_type_argument" +"bind_var" +"number_compare" +"eval" +"Ftagbody" +"bds_unwind" +) + +;;/* for file let.X */ + +( "let.X" +"endp1" +"not_a_variable" +"not_a_variable" +"FEerror" +"endp1" +"FEerror" +"Fprogn" +"bds_unwind" +"endp1" +"FEerror" +"Fprogn" +"bds_unwind" +"endp1" +"FEerror" +"eval" +"not_a_variable" +"bind_var" +"Fprogn" +"bds_unwind" +"endp1" +"FEerror" +"eval" +"bind_var" +"Fprogn" +"bds_unwind" +"endp1" +"FEtoo_few_argumentsF" +"FEerror" +"lex_fun_bind" +"Fprogn" +"endp1" +"FEtoo_few_argumentsF" +"FEerror" +"lex_fun_bind" +"Fprogn" +"endp1" +"FEtoo_few_argumentsF" +"FEerror" +"lex_macro_bind" +"Fprogn" +) + +;;/* for file lex.X */ + +( "lex.X" +"endp1" +"endp1" +"eql" +"endp1" +"enter_mark_origin" +) + +;;/* for file list.X */ + +( "list.X" +"eql" +"FEerror" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"vs_overflow" +"vs_overflow" +"FEwrong_type_argument" +"vs_overflow" +"vs_overflow" +"FEwrong_type_argument" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"too_few_arguments" +"parse_key" +"frs_overflow" +"unwind" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +"fixint" +"FEerror" +"FEwrong_type_argument" +"check_arg_failed" +"fixint" +"FEerror" +"FEwrong_type_argument" +"check_arg_failed" +"FEwrong_type_argument" +"too_few_arguments" +"too_few_arguments" +"parse_key" +"check_type_non_negative_integer" +"FEerror" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"check_arg_failed" +"FEwrong_type_argument" +"too_few_arguments" +"too_many_arguments" +"check_type_non_negative_integer" +"FEwrong_type_argument" +"vs_overflow" +"too_few_arguments" +"too_many_arguments" +"check_type_non_negative_integer" +"FEwrong_type_argument" +"check_arg_failed" +"FEwrong_type_argument" +"vs_overflow" +"check_arg_failed" +"check_type_cons" +"check_arg_failed" +"check_type_cons" +"too_few_arguments" +"parse_key" +"frs_overflow" +"unwind" +"too_few_arguments" +"too_few_arguments" +"too_few_arguments" +"parse_key" +"frs_overflow" +"unwind" +"too_few_arguments" +"too_few_arguments" +"FEwrong_type_argument" +"FEerror" +"too_few_arguments" +"parse_key" +"frs_overflow" +"unwind" +"too_few_arguments" +"parse_key" +"frs_overflow" +"unwind" +"too_few_arguments" +"parse_key" +"frs_overflow" +"FEwrong_type_argument" +"unwind" +"too_few_arguments" +"too_few_arguments" +"too_few_arguments" +"parse_key" +"frs_overflow" +"FEwrong_type_argument" +"unwind" +"check_arg_failed" +"FEwrong_type_argument" +"too_few_arguments" +"check_arg_failed" +"too_few_arguments" +"too_many_arguments" +"FEwrong_type_argument" +"FEerror" +"vs_overflow" +"FEerror" +"too_few_arguments" +"parse_key" +"frs_overflow" +"FEwrong_type_argument" +"unwind" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +) + +;;/* for file macros.X */ + +( "macros.X" +"check_arg_failed" +"not_a_symbol" +"FEerror" +"endp1" +"FEtoo_few_argumentsF" +"not_a_symbol" +"FEerror" +"super_funcall" +"too_few_arguments" +"too_many_arguments" +"too_few_arguments" +"too_many_arguments" +"super_funcall" +"enter_mark_origin" +) + +;;/* for file main.X */ + +( "main.X" +"setbuf" +"error" +"clear_stack" +"getrlimit" +"set_maxpage" +"bzero" +"sigstack" +"init_interrupt" +"super_funcall" +"multiply_stacks" +"printf" +"fflush" +"initlisp" +"init_init" +"init_interrupt" +"super_funcall" +"sigvec" +"init_alloc" +"init_symbol" +"init_package" +"import" +"export" +"enter_mark_origin" +"NewInit" +"init_typespec" +"init_pari" +"init_number" +"init_character" +"init_file" +"init_read" +"init_bind" +"init_pathname" +"init_print" +"init_GBC" +"init_unixfasl" +"init_unixsys" +"init_unixsave" +"init_alloc_function" +"init_array_function" +"init_character_function" +"init_file_function" +"init_list_function" +"init_package_function" +"init_pathname_function" +"init_predicate_function" +"init_print_function" +"init_read_function" +"init_sequence_function" +"init_socket_function" +"init_structure_function" +"init_string_function" +"init_symbol_function" +"init_typespec_function" +"init_hash" +"init_cfun" +"init_unixfsys" +"init_unixtime" +"init_eval" +"init_lex" +"init_prog" +"init_catch" +"init_block" +"init_macros" +"init_conditional" +"init_reference" +"init_assignment" +"init_multival" +"init_error" +"init_let" +"init_mapfun" +"init_iteration" +"init_toplevel" +"init_cmpaux" +"init_main" +"init_format" +"init_links" +"init_fat_string" +"init_cmac" +"init_interrupt1" +"error" +"FEerror" +"error" +"FEerror" +"error" +"FEerror" +"error" +"FEerror" +"error" +"error" +"FEerror" +"error" +"sgc_quit" +"FEerror" +"printf" +"fflush" +"FEerror" +"too_many_arguments" +"printf" +"check_arg_failed" +"check_arg_failed" +"FEerror" +"check_arg_failed" +"check_type_string" +"FEerror" +"check_arg_failed" +"check_arg_failed" +"FEerror" +"check_arg_failed" +"enter_mark_origin" +"array_allocself" +"bcopy" +"bcopy" +"bcopy" +"bcopy" +"check_arg_failed" +"init_system" +"check_arg_failed" +"check_arg_failed" +"fixint" +"check_arg_failed" +"printf" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"getdomainname" +"yp_unbind" +"GBC" +"brk" +"Lsave" +"enter_mark_origin" +) + +;;/* for file mapfun.X */ + +( "mapfun.X" +"too_few_arguments" +"endp1" +"super_funcall" +"endp1" +"too_few_arguments" +"endp1" +"super_funcall" +"endp1" +"too_few_arguments" +"endp1" +"super_funcall" +"endp1" +"too_few_arguments" +"endp1" +"super_funcall" +"endp1" +"too_few_arguments" +"endp1" +"super_funcall" +"endp1" +"too_few_arguments" +"endp1" +"super_funcall" +"endp1" +) + +;;/* for file multival.X */ + +( "multival.X" +"check_arg_failed" +"endp1" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"eval" +"super_funcall" +"endp1" +"FEtoo_few_argumentsF" +"eval" +) + +;;/* for file nfunlink.X */ + +( "nfunlink.X" +"FEerror" +"FEinvalid_function" +"vpush_extend" +"FEerror" +"vs_overflow" +"ihs_punsh_base" +"ihs_overflow" +"funcall" +"FEerror" +) + +;;/* for file num_arith.X */ + +( "num_arith.X" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"number_zerop" +"zero_divisor" +"number_minusp" +"FEwrong_type_argument" +"number_zerop" +"zero_divisor" +"FEwrong_type_argument" +"zero_divisor" +"number_zerop" +"FEwrong_type_argument" +"number_minusp" +"number_compare" +"check_type_number" +"too_few_arguments" +"check_type_number" +"check_type_number" +"too_few_arguments" +"check_type_number" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_number" +"check_type_integer" +"number_minusp" +"too_few_arguments" +"check_type_integer" +"number_minusp" +"number_minusp" +"FEerror" +) + +;;/* for file num_co.X */ + +( "num_co.X" +"too_few_arguments" +"too_many_arguments" +"check_type_float" +"FEwrong_type_argument" +"check_arg_failed" +"check_type_rational" +"check_arg_failed" +"check_type_rational" +"too_few_arguments" +"FEwrong_type_argument" +"too_many_arguments" +"number_zerop" +"integer_quotient_remainder_1" +"number_minusp" +"number_plusp" +"check_type_or_rational_float" +"number_minusp" +"number_compare" +"too_few_arguments" +"FEwrong_type_argument" +"too_many_arguments" +"number_zerop" +"integer_quotient_remainder_1" +"number_plusp" +"number_minusp" +"check_type_or_rational_float" +"number_plusp" +"number_compare" +"too_few_arguments" +"FEwrong_type_argument" +"too_many_arguments" +"integer_quotient_remainder_1" +"check_type_or_rational_float" +"too_few_arguments" +"number_oddp" +"FEwrong_type_argument" +"too_many_arguments" +"check_type_or_rational_float" +"number_compare" +"number_oddp" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_type_float" +"check_arg_failed" +"check_type_float" +"FEerror" +"check_arg_failed" +"check_type_float" +"too_few_arguments" +"too_many_arguments" +"check_type_float" +"check_arg_failed" +"check_type_float" +"check_arg_failed" +"check_type_float" +"check_arg_failed" +"check_type_float" +"too_few_arguments" +"too_many_arguments" +"check_type_or_rational_float" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_number" +"enter_mark_origin" +) + +;;/* for file num_comp.X */ + +( "num_comp.X" +"cmpii" +"number_zerop" +"FEwrong_type_argument" +"too_few_arguments" +"check_type_number" +"too_few_arguments" +"check_type_number" +"too_few_arguments" +"check_type_or_rational_float" +"too_few_arguments" +"check_type_or_rational_float" +"too_few_arguments" +"check_type_or_rational_float" +) + +;;/* for file num_log.X */ + +( "num_log.X" +"too_few_arguments" +"gcopy_to_big" +"FEwrong_type_argument" +"FEwrong_type_argument" +"check_type_integer" +"check_type_integer" +"check_type_integer" +"check_type_integer" +"check_arg_failed" +"check_type_integer" +"fixint" +"FEerror" +"check_arg_failed" +"check_type_integer" +"check_arg_failed" +"check_type_integer" +"FEerror" +"check_arg_failed" +"check_type_integer" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +"siLmake_vector" +"siLmake_pure_array" +"fixint" +"FEerror" +"FEerror" +) + +;;/* for file num_pred.X */ + +( "num_pred.X" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEwrong_type_argument" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_or_rational_float" +"check_arg_failed" +"check_type_or_rational_float" +"check_arg_failed" +"check_type_integer" +"check_arg_failed" +"check_type_integer" +"enter_mark_origin" +) + +;;/* for file num_rand.X */ + +( "num_rand.X" +"number_compare" +"FEwrong_type_argument" +"FEerror" +"time" +"FEwrong_type_argument" +"check_arg_failed" +"check_type_random_state" +"check_arg_failed" +"check_arg_failed" +) + +;;/* for file num_sfun.X */ + +( "num_sfun.X" +"FEwrong_type_argument" +"FEwrong_type_argument" +"number_zerop" +"number_plusp" +"FEerror" +"number_minusp" +"number_plusp" +"number_evenp" +"number_zerop" +"FEerror" +"number_minusp" +"FEwrong_type_argument" +"number_zerop" +"FEerror" +"number_minusp" +"FEwrong_type_argument" +"FEerror" +"FEwrong_type_argument" +"FEwrong_type_argument" +"number_zerop" +"FEerror" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_number" +"too_few_arguments" +"check_type_number" +"check_type_number" +"too_many_arguments" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_number" +"check_arg_failed" +"check_type_number" +"too_few_arguments" +"check_type_number" +"check_type_or_rational_float" +"too_many_arguments" +"enter_mark_origin" +) + +;;/* for file number.X */ + +( "number.X" +"FEerror" +"FEerror" +"number_zerop" +"FEerror" +"number_minusp" +"enter_mark_origin" +"init_num_pred" +"init_num_comp" +"init_num_arith" +"init_num_co" +"init_num_log" +"init_num_sfun" +"init_num_rand" +) + +;;/* for file package.X */ + +( "package.X" +"string_equal" +"pack_hash" +"package_already" +"endp1" +"no_package" +"endp1" +"package_already" +"use_package" +"equal" +"package_already" +"endp1" +"FEwrong_type_argument" +"string_equal" +"no_package" +"FEerror" +"bcmp" +"bcmp" +"member_eq" +"member_eq" +"FEerror" +"delete_eq" +"import" +"FEerror" +"member_eq" +"delete_eq" +"FEerror" +"delete_eq" +"FEerror" +"member_eq" +"member_eq" +"delete_eq" +"no_package" +"FEerror" +"member_eq" +"no_package" +"delete_eq" +"too_few_arguments" +"parse_key" +"check_type_or_string_symbol" +"too_few_arguments" +"parse_key" +"check_type_or_string_symbol" +"check_arg_failed" +"check_arg_failed" +"check_type_package" +"check_arg_failed" +"too_few_arguments" +"too_many_arguments" +"check_type_or_string_symbol" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"stack_cons" +"too_few_arguments" +"too_many_arguments" +"check_type_string" +"too_few_arguments" +"too_many_arguments" +"check_type_string" +"too_few_arguments" +"too_many_arguments" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"endp1" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"endp1" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"endp1" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"endp1" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"endp1" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"endp1" +"check_type_package" +"too_few_arguments" +"too_many_arguments" +"endp1" +"check_type_package" +"check_arg_failed" +"check_type_package" +"FEerror" +"check_arg_failed" +"check_type_package" +"FEerror" +"FEerror" +"FEerror" +"check_type_package" +"check_arg_failed" +"enter_mark_origin" +) + +;;/* for file pathname.X */ + +( "pathname.X" +"stack_cons" +"FEerror" +"endp1" +"FEerror" +"FEerror" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"too_few_arguments" +"parse_key" +"check_type_or_pathname_string_symbol_stream" +"get_string_start_end" +"FEerror" +"FEerror" +"FEerror" +"too_few_arguments" +"too_many_arguments" +"check_type_or_pathname_string_symbol_stream" +"too_few_arguments" +"parse_key" +"check_arg_failed" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_or_pathname_string_symbol_stream" +"equalp" +) + +;;/* for file predicate.X */ + +( "predicate.X" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"big_compare" +"check_arg_failed" +"string_eq" +"check_arg_failed" +"number_compare" +"char_equal" +"check_arg_failed" +"endp1" +"eval" +"eval" +"endp1" +"eval" +"eval" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +) + +;;/* for file print.X */ + +( "print.X" +"flush_queue" +"FEerror" +"file_column" +"writec_stream" +"writec_stream" +"file_column" +"FEerror" +"writec_stream" +"writec_stream" +"write_decimal1" +"FEerror" +"alarm" +"terminal_interrupt" +"frs_overflow" +"bds_unwind" +"unwind" +"digit_weight" +"big_zerop" +"vs_overflow" +"digit_weight" +"div_int_big" +"error" +"FEerror" +"potential_number_p" +"fixint" +"error" +"FEwrong_type_argument" +"error" +"vs_overflow" +"FEwrong_type_argument" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"flush_stream" +"FEwrong_type_argument" +"writec_stream" +"digitp" +"too_few_arguments" +"parse_key" +"FEerror" +"flush_stream" +"too_few_arguments" +"too_many_arguments" +"too_few_arguments" +"too_many_arguments" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"writec_stream" +"flush_stream" +"too_few_arguments" +"too_many_arguments" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_stream" +"writec_stream" +"too_few_arguments" +"parse_key" +"get_string_start_end" +"check_type_string" +"check_type_stream" +"writec_stream" +"flush_stream" +"too_few_arguments" +"parse_key" +"get_string_start_end" +"check_type_string" +"check_type_stream" +"writec_stream" +"flush_stream" +"too_few_arguments" +"too_many_arguments" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"file_column" +"writec_stream" +"flush_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"flush_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"flush_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"check_arg_failed" +"FEerror" +"check_type_stream" +"writec_stream" +"error" +"enter_mark_origin" +"FEerror" +"FEerror" +"flush_stream" +"FEerror" +"writec_stream" +"flush_stream" +"check_type_string" +"check_type_stream" +"writec_stream" +"flush_stream" +"check_type_stream" +"writestr_stream" +"check_type_stream" +"writec_stream" +"flush_stream" +"writec_stream" +"flush_stream" +) + +;;/* for file prog.X */ + +( "prog.X" +"endp1" +"lex_tag_bind" +"frs_overflow" +"eql" +"FEerror" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"lex_block_bind" +"frs_overflow" +"let_var_list" +"bds_unwind" +"endp1" +"FEtoo_few_argumentsF" +"lex_block_bind" +"frs_overflow" +"let_var_list" +"bds_unwind" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"FEerror" +"unwind" +"endp1" +"FEtoo_few_argumentsF" +"eval" +"not_a_symbol" +"FEerror" +"Fprogn" +"bds_unwind" +"endp1" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"eval" +"endp1" +"FEtoo_few_argumentsF" +"eval" +) + +;;/* for file read.X */ + +( "read.X" +"FEerror" +"FEerror" +"readc_stream" +"FEwrong_type_argument" +"unreadc_stream" +"readc_stream" +"readc_stream" +"frs_overflow" +"FEerror" +"FEerror" +"unwind" +"frs_overflow" +"unwind" +"frs_overflow" +"unwind" +"vs_overflow" +"_filbuf" +"end_of_stream" +"stream_at_end" +"end_of_stream" +"readc_stream" +"super_funcall" +"FEerror" +"too_long_token" +"_filbuf" +"stream_at_end" +"readc_stream" +"readc_stream" +"stream_at_end" +"end_of_stream" +"readc_stream" +"FEerror" +"FEerror" +"FEerror" +"FEerror" +"check_arg_failed" +"FEerror" +"readc_stream" +"digitp" +"mul_int_big" +"add_int_big" +"FEerror" +"mul_int_big" +"add_int_big" +"digitp" +"mul_int_big" +"add_int_big" +"readc_stream" +"too_long_string" +"_filbuf" +"stream_at_end" +"readc_stream" +"check_arg_failed" +"check_arg_failed" +"FEerror" +"readc_stream" +"digitp" +"super_funcall" +"check_arg_failed" +"stack_cons" +"check_arg_failed" +"check_arg_failed" +"_filbuf" +"stream_at_end" +"readc_stream" +"check_arg_failed" +"extra_argument" +"readc_stream" +"FEerror" +"contains_sharp_comma" +"check_type_number" +"check_arg_failed" +"FEerror" +"string_equal" +"check_arg_failed" +"extra_argument" +"stack_cons" +"check_arg_failed" +"unreadc_stream" +"backq_car" +"FEerror" +"endp1" +"vs_overflow" +"stack_cons" +"vs_overflow" +"FEerror" +"check_arg_failed" +"stream_at_end" +"readc_stream" +"vs_overflow" +"FEerror" +"error" +"extra_argument" +"readc_stream" +"too_long_token" +"stream_at_end" +"end_of_stream" +"check_arg_failed" +"extra_argument" +"check_arg_failed" +"extra_argument" +"check_arg_failed" +"extra_argument" +"check_arg_failed" +"extra_argument" +"extra_argument" +"FEerror" +"extra_argument" +"FEerror" +"extra_argument" +"FEerror" +"check_arg_failed" +"FEerror" +"FEerror" +"check_arg_failed" +"FEerror" +"eql" +"check_arg_failed" +"FEerror" +"eql" +"check_arg_failed" +"extra_argument" +"readc_stream" +"FEerror" +"check_arg_failed" +"extra_argument" +"check_arg_failed" +"extra_argument" +"FEerror" +"FEerror" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"end_of_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"stream_at_end" +"readc_stream" +"end_of_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_stream" +"frs_overflow" +"unwind" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"stream_at_end" +"end_of_stream" +"_filbuf" +"readc_stream" +"too_long_string" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"stream_at_end" +"end_of_stream" +"readc_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"stream_at_end" +"end_of_stream" +"readc_stream" +"stream_at_end" +"readc_stream" +"end_of_stream" +"check_type_character" +"stream_at_end" +"readc_stream" +"char_eq" +"end_of_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"listen_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"listen_stream" +"readc_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"listen_stream" +"readc_stream" +"too_few_arguments" +"parse_key" +"check_type_string" +"get_string_start_end" +"FEerror" +"too_few_arguments" +"too_many_arguments" +"check_type_stream" +"stream_at_end" +"end_of_stream" +"readc_stream" +"stream_at_end" +"readc_stream" +"stream_at_end" +"readc_stream" +"too_few_arguments" +"too_many_arguments" +"check_type_readtable" +"check_type_readtable" +"check_arg_failed" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_readtable" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_readtable" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_readtable" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_readtable" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_readtable" +"FEerror" +"too_few_arguments" +"too_many_arguments" +"check_type_character" +"check_type_readtable" +"FEerror" +"digitp" +"check_arg_failed" +"check_type_string" +"check_arg_failed" +"FEerror" +"enter_mark_origin" +"init_backq" +"frs_overflow" +"readc_stream" +"vs_overflow" +"system_error" +"unwind" +) + +;;/* for file reference.X */ + +( "reference.X" +"check_arg_failed" +"not_a_symbol" +"FEinvalid_function" +"FEundefined_function" +"check_arg_failed" +"not_a_symbol" +"stack_cons" +"FEundefined_function" +"stack_cons" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"FEundefined_function" +"FEinvalid_function" +"check_arg_failed" +"not_a_symbol" +"FEunbound_variable" +"check_arg_failed" +"not_a_symbol" +"check_arg_failed" +"not_a_symbol" +"check_arg_failed" +"not_a_symbol" +) + +;;/* for file run_process.X */ + +( "run_process.X" +"malloc" +"FEerror" +"bzero" +"bcopy" +"socket" +"FEerror" +"connect" +"close" +"FEerror" +"getpid" +"ioctl" +"FEerror" +"FEerror" +"setup_stream_buffer" +"check_arg_failed" +"socketpair" +"FEerror" +"setup_stream_buffer" +"FEerror" +"fork" +"close" +"dup" +"fprintf" +"execvp" +"fflush" +"object_to_string" +) + +;;/* for file sequence.X */ + +( "sequence.X" +"check_arg_failed" +"fixint" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"FEerror" +"check_arg_failed" +"fixint" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"FEerror" +"too_few_arguments" +"too_many_arguments" +"fixnnint" +"FEwrong_type_argument" +"vs_overflow" +"stack_cons" +"array_allocself" +"FEerror" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +"check_arg_failed" +"FEwrong_type_argument" +"array_allocself" +"check_arg_failed" +"FEwrong_type_argument" +) + +;;/* for file sfasl.X */ + +( "sfasl.X" +"printf" +"fflush" +"printf" +"fflush" +"coerce_to_filename" +"fread" +"FEerror" +"fseek" +"_filbuf" +"ungetc" +"build_symbol_table" +"get_extra_bss" +"relocate_symbols" +"close_stream" +"free" +"call_init" +"printf" +"fwrite" +"fclose" +"set_symbol_address" +"fprintf" +"fflush" +"FEerror" +"printf" +"fflush" +"getpid" +"coerce_to_filename" +"system" +"FEerror" +"read_special_symbols" +"unlink" +"qsort" +) + +;;/* for file string.X */ + +( "string.X" +"FEerror" +"check_arg_failed" +"check_type_string" +"illegal_index" +"check_arg_failed" +"check_type_string" +"illegal_index" +"check_type_character" +"FEerror" +"too_few_arguments" +"parse_key" +"too_few_arguments" +"parse_key" +"too_few_arguments" +"parse_key" +"too_few_arguments" +"parse_key" +"too_few_arguments" +"parse_key" +"endp1" +"FEerror" +"Lstring_trim0" +"Lstring_trim0" +"Lstring_trim0" +"check_arg_failed" +"too_few_arguments" +"parse_key" +"too_few_arguments" +"parse_key" +"check_type_string" +"check_arg_failed" +) + +;;/* for file structure.X */ + +( "structure.X" +"FEerror" +"FEerror" +"FEwrong_type_argument" +"FEwrong_type_argument" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"check_arg_failed" +"endp1" +"stack_cons" +"too_few_arguments" +"FEerror" +"bzero" +"too_few_arguments" +"FEwrong_type_argument" +"bcopy" +"check_arg_failed" +"FEwrong_type_argument" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"FEerror" +"endp1" +"check_arg_failed" +"FEerror" +"endp1" +"check_arg_failed" +"check_arg_failed" +"FEwrong_type_argument" +"get_aelttype" +"get_aelttype" +) + +;;/* for file symbol.X */ + +( "symbol.X" +"pack_hash" +"string_eq" +"pack_hash" +"string_eq" +"error" +"pack_hash" +"string_eq" +"FEunbound_variable" +"FEerror" +"not_a_symbol" +"FEerror" +"not_a_symbol" +"not_a_symbol" +"endp1" +"odd_plist" +"not_a_symbol" +"too_few_arguments" +"too_many_arguments" +"check_type_symbol" +"check_arg_failed" +"check_type_symbol" +"check_arg_failed" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"check_arg_failed" +"endp1" +"odd_plist" +"FEerror" +"check_arg_failed" +"check_arg_failed" +"check_type_string" +"too_few_arguments" +"too_many_arguments" +"check_type_symbol" +"too_few_arguments" +"too_many_arguments" +"check_type_non_negative_integer" +"too_few_arguments" +"too_many_arguments" +"check_type_string" +"check_type_package" +"check_arg_failed" +"check_type_symbol" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_arg_failed" +"check_type_symbol" +"check_arg_failed" +"check_type_symbol" +"FEerror" +"enter_mark_origin" +"enter_mark_origin" +) + +;;/* for file toplevel.X */ + +( "toplevel.X" +"endp1" +"FEtoo_few_argumentsF" +"FEerror" +"not_a_symbol" +"check_arg_failed" +"check_type_symbol" +"FEerror" +"check_arg_failed" +"check_type_symbol" +"FEerror" +"endp1" +"FEtoo_few_argumentsF" +"FEinvalid_form" +"eval" +"FEerror" +"Fprogn" +"endp1" +"FEtoo_few_argumentsF" +"FEtoo_many_argumentsF" +"eval" +"FEerror" +"FEwrong_type_argument" +"FEerror" +"FEwrong_type_argument" +"enter_mark_origin" +) + +;;/* for file typespec.X */ + +( "typespec.X" +"FEerror" +"check_arg_failed" +"error" +"enter_mark_origin" +) + +;;/* for file unixfasl.X */ + +( "unixfasl.X" +"coerce_to_filename" +"getpid" +"system" +"FEerror" +"setbuf" +"fread" +"fclose" +"fseek" +"close_stream" +"printf" +"error" +"unlink" +"call_init" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_type_string" +"bds_unwind" +) + +;;/* for file unixfsys.X */ + +( "unixfsys.X" +"bcopy" +"getuid" +"FEerror" +"FEerror" +"bcopy" +"chdir" +"FEerror" +"chdir" +"strcat" +"system" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_type_or_Pathname_string_symbol" +"rename" +"FEerror" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"unlink" +"FEerror" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"too_many_arguments" +"getuid" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"strcat" +"strcat" +"setbuf" +"_filbuf" +"pclose" +"stack_cons" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"chdir" +"FEerror" +) + +;;/* for file unixint.X */ + +( "unixint.X" +"terminal_interrupt" +"fprintf" +"fflush" +"gcl_signal" +"gcl_signal" +"gcl_signal" +"alarm" +"gcl_signal" +"FEerror" +"error" +"FEerror" +"check_arg_failed" +"gcl_signal" +"check_arg_failed" +"gcl_signal" +"gcl_signal" +) + +;;/* for file unixsave.X */ + +( "unixsave.X" +"fread" +"fwrite" +"fread" +"fwrite" +"fprintf" +"setbuf" +"fclose" +"unlink" +"fprintf" +"fread" +"fwrite" +"fseek" +"check_arg_failed" +"check_type_or_pathname_string_symbol_stream" +"coerce_to_filename" +"_cleanup" +) + +;;/* for file unixsys.X */ + +( "unixsys.X" +"check_arg_failed" +"check_type_string" +"FEerror" +"system" +) + +;;/* for file unixtime.X */ + +( "unixtime.X" +"check_arg_failed" +"time" +"check_arg_failed" +"check_type_or_rational_float" +"number_minusp" +"FEerror" +"Lround" +"sleep" +"check_arg_failed" +"check_arg_failed" +"gettimeofday" +"ftime" +) + +;;/* for file user_init.X */ + +( "user_init.X" +) +)) diff --git a/o/iteration.c b/o/iteration.c new file mode 100755 index 0000000..7cfe21c --- /dev/null +++ b/o/iteration.c @@ -0,0 +1,458 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + iteration.c + +*/ + +#include "include.h" + +static void +FFN(Floop)(object form) +{ + + object x; + object *oldlex = lex_env; + object *top; + + make_nil_block(); + + if (nlj_active) { + nlj_active = FALSE; + frs_pop(); + lex_env = oldlex; + return; + } + + top = vs_top; + + for(x = form; !endp(x); x = MMcdr(x)) { + vs_top = top; + eval(MMcar(x)); + } +LOOP: + /* Just !endp(x) is replaced by x != Cnil. */ + for(x = form; x != Cnil; x = MMcdr(x)) { + vs_top = top; + eval(MMcar(x)); + } + goto LOOP; +} + +/* + use of VS in Fdo and FdoA: + | | + lex_env -> | lex1 | + | lex2 | + | lex3 | + start -> |-------| where each bt is a bind_temp: + | bt1 | + |-------| | var | -- name of DO variable + : | spp | -- T if special + |-------| | init | + | btn | | aux | -- step-form or var (if no + |-------| step-form is given) + end -> | body | + old_top-> |-------| If 'spp' != T, it is NIL during + initialization, and is the pointer to + (var value) in lexical environment + during the main loop. +*/ + +static void +do_var_list(object var_list) +{ + + object is, x, y; + + for (is = var_list; !endp(is); is = MMcdr(is)) { + x = MMcar(is); + if (type_of(x)==t_symbol) + {vs_push(x);vs_push(Cnil);vs_push(Cnil);vs_push(x); + continue;} + + + + + + if (!consp(x)) + FEinvalid_form("The index, ~S, is illegal.", x); + y = MMcar(x); + check_var(y); + vs_push(y); + vs_push(Cnil); + if (endp(MMcdr(x))) { + vs_push(Cnil); + vs_push(y); + } else { + x = MMcdr(x); + vs_push(MMcar(x)); + if (endp(MMcdr(x))) + vs_push(y); + else { + x = MMcdr(x); + vs_push(MMcar(x)); + if (!endp(MMcdr(x))) + FEerror("Too many forms to the index ~S.", + 1, y); + } + } + } +} + +static void +FFN(Fdo)(VOL object arg) +{ + + object *oldlex = lex_env; + object *old_top; + struct bind_temp *start, *end, *bt; + object end_test, body; + VOL object result; + bds_ptr old_bds_top = bds_top; + + if (endp(arg) || endp(MMcdr(arg))) + FEtoo_few_argumentsF(arg); + if (endp(MMcadr(arg))) + FEinvalid_form("The DO end-test, ~S, is illegal.", + MMcadr(arg)); + + end_test = MMcaadr(arg); + result = MMcdadr(arg); + + make_nil_block(); + + if (nlj_active) { + nlj_active = FALSE; + goto END; + } + + start = (struct bind_temp *) vs_top; + + do_var_list(MMcar(arg)); + end = (struct bind_temp *)vs_top; + body = let_bind(MMcddr(arg), start, end); + vs_push(body); + + for (bt = start; bt < end; bt++) + if ((enum stype)bt->bt_var->s.s_stype != stp_ordinary) + bt->bt_spp = Ct; + else if (bt->bt_spp == Cnil) + bt->bt_spp = assoc_eq(bt->bt_var, lex_env[0]); + + old_top = vs_top; + +LOOP: /* the main loop */ + vs_top = old_top; + eval(end_test); + if (vs_base[0] != Cnil) { + /* RESULT evaluation */ + if (endp(result)) { + vs_base = vs_top = old_top; + vs_push(Cnil); + } else + do { + vs_top = old_top; + eval(MMcar(result)); + result = MMcdr(result); + } while (!endp(result)); + goto END; + } + + vs_top = old_top; + + Ftagbody(body); + + /* next step */ + for (bt = start; btbt_aux != bt->bt_var) { + eval_assign(bt->bt_init, bt->bt_aux); + } + } + for (bt = start; btbt_aux != bt->bt_var) { + if (bt->bt_spp == Ct) + bt->bt_var->s.s_dbind = bt->bt_init; + else + MMcadr(bt->bt_spp) = bt->bt_init; + } + } + goto LOOP; + +END: + bds_unwind(old_bds_top); + frs_pop(); + lex_env = oldlex; +} + +static void +FFN(FdoA)(VOL object arg) +{ + + object *oldlex = lex_env; + object *old_top; + struct bind_temp *start, *end, *bt; + object end_test, body; + VOL object result; + bds_ptr old_bds_top = bds_top; + + if (endp(arg) || endp(MMcdr(arg))) + FEtoo_few_argumentsF(arg); + if (endp(MMcadr(arg))) + FEinvalid_form("The DO* end-test, ~S, is illegal.", + MMcadr(arg)); + + end_test = MMcaadr(arg); + result = MMcdadr(arg); + + make_nil_block(); + + if (nlj_active) { + nlj_active = FALSE; + goto END; + } + + start = (struct bind_temp *)vs_top; + do_var_list(MMcar(arg)); + end = (struct bind_temp *)vs_top; + body = letA_bind(MMcddr(arg), start, end); + vs_push(body); + + for (bt = start; bt < end; bt++) + if ((enum stype)bt->bt_var->s.s_stype != stp_ordinary) + bt->bt_spp = Ct; + else if (bt->bt_spp == Cnil) + bt->bt_spp = assoc_eq(bt->bt_var, lex_env[0]); + + old_top = vs_top; + +LOOP: /* the main loop */ + eval(end_test); + if (vs_base[0] != Cnil) { + /* RESULT evaluation */ + if (endp(result)) { + vs_base = vs_top = old_top; + vs_push(Cnil); + } else + do { + vs_top = old_top; + eval(MMcar(result)); + result = MMcdr(result); + } while (!endp(result)); + goto END; + } + + vs_top = old_top; + + Ftagbody(body); + + /* next step */ + for (bt = start; bt < end; bt++) + if (bt->bt_aux != bt->bt_var) { + if (bt->bt_spp == Ct) { + eval_assign(bt->bt_var->s.s_dbind, bt->bt_aux); + } else { + eval_assign(MMcadr(bt->bt_spp), bt->bt_aux); + } + } + goto LOOP; + +END: + bds_unwind(old_bds_top); + frs_pop(); + lex_env = oldlex; +} + +static void +FFN(Fdolist)(VOL object arg) +{ + + object *oldlex = lex_env; + object *old_top; + struct bind_temp *start; + object x, listform, body; + VOL object result; + bds_ptr old_bds_top = bds_top; + + if (endp(arg)) + FEtoo_few_argumentsF(arg); + + x = MMcar(arg); + if (endp(x)) + FEerror("No variable.", 0); + start = (struct bind_temp *)vs_top; + vs_push(MMcar(x)); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + x = MMcdr(x); + if (endp(x)) + FEerror("No listform.", 0); + listform = MMcar(x); + x = MMcdr(x); + if (endp(x)) + result = Cnil; + else { + result = MMcar(x); + if (!endp(MMcdr(x))) + FEerror("Too many resultforms.", 0); + } + + make_nil_block(); + + if (nlj_active) { + nlj_active = FALSE; + goto END; + } + + eval_assign(start->bt_init, listform); + body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ + vs_push(body); + bind_var(start->bt_var, Cnil, start->bt_spp); + if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) + start->bt_spp = Ct; + else if (start->bt_spp == Cnil) + start->bt_spp = assoc_eq(start->bt_var, lex_env[0]); + + old_top = vs_top; + +LOOP: /* the main loop */ + if (endp(start->bt_init)) { + if (start->bt_spp == Ct) + start->bt_var->s.s_dbind = Cnil; + else + MMcadr(start->bt_spp) = Cnil; + eval(result); + goto END; + } + + if (start->bt_spp == Ct) + start->bt_var->s.s_dbind = MMcar(start->bt_init); + else + MMcadr(start->bt_spp) = MMcar(start->bt_init); + start->bt_init = MMcdr(start->bt_init); + + vs_top = old_top; + + Ftagbody(body); + + goto LOOP; + +END: + bds_unwind(old_bds_top); + frs_pop(); + lex_env = oldlex; +} + +static void +FFN(Fdotimes)(VOL object arg) +{ + + object *oldlex = lex_env; + object *old_top; + struct bind_temp *start; + object x, countform, body; + VOL object result; + bds_ptr old_bds_top = bds_top; + + if (endp(arg)) + FEtoo_few_argumentsF(arg); + + x = MMcar(arg); + if (endp(x)) + FEerror("No variable.", 0); + start = (struct bind_temp *)vs_top; + vs_push(MMcar(x)); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + x = MMcdr(x); + if (endp(x)) + FEerror("No countform.", 0); + countform = MMcar(x); + x = MMcdr(x); + if (endp(x)) + result = Cnil; + else { + result = MMcar(x); + if (!endp(MMcdr(x))) + FEerror("Too many resultforms.", 0); + } + + make_nil_block(); + + if (nlj_active) { + nlj_active = FALSE; + goto END; + } + + eval_assign(start->bt_init, countform); + if (type_of(start->bt_init) != t_fixnum && + type_of(start->bt_init) != t_bignum) + FEwrong_type_argument(sLinteger, start->bt_init); + body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ + vs_push(body); + bind_var(start->bt_var, make_fixnum(0), start->bt_spp); + if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) { + start->bt_spp = Ct; + x = start->bt_var->s.s_dbind; + } else if (start->bt_spp == Cnil) { + start->bt_spp = assoc_eq(start->bt_var, lex_env[0]); + x = MMcadr(start->bt_spp); + } else + x = start->bt_var->s.s_dbind; + + old_top = vs_top; + +LOOP: /* the main loop */ + if (number_compare(x, start->bt_init) >= 0) { + eval(result); + goto END; + } + + vs_top = old_top; + + Ftagbody(body); + + if (start->bt_spp == Ct) + x = start->bt_var->s.s_dbind = one_plus(x); + else + x = MMcadr(start->bt_spp) = one_plus(x); + + goto LOOP; + +END: + bds_unwind(old_bds_top); + frs_pop(); + lex_env = oldlex; +} + +void +gcl_init_iteration(void) +{ + make_special_form("LOOP", Floop); + make_special_form("DO", Fdo); + make_special_form("DO*", FdoA); + make_special_form("DOLIST", Fdolist); + make_special_form("DOTIMES", Fdotimes); +} diff --git a/o/lastfile.c b/o/lastfile.c new file mode 100755 index 0000000..126a64b --- /dev/null +++ b/o/lastfile.c @@ -0,0 +1,50 @@ +/* Mark end of data space to dump as pure, for GNU Emacs. + Copyright (C) 1985 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +#include "config.h" + +/* How this works: + + Fdump_emacs dumps everything up to my_edata as text space (pure). + + The files of Emacs are written so as to have no initialized + data that can ever need to be altered except at the first startup. + This is so that those words can be dumped as sharable text. + + It is not possible to exercise such control over library files. + So it is necessary to refrain from making their data areas shared. + Therefore, this file is loaded following all the files of Emacs + but before library files. + As a result, the symbol my_edata indicates the point + in data space between data coming from Emacs and data + coming from libraries. +*/ + +char my_edata[] = "End of Emacs initialized data"; + +/* Help unexec locate the end of the .bss area used by Emacs (which + isn't always a separate section in NT executables). */ +char my_endbss[1]; +/* The Alpha MSVC linker globally segregates all static and public bss + data, so we must take both into account to determine the true extent + of the bss area used by Emacs. */ +static char _my_endbss[1]; +char * my_endbss_static = _my_endbss; diff --git a/o/let.c b/o/let.c new file mode 100755 index 0000000..18cd3ab --- /dev/null +++ b/o/let.c @@ -0,0 +1,322 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + let.c +*/ + +#include "include.h" + +void +let_var_list(object var_list) +{ + + object x, y; + + for (x = var_list; !endp(x); x = x->c.c_cdr) { + y = x->c.c_car; + if (type_of(y) == t_symbol) { + check_var(y); + vs_push(y); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + } else { + endp(y); + check_var(y->c.c_car); + vs_push(y->c.c_car); + vs_push(Cnil); + y = y->c.c_cdr; + if (endp(y)) /* + FEerror("No initial form to the variable ~S.", + 1, vs_top[-2]) */ ; + else if (!endp(y->c.c_cdr)) + FEerror("Too many initial forms to the variable ~S.", + 1, vs_top[-2]); + vs_push(y->c.c_car); + vs_push(Cnil); + } + } +} + +static void +FFN(Flet)(object form) +{ + + object body; + struct bind_temp *start; + object *old_lex; + bds_ptr old_bds_top; + + if (endp(form)) + FEerror("No argument to LET.", 0); + + old_lex = lex_env; + lex_copy(); + old_bds_top = bds_top; + + start = (struct bind_temp *)vs_top; + let_var_list(form->c.c_car); + body = let_bind(form->c.c_cdr, start, (struct bind_temp *)vs_top); + vs_top = (object *)start; + vs_push(body); + + Fprogn(body); + + lex_env = old_lex; + bds_unwind(old_bds_top); +} + +static void +FFN(FletA)(object form) +{ + + object body; + struct bind_temp *start; + object *old_lex; + bds_ptr old_bds_top; + + if (endp(form)) + FEerror("No argument to LET*.", 0); + + old_lex = lex_env; + lex_copy(); + old_bds_top = bds_top; + + start = (struct bind_temp *)vs_top; + let_var_list(form->c.c_car); + body = letA_bind(form->c.c_cdr, start, (struct bind_temp *)vs_top); + vs_top = (object *)start; + vs_push(body); + + Fprogn(body); + + lex_env = old_lex; + bds_unwind(old_bds_top); +} + +static void +FFN(Fmultiple_value_bind)(object form) +{ + + object body, values_form, x, y; + int n, m, i; + object *base; + object *old_lex; + bds_ptr old_bds_top; + struct bind_temp *start; + + if (endp(form)) + FEerror("No argument to MULTIPLE-VALUE-BIND.", 0); + body = form->c.c_cdr; + if (endp(body)) + FEerror("No values-form to MULTIPLE-VALUE-BIND.", 0); + values_form = body->c.c_car; + body = body->c.c_cdr; + + old_lex = lex_env; + lex_copy(); + old_bds_top = bds_top; + + eval(values_form); + base = vs_base; + m = vs_top - vs_base; + + start = (struct bind_temp *)vs_top; + for (n = 0, x = form->c.c_car; !endp(x); n++, x = x->c.c_cdr) { + y = x->c.c_car; + check_var(y); + vs_push(y); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + } + { + object *vt = vs_top; + vs_push(find_special(body, start, (struct bind_temp *)vt,NULL)); /*?*/ + } + for (i = 0; i < n; i++) + bind_var(start[i].bt_var, + (i < m ? base[i] : Cnil), + start[i].bt_spp); + body = vs_pop; + + vs_top = vs_base = base; + + vs_push(body); + Fprogn(body); + lex_env = old_lex; + bds_unwind(old_bds_top); +} + +static void +FFN(Fcompiler_let)(object form) +{ + + object body; + object *old_lex; + bds_ptr old_bds_top; + struct bind_temp *start, *end, *bt; + + if (endp(form)) + FEerror("No argument to COMPILER-LET.", 0); + + body = form->c.c_cdr; + + old_lex = lex_env; + lex_copy(); + old_bds_top = bds_top; + + start = (struct bind_temp *)vs_top; + let_var_list(form->c.c_car); + end = (struct bind_temp *)vs_top; + for (bt = start; bt < end; bt++) { + eval_assign(bt->bt_init, bt->bt_init); + } + for (bt = start; bt < end; bt++) + bind_var(bt->bt_var, bt->bt_init, Ct); + + vs_top = (object *)start; + + Fprogn(body); + + lex_env = old_lex; + bds_unwind(old_bds_top); +} + +static void +FFN(Fflet)(object args) +{ + + object def_list; + object def; + object *lex = lex_env; + object *top = vs_top; + + vs_push(Cnil); /* space for each closure */ + if (endp(args)) + FEtoo_few_argumentsF(args); + def_list = MMcar(args); + lex_copy(); + while (!endp(def_list)) { + def = MMcar(def_list); + if (endp(def) || endp(MMcdr(def)) || + type_of(MMcar(def)) != t_symbol) + FEerror("~S~%\ +is an illegal function definition in FLET.", + 1, def); + top[0] = MMcons(lex[2], def); + top[0] = MMcons(lex[1], top[0]); + top[0] = MMcons(lex[0], top[0]); + top[0] = MMcons(sSlambda_block_closure, top[0]); + lex_fun_bind(MMcar(def), top[0]); + def_list = MMcdr(def_list); + } + vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; +} + +static void +FFN(Flabels)(object args) +{ + + object def_list; + object def; + object closure_list; + object *lex = lex_env; + object *top = vs_top; + + vs_push(Cnil); /* space for each closure */ + vs_push(Cnil); /* space for closure-list */ + if (endp(args)) + FEtoo_few_argumentsF(args); + def_list = MMcar(args); + lex_copy(); + while (!endp(def_list)) { + def = MMcar(def_list); + if (endp(def) || endp(MMcdr(def)) || + type_of(MMcar(def)) != t_symbol) + FEerror("~S~%\ +is an illegal function definition in LABELS.", + 1, def); + top[0] = MMcons(lex[2], def); + top[0] = MMcons(Cnil, top[0]); + top[1] = MMcons(top[0], top[1]); + top[0] = MMcons(lex[0], top[0]); + top[0] = MMcons(sSlambda_block_closure, top[0]); + lex_fun_bind(MMcar(def), top[0]); + def_list = MMcdr(def_list); + } + closure_list = top[1]; + while (!endp(closure_list)) { + MMcaar(closure_list) = lex_env[1]; + closure_list = MMcdr(closure_list); + } + vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; +} + +static void +FFN(Fmacrolet)(object args) +{ + + object def_list; + object def; + object *lex = lex_env; + object *top = vs_top; + + vs_push(Cnil); /* space for each macrodef */ + if (endp(args)) + FEtoo_few_argumentsF(args); + def_list = MMcar(args); + lex_copy(); + while (!endp(def_list)) { + def = MMcar(def_list); + if (endp(def) || endp(MMcdr(def)) || + type_of(MMcar(def)) != t_symbol) + FEerror("~S~%\ +is an illegal macro definition in MACROFLET.", + 1, def); + top[0] = ifuncall3(sSdefmacroA, + MMcar(def), + MMcadr(def), + MMcddr(def)); + lex_macro_bind(MMcar(def), MMcaddr(top[0])); + def_list = MMcdr(def_list); + } + vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; +} + +void +gcl_init_let(void) +{ + make_special_form("LET", Flet); + make_special_form("LET*", FletA); + make_special_form("MULTIPLE-VALUE-BIND", Fmultiple_value_bind); + make_special_form("FLET",Fflet); + make_special_form("LABELS",Flabels); + make_special_form("MACROLET",Fmacrolet); + make_si_special_form("COMPILER-LET", Fcompiler_let); +} diff --git a/o/lex.c b/o/lex.c new file mode 100755 index 0000000..c698506 --- /dev/null +++ b/o/lex.c @@ -0,0 +1,129 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + lex.c + + lexical environment +*/ + +#include "include.h" + + +object +assoc_eq(object key, object alist) +{ + + while (!endp(alist)) { + if (MMcaar(alist) == key) + return(MMcar(alist)); + alist = MMcdr(alist); + } + return(Cnil); +} + +void +lex_fun_bind(object name, object fun) +{ + object *top = vs_top; + + vs_push(make_cons(fun, Cnil)); + top[0] = make_cons(sLfunction, top[0]); + top[0] = make_cons(name, top[0]); + lex_env[1] = make_cons(top[0],lex_env[1]); + vs_top = top; +} + +void +lex_macro_bind(object name, object exp_fun) +{ + object *top = vs_top; + vs_push(make_cons(exp_fun, Cnil)); + top[0] = make_cons(sSmacro, top[0]); + top[0] = make_cons(name, top[0]); + lex_env[1]=make_cons(top[0], lex_env[1]); + vs_top = top; +} + +void +lex_tag_bind(object tag, object id) +{ + object *top = vs_top; + + vs_push(make_cons(id, Cnil)); + top[0] = make_cons(sStag, top[0]); + top[0] = make_cons(tag, top[0]); + lex_env[2] =make_cons(top[0], lex_env[2]); + vs_top = top; +} + +void +lex_block_bind(object name, object id) +{ + object *top = vs_top; + + vs_push(make_cons(id, Cnil)); + top[0] = make_cons(sLblock, top[0]); + top[0] = make_cons(name, top[0]); + lex_env[2]= make_cons(top[0], lex_env[2]); + vs_top = top; +} + +object +lex_tag_sch(object tag) +{ + + object alist = lex_env[2]; + + while (!endp(alist)) { + if (eql(MMcaar(alist), tag) && MMcadar(alist) == sStag) + return(MMcar(alist)); + alist = MMcdr(alist); + } + return(Cnil); +} + +object lex_block_sch(object name) +{ + + object alist = lex_env[2]; + + while (!endp(alist)) { + if (MMcaar(alist) == name && MMcadar(alist) == sLblock) + return(MMcar(alist)); + alist = MMcdr(alist); + } + return(Cnil); +} + +void +gcl_init_lex(void) +{ +/* sLfunction = make_ordinary("FUNCTION"); */ +/* enter_mark_origin(&sLfunction); */ + sSmacro = make_si_ordinary("MACRO"); + enter_mark_origin(&sSmacro); + sStag = make_si_ordinary("TAG"); + enter_mark_origin(&sStag); + sLblock = make_ordinary("BLOCK"); + enter_mark_origin(&sLblock); +} diff --git a/o/list.d b/o/list.d new file mode 100755 index 0000000..21fc5e4 --- /dev/null +++ b/o/list.d @@ -0,0 +1,1387 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + list.d + + list manipulating routines +*/ + +#include "include.h" +#include "page.h" + +static int reverse_comparison; + +#define TARG1(a,b) (reverse_comparison ? (b) : (a)) +#define TARG2(a,b) (reverse_comparison ? (a) : (b)) + +object sKinitial_element; + +#define TEST(x) (*tf)(x) + +#define saveTEST \ + object old_test_function = test_function; \ + object old_item_compared = item_compared; \ + bool (*old_tf)() = tf; \ + object old_key_function = key_function; \ + object (*old_kf)() = kf; \ + VOL bool eflag = FALSE + +#define protectTEST \ + frs_push(FRS_PROTECT, Cnil); \ + if (nlj_active) { \ + eflag = TRUE; \ + goto L; \ + } + +#define restoreTEST \ +L: \ + frs_pop(); \ + test_function = old_test_function; \ + item_compared = old_item_compared; \ + tf = old_tf; \ + key_function = old_key_function; \ + kf = old_kf; \ + if (eflag) { \ + nlj_active = FALSE; \ + unwind(nlj_fr, nlj_tag); \ + } + +static bool +test_compare(x) +object x; +{ + object b; + + vs_push((*kf)(x)); + b = ifuncall2(test_function, + TARG1(item_compared, vs_head), + TARG2(item_compared, vs_head)); + vs_popp; + return(b != Cnil); +} + +static bool +test_compare_not(x) +object x; +{ + object b; + + vs_push((*kf)(x)); + b = ifuncall2(test_function, + TARG1(item_compared, vs_head), + TARG2(item_compared, vs_head)); + vs_popp; + return(b == Cnil); +} + +static bool +test_eql(x) +object x; +{ + return(eql(item_compared, (*kf)(x))); +} + +static object +apply_key_function(x) +object x; +{ + return(ifuncall1(key_function, x)); +} + +static object +identity(x) +object x; +{ + return(x); +} + +static void +setupTEST(item, test, test_not, key) +object item, test, test_not, key; +{ + item_compared = item; + if (test != Cnil) { + if (test_not != Cnil) + FEerror("Both :TEST and :TEST-NOT are specified.", 0); + test_function = test; + tf = test_compare; + } else if (test_not != Cnil) { + test_function = test_not; + tf = test_compare_not; + } else + tf = test_eql; + if (key != Cnil) { + key_function = key; + kf = apply_key_function; + } else + kf = identity; +} + +#define PREDICATE(f, f_if, f_if_not, n) \ +LFD(f_if)() \ +{ \ + if (vs_top - vs_base < n) \ + too_few_arguments(); \ + vs_push(sKtest); \ + vs_push(sLfuncall); \ + f(); \ +} \ +\ +LFD(f_if_not)() \ +{ \ + if (vs_top - vs_base < n) \ + too_few_arguments(); \ + vs_push(sKtest_not); \ + vs_push(sLfuncall); \ + f(); \ +} + +/* static bool +endp1(x) +object x; +{ + + if (type_of(x) == t_cons) + return(FALSE); + else * if (x == Cnil) * + return(TRUE); + vs_push(x); + FEwrong_type_argument(sLlist, x); + return(FALSE); +}*/ + +object +car(x) +object x; +{ + if (x == Cnil) + return(x); + if (type_of(x) == t_cons) + return(x->c.c_car); + FEwrong_type_argument(sLlist, x); + return(Cnil); +} + +object +cdr(x) +object x; +{ + if (x == Cnil) + return(x); + if (type_of(x) == t_cons) + return(x->c.c_cdr); + FEwrong_type_argument(sLlist, x); + return(Cnil); +} + +object +kar(x) +object x; +{ + if (type_of(x) == t_cons) + return(x->c.c_car); + FEwrong_type_argument(sLcons, x); + return(Cnil); +} + +/* static object +kdr(x) +object x; +{ + if (type_of(x) == t_cons) + return(x->c.c_cdr); + FEwrong_type_argument(sLcons, x); + return(Cnil); +}*/ + +void +stack_cons(void) +{ + object d=vs_pop,a=vs_pop; + *vs_top++ = make_cons(a,d); +} + +/*static object on_stack_list_vector(n,ap) + int n; + va_list ap; +{object res=(object) alloca_val; + struct cons *p; + object x; + p=(struct cons *) res; + if (n<=0) return Cnil; + TOP: + p->t = (int)t_cons; + p->m=FALSE; + p->c_car= va_arg(ap,object); + if (--n == 0) + {p->c_cdr = Cnil; + return res;} + else + { x= (object) p; + x->c.c_cdr= (object) ( ++p);} + goto TOP; +}*/ + +object on_stack_list_vector_new(int n,object first,va_list ap) +{object res=(object) alloca_val; + struct cons *p; + object x; + int jj=0; + p=(struct cons *) res; + if (n<=0) return Cnil; + TOP: +#ifdef WIDE_CONS + set_type_of(p,t_cons); +#endif + p->c_car= jj||first==OBJNULL ? va_arg(ap,object) : first; + jj=1; + if (--n == 0) + {p->c_cdr = Cnil; + return res;} + else + { x= (object) p; + x->c.c_cdr= (object) ( ++p);} + goto TOP; +} + +/* static object list_vector(n,ap) + int n; + va_list ap; +{object ans,*p; + + if (n == 0) return Cnil; + ans = make_cons(va_arg(ap,object),Cnil); + p = & (ans->c.c_cdr); + while (--n > 0) + { *p = make_cons(va_arg(ap,object),Cnil); + p = & ((*p)->c.c_cdr); + } + return ans; +}*/ + +object +list_vector_new(int n,object first,va_list ap) { + + object ans,*p; + + for (p=&ans;n-->0;first=OBJNULL) + collect(p,make_cons(first==OBJNULL ? va_arg(ap,object) : first,Cnil)); + *p=Cnil; + return ans; + +} + +#ifdef WIDE_CONS +#define maybe_set_type_of(a,b) set_type_of(a,b) +#else +#define maybe_set_type_of(a,b) +#endif + +void +free_check(void) { + + int n=tm_table[t_cons].tm_nfree,m; + object f=tm_table[t_cons].tm_free; + for (m=0;f!=OBJNULL;m++,f=OBJ_LINK(f)); + massert(n==m); +} + +#define multi_cons(n_,next_,last_) \ + ({_tm->tm_nfree -= n_; \ + for(_x=_tm->tm_free,_p=&_x;n_-->0;_p=&(*_p)->c.c_cdr) { \ + object _z=*_p; \ + pageinfo(_z)->in_use++; \ + maybe_set_type_of(_z,t_cons); \ + _z->c.c_cdr=OBJ_LINK(_z); \ + _z->c.c_car=next_; \ + } \ + _tm->tm_free=*_p; \ + *_p=SAFE_CDR(last_); \ + _x;}) + +#define n_cons(n_,next_,last_) \ + ({fixnum _n=n_;object _x=Cnil,*_p; \ + static struct typemanager *_tm=tm_table+t_cons; \ + if (_n>=0) {/*FIXME vs_toptm_nfree) \ + _x=multi_cons(_n,next_,last_); \ + else { \ + for (_p=&_x;_n--;) \ + collect(_p,make_cons(next_,Cnil)); \ + *_p=SAFE_CDR(last_); \ + } \ + END_NO_INTERRUPT; \ + } \ + _x;}) + +object +n_cons_from_x(fixnum n,object x) { + + return n_cons(n,({object _z=x->c.c_car;x=x->c.c_cdr;_z;}),Cnil); + +} + + +object +listqA(int a,int n,va_list ap) { + + return n_cons(n,va_arg(ap,object),a ? va_arg(ap,object) : Cnil); + +} + +object list(fixnum n,...) { + + va_list ap; + object lis; + + va_start(ap,n); + lis=listqA(0,n,ap); + va_end(ap); + return lis; + +} + +object listA(fixnum n,...) { + + va_list ap; + object lis; + + va_start(ap,n); + lis=listqA(1,n-1,ap); + va_end(ap); + return lis; + +} + + +static bool +tree_equal(x, y) +object x, y; +{ + cs_check(x); + +BEGIN: + if (type_of(x) == t_cons) + if (type_of(y) == t_cons) + if (tree_equal(x->c.c_car, y->c.c_car)) { + x = x->c.c_cdr; + y = y->c.c_cdr; + goto BEGIN; + } else + return(FALSE); + else + return(FALSE); + else { + item_compared = x; + if (TEST(y)) + return(TRUE); + else + return(FALSE); + } +} + +object +append(object x, object y) { + + return n_cons(length(x),({object _t=x->c.c_car;x=x->c.c_cdr;_t;}),y); + +} + +/* + Copy_list(x) copies list x. +*/ +object +copy_list(object x) { + object h,y; + + if (type_of(x) != t_cons) + return(x); + h=y=make_cons(x->c.c_car, Cnil); + for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { + y->c.c_cdr = make_cons(x->c.c_car, Cnil); + y=y->c.c_cdr; + } + y->c.c_cdr=SAFE_CDR(x); + return(h); +} + +/* + Copy_alist(x) copies alist x. +*/ +static object +copy_alist(object x) { + + object h,y; + + if (endp(x)) + return(Cnil); + h=y=make_cons(Cnil, Cnil); + for (;;) { + y->c.c_car=make_cons(car(x->c.c_car), cdr(x->c.c_car)); + x=x->c.c_cdr; + if (endp(x)) + break; + y->c.c_cdr=make_cons(Cnil, Cnil); + y=y->c.c_cdr; + } + return(h); +} + +static object +copy_tree(object x) { + + object y; + + if (type_of(x) == t_cons) { + y=make_cons(Cnil,Cnil); + y->c.c_car=copy_tree(x->c.c_car); + y->c.c_cdr=copy_tree(x->c.c_cdr); + x=y; + } + return x; +} + +/* + Nsubst(new, treep) stores + the result of nsubstituting new in *treep + to *treep. +*/ +static void +nsubst(new, treep) +object new, *treep; +{ + cs_check(new); + + if (TEST(*treep)) + *treep = new; + else if (type_of(*treep) == t_cons) { + nsubst(new, &(*treep)->c.c_car); + nsubst(new, &(*treep)->c.c_cdr); + } +} + +/* + Sublis(alist, tree) pushes + result of substituting tree by alist + onto vs. +*/ +static object +sublis(object alist, object tree) { + + object x; + cs_check(alist); + + for (x=alist;!endp(x);x=x->c.c_cdr) { + item_compared=car(x->c.c_car); + if (TEST(tree)) + return x->c.c_car->c.c_cdr; + } + if (type_of(tree) == t_cons) { + object a=sublis(alist,tree->c.c_car),d=sublis(alist,tree->c.c_cdr); + return (a==tree->c.c_car && d==tree->c.c_cdr) ? tree : make_cons(a,d); + } else + return tree; +} + +/* + Nsublis(alist, treep) stores + the result of substiting *treep by alist + to *treep. +*/ +static void +nsublis(alist, treep) +object alist, *treep; +{ + object x; + + cs_check(alist); + + + for (x = alist; !endp(x); x = x->c.c_cdr) { + item_compared = car(x->c.c_car); + if (TEST(*treep)) { + *treep = x->c.c_car->c.c_cdr; + return; + } + } + if (type_of(*treep) == t_cons) { + nsublis(alist, &(*treep)->c.c_car); + nsublis(alist, &(*treep)->c.c_cdr); + } +} + +LFD(Lcar)() +{ + check_arg(1); + + if (type_of(vs_base[0]) == t_cons || vs_base[0] == Cnil) + vs_base[0] = vs_base[0]->c.c_car; + else + FEwrong_type_argument(sLlist, vs_base[0]); +} + +LFD(Lcdr)() +{ + check_arg(1); + + if (type_of(vs_base[0]) == t_cons || vs_base[0] == Cnil) + vs_base[0] = vs_base[0]->c.c_cdr; + else + FEwrong_type_argument(sLlist, vs_base[0]); +} + +object caar(x) object x; { return(car(car(x))); } +object cadr(x) object x; { return(car(cdr(x))); } +object cdar(x) object x; { return(cdr(car(x))); } +object cddr(x) object x; { return(cdr(cdr(x))); } +object caaar(x) object x; { return(car(car(car(x)))); } +object caadr(x) object x; { return(car(car(cdr(x)))); } +object cadar(x) object x; { return(car(cdr(car(x)))); } +object caddr(x) object x; { return(car(cdr(cdr(x)))); } +object cdaar(x) object x; { return(cdr(car(car(x)))); } +object cdadr(x) object x; { return(cdr(car(cdr(x)))); } +object cddar(x) object x; { return(cdr(cdr(car(x)))); } +object cdddr(x) object x; { return(cdr(cdr(cdr(x)))); } +object caaaar(x) object x; { return(car(car(car(car(x))))); } +object caaadr(x) object x; { return(car(car(car(cdr(x))))); } +object caadar(x) object x; { return(car(car(cdr(car(x))))); } +object caaddr(x) object x; { return(car(car(cdr(cdr(x))))); } +object cadaar(x) object x; { return(car(cdr(car(car(x))))); } +object cadadr(x) object x; { return(car(cdr(car(cdr(x))))); } +object caddar(x) object x; { return(car(cdr(cdr(car(x))))); } +object cadddr(x) object x; { return(car(cdr(cdr(cdr(x))))); } +object cdaaar(x) object x; { return(cdr(car(car(car(x))))); } +object cdaadr(x) object x; { return(cdr(car(car(cdr(x))))); } +object cdadar(x) object x; { return(cdr(car(cdr(car(x))))); } +object cdaddr(x) object x; { return(cdr(car(cdr(cdr(x))))); } +object cddaar(x) object x; { return(cdr(cdr(car(car(x))))); } +object cddadr(x) object x; { return(cdr(cdr(car(cdr(x))))); } +object cdddar(x) object x; { return(cdr(cdr(cdr(car(x))))); } +object cddddr(x) object x; { return(cdr(cdr(cdr(cdr(x))))); } + +LFD(Lcaar)(){ check_arg(1); vs_base[0] = car(car(vs_base[0])); } +LFD(Lcadr)(){ check_arg(1); vs_base[0] = car(cdr(vs_base[0])); } +LFD(Lcdar)(){ check_arg(1); vs_base[0] = cdr(car(vs_base[0])); } +LFD(Lcddr)(){ check_arg(1); vs_base[0] = cdr(cdr(vs_base[0])); } +LFD(Lcaaar)(){ check_arg(1); vs_base[0] = car(car(car(vs_base[0]))); } +LFD(Lcaadr)(){ check_arg(1); vs_base[0] = car(car(cdr(vs_base[0]))); } +LFD(Lcadar)(){ check_arg(1); vs_base[0] = car(cdr(car(vs_base[0]))); } +LFD(Lcaddr)(){ check_arg(1); vs_base[0] = car(cdr(cdr(vs_base[0]))); } +LFD(Lcdaar)(){ check_arg(1); vs_base[0] = cdr(car(car(vs_base[0]))); } +LFD(Lcdadr)(){ check_arg(1); vs_base[0] = cdr(car(cdr(vs_base[0]))); } +LFD(Lcddar)(){ check_arg(1); vs_base[0] = cdr(cdr(car(vs_base[0]))); } +LFD(Lcdddr)(){ check_arg(1); vs_base[0] = cdr(cdr(cdr(vs_base[0]))); } +LFD(Lcaaaar)(){check_arg(1); vs_base[0] = car(car(car(car(vs_base[0]))));} +LFD(Lcaaadr)(){check_arg(1); vs_base[0] = car(car(car(cdr(vs_base[0]))));} +LFD(Lcaadar)(){check_arg(1); vs_base[0] = car(car(cdr(car(vs_base[0]))));} +LFD(Lcaaddr)(){check_arg(1); vs_base[0] = car(car(cdr(cdr(vs_base[0]))));} +LFD(Lcadaar)(){check_arg(1); vs_base[0] = car(cdr(car(car(vs_base[0]))));} +LFD(Lcadadr)(){check_arg(1); vs_base[0] = car(cdr(car(cdr(vs_base[0]))));} +LFD(Lcaddar)(){check_arg(1); vs_base[0] = car(cdr(cdr(car(vs_base[0]))));} +LFD(Lcadddr)(){check_arg(1); vs_base[0] = car(cdr(cdr(cdr(vs_base[0]))));} +LFD(Lcdaaar)(){check_arg(1); vs_base[0] = cdr(car(car(car(vs_base[0]))));} +LFD(Lcdaadr)(){check_arg(1); vs_base[0] = cdr(car(car(cdr(vs_base[0]))));} +LFD(Lcdadar)(){check_arg(1); vs_base[0] = cdr(car(cdr(car(vs_base[0]))));} +LFD(Lcdaddr)(){check_arg(1); vs_base[0] = cdr(car(cdr(cdr(vs_base[0]))));} +LFD(Lcddaar)(){check_arg(1); vs_base[0] = cdr(cdr(car(car(vs_base[0]))));} +LFD(Lcddadr)(){check_arg(1); vs_base[0] = cdr(cdr(car(cdr(vs_base[0]))));} +LFD(Lcdddar)(){check_arg(1); vs_base[0] = cdr(cdr(cdr(car(vs_base[0]))));} +LFD(Lcddddr)(){check_arg(1); vs_base[0] = cdr(cdr(cdr(cdr(vs_base[0]))));} + +int +endp_error(object x) { + FEwrong_type_argument(sLlist,x); + return 0; +} + +DEFUNO_NEW("NTH",object,fLnth,LISP,2,2,NONE,OI,OO,OO,OO,void,Lnth,(fixnum index,object y),"") +{ object x = y; + if (index < 0) + FEerror("Negative index: ~D.", 1, make_fixnum(index)); + while (1) + {if (type_of(x)==t_cons) + { if (index == 0) + RETURN1(Mcar(x)); + else {x = Mcdr(x); index--;}} + else if (x == sLnil) RETURN1(sLnil); + else FEwrong_type_argument(sLlist, y);} +} +#ifdef STATIC_FUNCTION_POINTERS +object +fLnth(fixnum index,object list) { + return FFN(fLnth)(index,list); +} +#endif + +DEFUN_NEW("FIRST",object,fLfirst,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ RETURN1(car(x)) ;} + +DEFUN_NEW("SECOND",object,fLsecond,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(1,x);} +DEFUN_NEW("THIRD",object,fLthird,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(2,x);} +DEFUN_NEW("FOURTH",object,fLfourth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(3,x);} +DEFUN_NEW("FIFTH",object,fLfifth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(4,x);} +DEFUN_NEW("SIXTH",object,fLsixth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(5,x);} +DEFUN_NEW("SEVENTH",object,fLseventh,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(6,x);} +DEFUN_NEW("EIGHTH",object,fLeighth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(7,x);} +DEFUN_NEW("NINTH",object,fLninth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(8,x);} +DEFUN_NEW("TENTH",object,fLtenth,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") +{ return fLnth(9,x);} + +LFD(Lcons)() { + + check_arg(2); + vs_base[0]=make_cons(vs_base[0],vs_pop); + +} + +@(defun tree_equal (x y &key test test_not) + saveTEST; +@ + protectTEST; + setupTEST(Cnil, test, test_not, Cnil); + x=(tree_equal(x, y) ? Ct : Cnil); + restoreTEST; + @(return x) +@) + +LFD(Lendp)() +{ + + check_arg(1); + + if (vs_base[0] == Cnil) { + vs_base[0] = Ct; + return; + } + if (type_of(vs_base[0]) == t_cons) { + vs_base[0] = Cnil; + return; + } + FEwrong_type_argument(sLlist, vs_base[0]); +} + +LFD(Llist_length)() +{ + int n; + object fast, slow; + check_arg(1); + n = 0; + fast = slow = vs_base[0]; + for (;;) { + if (endp(fast)) { + vs_base[0] = make_fixnum(n); + return; + } + if (endp(fast->c.c_cdr)) { + vs_base[0] = make_fixnum(n + 1); + return; + } + if (fast == slow && n > 0) { + vs_base[0] = Cnil; + return; + } + n += 2; + fast = fast->c.c_cdr->c.c_cdr; + slow = slow->c.c_cdr; + } +} + + +object +nth(int n, object x) { + + if (n < 0) { + vs_push(make_fixnum(n)); + FEerror("Negative index: ~D.", 1, vs_head); + } + while (n-- > 0) + if (endp(x)) { + return(Cnil); + } else + x = x->c.c_cdr; + if (endp(x)) + return(Cnil); + else + return(x->c.c_car); +} + +LFD(Lnthcdr)() +{ + check_arg(2); + vs_base[0] = nthcdr(fixint(vs_base[0]), vs_base[1]); + vs_popp; +} + +object +nthcdr(int n, object x) { + + if (n < 0) { + vs_push(make_fixnum(n)); + FEwrong_type_argument(sLpositive_fixnum, vs_head); + } + while (n-- > 0) + if (endp_prop(x)) { + return(Cnil); + } else + x = x->c.c_cdr; + return(x); +} + +LFD(Llast)() { + object t; + int n; + + n=vs_top-vs_base; + if (n<1) + FEtoo_few_arguments(vs_base,vs_top); + if (n>2) + FEtoo_many_arguments(vs_base,vs_top); + if (endp(vs_base[0])) + return; + if (n==2) { + if (type_of(vs_base[1])!=t_fixnum || (n=fix(vs_base[1]))<0) + FEwrong_type_argument(sLpositive_fixnum,vs_base[1]); + vs_popp; + } + + if (!n) + while (type_of(vs_base[0]) == t_cons) + vs_base[0]=vs_base[0]->c.c_cdr; + else { + t=vs_base[0]; + while (type_of(vs_base[0]->c.c_cdr) == t_cons && --n) + vs_base[0] = vs_base[0]->c.c_cdr; + while (type_of(vs_base[0]->c.c_cdr) == t_cons) { + t=t->c.c_cdr; + vs_base[0] = vs_base[0]->c.c_cdr; + } + vs_base[0]=t; + } + +} + +LFD(Llist)() { + + object *a; + + a=vs_base; + vs_base[0]=n_cons(vs_top-vs_base,*a++,Cnil); + vs_top=vs_base+1; + +} + +LFD(LlistA)() { + + object *a; + + if (vs_top == vs_base) + too_few_arguments(); + + a=vs_base; + vs_base[0]=n_cons(vs_top-vs_base-1,*a++,vs_head); + vs_top=vs_base+1; + +} + +object on_stack_make_list(n) +int n; +{ object res=(object) alloca_val; + struct cons *p = (struct cons *)res; + if (n<=0) return Cnil; + TOP: +#ifdef WIDE_CONS + set_type_of(p,t_cons); +#endif + p->c_car=Cnil; + if (--n == 0) + {p->c_cdr = Cnil; + return res;} + else + {object x= (object) p; + x->c.c_cdr= (object) ( ++p);} + goto TOP; +} + +object +make_list(int n) { + + return n_cons(n,Cnil,Cnil); + +} + +@(defun make_list (size &key initial_element &aux x) +@ + check_type_non_negative_integer(&size); + if (type_of(size) != t_fixnum) + FEerror("Cannot make a list of the size ~D.", 1, size); + x=n_cons(fix(size),initial_element,Cnil); + @(return x) +@) + +LFD(Lappend)() +{ + object x; + + if (vs_top == vs_base) { + vs_push(Cnil); + return; + } + while (vs_top > vs_base + 1) { + x = append(vs_top[-2], vs_top[-1]); + vs_top[-2] = x; + vs_popp; + } +} + +LFD(Lcopy_list)() +{ + check_arg(1); + vs_base[0] = copy_list(vs_base[0]); +} + +LFD(Lcopy_alist)() +{ + check_arg(1); + vs_base[0] = copy_alist(vs_base[0]); +} + +LFD(Lcopy_tree)() +{ + check_arg(1); + vs_base[0]=copy_tree(vs_base[0]); +} + +LFD(Lrevappend)() { + + object x, y; + + check_arg(2); + y=vs_pop; + for (x=vs_base[0];!endp(x);x=x->c.c_cdr) + y=make_cons(x->c.c_car,y); + vs_base[0] = y; + +} + +object +nconc(object x, object y) { + object x1; + + if (endp(x)) + return(y); + for (x1 = x; !endp(x1->c.c_cdr); x1 = x1->c.c_cdr) + ; + x1->c.c_cdr = SAFE_CDR(y); + return(x); +} + +LFD(Lnconc)() { + object x, l, m=Cnil; + int i, narg; + + narg = vs_top - vs_base - 1; + if (narg < 0) { vs_push(Cnil); return; } + x = Cnil; + for (i = 0; i < narg; i++) { + l = vs_base[i]; + if (endp(l)) + continue; + if (x == Cnil) + x = m = l; + else { + m->c.c_cdr = SAFE_CDR(l); + m = l; + } + for (; type_of(m->c.c_cdr)==t_cons; m = m->c.c_cdr); + } + if (x == Cnil) vs_base[0] = vs_top[-1]; + else { + m->c.c_cdr = SAFE_CDR(vs_top[-1]); + vs_base[0] = x; + } + vs_top = vs_base+1; +} + +LFD(Lreconc)() { + object x, y, z; + + check_arg(2); + y = vs_pop; + for (x = vs_base[0]; !endp_prop(x);) { + z = x; + x = x->c.c_cdr; + z->c.c_cdr = SAFE_CDR(y); + y = z; + } + vs_base[0] = y; +} + +@(defun butlast (lis &optional (nn `make_fixnum(1)`)) + int i; + object *p,x,y,z; +@ + check_type_non_negative_integer(&nn); + if (!listp(lis))/*FIXME checktype*/ + FEwrong_type_argument(sLlist, lis); + if (type_of(nn) != t_fixnum) + @(return Cnil) + for (x=y=lis,i=0;ic.c_cdr); + for (p=&z;consp(y);x=x->c.c_cdr,y=y->c.c_cdr) + collect(p,make_cons(x->c.c_car,Cnil)); + *p=i ? Cnil : x; + @(return `z`) +@) + +@(defun nbutlast (lis &optional (nn `make_fixnum(1)`)) + int i; + object x; +@ + check_type_non_negative_integer(&nn); + if (!listp(lis))/*FIXME checktype*/ + FEwrong_type_argument(sLlist, lis); + if (type_of(nn) != t_fixnum) + @(return Cnil) + for (i = 0, x = lis; consp(x); i++, x = x->c.c_cdr); + if (i <= fix((nn))) + @(return Cnil) + for (i -= fix((nn)), x = lis; --i > 0; x = x->c.c_cdr) + ; + x->c.c_cdr = Cnil; + @(return lis) +@) + +LFD(Lldiff)() { + + fixnum i; + object x,y,*p,z; + + check_arg(2); + x=vs_base[0]; + z=vs_pop; + if (!listp(x))/*FIXME checktype*/ + FEwrong_type_argument(sLlist, x); + for (p=&y,i=0;consp(x) && x!=z;i++,x=x->c.c_cdr) + collect(p,make_cons(x->c.c_car,Cnil)); + *p=eql(x,z) ? Cnil : x; + vs_base[0]=y; + +} + +LFD(Lrplaca)() +{ + check_arg(2); + check_type_cons(&vs_base[0]); + take_care(vs_base[1]); + vs_base[0]->c.c_car = vs_base[1]; + vs_popp; +} + +LFD(Lrplacd)() +{ + check_arg(2); + check_type_cons(&vs_base[0]); + vs_base[0]->c.c_cdr = SAFE_CDR(vs_base[1]); + vs_popp; +} + +/* @(defun subst (new old tree &key test test_not key) */ +/* saveTEST; */ +/* @ */ +/* protectTEST; */ +/* setupTEST(old, test, test_not, key); */ +/* subst(new, tree); */ +/* tree = vs_pop; */ +/* /\* if (kf==identity && *\/ */ +/* /\* tf==test_eql && *\/ */ +/* /\* (is_imm_fixnum(item_compared) || *\/ */ +/* /\* ({enum type tp=type_of(item_compared);tp>t_complex || tpc.c_cdr) { + if ((*tst)(v->c.c_car->c.c_car,tree)) + return(v->c.c_car->c.c_cdr);} + if (type_of(tree)==t_cons){ + object a=sublis1(alist,tree->c.c_car,tst),d=sublis1(alist,tree->c.c_cdr,tst); + return a==tree->c.c_car && d==tree->c.c_cdr ? tree : make_cons(a,d); + } + return tree; +} + +/* static int +eq(x,y) +object x,y; +{return (x==y);}*/ + +void +check_alist(alist) + object alist; +{object v; + for (v=alist ; !endp(v) ; v=v->c.c_cdr) + {if (type_of(v->c.c_car) != t_cons + && v->c.c_car != Cnil) + FEerror("Not alist",0);} + return ; +} + + +@(defun sublis (alist tree &key test test_not key) + + saveTEST; +@ + protectTEST; + setupTEST(Cnil, test, test_not, key); + tree=sublis(alist,tree); + restoreTEST; + @(return tree) +@) + +@(defun nsublis (alist tree &key test test_not key) + saveTEST; +@ + protectTEST; + setupTEST(Cnil, test, test_not, key); + nsublis(alist, &tree); + restoreTEST; + @(return tree) +@) + +@(defun member (item list &key test test_not key) + saveTEST; + +@ + protectTEST; + setupTEST(item, test, test_not, key); + while (!endp_prop(list)) { + if (TEST(list->c.c_car)) + goto L; + list = list->c.c_cdr; + } + restoreTEST; + @(return list) +@) + +PREDICATE(Lmember,Lmember_if,Lmember_if_not, 2) + +@(static defun member1 (item list &key test test_not key rev) + saveTEST; +@ + protectTEST; + if (key != Cnil) + item = ifuncall1(key, item); + if (rev != Cnil) + reverse_comparison=1; + setupTEST(item, test, test_not, key); + while (!endp(list)) { + if (TEST(list->c.c_car)) + goto L; + list = list->c.c_cdr; + } + restoreTEST; + reverse_comparison=0; + @(return list) +@) + +LFD(Ltailp)() { + object x; + + check_arg(2); + for (x = vs_base[1]; consp(x); x = x->c.c_cdr) + if (x==vs_base[0]) { + vs_base[0] = Ct; + vs_popp; + return; + } + if (eql(x,vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; + vs_popp; + return; +} + +LFD(Ladjoin)() +{ + object *base = vs_base, *top = vs_top; + + if (vs_top - vs_base < 2) + too_few_arguments(); + while (vs_base < top) + vs_push(*vs_base++); + FFN(Lmember1)(); + if (vs_base[0] == Cnil) + base[1] = make_cons(base[0], base[1]); + vs_base = base+1; + vs_top = base+2; +} + +LFD(Lacons)() +{ + check_arg(3); + + vs_base[0] = make_cons(vs_base[0], vs_base[1]); + vs_base[0] = make_cons(vs_base[0], vs_base[2]); + vs_top -= 2; +} + +@(defun pairlis (keys data &optional a_list) + object k,d,y,z,*p; +@ + k=keys; + d=data; + p=&y; + while (!endp(k)) { + if (endp(d)) + FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); + z=make_cons(Cnil,Cnil); + z->c.c_car=make_cons(k->c.c_car,d->c.c_car); + collect(p,z); + k = k->c.c_cdr; + d = d->c.c_cdr; + } + if (!endp(d)) + FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); + *p=a_list; + vs_top=vs_base+1; + @(return `y`) +@) + +@(static defun assoc_or_rassoc (item a_list &key test test_not key) + saveTEST; +@ + protectTEST; + setupTEST(item, test, test_not, key); + while (!endp(a_list)) { + if (TEST((*car_or_cdr)(a_list->c.c_car)) && + a_list->c.c_car != Cnil) { + a_list = a_list->c.c_car; + goto L; + } + a_list = a_list->c.c_cdr; + } + restoreTEST; + @(return a_list) +@) + +LFD(Lassoc)() { car_or_cdr = car; FFN(Lassoc_or_rassoc)(); } +LFD(Lrassoc)() { car_or_cdr = cdr; FFN(Lassoc_or_rassoc)(); } + +static bool true_or_false; + +@(static defun assoc_or_rassoc_predicate (predicate a_list &key key) + object x; +@ + while (!endp(a_list)) { + if (a_list->c.c_car!=Cnil) { + x=(*car_or_cdr)(a_list->c.c_car); + if (key!=Cnil) + x=ifuncall1(key,x); + if ((ifuncall1(predicate,x) != Cnil) == true_or_false) + @(return `a_list->c.c_car`) + } + a_list = a_list->c.c_cdr; + } + @(return a_list) +@) + +LFD(Lassoc_if)() { car_or_cdr = car; true_or_false = TRUE; FFN(Lassoc_or_rassoc_predicate)(); } +LFD(Lassoc_if_not)() { car_or_cdr = car; true_or_false = FALSE; FFN(Lassoc_or_rassoc_predicate)(); } +LFD(Lrassoc_if)() { car_or_cdr = cdr; true_or_false = TRUE; FFN(Lassoc_or_rassoc_predicate)(); } +LFD(Lrassoc_if_not)() { car_or_cdr = cdr; true_or_false = FALSE; FFN(Lassoc_or_rassoc_predicate)(); } + +bool +member_eq(x, l) +object x, l; +{ + + for (; type_of(l) == t_cons; l = l->c.c_cdr) + if (x == l->c.c_car) + return(TRUE); + return(FALSE); +} + +static void +FFN(siLmemq)() +{ + object x, l; + + check_arg(2); + + x = vs_base[0]; + l = vs_base[1]; + + for (; type_of(l) == t_cons; l = l->c.c_cdr) + if (x == l->c.c_car) { + vs_base[0] = l; + vs_popp; + return; + } + + vs_base[0] = Cnil; + vs_popp; +} + +void +delete_eq(x, lp) +object x, *lp; +{ + for (; type_of(*lp) == t_cons; lp = &(*lp)->c.c_cdr) + if ((*lp)->c.c_car == x) { + *lp = (*lp)->c.c_cdr; + return; + } +} + +DEFUN_NEW("STATIC-INVERSE-CONS",object,fSstatic_inverse_cons,SI,1,1,NONE,OI,OO,OO,OO,(fixnum x),"") { + + object y=(object)x; + + return is_imm_fixnum(y) ? Cnil : (is_imm_fixnum(y->c.c_cdr) ? y : (y->d.f||y->d.e ? Cnil : y)); + +} + +void +gcl_init_list_function() +{ + + sKtest = make_keyword("TEST"); + sKtest_not = make_keyword("TEST-NOT"); + sKkey = make_keyword("KEY"); + sKrev = make_keyword("REV"); + + sKinitial_element = make_keyword("INITIAL-ELEMENT"); + + make_function("CAR", Lcar); + make_function("CDR", Lcdr); + + make_function("CAAR", Lcaar); + make_function("CADR", Lcadr); + make_function("CDAR", Lcdar); + make_function("CDDR", Lcddr); + make_function("CAAAR", Lcaaar); + make_function("CAADR", Lcaadr); + make_function("CADAR", Lcadar); + make_function("CADDR", Lcaddr); + make_function("CDAAR", Lcdaar); + make_function("CDADR", Lcdadr); + make_function("CDDAR", Lcddar); + make_function("CDDDR", Lcdddr); + make_function("CAAAAR", Lcaaaar); + make_function("CAAADR", Lcaaadr); + make_function("CAADAR", Lcaadar); + make_function("CAADDR", Lcaaddr); + make_function("CADAAR", Lcadaar); + make_function("CADADR", Lcadadr); + make_function("CADDAR", Lcaddar); + make_function("CADDDR", Lcadddr); + make_function("CDAAAR", Lcdaaar); + make_function("CDAADR", Lcdaadr); + make_function("CDADAR", Lcdadar); + make_function("CDADDR", Lcdaddr); + make_function("CDDAAR", Lcddaar); + make_function("CDDADR", Lcddadr); + make_function("CDDDAR", Lcdddar); + make_function("CDDDDR", Lcddddr); + + make_function("CONS", Lcons); + make_function("TREE-EQUAL", Ltree_equal); + make_function("ENDP", Lendp); + make_function("LIST-LENGTH", Llist_length); + + + make_function("REST", Lcdr); + make_function("NTHCDR", Lnthcdr); + make_function("LAST", Llast); + make_function("LIST", Llist); + make_function("LIST*", LlistA); + make_function("MAKE-LIST", Lmake_list); + make_function("APPEND", Lappend); + make_function("COPY-LIST", Lcopy_list); + make_function("COPY-ALIST", Lcopy_alist); + make_function("COPY-TREE", Lcopy_tree); + make_function("REVAPPEND", Lrevappend); + make_function("NCONC", Lnconc); + make_function("NRECONC", Lreconc); + + make_function("BUTLAST", Lbutlast); + make_function("NBUTLAST", Lnbutlast); + make_function("LDIFF", Lldiff); + make_function("RPLACA", Lrplaca); + make_function("RPLACD", Lrplacd); + /* make_function("SUBST", Lsubst); */ + /* make_function("SUBST-IF", Lsubst_if); */ + /* make_function("SUBST-IF-NOT", Lsubst_if_not); */ + make_function("NSUBST", Lnsubst); + make_function("NSUBST-IF", Lnsubst_if); + make_function("NSUBST-IF-NOT", Lnsubst_if_not); + make_function("SUBLIS", Lsublis); + make_function("NSUBLIS", Lnsublis); + make_function("MEMBER", Lmember); + make_function("MEMBER-IF", Lmember_if); + make_function("MEMBER-IF-NOT", Lmember_if_not); + make_si_function("MEMBER1", Lmember1); + make_function("TAILP", Ltailp); + make_function("ADJOIN", Ladjoin); + + make_function("ACONS", Lacons); + make_function("PAIRLIS", Lpairlis); + make_function("ASSOC", Lassoc); + make_function("ASSOC-IF", Lassoc_if); + make_function("ASSOC-IF-NOT", Lassoc_if_not); + make_function("RASSOC", Lrassoc); + make_function("RASSOC-IF", Lrassoc_if); + make_function("RASSOC-IF-NOT", Lrassoc_if_not); + + make_si_function("MEMQ", siLmemq); + +} diff --git a/o/littleXwin.c b/o/littleXwin.c new file mode 100755 index 0000000..b7d907a --- /dev/null +++ b/o/littleXwin.c @@ -0,0 +1,239 @@ +/**************************************************************/ + +#include +#include /* the X library */ +#include /* the X library */ + + /* a few arbitary constants */ +#define START_X 10 +#define START_Y 20 +#define WINDOW_WIDTH 225 +#define WINDOW_HEIGHT 400 +#define BORDER_WIDTH 1 +#define KEY_STR_LENGTH 20 + +Display *the_display; /* the display that will be used */ +int the_screen; /* the screen that will be used */ +Window root_window; /* the root window on the screen */ +XSizeHints size_hints; /* size hints for the window manager */ +XEvent the_event; /* the structure for the input event */ +XSetWindowAttributes attributes;/* the windows attributes */ + +GC the_solid_GC, + the_clear_GC; /* the graphics contexts */ + +XGCValues the_solid_GC_values, + the_clear_GC_values; + +Colormap cmap; +XFontStruct *the_fontstruct; /* the font info to be used */ + +Window open_window(void) +{ + Window the_window; /* the window that will be opened */ + int i, stop; + + /* Set the display to be the default display (ie, your + display as given in the environment variable DISPLAY). */ + + if ((the_display = XOpenDisplay("")) == NULL) + { + printf("can't open display\n"); + return(-1); + } + + /* A few useful values. */ + + the_screen = DefaultScreen(the_display); + root_window = RootWindow(the_display,the_screen); + + /* Set the size hints for the window manager. */ + + size_hints.x = START_X; + size_hints.y = START_Y; + size_hints.width = WINDOW_WIDTH; + size_hints.height = WINDOW_HEIGHT; + size_hints.flags = PSize|PPosition; + + /* Create a window of fixed size, origin, and borderwidth. + The window will have a black border and white background. */ + + the_window = XCreateSimpleWindow(the_display,root_window, + size_hints.x,size_hints.y,size_hints.width, + size_hints.height,BORDER_WIDTH, + BlackPixel(the_display,the_screen), + WhitePixel(the_display,the_screen)); + + XSetStandardProperties(the_display,the_window,"My Window","My Icon", + None,NULL,NULL,&size_hints); + + cmap = DefaultColormap(the_display, the_screen); + + the_solid_GC = XCreateGC(the_display, the_window, None, &the_solid_GC_values); + the_clear_GC = XCreateGC(the_display, the_window, None, &the_clear_GC_values); + + /* for a sun */ + XSetBackground(the_display, the_solid_GC, BlackPixel(the_display,the_screen)); + XSetForeground(the_display, the_solid_GC, BlackPixel(the_display,the_screen)); + + XSetBackground(the_display, the_clear_GC, WhitePixel(the_display,the_screen)); + XSetForeground(the_display, the_clear_GC, WhitePixel(the_display,the_screen)); + + if ((the_fontstruct = XLoadQueryFont(the_display,"8x13")) == NULL) + { + printf("could not open font\n"); + return(-1); + } + /* Put the font into the graphics context for draw operations. */ + XSetFont(the_display, the_solid_GC, the_fontstruct->fid); + XSetFont(the_display, the_clear_GC, the_fontstruct->fid); + + /* Tell the server to make the window visible. */ + + XMapWindow(the_display,the_window); + + attributes.bit_gravity = NorthWestGravity; + XChangeWindowAttributes(the_display, the_window, CWBitGravity, &attributes); + XFlush(the_display); + return(the_window); +} + +int close_window(Window the_window) +{ + XDestroyWindow(the_display, the_window); + XFlush(the_display); + return(1); +} + +int draw_line(Window the_window, int x1, int y1, int x2, int y2) +{ + XDrawLine(the_display, the_window, the_solid_GC, x1, y1, x2, y2); + XFlush(the_display); + return(1); +} + +int draw_arc(Window the_window, int x, int y, int width, int height, int angle1, int angle2) +{ + XDrawArc(the_display, the_window, the_solid_GC, + x, y, width, height, angle1, angle2); + XFlush(the_display); + return(1); +} + +int fill_arc(Window the_window, int x, int y, int width, int height, int angle1, int angle2) +{ + XFillArc(the_display, the_window, the_solid_GC, + x, y, width, height, angle1, angle2); + XFlush(the_display); + return(1); +} + +int clear_arc(Window the_window, int x, int y, int width, int height, int angle1, int angle2) +{ + XFillArc(the_display, the_window, the_clear_GC, + x, y, width, height, angle1, angle2); + XFlush(the_display); + return(1); +} + +int set_arc_mode (int pie_or_chord) +{ + if (pie_or_chord == 0) { + XSetArcMode(the_display, the_solid_GC, ArcChord); + XSetArcMode(the_display, the_clear_GC, ArcChord); + } + else { + XSetArcMode(the_display, the_solid_GC, ArcPieSlice); + XSetArcMode(the_display, the_clear_GC, ArcPieSlice); + } + return(1); +} + +int erase_line(Window the_window, int x1, int y1, int x2, int y2) +{ + XDrawLine(the_display, the_window, the_clear_GC, x1, y1, x2, y2); + XFlush(the_display); + return(1); +} + +int draw_text(Window the_window, char *string, int x, int y) +{ + XDrawString(the_display, the_window, the_solid_GC, x, y, + string, strlen(string)); + XFlush(the_display); + return(1); +} + +int erase_text(Window the_window, char *string, int x, int y) +{ + XDrawString(the_display, the_window, the_clear_GC, x, y, + string, strlen(string)); + XFlush(the_display); + return(1); +} + +int clear_window(Window the_window) +{ + XClearWindow(the_display, the_window); + XFlush(the_display); + return(1); +} + +int resize_window(Window the_window, int width, int height) +{ + XResizeWindow(the_display, the_window, width, height); + XFlush(the_display); + return(1); +} + +int raise_window(Window the_window) +{ + XRaiseWindow(the_display, the_window); + XFlush(the_display); + return(1); +} + +int use_font (char *font_name) +{ + if ((the_fontstruct = XLoadQueryFont(the_display, font_name)) == NULL) + return(-1); + + /* Put the font into the graphics context for draw operations. */ + XSetFont(the_display, the_solid_GC, the_fontstruct->fid); + XSetFont(the_display, the_clear_GC, the_fontstruct->fid); + XFlush(the_display); + return(1); +} + + + +int set_background (Window the_window, char *color_string) +{ + XColor color; + int result; + + if (result = XParseColor(the_display, cmap, color_string, &color)) { + if (result = XAllocColor(the_display, cmap, &color)) { + XSetWindowBackground(the_display, the_window, color.pixel); + XSetBackground(the_display, the_clear_GC, color.pixel); + XSetForeground(the_display, the_clear_GC, color.pixel); + XFlush(the_display); + } + } + return(result); +} + +int set_foreground (char *color_string) +{ + XColor color; + int result; + + if (result = XParseColor(the_display, cmap, color_string, &color)) { + if (result = XAllocColor(the_display, cmap, &color)) { + XSetForeground(the_display, the_solid_GC, color.pixel); + XSetBackground(the_display, the_solid_GC, color.pixel); + XFlush(the_display); + return(1); + } + } +} diff --git a/o/macros.c b/o/macros.c new file mode 100755 index 0000000..87e5340 --- /dev/null +++ b/o/macros.c @@ -0,0 +1,348 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + macros.c +*/ +#include "include.h" + + +object sLwarn; + +object sSAinhibit_macro_specialA; + +static void +FFN(siLdefine_macro)(void) +{ + check_arg(2); + if (type_of(vs_base[0]) != t_symbol) + not_a_symbol(vs_base[0]); + if (vs_base[0]->s.s_sfdef != NOT_SPECIAL) { + if (vs_base[0]->s.s_mflag) { + if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + vs_base[0]->s.s_sfdef = NOT_SPECIAL; + } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + FEerror("~S, a special form, cannot be redefined.", + 1, vs_base[0]); + } + clear_compiler_properties(vs_base[0],MMcaddr(vs_base[1])); + if (vs_base[0]->s.s_hpack == lisp_package && + vs_base[0]->s.s_gfdef != OBJNULL && !raw_image) { + vs_push(make_simple_string( + "~S is being redefined.")); + ifuncall2(sLwarn, vs_head, vs_base[0]); + vs_popp; + } + vs_base[0]->s.s_gfdef = MMcaddr(vs_base[1]); + vs_base[0]->s.s_mflag = TRUE; + if (MMcar(vs_base[1]) != Cnil) { + vs_base[0]->s.s_plist + = putf(vs_base[0]->s.s_plist, + MMcar(vs_base[1]), + sSfunction_documentation); + } + if (MMcadr(vs_base[1]) != Cnil) { + vs_base[0]->s.s_plist + = putf(vs_base[0]->s.s_plist, + MMcadr(vs_base[1]), + sSpretty_print_format); + } + vs_top = vs_base+1; +} + +static void +FFN(Fdefmacro)(object form) +{ + + object *top = vs_top; + object name; + + if (endp(form) || endp(MMcdr(form))) + FEtoo_few_argumentsF(form); + name = MMcar(form); + if (type_of(name) != t_symbol) + not_a_symbol(name); + vs_push(ifuncall3(sSdefmacroA, + name, + MMcadr(form), + MMcddr(form))); + if (MMcar(top[0]) != Cnil) + name->s.s_plist + = putf(name->s.s_plist, + MMcar(top[0]), + sSfunction_documentation); + if (MMcadr(top[0]) != Cnil) + name->s.s_plist + = putf(name->s.s_plist, + MMcadr(top[0]), + sSpretty_print_format); + if (name->s.s_sfdef != NOT_SPECIAL) { + if (name->s.s_mflag) { + if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + name->s.s_sfdef = NOT_SPECIAL; + } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + FEerror("~S, a special form, cannot be redefined.", + 1, name); + } + clear_compiler_properties(name,MMcaddr(top[0])); + if (name->s.s_hpack == lisp_package && + name->s.s_gfdef != OBJNULL && !raw_image) { + vs_push(make_simple_string( + "~S is being redefined.")); + ifuncall2(sLwarn, vs_head, name); + vs_popp; + } + name->s.s_gfdef = MMcaddr(top[0]); + name->s.s_mflag = TRUE; + vs_base = vs_top = top; + vs_push(name); +} + + +/* + Macros may well need their functional environment to expand properly. + For example setf needs to expand the place which may be a local + macro. They are not supposed to need the other parts of the + environment +*/ +#define VS_PUSH_ENV vs_push(MACRO_EXPAND_ENV) +#define MACRO_EXPAND_ENV \ + (lex_env[1]!= sLnil ? \ + list(3,lex_env[0],lex_env[1],lex_env[2]) : sLnil) + +/* + MACRO_EXPAND1 is an internal function which simply applies the + function EXP_FUN to FORM. On return, the expanded form is stored + in VS_BASE[0]. +*/ +object +Imacro_expand1(object exp_fun, object form) +{ + return Ifuncall_n(sLAmacroexpand_hookA->s.s_dbind, + 3,exp_fun,form,MACRO_EXPAND_ENV); +} + +/* + MACRO_DEF is an internal function which, given a form, returns + the expansion function if the form is a macro form. Otherwise, + MACRO_DEF returns NIL. +*/ +static object +macro_def(object form) +{ + object head, fd; + + if (type_of(form) != t_cons) + return(Cnil); + head = MMcar(form); + if (type_of(head) != t_symbol) + return(Cnil); + fd = lex_fd_sch(head); + if (MMnull(fd)) + if (head->s.s_mflag) + return(head->s.s_gfdef); + else + return(Cnil); + else if (MMcadr(fd) == sSmacro) + return(MMcaddr(fd)); + else + return(Cnil); +} + +DEFUNOM_NEW("MACROEXPAND",object,fLmacroexpand,LISP + ,1,2,NONE,OO,OO,OO,OO,void,Lmacroexpand,(object form,...),"") +{ int n=VFUN_NARGS; + object envir; + object exp_fun; + object *lex=lex_env; + object buf[3]; + + va_list ap; + { va_start(ap,form); + if (n>=2) envir=va_arg(ap,object);else goto LDEFAULT2; + goto LEND_VARARG; + LDEFAULT2: envir = Cnil; + LEND_VARARG: va_end(ap);} + + lex_env = buf; + if (n== 1) {buf[0]=sLnil; + buf[1]=sLnil; + buf[2]=sLnil; + } + else if (n==2) + { buf[0]=car(envir); + envir=Mcdr(envir); + buf[1]=car(envir); + envir=Mcdr(envir); + buf[2]=car(envir); + } + else check_arg_range(1,2); + + exp_fun = macro_def(form); + + if (MMnull(exp_fun)) { + lex_env = lex; + RETURN(2,object,form,(RV(sLnil))); + } + else + { + object *top = vs_top; + do { + form= Imacro_expand1(exp_fun, form); + vs_top = top; + exp_fun = macro_def(form); + } while (!MMnull(exp_fun)); + lex_env = lex; + RETURN(2,object,form,(RV(sLt))); + } +} + +LFD(Lmacroexpand_1)(void) +{ + object exp_fun; + object *base=vs_base; + object *lex=lex_env; + + lex_env = vs_top; + if (vs_top-vs_base<1) + too_few_arguments(); + else if (vs_top-vs_base == 1) { + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + } else if (vs_top-vs_base == 2) { + vs_push(car(vs_base[1])); + vs_push(car(cdr(vs_base[1]))); + vs_push(car(cdr(cdr(vs_base[1])))); + } else + too_many_arguments(); + exp_fun = macro_def(base[0]); + if (MMnull(exp_fun)) { + lex_env = lex; + vs_base = base; + vs_top = base+1; + vs_push(Cnil); + } else { + base[0]=Imacro_expand1(exp_fun, base[0]); + lex_env = lex; + vs_base = base; + vs_top = base+1; + vs_push(Ct); + } +} + +/* + MACRO_EXPAND is an internal function which, given a form, expands it + as many times as possible and returns the finally expanded form. + The argument 'form' need not be marked for GBC and the result is not + marked. +*/ +object +macro_expand(object form) +{ + object exp_fun, head, fd; + object *base = vs_base; + object *top = vs_top; + + /* Check if the given form is a macro form. If not, return + immediately. Macro definitions are superseded by special- + form definitions. + */ + if (type_of(form) != t_cons) + return(form); + head = MMcar(form); + if (type_of(head) != t_symbol) + return(form); + if (head->s.s_sfdef != NOT_SPECIAL) + return(form); + fd = lex_fd_sch(head); + if (MMnull(fd)) + if (head->s.s_mflag) + exp_fun = head->s.s_gfdef; + else + return(form); + else if (MMcadr(fd) == sSmacro) + exp_fun = MMcaddr(fd); + else + return(form); + + vs_top = top; + vs_push(form); /* saves form in top[0] */ + vs_push(exp_fun); /* saves exp_fun in top[1] */ +LOOP: + /* macro_expand1(exp_fun, form); */ + vs_base = vs_top; + vs_push(exp_fun); + vs_push(form); +/***/ +/* vs_push(Cnil); */ + VS_PUSH_ENV ; +/***/ + super_funcall(symbol_value(sLAmacroexpand_hookA)); + if (vs_base == vs_top) + vs_push(Cnil); + top[0] = form = vs_base[0]; + /* Check if the expanded form is again a macro form. If not, + reset the stack and return. + */ + if (type_of(form) != t_cons) + goto END; + head = MMcar(form); + if (type_of(head) != t_symbol) + goto END; + if (head->s.s_sfdef != NOT_SPECIAL) + goto END; + fd=lex_fd_sch(head); + if (MMnull(fd)) + if (head->s.s_mflag) + exp_fun = head->s.s_gfdef; + else + goto END; + else if (MMcadr(fd) == sSmacro) + exp_fun = MMcaddr(fd); + else + goto END; + /* The expanded form is a macro form. Continue expansion. */ + top[1] = exp_fun; + vs_top = top + 2; + goto LOOP; +END: + vs_base = base; + vs_top = top; + return(form); +} + +DEF_ORDINARY("FUNCALL",sLfuncall,LISP,""); +DEFVAR("*MACROEXPAND-HOOK*",sLAmacroexpand_hookA,LISP,sLfuncall,""); +DEF_ORDINARY("DEFMACRO*",sSdefmacroA,SI,""); +DEFVAR("*INHIBIT-MACRO-SPECIAL*",sSAinhibit_macro_specialA,SI,Cnil,""); +void +gcl_init_macros(void) +{ + make_si_function("DEFINE-MACRO", siLdefine_macro); + + + make_function("MACROEXPAND-1", Lmacroexpand_1); + make_special_form("DEFMACRO", Fdefmacro); + + + +} diff --git a/o/main.c b/o/main.c new file mode 100755 index 0000000..a246d08 --- /dev/null +++ b/o/main.c @@ -0,0 +1,1341 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + main.c + IMPLEMENTATION-DEPENDENT +*/ + +#include +#include +#include +#include +#include +#include + +static void +init_main(void); + +static void +initlisp(void); + +static int +multiply_stacks(int); + +#ifdef KCLOVM +#include +void change_contexts(); +int ovm_process_created; +void initialize_process(); +#endif + + +#define EXTER +#define INLINE + + +#include "include.h" +#include +#include "page.h" + +bool saving_system=FALSE; + +#ifdef BSD +#include +#ifndef SGI +#include +#endif +#endif + +#ifdef AOSVS + +#endif + +#ifdef _WIN32 +#include +#endif + +#define LISP_IMPLEMENTATION_VERSION "April 1994" + +char *system_directory; + +#define EXTRA_BUFSIZE 8 +char stdin_buf[BUFSIZ + EXTRA_BUFSIZE]; +char stdout_buf[BUFSIZ + EXTRA_BUFSIZE]; +char stderr_buf[BUFSIZ + EXTRA_BUFSIZE]; + +#include "stacks.h" + +int debug; /* debug switch */ +int raw_image = TRUE; /* raw or saved image -- CYGWIN will only place this in .data and not in .bss if initialized to non-zero */ +bool GBC_enable=FALSE; + +long real_maxpage; +object sSAlisp_maxpagesA; + +object siClisp_pagesize; + +object sStop_level; + + +object sSAmultiply_stacksA; +int stack_multiple=1; +static object stack_space; + +#ifdef _WIN32 +unsigned int _dbegin = 0x10100000; +#endif +#ifdef __CYGWIN__ +unsigned long _dbegin = 0; +#endif + +#ifdef SGC +int sgc_enabled; +#endif +void install_segmentation_catcher(void); + +int +cstack_dir(fixnum j) { + static fixnum n; + if (!n) { + n=1; + return cstack_dir((fixnum)&j); + } + return (fixnum)&jMAX_BRK) return -1; +#endif + + if (uv + +static ufixnum +get_phys_pages_no_malloc(char n) { + + MEMORYSTATUS m; + + m.dwLength=sizeof(m); + GlobalMemoryStatus(&m); + return m.dwTotalPhys>>PAGEWIDTH; + +} + +#elif defined (DARWIN) + +#include + +static ufixnum +get_phys_pages_no_malloc(char n) { + + uint64_t s; + size_t z=sizeof(s); + int m[2]={CTL_HW,HW_MEMSIZE}; + + if (sysctl(m,2,&s,&z,NULL,0)==0) + return s>>PAGEWIDTH; + + return 0; + +} + +#elif defined(__sun__) || defined(__GNU__) + +static ufixnum +get_phys_pages_no_malloc(char n) { + + return sysconf(_SC_PHYS_PAGES); + +} + +#elif defined(FREEBSD) + +#include +#include + +static ufixnum +get_phys_pages_no_malloc(char n) { + + size_t i,len=sizeof(i); + + return (sysctlbyname("hw.physmem",&i,&len,NULL,0) ? 0 : i)>>PAGEWIDTH; + +} + +#else /*Linux*/ + +#include + +static ufixnum +get_phys_pages_no_malloc(char freep) { + + struct sysinfo s; + + return sysinfo(&s) ? 0 : ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; + +} + +#endif + +static ufixnum +get_phys_pages1(char freep) { + + return get_phys_pages_no_malloc(freep); + +} + +static void +get_gc_environ(void) { + + const char *e; + + mem_multiple=1.0; + if ((e=getenv("GCL_MEM_MULTIPLE"))) { + massert(sscanf(e,"%lf",&mem_multiple)==1); + massert(mem_multiple>=0.0); + } + + gc_alloc_min=0.05; + if ((e=getenv("GCL_GC_ALLOC_MIN"))) { + massert(sscanf(e,"%lf",&gc_alloc_min)==1); + massert(gc_alloc_min>=0.0); + } + + gc_page_min=0.5; + if ((e=getenv("GCL_GC_PAGE_MIN"))||(e=getenv("GCL_GC_PAGE_THRESH"))) {/*legacy support*/ + massert(sscanf(e,"%lf",&gc_page_min)==1); + massert(gc_page_min>=0.0); + } + + gc_page_max=0.75; + if ((e=getenv("GCL_GC_PAGE_MAX"))) { + massert(sscanf(e,"%lf",&gc_page_max)==1); + massert(gc_page_max>=0.0); + } + + multiprocess_memory_pool= + (e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && (*e=='t' || *e=='T'); + + wait_on_abort=0; + if ((e=getenv("GCL_WAIT_ON_ABORT"))) + massert(sscanf(e,"%lu",&wait_on_abort)==1); + +} + +static void +setup_maxpages(double scale) { + + void *beg=data_start ? data_start : sbrk(0); + ufixnum maxpages=real_maxpage-page(beg),npages,i; + + for (npages=0,i=t_start;i=npages); + + maxpages*=scale; + phys_pages*=scale; + real_maxpage=maxpages+page(beg); + + resv_pages=available_pages=0; + available_pages=check_avail_pages(); + + resv_pages=available_pages/100; + available_pages-=resv_pages; + + recent_allocation=0; + +} + +void *initial_sbrk=NULL; + +int +update_real_maxpage(void) { + + ufixnum i,j; + void *end,*cur,*beg; +#ifdef __MINGW32__ + static fixnum n; + + if (!n) { + init_shared_memory(); + n=1; + } +#endif + +#ifdef DEFINED_REAL_MAXPAGE + real_maxpage=DEFINED_REAL_MAXPAGE; +#else + massert(cur=sbrk(0)); + beg=data_start ? data_start : cur; + for (i=0,j=(1L<PAGESIZE;j>>=1) + if ((end=beg+i+j-PAGESIZE)>cur) + if (!mbrk(end)) { + real_maxpage=page(end); + i+=j; + } + massert(!mbrk(cur)); +#endif + + phys_pages=ufmin(get_phys_pages1(0)+page(beg),real_maxpage)-page(beg); + + get_gc_environ(); + setup_maxpages(mem_multiple); + + return 0; + +} + +static int +minimize_image(void) { + + fixnum i; + + empty_relblock(); + nrbpage=0; + resize_hole(0,t_relocatable,0); + + gprof_cleanup(); + +#if defined(BSD) || defined(ATT) + mbrk(core_end=heap_end); +#endif + + cbgbccount = tm_table[t_contiguous].tm_adjgbccnt = tm_table[t_contiguous].tm_opt_maxpage = 0; + rbgbccount = tm_table[t_relocatable].tm_adjgbccnt = tm_table[t_relocatable].tm_opt_maxpage = 0; + for (i = 0; i < (int)t_end; i++) + tm_table[i].tm_gbccount = tm_table[i].tm_adjgbccnt = tm_table[i].tm_opt_maxpage = 0; + + return 0; + +} + +DEFUN_NEW("SET-LOG-MAXPAGE-BOUND",object,fSset_log_maxpage_bound,SI,1,1,NONE,II,OO,OO,OO,(fixnum l),"") { + + void *end,*dend; + fixnum def=sizeof(fixnum)*8-1; + + l=l= dend) { + minimize_image(); + log_maxpage_bound=l;/*FIXME maybe this should be under mem_multiple, not over*/ + update_real_maxpage(); + maybe_set_hole_from_maxpages(); + } + + return (object)log_maxpage_bound; + +} + +#ifdef NEED_STACK_CHK_GUARD + +unsigned long __stack_chk_guard=0; + +static unsigned long +random_ulong() { + + object y; + + vs_top=vs_base; + vs_push(Ct); + Lmake_random_state(); + y=vs_pop; + vs_push(number_negate(find_symbol(make_simple_string("MOST-NEGATIVE-FIXNUM"),system_package)->s.s_dbind)); + vs_push(y); + Lrandom(); + + return fixint(vs_pop); + +} +#endif + +#ifdef HAVE_MPROTECT +#include +int +gcl_mprotect(void *v,unsigned long l,int p) { + + int i; + char b[80]; + + if ((i=mprotect(v,l,p))) { + snprintf(b,sizeof(b),"mprotect failure: %p %lu %d\b",v,l,p); + perror(b); + } + + return i; + +} +#endif + +DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); + +#define HAVE_GCL_CLEANUP + +void +gcl_cleanup(int gc) { + + if (getenv("GCL_WAIT")) + sleep(30); + +#if defined(USE_CLEANUP) + {extern void _cleanup(void);_cleanup();} +#endif + + gprof_cleanup(); + + if (gc) { + + saving_system=TRUE; + GBC(t_other); + saving_system=FALSE; + + minimize_image(); + + raw_image=FALSE; + cs_org=0; + initial_sbrk=core_end; + + } + + close_pool(); + +} + +/*gcc boolean expression tail position bug*/ +static char *stack_to_be_allocated; + +int +stack_ret(char *s,unsigned long size) { + int r,i; + for (i=r=0;i1); + for (s=NULL;(s=strtok(s ? NULL : FN1,":"));) { + + massert(snprintf(FN2,sizeof(FN2),"%s/%s",s,n)); + if (mbin(FN2,o)) + return 1; + + } + + return 0; + +} + +#endif + +static int ARGC; +static char **ARGV; + +int +main(int argc, char **argv, char **envp) { + + GET_FULL_PATH_SELF(kcl_self); + *argv=kcl_self; + +#ifdef CAN_UNRANDOMIZE_SBRK +#include +#include +#include "unrandomize.h" +#endif + + gcl_init_alloc(alloca(1)); + + setbuf(stdin, stdin_buf); + setbuf(stdout, stdout_buf); + setbuf(stderr, stderr_buf); +#ifdef _WIN32 + _fmode = _O_BINARY; + _setmode( _fileno( stdin ), _O_BINARY ); + _setmode( _fileno( stdout ), _O_BINARY ); + _setmode( _fileno( stderr ), _O_BINARY ); +#endif + ARGC = argc; + ARGV = argv; + + vs_top = vs_base = vs_org; + ihs_top = ihs_org-1; + bds_top = bds_org-1; + frs_top = frs_org-1; + + if (raw_image) { + + printf("GCL (GNU Common Lisp) %s %ld pages\n",LISP_IMPLEMENTATION_VERSION,real_maxpage); + fflush(stdout); + + if (ARGC>1) { + massert(ARGV[1][strlen(ARGV[1])-1]=='/'); + system_directory=ARGV[1]; + } + + initlisp(); + lex_new(); + + GBC_enable = TRUE; + + gcl_init_init(); + + sLApackageA->s.s_dbind = user_package; + + } else { + + terminal_io->sm.sm_object0->sm.sm_fp = stdin; + terminal_io->sm.sm_object1->sm.sm_fp = stdout; + standard_error->sm.sm_fp = stderr; + + gcl_init_big1(); +#ifdef USE_READLINE + gcl_init_readline_function(); +#endif +#ifdef NEED_STACK_CHK_GUARD + __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/ +#endif + + } + + sSAlisp_maxpagesA->s.s_dbind = make_fixnum(real_maxpage); + + ihs_push(Cnil); + lex_new(); + vs_base = vs_top; + + interrupt_enable = TRUE; + install_default_signals(); + + do + super_funcall(sStop_level); + while (type_of(sSAmultiply_stacksA->s.s_dbind)==t_fixnum && multiply_stacks(fix(sSAmultiply_stacksA->s.s_dbind))); + + return 0; + +} + +/* catch certain signals */ +void install_segmentation_catcher(void) +{ + unblock_signals(SIGSEGV,SIGSEGV); + unblock_signals(SIGBUS,SIGBUS); + (void) gcl_signal(SIGSEGV,segmentation_catcher); + (void) gcl_signal(SIGBUS,segmentation_catcher); +} + +void +do_gcl_abort(void) { + if (wait_on_abort) + sleep(wait_on_abort); + gcl_cleanup(0); + abort(); +} + +int catch_fatal=1; +void +error(char *s) +{ + if (catch_fatal>0 && interrupt_enable ) + {catch_fatal = -1; +#ifdef SGC + if (sgc_enabled) + { sgc_quit();} + if (sgc_enabled==0) +#endif + { install_segmentation_catcher() ;} + FEerror("Caught fatal error [memory may be damaged]",0); } + printf("\nUnrecoverable error: %s.\n", s); + fflush(stdout); + do_gcl_abort(); +} + +static void +initlisp(void) { + + void *v=&v; + + if (NULL_OR_ON_C_STACK(v) == 0 +#if defined(IM_FIX_BASE) + || NULL_OR_ON_C_STACK(IM_FIX_BASE) == 0 + || NULL_OR_ON_C_STACK((IM_FIX_BASE|IM_FIX_LIM)) == 0 +#endif + /* || NULL_OR_ON_C_STACK(vv) */ + || NULL_OR_ON_C_STACK(pagetoinfo(first_data_page)) + || NULL_OR_ON_C_STACK(core_end-1)) { + /* check person has correct definition of above */ + emsg("%p %d " +#if defined(IM_FIX_BASE) + "%p %d %p %d " +#endif + "%p %d %p %d\n", + v,NULL_OR_ON_C_STACK(v), +#if defined(IM_FIX_BASE) + (void *)IM_FIX_BASE,NULL_OR_ON_C_STACK(IM_FIX_BASE), + (void *)(IM_FIX_BASE|IM_FIX_LIM),NULL_OR_ON_C_STACK(IM_FIX_BASE|IM_FIX_LIM), +#endif + pagetoinfo(first_data_page),NULL_OR_ON_C_STACK(pagetoinfo(first_data_page)), + core_end-1,NULL_OR_ON_C_STACK(core_end-1)); + error("NULL_OR_ON_C_STACK macro invalid"); + } + + Cnil->fw=0; + set_type_of(Cnil,t_symbol); + Cnil->c.c_cdr=Cnil; + Cnil_body.s.s_dbind = Cnil; + Cnil_body.s.s_sfdef = NOT_SPECIAL; + Cnil_body.s.s_fillp = 3; + Cnil_body.s.s_self = "NIL"; + Cnil_body.s.s_gfdef = OBJNULL; + Cnil_body.s.s_plist = Cnil; + Cnil_body.s.s_hpack = Cnil; + Cnil_body.s.s_stype = (short)stp_constant; + Cnil_body.s.s_mflag = FALSE; + + Ct->fw=0; + set_type_of(Ct,t_symbol); + Ct_body.s.s_dbind = Ct; + Ct_body.s.s_sfdef = NOT_SPECIAL; + Ct_body.s.s_fillp = 1; + Ct_body.s.s_self = "T"; + Ct_body.s.s_gfdef = OBJNULL; + Ct_body.s.s_plist = Cnil; + Ct_body.s.s_hpack = Cnil; + Ct_body.s.s_stype = (short)stp_constant; + Ct_body.s.s_mflag = FALSE; + + gcl_init_symbol(); + + gcl_init_package(); + + Cnil->s.s_hpack = lisp_package; + import(Cnil, lisp_package); + export(Cnil, lisp_package); + + Ct->s.s_hpack = lisp_package; + import(Ct, lisp_package); + export(Ct, lisp_package); + + sLlambda = make_ordinary("LAMBDA"); + sSlambda_block = make_si_ordinary("LAMBDA-BLOCK"); + sSlambda_closure = make_si_ordinary("LAMBDA-CLOSURE"); + sSlambda_block_closure = make_si_ordinary("LAMBDA-BLOCK-CLOSURE"); + sLspecial = make_ordinary("SPECIAL"); + + + NewInit(); + gcl_init_typespec(); + gcl_init_number(); + gcl_init_character(); + + gcl_init_read(); + gcl_init_bind(); + gcl_init_pathname(); + gcl_init_print(); + gcl_init_GBC(); + + gcl_init_unixfasl(); + gcl_init_unixsys(); + gcl_init_unixsave(); + + gcl_init_alloc_function(); + gcl_init_array_function(); + gcl_init_character_function(); + gcl_init_file_function(); + gcl_init_list_function(); + gcl_init_package_function(); + gcl_init_pathname_function(); + gcl_init_predicate_function(); + gcl_init_print_function(); + gcl_init_read_function(); + gcl_init_sequence_function(); +#if defined(KCLOVM) || defined(RUN_PROCESS) + gcl_init_socket_function(); +#endif + gcl_init_structure_function(); + gcl_init_string_function(); + gcl_init_symbol_function(); + gcl_init_typespec_function(); + gcl_init_hash(); + gcl_init_cfun(); + + gcl_init_unixfsys(); + gcl_init_unixtime(); + gcl_init_eval(); + gcl_init_lex(); + gcl_init_prog(); + gcl_init_catch(); + gcl_init_block(); + gcl_init_macros(); + gcl_init_conditional(); + gcl_init_reference(); + gcl_init_assignment(); + gcl_init_multival(); + gcl_init_error(); + gcl_init_let(); + gcl_init_mapfun(); + gcl_init_iteration(); + gcl_init_toplevel(); + + gcl_init_cmpaux(); + + init_main(); + + gcl_init_format(); + gcl_init_links(); + + gcl_init_fat_string(); + gcl_init_sfasl(); +#ifdef CMAC + gcl_init_cmac(); +#endif +#ifdef USE_READLINE + gcl_init_readline(); +#endif + +} +object +vs_overflow(void) +{ + if (vs_limit > vs_org + stack_multiple * VSSIZE) + error("value stack overflow"); + vs_limit += STACK_OVER*VSGETA; + FEerror("Value stack overflow.", 0); + return Cnil; +} + +void +bds_overflow(void) { + --bds_top; + if (bds_limit > bds_org + stack_multiple * BDSSIZE) { + error("bind stack overflow"); + } + bds_limit += STACK_OVER *BDSGETA; + FEerror("Bind stack overflow.", 0); +} + +void +frs_overflow(void) { + --frs_top; + if (frs_limit > frs_org + stack_multiple * FRSSIZE) + error("frame stack overflow"); + frs_limit += STACK_OVER* FRSGETA; + FEerror("Frame stack overflow.", 0); +} + +void +ihs_overflow(void) { + --ihs_top; + if (ihs_limit > ihs_org + stack_multiple * IHSSIZE) + error("invocation history stack overflow"); + ihs_limit += STACK_OVER*IHSGETA; + FEerror("Invocation history stack overflow.", 0); +} + +void +segmentation_catcher(int i) { + error("Segmentation violation."); +} + +/* static void */ +/* cs_overflow(void) { */ +/* #ifdef AV */ +/* if (cs_limit < cs_org - cssize) */ +/* error("control stack overflow"); */ +/* cs_limit -= CSGETA; */ +/* #endif */ +/* #ifdef MV */ + + + +/* #endif */ +/* FEerror("Control stack overflow.", 0); */ +/* } */ + +/* static void */ +/* end_of_file(void) { */ +/* error("end of file"); */ +/* } */ + +DEFUNO_NEW("BYE",object,fSbye,SI + ,0,1,NONE,OO,OO,OO,OO,void,Lby,(object exitc),"") +{ int n=VFUN_NARGS; + int exit_code; + if (n>=1) exit_code=fix(exitc);else exit_code=0; + +/* printf("Bye.\n"); */ + exit(exit_code); + +} + + +DEFUN_NEW("QUIT",object,fSquit,SI + ,0,1,NONE,OO,OO,OO,OO,(object exitc),"") +{ return FFN(fSbye)(exitc); } + +/* DEFUN_NEW("EXIT",object,fLexit,LISP */ +/* ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */ +/* { return fLbye(exitc); } */ + + +/* c_trace(void) */ +/* { */ +/* #ifdef AOSVS */ + +/* #endif */ +/* } */ + +static void +FFN(siLargc)(void) { + check_arg(0); + vs_push(make_fixnum(ARGC)); +} + +static void +FFN(siLargv)(void) { + int i=0; + + check_arg(1); + if (type_of(vs_base[0]) != t_fixnum || + (i = fix(vs_base[0])) < 0 || + i >= ARGC) + FEerror("Illegal argument index: ~S.", 1, vs_base[0]); + vs_base[0] = make_simple_string(ARGV[i]); + +} + +static void +FFN(siLgetenv)(void) { + + char name[256]; + int i; + char *value; + extern char *getenv(const char *); + + check_arg(1); + check_type_string(&vs_base[0]); + if (vs_base[0]->st.st_fillp >= 256) + FEerror("Too long name: ~S.", 1, vs_base[0]); + for (i = 0; i < vs_base[0]->st.st_fillp; i++) + name[i] = vs_base[0]->st.st_self[i]; + name[i] = '\0'; + if ((value = getenv(name)) != NULL) + {vs_base[0] = make_simple_string(value); +#ifdef FREE_GETENV_RESULT + free(value); + +#endif + } + else + vs_base[0] = Cnil; + +} + +object *vs_marker; + +static void +FFN(siLmark_vs)(void) { + check_arg(0); + vs_marker = vs_base; + vs_base[0] = Cnil; +} + +static void +FFN(siLcheck_vs)(void) { + check_arg(0); + if (vs_base != vs_marker) + FEerror("Value stack is flawed.", 0); + vs_base[0] = Cnil; +} + +static object +FFN(siLcatch_fatal)(int i) { + catch_fatal=i; + return Cnil; +} + +LFD(siLreset_stack_limits)(void) +{ + long i=0; + + check_arg(0); + if(catch_fatal <0) catch_fatal=1; +#ifdef SGC + {extern int fault_count ; fault_count = 0;} +#endif + if (vs_top < vs_org + stack_multiple * VSSIZE) + vs_limit = vs_org + stack_multiple * VSSIZE; + else + error("can't reset vs_limit"); + if (bds_top < bds_org + stack_multiple * BDSSIZE) + bds_limit = bds_org + stack_multiple * BDSSIZE; + else + error("can't reset bds_limit"); + if (frs_top < frs_org + stack_multiple * FRSSIZE) + frs_limit = frs_org + stack_multiple * FRSSIZE; + else + error("can't reset frs_limit"); + if (ihs_top < ihs_org + stack_multiple * IHSSIZE) + ihs_limit = ihs_org + stack_multiple * IHSSIZE; + else + error("can't reset ihs_limit"); + if (cs_base==cs_org) + cs_org=(void *)&i; +#ifdef __ia64__ + { + extern void * GC_save_regs_in_stack(); + if (cs_base2==cs_org2) + cs_org2=GC_save_regs_in_stack(); + } +#endif + /* reset_cstack_limit(i); */ + vs_base[0] = Cnil; +} + +#define COPYSTACK(org,p,typ,lim,top,geta,size) \ + {unsigned long topl=top-org;\ + bcopy(org,p,(lim-org)*sizeof(typ));\ + org=p;\ + top=org+topl;\ + lim=org+stack_multiple*size;\ + p=lim+(STACK_OVER+1)*geta;\ + } + +static int +multiply_stacks(int m) { + void *p; + int vs,bd,frs,ihs; + stack_multiple=stack_multiple*m; +#define ELTSIZE(x) (((char *)((x)+1)) - ((char *) x)) + vs = (stack_multiple*VSSIZE + (STACK_OVER+1)*VSGETA)* ELTSIZE(vs_org); + bd = (stack_multiple*BDSSIZE + (STACK_OVER+1)*BDSGETA)*ELTSIZE(bds_org); + frs = (stack_multiple*FRSSIZE + (STACK_OVER+1)*FRSGETA)*ELTSIZE(frs_org); + ihs = (stack_multiple*IHSSIZE + (STACK_OVER+1)*IHSGETA)*ELTSIZE(ihs_org); + if (stack_space==0) {enter_mark_origin(&stack_space);} + stack_space = alloc_simple_string(vs+bd+frs+ihs); + array_allocself(stack_space,1,code_char(0)); + p=stack_space->st.st_self; + COPYSTACK(vs_org,p,object,vs_limit,vs_top,VSGETA,VSSIZE); + COPYSTACK(bds_org,p,struct bds_bd,bds_limit,bds_top,BDSGETA,BDSSIZE); + COPYSTACK(frs_org,p,struct frame,frs_limit,frs_top,FRSGETA,FRSSIZE); + COPYSTACK(ihs_org,p,struct invocation_history,ihs_limit,ihs_top, + IHSGETA,IHSSIZE); + vs_base=vs_top; + return stack_multiple; +} + +DEFVAR("*NO-INIT*",sSAno_initA,SI,Cnil,""); + +LFD(siLinit_system)(void) { + check_arg(0); + gcl_init_system(sSAno_initA); + vs_base[0] = Cnil; +} + +static void +FFN(siLuser_init)(void) { + check_arg(0); + sLApackageA->s.s_dbind = user_package; + user_init(); + vs_base[0] = Cnil; +} + +/* static void */ +/* FFN(siLaddress)(void) { */ +/* check_arg(1); */ +/* vs_base[0] = make_fixnum((long)vs_base[0]); */ +/* } */ + +DEFUN_NEW("NANI",object,fSnani,SI,1,1,NONE,OI,OO,OO,OO,(fixnum address),"") { + + RETURN1((object)address); + +} + +DEFUN_NEW("ADDRESS",object,fSaddress,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + + RETURN1(x); + +} + +/* static void */ +/* FFN(siLnani)(void) { */ +/* check_arg(1); */ + +/* switch (type_of(vs_base[0])) { */ +/* case t_fixnum: */ +/* vs_base[0]=(object)fix(vs_base[0]); */ +/* break; */ +/* default: */ +/* FEerror("Cannot coerce ~s to an address",1,vs_base[0]); */ +/* } */ + +/* } */ + +static void +FFN(siLinitialization_failure)(void) { + check_arg(0); + printf("lisp initialization failed\n"); + do_gcl_abort(); +} + +DEFUNO_NEW("IDENTITY",object,fLidentity,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lidentity,(object x0),"") +{ + /* 1 args */ + RETURN1 (x0); +} + +DEFUNO_NEW("LDB1",object,fSldb1,SI + ,3,3,NONE,OI,II,OO,OO,void,Lldb1,(fixnum a,fixnum b, fixnum c),"") +{ + RETURN1 (make_fixnum(((((~(-1 << (a))) << (b)) & (c)) >> (b)))); +} + +DEFUN_NEW("LISP-IMPLEMENTATION-VERSION",object,fLlisp_implementation_version,LISP + ,0,0,NONE,OO,OO,OO,OO,(void),"") +{ + /* 0 args */ + RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); +} + +static void +FFN(siLsave_system)(void) { + +#ifdef HAVE_YP_UNBIND + extern object truename(),namestring(); + check_arg(1); + /* prevent subsequent consultation of yp by getting + truename now*/ + vs_base[0]=namestring(truename(vs_base[0])); + {char name[200]; + char *dom = name; + if (0== getdomainname(dom,sizeof(name))) + yp_unbind(dom);} +#endif + +#ifdef DO_BEFORE_SAVE + DO_BEFORE_SAVE +#endif + + siLsave(); + +} + +DEFVAR("*LISP-MAXPAGES*",sSAlisp_maxpagesA,SI,make_fixnum(real_maxpage),""); +DEFVAR("*SYSTEM-DIRECTORY*",sSAsystem_directoryA,SI,make_simple_string(system_directory),""); +DEFVAR("*MULTIPLY-STACKS*",sSAmultiply_stacksA,SI,Cnil,""); +DEF_ORDINARY("TOP-LEVEL",sStop_level,SI,""); +DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA,SI,sLnil,""); + +static void +init_main(void) { + + make_si_function("BY", Lby); + make_si_function("ARGC", siLargc); + make_si_function("ARGV", siLargv); + + make_si_function("GETENV", siLgetenv); + + make_si_function("MARK-VS", siLmark_vs); + make_si_function("CHECK-VS", siLcheck_vs); + make_si_function("RESET-STACK-LIMITS", siLreset_stack_limits); + make_si_function("INIT-SYSTEM", siLinit_system); + make_si_function("USER-INIT", siLuser_init); + /* make_si_function("ADDRESS", siLaddress); */ + /* make_si_function("NANI", siLnani); */ + make_si_function("INITIALIZATION-FAILURE", + siLinitialization_failure); + + siClisp_pagesize = + make_si_constant("LISP-PAGESIZE", make_fixnum(PAGESIZE)); + + + {object features; + +#define ADD_FEATURE(name) \ + features= make_cons(make_keyword(name),features) + + features= make_cons(make_keyword("COMMON"), + make_cons(make_keyword("KCL"), Cnil)); + ADD_FEATURE("AKCL"); + ADD_FEATURE("GCL"); +#ifdef BROKEN_O4_OPT + ADD_FEATURE("BROKEN_O4_OPT"); +#endif +#ifdef GMP + ADD_FEATURE("GMP"); +#endif +#ifdef GCL_GPROF + ADD_FEATURE("GPROF"); +#endif + +#ifndef _WIN32 + ADD_FEATURE("UNIX"); +#endif + +#ifdef _WIN32 + ADD_FEATURE("WINNT"); + ADD_FEATURE("WIN32"); +#endif + +#if defined(__CYGWIN__) + ADD_FEATURE("CYGWIN"); +#endif + +#ifdef IEEEFLOAT + ADD_FEATURE("IEEE-FLOATING-POINT"); +#endif +#ifdef SGC + ADD_FEATURE("SGC"); +#endif +/* #ifdef ADDITIONAL_FEATURES */ +/* ADDITIONAL_FEATURES; */ +/* #endif */ + ADD_FEATURE(HOST_CPU); + ADD_FEATURE(HOST_KERNEL); +#ifdef HOST_SYSTEM + ADD_FEATURE(HOST_SYSTEM); +#endif +#ifdef BSD + ADD_FEATURE("BSD"); +#endif + +#if !defined(DOUBLE_BIGENDIAN) + ADD_FEATURE("CLX-LITTLE-ENDIAN"); +#endif + +#ifndef PECULIAR_MACHINE +#define BIGM (int)((((unsigned int)(-1))/2)) + { +/* int ONEM = -1; */ + int Bigm = BIGM; + int Smallm = -BIGM-1; + int Seven = 7; + int Three = 3; + if ( (Smallm / Seven) < 0 + && (Smallm / (-Seven)) > 0 + && (Bigm / (-Seven)) < 0 + && ((-Seven) / Three) == -2 + && (Seven / (-Three)) == -2 + && ((-Seven)/ (-Three)) == 2) + { ADD_FEATURE("TRUNCATE_USE_C"); + } } +#endif + +#ifdef USE_READLINE +#ifdef READLINE_IS_EDITLINE + ADD_FEATURE("EDITLINE"); +#else + ADD_FEATURE("READLINE"); +#endif +#endif +#if !defined(USE_DLOPEN) + ADD_FEATURE("NATIVE-RELOC"); +#if defined(HAVE_LIBBFD) + ADD_FEATURE("BFD"); +#endif +#endif + ADD_FEATURE("UNEXEC"); +#ifdef HAVE_XGCL + ADD_FEATURE("XGCL"); +#endif + +#ifdef HAVE_GNU_LD + ADD_FEATURE("GNU-LD"); +#endif + +#ifdef STATIC_LINKING + ADD_FEATURE("STATIC"); +#endif + +#ifdef LARGE_MEMORY_MODEL + ADD_FEATURE("LARGE-MEMORY-MODEL"); +#endif + + make_special("*FEATURES*",features);} + + make_si_function("SAVE-SYSTEM", siLsave_system); + make_si_sfun("CATCH-FATAL",siLcatch_fatal,ARGTYPE1(f_fixnum)); + make_si_function("WARN-VERSION",Lidentity); + +} + +#ifdef HAVE_PRINT_INSN_I386 + +#include "dis-asm.h" + +static char b[4096],*bp; + +static int +my_fprintf(void *v,const char *f,...) { + va_list va; + int r; + va_start(va,f); + bp+=(r=vsnprintf(bp,sizeof(b)-(bp-b),f,va)); + va_end(va); + return r; +} + +static int +my_read(bfd_vma memaddr, bfd_byte *myaddr, unsigned int length, struct disassemble_info *dinfo) { + memcpy(myaddr,(void *)(long)memaddr,length); + return 0; +} + +static void +my_pa(bfd_vma addr,struct disassemble_info *dinfo) { + dinfo->fprintf_func(dinfo->stream,"%p",(void *)(long)addr); +} + +#endif + +DEFUN_NEW("DISASSEMBLE-INSTRUCTION",object,fSdisassemble_instruction,SI,1,1,NONE,OI,OO,OO,OO,(fixnum addr),"") { + +#ifdef HAVE_PRINT_INSN_I386 + + static disassemble_info i; + void *v; + int (*s)(); + int j; + + memset(&i,0,sizeof(i)); +#ifdef __i386__ + i.disassembler_options="i386"; +#endif + i.fprintf_func=my_fprintf; + i.read_memory_func=my_read; + i.print_address_func=my_pa; + bp=b; + + if ((v=dlopen("libopcodes.so",RTLD_NOW))) { + if ((s=dlsym(v,"print_insn_i386"))) { + j=s(addr,&i); + my_fprintf(NULL," ;"); + return MMcons(make_simple_string(b),make_fixnum(j)); + } + massert(!dlclose(v)); + } + +#endif + + return MMcons(make_simple_string("fnop ;"),make_fixnum(0)); + +} + +typedef struct { + enum type tt; + struct typemanager *tp; +} Tbl; + +#define Tblof(a_) {(a_),tm_of(a_)} +#define tblookup(a_,b_) ({Tbl *tb=tb1;(b_)=(a_);for (;tb->tt && tb->b_!=(b_);tb++);tb->tt;}) +#define mtm_of(a_) (a_)>=t_other ? NULL : tm_of(a_) + +DEFUN_NEW("FUNCTION-BY-ADDRESS",object,fSfunction_by_address,SI,1,1,NONE,OI,OO,OO,OO,(fixnum ad),"") { + + ufixnum m=-1,mm,j; + void *o; + object x,xx=Cnil; + Tbl tb1[]={Tblof(t_sfun),Tblof(t_cfun),Tblof(t_vfun),Tblof(t_afun),Tblof(t_gfun),Tblof(t_closure),Tblof(t_cclosure),{0}}; + struct typemanager *tp; + enum type tt; + struct pageinfo *v; + + if (VALID_DATA_ADDRESS_P(ad)) + for (v=cell_list_head;v;v=v->next) + if (tblookup(mtm_of(v->type),tp)) + for (o=pagetochar(page(v)),j=tp->tm_nppage;j--;o+=tp->tm_size) + if (tblookup(type_of((x=o)),tt)) + if (!is_free(x) && (mm=ad-(ufixnum)x->sfn.sfn_self) $@ + +boot.h: boot.ini + echo '#include "make-init.h"' > $@ + echo 'void gcl_init_boot(void){' >> $@ + cat $< >> $@ + echo '}' >> $@ + +%.ini: %.c grab_defs + $(CC) -DINICOMP -DNO_DEFUN $(CFLAGS) $(DEFS) -E $*.c |\ + sed -e 's,^.* DEFUNB,DEFUNB,g' -e 's/DEF,//g' -e 's:\"[ ]*):\"):g' | ./grab_defs > $*.ini + +%.ini: %.d $(DPP) grab_defs + $(DPP) $* + $(CC) -DINICOMP -DNO_DEFUN $(CFLAGS) $(DEFS) -E $*.c |\ + sed -e 's,^.* DEFUNB,DEFUNB,g' -e 's/DEF,//g' | sed -e 's:\"[ ]*):\"):g' | ./grab_defs > $*.ini + rm $*.c + +$(DPP): ../bin/dpp.c + ${CC} ${DEFS} -o $@ $< + +new_init.c: ${INI_FILES} + echo '#include "make-init.h"' > $@ + echo 'void NewInit(void){' >> $@ + cat ${INI_FILES} >> $@ + echo '}' >> $@ + ! cat $@ | awk -F, '/DEFUN/ {print $2}' | grep -v object || (rm $@ && false) + +ifneq ($(NIFLAGS),) +new_init.o: new_init.c $(DECL) + $(CC) -c $(NIFLAGS) $(DEFS) $< -o $@ +endif + +$(DECL): $(HDIR)/make-decl.h $(INI_FILES) + echo '#include "make-decl.h"' > foo.c + cat ${INI_FILES} |sed 's,DEFBFUN,DEFUN,g' >> foo.c + ${CC} -E -I${HDIR} foo.c | sed -n -e '/#/d' -e '/DO_/d' -e '/[a-zA-Z;]/p' > tmpini + ../xbin/move-if-changed mv tmpini $@ + rm -f foo.c tmpini + +grab_defs: grab_defs.c + ${CC} $(OFLAGS) -o grab_defs grab_defs.c + +wpool: wpool.o + $(CC) $(LDFLAGS) -o $@ $< + +$(GCLIB): ${ALIB} + rm -f gcllib.a + $(AR) gcllib.a ${ALIB} + ${RANLIB} gcllib.a + +clean: + rm -f $(OBJS) ${ALIB} new_init.o $(LAST_FILE) $(FIRST_FILE) *.a grab_defs$(EXE) *.ini tmpx foo.c + rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h wpool + +.INTERMEDIATE: $(patsubst %.d,%.c,$(shell ls -1 *.d)) diff --git a/o/makefun.c b/o/makefun.c new file mode 100755 index 0000000..50cc6d8 --- /dev/null +++ b/o/makefun.c @@ -0,0 +1,243 @@ +#include "include.h" +#include "funlink.h" + +#define PADDR(i) ((void *)(sSPinit->s.s_dbind->fixa.fixa_self[Mfix(i)])) +/* eg: +MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0); +MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0); +*/ + +static int mv; + +object MakeAfun(object (*addr)(object,object), unsigned int argd, object data) +{ + ufixnum at=F_TYPES(argd)>>F_TYPE_WIDTH; + ufixnum ma=F_MIN_ARGS(argd); + ufixnum xa=F_MAX_ARGS(argd); + ufixnum rt=F_RESULT_TYPE(argd); + int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : (!at&&!rt&&ma==xa&&!mv ? t_sfun : t_afun)); + object x = alloc_object(type); + x->sfn.sfn_name = Cnil; + x->sfn.sfn_self = addr; + x->sfn.sfn_argd = type==t_sfun ? ma : argd; + if (type == t_closure) + { x->cl.cl_env = 0; + x->cl.cl_envdim=0;} + x->sfn.sfn_data = data; + return x; +} + + +static object +fSmakefun(object sym, object (*addr) (/* ??? */), unsigned int argd) +{object ans = MakeAfun(addr,argd, + (sSPmemory && sSPmemory->s.s_dbind && + type_of(sSPmemory->s.s_dbind)==t_cfdata) ? + sSPmemory->s.s_dbind : 0); + ans->sfn.sfn_name = sym; + return ans; +} + +/* static object */ +/* ImakeClosure(object (*addr)(),int argd,int n,...) */ +/* { object x = fSmakefun(Cnil,addr,argd); */ +/* va_list ap; */ +/* va_start(ap,n); */ +/* IsetClosure(x,n,ap); */ +/* va_end(ap); */ +/* return x; */ +/* } */ + +static void +IsetClosure(object x, int n, va_list ap) +{ /* this will change so that we can allocate 'hunks' which will be little + blocks the size of an array header say with only one header word. This + will be more economical. Because of gc, we can't allocate relblock, it + might move while in the closure. */ + object *p; + if (type_of(x) != t_closure) + { FEerror("Not a closure",0);} + if (x->cl.cl_envdim < n) + {BEGIN_NO_INTERRUPT; x->cl.cl_env = (object *)alloc_relblock(n); + x->cl.cl_envdim = n; + END_NO_INTERRUPT; + } + p = x->cl.cl_env; + while (--n >= 0) + { *p++ = va_arg(ap,object); + } +} + +DEFUN_NEW("INITFUN",object,fSinitfun,SI,3,ARG_LIMIT,NONE,OO,OO,OO,OO, + (object sym,object addr_ind,object argd,...), + "Store a compiled function on SYMBOL whose body is in the VV array at \ +INDEX, and whose argd descriptor is ARGD. If more arguments IND1, IND2,.. \ +are supplied these are indices in the VV array for the environment of this \ +closure.") +{ int nargs = F_NARGS(VFUN_NARGS) -3; + va_list ap; + object fun = fSmakefun(IisSymbol(sym),PADDR(addr_ind),Mfix(argd)); + if (nargs > 0) + { va_start(ap,argd); + IsetClosure(fun,nargs,ap); + while (--nargs >= 0) + /* the things put in by IsetClosure were only the indices + of the closure variables not the actual variables */ + { fun->cl.cl_env[nargs]= (object) PADDR(fun->cl.cl_env[nargs]);} + va_end(ap); + } + fSfset(sym,fun); + return sym; +} + +#include "apply_n.h" + +DEFUN_NEW("INITMACRO",object,fSinitmacro,SI,4,ARG_LIMIT,NONE,OO,OO,OO,OO,(object first,...), + "Like INITFUN, but makes then sets the 'macro' flag on this symbol") +{va_list ap; + object res; + int n = VFUN_NARGS; + object *new; + va_start(ap,first); + COERCE_VA_LIST_NEW(new,first,ap,n); + res= c_apply_n_f((void *)FFN(fSinitfun),n,new,3,ARG_LIMIT); + va_end(ap); + res->s.s_mflag = 1; + return res; +} + +DEFUN_NEW("SET-KEY-STRUCT",object,fSset_key_struct,SI,1,1,NONE,OO,OO,OO,OO,(object key_struct_ind), + "Called inside the loader. The keystruct is set up in the file with \ + indexes rather than the actual entries. We change these indices to \ + the objects") +{ set_key_struct(PADDR(key_struct_ind),sSPmemory->s.s_dbind); + return Cnil; +} + + +#define mcollect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ + if (top_==Cnil) top_=next_=_x; \ + else next_=next_->c.c_cdr=_x;}) + + +static void +put_fn_procls(object sym,fixnum argd,fixnum oneval,object def,object rdef) { + + unsigned int atypes=F_TYPES(argd) >> F_TYPE_WIDTH; + unsigned int minargs=F_MIN_ARGS(argd); + unsigned int maxargs=F_MAX_ARGS(argd); + unsigned int rettype=F_RESULT_TYPE(argd); + unsigned int i; + object ta=Cnil,na=Cnil; + + for (i=0;i>=F_TYPE_WIDTH) + switch(maxargs!=minargs ? F_object : atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { + case F_object: + mcollect(ta,na,def); + break; + case F_int: + mcollect(ta,na,sLfixnum); + break; + case F_shortfloat: + mcollect(ta,na,sLshort_float); + break; + case F_double_ptr: + mcollect(ta,na,sLlong_float); + break; + default: + FEerror("Bad sfn declaration",0); + break; + } + if (maxargs!=minargs) + mcollect(ta,na,sLA); + putprop(sym,ta,sSproclaimed_arg_types); + ta=na=Cnil; + if (oneval) + switch(rettype) { + case F_object: + ta=rdef; + break; + case F_int: + ta=sLfixnum; + break; + case F_shortfloat: + ta=sLshort_float; + break; + case F_double_ptr: + ta=sLlong_float; + break; + default: + FEerror("Bad sfn declaration",0); + break; + } + else +/* ta=MMcons(sLA,Cnil); */ + ta=sLA; + putprop(sym,ta,sSproclaimed_return_type); + if (oneval) + putprop(sym,Ct,sSproclaimed_function); + +} + +void +SI_makefun(char *strg, void *fn, unsigned int argd) +{ object sym = make_si_ordinary(strg); + fSfset(sym, fSmakefun(sym,fn,argd)); + put_fn_procls(sym,argd,1,Ct,Ct); +} + +void +LISP_makefun(char *strg, void *fn, unsigned int argd) +{ object sym = make_ordinary(strg); + fSfset(sym, fSmakefun(sym,fn,argd)); + put_fn_procls(sym,argd,1,Ct,Ct); +} + +void +SI_makefunm(char *strg, void *fn, unsigned int argd) +{ object sym = make_si_ordinary(strg); + mv=1; + fSfset(sym, fSmakefun(sym,fn,argd)); + mv=0; + put_fn_procls(sym,argd,0,Ct,Ct); +} + +void +LISP_makefunm(char *strg, void *fn, unsigned int argd) +{ object sym = make_ordinary(strg); + mv=1; + fSfset(sym, fSmakefun(sym,fn,argd)); + mv=0; + put_fn_procls(sym,argd,0,Ct,Ct); +} + + +/* static object */ +/* MakeClosure(int n,int argd,object data,object (*fn)(),...) */ +/* { object x; */ +/* va_list ap; */ +/* x = alloc_object(t_closure); */ +/* x->cl.cl_name = Cnil; */ +/* x->cl.cl_self = fn; */ +/* x->cl.cl_data = data; */ +/* x->cl.cl_argd = argd; */ +/* x->cl.cl_env = 0; */ +/* x->cl.cl_env = (object *)alloc_contblock(n*sizeof(object)); */ +/* x->cl.cl_envdim=n; */ +/* va_start(ap,fn); */ +/* { object *p = x->cl.cl_env; */ +/* while (--n>= 0) */ +/* { *p++ = va_arg(ap,object);} */ +/* va_end(ap); */ +/* } */ +/* return x; */ +/* } */ + +DEFUN_NEW("INVOKE",object,fSinvoke,SI,1,ARG_LIMIT,NONE,OO,OO,OO,OO,(object x), + "Invoke a C function whose body is at INDEX in the VV array") +{ int (*fn)(); + fn = (void *) PADDR(x); + (*fn)(); + return Cnil; +} + diff --git a/o/malloc.c b/o/malloc.c new file mode 100755 index 0000000..5c37880 --- /dev/null +++ b/o/malloc.c @@ -0,0 +1,788 @@ +/* dynamic memory allocation for GNU. + Copyright (C) 1985, 1987 Free Software Foundation, Inc. + + NO WARRANTY + + BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY +NO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW. EXCEPT +WHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC, +RICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS" +WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, +BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY +AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE +DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR +CORRECTION. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M. +STALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY +WHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE +LIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR +OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR +DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR +A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS +PROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. + + GENERAL PUBLIC LICENSE TO COPY + + 1. You may copy and distribute verbatim copies of this source file +as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy a valid copyright notice "Copyright +(C) 1985 Free Software Foundation, Inc."; and include following the +copyright notice a verbatim copy of the above disclaimer of warranty +and of this License. You may charge a distribution fee for the +physical act of transferring a copy. + + 2. You may modify your copy or copies of this source file or +any portion of it, and copy and distribute such modifications under +the terms of Paragraph 1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating + that you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, + that in whole or in part contains or is a derivative of this + program or any part thereof, to be licensed at no charge to all + third parties on terms identical to those contained in this + License Agreement (except that you may choose to grant more extensive + warranty protection to some or all third parties, at your option). + + c) You may charge a distribution fee for the physical act of + transferring a copy, and you may at your option offer warranty + protection in exchange for a fee. + +Mere aggregation of another unrelated program with this program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other program under the scope of these terms. + + 3. You may copy and distribute this program (or a portion or derivative +of it, under Paragraph 2) in object code or executable form under the terms +of Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal + shipping charge) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +For an executable file, complete source code means all the source code for +all modules it contains; but, as a special exception, it need not include +source code for modules which are standard libraries that accompany the +operating system on which the executable file runs. + + 4. You may not copy, sublicense, distribute or transfer this program +except as expressly provided under this License Agreement. Any attempt +otherwise to copy, sublicense, distribute or transfer this program is void and +your rights to use the program under this License agreement shall be +automatically terminated. However, parties who have received computer +software programs from you with this License Agreement will not have +their licenses terminated so long as such parties remain in full compliance. + + 5. If you wish to incorporate parts of this program into other free +programs whose distribution conditions are different, write to the Free +Software Foundation at 675 Mass Ave, Cambridge, MA 02139. We have not yet +worked out a simple rule that can be stated here, but we will often permit +this. We will be guided by the two goals of preserving the free status of +all derivatives of our free software and of promoting the sharing and reuse of +software. + + +In other words, you are welcome to use, share and improve this program. +You are forbidden to forbid anyone else to use, share and improve +what you give them. Help stamp out software-hoarding! */ + + +/* + * @(#)nmalloc.c 1 (Caltech) 2/21/82 + * + * U of M Modified: 20 Jun 1983 ACT: strange hacks for Emacs + * + * Nov 1983, Mike@BRL, Added support for 4.1C/4.2 BSD. + * + * This is a very fast storage allocator. It allocates blocks of a small + * number of different sizes, and keeps free lists of each size. Blocks + * that don't exactly fit are passed up to the next larger size. In this + * implementation, the available sizes are (2^n)-4 (or -16) bytes long. + * This is designed for use in a program that uses vast quantities of + * memory, but bombs when it runs out. To make it a little better, it + * warns the user when he starts to get near the end. + * + * June 84, ACT: modified rcheck code to check the range given to malloc, + * rather than the range determined by the 2-power used. + * + * Jan 85, RMS: calls malloc_warning to issue warning on nearly full. + * No longer Emacs-specific; can serve as all-purpose malloc for GNU. + * You should call malloc_init to reinitialize after loading dumped Emacs. + * Call malloc_stats to get info on memory stats if MSTATS turned on. + * realloc knows how to return same block given, just changing its size, + * if the power of 2 is correct. + */ +/* Oct 89: wfs@cs.utexas.edu: Created V/ merge file for + * changes for GCL. + * Calls to sbrk replaced by alloc_page. Remove some of the + * additions for emacs. + * NB: According to the gnu license you may only distribute the + * verbatim copy of the gnumalloc.c. Thus we only distribute + * an abbreviated diffs file from that verbatim copy. +*/ +/* + * nextf[i] is the pointer to the next free block of size 2^(i+3). The + * smallest allocatable block is 8 bytes. The overhead information will + * go in the first int of the block, and the returned pointer will point + * to the second. + * +#ifdef MSTATS + * nmalloc[i] is the difference between the number of mallocs and frees + * for a given block size. +#endif /* MSTATS */ + +#ifdef emacs +#include "config.h" +#endif /* emacs */ + +/* Determine which kind of system this is. */ +#include +#ifndef SIGTSTP +#ifndef VMS +#ifndef USG +#define USG +#endif +#endif /* not VMS */ +#else /* SIGTSTP */ +#ifdef SIGIO +#define BSD42 +#endif /* SIGIO */ +#endif /* SIGTSTP */ + +/* Define getpagesize () if the system does not. */ +#define getpagesize() 2048 + +#ifndef BSD42 +#ifndef USG +#include /* warn the user when near the end */ +#endif /* not USG */ +#else /* if BSD42 */ +#include +/* #include */ +#endif /* BSD42 */ + +extern char *start_of_data (); + +#ifdef BSD +#ifndef DATA_SEG_BITS +#define start_of_data() &etext +#endif +#endif + +#ifndef emacs +#define start_of_data() &etext +#endif + +#define ISALLOC ((char) 0xf7) /* magic byte that implies allocation */ +#define ISFREE ((char) 0x54) /* magic byte that implies free block */ + /* this is for error checking only */ +#define ISMEMALIGN ((char) 0xd6) /* Stored before the value returned by + memalign, with the rest of the word + being the distance to the true + beginning of the block. */ + +extern char etext; + +/* These two are for user programs to look at, when they are interested. */ + +unsigned int malloc_sbrk_used; /* amount of data space used now */ +unsigned int malloc_sbrk_unused; /* amount more we can have */ + +/* start of data space; can be changed by calling init_malloc */ +static char *data_space_start; + +#define PAGEWIDTH 11 +char *alloc_page(); +#define sbrk our_sbrk +char * +our_sbrk(x) +int x; +{return alloc_page((x >> PAGEWIDTH));} + + + + +#ifdef MSTATS +static int nmalloc[30]; +static int nmal, nfre; +#endif /* MSTATS */ + +/* If range checking is not turned on, all we have is a flag indicating + whether memory is allocated, an index in nextf[], and a size field; to + realloc() memory we copy either size bytes or 1<<(index+3) bytes depending + on whether the former can hold the exact size (given the value of + 'index'). If range checking is on, we always need to know how much space + is allocated, so the 'size' field is never used. */ + +struct mhead { + char mh_alloc; /* ISALLOC or ISFREE */ + char mh_index; /* index in nextf[] */ +/* Remainder are valid only when block is allocated */ + unsigned short mh_size; /* size, if < 0x10000 */ +#ifdef rcheck + unsigned mh_nbytes; /* number of bytes allocated */ + int mh_magic4; /* should be == MAGIC4 */ +#endif /* rcheck */ +}; + +/* Access free-list pointer of a block. + It is stored at block + 4. + This is not a field in the mhead structure + because we want sizeof (struct mhead) + to describe the overhead for when the block is in use, + and we do not want the free-list pointer to count in that. */ + +#define CHAIN(a) \ + (*(struct mhead **) (sizeof (char *) + (char *) (a))) + +#ifdef rcheck + +/* To implement range checking, we write magic values in at the beginning and + end of each allocated block, and make sure they are undisturbed whenever a + free or a realloc occurs. */ +/* Written in each of the 4 bytes following the block's real space */ +#define MAGIC1 0x55 +/* Written in the 4 bytes before the block's real space */ +#define MAGIC4 0x55555555 +#define ASSERT(p) if (!(p)) botch("p"); else +#define EXTRA 4 /* 4 bytes extra for MAGIC1s */ +#else +#define ASSERT(p) +#define EXTRA 0 +#endif /* rcheck */ + + +/* nextf[i] is free list of blocks of size 2**(i + 3) */ + +static struct mhead *nextf[30]; + +/* busy[i] is nonzero while allocation of block size i is in progress. */ + +static char busy[30]; + +/* Number of bytes of writable memory we can expect to be able to get */ +static unsigned int lim_data; + +/* Level number of warnings already issued. + 0 -- no warnings issued. + 1 -- 75% warning already issued. + 2 -- 85% warning already issued. +*/ +static int warnlevel; + +/* Function to call to issue a warning; + 0 means don't issue them. */ +static void (*warnfunction) (); + +/* nonzero once initial bunch of free blocks made */ +static int gotpool; + +char *_malloc_base; + +static void getpool (); + +/* Cause reinitialization based on job parameters; + also declare where the end of pure storage is. */ +void +malloc_init (start, warnfun) + char *start; + void (*warnfun) (); +{ + if (start) + data_space_start = start; + lim_data = 0; + warnlevel = 0; + warnfunction = warnfun; +} + +/* Return the maximum size to which MEM can be realloc'd + without actually requiring copying. */ + +int +malloc_usable_size (mem) + char *mem; +{ + int blocksize = 8 << (((struct mhead *) mem) - 1) -> mh_index; + + return blocksize - sizeof (struct mhead) - EXTRA; +} + +static void +morecore (nu) /* ask system for more memory */ + register int nu; /* size index to get more of */ +{ + char *sbrk (); + register char *cp; + register int nblks; + register unsigned int siz; + int oldmask; + +#ifdef BSD +#ifndef BSD4_1 + oldmask = sigsetmask (-1); +#endif +#endif + + if (!data_space_start) + { + data_space_start = start_of_data (); + } + + if (lim_data == 0) + get_lim_data (); + + /* On initial startup, get two blocks of each size up to 1k bytes */ + if (!gotpool) + { getpool (); getpool (); gotpool = 1; } + + /* Find current end of memory and issue warning if getting near max */ + + /* Take at least 2k, and figure out how many blocks of the desired size + we're about to get */ + nblks = 1; + if ((siz = nu) < 8) + nblks = 1 << ((siz = 8) - nu); + + if ((cp = sbrk (1 << (siz + 3)))==0) + return; /* no more room! */ + + /* save new header and link the nblks blocks together */ + nextf[nu] = (struct mhead *) cp; + siz = 1 << (nu + 3); + while (1) + { + ((struct mhead *) cp) -> mh_alloc = ISFREE; + ((struct mhead *) cp) -> mh_index = nu; + if (--nblks <= 0) break; + CHAIN ((struct mhead *) cp) = (struct mhead *) (cp + siz); + cp += siz; + } + CHAIN ((struct mhead *) cp) = 0; + +#ifdef BSD +#ifndef BSD4_1 + sigsetmask (oldmask); +#endif +#endif +} + +static void +getpool () +{ + register int nu; + char * sbrk (); + register char *cp = sbrk (0); + + if ((int) cp & 0x3ff) /* land on 1K boundaries */ + sbrk (1024 - ((int) cp & 0x3ff)); + + /* Record address of start of space allocated by malloc. */ + if (_malloc_base == 0) + _malloc_base = cp; + + /* Get 2k of storage */ + + cp = sbrk (04000); + if (cp == (char *) -1) + return; + + /* Divide it into an initial 8-word block + plus one block of size 2**nu for nu = 3 ... 10. */ + + CHAIN (cp) = nextf[0]; + nextf[0] = (struct mhead *) cp; + ((struct mhead *) cp) -> mh_alloc = ISFREE; + ((struct mhead *) cp) -> mh_index = 0; + cp += 8; + + for (nu = 0; nu < 7; nu++) + { + CHAIN (cp) = nextf[nu]; + nextf[nu] = (struct mhead *) cp; + ((struct mhead *) cp) -> mh_alloc = ISFREE; + ((struct mhead *) cp) -> mh_index = nu; + cp += 8 << nu; + } +} + +char * +malloc (n) /* get a block */ + unsigned n; +{ + register struct mhead *p; + register unsigned int nbytes; + register int nunits = 0; + + /* Figure out how many bytes are required, rounding up to the nearest + multiple of 4, then figure out which nextf[] area to use */ + nbytes = (n + sizeof *p + EXTRA + 3) & ~3; + { + register unsigned int shiftr = (nbytes - 1) >> 2; + + while (shiftr >>= 1) + nunits++; + } + + /* In case this is reentrant use of malloc from signal handler, + pick a block size that no other malloc level is currently + trying to allocate. That's the easiest harmless way not to + interfere with the other level of execution. */ + while (busy[nunits]) nunits++; + busy[nunits] = 1; + + /* If there are no blocks of the appropriate size, go get some */ + /* COULD SPLIT UP A LARGER BLOCK HERE ... ACT */ + if (nextf[nunits] == 0) + morecore (nunits); + + /* Get one block off the list, and set the new list head */ + if ((p = nextf[nunits]) == 0) + { + busy[nunits] = 0; + return 0; + } + nextf[nunits] = CHAIN (p); + busy[nunits] = 0; + + /* Check for free block clobbered */ + /* If not for this check, we would gobble a clobbered free chain ptr */ + /* and bomb out on the NEXT allocate of this size block */ + if (p -> mh_alloc != ISFREE || p -> mh_index != nunits) +#ifdef rcheck + botch ("block on free list clobbered"); +#else /* not rcheck */ + abort (); +#endif /* not rcheck */ + + /* Fill in the info, and if range checking, set up the magic numbers */ + p -> mh_alloc = ISALLOC; +#ifdef rcheck + p -> mh_nbytes = n; + p -> mh_magic4 = MAGIC4; + { + register char *m = (char *) (p + 1) + n; + + *m++ = MAGIC1, *m++ = MAGIC1, *m++ = MAGIC1, *m = MAGIC1; + } +#else /* not rcheck */ + p -> mh_size = n; +#endif /* not rcheck */ +#ifdef MSTATS + nmalloc[nunits]++; + nmal++; +#endif /* MSTATS */ + return (char *) (p + 1); +} + +free (mem) + char *mem; +{ + register struct mhead *p; + { + register char *ap = mem; + + if (ap == 0) + return; + + p = (struct mhead *) ap - 1; + if (p -> mh_alloc == ISMEMALIGN) + { + ap -= p->mh_size; + p = (struct mhead *) ap - 1; + } + + if (p -> mh_alloc != ISALLOC) + abort (); + +#ifdef rcheck + ASSERT (p -> mh_magic4 == MAGIC4); + ap += p -> mh_nbytes; + ASSERT (*ap++ == MAGIC1); ASSERT (*ap++ == MAGIC1); + ASSERT (*ap++ == MAGIC1); ASSERT (*ap == MAGIC1); +#endif /* rcheck */ + } + { + register int nunits = p -> mh_index; + + ASSERT (nunits <= 29); + p -> mh_alloc = ISFREE; + + /* Protect against signal handlers calling malloc. */ + busy[nunits] = 1; + /* Put this block on the free list. */ + CHAIN (p) = nextf[nunits]; + nextf[nunits] = p; + busy[nunits] = 0; + +#ifdef MSTATS + nmalloc[nunits]--; + nfre++; +#endif /* MSTATS */ + } +} + +char * +realloc (mem, n) + char *mem; + register unsigned n; +{ + register struct mhead *p; + register unsigned int tocopy; + register unsigned int nbytes; + register int nunits; + + if ((p = (struct mhead *) mem) == 0) + return malloc (n); + p--; + nunits = p -> mh_index; + ASSERT (p -> mh_alloc == ISALLOC); +#ifdef rcheck + ASSERT (p -> mh_magic4 == MAGIC4); + { + register char *m = mem + (tocopy = p -> mh_nbytes); + ASSERT (*m++ == MAGIC1); ASSERT (*m++ == MAGIC1); + ASSERT (*m++ == MAGIC1); ASSERT (*m == MAGIC1); + } +#else /* not rcheck */ + if (p -> mh_index >= 13) + tocopy = (1 << (p -> mh_index + 3)) - sizeof *p; + else + tocopy = p -> mh_size; +#endif /* not rcheck */ + + /* See if desired size rounds to same power of 2 as actual size. */ + nbytes = (n + sizeof *p + EXTRA + 7) & ~7; + + /* If ok, use the same block, just marking its size as changed. */ + if (nbytes > (4 << nunits) && nbytes <= (8 << nunits)) + { +#ifdef rcheck + register char *m = mem + tocopy; + *m++ = 0; *m++ = 0; *m++ = 0; *m++ = 0; + p-> mh_nbytes = n; + m = mem + n; + *m++ = MAGIC1; *m++ = MAGIC1; *m++ = MAGIC1; *m++ = MAGIC1; +#else /* not rcheck */ + p -> mh_size = n; +#endif /* not rcheck */ + return mem; + } + + if (n < tocopy) + tocopy = n; + { + register char *new; + + if ((new = malloc (n)) == 0) + return 0; + bcopy (mem, new, tocopy); + free (mem); + return new; + } +} + +#ifndef VMS + +static char * +memalign (alignment, size) + unsigned alignment, size; +{ + register char *ptr = malloc (size + alignment); + register char *aligned; + register struct mhead *p; + + if (ptr == 0) + return 0; + /* If entire block has the desired alignment, just accept it. */ + if (((int) ptr & (alignment - 1)) == 0) + return ptr; + /* Otherwise, get address of byte in the block that has that alignment. */ + aligned = (char *) (((int) ptr + alignment - 1) & -alignment); + + /* Store a suitable indication of how to free the block, + so that free can find the true beginning of it. */ + p = (struct mhead *) aligned - 1; + p -> mh_size = aligned - ptr; + p -> mh_alloc = ISMEMALIGN; + return aligned; +} + +#ifndef HPUX +/* This runs into trouble with getpagesize on HPUX. + Patching out seems cleaner than the ugly fix needed. */ +static char * +valloc (size) +{ + return memalign (getpagesize (), size); +} +#endif /* not HPUX */ +#endif /* not VMS */ + +#ifdef MSTATS +/* Return statistics describing allocation of blocks of size 2**n. */ + +struct mstats_value + { + int blocksize; + int nfree; + int nused; + }; + +struct mstats_value +malloc_stats (size) + int size; +{ + struct mstats_value v; + register int i; + register struct mhead *p; + + v.nfree = 0; + + if (size < 0 || size >= 30) + { + v.blocksize = 0; + v.nused = 0; + return v; + } + + v.blocksize = 1 << (size + 3); + v.nused = nmalloc[size]; + + for (p = nextf[size]; p; p = CHAIN (p)) + v.nfree++; + + return v; +} +#endif /* MSTATS */ + +/* + * This function returns the total number of bytes that the process + * will be allowed to allocate via the sbrk(2) system call. On + * BSD systems this is the total space allocatable to stack and + * data. On USG systems this is the data space only. + */ + +#ifdef USG + +get_lim_data () +{ + extern long ulimit (); + + lim_data = ulimit (3, 0); + lim_data -= (long) data_space_start; +} + +#else /* not USG */ +#ifndef BSD42 + +get_lim_data () +{ + lim_data = vlimit (LIM_DATA, -1); +} + +#else /* BSD42 */ + +get_lim_data () +{ + struct rlimit XXrlimit; + +#ifdef RLIMIT_DATA + getrlimit (RLIMIT_DATA, &XXrlimit); +#endif +#ifdef RLIM_INFINITY + lim_data = XXrlimit.rlim_cur & RLIM_INFINITY; /* soft limit */ +#else + lim_data = XXrlimit.rlim_cur; /* soft limit */ +#endif +} + +#endif /* BSD42 */ +#endif /* not USG */ + +#ifdef VMS +/* There is a problem when dumping and restoring things on VMS. Calls + * to SBRK don't necessarily result in contiguous allocation. Dumping + * doesn't work when it isn't. Therefore, we make the initial + * allocation contiguous by allocating a big chunk, and do SBRKs from + * there. Once Emacs has dumped there is no reason to continue + * contiguous allocation, malloc doesn't depend on it. + * + * There is a further problem of using brk and sbrk while using VMS C + * run time library routines malloc, calloc, etc. The documentation + * says that this is a no-no, although I'm not sure why this would be + * a problem. In any case, we remove the necessity to call brk and + * sbrk, by calling calloc (to assure zero filled data) rather than + * sbrk. + * + * VMS_ALLOCATION_SIZE is the size of the allocation array. This + * should be larger than the malloc size before dumping. Making this + * too large will result in the startup procedure slowing down since + * it will require more space and time to map it in. + * + * The value for VMS_ALLOCATION_SIZE in the following define was determined + * by running emacs linked (and a large allocation) with the debugger and + * looking to see how much storage was used. The allocation was 201 pages, + * so I rounded it up to a power of two. + */ +#ifndef VMS_ALLOCATION_SIZE +#define VMS_ALLOCATION_SIZE (512*256) +#endif + +/* Use VMS RTL definitions */ +#undef sbrk +#undef brk +#undef malloc +int vms_out_initial = 0; +char vms_initial_buffer[VMS_ALLOCATION_SIZE]; +static char *vms_current_brk = &vms_initial_buffer; +static char *vms_end_brk = &vms_initial_buffer[VMS_ALLOCATION_SIZE-1]; + +#include + +char * +sys_sbrk (incr) + int incr; +{ + char *sbrk(), *temp, *ptr; + + if (vms_out_initial) + { + /* out of initial allocation... */ + if (!(temp = malloc (incr))) + temp = (char *) -1; + } + else + { + /* otherwise, go out of our area */ + ptr = vms_current_brk + incr; /* new current_brk */ + if (ptr <= vms_end_brk) + { + temp = vms_current_brk; + vms_current_brk = ptr; + } + else + { + vms_out_initial = 1; /* mark as out of initial allocation */ + if (!(temp = malloc (incr))) + temp = (char *) -1; + } + } + return temp; +} +#endif /* VMS */ diff --git a/o/mapfun.c b/o/mapfun.c new file mode 100755 index 0000000..dc7a24c --- /dev/null +++ b/o/mapfun.c @@ -0,0 +1,326 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + mapfun.c + + Mapping +*/ + +#include "include.h" + +/* + +Use of VS in mapfunctions: + + | | + |-------| + base -> | fun | + | list1 | + | : | + | : | + | listn | + top -> | value | ----- the list which should be returned + | arg1 | --| + | : | |-- arguments to FUN. + | : | | On call to FUN, vs_base = top+1 + | argn | --| vs_top = top+n+1 + |-------| + | | + VS +*/ + +LFD(Lmapcar)(void) +{ + + object *top = vs_top; + object *base = vs_base; + object x, handy; + int n = vs_top-vs_base-1; + int i; + + if (n <= 0) + too_few_arguments(); + vs_push(Cnil); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + base[0] = Cnil; + vs_top = base+1; + vs_base = base; + return; + } + vs_push(MMcar(x)); + base[i] = MMcdr(x); + } + handy = top[0] = MMcons(Cnil,Cnil); +LOOP: + vs_base = top+1; + super_funcall(base[0]); + MMcar(handy) = vs_base[0]; + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_base = top; + vs_top = top+1; + return; + } + top[i] = MMcar(x); + base[i] = MMcdr(x); + } + vs_top = top+n+1; + handy = MMcdr(handy) = MMcons(Cnil,Cnil); + goto LOOP; +} + +LFD(Lmaplist)(void) +{ + + object *top = vs_top; + object *base = vs_base; + object x, handy; + int n = vs_top-vs_base-1; + int i; + + if (n <= 0) + too_few_arguments(); + vs_push(Cnil); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + base[0] = Cnil; + vs_top = base+1; + vs_base = base; + return; + } + vs_push(x); + base[i] = MMcdr(x); + } + handy = top[0] = MMcons(Cnil,Cnil); +LOOP: + vs_base = top+1; + super_funcall(base[0]); + MMcar(handy) = vs_base[0]; + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_base = top; + vs_top = top+1; + return; + } + top[i] = x; + base[i] = MMcdr(x); + } + vs_top = top+n+1; + handy = MMcdr(handy) = MMcons(Cnil,Cnil); + goto LOOP; +} + +LFD(Lmapc)(void) +{ + + object *top = vs_top; + object *base = vs_base; + object x; + int n = vs_top-vs_base-1; + int i; + + if (n <= 0) + too_few_arguments(); + vs_push(base[1]); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_top = top+1; + vs_base = top; + return; + } + vs_push(MMcar(x)); + base[i] = MMcdr(x); + } +LOOP: + vs_base = top+1; + super_funcall(base[0]); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_base = top; + vs_top = top+1; + return; + } + top[i] = MMcar(x); + base[i] = MMcdr(x); + } + vs_top = top+n+1; + goto LOOP; +} + +LFD(Lmapl)(void) +{ + + object *top = vs_top; + object *base = vs_base; + object x; + int n = vs_top-vs_base-1; + int i; + + if (n <= 0) + too_few_arguments(); + vs_push(base[1]); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_top = top+1; + vs_base = top; + return; + } + vs_push(x); + base[i] = MMcdr(x); + } +LOOP: + vs_base = top+1; + super_funcall(base[0]); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_base = top; + vs_top = top+1; + return; + } + top[i] = x; + base[i] = MMcdr(x); + } + vs_top = top+n+1; + goto LOOP; +} + +LFD(Lmapcan)(void) +{ + + object *top = vs_top; + object *base = vs_base; + object x, handy; + int n = vs_top-vs_base-1; + int i; + + if (n <= 0) + too_few_arguments(); + vs_push(Cnil); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + base[0] = Cnil; + vs_top = base+1; + vs_base = base; + return; + } + vs_push(MMcar(x)); + base[i] = MMcdr(x); + } + handy = Cnil; +LOOP: + vs_base = top+1; + super_funcall(base[0]); + if (endp(handy)) handy = top[0] = vs_base[0]; + else { + x = MMcdr(handy); + while(!endp(x)) { + handy = x; + x = MMcdr(x); + } + MMcdr(handy) = vs_base[0]; + } + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_base = top; + vs_top = top+1; + return; + } + top[i] = MMcar(x); + base[i] = MMcdr(x); + } + vs_top = top+n+1; + goto LOOP; +} + +LFD(Lmapcon)(void) +{ + + object *top = vs_top; + object *base = vs_base; + object x, handy; + int n = vs_top-vs_base-1; + int i; + + if (n <= 0) + too_few_arguments(); + vs_push(Cnil); + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + base[0] = Cnil; + vs_top = base+1; + vs_base = base; + return; + } + vs_push(x); + base[i] = MMcdr(x); + } + handy = Cnil; +LOOP: + vs_base = top+1; + super_funcall(base[0]); + if (endp(handy)) + handy = top[0] = vs_base[0]; + else { + x = MMcdr(handy); + while(!endp(x)) { + handy = x; + x = MMcdr(x); + } + MMcdr(handy) = vs_base[0]; + } + for (i = 1; i <= n; i++) { + x = base[i]; + if (endp(x)) { + vs_base = top; + vs_top = top+1; + return; + } + top[i] = x; + base[i] = MMcdr(x); + } + vs_top = top+n+1; + goto LOOP; +} + +void +gcl_init_mapfun(void) +{ + make_function("MAPCAR", Lmapcar); + make_function("MAPLIST", Lmaplist); + make_function("MAPC", Lmapc); + make_function("MAPL", Lmapl); + make_function("MAPCAN", Lmapcan); + make_function("MAPCON", Lmapcon); +} diff --git a/o/mingfile.c b/o/mingfile.c new file mode 100644 index 0000000..4e1fb38 --- /dev/null +++ b/o/mingfile.c @@ -0,0 +1,13 @@ +#include "include.h" +#include "winsock2.h" +#include "windows.h" + +int +mingwlisten(FILE *fp) { + + int c = 0; + ioctlsocket(fileno(fp), FIONREAD, (void *)&c); + if (c<=0) + return 1; + return 0; +} diff --git a/o/mingwin.c b/o/mingwin.c new file mode 100755 index 0000000..0d3f055 --- /dev/null +++ b/o/mingwin.c @@ -0,0 +1,954 @@ +#include "include.h" + + + +#include "winsock2.h" +#include "windows.h" +#include "errno.h" +#include "signal.h" +#include "stdlib.h" + +#ifdef DODEBUG +#define dprintf(s,arg) emsg(s,arg) +#else +#define dprintf(s,arg) +#endif + +#ifndef EWOULDBLOCK +#define EWOULDBLOCK EAGAIN +#endif + + + +#include "errno.h" +#include +#include +#include +#include + + +#define Tcl_GetErrno() errno +#define Tcl_SetErrno(n) errno=n + +/* + * The following structure contains pointers to all of the WinSock API entry + * points used by Tcl. It is initialized by InitSockets. Since we + * dynamically load Winsock.dll on demand, we must use this function table + * to refer to functions in the socket API. + */ + +static struct { + HINSTANCE hInstance; /* Handle to WinSock library. */ + SOCKET (PASCAL FAR *accept)(SOCKET s, struct sockaddr FAR *addr, + int FAR *addrlen); + int (PASCAL FAR *bind)(SOCKET s, const struct sockaddr FAR *addr, + int namelen); + int (PASCAL FAR *closesocket)(SOCKET s); + int (PASCAL FAR *connect)(SOCKET s, const struct sockaddr FAR *name, + int namelen); + int (PASCAL FAR *ioctlsocket)(SOCKET s, long cmd, u_long FAR *argp); + int (PASCAL FAR *getsockopt)(SOCKET s, int level, int optname, + char FAR * optval, int FAR *optlen); + u_short (PASCAL FAR *htons)(u_short hostshort); + unsigned long (PASCAL FAR *inet_addr)(const char FAR * cp); + char FAR * (PASCAL FAR *inet_ntoa)(struct in_addr in); + int (PASCAL FAR *listen)(SOCKET s, int backlog); + u_short (PASCAL FAR *ntohs)(u_short netshort); + int (PASCAL FAR *recv)(SOCKET s, char FAR * buf, int len, int flags); + int (PASCAL FAR *select)(int nfds, fd_set FAR * readfds, + fd_set FAR * writefds, fd_set FAR * exceptfds, + const struct timeval FAR * tiemout); + int (PASCAL FAR *send)(SOCKET s, const char FAR * buf, int len, int flags); + int (PASCAL FAR *setsockopt)(SOCKET s, int level, int optname, + const char FAR * optval, int optlen); + int (PASCAL FAR *shutdown)(SOCKET s, int how); + SOCKET (PASCAL FAR *socket)(int af, int type, int protocol); + struct hostent FAR * (PASCAL FAR *gethostbyname)(const char FAR * name); + struct hostent FAR * (PASCAL FAR *gethostbyaddr)(const char FAR *addr, + int addrlen, int addrtype); + int (PASCAL FAR *gethostname)(char FAR * name, int namelen); + int (PASCAL FAR *getpeername)(SOCKET sock, struct sockaddr FAR *name, + int FAR *namelen); + struct servent FAR * (PASCAL FAR *getservbyname)(const char FAR * name, + const char FAR * proto); + int (PASCAL FAR *getsockname)(SOCKET sock, struct sockaddr FAR *name, + int FAR *namelen); + int (PASCAL FAR *WSAStartup)(WORD wVersionRequired, LPWSADATA lpWSAData); + int (PASCAL FAR *WSACleanup)(void); + int (PASCAL FAR *WSAGetLastError)(void); + int (PASCAL FAR *WSAAsyncSelect)(SOCKET s, HWND hWnd, u_int wMsg, + long lEvent); +} winSock; + +static int SocketsEnabled(); +static void close_winsock(); +extern void doReverse ( char *s, int n ); + + +/* + *---------------------------------------------------------------------- + * + * InitSockets -- + * + * Initialize the socket module. Attempts to load the wsock32.dll + * library and set up the winSock function table. If successful, + * registers the event window for the socket notifier code. + * + * Assumes Mutex is held. + * + * Results: + * None. + * + * Side effects: + * Dynamically loads wsock32.dll, and registers a new window + * class and creates a window for use in asynchronous socket + * notification. + * + *---------------------------------------------------------------------- + */ + + +static void +InitSockets() +{ + WSADATA wsaData; + static int initialized; + if (! initialized) { + initialized = 1; + winSock.hInstance = LoadLibraryA("wsock32.dll"); + + /* + * Initialize the function table. + */ + + if (!SocketsEnabled()) { + return; + } + + winSock.accept = (SOCKET (PASCAL FAR *)(SOCKET s, + struct sockaddr FAR *addr, int FAR *addrlen)) + GetProcAddress(winSock.hInstance, "accept"); + winSock.bind = (int (PASCAL FAR *)(SOCKET s, + const struct sockaddr FAR *addr, int namelen)) + GetProcAddress(winSock.hInstance, "bind"); + winSock.closesocket = (int (PASCAL FAR *)(SOCKET s)) + GetProcAddress(winSock.hInstance, "closesocket"); + winSock.connect = (int (PASCAL FAR *)(SOCKET s, + const struct sockaddr FAR *name, int namelen)) + GetProcAddress(winSock.hInstance, "connect"); + winSock.ioctlsocket = (int (PASCAL FAR *)(SOCKET s, long cmd, + u_long FAR *argp)) + GetProcAddress(winSock.hInstance, "ioctlsocket"); + winSock.getsockopt = (int (PASCAL FAR *)(SOCKET s, + int level, int optname, char FAR * optval, int FAR *optlen)) + GetProcAddress(winSock.hInstance, "getsockopt"); + winSock.htons = (u_short (PASCAL FAR *)(u_short hostshort)) + GetProcAddress(winSock.hInstance, "htons"); + winSock.inet_addr = (unsigned long (PASCAL FAR *)(const char FAR *cp)) + GetProcAddress(winSock.hInstance, "inet_addr"); + winSock.inet_ntoa = (char FAR * (PASCAL FAR *)(struct in_addr in)) + GetProcAddress(winSock.hInstance, "inet_ntoa"); + winSock.listen = (int (PASCAL FAR *)(SOCKET s, int backlog)) + GetProcAddress(winSock.hInstance, "listen"); + winSock.ntohs = (u_short (PASCAL FAR *)(u_short netshort)) + GetProcAddress(winSock.hInstance, "ntohs"); + winSock.recv = (int (PASCAL FAR *)(SOCKET s, char FAR * buf, + int len, int flags)) GetProcAddress(winSock.hInstance, "recv"); + winSock.select = (int (PASCAL FAR *)(int nfds, fd_set FAR * readfds, + fd_set FAR * writefds, fd_set FAR * exceptfds, + const struct timeval FAR * tiemout)) + GetProcAddress(winSock.hInstance, "select"); + winSock.send = (int (PASCAL FAR *)(SOCKET s, const char FAR * buf, + int len, int flags)) GetProcAddress(winSock.hInstance, "send"); + winSock.setsockopt = (int (PASCAL FAR *)(SOCKET s, int level, + int optname, const char FAR * optval, int optlen)) + GetProcAddress(winSock.hInstance, "setsockopt"); + winSock.shutdown = (int (PASCAL FAR *)(SOCKET s, int how)) + GetProcAddress(winSock.hInstance, "shutdown"); + winSock.socket = (SOCKET (PASCAL FAR *)(int af, int type, + int protocol)) GetProcAddress(winSock.hInstance, "socket"); + winSock.gethostbyaddr = (struct hostent FAR * (PASCAL FAR *) + (const char FAR *addr, int addrlen, int addrtype)) + GetProcAddress(winSock.hInstance, "gethostbyaddr"); + winSock.gethostbyname = (struct hostent FAR * (PASCAL FAR *) + (const char FAR *name)) + GetProcAddress(winSock.hInstance, "gethostbyname"); + winSock.gethostname = (int (PASCAL FAR *)(char FAR * name, + int namelen)) GetProcAddress(winSock.hInstance, "gethostname"); + winSock.getpeername = (int (PASCAL FAR *)(SOCKET sock, + struct sockaddr FAR *name, int FAR *namelen)) + GetProcAddress(winSock.hInstance, "getpeername"); + winSock.getservbyname = (struct servent FAR * (PASCAL FAR *) + (const char FAR * name, const char FAR * proto)) + GetProcAddress(winSock.hInstance, "getservbyname"); + winSock.getsockname = (int (PASCAL FAR *)(SOCKET sock, + struct sockaddr FAR *name, int FAR *namelen)) + GetProcAddress(winSock.hInstance, "getsockname"); + winSock.WSAStartup = (int (PASCAL FAR *)(WORD wVersionRequired, + LPWSADATA lpWSAData)) GetProcAddress(winSock.hInstance, "WSAStartup"); + winSock.WSACleanup = (int (PASCAL FAR *)(void)) + GetProcAddress(winSock.hInstance, "WSACleanup"); + winSock.WSAGetLastError = (int (PASCAL FAR *)(void)) + GetProcAddress(winSock.hInstance, "WSAGetLastError"); + winSock.WSAAsyncSelect = (int (PASCAL FAR *)(SOCKET s, HWND hWnd, + u_int wMsg, long lEvent)) + GetProcAddress(winSock.hInstance, "WSAAsyncSelect"); + + /* + * Now check that all fields are properly initialized. If not, return + * zero to indicate that we failed to initialize properly. + */ + + if ((winSock.hInstance == NULL) || + (winSock.accept == NULL) || + (winSock.bind == NULL) || + (winSock.closesocket == NULL) || + (winSock.connect == NULL) || + (winSock.ioctlsocket == NULL) || + (winSock.getsockopt == NULL) || + (winSock.htons == NULL) || + (winSock.inet_addr == NULL) || + (winSock.inet_ntoa == NULL) || + (winSock.listen == NULL) || + (winSock.ntohs == NULL) || + (winSock.recv == NULL) || + (winSock.select == NULL) || + (winSock.send == NULL) || + (winSock.setsockopt == NULL) || + (winSock.socket == NULL) || + (winSock.gethostbyname == NULL) || + (winSock.gethostbyaddr == NULL) || + (winSock.gethostname == NULL) || + (winSock.getpeername == NULL) || + (winSock.getservbyname == NULL) || + (winSock.getsockname == NULL) || + (winSock.WSAStartup == NULL) || + (winSock.WSACleanup == NULL) || + (winSock.WSAGetLastError == NULL) || + (winSock.WSAAsyncSelect == NULL)) { + goto unloadLibrary; + } + + + + /* + * Initialize the winsock library and check the version number. + */ + if ((*winSock.WSAStartup)(MAKEWORD(2,2), &wsaData) != 0) { + emsg("unloading"); + goto unloadLibrary; + } +#ifdef WSA_VERSION_REQD + if (wsaData.wVersion != WSA_VERSION_REQD) { + (*winSock.WSACleanup)(); + goto unloadLibrary; + } +#endif + } + atexit(close_winsock); + + return; + + /* + * Check for per-thread initialization. + */ +unloadLibrary: + + FreeLibrary(winSock.hInstance); + winSock.hInstance = NULL; + return; +} + + + +/* + *---------------------------------------------------------------------- + * + * SocketsEnabled -- + * + * Check that the WinSock DLL is loaded and ready. + * + * Results: + * 1 if it is. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +SocketsEnabled() +{ + int enabled; + + enabled = (winSock.hInstance != NULL); + if (!enabled) { + InitSockets(); + enabled = (winSock.hInstance != NULL); + } + return enabled; +} + +static void close_winsock() +{ + if (winSock.hInstance != NULL) + (*winSock.WSACleanup)(); +} + + + +/* + *---------------------------------------------------------------------- + * + * CreateSocketAddress -- + * + * This function initializes a sockaddr structure for a host and port. + * + * Results: + * 1 if the host was valid, 0 if the host could not be converted to + * an IP address. + * + * Side effects: + * Fills in the *sockaddrPtr structure. + * + *---------------------------------------------------------------------- + */ + +static int +CreateSocketAddress(sockaddrPtr, host, port) + struct sockaddr_in *sockaddrPtr; /* Socket address */ + char *host; /* Host. NULL implies INADDR_ANY */ + int port; /* Port number */ +{ + struct hostent *hostent; /* Host database entry */ + struct in_addr addr; /* For 64/32 bit madness */ + + /* + * Check that WinSock is initialized; do not call it if not, to + * prevent system crashes. This can happen at exit time if the exit + * handler for WinSock ran before other exit handlers that want to + * use sockets. + */ + + if (!SocketsEnabled()) { + Tcl_SetErrno(EFAULT); + return 0; + } + + (void) memset((char *) sockaddrPtr, '\0', sizeof(struct sockaddr_in)); + sockaddrPtr->sin_family = AF_INET; + sockaddrPtr->sin_port = (*winSock.htons)((short) (port & 0xFFFF)); + if (host == NULL) { + addr.s_addr = INADDR_ANY; + } else { + addr.s_addr = (*winSock.inet_addr)(host); + if (addr.s_addr == INADDR_NONE) { + hostent = (*winSock.gethostbyname)(host); + if (hostent != NULL) { + memcpy((char *) &addr, + (char *) hostent->h_addr_list[0], + (size_t) hostent->h_length); + } else { +#ifdef EHOSTUNREACH + Tcl_SetErrno(EHOSTUNREACH); +#else +#ifdef ENXIO + Tcl_SetErrno(ENXIO); +#endif +#endif + return 0; /* Error. */ + } + } + } + + /* + * NOTE: On 64 bit machines the assignment below is rumored to not + * do the right thing. Please report errors related to this if you + * observe incorrect behavior on 64 bit machines such as DEC Alphas. + * Should we modify this code to do an explicit memcpy? + */ + + sockaddrPtr->sin_addr.s_addr = addr.s_addr; + return 1; /* Success. */ +} + +#ifdef DEBUG +static void myerr(char *s,int d) +{ + if (0) + emsg(s,d); + +} +#else +#define myerr(a,b) +#endif + + + +/* + *---------------------------------------------------------------------- + * + * CreateSocket -- + * + * This function opens a new socket and initializes the + * return -1 on failure, or else an fd + * + *---------------------------------------------------------------------- + */ +static int myerror; +int +CreateSocket(port, host, server, myaddr, myport, async) + int port; /* Port number to open. */ + char *host; /* Name of host on which to open port. */ + int server; /* 1 if socket should be a server socket, + * else 0 for a client socket. */ + char *myaddr; /* Optional client-side address */ + int myport; /* Optional client-side port */ + int async; /* If nonzero, connect client socket + * asynchronously. */ +{ + u_long flag = 1; /* Indicates nonblocking mode. */ + int asyncConnect = 0; /* Will be 1 if async connect is + * in progress. */ + struct sockaddr_in sockaddr; /* Socket address */ + struct sockaddr_in mysockaddr; /* Socket address for client */ + SOCKET sock = 0; + + /* + * Check that WinSock is initialized; do not call it if not, to + * prevent system crashes. This can happen at exit time if the exit + * handler for WinSock ran before other exit handlers that want to + * use sockets. + */ + + if (!SocketsEnabled()) { + return -1; + } + + if (! CreateSocketAddress(&sockaddr, host, port)) { + goto error; + } + if ((myaddr != NULL || myport != 0) && + ! CreateSocketAddress(&mysockaddr, myaddr, myport)) { + goto error; + } + + sock = (*winSock.socket)(AF_INET, SOCK_STREAM, 0); + if (sock == INVALID_SOCKET) { + goto error; + } + + /* + * Win-NT has a misfeature that sockets are inherited in child + * processes by default. Turn off the inherit bit. + */ + + SetHandleInformation( (HANDLE) sock, HANDLE_FLAG_INHERIT, 0 ); + + /* + * Set kernel space buffering + */ + + /* TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE); */ + + if (server) { + /* + * Bind to the specified port. Note that we must not call setsockopt + * with SO_REUSEADDR because Microsoft allows addresses to be reused + * even if they are still in use. + * + * Bind should not be affected by the socket having already been + * set into nonblocking mode. If there is trouble, this is one place + * to look for bugs. + */ + + if ((*winSock.bind)(sock, (struct sockaddr *) &sockaddr, + sizeof(sockaddr)) == SOCKET_ERROR) { + goto error; + } + + /* + * Set the maximum number of pending connect requests to the + * max value allowed on each platform (Win32 and Win32s may be + * different, and there may be differences between TCP/IP stacks). + */ + + if ((*winSock.listen)(sock, SOMAXCONN) == SOCKET_ERROR) { + goto error; + } + + + } else { + + /* + * Try to bind to a local port, if specified. + */ + + if (myaddr != NULL || myport != 0) { + if ((*winSock.bind)(sock, (struct sockaddr *) &mysockaddr, + sizeof(struct sockaddr)) == SOCKET_ERROR) { + goto error; + } + } + + /* + * Set the socket into nonblocking mode if the connect should be + * done in the background. + */ + + if (async) { + if ((*winSock.ioctlsocket)(sock, FIONBIO, &flag) == SOCKET_ERROR) { + goto error; + } + } + + /* + * Attempt to connect to the remote socket. + */ + + if ((*winSock.connect)(sock, (struct sockaddr *) &sockaddr, + sizeof(sockaddr)) == SOCKET_ERROR) { + myerror = (*winSock.WSAGetLastError)(); + if (myerror != WSAEWOULDBLOCK) { + goto error; + } + } + + /* + * The connection is progressing in the background. + */ + + asyncConnect = 1; + } + + + + /* + * Set up the select mask for read/write events. If the connect + * attempt has not completed, include connect events. + */ + + + + /* + * Register for interest in events in the select mask. Note that this + * automatically places the socket into non-blocking mode. + */ + + (*winSock.ioctlsocket)(sock, FIONBIO, &flag); + /* SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); + */ + + return sock; + +error: + /* TclWinConvertWSAError((*winSock.WSAGetLastError)()); + if (interp != NULL) { + Tcl_AppendResult(interp, "couldn't open socket: ", + Tcl_PosixError(interp), (char *) NULL); + } + */ + if (sock != INVALID_SOCKET) { + (*winSock.closesocket)(sock); + } + return -1; +} + + + +/* + *---------------------------------------------------------------------- + * + * TcpOutputProc -- + * + * This procedure is called by the generic IO level to write data + * to a socket based channel. + * + * Results: + * The number of bytes written or -1 on failure. + * + * Side effects: + * Produces output on the socket. + * + *---------------------------------------------------------------------- + */ + +int +TcpOutputProc ( int fd, char *buf, int toWrite, int *errorCodePtr, int block ) +{ + int bytesWritten=0; + int error; + int count=1000*30; + + *errorCodePtr = 0; + + /* + * Check that WinSock is initialized; do not call it if not, to + * prevent system crashes. This can happen at exit time if the exit + * handler for WinSock ran before other exit handlers that want to + * use sockets. + */ + + + if (!SocketsEnabled()) { + *errorCodePtr = EFAULT; + return -1; + } + + while (block) { + + AGAIN: + /* + * In the blocking case, wait until the file becomes writable + * or closed and try again. + */ + { fd_set writefds; + int res; + struct timeval timeout; + FD_ZERO(&writefds); + FD_SET(fd,&writefds); + timeout.tv_sec = (block == 0 ? 0 : 60*60*24*30); + timeout.tv_usec = 0; + if (!(res=(*winSock.select)(fd+1,NULL,&writefds,NULL,&timeout)) ) + { bytesWritten = -1; + + break; + } + } + + + + bytesWritten = (*winSock.send)(fd, buf, toWrite, 0); + if (bytesWritten != SOCKET_ERROR) { + /* + * Since Windows won't generate a new write event until we hit + * an overflow condition, we need to force the event loop to + * poll until the condition changes. + */ + break; + } + + /* + * Check for error condition or overflow. In the event of overflow, we + * need to clear the FD_WRITE flag so we can detect the next writable + * event. Note that Windows only sends a new writable event after a + * send fails with WSAEWOULDBLOCK. + */ + + error = (*winSock.WSAGetLastError)(); + + if (error == WSAEWOULDBLOCK) { + *errorCodePtr = EWOULDBLOCK; + CHECK_INTERRUPT; + Sleep(30); + bytesWritten = -1; + if (--count < 0) + break; + else goto AGAIN; + + } else { + /* TclWinConvertWSAError(error); */ + + *errorCodePtr = EINVAL; + bytesWritten = -1; + break; + } + + + } + return bytesWritten; +} + + + + +/* + getCharGclSocket(strm,block) -- get one character from a socket + stream. + Results: a character or EOF if at end of file + Side Effects: The buffer may be filled, and the fill pointer + of the buffer may be changed. + */ +int getCharGclSocket(strm,block) + object strm; + object block; +{ + object bufp = SOCKET_STREAM_BUFFER(strm); + if (!SocketsEnabled()) { + return -1; + } + if (bufp->ust.ust_fillp > 0) { + dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); + return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; + } + else { + fd_set readfds; + struct timeval timeout; + int fd = SOCKET_STREAM_FD(strm); + if (1) + { int high; + AGAIN: + /* under cygwin a too large timout like (1<<30) does not work */ + timeout.tv_sec = (block != Ct ? 0 : 0); + timeout.tv_usec = (block != Ct ? 0 : 10000); + FD_ZERO(&readfds); + FD_SET(fd,&readfds); + high = (*winSock.select)(fd+1,&readfds,NULL,NULL,&timeout); + if (high > 0) + { object bufp = SOCKET_STREAM_BUFFER(strm); + int n; + n = (*winSock.recv)(fd,bufp->st.st_self ,bufp->ust.ust_dim,0); + doReverse(bufp->st.st_self,n); + bufp->ust.ust_fillp=n; + if (n > 0) + { + return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; + } + else + { return EOF; + FEerror("select said there was stuff there but there was not",0); + } + } + CHECK_INTERRUPT; + /* probably a signal interrupted us.. */ + if (block == Ct) + goto AGAIN; + return EOF; + } + } +} + +void tcpCloseSocket(SOCKET fd) +{ + + (*winSock.closesocket)(fd); + +} + +void ungetCharGclSocket ( int c, object strm) +{ object bufp = SOCKET_STREAM_BUFFER(strm); + if (c == EOF) return; + dprintf("pushing back %c\n",c); + if (bufp->ust.ust_fillp < bufp->ust.ust_dim) { + bufp->ust.ust_self[(bufp->ust.ust_fillp)++]=c; + } else { + FEerror("Tried to unget too many chars",0); + } +} + +void doReverse ( char *s, int n ) +{ + char *p=&s[n-1]; + int m = n/2; + while (--m>=0) { + int tem = *s; + *s = *p; + *p = tem; + s++; p--; + } +} + + +/* +void +sigint() +{ + install_default_signals(); + terminal_interrupt(1); +} +*/ + +#if 0 +BOOL WINAPI inthandler(DWORD i) +{ + emsg("in handler %d",i); + terminal_interrupt(1); + return TRUE; +} +#endif + + +void +alarm(int n) { + return; +} + + +/* to do: + + in the lisp: +start a shared named file based on the pid. +Then others will be able to send us messages, eg:interrupt! +and we will check this value in the CHECK_INTERRUPT +places.. + +Then a little program like test4 or test3 can change +the memory. + +*/ + +static struct { + + HANDLE handle; + LPVOID address; + DWORD length ; + char name[20] ; +} sharedMemory = {0,0,0x10000} ; + +void sigterm() +{ + exit(0); +} + +#ifdef SIGABRT +void sigabrt() +{ + do_gcl_abort(); +} +#endif + + +void sigkill() +{ + do_gcl_abort(); +} + + +static void +init_signals_pendingPtr() { + + static unsigned int where; + if (sharedMemory.address) { + signalsPendingPtr = sharedMemory.address; + } else { + signalsPendingPtr = (void *)&where; + } + gcl_signal(SIGKILL,sigkill); + gcl_signal(SIGTERM,sigterm); +#ifdef SIGABRT + gcl_signal(SIGABRT,sigabrt); +#endif + +} + +void +close_shared_memory() { + + if (sharedMemory.handle) + CloseHandle(sharedMemory.handle); + sharedMemory.handle = NULL; + if (sharedMemory.address) + UnmapViewOfFile(sharedMemory.address); + sharedMemory.address = NULL; + init_signals_pendingPtr(); + +} + +void +init_shared_memory (void) { + static int n; + + if (n) return; + n=1; + + sharedMemory.address=0; + init_signals_pendingPtr(); + return; + + sprintf(sharedMemory.name,"gcl-%d",getpid()); + sharedMemory.handle = + CreateFileMapping((HANDLE)-1,NULL,PAGE_READWRITE,0,sharedMemory.length ,TEXT(sharedMemory.name)); + if (sharedMemory.handle == NULL) + error("CreateFileMapping failed"); + sharedMemory.address = + MapViewOfFile(sharedMemory.handle, /* Handle to mapping object. */ + FILE_MAP_WRITE, /* Read/write permission */ + 0, /* Max. object size. */ + 0, /* Size of hFile. */ + 0); /* Map entire file. */ + if (sharedMemory.address == NULL) + error("MapViewOfFile failed"); + init_signals_pendingPtr(); + atexit(close_shared_memory); + +} + +/* The only signal REALLY handled somewhat under mingw is the + SIGINT, and we need to make the following allow blocking of this. + by for example taking the signal and then recording we got it, + but delivering it later in the unblock code time ... ie in the +*/ + +static sigset_t _current_set=0; +void +sigemptyset( sigset_t *set) +{ + *set = 0; +} +void +sigaddset( sigset_t *set, int n) +{ + *set |= (1 << n); +} + +int +sigismember ( sigset_t *set, int n) +{ + return ((*set & (1 << n)) != 0); + +} + +int +sigprocmask (int how , const sigset_t *set,sigset_t *oldset) + +{ + if (oldset) *oldset = _current_set; + if (set) { + switch (how) + { + case SIG_BLOCK: + _current_set |= *set; + break; + case SIG_UNBLOCK: + _current_set &= ~(*set); + break; + case SIG_SETMASK: + _current_set = *set; + break; + } + + } + return 0; +} + +char *GCLExeName ( void ) +{ + static char module_name_buf[128]; + char *rv = NULL; + module_name_buf[0] = 0; + DWORD result = GetModuleFileName ( (HMODULE) NULL, (LPTSTR) &module_name_buf, 128 ); + if ( result != 0 ) { + rv = module_name_buf; + } + return ( (char *) rv ); +} + +int +vsystem(const char *command) { + + STARTUPINFO s={0}; + PROCESS_INFORMATION p={0}; + long unsigned int e; + + massert(CreateProcess(NULL,(void *)command,NULL,NULL,FALSE,0,NULL,NULL,&s,&p)); + massert(!WaitForSingleObject(p.hProcess,INFINITE)); + massert(GetExitCodeProcess(p.hProcess,&e)); + massert(CloseHandle(p.hProcess)); + massert(CloseHandle(p.hThread)); + + return e; + +} diff --git a/o/multival.c b/o/multival.c new file mode 100755 index 0000000..8694cd7 --- /dev/null +++ b/o/multival.c @@ -0,0 +1,139 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + multival.c + + Multiple Values +*/ + +#include "include.h" + +LFD(Lvalues)(void) +{ + if (vs_base == vs_top) vs_base[0] = Cnil; +} + +LFD(Lvalues_list)(void) +{ + + object list; + + check_arg(1); + list = vs_base[0]; + vs_top = vs_base; + while (!endp_prop(list)) { + vs_push(MMcar(list)); + list = MMcdr(list); + } + if (vs_top == vs_base) vs_base[0] = Cnil; +} + +static void +FFN(Fmultiple_value_list)(object form) +{ + + object *top = vs_top; + + if (endp(form)) + FEtoo_few_argumentsF(form); + if (!endp(MMcdr(form))) + FEtoo_many_argumentsF(form); + vs_push(Cnil); + eval(MMcar(form)); + while (vs_base < vs_top) { + top[0] = MMcons(vs_top[-1],top[0]); + vs_top--; + } + vs_base = top; + vs_top = top+1; +} + +static void +FFN(Fmultiple_value_call)(object form) +{ + + object *top = vs_top; + object *top1; + object *top2; + + if (endp(form)) + FEtoo_few_argumentsF(form); + eval(MMcar(form)); + vs_top = top; + vs_push(vs_base[0]); + form = MMcdr(form); + while (!endp(form)) { + top1 = vs_top; + eval(MMcar(form)); + top2 = vs_top; + vs_top = top1; + while (vs_base < top2) { + vs_push(vs_base[0]); + vs_base++; + } + form = MMcdr(form); + } + vs_base = top+1; + super_funcall(top[0]); +} + +static void +FFN(Fmultiple_value_prog1)(object forms) +{ + + object *top; + object *base = vs_top; + + if (endp(forms)) + FEtoo_few_argumentsF(forms); + eval(MMcar(forms)); + top = vs_top; + vs_top=base; + while (vs_base < top) { + vs_push(vs_base[0]); + vs_base++; + } + top = vs_top; + forms = MMcdr(forms); + while (!endp(forms)) { + eval(MMcar(forms)); + vs_top = top; + forms = MMcdr(forms); + } + vs_base = base; + vs_top = top; + if (vs_base == vs_top) vs_base[0] = Cnil; +} + + +void +gcl_init_multival(void) +{ + make_constant("MULTIPLE-VALUES-LIMIT",make_fixnum(32)); + make_function("VALUES",Lvalues); + make_function("VALUES-LIST",Lvalues_list); + make_special_form("MULTIPLE-VALUE-CALL",Fmultiple_value_call); + make_special_form("MULTIPLE-VALUE-PROG1", + Fmultiple_value_prog1); + make_special_form("MULTIPLE-VALUE-LIST",Fmultiple_value_list); +} diff --git a/o/mych b/o/mych new file mode 100755 index 0000000..14663ca --- /dev/null +++ b/o/mych @@ -0,0 +1,60 @@ +from main.c +#else + kcl_self = find_executable(argv[0]); +#endif + + +#ifdef NeXT +#include +#include + + +static int +is_executable(fn) + char *fn; +{ + struct stat s; + + return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG + && access (fn, X_OK) != -1; +} + +char * +find_executable(fn) + char *fn; +{ + char *path, *getenv(); + static char buf[MAXPATHLEN+1]; + static char msg[100]; + register char *p; + + for (p = fn; *p; p++) { + if (*p == '/') { + if (is_executable (fn)) + return fn; + else { + sprintf(msg, "%s is not executable", fn); + error(msg); + } + } + } + if ((path = getenv ("PATH")) == 0) + error("PATH is undefined"); + do { + p = buf; + while (*path && *path != ':') + *p++ = *path++; + if (*path) + ++path; + if (p > buf) + *p++ = '/'; + strcpy (p, fn); + if (is_executable (buf)) + return buf; + } while (*path); + sprintf(msg, "cannot find pathname of %s", fn); + error(msg); +} +#endif + + diff --git a/o/ndiv.c b/o/ndiv.c new file mode 100755 index 0000000..5e95822 --- /dev/null +++ b/o/ndiv.c @@ -0,0 +1,118 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + + +/* author: William F. Schelter + The following is an implementation of extended_div in C suitable + for a machine which can do 32 bit arithmetic. + The assembler output could be optimized, so that carry tests + were read from the condition codes +*/ + +#include "arith.h" + +/* #define ESTIMATE_LOG_QUOTIENT(x,l,d) estimate_logq(x,l,d) */ +#define ESTIMATE_LOG_QUOTIENT(x,l,d) 31 + +/* +int +estimate_logq(x,l,div) +unsigned int x,div,l; +{ unsigned int logq,w; + if (x==0) {w=0;x=l;} else {w=WSIZ;} + for(logq=0; logq < WSIZ ; logq+=1) + if ((div << logq) >= x) + break; + return 31; + return logq+w;} + +*/ + + +extended_div(divisor,dh,dl,q,r) +unsigned int dh,dl , divisor, *q, *r; +{ unsigned int Rh,Rl,temph,templ; + unsigned int Q; + int iter; +#ifdef DEBUG + char *op; +#endif + Rh=dh; + Rl=dl; + + /* if (dh) printf("\n(di %d %d %d ",divisor,dh,dl); */ + + NORMALIZE(Rh,Rl); + Q=0; + if (dh==0) + {*q=dl/divisor; *r=dl%divisor; + return;} +#ifdef DEBUG + printf("\n%d (Q %d %d) (R %d %d) %s" , -1,0,Q,Rh,Rl,"begin"); +#endif + for (iter=ESTIMATE_LOG_QUOTIENT(dh,dl,divisor); iter >=0 ; iter-= 1) + { + /* assert(Q*divisor+R ==dividend); */ + lshift(divisor,iter,temph,templ); + if ((int)Rh>=0) + {lsub(temph,templ,Rh,Rl); +#ifdef DEBUG + op="add"; +#endif + /* lshift(1,iter,temph,templ); + ladd(temph,templ,Qh,Ql); + */ + /* ladd(0,(1<s.s_gfdef ==0 */ +/* ) */ +/* fun_name = IisFboundp(fun_name); */ +/* if (fun_name->s.s_sfdef != NOT_SPECIAL || fun_name->s.s_mflag) */ +/* FEinvalid_function(fun_name); */ +/* fun = fun_name->s.s_gfdef; */ +/* if (Rset == 0 || */ +/* !( type_of(fun)==t_afun || type_of(fun)==t_closure)) */ +/* goto GENERAL; */ +/* fn = (void *) fun->sfn.sfn_self; */ +/* fargd = fun->sfn.sfn_argd; */ +/* if ( (F_ARG_FLAGS(fargd) & F_ARG_FLAGS(link_desk)) == F_ARG_FLAGS(fargd) */ +/* && F_MIN_ARGS(fargd) <= F_MIN_ARGS(link_desk) */ +/* && F_MAX_ARGS(fargd) >= F_MIN_ARGS(link_desk) */ +/* && F_TYPES(fargd) == F_TYPES(link_desk)) */ +/* { /\* do the link *\/ */ +/* (void) vpush_extend(link_loc,sLAlink_arrayA->s.s_dbind); */ +/* (void) vpush_extend(*link_loc,sLAlink_arrayA->s.s_dbind); */ +/* *link_loc = fn;} */ + /* make this call */ + + /* figure out the true number of args passed */ +/* nargs = (F_ARG_FLAGS_P(link_desk,F_requires_nargs) ? */ +/* F_NARGS(VFUN_NARGS) : F_NARGS(link_desk)); */ +/* {unsigned int atypes = (F_TYPES(link_desk) >> F_TYPE_WIDTH); */ +/* unsigned int ftypes = (F_TYPES(fargd) >> F_TYPE_WIDTH); */ +/* int i; */ +/* object *new ; */ +/* if (atypes==ftypes) */ +/* { */ +/* #ifdef MUST_COPY_VA_LIST */ +/* new = vec; */ +/* for (i=0; i < nargs ; i++) new[i] = va_arg(ap,object); */ +/* #else */ +/* new = (object *) ap; */ +/* #endif */ +/* } */ +/* else */ +/* { new = vec; */ +/* for (i = 0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH, */ +/* ftypes >>= F_TYPE_WIDTH) */ +/* { int atyp = atypes & MASK_RANGE(0,F_TYPE_WIDTH); */ +/* int ftyp = ftypes & MASK_RANGE(0,F_TYPE_WIDTH); */ +/* object next = va_arg(ap,object); */ +/* new [i] = COERCE_F_TYPE(next, atyp ,ftyp); */ +/* }} */ +/* res = c_apply_n(fn,nargs,new); */ +/* { int lret_type = F_TYPES(link_desk) & MASK_RANGE(0,F_TYPE_WIDTH); */ +/* int fret_type = F_TYPES(fargd) & MASK_RANGE(0,F_TYPE_WIDTH); */ +/* return COERCE_F_TYPE(res,fret_type,lret_type); */ +/* }} */ + +/* GENERAL: */ + /* figure out the true number of args passed */ +/* nargs = (F_ARG_FLAGS_P(link_desk,F_requires_nargs) ? */ +/* F_NARGS(VFUN_NARGS) : F_NARGS(link_desk)); */ + +/* { int atypes,i,restype; */ +/* object res; */ +/* object *base = vs_top; */ +/* #define DEBUG */ +/* #ifdef DEBUG */ +/* bds_ptr oldbd = bds_top; */ +/* frame_ptr oldctl = frs_top; */ +/* #endif */ + +/* restype = F_RESULT_TYPE(link_desk); */ +/* atypes = F_TYPES(link_desk)>> F_TYPE_WIDTH; */ + +/* vs_top+= nargs; */ +/* for (i=0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH) */ +/* { object next = va_arg(ap,object); */ +/* int atyp = atypes & MASK_RANGE(0,F_TYPE_WIDTH); */ +/* base[i] = COERCE_F_TYPE(next,atyp,F_object);} */ +/* res = IapplyVector(fun,nargs,base); */ +/* vs_top = base; */ +/* res = COERCE_F_TYPE(res,F_object,restype); */ +/* #ifdef DEBUG */ +/* if (oldctl != frs_top || oldbd != bds_top) */ +/* FEerror("compiler error ? ",0 ); */ +/* #endif */ +/* return res; */ +/* }} */ + +/* for making a link which calls a function returning a double + + */ + +/* static float */ +/* Icall_proc_float(object fun_name, int link_desk, object (**link_loc) (/\* ??? *\/), va_list ap) */ +/* { object val; */ +/* val = Icall_proc(fun_name,link_desk,link_loc,ap); */ +/* { union { void *p; */ +/* float f;} bil; */ +/* bil.p = val; */ +/* return bil.f;} */ +/* } */ + +#include "apply_n.h" + +object +IapplyVector(object fun, int nargs, object *base) + + +/* Call FUN a lisp object on NARGS which are loaded into an array + starting at BASE. This pushes on the CallHist, and puts the args onto + the arg stack, so that debuggers may examine them. It sets + fcall.nvalues appropriately. */ +{ object res,*abase; + int i; + object *oldtop = vs_top; + unsigned int atypes; + if (oldtop == base) vs_top += nargs; + else + { object *b = base; + int n = nargs; + base = vs_top; vs_top +=n; + while (--n>=0) { base[n] = b[n];}} + vs_check; + switch(type_of(fun)) { + case t_closure: + case t_afun: + ihs_push_base(fun,base); + ihs_check; + VFUN_NARGS=nargs; + fcall.fun = fun; + if (nargs < F_MIN_ARGS(fun->sfn.sfn_argd)) + FEtoo_few_arguments(base,vs_top); + if (nargs > F_MAX_ARGS(fun->sfn.sfn_argd) && F_MAX_ARGS(fun->sfn.sfn_argd)) + FEtoo_many_arguments(base,vs_top); + atypes = F_TYPES(fun->sfn.sfn_argd) >> F_TYPE_WIDTH; + if (atypes==0) {abase = base;} + else { abase = vs_top; + for (i=0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH) + { object next = base[i]; + switch (atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { + case F_object: + break; + case F_int: + ASSURE_TYPE(next,t_fixnum); + next = COERCE_F_TYPE(next,F_object,F_int); + break; + case F_shortfloat: + ASSURE_TYPE(next,t_shortfloat); + next = COERCE_F_TYPE(next,F_object,F_shortfloat); + break; + case F_double_ptr: + ASSURE_TYPE(next,t_longfloat); + next = COERCE_F_TYPE(next,F_object,F_double_ptr); + break; + default: + FEerror("cant get here!",0); + } + vs_push(next);} + + } + res = c_apply_n_fun(fun,nargs,abase); + res = COERCE_F_TYPE(res,F_RESULT_TYPE(fun->sfn.sfn_argd),F_object); + if (F_ARG_FLAGS_P(fun->sfn.sfn_argd,F_caller_sets_one_val)) + { fcall.nvalues = 1;} + vs_top = oldtop; + ihs_pop(); + return res; + break; + default: + vs_base = base; + funcall(fun); + fcall.nvalues = vs_top - vs_base; + {int i = fcall.nvalues ; + object *p = vs_top; + object *b = &fcall.values[i]; + vs_top = oldtop; + if (i == 0) + return sLnil; + while(--i > 0) *(--b) = *(--p);} + return vs_base[0]; + break; + } +} + +/* use the following to define functions passing on the value stack, + from ones on the C stack. +Laref() +{ +Iinvoke_c_function_from_value_stack(fLaref,F_ARGD(2,2,0,ARGTYPES(oo,io,oo,oo))); + return; +} + +*/ +void +Iinvoke_c_function_from_value_stack(object (*f)(), int fargd) +{ + int atypes = F_TYPES(fargd)>> F_TYPE_WIDTH; + object *base = vs_base; + int i; + int nargs = vs_top - vs_base; + + object x[64],res; + int min,max; + min = F_MIN_ARGS(fargd); + max = F_MAX_ARGS(fargd); + if (nargs < min || nargs > max) + { FEerror("Wrong number of args",0); + } + for (i=0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH) + { object next = base[i]; + int atyp = atypes & MASK_RANGE(0,F_TYPE_WIDTH); + if (atyp == F_object) + x[i] = next; + else if (atyp == F_int) + { ASSURE_TYPE(next,t_fixnum); + x[i] = COERCE_F_TYPE(next,F_object,F_int);} + else if (atyp == F_shortfloat) + { ASSURE_TYPE(next,t_shortfloat); + x[i] = COERCE_F_TYPE(next,F_object,F_shortfloat);} + else if (atyp == F_double_ptr) + { ASSURE_TYPE(next,t_longfloat); + x[i] = COERCE_F_TYPE(next,F_object,F_double_ptr);} + else {FEerror("cant get here!",0);}} + VFUN_NARGS = nargs; + res = c_apply_n_f(f,nargs,x,min,max); + res = COERCE_F_TYPE(res,F_RESULT_TYPE(fargd),F_object); + base[0]=res; + if (F_ARG_FLAGS_P(fargd,F_caller_sets_one_val)) + { vs_top=base+ 1; + } + else + { vs_top=base + fcall.nvalues; + { int nn = fcall.nvalues; + while (--nn > 0) + { base[nn] = fcall.values[nn]; + } + } + } + vs_base=base; + return; +} + +#define TYPE_STRING(i) (i == F_object ? "object" : i == F_int ? "int" : i == F_double_ptr ? "double ptr" : "unknown") + +/* static int */ +/* print_fargd(int fargd) */ +/* { int i; */ +/* int nargs = 7; */ +/* unsigned int ftypes = (F_TYPES(fargd) >> F_TYPE_WIDTH); */ + +/* printf("minargs=%d,maxargs=%d, arg_types=(",F_MIN_ARGS(fargd), */ +/* F_MAX_ARGS(fargd)); */ +/* for (i = 0; i < F_MAX_ARGS(fargd) ; i++, ftypes >>= F_TYPE_WIDTH) */ +/* {int ftyp = ftypes & MASK_RANGE(0,F_TYPE_WIDTH); */ +/* printf(" %s,",TYPE_STRING(ftyp)); */ +/* if (i >= nargs) { printf("...object.."); break;} */ +/* } */ +/* printf(") result_type=%s\n",TYPE_STRING(F_RESULT_TYPE(fargd))); */ +/* fflush(stdout); */ +/* return 0; */ +/* } */ + + + diff --git a/o/nmul.c b/o/nmul.c new file mode 100755 index 0000000..e5ffe03 --- /dev/null +++ b/o/nmul.c @@ -0,0 +1,37 @@ +#include "arith.h" + +extended_mul(a,b,c,h,l) +unsigned int a,b,c, *h, *l; +{unsigned int temph,templ,ah,al,i; + ah=0; + al=0; + /* in case the shift by 32 does not zero an unsigned int.. + we separate out the first step.*/ + {if (b & 1) + {temph=0;templ=a; + ladd(temph,templ,ah,al);} +/* printf("\n%d b=%d a=%d (%d:%d)",i,b,a,ah,al); */ + b=b>>1; +} +i=1; + while(b) + {if (b & 1) + {lshift(a,i,temph,templ); + ladd(temph,templ,ah,al);} + i++;b=b>>1; + } + ladd(0,c,ah,al); + KCLNORMALIZE(ah,al); + *h=ah;*l=al; +} + +#ifndef VSSIZE +try(h,d, h1,l1, qp, rp) +unsigned int d, h, h1,l1,*qp, *rp; +{ +extended_mul (h,d,h1,qp,rp); +} +#endif + + + diff --git a/o/nsocket.c b/o/nsocket.c new file mode 100644 index 0000000..eab7605 --- /dev/null +++ b/o/nsocket.c @@ -0,0 +1,683 @@ +/* the following file compiles under win95 using cygwinb19 */ +#include +#include "include.h" +#include + +#ifdef DODEBUG +#define dprintf(s,arg) emsg(s,arg) +#else +#define dprintf(s,arg) +#endif + +#ifdef HAVE_NSOCKET + + + +#include +#include +#include + +#include +#include +#include + + + +/************* for the sockets ******************/ +#include /* struct sockaddr, SOCK_STREAM, ... */ +#ifndef NO_UNAME +# include /* uname system call. */ +#endif +#include /* struct in_addr, struct sockaddr_in */ +#include /* inet_ntoa() */ +#include /* gethostbyname() */ + +/****************end for sockets *******************/ + + + +/* + * These bits may be ORed together into the "flags" field of a TcpState + * structure. + */ + + +#define TCP_ASYNC_SOCKET (1<<0) /* Asynchronous socket. */ +#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ + +/* + * The following defines the maximum length of the listen queue. This is + * the number of outstanding yet-to-be-serviced requests for a connection + * on a server socket, more than this number of outstanding requests and + * the connection request will fail. + */ + +#ifndef SOMAXCONN +#define SOMAXCONN 100 +#endif + +#if (SOMAXCONN < 100) +#undef SOMAXCONN +#define SOMAXCONN 100 +#endif + +#define VOID void +#define ERROR_MESSAGE(msg) do{ emsg(msg); do_gcl_abort() ; } while(0) + +#ifdef STAND + +main(argc,argv) + char *argv[]; + int argc; +{ + char buf[1000]; + char out[1000]; + char op[10]; + int n,fd; + int x,y,ans,errno; + char *bp; + fd_set readfds; + struct timeval timeout; + + + bp = buf; + fd = doConnect(argv[1],atoi(argv[2])); + if (fd < 0) { + perror("cant connect"); + do_gcl_abort(); + } + + while (1) { int high; + timeout.tv_sec = 20; + timeout.tv_usec = 0; + FD_ZERO(&readfds); + FD_SET(fd,&readfds); + + high = select(fd+1,&readfds,NULL,NULL,&timeout); + if (high > 0) + { + int n; + n = read(fd,buf,sizeof(buf)); + if (3 == sscanf(buf,"%d %s %d",&x,op,&y)) { + switch (op[0]) { + + case '+': sprintf(out,"%d\n",x+y); + break; + case '*': sprintf(out,"%d\n",x*y); + break; + default: + sprintf(out,"bad operation\n"); + } + write(fd,out,strlen(out)); + } + } + } +} + +#endif + + +/* + *---------------------------------------------------------------------- + * + * CreateSocketAddress -- + * + * This function initializes a sockaddr structure for a host and port. + * + * Results: + * 1 if the host was valid, 0 if the host could not be converted to + * an IP address. + * + * Side effects: + * Fills in the *sockaddrPtr structure. + * + *---------------------------------------------------------------------- + */ + +static int +CreateSocketAddress(struct sockaddr_in *sockaddrPtr, char *host, int port) + /* Socket address */ + /* Host. NULL implies INADDR_ANY */ + /* Port number */ +{ + struct hostent *hostent; /* Host database entry */ + struct in_addr addr; /* For 64/32 bit madness */ + + (void) memset((VOID *) sockaddrPtr, '\0', sizeof(struct sockaddr_in)); + sockaddrPtr->sin_family = AF_INET; + sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF)); + if (host == NULL) { + addr.s_addr = INADDR_ANY; + } else { + addr.s_addr = inet_addr(host); + if (addr.s_addr == -1) { + hostent = /* gethostbyname(host); */ +#ifdef STATIC_LINKING + NULL; +#else + gethostbyname(host); +#endif + if (hostent != NULL) { + memcpy((VOID *) &addr, + (VOID *) hostent->h_addr_list[0], + (size_t) hostent->h_length); + } else { +#ifdef EHOSTUNREACH + errno = EHOSTUNREACH; +#else +#ifdef ENXIO + errno = ENXIO; +#endif +#endif + return 0; /* error */ + } + } + } + + /* + * NOTE: On 64 bit machines the assignment below is rumored to not + * do the right thing. Please report errors related to this if you + * observe incorrect behavior on 64 bit machines such as DEC Alphas. + * Should we modify this code to do an explicit memcpy? + */ + + sockaddrPtr->sin_addr.s_addr = addr.s_addr; + return 1; /* Success. */ +} + + + +/* return -1 on failure, or else an fd */ +int +CreateSocket(int port, char *host, int server, char *myaddr, int myport, int async) + /* Port number to open. */ + /* Name of host on which to open port. + * NULL implies INADDR_ANY */ + /* 1 if socket should be a server socket, + * else 0 for a client socket. */ + /* Optional client-side address */ + /* Optional client-side port */ + /* If nonzero and creating a client socket, + * attempt to do an async connect. Otherwise + * do a synchronous connect or bind. */ +{ + int status, sock, /* asyncConnect, */curState, origState; + struct sockaddr_in sockaddr; /* socket address */ + struct sockaddr_in mysockaddr; /* Socket address for client */ + + sock = -1; + origState = 0; + if (! CreateSocketAddress(&sockaddr, host, port)) { + goto addressError; + } + if ((myaddr != NULL || myport != 0) && + ! CreateSocketAddress(&mysockaddr, myaddr, myport)) { + goto addressError; + } + + sock = socket(AF_INET, SOCK_STREAM, 0); + if (sock < 0) { + goto addressError; + } + + /* + * Set the close-on-exec flag so that the socket will not get + * inherited by child processes. + */ + + fcntl(sock, F_SETFD, FD_CLOEXEC); + + /* asyncConnect = 0; */ + status = 0; + if (server) { + + /* + * Set up to reuse server addresses automatically and bind to the + * specified port. + */ + + status = 1; + (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status, + sizeof(status)); + status = bind(sock, (struct sockaddr *) &sockaddr, + sizeof(struct sockaddr)); + if (status != -1) { + status = listen(sock, SOMAXCONN); + } + } else { + if (myaddr != NULL || myport != 0) { + curState = 1; + (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, + (char *) &curState, sizeof(curState)); + status = bind(sock, (struct sockaddr *) &mysockaddr, + sizeof(struct sockaddr)); + if (status < 0) { + goto bindError; + } + } + + /* + * Attempt to connect. The connect may fail at present with an + * EINPROGRESS but at a later time it will complete. The caller + * will set up a file handler on the socket if she is interested in + * being informed when the connect completes. + */ + + if (async) { +#ifndef USE_FIONBIO + origState = fcntl(sock, F_GETFL); + curState = origState | O_NONBLOCK; + status = fcntl(sock, F_SETFL, curState); +#endif + +#ifdef USE_FIONBIO + curState = 1; + status = ioctl(sock, FIONBIO, &curState); +#endif + } else { + status = 0; + } + if (status > -1) { + status = connect(sock, (struct sockaddr *) &sockaddr, + sizeof(sockaddr)); + if (status < 0) { + if (errno == EINPROGRESS) { + /* asyncConnect = 1; */ + status = 0; + } + } + } + } + +bindError: + if (status < 0) { + + ERROR_MESSAGE("couldn't open socket:"); + + if (sock != -1) { + close(sock); + } + return -1; + } + + return sock; + +addressError: + if (sock != -1) { + close(sock); + } + + ERROR_MESSAGE("couldn't open socket:"); + + return -1; +} + + +#ifdef STAND +int +doConnect(host,port) + char *host; /*name of host we are trying to connect to */ + int port; /* port number to use */ +{ + return CreateSocket(port, host, 0 , NULL , 0 , 0); +} +#endif + + + +#define SOCKET_FD(strm) ((strm)->sm.sm_fp ? fileno((strm)->sm.sm_fp) : -1) + +static void +check_socket(object x) +{ + + if (type_of(x) != t_stream || x->sm.sm_mode != smm_socket) + FEwrong_type_argument(sSsocket,x); + +} + +DEFUN_NEW("GETPEERNAME",object,fSgetpeername,SI,1,1,NONE,OO,OO,OO,OO,(object sock), + "Return a list of three elements: the address, the hostname and the port for the other end of the socket. If hostname is not available it will be equal to the address. Invalid on server sockets. Return NIL on failure.") +{ + struct sockaddr_in peername; + socklen_t size = sizeof(struct sockaddr_in); + struct hostent *hostEntPtr; + object address,host; + check_socket(sock); + if (getpeername(SOCKET_FD(sock), (struct sockaddr *) &peername, &size) + >= 0) { + address=make_simple_string(inet_ntoa(peername.sin_addr)); + hostEntPtr = /* gethostbyaddr((char *) &(peername.sin_addr), */ + /* sizeof(peername.sin_addr), AF_INET); */ +#ifdef STATIC_LINKING + NULL; +#else + gethostbyaddr((char *) &(peername.sin_addr), + sizeof(peername.sin_addr), AF_INET); +#endif + + if (hostEntPtr != (struct hostent *) NULL) + host = make_simple_string(hostEntPtr->h_name); + else host = address; + return list(3,address,host,make_fixnum(ntohs(peername.sin_port))); + } else { + return Cnil; + } +} + + +DEFUN_NEW("GETSOCKNAME",object,fSgetsockname,SI,1,1,NONE,OO,OO,OO,OO,(object sock), + "Return a list of three elements: the address, the hostname and the port for the socket. If hostname is not available it will be equal to the address. Return NIL on failure. ") +{ struct sockaddr_in sockname; + socklen_t size = sizeof(struct sockaddr_in); + struct hostent *hostEntPtr; + object address,host; + + check_socket(sock); + if (getsockname(SOCKET_FD(sock), (struct sockaddr *) &sockname, &size) + >= 0) { + address= make_simple_string(inet_ntoa(sockname.sin_addr)); + hostEntPtr = /* gethostbyaddr((char *) &(sockname.sin_addr), */ + /* sizeof(sockname.sin_addr), AF_INET); */ +#ifdef STATIC_LINKING + NULL; +#else + gethostbyaddr((char *) &(sockname.sin_addr), + sizeof(sockname.sin_addr), AF_INET); +#endif + if (hostEntPtr != (struct hostent *) NULL) + host = make_simple_string(hostEntPtr->h_name); + else host=address; + return list(3,address,host,make_fixnum(ntohs(sockname.sin_port))); + } else { + return Cnil; + } +} + +/* + TcpBlocking -- + Use on a tcp socket to alter the blocking or non blocking. + Results 0 if succeeds and errno if fails. + + Side effects: + the channel is setto blocking or nonblocking mode. +*/ + +DEFUN_NEW("SET-BLOCKING",object,fSset_blocking,SI,2,2,NONE,OO,OO,OO,OO,(object sock,object setBlocking), + "Set blocking on if MODE is T otherwise off. Return 0 if succeeds. Otherwise the error number.") +{ + int setting; + int fd ; + AGAIN: + check_stream(sock); + /* set our idea of whether blocking on or off + setBlocking==Cnil <==> blocking turned off. */ + SET_STREAM_FLAG(sock,gcl_sm_tcp_async,setBlocking==Cnil); + if (sock->sm.sm_mode == smm_two_way) { + /* check for case they are sock streams and so + share the same fd */ + if (STREAM_INPUT_STREAM(sock)->sm.sm_fp != NULL + &&STREAM_OUTPUT_STREAM(sock)->sm.sm_fp != NULL + && (SOCKET_FD(STREAM_INPUT_STREAM(sock))== + SOCKET_FD(STREAM_OUTPUT_STREAM(sock)))) + { + SET_STREAM_FLAG(STREAM_OUTPUT_STREAM(sock), + gcl_sm_tcp_async,setBlocking==Cnil); + sock = STREAM_INPUT_STREAM(sock); + /* they share an 'fd' and so only do one. */ + goto AGAIN; + } + else + { + int x1 = fix(FFN(fSset_blocking)(STREAM_INPUT_STREAM(sock),setBlocking)); + int x2 = fix(FFN(fSset_blocking)(STREAM_OUTPUT_STREAM(sock),setBlocking)); + /* if either is negative result return negative. (ie fail) + If either is positive return positive (ie fail) + Zero result means both ok. (ie succeed) + */ + + return make_fixnum((x1 < 0 || x2 < 0 ? -2 : x1 > 0 ? x1 : x2)); + } + } + + if (sock->sm.sm_fp == NULL) + return make_fixnum(-2); + fd = SOCKET_FD(sock); + + +#ifndef USE_FIONBIO + setting = fcntl(fd, F_GETFL); + if (setBlocking != Cnil) { + setting &= (~(O_NONBLOCK)); + } else { + setting |= O_NONBLOCK; + } + if (fcntl(fd, F_SETFL, setting) < 0) { + return make_fixnum(errno); + } +#endif + +#ifdef USE_FIONBIO + if (setBlocking != Cnil) { + setting = 0; + if (ioctl(fd, (int) FIONBIO, &setting) == -1) { + return make_fixnum(errno); + } + } else { + setting = 1; + if (ioctl(fd, (int) FIONBIO, &setting) == -1) { + return make_fixnum(errno); + } + } +#endif + return make_fixnum(0); +} + +/* with 2 args return the function if any. +*/ + +/*setHandler(stream,readable,function) + object stream; stream to watch + object readable; keyword readable,writable + object function; the handler function to be invoked with arg stream +{ + +} +*/ +/* goes through the streams does a select with 0 timeout, and invokes + any handlers */ +/* +update () +{ + +} +*/ + +static int +joe(int x) { return x; } + +/* + get a character from FP but block, if it would return + the EOF, but the stream is not closed. +*/ +int +getOneChar(FILE *fp) +{ + fd_set readfds; + struct timeval timeout; + int fd= fileno(fp); + int high; + /* fprintf(stderr,"",fp); + fflush(stderr); */ + emsg("in getOneChar, fd=%d,fp=%p",fd,fp); + if (fd == 0) + { joe(fd); + return -1; + } + + while (1) { + timeout.tv_sec = 0; + timeout.tv_usec = 200000; + FD_ZERO(&readfds); + FD_SET(fd,&readfds); + CHECK_INTERRUPT; + high = select(fd+1,&readfds,NULL,NULL,&timeout); + if (high > 0) + { + int ch ; + emsg("in getOneChar, fd=%d,fp=%p",fd,fp); + ch = getc(fp); + if ( ch != EOF || feof(fp) ) { + /* fprintf(stderr,"< 0x%x returning %d,%c>\n",fp,ch,ch); + fflush(stderr); + */ + } + emsg("in getOneChar, ch= %c,%d\n",ch,ch); + CHECK_INTERRUPT; + if (ch != EOF) return ch; + if (feof(fp)) return EOF; + } + + } +} + +#ifdef DODEBUG +#define dprintf(s,arg) emsg(s,arg) +#else +#define dprintf(s,arg) +#endif + +void +ungetCharGclSocket(int c, object strm) + /* the character to unget */ + /* stream */ +{ object bufp = SOCKET_STREAM_BUFFER(strm); + if (c == EOF) return; + dprintf("pushing back %c\n",c); + if (bufp->ust.ust_fillp < bufp->ust.ust_dim) { + bufp->ust.ust_self[(bufp->ust.ust_fillp)++]=c; + } else { + FEerror("Tried to unget too many chars",0); + } +} + + +/* + *---------------------------------------------------------------------- + * + * TcpOutputProc -- + * + * This procedure is invoked by the generic IO level to write output + * to a TCP socket based channel. + * + * NOTE: We cannot share code with FilePipeOutputProc because here + * we must use send, not write, to get reliable error reporting. + * + * Results: + * The number of bytes written is returned. An output argument is + * set to a POSIX error code if an error occurred, or zero. + * + * Side effects: + * Writes output on the output device of the channel. + * + *---------------------------------------------------------------------- + */ + +int +TcpOutputProc(int fd, char *buf, int toWrite, int *errorCodePtr) + /* Socket state. */ + /* The data buffer. */ + /* How many bytes to write? */ + /* Where to store error code. */ +{ + int written; + + *errorCodePtr = 0; + written = send(fd, buf, (size_t) toWrite, 0); + if (written > -1) { + return written; + } + *errorCodePtr = errno; + return -1; +} + +void +tcpCloseSocket(int fd) +{ + close(fd); + +} + +static void +doReverse(char *s, int n) +{ char *p=&s[n-1]; + int m = n/2; + while (--m>=0) { + int tem = *s; + *s = *p; + *p = tem; + s++; p--; + } +} + + + +/* + getCharGclSocket(strm,block) -- get one character from a socket + stream. + Results: a character or EOF if at end of file + Side Effects: The buffer may be filled, and the fill pointer + of the buffer may be changed. + */ +int +getCharGclSocket(object strm, object block) { + + object bufp=SOCKET_STREAM_BUFFER(strm); + int fd=SOCKET_STREAM_FD(strm); + + if (bufp->ust.ust_fillp > 0) + return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; + + if (fd>=0) { + + fd_set readfds; + struct timeval t,t1={0,10000},*tp=block==Ct ? NULL : &t; + int high,n; + + FD_ZERO(&readfds); + FD_SET(fd,&readfds); + + for (;(errno=0,t=t1,high=select(fd+1,&readfds,NULL,NULL,tp))==-1 && !tp && errno==EINTR;); + + if (high > 0) { + + massert((n=SAFE_READ(fd,bufp->st.st_self,bufp->ust.ust_dim))>=0); + + if (n) { + doReverse(bufp->st.st_self,n); + bufp->ust.ust_fillp=n; + } else + SOCKET_STREAM_FD(strm)=-1; + + return getCharGclSocket(strm,block); + + } + + } + + return EOF; + +} + +#else +int +getOneChar(fp) + FILE *fp; +{ + return getc(fp); +} + +#endif + + + diff --git a/o/ntheap.h b/o/ntheap.h new file mode 100755 index 0000000..f7c5e36 --- /dev/null +++ b/o/ntheap.h @@ -0,0 +1,117 @@ +/* Heap management routines (including unexec) for GNU Emacs on Windows NT. + Copyright (C) 1994 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. + + Geoff Voelker (voelker@cs.washington.edu) 7-29-94 +*/ + +#ifndef NTHEAP_H_ +#define NTHEAP_H_ + +#include + +/* + * Heap related stuff. + */ +#define get_reserved_heap_size() reserved_heap_size +#define get_committed_heap_size() (get_data_end () - get_data_start ()) +#define get_heap_start() get_data_start () +#define get_heap_end() get_data_end () +#define get_page_size() sysinfo_cache.dwPageSize +#define get_allocation_unit() sysinfo_cache.dwAllocationGranularity +#define get_processor_type() sysinfo_cache.dwProcessorType +#define get_nt_major_version() nt_major_version +#define get_nt_minor_version() nt_minor_version + +extern unsigned char *get_data_start(); +extern unsigned char *get_data_end(); +extern unsigned long data_region_size; +extern unsigned long reserved_heap_size; +extern SYSTEM_INFO sysinfo_cache; +extern int nt_major_version; +extern int nt_minor_version; + +/* To prevent zero-initialized variables from being placed into the bss + section, use non-zero values to represent an uninitialized state. */ +#define UNINIT_PTR ((void *) 0xF0A0F0A0) +#define UNINIT_LONG (0xF0A0F0A0L) + +enum { + OS_WIN95 = 1, + OS_NT +}; + +extern int os_subtype; + +/* Emulation of Unix sbrk(). */ +extern void *sbrk (ptrdiff_t size); + +/* Recreate the heap created during dumping. */ +extern void recreate_heap (char *executable_path); + +/* Round the heap to this size. */ +extern void round_heap (unsigned long size); + +/* Load in the dumped .bss section. */ +extern void read_in_bss (char *name); + +/* Map in the dumped heap. */ +extern void map_in_heap (char *name); + +/* Cache system info, e.g., the NT page size. */ +extern void cache_system_info (void); + +/* Round ADDRESS up to be aligned with ALIGN. */ +extern unsigned char *round_to_next (unsigned char *address, + unsigned long align); + +/* ----------------------------------------------------------------- */ +/* Useful routines for manipulating memory-mapped files. */ + +typedef struct file_data { + char *name; + unsigned long size; + HANDLE file; + HANDLE file_mapping; + unsigned char *file_base; +} file_data; + +#define OFFSET_TO_RVA(var,section) \ + (section->VirtualAddress + ((DWORD)(var) - section->PointerToRawData)) + +#define RVA_TO_OFFSET(var,section) \ + (section->PointerToRawData + ((DWORD)(var) - section->VirtualAddress)) + +#define RVA_TO_PTR(var,section,filedata) \ + ((void *)(RVA_TO_OFFSET(var,section) + (filedata).file_base)) + +int open_input_file (file_data *p_file, char *name); +int open_output_file (file_data *p_file, char *name, unsigned long size); +void close_file_data (file_data *p_file); + +unsigned long get_section_size (PIMAGE_SECTION_HEADER p_section); + +/* Return pointer to section header for named section. */ +IMAGE_SECTION_HEADER * find_section (char * name, IMAGE_NT_HEADERS * nt_header); + +/* Return pointer to section header for section containing the given + relative virtual address. */ +IMAGE_SECTION_HEADER * rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header); + +#endif /* NTHEAP_H_ */ diff --git a/o/num_arith.c b/o/num_arith.c new file mode 100755 index 0000000..b912b87 --- /dev/null +++ b/o/num_arith.c @@ -0,0 +1,1040 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + Arithmetic operations +*/ +#define NEED_MP_H +#include "include.h" + +#include "num_include.h" + +void +zero_divisor(void); + +object fixnum_add(fixnum i, fixnum j) +{ + + if (i>=0) + { if (j<= (MOST_POSITIVE_FIX-i)) + { return make_fixnum(i+j); + } + MPOP(return,addss,i,j); + } else { /* i < 0 */ + if ((MOST_NEGATIVE_FIX -i) <= j) { + return make_fixnum(i+j); + } + MPOP(return,addss,i,j); + } +} +/* return i - j */ +object fixnum_sub(fixnum i, fixnum j) +{ + + if (i>=0) + { if (j >= (i - MOST_POSITIVE_FIX)) + { return make_fixnum(i-j); + } + MPOP(return,subss,i,j); + } else { /* i < 0 */ + if ((MOST_NEGATIVE_FIX -i) <= -j) { + return make_fixnum(i-j); + } + MPOP(return,subss,i,j); + } +} + +object +fixnum_times(fixnum i, fixnum j) { + +#ifdef HAVE_CLZL + if (i!=MOST_NEGATIVE_FIX && j!=MOST_NEGATIVE_FIX && fixnum_mul_safe(i,j)) +#else + if (i>=0 ? (j>=0 ? (!i || j<= (MOST_POSITIVE_FIX/i)) : (j==-1 || i<= (MOST_NEGATIVE_FIX/j))) : + (j>=0 ? (i==-1 || j<= (MOST_NEGATIVE_FIX/i)) : (i>MOST_NEGATIVE_FIX && -i<= (MOST_POSITIVE_FIX/-j)))) +#endif + return make_fixnum(i*j); + else + MPOP(return,mulss,i,j); +} + + +static object +number_to_complex(object x) +{ + object z; + + switch (type_of(x)) { + + case t_fixnum: + case t_bignum: + case t_ratio: + case t_shortfloat: + case t_longfloat: + z = alloc_object(t_complex); + z->cmp.cmp_real = x; + z->cmp.cmp_imag = small_fixnum(0); + return(z); + + case t_complex: + return(x); + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +number_plus(object x, object y) +{ + double dx, dy; + object z; + switch (type_of(x)) { + case t_fixnum: + switch(type_of(y)) { + case t_fixnum: + return fixnum_add(fix(x),fix(y)); + case t_bignum: + MPOP(return, addsi,fix(x),MP(y)); + case t_ratio: + z = number_plus(number_times(x, y->rat.rat_den), + y->rat.rat_num); + return make_ratio(z, y->rat.rat_den); + case t_shortfloat: + dx = (double)(fix(x)); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = (double)(fix(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + MPOP(return,addsi,fix(y),MP(x)); + case t_bignum: + MPOP(return,addii,MP(y),MP(x)); + case t_ratio: + z = number_plus(number_times(x, y->rat.rat_den), y->rat.rat_num); + return make_ratio(z, y->rat.rat_den); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + + z = number_plus(x->rat.rat_num, + number_times(x->rat.rat_den, y)); + z = make_ratio(z, x->rat.rat_den); + return(z); + case t_ratio: + + z = number_plus(number_times(x->rat.rat_num,y->rat.rat_den), + number_times(x->rat.rat_den,y->rat.rat_num)); + z = make_ratio(z,number_times(x->rat.rat_den,y->rat.rat_den)); + return(z); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_shortfloat: + switch (type_of(y)) { + case t_fixnum: + dx = (double)(sf(x)); + dy = (double)(fix(y)); + goto SHORTFLOAT; + case t_shortfloat: + dx = (double)(sf(x)); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = (double)(sf(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dx = (double)(sf(x)); + dy = number_to_double(y); + goto SHORTFLOAT; + } + SHORTFLOAT: + z = alloc_object(t_shortfloat); + sf(z) = (shortfloat)(dx + dy); + return(z); + + case t_longfloat: + dx = lf(x); + switch (type_of(y)) { + case t_fixnum: + dy = (double)(fix(y)); + goto LONGFLOAT; + case t_shortfloat: + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dy = number_to_double(y); + goto LONGFLOAT; + } + LONGFLOAT: + z = alloc_object(t_longfloat); + lf(z) = dx + dy; + return(z); + + case t_complex: + COMPLEX: + x = number_to_complex(x); + y = number_to_complex(y); + z = make_complex(number_plus(x->cmp.cmp_real, y->cmp.cmp_real), + number_plus(x->cmp.cmp_imag, y->cmp.cmp_imag)); + return(z); + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +one_plus(object x) +{ + double dx; + object z; + + + switch (type_of(x)) { + + case t_fixnum: + return fixnum_add(fix(x),1); + case t_bignum: + MPOP(return,addsi,1,MP(x)); + case t_ratio: + z = number_plus(x->rat.rat_num, x->rat.rat_den); + z = make_ratio(z, x->rat.rat_den); + return(z); + + case t_shortfloat: + dx = (double)(sf(x)); + z = alloc_object(t_shortfloat); + sf(z) = (shortfloat)(dx + 1.0); + return(z); + + case t_longfloat: + dx = lf(x); + z = alloc_object(t_longfloat); + lf(z) = dx + 1.0; + return(z); + + case t_complex: + z = make_complex(one_plus(x->cmp.cmp_real), x->cmp.cmp_imag); + return(z); + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +number_minus(object x, object y) +{ + double dx, dy; + object z; + + + switch (type_of(x)) { + + case t_fixnum: + switch(type_of(y)) { + case t_fixnum: + return fixnum_sub(fix(x),fix(y)); + /* MPOP(return,subss,fix(x),fix(y)); */ + case t_bignum: + MPOP(return, subsi,fix(x),MP(y)); + case t_ratio: + z = number_minus(number_times(x, y->rat.rat_den), y->rat.rat_num); + z = make_ratio(z, y->rat.rat_den); + return(z); + case t_shortfloat: + dx = (double)(fix(x)); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = (double)(fix(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + MPOP(return,subis,MP(x),fix(y)); + case t_bignum: + MPOP(return,subii,MP(x),MP(y)); + case t_ratio: + z = number_minus(number_times(x, y->rat.rat_den), y->rat.rat_num); + z = make_ratio(z, y->rat.rat_den); + return(z); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + z = number_minus(x->rat.rat_num, number_times(x->rat.rat_den, y)); + z = make_ratio(z, x->rat.rat_den); + return(z); + case t_ratio: + z = number_minus(number_times(x->rat.rat_num,y->rat.rat_den), + (number_times(x->rat.rat_den,y->rat.rat_num))); + z = make_ratio(z,number_times(x->rat.rat_den,y->rat.rat_den)); + return(z); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_shortfloat: + switch (type_of(y)) { + case t_fixnum: + dx = (double)(sf(x)); + dy = (double)(fix(y)); + goto SHORTFLOAT; + case t_shortfloat: + dx = (double)(sf(x)); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = (double)(sf(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dx = (double)(sf(x)); + dy = number_to_double(y); + goto SHORTFLOAT; + } + SHORTFLOAT: + z = alloc_object(t_shortfloat); + sf(z) = (shortfloat)(dx - dy); + return(z); + + case t_longfloat: + dx = lf(x); + switch (type_of(y)) { + case t_fixnum: + dy = (double)(fix(y)); + goto LONGFLOAT; + case t_shortfloat: + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dy = number_to_double(y); + } + LONGFLOAT: + z = alloc_object(t_longfloat); + lf(z) = dx - dy; + return(z); + + case t_complex: + COMPLEX: + x = number_to_complex(x); + y = number_to_complex(y); + z = make_complex(number_minus(x->cmp.cmp_real, y->cmp.cmp_real), + number_minus(x->cmp.cmp_imag, y->cmp.cmp_imag)); + return(z); + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +one_minus(object x) +{ + double dx; + object z; + switch (type_of(x)) { + + case t_fixnum: + return fixnum_sub(fix(x),1); + case t_bignum: + MPOP(return,addsi,-1,MP(x)); + case t_ratio: + z = number_minus(x->rat.rat_num, x->rat.rat_den); + z = make_ratio(z, x->rat.rat_den); + return(z); + + case t_shortfloat: + dx = (double)(sf(x)); + z = alloc_object(t_shortfloat); + sf(z) = (shortfloat)(dx - 1.0); + return(z); + + case t_longfloat: + dx = lf(x); + z = alloc_object(t_longfloat); + lf(z) = dx - 1.0; + return(z); + + case t_complex: + z = make_complex(one_minus(x->cmp.cmp_real), x->cmp.cmp_imag); + return(z); + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +number_negate(object x) +{ + object z, z1; + + switch (type_of(x)) { + + case t_fixnum: + if(fix(x) == MOST_NEGATIVE_FIX) + return fixnum_add(1,MOST_POSITIVE_FIX); + else + return(make_fixnum(-fix(x))); + case t_bignum: + return big_minus(x); + case t_ratio: + z1 = number_negate(x->rat.rat_num); + z = alloc_object(t_ratio); + z->rat.rat_num = z1; + z->rat.rat_den = x->rat.rat_den; + return(z); + + case t_shortfloat: + z = alloc_object(t_shortfloat); + sf(z) = -sf(x); + return(z); + + case t_longfloat: + z = alloc_object(t_longfloat); + lf(z) = -lf(x); + return(z); + + case t_complex: + z = make_complex(number_negate(x->cmp.cmp_real), + number_negate(x->cmp.cmp_imag)); + return(z); + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +number_times(object x, object y) +{ + object z; + double dx, dy; + + switch (type_of(x)) { + + case t_fixnum: + switch (type_of(y)) { + case t_fixnum: + return fixnum_times(fix(x),fix(y)); + /* MPOP(return,mulss,fix(x),fix(y)); */ + case t_bignum: + MPOP(return,mulsi,fix(x),MP(y)); + case t_ratio: + z = make_ratio(number_times(x, y->rat.rat_num), y->rat.rat_den); + return(z); + case t_shortfloat: + dx = (double)(fix(x)); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = (double)(fix(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + MPOP(return,mulsi,fix(y),MP(x)); + case t_bignum: + MPOP(return,mulii,MP(y),MP(x)); + case t_ratio: + z = make_ratio(number_times(x, y->rat.rat_num), y->rat.rat_den); + return(z); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + z = make_ratio(number_times(x->rat.rat_num, y), x->rat.rat_den); + return(z); + case t_ratio: + z = make_ratio(number_times(x->rat.rat_num,y->rat.rat_num), + number_times(x->rat.rat_den,y->rat.rat_den)); + return(z); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_shortfloat: + switch (type_of(y)) { + case t_fixnum: + dx = (double)(sf(x)); + dy = (double)(fix(y)); + goto SHORTFLOAT; + case t_shortfloat: + dx = (double)(sf(x)); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = (double)(sf(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dx = (double)(sf(x)); + dy = number_to_double(y); + break; + } + SHORTFLOAT: + z = alloc_object(t_shortfloat); + sf(z) = (shortfloat)(dx * dy); + return(z); + + case t_longfloat: + dx = lf(x); + switch (type_of(y)) { + case t_fixnum: + dy = (double)(fix(y)); + goto LONGFLOAT; + case t_shortfloat: + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dy = number_to_double(y); + } + LONGFLOAT: + z = alloc_object(t_longfloat); + lf(z) = dx * dy; + return(z); + + case t_complex: + COMPLEX: + { + object z1, z2, z11, z12, z21, z22; + + x = number_to_complex(x); + y = number_to_complex(y); + z11 = number_times(x->cmp.cmp_real, y->cmp.cmp_real); + z12 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag); + z21 = number_times(x->cmp.cmp_imag, y->cmp.cmp_real); + z22 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag); + z1 = number_minus(z11, z12); + z2 = number_plus(z21, z22); + z = make_complex(z1, z2); + return(z); + } + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +number_divide(object x, object y) +{ + object z; + double dx, dy; + + switch (type_of(x)) { + + case t_fixnum: + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + if(number_zerop(y) == TRUE) + zero_divisor(); + if (number_minusp(y) == TRUE) { + x = number_negate(x); + y = number_negate(y); + } + z = make_ratio(x, y); + return(z); + case t_ratio: + if(number_zerop(y->rat.rat_num)) + zero_divisor(); + z = make_ratio(number_times(x, y->rat.rat_den), y->rat.rat_num); + return(z); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + if (number_zerop(y)) + zero_divisor(); + z = make_ratio(x->rat.rat_num, number_times(x->rat.rat_den, y)); + return(z); + case t_ratio: + z = make_ratio(number_times(x->rat.rat_num,y->rat.rat_den), + number_times(x->rat.rat_den,y->rat.rat_num)); + return(z); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + FEwrong_type_argument(sLnumber, y); + } + + case t_shortfloat: + switch (type_of(y)) { + case t_fixnum: + dx = (double)(sf(x)); + dy = (double)(fix(y)); + goto SHORTFLOAT; + case t_shortfloat: + dx = (double)(sf(x)); + dy = (double)(sf(y)); + goto SHORTFLOAT; + case t_longfloat: + dx = (double)(sf(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dx = (double)(sf(x)); + dy = number_to_double(y); + goto LONGFLOAT; + } + SHORTFLOAT: + z = alloc_object(t_shortfloat); + if (dy == 0.0) + zero_divisor(); + sf(z) = (shortfloat)(dx / dy); + return(z); + + + case t_longfloat: + dx = lf(x); + switch (type_of(y)) { + case t_fixnum: + dy = (double)(fix(y)); + goto LONGFLOAT; + case t_shortfloat: + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto COMPLEX; + default: + dy = number_to_double(y); + } + LONGFLOAT: + z = alloc_object(t_longfloat); + if (dy == 0.0) + zero_divisor(); + lf(z) = dx / dy; + return(z); + + case t_complex: + COMPLEX: + { + object z1, z2, z3; + + x = number_to_complex(x); + y = number_to_complex(y); + z1 = number_times(y->cmp.cmp_real, y->cmp.cmp_real); + z2 = number_times(y->cmp.cmp_imag, y->cmp.cmp_imag); + if (number_zerop(z3 = number_plus(z1, z2))) + zero_divisor(); + z1 = number_times(x->cmp.cmp_real, y->cmp.cmp_real); + z2 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag); + z1 = number_plus(z1, z2); + z = number_times(x->cmp.cmp_imag, y->cmp.cmp_real); + z2 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag); + z2 = number_minus(z, z2); + z1 = number_divide(z1, z3); + z2 = number_divide(z2, z3); + z = make_complex(z1, z2); + return(z); + } + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +object +integer_divide1(object x, object y,fixnum d) { + object q; + + integer_quotient_remainder_1(x, y, &q, NULL,d); + return(q); + +} + +object +integer_divide2(object x, object y,fixnum d,object *r) { + object q; + + integer_quotient_remainder_1(x, y, &q, r,d); + return(q); + +} + +object +get_gcd_abs(object x,object y) { + + object r; + + for (;;) { + + if (type_of(x) == t_fixnum && type_of(y) == t_fixnum) + return make_fixnum(fixnum_gcd(fix(x),fix(y))); + + if (number_compare(x, y) < 0) { + r = x; + x = y; + y = r; + } + if (type_of(y) == t_fixnum && fix(y) == 0) + return(x); + + integer_quotient_remainder_1(x, y, NULL, &r,0); + x = y; + y = r; + + } + +} + + +object +get_gcd(object x, object y) { + + return get_gcd_abs(number_abs(x),number_abs(y)); + +} + +LFD(Lplus)(void) +{ + fixnum i, j; + + j = vs_top - vs_base; + if (j == 0) { + vs_push(small_fixnum(0)); + return; + } + for (i = 0; i < j; i++) + check_type_number(&vs_base[i]); + for (i = 1; i < j; i++) + vs_base[0] = number_plus(vs_base[0], vs_base[i]); + vs_top = vs_base+1; +} + +LFD(Lminus)(void) +{ + fixnum i, j; + + j = vs_top - vs_base; + if (j == 0) + too_few_arguments(); + for (i = 0; i < j ; i++) + check_type_number(&vs_base[i]); + if (j == 1) { + vs_base[0] = number_negate(vs_base[0]); + return; + } + for (i = 1; i < j; i++) + vs_base[0] = number_minus(vs_base[0], vs_base[i]); + vs_top = vs_base+1; +} + +LFD(Ltimes)(void) +{ + fixnum i, j; + + j = vs_top - vs_base; + if (j == 0) { + vs_push(small_fixnum(1)); + return; + } + for (i = 0; i < j; i++) + check_type_number(&vs_base[i]); + for (i = 1; i < j; i++) + vs_base[0] = number_times(vs_base[0], vs_base[i]); + vs_top = vs_base+1; +} + +LFD(Ldivide)(void) +{ + fixnum i, j; + + j = vs_top - vs_base; + if (j == 0) + too_few_arguments(); + for(i = 0; i < j; i++) + check_type_number(&vs_base[i]); + if (j == 1) { + vs_base[0] = number_divide(small_fixnum(1), vs_base[0]); + return; + } + for (i = 1; i < j; i++) + vs_base[0] = number_divide(vs_base[0], vs_base[i]); + vs_top = vs_base+1; +} + +LFD(Lone_plus)(void) +{ + + check_arg(1); + check_type_number(&vs_base[0]); + vs_base[0] = one_plus(vs_base[0]); +} + +LFD(Lone_minus)(void) +{ + + check_arg(1); + check_type_number(&vs_base[0]); + vs_base[0] = one_minus(vs_base[0]); +} + +LFD(Lconjugate)(void) +{ + object c, i; + + check_arg(1); + check_type_number(&vs_base[0]); + c = vs_base[0]; + if (type_of(c) == t_complex) { + i = number_negate(c->cmp.cmp_imag); + vs_push(i); + vs_base[0] = make_complex(c->cmp.cmp_real, i); + vs_popp; + } +} + +LFD(Lgcd)(void) { + + fixnum i, narg=vs_top-vs_base; + + if (narg == 0) { + vs_push(small_fixnum(0)); + return; + } + + for (i = 0; i < narg; i++) + check_type_integer(&vs_base[i]); + + vs_top=vs_base; + vs_push(number_abs(vs_base[0])); + + for (i = 1; i < narg; i++) + vs_base[0] = get_gcd_abs(vs_base[0], number_abs(vs_base[i])); + +} + +object +get_lcm_abs(object x,object y) { + + object g=get_gcd_abs(x,y); + + return number_zerop(g) ? g : number_times(x,integer_divide1(y,g,0)); + +} + +object +get_lcm(object x,object y) { + + return get_lcm_abs(number_abs(x),number_abs(y)); + +} + +LFD(Llcm)(void) { + + fixnum i, narg; + + narg = vs_top - vs_base; + + if (narg == 0) + too_few_arguments(); + + for (i = 0; i < narg; i++) + check_type_integer(&vs_base[i]); + + vs_top=vs_base; + vs_push(number_abs(vs_base[0])); + + for (i=1;i> 20) - 1022 - 53; + h = ((h & 0x000fffff) | 0x00100000); + } else { + *ep = ((h & 0x7fe00000) >> 20) - 1022 - 53 + 1; + h = (h & 0x001fffff); + } + if (32-BIG_RADIX) + /* shift for making bignum */ + { h = h << (32-BIG_RADIX) ; + h |= ((l & (-1 << (32-BIG_RADIX))) >> (32-BIG_RADIX)); + l &= ~(-1 << (32-BIG_RADIX)); + } + *hp = h; + *lp = l; + *sp = (d > 0.0 ? 1 : -1); +} + +static void +integer_decode_float(double d, int *mp, int *ep, int *sp) +{ + float f; + int m; + union {float f;int i;} u; + + f = d; + if (f == 0.0) { + *mp = 0; + *ep = 0; + *sp = 1; + return; + } + u.f=f; + m=u.i; +/* m = *(int *)(&f); */ + if (ISNORMAL(f)) { + *ep = ((m & 0x7f800000) >> 23) - 126 - 24; + *mp = (m & 0x007fffff) | 0x00800000; + } else { + *ep = ((m & 0x7f000000) >> 23) - 126 - 24 + 1; + *mp = m & 0x00ffffff; + } + *sp = (f > 0.0 ? 1 : -1); +} + +static int +double_exponent(double d) +{ + union {double d;int i[2];} u; + + if (d == 0.0) + return(0); + u.d=d; + return (((u.i[HIND] & 0x7ff00000) >> 20) - 1022); +} + +static double +set_exponent(double d, int e) +{ + union {double d;int i[2];} u; + + if (d == 0.0) + return(0.0); + + u.d=d; + u.i[HIND]= (u.i[HIND] & 0x800fffff) | (((e + 1022) << 20) & 0x7ff00000); + return(u.d); +} + + +object +double_to_integer(double d) { + + int h, l, e, s; + object x; + vs_mark; + + if (d == 0.0) + return(small_fixnum(0)); + integer_decode_double(d, &h, &l, &e, &s); + + if (e <= -BIG_RADIX) { + e = (-e) - BIG_RADIX; + if (e >= BIG_RADIX) + return(small_fixnum(0)); + h >>= e; + return(make_fixnum(s*h)); + } + if (h != 0 || l<0) + x = bignum2(h, l); + else + x = make_fixnum(l); + vs_push(x); + x = integer_fix_shift(x, e); + if (s < 0) { + vs_push(x); + x = number_negate(x); + } + vs_reset; + return(x); +} + +static object +num_remainder(object x, object y, object q) +{ + object z; + + z = number_times(q, y); + vs_push(z); + z = number_minus(x, z); + vs_popp; + return(z); +} + +/* Coerce X to single-float if one arg, + otherwise coerce to same float type as second arg */ + +LFD(Lfloat)(void) +{ + double d; + int narg; + object x; + enum type t=t_longfloat; + + narg = vs_top - vs_base; + if (narg < 1) + too_few_arguments(); + else if (narg > 2) + too_many_arguments(); + if (narg == 2) { + check_type_float(&vs_base[1]); + t = type_of(vs_base[1]); + } + x = vs_base[0]; + switch (type_of(x)) { + case t_fixnum: + if (narg > 1 && t == t_shortfloat) + x = make_shortfloat((shortfloat)(fix(x))); + else + x = make_longfloat((double)(fix(x))); + break; + + case t_bignum: + case t_ratio: + d = number_to_double(x); + if (narg > 1 && t == t_shortfloat) + x = make_shortfloat((shortfloat)d); + else + x = make_longfloat(d); + break; + + case t_shortfloat: + if (narg > 1 && t == t_shortfloat); + else + x = make_longfloat((double)(sf(x))); + break; + + case t_longfloat: + if (narg > 1 && t == t_shortfloat) + x = make_shortfloat((shortfloat)(lf(x))); + break; + + default: + FEwrong_type_argument(TSor_rational_float, x); + } + vs_base = vs_top; + vs_push(x); +} + +LFD(Lnumerator)(void) +{ + check_arg(1); + check_type_rational(&vs_base[0]); + if (type_of(vs_base[0]) == t_ratio) + vs_base[0] = vs_base[0]->rat.rat_num; +} + +LFD(Ldenominator)(void) +{ + check_arg(1); + check_type_rational(&vs_base[0]); + if (type_of(vs_base[0]) == t_ratio) + vs_base[0] = vs_base[0]->rat.rat_den; + else + vs_base[0] = small_fixnum(1); +} + +void +intdivrem(object x,object y,fixnum d,object *q,object *r) { + + enum type tx=type_of(x),ty=type_of(y); + object z,q2,q1; + + if (number_zerop(y)==TRUE) + zero_divisor(); + + switch(tx) { + case t_fixnum: + case t_bignum: + switch (ty) { + case t_fixnum: + case t_bignum: + integer_quotient_remainder_1(x,y,q,r,d); + return; + case t_ratio: + z=integer_divide1(number_times(y->rat.rat_den,x),y->rat.rat_num,d); + if (q) *q=z; + if (r) *r=num_remainder(x,y,z); + return; + default: + break; + } + break; + case t_ratio: + switch (ty) { + case t_fixnum: + case t_bignum: + z=integer_divide1(x->rat.rat_num,number_times(x->rat.rat_den,y),d); + if (q) *q=z; + if (r) *r=num_remainder(x,y,z); + return; + case t_ratio: + z=integer_divide1(number_times(x->rat.rat_num,y->rat.rat_den),number_times(x->rat.rat_den,y->rat.rat_num),d); + if (q) *q=z; + if (r) *r=num_remainder(x,y,z); + return; + default: + break; + } + break; + default: + break; + } + + q2=number_divide(x,y); + q1=double_to_integer(number_to_double(q2)); + if (d && (d<0 ? number_minusp(q2) : number_plusp(q2)) && number_compare(q2, q1)) + q1 = d<0 ? one_minus(q1) : one_plus(q1); + if (q) *q=q1; + if (r) *r=num_remainder(x,y,q1); + return; + +} + +object +number_ldb(object x,object y) { + return ifuncall2(sLldb,x,y); +} + +object +number_ldbt(object x,object y) { + return ifuncall2(sLldb_test,x,y); +} + +object +number_dpb(object x,object y,object z) { + return ifuncall3(sLdpb,x,y,z); +} + +object +number_dpf(object x,object y,object z) { + return ifuncall3(sLdeposit_field,x,y,z); +} + + +LFD(Lfloor)(void) { + + object x, y; + int n = vs_top - vs_base; + + if (n == 0) + too_few_arguments(); + if (n > 2) + too_many_arguments(); + + x = vs_base[0]; + y = n>1 ? vs_base[1] : small_fixnum(1); + + intdivrem(x,y,-1,&x,&y); + + vs_top=vs_base; + vs_push(x); + vs_push(y); + +} + +LFD(Lceiling)(void) { + + object x, y; + int n = vs_top - vs_base; + + if (n == 0) + too_few_arguments(); + if (n > 2) + too_many_arguments(); + + x = vs_base[0]; + y = n>1 ? vs_base[1] : small_fixnum(1); + + intdivrem(x,y,1,&x,&y); + + vs_top=vs_base; + vs_push(x); + vs_push(y); + +} + +LFD(Ltruncate)(void) { + + object x, y; + int n = vs_top - vs_base; + + if (n == 0) + too_few_arguments(); + if (n > 2) + too_many_arguments(); + + x = vs_base[0]; + y = n>1 ? vs_base[1] : small_fixnum(1); + + intdivrem(x,y,0,&x,&y); + + vs_top=vs_base; + vs_push(x); + vs_push(y); + +} + +LFD(Lround)(void) +{ + object x, y, q, q1, r; + double d; + int n, c; + object one_plus(object x), one_minus(object x); + + n = vs_top - vs_base; + if (n == 0) + too_few_arguments(); + if (n > 1) + goto TWO_ARG; + x = vs_base[0]; + switch (type_of(x)) { + + case t_fixnum: + case t_bignum: + vs_push(small_fixnum(0)); + return; + + case t_ratio: + q = x; + y = small_fixnum(1); + goto RATIO; + + case t_shortfloat: + d = (double)(sf(x)); + if (d >= 0.0) + q = double_to_integer(d + 0.5); + else + q = double_to_integer(d - 0.5); + d -= number_to_double(q); + if (d == 0.5 && number_oddp(q)) { + vs_push(q); + q = one_plus(q); + d = -0.5; + } + if (d == -0.5 && number_oddp(q)) { + vs_push(q); + q = one_minus(q); + d = 0.5; + } + vs_base = vs_top; + vs_push(q); + vs_push(make_shortfloat((shortfloat)d)); + return; + + case t_longfloat: + d = lf(x); + if (d >= 0.0) + q = double_to_integer(d + 0.5); + else + q = double_to_integer(d - 0.5); + d -= number_to_double(q); + if (d == 0.5 && number_oddp(q)) { + vs_push(q); + q = one_plus(q); + d = -0.5; + } + if (d == -0.5 && number_oddp(q)) { + vs_push(q); + q = one_minus(q); + d = 0.5; + } + vs_base = vs_top; + vs_push(q); + vs_push(make_longfloat(d)); + return; + + default: + FEwrong_type_argument(TSor_rational_float, x); + } + +TWO_ARG: + if (n > 2) + too_many_arguments(); + x = vs_base[0]; + y = vs_base[1]; + check_type_or_rational_float(&vs_base[0]); + check_type_or_rational_float(&vs_base[1]); + q = number_divide(x, y); + vs_push(q); + switch (type_of(q)) { + case t_fixnum: + case t_bignum: + vs_base = vs_top; + vs_push(q); + vs_push(small_fixnum(0)); + break; + + case t_ratio: + RATIO: + q1 = integer_divide1(q->rat.rat_num, q->rat.rat_den,0);/*FIXME*/ + vs_push(q1); + r = number_minus(q, q1); + vs_push(r); + if ((c = number_compare(r, plus_half)) > 0 || + (c == 0 && number_oddp(q1))) + q1 = one_plus(q1); + if ((c = number_compare(r, minus_half)) < 0 || + (c == 0 && number_oddp(q1))) + q1 = one_minus(q1); + vs_base = vs_top; + vs_push(q1); + vs_push(num_remainder(x, y, q1)); + return; + + case t_shortfloat: + case t_longfloat: + d = number_to_double(q); + if (d >= 0.0) + q1 = double_to_integer(d + 0.5); + else + q1 = double_to_integer(d - 0.5); + d -= number_to_double(q1); + if (d == 0.5 && number_oddp(q1)) { + vs_push(q1); + q1 = one_plus(q1); + } + if (d == -0.5 && number_oddp(q1)) { + vs_push(q1); + q1 = one_minus(q1); + } + vs_base = vs_top; + vs_push(q1); + vs_push(num_remainder(x, y, q1)); + return; + default: + break; + } +} + + +LFD(Lmod)(void) { + check_arg(2); + intdivrem(vs_base[0],vs_base[1],-1,NULL,vs_base); + vs_top=vs_base+1; +} + + +LFD(Lrem)(void) { + check_arg(2); + intdivrem(vs_base[0],vs_base[1],0,NULL,vs_base); + vs_top=vs_base+1; +} + + +LFD(Ldecode_float)(void) +{ + object x; + double d; + int e, s; + + check_arg(1); + check_type_float(&vs_base[0]); + x = vs_base[0]; + if (type_of(x) == t_shortfloat) + d = sf(x); + else + d = lf(x); + if (d >= 0.0) + s = 1; + else { + d = -d; + s = -1; + } + e=0; + if (!ISNORMAL(d)) { + int hp,lp,sp; + + integer_decode_double(d,&hp,&lp,&e,&sp); + if (hp!=0 || lp<0) + d=number_to_double(bignum2(hp, lp)); + else + d=lp; + } + e += double_exponent(d); + d = set_exponent(d, 0); + vs_top = vs_base; + if (type_of(x) == t_shortfloat) { + vs_push(make_shortfloat((shortfloat)d)); + vs_push(make_fixnum(e)); + vs_push(make_shortfloat((shortfloat)s)); + } else { + vs_push(make_longfloat(d)); + vs_push(make_fixnum(e)); + vs_push(make_longfloat((double)s)); + } +} + +LFD(Lscale_float)(void) +{ + object x; + double d; + int e, k=0; + + check_arg(2); + check_type_float(&vs_base[0]); + x = vs_base[0]; + if (type_of(vs_base[1]) == t_fixnum) + k = fix(vs_base[1]); + else + FEerror("~S is an illegal exponent.", 1, vs_base[1]); + if (type_of(x) == t_shortfloat) + d = sf(x); + else + d = lf(x); + e = double_exponent(d) + k; +#ifdef VAX + if (e <= -128 || e >= 128) +#endif +#ifdef IBMRT + +#endif +#ifdef IEEEFLOAT + /* Upper bound not needed, handled by floating point overflow */ + /* this checks if we're in the denormalized range */ + if (!ISNORMAL(d) || (type_of(x) == t_shortfloat && e <= -126/* || e >= 130 */) || + (type_of(x) == t_longfloat && (e <= -1022 /* || e >= 1026 */))) +#endif +#ifdef MV + +#endif +#ifdef S3000 + if (e < -64 || e >= 64) +#endif +/* FEerror("~S is an illegal exponent.", 1, vs_base[1]); */ + { + for (;k>0;d*=2.0,k--); + for (;k<0;d*=0.5,k++); + } + else + d = set_exponent(d, e); + vs_popp; + if (type_of(x) == t_shortfloat) + vs_base[0] = make_shortfloat((shortfloat)d); + else + vs_base[0] = make_longfloat(d); +} + +LFD(Lfloat_radix)(void) +{ + check_arg(1); + check_type_float(&vs_base[0]); +#ifdef VAX + vs_base[0] = small_fixnum(2); +#endif +#ifdef IBMRT + +#endif +#ifdef IEEEFLOAT + vs_base[0] = small_fixnum(2); +#endif +#ifdef MV + +#endif +#ifdef S3000 + vs_base[0] = small_fixnum(16); +#endif +} + +LFD(Lfloat_sign)(void) +{ + object x; + int narg; + double d, f; + + narg = vs_top - vs_base; + if (narg < 1) + too_few_arguments(); + else if (narg > 2) + too_many_arguments(); + check_type_float(&vs_base[0]); + x = vs_base[0]; + if (type_of(x) == t_shortfloat) + d = sf(x); + else + d = lf(x); + if (narg == 1) + f = 1.0; + else { + check_type_float(&vs_base[1]); + x = vs_base[1]; + if (type_of(x) == t_shortfloat) + f = sf(x); + else + f = lf(x); + if (f < 0.0) + f = -f; + } + if (d < 0.0) + f = -f; + vs_top = vs_base; + if (type_of(x) == t_shortfloat) + vs_push(make_shortfloat((shortfloat)f)); + else + vs_push(make_longfloat(f)); +} + +LFD(Lfloat_digits)(void) +{ + check_arg(1); + check_type_float(&vs_base[0]); + if (type_of(vs_base[0]) == t_shortfloat) + vs_base[0] = small_fixnum(24); + else + vs_base[0] = small_fixnum(53); +} + +LFD(Lfloat_precision)(void) +{ + object x; + + check_arg(1); + check_type_float(&vs_base[0]); + x = vs_base[0]; + if (type_of(x) == t_shortfloat) + if (sf(x) == 0.0) + vs_base[0] = small_fixnum(0); + else + vs_base[0] = small_fixnum(24); + else + if (lf(x) == 0.0) + vs_base[0] = small_fixnum(0); + else +#ifdef VAX + vs_base[0] = small_fixnum(53); +#endif +#ifdef IBMRT + +#endif +#ifdef IEEEFLOAT + vs_base[0] = small_fixnum(53); +#endif +#ifdef MV + +#endif +#ifdef S3000 + vs_base[0] = small_fixnum(53); +#endif +} + +LFD(Linteger_decode_float)(void) +{ + object x; + int h, l, e, s; + + check_arg(1); + check_type_float(&vs_base[0]); + x = vs_base[0]; + vs_base = vs_top; + if (type_of(x) == t_longfloat) { + integer_decode_double(lf(x), &h, &l, &e, &s); + if (h != 0 || l<0) + vs_push(bignum2(h, l)); + else + vs_push(make_fixnum(l)); + vs_push(make_fixnum(e)); + vs_push(make_fixnum(s)); + } else { + integer_decode_float((double)(sf(x)), &h, &e, &s); + vs_push(make_fixnum(h)); + vs_push(make_fixnum(e)); + vs_push(make_fixnum(s)); + } +} + +LFD(Lcomplex)(void) +{ + object r, i; + int narg; + + narg = vs_top - vs_base; + if (narg < 1) + too_few_arguments(); + if (narg > 2) + too_many_arguments(); + check_type_or_rational_float(&vs_base[0]); + r = vs_base[0]; + if (narg == 1) + i = small_fixnum(0); + else { + check_type_or_rational_float(&vs_base[1]); + i = vs_base[1]; + } + vs_top = vs_base; + vs_push(make_complex(r, i)); +} + +LFD(Lrealpart)(void) +{ + object x; + + check_arg(1); + check_type_number(&vs_base[0]); + x = vs_base[0]; + if (type_of(x) == t_complex) + vs_base[0] = x->cmp.cmp_real; +} + +LFD(Limagpart)(void) +{ + object x; + + check_arg(1); + check_type_number(&vs_base[0]); + x = vs_base[0]; + switch (type_of(x)) { + case t_fixnum: + case t_bignum: + case t_ratio: + vs_base[0] = small_fixnum(0); + break; + case t_shortfloat: + vs_base[0] = shortfloat_zero; + break; + case t_longfloat: + vs_base[0] = longfloat_zero; + break; + case t_complex: + vs_base[0] = x->cmp.cmp_imag; + break; + default: + break; + } +} + +void +gcl_init_num_co(void) +{ + float smallest_float, smallest_norm_float, biggest_float; + double smallest_double, smallest_norm_double, biggest_double; + float float_epsilon, float_negative_epsilon; + double double_epsilon, double_negative_epsilon; + union {double d;int i[2];} u; + union {float f;int i;} uf; + + +#ifdef VAX + l[0] = 0x80; + l[1] = 0; + smallest_float = *(float *)l; + smallest_double = *(double *)l; +#endif + +#ifdef IEEEFLOAT +#ifdef NS32K + + + + + +#else + uf.i=1; + u.i[HIND]=0; + u.i[LIND]=1; + smallest_float=uf.f; + smallest_double=u.d; + +/* ((int *) &smallest_float)[0]= 1; */ +/* ((int *) &smallest_double)[HIND] = 0; */ +/* ((int *) &smallest_double)[LIND] = 1; */ + +#endif +#endif + +#ifdef MV + + + + +#endif + +#ifdef S3000 + l[0] = 0x00100000; + l[1] = 0; + smallest_float = *(float *)l; + smallest_double = *(double *)l; +#endif + +#ifdef VAX + l[0] = 0xffff7fff; + l[1] = 0xffffffff; + biggest_float = *(float *)l; + biggest_double = *(double *)l; +#endif + +#ifdef IBMRT + + + + +#endif + +#ifdef IEEEFLOAT +#ifdef NS32K + + + + + +#else + + uf.i=0x7f7fffff; + u.i[HIND]=0x7fefffff; + u.i[LIND]=0xffffffff; + + biggest_float=uf.f; + biggest_double=u.d; + +/* ((int *) &biggest_float)[0]= 0x7f7fffff; */ +/* ((int *) &biggest_double)[HIND] = 0x7fefffff; */ +/* ((int *) &biggest_double)[LIND] = 0xffffffff; */ + +#ifdef BAD_FPCHIP + /* &&&& I am adding junk values to get past debugging */ + biggest_float = 1.0e37; + smallest_float = 1.0e-37; + biggest_double = 1.0e308; + smallest_double = 1.0e-308; + printf("\n Used fake values for float max and mins "); +#endif +#endif +#endif + +#if defined(S3000) && ~defined(DBL_MAX_10_EXP) + l[0] = 0x7fffffff; + l[1] = 0xffffffff; + l[0] = 0x7fffffff; + l[1] = 0xffffffff; + biggest_float = *(float *)l; + biggest_float = *(float *)l; + biggest_float = *(float *)l; + biggest_float = 0.0; + biggest_float = biggest_float + 1.0; + biggest_float = biggest_float + 2.0; + biggest_float = *(float *)l; + biggest_float = *(float *)l; + strcmp("I don't like", "DATA GENERAL."); + biggest_float = *(float *)l; + biggest_double = *(double *)l; + biggest_double = *(double *)l; + biggest_double = *(double *)l; + biggest_double = 0.0; + biggest_double = biggest_double + 1.0; + biggest_double = biggest_double + 2.0; + biggest_double = *(double *)l; + biggest_double = *(double *)l; + strcmp("I don't like", "DATA GENERAL."); + biggest_double = *(double *)l; +#endif + +#ifdef DBL_MAX_10_EXP + biggest_double = DBL_MAX; + smallest_norm_double = DBL_MIN; + smallest_norm_float = FLT_MIN; + biggest_float = FLT_MAX; +#endif + + { + + volatile double rd,dd,td,td1; + volatile float rf,df,tf,tf1; + int i,j; +#define MAX 500 + + for (rf=1.0f,df=0.5f,i=j=0;i y. + + If x or y is complex, 0 or 1 is returned. +*/ +int +number_compare(object x, object y) +{ + int i; + double dx, dy=0.0; + vs_mark; + + switch (type_of(x)) { + + case t_fixnum: + switch (type_of(y)) { + case t_fixnum: + if (fix(x) < fix(y)) + return(-1); + else if (fix(x) == fix(y)) + return(0); + else + return(1); + case t_bignum: + i = big_sign(y); + if (i < 0) + return(1); + else + return(-1); + case t_ratio: + x = number_times(x, y->rat.rat_den); + y = y->rat.rat_num; + vs_push(x); + i = number_compare(x, y); + vs_reset; + return(i); + case t_shortfloat: + dx = (double)(fix(x)); + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dx = (double)(fix(x)); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto Y_COMPLEX; + default: + wrong_type_argument(sLnumber, y); + } + + case t_bignum: + switch (type_of(y)) { + case t_fixnum: + i = big_sign(x); + if (i < 0) + return(-1); + else + return(1); + case t_bignum: + return cmpii(MP(x),MP(y)); + case t_ratio: + x = number_times(x, y->rat.rat_den); + y = y->rat.rat_num; + vs_push(x); + i = number_compare(x, y); + vs_reset; + return(i); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto Y_COMPLEX; + default: + wrong_type_argument(sLnumber, y); + } + + case t_ratio: + switch (type_of(y)) { + case t_fixnum: + case t_bignum: + y = number_times(y, x->rat.rat_den); + x = x->rat.rat_num; + vs_push(y); + i = number_compare(x, y); + vs_reset; + return(i); + case t_ratio: + vs_push(number_times(x->rat.rat_num,y->rat.rat_den)); + vs_push(number_times(y->rat.rat_num,x->rat.rat_den)); + i = number_compare(vs_top[-2], vs_top[-1]); + vs_reset; + return(i); + case t_shortfloat: + dx = number_to_double(x); + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dx = number_to_double(x); + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto Y_COMPLEX; + default: + wrong_type_argument(sLnumber, y); + } + + case t_shortfloat: + dx = (double)(sf(x)); + goto LONGFLOAT0; + + case t_longfloat: + dx = lf(x); + LONGFLOAT0: + switch (type_of(y)) { + case t_fixnum: + dy = (double)(fix(y)); + goto LONGFLOAT; + case t_bignum: + case t_ratio: + dy = number_to_double(y); + goto LONGFLOAT; + case t_shortfloat: + dy = (double)(sf(y)); + goto LONGFLOAT; + case t_longfloat: + dy = lf(y); + goto LONGFLOAT; + case t_complex: + goto Y_COMPLEX; + default: + break; + } + LONGFLOAT: + if (dx == dy) + return(0); + else if (dx < dy) + return(-1); + else + return(1); + + Y_COMPLEX: + if (number_zerop(y->cmp.cmp_imag)) + if (number_compare(x, y->cmp.cmp_real) == 0) + return(0); + else + return(1); + else + return(1); + + case t_complex: + if (type_of(y) != t_complex) { + if (number_zerop(x->cmp.cmp_imag)) + if (number_compare(x->cmp.cmp_real, y) == 0) + return(0); + else + return(1); + else + return(1); + } + if (number_compare(x->cmp.cmp_real, y->cmp.cmp_real) == 0 && + number_compare(x->cmp.cmp_imag, y->cmp.cmp_imag) == 0 ) + return(0); + else + return(1); + + default: + FEwrong_type_argument(sLnumber, x); + return(0); + } +} + +LFD(Lall_the_same)(void) +{ + int narg, i; + + narg = vs_top - vs_base; + if (narg == 0) + too_few_arguments(); + for (i = 0; i < narg; i++) + check_type_number(&vs_base[i]); + for (i = 1; i < narg; i++) + if (number_compare(vs_base[i-1], vs_base[i]) != 0) { + vs_top = vs_base+1; + vs_base[0] = Cnil; + return; + } + vs_top = vs_base+1; + vs_base[0] = Ct; +} + +LFD(Lall_different)(void) +{ + int narg, i, j; + + narg = vs_top - vs_base; + if (narg == 0) + too_few_arguments(); + else if (narg == 1) { + vs_base[0] = Ct; + return; + } + for (i = 0; i < narg; i++) + check_type_number(&vs_base[i]); + for(i = 1; i < narg; i++) + for(j = 0; j < i; j++) + if (number_compare(vs_base[j], vs_base[i]) == 0) { + vs_top = vs_base+1; + vs_base[0] = Cnil; + return; + } + vs_top = vs_base+1; + vs_base[0] = Ct; +} + +static void +Lnumber_compare(int s, int t) +{ + int narg, i; + + narg = vs_top - vs_base; + if (narg == 0) + too_few_arguments(); + for (i = 0; i < narg; i++) { + check_type_or_rational_float(&vs_base[i]); + if (gcl_isnan(vs_base[i])) { + vs_top = vs_base+1; + vs_base[0] = Cnil; + return; + } + } + for (i = 1; i < narg; i++) + if (s*number_compare(vs_base[i], vs_base[i-1]) < t) { + vs_top = vs_base+1; + vs_base[0] = Cnil; + return; + } + vs_top = vs_base+1; + vs_base[0] = Ct; +} + +LFD(Lmonotonically_increasing)(void) { Lnumber_compare( 1, 1); } +LFD(Lmonotonically_decreasing)(void) { Lnumber_compare(-1, 1); } +LFD(Lmonotonically_nondecreasing)(void) { Lnumber_compare( 1, 0); } +LFD(Lmonotonically_nonincreasing)(void) { Lnumber_compare(-1, 0); } + +LFD(Lmax)(void) +{ + object max; + int narg, i; + + narg = vs_top - vs_base; + if (narg == 0) + too_few_arguments(); + for (i = 0; i < narg; i++) + check_type_or_rational_float(&vs_base[i]); + for (i = 1, max = vs_base[0]; i < narg; i++) + if (number_compare(max, vs_base[i]) < 0) + max = vs_base[i]; + vs_top = vs_base+1; + vs_base[0] = max; +} + +LFD(Lmin)(void) +{ + object min; + int narg, i; + + narg = vs_top - vs_base; + if (narg == 0) + too_few_arguments(); + for (i = 0; i < narg; i++) + check_type_or_rational_float(&vs_base[i]); + for (i = 1, min = vs_base[0]; i < narg; i++) + if (number_compare(min, vs_base[i]) > 0) + min = vs_base[i]; + vs_top = vs_base+1; + vs_base[0] = min; +} + +void +gcl_init_num_comp(void) +{ + make_function("=", Lall_the_same); + make_function("/=", Lall_different); + make_function("<", Lmonotonically_increasing); + make_function(">", Lmonotonically_decreasing); + make_function("<=", Lmonotonically_nondecreasing); + make_function(">=", Lmonotonically_nonincreasing); + make_function("MAX", Lmax); + make_function("MIN", Lmin); +} diff --git a/o/num_log.c b/o/num_log.c new file mode 100755 index 0000000..af7c727 --- /dev/null +++ b/o/num_log.c @@ -0,0 +1,529 @@ + +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + Logical operations on number +*/ +#define NEED_MP_H +#include +#include "include.h" +#include "num_include.h" + + +#ifdef GMP +#include "gmp_num_log.c" +#else +#include "pari_num_log.c" +#endif + + + +object +fixnum_big_shift(fixnum x,fixnum w) { + MPOP(return,shifti,SI_TO_MP(x,big_fixnum1),w); +} + +object +integer_fix_shift(object x, fixnum w) { + if (type_of(x)==t_fixnum) { + fixnum fx=fix(x); + return (fx!=MOST_NEGATIVE_FIX || w<0) ? fixnum_shft(fx,w) : fixnum_big_shift(fx,w); + } + MPOP(return,shifti,MP(x),w); +} + +object +integer_shift(object x,object y) { + enum type tx=type_of(x),ty=type_of(y); + if (ty==t_fixnum) + return integer_fix_shift(x,fix(y)); + else { + if (eql(x,make_fixnum(0))) + return x; + if (big_sign(y)<0) + return make_fixnum((tx==t_fixnum ? fix(x) : big_sign(x))<0 ? -1 : 0); + FEerror("Insufficient memory",0); + return Cnil; + } +} + +object +integer_length(object x) { + return make_fixnum(type_of(x)==t_fixnum ? fixnum_length(fix(x)) : MP_SIZE_IN_BASE2(MP(x))); +} + +object +integer_count(object x) { + return make_fixnum(type_of(x)==t_fixnum ? fixnum_count(fix(x)) : MP_BITCOUNT(MP(x))); +} + +#define DEFLOG(a_,b_,c_) \ + LFD(a_)(void) { \ + object x; \ + int narg, i; \ + \ + narg = vs_top - vs_base; \ + for (i = 0; i < narg; i++) \ + check_type_integer(&vs_base[i]); \ + if (narg == 0) { \ + vs_top = vs_base; \ + vs_push(c_); \ + return; \ + } \ + if (narg == 1) \ + return; \ + x = log_op(b_); \ + vs_top = vs_base; \ + vs_push(x); \ + } + +DEFLOG(Llogior,BOOLIOR,small_fixnum(0)); +DEFLOG(Llogxor,BOOLXOR,small_fixnum(0)); +DEFLOG(Llogand,BOOLAND,small_fixnum(-1)); +DEFLOG(Llogeqv,BOOLEQV,small_fixnum(-1)); + +LFD(Lboole)(void) +{ + object x; + object o; + + check_arg(3); + check_type_integer(&vs_base[0]); + check_type_integer(&vs_base[1]); + check_type_integer(&vs_base[2]); + o = vs_base[0]; + + vs_base++; + x = log_op(fix(o)); + vs_base--; + vs_top = vs_base; + vs_push(x); + +} + +bool +integer_bitp(object p,object x) { + enum type tp=type_of(p),tx=type_of(x); + + if (tp==t_fixnum) { + if (tx==t_fixnum) + return fixnum_bitp(fix(p),fix(x)); + else + return big_bitp(x,fix(p)); + } else if (big_sign(p)<0) + return 0; + else if (tx==t_fixnum)/*fixme integer_minusp*/ + return fix(x)<0; + else return big_sign(x)<0; +} + +LFD(Llogbitp)(void) +{ + check_arg(2); + check_type_integer(&vs_base[0]); + check_type_integer(&vs_base[1]); + vs_top=vs_base; + vs_push(integer_bitp(vs_base[0],vs_base[1])?Ct:Cnil); +} + +LFD(Lash)(void) { + check_arg(2); + check_type_integer(&vs_base[0]); + check_type_integer(&vs_base[1]); + vs_top=vs_base; + vs_push(integer_shift(vs_base[0],vs_base[1])); +} + +LFD(Llogcount)(void) { + check_arg(1); + check_type_integer(&vs_base[0]); + vs_base[0]=integer_count(vs_base[0]); +} + +LFD(Linteger_length)(void) { + check_arg(1); + check_type_integer(&vs_base[0]); + vs_base[0]=integer_length(vs_base[0]); +} + +#define W_SIZE (8*sizeof(int)) + +static fixnum +ior_op(fixnum i, fixnum j) +{ + return(i | j); +} + +static fixnum +xor_op(fixnum i, fixnum j) +{ + return(i ^ j); +} + +static fixnum +and_op(fixnum i, fixnum j) +{ + return(i & j); +} + +static fixnum +eqv_op(fixnum i, fixnum j) +{ + return(~(i ^ j)); +} + +static fixnum +nand_op(fixnum i, fixnum j) +{ + return(~(i & j)); +} + +static fixnum +nor_op(fixnum i, fixnum j) +{ + return(~(i | j)); +} + +static fixnum +andc1_op(fixnum i, fixnum j) +{ + return((~i) & j); +} + +static fixnum +andc2_op(fixnum i, fixnum j) +{ + return(i & (~j)); +} + +static fixnum +orc1_op(fixnum i, fixnum j) +{ + return((~i) | j); +} + +static fixnum +orc2_op(fixnum i, fixnum j) +{ + return(i | (~j)); +} + +static fixnum +b_clr_op(fixnum i, fixnum j) +{ + return(0); +} + +static fixnum +b_set_op(fixnum i, fixnum j) +{ + return(-1); +} + +static fixnum +b_1_op(fixnum i, fixnum j) +{ + return(i); +} + +static fixnum +b_2_op(fixnum i, fixnum j) +{ + return(j); +} + +static fixnum +b_c1_op(fixnum i, fixnum j) +{ + return(~i); +} + +static fixnum +b_c2_op(fixnum i, fixnum j) +{ + return(~j); +} + +LFD(siLbit_array_op)(void) +{ + fixnum i, j, n, d; + object o, x, y, r, r0=Cnil; + fixnum (*op)()=NULL; + bool replace = FALSE; + fixnum xi, yi, ri; + char *xp, *yp, *rp; + fixnum xo, yo, ro; + object *base = vs_base; + + check_arg(4); + o = vs_base[0]; + x = vs_base[1]; + y = vs_base[2]; + r = vs_base[3]; + if (type_of(x) == t_bitvector) { + d = x->bv.bv_dim; + xp = x->bv.bv_self; + xo = BV_OFFSET(x); + if (type_of(y) != t_bitvector) + goto ERROR1; + if (d != y->bv.bv_dim) + goto ERROR1; + yp = y->bv.bv_self; + yo = BV_OFFSET(y); + if (r == Ct) + r = x; + if (r != Cnil) { + if (type_of(r) != t_bitvector) + goto ERROR1; + if (r->bv.bv_dim != d) + goto ERROR1; + i = (r->bv.bv_self - xp)*8 + (BV_OFFSET(r) - xo); + if ((i > 0 && i < d) || (i < 0 && -i < d)) { + r0 = r; + r = Cnil; + replace = TRUE; + goto L1; + } + i = (r->bv.bv_self - yp)*8 + (BV_OFFSET(r) - yo); + if ((i > 0 && i < d) || (i < 0 && -i < d)) { + r0 = r; + r = Cnil; + replace = TRUE; + } + } + L1: + if (r == Cnil) { + vs_base = vs_top; + vs_push(sLbit); + vs_push(make_fixnum(d)); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + vs_push(Cnil); + siLmake_vector(); + r = vs_base[0]; + } + } else { + if (type_of(x) != t_array) + goto ERROR1; + if ((enum aelttype)x->a.a_elttype != aet_bit) + goto ERROR1; + d = x->a.a_dim; + xp = x->bv.bv_self; + xo = BV_OFFSET(x); + if (type_of(y) != t_array) + goto ERROR1; + if ((enum aelttype)y->a.a_elttype != aet_bit) + goto ERROR1; + if (x->a.a_rank != y->a.a_rank) + goto ERROR1; + yp = y->bv.bv_self; + yo = BV_OFFSET(y); + for (i = 0; i < x->a.a_rank; i++) + if (x->a.a_dims[i] != y->a.a_dims[i]) + goto ERROR1; + if (r == Ct) + r = x; + if (r != Cnil) { + if (type_of(r) != t_array) + goto ERROR1; + if ((enum aelttype)r->a.a_elttype != aet_bit) + goto ERROR1; + if (r->a.a_rank != x->a.a_rank) + goto ERROR1; + for (i = 0; i < x->a.a_rank; i++) + if (r->a.a_dims[i] != x->a.a_dims[i]) + goto ERROR1; + i = (r->bv.bv_self - xp)*8 + (BV_OFFSET(r) - xo); + if ((i > 0 && i < d) || (i < 0 && -i < d)) { + r0 = r; + r = Cnil; + replace = TRUE; + goto L2; + } + i = (r->bv.bv_self - yp)*8 + (BV_OFFSET(r) - yo); + if ((i > 0 && i < d) || (i < 0 && -i < d)) { + r0 = r; + r = Cnil; + replace = TRUE; + } + } + L2: + if (r == Cnil) { + object b; + struct cons *p=alloca(x->a.a_rank*sizeof(struct cons)); + if (x->a.a_rank) { + object b1; + + b=(object)p; + for (b1=b,i=0;ia.a_rank;i++,b1=b1->c.c_cdr) { +#ifdef WIDE_CONS + set_type_of(b1,t_cons); +#endif + b1->c.c_car=/* x->a.a_dims[i]a.a_dims[i]) : */ + /* now done in a macro */ + make_fixnum(x->a.a_dims[i]); + b1->c.c_cdr=ia.a_rank-1 ? (object)++p : Cnil; + } + } else + b=Cnil; + + r = fSmake_array1(aet_bit,Cnil,small_fixnum(0),Cnil,0,b); + + /* object b[F_ARG_LIMIT]; */ + /* b[0]=Cnil; */ + /* for (i = 0; i < x->a.a_rank; i++) */ + /* b[i] = (make_fixnum(x->a.a_dims[i])); */ + /* r=Iapply_fun_n1(fSmake_array1,5,x->a.a_rank ? x->a.a_rank : 1, */ + /* aet_bit, */ + /* Cnil, */ + /* small_fixnum(0), */ + /* Cnil, */ + /* Cnil, */ + /* b); */ + + } + } + rp = r->bv.bv_self; + ro = BV_OFFSET(r); + switch(fixint(o)) { + case BOOLCLR: op = b_clr_op; break; + case BOOLSET: op = b_set_op; break; + case BOOL1: op = b_1_op; break; + case BOOL2: op = b_2_op; break; + case BOOLC1: op = b_c1_op; break; + case BOOLC2: op = b_c2_op; break; + case BOOLAND: op = and_op; break; + case BOOLIOR: op = ior_op; break; + case BOOLXOR: op = xor_op; break; + case BOOLEQV: op = eqv_op; break; + case BOOLNAND: op = nand_op; break; + case BOOLNOR: op = nor_op; break; + case BOOLANDC1: op = andc1_op; break; + case BOOLANDC2: op = andc2_op; break; + case BOOLORC1: op = orc1_op; break; + case BOOLORC2: op = orc2_op; break; + default: + FEerror("~S is an invalid logical operator.", 1, o); + } + +#define set_high(place, nbits, value) \ + ((place)=(((place)&~(-0400>>(nbits)))|((value)&(-0400>>(nbits))))) + +#define set_low(place, nbits, value) \ + ((place)=(((place)&(-0400>>(8-(nbits))))|((value)&~(-0400>>(8-(nbits)))))) + +#define extract_byte(integer, pointer, index, offset) \ + (integer) = (pointer)[(index)+1] & 0377; \ + (integer) = ((pointer)[index]<<(offset))|((integer)>>(8-(offset))) + +#define store_byte(pointer, index, offset, value) \ + set_low((pointer)[index], 8-(offset), (value)>>(offset)); \ + set_high((pointer)[(index)+1], offset, (value)<<(8-(offset))) + + if (xo == 0 && yo == 0 && ro == 0) { + for (n = d/8, i = 0; i < n; i++) + rp[i] = (*op)(xp[i], yp[i]); + if ((j = d%8) > 0) + set_high(rp[n], j, (*op)(xp[n], yp[n])); + if (!replace) { + vs_top = vs_base = base; + vs_push(r); + return; + } + } else { + for (n = d/8, i = 0; i <= n; i++) { + extract_byte(xi, xp, i, xo); + extract_byte(yi, yp, i, yo); + if (i == n) { + if ((j = d%8) == 0) + break; + extract_byte(ri, rp, n, ro); + set_high(ri, j, (*op)(xi, yi)); + } else + ri = (*op)(xi, yi); + store_byte(rp, i, ro, ri); + } + if (!replace) { + vs_top = vs_base = base; + vs_push(r); + return; + } + } + rp = r0->bv.bv_self; + ro = BV_OFFSET(r0); + for (n = d/8, i = 0; i <= n; i++) { + if (i == n) { + if ((j = d%8) == 0) + break; + extract_byte(ri, rp, n, ro); + set_high(ri, j, r->bv.bv_self[n]); + } else + ri = r->bv.bv_self[i]; + store_byte(rp, i, ro, ri); + } + vs_top = vs_base = base; + vs_push(r0); + return; + +ERROR1: + FEerror("Illegal arguments for bit-array operation.", 0); +} + +void +gcl_init_num_log(void) +{ +/* int siLbit_array_op(void); */ + + make_constant("BOOLE-CLR", make_fixnum(BOOLCLR)); + make_constant("BOOLE-SET", make_fixnum(BOOLSET)); + make_constant("BOOLE-1", make_fixnum(BOOL1)); + make_constant("BOOLE-2", make_fixnum(BOOL2)); + make_constant("BOOLE-C1", make_fixnum(BOOLC1)); + make_constant("BOOLE-C2", make_fixnum(BOOLC2)); + make_constant("BOOLE-AND", make_fixnum(BOOLAND)); + make_constant("BOOLE-IOR", make_fixnum(BOOLIOR)); + make_constant("BOOLE-XOR", make_fixnum(BOOLXOR)); + make_constant("BOOLE-EQV", make_fixnum(BOOLEQV)); + make_constant("BOOLE-NAND", make_fixnum(BOOLNAND)); + make_constant("BOOLE-NOR", make_fixnum(BOOLNOR)); + make_constant("BOOLE-ANDC1", make_fixnum(BOOLANDC1)); + make_constant("BOOLE-ANDC2", make_fixnum(BOOLANDC2)); + make_constant("BOOLE-ORC1", make_fixnum(BOOLORC1)); + make_constant("BOOLE-ORC2", make_fixnum(BOOLORC2)); + + make_function("LOGIOR", Llogior); + make_function("LOGXOR", Llogxor); + make_function("LOGAND", Llogand); + make_function("LOGEQV", Llogeqv); + make_function("BOOLE", Lboole); + make_function("LOGBITP", Llogbitp); + make_function("ASH", Lash); + make_function("LOGCOUNT", Llogcount); + make_function("INTEGER-LENGTH", Linteger_length); + + sLbit = make_ordinary("BIT"); + make_si_function("BIT-ARRAY-OP", siLbit_array_op); +} + diff --git a/o/num_pred.c b/o/num_pred.c new file mode 100755 index 0000000..5766f05 --- /dev/null +++ b/o/num_pred.c @@ -0,0 +1,253 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + Predicates on numbers +*/ +#define NEED_MP_H +#include "include.h" +#include "num_include.h" + + +int +number_zerop(object x) +{ + switch (type_of(x)) { + + case t_fixnum: + if (fix(x) == 0) + return(1); + else + return(0); + + case t_bignum: + case t_ratio: + return(0); + + case t_shortfloat: + if (sf(x) == 0.0) + return(1); + else + return(0); + + case t_longfloat: + if (lf(x) == 0.0) + return(1); + else + return(0); + + case t_complex: + return(number_zerop(x->cmp.cmp_real) && + number_zerop(x->cmp.cmp_imag)); + + default: + FEwrong_type_argument(sLnumber, x); + return(0); + } +} + +int +number_plusp(object x) +{ + switch (type_of(x)) { + + case t_fixnum: + if (fix(x) > 0) + return(1); + else + return(0); + + case t_bignum: + if (big_sign(x) > 0) + return(1); + else + return(0); + + case t_ratio: + if (number_plusp(x->rat.rat_num)) + return(1); + else + return(0); + + case t_shortfloat: + if (sf(x) > 0.0) + return(1); + else + return(0); + + case t_longfloat: + if (lf(x) > 0.0) + return(1); + else + return(0); + + default: + FEwrong_type_argument(TSor_rational_float,x); + return(0); + } +} + +int +number_minusp(object x) +{ + switch (type_of(x)) { + + case t_fixnum: + if (fix(x) < 0) + return(1); + else + return(0); + + case t_bignum: + if (big_sign(x) < 0) + return(1); + else + return(0); + + case t_ratio: + if (number_minusp(x->rat.rat_num)) + return(1); + else + return(0); + + case t_shortfloat: + if (sf(x) < 0.0) + return(1); + else + return(0); + + case t_longfloat: + if (lf(x) < 0.0) + return(1); + else + return(0); + + default: + FEwrong_type_argument(TSor_rational_float,x); + return(0); + } +} + +int +number_oddp(object x) +{ + int i=0; + + if (type_of(x) == t_fixnum) + i = fix(x); + else if (type_of(x) == t_bignum) + i = MP_LOW(MP(x),lgef(MP(x))); + else + FEwrong_type_argument(sLinteger, x); + return(i & 1); +} + +int +number_evenp(object x) +{ + int i=0; + + if (type_of(x) == t_fixnum) + i = fix(x); + else if (type_of(x) == t_bignum) + i = MP_LOW(MP(x),lgef(MP(x))); + else + FEwrong_type_argument(sLinteger, x); + return(~i & 1); +} + +LFD(Lzerop)(void) +{ + check_arg(1); + check_type_number(&vs_base[0]); + if (number_zerop(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Lplusp)(void) +{ + check_arg(1); + check_type_or_rational_float(&vs_base[0]); + if (number_plusp(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Lminusp)(void) +{ + check_arg(1); + check_type_or_rational_float(&vs_base[0]); + if (number_minusp(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Loddp)(void) +{ + check_arg(1); + check_type_integer(&vs_base[0]); + if (number_oddp(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(Levenp)(void) +{ + check_arg(1); + check_type_integer(&vs_base[0]); + if (number_evenp(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +/* this is just to force things into memory in num_co.c */ +/* static void _assure_in_memory (void *p) */ +/* { */ +/* ; */ +/* } */ + +/* static int */ +/* lf_eqlp(double *p, double *q) */ +/* { */ +/* return *p == *q; */ +/* } */ + + +void +gcl_init_num_pred(void) +{ +#ifndef GMP + big_register_1 = new_bignum(); + ZERO_BIG(big_register_1); + enter_mark_origin(&big_register_1); +#endif + make_function("ZEROP", Lzerop); + make_function("PLUSP", Lplusp); + make_function("MINUSP", Lminusp); + make_function("ODDP", Loddp); + make_function("EVENP", Levenp); +} diff --git a/o/num_rand.c b/o/num_rand.c new file mode 100755 index 0000000..c91e51e --- /dev/null +++ b/o/num_rand.c @@ -0,0 +1,222 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + Random numbers +*/ + +#include +#include + +#include "include.h" +#include "num_include.h" + +#ifdef AOSVS + +#endif + +static object +rando(object x, object rs) { + + enum type tx; + object base,out,z; + fixnum fbase; + double d; + + tx = type_of(x); + if (number_compare(x, small_fixnum(0)) != 1) + FEwrong_type_argument(TSpositive_number, x); + + if (tx==t_bignum) { + out=new_bignum(); + base=x; + fbase=-1; + } else { + out=big_fixnum1; + fbase=tx==t_fixnum ? fix(x) : MOST_POSITIVE_FIX; + mpz_set_si(MP(big_fixnum2),fbase); + base=big_fixnum2; + } + + mpz_urandomm(MP(out),&rs->rnd.rnd_state,MP(base)); + + switch (tx) { + + case t_fixnum: + return make_fixnum(mpz_get_si(MP(out))); + case t_bignum: + return normalize_big(out); + case t_shortfloat: case t_longfloat: + d=mpz_get_d(MP(out)); + d/=(double)fbase; + z=alloc_object(tx); + if (tx==t_shortfloat) sf(z)=sf(x)*d; else lf(z)=lf(x)*d; + return z; + default: + FEerror("~S is not an integer nor a floating-point number.", 1, x); + return(Cnil); + } +} + + +#ifdef UNIX +#define RS_DEF_INIT time(0) +#else +#define RS_DEF_INIT 0 +#endif + +#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +extern void * (*gcl_gmp_allocfun) (size_t); +static void * (*old_gcl_gmp_allocfun) (size_t); +static void * trap_result; +static size_t trap_size; + +static void * +trap_gcl_gmp_allocfun(size_t size){ + + size+=size%MP_LIMB_SIZE; + if (trap_size) + return old_gcl_gmp_allocfun(size); + else { + trap_size=size/MP_LIMB_SIZE; + trap_result=old_gcl_gmp_allocfun(size); + return trap_result; + } + +} +#endif + +void +init_gmp_rnd_state(__gmp_randstate_struct *x) { + + static int n; + + bzero(x,sizeof(*x)); + +#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +/* if (!trap_size) { */ + old_gcl_gmp_allocfun=gcl_gmp_allocfun; + gcl_gmp_allocfun=trap_gcl_gmp_allocfun; +/* } */ +#endif + gmp_randinit_default(x); +#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) + if (!n) { + + if (x->_mp_seed->_mp_d!=trap_result) + FEerror("Unknown pointer in rnd_state!",0); +/* #ifndef __hppa__ /\*FIXME*\/ */ +/* if (((gmp_randfnptr_t *)x->_mp_algdata._mp_lc)->b!=Mersenne_Twister_Generator_Noseed.b || */ +/* ((gmp_randfnptr_t *)x->_mp_algdata._mp_lc)->c!=Mersenne_Twister_Generator_Noseed.c || */ +/* ((gmp_randfnptr_t *)x->_mp_algdata._mp_lc)->d!=Mersenne_Twister_Generator_Noseed.d) */ +/* FEerror("Unknown pointer data in rnd_state!",0); */ +/* #endif */ + + n=1; + + } + gcl_gmp_allocfun=old_gcl_gmp_allocfun; + x->_mp_seed->_mp_alloc=x->_mp_seed->_mp_size=trap_size; +#endif + + +} + + + +static object +make_random_state(object rs) { + + object z; + + if (rs==Cnil) + rs=symbol_value(Vrandom_state); + + if (rs!=Ct && type_of(rs) != t_random) { + FEwrong_type_argument(sLrandom_state, rs); + return(Cnil); + } + + z = alloc_object(t_random); + init_gmp_rnd_state(&z->rnd.rnd_state); + + + if (rs == Ct) + gmp_randseed_ui(&z->rnd.rnd_state,RS_DEF_INIT); + else + memcpy(z->rnd.rnd_state._mp_seed->_mp_d,rs->rnd.rnd_state._mp_seed->_mp_d, + rs->rnd.rnd_state._mp_seed->_mp_alloc*sizeof(*z->rnd.rnd_state._mp_seed->_mp_d)); + +#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) + z->rnd.rnd_state._mp_algdata._mp_lc=&Mersenne_Twister_Generator_Noseed; +#endif + return(z); + +} + +LFD(Lrandom)(void) +{ + int j; + object x; + + j = vs_top - vs_base; + if (j == 1) + vs_push(symbol_value(Vrandom_state)); + check_arg(2); + check_type_random_state(&vs_base[1]); + x = rando(vs_base[0], vs_base[1]); + vs_top = vs_base; + vs_push(x); +} + +LFD(Lmake_random_state)(void) +{ + int j; + object x; + + j = vs_top - vs_base; + if (j == 0) + vs_push(Cnil); + check_arg(1); + x = make_random_state(vs_head); + vs_top = vs_base; + vs_push(x); +} + +LFD(Lrandom_state_p)(void) +{ + check_arg(1); + if (type_of(vs_pop) == t_random) + vs_push(Ct); + else + vs_push(Cnil); +} + +void +gcl_init_num_rand(void) +{ + Vrandom_state = make_special("*RANDOM-STATE*", + make_random_state(Ct)); + + make_function("RANDOM", Lrandom); + make_function("MAKE-RANDOM-STATE", Lmake_random_state); + make_function("RANDOM-STATE-P", Lrandom_state_p); +} diff --git a/o/num_sfun.c b/o/num_sfun.c new file mode 100755 index 0000000..a4c5192 --- /dev/null +++ b/o/num_sfun.c @@ -0,0 +1,768 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#define IN_NUM_CO + +#include "include.h" +#include "num_include.h" + +object imag_unit, minus_imag_unit, imag_two; + +int +fixnum_expt(int x, int y) +{ + int z; + + z = 1; + while (y > 0) + if (y%2 == 0) { + x *= x; + y /= 2; + } else { + z *= x; + --y; + } + return(z); +} + +static object number_sin(object); +static object number_cos(object); +static object number_exp(object); +static object number_nlog(object); +static object number_atan2(object,object); + + +static object +number_exp(object x) +{ + double exp(double); + + switch (type_of(x)) { + + case t_fixnum: + case t_bignum: + case t_ratio: + return(make_longfloat((longfloat)exp(number_to_double(x)))); + + case t_shortfloat: + return(make_shortfloat((shortfloat)exp((double)(sf(x))))); + + case t_longfloat: + return(make_longfloat(exp(lf(x)))); + + case t_complex: + { + object y, y1; + vs_mark; + + y = x->cmp.cmp_imag; + x = x->cmp.cmp_real; + x = number_exp(x); + vs_push(x); + y1 = number_cos(y); + vs_push(y1); + y = number_sin(y); + vs_push(y); + y = make_complex(y1, y); + vs_push(y); + x = number_times(x, y); + vs_reset; + return(x); + } + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + } +} + +static inline object +number_fix_iexpt(object x,fixnum y,fixnum ly,fixnum j) { + object z; + + if (j+1==ly) return x; + z=number_fix_iexpt(number_times(x,x),y,ly,j+1); + return fixnum_bitp(j,y) ? number_times(x,z) : z; +} + +static inline object +number_big_iexpt(object x,object y,fixnum ly,fixnum j) { + object z; + + if (j+1==ly) return x; + z=number_big_iexpt(number_times(x,x),y,ly,j+1); + return mpz_tstbit(MP(y),j) ? number_times(x,z) : z; + +} + +static inline object +number_zero_expt(object x,bool promote_short_p) { + + if (gcl_is_not_finite(x))/*FIXME, better place?*/ + return number_exp(number_times(number_nlog(x),small_fixnum(0))); + + switch (type_of(x)) { + case t_fixnum: + case t_bignum: + case t_ratio: + return make_fixnum(1); + case t_shortfloat: + return promote_short_p ? make_longfloat(1.0) : make_shortfloat(1.0); + case t_longfloat: + return make_longfloat(1.0); + case t_complex: + return make_complex(number_zero_expt(x->cmp.cmp_real,promote_short_p),small_fixnum(0)); + default: + FEwrong_type_argument(sLnumber,x); + return Cnil; + } + +} + + +static inline object +number_ui_expt(object x,fixnum fy) { + + switch (type_of(x)) { + case t_fixnum: + { + fixnum fx=fix(x); + object z; + MPOP(z=,mpz_ui_pow_ui,labs(fx),fy); + if (fx<0&&(fy&0x1)) return number_negate(z); else return z; + } + case t_bignum: + MPOP(return,mpz_pow_ui,MP(x),fy); + case t_ratio: + { + object n=number_ui_expt(x->rat.rat_num,fy),d=number_ui_expt(x->rat.rat_den,fy),z=alloc_object(t_ratio); + z->rat.rat_num=n; + z->rat.rat_den=d;/*No need to make_ratio as no common factors*/ + return z; + } + + case t_shortfloat: + case t_longfloat: + case t_complex: + { + fixnum ly=fixnum_length(fy); + + return ly ? number_fix_iexpt(x,fy,ly,0) : number_zero_expt(x,0); + + } + + default: + FEwrong_type_argument(sLnumber,x); + return Cnil; + } + +} + +static inline object +number_ump_expt(object x,object y) { + return number_big_iexpt(x,y,fix(integer_length(y)),0); +} + +static inline object +number_log_expt(object x,object y) { + return number_zerop(y) ? number_zero_expt(x,type_of(x)==t_longfloat) : number_exp(number_times(number_nlog(x),y)); +} + +static inline object +number_invert(object x,object y,object z) { + + switch (type_of(z)) { + case t_shortfloat: + if (!ISNORMAL(sf(z))) return number_log_expt(x,y); + break; + case t_longfloat: + if (!ISNORMAL(lf(z))) return number_log_expt(x,y); + break; + } + return number_divide(small_fixnum(1),z); +} + + +static inline object +number_si_expt(object x,object y) { + switch (type_of(y)) { + case t_fixnum: + { + fixnum fy=fix(y); + if (fy>=0) + return number_ui_expt(x,fy); + if (fy==MOST_NEGATIVE_FIX) + return number_invert(x,y,number_ump_expt(x,number_negate(y))); + return number_invert(x,y,number_ui_expt(x,-fy)); + } + case t_bignum: + return big_sign(y)<0 ? number_invert(x,y,number_ump_expt(x,number_negate(y))) : number_ump_expt(x,y); + case t_ratio: + case t_shortfloat: + case t_longfloat: + case t_complex: + return number_log_expt(x,y); + default: + FEwrong_type_argument(sLnumber,y); + return Cnil; + } +} + +object +number_expt(object x, object y) { + + if (number_zerop(x)&&y!=small_fixnum(0)) { + if (!number_plusp(type_of(y)==t_complex?y->cmp.cmp_real:y)) + FEerror("Cannot raise zero to the power ~S.", 1, y); + return(number_times(x, y)); + } + + return number_si_expt(x,y); + +} + +static object +number_nlog(object x) +{ + double log(double); + object r=Cnil, i=Cnil, a, p; + vs_mark; + + if (type_of(x) == t_complex) { + r = x->cmp.cmp_real; + i = x->cmp.cmp_imag; + goto COMPLEX; + } + if (number_zerop(x)) + FEerror("Zero is the logarithmic singularity.", 0); + if (number_minusp(x)) { + r = x; + i = small_fixnum(0); + goto COMPLEX; + } + switch (type_of(x)) { + case t_fixnum: + case t_bignum: + case t_ratio: + return(make_longfloat(log(number_to_double(x)))); + + case t_shortfloat: + return(make_shortfloat((shortfloat)log((double)(sf(x))))); + + case t_longfloat: + return(make_longfloat(log(lf(x)))); + + default: + FEwrong_type_argument(sLnumber, x); + } + +COMPLEX: + a = number_times(r, r); + vs_push(a); + p = number_times(i, i); + vs_push(p); + a = number_plus(a, p); + vs_push(a); + a = number_nlog(a); + vs_push(a); + a = number_divide(a, small_fixnum(2)); + vs_push(a); + p = number_atan2(i, r); + vs_push(p); + x = make_complex(a, p); + vs_reset; + return(x); +} + +static object +number_log(object x, object y) +{ + object z; + vs_mark; + + if (number_zerop(y)) + FEerror("Zero is the logarithmic singularity.", 0); + if (number_zerop(x)) + return(number_times(x, y)); + x = number_nlog(x); + vs_push(x); + y = number_nlog(y); + vs_push(y); + z = number_divide(y, x); + vs_reset; + return(z); +} + +static object +number_sqrt(object x) +{ + object z; + double sqrt(double); + vs_mark; + + if (type_of(x) == t_complex) + goto COMPLEX; + if (number_minusp(x)) + goto COMPLEX; + switch (type_of(x)) { + case t_fixnum: + case t_bignum: + case t_ratio: + return(make_longfloat( + (longfloat)sqrt(number_to_double(x)))); + + case t_shortfloat: + return(make_shortfloat((shortfloat)sqrt((double)(sf(x))))); + + case t_longfloat: + return(make_longfloat(sqrt(lf(x)))); + + default: + FEwrong_type_argument(sLnumber, x); + } + +COMPLEX: + z = make_ratio(small_fixnum(1), small_fixnum(2)); + vs_push(z); + z = number_expt(x, z); + vs_reset; + return(z); +} + +object +number_abs(object x) { + + object r,i,z; + + switch(type_of(x)) { + + case t_complex: + if (number_zerop(x)) return x->cmp.cmp_real; + r=number_abs(x->cmp.cmp_real); + i=number_abs(x->cmp.cmp_imag); + if (number_compare(r,i)<0) { + object z=i; + i=r; + r=z; + } + z=number_divide(i,r); + return number_times(r,number_sqrt(one_plus(number_times(z,z)))); + + case t_fixnum: + {fixnum fx=fix(x);return fx==MOST_NEGATIVE_FIX ? fixnum_add(1,MOST_POSITIVE_FIX) : (fx<0 ? make_fixnum(-fx) : x);} + + case t_bignum: + return big_sign(x)<0 ? big_minus(x) : x; + + case t_ratio: + {object n=number_abs(x->rat.rat_num);return n==x ? x : make_ratio(n,x->rat.rat_den);} + + case t_shortfloat: + return sf(x)<0.0 ? make_shortfloat(-sf(x)) : x; + + case t_longfloat: + return lf(x)<0.0 ? make_longfloat(-lf(x)) : x; + + default: + FEwrong_type_argument(sLnumber,x); + return(Cnil); + } +} + +object +number_signum(object x) { + + switch (type_of(x)) { + + case t_fixnum: + {fixnum fx=fix(x);return make_fixnum(fx<0 ? -1 : (fx==0 ? 0 : 1));} + + case t_bignum: + return make_fixnum(big_sign(x)<0 ? -1 : 1); + + case t_ratio: + return number_signum(x->rat.rat_num); + + case t_shortfloat: + return make_shortfloat(sf(x)<0.0 ? -1.0 : (sf(x)==0.0 ? 0.0 : 1.0)); + + case t_longfloat: + return make_longfloat(lf(x)<0.0 ? -1.0 : (lf(x)==0.0 ? 0.0 : 1.0)); + + case t_complex: + return number_zerop(x) ? x : number_divide(x,number_abs(x)); + + default: + FEwrong_type_argument(sLnumber,x); + return(Cnil); + + } + +} + +static object +number_atan2(object y, object x) +{ + object z; + double atan(double), dy, dx, dz=0.0; + + dy = number_to_double(y); + dx = number_to_double(x); + if (dx > 0.0) + if (dy > 0.0) + dz = atan(dy / dx); + else if (dy == 0.0) + dz = 0.0; + else + dz = -atan(-dy / dx); + else if (dx == 0.0) + if (dy > 0.0) + dz = PI / 2.0; + else if (dy == 0.0) + dz = 0.0; + else + dz = -PI / 2.0; + else + if (dy > 0.0) + dz = PI - atan(dy / -dx); + else if (dy == 0.0) + dz = PI; + else + dz = -PI + atan(-dy / -dx); + if (type_of(x) == t_shortfloat) + z = make_shortfloat((shortfloat)dz); + else + z = make_longfloat(dz); + return(z); +} + +static object +number_atan(object y) +{ + object z, z1; + vs_mark; + + if (type_of(y) == t_complex) { + z = number_times(imag_unit, y); + vs_push(z); + z = one_plus(z); + vs_push(z); + z1 = number_times(y, y); + vs_push(z1); + z1 = one_plus(z1); + vs_push(z1); + z1 = number_sqrt(z1); + vs_push(z1); + z = number_divide(z, z1); + vs_push(z); + z = number_nlog(z); + vs_push(z); + z = number_times(minus_imag_unit, z); + vs_reset; + return(z); + } + return(number_atan2(y, small_fixnum(1))); +} + +static object +number_sin(object x) +{ + double sin(double); + + switch (type_of(x)) { + + case t_fixnum: + case t_bignum: + case t_ratio: + return(make_longfloat((longfloat)sin(number_to_double(x)))); + + case t_shortfloat: + return(make_shortfloat((shortfloat)sin((double)(sf(x))))); + + case t_longfloat: + return(make_longfloat(sin(lf(x)))); + + case t_complex: + { + object r; + object x0, x1, x2; + vs_mark; + + x0 = number_times(imag_unit, x); + vs_push(x0); + x0 = number_exp(x0); + vs_push(x0); + x1 = number_times(minus_imag_unit, x); + vs_push(x1); + x1 = number_exp(x1); + vs_push(x1); + x2 = number_minus(x0, x1); + vs_push(x2); + r = number_divide(x2, imag_two); + + vs_reset; + return(r); + } + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + + } +} + +static object +number_cos(object x) +{ + double cos(double); + + switch (type_of(x)) { + + case t_fixnum: + case t_bignum: + case t_ratio: + return(make_longfloat((longfloat)cos(number_to_double(x)))); + + case t_shortfloat: + return(make_shortfloat((shortfloat)cos((double)(sf(x))))); + + case t_longfloat: + return(make_longfloat(cos(lf(x)))); + + case t_complex: + { + object r; + object x0, x1, x2; + vs_mark; + + x0 = number_times(imag_unit, x); + vs_push(x0); + x0 = number_exp(x0); + vs_push(x0); + x1 = number_times(minus_imag_unit, x); + vs_push(x1); + x1 = number_exp(x1); + vs_push(x1); + x2 = number_plus(x0, x1); + vs_push(x2); + r = number_divide(x2, small_fixnum(2)); + + vs_reset; + return(r); + } + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + + } +} + +static object +number_tan1(object x) +{ + double cos(double); + + switch (type_of(x)) { + + case t_fixnum: + case t_bignum: + case t_ratio: + return(make_longfloat((longfloat)tan(number_to_double(x)))); + + case t_shortfloat: + return(make_shortfloat((shortfloat)tan((double)(sf(x))))); + + case t_longfloat: + return(make_longfloat(tan(lf(x)))); + + case t_complex: + { + object r; + object x0, x1, x2; + vs_mark; + + x0 = number_times(imag_two, x); + vs_push(x0); + x0 = number_exp(x0); + vs_push(x0); + x1 = number_minus(x0,small_fixnum(1)); + vs_push(x1); + x2 = number_plus(x0,small_fixnum(1)); + vs_push(x2); + x2 = number_times(x2,imag_unit); + vs_push(x2); + r = number_divide(x1, x2); + + vs_reset; + return(r); + } + + default: + FEwrong_type_argument(sLnumber, x); + return(Cnil); + + } +} + +static object +number_tan(object x) +{ + object r, c; + vs_mark; + + c = number_cos(x); + vs_push(c); + if (number_zerop(c) == TRUE) + FEerror("Cannot compute the tangent of ~S.", 1, x); + r = number_tan1(x); + vs_reset; + return(r); +} + +LFD(Lexp)(void) +{ + check_arg(1); + check_type_number(&vs_base[0]); + vs_base[0] = number_exp(vs_base[0]); +} + +LFD(Lexpt)(void) +{ + check_arg(2); + check_type_number(&vs_base[0]); + check_type_number(&vs_base[1]); + vs_base[0] = number_expt(vs_base[0], vs_base[1]); + vs_popp; +} + +LFD(Llog)(void) +{ + int narg; + + narg = vs_top - vs_base; + if (narg < 1) + too_few_arguments(); + else if (narg == 1) { + check_type_number(&vs_base[0]); + vs_base[0] = number_nlog(vs_base[0]); + } else if (narg == 2) { + check_type_number(&vs_base[0]); + check_type_number(&vs_base[1]); + vs_base[0] = number_log(vs_base[1], vs_base[0]); + vs_popp; + } else + too_many_arguments(); +} + +LFD(Lsqrt)(void) +{ + check_arg(1); + check_type_number(&vs_base[0]); + vs_base[0] = number_sqrt(vs_base[0]); +} + +LFD(Lsin)(void) +{ + check_arg(1); + check_type_number(&vs_base[0]); + vs_base[0] = number_sin(vs_base[0]); +} + +LFD(Lcos)(void) +{ + check_arg(1); + check_type_number(&vs_base[0]); + vs_base[0] = number_cos(vs_base[0]); +} + +LFD(Ltan)(void) +{ + check_arg(1); + check_type_number(&vs_base[0]); + vs_base[0] = number_tan(vs_base[0]); +} + +LFD(Latan)(void) +{ + int narg; + + narg = vs_top - vs_base; + if (narg < 1) + too_few_arguments(); + if (narg == 1) { + check_type_number(&vs_base[0]); + vs_base[0] = number_atan(vs_base[0]); + } else if (narg == 2) { + check_type_or_rational_float(&vs_base[0]); + check_type_or_rational_float(&vs_base[1]); + vs_base[0] = number_atan2(vs_base[0], vs_base[1]); + vs_popp; + } else + too_many_arguments(); +} + +static void +FFN(siLmodf)(void) +{ + + object x; + double d,ip; + + check_arg(1); + check_type_float(&vs_base[0]); + x=vs_base[0]; + vs_base=vs_top; + d=type_of(x) == t_longfloat ? lf(x) : (double)sf(x); + d=modf(d,&ip); + vs_push(make_fixnum((int)ip)); + vs_push(type_of(x) == t_longfloat ? make_longfloat(d) : make_shortfloat((shortfloat)d)); + +} + +void +gcl_init_num_sfun(void) +{ + imag_unit + = make_complex(make_longfloat((longfloat)0.0), + make_longfloat((longfloat)1.0)); + enter_mark_origin(&imag_unit); + minus_imag_unit + = make_complex(make_longfloat((longfloat)0.0), + make_longfloat((longfloat)-1.0)); + enter_mark_origin(&minus_imag_unit); + imag_two + = make_complex(make_longfloat((longfloat)0.0), + make_longfloat((longfloat)2.0)); + enter_mark_origin(&imag_two); + + make_constant("PI", make_longfloat(PI)); + + make_function("EXP", Lexp); + make_function("EXPT", Lexpt); + make_function("LOG", Llog); + make_function("SQRT", Lsqrt); + make_function("SIN", Lsin); + make_function("COS", Lcos); + make_function("TAN", Ltan); + make_function("ATAN", Latan); + make_si_function("MODF", siLmodf); +} diff --git a/o/number.c b/o/number.c new file mode 100755 index 0000000..19f9f12 --- /dev/null +++ b/o/number.c @@ -0,0 +1,332 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + number.c + IMPLEMENTATION-DEPENDENT + + This file creates some implementation dependent constants. +*/ + +#define IN_NUM_CO + +#include "include.h" +#include "num_include.h" + + +long +fixint(object x) +{ + if (type_of(x) != t_fixnum) + FEwrong_type_argument(sLfixnum, x); + return(fix(x)); +} + +int +fixnnint(object x) +{ + if (type_of(x) != t_fixnum || fix(x) < 0) + FEerror("~S is not a non-negative fixnum.", 1, x); + return(fix(x)); +} +#if 0 +object small_fixnum ( int i ) { +#include + assert ( ( -SMALL_FIXNUM_LIMIT <= i ) && ( i < SMALL_FIXNUM_LIMIT ) ); + (object) small_fixnum_table + SMALL_FIXNUM_LIMIT + i; +} +#endif + +/* #if !defined(IM_FIX_BASE) */ + +#define BIGGER_FIXNUM_RANGE + +#ifdef BIGGER_FIXNUM_RANGE +struct {int min,max;} bigger_fixnums; + +struct fixnum_struct *bigger_fixnum_table; +#if !defined(IM_FIX_BASE) || defined(USE_SAFE_CDR) +#define STATIC_BIGGER_FIXNUM_TABLE_BITS 10 +static struct fixnum_struct bigger_fixnum_table1[1<<(STATIC_BIGGER_FIXNUM_TABLE_BITS+1)] OBJ_ALIGN; +#endif + +DEFUN_NEW("ALLOCATE-BIGGER-FIXNUM-RANGE",object,fSallocate_bigger_fixnum_range,SI,2,2,NONE,OI,IO,OO,OO,(fixnum min,fixnum max),"") { + int j; + if (min > max) FEerror("Need Min <= Max",0); + +#if !defined(IM_FIX_BASE) || defined(USE_SAFE_CDR) + if (min==-(1<fw=0; + set_type_of(x,t_fixnum); + x->FIX.FIXVAL=j; + } + bigger_fixnums.min=min; + bigger_fixnums.max=max; + + return Ct; +} +#endif +/* #endif */ + + +object +make_fixnum1(long i) +{ + object x; + + /* In a macro now */ +/* if (-SMALL_FIXNUM_LIMIT <= i && i < SMALL_FIXNUM_LIMIT) */ +/* return(small_fixnum(i)); */ +#ifdef BIGGER_FIXNUM_RANGE + if (bigger_fixnum_table) + { if (i >= bigger_fixnums.min + && i < bigger_fixnums.max) + return (object)(bigger_fixnum_table +(i -bigger_fixnums.min)); + } +#endif + + x = alloc_object(t_fixnum); + set_fix(x,i); + return(x); +} + +object +make_ratio(object num, object den) +{ + object g, r, get_gcd(object x, object y); + vs_mark; + + if (number_zerop(den)) + FEerror("Zero denominator.", 0); + if (number_zerop(num)) + return(small_fixnum(0)); + if (type_of(den) == t_fixnum && fix(den) == 1) + return(num); + if (number_minusp(den)) { + num = number_negate(num); + vs_push(num); + den = number_negate(den); + vs_push(den); + } + g = get_gcd(num, den); + vs_push(g); + num = integer_divide1(num, g,0); + vs_push(num); + den = integer_divide1(den, g,0); + vs_push(den); + if(type_of(den) == t_fixnum && fix(den) == 1) { + vs_reset; + return(num); + } + if(type_of(den) == t_fixnum && fix(den) == -1) { + num = number_negate(num); + vs_reset; + return(num); + } + r = alloc_object(t_ratio); + r->rat.rat_num = num; + r->rat.rat_den = den; + vs_reset; + return(r); +} + +object +make_shortfloat(double f) +{ + object x; + + if (f == (shortfloat)0.0) + return(shortfloat_zero); + x = alloc_object(t_shortfloat); + sf(x) = (shortfloat)f; + return(x); +} + +object +make_longfloat(longfloat f) +{ + object x; + + if (f == (longfloat)0.0) + return(longfloat_zero); + x = alloc_object(t_longfloat); + lf(x) = f; + return(x); +} + +object +make_complex(object r, object i) +{ + object c; + vs_mark; + + switch (type_of(r)) { + case t_fixnum: + case t_bignum: + case t_ratio: + switch (type_of(i)) { + case t_fixnum: + if (fix(i) == 0) + return(r); + break; + case t_shortfloat: + r = make_shortfloat((shortfloat)number_to_double(r)); + vs_push(r); + break; + case t_longfloat: + r = make_longfloat(number_to_double(r)); + vs_push(r); + break; + default: + break; + } + break; + case t_shortfloat: + switch (type_of(i)) { + case t_fixnum: + case t_bignum: + case t_ratio: + i = make_shortfloat((shortfloat)number_to_double(i)); + vs_push(i); + break; + case t_longfloat: + r = make_longfloat((double)(sf(r))); + vs_push(r); + break; + default: + break; + } + break; + case t_longfloat: + switch (type_of(i)) { + case t_fixnum: + case t_bignum: + case t_ratio: + case t_shortfloat: + i = make_longfloat(number_to_double(i)); + vs_push(i); + break; + default: + break; + } + break; + default: + break; + } + c = alloc_object(t_complex); + c->cmp.cmp_real = r; + c->cmp.cmp_imag = i; + vs_reset; + return(c); +} + +double +number_to_double(object x) +{ + switch(type_of(x)) { + case t_fixnum: + return((double)(fix(x))); + + case t_bignum: + return(big_to_double(/* (struct bignum *) */x)); + + case t_ratio: + + /* vs_base=vs_top; */ + /* vs_push(x); */ + /* Lround(); */ + /* if (vs_base[0]!=small_fixnum(0)) */ + /* return number_to_double(vs_base[0])+number_to_double(vs_base[1]); */ + /* else */ + { + double dx,dy; + object xx,yy; + + for (xx=x->rat.rat_num,yy=x->rat.rat_den,dx=number_to_double(xx),dy=number_to_double(yy); + dx && dy && (!ISNORMAL(dx) || !ISNORMAL(dy));) { + + if (ISNORMAL(dx)) + dx*=0.5; + else { + xx=integer_divide1(xx,small_fixnum(2),0); + dx=number_to_double(xx); + } + + if (ISNORMAL(dy)) + dy*=0.5; + else { + yy=integer_divide1(yy,small_fixnum(2),0); + dy=number_to_double(yy); + } + + } + + return dx/dy; + } + + case t_shortfloat: + return((double)(sf(x))); + + case t_longfloat: + return(lf(x)); + + default: + wrong_type_argument(TSor_rational_float, x); + return(0.0); + } +} + +void +gcl_init_number(void) +{ + +#if !defined(IM_FIX_BASE) || defined(USE_SAFE_CDR) + FFN(fSallocate_bigger_fixnum_range)(-1024,1024); +#endif + + shortfloat_zero = alloc_object(t_shortfloat); + sf(shortfloat_zero) = (shortfloat)0.0; + longfloat_zero = alloc_object(t_longfloat); + lf(longfloat_zero) = (longfloat)0.0; + enter_mark_origin(&shortfloat_zero); + enter_mark_origin(&longfloat_zero); + + make_constant("MOST-POSITIVE-FIXNUM", + make_fixnum(MOST_POSITIVE_FIX)); + make_constant("MOST-NEGATIVE-FIXNUM", + make_fixnum(MOST_NEGATIVE_FIX)); + + gcl_init_big(); + gcl_init_num_pred(); + gcl_init_num_comp(); + gcl_init_num_arith(); + gcl_init_num_co(); + gcl_init_num_log(); + gcl_init_num_sfun(); + gcl_init_num_rand(); +} diff --git a/o/package.d b/o/package.d new file mode 100755 index 0000000..0b5bbc9 --- /dev/null +++ b/o/package.d @@ -0,0 +1,1317 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + package.d +*/ + +#include +#include "include.h" + +#define HASHCOEF 12345 /* hashing coefficient */ + +void check_type_or_symbol_string_package(object *); + +#define INTERNAL 1 +#define EXTERNAL 2 +#define INHERITED 3 + +#define P_INTERNAL(x,j) ((x)->p.p_internal[(j) % (x)->p.p_internal_size]) +#define P_EXTERNAL(x,j) ((x)->p.p_external[(j) % (x)->p.p_external_size]) + + +#define string_eq(a,b) \ + ((a)->st.st_fillp==(b)->st.st_fillp && \ + bcmp((a)->st.st_self,(b)->st.st_self,(a)->st.st_fillp)==0) + +static bool +member_string_eq(x, l) +object x, l; +{ + for (; consp(l); l = l->c.c_cdr) + if (string_eq(x, l->c.c_car)) + return(TRUE); + return(FALSE); +} + +static inline object +coerce_to_str(object x) { + + switch(type_of(x)) { + case t_string: + case t_symbol: + return x; + case t_fixnum: + case t_character: + return coerce_to_string(x); + /* printf("foobar\n");fflush(stdout); */ + /* token->st.st_self=(char *)&x->ch.ch_code;/\*FIXME*\/ */ + /* token->st.st_fillp=1; */ + /* return token; */ + default: + TYPE_ERROR(x,TSor_symbol_string); + return Cnil; + } + +} + + +static bool +designate_package(object x,struct package *p) { + + switch(type_of(x)) { + case t_string: case t_symbol: + return string_eq(x,p->p_name) || member_string_eq(x, p->p_nicknames); + break; + case t_character: + return designate_package(coerce_to_str(x),p); + break; + case t_package: + return x==(object)p; + break; + default: + FEwrong_type_argument(TSor_symbol_string_package,x); + break; + } + return FALSE; + +} + +/* #define bad_package_name(a) (type_of(a)==t_string &&\ */ +/* (memchr((a)->st.st_self,'-',(a)->st.st_fillp) || \ */ +/* ((a)->st.st_self[0]=='*' && (a)->st.st_fillp==1))) */ + +#define check_package_designator(a) if (!stringp(a) && \ + type_of(a)!=t_character && \ + type_of(a)!=t_symbol && \ + type_of(a)!=t_package) \ + FEwrong_type_argument(TSor_symbol_string_package,(a)) +#define check_type_or_symbol_string_package(a) check_package_designator(*a) + +static void +rehash_pack(object **ptab,int *n,int m) { + object *ntab; + object *tab = *ptab; + object l,ll; + int k,i; + i=0; + k = *n; + {BEGIN_NO_INTERRUPT; + ntab= AR_ALLOC(alloc_contblock,m,object); + *ptab = ntab; + *n=m; + while(ic.c_car)%m; + ll=l->c.c_cdr; + l->c.c_cdr = ntab[j]; + ntab[j]=l; + l=ll; + } + END_NO_INTERRUPT;} +} + +/* some prime numbers suitable for package sizes */ + +static int package_sizes[]={ + 97,251, 509, 1021, 2039, 4093, 8191, 16381, + 32749, 65521, 131071, 262139, 524287, 1048573}; + +static int +suitable_package_size(int n) +{int *i=package_sizes; + if (n>= 1000000) return 1048573; + while(*i < n) { i++;} + return *i;} + +/* + Make_package(n, ns, ul, isize , esize) makes a package with name n, + which must be a string or a symbol, + and nicknames ns, which must be a list of strings or symbols, + and uses packages in list ul, which must be a list of packages + or package names i.e. strings or symbols. +*/ +static object +make_package(n, ns, ul,isize,esize) +object n, ns, ul; +int isize,esize; +{ + + object x, y; + int i; + vs_mark; + { BEGIN_NO_INTERRUPT; + BEGIN: + n=coerce_to_string(n); + if (find_package(n) != Cnil) { + PACKAGE_CERROR(n,"Input new package","Package already exists",0); + NEW_INPUT(n); + goto BEGIN; + } + x = alloc_object(t_package); + x->p.p_name = n; + x->p.p_nicknames = Cnil; + x->p.p_shadowings = Cnil; + x->p.p_uselist = Cnil; + x->p.p_usedbylist = Cnil; + x->p.p_internal = NULL; + x->p.p_external = NULL; + x->p.p_internal_size = (isize ? isize : suitable_package_size(200)); + x->p.p_external_size = (esize ? esize : suitable_package_size(60)); + x->p.p_internal_fp =0; + x->p.p_external_fp =0; + + vs_push(x); + for (; !endp(ns); ns = ns->c.c_cdr) { + n = ns->c.c_car; + n=coerce_to_string(n); + if (find_package(n) != Cnil) { + vs_reset; + PACKAGE_CERROR(n,"Input new nicknames list","Package already exists",0); + NEW_INPUT(ns); + goto BEGIN; + } + x->p.p_nicknames = make_cons(n, x->p.p_nicknames); + } + for (; !endp(ul); ul = ul->c.c_cdr) { + if (type_of(ul->c.c_car) == t_package) + y = ul->c.c_car; + else { + y = find_package(ul->c.c_car); + if (y == Cnil) { + PACKAGE_CERROR(ul->c.c_car,"Continue anyway","No such package",0); + continue; + } + } + x->p.p_uselist = make_cons(y, x->p.p_uselist); + y->p.p_usedbylist = make_cons(x, y->p.p_usedbylist); + } + x->p.p_internal + = AR_ALLOC(alloc_contblock,x->p.p_internal_size,object); + for (i = 0; i < x->p.p_internal_size; i++) + x->p.p_internal[i] = Cnil; + x->p.p_external + = AR_ALLOC(alloc_contblock,x->p.p_external_size,object); + for (i = 0; i < x->p.p_external_size; i++) + x->p.p_external[i] = Cnil; + x->p.p_link = pack_pointer; + pack_pointer = &(x->p); + vs_reset; + END_NO_INTERRUPT;} + return(x); +} + +static void +use_package(object,object); + +static object +in_package(n, ns, ul,isize,esize) +object n, ns, ul; +int isize,esize; +{ + + object x, y; + vs_mark; + + BEGIN: + x = find_package(n); + if (x == Cnil) { +#ifdef ANSI_COMMON_LISP + PACKAGE_CERROR(n,"Input new package","No such package",0); + NEW_INPUT(n); + goto BEGIN; + return Cnil; +#else + x = make_package(n, ns, ul,isize,esize); + goto L; +#endif + } + if (isize) rehash_pack(&(x->p.p_internal), + &x->p.p_internal_size,isize); + for (; !endp(ns); ns = ns->c.c_cdr) { + n = ns->c.c_car; + n=coerce_to_string(n); + y = find_package(n); + if (x == y) + continue; + if (y != Cnil) { + PACKAGE_CERROR(n,"Input new nicknames list","Package already exists",0); + NEW_INPUT(ns); + goto BEGIN; + } + x->p.p_nicknames = make_cons(n, x->p.p_nicknames); + } + for (; !endp(ul); ul = ul->c.c_cdr) + use_package(ul->c.c_car, x); +#ifndef ANSI_COMMON_LISP +L: +#endif + sLApackageA->s.s_dbind = x; + vs_reset; + return(x); +} + +static object +rename_package(x, n, ns) +object x, n, ns; +{ + + object y; + vs_mark; + + BEGIN: + n=coerce_to_string(n); + if (!(equal(x->p.p_name,n)) && + find_package(n) != Cnil) { + PACKAGE_CERROR(n,"Input new package","Package already exists",0); + NEW_INPUT(n); + goto BEGIN; + } + x->p.p_name = n; + x->p.p_nicknames = Cnil; + for (; !endp(ns); ns = ns->c.c_cdr) { + n = ns->c.c_car; + n=coerce_to_string(n); + y = find_package(n); + if (x == y) + continue; + if (y != Cnil) { + PACKAGE_CERROR(n,"Input nicknames list","Package already exists",0); + NEW_INPUT(ns); + goto BEGIN; + } + x->p.p_nicknames = make_cons(n, x->p.p_nicknames); + } + vs_reset; + return(x); +} + + +/* + Find_package(n) seaches for a package with name n, + which is a string or a symbol. + If not so, an error is signaled. +*/ +object +find_package(n) +object n; +{ + struct package *p; + + check_package_designator(n); + for (p = pack_pointer; p != NULL; p = p->p_link) + if (designate_package(n,p)) + return ((object)p); + return(Cnil); +} + +static object +coerce_to_package(p) +object p; +{ + object pp; + + if (type_of(p) == t_package) + return(p); + pp = find_package(p); + if (pp == Cnil) { + PACKAGE_CERROR(p,"Input new package","No such package",0); + NEW_INPUT(p); + return coerce_to_package(p); + } + return(pp); +} + +object +current_package() +{ + object x; + + x = symbol_value(sLApackageA); + if (type_of(x) != t_package) { + sLApackageA->s.s_dbind = user_package; + FEerror("The value of *PACKAGE*, ~S, was not a package.", + 1, x); + } + return(x); +} + +/* + Pack_hash(st) hashes string st + and returns the index for a hash table of a package. +*/ + +int +pack_hash(x) +object x; +{unsigned int h=0; + x=coerce_to_str(x); + {int len=x->st.st_fillp; + char *s; +#define HADD(i,j,k,l) (h+=s[i],h+=s[j]<<8,h+=s[k]<<13,h+=s[l]<<23) +#define HADD2(i,j) (h+=s[i]<<5,h+=s[j]<<15) + s=x->st.st_self; + switch(len) { + case 0: break; + case 10: + case 9: HADD(1,4,6,8); HADD2(5,7); goto END; + case 8: HADD(1,3,5,7); HADD2(2,4); goto END; + case 7: HADD(1,3,4,5); HADD2(6,2); goto END; + case 6: HADD(1,3,4,5); HADD2(0,2); goto END; + case 5: h+= s[4] << 13; + case 4: h+= s[3] << 24; + case 3: h+= s[2]<< 16; + case 2: h+= s[1] << 8; + case 1: h+= s[0] ; + break; + default: + HADD(3,6,len-2,len-4); HADD2(1,len-1); + if (len > 15) {HADD2(7,10); + } + } + END: + h &= 0x7fffffff; + return(h); +}} + +DEFUN_NEW("PACK-HASH",fixnum,fSpack_hash,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + RETURN1(pack_hash(x)); +} + +DEFUN_NEW("SET-SYMBOL-HPACK",object,fSset_symbol_hpack,SI,2,2,NONE,OO,OO,OO,OO,(object p,object s),"") { + check_type_package(&p); + check_type_sym(&s); + RETURN1(s->s.s_hpack=p); +} + +/* DEFUN_NEW("PACKAGE-INTERNAL",object,fSpackage_internal,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum i),"") { */ +/* check_type_package(&x); */ +/* RETURN1(x->p.p_internal[i]); */ +/* } */ + +DEFUN_NEW("PACKAGE-INTERNAL_SIZE",fixnum,fSpackage_internal_size,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + check_type_package(&x); + RETURN1(x->p.p_internal_size); +} + +/* DEFUN_NEW("PACKAGE-EXTERNAL",object,fSpackage_external,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum i),"") { */ +/* check_type_package(&x); */ +/* RETURN1(x->p.p_external[i]); */ +/* } */ + +DEFUN_NEW("PACKAGE-EXTERNAL_SIZE",fixnum,fSpackage_external_size,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + check_type_package(&x); + RETURN1(x->p.p_external_size); +} + +/* + Intern(st, p) interns string st in package p. +*/ +object +intern(st, p) +object st, p; +{ + int j; + object x, *ip, *ep, l, ul; + vs_mark; + + st=coerce_to_str(st); + {BEGIN_NO_INTERRUPT; + j = pack_hash(st); + ip = &P_INTERNAL(p ,j); + + for (l = *ip; consp(l); l = l->c.c_cdr) + if (string_eq(l->c.c_car, st)) { + intern_flag = INTERNAL; + END_NO_INTERRUPT;return(l->c.c_car); + } + ep = &P_EXTERNAL(p,j); + for (l = *ep; consp(l); l = l->c.c_cdr) + if (string_eq(l->c.c_car, st)) { + intern_flag = EXTERNAL; + END_NO_INTERRUPT;return(l->c.c_car); + } + for (ul=p->p.p_uselist; consp(ul); ul=ul->c.c_cdr) + for (l = P_EXTERNAL(ul->c.c_car,j); + consp(l); + l = l->c.c_cdr) + if (string_eq(l->c.c_car, st)) { + intern_flag = INHERITED; + END_NO_INTERRUPT;return(l->c.c_car); + } + x = make_symbol(st); + vs_push(x); + if (p == keyword_package) { + x->s.s_stype = (short)stp_constant; + x->s.s_dbind = x; + *ep = make_cons(x, *ep); + keyword_package->p.p_external_fp ++; + intern_flag = 0; + } else { + *ip = make_cons(x, *ip); + if (p->p.p_internal_fp++>(p->p.p_internal_size << 1)) + rehash_pack(&(p->p.p_internal),&p->p.p_internal_size, + suitable_package_size(p->p.p_internal_fp)); + intern_flag = 0; + } + if (x->s.s_hpack == Cnil) + x->s.s_hpack = p; + vs_reset; + END_NO_INTERRUPT;return(x); +}} + +/* + Find_symbol(st, p) searches for string st in package p. +*/ +object +find_symbol(st, p) +object st, p; +{ + int j; + object *ip, *ep, l, ul; + {BEGIN_NO_INTERRUPT; + st=coerce_to_str(st); + j = pack_hash(st); + ip = &P_INTERNAL(p ,j); + for (l = *ip; consp(l); l = l->c.c_cdr) + if (string_eq(l->c.c_car, st)) { + intern_flag = INTERNAL; + END_NO_INTERRUPT;return(l->c.c_car); + } + ep = &P_EXTERNAL(p,j); + for (l = *ep; consp(l); l = l->c.c_cdr) + if (string_eq(l->c.c_car, st)) { + intern_flag = EXTERNAL; + END_NO_INTERRUPT;return(l->c.c_car); + } + for (ul=p->p.p_uselist; consp(ul); ul=ul->c.c_cdr) + for (l = P_EXTERNAL(ul->c.c_car,j); + consp(l); + l = l->c.c_cdr) + if (string_eq(l->c.c_car, st)) { + intern_flag = INHERITED; + END_NO_INTERRUPT;return(l->c.c_car); + } + intern_flag = 0; + END_NO_INTERRUPT;return(Cnil); +}} + +static bool +unintern(s, p) +object s, p; +{ + object x, y, l, *lp; + int j; + {BEGIN_NO_INTERRUPT; + j = pack_hash(s); + x = find_symbol(s, p); + if (intern_flag == INTERNAL && s == x) { + lp = &P_INTERNAL(p ,j); + if (member_eq(s, p->p.p_shadowings)) + goto L; + goto UNINTERN; + } + if (intern_flag == EXTERNAL && s == x) { + lp = &P_EXTERNAL(p,j); + if (member_eq(s, p->p.p_shadowings)) + goto L; + goto UNINTERN; + } + END_NO_INTERRUPT;return(FALSE); + +L: + x = OBJNULL; + for (l = p->p.p_uselist; consp(l); l = l->c.c_cdr) { + y = find_symbol(s, l->c.c_car); + if (intern_flag == EXTERNAL) { + if (x == OBJNULL) + x = y; + else if (x != y) { + PACKAGE_CERROR(p,"Input new symbol","Name conflict on unintern of shadowing symbol ~s",1,s); + NEW_INPUT(s); + goto L; + } + } + } + delete_eq(s, &p->p.p_shadowings); + +UNINTERN: + delete_eq(s, lp); + if (s->s.s_hpack == p) + s->s.s_hpack = Cnil; + if ((enum stype)s->s.s_stype != stp_ordinary) + uninterned_list = make_cons(s, uninterned_list); + END_NO_INTERRUPT;return(TRUE); +}} + +void +export(s, p) +object s, p; +{ + object x; + int j; + object *ep, *ip, l; + +BEGIN: + ip = NULL; + j = pack_hash(s); + x = find_symbol(s, p); + if (intern_flag) { + if (x != s) { + import(s, p); /* signals an error */ + goto BEGIN; + } + if (intern_flag == INTERNAL) + ip = &P_INTERNAL(p ,j); + else if (intern_flag == EXTERNAL) + return; + } else { + PACKAGE_CERROR(p,"Input new symbol","Symbol ~s not accessible",1,s); + NEW_INPUT(s); + goto BEGIN; + } + for (l = p->p.p_usedbylist; + consp(l); + l = l->c.c_cdr) { + x = find_symbol(s, l->c.c_car); + if (intern_flag && s != x && + !member_eq(x, l->c.c_car->p.p_shadowings)) { + PACKAGE_CERROR(p,"Input new symbol","Name conflict on exporting ~s",1,s); + NEW_INPUT(s); + goto BEGIN; + } + } + if (ip != NULL) + {delete_eq(s, ip); + p->p.p_internal_fp--;} + ep = &P_EXTERNAL(p,j); + p->p.p_external_fp++; + *ep = make_cons(s, *ep); +} + +static void +unexport(s, p) +object s, p; +{ + object x, *ep, *ip; + int j; + + BEGIN: + if (p == keyword_package) { + PACKAGE_CERROR(p,"Input new package","Cannot unexport a symbol from the keyword",0); + NEW_INPUT(p); + goto BEGIN; + } + x = find_symbol(s, p); + if (/* intern_flag != EXTERNAL || */ x != s) { + PACKAGE_CERROR(p,"Input new symbol","Symbol ~s not in package.",1,s); + NEW_INPUT(s); + goto BEGIN; + } +/* "Cannot unexport the symbol ~S~%\ */ +/* from ~S,~%\ */ +/* because the symbol is not an external symbol~%\ */ +/* of the package.", 2, s, p); */ + j = pack_hash(s); + ep = &P_EXTERNAL(p,j); + delete_eq(s, ep); + ip = &P_INTERNAL(p ,j); + p->p.p_internal_fp++; + *ip = make_cons(s, *ip); +} + +void +import(s, p) +object s, p; +{ + object x; + int j; + object *ip; + + BEGIN: + x = find_symbol(s, p); + if (intern_flag) { + if (x != s) { + PACKAGE_CERROR(p,"Input new symbol","Name conflict on importing ~s",1,s); + NEW_INPUT(s); + goto BEGIN; + } + if (intern_flag == INTERNAL || intern_flag == EXTERNAL) + return; + } + j = pack_hash(s); + ip = &P_INTERNAL(p ,j); + p->p.p_internal_fp++; + *ip = make_cons(s, *ip); + if (s->s.s_hpack==Cnil) {if (p==keyword_package) s->s.tt=2;s->s.s_hpack=p;} +} + +static void +shadowing_import(s, p) +object s, p; +{ + object x, *ip; + + x=find_symbol(s, p); + if (intern_flag && intern_flag != INHERITED) { + if (x == s) { + if (!member_eq(x, p->p.p_shadowings)) + p->p.p_shadowings + = make_cons(x, p->p.p_shadowings); + return; + } + if(member_eq(x, p->p.p_shadowings)) + delete_eq(x, &p->p.p_shadowings); + if (intern_flag == INTERNAL) + delete_eq(x, &P_INTERNAL(p,pack_hash(x))); + else + delete_eq(x, &P_EXTERNAL(p ,pack_hash(x))); + if (x->s.s_hpack == p) + x->s.s_hpack = Cnil; + if ((enum stype)x->s.s_stype != stp_ordinary) + uninterned_list = make_cons(x, uninterned_list); + } + ip = &P_INTERNAL(p ,pack_hash(s)); + *ip = make_cons(s, *ip); + p->p.p_internal_fp++; + p->p.p_shadowings = make_cons(s, p->p.p_shadowings); +} + +static void +shadow(s, p) +object s, p; +{ + int j; + object *ip,x; + + s=coerce_to_str(s); + x=find_symbol(s, p); + if (intern_flag == INTERNAL || intern_flag == EXTERNAL) { + p->p.p_shadowings = make_cons(x, p->p.p_shadowings); + return; + } + j = pack_hash(s); + ip = &P_INTERNAL(p ,j); + vs_push(make_symbol(s)); + vs_head->s.s_hpack = p; + *ip = make_cons(vs_head, *ip); + p->p.p_internal_fp++; + p->p.p_shadowings = make_cons(vs_head, p->p.p_shadowings); + vs_popp; +} + +static void +use_package(x0, p) +object x0, p; +{ + object x = x0; + int i; + object y, l; + + BEGIN: + if (type_of(x) != t_package) { + x = find_package(x); + if (x == Cnil) { + PACKAGE_CERROR(x0,"Input new package","No such package",0); + NEW_INPUT(x0); + goto BEGIN; + } + } + if (x == keyword_package) { + PACKAGE_CERROR(x,"Input new package","Cannot use keyword package",0); + NEW_INPUT(x); + goto BEGIN; + } + if (p == x) + return; + if (member_eq(x, p->p.p_uselist)) + return; + for (i = 0; i < x->p.p_external_size; i++) + for (l = P_EXTERNAL(x ,i); + consp(l); + l = l->c.c_cdr) { + y = find_symbol(l->c.c_car, p); + if (intern_flag && l->c.c_car != y + && ! member_eq(y,p->p.p_shadowings) + ) { + PACKAGE_CERROR(p,"Input new package","Name conflict on using ~s from ~s",2,p,y); + NEW_INPUT(p); + goto BEGIN; + } + } + p->p.p_uselist = make_cons(x, p->p.p_uselist); + x->p.p_usedbylist = make_cons(p, x->p.p_usedbylist); +} + +static void +unuse_package(x0, p) +object x0, p; +{ + object x = x0; + + BEGIN: + if (type_of(x) != t_package) { + x = find_package(x); + if (x == Cnil) { + PACKAGE_CERROR(x0,"Input new package","No such package",0); + NEW_INPUT(x0); + goto BEGIN; + } + } + delete_eq(x, &p->p.p_uselist); + delete_eq(p, &x->p.p_usedbylist); +} + + + +static object +delete_package(object n) { + + struct package *p,*pp; + object t; + + for (p = pack_pointer,pp=NULL; p != NULL; pp=p,p = p->p_link) + + if (designate_package(n,p)) { + + if (p->p_usedbylist!=Cnil) { + + PACKAGE_CERROR((object)n,"Delete anyway","Package used by other packages",0); + + for (t=p->p_usedbylist;!endp(t);t=t->c.c_cdr) + unuse_package((object)p,t->c.c_car); + + } + + if (p->p_uselist!=Cnil) { + for (t=p->p_uselist;!endp(t);t=t->c.c_cdr) + unuse_package(t->c.c_car,(object)p); + } + + p->p_name=Cnil; + + if (pp) + pp->p_link=p->p_link; + else + pack_pointer=p->p_link; + + return(Ct); + + } + + if (type_of(n)!=t_package) { + PACKAGE_CERROR(n,"Input new package","No such package",0); + NEW_INPUT(n); + return delete_package(n); + } + + return(Cnil); + +} + +/* (use `make_cons(lisp_package, Cnil)`) */ + + +@(defun make_package (pack_name + &key nicknames + (use Cnil) + (internal `small_fixnum(0)`) + (external `small_fixnum(0)`) + ) +@ + check_type_or_string_symbol(&pack_name); + @(return `make_package(pack_name, nicknames, use, + fix(internal),fix(external))`) +@) + +@(defun in_package (pack_name &key nicknames (use Cnil use_sp) + (internal `small_fixnum(0)`) + (external `small_fixnum(0)`) + ) +@ + check_type_or_string_symbol(&pack_name); + if (find_package(pack_name) == Cnil && !(use_sp)) + use = make_cons(lisp_package, Cnil); + @(return `in_package(pack_name, nicknames, use,fix(internal),fix(external))`) +@) + +extern object sKuse; +extern object sKnicknames; +DEF_ORDINARY("IN-PACKAGE-INTERNAL",sSin_package_internal,SI,""); +DEFUN_NEW("IN-PACKAGE-INTERNAL",object,fSin_package_internal,SI,2,2,NONE,OO,OO,OO,OO,(object p,object r),"") { + + object use=Cnil,nick=Cnil; + + /*fixme non-std error check?*/ + for (;consp(r) && consp(r->c.c_cdr);r=r->c.c_cdr->c.c_cdr) { + if (r->c.c_car==sKuse) + use=Ieval1(r->c.c_cdr->c.c_car); + if (r->c.c_car==sKnicknames) + nick=Ieval1(r->c.c_cdr->c.c_car); + } + + RETURN1(in_package(p,nick,use,0,0)); + +} + +#ifdef ANSI_COMMON_LISP + +static void +FFN(Fin_package)(void) { + + object x; + + if (vs_top-vs_base!=2) + FEwrong_no_args("Fin_package requires two arguments",make_fixnum(vs_top-vs_base)); + x=MMcadr(vs_base[0]); + x=type_of(x)==t_symbol ? list(2,sLquote,x) : x; + vs_base[0]=list(3,sSin_package_internal,x,list(2,sLquote,MMcddr(vs_base[0]))); + vs_top=vs_base+1; + +} + +#endif + +DEFUN_NEW("FIND-PACKAGE",object,fLfind_package,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(find_package(x));/*FIXME p->p_link not exposable in lisp*/ +} + +LFD(Ldelete_package)() +{ + check_arg(1); + + vs_base[0] = delete_package(vs_base[0]); +} + +LFD(Lpackage_name)() +{ + object t; + + check_arg(1); + + check_package_designator(vs_base[0]); + t=coerce_to_package(vs_base[0]); + vs_base[0]=t==Cnil ? t : t->p.p_name; + +} + +LFD(Lpackage_nicknames)() +{ + check_arg(1); + + check_package_designator(vs_base[0]); + vs_base[0] = coerce_to_package(vs_base[0]); + vs_base[0] = vs_base[0]->p.p_nicknames; +} + +@(defun rename_package (pack new_name &o new_nicknames) +@ + check_package_designator(pack); + pack = coerce_to_package(pack); + check_type_or_string_symbol(&new_name); + @(return `rename_package(pack, new_name, new_nicknames)`) +@) + +LFD(Lpackage_use_list)() +{ + check_arg(1); + + check_package_designator(vs_base[0]); + vs_base[0] = coerce_to_package(vs_base[0]); + vs_base[0] = vs_base[0]->p.p_uselist; +} + +LFD(Lpackage_used_by_list)() +{ + check_arg(1); + + check_package_designator(vs_base[0]); + vs_base[0] = coerce_to_package(vs_base[0]); + vs_base[0] = vs_base[0]->p.p_usedbylist; +} + +static void +FFN(Lpackage_shadowing_symbols)() +{ + check_arg(1); + + check_package_designator(vs_base[0]); + vs_base[0] = coerce_to_package(vs_base[0]); + vs_base[0] = vs_base[0]->p.p_shadowings; +} + +LFD(Llist_all_packages)() { + + struct package *p; + object x,*l; + int i; + + check_arg(0); + + for (l=&x,p=pack_pointer,i=0;p!=NULL;p=p->p_link,i++) + collect(l,make_cons((object)p,Cnil)); + *l=Cnil; + vs_push(x); + +} + +@(defun intern (strng &optional (p `current_package()`) &aux sym) +@ + check_type_string(&strng); + check_package_designator(p); + p = coerce_to_package(p); + sym = intern(strng, p); + if (intern_flag == INTERNAL) + @(return sym sKinternal) + if (intern_flag == EXTERNAL) + @(return sym sKexternal) + if (intern_flag == INHERITED) + @(return sym sKinherited) + @(return sym Cnil) +@) + +@(defun find_symbol (strng &optional (p `current_package()`)) + object x; +@ + check_type_string(&strng); + check_package_designator(p); + p = coerce_to_package(p); + x = find_symbol(strng, p); + if (intern_flag == INTERNAL) + @(return x sKinternal) + if (intern_flag == EXTERNAL) + @(return x sKexternal) + if (intern_flag == INHERITED) + @(return x sKinherited) + @(return Cnil Cnil) +@) + +@(defun unintern (symbl &optional (p `current_package()`)) +@ + check_type_sym(&symbl); + check_package_designator(p); + p = coerce_to_package(p); + if (unintern(symbl, p)) + @(return Ct) + else + @(return Cnil) +@) + +@(defun export (symbols &o (pack `current_package()`)) + object l; + +@ + check_package_designator(pack); + pack = coerce_to_package(pack); +BEGIN: + switch (type_of(symbols)) { + case t_symbol: + if (symbols == Cnil) + break; + export(symbols, pack); + break; + + case t_cons: + for (l = symbols; !endp(l); l = l->c.c_cdr) { + check_type_sym(&l->c.c_car); + export(l->c.c_car, pack); + } + break; + + default: + check_type_sym(&symbols); + goto BEGIN; + } + @(return Ct) +@) + +@(defun unexport (symbols &o (pack `current_package()`)) + object l; + +@ + check_package_designator(pack); + pack = coerce_to_package(pack); +BEGIN: + switch (type_of(symbols)) { + case t_symbol: + if (symbols == Cnil) + break; + unexport(symbols, pack); + break; + + case t_cons: + for (l = symbols; !endp(l); l = l->c.c_cdr) { + check_type_sym(&l->c.c_car); + unexport(l->c.c_car, pack); + } + break; + + default: + check_type_sym(&symbols); + goto BEGIN; + } + @(return Ct) +@) + +@(defun import (symbols &o (pack `current_package()`)) + object l; +@ + check_package_designator(pack); + pack = coerce_to_package(pack); +BEGIN: + switch (type_of(symbols)) { + case t_symbol: + if (symbols == Cnil) + break; + import(symbols, pack); + break; + + case t_cons: + for (l = symbols; !endp(l); l = l->c.c_cdr) + import(l->c.c_car, pack); + break; + + default: + check_type_sym(&symbols); + goto BEGIN; + } + @(return Ct) +@) + +@(defun shadowing_import (symbols &o (pack `current_package()`)) + object l; +@ + check_package_designator(pack); + pack = coerce_to_package(pack); +BEGIN: + switch (type_of(symbols)) { + case t_symbol: + if (symbols == Cnil) + break; + shadowing_import(symbols, pack); + break; + + case t_cons: + for (l = symbols; !endp(l); l = l->c.c_cdr) + shadowing_import(l->c.c_car, pack); + break; + + default: + check_type_sym(&symbols); + goto BEGIN; + } + @(return Ct) +@) + +@(defun shadow (symbols &o (pack `current_package()`)) + object l; +@ + check_package_designator(pack); + pack = coerce_to_package(pack); +BEGIN: + switch (type_of(symbols)) { + case t_symbol: + case t_string: + case t_character: + if (symbols == Cnil) + break; + shadow(symbols, pack); + break; + + case t_cons: + for (l = symbols; !endp(l); l = l->c.c_cdr) + shadow(l->c.c_car, pack); + break; + + default: + check_type_or_symbol_string(&symbols); + goto BEGIN; + } + @(return Ct) +@) + +@(defun use_package (pack &o (pa `current_package()`)) + object l; +@ + check_package_designator(pa); + pa = coerce_to_package(pa); +BEGIN: + switch (type_of(pack)) { + case t_symbol: + if (pack == Cnil) + break; + + case t_string: + case t_package: + case t_character: + use_package(pack, pa); + break; + + case t_cons: + for (l = pack; !endp(l); l = l->c.c_cdr) + use_package(l->c.c_car, pa); + break; + + default: + check_type_package(&pack); + goto BEGIN; + } + @(return Ct) +@) + +@(defun unuse_package (pack &o (pa `current_package()`)) + object l; +@ + check_package_designator(pa); + pa = coerce_to_package(pa); +BEGIN: + switch (type_of(pack)) { + case t_symbol: + if (pack == Cnil) + break; + + case t_string: + case t_package: + case t_character: + unuse_package(pack, pa); + break; + + case t_cons: + for (l = pack; !endp(l); l = l->c.c_cdr) + unuse_package(l->c.c_car, pa); + break; + + default: + check_type_package(&pack); + goto BEGIN; + } + @(return Ct) +@) + +LFD(siLpackage_internal)() +{ + + int j=0; + + check_arg(2); + check_type_package(&vs_base[0]); + if (type_of(vs_base[1]) != t_fixnum || + (j = fix(vs_base[1])) < 0 || j >= vs_base[0]->p.p_internal_size) + FEerror("~S is an illegal index to a package hashtable.", + 1, vs_base[1]); + vs_base[0] = P_INTERNAL(vs_base[0],j); + vs_popp; +} + +LFD(siLpackage_external)() +{ + int j=0; + + check_arg(2); + check_type_package(&vs_base[0]); + if (type_of(vs_base[1]) != t_fixnum || + (j = fix(vs_base[1])) < 0 || j >= vs_base[0]->p.p_external_size) + FEerror("~S is an illegal index to a package hashtable.", + 1, vs_base[1]); + vs_base[0] = P_EXTERNAL(vs_base[0],j); + vs_popp; +} + +static void +FFN(siLpackage_size)() +{object p; + p=vs_base[0]; + check_type_package(&p); + check_arg(1); + vs_base[0]=make_fixnum(p->p.p_external_size); + vs_base[1]=make_fixnum(p->p.p_internal_size); + vs_top=vs_base+2; + return; +} + +DEF_ORDINARY("EXTERNAL",sKexternal,KEYWORD,""); +DEF_ORDINARY("INHERITED",sKinherited,KEYWORD,""); +DEF_ORDINARY("INTERNAL",sKinternal,KEYWORD,""); +DEF_ORDINARY("NICKNAMES",sKnicknames,KEYWORD,""); +DEF_ORDINARY("USE",sKuse,KEYWORD,""); +DEFVAR("*PACKAGE*",sLApackageA,LISP,lisp_package,""); + + +void +gcl_init_package() +{ + + lisp_package + = make_package(make_simple_string("COMMON-LISP"), + list(2,make_simple_string("CL"),make_simple_string("LISP")),Cnil,47,509); + user_package + = make_package(make_simple_string("COMMON-LISP-USER"), + list(2,make_simple_string("CL-USER"),make_simple_string("USER")), + make_cons(lisp_package, Cnil),509,97); + keyword_package + = make_package(make_simple_string("KEYWORD"), + Cnil, Cnil,11,509); + system_package + = make_package(make_simple_string("SYSTEM"), + make_cons(make_simple_string("SI"), + make_cons(make_simple_string("SYS"), + Cnil)), + make_cons(lisp_package, Cnil),251,157); + + /* There is no need to enter a package as a mark origin. */ + + uninterned_list = Cnil; + enter_mark_origin(&uninterned_list); +} + +void +gcl_init_package_function() +{ + make_function("MAKE-PACKAGE", Lmake_package); + make_function("DELETE-PACKAGE", Ldelete_package); +#ifdef ANSI_COMMON_LISP + make_si_function("KCL-IN-PACKAGE", Lin_package); + make_macro_function("IN-PACKAGE", Fin_package); +#else + make_function("IN-PACKAGE", Lin_package); +#endif + make_function("PACKAGE-NAME", Lpackage_name); + make_function("PACKAGE-NICKNAMES", Lpackage_nicknames); + make_function("RENAME-PACKAGE", Lrename_package); + make_function("PACKAGE-USE-LIST", Lpackage_use_list); + make_function("PACKAGE-USED-BY-LIST", Lpackage_used_by_list); + make_function("PACKAGE-SHADOWING-SYMBOLS",Lpackage_shadowing_symbols); + make_function("LIST-ALL-PACKAGES", Llist_all_packages); + make_function("INTERN", Lintern); + make_function("FIND-SYMBOL", Lfind_symbol); + make_function("UNINTERN", Lunintern); + make_function("EXPORT", Lexport); + make_function("UNEXPORT", Lunexport); + make_function("IMPORT", Limport); + make_function("SHADOWING-IMPORT", Lshadowing_import); + make_function("SHADOW", Lshadow); + make_function("USE-PACKAGE", Luse_package); + make_function("UNUSE-PACKAGE", Lunuse_package); + + make_si_function("PACKAGE-SIZE",siLpackage_size); + make_si_function("PACKAGE-INTERNAL", siLpackage_internal); + make_si_function("PACKAGE-EXTERNAL", siLpackage_external); +} diff --git a/o/pari_big.c b/o/pari_big.c new file mode 100755 index 0000000..73ca34f --- /dev/null +++ b/o/pari_big.c @@ -0,0 +1,565 @@ + /* Copyright William F. Schelter 1991 + Bignum routines. + + + +num_arith.c: add_int_big +num_arith.c: big_minus +num_arith.c: big_plus +num_arith.c: big_quotient_remainder +num_arith.c: big_sign +num_arith.c: big_times +num_arith.c: complement_big +num_arith.c: copy_big +num_arith.c: div_int_big +num_arith.c: mul_int_big +num_arith.c: normalize_big +num_arith.c: normalize_big_to_object +num_arith.c: stretch_big +num_arith.c: sub_int_big +num_comp.c: big_compare +num_comp.c: big_sign +num_log.c: big_sign +num_log.c: copy_to_big +num_log.c: normalize_big +num_log.c: normalize_big_to_object +num_log.c: stretch_big +num_pred.c: big_sign +number.c: big_to_double +predicate.c: big_compare +typespec.c: big_sign +print.d: big_minus +print.d: big_sign +print.d: big_zerop +print.d: copy_big +print.d: div_int_big +read.d: add_int_big +read.d: big_to_double +read.d: complement_big +read.d: mul_int_big +read.d: normalize_big +read.d: normalize_big_to_object + + */ + +#define BCOPY_BODY(x,y) \ +do { int *ucop = (int *)(x); \ + int *vcop = (int *) (y); \ + {int j = lgef(ucop); \ + while(--j >= 0) \ + { *vcop++ = *ucop++;}}}while (0) + +bcopy_body(x,y) + GEN x,y; +{BCOPY_BODY(x,y);} + + + +/* make a bignum with (most <<32 + least) */ +object +bignum2(most, least) +int most, least; +{ static plong u [4] + = {0x01010004 ,0x01010004, 0,0}; + GEN w; + int l; + if(most) {setlgef(u,4),l=4;} + else {l=3; setlgef(u,3);} + MP_START_LOW(w,u,l); + MP_NEXT_UP(w) = least; + if (most) MP_NEXT_UP(w) = most; + return make_integer(u); +} + + + +/* coerce a pari GEN to a bignum or fixnum */ + +object +make_integer(u) +GEN u; +{ int l = lgef(u); + if (l > (MP_CODE_WORDS+1) || + ( l == (MP_CODE_WORDS+1) && + (MP_ONLY_WORD(u) & (1<<31)) != 0 + && (MP_ONLY_WORD(u) == ( 1<<31) ? signe(u) > 0 : 1))) + { object ans ; + GEN w; + + { BEGIN_NO_INTERRUPT; + big_register_1->big.big_length = lg(u); + big_register_1->big.big_self = u; + ans = alloc_object(t_bignum); + ans->big.big_self = 0; + w = (plong *)alloc_relblock(lg(u)*sizeof(plong)); + /* may have been relocated */ + u = (GEN) big_register_1->big.big_self ; + ans->big.big_self = w; + ans->big.big_length = l; + BCOPY_BODY(u , w); + setlg(w,l); + END_NO_INTERRUPT;} + return ans; + } + else + if (signe(u) > 0) return make_fixnum(MP_ONLY_WORD(u)); + else + if (signe(u) < 0) return make_fixnum(-MP_ONLY_WORD(u)); + else + return(small_fixnum(0)); + } + + +static object +make_bignum(u) +GEN u; +{ BEGIN_NO_INTERRUPT; + { object ans = alloc_object(t_bignum); + GEN w; + ans->big.big_length = lg(u); + /* save u */ + ans->big.big_self = u; + w = (plong *)alloc_relblock(lg(u)*sizeof(plong)); + /* restore u */ + u = ans->big.big_self ; + ans->big.big_self = w; + BCOPY_BODY(u , ans->big.big_self); + END_NO_INTERRUPT; + return ans; + }} +static +big_zerop(x) + object x; +{ return (signe(MP(x))== 0);} + +big_compare(x, y) + object x,y; +{return cmpii(MP(x),MP(y));} + +object +big_minus(x) + object x; +{ object y; + setsigne(MP(x),-(signe(MP(x)))); + y = make_integer(MP(x)); + setsigne(MP(x),-(signe(MP(x)))); + return y; +} +static +gcopy_to_big(res,x) + GEN res; + object x; +{int l = (x)->big.big_length; + int lgres = lg(res); + if (l< lgres) + { BEGIN_NO_INTERRUPT; + big_register_1->big.big_length = lgres; + big_register_1->big.big_self = res; + (x)->big.big_self = (GEN) alloc_relblock(lgres*sizeof(int)); + (x)->big.big_length = lgres; + res = big_register_1->big.big_self ; + END_NO_INTERRUPT; + } + BCOPY_BODY(res,(x)->big.big_self); + if (l>lgres) + { setlg((x)->big.big_self, l);} +} + + +add_int_big(i, x) +int i; +object x; +{ + MPOP_DEST(x,addsi,i,MP(x)); +} +static +sub_int_big(i, x) +int i; +object x; +{ MPOP_DEST(x,subsi,i,MP(x)); +} + +mul_int_big(i, x) +int i; +object x; +{ MPOP_DEST(x,mulsi,i,MP(x)); +} + +/* + Div_int_big(i, x) destructively divides non-negative bignum x + by positive int i. + X will hold the quotient from the division. + Div_int_big(i, x) returns the remainder of the division. + I should be positive. + X should be non-negative. +*/ +static +div_int_big(i, x) +int i; +object x; +{ save_avma; + GEN res = divis(MP(x),i); + gcopy_to_big(res,x); + restore_avma; + return hiremainder; +} + + +static object +big_plus(x, y) +object x,y; +{ MPOP(return,addii,MP(x),MP(y)); +} + +static object +big_times(x, y) +object x,y; +{ + MPOP(return,mulii,MP(x),MP(y)); +} + + +static +big_quotient_remainder(x0, y0, qp, rp) + object x0,y0,*qp,*rp; +{ + GEN res,quot; + save_avma; + res = dvmdii(MP(x0),MP(y0),"); + *qp = make_integer(res); + *rp = make_integer(quot); + restore_avma; + return; + +} + + +double +big_to_double(x) + object x; +{ + double d, e; + GEN u = MP(x); + unsigned int *w; + int l; + e = 4.294967296e9; + + l = lgef(u); + MP_START_HIGH(w,(unsigned int *) u,l); + l = l - MP_CODE_WORDS; + + if (l == 0) return 0.0; + + d = (double) MP_NEXT_DOWN(w); + while (--l > 0) + {d = e*d + (double)(MP_NEXT_DOWN(w));} + if (signe(u)>0) return d; + else return -d; + } + + +object +normalize_big_to_object(x) + object x; +{ return make_integer(MP(x));} + + +static object copy_big(x) + object x; +{ + if (type_of(x)==t_bignum) + return make_bignum(MP(x)); + else FEerror("bignum expected",0); + +} + + +static object +copy_to_big(x) + object x; +{object y; + + if (type_of(x) == t_fixnum) { + save_avma; + y = make_bignum(stoi(fix(x))); + restore_avma; + } else if (type_of(x) == t_bignum) + y = copy_big(x); + else + FEerror("integer expected",0); + return(y); + } + + +/* return the power of x */ +GEN +powerii(x,y) + GEN x, y; +{ GEN ans = gun; + if (signe(y) < 0) FEerror("bad",0); + while (lgef(y) > 2){ + if (MP_LOW(y,lgef(y)) & 1) + { ans = mulii(ans,x);} + x = mulii(x,x); + y = shifti(y,-1);} + return ans; + } + + + +replace_copy1(x,y) + GEN y,x; +{ int j = lgef(x); + if (y && j <= lg(y)) + { x++; y++; + while (--j >0) + {*y++ = *x++;} + return 0;} + END: + return j*2*sizeof(GEN); +} + +/* doubles the length ! */ +GEN +replace_copy2(x,y) + GEN y,x; +{GEN yp = y; + int k,j = lgef(x); + k = j; + while (--j >=0) + {*yp++ = *x++;} + y[0] = INT_FLAG + k*2; + return y;} + +#define STOI(x,y) do{ \ + if (x ==0) { y[1]=2;} \ + else if((x)>0) {y[1]=0x1000003;y[2]=x;} \ + else{y[1]=0xff000003;y[2]= -x;}}while (0) + +/* actually y == 0 is not supposed to happen !*/ + +obj_replace_copy1(x,y) + object x; + GEN y; +{ int j ; + GEN xp; + { if (type_of(x) == t_bignum) + { j = lgef(MP(x)); + if (y && j <= lg(y)) + { xp=MP(x); + xp++; y++; + while (--j >0) + {*y++ = *xp++;} + return 0;}} + else + { if (y==0) return 3*2*sizeof(GEN) ; + STOI(fix(x),y); return 0;}} + END: + return j*2*sizeof(GEN); +} + +/* doubles the length ! */ +GEN +obj_replace_copy2(x,y) + object x; + GEN y; +{GEN yp = y; + GEN xp; + int k,j; + if (type_of(x) == t_bignum) + { j = lgef(MP(x)); + k = j; + xp = MP(x); + while (--j >=0) + {*yp++ = *xp++;} + y[0] = INT_FLAG + k*2;} + else {STOI(fix(x),yp); y[0] = INT_FLAG+3*2;} + return y;} + + +static GEN +otoi(x) + object x; +{if (type_of(x)==t_fixnum) return stoi(fix(x)); + if (type_of(x)==t_bignum) + return (MP(x)); + FEwrong_type_argument(sLinteger,x); + return 0; +} + +object +alloc_bignum_static(len) +int len; + { object ans = alloc_object(t_bignum); + GEN w; + ans->big.big_length = len; + ans->big.big_self = 0; + w = (GEN)AR_ALLOC(alloc_contblock,len,unsigned plong); + ans->big.big_self = w; + w[0] = INT_FLAG + len; + return ans; + } + + +GEN +setq_io(x,all,val) + GEN x; + object val; + object *all; +{int n= obj_replace_copy1(val,x); + if (n) + { *all = alloc_bignum_static(n/sizeof(int)); + return obj_replace_copy2(val,MP(*all)); + } + else return x;} + + +GEN +setq_ii(x,all,val) + GEN x; + GEN val; + object *all; +{int n= replace_copy1(val,x); + if (n) + { *all = alloc_bignum_static(n/sizeof(int)); + return replace_copy2(val,MP(*all)); + } + else return x;} + + + + +void +isetq_fix(var,s) + GEN var; + int s; +{/* if (var==0) FEerror("unitialized integer var",0); */ + STOI(s,var); +} + +GEN +icopy_bignum(a,y) + object a; + GEN y; +{ int *ucop = (int *)MP(a); + int *vcop = (int *) (y); + int j = lgef(ucop); + {while(--j >= 0) + { *vcop++ = *ucop++;} + setlg(y,a->big.big_length); + return y;}} + + +GEN +icopy_fixnum(a,y) + object a; + GEN y; + +{ int x= fix(a); + if(!x) return gzero; + y[0]=INT_FLAG+3; + if(x>0) {y[1]=0x1000003;y[2]=x;} + else{y[1]=0xff000003;y[2]= -x;} + return y; +} + + + + +GEN gnil,gzero,gun,gdeux,ghalf,gi; +plong lontyp[30]={0,0x10000,0x10000,1,1,1,1,2,1,0,2,2,1,1,1,0,1,1,1,1}; +unsigned plong hiremainder,overflow; + +#ifdef STANDALONE +#define FEerror printf +#define make_si_sfun(a,b,c) +#endif + +#define INITIAL_PARI_STACK 400 +char initial_pari_stack[400]; + +our_ulong bot= (our_ulong) initial_pari_stack; +our_ulong top = (our_ulong)(initial_pari_stack+INITIAL_PARI_STACK); +/* not initted */ +our_ulong avma= 0; + + +void +err(s) + int s; +{ switch (s) { + case errpile: + FEerror("Out of bignum stack space, (si::MULTIPLY-BIGNUM-STACK n) to grow",0); + case dvmer1: + case diver4: + case diver2: + case diver1: + FEerror("Divide by zero",0); + case muler1: + FEerror("Multiply overflow",0); + case moder1: + FEerror("Mod by 0",0); + default: + FEerror("Integer Arithmetic error",0); +}} + + + + +multiply_bignum_stack(n) + int n; +{ int parisize = n* (top - bot); + in_saved_avma = 0; + if (n> 1) + { if (bot != (our_ulong)initial_pari_stack) free(bot); + set_pari_stack(parisize); + } + return parisize; +} + +set_pari_stack(parisize) + int parisize; +{ + bot=(plong)malloc(parisize); + top = avma = bot + parisize; +} + +/* things to be done every start */ +gcl_init_big1() +{ + +} + +gcl_init_big() +{ + if (avma==0) + { + make_si_sfun("MULTIPLY-BIGNUM-STACK",multiply_bignum_stack, + ARGTYPE1(f_fixnum) | RESTYPE(f_fixnum)); + avma = top; + } + /* room for the permanent things */ + + gnil = cgeti(2);gnil[1]=2; setpere(gnil,255); + gzero = cgeti(2);gzero[1]=2; setpere(gzero, 255); + gun = stoi(1); setpere(gun, 255); + gdeux = stoi(2); setpere(gdeux, 255); + ghalf = cgetg(3,4);ghalf[1]=un;ghalf[2]=deux; setpere(ghalf, 255); + gi = cgetg(3,6); gi[1] = zero; gi[2] = un; setpere(gi, 255); + + /* set_pari_stack(BIGNUM_STACK_SIZE);*/ + } + + + + + + + + + + + + + + diff --git a/o/pari_num_log.c b/o/pari_num_log.c new file mode 100644 index 0000000..aad9408 --- /dev/null +++ b/o/pari_num_log.c @@ -0,0 +1,245 @@ +/* + big_log_op(x, y, op) performs the logical operation op onto + x and y, and return the result in x destructively. + + +*/ + +void minimize_lg(x) +GEN x; +{int j,i,lgx = lgef(x); + GEN u = x+2; + i = lgx; + i -= 2; + while (-- i >= 0) + { if (*u++) break; + } + j = lgx -i -3; + if (j) + { GEN v = x+2; + GEN w = v + j; + GEN lim = x+lgx; + while (w=0) + { unsigned int last = MP_NEXT_UP(w); + MP_NEXT_UP(v) = next - last ; + if (last > next) + { next -= 1 ;}} + return u;}} + +object big_log_op(x0,y0,op) +object x0,y0; + plong (*op)(); +{ int leadx,leady; + int result_length; + int lgx,lgy; + GEN x,y,u,up,result; + save_avma; + x = MP(x0); + y = (type_of(y0)==t_bignum ? MP(y0) : stoi(fix(y0))); + leadx = signe(x); + lgx=lgef(x); + if (leadx < 0) + x = complementi(x); + else leadx = 0; + + lgy = lgef(y); + leady = signe(y); + if (leady < 0) + y=complementi(y); + else leady = 0; + result_length = (lgx > lgy ? lgx : lgy); + u = result = cgeti(result_length); + setlgef(result,result_length); + MP_START_LOW(u,u,result_length); + result_length -= MP_CODE_WORDS; + + x += lgx; + y += lgy; + lgx -= MP_CODE_WORDS; + lgy -= MP_CODE_WORDS; + + while (--lgx >= 0) + { if (--lgy >= 0) + { MP_NEXT_UP(u) = (*op)(MP_NEXT_UP(x),MP_NEXT_UP(y));} + else MP_NEXT_UP(u) = (*op)(MP_NEXT_UP(x),leady); + } + /* lgx is now 0 */ + while (--lgy >= 0) + { MP_NEXT_UP(u) = (*op)(leadx,MP_NEXT_UP(y));} + {int leadresult = (*op)(leadx,leady); + if (leadresult < 0) + { result = complementi(result); + setsigne(result,-1);} + else setsigne(result,1);} + minimize_lg(result); + restore_avma; + gcopy_to_big(result,x0); + return x0; +} + +/* + x : fixnum or bignum (may be not normalized) + y : integer + returns + fixnum or bignum ( not normalized ) +*/ + +object big_log_op(); + +/* + x : fixnum or bignum (may be not normalized) + y : integer + returns + fixnum or bignum ( not normalized ) +*/ + + +static object +log_op(op,ignore) +int (*op)(); +void (*ignore)(); +{ + object x; + int narg, i, j; + + + narg = vs_top - vs_base; + if (narg < 2) too_few_arguments(); + i = narg; + while(--i >= 0) + if (type_of(vs_base[i]) == t_bignum) goto BIG_OP; + j = fix(vs_base[0]); + i = 1; + while (i < narg) { + j = (*op)(j, fix(vs_base[i])); + i++; + } + return(make_fixnum(j)); + +BIG_OP: + x = (object)copy_to_big(vs_base[0]); + vs_push(x); + i = 1; + {save_avma; + while (i < narg) { + x = (object)big_log_op(x, vs_base[i], op); + i++; + } + restore_avma;} + x = normalize_big_to_object(x); + vs_pop; + return(x); +} + + + +static int +big_bitp(x, p) +object x; +int p; +{ GEN u = MP(x); + int ans ; + int i = p /32; + if (signe(u) < 0) + { save_avma; + u = complementi(u); + restore_avma; + } + if (i < lgef(u) -MP_CODE_WORDS) + { ans = ((MP_ITH_WORD(u,i,lgef(u))) & (1 << p%32));} + else if (big_sign(x) < 0) ans = 1; + else ans = 0; + return ans; +} +/* these done without function call in above code ... */ +#define mp_b_clr_op (void *)0 +#define mp_b_set_op (void *)0 +#define mp_b_1_op (void *)0 +#define mp_b_2_op (void *)0 +#define mp_b_c1_op (void *)0 +#define mp_b_c2_op (void *)0 +#define mp_and_op (void *)0 +#define mp_ior_op (void *)0 +#define mp_xor_op (void *)0 +#define mp_eqv_op (void *)0 +#define mp_nand_op (void *)0 +#define mp_nor_op (void *)0 +#define mp_andc1_op (void *)0 +#define mp_andc2_op (void *)0 +#define mp_orc1_op (void *)0 +#define mp_orc2_op (void *)0 + +/* like integer-length in base 2 */ +gen_bitlength(u) + GEN u; +{ + GEN w; + int l = lg(u); + our_ulong high; + w = u; + MP_START_HIGH(u,u,l); + high = MP_NEXT_DOWN(u); + count = int_bit_length(high) ; + + l -= MP_CODE_WORDS; + + if (signe(w) < 0 && + high == (1 << (count -1))) + /* in the case of -(1<< n) + it is one less */ + { int ll = l; + int nzero = 0; + while (--ll > 0) + { if (MP_NEXT_DOWN(u)) + {nzero= 1; break;}} + if (nzero == 0) --count ;} + + count += 32* (l - 1); + return count; +} +/* number of 1's in 2's complement notation */ +gen_bitcount(u) + GEN u; + +{ save_avma; + if (signe(u) < 0) + { u = subsi(-1,u);} + count = 0; + {int leng = lgef(u); + MP_START_LOW(u,u,leng); + leng -= MP_CODE_WORDS; + while (--leng >= 0) + { count += count_int_bits(MP_NEXT_UP(u));}} + restore_avma; + return count; +} + + + + diff --git a/o/pathname.d b/o/pathname.d new file mode 100755 index 0000000..3c75882 --- /dev/null +++ b/o/pathname.d @@ -0,0 +1,125 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + pathname.d + IMPLEMENTATION-DEPENTENT + + This file contains those functions that interpret namestrings. +*/ + +#include +#include "include.h" + +DEFUN_NEW("C-SET-T-TT",object,fSc_set_t_tt,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum y),"") { + x->d.tt=y; + RETURN1(x); +} + + +DEFUN_NEW("C-T-TT",object,fSc_t_tt,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + RETURN1((object)(fixnum)x->d.tt); +} + + +DEFUN_NEW("C-SET-PATHNAME-NAMESTRING",object,fSc_set_pathname_namestring,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + check_type_pathname(&x); + x->pn.pn_namestring=y; + RETURN1(x); +} + +DEFUN_NEW("C-PATHNAME-HOST",object,fSc_pathname_host,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_pathname(&x); + RETURN1(x->pn.pn_host); +} +DEFUN_NEW("C-PATHNAME-DEVICE",object,fSc_pathname_device,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_pathname(&x); + RETURN1(x->pn.pn_device); +} +DEFUN_NEW("C-PATHNAME-DIRECTORY",object,fSc_pathname_directory,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_pathname(&x); + RETURN1(x->pn.pn_directory); +} +DEFUN_NEW("C-PATHNAME-NAME",object,fSc_pathname_name,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_pathname(&x); + RETURN1(x->pn.pn_name); +} +DEFUN_NEW("C-PATHNAME-TYPE",object,fSc_pathname_type,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_pathname(&x); + RETURN1(x->pn.pn_type); +} +DEFUN_NEW("C-PATHNAME-VERSION",object,fSc_pathname_version,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_pathname(&x); + RETURN1(x->pn.pn_version); +} +DEFUN_NEW("C-PATHNAME-NAMESTRING",object,fSc_pathname_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_pathname(&x); + RETURN1(x->pn.pn_namestring); +} + + +DEFUN_NEW("C-STREAM-OBJECT0",object,fSc_stream_object0,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(x->sm.sm_object0); +} + +DEFUN_NEW("C-STREAM-OBJECT1",object,fSc_stream_object1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(x->sm.sm_object1); +} + +DEFUN_NEW("C-SET-STREAM-OBJECT0",object,fSc_set_stream_object0,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + x->sm.sm_object0=y; + RETURN1(x); +} + +DEFUN_NEW("C-SET-STREAM-OBJECT1",object,fSc_set_stream_object1,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + x->sm.sm_object1=y; + RETURN1(x); +} + +DEFUN_NEW("INIT-PATHNAME",object,fSinit_pathname,SI,7,7,NONE,OO,OO,OO,OO, + (object host,object device,object directory,object name,object type,object version,object namestring),"") { + + object x=alloc_object(t_pathname); + + x->pn.pn_host=host; + x->pn.pn_device=device; + x->pn.pn_directory=directory; + x->pn.pn_name=name; + x->pn.pn_type=type; + x->pn.pn_version=version; + x->pn.pn_namestring=namestring; + + RETURN1(x); + +} + +DEFUN_NEW("PATHNAMEP",object,fLpathnamep,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(type_of(x)==t_pathname ? Ct : Cnil); +} + +void +gcl_init_pathname(void) { + +} + +void +gcl_init_pathname_function(void) { + +} diff --git a/o/peculiar.c b/o/peculiar.c new file mode 100755 index 0000000..d35ef4f --- /dev/null +++ b/o/peculiar.c @@ -0,0 +1,37 @@ +#ifndef PECULIAR_MACHINE + +#define BIGM (int)((((unsigned int)(-1))/2)) + +int ONEM = -1; +int Bigm = BIGM; +int Smallm = -BIGM-1; +int Seven = 7; +int Three = 3; + +main(void) +{ +#define BIGM (int)((((unsigned int)(-1))/2)) + { + int ONEM = -1; + int Bixsgm = BIGM; + int Smallm = -BIGM-1; + int Seven = 7; + int Three = 3; + if ( (Smallm / Seven) < 0 + && (Smallm / (-Seven)) > 0 + && (Bigm / (-Seven)) < 0 + && ((-Seven) / Three) == -2 + && (Seven / (-Three)) == -2 + && ((-Seven)/ (-Three)) == 2) + { printf("#define TRUNCATE_USE_C\n"); + + + } + printf("%d\n",(Smallm/-1)); + }} +#endif + + + + + diff --git a/o/plt.c b/o/plt.c new file mode 100644 index 0000000..1c55af2 --- /dev/null +++ b/o/plt.c @@ -0,0 +1,202 @@ +#include +#include +#include +#include +#include +#include +#include +#include + +#include "include.h" + +typedef struct { + const char *n; + unsigned long ad; +} Plt; + +#ifdef LEADING_UNDERSCORE +#define stn(a_) (*(a_)=='_' ? (a_)+1 : (a_)) +#else +#define stn(a_) a_ +#endif + +static int +pltcomp(const void *v1,const void *v2) { + const Plt *p1=v1,*p2=v2; + + return strcmp(p1->n,p2->n); + +} + +extern int mcount(); +extern int _mcount(); +extern int __divdi3(); +extern int __moddi3(); +extern int __udivdi3(); +extern int __umoddi3(); +extern void sincos(double,double *,double *); +extern int __divsi3(); +extern int __modsi3(); +extern int __udivsi3(); +extern int __umodsi3(); +extern int $$divI(); +extern int $$divU(); +extern int $$remI(); +extern int $$remU(); +extern int __divq(); +extern int __divqu(); +extern int __remq(); +extern int __remqu(); + +#define MY_PLT(a_) {#a_,(unsigned long)(void *)a_} +static Plt mplt[]={ + /* This is an attempt to at least capture the addresses to + which the compiler directly refers in C code. (Some symbols + are not explicitly mentioned in the C source but are + generated by gcc, usually in a platform specific way). At + the time of this writing, these symbols alone are + sufficient for compiling maxima,acl2,and axiom on x86. + This table is not (currently at least) consulted in + actuality -- the mere mention of the symbols here (at + present) ensures that the symbols are assigned values by + the linker, which are used preferentially to these values + in sfasli.c. FIXME -- this should be made synchronous with + compiler changes; sort the list automatically. SORT THIS + LIST BY HAND FOR THE TIME BEING. */ +#ifndef _WIN32 +# include "plt.h" +#endif +}; + +object sSAplt_tableA; +DEFVAR("*PLT-TABLE*",sSAplt_tableA,SI,Cnil,""); + +static int +arsort(const void *v1,const void *v2) { + const object *op1=v1,*op2=v2; + object o1=*op1,o2=*op2; + int j; + + o1=o1->c.c_car; + o2=o2->c.c_car; + if ((j=strncmp(o1->st.st_self, + o2->st.st_self, + o1->st.st_dimst.st_dim ? + o1->st.st_dim : o2->st.st_dim))) + return j; + j=o1->st.st_dim-o2->st.st_dim; + return j>0 ? 1 : (!j ? 0 : -1); + +} + +static int +arsearch(const void *v1,const void *v2) { + const char *s=v1; + const object *op=v2; + + int j; + if ((j=strncmp(s,(*op)->c.c_car->st.st_self,(*op)->c.c_car->st.st_dim))) + return j; + j=strlen(s)-(*op)->c.c_car->st.st_dim; + return j>0 ? 1 : (!j ? 0 : -1); + +} + +int +parse_plt() { + + FILE *f; + char b[1024],b1[1024]; + unsigned i,n,j; + unsigned long u; +#ifdef _WIN32 + char *exe_start = NULL; /* point to start of .exe */ +#endif + char *c,*d; + object st,fi,li,ar,*op; + Plt *p=mplt,*pe=p+sizeof(mplt)/sizeof(*mplt); + struct stat ss; + + if (snprintf(b,sizeof(b),"%s",kcl_self)<=0) + FEerror("Cannot write map filename",0); +#ifdef _WIN32 + exe_start = strstr ( b, ".exe" ); + if ( NULL != exe_start ) *exe_start = '\0'; +#endif + c=b+strlen(b); + if (sizeof(b)-(c-b)<5) + FEerror("Cannot write map filename",0); + strcpy(c,"_map"); + strcpy(b1,b); + if (stat(b1,&ss)) + return 0; + if (!(f=fopen(b1,"r"))) + FEerror("Cannot open map file", 0); + for (i=j=0,li=Cnil;fgets(b,sizeof(b),f);) { + if (!memchr(b,10,sizeof(b)-1)) + FEerror("plt buffer too small", 0); + if (!memcmp(b," .plt",4)) { + i=1; + continue; + } + if (*b!=' ' || b[1]!=' ' || !i) { + i=0; + continue; + } + if (sscanf(b,"%lx%n",&u,&n)!=1) + FEerror("Cannot read address", 0); + for (c=b+n;*c==32;c++); + for (d=c;*d!='@' && *d!='\r' && *d!='\n';d++); + *d=0; + st=make_simple_string(c); + fi=make_fixnum(u); + li=make_cons(make_cons(st,fi),li); + j++; + } + fclose(f); + unlink(b1); + ar=fSmake_vector1_1(j,aet_object,Cnil); + for (;j && !endp(li);li=li->c.c_cdr) + ar->v.v_self[--j]=li->c.c_car; + + if (j || !endp(li)) + FEerror("plt list mismatch", 0); + qsort(ar->v.v_self,ar->v.v_dim,sizeof(*ar->v.v_self),arsort); + + for (;pn,ar->v.v_self,ar->v.v_dim,sizeof(*ar->v.v_self),arsearch)) && + (*op)->c.c_cdr->FIX.FIXVAL != p->ad) + FEerror("plt/ld address mismatch",0); + + sSAplt_tableA->s.s_dbind=ar; + + return 0; + +} + + + +int +my_plt(const char *s,unsigned long *v) { + + Plt *p=mplt,*pe=p+sizeof(mplt)/sizeof(*mplt),tp; + object *op; + + if (sSAplt_tableA->s.s_dbind && + (op=bsearch(s,sSAplt_tableA->s.s_dbind->v.v_self, + sSAplt_tableA->s.s_dbind->v.v_dim, + sizeof(*sSAplt_tableA->s.s_dbind->v.v_self), + arsearch))) { + *v=(*op)->c.c_cdr->FIX.FIXVAL; + return 0; + } + + tp.n=stn(s); + if ((p=bsearch(&tp,p,pe-p,sizeof(*p),pltcomp))) { + *v=p->ad; + return 0; + } + + return -1; + +} diff --git a/o/plttest.c b/o/plttest.c new file mode 100644 index 0000000..1c47dbd --- /dev/null +++ b/o/plttest.c @@ -0,0 +1,86 @@ +#include +#include +#include +#include +#include + +/* We try here to compile in function addresses to which it is known + that the compiler will make *direct* reference. 20040308 CM */ + +#if defined (__APPLE__) && defined (__MACH__) +#define DARWIN +#endif + +#ifndef DARWIN +extern int _mcount(); +#define mmcount _mcount +extern void sincos(double,double *,double *); +#endif + +int +main(int argc,char * argv[],char *envp[]) { + + FILE *f=NULL; + char ch=0; + jmp_buf env; + double d=0.1; + long l; + unsigned long ul; + + sscanf(argv[1],"%lf",&d); + bzero(&env,sizeof(env)); + memset(&env,0,sizeof(env)); + + ul=*(unsigned long *)envp; + ul=ul%(ul>>(ul & 0x3)); + l=*(long *)argv; + l=l%(l<<(l & 0x7)); + l/=ul/l; + l/=((long)ul)/l; + + ch=getc(f); + ch&=putc(ch,f); + ch&=feof(f); + + f=fdopen(l,"r"); + l=read(l,&l,sizeof(l)); + l=write(l,&l,sizeof(l)); + +#ifndef DARWIN + ch&=mmcount(); +#endif + + setjmp(env); + + d=cos(d); + d=sin(d); +#ifndef DARWIN + sincos(d,&d,&d); +#endif + d=tan(d); + + d=acos(d); + d=asin(d); + d=atan(d); + + d=cosh(d); + d=sinh(d); + d=tanh(d); + +#ifndef _WIN32 + d=acosh(d); + d=asinh(d); + d=atanh(d); +#endif + + d=exp(d); + d=log(d); +#ifdef __i386__/*FIXME*/ + d=logl(d); +#endif + + d=sqrt(d); + + return ul & l & ((unsigned long)d) & ch; + +} diff --git a/o/pre_init.c b/o/pre_init.c new file mode 100755 index 0000000..1ff7189 --- /dev/null +++ b/o/pre_init.c @@ -0,0 +1,61 @@ +#include "all.h" +#include "funlink.h" +#define SI 0 +#define LISP 1 +#define KEYWORD 2 + +#define NONE 0 + +void SI_makefun(),LISP_makefun(),error(); + +#define MAKEFUN(pack,string,fname,argd) \ + (pack == SI ? SI_makefun : pack == LISP ? LISP_makefun : error)(string,fname,argd) + +#undef DEFUN +#define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56) \ + {extern ret fname(); \ + MAKEFUN(pack,string,fname,F_ARGD(min,max,flags,ARGTYPES(ret0a0,a12,a34,a56)));} + +#undef DEFUNO +#define DEFUNO(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,old) \ + {extern ret fname(); \ + MAKEFUN(pack,string,fname,F_ARGD(min,max,flags,ARGTYPES(ret0a0,a12,a34,a56)));} + +#undef DEFCOMP +#define DEFCOMP(type, fun) Ineed_in_image(fun); + + +#undef DEFVAR +#define DEFVAR(name,cname,pack,val) \ + { extern obj cname; \ + cname = (pack == LISP ? make_special(name,val) : \ + pack == SI ? make_si_special(name,val): \ + (error(name,val),(obj)0));} + +#undef DEFCONST +#define DEFCONST(name,cname,pack,val) \ + { extern obj cname; \ + cname = (pack == LISP ? make_constant(name,val) : \ + pack == SI ? make_si_constant(name,val): \ + (error(name,val),(obj)0));} + + +#undef DEF_ORDINARY +#define DEF_ORDINARY(name,cname,pack) \ + { extern obj cname ; cname = (pack == LISP ? make_ordinary(name) : \ + pack == SI ? make_si_ordinary(name): \ + (error(name),(obj)0));} + + +#undef DO_INIT +#define DO_INIT(x) x + + + + + + + + + + diff --git a/o/predicate.c b/o/predicate.c new file mode 100755 index 0000000..b527b7e --- /dev/null +++ b/o/predicate.c @@ -0,0 +1,830 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + predicate.c + + predicates +*/ + +#include +#include +#include "include.h" + +DEFUN_NEW("PATHNAME-DESIGNATORP",object,fSpathname_designatorp,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + RETURN1(pathname_designatorp(x) ? Ct : Cnil); +} + +DEFUNO_NEW("NULL",object,fLnull,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lnull,(object x0),"") +{ + /* 1 args */ + + if (x0 == Cnil) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUN_NEW("NOT",object,fLnot,LISP + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") + +{ + /* 1 args */ + + if (x0 == Cnil) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUNO_NEW("SYMBOLP",object,fLsymbolp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lsymbolp,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_symbol) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUNO_NEW("ATOM",object,fLatom ,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Latom,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) != t_cons) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUNO_NEW("CONSP",object,fLconsp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lconsp,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_cons) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUNO_NEW("LISTP",object,fLlistp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Llistp,(object x0),"") + +{ + /* 1 args */ + + if (x0 == Cnil || type_of(x0) == t_cons) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUNO_NEW("NUMBERP",object,fLnumberp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lnumberp,(object x0),"") + +{ + enum type t; + /* 1 args */ + + t = type_of(x0); + if (t == t_fixnum || t == t_bignum || t == t_ratio || + t == t_shortfloat || t == t_longfloat || + t == t_complex) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUNO_NEW("INTEGERP",object,fLintegerp ,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lintegerp,(object x0),"") + +{ + enum type t; + /* 1 args */ + + t = type_of(x0); + if (t == t_fixnum || t == t_bignum) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUN_NEW("RATIONALP",object,fLrationalp,LISP + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") + +{ + enum type t; + /* 1 args */ + + t = type_of(x0); + if (t == t_fixnum || t == t_bignum || t == t_ratio) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + + +DEFUN_NEW("REALP",object,fLrealp,LISP + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") +{ + enum type t; + t = type_of(x0); + + RETURN1((TS_MEMBER(t,TS(t_fixnum)| TS(t_bignum)| TS(t_ratio)| + TS(t_longfloat)| TS(t_shortfloat)) + ? Ct : Cnil)); + +} + + + + +DEFUNO_NEW("FLOATP",object,fLfloatp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lfloatp,(object x0),"") + +{ + enum type t; + /* 1 args */ + + t = type_of(x0); + if (t == t_longfloat || t == t_shortfloat) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("COMPLEXP",object,fLcomplexp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lcomplexp,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_complex) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("CHARACTERP",object,fLcharacterp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lcharacterp,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_character) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("STRINGP",object,fLstringp ,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lstringp,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_string) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("BIT-VECTOR-P",object,fLbit_vector_p,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lbit_vector_p,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_bitvector) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("VECTORP",object,fLvectorp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lvectorp,(object x0),"") + +{ + enum type t; + /* 1 args */ + + t = type_of(x0); + if (t == t_vector || t == t_string || t == t_bitvector) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("SIMPLE-STRING-P",object,fLsimple_string_p,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lsimple_string_p,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_string && +/* !x0->st.st_adjustable && */ + !x0->st.st_hasfillp && + x0->st.st_displaced->c.c_car == Cnil) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("SIMPLE-BIT-VECTOR-P",object,fLsimple_bit_vector_p ,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lsimple_bit_vector_p ,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_bitvector && + /* !x0->bv.bv_adjustable && */ + !x0->bv.bv_hasfillp && + x0->bv.bv_displaced->c.c_car == Cnil) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("SIMPLE-VECTOR-P",object,fLsimple_vector_p ,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lsimple_vector_p ,(object x0),"") + +{ + enum type t; + /* 1 args */ + + t = type_of(x0); + if (t == t_vector && +/* !x0->v.v_adjustable && */ + !x0->v.v_hasfillp && + x0->v.v_displaced->c.c_car == Cnil && + (enum aelttype)x0->v.v_elttype == aet_object) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("ARRAYP",object,fLarrayp ,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Larrayp,(object x0),"") + +{ + enum type t; + /* 1 args */ + + t = type_of(x0); + if (t == t_array || + t == t_vector || t == t_string || t == t_bitvector) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("PACKAGEP",object,fLpackagep ,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lpackagep ,(object x0),"") + +{ + /* 1 args */ + + if (type_of(x0) == t_package) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUNO_NEW("FUNCTIONP",object,fLfunctionp,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lfunctionp,(object x0),"") + +{ + enum type t; + object x; + + /* 1 args */ + t = type_of(x0); + if (t == t_cfun || t == t_cclosure || t == t_sfun || t == t_gfun + || t == t_closure|| t == t_afun + || t == t_vfun) + x0 = Ct; + else if (t == t_symbol) { + if (x0->s.s_gfdef != OBJNULL && + x0->s.s_mflag == FALSE) + x0 = Ct; + else + x0 = Cnil; } + else if (t == t_cons) { + x = x0->c.c_car; + if (x == sLlambda || x == sSlambda_block || + x == sSlambda_block_expanded || + x == sSlambda_closure || x == sSlambda_block_closure) + x0 = Ct; + else + x0 = Cnil; + } else + x0 = Cnil; +RETURN1(x0);} +#ifdef STATIC_FUNCTION_POINTERS +object +fLfunctionp(object x) { + return FFN(fLfunctionp)(x); +} +#endif + + +DEFUNO_NEW("COMMONP",object,fScommonp,SI,1,1,NONE,OO,OO,OO,OO,void,siLcommonp,(object x0),"") { + if (type_of(x0) != t_spice) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUNO_NEW("COMPILED-FUNCTION-P",object,fLcompiled_function_p,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lcompiled_function_p,(object x0),"") + +{ + /* 1 args */; + + if (type_of(x0) == t_cfun || + type_of(x0) == t_cclosure || + type_of(x0) == t_sfun || + type_of(x0) == t_gfun || + type_of(x0) == t_afun || + type_of(x0) == t_closure || + type_of(x0) == t_vfun + + + ) + x0 = Ct; + else + x0 = Cnil; +RETURN1(x0);} + +DEFUN_NEW("EQ",object,fLeq,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + RETURN1(x0==x1 ? Ct : Cnil); +} + +#define eqlm(x,y) \ +\ + case t_fixnum:\ + return (fix(x)==fix(y)) ? TRUE : FALSE;\ +\ + case t_bignum:\ + return big_compare(x,y) ? FALSE : TRUE;\ +\ + case t_ratio:\ + return (eql(x->rat.rat_num,y->rat.rat_num) &&\ + eql(x->rat.rat_den,y->rat.rat_den)) ? TRUE : FALSE;\ +\ + case t_shortfloat:\ + return sf(x)==sf(y) ? TRUE : FALSE;\ +\ + case t_longfloat:\ + return lf(x)==lf(y) ? TRUE : FALSE;\ +\ + case t_complex:\ + return (eql(x->cmp.cmp_real,y->cmp.cmp_real) &&\ + eql(x->cmp.cmp_imag,y->cmp.cmp_imag)) ? TRUE : FALSE;\ +\ + default:\ + return FALSE; + +bool +eql1(register object x,register object y) { + + /*x and y are not == and not Cnil and not immfix*/ + + /* if (valid_cdr(x)||valid_cdr(y)||x->d.t!=y->d.t) return FALSE; */ + + switch (x->d.t) { + + eqlm(x,y); + + } + +} + +/*for sublis1-inline*/ +bool +oeql(object x,object y) { + return eql(x,y) ? TRUE : FALSE; +} + +DEFUN_NEW("EQL",object,fLeql,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + RETURN1(eql(x0,x1) ? Ct : Cnil); +} + +bool +equal1(register object x, register object y) { + + /*x and y are not == and not Cnil and not immfix*/ + + /*gcc boolean expression tail position bug*/ + /* if (valid_cdr(x)) return valid_cdr(y)&&equal(x->c.c_car,y->c.c_car)&&equal(x->c.c_cdr,y->c.c_cdr); */ + if (valid_cdr(x)) return !valid_cdr(y)||!equal(x->c.c_car,y->c.c_car) ? FALSE : equal(x->c.c_cdr,y->c.c_cdr); + + if (valid_cdr(y)) return FALSE; + + if (x->d.t!=y->d.t) + return FALSE; + + switch(x->d.t) { + + case t_string: + return(string_eq(x, y)); + + case t_bitvector: + { + fixnum i, ox, oy; + + if (x->bv.bv_fillp != y->bv.bv_fillp) + return(FALSE); + ox = BV_OFFSET(x); + oy = BV_OFFSET(y); + for (i = 0; i < x->bv.bv_fillp; i++) + if(((x->bv.bv_self[(i+ox)/8] & (0200>>(i+ox)%8)) ? 1 : 0) + !=((y->bv.bv_self[(i+oy)/8] & (0200>>(i+oy)%8)) ? 1 : 0)) + return(FALSE); + return(TRUE); + } + + case t_pathname: + if (equal(x->pn.pn_host, y->pn.pn_host) && + equal(x->pn.pn_device, y->pn.pn_device) && + equal(x->pn.pn_directory, y->pn.pn_directory) && + equal(x->pn.pn_name, y->pn.pn_name) && + equal(x->pn.pn_type, y->pn.pn_type) && + equal(x->pn.pn_version, y->pn.pn_version)) + return(TRUE); + else + return(FALSE); + + eqlm(x,y); + + } + +} + +/*for sublis1-inline*/ +bool +oequal(object x,object y) { + return equal(x,y) ? TRUE : FALSE; +} + +DEFUN_NEW("EQUAL",object,fLequal,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + RETURN1(equal(x0, x1) ? Ct : Cnil); +} +#ifdef STATIC_FUNCTION_POINTERS +object +fLequal(object x,object y) { + return FFN(fLequal)(x,y); +} +#endif + +bool +equalp1(register object x, register object y) { + + enum type tx,ty; + fixnum j; + + /*x and y are not == and not Cnil*/ + + /*gcc boolean expression tail position bug*/ + /* if (listp(x)) return listp(y)&&equalp(x->c.c_car,y->c.c_car)&&equalp(x->c.c_cdr,y->c.c_cdr); */ + if (listp(x)) return !listp(y)||!equalp(x->c.c_car,y->c.c_car) ? FALSE : equalp(x->c.c_cdr,y->c.c_cdr); + + if (listp(y)) return FALSE; + + tx=is_imm_fixnum(x) ? t_fixnum : x->d.t; + ty=is_imm_fixnum(y) ? t_fixnum : y->d.t; + + switch(tx) { + + case t_fixnum: + case t_bignum: + case t_ratio: + case t_shortfloat: + case t_longfloat: + case t_complex: + if (ty==t_fixnum||ty==t_bignum||ty==t_ratio || + ty==t_shortfloat||ty==t_longfloat || + ty==t_complex) + return(!number_compare(x, y)); + else + return(FALSE); + + case t_vector: + case t_string: + case t_bitvector: + if (ty==t_vector||ty==t_string||ty==t_bitvector) { + j = x->v.v_fillp; + if (j != y->v.v_fillp) + return FALSE; + goto ARRAY; + } + else + return(FALSE); + + case t_array: + if (ty==t_array && x->a.a_rank==y->a.a_rank) { + if (x->a.a_rank > 1) { + fixnum i; + for (i=0; i< x->a.a_rank; i++) { + if (x->a.a_dims[i]!=y->a.a_dims[i]) + return(FALSE); + } + } + if (x->a.a_dim != y->a.a_dim) + return(FALSE); + j=x->a.a_dim; + goto ARRAY; + } + else + return(FALSE); + + default: + break; + + } + + if (tx != ty) + return(FALSE); + + switch (tx) { + + case t_character: + return(char_equal(x, y)); + + case t_structure: + { + fixnum i; + if (x->str.str_def != y->str.str_def) + return(FALSE); + { + fixnum leng= S_DATA(x->str.str_def)->length; + unsigned char *s_type= & SLOT_TYPE(x->str.str_def,0); + unsigned short *s_pos= & SLOT_POS(x->str.str_def,0); + for (i = 0; i < leng; i++,s_pos++) { + if (s_type[i]==aet_object) { + if (!equalp(STREF(object,x,*s_pos),STREF(object,y,*s_pos))) + return FALSE; + } + else + /* if (! (*s_pos & (sizeof(object)-1))) */ + switch(s_type[i]) { + case aet_lf: + if((! (*s_pos & (sizeof(longfloat)-1))) && + STREF(longfloat,x,*s_pos) != STREF(longfloat,y,*s_pos)) + return(FALSE); + break; + case aet_sf: + if((! (*s_pos & (sizeof(shortfloat)-1))) && + STREF(shortfloat,x,*s_pos)!=STREF(shortfloat,y,*s_pos)) + return(FALSE); + break; + default: + if((! (*s_pos & (sizeof(fixnum)-1))) && + STREF(fixnum,x,*s_pos)!=STREF(fixnum,y,*s_pos)) + return(FALSE); + break; + } + } + return(TRUE); + } + } + + case t_hashtable: + { + unsigned i; + struct htent *e; + + if (x->ht.ht_nent!=y->ht.ht_nent) + return(FALSE); + if (x->ht.ht_test!=y->ht.ht_test) + return(FALSE); + for (i=0;iht.ht_size;i++) { + if (x->ht.ht_self[i].hte_key==OBJNULL) + continue; + if ((e=gethash(x->ht.ht_self[i].hte_key,y))->hte_key==OBJNULL + ||!equalp(x->ht.ht_self[i].hte_value,e->hte_value)) + return(FALSE); + } + return(TRUE); + break; + } + + case t_pathname: + return(equal(x, y)); + + case t_random: + return(x->rnd.rnd_state._mp_seed->_mp_alloc==y->rnd.rnd_state._mp_seed->_mp_alloc && + !memcmp(x->rnd.rnd_state._mp_seed->_mp_d,y->rnd.rnd_state._mp_seed->_mp_d, + x->rnd.rnd_state._mp_seed->_mp_alloc*sizeof(*x->rnd.rnd_state._mp_seed->_mp_d))); + default: + return(FALSE); + + } + + + ARRAY: + + { + fixnum i; + + for (i = 0; i < j; i++) + if (!equalp(aref(x, i), aref(y, i))) + return(FALSE); + return(TRUE); + } + +} + +/*for sublis1-inline*/ +bool +oequalp(object x,object y) { + return equalp(x,y) ? TRUE : FALSE; +} + + +DEFUN_NEW("EQUALP",object,fLequalp,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + RETURN1(equalp(x0,x1) ? Ct : Cnil); +} + + +static void +FFN(Fand)(object args) +{ + + object *top = vs_top; + + if (endp(args)) { + vs_base = vs_top; + vs_push(Ct); + return; + } + while (!endp(MMcdr(args))) { + eval(MMcar(args)); + if (vs_base[0] == Cnil) { + vs_base = vs_top = top; + vs_push(Cnil); + return; + } + vs_top = top; + args = MMcdr(args); + } + eval(MMcar(args)); +} + +static void +FFN(For)(object args) +{ + + object *top = vs_top; + + if (endp(args)) { + vs_base = vs_top; + vs_push(Cnil); + return; + } + while (!endp(MMcdr(args))) { + eval(MMcar(args)); + if (vs_base[0] != Cnil) { + top[0] = vs_base[0]; + vs_base = top; + vs_top = top+1; + return; + } + vs_top = top; + args = MMcdr(args); + } + eval(MMcar(args)); +} + +/* + Contains_sharp_comma returns TRUE, iff the argument contains + a cons whose car is si:|#,| or a STRUCTURE. + Refer to the compiler about this magic. +*/ +bool +contains_sharp_comma(object x) +{ + enum type tx; + + cs_check(x); + +BEGIN: + tx = type_of(x); + if (tx == t_complex) + return(contains_sharp_comma(x->cmp.cmp_real) || + contains_sharp_comma(x->cmp.cmp_imag)); + if (tx == t_vector) { + int i; + if (x->v.v_elttype == aet_object) + for (i = 0; i < x->v.v_fillp; i++) + if (contains_sharp_comma(x->v.v_self[i])) + return(TRUE); + return(FALSE); + } + if (tx == t_cons) { + if (x->c.c_car == siSsharp_comma) + return(TRUE); + if (contains_sharp_comma(x->c.c_car)) + return(TRUE); + x = x->c.c_cdr; + goto BEGIN; + } + if (tx == t_array) + { + int i, j; + if (x->a.a_elttype == aet_object) { + for (i = 0, j = 1; i < x->a.a_rank; i++) + j *= x->a.a_dims[i]; + for (i = 0; i < j; i++) + if (contains_sharp_comma(x->a.a_self[i])) + return(TRUE); + } + return(FALSE); + } + if (tx == t_structure) + return(TRUE); /* Oh, my god! */ + return(FALSE); +} + +DEFUN_NEW("CONTAINS-SHARP-COMMA",object,fScontains_sharp_comma,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") + +{ + /* 1 args */ + + if (contains_sharp_comma(x0)) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUN_NEW("SPICEP",object,fSspicep ,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") + +{ + /* 1 args */ + if (type_of(x0) == t_spice) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +DEFUN_NEW("FIXNUMP",object,fSfixnump,SI + ,1,1,NONE,OO,OO,OO,OO,(object x0),"") + +{ + /* 1 args */ + if (type_of(x0) == t_fixnum) + x0 = Ct; + else + x0 = Cnil; + RETURN1(x0); +} + +void +gcl_init_predicate_function(void) +{ + + sLand=make_special_form("AND",Fand); + sLor=make_special_form("OR",For); + + + +} diff --git a/o/prelink.c b/o/prelink.c new file mode 100644 index 0000000..5456d6f --- /dev/null +++ b/o/prelink.c @@ -0,0 +1,43 @@ +#define NO_PRELINK_UNEXEC_DIVERSION + +#include "include.h" + +#if !defined(__MINGW32__) && !defined(__CYGWIN__) +extern FILE *stdin __attribute__((weak)); +extern FILE *stderr __attribute__((weak)); +extern FILE *stdout __attribute__((weak)); + +#ifdef USE_READLINE + +#if defined(RL_COMPLETION_ENTRY_FUNCTION_TYPE_FUNCTION) +extern Function *rl_completion_entry_function __attribute__((weak)); +#elif defined(RL_COMPLETION_ENTRY_FUNCTION_TYPE_RL_COMPENTRY_FUNC_T) +extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); +#else +#error Unknown rl_completion_entry_function return type +#endif + +#if defined(RL_READLINE_NAME_TYPE_CHAR) +extern char *rl_readline_name __attribute__((weak)); +#elif defined(RL_READLINE_NAME_TYPE_CONST_CHAR) +extern const char *rl_readline_name __attribute__((weak)); +#else +#error Unknown rl_readline_name return type +#endif + +#endif +#endif + +void +prelink_init(void) { + + my_stdin=stdin; + my_stdout=stdout; + my_stderr=stderr; +#ifdef USE_READLINE + my_rl_completion_entry_function_ptr=(void *)&rl_completion_entry_function; + my_rl_readline_name_ptr=(void *)&rl_readline_name; +#endif + +} + diff --git a/o/print.d b/o/print.d new file mode 100755 index 0000000..ac3fa1f --- /dev/null +++ b/o/print.d @@ -0,0 +1,2160 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + print.d +*/ + +#define NEED_ISFINITE + +#include "include.h" +#include +#include "num_include.h" + +#define LINE_LENGTH line_length +int line_length = 72; + +#ifndef WRITEC_NEWLINE +#define WRITEC_NEWLINE(strm) (writec_stream('\n',strm)) +#endif + +#define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) + +#define mod(x) ((x)%Q_SIZE) + + +#define queue printStructBufp->p_queue +#define indent_stack printStructBufp->p_indent_stack +#define qh printStructBufp->p_qh +#define qt printStructBufp->p_qt +#define qc printStructBufp->p_qc +#define isp printStructBufp->p_isp +#define iisp printStructBufp->p_iisp + + +object sSAprint_packageA; +object sSAprint_structureA; + + +/* bool RPINcircle; ??typo?? */ + + + +#define write_ch (*write_ch_fun) + + +#define MARK 0400 +#define UNMARK 0401 +#define SET_INDENT 0402 +#define INDENT 0403 +#define INDENT1 0404 +#define INDENT2 0405 + +extern object coerce_stream(object,int); + +static void +flush_queue(int); + +static void +writec_queue(c) +int c; +{ + if (qc >= Q_SIZE) + flush_queue(FALSE); + if (qc >= Q_SIZE) + FEerror("Can't pretty-print.", 0); + queue[qt] = c; + qt = mod(qt+1); + qc++; +} + +static void +flush_queue(int force) +{ + int c, i, j, k, l, i0; + +BEGIN: + while (qc > 0) { + c = queue[qh]; + if (c == MARK) + goto MDO_MARK; + else if (c == UNMARK) + isp -= 2; + else if (c == SET_INDENT) + indent_stack[isp] = file_column(PRINTstream); + else if (c == INDENT) { + goto MDO_INDENT; + } else if (c == INDENT1) { + i = file_column(PRINTstream)-indent_stack[isp]; + if (i < 8 && indent_stack[isp] < LINE_LENGTH/2) { + writec_stream(' ', PRINTstream); + indent_stack[isp] + = file_column(PRINTstream); + } else { + if (indent_stack[isp] < LINE_LENGTH/2) { + indent_stack[isp] + = indent_stack[isp-1] + 4; + } + goto MDO_INDENT; + } + } else if (c == INDENT2) { + indent_stack[isp] = indent_stack[isp-1] + 2; + goto PUT_INDENT; + } else if (c < 0400) + writec_stream(c, PRINTstream); + qh = mod(qh+1); + --qc; + } + return; + +MDO_MARK: + k = LINE_LENGTH - 1 - file_column(PRINTstream); + for (i = 1, j = 0, l = 1; l > 0 && i < qc && j < k; i++) { + c = queue[mod(qh + i)]; + if (c == MARK) + l++; + else if (c == UNMARK) + --l; + else if (c == INDENT || c == INDENT1 || c == INDENT2) + j++; + else if (c < 0400) + j++; + } + if (l == 0) + goto FLUSH; + if (i == qc && !force) + return; + qh = mod(qh+1); + --qc; + if (++isp >= IS_SIZE-1) + FEerror("Can't pretty-print.", 0); + indent_stack[isp++] = file_column(PRINTstream); + indent_stack[isp] = indent_stack[isp-1]; + goto BEGIN; + +MDO_INDENT: + if (iisp > isp) + goto PUT_INDENT; + k = LINE_LENGTH - 1 - file_column(PRINTstream); + for (i0 = 0, i = 1, j = 0, l = 1; i < qc && j < k; i++) { + c = queue[mod(qh + i)]; + if (c == MARK) + l++; + else if (c == UNMARK) { + if (--l == 0) + goto FLUSH; + } else if (c == SET_INDENT) { + if (l == 1) + break; + } else if (c == INDENT) { + if (l == 1) + i0 = i; + j++; + } else if (c == INDENT1) { + if (l == 1) + break; + j++; + } else if (c == INDENT2) { + if (l == 1) { + i0 = i; + break; + } + j++; + } else if (c < 0400) + j++; + } + if (i == qc && !force) + return; + if (i0 == 0) + goto PUT_INDENT; + i = i0; + goto FLUSH; + +PUT_INDENT: + qh = mod(qh+1); + --qc; + + WRITEC_NEWLINE(PRINTstream); + for (i = indent_stack[isp]; i > 0; --i) + writec_stream(' ', PRINTstream); + iisp = isp; + goto BEGIN; + +FLUSH: + for (j = 0; j < i; j++) { + c = queue[qh]; + if (c == INDENT || c == INDENT1 || c == INDENT2) + writec_stream(' ', PRINTstream); + else if (c < 0400) + writec_stream(c, PRINTstream); + qh = mod(qh+1); + --qc; + } + goto BEGIN; +} + +void +writec_PRINTstream(c) +int c; +{ + if (c == INDENT || c == INDENT1) + writec_stream(' ', PRINTstream); + else if (c < 0400) + writec_stream(c, PRINTstream); +} + +void +write_str(s) +char *s; +{ + while (*s != '\0') + write_ch(*s++); +} + +static void +write_decimal1(int); + +static void +write_decimal(i) +int i; +{ + if (i == 0) { + write_ch('0'); + return; + } + write_decimal1(i); +} + +static void +write_decimal1(i) +int i; +{ + if (i == 0) + return; + write_decimal1(i/10); + write_ch(i%10 + '0'); +} + +static void +write_addr(x) +object x; +{ + long i; + int j, k; + + i = (long)x; + for (j = 8*sizeof(i)-4; j >= 0; j -= 4) { + k = (i>>j) & 0xf; + if (k < 10) + write_ch('0' + k); + else + write_ch('a' + k - 10); + } +} + +static void +write_base(void) +{ + if (PRINTbase == 2) + write_str("#b"); + else if (PRINTbase == 8) + write_str("#o"); + else if (PRINTbase == 16) + write_str("#x"); + else if (PRINTbase >= 10) { + write_ch('#'); + write_ch(PRINTbase/10+'0'); + write_ch(PRINTbase%10+'0'); + write_ch('r'); + } else { + write_ch('#'); + write_ch(PRINTbase+'0'); + write_ch('r'); + } +} + +/* The floating point precision required to make the most-positive-long-float + printed expression readable. If this is too small, then the rounded + off fraction, may be too big to read */ + +#ifndef FPRC +#define FPRC 16 +#endif + +object sSAprint_nansA; + +#include + +static int +char_inc(char *b,char *p) { + + if (b==p) { + /* if (*p=='-') { */ + /* p++; */ + /* memmove(p+1,p,strlen(p)+1); */ + /* } */ + *p='1'; + } else if (*p=='9') { + *p='0'; + char_inc(b,p-1); + } else if (*p=='.') + char_inc(b,p-1); + else (*p)++; + + return 1; + +} + +#define COMP(a_,b_,c_,d_) ((d_) ? strtod((a_),(b_))==(c_) : strtof((a_),(b_))==(float)(c_)) + +static int +truncate_double(char *b,double d,int dp) { + + char c[FPRC+9],c1[FPRC+9],*p,*pp,*n; + int j,k; + + n=b; + k=strlen(n); + + strcpy(c1,b); + for (p=c1;*p && *p!='e';p++); + pp=p>c1 && p[-1]!='.' ? p-1 : p; + for (;pp>c1 && pp[-1]=='0';pp--); + memmove(pp,p,1+strlen(p)); + if (pp!=p && COMP(c1,&pp,d,dp)) + k=truncate_double(n=c1,d,dp); + + strcpy(c,n); + for (p=c;*p && *p!='e';p++); + if (p>c && p[-1]!='.' && char_inc(c,p-1) && COMP(c,&pp,d,dp)) { + j=truncate_double(c,d,dp); + if (j<=k) { + k=j; + n=c; + } + } + + if (n!=b) strcpy(b,n); + return k; + +} + +void +edit_double(int n,double d,int *sp,char *s,int *ep,int dp) { + + char *p, b[FPRC+9]; + int i; + + if (!ISFINITE(d)) { + if (sSAprint_nansA->s.s_dbind !=Cnil) { + sprintf(s, "%e",d); + *sp=2; + return; + } + else + FEerror("Can't print a non-number.",0);} + else + sprintf(b, "%*.*e",FPRC+8,FPRC,d); + if (b[FPRC+3] != 'e') { + sprintf(b, "%*.*e",FPRC+7,FPRC,d); + *ep=(b[FPRC+5]-'0')*10+(b[FPRC+6]-'0'); + } else + *ep=(b[FPRC+5]-'0')*100+(b[FPRC+6]-'0')*10+(b[FPRC+7]-'0'); + + *sp=1; + if (b[0]=='-') { + *sp*=-1; + b[0]=' '; + }if (b[FPRC+4]=='-') + *ep*=-1; + + truncate_double(b,d,dp); + if ((p=strchr(b,'e'))) + *p=0; + + if (n+2='5') + char_inc(b,b+n+1); + + if (isdigit((int)b[0])) { + b[1]=b[0]; + (*ep)++; + } + b[2]=b[1]; + + for (i=0,p=b+2;i'); + return; + } + if (sign < 0) + write_ch('-'); + if (-3 <= exp && exp < 7) { + if (exp < 0) { + write_ch('0'); + write_ch('.'); + exp = (-exp) - 1; + for (i = 0; i < exp; i++) + write_ch('0'); + for (; n > 0; --n) + if (buff[n-1] != '0' && buff[n-1]) + break; + if (exp == 0 && n == 0) + n = 1; + for (i = 0; i < n; i++) + write_ch(buff[i]); + } else { + exp++; + for (i = 0; i < exp; i++) + if (i < n) + write_ch(buff[i]); + else + write_ch('0'); + write_ch('.'); + if (i < n) + write_ch(buff[i]); + else + write_ch('0'); + i++; + for (; n > i; --n) + if (buff[n-1] != '0' && buff[n-1]) + break; + for (; i < n; i++) + write_ch(buff[i]); + } + exp = 0; + } else { + write_ch(buff[0]); + write_ch('.'); + write_ch(buff[1]); + for (; n > 2; --n) + if (buff[n-1] != '0' && buff[n-1]) + break; + for (i = 2; i < n; i++) + write_ch(buff[i]); + } + if (exp == 0 && e == 0) + return; + if (e == 0) + e = 'E'; + write_ch(e); + if (exp < 0) { + write_ch('-'); + exp *= -1; + } + write_decimal(exp); +} + +static void +call_structure_print_function(x, level) +object x; +int level; +{ + int i; + bool eflag; + bds_ptr old_bds_top; + + void (*wf)(int) = write_ch_fun; + + object *vt = PRINTvs_top; + bool e = PRINTescape; + bool ra = PRINTreadably; + bool r = PRINTradix; + int b = PRINTbase; + bool c = PRINTcircle; + bool p = PRINTpretty; + int lv = PRINTlevel; + int ln = PRINTlength; + bool g = PRINTgensym; + bool a = PRINTarray; + +/* + short oq[Q_SIZE]; +*/ + short ois[IS_SIZE]; + + VOL int oqh; + VOL int oqt; + VOL int oqc; + VOL int oisp; + VOL int oiisp; + +ONCE_MORE: + if (interrupt_flag) { + interrupt_flag = FALSE; +#ifdef UNIX + alarm(0); +#endif + terminal_interrupt(TRUE); + goto ONCE_MORE; + } + + if (PRINTpretty) + flush_queue(TRUE); + + oqh = qh; + oqt = qt; + oqc = qc; + oisp = isp; + oiisp = iisp; + +/* No need to save the queue, since it is flushed. + for (i = 0; i < Q_SIZE; i++) + oq[i] = queue[i]; +*/ + if (PRINTpretty) + for (i = 0; i <= isp; i++) + ois[i] = indent_stack[i]; + + vs_push(PRINTstream); + vs_push(PRINTcase); + + vs_push(make_fixnum(level)); + + old_bds_top = bds_top; + bds_bind(sLAprint_escapeA, PRINTescape?Ct:Cnil); + bds_bind(sLAprint_readablyA, PRINTreadably?Ct:Cnil); + bds_bind(sLAprint_radixA, PRINTradix?Ct:Cnil); + bds_bind(sLAprint_baseA, make_fixnum(PRINTbase)); + bds_bind(sLAprint_circleA, PRINTcircle?Ct:Cnil); + bds_bind(sLAprint_prettyA, PRINTpretty?Ct:Cnil); + bds_bind(sLAprint_levelA, PRINTlevel<0?Cnil:make_fixnum(PRINTlevel)); + bds_bind(sLAprint_lengthA, PRINTlength<0?Cnil:make_fixnum(PRINTlength)); + bds_bind(sLAprint_gensymA, PRINTgensym?Ct:Cnil); + bds_bind(sLAprint_arrayA, PRINTarray?Ct:Cnil); + bds_bind(sLAprint_caseA, PRINTcase); + + frs_push(FRS_PROTECT, Cnil); + if (nlj_active) { + eflag = TRUE; + goto L; + } + + ifuncall3(S_DATA(x->str.str_def)->print_function, + x, PRINTstream, vs_head); + vs_popp; + eflag = FALSE; + +L: + frs_pop(); + bds_unwind(old_bds_top); + +/* + for (i = 0; i < Q_SIZE; i++) + queue[i] = oq[i]; +*/ + if (PRINTpretty) + for (i = 0; i <= oisp; i++) + indent_stack[i] = ois[i]; + + iisp = oiisp; + isp = oisp; + qc = oqc; + qt = oqt; + qh = oqh; + + PRINTcase = vs_pop; + PRINTstream = vs_pop; + PRINTarray = a; + PRINTgensym = g; + PRINTlength = ln; + PRINTlevel = lv; + PRINTpretty = p; + PRINTcircle = c; + PRINTbase = b; + PRINTradix = r; + PRINTescape = e; + PRINTreadably = ra; + PRINTvs_top = vt; + + write_ch_fun = wf; + + if (eflag) { + nlj_active = FALSE; + unwind(nlj_fr, nlj_tag); + } +} +object copy_big(); +object coerce_big_to_string(object,int); + +static bool +potential_number_p(object,int); + +#define CASE_OF(x_) ({int _x=(x_);isUpper(_x) ? 1 : (isLower(_x) ? -1 : 0);}) + +static int +constant_case(object x) { + + fixnum i,j,jj; + + for (i=j=0;is.s_fillp;i++,j=j ? j : jj) + if (j*(jj=CASE_OF(x->s.s_self[i]))==-1) + return 0; + + return j; + +} + +static int +needs_escape (object x) { + + fixnum i,all_dots=1; + int ch; + + if (!PRINTescape) + return 0; + + for (i=0;is.s_fillp;i++) + switch((ch=x->s.s_self[i])) { + case ':': + return 1; + case '.': + break; + default: + all_dots=0; + if (Vreadtable->s.s_dbind->rt.rt_self[ch].rte_chattrib!=cat_constituent) + return 1; + if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || + (READ_TABLE_CASE==sKdowncase && isUpper(ch))) + return 1; + } + + if (potential_number_p(x, PRINTbase) || all_dots) + return 1; + + return !x->s.s_fillp; + +} + +#define convertible_upper(c) ((READ_TABLE_CASE==sKupcase ||READ_TABLE_CASE==sKinvert)&& isUpper(c)) +#define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) + +static void +print_symbol_name_body(object x) { + + int i,j,fc,tc,lw,k,cc; + + cc=constant_case(x); + k=needs_escape(x); + + if (k) + write_ch('|'); + + for (lw=i=0;is.s_fillp;i++) { + j = x->s.s_self[i]; + if (PRINTescape && + (Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_single_escape || + Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_multiple_escape)) + write_ch('\\'); + fc=convertible_upper(j) ? 1 : + (convertible_lower(j) ? -1 : 0); + tc=(READ_TABLE_CASE==sKinvert ? -cc : + (PRINTcase == sKupcase ? 1 : + (PRINTcase == sKdowncase ? -1 : + (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); + if (ispunct(j)||isspace(j)) lw=i+1; + j+=(tc && fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); + write_ch(j); + + } + + if (k) + write_ch('|'); + +} + +#define DONE 1 +#define FOUND -1 + +static int +do_write_sharp_eq(struct htent *e,bool dot) { + + fixnum val=fix(e->hte_value); + bool defined=val&1; + + if (dot) { + write_str(" . "); + if (!defined) return FOUND; + } + + if (!defined) e->hte_value=make_fixnum(val|1); + write_ch('#'); + write_decimal(val>>1); + write_ch(defined ? '#' : '='); + + return defined ? DONE : FOUND; + +} + +static int +write_sharp_eq(object x,bool dot) { + + struct htent *e; + + return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ? + do_write_sharp_eq(e,dot) : 0; + +} + + +void +write_object(x, level) +object x; +int level; +{ + object r, y; + int i, j, k; + + cs_check(x); + + if (x == OBJNULL) { + write_str("#"); + return; + } + if (is_free(x)) { + write_str("#"); + return; + } + + switch (type_of(x)) { + + case t_fixnum: + { + object *vsp; + /*FIXME 64*/ + fixnum i; + + if (PRINTradix && PRINTbase != 10) + write_base(); + i = fix(x); + if (i == 0) { + write_ch('0'); + if (PRINTradix && PRINTbase == 10) + write_ch('.'); + break; + } + if (i < 0) { + write_ch('-'); + if (i == MOST_NEGATIVE_FIX) { + x = fixnum_add(1,(MOST_POSITIVE_FIX)); + vs_push(x); + i = PRINTradix; + PRINTradix = FALSE; + write_object(x, level); + PRINTradix = i; + vs_popp; + if (PRINTradix && PRINTbase == 10) + write_ch('.'); + break; + } + i = -i; + } + vsp = vs_top; + for (vsp = vs_top; i != 0; i /= PRINTbase) + vs_push(code_char(digit_weight(i%PRINTbase, + PRINTbase))); + while (vs_top > vsp) + write_ch(char_code((vs_pop))); + if (PRINTradix && PRINTbase == 10) + write_ch('.'); + break; + } + + case t_bignum: + { + if (PRINTradix && PRINTbase != 10) + write_base(); + i = big_sign(x); + if (i == 0) { + write_ch('0'); + if (PRINTradix && PRINTbase == 10) + write_ch('.'); + break; + } + { object s = coerce_big_to_string(x,PRINTbase); + int i=0; + while (iust.ust_fillp) { write_ch(s->ust.ust_self[i++]); } + } + if (PRINTradix && PRINTbase == 10) + write_ch('.'); + break; + } + + case t_ratio: + if (PRINTradix) { + write_base(); + PRINTradix = FALSE; + write_object(x->rat.rat_num, level); + write_ch('/'); + write_object(x->rat.rat_den, level); + PRINTradix = TRUE; + } else { + write_object(x->rat.rat_num, level); + write_ch('/'); + write_object(x->rat.rat_den, level); + } + break; + + case t_shortfloat: + r = symbol_value(sLAread_default_float_formatA); + if (r == sLshort_float) + write_double((double)sf(x), 0, TRUE); + else + write_double((double)sf(x), 'S', TRUE); + break; + + case t_longfloat: + r = symbol_value(sLAread_default_float_formatA); + if (r == sLsingle_float || + r == sLlong_float || r == sLdouble_float) + write_double(lf(x), 0, FALSE); + else + write_double(lf(x), 'F', FALSE); + break; + + case t_complex: + write_str("#C("); + write_object(x->cmp.cmp_real, level); + write_ch(' '); + write_object(x->cmp.cmp_imag, level); + write_ch(')'); + break; + + case t_character: + if (!PRINTescape) { + write_ch(char_code(x)); + break; + } + write_str("#\\"); + switch (char_code(x)) { + case '\r': + write_str("Return"); + break; + + case ' ': + write_str("Space"); + break; + + case '\177': + write_str("Rubout"); + break; + + case '\f': + write_str("Page"); + break; + + case '\t': + write_str("Tab"); + break; + + case '\b': + write_str("Backspace"); + break; + + case '\n': + write_str("Newline"); + break; + + default: + if (char_code(x) & 0200) { + write_ch('\\'); + i = char_code(x); + write_ch(((i>>6)&7) + '0'); + write_ch(((i>>3)&7) + '0'); + write_ch(((i>>0)&7) + '0'); + } else if (char_code(x) < 040) { + write_ch('^'); + write_ch(char_code(x) + 0100); + } else + write_ch(char_code(x)); + break; + } + break; + + case t_symbol: + { + + if (PRINTescape) { + if (x->s.s_hpack == Cnil) { + if (PRINTcircle) + if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTgensym) + write_str("#:"); + } else if (x->s.s_hpack == keyword_package) { + write_ch(':'); + } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { + + print_symbol_name_body(x->s.s_hpack->p.p_name); + + if (find_symbol(x, x->s.s_hpack) != x) + error("can't print symbol"); + if (PRINTpackage || intern_flag == INTERNAL) + write_str("::"); + else if (intern_flag == EXTERNAL) + write_ch(':'); + else + FEerror("Pathological symbol --- cannot print.", 0); + + } + + } + print_symbol_name_body(x); + break; + } + case t_array: + { + int subscripts[ARANKLIM]; + int n, m; + + if (!PRINTarray) { + write_str("#"); + break; + } + if (PRINTcircle) + if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; + } + n = x->a.a_rank; + write_ch('#'); + write_decimal(n); + write_ch('A'); + if (PRINTlevel >= 0 && level+n >= PRINTlevel) + n = PRINTlevel - level; + for (i = 0; i < n; i++) + subscripts[i] = 0; + m = 0; + j = 0; + for (;;) { + for (i = j; i < n; i++) { + if (subscripts[i] == 0) { + write_ch(MARK); + write_ch('('); + write_ch(SET_INDENT); + if (x->a.a_dims[i] == 0) { + write_ch(')'); + write_ch(UNMARK); + j = i-1; + k = 0; + goto INC; + } + } + if (subscripts[i] > 0) + write_ch(INDENT); + if (PRINTlength >= 0 && + subscripts[i] >= PRINTlength) { + write_str("...)"); + write_ch(UNMARK); + k=x->a.a_dims[i]-subscripts[i]; + subscripts[i] = 0; + for (j = i+1; j < n; j++) + k *= x->a.a_dims[j]; + j = i-1; + goto INC; + } + } + if (n == x->a.a_rank) { + vs_push(aref(x, m)); + write_object(vs_head, level+n); + vs_popp; + } else + write_ch('#'); + j = n-1; + k = 1; + + INC: + while (j >= 0) { + if (++subscripts[j] < x->a.a_dims[j]) + break; + subscripts[j] = 0; + write_ch(')'); + write_ch(UNMARK); + --j; + } + if (j < 0) + break; + m += k; + } + break; + } + + case t_vector: + if (!PRINTarray) { + write_str("#"); + break; + } + if (PRINTcircle) + if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; + } + write_ch('#'); + write_ch(MARK); + write_ch('('); + write_ch(SET_INDENT); + if (x->v.v_fillp > 0) { + if (PRINTlength == 0) { + write_str("...)"); + write_ch(UNMARK); + break; + } + vs_push(aref(x, 0)); + write_object(vs_head, level+1); + vs_popp; + for (i = 1; i < x->v.v_fillp; i++) { + write_ch(INDENT); + if (PRINTlength>=0 && i>=PRINTlength){ + write_str("..."); + break; + } + vs_push(aref(x, i)); + write_object(vs_head, level+1); + vs_popp; + } + } + write_ch(')'); + write_ch(UNMARK); + break; + + case t_string: + if (!PRINTescape) { + for (i = 0; i < x->st.st_fillp; i++) + write_ch(x->st.st_self[i]); + break; + } + write_ch('"'); + for (i = 0; i < x->st.st_fillp; i++) { + if (x->st.st_self[i] == '"' || + x->st.st_self[i] == '\\') + write_ch('\\'); + write_ch(x->st.st_self[i]); + } + write_ch('"'); + break; + + case t_bitvector: + if (!PRINTarray) { + write_str("#"); + break; + } + write_str("#*"); + for (i = x->bv.bv_offset; i < x->bv.bv_fillp + x->bv.bv_offset; i++) + if (x->bv.bv_self[i/8] & (0200 >> i%8)) + write_ch('1'); + else + write_ch('0'); + break; + + case t_cons: + if (x->c.c_car == siSsharp_comma) { + write_str("#."); + write_object(x->c.c_cdr, level); + break; + } + if (PRINTcircle) + if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTpretty) { + if (x->c.c_car == sLquote && + type_of(x->c.c_cdr) == t_cons && + x->c.c_cdr->c.c_cdr == Cnil) { + write_ch('\''); + write_object(x->c.c_cdr->c.c_car, level); + break; + } + if (x->c.c_car == sLfunction && + type_of(x->c.c_cdr) == t_cons && + x->c.c_cdr->c.c_cdr == Cnil) { + write_ch('#'); + write_ch('\''); + write_object(x->c.c_cdr->c.c_car, level); + break; + } + } + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; + } + write_ch(MARK); + write_ch('('); + write_ch(SET_INDENT); + if (PRINTpretty && x->c.c_car != OBJNULL && + type_of(x->c.c_car) == t_symbol && + (r = getf(x->c.c_car->s.s_plist, + sSpretty_print_format, Cnil)) != Cnil) + goto PRETTY_PRINT_FORMAT; + for (i = 0; ; i++) { + if (PRINTlength >= 0 && i >= PRINTlength) { + write_str("..."); + break; + } + y = x->c.c_car; + x = x->c.c_cdr; + write_object(y, level+1); + if (type_of(x) != t_cons) { + if (x != Cnil) { + write_ch(INDENT); + write_str(". "); + write_object(x, level); + } + break; + } + if (PRINTcircle) + switch (write_sharp_eq(x,TRUE)) { + case FOUND: + write_object(x, level); + case DONE: + goto RIGHT_PAREN; + default: + break; + } + if (i == 0 && y != OBJNULL && type_of(y) == t_symbol) + write_ch(INDENT1); + else + write_ch(INDENT); + } + + RIGHT_PAREN: + write_ch(')'); + write_ch(UNMARK); + break; + + PRETTY_PRINT_FORMAT: + j = fixint(r); + for (i = 0; ; i++) { + if (PRINTlength >= 0 && i >= PRINTlength) { + write_str("..."); + break; + } + y = x->c.c_car; + x = x->c.c_cdr; + if (i <= j && y == Cnil) + write_str("()"); + else + write_object(y, level+1); + if (type_of(x) != t_cons) { + if (x != Cnil) { + write_ch(INDENT); + write_str(". "); + write_object(x, level); + } + break; + } + if (i >= j) + write_ch(INDENT2); + else if (i == 0) + write_ch(INDENT1); + else + write_ch(INDENT); + } + goto RIGHT_PAREN; + + case t_package: + write_str("#<"); + write_object(x->p.p_name, level); + write_str(" package>"); + break; + + case t_hashtable: + write_str("#"); + break; + + case t_stream: + switch (x->sm.sm_mode) { + case smm_input: + write_str("#sm.sm_object1, level); + write_ch('>'); + break; + + case smm_output: + write_str("#sm.sm_object1, level); + write_ch('>'); + break; + + case smm_io: + write_str("#sm.sm_object1, level); + write_ch('>'); + break; + + case smm_socket: + write_str("#sm.sm_object0, level); + write_ch('>'); + break; + + + case smm_probe: + write_str("#sm.sm_object1, level); + write_ch('>'); + break; + + case smm_synonym: + write_str("#sm.sm_object0, level); + write_ch('>'); + break; + + case smm_broadcast: + write_str("#"); + break; + + case smm_concatenated: + write_str("#"); + break; + + case smm_two_way: + write_str("#"); + break; + + case smm_echo: + write_str("#"); + break; + + case smm_string_input: + write_str("#sm.sm_object0; + j = y->st.st_fillp; + for (i = 0; i < j && i < 16; i++) + write_ch(y->st.st_self[i]); + if (j > 16) + write_str("..."); + write_str("\">"); + break; +#ifdef USER_DEFINED_STREAMS + case smm_user_defined: + write_str("#"); + break; +#endif + + case smm_string_output: + write_str("#"); + break; + + default: + error("illegal stream mode"); + } + break; + +#define FRESH_COPY(a_,b_) {(b_)->_mp_alloc=(a_)->_mp_alloc;\ + (b_)->_mp_d=gcl_gmp_alloc((b_)->_mp_alloc*sizeof(*(b_)->_mp_d));\ + (b_)->_mp_size=(a_)->_mp_size;\ + memcpy((b_)->_mp_d,(a_)->_mp_d,(b_)->_mp_alloc*sizeof(*(b_)->_mp_d));} + + case t_random: + write_str("#$"); + y = new_bignum(); + FRESH_COPY(x->rnd.rnd_state._mp_seed,MP(y)); + y=normalize_big(y); + vs_push(y); + write_object(y, level); + vs_popp; + break; + + case t_structure: + if (PRINTcircle) + if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; + } + if (type_of(x->str.str_def) != t_structure) + FEwrong_type_argument(sLstructure, x->str.str_def); + if (PRINTstructure || + S_DATA(x->str.str_def)->print_function == Cnil) + { + write_str("#S"); + x = structure_to_list(x); + vs_push(x); + write_object(x, level); + vs_popp; + break; + } + call_structure_print_function(x, level); + break; + + case t_readtable: + write_str("#"); + break; + + case t_pathname: + if (1 || PRINTescape) { + write_ch('#'); + write_ch('p'); + vs_push(x->pn.pn_namestring==Cnil ? make_simple_string("") : x->pn.pn_namestring); + write_object(vs_head, level); + vs_popp; + } else { + write_str("#"); + } + break; + case t_sfun: + case t_gfun: + case t_vfun: + case t_afun: + case t_cfun: + write_str("#cf.cf_name != Cnil) + write_object(x->cf.cf_name, level); + else + write_addr(x); + write_str(">"); + break; + + case t_closure: + case t_cclosure: + write_str("#cc.cc_name != Cnil) + write_object(x->cc.cc_name, level); + else + write_addr(x); + write_str(">"); + break; + + case t_spice: + write_str("#<\100"); + for (i = 8*sizeof(long)-4; i >= 0; i -= 4) { + j = ((long)x >> i) & 0xf; + if (j < 10) + write_ch('0' + j); + else + write_ch('A' + (j - 10)); + } + write_ch('>'); + break; + + default: + error("illegal type --- cannot print"); + } +} + +static int dgs,dga; + +#include "page.h" + +static void +travel_push(object x) { + + int i; + + if (is_imm_fixnum(x)) + return; + + if (is_marked(x)) { + + if (imcdr(x) || !x->d.f) + vs_check_push(x); + if (!imcdr(x)) + x->d.f=1; + + } else switch (type_of(x)) { + + case t_symbol: + + if (dgs && x->s.s_hpack==Cnil) { + mark(x); + } + break; + + case t_cons: + + { + object y=x->c.c_cdr; + mark(x); + travel_push(x->c.c_car); + travel_push(y); + } + break; + + case t_vector: + case t_array: + + mark(x); + if (dga && (enum aelttype)x->a.a_elttype==aet_object) + for (i=0;ia.a_dim;i++) + travel_push(x->a.a_self[i]); + break; + + case t_structure: + + mark(x); + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) + travel_push(structure_ref(x,x->str.str_def,i)); + break; + + default: + + break; + + } + +} + + +static void +travel_clear(object x) { + + int i; + + if (is_imm_fixnum(x)) + return; + + if (!is_marked(x)) + return; + + unmark(x); + if (!imcdr(x)) + x->d.f=0; + + switch (type_of(x)) { + + case t_cons: + + travel_clear(x->c.c_car); + travel_clear(x->c.c_cdr); + break; + + case t_vector: + case t_array: + + if (dga && (enum aelttype)x->a.a_elttype == aet_object) + for (i=0;ia.a_dim;i++) + travel_clear(x->a.a_self[i]); + break; + + case t_structure: + + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) + travel_clear(structure_ref(x,x->str.str_def,i)); + break; + + default: + + break; + + } + +} + +static void +travel(object x,int mdgs,int mdga) { + + BEGIN_NO_INTERRUPT; + dgs=mdgs; + dga=mdga; + travel_push(x); + travel_clear(x); + END_NO_INTERRUPT; + +} + +object sLeq; + +static void +setupPRINTcircle(object x,int dogensyms) { + + object *vp=vs_top,*v=vp,h; + fixnum j; + + travel(x,dogensyms,PRINTarray); + + h=vs_top>vp ? gcl_make_hash_table(sLeq) : Cnil; + for (j=0;vhte_key==OBJNULL) + sethash(*v,h,make_fixnum((j++)<<1)); + + vs_top=vp; + vs_push(h); + +} + +void +travel_find_sharing(object x,object table) { + + object *vp=vs_top; + + travel(x,1,1); + + for (;vs_top>vp;vs_top--) + sethash(vs_head,table,make_fixnum(-2)); + +} + +void +setupPRINTdefault(x) +object x; +{ + object y; + + PRINTvs_top = vs_top; + PRINTstream = symbol_value(sLAstandard_outputA); + if (type_of(PRINTstream) != t_stream) { + sLAstandard_outputA->s.s_dbind + = symbol_value(sLAterminal_ioA); + vs_push(PRINTstream); + FEwrong_type_argument(sLstream, PRINTstream); + } + PRINTreadably = symbol_value(sLAprint_readablyA) != Cnil; + PRINTescape = PRINTreadably || symbol_value(sLAprint_escapeA) != Cnil; + PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil; + PRINTcircle = symbol_value(sLAprint_circleA) != Cnil; + y = symbol_value(sLAprint_baseA); + if (type_of(y) != t_fixnum || fix(y) < 2 || fix(y) > 36) { + sLAprint_baseA->s.s_dbind = make_fixnum(10); + vs_push(y); + FEerror("~S is an illegal PRINT-BASE.", 1, y); + } else + PRINTbase = fix(y); + PRINTradix = symbol_value(sLAprint_radixA) != Cnil; + PRINTcase = symbol_value(sLAprint_caseA); + if (PRINTcase != sKupcase && PRINTcase != sKdowncase && + PRINTcase != sKcapitalize) { + sLAprint_caseA->s.s_dbind = sKdowncase; + vs_push(PRINTcase); + FEerror("~S is an illegal PRINT-CASE.", 1, PRINTcase); + } + PRINTgensym = symbol_value(sLAprint_gensymA) != Cnil; + y = symbol_value(sLAprint_levelA); + if (y == Cnil) + PRINTlevel = -1; + else if (type_of(y) != t_fixnum || fix(y) < 0) { + sLAprint_levelA->s.s_dbind = Cnil; + vs_push(y); + FEerror("~S is an illegal PRINT-LEVEL.", 1, y); + } else + PRINTlevel = fix(y); + y = symbol_value(sLAprint_lengthA); + if (y == Cnil) + PRINTlength = -1; + else if (type_of(y) != t_fixnum || fix(y) < 0) { + sLAprint_lengthA->s.s_dbind = Cnil; + vs_push(y); + FEerror("~S is an illegal PRINT-LENGTH.", 1, y); + } else + PRINTlength = fix(y); + PRINTarray = symbol_value(sLAprint_arrayA) != Cnil; + if (PRINTcircle) setupPRINTcircle(x,1); + if (PRINTpretty) { + qh = qt = qc = 0; + isp = iisp = 0; + indent_stack[0] = 0; + write_ch_fun = writec_queue; + } else + write_ch_fun = writec_PRINTstream; + PRINTpackage = symbol_value(sSAprint_packageA) != Cnil; + PRINTstructure = symbol_value(sSAprint_structureA) != Cnil; +} + +void +cleanupPRINT(void) +{ + vs_top = PRINTvs_top; + if (PRINTpretty) + flush_queue(TRUE); +} + +/*static void +write_object_by_default(x) +object x; +{ + SETUP_PRINT_DEFAULT(x); + write_object(x, 0); + flush_stream(PRINTstream); + CLEANUP_PRINT_DEFAULT; +}*/ + +/*static void +terpri_by_default() +{ + PRINTstream = symbol_value(sLAstandard_outputA); + if (type_of(PRINTstream) != t_stream) + FEwrong_type_argument(sLstream, PRINTstream); + WRITEC_NEWLINE(PRINTstream); +}*/ + +static bool +potential_number_p(strng, base) +object strng; +int base; +{ + int i, l, c, dc; + char *s; + + l = strng->st.st_fillp; + if (l == 0) + return(FALSE); + s = strng->st.st_self; + dc = 0; + c = s[0]; + if (digitp(c, base) >= 0) + dc++; + else if (c != '+' && c != '-' && c != '^' && c != '_') + return(FALSE); + if (s[l-1] == '+' || s[l-1] == '-') + return(FALSE); + for (i = 1; i < l; i++) { + c = s[i]; + if (digitp(c, base) >= 0) { + dc++; + continue; + } + if (c != '+' && c != '-' && c != '/' && c != '.' && + c != '^' && c != '_' && + c != 'e' && c != 'E' && + c != 's' && c != 'S' && c != 'l' && c != 'L') + return(FALSE); + } + if (dc == 0) + return(FALSE); + return(TRUE); +} + @(defun write (x + &key ((:stream strm) Cnil) + (escape `symbol_value(sLAprint_escapeA)`) + (readably `symbol_value(sLAprint_readablyA)`) + (radix `symbol_value(sLAprint_radixA)`) + (base `symbol_value(sLAprint_baseA)`) + (circle `symbol_value(sLAprint_circleA)`) + (pretty `symbol_value(sLAprint_prettyA)`) + (level `symbol_value(sLAprint_levelA)`) + (length `symbol_value(sLAprint_lengthA)`) + ((:case cas) `symbol_value(sLAprint_caseA)`) + (gensym `symbol_value(sLAprint_gensymA)`) + (array `symbol_value(sLAprint_arrayA)`)) + struct printStruct printStructBuf; + struct printStruct *old_printStructBufp = printStructBufp; +@ + + printStructBufp = &printStructBuf; + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + if (type_of(strm) != t_stream) + FEerror("~S is not a stream.", 1, strm); + PRINTvs_top = vs_top; + PRINTstream = strm; + PRINTreadably = readably != Cnil; + PRINTescape = PRINTreadably || escape != Cnil; + PRINTpretty = pretty != Cnil; + PRINTcircle = circle != Cnil; + if (type_of(base)!=t_fixnum || fix((base))<2 || fix((base))>36) + FEerror("~S is an illegal PRINT-BASE.", 1, base); + else + PRINTbase = fix((base)); + PRINTradix = radix != Cnil; + PRINTcase = cas; + if (PRINTcase != sKupcase && PRINTcase != sKdowncase && + PRINTcase != sKcapitalize) + FEerror("~S is an illegal PRINT-CASE.", 1, cas); + PRINTgensym = PRINTreadably || gensym != Cnil; + if (PRINTreadably || level == Cnil) + PRINTlevel = -1; + else if (type_of(level) != t_fixnum || fix((level)) < 0) + FEerror("~S is an illegal PRINT-LEVEL.", 1, level); + else + PRINTlevel = fix((level)); + if (PRINTreadably || length == Cnil) + PRINTlength = -1; + else if (type_of(length) != t_fixnum || fix((length)) < 0) + FEerror("~S is an illegal PRINT-LENGTH.", 1, length); + else + PRINTlength = fix((length)); + PRINTarray = PRINTreadably || array != Cnil; + if (PRINTcircle) setupPRINTcircle(x,1); + if (PRINTpretty) { + qh = qt = qc = 0; + isp = iisp = 0; + indent_stack[0] = 0; + write_ch_fun = writec_queue; + } else + write_ch_fun = writec_PRINTstream; + PRINTpackage = symbol_value(sSAprint_packageA) != Cnil; + PRINTstructure = symbol_value(sSAprint_structureA) != Cnil; + write_object(x, 0); + CLEANUP_PRINT_DEFAULT; + flush_stream(PRINTstream); + @(return x) +@) + +@(defun prin1 (obj &optional strm) +@ + prin1(obj, strm); + @(return obj) +@) + +@(defun print (obj &optional strm) +@ + print(obj, strm); + @(return obj) +@) + +@(defun pprint (obj &optional strm) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + WRITEC_NEWLINE(strm); + {SETUP_PRINT_DEFAULT(obj); + PRINTstream = strm; + PRINTreadably = FALSE; + PRINTescape = TRUE; + PRINTpretty = TRUE; + qh = qt = qc = 0; + isp = iisp = 0; + indent_stack[0] = 0; + write_ch_fun = writec_queue; + write_object(obj, 0); + CLEANUP_PRINT_DEFAULT; + flush_stream(strm);} + @(return) +@) + +@(defun princ (obj &optional strm) +@ + princ(obj, strm); + @(return obj) +@) + +@(defun write_char (c &optional strm) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_character(&c); + check_type_stream(&strm); + writec_stream(char_code(c), strm); +/* + flush_stream(strm); +*/ + @(return c) +@) + +@(defun write_string (strng &o strm &k start end) + int s, e, i; +@ + get_string_start_end(strng, start, end, &s, &e); + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_string(&strng); + check_type_stream(&strm); + for (i = s; i < e; i++) + writec_stream(strng->st.st_self[i], strm); + flush_stream(strm); + @(return strng) +@) + +@(defun write_line (strng &o strm &k start end) + int s, e, i; +@ + get_string_start_end(strng, start, end, &s, &e); + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_string(&strng); + check_type_stream(&strm); + for (i = s; i < e; i++) + writec_stream(strng->st.st_self[i], strm); + WRITEC_NEWLINE(strm); + flush_stream(strm); + @(return strng) +@) + +@(defun terpri (&optional strm) +@ + terpri(strm); + @(return Cnil) +@) + +@(defun fresh_line (&optional strm) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + /* we need to get the real output stream, if possible */ + {object tmp=coerce_stream(strm,1); + if(tmp != Cnil) strm = tmp ; + else + check_type_stream(&strm); + } + if (file_column(strm) == 0) + @(return Cnil) + WRITEC_NEWLINE(strm); + flush_stream(strm); + @(return Ct) +@) + +@(defun finish_output (&o strm) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + flush_stream(strm); + @(return Cnil) +@) + +@(defun force_output (&o strm) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + flush_stream(strm); + @(return Cnil) +@) + +@(defun clear_output (&o strm) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + @(return Cnil) +@) + +@(defun write_byte (integer binary_output_stream) +@ + if (type_of(integer) != t_fixnum) + FEerror("~S is not a byte.", 1, integer); + check_type_stream(&binary_output_stream); + writec_stream(fix(integer), binary_output_stream); + @(return integer) +@) + +DEF_ORDINARY("UPCASE",sKupcase,KEYWORD,""); +DEF_ORDINARY("DOWNCASE",sKdowncase,KEYWORD,""); +DEF_ORDINARY("CAPITALIZE",sKcapitalize,KEYWORD,""); +DEF_ORDINARY("STREAM",sKstream,KEYWORD,""); +DEF_ORDINARY("ESCAPE",sKescape,KEYWORD,""); +DEF_ORDINARY("READABLY",sKreadably,KEYWORD,""); +DEF_ORDINARY("PRETTY",sKpretty,KEYWORD,""); +DEF_ORDINARY("CIRCLE",sKcircle,KEYWORD,""); +DEF_ORDINARY("BASE",sKbase,KEYWORD,""); +DEF_ORDINARY("RADIX",sKradix,KEYWORD,""); +DEF_ORDINARY("CASE",sKcase,KEYWORD,""); +DEF_ORDINARY("GENSYM",sKgensym,KEYWORD,""); +DEF_ORDINARY("LEVEL",sKlevel,KEYWORD,""); +DEF_ORDINARY("LENGTH",sKlength,KEYWORD,""); +DEF_ORDINARY("ARRAY",sKarray,KEYWORD,""); +DEFVAR("*PRINT-ESCAPE*",sLAprint_escapeA,LISP,Ct,""); +DEFVAR("*PRINT-READABLY*",sLAprint_readablyA,LISP,Ct,""); +DEFVAR("*PRINT-PRETTY*",sLAprint_prettyA,LISP,Ct,""); +DEFVAR("*PRINT-CIRCLE*",sLAprint_circleA,LISP,Cnil,""); +DEFVAR("*PRINT-BASE*",sLAprint_baseA,LISP,make_fixnum(10),""); +DEFVAR("*PRINT-RADIX*",sLAprint_radixA,LISP,Cnil,""); +DEFVAR("*PRINT-CASE*",sLAprint_caseA,LISP,sKupcase,""); +DEFVAR("*PRINT-GENSYM*",sLAprint_gensymA,LISP,Ct,""); +DEFVAR("*PRINT-LEVEL*",sLAprint_levelA,LISP,Cnil,""); +DEFVAR("*PRINT-LENGTH*",sLAprint_lengthA,LISP,Cnil,""); +DEFVAR("*PRINT-ARRAY*",sLAprint_arrayA,LISP,Ct,""); +DEFVAR("*PRINT-PACKAGE*",sSAprint_packageA,SI,Cnil,""); +DEFVAR("*PRINT-STRUCTURE*",sSAprint_structureA,SI,Cnil,""); +DEF_ORDINARY("PRETTY-PRINT-FORMAT",sSpretty_print_format,SI,""); + +void +gcl_init_print() +{ + + /* travel_push_type[(int)t_array]=1; */ + /* travel_push_type[(int)t_vector]=1; */ + /* travel_push_type[(int)t_structure]=1; */ + /* travel_push_type[(int) t_cons]=1; */ + /* if(sizeof(travel_push_type) < t_other) */ + /* error("travel_push_size to small see print.d"); */ + + PRINTstream = Cnil; + enter_mark_origin(&PRINTstream); + PRINTreadably = FALSE; + PRINTescape = TRUE; + PRINTpretty = FALSE; + PRINTcircle = FALSE; + PRINTbase = 10; + PRINTradix = FALSE; + PRINTcase = sKupcase; + enter_mark_origin(&PRINTcase); + PRINTgensym = TRUE; + PRINTlevel = -1; + PRINTlength = -1; + PRINTarray = FALSE; + + write_ch_fun = writec_PRINTstream; +} + +object +princ(obj, strm) +object obj, strm; +{ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + if (type_of(strm) != t_stream) + FEerror("~S is not a stream.", 1, strm); + if (obj == OBJNULL) + goto SIMPLE_CASE; + switch (type_of(obj)) { + case t_symbol: + PRINTcase = symbol_value(sLAprint_caseA); + PRINTpackage = symbol_value(sSAprint_packageA) != Cnil; + + SIMPLE_CASE: + case t_string: + case t_character: + PRINTstream = strm; + PRINTreadably = FALSE; + PRINTescape = FALSE; + write_ch_fun = writec_PRINTstream; + write_object(obj, 0); + break; + + default: + {SETUP_PRINT_DEFAULT(obj); + PRINTstream = strm; + PRINTreadably = FALSE; + PRINTescape = FALSE; + write_object(obj, 0); + CLEANUP_PRINT_DEFAULT;} + break; + } + return(obj); +} + +object +prin1(obj, strm) +object obj, strm; +{ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + if (type_of(strm) != t_stream) + FEerror("~S is not a stream.", 1, strm); + if (obj == OBJNULL) + goto SIMPLE_CASE; + switch (type_of(obj)) { + SIMPLE_CASE: + case t_string: + case t_character: + PRINTstream = strm; + PRINTreadably = FALSE; + PRINTescape = TRUE; + write_ch_fun = writec_PRINTstream; + write_object(obj, 0); + break; + + default: + {SETUP_PRINT_DEFAULT(obj); + PRINTstream = strm; + PRINTreadably = FALSE; + PRINTescape = TRUE; + write_object(obj, 0); + CLEANUP_PRINT_DEFAULT;} + break; + } + flush_stream(strm); + return(obj); +} + +object +print(obj, strm) +object obj, strm; +{ + terpri(strm); + prin1(obj,strm); + princ(code_char(' '),strm); + return(obj); +} + +object +terpri(strm) +object strm; +{ + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + if (type_of(strm) != t_stream) + FEerror("~S is not a stream.", 1, strm); + WRITEC_NEWLINE(strm); + flush_stream(strm); + return(Cnil); +} + +void +write_string(strng, strm) +object strng, strm; +{ + int i; + + if (strm == Cnil) + strm = symbol_value(sLAstandard_outputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_string(&strng); + check_type_stream(&strm); + for (i = 0; i < strng->st.st_fillp; i++) + writec_stream(strng->st.st_self[i], strm); + flush_stream(strm); +} + +/* + THE ULTRA-SPECIAL-DINNER-SERVICE OPTIMIZATION +*/ +void +princ_str(s, sym) +char *s; +object sym; +{ + sym = symbol_value(sym); + if (sym == Cnil) + sym = symbol_value(sLAstandard_outputA); + else if (sym == Ct) + sym = symbol_value(sLAterminal_ioA); + check_type_stream(&sym); + writestr_stream(s, sym); +} + +void +princ_char(c, sym) +int c; +object sym; +{ + sym = symbol_value(sym); + if (sym == Cnil) + sym = symbol_value(sLAstandard_outputA); + else if (sym == Ct) + sym = symbol_value(sLAterminal_ioA); + check_type_stream(&sym); + if (c == '\n') + {WRITEC_NEWLINE(sym); + flush_stream(sym);} + else + writec_stream(c, sym); + +} + + +void +pp(x) +object x; +{ +princ(x,Cnil); +flush_stream(symbol_value(sLAstandard_outputA)); +} + +static object +FFN(set_line_length)(n) +int n; +{ + line_length=n; + return make_fixnum(line_length); +} + +DEFVAR("*PRINT-NANS*",sSAprint_nansA,SI,Cnil,""); + +void +gcl_init_print_function() +{ + make_function("WRITE", Lwrite); + make_function("PRIN1", Lprin1); + make_function("PRINT", Lprint); + make_function("PPRINT", Lpprint); + make_function("PRINC", Lprinc); + + make_function("WRITE-CHAR", Lwrite_char); + make_function("WRITE-STRING", Lwrite_string); + make_function("WRITE-LINE", Lwrite_line); + make_function("TERPRI", Lterpri); + make_function("FRESH-LINE", Lfresh_line); + make_function("FINISH-OUTPUT", Lfinish_output); + make_function("FORCE-OUTPUT", Lforce_output); + make_function("CLEAR-OUTPUT", Lclear_output); + make_function("WRITE-BYTE", Lwrite_byte); + make_si_sfun("SET-LINE-LENGTH",set_line_length,ARGTYPE1(f_fixnum) + | RESTYPE(f_fixnum)); +} + + + + + diff --git a/o/prog.c b/o/prog.c new file mode 100755 index 0000000..3e4e89b --- /dev/null +++ b/o/prog.c @@ -0,0 +1,304 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + prog.c +*/ + +#include "include.h" + +/* + use of VS in tagbody: + + old_top -> | id | + | lex0 | + | lex1 | + | lex2 | + tinf_base -> | tag1 | where 'bodyi' is the part of tag-body + | body1 | that follows the tag 'tagi'. + | : | + : i.e. + | : | tag-body + | tagn | = (...tag1..........tagn.............) + | bodyn | | |<- bodyn ->| + new_top -> | | | | + VS |<-------- body1 -------->| +*/ + +FFD(Ftagbody)(object body) +{ + + object *old_top = vs_top; + object * VOL new_top; + object *tinf; + object * VOL tinf_base; + object *env = lex_env; + object id = alloc_frame_id(); + VOL object bodysv = body; + object label; + enum type item_type; + + vs_push(id); + lex_copy(); + tinf_base = vs_top; + while (!endp(body)) { + label = MMcar(body); + item_type = type_of(label); + if (item_type == t_symbol || item_type == t_fixnum || + item_type == t_bignum) { + lex_tag_bind(label, id); + vs_push(label); + vs_push(MMcdr(body)); + } + body = MMcdr(body); + } + + new_top = vs_top; + + frs_push(FRS_CATCH, id); + body = bodysv; + if (nlj_active) { + label = cdr(nlj_tag); + nlj_active = FALSE; + for(tinf = tinf_base; + tinf < new_top && !eql(tinf[0],label); + tinf += 2) + ; + if (tinf >= new_top) + FEerror("Someone tried to RETURN-FROM a TAGBODY.",0); + body = tinf[1]; + } + while (body != Cnil) { + vs_top = new_top; + item_type = type_of(MMcar(body)); + if (item_type != t_symbol && item_type != t_fixnum && + item_type != t_bignum) + eval(MMcar(body)); + body = MMcdr(body); + } + frs_pop(); + lex_env = env; + vs_base = old_top; + vs_top = old_top+1; + vs_base[0] = Cnil; +} + +static void +FFN(Fprog)(VOL object arg) +{ + + object *oldlex = lex_env; + struct bind_temp *start; + object body; + bds_ptr old_bds_top = bds_top; + + if (endp(arg)) + FEtoo_few_argumentsF(arg); + + make_nil_block(); + + if (nlj_active) { + nlj_active = FALSE; + goto END; + } + + start = (struct bind_temp *)vs_top; + let_var_list(arg->c.c_car); + body = let_bind(arg->c.c_cdr, start, (struct bind_temp *)vs_top); + vs_top = (object *)start; + vs_push(body); + + Ftagbody(body); + +END: + bds_unwind(old_bds_top); + frs_pop(); + lex_env = oldlex; +} + +static void +FFN(FprogA)(VOL object arg) +{ + + object *oldlex = lex_env; + struct bind_temp *start; + object body; + bds_ptr old_bds_top = bds_top; + + if (endp(arg)) + FEtoo_few_argumentsF(arg); + + make_nil_block(); + + if (nlj_active) { + nlj_active = FALSE; + goto END; + } + + start = (struct bind_temp *) vs_top; + let_var_list(arg->c.c_car); + body = letA_bind(arg->c.c_cdr, start, (struct bind_temp *)vs_top); + vs_top = (object *)start; + vs_push(body); + + Ftagbody(body); + +END: + bds_unwind(old_bds_top); + frs_pop(); + lex_env = oldlex; +} + +static void +FFN(Fgo)(object args) +{ + + object lex_tag; + frame_ptr fr; + if (endp(args)) + FEtoo_few_argumentsF(args); + if (!endp(MMcdr(args))) + FEtoo_many_argumentsF(args); + lex_tag = lex_tag_sch(MMcar(args)); + if (MMnull(lex_tag)) + FEerror("~S is an undefined tag.", 1, MMcar(args)); + fr = frs_sch(MMcaddr(lex_tag)); + if (fr == NULL) + FEerror("The tag ~S is missing.", 1, MMcar(args)); + vs_push(MMcons(MMcaddr(lex_tag), MMcar(lex_tag))); + vs_base = vs_top; + unwind(fr,vs_top[-1]); + /* never reached */ +} + +static void +FFN(Fprogv)(object args) +{ + + object *top; + object symbols; + object values; + bds_ptr old_bds_top; + object var; + + if (endp(args) || endp(MMcdr(args))) + FEtoo_few_argumentsF(args); + + old_bds_top=bds_top; + + top=vs_top; + eval(MMcar(args)); + vs_top=top; + symbols=vs_base[0]; + vs_push(symbols); + eval(MMcadr(args)); + vs_top=top+1; + values=vs_base[0]; + vs_push(values); + while (!endp(symbols)) { + var = MMcar(symbols); + + if (type_of(var)!=t_symbol) not_a_symbol(var); + if ((enum stype)var->s.s_stype == stp_constant) + FEerror("Cannot bind the constant ~S.", 1, var); + + if (endp(values)) { + bds_bind(var, OBJNULL); + } else { + bds_bind(var, MMcar(values)); + values=MMcdr(values); + } + symbols=MMcdr(symbols); + } + + Fprogn(MMcddr(args)); + + bds_unwind(old_bds_top); +} + +FFD(Fprogn)(object body) +{ + + if(endp(body)) { + vs_base=vs_top; + vs_push(Cnil); + } else { + object *top=vs_top; + do { + vs_top=top; + eval(MMcar(body)); + body=MMcdr(body); + } while (!endp(body)); + } +} + +static void +FFN(Fprog1)(object arg) +{ + + object *top = vs_top; + + if(endp(arg)) + FEtoo_few_argumentsF(arg); + eval(MMcar(arg)); + vs_top = top; + vs_push(vs_base[0]); + for(arg = MMcdr(arg); !endp(arg); vs_top = top+1, arg = MMcdr(arg)) + eval(MMcar(arg)); + vs_base = top; + vs_top = top + 1; +} + +static void +FFN(Fprog2)(object arg) +{ + + object *top = vs_top; + + if(endp(arg) || endp(MMcdr(arg))) + FEtoo_few_argumentsF(arg); + eval(MMcar(arg)); + vs_top = top; + arg = MMcdr(arg); + eval(MMcar(arg)); + vs_top = top; + vs_push(vs_base[0]); + for(arg = MMcdr(arg); !endp(arg); vs_top = top+1, arg = MMcdr(arg)) + eval(MMcar(arg)); + vs_base = top; + vs_top = top+1; +} + +void +gcl_init_prog(void) +{ + make_special_form("TAGBODY", Ftagbody); + make_special_form("PROG", Fprog); + make_special_form("PROG*", FprogA); + make_special_form("GO", Fgo); + + make_special_form("PROGV", Fprogv); + + sLprogn=make_special_form("PROGN",Fprogn); + make_special_form("PROG1",Fprog1); + make_special_form("PROG2",Fprog2); +} diff --git a/o/read.d b/o/read.d new file mode 100755 index 0000000..6f4bab3 --- /dev/null +++ b/o/read.d @@ -0,0 +1,2513 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + read.d +*/ + + +#define NEED_ISFINITE +#include "include.h" + +#include +#include +#include "num_include.h" + +static object +current_readtable(void); + +DEFVAR("PATCH-SHARP",sSpatch_sharp,SI,sLnil,""); +static object +patch_sharp(object x) {return ifuncall1(sSpatch_sharp,x);} + + +#define digitp digitp1 + +static inline int +digitp(int i,int r) { + + if ( r<=10 || i<='9' ) + i-='0'; + else { + i=tolower(i)-'a'; + i=i<0 ? i : i+10; + } + + return i=0;u=0,o=o && f=0;u=0,o=o && fBUGGY_MAXIMUM_SSCANF_LENGTH) { + char *q1=s+BUGGY_MAXIMUM_SSCANF_LENGTH-strlen(q); + memmove(q1,q,strlen(q)+1); + q=q1; + } +#endif + n=sscanf(s,"%lf%n",&f,&m); + *q=c; + if (n!=1||s[m]) return OBJNULL; + + switch (ch=='e' || ch=='E' ? READdefault_float_format : ch) { + case 's':case 'S': + return make_shortfloat((float)f); + case 'f':case 'F':case 'd':case 'D':case 'l':case 'L': + return make_longfloat(f); + default: + return OBJNULL; + } + } +} + +static inline void +too_long_token(void) { + char *q; + int i; + + BEGIN_NO_INTERRUPT; + q = alloc_contblock(token->st.st_dim*2); + for (i = 0; i < token->st.st_dim; i++) + q[i] = token->st.st_self[i]; + token->st.st_self = q; + token->st.st_dim *= 2; + END_NO_INTERRUPT; + +} + +static inline void +null_terminate_token(void) { + + if (token->st.st_fillp==token->st.st_dim) + too_long_token(); + token->st.st_self[token->st.st_fillp]=0; + +} + + +#define token_buffer token->st.st_self +/* the active length of the token */ +int tok_leng; + + + +object dispatch_reader; + + +#define cat(c) (READtable->rt.rt_self[char_code((c))] \ + .rte_chattrib) + +static void +setup_READtable() +{ + READtable = current_readtable(); +} + + +/*bootstrap code*/ +DEFUN_NEW("SHARP-EQ-READER",object,fSsharp_eq_reader,SI,3,3,NONE,OO,OO,OO,OO,(object s,object ch,object ind),"") { + + object x,res; + + if (READsuppress) return Cnil; + if (ind==Cnil) FEerror("The #= readmacro requires an argument.", 0); + for (x=sSAsharp_eq_contextA->s.s_dbind;type_of(x)==t_cons && !(eql(x->c.c_car->c.c_car,ind));x=x->c.c_cdr); + if (x!=Cnil) FEerror("Duplicate definitions for #~D=.",1,ind); + x=x->c.c_car; + sSAsharp_eq_contextA->s.s_dbind=MMcons((x=MMcons(ind,MMcons(Cnil,OBJNULL))),sSAsharp_eq_contextA->s.s_dbind); + res=x->c.c_cdr->c.c_car=read_object(s); + if (res==x->c.c_cdr->c.c_cdr) + FEerror("#~D# is defined by itself.",1,x->c.c_car); + return res; +} + +DEFUN_NEW("SHARP-SHARP-READER",object,fSsharp_sharp_reader,SI,3,3,NONE,OO,OO,OO,OO,(object s,object ch,object ind),"") { + + object x; + + if (READsuppress) return Cnil; + if (ind==Cnil) FEerror("The ## readmacro requires an argument.", 0); + for (x=sSAsharp_eq_contextA->s.s_dbind;type_of(x)==t_cons && !(eql(x->c.c_car->c.c_car,ind));x=x->c.c_cdr); + if (x==Cnil) FEerror("#~D# is undefined.",1,ind); + x=x->c.c_car; + if (x->c.c_cdr->c.c_cdr==OBJNULL) + x->c.c_cdr->c.c_cdr=alloc_object(t_spice); + return x->c.c_cdr->c.c_cdr; +} + + +DEFUN_NEW("PATCH-SHARP",object,fSpatch_sharp,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + int i,j; + object y,p; + + switch (type_of(x)) { + + case t_spice: + for (y=sSAsharp_eq_contextA->s.s_dbind;type_of(y)==t_cons && y->c.c_car->c.c_cdr->c.c_cdr!=x;y=y->c.c_cdr); + return y->c.c_car->c.c_cdr->c.c_car; + break; + + case t_cons: + y=x; + do { + y->c.c_car=FFN(fSpatch_sharp)(y->c.c_car); + p=y; + y=y->c.c_cdr; + } while (type_of(y)==t_cons); + p->c.c_cdr=FFN(fSpatch_sharp)(p->c.c_cdr); + break; + + case t_vector: + if ((enum aelttype)x->v.v_elttype==aet_object) + for (i=0;iv.v_fillp;i++) + x->v.v_self[i]=FFN(fSpatch_sharp)(x->v.v_self[i]); + break; + + case t_array: + if ((enum aelttype)x->a.a_elttype==aet_object) { + for (i=0,j=1;ia.a_rank;i++) + j*=x->a.a_dims[i]; + for (i=0;ia.a_self[i]=FFN(fSpatch_sharp)(x->a.a_self[i]); + } + break; + + case t_structure: + y=x->str.str_def; + i=S_DATA(y)->length; + while (i-->0) + structure_set(x,y,i,FFN(fSpatch_sharp)(structure_ref(x,y,i))); + break; + + default: + break; + + } + + return(x); + +} +/*end bootstrap code*/ + +DEFVAR("*SHARP-EQ-CONTEXT*",sSAsharp_eq_contextA,SI,sLnil,""); + +DEFUN_NEW("ALLOC-SPICE",object,fSalloc_spice,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + return alloc_object(t_spice); +} +DEFUN_NEW("SPICE-P",object,fSspice_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + return type_of(x)==t_spice ? Ct : Cnil; +} + +static void +setup_READ() +{ + object x; + + READtable = current_readtable(); + x = symbol_value(sLAread_default_float_formatA); + if (x == sLshort_float) + READdefault_float_format = 'S'; + else if (x == sLsingle_float || x == sLdouble_float || x == sLlong_float) + READdefault_float_format = 'F'; + else { + vs_push(x); + sLAread_default_float_formatA->s.s_dbind = sLsingle_float; + FEerror("The value of *READ-DEFAULT-FLOAT-FORMAT*, ~S, was illegal.", + 1, x); + } + x = symbol_value(sLAread_baseA); + if (type_of(x) != t_fixnum || fix(x) < 2 || fix(x) > 36) { + vs_push(x); + sLAread_baseA->s.s_dbind = make_fixnum(10); + FEerror("The value of *READ-BASE*, ~S, was illegal.", 1, x); + } + READbase = fix(x); + READsuppress = symbol_value(sLAread_suppressA) != Cnil; + sSAsharp_eq_contextA->s.s_dbind=Cnil; + + backq_level = 0; +} + +/* static void */ +/* setup_standard_READ() */ +/* { */ +/* READtable = standard_readtable; */ +/* READdefault_float_format = 'F'; */ +/* READbase = 10; */ +/* READsuppress = FALSE; */ +/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ +/* backq_level = 0; */ +/* } */ + +object +read_char(in) +object in; +{ + return(code_char(readc_stream(in))); +} + +#define read_char(in) code_char(readc_stream(in)) + +static void +unread_char(c, in) +object c, in; +{ + if (type_of(c) != t_character) + FEwrong_type_argument(sLcharacter, c); + unreadc_stream(char_code(c), in); +} + +/* + Peek_char corresponds to COMMON Lisp function PEEK-CHAR. + When pt is TRUE, preceeding whitespaces are ignored. +*/ +object +peek_char(pt, in) +bool pt; +object in; +{ + object c; + + if (pt) { + do + c = read_char(in); + while (cat(c) == cat_whitespace); + unread_char(c, in); + return(c); + } else { + c = read_char(in); + unread_char(c, in); + return(c); + } +} + + +static object +read_object_recursive(in) +object in; +{ + VOL object x; + bool e; + + object old_READtable = READtable; + int old_READdefault_float_format = READdefault_float_format; + int old_READbase = READbase; + bool old_READsuppress = READsuppress; + + /* BUG FIX by Toshiba */ + vs_push(old_READtable); + + frs_push(FRS_PROTECT, Cnil); + if (nlj_active) { + e = TRUE; + goto L; + } + + READtable = current_readtable(); + x = symbol_value(sLAread_default_float_formatA); + if (x == sLshort_float) + READdefault_float_format = 'S'; + else if (x == sLsingle_float || x == sLdouble_float || x == sLlong_float) + READdefault_float_format = 'F'; + else { + vs_push(x); + sLAread_default_float_formatA->s.s_dbind = sLsingle_float; + FEerror("The value of *READ-DEFAULT-FLOAT-FORMAT*, ~S, was illegal.", + 1, x); + } + x = symbol_value(sLAread_baseA); + if (type_of(x) != t_fixnum || fix(x) < 2 || fix(x) > 36) { + vs_push(x); + sLAread_baseA->s.s_dbind = make_fixnum(10); + FEerror("The value of *READ-BASE*, ~S, was illegal.", 1, x); + } + READbase = fix(x); + READsuppress = symbol_value(sLAread_suppressA) != Cnil; + + x = read_object(in); + e = FALSE; + +L: + frs_pop(); + + READtable = old_READtable; + READdefault_float_format = old_READdefault_float_format; + READbase = old_READbase; + READsuppress = old_READsuppress; + + /* BUG FIX by Toshiba */ + vs_popp; + + if (e) { + nlj_active = FALSE; + unwind(nlj_fr, nlj_tag); + } + + return(x); +} + + +object +read_object_non_recursive(in) +object in; +{ + VOL object x; + bool e; + object old_READtable; + int old_READdefault_float_format; + int old_READbase; + int old_READsuppress; + object old_READcontext; + int old_backq_level; + + old_READtable = READtable; + old_READdefault_float_format = READdefault_float_format; + old_READbase = READbase; + old_READsuppress = READsuppress; + + old_READcontext=sSAsharp_eq_contextA->s.s_dbind; + + /* BUG FIX by Toshiba */ + vs_push(old_READtable); + old_backq_level = backq_level; + setup_READ(); + + frs_push(FRS_PROTECT, Cnil); + if (nlj_active) { + e = TRUE; + goto L; + } + + x = read_object(in); + vs_push(x); +#ifndef _WIN32 + while (listen_stream(in)) { + object c=read_char(in); + if (cat(c)!=cat_whitespace) { + unread_char(c,in); + break; + } + } +#endif + if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) + x = vs_head = patch_sharp(x); + + e = FALSE; + +L: + frs_pop(); + + READtable = old_READtable; + READdefault_float_format = old_READdefault_float_format; + READbase = old_READbase; + READsuppress = old_READsuppress; + sSAsharp_eq_contextA->s.s_dbind=old_READcontext; + backq_level = old_backq_level; + if (e) { + nlj_active = FALSE; + unwind(nlj_fr, nlj_tag); + } + vs_popp; + /* BUG FIX by Toshiba */ + vs_popp; + return(x); +} + +#ifdef UNIX /* faster code for inner loop from file stream */ +#define xxxread_char_to(res,in,eof_code) \ + do{FILE *fp; \ + if(fp=in->sm.sm_fp) \ + {int ch = getc(fp); \ + if (ch==EOF) { \ + if (feof(fp)) { eof_code;} \ + else if (in->sm.sm_mode==smm_socket) \ + { ch = getOneChar(fp); \ + if (ch==EOF) { eof_code;}}} \ + else res=code_char(ch);} \ + else \ + { if (stream_at_end(in)) \ + {eof_code;} \ + else res=read_char(in);}} while(0) + +#define read_char_to(res,in,eof_code) \ + do{FILE *fp; \ + if((fp=in->sm.sm_fp)) \ + {int ch = getc(fp); \ + if (ch==EOF && feof(fp)) \ + { eof_code;} \ + else res=code_char(ch);} \ + else \ + {int ch ; \ + if(stream_at_end(in)) {eof_code ;} \ + ch = readc_stream(in); \ + if (ch == EOF) { eof_code;} \ + res = code_char(ch); \ + }} while(0) +#else +#define read_char_to(res,in,eof_code) \ + do {if(stream_at_end(in)) {eof_code ;} \ + else { int ch = readc_stream(in); \ + if (ch == EOF) { eof_code;} \ + res = code_char(ch); \ + } \ + } while(0) +#endif + +/* + Read_object(in) reads an object from stream in. + This routine corresponds to COMMON Lisp function READ. +*/ + +/* FIXME What should this be? Apparently no reliable way to use value stack */ +#define MAX_PACKAGE_STACK 1024 +static object P0[MAX_PACKAGE_STACK],*PP0=P0,LP; + +object +read_object(in) +object in; +{ + object x; + object c=Cnil; + enum chattrib a; + object *old_vs_base; + object result; + object p; + int colon=0, colon_type; + int i; + bool df, ilf; + VOL int length; + vs_mark; + + cs_check(in); + + vs_check_push(delimiting_char); + delimiting_char = OBJNULL; + df = detect_eos_flag; + detect_eos_flag = FALSE; + ilf = in_list_flag; + in_list_flag = FALSE; + dot_flag = FALSE; + +BEGIN: + do { read_char_to(c,in, { + if (df) { + vs_reset; + return(OBJNULL); + } else + end_of_stream(in); + }); + a = cat(c); + } while (a == cat_whitespace); + if (c->ch.ch_code == '(') { /* Loose package extension */ + LP=LP || PP0==P0 ? LP : PP0[-1]; /* push loose packages into nested lists */ + if (LP) { + if (PP0-P0>=MAX_PACKAGE_STACK) + FEerror("Too many nested package specifiers",0); + *PP0++=LP; + LP=NULL; + } + } else if (LP) + FEerror("Loose package prefix must be followed by a list",0); + if (c->ch.ch_code==')' && PP0>P0) PP0--; /* regardless of error behavior, + will pop stack to beginning as parens + must match before the reader starts */ + delimiting_char = vs_head; + if (delimiting_char != OBJNULL && c == delimiting_char) { + delimiting_char = OBJNULL; + vs_reset; + return(OBJNULL); + } + delimiting_char = OBJNULL; + if (a == cat_terminating || a == cat_non_terminating) + { + object *fun_box = vs_top; + + old_vs_base = vs_base; + vs_push(Cnil); + vs_base = vs_top; + vs_push(in); + vs_push(c); + + x = + READtable->rt.rt_self[char_code(c)].rte_macro; + fun_box[0] = x; + super_funcall(x); + + i = vs_top - vs_base; + if (i == 0) { + vs_base = old_vs_base; + vs_top = old_vs_top + 1; + goto BEGIN; + } + if (i > 1) { + vs_push(make_fixnum(i)); + FEerror("The readmacro ~S returned ~D values.", + 2, fun_box[0], vs_top[-1]); + } + result = vs_base[0]; + vs_base = old_vs_base; + vs_reset; + return(result); + } + escape_flag = FALSE; + length = 0; tok_leng=0; + colon_type = 0; + goto L; + for (;;) { + if (length >= token->st.st_dim) + too_long_token(); + token_buffer[(tok_leng++,length++)] = char_code(c); + K: + read_char_to(c,in,goto M); + a = cat(c); + L: + if (a == cat_single_escape) { + c = read_char(in); + a = cat_constituent; + escape_flag = TRUE; + } else if (a == cat_multiple_escape) { + escape_flag = TRUE; + for (;;) { + if (stream_at_end(in)) + end_of_stream(in); + c = read_char(in); + a = cat(c); + if (a == cat_single_escape) { + c = read_char(in); + a = cat_constituent; + } else if (a == cat_multiple_escape) + break; + if (length >= token->st.st_dim) + too_long_token(); + token_buffer[(tok_leng++,length++)] = char_code(c); + } + goto K; + } else if (a == cat_terminating) { + break; + } else if (a == cat_whitespace) { + /* skip all whitespace after trailing colon if no escape seen */ + if (colon+colon_type==length && !escape_flag) + goto K; + else + break; + } else { + + switch(char_code(c)) { + case '\b': + case '\t': + case '\n': + case '\r': + case '\f': + case ' ': + case '\177': + READER_ERROR(in,"Cannot read character"); + default: + break; + } + + if ('a' <= char_code(c) && char_code(c) <= 'z') { + if ('a' <= char_code(c) && char_code(c) <= 'z' && + (READtable->rt.rt_case==sKupcase || READtable->rt.rt_case==sKinvert)) + c = code_char(char_code(c) - ('a' - 'A')); + else if ('A' <= char_code(c) && char_code(c) <= 'Z' && + (READtable->rt.rt_case==sKdowncase || READtable->rt.rt_case==sKinvert)) + c = code_char(char_code(c) + ('a' - 'A')); + } else if (char_code(c) == ':') { + if (colon_type == 0) { + colon_type = 1; + colon = length; + } else if (colon_type == 1 && colon == length-1) + colon_type = 2; + else + colon_type = -1; + /* Colon has appeared twice. */ + } + } + } + if (preserving_whitespace_flag || cat(c) != cat_whitespace) + unread_char(c, in); + +M: + if (READsuppress) { + token->st.st_fillp = length; + vs_reset; + return(Cnil); + } + if (ilf && !escape_flag && + length == 1 && token->st.st_self[0] == '.') { + dot_flag = TRUE; + vs_reset; + return(Cnil); + } else if (!escape_flag && length > 0) { + for (i = 0; i < length; i++) + if (token->st.st_self[i] != '.') + goto N; + FEerror("Dots appeared illegally.", 0); + } + +N: + token->st.st_fillp = length; + if (escape_flag || (READbase<=10 && token_buffer[0]>'9')) + goto SYMBOL; + null_terminate_token(); + x = parse_number(token_buffer, READbase); + if (x != OBJNULL) { + vs_reset; + return(x); + } + +SYMBOL: + if (colon_type == 1 /* && length > colon + 1 */) { + if (colon == 0) + p = keyword_package; + else { + token->st.st_fillp = colon; + p = find_package(token); + if (p == Cnil) { + vs_push(copy_simple_string(token)); + FEerror("There is no package with the name \"~A\".", + 1, vs_head); + } + } + for (i = colon + 1; i < length; i++) + token_buffer[i - (colon + 1)] + = token_buffer[i]; + token->st.st_fillp = length - (colon + 1); + if (colon > 0) { + x = find_symbol(token, p); + if (intern_flag != EXTERNAL) { + vs_push(copy_simple_string(token)); + FEerror("Cannot find the external symbol ~A in ~S.", + 2, vs_head, p); + /* no need to push a package */ + } + vs_reset; + return(x); + } + } else if (colon_type == 2 /* && colon > 0 && length > colon + 2 */) { + token->st.st_fillp = colon; + p = find_package(token); + if (p == Cnil) { + vs_push(copy_simple_string(token)); + FEerror("There is no package with the name \"~A\".", + 1, vs_head); + } + for (i = colon + 2; i < length; i++) + token_buffer[i - (colon + 2)] + = token_buffer[i]; + token->st.st_fillp = length - (colon + 2); + } else + p = current_package(); + /* loose package is an empty token following a non-beginning + colon with no escape, to allow for ||*/ + if (!token->st.st_fillp && colon && !escape_flag) { + LP=p; + goto BEGIN; + } + /* unless package specified for this symbol, use loose package if present */ + if (PP0>P0 && !colon_type) + p=PP0[-1]; + vs_push(p); + x = intern(token, p); + vs_push(x); + if (x->s.s_self == token_buffer) { + {BEGIN_NO_INTERRUPT; + x->s.s_self = alloc_relblock(token->st.st_fillp); + for (i = 0; i < token->st.st_fillp; i++) + x->s.s_self[i] = token_buffer[i]; + END_NO_INTERRUPT;} + } + vs_reset; + return(x); +} + +static void +Lleft_parenthesis_reader() { + + object in, x; + object *p; + + check_arg(2); + in = vs_base[0]; + vs_top=vs_base+1; + p = &vs_head; + + for (;;) { + + delimiting_char = code_char(')'); + in_list_flag = TRUE; + + if ((x=read_object(in))==OBJNULL) { + *p=Cnil; + break; + } + + if (dot_flag) { + + if (p==&vs_head) READER_ERROR(in,"A dot appeared after a left parenthesis."); + + delimiting_char = code_char(')'); + in_list_flag = TRUE; + *p=SAFE_CDR(read_object(in)); + + if (dot_flag) READER_ERROR(in,"Two dots appeared consecutively."); + if (*p==OBJNULL) READER_ERROR(in,"Object missing after dot."); + + delimiting_char = code_char(')'); + in_list_flag = TRUE; + if (read_object(in)!=OBJNULL) READER_ERROR(in,"Two objects after dot."); + + break; + + } + + collect(p,make_cons(x,Cnil)); + + } + +} + + +/* + Read_string(delim, in) reads + a simple string terminated by character code delim + and places it in token. + Delim is not included in the string but discarded. +*/ +static void +read_string(delim, in) +int delim; +object in; +{ + int i; + object c; + + i = 0; + for (;;) { + c = read_char(in); + if (char_code(c) == delim) + break; + else if (cat(c) == cat_single_escape) + c = read_char(in); + if (i >= token->st.st_dim) + too_long_token(); + token_buffer[i++] = char_code(c); + } + token->st.st_fillp = i; +} + +/* + Read_constituent(in) reads + a sequence of constituent characters from stream in + and places it in token_buffer. +*/ +static void +read_constituent(in) +object in; +{ + int i, j; + object c; + + i = 0; + for (;;) { + read_char_to(c,in,goto FIN); + if (cat(c) != cat_constituent) { + unread_char(c, in); + break; + } + j = char_code(c); + token_buffer[i++] = j; + } + FIN: + token->st.st_fillp = i; + +} + +static void +Ldouble_quote_reader() +{ + check_arg(2); + vs_popp; + read_string('"', vs_base[0]); + vs_base[0] = copy_simple_string(token); +} + +static void +Ldispatch_reader() +{ + object c, x; + int i, j; + object in; + + check_arg(2); + + in = vs_base[0]; + c = vs_base[1]; + + if (READtable->rt.rt_self[char_code(c)].rte_dtab == NULL) + FEerror("~C is not a dispatching macro character", 1, c); + + + for (i=0;ist.st_dim;i++) { + c=read_char(in); + j=char_code(c); + if (digitp(j,10)<0) + break; + token->st.st_self[i]=j; + } + if (i==token->st.st_dim) + FEerror("Dispatch number too long", 0); + if (i) { + token->st.st_fillp=i; + null_terminate_token(); + x=parse_number(token->st.st_self,10); + if (x == OBJNULL) + FEerror("Cannot parse the dispatch macro number.", 0); + } else + x=Cnil; + vs_push(x); + + x = + READtable->rt.rt_self[char_code(vs_base[1])].rte_dtab[char_code(c)]; + vs_base[1] = c; + super_funcall(x); +} + +static void +Lsingle_quote_reader() +{ + check_arg(2); + vs_base[0] = list(2,sLquote,read_object(vs_base[0])); + vs_top=vs_base+1; +} + +static void +Lright_parenthesis_reader() +{ + check_arg(2); + vs_popp; + vs_popp; + /* no result */ +} + +/* +Lcomma_reader(){} +*/ + +static void +Lsemicolon_reader() +{ + object c; + object str= vs_base[0]; + check_arg(2); + vs_popp; + do + { read_char_to(c,str, goto L); } + while (char_code(c) != '\n'); +L: + vs_popp; + vs_base[0] = Cnil; + /* no result */ +} + +/* +Lbackquote_reader(){} +*/ + +/* + sharpmacro routines +*/ +static void +extra_argument(int); + +static void +Lsharp_C_reader() +{ + object x, c; + + check_arg(3); + if (vs_base[2] != Cnil && !READsuppress) + extra_argument('C'); + vs_popp; + vs_popp; + c = read_char(vs_base[0]); + if (char_code(c) != '(') + FEerror("A left parenthesis is expected.", 0); + delimiting_char = code_char(')'); + x = read_object(vs_base[0]); + if (x == OBJNULL) + FEerror("No real part.", 0); + vs_push(x); + delimiting_char = code_char(')'); + x = read_object(vs_base[0]); + if (x == OBJNULL) + FEerror("No imaginary part.", 0); + vs_push(x); + delimiting_char = code_char(')'); + x = read_object(vs_base[0]); + if (x != OBJNULL) + FEerror("A right parenthesis is expected.", 0); + if (READsuppress) vs_base[0]= Cnil ; + else + if (contains_sharp_comma(vs_base[1]) || + contains_sharp_comma(vs_base[2])) { + vs_base[0] = alloc_object(t_complex); + vs_base[0]->cmp.cmp_real = vs_base[1]; + vs_base[0]->cmp.cmp_imag = vs_base[2]; + } else { + check_type_number(&vs_base[1]); + check_type_number(&vs_base[2]); + vs_base[0] = make_complex(vs_base[1], vs_base[2]); + } + vs_top = vs_base + 1; +} + +static void +Lsharp_backslash_reader() +{ + object c; + + check_arg(3); + if (vs_base[2] != Cnil && !READsuppress) + if (type_of(vs_base[2]) != t_fixnum || + fix(vs_base[2]) != 0) + FEerror("~S is an illegal CHAR-FONT.", 1, vs_base[2]); + /* assuming that CHAR-FONT-LIMIT is 1 */ + vs_popp; + vs_popp; + unread_char(code_char('\\'), vs_base[0]); + if (READsuppress) { + (void)read_object(vs_base[0]); + vs_base[0] = Cnil; + return; + } + READsuppress = TRUE; + (void)read_object(vs_base[0]); + READsuppress = FALSE; + c = token; + if (c->s.s_fillp == 1) { + vs_base[0] = code_char(c->ust.ust_self[0]); + return; + } + if (string_equal(c, STreturn)) + vs_base[0] = code_char('\r'); + else if (string_equal(c, STspace)) + vs_base[0] = code_char(' '); + else if (string_equal(c, STrubout)) + vs_base[0] = code_char('\177'); + else if (string_equal(c, STpage)) + vs_base[0] = code_char('\f'); + else if (string_equal(c, STtab)) + vs_base[0] = code_char('\t'); + else if (string_equal(c, STbackspace)) + vs_base[0] = code_char('\b'); + else if (string_equal(c, STlinefeed) || string_equal(c, STnewline)) + vs_base[0] = code_char('\n'); + else if (c->s.s_fillp == 2 && c->s.s_self[0] == '^') + vs_base[0] = code_char(c->s.s_self[1] & 037); + else if (c->s.s_self[0] =='\\' && c->s.s_fillp > 1) { + int i, n; + for (n = 0, i = 1; i < c->s.s_fillp; i++) + if (c->s.s_self[i] < '0' || '7' < c->s.s_self[i]) + FEerror("Octal digit expected.", 0); + else + n = 8*n + c->s.s_self[i] - '0'; + vs_base[0] = code_char(n & 0377); + } else + FEerror("~S is an illegal character name.", 1, c); +} + +static void +Lsharp_single_quote_reader() +{ + + check_arg(3); + if(vs_base[2] != Cnil && !READsuppress) + extra_argument('#'); + vs_base[0] = list(2,sLfunction,read_object(vs_base[0])); + vs_top=vs_base+1; +} + +#define QUOTE 1 +#define EVAL 2 +#define LIST 3 +#define LISTA 4 +#define APPEND 5 +#define NCONC 6 + +object siScomma; + +static void +Lsharp_left_parenthesis_reader() +{ + + int dim=0; + int dimcount; + object in, x; + int a; + object *vsp; + + check_arg(3); + if (vs_base[2] == Cnil || READsuppress) + dim = -1; + else if (type_of(vs_base[2]) == t_fixnum) + dim = fix(vs_base[2]); + vs_popp; + vs_popp; + in = vs_base[0]; + if (backq_level > 0) { + unreadc_stream('(', in); + vs_push(read_object(in)); + a = backq_car(vs_base[1]); + if (a == APPEND || a == NCONC) + FEerror(",at or ,. has appeared in an illegal position.", 0); + if (a == QUOTE) { + vsp = vs_top; + dimcount = 0; + for (x = vs_base[2]; !endp(x); x = x->c.c_cdr) { + vs_check_push(x->c.c_car); + dimcount++; + } + goto L; + } + vs_base[0]=list(4,siScomma,sLapply,list(2,sLquote,sLvector),vs_base[2]); + vs_top=vs_base+1; + return; + } + vsp = vs_top; + dimcount = 0; + for (;;) { + delimiting_char = code_char(')'); + x = read_object(in); + if (x == OBJNULL) + break; + vs_check_push(x); + dimcount++; + } +L: + if (dim >= 0) { + if (dimcount > dim) + FEerror("Too many elements in #(...).", 0); + else { + if (dimcount == 0) + FEerror("Cannot fill the vector #().", 0); + x = vs_head; + for (; dimcount < dim; dimcount++) + vs_push(x); + } + } + {BEGIN_NO_INTERRUPT; + x = alloc_simple_vector(dimcount, aet_object); + vs_push(x); + x->v.v_self + = (object *)alloc_relblock(dimcount * sizeof(object)); + vs_popp; + for (dim = 0; dim < dimcount; dim++) + x->v.v_self[dim] = vsp[dim]; + vs_top = vs_base; + END_NO_INTERRUPT;} + vs_push(x); +} + +static void +Lsharp_asterisk_reader() +{ + int dim=0; + int dimcount; + object in, x; + object *vsp; + + check_arg(3); + if (READsuppress) { + read_constituent(vs_base[0]); + vs_popp; + vs_popp; + vs_base[0] = Cnil; + return; + } + if (vs_head == Cnil) + dim = -1; + else if (type_of(vs_head) == t_fixnum) + dim = fix(vs_head); + vs_popp; + vs_popp; + in = vs_head; + vsp = vs_top; + dimcount = 0; + for (;;) { + if (stream_at_end(in)) + break; + x = read_char(in); + if (char_code(x) != '0' && char_code(x) != '1') { + unread_char(x, in); + break; + } + vs_check_push(x); + dimcount++; + } + if (dim >= 0) { + if (dimcount > dim) + FEerror("Too many elements in #*....", 0); + else { + if (dimcount == 0) + error("Cannot fill the bit-vector #*."); + x = vs_head; + for (; dimcount < dim; dimcount++) + vs_push(x); + } + } + {BEGIN_NO_INTERRUPT; + x = alloc_simple_bitvector(dimcount); + vs_push(x); + x->bv.bv_self = alloc_relblock((dimcount + 7)/8); + vs_popp; + for (dim = 0; dim < dimcount; dim++) + if (char_code(vsp[dim]) == '0') + x->bv.bv_self[dim/8] &= ~(0200 >> dim%8); + else + x->bv.bv_self[dim/8] |= 0200 >> dim%8; + END_NO_INTERRUPT;} + vs_top = vs_base; + vs_push(x); +} + +static void +Lsharp_colon_reader() +{ + object in; + int length; + object c; + enum chattrib a; + + if (vs_base[2] != Cnil && !READsuppress) + extra_argument(':'); + vs_popp; + vs_popp; + in = vs_base[0]; + c = read_char(in); + a = cat(c); + escape_flag = FALSE; + length = 0; tok_leng=0; + goto L; + for (;;) { + if (length >= token->st.st_dim) + too_long_token(); + token_buffer[(tok_leng++,length++)] = char_code(c); + K: + if (stream_at_end(in)) + goto M; + c = read_char(in); + a = cat(c); + L: + if (a == cat_single_escape) { + c = read_char(in); + a = cat_constituent; + escape_flag = TRUE; + } else if (a == cat_multiple_escape) { + escape_flag = TRUE; + for (;;) { + if (stream_at_end(in)) + end_of_stream(in); + c = read_char(in); + a = cat(c); + if (a == cat_single_escape) { + c = read_char(in); + a = cat_constituent; + } else if (a == cat_multiple_escape) + break; + if (length >= token->st.st_dim) + too_long_token(); + token_buffer[(tok_leng++,length++)] = char_code(c); + } + goto K; + } else if ('a' <= char_code(c) && char_code(c) <= 'z') + c = code_char(char_code(c) - ('a' - 'A')); + if (a == cat_whitespace || a == cat_terminating) + break; + } + if (preserving_whitespace_flag || cat(c) != cat_whitespace) + unread_char(c, in); + +M: + if (READsuppress) { + vs_base[0] = Cnil; + return; + } + token->st.st_fillp = length; + vs_base[0] = copy_simple_string(token); + vs_base[0] = make_symbol(vs_base[0]); +} + +static void +Lsharp_dot_reader() +{ + check_arg(3); + if(vs_base[2] != Cnil && !READsuppress) + extra_argument('.'); + vs_popp; + vs_popp; + if (READsuppress) { + read_object(vs_base[0]); + vs_base[0] = Cnil; + return; + } + vs_base[0] = read_object(vs_base[0]); + vs_base[0] = ieval(vs_base[0]); +} + +static void +Lsharp_comma_reader() +{ + check_arg(3); + if(vs_base[2] != Cnil && !READsuppress) + extra_argument(','); + vs_popp; + vs_popp; + if (READsuppress) { + read_object(vs_base[0]); + vs_base[0] = Cnil; + return; + } + vs_base[0] = read_object(vs_base[0]); + vs_base[0] = ieval(vs_base[0]); +} + +static void +FFN(siLsharp_comma_reader_for_compiler)() +{ + check_arg(3); + if(vs_base[2] != Cnil && !READsuppress) + extra_argument(','); + vs_popp; + vs_popp; + if (READsuppress) { + vs_base[0] = Cnil; + return; + } + vs_base[0] = read_object(vs_base[0]); + vs_base[0] = make_cons(siSsharp_comma, vs_base[0]); +} + +static void +Lsharp_B_reader() +{ + + if(vs_base[2] != Cnil && !READsuppress) + extra_argument('B'); + vs_popp; + vs_popp; + read_constituent(vs_base[0]); + if (READsuppress) { + vs_base[0] = Cnil; + return; + } + null_terminate_token(); + vs_base[0] + = parse_number(token_buffer, 2); + if (vs_base[0] == OBJNULL) + FEerror("Cannot parse the #B readmacro.", 0); + if (type_of(vs_base[0]) == t_shortfloat || + type_of(vs_base[0]) == t_longfloat) + FEerror("The float ~S appeared after the #B readmacro.", + 1, vs_base[0]); +} + +static void +Lsharp_O_reader() +{ + + if(vs_base[2] != Cnil && !READsuppress) + extra_argument('O'); + vs_popp; + vs_popp; + read_constituent(vs_base[0]); + if (READsuppress) { + vs_base[0] = Cnil; + return; + } + null_terminate_token(); + vs_base[0] + = parse_number(token_buffer, 8); + if (vs_base[0] == OBJNULL) + FEerror("Cannot parse the #O readmacro.", 0); + if (type_of(vs_base[0]) == t_shortfloat || + type_of(vs_base[0]) == t_longfloat) + FEerror("The float ~S appeared after the #O readmacro.", + 1, vs_base[0]); +} + +static void +Lsharp_X_reader() +{ + + if(vs_base[2] != Cnil && !READsuppress) + extra_argument('X'); + vs_popp; + vs_popp; + read_constituent(vs_base[0]); + if (READsuppress) { + vs_base[0] = Cnil; + return; + } + null_terminate_token(); + vs_base[0] + = parse_number(token_buffer, 16); + if (vs_base[0] == OBJNULL) + FEerror("Cannot parse the #X readmacro.", 0); + if (type_of(vs_base[0]) == t_shortfloat || + type_of(vs_base[0]) == t_longfloat) + FEerror("The float ~S appeared after the #X readmacro.", + 1, vs_base[0]); +} + +static void +Lsharp_R_reader() +{ + int radix=0; + + check_arg(3); + if (READsuppress) + radix = 10; + else if (type_of(vs_base[2]) == t_fixnum) { + radix = fix(vs_base[2]); + if (radix > 36 || radix < 2) + FEerror("~S is an illegal radix.", 1, vs_base[2]); + } else + FEerror("No radix was supplied in the #R readmacro.", 0); + vs_popp; + vs_popp; + read_constituent(vs_base[0]); + if (READsuppress) { + vs_base[0] = Cnil; + return; + } + null_terminate_token(); + vs_base[0] + = parse_number(token_buffer, radix); + if (vs_base[0] == OBJNULL) + FEerror("Cannot parse the #R readmacro.", 0); + if (type_of(vs_base[0]) == t_shortfloat || + type_of(vs_base[0]) == t_longfloat) + FEerror("The float ~S appeared after the #R readmacro.", + 1, vs_base[0]); +} + +static void Lsharp_plus_reader(){} + +static void Lsharp_minus_reader(){} + +static void +Lsharp_vertical_bar_reader() +{ + int c; + int level = 0; + + check_arg(3); + if (vs_base[2] != Cnil && !READsuppress) + extra_argument('|'); + vs_popp; + vs_popp; + for (;;) { + c = readc_stream(vs_base[0]); + L: + if (c == '#') { + c = readc_stream(vs_base[0]); + if (c == '|') + level++; + } else if (c == '|') { + c = readc_stream(vs_base[0]); + if (c == '#') { + if (level == 0) + break; + else + --level; + } else + goto L; + } + } + vs_popp; + vs_base[0] = Cnil; + /* no result */ +} + +static void +Ldefault_dispatch_macro() +{ + FEerror("The default dispatch macro signalled an error.", 0); +} + +/* + #$ fixnum returns a random-state with the fixnum + as its content. +*/ +static void +Lsharp_dollar_reader() +{ + object x; + enum type tx; + + check_arg(3); + if (vs_base[2] != Cnil && !READsuppress) + extra_argument('$'); + vs_popp; + vs_popp; + x = read_object(vs_base[0]); + tx=type_of(x); + vs_base[0] = alloc_object(t_random); + init_gmp_rnd_state(&vs_base[0]->rnd.rnd_state); + if (tx!=t_fixnum || fix(x)) { + if (tx==t_fixnum) { + if (vs_base[0]->rnd.rnd_state._mp_seed->_mp_size!=1) + FEerror("Cannot make a random-state with the value ~S.",1, x); + mpz_set_ui(vs_base[0]->rnd.rnd_state._mp_seed,fix(x)); + } else { + if (x->big.big_mpz_t._mp_size!=vs_base[0]->rnd.rnd_state._mp_seed->_mp_size) + FEerror("Cannot make a random-state with the value ~S.",1, x); + memcpy(vs_base[0]->rnd.rnd_state._mp_seed->_mp_d,x->big.big_mpz_t._mp_d, + vs_base[0]->rnd.rnd_state._mp_seed->_mp_size*sizeof(*vs_base[0]->rnd.rnd_state._mp_seed->_mp_d)); + } + } + +} + +/* + readtable routines +*/ + +static object +copy_readtable(from, to) +object from, to; +{ + struct rtent *rtab; + int i, j; + vs_mark; + {BEGIN_NO_INTERRUPT; + if (to == Cnil) { + to = alloc_object(t_readtable); + to->rt.rt_self = NULL; + to->rt.rt_case = sKupcase; + /* For GBC not to go mad. */ + vs_push(to); + /* Saving for GBC. */ + to->rt.rt_self + = rtab + = (struct rtent *) + alloc_contblock(RTABSIZE * sizeof(struct rtent)); + for (i = 0; i < RTABSIZE; i++) + rtab[i] = from->rt.rt_self[i]; + /* structure assignment */ + } else + rtab=to->rt.rt_self; + for (i = 0; i < RTABSIZE; i++) + if (from->rt.rt_self[i].rte_dtab != NULL) { + rtab[i].rte_dtab + = (object *) + alloc_contblock(RTABSIZE * sizeof(object)); + for (j = 0; j < RTABSIZE; j++) + rtab[i].rte_dtab[j] + = from->rt.rt_self[i].rte_dtab[j]; + } + to->rt.rt_case=from->rt.rt_case; + vs_reset; + END_NO_INTERRUPT;} + return(to); +} + +static object +current_readtable() +{ + object r; + + r = symbol_value(Vreadtable); + if (type_of(r) != t_readtable) { + Vreadtable->s.s_dbind = copy_readtable(standard_readtable,sLnil); + FEerror("The value of *READTABLE*, ~S, was not a readtable.", + 1, r); + } + return(r); +} + + +@(defun read (&optional (strm `symbol_value(sLAstandard_inputA)`) + (eof_errorp Ct) + eof_value + recursivep + &aux x) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + if (recursivep == Cnil) + preserving_whitespace_flag = FALSE; + detect_eos_flag = TRUE; + if (recursivep == Cnil) + x = read_object_non_recursive(strm); + else + x = read_object_recursive(strm); + if (x == OBJNULL) { + if (eof_errorp == Cnil && recursivep == Cnil) + @(return eof_value) + end_of_stream(strm); + } + @(return x) +@) + +@(static defun read_preserving_whitespace + (&optional (strm `symbol_value(sLAstandard_inputA)`) + (eof_errorp Ct) + eof_value + recursivep + &aux x) + object c; +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + while (!stream_at_end(strm)) { + c = read_char(strm); + if (cat(c) != cat_whitespace) { + unread_char(c, strm); + goto READ; + } + } + /* if (eof_errorp == Cnil && recursivep == Cnil) */ + /* @(return eof_value) */ + /* end_of_stream(strm); */ + +READ: + if (recursivep == Cnil) + preserving_whitespace_flag = TRUE; + detect_eos_flag = TRUE; + if (recursivep == Cnil) + x = read_object_non_recursive(strm); + else + x = read_object_recursive(strm); + if (x == OBJNULL) { + if (eof_errorp == Cnil && recursivep == Cnil) + @(return eof_value) + end_of_stream(strm); + } + @(return x) +@) + +@(defun read_delimited_list + (d + &optional (strm `symbol_value(sLAstandard_inputA)`) + recursivep + &aux l x) + + object *p; + + bool e; + volatile object old_READcontext; + volatile int old_backq_level=0; + +@ + + check_type_character(&d); + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + if (recursivep == Cnil) { + + old_READcontext=sSAsharp_eq_contextA->s.s_dbind; + old_backq_level = backq_level; + setup_READ(); + frs_push(FRS_PROTECT, Cnil); + if (nlj_active) { + e = TRUE; + goto L; + } + } + l = Cnil; + p = &l; + preserving_whitespace_flag = FALSE; /* necessary? */ + for (;;) { + delimiting_char = d; + x = read_object_recursive(strm); + if (x == OBJNULL) + break; + collect(p,make_cons(x,Cnil)); + } + if (recursivep == Cnil) { + if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) + l = patch_sharp(l); + e = FALSE; + L: + frs_pop(); + sSAsharp_eq_contextA->s.s_dbind=old_READcontext; + backq_level = old_backq_level; + if (e) { + nlj_active = FALSE; + unwind(nlj_fr, nlj_tag); + } + } + @(return l) +@) + +@(defun read_line (&optional (strm `symbol_value(sLAstandard_inputA)`) + (eof_errorp Ct) + eof_value + recursivep + &aux c) + int i; +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + if (stream_at_end(strm)) { + if (eof_errorp == Cnil && recursivep == Cnil) + @(return eof_value) + else + end_of_stream(strm); + } + i = 0; + for (;;) { + read_char_to(c,strm,c = Ct; goto FINISH); + if (char_code(c) == '\n') { + c = Cnil; + break; + } + if (i >= token->st.st_dim-1) + too_long_token(); + token->st.st_self[i++] = char_code(c); + } + FINISH: +#ifdef DOES_CRLF + if (i > 0 && token->st.st_self[i-1] == '\r') i--; +#endif + token->st.st_fillp = i; + /* no disadvantage to returning an adjustable string */ + + {object uu= copy_simple_string(token); +/* uu->st.st_hasfillp=TRUE; + uu->st.st_adjustable=TRUE; +*/ + @(return uu c) + } +@) + +@(defun read_char (&optional (strm `symbol_value(sLAstandard_inputA)`) + (eof_errorp Ct) + eof_value + recursivep) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + {object x ; + read_char_to(x,strm,goto AT_EOF); + @(return `x`) + AT_EOF: + if (eof_errorp == Cnil && recursivep == Cnil) + @(return eof_value) + else + end_of_stream(strm); + } +@) + +@(defun unread_char (c &optional (strm `symbol_value(sLAstandard_inputA)`)) +@ + check_type_character(&c); + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + unread_char(c, strm); + @(return Cnil) +@) + +@(defun peek_char (&optional peek_type + (strm `symbol_value(sLAstandard_inputA)`) + (eof_errorp Ct) + eof_value + recursivep) + object c; +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + setup_READtable(); + if (peek_type == Cnil) { + if (stream_at_end(strm)) { + if (eof_errorp == Cnil && recursivep == Cnil) + @(return eof_value) + else + end_of_stream(strm); + } + c = read_char(strm); + unread_char(c, strm); + @(return c) + } + if (peek_type == Ct) { + while (!stream_at_end(strm)) { + c = read_char(strm); + if (cat(c) != cat_whitespace) { + unread_char(c, strm); + @(return c) + } + } + if (eof_errorp == Cnil) + @(return eof_value) + else + end_of_stream(strm); + } + check_type_character(&peek_type); + while (!stream_at_end(strm)) { + c = read_char(strm); + if (char_eq(c, peek_type)) { + unread_char(c, strm); + @(return c) + } + } + if (eof_errorp == Cnil) + @(return eof_value) + else + end_of_stream(strm); +@) + +@(defun listen (&optional (strm `symbol_value(sLAstandard_inputA)`)) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + if (listen_stream(strm)) + @(return Ct) + else + @(return Cnil) +@) + +@(defun read_char_no_hang (&optional (strm `symbol_value(sLAstandard_inputA)`) + (eof_errorp Ct) + eof_value + recursivep) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); + if (stream_at_end(strm)) { + if (eof_errorp == Cnil) + @(return eof_value) + else + end_of_stream(strm); + } + if (!listen_stream(strm)) @(return Cnil) + @(return `read_char(strm)`) +@) + +@(defun clear_input (&optional (strm `symbol_value(sLAstandard_inputA)`)) +@ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + check_type_stream(&strm); +#ifdef LISTEN_FOR_INPUT + while(listen_stream(strm)) {readc_stream(strm);} +#endif + @(return Cnil) +@) + +@(defun parse_integer (strng + &key start + end + (radix `make_fixnum(10)`) + junk_allowed + &aux x) + int s, e, ep; +@ + check_type_string(&strng); + get_string_start_end(strng, start, end, &s, &e); + if (type_of(radix) != t_fixnum || + fix(radix) < 2 || fix(radix) > 36) + FEerror("~S is an illegal radix.", 1, radix); + setup_READtable(); + while (READtable->rt.rt_self[(unsigned char)strng->st.st_self[s]].rte_chattrib + == cat_whitespace && s < e) + s++; + if (s >= e) { + if (junk_allowed != Cnil) + @(return Cnil `make_fixnum(s)`) + else + goto CANNOT_PARSE; + } + { + char *q; + while (token->st.st_dimst.st_self,strng->st.st_self+s,e-s); + token->st.st_fillp=e-s; + null_terminate_token(); + x = parse_integer(token->st.st_self, &q, fix(radix)); + ep=q-token->st.st_self; + } + if (x == OBJNULL) { + if (junk_allowed != Cnil) + @(return Cnil `make_fixnum(ep+s)`) + else + goto CANNOT_PARSE; + } + if (junk_allowed != Cnil) + @(return x `make_fixnum(ep+s)`) + for (s += ep ; s < e; s++) + if (READtable->rt.rt_self[(unsigned char)strng->st.st_self[s]] + .rte_chattrib + != cat_whitespace) + goto CANNOT_PARSE; + @(return x `make_fixnum(e)`) + +CANNOT_PARSE: + FEerror("Cannot parse an integer in the string ~S.", 1, strng); +@) + +@(defun read_byte (binary_input_stream + &optional eof_errorp eof_value) + int c; +@ + check_type_stream(&binary_input_stream); + if (stream_at_end(binary_input_stream)) { + if (eof_errorp == Cnil) + @(return eof_value) + else + end_of_stream(binary_input_stream); + } + c = readc_stream(binary_input_stream); + @(return `make_fixnum(c)`) +@) + +object +read_byte1(strm,eof) +object strm,eof; +{ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + if (stream_at_end(strm)) + return eof; + return make_fixnum(readc_stream(strm)); +} + +object +read_char1(strm,eof) +object strm,eof; +{ + if (strm == Cnil) + strm = symbol_value(sLAstandard_inputA); + else if (strm == Ct) + strm = symbol_value(sLAterminal_ioA); + if (stream_at_end(strm)) + return eof; + return code_char(readc_stream(strm)); +} + + @(defun copy_readtable (&optional (from `current_readtable()`) to) +@ + if (from == Cnil) { + from = standard_readtable; + if (to != Cnil) + check_type_readtable(&to); + to = copy_readtable(from, to); + to->rt.rt_self['#'].rte_dtab['!'] + = default_dispatch_macro; + /* We must forget #! macro. */ + @(return to) + } + check_type_readtable(&from); + if (to != Cnil) + check_type_readtable(&to); + @(return `copy_readtable(from, to)`) +@) + +LFD(Lreadtablep)() +{ + check_arg(1); + + if (type_of(vs_base[0]) == t_readtable) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +@(defun set_syntax_from_char (tochr fromchr + &optional (tordtbl `current_readtable()`) + fromrdtbl) + int i; +@ + check_type_character(&tochr); + check_type_character(&fromchr); + check_type_readtable(&tordtbl); + {BEGIN_NO_INTERRUPT; + if (fromrdtbl == Cnil) + fromrdtbl = standard_readtable; + else + check_type_readtable(&fromrdtbl); + tordtbl->rt.rt_self[char_code(tochr)].rte_chattrib + = fromrdtbl->rt.rt_self[char_code(fromchr)].rte_chattrib; + tordtbl->rt.rt_self[char_code(tochr)].rte_macro + = fromrdtbl->rt.rt_self[char_code(fromchr)].rte_macro; + if ((tordtbl->rt.rt_self[char_code(tochr)].rte_dtab + = fromrdtbl->rt.rt_self[char_code(fromchr)].rte_dtab) + != NULL) { + tordtbl->rt.rt_self[char_code(tochr)].rte_dtab + = (object *) + alloc_contblock(RTABSIZE * sizeof(object)); + for (i = 0; i < RTABSIZE; i++) + tordtbl->rt.rt_self[char_code(tochr)] + .rte_dtab[i] + = fromrdtbl->rt.rt_self[char_code(fromchr)] + .rte_dtab[i]; + } + END_NO_INTERRUPT;} + @(return Ct) +@) + +@(defun set_macro_character (chr fnc + &optional ntp + (rdtbl `current_readtable()`)) + int c; +@ + check_type_character(&chr); + check_type_readtable(&rdtbl); + c = char_code(chr); + if (ntp != Cnil) + rdtbl->rt.rt_self[c].rte_chattrib + = cat_non_terminating; + else + rdtbl->rt.rt_self[c].rte_chattrib + = cat_terminating; + rdtbl->rt.rt_self[c].rte_macro = fnc; + SGC_TOUCH(rdtbl); + @(return Ct) +@) + +@(defun get_macro_character (chr &optional (rdtbl `current_readtable()`)) + object m; +@ + check_type_character(&chr); + check_type_readtable(&rdtbl); + if ((m = rdtbl->rt.rt_self[char_code(chr)].rte_macro) + == OBJNULL) + @(return Cnil) + if (rdtbl->rt.rt_self[char_code(chr)].rte_chattrib + == cat_non_terminating) + @(return m Ct) + else + @(return m Cnil) +@) + +@(static defun make_dispatch_macro_character (chr + &optional ntp (rdtbl `current_readtable()`)) + int i; +@ + check_type_character(&chr); + check_type_readtable(&rdtbl); + {BEGIN_NO_INTERRUPT; + if (ntp != Cnil) + rdtbl->rt.rt_self[char_code(chr)].rte_chattrib + = cat_non_terminating; + else + rdtbl->rt.rt_self[char_code(chr)].rte_chattrib + = cat_terminating; + rdtbl->rt.rt_self[char_code(chr)].rte_dtab + = (object *) + alloc_contblock(RTABSIZE * sizeof(object)); + for (i = 0; i < RTABSIZE; i++) + rdtbl->rt.rt_self[char_code(chr)].rte_dtab[i] + = default_dispatch_macro; + rdtbl->rt.rt_self[char_code(chr)].rte_macro = dispatch_reader; + END_NO_INTERRUPT;} + @(return Ct) +@) + +@(static defun set_dispatch_macro_character (dspchr subchr fnc + &optional (rdtbl `current_readtable()`)) +@ + check_type_character(&dspchr); + check_type_character(&subchr); + check_type_readtable(&rdtbl); + if (rdtbl->rt.rt_self[char_code(dspchr)].rte_macro != dispatch_reader + || rdtbl->rt.rt_self[char_code(dspchr)].rte_dtab == NULL) + FEerror("~S is not a dispatch character.", 1, dspchr); + rdtbl->rt.rt_self[char_code(dspchr)] + .rte_dtab[char_code(subchr)] = fnc; + if ('a' <= char_code(subchr) && char_code(subchr) <= 'z') + rdtbl->rt.rt_self[char_code(dspchr)] + .rte_dtab[char_code(subchr) - ('a' - 'A')] = fnc; + + @(return Ct) +@) + +DEFUN_NEW("READTABLE-CASE",object,fLreadtable_case,LISP,1,1,NONE,OO,OO,OO,OO,(object rt),"") { + check_type_readtable_no_default(&rt); + RETURN1(rt->rt.rt_case); +} + +DEFUN_NEW("SET-READTABLE-CASE",object,fSset_readtable_case,SI,2,2,NONE,OO,OO,OO,OO,(object rt,object cas),"") { + check_type_readtable_no_default(&rt); + if (cas!=sKupcase && cas!=sKdowncase && cas!=sKpreserve && cas!=sKinvert) + TYPE_ERROR(cas,list(5,sLmember,sKupcase,sKdowncase,sKpreserve,sKinvert)); + RETURN1(rt->rt.rt_case=cas); +} + +@(static defun get_dispatch_macro_character (dspchr subchr + &optional (rdtbl `current_readtable()`)) +@ + check_type_character(&dspchr); + check_type_character(&subchr); + check_type_readtable(&rdtbl); + if (rdtbl->rt.rt_self[char_code(dspchr)].rte_macro != dispatch_reader + || rdtbl->rt.rt_self[char_code(dspchr)].rte_dtab == NULL) + FEerror("~S is not a dispatch character.", 1, dspchr); + if (digitp(char_code(subchr),10) >= 0) @(return Cnil) + else { + object x=rdtbl->rt.rt_self[char_code(dspchr)].rte_dtab[char_code(subchr)]; + @(return `x==default_dispatch_macro ? Cnil : x`) + } +@) + +static object +string_to_object(x) +object x; +{ + object in; + vs_mark; + + in = fSmake_string_input_stream_int(x, 0, x->st.st_fillp); + vs_push(in); + preserving_whitespace_flag = FALSE; + detect_eos_flag = FALSE; + x = read_object_non_recursive(in); + vs_reset; + return(x); +} + +LFD(siLstring_to_object)() +{ + check_arg(1); + + check_type_string(&vs_base[0]); + vs_base[0] = string_to_object(vs_base[0]); +} + + +static void +FFN(siLstandard_readtable)() +{ + check_arg(0); + + vs_push(standard_readtable); +} + +static void +extra_argument(c) +int c; +{ + FEerror("~S is an extra argument for the #~C readmacro.", + 2, vs_base[2], code_char(c)); +} + + +#define make_cf(f) make_cfun((f), Cnil, Cnil, NULL, 0) + +DEFVAR("*READ-DEFAULT-FLOAT-FORMAT*",sLAread_default_float_formatA, + LISP,sLsingle_float,""); +DEFVAR("*READ-BASE*",sLAread_baseA,LISP,make_fixnum(10),""); +DEFVAR("*READ-SUPPRESS*",sLAread_suppressA,LISP,Cnil,""); + + +void +gcl_init_read() +{ + struct rtent *rtab; + object *dtab; + int i; + + standard_readtable = alloc_object(t_readtable); + enter_mark_origin(&standard_readtable); + + standard_readtable->rt.rt_self + = rtab + = (struct rtent *) + alloc_contblock(RTABSIZE * sizeof(struct rtent)); + for (i = 0; i < RTABSIZE; i++) { + rtab[i].rte_chattrib = cat_constituent; + rtab[i].rte_macro = OBJNULL; + rtab[i].rte_dtab = NULL; + } + + dispatch_reader = make_cf(Ldispatch_reader); + enter_mark_origin(&dispatch_reader); + + rtab['\t'].rte_chattrib = cat_whitespace; + rtab['\n'].rte_chattrib = cat_whitespace; + rtab['\f'].rte_chattrib = cat_whitespace; + rtab['\r'].rte_chattrib = cat_whitespace; + rtab[' '].rte_chattrib = cat_whitespace; + rtab['"'].rte_chattrib = cat_terminating; + rtab['"'].rte_macro = make_cf(Ldouble_quote_reader); + rtab['#'].rte_chattrib = cat_non_terminating; + rtab['#'].rte_macro = dispatch_reader; + rtab['\''].rte_chattrib = cat_terminating; + rtab['\''].rte_macro = make_cf(Lsingle_quote_reader); + rtab['('].rte_chattrib = cat_terminating; + rtab['('].rte_macro = make_cf(Lleft_parenthesis_reader); + rtab[')'].rte_chattrib = cat_terminating; + rtab[')'].rte_macro = make_cf(Lright_parenthesis_reader); +/* + rtab[','].rte_chattrib = cat_terminating; + rtab[','].rte_macro = make_cf(Lcomma_reader); +*/ + rtab[';'].rte_chattrib = cat_terminating; + rtab[';'].rte_macro = make_cf(Lsemicolon_reader); + rtab['\\'].rte_chattrib = cat_single_escape; +/* + rtab['`'].rte_chattrib = cat_terminating; + rtab['`'].rte_macro = make_cf(Lbackquote_reader); +*/ + rtab['|'].rte_chattrib = cat_multiple_escape; +/* + rtab['|'].rte_macro = make_cf(Lvertical_bar_reader); +*/ + + default_dispatch_macro = make_cf(Ldefault_dispatch_macro); + + rtab['#'].rte_dtab + = dtab + = (object *)alloc_contblock(RTABSIZE * sizeof(object)); + for (i = 0; i < RTABSIZE; i++) + dtab[i] = default_dispatch_macro; + dtab['C'] = dtab['c'] = make_cf(Lsharp_C_reader); + dtab['\\'] = make_cf(Lsharp_backslash_reader); + dtab['\''] = make_cf(Lsharp_single_quote_reader); + dtab['('] = make_cf(Lsharp_left_parenthesis_reader); + dtab['*'] = make_cf(Lsharp_asterisk_reader); + dtab[':'] = make_cf(Lsharp_colon_reader); + dtab['.'] = make_cf(Lsharp_dot_reader); + dtab[','] = make_cf(Lsharp_comma_reader); + dtab['B'] = dtab['b'] = make_cf(Lsharp_B_reader); + dtab['O'] = dtab['o'] = make_cf(Lsharp_O_reader); + dtab['X'] = dtab['x'] = make_cf(Lsharp_X_reader); + dtab['R'] = dtab['r'] = make_cf(Lsharp_R_reader); +/* + dtab['A'] = dtab['a'] = make_cf(Lsharp_A_reader); + dtab['S'] = dtab['s'] = make_cf(Lsharp_S_reader); +*/ + dtab['A'] = dtab['a'] = make_si_ordinary("SHARP-A-READER"); + dtab['S'] = dtab['s'] = make_si_ordinary("SHARP-S-READER"); + + dtab['='] = make_si_ordinary("SHARP-EQ-READER"); + dtab['#'] = make_si_ordinary("SHARP-SHARP-READER"); + dtab['+'] = make_cf(Lsharp_plus_reader); + dtab['-'] = make_cf(Lsharp_minus_reader); +/* + dtab['<'] = make_cf(Lsharp_less_than_reader); +*/ + dtab['|'] = make_cf(Lsharp_vertical_bar_reader); + /* This is specific to this implimentation */ + dtab['$'] = make_cf(Lsharp_dollar_reader); + /* This is specific to this implimentation */ +/* + dtab[' '] = dtab['\t'] = dtab['\n'] = dtab['\f'] + = make_cf(Lsharp_whitespace_reader); + dtab[')'] = make_cf(Lsharp_right_parenthesis_reader); +*/ + + gcl_init_backq(); + + sKupcase = make_keyword("UPCASE"); + sKdowncase = make_keyword("DOWNCASE"); + sKpreserve = make_keyword("PRESERVE"); + sKinvert = make_keyword("INVERT"); + + standard_readtable->rt.rt_case=sKupcase; + + Vreadtable + = make_special("*READTABLE*", + copy_readtable(standard_readtable, Cnil)); + Vreadtable->s.s_dbind->rt.rt_self['#'].rte_dtab['!'] + = default_dispatch_macro; + /* We must forget #! macro. */ + + + sKstart = make_keyword("START"); + sKend = make_keyword("END"); + sKradix = make_keyword("RADIX"); + sKjunk_allowed = make_keyword("JUNK-ALLOWED"); + + READtable = symbol_value(Vreadtable); + enter_mark_origin(&READtable); + READdefault_float_format = 'F'; + READbase = 10; + READsuppress = FALSE; + + sSAsharp_eq_contextA->s.s_dbind=Cnil; + + siSsharp_comma = make_si_ordinary("#,"); + enter_mark_origin(&siSsharp_comma); + + delimiting_char = OBJNULL; + enter_mark_origin(&delimiting_char); + + detect_eos_flag = FALSE; + in_list_flag = FALSE; + dot_flag = FALSE; + +} + +void +gcl_init_read_function() +{ + make_function("READ", Lread); + make_function("READ-PRESERVING-WHITESPACE", + Lread_preserving_whitespace); + make_function("READ-DELIMITED-LIST", Lread_delimited_list); + make_function("READ-LINE", Lread_line); + make_function("READ-CHAR", Lread_char); + make_function("UNREAD-CHAR", Lunread_char); + make_function("PEEK-CHAR", Lpeek_char); + make_function("LISTEN", Llisten); + make_function("READ-CHAR-NO-HANG", Lread_char_no_hang); + make_function("CLEAR-INPUT", Lclear_input); + + make_function("PARSE-INTEGER", Lparse_integer); + + make_function("READ-BYTE", Lread_byte); + + make_function("COPY-READTABLE", Lcopy_readtable); + make_function("READTABLEP", Lreadtablep); + make_function("SET-SYNTAX-FROM-CHAR", Lset_syntax_from_char); + make_function("SET-MACRO-CHARACTER", Lset_macro_character); + make_function("GET-MACRO-CHARACTER", Lget_macro_character); + make_function("MAKE-DISPATCH-MACRO-CHARACTER", + Lmake_dispatch_macro_character); + make_function("SET-DISPATCH-MACRO-CHARACTER", + Lset_dispatch_macro_character); + make_function("GET-DISPATCH-MACRO-CHARACTER", + Lget_dispatch_macro_character); + + make_si_function("SHARP-COMMA-READER-FOR-COMPILER", + siLsharp_comma_reader_for_compiler); + + make_si_function("STRING-TO-OBJECT", siLstring_to_object); + + make_si_function("STANDARD-READTABLE", siLstandard_readtable); +} + +object sSPinit; + +/* object */ +/* read_fasl_vector1(in) */ +/* object in; */ +/* { */ +/* int dimcount, dim; */ +/* VOL object *vsp; */ +/* object vspo; */ +/* VOL object x; */ +/* long i; */ +/* bool e; */ +/* object old_READtable; */ +/* int old_READdefault_float_format; */ +/* int old_READbase; */ +/* int old_READsuppress; */ +/* volatile object old_READcontext; */ +/* int old_backq_level; */ + +/* /\* to prevent longjmp clobber *\/ */ +/* i=(long)&vsp; */ +/* i+=i; */ +/* vsp=&vspo; */ +/* old_READtable = READtable; */ +/* old_READdefault_float_format = READdefault_float_format; */ +/* old_READbase = READbase; */ +/* old_READsuppress = READsuppress; */ +/* old_READcontext=sSAsharp_eq_contextA->s.s_dbind; */ +/* /\* BUG FIX by Toshiba *\/ */ +/* vs_push(old_READtable); */ +/* old_backq_level = backq_level; */ + +/* setup_standard_READ(); */ + +/* frs_push(FRS_PROTECT, Cnil); */ +/* if (nlj_active) { */ +/* e = TRUE; */ +/* goto L; */ +/* } */ + +/* while (readc_stream(in) != '#') */ +/* ; */ +/* while (readc_stream(in) != '(') */ +/* ; */ +/* vsp = vs_top; */ +/* dimcount = 0; */ +/* for (;;) { */ +/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ +/* backq_level = 0; */ +/* delimiting_char = code_char(')'); */ +/* preserving_whitespace_flag = FALSE; */ +/* detect_eos_flag = FALSE; */ +/* x = read_object(in); */ +/* if (x == OBJNULL) */ +/* break; */ +/* vs_check_push(x); */ +/* if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) */ +/* x = vs_head = patch_sharp(x); */ +/* dimcount++; */ +/* } */ +/* if(dimcount==1 && type_of(vs_head)==t_vector) */ +/* {/\* new style where all read at once *\/ */ +/* x=vs_head; */ +/* goto DONE;} */ +/* /\* old style separately sharped, and no %init *\/ */ +/* {BEGIN_NO_INTERRUPT; */ +/* x=alloc_simple_vector(dimcount,aet_object); */ +/* vs_push(x); */ +/* x->v.v_self */ +/* = (object *)alloc_relblock(dimcount * sizeof(object)); */ +/* END_NO_INTERRUPT;} */ +/* for (dim = 0; dim < dimcount; dim++) */ +/* {SGC_TOUCH(x); */ +/* x->cfd.cfd_self[dim] = vsp[dim];} */ + + +/* DONE: */ +/* e = FALSE; */ + +/* L: */ +/* frs_pop(); */ + +/* READtable = old_READtable; */ +/* READdefault_float_format = old_READdefault_float_format; */ +/* READbase = old_READbase; */ +/* READsuppress = old_READsuppress; */ +/* sSAsharp_eq_contextA->s.s_dbind=old_READcontext; */ +/* backq_level = old_backq_level; */ +/* if (e) { */ +/* nlj_active = FALSE; */ +/* unwind(nlj_fr, nlj_tag); */ +/* } */ +/* vs_top = (object *)vsp; */ +/* return(x); */ +/* } */ diff --git a/o/readme b/o/readme new file mode 100755 index 0000000..aeadd9f --- /dev/null +++ b/o/readme @@ -0,0 +1,16 @@ +Current scheme: + +All functions which used to start with siL or L have been replaced +by ones which pass arguments on the C stack. + +The special forms + +(eg Fprogn, Fsetq are still the same as before). + +Functions in the Lisp (resp Si package) are named +fL... (respectively fS...) and they all pass arguments on the C stack and return +multiple values, and have DEFUN's which specify their argd. + +eval still passes on the value stack +All functions beginning with I pass on C stack. +` diff --git a/o/reference.c b/o/reference.c new file mode 100755 index 0000000..476c029 --- /dev/null +++ b/o/reference.c @@ -0,0 +1,195 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + reference.c + + Reference in Constants and Variables +*/ + +#include "include.h" + +LFD(Lfboundp)(void) +{ + object sym; + + check_arg(1); + sym = vs_base[0]; + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL) + vs_base[0] = Ct; + else if (sym->s.s_gfdef == OBJNULL) + vs_base[0]= Cnil; + else + vs_base[0]= Ct; +} + +object +symbol_function(object sym) +{ +/* + if (type_of(sym) != t_symbol) + not_a_symbol(sym); +*/ + if (sym->s.s_sfdef != NOT_SPECIAL || sym->s.s_mflag) + FEinvalid_function(sym); + if (sym->s.s_gfdef == OBJNULL) + FEundefined_function(sym); + return(sym->s.s_gfdef); +} + +/* + Symbol-function returns + function-closure for function + (macro . function-closure) for macros + (special . address) for special forms. +*/ +LFD(Lsymbol_function)(void) +{ + object sym; + + check_arg(1); + sym = vs_base[0]; + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL) { + vs_base[0]=make_cons(sLspecial,make_fixnum((long)(sym->s.s_sfdef))); + return; + } + if (sym->s.s_gfdef==OBJNULL) + FEundefined_function(sym); + if (sym->s.s_mflag) { + vs_base[0]=make_cons(sSmacro,sym->s.s_gfdef); + return; + } + vs_base[0] = sym->s.s_gfdef; +} + +static void +FFN(Fquote)(object form) +{ + + if (endp(form)) + FEtoo_few_argumentsF(form); + if (!endp(MMcdr(form))) + FEtoo_many_argumentsF(form); + vs_base = vs_top; + vs_push(MMcar(form)); +} + +static void +FFN(Ffunction)(object form) +{ + + object fun; + object fd; + if (endp(form)) + FEtoo_few_argumentsF(form); + if (!endp(MMcdr(form))) + FEtoo_many_argumentsF(form); + fun = MMcar(form); + if (type_of(fun) == t_symbol) { + fd = lex_fd_sch(fun); + if (MMnull(fd) || MMcadr(fd) != sLfunction) + if (fun->s.s_gfdef == OBJNULL || fun->s.s_mflag) + FEundefined_function(fun); + else { + vs_base = vs_top; + vs_push(fun->s.s_gfdef); + } + else { + vs_base = vs_top; + vs_push(MMcaddr(fd)); + } + } else if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) { + vs_base = vs_top; + vs_push(MMcdr(fun)); + vs_base[0] = MMcons(lex_env[2], vs_base[0]); + vs_base[0] = MMcons(lex_env[1], vs_base[0]); + vs_base[0] = MMcons(lex_env[0], vs_base[0]); + vs_base[0] = MMcons(sSlambda_closure, vs_base[0]); + } else + FEinvalid_function(fun); +} + +LFD(Lsymbol_value)(void) +{ + object sym; + check_arg(1); + sym = vs_base[0]; + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_dbind == OBJNULL) + FEunbound_variable(sym); + else + vs_base[0] = sym->s.s_dbind; +} + +LFD(Lboundp)(void) +{ + object sym; + check_arg(1); + sym=vs_base[0]; + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_dbind == OBJNULL) + vs_base[0] = Cnil; + else + vs_base[0] = Ct; +} + +LFD(Lmacro_function)(void) +{ + check_arg(1); + if (type_of(vs_base[0]) != t_symbol) + not_a_symbol(vs_base[0]); + if (vs_base[0]->s.s_gfdef != OBJNULL && vs_base[0]->s.s_mflag) + vs_base[0] = vs_base[0]->s.s_gfdef; + else + vs_base[0] = Cnil; +} + +LFD(Lspecial_operator_p)(void) +{ + check_arg(1); + if (type_of(vs_base[0]) != t_symbol) + not_a_symbol(vs_base[0]); + if (vs_base[0]->s.s_sfdef != NOT_SPECIAL) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +void +gcl_init_reference(void) +{ + make_function("SYMBOL-FUNCTION", Lsymbol_function); + make_function("FBOUNDP", Lfboundp); + sLquote=make_special_form("QUOTE", Fquote); + sLfunction = make_special_form("FUNCTION", Ffunction); + make_function("SYMBOL-VALUE", Lsymbol_value); + make_function("BOUNDP", Lboundp); + make_function("MACRO-FUNCTION", Lmacro_function); + make_function("SPECIAL-OPERATOR-P", Lspecial_operator_p); +} + diff --git a/o/regexp.c b/o/regexp.c new file mode 100755 index 0000000..60ac4e9 --- /dev/null +++ b/o/regexp.c @@ -0,0 +1,1551 @@ +/* original regexp.c file written by Henry Spencer. + many changes made [see below] made by W. Schelter. + These changes Copyright (c) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + + Various enhancements made by William Schelter when converting + for use by GCL: + 1) allow case_fold_search: If this variable is not nil, + then 'a' and 'A' are considered equivalent. + 2) Various speed ups, useful when searching a long string + [eg body of a file etc.] + Timings searching a 47k byte file for patterns + + The following table shows how many times longer it took the original + implementation, to search for a given pattern. Comparison is also + made with the re-search-forward function of gnu emacs. For example + in searching for the pattern 'not_there' the search took 20 times + longer in the original implementation, and about the same time in gnu + emacs. + + Pattern: current original gnu emacs + not_there 1 20 1 + not_there|really_not 1 200 30 + not_there|really_not|how is[a-z] 1 115 15 + not_there|really_not|how is[a-z]y 1 30 4 + [a-u]bcdex 1 194 60 + a.bcde 1 10 7.5 + + of a character. + 3). Allow string length to be specified, and string not null + terminated. If length specified as zero, string assumed null + terminated. If string NOT null terminated, then string area + must be writable (commonly strings in non writable area are + already null terminated..). + + To do: 1)Still lots of improvement possible: eg the pattern + x[^x]*nice_pattern, should be searched for by doing search + for nice_pattern, and then backing up. To do easily requires + backward search. eg: "FRONT TAIL" search for TAIL and then + search back for "FRONT $" + 2) do backward search. + + +*/ +#include +#include "string.h" +#include "regexp.h" + +static int +min_initial_branch_length(regexp *, unsigned char *, int); + + +/* + * The "internal use only" fields in regexp.h are present to pass info from + * compile to execute that permits the execute phase to run lots faster on + * simple cases. They are: + * + * regstart char that must begin a match; '\0' if none obvious + * reganch is the match anchored (at beginning-of-line only)? + * regmust string (pointer into program) that match must include, or NULL + * regmlen length of regmust string + * + * Regstart and reganch permit very fast decisions on suitable starting points + * for a match, cutting down the work a lot. Regmust permits fast rejection + * of lines that cannot possibly match. The regmust tests are costly enough + * that regcomp() supplies a regmust only if the r.e. contains something + * potentially expensive (at present, the only such thing detected is * or + + * at the start of the r.e., which can involve a lot of backup). Regmlen is + * supplied because the test in regexec() needs it and regcomp() is + * computing it anyway. + */ + +/* + * Structure for regexp "program". This is essentially a linear encoding + * of a nondeterministic finite-state machine (aka syntax charts or + * "railroad normal form" in parsing technology). Each node is an opcode + * plus a "next" pointer, possibly plus an operand. "Next" pointers of + * all nodes except BRANCH implement concatenation; a "next" pointer with + * a BRANCH on both ends of it is connecting two alternatives. (Here we + * have one of the subtle syntax dependencies: an individual BRANCH (as + * opposed to a collection of them) is never concatenated with anything + * because of operator precedence.) The operand of some types of node is + * a literal string; for others, it is a node leading into a sub-FSM. In + * particular, the operand of a BRANCH node is the first node of the branch. + * (NB this is *not* a tree structure: the tail of the branch connects + * to the thing following the set of BRANCHes.) The opcodes are: + */ + +/* definition number opnd? meaning */ +#define END 0 /* no End of program. */ +#define BOL 1 /* no Match "" at beginning of line. */ +#define EOL 2 /* no Match "" at end of line. */ +#define ANY 3 /* no Match any one character. */ +#define ANYOF 4 /* str Match any character in this string. */ +#define ANYBUT 5 /* str Match any character not in this string. */ +#define BRANCH 6 /* node Match this alternative, or the next... */ +#define BACK 7 /* no Match "", "next" ptr points backward. */ +#define EXACTLY 8 /* str Match this string. */ +#define NOTHING 9 /* no Match empty string. */ +#define STAR 10 /* node Match this (simple) thing 0 or more times. */ +#define PLUS 11 /* node Match this (simple) thing 1 or more times. */ +#define OPEN 20 /* no Mark this point in input as start of #n. */ + /* OPEN+1 is number 1, etc. */ +#define CLOSE (OPEN+NSUBEXP) /* no Analogous to OPEN. */ + +/* + * Opcode notes: + * + * BRANCH The set of branches constituting a single choice are hooked + * together with their "next" pointers, since precedence prevents + * anything being concatenated to any individual branch. The + * "next" pointer of the last BRANCH in a choice points to the + * thing following the whole choice. This is also where the + * final "next" pointer of each individual branch points; each + * branch starts with the operand node of a BRANCH node. + * + * BACK Normal "next" pointers all implicitly point forward; BACK + * exists to make loop structures possible. + * + * STAR,PLUS '?', and complex '*' and '+', are implemented as circular + * BRANCH structures using BACK. Simple cases (one character + * per match) are implemented with STAR and PLUS for speed + * and to minimize recursive plunges. + * + * OPEN,CLOSE ...are numbered at compile time. + */ + +/* + * A node is one char of opcode followed by two chars of "next" pointer. + * "Next" pointers are stored as two 8-bit pieces, high order first. The + * value is a positive offset from the opcode of the node containing it. + * An operand, if any, simply follows the node. (Note that much of the + * code generation knows about this implicit relationship.) + * + * Using two bytes for the "next" pointer is vast overkill for most things, + * but allows patterns to get big without disasters. + */ +#define OP(p) (*(p)) +#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377)) +#define OPERAND(p) ((p) + 3) + +/* + * See regmagic.h for one further detail of program structure. + */ + + +/* + * Utility definitions. + */ +#ifndef CHARBITS +#define UCHARAT(p) ((int)*(unsigned char *)(p)) +#else +#define UCHARAT(p) ((int)*(p)&CHARBITS) +#endif + +#define FAIL(m) { regerror(m); return(NULL); } +#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?') +#undef META +#define META "^$.[()|?+*\\" + +/* + * Flags to be passed up and down. + */ +#define HASWIDTH 01 /* Known never to match null string. */ +#define SIMPLE 02 /* Simple enough to be STAR/PLUS operand. */ +#define SPSTART 04 /* Starts with * or +. */ +#define WORST 0 /* Worst case. */ + +/* + * Global work variables for regcomp(). + */ +static char *regparse; /* Input-scan pointer. */ +static int regnpar; /* () count. */ +static char regdummy; +static char *regcode; /* Code-emit pointer; ®dummy = don't. */ +static long regsize; /* Code size. */ + +/* + * The first byte of the regexp internal "program" is actually this magic + * number; the start node begins in the second byte. + */ +#define MAGIC 0234 + +/* + * Forward declarations for regcomp()'s friends. + */ +#ifndef STATIC +#define STATIC static +#endif +STATIC char *reg(int paren, int *flagp); +STATIC char *regbranch(int *flagp); +STATIC char *regpiece(int *flagp); +STATIC char *regatom(int *flagp); +STATIC char *regnode(char op); +STATIC char *regnext(register char *p); +STATIC void regc(char b); +STATIC void reginsert(char op, char *opnd); +STATIC void regtail(char *p, char *val); +STATIC void regoptail(char *p, char *val); + +int case_fold_search = 0; +/* + - regcomp - compile a regular expression into internal code + * + * We can't allocate space until we know how big the compiled form will be, + * but we can't compile it (and thus know how big it is) until we've got a + * place to put the code. So we cheat: we compile it twice, once with code + * generation turned off and size counting turned on, and once "for real". + * This also means that we don't allocate space until we are sure that the + * thing really will compile successfully, and we never have to move the + * code and thus invalidate pointers into it. (Note that it has to be in + * one piece because free() must be able to free it all.) + * + * Beware that the optimization-preparation code in here knows about some + * of the structure of the compiled regexp. + */ +static regexp * +regcomp(char *exp,ufixnum *sz) +{ + register regexp *r; + register char *scan; + register char *longest; + register int len; + int flags; + + if (exp == NULL) + FAIL("NULL argument"); + + /* First pass: determine size, legality. */ + regparse = exp; + regnpar = 1; + regsize = 0L; + regcode = ®dummy; + regc(MAGIC); + if (reg(0, &flags) == NULL) + return(NULL); + + /* Small enough for pointer-storage convention? */ + if (regsize >= 32767L) /* Probably could be 65535L. */ + FAIL("regexp too big"); + + /* Allocate space. */ + *sz=sizeof(regexp) + (unsigned)regsize; + r = (regexp *)alloc_relblock(*sz); + if (r == NULL) + FAIL("out of space"); + + /* Second pass: emit code. */ + regparse = exp; + regnpar = 1; + regcode = r->program; + regc(MAGIC); + if (reg(0, &flags) == NULL) + return(NULL); + + /* Dig out information for optimizations. */ + r->regstart = '\0'; /* Worst-case defaults. */ + r->reganch = 0; + r->regmust = NULL; + r->regmlen = 0; + r->regmaybe_boyer =0; + scan = r->program+1; /* First BRANCH. */ + if (0&& OP(regnext(scan)) == END) { /* Only one top-level choice. */ + scan = OPERAND(scan); + + /* Starting-point info. */ + if (OP(scan) == EXACTLY) + {r->regstart = *OPERAND(scan); + r->regmaybe_boyer = strlen(OPERAND(scan));} + else if (OP(scan) == BOL) + r->reganch++; + + + /* + * If there's something expensive in the r.e., find the + * longest literal string that must appear and make it the + * regmust. Resolve ties in favor of later strings, since + * the regstart check works with the beginning of the r.e. + * and avoiding duplication strengthens checking. Not a + * strong reason, but sufficient in the absence of others. + */ + if (flags&SPSTART) { + longest = NULL; + len = 0; + for (; scan != NULL; scan = regnext(scan)) + if (OP(scan) == EXACTLY && ((int) strlen(OPERAND(scan))) >= len) { + longest = OPERAND(scan); + len = strlen(OPERAND(scan)); + } + r->regmust = longest; + r->regmlen = len; + } + } + else { r->regmaybe_boyer = min_initial_branch_length(r,0,0);} + + + return(r); +} + +/* + - reg - regular expression, i.e. main body or parenthesized thing + * + * Caller must absorb opening parenthesis. + * + * Combining parenthesis handling with the base level of regular expression + * is a trifle forced, but the need to tie the tails of the branches to what + * follows makes it hard to avoid. + */ +static char * +reg(int paren, int *flagp) + /* Parenthesized? */ + +{ + register char *ret; + register char *br; + register char *ender; + register int parno = 0; + int flags; + + *flagp = HASWIDTH; /* Tentatively. */ + + /* Make an OPEN node, if parenthesized. */ + if (paren) { + if (regnpar >= NSUBEXP) + FAIL("too many ()"); + parno = regnpar; + regnpar++; + ret = regnode(OPEN+parno); + } else + ret = NULL; + + /* Pick up the branches, linking them together. */ + br = regbranch(&flags); + if (br == NULL) + return(NULL); + if (ret != NULL) + regtail(ret, br); /* OPEN -> first. */ + else + ret = br; + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + while (*regparse == '|') { + regparse++; + br = regbranch(&flags); + if (br == NULL) + return(NULL); + regtail(ret, br); /* BRANCH -> BRANCH. */ + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + } + + /* Make a closing node, and hook it on the end. */ + ender = regnode((paren) ? CLOSE+parno : END); + regtail(ret, ender); + + /* Hook the tails of the branches to the closing node. */ + for (br = ret; br != NULL; br = regnext(br)) + regoptail(br, ender); + + /* Check for proper termination. */ + if (paren && *regparse++ != ')') { + FAIL("unmatched ()"); + } else if (!paren && *regparse != '\0') { + if (*regparse == ')') { + FAIL("unmatched ()"); + } else + FAIL("junk on end"); /* "Can't happen". */ + /* NOTREACHED */ + } + + return(ret); +} + +/* + - regbranch - one alternative of an | operator + * + * Implements the concatenation operator. + */ +static char * +regbranch(int *flagp) +{ + register char *ret; + register char *chain; + register char *latest; + int flags; + + *flagp = WORST; /* Tentatively. */ + + ret = regnode(BRANCH); + chain = NULL; + while (*regparse != '\0' && *regparse != '|' && *regparse != ')') { + latest = regpiece(&flags); + if (latest == NULL) + return(NULL); + *flagp |= flags&HASWIDTH; + if (chain == NULL) /* First piece. */ + *flagp |= flags&SPSTART; + else + regtail(chain, latest); + chain = latest; + } + if (chain == NULL) /* Loop ran zero times. */ + (void) regnode(NOTHING); + + return(ret); +} + +/* + - regpiece - something followed by possible [*+?] + * + * Note that the branching code sequences used for ? and the general cases + * of * and + are somewhat optimized: they use the same NOTHING node as + * both the endmarker for their branch list and the body of the last branch. + * It might seem that this node could be dispensed with entirely, but the + * endmarker role is not redundant. + */ +static char * +regpiece(int *flagp) +{ + register char *ret; + register char op; + register char *next; + int flags; + + ret = regatom(&flags); + if (ret == NULL) + return(NULL); + + op = *regparse; + if (!ISMULT(op)) { + *flagp = flags; + return(ret); + } + + if (!(flags&HASWIDTH) && op != '?') + FAIL("*+ operand could be empty"); + *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH); + + if (op == '*' && (flags&SIMPLE)) + reginsert(STAR, ret); + else if (op == '*') { + /* Emit x* as (x&|), where & means "self". */ + reginsert(BRANCH, ret); /* Either x */ + regoptail(ret, regnode(BACK)); /* and loop */ + regoptail(ret, ret); /* back */ + regtail(ret, regnode(BRANCH)); /* or */ + regtail(ret, regnode(NOTHING)); /* null. */ + } else if (op == '+' && (flags&SIMPLE)) + reginsert(PLUS, ret); + else if (op == '+') { + /* Emit x+ as x(&|), where & means "self". */ + next = regnode(BRANCH); /* Either */ + regtail(ret, next); + regtail(regnode(BACK), ret); /* loop back */ + regtail(next, regnode(BRANCH)); /* or */ + regtail(ret, regnode(NOTHING)); /* null. */ + } else if (op == '?') { + /* Emit x? as (x|) */ + reginsert(BRANCH, ret); /* Either x */ + regtail(ret, regnode(BRANCH)); /* or */ + next = regnode(NOTHING); /* null. */ + regtail(ret, next); + regoptail(ret, next); + } + regparse++; + if (ISMULT(*regparse)) + FAIL("nested *?+"); + + return(ret); +} + +/* + - regatom - the lowest level + * + * Optimization: gobbles an entire sequence of ordinary characters so that + * it can turn them into a single node, which is smaller to store and + * faster to run. Backslashed characters are exceptions, each becoming a + * separate node; the code is simpler that way and it's not worth fixing. + */ +static char * +regatom(int *flagp) +{ + register char *ret; + int flags; + + *flagp = WORST; /* Tentatively. */ + + switch (*regparse++) { + case '^': + ret = regnode(BOL); + break; + case '$': + ret = regnode(EOL); + break; + case '.': + ret = regnode(ANY); + *flagp |= HASWIDTH|SIMPLE; + break; + case '[': {char buf[1000]; + char result[256]; + char *regcp=buf; + int matches = 1; +#define REGC(x) (*regcp++ = (x)) + { + register int clss; + register int classend; + ret = regnode(ANYOF); + + if (*regparse == '^') { /* Complement of range. */ + matches = 0; + regparse++;} + if (*regparse == ']' || *regparse == '-') + REGC(*regparse++); + while (*regparse != '\0' && *regparse != ']') { + if (*regparse == '-') { + regparse++; + if (*regparse == ']' || *regparse == '\0') + REGC('-'); + else { + clss = UCHARAT(regparse-2)+1; + classend = UCHARAT(regparse); + if (clss > classend+1) + FAIL("invalid [] range"); + for (; clss <= classend; clss++) + REGC(clss); + regparse++; + } + } else + REGC(*regparse++); + } + REGC('\0'); + if (*regparse != ']') + FAIL("unmatched []"); + regparse++; + *flagp |= HASWIDTH|SIMPLE; + } + if (regcp - buf > sizeof(buf)) + { emsg("wow that is badly defined regexp.."); + do_gcl_abort();} + regcp --; + { char *p=buf; + + /* set default vals */ + p = result; + while (p < &result[sizeof(result)]) + *p++ = (!matches ); + + p = buf; + while (p < regcp) + { result[*(unsigned char *)p] = matches; + if (case_fold_search) + {result[tolower((int)*p)] = matches; + result[toupper((int)*p)] = matches; p++;} + else + result[*(unsigned char *)p++] = matches; + + } + p = result; + while (p < &result[sizeof(result)]) + { regc(*p++);}} + break; + } + case '(': + ret = reg(1, &flags); + if (ret == NULL) + return(NULL); + *flagp |= flags&(HASWIDTH|SPSTART); + break; + case '\0': + case '|': + case ')': + FAIL("internal urp"); /* Supposed to be caught earlier. */ + /* NOTREACHED */ + break; + case '?': + case '+': + case '*': + FAIL("?+* follows nothing"); + /* NOTREACHED */ + break; + case '\\': + if (*regparse == '\0') + FAIL("trailing \\"); + ret = regnode(EXACTLY); + regc(*regparse++); + regc('\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + default: { + register int len; + register char ender; + + regparse--; + len = strcspn(regparse, META); + if (len <= 0) + FAIL("internal disaster"); + ender = *(regparse+len); + if (len > 1 && ISMULT(ender)) + len--; /* Back off clear of ?+* operand. */ + *flagp |= HASWIDTH; + if (len == 1) + *flagp |= SIMPLE; + ret = regnode(EXACTLY); + while (len > 0) { + regc(*regparse++); + len--; + } + regc('\0'); + } + break; + } + + return(ret); +} + +/* + - regnode - emit a node + */ +static char * /* Location. */ +regnode(char op) +{ + register char *ret; + register char *ptr; + + ret = regcode; + if (ret == ®dummy) { + regsize += 3; + return(ret); + } + + ptr = ret; + *ptr++ = op; + *ptr++ = '\0'; /* Null "next" pointer. */ + *ptr++ = '\0'; + regcode = ptr; + + return(ret); +} + +/* + - regc - emit (if appropriate) a byte of code + */ +static void +regc(char b) +{ + if (regcode != ®dummy) + *regcode++ = b; + else + regsize++; +} + +/* + - reginsert - insert an operator in front of already-emitted operand + * + * Means relocating the operand. + */ +static void +reginsert(char op, char *opnd) +{ + register char *src; + register char *dst; + register char *place; + + if (regcode == ®dummy) { + regsize += 3; + return; + } + + src = regcode; + regcode += 3; + dst = regcode; + while (src > opnd) + *--dst = *--src; + + place = opnd; /* Op node, where operand used to be. */ + *place++ = op; + *place++ = '\0'; + *place++ = '\0'; +} + +/* + - regtail - set the next-pointer at the end of a node chain + */ +static void +regtail(char *p, char *val) +{ + register char *scan; + register char *temp; + register int offset; + + if (p == ®dummy) + return; + + /* Find last node. */ + scan = p; + for (;;) { + temp = regnext(scan); + if (temp == NULL) + break; + scan = temp; + } + + if (OP(scan) == BACK) + offset = scan - val; + else + offset = val - scan; + *(scan+1) = (offset>>8)&0377; + *(scan+2) = offset&0377; +} + +/* + - regoptail - regtail on operand of first argument; nop if operandless + */ +static void +regoptail(char *p, char *val) +{ + /* "Operandless" and "op != BRANCH" are synonymous in practice. */ + if (p == NULL || p == ®dummy || OP(p) != BRANCH) + return; + regtail(OPERAND(p), val); +} + +/* + * regexec and friends + */ + +/* + * Global work variables for regexec(). + */ +static char *reginput; /* String-input pointer. */ +static char *regbol; /* Beginning of input, for ^ check. */ +static char **regstartp; /* Pointer to startp array. */ +static char **regendp; /* Ditto for endp. */ + +/* + * Forwards. + */ +STATIC int regtry(regexp *prog, char *string); +STATIC int regmatch(char *prog); +STATIC int regrepeat(char *p); + +#ifdef DEBUG +int regnarrate = 0; +void regdump(); +STATIC char *regprop(); +#endif + +/* + - regexec - match a regexp against a string + PROG is the compiled regexp and STRING is the string one is searching in + and START is a pointer relative to STRING, to tell if a substring of the + original STRING is being passed. LENGTH can be 0 or the strlen(STRING). + If it is not 0 and is large, then a fast checking will be enabled. + + */ +static int +regexec(register regexp *prog, register char *string, char *start, int length) +{ + register char *s; + char saved,*savedp=NULL; + int value; + + /* Be paranoid... */ + if (prog == NULL || string == NULL) { + regerror("NULL parameter"); + return(0); + } + + /* Check validity of program. */ + if (UCHARAT(prog->program) != MAGIC) { + regerror("corrupted program"); + return(0); + } + + /* If there is a "must appear" string, look for it. */ + /* to do:fix this for case_fold_search, and also to detect + x[^x]*MUST pattern, searching for MUST, and then + backing up to the 'x'. The regmust thing is bad in + case of a long string. */ + if (0 && prog->regmust != NULL) { + s = string; + while ((s = strchr(s, prog->regmust[0])) != NULL) { + if (strncmp(s, prog->regmust, prog->regmlen) == 0) + break; /* Found it. */ + s++; + } + if (s == NULL) /* Not present. */ + return(0); + } + + /* null terminate string */ + if (length) + { savedp = &string[length]; + saved = *savedp; + if (saved) *savedp=0; + } + else saved=0; +#define RETURN_VAL(i) do {value=i; goto DO_RETURN;}while(0) + + /* Mark beginning of line for ^ . */ + regbol = start; + + /* Simplest case: anchored match need be tried only once. */ + if (prog->reganch) + RETURN_VAL(regtry(prog, string)); + + /* Messy cases: unanchored match. */ + s = string; + /* only do if long enough to warrant compile time + really length/prog->regmaybe_boyer > 1000 is + probably better (and >=2 !) + */ + if (length > 2 && prog->regmaybe_boyer>= 1) + { unsigned char buf[256]; + /* int advance= reg_compboyer(prog,buf); */ + int advance=prog->regmaybe_boyer; + + + + int amt; + unsigned char *s = (unsigned char *)string+ advance -1; + min_initial_branch_length(prog, buf,advance); + switch(advance) { + case 1: + while (1) + { if (buf[*s]==0) + { if (*s == 0) RETURN_VAL(0); + else + if (regtry(prog,(char *)s-(1-1))) RETURN_VAL(1);} + s++; } + RETURN_VAL(0); + + case 2: + while (length > 0) + { + amt = (buf[s[0]]); + if (amt == 0) + { + amt = buf[s[-1]]-1; + if (amt <=0) { + if (regtry(prog,(char *)s-(advance-1))) + RETURN_VAL(1); + else + amt =1; + } + } + s += amt; length -= amt; + } + RETURN_VAL(0); + case 3: + while (length > 0) + { amt = (buf[s[0]]); + if (amt == 0) + {amt = buf[s[-1]]-1; + if (amt <=0) + {amt = buf[s[-2]]-2; + if (amt <=0) + {if (regtry(prog,(char *)s-(advance-1))) RETURN_VAL(1); + else amt =1;}}} + s += amt; length -= amt;} + case 4: + while (length > 0) + { amt = (buf[s[0]]); + if (amt == 0) + {amt = buf[s[-1]]-1; + if (amt <=0) + {amt = buf[s[-2]]-2; + if (amt <=0) + {amt = buf[s[-3]]-3; + if (amt <=0) + {if (regtry(prog,(char *)s-(advance-1))) RETURN_VAL(1); + else amt =1;}}}} + s += amt; length -= amt;} + + default: + while (length > 0) + { amt = (buf[s[0]]); + if (amt == 0) + {amt = buf[s[-1]]-1; + if (amt <=0) + {amt = buf[s[-2]]-2; + if (amt <=0) + {amt = buf[s[-3]]-3; + if (amt <=0) + {amt = buf[s[-4]]-4; + if (amt <=0) + {if (regtry(prog,(char *)s-(advance-1))) RETURN_VAL(1); + else amt =1;}}}}} + s += amt; length -= amt;} + } + RETURN_VAL(0); + } + else + if (prog->regstart != '\0') + /* We know what char it must start with. */ + { if (case_fold_search) + {char ch = tolower((int)prog->regstart); + while (*s) + { if (tolower((int)*s)==ch) + {if (regtry(prog, s)) + RETURN_VAL(1);} + s++;}} + else + while ((s = strchr(s, prog->regstart)) != NULL) { + if (regtry(prog, s)) + RETURN_VAL(1); + s++; + } + } + else + /* We don't -- general case. */ + do { + if (regtry(prog, s)) + RETURN_VAL(1); + } while (*s++ != '\0'); + + /* Failure. */ + RETURN_VAL(0); + DO_RETURN: + if(saved) *savedp=saved; + return value; + +} + +#ifdef OLD_VERSION +reg_compboyer(r,buf) + regexp *r; + char *buf; +{ + char *scan; + scan = r->program+1; /* First BRANCH. */ + if (OP(regnext(scan)) == END) {/* Only one top-level choice. */ + scan = OPERAND(scan); + /* Starting-point info. */ +#define MIN(n,m) (n > m ? m : n) + if (OP(scan) == EXACTLY) + { char *op = OPERAND(scan); + char *p = buf; + int advance = strlen(op); + int i = 256; + if (advance > 255) advance = 255; + if (advance < 1) regerror("Impossible"); + while (--i >= 0) *p++ = advance; + i = advance; + p = op; + while (--i >= 0) + { if (case_fold_search) + { buf[tolower(*p)] = i; + buf[toupper(*p)] = i; + } + else buf[(*p)] = i; + p++; + + } + buf[0]=0; + return advance; + }} + regerror("Should be impossible"); + return 1; +} +#endif + +/* + - regtry - try match at specific point + */ +static int /* 0 failure, 1 success */ +regtry(regexp *prog, char *string) +{ + register int i; + register char **sp; + register char **ep; + + reginput = string; + regstartp = prog->startp; + regendp = prog->endp; + + sp = prog->startp; + ep = prog->endp; + for (i = NSUBEXP; i > 0; i--) { + *sp++ = NULL; + *ep++ = NULL; + } + if (regmatch(prog->program + 1)) { + prog->startp[0] = string; + prog->endp[0] = reginput; + return(1); + } else + return(0); +} + +/* + - regmatch - main matching routine + * + * Conceptually the strategy is simple: check to see whether the current + * node matches, call self recursively to see whether the rest matches, + * and then act accordingly. In practice we make some effort to avoid + * recursion, in particular by going through "ordinary" nodes (that don't + * need to know whether the rest of the match failed) by a loop instead of + * by recursion. + */ +static int /* 0 failure, 1 success */ +regmatch(char *prog) +{ + register char *scan; /* Current node. */ + char *next; /* Next node. */ + + scan = prog; +#ifdef DEBUG + if (scan != NULL && regnarrate) + emsg("%s(\n", regprop(scan)); +#endif + while (scan != NULL) { +#ifdef DEBUG + if (regnarrate) + emsg("%s...\n", regprop(scan)); +#endif + next = regnext(scan); + + switch (OP(scan)) { + case BOL: + if (reginput != regbol) + return(0); + break; + case EOL: + if (*reginput != '\0') + return(0); + break; + case ANY: + if (*reginput == '\0') + return(0); + reginput++; + break; + case EXACTLY: { + register char *opnd; + char * ch = reginput; + + opnd = OPERAND(scan); + if (case_fold_search) + while (*opnd ) + { if (tolower((int)*opnd) != tolower((int)*ch)) + return 0; + else { ch++; opnd++;}} + else + while (*opnd ) + { if (*opnd != *ch) + return 0; + else { ch++; opnd++;}} + /* a match */ + reginput += (opnd - OPERAND(scan)); + } + break; + case ANYOF: + if (*reginput == '\0' || + OPERAND(scan)[*(unsigned char *)reginput] == 0) + return(0); + reginput++; + break; + case ANYBUT: + if (*reginput == '\0' || + OPERAND(scan)[*(unsigned char *)reginput] != 0) + return(0); + reginput++; + break; + case NOTHING: + break; + case BACK: + break; + case OPEN+1 ... OPEN+NSUBEXP-1: + { + register int no; + register char *save; + + no = OP(scan) - OPEN; + save = reginput; + + if (regmatch(next)) { + /* + * Don't set startp if some later + * invocation of the same parentheses + * already has. + */ + if (regstartp[no] == NULL) + regstartp[no] = save; + return(1); + } else + return(0); + } + /* NOTREACHED */ + break; + case CLOSE+1 ... CLOSE+NSUBEXP-1: + { + register int no; + register char *save; + + no = OP(scan) - CLOSE; + save = reginput; + + if (regmatch(next)) { + /* + * Don't set endp if some later + * invocation of the same parentheses + * already has. + */ + if (regendp[no] == NULL) + regendp[no] = save; + return(1); + } else + return(0); + } + /* NOTREACHED */ + break; + case BRANCH: { + register char *save; + + if (OP(next) != BRANCH) /* No choice. */ + next = OPERAND(scan); /* Avoid recursion. */ + else { + do { + save = reginput; + if (regmatch(OPERAND(scan))) + return(1); + reginput = save; + scan = regnext(scan); + } while (scan != NULL && OP(scan) == BRANCH); + return(0); + /* NOTREACHED */ + } + } + /* NOTREACHED */ + break; + case STAR: + case PLUS: { + register char nextch; + register int no; + register char *save; + register int min; + + /* + * Lookahead to avoid useless match attempts + * when we know what character comes next. + */ + nextch = '\0'; + if (OP(next) == EXACTLY) + nextch = *OPERAND(next); + if (case_fold_search) + nextch = tolower((int)nextch); + min = (OP(scan) == STAR) ? 0 : 1; + save = reginput; + no = regrepeat(OPERAND(scan)); + while (no >= min) { + /* If it could work, try it. */ + if (nextch == '\0' || + *reginput == nextch + || (case_fold_search && + tolower((int)*reginput) == nextch)) + if (regmatch(next)) + return(1); + /* Couldn't or didn't -- back up. */ + no--; + reginput = save + no; + } + return(0); + } + /* NOTREACHED */ + break; + case END: + return(1); /* Success! */ + /* NOTREACHED */ + break; + default: + regerror("memory corruption"); + return(0); + /* NOTREACHED */ + break; + } + + scan = next; + } + + /* + * We get here only if there's trouble -- normally "case END" is + * the terminating point. + */ + regerror("corrupted pointers"); + return(0); +} + +/* + - regrepeat - repeatedly match something simple, report how many + */ +static int +regrepeat(char *p) +{ + register int count = 0; + register char *scan; + register char *opnd; + + scan = reginput; + opnd = OPERAND(p); + switch (OP(p)) { + case ANY: + count = strlen(scan); + scan += count; + break; + case EXACTLY: + { char ch = *opnd; + if (case_fold_search) + { ch = tolower((int)*opnd); + while (ch == tolower((int)*scan)) + { + count++; + scan++;}} + else + while (ch == *scan) { + count++; + scan++; + }} + break; + case ANYOF: + while (*scan != '\0' && + opnd[*(unsigned char *)scan] != 0) + { + count++; + scan++; + } + break; + case ANYBUT: + while (*scan != '\0' && + opnd[*(unsigned char *)scan] == 0) + { + count++; + scan++; + } + break; + default: /* Oh dear. Called inappropriately. */ + regerror("internal foulup"); + count = 0; /* Best compromise. */ + break; + } + reginput = scan; + + return(count); +} + +/* + - regnext - dig the "next" pointer out of a node + */ +static char * +regnext(register char *p) +{ + register int offset; + + if (p == ®dummy) + return(NULL); + + offset = NEXT(p); + if (offset == 0) + return(NULL); + + if (OP(p) == BACK) + return(p-offset); + else + return(p+offset); +} + +#ifdef DEBUG + +STATIC char *regprop(); + +/* + - regdump - dump a regexp onto stdout in vaguely comprehensible form + */ +void +regdump(r) +regexp *r; +{ + register char *s; + register char op = EXACTLY; /* Arbitrary non-END op. */ + register char *next; + + + s = r->program + 1; + while (op != END) { /* While that wasn't END last time... */ + op = OP(s); + printf("%2d%s", s-r->program, regprop(s)); /* Where, what. */ + next = regnext(s); + if (next == NULL) /* Next ptr. */ + printf("(0)"); + else + printf("(%d)", (s-r->program)+(next-s)); + s += 3; + if (op == ANYOF || op == ANYBUT) + { int i=-1; + while (i++ < 256) + if (s[i]) printf("%c",i); + s +=256; + } + + + else + if (op == EXACTLY) { + /* Literal string, where present. */ + while (*s != '\0') { + putchar(*s); + s++; + } + s++; + } + putchar('\n'); + } + + /* Header fields of interest. */ + if (r->regstart != '\0') + printf("start `%c' ", r->regstart); + if (r->reganch) + printf("anchored "); + if (r->regmust != NULL) + printf("must have \"%s\"", r->regmust); + printf("\n"); +} + +/* + - regprop - printable representation of opcode + */ +static char * +regprop(op) +char *op; +{ + register char *p; + static char buf[50]; + + (void) strcpy(buf, ":"); + + switch (OP(op)) { + case BOL: + p = "BOL"; + break; + case EOL: + p = "EOL"; + break; + case ANY: + p = "ANY"; + break; + case ANYOF: + p = "ANYOF"; + break; + case ANYBUT: + p = "ANYBUT"; + break; + case BRANCH: + p = "BRANCH"; + break; + case EXACTLY: + p = "EXACTLY"; + break; + case NOTHING: + p = "NOTHING"; + break; + case BACK: + p = "BACK"; + break; + case END: + p = "END"; + break; + case OPEN+1 ... OPEN+NSUBEXP-1: + sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN); + p = NULL; + break; + case CLOSE+1 ... CLOSE+NSUBEXP-1: + sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE); + p = NULL; + break; + case STAR: + p = "STAR"; + break; + case PLUS: + p = "PLUS"; + break; + default: + regerror("corrupted opcode"); + break; + } + if (p != NULL) + (void) strcat(buf, p); + return(buf); +} +#endif + +/* + * The following is provided for those people who do not have strcspn() in + * their C libraries. They should get off their butts and do something + * about it; at least one public-domain implementation of those (highly + * useful) string routines has been published on Usenet. + */ +/* + * strcspn - find length of initial segment of s1 consisting entirely + * of characters not from s2 + */ + +#ifdef NEVER_WE_PUT_IT_IN_LIB +size_t +strcspn(s1, s2) +char *s1; +char *s2; +{ + register char *scan1; + register char *scan2; + register int count; + + count = 0; + for (scan1 = s1; *scan1 != '\0'; scan1++) { + for (scan2 = s2; *scan2 != '\0';) /* ++ moved down. */ + if (*scan1 == *scan2++) + return(count); + count++; + } + return(count); +} +#endif +/* if min_initial_branch_length(prog,0,0) > 2 + it is possible to have an initial matching routine + This means that each toplevel branch has an initial segment of + characters which is at least 2 and which + */ + +#define MINIMIZE(loc,val) if (val < loc) loc=val +static int +min_initial_branch_length(regexp *x, unsigned char *buf, int advance) +{ char *s = x->program+1; + int overall = 10000; + int i= -1; + char *next ; + char op = EXACTLY; + int n = advance; + if (buf) + { buf[0]=0; + for (i=256; --i>0 ; ){buf[i]=n;}; + } + while(op != END) + { op = OP(s); + next = (s) + NEXT(s); + if (op != END && op != BRANCH) + do_gcl_abort(); + s = s+3; + { int this = 0; + int anythis =0; + int ok = 1; + char op ; + int i; + while (1) + { if (ok == 0) goto LEND; + AGAIN: + if(buf && n <= 0) {break;} + op = OP(s); + advance = n; + s = OPERAND(s); + if (op == EXACTLY) + { int m = strlen(s); + if (buf) + { char *ss = s; + n--; + while(1) + { if (case_fold_search) + {MINIMIZE(buf[tolower((int)*ss)],n); + MINIMIZE(buf[toupper((int)*ss)],n); + } + else + { MINIMIZE(buf[*(unsigned char *)ss],n);} + + ss++; + if (*ss==0 || n ==0) break; + --n;}} + else { + this += m + anythis; + anythis = 0;} + + s += m+1;} + else if (op == ANYOF) + { if (buf) + { --n; + for(i=256; --i>0;) + {if (s[i]) MINIMIZE(buf[i],n);}} + else + { + anythis += 1; + /* if this seems like a random choice of letters they + are and they are not */ + if (s['f']==0 || s['a']==0 ||s['y']==0 || s['v']==0) + { this += anythis; + anythis = 0; + }} + + s += 256;} + else if (op == ANY) + {if (buf) + { --n; + for(i=256; --i>0;) + { MINIMIZE(buf[i],n);}} + else + anythis += 1; + } + else if (op == PLUS) + { + ok = 0; goto AGAIN; + } + else + { + LEND: +#ifdef DEBUG + if (buf==0)printf("[Br=%d]",this); +#endif + if (overall > this) { overall = this;} + break;} + }} + s = next; + op = OP(s); + n = advance; + + } +#ifdef DEBUG + if (buf==0) printf("[overall=%d]\n",overall); +#endif + return overall; +} + +#ifndef regerror +void +regerror(char *s) +{ + emsg("regexp error %s\n", s); +} +#endif + diff --git a/o/regexp.h b/o/regexp.h new file mode 100755 index 0000000..8535654 --- /dev/null +++ b/o/regexp.h @@ -0,0 +1,29 @@ +#ifndef _REGEXP +#define _REGEXP 1 + +#define NSUBEXP 19 +typedef struct regexp { + char *startp[NSUBEXP]; + char *endp[NSUBEXP]; + char regstart; /* Internal use only. */ + char reganch; /* Internal use only. */ + char *regmust; /* Internal use only. */ + int regmlen; /* Internal use only. */ + unsigned char regmaybe_boyer; + char program[1]; /* Unwarranted chumminess with compiler. */ +} regexp; + +#if __STDC__ == 1 +#define _ANSI_ARGS_(x) x +#else +#define _ANSI_ARGS_(x) () +#endif + +/* extern regexp *regcomp _ANSI_ARGS_((char *exp)); */ +/* extern int regexec _ANSI_ARGS_((regexp *prog, char *string, char *start,int length )); */ +extern void regsub _ANSI_ARGS_((regexp *prog, char *source, char *dest)); +#ifndef regerror +extern void regerror _ANSI_ARGS_((char *msg)); +#endif + +#endif /* REGEXP */ diff --git a/o/regexpr.c b/o/regexpr.c new file mode 100755 index 0000000..4afb957 --- /dev/null +++ b/o/regexpr.c @@ -0,0 +1,193 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include +#include "include.h" +#include "page.h" + +#undef STATIC +#define regerror gcl_regerror +static void +gcl_regerror(char *s) +{ + FEerror("Regexp Error: ~a",1,make_simple_string(s)); +} +#undef endp +#include "regexp.c" +#define check_string(x) \ + if (type_of(x) != t_string) \ + not_a_string(x) + + +DEFVAR("*MATCH-DATA*",sSAmatch_dataA,SI,sLnil,""); +DEFVAR("*CASE-FOLD-SEARCH*",sSAcase_fold_searchA,SI,sLnil, + "Non nil means that a string-match should ignore case"); + +DEFUN_NEW("MATCH-BEGINNING",object,fSmatch_beginning,SI,1,1,NONE,OI,OO,OO,OO,(fixnum i), + "Returns the beginning of the I'th match from the previous STRING-MATCH, \ +where the 0th is for the whole regexp and the subsequent ones match parenthetical expressions. -1 is returned if there is no match, or if the *match-data* \ +vector is not a fixnum array.") +{ object v = sSAmatch_dataA->s.s_dbind; + if (type_of(v)==t_vector + && (v->v.v_elttype == aet_fix)) + RETURN1(make_fixnum(sSAmatch_dataA->s.s_dbind->fixa.fixa_self[i])); + RETURN1(make_fixnum(-1)); +} + +DEFUN_NEW("MATCH-END",object,fSmatch_end,SI,1,1,NONE,OI,OO,OO,OO,(fixnum i), + "Returns the end of the I'th match from the previous STRING-MATCH") +{ object v = sSAmatch_dataA->s.s_dbind; + if (type_of(v)==t_vector + && (v->v.v_elttype == aet_fix)) + RETURN1(make_fixnum(sSAmatch_dataA->s.s_dbind->fixa.fixa_self[i+NSUBEXP])); + RETURN1(make_fixnum(-1)); +} + +DEFUN_NEW("COMPILE-REGEXP",object,fScompile_regexp,SI,1,1,NONE,OO,OO,OO,OO,(object p), + "Provide handle to export pre-compiled regexp's to string-match") { + + char *tmp; + object res; + ufixnum i=0; + + if (type_of(p)!= t_string && type_of(p)!=t_symbol) + not_a_string_or_symbol(p); + + if (!(tmp=alloca(p->st.st_fillp+1))) + FEerror("out of C stack",0); + memcpy(tmp,p->st.st_self,p->st.st_fillp); + tmp[p->st.st_fillp]=0; + + res=alloc_object(t_vector); + res->v.v_displaced=Cnil; + res->v.v_hasfillp=1; + res->v.v_elttype=aet_uchar; + res->v.v_adjustable=0; + res->v.v_offset=0; + res->v.v_self=NULL; + if (!(res->v.v_self=(void *)regcomp(tmp,&i))) + FEerror("regcomp failure",0); + res->v.v_fillp=res->v.v_dim=i; + + RETURN1(res); + +} + + +DEFUN_NEW("STRING-MATCH",object,fSstring_match,SI,2,4,NONE,OO,OO,OO,OO,(object pattern,object string,...), + "Match regexp PATTERN in STRING starting in string starting at START \ +and ending at END. Return -1 if match not found, otherwise \ +return the start index of the first matchs. The variable \ +*MATCH-DATA* will be set to a fixnum array of sufficient size to hold \ +the matches, to be obtained with match-beginning and match-end. \ +If it already contains such an array, then the contents of it will \ +be over written. \ +") { + + int i,ans,nargs=VFUN_NARGS,len,start,end; + static char buf[400],case_fold; + static regexp *saved_compiled_regexp; + va_list ap; + object v = sSAmatch_dataA->s.s_dbind; + char **pp,*str,save_c=0; + + if (type_of(pattern)!= t_string && type_of(pattern)!=t_symbol && + (type_of(pattern)!=t_vector || pattern->v.v_elttype!=aet_uchar)) + FEerror("~S is not a regexp pattern", 1 , pattern); + if (type_of(string)!= t_string && type_of(string)!=t_symbol) + not_a_string_or_symbol(string); + + if (type_of(v) != t_vector || v->v.v_elttype != aet_fix || v->v.v_dim < NSUBEXP*2) + v=sSAmatch_dataA->s.s_dbind=fSmake_vector1_1((NSUBEXP *2),aet_fix,sLnil); + + start=0; + end=string->st.st_fillp; + if (nargs>2) { + va_start(ap,string); + start=fixint(va_arg(ap,object)); + if (nargs>3) + end=fixint(va_arg(ap,object)); + va_end(ap); + } + if (start < 0 || end > string->st.st_fillp || start > end) + FEerror("Bad start or end",0); + + len=pattern->ust.ust_fillp; + if (len==0) { + /* trivial case of empty pattern */ + for (i=0;ifixa.fixa_self[i]=i ? -1 : 0; + memcpy(v->fixa.fixa_self+NSUBEXP,v->fixa.fixa_self,NSUBEXP*sizeof(*v->fixa.fixa_self)); + RETURN1(make_fixnum(0)); + } + + { + + regexp *compiled_regexp=saved_compiled_regexp; + + BEGIN_NO_INTERRUPT; + + case_fold_search = sSAcase_fold_searchA->s.s_dbind != sLnil ? 1 : 0; + + if (type_of(pattern)==t_vector) + + compiled_regexp=(void *)pattern->ust.ust_self; + + else if (case_fold != case_fold_search || len != strlen(buf) || memcmp(pattern->ust.ust_self,buf,len)) + + compiled_regexp=saved_compiled_regexp=(regexp *)FFN(fScompile_regexp)(pattern)->v.v_self; + + + str=string->st.st_self; + if (NULL_OR_ON_C_STACK(str+end) || str+end==(void *)compiled_regexp) { + + if (!(str=alloca(string->st.st_fillp+1))) + FEerror("Cannot allocate memory on C stack",0); + memcpy(str,string->st.st_self,string->st.st_fillp); + + } else + save_c=str[end]; + str[end]=0; + + ans = regexec(compiled_regexp,str+start,str,end-start); + + str[end] = save_c; + + if (!ans ) { + END_NO_INTERRUPT; + RETURN1(make_fixnum(-1)); + } + + pp=compiled_regexp->startp; + for (i=0;ifixa.fixa_self[i]=*pp ? *pp-str : -1; + pp=compiled_regexp->endp; + for (;i<2*NSUBEXP;i++,pp++) + v->fixa.fixa_self[i]=*pp ? *pp-str : -1; + + END_NO_INTERRUPT; + RETURN1(make_fixnum(v->fixa.fixa_self[0])); + + } + +} + + diff --git a/o/rel_aix.c b/o/rel_aix.c new file mode 100755 index 0000000..f68b429 --- /dev/null +++ b/o/rel_aix.c @@ -0,0 +1,110 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +*/ + +#define EXTERNAL_P(rel) \ + relocation_info.r_type & ) + +#define HI12 0xfff00000 +#define LO20 ~HI12 + +foo(){}; +relocate() +{ + char *where; + + {unsigned int new_value; + char tem [10]; +#ifdef DEBUG + printf("\nEnter relocate:*srelocation_info {r_symndx= %d, r_vaddr = %d,:", + relocation_info.r_symndx, + relocation_info.r_vaddr + );fflush(stdout); +#endif + where = the_start + relocation_info.r_vaddr; + + if(relocation_info.r_symndx < S_BSS){ +#ifdef DEBUG + printf("(relocation_info.r_symndx = %d < S_BSS)",relocation_info.r_symndx + );fflush(stdout); + print_name(&symbol_table[relocation_info.r_symndx]); +#endif + switch(relocation_info.r_type){ + case R_KCALL: + /* instructions like balix take a 20 bit argument + which wants to be the displacement in half words to + from the address of the instruction to the actual + address. */ + {int displ; + unsigned int new; + displ= symbol_table[relocation_info.r_symndx].n_value - + (int)where; + new= *(unsigned int *)where; + + /* *(unsigned int *)where + = (new & HI12) | ((displ >> 1) & LO20); */ + /* need to store the halves separately, because word pointers + must be aligned */ + ((unsigned short *)where)[0]=0x8b00; + ((unsigned short *)where)[1]=0x0c00; + return ;} + case R_PCRBYTE: /* byte (pc relative) */ + case R_PCRWORD: /* word (pc relative) */ + case R_PCRLONG: /* word (pc relative) */ + new_value= - (int)start_address + + symbol_table[relocation_info.r_symndx].n_value; + break; + default: + { new_value= + symbol_table[relocation_info.r_symndx].n_value;}}} + else + { switch(relocation_info.r_symndx){ + case S_DATA: case S_BSS: case S_TEXT: + new_value= (int)start_address; + break; + default: + dprintf(relocation_info.r_type = %d, relocation_info.r_type); +#ifdef DEBUG + printf("\nrelocation_info {r_symndx= %d, r_vaddr = %d, Ignored:", + relocation_info.r_symndx, + relocation_info.r_vaddr + );fflush(stdout); +#endif + goto DONT;} + }; + dprintf((type %d),relocation_info.r_type); + switch(relocation_info.r_type){ + case R_RELBYTE: + case R_PCRBYTE: + *( char *)where = new_value + *( char *) where; + break; + case R_RELWORD: + case R_PCRWORD: + *( short *)where = new_value + *( short *) where; + break; + case R_RELLONG: + case R_PCRLONG: + /* I guess it must be long if in these areas + I don't see how the size can vary. + */ + if (((int)where %4) !=0) FEerror("long alignment not long aligned",0,0); + *( long *)where = new_value + *( long *) where; + break; + default: + printf("(bad type %d)",relocation_info.r_type); + } + DONT:; + } +} + +typedef int (*FUNC)(); + + + +/* #define describe_sym(n) do{if (debug){printf("Sym No %d:",n); print_name(symbol_table+ (n));}}while(0) +*/ + +/* #include "spadutils.c" */ + + diff --git a/o/rel_coff.c b/o/rel_coff.c new file mode 100755 index 0000000..f62c76f --- /dev/null +++ b/o/rel_coff.c @@ -0,0 +1,86 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +*/ + +void +relocate() +{ + char *where; + describe_sym(relocation_info.r_symndx); + where = the_start + relocation_info.r_vaddr; + dprintf (where has %x , *where); + dprintf( at %x -->, where ); + + if (relocation_info.r_type == R_ABS) + { dprintf( r_abs ,0) return; } + switch(relocation_info.r_type) + { + case R_DIR32: + dprintf(new val r_dir32 %x , *((int *)where) + + symbol_table[relocation_info.r_symndx].n_value); + *(int *)where= *((int *)where) + + symbol_table[relocation_info.r_symndx].n_value; + break; + case R_PCRLONG: + + dprintf( r_pcrlong new value = %x , + *((int *)where) - (int)start_address + + symbol_table[relocation_info.r_symndx].n_value ); +#ifdef _WIN32 + /* the following is logical, except the address offset is + not where the 'where' is but where the 'call' is just + AFTER the 'where'. + */ + *(int *)where= symbol_table[relocation_info.r_symndx].n_value + - (int) where - sizeof(int *); +#else + *(int *)where= *((int *)where) - (int)start_address + + symbol_table[relocation_info.r_symndx].n_value; +#endif + + break; + default: + fprintf(stdout, "%d: unsupported relocation type.", + relocation_info.r_type); + FEerror("The relocation type was unknown",0,0); + } + +} + + + + +#ifdef DEBUG + +#define describe_sym describe_sym1 +describe_sym1(n) +int n; +{char *str; + char tem[9]; + struct syment *sym; + sym= &symbol_table[n]; + str= sym->n_zeroes == 0 ? + &my_string_table[sym->n_offset] : + (sym->n_name[SYMNMLEN -1] ? + /* MAKE IT NULL TERMINATED */ + (strncpy(tem,sym->n_name, + SYMNMLEN),tem): + sym->n_name ); + printf ("sym-index = %d table entry at %x",n,&symbol_table[n]); + /* + printf("symbol is (%s):\nsymbol_table[n]._n._n_name %s\nsymbol_table[n]._n._n_n._n_zeroes %d\nsymbol_table[n]._n._n_n._n_offset %d\nsymbol_table[n]._n._n_nptr[0] %d\nsymbol_table[n]._n._n_nptr[n] %d\nsymbol_table[n].n_value %d\nsymbol_table[n].n_scnum %d +\nsymbol_table[n].n_type %d\nsymbol_table[n].n_sclass %d\nsymbol_table[n].n_numaux %d", str, + symbol_table[n]._n._n_name, + symbol_table[n]._n._n_n._n_zeroes , + symbol_table[n]._n._n_n._n_offset , + symbol_table[n]._n._n_nptr[0] , + symbol_table[n]._n._n_nptr[1] , + symbol_table[n].n_value , + symbol_table[n].n_scnum , + symbol_table[n].n_type , + symbol_table[n].n_sclass , + symbol_table[n].n_numaux ); */ +} + +#endif diff --git a/o/rel_hp300.c b/o/rel_hp300.c new file mode 100755 index 0000000..e683d22 --- /dev/null +++ b/o/rel_hp300.c @@ -0,0 +1,218 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + +#undef NSYMS +#define NSYMS(hdr) count_symbols(&hdr,fp) +#ifndef dprintf +#define dprintf(a,b) +#endif + +/* the routines other than relocate are also used in rsym.c */ + + +#ifdef IN_RSYM +#define temp_malloc malloc +#else + +relocate() +{ + char *where; + { + unsigned int new_value; + where = the_start + relocation_info.r_address; + switch(relocation_info.r_segment){ + case RNOOP: goto DONT; + case REXT: + new_value = symbol_table[relocation_info. + r_symbolnum].n_value; + break; + case RDATA: + case RBSS: + case RTEXT: new_value= (int)start_address; break; + default: + dprintf(relocation_info.r_address = %d, + relocation_info.r_address); + printf( +"\nRel_Info {r_segment = %x, r_symbolnum= %x, r_address = %d} -- Ignored", + relocation_info.r_segment, + relocation_info.r_symbolnum, + relocation_info.r_address); + fflush(stdout); + goto DONT; + }; + switch(relocation_info.r_length){ + case 0: *( char *)where = new_value + *( char *) where; + break; + case 1: *( short *)where = new_value + *( short *) where; + break; + case 2: *( long *)where = new_value + *( long *) where; + break; + } +DONT: ; + } +} + + + +#ifdef PRIVATE_FASLINK + +int +faslink(faslfile, ldargstring) +object faslfile, ldargstring; +{ + struct exec tmpheader, faslheader; + + FILE *fp; TABL *table; + char filename[MAXPATHLEN]; + char ldargstr[MAXPATHLEN]; + char stbfilename[32]; + char tmpfilename[32]; + char command[MAXPATHLEN * 2]; + char buf[BUFSIZ], *p; + int i, res; + object tmpfile, data; + object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + + coerce_to_filename(ldargstring, ldargstr); + coerce_to_filename(faslfile, filename); + +/* Print out symbol table */ + sprintf(stbfilename, "/tmp/stb%d", getpid()); + fp = fopen(stbfilename, "w"); + for(i = 0, p = (char *)&tmpheader; i < sizeof(struct exec); i++) + *p++ = '\0'; + tmpheader.a_magic.system_id = HP9000S200_ID; + tmpheader.a_magic.file_type = RELOC_MAGIC; + tmpheader.a_stamp = 2; + + fwrite(&tmpheader, sizeof(struct exec), 1, fp); + table = c_table.ptable; + for(i = 0; i < c_table.length; i++) { + struct nlist_ nbuf; int len; + char *string; unsigned int address; + string =(*table)[i].string; + address =(*table)[i].address; + len = strlen(string); + if (((strncmp(string,"_end", 4) == NULL) && (len == 4)) || + ((strncmp(string,"_etext",6) == NULL) && (len == 6)) || + ((strncmp(string,"_edata",6) == NULL) && (len == 6))) + continue; + nbuf.n_value = address; + nbuf.n_type = N_ABS | N_EXT; + nbuf.n_length = len; + nbuf.n_almod = 0; + nbuf.n_unused = 0; + fwrite(&nbuf,sizeof(nbuf),1,fp); + fwrite(string,len,1,fp); + tmpheader.a_lesyms += sizeof(struct nlist_) + len; + } + fseek(fp,0,0); + fwrite(&tmpheader, sizeof(struct exec), 1, fp); + fclose(fp); + + sprintf(tmpfilename, "/tmp/fasl%d", getpid()); + sprintf(command, + "ld -r -o %s -x %s %s %s -h _edata -h _etext", + tmpfilename, + stbfilename, + filename, + ldargstr); + + if (system(command) != 0) + FEerror("The linkage editor failed.", 0); + + unlink(stbfilename); + + faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + vs_push(faslfile); + fp = faslfile->sm.sm_fp; + fread(&faslheader, sizeof(faslheader), 1, fp); + fseek(fp,RDATA_OFFSET(faslheader)+faslheader.a_drsize,0); + + { FILE *tmpfp; + int fpthis,fpend; + fpthis = ftell(fp); + fseek(fp,0,2); + fpend = ftell(fp); + fseek(fp,fpthis,0); + tmpfp = fopen(tmpfilename,"a+"); + fseek(tmpfp,0,2); + filecpy(tmpfp,fp,fpend-fpthis); + fclose(tmpfp); + } + + close_stream(faslfile); + + tmpfile = make_simple_string(tmpfilename); + vs_push(tmpfile); + + res = fasload(tmpfile); + + unlink(tmpfilename); + vs_base = old_vs_base; + vs_top = old_vs_top; + + return(res); +} +#endif +#endif + + +count_symbols(phdr,fp) +struct exec *phdr; +FILE *fp; +{int nsyms,i; + fseek(fp,(int)(LESYM_OFFSET(*phdr)), 0); + for(i = phdr->a_lesyms, nsyms = 0; i > 0; nsyms++) { + struct syment tmp; + fread((char *)&tmp, SYMESZ, 1, fp); i -= SYMESZ; + fseek(fp,(int)tmp.n_length,1); i -= tmp.n_length; + } + return (nsyms); +} + + +#define READ_IN_STRING_TABLE(fp,size) \ + read_in_string_table(fp,&fileheader,size,OUR_ALLOCA(size)) + +char * +read_in_string_table(fp,pfileheader,string_size,buf) +FILE *fp; +struct exec *pfileheader; +int string_size ; +char *buf; + +{ + char *p,*ans; + int slen,i,j; + ans=p = buf; + dprintf( string table leng = %d, string_size); + fseek(fp,LESYM_OFFSET(*pfileheader), 0); + for (i = pfileheader->a_lesyms,j=0; i > 0; i=i- slen-SYMESZ) + { + fseek(fp,SYMESZ, 1); + slen = symbol_table[j++].n_length; + fread(p,slen,1,fp); + *((p)+slen) = '\0'; + dprintf( p %s , p); + dprintf( slen %d,slen); + + p += slen + 1; + } + return (ans); +} diff --git a/o/rel_mac2.c b/o/rel_mac2.c new file mode 100755 index 0000000..6fd3f65 --- /dev/null +++ b/o/rel_mac2.c @@ -0,0 +1,84 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +*/ + + +relocate() +{ + char *where; + describe_sym(relocation_info.r_symndx); + where = the_start + relocation_info.r_vaddr; + dprintf (where has %x , *where); + dprintf( at %x -->, where ); + + if (relocation_info.r_type == R_ABS) + { dprintf( r_abs ,0) return; } + switch(relocation_info.r_type) + { int *q; + + case R_RELLONG: + dprintf(new val r_rellong %x , *((int *)where) + + symbol_table[relocation_info.r_symndx].n_value); + *(int *)where= *((int *)where) + + symbol_table[relocation_info.r_symndx].n_value; + break; + + case R_RELWORD: + dprintf(new val r_relword %x , *((short *)where) + + symbol_table[relocation_info.r_symndx].n_value); + *(short *)where= *((short *)where) + + symbol_table[relocation_info.r_symndx].n_value; + break; + case R_PCRLONG: + + dprintf( r_pcrlong new value = %x , + *((int *)where) - (int)start_address + + symbol_table[relocation_info.r_symndx].n_value ); + *(int *)where= *((int *)where) - (int)start_address + + symbol_table[relocation_info.r_symndx].n_value; + break; + + default: + fprintf(stdout, "%d: unsupported relocation type.", + relocation_info.r_type); + FEerror("The relocation type was unknown",0,0); + } + +} + + + + +#ifdef DEBUG + +#define describe_sym describe_sym1 +describe_sym1(n) +int n; +{char *str; + char tem[9]; + struct syment *sym; + sym= &symbol_table[n]; + str= sym->n_zeroes == 0 ? + &my_string_table[sym->n_offset] : + (sym->n_name[SYMNMLEN -1] ? + /* MAKE IT NULL TERMINATED */ + (strncpy(tem,sym->n_name, + SYMNMLEN),tem): + sym->n_name ); + printf ("sym-index = %d table entry at %x",n,&symbol_table[n]); + printf("symbol is (%s):\nsymbol_table[n]._n._n_name %s\nsymbol_table[n]._n._n_n._n_zeroes %d\nsymbol_table[n]._n._n_n._n_offset %d\nsymbol_table[n]._n._n_nptr[0] %d\nsymbol_table[n]._n._n_nptr[n] %d\nsymbol_table[n].n_value %d\nsymbol_table[n].n_scnum %d +\nsymbol_table[n].n_type %d\nsymbol_table[n].n_sclass %d\nsymbol_table[n].n_numaux %d", str, + symbol_table[n]._n._n_name, + symbol_table[n]._n._n_n._n_zeroes , + symbol_table[n]._n._n_n._n_offset , + symbol_table[n]._n._n_nptr[0] , + symbol_table[n]._n._n_nptr[1] , + symbol_table[n].n_value , + symbol_table[n].n_scnum , + symbol_table[n].n_type , + symbol_table[n].n_sclass , + symbol_table[n].n_numaux ); +} + +#endif diff --git a/o/rel_ps2aix.c b/o/rel_ps2aix.c new file mode 100755 index 0000000..5061823 --- /dev/null +++ b/o/rel_ps2aix.c @@ -0,0 +1,91 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +*/ + +print_rel(rel,sym) +struct syment *sym; + struct reloc *rel; +{char tem[10]; + printf(" (name = %s)",SYM_NAME(sym)); + printf("{r_type=%d",rel->r_type); + fflush(stdout); +} + + +#ifdef DEBUG + +#define describe_sym describe_sym1 +describe_sym1(n) +int n; +{char *str; + char tem[9]; + struct syment *sym; + sym= &symbol_table[n]; + str = SYM_NAME(sym); + if (debug == 0) return 1; + printf ("sym-index = %d table entry at %x",n,&symbol_table[n]); + printf("symbol is (%s):\nsymbol_table[n]._n._n_name %d\nsymbol_table[n]._n._n_n._n_zeroes %d\nsymbol_table[n]._n._n_n._n_offset %d\nsymbol_table[n]._n._n_nptr[0] %d\nsymbol_table[n]._n._n_nptr[n] %d\nsymbol_table[n].n_value %d\nsymbol_table[n].n_scnum %d " +"\nsymbol_table[n].n_type %d\nsymbol_table[n].n_sclass %d\nsymbol_table[n].n_numaux %d", + symbol_table[n]._n._n_name, + symbol_table[n]._n._n_n._n_zeroes , + symbol_table[n]._n._n_n._n_offset , + symbol_table[n]._n._n_nptr[0] , + symbol_table[n]._n._n_nptr[1] , + symbol_table[n].n_value , + symbol_table[n].n_scnum , + symbol_table[n].n_type , + symbol_table[n].n_sclass , + symbol_table[n].n_numaux ); +} + +#endif + +#define LONG_AT_ADDR(p) LONG_AT_ADDR1(((unsigned char *)p)) +#define LONG_AT_ADDR1(p) (p[0] | (p[1] << 8) | (p[2] << 16) |(p[3] << 24)) +#define STORE_LONG(p,val) STORE_LONG1(((unsigned char *)p),val) +#define STORE_LONG1(p,val) (p[3]=(val >> 24),p[0]=val,p[1]=(val >> 8),p[2]=(val >> 16)) + + + +relocate() +{ + char *where; + int old_val,new_val; +#ifdef DEBUG + if (debug) + {print_rel(&relocation_info,&symbol_table[relocation_info.r_symndx]); + describe_sym(relocation_info.r_symndx);} +#endif + where = the_start + relocation_info.r_vaddr; + dprintf (where has %x , *where); + dprintf( at %x -->, where ); + + if (relocation_info.r_type == R_ABS) + { dprintf( r_abs ,0); return; } + old_val = LONG_AT_ADDR(where); + switch(relocation_info.r_type) + { int *q; + case R_DIR32: + new_val= old_val + symbol_table[relocation_info.r_symndx].n_value; + dprintf(new val r_dir32 %x , new_val); + STORE_LONG(where,new_val); + break; + + case R_PCRLONG: + + new_val = old_val - (int) start_address + + symbol_table[relocation_info.r_symndx].n_value; + dprintf( r_pcrlong new value = %x , new_val) + STORE_LONG(where,new_val); + break; + + default: + fprintf(stderr, "%d: unsupported relocation type.", + relocation_info.r_type); + FEerror("The relocation type was unknown",0,0); + } + +} + + diff --git a/o/rel_rios.c b/o/rel_rios.c new file mode 100755 index 0000000..e10f39a --- /dev/null +++ b/o/rel_rios.c @@ -0,0 +1,284 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +*/ + +typedef int (*FUNC)(); +extern int akcltoc; +extern int toc_start; +static int current_toc; +static int ptrgl_offset = 0; +static int ptrgl_text; + +static int akcltoc_used=0; + +/* This is an alternating list of addresses x1,y1,x2,y2,... where + relocation entries for changing value in address x1 shold be read as changing + it in y1 */ + +static int toc_addresses_to_relocate [10]; +static int *next_toc_addresses_to_relocate = toc_addresses_to_relocate ; +static int akcltoc_thisload; +static int begun_relocate = 0; + +static int set_rel_bits(address,bits,val) + char *address; + int val; + int bits; +{ bits += 1; + if ( bits <= 16) + {unsigned short y = *(unsigned short *)address ; + y = y & (~0 << bits) ; + y |= (val & ~(~0 << bits)); + *(unsigned short *)address = val; + } + else + {unsigned int y = *(unsigned int *)address ; + y = y & (~0 << bits) ; + y |= (val & ~(~0 << bits)); + *(unsigned int *)address = y; + } +} + +#ifdef AIX3 +struct syment * +get_symbol(name,scnum,sym_table,length) + char *name; + int scnum,length; + struct syment *sym_table; +{ struct syment *end,*sym; + char tem[SYMNMLEN +1]; + char *na; + end =sym_table + length; + for(sym=sym_table; sym < end; sym += (NUM_AUX(sym) +1)) + {if ((sym)->n_scnum == scnum) + { na=SYM_NAME(sym); + if (strcmp(name,na) == 0) + {return sym;}}} + return 0;} +#endif /* aix3 */ + +/* + 800b0000 l r0,0x0(r11) + 90410014 st r2,0x14(r1) + 7c0903a6 mtctr r0 + 804b0004 l r2,0x4(r11) + 816b0008 l r11,0x8(r11) + 4e800420 bctr +*/ +int myptrgl[6] = { + 0x800b0000, 0x90410014, 0x7c0903a6, 0x804b0004, + 0x816b0008, 0x4e800420}; + +/* 7d8903a6 mtctr r12 + 4e800420 bctr + */ +static int jmp_r12[2] = { 0x7d8903a6, 0x4e800420}; + + +#define SYM_SMC(sym) (((union auxent *)(sym+1))->x_csect.x_smclas) +#define SYM_TOC_ADDR(sym) (((union auxent *)(sym+1))->x_csect.x_parmhash) +/* #define SYM_USED(sym) (((union auxent *)(&sym[1]))->x_csect.x_snhash) */ +#define TC_SYMBOL_P(sym) ((sym)->n_scnum == DATA_NSCN && NUM_AUX((sym)) && \ + (SYM_SMC(sym) == XMC_TC0 || SYM_SMC(sym) == XMC_TC)) + + + +int FIXtemp ; +static int intcmp2(x,y) + int *x,*y; +{ return (*x - *y); +} + +#define TOP6 (~0 << 26) +#define BR_IN_DATA_P(x) (((x) & TOP6) == (DBEGIN & TOP6)) + + +relocate() +{ struct syment *sym = &symbol_table[relocation_info.r_symndx]; + char *where; + describe_sym(relocation_info.r_symndx); + where = the_start + relocation_info.r_vaddr; + dprintf (where has %x , *(int *)where); + dprintf( at %x -->, where ); + + if(begun_relocate == 0) + {int n = next_toc_addresses_to_relocate - toc_addresses_to_relocate; + begun_relocate = 1; + FIXtemp = 0; /* dummy reference for export problem */ + qsort((char *)toc_addresses_to_relocate, n/2 , 2*sizeof(int), intcmp2); + next_toc_addresses_to_relocate + = toc_addresses_to_relocate;} + + switch(RELOC_RTYPE(relocation_info)) + { int *q; + + case R_TOC: /* TOC_ILodx */ + set_rel_bits(where,RELOC_RLEN(relocation_info), sym->n_value - toc_start) ; + break; + case R_POS: /* Pos_Rel */ + + if (where == *next_toc_addresses_to_relocate) + {where = next_toc_addresses_to_relocate [1]; + next_toc_addresses_to_relocate += 2;} + + if ( sym->n_scnum == N_UNDEF || TC_SYMBOL_P(sym)) + set_rel_bits(where,RELOC_RLEN(relocation_info), sym->n_value); + else + set_rel_bits(where,RELOC_RLEN(relocation_info), (*(int *)where)+ sym->n_value); + + break; + case R_BR: /* Brn_Sel */ + case R_RBR: /* Brn_Selx */ + + {int link_bit = ((((int *)where)[0]) & 1); + if (((((int *)where)[0]) & TOP6 ) == 0x48000000) /* bl or b relative */ + { + if (((int *)where)[1] == 0x80410014) /* l r2,0x14(r1) */ + {int x = SYM_TOC_ADDR(sym); + if (x) + { ((int *)where)[0] = 0x81820000 ; /* l r12,0x0(r2) */ + set_rel_bits(where+2,15,x - toc_start); + (((int *)where)[1] = 0x48000000); /* b relative */ + set_rel_bits(where+4, 0x19, ((int) jmp_r12) - ((int) where + 4 )); + ((int *)where)[1] |= link_bit; /* link bit */ + break; + } + else /* must be ptrgl */ + if (BR_IN_DATA_P(sym->n_value)) + {set_rel_bits(where, 0x19, sym->n_value - (int) where); + ((int *)where)[0] |= link_bit; /* link bit */ + break;} + } + else + if (BR_IN_DATA_P(sym->n_value)) + {set_rel_bits(where, 0x19, sym->n_value - (int) where); + ((int *)where)[0] |= link_bit; /* link bit */ + break;}} + else + FEerror("The type of Br_sel was new ",0,0); + } + default: + fprintf(stdout, "%d: unsupported relocation type.", + RELOC_RTYPE(relocation_info) ); + FEerror("The relocation type was unknown",0,0); + } + dprintf( %x,*(int *)where); + +} + +fix_undef_toc_address(answ,sym,str) + char *str; + struct syment *sym; + struct node *answ; + /* undefined sym */ +{ if (BR_IN_DATA_P(answ->address)) return; + if (answ->tc_offset == 0) + { answ->tc_offset = ( akcltoc + akcltoc_used - toc_start); + * ((int *)( akcltoc + akcltoc_used)) = answ->address; + akcltoc_used += sizeof(char *); + } + + if (NUM_AUX(sym)) + SYM_TOC_ADDR(sym) = (toc_start + answ->tc_offset); + else printf("symbol should have aux entry"); + + return; +} + + + + + + +#ifdef DEBUG +#undef describe_sym +#define describe_sym(x) do{if(sfasldebug) describe_sym1(x);} while (0) +describe_sym1(n) +int n; +{char *str; + char tem[9]; + struct syment *sym; + sym= &symbol_table[n]; + str= sym->n_zeroes == 0 ? + &my_string_table[sym->n_offset] : + (sym->n_name[SYMNMLEN -1] ? + /* MAKE IT NULL TERMINATED */ + (strncpy(tem,sym->n_name, + SYMNMLEN),tem): + sym->n_name ); + printf ("sym-index = %d table entry at %x",n,&symbol_table[n]); + printf("symbol is (%s):\nsymbol_table[n]._n._n_name %s\nsymbol_table[n]._n._n_n._n_zeroes %d\nsymbol_table[n]._n._n_n._n_offset %d\nsymbol_table[n]._n._n_nptr[0] %d\nsymbol_table[n]._n._n_nptr[n] %d\nsymbol_table[n].n_value %d\nsymbol_table[n].n_scnum %d nsymbol_table[n].n_type %d\nsymbol_table[n].n_sclass %d\nsymbol_table[n].n_numaux %d", str, + symbol_table[n]._n._n_name, + symbol_table[n]._n._n_n._n_zeroes , + symbol_table[n]._n._n_n._n_offset , + symbol_table[n]._n._n_nptr[0] , + symbol_table[n]._n._n_nptr[1] , + symbol_table[n].n_value , + symbol_table[n].n_scnum , + symbol_table[n].n_type , + symbol_table[n].n_sclass , + symbol_table[n].n_numaux ); +} + +#endif + + + + +/* allocate toc space in the preallocated region starting at akcltoc. + If a symbol already has a toc entry, use that instead + */ + +setup_for_aix_load() +{ bzero(toc_addresses_to_relocate,sizeof(toc_addresses_to_relocate)); + next_toc_addresses_to_relocate= toc_addresses_to_relocate; + akcltoc_thisload = akcltoc + akcltoc_used; + begun_relocate=0; + +} + +char * +sym_name(sym) + struct syment *sym; +{static char tem[SYMNMLEN +1]; + char *name; + tem[SYMNMLEN] = '0'; + name = SYM_NAME(sym); + return name;} + + + +allocate_toc(sym) + struct syment *sym; + /* sym is a symbol in the data section with an aux entry */ +{ if (SYM_SMC(sym) == XMC_TC0) + { sym->n_value = toc_start; return 1;} + if (SYM_SMC(sym) == XMC_TC) + {struct node *answ = find_sym(sym,0); + if (answ && answ->tc_offset) + { sym->n_value = toc_start + answ->tc_offset; + return 1;} + {char *na = sym_name(sym); +#ifdef SYM_USED + if (TC_SYMBOL_P(sym) && SYM_USED(sym) == 0) + return 0; +#endif + if (answ == 0 && *na && *na != '_') + printf("(strange TC synbol %s[%d])",na,sym - symbol_table);} + {int old_value; + (*next_toc_addresses_to_relocate++) = sym->n_value + start_address; + sym->n_value = akcltoc + akcltoc_used; + if (answ) answ->tc_offset = sym->n_value - toc_start; + (*next_toc_addresses_to_relocate++) = sym->n_value; + *((int *)(next_toc_addresses_to_relocate[-1])) = + *((int *)(next_toc_addresses_to_relocate[-2])); + akcltoc_used += sizeof(long int); + if (next_toc_addresses_to_relocate - toc_addresses_to_relocate + >= (sizeof(toc_addresses_to_relocate)/sizeof(int))) + FEerror("ran out",0,0); + if (akcltoc_used > 24000) FEerror("toc exhausted",0,0); + return 1; + }} + return 0; +} diff --git a/o/rel_stand.c b/o/rel_stand.c new file mode 100755 index 0000000..0190d46 --- /dev/null +++ b/o/rel_stand.c @@ -0,0 +1,88 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + + +#ifdef STAND + + +#define object char * +#define close_stream(a) +#define coerce_to_filename(a,b) +#define FEerror(a,b,c) printf(a) +#define vs_push(a) +#define read_fasl_vector(a) 0; + +int test; +char *joey="hi bill"; + +char *kcl_self,*system_directory; + +main(argc,argv) +int argc; +char *argv[]; +{argc; + kcl_self=argv[2]; + system_directory=argv[3]; + _fmode = O_BINARY; + + fasload(argv[1]); +} + +node_compare(node1,node2) +char *node1, *node2; +{ return(strcmp( ((struct node *)node1)->string, + ((struct node *)node2)->string));} + + + +read_special_symbols(symfile) +char *symfile; +{FILE *symin; + char *symbols; + int i,jj; + struct lsymbol_table tab; + if (!(symin=fopen(symfile,"r"))) + {perror(symfile);exit(1);}; + if(!fread((char *)&tab,sizeof(tab),1,symin)) + FEerror("No header",0,0); + symbols=malloc(tab.tot_leng); + c_table.alloc_length=( (PTABLE_EXTRA+ tab.n_symbols)); + (c_table.ptable) = (TABL *) malloc(sizeof(struct node) * c_table.alloc_length); + if (!(c_table.ptable)) {perror("could not allocate"); exit(1);}; + i=0; c_table.length=tab.n_symbols; + while(i < tab.n_symbols) + { fread((char *)&jj,sizeof(int),1,symin); + (SYM_ADDRESS(c_table,i))=jj; + SYM_STRING(c_table,i)=symbols; + + while( *(symbols++) = getc(symin)) + {;} +/* dprintf( name %s , SYM_STRING(c_table,i)); + dprintf( addr %d , jj); +*/ + i++; + } + + /* + for(i=0;i< 5;i++) + {printf("Symbol: %d %s %d \n",i,SYM_STRINGN(c_table,i), + SYM_ADDRESS(*ptable,i));} + */ +} + +#endif /* STAND */ + diff --git a/o/rel_sun3.c b/o/rel_sun3.c new file mode 100755 index 0000000..7b3446b --- /dev/null +++ b/o/rel_sun3.c @@ -0,0 +1,44 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +*/ + +relocate() +{ + char *where; + + {unsigned int new_value; + where = the_start + relocation_info.r_address; + if(relocation_info.r_extern) + { + if (relocation_info.r_pcrel) + new_value= - (int)start_address + + symbol_table[relocation_info.r_symbolnum].n_value; + else + { new_value= + symbol_table[relocation_info.r_symbolnum].n_value;}} + else + { switch(relocation_info.r_symbolnum){ + case N_DATA: case N_BSS: case N_TEXT: + new_value= (int)start_address; + break; + default: + dprintf(relocation_info.r_extern = %d, relocation_info.r_extern); + printf("\nrelocation_info {r_symbolnum= %d, r_address = %d, r_extern=0 Ignored:",relocation_info.r_address, + relocation_info.r_symbolnum);fflush(stdout); + goto DONT;} + }; + switch(relocation_info.r_length){ + case 0: + *( char *)where = new_value + *( char *) where; break; + case 1: + *( short *)where = new_value + *( short *) where; break; + case 2: + *( long *)where = new_value + *( long *) where; break; + } + DONT:; + } +} + + + diff --git a/o/rel_sun4.c b/o/rel_sun4.c new file mode 100755 index 0000000..45c8320 --- /dev/null +++ b/o/rel_sun4.c @@ -0,0 +1,166 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +Thanks to Blewett@research.att.com, for an initial effort on this. +*/ + +/* + Unfortunately the original documentation of the relocation types +was rather sketchy, so I was not able to determine the correct +behaviour of types which were not currently being output. + + These will have to be added later, for the moment an abort will occur. +One way to check your work is to compile sfasl.c defining STAND, and then +compare (using comp.c) the output from it with the output from ld. + */ + +relocate() +{ + char *where; + { + unsigned int new_value; + long x; + where = the_start + relocation_info.r_address; + dprintf (where has %x , *where); + dprintf( at %x -->, where ); +#ifdef DEBUG + dshow(); +#endif + if(relocation_info.r_extern) + { + switch (relocation_info.r_type) + { + case RELOC_DISP8: /* Disp's (pc-rel) */ + case RELOC_DISP16: + case RELOC_DISP32: abort(); + case RELOC_WDISP30: + dprintf ( symbol_table[relocation_info.r_index].n_value %d, + symbol_table[relocation_info.r_index].n_value); + new_value = + symbol_table[relocation_info.r_index].n_value + + relocation_info.r_addend + - (int)start_address; + break; + case RELOC_8: /* simplest relocs */ + case RELOC_16: + case RELOC_32: + case RELOC_HI22: /* SR 22-bit relocs */ + case RELOC_LO10: + dprintf( symbol_table[relocation_info.r_index].n_value = %d , + symbol_table[relocation_info.r_index].n_value); + new_value = + symbol_table[relocation_info.r_index].n_value; + + break; + default: + printf ("extern non-supported relocation_info.r_type=%d\n", + relocation_info.r_type); + fflush (stdout); + goto DONT; + } + dprintf( new value %x , new_value); + dprintf( rtype %x , relocation_info.r_type); + } + else + { + switch(relocation_info.r_index) /* was symbolnum */ + { + case N_DATA: case N_BSS: case N_TEXT: + new_value= (int)start_address; + break; + default: + abort(); + goto DONT; + } + } + + switch (relocation_info.r_type) + { +#define WHERE relocation_info.r_addend + case RELOC_8: /* simplest relocs */ + *(char *)where = x = new_value + WHERE; + break; + case RELOC_16: + *(short *)where = x = new_value + WHERE; + break; + case RELOC_32: + *(int *)where = x = new_value + WHERE; + break; + + case RELOC_DISP8: /* Disp's (pc-rel) */ + abort(); + *(char *)where = x = new_value + *(char *) where; + break; + case RELOC_DISP16: + abort(); + *(short *)where = x = new_value + *(short *) where; + break; + case RELOC_DISP32: + abort(); + *(int *)where = new_value + *(int *) where; + x = new_value + *( int *) where; + break; + + case RELOC_WDISP30: /* SR word disp's */ +#define MASK30BITS 0x3FFFFFFF + *(int *)where = ((((int) new_value) >> 2) & MASK30BITS) + | (~MASK30BITS & ( *(int *) where)); + break; + + case RELOC_WDISP22: + goto Default; + + case RELOC_HI22: /* SR 22-bit relocs */ + x = ((unsigned long) (new_value + relocation_info.r_addend)) >> 10; +#define MASK22 0x3fffff + *(long *) where= (~MASK22 & *(long *)where) | x; + break; + + case RELOC_22: + case RELOC_13: /* SR 13&10-bit relocs*/ + goto Default; + case RELOC_LO10: + x = ((unsigned long) (new_value + relocation_info.r_addend)) & 0x3ff; + *(unsigned short *)(where + 2) |= x; + break; + + case RELOC_SFA_BASE: /* SR S.F.A. relocs */ + case RELOC_SFA_OFF13: + case RELOC_BASE10: /* base_relative pic */ + case RELOC_BASE13: + case RELOC_BASE22: + case RELOC_PC10: /* special pc-rel pic*/ + case RELOC_PC22: + case RELOC_JMP_TBL: /* jmp_tbl_rel in pic */ + case RELOC_SEGOFF16: /* ShLib offset-in-seg*/ + case RELOC_GLOB_DAT: /* rtld relocs */ + case RELOC_JMP_SLOT: + case RELOC_RELATIVE: + + Default: + default: + printf ("non-supported relocation_info.r_type=%d\n", + relocation_info.r_type); + fflush (stdout); + abort(); + } + DONT:; + } + +} + + +#ifdef DEBUG + +dshow() +{ if(debug) + printf("\nrelocation_info:{r_address %d,r_index %d,r_extern %d \n r_type %d, r_addend %d" + , relocation_info.r_address +, relocation_info.r_index +, relocation_info.r_extern +, relocation_info.r_type +, relocation_info.r_addend); + fflush(stdout);} + +#endif /* DEBUG */ + diff --git a/o/rel_u370aix.c b/o/rel_u370aix.c new file mode 100755 index 0000000..3ee2b7e --- /dev/null +++ b/o/rel_u370aix.c @@ -0,0 +1,94 @@ +/* Copyright William Schelter. All rights reserved. This file does +the low level relocation which tends to be very system dependent. +It is included by the file sfasl.c +*/ + +print_rel(rel,sym) +struct syment *sym; + struct reloc *rel; +{char tem[10]; + printf(" (name = %s)",SYM_NAME(sym)); + printf("{r_type=%d",rel->r_type); + fflush(stdout); +} + + +#ifdef DEBUG + +#define describe_sym describe_sym1 +describe_sym1(n) +int n; +{char *str; + char tem[9]; + struct syment *sym; + sym= &symbol_table[n]; + str = SYM_NAME(sym); + if (debug == 0) return 1; + printf ("sym-index = %d table entry at %x",n,&symbol_table[n]); + printf("symbol is (%s):\nsymbol_table[n]._n._n_name %d\nsymbol_table[n]._n._n_n._n_zeroes %d\nsymbol_table[n]._n._n_n._n_offset %d\nsymbol_table[n]._n._n_nptr[0] %d\nsymbol_table[n]._n._n_nptr[n] %d\nsymbol_table[n].n_value %d\nsymbol_table[n].n_scnum %d " +"\nsymbol_table[n].n_type %d\nsymbol_table[n].n_sclass %d\nsymbol_table[n].n_numaux %d", + symbol_table[n]._n._n_name, + symbol_table[n]._n._n_n._n_zeroes , + symbol_table[n]._n._n_n._n_offset , + symbol_table[n]._n._n_nptr[0] , + symbol_table[n]._n._n_nptr[1] , + symbol_table[n].n_value , + symbol_table[n].n_scnum , + symbol_table[n].n_type , + symbol_table[n].n_sclass , + symbol_table[n].n_numaux ); +} + +#endif + +#define LONG_AT_ADDR(p) *((unsigned int *)p) +#define STORE_LONG(p,val) (*((unsigned int *)p)) = (val) + + + + +relocate() +{ + char *where; + int old_val,new_val; +#ifdef DEBUG + if (debug) + {print_rel(&relocation_info,&symbol_table[relocation_info.r_symndx]); + describe_sym(relocation_info.r_symndx);} +#endif + where = the_start + relocation_info.r_vaddr; + dprintf (where has %x , *where); + dprintf( at %x -->, where ); + + if (relocation_info.r_type == R_ABS) + { dprintf( r_abs ,0); return; } + old_val = LONG_AT_ADDR(where); + switch(relocation_info.r_type) + { int *q; + + case R_RELLONG: + case R_DIR32: + new_val= old_val + symbol_table[relocation_info.r_symndx].n_value; + dprintf(new val r_dir32 %x , new_val); + STORE_LONG(where,new_val); + break; + + case R_PCRLONG: + + new_val = old_val - (int) start_address + + symbol_table[relocation_info.r_symndx].n_value; + dprintf( r_pcrlong new value = %x , new_val) + STORE_LONG(where,new_val); + break; + + default: + fprintf(stderr, "%d: unsupported relocation type.", + relocation_info.r_type); + FEerror("The relocation type was unknown",0,0); + } + +} + + + + diff --git a/o/run_process.c b/o/run_process.c new file mode 100755 index 0000000..f08edf7 --- /dev/null +++ b/o/run_process.c @@ -0,0 +1,675 @@ +/* By Mike Ballantyne */ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + +#include + +#define IN_RUN_PROCESS +#include "include.h" + +#if defined(__CYGWIN__) +#include +#include +#include +#include +#endif + +#ifdef HAVE_SYS_SOCKIO_H +#include +#endif + +#ifdef RUN_PROCESS + +void setup_stream_buffer(object); +object make_two_way_stream(object, object); + +#if defined(__MINGW32__) || defined(__CYGWIN__) + +#include +#include +#include +#define PIPE_BUFFER_SIZE 2048 + +void DisplayError ( char *pszAPI ); +void PrepAndLaunchRedirectedChild ( HANDLE hChildStdOut, + HANDLE hChildStdIn, + HANDLE hChildStdErr, + PROCESS_INFORMATION *process_info, + char *name ); + +/* Run a process, with name holding the process name and arguments + * To test: + * + * (setq fp (si::run-process "wish")) + * + */ +void run_process ( char *name ) +{ + object stream_in, stream_out, stream; + HANDLE hChildStdoutReadTmp,hChildStdoutRead,hChildStdoutWrite; + HANDLE hChildStdinWriteTmp,hChildStdinRead,hChildStdinWrite; + HANDLE hChildStderrWrite; + SECURITY_ATTRIBUTES sec_att; + PROCESS_INFORMATION process_info; + int ofd, ifd; + FILE *ofp, *ifp; +#if 0 + DWORD dwRead, dwWritten; + /*CHAR chBuf[1024] = "puts $env(PATH)\n\0";*/ + CHAR chBuf[60] = "button .hello\npack .hello\n\0"; + /*CHAR chBuf[60] = "button .hello\n\0"; */ +#endif + + /* Set up the security attributes struct. */ + sec_att.nLength= sizeof(SECURITY_ATTRIBUTES); + sec_att.lpSecurityDescriptor = NULL; + sec_att.bInheritHandle = TRUE; + + /* Create the child output r/w pipes. The read pipe is temporary. */ + if ( ! CreatePipe ( &hChildStdoutReadTmp, + &hChildStdoutWrite, + &sec_att, + PIPE_BUFFER_SIZE ) ) { + DisplayError ( "CreatePipe stdout" ); + } + + /* Duplicate the output write handle to be used as std error + * avoiding problems when the spawned process closes a + * stdout handle. */ + if ( ! DuplicateHandle ( GetCurrentProcess (), + hChildStdoutWrite, + GetCurrentProcess (), + &hChildStderrWrite, + 0, + TRUE, /* Inheritable */ + DUPLICATE_SAME_ACCESS ) ) { + DisplayError ( "DuplicateHandle stdout/stderr" ); + } + + /* Likewise, the child input pipes. */ + if ( ! CreatePipe ( &hChildStdinRead, + &hChildStdinWriteTmp, + &sec_att, + PIPE_BUFFER_SIZE ) ) { + DisplayError ( "CreatePipe stdin" ); + } + + /* Make uninheritable copies of the output read handle and the + * input write handles. Stops the spawned process from + * inheriting non-closeable pipe handles. */ + if ( ! DuplicateHandle ( GetCurrentProcess(), + hChildStdoutReadTmp, + GetCurrentProcess(), + &hChildStdoutRead, /* The new handle. */ + 0, + FALSE, /* uninheritable. */ + DUPLICATE_SAME_ACCESS ) ) { + DisplayError ( "DuplicateHandle hChildStdoutRead" ); + } + + if ( ! DuplicateHandle ( GetCurrentProcess (), + hChildStdinWriteTmp, + GetCurrentProcess(), + &hChildStdinWrite, /* New handle. */ + 0, + FALSE, /* uninheritable. */ + DUPLICATE_SAME_ACCESS ) ) { + DisplayError ( "DuplicateHandle hChildStdinWrite" ); + } + + /* Kill the inheritable temporary handles. */ + if ( ! CloseHandle(hChildStdoutReadTmp ) ) DisplayError ( "CloseHandle: Temporary output read" ); + if ( ! CloseHandle(hChildStdinWriteTmp ) ) DisplayError ( "CloseHandle: Temporary input write" ); + + PrepAndLaunchRedirectedChild ( hChildStdoutWrite, + hChildStdinRead, + hChildStderrWrite, + &process_info, + name ); + + /* Close pipe handles to ensure that no inappropriately accessible pipe handles + * remain in this process. */ + if ( ! CloseHandle ( hChildStdoutWrite ) ) DisplayError ( "CloseHandle: Output write" ); + if ( ! CloseHandle ( hChildStdinRead ) ) DisplayError ( "CloseHandle: Input read" ); + if ( ! CloseHandle ( hChildStderrWrite ) ) DisplayError ( "CloseHandle: Error write" ); + +#if 0 + emsg("Before write\n" ); + WriteFile ( hChildStdinWrite, chBuf, strlen ( chBuf ), + &dwWritten, NULL); + FlushFileBuffers ( hChildStdinWrite ); + FlushFileBuffers ( hChildStdoutRead ); + emsg("Before read\n" ); + if ( ! ReadFile( hChildStdoutRead, chBuf, 2, &dwRead, NULL ) || + dwRead == 0 ) { + DisplayError ( "Nothing read\n" ); + } else { + emsg("Got Back: %s\n", chBuf ); + } + emsg("After read\n" ); +#endif + + +#if !defined (__CYGWIN__) + /* Connect up the Lisp objects with the pipes. */ + ofd = _open_osfhandle ( (int)hChildStdoutRead, _O_RDONLY | _O_TEXT ); + ofp = _fdopen ( ofd, "r" ); + ifd = _open_osfhandle ( (int)hChildStdinWrite, _O_WRONLY | _O_TEXT ); + ifp = _fdopen ( ifd, "w" ); +#else + { + extern int cygwin_attach_handle_to_fd(char *,int,HANDLE,mode_t,DWORD); + static int rpn; + + massert(snprintf(FN1,sizeof(FN1),"run_process_stdin_%d",rpn)>0); + ofd=cygwin_attach_handle_to_fd(FN1,-1,hChildStdoutRead,0,GENERIC_READ); + ofp=fdopen(ofd,"r"); + massert(snprintf(FN1,sizeof(FN1),"run_process_stdout_%d",rpn)>0); + ifd=cygwin_attach_handle_to_fd(FN1,-1,hChildStdinWrite,0,GENERIC_WRITE); + ifp=fdopen(ifd,"w"); + rpn++; + + } + +#endif + +#if 0 + { + char buf[1024]; + fprintf ( ifp, "button .wibble\n" ); + fflush (ifp); + fgets ( buf, 2, ofp ); + emsg("run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", + ofd, ofp, ifd, ifp, buf[0], buf[1], buf ); + } +#endif + + stream_in = (object) alloc_object(t_stream); + stream_in->sm.sm_mode = smm_input; + stream_in->sm.sm_fp = ofp; + stream_in->sm.sm_buffer = 0; + stream_in->sm.sm_flags=0; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = ifp; + stream_out->sm.sm_buffer = 0; + stream_out->sm.sm_flags=0; + setup_stream_buffer ( stream_in ); + setup_stream_buffer ( stream_out ); + stream = make_two_way_stream ( stream_in, stream_out ); + vs_base[0] = stream; + vs_base[1] = Cnil; + vs_top = vs_base + 1; +} + +/* Set up STARTUPINFO structure and launch redirected child. */ +void PrepAndLaunchRedirectedChild ( + HANDLE hChildStdOut, + HANDLE hChildStdIn, + HANDLE hChildStdErr, + PROCESS_INFORMATION *process_info, + char * name ) +{ + STARTUPINFO startup_info; + + /* Set up the start up info struct. */ + ZeroMemory ( &startup_info, sizeof ( STARTUPINFO ) ); + startup_info.cb = sizeof ( STARTUPINFO ); + startup_info.dwFlags = STARTF_USESTDHANDLES; + startup_info.hStdOutput = hChildStdOut; + startup_info.hStdInput = hChildStdIn; + startup_info.hStdError = hChildStdErr; + + /* Launch the redirected process. */ + if ( ! CreateProcess ( NULL, + name, + NULL, + NULL, + TRUE, + 0, + NULL, + NULL, + &startup_info, + process_info ) ) { + DisplayError("CreateProcess"); + } + +} + +/* Display the error number and the corresponding Windows message. */ +void DisplayError(char *pszAPI) +{ + LPVOID lpvMessageBuffer; + CHAR szPrintBuffer[512]; + DWORD nCharsWritten; + + FormatMessage ( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + GetLastError (), + MAKELANGID ( LANG_NEUTRAL, SUBLANG_DEFAULT ), + (LPTSTR) &lpvMessageBuffer, + 0, + NULL ); + + wsprintf ( szPrintBuffer, + "%s:\n error code = %d.\n message = %s.\n", + pszAPI, + GetLastError(), + (char *)lpvMessageBuffer ); + + WriteConsole ( GetStdHandle(STD_OUTPUT_HANDLE), + szPrintBuffer, + lstrlen ( szPrintBuffer ), + &nCharsWritten, + NULL ); + + LocalFree ( lpvMessageBuffer ); + FEerror ( "RUN-PROCESS encountered problems.", 0 ); +} + +void +siLrun_process() { + + int i, j; + int old = signals_allowed; + object x; + + if (vs_top-vs_base!=2) + FEwrong_no_args("RUN-PROCESS requires two arguments",make_fixnum(vs_top-vs_base)); + check_type_string(&vs_base[0]); + + massert(snprintf(FN1,sizeof(FN1),"%.*s%n",vs_base[0]->st.st_fillp,vs_base[0]->st.st_self,&i)>=0); + +#if defined(__CYGWIN__) + cygwin_conv_path(CCP_POSIX_TO_WIN_A,FN1,FN2,sizeof(FN2)); + massert(snprintf(FN1,sizeof(FN1),"%s%n",FN2,&i)>=0); +#endif + + x=vs_base[1]; + for (;x!=Cnil;x=x->c.c_cdr,i+=j) { + check_type_list(&x); + check_type_string(&x->c.c_car); + massert(snprintf(FN1+i,sizeof(FN1)-i," %.*s %n",x->c.c_car->st.st_fillp,x->c.c_car->st.st_self,&j)>=0); + } + + signals_allowed = sig_at_read; + run_process(FN1); + signals_allowed = old; + +} + +void +gcl_init_socket_function() +{ + make_si_function("RUN-PROCESS", siLrun_process); +} + + +#else /* __MINGW32__ */ + +/* + * System Include Files + * + * The system files here each define some part of the information needed to + * compile the inet package. They need to exist of every host you port this + * code to. I have added some comments that I hope will help you "find" + * the file if it does not have the same name of your host. + */ +#undef PAGESIZE +#include /* errno global, error codes for UNIX IO */ +#include /* Data types definitions */ +#include /* Socket definitions with out this forget it */ +#include /* Internet address definition AF_INET etc... */ +#include /* UNIX Signal codes */ +#include /* IO control standard UNIx fair */ +#include +#include /* Function to set socket aync/interrupt */ +#include /* Time for select time out */ +#include /* Data Base interface for network files */ +#include + + + +/* LISP - Lisp Wrapper for the "c" code. + * + * The lisp OBJECT is passed to the code and a string must be extracted + * and null terminated to make it work with the "C" code. + * + * Lisp Interface code. + */ + +static char *lisp_to_string(string) +object string; +{ + int i, len; + char *sself; + char *cstr; + + len = string->st.st_fillp; + + cstr = (char *) malloc (len+1); + sself = &(string->st.st_self[0]); + for (i=0; ih_addr, (char *)&sock_add.sin_addr, hp->h_length); + sock_add.sin_family = hp->h_addrtype; + + sock_add.sin_port = htons((short)server); + + sock = socket( hp->h_addrtype, SOCK_STREAM , 0); + + if(sock < 1) + { + FEerror("No Sockets!",0); + } + + if(connect(sock, (const struct sockaddr *)&sock_add, sizeof(sock_add)) < 0) + { + close(sock); + FEerror("Connection Failed.",0); + } + pid = getpid(); +#ifdef __CYGWIN__ + if(fcntl(sock, F_SETOWN, pid) < 0) +#else + if(ioctl(sock, SIOCSPGRP, (char *)&pid) < 0 ) +#endif + { + FEerror("Could not set process group of socket.",0); + } + +#ifdef OVM_IO + fcntl(sock,F_SETFL,FASYNC | FNDELAY); +#else + fcntl(sock,F_SETFL,FASYNC); +#endif + return(sock); +} + +object make_stream(host_l,socket,smm) +object host_l; +int socket; +enum smmode smm; +{ + char *mode=NULL; + object stream; + FILE *fp; + vs_mark; + + + switch(smm) + { + case smm_input: + mode = "r"; + break; + case smm_output: + mode = "w"; + break; + default: + FEerror("make_stream : wrong mode",0); + } + + fp = fdopen(socket,mode); + stream = (object) alloc_object(t_stream); + stream->sm.sm_mode = (short)smm; + stream->sm.sm_fp = fp; + stream->sm.sm_buffer = 0; + + stream->sm.sm_object0 = sLcharacter; + stream->sm.sm_object1 = host_l; + stream->sm.sm_int = 0; + stream->sm.sm_flags=0; + vs_push(stream); + setup_stream_buffer(stream); + vs_reset; + return(stream); +} + +object +make_socket_stream(host_l,port) +object host_l; +object port; +{ + char *host = lisp_to_string(host_l); + object stream_in; + object stream_out; + object stream; + int socket; + + socket = open_connection(host, fix(port)); + stream_in = make_stream(host_l,socket, smm_input); + stream_out = make_stream(host_l,socket, smm_output); + + stream = make_two_way_stream(stream_in,stream_out); + + return(stream); +} + +void +FFN(siLmake_socket_stream)() +{ + check_arg(2); + vs_base[0] = make_socket_stream(vs_base[0], vs_base[1]); + vs_popp; +} + +/* + * make 2 two-way streams + */ + +object +make_socket_pair() +{ + int sockets_in[2]; + int sockets_out[2]; + FILE *fp1, *fp2; + object stream_in, stream_out, stream; + + if (socketpair(AF_UNIX, SOCK_STREAM, 0, sockets_in) < 0) + FEerror("Failure to open socket stream pair", 0); + if (socketpair(AF_UNIX, SOCK_STREAM, 0, sockets_out) < 0) + FEerror("Failure to open socket stream pair", 0); + fp1 = fdopen(sockets_in[0], "r"); + fp2 = fdopen(sockets_out[0], "w"); + +#ifdef OVM_IO + {int pid; + pid = getpid(); + ioctl(sockets_in[0], SIOCSPGRP, (char *)&pid); + if( fcntl(sockets_in[0], F_SETFL, FASYNC | FNDELAY) == -1) + perror("Couldn't control socket"); + } +#endif + + + stream_in = (object) alloc_object(t_stream); + stream_in->sm.sm_mode = smm_input; + stream_in->sm.sm_fp = fp1; + stream_in->sm.sm_buffer = 0; + stream_in->sm.sm_int = sockets_in[1]; + stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; + stream_in->sm.sm_flags = 0; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = fp2; + stream_out->sm.sm_buffer = 0; + setup_stream_buffer(stream_in); + setup_stream_buffer(stream_out); + stream_out->sm.sm_int = sockets_out[1]; + stream_out->sm.sm_flags = 0; + stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; + stream = make_two_way_stream(stream_in, stream_out); + return(stream); +} +/* the routines for spawning off a process with streams + * + * Assumes that istream and ostream are both associated + * with "C" type streams. + */ + +static void +spawn_process_with_streams(object istream,object ostream,char *pname,char **argv) { + + int fdin; + int fdout; + + if (istream->sm.sm_fp == NULL || ostream->sm.sm_fp == NULL) + FEerror("Cannot spawn process with given stream", 0); + + fdin = istream->sm.sm_int; + fdout = ostream->sm.sm_int; + + if (!pvfork()) { + + /* the child --- replace standard in and out with descriptors given */ + close(0); + massert(dup(fdin)>=0); + close(1); + massert(dup(fdout)>=0); + + close(fileno(istream->sm.sm_fp)); + close(fileno(ostream->sm.sm_fp)); + + emsg("\n***** Spawning process %s ", pname); + + errno=0; + execvp(pname,argv); + _exit(128|(errno&0x7f)); + + } else { + + close(fdin); + close(fdout); + + } + +} + + +void +run_process(char *filename,char **argv) { + + object stream = make_socket_pair(); + spawn_process_with_streams(stream->sm.sm_object1,stream->sm.sm_object0,filename,argv); + + vs_base[0] = stream; + vs_base[1] = Cnil; + vs_top = vs_base + 2; + +} + +void +FFN(siLrun_process)() { + + int i,j; + object x; + char **p1,**pp,*c,*spc=" \n\t"; + + if (vs_top-vs_base!=2) + FEwrong_no_args("RUN-PROCESS requires two arguments",make_fixnum(vs_top-vs_base)); + check_type_string(&vs_base[0]); + + massert(snprintf(FN1,sizeof(FN1),"%.*s%n",vs_base[0]->st.st_fillp,vs_base[0]->st.st_self,&i)>=0); + + x=vs_base[1]; + for (;x!=Cnil;x=x->c.c_cdr,i+=j) { + check_type_list(&x); + check_type_string(&x->c.c_car); + massert(snprintf(FN1+i,sizeof(FN1)-i," %.*s %n",x->c.c_car->st.st_fillp,x->c.c_car->st.st_self,&j)>=0); + } + + for (pp=p1=(void *)FN2,c=FN1;(*pp=strtok(c,spc));c=NULL,pp++) + massert((void *)(pp+1)<(void *)FN2+sizeof(FN2)); + + run_process(FN1,(char **)FN2); + +} + +void +FFN(siLmake_socket_pair)() +{ + make_socket_pair(); +} + +void +gcl_init_socket_function() +{ + make_si_function("MAKE-SOCKET-STREAM", siLmake_socket_stream); + make_si_function("MAKE-SOCKET-PAIR", siLmake_socket_pair); + make_si_function("RUN-PROCESS", siLrun_process); +} + +#ifdef MUST_USE_STATIC_LINK +#ifdef __svr4__ +getpagesize() +{ return PAGESIZE; +} + +dlclose() +{emsg("calling 'dl' function sun did not supply..exitting") ;do_gcl_abort();} +dgettext() +{dlclose();} +dlopen() +{dlclose();} +dlerror() +{dlclose();} + +dlsym() +{dlclose();} + + + +#endif +#endif /* MUST_USE_STATIC_LINK */ + +#endif /* __MINGW32__ */ + +#else /* no RUN_PROCESS */ +/* static void */ +/* init_socket_function(void) {;} */ + +#endif diff --git a/o/save.c b/o/save.c new file mode 100755 index 0000000..c27fbd8 --- /dev/null +++ b/o/save.c @@ -0,0 +1,39 @@ +#ifndef FIRSTWORD +#include "include.h" +#endif + +static void +memory_save(char *original_file, char *save_file) +{ +#ifdef DO_BEFORE_SAVE + DO_BEFORE_SAVE ; +#endif + + unexec(save_file,original_file,0,0,0); +} + +#ifdef USE_CLEANUP +extern void _cleanup(); +#endif + +LFD(siLsave)(void) { + + char filename[256]; + extern char *kcl_self; + + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); + + gcl_cleanup(1); + +#ifdef MEMORY_SAVE + MEMORY_SAVE(kcl_self,filename); +#else + memory_save(kcl_self, filename); +#endif + + /* no return */ + exit(0); + +} diff --git a/o/save_sgi4.c b/o/save_sgi4.c new file mode 100755 index 0000000..6fd7ae4 --- /dev/null +++ b/o/save_sgi4.c @@ -0,0 +1,472 @@ +/* for the 4d */ + +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + unixsave.c +*/ + + + +/* When MACHINE is S3000, use fcntl.h */ +#ifdef ATT +#include +#include +#else +#include +#endif + + +#ifdef BSD +#include +#endif + +#ifdef VAX +#define PAGSIZ 1024 +#define SEGSIZ 1024 +#define TXTRELOC 0 +#endif + +#ifdef ISI + + + +#endif + +#ifdef SEQ + + +#endif + +#ifdef NEWS +#define TXTRELOC 0 +#endif + +#ifdef IBMRT + + + +#endif + +#ifdef ATT +#include +#include +#include +#include +#define exec aouthdr +#define a_text tsize +#define a_data dsize +#define a_bss bsize +#endif + +#ifdef E15 +#include +extern etext; +#define exec bhdr +#define a_text tsize +#define a_data dsize +#define a_bss bsize +#define a_syms ssize +#define a_trsize rtsize +#define a_drsize rdsize +#define SEGSIZ (128*1024) +#define TXTRELOC (1024*1024) +#endif + +#ifndef mips +filecpy(to, from, n) +FILE *to, *from; +register int n; +{ + char buffer[BUFSIZ]; + + for (;;) + if (n > BUFSIZ) { + fread(buffer, BUFSIZ, 1, from); + fwrite(buffer, BUFSIZ, 1, to); + n -= BUFSIZ; + } else if (n > 0) { + fread(buffer, 1, n, from); + fwrite(buffer, 1, n, to); + break; + } else + break; +} +#endif + +memory_save(original_file, save_file) +char *original_file, *save_file; +{ + +#ifdef BSD + struct exec header; + int stsize; +#endif +#ifdef ATT +#ifdef mips + struct { + struct filehdr filehdr; + struct aouthdr aouthdr; + struct scnhdr + text_section, + init_section, + rdata_section, + data_section, + lit8_section, + lit4_section, + sdata_section, + sbss_section, + bss_section; + } hdrs; + struct filehdr *pfilehdr; + struct aouthdr *paouthdr; + struct scnhdr *pscnhdr; + char buf[BUFSIZ]; + HDRR symhdr; + int fptr, nbytes, pagesize; +#define setbuf(stream,buf) +#else + struct filehdr fileheader; + struct exec header; +#endif /* mips */ + int diff; +#endif +#ifdef E15 + struct exec header; +#endif + + char *data_begin, *data_end; + int original_data; + FILE *original, *save; + register int n; + register char *p; + extern void *sbrk(); + + fclose(stdin); + original = fopen(original_file, "r"); + if (stdin != original || original->_file != 0) { + fprintf(stderr, "Can't open the original file.\n"); + exit(1); + } + setbuf(original, stdin_buf); + fclose(stdout); + unlink(save_file); + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { + fprintf(stderr, "Can't open the save file.\n"); + exit(1); + } + setbuf(save, stdout_buf); + +#ifdef BSD + fread(&header, sizeof(header), 1, original); + +#ifdef VAX + data_begin + = (char *)((TXTRELOC+header.a_text+(SEGSIZ-1)) & ~(SEGSIZ-1)); +#endif +#ifdef SUN + data_begin + = (char *)((TXTRELOC+header.a_text+(SEGSIZ-1)) & ~(SEGSIZ-1)); +#endif +#ifdef SUN2R3 + data_begin = (char *)N_DATADDR(header); +#endif +#ifdef SUN3 + data_begin = (char *)N_DATADDR(header); +#endif +#ifdef NEWS + data_begin + = (char *)((TXTRELOC+header.a_text+(SEGSIZ-1)) & ~(SEGSIZ-1)); +#endif +#ifdef ISI + + +#endif +#ifdef SEQ + + +#endif +#ifdef IBMRT + + +#endif + + data_end = core_end; + original_data = header.a_data; + header.a_data = data_end - data_begin; + header.a_bss = 0; + fwrite(&header, sizeof(header), 1, save); + +#ifdef VAX + if (header.a_magic == ZMAGIC) + filecpy(save, original, PAGSIZ - sizeof(header)); + filecpy(save, original, header.a_text); +#endif +#ifdef SUN + if (header.a_magic == ZMAGIC) + filecpy(save, original, PAGSIZ - sizeof(header)); + filecpy(save, original, header.a_text); +#endif +#ifdef SUN2R3 + filecpy(save, original, header.a_text - sizeof(header)); +#endif +#ifdef SUN3 + filecpy(save, original, header.a_text - sizeof(header)); +#endif +#ifdef NEWS + if (header.a_magic == ZMAGIC) + filecpy(save, original, PAGSIZ - sizeof(header)); + filecpy(save, original, header.a_text); +#endif +#ifdef ISI + + + + +#endif +#ifdef SEQ + + +#endif +#ifdef IBMRT + + + +#endif +#endif + +#ifdef ATT +#ifdef mips +# define NSCNS 4 + read(0, (char*)&hdrs.filehdr, FILHSZ + AOUTHSZ); + pfilehdr = (struct filehdr*)hdrs.aouthdr.text_start; + paouthdr = (struct aouthdr*)((long)pfilehdr + FILHSZ); + pscnhdr = (struct scnhdr*)((long)paouthdr + AOUTHSZ); + + pagesize = getpagesize(); + + hdrs.aouthdr.dsize = + ((long)core_end - hdrs.aouthdr.data_start + pagesize - 1) + & ~(pagesize - 1); + hdrs.aouthdr.bss_start = + hdrs.aouthdr.data_start + hdrs.aouthdr.dsize; + hdrs.aouthdr.bsize = 0; + + hdrs.filehdr.f_nscns = NSCNS; + hdrs.filehdr.f_timdat = time(NULL); + hdrs.filehdr.f_symptr = hdrs.aouthdr.tsize + hdrs.aouthdr.dsize; + + bcopy((char*)pscnhdr, (char*)&hdrs.text_section, NSCNS * SCNHSZ); + hdrs.data_section.s_size = hdrs.aouthdr.dsize + - hdrs.rdata_section.s_size; + bzero((char*)&hdrs.lit8_section, + sizeof hdrs - FILHSZ - AOUTHSZ - NSCNS * SCNHSZ); + fptr = write(1, &hdrs, AOUTHSZ + FILHSZ + pfilehdr->f_nscns * SCNHSZ); + + p = (char*)hdrs.aouthdr.text_start + fptr; + n = hdrs.aouthdr.tsize - fptr; + nbytes = pagesize - fptr; + write(1, p, nbytes); + p += nbytes; + n -= nbytes; + while ( n > pagesize ) { + write(1, p, pagesize); + p += pagesize; + n -= pagesize; + } + if ( n ) + write(1, p, n); + + lseek(1, hdrs.rdata_section.s_scnptr, SEEK_SET); + p = (char*)hdrs.aouthdr.data_start; + n = hdrs.aouthdr.dsize; + while ( n > pagesize ) { + write(1, p, pagesize); + p += pagesize; + n -= pagesize; + } + if ( n ) + write(1, p, n); + + lseek(0, pfilehdr->f_symptr, SEEK_SET); + diff = hdrs.filehdr.f_symptr - pfilehdr->f_symptr; + read(0, &symhdr, cbHDRR); +#ifndef __STDC__ +#define adjust(field)if(symhdr.cb/**/field/**/Offset)symhdr.cb/**/field/**/Offset+= diff +#else +#define adjust(field)if(symhdr.cb##field##Offset)symhdr.cb##field##Offset+= diff +#endif + adjust(Line); + adjust(Dn); + adjust(Pd); + adjust(Sym); + adjust(Opt); + adjust(Aux); + adjust(Ss); + adjust(SsExt); + adjust(Fd); + adjust(Rfd); + adjust(Ext); +#undef adjust + write(1, &symhdr, cbHDRR); + while ( (n = read(0, buf, sizeof buf)) > 0 ) + write(1, buf, n); +#else + fread(&fileheader, sizeof(fileheader), 1, original); + fread(&header, sizeof(header), 1, original); + data_begin = (char *)header.data_start; + data_end = core_end; + original_data = header.a_data; + header.a_data = data_end - data_begin; + diff = header.a_data - original_data; + header.a_bss = sbrk(0) - core_end; + fileheader.f_symptr += diff; + fwrite(&fileheader, sizeof(fileheader), 1, save); + fwrite(&header, sizeof(header), 1, save); + fread(§ionheader, sizeof(sectionheader), 1, original); + if (sectionheader.s_lnnoptr) + sectionheader.s_lnnoptr += diff; + fwrite(§ionheader, sizeof(sectionheader), 1, save); + fread(§ionheader, sizeof(sectionheader), 1, original); + sectionheader.s_size += diff; + if (sectionheader.s_lnnoptr) + sectionheader.s_lnnoptr += diff; + fwrite(§ionheader, sizeof(sectionheader), 1, save); + fread(§ionheader, sizeof(sectionheader), 1, original); + sectionheader.s_paddr += diff; + sectionheader.s_vaddr += diff; + sectionheader.s_size = header.a_bss; +#ifdef S3000 + if (sectionheader.s_scnptr) + sectionheader.s_scnptr += diff; +#endif + if (sectionheader.s_lnnoptr) + sectionheader.s_lnnoptr += diff; + fwrite(§ionheader, sizeof(sectionheader), 1, save); + for (n = 4; n <= fileheader.f_nscns; n++) { + fread(§ionheader, sizeof(sectionheader), 1, original); + if (sectionheader.s_scnptr) + sectionheader.s_scnptr += diff; + if (sectionheader.s_lnnoptr) + sectionheader.s_lnnoptr += diff; + fwrite(§ionheader, sizeof(sectionheader), 1, save); + } + filecpy(save, original, header.a_text); +#endif /* mips */ +#endif + +#ifdef E15 + fread(&header, sizeof(header), 1, original); + if (header.fmagic != NMAGIC) + data_begin + = (char *)(TXTRELOC+header.a_text); + else + data_begin + = (char *)((TXTRELOC+header.a_text+(SEGSIZ-1)) & ~(SEGSIZ-1)); + data_end = core_end; + original_data = header.a_data; + header.a_data = data_end - data_begin; + header.a_bss = sbrk(0) - core_end; + fwrite(&header, sizeof(header), 1, save); + filecpy(save, original, header.a_text); +#endif + +#ifndef mips + for (n = header.a_data, p = data_begin; ; n -= BUFSIZ, p += BUFSIZ) + if (n > BUFSIZ) + fwrite(p, BUFSIZ, 1, save); + else if (n > 0) { + fwrite(p, 1, n, save); + break; + } else + break; + + fseek(original, original_data, 1); + +#ifdef BSD + filecpy(save, original, header.a_syms+header.a_trsize+header.a_drsize); + fread(&stsize, sizeof(stsize), 1, original); + fwrite(&stsize, sizeof(stsize), 1, save); + filecpy(save, original, stsize - sizeof(stsize)); +#endif + +#ifdef ATT + for (;;) { + n = getc(original); + if (feof(original)) + break; + putc(n, save); + } +#endif + +#ifdef E15 + filecpy(save, original, header.a_syms+header.a_trsize+header.a_drsize); +#endif +#endif /* !mips */ + fclose(original); + fclose(save); +} + +Lsave() +{ + char filename[256]; + + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); +/* + _cleanup(); +*/ + { + FILE *p; + int nfile; + +#ifdef HAVE_GETDTABLESIZE + nfile = getdtablesize(); +#else + nfile = _NFILE; +#endif + for (p = &__iob[3]; p < &__iob[nfile]; p++) + fclose(p); + } + memory_save(kcl_self, filename); +/* + _exit(0); +*/ + exit(0); + /* no return */ +} + + +#ifdef ISI + + + + + + + + + + +#endif diff --git a/o/saveaix3.c b/o/saveaix3.c new file mode 100755 index 0000000..3fab243 --- /dev/null +++ b/o/saveaix3.c @@ -0,0 +1,283 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(c) Copyright William F. Schelter. + +*/ +/* + unixsave.c +*/ +#ifndef UNIX +#include "include.h" +#endif + +#include +#include +#include +#include +filecpy(to, from, n) +FILE *to, *from; +register int n; +{ + char buffer[BUFSIZ]; + for (;;) + if (n > BUFSIZ) { + fread(buffer, BUFSIZ, 1, from); + fwrite(buffer, BUFSIZ, 1, to); + n -= BUFSIZ; + } + else if (n > 0) { + fread(buffer, 1, n, from); + fwrite(buffer, 1, n, to); + break; + } + else + break; +} +#include +#include +char *__start; +memory_save(original_file, save_file) +char *original_file, *save_file; +{ /* MEM_SAVE_LOCALS; */ + struct filehdr Eheader; + struct aouthdr header; + struct scnhdr shdrs[15]; + int stsize; + int textsize=0; + int after_data; + int orig_data_scnptr; + int orig_debug_scnptr; + + char *data_begin, *data_end; + int original_data; + FILE *original, *save; + register int n; + register char *p; + extern char *sbrk(); + + fclose(stdin); + original = fopen(original_file, "r"); + if (stdin != original || original->_file != 0) { + fprintf(stderr, "Can't open the original file.\n"); + exit(1); + } + setbuf(original, stdin_buf); + fclose(stdout); + unlink(save_file); + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { + fprintf(stderr, "Can't open the save file.\n"); + exit(1); + } + setbuf(save, stdout_buf); + /* READ_HEADER; */ + fread(&Eheader, sizeof(Eheader), 1, original); + fread(&header, sizeof(header), 1, original); + data_begin= 0x20000800; + { + char buf[500]; + struct ld_info * ld; + loadquery(L_GETINFO,buf,sizeof(buf)); + ld = (struct ld_info *)buf; + data_begin = ld->ldinfo_dataorg ; + } + + /* header.data_start = data_begin; */ + + data_end = core_end; + original_data = header.dsize; + header.dsize = data_end - data_begin; + header.bsize = 0; + { + int j,i = Eheader.f_nscns; + int diff; + fread(shdrs +1 ,i,sizeof(struct scnhdr),original); + orig_data_scnptr = shdrs[header.o_sndata].s_scnptr; + orig_debug_scnptr = shdrs[8].s_scnptr; + diff = header.a_data - original_data + - shdrs[header.o_snbss + 1].s_size; + after_data = shdrs[header.o_snbss +2].s_scnptr; + Eheader.f_symptr += diff; + fwrite(&Eheader, sizeof(Eheader), 1, save); + fwrite(&header, sizeof(header), 1, save); + shdrs[header.o_snbss ].s_size = 0; + shdrs[header.o_snbss +1 ].s_size = 0; + /* ex**pect no more than 15 sections, and pad after data */ + if (strcmp(".pad",shdrs[header.o_snbss + 1].s_name) + || i >= 15) + perror("unexpected format of object file"); + shdrs[header.o_sndata ].s_size = header.a_data; + /* shdrs[header.o_sndata].s_paddr = data_begin; + shdrs[header.o_sndata].s_vaddr = data_begin; + */ + for (j=1; j<= i; j++) +#define ADJUST(x) if(x) (x) = (x) + diff + { + ADJUST(shdrs[j].s_lnnoptr); + ADJUST(shdrs[j].s_relptr); + } + for (j= header.o_sndata +1 ; j<= i; j++) + { + ADJUST(shdrs[j].s_scnptr); + ADJUST(shdrs[j].s_vaddr); + ADJUST(shdrs[j].s_paddr); + } + fwrite(shdrs +1 ,i,sizeof(struct scnhdr),save); + + + /* FILECPY_HEADER; */ + filecpy(save, original, + shdrs[header.o_sndata].s_scnptr + - sizeof(header)-sizeof(Eheader) - i*sizeof(struct scnhdr)); + + j= ftell(save); + j= ftell(original); + for (n = header.a_data, p = data_begin; ; n -= BUFSIZ, p += BUFSIZ) + if (n > BUFSIZ) + fwrite(p, BUFSIZ, 1, save); + else if (n > 0) { + fwrite(p, 1, n, save); + break; + } + else + break; + fseek(original, original_data, 1); + fseek(original, after_data, 0); + + /* now positioned at the loader section */ + { + struct ldhdr *ldheader; + struct ldrel * ldreloc_info,*p; + char *space; + space = (char *) sbrk(shdrs[header.o_snloader].s_size + 0x2000); + ldheader = (struct ldhdr *) space; + fread(space,1,shdrs[header.o_snloader].s_size,original); + ldreloc_info = (struct ldrel *) + (space + sizeof(struct ldhdr) + LDSYMSZ * ldheader->l_nsyms); + i = sizeof(struct ldhdr) + LDSYMSZ * (ldheader->l_nsyms); + for(p=ldreloc_info,i=0; i< ldheader->l_nreloc ; i++,p++) + { + if (p->l_rsecnm == header.o_snbss) + (p->l_rsecnm = header.o_sndata); + if (p->l_symndx == 2) /* make bss be data */ + (p->l_symndx = 1); + } + /* p->l_vaddr += data_begin; */ + fwrite(ldheader, 1, shdrs[header.o_snloader].s_size,save); + /* unrelocate */ + { + int j1 = ftell(save); + int j2= ftell(original); + int off=0; + fseek(original,orig_data_scnptr,0); + fseek(save,shdrs[header.o_sndata].s_scnptr,0); + for(p=ldreloc_info,i=0; i< ldheader->l_nreloc ; i++,p++) + if (p->l_rsecnm == header.o_sndata) + { + int x,pos1,y; + int d = p->l_vaddr - off; + if (d) + { + fseek(save,d,1); + fseek(original,d,1); + off += d; + } + pos1 = ftell(original); + pos1 = ftell(save); + fread(&x,1,sizeof(int),original); + y = x; + if (p->l_symndx ==0) + { + int w = *((int *)&__start); + x = ((*(int *)(data_begin+off))); + x = x + header.text_start ; + x = x - w ; + } + if (p->l_symndx ==1 || p->l_symndx ==2) + { + x = ((*(int *)(data_begin + off)) - (int) data_begin); + } + fwrite(&x,1,sizeof(int),save); + off += sizeof(int); + } + fseek(save,j1,0); + fseek(original,j2,0); + + } + } + + sbrk(- (shdrs[header.o_snloader].s_size+ 0x2000)); + filecpy(save,original,Eheader.f_symptr - ftell(save)); + /* now at the beginning of the sym table */ + { + struct syment symbol; + struct syment *sym = &symbol; + int naux; + int nsyms = Eheader.f_nsyms; + while (--nsyms >= 0) + { + fread(&symbol,1,SYMESZ,original); + fwrite(&symbol,1,SYMESZ,save); + naux= sym->n_numaux; + nsyms = nsyms - naux; + if (ISFCN(sym->n_type) + && (naux >= 2)) + { + fread(&symbol,1,SYMESZ,original); + (((union auxent *)(sym))->x_sym.x_fcnary.x_fcn.x_lnnoptr) += diff; + fwrite(&symbol,1,SYMESZ,save); + filecpy(save,original,SYMESZ*(naux -1)); + } + else + filecpy(save,original,SYMESZ*(naux)); + } + } + + + COPY_TO_SAVE; + fclose(original); + fclose(save); + } + } +Lsave() +{ + char filename[256]; + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); + _cleanup(); + /* + { + FILE *p; + int nfile; + nfile = NUMBER_OPEN_FILES; + for (p = &_iob[3]; p < &_iob[nfile]; p++) + fclose(p); + } +*/ + memory_save(kcl_self, filename); + _exit(0); + /* + exit(0); +*/ + /* no return */ +} + diff --git a/o/savedec31.c b/o/savedec31.c new file mode 100755 index 0000000..67d2706 --- /dev/null +++ b/o/savedec31.c @@ -0,0 +1,249 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + unixsave.c +*/ + + +#ifdef HAVE_FCNTL +#include +#else +#include +#endif + +#ifdef HAVE_AOUT +#undef BSD +#undef ATT +#define BSD +#endif + + + +#ifdef BSD +#include +#endif + + +#ifdef ATT +#include +#include +#include +#include +#endif + +#ifdef E15 +#include +extern etext; +#endif + + +filecpy(to, from, n) +FILE *to, *from; +register int n; +{ + char buffer[BUFSIZ]; + + for (;;) + if (n > BUFSIZ) { + fread(buffer, BUFSIZ, 1, from); + fwrite(buffer, BUFSIZ, 1, to); + n -= BUFSIZ; + } else if (n > 0) { + fread(buffer, 1, n, from); + fwrite(buffer, 1, n, to); + break; + } else + break; +} + + +memory_save(original_file, save_file) +char *original_file, *save_file; +{ /* MEM_SAVE_LOCALS; */ + + struct filehdr Ehdr; + struct aouthdr header; + struct scnhdr shdr[10]; + HDRR symhdr; + + struct scnhdr *text_section; + struct scnhdr *rdata_section; + struct scnhdr *data_section; + struct scnhdr *lit8_section; + struct scnhdr *lit4_section; + struct scnhdr *sdata_section; + struct scnhdr *sbss_section; + struct scnhdr *bss_section; + + char *data_begin, *data_end; + int original_data; + FILE *original, *save; + register int n; + register char *p; + extern char *sbrk(); + + + fclose(stdin); + original = fopen(original_file, "r"); + if (stdin != original || original->_file != 0) { + fprintf(stderr, "Can't open the original file.\n"); + exit(1); + } + setbuf(original, stdin_buf); + fclose(stdout); + unlink(save_file); + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { + fprintf(stderr, "Can't open the save file.\n"); + exit(1); + } + setbuf(save, stdout_buf); + + fread(&Ehdr,sizeof(Ehdr),1,original); + fread(&header,Ehdr.f_opthdr, 1,original); + {int i=0; + int pagesize = getpagesize(); +/* core_end = (char *)((int) (core_end + pagesize - 1) & ~(pagesize - 1)); +*/ + +#define READ_SCNHDR(name,str) \ + name = &shdr[i]; \ + fread(name,sizeof(struct scnhdr),1,original); \ + if(strcmp(str,(name)->s_name)) printf("got %s not %s sections", \ + (name)->s_name,str); i++; + READ_SCNHDR(text_section,".text") ; + READ_SCNHDR(rdata_section,".rdata"); + READ_SCNHDR(data_section,".data"); + READ_SCNHDR(lit8_section, ".lit8"); + READ_SCNHDR(lit4_section, ".lit4"); + READ_SCNHDR(sdata_section, ".sdata"); + READ_SCNHDR(sbss_section,".sbss"); + READ_SCNHDR(bss_section,".bss"); + if(i!= Ehdr.f_nscns) printf("wrong number of sections"); + } +/* + READ_HEADER; + FILECPY_HEADER; + */ +#define ALTER_SCN(name,size,addr,scnptr) (name)->s_size = size; \ + (name)->s_paddr = addr; \ + (name)->s_vaddr = addr; \ + (name)->s_scnptr = scnptr; + + original_data = header.a_data; + + data_begin = (char *)rdata_section->s_vaddr; + header.a_data = (int) core_end - rdata_section->s_vaddr; + header.a_bss = 0; + + + ALTER_SCN(data_section, header.a_data - rdata_section->s_size + ,data_section->s_vaddr, data_section->s_scnptr); + ALTER_SCN(lit4_section,0,data_section->s_vaddr,data_section->s_scnptr); + ALTER_SCN(lit8_section,0,data_section->s_vaddr,data_section->s_scnptr); + ALTER_SCN(sbss_section,0,data_section->s_vaddr,data_section->s_scnptr); + ALTER_SCN(sdata_section,0,data_section->s_vaddr,data_section->s_scnptr) +; + ALTER_SCN(bss_section,0, /* sbrk(0) - core_end,*/ + data_section->s_vaddr,data_section->s_scnptr); + + header.bsize = bss_section->s_size; + Ehdr.f_symptr += (header.dsize - original_data); + + fwrite(&Ehdr,1,sizeof(Ehdr),save); + fwrite(&header,1,Ehdr.f_opthdr,save); + fwrite(&shdr[0],sizeof(struct scnhdr),Ehdr.f_nscns,save); + filecpy(save,original,rdata_section->s_scnptr - ftell(save)); +/* p = data_begin; n= header.a_data; + while(--n>=0) + {putc(*p,save); p++;} */ + + for (n = header.a_data, p = data_begin; ; n -= BUFSIZ, p += BUFSIZ) + { {int jj; + jj = ftell(save);} + + + + if (n > BUFSIZ) + fwrite(p, BUFSIZ, 1, save); + else if (n > 0) { + fwrite(p, 1, n, save); + break; + } else + break;} + + fseek(original, original_data, 1); + + + COPY_TO_SAVE; + {int diff = (header.dsize - original_data); + fseek(original,Ehdr.f_symptr - diff,0); + fread(&symhdr,sizeof(symhdr),1,original); + if(symhdr.cbLineOffset)symhdr.cbLineOffset+= diff; + if(symhdr.cbDnOffset)symhdr.cbDnOffset+= diff; + if(symhdr.cbPdOffset)symhdr.cbPdOffset+= diff; + if(symhdr.cbSymOffset)symhdr.cbSymOffset+= diff; + if(symhdr.cbOptOffset)symhdr.cbOptOffset+= diff; + if(symhdr.cbAuxOffset)symhdr.cbAuxOffset+= diff; + if(symhdr.cbSsOffset)symhdr.cbSsOffset+= diff; + if(symhdr.cbSsExtOffset)symhdr.cbSsExtOffset+= diff; + if(symhdr.cbFdOffset)symhdr.cbFdOffset+= diff; + if(symhdr.cbRfdOffset)symhdr.cbRfdOffset+= diff; + if(symhdr.cbExtOffset)symhdr.cbExtOffset+= diff; + fseek(save,Ehdr.f_symptr ,0); + fwrite(&symhdr,sizeof(symhdr),1,save); + } + + fclose(original); + fclose(save); +} + +Lsave() +{ + char filename[256]; + + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); + + _cleanup(); +/* + { + FILE *p; + int nfile; + + + nfile = NUMBER_OPEN_FILES; + + for (p = &_iob[3]; p < &_iob[nfile]; p++) + fclose(p); + } +*/ + memory_save(kcl_self, filename); +/* + _exit(0); +*/ + exit(0); + + /* no return */ +} + diff --git a/o/saveu370.c b/o/saveu370.c new file mode 100755 index 0000000..5f1dde7 --- /dev/null +++ b/o/saveu370.c @@ -0,0 +1,188 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + unixsave.c +*/ + + +#include +#include +#include +#ifdef u370 +#undef u370 +#include + +filecpy(to, from, n) +FILE *to, *from; +register int n; +{ + char buffer[BUFSIZ]; + + for (;;) + if (n > BUFSIZ) { + fread(buffer, BUFSIZ, 1, from); + fwrite(buffer, BUFSIZ, 1, to); + n -= BUFSIZ; + } else if (n > 0) { + fread(buffer, 1, n, from); + fwrite(buffer, 1, n, to); + break; + } else + break; +} + + +memory_save(original_file, save_file) +char *original_file, *save_file; +{ MEM_SAVE_LOCALS; + struct scnhdr shdrs[15]; + char *data_begin, *data_end; + int original_data; + FILE *original, *save; + register int n; + register char *p; + extern char *sbrk(); + + + fclose(stdin); + original = fopen(original_file, "r"); + if (stdin != original || original->_file != 0) { + fprintf(stderr, "Can't open the original file.\n"); + exit(1); + } + setbuf(original, stdin_buf); + fclose(stdout); + unlink(save_file); + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { + fprintf(stderr, "Can't open the save file.\n"); + exit(1); + } + setbuf(save, stdout_buf); + + /* READ_HEADER; */ + fread(&fileheader, sizeof(fileheader), 1, original); + fread(&header, fileheader.f_opthdr, 1, original); + fread(&shdrs[1],sizeof(sectionheader),fileheader.f_nscns,original); + data_begin = (char *) shdrs[2].s_paddr; + data_end = core_end; + original_data = header.a_data; + header.a_data = data_end - data_begin; + diff = header.a_data - original_data; + header.a_bss = sbrk(0) - core_end; + fileheader.f_symptr += diff; + fwrite(&fileheader, sizeof(fileheader), 1, save); + fwrite(&header,fileheader.f_opthdr , 1, save); + + /* .text */ +#define INC_IF(x) if(x) x = x+diff; + + /* .data */ + INC_IF(shdrs[2].s_size); + + /* .bss */ + shdrs[3].s_paddr += diff; + shdrs[3].s_vaddr += diff; + shdrs[3].s_size = header.a_bss; + + for (n = 1; n <= fileheader.f_nscns; n++) { + INC_IF(shdrs[n].s_lnnoptr); + if(n>=3) {INC_IF(shdrs[n].s_scnptr);} + + }; + fwrite(&shdrs[1],sizeof(sectionheader),fileheader.f_nscns,save); + + filecpy(save,original,shdrs[2].s_scnptr - ftell(save)); + + for (n = header.a_data, p = data_begin; ; n -= BUFSIZ, p += BUFSIZ) + if (n > BUFSIZ) + fwrite(p, BUFSIZ, 1, save); + else if (n > 0) { + fwrite(p, 1, n, save); + break; + } else + break; + + fseek(original, original_data, 1); + + COPY_TO_SAVE; + + fclose(original); + fclose(save); +} + +Lsave() +{ + char filename[256]; + + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); + + _cleanup(); +/* + { + FILE *p; + int nfile; + + + nfile = NUMBER_OPEN_FILES; + + for (p = &_iob[3]; p < &_iob[nfile]; p++) + fclose(p); + } +*/ + memory_save(kcl_self, filename); +/* + _exit(0); +*/ + exit(0); + /* no return */ +} + + + +#include "page.h" +#undef sbrk +char *sbrk (); +char * +sbrk1(n) +{ char *m1; + char * m = sbrk(0); +/* printf("Calling sbrk(0x%08x),[cur,rently sbrk(0)=0x%08x,core_end=0x%08x," + ,n,m,core_end); + */ + m1 = sbrk(n); + if (core_end && m1!= m) + { if (m1 < m || + ((int)m1 % PAGESIZE)) + { error("unexpected sbrk"); + } + while ( m < m1) + {type_map[page(m)] = t_other; + m += PAGESIZE; + } + core_end = m;} +/* printf("Returning 0x%08x\n",m); */ + return m;} + + diff --git a/o/sbrk.c b/o/sbrk.c new file mode 100755 index 0000000..5086d9b --- /dev/null +++ b/o/sbrk.c @@ -0,0 +1,28 @@ +#include +extern char end; + +static caddr_t curbrk = &end; +caddr_t sbrk(int n); + +void * +sbrk(int n) { + int res; + if (n==0) return curbrk; + { + void * x=curbrk; + char *p; + p=curbrk; + p=p+n; + res = brk(p); + + if (res==-1) error("can't set brk"); + else curbrk = p; + return (x); + } +} + + + + + + diff --git a/o/sequence.d b/o/sequence.d new file mode 100755 index 0000000..759f930 --- /dev/null +++ b/o/sequence.d @@ -0,0 +1,548 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + sequence.d + + sequence routines +*/ + +#include "include.h" + +/* + I know the following name is not good. +*/ +object +alloc_simple_vector(l, aet) +int l; +enum aelttype aet; +{ + object x; + + x = alloc_object(t_vector); + x->v.v_hasfillp = FALSE; + x->v.v_adjustable = FALSE; + x->v.v_displaced = Cnil; + x->v.v_dim = x->v.v_fillp = l; + x->v.v_self = NULL; + x->v.v_elttype = (short)aet; + return(x); +} + +object +alloc_simple_bitvector(l) +int l; +{ + object x; + + x = alloc_object(t_bitvector); + x->bv.bv_hasfillp = FALSE; + x->bv.bv_adjustable = FALSE; + x->bv.bv_displaced = Cnil; + x->bv.bv_dim = x->bv.bv_fillp = l; + x->bv.bv_offset = 0; + x->bv.bv_self = NULL; + x->bv.bv_elttype = aet_bit; + return(x); +} + +LFD(Lelt)() +{ + check_arg(2); + vs_base[0] = elt(vs_base[0], fixint(vs_base[1])); + vs_popp; +} + +object +elt(seq, index) +object seq; +int index; +{ + int i; + object l; + + if (index < 0) { + vs_push(make_fixnum(index)); + FEwrong_type_argument(sLpositive_fixnum, vs_head); + } + switch (type_of(seq)) { + case t_cons: + for (i = index, l = seq; i > 0; --i) + if (endp(l)) + goto E; + else + l = l->c.c_cdr; + if (endp(l)) + goto E; + return(l->c.c_car); + + case t_vector: + case t_bitvector: + if (index >= seq->v.v_fillp) + goto E; + return(aref(seq, index)); + + case t_string: + if (index >= seq->st.st_fillp) + goto E; + return(code_char(seq->ust.ust_self[index])); + + default: + if (seq == Cnil) goto E; + FEwrong_type_argument(sLsequence, seq); + } + +E: + vs_push(make_fixnum(index)); + /* FIXME message should indicate out of range */ + TYPE_ERROR(make_fixnum(index),MMcons(sLinteger,MMcons(make_fixnum(0),MMcons(make_fixnum(length(seq)),Cnil)))); + return(Cnil); +} + +LFD(siLelt_set)() +{ + check_arg(3); + vs_base[0] = elt_set(vs_base[0], fixint(vs_base[1]), vs_base[2]); + vs_popp; + vs_popp; +} + +object +elt_set(seq, index, val) +object seq; +int index; +object val; +{ + int i; + object l; + + if (index < 0) { + vs_push(make_fixnum(index)); + FEwrong_type_argument(sLpositive_fixnum, vs_head); + } + switch (type_of(seq)) { + case t_cons: + for (i = index, l = seq; i > 0; --i) + if (endp(l)) + goto E; + else + l = l->c.c_cdr; + if (endp(l)) + goto E; + return(l->c.c_car = val); + + case t_vector: + case t_bitvector: + if (index >= seq->v.v_fillp) + goto E; + return(aset(seq, index, val)); + + case t_string: + if (index >= seq->st.st_fillp) + goto E; + if (type_of(val) != t_character) + FEwrong_type_argument(sLcharacter, val); + seq->st.st_self[index] = val->ch.ch_code; + return(val); + + default: + if (seq == Cnil) goto E; + FEwrong_type_argument(sLsequence, seq); + } + +E: + vs_push(make_fixnum(index)); + /* FIXME error message should indicate value out of range */ + FEwrong_type_argument(sLpositive_fixnum, vs_head); + return(Cnil); +} + +@(defun subseq (sequence start &optional end &aux x) + int s, e; + int i, j; +@ + s = fixnnint(start); + if (end == Cnil) + e = -1; + else + e = fixnnint(end); + switch (type_of(sequence)) { + case t_symbol: + if (sequence == Cnil) { + if (s > 0) + goto ILLEGAL_START_END; + if (e > 0) + goto ILLEGAL_START_END; + @(return Cnil) + } + FEwrong_type_argument(sLsequence, sequence); + + case t_cons: + if (e >= 0) + if ((e -= s) < 0) + goto ILLEGAL_START_END; + while (s-- > 0) { + if (type_of(sequence) != t_cons) + goto ILLEGAL_START_END; + sequence = sequence->c.c_cdr; + } + if (e < 0) + @(return `copy_list(sequence)`) + x=n_cons_from_x(e,sequence); + @(return x) + + case t_vector: + if (s > sequence->v.v_fillp) + goto ILLEGAL_START_END; + if (e < 0) + e = sequence->v.v_fillp; + else if (e < s || e > sequence->v.v_fillp) + goto ILLEGAL_START_END; + x = alloc_simple_vector(e - s, sequence->v.v_elttype); + array_allocself(x, FALSE,OBJNULL); + switch (sequence->v.v_elttype) { + case aet_object: + case aet_fix: + case aet_sf: + for (i = s, j = 0; i < e; i++, j++) + x->v.v_self[j] = sequence->v.v_self[i]; + break; + + case aet_lf: + for (i = s, j = 0; i < e; i++, j++) + x->lfa.lfa_self[j] = + sequence->lfa.lfa_self[i]; + break; + + case aet_short: + case aet_ushort: + for (i = s, j = 0; i < e; i++, j++) + USHORT_GCL(x, j) = USHORT_GCL(sequence, i); + break; + case aet_char: + case aet_uchar: + for (i = s, j = 0; i < e; i++, j++) + x->st.st_self[j] = sequence->st.st_self[i]; + break; + + } + @(return x) + + + case t_string: + if (s > sequence->st.st_fillp) + goto ILLEGAL_START_END; + if (e < 0) + e = sequence->st.st_fillp; + else if (e < s || e > sequence->st.st_fillp) + goto ILLEGAL_START_END; + {BEGIN_NO_INTERRUPT; + x = alloc_simple_string(e - s); + x->st.st_self = alloc_relblock(e - s); + END_NO_INTERRUPT;} + for (i = s, j = 0; i < e; i++, j++) + x->st.st_self[j] = sequence->st.st_self[i]; + @(return x) + + case t_bitvector: + if (s > sequence->bv.bv_fillp) + goto ILLEGAL_START_END; + if (e < 0) + e = sequence->bv.bv_fillp; + else if (e < s || e > sequence->bv.bv_fillp) + goto ILLEGAL_START_END; + {BEGIN_NO_INTERRUPT; + x = alloc_simple_bitvector(e - s); + x->bv.bv_self = alloc_relblock((e-s+7)/8); + s += sequence->bv.bv_offset; + e += sequence->bv.bv_offset; + for (i = s, j = 0; i < e; i++, j++) + if (sequence->bv.bv_self[i/8]&(0200>>i%8)) + x->bv.bv_self[j/8] + |= 0200>>j%8; + else + x->bv.bv_self[j/8] + &= ~(0200>>j%8); + END_NO_INTERRUPT;} + @(return x) + + default: + FEwrong_type_argument(sLsequence, vs_base[0]); + } + +ILLEGAL_START_END: + FEerror("~S and ~S are illegal as :START and :END~%\ +for the sequence ~S.", 3, start, end, sequence); +@) + +LFD(Lcopy_seq)() +{ + check_arg(1); + vs_push(small_fixnum(0)); + Lsubseq(); +} + +int +length(x) +object x; +{ + int i; + + switch (type_of(x)) { + case t_symbol: + if (x == Cnil) + return(0); + FEwrong_type_argument(sLsequence, x); + return(0); + case t_cons: + +#define cendp(obj) ((type_of(obj)!=t_cons)) + for (i = 0; !cendp(x); i++, x = x->c.c_cdr) + ; + if (x==Cnil) return(i); + FEwrong_type_argument(sLlist,x); + return(0); + + + case t_vector: + case t_string: + case t_bitvector: + return(x->v.v_fillp); + + default: + FEwrong_type_argument(sLsequence, x); + return(0); + } +} + +LFD(Llength)() +{ + check_arg(1); + vs_base[0] = make_fixnum(length(vs_base[0])); +} + +LFD(Lreverse)() +{ + check_arg(1); + vs_base[0] = reverse(vs_base[0]); +} + +object +reverse(seq) +object seq; +{ + object x, y, *v; + int i, j, k; + + switch (type_of(seq)) { + case t_symbol: + if (seq == Cnil) + return(Cnil); + FEwrong_type_argument(sLsequence, seq); + + case t_cons: + v = vs_top; + vs_push(Cnil); + for (x = seq; !endp(x); x = x->c.c_cdr) + *v = make_cons(x->c.c_car, *v); + return(vs_pop); + + case t_vector: + x = seq; + k = x->v.v_fillp; + y = alloc_simple_vector(k, x->v.v_elttype); + vs_push(y); + array_allocself(y, FALSE,OBJNULL); + switch (x->v.v_elttype) { + case aet_object: + case aet_fix: + case aet_sf: + for (j = k - 1, i = 0; j >=0; --j, i++) + y->v.v_self[j] = x->v.v_self[i]; + break; + + case aet_lf: + for (j = k - 1, i = 0; j >=0; --j, i++) + y->lfa.lfa_self[j] = x->lfa.lfa_self[i]; + break; + + case aet_short: + case aet_ushort: + for (j = k - 1, i = 0; j >=0; --j, i++) + USHORT_GCL(y, j) = USHORT_GCL(x, i); + break; + case aet_char: + case aet_uchar: + goto TYPE_STRING; + } + return(vs_pop); + + case t_string: + x = seq; + y = alloc_simple_string(x->st.st_fillp); + TYPE_STRING: + {BEGIN_NO_INTERRUPT; + vs_push(y); + y->st.st_self + = alloc_relblock(x->st.st_fillp); + for (j = x->st.st_fillp - 1, i = 0; j >=0; --j, i++) + y->st.st_self[j] = x->st.st_self[i]; + END_NO_INTERRUPT;} + return(vs_pop); + + case t_bitvector: + x = seq; + {BEGIN_NO_INTERRUPT; + y = alloc_simple_bitvector(x->bv.bv_fillp); + vs_push(y); + y->bv.bv_self + = alloc_relblock((x->bv.bv_fillp+7)/8); + for (j = x->bv.bv_fillp - 1, i = x->bv.bv_offset; + j >=0; + --j, i++) + if (x->bv.bv_self[i/8]&(0200>>i%8)) + y->bv.bv_self[j/8] |= 0200>>j%8; + else + y->bv.bv_self[j/8] &= ~(0200>>j%8); + END_NO_INTERRUPT;} + return(vs_pop); + + default: + FEwrong_type_argument(sLsequence, seq); + return(Cnil); + } +} + +LFD(Lnreverse)() +{ + check_arg(1); + vs_base[0] = nreverse(vs_base[0]); +} + +object +nreverse(seq) +object seq; +{ + object x, y, z; + int i, j, k; + + switch (type_of(seq)) { + case t_symbol: + if (seq == Cnil) + return(Cnil); + FEwrong_type_argument(sLsequence, seq); + + case t_cons: + for (x = Cnil, y = seq; !endp(y->c.c_cdr);) { + z = y; + y = y->c.c_cdr; + z->c.c_cdr = x; + x = z; + } + y->c.c_cdr = x; + return(y); + + case t_vector: + x = seq; + k = x->v.v_fillp; + switch (x->v.v_elttype) { + case aet_object: + case aet_fix: + case aet_sf: + for (i = 0, j = k - 1; i < j; i++, --j) { + y = x->v.v_self[i]; + x->v.v_self[i] = x->v.v_self[j]; + x->v.v_self[j] = y; + } + return(seq); + + case aet_lf: + for (i = 0, j = k - 1; i < j; i++, --j) { + longfloat y; + y = x->lfa.lfa_self[i]; + x->lfa.lfa_self[i] = x->lfa.lfa_self[j]; + x->lfa.lfa_self[j] = y; + } + return(seq); + + case aet_short: + case aet_ushort: + for (i = 0, j = k - 1; i < j; i++, --j) { + unsigned short y; + y = USHORT_GCL(x, i); + USHORT_GCL(x, i) = USHORT_GCL(x, j); + USHORT_GCL(x, y) = y; + } + return(seq); + case aet_char: + case aet_uchar: + goto TYPE_STRING; + } + + case t_string: + x = seq; + TYPE_STRING: + for (i = 0, j = x->st.st_fillp - 1; i < j; i++, --j) { + k = x->st.st_self[i]; + x->st.st_self[i] = x->st.st_self[j]; + x->st.st_self[j] = k; + } + return(seq); + + case t_bitvector: + x = seq; + for (i = x->bv.bv_offset, + j = x->bv.bv_fillp + x->bv.bv_offset - 1; + i < j; + i++, --j) { + k = x->bv.bv_self[i/8]&(0200>>i%8); + if (x->bv.bv_self[j/8]&(0200>>j%8)) + x->bv.bv_self[i/8] + |= 0200>>i%8; + else + x->bv.bv_self[i/8] + &= ~(0200>>i%8); + if (k) + x->bv.bv_self[j/8] + |= 0200>>j%8; + else + x->bv.bv_self[j/8] + &= ~(0200>>j%8); + } + return(seq); + + default: + FEwrong_type_argument(sLsequence, seq); + return(Cnil); + } +} + + +void +gcl_init_sequence_function() +{ + make_function("ELT", Lelt); + make_si_function("ELT-SET", siLelt_set); + make_function("SUBSEQ", Lsubseq); + make_function("COPY-SEQ", Lcopy_seq); + make_function("LENGTH", Llength); + make_function("REVERSE", Lreverse); + make_function("NREVERSE", Lnreverse); +} diff --git a/o/sfasl.c b/o/sfasl.c new file mode 100755 index 0000000..f5c8b67 --- /dev/null +++ b/o/sfasl.c @@ -0,0 +1,84 @@ +/* +Copyright William Schelter. All rights reserved. +There is a companion file rsym.c which is used to build +a list of the external symbols in a COFF or A.OUT object file, for +example saved_kcl. These are loaded into kcl, and the +linking is done directly inside kcl. This saves a good +deal of time. For example a tiny file foo.o with one definition +can be loaded in .04 seconds. This is much faster than +previously possible in kcl. +The function fasload from unixfasl.c is replaced by the fasload +in this file. +this file is included in unixfasl.c +via #include "../c/sfasl.c" +*/ + + +/* for testing in standalone manner define STAND + You may then compile this file cc -g -DSTAND -DDEBUG -I../hn + a.out /tmp/foo.o /public/gcl/unixport/saved_kcl /public/gcl/unixport/ + will write a /tmp/sfasltest file + which you can use comp to compare with one produced by ld. + */ + +#define IN_SFASL + +/* #ifdef STAND */ +/* #include "config.h" */ +/* #include "gclincl.h" */ +/* #define OUR_ALLOCA alloca */ +/* #include */ +/* #include "mdefs.h" */ + +/* #else */ +#include "gclincl.h" +#include "include.h" +#undef S_DATA +/* #endif */ + + +#if defined(SPECIAL_RSYM) && !defined(USE_DLOPEN) + +#include + +#include "ptable.h" + +static int +node_compare(const void *v1,const void *v2) { + const struct node *a1=v1,*a2=v2; + + return strcmp(a1->string,a2->string); + +} + +static struct node * +find_sym_ptable(const char *name) { + + struct node joe; + joe.string=name; + return bsearch(&joe,c_table.ptable,c_table.length,sizeof(joe),node_compare); + +} + +DEFUN_NEW("FIND-SYM-PTABLE",object,fSfind_sym_ptable,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + char c; + struct node *a; + + check_type_string(&x); + + c=x->st.st_self[x->st.st_fillp]; + x->st.st_self[x->st.st_fillp]=0; + a=find_sym_ptable(x->st.st_self); + x->st.st_self[x->st.st_fillp]=c; + + return (object)(a ? a->address : 0); + +} + +#endif + +#ifdef SEPARATE_SFASL_FILE +#include SEPARATE_SFASL_FILE +#else +#error must define SEPARATE_SFASL_FILE +#endif /* SEPARATE_SFASL_FILE */ diff --git a/o/sfaslbfd.c b/o/sfaslbfd.c new file mode 100644 index 0000000..9115794 --- /dev/null +++ b/o/sfaslbfd.c @@ -0,0 +1,393 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + +/* for testing in standalone manner define STAND + You may then compile this file cc -g -DSTAND -DDEBUG -I../hn + a.out /tmp/foo.o /public/gcl/unixport/saved_kcl /public/gcl/unixport/ + will write a /tmp/sfasltest file + which you can use comp to compare with one produced by ld. + */ + +#if defined(SPECIAL_RSYM) || !defined(HAVE_LIBBFD) +#error Cannot use bfd fasloading with SPECIAL_RSYM/without HAVE_LIBBFD defined +#endif + +#ifdef HAVE_LIBBFD +#ifdef NEED_CONST +#define CONST const +#endif +#define IN_GCC +#include +#include +#endif + + +#include "ext_sym.h" +#include "gclincl.h" +#include + +#if defined(DARWIN) +asection * +bfd_mach_o_craft_fp_branch_islands PARAMS ((bfd *)); + +MY_BFD_BOOLEAN +bfd_mach_o_inject_fp_branch_islands PARAMS ((bfd *, asection *, asymbol **)); +#endif + + +/* align for power of two n */ +static void * +round_up(void *address, unsigned long n) +{ + return (void *)(((unsigned long)address + n -1) & ~(n-1)) ; +} +#define ROUND_UP(a,b) round_up(a,b) + + +static MY_BFD_BOOLEAN +madd_archive_element (struct bfd_link_info * link_info, + bfd *abfd, + const char *name) { + +return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +mmultiple_definition (struct bfd_link_info * link_info, + const char *name, + bfd *obfd, + asection *osec, + bfd_vma oval, + bfd *nbfd, + asection *nsec, + bfd_vma nval) { + +return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +mmultiple_common (struct bfd_link_info * link_info, + const char *name, + bfd *obfd, + enum bfd_link_hash_type otype, + bfd_vma osize, + bfd *nbfd, + enum bfd_link_hash_type ntype, + bfd_vma nsize) { + +return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +madd_to_set (struct bfd_link_info * link_info, + struct bfd_link_hash_entry *entry, + bfd_reloc_code_real_type reloc, + bfd *abfd, asection *sec, bfd_vma value) { + +return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +mconstructor (struct bfd_link_info * link_info,MY_BFD_BOOLEAN constructor, + const char *name, bfd *abfd, asection *sec, + bfd_vma value) { + +return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +mwarning (struct bfd_link_info * link_info, + const char *warning, const char *symbol, + bfd *abfd, asection *section, + bfd_vma address) { + +return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +mundefined_symbol (struct bfd_link_info * link_info, + const char *name, bfd *abfd, + asection *section, + bfd_vma address, + MY_BFD_BOOLEAN fatal) { + + printf("%s is undefined\n",name); + return MY_BFD_FALSE; +} + +static MY_BFD_BOOLEAN +mreloc_overflow (struct bfd_link_info * link_info,struct bfd_link_hash_entry *entry, + const char *name, + const char *reloc_name, bfd_vma addend, + bfd *abfd, asection *section, + bfd_vma address) { + + printf("reloc for %s is overflowing\n",name); + return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +mreloc_dangerous (struct bfd_link_info * link_info, + const char *message, + bfd *abfd, asection *section, + bfd_vma address) { + + printf("reloc is dangerous %s\n",message); + return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +munattached_reloc (struct bfd_link_info * link_info, + const char *name, + bfd *abfd, asection *section, + bfd_vma address) { + +return MY_BFD_FALSE; + +} + +static MY_BFD_BOOLEAN +mnotice (struct bfd_link_info * link_info, const char *name, + bfd *abfd, asection *section, bfd_vma address) { + +return MY_BFD_FALSE; + +} + +static bfd *bself; + + +int +fasload(object faslfile) { + + object data; + char filename[256]; + int init_address=-1; + object memory; + int max_align=0; + void *current; + unsigned long curr_size; + object *old_vs_base=vs_base; + object *old_vs_top=vs_top; + static int nbfd; + bfd *b; + bfd_error_type myerr; + unsigned u,v; + asymbol **q; + asection *s; + void * the_start,*start_address,*m; + static union lispunion dum; + static struct bfd_link_callbacks link_callbacks; + static struct bfd_link_order link_order; + char entry_name[7]="_init_",*entry_name_ptr; +#if defined(DARWIN) + asection *bi; +#endif + + if (!nbfd) { + + nbfd=1; + + set_type_of(&dum,t_stream); + dum.sm.sm_mode=smm_input; + dum.sm.sm_object0=sLcharacter; + + link_callbacks.add_archive_element=madd_archive_element; + link_callbacks.multiple_definition=mmultiple_definition; + link_callbacks.multiple_common=mmultiple_common; + link_callbacks.add_to_set=madd_to_set; + link_callbacks.constructor=mconstructor; + link_callbacks.warning=mwarning; + link_callbacks.undefined_symbol=mundefined_symbol; + link_callbacks.reloc_overflow=mreloc_overflow; + link_callbacks.reloc_dangerous=mreloc_dangerous; + link_callbacks.unattached_reloc=munattached_reloc; + link_callbacks.notice=mnotice; + link_info.callbacks=&link_callbacks; + + link_order.type=bfd_indirect_link_order; + + } + + coerce_to_filename(faslfile, filename); + + if (!(b=bfd_openr(filename,0))) + FEerror("Cannot open bfd",0); + if ((myerr=bfd_get_error()) && myerr!=3) + FEerror("Unknown bfd error code on openr",0); + if (!bfd_check_format(b,bfd_object)) + FEerror("Unknown bfd format",0); + if ((myerr=bfd_get_error()) && myerr!=3) + FEerror("Unknown bfd error code on check_format",0); + bfd_set_error(0); + +#if defined(DARWIN) + if ((bi = bfd_mach_o_craft_fp_branch_islands (b)) == NULL) + FEerror ("Could not craft fp register preservation stubs",0); +#endif + + current=NULL; + for (s=b->sections;s;s=s->next) { + + s->owner=b; + s->output_section=(s->flags & SEC_ALLOC) ? s : b->sections; + s->output_offset=0; + + if (!(s->flags & SEC_ALLOC)) + continue; + + if (max_alignalignment_power) + max_align=s->alignment_power; + + current=round_up(current,1<alignment_power); + + current+=bfd_section_size(b,s); + + } + curr_size=(unsigned long)current; + max_align=1<cfd.cfd_size = curr_size + (max_align > sizeof(char *) ? max_align :0); + + memory->cfd.cfd_start=alloc_contblock(memory->cfd.cfd_size); + the_start=start_address=memory->cfd.cfd_start; + + start_address = ROUND_UP(start_address,max_align); + memory->cfd.cfd_size = memory->cfd.cfd_size - (start_address - the_start); + memory->cfd.cfd_start = (void *)start_address; + + for (m=start_address,s=b->sections;s;s=s->next) { + + if (!(s->flags & SEC_ALLOC)) + continue; + + m=round_up(m,1<alignment_power); + s->output_section->vma=(unsigned long)m; + m+=bfd_section_size(b,s); + + } + + if ((u=bfd_get_symtab_upper_bound(b))<0) + FEerror("Cannot get symtab uppoer bound",0); + q=(asymbol **)alloca(u); + if ((v=bfd_canonicalize_symtab(b,q))<0) + FEerror("cannot canonicalize symtab",0); + + *entry_name=bfd_get_symbol_leading_char(b); + entry_name_ptr=*entry_name ? entry_name : entry_name+1; + + for (u=0;uname,5)) { + init_address=q[u]->value+(q[u]->section->output_section->vma-(unsigned long)memory->cfd.cfd_start); + continue; + } + + if (!(h=bfd_link_hash_lookup(link_info.hash,q[u]->name,MY_BFD_FALSE,MY_BFD_FALSE,MY_BFD_TRUE))) + continue; + + if (h->type!=bfd_link_hash_defined) + FEerror("Undefined symbol ~S",1,make_simple_string(q[u]->name)); + + if (h->u.def.section) { + q[u]->value=h->u.def.value+h->u.def.section->vma; + q[u]->flags|=BSF_WEAK; + } else + FEerror("Symbol without section",0); + + } + +#if defined(DARWIN) + if (!bfd_mach_o_inject_fp_branch_islands (b, bi, q)) + FEerror ("Could not inject fp register preservation stubs",0); +#endif + +#ifndef HAVE_ALLOCA +#error Cannot use bfd relocations without alloca at present +#endif + /* We have to do this to avoid the possibility that + bfd_get_relocated_section_contents will run GBC via its alloc, thereby + write protecting the pages of memory->cfd again and causing bfd reads of + the section contents to return an error code after a 'stratified' segfault */ + { + void *v=alloca(memory->cfd.cfd_size); + + if (!v) + FEerror("Cannot alloca for bfd",0); + + for (s=b->sections;s;s=s->next) { + + unsigned long ss=bfd_section_size(b,s); + + if (!(s->flags & SEC_LOAD)) + continue; + + link_order.u.indirect.section=s; + + if (!bfd_get_relocated_section_contents(b,&link_info,&link_order, + v,0,q)) + FEerror("Cannot get relocated section contents\n",0); + + memcpy((void *)(unsigned long)s->output_section->vma,v,ss); + + } + + } + + dum.sm.sm_object1=faslfile; + dum.sm.sm_fp=b->iostream; + + /* Find a way of doing this in bfd -- use this for now. Unfortunately, + we're not always at file end after reading in the sections -- CM */ + SEEK_TO_END_OFILE(dum.sm.sm_fp); + + if (feof(dum.sm.sm_fp)) + data=0; + else + data = read_fasl_vector(&dum); + + bfd_close(b); + +#ifdef CLEAR_CACHE + CLEAR_CACHE; +#endif + + call_init(init_address,memory,data,0); + + vs_base=old_vs_base; + vs_top=old_vs_top; + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ",memory->cfd.cfd_start); + + return memory->cfd.cfd_size; + + } + +#include "sfasli.c" + diff --git a/o/sfaslcoff.c b/o/sfaslcoff.c new file mode 100644 index 0000000..4f53f79 --- /dev/null +++ b/o/sfaslcoff.c @@ -0,0 +1,501 @@ +#include + +#include "windows.h" + +typedef unsigned char uc; +typedef unsigned short us; +typedef unsigned int ul; + +struct filehdr { + us f_magic; /* magic number */ + us f_nscns; /* number of sections */ + ul f_timdat; /* time & date stamp */ + ul f_ptrsym; /* file pointer to symtab */ + ul f_symnum; /* number of symtab entries */ + us f_opthdr; /* sizeof(optional hdr) */ + us f_flags; /* flags */ +}; + +struct opthdr { + us h_magic; + uc h_mlv; + uc h_nlv; + ul h_tsize; + ul h_dsize; + ul h_bsize; + ul h_maddr; + ul h_tbase; + ul h_dbase; /* = high 32 bits of ibase for PE32+, magic 0x20b*/ + ul h_ibase; +}; + +struct scnhdr { + uc s_name[8]; /* section name */ + ul s_paddr; /* physical address, aliased s_nlib */ + ul s_vaddr; /* virtual address */ + ul s_size; /* section size */ + ul s_scnptr; /* file ptr to raw data for section */ + ul s_relptr; /* file ptr to relocation */ + ul s_lnnoptr; /* file ptr to line numbers */ + us s_nreloc; /* number of relocation entries */ + us s_nlnno; /* number of line number entries*/ + ul s_flags; /* flags */ +}; +#define SEC_CODE 0x20 +#define SEC_DATA 0x40 +#define SEC_BSS 0x80 +#define ALLOC_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA|SEC_BSS)) +#define LOAD_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA)) + +#define NM(sym_,tab_,nm_,op_) \ + ({char _c=0,*nm_; \ + if ((sym_)->n.n.n_zeroes) \ + {(nm_)=(sym_)->n.n_name;_c=(nm_)[8];(nm_)[8]=0;} \ + else \ + (nm_)=(tab_)+(sym_)->n.n.n_offset; \ + op_; \ + if (_c) (nm_)[8]=_c; \ + }) + + +struct reloc { + union { + ul r_vaddr; + ul r_count; /* Set to the real count when IMAGE_SCN_LNK_NRELOC_OVFL is set */ + } r; + ul r_symndx; + us r_type; +} __attribute__ ((packed)); +#define R_ABS 0x0000 /* absolute, no relocation is necessary */ +#define R_DIR32 0x0006 /* Direct 32-bit reference to the symbols virtual address */ +#define R_SECREL32 0x000B /* Currently ignored, used only for debugging strings FIXME */ +#define R_PCRLONG 0x0014 /* 32-bit reference pc relative to the symbols virtual address */ + +#define IMAGE_REL_AMD64_REL32 0x0004 /* 32-bit reference pc relative to the symbols virtual address */ +#define IMAGE_REL_AMD64_ADDR64 0x0001 /* The 64-bit VA of the relocation target */ +#define IMAGE_REL_AMD64_ADDR32NB 0x0003 /* The 32-bit address without an image base (RVA) */ + +struct syment { + union { + char n_name[8]; + struct { + int n_zeroes; + int n_offset; + } n; + } n; + ul n_value; + short n_scnum; + us n_type; + uc n_sclass; + uc n_numaux; +} __attribute__ ((packed)); + + +static int +ovchk(ul v,ul m) { + + m|=m>>1; + v&=m; + + return (!v || v==m); + +} + +static int +store_val(ul *w,ul m,ul v) { + + massert(ovchk(v,~m)); + *w=(v&m)|(*w&~m); + + return 0; + +} + +static int +add_val(ul *w,ul m,ul v) { + + return store_val(w,m,v+(*w&m)); + +} + + +static unsigned long self_ibase; +#define sym_lvalue(sym_) (!sym_->n_scnum ? self_ibase+sym_->n_value : (unsigned long)start+sym_->n_value) + +static void +relocate(struct scnhdr *sec,struct reloc *rel,struct syment *sym,void *start) { + + ul *where=start+(sec->s_paddr+rel->r.r_vaddr); + + switch(rel->r_type) { + + case R_ABS: + case R_SECREL32: + break; + + case IMAGE_REL_AMD64_ADDR64: + add_val(where,~0L,sym_lvalue(sym)); +#if SIZEOF_LONG == 8 + add_val(where+1,~0L,sym_lvalue(sym)>>32); +#endif + break; + + case IMAGE_REL_AMD64_ADDR32NB: + add_val(where,~0L,sym->n_value); + break; + + case R_DIR32: + add_val(where,~0L,sym_lvalue(sym)); + break; + + case R_PCRLONG: + case IMAGE_REL_AMD64_REL32: + add_val(where,~0L,(ul)((void *)sym_lvalue(sym)-(void *)(where+1))); + break; + + default: + fprintf(stdout, "%d: unsupported relocation type.", rel->r_type); + FEerror("The relocation type was unknown",0); + + } + +} + + +static void +find_init_address(struct syment *sym,struct syment *sye,ul *ptr,char *st1) { + + for(;symn_scnum == 1 && sym->n_value) { + char *s=sym->n.n.n_zeroes ? sym->n.n_name : st1+sym->n.n.n_offset; + if (!strncmp(s,"init_",5) || !strncmp(s,"_init_",6)) + *ptr=sym->n_value; + } + + sym += (sym)->n_numaux; + + } + +} + +static ul +get_sym_svalue(const char *name) { + + struct node *answ; + + return (answ=find_sym_ptable(name)) ? answ->address-self_ibase : + ({massert(!emsg("Unrelocated non-local symbol: %s\n",name));0;}); + +} + +static void +relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { + + long value; + + for (;symn_scnum>0) + sym->n_value = sec1[sym->n_scnum-1].s_paddr; + + else if (!sym->n_scnum) { + + NM(sym,st1,s,value=get_sym_svalue(s)); + + sym->n_value=value; + + } + + sym += (sym)->n_numaux; + + } + +} + +static object +load_memory(struct scnhdr *sec1,struct scnhdr *sece,void *st,ul *init_address) { + + object memory; + struct scnhdr *sec; + ul sz,a,ma; + + BEGIN_NO_INTERRUPT; + + for (sec=sec1,ma=sz=0;secs_flags>>20)&0xf)-1); + massert(a<=8192); + ma=ma ? ma : a; + sz=(sz+a-1)&~(a-1); + sec->s_paddr=sz; + sz+=sec->s_size; + + } + + ma=ma>sizeof(struct contblock) ? ma-1 : 0; + sz+=ma; + + memory=new_cfdata(); + memory->cfd.cfd_size=sz; + memory->cfd.cfd_start=alloc_code_space(sz,-1UL); + + a=(((unsigned long)memory->cfd.cfd_start+ma)&~ma)-((unsigned long)memory->cfd.cfd_start); + *init_address+=a; + for (sec=sec1;secs_paddr+=a; + if (LOAD_SEC(sec)) + memcpy((void *)memory->cfd.cfd_start+sec->s_paddr,st+sec->s_scnptr,sec->s_size); + } + } + + END_NO_INTERRUPT; + + return memory; + +} + +static int +load_self_symbols() { + + FILE *f; + void *v1,*v,*ve; + struct filehdr *fhp; + struct syment *sy1,*sye,*sym; + struct scnhdr *sec1,*sec,*sece; + struct opthdr *h; + struct node *a; + char *st1,*st; + ul ns,sl; + unsigned long jj; + + massert(f=fopen(kcl_self,"r")); + massert(v1=get_mmap(f,&ve)); + + v=v1+*(ul *)(v1+0x3c); + massert(!memcmp("PE\0\0",v,4)); + + fhp=v+4; + h=(void *)(fhp+1); + massert(h->h_magic==0x10b || h->h_magic==0x20b); + self_ibase=h->h_ibase; +#if SIZEOF_LONG == 8 + if (h->h_magic==0x20b) + self_ibase=(self_ibase<<32)+h->h_dbase; +#endif + + sec1=(void *)(fhp+1)+fhp->f_opthdr; + sece=sec1+fhp->f_nscns; + + sy1=v1+fhp->f_ptrsym; + sye=sy1+fhp->f_symnum; + + st1=(char *)sye; + + for (ns=sl=0,sym=sy1;symn_sclass<2 || sym->n_sclass>3 || sym->n_scnum<1) + continue; + + ns++; + + NM(sym,st1,s,sl+=strlen(s)+1); + + sym+=sym->n_numaux; + + } + + c_table.alloc_length=ns; + assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); + assert(st=malloc(sl)); + + for (a=c_table.ptable,sym=sy1;symn_sclass!=2 || sym->n_scnum<1) + continue; + + NM(sym,st1,s,strcpy(st,s)); + + sec=sec1+sym->n_scnum-1; + jj=self_ibase+sym->n_value+sec->s_vaddr; + +#ifdef FIX_ADDRESS + FIX_ADDRESS(jj); +#endif + + a->address=jj; + a->string=st; + + a++; + st+=strlen(st)+1; + sym+=sym->n_numaux; + + } + c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + + for (c_table.local_ptable=a,sym=sy1;symn_sclass!=3 || sym->n_scnum<1) + continue; + + NM(sym,st1,s,strcpy(st,s)); + + sec=sec1+sym->n_scnum-1; + jj=self_ibase+sym->n_value+sec->s_vaddr; + +#ifdef FIX_ADDRESS + FIX_ADDRESS(jj); +#endif + + a->address=jj; + a->string=st; + + a++; + st+=strlen(st)+1; + sym+=sym->n_numaux; + + } + c_table.local_length=a-c_table.local_ptable; + qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); + + massert(c_table.alloc_length==c_table.length+c_table.local_length); + + massert(!un_mmap(v1,ve)); + massert(!fclose(f)); + + return 0; + +} + +int +seek_to_end_ofile(FILE *fp) { + + void *st,*ve; + struct filehdr *fhp; + struct scnhdr *sec1,*sece; + struct syment *sy1,*sye; + const char *st1,*ste; + int i; + + massert(st=get_mmap(fp,&ve)); + + fhp=st; + sec1=(void *)(fhp+1)+fhp->f_opthdr; + sece=sec1+fhp->f_nscns; + sy1=st+fhp->f_ptrsym; + sye=sy1+fhp->f_symnum; + st1=(void *)sye; + ste=st1+*(ul *)st1; + + fseek(fp,(void *)ste-st,0); + while (!(i=getc(fp))); + ungetc(i, fp); + + massert(!un_mmap(st,ve)); + + return 0; + +} + +object +find_init_string(const char *s) { + + FILE *f; + struct filehdr *fhp; + struct scnhdr *sec1,*sece; + struct syment *sy1,*sym,*sye; + char *st1,*ste; + void *st,*est; + object o=OBJNULL; + + massert(f=fopen(s,"r")); + massert(st=get_mmap(f,&est)); + + fhp=st; + sec1=(void *)(fhp+1)+fhp->f_opthdr; + sece=sec1+fhp->f_nscns; + sy1=st+fhp->f_ptrsym; + sye=sy1+fhp->f_symnum; + st1=(void *)sye; + ste=st1+*(ul *)st1; + + for (sym=sy1;symsm.sm_fp; + + massert(st=get_mmap(fp,&est)); + + fhp=st; + sec1=(void *)(fhp+1)+fhp->f_opthdr; + sece=sec1+fhp->f_nscns; + sy1=st+fhp->f_ptrsym; + sye=sy1+fhp->f_symnum; + st1=(void *)sye; + ste=st1+*(ul *)st1; + + find_init_address(sy1,sye,&init_address,st1); + + memory=load_memory(sec1,sece,st,&init_address); + + relocate_symbols(sy1,sye,sec1,st1); + + for (sec=sec1;secs_flags&0xe0) + for (rel=st+sec->s_relptr,rele=rel+(sec->s_flags&0x1000000 ? rel->r.r_count : sec->s_nreloc);relr_symndx,memory->cfd.cfd_start); + + fseek(fp,(void *)ste-st,0); + while ((i = getc(fp)) == 0); + ungetc(i, fp); + + massert(!un_mmap(st,est)); + +#ifdef CLEAR_CACHE + CLEAR_CACHE; +#endif + + call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ", memory->cfd.cfd_start); + + return(memory->cfd.cfd_size); + +} + +#include "sfasli.c" diff --git a/o/sfaslelf.c b/o/sfaslelf.c new file mode 100755 index 0000000..a1b1999 --- /dev/null +++ b/o/sfaslelf.c @@ -0,0 +1,633 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + + +#include +#include +#include +#include +#include +#include +#include +#include + +#include "gclincl.h" + + +#if SIZEOF_LONG == 4 +#define Elfw 32 +#else +#define Elfw 64 +#endif + +#define Elf Mjoin(Elf,Elfw) +#define ELF Mjoin(ELF,Elfw) +#define Ehdr Mjoin(Elf,_Ehdr) +#define Shdr Mjoin(Elf,_Shdr) +#define Sym Mjoin(Elf,_Sym) +#define Rel Mjoin(Elf,_Rel) +#define Rela Mjoin(Elf,_Rela) +#define Word Elf32_Word + +#define ELF_R_SYM(a) Mjoin(ELF,_R_SYM)(a) +#define ELF_R_TYPE(a) Mjoin(ELF,_R_TYPE)(a) +#define ELF_R_INFO(a,b) Mjoin(ELF,_R_INFO)(a,b) +#define ELF_ST_BIND(a) Mjoin(ELF,_ST_BIND)(a) +#define ELF_ST_TYPE(a) Mjoin(ELF,_ST_TYPE)(a) +#define ELF_ST_INFO(a,b) Mjoin(ELF,_ST_INFO)(a,b) +#define ELF_ST_VISIBILITY(a) Mjoin(ELF,_ST_VISIBILITY)(a) + + +#define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) +#define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) +#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +#define LOAD_SYM(sym,st1) (sym->st_value && (EXT_SYM(sym,st1)||LOCAL_SYM(sym))) +#define EXT_SYM(sym,st1) (ELF_ST_BIND(sym->st_info)==STB_GLOBAL||ELF_ST_BIND(sym->st_info)==STB_WEAK||LOAD_SYM_BY_NAME(sym,st1)) +#define LOCAL_SYM(sym) ELF_ST_BIND(sym->st_info)==STB_LOCAL +#define LOAD_SYM_BY_NAME(sym,st1) 0 + +#define MASK(n) (~(~0ULL << (n))) + + + +typedef unsigned long ul; + + + +static Shdr * +get_section(char *s,Shdr *sec,Shdr *sece,const char *sn) { + + for (;secsh_name,s);sec++); + return sec>1; + v&=m; + + return (!v || v==m); + +} + +static int +ovchku(ul v,ul m) { + + return !(v&=m); + +} + +static char *init_section_name=".text"; + +#ifdef SPECIAL_RELOC_H +#include SPECIAL_RELOC_H +#endif + +int +store_val(ul *w,ul m,ul v) { + + *w=(v&m)|(*w&~m); + + return 0; + +} + +int +store_vals(ul *w,ul m,ul v) { + + massert(ovchks(v,~m)); + return store_val(w,m,v); + +} + +int +store_valu(ul *w,ul m,ul v) { + + massert(ovchku(v,~m)); + return store_val(w,m,v); + +} + + +int +add_val(ul *w,ul m,ul v) { + + return store_val(w,m,v+(*w&m)); + +} + +int +add_valu(ul *w,ul m,ul v) { + + return store_valu(w,m,v+(*w&m)); + +} + +int +add_vals(ul *w,ul m,ul v) { + + ul l=*w&m,mm; + + mm=~m; + mm|=mm>>1; + if (l&mm) l|=mm; + + return store_val(w,m,v+l); + +} + +int +add_valsc(ul *w,ul m,ul v) { + + ul l=*w&m,mm; + + mm=~m; + mm|=mm>>1; + if (l&mm) l|=mm; + + return store_vals(w,m,v+l); + +} + +static void +relocate(Sym *sym1,void *v,ul a,ul start,ul *got,ul *gote) { + + Rel *r=v; + Sym *sym; + ul *where,p,s,tp; + + where=(void *)start+r->r_offset; + p=(ul)where; + + sym=sym1+ELF_R_SYM(r->r_info); + s=sym->st_value; + + switch((tp=ELF_R_TYPE(r->r_info))) { + +#include RELOC_H + + default: + massert(!emsg("Unknown reloc type %lu\n", tp)); + + } + +} + +static int +find_init_address(Sym *sym,Sym *syme,Shdr *sec1,Shdr *sece, + const char *sn,const char *st1,ul *init) { + + Shdr *sec; + + for (;symst_shndx; + + if (sec=sece) + continue; + + if (strcmp(sn+sec->sh_name,init_section_name)) + continue; + + if (memcmp("init_",st1+sym->st_name,4)) + continue; + + *init=sym->st_value; + + return 0; + + } + + return -1; + +} + +static int +relocate_symbols(Sym *sym,Sym *syme,Shdr *sec1,Shdr *sece,const char *st1) { + + Shdr *sec; + struct node *a; + + for (;symst_shndx; + + if (secst_value+=sec->sh_addr; + + else if ((a=find_sym_ptable(st1+sym->st_name))) + sym->st_value=a->address; + + else if (ELF_ST_BIND(sym->st_info)!=STB_LOCAL) + massert(!emsg("Unrelocated non-local symbol: %s\n",st1+sym->st_name)); + + } + + return 0; + +} + +#ifdef LARGE_MEMORY_MODEL + +DEFUN_NEW("MARK-AS-LARGE-MEMORY-MODEL",object,fSmark_as_large_memory_model,SI,1,1, + NONE,OO,OO,OO,OO,(object x),"") { + + FILE *f; + void *ve; + Ehdr *fhp; + + coerce_to_filename(x,FN1); + + massert(f=fopen(FN1,"r+")); + massert(fhp=get_mmap_shared(f,&ve)); + + fhp->e_flags|=1; + + massert(!un_mmap(fhp,ve)); + massert(!fclose(f)); + + return Cnil; + +} + +#endif + +static object +load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) { + + object memory; + Shdr *sec; + ul gsz,sz,a,ma; + + BEGIN_NO_INTERRUPT; + + for (sec=sec1,ma=sz=0;secsh_addralign; + ma=ma ? ma : a; + sz=(sz+a-1)&~(a-1); + sec->sh_addr=sz; + sz+=sec->sh_size; + + } + + ma=ma>sizeof(struct contblock) ? ma-1 : 0; + sz+=ma; + + gsz=0; + if (**got) { + gsz=(**got+1)*sizeof(**got)-1; + sz+=gsz; + } + + memory=new_cfdata(); + memory->cfd.cfd_size=sz; + memory->cfd.cfd_start=alloc_code_space(sz, +#ifdef MAX_DEFAULT_MEMORY_MODEL_CODE_ADDRESS +#ifdef LARGE_MEMORY_MODEL + (((Ehdr *)v1)->e_flags) ? -1UL : MAX_DEFAULT_MEMORY_MODEL_CODE_ADDRESS +#else + MAX_DEFAULT_MEMORY_MODEL_CODE_ADDRESS +#endif +#else + -1UL +#endif + ); + + a=(ul)memory->cfd.cfd_start; + a=(a+ma)&~ma; + for (sec=sec1;secsh_addr+=a; + if (LOAD_SEC(sec)) + memcpy((void *)sec->sh_addr,v1+sec->sh_offset,sec->sh_size); + } + + if (**got) { + sz=**got; + *got=(void *)memory->cfd.cfd_start+memory->cfd.cfd_size-gsz; + gsz=sizeof(**got)-1; + *got=(void *)(((ul)*got+gsz)&~gsz); + *gote=*got+sz; + } + + END_NO_INTERRUPT; + + return memory; + +} + + +static int +relocate_code(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,ul *got,ul *gote) { + + Shdr *jsec,*sec; + void *v,*ve; + Rela *ra; + + for (sec=sec1;secsh_info; + + if (jsec=sece) + continue; + if (!ALLOC_SEC(jsec)) + continue; + + if (sec->sh_type!=SHT_REL && sec->sh_type!=SHT_RELA) + continue; + + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,ra=v;vsh_entsize,ra=v) + relocate(sym1,ra,sec->sh_type==SHT_RELA ? ra->r_addend : 0,jsec->sh_addr,got,gote); + + } + + return 0; + +} + +static int +parse_map(void *v1,Shdr **sec1,Shdr **sece, + char **sn,Sym **sym1,Sym **syme,char **st1,ul *end, + Sym **dsym1,Sym **dsyme,char **dst1) { + + Ehdr *fhp; + Shdr *sec; + + fhp=v1; + *sec1=v1+fhp->e_shoff; + *sece=*sec1+fhp->e_shnum; + + *sn=v1+(*sec1)[fhp->e_shstrndx].sh_offset; + + massert(sec=get_section(".symtab",*sec1,*sece,*sn)); + *sym1=v1+sec->sh_offset; + *syme=*sym1+sec->sh_size/sec->sh_entsize; + + massert(sec=get_section(".strtab",*sec1,*sece,*sn)); + *st1=v1+sec->sh_offset; + + *dsym1=*dsyme=NULL; + *dst1=NULL; + if ((sec=get_section(".dynsym",*sec1,*sece,*sn))) { + *dsym1=v1+sec->sh_offset; + *dsyme=*dsym1+sec->sh_size/sec->sh_entsize; + massert(sec=get_section(".dynstr",*sec1,*sece,*sn)); + *dst1=v1+sec->sh_offset; + } + + for (*end=fhp->e_shoff+fhp->e_shnum*fhp->e_shentsize,sec=*sec1;sec<*sece;sec++) + *end=ulmax(*end,sec->sh_offset+sec->sh_size); + + return 0; + +} + + +static int +set_symbol_stubs(void *v,Shdr *sec1,Shdr *sece,const char *sn, + Sym *ds1,Sym *dse,const char *dst1, + Sym *sym1,Sym *syme,const char *st1) { + + Shdr *sec,*psec; + Rel *r; + ul np,ps,p; + void *ve; + +#ifdef SPECIAL_RELOC_H + massert(!find_special_params(v,sec1,sece,sn,st1,ds1,dse,sym1,syme)); +#endif + + if (!(psec=get_section(".plt",sec1,sece,sn))) + return 0; + + massert((sec=get_section( ".rel.plt",sec1,sece,sn)) || + (sec=get_section(".rela.plt",sec1,sece,sn))); + + np=sec->sh_size/sec->sh_entsize; + ps=psec->sh_size/np; + + v+=sec->sh_offset; + ve=v+np*sec->sh_entsize; + + p=psec->sh_addr+psec->sh_size%np; + + for (r=v;vsh_entsize,p+=ps,r=v) + if (!ds1[ELF_R_SYM(r->r_info)].st_value) + ds1[ELF_R_SYM(r->r_info)].st_value=p; + + + return 0; + +} + +static int +calc_space(ul *ns,ul *sl,Sym *sym1,Sym *syme,const char *st1,Sym *d1,Sym *de,const char *ds1) { + + Sym *sym,*d; + + for (sym=sym1;symst_name,ds1+d->st_name);d++); + if (dst_name)+1; + + } + + return 0; + +} + +static int +load_ptable(struct node **a,char **s,Sym *sym1,Sym *syme,const char *st1, + Sym *d1,Sym *de,const char *ds1,ufixnum lp) { + + Sym *sym,*d; + + for (sym=sym1;symst_name,ds1+d->st_name);d++); + if (daddress=sym->st_value; + (*a)->string=(*s); + strcpy((*s),st1+sym->st_name); + +#ifdef FIX_HIDDEN_SYMBOLS + FIX_HIDDEN_SYMBOLS(st1,a,sym1,sym,syme); +#endif + + (*a)++; + (*s)+=strlen(*s)+1; + + } + + return 0; + +} + + +static int +load_self_symbols() { + + FILE *f; + char *sn,*st1,*s,*dst1; + Shdr *sec1,*sece; + Sym *sym1,*syme,*dsym1,*dsyme; + void *v1,*ve; + ul ns,sl,end; + struct node *a; + + massert(f=fopen(kcl_self,"r")); + massert(v1=get_mmap(f,&ve)); + + massert(!parse_map(v1,&sec1,&sece,&sn,&sym1,&syme,&st1,&end,&dsym1,&dsyme,&dst1)); + +#ifndef STATIC_LINKING + massert(!set_symbol_stubs(v1,sec1,sece,sn,dsym1,dsyme,dst1,sym1,syme,st1)); +#endif + + ns=sl=0; + massert(!calc_space(&ns,&sl,dsym1,dsyme,dst1,NULL,NULL,NULL)); + massert(!calc_space(&ns,&sl,sym1,syme,st1,dsym1,dsyme,dst1)); + + c_table.alloc_length=ns; + massert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); + massert(s=malloc(sl)); + + a=c_table.ptable; + massert(!load_ptable(&a,&s,dsym1,dsyme,dst1,NULL,NULL,NULL,0)); + massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1,0)); + c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + + c_table.local_ptable=a; + massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1,1)); + c_table.local_length=a-c_table.local_ptable; + qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); + + massert(c_table.alloc_length==c_table.length+c_table.local_length); + + massert(!un_mmap(v1,ve)); + massert(!fclose(f)); + + return 0; + +} + +int +seek_to_end_ofile(FILE *fp) { + + void *v1,*ve; + Shdr *sec1,*sece; + Sym *sym1,*syme,*dsym1,*dsyme; + char *sn,*st1,*dst1; + ul end; + + massert(v1=get_mmap(fp,&ve)); + + massert(!parse_map(v1,&sec1,&sece,&sn,&sym1,&syme,&st1,&end,&dsym1,&dsyme,&dst1)); + + massert(!fseek(fp,end,SEEK_SET)); + + massert(!un_mmap(v1,ve)); + + return 0; + +} + +static int +clear_protect_memory(object memory) { + + void *p,*pe; + + p=(void *)((unsigned long)memory->cfd.cfd_start & ~(PAGESIZE-1)); + pe=(void *)((unsigned long)(memory->cfd.cfd_start+memory->cfd.cfd_size + PAGESIZE-1) & ~(PAGESIZE-1)); + + return gcl_mprotect(p,pe-p,PROT_READ|PROT_WRITE|PROT_EXEC); + +} + +int +fasload(object faslfile) { + + FILE *fp; + char *sn,*st1,*dst1; + ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; + object memory; + Shdr *sec1,*sece; + Sym *sym1,*syme,*dsym1,*dsyme; + void *v1,*ve; + + fp = faslfile->sm.sm_fp; + + massert(v1=get_mmap(fp,&ve)); + + massert(!parse_map(v1,&sec1,&sece,&sn,&sym1,&syme,&st1,&end,&dsym1,&dsyme,&dst1)); + +#ifdef SPECIAL_RELOC_H + massert(!label_got_symbols(v1,sec1,sece,sym1,syme,st1,sn,got)); +#endif + + massert(memory=load_memory(sec1,sece,v1,&got,&gote)); + + massert(!relocate_symbols(sym1,syme,sec1,sece,st1)); + + massert(!find_init_address(sym1,syme,sec1,sece,sn,st1,&init_address)); + + massert(!relocate_code(v1,sec1,sece,sym1,got,gote)); + + massert(!fseek(fp,end,SEEK_SET)); + + massert(!un_mmap(v1,ve)); + + massert(!clear_protect_memory(memory)); + +#if defined(HAVE_BUILTIN_CLEAR_CACHE) + __builtin___clear_cache((void *)memory->cfd.cfd_start,(void *)memory->cfd.cfd_start+memory->cfd.cfd_size); +#elif defined(CLEAR_CACHE) + CLEAR_CACHE; +#endif + + init_address-=(ul)memory->cfd.cfd_start; + call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ",memory->cfd.cfd_start); + + return(memory->cfd.cfd_size); + +} + +#include "sfasli.c" diff --git a/o/sfasli.c b/o/sfasli.c new file mode 100755 index 0000000..c7b23bc --- /dev/null +++ b/o/sfasli.c @@ -0,0 +1,143 @@ +/* +Copyright William Schelter. All rights reserved. */ + +#if !defined(HAVE_LIBBFD) && !defined(SPECIAL_RSYM) +#error Need either BFD or SPECIAL_RSYM +#endif + +#ifndef SPECIAL_RSYM + +/* Replace this with gcl's own hash structure at some point */ +static int +build_symbol_table_bfd(void) { + + int u,v; + unsigned long pa; + asymbol **q; + + bfd_init(); + if (!(bself=bfd_openr(kcl_self,0))) + FEerror("Cannot open self\n",0); + if (!bfd_check_format(bself,bfd_object)) + FEerror("I'm not an object",0); +/* if (link_info.hash) */ +/* bfd_link_hash_table_free(bself,link_info.hash); */ +#ifdef HAVE_OUTPUT_BFD + link_info.output_bfd = bfd_openw("/dev/null", bfd_get_target(bself)); +#endif + if (!(link_info.hash = bfd_link_hash_table_create (bself))) + FEerror("Cannot make hash table",0); + if (!bfd_link_add_symbols(bself,&link_info)) + FEerror("Cannot add self symbols\n",0); + if ((u=bfd_get_symtab_upper_bound(bself))<0) + FEerror("Cannot get self's symtab upper bound",0); + +#ifdef HAVE_ALLOCA + q=(asymbol **)alloca(u); +#else + q=(asymbol **)malloc(u); +#endif + if ((v=bfd_canonicalize_symtab(bself,q))<0) + FEerror("Cannot canonicalize self's symtab",0); + + for (u=0;uname) + continue; + + if (strncmp(q[u]->section->name,"*UND*",5) && !(q[u]->flags & BSF_WEAK)) + continue; + + if ((c=(char *)strstr(q[u]->name,"@@"))) { + *c=0; + if (!(h=bfd_link_hash_lookup(link_info.hash,q[u]->name,MY_BFD_TRUE,MY_BFD_TRUE,MY_BFD_TRUE))) + FEerror("Cannot make new hash entry",0); + h->type=bfd_link_hash_new; + } else if + (!(h=bfd_link_hash_lookup(link_info.hash,q[u]->name,MY_BFD_FALSE,MY_BFD_FALSE,MY_BFD_TRUE)) && + !(h=bfd_link_hash_lookup(link_info.hash,q[u]->name,MY_BFD_TRUE,MY_BFD_TRUE,MY_BFD_TRUE))) + FEerror("Cannot make new hash entry",0); + + if (h->type!=bfd_link_hash_defined) { + if (!q[u]->section) + FEerror("Symbol ~S is missing section",1,make_simple_string(q[u]->name)); + if (!my_plt(q[u]->name,&pa)) { +/* printf("my_plt %s %p\n",q[u]->name,(void *)pa); */ + if (q[u]->value && q[u]->value!=pa) + FEerror("plt address mismatch", 0); + else + q[u]->value=pa; + } + if (q[u]->value) { + h->type=bfd_link_hash_defined; + h->u.def.value=q[u]->value+q[u]->section->vma; + h->u.def.section=q[u]->section; + } + } + + if (c) { + *c='@'; + c=NULL; + } + } + +#ifndef HAVE_ALLOCA + free(q); +#endif + + return 0; + +} + +#endif /* special_rsym */ + +LFD(build_symbol_table)(void) { + + printf("Building symbol table for %s ..\n",kcl_self);fflush(stdout); + +#ifdef SPECIAL_RSYM + +#ifndef USE_DLOPEN + load_self_symbols(); +#endif + +#else + + build_symbol_table_bfd(); + +#endif + +} + +#ifndef _WIN32 +int +use_symbols(double d,...) { + + double d2; +#ifndef DARWIN + extern void sincos(double,double *,double *); + + sincos(d,&d,&d2); + +#else + + d=sin(d)+cos(d); + d2=sin(d)+cos(d); + +#endif + + return (int)(d+d2); + +} +#endif + +void +gcl_init_sfasl() { + +#ifdef SFASL + make_si_function("BUILD-SYMBOL-TABLE",build_symbol_table); +#endif + +} diff --git a/o/sfaslmacho.c b/o/sfaslmacho.c new file mode 100644 index 0000000..c39f52f --- /dev/null +++ b/o/sfaslmacho.c @@ -0,0 +1,584 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#ifdef _LP64 +#define mach_header mach_header_64 +#define nlist nlist_64 +#define segment_command segment_command_64 +#undef LC_SEGMENT +#define LC_SEGMENT LC_SEGMENT_64 +#define section section_64 +#undef MH_MAGIC +#define MH_MAGIC MH_MAGIC_64 +#endif + +#ifndef S_16BYTE_LITERALS +#define S_16BYTE_LITERALS 0 +#endif + +#define ALLOC_SEC(sec) ({ul _fl=sec->flags&SECTION_TYPE;\ + _fl<=S_SYMBOL_STUBS || _fl==S_16BYTE_LITERALS;}) + +#define LOAD_SEC(sec) ({ul _fl=sec->flags&SECTION_TYPE;\ + (_fl<=S_SYMBOL_STUBS || _fl==S_16BYTE_LITERALS) && _fl!=S_ZEROFILL;}) + + +#define MASK(n) (~(~0ULL << (n))) + + + +typedef unsigned long ul; + + + +#ifdef STATIC_RELOC_VARS +STATIC_RELOC_VARS +#endif + + + +static int +ovchk(ul v,ul m) { + + m|=m>>1; + v&=m; + + return (!v || v==m); + +} + +static int +store_val(ul *w,ul m,ul v) { + + massert(ovchk(v,~m)); + *w=(v&m)|(*w&~m); + + return 0; + +} + +static int +add_val(ul *w,ul m,ul v) { + + return store_val(w,m,v+(*w&m)); + +} + + +#ifndef _LP64 +/*redirect trampolines gcc-4.0 gives no reloc for stub sections on x86 only*/ +static int +redirect_trampoline(struct relocation_info *ri,ul o,ul rel, + struct section *sec1,ul *io1,struct nlist *n1,ul *a) { + + struct section *js=sec1+ri->r_symbolnum-1; + + if (ri->r_extern) + return 0; + + if ((js->flags&SECTION_TYPE)!=S_SYMBOL_STUBS) + return 0; + + if (ri->r_pcrel) o+=rel; + o-=js->addr; + + massert(!(o%js->reserved2)); + o/=js->reserved2; + massert(o>=0 && osize/js->reserved2); + + *a=n1[io1[js->reserved1+o]].n_value; + ri->r_extern=1; + + return 0; + +} +#endif + +static int +relocate(struct relocation_info *ri,struct section *sec, + struct section *sec1,ul start,ul *io1,struct nlist *n1,ul *got,ul *gote) { + + struct scattered_relocation_info *sri=(void *)ri; + ul *q=(void *)(sec->addr+(sri->r_scattered ? sri->r_address : ri->r_address)); + ul a,rel=(ul)(q+1); + + if (sri->r_scattered) + a=sri->r_value; + else if (ri->r_extern) + a=n1[ri->r_symbolnum].n_value; + else + a=start; + + switch(sri->r_scattered ? sri->r_type : ri->r_type) { + +#include RELOC_H + + default: + FEerror("Unknown reloc type\n",0); + break; + + } + + return 0; + +} + +static int +relocate_symbols(struct nlist *n1,struct nlist *ne,char *st1,ul start) { + + struct nlist *n; + struct node *nd; + + for (n=n1;nn_sect) + n->n_value+=start; + else if ((nd=find_sym_ptable(st1+n->n_un.n_strx))) + n->n_value=nd->address; + else if (n->n_type&(N_PEXT|N_EXT)) + massert(!emsg("Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); + + return 0; + +} + +static int +find_init_address(struct nlist *n1,struct nlist *ne,const char *st1,ul *init) { + + struct nlist *n; + + for (n=n1;nn_un.n_strx,5);n++); + massert(nn_value; + + return 0; + +} + + + +static object +load_memory(struct section *sec1,struct section *sece,void *v1, + ul *p,ul **got,ul **gote,ul *start) { + + ul sz,gsz,sa,ma,a,fl; + struct section *sec; + object memory; + + BEGIN_NO_INTERRUPT; + + for (*p=sz=ma=0,sa=-1,sec=sec1;secaddraddr; + ma=1<align; + } + + a=sec->addr+sec->size; + if (szflags&SECTION_TYPE; + if (fl==S_NON_LAZY_SYMBOL_POINTERS || fl==S_LAZY_SYMBOL_POINTERS) + *p+=sec->size*sizeof(struct relocation_info)/sizeof(void *); + + } + + ma=ma>sizeof(struct contblock) ? ma-1 : 0; + sz+=ma; + + gsz=0; + if (**got) { + gsz=(**got+1)*sizeof(**got)-1; + sz+=gsz; + } + + memory=new_cfdata(); + memory->cfd.cfd_size=sz; + memory->cfd.cfd_start=alloc_code_space(sz,-1UL); + + a=(ul)memory->cfd.cfd_start; + a=(a+ma)&~ma; + for (sec=sec1;secaddr+=a; + if (LOAD_SEC(sec)) + memcpy((void *)sec->addr,v1+sec->offset,sec->size); + } + + if (**got) { + sz=**got; + *got=(void *)memory->cfd.cfd_start+memory->cfd.cfd_size-gsz; + gsz=sizeof(**got)-1; + *got=(void *)(((ul)*got+gsz)&~gsz); + *gote=*got+sz; + } + + *start=a; + + END_NO_INTERRUPT; + + return memory; + +} + + +static int +parse_file(void *v1, + struct section **sec1,struct section **sece, + struct nlist **n1,struct nlist **ne, + char **st1,char **ste,ul **io1) { + + struct mach_header *mh; + struct load_command *lc; + struct symtab_command *sym=NULL; + struct dysymtab_command *dsym=NULL; + struct segment_command *seg; + ul i; + void *v=v1; + + mh=v; + v+=sizeof(*mh); + + for (i=0,*sec1=NULL;(lc=v) && incmds;i++,v+=lc->cmdsize) + + switch(lc->cmd) { + + case LC_SEGMENT: + + if (*sec1 && *sece>*sec1) continue; + + seg=v; + *sec1=(void *)(seg+1); + *sece=*sec1+seg->nsects; + + break; + case LC_SYMTAB: + massert(!sym); + sym=v; + *n1=v1+sym->symoff; + *ne=*n1+sym->nsyms; + *st1=v1+sym->stroff; + *ste=*st1+sym->strsize; + break; + case LC_DYSYMTAB: + massert(!dsym); + dsym=v; + *io1=v1+dsym->indirectsymoff; + break; + } + + return 0; + +} + + +static int +set_symbol_stubs(void *v1,struct nlist *n1,struct nlist *ne,ul *uio,const char *st1) { + + struct mach_header *mh; + struct load_command *lc; + struct segment_command *seg; + struct section *sec1,*sec,*sece; + ul i,ns; + void *v=v1,*vv; + int *io1,*io,*ioe; + + mh=v; + v+=sizeof(*mh); + + for (i=0;(lc=v) && incmds;i++,v+=lc->cmdsize) + + switch(lc->cmd) { + + case LC_SEGMENT: + + for (seg=v,sec1=sec=(void *)(seg+1),sece=sec1+seg->nsects;secflags&SECTION_TYPE; + if (ns!=S_SYMBOL_STUBS && + ns!=S_LAZY_SYMBOL_POINTERS && + ns!=S_NON_LAZY_SYMBOL_POINTERS) + continue; + + io1=(void *)uio; + io1+=sec->reserved1; + if (!sec->reserved2) sec->reserved2=sizeof(void *); + ioe=io1+sec->size/sec->reserved2; + + for (io=io1,vv=(void *)sec->addr;ioreserved2,io++) + if (*io>=0 && *ioflags&SECTION_TYPE,*io; + struct relocation_info *ri,*re; + struct scattered_relocation_info *sri; + + if (fl!=S_NON_LAZY_SYMBOL_POINTERS && fl!=S_LAZY_SYMBOL_POINTERS) + return 0; + + sec->nreloc=sec->size/sizeof(void *); + sec->reloff=*p-v1; + ri=*p; + re=ri+sec->nreloc; + *p=re; + + io1+=sec->reserved1; + for (io=io1;rir_symbolnum=*io; + ri->r_extern=1; + ri->r_address=(io-io1)*sizeof(void *); + ri->r_type=GENERIC_RELOC_VANILLA; + ri->r_pcrel=0; + sri=(void *)ri; + sri->r_scattered=0; + + } + + return 0; + +} + + +static int +relocate_code(void *v1,struct section *sec1,struct section *sece, + void **p,ul *io1,struct nlist *n1,ul *got,ul *gote,ul start) { + + struct section *sec; + struct relocation_info *ri,*re; + + for (sec=sec1;secreloff,re=ri+sec->nreloc;rin_type & N_STAB) + continue; + + ns++; + sl+=strlen(sym->n_un.n_strx+strtab)+1; + + } + + c_table.alloc_length=ns; + assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); + assert(s=malloc(sl)); + + for (a=c_table.ptable,sym=sym1;symn_type & N_STAB) || !(sym->n_type & N_EXT)) + continue; + + a->address=sym->n_value; + a->string=s; + strcpy(s,sym->n_un.n_strx+strtab); + + a++; + s+=strlen(s)+1; + + } + c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + + for (c_table.local_ptable=a,sym=sym1;symn_type & N_STAB) || sym->n_type & N_EXT) + continue; + + a->address=sym->n_value; + a->string=s; + strcpy(s,sym->n_un.n_strx+strtab); + + a++; + s+=strlen(s)+1; + + } + c_table.local_length=a-c_table.local_ptable; + qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); + + massert(c_table.alloc_length==c_table.length+c_table.local_length); + + massert(!un_mmap(addr,addre)); + massert(!fclose(f)); + + return 0; + +} + +int +seek_to_end_ofile(FILE *f) { + + struct mach_header *mh; + struct load_command *lc; + struct symtab_command *st=NULL; + void *addr,*addre; + int i; + + massert(addr=get_mmap(f,&addre)); + + mh=addr; + lc=addr+sizeof(*mh); + + for (i=0;incmds;i++,lc=(void *)lc+lc->cmdsize) + if (lc->cmd==LC_SYMTAB) { + st=(void *) lc; + break; + } + massert(st); + + fseek(f,st->stroff+st->strsize,SEEK_SET); + + massert(!un_mmap(addr,addre)); + + return 0; + +} + +#ifndef GOT_RELOC +#define GOT_RELOC(a) 0 +#endif + +static int +label_got_symbols(void *v1,struct section *sec,struct nlist *n1,struct nlist *ne,ul *gs) { + + struct relocation_info *ri,*re; + struct nlist *n; + + *gs=0; + for (n=n1;nn_desc=0; + + for (ri=v1+sec->reloff,re=ri+sec->nreloc;rir_extern); + n=n1+ri->r_symbolnum; + if (!n->n_desc) + n->n_desc=++*gs; + + } + + return 0; + +} + +static int +clear_protect_memory(object memory) { + + void *p,*pe; + + p=(void *)((unsigned long)memory->cfd.cfd_start & ~(PAGESIZE-1)); + pe=(void *)((unsigned long)(memory->cfd.cfd_start+memory->cfd.cfd_size + PAGESIZE-1) & ~(PAGESIZE-1)); + + return gcl_mprotect(p,pe-p,PROT_READ|PROT_WRITE|PROT_EXEC); + +} + + +int +fasload(object faslfile) { + + FILE *fp; + ul init_address=-1; + object memory; + void *v1,*ve,*p; + struct section *sec1,*sece=NULL; + struct nlist *n1=NULL,*ne=NULL; + char *st1=NULL,*ste=NULL; + ul gs,*got=&gs,*gote,*io1=NULL,rls,start; + + fp = faslfile->sm.sm_fp; + + massert(v1=get_mmap(fp,&ve)); + + parse_file(v1,&sec1,&sece,&n1,&ne,&st1,&ste,&io1); + + label_got_symbols(v1,sec1,n1,ne,got); + + massert(memory=load_memory(sec1,sece,v1,&rls,&got,&gote,&start)); + + massert(p=alloca(rls)); + + relocate_symbols(n1,ne,st1,start); + + find_init_address(n1,ne,st1,&init_address); + + relocate_code(v1,sec1,sece,&p,io1,n1,got,gote,start); + + fseek(fp,(void *)ste-v1,SEEK_SET); + + massert(!clear_protect_memory(memory)); + +#ifdef CLEAR_CACHE + CLEAR_CACHE; +#endif + + massert(!un_mmap(v1,ve)); + + init_address-=(ul)memory->cfd.cfd_start; + call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ",memory->cfd.cfd_start); + + return(memory->cfd.cfd_size); + + } + +#include "sfasli.c" diff --git a/o/sfaslmacosx.c b/o/sfaslmacosx.c new file mode 100644 index 0000000..eff1c72 --- /dev/null +++ b/o/sfaslmacosx.c @@ -0,0 +1,249 @@ +/* + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include + +#include "ptable.h" + +typedef int (*func) (); + +/* Externalize the command line used to build loadable object files (a.k.a. bundles). */ +object sSAmacosx_ldcmdA = 0L; + +#define sfasl_error(a,b...) {emsg(a,b);do_gcl_abort();} + +/* static void get_init_name (object faslfile, char *init_fun) */ +/* { */ +/* object path = coerce_to_pathname (faslfile); */ +/* char *p; */ + +/* strcpy (init_fun, "_init_"); */ +/* coerce_to_filename (path->pn.pn_name, init_fun + 6); */ + +/* for (p = init_fun + 6 ; *p ; p++) */ +/* if (*p == '-') *p = '_'; */ +/* } */ + +static NSSymbol +get_init_sym(NSModule module,object ff) { + + static object inf; + static struct string st; + object x; + char ib[MAXPATHLEN+1]; + NSSymbol v; + + if (!inf) { + + object x; + static struct string st; + set_type_of(&st,t_string); + st.st_self="COMPILER"; + st.st_dim=st.st_fillp=strlen(st.st_self); + if ((x=find_package((object)&st))==Cnil) + sfasl_error("Cannot find compiler package\n"); + st.st_self="INIT-NAME"; + st.st_dim=st.st_fillp=strlen(st.st_self); + if ((inf=find_symbol((object)&st,x))==Cnil) { + inf=NULL; + sfasl_error("Cannot find function COMPILER::INIT-NAME\n"); + } + + } + + set_type_of(&st,t_string); + st.st_self=ff->st.st_self; + st.st_dim=st.st_fillp=ff->st.st_dim; + x=ifuncall1(inf,(object)&st); + if (x->d.t!=t_string) + sfasl_error("INIT-NAME error\n"); + assert(snprintf(ib,sizeof(ib),"_init_%-.*s",x->st.st_dim,x->st.st_self)>0); + + if (!(v=NSLookupSymbolInModule(module, ib))) { + x=ifuncall2(inf,(object)&st,Ct); + if (x->d.t!=t_string) + sfasl_error("INIT-NAME error\n"); + assert(snprintf(ib,sizeof(ib),"_init_%-.*s",x->st.st_dim,x->st.st_self)>0); + if (!(v=NSLookupSymbolInModule(module, ib))) + sfasl_error("Cannot lookup init-name\n"); + } + + return v; + +} + +static func prepare_bundle (object faslfile, char *filename) +{ + NSObjectFileImage image; + NSModule module; + NSSymbol nssym; + int (*fptr) (); + + unsigned long n; + unsigned long vmsize = 0; + unsigned long vmaddr_slide = 0; + unsigned long base_addr = (unsigned long) -1; + + extern void mark_region (unsigned long address, unsigned long size); + + if (NSCreateObjectFileImageFromFile (filename , &image) != NSObjectFileImageSuccess) { + sfasl_error ("cannot create object file image\n"); + } + + if (!(module = NSLinkModule (image, filename, NSLINKMODULE_OPTION_RETURN_ON_ERROR | + NSLINKMODULE_OPTION_PRIVATE | NSLINKMODULE_OPTION_BINDNOW))) { + sfasl_error ("cannot link bundle\n"); + } + + nssym=get_init_sym(module,faslfile); +/* if (!(nssym = NSLookupSymbolInModule (module, "_init_code"))) */ +/* { */ +/* char init_fun [256]; */ + +/* get_init_name (faslfile, init_fun); */ + +/* if (!(nssym = NSLookupSymbolInModule (module, init_fun))) { */ +/* sfasl_error ("cannot retrieve entry point symbol in bundle\n"); */ +/* } */ +/* } */ + + if (!(fptr = (int (*) ()) NSAddressOfSymbol (nssym))) { + sfasl_error ("cannot retrieve entry point address\n"); + } + + for (n = _dyld_image_count () ; --n != (unsigned long) -1 ; ) + { + if (strstr (filename, _dyld_get_image_name (n))) + { + struct mach_header *mh = _dyld_get_image_header (n); + struct load_command *lc = (struct load_command *) (mh+1); + unsigned long i; + + vmsize = 0; + + for (i=0 ; i < mh->ncmds ; i++) { + if (lc->cmd == LC_SEGMENT) { + if (base_addr == (unsigned long) -1) { + base_addr = ((struct segment_command *) lc)->vmaddr; + } + vmsize += ((struct segment_command *) lc)->vmsize; + } + lc = (struct load_command *) ((char *) lc + lc->cmdsize); + } + + vmaddr_slide = _dyld_get_image_vmaddr_slide (n); + + break; + } + } + + if (base_addr != (unsigned long) -1) { + mark_region (vmaddr_slide - base_addr, vmsize); + } else { + sfasl_error ("could not retrieve newly created bundle image\n"); + } + + return (fptr); +} + +int fasload (object faslfile) +{ + object faslstream; + object memory; + object data; + + int (*fptr) (); + + char filename [MAXPATHLEN]; + char tmpfile [MAXPATHLEN]; + + char cmd [256]; + + static int count = 0; + + static char ldfmt [] = "gcc -bind_at_load -bundle -bundle_loader %s -o %s %s"; + + char fmt [MAXPATHLEN]; + + extern int seek_to_end_ofile (FILE *); + + if (count == 0) { + /* DEFVAR ("*MACOSX-LDCMD*",sSAmacosx_ldcmdA,LISP,make_simple_string(ldfmt),""); */ + sSAmacosx_ldcmdA = make_special ("*MACOSX-LDCMD*", make_simple_string (ldfmt)); + count = time (0); + } + + coerce_to_filename (truename (faslfile), filename); + + snprintf (tmpfile, sizeof (tmpfile), "/tmp/ufas%dx.so", count++); + + mkstemp (tmpfile); + symlink (filename, tmpfile); + + faslstream = open_stream (faslfile, smm_input, Cnil, sKerror); + + /* I guess the program will crash if a dumped image is ever dynamically relinked against + a version of a shared library different from the one used at the time the bundle got + loaded (if the bundle makes reference to this shared library). To avoid this, we + would need all external bundle calls to be indirected through the loader image stubs. */ + + coerce_to_filename (symbol_value (sSAmacosx_ldcmdA), fmt); + + snprintf (cmd, sizeof(cmd), fmt, kcl_self, tmpfile, filename); + + if (system (cmd) != 0) { + sfasl_error ("cannot execute command `%s'\n", cmd); + } + + fptr = prepare_bundle (faslfile, tmpfile); + + if (seek_to_end_ofile (faslstream->sm.sm_fp) != 1) { + sfasl_error ("error seeking to end of object file"); + } + + close_stream (faslstream); + + memory=new_cfdata(); + + if (symbol_value (sLAload_verboseA) != Cnil) + printf (" start address (dynamic) %p ", fptr); + + call_init (0,memory,faslstream); + + unlink (tmpfile); + + return memory->cfd.cfd_size; +} + +void unlink_loaded_files () { + +} + +#include "sfasli.c" diff --git a/o/sgbc.c b/o/sgbc.c new file mode 100755 index 0000000..4927e28 --- /dev/null +++ b/o/sgbc.c @@ -0,0 +1,1043 @@ +/* Copyright William Schelter. All rights reserved. + + Stratified Garbage Collection (SGC) + + Write protects pages to tell which ones have been written + to recently, for more efficient garbage collection. + +*/ + +#ifdef BSD +/* ulong may have been defined in mp.h but the define is no longer needed */ +#undef ulong +#include +#define PROT_READ_WRITE_EXEC (PROT_READ | PROT_WRITE |PROT_EXEC) +#define PROT_READ_EXEC (PROT_READ|PROT_EXEC) +#endif +#ifdef AIX3 +#include +#define PROT_READ_EXEC RDONLY /*FIXME*/ +#define PROT_READ_WRITE_EXEC UDATAKEY +int mprotect(); +#endif + +#ifdef __MINGW32__ +#include +#define PROT_READ_WRITE_EXEC PAGE_EXECUTE_READWRITE +#define PROT_READ_EXEC PAGE_READONLY /*FIXME*/ + +int gclmprotect ( void *addr, size_t len, int prot ) { + int old, rv; + rv = VirtualProtect ( (LPVOID) addr, len, prot, &old ); + if ( 0 == rv ) { + fprintf ( stderr, "mprotect: VirtualProtect %x %d %d failed\n", addr, len, prot ); + rv = -1; + } else { + rv =0; + } + return (rv); +} +/* Avoid clash with libgcc's mprotect */ +#define mprotect gclmprotect + +#endif + +#if defined(DARWIN) +#include +#endif + +#include + +#ifdef SDEBUG +object sdebug; +joe1(){;} +joe() {;} +#endif + +/* structures and arrays of type t, need to be marked if their + bodies are not write protected even if the headers are. + So we should keep these on pages particular to them. + Actually we will change structure sets to touch the structure + header, that way we won't have to keep the headers in memory. + This takes only 1.47 as opposed to 1.33 microseconds per set. +*/ +static void +sgc_mark_phase(void) { + + STATIC fixnum i, j; + STATIC struct package *pp; + STATIC bds_ptr bdp; + STATIC frame_ptr frp; + STATIC ihs_ptr ihsp; + STATIC struct pageinfo *v; + + mark_object(Cnil->s.s_plist); + mark_object(Ct->s.s_plist); + + /* mark all non recent data on writable pages */ + { + long t,i=page(heap_end); + struct typemanager *tm; + char *p; + + for (v=cell_list_head;v;v=v->next) { + i=page(v); + if (v->sgc_flags&SGC_PAGE_FLAG || !WRITABLE_PAGE_P(i)) continue; + + t=v->type; + tm=tm_of(t); + p=pagetochar(i); + for (j = tm->tm_nppage; --j >= 0; p += tm->tm_size) { + object x = (object) p; +#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type) && x->d.s) continue; +#endif + mark_object1(x); + } + } + } + + /* mark all non recent data on writable contiguous pages */ + if (what_to_collect == t_contiguous) + for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) { + void *s=CB_DATA_START(v),*e=CB_DATA_END(v),*p,*q; + bool z=get_sgc_bit(v,s); + for (p=s;pbds_sym); + mark_object(bdp->bds_val); + } + + for (frp = frs_org; frp <= frs_top; frp++) + mark_object(frp->frs_val); + + for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++) + mark_object(ihsp->ihs_function); + + for (i = 0; i < mark_origin_max; i++) + mark_object(*mark_origin[i]); + for (i = 0; i < mark_origin_block_max; i++) + for (j = 0; j < mark_origin_block[i].mob_size; j++) + mark_object(mark_origin_block[i].mob_addr[j]); + + for (pp = pack_pointer; pp != NULL; pp = pp->p_link) + mark_object((object)pp); +#ifdef KCLOVM + if (ovm_process_created) + sgc_mark_all_stacks(); +#endif + +#ifdef DEBUG + if (debug) { + printf("symbol navigation\n"); + fflush(stdout); + } +#endif + + mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); + +} + +static void +sgc_sweep_phase(void) { + STATIC long j, k, l; + STATIC object x; + STATIC char *p; + STATIC struct typemanager *tm; + STATIC object f; + int size; + STATIC struct pageinfo *v; + + for (j= t_start; j < t_contiguous ; j++) { + tm_of(j)->tm_free=OBJNULL; + tm_of(j)->tm_nfree=0; + } + + for (v=cell_list_head;v;v=v->next) { + + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); + f = FREELIST_TAIL(tm); + l = k = 0; + size=tm->tm_size; + + if (v->sgc_flags&SGC_PAGE_FLAG) { + + for (j = tm->tm_nppage; --j >= 0; p += size) { + + x = (object)p; + + if (is_marked(x)) { + unmark(x); + l++; + continue; + } + +#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type) && x->d.s == SGC_NORMAL) + continue; +#endif + + k++; + make_free(x); + SET_LINK(f,x); + f = x; + +#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; +#endif + + } + + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; + v->in_use=l; + + } else if (WRITABLE_PAGE_P(page(v))) /*non sgc_page */ + for (j = tm->tm_nppage; --j >= 0; p += size) { + x = (object)p; + if (is_marked(x)) { + unmark(x); + } + } + + } +} + +#undef tm + +#ifdef SDEBUG +sgc_count(object yy) { + fixnum count=0; + object y=yy; + while(y) + {count++; + y=OBJ_LINK(y);} + printf("[length %x = %d]",yy,count); + fflush(stdout); +} + +#endif + +fixnum writable_pages=0; + +/* count read-only pages */ +static fixnum +sgc_count_read_only(void) { + + return sgc_enabled ? sSAwritableA->s.s_dbind->v.v_dim-writable_pages : 0; + +} + + +fixnum +sgc_count_type(int t) { + + if (t==t_relocatable) + return page(rb_limit)-page(rb_start); + else + return tm_of(t)->tm_npage-tm_of(t)->tm_alt_npage; + +} + +#ifdef SGC_CONT_DEBUG + +void +pcb(struct contblock *p) { + for (;p;p=p->cb_link) + printf("%p %d\n",p,p->cb_size); +} + +void +overlap_check(struct contblock *t1,struct contblock *t2) { + + struct contblock *p; + + for (;t1;t1=t1->cb_link) { + + if (!inheap(t1)) { + fprintf(stderr,"%p not in heap\n",t1); + do_gcl_abort(); + } + + for (p=t2;p;p=p->cb_link) { + + if (!inheap(p)) { + fprintf(stderr,"%p not in heap\n",t1); + do_gcl_abort(); + } + + if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) || + (t1<=p && (void *)t1+t1->cb_size>(void *)p)) { + fprintf(stderr,"Overlap %u %p %u %p\n",t1->cb_size,t1,p->cb_size,p); + do_gcl_abort(); + } + + if (p==p->cb_link) { + fprintf(stderr,"circle detected at %p\n",p); + do_gcl_abort(); + } + + } + + if (t1==t1->cb_link) { + fprintf(stderr,"circle detected at %p\n",t1); + do_gcl_abort(); + } + + } + +} + +void +tcc(struct contblock *t) { + + for (;t;t=t->cb_link) { + + if (!inheap(t)) { + fprintf(stderr,"%p not in heap\n",t); + break; + } + + fprintf(stderr,"%u at %p\n",t->cb_size,t); + + if (t==t->cb_link) { + fprintf(stderr,"circle detected at %p\n",t); + break; + } + + } + +} + +#endif + +typedef enum {memprotect_none,memprotect_cannot_protect,memprotect_sigaction, + memprotect_bad_return,memprotect_no_signal, + memprotect_multiple_invocations,memprotect_no_restart, + memprotect_bad_fault_address,memprotect_success} memprotect_enum; +static volatile memprotect_enum memprotect_result; +static int memprotect_handler_invocations,memprotect_print_enable; +static void *memprotect_test_address; + +#define MEM_ERR_CASE(a_) \ + case a_: \ + fprintf(stderr,"The SGC segfault recovery test failed with %s, SGC disabled\n",#a_); \ + break + +static void +memprotect_print(void) { + + if (!memprotect_print_enable) + return; + + switch(memprotect_result) { + case memprotect_none: case memprotect_success: + break; + + MEM_ERR_CASE(memprotect_cannot_protect); + MEM_ERR_CASE(memprotect_sigaction); + MEM_ERR_CASE(memprotect_bad_return); + MEM_ERR_CASE(memprotect_no_signal); + MEM_ERR_CASE(memprotect_no_restart); + MEM_ERR_CASE(memprotect_bad_fault_address); + MEM_ERR_CASE(memprotect_multiple_invocations); + + } + +} + + +static void +memprotect_handler_test(int sig, long code, void *scp, char *addr) { + + char *faddr; + faddr=GET_FAULT_ADDR(sig,code,scp,addr); + + if (memprotect_handler_invocations) { + memprotect_result=memprotect_multiple_invocations; + do_gcl_abort(); + } + memprotect_handler_invocations=1; + if (page(faddr)!=page(memprotect_test_address)) + memprotect_result=memprotect_bad_fault_address; + else + memprotect_result=memprotect_none; + gcl_mprotect(memprotect_test_address,PAGESIZE,PROT_READ_WRITE_EXEC); + +} + +static int +memprotect_test(void) { + + char *b1,*b2; + unsigned long p=PAGESIZE; + struct sigaction sa,sao,saob; + + if (memprotect_result!=memprotect_none) + return memprotect_result!=memprotect_success; + if (atexit(memprotect_print)) { + fprintf(stderr,"Cannot setup memprotect_print on exit\n"); + do_gcl_abort(); + } + + if (!(b1=alloca(2*p))) { + memprotect_result=memprotect_cannot_protect; + return -1; + } + + if (!(b2=alloca(p))) { + memprotect_result=memprotect_cannot_protect; + return -1; + } + + memset(b1,32,2*p); + memset(b2,0,p); + memprotect_test_address=(void *)(((unsigned long)b1+p-1) & ~(p-1)); + sa.sa_sigaction=(void *)memprotect_handler_test; + sa.sa_flags=MPROTECT_ACTION_FLAGS; + if (sigaction(SIGSEGV,&sa,&sao)) { + memprotect_result=memprotect_sigaction; + return -1; + } + if (sigaction(SIGBUS,&sa,&saob)) { + sigaction(SIGSEGV,&sao,NULL); + memprotect_result=memprotect_sigaction; + return -1; + } + { /* mips kernel bug test -- SIGBUS with no faddr when floating point is emulated. */ + float *f1=(void *)memprotect_test_address,*f2=(void *)b2,*f1e=f1+p/sizeof(*f1); + + if (gcl_mprotect(memprotect_test_address,p,PROT_READ_EXEC)) { + memprotect_result=memprotect_cannot_protect; + return -1; + } + memprotect_result=memprotect_bad_return; + for (;f1_b ? _a : _b;}) +/* If opt_maxpage is set, don't lose balancing information gained thus + far if we are triggered 'artificially' via a hole overrun. FIXME -- + try to allocate a small working set with the right proportions + later on. 20040804 CM*/ +#define WSGC(tm) ({struct typemanager *_tm=tm;long _t=MMAX(MMIN(_tm->tm_opt_maxpage,_tm->tm_npage),_tm->tm_sgc);_t*scale;}) +/* If opt_maxpage is set, add full pages to the sgc set if needed + too. 20040804 CM*/ +/* #define FSGC(tm) (tm->tm_type==t_cons ? tm->tm_nppage : (tm->tm_opt_maxpage ? 0 : tm->tm_sgc_minfree)) */ +#ifdef SGC_WHOLE_PAGE +#define FSGC(tm) tm->tm_nppage +#else +#define FSGC(tm) (!TYPEWORD_TYPE_P(tm->tm_type) ? tm->tm_nppage : tm->tm_sgc_minfree) +#endif + +DEFVAR("*WRITABLE*",sSAwritableA,SI,Cnil,""); + +unsigned char *wrimap=NULL; + +int +sgc_start(void) { + + long i,count,minfree,allocate_more_pages=!saving_system && 10*available_pages>2*(real_maxpage-first_data_page); + long np; + struct typemanager *tm; + struct pageinfo *v; + object omp=sSAoptimize_maximum_pagesA->s.s_dbind; + double tmp,scale; + + allocate_more_pages=0; + if (sgc_enabled) + return 1; + + sSAoptimize_maximum_pagesA->s.s_dbind=Cnil; + + if (memprotect_result!=memprotect_success && do_memprotect_test()) + return 0; + + empty_relblock(); + + /* Reset maxpage statistics if not invoked automatically on a hole + overrun. 20040804 CM*/ + /* if (!hole_overrun) { */ + /* vs_mark; */ + /* object *old_vs_base=vs_base; */ + /* vs_base=vs_top; */ + /* FFN(siLreset_gbc_count)(); */ + /* vs_base=old_vs_base; */ + /* vs_reset; */ + /* } */ + + for (i=t_start,scale=1.0,tmp=0.0;iavailable_pages/10 ? (float)available_pages/(10*tmp) : 1.0; + + for (i= t_start; i < t_contiguous ; i++) { + + if (!TM_BASE_TYPE_P(i) || !(np=(tm=tm_of(i))->tm_sgc)) continue; + + minfree = FSGC(tm) > 0 ? FSGC(tm) : 1; + count=0; + + FIND_FREE_PAGES: + + for (v=cell_list_head;v && (counttm_sgc_max,WSGC(tm)));v=v->next) { + + if (v->type!=i || tm->tm_nppage-v->in_usesgc_flags|=SGC_PAGE_FLAG; + count++; + + } + + if (counttm_sgc_max,WSGC(tm)));v=v->next) { + + if (v->type!=i || tm->tm_nppage!=v->in_use) continue; + + v->sgc_flags|=SGC_PAGE_FLAG; + count++; + if (count >= MMAX(tm->tm_sgc_max,WSGC(tm))) + break; + } + + /* don't do any more allocations for this type if saving system */ + if (!allocate_more_pages) + continue; + + if (count < WSGC(tm)) { + /* try to get some more free pages of type i */ + long n = WSGC(tm) - count; + long again=0,nfree = tm->tm_nfree; + char *p=alloc_page(n); + if (tm->tm_nfree > nfree) again=1; /* gc freed some objects */ + if (tm->tm_npage+n>tm->tm_maxpage) + if (!set_tm_maxpage(tm,tm->tm_npage+n)) + n=0; + while (n-- > 0) { + /* (sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0); */ + add_page_to_freelist(p,tm); + p += PAGESIZE; + } + if (again) + goto FIND_FREE_PAGES; + } + + } + + +/* SGC cont pages: Here we implement the contblock page division into + SGC and non-SGC types. Unlike the other types, we need *whole* + free pages for contblock SGC, as there is no persistent data + element (e.g. .m) on an allocated block itself which can indicate + its live status. If anything on a page which is to be marked + read-only points to a live object on an SGC cont page, it will + never be marked and will be erroneously swept. It is also possible + for dead objects to unnecessarily mark dead regions on SGC pages + and delay sweeping until the pointing type is GC'ed if SGC is + turned off for the pointing type, e.g. tm_sgc=0. (This was so by + default for a number of types, including bignums, and has now been + corrected in gcl_init_alloc in alloc.c.) We can't get around this + AFAICT, as old data on (writable) SGC pages must be marked lest it + is lost, and (old) data on now writable non-SGC pages might point + to live regions on SGC pages, yet might not themselves be reachable + from the mark origin through an unbroken chain of writable pages. + In any case, the possibility of a lot of garbage marks on contblock + pages, especially when the blocks are small as in bignums, makes + necessary the sweeping of minimal contblocks to prevent leaks. CM + 20030827 */ + + { + + void *p=NULL,*pe; + struct pageinfo *pi; + fixnum i,j,count=0; + struct contblock **cbpp; + + tm=tm_of(t_contiguous); + + for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]) && countcb_link) + if ((void*)*cbpp>=p && (void *)*cbppcb_size; + + if (j*tm->tm_nppagesgc_flags=SGC_PAGE_FLAG; + count+=pi->in_use; + + } + i=allocate_more_pages ? WSGC(tm) : (saving_system ? 1 : 0); + + if (i>count) { + /* SGC cont pages: allocate more if necessary, dumping possible + GBC freed pages onto the old contblock list. CM 20030827*/ + unsigned long z=(i-count)+1; + ufixnum fp=contblock_array->v.v_fillp; + + if (maxcbpagev.v_fillp); + + ((struct pageinfo *)contblock_array->v.v_self[fp])->sgc_flags=SGC_PAGE_FLAG; + + } + + } + + sSAwritableA->s.s_dbind=fSmake_vector1_1((page(heap_end)-first_data_page),aet_bit,Ct); + wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self; + + /* now move the sgc free lists into place. alt_free should + contain the others */ + for (i= t_start; i < t_contiguous ; i++) + if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { + object f=tm->tm_free,xf,yf; + struct freelist x,y;/*the f_link heads have to be separated on the stack*/ + fixnum count=0; + + xf=PHANTOM_FREELIST(x.f_link); + yf=PHANTOM_FREELIST(y.f_link); + while (f!=OBJNULL) { +#ifdef SDEBUG + if (!is_free(f)) + printf("Not FREE in freelist f=%d",f); +#endif + if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) { + SET_LINK(xf,f); +#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT; +#endif + xf=f; + count++; + } else { + SET_LINK(yf,f); +#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL; +#endif + yf=f; + } + f=OBJ_LINK(f); + } + SET_LINK(xf,OBJNULL); + tm->tm_free = OBJ_LINK(&x); + tm->tm_tail = xf; + SET_LINK(yf,OBJNULL); + tm->tm_alt_free = OBJ_LINK(&y); + tm->tm_alt_nfree = tm->tm_nfree - count; + tm->tm_nfree=count; + } + + { + + struct pageinfo *pi; + ufixnum j; + + { + + struct contblock **cbpp; + void *p=NULL,*pe; + struct pageinfo *pi; + ufixnum i; + + old_cb_pointer=cb_pointer; + reset_contblock_freelist(); + + for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]);i++) { + + if (pi->sgc_flags!=SGC_PAGE_FLAG) continue; + + p=CB_DATA_START(pi); + pe=p+CB_DATA_SIZE(pi->in_use); + + for (cbpp=&old_cb_pointer;*cbpp;) + if ((void *)*cbpp>=p && (void *)*cbppcb_size,*l=(*cbpp)->cb_link; + set_sgc_bits(pi,s,e); + insert_contblock(s,e-s); + *cbpp=l; + } else + cbpp=&(*cbpp)->cb_link; + + } + +#ifdef SGC_CONT_DEBUG + overlap_check(old_cb_pointer,cb_pointer); +#endif + } + + for (i=t_start;itm_alt_npage=0; + writable_pages=0; + + for (pi=cell_list_head;pi;pi=pi->next) { + if (pi->sgc_flags&SGC_WRITABLE) + SET_WRITABLE(page(pi)); + else + tm_of(pi->type)->tm_alt_npage++; + } + for (j=0;jv.v_fillp && (pi=(void *)contblock_array->v.v_self[j]);j++) + if (pi->sgc_flags&SGC_WRITABLE) + for (i=0;iin_use;i++) + SET_WRITABLE(page(pi)+i); + else + tm_of(t_contiguous)->tm_alt_npage+=pi->in_use; + { + extern object malloc_list; + object x; + + for (x=malloc_list;x!=Cnil;x=x->c.c_cdr) + if (x->c.c_car->st.st_adjustable) + for (i=page(x->c.c_car->st.st_self);i<=page(x->c.c_car->st.st_self+x->c.c_car->st.st_fillp-1);i++) + SET_WRITABLE(i); + } + + { + object v=sSAwritableA->s.s_dbind; + for (i=page(v->v.v_self);i<=page(v->v.v_self+CEI(v->bv.bv_offset+v->v.v_dim-1,8*sizeof(fixnum))/(8*sizeof(fixnum)));i++) + SET_WRITABLE(i); + SET_WRITABLE(page(v)); + SET_WRITABLE(page(sSAwritableA)); + } + + tm_of(t_relocatable)->tm_alt_npage=0; + + fault_pages=0; + + } + + /* Whew. We have now allocated the sgc space + and modified the tm_table; + Turn memory protection on for the pages which are writable. + */ + sgc_enabled=1; + if (memory_protect(1)) + sgc_quit(); + if (sSAnotify_gbcA->s.s_dbind != Cnil) + emsg("[SGC on]"); + + sSAoptimize_maximum_pagesA->s.s_dbind=omp; + + return 1; + +} + +/* int */ +/* pdebug(void) { */ + +/* extern object malloc_list; */ +/* object x=malloc_list; */ +/* struct pageinfo *v; */ +/* for (;x!=Cnil;x=x->c.c_cdr) */ +/* printf("%p %d\n",x->c.c_car->st.st_self,x->c.c_car->st.st_dim); */ + +/* for (v=contblock_list_head;v;v=v->next) */ +/* printf("%p %ld\n",v,v->in_use<<12); */ +/* return 0; */ +/* } */ + + +int +sgc_quit(void) { + + struct typemanager *tm; + struct contblock *tmp_cb_pointer,*next; + unsigned long i,np; + struct pageinfo *v; + + memory_protect(0); + + if(sSAnotify_gbcA->s.s_dbind != Cnil) + emsg("[SGC off]"); + + if (sgc_enabled==0) + return 0; + + sSAwritableA->s.s_dbind=Cnil; + wrimap=NULL; + + sgc_enabled=0; + + /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming + from the new list is guaranteed not to be on the old. Need to + grab 'next' before insert_contblock writes is. CM 20030827 */ + + if (old_cb_pointer) { +#ifdef SGC_CONT_DEBUG + overlap_check(old_cb_pointer,cb_pointer); +#endif + for (tmp_cb_pointer=old_cb_pointer;tmp_cb_pointer; tmp_cb_pointer=next) { + next=tmp_cb_pointer->cb_link; + insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size); + } + } + + for (i= t_start; i < t_contiguous ; i++) + + if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { + + object n=tm->tm_free,o=tm->tm_alt_free,f=PHANTOM_FREELIST(tm->tm_free); + + for (;n!=OBJNULL && o!=OBJNULL;) + if (o!=OBJNULL && (n==OBJNULL || otm_tail=f; + for (;OBJ_LINK(tm->tm_tail)!=OBJNULL;tm->tm_tail=OBJ_LINK(tm->tm_tail)); + tm->tm_nfree += tm->tm_alt_nfree; + tm->tm_alt_nfree = 0; + tm->tm_alt_free = OBJNULL; + + } + + /*FIXME*/ + /* remove the recent flag from any objects on sgc pages */ +#ifndef SGC_WHOLE_PAGE + for (v=cell_list_head;v;v=v->next) + if (v->type==(tm=tm_of(v->type))->tm_type && TYPEWORD_TYPE_P(v->type) && v->sgc_flags & SGC_PAGE_FLAG) + for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size) + ((object) p)->d.s=SGC_NORMAL; +#endif + + for (i=0;iv.v_fillp &&(v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) + bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); + + { + struct pageinfo *pi; + for (pi=cell_list_head;pi;pi=pi->next) + pi->sgc_flags&=SGC_PERM_WRITABLE; + for (i=0;iv.v_fillp &&(pi=(void *)contblock_array->v.v_self[i]);i++) + pi->sgc_flags&=SGC_PERM_WRITABLE; + } + + return 0; + +} + +fixnum debug_fault =0; +fixnum fault_count =0; +extern char etext; +static void +memprotect_handler(int sig, long code, void *scp, char *addr) { + + unsigned long p; + void *faddr; /* Needed because we must not modify signal handler + arguments on the stack! */ +#ifdef GET_FAULT_ADDR + faddr=GET_FAULT_ADDR(sig,code,scp,addr); + debug_fault = (long) faddr; +#ifdef DEBUG_MPROTECT + printf("fault:0x%x [%d] (%d) ",faddr,page(faddr),faddr >= core_end); +#endif + if (faddr >= (void *)core_end || faddr < data_start) { + static void *old_faddr; + if (old_faddr==faddr) + if (fault_count++ > 300) error("fault count too high"); + old_faddr=faddr; + INSTALL_MPROTECT_HANDLER; + return; + } +#else + faddr = addr; +#endif + p = page(faddr); + if (p >= first_protectable_page + && faddr < (void *)core_end + && !(WRITABLE_PAGE_P(p))) { + /* CHECK_RANGE(p,1); */ +#ifdef DEBUG_MPROTECT + printf("mprotect(0x%x,0x%x,0x%x)\n", + pagetoinfo(p),PAGESIZE, sbrk(0)); + fflush(stdout); +#endif + +#ifndef BSD + INSTALL_MPROTECT_HANDLER; +#endif + + massert(!gcl_mprotect(pagetoinfo(p),PAGESIZE,PROT_READ_WRITE_EXEC)); + SET_WRITABLE(p); + fault_pages++; + + return; + + } + +#ifndef BSD + INSTALL_MPROTECT_HANDLER; +#endif + + segmentation_catcher(0); + +} + +static int +sgc_mprotect(long pbeg, long n, int writable) { + /* CHECK_RANGE(pbeg,n); */ +#ifdef DEBUG_MPROTECT + printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE, + (writable & SGC_WRITABLE ? "writable" : "not writable")); + printf("mprotect(0x%x,0x%x), sbrk(0)=0x%x\n", + pagetoinfo(pbeg), n * PAGESIZE, sbrk(0)); + fflush(stdout); +#endif + if(gcl_mprotect(pagetoinfo(pbeg),n*PAGESIZE,(writable & SGC_WRITABLE ? PROT_READ_WRITE_EXEC : PROT_READ_EXEC))) { + perror("sgc disabled"); + return -1; + } + + return 0; + +} + + + +int +memory_protect(int on) { + + unsigned long i,beg,end= page(core_end); + int writable=1; + extern void install_segmentation_catcher(void); + + + first_protectable_page=first_data_page; + + /* turning it off */ + if (on==0) { + sgc_mprotect(first_protectable_page,end-first_protectable_page,SGC_WRITABLE); + install_segmentation_catcher(); + return 0; + } + + INSTALL_MPROTECT_HANDLER; + + beg=first_protectable_page; + writable = WRITABLE_PAGE_P(beg); + for (i=beg ; ++i<= end; ) { + + if (writable==WRITABLE_PAGE_P(i) && i + + /* earith.s for MIPS R2000 processor + by Doug Katzman + version 2.1.d dated 7/13/89 15:31 EDT */ + + # mods 7/13/89: + # emul: never conditionally branch + # ediv: improved code ordering allows jmp delay slot optimization by 'as' + # + .text + .align 2 + + .globl extended_mul + # extended_mul(d, q, r, hp, lp) + # unsigned int d, q, r, *hp, *lp; + # { + .ent extended_mul +extended_mul: + .frame sp, 0, ra + + mult a0, a1 # [hi:lo] = d * q + mfhi a1 + sll a1, 1 + mflo a0 + srl t7, a0, 31 + and a0, 0x7fffffff + or a1, t7 + addu a0, a2 # [a1:a0] += r + srl t7, a0, 31 + and a0, 0x7fffffff + addu a1, t7 + sw a1, 0(a3) # *hp = a1 + lw a3, 16(sp) # fetch fifth actual argument from stack + sw a0, 0(a3) # *lp = a0 + # } + j ra + .end extended_mul + + .globl extended_div + # extended_div(d, h, l, qp, rp) + # unsigned int d, h, l, *qp, *rp; + # { + .ent extended_div +extended_div: + .frame sp, 0, ra + + sll a2, 1 + li v0, 31 # v0 holds number of shifts +loop: + srl t7, a2, 31 + sll a1, 1 + or a1, t7 + sll a2, 1 + subu t7, a1, a0 # t = h - d + bltz t7, underflow + move a1, t7 + or a2, 1 +underflow: + subu v0, 1 + bnez v0, loop + sw a2, 0(a3) # *qp = l + lw a3, 16(sp) # fetch fifth actual argument from stack + sw a1, 0(a3) # *rp = h + # } + j ra + .end extended_div + diff --git a/o/sockets.c b/o/sockets.c new file mode 100755 index 0000000..a388857 --- /dev/null +++ b/o/sockets.c @@ -0,0 +1,556 @@ +/* + Copyright (C) 1994 Rami el Charif, W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#define IN_SOCKETS +#include +#include "include.h" + +#ifdef HAVE_NSOCKET + +#include "sheader.h" + +#include +#ifndef __MINGW32__ +# include +# include +# include +#else +# include +# include +#endif + +#ifdef __STDC__ +#include +#endif + +#ifndef __MINGW32__ +# include +#endif + +#include +#ifndef NO_UNISTD_H +#include +#endif +#include +/*#include */ + +#include + +static void write_timeout_error(); +static void connection_failure(); + +#ifdef __MINGW32__ +/* Keep track of socket initialisations */ +int w32_socket_initialisations = 0; +WSADATA WSAData; + +int w32_socket_init(void) +{ + int rv = 0; + if (w32_socket_initialisations++) { + rv = 0; + } else { + if (WSAStartup(0x0101, &WSAData)) { + w32_socket_initialisations = 0; + emsg("WSAStartup failed\n" ); + WSACleanup(); + rv = -1; + } + } + + return rv; +} + +int w32_socket_exit(void) +{ + int rv = 0; + + if ( w32_socket_initialisations == 0 || + --w32_socket_initialisations > 0 ) { + rv = 0; + } else { + rv = WSACleanup(); + } + + return rv; +} + +#endif + +#define BIND_MAX_RETRY 128 +#define BIND_ADDRESS_INCREMENT 16 +#define BIND_INITIAL_ADDRESS 5000 +#define BIND_LAST_ADDRESS 65534 +static unsigned int iLastAddressUsed = BIND_INITIAL_ADDRESS; + +DEFUN_NEW("OPEN-NAMED-SOCKET",object,fSopen_named_socket,SI,1,1,NONE,OI,OO,OO,OO,(fixnum port), +"Open a socket on PORT and return (cons fd portname) where file \ +descriptor is a small fixnum which is the write file descriptor for \ +the socket. If PORT is zero do automatic allocation of port") +{ +#ifdef __MINGW32__ + SOCKET s; +#else + int s; +#endif + int n, rc; + struct sockaddr_in addr; + +#ifdef __MINGW32__ + if ( w32_socket_init() < 0 ) { + perror("ERROR !!! Windows socket DLL initialisation failed in sock_connect_to_name\n"); + return Cnil; + } +#endif + + /* Using TCP layer */ + s = socket(PF_INET, SOCK_STREAM, 0); +#ifdef __MINGW32__ + if ( s == INVALID_SOCKET ) +#else + if (s < 0) +#endif + { + perror("ERROR !!! socket creation failed in sock_connect_to_name\n"); + return Cnil; + } + + addr.sin_family = PF_INET; + addr.sin_addr.s_addr = INADDR_ANY; + memset(addr.sin_zero, 0, 8); + n = sizeof addr; + + if (port == 0) + { +#define MY_HTONS(x) htons((unsigned short)((x) & 0xffff)) + int cRetry = 0; + do { + addr.sin_port = MY_HTONS(iLastAddressUsed); + rc = bind(s, (struct sockaddr *)&addr, n); + + cRetry++; + iLastAddressUsed += BIND_ADDRESS_INCREMENT; + if (iLastAddressUsed > BIND_LAST_ADDRESS) + iLastAddressUsed = BIND_INITIAL_ADDRESS; + } while ((rc < 0) && +#ifdef __MINGW32__ + (errno == WSAEADDRINUSE) && +#else + (errno == EADDRINUSE) && +#endif + (cRetry < BIND_MAX_RETRY)); + if (0) + emsg("\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" + , addr.sin_port, errno, rc, iLastAddressUsed, cRetry + ); + } + else + { + addr.sin_port = MY_HTONS(port); + rc = bind(s, (struct sockaddr *)&addr, n); + } + if (rc < 0) + { + perror("ERROR !!! Failed to bind socket in sock_open_named_socket\n"); + close(s); + return Cnil; + } + rc = listen(s, 3); + if (rc < 0) + { + perror("ERROR ! listen failed on socket in sock_open_named_socket"); + close(s); + return Cnil; + } + + return make_cons(make_fixnum(s), make_fixnum(ntohs(addr.sin_port))); +} + +DEFUN_NEW("CLOSE-FD",object,fSclose_fd,SI,1,1,NONE,OI,OO,OO,OO,(fixnum fd), + "Close the file descriptor FD") + +{RETURN1(0==close(fd) ? Ct : Cnil);} + +DEFUN_NEW("CLOSE-SD",object,fSclose_sfd,SI,1,1,NONE,OO,OO,OO,OO,(object sfd), + "Close the socket connection sfd") + +{ int res; + free(OBJ_TO_CONNECTION_STATE(sfd)->read_buffer); + res = close(OBJ_TO_CONNECTION_STATE(sfd)->fd); + free (OBJ_TO_CONNECTION_STATE(sfd)); +#ifdef __MINGW32__ + w32_socket_exit(); +#endif + RETURN1(res ? Ct : Cnil); +} + + +DEFUN_NEW("ACCEPT-SOCKET-CONNECTION",object,fSaccept_socket_connection, + SI,1,1,NONE,OO,OO,OO,OO,(object named_socket), + "Given a NAMED_SOCKET it waits for a connection on this \ +and returns (list* named_socket fd name1) when one is established") + +{ + socklen_t n; + int fd; + struct sockaddr_in addr; + object x; + n = sizeof addr; + fd = accept(fix(car(named_socket)) , (struct sockaddr *)&addr, &n); + if (fd < 0) + { + emsg("ERROR ! accept on socket failed in sock_accept_connection"); + return Cnil; + } + x = alloc_simple_string(sizeof(struct connection_state)); + x->ust.ust_self = (void *)setup_connection_state(fd); + return make_cons( + make_cons(x + , make_simple_string( + inet_ntoa(addr.sin_addr))), + named_socket + ); +} + +/* static object */ +/* sock_hostname_to_hostid_list(host_name) */ +/* char *host_name; */ +/* { */ +/* struct hostent *h; */ +/* object addr_list = Cnil; */ +/* int i; */ + +/* h = gethostbyname(host_name); */ + +/* for (i = 0; h->h_addr_list[i] != 0; i++) */ +/* { */ +/* addr_list = make_cons(make_simple_string(inet_ntoa(*(struct in_addr *)h->h_addr_list[i])), addr_list); */ +/* } */ +/* return addr_list; */ +/* } */ + + + + +DEFUN_NEW("HOSTNAME-TO-HOSTID",object,fShostname_to_hostid,SI,1,1, + NONE,OO,OO,OO,OO,(object host),"") +{ + struct hostent *h; + char buf[300]; + char *p; + p = lisp_copy_to_null_terminated(host,buf,sizeof(buf)); + h = /* gethostbyname(p); */ +#ifdef STATIC_LINKING + NULL; +#else + gethostbyname(p); +#endif + if (p != buf) free (p); + if (h && h->h_addr_list[0]) + return + make_simple_string(inet_ntoa(*(struct in_addr *)h->h_addr_list[0])); + else return Cnil; +} + +DEFUN_NEW("GETHOSTNAME",object,fSgethostname,SI,0,0,NONE,OO,OO,OO,OO,(void), + "Returns HOSTNAME of the local host") + +{char buf[300]; + if (0 == gethostname(buf,sizeof(buf))) + return make_simple_string(buf); + else return Cnil; +} + +DEFUN_NEW("HOSTID-TO-HOSTNAME",object,fShostid_to_hostname,SI, + 1,10,NONE,OO,OO,OO,OO,(object host_id),"") + +{char *hostid; + struct in_addr addr; + struct hostent *h; + char buf[300]; + hostid = lisp_copy_to_null_terminated(host_id,buf,sizeof(buf)); + addr.s_addr = inet_addr(hostid); + h = /* gethostbyaddr((char *)&addr, 4, AF_INET); */ +#ifdef STATIC_LINKING + NULL; +#else + gethostbyaddr((char *)&addr, 4, AF_INET); +#endif + if (h && h->h_name && *h->h_name) + return make_simple_string(h->h_name); + else + return Cnil; +} + +/* static object */ +/* sock_get_name(s) */ +/* int s; */ +/* { */ +/* struct sockaddr_in addr; */ +/* int m = sizeof(addr); */ +/* getsockname(s, (struct sockaddr *)&addr, &m); */ +/* return make_cons( */ +/* make_cons( */ +/* make_fixnum(addr.sin_port) */ +/* , make_simple_string(inet_ntoa(addr.sin_addr)) */ +/* ) */ +/* ,make_cons(make_fixnum(addr.sin_family) */ +/* , make_fixnum(s)) */ +/* ); */ +/* } */ + +#include "comm.c" + + +DEFUN_NEW("CONNECTION-STATE-FD",object,fSconnection_state_fd,SI,1,1,NONE,OO,OO,OO,OO,(object sfd),"") +{ return make_fixnum(OBJ_TO_CONNECTION_STATE(sfd)->fd); +} + +DEFUN_NEW("OUR-WRITE",object,fSour_write,SI,3,3,NONE,OO,OI,OO,OO,(object sfd,object buffer,fixnum nbytes),"") + +{ return make_fixnum(write1(OBJ_TO_CONNECTION_STATE(sfd),buffer->st.st_self,nbytes)); +} + +DEFUN_NEW("OUR-READ-WITH-OFFSET",object,fSour_read_with_offset,SI,5,5,NONE, + OO,OI,II,OO,(object fd,object buffer,fixnum offset,fixnum nbytes,fixnum timeout), + "Read from STATE-FD into string BUFFER putting data at OFFSET and reading NBYTES, waiting for TIMEOUT before failing") + +{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->st.st_self[offset]),nbytes,timeout)); +} + + +enum print_arglist_codes { + normal, + no_leading_space, + join_follows, + end_join, + begin_join, + begin_join_no_leading_space, + no_quote, + no_quote_no_leading_space, + no_quote_downcase, + no_quotes_and_no_leading_space + }; + + /* push object X into the string with fill pointer STR, according to CODE + */ + + +#define PUSH(_c) do{if (--left < 0) goto FAIL; \ + *xx++ = _c;}while(0) + + +#define BEGIN_QUOTE '"' +#define END_QUOTE '"' + +static int needs_quoting[256]; + +DEFUN_NEW("PRINT-TO-STRING1",object,fSprint_to_string1,SI,3,3,NONE,OO,OO,OO,OO,(object str,object x,object the_code), + "Print to STRING the object X according to CODE. The string must have \ +fill pointer, and this will be advanced.") + +{ enum type t = type_of(x); + int fp = str->st.st_fillp; + char *xx = &(str->st.st_self[fp]); + int left = str->st.st_dim - fp; + char buf[30]; + char *p; + enum print_arglist_codes code = fix(the_code); + + if (code==no_quote || code == no_quotes_and_no_leading_space) + { needs_quoting['"']=0; + needs_quoting['$']=0; + needs_quoting['\\']=0; + needs_quoting['[']=0; +/* needs_quoting[']']=0; */ + } + else { needs_quoting['"']=1; + needs_quoting['$']=1; + needs_quoting['\\']=1; + needs_quoting['[']=1; +/* needs_quoting[']']=1; */ + } + { + int downcase ; + int do_end_quote = 0; + if(type_of(str)!=t_string) + FEerror("Must be given string with fill pointer",0); + if (t==t_symbol) downcase=1; + else downcase=0; + + switch (code){ + + case no_quote_downcase: + downcase = 1; + case no_quote: + PUSH(' '); + case no_quotes_and_no_leading_space: + case no_quote_no_leading_space: + break; + + case normal: + PUSH(' '); + case no_leading_space: + if (t==t_string) + { do_end_quote = 1; + PUSH(BEGIN_QUOTE); + } + break; + + case begin_join: + PUSH(' '); + case begin_join_no_leading_space: + PUSH(BEGIN_QUOTE); + break; + case end_join: + do_end_quote=1; + break; + case join_follows: + + + break; + default: do_gcl_abort(); + } + + switch (t) { + case t_symbol: + if (x->s.s_hpack == keyword_package) + {if (code == normal) + PUSH('-');} + case t_string: + {int len = x->st.st_fillp; + p = &x->st.st_self[0]; + if (downcase) + while (--len>=0) + { char c = *p++; + c=tolower((int)c); + if(needs_quoting[(unsigned char)c]) + PUSH('\\'); + PUSH(c);} + else + while (--len>=0) + { char c = *p++; + if(needs_quoting[(unsigned char)c]) + PUSH('\\'); + PUSH(c);}} + break; + case t_fixnum: + sprintf(buf,"%ld",fix(x)); + p = buf; + while(*p) {PUSH(*p);p++;} + break; + case t_longfloat: + sprintf(buf,"%.2f",lf(x)); + p = buf; + while(*p) {PUSH(*p);p++;} + break; + case t_shortfloat: + sprintf(buf,"%.2f",sf(x)); + p = buf; + while(*p) {PUSH(*p);p++;} + break; + case t_bignum: + goto FAIL; + default: + FEerror("Bad type for print_string ~s",1,x); + } + if(do_end_quote) PUSH('"'); + str->st.st_fillp += (xx - &(str->st.st_self[fp])); + return Ct; + FAIL: + + /* either ran out of storage or tried to print a bignum. + The caller will handle these two cases + */ + return Cnil; + } +} + +static void +not_defined_for_os() +{ FEerror("Function not defined for this operating system",0);} + + +DEFUN_NEW("SET-SIGIO-FOR-FD",object,fSset_sigio_for_fd,SI,1,1,NONE,OI,OO,OO,OO,(fixnum fd),"") + +{ + /* for the moment we will use SIGUSR1 to notify, instead of depending on SIGIO, + since LINUX does not support the latter yet... + So right now this does nothing... + */ +#if !defined(FASYNC) || !defined(SET_FD_TO_GIVE_SIGIO) + not_defined_for_os(); + +#else +#ifdef SET_FD_TO_GIVE_SIGIO + SET_FD_TO_GIVE_SIGIO(fd); +#else + /* want something like this... but wont work on all machines. */ + flags = fcntl(fd,F_GETFL,0); + if (flags == -1 + || ( flags |= FASYNC , 0) + || -1 == fcntl(fd,F_SETFL,flags) + || -1 == fcntl(fd,F_SETOWN,getpid())) + {perror("Could not set ASYNC IO for SIGIO:"); + return Cnil;} +#endif +#endif + + return (Ct); + +} + +DEFUN_NEW("CHECK-STATE-INPUT",object,fScheck_state_input,SI,2,2,NONE,OO,IO,OO,OO,(object osfd,fixnum timeout), + "") +{ + return fScheck_dsfd_for_input(OBJ_TO_CONNECTION_STATE(osfd),timeout); + +} + +DEFUN_NEW("CLEAR-CONNECTION-STATE",object,fSclear_connection_state, + SI,1,1,NONE,OO,OO,OO,OO,(object osfd), + "Read on FD until nothing left to read. Return number of bytes read") + +{ + struct connection_state *sfd = OBJ_TO_CONNECTION_STATE(osfd); + int n=fix(FFN(fSclear_connection)(sfd->fd)); + + sfd->valid_data = sfd->read_buffer; + sfd->valid_data_size = 0; + sfd->bytes_received_not_confirmed += n; + return make_fixnum(n); +} + +#endif + +static void +write_timeout_error(s) + char *s; +{FEerror("Write timeout: ~s",1,make_simple_string(s)); +} + +static void +connection_failure(s) + char *s; +{FEerror("Connect failure: ~s",1,make_simple_string(s)); +} + + diff --git a/o/strcspn.c b/o/strcspn.c new file mode 100755 index 0000000..2448454 --- /dev/null +++ b/o/strcspn.c @@ -0,0 +1,16 @@ +size_t +strcspn(const char *s1, const char *s2) +{ + register char *scan1; + register char *scan2; + register int count; + + count = 0; + for (scan1 = s1; *scan1 != '\0'; scan1++) { + for (scan2 = s2; *scan2 != '\0';) /* ++ moved down. */ + if (*scan1 == *scan2++) + return(count); + count++; + } + return(count); +} diff --git a/o/string.d b/o/string.d new file mode 100755 index 0000000..d025fe3 --- /dev/null +++ b/o/string.d @@ -0,0 +1,637 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + string.d + + string routines +*/ + +#include +#include "include.h" + +object sKstart1; +object sKend1; +object sKstart2; +object sKend2; +object sKinitial_element; +object sKelement_type; + +object +alloc_simple_string(l) +int l; +{ + object x; + + x = alloc_object(t_string); + x->st.st_hasfillp = FALSE; + x->st.st_adjustable = FALSE; + x->st.st_displaced = Cnil; + x->st.st_dim = x->st.st_fillp = l; + x->st.st_self = NULL; + return(x); +} + +/* + Make_simple_string(s) makes a simple string from C string s. +*/ +object +make_simple_string(s) +const char *s; +{ + int l, i; + char *p; + object x; + vs_mark; + {BEGIN_NO_INTERRUPT; + for (l = 0; s[l] != '\0'; l++) + ; + x = alloc_simple_string(l); + vs_push(x); + p = alloc_relblock(l); + for (i = 0; i < l; i++) + p[i] = s[i]; + x->st.st_self = p; + vs_reset; + END_NO_INTERRUPT;} + return(x); +} + +/* + This correponds to string= (just the string equality). +*/ +bool +string_eq(x, y) +object x, y; +{ + int i, j; + +/* + if (type_of(x) != t_string || type_of(y) != t_string) + error("string expected"); +*/ + i = x->st.st_fillp; + j = y->st.st_fillp; + if (i != j) + return(FALSE); + for (i = 0; i < j; i++) + if (x->st.st_self[i] != y->st.st_self[i]) + return(FALSE); + return(TRUE); +} + +/* + This corresponds to string-equal + (string equality ignoring the case). +*/ +bool +string_equal(x, y) +object x, y; +{ + int i, j; + char *p, *q; + +/* + if (type_of(x) != t_string || type_of(y) != t_string) + error("string expected"); +*/ + i = x->st.st_fillp; + j = y->st.st_fillp; + if (i != j) + return(FALSE); + p = x->st.st_self; + q = y->st.st_self; + for (i = 0; i < j; i++) + if ((isLower(p[i]) ? p[i] - ('a' - 'A') : p[i]) + != (isLower(q[i]) ? q[i] - ('a' - 'A') : q[i])) + return(FALSE); + return(TRUE); +} + +/* + Copy_simple_string(x) copies string x to a simple string. +*/ +object +copy_simple_string(x) +object x; +{ + object y; + int i; + vs_mark; + + vs_push(x); +/* + if (type_of(x) != t_string) + error("string expected"); +*/ + {BEGIN_NO_INTERRUPT; + y = alloc_object(t_string); + y->st.st_dim = y->st.st_fillp = x->st.st_fillp; + y->st.st_hasfillp = FALSE; + y->st.st_adjustable = FALSE; + y->st.st_displaced = Cnil; + y->st.st_self = NULL; + vs_push(y); + y->st.st_self = alloc_relblock(x->st.st_fillp); + for (i = 0; i < x->st.st_fillp; i++) + y->st.st_self[i] = x->st.st_self[i]; + vs_reset; + END_NO_INTERRUPT; } + return(y); +} + +object +coerce_to_string(x) +object x; +{ + object y; + int i; + vs_mark; + + switch (type_of(x)) { + case t_symbol: + {BEGIN_NO_INTERRUPT; + y = alloc_simple_string(x->s.s_fillp); + vs_push(y); + if (x->s.s_self < heap_end) + y->st.st_self = x->s.s_self; + else { + y->st.st_self = alloc_relblock(x->s.s_fillp); + for (i = 0; i < x->s.s_fillp; i++) + y->st.st_self[i] = x->s.s_self[i]; + } + vs_reset; + END_NO_INTERRUPT;} + return(y); + + case t_fixnum: + x = coerce_to_character(x); + vs_push(x); + + case t_character: + {BEGIN_NO_INTERRUPT; + y = alloc_simple_string(1); + vs_push(y); + y->st.st_self = alloc_relblock(1); + y->st.st_self[0] = char_code(x); + vs_reset; + END_NO_INTERRUPT;} + return(y); + + case t_string: + return(x); + default: + break; + } + vs_push(x); + x=wrong_type_argument(sLstring,x); + vs_popp; + return(Cnil); +} + +@(defun char (s i) + int j; +@ + check_type_string(&s); + if (type_of(i) != t_fixnum) + illegal_index(s, i); + if ((j = fix(i)) < 0 || j >= s->st.st_dim) + illegal_index(s, i); + @(return `code_char(s->ust.ust_self[j])`) +@) + +LFD(siLchar_set)() +{ + int j; + + check_arg(3); + check_type_string(&vs_base[0]); + if (type_of(vs_base[1]) != t_fixnum) + illegal_index(vs_base[0], vs_base[1]); + if ((j = fix(vs_base[1])) < 0 || j >= vs_base[0]->st.st_dim) + illegal_index(vs_base[0], vs_base[1]); + check_type_character(&vs_base[2]); + vs_base[0]->st.st_self[j] = char_code(vs_base[2]); + vs_base += 2; +} + +void +get_string_start_end(string, start, end, ps, pe) +object string, start, end; +int *ps, *pe; +{ + if (start == Cnil) + *ps = 0; + else if (type_of(start) != t_fixnum) + goto E; + else { + *ps = fix(start); + if (*ps < 0) + goto E; + } + if (end == Cnil) { + *pe = string->st.st_fillp; + if (*pe < *ps) + goto E; + } else if (type_of(end) != t_fixnum) + goto E; + else { + *pe = fix(end); + if (*pe < *ps || *pe > string->st.st_fillp) + goto E; + } + return; + +E: + FEerror("~S and ~S are illegal as :START and :END~%\ +for the string ~S.", 3, start, end, string); +} + +@(defun string_eq (string1 string2 + &key start1 end1 start2 end2) + int s1=0, e1=0, s2=0, e2=0; +@ + string1 = coerce_to_string(string1); + string2 = coerce_to_string(string2); + get_string_start_end(string1, start1, end1, &s1, &e1); + get_string_start_end(string2, start2, end2, &s2, &e2); + if (e1 - s1 != e2 - s2) + @(return Cnil) + while (s1 < e1) + if (string1->st.st_self[s1++] != + string2->st.st_self[s2++]) + @(return Cnil) + @(return Ct) +@) + +@(defun string_equal (string1 string2 + &key start1 end1 start2 end2) + int s1=0, e1=0, s2=0, e2=0; + int i1, i2; +@ + string1 = coerce_to_string(string1); + string2 = coerce_to_string(string2); + get_string_start_end(string1, start1, end1, &s1, &e1); + get_string_start_end(string2, start2, end2, &s2, &e2); + if (e1 - s1 != e2 - s2) + @(return Cnil) + while (s1 < e1) { + i1 = string1->st.st_self[s1++]; + i2 = string2->st.st_self[s2++]; + if (isLower(i1)) + i1 -= 'a' - 'A'; + if (isLower(i2)) + i2 -= 'a' - 'A'; + if (i1 != i2) + @(return Cnil) + } + @(return Ct) +@) + + +int string_sign, string_boundary; + +@(static defun string_cmp (string1 string2 + &key start1 end1 start2 end2) + int s1=0, e1=0, s2=0, e2=0; + int i1, i2; + int s; +@ + string1 = coerce_to_string(string1); + string2 = coerce_to_string(string2); + get_string_start_end(string1, start1, end1, &s1, &e1); + get_string_start_end(string2, start2, end2, &s2, &e2); + while (s1 < e1) { + if (s2 == e2) + @(return `string_sign>0 ? Cnil : make_fixnum(s1)`) + i1 = string1->ust.ust_self[s1]; + i2 = string2->ust.ust_self[s2]; + if (string_sign == 0) { + if (i1 != i2) + @(return `make_fixnum(s1)`) + } else { + s = string_sign*(i2-i1); + if (s > 0) + @(return `make_fixnum(s1)`) + if (s < 0) + @(return Cnil) + } + s1++; + s2++; + } + if (s2 == e2) + @(return `string_boundary==0 ? make_fixnum(s1) : Cnil`) + @(return `string_sign>=0 ? make_fixnum(s1) : Cnil`) +@) + +LFD(Lstring_l)() { string_sign = 1; string_boundary = 1; FFN(Lstring_cmp)(); } +LFD(Lstring_g)() { string_sign = -1; string_boundary = 1; FFN(Lstring_cmp)(); } +LFD(Lstring_le)() { string_sign = 1; string_boundary = 0; FFN(Lstring_cmp)(); } +LFD(Lstring_ge)() { string_sign = -1; string_boundary = 0; FFN(Lstring_cmp)(); } +LFD(Lstring_neq)() { string_sign = 0; string_boundary = 1; FFN(Lstring_cmp)(); } + +@(static defun string_compare (string1 string2 + &key start1 end1 start2 end2) + int s1=0, e1=0, s2=0, e2=0; + int i1, i2; + int s; +@ + string1 = coerce_to_string(string1); + string2 = coerce_to_string(string2); + get_string_start_end(string1, start1, end1, &s1, &e1); + get_string_start_end(string2, start2, end2, &s2, &e2); + while (s1 < e1) { + if (s2 == e2) + @(return `string_sign>0 ? Cnil : make_fixnum(s1)`) + i1 = string1->ust.ust_self[s1]; + if (isLower(i1)) + i1 -= 'a' - 'A'; + i2 = string2->ust.ust_self[s2]; + if (isLower(i2)) + i2 -= 'a' - 'A'; + if (string_sign == 0) { + if (i1 != i2) + @(return `make_fixnum(s1)`) + } else { + s = string_sign*(i2-i1); + if (s > 0) + @(return `make_fixnum(s1)`) + if (s < 0) + @(return Cnil) + } + s1++; + s2++; + } + if (s2 == e2) + @(return `string_boundary==0 ? make_fixnum(s1) : Cnil`) + @(return `string_sign>=0 ? make_fixnum(s1) : Cnil`) +@) + +LFD(Lstring_lessp)() { string_sign = 1; string_boundary = 1; FFN(Lstring_compare)(); } +LFD(Lstring_greaterp)() { string_sign = -1; string_boundary = 1; FFN(Lstring_compare)(); } +LFD(Lstring_not_greaterp)(){ string_sign = 1; string_boundary = 0; FFN(Lstring_compare)(); } +LFD(Lstring_not_lessp)() { string_sign = -1; string_boundary = 0; FFN(Lstring_compare)(); } +LFD(Lstring_not_equal)() { string_sign = 0; string_boundary = 1; FFN(Lstring_compare)(); } + +/* element_type is currently ignored -- character == base-char == standard-char */ +@(defun make_string (size + &key (initial_element `code_char(' ')` ) element_type + &aux x) + int i; +@ + while (type_of(size) != t_fixnum || fix(size) < 0) + size + = wrong_type_argument(TSnon_negative_integer, size); + /* bignum not allowed, this is PRACTICAL!! */ + while (type_of(initial_element) != t_character || + char_bits(initial_element) != 0 || + char_font(initial_element) != 0) + initial_element + = wrong_type_argument(sLcharacter, initial_element); + {BEGIN_NO_INTERRUPT; + x = alloc_simple_string(fix(size)); + x->st.st_self = alloc_relblock(fix(size)); + for (i = 0; i < fix(size); i++) + x->st.st_self[i] = char_code(initial_element); + END_NO_INTERRUPT; } + @(return x) +@) + +static bool +member_char(c, char_bag) +int c; +object char_bag; +{ + + int i, f; + + switch (type_of(char_bag)) { + case t_symbol: + case t_cons: + while (!endp(char_bag)) { + if (type_of(char_bag->c.c_car) == t_character + && c == char_code(char_bag->c.c_car)) + return(TRUE); + char_bag = char_bag->c.c_cdr; + } + return(FALSE); + + case t_vector: + for (i = 0, f = char_bag->v.v_fillp; i < f; i++) { + if (type_of(char_bag->v.v_self[i]) == t_character + && c == char_code(char_bag->v.v_self[i])) + return(TRUE); + } + return(FALSE); + + case t_string: + for (i = 0, f = char_bag->st.st_fillp; i < f; i++) { + if (c == char_bag->st.st_self[i]) + return(TRUE); + } + return(FALSE); + + case t_bitvector: + return(FALSE); + + default: + FEerror("~S is not a sequence.", 1, char_bag); + return(FALSE); + } +} + +/*static void Lstring_trim0();*/ + +@(static defun string_trim0 (char_bag strng &aux res) + int i, j, k; +@ + strng = coerce_to_string(strng); + i = 0; + j = strng->st.st_fillp - 1; + if (left_trim) + for (; i <= j; i++) + if (!member_char(strng->st.st_self[i], char_bag)) + break; + if (right_trim) + for (; j >= i; --j) + if (!member_char(strng->st.st_self[j], char_bag)) + break; + k = j - i + 1; + {BEGIN_NO_INTERRUPT; + res = alloc_simple_string(k); + res->st.st_self = alloc_relblock(k); + for (j = 0; j < k; j++) + res->st.st_self[j] = strng->st.st_self[i + j]; + END_NO_INTERRUPT; } + @(return res) +@) + +LFD(Lstring_trim)() { left_trim = right_trim = TRUE; FFN(Lstring_trim0)(); } +LFD(Lstring_left_trim)() { left_trim = TRUE; right_trim = FALSE; FFN(Lstring_trim0)(); } +LFD(Lstring_right_trim)() { left_trim = FALSE; right_trim = TRUE; FFN(Lstring_trim0)();} + +static int char_upcase(c, bp) +int c, *bp; +{ + if (isLower(c)) + return(c - ('a' - 'A')); + else + return(c); +} + +static int char_downcase(c, bp) +int c, *bp; +{ + if (isUpper(c)) + return(c + ('a' - 'A')); + else + return(c); +} + +static int char_capitalize(c, bp) +int c, *bp; +{ + if (isLower(c)) { + if (*bp) + c -= 'a' - 'A'; + *bp = FALSE; + } else if (isUpper(c)) { + if (!*bp) + c += 'a' - 'A'; + *bp = FALSE; + } else if (!isDigit(c)) + *bp = TRUE; + else + *bp = FALSE; + return(c); +} + +@(static defun string_case (strng &key start end &aux conv) + int s=0, e=0, i; + bool b; +@ + strng = coerce_to_string(strng); + get_string_start_end(strng, start, end, &s, &e); + conv = copy_simple_string(strng); + b = TRUE; + for (i = s; i < e; i++) + conv->st.st_self[i] = + (*casefun)(conv->st.st_self[i], &b); + @(return conv) +@) + +LFD(Lstring_upcase)() { casefun = char_upcase; FFN(Lstring_case)(); } +LFD(Lstring_downcase)() { casefun = char_downcase; FFN(Lstring_case)(); } +LFD(Lstring_capitalize)() { casefun = char_capitalize; FFN(Lstring_case)(); } + + +@(static defun nstring_case (strng &key start end) + int s=0, e=0, i; + bool b; +@ + check_type_string(&strng); + get_string_start_end(strng, start, end, &s, &e); + b = TRUE; + for (i = s; i < e; i++) + strng->st.st_self[i] = + (*casefun)(strng->st.st_self[i], &b); + @(return strng) +@) + +LFD(Lnstring_upcase)() { casefun = char_upcase; FFN(Lnstring_case)(); } +LFD(Lnstring_downcase)() { casefun = char_downcase; FFN(Lnstring_case)(); } +LFD(Lnstring_capitalize)() { casefun = char_capitalize; FFN(Lnstring_case)(); } + + +@(defun string (x) +@ + @(return `coerce_to_string(x)`) +@) + +DEFUN_NEW("STRING-CONCATENATE",object,fLstring_concatenate,SI,0,63,NONE,OO,OO,OO,OO,(object first,...),"") { + + fixnum i,l,m,narg=VFUN_NARGS; + object x; + va_list ap; + + va_start(ap,first); + vs_base=vs_top; + for (l=i=0;ist.st_fillp; + } + va_end(ap); + + { + object *p; + BEGIN_NO_INTERRUPT; + x=alloc_simple_string(l); + (x)->st.st_self = alloc_relblock(l); + for (l=0,p=vs_base;pst.st_fillp)>=0;p++,l+=m) + memcpy(x->st.st_self+l,(*p)->st.st_self,m); + END_NO_INTERRUPT; + + } + + RETURN1(x); + +} + +void +gcl_init_string_function() +{ + sKstart1 = make_keyword("START1"); + sKend1 = make_keyword("END1"); + sKstart2 = make_keyword("START2"); + sKend2 = make_keyword("END2"); + sKinitial_element = make_keyword("INITIAL-ELEMENT"); + sKelement_type = make_keyword("ELEMENT-TYPE"); + sKstart = make_keyword("START"); + sKend = make_keyword("END"); + + make_function("CHAR", Lchar); + make_si_function("CHAR-SET", siLchar_set); + make_function("SCHAR", Lchar); + make_si_function("SCHAR-SET", siLchar_set); + make_function("STRING=", Lstring_eq); + make_function("STRING-EQUAL", Lstring_equal); + make_function("STRING<", Lstring_l); + make_function("STRING>", Lstring_g); + make_function("STRING<=", Lstring_le); + make_function("STRING>=", Lstring_ge); + make_function("STRING/=", Lstring_neq); + make_function("STRING-LESSP", Lstring_lessp); + make_function("STRING-GREATERP", Lstring_greaterp); + make_function("STRING-NOT-LESSP", Lstring_not_lessp); + make_function("STRING-NOT-GREATERP", Lstring_not_greaterp); + make_function("STRING-NOT-EQUAL", Lstring_not_equal); + make_function("MAKE-STRING", Lmake_string); + make_function("STRING-TRIM", Lstring_trim); + make_function("STRING-LEFT-TRIM", Lstring_left_trim); + make_function("STRING-RIGHT-TRIM", Lstring_right_trim); + make_function("STRING-UPCASE", Lstring_upcase); + make_function("STRING-DOWNCASE", Lstring_downcase); + make_function("STRING-CAPITALIZE", Lstring_capitalize); + make_function("NSTRING-UPCASE", Lnstring_upcase); + make_function("NSTRING-DOWNCASE", Lnstring_downcase); + make_function("NSTRING-CAPITALIZE", Lnstring_capitalize); + make_function("STRING", Lstring); + +} diff --git a/o/structure.c b/o/structure.c new file mode 100755 index 0000000..63f6e04 --- /dev/null +++ b/o/structure.c @@ -0,0 +1,465 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + structure.c + + structure interface +*/ + +#include +#include "include.h" + + +#define COERCE_DEF(x) if (type_of(x)==t_symbol) \ + x=getf(x->s.s_plist,sSs_data,Cnil) + +#define check_type_structure(x) \ + if(type_of((x))!=t_structure) \ + FEwrong_type_argument(sLstructure,(x)) + + +static bool +structure_subtypep(object x, object y) +{ if (x==y) return 1; + if (type_of(x)!= t_structure + || type_of(y)!=t_structure) + FEerror("bad call to structure_subtypep",0); + {if (S_DATA(y)->included == Cnil) return 0; + while ((x=S_DATA(x)->includes) != Cnil) + { if (x==y) return 1;} + return 0; + }} + +static void +bad_raw_type(void) +{ FEerror("Bad raw struct type",0);} + + +DEFUN_NEW("STRUCTURE-DEF",object,fSstructure_def,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_structure(x); + return (x)->str.str_def; +} + +DEFUN_NEW("STRUCTURE-LENGTH",object,fSstructure_length,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + check_type_structure(x); + return (object)S_DATA(x)->length; +} + +DEFUN_NEW("STRUCTURE-REF",object,structure_ref,SI,3,3,NONE,OO,OI,OO,OO,(object x,object name,fixnum i),"") { +/* object */ +/* structure_ref(object x, object name, int i) */ +/* { */ + unsigned short *s_pos; + COERCE_DEF(name); + if (type_of(x) != t_structure || + (type_of(name)!=t_structure) || + !structure_subtypep(x->str.str_def, name)) + FEwrong_type_argument((type_of(name)==t_structure ? + S_DATA(name)->name : name), + x); + s_pos = &SLOT_POS(x->str.str_def,0); + switch((SLOT_TYPE(x->str.str_def,i))) + { + case aet_object: return(STREF(object,x,s_pos[i])); + case aet_fix: return(make_fixnum((STREF(fixnum,x,s_pos[i])))); + case aet_ch: return(code_char(STREF(char,x,s_pos[i]))); + case aet_bit: + case aet_char: return(small_fixnum(STREF(char,x,s_pos[i]))); + case aet_sf: return(make_shortfloat(STREF(shortfloat,x,s_pos[i]))); + case aet_lf: return(make_longfloat(STREF(longfloat,x,s_pos[i]))); + case aet_uchar: return(small_fixnum(STREF(unsigned char,x,s_pos[i]))); + case aet_ushort: return(make_fixnum(STREF(unsigned short,x,s_pos[i]))); + case aet_short: return(make_fixnum(STREF(short,x,s_pos[i]))); + default: + bad_raw_type(); + return 0; + } +} +#ifdef STATIC_FUNCTION_POINTERS +object +structure_ref(object x,object name,fixnum i) { + return FFN(structure_ref)(x,name,i); +} +#endif + + +static void +FFN(siLstructure_ref1)(void) +{object x=vs_base[0]; + int n=fix(vs_base[1]); + object def; + check_type_structure(x); + def=x->str.str_def; + if(n>= S_DATA(def)->length) + FEerror("Structure ref out of bounds",0); + vs_base[0]=structure_ref(x,x->str.str_def,n); + vs_top=vs_base+1; +} + +DEFUN_NEW("STRUCTURE-SET",object,structure_set,SI,4,4,NONE,OO,OI,OO,OO,(object x,object name,fixnum i,object v),"") { +/* object */ +/* structure_set(object x, object name, int i, object v) */ +/* { */ + unsigned short *s_pos; + + COERCE_DEF(name); + if (type_of(x) != t_structure || + type_of(name) != t_structure || + !structure_subtypep(x->str.str_def, name)) + FEwrong_type_argument((type_of(name)==t_structure ? + S_DATA(name)->name : name) + , x); + +#ifdef SGC + /* make sure the structure header is on a writable page */ + if (is_marked(x)) FEerror("bad gc field",0); else unmark(x); +#endif + + s_pos= & SLOT_POS(x->str.str_def,0); + switch(SLOT_TYPE(x->str.str_def,i)){ + + case aet_object: STREF(object,x,s_pos[i])=v; break; + case aet_fix: (STREF(fixnum,x,s_pos[i]))=fix(v); break; + case aet_ch: STREF(char,x,s_pos[i])=char_code(v); break; + case aet_bit: + case aet_char: STREF(char,x,s_pos[i])=fix(v); break; + case aet_sf: STREF(shortfloat,x,s_pos[i])=sf(v); break; + case aet_lf: STREF(longfloat,x,s_pos[i])=lf(v); break; + case aet_uchar: STREF(unsigned char,x,s_pos[i])=fix(v); break; + case aet_ushort: STREF(unsigned short,x,s_pos[i])=fix(v); break; + case aet_short: STREF(short,x,s_pos[i])=fix(v); break; + default: + bad_raw_type(); + + } + return(v); +} +#ifdef STATIC_FUNCTION_POINTERS +object +structure_set(object x,object name,fixnum i,object v) { + return FFN(structure_set)(x,name,i,v); +} +#endif + +static void +FFN(siLstructure_subtype_p)(void) +{object x,y; + check_arg(2); + x=vs_base[0]; + y=vs_base[1]; + if (type_of(x)!=t_structure) + {vs_base[0]=Cnil; goto BOTTOM;} + x=x->str.str_def; + COERCE_DEF(y); + if (structure_subtypep(x,y)) vs_base[0]=Ct; + else vs_base[0]=Cnil; + BOTTOM: + vs_top=vs_base+1; +} + + + +object +structure_to_list(object x) +{ + + object *p,s,v; + struct s_data *def=S_DATA(x->str.str_def); + int i,n; + + s=def->slot_descriptions; + for (p=&v,i=0,n=def->length;!endp(s)&&ic.c_cdr,i++) { + collect(p,make_cons(car(s->c.c_car),Cnil)); + collect(p,make_cons(structure_ref(x,x->str.str_def,i),Cnil)); + } + *p=Cnil; + + return make_cons(def->name,v); + +} + +LFD(siLmake_structure)(void) +{ + object x,name,*base; + struct s_data *def=NULL; + int narg, i,size; + base=vs_base; + if ((narg = vs_top - base) == 0) + too_few_arguments(); + {BEGIN_NO_INTERRUPT; + x = alloc_object(t_structure); + name=base[0]; + COERCE_DEF(name); + if (type_of(name)!=t_structure || + (def=S_DATA(name))->length != --narg) + FEerror("Bad make_structure args for type ~a",1,base[0]); + x->str.str_def = name; + x->str.str_self = NULL; + size=S_DATA(name)->size; + base[0] = x; + x->str.str_self = (object *) + (def->staticp == Cnil ? alloc_relblock(size) + : alloc_contblock(size)); + /* There may be holes in the structure. + We want them zero, so that equal can work better. + */ + if (S_DATA(name)->has_holes != Cnil) + bzero(x->str.str_self,size); + {unsigned char *s_type; + unsigned short *s_pos; + s_pos= (&SLOT_POS(x->str.str_def,0)); + s_type = (&(SLOT_TYPE(x->str.str_def,0))); + base=base+1; + for (i = 0; i < narg; i++) + {object v=base[i]; + switch(s_type[i]){ + + case aet_object: STREF(object,x,s_pos[i])=v; break; + case aet_fix: (STREF(fixnum,x,s_pos[i]))=fix(v); break; + case aet_ch: STREF(char,x,s_pos[i])=char_code(v); break; + case aet_bit: + case aet_char: STREF(char,x,s_pos[i])=fix(v); break; + case aet_sf: STREF(shortfloat,x,s_pos[i])=sf(v); break; + case aet_lf: STREF(longfloat,x,s_pos[i])=lf(v); break; + case aet_uchar: STREF(unsigned char,x,s_pos[i])=fix(v); break; + case aet_ushort: STREF(unsigned short,x,s_pos[i])=fix(v); break; + case aet_short: STREF(short,x,s_pos[i])=fix(v); break; + default: + bad_raw_type(); + + }} + vs_top = base; + vs_base=base-1; + END_NO_INTERRUPT;} + } +} + +static void +FFN(Lcopy_structure)(void) +{ + object x, y; + struct s_data *def; + + check_arg(1); +/* if (vs_top-vs_base < 1) too_few_arguments(); */ + x = vs_base[0]; + check_type_structure(x); + {BEGIN_NO_INTERRUPT; + vs_base[0] = y = alloc_object(t_structure); + def=S_DATA(y->str.str_def = x->str.str_def); + y->str.str_self = NULL; + y->str.str_self = (object *)alloc_relblock(def->size); + bcopy(x->str.str_self,y->str.str_self,def->size); + vs_top=vs_base+1; + END_NO_INTERRUPT;} +} + +LFD(siLstructure_name)(void) +{ + check_arg(1); + check_type_structure(vs_base[0]); + vs_base[0] = S_DATA(vs_base[0]->str.str_def)->name; +} + +LFD(siLstructure_ref)(void) +{ + check_arg(3); + vs_base[0]=structure_ref(vs_base[0],vs_base[1],fix(vs_base[2])); + vs_top=vs_base+1; +} + +LFD(siLstructure_set)(void) +{ + check_arg(4); + structure_set(vs_base[0],vs_base[1],fix(vs_base[2]),vs_base[3]); + vs_base = vs_top-1; +} + +LFD(siLstructurep)(void) +{ + check_arg(1); + if (type_of(vs_base[0]) == t_structure) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +LFD(siLrplaca_nthcdr)(void) +{ + +/* + Used in DEFSETF forms generated by DEFSTRUCT. + (si:rplaca-nthcdr x i v) is equivalent to + (progn (rplaca (nthcdr i x) v) v). +*/ + int i; + object l; + + check_arg(3); + if (type_of(vs_base[1]) != t_fixnum || fix(vs_base[1]) < 0) + FEerror("~S is not a non-negative fixnum.", 1, vs_base[1]); + if (type_of(vs_base[0]) != t_cons) + FEerror("~S is not a cons.", 1, vs_base[0]); + + for (i = fix(vs_base[1]), l = vs_base[0]; i > 0; --i) { + l = l->c.c_cdr; + if (endp(l)) + FEerror("The offset ~S is too big.", 1, vs_base[1]); + } + take_care(vs_base[2]); + l->c.c_car = vs_base[2]; + vs_base = vs_base + 2; +} + +LFD(siLlist_nth)(void) +{ + +/* + Used in structure access functions generated by DEFSTRUCT. + si:list-nth is similar to nth except that + (si:list-nth i x) is error if the length of the list x is less than i. +*/ + int i; + object l; + + check_arg(2); + if (type_of(vs_base[0]) != t_fixnum || fix(vs_base[0]) < 0) + FEerror("~S is not a non-negative fixnum.", 1, vs_base[0]); + if (type_of(vs_base[1]) != t_cons) + FEerror("~S is not a cons.", 1, vs_base[1]); + + for (i = fix(vs_base[0]), l = vs_base[1]; i > 0; --i) { + l = l->c.c_cdr; + if (endp(l)) + FEerror("The offset ~S is too big.", 1, vs_base[0]); + } + + vs_base[0] = l->c.c_car; + vs_popp; +} + + +static void +FFN(siLmake_s_data_structure)(void) +{object x,y,raw,*base; + int i; + check_arg(5); + x=vs_base[0]; + base=vs_base; + raw=vs_base[1]; + y=alloc_object(t_structure); + y->str.str_def=y; + y->str.str_self = (object *)( x->v.v_self); + S_DATA(y)->name =sSs_data; + S_DATA(y)->length=(raw->v.v_dim); + S_DATA(y)->raw =raw; + for(i=3; iv.v_dim; i++) + y->str.str_self[i]=Cnil; + S_DATA(y)->slot_position=base[2]; + S_DATA(y)->slot_descriptions=base[3]; + S_DATA(y)->staticp=base[4]; + S_DATA(y)->size = (raw->v.v_dim)*sizeof(object); + vs_base[0]=y; + vs_top=vs_base+1; +} + +/* static void */ +/* FFN(siLstructure_def)(void) */ +/* {check_arg(1); */ +/* check_type_structure(vs_base[0]); */ +/* vs_base[0]=vs_base[0]->str.str_def; */ +/* } */ + +short aet_sizes [] = { +sizeof(object), /* aet_object t */ +sizeof(char), /* aet_ch string-char */ +sizeof(char), /* aet_bit bit */ +sizeof(fixnum), /* aet_fix fixnum */ +sizeof(float), /* aet_sf short-float */ +sizeof(double), /* aet_lf long-float */ +sizeof(char), /* aet_char signed char */ +sizeof(char), /* aet_uchar unsigned char */ +sizeof(short), /* aet_short signed short */ +sizeof(short) /* aet_ushort unsigned short */ +}; + + + + + +static void +FFN(siLsize_of)(void) +{ object x= vs_base[0]; + int i; + i= aet_sizes[fix(fSget_aelttype(x))]; + vs_base[0]=make_fixnum(i); +} + +static void +FFN(siLaet_type)(void) +{vs_base[0]=fSget_aelttype(vs_base[0]);} + + +/* Return N such that something of type ARG can be aligned on + an address which is a multiple of N */ + + +static void +FFN(siLalignment)(void) +{struct {double x; int y; double z; + float x1; int y1; float z1;} + joe; + joe.z=3.0; + + if (vs_base[0]==sLlong_float) + {vs_base[0]=make_fixnum((long)&joe.z- (long)&joe.y); return;} + else + if (vs_base[0]==sLshort_float) + {vs_base[0]=make_fixnum((long)&(joe.z1)-(long)&(joe.y1)); return;} + else + {FFN(siLsize_of)();} +} + + +DEF_ORDINARY("S-DATA",sSs_data,SI,""); + +void +gcl_init_structure_function(void) +{ + + + make_si_function("MAKE-STRUCTURE", siLmake_structure); + make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure); + make_function("COPY-STRUCTURE", Lcopy_structure); + make_si_function("STRUCTURE-NAME", siLstructure_name); + /* make_si_function("STRUCTURE-REF", siLstructure_ref); */ + /* make_si_function("STRUCTURE-DEF", siLstructure_def); */ + make_si_function("STRUCTURE-REF1", siLstructure_ref1); + /* make_si_function("STRUCTURE-SET", siLstructure_set); */ + make_si_function("STRUCTUREP", siLstructurep); + make_si_function("SIZE-OF", siLsize_of); + make_si_function("ALIGNMENT",siLalignment); + make_si_function("STRUCTURE-SUBTYPE-P",siLstructure_subtype_p); + make_si_function("RPLACA-NTHCDR", siLrplaca_nthcdr); + make_si_function("LIST-NTH", siLlist_nth); + make_si_function("AET-TYPE",siLaet_type); +} diff --git a/o/symbol.d b/o/symbol.d new file mode 100755 index 0000000..ff71dea --- /dev/null +++ b/o/symbol.d @@ -0,0 +1,711 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +*/ + +/* + symbol.d +*/ + +#include +#include "include.h" + +/*FIXME this symbol is needed my maxima MAKE_SPECIAL*/ +void +check_type_symbol(object *x) { + check_type_sym(x); +} + +static void +odd_plist(object); + + +object siSpname; + +void +set_up_string_register(char *s) { + string_register->st.st_fillp = + string_register->st.st_dim = strlen(s); + string_register->st.st_self = s; +} + +object +make_symbol(st) +object st; +{ + object x; + int i; + {BEGIN_NO_INTERRUPT; + x = alloc_object(t_symbol); + x->s.s_dbind = OBJNULL; + x->s.s_sfdef = NOT_SPECIAL; + x->s.s_fillp = st->st.st_fillp; + x->s.s_self = NULL; + x->s.s_gfdef = OBJNULL; + x->s.s_plist = Cnil; + x->s.s_hpack = Cnil; + x->s.s_stype = (short)stp_ordinary; + x->s.s_mflag = FALSE; + vs_push(x); + if (raw_image && st->st.st_self < heap_end) + x->s.s_self = st->st.st_self; + else { + x->s.s_self = alloc_relblock(x->s.s_fillp); + for (i = 0; i < x->s.s_fillp; i++) + x->s.s_self[i] = st->st.st_self[i]; + } + END_NO_INTERRUPT;} + return(vs_pop); +} + +/* + Make_ordinary(s) makes an ordinary symbol from C string s + and interns it in lisp package as an external symbol. +*/ + +#define P_EXTERNAL(x,j) ((x)->p.p_external[(j) % (x)->p.p_external_size]) + + +object +make_ordinary(s) +char *s; +{ + int j; + object x, l, *ep; + vs_mark; + + set_up_string_register(s); + j = pack_hash(string_register); + ep = &P_EXTERNAL(lisp_package,j); + for (l = *ep; type_of(l) == t_cons; l = l->c.c_cdr) + if (string_eq(l->c.c_car, string_register)) + return(l->c.c_car); + x = make_symbol(string_register); + vs_push(x); + x->s.s_hpack = lisp_package; + *ep = make_cons(x, *ep); + lisp_package->p.p_external_fp ++; + vs_reset; + return(x); +} + +/* + Make_special(s, v) makes a special variable from C string s + with initial value v in lisp package. +*/ +object +make_special(s, v) +char *s; +object v; +{ + object x; + + x = make_ordinary(s); + x->s.s_stype = (short)stp_special; + x->s.s_dbind = v; + return(x); +} + +/* + Make_constant(s, v) makes a constant from C string s + with constant value v in lisp package. +*/ +object +make_constant(s, v) +char *s; +object v; +{ + object x; + + x = make_ordinary(s); + x->s.s_stype = (short)stp_constant; + x->s.s_dbind = v; + return(x); +} + +/* + Make_si_ordinary(s) makes an ordinary symbol from C string s + and interns it in system package as an external symbol. + It assumes that the (only) package used by system is lisp. +*/ + + + +object +make_si_ordinary(s) +char *s; +{ + int j; + object x, l, *ep; + vs_mark; + + set_up_string_register(s); + j = pack_hash(string_register); + ep = & P_EXTERNAL(system_package,j); + for (l = *ep; type_of(l) == t_cons; l = l->c.c_cdr) + if (string_eq(l->c.c_car, string_register)) + return(l->c.c_car); + for (l = P_EXTERNAL(lisp_package,j); + type_of(l) == t_cons; + l = l->c.c_cdr) + if (string_eq(l->c.c_car, string_register)) + error("name conflict --- can't make_si_ordinary"); + x = make_symbol(string_register); + vs_push(x); + x->s.s_hpack = system_package; + system_package->p.p_external_fp ++; + *ep = make_cons(x, *ep); + vs_reset; + return(x); +} + +/* + Make_si_special(s, v) makes a special variable from C string s + with initial value v in system package. +*/ +object +make_si_special(s, v) +char *s; +object v; +{ + object x; + + x = make_si_ordinary(s); + x->s.s_stype = (short)stp_special; + x->s.s_dbind = v; + return(x); +} + +/* + Make_si_constant(s, v) makes a constant from C string s + with constant value v in system package. +*/ +object +make_si_constant(s, v) +char *s; +object v; +{ + object x; + + x = make_si_ordinary(s); + x->s.s_stype = (short)stp_constant; + x->s.s_dbind = v; + return(x); +} + +/* + Make_keyword(s) makes a keyword from C string s. +*/ +object +make_keyword(s) +char *s; +{ + int j; + object x, l, *ep; + vs_mark; + + set_up_string_register(s); + j = pack_hash(string_register); + ep = &P_EXTERNAL(keyword_package,j); + for (l = *ep; type_of(l) == t_cons; l = l->c.c_cdr) + if (string_eq(l->c.c_car, string_register)) + return(l->c.c_car); + x = make_symbol(string_register); + vs_push(x); + x->s.s_hpack = keyword_package; + x->s.s_stype = (short)stp_constant; + x->s.s_dbind = x; + *ep = make_cons(x, *ep); + keyword_package->p.p_external_fp ++; + vs_reset; + return(x); +} + +object +symbol_value(s) +object s; +{ +/* + if (type_of(s) != t_symbol) + FEinvalid_variable("~S is not a symbol.", s); +*/ + if (s->s.s_dbind == OBJNULL) + FEunbound_variable(s); + return(s->s.s_dbind); +} + +object +getf(place, indicator, deflt) +object place, indicator, deflt; +{ + + object l; +#define cendp(obj) ((type_of(obj)!=t_cons)) + for (l = place; !cendp(l); l = l->c.c_cdr->c.c_cdr) { + if (cendp(l->c.c_cdr)) + break; + if (l->c.c_car == indicator) + return(l->c.c_cdr->c.c_car); + } + if(l==Cnil) return deflt; + FEerror("Bad plist ~a",1,place); + return Cnil; +} + +object +get(s, p, d) +object s, p, d; +{ + if (type_of(s) != t_symbol) + not_a_symbol(s); + return(getf(s->s.s_plist, p, d)); +} + +/* + Putf(p, v, i) puts value v for property i to property list p + and returns the resulting property list. +*/ +object +putf(p, v, i) +object p, v, i; +{ + object l; + + for (l = p; !cendp(l); l = l->c.c_cdr->c.c_cdr) { + if (cendp(l->c.c_cdr)) + break; + if (l->c.c_car == i) { + l->c.c_cdr->c.c_car = v; + return(p); + } + } + if(l!=Cnil) FEerror("Bad plist ~a",1,p); + return listA(3,i,v,p); +} + +object +putprop(s, v, p) +object s, v, p; +{ + if (type_of(s) != t_symbol) + not_a_symbol(s); + s->s.s_plist = putf(s->s.s_plist, v, p); + return(v); +} + + +/* done in the right order for efficient setf.. */ +STATD object +FFN(sputprop)(s, p, v) +object s, v, p; +{ + if (type_of(s) != t_symbol) + not_a_symbol(s); + s->s.s_plist = putf(s->s.s_plist, v, p); + return(v); +} +#ifdef STATIC_FUNCTION_POINTERS +object +sputprop(object s, object p, object v) { + return FFN(sputprop)(s,p,v); +} +#endif + +/* + Remf(p, i) removes property i + from the property list pointed by p, + which is a pointer to an object. + The returned value of remf(p, i) is: + + TRUE if the property existed + FALSE otherwise. +*/ +bool +remf(p, i) +object *p, i; +{ + object l0 = *p; + + for(; !endp(*p); p = &(*p)->c.c_cdr->c.c_cdr) { + if (endp((*p)->c.c_cdr)) + odd_plist(l0); + if ((*p)->c.c_car == i) { + *p = (*p)->c.c_cdr->c.c_cdr; + return(TRUE); + } + } + return(FALSE); +} + +object +remprop(s, p) +object s, p; +{ + if (type_of(s) != t_symbol) + not_a_symbol(s); + if (remf(&s->s.s_plist, p)) + return(Ct); + else + return(Cnil); +} + +bool +keywordp(s) +object s; +{ + return(type_of(s) == t_symbol && s->s.s_hpack == keyword_package); +/* + if (type_of(s) != t_symbol) { + vs_push(s); + check_type_sym(&vs_head); + vs_pop; + } + if (s->s.s_hpack == OBJNULL) + return(FALSE); + return(s->s.s_hpack == keyword_package); +*/ +} + +@(defun get (sym indicator &optional deflt) +@ + check_type_sym(&sym); + @(return `getf(sym->s.s_plist, indicator, deflt)`) +@) + +LFD(Lremprop)() +{ + check_arg(2); + + check_type_sym(&vs_base[0]); + if (remf(&vs_base[0]->s.s_plist, vs_base[1])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; + vs_popp; +} + +LFD(Lsymbol_plist)() +{ + check_arg(1); + + check_type_sym(&vs_base[0]); + vs_base[0] = vs_base[0]->s.s_plist; +} + +@(defun getf (place indicator &optional deflt) +@ + @(return `getf(place, indicator, deflt)`) +@) + +@(defun get_properties (place indicator_list) + object l, m; + +@ + for (l = place; !endp(l); l = l->c.c_cdr->c.c_cdr) { + if (endp(l->c.c_cdr)) + odd_plist(place); + for (m = indicator_list; !endp(m); m = m->c.c_cdr) + if (l->c.c_car == m->c.c_car) + @(return `l->c.c_car` + `l->c.c_cdr->c.c_car` + l) + } + @(return Cnil Cnil Cnil) +@) + + +object +symbol_name(x) +object x; +{ +object y; + if (type_of(x)!=t_symbol) FEwrong_type_argument(sLsymbol,x); + for (y=x->s.s_plist; type_of(y)==t_cons ; y=y->c.c_cdr->c.c_cdr) + {if(y->c.c_car==siSpname) return(y->c.c_cdr->c.c_car);} + {BEGIN_NO_INTERRUPT; + y = alloc_simple_string(x->s.s_fillp); + vs_push(y); + if (x->s.s_self < heap_end) + y->st.st_self = x->s.s_self; + else {int i; + y->st.st_self = alloc_relblock(x->s.s_fillp); + for (i = 0; i < x->s.s_fillp; i++) + y->st.st_self[i] = x->s.s_self[i]; + } + x->s.s_plist = putf(x->s.s_plist, y, siSpname); + vs_popp; + END_NO_INTERRUPT; } + return(y); +} + +LFD(Lsymbol_name)() +{ + check_arg(1); + vs_base[0]=symbol_name(vs_base[0]); +} + +LFD(Lmake_symbol)() +{ + check_arg(1); + + check_type_string(&vs_base[0]); + vs_base[0] = make_symbol(vs_base[0]); +} + +@(defun copy_symbol (sym &optional cp &aux x) +@ + check_type_sym(&sym); + x = make_symbol(sym); + if (cp == Cnil) + @(return x) + x->s.s_stype = sym->s.s_stype; + x->s.s_dbind = sym->s.s_dbind; + x->s.s_mflag = sym->s.s_mflag; + x->s.s_gfdef = sym->s.s_gfdef; + x->s.s_plist = copy_list(sym->s.s_plist); + @(return x) +@) + +DEFVAR("*GENSYM-COUNTER*",sLgensym_counter,LISP,make_fixnum(0),""); + +@(defun gensym (&optional (x gensym_prefix) &aux sym) + int i, j, sign, size; + fixnum f; + char *q=NULL,*p=NULL; + object this_gensym_prefix,big; + object this_gensym_counter; +@ + if (type_of(x) == t_string) { + this_gensym_prefix = x; + this_gensym_counter=sLgensym_counter->s.s_dbind; + sLgensym_counter->s.s_dbind=number_plus(sLgensym_counter->s.s_dbind,small_fixnum(1)); + } else { + check_type_non_negative_integer(&x); + this_gensym_counter=x; + this_gensym_prefix=gensym_prefix; + } + + switch (type_of(this_gensym_counter)) { + case t_bignum: + big=this_gensym_counter; + sign=BIG_SIGN(big); + size = mpz_sizeinbase(MP(big),10)+2+(sign<0? 1 : 0); + if (!(p=alloca(size))) + FEerror("Cannot alloca gensym name", 0); + mpz_get_str(p,10,MP(big)); + j=size-5; + j=j<0 ? 0 : j; + while (p[j]) j++; + q=p+j; + break; + case t_fixnum: + for (size=1,f=fix(this_gensym_counter);f;f/=10,size++); + q=p=alloca(size+5); + if ((j=snprintf(p,size+5,"%ld",fix(this_gensym_counter)))<=0) + FEerror("Cannot write gensym counter",0); + q=p+j; + break; + default: + FEerror("Bad gensym counter type", 0); + break; + } + +/* FIXME: come up with a better call sequence */ +/* this_gensym_counter_string=fLformat_1(Cnil,make_simple_string("~S"),this_gensym_counter); */ +/* i=this_gensym_counter_string->st.st_fillp; */ + + i = (q-p)+this_gensym_prefix->st.st_fillp; + set_up_string_register(""); + sym = make_symbol(string_register); + {BEGIN_NO_INTERRUPT; + sym->s.s_self = alloc_relblock(i); + sym->s.s_fillp = i; + i=this_gensym_prefix->st.st_fillp; + for (j = 0; j < i; j++) + sym->s.s_self[j] = this_gensym_prefix->st.st_self[j]; + for (;js.s_fillp;j++) + sym->s.s_self[j] = p[j-i]; + END_NO_INTERRUPT;} + @(return sym) +@) + +@(defun gentemp (&optional (prefix gentemp_prefix) + (pack `current_package()`) + &aux smbl) + int i, j; +@ + check_type_string(&prefix); + check_type_package(&pack); +/* + gentemp_counter = 0; +*/ +ONCE_MORE: + for (j = gentemp_counter, i = 0; j > 0; j /= 10) + i++; + if (i == 0) + i++; + i += prefix->st.st_fillp; + set_up_string_register(""); + {BEGIN_NO_INTERRUPT; + string_register->st.st_fillp = string_register->st.st_dim = i; + string_register->st.st_self = alloc_relblock(i); + for (j = 0; j < prefix->st.st_fillp; j++) + string_register->st.st_self[j] = prefix->st.st_self[j]; + if ((j = gentemp_counter) == 0) + string_register->st.st_self[--i] = '0'; + else + for (; j > 0; j /= 10) + string_register->st.st_self[--i] = j%10 + '0'; + gentemp_counter++; + smbl = intern(string_register, pack); + if (intern_flag != 0) + goto ONCE_MORE; + END_NO_INTERRUPT;} + @(return smbl) +@) + +LFD(Lsymbol_package)() +{ + check_arg(1); + + check_type_sym(&vs_base[0]); + vs_base[0] = vs_base[0]->s.s_hpack; +} + +LFD(Lkeywordp)() +{ + check_arg(1); + + if (type_of(vs_base[0]) == t_symbol && keywordp(vs_base[0])) + vs_base[0] = Ct; + else + vs_base[0] = Cnil; +} + +/* + (SI:PUT-F plist value indicator) + returns the new property list with value for property indicator. + It will be used in SETF for GETF. +*/ +LFD(siLput_f)() +{ + check_arg(3); + + vs_base[0] = putf(vs_base[0], vs_base[1], vs_base[2]); + vs_top = vs_base+1; +} + +/* + (SI:REM-F plist indicator) returns two values: + + * the new property list + in which property indcator is removed + + * T if really removed + NIL otherwise. + + It will be used for macro REMF. +*/ +LFD(siLrem_f)() +{ + check_arg(2); + + if (remf(&vs_base[0], vs_base[1])) + vs_base[1] = Ct; + else + vs_base[1] = Cnil; +} + +LFD(siLset_symbol_plist)(void) +{ + check_arg(2); + + check_type_sym(&vs_base[0]); + vs_base[0]->s.s_plist = vs_base[1]; + vs_base[0] = vs_base[1]; + vs_popp; +} + +LFD(siLputprop)() +{ + check_arg(3); + + check_type_sym(&vs_base[0]); + vs_base[0]->s.s_plist + = putf(vs_base[0]->s.s_plist, vs_base[1], vs_base[2]); + vs_base[0] = vs_base[1]; + vs_top = vs_base+1; +} + + +static void +odd_plist(place) +object place; +{ + FEerror("The length of the property-list ~S is odd.", 1, place); +} + + +void +gcl_init_symbol() +{ + string_register = alloc_simple_string(0); + gensym_prefix = make_simple_string("G"); +/* gensym_counter = 0; */ + gentemp_prefix = make_simple_string("T"); + gentemp_counter = 0; + token = alloc_simple_string(INITIAL_TOKEN_LENGTH); + token->st.st_fillp = 0; + token->st.st_self = alloc_contblock(INITIAL_TOKEN_LENGTH); + token->st.st_hasfillp = TRUE; + token->st.st_adjustable = TRUE; + + enter_mark_origin(&string_register); + enter_mark_origin(&gensym_prefix); + enter_mark_origin(&gentemp_prefix); + enter_mark_origin(&token); +} + +void +gcl_init_symbol_function() +{ + make_function("GET", Lget); + make_function("REMPROP", Lremprop); + make_function("SYMBOL-PLIST", Lsymbol_plist); + make_function("GETF", Lgetf); + make_function("GET-PROPERTIES", Lget_properties); + make_function("SYMBOL-NAME", Lsymbol_name); + make_function("MAKE-SYMBOL", Lmake_symbol); + make_function("COPY-SYMBOL", Lcopy_symbol); + make_function("GENSYM", Lgensym); + make_function("GENTEMP", Lgentemp); + make_function("SYMBOL-PACKAGE", Lsymbol_package); + make_function("KEYWORDP", Lkeywordp); + + make_si_function("PUT-F", siLput_f); + make_si_function("REM-F", siLrem_f); + make_si_function("SET-SYMBOL-PLIST", siLset_symbol_plist); + + make_si_function("PUTPROP", siLputprop); + make_si_sfun("SPUTPROP",sputprop,3); + + + siSpname = make_si_ordinary("PNAME"); + enter_mark_origin(&siSpname); +/* enter_mark_origin(&sLgensym_counter); */ +} diff --git a/o/test_memprotect.c b/o/test_memprotect.c new file mode 100755 index 0000000..7e9c1d8 --- /dev/null +++ b/o/test_memprotect.c @@ -0,0 +1,71 @@ +/* + sample usage: +linux14% cd gcl-2.2 +linux14% cd o +linux14% gcc -I../h test_memprotect.c +linux14% a.out +[val=0] +Page violation (sig=b,code=2b,scp=2b,addr=2b,fault_adr=804a005) + +Reading pp[5] (addr=804a005) 10 +linux14% +*/ + +#define IN_GBC +#define NEED_MP_H +#include "include.h" + + + +#ifdef BSD +/* ulong may have been defined in mp.h but the define is no longer needed */ +#undef ulong +#include +#define PROT_READ_WRITE (PROT_READ | PROT_WRITE |PROT_EXEC) +#endif +#ifdef AIX3 +#include +#define PROT_READ RDONLY +#define PROT_READ_WRITE UDATAKEY +int mprotect(); +#endif + +#include + + +char *pp; +int psize; + +char *malloc(); + +#include +#include + +void +handler(sig,code,scp,addr) + int sig,code; + struct sigcontext *scp; + char *addr; +{ + struct sigcontext_struct *bil= (void *) & code; + printf("\nPage violation (sig=%x,code=%x,scp=%x,addr=%x,fault_adr=%x)",sig,code,scp,addr,GET_FAULT_ADDR(sig,code,scp,addr)); + fflush(stdout); + mprotect(pp, psize, PROT_READ | PROT_WRITE); + return; +} + +main() +{ + char *p; + int a; + signal(SIGSEGV, handler); + signal(SIGBUS, handler); + psize = getpagesize(); + p = malloc(3 * psize); + a = (int)p; + pp = (char *)( ((a / psize)+ 1) * psize); + printf("[val=%d]",mprotect(pp, psize, PROT_READ)); + pp[5] = 10; + printf("\n\nReading pp[5] (addr=%x) %d\n",&pp[5], pp[5]); + fflush(stdout); +} diff --git a/o/toplevel.c b/o/toplevel.c new file mode 100755 index 0000000..2569811 --- /dev/null +++ b/o/toplevel.c @@ -0,0 +1,241 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + + toplevel.c + + Top-Level Forms and Declarations +*/ + +#include "include.h" + +object sLcompile, sLload, sLeval, sKcompile_toplevel, sKload_toplevel, sKexecute; +object sLprogn; + + +object sLwarn; + +object sSAinhibit_macro_specialA; + +object sLtypep; + +static void +FFN(Fdefun)(object args) +{ + + object name; + object body, form; + + if (endp(args) || endp(MMcdr(args))) + FEtoo_few_argumentsF(args); + if (MMcadr(args) != Cnil && type_of(MMcadr(args)) != t_cons) + FEerror("~S is an illegal lambda-list.", 1, MMcadr(args)); + name = MMcar(args); + if (type_of(name) != t_symbol) + not_a_symbol(name); + if (name->s.s_sfdef != NOT_SPECIAL) { + if (name->s.s_mflag) { + if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + name->s.s_sfdef = NOT_SPECIAL; + } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil) + FEerror("~S, a special form, cannot be redefined.", 1, name); + } + if (name->s.s_hpack == lisp_package && + name->s.s_gfdef != OBJNULL && !raw_image) { + vs_push(make_simple_string( + "~S is being redefined.")); + ifuncall2(sLwarn, vs_head, name); + vs_popp; + } + vs_base = vs_top; + if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) { + vs_push(MMcons(sSlambda_block, args)); + } else { + vs_push(MMcons(lex_env[2], args)); + vs_base[0] = MMcons(lex_env[1], vs_base[0]); + vs_base[0] = MMcons(lex_env[0], vs_base[0]); + vs_base[0] = MMcons(sSlambda_block_closure, vs_base[0]); + } + {object fname = clear_compiler_properties(name,vs_base[0]); + fname->s.s_gfdef = vs_base[0]; + fname->s.s_mflag = FALSE;} + vs_base[0] = name; + for (body = MMcddr(args); !endp(body); body = body->c.c_cdr) { + form = macro_expand(body->c.c_car); + if (type_of(form) == t_string) { + if (endp(body->c.c_cdr)) + break; + vs_push(form); + name->s.s_plist = + putf(name->s.s_plist, + form, + sSfunction_documentation); + vs_popp; + break; + } + if (type_of(form) != t_cons || form->c.c_car != sLdeclare) + break; + } +} + +static void +FFN(siLAmake_special)(void) +{ + check_arg(1); + check_type_sym(&vs_base[0]); + if ((enum stype)vs_base[0]->s.s_stype == stp_constant) + FEerror("~S is a constant.", 1, vs_base[0]); + vs_base[0]->s.s_stype = (short)stp_special; +} + +static void +FFN(siLAmake_constant)(void) +{ + check_arg(2); + check_type_sym(&vs_base[0]); + if ((enum stype)vs_base[0]->s.s_stype == stp_special) + FEerror( + "The argument ~S to DEFCONSTANT is a special variable.", + 1, vs_base[0]); + vs_base[0]->s.s_stype = (short)stp_constant; + vs_base[0]->s.s_dbind = vs_base[1]; + vs_popp; +} + +static void +FFN(Feval_when)(object arg) +{ + + object *base = vs_base; + object ss; + bool flag = FALSE; + + if(endp(arg)) + FEtoo_few_argumentsF(arg); + for (ss = MMcar(arg); !endp(ss); ss = MMcdr(ss)) + if(MMcar(ss) == sLeval || (MMcar(ss) == sKexecute) ) + flag = TRUE; + else if(MMcar(ss) != sLload && MMcar(ss) != sLcompile && + MMcar(ss) != sKload_toplevel && MMcar(ss) != sKcompile_toplevel ) + FEinvalid_form("~S is an undefined situation for EVAL-WHEN.", + MMcar(ss)); + if(flag) { + vs_push(make_cons(sLprogn, MMcdr(arg))); + eval(vs_head); + } else { + vs_base = base; + vs_top = base+1; + vs_base[0] = Cnil; + } +} + +static void +FFN(Fload_time_value)(object arg) +{ + + if(endp(arg)) + FEtoo_few_argumentsF(arg); + if(!endp(MMcdr(arg)) && !endp(MMcddr(arg))) + FEtoo_many_argumentsF(arg); + vs_push(MMcar(arg)); + eval(vs_head); + +} + +static void +FFN(Fdeclare)(object arg) +{ + FEerror("DECLARE appeared in an invalid position.", 0); +} + +static void +FFN(Flocally)(object body) +{ + object *oldlex = lex_env; + + lex_copy(); + body = find_special(body, NULL, NULL,NULL); + vs_push(body); + Fprogn(body); + lex_env = oldlex; +} + +static void +FFN(Fthe)(object args) +{ + + object *vs; + + if(endp(args) || endp(MMcdr(args))) + FEtoo_few_argumentsF(args); + if(!endp(MMcddr(args))) + FEtoo_many_argumentsF(args); + eval(MMcadr(args)); + args = MMcar(args); + if (type_of(args) == t_cons && MMcar(args) == sLvalues) { + vs = vs_base; + for (args=MMcdr(args); !endp(args); args=MMcdr(args), vs++){ + if (vs >= vs_top) + FEerror("Too many return values.", 0); + if (ifuncall2(sLtypep, *vs, MMcar(args)) == Cnil) + FEwrong_type_argument(MMcar(args), *vs); + } + if (vs < vs_top) + FEerror("Too few return values.", 0); + } else { + if (ifuncall2(sLtypep, vs_base[0], args) == Cnil) + FEwrong_type_argument(args, vs_base[0]); + } +} + +DEF_ORDINARY("LDB",sLldb,LISP,""); +DEF_ORDINARY("LDB-TEST",sLldb_test,LISP,""); +DEF_ORDINARY("DPB",sLdpb,LISP,""); +DEF_ORDINARY("DEPOSIT-FIELD",sLdeposit_field,LISP,""); +DEF_ORDINARY("COMPILE",sLcompile,LISP,""); +DEF_ORDINARY("COMPILE-TOPLEVEL",sKcompile_toplevel,KEYWORD,""); +DEF_ORDINARY("DECLARE",sLdeclare,LISP,""); +DEF_ORDINARY("EVAL",sLeval,LISP,""); +DEF_ORDINARY("EXECUTE",sKexecute,KEYWORD,""); +DEF_ORDINARY("FUNCTION-DOCUMENTATION",sSfunction_documentation,SI,""); +DEF_ORDINARY("LOAD",sLload,LISP,""); +DEF_ORDINARY("LOAD-TOPLEVEL",sKload_toplevel,KEYWORD,""); +DEF_ORDINARY("PROGN",sLprogn,LISP,""); +DEF_ORDINARY("TYPEP",sLtypep,LISP,""); +DEF_ORDINARY("VALUES",sLvalues,LISP,""); +DEF_ORDINARY("VARIABLE-DOCUMENTATION",sSvariable_documentation,SI,""); +DEF_ORDINARY("WARN",sLwarn,LISP,""); + +void +gcl_init_toplevel(void) +{ + make_special_form("DEFUN",Fdefun); + make_si_function("*MAKE-SPECIAL", siLAmake_special); + make_si_function("*MAKE-CONSTANT", siLAmake_constant); + make_special_form("EVAL-WHEN", Feval_when); + make_special_form("LOAD-TIME-VALUE", Fload_time_value); + make_special_form("THE", Fthe); + sLdeclare=make_special_form("DECLARE",Fdeclare); + make_special_form("LOCALLY",Flocally); + + +} diff --git a/o/try.c b/o/try.c new file mode 100755 index 0000000..fba3eef --- /dev/null +++ b/o/try.c @@ -0,0 +1,496 @@ +#ifndef UNIXSAVE +#include "config.h" +#endif +/* #include */ /* _fmode */ +#include +#include +#include +#include +#include +#ifdef _GNU_H_WINDOWS_H +#include "cyglacks.h" +#endif +#undef DBEGIN +#define DBEGIN 0x400000 + +#include "ntheap.h" +/* Info for keeping track of our heap. */ +unsigned char *data_region_base = UNINIT_PTR; +unsigned char *data_region_end = UNINIT_PTR; +unsigned char *real_data_region_end = UNINIT_PTR; +unsigned long data_region_size = UNINIT_LONG; +unsigned long reserved_heap_size = UNINIT_LONG; + + +void mymemcpy(void *a, void *b ,int n) +{ + char *p=a; + char *q=b; + while(--n>=0) + { int c = q[0]; + q++; + p[0]=c; + p++; + } +} + +PIMAGE_SECTION_HEADER get_section_named(PIMAGE_NT_HEADERS nt_header,char *name); + +/* Dump out .data and .bss sections into a new executable. */ +void +unexec (char *new_name, char *old_name, void *start_data, void *start_bss, + void *entry_address) +{ + file_data in_file, out_file; + unsigned long size,header_size,file_size,i; + int last,foffset; + PIMAGE_DOS_HEADER old_dos_header,new_dos_header; + PIMAGE_NT_HEADERS old_nt_header,new_nt_header; + PIMAGE_SECTION_HEADER old_section, old_sptr,old_data_section; + PIMAGE_SECTION_HEADER new_section, new_sptr,new_data_section; + PIMAGE_SECTION_HEADER s; + long membase; + char *base; + + if (!get_allocation_unit()) + cache_system_info (); + if (!open_input_file (&in_file, old_name)) { + printf ("Failed to open %s (%d)...bailing.\n", + old_name, GetLastError ()); + exit (1); + } + + old_dos_header = (PIMAGE_DOS_HEADER) in_file.file_base; + if (old_dos_header->e_magic != IMAGE_DOS_SIGNATURE) + { + printf ("Unknown EXE header in %s...bailing.\n", in_file.name); + exit (1); + } + old_nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) old_dos_header) + + old_dos_header->e_lfanew); + if (old_nt_header == NULL) + { + printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", + in_file.name); + exit (1); + } + + /* Check the NT header signature ... */ + if (old_nt_header->Signature != IMAGE_NT_SIGNATURE) + { + printf ("Invalid IMAGE_NT_SIGNATURE 0x%x in %s...bailing.\n", + old_nt_header->Signature, in_file.name); + } + + /* Flip through the sections for .data and .bss ... */ + old_section = (PIMAGE_SECTION_HEADER) IMAGE_FIRST_SECTION (old_nt_header); + old_sptr= get_section_named(old_nt_header,".bss"); + old_data_section= get_section_named(old_nt_header,".data"); + header_size = old_section[0].PointerToRawData ; + + + base = alloca(header_size); + memcpy (base,in_file.file_base, header_size); + new_dos_header = (PIMAGE_DOS_HEADER) base; + new_nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) new_dos_header) + + new_dos_header->e_lfanew); + new_section = (PIMAGE_SECTION_HEADER) IMAGE_FIRST_SECTION (new_nt_header); + /* fix up the .bss section so that it is stored in file and + mark its characteristics to show load. + */ + if (old_sptr->Characteristics != old_data_section->Characteristics) + { + int j; + new_sptr= get_section_named(new_nt_header,".bss"); + new_data_section= get_section_named(new_nt_header,".data"); + new_sptr->Characteristics = old_data_section->Characteristics; + j = new_sptr - new_section; +#define S_ALIGN (1<<3) +#define ROUND_UP(x,n) (((((unsigned int)x)+(n)-1)/(n))*(n)) + new_sptr->PointerToRawData = new_sptr[1].PointerToRawData; + new_sptr->SizeOfRawData = ROUND_UP(new_sptr->Misc.VirtualSize,S_ALIGN); + foffset = new_sptr->SizeOfRawData; + + + + foffset = new_sptr->Misc.VirtualSize; + for(i= new_sptr-new_section+1; i < new_nt_header->FileHeader.NumberOfSections; i++) + {int tem ; + new_section[i].PointerToRawData += foffset; + tem = new_section[i].PointerToRawData + new_section[i].SizeOfRawData; + if (last < tem ) + last = tem; + } + } + + membase = old_nt_header->OptionalHeader.ImageBase; + /* if there is new data from sbrk + add it into .dataX section + */ + if (real_data_region_end - data_region_base) { + s = get_section_named(new_nt_header,".dataX"); + if (s ) { + s->SizeOfRawData = real_data_region_end - data_region_base; + } else { + /* tack in a new section */ + s = &new_section[new_nt_header->FileHeader.NumberOfSections]; + *s = *new_data_section; + strcpy(s->Name,".dataX"); + s->VirtualAddress = data_region_base - (unsigned char *)membase; + s->SizeOfRawData = real_data_region_end - data_region_base; + s->PointerToRawData = ROUND_UP(last,S_ALIGN) ; + new_nt_header->FileHeader.NumberOfSections += 1; + if ((char *)&s[1] -base > header_size) + { printf("unexpected fit"); + /* to do: we will have to recode moving all sections up + */ + exit(1); + } + } + + } + s = &new_section[new_nt_header->FileHeader.NumberOfSections-1]; + file_size = s->PointerToRawData + s->SizeOfRawData; + if (!open_output_file (&out_file, new_name, file_size)) + { + printf ("Failed to open %s (%d)...bailing.\n", + new_name, GetLastError ()); + exit (1); + } + for(i=0; i < file_size; i++) + out_file.file_base[i]='a'; + + + memcpy (out_file.file_base,base, header_size); + + for(i= 0; i < new_nt_header->FileHeader.NumberOfSections; i++) + { PIMAGE_SECTION_HEADER new,old; + new = &new_section[i]; + old = &old_section[i]; + if (new->Characteristics == old_data_section->Characteristics) + { mymemcpy(out_file.file_base + new->PointerToRawData, + (void *) (new->VirtualAddress + membase), + new->SizeOfRawData) + ; + } else if (new->SizeOfRawData) + { + memcpy(out_file.file_base + new->PointerToRawData, + in_file.file_base+ + old->PointerToRawData + ,new->SizeOfRawData); + + } + } + close_file_data (&in_file); + close_file_data (&out_file); +} + +PIMAGE_SECTION_HEADER +get_section_named(PIMAGE_NT_HEADERS nt_header,char *name) +{ + int i; + PIMAGE_SECTION_HEADER section, data_section; + section = (PIMAGE_SECTION_HEADER) IMAGE_FIRST_SECTION (nt_header); + for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) + { + if (strcmp(section[i].Name,name) == 0) + return §ion[i]; + } + return 0; +} + +int billy; +const char jim[]="before"; +char *jill = jim; +main(int argc,char *argv[]) +{ + printf("billy=%d,jill=%s",billy,jill); + if (billy == 0) { + billy=1; + jill = sbrk(101); + strcpy(jill,"hello"); + } + unexec(argv[1],argv[0],0,0,0); + return 0; +} + + + + + + + + +/* File handling. */ + + +int +open_input_file (file_data *p_file, char *filename) +{ + HANDLE file; + HANDLE file_mapping; + void *file_base; + unsigned long size, upper_size; + + file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if (file == INVALID_HANDLE_VALUE) + return FALSE; + + size = GetFileSize (file, &upper_size); + file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY, + 0, size, NULL); + if (!file_mapping) + return FALSE; + + file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size); + if (file_base == 0) + return FALSE; + + p_file->name = filename; + p_file->size = size; + p_file->file = file; + p_file->file_mapping = file_mapping; + p_file->file_base = file_base; + + return TRUE; +} + +int +open_output_file (file_data *p_file, char *filename, unsigned long size) +{ + HANDLE file; + HANDLE file_mapping; + void *file_base; + + file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL, + CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + if (file == INVALID_HANDLE_VALUE) + return FALSE; + + file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE, + 0, size, NULL); + if (!file_mapping) + return FALSE; + + file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size); + if (file_base == 0) + return FALSE; + + p_file->name = filename; + p_file->size = size; + p_file->file = file; + p_file->file_mapping = file_mapping; + p_file->file_base = file_base; + + return TRUE; +} + +/* Close the system structures associated with the given file. */ +void +close_file_data (file_data *p_file) +{ + UnmapViewOfFile (p_file->file_base); + CloseHandle (p_file->file_mapping); + CloseHandle (p_file->file); +} + + + + + +/* #include "lisp.h" */ /* for VALMASK */ +#define VALMASK -1 +/* try for 500 MB of address space */ +#define VALBITS 29 + +static char * +allocate_heap (void) +{ + /* The base address for our GNU malloc heap is chosen in conjuction + with the link settings for temacs.exe which control the stack size, + the initial default process heap size and the executable image base + address. The link settings and the malloc heap base below must all + correspond; the relationship between these values depends on how NT + and Win95 arrange the virtual address space for a process (and on + the size of the code and data segments in temacs.exe). + + The most important thing is to make base address for the executable + image high enough to leave enough room between it and the 4MB floor + of the process address space on Win95 for the primary thread stack, + the process default heap, and other assorted odds and ends + (eg. environment strings, private system dll memory etc) that are + allocated before temacs has a chance to grab its malloc arena. The + malloc heap base can then be set several MB higher than the + executable image base, leaving enough room for the code and data + segments. + + Because some parts of Emacs can use rather a lot of stack space + (for instance, the regular expression routines can potentially + allocate several MB of stack space) we allow 8MB for the stack. + + Allowing 1MB for the default process heap, and 1MB for odds and + ends, we can base the executable at 16MB and still have a generous + safety margin. At the moment, the executable has about 810KB of + code (for x86) and about 550KB of data - on RISC platforms the code + size could be roughly double, so if we allow 4MB for the executable + we will have plenty of room for expansion. + + Thus we would like to set the malloc heap base to 20MB. However, + Win95 refuses to allocate the heap starting at this address, so we + set the base to 27MB to make it happy. Since Emacs now leaves + 28 bits available for pointers, this lets us use the remainder of + the region below the 256MB line for our malloc arena - 229MB is + still a pretty decent arena to play in! */ + + unsigned long base = DBEGIN; /* 27MB */ + /* unsigned long base = 0x01B00000; */ /* 27MB */ + unsigned long end = 1 << VALBITS; /* 256MB */ + void *ptr = NULL; + +#define NTHEAP_PROBE_BASE 1 +#if NTHEAP_PROBE_BASE /* This is never normally defined */ + /* Try various addresses looking for one the kernel will let us have. */ + while (!ptr && (base < end)) + { + reserved_heap_size = end - base; + ptr = VirtualAlloc ((void *) base, + get_reserved_heap_size (), + MEM_RESERVE, + PAGE_NOACCESS); + base += 0x00100000; /* 1MB increment */ + } +#else + reserved_heap_size = end - base; + ptr = VirtualAlloc ((void *) base, + get_reserved_heap_size (), + MEM_RESERVE, + PAGE_NOACCESS); +#endif + + return ptr; +} + +/* This gives us the page size and the size of the allocation unit on NT. */ +SYSTEM_INFO sysinfo_cache; +unsigned long syspage_mask = 0; +int nt_major_version; +int nt_minor_version; +/* Distinguish between Windows NT and Windows 95. */ +int os_subtype; + +/* Cache information describing the NT system for later use. */ +void +cache_system_info (void) +{ + union + { + struct info + { + char major; + char minor; + short platform; + } info; + DWORD data; + } version; + + if (os_subtype) return; + + /* Cache the version of the operating system. */ + version.data = GetVersion (); + nt_major_version = version.info.major; + nt_minor_version = version.info.minor; + + if (version.info.platform & 0x8000) + os_subtype = OS_WIN95; + else + os_subtype = OS_NT; + + /* Cache page size, allocation unit, processor type, etc. */ + GetSystemInfo (&sysinfo_cache); + syspage_mask = sysinfo_cache.dwPageSize - 1; +} + + + +/* Emulate Unix sbrk. */ +void * +sbrk (unsigned long increment) +{ + void *result; + long size = (long) increment; + + cache_system_info(); + + /* Allocate our heap if we haven't done so already. */ + if (data_region_base == UNINIT_PTR) + { + data_region_base = allocate_heap (); + if (!data_region_base) + return NULL; + + /* Ensure that the addresses don't use the upper tag bits since + the Lisp type goes there. */ + if (((unsigned long) data_region_base & ~VALMASK) != 0) + { + printf ("Error: The heap was allocated in upper memory.\n"); + exit (1); + } + + data_region_end = data_region_base; + real_data_region_end = data_region_end; + data_region_size = get_reserved_heap_size (); + } + + result = data_region_end; + + /* If size is negative, shrink the heap by decommitting pages. */ + if (size < 0) + { + int new_size; + unsigned char *new_data_region_end; + + size = -size; + + /* Sanity checks. */ + if ((data_region_end - size) < data_region_base) + return NULL; + + /* We can only decommit full pages, so allow for + partial deallocation [cga]. */ + new_data_region_end = (data_region_end - size); + new_data_region_end = (unsigned char *) + ((long) (new_data_region_end + syspage_mask) & ~syspage_mask); + new_size = real_data_region_end - new_data_region_end; + real_data_region_end = new_data_region_end; + if (new_size > 0) + { + /* Decommit size bytes from the end of the heap. */ + if (!VirtualFree (real_data_region_end, new_size, MEM_DECOMMIT)) + return NULL; + } + + data_region_end -= size; + } + /* If size is positive, grow the heap by committing reserved pages. */ + else if (size > 0) + { + /* Sanity checks. */ + if ((data_region_end + size) > + (data_region_base + get_reserved_heap_size ())) + return NULL; + + /* Commit more of our heap. */ + if (VirtualAlloc (data_region_end, size, MEM_COMMIT, + PAGE_READWRITE) == NULL) + return NULL; + data_region_end += size; + + /* We really only commit full pages, so record where + the real end of committed memory is [cga]. */ + real_data_region_end = (unsigned char *) + ((long) (data_region_end + syspage_mask) & ~syspage_mask); + } + + return result; +} diff --git a/o/typespec.c b/o/typespec.c new file mode 100755 index 0000000..ab6d982 --- /dev/null +++ b/o/typespec.c @@ -0,0 +1,301 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + typespec.c + + type specifier routines +*/ + +#define NEED_MP_H +#include "include.h" + +object sLkeyword; + +enum type t_vtype; +int vtypep_fn(object x) {return type_of(x)==t_vtype;} + +LFD(Ltype_of)(void) +{ + int i; + + check_arg(1); + + switch (type_of(vs_base[0])) { + case t_fixnum: + vs_base[0] = sLfixnum; + break; + + case t_bignum: + vs_base[0] = sLbignum; + break; + + case t_ratio: + vs_base[0] = sLratio; + break; + + case t_shortfloat: + vs_base[0] = sLshort_float; + break; + + case t_longfloat: + vs_base[0] = sLlong_float; + break; + + case t_complex: + vs_base[0] = sLcomplex; + break; + + case t_character: + if (char_font(vs_base[0]) != 0 + || char_bits(vs_base[0]) != 0) + vs_base[0] = sLcharacter; + else { + i = char_code(vs_base[0]); + if ((' ' <= i && i < '\177') || i == '\n') + vs_base[0] = sLstandard_char; + else + vs_base[0] = sLcharacter; + } + break; + + case t_symbol: + if (vs_base[0]->s.s_hpack == keyword_package) + vs_base[0] = sLkeyword; + else + vs_base[0] = sLsymbol; + break; + + case t_package: + vs_base[0] = sLpackage; + break; + + case t_cons: + vs_base[0] = sLcons; + break; + + case t_hashtable: + vs_base[0] = sLhash_table; + break; + + case t_array: + if (vs_base[0]->a.a_adjustable || + vs_base[0]->a.a_displaced->c.c_car == Cnil) + vs_base[0] = sLarray; + else + vs_base[0] = sLsimple_array; + break; + + case t_vector: + if (vs_base[0]->v.v_adjustable || + vs_base[0]->v.v_hasfillp || + vs_base[0]->v.v_displaced->c.c_car == Cnil || + (enum aelttype)vs_base[0]->v.v_elttype != aet_object) + vs_base[0] = sLvector; + else + vs_base[0] = sLsimple_vector; + break; + + case t_string: + if (vs_base[0]->st.st_adjustable || + vs_base[0]->st.st_hasfillp || + vs_base[0]->st.st_displaced->c.c_car == Cnil) + vs_base[0] = sLstring; + else + vs_base[0] = sLsimple_string; + break; + + case t_bitvector: + if (vs_base[0]->bv.bv_adjustable || + vs_base[0]->bv.bv_hasfillp || + vs_base[0]->bv.bv_displaced->c.c_car == Cnil) + vs_base[0] = sLbit_vector; + else + vs_base[0] = sLsimple_bit_vector; + break; + + case t_structure: + + vs_base[0] = S_DATA(vs_base[0]->str.str_def)->name; + break; + + case t_stream: +#ifdef USER_DEFINED_STREAMS + if (vs_base[0]->sm.sm_mode == (int)smm_user_defined) + vs_base[0]= vs_base[0]->sm.sm_object1->str.str_self[8]; + else +#endif + vs_base[0] = sLstream; + break; + + case t_readtable: + vs_base[0] = sLreadtable; + break; + + case t_pathname: + vs_base[0] = sLpathname; + break; + + case t_random: + vs_base[0] = sLrandom_state; + break; + + case t_sfun: + case t_gfun: + case t_cfun: + case t_vfun: + case t_afun: + case t_cclosure: + case t_closure: + vs_base[0] = sLcompiled_function; + break; + + default: + error("not a lisp data object"); + } +} + +DEF_ORDINARY("PROCLAIMED-ARG-TYPES",sSproclaimed_arg_types,SI,""); +DEF_ORDINARY("PROCLAIMED-RETURN-TYPE",sSproclaimed_return_type,SI,""); +DEF_ORDINARY("PROCLAIMED-FUNCTION",sSproclaimed_function,SI,""); +DEF_ORDINARY("NULL",sLnull,LISP,""); +DEF_ORDINARY("CONS",sLcons,LISP,""); +DEF_ORDINARY("LIST",sLlist,LISP,""); +DEF_ORDINARY("SYMBOL",sLsymbol,LISP,""); +DEF_ORDINARY("ARRAY",sLarray,LISP,""); +DEF_ORDINARY("VECTOR",sLvector,LISP,""); +DEF_ORDINARY("BIT-VECTOR",sLbit_vector,LISP,""); +DEF_ORDINARY("STRING",sLstring,LISP,""); +DEF_ORDINARY("SEQUENCE",sLsequence,LISP,""); +DEF_ORDINARY("SIMPLE-ARRAY",sLsimple_array,LISP,""); +DEF_ORDINARY("SIMPLE-VECTOR",sLsimple_vector,LISP,""); +DEF_ORDINARY("SIMPLE-BIT-VECTOR",sLsimple_bit_vector,LISP,""); +DEF_ORDINARY("SIMPLE-STRING",sLsimple_string,LISP,""); +DEF_ORDINARY("FUNCTION",sLfunction,LISP,""); +DEF_ORDINARY("COMPILED-FUNCTION",sLcompiled_function,LISP,""); +DEF_ORDINARY("PATHNAME",sLpathname,LISP,""); +DEF_ORDINARY("CHARACTER",sLcharacter,LISP,""); +DEF_ORDINARY("NUMBER",sLnumber,LISP,""); +DEF_ORDINARY("RATIONAL",sLrational,LISP,""); +DEF_ORDINARY("FLOAT",sLfloat,LISP,""); +DEF_ORDINARY("REAL",sLreal,LISP,""); +DEF_ORDINARY("INTEGER",sLinteger,LISP,""); +DEF_ORDINARY("RATIO",sLratio,LISP,""); +DEF_ORDINARY("SHORT-FLOAT",sLshort_float,LISP,""); +DEF_ORDINARY("STANDARD-CHAR",sLstandard_char,LISP,""); +DEF_ORDINARY("BOOLEAN",sLboolean,LISP,""); +DEF_ORDINARY("FIXNUM",sLfixnum,LISP,""); +DEF_ORDINARY("COMPLEX",sLcomplex,LISP,""); +DEF_ORDINARY("SINGLE-FLOAT",sLsingle_float,LISP,""); +DEF_ORDINARY("PACKAGE",sLpackage,LISP,""); +DEF_ORDINARY("BIGNUM",sLbignum,LISP,""); +DEF_ORDINARY("RANDOM-STATE",sLrandom_state,LISP,""); +DEF_ORDINARY("DOUBLE-FLOAT",sLdouble_float,LISP,""); +DEF_ORDINARY("STREAM",sLstream,LISP,""); +DEF_ORDINARY("BIT",sLbit,LISP,""); +DEF_ORDINARY("READTABLE",sLreadtable,LISP,""); +DEF_ORDINARY("LONG-FLOAT",sLlong_float,LISP,""); +DEF_ORDINARY("HASH-TABLE",sLhash_table,LISP,""); +DEF_ORDINARY("KEYWORD",sLkeyword,LISP,""); +DEF_ORDINARY("STRUCTURE",sLstructure,LISP,""); +DEF_ORDINARY("SATISFIES",sLsatisfies,LISP,""); +DEF_ORDINARY("MEMBER",sLmember,LISP,""); +DEF_ORDINARY("NOT",sLnot,LISP,""); +DEF_ORDINARY("OR",sLor,LISP,""); +DEF_ORDINARY("AND",sLand,LISP,""); +DEF_ORDINARY("VALUES",sLvalues,LISP,""); +DEF_ORDINARY("MOD",sLmod,LISP,""); +DEF_ORDINARY("SIGNED-BYTE",sLsigned_byte,LISP,""); +DEF_ORDINARY("UNSIGNED-BYTE",sLunsigned_byte,LISP,""); +DEF_ORDINARY("SIGNED-CHAR",sSsigned_char,SI,""); +DEF_ORDINARY("UNSIGNED-CHAR",sSunsigned_char,SI,""); +DEF_ORDINARY("SIGNED-SHORT",sSsigned_short,SI,""); +DEF_ORDINARY("UNSIGNED-SHORT",sSunsigned_short,SI,""); +DEF_ORDINARY("*",sLA,LISP,""); +DEF_ORDINARY("PLUSP",sLplusp,LISP,""); + +DEF_ORDINARY("METHOD-COMBINATION",sLmethod_combination,LISP,""); +DEF_ORDINARY("BASE-CHAR",sLbase_char,LISP,""); +DEF_ORDINARY("BASE-STRING",sLbase_string,LISP,""); +DEF_ORDINARY("BROADCAST-STREAM",sLbroadcast_stream,LISP,""); +DEF_ORDINARY("BUILT-IN-CLASS",sLbuilt_in_class,LISP,""); +DEF_ORDINARY("CLASS",sLclass,LISP,""); +DEF_ORDINARY("CONCATENATED-STREAM",sLconcatenated_stream,LISP,""); +DEF_ORDINARY("ECHO-STREAM",sLecho_stream,LISP,""); +DEF_ORDINARY("EXTENDED-CHAR",sLextended_char,LISP,""); +DEF_ORDINARY("FILE-STREAM",sLfile_stream,LISP,""); +DEF_ORDINARY("GENERIC-FUNCTION",sLgeneric_function,LISP,""); +DEF_ORDINARY("LOGICAL-PATHNAME",sLlogical_pathname,LISP,""); +DEF_ORDINARY("METHOD",sLmethod,LISP,""); +/* FIXME -- need this for types in predlib.lsp, why can't we use the keyword sKpackage_error ? */ +DEF_ORDINARY("SIMPLE-BASE-STRING",sLsimple_base_string,LISP,""); +DEF_ORDINARY("STANDARD-CLASS",sLstandard_class,LISP,""); +DEF_ORDINARY("STANDARD-GENERIC-FUNCTION",sLstandard_generic_function,LISP,""); +DEF_ORDINARY("STANDARD-METHOD",sLstandard_method,LISP,""); +DEF_ORDINARY("STANDARD-OBJECT",sLstandard_object,LISP,""); +DEF_ORDINARY("STRING-STREAM",sLstring_stream,LISP,""); +DEF_ORDINARY("STRUCTURE-CLASS",sLstructure_class,LISP,""); +DEF_ORDINARY("STRUCTURE-OBJECT",sLstructure_object,LISP,""); +DEF_ORDINARY("SYNONYM-STREAM",sLsynonym_stream,LISP,""); +DEF_ORDINARY("TWO-WAY-STREAM",sLtwo_way_stream,LISP,""); + +DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character"); +DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer"); + +void +gcl_init_typespec(void) { +} + +void +gcl_init_typespec_function(void) { + + TSor_symbol_string=make_cons(sLor, make_cons(sLsymbol, make_cons(sLstring, Cnil))); + enter_mark_origin(&TSor_symbol_string); + + TSor_string_symbol=make_cons(sLor, make_cons(sLstring, make_cons(sLsymbol, Cnil))); + enter_mark_origin(&TSor_string_symbol); + + TSor_symbol_string_package=make_cons(sLor,make_cons(sLsymbol,make_cons(sLstring,make_cons(sLpackage, Cnil)))); + enter_mark_origin(&TSor_symbol_string_package); + + TSnon_negative_integer= make_cons(sLinteger,make_cons(make_fixnum(0), make_cons(sLA, Cnil))); + enter_mark_origin(&TSnon_negative_integer); + + TSpositive_number=make_cons(sLsatisfies, make_cons(sLplusp, Cnil)); + enter_mark_origin(&TSpositive_number); + + TSor_integer_float=make_cons(sLor, make_cons(sLinteger, make_cons(sLfloat, Cnil))); + enter_mark_origin(&TSor_integer_float); + + TSor_rational_float=make_cons(sLor, make_cons(sLrational, make_cons(sLfloat, Cnil))); + enter_mark_origin(&TSor_rational_float); + +#ifdef UNIX + TSor_pathname_string_symbol=make_cons(sLor,make_cons(sLpathname,make_cons(sLstring,make_cons(sLsymbol,Cnil)))); + enter_mark_origin(&TSor_pathname_string_symbol); +#endif + + TSor_pathname_string_symbol_stream=make_cons(sLor,make_cons(sLpathname,make_cons(sLstring,make_cons(sLsymbol,make_cons(sLstream,Cnil))))); + enter_mark_origin(&TSor_pathname_string_symbol_stream); + + make_function("TYPE-OF", Ltype_of); + +} diff --git a/o/u370_emul.s b/o/u370_emul.s new file mode 100755 index 0000000..45bab7e --- /dev/null +++ b/o/u370_emul.s @@ -0,0 +1,82 @@ + file_ tmp.c + entry $oVhc2_1r +$oVhc2_1r equ 0 + entry $oVO +$oVO equ 0 +L$$C0 csect + ds 0d +L00$TEXT equ * + entry _extended_mul +* -------------| extended_mul |-----------------------# + ds 0f + dc al2(0) arglength in words + dc xl2'FFFF' argument regs unknown + dc al4(LE$1-_extended_mul) code size + dc xl2'0000' no flags currently defined + dc al1(5) parmlength in words + dc al1(1) format +_extended_mul ds 0h +LX$011 equ * + using LX$011,12 + stm LR$1,15,x'10'+LV$1(13) + lr 12,13 + la 11,x'60' + slr 13,11 + st 12,4(,13) + lr 12,15 + lr 15,1 + mr 14,0 + alr 15,2 +# branch on carry + bc 3,Loverflow +# store the results +Lresult sldl 14,1(0) + srl 15,1(0) + l 1,x'B8'(,13) # lp + st 15,0(,1) + st 14,0(,3) + lm LR$1,14,x'70'+LV$1(13) + br 14 +Loverflow ah 14,LC$014 + b Lresult +LE$1 equ * +LR$1 equ 2 +LV$1 equ 0 +LC$014 equ * + dc xl2'0001' + end + entry _extended_div +* -------------| extended_div |-----------------------# + ds 0f + dc al2(0) arglength in words + dc xl2'FFFF' argument regs unknown + dc al4(LE$2-_extended_div) code size + dc xl2'0000' no flags currently defined + dc al1(5) parmlength in words + dc al1(1) format +_extended_div ds 0h +LX$021 equ * + using LX$021,12 + stm LR$2,15,x'10'+LV$2(13) + lr 12,13 + la 11,x'60' + slr 13,11 + st 12,4(,13) + lr 12,15 +* put h,l in 14,15 + lr 14,1 + lr 15,2 + sll 15,1 + srdl 14,1 + dr 14,0 +* store the quotient + st 15,0(,3) + l 1,x'B8'(,13) # rp +* store the remainder + st 14,0(,1) + lm LR$2,14,x'70'+LV$2(13) + br 14 +LE$2 equ * +LR$2 equ 2 +LV$2 equ 0 + end diff --git a/o/unexaix.c b/o/unexaix.c new file mode 100644 index 0000000..df1dad6 --- /dev/null +++ b/o/unexaix.c @@ -0,0 +1,936 @@ +/* Modified by Andrew.Vignaux@comp.vuw.ac.nz to get it to work :-) */ + +/* Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. + +In other words, you are welcome to use, share and improve this program. +You are forbidden to forbid anyone else to use, share and improve +what you give them. Help stamp out software-hoarding! */ + + +/* + * unexec.c - Convert a running program into an a.out file. + * + * Author: Spencer W. Thomas + * Computer Science Dept. + * University of Utah + * Date: Tue Mar 2 1982 + * Modified heavily since then. + * + * Updated for AIX 4.1.3 by Bill_Mann @ PraxisInt.com, Feb 1996 + * As of AIX 4.1, text, data, and bss are pre-relocated by the binder in + * such a way that the file can be mapped with code in one segment and + * data/bss in another segment, without reading or copying the file, by + * the AIX exec loader. Padding sections are omitted, nevertheless + * small amounts of 'padding' still occurs between sections in the file. + * As modified, this code handles both 3.2 and 4.1 conventions. + * + * Synopsis: + * unexec (new_name, a_name, data_start, bss_start, entry_address) + * char *new_name, *a_name; + * unsigned data_start, bss_start, entry_address; + * + * Takes a snapshot of the program and makes an a.out format file in the + * file named by the string argument new_name. + * If a_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing a_name file is required. + * + * The boundaries within the a.out file may be adjusted with the data_start + * and bss_start arguments. Either or both may be given as 0 for defaults. + * + * Data_start gives the boundary between the text segment and the data + * segment of the program. The text segment can contain shared, read-only + * program code and literal data, while the data segment is always unshared + * and unprotected. Data_start gives the lowest unprotected address. + * The value you specify may be rounded down to a suitable boundary + * as required by the machine you are using. + * + * Specifying zero for data_start means the boundary between text and data + * should not be the same as when the program was loaded. + * If NO_REMAP is defined, the argument data_start is ignored and the + * segment boundaries are never changed. + * + * Bss_start indicates how much of the data segment is to be saved in the + * a.out file and restored when the program is executed. It gives the lowest + * unsaved address, and is rounded up to a page boundary. The default when 0 + * is given assumes that the entire data segment is to be stored, including + * the previous data and bss as well as any additional storage allocated with + * break (2). + * + * The new file is set up to start at entry_address. + * + * If you make improvements I'd like to get them too. + * harpo!utah-cs!thomas, thomas@Utah-20 + * + */ + +/* There are several compilation parameters affecting unexec: + +* COFF + +Define this if your system uses COFF for executables. +Otherwise we assume you use Berkeley format. + +* NO_REMAP + +Define this if you do not want to try to save Emacs's pure data areas +as part of the text segment. + +Saving them as text is good because it allows users to share more. + +However, on machines that locate the text area far from the data area, +the boundary cannot feasibly be moved. Such machines require +NO_REMAP. + +Also, remapping can cause trouble with the built-in startup routine +/lib/crt0.o, which defines `environ' as an initialized variable. +Dumping `environ' as pure does not work! So, to use remapping, +you must write a startup routine for your machine in Emacs's crt0.c. +If NO_REMAP is defined, Emacs uses the system's crt0.o. + +* SECTION_ALIGNMENT + +Some machines that use COFF executables require that each section +start on a certain boundary *in the COFF file*. Such machines should +define SECTION_ALIGNMENT to a mask of the low-order bits that must be +zero on such a boundary. This mask is used to control padding between +segments in the COFF file. + +If SECTION_ALIGNMENT is not defined, the segments are written +consecutively with no attempt at alignment. This is right for +unmodified system V. + +* SEGMENT_MASK + +Some machines require that the beginnings and ends of segments +*in core* be on certain boundaries. For most machines, a page +boundary is sufficient. That is the default. When a larger +boundary is needed, define SEGMENT_MASK to a mask of +the bits that must be zero on such a boundary. + +* A_TEXT_OFFSET(HDR) + +Some machines count the a.out header as part of the size of the text +segment (a_text); they may actually load the header into core as the +first data in the text segment. Some have additional padding between +the header and the real text of the program that is counted in a_text. + +For these machines, define A_TEXT_OFFSET(HDR) to examine the header +structure HDR and return the number of bytes to add to `a_text' +before writing it (above and beyond the number of bytes of actual +program text). HDR's standard fields are already correct, except that +this adjustment to the `a_text' field has not yet been made; +thus, the amount of offset can depend on the data in the file. + +* A_TEXT_SEEK(HDR) + +If defined, this macro specifies the number of bytes to seek into the +a.out file before starting to write the text segment.a + +* EXEC_MAGIC + +For machines using COFF, this macro, if defined, is a value stored +into the magic number field of the output file. + +* ADJUST_EXEC_HEADER + +This macro can be used to generate statements to adjust or +initialize nonstandard fields in the file header + +* ADDR_CORRECT(ADDR) + +Macro to correct an int which is the bit pattern of a pointer to a byte +into an int which is the number of a byte. + +This macro has a default definition which is usually right. +This default definition is a no-op on most machines (where a +pointer looks like an int) but not on all machines. + +*/ + +#define XCOFF +#define COFF +#define NO_REMAP + +#ifndef emacs +#define PERROR(arg) perror (arg); return -1 +#else +#include "config.h" +#define PERROR(file) report_error (file, new) +#endif + +#include +/* Define getpagesize () if the system does not. + Note that this may depend on symbols defined in a.out.h + */ +#include "getpagesize.h" + +#ifndef makedev /* Try to detect types.h already loaded */ +#include +#endif +#include +#include +#include + +extern char *start_of_text (); /* Start of text */ +extern char *start_of_data (); /* Start of initialized data */ + +extern int _data; +extern int _edata; +extern int _text; +extern int _etext; +extern int _end; +#ifdef COFF +#ifndef USG +#ifndef STRIDE +#ifndef UMAX +#ifndef sun386 +/* I have a suspicion that these are turned off on all systems + and can be deleted. Try it in version 19. */ +#include +#include +#include +#include +#endif /* not sun386 */ +#endif /* not UMAX */ +#endif /* Not STRIDE */ +#endif /* not USG */ +static struct filehdr f_hdr; /* File header */ +static struct aouthdr f_ohdr; /* Optional file header (a.out) */ +long bias; /* Bias to add for growth */ +long lnnoptr; /* Pointer to line-number info within file */ + +static long text_scnptr; +static long data_scnptr; +#ifdef XCOFF +#define ALIGN(val, pwr) (((val) + ((1L<<(pwr))-1)) & ~((1L<<(pwr))-1)) +static long load_scnptr; +static long orig_load_scnptr; +static long orig_data_scnptr; +#endif +static ulong data_st; /* start of data area written out */ + +#ifndef MAX_SECTIONS +#define MAX_SECTIONS 10 +#endif + +#endif /* COFF */ + +static int pagemask; + +/* Correct an int which is the bit pattern of a pointer to a byte + into an int which is the number of a byte. + This is a no-op on ordinary machines, but not on all. */ + +#ifndef ADDR_CORRECT /* Let m-*.h files override this definition */ +#define ADDR_CORRECT(x) ((char *)(x) - (char*)0) +#endif + +#ifdef emacs +#include "lisp.h" + +static +report_error (file, fd) + char *file; + int fd; +{ + if (fd) + close (fd); + report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); +} +#endif /* emacs */ + +#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 +#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 +#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 + +static +report_error_1 (fd, msg, a1, a2) + int fd; + char *msg; + int a1, a2; +{ + close (fd); +#ifdef emacs + error (msg, a1, a2); +#else + fprintf (stderr, msg, a1, a2); + fprintf (stderr, "\n"); +#endif +} + +static int make_hdr (); +static int mark_x (); +static int copy_text_and_data (); +static int copy_sym (); + +/* **************************************************************** + * unexec + * + * driving logic. + */ +unexec (new_name, a_name, data_start, bss_start, entry_address) + char *new_name, *a_name; + unsigned data_start, bss_start, entry_address; +{ + int new, a_out = -1; + + if (a_name && (a_out = open (a_name, 0)) < 0) + { + PERROR (a_name); + } + if ((new = creat (new_name, 0666)) < 0) + { + PERROR (new_name); + } + if (make_hdr (new,a_out,data_start,bss_start,entry_address,a_name,new_name) < 0 + || copy_text_and_data (new) < 0 + || copy_sym (new, a_out, a_name, new_name) < 0 +#ifdef COFF + || adjust_lnnoptrs (new, a_out, new_name) < 0 +#endif +#ifdef XCOFF + || unrelocate_symbols (new, a_out, a_name, new_name) < 0 +#endif + ) + { + close (new); + return -1; + } + + close (new); + if (a_out >= 0) + close (a_out); + mark_x (new_name); + return 0; +} + +/* **************************************************************** + * make_hdr + * + * Make the header in the new a.out from the header in core. + * Modify the text and data sizes. + */ +static int +make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) + int new, a_out; + unsigned data_start, bss_start, entry_address; + char *a_name; + char *new_name; +{ + register int scns; + unsigned int bss_end; + + struct scnhdr section[MAX_SECTIONS]; + struct scnhdr * f_thdr; /* Text section header */ + struct scnhdr * f_dhdr; /* Data section header */ + struct scnhdr * f_bhdr; /* Bss section header */ + struct scnhdr * f_lhdr; /* Loader section header */ + struct scnhdr * f_tchdr; /* Typechk section header */ + struct scnhdr * f_dbhdr; /* Debug section header */ + struct scnhdr * f_xhdr; /* Except section header */ + + load_scnptr = orig_load_scnptr = lnnoptr = 0; + pagemask = getpagesize () - 1; + + /* Adjust text/data boundary. */ +#ifdef NO_REMAP + data_start = (long) start_of_data (); +#endif /* NO_REMAP */ + data_start = ADDR_CORRECT (data_start); + +#ifdef SEGMENT_MASK + data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */ +#else + data_start = data_start & ~pagemask; /* (Down) to page boundary. */ +#endif + + + bss_end = ADDR_CORRECT (sbrk (0)) + pagemask; + bss_end &= ~ pagemask; + /* Adjust data/bss boundary. */ + if (bss_start != 0) + { + bss_start = (ADDR_CORRECT (bss_start) + pagemask); + /* (Up) to page bdry. */ + bss_start &= ~ pagemask; + if (bss_start > bss_end) + { + ERROR1 ("unexec: Specified bss_start (%u) is past end of program", + bss_start); + } + } + else + bss_start = bss_end; + + if (data_start > bss_start) /* Can't have negative data size. */ + { + ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", + data_start, bss_start); + } + +#ifdef COFF + /* Salvage as much info from the existing file as possible */ + f_thdr = NULL; f_dhdr = NULL; f_bhdr = NULL; + f_lhdr = NULL; f_tchdr = NULL; f_dbhdr = NULL; f_xhdr = NULL; + if (a_out >= 0) + { + if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (a_name); + } + if (f_hdr.f_opthdr > 0) + { + if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (a_name); + } + } + if (f_hdr.f_nscns > MAX_SECTIONS) + { + ERROR0 ("unexec: too many section headers -- increase MAX_SECTIONS"); + } + /* Loop through section headers */ + for (scns = 0; scns < f_hdr.f_nscns; scns++) { + struct scnhdr *s = §ion[scns]; + if (read (a_out, s, sizeof (*s)) != sizeof (*s)) + { + PERROR (a_name); + } + +#define CHECK_SCNHDR(ptr, name, flags) \ + if (strcmp(s->s_name, name) == 0) { \ + if (s->s_flags != flags) { \ + fprintf(stderr, "unexec: %lx flags where %x expected in %s section.\n", \ + (unsigned long)s->s_flags, flags, name); \ + } \ + if (ptr) { \ + fprintf(stderr, "unexec: duplicate section header for section %s.\n", \ + name); \ + } \ + ptr = s; \ + } + CHECK_SCNHDR(f_thdr, _TEXT, STYP_TEXT); + CHECK_SCNHDR(f_dhdr, _DATA, STYP_DATA); + CHECK_SCNHDR(f_bhdr, _BSS, STYP_BSS); + CHECK_SCNHDR(f_lhdr, _LOADER, STYP_LOADER); + CHECK_SCNHDR(f_dbhdr, _DEBUG, STYP_DEBUG); + CHECK_SCNHDR(f_tchdr, _TYPCHK, STYP_TYPCHK); + CHECK_SCNHDR(f_xhdr, _EXCEPT, STYP_EXCEPT); + } + + if (f_thdr == 0) + { + ERROR1 ("unexec: couldn't find \"%s\" section", _TEXT); + } + if (f_dhdr == 0) + { + ERROR1 ("unexec: couldn't find \"%s\" section", _DATA); + } + if (f_bhdr == 0) + { + ERROR1 ("unexec: couldn't find \"%s\" section", _BSS); + } + } + else + { + ERROR0 ("can't build a COFF file from scratch yet"); + } + orig_data_scnptr = f_dhdr->s_scnptr; + orig_load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; + + /* Now we alter the contents of all the f_*hdr variables + to correspond to what we want to dump. */ + + /* Indicate that the reloc information is no longer valid for ld (bind); + we only update it enough to fake out the exec-time loader. */ + f_hdr.f_flags |= (F_RELFLG | F_EXEC); + +#ifdef EXEC_MAGIC + f_ohdr.magic = EXEC_MAGIC; +#endif +#ifndef NO_REMAP + f_ohdr.tsize = data_start - f_ohdr.text_start; + f_ohdr.text_start = (long) start_of_text (); +#endif + data_st = f_ohdr.data_start ? f_ohdr.data_start : (ulong) &_data; + f_ohdr.dsize = bss_start - data_st; + f_ohdr.bsize = bss_end - bss_start; + + f_dhdr->s_size = f_ohdr.dsize; + f_bhdr->s_size = f_ohdr.bsize; + f_bhdr->s_paddr = f_ohdr.data_start + f_ohdr.dsize; + f_bhdr->s_vaddr = f_ohdr.data_start + f_ohdr.dsize; + + /* fix scnptr's */ + { + ulong ptr = section[0].s_scnptr; + + bias = -1; + for (scns = 0; scns < f_hdr.f_nscns; scns++) + { + struct scnhdr *s = §ion[scns]; + + if (s->s_flags & STYP_PAD) /* .pad sections omitted in AIX 4.1 */ + { + /* + * the text_start should probably be o_algntext but that doesn't + * seem to change + */ + if (f_ohdr.text_start != 0) /* && scns != 0 */ + { + s->s_size = 512 - (ptr % 512); + if (s->s_size == 512) + s->s_size = 0; + } + s->s_scnptr = ptr; + } + else if (s->s_flags & STYP_DATA) + s->s_scnptr = ptr; + else if (!(s->s_flags & (STYP_TEXT | STYP_BSS))) + { + if (bias == -1) /* if first section after bss */ + bias = ptr - s->s_scnptr; + + s->s_scnptr += bias; + ptr = s->s_scnptr; + } + + ptr = ptr + s->s_size; + } + } + + /* fix other pointers */ + for (scns = 0; scns < f_hdr.f_nscns; scns++) + { + struct scnhdr *s = §ion[scns]; + + if (s->s_relptr != 0) + { + s->s_relptr += bias; + } + if (s->s_lnnoptr != 0) + { + if (lnnoptr == 0) lnnoptr = s->s_lnnoptr; + s->s_lnnoptr += bias; + } + } + + if (f_hdr.f_symptr > 0L) + { + f_hdr.f_symptr += bias; + } + + text_scnptr = f_thdr->s_scnptr; + data_scnptr = f_dhdr->s_scnptr; + load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; + +#ifdef ADJUST_EXEC_HEADER + ADJUST_EXEC_HEADER +#endif /* ADJUST_EXEC_HEADER */ + + if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (new_name); + } + + if (f_hdr.f_opthdr > 0) + { + if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (new_name); + } + } + + for (scns = 0; scns < f_hdr.f_nscns; scns++) { + struct scnhdr *s = §ion[scns]; + if (write (new, s, sizeof (*s)) != sizeof (*s)) + { + PERROR (new_name); + } + } + + return (0); + +#endif /* COFF */ +} + +/* **************************************************************** + + * + * Copy the text and data segments from memory to the new a.out + */ +static int +copy_text_and_data (new) + int new; +{ + register char *end; + register char *ptr; + + lseek (new, (long) text_scnptr, 0); + ptr = start_of_text () + text_scnptr; + end = ptr + f_ohdr.tsize; + write_segment (new, ptr, end); + + lseek (new, (long) data_scnptr, 0); + ptr = (char *) data_st; + end = ptr + f_ohdr.dsize; + write_segment (new, ptr, end); + + return 0; +} + +#define UnexBlockSz (1<<12) /* read/write block size */ +write_segment (new, ptr, end) + int new; + register char *ptr, *end; +{ + register int i, nwrite, ret; + char buf[80]; + extern int errno; + char zeros[UnexBlockSz]; + + for (i = 0; ptr < end;) + { + /* distance to next block. */ + nwrite = (((int) ptr + UnexBlockSz) & -UnexBlockSz) - (int) ptr; + /* But not beyond specified end. */ + if (nwrite > end - ptr) nwrite = end - ptr; + ret = write (new, ptr, nwrite); + /* If write gets a page fault, it means we reached + a gap between the old text segment and the old data segment. + This gap has probably been remapped into part of the text segment. + So write zeros for it. */ + if (ret == -1 && errno == EFAULT) + { + bzero (zeros, nwrite); + write (new, zeros, nwrite); + } + else if (nwrite != ret) + { + sprintf (buf, + "unexec write failure: addr 0x%lx, fileno %d, size 0x%x, wrote 0x%x, errno %d", + (unsigned long)ptr, new, nwrite, ret, errno); + PERROR (buf); + } + i += nwrite; + ptr += nwrite; + } +} + +/* **************************************************************** + * copy_sym + * + * Copy the relocation information and symbol table from the a.out to the new + */ +static int +copy_sym (new, a_out, a_name, new_name) + int new, a_out; + char *a_name, *new_name; +{ + char page[UnexBlockSz]; + int n; + + if (a_out < 0) + return 0; + + if (orig_load_scnptr == 0L) + return 0; + + if (lnnoptr && lnnoptr < orig_load_scnptr) /* if there is line number info */ + lseek (a_out, lnnoptr, 0); /* start copying from there */ + else + lseek (a_out, orig_load_scnptr, 0); /* Position a.out to symtab. */ + + while ((n = read (a_out, page, sizeof page)) > 0) + { + if (write (new, page, n) != n) + { + PERROR (new_name); + } + } + if (n < 0) + { + PERROR (a_name); + } + return 0; +} + +/* **************************************************************** + * mark_x + * + * After successfully building the new a.out, mark it executable + */ +static int +mark_x (name) + char *name; +{ + struct stat sbuf; + int um; + int new = 0; /* for PERROR */ + + um = umask (777); + umask (um); + if (stat (name, &sbuf) == -1) + { + PERROR (name); + } + sbuf.st_mode |= 0111 & ~um; + if (chmod (name, sbuf.st_mode) == -1) + PERROR (name); +} + +/* + * If the COFF file contains a symbol table and a line number section, + * then any auxiliary entries that have values for x_lnnoptr must + * be adjusted by the amount that the line number section has moved + * in the file (bias computed in make_hdr). The #@$%&* designers of + * the auxiliary entry structures used the absolute file offsets for + * the line number entry rather than an offset from the start of the + * line number section! + * + * When I figure out how to scan through the symbol table and pick out + * the auxiliary entries that need adjustment, this routine will + * be fixed. As it is now, all such entries are wrong and sdb + * will complain. Fred Fish, UniSoft Systems Inc. + * + * I believe this is now fixed correctly. Bill Mann + */ + +#ifdef COFF + +/* This function is probably very slow. Instead of reopening the new + file for input and output it should copy from the old to the new + using the two descriptors already open (WRITEDESC and READDESC). + Instead of reading one small structure at a time it should use + a reasonable size buffer. But I don't have time to work on such + things, so I am installing it as submitted to me. -- RMS. */ + +adjust_lnnoptrs (writedesc, readdesc, new_name) + int writedesc; + int readdesc; + char *new_name; +{ + register int nsyms; + register int naux; + register int new; +#ifdef amdahl_uts + SYMENT symentry; + AUXENT auxentry; +#else + struct syment symentry; + union auxent auxentry; +#endif + + if (!lnnoptr || !f_hdr.f_symptr) + return 0; + + if ((new = open (new_name, 2)) < 0) + { + PERROR (new_name); + return -1; + } + + lseek (new, f_hdr.f_symptr, 0); + for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) + { + read (new, &symentry, SYMESZ); + if (symentry.n_sclass == C_BINCL || symentry.n_sclass == C_EINCL) + { + symentry.n_value += bias; + lseek (new, -SYMESZ, 1); + write (new, &symentry, SYMESZ); + } + + for (naux = symentry.n_numaux; naux-- != 0; ) + { + read (new, &auxentry, AUXESZ); + nsyms++; + if (naux != 0 /* skip csect auxentry (last entry) */ + && (symentry.n_sclass == C_EXT || symentry.n_sclass == C_HIDEXT)) + { + auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; + lseek (new, -AUXESZ, 1); + write (new, &auxentry, AUXESZ); + } + } + } + close (new); +} + +#endif /* COFF */ + +#ifdef XCOFF + +/* It is probably a false economy to optimise this routine (it used to + read one LDREL and do do two lseeks per iteration) but the wrath of + RMS (see above :-) would be too much to bear */ + +unrelocate_symbols (new, a_out, a_name, new_name) + int new, a_out; + char *a_name, *new_name; +{ + register int i; + register int l; + register LDREL *ldrel; + LDHDR ldhdr; + LDREL ldrel_buf [20]; + ulong t_reloc = (ulong) &_text - f_ohdr.text_start; + ulong d_reloc = (ulong) &_data - ALIGN(f_ohdr.data_start, 2); + int * p; + + if (load_scnptr == 0) + return 0; + + lseek (a_out, orig_load_scnptr, 0); + if (read (a_out, &ldhdr, sizeof (ldhdr)) != sizeof (ldhdr)) + { + PERROR (new_name); + } + +#define SYMNDX_TEXT 0 +#define SYMNDX_DATA 1 +#define SYMNDX_BSS 2 + l = 0; + for (i = 0; i < ldhdr.l_nreloc; i++, l--, ldrel++) + { + if (l == 0) { + lseek (a_out, + orig_load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, + 0); + + l = ldhdr.l_nreloc - i; + if (l > sizeof (ldrel_buf) / LDRELSZ) + l = sizeof (ldrel_buf) / LDRELSZ; + + if (read (a_out, ldrel_buf, l * LDRELSZ) != l * LDRELSZ) + { + PERROR (a_name); + } + ldrel = ldrel_buf; + } + + /* move the BSS loader symbols to the DATA segment */ + if (ldrel->l_symndx == SYMNDX_BSS) + { + ldrel->l_symndx = SYMNDX_DATA; + + lseek (new, + load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, + 0); + + if (write (new, ldrel, LDRELSZ) != LDRELSZ) + { + PERROR (new_name); + } + } + + if (ldrel->l_rsecnm == f_ohdr.o_sndata) + { + int orig_int; + + lseek (a_out, + orig_data_scnptr + (ldrel->l_vaddr - f_ohdr.data_start), 0); + + if (read (a_out, (void *) &orig_int, sizeof (orig_int)) != sizeof (orig_int)) + { + PERROR (a_name); + } + + p = (int *) (ldrel->l_vaddr + d_reloc); + + switch (ldrel->l_symndx) { + case SYMNDX_TEXT: + orig_int = * p - t_reloc; + break; + + case SYMNDX_DATA: + case SYMNDX_BSS: + orig_int = * p - d_reloc; + break; + } + + if (orig_int != * p) + { + lseek (new, + data_scnptr + (ldrel->l_vaddr - f_ohdr.data_start), 0); + if (write (new, (void *) &orig_int, sizeof (orig_int)) + != sizeof (orig_int)) + { + PERROR (new_name); + } + } + } + } +} +#endif /* XCOFF */ +#include "save.c" + +#include +#define DATA_START DBEGIN +char * +start_of_data () +{ + char buf[500]; + struct ld_info * ld; + loadquery(L_GETINFO,buf,sizeof(buf)); + ld = (struct ld_info *)buf; + return ld->ldinfo_dataorg; + + + + +#ifdef DATA_START + return ((char *) DATA_START); +#else +#ifdef ORDINARY_LINK + /* + * This is a hack. Since we're not linking crt0.c or pre_crt0.c, + * data_start isn't defined. We take the address of environ, which + * is known to live at or near the start of the system crt0.c, and + * we don't sweat the handful of bytes that might lose. + */ + extern char **environ; + + return((char *) &environ); +#else + extern int data_start; + return ((char *) &data_start); +#endif /* ORDINARY_LINK */ +#endif /* DATA_START */ +} + + +#define TEXT_START 0x10000000 + +char *start_of_text () +{ +#ifdef TEXT_START + return ((char *) TEXT_START); +#else +#ifdef GOULD + extern csrt (); + return ((char *) csrt); +#else /* not GOULD */ + extern int _start (); + return ((char *) _start); +#endif /* GOULD */ +#endif /* TEXT_START */ +} + diff --git a/o/unexec-19.29.c b/o/unexec-19.29.c new file mode 100755 index 0000000..3390243 --- /dev/null +++ b/o/unexec-19.29.c @@ -0,0 +1,1197 @@ +/* Copyright (C) 1985,86,87,88,92,93,94 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + + +/* + * unexec.c - Convert a running program into an a.out file. + * + * Author: Spencer W. Thomas + * Computer Science Dept. + * University of Utah + * Date: Tue Mar 2 1982 + * Modified heavily since then. + * + * Synopsis: + * unexec (new_name, a_name, data_start, bss_start, entry_address) + * char *new_name, *a_name; + * unsigned data_start, bss_start, entry_address; + * + * Takes a snapshot of the program and makes an a.out format file in the + * file named by the string argument new_name. + * If a_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing a_name file is required. + * + * The boundaries within the a.out file may be adjusted with the data_start + * and bss_start arguments. Either or both may be given as 0 for defaults. + * + * Data_start gives the boundary between the text segment and the data + * segment of the program. The text segment can contain shared, read-only + * program code and literal data, while the data segment is always unshared + * and unprotected. Data_start gives the lowest unprotected address. + * The value you specify may be rounded down to a suitable boundary + * as required by the machine you are using. + * + * Specifying zero for data_start means the boundary between text and data + * should not be the same as when the program was loaded. + * If NO_REMAP is defined, the argument data_start is ignored and the + * segment boundaries are never changed. + * + * Bss_start indicates how much of the data segment is to be saved in the + * a.out file and restored when the program is executed. It gives the lowest + * unsaved address, and is rounded up to a page boundary. The default when 0 + * is given assumes that the entire data segment is to be stored, including + * the previous data and bss as well as any additional storage allocated with + * break (2). + * + * The new file is set up to start at entry_address. + * + * If you make improvements I'd like to get them too. + * harpo!utah-cs!thomas, thomas@Utah-20 + * + */ + +/* Modified to support SysVr3 shared libraries by James Van Artsdalen + * of Dell Computer Corporation. james@bigtex.cactus.org. + */ + +/* There are several compilation parameters affecting unexec: + +* COFF + +Define this if your system uses COFF for executables. + +* COFF_ENCAPSULATE + +Define this if you are using the GNU coff encapsulated a.out format. +This is closer to a.out than COFF. You should *not* define COFF if +you define COFF_ENCAPSULATE + +Otherwise we assume you use Berkeley format. + +* NO_REMAP + +Define this if you do not want to try to save Emacs's pure data areas +as part of the text segment. + +Saving them as text is good because it allows users to share more. + +However, on machines that locate the text area far from the data area, +the boundary cannot feasibly be moved. Such machines require +NO_REMAP. + +Also, remapping can cause trouble with the built-in startup routine +/lib/crt0.o, which defines `environ' as an initialized variable. +Dumping `environ' as pure does not work! So, to use remapping, +you must write a startup routine for your machine in Emacs's crt0.c. +If NO_REMAP is defined, Emacs uses the system's crt0.o. + +* SECTION_ALIGNMENT + +Some machines that use COFF executables require that each section +start on a certain boundary *in the COFF file*. Such machines should +define SECTION_ALIGNMENT to a mask of the low-order bits that must be +zero on such a boundary. This mask is used to control padding between +segments in the COFF file. + +If SECTION_ALIGNMENT is not defined, the segments are written +consecutively with no attempt at alignment. This is right for +unmodified system V. + +* SEGMENT_MASK + +Some machines require that the beginnings and ends of segments +*in core* be on certain boundaries. For most machines, a page +boundary is sufficient. That is the default. When a larger +boundary is needed, define SEGMENT_MASK to a mask of +the bits that must be zero on such a boundary. + +* A_TEXT_OFFSET(HDR) + +Some machines count the a.out header as part of the size of the text +segment (a_text); they may actually load the header into core as the +first data in the text segment. Some have additional padding between +the header and the real text of the program that is counted in a_text. + +For these machines, define A_TEXT_OFFSET(HDR) to examine the header +structure HDR and return the number of bytes to add to `a_text' +before writing it (above and beyond the number of bytes of actual +program text). HDR's standard fields are already correct, except that +this adjustment to the `a_text' field has not yet been made; +thus, the amount of offset can depend on the data in the file. + +* A_TEXT_SEEK(HDR) + +If defined, this macro specifies the number of bytes to seek into the +a.out file before starting to write the text segment. + +* EXEC_MAGIC + +For machines using COFF, this macro, if defined, is a value stored +into the magic number field of the output file. + +* ADJUST_EXEC_HEADER + +This macro can be used to generate statements to adjust or +initialize nonstandard fields in the file header + +* ADDR_CORRECT(ADDR) + +Macro to correct an int which is the bit pattern of a pointer to a byte +into an int which is the number of a byte. + +This macro has a default definition which is usually right. +This default definition is a no-op on most machines (where a +pointer looks like an int) but not on all machines. + +*/ + +#ifndef emacs +#define PERROR(arg) perror (arg); return -1 +#else +#define IN_UNEXEC +#include "config.h" +#define PERROR(file) report_error (file, new) +#endif + +#ifndef CANNOT_DUMP /* all rest of file! */ + +#ifdef COFF_ENCAPSULATE +int need_coff_header = 1; +#include /* The location might be a poor assumption */ +#else +#ifdef MSDOS +#include +#define filehdr external_filehdr +#define scnhdr external_scnhdr +#define syment external_syment +#define auxent external_auxent +#define n_numaux e_numaux +#define n_type e_type +struct aouthdr +{ + unsigned short magic; /* type of file */ + unsigned short vstamp; /* version stamp */ + unsigned long tsize; /* text size in bytes, padded to FW bdry*/ + unsigned long dsize; /* initialized data " " */ + unsigned long bsize; /* uninitialized data " " */ + unsigned long entry; /* entry pt. */ + unsigned long text_start;/* base of text used for this file */ + unsigned long data_start;/* base of data used for this file */ +}; + + +#else /* not MSDOS */ +#include +#endif /* not MSDOS */ +#endif + +/* Define getpagesize if the system does not. + Note that this may depend on symbols defined in a.out.h. */ +#include "getpagesize.h" + +#ifndef makedev /* Try to detect types.h already loaded */ +#include +#endif /* makedev */ +#include +#include +#include + +#include /* Must be after sys/types.h for USG and BSD4_1*/ + +#ifdef USG5 +#include +#endif + +#ifndef O_RDONLY +#define O_RDONLY 0 +#endif +#ifndef O_RDWR +#define O_RDWR 2 +#endif + +#ifdef UNIXSAVE +extern char etext; +#endif + +#ifndef start_of_data +extern char *start_of_text (); /* Start of text */ +extern char *start_of_data (); /* Start of initialized data */ +#endif + +#ifdef COFF +static long block_copy_start; /* Old executable start point */ +static struct filehdr f_hdr; /* File header */ +static struct aouthdr f_ohdr; /* Optional file header (a.out) */ +long bias; /* Bias to add for growth */ +long lnnoptr; /* Pointer to line-number info within file */ +#define SYMS_START block_copy_start + +static long text_scnptr; +static long data_scnptr; + +#else /* not COFF */ + +#ifdef HPUX +extern void *sbrk (); +#else +#if 0 +/* Some systems with __STDC__ compilers still declare this `char *' in some + header file, and our declaration conflicts. The return value is always + cast, so it should be harmless to leave it undefined. Hopefully + machines with different size pointers and ints declare sbrk in a header + file. */ +#ifdef __STDC__ +extern void *sbrk (); +#else +extern char *sbrk (); +#endif /* __STDC__ */ +#endif +#endif /* HPUX */ + +#define SYMS_START ((long) N_SYMOFF (ohdr)) + +/* Some machines override the structure name for an a.out header. */ +#ifndef EXEC_HDR_TYPE +#define EXEC_HDR_TYPE struct exec +#endif + +#ifdef HPUX +#ifdef HP9000S200_ID +#define MY_ID HP9000S200_ID +#else +#include +#define MY_ID MYSYS +#endif /* no HP9000S200_ID */ +static MAGIC OLDMAGIC = {MY_ID, SHARE_MAGIC}; +static MAGIC NEWMAGIC = {MY_ID, DEMAND_MAGIC}; +#define N_TXTOFF(x) TEXT_OFFSET(x) +#define N_SYMOFF(x) LESYM_OFFSET(x) +static EXEC_HDR_TYPE hdr, ohdr; + +#else /* not HPUX */ + +#if defined (USG) && !defined (IBMAIX) && !defined (IRIS) && !defined (COFF_ENCAPSULATE) && !defined (LINUX) +static struct bhdr hdr, ohdr; +#define a_magic fmagic +#define a_text tsize +#define a_data dsize +#define a_bss bsize +#define a_syms ssize +#define a_trsize rtsize +#define a_drsize rdsize +#define a_entry entry +#define N_BADMAG(x) \ + (((x).fmagic)!=OMAGIC && ((x).fmagic)!=NMAGIC &&\ + ((x).fmagic)!=FMAGIC && ((x).fmagic)!=IMAGIC) +#define NEWMAGIC FMAGIC +#else /* IRIS or IBMAIX or not USG */ +static EXEC_HDR_TYPE hdr, ohdr; +#define NEWMAGIC ZMAGIC +#endif /* IRIS or IBMAIX not USG */ +#endif /* not HPUX */ + +static int unexec_text_start; +static int unexec_data_start; + +#ifdef COFF_ENCAPSULATE +/* coffheader is defined in the GNU a.out.encap.h file. */ +struct coffheader coffheader; +#endif + +#endif /* not COFF */ + +static int pagemask; + +/* Correct an int which is the bit pattern of a pointer to a byte + into an int which is the number of a byte. + This is a no-op on ordinary machines, but not on all. */ + +#ifndef ADDR_CORRECT /* Let m-*.h files override this definition */ +#define ADDR_CORRECT(x) ((char *)(x) - (char*)0) +#endif + +#ifdef emacs + +#include "lisp.h" + +static +report_error (file, fd) + char *file; + int fd; +{ + if (fd) + close (fd); + report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); +} +#endif /* emacs */ + +#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 +#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 +#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 + +static +report_error_1 (int fd, char *msg, int a1, int a2) +{ + close (fd); +#ifdef emacs + error (msg, a1, a2); +#else + fprintf (stderr, msg, a1, a2); + fprintf (stderr, "\n"); +#endif +} + +static int make_hdr (int new, int a_out, unsigned int data_start, unsigned int bss_start, unsigned int entry_address, char *a_name, char *new_name); +static int copy_text_and_data (int new, int a_out); +static int copy_sym (int new, int a_out, char *a_name, char *new_name); +static void mark_x (char *name); + +/* **************************************************************** + * unexec + * + * driving logic. + */ +unexec (char *new_name, char *a_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address) +{ + int new, a_out = -1; + + if (a_name && (a_out = open (a_name, O_RDONLY)) < 0) + { + PERROR (a_name); + } + if ((new = creat (new_name, 0666)) < 0) + { + PERROR (new_name); + } + + if (make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) < 0 + || copy_text_and_data (new, a_out) < 0 + || copy_sym (new, a_out, a_name, new_name) < 0 +#ifdef COFF +#ifndef COFF_BSD_SYMBOLS + || adjust_lnnoptrs (new, a_out, new_name) < 0 +#endif +#endif + ) + { + close (new); + /* unlink (new_name); /* Failed, unlink new a.out */ + return -1; + } + + close (new); + if (a_out >= 0) + close (a_out); + mark_x (new_name); + return 0; +} + +/* **************************************************************** + * make_hdr + * + * Make the header in the new a.out from the header in core. + * Modify the text and data sizes. + */ +static int +make_hdr (int new, int a_out, unsigned int data_start, unsigned int bss_start, unsigned int entry_address, char *a_name, char *new_name) +{ + int tem; +#ifdef COFF + auto struct scnhdr f_thdr; /* Text section header */ + auto struct scnhdr f_dhdr; /* Data section header */ + auto struct scnhdr f_bhdr; /* Bss section header */ + auto struct scnhdr scntemp; /* Temporary section header */ + register int scns; +#endif /* COFF */ +#ifdef USG_SHARED_LIBRARIES + extern unsigned int bss_end; +#else + unsigned int bss_end; +#endif + + pagemask = getpagesize () - 1; + + /* Adjust text/data boundary. */ +#ifdef NO_REMAP + data_start = (int) start_of_data (); +#else /* not NO_REMAP */ + if (!data_start) + data_start = (int) start_of_data (); +#endif /* not NO_REMAP */ + data_start = ADDR_CORRECT (data_start); + +#ifdef SEGMENT_MASK + data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */ +#else + data_start = data_start & ~pagemask; /* (Down) to page boundary. */ +#endif + + bss_end = ADDR_CORRECT (sbrk (0)) + pagemask; + bss_end &= ~ pagemask; + + /* Adjust data/bss boundary. */ + if (bss_start != 0) + { + bss_start = (ADDR_CORRECT (bss_start) + pagemask); + /* (Up) to page bdry. */ + bss_start &= ~ pagemask; + if (bss_start > bss_end) + { + ERROR1 ("unexec: Specified bss_start (%u) is past end of program", + bss_start); + } + } + else + bss_start = bss_end; + + if (data_start > bss_start) /* Can't have negative data size. */ + { + ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", + data_start, bss_start); + } + +#ifdef COFF + /* Salvage as much info from the existing file as possible */ + if (a_out >= 0) + { + if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (a_name); + } + block_copy_start += sizeof (f_hdr); + if (f_hdr.f_opthdr > 0) + { + if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (a_name); + } + block_copy_start += sizeof (f_ohdr); + } + /* Loop through section headers, copying them in */ + lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 0); + for (scns = f_hdr.f_nscns; scns > 0; scns--) { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + { + PERROR (a_name); + } + if (scntemp.s_scnptr > 0L) + { + if (block_copy_start < scntemp.s_scnptr + scntemp.s_size) + block_copy_start = scntemp.s_scnptr + scntemp.s_size; + } + if (strcmp (scntemp.s_name, ".text") == 0) + { + f_thdr = scntemp; + } + else if (strcmp (scntemp.s_name, ".data") == 0) + { + f_dhdr = scntemp; + } + else if (strcmp (scntemp.s_name, ".bss") == 0) + { + f_bhdr = scntemp; + } + } + } + else + { + ERROR0 ("can't build a COFF file from scratch yet"); + } + + /* Now we alter the contents of all the f_*hdr variables + to correspond to what we want to dump. */ + +#ifdef USG_SHARED_LIBRARIES + + /* The amount of data we're adding to the file is distance from the + * end of the original .data space to the current end of the .data + * space. + */ + + bias = bss_start - (f_ohdr.data_start + f_dhdr.s_size); + +#endif + + f_hdr.f_flags |= (F_RELFLG | F_EXEC); +#ifdef TPIX + f_hdr.f_nscns = 3; +#endif +#ifdef EXEC_MAGIC + f_ohdr.magic = EXEC_MAGIC; +#endif +#ifndef NO_REMAP + f_ohdr.text_start = (long) start_of_text (); + f_ohdr.tsize = data_start - f_ohdr.text_start; + f_ohdr.data_start = data_start; +#endif /* NO_REMAP */ + f_ohdr.dsize = bss_start - f_ohdr.data_start; + f_ohdr.bsize = bss_end - bss_start; +#ifndef KEEP_OLD_TEXT_SCNPTR + /* On some machines, the old values are right. + ??? Maybe on all machines with NO_REMAP. */ + f_thdr.s_size = f_ohdr.tsize; + f_thdr.s_scnptr = sizeof (f_hdr) + sizeof (f_ohdr); + f_thdr.s_scnptr += (f_hdr.f_nscns) * (sizeof (f_thdr)); +#endif /* KEEP_OLD_TEXT_SCNPTR */ +#ifdef ADJUST_TEXT_SCNHDR_SIZE + /* On some machines, `text size' includes all headers. */ + f_thdr.s_size -= f_thdr.s_scnptr; +#endif /* ADJUST_TEST_SCNHDR_SIZE */ + lnnoptr = f_thdr.s_lnnoptr; +#ifdef SECTION_ALIGNMENT + /* Some systems require special alignment + of the sections in the file itself. */ + f_thdr.s_scnptr + = (f_thdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; +#endif /* SECTION_ALIGNMENT */ +#ifdef TPIX + f_thdr.s_scnptr = 0xd0; +#endif + text_scnptr = f_thdr.s_scnptr; +#ifdef ADJUST_TEXTBASE + text_scnptr = sizeof (f_hdr) + sizeof (f_ohdr) + (f_hdr.f_nscns) * (sizeof (f_thdr)); +#endif +#ifndef KEEP_OLD_PADDR + f_dhdr.s_paddr = f_ohdr.data_start; +#endif /* KEEP_OLD_PADDR */ + f_dhdr.s_vaddr = f_ohdr.data_start; + f_dhdr.s_size = f_ohdr.dsize; + f_dhdr.s_scnptr = f_thdr.s_scnptr + f_thdr.s_size; +#ifdef SECTION_ALIGNMENT + /* Some systems require special alignment + of the sections in the file itself. */ + f_dhdr.s_scnptr + = (f_dhdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; +#endif /* SECTION_ALIGNMENT */ +#ifdef DATA_SECTION_ALIGNMENT + /* Some systems require special alignment + of the data section only. */ + f_dhdr.s_scnptr + = (f_dhdr.s_scnptr + DATA_SECTION_ALIGNMENT) & ~DATA_SECTION_ALIGNMENT; +#endif /* DATA_SECTION_ALIGNMENT */ + data_scnptr = f_dhdr.s_scnptr; +#ifndef KEEP_OLD_PADDR + f_bhdr.s_paddr = f_ohdr.data_start + f_ohdr.dsize; +#endif /* KEEP_OLD_PADDR */ + f_bhdr.s_vaddr = f_ohdr.data_start + f_ohdr.dsize; + f_bhdr.s_size = f_ohdr.bsize; + f_bhdr.s_scnptr = 0L; +#ifndef USG_SHARED_LIBRARIES + bias = f_dhdr.s_scnptr + f_dhdr.s_size - block_copy_start; +#endif + + if (f_hdr.f_symptr > 0L) + { + f_hdr.f_symptr += bias; + } + + if (f_thdr.s_lnnoptr > 0L) + { + f_thdr.s_lnnoptr += bias; + } + +#ifdef ADJUST_EXEC_HEADER + ADJUST_EXEC_HEADER; +#endif /* ADJUST_EXEC_HEADER */ + + if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (new_name); + } + + if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (new_name); + } + +#ifndef USG_SHARED_LIBRARIES + + if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) + { + PERROR (new_name); + } + + if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) + { + PERROR (new_name); + } + + if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) + { + PERROR (new_name); + } + +#else /* USG_SHARED_LIBRARIES */ + + /* The purpose of this code is to write out the new file's section + * header table. + * + * Scan through the original file's sections. If the encountered + * section is one we know (.text, .data or .bss), write out the + * correct header. If it is a section we do not know (such as + * .lib), adjust the address of where the section data is in the + * file, and write out the header. + * + * If any section precedes .text or .data in the file, this code + * will not adjust the file pointer for that section correctly. + */ + + /* This used to use sizeof (f_ohdr) instead of .f_opthdr. + .f_opthdr is said to be right when there is no optional header. */ + lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 0); + + for (scns = f_hdr.f_nscns; scns > 0; scns--) + { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR (a_name); + + if (!strcmp (scntemp.s_name, f_thdr.s_name)) /* .text */ + { + if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) + PERROR (new_name); + } + else if (!strcmp (scntemp.s_name, f_dhdr.s_name)) /* .data */ + { + if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) + PERROR (new_name); + } + else if (!strcmp (scntemp.s_name, f_bhdr.s_name)) /* .bss */ + { + if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) + PERROR (new_name); + } + else + { + if (scntemp.s_scnptr) + scntemp.s_scnptr += bias; + if (write (new, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR (new_name); + } + } +#endif /* USG_SHARED_LIBRARIES */ + + return (0); + +#else /* if not COFF */ + + /* Get symbol table info from header of a.out file if given one. */ + if (a_out >= 0) + { +#ifdef COFF_ENCAPSULATE + if (read (a_out, &coffheader, sizeof coffheader) != sizeof coffheader) + { + PERROR(a_name); + } + if (coffheader.f_magic != COFF_MAGIC) + { + ERROR1("%s doesn't have legal coff magic number\n", a_name); + } +#endif + if (read (a_out, &ohdr, sizeof hdr) != sizeof hdr) + { + PERROR (a_name); + } + + if (N_BADMAG (ohdr)) + { + ERROR1 ("invalid magic number in %s", a_name); + } + hdr = ohdr; + } + else + { +#ifdef COFF_ENCAPSULATE + /* We probably could without too much trouble. The code is in gld + * but I don't have that much time or incentive. + */ + ERROR0 ("can't build a COFF file from scratch yet"); +#else +#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ + bzero ((void *)&hdr, sizeof hdr); +#else + bzero (&hdr, sizeof hdr); +#endif +#endif + } + + unexec_text_start = (long) start_of_text (); + unexec_data_start = data_start; + + /* Machine-dependent fixup for header, or maybe for unexec_text_start */ +#ifdef ADJUST_EXEC_HEADER + ADJUST_EXEC_HEADER; +#endif /* ADJUST_EXEC_HEADER */ + + hdr.a_trsize = 0; + hdr.a_drsize = 0; + if (entry_address != 0) + hdr.a_entry = entry_address; + + hdr.a_bss = bss_end - bss_start; + hdr.a_data = bss_start - data_start; +#ifdef NO_REMAP + hdr.a_text = ohdr.a_text; +#else /* not NO_REMAP */ + hdr.a_text = data_start - unexec_text_start; + +#ifdef A_TEXT_OFFSET + hdr.a_text += A_TEXT_OFFSET (ohdr); +#endif + +#endif /* not NO_REMAP */ + +#ifdef COFF_ENCAPSULATE + /* We are encapsulating BSD format within COFF format. */ + { + struct coffscn *tp, *dp, *bp; + tp = &coffheader.scns[0]; + dp = &coffheader.scns[1]; + bp = &coffheader.scns[2]; + tp->s_size = hdr.a_text + sizeof(struct exec); + dp->s_paddr = data_start; + dp->s_vaddr = data_start; + dp->s_size = hdr.a_data; + bp->s_paddr = dp->s_vaddr + dp->s_size; + bp->s_vaddr = bp->s_paddr; + bp->s_size = hdr.a_bss; + coffheader.tsize = tp->s_size; + coffheader.dsize = dp->s_size; + coffheader.bsize = bp->s_size; + coffheader.text_start = tp->s_vaddr; + coffheader.data_start = dp->s_vaddr; + } + if (write (new, &coffheader, sizeof coffheader) != sizeof coffheader) + { + PERROR(new_name); + } +#endif /* COFF_ENCAPSULATE */ + + if (write (new, &hdr, sizeof hdr) != sizeof hdr) + { + PERROR (new_name); + } + +#if 0 /* This #ifndef caused a bug on Linux when using QMAGIC. */ + /* This adjustment was done above only #ifndef NO_REMAP, + so only undo it now #ifndef NO_REMAP. */ + /* #ifndef NO_REMAP */ +#endif +#ifdef A_TEXT_OFFSET + hdr.a_text -= A_TEXT_OFFSET (ohdr); +#endif + + return 0; + +#endif /* not COFF */ +} + +/* **************************************************************** + * copy_text_and_data + * + * Copy the text and data segments from memory to the new a.out + */ +static int +copy_text_and_data (int new, int a_out) +{ + register char *end; + register char *ptr; + +#ifdef COFF + +#ifdef USG_SHARED_LIBRARIES + + int scns; + struct scnhdr scntemp; /* Temporary section header */ + + /* The purpose of this code is to write out the new file's section + * contents. + * + * Step through the section table. If we know the section (.text, + * .data) do the appropriate thing. Otherwise, if the section has + * no allocated space in the file (.bss), do nothing. Otherwise, + * the section has space allocated in the file, and is not a section + * we know. So just copy it. + */ + + lseek (a_out, sizeof (struct filehdr) + sizeof (struct aouthdr), 0); + + for (scns = f_hdr.f_nscns; scns > 0; scns--) + { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR ("temacs"); + + if (!strcmp (scntemp.s_name, ".text")) + { + lseek (new, (long) text_scnptr, 0); + ptr = (char *) f_ohdr.text_start; + end = ptr + f_ohdr.tsize; + write_segment (new, ptr, end); + } + else if (!strcmp (scntemp.s_name, ".data")) + { + lseek (new, (long) data_scnptr, 0); + ptr = (char *) f_ohdr.data_start; + end = ptr + f_ohdr.dsize; + write_segment (new, ptr, end); + } + else if (!scntemp.s_scnptr) + ; /* do nothing - no data for this section */ + else + { + char page[BUFSIZ]; + int size, n; + long old_a_out_ptr = lseek (a_out, 0, 1); + + lseek (a_out, scntemp.s_scnptr, 0); + for (size = scntemp.s_size; size > 0; size -= sizeof (page)) + { + n = size > sizeof (page) ? sizeof (page) : size; + if (read (a_out, page, n) != n || write (new, page, n) != n) + PERROR ("emacs"); + } + lseek (a_out, old_a_out_ptr, 0); + } + } + +#else /* COFF, but not USG_SHARED_LIBRARIES */ + + lseek (new, (long) text_scnptr, 0); + ptr = (char *) f_ohdr.text_start; +#ifdef HEADER_INCL_IN_TEXT + /* For Gould UTX/32, text starts after headers */ + ptr = (char *) (ptr + text_scnptr); +#endif /* HEADER_INCL_IN_TEXT */ + end = ptr + f_ohdr.tsize; + write_segment (new, ptr, end); + + lseek (new, (long) data_scnptr, 0); + ptr = (char *) f_ohdr.data_start; + end = ptr + f_ohdr.dsize; + write_segment (new, ptr, end); + +#endif /* USG_SHARED_LIBRARIES */ + +#else /* if not COFF */ + +/* Some machines count the header as part of the text segment. + That is to say, the header appears in core + just before the address that start_of_text returns. + For them, N_TXTOFF is the place where the header goes. + We must adjust the seek to the place after the header. + Note that at this point hdr.a_text does *not* count + the extra A_TEXT_OFFSET bytes, only the actual bytes of code. */ + +#ifdef A_TEXT_SEEK + lseek (new, (long) A_TEXT_SEEK (hdr), 0); +#else + lseek (new, (long) N_TXTOFF (hdr), 0); +#endif /* no A_TEXT_SEEK */ + +#ifdef RISCiX + + /* Acorn's RISC-iX has a wacky way of initialising the position of the heap. + * There is a little table in crt0.o that is filled at link time with + * the min and current brk positions, among other things. When start + * runs, it copies the table to where these parameters live during + * execution. This data is in text space, so it cannot be modified here + * before saving the executable, so the data is written manually. In + * addition, the table does not have a label, and the nearest accessable + * label (mcount) is not prefixed with a '_', thus making it inaccessable + * from within C programs. To overcome this, emacs's executable is passed + * through the command 'nm %s | fgrep mcount' into a pipe, and the + * resultant output is then used to find the address of 'mcount'. As far as + * is possible to determine, in RISC-iX releases prior to 1.2, the negative + * offset of the table from mcount is 0x2c, whereas from 1.2 onwards it is + * 0x30. bss_end has been rounded up to page boundary. This solution is + * based on suggestions made by Kevin Welton and Steve Hunt of Acorn, and + * avoids the need for a custom version of crt0.o for emacs which has its + * table in data space. + */ + + { + char command[1024]; + char errbuf[1024]; + char address_text[32]; + int proforma[4]; + FILE *pfile; + char *temp_ptr; + char c; + int mcount_address, mcount_offset, count; + extern char *_execname; + + + /* The use of _execname is incompatible with RISCiX 1.1 */ + sprintf (command, "nm '%s' | fgrep mcount", _execname); + + if ( (pfile = popen(command, "r")) == NULL) + { + sprintf (errbuf, "Could not open pipe"); + PERROR (errbuf); + } + + count=0; + while ( ((c=getc(pfile)) != EOF) && (c != ' ') && (count < 31)) + address_text[count++]=c; + address_text[count]=0; + + if ((count == 0) || pclose(pfile) != NULL) + { + sprintf (errbuf, "Failed to execute the command '%s'\n", command); + PERROR (errbuf); + } + + sscanf(address_text, "%x", &mcount_address); + ptr = (char *) unexec_text_start; + mcount_offset = (char *)mcount_address - ptr; + +#ifdef RISCiX_1_1 +#define EDATA_OFFSET 0x2c +#else +#define EDATA_OFFSET 0x30 +#endif + + end = ptr + mcount_offset - EDATA_OFFSET; + + write_segment (new, ptr, end); + + proforma[0] = bss_end; /* becomes _edata */ + proforma[1] = bss_end; /* becomes _end */ + proforma[2] = bss_end; /* becomes _minbrk */ + proforma[3] = bss_end; /* becomes _curbrk */ + + write (new, proforma, 16); + + temp_ptr = ptr; + ptr = end + 16; + end = temp_ptr + hdr.a_text; + + write_segment (new, ptr, end); + } + +#else /* !RISCiX */ + ptr = (char *) unexec_text_start; + end = ptr + hdr.a_text; + write_segment (new, ptr, end); +#endif /* RISCiX */ + + ptr = (char *) unexec_data_start; + end = ptr + hdr.a_data; +/* This lseek is certainly incorrect when A_TEXT_OFFSET + and I believe it is a no-op otherwise. + Let's see if its absence ever fails. */ +/* lseek (new, (long) N_TXTOFF (hdr) + hdr.a_text, 0); */ + write_segment (new, ptr, end); + +#endif /* not COFF */ + + return 0; +} + +write_segment (int new, register char *ptr, register char *end) +{ + register int i, nwrite, ret; + char buf[80]; + extern int errno; + char zeros[128]; + int amt_to_write = (1 << 13); + + bzero (zeros, sizeof zeros); + + for (i = 0; ptr < end;) + { + /* distance to next multiple of amt_to_write . */ + AGAIN: + nwrite = (((int) ptr + amt_to_write) & -amt_to_write) - (int) ptr; + /* But not beyond specified end. */ + if (nwrite > end - ptr) nwrite = end - ptr; + ret = write (new, ptr, nwrite); + /* If write gets a page fault, it means we reached + a gap between the old text segment and the old data segment. + This gap has probably been remapped into part of the text segment. + So write zeros for it. */ + if (ret == -1 +#ifdef EFAULT + && errno == EFAULT +#endif + ) + { if (amt_to_write > sizeof(zeros)) + { amt_to_write = sizeof(zeros); + goto AGAIN; + } + write (new, zeros, nwrite); + } + else if (nwrite != ret) + { + sprintf (buf, + "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", + ptr, new, nwrite, ret, errno); + PERROR (buf); + } + i += nwrite; + ptr += nwrite; + } +} + +/* **************************************************************** + * copy_sym + * + * Copy the relocation information and symbol table from the a.out to the new + */ +static int +copy_sym (int new, int a_out, char *a_name, char *new_name) +{ + char page[1024]; + int n; + + if (a_out < 0) + return 0; + +#ifdef COFF + if (SYMS_START == 0L) + return 0; +#endif /* COFF */ + +#ifdef COFF + if (lnnoptr) /* if there is line number info */ + lseek (a_out, lnnoptr, 0); /* start copying from there */ + else +#endif /* COFF */ + lseek (a_out, SYMS_START, 0); /* Position a.out to symtab. */ + + while ((n = read (a_out, page, sizeof page)) > 0) + { + if (write (new, page, n) != n) + { + PERROR (new_name); + } + } + if (n < 0) + { + PERROR (a_name); + } + return 0; +} + +/* **************************************************************** + * mark_x + * + * After successfully building the new a.out, mark it executable + */ +static void +mark_x (char *name) +{ + struct stat sbuf; + int um; + int new = 0; /* for PERROR */ + + um = umask (777); + umask (um); + if (stat (name, &sbuf) == -1) + { + PERROR (name); + } + sbuf.st_mode |= 0111 & ~um; + if (chmod (name, sbuf.st_mode) == -1) + PERROR (name); +} + +#ifdef COFF +#ifndef COFF_BSD_SYMBOLS + +/* + * If the COFF file contains a symbol table and a line number section, + * then any auxiliary entries that have values for x_lnnoptr must + * be adjusted by the amount that the line number section has moved + * in the file (bias computed in make_hdr). The #@$%&* designers of + * the auxiliary entry structures used the absolute file offsets for + * the line number entry rather than an offset from the start of the + * line number section! + * + * When I figure out how to scan through the symbol table and pick out + * the auxiliary entries that need adjustment, this routine will + * be fixed. As it is now, all such entries are wrong and sdb + * will complain. Fred Fish, UniSoft Systems Inc. + */ + +/* This function is probably very slow. Instead of reopening the new + file for input and output it should copy from the old to the new + using the two descriptors already open (WRITEDESC and READDESC). + Instead of reading one small structure at a time it should use + a reasonable size buffer. But I don't have time to work on such + things, so I am installing it as submitted to me. -- RMS. */ + +adjust_lnnoptrs (writedesc, readdesc, new_name) + int writedesc; + int readdesc; + char *new_name; +{ + register int nsyms; + register int new; +#if defined (amdahl_uts) || defined (pfa) + SYMENT symentry; + AUXENT auxentry; +#else + struct syment symentry; + union auxent auxentry; +#endif + + if (!lnnoptr || !f_hdr.f_symptr) + return 0; + +#ifdef MSDOS + if ((new = writedesc) < 0) +#else + if ((new = open (new_name, O_RDWR)) < 0) +#endif + { + PERROR (new_name); + return -1; + } + + lseek (new, f_hdr.f_symptr, 0); + for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) + { + read (new, &symentry, SYMESZ); + if (symentry.n_numaux) + { + read (new, &auxentry, AUXESZ); + nsyms++; + if (ISFCN (symentry.n_type) || symentry.n_type == 0x2400) + { + auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; + lseek (new, -AUXESZ, 1); + write (new, &auxentry, AUXESZ); + } + } + } +#ifndef MSDOS + close (new); +#endif + return 0; +} + +#endif /* COFF_BSD_SYMBOLS */ + +#endif /* COFF */ + +#endif /* not CANNOT_DUMP */ + + +#ifdef UNIXSAVE +#include "save.c" +#endif diff --git a/o/unexec.c b/o/unexec.c new file mode 100755 index 0000000..6852715 --- /dev/null +++ b/o/unexec.c @@ -0,0 +1,1198 @@ +/* Copyright (C) 1985,86,87,88,92,93,94 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + + +/* + * unexec.c - Convert a running program into an a.out file. + * + * Author: Spencer W. Thomas + * Computer Science Dept. + * University of Utah + * Date: Tue Mar 2 1982 + * Modified heavily since then. + * + * Synopsis: + * unexec (new_name, a_name, data_start, bss_start, entry_address) + * char *new_name, *a_name; + * unsigned data_start, bss_start, entry_address; + * + * Takes a snapshot of the program and makes an a.out format file in the + * file named by the string argument new_name. + * If a_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing a_name file is required. + * + * The boundaries within the a.out file may be adjusted with the data_start + * and bss_start arguments. Either or both may be given as 0 for defaults. + * + * Data_start gives the boundary between the text segment and the data + * segment of the program. The text segment can contain shared, read-only + * program code and literal data, while the data segment is always unshared + * and unprotected. Data_start gives the lowest unprotected address. + * The value you specify may be rounded down to a suitable boundary + * as required by the machine you are using. + * + * Specifying zero for data_start means the boundary between text and data + * should not be the same as when the program was loaded. + * If NO_REMAP is defined, the argument data_start is ignored and the + * segment boundaries are never changed. + * + * Bss_start indicates how much of the data segment is to be saved in the + * a.out file and restored when the program is executed. It gives the lowest + * unsaved address, and is rounded up to a page boundary. The default when 0 + * is given assumes that the entire data segment is to be stored, including + * the previous data and bss as well as any additional storage allocated with + * break (2). + * + * The new file is set up to start at entry_address. + * + * If you make improvements I'd like to get them too. + * harpo!utah-cs!thomas, thomas@Utah-20 + * + */ + +/* Modified to support SysVr3 shared libraries by James Van Artsdalen + * of Dell Computer Corporation. james@bigtex.cactus.org. + */ + +/* There are several compilation parameters affecting unexec: + +* COFF + +Define this if your system uses COFF for executables. + +* COFF_ENCAPSULATE + +Define this if you are using the GNU coff encapsulated a.out format. +This is closer to a.out than COFF. You should *not* define COFF if +you define COFF_ENCAPSULATE + +Otherwise we assume you use Berkeley format. + +* NO_REMAP + +Define this if you do not want to try to save Emacs's pure data areas +as part of the text segment. + +Saving them as text is good because it allows users to share more. + +However, on machines that locate the text area far from the data area, +the boundary cannot feasibly be moved. Such machines require +NO_REMAP. + +Also, remapping can cause trouble with the built-in startup routine +/lib/crt0.o, which defines `environ' as an initialized variable. +Dumping `environ' as pure does not work! So, to use remapping, +you must write a startup routine for your machine in Emacs's crt0.c. +If NO_REMAP is defined, Emacs uses the system's crt0.o. + +* SECTION_ALIGNMENT + +Some machines that use COFF executables require that each section +start on a certain boundary *in the COFF file*. Such machines should +define SECTION_ALIGNMENT to a mask of the low-order bits that must be +zero on such a boundary. This mask is used to control padding between +segments in the COFF file. + +If SECTION_ALIGNMENT is not defined, the segments are written +consecutively with no attempt at alignment. This is right for +unmodified system V. + +* SEGMENT_MASK + +Some machines require that the beginnings and ends of segments +*in core* be on certain boundaries. For most machines, a page +boundary is sufficient. That is the default. When a larger +boundary is needed, define SEGMENT_MASK to a mask of +the bits that must be zero on such a boundary. + +* A_TEXT_OFFSET(HDR) + +Some machines count the a.out header as part of the size of the text +segment (a_text); they may actually load the header into core as the +first data in the text segment. Some have additional padding between +the header and the real text of the program that is counted in a_text. + +For these machines, define A_TEXT_OFFSET(HDR) to examine the header +structure HDR and return the number of bytes to add to `a_text' +before writing it (above and beyond the number of bytes of actual +program text). HDR's standard fields are already correct, except that +this adjustment to the `a_text' field has not yet been made; +thus, the amount of offset can depend on the data in the file. + +* A_TEXT_SEEK(HDR) + +If defined, this macro specifies the number of bytes to seek into the +a.out file before starting to write the text segment. + +* EXEC_MAGIC + +For machines using COFF, this macro, if defined, is a value stored +into the magic number field of the output file. + +* ADJUST_EXEC_HEADER + +This macro can be used to generate statements to adjust or +initialize nonstandard fields in the file header + +* ADDR_CORRECT(ADDR) + +Macro to correct an int which is the bit pattern of a pointer to a byte +into an int which is the number of a byte. + +This macro has a default definition which is usually right. +This default definition is a no-op on most machines (where a +pointer looks like an int) but not on all machines. + +*/ + +#ifndef emacs +#define PERROR(arg) perror (arg); return -1 +#else +#define IN_UNEXEC +#include "config.h" +#define PERROR(file) report_error (file, new) +#endif + +#ifndef CANNOT_DUMP /* all rest of file! */ + +#ifdef COFF_ENCAPSULATE +int need_coff_header = 1; +#include /* The location might be a poor assumption */ +#else +#ifdef MSDOS +#include +#define filehdr external_filehdr +#define scnhdr external_scnhdr +#define syment external_syment +#define auxent external_auxent +#define n_numaux e_numaux +#define n_type e_type +struct aouthdr +{ + unsigned short magic; /* type of file */ + unsigned short vstamp; /* version stamp */ + unsigned long tsize; /* text size in bytes, padded to FW bdry*/ + unsigned long dsize; /* initialized data " " */ + unsigned long bsize; /* uninitialized data " " */ + unsigned long entry; /* entry pt. */ + unsigned long text_start;/* base of text used for this file */ + unsigned long data_start;/* base of data used for this file */ +}; + + +#else /* not MSDOS */ +#include +#endif /* not MSDOS */ +#endif + +/* Define getpagesize if the system does not. + Note that this may depend on symbols defined in a.out.h. */ +#include "getpagesize.h" + +#ifndef makedev /* Try to detect types.h already loaded */ +#include +#endif /* makedev */ +#include +#include +#include + +#include /* Must be after sys/types.h for USG and BSD4_1*/ + +#ifdef USG5 +#include +#endif + +#ifndef O_RDONLY +#define O_RDONLY 0 +#endif +#ifndef O_RDWR +#define O_RDWR 2 +#endif + +#ifdef UNIXSAVE +extern char etext; +#endif + +#ifndef start_of_data +extern char *start_of_text (); /* Start of text */ +extern char *start_of_data (); /* Start of initialized data */ +#endif + +#ifdef COFF +static long block_copy_start; /* Old executable start point */ +static struct filehdr f_hdr; /* File header */ +static struct aouthdr f_ohdr; /* Optional file header (a.out) */ +long bias; /* Bias to add for growth */ +long lnnoptr; /* Pointer to line-number info within file */ +#define SYMS_START block_copy_start + +static long text_scnptr; +static long data_scnptr; + +#else /* not COFF */ + +#ifdef HPUX +extern void *sbrk (); +#else +#if 0 +/* Some systems with __STDC__ compilers still declare this `char *' in some + header file, and our declaration conflicts. The return value is always + cast, so it should be harmless to leave it undefined. Hopefully + machines with different size pointers and ints declare sbrk in a header + file. */ +#ifdef __STDC__ +extern void *sbrk (); +#else +extern char *sbrk (); +#endif /* __STDC__ */ +#endif +#endif /* HPUX */ + +#define SYMS_START ((long) N_SYMOFF (ohdr)) + +/* Some machines override the structure name for an a.out header. */ +#ifndef EXEC_HDR_TYPE +#define EXEC_HDR_TYPE struct exec +#endif + +#ifdef HPUX +#ifdef HP9000S200_ID +#define MY_ID HP9000S200_ID +#else +#include +#define MY_ID MYSYS +#endif /* no HP9000S200_ID */ +static MAGIC OLDMAGIC = {MY_ID, SHARE_MAGIC}; +static MAGIC NEWMAGIC = {MY_ID, DEMAND_MAGIC}; +#define N_TXTOFF(x) TEXT_OFFSET(x) +#define N_SYMOFF(x) LESYM_OFFSET(x) +static EXEC_HDR_TYPE hdr, ohdr; + +#else /* not HPUX */ + +#if defined (USG) && !defined (IBMAIX) && !defined (IRIS) && !defined (COFF_ENCAPSULATE) && !defined (LINUX) +static struct bhdr hdr, ohdr; +#define a_magic fmagic +#define a_text tsize +#define a_data dsize +#define a_bss bsize +#define a_syms ssize +#define a_trsize rtsize +#define a_drsize rdsize +#define a_entry entry +#define N_BADMAG(x) \ + (((x).fmagic)!=OMAGIC && ((x).fmagic)!=NMAGIC &&\ + ((x).fmagic)!=FMAGIC && ((x).fmagic)!=IMAGIC) +#define NEWMAGIC FMAGIC +#else /* IRIS or IBMAIX or not USG */ +static EXEC_HDR_TYPE hdr, ohdr; +#define NEWMAGIC ZMAGIC +#endif /* IRIS or IBMAIX not USG */ +#endif /* not HPUX */ + +static int unexec_text_start; +static int unexec_data_start; + +#ifdef COFF_ENCAPSULATE +/* coffheader is defined in the GNU a.out.encap.h file. */ +struct coffheader coffheader; +#endif + +#endif /* not COFF */ + +static int pagemask; + +/* Correct an int which is the bit pattern of a pointer to a byte + into an int which is the number of a byte. + This is a no-op on ordinary machines, but not on all. */ + +#ifndef ADDR_CORRECT /* Let m-*.h files override this definition */ +#define ADDR_CORRECT(x) ((char *)(x) - (char*)0) +#endif + +#ifdef emacs + +#include "lisp.h" + +static +report_error (file, fd) + char *file; + int fd; +{ + if (fd) + close (fd); + report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); +} +#endif /* emacs */ + +#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 +#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 +#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 + +static +report_error_1 (int fd, char *msg, int a1, int a2) +{ + close (fd); +#ifdef emacs + error (msg, a1, a2); +#else + fprintf (stderr, msg, a1, a2); + fprintf (stderr, "\n"); +#endif +} + +static int make_hdr (int new, int a_out, unsigned int data_start, unsigned int bss_start, unsigned int entry_address, char *a_name, char *new_name); +static int copy_text_and_data (int new, int a_out); +static int copy_sym (int new, int a_out, char *a_name, char *new_name); +static void mark_x (char *name); + +/* **************************************************************** + * unexec + * + * driving logic. + */ +void +unexec (char *new_name, char *a_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address) +{ + int new, a_out = -1; + + if (a_name && (a_out = open (a_name, O_RDONLY)) < 0) + { + PERROR (a_name); + } + if ((new = creat (new_name, 0666)) < 0) + { + PERROR (new_name); + } + + if (make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) < 0 + || copy_text_and_data (new, a_out) < 0 + || copy_sym (new, a_out, a_name, new_name) < 0 +#ifdef COFF +#ifndef COFF_BSD_SYMBOLS + || adjust_lnnoptrs (new, a_out, new_name) < 0 +#endif +#endif + ) + { + close (new); + /* unlink (new_name); /* Failed, unlink new a.out */ + return -1; + } + + close (new); + if (a_out >= 0) + close (a_out); + mark_x (new_name); + return 0; +} + +/* **************************************************************** + * make_hdr + * + * Make the header in the new a.out from the header in core. + * Modify the text and data sizes. + */ +static int +make_hdr (int new, int a_out, unsigned int data_start, unsigned int bss_start, unsigned int entry_address, char *a_name, char *new_name) +{ + int tem; +#ifdef COFF + auto struct scnhdr f_thdr; /* Text section header */ + auto struct scnhdr f_dhdr; /* Data section header */ + auto struct scnhdr f_bhdr; /* Bss section header */ + auto struct scnhdr scntemp; /* Temporary section header */ + register int scns; +#endif /* COFF */ +#ifdef USG_SHARED_LIBRARIES + extern unsigned int bss_end; +#else + unsigned int bss_end; +#endif + + pagemask = getpagesize () - 1; + + /* Adjust text/data boundary. */ +#ifdef NO_REMAP + data_start = (int) start_of_data (); +#else /* not NO_REMAP */ + if (!data_start) + data_start = (int) start_of_data (); +#endif /* not NO_REMAP */ + data_start = ADDR_CORRECT (data_start); + +#ifdef SEGMENT_MASK + data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */ +#else + data_start = data_start & ~pagemask; /* (Down) to page boundary. */ +#endif + + bss_end = ADDR_CORRECT (sbrk (0)) + pagemask; + bss_end &= ~ pagemask; + + /* Adjust data/bss boundary. */ + if (bss_start != 0) + { + bss_start = (ADDR_CORRECT (bss_start) + pagemask); + /* (Up) to page bdry. */ + bss_start &= ~ pagemask; + if (bss_start > bss_end) + { + ERROR1 ("unexec: Specified bss_start (%u) is past end of program", + bss_start); + } + } + else + bss_start = bss_end; + + if (data_start > bss_start) /* Can't have negative data size. */ + { + ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", + data_start, bss_start); + } + +#ifdef COFF + /* Salvage as much info from the existing file as possible */ + if (a_out >= 0) + { + if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (a_name); + } + block_copy_start += sizeof (f_hdr); + if (f_hdr.f_opthdr > 0) + { + if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (a_name); + } + block_copy_start += sizeof (f_ohdr); + } + /* Loop through section headers, copying them in */ + lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 0); + for (scns = f_hdr.f_nscns; scns > 0; scns--) { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + { + PERROR (a_name); + } + if (scntemp.s_scnptr > 0L) + { + if (block_copy_start < scntemp.s_scnptr + scntemp.s_size) + block_copy_start = scntemp.s_scnptr + scntemp.s_size; + } + if (strcmp (scntemp.s_name, ".text") == 0) + { + f_thdr = scntemp; + } + else if (strcmp (scntemp.s_name, ".data") == 0) + { + f_dhdr = scntemp; + } + else if (strcmp (scntemp.s_name, ".bss") == 0) + { + f_bhdr = scntemp; + } + } + } + else + { + ERROR0 ("can't build a COFF file from scratch yet"); + } + + /* Now we alter the contents of all the f_*hdr variables + to correspond to what we want to dump. */ + +#ifdef USG_SHARED_LIBRARIES + + /* The amount of data we're adding to the file is distance from the + * end of the original .data space to the current end of the .data + * space. + */ + + bias = bss_start - (f_ohdr.data_start + f_dhdr.s_size); + +#endif + + f_hdr.f_flags |= (F_RELFLG | F_EXEC); +#ifdef TPIX + f_hdr.f_nscns = 3; +#endif +#ifdef EXEC_MAGIC + f_ohdr.magic = EXEC_MAGIC; +#endif +#ifndef NO_REMAP + f_ohdr.text_start = (long) start_of_text (); + f_ohdr.tsize = data_start - f_ohdr.text_start; + f_ohdr.data_start = data_start; +#endif /* NO_REMAP */ + f_ohdr.dsize = bss_start - f_ohdr.data_start; + f_ohdr.bsize = bss_end - bss_start; +#ifndef KEEP_OLD_TEXT_SCNPTR + /* On some machines, the old values are right. + ??? Maybe on all machines with NO_REMAP. */ + f_thdr.s_size = f_ohdr.tsize; + f_thdr.s_scnptr = sizeof (f_hdr) + sizeof (f_ohdr); + f_thdr.s_scnptr += (f_hdr.f_nscns) * (sizeof (f_thdr)); +#endif /* KEEP_OLD_TEXT_SCNPTR */ +#ifdef ADJUST_TEXT_SCNHDR_SIZE + /* On some machines, `text size' includes all headers. */ + f_thdr.s_size -= f_thdr.s_scnptr; +#endif /* ADJUST_TEST_SCNHDR_SIZE */ + lnnoptr = f_thdr.s_lnnoptr; +#ifdef SECTION_ALIGNMENT + /* Some systems require special alignment + of the sections in the file itself. */ + f_thdr.s_scnptr + = (f_thdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; +#endif /* SECTION_ALIGNMENT */ +#ifdef TPIX + f_thdr.s_scnptr = 0xd0; +#endif + text_scnptr = f_thdr.s_scnptr; +#ifdef ADJUST_TEXTBASE + text_scnptr = sizeof (f_hdr) + sizeof (f_ohdr) + (f_hdr.f_nscns) * (sizeof (f_thdr)); +#endif +#ifndef KEEP_OLD_PADDR + f_dhdr.s_paddr = f_ohdr.data_start; +#endif /* KEEP_OLD_PADDR */ + f_dhdr.s_vaddr = f_ohdr.data_start; + f_dhdr.s_size = f_ohdr.dsize; + f_dhdr.s_scnptr = f_thdr.s_scnptr + f_thdr.s_size; +#ifdef SECTION_ALIGNMENT + /* Some systems require special alignment + of the sections in the file itself. */ + f_dhdr.s_scnptr + = (f_dhdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; +#endif /* SECTION_ALIGNMENT */ +#ifdef DATA_SECTION_ALIGNMENT + /* Some systems require special alignment + of the data section only. */ + f_dhdr.s_scnptr + = (f_dhdr.s_scnptr + DATA_SECTION_ALIGNMENT) & ~DATA_SECTION_ALIGNMENT; +#endif /* DATA_SECTION_ALIGNMENT */ + data_scnptr = f_dhdr.s_scnptr; +#ifndef KEEP_OLD_PADDR + f_bhdr.s_paddr = f_ohdr.data_start + f_ohdr.dsize; +#endif /* KEEP_OLD_PADDR */ + f_bhdr.s_vaddr = f_ohdr.data_start + f_ohdr.dsize; + f_bhdr.s_size = f_ohdr.bsize; + f_bhdr.s_scnptr = 0L; +#ifndef USG_SHARED_LIBRARIES + bias = f_dhdr.s_scnptr + f_dhdr.s_size - block_copy_start; +#endif + + if (f_hdr.f_symptr > 0L) + { + f_hdr.f_symptr += bias; + } + + if (f_thdr.s_lnnoptr > 0L) + { + f_thdr.s_lnnoptr += bias; + } + +#ifdef ADJUST_EXEC_HEADER + ADJUST_EXEC_HEADER; +#endif /* ADJUST_EXEC_HEADER */ + + if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (new_name); + } + + if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (new_name); + } + +#ifndef USG_SHARED_LIBRARIES + + if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) + { + PERROR (new_name); + } + + if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) + { + PERROR (new_name); + } + + if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) + { + PERROR (new_name); + } + +#else /* USG_SHARED_LIBRARIES */ + + /* The purpose of this code is to write out the new file's section + * header table. + * + * Scan through the original file's sections. If the encountered + * section is one we know (.text, .data or .bss), write out the + * correct header. If it is a section we do not know (such as + * .lib), adjust the address of where the section data is in the + * file, and write out the header. + * + * If any section precedes .text or .data in the file, this code + * will not adjust the file pointer for that section correctly. + */ + + /* This used to use sizeof (f_ohdr) instead of .f_opthdr. + .f_opthdr is said to be right when there is no optional header. */ + lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 0); + + for (scns = f_hdr.f_nscns; scns > 0; scns--) + { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR (a_name); + + if (!strcmp (scntemp.s_name, f_thdr.s_name)) /* .text */ + { + if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) + PERROR (new_name); + } + else if (!strcmp (scntemp.s_name, f_dhdr.s_name)) /* .data */ + { + if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) + PERROR (new_name); + } + else if (!strcmp (scntemp.s_name, f_bhdr.s_name)) /* .bss */ + { + if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) + PERROR (new_name); + } + else + { + if (scntemp.s_scnptr) + scntemp.s_scnptr += bias; + if (write (new, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR (new_name); + } + } +#endif /* USG_SHARED_LIBRARIES */ + + return (0); + +#else /* if not COFF */ + + /* Get symbol table info from header of a.out file if given one. */ + if (a_out >= 0) + { +#ifdef COFF_ENCAPSULATE + if (read (a_out, &coffheader, sizeof coffheader) != sizeof coffheader) + { + PERROR(a_name); + } + if (coffheader.f_magic != COFF_MAGIC) + { + ERROR1("%s doesn't have legal coff magic number\n", a_name); + } +#endif + if (read (a_out, &ohdr, sizeof hdr) != sizeof hdr) + { + PERROR (a_name); + } + + if (N_BADMAG (ohdr)) + { + ERROR1 ("invalid magic number in %s", a_name); + } + hdr = ohdr; + } + else + { +#ifdef COFF_ENCAPSULATE + /* We probably could without too much trouble. The code is in gld + * but I don't have that much time or incentive. + */ + ERROR0 ("can't build a COFF file from scratch yet"); +#else +#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ + bzero ((void *)&hdr, sizeof hdr); +#else + bzero (&hdr, sizeof hdr); +#endif +#endif + } + + unexec_text_start = (long) start_of_text (); + unexec_data_start = data_start; + + /* Machine-dependent fixup for header, or maybe for unexec_text_start */ +#ifdef ADJUST_EXEC_HEADER + ADJUST_EXEC_HEADER; +#endif /* ADJUST_EXEC_HEADER */ + + hdr.a_trsize = 0; + hdr.a_drsize = 0; + if (entry_address != 0) + hdr.a_entry = entry_address; + + hdr.a_bss = bss_end - bss_start; + hdr.a_data = bss_start - data_start; +#ifdef NO_REMAP + hdr.a_text = ohdr.a_text; +#else /* not NO_REMAP */ + hdr.a_text = data_start - unexec_text_start; + +#ifdef A_TEXT_OFFSET + hdr.a_text += A_TEXT_OFFSET (ohdr); +#endif + +#endif /* not NO_REMAP */ + +#ifdef COFF_ENCAPSULATE + /* We are encapsulating BSD format within COFF format. */ + { + struct coffscn *tp, *dp, *bp; + tp = &coffheader.scns[0]; + dp = &coffheader.scns[1]; + bp = &coffheader.scns[2]; + tp->s_size = hdr.a_text + sizeof(struct exec); + dp->s_paddr = data_start; + dp->s_vaddr = data_start; + dp->s_size = hdr.a_data; + bp->s_paddr = dp->s_vaddr + dp->s_size; + bp->s_vaddr = bp->s_paddr; + bp->s_size = hdr.a_bss; + coffheader.tsize = tp->s_size; + coffheader.dsize = dp->s_size; + coffheader.bsize = bp->s_size; + coffheader.text_start = tp->s_vaddr; + coffheader.data_start = dp->s_vaddr; + } + if (write (new, &coffheader, sizeof coffheader) != sizeof coffheader) + { + PERROR(new_name); + } +#endif /* COFF_ENCAPSULATE */ + + if (write (new, &hdr, sizeof hdr) != sizeof hdr) + { + PERROR (new_name); + } + +#if 0 /* This #ifndef caused a bug on Linux when using QMAGIC. */ + /* This adjustment was done above only #ifndef NO_REMAP, + so only undo it now #ifndef NO_REMAP. */ + /* #ifndef NO_REMAP */ +#endif +#ifdef A_TEXT_OFFSET + hdr.a_text -= A_TEXT_OFFSET (ohdr); +#endif + + return 0; + +#endif /* not COFF */ +} + +/* **************************************************************** + * copy_text_and_data + * + * Copy the text and data segments from memory to the new a.out + */ +static int +copy_text_and_data (int new, int a_out) +{ + register char *end; + register char *ptr; + +#ifdef COFF + +#ifdef USG_SHARED_LIBRARIES + + int scns; + struct scnhdr scntemp; /* Temporary section header */ + + /* The purpose of this code is to write out the new file's section + * contents. + * + * Step through the section table. If we know the section (.text, + * .data) do the appropriate thing. Otherwise, if the section has + * no allocated space in the file (.bss), do nothing. Otherwise, + * the section has space allocated in the file, and is not a section + * we know. So just copy it. + */ + + lseek (a_out, sizeof (struct filehdr) + sizeof (struct aouthdr), 0); + + for (scns = f_hdr.f_nscns; scns > 0; scns--) + { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR ("temacs"); + + if (!strcmp (scntemp.s_name, ".text")) + { + lseek (new, (long) text_scnptr, 0); + ptr = (char *) f_ohdr.text_start; + end = ptr + f_ohdr.tsize; + write_segment (new, ptr, end); + } + else if (!strcmp (scntemp.s_name, ".data")) + { + lseek (new, (long) data_scnptr, 0); + ptr = (char *) f_ohdr.data_start; + end = ptr + f_ohdr.dsize; + write_segment (new, ptr, end); + } + else if (!scntemp.s_scnptr) + ; /* do nothing - no data for this section */ + else + { + char page[BUFSIZ]; + int size, n; + long old_a_out_ptr = lseek (a_out, 0, 1); + + lseek (a_out, scntemp.s_scnptr, 0); + for (size = scntemp.s_size; size > 0; size -= sizeof (page)) + { + n = size > sizeof (page) ? sizeof (page) : size; + if (read (a_out, page, n) != n || write (new, page, n) != n) + PERROR ("emacs"); + } + lseek (a_out, old_a_out_ptr, 0); + } + } + +#else /* COFF, but not USG_SHARED_LIBRARIES */ + + lseek (new, (long) text_scnptr, 0); + ptr = (char *) f_ohdr.text_start; +#ifdef HEADER_INCL_IN_TEXT + /* For Gould UTX/32, text starts after headers */ + ptr = (char *) (ptr + text_scnptr); +#endif /* HEADER_INCL_IN_TEXT */ + end = ptr + f_ohdr.tsize; + write_segment (new, ptr, end); + + lseek (new, (long) data_scnptr, 0); + ptr = (char *) f_ohdr.data_start; + end = ptr + f_ohdr.dsize; + write_segment (new, ptr, end); + +#endif /* USG_SHARED_LIBRARIES */ + +#else /* if not COFF */ + +/* Some machines count the header as part of the text segment. + That is to say, the header appears in core + just before the address that start_of_text returns. + For them, N_TXTOFF is the place where the header goes. + We must adjust the seek to the place after the header. + Note that at this point hdr.a_text does *not* count + the extra A_TEXT_OFFSET bytes, only the actual bytes of code. */ + +#ifdef A_TEXT_SEEK + lseek (new, (long) A_TEXT_SEEK (hdr), 0); +#else + lseek (new, (long) N_TXTOFF (hdr), 0); +#endif /* no A_TEXT_SEEK */ + +#ifdef RISCiX + + /* Acorn's RISC-iX has a wacky way of initialising the position of the heap. + * There is a little table in crt0.o that is filled at link time with + * the min and current brk positions, among other things. When start + * runs, it copies the table to where these parameters live during + * execution. This data is in text space, so it cannot be modified here + * before saving the executable, so the data is written manually. In + * addition, the table does not have a label, and the nearest accessable + * label (mcount) is not prefixed with a '_', thus making it inaccessable + * from within C programs. To overcome this, emacs's executable is passed + * through the command 'nm %s | fgrep mcount' into a pipe, and the + * resultant output is then used to find the address of 'mcount'. As far as + * is possible to determine, in RISC-iX releases prior to 1.2, the negative + * offset of the table from mcount is 0x2c, whereas from 1.2 onwards it is + * 0x30. bss_end has been rounded up to page boundary. This solution is + * based on suggestions made by Kevin Welton and Steve Hunt of Acorn, and + * avoids the need for a custom version of crt0.o for emacs which has its + * table in data space. + */ + + { + char command[1024]; + char errbuf[1024]; + char address_text[32]; + int proforma[4]; + FILE *pfile; + char *temp_ptr; + char c; + int mcount_address, mcount_offset, count; + extern char *_execname; + + + /* The use of _execname is incompatible with RISCiX 1.1 */ + sprintf (command, "nm '%s' | fgrep mcount", _execname); + + if ( (pfile = popen(command, "r")) == NULL) + { + sprintf (errbuf, "Could not open pipe"); + PERROR (errbuf); + } + + count=0; + while ( ((c=getc(pfile)) != EOF) && (c != ' ') && (count < 31)) + address_text[count++]=c; + address_text[count]=0; + + if ((count == 0) || pclose(pfile) != NULL) + { + sprintf (errbuf, "Failed to execute the command '%s'\n", command); + PERROR (errbuf); + } + + sscanf(address_text, "%x", &mcount_address); + ptr = (char *) unexec_text_start; + mcount_offset = (char *)mcount_address - ptr; + +#ifdef RISCiX_1_1 +#define EDATA_OFFSET 0x2c +#else +#define EDATA_OFFSET 0x30 +#endif + + end = ptr + mcount_offset - EDATA_OFFSET; + + write_segment (new, ptr, end); + + proforma[0] = bss_end; /* becomes _edata */ + proforma[1] = bss_end; /* becomes _end */ + proforma[2] = bss_end; /* becomes _minbrk */ + proforma[3] = bss_end; /* becomes _curbrk */ + + write (new, proforma, 16); + + temp_ptr = ptr; + ptr = end + 16; + end = temp_ptr + hdr.a_text; + + write_segment (new, ptr, end); + } + +#else /* !RISCiX */ + ptr = (char *) unexec_text_start; + end = ptr + hdr.a_text; + write_segment (new, ptr, end); +#endif /* RISCiX */ + + ptr = (char *) unexec_data_start; + end = ptr + hdr.a_data; +/* This lseek is certainly incorrect when A_TEXT_OFFSET + and I believe it is a no-op otherwise. + Let's see if its absence ever fails. */ +/* lseek (new, (long) N_TXTOFF (hdr) + hdr.a_text, 0); */ + write_segment (new, ptr, end); + +#endif /* not COFF */ + + return 0; +} + +write_segment (int new, register char *ptr, register char *end) +{ + register int i, nwrite, ret; + char buf[80]; + extern int errno; + char zeros[128]; + int amt_to_write = (1 << 13); + + bzero (zeros, sizeof zeros); + + for (i = 0; ptr < end;) + { + /* distance to next multiple of amt_to_write . */ + AGAIN: + nwrite = (((int) ptr + amt_to_write) & -amt_to_write) - (int) ptr; + /* But not beyond specified end. */ + if (nwrite > end - ptr) nwrite = end - ptr; + ret = write (new, ptr, nwrite); + /* If write gets a page fault, it means we reached + a gap between the old text segment and the old data segment. + This gap has probably been remapped into part of the text segment. + So write zeros for it. */ + if (ret == -1 +#ifdef EFAULT + && errno == EFAULT +#endif + ) + { if (amt_to_write > sizeof(zeros)) + { amt_to_write = sizeof(zeros); + goto AGAIN; + } + write (new, zeros, nwrite); + } + else if (nwrite != ret) + { + sprintf (buf, + "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", + ptr, new, nwrite, ret, errno); + PERROR (buf); + } + i += nwrite; + ptr += nwrite; + } +} + +/* **************************************************************** + * copy_sym + * + * Copy the relocation information and symbol table from the a.out to the new + */ +static int +copy_sym (int new, int a_out, char *a_name, char *new_name) +{ + char page[1024]; + int n; + + if (a_out < 0) + return 0; + +#ifdef COFF + if (SYMS_START == 0L) + return 0; +#endif /* COFF */ + +#ifdef COFF + if (lnnoptr) /* if there is line number info */ + lseek (a_out, lnnoptr, 0); /* start copying from there */ + else +#endif /* COFF */ + lseek (a_out, SYMS_START, 0); /* Position a.out to symtab. */ + + while ((n = read (a_out, page, sizeof page)) > 0) + { + if (write (new, page, n) != n) + { + PERROR (new_name); + } + } + if (n < 0) + { + PERROR (a_name); + } + return 0; +} + +/* **************************************************************** + * mark_x + * + * After successfully building the new a.out, mark it executable + */ +static void +mark_x (char *name) +{ + struct stat sbuf; + int um; + int new = 0; /* for PERROR */ + + um = umask (777); + umask (um); + if (stat (name, &sbuf) == -1) + { + PERROR (name); + } + sbuf.st_mode |= 0111 & ~um; + if (chmod (name, sbuf.st_mode) == -1) + PERROR (name); +} + +#ifdef COFF +#ifndef COFF_BSD_SYMBOLS + +/* + * If the COFF file contains a symbol table and a line number section, + * then any auxiliary entries that have values for x_lnnoptr must + * be adjusted by the amount that the line number section has moved + * in the file (bias computed in make_hdr). The #@$%&* designers of + * the auxiliary entry structures used the absolute file offsets for + * the line number entry rather than an offset from the start of the + * line number section! + * + * When I figure out how to scan through the symbol table and pick out + * the auxiliary entries that need adjustment, this routine will + * be fixed. As it is now, all such entries are wrong and sdb + * will complain. Fred Fish, UniSoft Systems Inc. + */ + +/* This function is probably very slow. Instead of reopening the new + file for input and output it should copy from the old to the new + using the two descriptors already open (WRITEDESC and READDESC). + Instead of reading one small structure at a time it should use + a reasonable size buffer. But I don't have time to work on such + things, so I am installing it as submitted to me. -- RMS. */ + +adjust_lnnoptrs (writedesc, readdesc, new_name) + int writedesc; + int readdesc; + char *new_name; +{ + register int nsyms; + register int new; +#if defined (amdahl_uts) || defined (pfa) + SYMENT symentry; + AUXENT auxentry; +#else + struct syment symentry; + union auxent auxentry; +#endif + + if (!lnnoptr || !f_hdr.f_symptr) + return 0; + +#ifdef MSDOS + if ((new = writedesc) < 0) +#else + if ((new = open (new_name, O_RDWR)) < 0) +#endif + { + PERROR (new_name); + return -1; + } + + lseek (new, f_hdr.f_symptr, 0); + for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) + { + read (new, &symentry, SYMESZ); + if (symentry.n_numaux) + { + read (new, &auxentry, AUXESZ); + nsyms++; + if (ISFCN (symentry.n_type) || symentry.n_type == 0x2400) + { + auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; + lseek (new, -AUXESZ, 1); + write (new, &auxentry, AUXESZ); + } + } + } +#ifndef MSDOS + close (new); +#endif + return 0; +} + +#endif /* COFF_BSD_SYMBOLS */ + +#endif /* COFF */ + +#endif /* not CANNOT_DUMP */ + + +#ifdef UNIXSAVE +#include "save.c" +#endif diff --git a/o/unexelf.c b/o/unexelf.c new file mode 100755 index 0000000..9b90701 --- /dev/null +++ b/o/unexelf.c @@ -0,0 +1,1254 @@ +/* Foundation; either version 2, or (at your option) +any later version. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. + +In other words, you are welcome to use, share and improve this program. +You are forbidden to forbid anyone else to use, share and improve +what you give them. Help stamp out software-hoarding! */ + + +/* + * unexec.c - Convert a running program into an a.out file. + * + * Author: Spencer W. Thomas + * Computer Science Dept. + * University of Utah + * Date: Tue Mar 2 1982 + * Modified heavily since then. + * + * Synopsis: + * unexec (new_name, old_name, data_start, bss_start, entry_address) + * char *new_name, *old_name; + * unsigned data_start, bss_start, entry_address; + * + * Takes a snapshot of the program and makes an a.out format file in the + * file named by the string argument new_name. + * If old_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing old_name file is required. + * + * The boundaries within the a.out file may be adjusted with the data_start + * and bss_start arguments. Either or both may be given as 0 for defaults. + * + * Data_start gives the boundary between the text segment and the data + * segment of the program. The text segment can contain shared, read-only + * program code and literal data, while the data segment is always unshared + * and unprotected. Data_start gives the lowest unprotected address. + * The value you specify may be rounded down to a suitable boundary + * as required by the machine you are using. + * + * Bss_start indicates how much of the data segment is to be saved in the + * a.out file and restored when the program is executed. It gives the lowest + * unsaved address, and is rounded up to a page boundary. The default when 0 + * is given assumes that the entire data segment is to be stored, including + * the previous data and bss as well as any additional storage allocated with + * break (2). + * + * The new file is set up to start at entry_address. + * + */ + +/* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co. + * ELF support added. + * + * Basic theory: the data space of the running process needs to be + * dumped to the output file. Normally we would just enlarge the size + * of .data, scooting everything down. But we can't do that in ELF, + * because there is often something between the .data space and the + * .bss space. + * + * In the temacs dump below, notice that the Global Offset Table + * (.got) and the Dynamic link data (.dynamic) come between .data1 and + * .bss. It does not work to overlap .data with these fields. + * + * The solution is to create a new .data segment. This segment is + * filled with data from the current process. Since the contents of + * various sections refer to sections by index, the new .data segment + * is made the last in the table to avoid changing any existing index. + + * This is an example of how the section headers are changed. "Addr" + * is a process virtual address. "Offset" is a file offset. + +raid:/nfs/raid/src/dist-18.56/src> dump -h temacs + +temacs: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 8 3 0x80a98f4 0x608f4 0x449c .bss + 0 0 0x4 0 + +[17] 2 0 0 0x608f4 0x9b90 .symtab + 18 371 0x4 0x10 + +[18] 3 0 0 0x6a484 0x8526 .strtab + 0 0 0x1 0 + +[19] 3 0 0 0x729aa 0x93 .shstrtab + 0 0 0x1 0 + +[20] 1 0 0 0x72a3d 0x68b7 .comment + 0 0 0x1 0 + +raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs + +xemacs: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 + +[17] 2 0 0 0x7d800 0x9b90 .symtab + 18 371 0x4 0x10 + +[18] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 + +[19] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 + +[20] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 + +[21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 + + * This is an example of how the file header is changed. "Shoff" is + * the section header offset within the file. Since that table is + * after the new .data section, it is moved. "Shnum" is the number of + * sections, which we increment. + * + * "Phoff" is the file offset to the program header. "Phentsize" and + * "Shentsz" are the program and section header entries sizes respectively. + * These can be larger than the apparent struct sizes. + +raid:/nfs/raid/src/dist-18.56/src> dump -f temacs + +temacs: + + **** ELF HEADER **** +Class Data Type Machine Version +Entry Phoff Shoff Flags Ehsize +Phentsize Phnum Shentsz Shnum Shstrndx + +1 1 2 3 1 +0x80499cc 0x34 0x792f4 0 0x34 +0x20 5 0x28 21 19 + +raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs + +xemacs: + + **** ELF HEADER **** +Class Data Type Machine Version +Entry Phoff Shoff Flags Ehsize +Phentsize Phnum Shentsz Shnum Shstrndx + +1 1 2 3 1 +0x80499cc 0x34 0x96200 0 0x34 +0x20 5 0x28 22 19 + + * These are the program headers. "Offset" is the file offset to the + * segment. "Vaddr" is the memory load address. "Filesz" is the + * segment size as it appears in the file, and "Memsz" is the size in + * memory. Below, the third segment is the code and the fourth is the + * data: the difference between Filesz and Memsz is .bss + +raid:/nfs/raid/src/dist-18.56/src> dump -o temacs + +temacs: + ***** PROGRAM EXECUTION HEADER ***** +Type Offset Vaddr Paddr +Filesz Memsz Flags Align + +6 0x34 0x8048034 0 +0xa0 0xa0 5 0 + +3 0xd4 0 0 +0x13 0 4 0 + +1 0x34 0x8048034 0 +0x3f2f9 0x3f2f9 5 0x1000 + +1 0x3f330 0x8088330 0 +0x215c4 0x25a60 7 0x1000 + +2 0x60874 0x80a9874 0 +0x80 0 7 0 + +raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs + +xemacs: + ***** PROGRAM EXECUTION HEADER ***** +Type Offset Vaddr Paddr +Filesz Memsz Flags Align + +6 0x34 0x8048034 0 +0xa0 0xa0 5 0 + +3 0xd4 0 0 +0x13 0 4 0 + +1 0x34 0x8048034 0 +0x3f2f9 0x3f2f9 5 0x1000 + +1 0x3f330 0x8088330 0 +0x3e4d0 0x3e4d0 7 0x1000 + +2 0x60874 0x80a9874 0 +0x80 0 7 0 + + + */ + +/* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. + * + * The above mechanism does not work if the unexeced ELF file is being + * re-layout by other applications (such as `strip'). All the applications + * that re-layout the internal of ELF will layout all sections in ascending + * order of their file offsets. After the re-layout, the data2 section will + * still be the LAST section in the section header vector, but its file offset + * is now being pushed far away down, and causes part of it not to be mapped + * in (ie. not covered by the load segment entry in PHDR vector), therefore + * causes the new binary to fail. + * + * The solution is to modify the unexec algorithm to insert the new data2 + * section header right before the new bss section header, so their file + * offsets will be in the ascending order. Since some of the section's (all + * sections AFTER the bss section) indexes are now changed, we also need to + * modify some fields to make them point to the right sections. This is done + * by macro PATCH_INDEX. All the fields that need to be patched are: + * + * 1. ELF header e_shstrndx field. + * 2. section header sh_link and sh_info field. + * 3. symbol table entry st_shndx field. + * + * The above example now should look like: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 + +[17] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 + +[18] 2 0 0 0x7d800 0x9b90 .symtab + 19 371 0x4 0x10 + +[19] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 + +[20] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 + +[21] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 + + */ + +/* We do not use mmap because that fails with NFS. + Instead we read the whole file, modify it, and write it out. */ + +#ifndef emacs +#define fatal(a, b...) emsg(a,##b),do_gcl_abort() +#else +#include "config.h" +extern void fatal (char *, ...); +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#if !defined (__NetBSD__) && !defined (__OpenBSD__) +#include +#endif +#include +#if defined (__sony_news) && defined (_SYSTYPE_SYSV) +#include +#include +#endif /* __sony_news && _SYSTYPE_SYSV */ +#if __sgi +#include /* for HDRR declaration */ +#endif /* __sgi */ + +#include "page.h" + +#ifndef MAP_ANON +#ifdef MAP_ANONYMOUS +#define MAP_ANON MAP_ANONYMOUS +#else +#define MAP_ANON 0 +#endif +#endif + +#ifndef MAP_FAILED +#define MAP_FAILED ((void *) -1) +#endif + +#if defined (__alpha__) && !defined (__NetBSD__) && !defined (__OpenBSD__) +/* Declare COFF debugging symbol table. This used to be in + /usr/include/sym.h, but this file is no longer included in Red Hat + 5.0 and presumably in any other glibc 2.x based distribution. */ +typedef struct { + short magic; + short vstamp; + int ilineMax; + int idnMax; + int ipdMax; + int isymMax; + int ioptMax; + int iauxMax; + int issMax; + int issExtMax; + int ifdMax; + int crfd; + int iextMax; + long cbLine; + long cbLineOffset; + long cbDnOffset; + long cbPdOffset; + long cbSymOffset; + long cbOptOffset; + long cbAuxOffset; + long cbSsOffset; + long cbSsExtOffset; + long cbFdOffset; + long cbRfdOffset; + long cbExtOffset; +} HDRR, *pHDRR; +#define cbHDRR sizeof(HDRR) +#define hdrNil ((pHDRR)0) +#endif + +#ifdef __NetBSD__ +/* + * NetBSD does not have normal-looking user-land ELF support. + */ +# ifdef __alpha__ +# define ELFSIZE 64 +# else +# define ELFSIZE 32 +# endif +# include + +# ifndef PT_LOAD +# define PT_LOAD Elf_pt_load +# define SHT_SYMTAB Elf_sht_symtab +# define SHT_DYNSYM Elf_sht_dynsym +# define SHT_NULL Elf_sht_null +# define SHT_NOBITS Elf_sht_nobits +# define SHT_REL Elf_sht_rel +# define SHT_RELA Elf_sht_rela + +# define SHN_UNDEF Elf_eshn_undefined +# define SHN_ABS Elf_eshn_absolute +# define SHN_COMMON Elf_eshn_common +# endif + +# ifdef __alpha__ +# include +# define HDRR struct ecoff_symhdr +# define pHDRR HDRR * +# endif +#endif /* __NetBSD__ */ + +#ifdef __OpenBSD__ +# include +#endif + +#if __GNU_LIBRARY__ - 0 >= 6 +# include /* get ElfW etc */ +#endif + +#ifndef ElfW +# ifdef __STDC__ +# define ElfBitsW(bits, type) Elf##bits##_##type +# else +# define ElfBitsW(bits, type) Elf/**/bits/**/_/**/type +# endif +# ifdef _LP64 +# define ELFSIZE 64 +# else +# define ELFSIZE 32 +# endif + /* This macro expands `bits' before invoking ElfBitsW. */ +# define ElfExpandBitsW(bits, type) ElfBitsW (bits, type) +# define ElfW(type) ElfExpandBitsW (ELFSIZE, type) +#endif + +#ifndef ELF_BSS_SECTION_NAME +#define ELF_BSS_SECTION_NAME ".bss" +#endif + +/* Get the address of a particular section or program header entry, + * accounting for the size of the entries. + */ +/* + On PPC Reference Platform running Solaris 2.5.1 + the plt section is also of type NOBI like the bss section. + (not really stored) and therefore sections after the bss + section start at the plt offset. The plt section is always + the one just before the bss section. + Thus, we modify the test from + if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) + to + if (NEW_SECTION_H (nn).sh_offset >= + OLD_SECTION_H (old_bss_index-1).sh_offset) + This is just a hack. We should put the new data section + before the .plt section. + And we should not have this routine at all but use + the libelf library to read the old file and create the new + file. + The changed code is minimal and depends on prep set in m/prep.h + Erik Deumens + Quantum Theory Project + University of Florida + deumens@qtp.ufl.edu + Apr 23, 1996 + */ + +#define OLD_SECTION_H(n) \ + (*(ElfW(Shdr) *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) +#define NEW_SECTION_H(n) \ + (*(ElfW(Shdr) *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) +#define OLD_PROGRAM_H(n) \ + (*(ElfW(Phdr) *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) +#define NEW_PROGRAM_H(n) \ + (*(ElfW(Phdr) *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) + +#define PATCH_INDEX(n) \ + do { \ + if ((int) (n) >= old_bss_index) \ + (n)++; } while (0) +typedef unsigned char byte; + +/* Round X up to a multiple of Y. */ + +static ElfW(Addr) +round_up (x, y) + ElfW(Addr) x, y; +{ + int rem = x % y; + if (rem == 0) + return x; + return x - rem + y; +} + +/* Return the index of the section named NAME. + SECTION_NAMES, FILE_NAME and FILE_H give information + about the file we are looking in. + + If we don't find the section NAME, that is a fatal error + if NOERROR is 0; we return -1 if NOERROR is nonzero. */ + +static int +find_section (char *name, char *section_names, char *file_name, ElfW(Ehdr) *old_file_h, ElfW(Shdr) *old_section_h, int noerror) +{ + int idx; + + for (idx = 1; idx < old_file_h->e_shnum; idx++) + { +#ifdef DEBUG + emsg("Looking for %s - found %s\n", name, + section_names + OLD_SECTION_H (idx).sh_name); +#endif + if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, + name)) + break; + } + if (idx == old_file_h->e_shnum) + { + if (noerror) + return -1; + else + fatal ("Can't find %s in %s.\n", name, file_name); + } + + return idx; +} + +/* **************************************************************** + * unexec + * + * driving logic. + * + * In ELF, this works by replacing the old .bss section with a new + * .data section, and inserting an empty .bss immediately afterwards. + * + */ +static void +unexec (char *new_name, char *old_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address) +{ + int new_file, old_file; + + /* Pointers to the base of the image of the two files. */ + caddr_t old_base, new_base; + +#if MAP_ANON == 0 + int mmap_fd; +#else +# define mmap_fd -1 +#endif + + /* Pointers to the file, program and section headers for the old and + new files. */ + ElfW(Ehdr) *old_file_h, *new_file_h; + ElfW(Phdr) *old_program_h, *new_program_h; + ElfW(Shdr) *old_section_h, *new_section_h; + + /* Point to the section name table in the old file */ + char *old_section_names; + + ElfW(Addr) old_bss_addr, new_bss_addr,new_data2_addr; + ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size,data_bss_offset; + + int n, nn; + int old_bss_index, old_sbss_index; + int old_data_index, new_data2_index; + /* int old_mdebug_index; */ + struct stat stat_buf; + + /* Open the old file, allocate a buffer of the right size, and read + in the file contents. */ + + old_file = open (old_name, O_RDONLY); + + if (old_file < 0) + fatal ("Can't open %s for reading: errno %d\n", old_name, errno); + + if (fstat (old_file, &stat_buf) == -1) + fatal ("Can't fstat (%s): errno %d\n", old_name, errno); + +#if MAP_ANON == 0 + mmap_fd = open ("/dev/zero", O_RDONLY); + if (mmap_fd < 0) + fatal ("Can't open /dev/zero for reading: errno %d\n", errno); +#endif + + /* We cannot use malloc here because that may use sbrk. If it does, + we'd dump our temporary buffers with Emacs, and we'd have to be + extra careful to use the correct value of sbrk(0) after + allocating all buffers in the code below, which we aren't. */ + old_file_size = stat_buf.st_size; + old_base = mmap (NULL, old_file_size, PROT_READ,MAP_SHARED, old_file, 0); + if (old_base == MAP_FAILED) + fatal ("Can't allocate buffer for %s\n", old_name); + + /* errno=0; */ + /* if (read (old_file, old_base, stat_buf.st_size) != stat_buf.st_size) */ + /* fatal ("Didn't read all of %s: errno %d\n", old_name, errno); */ + + /* Get pointers to headers & section names */ + + old_file_h = (ElfW(Ehdr) *) old_base; + old_program_h = (ElfW(Phdr) *) ((byte *) old_base + old_file_h->e_phoff); + old_section_h = (ElfW(Shdr) *) ((byte *) old_base + old_file_h->e_shoff); + old_section_names = (char *) old_base + + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; + + /* Find the mdebug section, if any. */ + + /* old_mdebug_index = find_section (".mdebug", old_section_names, */ + /* old_name, old_file_h, old_section_h, 1); */ + + /* Find the old .bss section. Figure out parameters of the new + * data2 and bss sections. + */ + + old_bss_index = find_section (".bss", old_section_names, + old_name, old_file_h, old_section_h, 0); + + old_sbss_index = find_section (".sbss", old_section_names, + old_name, old_file_h, old_section_h, 1); + if (old_sbss_index != -1) + if (OLD_SECTION_H (old_sbss_index).sh_type == SHT_PROGBITS) + old_sbss_index = -1; + + if (old_sbss_index == -1) + { + old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; + old_bss_offset = OLD_SECTION_H (old_bss_index).sh_offset; + old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; + new_data2_index = old_bss_index; + } + else + { + old_bss_addr = OLD_SECTION_H (old_sbss_index).sh_addr; + old_bss_offset = OLD_SECTION_H (old_sbss_index).sh_offset; + old_bss_size = OLD_SECTION_H (old_bss_index).sh_size + + OLD_SECTION_H (old_sbss_index).sh_size; + new_data2_index = old_sbss_index; + } + + /* Find the old .data section. Figure out parameters of + the new data2 and bss sections. */ + + old_data_index = find_section (".data", old_section_names, + old_name, old_file_h, old_section_h, 0); + +#if defined (emacs) || !defined (DEBUG) + new_bss_addr = (ElfW(Addr)) sbrk (0); +#else + new_bss_addr = old_bss_addr + old_bss_size + 0x1234; +#endif + new_data2_addr = old_bss_addr; + new_data2_size = new_bss_addr - old_bss_addr; + new_data2_offset = OLD_SECTION_H (old_data_index).sh_offset + /*to preserve data offset alignment*/ + (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); + +#ifdef DEBUG + emsg("old_bss_index %d\n", old_bss_index); + emsg("old_bss_addr %x\n", old_bss_addr); + emsg("old_bss_size %x\n", old_bss_size); + emsg("new_bss_addr %x\n", new_bss_addr); + emsg("new_data2_addr %x\n", new_data2_addr); + emsg("new_data2_size %x\n", new_data2_size); + emsg("new_data2_offset %x\n", new_data2_offset); +#endif + + if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) + fatal (".bss shrank when undumping???\n"); + + /* Set the output file to the right size. Allocate a buffer to hold + the image of the new file. Set pointers to various interesting + objects. stat_buf still has old_file data. */ + + new_file = open (new_name, O_RDWR | O_CREAT, 0666); + if (new_file < 0) + fatal ("Can't creat (%s): errno %d\n", new_name, errno); + + data_bss_offset=CEI(new_data2_offset-old_bss_offset,sizeof(long));/*????, e.g. sparc64*/ + + new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size + data_bss_offset; + + if (ftruncate (new_file, new_file_size)) + fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); + + new_base = mmap (NULL, new_file_size, PROT_READ | PROT_WRITE,MAP_SHARED, new_file, 0); + if (new_base == MAP_FAILED) + fatal ("Can't allocate buffer for %s\n", old_name); + + new_file_h = (ElfW(Ehdr) *) new_base; + new_program_h = (ElfW(Phdr) *) ((byte *) new_base + old_file_h->e_phoff); + new_section_h = (ElfW(Shdr) *) + ((byte *) new_base + old_file_h->e_shoff + new_data2_size + data_bss_offset); + + + /* Make our new file, program and section headers as copies of the + * originals. + */ + + memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); + memcpy (new_program_h, old_program_h, + old_file_h->e_phnum * old_file_h->e_phentsize); + + /* Modify the e_shstrndx if necessary. */ + PATCH_INDEX (new_file_h->e_shstrndx); + + /* Fix up file header. We'll add one section. Section header is + * further away now. + */ + + new_file_h->e_shoff += new_data2_size + data_bss_offset; + new_file_h->e_shnum += 1; + +#ifdef DEBUG + emsg("Old section offset %x\n", old_file_h->e_shoff); + emsg("Old section count %d\n", old_file_h->e_shnum); + emsg("New section offset %x\n", new_file_h->e_shoff); + emsg("New section count %d\n", new_file_h->e_shnum); +#endif + + /* Fix up a new program header. Extend the writable data segment so + * that the bss area is covered too. Find that segment by looking + * for a segment that ends just before the .bss area. Make sure + * that no segments are above the new .data2. Put a loop at the end + * to adjust the offset and address of any segment that is above + * data2, just in case we decide to allow this later. + */ + + for (n = new_file_h->e_phnum - 1; n >= 0; n--) + { + /* Compute maximum of all requirements for alignment of section. */ + ElfW(Word) alignment = (NEW_PROGRAM_H (n)).p_align; + if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) + alignment = OLD_SECTION_H (old_bss_index).sh_addralign; + +#ifdef __sgi + /* According to r02kar@x4u2.desy.de (Karsten Kuenne) + and oliva@gnu.org (Alexandre Oliva), on IRIX 5.2, we + always get "Program segment above .bss" when dumping + when the executable doesn't have an sbss section. */ + if (old_sbss_index != -1) +#endif /* __sgi */ + if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz + > (old_sbss_index == -1 + ? old_bss_addr + : round_up (old_bss_addr, alignment))) + fatal ("Program segment above .bss in %s\n", old_name); + + if (NEW_PROGRAM_H (n).p_type == PT_LOAD + && (round_up ((NEW_PROGRAM_H (n)).p_vaddr + + (NEW_PROGRAM_H (n)).p_filesz, + alignment) + <= round_up (old_bss_addr, alignment))) + break; + } + if (n < 0) + fatal ("Couldn't find segment next to .bss in %s\n", old_name); + + /* Make sure that the size includes any padding before the old .bss + section. */ + NEW_PROGRAM_H (n).p_filesz = new_bss_addr - NEW_PROGRAM_H (n).p_vaddr; + NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; + +#if 0 /* Maybe allow section after data2 - does this ever happen? */ + for (n = new_file_h->e_phnum - 1; n >= 0; n--) + { + if (NEW_PROGRAM_H (n).p_vaddr + && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr) + NEW_PROGRAM_H (n).p_vaddr += new_data2_size - old_bss_size; + + if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset) + NEW_PROGRAM_H (n).p_offset += new_data2_size; + } +#endif + + /* Fix up section headers based on new .data2 section. Any section + * whose offset or virtual address is after the new .data2 section + * gets its value adjusted. .bss size becomes zero and new address + * is set. data2 section header gets added by copying the existing + * .data header and modifying the offset, address and size. + */ + for (old_data_index = 1; old_data_index < (int) old_file_h->e_shnum; + old_data_index++) + if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name, + ".data")) + break; + if (old_data_index == old_file_h->e_shnum) + fatal ("Can't find .data in %s.\n", old_name); + + /* Walk through all section headers, insert the new data2 section right + before the new bss section. */ + for (n = 0, nn = 0; n < (int) old_file_h->e_shnum; n++, nn++) + { + caddr_t src; + /* If it is (s)bss section, insert the new data2 section before it. */ + /* new_data2_index is the index of either old_sbss or old_bss, that was + chosen as a section for new_data2. */ + if (n == new_data2_index) + { + /* Steal the data section header for this data2 section. */ + memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index), + new_file_h->e_shentsize); + + NEW_SECTION_H (nn).sh_addr = new_data2_addr; + NEW_SECTION_H (nn).sh_offset = new_data2_offset; + NEW_SECTION_H (nn).sh_size = new_data2_size; + /* Use the bss section's alignment. This will assure that the + new data2 section always be placed in the same spot as the old + bss section by any other application. */ + NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign; + /* for gcl make the NEW_SECTION_H executable since it will + have code in it. */ + NEW_SECTION_H (nn).sh_flags |= SHF_EXECINSTR; + + /* Now copy over what we have in the memory now. */ + memcpy (NEW_SECTION_H (nn).sh_offset + new_base, + (caddr_t) OLD_SECTION_H (n).sh_addr, + new_data2_size); + nn++; + } + + memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), + old_file_h->e_shentsize); + + if (n == old_bss_index + /* The new bss and sbss section's size is zero, and its file offset + and virtual address should be off by NEW_DATA2_SIZE. */ + || n == old_sbss_index + ) + { + /* NN should be `old_s?bss_index + 1' at this point. */ + NEW_SECTION_H (nn).sh_offset = + NEW_SECTION_H (new_data2_index).sh_offset + new_data2_size; + NEW_SECTION_H (nn).sh_addr = + NEW_SECTION_H (new_data2_index).sh_addr + new_data2_size; + /* Let the new bss section address alignment be the same as the + section address alignment followed the old bss section, so + this section will be placed in exactly the same place. */ + NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign; + NEW_SECTION_H (nn).sh_size = 0; + } + else + { + /* Any section that was originally placed after the .bss + section should now be off by NEW_DATA2_SIZE. If a + section overlaps the .bss section, consider it to be + placed after the .bss section. Overlap can occur if the + section just before .bss has less-strict alignment; this + was observed between .symtab and .bss on Solaris 2.5.1 + (sparc) with GCC snapshot 960602. */ +#ifdef SOLARIS_POWERPC + /* On PPC Reference Platform running Solaris 2.5.1 + the plt section is also of type NOBI like the bss section. + (not really stored) and therefore sections after the bss + section start at the plt offset. The plt section is always + the one just before the bss section. + It would be better to put the new data section before + the .plt section, or use libelf instead. + Erik Deumens, deumens@qtp.ufl.edu. */ + if (NEW_SECTION_H (nn).sh_offset + >= OLD_SECTION_H (old_bss_index-1).sh_offset) + NEW_SECTION_H (nn).sh_offset += new_data2_size; +#else + if (NEW_SECTION_H (nn).sh_offset >= old_bss_offset || + /* solaris has symtab straddling bss offset */ + NEW_SECTION_H (nn).sh_offset+NEW_SECTION_H (nn).sh_size > old_bss_offset) + NEW_SECTION_H (nn).sh_offset += new_data2_size+data_bss_offset; +#endif + /* Any section that was originally placed after the section + header table should now be off by the size of one section + header table entry. */ + if (NEW_SECTION_H (nn).sh_offset > new_file_h->e_shoff) + NEW_SECTION_H (nn).sh_offset += new_file_h->e_shentsize; + } + + /* If any section hdr refers to the section after the new .data + section, make it refer to next one because we have inserted + a new section in between. */ + + PATCH_INDEX (NEW_SECTION_H (nn).sh_link); + /* For symbol tables, info is a symbol table index, + so don't change it. */ + if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB + && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM) + PATCH_INDEX (NEW_SECTION_H (nn).sh_info); + + if (old_sbss_index != -1) + if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".sbss")) + { + NEW_SECTION_H (nn).sh_offset = + round_up (NEW_SECTION_H (nn).sh_offset, + NEW_SECTION_H (nn).sh_addralign); + NEW_SECTION_H (nn).sh_type = SHT_PROGBITS; + } + + /* Now, start to copy the content of sections. */ + if (NEW_SECTION_H (nn).sh_type == SHT_NULL + || NEW_SECTION_H (nn).sh_type == SHT_NOBITS) + continue; + + /* Write out the sections. .data and .data1 (and data2, called + ".data" in the strings table) get copied from the current process + instead of the old file. */ + if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit4") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit8") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata1") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".data1") + || !strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, + ".sbss")) + src = (caddr_t) OLD_SECTION_H (n).sh_addr; + else + src = old_base + OLD_SECTION_H (n).sh_offset; + + memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src, + NEW_SECTION_H (nn).sh_size); + +#ifdef __alpha__ + /* Update Alpha COFF symbol table: */ + if (strcmp (old_section_names + OLD_SECTION_H (n).sh_name, ".mdebug") + == 0) + { + pHDRR symhdr = (pHDRR) (NEW_SECTION_H (nn).sh_offset + new_base); + + symhdr->cbLineOffset += new_data2_size; + symhdr->cbDnOffset += new_data2_size; + symhdr->cbPdOffset += new_data2_size; + symhdr->cbSymOffset += new_data2_size; + symhdr->cbOptOffset += new_data2_size; + symhdr->cbAuxOffset += new_data2_size; + symhdr->cbSsOffset += new_data2_size; + symhdr->cbSsExtOffset += new_data2_size; + symhdr->cbFdOffset += new_data2_size; + symhdr->cbRfdOffset += new_data2_size; + symhdr->cbExtOffset += new_data2_size; + } +#endif /* __alpha__ */ + +#if defined (__sony_news) && defined (_SYSTYPE_SYSV) + if (NEW_SECTION_H (nn).sh_type == SHT_MIPS_DEBUG + && old_mdebug_index != -1) + { + int diff = NEW_SECTION_H(nn).sh_offset + - OLD_SECTION_H(old_mdebug_index).sh_offset; + HDRR *phdr = (HDRR *)(NEW_SECTION_H (nn).sh_offset + new_base); + + if (diff) + { + phdr->cbLineOffset += diff; + phdr->cbDnOffset += diff; + phdr->cbPdOffset += diff; + phdr->cbSymOffset += diff; + phdr->cbOptOffset += diff; + phdr->cbAuxOffset += diff; + phdr->cbSsOffset += diff; + phdr->cbSsExtOffset += diff; + phdr->cbFdOffset += diff; + phdr->cbRfdOffset += diff; + phdr->cbExtOffset += diff; + } + } +#endif /* __sony_news && _SYSTYPE_SYSV */ + +#if __sgi + /* Adjust the HDRR offsets in .mdebug and copy the + line data if it's in its usual 'hole' in the object. + Makes the new file debuggable with dbx. + patches up two problems: the absolute file offsets + in the HDRR record of .mdebug (see /usr/include/syms.h), and + the ld bug that gets the line table in a hole in the + elf file rather than in the .mdebug section proper. + David Anderson. davea@sgi.com Jan 16,1994. */ + if (n == old_mdebug_index) + { +#define MDEBUGADJUST(__ct,__fileaddr) \ + if (n_phdrr->__ct > 0) \ + { \ + n_phdrr->__fileaddr += movement; \ + } + + HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset); + HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset); + unsigned movement = new_data2_size; + + MDEBUGADJUST (idnMax, cbDnOffset); + MDEBUGADJUST (ipdMax, cbPdOffset); + MDEBUGADJUST (isymMax, cbSymOffset); + MDEBUGADJUST (ioptMax, cbOptOffset); + MDEBUGADJUST (iauxMax, cbAuxOffset); + MDEBUGADJUST (issMax, cbSsOffset); + MDEBUGADJUST (issExtMax, cbSsExtOffset); + MDEBUGADJUST (ifdMax, cbFdOffset); + MDEBUGADJUST (crfd, cbRfdOffset); + MDEBUGADJUST (iextMax, cbExtOffset); + /* The Line Section, being possible off in a hole of the object, + requires special handling. */ + if (n_phdrr->cbLine > 0) + { + if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset + + OLD_SECTION_H (n).sh_size)) + { + /* line data is in a hole in elf. do special copy and adjust + for this ld mistake. + */ + n_phdrr->cbLineOffset += movement; + + memcpy (n_phdrr->cbLineOffset + new_base, + o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine); + } + else + { + /* somehow line data is in .mdebug as it is supposed to be. */ + MDEBUGADJUST (cbLine, cbLineOffset); + } + } + } +#endif /* __sgi */ + + /* If it is the symbol table, its st_shndx field needs to be patched. */ + if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB + || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM) + { + ElfW(Shdr) *spt = &NEW_SECTION_H (nn); + unsigned int num = spt->sh_size / spt->sh_entsize; + ElfW(Sym) * sym = (ElfW(Sym) *) (NEW_SECTION_H (nn).sh_offset + + new_base); + for (; num--; sym++) + { + if ((sym->st_shndx == SHN_UNDEF) + || (sym->st_shndx == SHN_ABS) + || (sym->st_shndx == SHN_COMMON)) + continue; + + PATCH_INDEX (sym->st_shndx); + } + } + } + + /* Update the symbol values of _edata and _end. */ + for (n = new_file_h->e_shnum - 1; n; n--) + { + byte *symnames; + ElfW(Sym) *symp, *symendp; + + if (NEW_SECTION_H (n).sh_type != SHT_DYNSYM + && NEW_SECTION_H (n).sh_type != SHT_SYMTAB) + continue; + + symnames = ((byte *) new_base + + NEW_SECTION_H (NEW_SECTION_H (n).sh_link).sh_offset); + symp = (ElfW(Sym) *) (NEW_SECTION_H (n).sh_offset + new_base); + symendp = (ElfW(Sym) *) ((byte *)symp + NEW_SECTION_H (n).sh_size); + + for (; symp < symendp; symp ++) + if (strcmp ((char *) (symnames + symp->st_name), "_end") == 0 + || strcmp ((char *) (symnames + symp->st_name), "end") == 0 + || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0 + || strcmp ((char *) (symnames + symp->st_name), "edata") == 0) + memcpy (&symp->st_value, &new_bss_addr, sizeof (new_bss_addr)); + } + + /* This loop seeks out relocation sections for the data section, so + that it can undo relocations performed by the runtime linker. */ + for (n = new_file_h->e_shnum - 1; n; n--) + { + ElfW(Shdr) section = NEW_SECTION_H (n); + switch (section.sh_type) { + default: + break; + case SHT_REL: + case SHT_RELA: + /* This code handles two different size structs, but there should + be no harm in that provided that r_offset is always the first + member. */ + nn = section.sh_info; + if (nn && (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit4") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit8") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata1") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".data1"))) + { + ElfW(Addr) offset = NEW_SECTION_H (nn).sh_addr - + NEW_SECTION_H (nn).sh_offset; + caddr_t reloc = old_base + section.sh_offset, end; + for (end = reloc + section.sh_size; reloc < end; + reloc += section.sh_entsize) + { + ElfW(Addr) addr = ((ElfW(Rel) *) reloc)->r_offset - offset; +#ifdef __alpha__ + /* The Alpha ELF binutils currently have a bug that + sometimes results in relocs that contain all + zeroes. Work around this for now... */ + if (((ElfW(Rel) *) reloc)->r_offset == 0) + continue; +#endif + memcpy (new_base + addr, old_base + addr, sizeof(ElfW(Addr))); + } + } + break; + } + } + + /* Write out new_file, and free the buffers. */ + + /* if (write (new_file, new_base, new_file_size) != new_file_size) */ + /* fatal ("Didn't write %d bytes to %s: errno %d\n", */ + /* new_file_size, new_base, errno); */ + + munmap (old_base, old_file_size); + munmap (new_base, new_file_size); + + /* Close the files and make the new file executable. */ + +#if MAP_ANON == 0 + close (mmap_fd); +#endif + + if (close (old_file)) + fatal ("Can't close (%s): errno %d\n", old_name, errno); + + if (close (new_file)) + fatal ("Can't close (%s): errno %d\n", new_name, errno); + + if (stat (new_name, &stat_buf) == -1) + fatal ("Can't stat (%s): errno %d\n", new_name, errno); + + n = umask (777); + umask (n); + stat_buf.st_mode |= 0111 & ~n; + if (chmod (new_name, stat_buf.st_mode) == -1) + fatal ("Can't chmod (%s): errno %d\n", new_name, errno); +} +/* All of the above is from the emacs-20.7 file. This comment and the + following are added for gcl. Also we changed the above (near "for + gcl") we make the NEW_SECTION_H executable since it will have code + in it. NEW_SECTION_H (nn).sh_flags |= SHF_EXECINSTR; + + Partly synchronized with Emacs HEAD of 2004-04-12 by Magnus Henoch. + The files themselves are no longer mmap'ed, but memory is allocated + with mmap, and everything is written to the new file at the end. +*/ +#ifdef UNIXSAVE +#include "save.c" +#endif diff --git a/o/unexelfsgi.c b/o/unexelfsgi.c new file mode 100755 index 0000000..24c01d2 --- /dev/null +++ b/o/unexelfsgi.c @@ -0,0 +1,861 @@ +/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992 + 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, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +In other words, you are welcome to use, share and improve this program. +You are forbidden to forbid anyone else to use, share and improve +what you give them. Help stamp out software-hoarding! */ + + +/* + * unexec.c - Convert a running program into an a.out file. + * + * Author: Spencer W. Thomas + * Computer Science Dept. + * University of Utah + * Date: Tue Mar 2 1982 + * Modified heavily since then. + * + * Synopsis: + * unexec (new_name, a_name, data_start, bss_start, entry_address) + * char *new_name, *a_name; + * unsigned data_start, bss_start, entry_address; + * + * Takes a snapshot of the program and makes an a.out format file in the + * file named by the string argument new_name. + * If a_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing a_name file is required. + * + * The boundaries within the a.out file may be adjusted with the data_start + * and bss_start arguments. Either or both may be given as 0 for defaults. + * + * Data_start gives the boundary between the text segment and the data + * segment of the program. The text segment can contain shared, read-only + * program code and literal data, while the data segment is always unshared + * and unprotected. Data_start gives the lowest unprotected address. + * The value you specify may be rounded down to a suitable boundary + * as required by the machine you are using. + * + * Specifying zero for data_start means the boundary between text and data + * should not be the same as when the program was loaded. + * If NO_REMAP is defined, the argument data_start is ignored and the + * segment boundaries are never changed. + * + * Bss_start indicates how much of the data segment is to be saved in the + * a.out file and restored when the program is executed. It gives the lowest + * unsaved address, and is rounded up to a page boundary. The default when 0 + * is given assumes that the entire data segment is to be stored, including + * the previous data and bss as well as any additional storage allocated with + * break (2). + * + * The new file is set up to start at entry_address. + * + * If you make improvements I'd like to get them too. + * harpo!utah-cs!thomas, thomas@Utah-20 + * + */ + +/* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co. + * ELF support added. + * + * Basic theory: the data space of the running process needs to be + * dumped to the output file. Normally we would just enlarge the size + * of .data, scooting everything down. But we can't do that in ELF, + * because there is often something between the .data space and the + * .bss space. + * + * In the temacs dump below, notice that the Global Offset Table + * (.got) and the Dynamic link data (.dynamic) come between .data1 and + * .bss. It does not work to overlap .data with these fields. + * + * The solution is to create a new .data segment. This segment is + * filled with data from the current process. Since the contents of + * various sections refer to sections by index, the new .data segment + * is made the last in the table to avoid changing any existing index. + + * This is an example of how the section headers are changed. "Addr" + * is a process virtual address. "Offset" is a file offset. + +raid:/nfs/raid/src/dist-18.56/src> dump -h temacs + +temacs: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 8 3 0x80a98f4 0x608f4 0x449c .bss + 0 0 0x4 0 + +[17] 2 0 0 0x608f4 0x9b90 .symtab + 18 371 0x4 0x10 + +[18] 3 0 0 0x6a484 0x8526 .strtab + 0 0 0x1 0 + +[19] 3 0 0 0x729aa 0x93 .shstrtab + 0 0 0x1 0 + +[20] 1 0 0 0x72a3d 0x68b7 .comment + 0 0 0x1 0 + +raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs + +xemacs: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 + +[17] 2 0 0 0x7d800 0x9b90 .symtab + 18 371 0x4 0x10 + +[18] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 + +[19] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 + +[20] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 + +[21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 + + * This is an example of how the file header is changed. "Shoff" is + * the section header offset within the file. Since that table is + * after the new .data section, it is moved. "Shnum" is the number of + * sections, which we increment. + * + * "Phoff" is the file offset to the program header. "Phentsize" and + * "Shentsz" are the program and section header entries sizes respectively. + * These can be larger than the apparent struct sizes. + +raid:/nfs/raid/src/dist-18.56/src> dump -f temacs + +temacs: + + **** ELF HEADER **** +Class Data Type Machine Version +Entry Phoff Shoff Flags Ehsize +Phentsize Phnum Shentsz Shnum Shstrndx + +1 1 2 3 1 +0x80499cc 0x34 0x792f4 0 0x34 +0x20 5 0x28 21 19 + +raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs + +xemacs: + + **** ELF HEADER **** +Class Data Type Machine Version +Entry Phoff Shoff Flags Ehsize +Phentsize Phnum Shentsz Shnum Shstrndx + +1 1 2 3 1 +0x80499cc 0x34 0x96200 0 0x34 +0x20 5 0x28 22 19 + + * These are the program headers. "Offset" is the file offset to the + * segment. "Vaddr" is the memory load address. "Filesz" is the + * segment size as it appears in the file, and "Memsz" is the size in + * memory. Below, the third segment is the code and the fourth is the + * data: the difference between Filesz and Memsz is .bss + +raid:/nfs/raid/src/dist-18.56/src> dump -o temacs + +temacs: + ***** PROGRAM EXECUTION HEADER ***** +Type Offset Vaddr Paddr +Filesz Memsz Flags Align + +6 0x34 0x8048034 0 +0xa0 0xa0 5 0 + +3 0xd4 0 0 +0x13 0 4 0 + +1 0x34 0x8048034 0 +0x3f2f9 0x3f2f9 5 0x1000 + +1 0x3f330 0x8088330 0 +0x215c4 0x25a60 7 0x1000 + +2 0x60874 0x80a9874 0 +0x80 0 7 0 + +raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs + +xemacs: + ***** PROGRAM EXECUTION HEADER ***** +Type Offset Vaddr Paddr +Filesz Memsz Flags Align + +6 0x34 0x8048034 0 +0xa0 0xa0 5 0 + +3 0xd4 0 0 +0x13 0 4 0 + +1 0x34 0x8048034 0 +0x3f2f9 0x3f2f9 5 0x1000 + +1 0x3f330 0x8088330 0 +0x3e4d0 0x3e4d0 7 0x1000 + +2 0x60874 0x80a9874 0 +0x80 0 7 0 + + + */ + +/* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. + * + * The above mechanism does not work if the unexeced ELF file is being + * re-layout by other applications (such as `strip'). All the applications + * that re-layout the internal of ELF will layout all sections in ascending + * order of their file offsets. After the re-layout, the data2 section will + * still be the LAST section in the section header vector, but its file offset + * is now being pushed far away down, and causes part of it not to be mapped + * in (ie. not covered by the load segment entry in PHDR vector), therefore + * causes the new binary to fail. + * + * The solution is to modify the unexec algorithm to insert the new data2 + * section header right before the new bss section header, so their file + * offsets will be in the ascending order. Since some of the section's (all + * sections AFTER the bss section) indexes are now changed, we also need to + * modify some fields to make them point to the right sections. This is done + * by macro PATCH_INDEX. All the fields that need to be patched are: + * + * 1. ELF header e_shstrndx field. + * 2. section header sh_link and sh_info field. + * 3. symbol table entry st_shndx field. + * + * The above example now should look like: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 + +[17] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 + +[18] 2 0 0 0x7d800 0x9b90 .symtab + 19 371 0x4 0x10 + +[19] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 + +[20] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 + +[21] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 + + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include /* for HDRR declaration */ +#include + +#ifndef emacs +#define fatal(a, b, c) fprintf(stderr, a, b, c), exit(1) +#else +fatal() +{exit(1);} +#endif + +/* Get the address of a particular section or program header entry, + * accounting for the size of the entries. + */ + +#define OLD_SECTION_H(n) \ + (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) +#define NEW_SECTION_H(n) \ + (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) +#define OLD_PROGRAM_H(n) \ + (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) +#define NEW_PROGRAM_H(n) \ + (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) + +#define PATCH_INDEX(n) \ + do { \ + if ((n) >= old_bss_index) \ + (n)++; } while (0) +typedef unsigned char byte; + +/* Round X up to a multiple of Y. */ + +int +round_up (x, y) + int x, y; +{ + int rem = x % y; + if (rem == 0) + return x; + return x - rem + y; +} + +/* **************************************************************** + * unexec + * + * driving logic. + * + * In ELF, this works by replacing the old .bss section with a new + * .data section, and inserting an empty .bss immediately afterwards. + * + */ +void +unexec (new_name, old_name, data_start, bss_start, entry_address) + char *new_name, *old_name; + unsigned data_start, bss_start, entry_address; +{ +/* extern unsigned int bss_end; */ + int new_file, old_file, new_file_size; + + /* Pointers to the base of the image of the two files. */ + caddr_t old_base, new_base; + + /* Pointers to the file, program and section headers for the old and new + files. */ + Elf32_Ehdr *old_file_h, *new_file_h; + Elf32_Phdr *old_program_h, *new_program_h; + Elf32_Shdr *old_section_h, *new_section_h; + + /* Point to the section name table in the old file. */ + char *old_section_names; + + Elf32_Addr old_bss_addr, new_bss_addr; + Elf32_Word old_bss_size, new_data2_size; + Elf32_Off new_data2_offset; + Elf32_Addr new_data2_addr; + + int n, nn, old_bss_index, old_data_index, new_data2_index; + int old_mdebug_index; + struct stat stat_buf; + + /* Open the old file & map it into the address space. */ + + old_file = open (old_name, O_RDONLY); + + if (old_file < 0) + fatal ("Can't open %s for reading: errno %d\n", old_name, errno); + + if (fstat (old_file, &stat_buf) == -1) + fatal ("Can't fstat(%s): errno %d\n", old_name, errno); + + old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); + + if (old_base == (caddr_t) -1) + fatal ("Can't mmap(%s): errno %d\n", old_name, errno); + +#ifdef DEBUG + fprintf (stderr, "mmap(%s, %x) -> %x\n", old_name, stat_buf.st_size, + old_base); +#endif + + /* Get pointers to headers & section names. */ + + old_file_h = (Elf32_Ehdr *) old_base; + old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff); + old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff); + old_section_names + = (char *) old_base + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; + + /* Find the mdebug section, if any. */ + for (old_mdebug_index = 1; old_mdebug_index < old_file_h->e_shnum; old_mdebug_index++) + { +#ifdef DEBUG + fprintf (stderr, "Looking for .mdebug - found %s\n", + old_section_names + OLD_SECTION_H(old_mdebug_index).sh_name); +#endif + if (!strcmp (old_section_names + OLD_SECTION_H(old_mdebug_index).sh_name, + ".mdebug")) + break; + } + if (old_mdebug_index == old_file_h->e_shnum) + old_mdebug_index = -1; /* just means no such section was present */ + + /* Find the old .bss section. Figure out parameters of the new + data2 and bss sections. */ + + for (old_bss_index = 1; old_bss_index < old_file_h->e_shnum; old_bss_index++) + { +#ifdef DEBUG + fprintf (stderr, "Looking for .bss - found %s\n", + old_section_names + OLD_SECTION_H(old_bss_index).sh_name); +#endif + if (!strcmp (old_section_names + OLD_SECTION_H(old_bss_index).sh_name, + ".bss")) + break; + } + if (old_bss_index == old_file_h->e_shnum) + fatal ("Can't find .bss in %s.\n", old_name, 0); + + old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; + old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; +#if defined(emacs) || !defined(DEBUG) + bss_end = (unsigned int) sbrk (0); + new_bss_addr = (Elf32_Addr) bss_end; +#else + new_bss_addr = old_bss_addr + old_bss_size + 0x1234; +#endif + new_data2_addr = old_bss_addr; + new_data2_size = new_bss_addr - old_bss_addr; + new_data2_offset = OLD_SECTION_H (old_bss_index).sh_offset; + +#ifdef DEBUG + fprintf (stderr, "old_bss_index %d\n", old_bss_index); + fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); + fprintf (stderr, "old_bss_size %x\n", old_bss_size); + fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); + fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); + fprintf (stderr, "new_data2_size %x\n", new_data2_size); + fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); +#endif + + if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) + fatal (".bss shrank when undumping???\n", 0, 0); + + /* Set the output file to the right size and mmap it. Set + pointers to various interesting objects. stat_buf still has + old_file data. */ + + new_file = open (new_name, O_RDWR | O_CREAT, 0666); + if (new_file < 0) + fatal ("Can't creat (%s): errno %d\n", new_name, errno); + + new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size; + + if (ftruncate (new_file, new_file_size)) + fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); + + new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED, + new_file, 0); + + if (new_base == (caddr_t) -1) + fatal ("Can't mmap (%s): errno %d\n", new_name, errno); + + new_file_h = (Elf32_Ehdr *) new_base; + new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff); + new_section_h + = (Elf32_Shdr *) ((byte *) new_base + old_file_h->e_shoff + + new_data2_size); + + /* Make our new file, program and section headers as copies of the + originals. */ + + memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); + memcpy (new_program_h, old_program_h, + old_file_h->e_phnum * old_file_h->e_phentsize); + + /* Modify the e_shstrndx if necessary. */ + PATCH_INDEX (new_file_h->e_shstrndx); + + /* Fix up file header. We'll add one section. Section header is + further away now. */ + + new_file_h->e_shoff += new_data2_size; + new_file_h->e_shnum += 1; + +#ifdef DEBUG + fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); + fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); + fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); + fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); +#endif + + /* Fix up a new program header. Extend the writable data segment so + that the bss area is covered too. Find that segment by looking + for a segment that ends just before the .bss area. Make sure + that no segments are above the new .data2. Put a loop at the end + to adjust the offset and address of any segment that is above + data2, just in case we decide to allow this later. */ + + for (n = new_file_h->e_phnum - 1; n >= 0; n--) + { + /* Compute maximum of all requirements for alignment of section. */ + int alignment = (NEW_PROGRAM_H (n)).p_align; + if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) + alignment = OLD_SECTION_H (old_bss_index).sh_addralign; + + /* Supposedly this condition is okay for the SGI. */ +#if 0 + if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr) + fatal ("Program segment above .bss in %s\n", old_name, 0); +#endif + + if (NEW_PROGRAM_H (n).p_type == PT_LOAD + && (round_up ((NEW_PROGRAM_H (n)).p_vaddr + + (NEW_PROGRAM_H (n)).p_filesz, + alignment) + == round_up (old_bss_addr, alignment))) + break; + } + if (n < 0) + fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0); + + NEW_PROGRAM_H (n).p_filesz += new_data2_size; + NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; + +#if 1 /* Maybe allow section after data2 - does this ever happen? */ + for (n = new_file_h->e_phnum - 1; n >= 0; n--) + { + if (NEW_PROGRAM_H (n).p_vaddr + && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr) + NEW_PROGRAM_H (n).p_vaddr += new_data2_size - old_bss_size; + + if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset) + NEW_PROGRAM_H (n).p_offset += new_data2_size; + } +#endif + + /* Fix up section headers based on new .data2 section. Any section + whose offset or virtual address is after the new .data2 section + gets its value adjusted. .bss size becomes zero and new address + is set. data2 section header gets added by copying the existing + .data header and modifying the offset, address and size. */ + for (old_data_index = 1; old_data_index < old_file_h->e_shnum; + old_data_index++) + if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name, + ".data")) + break; + if (old_data_index == old_file_h->e_shnum) + fatal ("Can't find .data in %s.\n", old_name, 0); + + /* Walk through all section headers, insert the new data2 section right + before the new bss section. */ + for (n = 1, nn = 1; n < old_file_h->e_shnum; n++, nn++) + { + caddr_t src; + /* If it is bss section, insert the new data2 section before it. */ + if (n == old_bss_index) + { + /* Steal the data section header for this data2 section. */ + memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index), + new_file_h->e_shentsize); + + NEW_SECTION_H (nn).sh_addr = new_data2_addr; + NEW_SECTION_H (nn).sh_offset = new_data2_offset; + NEW_SECTION_H (nn).sh_size = new_data2_size; + /* Use the bss section's alignment. This will assure that the + new data2 section always be placed in the same spot as the old + bss section by any other application. */ + NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign; + + /* Now copy over what we have in the memory now. */ + memcpy (NEW_SECTION_H (nn).sh_offset + new_base, + (caddr_t) OLD_SECTION_H (n).sh_addr, + new_data2_size); + nn++; + } + + memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), + old_file_h->e_shentsize); + + /* The new bss section's size is zero, and its file offset and virtual + address should be off by NEW_DATA2_SIZE. */ + if (n == old_bss_index) + { + /* NN should be `old_bss_index + 1' at this point. */ + NEW_SECTION_H (nn).sh_offset += new_data2_size; + NEW_SECTION_H (nn).sh_addr += new_data2_size; + /* Let the new bss section address alignment be the same as the + section address alignment followed the old bss section, so + this section will be placed in exactly the same place. */ + NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign; + NEW_SECTION_H (nn).sh_size = 0; + } + /* Any section that was original placed AFTER the bss section should now + be off by NEW_DATA2_SIZE. */ + else if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) + NEW_SECTION_H (nn).sh_offset += new_data2_size; + + /* If any section hdr refers to the section after the new .data + section, make it refer to next one because we have inserted + a new section in between. */ + + PATCH_INDEX (NEW_SECTION_H (nn).sh_link); + /* For symbol tables, info is a symbol table index, + so don't change it. */ + if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB + && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM) + PATCH_INDEX (NEW_SECTION_H (nn).sh_info); + + /* Now, start to copy the content of sections. */ + if (NEW_SECTION_H (nn).sh_type == SHT_NULL + || NEW_SECTION_H (nn).sh_type == SHT_NOBITS) + continue; + + /* Write out the sections. .data and .data1 (and data2, called + ".data" in the strings table) get copied from the current process + instead of the old file. */ + if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".data1")) + src = (caddr_t) OLD_SECTION_H (n).sh_addr; + else + src = old_base + OLD_SECTION_H (n).sh_offset; + + memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src, + NEW_SECTION_H (nn).sh_size); + + /* Adjust the HDRR offsets in .mdebug and copy the + line data if it's in its usual 'hole' in the object. + Makes the new file debuggable with dbx. + patches up two problems: the absolute file offsets + in the HDRR record of .mdebug (see /usr/include/syms.h), and + the ld bug that gets the line table in a hole in the + elf file rather than in the .mdebug section proper. + David Anderson. davea@sgi.com Jan 16,1994. */ + if (n == old_mdebug_index) + { +#define MDEBUGADJUST(__ct,__fileaddr) \ + if (n_phdrr->__ct > 0) \ + { \ + n_phdrr->__fileaddr += movement; \ + } + + HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset); + HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset); + unsigned movement = new_data2_size; + + MDEBUGADJUST (idnMax, cbDnOffset); + MDEBUGADJUST (ipdMax, cbPdOffset); + MDEBUGADJUST (isymMax, cbSymOffset); + MDEBUGADJUST (ioptMax, cbOptOffset); + MDEBUGADJUST (iauxMax, cbAuxOffset); + MDEBUGADJUST (issMax, cbSsOffset); + MDEBUGADJUST (issExtMax, cbSsExtOffset); + MDEBUGADJUST (ifdMax, cbFdOffset); + MDEBUGADJUST (crfd, cbRfdOffset); + MDEBUGADJUST (iextMax, cbExtOffset); + /* The Line Section, being possible off in a hole of the object, + requires special handling. */ + if (n_phdrr->cbLine > 0) + { + if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset + + OLD_SECTION_H (n).sh_size)) + { + /* line data is in a hole in elf. do special copy and adjust + for this ld mistake. + */ + n_phdrr->cbLineOffset += movement; + + memcpy (n_phdrr->cbLineOffset + new_base, + o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine); + } + else + { + /* somehow line data is in .mdebug as it is supposed to be. */ + MDEBUGADJUST (cbLine, cbLineOffset); + } + } + } + + /* If it is the symbol table, its st_shndx field needs to be patched. */ + if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB + || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM) + { + Elf32_Shdr *spt = &NEW_SECTION_H (nn); + unsigned int num = spt->sh_size / spt->sh_entsize; + Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset + + new_base); + for (; num--; sym++) + { + if (sym->st_shndx == SHN_UNDEF + || sym->st_shndx == SHN_ABS + || sym->st_shndx == SHN_COMMON) + continue; + + PATCH_INDEX (sym->st_shndx); + } + } + } + + /* Close the files and make the new file executable. */ + + if (close (old_file)) + fatal ("Can't close (%s): errno %d\n", old_name, errno); + + if (close (new_file)) + fatal ("Can't close (%s): errno %d\n", new_name, errno); + + if (stat (new_name, &stat_buf) == -1) + fatal ("Can't stat (%s): errno %d\n", new_name, errno); + + n = umask (777); + umask (n); + stat_buf.st_mode |= 0111 & ~n; + if (chmod (new_name, stat_buf.st_mode) == -1) + fatal ("Can't chmod (%s): errno %d\n", new_name, errno); +} + + + +#ifdef UNIXSAVE +#include "save.c" +#endif diff --git a/o/unexhp9k800.c b/o/unexhp9k800.c new file mode 100755 index 0000000..1d974b7 --- /dev/null +++ b/o/unexhp9k800.c @@ -0,0 +1,310 @@ +/* Unexec for HP 9000 Series 800 machines. + Bob Desinger + + Note that the GNU project considers support for HP operation a + peripheral activity which should not be allowed to divert effort + from development of the GNU system. Changes in this code will be + installed when users send them in, but aside from that we don't + plan to think about it, or about whether other Emacs maintenance + might break it. + + + Unexec creates a copy of the old a.out file, and replaces the old data + area with the current data area. When the new file is executed, the + process will see the same data structures and data values that the + original process had when unexec was called. + + Unlike other versions of unexec, this one copies symbol table and + debug information to the new a.out file. Thus, the new a.out file + may be debugged with symbolic debuggers. + + If you fix any bugs in this, I'd like to incorporate your fixes. + Send them to uunet!hpda!hpsemc!jmorris or jmorris%hpsemc@hplabs.HP.COM. + + CAVEATS: + This routine saves the current value of all static and external + variables. This means that any data structure that needs to be + initialized must be explicitly reset. Variables will not have their + expected default values. + + Unfortunately, the HP-UX signal handler has internal initialization + flags which are not explicitly reset. Thus, for signals to work in + conjunction with this routine, the following code must executed when + the new process starts up. + + void _sigreturn(); + ... + sigsetreturn(_sigreturn); +*/ + +#include +#include +#include + +#include + +#define NBPG 2048 +#define roundup(x,n) ( ( (x)+(n-1) ) & ~(n-1) ) /* n is power of 2 */ +#define min(x,y) ( ((x)<(y))?(x):(y) ) + + +/* Create a new a.out file, same as old but with current data space */ + +unexec(new_name, old_name, new_end_of_text, dummy1, dummy2) + char new_name[]; /* name of the new a.out file to be created */ + char old_name[]; /* name of the old a.out file */ + char *new_end_of_text; /* ptr to new edata/etext; NOT USED YET */ + int dummy1, dummy2; /* not used by emacs */ +{ + int old, new; + int old_size, new_size; + struct header hdr; + struct som_exec_auxhdr auxhdr; + char stdin_buf[BUFSIZ],stdout_buf[BUFSIZ]; + FILE *original,*tem; + + /* For the greatest flexibility, should create a temporary file in + the same directory as the new file. When everything is complete, + rename the temp file to the new name. + This way, a program could update its own a.out file even while + it is still executing. If problems occur, everything is still + intact. NOT implemented. */ + + /* Open the input and output a.out files */ + _cleanup(); + fclose(stdin); + old = open(old_name, O_RDONLY); + if (old < 0) + { perror(old_name); exit(1); } + if ( old < 0) + {perror("can't open in"); exit(1);} + printf("(%d = old) \n",old); + tem = fdopen(old,"r"); + setbuf(tem,stdin_buf); + fflush(stdout); + fclose(stdout); + new = open(new_name, O_CREAT|O_RDWR|O_TRUNC, 0777); + if (new < 0) + { perror(new_name); exit(1); } + tem = fdopen(new,"w"); + setbuf(tem,stdout_buf); + /* Read the old headers */ + read_header(old, &hdr, &auxhdr); + + /* Decide how large the new and old data areas are */ + old_size = auxhdr.exec_dsize; + new_size = (int)sbrk(0) - auxhdr.exec_dmem; + + /* Copy the old file to the new, up to the data space */ + lseek(old, 0, 0); + copy_file(old, new, auxhdr.exec_dfile); + + /* Skip the old data segment and write a new one */ + lseek(old, old_size, 1); + + save_data_space(new, &hdr, &auxhdr, new_size); + + /* Copy the rest of the file */ + copy_rest(old, new); + + /* Update file pointers since we probably changed size of data area */ + update_file_ptrs(new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size); + + /* Save the modified header */ + write_header(new, &hdr, &auxhdr); + + /* Close the binary file */ + close(old); + close(new); + exit(0); +} + +/* Save current data space in the file, update header. */ + +save_data_space(file, hdr, auxhdr, size) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; + int size; +{ + /* Write the entire data space out to the file */ + if (write(file, auxhdr->exec_dmem, size) != size) + { perror("Can't save new data space"); exit(1); } + + /* Update the header to reflect the new data size */ + auxhdr->exec_dsize = size; + auxhdr->exec_bsize = 0; +} + +/* Update the values of file pointers when something is inserted. */ + +update_file_ptrs(file, hdr, auxhdr, location, offset) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; + unsigned int location; + int offset; +{ + struct subspace_dictionary_record subspace; + int i; + + /* Increase the overall size of the module */ + hdr->som_length += offset; + + /* Update the various file pointers in the header */ +#define update(ptr) if (ptr > location) ptr = ptr + offset + update(hdr->aux_header_location); + update(hdr->space_strings_location); + update(hdr->init_array_location); + update(hdr->compiler_location); + update(hdr->symbol_location); + update(hdr->fixup_request_location); + update(hdr->symbol_strings_location); + update(hdr->unloadable_sp_location); + update(auxhdr->exec_tfile); + update(auxhdr->exec_dfile); + + /* Do for each subspace dictionary entry */ + lseek(file, hdr->subspace_location, 0); + for (i = 0; i < hdr->subspace_total; i++) + { + if (read(file, &subspace, sizeof(subspace)) != sizeof(subspace)) + { perror("Can't read subspace record"); exit(1); } + + /* If subspace has a file location, update it */ + if (subspace.initialization_length > 0 + && subspace.file_loc_init_value > location) + { + subspace.file_loc_init_value += offset; + lseek(file, -sizeof(subspace), 1); + if (write(file, &subspace, sizeof(subspace)) != sizeof(subspace)) + { perror("Can't update subspace record"); exit(1); } + } + } + + /* Do for each initialization pointer record */ + /* (I don't think it applies to executable files, only relocatables) */ +#undef update +} + +/* Read in the header records from an a.out file. */ + +read_header(file, hdr, auxhdr) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; +{ + + /* Read the header in */ + lseek(file, 0, 0); + if (read(file, hdr, sizeof(*hdr)) != sizeof(*hdr)) + { perror("Couldn't read header from a.out file"); exit(1); } + + if (hdr->a_magic != EXEC_MAGIC && hdr->a_magic != SHARE_MAGIC + && hdr->a_magic != DEMAND_MAGIC) + { + fprintf(stderr, "a.out file doesn't have legal magic number\n"); + exit(1); + } + + lseek(file, hdr->aux_header_location, 0); + if (read(file, auxhdr, sizeof(*auxhdr)) != sizeof(*auxhdr)) + { + perror("Couldn't read auxiliary header from a.out file"); + exit(1); + } +} + +/* Write out the header records into an a.out file. */ + +write_header(file, hdr, auxhdr) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; +{ + /* Update the checksum */ + hdr->checksum = calculate_checksum(hdr); + + /* Write the header back into the a.out file */ + lseek(file, 0, 0); + if (write(file, hdr, sizeof(*hdr)) != sizeof(*hdr)) + { perror("Couldn't write header to a.out file"); exit(1); } + lseek(file, hdr->aux_header_location, 0); + if (write(file, auxhdr, sizeof(*auxhdr)) != sizeof(*auxhdr)) + { perror("Couldn't write auxiliary header to a.out file"); exit(1); } +} + +/* Calculate the checksum of a SOM header record. */ + +calculate_checksum(hdr) + struct header *hdr; +{ + int checksum, i, *ptr; + + checksum = 0; ptr = (int *) hdr; + + for (i=0; i 0; size -= len) + { + len = min(size, sizeof(buffer)); + if (read(old, buffer, len) != len) + { perror("Read failure on a.out file"); exit(1); } + if (write(new, buffer, len) != len) + { perror("Write failure in a.out file"); exit(1); } + } +} + +/* Copy the rest of the file, up to EOF. */ + +copy_rest(old, new) + int new, old; +{ + int buffer[4096]; + int len; + + /* Copy bytes until end of file or error */ + while ( (len = read(old, buffer, sizeof(buffer))) > 0) + if (write(new, buffer, len) != len) break; + + if (len != 0) + { perror("Unable to copy the rest of the file"); exit(1); } +} + +#ifdef DEBUG +display_header(hdr, auxhdr) + struct header *hdr; + struct som_exec_auxhdr *auxhdr; +{ + /* Display the header information (debug) */ + printf("\n\nFILE HEADER\n"); + printf("magic number %d \n", hdr->a_magic); + printf("text loc %.8x size %d \n", auxhdr->exec_tmem, auxhdr->exec_tsize); + printf("data loc %.8x size %d \n", auxhdr->exec_dmem, auxhdr->exec_dsize); + printf("entry %x \n", auxhdr->exec_entry); + printf("Bss segment size %u\n", auxhdr->exec_bsize); + printf("\n"); + printf("data file loc %d size %d\n", + auxhdr->exec_dfile, auxhdr->exec_dsize); + printf("som_length %d\n", hdr->som_length); + printf("unloadable sploc %d size %d\n", + hdr->unloadable_sp_location, hdr->unloadable_sp_size); +} +#endif /* DEBUG */ + +#ifdef UNIXSAVE +#include "save.c" +#endif diff --git a/o/unexlin.c b/o/unexlin.c new file mode 100755 index 0000000..c8008e2 --- /dev/null +++ b/o/unexlin.c @@ -0,0 +1,969 @@ +/* Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 1, 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 Library General Public License for more details. + + You should have received a copy of the GNU Library General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +In other words, you are welcome to use, share and improve this program. +You are forbidden to forbid anyone else to use, share and improve +what you give them. Help stamp out software-hoarding! */ + +/* MODIFIED by M. Frigo (6 Mar 1993) to work with the linux port + * of akcl-1-615 + */ + +/* + * unexec.c - Convert a running program into an a.out file. + * + * Author: Spencer W. Thomas + * Computer Science Dept. + * University of Utah + * Date: Tue Mar 2 1982 + * Modified heavily since then. + * + * Synopsis: + * unexec (new_name, a_name, data_start, bss_start, entry_address) + * char *new_name, *a_name; + * unsigned data_start, bss_start, entry_address; + * + * Takes a snapshot of the program and makes an a.out format file in the + * file named by the string argument new_name. + * If a_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing a_name file is required. + * + * The boundaries within the a.out file may be adjusted with the data_start + * and bss_start arguments. Either or both may be given as 0 for defaults. + * + * Data_start gives the boundary between the text segment and the data + * segment of the program. The text segment can contain shared, read-only + * program code and literal data, while the data segment is always unshared + * and unprotected. Data_start gives the lowest unprotected address. + * The value you specify may be rounded down to a suitable boundary + * as required by the machine you are using. + * + * Specifying zero for data_start means the boundary between text and data + * should not be the same as when the program was loaded. + * If NO_REMAP is defined, the argument data_start is ignored and the + * segment boundaries are never changed. + * + * Bss_start indicates how much of the data segment is to be saved in the + * a.out file and restored when the program is executed. It gives the lowest + * unsaved address, and is rounded up to a page boundary. The default when 0 + * is given assumes that the entire data segment is to be stored, including + * the previous data and bss as well as any additional storage allocated with + * break (2). + * + * The new file is set up to start at entry_address. + * + * If you make improvements I'd like to get them too. + * harpo!utah-cs!thomas, thomas@Utah-20 + * + */ + +/* Modified to support SysVr3 shared libraries by James Van Artsdalen + * of Dell Computer Corporation. james@bigtex.cactus.org. + */ + +/* There are several compilation parameters affecting unexec: + +* COFF + +Define this if your system uses COFF for executables. +Otherwise we assume you use Berkeley format. + +* NO_REMAP + +Define this if you do not want to try to save Emacs's pure data areas +as part of the text segment. + +Saving them as text is good because it allows users to share more. + +However, on machines that locate the text area far from the data area, +the boundary cannot feasibly be moved. Such machines require +NO_REMAP. + +Also, remapping can cause trouble with the built-in startup routine +/lib/crt0.o, which defines `environ' as an initialized variable. +Dumping `environ' as pure does not work! So, to use remapping, +you must write a startup routine for your machine in Emacs's crt0.c. +If NO_REMAP is defined, Emacs uses the system's crt0.o. + +* SECTION_ALIGNMENT + +Some machines that use COFF executables require that each section +start on a certain boundary *in the COFF file*. Such machines should +define SECTION_ALIGNMENT to a mask of the low-order bits that must be +zero on such a boundary. This mask is used to control padding between +segments in the COFF file. + +If SECTION_ALIGNMENT is not defined, the segments are written +consecutively with no attempt at alignment. This is right for +unmodified system V. + +* SEGMENT_MASK + +Some machines require that the beginnings and ends of segments +*in core* be on certain boundaries. For most machines, a page +boundary is sufficient. That is the default. When a larger +boundary is needed, define SEGMENT_MASK to a mask of +the bits that must be zero on such a boundary. + +* A_TEXT_OFFSET(HDR) + +Some machines count the a.out header as part of the size of the text +segment (a_text); they may actually load the header into core as the +first data in the text segment. Some have additional padding between +the header and the real text of the program that is counted in a_text. + +For these machines, define A_TEXT_OFFSET(HDR) to examine the header +structure HDR and return the number of bytes to add to `a_text' +before writing it (above and beyond the number of bytes of actual +program text). HDR's standard fields are already correct, except that +this adjustment to the `a_text' field has not yet been made; +thus, the amount of offset can depend on the data in the file. + +* A_TEXT_SEEK(HDR) + +If defined, this macro specifies the number of bytes to seek into the +a.out file before starting to write the text segment.a + +* EXEC_MAGIC + +For machines using COFF, this macro, if defined, is a value stored +into the magic number field of the output file. + +* ADJUST_EXEC_HEADER + +This macro can be used to generate statements to adjust or +initialize nonstandard fields in the file header + +* ADDR_CORRECT(ADDR) + +Macro to correct an int which is the bit pattern of a pointer to a byte +into an int which is the number of a byte. + +This macro has a default definition which is usually right. +This default definition is a no-op on most machines (where a +pointer looks like an int) but not on all machines. + +*/ + +#ifndef emacs +#define PERROR(arg) perror (arg); return -1 +#else +#include "config.h" +#define PERROR(file) report_error (file, new) +#endif + +#ifndef CANNOT_DUMP /* all rest of file! */ + +#ifndef CANNOT_UNEXEC /* most of rest of file */ + +#include +/* Define getpagesize () if the system does not. + Note that this may depend on symbols defined in a.out.h + */ + +#ifndef makedev /* Try to detect types.h already loaded */ +#include +#endif +#include +#include +#include + +extern char *start_of_text (); /* Start of text */ +extern char *start_of_data (); /* Start of initialized data */ +#define start_of_data() &etext +#define start_of_text() ( (char *) 0 ) +extern char etext; + +static int make_hdr (int new, int a_out, unsigned int data_start, unsigned int bss_start, unsigned int entry_address, char *a_name, char *new_name), copy_text_and_data (int new, int a_out), copy_sym (int new, int a_out, char *a_name, char *new_name); +static int mark_x (char *name); + +#ifdef COFF +#ifndef USG +#ifndef STRIDE +#ifndef UMAX +#ifndef sun386 +/* I have a suspicion that these are turned off on all systems + and can be deleted. Try it in version 19. */ +#include +#include +#include +#include +#endif /* not sun386 */ +#endif /* not UMAX */ +#endif /* Not STRIDE */ +#endif /* not USG */ +static long block_copy_start; /* Old executable start point */ +static struct filehdr f_hdr; /* File header */ +static struct aouthdr f_ohdr; /* Optional file header (a.out) */ +long bias; /* Bias to add for growth */ +long lnnoptr; /* Pointer to line-number info within file */ +#define SYMS_START block_copy_start + +static long text_scnptr; +static long data_scnptr; + +#else /* not COFF */ + +#define SYMS_START ((long) N_SYMOFF (ohdr)) + +/* Some machines override the structure name for an a.out header. */ +#ifndef EXEC_HDR_TYPE +#define EXEC_HDR_TYPE struct exec +#endif + +#ifdef HPUX +#ifdef HP9000S200_ID +#define MY_ID HP9000S200_ID +#else +#include +#define MY_ID MYSYS +#endif /* no HP9000S200_ID */ +static MAGIC OLDMAGIC = {MY_ID, SHARE_MAGIC}; +static MAGIC NEWMAGIC = {MY_ID, DEMAND_MAGIC}; +#define N_TXTOFF(x) TEXT_OFFSET(x) +#define N_SYMOFF(x) LESYM_OFFSET(x) +static EXEC_HDR_TYPE hdr, ohdr; + +#else /* not HPUX */ + +extern char *sbrk (int n); + +#if defined (USG) && !defined (IBMRTAIX) && !defined (IRIS) && !defined(linux) +static struct bhdr hdr, ohdr; +#define a_magic fmagic +#define a_text tsize +#define a_data dsize +#define a_bss bsize +#define a_syms ssize +#define a_trsize rtsize +#define a_drsize rdsize +#define a_entry entry +#define N_BADMAG(x) \ + (((x).fmagic)!=OMAGIC && ((x).fmagic)!=NMAGIC &&\ + ((x).fmagic)!=FMAGIC && ((x).fmagic)!=IMAGIC) +#define NEWMAGIC FMAGIC +#else /* IRIS or IBMRTAIX or not USG */ +static EXEC_HDR_TYPE hdr, ohdr; +#define NEWMAGIC ZMAGIC +#endif /* IRIS or IBMRTAIX not USG */ +#endif /* not HPUX */ + +static int unexec_text_start; +static int unexec_data_start; + +#endif /* not COFF */ + +static int pagemask; + +/* Correct an int which is the bit pattern of a pointer to a byte + into an int which is the number of a byte. + This is a no-op on ordinary machines, but not on all. */ + +#ifndef ADDR_CORRECT /* Let m-*.h files override this definition */ +#define ADDR_CORRECT(x) ((char *)(x) - (char*)0) +#endif + +#ifdef emacs + +static +report_error (file, fd) + char *file; + int fd; +{ + if (fd) + close (fd); + error ("Failure operating on %s", file); +} +#endif /* emacs */ + +#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 +#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 +#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 + +static +report_error_1 (int fd, char *msg, int a1, int a2) +{ + close (fd); +#ifdef emacs + error (msg, a1, a2); +#else + fprintf (stderr, msg, a1, a2); + fprintf (stderr, "\n"); +#endif +} + +/* **************************************************************** + * unexec + * + * driving logic. + */ +unexec (char *new_name, char *a_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address) +{ + int new, a_out = -1; + + if (a_name && (a_out = open (a_name, 0)) < 0) + { + PERROR (a_name); + } + if ((new = creat (new_name, 0666)) < 0) + { + PERROR (new_name); + } + + if (make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) < 0 + || copy_text_and_data (new, a_out) < 0 + || copy_sym (new, a_out, a_name, new_name) < 0 +#ifdef COFF + || adjust_lnnoptrs (new, a_out, new_name) < 0 +#endif + ) + { + close (new); + /* unlink (new_name); /* Failed, unlink new a.out */ + return -1; + } + + close (new); + if (a_out >= 0) + close (a_out); + return mark_x (new_name); +} + +/* **************************************************************** + * make_hdr + * + * Make the header in the new a.out from the header in core. + * Modify the text and data sizes. + */ +static int +make_hdr (int new, int a_out, unsigned int data_start, unsigned int bss_start, unsigned int entry_address, char *a_name, char *new_name) +{ + int tem; +#ifdef COFF + auto struct scnhdr f_thdr; /* Text section header */ + auto struct scnhdr f_dhdr; /* Data section header */ + auto struct scnhdr f_bhdr; /* Bss section header */ + auto struct scnhdr scntemp; /* Temporary section header */ + register int scns; +#endif /* COFF */ +#ifdef USG_SHARED_LIBRARIES + extern unsigned int bss_end; +#else + unsigned int bss_end; +#endif + + pagemask = getpagesize () - 1; + + /* Adjust text/data boundary. */ +#ifdef NO_REMAP + data_start = (int) start_of_data (); +#else /* not NO_REMAP */ + if (!data_start) + data_start = (int) start_of_data (); +#endif /* not NO_REMAP */ + data_start = ADDR_CORRECT (data_start); + +#ifdef SEGMENT_MASK + data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */ +#else + data_start = data_start & ~pagemask; /* (Down) to page boundary. */ +#endif + + bss_end = ADDR_CORRECT (sbrk (0)) + pagemask; + bss_end &= ~ pagemask; + + /* Adjust data/bss boundary. */ + if (bss_start != 0) + { + bss_start = (ADDR_CORRECT (bss_start) + pagemask); + /* (Up) to page bdry. */ + bss_start &= ~ pagemask; + if (bss_start > bss_end) + { + ERROR1 ("unexec: Specified bss_start (%u) is past end of program", + bss_start); + } + } + else + bss_start = bss_end; + + if (data_start > bss_start) /* Can't have negative data size. */ + { + ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", + data_start, bss_start); + } + +#ifdef COFF + /* Salvage as much info from the existing file as possible */ + if (a_out >= 0) + { + if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (a_name); + } + block_copy_start += sizeof (f_hdr); + if (f_hdr.f_opthdr > 0) + { + if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (a_name); + } + block_copy_start += sizeof (f_ohdr); + } + /* Loop through section headers, copying them in */ + for (scns = f_hdr.f_nscns; scns > 0; scns--) { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + { + PERROR (a_name); + } + if (scntemp.s_scnptr > 0L) + { + if (block_copy_start < scntemp.s_scnptr + scntemp.s_size) + block_copy_start = scntemp.s_scnptr + scntemp.s_size; + } + if (strcmp (scntemp.s_name, ".text") == 0) + { + f_thdr = scntemp; + } + else if (strcmp (scntemp.s_name, ".data") == 0) + { + f_dhdr = scntemp; + } + else if (strcmp (scntemp.s_name, ".bss") == 0) + { + f_bhdr = scntemp; + } + } + } + else + { + ERROR0 ("can't build a COFF file from scratch yet"); + } + + /* Now we alter the contents of all the f_*hdr variables + to correspond to what we want to dump. */ + +#ifdef USG_SHARED_LIBRARIES + + /* The amount of data we're adding to the file is distance from the + * end of the original .data space to the current end of the .data + * space. + */ + + bias = bss_end - (f_ohdr.data_start + f_dhdr.s_size); + +#endif + + f_hdr.f_flags |= (F_RELFLG | F_EXEC); +#ifdef TPIX + f_hdr.f_nscns = 3; +#endif +#ifdef EXEC_MAGIC + f_ohdr.magic = EXEC_MAGIC; +#endif +#ifndef NO_REMAP + f_ohdr.text_start = (long) start_of_text (); + f_ohdr.tsize = data_start - f_ohdr.text_start; + f_ohdr.data_start = data_start; +#endif /* NO_REMAP */ + f_ohdr.dsize = bss_start - f_ohdr.data_start; + f_ohdr.bsize = bss_end - bss_start; + f_thdr.s_size = f_ohdr.tsize; + f_thdr.s_scnptr = sizeof (f_hdr) + sizeof (f_ohdr); + f_thdr.s_scnptr += (f_hdr.f_nscns) * (sizeof (f_thdr)); + lnnoptr = f_thdr.s_lnnoptr; +#ifdef SECTION_ALIGNMENT + /* Some systems require special alignment + of the sections in the file itself. */ + f_thdr.s_scnptr + = (f_thdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; +#endif /* SECTION_ALIGNMENT */ +#ifdef TPIX + f_thdr.s_scnptr = 0xd0; +#endif + text_scnptr = f_thdr.s_scnptr; + f_dhdr.s_paddr = f_ohdr.data_start; + f_dhdr.s_vaddr = f_ohdr.data_start; + f_dhdr.s_size = f_ohdr.dsize; + f_dhdr.s_scnptr = f_thdr.s_scnptr + f_thdr.s_size; +#ifdef SECTION_ALIGNMENT + /* Some systems require special alignment + of the sections in the file itself. */ + f_dhdr.s_scnptr + = (f_dhdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; +#endif /* SECTION_ALIGNMENT */ +#ifdef DATA_SECTION_ALIGNMENT + /* Some systems require special alignment + of the data section only. */ + f_dhdr.s_scnptr + = (f_dhdr.s_scnptr + DATA_SECTION_ALIGNMENT) & ~DATA_SECTION_ALIGNMENT; +#endif /* DATA_SECTION_ALIGNMENT */ + data_scnptr = f_dhdr.s_scnptr; + f_bhdr.s_paddr = f_ohdr.data_start + f_ohdr.dsize; + f_bhdr.s_vaddr = f_ohdr.data_start + f_ohdr.dsize; + f_bhdr.s_size = f_ohdr.bsize; + f_bhdr.s_scnptr = 0L; +#ifndef USG_SHARED_LIBRARIES + bias = f_dhdr.s_scnptr + f_dhdr.s_size - block_copy_start; +#endif + + if (f_hdr.f_symptr > 0L) + { + f_hdr.f_symptr += bias; + } + + if (f_thdr.s_lnnoptr > 0L) + { + f_thdr.s_lnnoptr += bias; + } + +#ifdef ADJUST_EXEC_HEADER + ADJUST_EXEC_HEADER +#endif /* ADJUST_EXEC_HEADER */ + + if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) + { + PERROR (new_name); + } + + if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) + { + PERROR (new_name); + } + +#ifndef USG_SHARED_LIBRARIES + + if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) + { + PERROR (new_name); + } + + if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) + { + PERROR (new_name); + } + + if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) + { + PERROR (new_name); + } + +#else /* USG_SHARED_LIBRARIES */ + + /* The purpose of this code is to write out the new file's section + * header table. + * + * Scan through the original file's sections. If the encountered + * section is one we know (.text, .data or .bss), write out the + * correct header. If it is a section we do not know (such as + * .lib), adjust the address of where the section data is in the + * file, and write out the header. + * + * If any section preceeds .text or .data in the file, this code + * will not adjust the file pointer for that section correctly. + */ + + lseek (a_out, sizeof (f_hdr) + sizeof (f_ohdr), 0); + + for (scns = f_hdr.f_nscns; scns > 0; scns--) + { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR (a_name); + + if (!strcmp (scntemp.s_name, f_thdr.s_name)) /* .text */ + { + if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) + PERROR (new_name); + } + else if (!strcmp (scntemp.s_name, f_dhdr.s_name)) /* .data */ + { + if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) + PERROR (new_name); + } + else if (!strcmp (scntemp.s_name, f_bhdr.s_name)) /* .bss */ + { + if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) + PERROR (new_name); + } + else + { + if (scntemp.s_scnptr) + scntemp.s_scnptr += bias; + if (write (new, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR (new_name); + } + } +#endif /* USG_SHARED_LIBRARIES */ + + return (0); + +#else /* if not COFF */ + + /* Get symbol table info from header of a.out file if given one. */ + if (a_out >= 0) + { + if (read (a_out, &ohdr, sizeof hdr) != sizeof hdr) + { + PERROR (a_name); + } + + if (N_BADMAG (ohdr)) + { + ERROR1 ("invalid magic number in %s", a_name); + } + hdr = ohdr; + } + else + { + bzero (hdr, sizeof hdr); + } + + unexec_text_start = (long) start_of_text (); + unexec_data_start = data_start; + + /* Machine-dependent fixup for header, or maybe for unexec_text_start */ +#ifdef ADJUST_EXEC_HEADER + ADJUST_EXEC_HEADER; +#endif /* ADJUST_EXEC_HEADER */ + + hdr.a_trsize = 0; + hdr.a_drsize = 0; + if (entry_address != 0) + hdr.a_entry = entry_address; + + hdr.a_bss = bss_end - bss_start; + hdr.a_data = bss_start - data_start; +#ifdef NO_REMAP + hdr.a_text = ohdr.a_text; +#else /* not NO_REMAP */ + hdr.a_text = data_start - unexec_text_start; + +#ifdef A_TEXT_OFFSET + hdr.a_text += A_TEXT_OFFSET (ohdr); +#endif + +#endif /* not NO_REMAP */ + + if (write (new, &hdr, sizeof hdr) != sizeof hdr) + { + PERROR (new_name); + } + +#ifdef A_TEXT_OFFSET + hdr.a_text -= A_TEXT_OFFSET (ohdr); +#endif + + return 0; + +#endif /* not COFF */ +} + +/* **************************************************************** + * copy_text_and_data + * + * Copy the text and data segments from memory to the new a.out + */ +static int +copy_text_and_data (int new, int a_out) +{ + register char *end; + register char *ptr; + +#ifdef COFF + +#ifdef USG_SHARED_LIBRARIES + + int scns; + struct scnhdr scntemp; /* Temporary section header */ + + /* The purpose of this code is to write out the new file's section + * contents. + * + * Step through the section table. If we know the section (.text, + * .data) do the appropriate thing. Otherwise, if the section has + * no allocated space in the file (.bss), do nothing. Otherwise, + * the section has space allocated in the file, and is not a section + * we know. So just copy it. + */ + + lseek (a_out, sizeof (struct filehdr) + sizeof (struct aouthdr), 0); + + for (scns = f_hdr.f_nscns; scns > 0; scns--) + { + if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) + PERROR ("temacs"); + + if (!strcmp (scntemp.s_name, ".text")) + { + lseek (new, (long) text_scnptr, 0); + ptr = (char *) f_ohdr.text_start; + end = ptr + f_ohdr.tsize; + write_segment (new, ptr, end); + } + else if (!strcmp (scntemp.s_name, ".data")) + { + lseek (new, (long) data_scnptr, 0); + ptr = (char *) f_ohdr.data_start; + end = ptr + f_ohdr.dsize; + write_segment (new, ptr, end); + } + else if (!scntemp.s_scnptr) + ; /* do nothing - no data for this section */ + else + { + char page[BUFSIZ]; + int size, n; + long old_a_out_ptr = lseek (a_out, 0, 1); + + lseek (a_out, scntemp.s_scnptr, 0); + for (size = scntemp.s_size; size > 0; size -= sizeof (page)) + { + n = size > sizeof (page) ? sizeof (page) : size; + if (read (a_out, page, n) != n || write (new, page, n) != n) + PERROR ("xemacs"); + } + lseek (a_out, old_a_out_ptr, 0); + } + } + +#else /* COFF, but not USG_SHARED_LIBRARIES */ + + lseek (new, (long) text_scnptr, 0); + ptr = (char *) f_ohdr.text_start; + end = ptr + f_ohdr.tsize; + write_segment (new, ptr, end); + + lseek (new, (long) data_scnptr, 0); + ptr = (char *) f_ohdr.data_start; + end = ptr + f_ohdr.dsize; + write_segment (new, ptr, end); + +#endif /* USG_SHARED_LIBRARIES */ + +#else /* if not COFF */ + +/* Some machines count the header as part of the text segment. + That is to say, the header appears in core + just before the address that start_of_text () returns. + For them, N_TXTOFF is the place where the header goes. + We must adjust the seek to the place after the header. + Note that at this point hdr.a_text does *not* count + the extra A_TEXT_OFFSET bytes, only the actual bytes of code. */ + +#ifdef A_TEXT_SEEK + lseek (new, (long) A_TEXT_SEEK (hdr), 0); +#else +#ifdef A_TEXT_OFFSET + /* Note that on the Sequent machine A_TEXT_OFFSET != sizeof (hdr) + and sizeof (hdr) is the correct amount to add here. */ + /* In version 19, eliminate this case and use A_TEXT_SEEK whenever + N_TXTOFF is not right. */ + lseek (new, (long) N_TXTOFF (hdr) + sizeof (hdr), 0); +#else + lseek (new, (long) N_TXTOFF (hdr), 0); +#endif /* no A_TEXT_OFFSET */ +#endif /* no A_TEXT_SEEK */ + + ptr = (char *) unexec_text_start; + end = ptr + hdr.a_text; + write_segment (new, ptr, end); + + ptr = (char *) unexec_data_start; + end = ptr + hdr.a_data; +/* This lseek is certainly incorrect when A_TEXT_OFFSET + and I believe it is a no-op otherwise. + Let's see if its absence ever fails. */ +/* lseek (new, (long) N_TXTOFF (hdr) + hdr.a_text, 0); */ + write_segment (new, ptr, end); + +#endif /* not COFF */ + + return 0; +} + +write_segment (int new, register char *ptr, register char *end) +{ + register int i, nwrite, ret; + char buf[80]; + extern int errno; + char zeros[128]; + + bzero (zeros, sizeof zeros); + + for (i = 0; ptr < end;) + { + /* distance to next multiple of 128. */ + nwrite = (((int) ptr + 128) & -128) - (int) ptr; + /* But not beyond specified end. */ + if (nwrite > end - ptr) nwrite = end - ptr; + ret = write (new, ptr, nwrite); + /* If write gets a page fault, it means we reached + a gap between the old text segment and the old data segment. + This gap has probably been remapped into part of the text segment. + So write zeros for it. */ + if (ret == -1 && errno == EFAULT) + write (new, zeros, nwrite); + else if (nwrite != ret) + { + sprintf (buf, + "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", + ptr, new, nwrite, ret, errno); + PERROR (buf); + } + i += nwrite; + ptr += nwrite; + } +} + +/* **************************************************************** + * copy_sym + * + * Copy the relocation information and symbol table from the a.out to the new + */ +static int +copy_sym (int new, int a_out, char *a_name, char *new_name) +{ + char page[1024]; + int n; + + if (a_out < 0) + return 0; + +#ifdef COFF + if (SYMS_START == 0L) + return 0; +#endif /* COFF */ + +#ifdef COFF + if (lnnoptr) /* if there is line number info */ + lseek (a_out, lnnoptr, 0); /* start copying from there */ + else +#endif /* COFF */ + lseek (a_out, SYMS_START, 0); /* Position a.out to symtab. */ + + while ((n = read (a_out, page, sizeof page)) > 0) + { + if (write (new, page, n) != n) + { + PERROR (new_name); + } + } + if (n < 0) + { + PERROR (a_name); + } + return 0; +} + +/* **************************************************************** + * mark_x + * + * After succesfully building the new a.out, mark it executable + */ +static int +mark_x (char *name) +{ + struct stat sbuf; + int um; + int new = 0; /* for PERROR */ + + um = umask (777); + umask (um); + if (stat (name, &sbuf) == -1) + { + PERROR (name); + } + sbuf.st_mode |= 0111 & ~um; + if (chmod (name, sbuf.st_mode) == -1) + PERROR (name); + return 0; +} + +/* + * If the COFF file contains a symbol table and a line number section, + * then any auxiliary entries that have values for x_lnnoptr must + * be adjusted by the amount that the line number section has moved + * in the file (bias computed in make_hdr). The #@$%&* designers of + * the auxiliary entry structures used the absolute file offsets for + * the line number entry rather than an offset from the start of the + * line number section! + * + * When I figure out how to scan through the symbol table and pick out + * the auxiliary entries that need adjustment, this routine will + * be fixed. As it is now, all such entries are wrong and sdb + * will complain. Fred Fish, UniSoft Systems Inc. + */ + +#ifdef COFF + +/* This function is probably very slow. Instead of reopening the new + file for input and output it should copy from the old to the new + using the two descriptors already open (WRITEDESC and READDESC). + Instead of reading one small structure at a time it should use + a reasonable size buffer. But I don't have time to work on such + things, so I am installing it as submitted to me. -- RMS. */ + +adjust_lnnoptrs (writedesc, readdesc, new_name) + int writedesc; + int readdesc; + char *new_name; +{ + register int nsyms; + register int new; +#if defined (amdahl_uts) || defined (pfa) + SYMENT symentry; + AUXENT auxentry; +#else + struct syment symentry; + union auxent auxentry; +#endif + + if (!lnnoptr || !f_hdr.f_symptr) + return 0; + + if ((new = open (new_name, 2)) < 0) + { + PERROR (new_name); + return -1; + } + + lseek (new, f_hdr.f_symptr, 0); + for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) + { + read (new, &symentry, SYMESZ); + if (symentry.n_numaux) + { + read (new, &auxentry, AUXESZ); + nsyms++; + if (ISFCN (symentry.n_type)) { + auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; + lseek (new, -AUXESZ, 1); + write (new, &auxentry, AUXESZ); + } + } + } + close (new); +} + +#endif /* COFF */ + +#endif /* not CANNOT_UNEXEC */ + +#endif /* not CANNOT_DUMP */ + +#ifdef UNIXSAVE +#include "save.c" +#endif diff --git a/o/unexmacosx.c b/o/unexmacosx.c new file mode 100644 index 0000000..9d57b73 --- /dev/null +++ b/o/unexmacosx.c @@ -0,0 +1,1192 @@ +/* Dump Gcl in Mach-O format for use on Mac OS X. + Copyright (C) 2001, 2002, 2003, 2004, 2005, + 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +This file is part of GNU Gcl. + +GNU Gcl 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 3 of the License, or +(at your option) any later version. + +GNU Gcl 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 GNU Gcl. If not, see . */ + +/* Contributed by Andrew Choi (akochoi@mac.com). */ + +/* Documentation note. + + Consult the following documents/files for a description of the + Mach-O format: the file loader.h, man pages for Mach-O and ld, old + NEXTSTEP documents of the Mach-O format. The tool otool dumps the + mach header (-h option) and the load commands (-l option) in a + Mach-O file. The tool nm on Mac OS X displays the symbol table in + a Mach-O file. For examples of unexec for the Mach-O format, see + the file unexnext.c in the GNU Gcl distribution, the file + unexdyld.c in the Darwin port of GNU Gcl 20.7, and unexdyld.c in + the Darwin port of XGcl 21.1. Also the Darwin Libc source + contains the source code for malloc_freezedry and malloc_jumpstart. + Read that to see what they do. This file was written completely + from scratch, making use of information from the above sources. */ + +/* The Mac OS X implementation of unexec makes use of Darwin's `zone' + memory allocator. All calls to malloc, realloc, and free in Gcl + are redirected to unexec_malloc, unexec_realloc, and unexec_free in + this file. When tgcl is run, all memory requests are handled in + the zone GclZone. The Darwin memory allocator library calls + maintain the data structures to manage this zone. Dumping writes + its contents to data segments of the executable file. When gcl + is run, the loader recreates the contents of the zone in memory. + However since the initialization routine of the zone memory + allocator is run again, this `zone' can no longer be used as a + heap. That is why gcl uses the ordinary malloc system call to + allocate memory. Also, when a block of memory needs to be + reallocated and the new size is larger than the old one, a new + block must be obtained by malloc and the old contents copied to + it. */ + +/* Peculiarity of the Mach-O files generated by ld in Mac OS X + (possible causes of future bugs if changed). + + The file offset of the start of the __TEXT segment is zero. Since + the Mach header and load commands are located at the beginning of a + Mach-O file, copying the contents of the __TEXT segment from the + input file overwrites them in the output file. Despite this, + unexec works fine as written below because the segment load command + for __TEXT appears, and is therefore processed, before all other + load commands except the segment load command for __PAGEZERO, which + remains unchanged. + + Although the file offset of the start of the __TEXT segment is + zero, none of the sections it contains actually start there. In + fact, the earliest one starts a few hundred bytes beyond the end of + the last load command. The linker option -headerpad controls the + minimum size of this padding. Its setting can be changed in + s/darwin.h. A value of 0x690, e.g., leaves room for 30 additional + load commands for the newly created __DATA segments (at 56 bytes + each). Unexec fails if there is not enough room for these new + segments. + + The __TEXT segment contains the sections __text, __cstring, + __picsymbol_stub, and __const and the __DATA segment contains the + sections __data, __la_symbol_ptr, __nl_symbol_ptr, __dyld, __bss, + and __common. The other segments do not contain any sections. + These sections are copied from the input file to the output file, + except for __data, __bss, and __common, which are dumped from + memory. The types of the sections __bss and __common are changed + from S_ZEROFILL to S_REGULAR. Note that the number of sections and + their relative order in the input and output files remain + unchanged. Otherwise all n_sect fields in the nlist records in the + symbol table (specified by the LC_SYMTAB load command) will have to + be changed accordingly. +*/ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#if defined (__ppc__) +#include +#endif +#include +#include +#undef malloc +#undef realloc +#undef free +#include + +#include + +#ifdef _LP64 +#define mach_header mach_header_64 +#define segment_command segment_command_64 +#undef VM_REGION_BASIC_INFO_COUNT +#define VM_REGION_BASIC_INFO_COUNT VM_REGION_BASIC_INFO_COUNT_64 +#undef VM_REGION_BASIC_INFO +#define VM_REGION_BASIC_INFO VM_REGION_BASIC_INFO_64 +#undef LC_SEGMENT +#define LC_SEGMENT LC_SEGMENT_64 +#define vm_region vm_region_64 +#define section section_64 +#undef MH_MAGIC +#define MH_MAGIC MH_MAGIC_64 +#endif + +#define VERBOSE 0 + +/* Size of buffer used to copy data from the input file to the output + file in function unexec_copy. */ +#define UNEXEC_COPY_BUFSZ 1024 + +/* Regions with memory addresses above this value are assumed to be + mapped to dynamically loaded libraries and will not be dumped. */ +#define VM_DATA_TOP (20 * 1024 * 1024) + +/* Type of an element on the list of regions to be dumped. */ +struct region_t { + vm_address_t address; + vm_size_t size; + vm_prot_t protection; + vm_prot_t max_protection; + + struct region_t *next; +}; + +/* Head and tail of the list of regions to be dumped. */ +static struct region_t *region_list_head = 0; +static struct region_t *region_list_tail = 0; + +/* Pointer to array of load commands. */ +static struct load_command **lca; + +/* Number of load commands. */ +static int nlc; + +/* The highest VM address of segments loaded by the input file. + Regions with addresses beyond this are assumed to be allocated + dynamically and thus require dumping. */ +static vm_address_t infile_lc_highest_addr = 0; + +/* The lowest file offset used by the all sections in the __TEXT + segments. This leaves room at the beginning of the file to store + the Mach-O header. Check this value against header size to ensure + the added load commands for the new __DATA segments did not + overwrite any of the sections in the __TEXT segment. */ +static unsigned long text_seg_lowest_offset = 0x10000000; + +/* Mach header. */ +static struct mach_header mh; + +/* Offset at which the next load command should be written. */ +static unsigned long curr_header_offset = sizeof (struct mach_header); + +/* Offset at which the next segment should be written. */ +static unsigned long curr_file_offset = 0; + +static unsigned long pagesize; +#define ROUNDUP_TO_PAGE_BOUNDARY(x) (((x) + pagesize - 1) & ~(pagesize - 1)) + +static int infd, outfd; + +static malloc_zone_t gcl_zone_body,*gcl_zone; + +/* file offset of input file's data segment */ +static off_t data_segment_old_fileoff = 0; + +static struct segment_command *data_segment_scp; + +void +reset_unexec_globals() { + region_list_head=NULL; + region_list_tail=NULL; + lca=NULL; + nlc=0; + infile_lc_highest_addr=0; + text_seg_lowest_offset=0x10000000; + memset(&mh,0,sizeof(mh)); + curr_header_offset=sizeof (struct mach_header); + curr_file_offset=0; + pagesize=0; + infd=0; + outfd=0; + gcl_zone=NULL; + data_segment_old_fileoff=0; + data_segment_scp=NULL; +} + +#define MAX_MARKED_REGIONS 1024 + +vm_range_t marked_regions [MAX_MARKED_REGIONS]; + +unsigned num_marked_regions; + +/* Size of the heap. */ +static unsigned long big_heap; + +/* Start of the heap. */ +char *mach_mapstart = 0; + +/* End of the heap. */ +char *mach_maplimit = 0; + +/* Position ot the break within the heap. */ +char *mach_brkpt = 0; + +/* Read N bytes from infd into memory starting at address DEST. + Return true if successful, false otherwise. */ +static int +unexec_read (void *dest, size_t n) +{ + return n == read (infd, dest, n); +} + +/* Write COUNT bytes from memory starting at address SRC to outfd + starting at offset DEST. Return true if successful, false + otherwise. */ +static int +unexec_write (off_t dest, const void *src, size_t count) +{ + if (lseek (outfd, dest, SEEK_SET) != dest) + return 0; + + return write (outfd, src, count) == count; +} + +/* Write COUNT bytes of zeros to outfd starting at offset DEST. + Return true if successful, false otherwise. */ +static int +unexec_write_zero (off_t dest, size_t count) +{ + char buf[UNEXEC_COPY_BUFSZ]; + ssize_t bytes; + + bzero (buf, UNEXEC_COPY_BUFSZ); + if (lseek (outfd, dest, SEEK_SET) != dest) + return 0; + + while (count > 0) + { + bytes = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; + if (write (outfd, buf, bytes) != bytes) + return 0; + count -= bytes; + } + + return 1; +} + +/* Copy COUNT bytes from starting offset SRC in infd to starting + offset DEST in outfd. Return true if successful, false + otherwise. */ +static int +unexec_copy (off_t dest, off_t src, ssize_t count) +{ + ssize_t bytes_read; + ssize_t bytes_to_read; + + char buf[UNEXEC_COPY_BUFSZ]; + + if (lseek (infd, src, SEEK_SET) != src) + return 0; + + if (lseek (outfd, dest, SEEK_SET) != dest) + return 0; + + while (count > 0) + { + bytes_to_read = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; + bytes_read = read (infd, buf, bytes_to_read); + if (bytes_read <= 0) + return 0; + if (write (outfd, buf, bytes_read) != bytes_read) + return 0; + count -= bytes_read; + } + + return 1; +} + +/* Debugging and informational messages routines. */ + +#define unexec_error(a,b...) emsg(a,##b),do_gcl_abort() + +/* More informational messages routines. */ + +#if VERBOSE +static void +print_load_command_name (int lc) +{ + switch (lc) + { + case LC_SEGMENT: +#ifndef _LP64 + printf ("LC_SEGMENT "); +#else + printf ("LC_SEGMENT_64 "); +#endif + break; + case LC_LOAD_DYLINKER: + printf ("LC_LOAD_DYLINKER "); + break; + case LC_LOAD_DYLIB: + printf ("LC_LOAD_DYLIB "); + break; + case LC_SYMTAB: + printf ("LC_SYMTAB "); + break; + case LC_DYSYMTAB: + printf ("LC_DYSYMTAB "); + break; + case LC_UNIXTHREAD: + printf ("LC_UNIXTHREAD "); + break; + case LC_PREBOUND_DYLIB: + printf ("LC_PREBOUND_DYLIB"); + break; + case LC_TWOLEVEL_HINTS: + printf ("LC_TWOLEVEL_HINTS"); + break; +#ifdef LC_UUID + case LC_UUID: + printf ("LC_UUID "); + break; +#endif +#ifdef LC_DYLD_INFO + case LC_DYLD_INFO: + printf ("LC_DYLD_INFO "); + break; + case LC_DYLD_INFO_ONLY: + printf ("LC_DYLD_INFO_ONLY"); + break; +#endif + default: + printf ("unknown "); + } +} + +static void +print_load_command (struct load_command *lc) +{ + print_load_command_name (lc->cmd); + printf ("%8d", lc->cmdsize); + + if (lc->cmd == LC_SEGMENT) + { + struct segment_command *scp; + struct section *sectp; + int j; + + scp = (struct segment_command *) lc; + printf (" %-16.16s %#10lx %#8lx\n", + scp->segname, (long) (scp->vmaddr), (long) (scp->vmsize)); + + sectp = (struct section *) (scp + 1); + for (j = 0; j < scp->nsects; j++) + { + printf (" %-16.16s %#10lx %#8lx\n", + sectp->sectname, (long) (sectp->addr), (long) (sectp->size)); + sectp++; + } + } + else + printf ("\n"); +} +#endif + +/* Copy a LC_SEGMENT load command other than the __DATA segment from + the input file to the output file, adjusting the file offset of the + segment and the file offsets of sections contained in it. */ +static void +copy_segment (struct load_command *lc) +{ + struct segment_command *scp = (struct segment_command *) lc; + unsigned long old_fileoff = scp->fileoff; + struct section *sectp; + int j; + + scp->fileoff = curr_file_offset; + + sectp = (struct section *) (scp + 1); + for (j = 0; j < scp->nsects; j++) + { + sectp->offset += curr_file_offset - old_fileoff; + sectp++; + } + +#if VERBOSE + printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", + scp->segname, (long) (scp->fileoff), (long) (scp->filesize), + (long) (scp->vmsize), (long) (scp->vmaddr)); +#endif + + if (!unexec_copy (scp->fileoff, old_fileoff, scp->filesize)) + unexec_error ("cannot copy segment from input to output file"); + curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write load command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Copy a LC_SEGMENT load command for the __DATA segment in the input + file to the output file. We assume that only one such segment load + command exists in the input file and it contains the sections + __data, __bss, __common, __la_symbol_ptr, __nl_symbol_ptr, and + __dyld. The first three of these should be dumped from memory and + the rest should be copied from the input file. Note that the + sections __bss and __common contain no data in the input file + because their flag fields have the value S_ZEROFILL. Dumping these + from memory makes it necessary to adjust file offset fields in + subsequently dumped load commands. Then, create new __DATA segment + load commands for regions on the region list other than the one + corresponding to the __DATA segment in the input file. */ +static void +copy_data_segment (struct load_command *lc) +{ + struct segment_command *scp = (struct segment_command *) lc; + struct section *sectp; + int j; + unsigned long header_offset, old_file_offset; + + /* The new filesize of the segment is set to its vmsize because data + blocks for segments must start at region boundaries. Note that + this may leave unused locations at the end of the segment data + block because the total of the sizes of all sections in the + segment is generally smaller than vmsize. */ + scp->filesize = scp->vmsize; + +#if VERBOSE + printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", + scp->segname, curr_file_offset, (long)(scp->filesize), + (long)(scp->vmsize), (long) (scp->vmaddr)); +#endif + + /* Offsets in the output file for writing the next section structure + and segment data block, respectively. */ + header_offset = curr_header_offset + sizeof (struct segment_command); + + sectp = (struct section *) (scp + 1); + for (j = 0; j < scp->nsects; j++) + { + old_file_offset = sectp->offset; + sectp->offset = sectp->addr - scp->vmaddr + curr_file_offset; + /* The __data section is dumped from memory. The __bss and + __common sections are also dumped from memory but their flag + fields require changing (from S_ZEROFILL to S_REGULAR). The + other three kinds of sections are just copied from the input + file. */ + if (strncmp (sectp->sectname, SECT_DATA, 16) == 0) + { + if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) + unexec_error ("cannot write section %s", SECT_DATA); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", SECT_DATA); + } + else if (strncmp (sectp->sectname, SECT_COMMON, 16) == 0) + { + sectp->flags = S_REGULAR; + if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", sectp->sectname); + } + else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0) + { + /* extern char *my_endbss_static; */ + unsigned long my_size; + + sectp->flags = S_REGULAR; + + /* Clear uninitialized local variables in statically linked + libraries. In particular, function pointers stored by + libSystemStub.a, which is introduced in Mac OS X 10.4 for + binary compatibility with respect to long double, are + cleared so that they will be reinitialized when the + dumped binary is executed on other versions of OS. */ + my_size = sectp->size;/* (unsigned long)my_endbss_static - sectp->addr; */ + /* if (!(sectp->addr <= (unsigned long)my_endbss_static */ + /* && my_size <= sectp->size)) */ + /* unexec_error ("my_endbss_static is not in section %s", */ + /* sectp->sectname); */ + if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write_zero (sectp->offset + my_size, + sectp->size - my_size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", sectp->sectname); + } + else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0 + || strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0 + || strncmp (sectp->sectname, "__la_sym_ptr2", 16) == 0 + || strncmp (sectp->sectname, "__dyld", 16) == 0 + || strncmp (sectp->sectname, "__const", 16) == 0 + || strncmp (sectp->sectname, "__cfstring", 16) == 0 + || strncmp (sectp->sectname, "__gcc_except_tab", 16) == 0 + || strncmp (sectp->sectname, "__program_vars", 16) == 0 + || strncmp (sectp->sectname, "__objc_", 7) == 0 + || strncmp (sectp->sectname, "__got", 5) == 0)/*FIXME check this, but appears to work*/ + { + if (!unexec_copy (sectp->offset, old_file_offset, sectp->size)) + unexec_error ("cannot copy section %s", sectp->sectname); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", sectp->sectname); + } + else + unexec_error ("unrecognized section name in __DATA segment"); + +#if VERBOSE + printf (" section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n", + sectp->sectname, (long) (sectp->offset), + (long) (sectp->offset + sectp->size), (long) (sectp->size)); +#endif + + header_offset += sizeof (struct section); + sectp++; + } + + curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); + + if (!unexec_write (curr_header_offset, scp, sizeof (struct segment_command))) + unexec_error ("cannot write header of __DATA segment"); + curr_header_offset += lc->cmdsize; + + /* Create new __DATA segment load commands for regions on the region + list that do not corresponding to any segment load commands in + the input file. + */ + /* for (j = 0; j < num_unexec_regions; j++) */ + { + struct segment_command sc; + + sc.cmd = LC_SEGMENT; + sc.cmdsize = sizeof (struct segment_command); + /* strncpy (sc.segname, SEG_DATA, 16); */ + strncpy (sc.segname, "__HEAP", 16); + sc.vmaddr = (long)mach_mapstart; + sc.vmsize = mach_maplimit-mach_mapstart; + sc.fileoff = curr_file_offset; + sc.filesize = core_end-mach_mapstart; + sc.maxprot = VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE; + sc.initprot = VM_PROT_READ | VM_PROT_WRITE /* | VM_PROT_EXECUTE */; + sc.nsects = 0; + sc.flags = 0; + +#if VERBOSE + printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", + sc.segname, (long) (sc.fileoff), (long) (sc.filesize), + (long) (sc.vmsize), (long) (sc.vmaddr)); +#endif + + if (!unexec_write (sc.fileoff, (void *) sc.vmaddr, sc.filesize)) + unexec_error ("cannot write new __DATA segment"); + curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (sc.filesize); + + if (!unexec_write (curr_header_offset, &sc, sc.cmdsize)) + unexec_error ("cannot write new __DATA segment's header"); + curr_header_offset += sc.cmdsize; + mh.ncmds++; + } +} + +/* Copy a LC_SYMTAB load command from the input file to the output + file, adjusting the file offset fields. */ +static void +copy_symtab (struct load_command *lc, long delta) +{ + struct symtab_command *stp = (struct symtab_command *) lc; + + stp->symoff += delta; + stp->stroff += delta; + +#if VERBOSE + printf ("Writing LC_SYMTAB command\n"); +#endif + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write symtab command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Fix up relocation entries. */ +static void +unrelocate (const char *name, off_t reloff, int nrel, vm_address_t base) +{ + int i, unreloc_count; + struct relocation_info reloc_info; + struct scattered_relocation_info *sc_reloc_info + = (struct scattered_relocation_info *) &reloc_info; + vm_address_t location; + + for (unreloc_count = 0, i = 0; i < nrel; i++) + { + if (lseek (infd, reloff, L_SET) != reloff) + unexec_error ("unrelocate: %s:%d cannot seek to reloc_info", name, i); + if (!unexec_read (&reloc_info, sizeof (reloc_info))) + unexec_error ("unrelocate: %s:%d cannot read reloc_info", name, i); + reloff += sizeof (reloc_info); + + if (sc_reloc_info->r_scattered == 0) + switch (reloc_info.r_type) + { + case GENERIC_RELOC_VANILLA: + location = base + reloc_info.r_address; + if (location >= data_segment_scp->vmaddr + && location < (data_segment_scp->vmaddr + + data_segment_scp->vmsize)) + { + off_t src_off = data_segment_old_fileoff + + (location - data_segment_scp->vmaddr); + off_t dst_off = data_segment_scp->fileoff + + (location - data_segment_scp->vmaddr); + + if (!unexec_copy (dst_off, src_off, 1 << reloc_info.r_length)) + unexec_error ("unrelocate: %s:%d cannot copy original value", + name, i); + unreloc_count++; + } + break; + default: + unexec_error ("unrelocate: %s:%d cannot handle type = %d", + name, i, reloc_info.r_type); + } + else + switch (sc_reloc_info->r_type) + { +#if defined (__ppc__) + case PPC_RELOC_PB_LA_PTR: + /* nothing to do for prebound lazy pointer */ + break; +#endif + default: + unexec_error ("unrelocate: %s:%d cannot handle scattered type = %d", + name, i, sc_reloc_info->r_type); + } + } + +#if VERBOSE + if (nrel > 0) + printf ("Fixed up %d/%d %s relocation entries in data segment.\n", + unreloc_count, nrel, name); +#endif + +} + +#if __ppc64__ +/* Rebase r_address in the relocation table. */ +static void +rebase_reloc_address (off_t reloff, int nrel, long linkedit_delta, long diff) +{ + int i; + struct relocation_info reloc_info; + struct scattered_relocation_info *sc_reloc_info + = (struct scattered_relocation_info *) &reloc_info; + + for (i = 0; i < nrel; i++, reloff += sizeof (reloc_info)) + { + if (lseek (infd, reloff - linkedit_delta, L_SET) + != reloff - linkedit_delta) + unexec_error ("rebase_reloc_table: cannot seek to reloc_info"); + if (!unexec_read (&reloc_info, sizeof (reloc_info))) + unexec_error ("rebase_reloc_table: cannot read reloc_info"); + + if (sc_reloc_info->r_scattered == 0 + && reloc_info.r_type == GENERIC_RELOC_VANILLA) + { + reloc_info.r_address -= diff; + if (!unexec_write (reloff, &reloc_info, sizeof (reloc_info))) + unexec_error ("rebase_reloc_table: cannot write reloc_info"); + } + } +} +#endif + +/* Copy a LC_DYSYMTAB load command from the input file to the output + file, adjusting the file offset fields. */ +static void +copy_dysymtab (struct load_command *lc, long delta) +{ + struct dysymtab_command *dstp = (struct dysymtab_command *) lc; + vm_address_t base; + +#ifdef _LP64 +#if __ppc64__ + { + int i; + + base = 0; + for (i = 0; i < nlc; i++) + if (lca[i]->cmd == LC_SEGMENT) + { + struct segment_command *scp = (struct segment_command *) lca[i]; + + if (scp->vmaddr + scp->vmsize > 0x100000000 + && (scp->initprot & VM_PROT_WRITE) != 0) + { + base = data_segment_scp->vmaddr; + break; + } + } + } +#else + /* First writable segment address. */ + base = data_segment_scp->vmaddr; +#endif +#else + /* First segment address in the file (unless MH_SPLIT_SEGS set). */ + base = 0; +#endif + + unrelocate ("local", dstp->locreloff, dstp->nlocrel, base); + unrelocate ("external", dstp->extreloff, dstp->nextrel, base); + + if (dstp->nextrel > 0) { + dstp->extreloff += delta; + } + + if (dstp->nlocrel > 0) { + dstp->locreloff += delta; + } + + if (dstp->nindirectsyms > 0) + dstp->indirectsymoff += delta; + +#if VERBOSE + printf ("Writing LC_DYSYMTAB command\n"); +#endif + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write symtab command to header"); + + curr_header_offset += lc->cmdsize; + +#if __ppc64__ + /* Check if the relocation base needs to be changed. */ + if (base == 0) + { + vm_address_t newbase = 0; + int i; + + for (i = 0; i < num_unexec_regions; i++) + if (unexec_regions[i].range.address + unexec_regions[i].range.size + > 0x100000000) + { + newbase = data_segment_scp->vmaddr; + break; + } + + if (newbase) + { + rebase_reloc_address (dstp->locreloff, dstp->nlocrel, delta, newbase); + rebase_reloc_address (dstp->extreloff, dstp->nextrel, delta, newbase); + } + } +#endif +} + +/* Copy a LC_TWOLEVEL_HINTS load command from the input file to the output + file, adjusting the file offset fields. */ +static void +copy_twolevelhints (struct load_command *lc, long delta) +{ + struct twolevel_hints_command *tlhp = (struct twolevel_hints_command *) lc; + + if (tlhp->nhints > 0) { + tlhp->offset += delta; + } + +#if VERBOSE + printf ("Writing LC_TWOLEVEL_HINTS command\n"); +#endif + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write two level hint command to header"); + + curr_header_offset += lc->cmdsize; +} + +#ifdef LC_DYLD_INFO +/* Copy a LC_DYLD_INFO(_ONLY) load command from the input file to the output + file, adjusting the file offset fields. */ +static void +copy_dyld_info (struct load_command *lc, long delta) +{ + struct dyld_info_command *dip = (struct dyld_info_command *) lc; + + if (dip->rebase_off > 0) + dip->rebase_off += delta; + if (dip->bind_off > 0) + dip->bind_off += delta; + if (dip->weak_bind_off > 0) + dip->weak_bind_off += delta; + if (dip->lazy_bind_off > 0) + dip->lazy_bind_off += delta; + if (dip->export_off > 0) + dip->export_off += delta; + +#if VERBOSE + printf ("Writing "); + print_load_command_name (lc->cmd); + printf (" command\n"); +#endif + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write dyld info command to header"); + + curr_header_offset += lc->cmdsize; +} +#endif + +/* Copy other kinds of load commands from the input file to the output + file, ones that do not require adjustments of file offsets. */ +static void +copy_other (struct load_command *lc) +{ +#if VERBOSE + printf ("Writing "); + print_load_command_name (lc->cmd); + printf (" command\n"); +#endif + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write symtab command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Loop through all load commands and dump them. Then write the Mach + header. */ +static void +dump_it () { + + int i; + long linkedit_delta = 0; + +#if VERBOSE + printf ("--- Load Commands written to Output File ---\n"); +#endif + + for (i = 0; i < nlc; i++) + switch (lca[i]->cmd) { + + case LC_SEGMENT: + { + struct segment_command *scp = (struct segment_command *) lca[i]; + if (strncmp (scp->segname, SEG_DATA, 16) == 0) { + + /* save data segment file offset and segment_command for + unrelocate */ + + if (data_segment_old_fileoff) + unexec_error ("cannot handle multiple DATA segments in input file"); + + data_segment_old_fileoff = scp->fileoff; + data_segment_scp = scp; + + copy_data_segment (lca[i]); + + } else { + + if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) { + if (linkedit_delta) + unexec_error ("cannot handle multiple LINKEDIT segments in input file"); + linkedit_delta = curr_file_offset - scp->fileoff; + } + + if (strncmp (scp->segname, "__HEAP", 16) != 0) copy_segment (lca[i]); else mh.ncmds--; + + } + } + break; + case LC_SYMTAB: + copy_symtab (lca[i], linkedit_delta); + break; + case LC_DYSYMTAB: + copy_dysymtab (lca[i], linkedit_delta); + break; + case LC_TWOLEVEL_HINTS: + copy_twolevelhints (lca[i], linkedit_delta); + break; +#ifdef LC_DYLD_INFO + case LC_DYLD_INFO: + case LC_DYLD_INFO_ONLY: + copy_dyld_info (lca[i], linkedit_delta); + break; +#endif + default: + copy_other (lca[i]); + break; + } + + if (curr_header_offset > text_seg_lowest_offset) + unexec_error ("not enough room for load commands for new __DATA segments"); + +#if VERBOSE + printf ("%ld unused bytes follow Mach-O header\n", + text_seg_lowest_offset - curr_header_offset); +#endif + + mh.sizeofcmds = curr_header_offset - sizeof (struct mach_header); + if (!unexec_write (0, &mh, sizeof (struct mach_header))) + unexec_error ("cannot write final header contents"); + +} + +/* Read header and load commands from input file. Store the latter in + the global array lca. Store the total number of load commands in + global variable nlc. */ +static void +read_load_commands_and_dump () { + + int i; + + if (!unexec_read (&mh, sizeof (struct mach_header))) + unexec_error ("cannot read mach-o header"); + + if (mh.magic != MH_MAGIC) + unexec_error ("input file not in Mach-O format"); + + if (mh.filetype != MH_EXECUTE) + unexec_error ("input Mach-O file is not an executable object file"); + +#if VERBOSE + printf ("--- Header Information ---\n"); + printf ("Magic = 0x%08x\n", mh.magic); + printf ("CPUType = %d\n", mh.cputype); + printf ("CPUSubType = %d\n", mh.cpusubtype); + printf ("FileType = 0x%x\n", mh.filetype); + printf ("NCmds = %d\n", mh.ncmds); + printf ("SizeOfCmds = %d\n", mh.sizeofcmds); + printf ("Flags = 0x%08x\n", mh.flags); +#endif + + nlc = mh.ncmds; + lca=alloca(nlc*sizeof(struct load_command *)); + + for (i = 0; i < nlc; i++) { + + struct load_command lc; + + /* Load commands are variable-size: so read the command type and + size first and then read the rest. */ + + if (!unexec_read (&lc, sizeof (struct load_command))) + unexec_error ("cannot read load command"); + + lca[i]=(struct load_command *)alloca(lc.cmdsize); + memcpy (lca[i], &lc, sizeof (struct load_command)); + + if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command))) + unexec_error ("cannot read content of load command"); + if (lc.cmd == LC_SEGMENT) { + + struct segment_command *scp = (struct segment_command *) lca[i]; + + if (scp->vmaddr + scp->vmsize > infile_lc_highest_addr) + infile_lc_highest_addr = scp->vmaddr + scp->vmsize; + + if (strncmp (scp->segname, SEG_TEXT, 16) == 0) { + + struct section *sectp = (struct section *) (scp + 1); + int j; + + for (j = 0; j < scp->nsects; j++) + if (sectp->offset < text_seg_lowest_offset) + text_seg_lowest_offset = sectp->offset; + } + } + } + +#if VERBOSE + printf ("Highest address of load commands in input file: %#8x\n", + infile_lc_highest_addr); + + printf ("Lowest offset of all sections in __TEXT segment: %#8lx\n", + text_seg_lowest_offset); + + printf ("--- List of Load Commands in Input File ---\n"); + printf ("# cmd cmdsize name address size\n"); + + for (i = 0; i < nlc; i++) { + printf ("%1d ", i); + print_load_command (lca[i]); + } +#endif + + dump_it (); + +} + +/* Take a snapshot of Gcl and make a Mach-O format executable file + from it. The file names of the output and input files are outfile + and infile, respectively. The three other parameters are + ignored. */ +void +unexec (char *outfile, char *infile, void *start_data, void *start_bss, + void *entry_address) { + + reset_unexec_globals(); + + pagesize = getpagesize (); + if ((infd = open (infile, O_RDONLY, 0)) < 0) + unexec_error ("cannot open input file `%s'", infile); + + if ((outfd = open (outfile, O_WRONLY | O_TRUNC | O_CREAT, 0755)) < 0) { + close (infd); + unexec_error ("cannot open output file `%s'", outfile); + } + + read_load_commands_and_dump(); + + close (outfd); + +} + +/* Replacement for broken sbrk(2). */ + +#include +#include +unsigned long +probe_big_heap(unsigned long try,unsigned long inc,unsigned long max) { + + void *r; + + if ((r=mmap(NULL, try, PROT_READ|PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0))==(void *)-1) + return try>inc ? probe_big_heap(try-inc,inc>>1,max) : 0; + munmap(r,try); + return (!inc || try >=max) ? try : probe_big_heap(try+inc,inc,max); + +} + +void *my_sbrk (long incr) +{ + char *temp, *ptr; + + if (mach_brkpt == 0) { + + big_heap=(1UL)<<35; + if (!(big_heap=probe_big_heap(PAGESIZE,big_heap>>1,big_heap))) { + unexec_error("my_sbrk(): probe_big_heap() failed\n"); + return ((char *)-1); + } + + mach_brkpt=mmap(NULL, big_heap, PROT_READ|PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0); + + mach_mapstart = mach_brkpt; + mach_maplimit = mach_brkpt + big_heap; + + } + if (incr == 0) { + return (mach_brkpt); + } else { + ptr = mach_brkpt + incr; + if (ptr mach_maplimit) + return (char *)-1; + temp = mach_brkpt; + mach_brkpt = ptr; + return (temp); + } +} + +static size_t stub_size (malloc_zone_t *zone, const void *ptr) +{ + extern object malloc_list; + object *p; + + for (p = &malloc_list ; *p && !endp(*p) ; p = &((*p)->c.c_cdr)) { + size_t size = (*p)->c.c_car->st.st_dim; + void *base = (*p)->c.c_car->st.st_self; + if (ptr >= base && ptr < base + size) { + return (size); + } + } + return (0); +} + +#ifdef HAVE_MALLOC_ZONE_MEMALIGN +static void * +stub_memalign(size_t boundary, size_t size) { + + extern void *my_malloc (size_t); + void *v=my_malloc(size+boundary-1); + return (void *)(((unsigned long)v+boundary-1)&~(boundary-1)); + +} +#endif + +static void * +stub_malloc(malloc_zone_t *zone, size_t size) { + + extern void *my_malloc (size_t); + return my_malloc (size); + +} + +static void * +stub_calloc(malloc_zone_t *zone, size_t num_items, size_t size) { + + extern void *my_calloc (size_t, size_t); + return my_calloc (num_items, size); + +} + +static void * +stub_valloc(malloc_zone_t *zone, size_t size) { + + extern void *my_valloc (size_t); + return my_valloc (size); + +} + +static void * +stub_realloc(malloc_zone_t *zone, void *ptr, size_t size) { + + extern void *my_realloc (void *, size_t); + return my_realloc (ptr, size); + +} + +static void stub_free (malloc_zone_t *zone, void *ptr) { + + extern void my_free (void *ptr); + my_free (ptr); + +} + +void init_darwin_zone_compat () { + + extern unsigned malloc_num_zones; + extern malloc_zone_t **malloc_zones; + unsigned nmzc; + malloc_zone_t *mzc[10]; + unsigned i; + + nmzc=malloc_num_zones; + assert(nmzc<=sizeof(mzc)/sizeof(*mzc)); + memcpy(mzc,malloc_zones,nmzc*sizeof(*mzc)); + + gcl_zone=&gcl_zone_body; + + gcl_zone->size = (void *) stub_size; + gcl_zone->malloc = (void *) stub_malloc; + gcl_zone->calloc = (void *) stub_calloc; + gcl_zone->valloc = (void *) stub_valloc; + gcl_zone->realloc = (void *) stub_realloc; + gcl_zone->free = (void *) stub_free; + gcl_zone->destroy = (void *) stub_free; + gcl_zone->batch_malloc = (void *) stub_malloc; + gcl_zone->batch_free = (void *) stub_free; + +#ifdef HAVE_MALLOC_ZONE_MEMALIGN + gcl_zone->free_definite_size = (void *) stub_free; + gcl_zone->memalign = (void *) stub_memalign; +#endif + + for (i=0;i +#include +#include +#include +#include +#include +#include +#include + +#if defined (IRIS_4D) || defined (sony) +#include "getpagesize.h" +#include +#endif + +static void fatal_unexec (); +static void mark_x (); + +#define READ(_fd, _buffer, _size, _error_message, _error_arg) \ + errno = EEOF; \ + if (read (_fd, _buffer, _size) != _size) \ + fatal_unexec (_error_message, _error_arg); + +#define WRITE(_fd, _buffer, _size, _error_message, _error_arg) \ + if (write (_fd, _buffer, _size) != _size) \ + fatal_unexec (_error_message, _error_arg); + +#define SEEK(_fd, _position, _error_message, _error_arg) \ + errno = EEOF; \ + if (lseek (_fd, _position, L_SET) != _position) \ + fatal_unexec (_error_message, _error_arg); + +extern int errno; +extern char *strerror (); +#define EEOF -1 + +static struct scnhdr *text_section; +static struct scnhdr *init_section; +static struct scnhdr *finit_section; +static struct scnhdr *rdata_section; +static struct scnhdr *xdata_section; +static struct scnhdr *pdata_section; +static struct scnhdr *data_section; +static struct scnhdr *lit8_section; +static struct scnhdr *lit4_section; +static struct scnhdr *sdata_section; +static struct scnhdr *sbss_section; +static struct scnhdr *bss_section; + + +struct headers { + struct filehdr fhdr; + struct aouthdr aout; + struct scnhdr section[16]; +}; + +/* Define name of label for entry point for the dumped executable. */ + +#ifndef DEFAULT_ENTRY_ADDRESS +#define DEFAULT_ENTRY_ADDRESS __start +#endif + +unexec (new_name, a_name, data_start, bss_start, entry_address) + char *new_name, *a_name; + unsigned long data_start, bss_start, entry_address; +{ + int new, old; + long pagesize, brk; + long newsyms, symrel; + int nread; + struct headers hdr; + int i; + long vaddr, scnptr; +#define BUFSIZE 8192 + char buffer[BUFSIZE]; + + old = open (a_name, O_RDONLY, 0); + if (old < 0) fatal_unexec ("opening %s", a_name); + + new = creat (new_name, 0666); + if (new < 0) fatal_unexec ("creating %s", new_name); + + hdr = *((struct headers *)TEXT_START); +#ifdef MIPS2 + if (hdr.fhdr.f_magic != MIPSELMAGIC + && hdr.fhdr.f_magic != MIPSEBMAGIC + && hdr.fhdr.f_magic != (MIPSELMAGIC | 1) + && hdr.fhdr.f_magic != (MIPSEBMAGIC | 1)) + { + fprintf (stderr, + "unexec: input file magic number is %x, not %x, %x, %x or %x.\n", + hdr.fhdr.f_magic, + MIPSELMAGIC, MIPSEBMAGIC, + MIPSELMAGIC | 1, MIPSEBMAGIC | 1); + exit(1); + } +#else /* not MIPS2 */ +#ifdef __alpha + if (hdr.fhdr.f_magic != ALPHAMAGIC + && hdr.fhdr.f_magic != ALPHAUMAGIC) + { + fprintf(stderr, "unexec: input file magic number is %x, not %x or %x.\n", + hdr.fhdr.f_magic, ALPHAMAGIC, ALPHAUMAGIC); + exit(1); + } +#else /* not alpha */ + if (hdr.fhdr.f_magic != MIPSELMAGIC + && hdr.fhdr.f_magic != MIPSEBMAGIC) + { + fprintf(stderr, "unexec: input file magic number is %x, not %x or %x.\n", + hdr.fhdr.f_magic, MIPSELMAGIC, MIPSEBMAGIC); + exit(1); + } +#endif /* not alpha */ +#endif /* not MIPS2 */ + + if (hdr.fhdr.f_opthdr != sizeof (hdr.aout)) + { + fprintf (stderr, "unexec: input a.out header is %d bytes, not %d.\n", + hdr.fhdr.f_opthdr, sizeof (hdr.aout)); + exit (1); + } + if (hdr.aout.magic != ZMAGIC) + { + fprintf (stderr, "unexec: input file a.out magic number is %o, not %o.\n", + hdr.aout.magic, ZMAGIC); + exit (1); + } + +#define CHECK_SCNHDR(ptr, name, flags) \ +for( i = 0, ptr = NULL; i < hdr.fhdr.f_nscns && !ptr; i++){ \ + if (hdr.section[i].s_name && strcmp (hdr.section[i].s_name, name) == 0){ \ + if (hdr.section[i].s_flags != flags) { \ + fprintf(stderr, "unexec: %x flags (%x expected) in %s section.\n", \ + hdr.section[i].s_flags, flags, name); \ + } \ + ptr = hdr.section + i; \ + } \ + if(ptr) \ + break;\ +} + + + CHECK_SCNHDR (text_section, _TEXT, STYP_TEXT); + CHECK_SCNHDR (init_section, _INIT, STYP_INIT); + CHECK_SCNHDR (rdata_section, _RDATA, STYP_RDATA); +#ifdef _RCONST + if (!rdata_section) /* OSF/1 V3 adds this */ + CHECK_SCNHDR (rdata_section, _RCONST, STYP_RCONST); +#endif +#ifdef _XDATA + CHECK_SCNHDR(xdata_section, _XDATA, STYP_XDATA); + CHECK_SCNHDR(pdata_section, _PDATA, STYP_PDATA); +#endif + CHECK_SCNHDR (data_section, _DATA, STYP_DATA); +#ifdef _LIT8 + CHECK_SCNHDR (lit8_section, _LIT8, STYP_LIT8); + CHECK_SCNHDR (lit4_section, _LIT4, STYP_LIT4); +#endif /* _LIT8 */ + CHECK_SCNHDR (sdata_section, _SDATA, STYP_SDATA); + CHECK_SCNHDR (sbss_section, _SBSS, STYP_SBSS); + CHECK_SCNHDR (bss_section, _BSS, STYP_BSS); +#if 0 /* Apparently this error check goes off on irix 3.3, + but it doesn't indicate a real problem. */ + if (i != hdr.fhdr.f_nscns) + fprintf (stderr, "unexec: %d sections found instead of %d.\n", + i, hdr.fhdr.f_nscns); +#endif + + text_section->s_scnptr = 0; + + pagesize = getpagesize (); + /* Casting to int avoids compiler error on NEWS-OS 5.0.2. */ + brk = (((int) (sbrk (0))) + pagesize - 1) & (-pagesize); + hdr.aout.dsize = brk - DATA_START; + hdr.aout.bsize = 0; + if (entry_address == 0) + { + extern DEFAULT_ENTRY_ADDRESS (); + hdr.aout.entry = (unsigned long)DEFAULT_ENTRY_ADDRESS; + } + else + hdr.aout.entry = entry_address; + + hdr.aout.bss_start = hdr.aout.data_start + hdr.aout.dsize; + rdata_section->s_size = data_start - DATA_START; + + /* Adjust start and virtual addresses of rdata_section, too. */ + rdata_section->s_vaddr = DATA_START; + rdata_section->s_paddr = DATA_START; + rdata_section->s_scnptr = text_section->s_scnptr + hdr.aout.tsize; + + data_section->s_vaddr = data_start; + data_section->s_paddr = data_start; + data_section->s_size = brk - data_start; + data_section->s_scnptr = rdata_section->s_scnptr + rdata_section->s_size; + vaddr = data_section->s_vaddr + data_section->s_size; + scnptr = data_section->s_scnptr + data_section->s_size; + if (lit8_section != NULL) + { + lit8_section->s_vaddr = vaddr; + lit8_section->s_paddr = vaddr; + lit8_section->s_size = 0; + lit8_section->s_scnptr = scnptr; + } + if (lit4_section != NULL) + { + lit4_section->s_vaddr = vaddr; + lit4_section->s_paddr = vaddr; + lit4_section->s_size = 0; + lit4_section->s_scnptr = scnptr; + } + if (sdata_section != NULL) + { + sdata_section->s_vaddr = vaddr; + sdata_section->s_paddr = vaddr; + sdata_section->s_size = 0; + sdata_section->s_scnptr = scnptr; + } + if (sbss_section != NULL) + { + sbss_section->s_vaddr = vaddr; + sbss_section->s_paddr = vaddr; + sbss_section->s_size = 0; + sbss_section->s_scnptr = scnptr; + } + if (bss_section != NULL) + { + bss_section->s_vaddr = vaddr; + bss_section->s_paddr = vaddr; + bss_section->s_size = 0; + bss_section->s_scnptr = scnptr; + } + + WRITE (new, (char *)TEXT_START, hdr.aout.tsize, + "writing text section to %s", new_name); + WRITE (new, (char *)DATA_START, hdr.aout.dsize, + "writing data section to %s", new_name); + + SEEK (old, hdr.fhdr.f_symptr, "seeking to start of symbols in %s", a_name); + errno = EEOF; + nread = read (old, buffer, BUFSIZE); + if (nread < sizeof (HDRR)) fatal_unexec ("reading symbols from %s", a_name); +#define symhdr ((pHDRR)buffer) + newsyms = hdr.aout.tsize + hdr.aout.dsize; + symrel = newsyms - hdr.fhdr.f_symptr; + hdr.fhdr.f_symptr = newsyms; + symhdr->cbLineOffset += symrel; + symhdr->cbDnOffset += symrel; + symhdr->cbPdOffset += symrel; + symhdr->cbSymOffset += symrel; + symhdr->cbOptOffset += symrel; + symhdr->cbAuxOffset += symrel; + symhdr->cbSsOffset += symrel; + symhdr->cbSsExtOffset += symrel; + symhdr->cbFdOffset += symrel; + symhdr->cbRfdOffset += symrel; + symhdr->cbExtOffset += symrel; +#undef symhdr + do + { + if (write (new, buffer, nread) != nread) + fatal_unexec ("writing symbols to %s", new_name); + nread = read (old, buffer, BUFSIZE); + if (nread < 0) fatal_unexec ("reading symbols from %s", a_name); +#undef BUFSIZE + } while (nread != 0); + + SEEK (new, 0, "seeking to start of header in %s", new_name); + WRITE (new, &hdr, sizeof (hdr), + "writing header of %s", new_name); + + close (old); + close (new); + mark_x (new_name); +} + +/* + * mark_x + * + * After successfully building the new a.out, mark it executable + */ + +static void +mark_x (name) + char *name; +{ + struct stat sbuf; + int um = umask (777); + umask (um); + if (stat (name, &sbuf) < 0) + fatal_unexec ("getting protection on %s", name); + sbuf.st_mode |= 0111 & ~um; + if (chmod (name, sbuf.st_mode) < 0) + fatal_unexec ("setting protection on %s", name); +} + +static void +fatal_unexec (const char *s, ...) +{ + va_list ap; + if (errno == EEOF) + fputs ("unexec: unexpected end of file, ", stderr); + else + fprintf (stderr, "unexec: %s, ", strerror (errno)); + va_start (ap,s); + _doprnt (s, ap, stderr); + fputs (".\n", stderr); + exit (1); +} + +#ifdef UNIXSAVE +#include "save.c" +#endif + diff --git a/o/unexnt.c b/o/unexnt.c new file mode 100755 index 0000000..338fd37 --- /dev/null +++ b/o/unexnt.c @@ -0,0 +1,1164 @@ +/* unexec for GNU Emacs on Windows NT. + Copyright (C) 1994 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. + + Geoff Voelker (voelker@cs.washington.edu) 8-12-94 +*/ + +/* #include "gclincl.h" */ + +#ifndef UNIXSAVE +#include +#endif +/* #include */ /* _fmode */ +/* in case the include of config.h defined it */ +#undef va_start +#include +#include +#include +#include +#include /* strrchr */ + +#ifdef _GNU_H_WINDOWS_H +#include "cyglacks.h" +#endif + +/* Include relevant definitions from IMAGEHLP.H, which can be found + in \\win32sdk\mstools\samples\image\include\imagehlp.h. */ + + + +PIMAGE_NT_HEADERS +(__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress, + DWORD FileLength, + LPDWORD HeaderSum, + LPDWORD CheckSum); + + + +#include +#include + +#include "ntheap.h" + +/* Info for keeping track of our heap. */ +unsigned char *data_region_base = UNINIT_PTR; +unsigned char *data_region_end = UNINIT_PTR; +unsigned char *real_data_region_end = UNINIT_PTR; +unsigned long data_region_size = UNINIT_LONG; +unsigned long reserved_heap_size = UNINIT_LONG; + +extern BOOL ctrl_c_handler (unsigned long type); + +extern char my_begdata[]; +extern char my_edata[]; +extern char my_begbss[]; +extern char my_endbss[]; +extern char *my_begbss_static; +extern char *my_endbss_static; + +#include "ntheap.h" + +enum { + HEAP_UNINITIALIZED = 1, + HEAP_UNLOADED, + HEAP_LOADED +}; + +/* Basically, our "initialized" flag. */ +int heap_state = HEAP_UNINITIALIZED; + +/* So we can find our heap in the file to recreate it. */ +unsigned long heap_index_in_executable = UNINIT_LONG; + +static void get_section_info (file_data *p_file); +static void copy_executable_and_dump_data_section (file_data *, file_data *); +static void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile); + +/* Cached info about the .data section in the executable. */ +PUCHAR data_start_va = UNINIT_PTR; +DWORD data_start_file = UNINIT_LONG; +DWORD data_size = UNINIT_LONG; + +/* Cached info about the .bss section in the executable. */ +PUCHAR bss_start = UNINIT_PTR; +DWORD bss_size = UNINIT_LONG; + +void recreate_heap1() +{ + char executable_path[MAX_PATH]; + + if (heap_state == HEAP_UNLOADED) { + if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) + { + printf ("Failed to find path for executable.\n"); + do_gcl_abort(); + } + recreate_heap (executable_path); + } + heap_state = HEAP_LOADED; + +} + + +#ifdef HAVE_NTGUI +HINSTANCE hinst = NULL; +HINSTANCE hprevinst = NULL; +LPSTR lpCmdLine = ""; +int nCmdShow = 0; +#endif /* HAVE_NTGUI */ + +#ifndef UNIXSAVE +/* Startup code for running on NT. When we are running as the dumped + version, we need to bootstrap our heap and .bss section into our + address space before we can actually hand off control to the startup + code supplied by NT (primarily because that code relies upon malloc ()). */ +void +_start (void) +{ + extern void mainCRTStartup (void); + +#if 0 + /* Give us a way to debug problems with crashes on startup when + running under the MSVC profiler. */ + if (GetEnvironmentVariable ("EMACS_DEBUG", NULL, 0) > 0) + DebugBreak (); +#endif + + /* Cache system info, e.g., the NT page size. */ + cache_system_info (); + + /* If we're a dumped version of emacs then we need to recreate + our heap and play tricks with our .bss section. Do this before + start up. (WARNING: Do not put any code before this section + that relies upon malloc () and runs in the dumped version. It + won't work.) */ + if (heap_state == HEAP_UNLOADED) + { + char executable_path[MAX_PATH]; + + if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) + { + printf ("Failed to find path for executable.\n"); + do_gcl_abort(); + } + +#if 1 + /* To allow profiling, make sure executable_path names the .exe + file, not the ._xe file created by the profiler which contains + extra code that makes the stored exe offsets incorrect. (This + will not be necessary when unexec properly extends the .bss (or + .data as appropriate) section to include the dumped bss data, + and dumps the heap into a proper section of its own.) */ + { + char * p = strrchr (executable_path, '.'); + if (p && p[1] == '_') + p[1] = 'e'; + } + + /* Using HiProf profiler, exe name is different still. */ + { + char * p = strrchr (executable_path, '\\'); + strcpy (p, "\\emacs.exe"); + } +#endif + + recreate_heap (executable_path); + heap_state = HEAP_LOADED; + } + else + { + /* Grab our malloc arena space now, before CRT starts up. */ + sbrk (0); + } + + /* The default behavior is to treat files as binary and patch up + text files appropriately, in accordance with the MSDOS code. */ + _fmode = O_BINARY; + + /* This prevents ctrl-c's in shells running while we're suspended from + having us exit. */ + SetConsoleCtrlHandler ((PHANDLER_ROUTINE) ctrl_c_handler, TRUE); + + /* Invoke the NT CRT startup routine now that our housecleaning + is finished. */ +#ifdef HAVE_NTGUI + /* determine WinMain args like crt0.c does */ + hinst = GetModuleHandle(NULL); + lpCmdLine = GetCommandLine(); + nCmdShow = SW_SHOWDEFAULT; +#endif + mainCRTStartup (); +} +#endif /* UNIXSAVE */ + +#ifdef __CYGWIN__ +#include +#endif + +/* Dump out .data and .bss sections into a new executable. */ +void +unexec (char *new_name, char *old_name, void *start_data, void *start_bss, + void *entry_address) +{ +#ifdef __CYGWIN__ + static file_data in_file, out_file; + char out_filename[MAX_PATH], in_filename[MAX_PATH]; + char filename[MAX_PATH]; + unsigned long size; + char *ptr; + + fflush (stdin); + /* copy_stdin = *stdin; */ + setvbuf(stdin,0,_IONBF,0); + setvbuf(stdout,0,_IONBF,0); + + /* stdin->_data->__sdidinit = 0; + */ + + + if (!get_allocation_unit()) + cache_system_info (); + + /* Make sure that the input and output filenames have the + ".exe" extension...patch them up if they don't. */ + ptr = old_name + strlen (old_name) - 4; + strcpy(filename, old_name); + strcat(filename, (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE"))?".exe":""); + cygwin_conv_path(CCP_POSIX_TO_WIN_A,filename,in_filename,sizeof(in_filename)); + ptr = new_name + strlen (new_name) - 4; + strcpy(filename, new_name); + strcat(filename, (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE"))?".exe":""); + cygwin_conv_path(CCP_POSIX_TO_WIN_A,filename,out_filename,sizeof(out_filename)); +#else + static file_data in_file, out_file; + char out_filename[MAX_PATH], in_filename[MAX_PATH]; + unsigned long size; + char *ptr; + + fflush (stdin); + /* copy_stdin = *stdin; */ + setvbuf(stdin,0,_IONBF,0); + setvbuf(stdout,0,_IONBF,0); + + /* stdin->_data->__sdidinit = 0; + */ + + + if (!get_allocation_unit()) + cache_system_info (); + + /* Make sure that the input and output filenames have the + ".exe" extension...patch them up if they don't. */ + strcpy (in_filename, old_name); + ptr = in_filename + strlen (in_filename) - 4; + if (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE") ) + strcat (in_filename, ".exe"); + + strcpy (out_filename, new_name); + ptr = out_filename + strlen (out_filename) - 4; + if (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE") ) + strcat (out_filename, ".exe"); +#endif + /* printf ("Dumping from %s\n", in_filename); */ + /* printf (" to %s\n", out_filename); */ + + /* We need to round off our heap to NT's allocation unit (64KB). */ + round_heap (get_allocation_unit ()); + + /* Open the undumped executable file. */ + if (!open_input_file (&in_file, in_filename)) + { + printf ("Failed to open %s (%u)...bailing.\n", + in_filename, (unsigned)GetLastError ()); + do_gcl_abort(); + } + + /* Get the interesting section info, like start and size of .bss... */ + get_section_info (&in_file); + + /* The size of the dumped executable is the size of the original + executable plus the size of the heap and the size of the .bss section. */ + if (heap_index_in_executable==UNINIT_LONG) + heap_index_in_executable = (unsigned long) + round_to_next ((unsigned char *) in_file.size, get_allocation_unit ()); + /* from lisp we know what to use */ +#ifdef IN_UNIXSAVE + data_region_end = round_to_next((unsigned char *)core_end,0x10000); + real_data_region_end = data_region_end; +#endif + size = heap_index_in_executable + get_committed_heap_size () + bss_size; + if (!open_output_file (&out_file, out_filename, size)) + { + printf ("Failed to open %s (%u)...bailing.\n", + out_filename, (unsigned)GetLastError ()); + do_gcl_abort(); + } + + /* Set the flag (before dumping). */ + heap_state = HEAP_UNLOADED; + + copy_executable_and_dump_data_section (&in_file, &out_file); + dump_bss_and_heap (&in_file, &out_file); + + /* Patch up header fields; profiler is picky about this. */ + + { + PIMAGE_DOS_HEADER dos_header; + PIMAGE_NT_HEADERS nt_header; + HANDLE hImagehelp = LoadLibrary ("imagehlp.dll"); + DWORD headersum; + DWORD checksum; + + dos_header = (PIMAGE_DOS_HEADER) out_file.file_base; + nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); + + + nt_header->OptionalHeader.SizeOfStackReserve=0x800000; + /* nt_header->OptionalHeader.SizeOfHeapReserve=0x80000000; */ + /* nt_header->OptionalHeader.SizeOfHeapCommit=0x80000000; */ + + nt_header->OptionalHeader.CheckSum = 0; +// nt_header->FileHeader.TimeDateStamp = time (NULL); +// dos_header->e_cp = size / 512; +// nt_header->OptionalHeader.SizeOfImage = size; + + pfnCheckSumMappedFile = (void *) GetProcAddress (hImagehelp, "CheckSumMappedFile"); + if (pfnCheckSumMappedFile) + { +// nt_header->FileHeader.TimeDateStamp = time (NULL); + pfnCheckSumMappedFile (out_file.file_base, + out_file.size, + &headersum, + &checksum); + nt_header->OptionalHeader.CheckSum = checksum; + } + FreeLibrary (hImagehelp); + } + + close_file_data (&in_file); + close_file_data (&out_file); +} + + +/* File handling. */ + + +int +open_input_file (file_data *p_file, char *filename) +{ + HANDLE file; + HANDLE file_mapping; + void *file_base; + DWORD size, upper_size; + + file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if (file == INVALID_HANDLE_VALUE) + return FALSE; + + size = GetFileSize (file, &upper_size); + file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY, + 0, size, NULL); + if (!file_mapping) + return FALSE; + + file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size); + if (file_base == 0) + return FALSE; + + p_file->name = filename; + p_file->size = size; + p_file->file = file; + p_file->file_mapping = file_mapping; + p_file->file_base = file_base; + + return TRUE; +} + +int +open_output_file (file_data *p_file, char *filename, unsigned long size) +{ + HANDLE file; + HANDLE file_mapping; + void *file_base; + + file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL, + CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + if (file == INVALID_HANDLE_VALUE) + return FALSE; + + file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE, + 0, size, NULL); + if (!file_mapping) + return FALSE; + + file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size); + if (file_base == 0) + return FALSE; + + p_file->name = filename; + p_file->size = size; + p_file->file = file; + p_file->file_mapping = file_mapping; + p_file->file_base = file_base; + + return TRUE; +} + +/* Close the system structures associated with the given file. */ +void +close_file_data (file_data *p_file) +{ + UnmapViewOfFile (p_file->file_base); + CloseHandle (p_file->file_mapping); + CloseHandle (p_file->file); +} + + +/* Routines to manipulate NT executable file sections. */ + +#ifdef SEPARATE_BSS_SECTION +static void +get_bss_info_from_map_file (file_data *p_infile, PUCHAR *p_bss_start, + DWORD *p_bss_size) +{ + int n, start, len; + char map_filename[MAX_PATH]; + char buffer[256]; + FILE *map; + + /* Overwrite the .exe extension on the executable file name with + the .map extension. */ + strcpy (map_filename, p_infile->name); + n = strlen (map_filename) - 3; + strcpy (&map_filename[n], "map"); + + map = fopen (map_filename, "r"); + if (!map) + { + printf ("Failed to open map file %s, error %d...bailing out.\n", + map_filename, GetLastError ()); + do_gcl_abort(); + } + + while (fgets (buffer, sizeof (buffer), map)) + { + if (!(strstr (buffer, ".bss") && strstr (buffer, "DATA"))) + continue; + n = sscanf (buffer, " %*d:%x %x", &start, &len); + if (n != 2) + { + printf ("Failed to scan the .bss section line:\n%s", buffer); + do_gcl_abort(); + } + break; + } + *p_bss_start = (PUCHAR) start; + *p_bss_size = (DWORD) len; +} +#endif + +unsigned long +get_section_size (PIMAGE_SECTION_HEADER p_section) +{ + /* The true section size, before rounding. Some linkers swap the + meaning of these two values. */ + return min (p_section->SizeOfRawData, + p_section->Misc.VirtualSize); +} + +/* Return pointer to section header for named section. */ +IMAGE_SECTION_HEADER * +find_section (char * name, IMAGE_NT_HEADERS * nt_header) +{ + PIMAGE_SECTION_HEADER section; + int i; + + section = IMAGE_FIRST_SECTION (nt_header); + + for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) + { + if (strcmp ((char *)section->Name, name) == 0) + return section; + section++; + } + return NULL; +} + +/* Return pointer to section header for section containing the given + relative virtual address. */ +IMAGE_SECTION_HEADER * +rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) +{ + PIMAGE_SECTION_HEADER section; + int i; + + section = IMAGE_FIRST_SECTION (nt_header); + + for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) + { + if (rva >= section->VirtualAddress && + rva < section->VirtualAddress + section->SizeOfRawData) + return section; + section++; + } + return NULL; +} + + +/* Flip through the executable and cache the info necessary for dumping. */ +static void +get_section_info (file_data *p_infile) +{ + PIMAGE_DOS_HEADER dos_header; + PIMAGE_NT_HEADERS nt_header; + PIMAGE_SECTION_HEADER section, data_section; + unsigned char *ptr; + int i; + + dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; + if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) + { + printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); + do_gcl_abort(); + } + nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + dos_header->e_lfanew); + if (nt_header == NULL) + { + printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", + p_infile->name); + do_gcl_abort(); + } + + /* Check the NT header signature ... */ + if (nt_header->Signature != IMAGE_NT_SIGNATURE) + { + printf ("Invalid IMAGE_NT_SIGNATURE 0x%x in %s...bailing.\n", + (int)nt_header->Signature, p_infile->name); + } + + /* Flip through the sections for .data and .bss ... */ + section = (PIMAGE_SECTION_HEADER) IMAGE_FIRST_SECTION (nt_header); + for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) + { +#ifdef SEPARATE_BSS_SECTION + if (!strcmp (section->Name, ".bss")) + { + /* The .bss section. */ + ptr = (char *) nt_header->OptionalHeader.ImageBase + + section->VirtualAddress; + bss_start = ptr; + bss_size = get_section_size (section); + } +#endif +#if 0 + if (!strcmp (section->Name, ".data")) + { + /* From lastfile.c */ + extern char my_edata[]; + + /* The .data section. */ + data_section = section; + ptr = (char *) nt_header->OptionalHeader.ImageBase + + section->VirtualAddress; + data_start_va = ptr; + data_start_file = section->PointerToRawData; + + /* We want to only write Emacs data back to the executable, + not any of the library data (if library data is included, + then a dumped Emacs won't run on system versions other + than the one Emacs was dumped on). */ + data_size = my_edata - data_start_va; + } +#else +#ifdef emacs + #define DATA_SECTION "EMDATA" +#else +#define DATA_SECTION ".data" +#endif + if (!strcmp ((char *)section->Name, DATA_SECTION)) + { + /* The Emacs initialized data section. */ + data_section = section; + ptr = (unsigned char *) nt_header->OptionalHeader.ImageBase + + section->VirtualAddress; + data_start_va = ptr; + data_start_file = section->PointerToRawData; + + /* Write back the full section. */ + data_size = get_section_size (section); + } +#endif + section++; + } + +#ifdef SEPARATE_BSS_SECTION + if (bss_start == UNINIT_PTR && bss_size == UNINIT_LONG) + { + /* Starting with MSVC 4.0, the .bss section has been eliminated + and appended virtually to the end of the .data section. Our + only hint about where the .bss section starts in the address + comes from the SizeOfRawData field in the .data section + header. Unfortunately, this field is only approximate, as it + is a rounded number and is typically rounded just beyond the + start of the .bss section. To find the start and size of the + .bss section exactly, we have to peek into the map file. */ + get_bss_info_from_map_file (p_infile, &ptr, &bss_size); + bss_start = ptr + nt_header->OptionalHeader.ImageBase + + data_section->VirtualAddress; + } +#else +/* As noted in lastfile.c, the Alpha (but not the Intel) MSVC linker + globally segregates all static and public bss data (ie. across all + linked modules, not just per module), so we must take both static and + public bss areas into account to determine the true extent of the bss + area used by Emacs. + + To be strictly correct, we should dump the static and public bss + areas used by Emacs separately if non-overlapping (since otherwise we + are dumping bss data belonging to system libraries, eg. the static + bss system data on the Alpha). However, in practice this doesn't + seem to matter, since presumably the system libraries always + reinitialize their bss variables. */ + bss_start = (unsigned char *)min (my_begbss, my_begbss_static); + bss_size = max ((char *)my_endbss, (char *) my_endbss_static) - (char *) bss_start; + +#endif +} + + +/* The dump routines. */ + +static void +copy_executable_and_dump_data_section (file_data *p_infile, + file_data *p_outfile) +{ + unsigned char *data_file, *data_va; + unsigned long size, index; + + /* Get a pointer to where the raw data should go in the executable file. */ + data_file = (unsigned char *) p_outfile->file_base + data_start_file; + + /* Get a pointer to the raw data in our address space. */ + data_va = data_start_va; + + size = (unsigned long) data_file - (unsigned long) p_outfile->file_base; + /* printf ("Copying executable up to data section...\n"); */ + /* printf ("\t0x%08x Offset in input file.\n", 0); */ + /* printf ("\t0x%08x Offset in output file.\n", 0); */ + /* printf ("\t0x%08lx Size in bytes.\n", size); */ + memcpy (p_outfile->file_base, p_infile->file_base, size); + + size = data_size; + /* printf ("Dumping .data section...\n"); */ + /* printf ("\t0x%p Address in process.\n", data_va); */ + /* printf ("\t0x%08x Offset in output file.\n", */ + /* data_file - p_outfile->file_base); */ + /* printf ("\t0x%08lx Size in bytes.\n", size); */ + memcpy (data_file, data_va, size); + + index = (unsigned long) data_file + size - (unsigned long) p_outfile->file_base; + size = p_infile->size - index; + /* printf ("Copying rest of executable...\n"); */ + /* printf ("\t0x%08lx Offset in input file.\n", index); */ + /* printf ("\t0x%08lx Offset in output file.\n", index); */ + /* printf ("\t0x%08lx Size in bytes.\n", size); */ + memcpy ((char *) p_outfile->file_base + index, + (char *) p_infile->file_base + index, size); +} + +static void +dump_bss_and_heap (file_data *p_infile, file_data *p_outfile) +{ + unsigned char *heap_data, *bss_data; + unsigned long size, index; + + /* printf ("Dumping heap into executable...\n"); */ + + index = heap_index_in_executable; + size = get_committed_heap_size (); + heap_data = get_heap_start (); + + /* printf ("\t0x%p Heap start in process.\n", heap_data); */ + /* printf ("\t0x%08lx Heap offset in executable.\n", index); */ + /* printf ("\t0x%08lx Heap size in bytes.\n", size); */ + + memcpy ((PUCHAR) p_outfile->file_base + index, heap_data, size); + + /* printf ("Dumping .bss into executable...\n"); */ + + index += size; + size = bss_size; + bss_data = bss_start; + + /* printf ("\t0x%p BSS start in process.\n", bss_data); */ + /* printf ("\t0x%08lx BSS offset in executable.\n", index); */ + /* printf ("\t0x%08lx BSS size in bytes.\n", size); */ + memcpy ((char *) p_outfile->file_base + index, bss_data, size); +} + + +/* Reload and remap routines. */ + + +/* Load the dumped .bss section into the .bss area of our address space. */ +void +read_in_bss (char *filename) +{ + HANDLE file; + DWORD index, n_read; + int i; + + file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if (file == INVALID_HANDLE_VALUE) + { + i = GetLastError (); + do_gcl_abort(); + } + + /* Seek to where the .bss section is tucked away after the heap... */ + index = heap_index_in_executable + get_committed_heap_size (); + if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) + { + i = GetLastError (); + do_gcl_abort(); + } + + + /* Ok, read in the saved .bss section and initialize all + uninitialized variables. */ + if (!ReadFile (file, bss_start, bss_size, &n_read, (void *)NULL)) + { + i = GetLastError (); + do_gcl_abort(); + } + + CloseHandle (file); +} + +/* Map the heap dumped into the executable file into our address space. */ +void +map_in_heap (char *filename) +{ + HANDLE file; + HANDLE file_mapping; + void *file_base; + DWORD size, upper_size, n_read; + int i; + + file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if (file == INVALID_HANDLE_VALUE) + { + i = GetLastError (); + do_gcl_abort(); + } + + size = GetFileSize (file, &upper_size); + file_mapping = CreateFileMapping (file, NULL, PAGE_WRITECOPY, + 0, size, NULL); + if (!file_mapping) + { + i = GetLastError (); + do_gcl_abort(); + } + + size = get_committed_heap_size (); + file_base = MapViewOfFileEx (file_mapping, FILE_MAP_ALL_ACCESS, 0, + heap_index_in_executable, size, + get_heap_start ()); + if (file_base != 0) + { + return; + } + + /* If we don't succeed with the mapping, then copy from the + data into the heap. */ + + CloseHandle (file_mapping); + + if (VirtualAlloc (get_heap_start (), get_committed_heap_size (), + MEM_COMMIT, PAGE_EXECUTE_READWRITE) == NULL) + { + i = GetLastError (); + do_gcl_abort(); + } + + /* Seek to the location of the heap data in the executable. */ + i = heap_index_in_executable; + if (SetFilePointer (file, i, NULL, FILE_BEGIN) == 0xFFFFFFFF) + { + i = GetLastError (); + do_gcl_abort(); + } + + /* Read in the data. */ + if (!ReadFile (file, get_heap_start (), + get_committed_heap_size (), &n_read, (void *)NULL)) + { + i = GetLastError (); + do_gcl_abort(); + } + + CloseHandle (file); +} + +/* ntheap.c */ +/* Heap management routines for GNU Emacs on Windows NT. + Copyright (C) 1994 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. + + Geoff Voelker (voelker@cs.washington.edu) 7-29-94 +*/ +/* + +*/ +/* #include "lisp.h" */ /* for VALMASK */ +#define VALMASK -1 +/* try for 500 MB of address space */ +#define VALBITS 29 + +/* This gives us the page size and the size of the allocation unit on NT. */ +SYSTEM_INFO sysinfo_cache; +unsigned long syspage_mask = 0; + +/* These are defined to get Emacs to compile, but are not used. */ +int edata; +int etext; + +/* The major and minor versions of NT. */ +int nt_major_version; +int nt_minor_version; + +/* Distinguish between Windows NT and Windows 95. */ +int os_subtype; + +/* Cache information describing the NT system for later use. */ +void +cache_system_info (void) +{ + union + { + struct info + { + char major; + char minor; + short platform; + } info; + DWORD data; + } version; + + /* Cache the version of the operating system. */ + version.data = GetVersion (); + nt_major_version = version.info.major; + nt_minor_version = version.info.minor; + + if (version.info.platform & 0x8000) + os_subtype = OS_WIN95; + else + os_subtype = OS_NT; + + /* Cache page size, allocation unit, processor type, etc. */ + GetSystemInfo (&sysinfo_cache); + syspage_mask = sysinfo_cache.dwPageSize - 1; +} + +/* Round ADDRESS up to be aligned with ALIGN. */ +unsigned char * +round_to_next (unsigned char *address, unsigned long align) +{ + unsigned long tmp; + + tmp = (unsigned long) address; + tmp = (tmp + align - 1) / align; + + return (unsigned char *) (tmp * align); +} + + +/* The start of the data segment. */ +unsigned char * +get_data_start (void) +{ + return data_region_base; +} + +/* The end of the data segment. */ +unsigned char * +get_data_end (void) +{ + return data_region_end; +} + +void * +probe_base(void *base,unsigned long try,unsigned long inc,unsigned long c) { + void *r; + if (!(r=VirtualAlloc(base,try,MEM_RESERVE,PAGE_NOACCESS))) + return probe_base(base+inc,try,inc,c+1); + VirtualFree (r, 0, MEM_RELEASE); + return !c || inc<2 ? base : probe_base(base-inc,try,inc>>1,c+1); +} + +unsigned long +probe_heap_size(void *base,unsigned long try,unsigned long inc) { + void *r; + if (!(r=VirtualAlloc(base,try,MEM_RESERVE,PAGE_NOACCESS))) + return inc<2 ? try-inc : probe_heap_size(base,try-inc,inc>>1); + VirtualFree (r, 0, MEM_RELEASE); + return probe_heap_size(base,try+inc,inc); +} + +static char * +allocate_heap (void) +{ + /* The base address for our GNU malloc heap is chosen in conjuction + with the link settings for temacs.exe which control the stack size, + the initial default process heap size and the executable image base + address. The link settings and the malloc heap base below must all + correspond; the relationship between these values depends on how NT + and Win95 arrange the virtual address space for a process (and on + the size of the code and data segments in temacs.exe). + + The most important thing is to make base address for the executable + image high enough to leave enough room between it and the 4MB floor + of the process address space on Win95 for the primary thread stack, + the process default heap, and other assorted odds and ends + (eg. environment strings, private system dll memory etc) that are + allocated before temacs has a chance to grab its malloc arena. The + malloc heap base can then be set several MB higher than the + executable image base, leaving enough room for the code and data + segments. + + Because some parts of Emacs can use rather a lot of stack space + (for instance, the regular expression routines can potentially + allocate several MB of stack space) we allow 8MB for the stack. + + Allowing 1MB for the default process heap, and 1MB for odds and + ends, we can base the executable at 16MB and still have a generous + safety margin. At the moment, the executable has about 810KB of + code (for x86) and about 550KB of data - on RISC platforms the code + size could be roughly double, so if we allow 4MB for the executable + we will have plenty of room for expansion. + + Thus we would like to set the malloc heap base to 20MB. However, + Win95 refuses to allocate the heap starting at this address, so we + set the base to 27MB to make it happy. Since Emacs now leaves + 28 bits available for pointers, this lets us use the remainder of + the region below the 256MB line for our malloc arena - 229MB is + still a pretty decent arena to play in! */ + + void *base,*ptr; + unsigned long min=PAGESIZE,inc=(1UL<<31); + +#if defined(__CYGWIN__) + ptr=my_endbss; +#else + ptr=(void *)0x5000000; +#endif + base=probe_base(ptr,min,(unsigned long)my_endbss,0); + reserved_heap_size=probe_heap_size(base,inc+min,inc); + ptr = VirtualAlloc ((void *) base,get_reserved_heap_size (),MEM_RESERVE,PAGE_NOACCESS); + /* printf("probe results: %lu at %p\n",reserved_heap_size,ptr); */ + + DBEGIN = (DBEGIN_TY) ptr; + + return ptr; + +} + +/* Emulate Unix sbrk. */ +void * +sbrk (ptrdiff_t increment) +{ + void *result; + long size = (long) increment; + + /* Allocate our heap if we haven't done so already. */ + if (data_region_base == UNINIT_PTR) + { + data_region_base = (unsigned char *)allocate_heap (); + if (!data_region_base) + return NULL; + + /* Ensure that the addresses don't use the upper tag bits since + the Lisp type goes there. */ + if (((unsigned long) data_region_base & ~VALMASK) != 0) + { + printf ("Error: The heap was allocated in upper memory.\n"); + do_gcl_abort(); + } + + data_region_end = data_region_base; + real_data_region_end = data_region_end; + data_region_size = get_reserved_heap_size (); + } + + result = data_region_end; + + /* If size is negative, shrink the heap by decommitting pages. */ + if (size < 0) + { + int new_size; + unsigned char *new_data_region_end; + + size = -size; + + /* Sanity checks. */ + if ((data_region_end - size) < data_region_base) + return NULL; + + /* We can only decommit full pages, so allow for + partial deallocation [cga]. */ + new_data_region_end = (data_region_end - size); + new_data_region_end = (unsigned char *) + ((long) (new_data_region_end + syspage_mask) & ~syspage_mask); + new_size = real_data_region_end - new_data_region_end; + real_data_region_end = new_data_region_end; + if (new_size > 0) + { + /* Decommit size bytes from the end of the heap. */ + if (!VirtualFree (real_data_region_end, new_size, MEM_DECOMMIT)) + return NULL; + } + + data_region_end -= size; + } + /* If size is positive, grow the heap by committing reserved pages. */ + else if (size > 0) + { + /* Sanity checks. */ + if ((data_region_end + size) > + (data_region_base + get_reserved_heap_size ())) + return NULL; + + /* Commit more of our heap. */ + if (VirtualAlloc (data_region_end, size, MEM_COMMIT, + PAGE_EXECUTE_READWRITE) == NULL) + return NULL; + data_region_end += size; + + /* We really only commit full pages, so record where + the real end of committed memory is [cga]. */ + real_data_region_end = (unsigned char *) + ((long) (data_region_end + syspage_mask) & ~syspage_mask); + } + + return result; +} + +#ifdef __CYGWIN__ +/* Emulate Unix getpagesize. */ +int getpagesize (void) { return 4096; } +#endif + +/* Recreate the heap from the data that was dumped to the executable. + EXECUTABLE_PATH tells us where to find the executable. */ +void +recreate_heap (char *executable_path) { + + unsigned char *tmp; + + /* First reserve the upper part of our heap. (We reserve first + because there have been problems in the past where doing the + mapping first has loaded DLLs into the VA space of our heap.) */ + tmp = VirtualAlloc ((void *) get_heap_start (), + get_reserved_heap_size (), + MEM_RESERVE, + PAGE_NOACCESS); + if (!tmp) + do_gcl_abort(); + + /* We read in the data for the .bss section from the executable + first and map in the heap from the executable second to prevent + any funny interactions between file I/O and file mapping. */ + + read_in_bss (executable_path); + + map_in_heap (executable_path); + + /* Update system version information to match current system. */ + cache_system_info (); + +} + +/* Round the heap up to the given alignment. */ +void +round_heap (unsigned long align) +{ + unsigned long needs_to_be; + unsigned long need_to_alloc; + + needs_to_be = (unsigned long) round_to_next (get_heap_end (), align); + need_to_alloc = needs_to_be - (unsigned long) get_heap_end (); + + if (need_to_alloc) + sbrk (need_to_alloc); +} + +#if (_MSC_VER >= 1000) + +/* MSVC 4.2 invokes these functions from mainCRTStartup to initialize + a heap via HeapCreate. They are normally defined by the runtime, + but we override them here so that the unnecessary HeapCreate call + is not performed. */ + +int __cdecl +_heap_init (void) +{ + /* Stepping through the assembly indicates that mainCRTStartup is + expecting a nonzero success return value. */ + return 1; +} + +void __cdecl +_heap_term (void) + +#endif + + + +#ifdef UNIXSAVE +BOOL ctrl_c_handler (unsigned long type) +{ + extern void sigint(void); + sigint(); + return 0; + +} +#include "save.c" +#endif diff --git a/o/unexsgi.c b/o/unexsgi.c new file mode 100755 index 0000000..7d0a13e --- /dev/null +++ b/o/unexsgi.c @@ -0,0 +1,896 @@ +/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992 + Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. + +In other words, you are welcome to use, share and improve this program. +You are forbidden to forbid anyone else to use, share and improve +what you give them. Help stamp out software-hoarding! */ + + +/* + * unexec.c - Convert a running program into an a.out file. + * + * Author: Spencer W. Thomas + * Computer Science Dept. + * University of Utah + * Date: Tue Mar 2 1982 + * Modified heavily since then. + * + * Synopsis: + * unexec (new_name, a_name, data_start, bss_start, entry_address) + * char *new_name, *a_name; + * unsigned data_start, bss_start, entry_address; + * + * Takes a snapshot of the program and makes an a.out format file in the + * file named by the string argument new_name. + * If a_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing a_name file is required. + * + * The boundaries within the a.out file may be adjusted with the data_start + * and bss_start arguments. Either or both may be given as 0 for defaults. + * + * Data_start gives the boundary between the text segment and the data + * segment of the program. The text segment can contain shared, read-only + * program code and literal data, while the data segment is always unshared + * and unprotected. Data_start gives the lowest unprotected address. + * The value you specify may be rounded down to a suitable boundary + * as required by the machine you are using. + * + * Specifying zero for data_start means the boundary between text and data + * should not be the same as when the program was loaded. + * If NO_REMAP is defined, the argument data_start is ignored and the + * segment boundaries are never changed. + * + * Bss_start indicates how much of the data segment is to be saved in the + * a.out file and restored when the program is executed. It gives the lowest + * unsaved address, and is rounded up to a page boundary. The default when 0 + * is given assumes that the entire data segment is to be stored, including + * the previous data and bss as well as any additional storage allocated with + * break (2). + * + * The new file is set up to start at entry_address. + * + * If you make improvements I'd like to get them too. + * harpo!utah-cs!thomas, thomas@Utah-20 + * + */ + +/* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co. + * ELF support added. + * + * Basic theory: the data space of the running process needs to be + * dumped to the output file. Normally we would just enlarge the size + * of .data, scooting everything down. But we can't do that in ELF, + * because there is often something between the .data space and the + * .bss space. + * + * In the temacs dump below, notice that the Global Offset Table + * (.got) and the Dynamic link data (.dynamic) come between .data1 and + * .bss. It does not work to overlap .data with these fields. + * + * The solution is to create a new .data segment. This segment is + * filled with data from the current process. Since the contents of + * various sections refer to sections by index, the new .data segment + * is made the last in the table to avoid changing any existing index. + + * This is an example of how the section headers are changed. "Addr" + * is a process virtual address. "Offset" is a file offset. + +raid:/nfs/raid/src/dist-18.56/src> dump -h temacs + +temacs: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 8 3 0x80a98f4 0x608f4 0x449c .bss + 0 0 0x4 0 + +[17] 2 0 0 0x608f4 0x9b90 .symtab + 18 371 0x4 0x10 + +[18] 3 0 0 0x6a484 0x8526 .strtab + 0 0 0x1 0 + +[19] 3 0 0 0x729aa 0x93 .shstrtab + 0 0 0x1 0 + +[20] 1 0 0 0x72a3d 0x68b7 .comment + 0 0 0x1 0 + +raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs + +xemacs: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 + +[17] 2 0 0 0x7d800 0x9b90 .symtab + 18 371 0x4 0x10 + +[18] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 + +[19] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 + +[20] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 + +[21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 + + * This is an example of how the file header is changed. "Shoff" is + * the section header offset within the file. Since that table is + * after the new .data section, it is moved. "Shnum" is the number of + * sections, which we increment. + * + * "Phoff" is the file offset to the program header. "Phentsize" and + * "Shentsz" are the program and section header entries sizes respectively. + * These can be larger than the apparent struct sizes. + +raid:/nfs/raid/src/dist-18.56/src> dump -f temacs + +temacs: + + **** ELF HEADER **** +Class Data Type Machine Version +Entry Phoff Shoff Flags Ehsize +Phentsize Phnum Shentsz Shnum Shstrndx + +1 1 2 3 1 +0x80499cc 0x34 0x792f4 0 0x34 +0x20 5 0x28 21 19 + +raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs + +xemacs: + + **** ELF HEADER **** +Class Data Type Machine Version +Entry Phoff Shoff Flags Ehsize +Phentsize Phnum Shentsz Shnum Shstrndx + +1 1 2 3 1 +0x80499cc 0x34 0x96200 0 0x34 +0x20 5 0x28 22 19 + + * These are the program headers. "Offset" is the file offset to the + * segment. "Vaddr" is the memory load address. "Filesz" is the + * segment size as it appears in the file, and "Memsz" is the size in + * memory. Below, the third segment is the code and the fourth is the + * data: the difference between Filesz and Memsz is .bss + +raid:/nfs/raid/src/dist-18.56/src> dump -o temacs + +temacs: + ***** PROGRAM EXECUTION HEADER ***** +Type Offset Vaddr Paddr +Filesz Memsz Flags Align + +6 0x34 0x8048034 0 +0xa0 0xa0 5 0 + +3 0xd4 0 0 +0x13 0 4 0 + +1 0x34 0x8048034 0 +0x3f2f9 0x3f2f9 5 0x1000 + +1 0x3f330 0x8088330 0 +0x215c4 0x25a60 7 0x1000 + +2 0x60874 0x80a9874 0 +0x80 0 7 0 + +raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs + +xemacs: + ***** PROGRAM EXECUTION HEADER ***** +Type Offset Vaddr Paddr +Filesz Memsz Flags Align + +6 0x34 0x8048034 0 +0xa0 0xa0 5 0 + +3 0xd4 0 0 +0x13 0 4 0 + +1 0x34 0x8048034 0 +0x3f2f9 0x3f2f9 5 0x1000 + +1 0x3f330 0x8088330 0 +0x3e4d0 0x3e4d0 7 0x1000 + +2 0x60874 0x80a9874 0 +0x80 0 7 0 + + + */ + +/* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. + * + * The above mechanism does not work if the unexeced ELF file is being + * re-layout by other applications (such as `strip'). All the applications + * that re-layout the internal of ELF will layout all sections in ascending + * order of their file offsets. After the re-layout, the data2 section will + * still be the LAST section in the section header vector, but its file offset + * is now being pushed far away down, and causes part of it not to be mapped + * in (ie. not covered by the load segment entry in PHDR vector), therefore + * causes the new binary to fail. + * + * The solution is to modify the unexec algorithm to insert the new data2 + * section header right before the new bss section header, so their file + * offsets will be in the ascending order. Since some of the section's (all + * sections AFTER the bss section) indexes are now changed, we also need to + * modify some fields to make them point to the right sections. This is done + * by macro PATCH_INDEX. All the fields that need to be patched are: + * + * 1. ELF header e_shstrndx field. + * 2. section header sh_link and sh_info field. + * 3. symbol table entry st_shndx field. + * + * The above example now should look like: + + **** SECTION HEADER TABLE **** +[No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize + +[1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 + +[2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 + +[3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 + +[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 + +[5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 + +[6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 + +[7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 + +[8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 + +[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 + +[10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 + +[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 + +[12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 + +[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 + +[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 + +[15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 + +[16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 + +[17] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 + +[18] 2 0 0 0x7d800 0x9b90 .symtab + 19 371 0x4 0x10 + +[19] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 + +[20] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 + +[21] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 + + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include /* for HDRR declaration */ +#include + +#ifndef emacs +#define fatal(a, b, c) fprintf(stderr, a, b, c), exit(1) +#else +extern void fatal(char *, ...); +#endif + +/* Get the address of a particular section or program header entry, + * accounting for the size of the entries. + */ + +#define OLD_SECTION_H(n) \ + (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) +#define NEW_SECTION_H(n) \ + (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) +#define OLD_PROGRAM_H(n) \ + (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) +#define NEW_PROGRAM_H(n) \ + (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) + +#define PATCH_INDEX(n) \ + do { \ + if ((n) >= old_bss_index) \ + (n)++; } while (0) +typedef unsigned char byte; + +/* Round X up to a multiple of Y. */ + +int +round_up (x, y) + int x, y; +{ + int rem = x % y; + if (rem == 0) + return x; + return x - rem + y; +} + +/* Return the index of the section named NAME. + SECTION_NAMES, FILE_NAME and FILE_H give information + about the file we are looking in. + + If we don't find the section NAME, that is a fatal error + if NOERROR is 0; we return -1 if NOERROR is nonzero. */ + +static int +find_section (name, section_names, file_name, old_file_h, old_section_h, noerror) + char *name; + char *section_names; + char *file_name; + Elf32_Ehdr *old_file_h; + Elf32_Shdr *old_section_h; + int noerror; +{ + int idx; + + for (idx = 1; idx < old_file_h->e_shnum; idx++) + { +#ifdef DEBUG + fprintf (stderr, "Looking for %s - found %s\n", name, + section_names + OLD_SECTION_H (idx).sh_name); +#endif + if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, + name)) + break; + } + if (idx == old_file_h->e_shnum) + { + if (noerror) + return -1; + else + fatal ("Can't find .bss in %s.\n", file_name, 0); + } + + return idx; +} + +/* **************************************************************** + * unexec + * + * driving logic. + * + * In ELF, this works by replacing the old .bss section with a new + * .data section, and inserting an empty .bss immediately afterwards. + * + */ +void +unexec (new_name, old_name, data_start, bss_start, entry_address) + char *new_name, *old_name; + unsigned data_start, bss_start, entry_address; +{ + extern unsigned int bss_end; + int new_file, old_file, new_file_size; + + /* Pointers to the base of the image of the two files. */ + caddr_t old_base, new_base; + + /* Pointers to the file, program and section headers for the old and new + files. */ + Elf32_Ehdr *old_file_h, *new_file_h; + Elf32_Phdr *old_program_h, *new_program_h; + Elf32_Shdr *old_section_h, *new_section_h; + + /* Point to the section name table in the old file. */ + char *old_section_names; + + Elf32_Addr old_bss_addr, new_bss_addr; + Elf32_Word old_bss_size, new_data2_size; + Elf32_Off new_data2_offset; + Elf32_Addr new_data2_addr; + Elf32_Addr new_offsets_shift; + + int n, nn, old_bss_index, old_data_index, new_data2_index; + int old_mdebug_index; + struct stat stat_buf; + + /* Open the old file & map it into the address space. */ + + old_file = open (old_name, O_RDONLY); + + if (old_file < 0) + fatal ("Can't open %s for reading: errno %d\n", old_name, errno); + + if (fstat (old_file, &stat_buf) == -1) + fatal ("Can't fstat(%s): errno %d\n", old_name, errno); + + old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); + + if (old_base == (caddr_t) -1) + fatal ("Can't mmap(%s): errno %d\n", old_name, errno); + +#ifdef DEBUG + fprintf (stderr, "mmap(%s, %x) -> %x\n", old_name, stat_buf.st_size, + old_base); +#endif + + /* Get pointers to headers & section names. */ + + old_file_h = (Elf32_Ehdr *) old_base; + old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff); + old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff); + old_section_names + = (char *) old_base + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; + + /* Find the mdebug section, if any. */ + + old_mdebug_index = find_section (".mdebug", old_section_names, + old_name, old_file_h, old_section_h, 1); + + /* Find the old .bss section. */ + + old_bss_index = find_section (".bss", old_section_names, + old_name, old_file_h, old_section_h, 0); + + /* Find the old .data section. Figure out parameters of + the new data2 and bss sections. */ + + old_data_index = find_section (".data", old_section_names, + old_name, old_file_h, old_section_h, 0); + + old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; + old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; +#if defined(emacs) || !defined(DEBUG) + bss_end = (unsigned int) sbrk (0); + new_bss_addr = (Elf32_Addr) bss_end; + /* add for gcl */ + core_end = (char *) bss_end; +#else + new_bss_addr = old_bss_addr + old_bss_size + 0x1234; +#endif + new_data2_addr = old_bss_addr; + new_data2_size = new_bss_addr - old_bss_addr; + new_data2_offset = OLD_SECTION_H (old_data_index).sh_offset + + (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); + new_offsets_shift = new_bss_addr - + ((old_bss_addr & ~0xfff) + ((old_bss_addr & 0xfff) ? 0x1000 : 0)); + +#ifdef DEBUG + fprintf (stderr, "old_bss_index %d\n", old_bss_index); + fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); + fprintf (stderr, "old_bss_size %x\n", old_bss_size); + fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); + fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); + fprintf (stderr, "new_data2_size %x\n", new_data2_size); + fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); + fprintf (stderr, "new_offsets_shift %x\n", new_offsets_shift); +#endif + + if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) + fatal (".bss shrank when undumping???\n", 0, 0); + + /* Set the output file to the right size and mmap it. Set + pointers to various interesting objects. stat_buf still has + old_file data. */ + + new_file = open (new_name, O_RDWR | O_CREAT, 0666); + if (new_file < 0) + fatal ("Can't creat (%s): errno %d\n", new_name, errno); + + new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_offsets_shift; + + if (ftruncate (new_file, new_file_size)) + fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); + + new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED, + new_file, 0); + + if (new_base == (caddr_t) -1) + fatal ("Can't mmap (%s): errno %d\n", new_name, errno); + + new_file_h = (Elf32_Ehdr *) new_base; + new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff); + new_section_h + = (Elf32_Shdr *) ((byte *) new_base + old_file_h->e_shoff + + new_offsets_shift); + + /* Make our new file, program and section headers as copies of the + originals. */ + + memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); + memcpy (new_program_h, old_program_h, + old_file_h->e_phnum * old_file_h->e_phentsize); + + /* Modify the e_shstrndx if necessary. */ + PATCH_INDEX (new_file_h->e_shstrndx); + + /* Fix up file header. We'll add one section. Section header is + further away now. */ + + new_file_h->e_shoff += new_offsets_shift; + new_file_h->e_shnum += 1; + +#ifdef DEBUG + fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); + fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); + fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); + fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); +#endif + + /* Fix up a new program header. Extend the writable data segment so + that the bss area is covered too. Find that segment by looking + for a segment that ends just before the .bss area. Make sure + that no segments are above the new .data2. Put a loop at the end + to adjust the offset and address of any segment that is above + data2, just in case we decide to allow this later. */ + + for (n = new_file_h->e_phnum - 1; n >= 0; n--) + { + /* Compute maximum of all requirements for alignment of section. */ + int alignment = (NEW_PROGRAM_H (n)).p_align; + if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) + alignment = OLD_SECTION_H (old_bss_index).sh_addralign; + + /* Supposedly this condition is okay for the SGI. */ +#if 0 + if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr) + fatal ("Program segment above .bss in %s\n", old_name, 0); +#endif + + if (NEW_PROGRAM_H (n).p_type == PT_LOAD + && (round_up ((NEW_PROGRAM_H (n)).p_vaddr + + (NEW_PROGRAM_H (n)).p_filesz, + alignment) + == round_up (old_bss_addr, alignment))) + break; + } + if (n < 0) + fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0); + + NEW_PROGRAM_H (n).p_filesz += new_offsets_shift; + NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; + +#if 1 /* Maybe allow section after data2 - does this ever happen? */ + for (n = new_file_h->e_phnum - 1; n >= 0; n--) + { + if (NEW_PROGRAM_H (n).p_vaddr + && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr) + NEW_PROGRAM_H (n).p_vaddr += new_offsets_shift - old_bss_size; + + if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset) + NEW_PROGRAM_H (n).p_offset += new_offsets_shift; + } +#endif + + /* Fix up section headers based on new .data2 section. Any section + whose offset or virtual address is after the new .data2 section + gets its value adjusted. .bss size becomes zero and new address + is set. data2 section header gets added by copying the existing + .data header and modifying the offset, address and size. */ + for (old_data_index = 1; old_data_index < old_file_h->e_shnum; + old_data_index++) + if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name, + ".data")) + break; + if (old_data_index == old_file_h->e_shnum) + fatal ("Can't find .data in %s.\n", old_name, 0); + + /* Walk through all section headers, insert the new data2 section right + before the new bss section. */ + for (n = 1, nn = 1; n < old_file_h->e_shnum; n++, nn++) + { + caddr_t src; + + /* If it is bss section, insert the new data2 section before it. */ + if (n == old_bss_index) + { + /* Steal the data section header for this data2 section. */ + memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index), + new_file_h->e_shentsize); + + NEW_SECTION_H (nn).sh_addr = new_data2_addr; + NEW_SECTION_H (nn).sh_offset = new_data2_offset; + NEW_SECTION_H (nn).sh_size = new_data2_size; + /* Use the bss section's alignment. This will assure that the + new data2 section always be placed in the same spot as the old + bss section by any other application. */ + NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign; + + /* Now copy over what we have in the memory now. */ + memcpy (NEW_SECTION_H (nn).sh_offset + new_base, + (caddr_t) OLD_SECTION_H (n).sh_addr, + new_data2_size); + nn++; + memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), + old_file_h->e_shentsize); + + /* The new bss section's size is zero, and its file offset and virtual + address should be off by NEW_OFFSETS_SHIFT. */ + NEW_SECTION_H (nn).sh_offset += new_offsets_shift; + NEW_SECTION_H (nn).sh_addr = new_bss_addr; + /* Let the new bss section address alignment be the same as the + section address alignment followed the old bss section, so + this section will be placed in exactly the same place. */ + NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign; + NEW_SECTION_H (nn).sh_size = 0; + } + else + memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), + old_file_h->e_shentsize); + + /* Any section that was original placed AFTER the bss + section must now be adjusted by NEW_OFFSETS_SHIFT. */ + + if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) + NEW_SECTION_H (nn).sh_offset += new_offsets_shift; + + /* If any section hdr refers to the section after the new .data + section, make it refer to next one because we have inserted + a new section in between. */ + + PATCH_INDEX (NEW_SECTION_H (nn).sh_link); + /* For symbol tables, info is a symbol table index, + so don't change it. */ + if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB + && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM) + PATCH_INDEX (NEW_SECTION_H (nn).sh_info); + + /* Now, start to copy the content of sections. */ + if (NEW_SECTION_H (nn).sh_type == SHT_NULL + || NEW_SECTION_H (nn).sh_type == SHT_NOBITS) + continue; + + /* Write out the sections. .data and .data1 (and data2, called + ".data" in the strings table) get copied from the current process + instead of the old file. */ + if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") + || !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data1") + || !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".got")) + src = (caddr_t) OLD_SECTION_H (n).sh_addr; + else + src = old_base + OLD_SECTION_H (n).sh_offset; + + memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src, + NEW_SECTION_H (nn).sh_size); + + /* Adjust the HDRR offsets in .mdebug and copy the + line data if it's in its usual 'hole' in the object. + Makes the new file debuggable with dbx. + patches up two problems: the absolute file offsets + in the HDRR record of .mdebug (see /usr/include/syms.h), and + the ld bug that gets the line table in a hole in the + elf file rather than in the .mdebug section proper. + David Anderson. davea@sgi.com Jan 16,1994. */ + if (n == old_mdebug_index) + { +#define MDEBUGADJUST(__ct,__fileaddr) \ + if (n_phdrr->__ct > 0) \ + { \ + n_phdrr->__fileaddr += movement; \ + } + + HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset); + HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset); + unsigned movement = new_offsets_shift; + + MDEBUGADJUST (idnMax, cbDnOffset); + MDEBUGADJUST (ipdMax, cbPdOffset); + MDEBUGADJUST (isymMax, cbSymOffset); + MDEBUGADJUST (ioptMax, cbOptOffset); + MDEBUGADJUST (iauxMax, cbAuxOffset); + MDEBUGADJUST (issMax, cbSsOffset); + MDEBUGADJUST (issExtMax, cbSsExtOffset); + MDEBUGADJUST (ifdMax, cbFdOffset); + MDEBUGADJUST (crfd, cbRfdOffset); + MDEBUGADJUST (iextMax, cbExtOffset); + /* The Line Section, being possible off in a hole of the object, + requires special handling. */ + if (n_phdrr->cbLine > 0) + { + if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset + + OLD_SECTION_H (n).sh_size)) + { + /* line data is in a hole in elf. do special copy and adjust + for this ld mistake. + */ + n_phdrr->cbLineOffset += movement; + + memcpy (n_phdrr->cbLineOffset + new_base, + o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine); + } + else + { + /* somehow line data is in .mdebug as it is supposed to be. */ + MDEBUGADJUST (cbLine, cbLineOffset); + } + } + } + + /* If it is the symbol table, its st_shndx field needs to be patched. */ + if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB + || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM) + { + Elf32_Shdr *spt = &NEW_SECTION_H (nn); + unsigned int num = spt->sh_size / spt->sh_entsize; + Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset + + new_base); + for (; num--; sym++) + { + if (sym->st_shndx == SHN_UNDEF + || sym->st_shndx == SHN_ABS + || sym->st_shndx == SHN_COMMON) + continue; + + PATCH_INDEX (sym->st_shndx); + } + } + } + + /* Close the files and make the new file executable. */ + + if (close (old_file)) + fatal ("Can't close (%s): errno %d\n", old_name, errno); + + if (close (new_file)) + fatal ("Can't close (%s): errno %d\n", new_name, errno); + + if (stat (new_name, &stat_buf) == -1) + fatal ("Can't stat (%s): errno %d\n", new_name, errno); + + n = umask (777); + umask (n); + stat_buf.st_mode |= 0111 & ~n; + if (chmod (new_name, stat_buf.st_mode) == -1) + fatal ("Can't chmod (%s): errno %d\n", new_name, errno); +} + + +#ifdef UNIXSAVE +#include "save.c" +#endif + diff --git a/o/unixfasl.c b/o/unixfasl.c new file mode 100755 index 0000000..d465a6c --- /dev/null +++ b/o/unixfasl.c @@ -0,0 +1,194 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#define IN_UNIXFASL +#include "include.h" + +#ifdef UNIXFASL +#include UNIXFASL +#else + +#ifdef HAVE_AOUT +#undef BSD +#undef ATT +#define BSD +#include HAVE_AOUT +#endif + +#ifdef COFF_ENCAPSULATE +#undef BSD +#undef ATT +#define BSD +#include "a.out.encap.h" +#endif + +#ifdef ATT +#include +#include +#include +#endif + +#ifdef E15 +#include +#define exec bhdr +#define a_text tsize +#define a_data dsize +#define a_bss bsize +#define a_syms ssize +#define a_trsize rtsize +#define a_drsize rdsize +#endif + +#ifdef BSD +#define textsize header.a_text +#define datasize header.a_data +#define bsssize header.a_bss +#ifdef COFF_ENCAPSULATE +#define textstart sizeof(header) +sizeof(struct coffheader) +#else +#define textstart sizeof(header) +#endif +#define newbsssize newheader.a_bss +#endif + +#ifndef HEADER_SEEK +#define HEADER_SEEK +#endif + +#ifndef MAXPATHLEN +# define MAXPATHLEN 1024 +#endif + +#ifndef SFASL +#error must define SFASL +#endif /* ifndef SFASL */ + +#ifndef __svr4__ +#ifdef BSD + +#define FASLINK +#ifndef PRIVATE_FASLINK + +DEFUN_NEW("FASLINK-INT",object,fSfaslink_int,SI,2,2,NONE,II,OO,OO,OO,(object faslfile, object ldargstring),"") { +#if defined(__ELF__) || defined(DARWIN) + FEerror("faslink() not supported for ELF or DARWIN yet",0); + return 0; +#else + struct exec header, faslheader; + object memory, data, tempfile; + FILE *fp; + char filename[MAXPATHLEN]; + char ldargstr[MAXPATHLEN]; + char tempfilename[32]; + char command[MAXPATHLEN * 2]; + char buf[BUFSIZ]; + int i; + object *old_vs_base = vs_base; + object *old_vs_top = vs_top; + + coerce_to_filename(ldargstring, ldargstr); + coerce_to_filename(faslfile, filename); + + sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); + LD_COMMAND(command, + kcl_self, + (int)core_end, + filename, + ldargstr, + tempfilename); + + if (system(command) != 0) + FEerror("The linkage editor failed.", 0); + + fp = fopen(tempfilename, "r"); + setbuf(fp, buf); + fread(&header, sizeof(header), 1, fp); + {BEGIN_NO_INTERRUPT; + memory=new_cfdata(); + memory->cfd.cfd_size = textsize + datasize + bsssize; + vs_push(memory); + memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, + memory->cfd.cfd_size, + sizeof(double)); + END_NO_INTERRUPT;} + fclose(fp); + + faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + vs_push(faslfile); +#ifdef SEEK_TO_END_OFILE +SEEK_TO_END_OFILE(faslfile->sm.sm_fp); +#else + fp = faslfile->sm.sm_fp; + fread(&faslheader, sizeof(faslheader), 1, fp); + fseek(fp, + faslheader.a_text+faslheader.a_data+ + faslheader.a_syms+faslheader.a_trsize+faslheader.a_drsize, + 1); + fread(&i, sizeof(i), 1, fp); + fseek(fp, i - sizeof(i), 1); +#endif + data = read_fasl_vector(faslfile); + vs_push(data); + close_stream(faslfile); + LD_COMMAND(command, + kcl_self, + memory->cfd.cfd_start, + filename, + ldargstr, + tempfilename); + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %x ",memory->cfd.cfd_start); + if (system(command) != 0) + FEerror("The linkage editor failed.", 0); + + tempfile = make_simple_string(tempfilename); + vs_push(tempfile); + tempfile = open_stream(tempfile, smm_input, Cnil, sKerror); + vs_push(tempfile); + fp = tempfile->sm.sm_fp; + + if (fseek(fp, textstart, 0) < 0) + error("file seek error"); + + fread(memory->cfd.cfd_start, textsize + datasize, 1, fp); + + close_stream(tempfile); + + unlink(tempfilename); + + call_init(0,memory,data,0); + + vs_base = old_vs_base; + vs_top = old_vs_top; + + return(memory->cfd.cfd_size); +#endif +} + +#endif + +#endif +#endif/* svr4 */ +#endif /* UNIXFASL */ + +void +gcl_init_unixfasl(void) { +} diff --git a/o/unixfsys.c b/o/unixfsys.c new file mode 100755 index 0000000..6e1ea8b --- /dev/null +++ b/o/unixfsys.c @@ -0,0 +1,582 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include +#include +#include + +#define IN_UNIXFSYS +#include "include.h" +#include +#include +#ifndef NO_PWD_H +#include +#endif + +#ifdef __MINGW32__ +# include +/* Windows has no symlink, therefore no lstat. Without symlinks lstat + is equivalent to stat anyway. */ +# define S_ISLNK(a) 0 +# define lstat stat +#endif + +static object +get_string(object x) { + + switch(type_of(x)) { + case t_symbol: + case t_string: + return x; + case t_pathname: + return x->pn.pn_namestring; + case t_stream: + switch(x->sm.sm_mode) { + case smm_input: + case smm_output: + case smm_probe: + case smm_io: + return get_string(x->sm.sm_object1); + case smm_synonym: + return get_string(x->sm.sm_object0->s.s_dbind); + } + } + + return Cnil; + +} + +void +coerce_to_filename1(object spec, char *p,unsigned sz) { + + object namestring=get_string(spec); + + massert(type_of(namestring)==t_string); + massert(namestring->st.st_fillpst.st_self,namestring->st.st_fillp); + p[namestring->st.st_fillp]=0; + +} + +#ifndef __MINGW32__ +static char GETPW_BUF[16384]; +#endif + +DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { +#ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); + massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + + massert(!getpwuid_r(uid,&pw,GETPW_BUF,r,&pwent)); + + RETURN1(make_simple_string(pwent->pw_name)); +#else + RETURN1(Cnil); +#endif +} + +int +home_namestring1(const char *n,int s,char *o,int so) { + + #ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + + massert(s>0); + massert(*n=='~'); + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); + massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + + if (s==1) + + if ((pw.pw_dir=getenv("HOME"))) + pwent=&pw; + else + massert(!getpwuid_r(getuid(),&pw,GETPW_BUF,r,&pwent) && pwent); + + else { + + massert(spw_dir))+2pw_dir,r); + o[r]='/'; + o[r+1]=0; + return 0; +#else + massert(snprintf(o,so-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); + return 0; +#endif + +} + + +DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { + + check_type_string(&nm); + + massert(!home_namestring1(nm->st.st_self,nm->st.st_fillp,FN1,sizeof(FN1))); + RETURN1(make_simple_string(FN1)); + +} +#ifdef STATIC_FUNCTION_POINTERS +object +fShome_namestring(object x) { + return FFN(fShome_namestring)(x); +} +#endif + + + +#define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) +#define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) + +FILE * +fopen_not_dir(char *filename,char *option) { + + struct stat ss; + + return DIR_EXISTS_P(filename,ss) ? NULL : fopen(filename,option); + +} + +int +file_len(FILE *fp) {/*FIXME dir*/ + + struct stat filestatus; + + return fstat(fileno(fp), &filestatus) ? 0 : filestatus.st_size; + +} + +bool +file_exists(object x) { + + struct stat ss; + + coerce_to_filename(x,FN1); + + return FILE_EXISTS_P(FN1,ss) ? TRUE : FALSE; + +} + +DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); +DEF_ORDINARY("LINK",sKlink,KEYWORD,""); +DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + +static int +stat_internal(object x,struct stat *ssp) { + + if (type_of(x)==t_string) { + + coerce_to_filename(x,FN1); + +#ifdef __MINGW32__ + {char *p=FN1+strlen(FN1)-1;for (;p>FN1 && *p=='/';p--) *p=0;} +#endif + if (lstat(FN1,ssp)) + return 0; + } else if ((x=file_stream(x))!=Cnil&&x->sm.sm_fp) { + if (fstat(fileno((FILE *)x->sm.sm_fp),ssp)) + return 0; + } else + return 0; + return 1; +} + +static object +stat_mode_key(struct stat *ssp) { + + return S_ISDIR(ssp->st_mode) ? sKdirectory : (S_ISLNK(ssp->st_mode) ? sKlink : sKfile); + +} + +DEFUN_NEW("STAT1",object,fSstat1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + struct stat ss; + + RETURN1(stat_internal(x,&ss) ? stat_mode_key(&ss) : Cnil); + +} + + +DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + struct stat ss; + + if (stat_internal(x,&ss)) + RETURN4(stat_mode_key(&ss), + make_fixnum(ss.st_size), + make_fixnum(ss.st_mtime), + make_fixnum(ss.st_uid)); + else + RETURN1(Cnil); + +} + +DEFUN_NEW("FTELL",object,fSftell,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + + RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp ? (object)ftell(x->sm.sm_fp) : (object)0); + +} + +DEFUN_NEW("FSEEK",object,fSfseek,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum pos),"") { + + RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp&&!fseek(x->sm.sm_fp,pos,SEEK_SET) ? Ct : Cnil); + +} + +#include +#include +#include +#include + +DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { + ssize_t l,z1; + + check_type_string(&s); + /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ + z1=length(s); + massert(z1st.st_self,z1); + FN1[z1]=0; +#ifndef __MINGW32__ + massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l +#include + +DEFUN_NEW("OPENDIR",object,fSopendir,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { + check_type_string(&x); + coerce_to_filename(x,FN1); + return (object)opendir(strlen(FN1) ? FN1 : "./"); +} + + +DEFUN_NEW("D-TYPE-LIST",object,fSd_type_list,SI,0,0,NONE,OI,OO,OO,OO,(void),"") { + RETURN1( + +#ifdef HAVE_D_TYPE + list(8, + MMcons(make_fixnum(DT_BLK),make_keyword("BLOCK")), + MMcons(make_fixnum(DT_CHR),make_keyword("CHAR")), + MMcons(make_fixnum(DT_DIR),make_keyword("DIRECTORY")), + MMcons(make_fixnum(DT_FIFO),make_keyword("FIFO")), + MMcons(make_fixnum(DT_LNK),make_keyword("LINK")), + MMcons(make_fixnum(DT_REG),make_keyword("FILE")), + MMcons(make_fixnum(DT_SOCK),make_keyword("SOCKET")), + MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) + ) +#else +#undef DT_UNKNOWN +#define DT_UNKNOWN 0 +#undef DT_REG +#define DT_REG 1 +#undef DT_DIR +#define DT_DIR 2 + list(3, + MMcons(make_fixnum(DT_REG),make_keyword("FILE")), + MMcons(make_fixnum(DT_DIR),make_keyword("DIRECTORY")), + MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) + ) +#endif + ); +} + + + +DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { + + struct dirent *e; + object z; + long tl; + size_t l; + long d_type=DT_UNKNOWN; +#ifdef HAVE_D_TYPE +#define get_d_type(e,s) e->d_type +#else +#define get_d_type(e,s) \ + ({struct stat ss;\ + massert(snprintf(FN1,sizeof(FN1),"%-*.*s%s",s->st.st_fillp,s->st.st_fillp,s->st.st_self,e->d_name)>=0);\ + lstat(FN1,&ss);S_ISDIR(ss.st_mode) ? DT_DIR : DT_REG;}) +#endif + + if (!x) RETURN1(Cnil); + + tl=telldir((DIR *)x); + + for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && y!=(d_type=get_d_type(e,s));); + if (!e) RETURN1(Cnil); + + if (s==Cnil) + z=make_simple_string(e->d_name); + else { + check_type_string(&s); + l=strlen(e->d_name); + if (s->st.st_dim-s->st.st_fillp>=l) { + memcpy(s->st.st_self+s->st.st_fillp,e->d_name,l); + s->st.st_fillp+=l; + z=s; + } else { + seekdir((DIR *)x,tl); + RETURN1(make_fixnum(l)); + } + } + + if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(d_type)); + + RETURN1(z); + +} + +DEFUN_NEW("CLOSEDIR",object,fSclosedir,SI,1,1,NONE,OI,OO,OO,OO,(fixnum x),"") { + closedir((DIR *)x); + return Cnil; +} + +DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + + check_type_string(&x); + check_type_string(&y); + + coerce_to_filename(x,FN1); + coerce_to_filename(y,FN2); + + RETURN1(rename(FN1,FN2) ? Cnil : Ct); + +} + +DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + check_type_string(&x); + + coerce_to_filename(x,FN1); + + RETURN1(unlink(FN1) ? Cnil : Ct); + +} + + +DEFUN_NEW("CHDIR1",object,fSchdir1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + check_type_string(&x); + + coerce_to_filename(x,FN1); + + RETURN1(chdir(FN1) ? Cnil : Ct); + +} + +DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + check_type_string(&x); + + coerce_to_filename(x,FN1); + + RETURN1(mkdir(FN1 +#ifndef __MINGW32__ + ,01777 +#endif + ) ? Cnil : Ct); + +} + +DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_string(&x); + + coerce_to_filename(x,FN1); + + RETURN1(rmdir(FN1) ? Cnil : Ct); + +} + +DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); + +#ifdef _WIN32 + +void * +get_mmap(FILE *fp,void **ve) { + + int n; + void *st; + size_t sz; + HANDLE handle; + + massert((sz=file_len(fp))>0); + if (sSAload_with_freadA->s.s_dbind==Cnil) { + n=fileno(fp); + massert((n=fileno(fp))>2); + massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); + massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); + CloseHandle(handle); + } else { + massert(st=malloc(sz)); + massert(fread(st,sz,1,fp)==1); + } + + *ve=st+sz; + + return st; + +} + +int +un_mmap(void *v1,void *ve) { + + if (sSAload_with_freadA->s.s_dbind==Cnil) + return UnmapViewOfFile(v1) ? 0 : -1; + else { + free(v1); + return 0; + } + +} + + +#else + +#include + +static void * +get_mmap_flags(FILE *fp,void **ve,int flags) { + + int n; + void *v1; + struct stat ss; + + massert((n=fileno(fp))>2); + massert(!fstat(n,&ss)); + if (sSAload_with_freadA->s.s_dbind==Cnil) { + massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,flags,n,0))!=(void *)-1); + } else { + massert(v1=malloc(ss.st_size)); + massert(fread(v1,ss.st_size,1,fp)==1); + } + + *ve=v1+ss.st_size; + return v1; + +} + +void * +get_mmap(FILE *fp,void **ve) { + + return get_mmap_flags(fp,ve,MAP_PRIVATE); + +} + +void * +get_mmap_shared(FILE *fp,void **ve) { + + return get_mmap_flags(fp,ve,MAP_SHARED); + +} + +int +un_mmap(void *v1,void *ve) { + + if (sSAload_with_freadA->s.s_dbind==Cnil) + return munmap(v1,ve-v1); + else { + free(v1); + return 0; + } + +} + +#endif + +/* export these for AXIOM */ +int gcl_putenv(char *s) {return putenv(s);} +char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} +int gcl_strncpy_chk(char *a1,char *b1,size_t z) {char a[10],b[10];strncpy(a,a1,z);strncpy(b,b1,z);return strncmp(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ +#ifdef __MINGW32__ +#define uid_t int +#endif +uid_t gcl_geteuid(void) { +#ifndef __MINGW32__ + return geteuid(); +#else + return 0; +#endif +} +uid_t gcl_getegid(void) { +#ifndef __MINGW32__ + return getegid(); +#else + return 0; +#endif +} +int gcl_dup2(int o,int n) {return dup2(o,n);} +char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} +int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} + +int gcl_feof(void *v) {return feof(((FILE *)v));} +int gcl_getc(void *v) {return getc(((FILE *)v));} +int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} + +void +gcl_init_unixfsys(void) { +} diff --git a/o/unixsave.c b/o/unixsave.c new file mode 100755 index 0000000..bad1646 --- /dev/null +++ b/o/unixsave.c @@ -0,0 +1,164 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + unixsave.c +*/ + +#define IN_UNIXSAVE +#ifndef FIRSTWORD +#include "include.h" +#endif + +#ifdef UNIXSAVE +#include UNIXSAVE +#else + +#ifdef HAVE_FCNTL +#include +#else +#include +#endif + +#ifdef HAVE_AOUT +#undef BSD +#undef ATT +#define BSD +#endif + + + +#ifdef BSD +#include HAVE_AOUT +#endif + +#ifdef DOS +void +binary_file_mode() +{_fmode = O_BINARY;} +#endif + + +#ifdef ATT +#include +#include +#include +#endif + +#ifdef E15 +#include +extern char etext; +#endif + + +filecpy(to, from, n) +FILE *to, *from; +register int n; +{ + char buffer[BUFSIZ]; + + for (;;) + if (n > BUFSIZ) { + fread(buffer, BUFSIZ, 1, from); + fwrite(buffer, BUFSIZ, 1, to); + n -= BUFSIZ; + } else if (n > 0) { + fread(buffer, 1, n, from); + fwrite(buffer, 1, n, to); + break; + } else + break; +} + +static void +memory_save(original_file, save_file) +char *original_file, *save_file; +{ MEM_SAVE_LOCALS; + char *data_begin, *data_end; + int original_data; + FILE *original, *save; + register int n; + register char *p; + extern char *sbrk(); + + original = freopen(original_file,"r",stdin); +/* fclose(stdin); + original = fopen(original_file, "r"); +*/ + + if (stdin != original || original->_file != 0) { + emsg("Can't open the original file.\n"); + do_gcl_abort(); + } + setbuf(original, stdin_buf); + fclose(stdout); + unlink(save_file); + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { + emsg("Can't open the save file.\n"); + do_gcl_abort(); + } + setbuf(save, stdout_buf); + + READ_HEADER; + FILECPY_HEADER; + + for (n = header.a_data, p = data_begin; ; n -= BUFSIZ, p += BUFSIZ) + if (n > BUFSIZ) + fwrite(p, BUFSIZ, 1, save); + else if (n > 0) { + fwrite(p, 1, n, save); + break; + } else + break; + + fseek(original, original_data, 1); + + COPY_TO_SAVE; + + fclose(original); + fclose(save); +} + +extern void _cleanup(); + +LFD(siLsave)() { + char filename[256]; + + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); + + _cleanup(); + + memory_save(kcl_self, filename); + exit(0); + /* no return */ +} + +#endif /* UNIXSAVE include */ + +void +gcl_init_unixsave(void) +{ + make_si_function("SAVE", siLsave); +} + diff --git a/o/unixsys.c b/o/unixsys.c new file mode 100755 index 0000000..ab17e06 --- /dev/null +++ b/o/unixsys.c @@ -0,0 +1,189 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#include +#include +#include +#include +#include +#ifndef __MINGW32__ +#include +#endif + +#include "include.h" + +#if !defined(__MINGW32__) && !defined(__CYGWIN__) + +int +vsystem(const char *command) { + + unsigned j,n=strlen(command)+1; + char *z,*c; + const char *x1[]={"/bin/sh","-c",NULL,NULL},*spc=" \n\t",**p1,**pp; + int s; + pid_t pid; + + if (strpbrk(command,"\"'$<>")) + + (p1=x1)[2]=command; + + else { + + massert(n0); + massert(pid==waitpid(pid,&s,0)); + + if ((s>>8)&128) + emsg("execvp failure when executing '%s': %s\n",command,strerror((s>>8)&0x7f)); + + return s; + +} +#elif defined(__CYGWIN__) + +#include +#include +#include +#include + +int +vsystem(const char *command) { + + STARTUPINFO s={0}; + PROCESS_INFORMATION p={0}; + unsigned int e; + char *cmd=NULL,*r; + + massert((r=strpbrk(command," \n\t"))-command=0); + command=FN1; + + + s.cb=sizeof(s); + massert(CreateProcess(cmd,(void *)command,NULL,NULL,FALSE,0,NULL,NULL,&s,&p)); + massert(!WaitForSingleObject(p.hProcess,INFINITE)); + massert(GetExitCodeProcess(p.hProcess,&e)); + massert(CloseHandle(p.hProcess)); + massert(CloseHandle(p.hThread)); + + return e; + +} + +#endif + + +#ifdef ATT3B2 +#include +int +system(command) +char *command; +{ + char buf[4]; + extern sigint(); + + signal(SIGINT, SIG_IGN); + write(4, command, strlen(command)+1); + read(5, buf, 1); + signal(SIGINT, sigint); + return(buf[0]<<8); +} +#endif + +#ifdef E15 +#include +int +system(command) +char *command; +{ + char buf[4]; + extern sigint(); + + signal(SIGINT, SIG_IGN); + write(4, command, strlen(command)+1); + read(5, buf, 1); + signal(SIGINT, sigint); + return(buf[0]<<8); +} +#endif + +int +msystem(const char *s) { + + return psystem(s); + +} + +static void +FFN(siLsystem)(void) +{ + char command[32768]; + int i; + + check_arg(1); + check_type_string(&vs_base[0]); + if (vs_base[0]->st.st_fillp >= 32768) + FEerror("Too long command line: ~S.", 1, vs_base[0]); + for (i = 0; i < vs_base[0]->st.st_fillp; i++) + command[i] = vs_base[0]->st.st_self[i]; + command[i] = '\0'; + {int old = signals_allowed; + int res; + signals_allowed = sig_at_read; + res = msystem(command) ; + signals_allowed = old; + vs_base[0] = make_fixnum(res >> 8); + vs_base[1] = make_fixnum((res & 0xff)); + vs_top++; + } +} + +DEFUN_NEW("GETPID",object,fSgetpid,SI,0,0,NONE,OO,OO,OO,OO,(void), + "getpid returns the process ID of the current process") +{ return make_fixnum(getpid()); +} + + +void +gcl_init_unixsys(void) { + + make_si_function("SYSTEM", siLsystem); + +} diff --git a/o/unixtime.c b/o/unixtime.c new file mode 100755 index 0000000..3be590d --- /dev/null +++ b/o/unixtime.c @@ -0,0 +1,304 @@ +/* + Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +/* + unixtime.c +*/ + +#define IN_UNIXTIME + +#include + +#include "include.h" +#include +#ifdef UNIX +/* all we want from this is HZ the number of clock ticks per second +which is usually 60 maybe 100 or something else. */ +#undef PAGESIZE +#ifndef NO_SYS_PARAM_H +#include +#endif +#endif + +#ifndef HZ +/* #define HZ 60 */ +#define HZ 100 +#endif + +/* #define HZ1 (HZ > 100 ? 100 : HZ) */ +#define HZ1 HZ + +#ifdef USE_ATT_TIME +# undef BSD +# define ATT +#endif + +#if defined __MINGW32__ || !defined NO_SYSTEM_TIME_ZONE + +# ifdef __MINGW32__ +# include +# include +# include + +static struct timeb t0; +int usleep1 ( unsigned int microseconds ); +#undef usleep +#define usleep(x) usleep1(x) + +# endif + +#endif /* __MINGW32__ or !defined NO_SYSTEM_TIME_ZONE */ + +#ifdef BSD +#include +#include +#ifndef NO_SYS_TIMES_H +#include +#endif +#include +/* static struct timeb beginning; */ +#endif + +#ifdef ATT +#include +static long beginning; +#endif + +int +runtime(void) +{ + +#ifdef USE_INTERNAL_REAL_TIME_FOR_RUNTIME + +# ifdef __MINGW32__ + struct timeb t; + if ( t0.time == 0 ) { + ftime(&t0); + } + ftime ( &t ); + return ( ( t.time - t0.time ) * HZ1 + ( (t.millitm) * HZ1 ) / 1000 ); +# else +# error Need to return runtime without generating a fixnum (else GBC(t_fixnum) will loop) +# endif + +#else + { + struct tms buf; + times(&buf); + return(buf.tms_utime); + } +#endif +} + +object +unix_time_to_universal_time(int i) +{ + object x; + vs_mark; + + vs_push(make_fixnum(24*60*60)); + vs_push(make_fixnum(70*365+17)); + x = number_times(vs_top[-1], vs_top[-2]); + vs_push(x); + vs_push(make_fixnum(i)); + x = number_plus(vs_top[-1], vs_top[-2]); + vs_reset; + return(x); +} + +DEFUN_NEW("GET-UNIVERSAL-TIME",object,fLget_universal_time,LISP + ,0,0,NONE,OO,OO,OO,OO,(void),"") +{ + /* 0 args */ + RETURN1(unix_time_to_universal_time(time(0))); +} + +LFD(Lsleep)(void) +{ + object z; + + check_arg(1); + check_type_or_rational_float(&vs_base[0]); + if (number_minusp(vs_base[0]) == TRUE) + FEerror("~S is not a non-negative number.", 1, vs_base[0]); + vs_base[0]=number_times(vs_base[0],make_fixnum(1000000)); + Lround(); + z = vs_base[0]; + if (type_of(z) == t_fixnum) + usleep(fix(z)); + else + /* What is this for? -- MJT */ + for(;;) +#ifdef __MINGW32__ + Sleep ( 10000 ); +#else + sleep(1000); +#endif + vs_top = vs_base; + vs_push(Cnil); +} + +LFD(Lget_internal_run_time)(void) +{ + +#ifdef USE_INTERNAL_REAL_TIME_FOR_RUNTIME + vs_push(fLget_internal_real_time()); + vs_push(small_fixnum(0)); + return; +#else + struct tms buf; + + check_arg(0); + times(&buf); + vs_push(make_fixnum(buf.tms_utime)); + vs_push(make_fixnum(buf.tms_cutime)); + vs_push(make_fixnum(buf.tms_stime)); + vs_push(make_fixnum(buf.tms_cstime)); + +#endif + +} + + +DEFUN_NEW("GETTIMEOFDAY",object,fSgettimeofday,SI,0,0,NONE,OO,OO,OO,OO,(void),"Return time with maximum resolution") { +#ifdef __MINGW32__ + LARGE_INTEGER uu,ticks; + if (QueryPerformanceFrequency(&ticks)) { + QueryPerformanceCounter(&uu); + return make_longfloat((longfloat)uu.QuadPart/ticks.QuadPart); + } else { + FEerror("microsecond timing not available",0); + return Cnil; + /* static struct timeb t0; */ + /* static unsigned u; */ + /* struct timeb t; */ + /* ftime(&t); */ + /* if (t.time!=t0.time || t.millitm!=t0.millitm) {t0=t;u=0;} */ + /* u++; */ + /* return make_longfloat(((longfloat)t.time+1.0e-3*t.millitm+1.0e-6*(u%1000))); */ + } +#endif +#ifdef BSD + struct timeval tzp; + gettimeofday(&tzp,0); + return make_longfloat((longfloat)tzp.tv_sec+1.0e-6*tzp.tv_usec); +#endif +#ifdef ATT + return make_longfloat((longfloat)time(0)); +#endif +} + + +DEFUN_NEW("GET-INTERNAL-REAL-TIME",object,fLget_internal_real_time,LISP,0,0,NONE,OO,OO,OO,OO,(void),"Run time relative to beginning") + +{ +#ifdef __MINGW32__ + struct timeb t; + if ( t0.time == 0 ) { + ftime ( &t0 ); + } + ftime(&t); + return ( make_fixnum ( ( t.time - t0.time ) * HZ1 + ( (t.millitm) * HZ1 ) / 1000 ) ); +#endif +#ifdef BSD + static struct timeval begin_tzp; + struct timeval tzp; + if (begin_tzp.tv_sec==0) + gettimeofday(&begin_tzp,0); + gettimeofday(&tzp,0); +/* the value returned will be relative to the first time this is called, + plus the fraction of a second. We must make it relative, so this + will only wrap if the process lasts longer than 818 days + */ + return make_fixnum(((tzp.tv_sec-begin_tzp.tv_sec)*HZ1 + + ((tzp.tv_usec)*HZ1)/1000000)); +#endif +#ifdef ATT + return make_fixnum((time(0) - beginning)*HZ1); +#endif +} + + +void +gcl_init_unixtime(void) { +#ifdef ATT + beginning = time(0); +#endif +# if defined __MINGW32__ + ftime(&t0); +# endif + + make_constant("INTERNAL-TIME-UNITS-PER-SECOND", make_fixnum(HZ1)); + + make_function("SLEEP", Lsleep); + make_function("GET-INTERNAL-RUN-TIME", Lget_internal_run_time); + +} + +#ifdef __MINGW32__ +int usleep1 ( unsigned int microseconds ) +{ + unsigned int milliseconds = microseconds / 1000; + return ( SleepEx ( milliseconds, TRUE ) ); +} + +#endif + +DEFUN_NEW("CURRENT-TIMEZONE",object,fScurrent_timezone,SI,0,0,NONE,IO,OO,OO,OO,(void),"") { + +#if defined(__MINGW32__) + + TIME_ZONE_INFORMATION tzi; + DWORD TZResult; + + TZResult = GetTimeZoneInformation ( &tzi ); + + /* Now UTC = (local time + bias), in units of minutes, so */ + /*fprintf ( stderr, "Bias = %ld\n", tzi.Bias );*/ + return (object)((tzi.Bias+tzi.DaylightBias)/60); + +#elif defined NO_SYSTEM_TIME_ZONE + return (object)0; +#elif defined __CYGWIN__ + struct tm gt,lt; + fixnum _t=time(0); + gmtime_r(&_t, >); + localtime_r(&_t, <); + return (object)(long)(gt.tm_hour-lt.tm_hour+24*(gt.tm_yday!=lt.tm_yday ? (gt.tm_year>lt.tm_year||gt.tm_yday>lt.tm_yday ? 1 : -1) : 0)); +#else + time_t _t=time(0); + return (object)(-localtime(&_t)->tm_gmtoff/3600); +#endif +} + +DEFUN_NEW("CURRENT-DSTP",object,fScurrent_dstp,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + +#if defined(__MINGW32__) + + return Cnil; + +#elif defined NO_SYSTEM_TIME_ZONE /*solaris*/ + return Cnil; +#else + time_t _t=time(0); + return localtime(&_t)->tm_isdst > 0 ? Ct : Cnil; +#endif +} diff --git a/o/user_init.c b/o/user_init.c new file mode 100755 index 0000000..1487b48 --- /dev/null +++ b/o/user_init.c @@ -0,0 +1,3 @@ +#include "include.h" +object +user_init(void) {return Cnil;} diff --git a/o/user_match.c b/o/user_match.c new file mode 100644 index 0000000..bb030e9 --- /dev/null +++ b/o/user_match.c @@ -0,0 +1,3 @@ +#include "include.h" +int +user_match(const char *s,int n) {return 0;} diff --git a/o/usig.c b/o/usig.c new file mode 100755 index 0000000..fcc7a2a --- /dev/null +++ b/o/usig.c @@ -0,0 +1,320 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#define _GNU_SOURCE 1 +#include + +#ifdef __MINGW32__ +#include /* sigset_t */ +#endif + +#ifndef IN_UNIXINT +#include "include.h" + + +#include +#endif + +#ifdef USIG +#include USIG +#else + +#ifdef HAVE_SIGACTION +#define HAVE_SIGPROCMASK +#endif + + +#include "usig.h" + +extern char signals_handled[]; + +void +gcl_signal(int signo, void (*handler) (/* ??? */)) +{ + char *p = signals_handled; + while (*p) + { if (*p==signo) + {our_signal_handler[signo] = handler; + handler = main_signal_handler; + break; + } + p++;} + + { + +#ifdef HAVE_SIGACTION + struct sigaction action; + action.sa_handler = handler; +/* action.sa_flags = SA_RESTART | ((signo == SIGSEGV || signo == SIGBUS) ? SV_ONSTACK : 0) */ + action.sa_flags = SA_RESTART | ((signo == SIGSEGV || signo == SIGBUS) ? SA_ONSTACK : 0) +#ifdef SA_SIGINFO + | SA_SIGINFO +#endif + ; + sigemptyset(&action.sa_mask); + /* sigaddset(&action.sa_mask,signo); */ + sigaction(signo,&action,0); +#else +#ifdef HAVE_SIGVEC + struct sigvec vec; + vec.sv_handler = handler; + vec.sv_flags = (signo == SIGSEGV || signo == SIGBUS ? SV_ONSTACK : 0); + vec.sv_mask = sigmask(signo); + sigvec(signo,&vec,0); +#else + signal(signo,handler); +#endif +#endif + } +} + +/* remove the signal n from the signal mask */ +int +unblock_signals(int n, int m) +{ + int result = 0; + int current_mask; +#ifdef SIG_UNBLOCK_SIGNALS + SIG_UNBLOCK_SIGNALS(result,n,n); +#else +#ifdef HAVE_SIGPROCMASK + /* posix */ + { sigset_t set,oset; + sigemptyset(&set); + sigaddset(&set,n); + sigaddset(&set,m); + sigprocmask(SIG_UNBLOCK,&set,&oset); + current_mask=0; + result =((sigismember(&oset,n) ? signal_mask(n) : current_mask) + |(sigismember(&oset,m) ? signal_mask(m) : current_mask)); + } +#else + + current_mask = sigblock(0); + sigsetmask(~(sigmask(m)) & ~(sigmask(n)) & current_mask); + result = (current_mask & sigmask(m) ? signal_mask(m) : 0) + | (current_mask & sigmask(n) ? signal_mask(n) : 0); +#endif +#endif + return result; +} + +void +unblock_sigusr_sigio(void) +{ +#ifdef HAVE_SIGPROCMASK + /* posix */ + { sigset_t set; + sigemptyset(&set); + sigaddset(&set,SIGUSR1); + sigaddset(&set,SIGIO); + sigprocmask( SIG_UNBLOCK,&set,0); + } +#else + int current_mask = sigblock(0); + return sigsetmask(~(sigmask(SIGIO))&~(sigmask(SIGUSR1)) & current_mask); +#endif +} + +DEFCONST("+MC-CONTEXT-OFFSETS+",sSPmc_context_offsetsP,SI,FPE_INIT,""); + +#if defined(__x86_64__) || defined(__i386__) + +#define ASM __asm__ __volatile__ + +DEFUN_NEW("FLD",object,fSfld,SI,1,1,NONE,OI,OO,OO,OO,(fixnum val),"") { + volatile double d; + ASM ("fldt %1;fstpl %0" : "=m" (d): "m" (*(char *)val)); + RETURN1(make_longfloat(d)); +} + +#endif + +/* For now ignore last three args governing offsets and data modification, just to + support fpe sync with master*/ +DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,II,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1((object)*(fixnum *)addr); +} +DEFUN_NEW("*FLOAT",object,fSAfloat,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1(make_shortfloat(*(float *)addr)); +} +DEFUN_NEW("*DOUBLE",object,fSAdouble,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1(make_longfloat(*(double *)addr)); +} + +DEFUN_NEW("FEENABLEEXCEPT",object,fSfeenableexcept,SI,1,1,NONE,II,OO,OO,OO,(fixnum x),"") { + +#ifdef HAVE_FEENABLEEXCEPT + + x=feenableexcept(x); + +#elif defined(__x86_64__) || defined(__i386__) +#define ASM __asm__ __volatile__ + { + volatile unsigned short s=0; + volatile unsigned int i; + ASM("fnstcw %0" :: "m" (s)); + s=(s|FE_ALL_EXCEPT)&(~x); + ASM("fldcw %0" : "=m" (s)); + ASM("stmxcsr %0" :: "m" (i)); + i=(i|(FE_ALL_EXCEPT<<7))&(~(x<<7)); + ASM("ldmxcsr %0" : "=m" (i)); + } +#endif + + RETURN1((object)x); + +} + +DEFUN_NEW("FEDISABLEEXCEPT",object,fSfedisableexcept,SI,0,0,NONE,IO,OO,OO,OO,(void),"") { + + fixnum x; + +#ifdef HAVE_FEENABLEEXCEPT + + feclearexcept(FE_ALL_EXCEPT); + x=fedisableexcept(FE_ALL_EXCEPT); + +#elif defined(__x86_64__) || defined(__i386__) +#define ASM __asm__ __volatile__ + { + volatile unsigned int i=0; + ASM("fnclex"); + ASM("stmxcsr %0" :: "m" (i)); + i=(i|(FE_ALL_EXCEPT<<7)); + ASM("ldmxcsr %0" : "=m" (i)); + x=0; + } +#endif + + RETURN1((object)x); +} + +#if defined(__x86_64__) || defined(__i386__) + +#define FE_TEST(x87sw_,mxcsr_,excepts_) ((x87sw_)&(excepts_))|(~((mxcsr_)>>7)&excepts_) + +DEFUN_NEW("FPE_CODE",object,fSfpe_code,SI,2,2,NONE,II,OO,OO,OO,(fixnum x87sw,fixnum mxcsr),"") { + + RETURN1((object)(long)(FE_TEST(x87sw,mxcsr,FE_INVALID) ? FPE_FLTINV : + (FE_TEST(x87sw,mxcsr,FE_DIVBYZERO) ? FPE_FLTDIV : + (FE_TEST(x87sw,mxcsr,FE_OVERFLOW) ? FPE_FLTOVF : + (FE_TEST(x87sw,mxcsr,FE_UNDERFLOW) ? FPE_FLTUND : + (FE_TEST(x87sw,mxcsr,FE_INEXACT) ? FPE_FLTRES : 0)))))); +} + +#if defined(__MINGW32__) || defined(__CYGWIN__) + +DEFUN_NEW("FNSTSW",object,fSfnstsw,SI,0,0,NONE,II,OO,OO,OO,(void),"") { + volatile unsigned short t=0; + ASM ("fnstsw %0" :: "m" (t)); + RETURN1((object)(long)t); +} +DEFUN_NEW("STMXCSR",object,fSstmxcsr,SI,0,0,NONE,II,OO,OO,OO,(void),"") { + volatile unsigned int t=0; + ASM ("stmxcsr %0" :: "m" (t)); + RETURN1((object)(long)t); +} + +#endif +#endif + + +static void +sigfpe3(int sig,void *i,void *v) { + + unblock_signals(SIGFPE,SIGFPE); +#ifdef __MINGW32__ + gcl_signal(SIGFPE,sigfpe3); +#endif + ifuncall3(sSfloating_point_error,FPE_CODE(i,v),FPE_ADDR(i,v),FPE_CTXT(v)); + +} + +DEFCONST("+FE-LIST+",sSPfe_listP,SI,list(5, + list(3,sLdivision_by_zero,make_fixnum(FPE_FLTDIV),make_fixnum(FE_DIVBYZERO)), + list(3,sLfloating_point_overflow,make_fixnum(FPE_FLTOVF),make_fixnum(FE_OVERFLOW)), + list(3,sLfloating_point_underflow,make_fixnum(FPE_FLTUND),make_fixnum(FE_UNDERFLOW)), + list(3,sLfloating_point_inexact,make_fixnum(FPE_FLTRES),make_fixnum(FE_INEXACT)), + list(3,sLfloating_point_invalid_operation,make_fixnum(FPE_FLTINV),make_fixnum(FE_INVALID))),""); + +DEF_ORDINARY("FLOATING-POINT-ERROR",sSfloating_point_error,SI,""); + +static void +sigpipe(void) +{ + unblock_signals(SIGPIPE,SIGPIPE); + perror(""); + FEerror("Broken pipe", 0); +} + +void +sigint(void) +{ + unblock_signals(SIGINT,SIGINT); + terminal_interrupt(1); +} + +static void +sigalrm(void) +{ + unblock_signals(SIGALRM,SIGALRM); + raise_pending_signals(sig_try_to_delay); +} + +DEFVAR("*INTERRUPT-ENABLE*",sSAinterrupt_enableA,SI,sLt,""); + +DEF_ORDINARY("SIGUSR1-INTERRUPT",sSsigusr1_interrupt,SI,""); +DEF_ORDINARY("SIGIO-INTERRUPT",sSsigio_interrupt,SI,""); + +static void +sigusr1(void) +{ifuncall1(sSsigusr1_interrupt,Cnil);} + +static void +sigio(void) +{ifuncall1(sSsigio_interrupt,Cnil);} + + +static void +sigterm(void) +{do_gcl_abort();} + + + +void +install_default_signals(void) +{ gcl_signal(SIGFPE, sigfpe3); + gcl_signal(SIGPIPE, sigpipe); + gcl_signal(SIGINT, sigint); + gcl_signal(SIGTERM, sigterm); + gcl_signal(SIGUSR1, sigusr1); + gcl_signal(SIGIO, sigio); + gcl_signal(SIGALRM, sigalrm); + + /*install_segmentation_catcher(); */ + signals_allowed = sig_normal; + } + + + + +#endif diff --git a/o/usig2.c b/o/usig2.c new file mode 100755 index 0000000..50d5cfc --- /dev/null +++ b/o/usig2.c @@ -0,0 +1,427 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +You should have received a copy of the GNU Library General Public License +along with GCL; see the file COPYING. If not, write to the Free Software +Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + + +#ifndef IN_UNIXINT +#define NEED_MP_H +#include +#include +#include +#include "include.h" + +static void +invoke_handler(int,int); + + +#ifndef USIG2 +#include +#include "usig.h" +/* #include "arith.h" */ +#endif +#endif + +#ifdef USIG2 +#include USIG2 +#else + + + +/* these sstructure pointers would need their structures provided... + so we just call them void */ +void * sfaslp; + +#ifdef CMAC +EXTER +unsigned long s4_neg_int[4],small_neg_int[3],small_pos_int[3]; +#endif + + +/* + We have two mechanisms for protecting against interrupts. 1] We have a + facility for delaying certain signals during critical regions of code. + This facility will involve BEGIN_NO_INTERRUPT and END_NO_INTERRUPT + +*/ + +handler_function_type our_signal_handler[32]; + +struct save_for_interrupt{ + object free1[32]; + object free2[32]; + object altfree1[32]; + object altfree2[32]; + union lispunion buf[32]; + struct call_data fcall; + object *vs_top,vs_topVAL,*vs_base; + struct bds_bd *bds_top,bds_topVAL; + struct invocation_history *ihs_top,ihs_topVAL; + char *token_bufp; + char token_buf [4*INITIAL_TOKEN_LENGTH]; + int token_st_dim; + /* for storing the XS objects in te usig2_aux.c */ + void *save_objects[75]; + + }; + + +/* note these are the reverse of the ones in unixint.c + ... uggghhh*/ + + +#undef SS1 +#undef RS1 +#define SS1(a,b) a = b ; +#define RS1(a,b) b = a ; + + /* save objects in save_objects list */ + + + +char signals_handled [] = {SIGINT,SIGUSR2,SIGUSR1,SIGIO,SIGALRM, +#ifdef OTHER_SIGNALS_HANDLED + OTHER_SIGNALS_HANDLED +#endif + 0}; + +/* * in_signal_handler: if not zero indicates we are running inside a signal + handler, which may have been invoked at a random intruction, and so + it is not safe to do a relocatable gc. + + * signals_pending: if (signals_pending & signal_mask(signo)) then this + signo 's handler is waiting to be run. + + * signals_allowed: indicates the state we think we were in when + checking to invoke a signal. Values: + + sig_none: definitely dont run handler + sig_normal: In principle `ok', but if desiring maximum safety dont run here. + sig_safe: safe point to run a function (eg make_cons,...) + sig_at_read: interrupting the getc function in read. Should be safe. + + + unwind (used by throw,return etc) resets this to sig_normal just as it + does the longjmp. + + + If we invoke signal handling routines at a storage + allocation pt, it is completely safe: we should save + some of the globals, but the freelists etc dont need + to be saved. pass: sig_safe to raise_pending. + + If we invoke it at end of a No interrupts + region, then it we must look at whether these were nested. + We should probably have two endings for END_NO_INTERRUPTS, + one for when we want to raise, and one for where we are sure + we are at safe place. pass sig_use_signals_allowed_value + + If we invoke a handler when at + signals_allowed == sig_at_read, then we are safe. + */ + + +#define XX sig_safe +/* min safety level required for invoking a given signal handler */ +char safety_required[]={XX,XX,XX,XX,XX,XX,XX,XX, + XX,XX,XX,XX,XX,XX,XX,XX, + XX,XX,XX,XX,XX,XX,XX,XX, + XX,XX,XX,XX,XX,XX,XX,XX}; + +void +gcl_init_safety(void) +{ safety_required[SIGINT]=sig_try_to_delay; + safety_required[SIGALRM]=sig_normal; +} + +DO_INIT(gcl_init_safety();) +DEFUN_NEW("SIGNAL-SAFETY-REQUIRED",object,sSsignal_safety_required,SI,2,2, + NONE,OI,IO,OO,OO,(fixnum signo,fixnum safety), + "Set the safety level required for handling SIGNO to SAFETY, or if \ +SAFETY is negative just return the current safety level for that \ +signal number. Value of 1 means allow interrupt at any place not \ +specifically marked in the code as bad, and value of 2 means allow it \ +only in very SAFE places.") + +{ if (signo > sizeof(safety_required)) + {FEerror("Illegal signo:~a.",1,make_fixnum(signo));} + if (safety >=0) safety_required[signo] = safety; + return small_fixnum(safety_required[signo]) ; +} + + +void +#ifdef __MINGW32__ +main_signal_handler(int signo) +#else +main_signal_handler(int signo, int a, int b) +#endif +{ int allowed = signals_allowed; +#ifdef NEED_TO_REINSTALL_SIGNALS + signal(signo,main_signal_handler); +#endif + if (allowed >= safety_required[signo]) + { signals_allowed = sig_none; + + if (signo == SIGUSR1 || + signo == SIGIO) + { unblock_sigusr_sigio();} + + invoke_handler(signo,allowed); + signals_allowed = allowed; + } + else { + signals_pending |= signal_mask(signo); + alarm(1);} + return; + + } + +static void before_interrupt(struct save_for_interrupt *p, int allowed); +static void after_interrupt(struct save_for_interrupt *p, int allowed); + +/* caller saves and restores the global signals_allowed; */ +static void +invoke_handler(int signo, int allowed) +{struct save_for_interrupt buf; + before_interrupt(&buf,allowed); + signals_pending &= ~(signal_mask(signo)); + {int prev_in_handler = in_signal_handler; + in_signal_handler |= (allowed <= sig_normal ? 1 : 0); + signals_allowed = allowed; + our_signal_handler[signo](signo); + signals_allowed = 0; + in_signal_handler = prev_in_handler; + after_interrupt(&buf,allowed); +}} + +int tok_leng; +static void +before_interrupt(struct save_for_interrupt *p, int allowed) +{int i; + /* all this must be run in no interrupts mode */ + if ( allowed < sig_safe) + { /* save tht tops of the free stacks */ + for(i=0; i < t_end ; i++) + { struct typemanager *ad = &tm_table[i]; + {SS1(p->free1[i],ad->tm_free); + if (p->free1[i]) + { char *beg = (char *) (p->free1[i]); + object x = (object)beg; + int amt = ad->tm_size; + SS1(p->free2[i],OBJ_LINK(p->free1[i])); + ad->tm_nfree --; + bcopy(beg ,&(p->buf[i]), amt); + bzero(beg+sizeof(struct freelist),amt-sizeof(struct freelist)); + make_unfree(x); + if (p->free2[i]) + { x = (object) p->free2[i]; + beg = (char *)x; + make_unfree(x); + bzero(beg+sizeof(struct freelist),amt-sizeof(struct freelist)); + SS1(ad->tm_free,OBJ_LINK(p->free2[i])); + ad->tm_nfree --; + } + else + { SS1(ad->tm_free, OBJ_LINK(p->free1[i])); + }} + }} + } + SS1(p->fcall,fcall); + SS1(p->vs_top,vs_top); + SS1(p->vs_topVAL,*vs_top); + SS1(p->vs_base,vs_base); + SS1(p->bds_top,bds_top); + SS1(p->bds_topVAL,*bds_top); + SS1(p->ihs_top,ihs_top); + SS1(p->ihs_topVAL,*ihs_top); + { void **pp = p->save_objects; +#undef XS +#undef XSI +#define XS(a) *pp++ = (void *) (a); +#define XSI(a) *pp++ = (void *)(long)(a); +/* #define XS(a) *pp++ = * (void **) (&a); */ +#include "usig2_aux.c" + if ((pp - (&(p->save_objects)[0])) >= (sizeof(p->save_objects)/sizeof(void *))) + do_gcl_abort(); + } +#define MINN(a,b) (atoken_st_dim = MINN(token->st.st_dim,tok_leng+1); + if (p->token_st_dim < sizeof(p->token_buf)) + p->token_bufp = p->token_buf; + else { p->token_bufp= (void *)alloca(p->token_st_dim);} + bcopy(token->st.st_self,p->token_bufp,p->token_st_dim); + +} + +static void +after_interrupt(struct save_for_interrupt *p, int allowed) +{int i; + /* all this must be run in no interrupts mode */ + if ( allowed < sig_safe) + { + for(i=0; i < t_end ; i++) + { struct typemanager *ad = &tm_table[i]; + object current_fl = ad->tm_free; + {RS1(p->free1[i],ad->tm_free); + if (p->free1[i]) + { char *beg = (char *) (p->free1[i]); + object x = (object)beg; + int amt = ad->tm_size; + RS1(p->free2[i],(p->free1[i])); + if (is_marked_or_free(x)) error("should not be free"); + bcopy(&(p->buf[i]),beg, amt); + if (p->free2[i]) + { x = (object) p->free2[i]; + if (is_marked_or_free(x)) error("should not be free"); + make_free(x); + F_LINK(F_LINK(ad->tm_free)) = (long )current_fl; + ad->tm_nfree += 2; + } + else + ad->tm_nfree =1; + } + + else ad->tm_nfree =0; + }} + } + RS1(p->fcall,fcall); + RS1(p->vs_top,vs_top); + RS1(p->vs_topVAL,*vs_top); + RS1(p->vs_base,vs_base); + RS1(p->bds_top,bds_top); + RS1(p->bds_topVAL,*bds_top); + RS1(p->ihs_top,ihs_top); + RS1(p->ihs_topVAL,*ihs_top); + { void **pp = p->save_objects; +#undef XS +#undef XSI + + /* #define XS(a) a = (void *)(*pp++) + We store back in the location 'a' the value we have saved. + */ + +/* #define XS(a) do { void **_p = (void **)(&a); *_p = (void *)(*pp++);}while(0) */ +#define XS(a) a = (void *)(*pp++) +#define XSI(a) {union {void *v;long l;}u; u.v=*pp++; a = u.l;} +#include "usig2_aux.c" + } + + bcopy(p->token_bufp,token->st.st_self,p->token_st_dim); +} + + +/* claim the following version of make_cons can be interrupted at any line + and is suitable for inlining. +*/ + +/* static object */ +/* MakeCons(object a, object b) */ +/* { struct typemanager*ad = &tm_table[t_cons]; */ +/* object new = (object) ad->tm_free; */ +/* if (new == 0) */ +/* { new = alloc_object(t_cons); */ +/* new->c.c_car = a; */ +/* goto END; */ +/* } */ + +/* new->c.c_car=a; */ + /* interrupt here and before_interrupt will copy new->c into the + C stack, so that a will be protected */ +/* new->c.t=t_cons; */ +/* new->c.m= 0; */ + /* Make interrupt copy new out to the stack and then zero new. + That way new is certainly gc valid, and its contents are protected. + So the above three operations can occur in any order. + */ + +/* { object tem = OBJ_LINK(new); */ + /* + interrupt here and we see that before_interrupt must save the top of the + free list AND the second thing on the Free list. That way we will be ok + here and an interrupt here could not affect tem. It is possible that tem + == 0, yet a gc happened in between. An interrupt here when tem = 0 would + mean the free list needs to be collected again by second gc. + */ +/* ad->tm_free = tem; */ +/* } */ + /* Whew: we got it safely off so interrupts can't hurt us now. */ +/* ad->tm_nfree --; */ + /* interrupt here and the cdr field will point to a f_link which is + a 'free' and so gc valid. b is still protected since + it is in the stack or a regiseter, and a is protected since it is + in new, and new is not free + */ +/* END: */ +/* new->c.c_cdr=b; */ +/* return new; */ +/* } */ + + +/* COND is the condition where this is raised. + Might be sig_safe (eg at cons). */ + +void +raise_pending_signals(int cond) +{unsigned int allowed = signals_allowed ; + if (cond == sig_use_signals_allowed_value) + if (cond == sig_none || interrupt_enable ==0) return ; + + + AGAIN: + { unsigned int pending = signals_pending; + char *p = signals_handled; + if (pending) + while(*p) + { if (signal_mask(*p) & pending + && cond >= safety_required[(unsigned char)*p]) + { + signals_pending &= ~(signal_mask(*p)); + if (*p == SIGALRM && cond >= sig_safe) + { alarm(0);} + else + invoke_handler(*p,cond); + goto AGAIN; + } + p++; + } + signals_allowed = allowed; + return; + }} + + +DEFUN_NEW("ALLOW-SIGNAL",object,fSallow_signal,SI,1,1,NONE,OI,OO,OO,OO,(fixnum n), + "Install the default signal handler on signal N") + +{ + + signals_allowed |= signal_mask(n); + unblock_signals(n,n); + /* sys v ?? just restore the signal ?? */ + if (our_signal_handler[n]) + {gcl_signal(n,our_signal_handler[n]); + return make_fixnum(1); + } + else + return make_fixnum(0); +} + + + +#endif diff --git a/o/usig2_aux.c b/o/usig2_aux.c new file mode 100755 index 0000000..9262f85 --- /dev/null +++ b/o/usig2_aux.c @@ -0,0 +1,81 @@ +XSI(string_register->st.st_fillp); +XSI(string_register->st.st_fillp); +XSI(string_register->st.st_dim); +XS(string_register->st.st_self); +XSI(token->st.st_fillp); +XSI(in_signal_handler); +XSI(nlj_active); +XS(nlj_fr); +XS(nlj_tag); +XSI(PRINTarray); +XSI(PRINTbase); +XS(PRINTcase); +XSI(PRINTcircle); +XSI(PRINTescape); +XSI(PRINTgensym); +XSI(PRINTlength); +XSI(PRINTlevel); +XSI(PRINTpackage); +XSI(PRINTpretty); +XSI(PRINTradix); +XS(PRINTstream); +XSI(PRINTstructure); +XS(PRINTvs_limit); +XS(PRINTvs_top); +XSI(READbase); +XSI(READdefault_float_format); +XSI(READsuppress); +XS(READtable); +XSI(ctl_end); +XSI(ctl_index); +XSI(ctl_origin); +XS(endp_temp); +XSI(eval1); +XSI(line_length); +XSI(in_list_flag); +XS(kf); +XS(tf); +XSI(left_trim); +XSI(right_trim); +XS(lex_env); +XS(key_function); +XS(test_function); +XS(item_compared); +XSI(intern_flag); +XS(printStructBufp); +XS(sfaslp); +XSI(preserving_whitespace_flag); +XS(sharing_table); +XSI(string_sign); +XSI(string_boundary); +XS(car_or_cdr); +XS(casefun); +XS(tmp_alloc); +#ifndef GMP +#ifdef CMAC +XS(s4_neg_int[3]); +XS(small_neg_int[2]); +XS(small_pos_int[2]); +#endif +XS(overflow); +XS(top); +XS(hiremainder); +XS(in_saved_avma); +XS(avma ); +#endif + +/* put in NO_INTERRUPT +YS(fmt_base); +YS(fmt_end); +YS(fmt_indents); +YS(fmt_index); +YS(fmt_jmp_buf); +YS(fmt_line_length); +YS(fmt_nparam); +YS(fmt_paramp); +YS(fmt_spare_spaces); +YS(fmt_stream); +YS(fmt_string); +YS(fmt_temporary_stream); +YS(fmt_temporary_string); + */ diff --git a/o/utils.c b/o/utils.c new file mode 100755 index 0000000..711ccbd --- /dev/null +++ b/o/utils.c @@ -0,0 +1,213 @@ +#include +#include +#include +#include "include.h" + +/* The functions IisProp check the property holds, and return the + argument. They may in future allow resetting the argument. +*/ + +object +IisSymbol(object f) +{ if (type_of(f) != t_symbol) + { FEerror("Not a symbol ~s",1,f); } + return f; +} + +/* object */ +/* IisFboundp(object f) */ +/* { */ +/* IisSymbol(f); */ +/* if (f->s.s_gfdef ==0) */ +/* { FEerror("Not a fboundp ~s",1,f);} */ +/* return f; */ +/* } */ + +object +IisArray(object f) +{ if (TS_MEMBER(type_of(f), + TS(t_array) + |TS(t_vector) + |TS(t_bitvector) + |TS(t_string))) + return f; + else + { FEwrong_type_argument(sLarray,f); return f; + } +} + +object +Iis_fixnum(object f) +{ if (type_of(f)==t_fixnum) + { return f;} + else + { FEerror("Not a fixnum ~s",1,f); return f; + + } +} + +void Wrong_type_error(char *str,int n,...) { + FEerror("Wrong type error",0); +} + +/* static object */ +/* Iapply_ap(object (*f) (/\* ??? *\/), va_list ap) */ +/* Apply f to the va_list ap, with an implicit number of args + passed in VFUN_NARGS */ + + +/* { int n = VFUN_NARGS; */ +/* object *new; */ +/* COERCE_VA_LIST(new,ap,n); */ +/* return c_apply_n(f,n,new); */ +/* } */ + +object +Ifuncall_n(object fun,int n,...) { +/* call fun on the n optional args supplied, and set the fcall.nvalues etc + return the first value */ + va_list ap; + object *new; + va_start(ap,n); + COERCE_VA_LIST(new,ap,n); + va_end(ap); + return IapplyVector(fun,n,new); +} + + + +/* For applying FUN to args in VA_LIST, where n are supplied directly + and the last one is itself a va_list */ +/* object */ +/* Iapply_fun_n(object fun,int n,int m,...) { */ + +/* va_list ap1,ap; */ +/* object b[F_ARG_LIMIT]; */ +/* int i = 0; */ + +/* va_start(ap1,m); */ + +/* while (--n >= 0) */ +/* { b[i++] = va_arg(ap1,object);} */ +/* if (m > 0) { */ +/* ap = va_arg(ap1,va_list); */ +/* while (--m >= 0) */ +/* { b[i++] = va_arg(ap,object);} */ +/* } */ + +/* va_end(ap1); */ + +/* return IapplyVector(fun,i,b); */ + +/* } */ + + + +/* For applying FUN to args in VA_LIST, where n are supplied directly + and the last one is itself a va_list */ +/* object */ +/* Iapply_fun_n1(object (*fun)(),int n,int m,...) { */ + +/* va_list ap; */ +/* object b[F_ARG_LIMIT],*bb; */ +/* int i = 0; */ + +/* va_start(ap,m); */ + +/* while (--n >= 0) { */ +/* b[i++] = va_arg(ap,object);} */ +/* if (m > 0) { */ +/* bb = va_arg(ap,object *); */ +/* while (--m >= 0) */ +/* b[i++] = *bb++; */ +/* } */ + +/* va_end(ap); */ + +/* return IapplyVector(make_sfun(Cnil,fun,i,Cnil),i,b); */ +/* } */ + +/* For applying FUN to args in VA_LIST, where n are supplied directly + and the last one is itself a va_list */ +/* object */ +/* Iapply_fun_n2(object fun,int n,int m,...) { */ + +/* va_list ap,*app; */ +/* object b[F_ARG_LIMIT]; */ +/* int i = 0; */ + +/* va_start(ap,m); */ + +/* while (--n >= 0) { */ +/* b[i++] = va_arg(ap,object);} */ +/* if (m > 0) { */ +/* app = va_arg(ap,va_list *); */ +/* while (--m >= 0) */ +/* b[i++] = va_arg(*app,object); */ +/* } */ + +/* va_end(ap); */ + +/* return IapplyVector(fun,i,b); */ +/* } */ + + +/* static object */ +/* ImakeStructure(int n, object *p) */ +/* p[0]= structure name , p[1] = 1'st elt,.... p[n-1] = last elt. */ + + +/* { object * r = vs_top; */ +/* object res; */ +/* if (p+n != r) { FEerror("bad make struct",0);} */ +/* vs_base= p; */ +/* siLmake_structure(); */ +/* res = vs_base[0]; */ +/* vs_top=p; */ +/* return res; */ +/* } */ + +/* static void */ +/* Ineed_in_image(object (*foo) (/\* ??? *\/)) */ +/* {;} */ + +/* Convert a value stack type return to an fcall multiple vaule return + and return the actual value (or nil if no values); */ +object +Ivs_values(void) +{ fixnum n = fcall.nvalues = vs_top - vs_base; + object *b = vs_base,*p=&fcall.values[0]; + object res = (n > 0 ? b[0] : sLnil); + if (n>=(fixnum)(sizeof(fcall.values)/sizeof(*fcall.values))) + FEerror("Too many function call values",0); + while (--n > 0) + { *++p= *++b;} + return res; +} + + +/* static void */ +/* fatal(char *s, int i1, int i2) */ +/* { */ +/* fprintf(stderr,s,i1,i2); */ +/* exit(1); */ +/* } */ + + + +/* Copy STRING to BUF which has N bytes available. + If there is not enough space, malloc some */ +char * +lisp_copy_to_null_terminated(object string, char *buf, int n) +{ if(type_of(string) != t_string + && type_of(string) != t_symbol) + FEerror("Need to give symbol or string",0); + if (string->st.st_fillp +1 > n) + { buf= (void *)malloc(string->st.st_fillp +1); + } + bcopy(string->st.st_self,buf,string->st.st_fillp); + buf[string->st.st_fillp] = 0; + return buf; +} + + diff --git a/o/wpool.c b/o/wpool.c new file mode 100644 index 0000000..c7b3d78 --- /dev/null +++ b/o/wpool.c @@ -0,0 +1,35 @@ +#include + +#define NO_PRELINK_UNEXEC_DIVERSION +char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; +void *data_start=NULL; +int multiprocess_memory_pool=1; + +#include "include.h" +#include "page.h" +#include "pool.h" + +/*lintian*/ +void +assert_error(const char *a,unsigned l,const char *f,const char *n) { + update_pool(0); + get_pool(); + pool_check(); +} + +int +main(int argc,char * argv[],char * envp[]) { + + int s=3; + + if (argc>1) sscanf(argv[1],"%d",&s); + open_pool(); + for (;;) { + lock_pool(); + fprintf(stderr,"master pid %lu %lu processess %lu pages\n",Pool->pid,Pool->n,Pool->s); + fflush(stderr); + unlock_pool(); + sleep(s); + } + return 0; +} diff --git a/o/xdrfuns.c b/o/xdrfuns.c new file mode 100755 index 0000000..f74e7a4 --- /dev/null +++ b/o/xdrfuns.c @@ -0,0 +1,186 @@ +/* + Copyright (C) 1994 W. Schelter + +This file is part of GNU Common Lisp, herein referred to as GCL + +GCL is free software; you can redistribute it and/or modify it under +the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GCL 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 Library General Public +License for more details. + +*/ + +#ifdef HAVE_XDR + +#ifdef DARWIN +#undef __LP64__ /*Apple header declaration bug workaround for xdr_long*/ +#endif + +#ifdef AIX3 +#include +#endif +#ifdef __CYGWIN__ +#include +#else /* __CYGWIN__ */ +#include +#endif /* __CYGWIN__ */ + +extern short aet_sizes[]; +static object +FFN(siGxdr_open)(f) + object f; +{ XDR *xdrs; + object ar= alloc_simple_string(sizeof(XDR)); + array_allocself(ar,1,OBJNULL); + xdrs= (XDR *) ar->a.a_self; + if (f->sm.sm_fp == 0) FEerror("stream not ok for xdr io",0); + xdrstdio_create(xdrs, f->sm.sm_fp, + (f->sm.sm_mode == smm_input ? XDR_DECODE : + f->sm.sm_mode == smm_output ? XDR_ENCODE : + (FEerror("stream not input or output",0),XDR_ENCODE))) + ; + return ar; +} + +static object +FFN(siGxdr_write)(object str,object elt) { + + XDR *xdrp= (XDR *) str->ust.ust_self; + xdrproc_t e; + + switch (type_of(elt)) { + case t_fixnum: + { + fixnum e=fix(elt); + if(xdr_long(xdrp,(long *)&e)) goto error; + } + break; + case t_longfloat: + if(xdr_double(xdrp,&lf(elt))) goto error; + break; + case t_shortfloat: + if(xdr_float(xdrp,&sf(elt))) goto error; + break; + case t_vector: + + switch(elt->v.v_elttype) { + case aet_lf: + e=(xdrproc_t)xdr_double; + break; + case aet_sf: + e=(xdrproc_t)xdr_float; + break; + case aet_fix: + e=(xdrproc_t)xdr_long; + break; + case aet_short: + e=(xdrproc_t)xdr_short; + break; + default: + FEerror("unsupported xdr size",0); + goto error; + break; + } + { + u_int tmp=elt->v.v_fillp; + if (tmp!=elt->v.v_fillp) + goto error; + if(xdr_array(xdrp,(void *)&elt->v.v_self, + &tmp, + elt->v.v_dim, + aet_sizes[elt->v.v_elttype], + e)) + goto error; + } + break; + default: + FEerror("unsupported xdr ~a",1,elt); + break; + } + return elt; + error: + FEerror("bad xdr write",0); + return elt; +} + +static object +FFN(siGxdr_read)(object str,object elt) { + + XDR *xdrp= (XDR *) str->ust.ust_self; + xdrproc_t e; + + switch (type_of(elt)) { + case t_fixnum: + {fixnum l; + if(xdr_long(xdrp,(long *)&l)) goto error; + return make_fixnum(l);} + break; + case t_longfloat: + {double x; + if(xdr_double(xdrp,&x)) goto error; + return make_longfloat(x);} + case t_shortfloat: + {float x; + if(xdr_float(xdrp,&x)) goto error; + return make_shortfloat(x);} + case t_vector: + switch(elt->v.v_elttype) { + case aet_lf: + e=(xdrproc_t)xdr_double; + break; + case aet_sf: + e=(xdrproc_t)xdr_float; + break; + case aet_fix: + e=(xdrproc_t)xdr_long; + break; + case aet_short: + e=(xdrproc_t)xdr_short; + break; + default: + FEerror("unsupported xdr size",0); + goto error; + break; + } + + { + u_int tmp=elt->v.v_fillp; + if (tmp!=elt->v.v_fillp) + goto error; + if(xdr_array(xdrp,(void *)&elt->v.v_self, + &tmp, + elt->v.v_dim, + aet_sizes[elt->v.v_elttype], + e)) + goto error; + } + return elt; + break; + default: + FEerror("unsupported xdr ~a",1,elt); + return elt; + break; + } + error: + FEerror("bad xdr read",0); + return elt; +} +static void +gcl_init_xdrfuns() +{ make_si_sfun("XDR-WRITE",siGxdr_write, + ARGTYPE2(f_object,f_object)|RESTYPE(f_object)); + + make_si_sfun("XDR-READ",siGxdr_read, + ARGTYPE2(f_object,f_object)|RESTYPE(f_object)); + make_si_sfun("XDR-OPEN",siGxdr_open, + ARGTYPE1(f_object)|RESTYPE(f_object)); + +} +#else +static void gcl_init_xdrfuns(void) {;} +#endif diff --git a/pcl/.gitignore b/pcl/.gitignore new file mode 100644 index 0000000..8c5d26a --- /dev/null +++ b/pcl/.gitignore @@ -0,0 +1,3 @@ +*.c +*.h +*gazonk* diff --git a/pcl/README b/pcl/README new file mode 100644 index 0000000..4b42f08 --- /dev/null +++ b/pcl/README @@ -0,0 +1,11 @@ +To install PCL at your site, follow the instructions in the defsys.lisp file. + + +If you use gcl (GNU Common Lisp), follow the instructions in impl/gcl/README. + +If you use cmucl17f, follow the instructions in impl/cmu/README, +then recompile PCL and rebuild the world. + +If you use lucid, just compile and load defsys, +then type (pcl::compile-pcl), or (pcl::load-pcl). + diff --git a/pcl/defsys.lisp b/pcl/defsys.lisp new file mode 100644 index 0000000..29c8528 --- /dev/null +++ b/pcl/defsys.lisp @@ -0,0 +1,943 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; Some support stuff for compiling and loading PCL. It would be nice if +;;; there was some portable make-system we could all agree to share for a +;;; while. At least until people really get databases and stuff. +;;; +;;; *** *** +;;; *** DIRECTIONS FOR INSTALLING PCL AT YOUR SITE *** +;;; *** *** +;;; +;;; To get PCL working at your site you should: +;;; +;;; - Get all the PCL source files from Xerox. The complete list of source +;;; file names can be found in the defsystem for PCL which appears towards +;;; the end of this file. +;;; +;;; - Edit the variable *pcl-directory* below to specify the directory at +;;; your site where the pcl sources and binaries will be. This variable +;;; can be found by searching from this point for the string "***" in +;;; this file. +;;; +;;; - Use the function (pcl::compile-pcl) to compile PCL for your site. +;;; +;;; - Once PCL has been compiled it can be loaded with (pcl::load-pcl). +;;; Note that PCL cannot be loaded on top of itself, nor can it be +;;; loaded into the same world it was compiled in. +;;; + +(in-package :user) + +(load "package.lisp") + +(eval-when (compile load eval) + +(export (intern (symbol-name :iterate) ;Have to do this here, + (find-package :iterate)) ;because in the defsystem + (find-package :iterate)) ;(later in this file) + ;we use the symbol iterate + ;to name the file +) + +(in-package :pcl) + +;;; +;;; Sure, its weird for this to be here, but in order to follow the rules +;;; about order of export and all that stuff, we can't put it in PKG before +;;; we want to use it. +;;; +(defvar *the-pcl-package* (find-package :pcl)) + +(defvar *pcl-system-date* "September 16 92 PCL (g)") + +(eval-when (compile load eval) +(defvar *pcl-proclaim* + '(optimize (speed 3) (safety 1) (space 0) + #+lucid (compilation-speed 0))) +) + +#-cmu ; see pclcom.lisp +(proclaim *pcl-proclaim*) + +#+cmu +(setf (getf ext:*herald-items* :pcl) + `(" CLOS based on PCL version: " ,*pcl-system-date*)) + +;;; +;;; Various hacks to get people's *features* into better shape. +;;; +(eval-when (compile load eval) + #+(and Symbolics Lispm) + (multiple-value-bind (major minor) (sct:get-release-version) + (etypecase minor + (integer) + (string (setf minor (parse-integer minor :junk-allowed t)))) + (pushnew :genera *features*) + (ecase major + ((6) + (pushnew :genera-release-6 *features*)) + ((7) + (pushnew :genera-release-7 *features*) + (pushnew :copy-&rest-arg *features*) + (ecase minor + ((0 1) (pushnew :genera-release-7-1 *features*)) + ((2) (pushnew :genera-release-7-2 *features*)) + ((3) (pushnew :genera-release-7-3 *features*)) + ((4) (pushnew :genera-release-7-4 *features*)))) + ((8) + (pushnew :genera-release-8 *features*) + (ecase minor + ((0) (pushnew :genera-release-8-0 *features*)) + ((1) (pushnew :genera-release-8-1 *features*)))))) + + #+CLOE-Runtime + (let ((version (lisp-implementation-version))) + (when (string-equal version "2.0" :end1 (min 3 (length version))) + (pushnew :cloe-release-2 *features*))) + + (dolist (feature *features*) + (when (and (symbolp feature) ;3600!! + (equal (symbol-name feature) "CMU")) + (pushnew :CMU *features*))) + + #+TI + (if (eq (si:local-binary-file-type) :xld) + (pushnew ':ti-release-3 *features*) + (pushnew ':ti-release-2 *features*)) + + #+Lucid + (when (search "IBM RT PC" (machine-type)) + (pushnew :ibm-rt-pc *features*)) + + #+ExCL + (cond ((search "sun3" (lisp-implementation-version)) + (push :sun3 *features*)) + ((search "sun4" (lisp-implementation-version)) + (push :sun4 *features*))) + + #+(and HP Lucid) + (push :HP-Lucid *features*) + #+(and HP (not Lucid) (not excl)) + (push :HP-HPLabs *features*) + + #+Xerox + (case il:makesysname + (:lyric (push :Xerox-Lyric *features*)) + (otherwise (push :Xerox-Medley *features*))) +;;; +;;; For KCL and IBCL, push the symbol :turbo-closure on the list *features* +;;; if you have installed turbo-closure patch. See the file kcl-mods.text +;;; for details. +;;; +;;; The xkcl version of KCL has this fixed already. +;;; + + #+xkcl(pushnew :turbo-closure *features*) + + ) + +#+(and excl sun4) +(eval-when (eval compile load) + (pushnew :excl-sun4 *features*)) + + + +;;; Yet Another Sort Of General System Facility and friends. +;;; +;;; The entry points are defsystem and operate-on-system. defsystem is used +;;; to define a new system and the files with their load/compile constraints. +;;; Operate-on-system is used to operate on a system defined that has been +;;; defined by defsystem. For example: +#|| + +(defsystem my-very-own-system + "/usr/myname/lisp/" + ((classes (precom) () ()) + (methods (precom classes) (classes) ()) + (precom () (classes methods) (classes methods)))) + +This defsystem should be read as follows: + +* Define a system named MY-VERY-OWN-SYSTEM, the sources and binaries + should be in the directory "/usr/me/lisp/". There are three files + in the system, there are named classes, methods and precom. (The + extension the filenames have depends on the lisp you are running in.) + +* For the first file, classes, the (precom) in the line means that + the file precom should be loaded before this file is loaded. The + first () means that no other files need to be loaded before this + file is compiled. The second () means that changes in other files + don't force this file to be recompiled. + +* For the second file, methods, the (precom classes) means that both + of the files precom and classes must be loaded before this file + can be loaded. The (classes) means that the file classes must be + loaded before this file can be compiled. The () means that changes + in other files don't force this file to be recompiled. + +* For the third file, precom, the first () means that no other files + need to be loaded before this file is loaded. The first use of + (classes methods) means that both classes and methods must be + loaded before this file can be compiled. The second use of (classes + methods) mean that whenever either classes or methods changes precom + must be recompiled. + +Then you can compile your system with: + + (operate-on-system 'my-very-own-system :compile) + +and load your system with: + + (operate-on-system 'my-very-own-system :load) + +||# + +;;; +(defvar *system-directory*) + +;;; +;;; *port* is a list of symbols (in the PCL package) which represent the +;;; Common Lisp in which we are now running. Many of the facilities in +;;; defsys use the value of *port* rather than #+ and #- to conditionalize +;;; the way they work. +;;; +(defparameter *port+dname-list* + (mapcar #'(lambda (x) + (cons (if (consp x) (car x) x) + (string-downcase (if (consp x) (cadr x) x)))) + '(#+Genera (Genera symbolics) +; #+Genera-Release-6 (Rel-6 symbolics) +; #+Genera-Release-7-1 (Rel-7 symbolics) + #+Genera-Release-7-2 (Rel-7 symbolics) + #+Genera-Release-7-3 (Rel-7 symbolics) + #+Genera-Release-7-1 (Rel-7-1 symbolics) + #+Genera-Release-7-2 (Rel-7-2 symbolics) + #+Genera-Release-7-3 (Rel-7-2 symbolics) ;OK for now + #+Genera-Release-7-4 (Rel-7-2 symbolics) ;OK for now + #+Genera-Release-8 (Rel-8 symbolics) + #+imach (Ivory symbolics) + #+Cloe-Runtime (Cloe symbolics) + #+Lucid Lucid + #+Xerox Xerox + #+Xerox-Lyric (Xerox-Lyric xerox) + #+Xerox-Medley (Xerox-Medley xerox) + #+TI TI + #+(and dec vax common) Vaxlisp + #+IBCL IBCL + #+gcl gcl + #+excl (excl franz) + #+(and excl sun4) (excl-sun4 franz) + #+:CMU CMU + #+HP-HPLabs (HP-HPLabs hp) + #+:gclisp (gclisp gold-hill) + #+pyramid pyramid + #+:coral coral))) + +(defparameter *port* (mapcar #'car *port+dname-list*)) + +(defparameter *put-impl-binaries-in-impl-directory-p* + nil) + +;;; +;;; When you get a copy of PCL (by tape or by FTP), the sources files will +;;; have extensions of ".lisp" in particular, this file will be defsys.lisp. +;;; The preferred way to install pcl is to rename these files to have the +;;; extension which your lisp likes to use for its files. Alternately, it +;;; is possible not to rename the files. See below. +;;; +;;; Note: Something people installing PCL on a machine running Unix +;;; might find useful. If you want to change the extensions +;;; of the source files from ".lisp" to ".lsp", *all* you have +;;; to do is the following: +;;; +;;; % foreach i (*.lisp) +;;; ? mv $i $i:r.lsp +;;; ? end +;;; % +;;; +;;; I am sure that a lot of people already know that, and some +;;; Unix hackers may say, "jeez who doesn't know that". Those +;;; same Unix hackers are invited to fix mv so that I can type +;;; "mv *.lisp *.lsp". +;;; +(defvar *default-pathname-extensions* + (car '(#+(and (not imach) genera) ("lisp" . "bin") + #+(and imach genera) ("lisp" . "ibin") + #+Cloe-Runtime ("l" . "fasl") + #+(and dec common vax (not ultrix)) ("LSP" . "FAS") + #+(and dec common vax ultrix) ("lsp" . "fas") + #+IBCL ("lsp" . "o") + #+Xerox ("lisp" . "dfasl") + #+(and Lucid MC68000) ("lisp" . "lbin") + #+(and Lucid VAX) ("lisp" . "vbin") + #+(and Lucid Prime) ("lisp" . "pbin") + #+(and Lucid SUNRise) ("lisp" . "sbin") + #+(and Lucid SPARC) ("lisp" . "sbin") + #+(and Lucid IBM-RT-PC) ("lisp" . "bbin") + #+(and Lucid MIPS) ("lisp" . "mbin") + #+(and Lucid PRISM) ("lisp" . "abin") + #+(and Lucid PA) ("lisp" . "hbin") + #+(and excl SPARC) ("cl" . "sparc") + #+(and excl m68k) ("cl" . "m68k") + #+excl ("cl" . "fasl") + #+cmu ("lisp" . #.(c:backend-fasl-file-type c:*backend*)) + #+HP-HPLabs ("l" . "b") + #+TI ("lisp" . #.(string (si::local-binary-file-type))) + #+:gclisp ("LSP" . "F2S") + #+pyramid ("clisp" . "o") + #+:coral ("lisp" . "fasl") + #-(or symbolics (and dec common vax) KCL IBCL Xerox + lucid excl :CMU HP TI :gclisp pyramid coral) + ("lisp" . "lbin")))) + +;;; Note: In previous versions of PCL, the defvar for *pathname-extensions* +;;; assumed that files WERE renamed, (files-renamed-p was bound to t). +;;; Now, this defvar assumes that the files are not renamed, unless the +;;; symbol :pcl-files-renamed-p is put on the *features* list. + +#| ; Remove this line if you have renamed the PCL source files. +(eval-when (compile load eval) (pushnew :pcl-files-renamed-p *features*)) +|# ; Remove this line if you have renamed the PCL source files. + +(defvar *pathname-extensions* + (let ((proper-extensions (or *default-pathname-extensions* + '("lisp" . "lbin")))) + #+pcl-files-renamed-p proper-extensions + #-pcl-files-renamed-p (cons "lisp" (cdr proper-extensions)))) + +(eval-when (compile load eval) + +(defun get-system (name) + (get name 'system-definition)) + +(defun set-system (name new-value) + (setf (get name 'system-definition) new-value)) + +(defmacro defsystem (name directory files) + `(set-system ',name (list #'(lambda () ,directory) + (make-modules ',files) + ',(mapcar #'car files)))) + +) + + +;;; +;;; The internal datastructure used when operating on a system. +;;; +(defstruct (module (:constructor make-module (name)) + (:print-function + (lambda (m s d) + (declare (ignore d)) + (format s "#" (module-name m))))) + name + load-env + comp-env + recomp-reasons + port) + +(defun make-modules (system-description) + (let ((modules ())) + (labels ((get-module (name) + (or (find name modules :key #'module-name) + (progn (setq modules (cons (make-module name) modules)) + (car modules)))) + (parse-spec (spec) + (if (eq spec 't) + (reverse (cdr modules)) + (case (car spec) + (+ (append (reverse (cdr modules)) + (mapcar #'get-module (cdr spec)))) + (- (let ((rem (mapcar #'get-module (cdr spec)))) + (remove-if #'(lambda (m) (member m rem)) + (reverse (cdr modules))))) + (otherwise (mapcar #'get-module spec)))))) + (dolist (file system-description) + (let* ((name (car file)) + (port (car (cddddr file))) + (module nil)) + (when (or (null port) + (member port *port*)) + (setq module (get-module name)) + (setf (module-load-env module) (parse-spec (cadr file)) + (module-comp-env module) (parse-spec (caddr file)) + (module-recomp-reasons module) (parse-spec (cadddr file)) + (module-port module) port)))) + (let ((filenames (mapcar #'car system-description))) + (sort modules #'(lambda (name1 name2) + (member name2 (member name1 filenames))) + :key #'module-name))))) + + +(defun make-transformations (modules filter make-transform) + (declare (type function filter make-transform)) + (let ((transforms (list nil))) + (dolist (m modules) + (when (funcall filter m transforms) + (funcall make-transform m transforms))) + (reverse (cdr transforms)))) + +(defun make-compile-transformation (module transforms) + (unless (dolist (trans transforms) + (and (eq (car trans) ':compile) + (eq (cadr trans) module) + (return t))) + (dolist (c (module-comp-env module)) + (make-load-transformation c transforms)) + (setf (cdr transforms) + (remove-if #'(lambda (trans) (and (eq (car trans) :load) + (eq (cadr trans) module))) + (cdr transforms))) + (push `(:compile ,module) (cdr transforms)))) + +(defvar *being-loaded* ()) + +(defun make-load-transformation (module transforms) + (if (assoc module *being-loaded*) + (throw module (setf (cdr transforms) + (cdr (assoc module *being-loaded*)))) + (let ((*being-loaded* (cons (cons module (cdr transforms)) + *being-loaded*))) + (catch module + (unless (dolist (trans transforms) + (when (and (eq (car trans) ':load) + (eq (cadr trans) module)) + (return t))) + (dolist (l (module-load-env module)) + (make-load-transformation l transforms)) + (push `(:load ,module) (cdr transforms))))))) + +(defun make-load-without-dependencies-transformation (module transforms) + (unless (dolist (trans transforms) + (and (eq (car trans) ':load) + (eq (cadr trans) module) + (return trans))) + (push `(:load ,module) (cdr transforms)))) + +(defun compile-filter (module transforms) + (or (dolist (r (module-recomp-reasons module)) + (when (dolist (transform transforms) + (when (and (eq (car transform) ':compile) + (eq (cadr transform) r)) + (return t))) + (return t))) + (null (probe-file (make-binary-pathname module))) + (> (file-write-date (make-source-pathname module)) + (file-write-date (make-binary-pathname module))))) + +(defun operation-transformations (name mode &optional arg) + (let ((system (get-system name))) + (unless system (error "Can't find system with name ~S." name)) + (let ((*system-directory* (funcall (the function (car system)))) + (modules (cadr system))) + (ecase mode + (:compile + ;; Compile any files that have changed and any other files + ;; that require recompilation when another file has been + ;; recompiled. + (make-transformations + modules + #'compile-filter + #'make-compile-transformation)) + (:recompile + ;; Force recompilation of all files. + (make-transformations + modules + #'true + #'make-compile-transformation)) + (:recompile-some + ;; Force recompilation of some files. Also compile the + ;; files that require recompilation when another file has + ;; been recompiled. + (make-transformations + modules + #'(lambda (m transforms) + (or (member (module-name m) arg) + (compile-filter m transforms))) + #'make-compile-transformation)) + (:query-compile + ;; Ask the user which files to compile. Compile those + ;; and any other files which must be recompiled when + ;; another file has been recompiled. + (make-transformations + modules + #'(lambda (m transforms) + (or (compile-filter m transforms) + (y-or-n-p "Compile ~A?" + (module-name m)))) + #'make-compile-transformation)) + (:confirm-compile + ;; Offer the user a chance to prevent a file from being + ;; recompiled. + (make-transformations + modules + #'(lambda (m transforms) + (and (compile-filter m transforms) + (y-or-n-p "Go ahead and compile ~A?" + (module-name m)))) + #'make-compile-transformation)) + (:load + ;; Load the whole system. + (make-transformations + modules + #'true + #'make-load-transformation)) + (:query-load + ;; Load only those files the user says to load. + (make-transformations + modules + #'(lambda (m transforms) + (declare (ignore transforms)) + (y-or-n-p "Load ~A?" (module-name m))) + #'make-load-without-dependencies-transformation)))))) + +(defun true (&rest ignore) + (declare (ignore ignore)) + 't) + +#+cmu17 +(defparameter *byte-files* '(defclass defcombin iterate env)) + +(defun operate-on-system (name mode &optional arg print-only) + (let ((system (get-system name))) + (unless system (error "Can't find system with name ~S." name)) + (let* ((*system-directory* (funcall (the function (car system)))) + (transformations (operation-transformations name mode arg))) + (labels ((load-binary (name pathname) + (format t "~&Loading binary of ~A...~%" name) + (or print-only (load pathname))) + (load-module (m) + (let* ((name (module-name m)) + (*load-verbose* t) + (binary (make-binary-pathname m))) + (load-binary name binary))) + (compile-module (m) + (format t "~&Compiling ~A...~%" (module-name m)) + (unless print-only + (compile-file (make-source-pathname m) + :output-file + (make-pathname :defaults + (make-binary-pathname m) + :version :newest) + #+cmu17 :byte-compile #+cmu17 + (if (and (member (module-name m) *byte-files*) + (member :small *features*)) + t + :maybe))))) + (#+Genera + compiler:compiler-warnings-context-bind + #+TI + COMPILER:COMPILER-WARNINGS-CONTEXT-BIND + #+:LCL3.0 + lucid-common-lisp:with-deferred-warnings + #+cmu + with-compilation-unit #+cmu () + #-(or Genera TI :LCL3.0 cmu) + progn + (loop (when (null transformations) (return t)) + (let ((transform (pop transformations))) + (ecase (car transform) + (:compile (compile-module (cadr transform))) + (:load (load-module (cadr transform))))))))))) + +(defun make-source-pathname (name) (make-pathname-internal name :source)) +(defun make-binary-pathname (name) (make-pathname-internal name :binary)) + +(defun make-pathname-internal (name-or-module type) + (let* ((name (if (module-p name-or-module) + (module-name name-or-module) + name-or-module)) + (port (if (module-p name-or-module) + (module-port name-or-module) + nil)) + (extension (ecase type + (:source (car *pathname-extensions*)) + (:binary (cdr *pathname-extensions*)))) + (directory (pathname + (etypecase *system-directory* + (string *system-directory*) + (pathname *system-directory*) + (cons (ecase type + (:source (car *system-directory*)) + (:binary (cdr *system-directory*))))))) + (dir (pathname-directory directory)) + (ldir (if (consp dir) + dir + (pathname-directory (truename directory)))) + + (port-dname (when (and port + (or *put-impl-binaries-in-impl-directory-p* + (eq type ':source))) + (cdr (assoc port *port+dname-list*)))) + (port-directory (if port-dname + (append ldir (list "impl" port-dname)) + ldir)) + + (pathname + (make-pathname + :name (string-downcase (string name)) + :type extension + :directory port-directory + :defaults directory))) + + #+Genera + (setq pathname (zl:send pathname :new-raw-name (pathname-name pathname)) + pathname (zl:send pathname :new-raw-type (pathname-type pathname))) + + pathname)) + +(defun system-source-files (name) + (let ((system (get-system name))) + (unless system (error "Can't find system with name ~S." name)) + (let ((*system-directory* (funcall (the function (car system)))) + (modules (cadr system))) + (mapcar #'make-source-pathname modules)))) + +(defun system-binary-files (name) + (let ((system (get-system name))) + (unless system (error "Can't find system with name ~S." name)) + (let ((*system-directory* (funcall (the function (car system)))) + (modules (cadr system))) + (mapcar #'make-binary-pathname modules)))) + +;;; *** SITE SPECIFIC PCL DIRECTORY *** +;;; +;;; *pcl-directory* is a variable which specifies the directory pcl is stored +;;; in at your site. If the value of the variable is a single pathname, the +;;; sources and binaries should be stored in that directory. If the value of +;;; that directory is a cons, the CAR should be the source directory and the +;;; CDR should be the binary directory. +;;; +;;; By default, the value of *pcl-directory* is set to the directory that +;;; this file is loaded from. This makes it simple to keep multiple copies +;;; of PCL in different places, just load defsys from the same directory as +;;; the copy of PCL you want to use. +;;; +;;; Note that the value of *PCL-DIRECTORY* is set using a DEFVAR. This is +;;; done to make it possible for users to set it in their init file and then +;;; load this file. The value set in the init file will override the value +;;; here. +;;; +;;; *** *** + +(defun load-truename (&optional (errorp nil)) + #+cmu (declare (ignore errorp)) + (flet (#+(or Lispm Xerox LUCID) + (bad-time () + (when errorp + (error "LOAD-TRUENAME called but a file isn't being loaded.")))) + #+Lispm (or sys:fdefine-file-pathname (bad-time)) + #+excl excl::*source-pathname* + #+Xerox (pathname (or (il:fullname *standard-input*) (bad-time))) + #+(and dec vax common) (truename (sys::source-file #'load-truename)) + ;; + ;; The following use of `lucid::' is a kludge for 2.1 and 3.0 + ;; compatibility. In 2.1 it was in the SYSTEM package, and i + ;; 3.0 it's in the LUCID-COMMON-LISP package. + ;; + #+LUCID (or lucid::*source-pathname* (bad-time)) + #+akcl *load-pathname* + #+cmu17 *load-truename* + #-(or Lispm excl Xerox (and dec vax common) LUCID akcl cmu17) nil)) + +#-(or cmu Symbolics) +(defvar *pcl-directory* (concatenate 'string user::*system-directory* "../pcl/")) +; (or (load-truename t) +; (error "Because load-truename is not implemented in this port~%~ +; of PCL, you must manually edit the definition of the~%~ +; variable *pcl-directory* in the file defsys.lisp."))) + +#+cmu +(defvar *pcl-directory* (pathname "target:pcl/")) + +#+Genera +(defvar *pcl-directory* + (let ((source (load-truename t))) + (flet ((subdir (name) + (scl:send source :new-pathname :raw-directory + (append (scl:send source :raw-directory) + (list name))))) + (cons source + #+genera-release-7-2 (subdir "rel-7-2") + #+genera-release-7-3 (subdir "rel-7-3") + #+genera-release-7-4 (subdir "rel-7-4") + #+genera-release-8-0 (subdir "rel-8-0") + #+genera-release-8-1 (subdir "rel-8-1") + )))) + +#+Cloe-Runtime +(defvar *pcl-directory* (pathname "/usr3/hornig/pcl/")) + +(defsystem pcl + *pcl-directory* + ;; + ;; file load compile files which port + ;; environment environment force the of + ;; recompilation + ;; of this file + ;; + ( +; (rel-6-patches t t () rel-6) +; (rel-7-1-patches t t () rel-7-1) + (rel-7-2-patches t t () rel-7-2) + (rel-8-patches t t () rel-8) + (ti-patches t t () ti) + (pyr-patches t t () pyramid) + (xerox-patches t t () xerox) + (kcl-patches t t () kcl) + (ibcl-patches t t () ibcl) + (gold-patches t t () gclisp) + + (gcl_pcl_pkg t t ()) + (sys-proclaim t t () kcl) + (gcl_pcl_walk (gcl_pcl_pkg) (gcl_pcl_pkg) ()) + (gcl_pcl_iterate t t ()) + (gcl_pcl_macros t t ()) + (gcl_pcl_low (gcl_pcl_pkg gcl_pcl_macros) t (gcl_pcl_macros)) + + + (genera-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) Genera) + (cloe-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) Cloe) + (lucid-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) Lucid) + (Xerox-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) Xerox) + (ti-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) TI) + (vaxl-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) vaxlisp) + (kcl-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) KCL) + (ibcl-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) IBCL) + (gcl_pcl_impl_low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) gcl) + (excl-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) excl) + (cmu-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) CMU) + (hp-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) HP-HPLabs) + (gold-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) gclisp) + (pyr-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) pyramid) + (coral-low (gcl_pcl_low) (gcl_pcl_low) (gcl_pcl_low) coral) + + (gcl_pcl_fin t t (gcl_pcl_low)) + (gcl_pcl_defclass t t (gcl_pcl_low)) + (gcl_pcl_defs t t (gcl_pcl_defclass gcl_pcl_macros gcl_pcl_iterate)) + (gcl_pcl_fngen t t (gcl_pcl_low)) + (gcl_pcl_cache t t (gcl_pcl_low gcl_pcl_defs)) + (gcl_pcl_dlisp t t (gcl_pcl_defs gcl_pcl_low gcl_pcl_fin gcl_pcl_cache)) + (gcl_pcl_dlisp2 t t (gcl_pcl_low gcl_pcl_fin gcl_pcl_cache gcl_pcl_dlisp)) + (gcl_pcl_boot t t (gcl_pcl_defs gcl_pcl_fin)) + (gcl_pcl_vector t t (gcl_pcl_boot gcl_pcl_defs gcl_pcl_cache gcl_pcl_fin)) + (gcl_pcl_slots_boot t t (gcl_pcl_vector gcl_pcl_boot gcl_pcl_defs gcl_pcl_cache gcl_pcl_fin)) + (gcl_pcl_combin t t (gcl_pcl_boot gcl_pcl_defs)) + (gcl_pcl_dfun t t (gcl_pcl_boot gcl_pcl_low gcl_pcl_cache)) + (gcl_pcl_fast_init t t (gcl_pcl_boot gcl_pcl_low)) + (gcl_pcl_braid (+ gcl_pcl_precom1 gcl_pcl_precom2) t (gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_fin gcl_pcl_cache)) + (gcl_pcl_generic_functions t t (gcl_pcl_boot)) + (gcl_pcl_slots t t (gcl_pcl_vector gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_cache gcl_pcl_fin)) + (gcl_pcl_init t t (gcl_pcl_vector gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_fast_init)) + (gcl_pcl_std_class t t (gcl_pcl_vector gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_cache gcl_pcl_fin gcl_pcl_slots)) + (gcl_pcl_cpl t t (gcl_pcl_vector gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_cache gcl_pcl_fin gcl_pcl_slots)) + (gcl_pcl_fsc t t (gcl_pcl_defclass gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_fin gcl_pcl_cache)) + (gcl_pcl_methods t t (gcl_pcl_defclass gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_fin gcl_pcl_cache)) + (gcl_pcl_fixup t t (gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_fin)) + (gcl_pcl_defcombin t t (gcl_pcl_defclass gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_fin)) + (gcl_pcl_ctypes t t (gcl_pcl_defclass gcl_pcl_defcombin)) + (gcl_pcl_env t t (gcl_pcl_defclass gcl_pcl_boot gcl_pcl_defs gcl_pcl_low gcl_pcl_fin)) + (gcl_pcl_compat t t ()) + (gcl_pcl_precom1 (gcl_pcl_dlisp) t (gcl_pcl_defs gcl_pcl_low gcl_pcl_cache gcl_pcl_fin gcl_pcl_dfun)) + (gcl_pcl_precom2 (gcl_pcl_dlisp) t (gcl_pcl_defs gcl_pcl_low gcl_pcl_cache gcl_pcl_fin gcl_pcl_dfun)) + )) + +(defun compile-pcl (&optional m) + (let (#+:coral(ccl::*warn-if-redefine-kernel* nil) + #+Lucid (lcl:*redefinition-action* nil) + #+excl (excl::*redefinition-warnings* nil) + #+Genera (sys:inhibit-fdefine-warnings t) + ) + (cond ((null m) (operate-on-system 'pcl :compile)) + ((eq m :print) (operate-on-system 'pcl :compile () t)) + ((eq m :query) (operate-on-system 'pcl :query-compile)) + ((eq m :confirm) (operate-on-system 'pcl :confirm-compile)) + ((eq m 't) (operate-on-system 'pcl :recompile)) + ((listp m) (operate-on-system 'pcl :compile-from m)) + ((symbolp m) (operate-on-system 'pcl :recompile-some `(,m)))))) + +(defun load-pcl (&optional m) + (let (#+:coral(ccl::*warn-if-redefine-kernel* nil) + #+Lucid (lcl:*redefinition-action* nil) + #+excl (excl::*redefinition-warnings* nil) + #+Genera (sys:inhibit-fdefine-warnings t) + ) + (cond ((null m) (operate-on-system 'pcl :load)) + ((eq m :query) (operate-on-system 'pcl :query-load))))) + +#+Genera +;;; Make sure Genera bug mail contains the PCL bug data. A little +;;; kludgy, but what the heck. If they didn't mean for people to do +;;; this, they wouldn't have made private patch notes be flavored +;;; objects, right? Right. +(progn + (scl:defflavor pcl-private-patch-info ((description)) ()) + (scl:defmethod (sct::private-patch-info-description pcl-private-patch-info) () + (or description + (setf description (string-append "PCL version: " *pcl-system-date*)))) + (scl:defmethod (sct::private-patch-info-pathname pcl-private-patch-info) () + *pcl-directory*) + (unless (find-if #'(lambda (x) (typep x 'pcl-private-patch-info)) + sct::*private-patch-info*) + (push (scl:make-instance 'pcl-private-patch-info) + sct::*private-patch-info*))) + +(defun bug-report-info (&optional (stream *standard-output*)) + (format stream "~&PCL system date: ~A~ + ~&Lisp Implementation type: ~A~ + ~&Lisp Implementation version: ~A~ + ~&*features*: ~S" + *pcl-system-date* + (lisp-implementation-type) + (lisp-implementation-version) + *features*)) + + + +;;;; +;;; +;;; This stuff is not intended for external use. +;;; +(defun rename-pcl () + (dolist (f (cadr (get-system 'pcl))) + (let ((old nil) + (new nil)) + (let ((*system-directory* *default-pathname-defaults*)) + (setq old (make-source-pathname (car f)))) + (setq new (make-source-pathname (car f))) + (rename-file old new)))) + +#+Genera +(defun edit-pcl () + (dolist (f (cadr (get-system 'pcl))) + (let ((*system-directory* *pcl-directory*)) + (zwei:find-file (make-source-pathname (car f)))))) + +#+Genera +(defun hardcopy-pcl (&optional query-p) + (let ((files (mapcar #'(lambda (f) + (setq f (car f)) + (and (or (not query-p) + (y-or-n-p "~A? " f)) + f)) + (cadr (get-system 'pcl)))) + (b zwei:*interval*)) + (unwind-protect + (dolist (f files) + (when f + (multiple-value-bind (ignore b) + (zwei:find-file (make-source-pathname f)) + (zwei:hardcopy-buffer b)))) + (zwei:make-buffer-current b)))) + + +;;; +;;; unido!ztivax!dae@seismo.css.gov +;;; z30083%tansei.cc.u-tokyo.junet@utokyo-relay.csnet +;;; Victor@carmen.uu.se +;;; mcvax!harlqn.co.uk!chris@uunet.UU.NET +;;; +#+Genera +(defun mail-pcl (to) + (let* ((original-buffer zwei:*interval*) + (*system-directory* (pathname "vaxc:/user/ftp/pub/pcl/") + ;(funcall (car (get-system 'pcl))) + ) + (files (list* 'defsys + 'test + (caddr (get-system 'pcl)))) + (total-number (length files)) + (file nil) + (number-of-lines 0) + (i 0) + (mail-buffer nil)) + (unwind-protect + (loop + (when (null files) (return nil)) + (setq file (pop files)) + (incf i) + (multiple-value-bind (ignore b) + (zwei:find-file (make-source-pathname file)) + (setq number-of-lines (zwei:count-lines b)) + (zwei:com-mail-internal t + :initial-to to + :initial-body b + :initial-subject + (format nil + "PCL file ~A (~A of ~A) ~D lines" + file i total-number number-of-lines)) + (setq mail-buffer zwei:*interval*) + (zwei:com-exit-com-mail) + (format t "~&Just sent ~A (~A of ~A)." b i total-number) + (zwei:kill-buffer mail-buffer))) + (zwei:make-buffer-current original-buffer)))) + +(defun reset-pcl-package () ; Try to do this safely + (let* ((vars '(*pcl-directory* + *default-pathname-extensions* + *pathname-extensions* + *redefined-functions*)) + (names (mapcar #'symbol-name vars)) + (values (mapcar #'symbol-value vars))) + (declare (special *redefined-functions*)) + (reset-package "PCL") + (let ((pkg (find-package "SLOT-ACCESSOR-NAME"))) + (when pkg + (do-symbols (sym pkg) + (makunbound sym) + (fmakunbound sym) + (setf (symbol-plist sym) nil)))) + (let ((pcl (find-package "PCL"))) + (mapcar #'(lambda (name value) + (let ((var (intern name pcl))) + (proclaim `(special ,var)) + (set var value))) + names values)) + (dolist (sym *redefined-functions*) + (setf (symbol-function sym) (get sym 'definition-before-pcl))) + nil)) + +(defun reset-package (&optional (package-name "PCL")) + (let ((pkg (find-package package-name))) + (do-symbols (sym pkg) + (when (eq pkg (symbol-package sym)) + (if (or (constantp sym) + #-cmu (member sym '(wrapper cache arg-info pv-table)) + #+cmu + (or (c::info setf inverse sym) + (c::info setf expander sym) + (c::info type kind sym) + (c::info function macro-function sym) + (c::info function compiler-macro-function sym))) + (unintern sym pkg) + (progn + (makunbound sym) + (unless (or (eq sym 'reset-pcl-package) + (eq sym 'reset-package)) + (fmakunbound sym) + #+cmu + (fmakunbound `(setf ,sym))) + (setf (symbol-plist sym) nil))))))) diff --git a/pcl/extensions/extensions.lisp b/pcl/extensions/extensions.lisp new file mode 100644 index 0000000..32231cf --- /dev/null +++ b/pcl/extensions/extensions.lisp @@ -0,0 +1,496 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp; -*- + +;;; +;;; ************************************************************************* +;;; +;;; File: extensions.lisp. +;;; +;;; by Trent E. Lange, Effective Date 04-23-92 +;;; +;;; +;;; This file contains a small set of useful extensions to PCL. +;;; +;;; Permission is granted to any individual or institution to use, copy, +;;; modify and distribute this document. +;;; +;;; Suggestions, bugs, criticism and questions to lange@cs.ucla.edu +;;; ************************************************************************* +;;; + +(in-package 'pcl) + +(eval-when (compile load eval) + +(defvar *extensions-exports* + '(set-standard-instance-access + set-funcallable-instance-access + + funcallable-instance-slot-value + set-funcallable-instance-slot-value + funcallable-instance-slot-boundp + standard-instance-slot-value + set-standard-instance-slot-value + standard-instance-slot-boundp + structure-instance-slot-value + set-structure-instance-slot-value + structure-instance-slot-boundp + + #+pcl-user-instances + user-instance-slot-value + #+pcl-user-instances + set-user-instance-slot-value + #+pcl-user-instances + user-instance-slot-boundp + + with-optimized-slots + with-standard-instance-slots + + method-needs-next-methods-p + map-all-classes + finalize-all-classes + + updater + record-updater)) +) + +(defclass updater () + ((dependent :initarg :dependent :reader dependent))) + +(defun record-updater (class dependee dependent &rest initargs) + (let ((updater + (apply #'make-instance class :dependent dependent initargs))) + (add-dependent dependee updater) + updater)) + + +(defun finalize-all-classes (&optional (root-name 't)) + "Makes sure that all classes are finalized. If Root-Name is supplied, + then finalizes Root-Name and all of its subclasses and their subclasses." + (map-all-classes #'(lambda (class) + (unless (class-finalized-p class) + (finalize-inheritance class))) + root-name)) + + +;;; +;;; +;;; + + +(defmacro slot-value-from-index (instance wrapper slot-name slots index) + "Returns instance's slot-value given slot-name's index." + (once-only (index) + `(if ,index + (let ((val (%svref ,slots ,index))) + (if (eq val ',*slot-unbound*) + (slot-unbound (wrapper-class ,wrapper) ,instance ,slot-name) + val)) + (if *safe-to-use-slot-value-wrapper-optimizations-p* + (get-class-slot-value-1 ,instance ,wrapper ,slot-name) + (accessor-slot-value ,instance ,slot-name))))) + +(defmacro set-slot-value-from-index + (instance wrapper slot-name slots index new-value) + "Sets instance's slot-value to new-value given slot-name's index." + (once-only (index) + `(if ,index + (setf (%svref ,slots ,index) ,new-value) + (if *safe-to-use-set-slot-value-wrapper-optimizations-p* + (set-class-slot-value-1 ,instance ,wrapper ,slot-name ,new-value) + (setf (accessor-slot-value ,instance ,slot-name) ,new-value))))) + +(defsetf slot-value-from-index set-slot-value-from-index) + +(defmacro with-slots-slot-value-from-index + (instance wrapper slot-name slots index variable-instance) + "Returns instance's slot-value given slot-name's index." + (cond + ((consp wrapper) + `(let ((wrapper ,wrapper)) + (unless (eq (wrapper-state wrapper) 't) + (setf wrapper (wrapper-state-trap wrapper ,instance))) + (with-slots-slot-value-from-index + ,instance wrapper ,slot-name ,slots ,index ,variable-instance))) + (variable-instance + `(let ((,instance ,variable-instance)) + (with-slots-slot-value-from-index + ,instance ,wrapper ,slot-name ,slots ,index NIL))) + (T `(slot-value-from-index ,instance ,wrapper ,slot-name ,slots ,index)))) + +(defmacro set-with-slots-slot-value-from-index + (instance wrapper slot-name slots index variable-instance new-value) + "Sets instance's slot-value to new-value given slot-name's index." + (cond + ((consp wrapper) + `(let ((wrapper ,wrapper)) + (unless (eq (wrapper-state wrapper) 't) + (setf wrapper (wrapper-state-trap wrapper ,instance))) + (set-with-slots-slot-value-from-index + ,instance wrapper ,slot-name ,slots ,index ,variable-instance + ,new-value))) + (variable-instance + `(let ((,instance ,variable-instance)) + (set-with-slot-slots-value-from-index + ,instance ,wrapper ,slot-name ,slots ,index NIL ,new-value))) + (T + `(setf (slot-value-from-index ,instance ,wrapper ,slot-name ,slots ,index) + ,new-value)))) + +(defsetf with-slots-slot-value-from-index + set-with-slots-slot-value-from-index) + +(defmacro with-slots-slot-value-from-wrapper-and-slots + (instance slot-name wrapper slots-layout slots variable-instance) + (cond + (variable-instance + `(let ((,instance ,variable-instance)) + (with-slots-slot-value-from-wrapper-and-slots + ,instance ,slot-name ,wrapper ,slots-layout ,slots NIL))) + ((consp wrapper) + `(if *safe-to-use-slot-value-wrapper-optimizations-p* + (let ((wrapper ,wrapper)) + (unless (eq (wrapper-state wrapper) 't) + (setf wrapper (wrapper-state-trap wrapper ,instance))) + (slot-value-from-wrapper-and-slots ,instance ,slot-name + wrapper ,slots-layout ,slots NIL)) + (accessor-slot-value ,instance ,slot-name))) + (T + `(if *safe-to-use-slot-value-wrapper-optimizations-p* + (slot-value-from-wrapper-and-slots + ,instance ,slot-name ,wrapper ,slots-layout ,slots NIL) + (accessor-slot-value ,instance ,slot-name))))) + +(defmacro set-with-slots-slot-value-from-wrapper-and-slots + (instance slot-name wrapper slots-layout slots variable-instance new-value) + (cond + (variable-instance + `(let ((,instance ,variable-instance)) + (set-with-slots-slot-value-from-wrapper-and-slots + ,instance ,slot-name ,wrapper ,slots-layout ,slots NIL ,new-value))) + ((consp wrapper) + `(if *safe-to-use-set-slot-value-wrapper-optimizations-p* + (let ((wrapper ,wrapper)) + (unless (eq (wrapper-state wrapper) 't) + (setf wrapper (wrapper-state-trap wrapper ,instance))) + (setf (slot-value-from-wrapper-and-slots ,instance ,slot-name + wrapper ,slots-layout ,slots NIL) + ,new-value)) + (setf (accessor-slot-value ,instance ,slot-name) ,new-value))) + (T + `(if *safe-to-use-set-slot-value-wrapper-optimizations-p* + (setf (slot-value-from-wrapper-and-slots + ,instance ,slot-name ,wrapper ,slots-layout ,slots NIL) + ,new-value) + (setf (accessor-slot-value ,instance ,slot-name) ,new-value))))) + +(defsetf with-slots-slot-value-from-wrapper-and-slots + set-with-slots-slot-value-from-wrapper-and-slots) + +(defun tree-memq-p (item form) + (cond ((consp form) + (or (tree-memq-p item (car form)) + (tree-memq-p item (cdr form)))) + (T (eq item form)))) + +(defmacro with-optimized-slots (slot-entries instance-form &body body) + "Optimized version of With-Slots that is faster because it factors out + functions common to all slot accesses on the instance. It has two + extensions to With-Slots: (1) the second value of slot-entries are + evaluated as forms rather than considered to be hard slot-names, allowing + access of variable slot-names. (2) if a :variable-instance keyword is + the first part of the body, then the instance-form is treated as a variable + form, which is always expected to return an instance of the same class. + The value of the keyword must be an instance that is the same class as + instance-form will always return." + ;; E.g. (with-optimized-slots (foo-slot + ;; (foo-slot-accessor 'foo-slot) + ;; (variable-slot-accessor variable-slot)) + ;; instance + ;; :instance-form (car instances-of-same-class) + ;; (loop for instance in objects-of-same-class + ;; as variable-slot in variable-slots + ;; collect (list foo-slot + ;; foo-slot-accessor + ;; variable-slot-accessor))) + ;; ==> (loop for instance in objects-of-same-class + ;; as variable-slot in variable-slots + ;; collect (list (slot-value instance 'foo-slot) + ;; (slot-value instance 'foo-slot) + ;; (slot-value instance variable-slot))) + (build-with-optimized-slots-form slot-entries instance-form body)) + +(defmacro with-standard-instance-slots (slot-entries instance-form &body body) + "Optimized version of With-Slots that assumes that the instance-form + evaluates to a standard-instance. The result is undefined if it does not. + With-standard-instance-slots is faster than With-Slots because it factors + out functions common to all slot accesses on the instance. It has two + extensions to With-Slots: (1) the second value of slot-entries are + evaluated as forms rather than considered to be hard slot-names, allowing + access of variable slot-names. (2) if a :variable-instance keyword is + the first part of the body, then the instance-form is treated as a variable + form, which is always expected to return an instance of the same class. + The value of the keyword must be an instance that is the same class as + instance-form will always return." + (build-with-optimized-slots-form slot-entries instance-form body 'std-instance)) + +(defun build-with-optimized-slots-form (slot-entries instance-form body + &optional instance-type) + (let* ((variable-instance + (if (eq (car body) :variable-instance) + (prog1 + (cadr body) + (setf body (cddr body))))) + (hard-accessors + (let ((collect NIL)) + (dolist (slot-entry slot-entries (nreverse collect)) + (when (and (symbolp slot-entry) + (tree-memq-p slot-entry body)) + (push (cons slot-entry slot-entry) collect)) + (when (and (consp slot-entry) + (constantp (second slot-entry)) + (tree-memq-p (car slot-entry) body)) + (push (cons (car slot-entry) (second (second slot-entry))) + collect))))) + (variable-accessors + (let ((collect NIL)) + (dolist (slot-entry slot-entries (nreverse collect)) + (when (and (consp slot-entry) + (not (constantp (second slot-entry))) + (tree-memq-p (car slot-entry) body)) + (push slot-entry collect)))))) + (if *safe-to-use-slot-wrapper-optimizations-p* + (build-maybe-safe-w-o-s-v hard-accessors variable-accessors + instance-form body variable-instance + instance-type) + (build-with-accessor-s-v hard-accessors variable-accessors + instance-form body variable-instance)))) + +(defun build-maybe-safe-w-o-s-v (hard-accessors variable-accessors + instance-form body variable-instance + instance-type) + (let* ((instance-string + (if (symbolp instance-form) (symbol-name instance-form) "")) + (instance-form-var + (if (and variable-instance (simple-eval-access-p instance-form)) + instance-form + (gensym + (concatenate 'simple-string instance-string "-INSTANCE-FORM")))) + (prototype-form + (if variable-instance + (if (simple-eval-access-p variable-instance) + variable-instance + (gensym (concatenate 'simple-string "VARIABLE-INSTANCE" + instance-string))) + instance-form-var)) + (wrapper-var + (gensym (concatenate 'simple-string instance-string "-WRAPPER"))) + (slots-var + (unless variable-instance + (gensym (concatenate 'simple-string instance-string "-SLOTS")))) + (type-var + (when (and variable-instance (not instance-type)) + (gensym (concatenate 'simple-string instance-string "-TYPE")))) + (type-var-std 1) + (type-var-fsc 2) + #+pcl-user-instances + (type-var-user 3) + (slot-index-vars + (mapcar #'(lambda (slot-entry) + (list (car slot-entry) + (cdr slot-entry) + (gensym (concatenate + 'simple-string + (if (string= instance-string "") + "INSTANCE-FORM-" + instance-string) + (symbol-name (cdr slot-entry)) + "-INDEX")))) + (remove-duplicates hard-accessors :key #'cdr))) + (slots-layout-var + (gensym (concatenate 'simple-string "SLOTS-LAYOUT-" instance-string))) + (runtime-slots-form + (if variable-instance + (ecase instance-type + (std-instance `(std-instance-slots ,instance-form-var)) + (fsc-instance `(fsc-instance-slots ,instance-form-var)) + #+pcl-user-instances + (user-instance `(get-user-instance-slots ,instance-form-var)) + ((nil) + `(case ,type-var + (,type-var-std (std-instance-slots ,instance-form-var)) + (,type-var-fsc (fsc-instance-slots ,instance-form-var)) + #+pcl-user-instances + (,type-var-user (get-user-instance-slots ,instance-form-var))))) + slots-var)) + (runtime-wrapper-form + (if variable-instance + (ecase instance-type + (std-instance `(std-instance-wrapper ,instance-form-var)) + (fsc-instance `(fsc-instance-wrapper ,instance-form-var)) + #+pcl-user-instances + (user-instance `(get-user-instance-wrapper ,instance-form-var)) + ((nil) + `(case ,type-var + (,type-var-std (std-instance-wrapper ,instance-form-var)) + (,type-var-fsc (fsc-instance-wrapper ,instance-form-var)) + #+pcl-user-instances + (,type-var-user (get-user-instance-wrapper ,instance-form-var))))) + wrapper-var))) + (declare (type simple-string instance-string) + (type list slot-index-vars)) + `(let (,@(unless variable-instance + `((,instance-form-var ,instance-form))) + ,@(when (and variable-instance + (not (eq prototype-form variable-instance))) + `((,prototype-form ,variable-instance))) + ,wrapper-var ,slots-layout-var + ,@(if variable-instance + (if type-var `((type-var 0))) + (list slots-var)) + ,@(mapcar #'third slot-index-vars)) + ,@(when type-var `((declare (type index ,type-var)))) + (when *safe-to-use-slot-wrapper-optimizations-p* + ,@(ecase instance-type + (std-instance + `((setf ,wrapper-var (std-instance-wrapper ,prototype-form)) + ,@(unless variable-instance + `((setf ,slots-var (std-instance-slots ,prototype-form)))))) + (fsc-instance + `((setf ,wrapper-var (fsc-instance-wrapper ,prototype-form)) + ,@(unless variable-instance + `((setf ,slots-var (fsc-instance-slots ,prototype-form)))))) + #+pcl-user-instances + (user-instance + `((setf ,wrapper-var (get-user-instance-wrapper ,prototype-form)) + ,@(unless variable-instance + `((setf ,slots-var (get-user-instance-slots ,prototype-form)))))) + ((nil) + `((cond + ((std-instance-p ,prototype-form) + (setf ,wrapper-var (std-instance-wrapper ,prototype-form)) + ,(if variable-instance + `(setf ,type-var ,type-var-std) + `(setf ,slots-var (std-instance-slots ,prototype-form)))) + ((fsc-instance-p ,prototype-form) + (setf ,wrapper-var (fsc-instance-wrapper ,prototype-form)) + ,(if variable-instance + `(setf ,type-var ,type-var-fsc) + `(setf ,slots-var (fsc-instance-slots ,prototype-form)))) + #+pcl-user-instances + ((get-user-instance-p ,prototype-form) + (setf ,wrapper-var (get-user-instance-wrapper ,prototype-form)) + ,(if variable-instance + `(setf ,type-var ,type-var-user) + `(setf ,slots-var (get-user-instance-slots ,prototype-form)))))))) + ,@(if instance-type + (build-w-s-v-find-slot-indices wrapper-var slots-layout-var + prototype-form slot-index-vars) + `((when ,wrapper-var + ,@(build-w-s-v-find-slot-indices wrapper-var slots-layout-var + prototype-form slot-index-vars))))) + (symbol-macrolet + (,@(mapcar + #'(lambda (slot-cons) + `(,(car slot-cons) + (with-slots-slot-value-from-index + ,instance-form-var + ,runtime-wrapper-form + ',(cdr slot-cons) + ,runtime-slots-form + ,(third (assoc (car slot-cons) slot-index-vars + :test #'eq)) + ,(when (and variable-instance + (not (eq variable-instance + instance-form-var))) + variable-instance)))) + hard-accessors) + ,@(mapcar + #'(lambda (variable-cons) + `(,(car variable-cons) + (with-slots-slot-value-from-wrapper-and-slots + ,instance-form-var + ,(second variable-cons) + ,runtime-wrapper-form + ,slots-layout-var + ,runtime-slots-form + ,(when (and variable-instance + (not (eq variable-instance + instance-form-var))) + variable-instance)))) + variable-accessors)) + ,@body)))) + +(defun build-w-s-v-find-slot-indices (wrapper-var slots-layout-var + prototype-form + slot-index-vars) + (declare (type list slot-index-vars)) + `((unless (eq (wrapper-state ,wrapper-var) 't) + (setf ,wrapper-var + (wrapper-state-trap ,wrapper-var ,prototype-form))) + (setf ,slots-layout-var (wrapper-instance-slots-layout ,wrapper-var)) + ,@(if (<= (length slot-index-vars) 2) + (mapcar + #'(lambda (slot-cons) + `(setf ,(third slot-cons) + (instance-slot-index-from-slots-layout + ,slots-layout-var ',(second slot-cons)))) + slot-index-vars) + ;; More than two slots, so more efficient to search slots-layout-var + ;; only once, rather than once for each with instance-slot-index. + (labels + ((build-comps (slot-vars index) + (if slot-vars + `(if (eq slot-name ',(second (car slot-vars))) + (progn + (setf ,(third (car slot-vars)) ,index) + (if (= matches ,(1- (length slot-index-vars))) + (go end-loop) + (setf matches (the fixnum (1+ matches))))) + ,(build-comps (cdr slot-vars) index))))) + `((block nil + (let ((slots-left ,slots-layout-var) + (slot-name NIL) + (index 0) + (matches 0)) + (declare (type fixnum index matches)) + (when slots-left + (tagbody + begin-instance-slots-loop + (setf slot-name (car slots-left)) + ,(build-comps slot-index-vars 'index) + (setf index (the fixnum (1+ index))) + (if (null (setf slots-left (cdr slots-left))) + (go end-loop)) + (go begin-instance-slots-loop) + end-loop))))))))) + +(defun build-with-accessor-s-v (hard-accessors variable-accessors + instance-form body variable-instance) + ;; Build the body for with-optimized-slot-value when it is unsafe + ;; and accessor-slot-value must be used. + (let ((instance-form-var + (if variable-instance instance-form (gensym "INSTANCE-FORM")))) + `(let (,@(unless variable-instance + `((,instance-form-var ,instance-form)))) + (symbol-macrolet + (,@(mapcar + #'(lambda (slot-cons) + `(,(car slot-cons) + (accessor-slot-value ,instance-form-var + ',(cdr slot-cons)))) + hard-accessors) + ,@(mapcar + #'(lambda (variable-cons) + `(,(car variable-cons) + (accessor-slot-value ,instance-form-var + ,(second variable-cons)))) + variable-accessors)) + ,@body)))) + + +#-(or KCL IBCL) +(export *extensions-exports* *the-pcl-package*) + +#+(or KCL IBCL) +(mapc 'export (list *extensions-exports*) (list *the-pcl-package*)) + diff --git a/pcl/extensions/inline.lisp b/pcl/extensions/inline.lisp new file mode 100644 index 0000000..b884310 --- /dev/null +++ b/pcl/extensions/inline.lisp @@ -0,0 +1,263 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- + +(in-package :pcl) + +;; This file contains some of the things that will have to change to support +;; inlining of methods. + +(defun make-method-lambda-internal (method-lambda &optional env) + (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) + (error "The method-lambda argument to make-method-lambda, ~S,~ + is not a lambda form" method-lambda)) + (multiple-value-bind (documentation declarations real-body) + (extract-declarations (cddr method-lambda) env) + (let* ((name-decl (get-declaration 'method-name declarations)) + (sll-decl (get-declaration 'method-lambda-list declarations)) + (method-name (when (consp name-decl) (car name-decl))) + (generic-function-name (when method-name (car method-name))) + (specialized-lambda-list (or sll-decl (cadr method-lambda)))) + (multiple-value-bind (parameters lambda-list specializers) + (parse-specialized-lambda-list specialized-lambda-list) + (let* ((required-parameters + (mapcar #'(lambda (r s) (declare (ignore s)) r) + parameters + specializers)) + (slots (mapcar #'list required-parameters)) + (calls (list nil)) + (parameters-to-reference + (make-parameter-references specialized-lambda-list + required-parameters + declarations + method-name + specializers)) + (class-declarations + `(declare + ,@(remove nil + (mapcar #'(lambda (a s) (and (symbolp s) + (neq s 't) + `(class ,a ,s))) + parameters + specializers)))) + (method-lambda + ;; Remove the documentation string and insert the + ;; appropriate class declarations. The documentation + ;; string is removed to make it easy for us to insert + ;; new declarations later, they will just go after the + ;; cadr of the method lambda. The class declarations + ;; are inserted to communicate the class of the method's + ;; arguments to the code walk. + `(lambda ,lambda-list + ,class-declarations + ,@declarations + (progn ,@parameters-to-reference) + (block ,(if (listp generic-function-name) + (cadr generic-function-name) + generic-function-name) + ,@real-body))) + (constant-value-p (and (null (cdr real-body)) + (constantp (car real-body)))) + (constant-value (and constant-value-p + (eval (car real-body)))) + (plist (if (and constant-value-p + (or (typep constant-value '(or number character)) + (and (symbolp constant-value) + (symbol-package constant-value)))) + (list :constant-value constant-value) + ())) + (applyp (dolist (p lambda-list nil) + (cond ((memq p '(&optional &rest &key)) + (return t)) + ((eq p '&aux) + (return nil)))))) + (multiple-value-bind (walked-lambda call-next-method-p closurep + next-method-p-p) + (walk-method-lambda method-lambda required-parameters env + slots calls) + (multiple-value-bind (ignore walked-declarations walked-lambda-body) + (extract-declarations (cddr walked-lambda)) + (declare (ignore ignore)) + (when (or next-method-p-p call-next-method-p) + (setq plist (list* :needs-next-methods-p 't plist))) + (when (some #'cdr slots) + (multiple-value-bind (slot-name-lists call-list) + (slot-name-lists-from-slots slots calls) + (let ((pv-table-symbol (make-symbol "pv-table"))) + (setq plist + `(,@(when slot-name-lists + `(:slot-name-lists ,slot-name-lists)) + ,@(when call-list + `(:call-list ,call-list)) + :pv-table-symbol ,pv-table-symbol + ,@plist)) + (setq walked-lambda-body + `((pv-binding (,required-parameters ,slot-name-lists + ,pv-table-symbol) + ,@walked-lambda-body)))))) + (when (and (memq '&key lambda-list) + (not (memq '&allow-other-keys lambda-list))) + (let ((aux (memq '&aux lambda-list))) + (setq lambda-list (nconc (ldiff lambda-list aux) + (list '&allow-other-keys) + aux)))) + (values `(lambda (.method-args. .next-methods.) + (simple-lexical-method-functions + (,lambda-list .method-args. .next-methods. + :call-next-method-p ,call-next-method-p + :next-method-p-p ,next-method-p-p + :closurep ,closurep + :applyp ,applyp) + ,@walked-declarations + ,@walked-lambda-body)) + `(,@(when plist + `(:plist ,plist)) + ,@(when documentation + `(:documentation ,documentation))))))))))) + +(define-inline-function slot-value (instance slot-name) (form closure-p env) + :predicate (and (not closure-p) (constantp slot-name)) + :inline-arguments (required-parameters slots) + :inline (optimize-slot-value + slots + (can-optimize-access form required-parameters env) + form)) + +;collect information about: +; uses of the required-parameters +; uses of call-next-method and next-method-p: +; called-p +; apply-p +; arglist info +;optimize calls to slot-value, set-slot-value, slot-boundp +;optimize calls to find-class +;optimize generic-function calls +(defun make-walk-function (required-parameters info slots calls) + #'(lambda (form context env) + (cond ((not (eq context ':eval)) form) + ((not (listp form)) form) + ((eq (car form) 'call-next-method) + (setq call-next-method-p 't) + form) + ((eq (car form) 'next-method-p) + (setq next-method-p-p 't) + form) + ((and (eq (car form) 'function) + (cond ((eq (cadr form) 'call-next-method) + (setq call-next-method-p 't) + (setq closurep t) + form) + ((eq (cadr form) 'next-method-p) + (setq next-method-p-p 't) + (setq closurep t) + form) + (t nil)))) + ((and (or (eq (car form) 'slot-value) + (eq (car form) 'set-slot-value) + (eq (car form) 'slot-boundp)) + (constantp (caddr form))) + (let ((parameter + (can-optimize-access form + required-parameters env))) + (ecase (car form) + (slot-value + (optimize-slot-value slots parameter form)) + (set-slot-value + (optimize-set-slot-value slots parameter form)) + (slot-boundp + (optimize-slot-boundp slots parameter form))))) + ((and (or (symbolp (car form)) + (and (consp (car form)) + (eq (caar form) 'setf))) + (gboundp (car form)) + (if (eq *boot-state* 'complete) + (standard-generic-function-p (gdefinition (car form))) + (funcallable-instance-p (gdefinition (car form))))) + (optimize-generic-function-call + form required-parameters env slots calls)) + (t form)))) + +(defun walk-method-lambda (method-lambda required-parameters env slots calls) + (let* ((call-next-method-p nil) ;flag indicating that call-next-method + ;should be in the method definition + (closurep nil) ;flag indicating that #'call-next-method + ;was seen in the body of a method + (next-method-p-p nil) ;flag indicating that next-method-p + ;should be in the method definition + (walk-functions `((call-next-method-p + ,#'(lambda (form closure-p env) + (setq call-next-method-p 't) + (when closure-p + (setq closurep t)) + form)) + (next-method-p + ,#'(lambda (form closure-p env) + (setq next-method-p-p 't) + (when closure-p + (setq closurep t)) + form)) + ((slot-value set-slot-value slot-boundp) + ,#'(lambda (form closure-p env) + (if (and (not closure-p) + (constantp (caddr form))) + + (let ((walked-lambda (walk-form method-lambda env + (make-walk-function + `((call-next-method-p + ,#'(lambda (form closure-p env) + (setq call-next-method-p 't) + (when closure-p + (setq closurep t)) + form)) + (next-method-p + ,#'(lambda (form closure-p env) + (setq next-method-p-p 't) + (when closure-p + (setq closurep t)) + form)) + ((slot-value set-slot-value slot-boundp) + ,#'(lambda (form closure-p env) + ( + (values walked-lambda + call-next-method-p closurep next-method-p-p))))) + +(defun initialize-method-function (initargs &optional return-function-p method) + (let* ((mf (getf initargs ':function)) + (method-spec (getf initargs ':method-spec)) + (plist (getf initargs ':plist)) + (pv-table-symbol (getf plist ':pv-table-symbol)) + (pv-table nil) + (mff (getf initargs ':fast-function))) + (flet ((set-mf-property (p v) + (when mf + (setf (method-function-get mf p) v)) + (when mff + (setf (method-function-get mff p) v)))) + (when method-spec + (when mf + (setq mf (set-function-name mf method-spec))) + (when mff + (let ((name `(,(or (get (car method-spec) 'fast-sym) + (setf (get (car method-spec) 'fast-sym) + (intern (format nil "FAST-~A" + (car method-spec)) + *the-pcl-package*))) + ,@(cdr method-spec)))) + (set-function-name mff name) + (unless mf + (set-mf-property :name name))))) + (when plist + (let ((snl (getf plist :slot-name-lists)) + (cl (getf plist :call-list))) + (when (or snl cl) + (setq pv-table (intern-pv-table :slot-name-lists snl + :call-list cl)) + (when pv-table (set pv-table-symbol pv-table)) + (set-mf-property :pv-table pv-table))) + (loop (when (null plist) (return nil)) + (set-mf-property (pop plist) (pop plist))) + (when method + (set-mf-property :method method)) + (when return-function-p + (or mf (method-function-from-fast-function mff))))))) + + + diff --git a/pcl/extensions/user-instances.lisp b/pcl/extensions/user-instances.lisp new file mode 100644 index 0000000..1600efc --- /dev/null +++ b/pcl/extensions/user-instances.lisp @@ -0,0 +1,684 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp; -*- + +;;; +;;; ************************************************************************* +;;; +;;; File: user-instances.lisp. +;;; +;;; by Trent E. Lange, Effective Date 06-02-92 +;;; +;;; +;;; This file contains a metaclass (User-Vector-Class) whose instances +;;; are stored as simple-vectors, saving space over PCL's standard instance +;;; representations of PCL at the cost of some class redefinition flexibiliity. +;;; +;;; Permission is granted to any individual or institution to use, copy, +;;; modify and distribute this document. +;;; +;;; Suggestions, bugs, criticism and questions to lange@cs.ucla.edu +;;; ************************************************************************* +;;; + +(in-package 'pcl) + +;;; This file builds on the PCL-USER-INSTANCES feature of July 92 PCL +;;; to define the USER-VECTOR-CLASS metaclass whose instances are simple +;;; vectors. The first element of the instance vector is the instance's +;;; class wrapper (providing internal PCL information about the instance's +;;; class). The remaining elements of the instance vector are the instance's +;;; slots themselves. +;;; +;;; The space overhead of user-vector-instances is only two vector cells +;;; (one for the vector, one for the wrapper). This is contrast to standard +;;; PCL instances, which have a total overhead of four cells. (Standard +;;; instances in PCL are represented as instances of structure STD-INSTANCE +;;; having two slots, one for the wrapper and one holding a simple-vector +;;; which is the instance's slots). This two-cell space savings per instance +;;; comes at the cost of losing some class redefinition flexibility, since +;;; simple-vectors cannot have their sizes changed dynamically. +;;; All current instances of user-instance-vectors therefore become +;;; permanently obsolete if the classes' instance slots change. +;;; +;;; This code requires July 92 PCL or later compiled with the +;;; PCL-USER-INSTANCES feature turned on (see PCL's low.lisp file). +;;; + +#-pcl-user-instances +(eval-when (compile load eval) +(error "Cannot use user-instances, since PCL was compiled without + PCL-USER-INSTANCES on the *features* list (see pcl file low.lisp.)") +) + +(eval-when (compile load eval) +(defclass user-vector-class-mixin () () + (:documentation + "Use this mixin for metaclasses whose instances are USER-INSTANCES + instantiated as simple-vectors. This saves space over the standard + instances used by standard-class, at the cost of losing the ability to + redefine the slots in a class and still have old instances updated correctly.")) + +(defclass user-vector-class (user-vector-class-mixin standard-class) () + (:documentation + "A metaclass whose instances are USER-INSTANCES instantiated as simple-vectors. + This saves space over the standard instances used by standard-class, at the + cost of losing the ability to redefine the slots in a class and still have old + instances updated correctly.")) + +(defmethod validate-superclass ((class user-vector-class-mixin) + (new-super T)) + (or (typep new-super 'user-vector-class-mixin) + (eq new-super (find-class 'standard-object)))) + +(defclass user-vector-object (standard-object) () + (:metaclass user-vector-class)) +) + +;;; +;;; +;;; Instance allocation stuff. +;;; + +(defmacro user-vector-instance-p (object) + (once-only (object) + `(the boolean + (and (simple-vector-p ,object) + (plusp (length (the simple-vector ,object))) + (wrapper-p (%svref ,object 0)))))) + +(defmacro user-vector-instance-wrapper (object) + `(%svref ,object 0)) + +(defsetf user-vector-instance-wrapper (object) (new-value) + `(setf (%svref ,object 0) ,new-value)) + +(defmacro user-vector-instance-slots (instance) + ;; The slots vector of user-vector instances is the instance itself. + instance) + +(defmacro set-user-vector-instance-slots (instance new-value) + `(progn + (warn "Attempt to set user-vector-instance-slots of ~S to ~S" + ,instance ,new-value) + ,new-value)) + +(defun user-instance-p (x) + "Is X a user instance, specifically a user-vector-instance?" + (user-vector-instance-p x)) + +(defun user-instance-slots (x) + "Return the slots of this user-vector-instance." + (user-vector-instance-slots x)) + +(defun user-instance-wrapper (x) + "Return the wrapper of this user-vector-instance." + (user-vector-instance-wrapper x)) + +(defun set-user-instance-wrapper (x new) + (setf (user-vector-instance-wrapper x) new)) + +(defmacro get-user-instance-p (x) + `(user-vector-instance-p ,x)) + +(defmacro get-user-instance-wrapper (x) + `(user-vector-instance-wrapper ,x)) + +(defmacro get-user-instance-slots (x) + `(user-vector-instance-slots ,x)) + +(eval-when (eval #+cmu load) + (force-compile 'user-instance-p) + (force-compile 'user-instance-slots) + (force-compile 'user-instance-wrapper) + (force-compile 'set-user-instance-wrapper)) + + +;;; +;;; Methods needed for user-vector-class-mixin. +;;; + +(defconstant *not-a-slot* (gensym "NOT-A-SLOT")) + +(defmethod allocate-instance ((class user-vector-class-mixin) &rest initargs) + (declare (ignore initargs)) + (unless (class-finalized-p class) (finalize-inheritance class)) + (let* ((class-wrapper (class-wrapper class)) + (copy-instance (wrapper-allocate-static-slot-storage-copy + class-wrapper)) + (instance (copy-simple-vector copy-instance))) + (declare (type simple-vector copy-instance instance)) + (setf (user-vector-instance-wrapper instance) class-wrapper) + instance)) + +(defmethod make-instances-obsolete ((class user-vector-class-mixin)) + "The slots of user-vector-instances are stored in the instance vector + themselves (a simple-vector), so old instances cannot be updated properly." + (setf (slot-value class 'prototype) NIL) + (warn "Obsoleting user-vector class ~A, all current instances will be invalid..." + class)) + +(defmethod compute-layout :around ((class user-vector-class-mixin) + cpl instance-eslotds) + ;; First element of user-vector-instance is actually its wrapper. + (declare (ignore cpl instance-eslotds)) + (cons *not-a-slot* (call-next-method))) + +(defmethod compute-instance-layout :around ((class user-vector-class-mixin) + instance-eslotds) + ;; First element of user-vector-instance is actually its wrapper. + (declare (ignore instance-eslotds)) + (cons *not-a-slot* (call-next-method))) + +(defmethod wrapper-fetcher ((class user-vector-class-mixin)) + 'user-vector-instance-wrapper) + +(defmethod slots-fetcher ((class user-vector-class-mixin)) + 'user-vector-instance-slots) + +(defmethod raw-instance-allocator ((class user-vector-class-mixin)) + 'allocate-user-vector-instance) + + +;;; +;;; The following functions and methods are not strictly necessary for +;;; user-vector-instances, but do speed things up a bit. +;;; + +;;; Inform PCL that it is still safe to use its standard slot-value +;;; optimizations with user-vector-class-mixin's slot-value-using-class +;;; methods: + +(pushnew + '(user-vector-class-mixin standard-object standard-effective-slot-definition) + *safe-slot-value-using-class-specializers*) + +(pushnew + '(T user-vector-class-mixin standard-object standard-effective-slot-definition) + *safe-set-slot-value-using-class-specializers*) + +(pushnew + '(user-vector-class-mixin standard-object standard-effective-slot-definition) + *safe-slot-boundp-using-class-specializers*) + +(defmethod slot-value-using-class + ((class user-vector-class-mixin) + (object standard-object) + (slotd standard-effective-slot-definition)) + (let* ((location (slot-definition-location slotd)) + (value + (typecase location + (fixnum + (%svref (user-vector-instance-slots object) location)) + (cons + (cdr location)) + (t + (error + "The slot ~s has neither :instance nor :class allocation, ~@ + so it can't be read by the default ~s method." + slotd 'slot-value-using-class))))) + (if (eq value *slot-unbound*) + (slot-unbound class object (slot-definition-name slotd)) + value))) + +(defmethod (setf slot-value-using-class) + (new-value (class user-vector-class-mixin) + (object standard-object) + (slotd standard-effective-slot-definition)) + (let ((location (slot-definition-location slotd))) + (typecase location + (fixnum + (setf (%svref (user-vector-instance-slots object) location) new-value)) + (cons + (setf (cdr location) new-value)) + (t + (error "The slot ~s has neither :instance nor :class allocation, ~@ + so it can't be written by the default ~s method." + slotd '(setf slot-value-using-class)))))) + +(defmethod slot-boundp-using-class + ((class user-vector-class-mixin) + (object standard-object) + (slotd standard-effective-slot-definition)) + (let* ((location (slot-definition-location slotd)) + (value + (typecase location + (fixnum + (%svref (user-vector-instance-slots object) location)) + (cons + (cdr location)) + (t + (error + "The slot ~s has neither :instance nor :class allocation, ~@ + so it can't be read by the default ~s method." + slotd 'slot-boundp-using-class))))) + (not (eq value *slot-unbound*)))) + + + +(defmethod make-optimized-reader-method-function + ((class user-vector-class-mixin) + generic-function + reader-method-prototype + slot-name) + (declare (ignore generic-function reader-method-prototype)) + (make-user-vector-instance-reader-method-function slot-name)) + +(defmethod make-optimized-writer-method-function + ((class user-vector-class-mixin) + generic-function + reader-method-prototype + slot-name) + (declare (ignore generic-function reader-method-prototype)) + (make-user-vector-instance-writer-method-function slot-name)) + +(defmethod make-optimized-method-function + ((class user-vector-class-mixin) + generic-function + boundp-method-prototype + slot-name) + (declare (ignore generic-function boundp-method-prototype)) + (make-user-vector-instance-boundp-method-function slot-name)) + +(defun make-user-vector-instance-reader-method-function (slot-name) + (declare #.*optimize-speed*) + #'(lambda (instance) + (user-instance-slot-value instance slot-name))) + +(defun make-user-vector-instance-writer-method-function (slot-name) + (declare #.*optimize-speed*) + #'(lambda (nv instance) + (setf (user-instance-slot-value instance slot-name) nv))) + +(defun make-user-vector-instance-boundp-method-function (slot-name) + (declare #.*optimize-speed*) + #'(lambda (instance) + (user-instance-slot-boundp instance slot-name))) + + +(defun make-optimized-user-reader-method-function (slot-name index) + (declare #.*optimize-speed*) + (progn slot-name) + #'(lambda (instance) + (let ((value (%svref (user-vector-instance-slots instance) index))) + (if (eq value *slot-unbound*) + (slot-unbound (class-of instance) instance slot-name) + value)))) + +(defun make-optimized-user-writer-method-function (index) + (declare #.*optimize-speed*) + #'(lambda (nv instance) + (setf (%svref (user-vector-instance-slots instance) index) nv))) + +(defun make-optimized-user-boundp-method-function (index) + (declare #.*optimize-speed*) + #'(lambda (instance) + (not (eq (%svref (user-vector-instance-slots instance) index) + *slot-unbound*)))) + + + +(defmacro with-user-instance-slots (slot-entries instance-form &body body) + "Optimized version of With-Slots that assumes that the instance-form + evaluates to a user-vector-instance. The result is undefined if it does not. + With-user-vector-instance-slots is faster than With-Slots because it factors + out functions common to all slot accesses on the instance. It has two + extensions to With-Slots: (1) the second value of slot-entries are + evaluated as forms rather than considered to be hard slot-names, allowing + access of variable slot-names. (2) if a :variable-instance keyword is + the first part of the body, then the instance-form is treated as a variable + form, which is always expected to return an instance of the same class. + The value of the keyword must be an instance that is the same class as + instance-form will always return." + (build-with-optimized-slots-form slot-entries instance-form body 'user-instance)) + + + +;;; +;;; Lisp and CLOS print compatability functions: +;;; +;;; This gets really ugly because most lisps don't use PRINT-OBJECT +;;; for the printed representation of their objects like they're supposed +;;; to. (And if the lisp did, it wouldn't be using PCL.). And since +;;; user-vector-instances are implemented as simple-vectors, the only +;;; way to get their printed representations to look right is to make +;;; PRINT-OBJECT object to work. +;;; We therefore have to patch the standard lisp printing functions. +;;; If all goes well, then everything is honky-dory. If it doesn't, then +;;; debugging can get pretty messy since we were screwing with the standard +;;; printing functions. Things should work, but if they don't, then calling +;;; RESTORE-LISP-PRINTERS will get things back to normal. + +(defvar *old-write* NIL) +(defvar *old-princ* NIL) +(defvar *old-prin1* NIL) +(defvar *old-print* NIL) + +;; Structure dummy-print-instance is a structure whose sole purpose +;; in life is to act as a placeholder to allow the print-object of +;; user-vector-class objects to be printed. + +(defstruct (dummy-print-instance + (:print-function print-dummy-print-instance)) + (print-object-string nil)) + +(declaim (type list *dummy-print-instance-garbage*)) +(defvar *dummy-print-instance-garbage* NIL) +(defconstant *dummy-print-instance-garbage-limit* 100) + +(defmacro pure-array-p (x &optional (test-user-vector-instance-p T)) + "Returns whether item is a 'pure' array -- i.e. not a string, and + not something holding a CLOS instance." + (once-only (x) + `(the boolean + (locally (declare (inline arrayp stringp typep)) + (and (arrayp ,x) + (not (stringp ,x)) + #-(or cmu (and lucid pcl)) + (not (typep ,x 'structure)) + ,@(when test-user-vector-instance-p + `((not (user-vector-instance-p ,x)))) + #-(or cmu (and lucid pcl)) + (not (typep ,x 'standard-object))))))) + +(defun copy-any-array (old-array &rest keys-passed &key key dimensions) + ;; Returns a copy of old-array. If :key is provided, then the + ;; elements of the new-array are the result of key applied to + ;; old-array's elements. If :dimensions is provided, and it is + ;; different than old-array's dimensions, then the new-array is created + ;; with those dimensions, and everything that can be copied from + ;; old-array is copied into it. It is an error if the rank of + ;; the array specified by dimensionss is different than that of the + ;; old-array. + (declare (type array old-array) + (type (or function null) key) + (type list dimensions keys-passed)) + (cond + ((simple-vector-p old-array) + (apply #'copy-array-contents + old-array + (make-array (the index + (if dimensions + (car dimensions) + (length (the simple-vector old-array))))) + keys-passed)) + ((vectorp old-array) + (apply #'copy-array-contents + old-array + (make-array (the index + (if dimensions + (car dimensions) + (length (the vector old-array)))) + :element-type (array-element-type old-array) + :adjustable (adjustable-array-p old-array)) + keys-passed)) + ((arrayp old-array) + (let* ((old-dimensions (array-dimensions old-array)) + (new-dimensions (or dimensions old-dimensions)) + (element-type (array-element-type old-array)) + (new-array + (make-array new-dimensions + :element-type element-type + :adjustable (adjustable-array-p old-array)))) + (declare (type list old-dimensions new-dimensions) + (type array new-array)) + (if (or (null dimensions) (equal new-dimensions old-dimensions)) + (let* ((displaced-old-array + (make-array (array-total-size old-array) + :element-type element-type + :displaced-to old-array)) + (displaced-new-array + (make-array (array-total-size new-array) + :element-type element-type + :displaced-to new-array))) + (declare (type array displaced-old-array displaced-new-array)) + (copy-array-contents displaced-old-array + displaced-new-array + :key key)) + (let ((first-dimension + (min (the index (car new-dimensions)) + (the index (car old-dimensions))))) + (declare (type index first-dimension)) + (walk-dimensions + (mapcar #'min (cdr new-dimensions) (cdr old-dimensions)) + #'(lambda (post-indices) + (copy-array-contents old-array new-array + :key key + :length first-dimension + :post-indices post-indices))))) + new-array)))) + +(defun copy-array-contents + (old-array new-array &key key length post-indices &allow-other-keys) + ;; Copies the contents of old-array into new-array, using key if + ;; supplied. Only the first :length items are copied (defaulting + ;; to the length of the old-array). If :post-indices are passed, then + ;; they are used as "post" indices to an aref. + (macrolet + ((do-copy (aref old new key key-type len post-indices) + (let ((atype (if (eq aref #'svref) 'simple-vector 'array))) + `(dotimes (i (the index ,len)) + (setf ,(if post-indices + `(apply #'aref (the ,atype ,new) i ,post-indices) + `(,aref (the ,atype ,new) i)) + ,(if key-type + `(funcall + (the ,key-type ,key) + ,(if post-indices + `(apply #'aref (the ,atype ,old) + i ,post-indices) + `(,aref (the ,atype ,old) i))) + (if post-indices + `(apply #'aref (the ,atype ,old) i ,post-indices) + `(,aref (the ,atype ,old) i))))))) + (expand-on-key (aref key old new len post-ind) + `(cond + ((null ,key) + (do-copy ,aref ,old ,new ,key NIL ,len ,post-ind)) + ((compiled-function-p ,key) + (do-copy ,aref ,old ,new ,key compiled-function ,len ,post-ind)) + (T + (do-copy ,aref ,old ,new ,key function ,len ,post-ind))))) + (if (simple-vector-p old-array) + (progn + (when post-indices + (error "Can't pass post-indices given to COPY-ARRAY-CONTENTS + from simple-vector")) + + (unless length + (setf length (min (length (the simple-vector old-array)) + (length (the simple-vector new-array))))) + (expand-on-key svref key old-array new-array length NIL)) + (progn + (unless length + (setf length (min (the index (car (array-dimensions old-array))) + (the index (car (array-dimensions new-array)))))) + (if post-indices + (expand-on-key #'aref key old-array new-array length post-indices) + (expand-on-key aref key old-array new-array length NIL))))) + new-array) + +(declaim (ftype (function (list function) T) walk-dimensions)) +(defun walk-dimensions (dimensions fn) + (declare (type list dimensions) + (type function fn)) + ;; Given a list of dimensions (e.g. '(3 2 8)), this function walks + ;; through every possible combination from 0 to 1- each of those + ;; dimensions, and calling fn on each of them. + (let ((compiled-p (compiled-function-p fn))) + (labels + ((doit (dims apply-dims) + (declare (type list dims apply-dims)) + (if (cdr dims) + (let ((last-dim NIL) + (dims-left NIL)) + (loop (when (null (cdr dims)) + (setf last-dim (car dims)) + (return)) + (if dims-left + (nconc dims-left (list (car dims))) + (setf dims-left (list (car dims)))) + (setf dims (cdr dims))) + (dotimes (i (the index last-dim)) + (doit dims-left (cons i apply-dims)))) + (if compiled-p + (dotimes (i (the index (car dims))) + (funcall (the compiled-function fn) (cons i apply-dims))) + (dotimes (i (the index (car dims))) + (funcall fn (cons i apply-dims))))))) + (doit dimensions NIL)))) + +(defmacro funcall-printer (applyer print-function object keys) + `(progn + (if (or (arrayp ,object) (consp ,object)) + (multiple-value-bind (converted-item garbage) + (convert-user-vector-instances-to-dummy-print-instances ,object) + (,applyer (the compiled-function ,print-function) + converted-item ,keys) + (deallocate-dummy-print-instances garbage)) + (,applyer (the compiled-function ,print-function) + ,object ,keys)) + ,object)) + +(defun print-dummy-print-instance (instance stream depth) + (declare (ignore depth)) + (let ((*print-pretty* NIL)) + (funcall (the compiled-function *old-princ*) + (dummy-print-instance-print-object-string instance) + stream))) + +(defun allocate-dummy-print-instance (print-object-string) + (if *dummy-print-instance-garbage* + (let ((instance (pop *dummy-print-instance-garbage*))) + (setf (dummy-print-instance-print-object-string instance) + print-object-string) + instance) + (make-dummy-print-instance :print-object-string print-object-string))) + +(defun dummy-print-instance-of (user-vector-instance) + (allocate-dummy-print-instance + (with-output-to-string (str) + (print-object user-vector-instance str)))) + +(defun deallocate-dummy-print-instances (dummies) + (let ((count (length *dummy-print-instance-garbage*))) + (declare (type index count)) + (dolist (dummy dummies) + (when (> count *dummy-print-instance-garbage-limit*) + (return)) + (push dummy *dummy-print-instance-garbage*) + (setf count (the index (1+ count)))))) + +(defun convert-user-vector-instances-to-dummy-print-instances (item) + (let ((print-length + (or *print-length* 1000)) + (print-level + (or *print-level* 1000)) + (dummy-print-instances-used NIL)) + (declare (fixnum print-length print-level)) + (labels + ((doit (item level length) + (declare (fixnum level length)) + (labels + ((user-vector-instance-visible-within-p (item level length) + (declare (fixnum level length)) + (cond + ((>= length print-length) NIL) + ((> level print-level) NIL) + ((= level print-level) (user-vector-instance-p item)) + (T (cond + ((user-vector-instance-p item) T) + ((consp item) + (or (user-vector-instance-visible-within-p + (car item) (the fixnum (1+ level)) 0) + (user-vector-instance-visible-within-p + (cdr item) level (the fixnum (1+ length))))) + ((and *print-array* (pure-array-p item)) + (let ((next-level (the fixnum (1+ level)))) + (declare (fixnum next-level)) + (dotimes (i (1- (length (the array item))) NIL) + (unless (< i print-length) + (return NIL)) + (if (user-vector-instance-visible-within-p + (aref item i) next-level 0) + (return T)))))))))) + ;; doit body + (cond + ((user-vector-instance-p item) + (let ((dummy (dummy-print-instance-of item))) + (push dummy dummy-print-instances-used) + dummy)) + ((consp item) + (if (user-vector-instance-visible-within-p item level length) + (cons (doit (car item) (the fixnum (1+ level)) length) + (doit (cdr item) level (the fixnum (1+ length)))) + item)) + ((and *print-array* (pure-array-p item NIL)) + (if (user-vector-instance-visible-within-p item level length) + (copy-any-array + item + :key + #'(lambda (item) + (if (user-vector-instance-p item) + (let ((dummy (dummy-print-instance-of item))) + (push dummy dummy-print-instances-used) + dummy) + item)) + :dimensions + (mapcar #'1+ (array-dimensions item))) + item)) + (T item))))) + + ;; convert-user-vector-instances-to-dummy-print-instances body + + (let ((converted (doit item 0 0))) + (values converted dummy-print-instances-used))))) + +(force-compile 'convert-user-vector-instances-to-dummy-print-instances) + +(unless *old-write* (setf *old-write* (symbol-function 'write))) +(defun new-write (object &rest keys-passed) + (declare (list keys-passed)) + (funcall-printer apply *old-write* object keys-passed)) +(force-compile 'write) +(setf (symbol-function 'write) (symbol-function 'new-write)) + +(unless *old-princ* (setf *old-princ* (symbol-function 'princ))) +(defun princ (object &optional stream) + (funcall-printer funcall *old-princ* object stream)) +(force-compile 'princ) + +(unless *old-prin1* (setf *old-prin1* (symbol-function 'prin1))) +(defun prin1 (object &optional stream) + (funcall-printer funcall *old-prin1* object stream)) +(force-compile 'prin1) + +(unless *old-print* (setf *old-print* (symbol-function 'print))) +(defun print (object &optional stream) + (funcall-printer funcall *old-print* object stream)) +(force-compile 'print) + +(defun new-write-to-string (object &rest keys-passed) + (declare (list keys-passed)) + (with-output-to-string (string-stream) + (apply #'write object :stream string-stream keys-passed))) +(force-compile 'write-to-string) +(setf (symbol-function 'write-to-string) + (symbol-function 'new-write-to-string)) + +(defun princ-to-string (object) + (with-output-to-string (string-stream) + (funcall-printer funcall *old-princ* object string-stream) + string-stream)) +(force-compile 'princ-to-string) + +(defun prin1-to-string (object) + (with-output-to-string (string-stream) + (funcall-printer funcall *old-prin1* object string-stream) + string-stream)) +(force-compile 'prin1-to-string) + +(defun restore-lisp-printers () + (setf (symbol-function 'write) *old-write*) + (setf (symbol-function 'princ) *old-princ*) + (setf (symbol-function 'prin1) *old-prin1*) + (setf (symbol-function 'print) *old-print*)) + diff --git a/pcl/gcl_pcl_boot.lisp b/pcl/gcl_pcl_boot.lisp new file mode 100644 index 0000000..d57bd4d --- /dev/null +++ b/pcl/gcl_pcl_boot.lisp @@ -0,0 +1,2195 @@ +;;;-*-Mode: LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +#| + +The CommonLoops evaluator is meta-circular. + +Most of the code in PCL is methods on generic functions, including most of +the code that actually implements generic functions and method lookup. + +So, we have a classic bootstrapping problem. The solution to this is to +first get a cheap implementation of generic functions running, these are +called early generic functions. These early generic functions and the +corresponding early methods and early method lookup are used to get enough +of the system running that it is possible to create real generic functions +and methods and implement real method lookup. At that point (done in the +file FIXUP) the function fix-early-generic-functions is called to convert +all the early generic functions to real generic functions. + +The cheap generic functions are built using the same funcallable-instance +objects real generic-functions are made out of. This means that as PCL +is being bootstrapped, the cheap generic function objects which are being +created are the same objects which will later be real generic functions. +This is good because: + - we don't cons garbage structure + - we can keep pointers to the cheap generic function objects + during booting because those pointers will still point to + the right object after the generic functions are all fixed + up + + + +This file defines the defmethod macro and the mechanism used to expand it. +This includes the mechanism for processing the body of a method. defmethod +basically expands into a call to load-defmethod, which basically calls +add-method to add the method to the generic-function. These expansions can +be loaded either during bootstrapping or when PCL is fully up and running. + +An important effect of this structure is it means we can compile files with +defmethod forms in them in a completely running PCL, but then load those files +back in during bootstrapping. This makes development easier. It also means +there is only one set of code for processing defmethod. Bootstrapping works +by being sure to have load-method be careful to call only primitives which +work during bootstrapping. + +|# + +(proclaim '(notinline make-a-method + add-named-method + ensure-generic-function-using-class + + add-method + remove-method + )) + +(defvar *early-functions* + '((make-a-method early-make-a-method + real-make-a-method) + (add-named-method early-add-named-method + real-add-named-method) + )) + +;;; +;;; For each of the early functions, arrange to have it point to its early +;;; definition. Do this in a way that makes sure that if we redefine one +;;; of the early definitions the redefinition will take effect. This makes +;;; development easier. +;;; +;;; The function which generates the redirection closure is pulled out into +;;; a separate piece of code because of a bug in ExCL which causes this not +;;; to work if it is inlined. +;;; +(eval-when (load eval) + +(defun redirect-early-function-internal (real early) + (setf (gdefinition real) + (set-function-name + #'(lambda (&rest args) + (apply (the function (symbol-function early)) args)) + real))) + +(dolist (fns *early-functions*) + (let ((name (car fns)) + (early-name (cadr fns))) + (redirect-early-function-internal name early-name))) + +) + + +;;; +;;; *generic-function-fixups* is used by fix-early-generic-functions to +;;; convert the few functions in the bootstrap which are supposed to be +;;; generic functions but can't be early on. +;;; +(defvar *generic-function-fixups* + '((add-method + ((generic-function method) ;lambda-list + (standard-generic-function method) ;specializers + real-add-method)) ;method-function + (remove-method + ((generic-function method) + (standard-generic-function method) + real-remove-method)) + (get-method + ((generic-function qualifiers specializers &optional (errorp t)) + (standard-generic-function t t) + real-get-method)) + (ensure-generic-function-using-class + ((generic-function function-specifier + &key generic-function-class environment + &allow-other-keys) + (generic-function t) + real-ensure-gf-using-class--generic-function) + ((generic-function function-specifier + &key generic-function-class environment + &allow-other-keys) + (null t) + real-ensure-gf-using-class--null)) + (make-method-lambda + ((proto-generic-function proto-method lambda-expression environment) + (standard-generic-function standard-method t t) + real-make-method-lambda)) + (make-method-initargs-form + ((proto-generic-function proto-method lambda-expression lambda-list environment) + (standard-generic-function standard-method t t t) + real-make-method-initargs-form)) + (compute-effective-method + ((generic-function combin applicable-methods) + (generic-function standard-method-combination t) + standard-compute-effective-method)) + )) + + +;;; +;;; +;;; +(defmacro defgeneric (function-specifier lambda-list &body options) + (expand-defgeneric function-specifier lambda-list options)) + +(defun expand-defgeneric (function-specifier lambda-list options) + (when (listp function-specifier) (do-standard-defsetf-1 (cadr function-specifier))) + (let ((initargs ())) + (flet ((duplicate-option (name) + (error "The option ~S appears more than once." name))) + ;; + ;; INITARG takes this screwy new argument to get around a bad + ;; interaction between lexical macros and setf in the Lucid + ;; compiler. + ;; + (macrolet ((initarg (key &optional new) + (if new + `(setf (getf initargs ,key) ,new) + `(getf initargs ,key)))) + (dolist (option options) + (ecase (car option) + (:argument-precedence-order + (if (initarg :argument-precedence-order) + (duplicate-option :argument-precedence-order) + (initarg :argument-precedence-order `',(cdr option)))) + (declare + (initarg :declarations + (append (cdr option) (initarg :declarations)))) + (:documentation + (if (initarg :documentation) + (duplicate-option :documentation) + (initarg :documentation `',(cadr option)))) + (:method-combination + (if (initarg :method-combination) + (duplicate-option :method-combination) + (initarg :method-combination `',(cdr option)))) + (:generic-function-class + (if (initarg :generic-function-class) + (duplicate-option :generic-function-class) + (initarg :generic-function-class `',(cadr option)))) + (:method-class + (if (initarg :method-class) + (duplicate-option :method-class) + (initarg :method-class `',(cadr option)))) + (:method + (error + "DEFGENERIC doesn't support the :METHOD option yet.")))) + + (let ((declarations (initarg :declarations))) + (when declarations (initarg :declarations `',declarations))))) + `(progn + (proclaim-defgeneric ',function-specifier ',lambda-list) + ,(make-top-level-form `(defgeneric ,function-specifier) + *defgeneric-times* + `(load-defgeneric ',function-specifier ',lambda-list ,@initargs))))) + +(defun load-defgeneric (function-specifier lambda-list &rest initargs) + (when (listp function-specifier) (do-standard-defsetf-1 (cadr function-specifier))) + (apply #'ensure-generic-function + function-specifier + :lambda-list lambda-list + :definition-source `((defgeneric ,function-specifier) + ,(load-truename)) + initargs)) + + +;;; +;;; +;;; +(defmacro DEFMETHOD (&rest args &environment env) + #+(or (not :lucid) :lcl3.0) + (declare (arglist name + {method-qualifier}* + specialized-lambda-list + &body body)) + (multiple-value-bind (name qualifiers lambda-list body) + (parse-defmethod args) + (multiple-value-bind (proto-gf proto-method) + (prototypes-for-make-method-lambda name) + (expand-defmethod name proto-gf proto-method + qualifiers lambda-list body env)))) + +(defun prototypes-for-make-method-lambda (name) + (if (not (eq *boot-state* 'complete)) + (values nil nil) + (let ((gf? (and (gboundp name) + (gdefinition name)))) + (if (or (null gf?) + (not (generic-function-p gf?))) + (values (class-prototype (find-class 'standard-generic-function)) + (class-prototype (find-class 'standard-method))) + (values gf? + (class-prototype (or (generic-function-method-class gf?) + (find-class 'standard-method)))))))) + +;;; +;;; takes a name which is either a generic function name or a list specifying +;;; a setf generic function (like: (SETF )). Returns +;;; the prototype instance of the method-class for that generic function. +;;; +;;; If there is no generic function by that name, this returns the default +;;; value, the prototype instance of the class STANDARD-METHOD. This default +;;; value is also returned if the spec names an ordinary function or even a +;;; macro. In effect, this leaves the signalling of the appropriate error +;;; until load time. +;;; +;;; NOTE that during bootstrapping, this function is allowed to return NIL. +;;; +(defun method-prototype-for-gf (name) + (let ((gf? (and (gboundp name) + (gdefinition name)))) + (cond ((neq *boot-state* 'complete) nil) + ((or (null gf?) + (not (generic-function-p gf?))) ;Someone else MIGHT + ;error at load time. + (class-prototype (find-class 'standard-method))) + (t + (class-prototype (or (generic-function-method-class gf?) + (find-class 'standard-method))))))) + + +(defvar *optimize-asv-funcall-p* nil) +(defvar *asv-readers*) +(defvar *asv-writers*) +(defvar *asv-boundps*) + +(defun expand-defmethod (name proto-gf proto-method qualifiers lambda-list body env) + (when (listp name) (do-standard-defsetf-1 (cadr name))) + (let ((*make-instance-function-keys* nil) + (*optimize-asv-funcall-p* t) + (*asv-readers* nil) (*asv-writers* nil) (*asv-boundps* nil)) + (declare (special *make-instance-function-keys*)) + (multiple-value-bind (method-lambda unspecialized-lambda-list specializers) + (add-method-declarations name qualifiers lambda-list body env) + (multiple-value-bind (method-function-lambda initargs) + (make-method-lambda proto-gf proto-method method-lambda env) + (let ((initargs-form (make-method-initargs-form + proto-gf proto-method + method-function-lambda initargs env))) + `(progn + (proclaim-defgeneric ',name ',lambda-list) + ,@(when *make-instance-function-keys* + `((get-make-instance-functions ',*make-instance-function-keys*))) + ,@(when (or *asv-readers* *asv-writers* *asv-boundps*) + `((initialize-internal-slot-gfs* + ',*asv-readers* ',*asv-writers* ',*asv-boundps*))) + ,(make-defmethod-form name qualifiers specializers + unspecialized-lambda-list + (if proto-method + (class-name (class-of proto-method)) + 'standard-method) + initargs-form + (getf (getf initargs ':plist) + ':pv-table-symbol)))))))) + +(defun interned-symbol-p (x) + (and (symbolp x) (symbol-package x))) + +(defun make-defmethod-form (name qualifiers specializers + unspecialized-lambda-list method-class-name + initargs-form &optional pv-table-symbol) + (let (fn fn-lambda) + (if (and (interned-symbol-p (if (consp name) + (and (eq (car name) 'setf) (cadr name)) + name)) + (every #'interned-symbol-p qualifiers) + (every #'(lambda (s) + (if (consp s) + (and (eq (car s) 'eql) + (constantp (cadr s)) + (let ((sv (eval (cadr s)))) + (or (interned-symbol-p sv) + (integerp sv) + (and (characterp sv) + (standard-char-p sv))))) + (interned-symbol-p s))) + specializers) + (consp initargs-form) + (eq (car initargs-form) 'list*) + (memq (cadr initargs-form) '(:function :fast-function)) + (consp (setq fn (caddr initargs-form))) + (eq (car fn) 'function) + (consp (setq fn-lambda (cadr fn))) + (eq (car fn-lambda) 'lambda)) + (let* ((specls (mapcar #'(lambda (specl) + (if (consp specl) + `(,(car specl) ,(eval (cadr specl))) + specl)) + specializers)) + (mname `(,(if (eq (cadr initargs-form) ':function) + 'method 'fast-method) + ,name ,@qualifiers ,specls)) + (mname-sym (intern (let ((*print-pretty* nil)) + (format nil "~S" mname))))) + `(eval-when ,*defmethod-times* + (defun ,mname-sym ,(cadr fn-lambda) + ,@(cddr fn-lambda)) + ,(make-defmethod-form-internal + name qualifiers `',specls + unspecialized-lambda-list method-class-name + `(list* ,(cadr initargs-form) #',mname-sym ,@(cdddr initargs-form)) + pv-table-symbol))) + (make-top-level-form + `(defmethod ,name ,@qualifiers ,specializers) + *defmethod-times* + (make-defmethod-form-internal + name qualifiers + `(list ,@(mapcar #'(lambda (specializer) + (if (consp specializer) + ``(,',(car specializer) ,,(cadr specializer)) + `',specializer)) + specializers)) + unspecialized-lambda-list method-class-name + initargs-form + pv-table-symbol))))) + +(defun make-defmethod-form-internal (name qualifiers specializers-form + unspecialized-lambda-list method-class-name + initargs-form &optional pv-table-symbol) + `(load-defmethod + ',method-class-name + ',name + ',qualifiers + ,specializers-form + ',unspecialized-lambda-list + ,initargs-form + ;;Paper over a bug in KCL by passing the cache-symbol + ;;here in addition to in the list. + ',pv-table-symbol)) + +(defmacro make-method-function (method-lambda &environment env) + (make-method-function-internal method-lambda env)) + +(defun make-method-function-internal (method-lambda &optional env) + (multiple-value-bind (proto-gf proto-method) + (prototypes-for-make-method-lambda nil) + (multiple-value-bind (method-function-lambda initargs) + (make-method-lambda proto-gf proto-method method-lambda env) + (make-method-initargs-form proto-gf proto-method + method-function-lambda initargs env)))) + +(defun add-method-declarations (name qualifiers lambda-list body env) + (multiple-value-bind (parameters unspecialized-lambda-list specializers) + (parse-specialized-lambda-list lambda-list) + (declare (ignore parameters)) + (multiple-value-bind (documentation declarations real-body) + (extract-declarations body env) + (values `(lambda ,unspecialized-lambda-list + ,@(when documentation `(,documentation)) + (declare (method-name ,(list name qualifiers specializers))) + (declare (method-lambda-list ,@lambda-list)) + ,@declarations + ,@real-body) + unspecialized-lambda-list specializers)))) + +(defun real-make-method-initargs-form (proto-gf proto-method + method-lambda initargs env) + (declare (ignore proto-gf proto-method)) + (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) + (error "The method-lambda argument to make-method-function, ~S,~ + is not a lambda form" method-lambda)) + (make-method-initargs-form-internal method-lambda initargs env)) + +(unless (fboundp 'make-method-initargs-form) + (setf (gdefinition 'make-method-initargs-form) + (symbol-function 'real-make-method-initargs-form))) + +(defun real-make-method-lambda (proto-gf proto-method method-lambda env) + (declare (ignore proto-gf proto-method)) + (make-method-lambda-internal method-lambda env)) + +(defun make-method-lambda-internal (method-lambda &optional env) + (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) + (error "The method-lambda argument to make-method-lambda, ~S,~ + is not a lambda form" method-lambda)) + (multiple-value-bind (documentation declarations real-body) + (extract-declarations (cddr method-lambda) env) + (let* ((name-decl (get-declaration 'method-name declarations)) + (sll-decl (get-declaration 'method-lambda-list declarations)) + (method-name (when (consp name-decl) (car name-decl))) + (generic-function-name (when method-name (car method-name))) + (specialized-lambda-list (or sll-decl (cadr method-lambda)))) + (multiple-value-bind (parameters lambda-list specializers) + (parse-specialized-lambda-list specialized-lambda-list) + (let* ((required-parameters + (mapcar #'(lambda (r s) (declare (ignore s)) r) + parameters + specializers)) + (slots (mapcar #'list required-parameters)) + (calls (list nil)) + (parameters-to-reference + (make-parameter-references specialized-lambda-list + required-parameters + declarations + method-name + specializers)) + (class-declarations + `(declare + ,@(remove nil + (mapcar #'(lambda (a s) (and (symbolp s) + (neq s 't) + `(class ,a ,s))) + parameters + specializers)))) + (method-lambda + ;; Remove the documentation string and insert the + ;; appropriate class declarations. The documentation + ;; string is removed to make it easy for us to insert + ;; new declarations later, they will just go after the + ;; cadr of the method lambda. The class declarations + ;; are inserted to communicate the class of the method's + ;; arguments to the code walk. + `(lambda ,lambda-list + ,class-declarations + ,@declarations + (progn ,@parameters-to-reference) + (block ,(if (listp generic-function-name) + (cadr generic-function-name) + generic-function-name) + ,@real-body))) + (constant-value-p (and (null (cdr real-body)) + (constantp (car real-body)))) + (constant-value (and constant-value-p + (eval (car real-body)))) + (plist (if (and constant-value-p + (or (typep constant-value '(or number character)) + (and (symbolp constant-value) + (symbol-package constant-value)))) + (list :constant-value constant-value) + ())) + (applyp (dolist (p lambda-list nil) + (cond ((memq p '(&optional &rest &key)) + (return t)) + ((eq p '&aux) + (return nil)))))) + (multiple-value-bind (walked-lambda call-next-method-p closurep + next-method-p-p) + (walk-method-lambda method-lambda required-parameters env + slots calls) + (multiple-value-bind (ignore walked-declarations walked-lambda-body) + (extract-declarations (cddr walked-lambda)) + (declare (ignore ignore)) + (when (or next-method-p-p call-next-method-p) + (setq plist (list* :needs-next-methods-p 't plist))) + (when (some #'cdr slots) + (multiple-value-bind (slot-name-lists call-list) + (slot-name-lists-from-slots slots calls) + (let ((pv-table-symbol (make-symbol "pv-table"))) + (setq plist + `(,@(when slot-name-lists + `(:slot-name-lists ,slot-name-lists)) + ,@(when call-list + `(:call-list ,call-list)) + :pv-table-symbol ,pv-table-symbol + ,@plist)) + (setq walked-lambda-body + `((pv-binding (,required-parameters ,slot-name-lists + ,pv-table-symbol) + ,@walked-lambda-body)))))) + (when (and (memq '&key lambda-list) + (not (memq '&allow-other-keys lambda-list))) + (let ((aux (memq '&aux lambda-list))) + (setq lambda-list (nconc (ldiff lambda-list aux) + (list '&allow-other-keys) + aux)))) + (values `(lambda (.method-args. .next-methods.) + (simple-lexical-method-functions + (,lambda-list .method-args. .next-methods. + :call-next-method-p ,call-next-method-p + :next-method-p-p ,next-method-p-p + :closurep ,closurep + :applyp ,applyp) + ,@walked-declarations + ,@walked-lambda-body)) + `(,@(when plist + `(:plist ,plist)) + ,@(when documentation + `(:documentation ,documentation))))))))))) + +(unless (fboundp 'make-method-lambda) + (setf (gdefinition 'make-method-lambda) + (symbol-function 'real-make-method-lambda))) + +(defmacro simple-lexical-method-functions ((lambda-list method-args next-methods + &rest lmf-options) + &body body) + `(progn + ,method-args ,next-methods + (bind-simple-lexical-method-macros (,method-args ,next-methods) + (bind-lexical-method-functions (,@lmf-options) + (bind-args (,lambda-list ,method-args) + ,@body))))) + +(defmacro fast-lexical-method-functions ((lambda-list next-method-call args rest-arg + &rest lmf-options) + &body body) + `(bind-fast-lexical-method-macros (,args ,rest-arg ,next-method-call) + (bind-lexical-method-functions (,@lmf-options) + (bind-args (,(nthcdr (length args) lambda-list) ,rest-arg) + ,@body)))) + +(defmacro bind-simple-lexical-method-macros ((method-args next-methods) &body body) + `(macrolet ((call-next-method-bind (&body body) + `(let ((.next-method. (car ,',next-methods)) + (,',next-methods (cdr ,',next-methods))) + .next-method. ,',next-methods + ,@body)) + (call-next-method-body (cnm-args) + `(if .next-method. + (funcall (the function + (if (std-instance-p .next-method.) + (method-function .next-method.) + .next-method.)) ; for early methods + (or ,cnm-args ,',method-args) + ,',next-methods) + (error "No next method."))) + (next-method-p-body () + `(not (null .next-method.)))) + ,@body)) + +(defstruct method-call + (function #'identity :type function) + call-method-args) + +#+cmu +(declaim (ext:freeze-type method-call)) + +(defmacro invoke-method-call1 (function args cm-args) + `(let ((.function. ,function) + (.args. ,args) + (.cm-args. ,cm-args)) + (declare (type function .function.)) + (if (and .cm-args. (null (cdr .cm-args.))) + (funcall .function. .args. (car .cm-args.)) + (apply .function. .args. .cm-args.)))) + +(defmacro invoke-method-call (method-call restp &rest required-args+rest-arg) + `(invoke-method-call1 (method-call-function ,method-call) + ,(if restp + `(list* ,@required-args+rest-arg) + `(list ,@required-args+rest-arg)) + (method-call-call-method-args ,method-call))) + +(defstruct fast-method-call + (function #'identity :type function) + pv-cell + next-method-call + arg-info) + +#+cmu +(declaim (ext:freeze-type fast-method-call)) + +#-akcl +(defmacro fmc-funcall (fn pv-cell next-method-call &rest args) + `(funcall (the function ,fn) ,pv-cell ,next-method-call ,@args)) + +(defmacro invoke-fast-method-call (method-call &rest required-args+rest-arg) + `(fmc-funcall (fast-method-call-function ,method-call) + (fast-method-call-pv-cell ,method-call) + (fast-method-call-next-method-call ,method-call) + ,@required-args+rest-arg)) + +(defstruct fast-instance-boundp + (index 0 :type fixnum)) + +#+cmu +(declaim (ext:freeze-type fast-instance-boundp)) + +(eval-when (compile load eval) +(defvar *allow-emf-call-tracing-p* nil) +(defvar *enable-emf-call-tracing-p* #-testing nil #+testing t) +) + +(defvar *emf-call-trace-size* 200) +(defvar *emf-call-trace* nil) +(defvar emf-call-trace-index 0) + +(defun show-emf-call-trace () + (when *emf-call-trace* + (let ((j emf-call-trace-index) + (*enable-emf-call-tracing-p* nil)) + (format t "~&(The oldest entries are printed first)~%") + (dotimes (i *emf-call-trace-size*) + (let ((ct (aref *emf-call-trace* j))) + (when ct (print ct))) + (incf j) + (when (= j *emf-call-trace-size*) + (setq j 0)))))) + +(defun trace-emf-call-internal (emf format args) + (unless *emf-call-trace* + (setq *emf-call-trace* (make-array *emf-call-trace-size*))) + (setf (aref *emf-call-trace* emf-call-trace-index) + (list* emf format args)) + (incf emf-call-trace-index) + (when (= emf-call-trace-index *emf-call-trace-size*) + (setq emf-call-trace-index 0))) + +(defmacro trace-emf-call (emf format args) + (when *allow-emf-call-tracing-p* + `(when *enable-emf-call-tracing-p* + (trace-emf-call-internal ,emf ,format ,args)))) + +(defmacro invoke-effective-method-function-fast + (emf restp &rest required-args+rest-arg) + `(progn + (trace-emf-call ,emf ,restp (list ,@required-args+rest-arg)) + (invoke-fast-method-call ,emf ,@required-args+rest-arg))) + +(defmacro invoke-effective-method-function (emf restp &rest required-args+rest-arg) + (unless (constantp restp) + (error "The restp argument to invoke-effective-method-function is not constant")) + (setq restp (eval restp)) + `(progn + (trace-emf-call ,emf ,restp (list ,@required-args+rest-arg)) + (cond (#-(or lucid excl) (typep ,emf 'fast-method-call) + #+(or lucid excl) (fast-method-call-p ,emf) + (invoke-fast-method-call ,emf ,@required-args+rest-arg)) + ,@(when (and (null restp) (= 1 (length required-args+rest-arg))) + `(((typep ,emf 'fixnum) + (let* ((.slots. (get-slots-or-nil + ,(car required-args+rest-arg))) + (value (when .slots. (%instance-ref .slots. ,emf)))) + (if (eq value ',*slot-unbound*) + (slot-unbound-internal ,(car required-args+rest-arg) + ,emf) + value))))) + ,@(when (and (null restp) (= 2 (length required-args+rest-arg))) + `(((typep ,emf 'fixnum) + (let ((.new-value. ,(car required-args+rest-arg)) + (.slots. (get-slots-or-nil + ,(car required-args+rest-arg)))) + (when .slots. ; just to avoid compiler wranings + (setf (%instance-ref .slots. ,emf) .new-value.)))))) + #|| + ,@(when (and (null restp) (= 1 (length required-args+rest-arg))) + `(((typep ,emf 'fast-instance-boundp) + (let ((.slots. (get-slots-or-nil + ,(car required-args+rest-arg)))) + (and .slots. + (not (eq (%instance-ref + .slots. (fast-instance-boundp-index ,emf)) + ',*slot-unbound*))))))) + ||# + (t + (etypecase ,emf + (method-call + (invoke-method-call ,emf ,restp ,@required-args+rest-arg)) + (function + ,(if restp + `(apply (the function ,emf) ,@required-args+rest-arg) + `(funcall (the function ,emf) + ,@required-args+rest-arg)))))))) + +(defun invoke-emf (emf args) + (trace-emf-call emf t args) + (etypecase emf + (fast-method-call + (let* ((arg-info (fast-method-call-arg-info emf)) + (restp (cdr arg-info)) + (nreq (car arg-info))) + (if restp + (let* ((rest-args (nthcdr nreq args)) + (req-args (ldiff args rest-args))) + (apply (the function (fast-method-call-function emf)) + (fast-method-call-pv-cell emf) + (fast-method-call-next-method-call emf) + (nconc req-args (list rest-args)))) + (cond ((null args) + (if (eql nreq 0) + (invoke-fast-method-call emf) + (error "wrong number of args"))) + ((null (cdr args)) + (if (eql nreq 1) + (invoke-fast-method-call emf (car args)) + (error "wrong number of args"))) + ((null (cddr args)) + (if (eql nreq 2) + (invoke-fast-method-call emf (car args) (cadr args)) + (error "wrong number of args"))) + (t + (apply (the function (fast-method-call-function emf)) + (fast-method-call-pv-cell emf) + (fast-method-call-next-method-call emf) + args)))))) + (method-call + (apply (the function (method-call-function emf)) + args + (method-call-call-method-args emf))) + (fixnum + (cond ((null args) (error "1 or 2 args expected")) + ((null (cdr args)) + (let ((value (%instance-ref (get-slots (car args)) emf))) + (if (eq value *slot-unbound*) + (slot-unbound-internal (car args) emf) + value))) + ((null (cddr args)) + (setf (%instance-ref (get-slots (cadr args)) emf) + (car args))) + (t (error "1 or 2 args expected")))) + (fast-instance-boundp + (if (or (null args) (cdr args)) + (error "1 arg expected") + (not (eq (%instance-ref (get-slots (car args)) + (fast-instance-boundp-index emf)) + *slot-unbound*)))) + (function + (apply (the function emf) args)))) + +;; This can be improved alot. +(defun gf-make-function-from-emf (gf emf) + (etypecase emf + (fast-method-call (let* ((arg-info (gf-arg-info gf)) + (nreq (arg-info-number-required arg-info)) + (restp (arg-info-applyp arg-info))) + #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) + (trace-emf-call emf t args) + (apply (fast-method-call-function emf) + (fast-method-call-pv-cell emf) + (fast-method-call-next-method-call emf) + (if restp + (let* ((rest-args (nthcdr nreq args)) + (req-args (ldiff args rest-args))) + (nconc req-args rest-args)) + args))))) + (method-call #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) + (trace-emf-call emf t args) + (apply (method-call-function emf) + args + (method-call-call-method-args emf)))) + (function emf))) + +(defmacro bind-fast-lexical-method-macros ((args rest-arg next-method-call) + &body body) + `(macrolet ((call-next-method-bind (&body body) + `(let () ,@body)) + (call-next-method-body (cnm-args) + `(if ,',next-method-call + ,(if (and (null ',rest-arg) + (consp cnm-args) + (eq (car cnm-args) 'list)) + `(invoke-effective-method-function + ,',next-method-call nil + ,@(cdr cnm-args)) + (let ((call `(invoke-effective-method-function + ,',next-method-call + ,',(not (null rest-arg)) + ,@',args + ,@',(when rest-arg `(,rest-arg))))) + `(if ,cnm-args + (bind-args ((,@',args ,@',(when rest-arg + `(&rest ,rest-arg))) + ,cnm-args) + ,call) + ,call))) + (error "No next method."))) + (next-method-p-body () + `(not (null ,',next-method-call)))) + ,@body)) + +(defmacro bind-lexical-method-functions + ((&key call-next-method-p next-method-p-p closurep applyp) + &body body) + (cond ((and (null call-next-method-p) (null next-method-p-p) + (null closurep) + (null applyp)) + `(let () ,@body)) + ((and (null closurep) + (null applyp)) + ;; OK to use MACROLET, and all args are mandatory + ;; (else APPLYP would be true). + `(call-next-method-bind + (macrolet ((call-next-method (&rest cnm-args) + `(call-next-method-body ,(when cnm-args `(list ,@cnm-args)))) + (next-method-p () + `(next-method-p-body))) + ,@body))) + (t + `(call-next-method-bind + (flet (,@(and call-next-method-p + '((call-next-method (&rest cnm-args) + #+Genera + (declare (dbg:invisible-frame :clos-internal)) + #+copy-&rest-arg (setq args (copy-list args)) + (call-next-method-body cnm-args)))) + ,@(and next-method-p-p + '((next-method-p () + (next-method-p-body))))) + ,@body))))) + +(defmacro bind-args ((lambda-list args) &body body) + #|| ; Lucid and Allegro don't compile the function inline + `(apply #'(lambda ,lambda-list ,@body) ,args) + ||# + (let ((args-tail '.args-tail.) + (key '.key.) + (state 'required)) + (flet ((process-var (var) + (if (memq var lambda-list-keywords) + (progn + (case var + (&optional (setq state 'optional)) + (&key (setq state 'key)) + (&allow-other-keys) + (&rest (setq state 'rest)) + (&aux (setq state 'aux)) + (otherwise + (error "Encountered the non-standard lambda list keyword ~S." + var))) + nil) + (case state + (required `((,var (pop ,args-tail)))) + (optional (cond ((not (consp var)) + `((,var (when ,args-tail (pop ,args-tail))))) + ((null (cddr var)) + `((,(car var) (if ,args-tail + (pop ,args-tail) + ,(cadr var))))) + (t + `((,(caddr var) ,args-tail) + (,(car var) (if ,args-tail + (pop ,args-tail) + ,(cadr var))))))) + (rest `((,var ,args-tail))) + (key (cond ((not (consp var)) + `((,var (get-key-arg ,(make-keyword var) + ,args-tail)))) + ((null (cddr var)) + (multiple-value-bind (keyword variable) + (if (consp (car var)) + (values (caar var) (cadar var)) + (values (make-keyword (car var)) (car var))) + `((,key (get-key-arg1 ,keyword ,args-tail)) + (,variable (if (consp ,key) + (car ,key) + ,(cadr var)))))) + (t + (multiple-value-bind (keyword variable) + (if (consp (car var)) + (values (caar var) (cadar var)) + (values (make-keyword (car var)) (car var))) + `((,key (get-key-arg1 ,keyword ,args-tail)) + (,(caddr var) ,key) + (,variable (if (consp ,key) + (car ,key) + ,(cadr var)))))))) + (aux `(,var)))))) + (let ((bindings (mapcan #'process-var lambda-list))) + `(let* ((,args-tail ,args) + ,@bindings) + ,@(unless bindings `((declare (ignore ,args-tail)))) + ,@body))))) + +(defun get-key-arg (keyword list) + (loop (when (atom list) (return nil)) + (when (eq (car list) keyword) (return (cadr list))) + (setq list (cddr list)))) + +(defun get-key-arg1 (keyword list) + (loop (when (atom list) (return nil)) + (when (eq (car list) keyword) (return (cdr list))) + (setq list (cddr list)))) + +(defun walk-method-lambda (method-lambda required-parameters env slots calls) + (let ((call-next-method-p nil) ;flag indicating that call-next-method + ;should be in the method definition + (closurep nil) ;flag indicating that #'call-next-method + ;was seen in the body of a method + (next-method-p-p nil)) ;flag indicating that next-method-p + ;should be in the method definition + (flet ((walk-function (form context env) + (cond ((not (eq context ':eval)) form) + ((not (listp form)) form) + ((eq (car form) 'call-next-method) + (setq call-next-method-p 't) + form) + ((eq (car form) 'next-method-p) + (setq next-method-p-p 't) + form) + ((and (eq (car form) 'function) + (cond ((eq (cadr form) 'call-next-method) + (setq call-next-method-p 't) + (setq closurep t) + form) + ((eq (cadr form) 'next-method-p) + (setq next-method-p-p 't) + (setq closurep t) + form) + (t nil)))) + ((and (or (eq (car form) 'slot-value) + (eq (car form) 'set-slot-value) + (eq (car form) 'slot-boundp)) + (constantp (caddr form))) + (let ((parameter + (can-optimize-access form + required-parameters env))) + (ecase (car form) + (slot-value + (optimize-slot-value slots parameter form)) + (set-slot-value + (optimize-set-slot-value slots parameter form)) + (slot-boundp + (optimize-slot-boundp slots parameter form))))) + ((and (eq (car form) 'apply) + (consp (cadr form)) + (eq (car (cadr form)) 'function) + (generic-function-name-p (cadr (cadr form)))) + (optimize-generic-function-call + form required-parameters env slots calls)) + ((and (or (symbolp (car form)) + (and (consp (car form)) + (eq (caar form) 'setf))) + (generic-function-name-p (car form))) + (optimize-generic-function-call + form required-parameters env slots calls)) + ((and (eq (car form) 'asv-funcall) + *optimize-asv-funcall-p*) + (case (fourth form) + (reader (push (third form) *asv-readers*)) + (writer (push (third form) *asv-writers*)) + (boundp (push (third form) *asv-boundps*))) + `(,(second form) ,@(cddddr form))) + (t form)))) + + (let ((walked-lambda (walk-form method-lambda env #'walk-function))) + (values walked-lambda + call-next-method-p closurep next-method-p-p))))) + +(defun generic-function-name-p (name) + (and (or (symbolp name) + (and (consp name) + (eq (car name) 'setf) + (consp (cdr name)) + (symbolp (cadr name)) + (null (cddr name)))) + (gboundp name) + (if (eq *boot-state* 'complete) + (standard-generic-function-p (gdefinition name)) + (funcallable-instance-p (gdefinition name))))) + +(defun make-parameter-references (specialized-lambda-list + required-parameters + declarations + method-name + specializers) + (flet ((ignoredp (symbol) + (dolist (decl (cdar declarations)) + (when (and (eq (car decl) 'ignore) + (memq symbol (cdr decl))) + (return t))))) + (gathering ((references (collecting))) + (iterate ((s (list-elements specialized-lambda-list)) + (p (list-elements required-parameters))) + (progn p) + (cond ((not (listp s))) + ((ignoredp (car s)) + (warn "In defmethod ~S, there is a~%~ + redundant ignore declaration for the parameter ~S." + method-name + specializers + (car s))) + (t + (gather (car s) references))))))) + + +(defvar *method-function-plist* (make-hash-table :test #'eq)) +(defvar *mf1* nil) (defvar *mf1p* nil) (defvar *mf1cp* nil) +(defvar *mf2* nil) (defvar *mf2p* nil) (defvar *mf2cp* nil) + +(defun method-function-plist (method-function) + (unless (eq method-function *mf1*) + (rotatef *mf1* *mf2*) + (rotatef *mf1p* *mf2p*) + (rotatef *mf1cp* *mf2cp*)) + (unless (or (eq method-function *mf1*) (null *mf1cp*)) + (setf (gethash *mf1* *method-function-plist*) *mf1p*)) + (unless (eq method-function *mf1*) + (setf *mf1* method-function + *mf1cp* nil + *mf1p* (gethash method-function *method-function-plist*))) + *mf1p*) + +(defun #-setf SETF\ PCL\ METHOD-FUNCTION-PLIST #+setf (setf method-function-plist) + (val method-function) + (unless (eq method-function *mf1*) + (rotatef *mf1* *mf2*) + (rotatef *mf1cp* *mf2cp*) + (rotatef *mf1p* *mf2p*)) + (unless (or (eq method-function *mf1*) (null *mf1cp*)) + (setf (gethash *mf1* *method-function-plist*) *mf1p*)) + (setf *mf1* method-function + *mf1cp* t + *mf1p* val)) + +(defun method-function-get (method-function key &optional default) + (getf (method-function-plist method-function) key default)) + +(defun #-setf SETF\ PCL\ METHOD-FUNCTION-GET #+setf (setf method-function-get) + (val method-function key) + (setf (getf (method-function-plist method-function) key) val)) + + +(defun method-function-pv-table (method-function) + (method-function-get method-function :pv-table)) + +(defun method-function-method (method-function) + (method-function-get method-function :method)) + +(defun method-function-needs-next-methods-p (method-function) + (method-function-get method-function :needs-next-methods-p t)) + + + +(defmacro method-function-closure-generator (method-function) + `(method-function-get ,method-function 'closure-generator)) + +(defun load-defmethod (class name quals specls ll initargs &optional pv-table-symbol) + (when (listp name) (do-standard-defsetf-1 (cadr name))) + (setq initargs (copy-tree initargs)) + (let ((method-spec (or (getf initargs ':method-spec) + (make-method-spec name quals specls)))) + (setf (getf initargs ':method-spec) method-spec) + (record-definition 'method method-spec) + (load-defmethod-internal class name quals specls ll initargs pv-table-symbol))) + +(defun load-defmethod-internal + (method-class gf-spec qualifiers specializers lambda-list + initargs pv-table-symbol) + (when (listp gf-spec) (do-standard-defsetf-1 (cadr gf-spec))) + (when pv-table-symbol + (setf (getf (getf initargs ':plist) :pv-table-symbol) + pv-table-symbol)) + (let ((method (apply #'add-named-method + gf-spec qualifiers specializers lambda-list + :definition-source `((defmethod ,gf-spec + ,@qualifiers + ,specializers) + ,(load-truename)) + initargs))) + (unless (or (eq method-class 'standard-method) + (eq (find-class method-class nil) (class-of method))) + (format *error-output* + "~&At the time the method with qualifiers ~:S and~%~ + specializers ~:S on the generic function ~S~%~ + was compiled, the method-class for that generic function was~%~ + ~S. But, the method class is now ~S, this~%~ + may mean that this method was compiled improperly.~%" + qualifiers specializers gf-spec + method-class (class-name (class-of method)))) + method)) + +(defun make-method-spec (gf-spec qualifiers unparsed-specializers) + `(method ,gf-spec ,@qualifiers ,unparsed-specializers)) + +(defun initialize-method-function (initargs &optional return-function-p method) + (let* ((mf (getf initargs ':function)) + (method-spec (getf initargs ':method-spec)) + (plist (getf initargs ':plist)) + (pv-table-symbol (getf plist ':pv-table-symbol)) + (pv-table nil) + (mff (getf initargs ':fast-function))) + (flet ((set-mf-property (p v) + (when mf + (setf (method-function-get mf p) v)) + (when mff + (setf (method-function-get mff p) v)))) + (when method-spec + (when mf + (setq mf (set-function-name mf method-spec))) + (when mff + (let ((name `(,(or (get (car method-spec) 'fast-sym) + (setf (get (car method-spec) 'fast-sym) + (intern (format nil "FAST-~A" + (car method-spec)) + *the-pcl-package*))) + ,@(cdr method-spec)))) + (set-function-name mff name) + (unless mf + (set-mf-property :name name))))) + (when plist + (let ((snl (getf plist :slot-name-lists)) + (cl (getf plist :call-list))) + (when (or snl cl) + (setq pv-table (intern-pv-table :slot-name-lists snl + :call-list cl)) + (when pv-table (set pv-table-symbol pv-table)) + (set-mf-property :pv-table pv-table))) + (loop (when (null plist) (return nil)) + (set-mf-property (pop plist) (pop plist))) + (when method + (set-mf-property :method method)) + (when return-function-p + (or mf (method-function-from-fast-function mff))))))) + + + +(defun analyze-lambda-list (lambda-list) + ;;(declare (values nrequired noptional keysp restp allow-other-keys-p + ;; keywords keyword-parameters)) + (flet ((parse-keyword-argument (arg) + (if (listp arg) + (if (listp (car arg)) + (caar arg) + (make-keyword (car arg))) + (make-keyword arg)))) + (let ((nrequired 0) + (noptional 0) + (keysp nil) + (restp nil) + (allow-other-keys-p nil) + (keywords ()) + (keyword-parameters ()) + (state 'required)) + (dolist (x lambda-list) + (if (memq x lambda-list-keywords) + (case x + (&optional (setq state 'optional)) + (&key (setq keysp 't + state 'key)) + (&allow-other-keys (setq allow-other-keys-p 't)) + (&rest (setq restp 't + state 'rest)) + (&aux (return t)) + (otherwise + (error "Encountered the non-standard lambda list keyword ~S." x))) + (ecase state + (required (incf nrequired)) + (optional (incf noptional)) + (key (push (parse-keyword-argument x) keywords) + (push x keyword-parameters)) + (rest ())))) + (values nrequired noptional keysp restp allow-other-keys-p + (reverse keywords) + (reverse keyword-parameters))))) + +(defun keyword-spec-name (x) + (let ((key (if (atom x) x (car x)))) + (if (atom key) + (intern (symbol-name key) (find-package "KEYWORD")) + (car key)))) + +(defun ftype-declaration-from-lambda-list (lambda-list #+cmu name) + (multiple-value-bind (nrequired noptional keysp restp allow-other-keys-p + keywords keyword-parameters) + (analyze-lambda-list lambda-list) + (declare (ignore keyword-parameters)) + (let* (#+cmu (old (c::info function type name)) + #+cmu (old-ftype (if (c::function-type-p old) old nil)) + #+cmu (old-restp (and old-ftype (c::function-type-rest old-ftype))) + #+cmu (old-keys (and old-ftype + (mapcar #'c::key-info-name + (c::function-type-keywords old-ftype)))) + #+cmu (old-keysp (and old-ftype (c::function-type-keyp old-ftype))) + #+cmu (old-allowp (and old-ftype (c::function-type-allowp old-ftype))) + (keywords #+cmu (union old-keys (mapcar #'keyword-spec-name keywords)) + #-cmu (mapcar #'keyword-spec-name keywords))) + `(function ,(append (make-list nrequired :initial-element 't) + (when (plusp noptional) + (append '(&optional) + (make-list noptional :initial-element 't))) + (when (or restp #+cmu old-restp) + '(&rest t)) + (when (or keysp #+cmu old-keysp) + (append '(&key) + (mapcar #'(lambda (key) + `(,key t)) + keywords) + (when (or allow-other-keys-p #+cmu old-allowp) + '(&allow-other-keys))))) + *)))) + +(defun proclaim-defgeneric (spec lambda-list) + #-cmu (declare (ignore lambda-list)) + (when (consp spec) + (setq spec (get-setf-function-name (cadr spec)))) + (let (#+cmu + (decl `(ftype ,(ftype-declaration-from-lambda-list lambda-list #+cmu spec) + ,spec))) + #+cmu (proclaim decl) + #+kcl (setf (get spec 'compiler::proclaimed-closure) t))) + +;;;; Early generic-function support +;;; +;;; +(defvar *early-generic-functions* ()) + +(defun ensure-generic-function (function-specifier + &rest all-keys + &key environment + &allow-other-keys) + (declare (ignore environment)) + #+copy-&rest-arg (setq all-keys (copy-list all-keys)) + (let ((existing (and (gboundp function-specifier) + (gdefinition function-specifier)))) + (if (and existing + (eq *boot-state* 'complete) + (null (generic-function-p existing))) + (generic-clobbers-function function-specifier) + (apply #'ensure-generic-function-using-class + existing function-specifier all-keys)))) + +(defun generic-clobbers-function (function-specifier) + #+Lispm (zl:signal 'generic-clobbers-function :name function-specifier) + #-Lispm (error "~S already names an ordinary function or a macro,~%~ + you may want to replace it with a generic function, but doing so~%~ + will require that you decide what to do with the existing function~%~ + definition.~%~ + The PCL-specific function MAKE-SPECIALIZABLE may be useful to you." + function-specifier)) + +#+Lispm +(zl:defflavor generic-clobbers-function (name) (si:error) + :initable-instance-variables) + +#+Lispm +(zl:defmethod #+Genera (dbg:report generic-clobbers-function) + #+ti (generic-clobbers-function :report) + (stream) + (format stream + "~S aready names a ~a" + name + (if (and (symbolp name) (macro-function name)) "macro" "function"))) + +#+Genera +(zl:defmethod (sys:proceed generic-clobbers-function :specialize-it) () + "Make it specializable anyway?" + (make-specializable name)) + +#+ti +(zl:defmethod + (generic-clobbers-function :case :proceed-asking-user :specialize-it) + (continuation ignore) + "Make it specializable anyway?" + (make-specializable name) + (funcall continuation :specialize-it)) + +(defvar *sgf-wrapper* + (#+cmu17 boot-make-wrapper #-cmu17 make-wrapper + (early-class-size 'standard-generic-function) + #+cmu17 'standard-generic-function)) + +(defvar *sgf-slots-init* + (map 'vector + #'(lambda (canonical-slot) + (if (memq (getf canonical-slot :name) '(arg-info source)) + *slot-unbound* + (let ((initfunction (getf canonical-slot :initfunction))) + (if initfunction + (funcall initfunction) + *slot-unbound*)))) + (early-collect-inheritance 'standard-generic-function))) + +(defvar *sgf-method-class-index* + (bootstrap-slot-index 'standard-generic-function 'method-class)) + +(defun early-gf-p (x) + (and (fsc-instance-p x) + (eq (instance-ref (get-slots x) *sgf-method-class-index*) + *slot-unbound*))) + +(defvar *sgf-methods-index* + (bootstrap-slot-index 'standard-generic-function 'methods)) + +(defmacro early-gf-methods (gf) + `(instance-ref (get-slots ,gf) *sgf-methods-index*)) + +(defvar *sgf-arg-info-index* + (bootstrap-slot-index 'standard-generic-function 'arg-info)) + +(defmacro early-gf-arg-info (gf) + `(instance-ref (get-slots ,gf) *sgf-arg-info-index*)) + +(defvar *sgf-dfun-state-index* + (bootstrap-slot-index 'standard-generic-function 'dfun-state)) + +(defstruct (arg-info + (:conc-name nil) + (:constructor make-arg-info ())) + (arg-info-lambda-list :no-lambda-list) + arg-info-precedence + arg-info-metatypes + arg-info-number-optional + arg-info-key/rest-p + arg-info-keywords ;nil no keyword or rest allowed + ;(k1 k2 ..) each method must accept these keyword arguments + ;T must have &key or &rest + + gf-info-simple-accessor-type ; nil, reader, writer, boundp + (gf-precompute-dfun-and-emf-p nil) ; set by set-arg-info + + gf-info-static-c-a-m-emf + (gf-info-c-a-m-emf-std-p t) + gf-info-fast-mf-p) + +#+cmu +(declaim (ext:freeze-type arg-info)) + +(defun arg-info-valid-p (arg-info) + (not (null (arg-info-number-optional arg-info)))) + +(defun arg-info-applyp (arg-info) + (or (plusp (the fixnum (arg-info-number-optional arg-info))) + (arg-info-key/rest-p arg-info))) + +(defun arg-info-number-required (arg-info) + (length (arg-info-metatypes arg-info))) + +(defun arg-info-nkeys (arg-info) + (count-if #'(lambda (x) (neq x 't)) (arg-info-metatypes arg-info))) + +;;; Keep pages clean by not setting if the value is already the same. +(defmacro esetf (pos val) + (let ((valsym (gensym "value"))) + `(let ((,valsym ,val)) + (unless (equal ,pos ,valsym) + (setf ,pos ,valsym))))) + +(defun set-arg-info (gf &key new-method (lambda-list nil lambda-list-p) + argument-precedence-order) + (let* ((arg-info (if (eq *boot-state* 'complete) + (gf-arg-info gf) + (early-gf-arg-info gf))) + (methods (if (eq *boot-state* 'complete) + (generic-function-methods gf) + (early-gf-methods gf))) + (was-valid-p (integerp (arg-info-number-optional arg-info))) + (first-p (and new-method (null (cdr methods))))) + (when (and (not lambda-list-p) methods) + (setq lambda-list (gf-lambda-list gf))) + (when (or lambda-list-p + (and first-p (eq (arg-info-lambda-list arg-info) ':no-lambda-list))) + (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords) + (analyze-lambda-list lambda-list) + (when (and methods (not first-p)) + (let ((gf-nreq (arg-info-number-required arg-info)) + (gf-nopt (arg-info-number-optional arg-info)) + (gf-key/rest-p (arg-info-key/rest-p arg-info))) + (unless (and (= nreq gf-nreq) + (= nopt gf-nopt) + (eq (or keysp restp) gf-key/rest-p)) + (error "The lambda-list ~S is incompatible with ~ + existing methods of ~S." + lambda-list gf)))) + (when lambda-list-p + (esetf (arg-info-lambda-list arg-info) lambda-list)) + (when (or lambda-list-p argument-precedence-order + (null (arg-info-precedence arg-info))) + (esetf (arg-info-precedence arg-info) + (compute-precedence lambda-list nreq + argument-precedence-order))) + (esetf (arg-info-metatypes arg-info) (make-list nreq)) + (esetf (arg-info-number-optional arg-info) nopt) + (esetf (arg-info-key/rest-p arg-info) (not (null (or keysp restp)))) + (esetf (arg-info-keywords arg-info) + (if lambda-list-p + (if allow-other-keys-p t keywords) + (arg-info-key/rest-p arg-info))))) + (when new-method + (check-method-arg-info gf arg-info new-method)) + (set-arg-info1 gf arg-info new-method methods was-valid-p first-p) + arg-info)) + +(defun check-method-arg-info (gf arg-info method) + (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords) + (analyze-lambda-list (if (consp method) + (early-method-lambda-list method) + (method-lambda-list method))) + (flet ((lose (string &rest args) + (error "Attempt to add the method ~S to the generic function ~S.~%~ + But ~A" method gf (apply #'format nil string args))) + (compare (x y) + (if (> x y) "more" "fewer"))) + (let ((gf-nreq (arg-info-number-required arg-info)) + (gf-nopt (arg-info-number-optional arg-info)) + (gf-key/rest-p (arg-info-key/rest-p arg-info)) + (gf-keywords (arg-info-keywords arg-info))) + (unless (= nreq gf-nreq) + (lose "the method has ~A required arguments than the generic function." + (compare nreq gf-nreq))) + (unless (= nopt gf-nopt) + (lose "the method has ~S optional arguments than the generic function." + (compare nopt gf-nopt))) + (unless (eq (or keysp restp) gf-key/rest-p) + (error "the method and generic function differ in whether they accept~%~ + rest or keyword arguments.")) + (when (consp gf-keywords) + (unless (or (and restp (not keysp)) + allow-other-keys-p + (every #'(lambda (k) (memq k keywords)) gf-keywords)) + (lose "the method does not accept each of the keyword arguments~%~ + ~S." gf-keywords))))))) + +(defun set-arg-info1 (gf arg-info new-method methods was-valid-p first-p) + (let* ((existing-p (and methods (cdr methods) new-method)) + (nreq (length (arg-info-metatypes arg-info))) + (metatypes (if existing-p + (arg-info-metatypes arg-info) + (make-list nreq))) + (type (if existing-p + (gf-info-simple-accessor-type arg-info) + nil))) + (when (arg-info-valid-p arg-info) + (dolist (method (if new-method (list new-method) methods)) + (let* ((specializers (if (or (eq *boot-state* 'complete) + (not (consp method))) + (method-specializers method) + (early-method-specializers method t))) + (class (if (or (eq *boot-state* 'complete) (not (consp method))) + (class-of method) + (early-method-class method))) + (new-type (when (and class + (or (not (eq *boot-state* 'complete)) + (eq (generic-function-method-combination gf) + *standard-method-combination*))) + (cond ((eq class *the-class-standard-reader-method*) + 'reader) + ((eq class *the-class-standard-writer-method*) + 'writer) + ((eq class *the-class-standard-boundp-method*) + 'boundp))))) + (setq metatypes (mapcar #'raise-metatype metatypes specializers)) + (setq type (cond ((null type) new-type) + ((eq type new-type) type) + (t nil))))) + (esetf (arg-info-metatypes arg-info) metatypes) + (esetf (gf-info-simple-accessor-type arg-info) type))) + (when (or (not was-valid-p) first-p) + (multiple-value-bind (c-a-m-emf std-p) + (if (early-gf-p gf) + (values t t) + (compute-applicable-methods-emf gf)) + (esetf (gf-info-static-c-a-m-emf arg-info) c-a-m-emf) + (esetf (gf-info-c-a-m-emf-std-p arg-info) std-p) + (unless (gf-info-c-a-m-emf-std-p arg-info) + (esetf (gf-info-simple-accessor-type arg-info) t)))) + (unless was-valid-p + (let ((name (if (eq *boot-state* 'complete) + (generic-function-name gf) + (early-gf-name gf)))) + (esetf (gf-precompute-dfun-and-emf-p arg-info) + (let* ((sym (if (atom name) name (cadr name))) + (pkg-list (cons *the-pcl-package* + (package-use-list *the-pcl-package*)))) + (and sym (symbolp sym) + (not (null (memq (symbol-package sym) pkg-list))) + (not (find #\space (symbol-name sym)))))))) + (esetf (gf-info-fast-mf-p arg-info) + (or (not (eq *boot-state* 'complete)) + (let* ((method-class (generic-function-method-class gf)) + (methods (compute-applicable-methods + #'make-method-lambda + (list gf (class-prototype method-class) + '(lambda) nil)))) + (and methods (null (cdr methods)) + (let ((specls (method-specializers (car methods)))) + (and (classp (car specls)) + (eq 'standard-generic-function + (class-name (car specls))) + (classp (cadr specls)) + (eq 'standard-method + (class-name (cadr specls))))))))) + arg-info) + +;;; +;;; This is the early definition of ensure-generic-function-using-class. +;;; +;;; The static-slots field of the funcallable instances used as early generic +;;; functions is used to store the early methods and early discriminator code +;;; for the early generic function. The static slots field of the fins +;;; contains a list whose: +;;; CAR - a list of the early methods on this early gf +;;; CADR - the early discriminator code for this method +;;; +(defun ensure-generic-function-using-class (existing spec &rest keys + &key (lambda-list nil lambda-list-p) + &allow-other-keys) + (declare (ignore keys)) + (cond ((and existing (early-gf-p existing)) + existing) + ((assoc spec *generic-function-fixups* :test #'equal) + (if existing + (make-early-gf spec lambda-list lambda-list-p existing) + (error "The function ~S is not already defined" spec))) + (existing + (error "~S should be on the list ~S" spec '*generic-function-fixups*)) + (t + (pushnew spec *early-generic-functions* :test #'equal) + (make-early-gf spec lambda-list lambda-list-p)))) + +(defun make-early-gf (spec &optional lambda-list lambda-list-p function) + (let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*))) + (set-funcallable-instance-function + fin + (or function + (if (eq spec 'print-object) + (fin-lambda-fn (instance stream) + (printing-random-thing (instance stream) + (format stream "std-instance"))) + (fin-lambda-fn (&rest args) + (declare (ignore args)) + (error "The function of the funcallable-instance ~S~ + has not been set" fin))))) + (setf (gdefinition spec) fin) + (bootstrap-set-slot 'standard-generic-function fin 'name spec) + (bootstrap-set-slot 'standard-generic-function fin 'source (load-truename)) + (set-function-name fin spec) + (let ((arg-info (make-arg-info))) + (setf (early-gf-arg-info fin) arg-info) + (when lambda-list-p + (proclaim-defgeneric spec lambda-list) + (set-arg-info fin :lambda-list lambda-list))) + fin)) + +(defun set-dfun (gf &optional dfun cache info) + (when cache + (setf (cache-owner cache) gf)) + (let ((new-state (if (and dfun (or cache info)) + (list* dfun cache info) + dfun))) + (if (eq *boot-state* 'complete) + (setf (gf-dfun-state gf) new-state) + (setf (instance-ref (get-slots gf) *sgf-dfun-state-index*) new-state))) + dfun) + +(defun gf-dfun-cache (gf) + (let ((state (if (eq *boot-state* 'complete) + (gf-dfun-state gf) + (instance-ref (get-slots gf) *sgf-dfun-state-index*)))) + (typecase state + (function nil) + (cons (cadr state))))) + +(defun gf-dfun-info (gf) + (let ((state (if (eq *boot-state* 'complete) + (gf-dfun-state gf) + (instance-ref (get-slots gf) *sgf-dfun-state-index*)))) + (typecase state + (function nil) + (cons (cddr state))))) + +(defvar *sgf-name-index* + (bootstrap-slot-index 'standard-generic-function 'name)) + +(defun early-gf-name (gf) + (instance-ref (get-slots gf) *sgf-name-index*)) + +(defun gf-lambda-list (gf) + (let ((arg-info (if (eq *boot-state* 'complete) + (gf-arg-info gf) + (early-gf-arg-info gf)))) + (if (eq ':no-lambda-list (arg-info-lambda-list arg-info)) + (let ((methods (if (eq *boot-state* 'complete) + (generic-function-methods gf) + (early-gf-methods gf)))) + (if (null methods) + (progn + (warn "No way to determine the lambda list for ~S." gf) + nil) + (let* ((method (car (last methods))) + (ll (if (consp method) + (early-method-lambda-list method) + (method-lambda-list method))) + (k (member '&key ll))) + (if k + (append (ldiff ll (cdr k)) '(&allow-other-keys)) + ll)))) + (arg-info-lambda-list arg-info)))) + +(defmacro real-ensure-gf-internal (gf-class all-keys env) + `(progn + (cond ((symbolp ,gf-class) + (setq ,gf-class (find-class ,gf-class t ,env))) + ((classp ,gf-class)) + (t + (error "The :GENERIC-FUNCTION-CLASS argument (~S) was neither a~%~ + class nor a symbol that names a class." + ,gf-class))) + (remf ,all-keys :generic-function-class) + (remf ,all-keys :environment) + (let ((combin (getf ,all-keys :method-combination '.shes-not-there.))) + (unless (eq combin '.shes-not-there.) + (setf (getf ,all-keys :method-combination) + (find-method-combination (class-prototype ,gf-class) + (car combin) + (cdr combin))))) + )) + +(defun real-ensure-gf-using-class--generic-function + (existing + function-specifier + &rest all-keys + &key environment (lambda-list nil lambda-list-p) + (generic-function-class 'standard-generic-function gf-class-p) + &allow-other-keys) + #+copy-&rest-arg (setq all-keys (copy-list all-keys)) + (real-ensure-gf-internal generic-function-class all-keys environment) + (unless (or (null gf-class-p) + (eq (class-of existing) generic-function-class)) + (change-class existing generic-function-class)) + (prog1 + (apply #'reinitialize-instance existing all-keys) + (when lambda-list-p + (proclaim-defgeneric function-specifier lambda-list)))) + +(defun real-ensure-gf-using-class--null + (existing + function-specifier + &rest all-keys + &key environment (lambda-list nil lambda-list-p) + (generic-function-class 'standard-generic-function) + &allow-other-keys) + (declare (ignore existing)) + #+copy-&rest-arg (setq all-keys (copy-list all-keys)) + (real-ensure-gf-internal generic-function-class all-keys environment) + (prog1 + (setf (gdefinition function-specifier) + (apply #'make-instance generic-function-class + :name function-specifier all-keys)) + (when lambda-list-p + (proclaim-defgeneric function-specifier lambda-list)))) + + + +(defun get-generic-function-info (gf) + ;; values nreq applyp metatypes nkeys arg-info + (multiple-value-bind (applyp metatypes arg-info) + (let* ((arg-info (if (early-gf-p gf) + (early-gf-arg-info gf) + (gf-arg-info gf))) + (metatypes (arg-info-metatypes arg-info))) + (values (arg-info-applyp arg-info) + metatypes + arg-info)) + (values (length metatypes) applyp metatypes + (count-if #'(lambda (x) (neq x 't)) metatypes) + arg-info))) + +(defun early-make-a-method (class qualifiers arglist specializers initargs doc + &optional slot-name) + (initialize-method-function initargs) + (let ((parsed ()) + (unparsed ())) + ;; Figure out whether we got class objects or class names as the + ;; specializers and set parsed and unparsed appropriately. If we + ;; got class objects, then we can compute unparsed, but if we got + ;; class names we don't try to compute parsed. + ;; + ;; Note that the use of not symbolp in this call to every should be + ;; read as 'classp' we can't use classp itself because it doesn't + ;; exist yet. + (if (every #'(lambda (s) (not (symbolp s))) specializers) + (setq parsed specializers + unparsed (mapcar #'(lambda (s) + (if (eq s 't) 't (class-name s))) + specializers)) + (setq unparsed specializers + parsed ())) + (list :early-method ;This is an early method dammit! + + (getf initargs ':function) + (getf initargs ':fast-function) + + parsed ;The parsed specializers. This is used + ;by early-method-specializers to cache + ;the parse. Note that this only comes + ;into play when there is more than one + ;early method on an early gf. + + (list class ;A list to which real-make-a-method + qualifiers ;can be applied to make a real method + arglist ;corresponding to this early one. + unparsed + initargs + doc + slot-name) + ))) + +(defun real-make-a-method + (class qualifiers lambda-list specializers initargs doc + &optional slot-name) + (setq specializers (parse-specializers specializers)) + (apply #'make-instance class + :qualifiers qualifiers + :lambda-list lambda-list + :specializers specializers + :documentation doc + :slot-name slot-name + :allow-other-keys t + initargs)) + +(defun early-method-function (early-method) + (values (cadr early-method) (caddr early-method))) + +(defun early-method-class (early-method) + (find-class (car (fifth early-method)))) + +(defun early-method-standard-accessor-p (early-method) + (let ((class (first (fifth early-method)))) + (or (eq class 'standard-reader-method) + (eq class 'standard-writer-method) + (eq class 'standard-boundp-method)))) + +(defun early-method-standard-accessor-slot-name (early-method) + (seventh (fifth early-method))) + +;;; +;;; Fetch the specializers of an early method. This is basically just a +;;; simple accessor except that when the second argument is t, this converts +;;; the specializers from symbols into class objects. The class objects +;;; are cached in the early method, this makes bootstrapping faster because +;;; the class objects only have to be computed once. +;;; NOTE: +;;; the second argument should only be passed as T by early-lookup-method. +;;; this is to implement the rule that only when there is more than one +;;; early method on a generic function is the conversion from class names +;;; to class objects done. +;;; the corresponds to the fact that we are only allowed to have one method +;;; on any generic function up until the time classes exist. +;;; +(defun early-method-specializers (early-method &optional objectsp) + (if (and (listp early-method) + (eq (car early-method) :early-method)) + (cond ((eq objectsp 't) + (or (fourth early-method) + (setf (fourth early-method) + (mapcar #'find-class (cadddr (fifth early-method)))))) + (t + (cadddr (fifth early-method)))) + (error "~S is not an early-method." early-method))) + +(defun early-method-qualifiers (early-method) + (cadr (fifth early-method))) + +(defun early-method-lambda-list (early-method) + (caddr (fifth early-method))) + +(defun early-add-named-method (generic-function-name + qualifiers + specializers + arglist + &rest initargs) + #+copy-&rest-arg (setq initargs (copy-list initargs)) + (let* ((gf (ensure-generic-function generic-function-name)) + (existing + (dolist (m (early-gf-methods gf)) + (when (and (equal (early-method-specializers m) specializers) + (equal (early-method-qualifiers m) qualifiers)) + (return m)))) + (new (make-a-method 'standard-method + qualifiers + arglist + specializers + initargs + ()))) + (when existing (remove-method gf existing)) + (add-method gf new))) + +;;; +;;; This is the early version of add-method. Later this will become a +;;; generic function. See fix-early-generic-functions which has special +;;; knowledge about add-method. +;;; +(defun add-method (generic-function method) + (when (not (fsc-instance-p generic-function)) + (error "Early add-method didn't get a funcallable instance.")) + (when (not (and (listp method) (eq (car method) :early-method))) + (error "Early add-method didn't get an early method.")) + (push method (early-gf-methods generic-function)) + (set-arg-info generic-function :new-method method) + (unless (assoc (early-gf-name generic-function) *generic-function-fixups* + :test #'equal) + (update-dfun generic-function))) + +;;; +;;; This is the early version of remove method. +;;; +(defun remove-method (generic-function method) + (when (not (fsc-instance-p generic-function)) + (error "Early remove-method didn't get a funcallable instance.")) + (when (not (and (listp method) (eq (car method) :early-method))) + (error "Early remove-method didn't get an early method.")) + (setf (early-gf-methods generic-function) + (remove method (early-gf-methods generic-function))) + (set-arg-info generic-function) + (unless (assoc (early-gf-name generic-function) *generic-function-fixups* + :test #'equal) + (update-dfun generic-function))) + +;;; +;;; And the early version of get-method. +;;; +(defun get-method (generic-function qualifiers specializers + &optional (errorp t)) + (if (early-gf-p generic-function) + (or (dolist (m (early-gf-methods generic-function)) + (when (and (or (equal (early-method-specializers m nil) + specializers) + (equal (early-method-specializers m 't) + specializers)) + (equal (early-method-qualifiers m) qualifiers)) + (return m))) + (if errorp + (error "Can't get early method.") + nil)) + (real-get-method generic-function qualifiers specializers errorp))) + +(defvar *fegf-debug-p* nil) + +(defun fix-early-generic-functions (&optional (noisyp *fegf-debug-p*)) + (setq *fegf-started-p* t) + (let ((accessors nil)) + ;; Rearrange *early-generic-functions* to speed up fix-early-generic-functions. + (dolist (early-gf-spec *early-generic-functions*) + (when (every #'early-method-standard-accessor-p + (early-gf-methods (gdefinition early-gf-spec))) + (push early-gf-spec accessors))) + (dolist (spec (nconc accessors + '(accessor-method-slot-name + generic-function-methods + method-specializers + specializerp + specializer-type + specializer-class + slot-definition-location + slot-definition-name + class-slots + gf-arg-info + class-precedence-list + slot-boundp-using-class + (setf slot-value-using-class) + slot-value-using-class + structure-class-p + standard-class-p + funcallable-standard-class-p + specializerp))) + (setq *early-generic-functions* + (cons spec (delete spec *early-generic-functions* :test #'equal)))) + + (dolist (early-gf-spec *early-generic-functions*) + (when noisyp (format t "~&~S..." early-gf-spec)) + (let* ((gf (gdefinition early-gf-spec)) + (methods (mapcar #'(lambda (early-method) + (let ((args (copy-list (fifth early-method)))) + (setf (fourth args) + (early-method-specializers early-method t)) + (apply #'real-make-a-method args))) + (early-gf-methods gf)))) + (setf (generic-function-method-class gf) *the-class-standard-method*) + (setf (generic-function-method-combination gf) *standard-method-combination*) + (set-methods gf methods))) + + (dolist (fns *early-functions*) + (setf (gdefinition (car fns)) (symbol-function (caddr fns)))) + + (dolist (fixup *generic-function-fixups*) + (let* ((fspec (car fixup)) + (gf (gdefinition fspec)) + (methods (mapcar #'(lambda (method) + (let* ((lambda-list (first method)) + (specializers (second method)) + (method-fn-name (third method)) + (fn-name (or method-fn-name fspec)) + (fn (symbol-function fn-name)) + (initargs + (list :function + (set-function-name + #'(lambda (args next-methods) + (declare (ignore next-methods)) + (apply fn args)) + `(call ,fn-name))))) + (declare (type function fn)) + (make-a-method 'standard-method + () + lambda-list + specializers + initargs + nil))) + (cdr fixup)))) + (setf (generic-function-method-class gf) *the-class-standard-method*) + (setf (generic-function-method-combination gf) *standard-method-combination*) + (set-methods gf methods))))) + + +;;; +;;; parse-defmethod is used by defmethod to parse the &rest argument into +;;; the 'real' arguments. This is where the syntax of defmethod is really +;;; implemented. +;;; +(defun parse-defmethod (cdr-of-form) + ;;(declare (values name qualifiers specialized-lambda-list body)) + (let ((name (pop cdr-of-form)) + (qualifiers ()) + (spec-ll ())) + (loop (if (and (car cdr-of-form) (atom (car cdr-of-form))) + (push (pop cdr-of-form) qualifiers) + (return (setq qualifiers (nreverse qualifiers))))) + (setq spec-ll (pop cdr-of-form)) + (values name qualifiers spec-ll cdr-of-form))) + +(defun parse-specializers (specializers) + (flet ((parse (spec) + (let ((result (specializer-from-type spec))) + (if (specializerp result) + result + (if (symbolp spec) + (error "~S used as a specializer,~%~ + but is not the name of a class." + spec) + (error "~S is not a legal specializer." spec)))))) + (mapcar #'parse specializers))) + +(defun unparse-specializers (specializers-or-method) + (if (listp specializers-or-method) + (flet ((unparse (spec) + (if (specializerp spec) + (let ((type (specializer-type spec))) + (if (and (consp type) + (eq (car type) 'class)) + (let* ((class (cadr type)) + (class-name (class-name class))) + (if (eq class (find-class class-name nil)) + class-name + type)) + type)) + (error "~S is not a legal specializer." spec)))) + (mapcar #'unparse specializers-or-method)) + (unparse-specializers (method-specializers specializers-or-method)))) + +(defun parse-method-or-spec (spec &optional (errorp t)) + ;;(declare (values generic-function method method-name)) + (let (gf method name temp) + (if (method-p spec) + (setq method spec + gf (method-generic-function method) + temp (and gf (generic-function-name gf)) + name (if temp + (intern-function-name + (make-method-spec temp + (method-qualifiers method) + (unparse-specializers + (method-specializers method)))) + (make-symbol (format nil "~S" method)))) + (multiple-value-bind (gf-spec quals specls) + (parse-defmethod spec) + (and (setq gf (and (or errorp (gboundp gf-spec)) + (gdefinition gf-spec))) + (let ((nreq (compute-discriminating-function-arglist-info gf))) + (setq specls (append (parse-specializers specls) + (make-list (- nreq (length specls)) + :initial-element + *the-class-t*))) + (and + (setq method (get-method gf quals specls errorp)) + (setq name + (intern-function-name (make-method-spec gf-spec + quals + specls)))))))) + (values gf method name))) + + + +(defun extract-parameters (specialized-lambda-list) + (multiple-value-bind (parameters ignore1 ignore2) + (parse-specialized-lambda-list specialized-lambda-list) + (declare (ignore ignore1 ignore2)) + parameters)) + +(defun extract-lambda-list (specialized-lambda-list) + (multiple-value-bind (ignore1 lambda-list ignore2) + (parse-specialized-lambda-list specialized-lambda-list) + (declare (ignore ignore1 ignore2)) + lambda-list)) + +(defun extract-specializer-names (specialized-lambda-list) + (multiple-value-bind (ignore1 ignore2 specializers) + (parse-specialized-lambda-list specialized-lambda-list) + (declare (ignore ignore1 ignore2)) + specializers)) + +(defun extract-required-parameters (specialized-lambda-list) + (multiple-value-bind (ignore1 ignore2 ignore3 required-parameters) + (parse-specialized-lambda-list specialized-lambda-list) + (declare (ignore ignore1 ignore2 ignore3)) + required-parameters)) + +(defun parse-specialized-lambda-list (arglist &optional post-keyword) + ;;(declare (values parameters lambda-list specializers required-parameters)) + (let ((arg (car arglist))) + (cond ((null arglist) (values nil nil nil nil)) + ((eq arg '&aux) + (values nil arglist nil)) + ((memq arg lambda-list-keywords) + (unless (memq arg '(&optional &rest &key &allow-other-keys &aux)) + ;; Warn about non-standard lambda-list-keywords, but then + ;; go on to treat them like a standard lambda-list-keyword + ;; what with the warning its probably ok. + (warn "Unrecognized lambda-list keyword ~S in arglist.~%~ + Assuming that the symbols following it are parameters,~%~ + and not allowing any parameter specializers to follow~%~ + to follow it." + arg)) + ;; When we are at a lambda-list-keyword, the parameters don't + ;; include the lambda-list-keyword; the lambda-list does include + ;; the lambda-list-keyword; and no specializers are allowed to + ;; follow the lambda-list-keywords (at least for now). + (multiple-value-bind (parameters lambda-list) + (parse-specialized-lambda-list (cdr arglist) t) + (values parameters + (cons arg lambda-list) + () + ()))) + (post-keyword + ;; After a lambda-list-keyword there can be no specializers. + (multiple-value-bind (parameters lambda-list) + (parse-specialized-lambda-list (cdr arglist) t) + (values (cons (if (listp arg) (car arg) arg) parameters) + (cons arg lambda-list) + () + ()))) + (t + (multiple-value-bind (parameters lambda-list specializers required) + (parse-specialized-lambda-list (cdr arglist)) + (values (cons (if (listp arg) (car arg) arg) parameters) + (cons (if (listp arg) (car arg) arg) lambda-list) + (cons (if (listp arg) (cadr arg) 't) specializers) + (cons (if (listp arg) (car arg) arg) required))))))) + + +(eval-when (load eval) + (setq *boot-state* 'early)) + + +#-cmu ;; CMUCL Has a real symbol-macrolet +(progn +(defmacro symbol-macrolet (bindings &body body &environment env) + (let ((specs (mapcar #'(lambda (binding) + (list (car binding) + (variable-lexical-p (car binding) env) + (cadr binding))) + bindings))) + (walk-form `(progn ,@body) + env + #'(lambda (f c e) + (expand-symbol-macrolet-internal specs f c e))))) + +(defun expand-symbol-macrolet-internal (specs form context env) + (let ((entry nil)) + (cond ((not (eq context :eval)) form) + ((symbolp form) + (if (and (setq entry (assoc form specs)) + (eq (cadr entry) (variable-lexical-p form env))) + (caddr entry) + form)) + ((not (listp form)) form) + ((member (car form) '(setq setf)) + ;; Have to be careful. We must only convert the form to a SETF + ;; form when we convert one of the 'logical' variables to a form + ;; Otherwise we will get looping in implementations where setf + ;; is a macro which expands into setq. + (let ((kind (car form))) + (labels ((scan-setf (tail) + (if (null tail) + nil + (walker::relist* + tail + (if (and (setq entry (assoc (car tail) specs)) + (eq (cadr entry) + (variable-lexical-p (car tail) + env))) + (progn (setq kind 'setf) + (caddr entry)) + (car tail)) + (cadr tail) + (scan-setf (cddr tail)))))) + (let (new-tail) + (setq new-tail (scan-setf (cdr form))) + (walker::recons form kind new-tail))))) + ((eq (car form) 'multiple-value-setq) + (let* ((vars (cadr form)) + (gensyms (mapcar #'(lambda (i) (declare (ignore i)) (gensym)) + vars))) + `(multiple-value-bind ,gensyms + ,(caddr form) + .,(reverse (mapcar #'(lambda (v g) `(setf ,v ,g)) + vars + gensyms))))) + (t form)))) +) + +(defmacro with-slots (slots instance &body body) + (let ((in (gensym))) + `(let ((,in ,instance)) + #+cmu (declare (ignorable ,in)) + ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the)) + (third instance) + instance))) + (and (symbolp instance) + `((declare (variable-rebinding ,in ,instance))))) + ,in + (symbol-macrolet ,(mapcar #'(lambda (slot-entry) + (let ((variable-name + (if (symbolp slot-entry) + slot-entry + (car slot-entry))) + (slot-name + (if (symbolp slot-entry) + slot-entry + (cadr slot-entry)))) + `(,variable-name + (slot-value ,in ',slot-name)))) + slots) + ,@body)))) + +(defmacro with-accessors (slots instance &body body) + (let ((in (gensym))) + `(let ((,in ,instance)) + #+cmu (declare (ignorable ,in)) + ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the)) + (third instance) + instance))) + (and (symbolp instance) + `((declare (variable-rebinding ,in ,instance))))) + ,in + (symbol-macrolet ,(mapcar #'(lambda (slot-entry) + (let ((variable-name (car slot-entry)) + (accessor-name (cadr slot-entry))) + `(,variable-name + (,accessor-name ,in)))) + slots) + ,@body)))) + + + diff --git a/pcl/gcl_pcl_braid.lisp b/pcl/gcl_pcl_braid.lisp new file mode 100644 index 0000000..fe03ca0 --- /dev/null +++ b/pcl/gcl_pcl_braid.lisp @@ -0,0 +1,760 @@ +;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; Bootstrapping the meta-braid. +;;; +;;; The code in this file takes the early definitions that have been saved +;;; up and actually builds those class objects. This work is largely driven +;;; off of those class definitions, but the fact that STANDARD-CLASS is the +;;; class of all metaclasses in the braid is built into this code pretty +;;; deeply. +;;; +;;; + +(in-package :pcl) + +(defun allocate-standard-instance (wrapper &optional (slots-init nil slots-init-p)) + #-new-kcl-wrapper (declare (special *slot-unbound*)) + #-new-kcl-wrapper + (let ((instance (%%allocate-instance--class))) + (setf (std-instance-wrapper instance) wrapper) + (setf (std-instance-slots instance) + (if slots-init-p + (copy-slots slots-init) + (make-array (wrapper-no-of-instance-slots wrapper) + :initial-element *slot-unbound*))) + instance) + #+new-kcl-wrapper + (apply #'si:make-structure wrapper + (if slots-init-p + slots-init + (let ((no-of-slots (si::s-data-length wrapper))) + (if (< no-of-slots (fill-pointer *init-vector*)) + (aref *init-vector* no-of-slots) + (get-init-list no-of-slots)))))) + +(defmacro allocate-funcallable-instance-slots (wrapper &optional + slots-init-p slots-init) + #-new-kcl-wrapper + `(let ((no-of-slots (wrapper-no-of-instance-slots ,wrapper))) + ,(if slots-init-p + `(if ,slots-init-p + (copy-slots ,slots-init) + (make-array no-of-slots :initial-element *slot-unbound*)) + `(make-array no-of-slots :initial-element *slot-unbound*))) + #+new-kcl-wrapper + (if slots-init-p + `(if ,slots-init-p + (allocate-standard-instance ,wrapper ,slots-init) + (allocate-standard-instance ,wrapper)) + `(allocate-standard-instance ,wrapper))) + +(defun allocate-funcallable-instance (wrapper &optional (slots-init nil slots-init-p)) + (let ((fin (allocate-funcallable-instance-1))) + (set-funcallable-instance-function + fin + (fin-lambda-fn (&rest args) + (declare (ignore args)) + (error "The function of the funcallable-instance ~S has not been set" fin))) + (setf (fsc-instance-wrapper fin) wrapper + (fsc-instance-slots fin) (allocate-funcallable-instance-slots + wrapper slots-init-p slots-init)) + fin)) + +(defun allocate-structure-instance (wrapper &optional (slots-init nil slots-init-p)) + #-new-kcl-wrapper + (let* ((class (wrapper-class wrapper)) + (constructor (class-defstruct-constructor class))) + (if constructor + (let ((instance (funcall constructor)) + (slots (class-slots class))) + (when slots-init-p + (dotimes (i (length slots-init)) + (let ((slot (pop slots))) + (setf (slot-value-using-class class instance slot) + (svref slots-init i))))) + instance) + (error "Can't allocate an instance of class ~S" (class-name class)))) + #+new-kcl-wrapper + (if slots-init-p + (allocate-standard-instance wrapper slots-init) + (allocate-standard-instance wrapper))) + +;;; +;;; bootstrap-meta-braid +;;; +;;; This function builds the base metabraid from the early class definitions. +;;; +(defmacro initial-classes-and-wrappers (&rest classes) + `(progn + ,@(mapcar #'(lambda (class) + (let ((wr (intern (format nil "~A-WRAPPER" class) + *the-pcl-package*))) + `(setf ,wr ,(if (eq class 'standard-generic-function) + '*sgf-wrapper* + #-cmu17 + `(make-wrapper (early-class-size ',class)) + #+cmu17 + `(boot-make-wrapper + (early-class-size ',class) + ',class)) + ,class (allocate-standard-instance + ,(if (eq class 'standard-generic-function) + 'funcallable-standard-class-wrapper + 'standard-class-wrapper)) + (wrapper-class ,wr) ,class + #+new-kcl-wrapper (si::s-data-name ,wr) + #+new-kcl-wrapper ',class + (find-class ',class) ,class))) + classes))) + +(defun bootstrap-meta-braid () + (let* ((name 'class) + (predicate-name (make-type-predicate-name name))) + (setf (gdefinition predicate-name) + #'(lambda (x) (declare (ignore x)) t)) + (do-satisfies-deftype name predicate-name)) + (let* ((*create-classes-from-internal-structure-definitions-p* nil) + standard-class-wrapper standard-class + funcallable-standard-class-wrapper funcallable-standard-class + slot-class-wrapper slot-class + built-in-class-wrapper built-in-class + structure-class-wrapper structure-class + standard-direct-slot-definition-wrapper standard-direct-slot-definition + standard-effective-slot-definition-wrapper standard-effective-slot-definition + class-eq-specializer-wrapper class-eq-specializer + standard-generic-function-wrapper standard-generic-function) + (initial-classes-and-wrappers + standard-class funcallable-standard-class + slot-class built-in-class structure-class + standard-direct-slot-definition standard-effective-slot-definition + class-eq-specializer standard-generic-function) + ;; + ;; First, make a class metaobject for each of the early classes. For + ;; each metaobject we also set its wrapper. Except for the class T, + ;; the wrapper is always that of STANDARD-CLASS. + ;; + (dolist (definition *early-class-definitions*) + (let* ((name (ecd-class-name definition)) + (meta (ecd-metaclass definition)) + (wrapper (ecase meta + (slot-class slot-class-wrapper) + (standard-class standard-class-wrapper) + (funcallable-standard-class funcallable-standard-class-wrapper) + (built-in-class built-in-class-wrapper) + (structure-class structure-class-wrapper))) + (class (or (find-class name nil) + (allocate-standard-instance wrapper)))) + (when (or (eq meta 'standard-class) (eq meta 'funcallable-standard-class)) + (inform-type-system-about-std-class name)) + (setf (find-class name) class))) + ;; + ;; + ;; + (dolist (definition *early-class-definitions*) + (let ((name (ecd-class-name definition)) + (meta (ecd-metaclass definition)) + (source (ecd-source definition)) + (direct-supers (ecd-superclass-names definition)) + (direct-slots (ecd-canonical-slots definition)) + (other-initargs (ecd-other-initargs definition))) + (let ((direct-default-initargs + (getf other-initargs :direct-default-initargs))) + (multiple-value-bind (slots cpl default-initargs direct-subclasses) + (early-collect-inheritance name) + (let* ((class (find-class name)) + (wrapper (cond ((eq class slot-class) + slot-class-wrapper) + ((eq class standard-class) + standard-class-wrapper) + ((eq class funcallable-standard-class) + funcallable-standard-class-wrapper) + ((eq class standard-direct-slot-definition) + standard-direct-slot-definition-wrapper) + ((eq class standard-effective-slot-definition) + standard-effective-slot-definition-wrapper) + ((eq class built-in-class) + built-in-class-wrapper) + ((eq class structure-class) + structure-class-wrapper) + ((eq class class-eq-specializer) + class-eq-specializer-wrapper) + ((eq class standard-generic-function) + standard-generic-function-wrapper) + (t + #-cmu17 + (make-wrapper (length slots) class) + #+cmu17 + (boot-make-wrapper (length slots) name)))) + (proto nil)) + (when (eq name 't) (setq *the-wrapper-of-t* wrapper)) + (set (intern (format nil "*THE-CLASS-~A*" (symbol-name name)) + *the-pcl-package*) + class) + (dolist (slot slots) + (unless (eq (getf slot :allocation :instance) :instance) + (error "Slot allocation ~S not supported in bootstrap."))) + + (when #+cmu17 (typep wrapper 'wrapper) #-cmu17 t + (setf (wrapper-instance-slots-layout wrapper) + (mapcar #'canonical-slot-name slots)) + (setf (wrapper-class-slots wrapper) + ())) + + (setq proto (if (eq meta 'funcallable-standard-class) + (allocate-funcallable-instance wrapper) + (allocate-standard-instance wrapper))) + + (setq direct-slots + (bootstrap-make-slot-definitions + name class direct-slots + standard-direct-slot-definition-wrapper nil)) + (setq slots + (bootstrap-make-slot-definitions + name class slots + standard-effective-slot-definition-wrapper t)) + + (case meta + ((standard-class funcallable-standard-class) + (bootstrap-initialize-class + meta + class name class-eq-specializer-wrapper source + direct-supers direct-subclasses cpl wrapper proto + direct-slots slots direct-default-initargs default-initargs)) + (built-in-class ; *the-class-t* + (bootstrap-initialize-class + meta + class name class-eq-specializer-wrapper source + direct-supers direct-subclasses cpl wrapper proto)) + (slot-class ; *the-class-slot-object* + (bootstrap-initialize-class + meta + class name class-eq-specializer-wrapper source + direct-supers direct-subclasses cpl wrapper proto)) + (structure-class ; *the-class-structure-object* + (bootstrap-initialize-class + meta + class name class-eq-specializer-wrapper source + direct-supers direct-subclasses cpl wrapper)))))))) + + (let* ((smc-class (find-class 'standard-method-combination)) + (smc-wrapper (bootstrap-get-slot 'standard-class smc-class 'wrapper)) + (smc (allocate-standard-instance smc-wrapper))) + (flet ((set-slot (name value) + (bootstrap-set-slot 'standard-method-combination smc name value))) + (set-slot 'source (load-truename)) + (set-slot 'type 'standard) + (set-slot 'documentation "The standard method combination.") + (set-slot 'options ())) + (setq *standard-method-combination* smc)))) + +;;; +;;; Initialize a class metaobject. +;;; +(defun bootstrap-initialize-class + (metaclass-name class name + class-eq-wrapper source direct-supers direct-subclasses cpl wrapper + &optional proto direct-slots slots direct-default-initargs default-initargs) + (flet ((classes (names) (mapcar #'find-class names)) + (set-slot (slot-name value) + (bootstrap-set-slot metaclass-name class slot-name value))) + (set-slot 'name name) + (set-slot 'source source) + (set-slot 'type (if (eq class (find-class 't)) + t + `(class ,class))) + (set-slot 'class-eq-specializer + (let ((spec (allocate-standard-instance class-eq-wrapper))) + (bootstrap-set-slot 'class-eq-specializer spec 'type + `(class-eq ,class)) + (bootstrap-set-slot 'class-eq-specializer spec 'object + class) + spec)) + (set-slot 'class-precedence-list (classes cpl)) + (set-slot 'can-precede-list (classes (cdr cpl))) + (set-slot 'incompatible-superclass-list nil) + (set-slot 'direct-superclasses (classes direct-supers)) + (set-slot 'direct-subclasses (classes direct-subclasses)) + (set-slot 'direct-methods (cons nil nil)) + (set-slot 'wrapper wrapper) + #+new-kcl-wrapper + (setf (si::s-data-name wrapper) name) + (set-slot 'predicate-name (or (cadr (assoc name *early-class-predicates*)) + (make-class-predicate-name name))) + (set-slot 'plist + `(,@(and direct-default-initargs + `(direct-default-initargs ,direct-default-initargs)) + ,@(and default-initargs + `(default-initargs ,default-initargs)))) + (when (memq metaclass-name '(standard-class funcallable-standard-class + structure-class slot-class)) + (set-slot 'direct-slots direct-slots) + (set-slot 'slots slots) + (set-slot 'initialize-info nil)) + (if (eq metaclass-name 'structure-class) + (let ((constructor-sym '|STRUCTURE-OBJECT class constructor|)) + (set-slot 'predicate-name (or (cadr (assoc name *early-class-predicates*)) + (make-class-predicate-name name))) + (set-slot 'defstruct-form + `(defstruct (structure-object (:constructor ,constructor-sym)))) + (set-slot 'defstruct-constructor constructor-sym) + (set-slot 'from-defclass-p t) + (set-slot 'plist nil) + (set-slot 'prototype (funcall constructor-sym))) + (set-slot 'prototype (or proto (allocate-standard-instance wrapper)))) + class)) + +(defun bootstrap-make-slot-definitions (name class slots wrapper effective-p) + (let ((index -1)) + (mapcar #'(lambda (slot) + (incf index) + (bootstrap-make-slot-definition + name class slot wrapper effective-p index)) + slots))) + +(defun bootstrap-make-slot-definition (name class slot wrapper effective-p index) + (let* ((slotd-class-name (if effective-p + 'standard-effective-slot-definition + 'standard-direct-slot-definition)) + (slotd (allocate-standard-instance wrapper)) + (slot-name (getf slot :name))) + (flet ((get-val (name) (getf slot name)) + (set-val (name val) (bootstrap-set-slot slotd-class-name slotd name val))) + (set-val 'name slot-name) + (set-val 'initform (get-val :initform)) + (set-val 'initfunction (get-val :initfunction)) + (set-val 'initargs (get-val :initargs)) + (set-val 'readers (get-val :readers)) + (set-val 'writers (get-val :writers)) + (set-val 'allocation :instance) + (set-val 'type (or (get-val :type) t)) + (set-val 'documentation (or (get-val :documentation) "")) + (set-val 'class class) + (when effective-p + (set-val 'location index) + (let ((fsc-p nil)) + (set-val 'reader-function (make-optimized-std-reader-method-function + fsc-p slot-name index)) + (set-val 'writer-function (make-optimized-std-writer-method-function + fsc-p slot-name index)) + (set-val 'boundp-function (make-optimized-std-boundp-method-function + fsc-p slot-name index))) + (set-val 'accessor-flags 7) + (let ((table (or (gethash slot-name *name->class->slotd-table*) + (setf (gethash slot-name *name->class->slotd-table*) + (make-hash-table :test 'eq :size 5))))) + (setf (gethash class table) slotd))) + (when (and (eq name 'standard-class) + (eq slot-name 'slots) effective-p) + (setq *the-eslotd-standard-class-slots* slotd)) + (when (and (eq name 'funcallable-standard-class) + (eq slot-name 'slots) effective-p) + (setq *the-eslotd-funcallable-standard-class-slots* slotd)) + slotd))) + +(defun bootstrap-accessor-definitions (early-p) + (let ((*early-p* early-p)) + (dolist (definition *early-class-definitions*) + (let ((name (ecd-class-name definition)) + (meta (ecd-metaclass definition))) + (unless (eq meta 'built-in-class) + (let ((direct-slots (ecd-canonical-slots definition))) + (dolist (slotd direct-slots) + (let ((slot-name (getf slotd :name)) + (readers (getf slotd :readers)) + (writers (getf slotd :writers))) + (bootstrap-accessor-definitions1 name slot-name readers writers nil) + (bootstrap-accessor-definitions1 + 'slot-object + slot-name + (list (slot-reader-symbol slot-name)) + (list (slot-writer-symbol slot-name)) + (list (slot-boundp-symbol slot-name))))))))))) + +(defun bootstrap-accessor-definition (class-name accessor-name slot-name type) + (multiple-value-bind (accessor-class make-method-function arglist specls doc) + (ecase type + (reader (values 'standard-reader-method #'make-std-reader-method-function + (list class-name) (list class-name) + "automatically generated reader method")) + (writer (values 'standard-writer-method #'make-std-writer-method-function + (list 'new-value class-name) (list 't class-name) + "automatically generated writer method")) + (boundp (values 'standard-boundp-method #'make-std-boundp-method-function + (list class-name) (list class-name) + "automatically generated boundp method"))) + (let ((gf (ensure-generic-function accessor-name))) + (if (find specls (early-gf-methods gf) + :key #'early-method-specializers + :test #'equal) + (unless (assoc accessor-name *generic-function-fixups* + :test #'equal) + (update-dfun gf)) + (add-method gf + (make-a-method accessor-class + () + arglist specls + (funcall make-method-function + class-name slot-name) + doc + slot-name)))))) + +(defun bootstrap-accessor-definitions1 (class-name slot-name readers writers boundps) + (flet ((do-reader-definition (reader) + (bootstrap-accessor-definition class-name reader slot-name 'reader)) + (do-writer-definition (writer) + (bootstrap-accessor-definition class-name writer slot-name 'writer)) + (do-boundp-definition (boundp) + (bootstrap-accessor-definition class-name boundp slot-name 'boundp))) + (dolist (reader readers) (do-reader-definition reader)) + (dolist (writer writers) (do-writer-definition writer)) + (dolist (boundp boundps) (do-boundp-definition boundp)))) + +(defun bootstrap-class-predicates (early-p) + (let ((*early-p* early-p)) + (dolist (definition *early-class-definitions*) + (let* ((name (ecd-class-name definition)) + (class (find-class name))) + (setf (find-class-predicate name) + (make-class-predicate class (class-predicate-name class))))))) + +(defun bootstrap-built-in-classes () + ;; + ;; First make sure that all the supers listed in *built-in-class-lattice* + ;; are themselves defined by *built-in-class-lattice*. This is just to + ;; check for typos and other sorts of brainos. + ;; + (dolist (e *built-in-classes*) + (dolist (super (cadr e)) + (unless (or (eq super 't) + (assq super *built-in-classes*)) + (error "In *built-in-classes*: ~S has ~S as a super,~%~ + but ~S is not itself a class in *built-in-classes*." + (car e) super super)))) + + ;; + ;; In the first pass, we create a skeletal object to be bound to the + ;; class name. + ;; + (let* ((built-in-class (find-class 'built-in-class)) + (built-in-class-wrapper (class-wrapper built-in-class))) + (dolist (e *built-in-classes*) + (let ((class (allocate-standard-instance built-in-class-wrapper))) + (setf (find-class (car e)) class)))) + + ;; + ;; In the second pass, we initialize the class objects. + ;; + (let ((class-eq-wrapper (class-wrapper (find-class 'class-eq-specializer)))) + (dolist (e *built-in-classes*) + ; FIXME use regular destructuring-bind + (pcl-destructuring-bind (name supers subs cpl prototype) e + (let* ((class (find-class name)) + #+cmu17 + (lclass (lisp:find-class name)) + (wrapper #-cmu17(make-wrapper 0 class) + #+cmu17(kernel:class-layout lclass))) + (set (get-built-in-class-symbol name) class) + (set (get-built-in-wrapper-symbol name) wrapper) + #+cmu17 + (setf (kernel:class-pcl-class lclass) class) + #-cmu17 + (setf (wrapper-instance-slots-layout wrapper) () + (wrapper-class-slots wrapper) ()) + + (bootstrap-initialize-class 'built-in-class class + name class-eq-wrapper nil + supers subs + (cons name cpl) + wrapper prototype))))) + + (dolist (e *built-in-classes*) + (let* ((name (car e)) + (class (find-class name))) + (setf (find-class-predicate name) + (make-class-predicate class (class-predicate-name class)))))) + + +;;; +;;; +;;; +#-(or new-kcl-wrapper cmu17) +(progn +(defvar *built-in-or-structure-wrapper-table* + (make-hash-table :test 'eq)) + +(defvar wft-type1 nil) +(defvar wft-wrapper1 nil) +(defvar wft-type2 nil) +(defvar wft-wrapper2 nil) + +(defun wrapper-for-structure (x) + (let ((type (structure-type x))) + (when (symbolp type) + (cond ((eq type 'std-instance) + (return-from wrapper-for-structure (std-instance-wrapper x))) + ((eq type wft-type1) (return-from wrapper-for-structure wft-wrapper1)) + ((eq type wft-type2) (return-from wrapper-for-structure wft-wrapper2)) + (t (setq wft-type2 wft-type1 wft-wrapper2 wft-wrapper1)))) + (let* ((cell (find-class-cell type)) + (class (or (find-class-cell-class cell) + (let* (#+lucid + (*structure-type* type) + #+lucid + (*structure-length* (structure-length x type))) + (find-class-from-cell type cell)))) + (wrapper (if class (class-wrapper class) *the-wrapper-of-t*))) + (when (symbolp type) + (setq wft-type1 type wft-wrapper1 wrapper)) + wrapper))) + +(defun built-in-or-structure-wrapper1 (x) + (let ((biw (or (built-in-wrapper-of x) *the-wrapper-of-t*))) + (or (and (eq biw *the-wrapper-of-t*) + (structurep x) + (let* ((type (type-of x)) + #+lucid + (*structure-type* type) + #+lucid + (*structure-length* (structure-length x type)) + (class (find-class type nil))) + (and class (class-wrapper class)))) + biw))) +) + +#|| ; moved to low.lisp +(defmacro built-in-or-structure-wrapper (x) + (once-only (x) + (if (structure-functions-exist-p) ; otherwise structurep is too slow for this + `(if (structurep ,x) + (wrapper-for-structure ,x) + (if (symbolp ,x) + (if ,x *the-wrapper-of-symbol* *the-wrapper-of-null*) + (built-in-wrapper-of ,x))) + `(or (and (symbolp ,x) + (if ,x *the-wrapper-of-symbol* *the-wrapper-of-null*)) + (built-in-or-structure-wrapper1 ,x))))) + +#-cmu17 +(defmacro wrapper-of-macro (x) + `(cond ((std-instance-p ,x) + (std-instance-wrapper ,x)) + ((fsc-instance-p ,x) + (fsc-instance-wrapper ,x)) + (t + (#+new-kcl-wrapper built-in-wrapper-of + #-new-kcl-wrapper built-in-or-structure-wrapper + ,x)))) + +#+cmu17 +(defmacro wrapper-of-macro (x) + `(kernel:layout-of ,x)) +||# + +(defun class-of (x) + (wrapper-class* (wrapper-of-macro x))) + +#+cmu17 +(declaim (inline wrapper-of)) +(defun wrapper-of (x) + (wrapper-of-macro x)) + +#-cmu17 +(defun structure-wrapper (x) + (class-wrapper (find-class (structure-type x)))) + +(defvar find-structure-class nil) + +(defun eval-form (form) + #'(lambda () (eval form))) + +(defun slot-initargs-from-structure-slotd (slotd) + `(:name ,(structure-slotd-name slotd) + :defstruct-accessor-symbol ,(structure-slotd-accessor-symbol slotd) + :internal-reader-function ,(structure-slotd-reader-function slotd) + :internal-writer-function ,(structure-slotd-writer-function slotd) + :type ,(or (structure-slotd-type slotd) t) + :initform ,(structure-slotd-init-form slotd) + :initfunction ,(eval-form (structure-slotd-init-form slotd)))) + +(defun find-structure-class (symbol) + (if (structure-type-p symbol) + (unless (eq find-structure-class symbol) + (let ((find-structure-class symbol)) + (ensure-class symbol + :metaclass 'structure-class + :name symbol + :direct-superclasses + (when (structure-type-included-type-name symbol) + (list (structure-type-included-type-name symbol))) + :direct-slots + (mapcar #'slot-initargs-from-structure-slotd + (structure-type-slot-description-list symbol))))) + (error "~S is not a legal structure class name." symbol))) + +#-cmu17 +(eval-when (compile eval) + +(defun make-built-in-class-subs () + (mapcar #'(lambda (e) + (let ((class (car e)) + (class-subs ())) + (dolist (s *built-in-classes*) + (when (memq class (cadr s)) (pushnew (car s) class-subs))) + (cons class class-subs))) + (cons '(t) *built-in-classes*))) + +(defun make-built-in-class-tree () + (let ((subs (make-built-in-class-subs))) + (labels ((descend (class) + (cons class (mapcar #'descend (cdr (assq class subs)))))) + (descend 't)))) + +(defun make-built-in-wrapper-of-body () + (make-built-in-wrapper-of-body-1 (make-built-in-class-tree) + 'x + #'get-built-in-wrapper-symbol)) + +(defun make-built-in-wrapper-of-body-1 (tree var get-symbol) + (let ((*specials* ())) + (declare (special *specials*)) + (let ((inner (make-built-in-wrapper-of-body-2 tree var get-symbol))) + `(locally (declare (special .,*specials*)) ,inner)))) + +(defun make-built-in-wrapper-of-body-2 (tree var get-symbol) + (declare (special *specials*)) + (let ((symbol (funcall get-symbol (car tree)))) + (push symbol *specials*) + (let ((sub-tests + (mapcar #'(lambda (x) + (make-built-in-wrapper-of-body-2 x var get-symbol)) + (cdr tree)))) + `(and (typep ,var ',(car tree)) + ,(if sub-tests + `(or ,.sub-tests ,symbol) + symbol))))) +) + +#-cmu17 +(defun built-in-wrapper-of (x) + #.(when (fboundp 'make-built-in-wrapper-of-body) ; so we can at least read this file + (make-built-in-wrapper-of-body))) + + + +(defun method-function-returning-nil (args next-methods) + (declare (ignore args next-methods)) + nil) + +(defun method-function-returning-t (args next-methods) + (declare (ignore args next-methods)) + t) + +(defun make-class-predicate (class name) + (let* ((gf (ensure-generic-function name)) + (mlist (if (eq *boot-state* 'complete) + (generic-function-methods gf) + (early-gf-methods gf)))) + (unless mlist + (unless (eq class *the-class-t*) + (let* ((default-method-function #'method-function-returning-nil) + (default-method-initargs (list :function + default-method-function)) + (default-method (make-a-method 'standard-method + () + (list 'object) + (list *the-class-t*) + default-method-initargs + "class predicate default method"))) + (setf (method-function-get default-method-function :constant-value) nil) + (add-method gf default-method))) + (let* ((class-method-function #'method-function-returning-t) + (class-method-initargs (list :function + class-method-function)) + (class-method (make-a-method 'standard-method + () + (list 'object) + (list class) + class-method-initargs + "class predicate class method"))) + (setf (method-function-get class-method-function :constant-value) t) + (add-method gf class-method))) + gf)) + + +#+cmu17 +;;; Set inherits from CPL and register layout. This actually installs the +;;; class in the lisp type system. +;;; +(defun update-lisp-class-layout (class layout) + (unless (eq (kernel:class-layout (kernel:layout-class layout)) + layout) + (setf (kernel:layout-inherits layout) + (map 'vector #'class-wrapper + (reverse (rest (class-precedence-list class))))) + + (kernel:register-layout layout :invalidate nil))) + +(eval-when (load eval) + (clrhash *find-class*) + (bootstrap-meta-braid) + (bootstrap-accessor-definitions t) + (bootstrap-class-predicates t) + (bootstrap-accessor-definitions nil) + (bootstrap-class-predicates nil) + (bootstrap-built-in-classes) + + #+cmu17 + (ext:do-hash (name x *find-class*) + (let* ((class (find-class-from-cell name x)) + (layout (class-wrapper class)) + (lclass (kernel:layout-class layout)) + (lclass-pcl-class (kernel:class-pcl-class lclass)) + (olclass (lisp:find-class name nil))) + (if lclass-pcl-class + (assert (eq class lclass-pcl-class)) + (setf (kernel:class-pcl-class lclass) class)) + + (update-lisp-class-layout class layout) + + (cond (olclass + (assert (eq lclass olclass))) + (t + (setf (lisp:find-class name) lclass))))) + + (setq *boot-state* 'braid) + ) + +#-cmu17 +(deftype slot-object () + '(or standard-object structure-object)) + +(defmethod no-applicable-method (generic-function &rest args) + (cerror "Retry call to ~S" + "No matching method for the generic-function ~S,~@ + when called with arguments ~S." + generic-function args) + (apply generic-function args)) diff --git a/pcl/gcl_pcl_cache.lisp b/pcl/gcl_pcl_cache.lisp new file mode 100644 index 0000000..160a2c7 --- /dev/null +++ b/pcl/gcl_pcl_cache.lisp @@ -0,0 +1,1689 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; The basics of the PCL wrapper cache mechanism. +;;; + +(in-package :pcl) +;;; +;;; The caching algorithm implemented: +;;; +;;; << put a paper here >> +;;; +;;; For now, understand that as far as most of this code goes, a cache has +;;; two important properties. The first is the number of wrappers used as +;;; keys in each cache line. Throughout this code, this value is always +;;; called NKEYS. The second is whether or not the cache lines of a cache +;;; store a value. Throughout this code, this always called VALUEP. +;;; +;;; Depending on these values, there are three kinds of caches. +;;; +;;; NKEYS = 1, VALUEP = NIL +;;; +;;; In this kind of cache, each line is 1 word long. No cache locking is +;;; needed since all read's in the cache are a single value. Nevertheless +;;; line 0 (location 0) is reserved, to ensure that invalid wrappers will +;;; not get a first probe hit. +;;; +;;; To keep the code simpler, a cache lock count does appear in location 0 +;;; of these caches, that count is incremented whenever data is written to +;;; the cache. But, the actual lookup code (see make-dlap) doesn't need to +;;; do locking when reading the cache. +;;; +;;; +;;; NKEYS = 1, VALUEP = T +;;; +;;; In this kind of cache, each line is 2 words long. Cache locking must +;;; be done to ensure the synchronization of cache reads. Line 0 of the +;;; cache (location 0) is reserved for the cache lock count. Location 1 +;;; of the cache is unused (in effect wasted). +;;; +;;; NKEYS > 1 +;;; +;;; In this kind of cache, the 0 word of the cache holds the lock count. +;;; The 1 word of the cache is line 0. Line 0 of these caches is not +;;; reserved. +;;; +;;; This is done because in this sort of cache, the overhead of doing the +;;; cache probe is high enough that the 1+ required to offset the location +;;; is not a significant cost. In addition, because of the larger line +;;; sizes, the space that would be wasted by reserving line 0 to hold the +;;; lock count is more significant. +;;; + +;;; +;;; Caches +;;; +;;; A cache is essentially just a vector. The use of the individual `words' +;;; in the vector depends on particular properties of the cache as described +;;; above. +;;; +;;; This defines an abstraction for caches in terms of their most obvious +;;; implementation as simple vectors. But, please notice that part of the +;;; implementation of this abstraction, is the function lap-out-cache-ref. +;;; This means that most port-specific modifications to the implementation +;;; of caches will require corresponding port-specific modifications to the +;;; lap code assembler. +;;; +;; #+gcl(import 'si::non-negative-fixnum) + +(defmacro cache-vector-ref (cache-vector location) + `(svref (the simple-vector ,cache-vector) + (#-cmu the #+cmu ext:truly-the non-negative-fixnum ,location))) + +(defmacro cache-vector-size (cache-vector) + `(array-dimension (the simple-vector ,cache-vector) 0)) + +(defun allocate-cache-vector (size) + (make-array size :adjustable nil)) + +(defmacro cache-vector-lock-count (cache-vector) + `(cache-vector-ref ,cache-vector 0)) + +(defun flush-cache-vector-internal (cache-vector) + (without-interrupts + (fill (the simple-vector cache-vector) nil) + (setf (cache-vector-lock-count cache-vector) 0)) + cache-vector) + +;; FIXME 64 +(defconstant rand-base (- (ash 1 31) 1)) + +(defmacro modify-cache (cache-vector &body body) + `(without-interrupts + (multiple-value-prog1 + (progn ,@body) + (let ((old-count (cache-vector-lock-count ,cache-vector))) + (declare (type non-negative-fixnum old-count)) + (setf (cache-vector-lock-count ,cache-vector) + (if (= old-count rand-base) + 1 (the non-negative-fixnum (1+ old-count)))))))) + +(deftype field-type () + '(integer 0 ;#.(position 'number wrapper-layout) + 7)) ;#.(position 'number wrapper-layout :from-end t) + +(eval-when (compile load eval) +(defun power-of-two-ceiling (x) + (declare (type (and fixnum (integer 1 *)) x)) + ;;(expt 2 (ceiling (log x 2))) + (the non-negative-fixnum (ash 1 (integer-length (1- x))))) + +(defconstant *nkeys-limit* 255) +) + +(defstruct (cache + (:print-function print-cache) + (:constructor make-cache ()) + (:copier copy-cache-internal)) + (owner nil) + (nkeys 1 :type (integer 1 #.*nkeys-limit*)) + (valuep nil :type boolean) + (nlines 0 :type non-negative-fixnum) + (field 0 :type field-type) + (limit-fn #'default-limit-fn :type function) + (mask 0 :type non-negative-fixnum) + (size 0 :type non-negative-fixnum) + (line-size 1 :type (integer 1 #.(power-of-two-ceiling (1+ *nkeys-limit*)))) + (max-location 0 :type non-negative-fixnum) + (vector #() :type simple-vector) + (overflow nil :type list)) + +#+cmu +(declaim (ext:freeze-type cache)) + +(defun print-cache (cache stream depth) + (declare (ignore depth)) + (printing-random-thing (cache stream) + (format stream "cache ~D ~S ~D" + (cache-nkeys cache) (cache-valuep cache) (cache-nlines cache)))) + +#+akcl +(si::freeze-defstruct 'cache) + +(defmacro cache-lock-count (cache) + `(cache-vector-lock-count (cache-vector ,cache))) + + +;;; +;;; Some facilities for allocation and freeing caches as they are needed. +;;; This is done on the assumption that a better port of PCL will arrange +;;; to cons these all the same static area. Given that, the fact that +;;; PCL tries to reuse them should be a win. +;;; +(defvar *free-cache-vectors* (make-hash-table :size 16 :test 'eql)) + +;;; +;;; Return a cache that has had flush-cache-vector-internal called on it. This +;;; returns a cache of exactly the size requested, it won't ever return a +;;; larger cache. +;;; +(defun get-cache-vector (size) + (let ((entry (gethash size *free-cache-vectors*))) + (without-interrupts + (cond ((null entry) + (setf (gethash size *free-cache-vectors*) (cons 0 nil)) + (get-cache-vector size)) + ((null (cdr entry)) + (incf (car entry)) + (flush-cache-vector-internal (allocate-cache-vector size))) + (t + (let ((cache (cdr entry))) + (setf (cdr entry) (cache-vector-ref cache 0)) + (flush-cache-vector-internal cache))))))) + +(defun free-cache-vector (cache-vector) + (let ((entry (gethash (cache-vector-size cache-vector) *free-cache-vectors*))) + (without-interrupts + (if (null entry) + (error "Attempt to free a cache-vector not allocated by GET-CACHE-VECTOR.") + (let ((thread (cdr entry))) + (loop (unless thread (return)) + (when (eq thread cache-vector) (error "Freeing a cache twice.")) + (setq thread (cache-vector-ref thread 0))) + (flush-cache-vector-internal cache-vector) ;Help the GC + (setf (cache-vector-ref cache-vector 0) (cdr entry)) + (setf (cdr entry) cache-vector) + nil))))) + +;;; +;;; This is just for debugging and analysis. It shows the state of the free +;;; cache resource. +;;; +(defun show-free-cache-vectors () + (let ((elements ())) + (maphash #'(lambda (s e) (push (list s e) elements)) *free-cache-vectors*) + (setq elements (sort elements #'< :key #'car)) + (dolist (e elements) + (let* ((size (car e)) + (entry (cadr e)) + (allocated (car entry)) + (head (cdr entry)) + (free 0)) + (loop (when (null head) (return t)) + (setq head (cache-vector-ref head 0)) + (incf free)) + (format t + "~&There ~4D are caches of size ~4D. (~D free ~3D%)" + allocated + size + free + (floor (* 100 (/ free (float allocated))))))))) + + +;;; +;;; Wrapper cache numbers +;;; + +;;; +;;; The constant WRAPPER-CACHE-NUMBER-ADDS-OK controls the number of non-zero +;;; bits wrapper cache numbers will have. +;;; +;;; The value of this constant is the number of wrapper cache numbers which +;;; can be added and still be certain the result will be a fixnum. This is +;;; used by all the code that computes primary cache locations from multiple +;;; wrappers. +;;; +;;; The value of this constant is used to derive the next two which are the +;;; forms of this constant which it is more convenient for the runtime code +;;; to use. +;;; +#-cmu17 +(eval-when (compile load eval) + +(defconstant wrapper-cache-number-adds-ok 4) + +;;; Incorrect. This actually allows 15 or 16 adds, depending on whether +;;; most-positive-fixnum is all-ones. -- Ram +;;; +(defconstant wrapper-cache-number-length + (- (integer-length rand-base) + wrapper-cache-number-adds-ok)) + +(defconstant wrapper-cache-number-mask + (1- (expt 2 wrapper-cache-number-length))) + + +(defvar *get-wrapper-cache-number* (make-random-state)) + +(defun get-wrapper-cache-number () + (let ((n 0)) + (declare (type non-negative-fixnum n)) + (loop + (setq n + (logand wrapper-cache-number-mask + (random rand-base *get-wrapper-cache-number*))) + (unless (zerop n) (return n))))) + + +(unless (> wrapper-cache-number-length 8) + (error "In this implementation of Common Lisp, fixnums are so small that~@ + wrapper cache numbers end up being only ~D bits long. This does~@ + not actually keep PCL from running, but it may degrade cache~@ + performance.~@ + You may want to consider changing the value of the constant~@ + WRAPPER-CACHE-NUMBER-ADDS-OK."))) + +#+cmu17 +(progn + (defconstant wrapper-cache-number-length + (integer-length kernel:layout-hash-max)) + + (defconstant wrapper-cache-number-mask kernel:layout-hash-max) + + (defconstant wrapper-cache-number-adds-ok + (truncate most-positive-fixnum kernel:layout-hash-max))) + + +;;; +;;; wrappers themselves +;;; +;;; This caching algorithm requires that wrappers have more than one wrapper +;;; cache number. You should think of these multiple numbers as being in +;;; columns. That is, for a given cache, the same column of wrapper cache +;;; numbers will be used. +;;; +;;; If at some point the cache distribution of a cache gets bad, the cache +;;; can be rehashed by switching to a different column. +;;; +;;; The columns are referred to by field number which is that number which, +;;; when used as a second argument to wrapper-ref, will return that column +;;; of wrapper cache number. +;;; +;;; This code is written to allow flexibility as to how many wrapper cache +;;; numbers will be in each wrapper, and where they will be located. It is +;;; also set up to allow port specific modifications to `pack' the wrapper +;;; cache numbers on machines where the addressing modes make that a good +;;; idea. +;;; +#-structure-wrapper +(progn +(eval-when (compile load eval) +(defconstant wrapper-layout + '(number + number + number + number + number + number + number + number + state + instance-slots-layout + class-slots + class + no-of-instance-slots)) +) + +(eval-when (compile load eval) + +(defun wrapper-field (type) + (posq type wrapper-layout)) + +(defun next-wrapper-field (field-number) + (position (nth field-number wrapper-layout) + wrapper-layout + :start (1+ field-number))) + +(defmacro first-wrapper-cache-number-index () + `(wrapper-field 'number)) + +(defmacro next-wrapper-cache-number-index (field-number) + `(next-wrapper-field ,field-number)) + +);eval-when + +(defmacro wrapper-cache-number-vector (wrapper) + wrapper) + +(defmacro cache-number-vector-ref (cnv n) + `(svref ,cnv ,n)) + + +(defmacro wrapper-ref (wrapper n) + `(svref ,wrapper ,n)) + +(defmacro wrapper-state (wrapper) + `(wrapper-ref ,wrapper ,(wrapper-field 'state))) + +(defmacro wrapper-instance-slots-layout (wrapper) + `(wrapper-ref ,wrapper ,(wrapper-field 'instance-slots-layout))) + +(defmacro wrapper-class-slots (wrapper) + `(wrapper-ref ,wrapper ,(wrapper-field 'class-slots))) + +(defmacro wrapper-class (wrapper) + `(wrapper-ref ,wrapper ,(wrapper-field 'class))) + +(defmacro wrapper-no-of-instance-slots (wrapper) + `(wrapper-ref ,wrapper ,(wrapper-field 'no-of-instance-slots))) + +(defmacro make-wrapper-internal () + `(let ((wrapper (make-array ,(length wrapper-layout) :adjustable nil))) + ,@(gathering1 (collecting) + (iterate ((i (interval :from 0)) + (desc (list-elements wrapper-layout))) + (ecase desc + (number + (gather1 `(setf (wrapper-ref wrapper ,i) + (get-wrapper-cache-number)))) + ((state instance-slots-layout class-slots class no-of-instance-slots))))) + (setf (wrapper-state wrapper) 't) + wrapper)) + +(defun make-wrapper (no-of-instance-slots &optional class) + (let ((wrapper (make-wrapper-internal))) + (setf (wrapper-no-of-instance-slots wrapper) no-of-instance-slots) + (setf (wrapper-class wrapper) class) + wrapper)) + +) + +; In CMUCL we want to do type checking as early as possible; structures help this. +#+structure-wrapper +(eval-when (compile load eval) + +(defconstant wrapper-cache-number-vector-length + #+cmu17 kernel:layout-hash-length #-cmu17 8) + +#-cmu17 +(deftype cache-number-vector () + `(simple-array fixnum (,wrapper-cache-number-vector-length))) + +(defconstant wrapper-layout (make-list wrapper-cache-number-vector-length + :initial-element 'number)) + +) + +(defmacro mdotimes ((var form &optional ret) &rest body &aux (v (gensym))) + `(do ((,v ,form) + (,var 0 (1+ ,var))) + ((>= ,var ,v) ,ret) + (declare (fixnum ,var ,v)) + ,@body)) + +#+structure-wrapper +(progn + +#-(or new-kcl-wrapper cmu17) +(defun make-wrapper-cache-number-vector () + (let ((cnv (make-array #.wrapper-cache-number-vector-length + :element-type 'fixnum))) + (mdotimes (i #.wrapper-cache-number-vector-length) + (setf (aref cnv i) (get-wrapper-cache-number))) + cnv)) + + +#-cmu17 +(defstruct (wrapper + #+new-kcl-wrapper (:include si::basic-wrapper) + (:print-function print-wrapper) + #-new-kcl-wrapper + (:constructor make-wrapper (no-of-instance-slots &optional class)) + #+new-kcl-wrapper + (:constructor make-wrapper-internal)) + #-new-kcl-wrapper + (cache-number-vector (make-wrapper-cache-number-vector) + :type cache-number-vector) + #-new-kcl-wrapper + (state t :type (or (member t) cons)) + ;; either t or a list (state-sym new-wrapper) + ;; where state-sym is either :flush or :obsolete + (instance-slots-layout nil :type list) + (class-slots nil :type list) + #-new-kcl-wrapper + (no-of-instance-slots 0 :type fixnum) + #-new-kcl-wrapper + (class *the-class-t* :type class)) + + +(unless (boundp '*the-class-t*) (setq *the-class-t* nil)) + +#+new-kcl-wrapper +(defmacro wrapper-no-of-instance-slots (wrapper) + `(si::s-data-length ,wrapper)) + + +;;; Note that for CMU, the WRAPPER of a built-in or structure class will be +;;; some other kind of KERNEL:LAYOUT, but this shouldn't matter, since the only +;;; two slots that WRAPPER adds are meaningless in those cases. +;;; +#+cmu17 +(progn + (defstruct (wrapper + (:include kernel:layout) + (:conc-name %wrapper-) + (:print-function print-wrapper) + (:constructor make-wrapper-internal)) + (instance-slots-layout nil :type list) + (class-slots nil :type list)) + (declaim (ext:freeze-type wrapper)) + + (defmacro wrapper-class (wrapper) + `(kernel:class-pcl-class (kernel:layout-class ,wrapper))) + (defmacro wrapper-no-of-instance-slots (wrapper) + `(kernel:layout-length ,wrapper)) + (declaim (inline wrapper-state (setf wrapper-state))) + + (defun wrapper-state (wrapper) + (let ((invalid (kernel:layout-invalid wrapper))) + (cond ((null invalid) + t) + ((atom invalid) + ;; Some non-pcl object. invalid is probably :INVALID + ;; We should compute the new wrapper here instead + ;; of returning nil, but why bother, since + ;; obsolete-instance-trap can't use it. + '(:obsolete nil)) + (t + invalid)))) + + (defun (setf wrapper-state) (new-value wrapper) + (setf (kernel:layout-invalid wrapper) + (if (eq new-value 't) + nil + new-value))) + + (defmacro wrapper-instance-slots-layout (wrapper) + `(%wrapper-instance-slots-layout ,wrapper)) + (defmacro wrapper-class-slots (wrapper) + `(%wrapper-class-slots ,wrapper)) + (defmacro wrapper-cache-number-vector (x) x)) + + +#+new-kcl-wrapper +(defun make-wrapper (size &optional class) + (multiple-value-bind (raw slot-positions) + (if (< size 50) + (values si::*all-t-s-type* si::*standard-slot-positions*) + (values (make-array size :element-type 'unsigned-char) + (let ((array (make-array size :element-type 'unsigned-short))) + (mdotimes (i size) + (declare (fixnum i)) + (setf (aref array i) (* #.(si::size-of t) i)))))) + (make-wrapper-internal :length size + :raw raw + :print-function 'print-std-instance + :slot-position slot-positions + :size (* size #.(si::size-of t)) + :class class))) + +#+cmu17 +;;; BOOT-MAKE-WRAPPER -- Interface +;;; +;;; Called in BRAID when we are making wrappers for classes whose slots are +;;; not initialized yet, and which may be built-in classes. We pass in the +;;; class name in addition to the class. +;;; +(defun boot-make-wrapper (length name &optional class) + (let ((found (lisp:find-class name nil))) + (cond + (found + (unless (kernel:class-pcl-class found) + (setf (kernel:class-pcl-class found) class)) + (assert (eq (kernel:class-pcl-class found) class)) + (let ((layout (kernel:class-layout found))) + (assert layout) + layout)) + (t + (kernel:initialize-layout-hash + (make-wrapper-internal + :length length + :class (kernel:make-standard-class :name name :pcl-class class))))))) + + +#+cmu17 +;;; MAKE-WRAPPER -- Interface +;;; +;;; In CMU CL, the layouts (a.k.a wrappers) for built-in and structure +;;; classes already exist when PCL is initialized, so we don't necessarily +;;; always make a wrapper. Also, we help maintain the mapping between +;;; lisp:class and pcl::class objects. +;;; +(defun make-wrapper (length class) + (cond + ((typep class 'std-class) + (kernel:initialize-layout-hash + (make-wrapper-internal + :length length + :class + (let ((owrap (class-wrapper class))) + (cond (owrap + (kernel:layout-class owrap)) + ((*subtypep (class-of class) + *the-class-standard-class*) + (kernel:make-standard-class :pcl-class class)) + (t + (kernel:make-random-pcl-class :pcl-class class))))))) + (t + (let* ((found (lisp:find-class (slot-value class 'name))) + (layout (kernel:class-layout found))) + (unless (kernel:class-pcl-class found) + (setf (kernel:class-pcl-class found) class)) + (assert (eq (kernel:class-pcl-class found) class)) + (assert layout) + layout)))) + +(defun print-wrapper (wrapper stream depth) + (declare (ignore depth)) + (printing-random-thing (wrapper stream) + (format stream "Wrapper ~S" (wrapper-class wrapper)))) + +(defmacro first-wrapper-cache-number-index () + 0) + +(defmacro next-wrapper-cache-number-index (field-number) + `(and (< (the field-type ,field-number) + #.(1- wrapper-cache-number-vector-length)) + (the field-type (1+ (the field-type ,field-number))))) + +#-cmu17 +(defmacro cache-number-vector-ref (cnv n) + `(#-kcl svref #+kcl aref ,cnv ,n)) + +#+cmu17 +(defmacro cache-number-vector-ref (cnv n) + `(wrapper-cache-number-vector-ref ,cnv ,n)) + +) + +#-cmu17 +(defmacro wrapper-cache-number-vector-ref (wrapper n) + `(the fixnum + (#-structure-wrapper svref #+structure-wrapper aref + (wrapper-cache-number-vector ,wrapper) ,n))) +#+cmu17 +(defmacro wrapper-cache-number-vector-ref (wrapper n) + `(kernel:layout-hash ,wrapper ,n)) + +(defmacro class-no-of-instance-slots (class) + `(wrapper-no-of-instance-slots (class-wrapper ,class))) + +(defmacro wrapper-class* (wrapper) + #-(or new-kcl-wrapper cmu17) + `(wrapper-class ,wrapper) + #+(or new-kcl-wrapper cmu17) + `(let ((wrapper ,wrapper)) + (or (wrapper-class wrapper) + (find-structure-class + #+new-kcl-wrapper (si::s-data-name wrapper) + #+cmu17 (lisp:class-name (kernel:layout-class wrapper)))))) + +;;; +;;; The wrapper cache machinery provides general mechanism for trapping on +;;; the next access to any instance of a given class. This mechanism is +;;; used to implement the updating of instances when the class is redefined +;;; (make-instances-obsolete). The same mechanism is also used to update +;;; generic function caches when there is a change to the supers of a class. +;;; +;;; Basically, a given wrapper can be valid or invalid. If it is invalid, +;;; it means that any attempt to do a wrapper cache lookup using the wrapper +;;; should trap. Also, methods on slot-value-using-class check the wrapper +;;; validity as well. This is done by calling check-wrapper-validity. +;;; + +(defmacro invalid-wrapper-p (wrapper) + `(neq (wrapper-state ,wrapper) 't)) + +(defvar *previous-nwrappers* (make-hash-table)) + +(defun invalidate-wrapper (owrapper state nwrapper) + (ecase state + ((:flush :obsolete) + (let ((new-previous ())) + ;; + ;; First off, a previous call to invalidate-wrapper may have recorded + ;; owrapper as an nwrapper to update to. Since owrapper is about to + ;; be invalid, it no longer makes sense to update to it. + ;; + ;; We go back and change the previously invalidated wrappers so that + ;; they will now update directly to nwrapper. This corresponds to a + ;; kind of transitivity of wrapper updates. + ;; + (dolist (previous (gethash owrapper *previous-nwrappers*)) + (when (eq state ':obsolete) + (setf (car previous) ':obsolete)) + (setf (cadr previous) nwrapper) + (push previous new-previous)) + + (let ((ocnv (wrapper-cache-number-vector owrapper))) + (iterate ((type (list-elements wrapper-layout)) + (i (interval :from 0))) + (when (eq type 'number) (setf (cache-number-vector-ref ocnv i) 0)))) + (push (setf (wrapper-state owrapper) (list state nwrapper)) + new-previous) + + (setf (gethash owrapper *previous-nwrappers*) () + (gethash nwrapper *previous-nwrappers*) new-previous))))) + +(defun check-wrapper-validity (instance) + (let* ((owrapper (wrapper-of instance)) + (state (wrapper-state owrapper))) + (if (eq state 't) + owrapper + (let ((nwrapper + (ecase (car state) + (:flush + (flush-cache-trap owrapper (cadr state) instance)) + (:obsolete + (obsolete-instance-trap owrapper (cadr state) instance))))) + ;; + ;; This little bit of error checking is superfluous. It only + ;; checks to see whether the person who implemented the trap + ;; handling screwed up. Since that person is hacking internal + ;; PCL code, and is not a user, this should be needless. Also, + ;; since this directly slows down instance update and generic + ;; function cache refilling, feel free to take it out sometime + ;; soon. + ;; + (cond ((neq nwrapper (wrapper-of instance)) + (error "Wrapper returned from trap not wrapper of instance.")) + ((invalid-wrapper-p nwrapper) + (error "Wrapper returned from trap invalid."))) + nwrapper)))) + +#-cmu17 +(defmacro check-wrapper-validity1 (object) + (let ((owrapper (gensym))) + `(let ((,owrapper (cond ((std-instance-p ,object) + (std-instance-wrapper ,object)) + ((fsc-instance-p ,object) + (fsc-instance-wrapper ,object)) + #+new-kcl-wrapper + (t (built-in-wrapper-of ,object)) + #-new-kcl-wrapper + (t (wrapper-of ,object))))) + (if (eq 't (wrapper-state ,owrapper)) + ,owrapper + (check-wrapper-validity ,object))))) + +#+cmu17 +;;; semantically equivalent, but faster. +;;; +(defmacro check-wrapper-validity1 (object) + (let ((owrapper (gensym))) + `(let ((,owrapper (kernel:layout-of object))) + (if (kernel:layout-invalid ,owrapper) + (check-wrapper-validity ,object) + ,owrapper)))) + + +(defvar *free-caches* nil) + +(defun get-cache (nkeys valuep limit-fn nlines) + (declare (type non-negative-fixnum nlines)) + (let ((cache (or (without-interrupts (pop *free-caches*)) (make-cache)))) + (declare (type cache cache)) + (multiple-value-bind (cache-mask actual-size line-size nlines) + (compute-cache-parameters nkeys valuep nlines) + (declare (type non-negative-fixnum + cache-mask actual-size line-size nlines)) + (setf (cache-nkeys cache) nkeys + (cache-valuep cache) valuep + (cache-nlines cache) nlines + (cache-field cache) (first-wrapper-cache-number-index) + (cache-limit-fn cache) limit-fn + (cache-mask cache) cache-mask + (cache-size cache) actual-size + (cache-line-size cache) line-size + (cache-max-location cache) + (let ((line (1- nlines))) + (declare (type non-negative-fixnum line)) + (if (= nkeys 1) + (the fixnum (* line line-size)) + (the fixnum (1+ (the fixnum (* line line-size)))))) + (cache-vector cache) (get-cache-vector actual-size) + (cache-overflow cache) nil) + cache))) + +(defun get-cache-from-cache (old-cache new-nlines + &optional (new-field (first-wrapper-cache-number-index))) + (declare (type non-negative-fixnum new-nlines)) + (let ((nkeys (cache-nkeys old-cache)) + (valuep (cache-valuep old-cache)) + (cache (or (without-interrupts (pop *free-caches*)) (make-cache)))) + (declare (type cache cache)) + (multiple-value-bind (cache-mask actual-size line-size nlines) + (if (= new-nlines (cache-nlines old-cache)) + (values (cache-mask old-cache) (cache-size old-cache) + (cache-line-size old-cache) (cache-nlines old-cache)) + (compute-cache-parameters nkeys valuep new-nlines)) + (declare (type non-negative-fixnum + cache-mask actual-size line-size nlines)) + (setf (cache-owner cache) (cache-owner old-cache) + (cache-nkeys cache) nkeys + (cache-valuep cache) valuep + (cache-nlines cache) nlines + (cache-field cache) new-field + (cache-limit-fn cache) (cache-limit-fn old-cache) + (cache-mask cache) cache-mask + (cache-size cache) actual-size + (cache-line-size cache) line-size + (cache-max-location cache) + (let ((line (1- nlines))) + (declare (type non-negative-fixnum line)) + (if (= nkeys 1) + (the fixnum (* line line-size)) + (the fixnum (1+ (the fixnum (* line line-size)))))) + (cache-vector cache) (get-cache-vector actual-size) + (cache-overflow cache) nil) + cache))) + +(defun copy-cache (old-cache) + (let* ((new-cache (copy-cache-internal old-cache)) + (size (cache-size old-cache)) + (old-vector (cache-vector old-cache)) + (new-vector (get-cache-vector size))) + (declare (simple-vector old-vector new-vector)) + (mdotimes (i size) + (setf (svref new-vector i) (svref old-vector i))) + (setf (cache-vector new-cache) new-vector) + new-cache)) + +(defun free-cache (cache) + (free-cache-vector (cache-vector cache)) + (setf (cache-vector cache) #()) + (setf (cache-owner cache) nil) + (push cache *free-caches*) + nil) + +(defun compute-line-size (x) + (power-of-two-ceiling x)) + +(defun compute-cache-parameters (nkeys valuep nlines-or-cache-vector) + ;;(declare (values cache-mask actual-size line-size nlines)) + (declare (type non-negative-fixnum nkeys)) + (if (= nkeys 1) + (let* ((line-size (if valuep 2 1)) + (cache-size (if (typep nlines-or-cache-vector 'fixnum) + (the non-negative-fixnum + (* line-size + (the non-negative-fixnum + (power-of-two-ceiling + nlines-or-cache-vector)))) + (cache-vector-size nlines-or-cache-vector)))) + (declare (type non-negative-fixnum line-size cache-size)) + (values (logxor (the non-negative-fixnum (1- cache-size)) + (the non-negative-fixnum (1- line-size))) + cache-size + line-size + (the non-negative-fixnum (floor cache-size line-size)))) + (let* ((line-size (power-of-two-ceiling (if valuep (1+ nkeys) nkeys))) + (cache-size (if (typep nlines-or-cache-vector 'fixnum) + (the non-negative-fixnum + (* line-size + (the non-negative-fixnum + (power-of-two-ceiling + nlines-or-cache-vector)))) + (1- (cache-vector-size nlines-or-cache-vector))))) + (declare (type non-negative-fixnum line-size cache-size)) + (values (logxor (the non-negative-fixnum (1- cache-size)) + (the non-negative-fixnum (1- line-size))) + (the non-negative-fixnum (1+ cache-size)) + line-size + (the non-negative-fixnum (floor cache-size line-size)))))) + + + +;;; +;;; The various implementations of computing a primary cache location from +;;; wrappers. Because some implementations of this must run fast there are +;;; several implementations of the same algorithm. +;;; +;;; The algorithm is: +;;; +;;; SUM over the wrapper cache numbers, +;;; ENSURING that the result is a fixnum +;;; MASK the result against the mask argument. +;;; +;;; + +;;; +;;; COMPUTE-PRIMARY-CACHE-LOCATION +;;; +;;; The basic functional version. This is used by the cache miss code to +;;; compute the primary location of an entry. +;;; +(defun compute-primary-cache-location (field mask wrappers) + (declare (type field-type field) (type non-negative-fixnum mask)) + (if (not (listp wrappers)) + (logand mask (the non-negative-fixnum + (wrapper-cache-number-vector-ref wrappers field))) + (let ((location 0) (i 0)) + (declare (type non-negative-fixnum location i)) + (dolist (wrapper wrappers) + ;; + ;; First add the cache number of this wrapper to location. + ;; + (let ((wrapper-cache-number + (wrapper-cache-number-vector-ref wrapper field))) + (declare (type non-negative-fixnum wrapper-cache-number)) + (if (zerop wrapper-cache-number) + (return-from compute-primary-cache-location 0) + (setq location (the non-negative-fixnum + (+ location wrapper-cache-number))))) + ;; + ;; Then, if we are working with lots of wrappers, deal with + ;; the wrapper-cache-number-mask stuff. + ;; + (when (and (not (zerop i)) + (zerop (mod i wrapper-cache-number-adds-ok))) + (setq location + (logand location wrapper-cache-number-mask))) + (incf i)) + (the non-negative-fixnum (1+ (logand mask location)))))) + +;;; +;;; COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION +;;; +;;; This version is called on a cache line. It fetches the wrappers from +;;; the cache line and determines the primary location. Various parts of +;;; the cache filling code call this to determine whether it is appropriate +;;; to displace a given cache entry. +;;; +;;; If this comes across a wrapper whose cache-no is 0, it returns the symbol +;;; invalid to suggest to its caller that it would be provident to blow away +;;; the cache line in question. +;;; +(defun compute-primary-cache-location-from-location (to-cache from-location + &optional (from-cache to-cache)) + (declare (type cache to-cache from-cache) + (type non-negative-fixnum from-location)) + (let ((result 0) + (cache-vector (cache-vector from-cache)) + (field (cache-field to-cache)) + (mask (cache-mask to-cache)) + (nkeys (cache-nkeys to-cache))) + (declare (type field-type field) + (type non-negative-fixnum result mask nkeys) + (simple-vector cache-vector)) + (mdotimes (i nkeys) + (let* ((wrapper (cache-vector-ref cache-vector (+ i from-location))) + (wcn (wrapper-cache-number-vector-ref wrapper field))) + (declare (type non-negative-fixnum wcn)) + (setq result (+ result wcn))) + (when (and (not (zerop i)) + (zerop (mod i wrapper-cache-number-adds-ok))) + (setq result (logand result wrapper-cache-number-mask)))) + (if (= nkeys 1) + (logand mask result) + (the non-negative-fixnum (1+ (logand mask result)))))) + + +;;; +;;; NIL means nothing so far, no actual arg info has NILs +;;; in the metatype +;;; CLASS seen all sorts of metaclasses +;;; (specifically, more than one of the next 4 values) +;;; T means everything so far is the class T +;;; STANDARD-CLASS seen only standard classes +;;; BUILT-IN-CLASS seen only built in classes +;;; STRUCTURE-CLASS seen only structure classes +;;; +(defun raise-metatype (metatype new-specializer) + (let ((slot (find-class 'slot-class)) + (standard (find-class 'standard-class)) + (fsc (find-class 'funcallable-standard-class)) + (structure (find-class 'structure-class)) + (built-in (find-class 'built-in-class))) + (flet ((specializer->metatype (x) + (let ((meta-specializer + (if (eq *boot-state* 'complete) + (class-of (specializer-class x)) + (class-of x)))) + (cond ((eq x *the-class-t*) t) + ((*subtypep meta-specializer standard) 'standard-instance) + ((*subtypep meta-specializer fsc) 'standard-instance) + ((*subtypep meta-specializer structure) 'structure-instance) + ((*subtypep meta-specializer built-in) 'built-in-instance) + ((*subtypep meta-specializer slot) 'slot-instance) + (t (error "PCL can not handle the specializer ~S (meta-specializer ~S)." + new-specializer meta-specializer)))))) + ;; + ;; We implement the following table. The notation is + ;; that X and Y are distinct meta specializer names. + ;; + ;; NIL ===> + ;; X X ===> X + ;; X Y ===> CLASS + ;; + (let ((new-metatype (specializer->metatype new-specializer))) + (cond ((eq new-metatype 'slot-instance) 'class) + ((null metatype) new-metatype) + ((eq metatype new-metatype) new-metatype) + (t 'class)))))) + +(defmacro with-dfun-wrappers ((args metatypes) + (dfun-wrappers invalid-wrapper-p + &optional wrappers classes types) + invalid-arguments-form + &body body) + `(let* ((args-tail ,args) (,invalid-wrapper-p nil) (invalid-arguments-p nil) + (,dfun-wrappers nil) (dfun-wrappers-tail nil) + ,@(when wrappers + `((wrappers-rev nil) (types-rev nil) (classes-rev nil)))) + (dolist (mt ,metatypes) + (unless args-tail + (setq invalid-arguments-p t) + (return nil)) + (let* ((arg (pop args-tail)) + (wrapper nil) + ,@(when wrappers + `((class *the-class-t*) + (type 't)))) + (unless (eq mt 't) + (setq wrapper (wrapper-of arg)) + (when (invalid-wrapper-p wrapper) + (setq ,invalid-wrapper-p t) + (setq wrapper (check-wrapper-validity arg))) + (cond ((null ,dfun-wrappers) + (setq ,dfun-wrappers wrapper)) + ((not (consp ,dfun-wrappers)) + (setq dfun-wrappers-tail (list wrapper)) + (setq ,dfun-wrappers (cons ,dfun-wrappers dfun-wrappers-tail))) + (t + (let ((new-dfun-wrappers-tail (list wrapper))) + (setf (cdr dfun-wrappers-tail) new-dfun-wrappers-tail) + (setf dfun-wrappers-tail new-dfun-wrappers-tail)))) + ,@(when wrappers + `((setq class (wrapper-class* wrapper)) + (setq type `(class-eq ,class))))) + ,@(when wrappers + `((push wrapper wrappers-rev) + (push class classes-rev) + (push type types-rev))))) + (if invalid-arguments-p + ,invalid-arguments-form + (let* (,@(when wrappers + `((,wrappers (nreverse wrappers-rev)) + (,classes (nreverse classes-rev)) + (,types (mapcar #'(lambda (class) + `(class-eq ,class)) + ,classes))))) + ,@body)))) + + +;;; +;;; Some support stuff for getting a hold of symbols that we need when +;;; building the discriminator codes. Its ok for these to be interned +;;; symbols because we don't capture any user code in the scope in which +;;; these symbols are bound. +;;; + +(defvar *dfun-arg-symbols* '(.ARG0. .ARG1. .ARG2. .ARG3.)) + +(defun dfun-arg-symbol (arg-number) + (or (nth arg-number (the list *dfun-arg-symbols*)) + (intern (format nil ".ARG~A." arg-number) *the-pcl-package*))) + +(defvar *slot-vector-symbols* '(.SLOTS0. .SLOTS1. .SLOTS2. .SLOTS3.)) + +(defun slot-vector-symbol (arg-number) + (or (nth arg-number (the list *slot-vector-symbols*)) + (intern (format nil ".SLOTS~A." arg-number) *the-pcl-package*))) + +(defun make-dfun-lambda-list (metatypes applyp) + (gathering1 (collecting) + (iterate ((i (interval :from 0)) + (s (list-elements metatypes))) + (progn s) + (gather1 (dfun-arg-symbol i))) + (when applyp + (gather1 '&rest) + (gather1 '.dfun-rest-arg.)))) + +(defun make-dlap-lambda-list (metatypes applyp) + (gathering1 (collecting) + (iterate ((i (interval :from 0)) + (s (list-elements metatypes))) + (progn s) + (gather1 (dfun-arg-symbol i))) + (when applyp + (gather1 '&rest)))) + +(defun make-emf-call (metatypes applyp fn-variable &optional emf-type) + (let ((required + (gathering1 (collecting) + (iterate ((i (interval :from 0)) + (s (list-elements metatypes))) + (progn s) + (gather1 (dfun-arg-symbol i)))))) + `(,(if (eq emf-type 'fast-method-call) + 'invoke-effective-method-function-fast + 'invoke-effective-method-function) + ,fn-variable ,applyp ,@required ,@(when applyp `(.dfun-rest-arg.))))) + +(defun make-dfun-call (metatypes applyp fn-variable) + (let ((required + (gathering1 (collecting) + (iterate ((i (interval :from 0)) + (s (list-elements metatypes))) + (progn s) + (gather1 (dfun-arg-symbol i)))))) + (if applyp + `(function-apply ,fn-variable ,@required .dfun-rest-arg.) + `(function-funcall ,fn-variable ,@required)))) + +(defun make-dfun-arg-list (metatypes applyp) + (let ((required + (gathering1 (collecting) + (iterate ((i (interval :from 0)) + (s (list-elements metatypes))) + (progn s) + (gather1 (dfun-arg-symbol i)))))) + (if applyp + `(list* ,@required .dfun-rest-arg.) + `(list ,@required)))) + +(defun make-fast-method-call-lambda-list (metatypes applyp) + (gathering1 (collecting) + (gather1 '.pv-cell.) + (gather1 '.next-method-call.) + (iterate ((i (interval :from 0)) + (s (list-elements metatypes))) + (progn s) + (gather1 (dfun-arg-symbol i))) + (when applyp + (gather1 '.dfun-rest-arg.)))) + +(defmacro fin-lambda-fn (arglist &body body) + `#'(#+cmu kernel:instance-lambda #-cmu lambda + ,arglist + ,@body)) + +(defun make-dispatch-lambda (function-p metatypes applyp body) + `(#+cmu ,(if function-p 'kernel:instance-lambda 'lambda) #-cmu lambda + ,(if function-p + (make-dfun-lambda-list metatypes applyp) + (make-fast-method-call-lambda-list metatypes applyp)) + ,@(unless function-p + `((declare (ignore .pv-cell. .next-method-call.)))) + #+cmu (declare (ignorable ,@(cddr (make-fast-method-call-lambda-list + metatypes applyp)))) + #+copy-&rest-arg + ,@(when (and applyp function-p) + `((setq .dfun-rest-arg. (copy-list .dfun-rest-arg.)))) + ,@body)) + + +;;; +;;; Its too bad Common Lisp compilers freak out when you have a defun with +;;; a lot of LABELS in it. If I could do that I could make this code much +;;; easier to read and work with. +;;; +;;; Ahh Scheme... +;;; +;;; In the absence of that, the following little macro makes the code that +;;; follows a little bit more reasonable. I would like to add that having +;;; to practically write my own compiler in order to get just this simple +;;; thing is something of a drag. +;;; +(eval-when (compile load eval) + +(defvar *cache* nil) + +(defconstant *local-cache-functions* + '((cache () .cache.) + (nkeys () (the non-negative-fixnum (cache-nkeys .cache.))) + (line-size () (cache-line-size .cache.)) + (vector () (cache-vector .cache.)) + (valuep () (cache-valuep .cache.)) + (nlines () (cache-nlines .cache.)) + (max-location () (cache-max-location .cache.)) + (limit-fn () (cache-limit-fn .cache.)) + (size () (cache-size .cache.)) + (mask () (cache-mask .cache.)) + (field () (cache-field .cache.)) + (overflow () (cache-overflow .cache.)) + + ;; + ;; Return T IFF this cache location is reserved. The only time + ;; this is true is for line number 0 of an nkeys=1 cache. + ;; + (line-reserved-p (line) + (declare (type non-negative-fixnum line)) + (and (= (nkeys) 1) + (= line 0))) + ;; + (location-reserved-p (location) + (declare (type non-negative-fixnum location)) + (and (= (nkeys) 1) + (= location 0))) + ;; + ;; Given a line number, return the cache location. This is the + ;; value that is the second argument to cache-vector-ref. Basically, + ;; this deals with the offset of nkeys>1 caches and multiplies + ;; by line size. + ;; + (line-location (line) + (declare (type non-negative-fixnum line)) + (when (line-reserved-p line) + (error "line is reserved")) + (if (= (nkeys) 1) + (the non-negative-fixnum (* line (line-size))) + (the non-negative-fixnum + (1+ (the non-negative-fixnum (* line (line-size))))))) + ;; + ;; Given a cache location, return the line. This is the inverse + ;; of LINE-LOCATION. + ;; + (location-line (location) + (declare (type non-negative-fixnum location)) + (if (= (nkeys) 1) + (floor location (line-size)) + (floor (the non-negative-fixnum (1- location)) (line-size)))) + ;; + ;; Given a line number, return the wrappers stored at that line. + ;; As usual, if nkeys=1, this returns a single value. Only when + ;; nkeys>1 does it return a list. An error is signalled if the + ;; line is reserved. + ;; + (line-wrappers (line) + (declare (type non-negative-fixnum line)) + (when (line-reserved-p line) (error "Line is reserved.")) + (location-wrappers (line-location line))) + ;; + (location-wrappers (location) ; avoid multiplies caused by line-location + (declare (type non-negative-fixnum location)) + (if (= (nkeys) 1) + (cache-vector-ref (vector) location) + (let ((list (make-list (nkeys))) + (vector (vector))) + (declare (simple-vector vector)) + (mdotimes (i (nkeys) list) + (setf (nth i list) (cache-vector-ref vector (+ location i))))))) + ;; + ;; Given a line number, return true IFF the line's + ;; wrappers are the same as wrappers. + ;; + (line-matches-wrappers-p (line wrappers) + (declare (type non-negative-fixnum line)) + (and (not (line-reserved-p line)) + (location-matches-wrappers-p (line-location line) wrappers))) + ;; + (location-matches-wrappers-p (loc wrappers) ; must not be reserved + (declare (type non-negative-fixnum loc)) + (let ((cache-vector (vector))) + (declare (simple-vector cache-vector)) + (if (= (nkeys) 1) + (eq wrappers (cache-vector-ref cache-vector loc)) + (mdotimes (i (nkeys) t) + (unless (eq (pop wrappers) + (cache-vector-ref cache-vector (+ loc i))) + (return nil)))))) + ;; + ;; Given a line number, return the value stored at that line. + ;; If valuep is NIL, this returns NIL. As with line-wrappers, + ;; an error is signalled if the line is reserved. + ;; + (line-value (line) + (declare (type non-negative-fixnum line)) + (when (line-reserved-p line) (error "Line is reserved.")) + (location-value (line-location line))) + ;; + (location-value (loc) + (declare (type non-negative-fixnum loc)) + (and (valuep) + (cache-vector-ref (vector) (+ loc (nkeys))))) + ;; + ;; Given a line number, return true IFF that line has data in + ;; it. The state of the wrappers stored in the line is not + ;; checked. An error is signalled if line is reserved. + (line-full-p (line) + (when (line-reserved-p line) (error "Line is reserved.")) + (not (null (cache-vector-ref (vector) (line-location line))))) + ;; + ;; Given a line number, return true IFF the line is full and + ;; there are no invalid wrappers in the line, and the line's + ;; wrappers are different from wrappers. + ;; An error is signalled if the line is reserved. + ;; + (line-valid-p (line wrappers) + (declare (type non-negative-fixnum line)) + (when (line-reserved-p line) (error "Line is reserved.")) + (location-valid-p (line-location line) wrappers)) + ;; + (location-valid-p (loc wrappers) + (declare (type non-negative-fixnum loc)) + (let ((cache-vector (vector)) + (wrappers-mismatch-p (null wrappers))) + (declare (simple-vector cache-vector)) + (mdotimes (i (nkeys) wrappers-mismatch-p) + (let ((wrapper (cache-vector-ref cache-vector (+ loc i)))) + (when (or (null wrapper) + (invalid-wrapper-p wrapper)) + (return nil)) + (unless (and wrappers + (eq wrapper + (if (consp wrappers) (pop wrappers) wrappers))) + (setq wrappers-mismatch-p t)))))) + ;; + ;; How many unreserved lines separate line-1 and line-2. + ;; + (line-separation (line-1 line-2) + (declare (type non-negative-fixnum line-1 line-2)) + (let ((diff (the fixnum (- line-2 line-1)))) + (declare (fixnum diff)) + (when (minusp diff) + (setq diff (+ diff (nlines))) + (when (line-reserved-p 0) + (setq diff (1- diff)))) + diff)) + ;; + ;; Given a cache line, get the next cache line. This will not + ;; return a reserved line. + ;; + (next-line (line) + (declare (type non-negative-fixnum line)) + (if (= line (the fixnum (1- (nlines)))) + (if (line-reserved-p 0) 1 0) + (the non-negative-fixnum (1+ line)))) + ;; + (next-location (loc) + (declare (type non-negative-fixnum loc)) + (if (= loc (max-location)) + (if (= (nkeys) 1) + (line-size) + 1) + (the non-negative-fixnum (+ loc (line-size))))) + ;; + ;; Given a line which has a valid entry in it, this will return + ;; the primary cache line of the wrappers in that line. We just + ;; call COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION, this is an + ;; easier packaging up of the call to it. + ;; + (line-primary (line) + (declare (type non-negative-fixnum line)) + (location-line (line-primary-location line))) + ;; + (line-primary-location (line) + (declare (type non-negative-fixnum line)) + (compute-primary-cache-location-from-location + (cache) (line-location line))) + )) + +(defmacro with-local-cache-functions ((cache) &body body) + `(let ((.cache. ,cache)) + (declare (type cache .cache.)) + (macrolet ,(mapcar #'(lambda (fn) + `(,(car fn) ,(cadr fn) + `(let (,,@(mapcar #'(lambda (var) + ``(,',var ,,var)) + (cadr fn))) + ,@',(cddr fn)))) + *local-cache-functions*) + ,@body))) + +) + +;;; +;;; Here is where we actually fill, recache and expand caches. +;;; +;;; The functions FILL-CACHE and PROBE-CACHE are the ONLY external +;;; entrypoints into this code. +;;; +;;; FILL-CACHE returns 1 value: a new cache +;;; +;;; a wrapper field number +;;; a cache +;;; a mask +;;; an absolute cache size (the size of the actual vector) +;;; It tries to re-adjust the cache every time it makes a new fill. The +;;; intuition here is that we want uniformity in the number of probes needed to +;;; find an entry. Furthermore, adjusting has the nice property of throwing out +;;; any entries that are invalid. +;;; +(defvar *cache-expand-threshold* 1.25) + +(defun fill-cache (cache wrappers value &optional free-cache-p) + ;;(declare (values cache)) + (unless wrappers ; fill-cache won't return if wrappers is nil, might as well check. + (error "fill-cache: wrappers arg is NIL!")) + (or (fill-cache-p nil cache wrappers value) + (and (< (ceiling (* (cache-count cache) 1.25)) + (if (= (cache-nkeys cache) 1) + (1- (cache-nlines cache)) + (cache-nlines cache))) + (adjust-cache cache wrappers value free-cache-p)) + (expand-cache cache wrappers value free-cache-p))) + +(defvar *check-cache-p* nil) + +(defmacro maybe-check-cache (cache) + `(progn + (when *check-cache-p* + (check-cache ,cache)) + ,cache)) + +(defun check-cache (cache) + (with-local-cache-functions (cache) + (let ((location (if (= (nkeys) 1) 0 1)) + (limit (funcall (limit-fn) (nlines)))) + (mdotimes (i (nlines) cache) + (when (and (not (location-reserved-p location)) + (line-full-p i)) + (let* ((home-loc (compute-primary-cache-location-from-location + cache location)) + (home (location-line (if (location-reserved-p home-loc) + (next-location home-loc) + home-loc))) + (sep (when home (line-separation home i)))) + (when (and sep (> sep limit)) + (error "bad cache ~S ~@ + value at location ~D is ~D lines from its home. limit is ~D." + cache location sep limit)))) + (setq location (next-location location)))))) + +(defun probe-cache (cache wrappers &optional default limit-fn) + ;;(declare (values value)) + (unless wrappers (error "probe-cache: wrappers arg is NIL!")) + (with-local-cache-functions (cache) + (let* ((location (compute-primary-cache-location (field) (mask) wrappers)) + (limit (funcall (or limit-fn (limit-fn)) (nlines)))) + (declare (type non-negative-fixnum location limit)) + (when (location-reserved-p location) + (setq location (next-location location))) + (mdotimes (i (the non-negative-fixnum (1+ limit))) + (when (location-matches-wrappers-p location wrappers) + (return-from probe-cache (or (not (valuep)) + (location-value location)))) + (setq location (next-location location))) + (dolist (entry (overflow)) + (when (equal (car entry) wrappers) + (return-from probe-cache (or (not (valuep)) + (cdr entry))))) + default))) + +(defun map-cache (function cache &optional set-p) + (with-local-cache-functions (cache) + (let ((set-p (and set-p (valuep)))) + (mdotimes (i (nlines) cache) + (unless (or (line-reserved-p i) (not (line-valid-p i nil))) + (let ((value (funcall function (line-wrappers i) (line-value i)))) + (when set-p + (setf (cache-vector-ref (vector) (+ (line-location i) (nkeys))) + value))))) + (dolist (entry (overflow)) + (let ((value (funcall function (car entry) (cdr entry)))) + (when set-p + (setf (cdr entry) value)))))) + cache) + +(defun cache-count (cache) + (with-local-cache-functions (cache) + (let ((count 0)) + (declare (type non-negative-fixnum count)) + (mdotimes (i (nlines) count) + (unless (line-reserved-p i) + (when (line-full-p i) + (incf count))))))) + +(defun entry-in-cache-p (cache wrappers value) + (declare (ignore value)) + (with-local-cache-functions (cache) + (mdotimes (i (nlines)) + (unless (line-reserved-p i) + (when (equal (line-wrappers i) wrappers) + (return t)))))) + +;;; +;;; returns T or NIL +;;; +(defun fill-cache-p (forcep cache wrappers value) + (with-local-cache-functions (cache) + (let* ((location (compute-primary-cache-location (field) (mask) wrappers)) + (primary (location-line location))) + (declare (type non-negative-fixnum location primary)) + (multiple-value-bind (free emptyp) + (find-free-cache-line primary cache wrappers) + (when (or forcep emptyp) + (when (not emptyp) + (push (cons (line-wrappers free) (line-value free)) + (cache-overflow cache))) + ;;(fill-line free wrappers value) + (let ((line free)) + (declare (type non-negative-fixnum line)) + (when (line-reserved-p line) + (error "Attempt to fill a reserved line.")) + (let ((loc (line-location line)) + (cache-vector (vector))) + (declare (type non-negative-fixnum loc) + (simple-vector cache-vector)) + (cond ((= (nkeys) 1) + (setf (cache-vector-ref cache-vector loc) wrappers) + (when (valuep) + (setf (cache-vector-ref cache-vector (1+ loc)) value))) + (t + (let ((i 0)) + (declare (type non-negative-fixnum i)) + (dolist (w wrappers) + (setf (cache-vector-ref cache-vector (+ loc i)) w) + (setq i (the non-negative-fixnum (1+ i))))) + (when (valuep) + (setf (cache-vector-ref cache-vector (+ loc (nkeys))) + value)))) + (maybe-check-cache cache)))))))) + +(defun fill-cache-from-cache-p (forcep cache from-cache from-line) + (declare (type non-negative-fixnum from-line)) + (with-local-cache-functions (cache) + (let ((primary (location-line (compute-primary-cache-location-from-location + cache (line-location from-line) from-cache)))) + (declare (type non-negative-fixnum primary)) + (multiple-value-bind (free emptyp) + (find-free-cache-line primary cache) + (when (or forcep emptyp) + (when (not emptyp) + (push (cons (line-wrappers free) (line-value free)) + (cache-overflow cache))) + ;;(transfer-line from-cache-vector from-line cache-vector free) + (let ((from-cache-vector (cache-vector from-cache)) + (to-cache-vector (vector)) + (to-line free)) + (declare (type non-negative-fixnum to-line)) + (if (line-reserved-p to-line) + (error "transferring something into a reserved cache line.") + (let ((from-loc (line-location from-line)) + (to-loc (line-location to-line))) + (declare (type non-negative-fixnum from-loc to-loc)) + (modify-cache to-cache-vector + (mdotimes (i (line-size)) + (setf (cache-vector-ref to-cache-vector + (+ to-loc i)) + (cache-vector-ref from-cache-vector + (+ from-loc i))))))) + (maybe-check-cache cache))))))) + +;;; +;;; Returns NIL or (values ) +;;; +;;; This is only called when it isn't possible to put the entry in the cache +;;; the easy way. That is, this function assumes that FILL-CACHE-P has been +;;; called as returned NIL. +;;; +;;; If this returns NIL, it means that it wasn't possible to find a wrapper +;;; field for which all of the entries could be put in the cache (within the +;;; limit). +;;; +(defun adjust-cache (cache wrappers value free-old-cache-p) + (with-local-cache-functions (cache) + (let ((ncache (get-cache-from-cache cache (nlines) (field)))) + (do ((nfield (cache-field ncache) + (next-wrapper-cache-number-index nfield))) + ((null nfield) (free-cache ncache) nil) + (let ((nfield nfield)) + (declare (type field-type nfield)) + (setf (cache-field ncache) nfield) + (labels ((try-one-fill-from-line (line) + (fill-cache-from-cache-p nil ncache cache line)) + (try-one-fill (wrappers value) + (fill-cache-p nil ncache wrappers value))) + (if (and (mdotimes (i (nlines) t) + (when (and (null (line-reserved-p i)) + (line-valid-p i wrappers)) + (unless (try-one-fill-from-line i) (return nil)))) + (dolist (wrappers+value (cache-overflow cache) t) + (unless (try-one-fill (car wrappers+value) + (cdr wrappers+value)) + (return nil))) + (try-one-fill wrappers value)) + (progn (when free-old-cache-p (free-cache cache)) + (return (maybe-check-cache ncache))) + (flush-cache-vector-internal (cache-vector ncache))))))))) + + +;;; +;;; returns: (values ) +;;; +(defun expand-cache (cache wrappers value free-old-cache-p) + ;;(declare (values cache)) + (with-local-cache-functions (cache) + (let ((ncache (get-cache-from-cache cache (* (nlines) 2)))) + (labels ((do-one-fill-from-line (line) + (unless (fill-cache-from-cache-p nil ncache cache line) + (do-one-fill (line-wrappers line) (line-value line)))) + (do-one-fill (wrappers value) + (setq ncache (or (adjust-cache ncache wrappers value t) + (fill-cache-p t ncache wrappers value)))) + (try-one-fill (wrappers value) + (fill-cache-p nil ncache wrappers value))) + (mdotimes (i (nlines)) + (when (and (null (line-reserved-p i)) + (line-valid-p i wrappers)) + (do-one-fill-from-line i))) + (dolist (wrappers+value (cache-overflow cache)) + (unless (try-one-fill (car wrappers+value) (cdr wrappers+value)) + (do-one-fill (car wrappers+value) (cdr wrappers+value)))) + (unless (try-one-fill wrappers value) + (do-one-fill wrappers value)) + (when free-old-cache-p (free-cache cache)) + (maybe-check-cache ncache))))) + + +;;; +;;; This is the heart of the cache filling mechanism. It implements the decisions +;;; about where entries are placed. +;;; +;;; Find a line in the cache at which a new entry can be inserted. +;;; +;;; +;;; is in fact empty? +;;; +(defun find-free-cache-line (primary cache &optional wrappers) + ;;(declare (values line empty?)) + (declare (type non-negative-fixnum primary)) + (with-local-cache-functions (cache) + (when (line-reserved-p primary) (setq primary (next-line primary))) + (let ((limit (funcall (limit-fn) (nlines))) + (wrappedp nil) + (lines nil) + (p primary) (s primary)) + (declare (type non-negative-fixnum p s limit)) + (block find-free + (loop + ;; Try to find a free line starting at .

    is the + ;; primary line of the entry we are finding a free + ;; line for, it is used to compute the seperations. + (do* ((line s (next-line line)) + (nsep (line-separation p s) (1+ nsep))) + (()) + (declare (type non-negative-fixnum line nsep)) + (when (null (line-valid-p line wrappers)) ;If this line is empty or + (push line lines) ;invalid, just use it. + (return-from find-free)) + (when (and wrappedp (>= line primary)) + ;; have gone all the way around the cache, time to quit + (return-from find-free-cache-line (values primary nil))) + (let ((osep (line-separation (line-primary line) line))) + (when (>= osep limit) + (return-from find-free-cache-line (values primary nil))) + (when (cond ((= nsep limit) t) + ((= nsep osep) (zerop (random 2))) + ((> nsep osep) t) + (t nil)) + ;; See if we can displace what is in this line so that we + ;; can use the line. + (when (= line (the fixnum (1- (nlines)))) (setq wrappedp t)) + (setq p (line-primary line)) + (setq s (next-line line)) + (push line lines) + (return nil))) + (when (= line (the fixnum (1- (nlines)))) (setq wrappedp t))))) + ;; Do all the displacing. + (loop + (when (null (cdr lines)) (return nil)) + (let ((dline (pop lines)) + (line (car lines))) + (declare (type non-negative-fixnum dline line)) + ;;Copy from line to dline (dline is known to be free). + (let ((from-loc (line-location line)) + (to-loc (line-location dline)) + (cache-vector (vector))) + (declare (type non-negative-fixnum from-loc to-loc) + (simple-vector cache-vector)) + (modify-cache cache-vector + (mdotimes (i (line-size)) + (setf (cache-vector-ref cache-vector (+ to-loc i)) + (cache-vector-ref cache-vector (+ from-loc i))) + (setf (cache-vector-ref cache-vector (+ from-loc i)) + nil)))))) + (values (car lines) t)))) + +(defun default-limit-fn (nlines) + (case nlines + ((1 2 4) 1) + ((8 16) 4) + (otherwise 6))) + +(defvar *empty-cache* (make-cache)) ; for defstruct slot initial value forms + +;;; +;;; pre-allocate generic function caches. The hope is that this will put +;;; them nicely together in memory, and that that may be a win. Of course +;;; the first gc copy will probably blow that out, this really wants to be +;;; wrapped in something that declares the area static. +;;; +;;; This preallocation only creates about 25% more caches than PCL itself +;;; uses. Some ports may want to preallocate some more of these. +;;; +(eval-when (load) + (dolist (n-size '((1 513)(3 257)(3 129)(14 128)(6 65)(2 64)(7 33)(16 32) + (16 17)(32 16)(64 9)(64 8)(6 5)(128 4)(35 2))) + (let ((n (car n-size)) + (size (cadr n-size))) + (mapcar #'free-cache-vector + (mapcar #'get-cache-vector + (make-list n :initial-element size)))))) + +(defun caches-to-allocate () + (sort (let ((l nil)) + (maphash #'(lambda (size entry) + (push (list (car entry) size) l)) + pcl::*free-caches*) + l) + #'> :key #'cadr)) + + diff --git a/pcl/gcl_pcl_combin.lisp b/pcl/gcl_pcl_combin.lisp new file mode 100644 index 0000000..eb03697 --- /dev/null +++ b/pcl/gcl_pcl_combin.lisp @@ -0,0 +1,407 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(defun get-method-function (method &optional method-alist wrappers) + (let ((fn (cadr (assoc method method-alist)))) + (if fn + (values fn nil nil nil) + (multiple-value-bind (mf fmf) + (if (listp method) + (early-method-function method) + (values nil (method-fast-function method))) + (let* ((pv-table (and fmf (method-function-pv-table fmf)))) + (if (and fmf (or (null pv-table) wrappers)) + (let* ((pv-wrappers (when pv-table + (pv-wrappers-from-all-wrappers + pv-table wrappers))) + (pv-cell (when (and pv-table pv-wrappers) + (pv-table-lookup pv-table pv-wrappers)))) + (values mf t fmf pv-cell)) + (values + (or mf (if (listp method) + (setf (cadr method) + (method-function-from-fast-function fmf)) + (method-function method))) + t nil nil))))))) + +(defun make-effective-method-function (generic-function form &optional + method-alist wrappers) + (funcall (the function + (make-effective-method-function1 generic-function form + (not (null method-alist)) + (not (null wrappers)))) + method-alist wrappers)) + +(defun make-effective-method-function1 (generic-function form + method-alist-p wrappers-p) + (if (and (listp form) + (eq (car form) 'call-method)) + (make-effective-method-function-simple generic-function form) + ;; + ;; We have some sort of `real' effective method. Go off and get a + ;; compiled function for it. Most of the real hair here is done by + ;; the GET-FUNCTION mechanism. + ;; + (make-effective-method-function-internal generic-function form + method-alist-p wrappers-p))) + +(defun make-effective-method-function-type (generic-function form + method-alist-p wrappers-p) + (if (and (listp form) + (eq (car form) 'call-method)) + (let* ((cm-args (cdr form)) + (method (car cm-args))) + (when method + (if (if (listp method) + (eq (car method) ':early-method) + (method-p method)) + (if method-alist-p + 't + (multiple-value-bind (mf fmf) + (if (listp method) + (early-method-function method) + (values nil (method-fast-function method))) + (declare (ignore mf)) + (let* ((pv-table (and fmf (method-function-pv-table fmf)))) + (if (and fmf (or (null pv-table) wrappers-p)) + 'fast-method-call + 'method-call)))) + (if (and (consp method) (eq (car method) 'make-method)) + (make-effective-method-function-type + generic-function (cadr method) method-alist-p wrappers-p) + (type-of method))))) + 'fast-method-call)) + +(defun make-effective-method-function-simple (generic-function form + &optional no-fmf-p) + ;; + ;; The effective method is just a call to call-method. This opens up + ;; the possibility of just using the method function of the method as + ;; the effective method function. + ;; + ;; But we have to be careful. If that method function will ask for + ;; the next methods we have to provide them. We do not look to see + ;; if there are next methods, we look at whether the method function + ;; asks about them. If it does, we must tell it whether there are + ;; or aren't to prevent the leaky next methods bug. + ;; + (let* ((cm-args (cdr form)) + (fmf-p (and (null no-fmf-p) + (or (not (eq *boot-state* 'complete)) + (gf-fast-method-function-p generic-function)) + (null (cddr cm-args)))) + (method (car cm-args)) + (cm-args1 (cdr cm-args))) + #'(lambda (method-alist wrappers) + (make-effective-method-function-simple1 generic-function method cm-args1 fmf-p + method-alist wrappers)))) + +(defun make-emf-from-method (method cm-args &optional gf fmf-p method-alist wrappers) + (multiple-value-bind (mf real-mf-p fmf pv-cell) + (get-method-function method method-alist wrappers) + (if fmf + (let* ((next-methods (car cm-args)) + (next (make-effective-method-function-simple1 + gf (car next-methods) + (list* (cdr next-methods) (cdr cm-args)) + fmf-p method-alist wrappers)) + (arg-info (method-function-get fmf ':arg-info))) + (make-fast-method-call :function fmf + :pv-cell pv-cell + :next-method-call next + :arg-info arg-info)) + (if real-mf-p + (make-method-call :function mf + :call-method-args cm-args) + mf)))) + +(defun make-effective-method-function-simple1 (gf method cm-args fmf-p + &optional method-alist wrappers) + (when method + (if (if (listp method) + (eq (car method) ':early-method) + (method-p method)) + (make-emf-from-method method cm-args gf fmf-p method-alist wrappers) + (if (and (consp method) (eq (car method) 'make-method)) + (make-effective-method-function gf (cadr method) method-alist wrappers) + method)))) + +(defvar *global-effective-method-gensyms* ()) +(defvar *rebound-effective-method-gensyms*) + +(defun get-effective-method-gensym () + (or (pop *rebound-effective-method-gensyms*) + (let ((new (intern (format nil "EFFECTIVE-METHOD-GENSYM-~D" + (length *global-effective-method-gensyms*)) + "PCL"))) + (setq *global-effective-method-gensyms* + (append *global-effective-method-gensyms* (list new))) + new))) + +(let ((*rebound-effective-method-gensyms* ())) + (dotimes (i 10) (get-effective-method-gensym))) + +(defun expand-effective-method-function (gf effective-method &optional env) + (declare (ignore env)) + (multiple-value-bind (nreq applyp metatypes nkeys arg-info) + (get-generic-function-info gf) + (declare (ignore nreq nkeys arg-info)) + (let ((args (make-fast-method-call-lambda-list metatypes applyp))) + `(lambda ,args + (declare (ignore .pv-cell. .next-method-call.)) + #+cmu (declare (ignorable ,@(cddr args))) + ,effective-method)))) + +(defun expand-emf-call-method (gf form metatypes applyp env) + (declare (ignore gf metatypes applyp env)) + `(call-method ,(cdr form))) + +(defmacro call-method (&rest args) + (declare (ignore args)) + `(error "~S outside of an effective method form" 'call-method)) + +(defun memf-test-converter (form generic-function method-alist-p wrappers-p) + (cond ((and (consp form) (eq (car form) 'call-method)) + (case (make-effective-method-function-type + generic-function form method-alist-p wrappers-p) + (fast-method-call + '.fast-call-method.) + (t + '.call-method.))) + ((and (consp form) (eq (car form) 'call-method-list)) + (case (if (every #'(lambda (form) + (eq 'fast-method-call + (make-effective-method-function-type + generic-function form + method-alist-p wrappers-p))) + (cdr form)) + 'fast-method-call + 't) + (fast-method-call + '.fast-call-method-list.) + (t + '.call-method-list.))) + (t + (default-test-converter form)))) + +(defun memf-code-converter (form generic-function + metatypes applyp method-alist-p wrappers-p) + (cond ((and (consp form) (eq (car form) 'call-method)) + (let ((gensym (get-effective-method-gensym))) + (values (make-emf-call metatypes applyp gensym + (make-effective-method-function-type + generic-function form method-alist-p wrappers-p)) + (list gensym)))) + ((and (consp form) (eq (car form) 'call-method-list)) + (let ((gensym (get-effective-method-gensym)) + (type (if (every #'(lambda (form) + (eq 'fast-method-call + (make-effective-method-function-type + generic-function form + method-alist-p wrappers-p))) + (cdr form)) + 'fast-method-call + 't))) + (values `(dolist (emf ,gensym nil) + ,(make-emf-call metatypes applyp 'emf type)) + (list gensym)))) + (t + (default-code-converter form)))) + +(defun memf-constant-converter (form generic-function) + (cond ((and (consp form) (eq (car form) 'call-method)) + (list (cons '.meth. + (make-effective-method-function-simple + generic-function form)))) + ((and (consp form) (eq (car form) 'call-method-list)) + (list (cons '.meth-list. + (mapcar #'(lambda (form) + (make-effective-method-function-simple + generic-function form)) + (cdr form))))) + (t + (default-constant-converter form)))) + +(defun make-effective-method-function-internal (generic-function effective-method + method-alist-p wrappers-p) + (multiple-value-bind (nreq applyp metatypes nkeys arg-info) + (get-generic-function-info generic-function) + (declare (ignore nkeys arg-info)) + (let* ((*rebound-effective-method-gensyms* *global-effective-method-gensyms*) + (name (if (early-gf-p generic-function) + (early-gf-name generic-function) + (generic-function-name generic-function))) + (arg-info (cons nreq applyp)) + (effective-method-lambda (expand-effective-method-function + generic-function effective-method))) + (multiple-value-bind (cfunction constants) + (get-function1 effective-method-lambda + #'(lambda (form) + (memf-test-converter form generic-function + method-alist-p wrappers-p)) + #'(lambda (form) + (memf-code-converter form generic-function + metatypes applyp + method-alist-p wrappers-p)) + #'(lambda (form) + (memf-constant-converter form generic-function))) + #'(lambda (method-alist wrappers) + (let* ((constants + (mapcar #'(lambda (constant) + (if (consp constant) + (case (car constant) + (.meth. + (funcall (the function (cdr constant)) + method-alist wrappers)) + (.meth-list. + (mapcar #'(lambda (fn) + (funcall (the function fn) + method-alist wrappers)) + (cdr constant))) + (t constant)) + constant)) + constants)) + (function (set-function-name + (apply cfunction constants) + `(combined-method ,name)))) + (make-fast-method-call :function function + :arg-info arg-info))))))) + +(defmacro call-method-list (&rest calls) + `(progn ,@calls)) + +(defun make-call-methods (methods) + `(call-method-list + ,@(mapcar #'(lambda (method) `(call-method ,method ())) methods))) + +(defun standard-compute-effective-method (generic-function combin applicable-methods) + (declare (ignore combin)) + (let ((before ()) + (primary ()) + (after ()) + (around ())) + (dolist (m applicable-methods) + (let ((qualifiers (if (listp m) + (early-method-qualifiers m) + (method-qualifiers m)))) + (cond ((member ':before qualifiers) (push m before)) + ((member ':after qualifiers) (push m after)) + ((member ':around qualifiers) (push m around)) + (t + (push m primary))))) + (setq before (reverse before) + after (reverse after) + primary (reverse primary) + around (reverse around)) + (cond ((null primary) + `(error "No primary method for the generic function ~S." ',generic-function)) + ((and (null before) (null after) (null around)) + ;; + ;; By returning a single call-method `form' here we enable an important + ;; implementation-specific optimization. + ;; + `(call-method ,(first primary) ,(rest primary))) + (t + (let ((main-effective-method + (if (or before after) + `(multiple-value-prog1 + (progn ,(make-call-methods before) + (call-method ,(first primary) ,(rest primary))) + ,(make-call-methods (reverse after))) + `(call-method ,(first primary) ,(rest primary))))) + (if around + `(call-method ,(first around) + (,@(rest around) (make-method ,main-effective-method))) + main-effective-method)))))) + +;;; +;;; The STANDARD method combination type. This is coded by hand (rather than +;;; with define-method-combination) for bootstrapping and efficiency reasons. +;;; Note that the definition of the find-method-combination-method appears in +;;; the file defcombin.lisp, this is because EQL methods can't appear in the +;;; bootstrap. +;;; +;;; The defclass for the METHOD-COMBINATION and STANDARD-METHOD-COMBINATION +;;; classes has to appear here for this reason. This code must conform to +;;; the code in the file defcombin, look there for more details. +;;; + +(defun compute-effective-method (generic-function combin applicable-methods) + (standard-compute-effective-method generic-function combin applicable-methods)) + +(defvar *invalid-method-error* + #'(lambda (&rest args) + (declare (ignore args)) + (error + "INVALID-METHOD-ERROR was called outside the dynamic scope~%~ + of a method combination function (inside the body of~%~ + DEFINE-METHOD-COMBINATION or a method on the generic~%~ + function COMPUTE-EFFECTIVE-METHOD)."))) + +(defvar *method-combination-error* + #'(lambda (&rest args) + (declare (ignore args)) + (error + "METHOD-COMBINATION-ERROR was called outside the dynamic scope~%~ + of a method combination function (inside the body of~%~ + DEFINE-METHOD-COMBINATION or a method on the generic~%~ + function COMPUTE-EFFECTIVE-METHOD)."))) + +;(defmethod compute-effective-method :around ;issue with magic +; ((generic-function generic-function) ;generic functions +; (method-combination method-combination) +; applicable-methods) +; (declare (ignore applicable-methods)) +; (flet ((real-invalid-method-error (method format-string &rest args) +; (declare (ignore method)) +; (apply #'error format-string args)) +; (real-method-combination-error (format-string &rest args) +; (apply #'error format-string args))) +; (let ((*invalid-method-error* #'real-invalid-method-error) +; (*method-combination-error* #'real-method-combination-error)) +; (call-next-method)))) + +(defun invalid-method-error (&rest args) + (declare (arglist method format-string &rest format-arguments)) + (apply *invalid-method-error* args)) + +(defun method-combination-error (&rest args) + (declare (arglist format-string &rest format-arguments)) + (apply *method-combination-error* args)) + +;This definition appears in defcombin.lisp. +; +;(defmethod find-method-combination ((generic-function generic-function) +; (type (eql 'standard)) +; options) +; (when options +; (method-combination-error +; "The method combination type STANDARD accepts no options.")) +; *standard-method-combination*) + diff --git a/pcl/gcl_pcl_compat.lisp b/pcl/gcl_pcl_compat.lisp new file mode 100644 index 0000000..6069153 --- /dev/null +++ b/pcl/gcl_pcl_compat.lisp @@ -0,0 +1,31 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp; -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +() + diff --git a/pcl/gcl_pcl_cpl.lisp b/pcl/gcl_pcl_cpl.lisp new file mode 100644 index 0000000..cc044c7 --- /dev/null +++ b/pcl/gcl_pcl_cpl.lisp @@ -0,0 +1,314 @@ +;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +;;; +;;; compute-class-precedence-list +;;; +;;; Knuth section 2.2.3 has some interesting notes on this. +;;; +;;; What appears here is basically the algorithm presented there. +;;; +;;; The key idea is that we use class-precedence-description (CPD) structures +;;; to store the precedence information as we proceed. The CPD structure for +;;; a class stores two critical pieces of information: +;;; +;;; - a count of the number of "reasons" why the class can't go +;;; into the class precedence list yet. +;;; +;;; - a list of the "reasons" this class prevents others from +;;; going in until after it +;; +;;; A "reason" is essentially a single local precedence constraint. If a +;;; constraint between two classes arises more than once it generates more +;;; than one reason. This makes things simpler, linear, and isn't a problem +;;; as long as we make sure to keep track of each instance of a "reason". +;;; +;;; This code is divided into three phases. +;;; +;;; - the first phase simply generates the CPD's for each of the class +;;; and its superclasses. The remainder of the code will manipulate +;;; these CPDs rather than the class objects themselves. At the end +;;; of this pass, the CPD-SUPERS field of a CPD is a list of the CPDs +;;; of the direct superclasses of the class. +;;; +;;; - the second phase folds all the local constraints into the CPD +;;; structure. The CPD-COUNT of each CPD is built up, and the +;;; CPD-AFTER fields are augmented to include precedence constraints +;;; from the CPD-SUPERS field and from the order of classes in other +;;; CPD-SUPERS fields. +;;; +;;; After this phase, the CPD-AFTER field of a class includes all the +;;; direct superclasses of the class plus any class that immediately +;;; follows the class in the direct superclasses of another. There +;;; can be duplicates in this list. The CPD-COUNT field is equal to +;;; the number of times this class appears in the CPD-AFTER field of +;;; all the other CPDs. +;;; +;;; - In the third phase, classes are put into the precedence list one +;;; at a time, with only those classes with a CPD-COUNT of 0 being +;;; candidates for insertion. When a class is inserted , every CPD +;;; in its CPD-AFTER field has its count decremented. +;;; +;;; In the usual case, there is only one candidate for insertion at +;;; any point. If there is more than one, the specified tiebreaker +;;; rule is used to choose among them. +;;; + +(defmethod compute-class-precedence-list ((root slot-class)) + (compute-std-cpl root (class-direct-superclasses root))) + +(defstruct (class-precedence-description + (:conc-name nil) + (:print-function (lambda (obj str depth) + (declare (ignore depth)) + (format str + "#" + (class-name (cpd-class obj)) + (cpd-count obj)))) + (:constructor make-cpd ())) + (cpd-class nil) + (cpd-supers ()) + (cpd-after ()) + (cpd-count 0 :type fixnum)) + +(defun compute-std-cpl (class supers) + (cond ((null supers) ;First two branches of COND + (list class)) ;are implementing the single + ((null (cdr supers)) ;inheritance optimization. + (cons class + (compute-std-cpl (car supers) + (class-direct-superclasses (car supers))))) + (t + (multiple-value-bind (all-cpds nclasses) + (compute-std-cpl-phase-1 class supers) + (compute-std-cpl-phase-2 all-cpds) + (compute-std-cpl-phase-3 class all-cpds nclasses))))) + +(defvar *compute-std-cpl-class->entry-table-size* 60) + +(defun compute-std-cpl-phase-1 (class supers) + (let ((nclasses 0) + (all-cpds ()) + (table (make-hash-table :size *compute-std-cpl-class->entry-table-size* + :test #'eq))) + (declare (fixnum nclasses)) + (labels ((get-cpd (c) + (or (gethash c table) + (setf (gethash c table) (make-cpd)))) + (walk (c supers) + (if (forward-referenced-class-p c) + (cpl-forward-referenced-class-error class c) + (let ((cpd (get-cpd c))) + (unless (cpd-class cpd) ;If we have already done this + ;class before, we can quit. + (setf (cpd-class cpd) c) + (incf nclasses) + (push cpd all-cpds) + (setf (cpd-supers cpd) (mapcar #'get-cpd supers)) + (dolist (super supers) + (walk super (class-direct-superclasses super)))))))) + (walk class supers) + (values all-cpds nclasses)))) + +(defun compute-std-cpl-phase-2 (all-cpds) + (dolist (cpd all-cpds) + (let ((supers (cpd-supers cpd))) + (when supers + (setf (cpd-after cpd) (nconc (cpd-after cpd) supers)) + (incf (cpd-count (car supers)) 1) + (do* ((t1 supers t2) + (t2 (cdr t1) (cdr t1))) + ((null t2)) + (incf (cpd-count (car t2)) 2) + (push (car t2) (cpd-after (car t1)))))))) + +(defun compute-std-cpl-phase-3 (class all-cpds nclasses) + (declare (fixnum nclasses)) + (let ((candidates ()) + (next-cpd nil) + (rcpl ())) + ;; + ;; We have to bootstrap the collection of those CPD's that + ;; have a zero count. Once we get going, we will maintain + ;; this list incrementally. + ;; + (dolist (cpd all-cpds) + (when (zerop (cpd-count cpd)) (push cpd candidates))) + + + (loop + (when (null candidates) + ;; + ;; If there are no candidates, and enough classes have been put + ;; into the precedence list, then we are all done. Otherwise + ;; it means there is a consistency problem. + (if (zerop nclasses) + (return (reverse rcpl)) + (cpl-inconsistent-error class all-cpds))) + ;; + ;; Try to find the next class to put in from among the candidates. + ;; If there is only one, its easy, otherwise we have to use the + ;; famous RPG tiebreaker rule. There is some hair here to avoid + ;; having to call DELETE on the list of candidates. I dunno if + ;; its worth it but what the hell. + ;; + (setq next-cpd + (if (null (cdr candidates)) + (prog1 (car candidates) + (setq candidates ())) + (block tie-breaker + (dolist (c rcpl) + (let ((supers (class-direct-superclasses c))) + (if (memq (cpd-class (car candidates)) supers) + (return-from tie-breaker (pop candidates)) + (do ((loc candidates (cdr loc))) + ((null (cdr loc))) + (let ((cpd (cadr loc))) + (when (memq (cpd-class cpd) supers) + (setf (cdr loc) (cddr loc)) + (return-from tie-breaker cpd)))))))))) + (decf nclasses) + (push (cpd-class next-cpd) rcpl) + (dolist (after (cpd-after next-cpd)) + (when (zerop (decf (cpd-count after))) + (push after candidates)))))) + +;;; +;;; Support code for signalling nice error messages. +;;; + +(defun cpl-error (class format-string &rest format-args) + (error "While computing the class precedence list of the class ~A.~%~A" + (if (class-name class) + (format nil "named ~S" (class-name class)) + class) + (apply #'format nil format-string format-args))) + + +(defun cpl-forward-referenced-class-error (class forward-class) + (flet ((class-or-name (class) + (if (class-name class) + (format nil "named ~S" (class-name class)) + class))) + (let ((names (mapcar #'class-or-name + (cdr (find-superclass-chain class forward-class))))) + (cpl-error class + "The class ~A is a forward referenced class.~@ + The class ~A is ~A." + (class-or-name forward-class) + (class-or-name forward-class) + (if (null (cdr names)) + (format nil + "a direct superclass of the class ~A" + (class-or-name class)) + (format nil + "reached from the class ~A by following~@ + the direct superclass chain through: ~A~ + ~% ending at the class ~A" + (class-or-name class) + (format nil + "~{~% the class ~A,~}" + (butlast names)) + (car (last names)))))))) + +(defun find-superclass-chain (bottom top) + (labels ((walk (c chain) + (if (eq c top) + (return-from find-superclass-chain (nreverse chain)) + (dolist (super (class-direct-superclasses c)) + (walk super (cons super chain)))))) + (walk bottom (list bottom)))) + + +(defun cpl-inconsistent-error (class all-cpds) + (let ((reasons (find-cycle-reasons all-cpds))) + (cpl-error class + "It is not possible to compute the class precedence list because~@ + there ~A in the local precedence relations.~@ + ~A because:~{~% ~A~}." + (if (cdr reasons) "are circularities" "is a circularity") + (if (cdr reasons) "These arise" "This arises") + (format-cycle-reasons (apply #'append reasons))))) + +(defun format-cycle-reasons (reasons) + (flet ((class-or-name (cpd) + (let ((class (cpd-class cpd))) + (if (class-name class) + (format nil "named ~S" (class-name class)) + class)))) + (mapcar + #'(lambda (reason) + (ecase (caddr reason) + (:super + (format + nil + "the class ~A appears in the supers of the class ~A" + (class-or-name (cadr reason)) + (class-or-name (car reason)))) + (:in-supers + (format + nil + "the class ~A follows the class ~A in the supers of the class ~A" + (class-or-name (cadr reason)) + (class-or-name (car reason)) + (class-or-name (cadddr reason)))))) + reasons))) + +(defun find-cycle-reasons (all-cpds) + (let ((been-here ()) ;List of classes we have visited. + (cycle-reasons ())) + + (labels ((chase (path) + (if (memq (car path) (cdr path)) + (record-cycle (memq (car path) (nreverse path))) + (unless (memq (car path) been-here) + (push (car path) been-here) + (dolist (after (cpd-after (car path))) + (chase (cons after path)))))) + (record-cycle (cycle) + (let ((reasons ())) + (do* ((t1 cycle t2) + (t2 (cdr t1) (cdr t1))) + ((null t2)) + (let ((c1 (car t1)) + (c2 (car t2))) + (if (memq c2 (cpd-supers c1)) + (push (list c1 c2 :super) reasons) + (dolist (cpd all-cpds) + (when (memq c2 (memq c1 (cpd-supers cpd))) + (return + (push (list c1 c2 :in-supers cpd) reasons))))))) + (push (nreverse reasons) cycle-reasons)))) + + (dolist (cpd all-cpds) + (unless (zerop (cpd-count cpd)) + (chase (list cpd)))) + + cycle-reasons))) + diff --git a/pcl/gcl_pcl_ctypes.lisp b/pcl/gcl_pcl_ctypes.lisp new file mode 100644 index 0000000..bd2c7a6 --- /dev/null +++ b/pcl/gcl_pcl_ctypes.lisp @@ -0,0 +1,45 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +;;; +;;; The built-in method combination types as taken from page 1-31 of 88-002R. +;;; Note that the STANDARD method combination type is defined by hand in the +;;; file combin.lisp. +;;; + +(define-method-combination + :identity-with-one-argument t) +(define-method-combination and :identity-with-one-argument t) +(define-method-combination append :identity-with-one-argument nil) +(define-method-combination list :identity-with-one-argument nil) +(define-method-combination max :identity-with-one-argument t) +(define-method-combination min :identity-with-one-argument t) +(define-method-combination nconc :identity-with-one-argument t) +(define-method-combination or :identity-with-one-argument t) +(define-method-combination progn :identity-with-one-argument t) + diff --git a/pcl/gcl_pcl_defclass.lisp b/pcl/gcl_pcl_defclass.lisp new file mode 100644 index 0000000..6a7f900 --- /dev/null +++ b/pcl/gcl_pcl_defclass.lisp @@ -0,0 +1,467 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +;;; +;;; MAKE-TOP-LEVEL-FORM is used by all PCL macros that appear `at top-level'. +;;; +;;; The original motiviation for this function was to deal with the bug in +;;; the Genera compiler that prevents lambda expressions in top-level forms +;;; other than DEFUN from being compiled. +;;; +;;; Now this function is used to grab other functionality as well. This +;;; includes: +;;; - Preventing the grouping of top-level forms. For example, a +;;; DEFCLASS followed by a DEFMETHOD may not want to be grouped +;;; into the same top-level form. +;;; - Telling the programming environment what the pretty version +;;; of the name of this form is. This is used by WARN. +;;; +(defun make-top-level-form (name times form) + (flet ((definition-name () + (if (and (listp name) + (memq (car name) '(defmethod defclass class method method-combination))) + (format nil "~A~{ ~S~}" + (capitalize-words (car name) ()) (cdr name)) + (format nil "~S" name)))) + (definition-name) + #+Genera + (progn + #-Genera-Release-8 + (let ((thunk-name (gensym "TOP-LEVEL-FORM"))) + `(eval-when ,times + (defun ,thunk-name () + (declare (sys:function-parent + ,(cond ((listp name) + (case (first name) + (defmethod `(method ,@(rest name))) + (otherwise (second name)))) + (t name)) + ,(cond ((listp name) + (case (first name) + ((defmethod defgeneric) 'defun) + ((defclass) 'defclass) + (otherwise (first name)))) + (t 'defun)))) + ,form) + (,thunk-name))) + #+Genera-Release-8 + `(compiler-let ((compiler:default-warning-function ',name)) + (eval-when ,times + (funcall #'(lambda () + (declare ,(cond ((listp name) + (case (first name) + ((defclass) + `(sys:function-parent ,(second name) defclass)) + ((defmethod) + `(sys:function-name (method ,@(rest name)))) + ((defgeneric) + `(sys:function-name ,(second name))) + (otherwise + `(sys:function-name ,name)))) + (t + `(sys:function-name ,name)))) + ,form))))) + #+LCL3.0 + `(compiler-let ((lucid::*compiler-message-string* + (or lucid::*compiler-message-string* + ,(definition-name)))) + (eval-when ,times ,form)) + #+cmu + (if (member 'compile times) + `(eval-when ,times ,form) + form) + #+kcl + (let* ((*print-pretty* nil) + (thunk-name (gensym (definition-name)))) + (gensym "G") ; set the prefix back to something less confusing. + `(eval-when ,times + (defun ,thunk-name () + ,form) + (,thunk-name))) + #-(or Genera LCL3.0 cmu kcl) + (make-progn `',name `(eval-when ,times ,form)))) + +(defun make-progn (&rest forms) + (let ((progn-form nil)) + (labels ((collect-forms (forms) + (unless (null forms) + (collect-forms (cdr forms)) + (if (and (listp (car forms)) + (eq (caar forms) 'progn)) + (collect-forms (cdar forms)) + (push (car forms) progn-form))))) + (collect-forms forms) + (cons 'progn progn-form)))) + + + +;;; +;;; Like the DEFMETHOD macro, the expansion of the DEFCLASS macro is fixed. +;;; DEFCLASS always expands into a call to LOAD-DEFCLASS. Until the meta- +;;; braid is set up, LOAD-DEFCLASS has a special definition which simply +;;; collects all class definitions up, when the metabraid is initialized it +;;; is done from those class definitions. +;;; +;;; After the metabraid has been setup, and the protocol for defining classes +;;; has been defined, the real definition of LOAD-DEFCLASS is installed by the +;;; file defclass.lisp +;;; +(defmacro DEFCLASS (name direct-superclasses direct-slots &rest options) + (declare (indentation 2 4 3 1)) + (expand-defclass name direct-superclasses direct-slots options)) + +(defun expand-defclass (name supers slots options) + (declare (special *defclass-times* *boot-state* *the-class-structure-class*)) + (setq supers (copy-tree supers) + slots (copy-tree slots) + options (copy-tree options)) + (let ((metaclass 'standard-class)) + (dolist (option options) + (if (not (listp option)) + (error "~S is not a legal defclass option." option) + (when (eq (car option) ':metaclass) + (unless (legal-class-name-p (cadr option)) + (error "The value of the :metaclass option (~S) is not a~%~ + legal class name." + (cadr option))) + #-cmu17 + (setq metaclass (cadr option)) + #+cmu17 + (setq metaclass + (case (cadr option) + (lisp:standard-class 'standard-class) + (lisp:structure-class 'structure-class) + (t (cadr option)))) + (setf options (remove option options)) + (return t)))) + + (let ((*initfunctions* ()) + (*accessors* ()) ;Truly a crock, but we got + (*readers* ()) ;to have it to live nicely. + (*writers* ())) + (declare (special *initfunctions* *accessors* *readers* *writers*)) + (let ((canonical-slots + (mapcar #'(lambda (spec) + (canonicalize-slot-specification name spec)) + slots)) + (other-initargs + (mapcar #'(lambda (option) + (canonicalize-defclass-option name option)) + options)) + (defstruct-p (and (eq *boot-state* 'complete) + (let ((mclass (find-class metaclass nil))) + (and mclass + (*subtypep mclass + *the-class-structure-class*)))))) + (do-standard-defsetfs-for-defclass *accessors*) + (let ((defclass-form + (make-top-level-form `(defclass ,name) + (if defstruct-p '(load eval) *defclass-times*) + `(progn + ,@(mapcar #'(lambda (x) + `(declaim (ftype (function (t) t) ,x))) + #+cmu *readers* #-cmu nil) + ,@(mapcar #'(lambda (x) + #-setf (when (consp x) + (setq x (get-setf-function-name (cadr x)))) + `(declaim (ftype (function (t t) t) ,x))) + #+cmu *writers* #-cmu nil) + (let ,(mapcar #'cdr *initfunctions*) + (load-defclass ',name + ',metaclass + ',supers + (list ,@canonical-slots) + (list ,@(apply #'append + (when defstruct-p + '(:from-defclass-p t)) + other-initargs)) + ',*accessors*)))))) + (if defstruct-p + (progn + (eval defclass-form) ; define the class now, so that + `(progn ; the defstruct can be compiled. + ,(class-defstruct-form (find-class name)) + ,defclass-form)) + (progn + (when (and (eq *boot-state* 'complete) + (not (member 'compile *defclass-times*))) + (inform-type-system-about-std-class name)) + defclass-form))))))) + +(defun make-initfunction (initform) + (declare (special *initfunctions*)) + (cond ((or (eq initform 't) + (equal initform ''t)) + '(function true)) + ((or (eq initform 'nil) + (equal initform ''nil)) + '(function false)) + ((or (eql initform '0) + (equal initform ''0)) + '(function zero)) + (t + (let ((entry (assoc initform *initfunctions* :test #'equal))) + (unless entry + (setq entry (list initform + (gensym) + `(function (lambda () ,initform)))) + (push entry *initfunctions*)) + (cadr entry))))) + +(defun canonicalize-slot-specification (class-name spec) + (declare (special *accessors* *readers* *writers*)) + (cond ((and (symbolp spec) + (not (keywordp spec)) + (not (memq spec '(t nil)))) + `'(:name ,spec)) + ((not (consp spec)) + (error "~S is not a legal slot specification." spec)) + ((null (cdr spec)) + `'(:name ,(car spec))) + ((null (cddr spec)) + (error "In DEFCLASS ~S, the slot specification ~S is obsolete.~%~ + Convert it to ~S" + class-name spec (list (car spec) :initform (cadr spec)))) + (t + (let* ((name (pop spec)) + (readers ()) + (writers ()) + (initargs ()) + (unsupplied (list nil)) + (initform (getf spec :initform unsupplied))) + (doplist (key val) spec + (case key + (:accessor (push val *accessors*) + (push val readers) + (push `(setf ,val) writers)) + (:reader (push val readers)) + (:writer (push val writers)) + (:initarg (push val initargs)))) + (loop (unless (remf spec :accessor) (return))) + (loop (unless (remf spec :reader) (return))) + (loop (unless (remf spec :writer) (return))) + (loop (unless (remf spec :initarg) (return))) + (setq *writers* (append writers *writers*)) + (setq *readers* (append readers *readers*)) + (setq spec `(:name ',name + :readers ',readers + :writers ',writers + :initargs ',initargs + ',spec)) + (if (eq initform unsupplied) + `(list* ,@spec) + `(list* :initfunction ,(make-initfunction initform) ,@spec)))))) + +(defun canonicalize-defclass-option (class-name option) + (declare (ignore class-name)) + (case (car option) + (:default-initargs + (let ((canonical ())) + (let (key val (tail (cdr option))) + (loop (when (null tail) (return nil)) + (setq key (pop tail) + val (pop tail)) + (push ``(,',key ,,(make-initfunction val) ,',val) canonical)) + `(':direct-default-initargs (list ,@(nreverse canonical)))))) + (otherwise + `(',(car option) ',(cdr option))))) + + +;;; +;;; This is the early definition of load-defclass. It just collects up all +;;; the class definitions in a list. Later, in the file braid1.lisp, these +;;; are actually defined. +;;; + + +;;; +;;; Each entry in *early-class-definitions* is an early-class-definition. +;;; +;;; +(defparameter *early-class-definitions* ()) + +(defun early-class-definition (class-name) + (or (find class-name *early-class-definitions* :key #'ecd-class-name) + (error "~S is not a class in *early-class-definitions*." class-name))) + +(defun make-early-class-definition + (name source metaclass + superclass-names canonical-slots other-initargs) + (list 'early-class-definition + name source metaclass + superclass-names canonical-slots other-initargs)) + +(defun ecd-class-name (ecd) (nth 1 ecd)) +(defun ecd-source (ecd) (nth 2 ecd)) +(defun ecd-metaclass (ecd) (nth 3 ecd)) +(defun ecd-superclass-names (ecd) (nth 4 ecd)) +(defun ecd-canonical-slots (ecd) (nth 5 ecd)) +(defun ecd-other-initargs (ecd) (nth 6 ecd)) + +(defvar *early-class-slots* nil) + +(defun canonical-slot-name (canonical-slot) + (getf canonical-slot :name)) + +(defun early-class-slots (class-name) + (cdr (or (assoc class-name *early-class-slots*) + (let ((a (cons class-name + (mapcar #'canonical-slot-name + (early-collect-inheritance class-name))))) + (push a *early-class-slots*) + a)))) + +(defun early-class-size (class-name) + (length (early-class-slots class-name))) + +(defun early-collect-inheritance (class-name) + ;;(declare (values slots cpl default-initargs direct-subclasses)) + (let ((cpl (early-collect-cpl class-name))) + (values (early-collect-slots cpl) + cpl + (early-collect-default-initargs cpl) + (gathering1 (collecting) + (dolist (definition *early-class-definitions*) + (when (memq class-name (ecd-superclass-names definition)) + (gather1 (ecd-class-name definition)))))))) + +(defun early-collect-slots (cpl) + (let* ((definitions (mapcar #'early-class-definition cpl)) + (super-slots (mapcar #'ecd-canonical-slots definitions)) + (slots (apply #'append (reverse super-slots)))) + (dolist (s1 slots) + (let ((name1 (canonical-slot-name s1))) + (dolist (s2 (cdr (memq s1 slots))) + (when (eq name1 (canonical-slot-name s2)) + (error "More than one early class defines a slot with the~%~ + name ~S. This can't work because the bootstrap~%~ + object system doesn't know how to compute effective~%~ + slots." + name1))))) + slots)) + +(defun early-collect-cpl (class-name) + (labels ((walk (c) + (let* ((definition (early-class-definition c)) + (supers (ecd-superclass-names definition))) + (cons c + (apply #'append (mapcar #'early-collect-cpl supers)))))) + (remove-duplicates (walk class-name) :from-end nil :test #'eq))) + +(defun early-collect-default-initargs (cpl) + (let ((default-initargs ())) + (dolist (class-name cpl) + (let* ((definition (early-class-definition class-name)) + (others (ecd-other-initargs definition))) + (loop (when (null others) (return nil)) + (let ((initarg (pop others))) + (unless (eq initarg :direct-default-initargs) + (error "The defclass option ~S is not supported by the bootstrap~%~ + object system." + initarg))) + (setq default-initargs + (nconc default-initargs (reverse (pop others))))))) + (reverse default-initargs))) + +(defun bootstrap-slot-index (class-name slot-name) + (or (position slot-name (early-class-slots class-name)) + (error "~S not found" slot-name))) + +;;; +;;; bootstrap-get-slot and bootstrap-set-slot are used to access and change +;;; the values of slots during bootstrapping. During bootstrapping, there +;;; are only two kinds of objects whose slots we need to access, CLASSes +;;; and SLOT-DEFINITIONs. The first argument to these functions tells whether the +;;; object is a CLASS or a SLOT-DEFINITION. +;;; +;;; Note that the way this works it stores the slot in the same place in +;;; memory that the full object system will expect to find it later. This +;;; is critical to the bootstrapping process, the whole changeover to the +;;; full object system is predicated on this. +;;; +;;; One important point is that the layout of standard classes and standard +;;; slots must be computed the same way in this file as it is by the full +;;; object system later. +;;; +(defmacro bootstrap-get-slot (type object slot-name) + `(instance-ref (get-slots ,object) (bootstrap-slot-index ,type ,slot-name))) + +(defun bootstrap-set-slot (type object slot-name new-value) + (setf (bootstrap-get-slot type object slot-name) new-value)) + +(defun early-class-name (class) + (bootstrap-get-slot 'class class 'name)) + +(defun early-class-precedence-list (class) + (bootstrap-get-slot 'pcl-class class 'class-precedence-list)) + +(defun early-class-name-of (instance) + (early-class-name (class-of instance))) + +(defun early-class-slotds (class) + (bootstrap-get-slot 'slot-class class 'slots)) + +(defun early-slot-definition-name (slotd) + (bootstrap-get-slot 'standard-effective-slot-definition slotd 'name)) + +(defun early-slot-definition-location (slotd) + (bootstrap-get-slot 'standard-effective-slot-definition slotd 'location)) + +(defun early-accessor-method-slot-name (method) + (bootstrap-get-slot 'standard-accessor-method method 'slot-name)) + +(unless (fboundp 'class-name-of) + (setf (symbol-function 'class-name-of) + (symbol-function 'early-class-name-of))) + +(defun early-class-direct-subclasses (class) + (bootstrap-get-slot 'class class 'direct-subclasses)) + +(proclaim '(notinline load-defclass)) +(defun load-defclass + (name metaclass supers canonical-slots canonical-options accessor-names) + (setq supers (copy-tree supers) + canonical-slots (copy-tree canonical-slots) + canonical-options (copy-tree canonical-options)) + (do-standard-defsetfs-for-defclass accessor-names) + (when (eq metaclass 'standard-class) + (inform-type-system-about-std-class name)) + (let ((ecd + (make-early-class-definition name + (load-truename) + metaclass + supers + canonical-slots + canonical-options)) + (existing + (find name *early-class-definitions* :key #'ecd-class-name))) + (setq *early-class-definitions* + (cons ecd (remove existing *early-class-definitions*))) + ecd)) + diff --git a/pcl/gcl_pcl_defcombin.lisp b/pcl/gcl_pcl_defcombin.lisp new file mode 100644 index 0000000..61222ad --- /dev/null +++ b/pcl/gcl_pcl_defcombin.lisp @@ -0,0 +1,430 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +;;; +;;; DEFINE-METHOD-COMBINATION +;;; + +(defmacro define-method-combination (&whole form &rest args) + (declare (ignore args)) + (if (and (cddr form) + (listp (caddr form))) + (expand-long-defcombin form) + (expand-short-defcombin form))) + + +;;; +;;; STANDARD method combination +;;; +;;; The STANDARD method combination type is implemented directly by the class +;;; STANDARD-METHOD-COMBINATION. The method on COMPUTE-EFFECTIVE-METHOD does +;;; standard method combination directly and is defined by hand in the file +;;; combin.lisp. The method for FIND-METHOD-COMBINATION must appear in this +;;; file for bootstrapping reasons. +;;; +;;; A commented out copy of this definition appears in combin.lisp. +;;; If you change this definition here, be sure to change it there +;;; also. +;;; +(defmethod find-method-combination ((generic-function generic-function) + (type (eql 'standard)) + options) + (when options + (method-combination-error + "The method combination type STANDARD accepts no options.")) + *standard-method-combination*) + + + +;;; +;;; short method combinations +;;; +;;; Short method combinations all follow the same rule for computing the +;;; effective method. So, we just implement that rule once. Each short +;;; method combination object just reads the parameters out of the object +;;; and runs the same rule. +;;; +;;; +(defclass short-method-combination (standard-method-combination) + ((operator + :reader short-combination-operator + :initarg :operator) + (identity-with-one-argument + :reader short-combination-identity-with-one-argument + :initarg :identity-with-one-argument)) + (:predicate-name short-method-combination-p)) + +(defun expand-short-defcombin (whole) + (let* ((type (cadr whole)) + (documentation + (getf (cddr whole) :documentation "")) + (identity-with-one-arg + (getf (cddr whole) :identity-with-one-argument nil)) + (operator + (getf (cddr whole) :operator type))) + (make-top-level-form `(define-method-combination ,type) + '(load eval) + `(load-short-defcombin + ',type ',operator ',identity-with-one-arg ',documentation)))) + +(defun load-short-defcombin (type operator ioa doc) + (let* ((truename (load-truename)) + (specializers + (list (find-class 'generic-function) + (intern-eql-specializer type) + *the-class-t*)) + (old-method + (get-method #'find-method-combination () specializers nil)) + (new-method nil)) + (setq new-method + (make-instance 'standard-method + :qualifiers () + :specializers specializers + :lambda-list '(generic-function type options) + :function #'(lambda (gf type options) + (declare (ignore gf)) + (do-short-method-combination + type options operator ioa new-method doc)) + :definition-source `((define-method-combination ,type) ,truename))) + (when old-method + (remove-method #'find-method-combination old-method)) + (add-method #'find-method-combination new-method))) + +(defun do-short-method-combination (type options operator ioa method doc) + (cond ((null options) (setq options '(:most-specific-first))) + ((equal options '(:most-specific-first))) + ((equal options '(:most-specific-last))) + (t + (method-combination-error + "Illegal options to a short method combination type.~%~ + The method combination type ~S accepts one option which~%~ + must be either :MOST-SPECIFIC-FIRST or :MOST-SPECIFIC-LAST." + type))) + (make-instance 'short-method-combination + :type type + :options options + :operator operator + :identity-with-one-argument ioa + :definition-source method + :documentation doc)) + +(defmethod compute-effective-method ((generic-function generic-function) + (combin short-method-combination) + applicable-methods) + (let ((type (method-combination-type combin)) + (operator (short-combination-operator combin)) + (ioa (short-combination-identity-with-one-argument combin)) + (around ()) + (primary ())) + (dolist (m applicable-methods) + (let ((qualifiers (method-qualifiers m))) + (flet ((lose (method why) + (invalid-method-error + method + "The method ~S ~A.~%~ + The method combination type ~S was defined with the~%~ + short form of DEFINE-METHOD-COMBINATION and so requires~%~ + all methods have either the single qualifier ~S or the~%~ + single qualifier :AROUND." + method why type type))) + (cond ((null qualifiers) + (lose m "has no qualifiers")) + ((cdr qualifiers) + (lose m "has more than one qualifier")) + ((eq (car qualifiers) :around) + (push m around)) + ((eq (car qualifiers) type) + (push m primary)) + (t + (lose m "has an illegal qualifier")))))) + (setq around (nreverse around) + primary (nreverse primary)) + (let ((main-method + (if (and (null (cdr primary)) + (not (null ioa))) + `(call-method ,(car primary) ()) + `(,operator ,@(mapcar #'(lambda (m) `(call-method ,m ())) + primary))))) + (cond ((null primary) + `(error "No ~S methods for the generic function ~S." + ',type ',generic-function)) + ((null around) main-method) + (t + `(call-method ,(car around) + (,@(cdr around) (make-method ,main-method)))))))) + + +;;; +;;; long method combinations +;;; +;;; + +(defclass long-method-combination (standard-method-combination) + ((function :initarg :function + :reader long-method-combination-function))) + +(defun expand-long-defcombin (form) + (let ((type (cadr form)) + (lambda-list (caddr form)) + (method-group-specifiers (cadddr form)) + (body (cddddr form)) + (arguments-option ()) + (gf-var nil)) + (when (and (consp (car body)) (eq (caar body) :arguments)) + (setq arguments-option (cdr (pop body)))) + (when (and (consp (car body)) (eq (caar body) :generic-function)) + (setq gf-var (cadr (pop body)))) + (multiple-value-bind (documentation function) + (make-long-method-combination-function + type lambda-list method-group-specifiers arguments-option gf-var + body) + (make-top-level-form `(define-method-combination ,type) + '(load eval) + `(load-long-defcombin ',type ',documentation #',function))))) + +(defvar *long-method-combination-functions* (make-hash-table :test #'eq)) + +(defun load-long-defcombin (type doc function) + (let* ((specializers + (list (find-class 'generic-function) + (intern-eql-specializer type) + *the-class-t*)) + (old-method + (get-method #'find-method-combination () specializers nil)) + (new-method + (make-instance 'standard-method + :qualifiers () + :specializers specializers + :lambda-list '(generic-function type options) + :function #'(lambda (generic-function type options) + (declare (ignore generic-function)) + (make-instance 'long-method-combination + :type type + :documentation doc + :options options)) + :definition-source `((define-method-combination ,type) + ,(load-truename))))) + (setf (gethash type *long-method-combination-functions*) function) + (when old-method (remove-method #'find-method-combination old-method)) + (add-method #'find-method-combination new-method))) + +(defmethod compute-effective-method ((generic-function generic-function) + (combin long-method-combination) + applicable-methods) + (funcall (gethash (method-combination-type combin) + *long-method-combination-functions*) + generic-function + combin + applicable-methods)) + +;;; +;;; +;;; +(defun make-long-method-combination-function + (type ll method-group-specifiers arguments-option gf-var body) + ;;(declare (values documentation function)) + (declare (ignore type)) + (multiple-value-bind (documentation declarations real-body) + (extract-declarations body) + + (let ((wrapped-body + (wrap-method-group-specifier-bindings method-group-specifiers + declarations + real-body))) + (when gf-var + (push `(,gf-var .generic-function.) (cadr wrapped-body))) + + (when arguments-option + (setq wrapped-body (deal-with-arguments-option wrapped-body + arguments-option))) + + (when ll + (setq wrapped-body + `(apply #'(lambda ,ll ,wrapped-body) + (method-combination-options .method-combination.)))) + + (values + documentation + `(lambda (.generic-function. .method-combination. .applicable-methods.) + (progn .generic-function. .method-combination. .applicable-methods.) + (block .long-method-combination-function. ,wrapped-body)))))) +;; +;; parse-method-group-specifiers parse the method-group-specifiers +;; + +(defun wrap-method-group-specifier-bindings + (method-group-specifiers declarations real-body) + (with-gathering ((names (collecting)) + (specializer-caches (collecting)) + (cond-clauses (collecting)) + (required-checks (collecting)) + (order-cleanups (collecting))) + (dolist (method-group-specifier method-group-specifiers) + (multiple-value-bind (name tests description order required) + (parse-method-group-specifier method-group-specifier) + (declare (ignore description)) + (let ((specializer-cache (gensym))) + (gather name names) + (gather specializer-cache specializer-caches) + (gather `((or ,@tests) + (if (equal ,specializer-cache .specializers.) + (return-from .long-method-combination-function. + '(error "More than one method of type ~S ~ + with the same specializers." + ',name)) + (setq ,specializer-cache .specializers.)) + (push .method. ,name)) + cond-clauses) + (when required + (gather `(when (null ,name) + (return-from .long-method-combination-function. + '(error "No ~S methods." ',name))) + required-checks)) + (loop (unless (and (constantp order) + (neq order (setq order (eval order)))) + (return t))) + (gather (cond ((eq order :most-specific-first) + `(setq ,name (nreverse ,name))) + ((eq order :most-specific-last) ()) + (t + `(ecase ,order + (:most-specific-first + (setq ,name (nreverse ,name))) + (:most-specific-last)))) + order-cleanups)))) + `(let (,@names ,@specializer-caches) + ,@declarations + (dolist (.method. .applicable-methods.) + (let ((.qualifiers. (method-qualifiers .method.)) + (.specializers. (method-specializers .method.))) + (progn .qualifiers. .specializers.) + (cond ,@cond-clauses))) + ,@required-checks + ,@order-cleanups + ,@real-body))) + +(defun parse-method-group-specifier (method-group-specifier) + ;;(declare (values name tests description order required)) + (let* ((name (pop method-group-specifier)) + (patterns ()) + (tests + (gathering1 (collecting) + (block collect-tests + (loop + (if (or (null method-group-specifier) + (memq (car method-group-specifier) + '(:description :order :required))) + (return-from collect-tests t) + (let ((pattern (pop method-group-specifier))) + (push pattern patterns) + (gather1 (parse-qualifier-pattern name pattern))))))))) + (values name + tests + (getf method-group-specifier :description + (make-default-method-group-description patterns)) + (getf method-group-specifier :order :most-specific-first) + (getf method-group-specifier :required nil)))) + +(defun parse-qualifier-pattern (name pattern) + (cond ((eq pattern '()) `(null .qualifiers.)) + ((eq pattern '*) 't) + ((symbolp pattern) `(,pattern .qualifiers.)) + ((listp pattern) `(qualifier-check-runtime ',pattern .qualifiers.)) + (t (error "In the method group specifier ~S,~%~ + ~S isn't a valid qualifier pattern." + name pattern)))) + +(defun qualifier-check-runtime (pattern qualifiers) + (loop (cond ((and (null pattern) (null qualifiers)) + (return t)) + ((eq pattern '*) (return t)) + ((and pattern qualifiers (eq (car pattern) (car qualifiers))) + (pop pattern) + (pop qualifiers)) + (t (return nil))))) + +(defun make-default-method-group-description (patterns) + (if (cdr patterns) + (format nil + "methods matching one of the patterns: ~{~S, ~} ~S" + (butlast patterns) (car (last patterns))) + (format nil + "methods matching the pattern: ~S" + (car patterns)))) + + + +;;; +;;; This baby is a complete mess. I can't believe we put it in this +;;; way. No doubt this is a large part of what drives MLY crazy. +;;; +;;; At runtime (when the effective-method is run), we bind an intercept +;;; lambda-list to the arguments to the generic function. +;;; +;;; At compute-effective-method time, the symbols in the :arguments +;;; option are bound to the symbols in the intercept lambda list. +;;; +(defun deal-with-arguments-option (wrapped-body arguments-option) + (let* ((intercept-lambda-list + (gathering1 (collecting) + (dolist (arg arguments-option) + (if (memq arg lambda-list-keywords) + (gather1 arg) + (gather1 (gensym)))))) + (intercept-rebindings + (gathering1 (collecting) + (iterate ((arg (list-elements arguments-option)) + (int (list-elements intercept-lambda-list))) + (unless (memq arg lambda-list-keywords) + (gather1 `(,arg ',int))))))) + ;; + ;; + (setf (cadr wrapped-body) + (append intercept-rebindings (cadr wrapped-body))) + ;; + ;; Be sure to fill out the intercept lambda list so that it can + ;; be too short if it wants to. + ;; + (cond ((memq '&rest intercept-lambda-list)) + ((memq '&allow-other-keys intercept-lambda-list)) + ((memq '&key intercept-lambda-list) + (setq intercept-lambda-list + (append intercept-lambda-list '(&allow-other-keys)))) + (t + (setq intercept-lambda-list + (append intercept-lambda-list '(&rest .ignore.))))) + + `(let ((inner-result. ,wrapped-body)) + `(apply #'(lambda ,',intercept-lambda-list + ,,(when (memq '.ignore. intercept-lambda-list) + ''(declare (ignore .ignore.))) + ,inner-result.) + .combined-method-args.)))) + + diff --git a/pcl/gcl_pcl_defs.lisp b/pcl/gcl_pcl_defs.lisp new file mode 100644 index 0000000..82eb031 --- /dev/null +++ b/pcl/gcl_pcl_defs.lisp @@ -0,0 +1,970 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(eval-when (compile load eval) + +(defvar *defclass-times* '(load eval)) ;Probably have to change this + ;if you use defconstructor. +(defvar *defmethod-times* '(load eval)) +(defvar *defgeneric-times* '(load eval)) + +; defvar is now actually in macros +;(defvar *boot-state* ()) ;NIL + ;EARLY + ;BRAID + ;COMPLETE +(defvar *fegf-started-p* nil) + + +) + +(eval-when (load eval) + (when (eq *boot-state* 'complete) + (error "Trying to load (or compile) PCL in an environment in which it~%~ + has already been loaded. This doesn't work, you will have to~%~ + get a fresh lisp (reboot) and then load PCL.")) + (when *boot-state* + (cerror "Try loading (or compiling) PCL anyways." + "Trying to load (or compile) PCL in an environment in which it~%~ + has already been partially loaded. This may not work, you may~%~ + need to get a fresh lisp (reboot) and then load PCL.")) + ) + + + +;;; +;;; This is like fdefinition on the Lispm. If Common Lisp had something like +;;; function specs I wouldn't need this. On the other hand, I don't like the +;;; way this really works so maybe function specs aren't really right either? +;;; +;;; I also don't understand the real implications of a Lisp-1 on this sort of +;;; thing. Certainly some of the lossage in all of this is because these +;;; SPECs name global definitions. +;;; +;;; Note that this implementation is set up so that an implementation which +;;; has a 'real' function spec mechanism can use that instead and in that way +;;; get rid of setf generic function names. +;;; +(defmacro parse-gspec (spec + (non-setf-var . non-setf-case) + (setf-var . setf-case)) + (declare (indentation 1 1)) + #+setf (declare (ignore setf-var setf-case)) + (once-only (spec) + `(cond (#-setf (symbolp ,spec) #+setf t + (let ((,non-setf-var ,spec)) ,@non-setf-case)) + #-setf + ((and (listp ,spec) + (eq (car ,spec) 'setf) + (symbolp (cadr ,spec))) + (let ((,setf-var (cadr ,spec))) ,@setf-case)) + #-setf + (t + (error + "Can't understand ~S as a generic function specifier.~%~ + It must be either a symbol which can name a function or~%~ + a list like ~S, where the car is the symbol ~S and the cadr~%~ + is a symbol which can name a generic function." + ,spec '(setf ) 'setf))))) + +;;; +;;; If symbol names a function which is traced or advised, return the +;;; unadvised, traced etc. definition. This lets me get at the generic +;;; function object even when it is traced. +;;; +(defun unencapsulated-fdefinition (symbol) + #+Lispm (si:fdefinition (si:unencapsulate-function-spec symbol)) + #+Lucid (lucid::get-unadvised-procedure (symbol-function symbol)) + #+excl (or (excl::encapsulated-basic-definition symbol) + (symbol-function symbol)) + #+xerox (il:virginfn symbol) + #+setf (fdefinition symbol) + #+kcl (symbol-function + (let ((sym (get symbol 'si::traced)) first-form) + (if (and sym + (consp (symbol-function symbol)) + (consp (setq first-form (nth 3 (symbol-function symbol)))) + (eq (car first-form) 'si::trace-call)) + sym + symbol))) + #-(or Lispm Lucid excl Xerox setf kcl) (symbol-function symbol)) + +;;; +;;; If symbol names a function which is traced or advised, redefine +;;; the `real' definition without affecting the advise. +;;; +(defun fdefine-carefully (name new-definition) + #+Lispm (si:fdefine name new-definition t t) + #+Lucid (let ((lucid::*redefinition-action* nil)) + (setf (symbol-function name) new-definition)) + #+excl (setf (symbol-function name) new-definition) + #+xerox (let ((advisedp (member name il:advisedfns :test #'eq)) + (brokenp (member name il:brokenfns :test #'eq))) + ;; In XeroxLisp (late of envos) tracing is implemented + ;; as a special case of "breaking". Advising, however, + ;; is treated specially. + (xcl:unadvise-function name :no-error t) + (xcl:unbreak-function name :no-error t) + (setf (symbol-function name) new-definition) + (when brokenp (xcl:rebreak-function name)) + (when advisedp (xcl:readvise-function name))) + #+(and setf (not cmu)) (setf (fdefinition name) new-definition) + #+kcl (setf (symbol-function + (let ((sym (get name 'si::traced)) first-form) + (if (and sym + (consp (symbol-function name)) + (consp (setq first-form + (nth 3 (symbol-function name)))) + (eq (car first-form) 'si::trace-call)) + sym + name))) + new-definition) + #+cmu (progn + (c::%%defun name new-definition nil) + (c::note-name-defined name :function) + new-definition) + #-(or Lispm Lucid excl Xerox setf kcl cmu) + (setf (symbol-function name) new-definition)) + +(defun gboundp (spec) + (parse-gspec spec + (name (fboundp name)) + (name (fboundp (get-setf-function-name name))))) + +(defun gmakunbound (spec) + (parse-gspec spec + (name (fmakunbound name)) + (name (fmakunbound (get-setf-function-name name))))) + +(defun gdefinition (spec) + (parse-gspec spec + (name (or #-setf (macro-function name) ;?? + (unencapsulated-fdefinition name))) + (name (unencapsulated-fdefinition (get-setf-function-name name))))) + +(defun #-setf SETF\ PCL\ GDEFINITION #+setf (setf gdefinition) (new-value spec) + (parse-gspec spec + (name (fdefine-carefully name new-value)) + (name (fdefine-carefully (get-setf-function-name name) new-value)))) + + +(proclaim '(special *the-class-t* + *the-class-vector* *the-class-symbol* + *the-class-string* *the-class-sequence* + *the-class-rational* *the-class-ratio* + *the-class-number* *the-class-null* *the-class-list* + *the-class-integer* *the-class-float* *the-class-cons* + *the-class-complex* *the-class-character* + *the-class-bit-vector* *the-class-array* + + *the-class-slot-object* + *the-class-standard-object* + *the-class-structure-object* + *the-class-class* + *the-class-generic-function* + *the-class-built-in-class* + *the-class-slot-class* + *the-class-structure-class* + *the-class-standard-class* + *the-class-funcallable-standard-class* + *the-class-method* + *the-class-standard-method* + *the-class-standard-reader-method* + *the-class-standard-writer-method* + *the-class-standard-boundp-method* + *the-class-standard-generic-function* + *the-class-standard-effective-slot-definition* + + *the-eslotd-standard-class-slots* + *the-eslotd-funcallable-standard-class-slots*)) + +(proclaim '(special *the-wrapper-of-t* + *the-wrapper-of-vector* *the-wrapper-of-symbol* + *the-wrapper-of-string* *the-wrapper-of-sequence* + *the-wrapper-of-rational* *the-wrapper-of-ratio* + *the-wrapper-of-number* *the-wrapper-of-null* + *the-wrapper-of-list* *the-wrapper-of-integer* + *the-wrapper-of-float* *the-wrapper-of-cons* + *the-wrapper-of-complex* *the-wrapper-of-character* + *the-wrapper-of-bit-vector* *the-wrapper-of-array*)) + +;;;; Type specifier hackery: + +;;; internal to this file. +(defun coerce-to-class (class &optional make-forward-referenced-class-p) + (if (symbolp class) + (or (find-class class (not make-forward-referenced-class-p)) + (ensure-class class)) + class)) + +;;; Interface +(defun specializer-from-type (type &aux args) + (when (consp type) + (setq args (cdr type) type (car type))) + (cond ((symbolp type) + (or (and (null args) (find-class type)) + (ecase type + (class (coerce-to-class (car args))) + (prototype (make-instance 'class-prototype-specializer + :object (coerce-to-class (car args)))) + (class-eq (class-eq-specializer (coerce-to-class (car args)))) + (eql (intern-eql-specializer (car args)))))) + #+cmu17 + ((and (null args) (typep type 'lisp:class)) + (or (kernel:class-pcl-class type) + (find-structure-class (lisp:class-name type)))) + ((specializerp type) type))) + +;;; interface +(defun type-from-specializer (specl) + (cond ((eq specl 't) + 't) + ((consp specl) + (unless (member (car specl) '(class prototype class-eq eql)) + (error "~S is not a legal specializer type" specl)) + specl) + ((progn + (when (symbolp specl) + ;;maybe (or (find-class specl nil) (ensure-class specl)) instead? + (setq specl (find-class specl))) + (or (not (eq *boot-state* 'complete)) + (specializerp specl))) + (specializer-type specl)) + (t + (error "~s is neither a type nor a specializer" specl)))) + +(defun type-class (type) + (declare (special *the-class-t*)) + (setq type (type-from-specializer type)) + (if (atom type) + (if (eq type 't) + *the-class-t* + (error "bad argument to type-class")) + (case (car type) + (eql (class-of (cadr type))) + (prototype (class-of (cadr type))) ;? + (class-eq (cadr type)) + (class (cadr type))))) + +(defun class-eq-type (class) + (specializer-type (class-eq-specializer class))) + +(defun inform-type-system-about-std-class (name) + (let ((predicate-name (make-type-predicate-name name))) + (setf (gdefinition predicate-name) (make-type-predicate name)) + (do-satisfies-deftype name predicate-name))) + +(defun make-type-predicate (name) + (let ((cell (find-class-cell name))) + #'(lambda (x) + (funcall (the function (find-class-cell-predicate cell)) x)))) + + +;This stuff isn't right. Good thing it isn't used. +;The satisfies predicate has to be a symbol. There is no way to +;construct such a symbol from a class object if class names change. +(defun class-predicate (class) + (when (symbolp class) (setq class (find-class class))) + #'(lambda (object) (memq class (class-precedence-list (class-of object))))) + +(defun make-class-eq-predicate (class) + (when (symbolp class) (setq class (find-class class))) + #'(lambda (object) (eq class (class-of object)))) + +(defun make-eql-predicate (eql-object) + #'(lambda (object) (eql eql-object object))) + +#|| ; The argument to satisfies must be a symbol. +(deftype class (&optional class) + (if class + `(satisfies ,(class-predicate class)) + `(satisfies ,(class-predicate 'class)))) + +(deftype class-eq (class) + `(satisfies ,(make-class-eq-predicate class))) +||# + +#-(or excl cmu17) +(deftype eql (type-object) + `(member ,type-object)) + + +;;; Internal to this file. +;;; +;;; These functions are a pale imitiation of their namesake. They accept +;;; class objects or types where they should. +;;; +(defun *normalize-type (type) + (cond ((consp type) + (if (member (car type) '(not and or)) + `(,(car type) ,@(mapcar #'*normalize-type (cdr type))) + (if (null (cdr type)) + (*normalize-type (car type)) + type))) + ((symbolp type) + (let ((class (find-class type nil))) + (if class + (let ((type (specializer-type class))) + (if (listp type) type `(,type))) + `(,type)))) + ((or (not (eq *boot-state* 'complete)) + (specializerp type)) + (specializer-type type)) + (t + (error "~s is not a type" type)))) + +;;; Not used... +#+nil +(defun unparse-type-list (tlist) + (mapcar #'unparse-type tlist)) + +;;; Not used... +#+nil +(defun unparse-type (type) + (if (atom type) + (if (specializerp type) + (unparse-type (specializer-type type)) + type) + (case (car type) + (eql type) + (class-eq `(class-eq ,(class-name (cadr type)))) + (class (class-name (cadr type))) + (t `(,(car type) ,@(unparse-type-list (cdr type))))))) + +;;; internal to this file... +(defun convert-to-system-type (type) + (case (car type) + ((not and or) `(,(car type) ,@(mapcar #'convert-to-system-type + (cdr type)))) + ((class class-eq) ; class-eq is impossible to do right + #-cmu17 (class-name (cadr type)) + #+cmu17 (kernel:layout-class (class-wrapper (cadr type)))) + (eql type) + (t (if (null (cdr type)) + (car type) + type)))) + +;;; not used... +#+nil +(defun *typep (object type) + (setq type (*normalize-type type)) + (cond ((member (car type) '(eql wrapper-eq class-eq class)) + (specializer-applicable-using-type-p type `(eql ,object))) + ((eq (car type) 'not) + (not (*typep object (cadr type)))) + (t + (typep object (convert-to-system-type type))))) + + +;;; *SUBTYPEP -- Interface +;;; +;Writing the missing NOT and AND clauses will improve +;the quality of code generated by generate-discrimination-net, but +;calling subtypep in place of just returning (values nil nil) can be +;very slow. *subtypep is used by PCL itself, and must be fast. +(defun *subtypep (type1 type2) + (if (equal type1 type2) + (values t t) + (if (eq *boot-state* 'early) + (values (eq type1 type2) t) + (let ((*in-precompute-effective-methods-p* t)) + (declare (special *in-precompute-effective-methods-p*)) + ;; *in-precompute-effective-methods-p* is not a good name. + ;; It changes the way class-applicable-using-class-p works. + (setq type1 (*normalize-type type1)) + (setq type2 (*normalize-type type2)) + (case (car type2) + (not + (values nil nil)) ; Should improve this. + (and + (values nil nil)) ; Should improve this. + ((eql wrapper-eq class-eq class) + (multiple-value-bind (app-p maybe-app-p) + (specializer-applicable-using-type-p type2 type1) + (values app-p (or app-p (not maybe-app-p))))) + (t + (subtypep (convert-to-system-type type1) + (convert-to-system-type type2)))))))) + +(defun do-satisfies-deftype (name predicate) + #+cmu17 (declare (ignore name predicate)) + #+(or :Genera (and :Lucid (not :Prime)) ExCL :coral) + (let* ((specifier `(satisfies ,predicate)) + (expand-fn #'(lambda (&rest ignore) + (declare (ignore ignore)) + specifier))) + ;; Specific ports can insert their own way of doing this. Many + ;; ports may find the expand-fn defined above useful. + ;; + (or #+:Genera + (setf (get name 'deftype) expand-fn) + #+(and :Lucid (not :Prime)) + (system::define-macro `(deftype ,name) expand-fn nil) + #+ExCL + (setf (get name 'excl::deftype-expander) expand-fn) + #+:coral + (setf (get name 'ccl::deftype-expander) expand-fn))) + #-(or :Genera (and :Lucid (not :Prime)) ExCL :coral cmu17) + ;; This is the default for ports for which we don't know any + ;; better. Note that for most ports, providing this definition + ;; should just speed up class definition. It shouldn't have an + ;; effect on performance of most user code. + (eval `(deftype ,name () '(satisfies ,predicate)))) + +(defun make-type-predicate-name (name &optional kind) + (if (symbol-package name) + (intern (format nil + "~@[~A ~]TYPE-PREDICATE ~A ~A" + kind + (package-name (symbol-package name)) + (symbol-name name)) + *the-pcl-package*) + (make-symbol (format nil + "~@[~A ~]TYPE-PREDICATE ~A" + kind + (symbol-name name))))) + + + +(defvar *built-in-class-symbols* ()) +(defvar *built-in-wrapper-symbols* ()) + +(defun get-built-in-class-symbol (class-name) + (or (cadr (assq class-name *built-in-class-symbols*)) + (let ((symbol (intern (format nil + "*THE-CLASS-~A*" + (symbol-name class-name)) + *the-pcl-package*))) + (push (list class-name symbol) *built-in-class-symbols*) + symbol))) + +(defun get-built-in-wrapper-symbol (class-name) + (or (cadr (assq class-name *built-in-wrapper-symbols*)) + (let ((symbol (intern (format nil + "*THE-WRAPPER-OF-~A*" + (symbol-name class-name)) + *the-pcl-package*))) + (push (list class-name symbol) *built-in-wrapper-symbols*) + symbol))) + + + + +(pushnew 'class *variable-declarations*) +(pushnew 'variable-rebinding *variable-declarations*) + +(defun variable-class (var env) + (caddr (variable-declaration 'class var env))) + +(defvar *name->class->slotd-table* (make-hash-table)) + + +;;; +;;; This is used by combined methods to communicate the next methods to +;;; the methods they call. This variable is captured by a lexical variable +;;; of the methods to give it the proper lexical scope. +;;; +(defvar *next-methods* nil) + +(defvar *not-an-eql-specializer* '(not-an-eql-specializer)) + +(defvar *umi-gfs*) +(defvar *umi-complete-classes*) +(defvar *umi-reorder*) + +(defvar *invalidate-discriminating-function-force-p* ()) +(defvar *invalid-dfuns-on-stack* ()) + + +(defvar *standard-method-combination*) + +(defvar *slotd-unsupplied* (list '*slotd-unsupplied*)) ;*** + + +(defmacro define-gf-predicate (predicate-name &rest classes) + `(progn + (defmethod ,predicate-name ((x t)) nil) + ,@(mapcar #'(lambda (c) `(defmethod ,predicate-name ((x ,c)) t)) + classes))) + +(defun make-class-predicate-name (name) + (intern (format nil "~A::~A class predicate" + (package-name (symbol-package name)) + name) + *the-pcl-package*)) + +(defun plist-value (object name) + (getf (object-plist object) name)) + +(defun #-setf SETF\ PCL\ PLIST-VALUE #+setf (setf plist-value) (new-value object name) + (if new-value + (setf (getf (object-plist object) name) new-value) + (progn + (remf (object-plist object) name) + nil))) + + + +(defvar *built-in-classes* + ;; + ;; name supers subs cdr of cpl + ;; prototype + '(;(t () (number sequence array character symbol) ()) + (number (t) (complex real) (t)) + (real (number) (float rational) (number t)) + (complex (number) () (number t) #c(1 1)) + (float (real) () (real number t) 1.0) + (rational (real) (integer ratio) (real number t)) + (integer (rational) () (rational real number t) 1) + (ratio (rational) () (rational real number t) 1/2) + + (sequence (t) (list vector) (t)) + (list (sequence) (cons null) (sequence t)) + (cons (list) () (list sequence t) + (nil)) + + + (array (t) (vector) (t) + #2A((NIL))) + (vector (array + sequence) (string bit-vector) (array sequence t) + #()) + (string (vector) () (vector array sequence t) + "") + (bit-vector (vector) () (vector array sequence t) + #*1) + (character (t) () (t) + #\c) + + (symbol (t) (null) (t) + symbol) + (null (symbol + list) () (symbol list sequence t) + nil))) + +#+cmu17 +(labels ((direct-supers (class) + (if (typep class 'lisp:built-in-class) + (kernel:built-in-class-direct-superclasses class) + (let ((inherits (kernel:layout-inherits + (kernel:class-layout class)))) + (list (svref inherits (1- (length inherits))))))) + (direct-subs (class) + (ext:collect ((res)) + (let ((subs (kernel:class-subclasses class))) + (when subs + (ext:do-hash (sub v subs) + (declare (ignore v)) + (when (member class (direct-supers sub)) + (res sub))))) + (res)))) + (ext:collect ((res)) + (dolist (bic kernel::built-in-classes) + (let* ((name (car bic)) + (class (lisp:find-class name))) + (unless (member name '(t kernel:instance kernel:funcallable-instance + function)) + (res `(,name + ,(mapcar #'lisp:class-name (direct-supers class)) + ,(mapcar #'lisp:class-name (direct-subs class)) + ,(map 'list #'(lambda (x) + (lisp:class-name (kernel:layout-class x))) + (reverse + (kernel:layout-inherits + (kernel:class-layout class)))) + ,(let ((found (assoc name *built-in-classes*))) + (if found (fifth found) 42))))))) + (setq *built-in-classes* (res)))) + + +;;; +;;; The classes that define the kernel of the metabraid. +;;; +(defclass t () () + (:metaclass built-in-class)) + +#+cmu17 +(progn + (defclass kernel:instance (t) () + (:metaclass built-in-class)) + + (defclass function (t) () + (:metaclass built-in-class)) + + (defclass kernel:funcallable-instance (function) () + (:metaclass built-in-class))) + +(defclass slot-object (#-cmu17 t #+cmu17 kernel:instance) () + (:metaclass slot-class)) + +(defclass structure-object (slot-object) () + (:metaclass structure-class)) + +(defstruct (#-cmu17 structure-object #+cmu17 dead-beef-structure-object + (:constructor |STRUCTURE-OBJECT class constructor|))) + + +(defclass standard-object (slot-object) ()) + +(defclass metaobject (standard-object) ()) + +(defclass specializer (metaobject) + ((type + :initform nil + :reader specializer-type))) + +(defclass definition-source-mixin (standard-object) + ((source + :initform (load-truename) + :reader definition-source + :initarg :definition-source))) + +(defclass plist-mixin (standard-object) + ((plist + :initform () + :accessor object-plist))) + +(defclass documentation-mixin (plist-mixin) + ()) + +(defclass dependent-update-mixin (plist-mixin) + ()) + +;;; +;;; The class CLASS is a specified basic class. It is the common superclass +;;; of any kind of class. That is any class that can be a metaclass must +;;; have the class CLASS in its class precedence list. +;;; +(defclass class (documentation-mixin dependent-update-mixin definition-source-mixin + specializer) + ((name + :initform nil + :initarg :name + :accessor class-name) + (class-eq-specializer + :initform nil + :reader class-eq-specializer) + (direct-superclasses + :initform () + :reader class-direct-superclasses) + (direct-subclasses + :initform () + :reader class-direct-subclasses) + (direct-methods + :initform (cons nil nil)) + (predicate-name + :initform nil + :reader class-predicate-name))) + +;;; +;;; The class PCL-CLASS is an implementation-specific common superclass of +;;; all specified subclasses of the class CLASS. +;;; +(defclass pcl-class (class) + ((class-precedence-list + :reader class-precedence-list) + (can-precede-list + :initform () + :reader class-can-precede-list) + (incompatible-superclass-list + :initform () + :accessor class-incompatible-superclass-list) + (wrapper + :initform nil + :reader class-wrapper) + (prototype + :initform nil + :reader class-prototype))) + +(defclass slot-class (pcl-class) + ((direct-slots + :initform () + :accessor class-direct-slots) + (slots + :initform () + :accessor class-slots) + (initialize-info + :initform nil + :accessor class-initialize-info))) + +;;; +;;; The class STD-CLASS is an implementation-specific common superclass of +;;; the classes STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS. +;;; +(defclass std-class (slot-class) + ()) + +(defclass standard-class (std-class) + ()) + +(defclass funcallable-standard-class (std-class) + ()) + +(defclass forward-referenced-class (pcl-class) ()) + +(defclass built-in-class (pcl-class) ()) + +(defclass structure-class (slot-class) + ((defstruct-form + :initform () + :accessor class-defstruct-form) + (defstruct-constructor + :initform nil + :accessor class-defstruct-constructor) + (from-defclass-p + :initform nil + :initarg :from-defclass-p))) + + +(defclass specializer-with-object (specializer) ()) + +(defclass exact-class-specializer (specializer) ()) + +(defclass class-eq-specializer (exact-class-specializer specializer-with-object) + ((object :initarg :class :reader specializer-class :reader specializer-object))) + +(defclass class-prototype-specializer (specializer-with-object) + ((object :initarg :class :reader specializer-class :reader specializer-object))) + +(defclass eql-specializer (exact-class-specializer specializer-with-object) + ((object :initarg :object :reader specializer-object + :reader eql-specializer-object))) + +(defvar *eql-specializer-table* (make-hash-table :test 'eql)) + +(defun intern-eql-specializer (object) + (or (gethash object *eql-specializer-table*) + (setf (gethash object *eql-specializer-table*) + (make-instance 'eql-specializer :object object)))) + + +;;; +;;; Slot definitions. +;;; +(defclass slot-definition (metaobject) + ((name + :initform nil + :initarg :name + :accessor slot-definition-name) + (initform + :initform nil + :initarg :initform + :accessor slot-definition-initform) + (initfunction + :initform nil + :initarg :initfunction + :accessor slot-definition-initfunction) + (readers + :initform nil + :initarg :readers + :accessor slot-definition-readers) + (writers + :initform nil + :initarg :writers + :accessor slot-definition-writers) + (initargs + :initform nil + :initarg :initargs + :accessor slot-definition-initargs) + (type + :initform t + :initarg :type + :accessor slot-definition-type) + (documentation + :initform "" + :initarg :documentation) + (class + :initform nil + :initarg :class + :accessor slot-definition-class))) + +(defclass standard-slot-definition (slot-definition) + ((allocation + :initform :instance + :initarg :allocation + :accessor slot-definition-allocation))) + +(defclass structure-slot-definition (slot-definition) + ((defstruct-accessor-symbol + :initform nil + :initarg :defstruct-accessor-symbol + :accessor slot-definition-defstruct-accessor-symbol) + (internal-reader-function + :initform nil + :initarg :internal-reader-function + :accessor slot-definition-internal-reader-function) + (internal-writer-function + :initform nil + :initarg :internal-writer-function + :accessor slot-definition-internal-writer-function))) + +(defclass direct-slot-definition (slot-definition) + ()) + +(defclass effective-slot-definition (slot-definition) + ((reader-function ; #'(lambda (object) ...) + :accessor slot-definition-reader-function) + (writer-function ; #'(lambda (new-value object) ...) + :accessor slot-definition-writer-function) + (boundp-function ; #'(lambda (object) ...) + :accessor slot-definition-boundp-function) + (accessor-flags + :initform 0))) + +(defclass standard-direct-slot-definition (standard-slot-definition + direct-slot-definition) + ()) + +(defclass standard-effective-slot-definition (standard-slot-definition + effective-slot-definition) + ((location ; nil, a fixnum, a cons: (slot-name . value) + :initform nil + :accessor slot-definition-location))) + +(defclass structure-direct-slot-definition (structure-slot-definition + direct-slot-definition) + ()) + +(defclass structure-effective-slot-definition (structure-slot-definition + effective-slot-definition) + ()) + +(defclass method (metaobject) ()) + +(defclass standard-method (definition-source-mixin plist-mixin method) + ((generic-function + :initform nil + :accessor method-generic-function) +; (qualifiers +; :initform () +; :initarg :qualifiers +; :reader method-qualifiers) + (specializers + :initform () + :initarg :specializers + :reader method-specializers) + (lambda-list + :initform () + :initarg :lambda-list + :reader method-lambda-list) + (function + :initform nil + :initarg :function) ;no writer + (fast-function + :initform nil + :initarg :fast-function ;no writer + :reader method-fast-function) +; (documentation +; :initform nil +; :initarg :documentation +; :reader method-documentation) + )) + +(defclass standard-accessor-method (standard-method) + ((slot-name :initform nil + :initarg :slot-name + :reader accessor-method-slot-name) + (slot-definition :initform nil + :initarg :slot-definition + :reader accessor-method-slot-definition))) + +(defclass standard-reader-method (standard-accessor-method) ()) + +(defclass standard-writer-method (standard-accessor-method) ()) + +(defclass standard-boundp-method (standard-accessor-method) ()) + +(defclass generic-function (dependent-update-mixin + definition-source-mixin + documentation-mixin + metaobject + #+cmu17 kernel:funcallable-instance) + () + (:metaclass funcallable-standard-class)) + +(defclass standard-generic-function (generic-function) + ((name + :initform nil + :initarg :name + :accessor generic-function-name) + (methods + :initform () + :accessor generic-function-methods) + (method-class + :initarg :method-class + :accessor generic-function-method-class) + (method-combination + :initarg :method-combination + :accessor generic-function-method-combination) + (arg-info + :initform (make-arg-info) + :reader gf-arg-info) + (dfun-state + :initform () + :accessor gf-dfun-state) + (pretty-arglist + :initform () + :accessor gf-pretty-arglist) + ) + (:metaclass funcallable-standard-class) + (:default-initargs :method-class *the-class-standard-method* + :method-combination *standard-method-combination*)) + +(defclass method-combination (metaobject) ()) + +(defclass standard-method-combination + (definition-source-mixin method-combination) + ((type :reader method-combination-type + :initarg :type) + (documentation :reader method-combination-documentation + :initarg :documentation) + (options :reader method-combination-options + :initarg :options))) + +(defparameter *early-class-predicates* + '((specializer specializerp) + (exact-class-specializer exact-class-specializer-p) + (class-eq-specializer class-eq-specializer-p) + (eql-specializer eql-specializer-p) + (class classp) + (slot-class slot-class-p) + (standard-class standard-class-p) + (funcallable-standard-class funcallable-standard-class-p) + (structure-class structure-class-p) + (forward-referenced-class forward-referenced-class-p) + (method method-p) + (standard-method standard-method-p) + (standard-accessor-method standard-accessor-method-p) + (standard-reader-method standard-reader-method-p) + (standard-writer-method standard-writer-method-p) + (standard-boundp-method standard-boundp-method-p) + (generic-function generic-function-p) + (standard-generic-function standard-generic-function-p) + (method-combination method-combination-p))) + diff --git a/pcl/gcl_pcl_dfun.lisp b/pcl/gcl_pcl_dfun.lisp new file mode 100644 index 0000000..01aca3b --- /dev/null +++ b/pcl/gcl_pcl_dfun.lisp @@ -0,0 +1,1617 @@ +;;; -*- Mode:LISP; Package:PCL; Base:10; Syntax:Common-Lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +#| + +This implementation of method lookup was redone in early August of 89. + +It has the following properties: + + - It's modularity makes it easy to modify the actual caching algorithm. + The caching algorithm is almost completely separated into the files + cache.lisp and dlap.lisp. This file just contains the various uses + of it. There will be more tuning as we get more results from Luis' + measurements of caching behavior. + + - The metacircularity issues have been dealt with properly. All of + PCL now grounds out properly. Moreover, it is now possible to have + metaobject classes which are themselves not instances of standard + metaobject classes. + +** Modularity of the code ** + +The actual caching algorithm is isolated in a modest number of functions. +The code which generates cache lookup code is all found in cache.lisp and +dlap.lisp. Certain non-wrapper-caching special cases are in this file. + + +** Handling the metacircularity ** + +In CLOS, method lookup is the potential source of infinite metacircular +regress. The metaobject protocol specification gives us wide flexibility +in how to address this problem. PCL uses a technique which handles the +problem not only for the metacircular language described in Chapter 3, but +also for the PCL protocol which includes additional generic functions +which control more aspects of the CLOS implementation. + +The source of the metacircular regress can be seen in a number of ways. +One is that the specified method lookup protocol must, as part of doing +the method lookup (or at least the cache miss case), itself call generic +functions. It is easy to see that if the method lookup for a generic +function ends up calling that same generic function there can be trouble. + +Fortunately, there is an easy solution at hand. The solution is based on +the restriction that portable code cannot change the class of a specified +metaobject. This restriction implies that for specified generic functions, +the method lookup protocol they follow is fixed. + +More precisely, for such specified generic functions, most generic functions +that are called during their own method lookup will not run portable methods. +This allows the implementation to usurp the actual generic function call in +this case. In short, method lookup of a standard generic function, in the +case where the only applicable methods are themselves standard doesn't +have to do any method lookup to implement itself. + +And so, we are saved. + +|# + + +;An alist in which each entry is of the form : +; ( . ( ...)) +;Each subentry is of the form: +; ( ) +(defvar *dfun-constructors* ()) + +;If this is NIL, then the whole mechanism +;for caching dfun constructors is turned +;off. The only time that makes sense is +;when debugging LAP code. +(defvar *enable-dfun-constructor-caching* t) + +(defun show-dfun-constructors () + (format t "~&DFUN constructor caching is ~A." + (if *enable-dfun-constructor-caching* + "enabled" "disabled")) + (dolist (generator-entry *dfun-constructors*) + (dolist (args-entry (cdr generator-entry)) + (format t "~&~S ~S ~A" + (cons (car generator-entry) (car args-entry)) + (caddr args-entry) + (if (cadddr args-entry) "(preliminary)" ""))))) + +(defvar *raise-metatypes-to-class-p* t) + +(defun get-dfun-constructor (generator &rest args) + (when (and *raise-metatypes-to-class-p* + (member generator + '(emit-checking emit-caching + emit-in-checking-cache-p emit-constant-value))) + (setq args (cons (mapcar #'(lambda (mt) + (if (eq mt 't) + mt + 'class)) + (car args)) + (cdr args)))) + (let* ((generator-entry (assq generator *dfun-constructors*)) + (args-entry (assoc args (cdr generator-entry) :test #'equal))) + (if (null *enable-dfun-constructor-caching*) + (apply (the function (symbol-function generator)) args) + (or (cadr args-entry) + (multiple-value-bind (new not-best-p) + (apply (the function (symbol-function generator)) args) + (let ((entry (list (copy-list args) new + (unless not-best-p '+pcl+) + not-best-p))) + (if generator-entry + (push entry (cdr generator-entry)) + (push (list generator entry) + *dfun-constructors*))) + (values new not-best-p)))))) + +(defun load-precompiled-dfun-constructor (generator args system constructor) + (let* ((generator-entry (assq generator *dfun-constructors*)) + (args-entry (assoc args (cdr generator-entry) :test #'equal))) + (if args-entry + (when (fourth args-entry) + (let* ((dfun-type (case generator + (emit-checking 'checking) + (emit-caching 'caching) + (emit-constant-value 'constant-value) + (emit-default-only 'default-method-only))) + (metatypes (car args)) + (gfs (when dfun-type (gfs-of-type dfun-type)))) + (dolist (gf gfs) + (when (and (equal metatypes (arg-info-metatypes (gf-arg-info gf))) + (let ((gf-name (generic-function-name gf))) + (and (not (eq gf-name 'slot-value-using-class)) + (not (equal gf-name '(setf slot-value-using-class))) + (not (eq gf-name 'slot-boundp-using-class))))) + (update-dfun gf))) + (setf (second args-entry) constructor) + (setf (third args-entry) system) + (setf (fourth args-entry) nil))) + (let ((entry (list args constructor system nil))) + (if generator-entry + (push entry (cdr generator-entry)) + (push (list generator entry) *dfun-constructors*)))))) + +(defmacro precompile-dfun-constructors (&optional system) + (let ((*precompiling-lap* t)) + `(progn + ,@(gathering1 (collecting) + (dolist (generator-entry *dfun-constructors*) + (dolist (args-entry (cdr generator-entry)) + (when (or (null (caddr args-entry)) + (eq (caddr args-entry) system)) + (when system (setf (caddr args-entry) system)) + (gather1 + (make-top-level-form `(precompile-dfun-constructor + ,(car generator-entry)) + '(load) + `(load-precompiled-dfun-constructor + ',(car generator-entry) + ',(car args-entry) + ',system + ,(apply (symbol-function (car generator-entry)) + (car args-entry)))))))))))) + + +;;; +;;; When all the methods of a generic function are automatically generated +;;; reader or writer methods a number of special optimizations are possible. +;;; These are important because of the large number of generic functions of +;;; this type. +;;; +;;; There are a number of cases: +;;; +;;; ONE-CLASS-ACCESSOR +;;; In this case, the accessor generic function has only been called +;;; with one class of argument. There is no cache vector, the wrapper +;;; of the one class, and the slot index are stored directly as closure +;;; variables of the discriminating function. This case can convert to +;;; either of the next kind. +;;; +;;; TWO-CLASS-ACCESSOR +;;; Like above, but two classes. This is common enough to do specially. +;;; There is no cache vector. The two classes are stored a separate +;;; closure variables. +;;; +;;; ONE-INDEX-ACCESSOR +;;; In this case, the accessor generic function has seen more than one +;;; class of argument, but the index of the slot is the same for all +;;; the classes that have been seen. A cache vector is used to store +;;; the wrappers that have been seen, the slot index is stored directly +;;; as a closure variable of the discriminating function. This case +;;; can convert to the next kind. +;;; +;;; N-N-ACCESSOR +;;; This is the most general case. In this case, the accessor generic +;;; function has seen more than one class of argument and more than one +;;; slot index. A cache vector stores the wrappers and corresponding +;;; slot indexes. Because each cache line is more than one element +;;; long, a cache lock count is used. +;;; +(defstruct (dfun-info + (:constructor nil) + (:print-function print-dfun-info)) + (cache nil)) + +(defun print-dfun-info (dfun-info stream depth) + (declare (ignore depth) (stream stream)) + (printing-random-thing (dfun-info stream) + (format stream "~A" (type-of dfun-info)))) + +(defstruct (no-methods + (:constructor no-methods-dfun-info ()) + (:include dfun-info))) + +(defstruct (initial + (:constructor initial-dfun-info ()) + (:include dfun-info))) + +(defstruct (initial-dispatch + (:constructor initial-dispatch-dfun-info ()) + (:include dfun-info))) + +(defstruct (dispatch + (:constructor dispatch-dfun-info ()) + (:include dfun-info))) + +(defstruct (default-method-only + (:constructor default-method-only-dfun-info ()) + (:include dfun-info))) + +;without caching: +; dispatch one-class two-class default-method-only + +;with caching: +; one-index n-n checking caching + +;accessor: +; one-class two-class one-index n-n +(defstruct (accessor-dfun-info + (:constructor nil) + (:include dfun-info)) + accessor-type) ; (member reader writer) + +(defmacro dfun-info-accessor-type (di) + `(accessor-dfun-info-accessor-type ,di)) + +(defstruct (one-index-dfun-info + (:constructor nil) + (:include accessor-dfun-info)) + index) + +(defmacro dfun-info-index (di) + `(one-index-dfun-info-index ,di)) + +(defstruct (n-n + (:constructor n-n-dfun-info (accessor-type cache)) + (:include accessor-dfun-info))) + +(defstruct (one-class + (:constructor one-class-dfun-info (accessor-type index wrapper0)) + (:include one-index-dfun-info)) + wrapper0) + +(defmacro dfun-info-wrapper0 (di) + `(one-class-wrapper0 ,di)) + +(defstruct (two-class + (:constructor two-class-dfun-info (accessor-type index wrapper0 wrapper1)) + (:include one-class)) + wrapper1) + +(defmacro dfun-info-wrapper1 (di) + `(two-class-wrapper1 ,di)) + +(defstruct (one-index + (:constructor one-index-dfun-info + (accessor-type index cache)) + (:include one-index-dfun-info))) + +(defstruct (checking + (:constructor checking-dfun-info (function cache)) + (:include dfun-info)) + function) + +(defmacro dfun-info-function (di) + `(checking-function ,di)) + +(defstruct (caching + (:constructor caching-dfun-info (cache)) + (:include dfun-info))) + +(defstruct (constant-value + (:constructor constant-value-dfun-info (cache)) + (:include dfun-info))) + +(defmacro dfun-update (generic-function function &rest args) + `(multiple-value-bind (dfun cache info) + (funcall ,function ,generic-function ,@args) + (update-dfun ,generic-function dfun cache info))) + +(defun accessor-miss-function (gf dfun-info) + (ecase (dfun-info-accessor-type dfun-info) + (reader + #'(lambda (arg) + (declare (pcl-fast-call)) + (accessor-miss gf nil arg dfun-info))) + (writer + #'(lambda (new arg) + (declare (pcl-fast-call)) + (accessor-miss gf new arg dfun-info))))) + +#+cmu +(declaim (ext:freeze-type dfun-info)) + + +;;; +;;; ONE-CLASS-ACCESSOR +;;; +(defun make-one-class-accessor-dfun (gf type wrapper index) + (let ((emit (if (eq type 'reader) 'emit-one-class-reader 'emit-one-class-writer)) + (dfun-info (one-class-dfun-info type index wrapper))) + (values + (funcall (the function (get-dfun-constructor emit (consp index))) + wrapper index + (accessor-miss-function gf dfun-info)) + nil + dfun-info))) + +;;; +;;; TWO-CLASS-ACCESSOR +;;; +(defun make-two-class-accessor-dfun (gf type w0 w1 index) + (let ((emit (if (eq type 'reader) 'emit-two-class-reader 'emit-two-class-writer)) + (dfun-info (two-class-dfun-info type index w0 w1))) + (values + (funcall (the function (get-dfun-constructor emit (consp index))) + w0 w1 index + (accessor-miss-function gf dfun-info)) + nil + dfun-info))) + +;;; +;;; std accessors same index dfun +;;; +(defun make-one-index-accessor-dfun (gf type index &optional cache) + (let* ((emit (if (eq type 'reader) 'emit-one-index-readers 'emit-one-index-writers)) + (cache (or cache (get-cache 1 nil #'one-index-limit-fn 4))) + (dfun-info (one-index-dfun-info type index cache))) + (declare (type cache cache)) + (values + (funcall (the function (get-dfun-constructor emit (consp index))) + cache + index + (accessor-miss-function gf dfun-info)) + cache + dfun-info))) + +(defun make-final-one-index-accessor-dfun (gf type index table) + (let ((cache (fill-dfun-cache table nil 1 #'one-index-limit-fn))) + (make-one-index-accessor-dfun gf type index cache))) + +(defun one-index-limit-fn (nlines) + (default-limit-fn nlines)) + + +(defun make-n-n-accessor-dfun (gf type &optional cache) + (let* ((emit (if (eq type 'reader) 'emit-n-n-readers 'emit-n-n-writers)) + (cache (or cache (get-cache 1 t #'n-n-accessors-limit-fn 2))) + (dfun-info (n-n-dfun-info type cache))) + (declare (type cache cache)) + (values + (funcall (the function (get-dfun-constructor emit)) + cache + (accessor-miss-function gf dfun-info)) + cache + dfun-info))) + +(defun make-final-n-n-accessor-dfun (gf type table) + (let ((cache (fill-dfun-cache table t 1 #'n-n-accessors-limit-fn))) + (make-n-n-accessor-dfun gf type cache))) + +(defun n-n-accessors-limit-fn (nlines) + (default-limit-fn nlines)) + +(defun make-checking-dfun (generic-function function &optional cache) + (unless cache + (when (use-caching-dfun-p generic-function) + (return-from make-checking-dfun (make-caching-dfun generic-function))) + (when (use-dispatch-dfun-p generic-function) + (return-from make-checking-dfun (make-dispatch-dfun generic-function)))) + (multiple-value-bind (nreq applyp metatypes nkeys) + (get-generic-function-info generic-function) + (declare (ignore nreq)) + (if (every #'(lambda (mt) (eq mt 't)) metatypes) + (let ((dfun-info (default-method-only-dfun-info))) + (values + (funcall (the function (get-dfun-constructor + 'emit-default-only metatypes applyp)) + function) + nil + dfun-info)) + (let* ((cache (or cache (get-cache nkeys nil #'checking-limit-fn 2))) + (dfun-info (checking-dfun-info function cache))) + (values + (funcall (the function (get-dfun-constructor + 'emit-checking metatypes applyp)) + cache + function + #'(lambda (&rest args) + (declare (pcl-fast-call)) + #+copy-&rest-arg (setq args (copy-list args)) + (checking-miss generic-function args dfun-info))) + cache + dfun-info))))) + +(defun make-final-checking-dfun (generic-function function + classes-list new-class) + (let ((metatypes (arg-info-metatypes (gf-arg-info generic-function)))) + (if (every #'(lambda (mt) (eq mt 't)) metatypes) + (values #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) + (invoke-emf function args)) + nil (default-method-only-dfun-info)) + (let ((cache (make-final-ordinary-dfun-internal + generic-function nil #'checking-limit-fn + classes-list new-class))) + (make-checking-dfun generic-function function cache))))) + +(defun use-default-method-only-dfun-p (generic-function) + (multiple-value-bind (nreq applyp metatypes nkeys) + (get-generic-function-info generic-function) + (declare (ignore nreq applyp nkeys)) + (every #'(lambda (mt) (eq mt 't)) metatypes))) + +(defun use-caching-dfun-p (generic-function) + (some #'(lambda (method) + (let ((fmf (if (listp method) + (third method) + (method-fast-function method)))) + (method-function-get fmf ':slot-name-lists))) + (if (early-gf-p generic-function) + (early-gf-methods generic-function) + (generic-function-methods generic-function)))) + +(defun checking-limit-fn (nlines) + (default-limit-fn nlines)) + + +;;; +;;; +;;; +(defun make-caching-dfun (generic-function &optional cache) + (unless cache + (when (use-constant-value-dfun-p generic-function) + (return-from make-caching-dfun (make-constant-value-dfun generic-function))) + (when (use-dispatch-dfun-p generic-function) + (return-from make-caching-dfun (make-dispatch-dfun generic-function)))) + (multiple-value-bind (nreq applyp metatypes nkeys) + (get-generic-function-info generic-function) + (declare (ignore nreq)) + (let* ((cache (or cache (get-cache nkeys t #'caching-limit-fn 2))) + (dfun-info (caching-dfun-info cache))) + (values + (funcall (the function (get-dfun-constructor + 'emit-caching metatypes applyp)) + cache + #'(lambda (&rest args) + (declare (pcl-fast-call)) + #+copy-&rest-arg (setq args (copy-list args)) + (caching-miss generic-function args dfun-info))) + cache + dfun-info)))) + +(defun make-final-caching-dfun (generic-function classes-list new-class) + (let ((cache (make-final-ordinary-dfun-internal + generic-function t #'caching-limit-fn + classes-list new-class))) + (make-caching-dfun generic-function cache))) + +(defun caching-limit-fn (nlines) + (default-limit-fn nlines)) + +(defun insure-dfun (gf caching-p) + (multiple-value-bind (nreq applyp metatypes nkeys) + (get-generic-function-info gf) + (declare (ignore nreq nkeys)) + (when (or (null metatypes) + (not (null (car metatypes)))) + (cond ((use-constant-value-dfun-p gf) + (get-dfun-constructor 'emit-constant-value metatypes)) + (caching-p + (get-dfun-constructor 'emit-caching metatypes applyp)) + ((dolist (mt metatypes t) (unless (eq mt 't) (return nil))) + (get-dfun-constructor 'emit-default-only metatypes applyp)) + (t + (get-dfun-constructor 'emit-checking metatypes applyp)))))) + +(defun use-constant-value-dfun-p (gf &optional boolean-values-p) + (multiple-value-bind (nreq applyp metatypes nkeys) + (get-generic-function-info gf) + (declare (ignore nreq metatypes nkeys)) + (let* ((early-p (early-gf-p gf)) + (methods (if early-p + (early-gf-methods gf) + (generic-function-methods gf))) + (default '(unknown))) + (and (null applyp) + (or (not (eq *boot-state* 'complete)) + (compute-applicable-methods-emf-std-p gf)) + (notany #'(lambda (method) + (or (and (eq *boot-state* 'complete) + (some #'eql-specializer-p + (method-specializers method))) + (let ((value (method-function-get + (if early-p + (or (third method) (second method)) + (or (method-fast-function method) + (method-function method))) + :constant-value default))) + (if boolean-values-p + (not (or (eq value 't) (eq value nil))) + (eq value default))))) + methods))))) + +(defun make-constant-value-dfun (generic-function &optional cache) + (multiple-value-bind (nreq applyp metatypes nkeys) + (get-generic-function-info generic-function) + (declare (ignore nreq applyp)) + (let* ((cache (or cache (get-cache nkeys t #'caching-limit-fn 2))) + (dfun-info (constant-value-dfun-info cache))) + (values + (funcall (the function (get-dfun-constructor + 'emit-constant-value metatypes)) + cache + #'(lambda (&rest args) + (declare (pcl-fast-call)) + #+copy-&rest-arg (setq args (copy-list args)) + (constant-value-miss generic-function args dfun-info))) + cache + dfun-info)))) + +(defun make-final-constant-value-dfun (generic-function classes-list new-class) + (let ((cache (make-final-ordinary-dfun-internal + generic-function :constant-value #'caching-limit-fn + classes-list new-class))) + (make-constant-value-dfun generic-function cache))) + +(defun use-dispatch-dfun-p (gf &optional (caching-p (use-caching-dfun-p gf))) + (when (eq *boot-state* 'complete) + (unless caching-p + ;; This should return T when almost all dispatching is by + ;; eql specializers or built-in classes. In other words, + ;; return NIL if we might ever need to do more than + ;; one (non built-in) typep. + ;; Otherwise, it is probably at least as fast to use + ;; a caching dfun first, possibly followed by secondary dispatching. + (let ((caching-cost (caching-dfun-cost gf))) + (< (dispatch-dfun-cost gf caching-cost) caching-cost))))) + +;; Try this on print-object, find-method-combination, and documentation. +;; Look at pcl/generic-functions.lisp for other potential test cases. +(defun show-dfun-costs (gf) + (when (or (symbolp gf) (consp gf)) + (setq gf (gdefinition gf))) + (format t "~&Name ~S caching cost ~D dispatch cost ~D~%" + (generic-function-name gf) + (caching-dfun-cost gf) + (dispatch-dfun-cost gf))) + +(defparameter *non-built-in-typep-cost* 1) +(defparameter *structure-typep-cost* 1) +(defparameter *built-in-typep-cost* 0) + +(defun dispatch-dfun-cost (gf &optional limit) + (generate-discrimination-net-internal + gf (generic-function-methods gf) nil + #'(lambda (methods known-types) + (declare (ignore methods known-types)) + 0) + #'(lambda (position type true-value false-value) + (declare (ignore position)) + (let* ((type-test-cost + (if (eq 'class (car type)) + (let* ((metaclass (class-of (cadr type))) + (mcpl (class-precedence-list metaclass))) + (cond ((memq *the-class-built-in-class* mcpl) + *built-in-typep-cost*) + ((memq *the-class-structure-class* mcpl) + *structure-typep-cost*) + (t + *non-built-in-typep-cost*))) + 0)) + (max-cost-so-far + (+ (max true-value false-value) type-test-cost))) + (when (and limit (<= limit max-cost-so-far)) + (return-from dispatch-dfun-cost max-cost-so-far)) + max-cost-so-far)) + #'identity)) + +(defparameter *cache-lookup-cost* 1) +(defparameter *wrapper-of-cost* 0) +(defparameter *secondary-dfun-call-cost* 1) + +(defun caching-dfun-cost (gf) + (let* ((arg-info (gf-arg-info gf)) + (nreq (length (arg-info-metatypes arg-info)))) + (+ *cache-lookup-cost* + (* *wrapper-of-cost* nreq) + (if (methods-contain-eql-specializer-p + (generic-function-methods gf)) + *secondary-dfun-call-cost* + 0)))) + +#+cmu +(progn + (setq *non-built-in-typep-cost* 100) + (setq *structure-typep-cost* 15) + (setq *built-in-typep-cost* 5) + (setq *cache-lookup-cost* 30) + (setq *wrapper-of-cost* 15) + (setq *secondary-dfun-call-cost* 30)) + + +(defun make-dispatch-dfun (gf) + (values (get-dispatch-function gf) nil (dispatch-dfun-info))) + +(defun get-dispatch-function (gf) + (let ((methods (generic-function-methods gf))) + (function-funcall (get-secondary-dispatch-function1 gf methods nil nil nil + nil nil t) + nil nil))) + +(defun make-final-dispatch-dfun (gf) + (make-dispatch-dfun gf)) + +(defun update-dispatch-dfuns () + (dolist (gf (gfs-of-type '(dispatch initial-dispatch))) + (dfun-update gf #'make-dispatch-dfun))) + +(defun fill-dfun-cache (table valuep nkeys limit-fn &optional cache) + (let ((cache (or cache (get-cache nkeys valuep limit-fn + (+ (hash-table-count table) 3))))) + (maphash #'(lambda (classes value) + (setq cache (fill-cache cache + (class-wrapper classes) + value + t))) + table) + cache)) + +(defun make-final-ordinary-dfun-internal (generic-function valuep limit-fn + classes-list new-class) + (let* ((arg-info (gf-arg-info generic-function)) + (nkeys (arg-info-nkeys arg-info)) + (new-class (and new-class + (equal (type-of (gf-dfun-info generic-function)) + (cond ((eq valuep t) 'caching) + ((eq valuep :constant-value) 'constant-value) + ((null valuep) 'checking))) + new-class)) + (cache (if new-class + (copy-cache (gf-dfun-cache generic-function)) + (get-cache nkeys (not (null valuep)) limit-fn 4)))) + (make-emf-cache generic-function valuep cache classes-list new-class))) + +(defvar *dfun-miss-gfs-on-stack* ()) + +(defmacro dfun-miss ((gf args wrappers invalidp nemf + &optional type index caching-p applicable) + &body body) + (unless applicable (setq applicable (gensym))) + `(multiple-value-bind (,nemf ,applicable ,wrappers ,invalidp + ,@(when type `(,type ,index))) + (cache-miss-values ,gf ,args ',(cond (caching-p 'caching) + (type 'accessor) + (t 'checking))) + (when (and ,applicable (not (memq ,gf *dfun-miss-gfs-on-stack*))) + (let ((*dfun-miss-gfs-on-stack* (cons ,gf *dfun-miss-gfs-on-stack*))) + ,@body)) + (invoke-emf ,nemf ,args))) + +;;; +;;; The dynamically adaptive method lookup algorithm is implemented is +;;; implemented as a kind of state machine. The kinds of discriminating +;;; function is the state, the various kinds of reasons for a cache miss +;;; are the state transitions. +;;; +;;; The code which implements the transitions is all in the miss handlers +;;; for each kind of dfun. Those appear here. +;;; +;;; Note that within the states that cache, there are dfun updates which +;;; simply select a new cache or cache field. Those are not considered +;;; as state transitions. +;;; +(defvar *lazy-dfun-compute-p* t) +(defvar *early-p* nil) + +(defun make-initial-dfun (gf) + (let ((initial-dfun + (fin-lambda-fn (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) + (initial-dfun gf args)))) + (multiple-value-bind (dfun cache info) + (if (and (eq *boot-state* 'complete) + (compute-applicable-methods-emf-std-p gf)) + (let* ((caching-p (use-caching-dfun-p gf)) + (classes-list (precompute-effective-methods + gf caching-p + (not *lazy-dfun-compute-p*)))) + (if *lazy-dfun-compute-p* + (cond ((use-dispatch-dfun-p gf caching-p) + (values initial-dfun nil (initial-dispatch-dfun-info))) + (t + (insure-dfun gf caching-p) + (values initial-dfun nil (initial-dfun-info)))) + (make-final-dfun-internal gf classes-list))) + (let ((arg-info (if (early-gf-p gf) + (early-gf-arg-info gf) + (gf-arg-info gf))) + (type nil)) + (if (and (gf-precompute-dfun-and-emf-p arg-info) + (setq type (final-accessor-dfun-type gf))) + (if *early-p* + (values (make-early-accessor gf type) nil nil) + (make-final-accessor-dfun gf type)) + (values initial-dfun nil (initial-dfun-info))))) + (set-dfun gf dfun cache info)))) + +(defun make-early-accessor (gf type) + (let* ((methods (early-gf-methods gf)) + (slot-name (early-method-standard-accessor-slot-name (car methods)))) + (ecase type + (reader (fin-lambda-fn (instance) + (let* ((class (class-of instance)) + (class-name (bootstrap-get-slot 'class class 'name))) + (bootstrap-get-slot class-name instance slot-name)))) + (writer (fin-lambda-fn (new-value instance) + (let* ((class (class-of instance)) + (class-name (bootstrap-get-slot 'class class 'name))) + (bootstrap-set-slot class-name instance slot-name new-value))))))) + +(defun initial-dfun (gf args) + (dfun-miss (gf args wrappers invalidp nemf ntype nindex) + (cond (invalidp) + ((and ntype nindex) + (dfun-update + gf #'make-one-class-accessor-dfun ntype wrappers nindex)) + ((use-caching-dfun-p gf) + (dfun-update gf #'make-caching-dfun)) + (t + (dfun-update + gf #'make-checking-dfun + ;; nemf is suitable only for caching, have to do this: + (cache-miss-values gf args 'checking)))))) + +(defun make-final-dfun (gf &optional classes-list) + (multiple-value-bind (dfun cache info) + (make-final-dfun-internal gf classes-list) + (set-dfun gf dfun cache info))) + +(defvar *new-class* nil) + +(defvar *free-hash-tables* (mapcar #'list '(eq equal eql))) + +(defmacro with-hash-table ((table test) &body forms) + `(let* ((.free. (assoc ',test *free-hash-tables*)) + (,table (if (cdr .free.) + (pop (cdr .free.)) + (make-hash-table :test ',test)))) + (multiple-value-prog1 + (progn ,@forms) + (clrhash ,table) + (push ,table (cdr .free.))))) + +(defmacro with-eq-hash-table ((table) &body forms) + `(with-hash-table (,table eq) ,@forms)) + +(defun final-accessor-dfun-type (gf) + (let ((methods (if (early-gf-p gf) + (early-gf-methods gf) + (generic-function-methods gf)))) + (cond ((every #'(lambda (method) + (if (consp method) + (eq *the-class-standard-reader-method* + (early-method-class method)) + (standard-reader-method-p method))) + methods) + 'reader) + ((every #'(lambda (method) + (if (consp method) + (eq *the-class-standard-writer-method* + (early-method-class method)) + (standard-writer-method-p method))) + methods) + 'writer)))) + +(defun make-final-accessor-dfun (gf type &optional classes-list new-class) + (with-eq-hash-table (table) + (multiple-value-bind (table all-index first second size no-class-slots-p) + (make-accessor-table gf type table) + (if table + (cond ((= size 1) + (let ((w (class-wrapper first))) + (make-one-class-accessor-dfun gf type w all-index))) + ((and (= size 2) (or (integerp all-index) (consp all-index))) + (let ((w0 (class-wrapper first)) + (w1 (class-wrapper second))) + (make-two-class-accessor-dfun gf type w0 w1 all-index))) + ((or (integerp all-index) (consp all-index)) + (make-final-one-index-accessor-dfun + gf type all-index table)) + (no-class-slots-p + (make-final-n-n-accessor-dfun gf type table)) + (t + (make-final-caching-dfun gf classes-list new-class))) + (make-final-caching-dfun gf classes-list new-class))))) + +(defun make-final-dfun-internal (gf &optional classes-list) + (let ((methods (generic-function-methods gf)) type + (new-class *new-class*) (*new-class* nil) + specls all-same-p) + (cond ((null methods) + (values + (fin-lambda-fn (&rest args) + (apply #'no-applicable-method gf args)) + nil + (no-methods-dfun-info))) + ((setq type (final-accessor-dfun-type gf)) + (make-final-accessor-dfun gf type classes-list new-class)) + ((and (not (and (every #'(lambda (specl) (eq specl *the-class-t*)) + (setq specls (method-specializers (car methods)))) + (setq all-same-p + (every #'(lambda (method) + (and (equal specls + (method-specializers method)))) + methods)))) + (use-constant-value-dfun-p gf)) + (make-final-constant-value-dfun gf classes-list new-class)) + ((use-dispatch-dfun-p gf) + (make-final-dispatch-dfun gf)) + ((and all-same-p (not (use-caching-dfun-p gf))) + (let ((emf (get-secondary-dispatch-function gf methods nil))) + (make-final-checking-dfun gf emf classes-list new-class))) + (t + (make-final-caching-dfun gf classes-list new-class))))) + +(defun accessor-miss (gf new object dfun-info) + (let* ((ostate (type-of dfun-info)) + (otype (dfun-info-accessor-type dfun-info)) + oindex ow0 ow1 cache + (args (ecase otype ;The congruence rules assure + (reader (list object)) ;us that this is safe despite + (writer (list new object))))) ;not knowing the new type yet. + (dfun-miss (gf args wrappers invalidp nemf ntype nindex) + ;; + ;; The following lexical functions change the state of the + ;; dfun to that which is their name. They accept arguments + ;; which are the parameters of the new state, and get other + ;; information from the lexical variables bound above. + ;; + (flet ((two-class (index w0 w1) + (when (zerop (random 2)) (psetf w0 w1 w1 w0)) + (dfun-update gf #'make-two-class-accessor-dfun ntype w0 w1 index)) + (one-index (index &optional cache) + (dfun-update gf #'make-one-index-accessor-dfun ntype index cache)) + (n-n (&optional cache) + (if (consp nindex) + (dfun-update gf #'make-checking-dfun nemf) + (dfun-update gf #'make-n-n-accessor-dfun ntype cache))) + (caching () ; because cached accessor emfs are much faster for accessors + (dfun-update gf #'make-caching-dfun)) + ;; + (do-fill (update-fn) + (declare (type function update-fn)) + (let ((ncache (fill-cache cache wrappers nindex))) + (unless (eq ncache cache) + (funcall update-fn ncache))))) + (cond ((null ntype) + (caching)) + ((or invalidp + (null nindex))) + ((not #-cmu17 + (or (std-instance-p object) + (fsc-instance-p object)) + #+cmu17 + (pcl-instance-p object)) + (caching)) + ((or (neq ntype otype) (listp wrappers)) + (caching)) + (t + (ecase ostate + (one-class + (setq oindex (dfun-info-index dfun-info)) + (setq ow0 (dfun-info-wrapper0 dfun-info)) + (unless (eq ow0 wrappers) + (if (eql nindex oindex) + (two-class nindex ow0 wrappers) + (n-n)))) + (two-class + (setq oindex (dfun-info-index dfun-info)) + (setq ow0 (dfun-info-wrapper0 dfun-info)) + (setq ow1 (dfun-info-wrapper1 dfun-info)) + (unless (or (eq ow0 wrappers) (eq ow1 wrappers)) + (if (eql nindex oindex) + (one-index nindex) + (n-n)))) + (one-index + (setq oindex (dfun-info-index dfun-info)) + (setq cache (dfun-info-cache dfun-info)) + (if (eql nindex oindex) + (do-fill #'(lambda (ncache) + (one-index nindex ncache))) + (n-n))) + (n-n + (setq cache (dfun-info-cache dfun-info)) + (if (consp nindex) + (caching) + (do-fill #'n-n)))))))))) + +(defun checking-miss (generic-function args dfun-info) + (let ((oemf (dfun-info-function dfun-info)) + (cache (dfun-info-cache dfun-info))) + (dfun-miss (generic-function args wrappers invalidp nemf) + (cond (invalidp) + ((eq oemf nemf) + (let ((ncache (fill-cache cache wrappers nil))) + (unless (eq ncache cache) + (dfun-update generic-function #'make-checking-dfun + nemf ncache)))) + (t + (dfun-update generic-function #'make-caching-dfun)))))) + +(defun caching-miss (generic-function args dfun-info) + (let ((ocache (dfun-info-cache dfun-info))) + (dfun-miss (generic-function args wrappers invalidp emf nil nil t) + (cond (invalidp) + (t + (let ((ncache (fill-cache ocache wrappers emf))) + (unless (eq ncache ocache) + (dfun-update generic-function + #'make-caching-dfun ncache)))))))) + +(defun constant-value-miss (generic-function args dfun-info) + (let ((ocache (dfun-info-cache dfun-info))) + (dfun-miss (generic-function args wrappers invalidp emf nil nil t) + (cond (invalidp) + (t + (let* ((function (typecase emf + (fast-method-call (fast-method-call-function emf)) + (method-call (method-call-function emf)))) + (value (method-function-get function :constant-value)) + (ncache (fill-cache ocache wrappers value))) + (unless (eq ncache ocache) + (dfun-update generic-function + #'make-constant-value-dfun ncache)))))))) + +;;; Given a generic function and a set of arguments to that generic function, +;;; returns a mess of values. +;;; +;;; The compiled effective method function for this set of +;;; arguments. +;;; +;;; Sorted list of applicable methods. +;;; +;;; Is a single wrapper if the generic function has only +;;; one key, that is arg-info-nkeys of the arg-info is 1. +;;; Otherwise a list of the wrappers of the specialized +;;; arguments to the generic function. +;;; +;;; Note that all these wrappers are valid. This function +;;; does invalid wrapper traps when it finds an invalid +;;; wrapper and then returns the new, valid wrapper. +;;; +;;; True if any of the specialized arguments had an invalid +;;; wrapper, false otherwise. +;;; +;;; READER or WRITER when the only method that would be run +;;; is a standard reader or writer method. To be specific, +;;; the value is READER when the method combination is eq to +;;; *standard-method-combination*; there are no applicable +;;; :before, :after or :around methods; and the most specific +;;; primary method is a standard reader method. +;;; +;;; If is READER or WRITER, and the slot accessed is +;;; an :instance slot, this is the index number of that slot +;;; in the object argument. +;;; +(defun cache-miss-values (gf args state) + (if (null (if (early-gf-p gf) + (early-gf-methods gf) + (generic-function-methods gf))) + (apply #'no-applicable-method gf args) + (multiple-value-bind (nreq applyp metatypes nkeys arg-info) + (get-generic-function-info gf) + (declare (ignore nreq applyp nkeys)) + (with-dfun-wrappers (args metatypes) + (dfun-wrappers invalid-wrapper-p wrappers classes types) + (error "The function ~S requires at least ~D arguments" + gf (length metatypes)) + (multiple-value-bind (emf methods accessor-type index) + (cache-miss-values-internal gf arg-info wrappers classes types state) + (values emf methods + dfun-wrappers + invalid-wrapper-p + accessor-type index)))))) + +(defun cache-miss-values-internal (gf arg-info wrappers classes types state) + (let* ((for-accessor-p (eq state 'accessor)) + (for-cache-p (or (eq state 'caching) (eq state 'accessor))) + (cam-std-p (or (null arg-info) + (gf-info-c-a-m-emf-std-p arg-info)))) + (multiple-value-bind (methods all-applicable-and-sorted-p) + (if cam-std-p + (compute-applicable-methods-using-types gf types) + (compute-applicable-methods-using-classes gf classes)) + (let ((emf (if (or cam-std-p all-applicable-and-sorted-p) + (function-funcall (get-secondary-dispatch-function1 + gf methods types nil (and for-cache-p wrappers) + all-applicable-and-sorted-p) + nil (and for-cache-p wrappers)) + (default-secondary-dispatch-function gf)))) + (multiple-value-bind (index accessor-type) + (and for-accessor-p all-applicable-and-sorted-p methods + (accessor-values gf arg-info classes methods)) + (values (if (integerp index) index emf) + methods accessor-type index)))))) + +(defun accessor-values (gf arg-info classes methods) + (declare (ignore gf)) + (let* ((accessor-type (gf-info-simple-accessor-type arg-info)) + (accessor-class (case accessor-type + (reader (car classes)) + (writer (cadr classes)) + (boundp (car classes))))) + (accessor-values-internal accessor-type accessor-class methods))) + +(defun accessor-values1 (gf accessor-type accessor-class) + (let* ((type `(class-eq ,accessor-class)) + (types (if (eq accessor-type 'writer) `(t ,type) `(,type))) + (methods (compute-applicable-methods-using-types gf types))) + (accessor-values-internal accessor-type accessor-class methods))) + +(defun accessor-values-internal (accessor-type accessor-class methods) + (dolist (meth methods) + (when (if (consp meth) + (early-method-qualifiers meth) + (method-qualifiers meth)) + (return-from accessor-values-internal (values nil nil)))) + (let* ((meth (car methods)) + (early-p (not (eq *boot-state* 'complete))) + (slot-name (when accessor-class + (if (consp meth) + (and (early-method-standard-accessor-p meth) + (early-method-standard-accessor-slot-name meth)) + (and (member *the-class-standard-object* + (if early-p + (early-class-precedence-list accessor-class) + (class-precedence-list accessor-class))) + (if early-p + (not (eq *the-class-standard-method* + (early-method-class meth))) + (standard-accessor-method-p meth)) + (if early-p + (early-accessor-method-slot-name meth) + (accessor-method-slot-name meth)))))) + (slotd (and accessor-class + (if early-p + (dolist (slot (early-class-slotds accessor-class) nil) + (when (eql slot-name (early-slot-definition-name slot)) + (return slot))) + (find-slot-definition accessor-class slot-name))))) + (when (and slotd + (or early-p + (slot-accessor-std-p slotd accessor-type))) + (values (if early-p + (early-slot-definition-location slotd) + (slot-definition-location slotd)) + accessor-type)))) + +(defun make-accessor-table (gf type &optional table) + (unless table (setq table (make-hash-table :test 'eq))) + (let ((methods (if (early-gf-p gf) + (early-gf-methods gf) + (generic-function-methods gf))) + (all-index nil) + (no-class-slots-p t) + (early-p (not (eq *boot-state* 'complete))) + first second (size 0)) + (declare (fixnum size)) + ;; class -> {(specl slotd)} + (dolist (method methods) + (let* ((specializers (if (consp method) + (early-method-specializers method t) + (method-specializers method))) + (specl (if (eq type 'reader) + (car specializers) + (cadr specializers))) + (specl-cpl (if early-p + (early-class-precedence-list specl) + (and (class-finalized-p specl) + (class-precedence-list specl)))) + (so-p (member *the-class-standard-object* specl-cpl)) + (slot-name (if (consp method) + (and (early-method-standard-accessor-p method) + (early-method-standard-accessor-slot-name method)) + (accessor-method-slot-name method)))) + (when (or (null specl-cpl) + (member *the-class-structure-object* specl-cpl)) + (return-from make-accessor-table nil)) + (maphash #'(lambda (class slotd) + (let ((cpl (if early-p + (early-class-precedence-list class) + (class-precedence-list class)))) + (when (memq specl cpl) + (unless (and (or so-p + (member *the-class-standard-object* cpl)) + (or early-p + (slot-accessor-std-p slotd type))) + (return-from make-accessor-table nil)) + (push (cons specl slotd) (gethash class table))))) + (gethash slot-name *name->class->slotd-table*)))) + (maphash #'(lambda (class specl+slotd-list) + (dolist (sclass (if early-p + (early-class-precedence-list class) + (class-precedence-list class)) + (error "This can't happen")) + (let ((a (assq sclass specl+slotd-list))) + (when a + (let* ((slotd (cdr a)) + (index (if early-p + (early-slot-definition-location slotd) + (slot-definition-location slotd)))) + (unless index (return-from make-accessor-table nil)) + (setf (gethash class table) index) + (when (consp index) (setq no-class-slots-p nil)) + (setq all-index (if (or (null all-index) + (eql all-index index)) + index t)) + (incf size) + (cond ((= size 1) (setq first class)) + ((= size 2) (setq second class))) + (return nil)))))) + table) + (values table all-index first second size no-class-slots-p))) + +(defun compute-applicable-methods-using-types (generic-function types) + (let ((definite-p t) (possibly-applicable-methods nil)) + (dolist (method (if (early-gf-p generic-function) + (early-gf-methods generic-function) + (generic-function-methods generic-function))) + (let ((specls (if (consp method) + (early-method-specializers method t) + (method-specializers method))) + (types types) + (possibly-applicable-p t) (applicable-p t)) + (dolist (specl specls) + (multiple-value-bind (specl-applicable-p specl-possibly-applicable-p) + (specializer-applicable-using-type-p specl (pop types)) + (unless specl-applicable-p + (setq applicable-p nil)) + (unless specl-possibly-applicable-p + (setq possibly-applicable-p nil) + (return nil)))) + (when possibly-applicable-p + (unless applicable-p (setq definite-p nil)) + (push method possibly-applicable-methods)))) + (let ((precedence (arg-info-precedence (if (early-gf-p generic-function) + (early-gf-arg-info generic-function) + (gf-arg-info generic-function))))) + (values (sort-applicable-methods precedence + (nreverse possibly-applicable-methods) + types) + definite-p)))) + +(defun sort-applicable-methods (precedence methods types) + (sort-methods methods + precedence + #'(lambda (class1 class2 index) + (let* ((class (type-class (nth index types))) + (cpl (if (eq *boot-state* 'complete) + (class-precedence-list class) + (early-class-precedence-list class)))) + (if (memq class2 (memq class1 cpl)) + class1 class2))))) + +(defun sort-methods (methods precedence compare-classes-function) + (declare (type function compare-classes-function)) + (flet ((sorter (method1 method2) + (dolist (index precedence) + (let* ((specl1 (nth index (if (listp method1) + (early-method-specializers method1 t) + (method-specializers method1)))) + (specl2 (nth index (if (listp method2) + (early-method-specializers method2 t) + (method-specializers method2)))) + (order (order-specializers + specl1 specl2 index compare-classes-function))) + (when order + (return-from sorter (eq order specl1))))))) + (stable-sort methods #'sorter))) + +(defun order-specializers (specl1 specl2 index compare-classes-function) + (declare (type function compare-classes-function)) + (let ((type1 (if (eq *boot-state* 'complete) + (specializer-type specl1) + (bootstrap-get-slot 'specializer specl1 'type))) + (type2 (if (eq *boot-state* 'complete) + (specializer-type specl2) + (bootstrap-get-slot 'specializer specl2 'type)))) + (cond ((eq specl1 specl2) + nil) + ((atom type1) + specl2) + ((atom type2) + specl1) + (t + (case (car type1) + (class (case (car type2) + (class (funcall compare-classes-function specl1 specl2 index)) + (t specl2))) + (prototype (case (car type2) + (class (funcall compare-classes-function specl1 specl2 index)) + (t specl2))) + (class-eq (case (car type2) + (eql specl2) + (class-eq nil) + (class type1))) + (eql (case (car type2) + (eql nil) + (t specl1)))))))) + +(defun map-all-orders (methods precedence function) + (declare (type function function)) + (let ((choices nil)) + (flet ((compare-classes-function (class1 class2 index) + (declare (ignore index)) + (let ((choice nil)) + (dolist (c choices nil) + (when (or (and (eq (first c) class1) + (eq (second c) class2)) + (and (eq (first c) class2) + (eq (second c) class1))) + (return (setq choice c)))) + (unless choice + (setq choice + (if (class-might-precede-p class1 class2) + (if (class-might-precede-p class2 class1) + (list class1 class2 nil t) + (list class1 class2 t)) + (if (class-might-precede-p class2 class1) + (list class2 class1 t) + (let ((name1 (class-name class1)) + (name2 (class-name class2))) + (if (and name1 name2 (symbolp name1) (symbolp name2) + (string< (symbol-name name1) + (symbol-name name2))) + (list class1 class2 t) + (list class2 class1 t)))))) + (push choice choices)) + (car choice)))) + (loop (funcall function + (sort-methods methods precedence #'compare-classes-function)) + (unless (dolist (c choices nil) + (unless (third c) + (rotatef (car c) (cadr c)) + (return (setf (third c) t)))) + (return nil)))))) + +(defvar *in-precompute-effective-methods-p* nil) + +;used only in map-all-orders +(defun class-might-precede-p (class1 class2) + (if (not *in-precompute-effective-methods-p*) + (not (member class1 (cdr (class-precedence-list class2)))) + (class-can-precede-p class1 class2))) + +(defun compute-precedence (lambda-list nreq argument-precedence-order) + (if (null argument-precedence-order) + (let ((list nil))(dotimes (i nreq list) (push (- (1- nreq) i) list))) + (mapcar #'(lambda (x) (position x lambda-list)) argument-precedence-order))) + +(defun saut-and (specl type) + (let ((applicable nil) + (possibly-applicable t)) + (dolist (type (cdr type)) + (multiple-value-bind (appl poss-appl) + (specializer-applicable-using-type-p specl type) + (when appl (return (setq applicable t))) + (unless poss-appl (return (setq possibly-applicable nil))))) + (values applicable possibly-applicable))) + +(defun saut-not (specl type) + (let ((ntype (cadr type))) + (values nil + (case (car ntype) + (class (saut-not-class specl ntype)) + (class-eq (saut-not-class-eq specl ntype)) + (prototype (saut-not-prototype specl ntype)) + (eql (saut-not-eql specl ntype)) + (t (error "~s cannot handle the second argument ~s" + 'specializer-applicable-using-type-p type)))))) + +(defun saut-not-class (specl ntype) + (let* ((class (type-class specl)) + (cpl (class-precedence-list class))) + (not (memq (cadr ntype) cpl)))) + +(defun saut-not-prototype (specl ntype) + (let* ((class (case (car specl) + (eql (class-of (cadr specl))) + (class-eq (cadr specl)) + (prototype (cadr specl)) + (class (cadr specl)))) + (cpl (class-precedence-list class))) + (not (memq (cadr ntype) cpl)))) + +(defun saut-not-class-eq (specl ntype) + (let ((class (case (car specl) + (eql (class-of (cadr specl))) + (class-eq (cadr specl))))) + (not (eq class (cadr ntype))))) + +(defun saut-not-eql (specl ntype) + (case (car specl) + (eql (not (eql (cadr specl) (cadr ntype)))) + (t t))) + +(defun class-applicable-using-class-p (specl type) + (let ((pred (memq specl (if (eq *boot-state* 'complete) + (class-precedence-list type) + (early-class-precedence-list type))))) + (values pred + (or pred + (if (not *in-precompute-effective-methods-p*) + ;; classes might get common subclass + (superclasses-compatible-p specl type) + ;; worry only about existing classes + (classes-have-common-subclass-p specl type)))))) + +(defun classes-have-common-subclass-p (class1 class2) + (or (eq class1 class2) + (let ((class1-subs (class-direct-subclasses class1))) + (or (memq class2 class1-subs) + (dolist (class1-sub class1-subs nil) + (when (classes-have-common-subclass-p class1-sub class2) + (return t))))))) + +(defun saut-class (specl type) + (case (car specl) + (class (class-applicable-using-class-p (cadr specl) (cadr type))) + (t (values nil (let ((class (type-class specl))) + (memq (cadr type) + (class-precedence-list class))))))) + +(defun saut-class-eq (specl type) + (if (eq (car specl) 'eql) + (values nil (eq (class-of (cadr specl)) (cadr type))) + (let ((pred (case (car specl) + (class-eq + (eq (cadr specl) (cadr type))) + (class + (or (eq (cadr specl) (cadr type)) + (memq (cadr specl) + (if (eq *boot-state* 'complete) + (class-precedence-list (cadr type)) + (early-class-precedence-list (cadr type))))))))) + (values pred pred)))) + +(defun saut-prototype (specl type) + (declare (ignore specl type)) + (values nil nil)) ; fix this someday + +(defun saut-eql (specl type) + (let ((pred (case (car specl) + (eql (eql (cadr specl) (cadr type))) + (class-eq (eq (cadr specl) (class-of (cadr type)))) + (class (memq (cadr specl) + (let ((class (class-of (cadr type)))) + (if (eq *boot-state* 'complete) + (class-precedence-list class) + (early-class-precedence-list class)))))))) + (values pred pred))) + +(defun specializer-applicable-using-type-p (specl type) + (setq specl (type-from-specializer specl)) + (when (eq specl 't) + (return-from specializer-applicable-using-type-p (values t t))) + ;; This is used by c-a-m-u-t and generate-discrimination-net-internal, + ;; and has only what they need. + (if (or (atom type) (eq (car type) 't)) + (values nil t) + (case (car type) + (and (saut-and specl type)) + (not (saut-not specl type)) + (class (saut-class specl type)) + (prototype (saut-prototype specl type)) + (class-eq (saut-class-eq specl type)) + (eql (saut-eql specl type)) + (t (error "~s cannot handle the second argument ~s" + 'specializer-applicable-using-type-p type))))) + +(defun map-all-classes (function &optional (root 't)) + (declare (type function function)) + (let ((braid-p (or (eq *boot-state* 'braid) + (eq *boot-state* 'complete)))) + (labels ((do-class (class) + (mapc #'do-class + (if braid-p + (class-direct-subclasses class) + (early-class-direct-subclasses class))) + (funcall function class))) + (do-class (if (symbolp root) + (find-class root) + root))))) + +;;; +;;; NOTE: We are assuming a restriction on user code that the method +;;; combination must not change once it is connected to the +;;; generic function. +;;; +;;; This has to be legal, because otherwise any kind of method +;;; lookup caching couldn't work. See this by saying that this +;;; cache, is just a backing cache for the fast cache. If that +;;; cache is legal, this one must be too. +;;; +;;; Don't clear this table! +(defvar *effective-method-table* (make-hash-table :test 'eq)) + +(defun get-secondary-dispatch-function (gf methods types &optional + method-alist wrappers) + (function-funcall (get-secondary-dispatch-function1 + gf methods types + (not (null method-alist)) + (not (null wrappers)) + (not (methods-contain-eql-specializer-p methods))) + method-alist wrappers)) + +(defun get-secondary-dispatch-function1 (gf methods types method-alist-p wrappers-p + &optional all-applicable-p + (all-sorted-p t) function-p) + (if (null methods) + (if function-p + #'(lambda (method-alist wrappers) + (declare (ignore method-alist wrappers)) + (fin-lambda-fn (&rest args) + (apply #'no-applicable-method gf args))) + #'(lambda (method-alist wrappers) + (declare (ignore method-alist wrappers)) + #'(lambda (&rest args) + (apply #'no-applicable-method gf args)))) + (let* ((key (car methods)) + (ht-value (or (gethash key *effective-method-table*) + (setf (gethash key *effective-method-table*) + (cons nil nil))))) + (if (and (null (cdr methods)) all-applicable-p ; the most common case + (null method-alist-p) wrappers-p (not function-p)) + (or (car ht-value) + (setf (car ht-value) + (get-secondary-dispatch-function2 + gf methods types method-alist-p wrappers-p + all-applicable-p all-sorted-p function-p))) + (let ((akey (list methods + (if all-applicable-p 'all-applicable types) + method-alist-p wrappers-p function-p))) + (or (cdr (assoc akey (cdr ht-value) :test #'equal)) + (let ((value (get-secondary-dispatch-function2 + gf methods types method-alist-p wrappers-p + all-applicable-p all-sorted-p function-p))) + (push (cons akey value) (cdr ht-value)) + value))))))) + +(defun get-secondary-dispatch-function2 (gf methods types method-alist-p wrappers-p + all-applicable-p all-sorted-p function-p) + (if (and all-applicable-p all-sorted-p (not function-p)) + (if (eq *boot-state* 'complete) + (let* ((combin (generic-function-method-combination gf)) + (effective (compute-effective-method gf combin methods))) + (make-effective-method-function1 gf effective method-alist-p wrappers-p)) + (let ((effective (standard-compute-effective-method gf nil methods))) + (make-effective-method-function1 gf effective method-alist-p wrappers-p))) + (let ((net (generate-discrimination-net + gf methods types all-sorted-p))) + (compute-secondary-dispatch-function1 gf net function-p)))) + +(defun get-effective-method-function (gf methods &optional method-alist wrappers) + (function-funcall (get-secondary-dispatch-function1 gf methods nil + (not (null method-alist)) + (not (null wrappers)) + t) + method-alist wrappers)) + +(defun get-effective-method-function1 (gf methods &optional (sorted-p t)) + (get-secondary-dispatch-function1 gf methods nil nil nil t sorted-p)) + +(defun methods-contain-eql-specializer-p (methods) + (and (eq *boot-state* 'complete) + (dolist (method methods nil) + (when (dolist (spec (method-specializers method) nil) + (when (eql-specializer-p spec) (return t))) + (return t))))) + +(defun update-dfun (generic-function &optional dfun cache info) + (let* ((early-p (early-gf-p generic-function)) + (gf-name (if early-p + (early-gf-name generic-function) + (generic-function-name generic-function))) + (ocache (gf-dfun-cache generic-function))) + (set-dfun generic-function dfun cache info) + (let* ((dfun (if early-p + (or dfun (make-initial-dfun generic-function)) + (compute-discriminating-function generic-function))) + (info (gf-dfun-info generic-function))) + (unless (eq 'default-method-only (type-of info)) + (setq dfun (doctor-dfun-for-the-debugger + generic-function + #+cmu dfun #-cmu (set-function-name dfun gf-name)))) + (set-funcallable-instance-function generic-function dfun) + #+cmu (set-function-name generic-function gf-name) + (when (and ocache (not (eq ocache cache))) (free-cache ocache)) + dfun))) + + +(defvar dfun-count nil) +(defvar dfun-list nil) +(defvar *minimum-cache-size-to-list*) + +(defun list-dfun (gf) + (let* ((sym (type-of (gf-dfun-info gf))) + (a (assq sym dfun-list))) + (unless a + (push (setq a (list sym)) dfun-list)) + (push (generic-function-name gf) (cdr a)))) + +(defun list-all-dfuns () + (setq dfun-list nil) + (map-all-generic-functions #'list-dfun) + dfun-list) + +(defun list-large-cache (gf) + (let* ((sym (type-of (gf-dfun-info gf))) + (cache (gf-dfun-cache gf))) + (when cache + (let ((size (cache-size cache))) + (when (>= size *minimum-cache-size-to-list*) + (let ((a (assoc size dfun-list))) + (unless a + (push (setq a (list size)) dfun-list)) + (push (let ((name (generic-function-name gf))) + (if (eq sym 'caching) name (list name sym))) + (cdr a)))))))) + +(defun list-large-caches (&optional (*minimum-cache-size-to-list* 130)) + (setq dfun-list nil) + (map-all-generic-functions #'list-large-cache) + (setq dfun-list (sort dfun-list #'< :key #'car)) + (mapc #'print dfun-list) + (values)) + + +(defun count-dfun (gf) + (let* ((sym (type-of (gf-dfun-info gf))) + (cache (gf-dfun-cache gf)) + (a (assq sym dfun-count))) + (unless a + (push (setq a (list sym 0 nil)) dfun-count)) + (incf (cadr a)) + (when cache + (let* ((size (cache-size cache)) + (b (assoc size (third a)))) + (unless b + (push (setq b (cons size 0)) (third a))) + (incf (cdr b)))))) + +(defun count-all-dfuns () + (setq dfun-count (mapcar #'(lambda (type) (list type 0 nil)) + '(ONE-CLASS TWO-CLASS DEFAULT-METHOD-ONLY + ONE-INDEX N-N CHECKING CACHING + DISPATCH))) + (map-all-generic-functions #'count-dfun) + (mapc #'(lambda (type+count+sizes) + (setf (third type+count+sizes) + (sort (third type+count+sizes) #'< :key #'car))) + dfun-count) + (mapc #'(lambda (type+count+sizes) + (format t "~&There are ~4d dfuns of type ~s" + (cadr type+count+sizes) (car type+count+sizes)) + (format t "~% ~S~%" (caddr type+count+sizes))) + dfun-count) + (values)) + +(defun gfs-of-type (type) + (unless (consp type) (setq type (list type))) + (let ((gf-list nil)) + (map-all-generic-functions #'(lambda (gf) + (when (memq (type-of (gf-dfun-info gf)) type) + (push gf gf-list)))) + gf-list)) diff --git a/pcl/gcl_pcl_dlisp.lisp b/pcl/gcl_pcl_dlisp.lisp new file mode 100644 index 0000000..4d92600 --- /dev/null +++ b/pcl/gcl_pcl_dlisp.lisp @@ -0,0 +1,425 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +;;; This file is (almost) functionally equivalent to dlap.lisp, +;;; but easier to read. + +;;; Might generate faster code, too, depending on the compiler and +;;; whether an implementation-specific lap assembler was used. + +(defun emit-one-class-reader (class-slot-p) + (emit-reader/writer :reader 1 class-slot-p)) + +(defun emit-one-class-writer (class-slot-p) + (emit-reader/writer :writer 1 class-slot-p)) + +(defun emit-two-class-reader (class-slot-p) + (emit-reader/writer :reader 2 class-slot-p)) + +(defun emit-two-class-writer (class-slot-p) + (emit-reader/writer :writer 2 class-slot-p)) + +;;; -------------------------------- + +(defun emit-one-index-readers (class-slot-p) + (emit-one-or-n-index-reader/writer :reader nil class-slot-p)) + +(defun emit-one-index-writers (class-slot-p) + (emit-one-or-n-index-reader/writer :writer nil class-slot-p)) + +(defun emit-n-n-readers () + (emit-one-or-n-index-reader/writer :reader t nil)) + +(defun emit-n-n-writers () + (emit-one-or-n-index-reader/writer :writer t nil)) + +;;; -------------------------------- + +(defun emit-checking (metatypes applyp) + (emit-checking-or-caching nil nil metatypes applyp)) + +(defun emit-caching (metatypes applyp) + (emit-checking-or-caching t nil metatypes applyp)) + +(defun emit-in-checking-cache-p (metatypes) + (emit-checking-or-caching nil t metatypes nil)) + +(defun emit-constant-value (metatypes) + (emit-checking-or-caching t t metatypes nil)) + +;;; -------------------------------- + +(defvar *precompiling-lap* nil) +(defvar *emit-function-p* t) + +(defun emit-default-only (metatypes applyp) + (when (and (null *precompiling-lap*) *emit-function-p*) + (return-from emit-default-only + (emit-default-only-function metatypes applyp))) + (let* ((dlap-lambda-list (make-dlap-lambda-list metatypes applyp)) + (args (remove '&rest dlap-lambda-list)) + (restl (when applyp '(.lap-rest-arg.)))) + (generating-lisp '(emf) + dlap-lambda-list + `(invoke-effective-method-function emf ,applyp ,@args ,@restl)))) + +(defmacro emit-default-only-macro (metatypes applyp) + (let ((*emit-function-p* nil) + (*precompiling-lap* t)) + (values + (emit-default-only metatypes applyp)))) + +;;; -------------------------------- + +(defun generating-lisp (closure-variables args form) + (let* ((rest (memq '&rest args)) + (ldiff (and rest (ldiff args rest))) + (args (if rest (append ldiff '(&rest .lap-rest-arg.)) args)) + (lambda `(lambda ,closure-variables + ,@(when (member 'miss-fn closure-variables) + `((declare (type function miss-fn)))) + (fin-lambda-fn ,args + #+copy-&rest-arg + ,@(when rest + `((setq .lap-rest-arg. (copy-list .lap-rest-arg.)))) + (let () + (declare #.*optimize-speed*) + ,form))))) + (values (if *precompiling-lap* + `#',lambda + (compile-lambda lambda)) + nil))) + +;;; cmu17 note: since std-instance-p is weakened, that branch may run +;;; on non-pcl instances (structures). The result will be the +;;; non-wrapper layout for the structure, which will cause a miss. The "slots" +;;; will be whatever the first slot is, but will be ignored. Similarly, +;;; fsc-instance-p returns true on funcallable structures as well as PCL fins. +;;; +(defun emit-reader/writer (reader/writer 1-or-2-class class-slot-p) + (when (and (null *precompiling-lap*) *emit-function-p*) + (return-from emit-reader/writer + (emit-reader/writer-function reader/writer 1-or-2-class class-slot-p))) + (let ((instance nil) + (arglist ()) + (closure-variables ()) + (field (first-wrapper-cache-number-index)) + (readp (eq reader/writer :reader)) + (read-form (emit-slot-read-form class-slot-p 'index 'slots))) + ;;we need some field to do the fast obsolete check + (ecase reader/writer + (:reader (setq instance (dfun-arg-symbol 0) + arglist (list instance))) + (:writer (setq instance (dfun-arg-symbol 1) + arglist (list (dfun-arg-symbol 0) instance)))) + (ecase 1-or-2-class + (1 (setq closure-variables '(wrapper-0 index miss-fn))) + (2 (setq closure-variables '(wrapper-0 wrapper-1 index miss-fn)))) + (generating-lisp closure-variables + arglist + `(let* (,@(unless class-slot-p `((slots nil))) + (wrapper (cond ((std-instance-p ,instance) + ,@(unless class-slot-p + `((setq slots (std-instance-slots ,instance)))) + (std-instance-wrapper ,instance)) + ((fsc-instance-p ,instance) + ,@(unless class-slot-p + `((setq slots (fsc-instance-slots ,instance)))) + (fsc-instance-wrapper ,instance)))) + ,@(when readp '(value))) + (if (or (null wrapper) + (zerop (wrapper-cache-number-vector-ref wrapper ,field)) + (not (or (eq wrapper wrapper-0) + ,@(when (eql 2 1-or-2-class) + `((eq wrapper wrapper-1))))) + ,@(when readp `((eq *slot-unbound* (setq value ,read-form))))) + (funcall miss-fn ,@arglist) + ,(if readp + 'value + `(setf ,read-form ,(car arglist)))))))) + +(defun emit-slot-read-form (class-slot-p index slots) + (if class-slot-p + `(cdr ,index) + `(%instance-ref ,slots ,index))) + +(defun emit-boundp-check (value-form miss-fn arglist) + `(let ((value ,value-form)) + (if (eq value *slot-unbound*) + (funcall ,miss-fn ,@arglist) + value))) + +(defun emit-slot-access (reader/writer class-slot-p slots index miss-fn arglist) + (let ((read-form (emit-slot-read-form class-slot-p index slots))) + (ecase reader/writer + (:reader (emit-boundp-check read-form miss-fn arglist)) + (:writer `(setf ,read-form ,(car arglist)))))) + +(defmacro emit-reader/writer-macro (reader/writer 1-or-2-class class-slot-p) + (let ((*emit-function-p* nil) + (*precompiling-lap* t)) + (values + (emit-reader/writer reader/writer 1-or-2-class class-slot-p)))) + +(defun emit-one-or-n-index-reader/writer (reader/writer cached-index-p class-slot-p) + (when (and (null *precompiling-lap*) *emit-function-p*) + (return-from emit-one-or-n-index-reader/writer + (emit-one-or-n-index-reader/writer-function + reader/writer cached-index-p class-slot-p))) + (multiple-value-bind (arglist metatypes) + (ecase reader/writer + (:reader (values (list (dfun-arg-symbol 0)) + '(standard-instance))) + (:writer (values (list (dfun-arg-symbol 0) (dfun-arg-symbol 1)) + '(t standard-instance)))) + (generating-lisp `(cache ,@(unless cached-index-p '(index)) miss-fn) + arglist + `(let (,@(unless class-slot-p '(slots)) + ,@(when cached-index-p '(index))) + ,(emit-dlap arglist metatypes + (emit-slot-access reader/writer class-slot-p + 'slots 'index 'miss-fn arglist) + `(funcall miss-fn ,@arglist) + (when cached-index-p 'index) + (unless class-slot-p '(slots))))))) + +(defmacro emit-one-or-n-index-reader/writer-macro + (reader/writer cached-index-p class-slot-p) + (let ((*emit-function-p* nil) + (*precompiling-lap* t)) + (values + (emit-one-or-n-index-reader/writer reader/writer cached-index-p class-slot-p)))) + +(defun emit-miss (miss-fn args &optional applyp) + (let ((restl (when applyp '(.lap-rest-arg.)))) + (if restl + `(apply ,miss-fn ,@args ,@restl) + `(funcall ,miss-fn ,@args ,@restl)))) + +(defun emit-checking-or-caching (cached-emf-p return-value-p metatypes applyp) + (when (and (null *precompiling-lap*) *emit-function-p*) + (return-from emit-checking-or-caching + (emit-checking-or-caching-function + cached-emf-p return-value-p metatypes applyp))) + (let* ((dlap-lambda-list (make-dlap-lambda-list metatypes applyp)) + (args (remove '&rest dlap-lambda-list)) + (restl (when applyp '(.lap-rest-arg.)))) + (generating-lisp `(cache ,@(unless cached-emf-p '(emf)) miss-fn) + dlap-lambda-list + `(let (,@(when cached-emf-p '(emf))) + ,(emit-dlap args + metatypes + (if return-value-p + (if cached-emf-p 'emf t) + `(invoke-effective-method-function emf ,applyp + ,@args ,@restl)) + (emit-miss 'miss-fn args applyp) + (when cached-emf-p 'emf)))))) + +(defmacro emit-checking-or-caching-macro (cached-emf-p return-value-p metatypes applyp) + (let ((*emit-function-p* nil) + (*precompiling-lap* t)) + (values + (emit-checking-or-caching cached-emf-p return-value-p metatypes applyp)))) + +(defun emit-dlap (args metatypes hit miss value-reg &optional slot-regs) + (let* ((index -1) + (wrapper-bindings (mapcan #'(lambda (arg mt) + (unless (eq mt 't) + (incf index) + `((,(intern (format nil "WRAPPER-~D" index) + *the-pcl-package*) + ,(emit-fetch-wrapper mt arg 'miss + (pop slot-regs)))))) + args metatypes)) + (wrappers (mapcar #'car wrapper-bindings))) + (declare (fixnum index)) + (unless wrappers (error "Every metatype is T.")) + `(block dfun + (tagbody + (let ((field (cache-field cache)) + (cache-vector (cache-vector cache)) + (mask (cache-mask cache)) + (size (cache-size cache)) + (overflow (cache-overflow cache)) + ,@wrapper-bindings) + (declare (fixnum size field mask)) + ,(cond ((cdr wrappers) + (emit-greater-than-1-dlap wrappers 'miss value-reg)) + (value-reg + (emit-1-t-dlap (car wrappers) 'miss value-reg)) + (t + (emit-1-nil-dlap (car wrappers) 'miss))) + (return-from dfun ,hit)) + miss + (return-from dfun ,miss))))) + +(defun emit-1-nil-dlap (wrapper miss-label) + `(let* ((primary ,(emit-1-wrapper-compute-primary-cache-location wrapper miss-label)) + (location primary)) + (declare (fixnum primary location)) + (block search + (loop (when (eq ,wrapper (cache-vector-ref cache-vector location)) + (return-from search nil)) + (setq location (the fixnum (+ location 1))) + (when (= location size) + (setq location 0)) + (when (= location primary) + (dolist (entry overflow) + (when (eq (car entry) ,wrapper) + (return-from search nil))) + (go ,miss-label)))))) + +(defmacro get-cache-vector-lock-count (cache-vector) + `(let ((lock-count (cache-vector-lock-count ,cache-vector))) + (unless (typep lock-count 'fixnum) + (error "my cache got freed somehow")) + (the fixnum lock-count))) + +(defun emit-1-t-dlap (wrapper miss-label value) + `(let ((primary ,(emit-1-wrapper-compute-primary-cache-location wrapper miss-label)) + (initial-lock-count (get-cache-vector-lock-count cache-vector))) + (declare (fixnum primary initial-lock-count)) + (let ((location primary)) + (declare (fixnum location)) + (block search + (loop (when (eq ,wrapper (cache-vector-ref cache-vector location)) + (setq ,value (cache-vector-ref cache-vector (1+ location))) + (return-from search nil)) + (setq location (the fixnum (+ location 2))) + (when (= location size) + (setq location 0)) + (when (= location primary) + (dolist (entry overflow) + (when (eq (car entry) ,wrapper) + (setq ,value (cdr entry)) + (return-from search nil))) + (go ,miss-label)))) + (unless (= initial-lock-count + (get-cache-vector-lock-count cache-vector)) + (go ,miss-label))))) + +(defun emit-greater-than-1-dlap (wrappers miss-label value) + (declare (type list wrappers)) + (let ((cache-line-size (compute-line-size (+ (length wrappers) (if value 1 0))))) + `(let ((primary 0) (size-1 (the fixnum (- size 1)))) + (declare (fixnum primary size-1)) + ,(emit-n-wrapper-compute-primary-cache-location wrappers miss-label) + (let ((initial-lock-count (get-cache-vector-lock-count cache-vector))) + (declare (fixnum initial-lock-count)) + (let ((location primary) (next-location 0)) + (declare (fixnum location next-location)) + (block search + (loop (setq next-location (the fixnum (+ location ,cache-line-size))) + (when (and ,@(mapcar + #'(lambda (wrapper) + `(eq ,wrapper + (cache-vector-ref cache-vector + (setq location + (the fixnum (+ location 1)))))) + wrappers)) + ,@(when value + `((setq location (the fixnum (+ location 1))) + (setq ,value (cache-vector-ref cache-vector location)))) + (return-from search nil)) + (setq location next-location) + (when (= location size-1) + (setq location 0)) + (when (= location primary) + (dolist (entry overflow) + (let ((entry-wrappers (car entry))) + (when (and ,@(mapcar #'(lambda (wrapper) + `(eq ,wrapper (pop entry-wrappers))) + wrappers)) + ,@(when value + `((setq ,value (cdr entry)))) + (return-from search nil)))) + (go ,miss-label)))) + (unless (= initial-lock-count + (get-cache-vector-lock-count cache-vector)) + (go ,miss-label))))))) + +(defun emit-1-wrapper-compute-primary-cache-location (wrapper miss-label) + `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref ,wrapper field))) + (declare (fixnum wrapper-cache-no)) + (when (zerop wrapper-cache-no) (go ,miss-label)) + ,(let ((form `(#+lucid %logand #-lucid logand + mask wrapper-cache-no))) + #+lucid form + #-lucid `(the fixnum ,form)))) + +(defun emit-n-wrapper-compute-primary-cache-location (wrappers miss-label) + (declare (type list wrappers)) + ;; this returns 1 less that the actual location + `(progn + ,@(let ((adds 0) (len (length wrappers))) + (declare (fixnum adds len)) + (mapcar #'(lambda (wrapper) + `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref + ,wrapper field))) + (declare (fixnum wrapper-cache-no)) + (when (zerop wrapper-cache-no) (go ,miss-label)) + (setq primary (the fixnum (+ primary wrapper-cache-no))) + ,@(progn + (incf adds) + (when (or (zerop (mod adds wrapper-cache-number-adds-ok)) + (eql adds len)) + `((setq primary + ,(let ((form `(#+lucid %logand #-lucid logand + primary mask))) + #+lucid form + #-lucid `(the fixnum ,form)))))))) + wrappers)))) + +;;; cmu17 note: since std-instance-p is weakened, that branch may run +;;; on non-pcl instances (structures). The result will be the +;;; non-wrapper layout for the structure, which will cause a miss. The "slots" +;;; will be whatever the first slot is, but will be ignored. Similarly, +;;; fsc-instance-p returns true on funcallable structures as well as PCL fins. +;;; +(defun emit-fetch-wrapper (metatype argument miss-label &optional slot) + (ecase metatype + ((standard-instance #+new-kcl-wrapper structure-instance) + `(cond ((std-instance-p ,argument) + ,@(when slot `((setq ,slot (std-instance-slots ,argument)))) + (std-instance-wrapper ,argument)) + ((fsc-instance-p ,argument) + ,@(when slot `((setq ,slot (fsc-instance-slots ,argument)))) + (fsc-instance-wrapper ,argument)) + (t + (go ,miss-label)))) + (class + (when slot (error "Can't do a slot reg for this metatype.")) + `(wrapper-of-macro ,argument)) + ((built-in-instance #-new-kcl-wrapper structure-instance) + (when slot (error "Can't do a slot reg for this metatype.")) + `(#+new-kcl-wrapper built-in-wrapper-of + #-new-kcl-wrapper built-in-or-structure-wrapper + ,argument)))) + diff --git a/pcl/gcl_pcl_dlisp2.lisp b/pcl/gcl_pcl_dlisp2.lisp new file mode 100644 index 0000000..3b33a31 --- /dev/null +++ b/pcl/gcl_pcl_dlisp2.lisp @@ -0,0 +1,178 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(defun emit-reader/writer-function (reader/writer 1-or-2-class class-slot-p) + (values + (ecase reader/writer + (:reader (ecase 1-or-2-class + (1 (if class-slot-p + (emit-reader/writer-macro :reader 1 t) + (emit-reader/writer-macro :reader 1 nil))) + (2 (if class-slot-p + (emit-reader/writer-macro :reader 2 t) + (emit-reader/writer-macro :reader 2 nil))))) + (:writer (ecase 1-or-2-class + (1 (if class-slot-p + (emit-reader/writer-macro :writer 1 t) + (emit-reader/writer-macro :writer 1 nil))) + (2 (if class-slot-p + (emit-reader/writer-macro :writer 2 t) + (emit-reader/writer-macro :writer 2 nil)))))) + nil)) + +(defun emit-one-or-n-index-reader/writer-function + (reader/writer cached-index-p class-slot-p) + (values + (ecase reader/writer + (:reader (if cached-index-p + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :reader t t) + (emit-one-or-n-index-reader/writer-macro :reader t nil)) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :reader nil t) + (emit-one-or-n-index-reader/writer-macro :reader nil nil)))) + (:writer (if cached-index-p + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :writer t t) + (emit-one-or-n-index-reader/writer-macro :writer t nil)) + (if class-slot-p + (emit-one-or-n-index-reader/writer-macro :writer nil t) + (emit-one-or-n-index-reader/writer-macro :writer nil nil))))) + nil)) + +(eval-when (compile load eval) +(defparameter checking-or-caching-list + '() + #|| + '((T NIL (CLASS) NIL) + (T NIL (CLASS CLASS) NIL) + (T NIL (CLASS CLASS CLASS) NIL) + (T NIL (CLASS CLASS T) NIL) + (T NIL (CLASS CLASS T T) NIL) + (T NIL (CLASS CLASS T T T) NIL) + (T NIL (CLASS T) NIL) + (T NIL (CLASS T T) NIL) + (T NIL (CLASS T T T) NIL) + (T NIL (CLASS T T T T) NIL) + (T NIL (CLASS T T T T T) NIL) + (T NIL (CLASS T T T T T T) NIL) + (T NIL (T CLASS) NIL) + (T NIL (T CLASS T) NIL) + (T NIL (T T CLASS) NIL) + (T NIL (CLASS) T) + (T NIL (CLASS CLASS) T) + (T NIL (CLASS T) T) + (T NIL (CLASS T T) T) + (T NIL (CLASS T T T) T) + (T NIL (T CLASS) T) + (T T (CLASS) NIL) + (T T (CLASS CLASS) NIL) + (T T (CLASS CLASS CLASS) NIL) + (NIL NIL (CLASS) NIL) + (NIL NIL (CLASS CLASS) NIL) + (NIL NIL (CLASS CLASS T) NIL) + (NIL NIL (CLASS CLASS T T) NIL) + (NIL NIL (CLASS T) NIL) + (NIL NIL (T CLASS T) NIL) + (NIL NIL (CLASS) T) + (NIL NIL (CLASS CLASS) T)) ||# )) + +(defmacro make-checking-or-caching-function-list () + `(list ,@(mapcar #'(lambda (key) + `(cons ',key (emit-checking-or-caching-macro ,@key))) + checking-or-caching-list))) + +(defvar checking-or-caching-function-list) + +(defun initialize-checking-or-caching-function-list () + (setq checking-or-caching-function-list + (make-checking-or-caching-function-list))) + +(initialize-checking-or-caching-function-list) + +(defmacro emit-checking-or-caching-function-precompiled () + `(cdr (assoc (list cached-emf-p return-value-p metatypes applyp) + checking-or-caching-function-list + :test #'equal))) + +(defun emit-checking-or-caching-function (cached-emf-p return-value-p metatypes applyp) + (let ((fn (emit-checking-or-caching-function-precompiled))) + (if fn + (values fn nil) + (values (emit-checking-or-caching-function-preliminary + cached-emf-p return-value-p metatypes applyp) + t)))) + +(defvar not-in-cache (make-symbol "not in cache")) + +(defun emit-checking-or-caching-function-preliminary + (cached-emf-p return-value-p metatypes applyp) + (declare (ignore applyp)) + (if cached-emf-p + #'(lambda (cache miss-fn) + (declare (type function miss-fn)) + (fin-lambda-fn (&rest args) + (declare #.*optimize-speed*) + #+copy-&rest-arg (setq args (copy-list args)) + (with-dfun-wrappers (args metatypes) (dfun-wrappers invalid-wrapper-p) + (apply miss-fn args) + (if invalid-wrapper-p + (apply miss-fn args) + (let ((emf (probe-cache cache dfun-wrappers not-in-cache))) + (if (eq emf not-in-cache) + (apply miss-fn args) + (if return-value-p + emf + (invoke-emf emf args)))))))) + #'(lambda (cache emf miss-fn) + (declare (type function miss-fn)) + (fin-lambda-fn (&rest args) + (declare #.*optimize-speed*) + #+copy-&rest-arg (setq args (copy-list args)) + (with-dfun-wrappers (args metatypes) (dfun-wrappers invalid-wrapper-p) + (apply miss-fn args) + (if invalid-wrapper-p + (apply miss-fn args) + (let ((found-p (not (eq not-in-cache + (probe-cache cache dfun-wrappers + not-in-cache))))) + (if found-p + (invoke-emf emf args) + (if return-value-p + t + (apply miss-fn args)))))))))) + + +(defun emit-default-only-function (metatypes applyp) + (declare (ignore metatypes applyp)) + (values #'(lambda (emf) + #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) + (invoke-emf emf args))) + t)) diff --git a/pcl/gcl_pcl_env.lisp b/pcl/gcl_pcl_env.lisp new file mode 100644 index 0000000..7c286fa --- /dev/null +++ b/pcl/gcl_pcl_env.lisp @@ -0,0 +1,406 @@ +;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; Basic environmental stuff. +;;; + +(in-package :pcl) + +#+Lucid +(progn + +(defun pcl-arglist (function &rest other-args) + (let ((defn nil)) + (cond ((and (fsc-instance-p function) + (generic-function-p function)) + (generic-function-pretty-arglist function)) + ((and (symbolp function) + (fboundp function) + (setq defn (symbol-function function)) + (fsc-instance-p defn) + (generic-function-p defn)) + (generic-function-pretty-arglist defn)) + (t (apply (original-definition 'sys::arglist) + function other-args))))) + +(redefine-function 'sys::arglist 'pcl-arglist) + +) + + +;;; +;;; +;;; + +(defgeneric describe-object (object stream)) + +#-Genera +(progn + +(defun pcl-describe (object #+Lispm &optional #+Lispm no-complaints) + (let (#+Lispm (*describe-no-complaints* no-complaints)) + #+Lispm (declare (special *describe-no-complaints*)) + (describe-object object *standard-output*) + (values))) + +(defmethod describe-object (object stream) + #-cmu + (cond ((or #+kcl (packagep object)) + (describe-package object stream)) + (t + (funcall (original-definition 'describe) object))) + #+cmu + (describe object stream)) + +#-cmu +(redefine-function 'describe 'pcl-describe) + +) + +(defmethod describe-object ((object slot-object) stream) + (let* ((class (class-of object)) + (slotds (slots-to-inspect class object)) + (max-slot-name-length 0) + (instance-slotds ()) + (class-slotds ()) + (other-slotds ())) + (flet ((adjust-slot-name-length (name) + (setq max-slot-name-length + (max max-slot-name-length + (length (the string (symbol-name name)))))) + (describe-slot (name value &optional (allocation () alloc-p)) + (if alloc-p + (format stream + "~% ~A ~S ~VT ~S" + name allocation (+ max-slot-name-length 7) value) + (format stream + "~% ~A~VT ~S" + name max-slot-name-length value)))) + ;; Figure out a good width for the slot-name column. + (dolist (slotd slotds) + (adjust-slot-name-length (slot-definition-name slotd)) + (case (slot-definition-allocation slotd) + (:instance (push slotd instance-slotds)) + (:class (push slotd class-slotds)) + (otherwise (push slotd other-slotds)))) + (setq max-slot-name-length (min (+ max-slot-name-length 3) 30)) + (format stream "~%~S is an instance of class ~S:" object class) + + (when instance-slotds + (format stream "~% The following slots have :INSTANCE allocation:") + (dolist (slotd (nreverse instance-slotds)) + (describe-slot (slot-definition-name slotd) + (slot-value-or-default object (slot-definition-name slotd))))) + + (when class-slotds + (format stream "~% The following slots have :CLASS allocation:") + (dolist (slotd (nreverse class-slotds)) + (describe-slot (slot-definition-name slotd) + (slot-value-or-default object (slot-definition-name slotd))))) + + (when other-slotds + (format stream "~% The following slots have allocation as shown:") + (dolist (slotd (nreverse other-slotds)) + (describe-slot (slot-definition-name slotd) + (slot-value-or-default object (slot-definition-name slotd)) + (slot-definition-allocation slotd)))) + (values)))) + +(defmethod slots-to-inspect ((class slot-class) (object slot-object)) + (class-slots class)) + +(defvar *describe-metaobjects-as-objects-p* nil) + +(defmethod describe-object ((fun standard-generic-function) stream) + (format stream "~A is a generic function.~%" fun) + (format stream "Its arguments are:~% ~S~%" + (generic-function-pretty-arglist fun)) + (format stream "Its methods are:") + (dolist (meth (generic-function-methods fun)) + (format stream "~2% ~{~S ~}~:S =>~%" + (method-qualifiers meth) + (unparse-specializers meth)) + (describe-object (or (method-fast-function meth) + (method-function meth)) + stream)) + (when *describe-metaobjects-as-objects-p* + (call-next-method))) + +;;; +;;; +;;; +(defmethod describe-object ((class class) stream) + (flet ((pretty-class (c) (or (class-name c) c))) + (macrolet ((ft (string &rest args) `(format stream ,string ,@args))) + (ft "~&~S is a class, it is an instance of ~S.~%" + class (pretty-class (class-of class))) + (let ((name (class-name class))) + (if name + (if (eq class (find-class name nil)) + (ft "Its proper name is ~S.~%" name) + (ft "Its name is ~S, but this is not a proper name.~%" name)) + (ft "It has no name (the name is NIL).~%"))) + (ft "The direct superclasses are: ~:S, and the direct~%~ + subclasses are: ~:S. The class precedence list is:~%~S~%~ + There are ~D methods specialized for this class." + (mapcar #'pretty-class (class-direct-superclasses class)) + (mapcar #'pretty-class (class-direct-subclasses class)) + (mapcar #'pretty-class (class-precedence-list class)) + (length (specializer-direct-methods class))))) + (when *describe-metaobjects-as-objects-p* + (call-next-method))) + +(defun describe-package (object stream) + (unless (packagep object) (setq object (find-package object))) + (format stream "~&~S is a ~S.~%" object (type-of object)) + (let ((nick (package-nicknames object))) + (when nick + (format stream "You can also call it~@[ ~{~S~^, ~} or~] ~S.~%" + (butlast nick) (first (last nick))))) + (let* (#+cmu (internal (lisp::package-internal-symbols object)) + (internal-count #+cmu (- (lisp::package-hashtable-size internal) + (lisp::package-hashtable-free internal)) + #-cmu 0) + #+cmu (external (lisp::package-external-symbols object)) + (external-count #+cmu (- (lisp::package-hashtable-size external) + (lisp::package-hashtable-free external)) + #-cmu 0)) + #-cmu (do-external-symbols (sym object) + (declare (ignore sym)) + (incf external-count)) + #-cmu (do-symbols (sym object) + (declare (ignore sym)) + (incf internal-count)) + #-cmu (decf internal-count external-count) + (format stream "It has ~D internal and ~D external symbols (~D total).~%" + internal-count external-count (+ internal-count external-count))) + (let ((used (package-use-list object))) + (when used + (format stream "It uses the packages ~{~S~^, ~}.~%" + (mapcar #'package-name used)))) + (let ((users (package-use-list object))) + (when users + (format stream "It is used by the packages ~{~S~^, ~}.~%" + (mapcar #'package-name users))))) + +#+cmu +(defmethod describe-object ((object package) stream) + (describe-package object stream)) + +#+cmu +(defmethod describe-object ((object hash-table) stream) + (format stream "~&~S is an ~a hash table." + object + #-cmu17 (lisp::hash-table-kind object) + #+cmu17 (lisp::hash-table-test object)) + (format stream "~&Its size is ~d buckets." + (lisp::hash-table-size object)) + (format stream "~&Its rehash-size is ~d." + (lisp::hash-table-rehash-size object)) + (format stream "~&Its rehash-threshold is ~d." + (hash-table-rehash-threshold object)) + (format stream "~&It currently holds ~d entries." + (lisp::hash-table-number-entries object))) + + + +;;; +;;; trace-method and untrace-method accept method specs as arguments. A +;;; method-spec should be a list like: +;;; ( qualifiers* (specializers*)) +;;; where should be either a symbol or a list +;;; of (SETF ). +;;; +;;; For example, to trace the method defined by: +;;; +;;; (defmethod foo ((x spaceship)) 'ss) +;;; +;;; You should say: +;;; +;;; (trace-method '(foo (spaceship))) +;;; +;;; You can also provide a method object in the place of the method +;;; spec, in which case that method object will be traced. +;;; +;;; For untrace-method, if an argument is given, that method is untraced. +;;; If no argument is given, all traced methods are untraced. +;;; +(defclass traced-method (method) + ((method :initarg :method) + (function :initarg :function + :reader method-function) + (generic-function :initform nil + :accessor method-generic-function))) + +(defmethod method-lambda-list ((m traced-method)) + (with-slots (method) m (method-lambda-list method))) + +(defmethod method-specializers ((m traced-method)) + (with-slots (method) m (method-specializers method))) + +(defmethod method-qualifiers ((m traced-method)) + (with-slots (method) m (method-qualifiers method))) + +(defmethod accessor-method-slot-name ((m traced-method)) + (with-slots (method) m (accessor-method-slot-name method))) + +(defvar *traced-methods* ()) + +(defun trace-method (spec &rest options) + #+copy-&rest-arg (setq options (copy-list options)) + (multiple-value-bind (gf omethod name) + (parse-method-or-spec spec) + (let* ((tfunction (trace-method-internal (method-function omethod) + name + options)) + (tmethod (make-instance 'traced-method + :method omethod + :function tfunction))) + (remove-method gf omethod) + (add-method gf tmethod) + (pushnew tmethod *traced-methods*) + tmethod))) + +(defun untrace-method (&optional spec) + (flet ((untrace-1 (m) + (let ((gf (method-generic-function m))) + (when gf + (remove-method gf m) + (add-method gf (slot-value m 'method)) + (setq *traced-methods* (remove m *traced-methods*)))))) + (if (not (null spec)) + (multiple-value-bind (gf method) + (parse-method-or-spec spec) + (declare (ignore gf)) + (if (memq method *traced-methods*) + (untrace-1 method) + (error "~S is not a traced method?" method))) + (dolist (m *traced-methods*) (untrace-1 m))))) + +(defun trace-method-internal (ofunction name options) + (eval `(untrace ,name)) + (setf (symbol-function name) ofunction) + (eval `(trace ,name ,@options)) + (symbol-function name)) + + + + +;(defun compile-method (spec) +; (multiple-value-bind (gf method name) +; (parse-method-or-spec spec) +; (declare (ignore gf)) +; (compile name (method-function method)) +; (setf (method-function method) (symbol-function name)))) + +(defmacro undefmethod (&rest args) + #+(or (not :lucid) :lcl3.0) + (declare (arglist name {method-qualifier}* specializers)) + `(undefmethod-1 ',args)) + +(defun undefmethod-1 (args) + (multiple-value-bind (gf method) + (parse-method-or-spec args) + (when (and gf method) + (remove-method gf method) + method))) + + +(pushnew :pcl *features*) +(pushnew :portable-commonloops *features*) +(pushnew :pcl-structures *features*) + +#+cmu +(when (find-package "OLD-PCL") + (setf (symbol-function (find-symbol "PRINT-OBJECT" :old-pcl)) + (symbol-function 'pcl::print-object))) + + +;;;; MAKE-LOAD-FORM + +#+cmu17 +(export '(cl::make-load-form cl::make-load-form-saving-slots) "CL") + +#+cmu17 +(progn + (defgeneric make-load-form (object &optional environment)) + + (defmethod make-load-form ((object structure-object) &optional environment) + (declare (ignore environment)) + (kernel:make-structure-load-form object)) + + (defmethod make-load-form ((object wrapper) &optional env) + (declare (ignore env)) + (let ((pname (kernel:class-proper-name (kernel:layout-class object)))) + (unless pname + (error "Can't dump wrapper for anonymous class:~% ~S" + (kernel:layout-class object))) + `(kernel:class-layout (lisp:find-class ',pname)))) + + (defun make-load-form-saving-slots (object &key slot-names environment) + (declare (ignore environment)) + (when slot-names + (warn ":SLOT-NAMES MAKE-LOAD-FORM option not implemented, dumping all ~ + slots:~% ~S" + object)) + :just-dump-it-normally)) + + +;;; The following are hacks to deal with CMU CL having two different CLASS +;;; classes. +;;; +#+cmu17 +(defun coerce-to-pcl-class (class) + (if (typep class 'lisp:class) + (or (kernel:class-pcl-class class) + (find-structure-class (lisp:class-name class))) + class)) + +#+cmu17 +(progn + (defmethod make-instance ((class lisp:class) &rest stuff) + (apply #'make-instance (coerce-to-pcl-class class) stuff)) + (defmethod change-class (instance (class lisp:class)) + (apply #'change-class instance (coerce-to-pcl-class class)))) + +#+cmu17 +(macrolet ((frob (&rest names) + `(progn + ,@(mapcar #'(lambda (name) + `(defmethod ,name ((class lisp:class)) + (funcall #',name + (coerce-to-pcl-class class)))) + names)))) + (frob + class-direct-slots + class-prototype + class-precedence-list + class-direct-default-initargs + class-direct-superclasses + compute-class-precedence-list + class-default-initargs class-finalized-p + class-direct-subclasses class-slots + make-instances-obsolete)) diff --git a/pcl/gcl_pcl_fast_init.lisp b/pcl/gcl_pcl_fast_init.lisp new file mode 100644 index 0000000..f9c9d45 --- /dev/null +++ b/pcl/gcl_pcl_fast_init.lisp @@ -0,0 +1,1048 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; +;;; This file defines the optimized make-instance functions. +;;; + +(in-package :pcl) + +(defvar *compile-make-instance-functions-p* nil) + +(defun update-make-instance-function-table (&optional (class *the-class-t*)) + (when (symbolp class) (setq class (find-class class))) + (when (eq class *the-class-t*) (setq class *the-class-slot-object*)) + (when (memq *the-class-slot-object* (class-precedence-list class)) + (map-all-classes #'reset-class-initialize-info class))) + +(defun constant-symbol-p (form) + (and (constantp form) + (let ((object (eval form))) + (and (symbolp object) + (symbol-package object))))) + +(defvar *make-instance-function-keys* nil) + +(defun expand-make-instance-form (form) + (let ((class (cadr form)) (initargs (cddr form)) + (keys nil)(allow-other-keys-p nil) key value) + (when (and (constant-symbol-p class) + (let ((initargs-tail initargs)) + (loop (when (null initargs-tail) (return t)) + (unless (constant-symbol-p (car initargs-tail)) + (return nil)) + (setq key (eval (pop initargs-tail))) + (setq value (pop initargs-tail)) + (when (eq ':allow-other-keys key) + (setq allow-other-keys-p value)) + (push key keys)))) + (let* ((class (eval class)) + (keys (nreverse keys)) + (key (list class keys allow-other-keys-p)) + (sym (make-instance-function-symbol key))) + (push key *make-instance-function-keys*) + (when sym + `(,sym ',class ,@initargs)))))) + +(defmacro expanding-make-instance-top-level (&rest forms &environment env) + (let* ((*make-instance-function-keys* nil) + (form (macroexpand `(expanding-make-instance ,@forms) env))) + `(progn + ,@(when *make-instance-function-keys* + `((get-make-instance-functions ',*make-instance-function-keys*))) + ,form))) + +(defmacro expanding-make-instance (&rest forms &environment env) + `(progn + ,@(mapcar #'(lambda (form) + (walk-form form env + #'(lambda (subform context env) + (declare (ignore env)) + (or (and (eq context ':eval) + (consp subform) + (eq (car subform) 'make-instance) + (expand-make-instance-form subform)) + subform)))) + forms))) + +(defmacro defconstructor + (name class lambda-list &rest initialization-arguments) + `(expanding-make-instance-top-level + (defun ,name ,lambda-list + (make-instance ',class ,@initialization-arguments)))) + +(defun get-make-instance-functions (key-list) + (dolist (key key-list) + (let* ((cell (find-class-cell (car key))) + (make-instance-function-keys + (find-class-cell-make-instance-function-keys cell)) + (mif-key (cons (cadr key) (caddr key)))) + (unless (find mif-key make-instance-function-keys + :test #'equal) + (push mif-key (find-class-cell-make-instance-function-keys cell)) + (let ((class (find-class-cell-class cell))) + (when (and class (not (forward-referenced-class-p class))) + (update-initialize-info-internal + (initialize-info class (car mif-key) nil (cdr mif-key)) + 'make-instance-function))))))) + +(defun make-instance-function-symbol (key) + (let* ((class (car key)) + (symbolp (symbolp class))) + (when (or symbolp (classp class)) + (let* ((class-name (if (symbolp class) class (class-name class))) + (keys (cadr key)) + (allow-other-keys-p (caddr key))) + (when (and (or symbolp + (and (symbolp class-name) + (eq class (find-class class-name nil)))) + (symbol-package class-name)) + (let ((*package* *the-pcl-package*) + (*print-length* nil) (*print-level* nil) + (*print-circle* nil) (*print-case* :upcase) + (*print-pretty* nil)) + (intern (format nil "MAKE-INSTANCE ~S ~S ~S" + class-name keys allow-other-keys-p)))))))) + +(defun make-instance-1 (class &rest initargs) + (apply #'make-instance class initargs)) + +(defmacro define-cached-reader (type name trap) + (let ((reader-name (intern (format nil "~A-~A" type name))) + (cached-name (intern (format nil "~A-CACHED-~A" type name)))) + `(defmacro ,reader-name (info) + `(let ((value (,',cached-name ,info))) + (if (eq value ':unknown) + (progn + (,',trap ,info ',',name) + (,',cached-name ,info)) + value))))) + +(eval-when (compile load eval) +(defparameter initialize-info-cached-slots + '(valid-p ; t or (:invalid key) + ri-valid-p + initargs-form-list + combined-initargs-form-list + new-keys + default-initargs-function + shared-initialize-t-function + shared-initialize-nil-function + constants + combined-initialize-function ; allocate-instance + shared-initialize + make-instance-function ; nil means use gf + make-instance-function-symbol))) + +(defmacro define-initialize-info () + (let ((cached-slot-names + (mapcar #'(lambda (name) + (intern (format nil "CACHED-~A" name))) + initialize-info-cached-slots)) + (cached-names + (mapcar #'(lambda (name) + (intern (format nil "~A-CACHED-~A" + 'initialize-info name))) + initialize-info-cached-slots))) + `(progn + (defstruct initialize-info + key wrapper + ,@(mapcar #'(lambda (name) + `(,name :unknown)) + cached-slot-names)) + (defmacro reset-initialize-info-internal (info) + `(progn + ,@(mapcar #'(lambda (cname) + `(setf (,cname ,info) ':unknown)) + ',cached-names))) + (defun initialize-info-bound-slots (info) + (let ((slots nil)) + ,@(mapcar #'(lambda (name cached-name) + `(unless (eq ':unknown (,cached-name info)) + (push ',name slots))) + initialize-info-cached-slots cached-names) + slots)) + ,@(mapcar #'(lambda (name) + `(define-cached-reader initialize-info ,name + update-initialize-info-internal)) + initialize-info-cached-slots)))) + +(define-initialize-info) + +(defvar *initialize-info-cache-class* nil) +(defvar *initialize-info-cache-initargs* nil) +(defvar *initialize-info-cache-info* nil) + +(defvar *revert-initialize-info-p* nil) + +(defun reset-initialize-info (info) + (setf (initialize-info-wrapper info) + (class-wrapper (car (initialize-info-key info)))) + (let ((slots-to-revert (if *revert-initialize-info-p* + (initialize-info-bound-slots info) + '(make-instance-function)))) + (reset-initialize-info-internal info) + (dolist (slot slots-to-revert) + (update-initialize-info-internal info slot)) + info)) + +(defun reset-class-initialize-info (class) + (reset-class-initialize-info-1 (class-initialize-info class))) + +(defun reset-class-initialize-info-1 (cell) + (when (consp cell) + (when (car cell) + (reset-initialize-info (car cell))) + (let ((alist (cdr cell))) + (dolist (a alist) + (reset-class-initialize-info-1 (cdr a)))))) + +(defun initialize-info (class initargs &optional (plist-p t) allow-other-keys-arg) + (let ((info nil)) + (if (and (eq *initialize-info-cache-class* class) + (eq *initialize-info-cache-initargs* initargs)) + (setq info *initialize-info-cache-info*) + (let ((initargs-tail initargs) + (cell (or (class-initialize-info class) + (setf (class-initialize-info class) (cons nil nil))))) + (loop (when (null initargs-tail) (return nil)) + (let ((keyword (pop initargs-tail)) + (alist-cell cell)) + (when plist-p + (if (eq keyword :allow-other-keys) + (setq allow-other-keys-arg (pop initargs-tail)) + (pop initargs-tail))) + (loop (let ((alist (cdr alist-cell))) + (when (null alist) + (setq cell (cons nil nil)) + (setf (cdr alist-cell) (list (cons keyword cell))) + (return nil)) + (when (eql keyword (caar alist)) + (setq cell (cdar alist)) + (return nil)) + (setq alist-cell alist))))) + (setq info (or (car cell) + (setf (car cell) (make-initialize-info)))))) + (let ((wrapper (initialize-info-wrapper info))) + (unless (eq wrapper (class-wrapper class)) + (unless wrapper + (let* ((initargs-tail initargs) + (klist-cell (list nil)) + (klist-tail klist-cell)) + (loop (when (null initargs-tail) (return nil)) + (let ((key (pop initargs-tail))) + (setf (cdr klist-tail) (list key))) + (setf klist-tail (cdr klist-tail)) + (when plist-p (pop initargs-tail))) + (setf (initialize-info-key info) + (list class (cdr klist-cell) allow-other-keys-arg)))) + (reset-initialize-info info))) + (setq *initialize-info-cache-class* class) + (setq *initialize-info-cache-initargs* initargs) + (setq *initialize-info-cache-info* info) + info)) + +(defun update-initialize-info-internal (info name) + (let* ((key (initialize-info-key info)) + (class (car key)) + (keys (cadr key)) + (allow-other-keys-arg (caddr key))) + (ecase name + ((initargs-form-list new-keys) + (multiple-value-bind (initargs-form-list new-keys) + (make-default-initargs-form-list class keys) + (setf (initialize-info-cached-initargs-form-list info) initargs-form-list) + (setf (initialize-info-cached-new-keys info) new-keys))) + ((combined-initargs-form-list) + (multiple-value-bind (initargs-form-list new-keys) + (make-default-initargs-form-list class keys nil) + (setf (initialize-info-cached-combined-initargs-form-list info) + initargs-form-list) + (setf (initialize-info-cached-new-keys info) new-keys))) + ((default-initargs-function) + (let ((initargs-form-list (initialize-info-initargs-form-list info))) + (setf (initialize-info-cached-default-initargs-function info) + (initialize-instance-simple-function + 'default-initargs-function info + class initargs-form-list)))) + ((valid-p ri-valid-p) + (flet ((compute-valid-p (methods) + (or (not (null allow-other-keys-arg)) + (multiple-value-bind (legal allow-other-keys) + (check-initargs-values class methods) + (or (not (null allow-other-keys)) + (dolist (key keys t) + (unless (member key legal) + (return (cons :invalid key))))))))) + (let ((proto (class-prototype class))) + (setf (initialize-info-cached-valid-p info) + (compute-valid-p + (list (list* 'allocate-instance class nil) + (list* 'initialize-instance proto nil) + (list* 'shared-initialize proto t nil)))) + (setf (initialize-info-cached-ri-valid-p info) + (compute-valid-p + (list (list* 'reinitialize-instance proto nil) + (list* 'shared-initialize proto nil nil))))))) + ((shared-initialize-t-function) + (multiple-value-bind (initialize-form-list ignore) + (make-shared-initialize-form-list class keys t nil) + (declare (ignore ignore)) + (setf (initialize-info-cached-shared-initialize-t-function info) + (initialize-instance-simple-function + 'shared-initialize-t-function info + class initialize-form-list)))) + ((shared-initialize-nil-function) + (multiple-value-bind (initialize-form-list ignore) + (make-shared-initialize-form-list class keys nil nil) + (declare (ignore ignore)) + (setf (initialize-info-cached-shared-initialize-nil-function info) + (initialize-instance-simple-function + 'shared-initialize-nil-function info + class initialize-form-list)))) + ((constants combined-initialize-function) + (let ((initargs-form-list (initialize-info-combined-initargs-form-list info)) + (new-keys (initialize-info-new-keys info))) + (multiple-value-bind (initialize-form-list constants) + (make-shared-initialize-form-list class new-keys t t) + (setf (initialize-info-cached-constants info) constants) + (setf (initialize-info-cached-combined-initialize-function info) + (initialize-instance-simple-function + 'combined-initialize-function info + class (append initargs-form-list initialize-form-list)))))) + ((make-instance-function-symbol) + (setf (initialize-info-cached-make-instance-function-symbol info) + (make-instance-function-symbol key))) + ((make-instance-function) + (let* ((function (get-make-instance-function key)) + (symbol (initialize-info-make-instance-function-symbol info))) + (setf (initialize-info-cached-make-instance-function info) function) + (when symbol (setf (gdefinition symbol) + (or function #'make-instance-1))))))) + info) + +(defun get-make-instance-function (key) + (let* ((class (car key)) + (keys (cadr key))) + (unless (eq *boot-state* 'complete) + (return-from get-make-instance-function nil)) + (when (symbolp class) + (setq class (find-class class))) + (when (classp class) + (unless (class-finalized-p class) (finalize-inheritance class))) + (let* ((initargs (mapcan #'(lambda (key) (list key nil)) keys)) + (class-and-initargs (list* class initargs)) + (make-instance (gdefinition 'make-instance)) + (make-instance-methods + (compute-applicable-methods make-instance class-and-initargs)) + (std-mi-meth (find-standard-ii-method make-instance-methods 'class)) + (class+initargs (list class initargs)) + (default-initargs (gdefinition 'default-initargs)) + (default-initargs-methods + (compute-applicable-methods default-initargs class+initargs)) + (proto (and (classp class) (class-prototype class))) + (initialize-instance-methods + (when proto + (compute-applicable-methods (gdefinition 'initialize-instance) + (list* proto initargs)))) + (shared-initialize-methods + (when proto + (compute-applicable-methods (gdefinition 'shared-initialize) + (list* proto t initargs))))) + (when (null make-instance-methods) + (return-from get-make-instance-function + #'(lambda (class &rest initargs) + (apply #'no-applicable-method make-instance class initargs)))) + (unless (and (null (cdr make-instance-methods)) + (eq (car make-instance-methods) std-mi-meth) + (null (cdr default-initargs-methods)) + (eq (car (method-specializers (car default-initargs-methods))) + *the-class-slot-class*) + (flet ((check-meth (meth) + (let ((quals (method-qualifiers meth))) + (if (null quals) + (eq (car (method-specializers meth)) + *the-class-slot-object*) + (and (null (cdr quals)) + (or (eq (car quals) ':before) + (eq (car quals) ':after))))))) + (and (every #'check-meth initialize-instance-methods) + (every #'check-meth shared-initialize-methods)))) + (return-from get-make-instance-function nil)) + (get-make-instance-function-internal + class key (default-initargs class initargs) + initialize-instance-methods shared-initialize-methods)))) + +(defun get-make-instance-function-internal (class key initargs + initialize-instance-methods + shared-initialize-methods) + (let* (#|(class-key (car key))|# + (keys (cadr key)) + (allow-other-keys-p (caddr key)) + (allocate-instance-methods + (compute-applicable-methods (gdefinition 'allocate-instance) + (list* class initargs)))) + (unless allow-other-keys-p + (unless (check-initargs-1 + class initargs + (append allocate-instance-methods + initialize-instance-methods + shared-initialize-methods) + t nil) + (return-from get-make-instance-function-internal nil))) + (cond ((or (cdr allocate-instance-methods) + (some #'complicated-instance-creation-method + initialize-instance-methods) + (some #'complicated-instance-creation-method + shared-initialize-methods)) + (make-instance-function-complex + key class keys + initialize-instance-methods shared-initialize-methods)) + (t #|(or (not (standard-class-p class)) (not (symbolp class-key)) + initialize-instance-methods shared-initialize-methods)|# + (make-instance-function-simple + key class keys + initialize-instance-methods shared-initialize-methods)) + #|(t + (make-instance-function-basic + key class keys))|#))) + +(defun complicated-instance-creation-method (m) + (let ((qual (method-qualifiers m))) + (if qual + (not (and (null (cdr qual)) (eq (car qual) ':after))) + (let ((specl (car (method-specializers m)))) + (or (not (classp specl)) + (not (eq 'slot-object (class-name specl)))))))) + +(defun find-standard-ii-method (methods class-names) + (dolist (m methods) + (when (null (method-qualifiers m)) + (let ((specl (car (method-specializers m)))) + (when (and (classp specl) + (if (listp class-names) + (member (class-name specl) class-names) + (eq (class-name specl) class-names))) + (return m)))))) + +(defmacro call-initialize-function (initialize-function instance initargs) + `(let ((.function. ,initialize-function)) + (if (and (consp .function.) + (eq (car .function.) 'call-initialize-instance-simple)) + (initialize-instance-simple (cadr .function.) (caddr .function.) + ,instance ,initargs) + (funcall (the function .function.) ,instance ,initargs)))) + +(defmacro copy-slots (slots-init) + #-(or lucid cmu17) + `(copy-seq ,slots-init) + #+(or lucid cmu17) + `(let* ((init ,slots-init) + (len (length init)) + (v #+lucid (system:new-simple-vector len) + #+cmu17 (lisp::allocate-vector #.vm:simple-vector-type len len))) + (declare (simple-vector init v) + (type #-cmu fixnum #+cmu lisp::index len)) + (dotimes (i len v) + (declare (type #-cmu fixnum #+cmu lisp::index i)) + (setf (svref v i) (svref init i))))) + +(defmacro allocate-standard-instance--macro (wrapper slots-init) + #-new-kcl-wrapper + `(let ((instance (%%allocate-instance--class))) + (setf (std-instance-wrapper instance) ,wrapper) + (setf (std-instance-slots instance) (copy-slots ,slots-init)) + instance) + #+new-kcl-wrapper + `(allocate-standard-instance ,wrapper ,slots-init)) + +(defmacro with-make-instance-function-valid-p-check (initargs-form &body body) + `(let ((current-class (if class-cell + (find-class-from-cell class-key class-cell) + class-symbol))) + (if (or (not (eq current-class class-symbol)) + (invalid-wrapper-p wrapper)) + (make-instance-function-trap current-class ,initargs-form) + (progn ,@body)))) + +(defun make-instance-function-trap (class-symbol initargs) + (let* ((info (initialize-info class-symbol initargs)) + (fn (initialize-info-make-instance-function info))) + (declare (type function fn)) + (funcall fn class-symbol initargs))) + +(defun make-instance-function-simple (key class keys + initialize-instance-methods + shared-initialize-methods) + (let* ((class-key (car key)) + (class-cell (when (symbolp class-key) + (find-class-cell class-key nil))) + (wrapper (class-wrapper class)) + (lwrapper (list wrapper)) + (allocate-function + (cond ((structure-class-p class) + #'allocate-structure-instance) + ((standard-class-p class) + #'allocate-standard-instance) + ((funcallable-standard-class-p class) + #'allocate-funcallable-instance) + (t + (error "error in make-instance-function-simple")))) + (allocate-macro + (cond ((standard-class-p class) + 'allocate-standard-instance--macro))) + (std-si-meth (find-standard-ii-method shared-initialize-methods + 'slot-object)) + (shared-initfns + (nreverse (mapcar #'(lambda (method) + (make-effective-method-function + #'shared-initialize + `(call-method ,method nil) + nil lwrapper)) + (remove std-si-meth shared-initialize-methods)))) + (std-ii-meth (find-standard-ii-method initialize-instance-methods + 'slot-object)) + (initialize-initfns + (nreverse (mapcar #'(lambda (method) + (make-effective-method-function + #'initialize-instance + `(call-method ,method nil) + nil lwrapper)) + (remove std-ii-meth + initialize-instance-methods))))) + (multiple-value-bind (initialize-function constants) + (get-simple-initialization-function class keys (caddr key)) + (if (eq allocate-macro 'allocate-standard-instance--macro) + #'(lambda (class-symbol &rest initargs) + (with-make-instance-function-valid-p-check initargs + (let ((instance + (allocate-standard-instance--macro wrapper constants))) + (call-initialize-function initialize-function instance initargs) + (dolist (fn shared-initfns) + (invoke-effective-method-function fn t instance t initargs)) + (dolist (fn initialize-initfns) + (invoke-effective-method-function fn t instance initargs)) + instance))) + #'(lambda (class-symbol &rest initargs) + (with-make-instance-function-valid-p-check initargs + (let* ((instance (funcall allocate-function wrapper constants)) + (initargs (call-initialize-function initialize-function + instance initargs))) + (dolist (fn shared-initfns) + (invoke-effective-method-function fn t instance t initargs)) + (dolist (fn initialize-initfns) + (invoke-effective-method-function fn t instance initargs)) + instance))))))) + +(defun make-instance-function-complex (key class keys + initialize-instance-methods + shared-initialize-methods) + (multiple-value-bind (initargs-function initialize-function) + (get-complex-initialization-functions class keys (caddr key)) + (let* ((class-key (car key)) + (class-cell (when (symbolp class-key) + (find-class-cell class-key nil))) + (wrapper (class-wrapper class)) + (shared-initialize + (get-secondary-dispatch-function + #'shared-initialize shared-initialize-methods + `((class-eq ,class) t t) + `((,(find-standard-ii-method shared-initialize-methods 'slot-object) + ,#'(lambda (instance init-type &rest initargs) + (declare (ignore init-type)) + #+copy-&rest-arg (setq initargs (copy-list initargs)) + (call-initialize-function initialize-function + instance initargs) + instance))) + (list wrapper *the-wrapper-of-t* *the-wrapper-of-t*))) + (initialize-instance + (get-secondary-dispatch-function + #'initialize-instance initialize-instance-methods + `((class-eq ,class) t) + `((,(find-standard-ii-method initialize-instance-methods 'slot-object) + ,#'(lambda (instance &rest initargs) + #+copy-&rest-arg (setq initargs (copy-list initargs)) + (invoke-effective-method-function + shared-initialize t instance t initargs)))) + (list wrapper *the-wrapper-of-t*)))) + #'(lambda (class-symbol &rest initargs) + (with-make-instance-function-valid-p-check initargs + (let* ((initargs (call-initialize-function initargs-function + nil initargs)) + (instance (apply #'allocate-instance class initargs))) + (invoke-effective-method-function + initialize-instance t instance initargs) + instance)))))) + +#| +(defmacro call-initialize-function (initialize-function instance initargs) + `(let ((.function. ,initialize-function)) + (if (and (consp .function.) + (eq (car .function.) 'call-initialize-instance-simple)) + (initialize-instance-simple (cadr .function.) (caddr .function.) + ,instance ,initargs) + (funcall (the function .function.) ,instance ,initargs)))) + +(defun make-instance-function-basic (key class keys) + (let* ((class-key (car key)) + (class-cell (find-class-cell class-key nil)) + (wrapper (class-wrapper class))) + (multiple-value-bind (initialize-function constants) + (get-simple-initialization-function class keys (caddr key)) + #'(lambda (class-symbol &rest initargs) + (let ((current-class (find-class-from-cell class-key class-cell))) + (if (or (not (eq current-class class-symbol)) + (invalid-wrapper-p wrapper)) + (make-instance-function-trap current-class initargs-form) + (let ((instance + (allocate-standard-instance--macro wrapper constants))) + (call-initialize-function initialize-function instance initargs) + instance))))))) +|# + +(defun get-simple-initialization-function (class keys &optional allow-other-keys-arg) + (let ((info (initialize-info class keys nil allow-other-keys-arg))) + (values (initialize-info-combined-initialize-function info) + (initialize-info-constants info)))) + +(defun get-complex-initialization-functions (class keys &optional allow-other-keys-arg + separate-p) + (let* ((info (initialize-info class keys nil allow-other-keys-arg)) + (default-initargs-function (initialize-info-default-initargs-function info))) + (if separate-p + (values default-initargs-function + (initialize-info-shared-initialize-t-function info)) + (values default-initargs-function + (initialize-info-shared-initialize-t-function + (initialize-info class (initialize-info-new-keys info) + nil allow-other-keys-arg)))))) + +(defun add-forms (forms forms-list) + (when forms + (setq forms (copy-list forms)) + (if (null (car forms-list)) + (setf (car forms-list) forms) + (setf (cddr forms-list) forms)) + (setf (cdr forms-list) (last forms))) + (car forms-list)) + +(defun make-default-initargs-form-list (class keys &optional (separate-p t)) + (let ((initargs-form-list (cons nil nil)) + (default-initargs (class-default-initargs class)) + (nkeys keys) + (slots-alist + (mapcan #'(lambda (slot) + (mapcar #'(lambda (arg) + (cons arg slot)) + (slot-definition-initargs slot))) + (class-slots class))) + (nslots nil)) + (dolist (key nkeys) + (pushnew (cdr (assoc key slots-alist)) nslots)) + (dolist (default default-initargs) + (let* ((key (car default)) + (slot (cdr (assoc key slots-alist))) + (function (cadr default))) + (unless (member slot nslots) + (add-forms `((funcall ,function) (push-initarg ,key)) + initargs-form-list) + (push key nkeys) + (push slot nslots)))) + (when separate-p + (add-forms `((update-initialize-info-cache + ,class ,(initialize-info class nkeys nil))) + initargs-form-list)) + (add-forms `((finish-pushing-initargs)) + initargs-form-list) + (values (car initargs-form-list) nkeys))) + +(defun make-shared-initialize-form-list (class keys si-slot-names simple-p) + (let* ((initialize-form-list (cons nil nil)) + (type (cond ((structure-class-p class) + 'structure) + ((standard-class-p class) + 'standard) + ((funcallable-standard-class-p class) + 'funcallable) + (t (error "error in make-shared-initialize-form-list")))) + (wrapper (class-wrapper class)) + (constants (when simple-p + (make-array (wrapper-no-of-instance-slots wrapper) + ':initial-element *slot-unbound*))) + (slots (class-slots class)) + (slot-names (mapcar #'slot-definition-name slots)) + (slots-key (mapcar #'(lambda (slot) + (let ((index most-positive-fixnum)) + (dolist (key (slot-definition-initargs slot)) + (let ((pos (position key keys))) + (when pos (setq index (min index pos))))) + (cons slot index))) + slots)) + (slots (stable-sort slots-key #'< :key #'cdr))) + (let ((n-popped 0)) + (declare (fixnum n-popped)) + (dolist (slot+index slots) + (let* ((slot (car slot+index)) + (name (slot-definition-name slot)) + (npop (1+ (- (the fixnum (cdr slot+index)) n-popped)))) + (declare (fixnum npop)) + (unless (eql (cdr slot+index) most-positive-fixnum) + (let* ((pv-offset (1+ (position name slot-names)))) + (add-forms `(,@(when (plusp npop) + `((pop-initargs ,(the fixnum (* 2 npop))))) + (instance-set ,pv-offset ,slot)) + initialize-form-list)) + (incf n-popped npop))))) + (dolist (slot+index slots) + (let* ((slot (car slot+index)) + (name (slot-definition-name slot))) + (when (and (eql (cdr slot+index) most-positive-fixnum) + (or (eq si-slot-names 't) + (member name si-slot-names))) + (let* ((initform (slot-definition-initform slot)) + (initfunction (slot-definition-initfunction slot)) + (location (unless (eq type 'structure) + (slot-definition-location slot))) + (pv-offset (1+ (position name slot-names))) + (forms (cond ((null initfunction) + nil) + ((constantp initform) + (let ((value (funcall initfunction))) + (if (and simple-p (integerp location)) + (progn (setf (svref constants location) value) + nil) + `((const ,value) + (instance-set ,pv-offset ,slot))))) + (t + `((funcall ,(slot-definition-initfunction slot)) + (instance-set ,pv-offset ,slot)))))) + (add-forms `(,@(unless (or simple-p (null forms)) + `((skip-when-instance-boundp ,pv-offset ,slot + ,(length forms)))) + ,@forms) + initialize-form-list))))) + (values (car initialize-form-list) constants))) + +(defvar *class-pv-table-table* (make-hash-table :test 'eq)) + +(defun get-pv-cell-for-class (class) + (let* ((slot-names (mapcar #'slot-definition-name (class-slots class))) + (slot-name-lists (list (cons nil slot-names))) + (pv-table (gethash class *class-pv-table-table*))) + (unless (and pv-table + (equal slot-name-lists (pv-table-slot-name-lists pv-table))) + (setq pv-table (intern-pv-table :slot-name-lists slot-name-lists)) + (setf (gethash class *class-pv-table-table*) pv-table)) + (pv-table-lookup pv-table (class-wrapper class)))) + +(defvar *initialize-instance-simple-alist* nil) +(defvar *note-iis-entry-p* nil) + +(defvar *compiled-initialize-instance-simple-functions* + (make-hash-table :test #'equal)) + +(defun initialize-instance-simple-function (use info class form-list) + (let* ((pv-cell (get-pv-cell-for-class class)) + (key (initialize-info-key info)) + (sf-key (list* use (class-name (car key)) (cdr key)))) + (if (or *compile-make-instance-functions-p* + (gethash sf-key *compiled-initialize-instance-simple-functions*)) + (multiple-value-bind (form args) + (form-list-to-lisp pv-cell form-list) + (let ((entry (assoc form *initialize-instance-simple-alist* + :test #'equal))) + (setf (gethash sf-key + *compiled-initialize-instance-simple-functions*) + t) + (if entry + (setf (cdddr entry) (union (list sf-key) (cdddr entry) + :test #'equal)) + (progn + (setq entry (list* form nil nil (list sf-key))) + (setq *initialize-instance-simple-alist* + (nconc *initialize-instance-simple-alist* + (list entry))))) + (unless (or *note-iis-entry-p* (cadr entry)) + (setf (cadr entry) (compile-lambda (car entry)))) + (if (cadr entry) + (apply (the function (cadr entry)) args) + `(call-initialize-instance-simple ,pv-cell ,form-list)))) + #|| + #'(lambda (instance initargs) + (initialize-instance-simple pv-cell form-list instance initargs)) + ||# + `(call-initialize-instance-simple ,pv-cell ,form-list)))) + +(defun load-precompiled-iis-entry (form function system uses) + (let ((entry (assoc form *initialize-instance-simple-alist* + :test #'equal))) + (unless entry + (setq entry (list* form nil nil nil)) + (setq *initialize-instance-simple-alist* + (nconc *initialize-instance-simple-alist* + (list entry)))) + (setf (cadr entry) function) + (setf (caddr entry) system) + (dolist (use uses) + (setf (gethash use *compiled-initialize-instance-simple-functions*) t)) + (setf (cdddr entry) (union uses (cdddr entry) + :test #'equal)))) + +(defmacro precompile-iis-functions (&optional system) + (let ((index -1)) + `(progn + ,@(gathering1 (collecting) + (dolist (iis-entry *initialize-instance-simple-alist*) + (when (or (null (caddr iis-entry)) + (eq (caddr iis-entry) system)) + (when system (setf (caddr iis-entry) system)) + (gather1 + (make-top-level-form + `(precompile-initialize-instance-simple ,system ,(incf index)) + '(load) + `(load-precompiled-iis-entry + ',(car iis-entry) + #',(car iis-entry) + ',system + ',(cdddr iis-entry)))))))))) + +(defun compile-iis-functions (after-p) + (let ((*compile-make-instance-functions-p* t) + (*revert-initialize-info-p* t) + (*note-iis-entry-p* (not after-p))) + (declare (special *compile-make-instance-functions-p*)) + (when (eq *boot-state* 'complete) + (update-make-instance-function-table)))) + + +;(const const) +;(funcall function) +;(push-initarg const) +;(pop-supplied count) ; a positive odd number +;(instance-set pv-offset slotd) +;(skip-when-instance-boundp pv-offset slotd n) + +(defun initialize-instance-simple (pv-cell form-list instance initargs) + (let ((pv (car pv-cell)) + (initargs-tail initargs) + (slots (get-slots-or-nil instance)) + (class (class-of instance)) + value) + (loop (when (null form-list) (return nil)) + (let ((form (pop form-list))) + (ecase (car form) + (push-initarg + (push value initargs) + (push (cadr form) initargs)) + (const + (setq value (cadr form))) + (funcall + (setq value (funcall (the function (cadr form))))) + (pop-initargs + (setq initargs-tail (nthcdr (1- (cadr form)) initargs-tail)) + (setq value (pop initargs-tail))) + (instance-set + (instance-write-internal + pv slots (cadr form) value + (setf (slot-value-using-class class instance (caddr form)) value))) + (skip-when-instance-boundp + (when (instance-boundp-internal + pv slots (cadr form) + (slot-boundp-using-class class instance (caddr form))) + (dotimes (i (cadddr form)) + (pop form-list)))) + (update-initialize-info-cache + (when (consp initargs) + (setq initargs (cons (car initargs) (cdr initargs)))) + (setq *initialize-info-cache-class* (cadr form)) + (setq *initialize-info-cache-initargs* initargs) + (setq *initialize-info-cache-info* (caddr form))) + (finish-pushing-initargs + (setq initargs-tail initargs))))) + initargs)) + +(defun add-to-cvector (cvector constant) + (or (position constant cvector) + (prog1 (fill-pointer cvector) + (vector-push-extend constant cvector)))) + +(defvar *inline-iis-instance-locations-p* t) + +(defun first-form-to-lisp (forms cvector pv) + (flet ((const (constant) + (cond ((or (numberp constant) (characterp constant)) + constant) + ((and (symbolp constant) (symbol-package constant)) + `',constant) + (t + `(svref cvector ,(add-to-cvector cvector constant)))))) + (let ((form (pop (car forms)))) + (ecase (car form) + (push-initarg + `((push value initargs) + (push ,(const (cadr form)) initargs))) + (const + `((setq value ,(const (cadr form))))) + (funcall + `((setq value (funcall (the function ,(const (cadr form))))))) + (pop-initargs + `((setq initargs-tail (,@(let ((pop (1- (cadr form)))) + (case pop + (1 `(cdr)) + (3 `(cdddr)) + (t `(nthcdr ,pop)))) + initargs-tail)) + (setq value (pop initargs-tail)))) + (instance-set + (let* ((pv-offset (cadr form)) + (location (pvref pv pv-offset)) + (default `(setf (slot-value-using-class class instance + ,(const (caddr form))) + value))) + (if *inline-iis-instance-locations-p* + (typecase location + (fixnum `((setf (%instance-ref slots ,(const location)) value))) + (cons `((setf (cdr ,(const location)) value))) + (t `(,default))) + `((instance-write-internal pv slots ,(const pv-offset) value + ,default + ,(typecase location + (fixnum ':instance) + (cons ':class) + (t ':default))))))) + (skip-when-instance-boundp + (let* ((pv-offset (cadr form)) + (location (pvref pv pv-offset)) + (default `(slot-boundp-using-class class instance + ,(const (caddr form))))) + `((unless ,(if *inline-iis-instance-locations-p* + (typecase location + (fixnum `(not (eq (%instance-ref slots ,(const location)) + ',*slot-unbound*))) + (cons `(not (eq (cdr ,(const location)) ',*slot-unbound*))) + (t default)) + `(instance-boundp-internal pv slots ,(const pv-offset) + ,default + ,(typecase (pvref pv pv-offset) + (fixnum ':instance) + (cons ':class) + (t ':default)))) + ,@(let ((sforms (cons nil nil))) + (dotimes (i (cadddr form) (car sforms)) + (add-forms (first-form-to-lisp forms cvector pv) sforms))))))) + (update-initialize-info-cache + `((when (consp initargs) + (setq initargs (cons (car initargs) (cdr initargs)))) + (setq *initialize-info-cache-class* ,(const (cadr form))) + (setq *initialize-info-cache-initargs* initargs) + (setq *initialize-info-cache-info* ,(const (caddr form))))) + (finish-pushing-initargs + `((setq initargs-tail initargs))))))) + +(defmacro iis-body (&body forms) + (let ((vars '(initargs-tail pv slots wrapper class value))) + `(let ((initargs-tail initargs) + (pv (car pv-cell)) + (slots nil) + (wrapper #+cmu17 (kernel:layout-of instance) #-cmu17 nil) + class + value) + ,@(progn + #-cmu vars + #+cmu `((declare (ignorable ,@vars)))) + #+cmu17 + (cond ((not (typep wrapper 'wrapper))) + ((std-instance-p instance) + (setq slots (std-instance-slots instance))) + (t + (setq slots (fsc-instance-slots instance)))) + #-cmu17 + (cond ((std-instance-p instance) + (setq slots (std-instance-slots instance)) + (setq wrapper (std-instance-wrapper instance))) + ((fsc-instance-p instance) + (setq slots (fsc-instance-slots instance)) + (setq wrapper (fsc-instance-wrapper instance))) + (t + (setq wrapper (wrapper-of instance)))) + (setq class (wrapper-class wrapper)) + ,@forms))) + +(defun form-list-to-lisp (pv-cell form-list) + (let* ((forms (list form-list)) + (cvector (make-array (floor (length form-list) 2) + :fill-pointer 0 :adjustable t)) + (pv (car pv-cell)) + (body (let ((rforms (cons nil nil))) + (loop (when (null (car forms)) (return (car rforms))) + (add-forms (first-form-to-lisp forms cvector pv) + rforms)))) + (cvector-type `(simple-vector ,(length cvector)))) + (values + `(lambda (pv-cell cvector) + (declare (type ,cvector-type cvector)) + #+cmu + (declare (ignorable pv-cell cvector)) + #'(lambda (instance initargs) + (declare #.*optimize-speed*) + #+cmu + (declare (ignorable instance initargs)) + (iis-body ,@body) + initargs)) + (list pv-cell (coerce cvector cvector-type))))) + + +;The effect of this is to cause almost all of the overhead of make-instance +;to happen at load time (or maybe at precompile time, as explained in a +;previous message) rather than the first time make-instance is called with +;a given class-name and sequence of keywords. + +;This optimization applys only when the first argument and all the even +;numbered arguments are constants evaluating to interned symbols. + +#+cmu +(declaim (ftype (function (t) symbol) get-make-instance-function-symbol)) + +; Use this definition in any CL implementation supporting +; both define-compiler-macro and load-time-value. +#+cmu +(define-compiler-macro make-instance (&whole form &rest args) + (declare (ignore args)) + (let* ((*make-instance-function-keys* nil) + (expanded-form (expand-make-instance-form form))) + (if expanded-form + `(funcall (the function + (symbol-function + ;; The symbol is guaranteed to be fbound. + ;; Is there a way to declare this? + (load-time-value + (get-make-instance-function-symbol + ',(first *make-instance-function-keys*))))) + ,@(cdr expanded-form)) + form))) + +(defun get-make-instance-function-symbol (key) + (get-make-instance-functions (list key)) + (make-instance-function-symbol key)) diff --git a/pcl/gcl_pcl_fin.lisp b/pcl/gcl_pcl_fin.lisp new file mode 100644 index 0000000..22f2d7d --- /dev/null +++ b/pcl/gcl_pcl_fin.lisp @@ -0,0 +1,1868 @@ +;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + + ;; +;;;;;; FUNCALLABLE INSTANCES + ;; + +#| + +Generic functions are instances with meta class funcallable-standard-class. +Instances with this meta class are called funcallable-instances (FINs for +short). They behave something like lexical closures in that they have data +associated with them (which is used to store the slots) and are funcallable. +When a funcallable instance is funcalled, the function that is invoked is +called the funcallable-instance-function. The funcallable-instance-function +of a funcallable instance can be changed. + +This file implements low level code for manipulating funcallable instances. + +It is possible to implement funcallable instances in pure Common Lisp. A +simple implementation which uses lexical closures as the instances and a +hash table to record that the lexical closures are funcallable instances +is easy to write. Unfortunately, this implementation adds significant +overhead: + + to generic-function-invocation (1 function call) + to slot-access (1 function call or one hash table lookup) + to class-of a generic-function (1 hash-table lookup) + +In addition, it would prevent the funcallable instances from being garbage +collected. In short, the pure Common Lisp implementation really isn't +practical. + +Instead, PCL uses a specially tailored implementation for each Common Lisp and +makes no attempt to provide a purely portable implementation. The specially +tailored implementations are based on the lexical closure's provided by that +implementation and are fairly short and easy to write. + +Some of the implementation dependent code in this file was originally written +by someone in the employ of the vendor of that Common Lisp. That code is +explicitly marked saying who wrote it. + +|# + +(in-package :pcl) + +;;; +;;; The first part of the file contains the implementation dependent code to +;;; implement funcallable instances. Each implementation must provide the +;;; following functions and macros: +;;; +;;; ALLOCATE-FUNCALLABLE-INSTANCE-1 () +;;; should create and return a new funcallable instance. The +;;; funcallable-instance-data slots must be initialized to NIL. +;;; This is called by allocate-funcallable-instance and by the +;;; bootstrapping code. +;;; +;;; FUNCALLABLE-INSTANCE-P (x) +;;; the obvious predicate. This should be an INLINE function. +;;; it must be funcallable, but it would be nice if it compiled +;;; open. +;;; +;;; SET-FUNCALLABLE-INSTANCE-FUNCTION (fin new-value) +;;; change the fin so that when it is funcalled, the new-value +;;; function is called. Note that it is legal for new-value +;;; to be copied before it is installed in the fin, specifically +;;; there is no accessor for a FIN's function so this function +;;; does not have to preserve the actual new value. The new-value +;;; argument can be any funcallable thing, a closure, lambda +;;; compiled code etc. This function must coerce those values +;;; if necessary. +;;; NOTE: new-value is almost always a compiled closure. This +;;; is the important case to optimize. +;;; +;;; FUNCALLABLE-INSTANCE-DATA-1 (fin data-name) +;;; should return the value of the data named data-name in the fin. +;;; data-name is one of the symbols in the list which is the value +;;; of funcallable-instance-data. Since data-name is almost always +;;; a quoted symbol and funcallable-instance-data is a constant, it +;;; is possible (and worthwhile) to optimize the computation of +;;; data-name's offset in the data part of the fin. +;;; This must be SETF'able. +;;; + +(eval-when (compile load eval) +(defconstant funcallable-instance-data + '(wrapper slots) + "These are the 'data-slots' which funcallable instances have so that + the meta-class funcallable-standard-class can store class, and static + slots in them.") +) + +(defmacro funcallable-instance-data-position (data) + (if (and (consp data) + (eq (car data) 'quote)) + (or (position (cadr data) funcallable-instance-data :test #'eq) + (progn + (warn "Unknown funcallable-instance data: ~S." (cadr data)) + `(error "Unknown funcallable-instance data: ~S." ',(cadr data)))) + `(position ,data funcallable-instance-data :test #'eq))) + +(proclaim '(notinline called-fin-without-function)) +(defun called-fin-without-function (&rest args) + (declare (ignore args)) + (error "Attempt to funcall a funcallable-instance without first~%~ + setting its funcallable-instance-function.")) + + +;;; +;;; In Lucid Lisp, compiled functions and compiled closures have the same +;;; representation. They are called procedures. A procedure is a basically +;;; just a constants vector, with one slot which points to the CODE. This +;;; means that constants and closure variables are intermixed in the procedure +;;; vector. +;;; +;;; This code was largely written by JonL@Lucid.com. Problems with it should +;;; be referred to him. +;;; +#+Lucid +(progn + +(defconstant procedure-is-funcallable-instance-bit-position 10) + +(defconstant fin-trampoline-fun-index lucid::procedure-literals) + +(defconstant fin-size (+ fin-trampoline-fun-index + (length funcallable-instance-data) + 1)) + +;;; +;;; The inner closure of this function will have its code vector replaced +;;; by a hand-coded fast jump to the function that is stored in the +;;; captured-lexical variable. In effect, that code is a hand- +;;; optimized version of the code for this inner closure function. +;;; +(defun make-trampoline (function) + (declare (optimize (speed 3) (safety 0))) + #'(lambda (&rest args) + (apply function args))) + +(eval-when (eval) + (compile 'make-trampoline) + ) + + +(defun binary-assemble (codes) + (let* ((ncodes (length codes)) + (code-vec #-LCL3.0 (lucid::new-code ncodes) + #+LCL3.0 (lucid::with-current-area + lucid::*READONLY-NON-POINTER-AREA* + (lucid::new-code ncodes)))) + (declare (fixnum ncodes)) + (do ((l codes (cdr l)) + (i 0 (1+ i))) + ((null l) nil) + (declare (fixnum i)) + (setf (lucid::code-ref code-vec i) (car l))) + code-vec)) + +;;; +;;; Egad! Binary patching! +;;; See comment following definition of MAKE-TRAMPOLINE -- this is just +;;; the "hand-optimized" machine instructions to make it work. +;;; +(defvar *mattress-pad-code* + (binary-assemble + #+MC68000 + '(#x2A6D #x11 #x246D #x1 #x4EEA #x5) + #+SPARC + (ecase (lucid::procedure-length #'lucid::false) + (5 + '(#xFA07 #x6012 #xDE07 #x7FFE #x81C3 #xFFFE #x100 #x0)) + (8 + `(#xFA07 #x601E #xDE07 #x7FFE #x81C3 #xFFFE #x100 #x0))) + #+(and BSP (not LCL3.0 )) + '(#xCD33 #x11 #xCDA3 #x1 #xC19A #x5 #xE889) + #+(and BSP LCL3.0) + '(#x7733 #x7153 #xC155 #x5 #xE885) + #+I386 + '(#x87 #xD2 #x8B #x76 #xE #xFF #x66 #xFE) + #+VAX + '(#xD0 #xAC #x11 #x5C #xD0 #xAC #x1 #x57 #x17 #xA7 #x5) + #+PA + '(#x4891 #x3C #xE461 #x6530 #x48BF #x3FF9) + #+MIPS + '(#x8FD4 #x1E #x2785 #x2EEF #xA0 #x8 #x14 #xF000) + #-(or MC68000 SPARC BSP I386 VAX PA MIPS) + '(0 0 0 0))) + + +(lucid::defsubst funcallable-instance-p (x) + (and (lucid::procedurep x) + (lucid::logbitp& procedure-is-funcallable-instance-bit-position + (lucid::procedure-ref x lucid::procedure-flags)))) + +(lucid::defsubst set-funcallable-instance-p (x) + (if (not (lucid::procedurep x)) + (error "Can't make a non-procedure a fin.") + (setf (lucid::procedure-ref x lucid::procedure-flags) + (logior (expt 2 procedure-is-funcallable-instance-bit-position) + (the fixnum + (lucid::procedure-ref x lucid::procedure-flags)))))) + + +(defun allocate-funcallable-instance-1 () + #+Prime + (declare (notinline lucid::new-procedure)) ;fixes a bug in Prime 1.0 in + ;which new-procedure expands + ;incorrectly + (let ((new-fin (lucid::new-procedure fin-size)) + (fin-index fin-size)) + (declare (fixnum fin-index) + (type lucid::procedure new-fin)) + (dotimes (i (length funcallable-instance-data)) + ;; Initialize the new funcallable-instance. As part of our contract, + ;; we have to make sure the initial value of all the funcallable + ;; instance data slots is NIL. + (decf fin-index) + (setf (lucid::procedure-ref new-fin fin-index) nil)) + ;; + ;; "Assemble" the initial function by installing a fast "trampoline" code; + ;; + (setf (lucid::procedure-ref new-fin lucid::procedure-code) + *mattress-pad-code*) + ;; Disable argcount checking in the "mattress-pad" code for + ;; ports that go through standardized trampolines + #+PA (setf (sys:procedure-ref new-fin lucid::procedure-arg-count) -1) + #+MIPS (progn + (setf (sys:procedure-ref new-fin lucid::procedure-min-args) 0) + (setf (sys:procedure-ref new-fin lucid::procedure-max-args) + call-arguments-limit)) + ;; but start out with the function to be run as an error call. + (setf (lucid::procedure-ref new-fin fin-trampoline-fun-index) + #'called-fin-without-function) + ;; Then mark it as a "fin" + (set-funcallable-instance-p new-fin) + new-fin)) + +(defun set-funcallable-instance-function (fin new-value) + (unless (funcallable-instance-p fin) + (error "~S is not a funcallable-instance" fin)) + (if (lucid::procedurep new-value) + (progn + (setf (lucid::procedure-ref fin fin-trampoline-fun-index) new-value) + fin) + (progn + (unless (functionp new-value) + (error "~S is not a function." new-value)) + ;; 'new-value' is an interpreted function. Install a + ;; trampoline to call the interpreted function. + (set-funcallable-instance-function fin + (make-trampoline new-value))))) + +(defmacro funcallable-instance-data-1 (instance data) + `(lucid::procedure-ref + ,instance + (the fixnum + (- (- fin-size 1) + (the fixnum (funcallable-instance-data-position ,data)))))) + +);end of #+Lucid + + +;;; +;;; In Symbolics Common Lisp, a lexical closure is a pair of an environment +;;; and an ordinary compiled function. The environment is represented as +;;; a CDR-coded list. I know of no way to add a special bit to say that the +;;; closure is a FIN, so for now, closures are marked as FINS by storing a +;;; special marker in the last cell of the environment. +;;; +;;; The new structure of a fin is: +;;; (lex-env lex-fun *marker* fin-data0 fin-data1) +;;; The value returned by allocate is a lexical-closure pointing to the start +;;; of the fin list. Benefits are: no longer ever have to copy environments, +;;; fins can be much smaller (5 words instead of 18), old environments never +;;; get destroyed (so running dcodes dont have the lex env change from under +;;; them any longer). +;;; +;;; Most of the fin operations speed up a little (by as much as 30% on a +;;; 3650), at least one nasty bug is fixed, and so far at least I've not +;;; seen any problems at all with this code. - mike thome (mthome@bbn.com) +;;; +#+(and Genera (not Genera-Release-8)) +(progn + +(defvar *funcallable-instance-marker* (list "Funcallable Instance Marker")) + +(defun allocate-funcallable-instance-1 () + (let* ((whole-fin (make-list (+ 3 (length funcallable-instance-data)))) + (new-fin (sys:%make-pointer-offset sys:dtp-lexical-closure + whole-fin + 0))) + ;; + ;; note that we DO NOT turn the real lex-closure part of the fin into + ;; a dotted pair, because (1) the machine doesn't care and (2) if we + ;; did the garbage collector would reclaim everything after the lexical + ;; function. + ;; + (setf (sys:%p-contents-offset new-fin 2) *funcallable-instance-marker*) + (setf (si:lexical-closure-function new-fin) + #'(lambda (ignore &rest ignore-them-too) + (declare (ignore ignore ignore-them-too)) + (called-fin-without-function))) + #+ignore + (setf (si:lexical-closure-environment new-fin) nil) + new-fin)) + +(scl:defsubst funcallable-instance-p (x) + (declare (inline si:lexical-closure-p)) + (and (si:lexical-closure-p x) + (= (sys:%p-cdr-code (sys:%make-pointer-offset sys:dtp-compiled-function x 1)) + sys:cdr-next) + (eq (sys:%p-contents-offset x 2) *funcallable-instance-marker*))) + +(defun set-funcallable-instance-function (fin new-value) + (cond ((not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance" fin)) + ((not (or (functionp new-value) + (and (consp new-value) + (eq (car new-value) 'si:digested-lambda)))) + (error "~S is not a function." new-value)) + ((and (si:lexical-closure-p new-value) + (compiled-function-p (si:lexical-closure-function new-value))) + (let ((env (si:lexical-closure-environment new-value)) + (fn (si:lexical-closure-function new-value))) + ;; we only have to copy the pointers!! + (setf (si:lexical-closure-environment fin) env + (si:lexical-closure-function fin) fn) +; (dbg:set-env->fin env fin) + )) + (t + (set-funcallable-instance-function fin + (make-trampoline new-value))))) + +(defun make-trampoline (function) + (declare (optimize (speed 3) (safety 0))) + #'(lambda (&rest args) + #+Genera (declare (dbg:invisible-frame :pcl-internals)) + (apply function args))) + +(defmacro funcallable-instance-data-1 (fin data) + `(sys:%p-contents-offset ,fin + (+ 3 (funcallable-instance-data-position ,data)))) + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(setf (sys:%p-contents-offset ,fin + (+ 3 (funcallable-instance-data-position ,data))) + ,new-value)) + +;;; +;;; Make funcallable instances print out properly. +;;; +(defvar *print-lexical-closure* nil) + +(defun pcl-print-lexical-closure (exp stream slashify-p &optional (depth 0)) + (declare (ignore depth)) + (declare (special *boot-state*)) + (if (or (eq *print-lexical-closure* exp) + (neq *boot-state* 'complete) + (eq (class-of exp) *the-class-t*)) + (let ((*print-lexical-closure* nil)) + (funcall (original-definition 'si:print-lexical-closure) + exp stream slashify-p)) + (let ((*print-escape* slashify-p) + (*print-lexical-closure* exp)) + (print-object exp stream)))) + +(unless (boundp '*boot-state*) + (setq *boot-state* nil)) + +(redefine-function 'si:print-lexical-closure 'pcl-print-lexical-closure) + +(defvar *function-name-level* 0) + +(defun pcl-function-name (function &rest other-args) + (if (and (eq *boot-state* 'complete) + (funcallable-instance-p function) + (generic-function-p function) + (<= *function-name-level* 2)) + (let ((*function-name-level* (1+ *function-name-level*))) + (generic-function-name function)) + (apply (original-definition 'si:function-name) function other-args))) + +(redefine-function 'si:function-name 'pcl-function-name) + +(defun pcl-arglist (function &rest other-args) + (let ((defn nil)) + (cond ((and (funcallable-instance-p function) + (generic-function-p function)) + (generic-function-pretty-arglist function)) + ((and (sys:validate-function-spec function) + (sys:fdefinedp function) + (setq defn (sys:fdefinition function)) + (funcallable-instance-p defn) + (generic-function-p defn)) + (generic-function-pretty-arglist defn)) + (t (apply (original-definition 'zl:arglist) function other-args))))) + +(redefine-function 'zl:arglist 'pcl-arglist) + + +;;; +;;; This code is adapted from frame-lexical-environment and frame-function. +;;; +#|| +dbg: +(progn + +(defvar *old-frame-function*) + +(defvar *inside-new-frame-function* nil) + +(defun new-frame-function (frame) + (let* ((fn (funcall *old-frame-function* frame)) + (location (%pointer-plus frame #+imach (defstorage-size stack-frame) #-imach 0)) + (env? #+3600 (location-contents location) + #+imach (%memory-read location :cycle-type %memory-scavenge))) + (or (when (cl:consp env?) + (let ((l2 (last2 env?))) + (when (eq (car l2) '.this-is-a-dfun.) + (cadr l2)))) + fn))) + +(defun pcl::doctor-dfun-for-the-debugger (gf dfun) + (when (sys:lexical-closure-p dfun) + (let* ((env (si:lexical-closure-environment dfun)) + (l2 (last2 env))) + (unless (eq (car l2) '.this-is-a-dfun.) + (setf (si:lexical-closure-environment dfun) + (nconc env (list '.this-is-a-dfun. gf)))))) + dfun) + +(defun last2 (l) + (labels ((scan (2ago tail) + (if (null tail) + 2ago + (if (cl:consp tail) + (scan (cdr 2ago) (cdr tail)) + nil)))) + (and (cl:consp l) + (cl:consp (cdr l)) + (scan l (cddr l))))) + +(eval-when (load) + (unless (boundp '*old-frame-function*) + (setq *old-frame-function* #'frame-function) + (setf (cl:symbol-function 'frame-function) 'new-frame-function))) + +) +||# + +);end of #+Genera + + + +;;; +;;; In Genera 8.0, we use a real funcallable instance (from Genera CLOS) for this. +;;; This minimizes the subprimitive mucking around. +;;; +#+(and Genera Genera-Release-8) +(progn + +(clos-internals::ensure-class + 'pcl-funcallable-instance + :direct-superclasses '(clos-internals:funcallable-instance) + :slots `((:name function + :initform #'(lambda (ignore &rest ignore-them-too) + (declare (ignore ignore ignore-them-too)) + (called-fin-without-function)) + :initfunction ,#'(lambda nil + #'(lambda (ignore &rest ignore-them-too) + (declare (ignore ignore ignore-them-too)) + (called-fin-without-function)))) + ,@(mapcar #'(lambda (slot) `(:name ,slot)) funcallable-instance-data)) + :metaclass 'clos:funcallable-standard-class) + +(defun pcl-funcallable-instance-trampoline (extra-arg &rest args) + (apply (sys:%instance-ref (clos-internals::%dispatch-instance-from-extra-argument extra-arg) + 3) + args)) + +(defun allocate-funcallable-instance-1 () + (let ((fin (clos:make-instance 'pcl-funcallable-instance))) + (setf (clos-internals::%funcallable-instance-function fin) + #'pcl-funcallable-instance-trampoline) + (setf (clos-internals::%funcallable-instance-extra-argument fin) + (sys:%make-pointer sys:dtp-instance + (clos-internals::%funcallable-instance-extra-argument fin))) + (setf (clos:slot-value fin 'clos-internals::funcallable-instance) fin) + fin)) + +(scl:defsubst funcallable-instance-p (x) + (and (sys:funcallable-instance-p x) + (eq (clos-internals::%funcallable-instance-function x) + #'pcl-funcallable-instance-trampoline))) + +(defun set-funcallable-instance-function (fin new-value) + (setf (clos:slot-value fin 'function) new-value)) + +(defmacro funcallable-instance-data-1 (fin data) + `(clos-internals:%funcallable-instance-ref + ,fin (+ 4 (funcallable-instance-data-position ,data)))) + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(setf (clos-internals:%funcallable-instance-ref + ,fin (+ 4 (funcallable-instance-data-position ,data))) + ,new-value)) + +(clos:defmethod clos:print-object ((fin pcl-funcallable-instance) stream) + (print-object fin stream)) + +(clos:defmethod clos-internals:debugging-information-function ((fin pcl-funcallable-instance)) + nil) + +(clos:defmethod clos-internals:function-name-object ((fin pcl-funcallable-instance)) + (declare (special *boot-state*)) + (if (and (eq *boot-state* 'complete) + (generic-function-p fin)) + (generic-function-name fin) + fin)) + +(clos:defmethod clos-internals:arglist-object ((fin pcl-funcallable-instance)) + (declare (special *boot-state*)) + (if (and (eq *boot-state* 'complete) + (generic-function-p fin)) + (generic-function-pretty-arglist fin) + '(&rest args))) + +);end of #+Genera + + + +#+Cloe-Runtime +(progn + +(defconstant funcallable-instance-closure-slots 5) +(defconstant funcallable-instance-closure-size + (+ funcallable-instance-closure-slots (length funcallable-instance-data) 1)) + +#-CLOE-Release-2 (progn + +(defun allocate-funcallable-instance-1 () + (let ((data (system::make-funcallable-structure 'funcallable-instance + funcallable-instance-closure-size))) + (setf (system::%trampoline-ref data funcallable-instance-closure-slots) + 'funcallable-instance) + (set-funcallable-instance-function + data + #'(lambda (&rest ignore-them-too) + (declare (ignore ignore-them-too)) + (called-fin-without-function))) + data)) + +(proclaim '(inline funcallable-instance-p)) +(defun funcallable-instance-p (x) + (and (typep x 'system::trampoline) + (= (system::%trampoline-data-length x) funcallable-instance-closure-size) + (eq (system::%trampoline-ref x funcallable-instance-closure-slots) + 'funcallable-instance))) + +(defun set-funcallable-instance-function (fin new-value) + (when (not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance" fin)) + (etypecase new-value + (system::trampoline + (let ((length (system::%trampoline-data-length new-value))) + (cond ((> length funcallable-instance-closure-slots) + (set-funcallable-instance-function + fin + #'(lambda (&rest args) + (declare (sys:downward-rest-argument)) + (apply new-value args)))) + (t + (setf (system::%trampoline-function fin) + (system::%trampoline-function new-value)) + (dotimes (i length) + (setf (system::%trampoline-ref fin i) + (system::%trampoline-ref new-value i))))))) + (compiled-function + (setf (system::%trampoline-function fin) new-value)) + (function + (set-funcallable-instance-function + fin + #'(lambda (&rest args) + (declare (sys:downward-rest-argument)) + (apply new-value args)))))) + +(defmacro funcallable-instance-data-1 (fin data) + `(system::%trampoline-ref ,fin (+ funcallable-instance-closure-slots + 1 (funcallable-instance-data-position ,data)))) + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(setf (system::%trampoline-ref ,fin (+ funcallable-instance-closure-slots + 1 (funcallable-instance-data-position ,data))) + ,new-value)) + +) + +#+CLOE-Release-2 (progn + +(defun allocate-funcallable-instance-1 () + (let ((data (si::cons-closure funcallable-instance-closure-size))) + (setf (si::closure-ref data funcallable-instance-closure-slots) 'funcallable-instance) + (set-funcallable-instance-function + data + #'(lambda (&rest ignore-them-too) + (declare (ignore ignore-them-too)) + (error "Called a FIN without first setting its function."))) + data)) + +(proclaim '(inline funcallable-instance-p)) +(defun funcallable-instance-p (x) + (and (si::closurep x) + (= (si::closure-length x) funcallable-instance-closure-size) + (eq (si::closure-ref x funcallable-instance-closure-slots) 'funcallable-instance))) + +(defun set-funcallable-instance-function (fin new-value) + (when (not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance" fin)) + (etypecase new-value + (si::closure + (let ((length (si::closure-length new-value))) + (cond ((> length funcallable-instance-closure-slots) + (set-funcallable-instance-function + fin + #'(lambda (&rest args) + (declare (sys:downward-rest-argument)) + (apply new-value args)))) + (t + (setf (si::closure-function fin) (si::closure-function new-value)) + (dotimes (i length) + (si::object-set fin (+ i 3) (si::object-ref new-value (+ i 3)))))))) + (compiled-function + (setf (si::closure-function fin) new-value)) + (function + (set-funcallable-instance-function + fin + #'(lambda (&rest args) + (declare (sys:downward-rest-argument)) + (apply new-value args)))))) + +(defmacro funcallable-instance-data-1 (fin data) + `(si::closure-ref ,fin (+ funcallable-instance-closure-slots + 1 (funcallable-instance-data-position ,data)))) + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(setf (si::closure-ref ,fin (+ funcallable-instance-closure-slots + 1 (funcallable-instance-data-position ,data))) + ,new-value)) + +) + +) + + +;;; +;;; +;;; In Xerox Common Lisp, a lexical closure is a pair of an environment and +;;; CCODEP. The environment is represented as a block. There is space in +;;; the top 8 bits of the pointers to the CCODE and the environment to use +;;; to mark the closure as being a FIN. +;;; +;;; To help the debugger figure out when it has found a FIN on the stack, we +;;; reserve the last element of the closure environment to use to point back +;;; to the actual fin. +;;; +;;; Note that there is code in xerox-low which lets us access the fields of +;;; compiled-closures and which defines the closure-overlay record. That +;;; code is there because there are some clients of it in that file. +;;; +#+Xerox +(progn + +;; Don't be fooled. We actually allocate one bigger than this to have a place +;; to store the backpointer to the fin. -smL +(defconstant funcallable-instance-closure-size 15) + +;; This is only used in the file PCL-ENV. +(defvar *fin-env-type* + (type-of (il:\\allocblock (1+ funcallable-instance-closure-size) t))) + +;; Well, Gregor may be too proud to hack xpointers, but bvm and I aren't. -smL + +(defstruct fin-env-pointer + (pointer nil :type il:fullxpointer)) + +(defun fin-env-fin (fin-env) + (fin-env-pointer-pointer + (il:\\getbaseptr fin-env (* funcallable-instance-closure-size 2)))) + +(defun |set fin-env-fin| (fin-env new-value) + (il:\\rplptr fin-env (* funcallable-instance-closure-size 2) + (make-fin-env-pointer :pointer new-value)) + new-value) + +(defsetf fin-env-fin |set fin-env-fin|) + +;; The finalization function that will clean up the backpointer from the +;; fin-env to the fin. This needs to be careful to not cons at all. This +;; depends on there being no other finalization function on compiled-closures, +;; since there is only one finalization function per datatype. Too bad. -smL +(defun finalize-fin (fin) + ;; This could use the fn funcallable-instance-p, but if we get here we know + ;; that this is a closure, so we can skip that test. + (when (il:fetch (closure-overlay funcallable-instance-p) il:of fin) + (let ((env (il:fetch (il:compiled-closure il:environment) il:of fin))) + (when env + (setq env + (il:\\getbaseptr env (* funcallable-instance-closure-size 2))) + (when (il:typep env 'fin-env-pointer) + (setf (fin-env-pointer-pointer env) nil))))) + nil) ;Return NIL so GC can proceed + +(eval-when (load) + ;; Install the above finalization function. + (when (fboundp 'finalize-fin) + (il:\\set.finalization.function 'il:compiled-closure 'finalize-fin))) + +(defun allocate-funcallable-instance-1 () + (let* ((env (il:\\allocblock (1+ funcallable-instance-closure-size) t)) + (fin (il:make-compiled-closure nil env))) + (setf (fin-env-fin env) fin) + (il:replace (closure-overlay funcallable-instance-p) il:of fin il:with 't) + (set-funcallable-instance-function fin + #'(lambda (&rest ignore) + (declare (ignore ignore)) + (called-fin-without-function))) + fin)) + +(xcl:definline funcallable-instance-p (x) + (and (typep x 'il:compiled-closure) + (il:fetch (closure-overlay funcallable-instance-p) il:of x))) + +(defun set-funcallable-instance-function (fin new) + (cond ((not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance" fin)) + ((not (functionp new)) + (error "~S is not a function." new)) + ((typep new 'il:compiled-closure) + (let* ((fin-env + (il:fetch (il:compiled-closure il:environment) il:of fin)) + (new-env + (il:fetch (il:compiled-closure il:environment) il:of new)) + (new-env-size (if new-env (il:\\#blockdatacells new-env) 0)) + (fin-env-size (- funcallable-instance-closure-size + (length funcallable-instance-data)))) + (cond ((and new-env + (<= new-env-size fin-env-size)) + (dotimes (i fin-env-size) + (il:\\rplptr fin-env + (* i 2) + (if (< i new-env-size) + (il:\\getbaseptr new-env (* i 2)) + nil))) + (setf (compiled-closure-fnheader fin) + (compiled-closure-fnheader new))) + (t + (set-funcallable-instance-function + fin + (make-trampoline new)))))) + (t + (set-funcallable-instance-function fin + (make-trampoline new))))) + +(defun make-trampoline (function) + #'(lambda (&rest args) + (apply function args))) + + +(defmacro funcallable-instance-data-1 (fin data) + `(il:\\getbaseptr (il:fetch (il:compiled-closure il:environment) il:of ,fin) + (* (- funcallable-instance-closure-size + (funcallable-instance-data-position ,data) + 1) ;Reserve last element to + ;point back to actual FIN! + 2))) + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(il:\\rplptr (il:fetch (il:compiled-closure il:environment) il:of ,fin) + (* (- funcallable-instance-closure-size + (funcallable-instance-data-position ,data) + 1) + 2) + ,new-value)) + +);end of #+Xerox + + +;;; +;;; In Franz Common Lisp ExCL +;;; This code was originally written by: +;;; jkf%franz.uucp@berkeley.edu +;;; and hacked by: +;;; smh%franz.uucp@berkeley.edu + +#+ExCL +(progn + +(defconstant funcallable-instance-flag-bit #x1) + +(defun funcallable-instance-p (x) + (and (excl::function-object-p x) + (eq funcallable-instance-flag-bit + (logand (excl::fn_flags x) + funcallable-instance-flag-bit)))) + +(defun make-trampoline (function) + #'(lambda (&rest args) + (apply function args))) + +;; We initialize a fin's procedure function to this because +;; someone might try to funcall it before it has been set up. +(defun init-fin-fun (&rest ignore) + (declare (ignore ignore)) + (called-fin-without-function)) + + +(eval-when (eval) + (compile 'make-trampoline) + (compile 'init-fin-fun)) + + +;; new style +#+(and gsgc (not sun4) (not cray) (not mips)) +(progn +;; set-funcallable-instance-function must work by overwriting the fin itself +;; because the fin must maintain EQ identity. +;; Because the gsgc time needs several of the fields in the function object +;; at gc time in order to walk the stack frame, it is important never to bash +;; a function object that is active in a frame on the stack. Besides, changing +;; the functions closure vector, not to mention overwriting its constant +;; vector, would scramble it's execution when that stack frame continues. +;; Therefore we represent a fin as a funny compiled-function object. +;; The code vector of this object has some hand-coded instructions which +;; do a very fast jump into the real fin handler function. The function +;; which is the fin object *never* creates a frame on the stack. + + +(defun allocate-funcallable-instance-1 () + (let ((fin (compiler::.primcall 'sys::new-function)) + (init #'init-fin-fun) + (mattress-fun #'funcallable-instance-mattress-pad)) + (setf (excl::fn_symdef fin) 'anonymous-fin) + (setf (excl::fn_constant fin) init) + (setf (excl::fn_code fin) ; this must be before fn_start + (excl::fn_code mattress-fun)) + (setf (excl::fn_start fin) (excl::fn_start mattress-fun)) + (setf (excl::fn_flags fin) (logior (excl::fn_flags init) + funcallable-instance-flag-bit)) + (setf (excl::fn_closure fin) + (make-array (length funcallable-instance-data))) + + fin)) + +;; This function gets its code vector modified with a hand-coded fast jump +;; to the function that is stored in place of its constant vector. +;; This function is never linked in and never appears on the stack. + +(defun funcallable-instance-mattress-pad () + (declare (optimize (speed 3) (safety 0))) + 'nil) + +(eval-when (eval) + (compile 'funcallable-instance-mattress-pad)) + + +#+(and excl (target-class s)) +(eval-when (load eval) + (let ((codevec (excl::fn_code + (symbol-function 'funcallable-instance-mattress-pad)))) + ;; The entire code vector wants to be: + ;; move.l 7(a2),a2 ;#x246a0007 + ;; jmp 1(a2) ;#x4eea0001 + (setf (aref codevec 0) #x246a + (aref codevec 1) #x0007 + (aref codevec 2) #x4eea + (aref codevec 3) #x0001)) +) + +#+(and excl (target-class a)) +(eval-when (load eval) + (let ((codevec (excl::fn_code + (symbol-function 'funcallable-instance-mattress-pad)))) + ;; The entire code vector wants to be: + ;; l r5,15(r5) ;#x5850500f + ;; l r15,11(r5) ;#x58f0500b + ;; br r15 ;#x07ff + (setf (aref codevec 0) #x5850 + (aref codevec 1) #x500f + (aref codevec 2) #x58f0 + (aref codevec 3) #x500b + (aref codevec 4) #x07ff + (aref codevec 5) #x0000)) + ) + +#+(and excl (target-class i)) +(eval-when (load eval) + (let ((codevec (excl::fn_code + (symbol-function 'funcallable-instance-mattress-pad)))) + ;; The entire code vector wants to be: + ;; movl 7(edx),edx ;#x07528b + ;; jmp *3(edx) ;#x0362ff + (setf (aref codevec 0) #x8b + (aref codevec 1) #x52 + (aref codevec 2) #x07 + (aref codevec 3) #xff + (aref codevec 4) #x62 + (aref codevec 5) #x03)) +) + +(defun funcallable-instance-data-1 (instance data) + (let ((constant (excl::fn_closure instance))) + (svref constant (funcallable-instance-data-position data)))) + +(defsetf funcallable-instance-data-1 set-funcallable-instance-data-1) + +(defun set-funcallable-instance-data-1 (instance data new-value) + (let ((constant (excl::fn_closure instance))) + (setf (svref constant (funcallable-instance-data-position data)) + new-value))) + +(defun set-funcallable-instance-function (fin new-function) + (unless (funcallable-instance-p fin) + (error "~S is not a funcallable-instance" fin)) + (unless (functionp new-function) + (error "~S is not a function." new-function)) + (setf (excl::fn_constant fin) + (if (excl::function-object-p new-function) + new-function + ;; The new-function is an interpreted function. + ;; Install a trampoline to call the interpreted function. + (make-trampoline new-function)))) + + +) ;; end sun3 + + +#+(and gsgc (or sun4 mips)) +(progn + +(eval-when (compile load eval) + (defconstant funcallable-instance-constant-count 15) + ) + +(defun allocate-funcallable-instance-1 () + (let ((new-fin (compiler::.primcall + 'sys::new-function + funcallable-instance-constant-count))) + ;; Have to set the procedure function to something for two reasons. + ;; 1. someone might try to funcall it. + ;; 2. the flag bit that says the procedure is a funcallable + ;; instance is set by set-funcallable-instance-function. + (set-funcallable-instance-function new-fin #'init-fin-fun) + new-fin)) + +(defun set-funcallable-instance-function (fin new-value) + ;; we actually only check for a function object since + ;; this is called before the funcallable instance flag is set + (unless (excl::function-object-p fin) + (error "~S is not a funcallable-instance" fin)) + + (cond ((not (functionp new-value)) + (error "~S is not a function." new-value)) + ((not (excl::function-object-p new-value)) + ;; new-value is an interpreted function. Install a + ;; trampoline to call the interpreted function. + (set-funcallable-instance-function fin (make-trampoline new-value))) + ((> (+ (excl::function-constant-count new-value) + (length funcallable-instance-data)) + funcallable-instance-constant-count) + ; can't fit, must trampoline + (set-funcallable-instance-function fin (make-trampoline new-value))) + (t + ;; tack the instance variables at the end of the constant vector + + (setf (excl::fn_code fin) ; this must be before fn_start + (excl::fn_code new-value)) + (setf (excl::fn_start fin) (excl::fn_start new-value)) + + (setf (excl::fn_closure fin) (excl::fn_closure new-value)) + ; only replace the symdef slot if the new value is an + ; interned symbol or some other object (like a function spec) + (let ((newsym (excl::fn_symdef new-value))) + (excl:if* (and newsym (or (not (symbolp newsym)) + (symbol-package newsym))) + then (setf (excl::fn_symdef fin) newsym))) + (setf (excl::fn_formals fin) (excl::fn_formals new-value)) + (setf (excl::fn_cframe-size fin) (excl::fn_cframe-size new-value)) + (setf (excl::fn_locals fin) (excl::fn_locals new-value)) + (setf (excl::fn_flags fin) (logior (excl::fn_flags new-value) + funcallable-instance-flag-bit)) + + ;; on a sun4 we copy over the constants + (dotimes (i (excl::function-constant-count new-value)) + (setf (excl::function-constant fin i) + (excl::function-constant new-value i))) + ;(format t "all done copy from ~s to ~s" new-value fin) + ))) + +(defmacro funcallable-instance-data-1 (instance data) + `(excl::function-constant ,instance + (- funcallable-instance-constant-count + (funcallable-instance-data-position ,data) + 1))) + +) ;; end sun4 or mips + +#+(and gsgc cray) +(progn + +;; The cray is like the sun4 in that the constant vector is included in the +;; function object itself. But a mattress pad must be used anyway, because +;; the function start address is copied in the symbol object, and cannot be +;; updated when the fin is changed. +;; We place the funcallable-instance-function into the first constant slot, +;; and leave enough constant slots after that for the instance data. + +(eval-when (compile load eval) + (defconstant fin-fun-slot 0) + (defconstant fin-instance-data-slot 1) + ) + + +;; We initialize a fin's procedure function to this because +;; someone might try to funcall it before it has been set up. +(defun init-fin-fun (&rest ignore) + (declare (ignore ignore)) + (called-fin-without-function)) + +(defun allocate-funcallable-instance-1 () + (let ((fin (compiler::.primcall 'sys::new-function + (1+ (length funcallable-instance-data)) + "funcallable-instance")) + (init #'init-fin-fun) + (mattress-fun #'funcallable-instance-mattress-pad)) + (setf (excl::fn_symdef fin) 'anonymous-fin) + (setf (excl::function-constant fin fin-fun-slot) init) + (setf (excl::fn_code fin) ; this must be before fn_start + (excl::fn_code mattress-fun)) + (setf (excl::fn_start fin) (excl::fn_start mattress-fun)) + (setf (excl::fn_flags fin) (logior (excl::fn_flags init) + funcallable-instance-flag-bit)) + + fin)) + +;; This function gets its code vector modified with a hand-coded fast jump +;; to the function that is stored in place of its constant vector. +;; This function is never linked in and never appears on the stack. + +(defun funcallable-instance-mattress-pad () + (declare (optimize (speed 3) (safety 0))) + 'nil) + +(eval-when (eval) + (compile 'funcallable-instance-mattress-pad) + (compile 'init-fin-fun)) + +(eval-when (load eval) + (let ((codevec (excl::fn_code + (symbol-function 'funcallable-instance-mattress-pad)))) + ;; The entire code vector wants to be: + ;; a1 b77 + ;; a2 12,a1 + ;; a1 1,a2 + ;; b77 a2 + ;; b76 a1 + ;; j b76 + (setf (aref codevec 0) #o024177 + (aref codevec 1) #o101200 (aref codevec 2) 12 + (aref codevec 3) #o102100 (aref codevec 4) 1 + (aref codevec 5) #o025277 + (aref codevec 6) #o025176 + (aref codevec 7) #o005076 + )) +) + +(defmacro funcallable-instance-data-1 (instance data) + `(excl::function-constant ,instance + (+ (funcallable-instance-data-position ,data) + fin-instance-dtat-slot))) + + +(defun set-funcallable-instance-function (fin new-function) + (unless (funcallable-instance-p fin) + (error "~S is not a funcallable-instance" fin)) + (unless (functionp new-function) + (error "~S is not a function." new-function)) + (setf (excl::function-constant fin fin-fun-slot) + (if (excl::function-object-p new-function) + new-function + ;; The new-function is an interpreted function. + ;; Install a trampoline to call the interpreted function. + (make-trampoline new-function)))) + +) ;; end cray + +#-gsgc +(progn + +(defun allocate-funcallable-instance-1 () + (let ((new-fin (compiler::.primcall 'sys::new-function))) + ;; Have to set the procedure function to something for two reasons. + ;; 1. someone might try to funcall it. + ;; 2. the flag bit that says the procedure is a funcallable + ;; instance is set by set-funcallable-instance-function. + (set-funcallable-instance-function new-fin #'init-fin-fn) + new-fin)) + +(defun set-funcallable-instance-function (fin new-value) + ;; we actually only check for a function object since + ;; this is called before the funcallable instance flag is set + (unless (excl::function-object-p fin) + (error "~S is not a funcallable-instance" fin)) + (cond ((not (functionp new-value)) + (error "~S is not a function." new-value)) + ((not (excl::function-object-p new-value)) + ;; new-value is an interpreted function. Install a + ;; trampoline to call the interpreted function. + (set-funcallable-instance-function fin (make-trampoline new-value))) + (t + ;; tack the instance variables at the end of the constant vector + (setf (excl::fn_start fin) (excl::fn_start new-value)) + (setf (excl::fn_constant fin) (add-instance-vars + (excl::fn_constant new-value) + (excl::fn_constant fin))) + (setf (excl::fn_closure fin) (excl::fn_closure new-value)) + ;; In versions prior to 2.0. comment the next line and any other + ;; references to fn_symdef or fn_locals. + (setf (excl::fn_symdef fin) (excl::fn_symdef new-value)) + (setf (excl::fn_code fin) (excl::fn_code new-value)) + (setf (excl::fn_formals fin) (excl::fn_formals new-value)) + (setf (excl::fn_cframe-size fin) (excl::fn_cframe-size new-value)) + (setf (excl::fn_locals fin) (excl::fn_locals new-value)) + (setf (excl::fn_flags fin) (logior (excl::fn_flags new-value) + funcallable-instance-flag-bit))))) + +(defun add-instance-vars (cvec old-cvec) + ;; create a constant vector containing everything in the given constant + ;; vector plus space for the instance variables + (let* ((nconstants (cond (cvec (length cvec)) (t 0))) + (ndata (length funcallable-instance-data)) + (old-cvec-length (if old-cvec (length old-cvec) 0)) + (new-cvec nil)) + (cond ((<= (+ nconstants ndata) old-cvec-length) + (setq new-cvec old-cvec)) + (t + (setq new-cvec (make-array (+ nconstants ndata))) + (when old-cvec + (dotimes (i ndata) + (setf (svref new-cvec (- (+ nconstants ndata) i 1)) + (svref old-cvec (- old-cvec-length i 1))))))) + + (dotimes (i nconstants) (setf (svref new-cvec i) (svref cvec i))) + + new-cvec)) + +(defun funcallable-instance-data-1 (instance data) + (let ((constant (excl::fn_constant instance))) + (svref constant (- (length constant) + (1+ (funcallable-instance-data-position data)))))) + +(defsetf funcallable-instance-data-1 set-funcallable-instance-data-1) + +(defun set-funcallable-instance-data-1 (instance data new-value) + (let ((constant (excl::fn_constant instance))) + (setf (svref constant (- (length constant) + (1+ (funcallable-instance-data-position data)))) + new-value))) + +);end #-gsgc + +);end of #+ExCL + + +;;; +;;; In Vaxlisp +;;; This code was originally written by: +;;; vanroggen%bach.DEC@DECWRL.DEC.COM +;;; +#+(and dec vax common) +(progn + +;;; The following works only in Version 2 of VAXLISP, and will have to +;;; be replaced for later versions. + +(defun allocate-funcallable-instance-1 () + (list 'system::%compiled-closure% + () + #'(lambda (&rest args) + (declare (ignore args)) + (called-fin-without-function)) + (make-array (length funcallable-instance-data)))) + +(proclaim '(inline funcallable-instance-p)) +(defun funcallable-instance-p (x) + (and (consp x) + (eq (car x) 'system::%compiled-closure%) + (not (null (cdddr x))))) + +(defun set-funcallable-instance-function (fin func) + (cond ((not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance" fin)) + ((not (functionp func)) + (error "~S is not a function" func)) + ((and (consp func) (eq (car func) 'system::%compiled-closure%)) + (setf (cadr fin) (cadr func) + (caddr fin) (caddr func))) + (t (set-funcallable-instance-function fin + (make-trampoline func))))) + +(defun make-trampoline (function) + #'(lambda (&rest args) + (apply function args))) + +(eval-when (eval) (compile 'make-trampoline)) + +(defmacro funcallable-instance-data-1 (instance data) + `(svref (cadddr ,instance) + (funcallable-instance-data-position ,data))) + +);end of Vaxlisp (and dec vax common) + + +;;;; Implementation of funcallable instances for CMU Common Lisp: +;;; +#+CMU +;;; Note: returns true for non-pcl funcallable structures. +(import 'kernel:funcallable-instance-p) + +#+CMU +(progn + +(defstruct (pcl-funcallable-instance + (:alternate-metaclass kernel:funcallable-instance + kernel:random-pcl-class + kernel:make-random-pcl-class) + (:type kernel:funcallable-structure) + (:constructor allocate-funcallable-instance-1 ()) + (:conc-name nil)) + ;; + ;; PCL wrapper is in the layout slot. + ;; + ;; PCL data vector. + (pcl-funcallable-instance-slots nil) + ;; + ;; The debug-name for this function. + (funcallable-instance-name nil)) + +;;; SET-FUNCALLABLE-INSTANCE-FUNCTION -- Interface +;;; +;;; Set the function that is called when FIN is called. +;;; +(defun set-funcallable-instance-function (fin new-value) + (declare (type function new-value)) + (assert (funcallable-instance-p fin)) + (setf (kernel:funcallable-instance-function fin) new-value)) + + +;;; FUNCALLABLE-INSTANCE-DATA-1 -- Interface +;;; +;;; This "works" on non-PCL FINs, which allows us to weaken +;;; FUNCALLABLE-INSTANCE-P to return trure for all FINs. This is also +;;; necessary for bootstrapping to work, since the layouts for early GFs are +;;; not initially initialized. +;;; +(defmacro funcallable-instance-data-1 (fin slot) + (ecase (eval slot) + (wrapper `(kernel:%funcallable-instance-layout ,fin)) + (slots `(kernel:%funcallable-instance-info ,fin 0)))) + +(defmacro pcl-funcallable-instance-wrapper (x) + `(kernel:%funcallable-instance-layout ,x)) + +); End of #+cmu progn + + +;;; +;;; Kyoto Common Lisp (KCL) +;;; +;;; In KCL, compiled functions and compiled closures are defined as c structs. +;;; This means that in order to access their fields, we have to use C code! +;;; The C code we call and the lisp interface to it is in the file kcl-low. +;;; The lisp interface to this code implements accessors to compiled closures +;;; and compiled functions of about the same level of abstraction as that +;;; which is used by the other implementation dependent versions of FINs in +;;; this file. +;;; + +#+(and KCL (not IBCL)) +(progn + +(defvar *funcallable-instance-marker* (list "Funcallable Instance Marker")) + +(defconstant funcallable-instance-closure-size 15) + +(defconstant funcallable-instance-closure-size1 + (1- funcallable-instance-closure-size)) + +(defconstant funcallable-instance-available-size + (- funcallable-instance-closure-size1 + (length funcallable-instance-data))) + +(defmacro funcallable-instance-marker (x) + `(car (cclosure-env-nthcdr funcallable-instance-closure-size1 ,x))) + +(defun allocate-funcallable-instance-1 () + (let ((fin (allocate-funcallable-instance-2)) + (env (make-list funcallable-instance-closure-size :initial-element nil))) + (setf (%cclosure-env fin) env) + #+:turbo-closure (si:turbo-closure fin) + (setf (funcallable-instance-marker fin) *funcallable-instance-marker*) + fin)) + +(defun allocate-funcallable-instance-2 () + (let ((what-a-dumb-closure-variable ())) + #'(lambda (&rest args) + (declare (ignore args)) + (called-fin-without-function) + (setq what-a-dumb-closure-variable + (dummy-function what-a-dumb-closure-variable))))) + +(defun funcallable-instance-p (x) + (eq *funcallable-instance-marker* (funcallable-instance-marker x))) + +(si:define-compiler-macro funcallable-instance-p (x) + `(eq *funcallable-instance-marker* (funcallable-instance-marker ,x))) + +(defun set-funcallable-instance-function (fin new-value) + (cond ((not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance" fin)) + ((not (functionp new-value)) + (error "~S is not a function." new-value)) + ((and (cclosurep new-value) + (<= (length (%cclosure-env new-value)) + funcallable-instance-available-size)) + (%set-cclosure fin new-value funcallable-instance-available-size)) + (t + (set-funcallable-instance-function + fin (make-trampoline new-value)))) + fin) + +(defmacro funcallable-instance-data-1 (fin data &environment env) + ;; The compiler won't expand macros before deciding on optimizations, + ;; so we must do it here. + (let* ((pos-form (macroexpand `(funcallable-instance-data-position ,data) + env)) + (index-form (if (constantp pos-form) + (- funcallable-instance-closure-size + (eval pos-form) + 2) + `(- funcallable-instance-closure-size + (funcallable-instance-data-position ,data) + 2)))) + `(car (%cclosure-env-nthcdr ,index-form ,fin)))) + + +#+turbo-closure (clines "#define TURBO_CLOSURE") + +(clines " +static void make_trampoline_internal(); +static void make_turbo_trampoline_internal(); + +static object +make_trampoline(function) + object function; +{ + vs_push(MMcons(function,Cnil)); +#ifdef TURBO_CLOSURE + if(type_of(function)==t_cclosure) + {if(function->cc.cc_turbo==NULL)turbo_closure(function); + vs_head=make_cclosure(make_turbo_trampoline_internal,Cnil,vs_head,Cnil,NULL,0); + return vs_pop;} +#endif + vs_head=make_cclosure(make_trampoline_internal,Cnil,vs_head,Cnil,NULL,0); + return vs_pop; +} + +static void +make_trampoline_internal(fun) + object fun; +{super_funcall_no_event(fun->cc.cc_turbo[0]->c.c_car);} + +static void +make_turbo_trampoline_internal(fun) + object fun; +{ object function=fun->cc.cc_turbo[0]->c.c_car; + (*function->cc.cc_self)(function); +} + +") + +(defentry make-trampoline (object) (compiler::static object make_trampoline)) +) + +#+IBCL +(progn ; From Rainy Day PCL. + +(defvar *funcallable-instance-marker* (list "Funcallable Instance Marker")) + +(defconstant funcallable-instance-closure-size 15) + +(defun allocate-funcallable-instance-1 () + (let ((fin (allocate-funcallable-instance-2)) + (env + (make-list funcallable-instance-closure-size :initial-element nil))) + (set-cclosure-env fin env) + #+:turbo-closure (si:turbo-closure fin) + (dotimes (i (1- funcallable-instance-closure-size)) (pop env)) + (setf (car env) *funcallable-instance-marker*) + fin)) + +(defun allocate-funcallable-instance-2 () + (let ((what-a-dumb-closure-variable ())) + #'(lambda (&rest args) + (declare (ignore args)) + (called-fin-without-function) + (setq what-a-dumb-closure-variable + (dummy-function what-a-dumb-closure-variable))))) + +(defun funcallable-instance-p (x) + (and (cclosurep x) + (let ((env (cclosure-env x))) + (when (listp env) + (dotimes (i (1- funcallable-instance-closure-size)) (pop env)) + (eq (car env) *funcallable-instance-marker*))))) + +(defun set-funcallable-instance-function (fin new-value) + (cond ((not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance" fin)) + ((not (functionp new-value)) + (error "~S is not a function." new-value)) + ((cclosurep new-value) + (let* ((fin-env (cclosure-env fin)) + (new-env (cclosure-env new-value)) + (new-env-size (length new-env)) + (fin-env-size (- funcallable-instance-closure-size + (length funcallable-instance-data) + 1))) + (cond ((<= new-env-size fin-env-size) + (do ((i 0 (+ i 1)) + (new-env-tail new-env (cdr new-env-tail)) + (fin-env-tail fin-env (cdr fin-env-tail))) + ((= i fin-env-size)) + (setf (car fin-env-tail) + (if (< i new-env-size) + (car new-env-tail) + nil))) + (set-cclosure-self fin (cclosure-self new-value)) + (set-cclosure-data fin (cclosure-data new-value)) + (set-cclosure-start fin (cclosure-start new-value)) + (set-cclosure-size fin (cclosure-size new-value))) + (t + (set-funcallable-instance-function + fin + (make-trampoline new-value)))))) + ((typep new-value 'compiled-function) + ;; Write NILs into the part of the cclosure environment that is + ;; not being used to store the funcallable-instance-data. Then + ;; copy over the parts of the compiled function that need to be + ;; copied over. + (let ((env (cclosure-env fin))) + (dotimes (i (- funcallable-instance-closure-size + (length funcallable-instance-data) + 1)) + (setf (car env) nil) + (pop env))) + (set-cclosure-self fin (cfun-self new-value)) + (set-cclosure-data fin (cfun-data new-value)) + (set-cclosure-start fin (cfun-start new-value)) + (set-cclosure-size fin (cfun-size new-value))) + (t + (set-funcallable-instance-function fin + (make-trampoline new-value)))) + fin) + + +(defun make-trampoline (function) + #'(lambda (&rest args) + (apply function args))) + +;; this replaces funcallable-instance-data-1, set-funcallable-instance-data-1 +;; and the defsetf +(defmacro funcallable-instance-data-1 (fin data &environment env) + ;; The compiler won't expand macros before deciding on optimizations, + ;; so we must do it here. + (let* ((pos-form (macroexpand `(funcallable-instance-data-position ,data) + env)) + (index-form (if (constantp pos-form) + (- funcallable-instance-closure-size + (eval pos-form) + 2) + `(- funcallable-instance-closure-size + (funcallable-instance-data-position ,data) + 2)))) + #+:turbo-closure `(car (tc-cclosure-env-nthcdr ,index-form ,fin)) + #-:turbo-closure `(nth ,index-form (cclosure-env ,fin)))) + +) + + +;;; +;;; In H.P. Common Lisp +;;; This code was originally written by: +;;; kempf@hplabs.hp.com (James Kempf) +;;; dsouza@hplabs.hp.com (Roy D'Souza) +;;; +#+HP-HPLabs +(progn + +(defmacro fin-closure-size ()`(prim::@* 6 prim::bytes-per-word)) + +(defmacro fin-set-mem-hword () + `(prim::@set-mem-hword + (prim::@+ fin (prim::@<< 2 1)) + (prim::@+ (prim::@<< 2 8) + (prim::@fundef-info-parms (prim::@fundef-info fundef))))) + +(defun allocate-funcallable-instance-1() + (let* ((fundef + #'(lambda (&rest ignore) + (declare (ignore ignore)) + (called-fin-without-function))) + (static-link (vector 'lisp::*undefined* NIL NIL NIL NIL NIL)) + (fin (prim::@make-fundef (fin-closure-size)))) + (fin-set-mem-hword) + (prim::@set-svref fin 2 fundef) + (prim::@set-svref fin 3 static-link) + (prim::@set-svref fin 4 0) + (impl::PlantclosureHook fin) + fin)) + +(defmacro funcallable-instance-p (possible-fin) + `(= (fin-closure-size) (prim::@header-inf ,possible-fin))) + +(defun set-funcallable-instance-function (fin new-function) + (cond ((not (funcallable-instance-p fin)) + (error "~S is not a funcallable instance.~%" fin)) + ((not (functionp new-function)) + (error "~S is not a function." new-function)) + (T + (prim::@set-svref fin 2 new-function)))) + +(defmacro funcallable-instance-data-1 (fin data) + `(prim::@svref (prim::@closure-static-link ,fin) + (+ 2 (funcallable-instance-data-position ,data)))) + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(prim::@set-svref (prim::@closure-static-link ,fin) + (+ (funcallable-instance-data-position ,data) 2) + ,new-value)) + +(defun funcallable-instance-name (fin) + (prim::@svref (prim::@closure-static-link fin) 1)) + +(defsetf funcallable-instance-name set-funcallable-instance-name) + +(defun set-funcallable-instance-name (fin new-name) + (prim::@set-svref (prim::@closure-static-link fin) 1 new-name)) + +);end #+HP + + + +;;; +;;; In Golden Common Lisp. +;;; This code was originally written by: +;;; dan%acorn@Live-Oak.LCS.MIT.edu (Dan Jacobs) +;;; +;;; GCLISP supports named structures that are specially marked as funcallable. +;;; This allows FUNCALLABLE-INSTANCE-P to be a normal structure predicate, +;;; and allows ALLOCATE-FUNCALLABLE-INSTANCE-1 to be a normal boa-constructor. +;;; +#+GCLISP +(progn + +(defstruct (%funcallable-instance + (:predicate funcallable-instance-p) + (:copier nil) + (:constructor allocate-funcallable-instance-1 ()) + (:print-function + (lambda (struct stream depth) + (declare (ignore depth)) + (print-object struct stream)))) + (function #'(lambda (ignore-this &rest ignore-these-too) + (declare (ignore ignore-this ignore-these-too)) + (called-fin-without-function)) + :type function) + (%hidden% 'gclisp::funcallable :read-only t) + (data (vector nil nil) :type simple-vector :read-only t)) + +(proclaim '(inline set-funcallable-instance-function)) +(defun set-funcallable-instance-function (fin new-value) + (setf (%funcallable-instance-function fin) new-value)) + +(defmacro funcallable-instance-data-1 (fin data) + `(svref (%funcallable-instance-data ,fin) + (funcallable-instance-data-position ,data))) + +) + + +;;; +;;; Explorer Common Lisp +;;; This code was originally written by: +;;; Dussud%Jenner@csl.ti.com +;;; +#+ti +(progn + +#+(or :ti-release-3 (and :ti-release-2 elroy)) +(defmacro lexical-closure-environment (l) + `(cdr (si:%make-pointer si:dtp-list + (cdr (si:%make-pointer si:dtp-list ,l))))) + +#-(or :ti-release-3 elroy) +(defmacro lexical-closure-environment (l) + `(caar (si:%make-pointer si:dtp-list + (cdr (si:%make-pointer si:dtp-list ,l))))) + +(defmacro lexical-closure-function (l) + `(car (si:%make-pointer si:dtp-list ,l))) + + +(defvar *funcallable-instance-marker* (list "Funcallable Instance Marker")) + +(defconstant funcallable-instance-closure-size 15) ; NOTE: In order to avoid + ; hassles with the reader, +(defmacro allocate-funcallable-instance-2 () ; these two 15's are the + (let ((l ())) ; same. Be sure to keep + (dotimes (i 15) ; them consistent. + (push (list (gensym) nil) l)) + `(let ,l + #'(lambda (ignore &rest ignore-them-too) + (declare (ignore ignore ignore-them-too)) + (called-fin-without-function) + (values . ,(mapcar #'car l)))))) + +(defun allocate-funcallable-instance-1 () + (let* ((new-fin (allocate-funcallable-instance-2))) + (setf (car (nthcdr (1- funcallable-instance-closure-size) + (lexical-closure-environment new-fin))) + *funcallable-instance-marker*) + new-fin)) + +(eval-when (eval) (compile 'allocate-funcallable-instance-1)) + +(proclaim '(inline funcallable-instance-p)) +(defun funcallable-instance-p (x) + (and (typep x #+:ti-release-2 'closure + #+:ti-release-3 'si:lexical-closure) + (let ((env (lexical-closure-environment x))) + (eq (nth (1- funcallable-instance-closure-size) env) + *funcallable-instance-marker*)))) + +(defun set-funcallable-instance-function (fin new-value) + (cond ((not (funcallable-instance-p fin)) + (error "~S is not a funcallable-instance")) + ((not (functionp new-value)) + (error "~S is not a function.")) + ((typep new-value 'si:lexical-closure) + (let* ((fin-env (lexical-closure-environment fin)) + (new-env (lexical-closure-environment new-value)) + (new-env-size (length new-env)) + (fin-env-size (- funcallable-instance-closure-size + (length funcallable-instance-data) + 1))) + (cond ((<= new-env-size fin-env-size) + (do ((i 0 (+ i 1)) + (new-env-tail new-env (cdr new-env-tail)) + (fin-env-tail fin-env (cdr fin-env-tail))) + ((= i fin-env-size)) + (setf (car fin-env-tail) + (if (< i new-env-size) + (car new-env-tail) + nil))) + (setf (lexical-closure-function fin) + (lexical-closure-function new-value))) + (t + (set-funcallable-instance-function + fin + (make-trampoline new-value)))))) + (t + (set-funcallable-instance-function fin + (make-trampoline new-value))))) + +(defun make-trampoline (function) + (let ((tmp)) + #'(lambda (&rest args) tmp + (apply function args)))) + +(eval-when (eval) (compile 'make-trampoline)) + +(defmacro funcallable-instance-data-1 (fin data) + `(let ((env (lexical-closure-environment ,fin))) + (nth (- funcallable-instance-closure-size + (funcallable-instance-data-position ,data) + 2) + env))) + + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(let ((env (lexical-closure-environment ,fin))) + (setf (car (nthcdr (- funcallable-instance-closure-size + (funcallable-instance-data-position ,data) + 2) + env)) + ,new-value))) + +);end of code for TI + + +;;; Implemented by Bein@pyramid -- Tue Aug 25 19:05:17 1987 +;;; +;;; A FIN is a distinct type of object which FUNCALL,EVAL, and APPLY +;;; recognize as functions. Both Compiled-Function-P and functionp +;;; recognize FINs as first class functions. +;;; +;;; This does not work with PyrLisp versions earlier than 1.1.. + +#+pyramid +(progn + +(defun make-trampoline (function) + #'(lambda (&rest args) (apply function args))) + +(defun un-initialized-fin (&rest trash) + (declare (ignore trash)) + (called-fin-without-function)) + +(eval-when (eval) + (compile 'make-trampoline) + (compile 'un-initialized-fin)) + +(defun allocate-funcallable-instance-1 () + (let ((fin (system::alloc-funcallable-instance))) + (system::set-fin-function fin #'un-initialized-fin) + fin)) + +(defun funcallable-instance-p (object) + (typep object 'lisp::funcallable-instance)) + +(clc::deftransform funcallable-instance-p trans-fin-p (object) + `(typep ,object 'lisp::funcallable-instance)) + +(defun set-funcallable-instance-function (fin new-value) + (or (funcallable-instance-p fin) + (error "~S is not a funcallable-instance." fin)) + (cond ((not (functionp new-value)) + (error "~S is not a function." new-value)) + ((not (lisp::compiled-function-p new-value)) + (set-funcallable-instance-function fin + (make-trampoline new-value))) + (t + (system::set-fin-function fin new-value)))) + +(defun funcallable-instance-data-1 (fin data-name) + (system::get-fin-data fin + (funcallable-instance-data-position data-name))) + +(defun set-funcallable-instance-data-1 (fin data-name value) + (system::set-fin-data fin + (funcallable-instance-data-position data-name) + value)) + +(defsetf funcallable-instance-data-1 set-funcallable-instance-data-1) + +); End of #+pyramid + + +;;; +;;; For Coral Lisp +;;; +#+:coral +(progn + +(defconstant ccl::$v_istruct 22) +(defvar ccl::initial-fin-slots (make-list (length funcallable-instance-data))) +(defconstant ccl::fin-function 1) +(defconstant ccl::fin-data (+ ccl::FIN-function 1)) + +(defun allocate-funcallable-instance-1 () + (apply #'ccl::%gvector + ccl::$v_istruct + 'ccl::funcallable-instance + #'(lambda (&rest ignore) + (declare (ignore ignore)) + (called-fin-without-function)) + ccl::initial-fin-slots)) + +#+:ccl-1.3 +(eval-when (eval compile load) + +;;; Make uvector-based objects (like funcallable instances) print better. +(defun print-uvector-object (obj stream &optional print-level) + (declare (ignore print-level)) + (print-object obj stream)) + +;;; Inform the print system about funcallable instance uvectors. +(pushnew (cons 'ccl::funcallable-instance #'print-uvector-object) + ccl:*write-uvector-alist* + :test #'equal) + +) + +(defun funcallable-instance-p (x) + (and (eq (ccl::%type-of x) 'ccl::internal-structure) + (eq (ccl::%uvref x 0) 'ccl::funcallable-instance))) + +(defun set-funcallable-instance-function (fin new-value) + (unless (funcallable-instance-p fin) + (error "~S is not a funcallable-instance." fin)) + (unless (functionp new-value) + (error "~S is not a function." new-value)) + (ccl::%uvset fin ccl::FIN-function new-value)) + +(defmacro funcallable-instance-data-1 (fin data-name) + `(ccl::%uvref ,fin + (+ (funcallable-instance-data-position ,data-name) + ccl::FIN-data))) + +(defsetf funcallable-instance-data-1 (fin data) (new-value) + `(ccl::%uvset ,fin + (+ (funcallable-instance-data-position ,data) ccl::FIN-data) + ,new-value)) + +); End of #+:coral + + + +;;;; Slightly Higher-Level stuff built on the implementation-dependent stuff. +;;; +;;; + +(defmacro fsc-instance-p (fin) + `(funcallable-instance-p ,fin)) + +(defmacro fsc-instance-class (fin) + `(wrapper-class (funcallable-instance-data-1 ,fin 'wrapper))) + +(defmacro fsc-instance-wrapper (fin) + `(funcallable-instance-data-1 ,fin 'wrapper)) + +(defmacro fsc-instance-slots (fin) + `(funcallable-instance-data-1 ,fin 'slots)) diff --git a/pcl/gcl_pcl_fixup.lisp b/pcl/gcl_pcl_fixup.lisp new file mode 100644 index 0000000..82c4d69 --- /dev/null +++ b/pcl/gcl_pcl_fixup.lisp @@ -0,0 +1,40 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(fix-early-generic-functions) +(setq *boot-state* 'complete) + +#+Lispm +(eval-when (load eval) + (si:record-source-file-name 'print-std-instance 'defun 't)) + +(defun print-std-instance (instance stream depth) + (declare (ignore depth)) + (print-object instance stream)) + diff --git a/pcl/gcl_pcl_fngen.lisp b/pcl/gcl_pcl_fngen.lisp new file mode 100644 index 0000000..61ae0ac --- /dev/null +++ b/pcl/gcl_pcl_fngen.lisp @@ -0,0 +1,214 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +;;; +;;; GET-FUNCTION is the main user interface to this code. It is like +;;; COMPILE-LAMBDA, only more efficient. It achieves this efficiency by +;;; reducing the number of times that the compiler needs to be called. +;;; Calls to GET-FUNCTION in which the lambda forms differ only by constants +;;; can use the same piece of compiled code. (For example, dispatch dfuns and +;;; combined method functions can often be shared, if they differ only +;;; by referring to different methods.) +;;; +;;; If GET-FUNCTION is called with a lambda expression only, it will return +;;; a corresponding function. The optional constant-converter argument +;;; can be a function which will be called to convert each constant appearing +;;; in the lambda to whatever value should appear in the function. +;;; +;;; There are three internal functions which operate on the lambda argument +;;; to GET-FUNCTION: +;;; compute-test converts the lambda into a key to be used for lookup, +;;; compute-code is used by get-new-function-generator-internal to +;;; generate the actual lambda to be compiled, and +;;; compute-constants is used to generate the argument list that is +;;; to be passed to the compiled function. +;;; +;;; Whether the returned function is actually compiled depends on whether +;;; the compiler is present (see COMPILE-LAMBDA) and whether this shape of +;;; code was precompiled. +;;; +(defun get-function (lambda + &optional (test-converter #'default-test-converter) + (code-converter #'default-code-converter) + (constant-converter #'default-constant-converter)) + (function-apply (get-function-generator lambda test-converter code-converter) + (compute-constants lambda constant-converter))) + +(defun get-function1 (lambda + &optional (test-converter #'default-test-converter) + (code-converter #'default-code-converter) + (constant-converter #'default-constant-converter)) + (values (the function (get-function-generator lambda test-converter code-converter)) + (compute-constants lambda constant-converter))) + +(defun default-constantp (form) + (and (constantp form) + (not (typep (eval form) '(or symbol fixnum))))) + +(defun default-test-converter (form) + (if (default-constantp form) + '.constant. + form)) + +(defun default-code-converter (form) + (if (default-constantp form) + (let ((gensym (gensym))) (values gensym (list gensym))) + form)) + +(defun default-constant-converter (form) + (if (default-constantp form) + (list (eval form)) + nil)) + + +;;; +;;; *fgens* is a list of all the function generators we have so far. Each +;;; element is a FGEN structure as implemented below. Don't ever touch this +;;; list by hand, use STORE-FGEN. +;;; +(defvar *fgens* ()) + +(defun store-fgen (fgen) + (let ((old (lookup-fgen (fgen-test fgen)))) + (if old + (setf (svref old 2) (fgen-generator fgen) + (svref old 4) (or (svref old 4) + (fgen-system fgen))) + (setq *fgens* (nconc *fgens* (list fgen)))))) + +(defun lookup-fgen (test) + (find test (the list *fgens*) :key #'fgen-test :test #'equal)) + +(defun make-fgen (test gensyms generator generator-lambda system) + (let ((new (make-array 6))) + (setf (svref new 0) test + (svref new 1) gensyms + (svref new 2) generator + (svref new 3) generator-lambda + (svref new 4) system) + new)) + +(defun fgen-test (fgen) (svref fgen 0)) +(defun fgen-gensyms (fgen) (svref fgen 1)) +(defun fgen-generator (fgen) (svref fgen 2)) +(defun fgen-generator-lambda (fgen) (svref fgen 3)) +(defun fgen-system (fgen) (svref fgen 4)) + + + +(defun get-function-generator (lambda test-converter code-converter) + (let* ((test (compute-test lambda test-converter)) + (fgen (lookup-fgen test))) + (if fgen + (fgen-generator fgen) + (get-new-function-generator lambda test code-converter)))) + +(defun get-new-function-generator (lambda test code-converter) + (multiple-value-bind (gensyms generator-lambda) + (get-new-function-generator-internal lambda code-converter) + (let* ((generator (compile-lambda generator-lambda)) + (fgen (make-fgen test gensyms generator generator-lambda nil))) + (store-fgen fgen) + generator))) + +(defun get-new-function-generator-internal (lambda code-converter) + (multiple-value-bind (code gensyms) + (compute-code lambda code-converter) + (values gensyms `(lambda ,gensyms (function ,code))))) + + +(defun compute-test (lambda test-converter) + (let ((walk-form-expand-macros-p t)) + (walk-form lambda + nil + #'(lambda (f c e) + (declare (ignore e)) + (if (neq c :eval) + f + (let ((converted (funcall test-converter f))) + (values converted (neq converted f)))))))) + +(defun compute-code (lambda code-converter) + (let ((walk-form-expand-macros-p t) + (gensyms ())) + (values (walk-form lambda + nil + #'(lambda (f c e) + (declare (ignore e)) + (if (neq c :eval) + f + (multiple-value-bind (converted gens) + (funcall code-converter f) + (when gens (setq gensyms (append gensyms gens))) + (values converted (neq converted f)))))) + gensyms))) + +(defun compute-constants (lambda constant-converter) + (let ((walk-form-expand-macros-p t)) ; doesn't matter here. + (macrolet ((appending () + `(let ((result ())) + (values #'(lambda (value) (setq result (append result value))) + #'(lambda ()result))))) + (gathering1 (appending) + (walk-form lambda + nil + #'(lambda (f c e) + (declare (ignore e)) + (if (neq c :eval) + f + (let ((consts (funcall constant-converter f))) + (if consts + (progn (gather1 consts) (values f t)) + f))))))))) + + +;;; +;;; +;;; +(defmacro precompile-function-generators (&optional system) + (let ((index -1)) + `(progn ,@(gathering1 (collecting) + (dolist (fgen *fgens*) + (when (or (null (fgen-system fgen)) + (eq (fgen-system fgen) system)) + (when system (setf (svref fgen 4) system)) + (gather1 + (make-top-level-form + `(precompile-function-generators ,system ,(incf index)) + '(load) + `(load-function-generator + ',(fgen-test fgen) + ',(fgen-gensyms fgen) + (function ,(fgen-generator-lambda fgen)) + ',(fgen-generator-lambda fgen) + ',system))))))))) + +(defun load-function-generator (test gensyms generator generator-lambda system) + (store-fgen (make-fgen test gensyms generator generator-lambda system))) + diff --git a/pcl/gcl_pcl_fsc.lisp b/pcl/gcl_pcl_fsc.lisp new file mode 100644 index 0000000..6d7f28a --- /dev/null +++ b/pcl/gcl_pcl_fsc.lisp @@ -0,0 +1,100 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This file contains the definition of the FUNCALLABLE-STANDARD-CLASS +;;; metaclass. Much of the implementation of this metaclass is actually +;;; defined on the class STD-CLASS. What appears in this file is a modest +;;; number of simple methods related to the low-level differences in the +;;; implementation of standard and funcallable-standard instances. +;;; +;;; As it happens, none of these differences are the ones reflected in +;;; the MOP specification; STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS +;;; share all their specified methods at STD-CLASS. +;;; +;;; +;;; workings of this metaclass and the standard-class metaclass. +;;; + +(in-package :pcl) + +(defmethod wrapper-fetcher ((class funcallable-standard-class)) + 'fsc-instance-wrapper) + +(defmethod slots-fetcher ((class funcallable-standard-class)) + 'fsc-instance-slots) + +(defmethod raw-instance-allocator ((class funcallable-standard-class)) + 'allocate-funcallable-instance) + +;;; +;;; +;;; + +(defmethod validate-superclass + ((fsc funcallable-standard-class) + (class standard-class)) + t) ; was (null (wrapper-instance-slots-layout (class-wrapper class))) + + +(defmethod allocate-instance + ((class funcallable-standard-class) &rest initargs) + (declare (ignore initargs)) + (unless (class-finalized-p class) (finalize-inheritance class)) + (allocate-funcallable-instance (class-wrapper class))) + +(defmethod make-reader-method-function ((class funcallable-standard-class) + slot-name) + (make-std-reader-method-function (class-name class) slot-name)) + +(defmethod make-writer-method-function ((class funcallable-standard-class) + slot-name) + (make-std-writer-method-function (class-name class) slot-name)) + +;;;; +;;;; See the comment about reader-function--std and writer-function--sdt. +;;;; +;(define-function-template reader-function--fsc () '(slot-name) +; `(function +; (lambda (instance) +; (slot-value-using-class (wrapper-class (get-wrapper instance)) +; instance +; slot-name)))) +; +;(define-function-template writer-function--fsc () '(slot-name) +; `(function +; (lambda (nv instance) +; (setf +; (slot-value-using-class (wrapper-class (get-wrapper instance)) +; instance +; slot-name) +; nv)))) +; +;(eval-when (load) +; (pre-make-templated-function-constructor reader-function--fsc) +; (pre-make-templated-function-constructor writer-function--fsc)) + + + diff --git a/pcl/gcl_pcl_generic_functions.lisp b/pcl/gcl_pcl_generic_functions.lisp new file mode 100644 index 0000000..00d71d7 --- /dev/null +++ b/pcl/gcl_pcl_generic_functions.lisp @@ -0,0 +1,779 @@ +;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*- + +(in-package :pcl) + +;;; class predicates +(defgeneric class-eq-specializer-p (object)) +; (t) +; (class-eq-specializer) + +(defgeneric classp (object)) +; (t) +; (class) + +(defgeneric eql-specializer-p (object)) +; (t) +; (eql-specializer) + +(defgeneric exact-class-specializer-p (object)) +; (t) +; (exact-class-specializer) + +(defgeneric forward-referenced-class-p (object)) +; (t) +; (forward-referenced-class) + +(defgeneric funcallable-standard-class-p (object)) +; (t) +; (funcallable-standard-class) + +(defgeneric generic-function-p (object)) +; (t) +; (generic-function) + +(defgeneric legal-lambda-list-p (object x)) +; (standard-method t) + +(defgeneric method-combination-p (object)) +; (t) +; (method-combination) + +(defgeneric method-p (object)) +; (t) +; (method) + +(defgeneric short-method-combination-p (object)) +; (short-method-combination) +; (t) + +(defgeneric slot-class-p (object)) +; (t) +; (slot-class) + +(defgeneric specializerp (object)) +; (t) +; (specializer) + +(defgeneric standard-accessor-method-p (object)) +; (t) +; (standard-accessor-method) + +(defgeneric standard-boundp-method-p (object)) +; (t) +; (standard-boundp-method) + +(defgeneric standard-class-p (object)) +; (t) +; (standard-class) + +(defgeneric standard-generic-function-p (object)) +; (t) +; (standard-generic-function) + +(defgeneric standard-method-p (object)) +; (t) +; (standard-method) + +(defgeneric standard-reader-method-p (object)) +; (t) +; (standard-reader-method) + +(defgeneric standard-writer-method-p (object)) +; (t) +; (standard-writer-method) + +(defgeneric structure-class-p (object)) +; (t) +; (structure-class) + + +;;; readers +(defgeneric accessor-method-slot-definition (standard-accessor-method)) +; (standard-accessor-method) + +(defgeneric class-can-precede-list (pcl-class)) +; (pcl-class) + +(defgeneric class-defstruct-constructor (structure-class)) +; (structure-class) + +(defgeneric class-defstruct-form (structure-class)) +; (structure-class) + +(defgeneric class-direct-subclasses (class)) +; (class) + +(defgeneric class-direct-superclasses (class)) +; (class) + +(defgeneric class-eq-specializer (class)) +; (class) + +(defgeneric class-incompatible-superclass-list (pcl-class)) +; (pcl-class) + +(defgeneric class-initialize-info (slot-class)) +; (slot-class) + +(defgeneric class-name (class)) +; (class) + +(defgeneric class-precedence-list (pcl-class)) +; (pcl-class) + +(defgeneric class-predicate-name (class)) +; (class) + +(defgeneric class-wrapper (pcl-class)) +; (pcl-class) + +(defgeneric definition-source (definition-source-mixin)) +; (definition-source-mixin) + +(defgeneric eql-specializer-object (eql-specializer)) +; (eql-specializer) + +(defgeneric generic-function-method-class (standard-generic-function)) +; (standard-generic-function) + +(defgeneric generic-function-method-combination (standard-generic-function)) +; (standard-generic-function) + +(defgeneric generic-function-methods (standard-generic-function)) +; (standard-generic-function) + +(defgeneric generic-function-name (standard-generic-function)) +; (standard-generic-function) + +(defgeneric gf-arg-info (standard-generic-function)) +; (standard-generic-function) + +(defgeneric gf-dfun-state (standard-generic-function)) +; (standard-generic-function) + +(defgeneric gf-pretty-arglist (standard-generic-function)) +; (standard-generic-function) + +(defgeneric long-method-combination-function (long-method-combination)) +; (long-method-combination) + +(defgeneric method-combination-documentation (standard-method-combination)) +; (standard-method-combination) + +(defgeneric method-combination-options (standard-method-combination)) +; (standard-method-combination) + +(defgeneric method-combination-type (standard-method-combination)) +; (standard-method-combination) + +(defgeneric method-fast-function (standard-method)) +; (standard-method) + +(defgeneric method-generic-function (standard-method)) +; (traced-method) +; (standard-method) + +(defgeneric object-plist (plist-mixin)) +; (plist-mixin) + +(defgeneric short-combination-identity-with-one-argument (short-method-combination)) +; (short-method-combination) + +(defgeneric short-combination-operator (short-method-combination)) +; (short-method-combination) + +(defgeneric slot-definition-boundp-function (effective-slot-definition)) +; (effective-slot-definition) + +(defgeneric slot-definition-class (slot-definition)) +; (slot-definition) + +(defgeneric slot-definition-defstruct-accessor-symbol (structure-slot-definition)) +; (structure-slot-definition) + +(defgeneric slot-definition-initargs (slot-definition)) +; (slot-definition) + +(defgeneric slot-definition-initform (slot-definition)) +; (slot-definition) + +(defgeneric slot-definition-initfunction (slot-definition)) +; (slot-definition) + +(defgeneric slot-definition-internal-reader-function (structure-slot-definition)) +; (structure-slot-definition) + +(defgeneric slot-definition-internal-writer-function (structure-slot-definition)) +; (structure-slot-definition) + +(defgeneric slot-definition-location (standard-effective-slot-definition)) +; (standard-effective-slot-definition) + +(defgeneric slot-definition-name (slot-definition)) +; (slot-definition) + +(defgeneric slot-definition-reader-function (effective-slot-definition)) +; (effective-slot-definition) + +(defgeneric slot-definition-readers (slot-definition)) +; (slot-definition) + +(defgeneric slot-definition-type (slot-definition)) +; (slot-definition) + +(defgeneric slot-definition-writer-function (effective-slot-definition)) +; (effective-slot-definition) + +(defgeneric slot-definition-writers (slot-definition)) +; (slot-definition) + +(defgeneric specializer-object (class-eq-specializer)) +; (eql-specializer) +; (class-prototype-specializer) +; (class-eq-specializer) + +(defgeneric specializer-type (specializer)) +; (specializer) + + +;;; writers +(defgeneric (setf class-defstruct-constructor) (new-value structure-class)) +; (t structure-class) + +(defgeneric (setf class-defstruct-form) (new-value structure-class)) +; (t structure-class) + +(defgeneric (setf class-direct-slots) (new-value slot-class)) +; (t slot-class) + +(defgeneric (setf class-incompatible-superclass-list) (new-value pcl-class)) +; (t pcl-class) + +(defgeneric (setf class-initialize-info) (new-value slot-class)) +; (t slot-class) + +(defgeneric (setf class-name) (new-value class)) +; (t class) + +(defgeneric (setf class-slots) (new-value slot-class)) +; (t slot-class) + +(defgeneric (setf generic-function-method-class) (new-value standard-generic-function)) +; (t standard-generic-function) + +(defgeneric (setf generic-function-method-combination) (new-value standard-generic-function)) +; (t standard-generic-function) + +(defgeneric (setf generic-function-methods) (new-value standard-generic-function)) +; (t standard-generic-function) + +(defgeneric (setf generic-function-name) (new-value standard-generic-function)) +; (t standard-generic-function) + +(defgeneric (setf gf-dfun-state) (new-value standard-generic-function)) +; (t standard-generic-function) + +(defgeneric (setf gf-pretty-arglist) (new-value standard-generic-function)) +; (t standard-generic-function) + +(defgeneric (setf method-generic-function) (new-value standard-method)) +; (t traced-method) +; (t standard-method) + +(defgeneric (setf object-plist) (new-value plist-mixin)) +; (t plist-mixin) + +(defgeneric (setf slot-definition-allocation) (new-value standard-slot-definition)) +; (t standard-slot-definition) + +(defgeneric (setf slot-definition-boundp-function) (new-value effective-slot-definition)) +; (t effective-slot-definition) + +(defgeneric (setf slot-definition-class) (new-value slot-definition)) +; (t slot-definition) + +(defgeneric (setf slot-definition-defstruct-accessor-symbol) (new-value structure-slot-definition)) +; (t structure-slot-definition) + +(defgeneric (setf slot-definition-initargs) (new-value slot-definition)) +; (t slot-definition) + +(defgeneric (setf slot-definition-initform) (new-value slot-definition)) +; (t slot-definition) + +(defgeneric (setf slot-definition-initfunction) (new-value slot-definition)) +; (t slot-definition) + +(defgeneric (setf slot-definition-internal-reader-function) (new-value structure-slot-definition)) +; (t structure-slot-definition) + +(defgeneric (setf slot-definition-internal-writer-function) (new-value structure-slot-definition)) +; (t structure-slot-definition) + +(defgeneric (setf slot-definition-location) (new-value standard-effective-slot-definition)) +; (t standard-effective-slot-definition) + +(defgeneric (setf slot-definition-name) (new-value slot-definition)) +; (t slot-definition) + +(defgeneric (setf slot-definition-reader-function) (new-value effective-slot-definition)) +; (t effective-slot-definition) + +(defgeneric (setf slot-definition-readers) (new-value slot-definition)) +; (t slot-definition) + +(defgeneric (setf slot-definition-type) (new-value slot-definition)) +; (t slot-definition) + +(defgeneric (setf slot-definition-writer-function) (new-value effective-slot-definition)) +; (t effective-slot-definition) + +(defgeneric (setf slot-definition-writers) (new-value slot-definition)) +; (t slot-definition) + + +;;; 1 argument +(defgeneric accessor-method-class (method)) +; (standard-accessor-method) +; (standard-writer-method) + +(defgeneric accessor-method-slot-name (m)) +; (traced-method) +; (standard-accessor-method) + +(defgeneric class-constructors (class)) +; (slot-class) + +(defgeneric class-default-initargs (class)) +; (slot-class) +; (built-in-class) + +(defgeneric class-direct-default-initargs (class)) +; (slot-class) +; (built-in-class) + +(defgeneric class-direct-slots (class)) +; (slot-class) +; (built-in-class) + +(defgeneric class-finalized-p (class)) +; (pcl-class) + +(defgeneric class-prototype (class)) +; (pcl-class) +; (std-class) +; (structure-class) + +(defgeneric class-slot-cells (class)) +; (std-class) + +(defgeneric class-slots (class)) +; (slot-class) +; (built-in-class) + +(defgeneric compute-class-precedence-list (root)) +; (slot-class) + +(defgeneric compute-default-initargs (class)) +; (slot-class) + +(defgeneric compute-discriminating-function (gf)) +; (standard-generic-function) + +(defgeneric compute-discriminating-function-arglist-info (generic-function)) +; (standard-generic-function) + +(defgeneric compute-slots (class)) +; (std-class) +; :around (std-class) +; (structure-class) +; :around (structure-class) + +(defgeneric finalize-inheritance (class)) +; (structure-class) +; (std-class) + +(defgeneric function-keywords (method)) +; (standard-method) + +(defgeneric generic-function-lambda-list (gf)) +; (generic-function) + +(defgeneric generic-function-pretty-arglist (generic-function)) +; (standard-generic-function) + +(defgeneric gf-fast-method-function-p (gf)) +; (standard-generic-function) + +(defgeneric initialize-internal-slot-functions (slotd)) +; (effective-slot-definition) + +(defgeneric make-instances-obsolete (class)) +; (std-class) +; (symbol) + +(defgeneric method-function (method)) +; (traced-method) +; (standard-method) + +(defgeneric method-lambda-list (m)) +; (traced-method) +; (standard-method) + +(defgeneric method-pretty-arglist (method)) +; (standard-method) + +(defgeneric method-qualifiers (m)) +; (traced-method) +; (standard-method) + +(defgeneric method-specializers (m)) +; (traced-method) +; (standard-method) + +(defgeneric raw-instance-allocator (class)) +; (standard-class) +; (funcallable-standard-class) + +(defgeneric slot-definition-allocation (slotd)) +; (standard-slot-definition) +; (structure-slot-definition) + +(defgeneric slots-fetcher (class)) +; (standard-class) +; (funcallable-standard-class) + +(defgeneric specializer-class (specializer)) +; (class-prototype-specializer) +; (class-eq-specializer) +; (class) +; (eql-specializer) + +(defgeneric specializer-direct-generic-functions (specializer)) +; (class) +; (specializer-with-object) + +(defgeneric specializer-direct-methods (specializer)) +; (class) +; (specializer-with-object) + +(defgeneric specializer-method-table (specializer)) +; (eql-specializer) +; (class-eq-specializer) + +(defgeneric update-constructors (class)) +; (slot-class) +; (class) + +(defgeneric wrapper-fetcher (class)) +; (standard-class) +; (funcallable-standard-class) + + +;;; 2 arguments +(defgeneric add-dependent (metaobject dependent)) +; (dependent-update-mixin t) + +(defgeneric add-direct-method (specializer method)) +; (class method) +; (specializer-with-object method) + +(defgeneric add-direct-subclass (class subclass)) +; (class class) + +(defgeneric add-method (generic-function method)) +; (standard-generic-function method) + +(defgeneric change-class (instance new-class-name)) +; (standard-object standard-class) +; (standard-object funcallable-standard-class) +; (t symbol) + +(defgeneric class-slot-value (class slot-name)) +; (std-class t) + +(defgeneric compatible-meta-class-change-p (class proto-new-class)) +; (t t) + +(defgeneric compute-applicable-methods (generic-function arguments)) +; (generic-function t) + +(defgeneric compute-applicable-methods-using-classes (generic-function classes)) +; (generic-function t) + +(defgeneric compute-effective-slot-definition (class dslotds)) +; (slot-class t) + +(defgeneric compute-effective-slot-definition-initargs (class direct-slotds)) +; (slot-class t) +; :around (structure-class t) + +(defgeneric default-initargs (class supplied-initargs)) +; (slot-class t) + +(defgeneric describe-object (object stream)) +; (class t) +; (standard-generic-function t) +; (slot-object t) +; (t t) + +(defgeneric direct-slot-definition-class (class initargs)) +; (structure-class t) +; (std-class t) + +(defgeneric effective-slot-definition-class (class initargs)) +; (std-class t) +; (structure-class t) + +(defgeneric inform-type-system-about-class (class name)) +; (std-class t) +; (structure-class t) + +(defgeneric legal-documentation-p (object x)) +; (standard-method t) + +(defgeneric legal-method-function-p (object x)) +; (standard-method t) + +(defgeneric legal-qualifier-p (object x)) +; (standard-method t) + +(defgeneric legal-qualifiers-p (object x)) +; (standard-method t) + +(defgeneric legal-slot-name-p (object x)) +; (standard-method t) + +(defgeneric legal-specializer-p (object x)) +; (standard-method t) + +(defgeneric legal-specializers-p (object x)) +; (standard-method t) + +(defgeneric make-boundp-method-function (class slot-name)) +; (slot-class t) + +(defgeneric make-reader-method-function (class slot-name)) +; (slot-class t) +; (funcallable-standard-class t) + +(defgeneric make-writer-method-function (class slot-name)) +; (slot-class t) +; (funcallable-standard-class t) + +(defgeneric map-dependents (metaobject function)) +; (dependent-update-mixin t) + +;(defgeneric maybe-update-constructors (generic-function method)) +; (generic-function method) + +(defgeneric print-object (mc stream)) +; (t t) +; (class t) +; (slot-definition t) +; (standard-method t) +; (standard-accessor-method t) +; (generic-function t) +; (standard-method-combination t) + +(defgeneric remove-boundp-method (class generic-function)) +; (slot-class t) + +(defgeneric remove-dependent (metaobject dependent)) +; (dependent-update-mixin t) + +(defgeneric remove-direct-method (specializer method)) +; (class method) +; (specializer-with-object method) + +(defgeneric remove-direct-subclass (class subclass)) +; (class class) + +(defgeneric remove-method (generic-function method)) +; (standard-generic-function method) + +(defgeneric remove-reader-method (class generic-function)) +; (slot-class t) + +(defgeneric remove-writer-method (class generic-function)) +; (slot-class t) + +(defgeneric same-specializer-p (specl1 specl2)) +; (specializer specializer) +; (class class) +; (class-eq-specializer class-eq-specializer) +; (eql-specializer eql-specializer) + +(defgeneric slot-accessor-function (slotd type)) +; (effective-slot-definition t) + +(defgeneric slot-accessor-std-p (slotd type)) +; (effective-slot-definition t) + +(defgeneric slots-to-inspect (class object)) +; (slot-class slot-object) + +(defgeneric update-gf-dfun (class gf)) +; (std-class t) + +(defgeneric validate-superclass (fsc class)) +; (class class) +; (class built-in-class) +; (slot-class forward-referenced-class) +; (funcallable-standard-class standard-class) + + +;;; 3 arguments +(defgeneric add-boundp-method (class generic-function slot-name)) +; (slot-class t t) + +(defgeneric add-reader-method (class generic-function slot-name)) +; (slot-class t t) + +(defgeneric add-writer-method (class generic-function slot-name)) +; (slot-class t t) + +(defgeneric (setf class-slot-value) (nv class slot-name)) +; (t std-class t) + +(defgeneric compute-effective-method (generic-function combin applicable-methods)) +; (generic-function long-method-combination t) +; (generic-function short-method-combination t) +; (generic-function standard-method-combination t) + +(defgeneric compute-slot-accessor-info (slotd type gf)) +; (effective-slot-definition t t) + +(defgeneric find-method-combination (generic-function type options)) +; (generic-function (eql progn) t) +; (generic-function (eql or) t) +; (generic-function (eql nconc) t) +; (generic-function (eql min) t) +; (generic-function (eql max) t) +; (generic-function (eql list) t) +; (generic-function (eql append) t) +; (generic-function (eql and) t) +; (generic-function (eql +) t) +; (generic-function (eql standard) t) + +(defgeneric (setf slot-accessor-function) (function slotd type)) +; (t effective-slot-definition t) + +(defgeneric (setf slot-accessor-std-p) (value slotd type)) +; (t effective-slot-definition t) + +(defgeneric slot-boundp-using-class (class object slotd)) +; (std-class standard-object standard-effective-slot-definition) +; (structure-class structure-object structure-effective-slot-definition) + +(defgeneric slot-makunbound-using-class (class object slotd)) +; (std-class standard-object standard-effective-slot-definition) +; (structure-class structure-object structure-effective-slot-definition) + +(defgeneric slot-unbound (class instance slot-name)) +; (t t t) + +(defgeneric slot-value-using-class (class object slotd)) +; (std-class standard-object standard-effective-slot-definition) +; (structure-class structure-object structure-effective-slot-definition) + + +;;; 4 arguments +(defgeneric make-method-lambda (proto-generic-function proto-method lambda-expression environment)) +; (standard-generic-function standard-method t t) + +(defgeneric (setf slot-value-using-class) (new-value class object slotd)) +; (t std-class standard-object standard-effective-slot-definition) +; (t structure-class structure-object structure-effective-slot-definition) + + +;;; 5 arguments +(defgeneric make-method-initargs-form (proto-generic-function proto-method lambda-expression lambda-list environment)) +; (standard-generic-function standard-method t t t) + + +;;; optional arguments +(defgeneric (setf documentation) (new-value slotd &optional doc-type)) +; (t t) +; (t documentation-mixin) +; (t standard-slot-definition) + +(defgeneric documentation (slotd &optional doc-type)) +; (t) +; (documentation-mixin) +; (standard-slot-definition) + +(defgeneric get-method (generic-function qualifiers specializers &optional (errorp t))) +; (standard-generic-function t t) + +(defgeneric remove-named-method (generic-function-name argument-specifiers &optional extra)) +; (t t) + +(defgeneric slot-missing (class instance slot-name operation &optional new-value)) +; (t t t t) + + +;;; keyword arguments +(defgeneric allocate-instance (class &rest initargs)) +; (standard-class) +; (structure-class) +; (funcallable-standard-class) + +(defgeneric ensure-class-using-class (name class &rest args &key &allow-other-keys)) +; (t null) +; (t pcl-class) + +(defgeneric ensure-generic-function-using-class (generic-function function-specifier &key &allow-other-keys)) +; (null t) +; (generic-function t) + +(defgeneric initialize-instance (gf &key &allow-other-keys)) +; (slot-object) +; :after (standard-generic-function) + +(defgeneric make-instance (class &rest initargs)) +; (symbol) +; (class) + +(defgeneric no-applicable-method (generic-function &rest args)) +; (t) + +(defgeneric reader-method-class (class direct-slot &rest initargs)) +; (slot-class t) + +(defgeneric reinitialize-instance (gf &rest args &key &allow-other-keys)) +; (slot-object) +; :before (slot-class) +; :after (slot-class) +; (standard-method) +; :after (standard-generic-function) + +(defgeneric shared-initialize (generic-function slot-names &key &allow-other-keys)) +; (slot-object t) +; :after (documentation-mixin t) +; :after (class-eq-specializer t) +; :after (eql-specializer t) +; :after (std-class t) +; :before (class t) +; :after (structure-class t) +; :before (built-in-class t) +; :after (standard-slot-definition t) +; :after (structure-slot-definition t) +; :before (standard-method t) +; :before (standard-accessor-method t) +; :after (standard-method t) +; :after (standard-accessor-method t) +; :before (standard-generic-function t) + +(defgeneric update-dependent (metaobject dependent &rest initargs)) + +(defgeneric update-instance-for-different-class (previous current &rest initargs)) +; (standard-object standard-object) + +(defgeneric update-instance-for-redefined-class (instance added-slots discarded-slots property-list &rest initargs)) +; (standard-object t t t) + +(defgeneric writer-method-class (class direct-slot &rest initargs)) +; (slot-class t) + + diff --git a/pcl/gcl_pcl_init.lisp b/pcl/gcl_pcl_init.lisp new file mode 100644 index 0000000..217cca7 --- /dev/null +++ b/pcl/gcl_pcl_init.lisp @@ -0,0 +1,261 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; +;;; This file defines the initialization and related protocols. +;;; + +(in-package :pcl) + +(defmethod make-instance ((class symbol) &rest initargs) + (apply #'make-instance (find-class class) initargs)) + +(defmethod make-instance ((class class) &rest initargs) + (unless (class-finalized-p class) (finalize-inheritance class)) + (setq initargs (default-initargs class initargs)) + #|| + (check-initargs-1 + class initargs + (list (list* 'allocate-instance class initargs) + (list* 'initialize-instance (class-prototype class) initargs) + (list* 'shared-initialize (class-prototype class) t initargs))) + ||# + (let* ((info (initialize-info class initargs)) + (valid-p (initialize-info-valid-p info))) + (when (and (consp valid-p) (eq (car valid-p) :invalid)) + (error "Invalid initialization argument ~S for class ~S" + (cdr valid-p) (class-name class)))) + (let ((instance (apply #'allocate-instance class initargs))) + (apply #'initialize-instance instance initargs) + instance)) + +(defvar *default-initargs-flag* (list nil)) + +(defmethod default-initargs ((class slot-class) supplied-initargs) + (call-initialize-function + (initialize-info-default-initargs-function + (initialize-info class supplied-initargs)) + nil supplied-initargs) + #|| + ;; This implementation of default initargs is critically dependent + ;; on all-default-initargs not having any duplicate initargs in it. + (let ((all-default (class-default-initargs class)) + (miss *default-initargs-flag*)) + (flet ((getf* (plist key) + (do () + ((null plist) miss) + (if (eq (car plist) key) + (return (cadr plist)) + (setq plist (cddr plist)))))) + (labels ((default-1 (tail) + (if (null tail) + nil + (if (eq (getf* supplied-initargs (caar tail)) miss) + (list* (caar tail) + (funcall (cadar tail)) + (default-1 (cdr tail))) + (default-1 (cdr tail)))))) + (append supplied-initargs (default-1 all-default))))) + ||#) + +(defmethod initialize-instance ((instance slot-object) &rest initargs) + (apply #'shared-initialize instance t initargs)) + +(defmethod reinitialize-instance ((instance slot-object) &rest initargs) + #|| + (check-initargs-1 + (class-of instance) initargs + (list (list* 'reinitialize-instance instance initargs) + (list* 'shared-initialize instance nil initargs))) + ||# + (let* ((class (class-of instance)) + (info (initialize-info class initargs)) + (valid-p (initialize-info-ri-valid-p info))) + (when (and (consp valid-p) (eq (car valid-p) :invalid)) + (error "Invalid initialization argument ~S for class ~S" + (cdr valid-p) (class-name class)))) + (apply #'shared-initialize instance nil initargs) + instance) + +(defmethod update-instance-for-different-class ((previous standard-object) + (current standard-object) + &rest initargs) + ;; First we must compute the newly added slots. The spec defines + ;; newly added slots as "those local slots for which no slot of + ;; the same name exists in the previous class." + (let ((added-slots '()) + (current-slotds (class-slots (class-of current))) + (previous-slot-names (mapcar #'slot-definition-name + (class-slots (class-of previous))))) + (dolist (slotd current-slotds) + (if (and (not (memq (slot-definition-name slotd) previous-slot-names)) + (eq (slot-definition-allocation slotd) ':instance)) + (push (slot-definition-name slotd) added-slots))) + (check-initargs-1 + (class-of current) initargs + (list (list* 'update-instance-for-different-class previous current initargs) + (list* 'shared-initialize current added-slots initargs))) + (apply #'shared-initialize current added-slots initargs))) + +(defmethod update-instance-for-redefined-class ((instance standard-object) + added-slots + discarded-slots + property-list + &rest initargs) + (check-initargs-1 + (class-of instance) initargs + (list (list* 'update-instance-for-redefined-class + instance added-slots discarded-slots property-list initargs) + (list* 'shared-initialize instance added-slots initargs))) + (apply #'shared-initialize instance added-slots initargs)) + +(defmethod shared-initialize + ((instance slot-object) slot-names &rest initargs) + (when (eq slot-names 't) + (return-from shared-initialize + (call-initialize-function + (initialize-info-shared-initialize-t-function + (initialize-info (class-of instance) initargs)) + instance initargs))) + (when (eq slot-names 'nil) + (return-from shared-initialize + (call-initialize-function + (initialize-info-shared-initialize-nil-function + (initialize-info (class-of instance) initargs)) + instance initargs))) + ;; + ;; initialize the instance's slots in a two step process + ;; (1) A slot for which one of the initargs in initargs can set + ;; the slot, should be set by that initarg. If more than + ;; one initarg in initargs can set the slot, the leftmost + ;; one should set it. + ;; + ;; (2) Any slot not set by step 1, may be set from its initform + ;; by step 2. Only those slots specified by the slot-names + ;; argument are set. If slot-names is: + ;; T + ;; any slot not set in step 1 is set from its + ;; initform + ;; + ;; any slot in the list, and not set in step 1 + ;; is set from its initform + ;; + ;; () + ;; no slots are set from initforms + ;; + (let* ((class (class-of instance)) + (slotds (class-slots class)) + #-new-kcl-wrapper + (std-p #+cmu17 + (pcl-instance-p instance) + #-cmu17 + (or (std-instance-p instance) (fsc-instance-p instance)))) + (dolist (slotd slotds) + (let ((slot-name (slot-definition-name slotd)) + (slot-initargs (slot-definition-initargs slotd))) + (unless (progn + ;; Try to initialize the slot from one of the initargs. + ;; If we succeed return T, otherwise return nil. + (doplist (initarg val) initargs + (when (memq initarg slot-initargs) + (setf (slot-value-using-class class instance slotd) + val) + (return 't)))) + ;; Try to initialize the slot from its initform. + (if (and slot-names + (or (eq slot-names 't) + (memq slot-name slot-names)) + (or #-new-kcl-wrapper (and (not std-p) (eq slot-names 't)) + (not (slot-boundp-using-class class instance slotd)))) + (let ((initfunction (slot-definition-initfunction slotd))) + (when initfunction + (setf (slot-value-using-class class instance slotd) + (funcall (the function initfunction))))))))) + instance)) + + +;;; +;;; if initargs are valid return nil, otherwise signal an error +;;; +(defun check-initargs-1 (class initargs call-list &optional (plist-p t) (error-p t)) + (multiple-value-bind (legal allow-other-keys) + (check-initargs-values class call-list) + (unless allow-other-keys + (if plist-p + (check-initargs-2-plist initargs class legal error-p) + (check-initargs-2-list initargs class legal error-p))))) + +(defun check-initargs-values (class call-list) + (let ((methods (mapcan #'(lambda (call) + (if (consp call) + (copy-list (compute-applicable-methods + (gdefinition (car call)) + (cdr call))) + (list call))) + call-list)) + (legal (apply #'append (mapcar #'slot-definition-initargs + (class-slots class))))) + ;; Add to the set of slot-filling initargs the set of + ;; initargs that are accepted by the methods. If at + ;; any point we come across &allow-other-keys, we can + ;; just quit. + (dolist (method methods) + (multiple-value-bind (nreq nopt keysp restp allow-other-keys keys) + (analyze-lambda-list (if (consp method) + (early-method-lambda-list method) + (method-lambda-list method))) + (declare (ignore nreq nopt keysp restp)) + (when allow-other-keys + (return-from check-initargs-values (values nil t))) + (setq legal (append keys legal)))) + (values legal nil))) + +(defun check-initargs-2-plist (initargs class legal &optional (error-p t)) + (unless (getf initargs :allow-other-keys) + ;; Now check the supplied-initarg-names and the default initargs + ;; against the total set that we know are legal. + (doplist (key val) initargs + (unless (memq key legal) + (if error-p + (error "Invalid initialization argument ~S for class ~S" + key + (class-name class)) + (return-from check-initargs-2-plist nil))))) + t) + +(defun check-initargs-2-list (initkeys class legal &optional (error-p t)) + (unless (memq :allow-other-keys initkeys) + ;; Now check the supplied-initarg-names and the default initargs + ;; against the total set that we know are legal. + (dolist (key initkeys) + (unless (memq key legal) + (if error-p + (error "Invalid initialization argument ~S for class ~S" + key + (class-name class)) + (return-from check-initargs-2-list nil))))) + t) + diff --git a/pcl/gcl_pcl_iterate.lisp b/pcl/gcl_pcl_iterate.lisp new file mode 100644 index 0000000..d690a95 --- /dev/null +++ b/pcl/gcl_pcl_iterate.lisp @@ -0,0 +1,1267 @@ +;;;-*- Package: ITERATE; Syntax: Common-Lisp; Base: 10 -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; Original source {pooh/n}vanmelle>lisp>iterate;4 created 27-Sep-88 12:35:33 + +(in-package :iterate :use '(:lisp :walker)) + + +(export '(iterate iterate* gathering gather with-gathering interval elements + list-elements list-tails plist-elements eachtime while until + collecting joining maximizing minimizing summing + *iterate-warnings*)) + +(defvar *iterate-warnings* :any "Controls whether warnings are issued for iterate/gather forms that aren't optimized. +NIL => never; :USER => those resulting from user code; T => always, even if it's the iteration macro that's suboptimal." + ) + +;;; ITERATE macro + + +(defmacro iterate (clauses &body body &environment env) + (optimize-iterate-form clauses body env)) + +(defun + simple-expand-iterate-form + (clauses body) + + ;; Expand ITERATE. This is the "formal semantics" expansion, which we never + ;; use. + (let* + ((block-name (gensym)) + (bound-var-lists (mapcar #'(lambda (clause) + (let ((names (first clause))) + (if (listp names) + names + (list names)))) + clauses)) + (generator-vars (mapcar #'(lambda (clause) + (declare (ignore clause)) + (gensym)) + clauses))) + `(block ,block-name + (let* + ,(mapcan #'(lambda (gvar clause var-list) + ; For each clause, bind a + ; generator temp to the clause, + ; then bind the specified + ; var(s) + (cons (list gvar (second clause)) + (copy-list var-list))) + generator-vars clauses bound-var-lists) + + ;; Note bug in formal semantics: there can be declarations in the head + ;; of BODY; they go here, rather than inside loop + (loop + ,@(mapcar + #'(lambda (var-list gen-var) + ; Set each bound variable (or + ; set of vars) to the result of + ; calling the corresponding + ; generator + `(multiple-value-setq + ,var-list + (funcall ,gen-var #'(lambda nil (return-from + ,block-name))))) + bound-var-lists generator-vars) + ,@body))))) + +(defparameter *iterate-temp-vars-list* + '(iterate-temp-1 iterate-temp-2 iterate-temp-3 iterate-temp-4 + iterate-temp-5 iterate-temp-6 iterate-temp-7 iterate-temp-8) + "Temp var names used by ITERATE expansions.") + +(defun + optimize-iterate-form + (clauses body iterate-env) + (let* + ((temp-vars *iterate-temp-vars-list*) + (block-name (gensym)) + (finish-form `(return-from ,block-name)) + (bound-vars (mapcan #'(lambda (clause) + (let ((names (first clause))) + (if (listp names) + (copy-list names) + (list names)))) + clauses)) + iterate-decls generator-decls update-forms bindings leftover-body) + (do ((tail bound-vars (cdr tail))) + ((null tail)) + ; Check for duplicates + (when (member (car tail) + (cdr tail)) + (warn "Variable appears more than once in ITERATE: ~S" (car tail)))) + (flet + ((get-iterate-temp nil + + ;; Make temporary var. Note that it is ok to re-use these symbols + ;; in each iterate, because they are not used within BODY. + (or (pop temp-vars) + (gensym)))) + (dolist (clause clauses) + (cond + ((or (not (consp clause)) + (not (consp (cdr clause)))) + (warn "Bad syntax in ITERATE: clause not of form (var iterator): ~S" + clause)) + (t + (unless (null (cddr clause)) + (warn + "Probable parenthesis error in ITERATE clause--more than 2 elements: ~S" + clause)) + (multiple-value-bind + (let-body binding-type let-bindings localdecls otherdecls extra-body) + (expand-into-let (second clause) + 'iterate iterate-env) + + ;; We have expanded the generator clause and parsed it into its LET + ;; pieces. + (prog* + ((vars (first clause)) + gen-args renamed-vars) + (setq vars (if (listp vars) + (copy-list vars) + (list vars))) + ; VARS is now a (fresh) list of + ; all iteration vars bound in + ; this clause + (cond + ((eq let-body :abort) + ; Already issued a warning + ; about malformedness + ) + ((null (setq let-body (function-lambda-p let-body 1))) + ; Not of the expected form + (let ((generator (second clause))) + (cond ((and (consp generator) + (fboundp (car generator))) + ; It looks ok--a macro or + ; function here--so the guy who + ; wrote it just didn't do it in + ; an optimizable way + (maybe-warn :definition "Could not optimize iterate clause ~S because generator not of form (LET[*] ... (FUNCTION (LAMBDA (finish) ...)))" + generator)) + (t ; Perhaps it's just a + ; misspelling? Probably user + ; error + (maybe-warn :user + "Iterate operator in clause ~S is not fboundp." + generator))) + (setq let-body :abort))) + (t + + ;; We have something of the form #'(LAMBDA (finisharg) ...), + ;; possibly with some LET bindings around it. LET-BODY = + ;; ((finisharg) ...). + (setq let-body (cdr let-body)) + (setq gen-args (pop let-body)) + (when let-bindings + + ;; The first transformation we want to perform is + ;; "LET-eversion": turn (let* ((generator (let (..bindings..) + ;; #'(lambda ...)))) ..body..) into (let* (..bindings.. + ;; (generator #'(lambda ...))) ..body..). This + ;; transformation is valid if nothing in body refers to any + ;; of the bindings, something we can assure by + ;; alpha-converting the inner let (substituting new names for + ;; each var). Of course, none of those vars can be special, + ;; but we already checked for that above. + (multiple-value-setq (let-bindings renamed-vars) + (rename-let-bindings let-bindings binding-type + iterate-env leftover-body #'get-iterate-temp)) + (setq leftover-body nil) + ; If there was any leftover + ; from previous, it is now + ; consumed + ) + + ;; The second transformation is substituting the body of the + ;; generator (LAMBDA (finish-arg) . gen-body) for its appearance + ;; in the update form (funcall generator #'(lambda () + ;; finish-form)), then simplifying that form. The requirement + ;; for this part is that the generator body not refer to any + ;; variables that are bound between the generator binding and the + ;; appearance in the loop body. The only variables bound in that + ;; interval are generator temporaries, which have unique names so + ;; are no problem, and the iteration variables remaining for + ;; subsequent clauses. We'll discover the story as we walk the + ;; body. + (multiple-value-bind + (finishdecl other rest) + (parse-declarations let-body gen-args) + (declare (ignore finishdecl)) + ; Pull out declares, if any, + ; separating out the one(s) + ; referring to the finish arg, + ; which we will throw away + (when other + ; Combine remaining decls with + ; decls extracted from the LET, + ; if any + (setq otherdecls (nconc otherdecls other))) + (setq let-body (cond + (otherdecls + ; There are interesting + ; declarations, so have to keep + ; it wrapped. + `(let nil (declare ,@otherdecls) + ,@rest)) + ((null (cdr rest)) + ; Only one form left + (first rest)) + (t `(progn ,@rest))))) + (unless (eq (setq let-body (iterate-transform-body let-body + iterate-env renamed-vars + (first gen-args) + finish-form bound-vars clause)) + :abort) + + ;; Skip the rest if transformation failed. Warning has + ;; already been issued. + + ;; Note possible further optimization: if LET-BODY expanded + ;; into (prog1 oldvalue prepare-for-next-iteration), as so + ;; many do, then we could in most cases split the PROG1 into + ;; two pieces: do the (setq var oldvalue) here, and do the + ;; prepare-for-next-iteration at the bottom of the loop. + ;; This does a slight optimization of the PROG1 and also + ;; rearranges the code in a way that a reasonably clever + ;; compiler might detect how to get rid of redundant + ;; variables altogether (such as happens with INTERVAL and + ;; LIST-TAILS); that would make the whole thing closer to + ;; what you might have coded by hand. However, to do this + ;; optimization, we need to assure that (a) the + ;; prepare-for-next-iteration refers freely to no vars other + ;; than the internal vars we have extracted from the LET, and + ;; (b) that the code has no side effects. These are both + ;; true for all the iterators defined by this module, but how + ;; shall we represent side-effect info and/or tap into the + ;; compiler's knowledge of same? + (when localdecls + ; There were declarations for + ; the generator locals--have to + ; keep them for later, and + ; rename the vars mentioned + (setq + generator-decls + (nconc + generator-decls + (mapcar + #'(lambda + (decl) + (let ((head (car decl))) + (cons head (if (eq head 'type) + (cons (second decl) + (sublis renamed-vars + (cddr decl))) + (sublis renamed-vars + (cdr decl)))))) + localdecls))))))) + + ;; Finished analyzing clause now. LET-BODY is the form which, when + ;; evaluated, returns updated values for the iteration variable(s) + ;; VARS. + (when (eq let-body :abort) + + ;; Some punt case: go with the formal semantics: bind a var to + ;; the generator, then call it in the update section + (let + ((gvar (get-iterate-temp)) + (generator (second clause))) + (setq + let-bindings + (list (list gvar + (cond + (leftover-body + ; Have to use this up + `(progn ,@(prog1 leftover-body (setq + leftover-body + nil)) + generator)) + (t generator))))) + (setq let-body `(funcall ,gvar #'(lambda nil ,finish-form))))) + (push (mv-setq (copy-list vars) + let-body) + update-forms) + (dolist (v vars) + (declare (ignore v)) + ; Pop off the vars we have now + ; bound from the list of vars + ; to watch out for--we'll bind + ; them right now + (pop bound-vars)) + (setq bindings + (nconc bindings let-bindings + (cond (extra-body + ; There was some computation to + ; do after the bindings--here's + ; our chance + (cons (list (first vars) + `(progn ,@extra-body nil)) + (rest vars))) + (t vars)))))))))) + (do ((tail body (cdr tail))) + ((not (and (consp tail) + (consp (car tail)) + (eq (caar tail) + 'declare))) + + ;; TAIL now points at first non-declaration. If there were + ;; declarations, pop them off so they appear in the right place + (unless (eq tail body) + (setq iterate-decls (ldiff body tail)) + (setq body tail)))) + `(block ,block-name + (let* ,bindings ,@(and generator-decls + `((declare ,@generator-decls))) + ,@iterate-decls + ,@leftover-body + (loop ,@(nreverse update-forms) + ,@body))))) + +(defun expand-into-let (clause parent-name env) + + ;; Return values: Body, LET[*], bindings, localdecls, otherdecls, extra + ;; body, where BODY is a single form. If multiple forms in a LET, the + ;; preceding forms are returned as extra body. Returns :ABORT if it + ;; issued a punt warning. + (prog ((expansion clause) + expandedp binding-type let-bindings let-body) + expand + (multiple-value-setq (expansion expandedp) + (macroexpand-1 expansion env)) + (cond ((not (consp expansion)) + ; Shouldn't happen + ) + ((symbolp (setq binding-type (first expansion))) + (case binding-type + ((let let*) + (setq let-bindings (second expansion)) + ; List of variable bindings + (setq let-body (cddr expansion)) + (go handle-let)))) + ((and (consp binding-type) + (eq (car binding-type) + 'lambda) + (not (find-if #'(lambda (x) + (member x lambda-list-keywords) + ) + (setq let-bindings (second binding-type))) + ) + (eql (length (second expansion)) + (length let-bindings)) + (null (cddr expansion))) + ; A simple LAMBDA form can be + ; treated as LET + (setq let-body (cddr binding-type)) + (setq let-bindings (mapcar #'list let-bindings (second + expansion)) + ) + (setq binding-type 'let) + (go handle-let))) + + ;; Fall thru if not a LET + (cond (expandedp ; try expanding again + (go expand)) + (t ; Boring--return form as the + ; body + (return expansion))) + handle-let + (return (let ((locals (variables-from-let let-bindings)) + extra-body specials) + (multiple-value-bind + (localdecls otherdecls let-body) + (parse-declarations let-body locals) + (cond ((setq specials (extract-special-bindings + locals localdecls)) + (maybe-warn (cond ((find-if #'variable-globally-special-p + specials) + ; This could be the fault of a + ; user proclamation + :user) + (t :definition)) + + "Couldn't optimize ~S because expansion of ~S binds specials ~(~S ~)" + parent-name clause specials) + :abort) + (t (values (cond ((not (consp let-body)) + + ; Null body of LET? unlikely, + ; but someone else will likely + ; complain + nil) + ((null (cdr let-body)) + + ; A single expression, which we + ; hope is (function + ; (lambda...)) + (first let-body)) + (t + + ;; More than one expression. These are forms to + ;; evaluate after the bindings but before the + ;; generator form is returned. Save them to + ;; evaluate in the next convenient place. Note that + ;; this is ok, as there is no construct that can + ;; cause a LET to return prematurely (without + ;; returning also from some surrounding construct). + (setq extra-body + (butlast let-body)) + (car (last let-body)))) + binding-type let-bindings localdecls + otherdecls extra-body)))))))) + +(defun variables-from-let (bindings) + + ;; Return a list of the variables bound in the first argument to LET[*]. + (mapcar #'(lambda (binding) + (if (consp binding) + (first binding) + binding)) + bindings)) + +(defun iterate-transform-body (let-body iterate-env renamed-vars finish-arg + finish-form bound-vars clause) + + +;;; This is the second major transformation for a single iterate clause. +;;; LET-BODY is the body of the iterator after we have extracted its local +;;; variables and declarations. We have two main tasks: (1) Substitute +;;; internal temporaries for occurrences of the LET variables; the alist +;;; RENAMED-VARS specifies this transformation. (2) Substitute evaluation of +;;; FINISH-FORM for any occurrence of (funcall FINISH-ARG). Along the way, we +;;; check for forms that would invalidate these transformations: occurrence of +;;; FINISH-ARG outside of a funcall, and free reference to any element of +;;; BOUND-VARS. CLAUSE & TYPE are the original ITERATE clause and its type +;;; (ITERATE or ITERATE*), for purpose of error messages. On success, we +;;; return the transformed body; on failure, :ABORT. + + (walk-form let-body iterate-env + #'(lambda (form context env) + (declare (ignore context)) + + ;; Need to substitute RENAMED-VARS, as well as turn + ;; (FUNCALL finish-arg) into the finish form + (cond ((symbolp form) + (let (renaming) + (cond ((and (eq form finish-arg) + (variable-same-p form env + iterate-env)) + ; An occurrence of the finish + ; arg outside of FUNCALL + ; context--I can't handle this + (maybe-warn :definition "Couldn't optimize iterate form because generator ~S does something with its FINISH arg besides FUNCALL it." + (second clause)) + (return-from iterate-transform-body + :abort)) + ((and (setq renaming (assoc form + renamed-vars + )) + (variable-same-p form env + iterate-env)) + ; Reference to one of the vars + ; we're renaming + (cdr renaming)) + ((and (member form bound-vars) + (variable-same-p form env + iterate-env)) + ; FORM is a var that is bound + ; in this same ITERATE, or + ; bound later in this ITERATE*. + ; This is a conflict. + (maybe-warn :user "Couldn't optimize iterate form because generator ~S is closed over ~S, in conflict with a subsequent iteration variable." + (second clause) + form) + (return-from iterate-transform-body + :abort)) + (t form)))) + ((and (consp form) + (eq (first form) + 'funcall) + (eq (second form) + finish-arg) + (variable-same-p (second form) + env iterate-env)) + ; (FUNCALL finish-arg) => + ; finish-form + (unless (null (cddr form)) + (maybe-warn :definition + "Generator for ~S applied its finish arg to > 0 arguments ~S--ignored." + (second clause) + (cddr form))) + finish-form) + (t form))))) + +(defun + parse-declarations + (tail locals) + + ;; Extract the declarations from the head of TAIL and divide them into 2 + ;; classes: declares about variables in the list LOCALS, and all other + ;; declarations. Returns 3 values: those 2 lists plus the remainder of TAIL. + (let + (localdecls otherdecls form) + (loop + (unless (and tail (consp (setq form (car tail))) + (eq (car form) + 'declare)) + (return (values localdecls otherdecls tail))) + (mapc + #'(lambda + (decl) + (case (first decl) + ((inline notinline optimize) + ; These don't talk about vars + (push decl otherdecls)) + (t ; Assume all other kinds are + ; for vars + (let* ((vars (if (eq (first decl) + 'type) + (cddr decl) + (cdr decl))) + (l (intersection locals vars)) + other) + (cond + ((null l) + ; None talk about LOCALS + (push decl otherdecls)) + ((null (setq other (set-difference vars l))) + ; All talk about LOCALS + (push decl localdecls)) + (t ; Some of each + (let ((head (cons 'type (and (eq (first decl) + 'type) + (list (second decl)))))) + (push (append head other) + otherdecls) + (push (append head l) + localdecls)))))))) + (cdr form)) + (pop tail)))) + +(defun extract-special-bindings (vars decls) + + ;; Return the subset of VARS that are special, either globally or + ;; because of a declaration in DECLS + (let ((specials (remove-if-not #'variable-globally-special-p vars))) + (dolist (d decls) + (when (eq (car d) + 'special) + (setq specials (union specials (intersection vars + (cdr d)))))) + specials)) + +(defun function-lambda-p (form &optional nargs) + + ;; If FORM is #'(LAMBDA bindings . body) and bindings is of length + ;; NARGS, return the lambda expression + (let (args body) + (and (consp form) + (eq (car form) + 'function) + (consp (setq form (cdr form))) + (null (cdr form)) + (consp (setq form (car form))) + (eq (car form) + 'lambda) + (consp (setq body (cdr form))) + (listp (setq args (car body))) + (or (null nargs) + (eql (length args) + nargs)) + form))) + +(defun + rename-let-bindings + (let-bindings binding-type env leftover-body &optional tempvarfn) + + ;; Perform the alpha conversion required for "LET eversion" of (LET[*] + ;; LET-BINDINGS . body)--rename each of the variables to an internal name. + ;; Returns 2 values: a new set of LET bindings and the alist of old var names + ;; to new (so caller can walk the body doing the rest of the renaming). + ;; BINDING-TYPE is one of LET or LET*. LEFTOVER-BODY is optional list of + ;; forms that must be eval'ed before the first binding happens. ENV is the + ;; macro expansion environment, in case we have to walk a LET*. TEMPVARFN is + ;; a function of no args to return a temporary var; if omitted, we use + ;; GENSYM. + (let + (renamed-vars) + (values (mapcar #'(lambda (binding) + (let ((valueform (cond ((not (consp binding)) + + ; No initial value + nil) + ((or (eq binding-type + 'let) + (null renamed-vars)) + + ; All bindings are in parallel, + ; so none can refer to others + (second binding)) + (t + ; In a LET*, have to substitute + ; vars in the 2nd and + ; subsequent initialization + ; forms + (rename-variables + (second binding) + renamed-vars env)))) + (newvar (if tempvarfn + (funcall tempvarfn) + (gensym)))) + (push (cons (if (consp binding) + (first binding) + binding) + newvar) + renamed-vars) + ; Add new variable to the list + ; AFTER we have walked the + ; initial value form + (when leftover-body + + + ;; Previous clause had some computation to do after + ;; its bindings. Here is the first opportunity to + ;; do it + (setq valueform `(progn ,@leftover-body + ,valueform)) + (setq leftover-body nil)) + (list newvar valueform))) + let-bindings) + renamed-vars))) + +(defun rename-variables (form alist env) + + ;; Walks FORM, renaming occurrences of the key variables in ALIST with + ;; their corresponding values. ENV is FORM's environment, so we can + ;; make sure we are talking about the same variables. + (walk-form form env + #'(lambda (form context subenv) + (declare (ignore context)) + (let (pair) + (cond ((and (symbolp form) + (setq pair (assoc form alist)) + (variable-same-p form subenv env)) + (cdr pair)) + (t form)))))) + +(defun + mv-setq + (vars expr) + + ;; Produces (MULTIPLE-VALUE-SETQ vars expr), except that I'll optimize some + ;; of the simple cases for benefit of compilers that don't, and I don't care + ;; what the value is, and I know that the variables need not be set in + ;; parallel, since they can't be used free in EXPR + (cond + ((null vars) + ; EXPR is a side-effect + expr) + ((not (consp vars)) + ; This is an error, but I'll + ; let MULTIPLE-VALUE-SETQ + ; report it + `(multiple-value-setq ,vars ,expr)) + ((and (listp expr) + (eq (car expr) + 'values)) + + ;; (mv-setq (a b c) (values x y z)) can be reduced to a parallel setq + ;; (psetq returns nil, but I don't care about returned value). Do this + ;; even for the single variable case so that we catch (mv-setq (a) (values + ;; x y)) + (pop expr) + ; VALUES + `(setq ,@(mapcon #'(lambda (tail) + (list (car tail) + (cond ((or (cdr tail) + (null (cdr expr))) + ; One result expression for + ; this var + (pop expr)) + (t ; More expressions than vars, + ; so arrange to evaluate all + ; the rest now. + (cons 'prog1 expr))))) + vars))) + ((null (cdr vars)) + ; Simple one variable case + `(setq ,(car vars) + ,expr)) + (t ; General case--I know nothing + `(multiple-value-setq ,vars ,expr)))) + +(defun variable-same-p (var env1 env2) + (eq (variable-lexical-p var env1) + (variable-lexical-p var env2))) + +(defun maybe-warn (type &rest warn-args) + + ;; Issue a warning about not being able to optimize this thing. TYPE + ;; is one of :DEFINITION, meaning the definition is at fault, and + ;; :USER, meaning the user's code is at fault. + (when (case *iterate-warnings* + ((nil) nil) + ((:user) (eq type :user)) + (t t)) + (apply #'warn warn-args))) + + +;; Sample iterators + + +(defmacro + interval + (&whole whole &key from downfrom to downto above below by type) + (cond + ((and from downfrom) + (error "Can't use both FROM and DOWNFROM in ~S" whole)) + ((cdr (remove nil (list to downto above below))) + (error "Can't use more than one limit keyword in ~S" whole)) + (t + (let* + ((down (or downfrom downto above)) + (limit (or to downto above below)) + (inc (cond ((null by) + 1) + ((constantp by) + ; Can inline this increment + by)))) + `(let + ((from ,(or from downfrom 0)) + ,@(and limit `((to ,limit))) + ,@(and (null inc) + `((by ,by)))) + ,@(and type `((declare (type ,type from ,@(and limit '(to)) + ,@(and (null inc) + `(by)))))) + #'(lambda + (finish) + ,@(cond ((null limit) + ; We won't use the FINISH arg + '((declare (ignore finish))))) + (prog1 ,(cond (limit ; Test the limit. If ok, + ; return current value and + ; increment, else quit + `(if (,(cond (above '>) + (below '<) + (down '>=) + (t '<=)) + from to) + from + (funcall finish))) + (t ; No test + 'from)) + (setq from (,(if down + '- + '+) + from + ,(or inc 'by)))))))))) + +(defmacro list-elements (list &key (by '#'cdr)) + `(let ((tail ,list)) + #'(lambda (finish) + (prog1 (if (endp tail) + (funcall finish) + (first tail)) + (setq tail (funcall ,by tail)))))) + +(defmacro list-tails (list &key (by '#'cdr)) + `(let ((tail ,list)) + #'(lambda (finish) + (prog1 (if (endp tail) + (funcall finish) + tail) + (setq tail (funcall ,by tail)))))) + +(defmacro + elements + (sequence) + "Generates successive elements of SEQUENCE, with second value being the index. Use (ELEMENTS (THE type arg)) if you care about the type." + (let* + ((type (and (consp sequence) + (eq (first sequence) + 'the) + (second sequence))) + (accessor (if type + (sequence-accessor type) + 'elt)) + (listp (eq type 'list))) + + ;; If type is given via THE, we may be able to generate a good accessor here + ;; for the benefit of implementations that aren't smart about (ELT (THE + ;; STRING FOO)). I'm not bothering to keep the THE inside the body, + ;; however, since I assume any compiler that would understand (AREF (THE + ;; SIMPLE-ARRAY S)) would also understand that (AREF S) is the same when I + ;; bound S to (THE SIMPLE-ARRAY foo) and never modified it. + + ;; If sequence is declared to be a list, it's better to cdr down it, so we + ;; have some extra cases here. Normally folks would write LIST-ELEMENTS, + ;; but maybe they wanted to get the index for free... + `(let* ((index 0) + (s ,sequence) + ,@(and (not listp) + '((size (length s))))) + #'(lambda (finish) + (values (cond ,(if listp + '((not (endp s)) + (pop s)) + `((< index size) + (,accessor s index))) + (t (funcall finish))) + (prog1 index + (setq index (1+ index)))))))) + +(defmacro + plist-elements + (plist) + "Generates each time 2 items, the indicator and the value." + `(let ((tail ,plist)) + #'(lambda (finish) + (values (if (endp tail) + (funcall finish) + (first tail)) + (prog1 (if (endp (setq tail (cdr tail))) + (funcall finish) + (first tail)) + (setq tail (cdr tail))))))) + +(defun sequence-accessor (type) + + ;; returns the function with which most efficiently to make accesses to + ;; a sequence of type TYPE. + (case (if (consp type) + ; e.g., (VECTOR FLOAT *) + (car type) + type) + ((array simple-array vector) 'aref) + (simple-vector 'svref) + (string 'char) + (simple-string 'schar) + (bit-vector 'bit) + (simple-bit-vector 'sbit) + (t 'elt))) + + +;; These "iterators" may be withdrawn + + +(defmacro eachtime (expr) + `#'(lambda (finish) + (declare (ignore finish)) + ,expr)) + +(defmacro while (expr) + `#'(lambda (finish) + (unless ,expr (funcall finish)))) + +(defmacro until (expr) + `#'(lambda (finish) + (when ,expr (funcall finish)))) + + ; GATHERING macro + + +(defmacro gathering (clauses &body body &environment env) + (or (optimize-gathering-form clauses body env) + (simple-expand-gathering-form clauses body env))) + +(defmacro with-gathering (clauses gather-body &body use-body) + "Binds the variables specified in CLAUSES to the result of (GATHERING clauses gather-body) and evaluates the forms in USE-BODY inside that contour." + + ;; We may optimize this a little better later for those compilers that + ;; don't do a good job on (m-v-bind vars (... (values ...)) ...). + `(multiple-value-bind ,(mapcar #'car clauses) + (gathering ,clauses ,gather-body) + ,@use-body)) + +(defun + simple-expand-gathering-form + (clauses body env) + (declare (ignore env)) + + ;; The "formal semantics" of GATHERING. We use this only in cases that can't + ;; be optimized. + (let + ((acc-names (mapcar #'first (if (symbolp clauses) + ; Shorthand using anonymous + ; gathering site + (setq clauses `((*anonymous-gathering-site* + (,clauses)))) + clauses))) + (realizer-names (mapcar #'(lambda (binding) + (declare (ignore binding)) + (gensym)) + clauses))) + `(multiple-value-call + #'(lambda + ,(mapcan #'list acc-names realizer-names) + (flet ((gather (value &optional (accumulator *anonymous-gathering-site*) + ) + (funcall accumulator value))) + ,@body + (values ,@(mapcar #'(lambda (rname) + `(funcall ,rname)) + realizer-names)))) + ,@(mapcar #'second clauses)))) + +(defvar *active-gatherers* nil + "List of GATHERING bindings currently active during macro expansion)") + +(defvar *anonymous-gathering-site* nil "Variable used in formal expansion of an abbreviated GATHERING form (one with anonymous gathering site)." + ) + +(defun + optimize-gathering-form + (clauses body gathering-env) + (let* + (acc-info leftover-body top-bindings finish-forms top-decls) + (dolist (clause (if (symbolp clauses) + ; A shorthand + `((*anonymous-gathering-site* (,clauses))) + clauses)) + (multiple-value-bind + (let-body binding-type let-bindings localdecls otherdecls extra-body) + (expand-into-let (second clause) + 'gathering gathering-env) + (prog* + ((acc-var (first clause)) + renamed-vars accumulator realizer) + (when (and (consp let-body) + (eq (car let-body) + 'values) + (consp (setq let-body (cdr let-body))) + (setq accumulator (function-lambda-p (car let-body))) + (consp (setq let-body (cdr let-body))) + (setq realizer (function-lambda-p (car let-body) + 0)) + (null (cdr let-body))) + + ;; Macro returned something of the form (VALUES #'(lambda (value) + ;; ...) #'(lambda () ...)), a function to accumulate values and a + ;; function to realize the result. + (when binding-type + + ;; Gatherer expanded into a LET + (cond (otherdecls (maybe-warn :definition "Couldn't optimize GATHERING clause ~S because its expansion carries declarations about more than the bound variables: ~S" + (second clause) + `(declare ,@otherdecls)) + (go punt))) + (when let-bindings + + ;; The first transformation we want to perform is a + ;; variant of "LET-eversion": turn (mv-bind (acc real) + ;; (let (..bindings..) (values #'(lambda ...) #'(lambda + ;; ...))) ..body..) into (let* (..bindings.. (acc + ;; #'(lambda ...)) (real #'(lambda ...))) ..body..). This + ;; transformation is valid if nothing in body refers to + ;; any of the bindings, something we can assure by + ;; alpha-converting the inner let (substituting new names + ;; for each var). Of course, none of those vars can be + ;; special, but we already checked for that above. + (multiple-value-setq (let-bindings renamed-vars) + (rename-let-bindings let-bindings binding-type + gathering-env leftover-body)) + (setq top-bindings (nconc top-bindings let-bindings)) + (setq leftover-body nil) + ; If there was any leftover + ; from previous, it is now + ; consumed + )) + (setq leftover-body (nconc leftover-body extra-body)) + ; Computation to do after these + ; bindings + (push (cons acc-var (rename-and-capture-variables accumulator + renamed-vars gathering-env)) + acc-info) + (setq realizer (rename-variables realizer renamed-vars + gathering-env)) + (push (cond ((null (cdddr realizer)) + ; Simple (LAMBDA () expr) => + ; expr + (third realizer)) + (t ; There could be declarations + ; or something, so leave as a + ; LET + (cons 'let (cdr realizer)))) + finish-forms) + (unless (null localdecls) + ; Declarations about the LET + ; variables also has to + ; percolate up + (setq top-decls (nconc top-decls (sublis renamed-vars + localdecls)))) + (return)) + (maybe-warn :definition "Couldn't optimize GATHERING clause ~S because its expansion is not of the form (VALUES #'(LAMBDA ...) #'(LAMBDA () ...))" + (second clause)) + punt + (let + ((gs (gensym)) + (expansion `(multiple-value-list ,(second clause)))) + ; Slow way--bind gensym to the + ; macro expansion, and we will + ; funcall it in the body + (push (list acc-var gs) + acc-info) + (push `(funcall (cadr ,gs)) + finish-forms) + (setq + top-bindings + (nconc + top-bindings + (list (list gs (cond (leftover-body + `(progn ,@(prog1 leftover-body + (setq leftover-body nil)) + ,expansion)) + (t expansion)))))))))) + (setq body (walk-gathering-body body gathering-env acc-info)) + (cond ((eq body :abort) + ; Couldn't finish expansion + nil) + (t `(let* ,top-bindings + ,@(and top-decls `((declare ,@top-decls))) + ,body + ,(cond ((null (cdr finish-forms)) + ; just a single value + (car finish-forms)) + (t `(values ,@(reverse finish-forms))))))))) + +(defun rename-and-capture-variables (form alist env) + + ;; Walks FORM, renaming occurrences of the key variables in ALIST with + ;; their corresponding values, and capturing any other free variables. + ;; Returns a list of the new form and the list of other closed-over + ;; vars. ENV is FORM's environment, so we can make sure we are talking + ;; about the same variables. + (let (closed) + (list (walk-form + form env + #'(lambda (form context subenv) + (declare (ignore context)) + (let (pair) + (cond ((or (not (symbolp form)) + (not (variable-same-p form subenv + env))) + ; non-variable or one that has + ; been rebound + form) + ((setq pair (assoc form alist)) + ; One to rename + (cdr pair)) + (t ; var is free + (pushnew form closed) + form))))) + closed))) + +(defun + walk-gathering-body + (body gathering-env acc-info) + + ;; Walk the body of (GATHERING (...) . BODY) in environment GATHERING-ENV. + ;; ACC-INFO is a list of information about each of the gathering "bindings" + ;; in the form, in the form (var gatheringfn freevars env) + (let + ((*active-gatherers* (nconc (mapcar #'car acc-info) + *active-gatherers*))) + + ;; *ACTIVE-GATHERERS* tells us what vars are currently legal as GATHER + ;; targets. This is so that when we encounter a GATHER not belonging to us + ;; we can know whether to warn about it. + (walk-form + (cons 'progn body) + gathering-env + #'(lambda + (form context env) + (declare (ignore context)) + (let (info site) + (cond ((consp form) + (cond + ((not (eq (car form) + 'gather)) + ; We only care about GATHER + (when (and (eq (car form) + 'function) + (eq (cadr form) + 'gather)) + ; Passed as functional--can't + ; macroexpand + (maybe-warn :user + "Can't optimize GATHERING because of reference to #'GATHER." + ) + (return-from walk-gathering-body :abort)) + form) + ((setq info (assoc (setq site (if (null (cddr form)) + + ' + *anonymous-gathering-site* + (third form))) + acc-info)) + ; One of ours--expand (GATHER + ; value var). INFO = (var + ; gatheringfn freevars env) + (unless (null (cdddr form)) + (warn "Extra arguments (> 2) in ~S discarded." form) + ) + (let ((fn (second info))) + (cond ((symbolp fn) + ; Unoptimized case--just call + ; the gatherer. FN is the + ; gensym that we bound to the + ; list of two values returned + ; from the gatherer. + `(funcall (car ,fn) + ,(second form))) + (t ; FN = (lambda (value) ...) + (dolist (s (third info)) + (unless (or (variable-same-p s env + gathering-env) + (and (variable-special-p + s env) + (variable-special-p + s gathering-env))) + + + ;; Some var used free in the LAMBDA form has been + ;; rebound between here and the parent GATHERING + ;; form, so can't substitute the lambda. Ok if it's + ;; a special reference both here and in the LAMBDA, + ;; because then it's not closed over. + (maybe-warn :user "Can't optimize GATHERING because the expansion closes over the variable ~S, which is rebound around a GATHER for it." + s) + (return-from walk-gathering-body + :abort))) + + + ;; Return ((lambda (value) ...) actual-value). In + ;; many cases we could simplify this further by + ;; substitution, but we'd have to be careful (for + ;; example, we would need to alpha-convert any LET + ;; we found inside). Any decent compiler will do it + ;; for us. + (list fn (second form)))))) + ((and (setq info (member site *active-gatherers*)) + (or (eq site '*anonymous-gathering-site*) + (variable-same-p site env (fourth info)))) + ; Some other GATHERING will + ; take care of this form, so + ; pass it up for now. + ; Environment check is to make + ; sure nobody shadowed it + ; between here and there + form) + (t ; Nobody's going to handle it + (if (eq site '*anonymous-gathering-site*) + ; More likely that she forgot + ; to mention the site than + ; forget to write an anonymous + ; gathering. + (warn "There is no gathering site specified in ~S." + form) + (warn + "The site ~S in ~S is not defined in an enclosing GATHERING form." + site form)) + ; Turn it into something else + ; so we don't warn twice in the + ; nested case + `(%orphaned-gather ,@(cdr form))))) + ((and (symbolp form) + (setq info (assoc form acc-info)) + (variable-same-p form env gathering-env)) + ; A variable reference to a + ; gather binding from + ; environment TEM + (maybe-warn :user "Can't optimize GATHERING because site variable ~S is used outside of a GATHER form." + form) + (return-from walk-gathering-body :abort)) + (t form))))))) + + +;; Sample gatherers + + +(defmacro + collecting + (&key initial-value) + `(let* ((head ,initial-value) + (tail ,(and initial-value `(last head)))) + (values #'(lambda (value) + (if (null head) + (setq head (setq tail (list value))) + (setq tail (cdr (rplacd tail (list value)))))) + #'(lambda nil head)))) + +(defmacro joining (&key initial-value) + `(let ((result ,initial-value)) + (values #'(lambda (value) + (setq result (nconc result value))) + #'(lambda nil result)))) + +(defmacro + maximizing + (&key initial-value) + `(let ((result ,initial-value)) + (values + #'(lambda (value) + (when ,(cond ((and (constantp initial-value) + (not (null (eval initial-value)))) + ; Initial value is given and we + ; know it's not NIL, so leave + ; out the null check + '(> value result)) + (t '(or (null result) + (> value result)))) + (setq result value))) + #'(lambda nil result)))) + +(defmacro + minimizing + (&key initial-value) + `(let ((result ,initial-value)) + (values + #'(lambda (value) + (when ,(cond ((and (constantp initial-value) + (not (null (eval initial-value)))) + ; Initial value is given and we + ; know it's not NIL, so leave + ; out the null check + '(< value result)) + (t '(or (null result) + (< value result)))) + (setq result value))) + #'(lambda nil result)))) + +(defmacro summing (&key (initial-value 0)) + `(let ((sum ,initial-value)) + (values #'(lambda (value) + (setq sum (+ sum value))) + #'(lambda nil sum)))) + + ; Easier to read expanded code + ; if PROG1 gets left alone + + +(define-walker-template prog1 (nil return walker::repeat (eval))) + diff --git a/pcl/gcl_pcl_low.lisp b/pcl/gcl_pcl_low.lisp new file mode 100644 index 0000000..913fb3b --- /dev/null +++ b/pcl/gcl_pcl_low.lisp @@ -0,0 +1,459 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This file contains portable versions of low-level functions and macros +;;; which are ripe for implementation specific customization. None of the +;;; code in this file *has* to be customized for a particular Common Lisp +;;; implementation. Moreover, in some implementations it may not make any +;;; sense to customize some of this code. +;;; +;;; But, experience suggests that MOST Common Lisp implementors will want +;;; to customize some of the code in this file to make PCL run better in +;;; their implementation. The code in this file has been separated and +;;; heavily commented to make that easier. +;;; +;;; Implementation-specific version of this file already exist for: +;;; +;;; Symbolics Genera family genera-low.lisp +;;; Lucid Lisp lucid-low.lisp +;;; Xerox 1100 family xerox-low.lisp +;;; ExCL (Franz) excl-low.lisp +;;; Kyoto Common Lisp kcl-low.lisp +;;; Vaxlisp vaxl-low.lisp +;;; CMU Lisp cmu-low.lisp +;;; H.P. Common Lisp hp-low.lisp +;;; Golden Common Lisp gold-low.lisp +;;; Ti Explorer ti-low.lisp +;;; +;;; +;;; These implementation-specific files are loaded after this file. Because +;;; none of the macros defined by this file are used in functions defined by +;;; this file the implementation-specific files can just contain the parts of +;;; this file they want to change. They don't have to copy this whole file +;;; and then change the parts they want. +;;; +;;; If you make changes or improvements to these files, or if you need some +;;; low-level part of PCL re-modularized to make it more portable to your +;;; system please send mail to CommonLoops.pa@Xerox.com. +;;; +;;; Thanks. +;;; + +(in-package :pcl) + +(eval-when (compile load eval) +(defvar *optimize-speed* '(optimize (speed 3) (safety 0))) +) + +(defmacro %svref (vector index) + `(locally (declare #.*optimize-speed* + (inline svref)) + (svref (the simple-vector ,vector) (the fixnum ,index)))) + +(defsetf %svref %set-svref) + +(defmacro %set-svref (vector index new-value) + `(locally (declare #.*optimize-speed* + (inline svref)) + (setf (svref (the simple-vector ,vector) (the fixnum ,index)) + ,new-value))) + + +;;; +;;; without-interrupts +;;; +;;; OK, Common Lisp doesn't have this and for good reason. But For all of +;;; the Common Lisp's that PCL runs on today, there is a meaningful way to +;;; implement this. WHAT I MEAN IS: +;;; +;;; I want the body to be evaluated in such a way that no other code that is +;;; running PCL can be run during that evaluation. I agree that the body +;;; won't take *long* to evaluate. That is to say that I will only use +;;; without interrupts around relatively small computations. +;;; +;;; INTERRUPTS-ON should turn interrupts back on if they were on. +;;; INTERRUPTS-OFF should turn interrupts back off. +;;; These are only valid inside the body of WITHOUT-INTERRUPTS. +;;; +;;; OK? +;;; +(defmacro without-interrupts (&body body) + `(macrolet ((interrupts-on () ()) + (interrupts-off () ())) + (progn ,.body))) + + +;;; +;;; Very Low-Level representation of instances with meta-class standard-class. +;;; +#-new-kcl-wrapper +(progn +#-cmu17 +(defstruct (std-instance (:predicate std-instance-p) + (:conc-name %std-instance-) + (:constructor %%allocate-instance--class ()) + (:print-function print-std-instance)) + (wrapper nil) + (slots nil)) + +(defmacro %instance-ref (slots index) + `(%svref ,slots ,index)) + +(defmacro instance-ref (slots index) + `(svref ,slots ,index)) +) + +#+new-kcl-wrapper +(progn +(defvar *init-vector* (make-array 40 :fill-pointer 1 :adjustable t + :initial-element nil)) + +(defun get-init-list (i) + (declare (fixnum i)(special *slot-unbound*)) + (loop (when (< i (fill-pointer *init-vector*)) + (return (aref *init-vector* i))) + (vector-push-extend + (cons *slot-unbound* + (aref *init-vector* (1- (fill-pointer *init-vector*)))) + *init-vector*))) + +(defmacro %std-instance-wrapper (instance) + `(structure-def ,instance)) + +(defmacro %std-instance-slots (instance) + instance) + +(defmacro std-instance-p (x) + `(structurep ,x)) +) + +(defmacro std-instance-wrapper (x) `(%std-instance-wrapper ,x)) +(defmacro std-instance-slots (x) `(%std-instance-slots ,x)) + +(defmacro get-wrapper (inst) + `(cond ((std-instance-p ,inst) (std-instance-wrapper ,inst)) + ((fsc-instance-p ,inst) (fsc-instance-wrapper ,inst)) + (t (error "What kind of instance is this?")))) + +(defmacro get-instance-wrapper-or-nil (inst) + `(cond ((std-instance-p ,inst) (std-instance-wrapper ,inst)) + ((fsc-instance-p ,inst) (fsc-instance-wrapper ,inst)))) + +(defmacro get-slots (inst) + `(cond ((std-instance-p ,inst) (std-instance-slots ,inst)) + ((fsc-instance-p ,inst) (fsc-instance-slots ,inst)) + (t (error "What kind of instance is this?")))) + +(defmacro get-slots-or-nil (inst) + `(cond ((std-instance-p ,inst) (std-instance-slots ,inst)) + ((fsc-instance-p ,inst) (fsc-instance-slots ,inst)))) + +(defun print-std-instance (instance stream depth) ;A temporary definition used + (declare (ignore depth)) ;for debugging the bootstrap + (printing-random-thing (instance stream) ;code of PCL (See high.lisp). + (let ((class (class-of instance))) + (if (or (eq class (find-class 'standard-class nil)) + (eq class (find-class 'funcallable-standard-class nil)) + (eq class (find-class 'built-in-class nil))) + (format stream "~a ~a" (early-class-name class) + (early-class-name instance)) + (format stream "~a" (early-class-name class)))))) + +;;; +;;; This is the value that we stick into a slot to tell us that it is unbound. +;;; It may seem gross, but for performance reasons, we make this an interned +;;; symbol. That means that the fast check to see if a slot is unbound is to +;;; say (EQ '..SLOT-UNBOUND..). That is considerably faster than looking +;;; at the value of a special variable. Be careful, there are places in the +;;; code which actually use ..slot-unbound.. rather than this variable. So +;;; much for modularity +;;; +(defvar *slot-unbound* '..slot-unbound..) + +(defmacro %allocate-static-slot-storage--class (no-of-slots) + #+new-kcl-wrapper (declare (ignore no-of-slots)) + #-new-kcl-wrapper + `(make-array ,no-of-slots :initial-element *slot-unbound*) + #+new-kcl-wrapper + (error "don't call this")) + +(defmacro std-instance-class (instance) + `(wrapper-class* (std-instance-wrapper ,instance))) + + + ;; +;;;;;; FUNCTION-ARGLIST + ;; +;;; Given something which is functionp, function-arglist should return the +;;; argument list for it. PCL does not count on having this available, but +;;; MAKE-SPECIALIZABLE works much better if it is available. Versions of +;;; function-arglist for each specific port of pcl should be put in the +;;; appropriate xxx-low file. This is what it should look like: +;(defun function-arglist (function) +; ( function)) + +(defun function-pretty-arglist (function) + (declare (ignore function)) + ()) + +(defsetf function-pretty-arglist set-function-pretty-arglist) + +(defun set-function-pretty-arglist (function new-value) + (declare (ignore function)) + new-value) + +;;; +;;; set-function-name +;;; When given a function should give this function the name . +;;; Note that is sometimes a list. Some lisps get the upset +;;; in the tummy when they start thinking about functions which have +;;; lists as names. To deal with that there is set-function-name-intern +;;; which takes a list spec for a function name and turns it into a symbol +;;; if need be. +;;; +;;; When given a funcallable instance, set-function-name MUST side-effect +;;; that FIN to give it the name. When given any other kind of function +;;; set-function-name is allowed to return new function which is the 'same' +;;; except that it has the name. +;;; +;;; In all cases, set-function-name must return the new (or same) function. +;;; +(defun set-function-name (function new-name) + (declare (notinline set-function-name-1 intern-function-name)) + (set-function-name-1 function + (intern-function-name new-name) + new-name)) + +(defun set-function-name-1 (function new-name uninterned-name) + (declare (ignore new-name uninterned-name)) + function) + +(defun intern-function-name (name) + (cond ((symbolp name) name) + ((listp name) + (intern (let ((*package* *the-pcl-package*) + (*print-case* :upcase) + (*print-pretty* nil) + (*print-gensym* 't)) + (format nil "~S" name)) + *the-pcl-package*)))) + + +;;; +;;; COMPILE-LAMBDA +;;; +;;; This is like the Common Lisp function COMPILE. In fact, that is what +;;; it ends up calling. The difference is that it deals with things like +;;; watching out for recursive calls to the compiler or not calling the +;;; compiler in certain cases or allowing the compiler not to be present. +;;; +;;; This starts out with several variables and support functions which +;;; should be conditionalized for any new port of PCL. Note that these +;;; default to reasonable values, many new ports won't need to look at +;;; these values at all. +;;; +;;; *COMPILER-PRESENT-P* NIL means the compiler is not loaded +;;; +;;; *COMPILER-SPEED* one of :FAST :MEDIUM or :SLOW +;;; +;;; *COMPILER-REENTRANT-P* T ==> OK to call compiler recursively +;;; NIL ==> not OK +;;; +;;; function IN-THE-COMPILER-P returns T if in the compiler, NIL otherwise +;;; This is not called if *compiler-reentrant-p* +;;; is T, so it only needs to be implemented for +;;; ports which have non-reentrant compilers. +;;; +;;; +(defvar *compiler-present-p* t) + +(defvar *compiler-speed* + #+(or KCL IBCL GCLisp CMU) :slow + #-(or KCL IBCL GCLisp CMU) :fast) + +(defvar *compiler-reentrant-p* + #+(and (not XKCL) (or KCL IBCL)) nil + #-(and (not XKCL) (or KCL IBCL)) t) + +(defun in-the-compiler-p () + #+(and (not xkcl) (or KCL IBCL))compiler::*compiler-in-use* + #+gclisp (typep (eval '(function (lambda ()))) 'lexical-closure) + ) + +(defvar *compile-lambda-break-p* nil) + +(defun compile-lambda (lambda &optional (desirability :fast)) + (when *compile-lambda-break-p* (break)) + (cond ((null *compiler-present-p*) + (compile-lambda-uncompiled lambda)) + ((and (null *compiler-reentrant-p*) + (in-the-compiler-p)) + (compile-lambda-deferred lambda)) + ((eq desirability :fast) + (compile nil lambda)) + ((and (eq desirability :medium) + (member *compiler-speed* '(:fast :medium))) + (compile nil lambda)) + ((and (eq desirability :slow) + (eq *compiler-speed* ':fast)) + (compile nil lambda)) + (t + (compile-lambda-uncompiled lambda)))) + +(defun compile-lambda-uncompiled (uncompiled) + #'(lambda (&rest args) (apply (coerce uncompiled 'function) args))) + +(defun compile-lambda-deferred (uncompiled) + (let ((function (coerce uncompiled 'function)) + (compiled nil)) + (declare (type (or function null) compiled)) + #'(lambda (&rest args) + (if compiled + (apply compiled args) + (if (in-the-compiler-p) + (apply function args) + (progn (setq compiled (compile nil uncompiled)) + (apply compiled args))))))) + +(defmacro precompile-random-code-segments (&optional system) + `(progn + (eval-when (compile) + (update-dispatch-dfuns) + (compile-iis-functions nil)) + (precompile-function-generators ,system) + (precompile-dfun-constructors ,system) + (precompile-iis-functions ,system) + (eval-when (load) + (compile-iis-functions t)))) + + + +(defun record-definition (type spec &rest args) + (declare (ignore type spec args)) + ()) + +(defun doctor-dfun-for-the-debugger (gf dfun) (declare (ignore gf)) dfun) + +;; From braid.lisp +#-new-kcl-wrapper +(defmacro built-in-or-structure-wrapper (x) + (once-only (x) + (if (structure-functions-exist-p) ; otherwise structurep is too slow for this + `(if (structurep ,x) + (wrapper-for-structure ,x) + (if (symbolp ,x) + (if ,x *the-wrapper-of-symbol* *the-wrapper-of-null*) + (built-in-wrapper-of ,x))) + `(or (and (symbolp ,x) + (if ,x *the-wrapper-of-symbol* *the-wrapper-of-null*)) + (built-in-or-structure-wrapper1 ,x))))) + +#-cmu17 +(defmacro wrapper-of-macro (x) + `(cond ((std-instance-p ,x) + (std-instance-wrapper ,x)) + ((fsc-instance-p ,x) + (fsc-instance-wrapper ,x)) + (t + (#+new-kcl-wrapper built-in-wrapper-of + #-new-kcl-wrapper built-in-or-structure-wrapper + ,x)))) + +#+cmu17 +(defmacro wrapper-of-macro (x) + `(kernel:layout-of ,x)) + +;Low level functions for structures + +;Functions on arbitrary objects + +(defvar *structure-table* (make-hash-table :test 'eq)) + +(defun declare-structure (name included-name slot-description-list) + (setf (gethash name *structure-table*) + (cons included-name slot-description-list))) + +(unless (fboundp 'structure-functions-exist-p) + (setf (symbol-function 'structure-functions-exist-p) + #'(lambda () nil))) + +(defun default-structurep (x) + (structure-type-p (type-of x))) + +(defun default-structure-instance-p (x) + (let ((type (type-of x))) + (and (not (eq type 'std-instance)) + (structure-type-p type)))) + +(defun default-structure-type (x) + (type-of x)) + +(unless (fboundp 'structurep) + (setf (symbol-function 'structurep) #'default-structurep)) + +; excludes std-instance +(unless (fboundp 'structure-instance-p) + (setf (symbol-function 'structure-instance-p) #'default-structure-instance-p)) + +; returns a symbol +(unless (fboundp 'structure-type) + (setf (symbol-function 'structure-type) #'default-structure-type)) + + +;Functions on symbols naming structures + +; Excludes structures types created with the :type option +(defun structure-type-p (symbol) + (not (null (gethash symbol *structure-table*)))) + +(defun structure-type-included-type-name (symbol) + (car (gethash symbol *structure-table*))) + +; direct slots only +; The results of this function are used only by the functions below. +(defun structure-type-slot-description-list (symbol) + (cdr (gethash symbol *structure-table*))) + + +;Functions on slot-descriptions (returned by the function above) + +;returns a symbol +(defun structure-slotd-name (structure-slot-description) + (first structure-slot-description)) + +;returns a symbol +(defun structure-slotd-accessor-symbol (structure-slot-description) + (second structure-slot-description)) + +;returns a symbol or a list or nil +(defun structure-slotd-writer-function (structure-slot-description) + (third structure-slot-description)) + +(defun structure-slotd-type (structure-slot-description) + (fourth structure-slot-description)) + +(defun structure-slotd-init-form (structure-slot-description) + (fifth structure-slot-description)) diff --git a/pcl/gcl_pcl_macros.lisp b/pcl/gcl_pcl_macros.lisp new file mode 100644 index 0000000..26aeb6d --- /dev/null +++ b/pcl/gcl_pcl_macros.lisp @@ -0,0 +1,789 @@ +;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; Macros global variable definitions, and other random support stuff used +;;; by the rest of the system. +;;; +;;; For simplicity (not having to use eval-when a lot), this file must be +;;; loaded before it can be compiled. +;;; + +(in-package :pcl) + +(proclaim '(declaration + #-Genera values ;I use this so that Zwei can remind + ;me what values a function returns. + + #-Genera arglist ;Tells me what the pretty arglist + ;of something (which probably takes + ;&rest args) is. + + #-Genera indentation ;Tells ZWEI how to indent things + ;like defclass. + class + variable-rebinding + pcl-fast-call + method-name + method-lambda-list + )) + +;;; Age old functions which CommonLisp cleaned-up away. They probably exist +;;; in other packages in all CommonLisp implementations, but I will leave it +;;; to the compiler to optimize into calls to them. +;;; +;;; Common Lisp BUG: +;;; Some Common Lisps define these in the Lisp package which causes +;;; all sorts of lossage. Common Lisp should explictly specify which +;;; symbols appear in the Lisp package. +;;; +(eval-when (compile load eval) + +(defmacro memq (item list) `(member ,item ,list :test #'eq)) +(defmacro assq (item list) `(assoc ,item ,list :test #'eq)) +(defmacro rassq (item list) `(rassoc ,item ,list :test #'eq)) +(defmacro delq (item list) `(delete ,item ,list :test #'eq)) +(defmacro posq (item list) `(position ,item ,list :test #'eq)) +(defmacro neq (x y) `(not (eq ,x ,y))) + + +(defun make-caxr (n form) + (if (< n 4) + `(,(nth n '(car cadr caddr cadddr)) ,form) + (make-caxr (- n 4) `(cddddr ,form)))) + +(defun make-cdxr (n form) + (cond ((zerop n) form) + ((< n 5) `(,(nth n '(identity cdr cddr cdddr cddddr)) ,form)) + (t (make-cdxr (- n 4) `(cddddr ,form))))) +) + +(deftype non-negative-fixnum () + '(and fixnum (integer 0 *))) + +(defun true (&rest ignore) (declare (ignore ignore)) t) +(defun false (&rest ignore) (declare (ignore ignore)) nil) +(defun zero (&rest ignore) (declare (ignore ignore)) 0) + +(defun make-plist (keys vals) + (if (null vals) + () + (list* (car keys) + (car vals) + (make-plist (cdr keys) (cdr vals))))) + +(defun remtail (list tail) + (if (eq list tail) () (cons (car list) (remtail (cdr list) tail)))) + +;;; ONCE-ONLY does the same thing as it does in zetalisp. I should have just +;;; lifted it from there but I am honest. Not only that but this one is +;;; written in Common Lisp. I feel a lot like bootstrapping, or maybe more +;;; like rebuilding Rome. +(defmacro once-only (vars &body body) + (let ((gensym-var (gensym)) + (run-time-vars (gensym)) + (run-time-vals (gensym)) + (expand-time-val-forms ())) + (dolist (var vars) + (push `(if (or (symbolp ,var) + (numberp ,var) + (and (listp ,var) + (member (car ,var) '(quote function)))) + ,var + (let ((,gensym-var (gensym))) + (push ,gensym-var ,run-time-vars) + (push ,var ,run-time-vals) + ,gensym-var)) + expand-time-val-forms)) + `(let* (,run-time-vars + ,run-time-vals + (wrapped-body + (let ,(mapcar #'list vars (reverse expand-time-val-forms)) + ,@body))) + `(let ,(mapcar #'list (reverse ,run-time-vars) + (reverse ,run-time-vals)) + ,wrapped-body)))) + +(eval-when (compile load eval) +(defun extract-declarations (body &optional environment) + ;;(declare (values documentation declarations body)) + (let (documentation declarations form) + (when (and (stringp (car body)) + (cdr body)) + (setq documentation (pop body))) + (block outer + (loop + (when (null body) (return-from outer nil)) + (setq form (car body)) + (when (block inner + (loop (cond ((not (listp form)) + (return-from outer nil)) + ((eq (car form) 'declare) + (return-from inner 't)) + (t + (multiple-value-bind (newform macrop) + (macroexpand-1 form environment) + (if (or (not (eq newform form)) macrop) + (setq form newform) + (return-from outer nil))))))) + (pop body) + (dolist (declaration (cdr form)) + (push declaration declarations))))) + (values documentation + (and declarations `((declare ,.(nreverse declarations)))) + body))) +) + +(defun get-declaration (name declarations &optional default) + (dolist (d declarations default) + (dolist (form (cdr d)) + (when (and (consp form) (eq (car form) name)) + (return-from get-declaration (cdr form)))))) + + +#+Lucid +(eval-when (compile load eval) + (eval `(defstruct ,(intern "FASLESCAPE" (find-package 'lucid))))) + +(defvar *keyword-package* (find-package 'keyword)) + +(defun make-keyword (symbol) + (intern (symbol-name symbol) *keyword-package*)) + +(eval-when (compile load eval) + +(defun string-append (&rest strings) + (setq strings (copy-list strings)) ;The explorer can't even + ;rplaca an &rest arg? + (do ((string-loc strings (cdr string-loc))) + ((null string-loc) + (apply #'concatenate 'string strings)) + (rplaca string-loc (string (car string-loc))))) +) + +(defun symbol-append (sym1 sym2 &optional (package *package*)) + (intern (string-append sym1 sym2) package)) + +(defmacro check-member (place list &key (test #'eql) (pretty-name place)) + (once-only (place list) + `(or (member ,place ,list :test ,test) + (error "The value of ~A, ~S is not one of ~S." + ',pretty-name ,place ,list)))) + +(defmacro alist-entry (alist key make-entry-fn) + (once-only (alist key) + `(or (assq ,key ,alist) + (progn (setf ,alist (cons (,make-entry-fn ,key) ,alist)) + (car ,alist))))) + +;;; A simple version of destructuring-bind. + +;;; This does no more error checking than CAR and CDR themselves do. Some +;;; attempt is made to be smart about preserving intermediate values. It +;;; could be better, although the only remaining case should be easy for +;;; the compiler to spot since it compiles to PUSH POP. +;;; +;;; Common Lisp BUG: +;;; Common Lisp should have destructuring-bind. +;;; +;#-gcl +; FIXME use regular destructuring-bind +(defmacro pcl-destructuring-bind (pattern form &body body) + (multiple-value-bind (ignore declares body) + (extract-declarations body) + (declare (ignore ignore)) + (multiple-value-bind (setqs binds) + (destructure pattern form) + `(let ,binds + ,@declares + ,@setqs + (progn .destructure-form.) + . ,body)))) + +(eval-when (compile load eval) +(defun destructure (pattern form) + ;;(declare (values setqs binds)) + (let ((*destructure-vars* ()) + (setqs ())) + (declare (special *destructure-vars*)) + (setq *destructure-vars* '(.destructure-form.) + setqs (list `(setq .destructure-form. ,form)) + form '.destructure-form.) + (values (nconc setqs (nreverse (destructure-internal pattern form))) + (delete nil *destructure-vars*)))) + +(defun destructure-internal (pattern form) + ;; When we are called, pattern must be a list. Form should be a symbol + ;; which we are free to setq containing the value to be destructured. + ;; Optimizations are performed for the last element of pattern cases. + ;; we assume that the compiler is smart about gensyms which are bound + ;; but only for a short period of time. + (declare (special *destructure-vars*)) + (let ((gensym (gensym)) + (pending-pops 0) + (var nil) + (setqs ())) + (labels + ((make-pop (var form pop-into) + (prog1 + (cond ((zerop pending-pops) + `(progn ,(and var `(setq ,var (car ,form))) + ,(and pop-into `(setq ,pop-into (cdr ,form))))) + ((null pop-into) + (and var `(setq ,var ,(make-caxr pending-pops form)))) + (t + `(progn (setq ,pop-into ,(make-cdxr pending-pops form)) + ,(and var `(setq ,var (pop ,pop-into)))))) + (setq pending-pops 0)))) + (do ((pat pattern (cdr pat))) + ((null pat) ()) + (if (symbolp (setq var (car pat))) + (progn + #-:coral (unless (memq var '(nil ignore)) + (push var *destructure-vars*)) + #+:coral (push var *destructure-vars*) + (cond ((null (cdr pat)) + (push (make-pop var form ()) setqs)) + ((symbolp (cdr pat)) + (push (make-pop var form (cdr pat)) setqs) + (push (cdr pat) *destructure-vars*) + (return ())) + #-:coral + ((memq var '(nil ignore)) (incf pending-pops)) + #-:coral + ((memq (cadr pat) '(nil ignore)) + (push (make-pop var form ()) setqs) + (incf pending-pops 1)) + (t + (push (make-pop var form form) setqs)))) + (progn + (push `(let ((,gensym ())) + ,(make-pop gensym + form + (if (symbolp (cdr pat)) (cdr pat) form)) + ,@(nreverse + (destructure-internal + (if (consp pat) (car pat) pat) + gensym))) + setqs) + (when (symbolp (cdr pat)) + (push (cdr pat) *destructure-vars*) + (return))))) + setqs))) +) + + +(defmacro collecting-once (&key initial-value) + `(let* ((head ,initial-value) + (tail ,(and initial-value `(last head)))) + (values #'(lambda (value) + (if (null head) + (setq head (setq tail (list value))) + (unless (memq value head) + (setq tail + (cdr (rplacd tail (list value))))))) + #'(lambda nil head)))) + +(defmacro doplist ((key val) plist &body body &environment env) + (multiple-value-bind (doc decls bod) + (extract-declarations body env) + (declare (ignore doc)) + `(let ((.plist-tail. ,plist) ,key ,val) + ,@decls + (loop (when (null .plist-tail.) (return nil)) + (setq ,key (pop .plist-tail.)) + (when (null .plist-tail.) + (error "Malformed plist in doplist, odd number of elements.")) + (setq ,val (pop .plist-tail.)) + (progn ,@bod))))) + +(defmacro if* (condition true &rest false) + `(if ,condition ,true (progn ,@false))) + +(defmacro dolist-carefully ((var list improper-list-handler) &body body) + `(let ((,var nil) + (.dolist-carefully. ,list)) + (loop (when (null .dolist-carefully.) (return nil)) + (if (consp .dolist-carefully.) + (progn + (setq ,var (pop .dolist-carefully.)) + ,@body) + (,improper-list-handler))))) + + ;; +;;;;;; printing-random-thing + ;; +;;; Similar to printing-random-object in the lisp machine but much simpler +;;; and machine independent. +(defmacro printing-random-thing ((thing stream) &body body) + #+cmu17 + `(print-unreadable-object (,thing ,stream :identity t) ,@body) + #-cmu17 + (once-only (thing stream) + `(progn + #+cmu + (when *print-readably* + (error "~S cannot be printed readably." ,thing)) + (format ,stream "#<") + ,@body + (format ,stream " ") + (printing-random-thing-internal ,thing ,stream) + (format ,stream ">")))) + +(defun printing-random-thing-internal (thing stream) + (declare (ignore thing stream)) + nil) + + ;; +;;;;;; + ;; + +(defun capitalize-words (string &optional (dashes-p t)) + (let ((string (copy-seq (string string)))) + (declare (string string)) + (do* ((flag t flag) + (length (length string) length) + (char nil char) + (i 0 (+ i 1))) + ((= i length) string) + (setq char (elt string i)) + (cond ((both-case-p char) + (if flag + (and (setq flag (lower-case-p char)) + (setf (elt string i) (char-upcase char))) + (and (not flag) (setf (elt string i) (char-downcase char)))) + (setq flag nil)) + ((char-equal char #\-) + (setq flag t) + (unless dashes-p (setf (elt string i) #\space))) + (t (setq flag nil)))))) + +#-(or lucid kcl) +(eval-when (compile load eval) +;(warn "****** Things will go faster if you fix define-compiler-macro") +) + +#-(or cmu gcl) +(defmacro define-compiler-macro (name arglist &body body) + #+(or lucid kcl) + `(#+lucid lcl:def-compiler-macro #+kcl si::define-compiler-macro + ,name ,arglist + ,@body) + #-(or kcl lucid) + (declare (ignore name arglist body)) + #-(or kcl lucid) + nil) + + +;;; +;;; FIND-CLASS +;;; +;;; This is documented in the CLOS specification. +;;; +(defvar *find-class* (make-hash-table :test #'eq)) + +(defun make-constant-function (value) + #'(lambda (object) + (declare (ignore object)) + value)) + +(defun function-returning-nil (x) + (declare (ignore x)) + nil) + +(defun function-returning-t (x) + (declare (ignore x)) + t) + +(defmacro find-class-cell-class (cell) + `(car ,cell)) + +(defmacro find-class-cell-predicate (cell) + `(cadr ,cell)) + +(defmacro find-class-cell-make-instance-function-keys (cell) + `(cddr ,cell)) + +(defmacro make-find-class-cell (class-name) + (declare (ignore class-name)) + '(list* nil #'function-returning-nil nil)) + +(defun find-class-cell (symbol &optional dont-create-p) + (or (gethash symbol *find-class*) + (unless dont-create-p + (unless (legal-class-name-p symbol) + (error "~S is not a legal class name." symbol)) + (setf (gethash symbol *find-class*) (make-find-class-cell symbol))))) + +(defvar *create-classes-from-internal-structure-definitions-p* t) + +(defun find-class-from-cell (symbol cell &optional (errorp t)) + (or (find-class-cell-class cell) + (and *create-classes-from-internal-structure-definitions-p* + (structure-type-p symbol) + (find-structure-class symbol)) + (cond ((null errorp) nil) + ((legal-class-name-p symbol) + (error "No class named: ~S." symbol)) + (t + (error "~S is not a legal class name." symbol))))) + +(defun find-class-predicate-from-cell (symbol cell &optional (errorp t)) + (unless (find-class-cell-class cell) + (find-class-from-cell symbol cell errorp)) + (find-class-cell-predicate cell)) + +(defun legal-class-name-p (x) + (and (symbolp x) + (not (keywordp x)))) + +(defun find-class (symbol &optional (errorp t) environment) + (declare (ignore environment)) + (find-class-from-cell + symbol (find-class-cell symbol errorp) errorp)) + +(defun find-class-predicate (symbol &optional (errorp t) environment) + (declare (ignore environment)) + (find-class-predicate-from-cell + symbol (find-class-cell symbol errorp) errorp)) + +(defvar *boot-state* nil) ; duplicate defvar to defs.lisp + +; Use this definition in any CL implementation supporting +; both define-compiler-macro and load-time-value. +#+cmu ; Note that in CMU, lisp:find-class /= pcl:find-class +(define-compiler-macro find-class (&whole form + symbol &optional (errorp t) environment) + (declare (ignore environment)) + (if (and (constantp symbol) + (legal-class-name-p (eval symbol)) + (constantp errorp) + (member *boot-state* '(braid complete))) + (let ((symbol (eval symbol)) + (errorp (not (null (eval errorp)))) + (class-cell (make-symbol "CLASS-CELL"))) + `(let ((,class-cell (load-time-value (find-class-cell ',symbol)))) + (or (find-class-cell-class ,class-cell) + #-cmu17 + (find-class-from-cell ',symbol ,class-cell ,errorp) + #+cmu17 + ,(if errorp + `(find-class-from-cell ',symbol ,class-cell t) + `(and (kernel:class-cell-class + ',(kernel:find-class-cell symbol)) + (find-class-from-cell ',symbol ,class-cell nil)))))) + form)) + +#-setf +(defsetf find-class (symbol &optional (errorp t) environment) (new-value) + (declare (ignore errorp environment)) + `(SETF\ PCL\ FIND-CLASS ,new-value ,symbol)) + +(defun #-setf SETF\ PCL\ FIND-CLASS #+setf (setf find-class) (new-value symbol) + (if (legal-class-name-p symbol) + (let ((cell (find-class-cell symbol))) + (setf (find-class-cell-class cell) new-value) + (when (or (eq *boot-state* 'complete) + (eq *boot-state* 'braid)) + #+cmu17 + (let ((lclass (kernel:layout-class (class-wrapper new-value)))) + (setf (lisp:class-name lclass) (class-name new-value)) + (unless (eq (lisp:find-class symbol nil) lclass) + (setf (lisp:find-class symbol) lclass))) + + (setf (find-class-cell-predicate cell) + (symbol-function (class-predicate-name new-value))) + (when (and new-value (not (forward-referenced-class-p new-value))) + + (dolist (keys+aok (find-class-cell-make-instance-function-keys cell)) + (update-initialize-info-internal + (initialize-info new-value (car keys+aok) nil (cdr keys+aok)) + 'make-instance-function))))) + (error "~S is not a legal class name." symbol))) + +#-setf +(defsetf find-class-predicate (symbol &optional (errorp t) environment) (new-value) + (declare (ignore errorp environment)) + `(SETF\ PCL\ FIND-CLASS-PREDICATE ,new-value ,symbol)) + +(defun #-setf SETF\ PCL\ FIND-CLASS-PREDICATE #+setf (setf find-class-predicate) + (new-value symbol) + (if (legal-class-name-p symbol) + (setf (find-class-cell-predicate (find-class-cell symbol)) new-value) + (error "~S is not a legal class name." symbol))) + +(defun find-wrapper (symbol) + (class-wrapper (find-class symbol))) + +#|| ; Anything that used this should use eval instead. +(defun reduce-constant (old) + (let ((new (eval old))) + (if (eq new old) + new + (if (constantp new) + (reduce-constant new) + new)))) +||# + +(defmacro gathering1 (gatherer &body body) + `(gathering ((.gathering1. ,gatherer)) + (macrolet ((gather1 (x) `(gather ,x .gathering1.))) + ,@body))) + +;;; +;;; +;;; +(defmacro vectorizing (&key (size 0)) + `(let* ((limit ,size) + (result (make-array limit)) + (index 0)) + (values #'(lambda (value) + (if (= index limit) + (error "vectorizing more elements than promised.") + (progn + (setf (svref result index) value) + (incf index) + value))) + #'(lambda () result)))) + +;;; +;;; These are augmented definitions of list-elements and list-tails from +;;; iterate.lisp. These versions provide the extra :by keyword which can +;;; be used to specify the step function through the list. +;;; +(defmacro *list-elements (list &key (by #'cdr)) + `(let ((tail ,list)) + #'(lambda (finish) + (if (endp tail) + (funcall finish) + (prog1 (car tail) + (setq tail (funcall ,by tail))))))) + +(defmacro *list-tails (list &key (by #'cdr)) + `(let ((tail ,list)) + #'(lambda (finish) + (prog1 (if (endp tail) + (funcall finish) + tail) + (setq tail (funcall ,by tail)))))) + +(defmacro function-funcall (form &rest args) + #-cmu `(funcall ,form ,@args) + #+cmu `(funcall (the function ,form) ,@args)) + +(defmacro function-apply (form &rest args) + #-cmu `(apply ,form ,@args) + #+cmu `(apply (the function ,form) ,@args)) + + +;;; +;;; Convert a function name to its standard setf function name. We have to +;;; do this hack because not all Common Lisps have yet converted to having +;;; setf function specs. +;;; +;;; In a port that does have setf function specs you can use those just by +;;; making the obvious simple changes to these functions. The rest of PCL +;;; believes that there are function names like (SETF ), this is the +;;; only place that knows about this hack. +;;; +(eval-when (compile load eval) +; In 15e (and also 16c), using the built in setf mechanism costs +; a hash table lookup every time a setf function is called. +; Uncomment the next line to use the built in setf mechanism. +;#+cmu (pushnew :setf *features*) +) + +(eval-when (compile load eval) + +#-setf +(defvar *setf-function-names* (make-hash-table :size 200 :test #'eq)) + +(defun get-setf-function-name (name) + #+setf `(setf ,name) + #-setf + (or (gethash name *setf-function-names*) + (setf (gethash name *setf-function-names*) + (let ((pkg (symbol-package name))) + (if pkg + (intern (format nil + "SETF ~A ~A" + (package-name pkg) + (symbol-name name)) + *the-pcl-package*) + (make-symbol (format nil "SETF ~A" (symbol-name name)))))))) + +;;; +;;; Call this to define a setf macro for a function with the same behavior as +;;; specified by the SETF function cleanup proposal. Specifically, this will +;;; cause: (SETF (FOO a b) x) to expand to (|SETF FOO| x a b). +;;; +;;; do-standard-defsetf A macro interface for use at top level +;;; in files. Unfortunately, users may +;;; have to use this for a while. +;;; +;;; do-standard-defsetfs-for-defclass A special version called by defclass. +;;; +;;; do-standard-defsetf-1 A functional interface called by the +;;; above, defmethod and defgeneric. +;;; Since this is all a crock anyways, +;;; users are free to call this as well. +;;; +(defmacro do-standard-defsetf (&rest function-names) + `(eval-when (compile load eval) + (dolist (fn-name ',function-names) (do-standard-defsetf-1 fn-name)))) + +(defun do-standard-defsetfs-for-defclass (accessors) + (dolist (name accessors) (do-standard-defsetf-1 name))) + +(defun do-standard-defsetf-1 (function-name) + #+setf + (declare (ignore function-name)) + #+setf nil + #-setf + (unless (and (setfboundp function-name) + (get function-name 'standard-setf)) + (setf (get function-name 'standard-setf) t) + (let* ((setf-function-name (get-setf-function-name function-name))) + + #+Genera + (let ((fn #'(lambda (form) + (lt::help-defsetf + '(&rest accessor-args) '(new-value) function-name 'nil + `(`(,',setf-function-name ,new-value .,accessor-args)) + form)))) + (setf (get function-name 'lt::setf-method) fn + (get function-name 'lt::setf-method-internal) fn)) + + #+Lucid + (lucid::set-simple-setf-method + function-name + #'(lambda (form new-value) + (let* ((bindings (mapcar #'(lambda (x) `(,(gensym) ,x)) + (cdr form))) + (vars (mapcar #'car bindings))) + ;; This may wrap spurious LET bindings around some form, + ;; but the PQC compiler will unwrap then. + `(LET (,.bindings) + (,setf-function-name ,new-value . ,vars))))) + + #+kcl + (let ((helper (gensym))) + (setf (macro-function helper) + #'(lambda (form env) + (declare (ignore env)) + (let* ((loc-args (butlast (cdr form))) + (bindings (mapcar #'(lambda (x) `(,(gensym) ,x)) loc-args)) + (vars (mapcar #'car bindings))) + `(let ,bindings + (,setf-function-name ,(car (last form)) ,@vars))))) + (eval `(defsetf ,function-name ,helper))) + #+Xerox + (flet ((setf-expander (body env) + (declare (ignore env)) + (let ((temps + (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) + (cdr body))) + (forms (cdr body)) + (vars (list (gensym)))) + (values temps + forms + vars + `(,setf-function-name ,@vars ,@temps) + `(,function-name ,@temps))))) + (let ((setf-method-expander (intern (concatenate 'string + (symbol-name function-name) + "-setf-expander") + (symbol-package function-name)))) + (setf (get function-name :setf-method-expander) setf-method-expander + (symbol-function setf-method-expander) #'setf-expander))) + + #-(or Genera Lucid kcl Xerox) + (eval `(defsetf ,function-name (&rest accessor-args) (new-value) + (let* ((bindings (mapcar #'(lambda (x) `(,(gensym) ,x)) accessor-args)) + (vars (mapcar #'car bindings))) + `(let ,bindings + (,',setf-function-name ,new-value ,@vars))))) + + ))) + +(defun setfboundp (symbol) + #+Genera (not (null (get-properties (symbol-plist symbol) + 'lt::(derived-setf-function trivial-setf-method + setf-equivalence setf-method)))) + #+Lucid (locally + (declare (special lucid::*setf-inverse-table* + lucid::*simple-setf-method-table* + lucid::*setf-method-expander-table*)) + (or (gethash symbol lucid::*setf-inverse-table*) + (gethash symbol lucid::*simple-setf-method-table*) + (gethash symbol lucid::*setf-method-expander-table*))) + #+kcl (or (get symbol 'si::setf-method) + (get symbol 'si::setf-update-fn) + (get symbol 'si::setf-lambda)) + #+Xerox (or (get symbol :setf-inverse) + (get symbol 'il:setf-inverse) + (get symbol 'il:setfn) + (get symbol :shared-setf-inverse) + (get symbol :setf-method-expander) + (get symbol 'il:setf-method-expander)) + #+:coral (or (get symbol 'ccl::setf-inverse) + (get symbol 'ccl::setf-method-expander)) + #+cmu (fboundp `(setf ,symbol)) + #-(or Genera Lucid KCL Xerox :coral cmu) nil) + +);eval-when + + +;;; +;;; PCL, like user code, must endure the fact that we don't have a properly +;;; working setf. Many things work because they get mentioned by a defclass +;;; or defmethod before they are used, but others have to be done by hand. +;;; +(do-standard-defsetf + class-wrapper ;*** + generic-function-name + method-function-plist + method-function-get + plist-value + object-plist + gdefinition + slot-value-using-class + ) + +(defsetf slot-value set-slot-value) + +(defvar *redefined-functions* nil) + +(defmacro original-definition (name) + `(get ,name 'definition-before-pcl)) + +(defun redefine-function (name new) + (pushnew name *redefined-functions*) + (unless (original-definition name) + (setf (original-definition name) + (symbol-function name))) + (setf (symbol-function name) + (symbol-function new))) + diff --git a/pcl/gcl_pcl_methods.lisp b/pcl/gcl_pcl_methods.lisp new file mode 100644 index 0000000..b15c651 --- /dev/null +++ b/pcl/gcl_pcl_methods.lisp @@ -0,0 +1,1647 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(defmethod print-object (instance stream) + (printing-random-thing (instance stream) + (let ((name (class-name (class-of instance)))) + (if name + (format stream "~S" name) + (format stream "Instance"))))) + +(defmethod print-object ((class class) stream) + (named-object-print-function class stream)) + +(defmethod print-object ((slotd slot-definition) stream) + (named-object-print-function slotd stream)) + +(defun named-object-print-function (instance stream + &optional (extra nil extra-p)) + (printing-random-thing (instance stream) + (if extra-p + (format stream "~A ~S ~:S" + (capitalize-words (class-name (class-of instance))) + (slot-value-or-default instance 'name) + extra) + (format stream "~A ~S" + (capitalize-words (class-name (class-of instance))) + (slot-value-or-default instance 'name))))) + +(defmethod print-object ((mc standard-method-combination) stream) + (printing-random-thing (mc stream) + (format stream + "Method-Combination ~S ~S" + (slot-value-or-default mc 'type) + (slot-value-or-default mc 'options)))) + + +;;; +;;; +;;; +(defmethod shared-initialize :after ((slotd standard-slot-definition) slot-names &key) + (declare (ignore slot-names)) + (with-slots (allocation class) + slotd + (setq allocation (if (eq allocation :class) class allocation)))) + +(defmethod shared-initialize :after ((slotd structure-slot-definition) slot-names + &key (allocation :instance)) + (declare (ignore slot-names)) + (unless (eq allocation :instance) + (error "structure slots must have :instance allocation"))) + +(defmethod inform-type-system-about-class ((class structure-class) (name t)) + nil) + +;;; +;;; METHODS +;;; +;;; Methods themselves are simple inanimate objects. Most properties of +;;; methods are immutable, methods cannot be reinitialized. The following +;;; properties of methods can be changed: +;;; METHOD-GENERIC-FUNCTION +;;; METHOD-FUNCTION ?? +;;; +;;; + +(defmethod method-function ((method standard-method)) + (or (slot-value method 'function) + (let ((fmf (slot-value method 'fast-function))) + (unless fmf ; the :before shared-initialize method prevents this + (error "~S doesn't seem to have a method-function" method)) + (setf (slot-value method 'function) + (method-function-from-fast-function fmf))))) + +(defmethod accessor-method-class ((method standard-accessor-method)) + (car (slot-value method 'specializers))) + +(defmethod accessor-method-class ((method standard-writer-method)) + (cadr (slot-value method 'specializers))) + +(defmethod print-object ((method standard-method) stream) + (printing-random-thing (method stream) + (if (slot-boundp method 'generic-function) + (let ((generic-function (method-generic-function method)) + (class-name (capitalize-words (class-name (class-of method))))) + (format stream "~A ~S ~{~S ~}~:S" + class-name + (and generic-function (generic-function-name generic-function)) + (method-qualifiers method) + (unparse-specializers method))) + (call-next-method)))) + +(defmethod print-object ((method standard-accessor-method) stream) + (printing-random-thing (method stream) + (if (slot-boundp method 'generic-function) + (let ((generic-function (method-generic-function method)) + (class-name (capitalize-words (class-name (class-of method))))) + (format stream "~A ~S, slot:~S, ~:S" + class-name + (and generic-function (generic-function-name generic-function)) + (accessor-method-slot-name method) + (unparse-specializers method))) + (call-next-method)))) + +;;; +;;; INITIALIZATION +;;; +;;; Error checking is done in before methods. Because of the simplicity of +;;; standard method objects the standard primary method can fill the slots. +;;; +;;; Methods are not reinitializable. +;;; + +(defmethod reinitialize-instance ((method standard-method) &rest initargs) + (declare (ignore initargs)) + (error "Attempt to reinitialize the method ~S.~%~ + Method objects cannot be reinitialized." + method)) + +(defmethod legal-documentation-p ((object standard-method) x) + (if (or (null x) (stringp x)) + t + "a string or NULL")) + +(defmethod legal-lambda-list-p ((object standard-method) x) + (declare (ignore x)) + t) + +(defmethod legal-method-function-p ((object standard-method) x) + (if (functionp x) + t + "a function")) + +(defmethod legal-qualifiers-p ((object standard-method) x) + (flet ((improper-list () + (return-from legal-qualifiers-p "Is not a proper list."))) + (dolist-carefully (q x improper-list) + (let ((ok (legal-qualifier-p object q))) + (unless (eq ok t) + (return-from legal-qualifiers-p + (format nil "Contains ~S which ~A" q ok))))) + t)) + +(defmethod legal-qualifier-p ((object standard-method) x) + (if (and x (atom x)) + t + "is not a non-null atom")) + +(defmethod legal-slot-name-p ((object standard-method) x) + (cond ((not (symbolp x)) "is not a symbol and so cannot be bound") + ((keywordp x) "is a keyword and so cannot be bound") + ((memq x '(t nil)) "cannot be bound") + ((constantp x) "is a constant and so cannot be bound") + (t t))) + +(defmethod legal-specializers-p ((object standard-method) x) + (flet ((improper-list () + (return-from legal-specializers-p "Is not a proper list."))) + (dolist-carefully (s x improper-list) + (let ((ok (legal-specializer-p object s))) + (unless (eq ok t) + (return-from legal-specializers-p + (format nil "Contains ~S which ~A" s ok))))) + t)) + +(defvar *allow-experimental-specializers-p* nil) + +(defmethod legal-specializer-p ((object standard-method) x) + (if (if *allow-experimental-specializers-p* + (specializerp x) + (or (classp x) + (eql-specializer-p x))) + t + "is neither a class object nor an eql specializer")) + +(defmethod shared-initialize :before ((method standard-method) + slot-names + &key qualifiers + lambda-list + specializers + function + fast-function + documentation) + (declare (ignore slot-names)) + (flet ((lose (initarg value string) + (error "When initializing the method ~S:~%~ + The ~S initialization argument was: ~S.~%~ + which ~A." + method initarg value string))) + (let ((check-qualifiers (legal-qualifiers-p method qualifiers)) + (check-lambda-list (legal-lambda-list-p method lambda-list)) + (check-specializers (legal-specializers-p method specializers)) + (check-function (legal-method-function-p method (or function + fast-function))) + (check-documentation (legal-documentation-p method documentation))) + (unless (eq check-qualifiers t) + (lose :qualifiers qualifiers check-qualifiers)) + (unless (eq check-lambda-list t) + (lose :lambda-list lambda-list check-lambda-list)) + (unless (eq check-specializers t) + (lose :specializers specializers check-specializers)) + (unless (eq check-function t) + (lose :function function check-function)) + (unless (eq check-documentation t) + (lose :documentation documentation check-documentation))))) + +(defmethod shared-initialize :before ((method standard-accessor-method) + slot-names + &key slot-name slot-definition) + (declare (ignore slot-names)) + (unless slot-definition + (let ((legalp (legal-slot-name-p method slot-name))) + (unless (eq legalp t) + (error "The value of the :SLOT-NAME initarg ~A." legalp))))) + +(defmethod shared-initialize :after ((method standard-method) slot-names + &rest initargs + &key qualifiers method-spec plist) + (declare (ignore slot-names method-spec plist)) + (initialize-method-function initargs nil method) + (setf (plist-value method 'qualifiers) qualifiers) + #+ignore + (setf (slot-value method 'closure-generator) + (method-function-closure-generator (slot-value method 'function)))) + +(defmethod shared-initialize :after ((method standard-accessor-method) + slot-names + &key) + (declare (ignore slot-names)) + (with-slots (slot-name slot-definition) + method + (unless slot-definition + (let ((class (accessor-method-class method))) + (when (slot-class-p class) + (setq slot-definition (find slot-name (class-direct-slots class) + :key #'slot-definition-name))))) + (when (and slot-definition (null slot-name)) + (setq slot-name (slot-definition-name slot-definition))))) + +(defmethod method-qualifiers ((method standard-method)) + (plist-value method 'qualifiers)) + + + +(defvar *the-class-generic-function* (find-class 'generic-function)) +(defvar *the-class-standard-generic-function* (find-class 'standard-generic-function)) + + + +(defmethod print-object ((generic-function generic-function) stream) + (named-object-print-function + generic-function + stream + (if (slot-boundp generic-function 'methods) + (list (length (generic-function-methods generic-function))) + "?"))) + +(defmethod shared-initialize :before + ((generic-function standard-generic-function) + slot-names + &key (name nil namep) + (lambda-list () lambda-list-p) + argument-precedence-order + declarations + documentation + (method-class nil method-class-supplied-p) + (method-combination nil method-combination-supplied-p)) + (declare (ignore slot-names + declarations argument-precedence-order documentation + lambda-list lambda-list-p)) + + (when namep + (set-function-name generic-function name)) + + (flet ((initarg-error (initarg value string) + (error "When initializing the generic-function ~S:~%~ + The ~S initialization argument was: ~A.~%~ + It must be ~A." + generic-function initarg value string))) + (cond (method-class-supplied-p + (when (symbolp method-class) + (setq method-class (find-class method-class))) + (unless (and (classp method-class) + (*subtypep (class-eq-specializer method-class) + *the-class-method*)) + (initarg-error :method-class + method-class + "a subclass of the class METHOD")) + (setf (slot-value generic-function 'method-class) method-class)) + ((slot-boundp generic-function 'method-class)) + (t + (initarg-error :method-class + "not supplied" + "a subclass of the class METHOD"))) + (cond (method-combination-supplied-p + (unless (method-combination-p method-combination) + (initarg-error :method-combination + method-combination + "a method combination object"))) + ((slot-boundp generic-function 'method-combination)) + (t + (initarg-error :method-combination + "not supplied" + "a method combination object"))))) + + +#|| +(defmethod reinitialize-instance ((generic-function standard-generic-function) + &rest initargs + &key name + lambda-list + argument-precedence-order + declarations + documentation + method-class + method-combination) + (declare (ignore documentation declarations argument-precedence-order + lambda-list name method-class method-combination)) + (macrolet ((add-initarg (check name slot-name) + `(unless ,check + (push (slot-value generic-function ,slot-name) initargs) + (push ,name initargs)))) +; (add-initarg name :name 'name) +; (add-initarg lambda-list :lambda-list 'lambda-list) +; (add-initarg argument-precedence-order +; :argument-precedence-order +; 'argument-precedence-order) +; (add-initarg declarations :declarations 'declarations) +; (add-initarg documentation :documentation 'documentation) +; (add-initarg method-class :method-class 'method-class) +; (add-initarg method-combination :method-combination 'method-combination) + (apply #'call-next-method generic-function initargs))) +||# + + +;;; +;;; These three are scheduled for demolition. +;;; +(defmethod remove-named-method (generic-function-name argument-specifiers + &optional extra) + (let ((generic-function ()) + (method ())) + (cond ((or (null (fboundp generic-function-name)) + (not (generic-function-p + (setq generic-function + (symbol-function generic-function-name))))) + (error "~S does not name a generic-function." + generic-function-name)) + ((null (setq method (get-method generic-function + extra + (parse-specializers + argument-specifiers) + nil))) + (error "There is no method for the generic-function ~S~%~ + which matches the argument-specifiers ~S." + generic-function + argument-specifiers)) + (t + (remove-method generic-function method))))) + +(defun real-add-named-method (generic-function-name + qualifiers + specializers + lambda-list + &rest other-initargs) + #+copy-&rest-arg (setq other-initargs (copy-list other-initargs)) + ;; What about changing the class of the generic-function if there is + ;; one. Whose job is that anyways. Do we need something kind of + ;; like class-for-redefinition? + (let* ((generic-function + (ensure-generic-function generic-function-name)) + (specs (parse-specializers specializers)) +; (existing (get-method generic-function qualifiers specs nil)) + (proto (method-prototype-for-gf generic-function-name)) + (new (apply #'make-instance (class-of proto) + :qualifiers qualifiers + :specializers specs + :lambda-list lambda-list + other-initargs))) +; (when existing (remove-method generic-function existing)) + (add-method generic-function new))) + + +(defun make-specializable (function-name &key (arglist nil arglistp)) + (cond ((not (null arglistp))) + ((not (fboundp function-name))) + ((fboundp 'function-arglist) + ;; function-arglist exists, get the arglist from it. + (setq arglist (function-arglist function-name))) + (t + (error + "The :arglist argument to make-specializable was not supplied~%~ + and there is no version of FUNCTION-ARGLIST defined for this~%~ + port of Portable CommonLoops.~%~ + You must either define a version of FUNCTION-ARGLIST (which~%~ + should be easy), and send it off to the Portable CommonLoops~%~ + people or you should call make-specializable again with the~%~ + :arglist keyword to specify the arglist."))) + (let ((original (and (fboundp function-name) + (symbol-function function-name))) + (generic-function (make-instance 'standard-generic-function + :name function-name)) + (nrequireds 0)) + (if (generic-function-p original) + original + (progn + (dolist (arg arglist) + (if (memq arg lambda-list-keywords) + (return) + (incf nrequireds))) + (setf (gdefinition function-name) generic-function) + (set-function-name generic-function function-name) + (when arglistp + (setf (gf-pretty-arglist generic-function) arglist)) + (when original + (add-named-method function-name + () + (make-list nrequireds :initial-element 't) + arglist + (list :function + #'(lambda (args next-methods) + (declare (ignore next-methods)) + (apply original args))))) + generic-function)))) + + + +(defun real-get-method (generic-function qualifiers specializers + &optional (errorp t)) + (let ((hit + (dolist (method (generic-function-methods generic-function)) + (when (and (equal qualifiers (method-qualifiers method)) + (every #'same-specializer-p specializers + (method-specializers method))) + (return method))))) + (cond (hit hit) + ((null errorp) nil) + (t + (error "No method on ~S with qualifiers ~:S and specializers ~:S." + generic-function qualifiers specializers))))) + + +;;; +;;; Compute various information about a generic-function's arglist by looking +;;; at the argument lists of the methods. The hair for trying not to use +;;; &rest arguments lives here. +;;; The values returned are: +;;; number-of-required-arguments +;;; the number of required arguments to this generic-function's +;;; discriminating function +;;; &rest-argument-p +;;; whether or not this generic-function's discriminating +;;; function takes an &rest argument. +;;; specialized-argument-positions +;;; a list of the positions of the arguments this generic-function +;;; specializes (e.g. for a classical generic-function this is the +;;; list: (1)). +;;; +(defmethod compute-discriminating-function-arglist-info + ((generic-function standard-generic-function)) + ;;(declare (values number-of-required-arguments &rest-argument-p + ;; specialized-argument-postions)) + (let ((number-required nil) + (restp nil) + (specialized-positions ()) + (methods (generic-function-methods generic-function))) + (dolist (method methods) + (multiple-value-setq (number-required restp specialized-positions) + (compute-discriminating-function-arglist-info-internal + generic-function method number-required restp specialized-positions))) + (values number-required restp (sort specialized-positions #'<)))) + +(defun compute-discriminating-function-arglist-info-internal + (generic-function method number-of-requireds restp + specialized-argument-positions) + (declare (ignore generic-function) (type (or null fixnum) number-of-requireds)) + (let ((requireds 0)) + (declare (fixnum requireds)) + ;; Go through this methods arguments seeing how many are required, + ;; and whether there is an &rest argument. + (dolist (arg (method-lambda-list method)) + (cond ((eq arg '&aux) (return)) + ((memq arg '(&optional &rest &key)) + (return (setq restp t))) + ((memq arg lambda-list-keywords)) + (t (incf requireds)))) + ;; Now go through this method's type specifiers to see which + ;; argument positions are type specified. Treat T specially + ;; in the usual sort of way. For efficiency don't bother to + ;; keep specialized-argument-positions sorted, rather depend + ;; on our caller to do that. + (iterate ((type-spec (list-elements (method-specializers method))) + (pos (interval :from 0))) + (unless (eq type-spec *the-class-t*) + (pushnew pos specialized-argument-positions))) + ;; Finally merge the values for this method into the values + ;; for the exisiting methods and return them. Note that if + ;; num-of-requireds is NIL it means this is the first method + ;; and we depend on that. + (values (min (or number-of-requireds requireds) requireds) + (or restp + (and number-of-requireds (/= number-of-requireds requireds))) + specialized-argument-positions))) + +(defun make-discriminating-function-arglist (number-required-arguments restp) + (nconc (gathering ((args (collecting))) + (iterate ((i (interval :from 0 :below number-required-arguments))) + (gather (intern (format nil "Discriminating Function Arg ~D" i)) + args))) + (when restp + `(&rest ,(intern "Discriminating Function &rest Arg"))))) + + +;;; +;;; +;;; + +(defmethod generic-function-lambda-list ((gf generic-function)) + (gf-lambda-list gf)) + +(defmethod gf-fast-method-function-p ((gf standard-generic-function)) + (gf-info-fast-mf-p (slot-value gf 'arg-info))) + +(defmethod initialize-instance :after ((gf standard-generic-function) + &key (lambda-list nil lambda-list-p) + argument-precedence-order) + (with-slots (arg-info) + gf + (if lambda-list-p + (set-arg-info gf + :lambda-list lambda-list + :argument-precedence-order argument-precedence-order) + (set-arg-info gf)) + (when (arg-info-valid-p arg-info) + (update-dfun gf)))) + +(defmethod reinitialize-instance :after ((gf standard-generic-function) + &rest args + &key (lambda-list nil lambda-list-p) + (argument-precedence-order + nil argument-precedence-order-p)) + (with-slots (arg-info) + gf + (if lambda-list-p + (if argument-precedence-order-p + (set-arg-info gf + :lambda-list lambda-list + :argument-precedence-order argument-precedence-order) + (set-arg-info gf + :lambda-list lambda-list)) + (set-arg-info gf)) + (when (and (arg-info-valid-p arg-info) + args + (or lambda-list-p (cddr args))) + (update-dfun gf)))) + +;;; +;;; +;;; + +(proclaim '(special *lazy-dfun-compute-p*)) + +(defun set-methods (gf methods) + (setf (generic-function-methods gf) nil) + (loop (when (null methods) (return gf)) + (real-add-method gf (pop methods) methods))) + +(defun real-add-method (generic-function method &optional skip-dfun-update-p) + (if (method-generic-function method) + (error "The method ~S is already part of the generic~@ + function ~S. It can't be added to another generic~@ + function until it is removed from the first one." + method (method-generic-function method)) + + (let* ((name (generic-function-name generic-function)) + (qualifiers (method-qualifiers method)) + (specializers (method-specializers method)) + (existing (get-method generic-function qualifiers specializers nil))) + ;; + ;; If there is already a method like this one then we must + ;; get rid of it before proceeding. Note that we call the + ;; generic function remove-method to remove it rather than + ;; doing it in some internal way. + ;; + (when existing (remove-method generic-function existing)) + ;; + (setf (method-generic-function method) generic-function) + (pushnew method (generic-function-methods generic-function)) + (dolist (specializer specializers) + (add-direct-method specializer method)) + (set-arg-info generic-function :new-method method) + (unless skip-dfun-update-p + (when (member name + '(make-instance default-initargs + allocate-instance shared-initialize initialize-instance)) + (update-make-instance-function-table (type-class (car specializers)))) + (update-dfun generic-function)) + method))) + +(defun real-remove-method (generic-function method) + (if (neq generic-function (method-generic-function method)) + (error "The method ~S is attached to the generic function~@ + ~S. It can't be removed from the generic function~@ + to which it is not attached." + method (method-generic-function method)) + (let* ((name (generic-function-name generic-function)) + (specializers (method-specializers method)) + (methods (generic-function-methods generic-function)) + (new-methods (remove method methods))) + (setf (method-generic-function method) nil) + (setf (generic-function-methods generic-function) new-methods) + (dolist (specializer (method-specializers method)) + (remove-direct-method specializer method)) + (set-arg-info generic-function) + (when (member name '(make-instance default-initargs + allocate-instance shared-initialize initialize-instance)) + (update-make-instance-function-table (type-class (car specializers)))) + (update-dfun generic-function) + generic-function))) + + +(defun compute-applicable-methods-function (generic-function arguments) + (values (compute-applicable-methods-using-types + generic-function + (types-from-arguments generic-function arguments 'eql)))) + +(defmethod compute-applicable-methods + ((generic-function generic-function) arguments) + (values (compute-applicable-methods-using-types + generic-function + (types-from-arguments generic-function arguments 'eql)))) + +(defmethod compute-applicable-methods-using-classes + ((generic-function generic-function) classes) + (compute-applicable-methods-using-types + generic-function + (types-from-arguments generic-function classes 'class-eq))) + +(defun proclaim-incompatible-superclasses (classes) + (setq classes (mapcar #'(lambda (class) + (if (symbolp class) + (find-class class) + class)) + classes)) + (dolist (class classes) + (dolist (other-class classes) + (unless (eq class other-class) + (pushnew other-class (class-incompatible-superclass-list class)))))) + +(defun superclasses-compatible-p (class1 class2) + (let ((cpl1 (class-precedence-list class1)) + (cpl2 (class-precedence-list class2))) + (dolist (sc1 cpl1 t) + (dolist (ic (class-incompatible-superclass-list sc1)) + (when (memq ic cpl2) + (return-from superclasses-compatible-p nil)))))) + +(mapc + #'proclaim-incompatible-superclasses + '(;; superclass class + (built-in-class std-class structure-class) ; direct subclasses of pcl-class + (standard-class funcallable-standard-class) + ;; superclass metaobject + (class eql-specializer class-eq-specializer method method-combination + generic-function slot-definition) + ;; metaclass built-in-class + (number sequence character ; direct subclasses of t, but not array + standard-object structure-object) ; or symbol + (number array character symbol ; direct subclasses of t, but not sequence + standard-object structure-object) + (complex real) ; direct subclasses of number + (float rational) ; direct subclasses of real + (integer ratio) ; direct subclasses of rational + (list vector) ; direct subclasses of sequence + (cons null) ; direct subclasses of list + (string bit-vector) ; direct subclasses of vector + )) + + + + +(defmethod same-specializer-p ((specl1 specializer) (specl2 specializer)) + nil) + +(defmethod same-specializer-p ((specl1 class) (specl2 class)) + (eq specl1 specl2)) + +(defmethod specializer-class ((specializer class)) + specializer) + +(defmethod same-specializer-p ((specl1 class-eq-specializer) + (specl2 class-eq-specializer)) + (eq (specializer-class specl1) (specializer-class specl2))) + +(defmethod same-specializer-p ((specl1 eql-specializer) + (specl2 eql-specializer)) + (eq (specializer-object specl1) (specializer-object specl2))) + +(defmethod specializer-class ((specializer eql-specializer)) + (class-of (slot-value specializer 'object))) + +(defvar *in-gf-arg-info-p* nil) +(setf (gdefinition 'arg-info-reader) + (let ((mf (initialize-method-function + (make-internal-reader-method-function + 'standard-generic-function 'arg-info) + t))) + #'(lambda (&rest args) (funcall mf args nil)))) + +(defun types-from-arguments (generic-function arguments &optional type-modifier) + (multiple-value-bind (nreq applyp metatypes nkeys arg-info) + (get-generic-function-info generic-function) + (declare (ignore applyp metatypes nkeys)) + (let ((types-rev nil)) + (dotimes (i nreq) + i + (unless arguments + (error "The function ~S requires at least ~D arguments" + (generic-function-name generic-function) + nreq)) + (let ((arg (pop arguments))) + (push (if type-modifier `(,type-modifier ,arg) arg) types-rev))) + (values (nreverse types-rev) arg-info)))) + +(defun get-wrappers-from-classes (nkeys wrappers classes metatypes) + (let* ((w wrappers) (w-tail w) (mt-tail metatypes)) + (dolist (class (if (listp classes) classes (list classes))) + (unless (eq 't (car mt-tail)) + (let ((c-w (class-wrapper class))) + (unless c-w (return-from get-wrappers-from-classes nil)) + (if (eql nkeys 1) + (setq w c-w) + (setf (car w-tail) c-w + w-tail (cdr w-tail))))) + (setq mt-tail (cdr mt-tail))) + w)) + +(defun sdfun-for-caching (gf classes) + (let ((types (mapcar #'class-eq-type classes))) + (multiple-value-bind (methods all-applicable-and-sorted-p) + (compute-applicable-methods-using-types gf types) + (function-funcall (get-secondary-dispatch-function1 + gf methods types nil t all-applicable-and-sorted-p) + nil (mapcar #'class-wrapper classes))))) + +(defun value-for-caching (gf classes) + (let ((methods (compute-applicable-methods-using-types + gf (mapcar #'class-eq-type classes)))) + (method-function-get (or (method-fast-function (car methods)) + (method-function (car methods))) + :constant-value))) + +(defun default-secondary-dispatch-function (generic-function) + #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) + (let ((methods (compute-applicable-methods generic-function args))) + (if methods + (let ((emf (get-effective-method-function generic-function methods))) + (invoke-emf emf args)) + (apply #'no-applicable-method generic-function args))))) + +(defun list-eq (x y) + (loop (when (atom x) (return (eq x y))) + (when (atom y) (return nil)) + (unless (eq (car x) (car y)) (return nil)) + (setq x (cdr x) y (cdr y)))) + +(defvar *std-cam-methods* nil) + +(defun compute-applicable-methods-emf (generic-function) + (if (eq *boot-state* 'complete) + (let* ((cam (gdefinition 'compute-applicable-methods)) + (cam-methods (compute-applicable-methods-using-types + cam (list `(eql ,generic-function) t)))) + (values (get-effective-method-function cam cam-methods) + (list-eq cam-methods + (or *std-cam-methods* + (setq *std-cam-methods* + (compute-applicable-methods-using-types + cam (list `(eql ,cam) t))))))) + (values #'compute-applicable-methods-function t))) + +(defun compute-applicable-methods-emf-std-p (gf) + (gf-info-c-a-m-emf-std-p (gf-arg-info gf))) + +(defvar *old-c-a-m-gf-methods* nil) + +(defun update-all-c-a-m-gf-info (c-a-m-gf) + (let ((methods (generic-function-methods c-a-m-gf))) + (if (and *old-c-a-m-gf-methods* + (every #'(lambda (old-method) + (member old-method methods)) + *old-c-a-m-gf-methods*)) + (let ((gfs-to-do nil) + (gf-classes-to-do nil)) + (dolist (method methods) + (unless (member method *old-c-a-m-gf-methods*) + (let ((specl (car (method-specializers method)))) + (if (eql-specializer-p specl) + (pushnew (specializer-object specl) gfs-to-do) + (pushnew (specializer-class specl) gf-classes-to-do))))) + (map-all-generic-functions + #'(lambda (gf) + (when (or (member gf gfs-to-do) + (dolist (class gf-classes-to-do nil) + (member class (class-precedence-list (class-of gf))))) + (update-c-a-m-gf-info gf))))) + (map-all-generic-functions #'update-c-a-m-gf-info)) + (setq *old-c-a-m-gf-methods* methods))) + +(defun update-gf-info (gf) + (update-c-a-m-gf-info gf) + (update-gf-simple-accessor-type gf)) + +(defun update-c-a-m-gf-info (gf) + (unless (early-gf-p gf) + (multiple-value-bind (c-a-m-emf std-p) + (compute-applicable-methods-emf gf) + (let ((arg-info (gf-arg-info gf))) + (setf (gf-info-static-c-a-m-emf arg-info) c-a-m-emf) + (setf (gf-info-c-a-m-emf-std-p arg-info) std-p))))) + +(defun update-gf-simple-accessor-type (gf) + (let ((arg-info (gf-arg-info gf))) + (setf (gf-info-simple-accessor-type arg-info) + (let* ((methods (generic-function-methods gf)) + (class (and methods (class-of (car methods)))) + (type (and class (cond ((eq class *the-class-standard-reader-method*) + 'reader) + ((eq class *the-class-standard-writer-method*) + 'writer) + ((eq class *the-class-standard-boundp-method*) + 'boundp))))) + (when (and (gf-info-c-a-m-emf-std-p arg-info) + type + (dolist (method (cdr methods) t) + (unless (eq class (class-of method)) (return nil))) + (eq (generic-function-method-combination gf) + *standard-method-combination*)) + type))))) + +(defun get-accessor-method-function (gf type class slotd) + (let* ((std-method (standard-svuc-method type)) + (str-method (structure-svuc-method type)) + (types1 `((eql ,class) (class-eq ,class) (eql ,slotd))) + (types (if (eq type 'writer) `(t ,@types1) types1)) + (methods (compute-applicable-methods-using-types gf types)) + (std-p (null (cdr methods)))) + (values + (if std-p + (get-optimized-std-accessor-method-function class slotd type) + (get-accessor-from-svuc-method-function + class slotd + (get-secondary-dispatch-function + gf methods types + `((,(car (or (member std-method methods) + (member str-method methods) + (error "error in get-accessor-method-function"))) + ,(get-optimized-std-slot-value-using-class-method-function + class slotd type))) + (unless (and (eq type 'writer) + (dolist (method methods t) + (unless (eq (car (method-specializers method)) + *the-class-t*) + (return nil)))) + (let ((wrappers (list (wrapper-of class) + (class-wrapper class) + (wrapper-of slotd)))) + (if (eq type 'writer) + (cons (class-wrapper *the-class-t*) wrappers) + wrappers)))) + type)) + std-p))) + +;used by optimize-slot-value-by-class-p (vector.lisp) +(defun update-slot-value-gf-info (gf type) + (unless *new-class* + (update-std-or-str-methods gf type)) + (when (and (standard-svuc-method type) (structure-svuc-method type)) + (flet ((update-class (class) + (when (class-finalized-p class) + (dolist (slotd (class-slots class)) + (compute-slot-accessor-info slotd type gf))))) + (if *new-class* + (update-class *new-class*) + (map-all-classes #'update-class 'slot-object))))) + +(defvar *standard-slot-value-using-class-method* nil) +(defvar *standard-setf-slot-value-using-class-method* nil) +(defvar *standard-slot-boundp-using-class-method* nil) +(defvar *structure-slot-value-using-class-method* nil) +(defvar *structure-setf-slot-value-using-class-method* nil) +(defvar *structure-slot-boundp-using-class-method* nil) + +(defun standard-svuc-method (type) + (case type + (reader *standard-slot-value-using-class-method*) + (writer *standard-setf-slot-value-using-class-method*) + (boundp *standard-slot-boundp-using-class-method*))) + +(defun set-standard-svuc-method (type method) + (case type + (reader (setq *standard-slot-value-using-class-method* method)) + (writer (setq *standard-setf-slot-value-using-class-method* method)) + (boundp (setq *standard-slot-boundp-using-class-method* method)))) + +(defun structure-svuc-method (type) + (case type + (reader *structure-slot-value-using-class-method*) + (writer *structure-setf-slot-value-using-class-method*) + (boundp *structure-slot-boundp-using-class-method*))) + +(defun set-structure-svuc-method (type method) + (case type + (reader (setq *structure-slot-value-using-class-method* method)) + (writer (setq *structure-setf-slot-value-using-class-method* method)) + (boundp (setq *structure-slot-boundp-using-class-method* method)))) + +(defun update-std-or-str-methods (gf type) + (dolist (method (generic-function-methods gf)) + (let ((specls (method-specializers method))) + (when (and (or (not (eq type 'writer)) + (eq (pop specls) *the-class-t*)) + (every #'classp specls)) + (cond ((and (eq (class-name (car specls)) + 'std-class) + (eq (class-name (cadr specls)) + 'standard-object) + (eq (class-name (caddr specls)) + 'standard-effective-slot-definition)) + (set-standard-svuc-method type method)) + ((and (eq (class-name (car specls)) + 'structure-class) + (eq (class-name (cadr specls)) + 'structure-object) + (eq (class-name (caddr specls)) + 'structure-effective-slot-definition)) + (set-structure-svuc-method type method))))))) + +(defun mec-all-classes-internal (spec precompute-p) + (cons (specializer-class spec) + (and (classp spec) + precompute-p + (not (or (eq spec *the-class-t*) + (eq spec *the-class-slot-object*) + (eq spec *the-class-standard-object*) + (eq spec *the-class-structure-object*))) + (let ((sc (class-direct-subclasses spec))) + (when sc + (mapcan #'(lambda (class) + (mec-all-classes-internal class precompute-p)) + sc)))))) + +(defun mec-all-classes (spec precompute-p) + (let ((classes (mec-all-classes-internal spec precompute-p))) + (if (null (cdr classes)) + classes + (let* ((a-classes (cons nil classes)) + (tail classes)) + (loop (when (null (cdr tail)) + (return (cdr a-classes))) + (let ((class (cadr tail)) + (ttail (cddr tail))) + (if (dolist (c ttail nil) + (when (eq class c) (return t))) + (setf (cdr tail) (cddr tail)) + (setf tail (cdr tail))))))))) + +(defun mec-all-class-lists (spec-list precompute-p) + (if (null spec-list) + (list nil) + (let* ((car-all-classes (mec-all-classes (car spec-list) precompute-p)) + (all-class-lists (mec-all-class-lists (cdr spec-list) precompute-p))) + (mapcan #'(lambda (list) + (mapcar #'(lambda (c) (cons c list)) car-all-classes)) + all-class-lists)))) + +(defun make-emf-cache (generic-function valuep cache classes-list new-class) + (let* ((arg-info (gf-arg-info generic-function)) + (nkeys (arg-info-nkeys arg-info)) + (metatypes (arg-info-metatypes arg-info)) + (wrappers (unless (eq nkeys 1) (make-list nkeys))) + (precompute-p (gf-precompute-dfun-and-emf-p arg-info)) + (default '(default))) + (flet ((add-class-list (classes) + (when (or (null new-class) (memq new-class classes)) + (let ((wrappers (get-wrappers-from-classes + nkeys wrappers classes metatypes))) + (when (and wrappers + (eq default (probe-cache cache wrappers default))) + (let ((value (cond ((eq valuep t) + (sdfun-for-caching generic-function classes)) + ((eq valuep :constant-value) + (value-for-caching generic-function classes))))) + (setq cache (fill-cache cache wrappers value t)))))))) + (if classes-list + (mapc #'add-class-list classes-list) + (dolist (method (generic-function-methods generic-function)) + (mapc #'add-class-list + (mec-all-class-lists (method-specializers method) precompute-p)))) + cache))) + +(defmacro class-test (arg class) + (cond ((eq class *the-class-t*) + 't) + ((eq class *the-class-slot-object*) + #-(or new-kcl-wrapper cmu17) + `(not (eq *the-class-built-in-class* + (wrapper-class (std-instance-wrapper (class-of ,arg))))) + #+new-kcl-wrapper + `(or (std-instance-p ,arg) + (fsc-instance-p ,arg)) + #+cmu17 + `(not (lisp:typep (lisp:class-of ,arg) 'lisp:built-in-class))) + #-new-kcl-wrapper + ((eq class *the-class-standard-object*) + `(or (std-instance-p ,arg) (fsc-instance-p ,arg))) + #-cmu17 + ((eq class *the-class-structure-object*) + `(memq ',class (class-precedence-list (class-of ,arg)))) + ;; TYPEP is now sometimes faster than doing memq of the cpl + (t + `(typep ,arg ',(class-name class))))) + +(defmacro class-eq-test (arg class) + `(eq (class-of ,arg) ',class)) + +(defmacro eql-test (arg object) + `(eql ,arg ',object)) + +(defun dnet-methods-p (form) + (and (consp form) + (or (eq (car form) 'methods) + (eq (car form) 'unordered-methods)))) + +(defmacro scase (arg &rest clauses) ; This is case, but without gensyms + `(let ((.case-arg. ,arg)) + (cond ,@(mapcar #'(lambda (clause) + (list* (cond ((null (car clause)) + nil) + ((consp (car clause)) + (if (null (cdar clause)) + `(eql .case-arg. ',(caar clause)) + `(member .case-arg. ',(car clause)))) + ((member (car clause) '(t otherwise)) + `t) + (t + `(eql .case-arg. ',(car clause)))) + nil + (cdr clause))) + clauses)))) + +(defmacro mcase (arg &rest clauses) `(scase ,arg ,@clauses)) + +(defun generate-discrimination-net (generic-function methods types sorted-p) + (let* ((arg-info (gf-arg-info generic-function)) + (precedence (arg-info-precedence arg-info))) + (generate-discrimination-net-internal + generic-function methods types + #'(lambda (methods known-types) + (if (or sorted-p + (block one-order-p + (let ((sorted-methods nil)) + (map-all-orders + (copy-list methods) precedence + #'(lambda (methods) + (when sorted-methods (return-from one-order-p nil)) + (setq sorted-methods methods))) + (setq methods sorted-methods)) + t)) + `(methods ,methods ,known-types) + `(unordered-methods ,methods ,known-types))) + #'(lambda (position type true-value false-value) + (let ((arg (dfun-arg-symbol position))) + (if (eq (car type) 'eql) + (let* ((false-case-p (and (consp false-value) + (or (eq (car false-value) 'scase) + (eq (car false-value) 'mcase)) + (eq arg (cadr false-value)))) + (false-clauses (if false-case-p + (cddr false-value) + `((t ,false-value)))) + (case-sym (if (and (dnet-methods-p true-value) + (if false-case-p + (eq (car false-value) 'mcase) + (dnet-methods-p false-value))) + 'mcase + 'scase)) + (type-sym `(,(cadr type)))) + `(,case-sym ,arg + (,type-sym ,true-value) + ,@false-clauses)) + `(if ,(let ((arg (dfun-arg-symbol position))) + (case (car type) + (class `(class-test ,arg ,(cadr type))) + (class-eq `(class-eq-test ,arg ,(cadr type))))) + ,true-value + ,false-value)))) + #'identity))) + +(defun class-from-type (type) + (if (or (atom type) (eq (car type) 't)) + *the-class-t* + (case (car type) + (and (dolist (type (cdr type) *the-class-t*) + (when (and (consp type) (not (eq (car type) 'not))) + (return (class-from-type type))))) + (not *the-class-t*) + (eql (class-of (cadr type))) + (class-eq (cadr type)) + (class (cadr type))))) + +(defun precompute-effective-methods (gf caching-p &optional classes-list-p) + (let* ((arg-info (gf-arg-info gf)) + (methods (generic-function-methods gf)) + (precedence (arg-info-precedence arg-info)) + (*in-precompute-effective-methods-p* t) + (classes-list nil)) + (generate-discrimination-net-internal + gf methods nil + #'(lambda (methods known-types) + (when methods + (when classes-list-p + (push (mapcar #'class-from-type known-types) classes-list)) + (let ((no-eql-specls-p (not (methods-contain-eql-specializer-p methods)))) + (map-all-orders + methods precedence + #'(lambda (methods) + (get-secondary-dispatch-function1 + gf methods known-types + nil caching-p no-eql-specls-p)))))) + #'(lambda (position type true-value false-value) + (declare (ignore position type true-value false-value)) + nil) + #'(lambda (type) + (if (and (consp type) (eq (car type) 'eql)) + `(class-eq ,(class-of (cadr type))) + type))) + classes-list)) + +; we know that known-type implies neither new-type nor `(not ,new-type) +(defun augment-type (new-type known-type) + (if (or (eq known-type 't) + (eq (car new-type) 'eql)) + new-type + (let ((so-far (if (and (consp known-type) (eq (car known-type) 'and)) + (cdr known-type) + (list known-type)))) + (unless (eq (car new-type) 'not) + (setq so-far + (mapcan #'(lambda (type) + (unless (*subtypep new-type type) + (list type))) + so-far))) + (if (null so-far) + new-type + `(and ,new-type ,@so-far))))) + +#+lcl3.0 (dont-use-production-compiler) + +(defun generate-discrimination-net-internal + (gf methods types methods-function test-function type-function) + #+cmu + (declare (type function methods-function test-function type-function)) + (let* ((arg-info (gf-arg-info gf)) + (precedence (arg-info-precedence arg-info)) + (nreq (arg-info-number-required arg-info)) + (metatypes (arg-info-metatypes arg-info))) + (labels ((do-column (p-tail contenders known-types) + (if p-tail + (let* ((position (car p-tail)) + (known-type (or (nth position types) t))) + (if (eq (nth position metatypes) 't) + (do-column (cdr p-tail) contenders + (cons (cons position known-type) known-types)) + (do-methods p-tail contenders + known-type () known-types))) + (funcall methods-function contenders + (let ((k-t (make-list nreq))) + (dolist (index+type known-types) + (setf (nth (car index+type) k-t) (cdr index+type))) + k-t)))) + (do-methods (p-tail contenders known-type winners known-types) + ;; + ;; + ;; is a (sorted) list of methods that must be discriminated + ;; + ;; is the type of this argument, constructed from tests already made. + ;; + ;; is a (sorted) list of methods that are potentially applicable + ;; after the discrimination has been made. + ;; + (if (null contenders) + (do-column (cdr p-tail) winners + (cons (cons (car p-tail) known-type) known-types)) + (let* ((position (car p-tail)) + (method (car contenders)) + (specl (nth position (method-specializers method))) + (type (funcall type-function (type-from-specializer specl)))) + (multiple-value-bind (app-p maybe-app-p) + (specializer-applicable-using-type-p type known-type) + (flet ((determined-to-be (truth-value) + (if truth-value app-p (not maybe-app-p))) + (do-if (truth &optional implied) + (let ((ntype (if truth type `(not ,type)))) + (do-methods p-tail + (cdr contenders) + (if implied + known-type + (augment-type ntype known-type)) + (if truth + (append winners `(,method)) + winners) + known-types)))) + (cond ((determined-to-be nil) (do-if nil t)) + ((determined-to-be t) (do-if t t)) + (t (funcall test-function position type + (do-if t) (do-if nil)))))))))) + (do-column precedence methods ())))) + +#+lcl3.0 (use-previous-compiler) + +(defun compute-secondary-dispatch-function (generic-function net &optional + method-alist wrappers) + (function-funcall (compute-secondary-dispatch-function1 generic-function net) + method-alist wrappers)) + +(defvar *eq-case-table-limit* 15) +(defvar *case-table-limit* 10) + +(defun compute-mcase-parameters (case-list) + (unless (eq 't (caar (last case-list))) + (error "The key for the last case arg to mcase was not T")) + (let* ((eq-p (dolist (case case-list t) + (unless (or (eq (car case) 't) + (symbolp (caar case))) + (return nil)))) + (len (1- (length case-list))) + (type (cond ((= len 1) + :simple) + ((<= len + (if eq-p + *eq-case-table-limit* + *case-table-limit*)) + :assoc) + (t + :hash-table)))) + (list eq-p type))) + +(defmacro mlookup (key info default &optional eq-p type) + (unless (or (eq eq-p 't) (null eq-p)) + (error "Invalid eq-p argument")) + (ecase type + (:simple + `(if (,(if eq-p 'eq 'eql) ,key (car ,info)) + (cdr ,info) + ,default)) + (:assoc + `(dolist (e ,info ,default) + (when (,(if eq-p 'eq 'eql) (car e) ,key) + (return (cdr e))))) + (:hash-table + `(gethash ,key ,info ,default)))) + +(defun net-test-converter (form) + (if (atom form) + (default-test-converter form) + (case (car form) + ((invoke-effective-method-function invoke-fast-method-call) + '.call.) + (methods + '.methods.) + (unordered-methods + '.umethods.) + (mcase + `(mlookup ,(cadr form) nil nil ,@(compute-mcase-parameters (cddr form)))) + (t (default-test-converter form))))) + +(defun net-code-converter (form) + (if (atom form) + (default-code-converter form) + (case (car form) + ((methods unordered-methods) + (let ((gensym (gensym))) + (values gensym + (list gensym)))) + (mcase + (let ((mp (compute-mcase-parameters (cddr form))) + (gensym (gensym)) (default (gensym))) + (values `(mlookup ,(cadr form) ,gensym ,default ,@mp) + (list gensym default)))) + (t + (default-code-converter form))))) + +(defun net-constant-converter (form generic-function) + (or (let ((c (methods-converter form generic-function))) + (when c (list c))) + (if (atom form) + (default-constant-converter form) + (case (car form) + (mcase + (let* ((mp (compute-mcase-parameters (cddr form))) + (list (mapcar #'(lambda (clause) + (let ((key (car clause)) + (meth (cadr clause))) + (cons (if (consp key) (car key) key) + (methods-converter + meth generic-function)))) + (cddr form))) + (default (car (last list)))) + (list (list* ':mcase mp (nbutlast list)) + (cdr default)))) + (t + (default-constant-converter form)))))) + +(defun methods-converter (form generic-function) + (cond ((and (consp form) (eq (car form) 'methods)) + (cons '.methods. + (get-effective-method-function1 generic-function (cadr form)))) + ((and (consp form) (eq (car form) 'unordered-methods)) + (default-secondary-dispatch-function generic-function)))) + +(defun convert-methods (constant method-alist wrappers) + (if (and (consp constant) + (eq (car constant) '.methods.)) + (funcall (the function (cdr constant)) method-alist wrappers) + constant)) + +(defun convert-table (constant method-alist wrappers) + (cond ((and (consp constant) + (eq (car constant) ':mcase)) + (let ((alist (mapcar #'(lambda (k+m) + (cons (car k+m) + (convert-methods (cdr k+m) + method-alist wrappers))) + (cddr constant))) + (mp (cadr constant))) + (ecase (cadr mp) + (:simple + (car alist)) + (:assoc + alist) + (:hash-table + (let ((table (make-hash-table :test (if (car mp) 'eq 'eql)))) + (dolist (k+m alist) + (setf (gethash (car k+m) table) (cdr k+m))) + table))))))) + +(defun compute-secondary-dispatch-function1 (generic-function net + &optional function-p) + (cond + ((and (eq (car net) 'methods) (not function-p)) + (get-effective-method-function1 generic-function (cadr net))) + (t + (let* ((name (generic-function-name generic-function)) + (arg-info (gf-arg-info generic-function)) + (metatypes (arg-info-metatypes arg-info)) + (applyp (arg-info-applyp arg-info)) + (fmc-arg-info (cons (length metatypes) applyp))) + (multiple-value-bind + (cfunction constants) + (get-function1 (make-dispatch-lambda + function-p metatypes applyp + `((locally (declare #.*optimize-speed*) + (let ((emf ,net)) + ,(make-emf-call metatypes applyp 'emf))))) + #'net-test-converter + #'net-code-converter + #'(lambda (form) + (net-constant-converter form generic-function))) + #'(lambda (method-alist wrappers) + (let* ((alist (list nil)) + (alist-tail alist)) + (dolist (constant constants) + (let* ((a (or (dolist (a alist nil) + (when (eq (car a) constant) + (return a))) + (cons constant + (or (convert-table + constant method-alist wrappers) + (convert-methods + constant method-alist wrappers))))) + (new (list a))) + (setf (cdr alist-tail) new) + (setf alist-tail new))) + (let ((function (apply cfunction (mapcar #'cdr (cdr alist))))) + (if function-p + function + (make-fast-method-call + :function (set-function-name function `(sdfun-method ,name)) + :arg-info fmc-arg-info)))))))))) + +(defvar *show-make-unordered-methods-emf-calls* nil) + +(defun make-unordered-methods-emf (generic-function methods) + (when *show-make-unordered-methods-emf-calls* + (format t "~&make-unordered-methods-emf ~s~%" + (generic-function-name generic-function))) + #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) + (let* ((types (types-from-arguments generic-function args 'eql)) + (smethods (sort-applicable-methods generic-function methods types)) + (emf (get-effective-method-function generic-function smethods))) + (invoke-emf emf args)))) + + +;;; +;;; The value returned by compute-discriminating-function is a function +;;; object. It is called a discriminating function because it is called +;;; when the generic function is called and its role is to discriminate +;;; on the arguments to the generic function and then call appropriate +;;; method functions. +;;; +;;; A discriminating function can only be called when it is installed as +;;; the funcallable instance function of the generic function for which +;;; it was computed. +;;; +;;; More precisely, if compute-discriminating-function is called with an +;;; argument , and returns a result , that result must not be +;;; passed to apply or funcall directly. Rather, must be stored as +;;; the funcallable instance function of the same generic function +;;; (using set-funcallable-instance-function). Then the generic function +;;; can be passed to funcall or apply. +;;; +;;; An important exception is that methods on this generic function are +;;; permitted to return a function which itself ends up calling the value +;;; returned by a more specific method. This kind of `encapsulation' of +;;; discriminating function is critical to many uses of the MOP. +;;; +;;; As an example, the following canonical case is legal: +;;; +;;; (defmethod compute-discriminating-function ((gf my-generic-function)) +;;; (let ((std (call-next-method))) +;;; #'(lambda (arg) +;;; (print (list 'call-to-gf gf arg)) +;;; (funcall std arg)))) +;;; +;;; Because many discriminating functions would like to use a dynamic +;;; strategy in which the precise discriminating function changes with +;;; time it is important to specify how a discriminating function is +;;; permitted itself to change the funcallable instance function of the +;;; generic function. +;;; +;;; Discriminating functions may set the funcallable instance function +;;; of the generic function, but the new value must be generated by making +;;; a call to COMPUTE-DISCRIMINATING-FUNCTION. This is to ensure that any +;;; more specific methods which may have encapsulated the discriminating +;;; function will get a chance to encapsulate the new, inner discriminating +;;; function. +;;; +;;; This implies that if a discriminating function wants to modify itself +;;; it should first store some information in the generic function proper, +;;; and then call compute-discriminating-function. The appropriate method +;;; on compute-discriminating-function will see the information stored in +;;; the generic function and generate a discriminating function accordingly. +;;; +;;; The following is an example of a discriminating function which modifies +;;; itself in accordance with this protocol: +;;; +;;; (defmethod compute-discriminating-function ((gf my-generic-function)) +;;; #'(lambda (arg) +;;; (cond ( +;;; +;;; (set-funcallable-instance-function +;;; gf +;;; (compute-discriminating-function gf)) +;;; (funcall gf arg)) +;;; (t +;;; )))) +;;; +;;; Whereas this code would not be legal: +;;; +;;; (defmethod compute-discriminating-function ((gf my-generic-function)) +;;; #'(lambda (arg) +;;; (cond ( +;;; (set-funcallable-instance-function +;;; gf +;;; #'(lambda (a) ..)) +;;; (funcall gf arg)) +;;; (t +;;; )))) +;;; +;;; NOTE: All the examples above assume that all instances of the class +;;; my-generic-function accept only one argument. +;;; +;;; +;;; +;;; +(defun slot-value-using-class-dfun (class object slotd) + (declare (ignore class)) + (function-funcall (slot-definition-reader-function slotd) object)) + +(defun setf-slot-value-using-class-dfun (new-value class object slotd) + (declare (ignore class)) + (function-funcall (slot-definition-writer-function slotd) new-value object)) + +(defun slot-boundp-using-class-dfun (class object slotd) + (declare (ignore class)) + (function-funcall (slot-definition-boundp-function slotd) object)) + +(defmethod compute-discriminating-function ((gf standard-generic-function)) + (with-slots (dfun-state arg-info) gf + (typecase dfun-state + (null (let ((name (generic-function-name gf))) + (when (eq name 'compute-applicable-methods) + (update-all-c-a-m-gf-info gf)) + (cond ((eq name 'slot-value-using-class) + (update-slot-value-gf-info gf 'reader) + #'slot-value-using-class-dfun) + ((equal name '(setf slot-value-using-class)) + (update-slot-value-gf-info gf 'writer) + #'setf-slot-value-using-class-dfun) + ((eq name 'slot-boundp-using-class) + (update-slot-value-gf-info gf 'boundp) + #'slot-boundp-using-class-dfun) + ((gf-precompute-dfun-and-emf-p arg-info) + (make-final-dfun gf)) + (t + (make-initial-dfun gf))))) + (function dfun-state) + (cons (car dfun-state))))) + +(defmethod update-gf-dfun ((class std-class) gf) + (let ((*new-class* class) + #|| (name (generic-function-name gf)) ||# + (arg-info (gf-arg-info gf))) + (cond #|| + ((eq name 'slot-value-using-class) + (update-slot-value-gf-info gf 'reader)) + ((equal name '(setf slot-value-using-class)) + (update-slot-value-gf-info gf 'writer)) + ((eq name 'slot-boundp-using-class) + (update-slot-value-gf-info gf 'boundp)) + ||# + ((gf-precompute-dfun-and-emf-p arg-info) + (multiple-value-bind (dfun cache info) + (make-final-dfun-internal gf) + (set-dfun gf dfun cache info) ; otherwise cache might get freed twice + (update-dfun gf dfun cache info)))))) + +;;; +;;; +;;; +(defmethod function-keywords ((method standard-method)) + (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords) + (analyze-lambda-list (if (consp method) + (early-method-lambda-list method) + (method-lambda-list method))) + (declare (ignore nreq nopt keysp restp)) + (values keywords allow-other-keys-p))) + +(defun method-ll->generic-function-ll (ll) + (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords keyword-parameters) + (analyze-lambda-list ll) + (declare (ignore nreq nopt keysp restp allow-other-keys-p keywords)) + (remove-if #'(lambda (s) + (or (memq s keyword-parameters) + (eq s '&allow-other-keys))) + ll))) + + +;;; +;;; This is based on the rules of method lambda list congruency defined in +;;; the spec. The lambda list it constructs is the pretty union of the +;;; lambda lists of all the methods. It doesn't take method applicability +;;; into account at all yet. +;;; +(defmethod generic-function-pretty-arglist + ((generic-function standard-generic-function)) + (let ((methods (generic-function-methods generic-function)) + (arglist ())) + (when methods + (multiple-value-bind (required optional rest key allow-other-keys) + (method-pretty-arglist (car methods)) + (dolist (m (cdr methods)) + (multiple-value-bind (method-key-keywords + method-allow-other-keys + method-key) + (function-keywords m) + ;; we've modified function-keywords to return what we want as + ;; the third value, no other change here. + (declare (ignore method-key-keywords)) + (setq key (union key method-key)) + (setq allow-other-keys (or allow-other-keys + method-allow-other-keys)))) + (when allow-other-keys + (setq arglist '(&allow-other-keys))) + (when key + (setq arglist (nconc (list '&key) key arglist))) + (when rest + (setq arglist (nconc (list '&rest rest) arglist))) + (when optional + (setq arglist (nconc (list '&optional) optional arglist))) + (nconc required arglist))))) + + +(defmethod method-pretty-arglist ((method standard-method)) + (let ((required ()) + (optional ()) + (rest nil) + (key ()) + (allow-other-keys nil) + (state 'required) + (arglist (method-lambda-list method))) + (dolist (arg arglist) + (cond ((eq arg '&optional) (setq state 'optional)) + ((eq arg '&rest) (setq state 'rest)) + ((eq arg '&key) (setq state 'key)) + ((eq arg '&allow-other-keys) (setq allow-other-keys 't)) + ((memq arg lambda-list-keywords)) + (t + (ecase state + (required (push arg required)) + (optional (push arg optional)) + (key (push arg key)) + (rest (setq rest arg)))))) + (values (nreverse required) + (nreverse optional) + rest + (nreverse key) + allow-other-keys))) + diff --git a/pcl/gcl_pcl_pkg.lisp b/pcl/gcl_pcl_pkg.lisp new file mode 100644 index 0000000..115044d --- /dev/null +++ b/pcl/gcl_pcl_pkg.lisp @@ -0,0 +1,405 @@ +;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :user) + +;;; From defsys.lisp +(eval-when (compile load eval) + +(if (find-package ':walker) + (use-package '(:lisp) ':walker) + (make-package ':walker :use '(:lisp))) + +(if (find-package ':iterate) + (use-package '(:lisp :walker) ':iterate) + (make-package ':iterate :use '(:lisp :walker))) + +(if (find-package ':pcl) + (use-package '(:walker :iterate :lisp) ':pcl) + (make-package ':pcl :use '(:walker :iterate :lisp))) + +(export (intern (symbol-name :iterate) ;Have to do this here, + (find-package :iterate)) ;because in the defsystem + (find-package :iterate)) ;(later in this file) + ;we use the symbol iterate + ;to name the file +) + +(in-package :walker) + +(export '(define-walker-template + walk-form + walk-form-expand-macros-p + nested-walk-form + variable-lexical-p + variable-special-p + variable-globally-special-p + *variable-declarations* + variable-declaration + macroexpand-all + )) + +(in-package :iterate) + +(export '(iterate iterate* gathering gather with-gathering interval elements + list-elements list-tails plist-elements eachtime while until + collecting joining maximizing minimizing summing + *iterate-warnings*)) + +(in-package :pcl) + +;;; +;;; Some CommonLisps have more symbols in the Lisp package than the ones that +;;; are explicitly specified in CLtL. This causes trouble. Any Lisp that has +;;; extra symbols in the Lisp package should shadow those symbols in the PCL +;;; package. +;;; +#+TI +(shadow '(string-append once-only destructuring-bind + memq assq delq neq true false + without-interrupts + defmethod) + *the-pcl-package*) + +#+CMU +(shadow '(destructuring-bind) + *the-pcl-package*) +#+cmu17 +(shadow '(find-class class-name class-of + class built-in-class structure-class + standard-class) + *the-pcl-package*) + +#+GCLisp +(shadow '(string-append memq assq delq neq make-instance) + *the-pcl-package*) + +(defun use-package-pcl (&optional (*package* *package*)) + (shadowing-import + (let ((*package* *the-pcl-package*)) + (mapcar #'intern + #+cmu17 '("FIND-CLASS" "CLASS-NAME" "CLASS-OF" + "CLASS" "BUILT-IN-CLASS" "STRUCTURE-CLASS" + "STANDARD-CLASS") + #+TI '("DEFMETHOD") + #+GCLisp '("MAKE-INSTANCE") + #-(or cmu17 TI GCLisp) '()))) + (use-package *the-pcl-package*)) + +#+Genera +(shadowing-import '(zl:arglist zwei:indentation) *the-pcl-package*) + +#+Lucid +(import '(#-LCL3.0 system:arglist #+LCL3.0 lcl:arglist + system:structurep system:structure-type system:structure-length) + *the-pcl-package*) + +#+lucid +(#-LCL3.0 progn #+LCL3.0 lcl:handler-bind + #+LCL3.0 ((lcl:warning #'(lambda (condition) + (declare (ignore condition)) + (lcl:muffle-warning)))) +(let ((importer + #+LCL3.0 #'sys:import-from-lucid-pkg + #-LCL3.0 (let ((x (find-symbol "IMPORT-FROM-LUCID-PKG" "LUCID"))) + (if (and x (fboundp x)) + (symbol-function x) + ;; Only the #'(lambda (x) ...) below is really needed, + ;; but when available, the "internal" function + ;; 'import-from-lucid-pkg' provides better checking. + #'(lambda (name) + (import (intern name "LUCID"))))))) + ;; + ;; We need the following "internal", undocumented Lucid goodies: + (mapc importer '("%POINTER" "DEFSTRUCT-SIMPLE-PREDICATE" + #-LCL3.0 "LOGAND&" "%LOGAND&" #+VAX "LOGAND&-VARIABLE")) + + ;; + ;; For without-interrupts. + ;; + #+LCL3.0 + (mapc importer '("*SCHEDULER-WAKEUP*" "MAYBE-CALL-SCHEDULER")) + + ;; + ;; We import the following symbols, because in 2.1 Lisps they have to be + ;; accessed as SYS:, whereas in 3.0 lisps, they are homed in the + ;; LUCID-COMMON-LISP package. + (mapc importer '("ARGLIST" "NAMED-LAMBDA" "*PRINT-STRUCTURE*")) + ;; + ;; We import the following symbols, because in 2.1 Lisps they have to be + ;; accessed as LUCID::, whereas in 3.0 lisps, they have to be + ;; accessed as SYS: + (mapc importer '( + "NEW-STRUCTURE" "STRUCTURE-REF" + "STRUCTUREP" "STRUCTURE-TYPE" "STRUCTURE-LENGTH" + "PROCEDUREP" "PROCEDURE-SYMBOL" + "PROCEDURE-REF" "SET-PROCEDURE-REF" + )) +; ;; +; ;; The following is for the "patch" to the general defstruct printer. +; (mapc importer '( +; "OUTPUT-STRUCTURE" "DEFSTRUCT-INFO" +; "OUTPUT-TERSE-OBJECT" "DEFAULT-STRUCTURE-PRINT" +; "STRUCTURE-TYPE" "*PRINT-OUTPUT*" +; )) + ;; + ;; The following is for a "patch" affecting compilation of %logand&. + ;; On APOLLO, Domain/CommonLISP 2.10 does not include %logand& whereas + ;; Domain/CommonLISP 2.20 does; Domain/CommonLISP 2.20 includes :DOMAIN/OS + ;; on *FEATURES*, so this conditionalizes correctly for APOLLO. + #-(or (and APOLLO DOMAIN/OS) LCL3.0 VAX) + (mapc importer '("COPY-STRUCTURE" "GET-FDESC" "SET-FDESC")) + + nil)) + +#+kcl(import '(si:structurep si:structure-def si:structure-ref)) + +#+kcl +(in-package "SI") +#+kcl +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name + %instance-ref + %set-instance-ref)) +#+kcl +(in-package 'pcl) + +#+cmu (shadow 'lisp:dotimes) + +#+cmu +(import '(kernel:funcallable-instance-p) + *the-pcl-package*) + + +(shadow 'documentation) + + +;;; +;;; These come from the index pages of 88-002R. +;;; +;;; +(eval-when (compile load eval) + +(defvar *exports* '(add-method + built-in-class + call-method + call-next-method + change-class + class-name + classp + class-of + compute-applicable-methods + defclass + defgeneric + define-method-combination + defmethod + ensure-generic-function + find-class + find-method + function-keywords + generic-flet + generic-labels + initialize-instance + invalid-method-error + make-instance + make-instances-obsolete + method-combination-error + method-qualifiers + next-method-p + no-applicable-method + no-next-method + print-object + reinitialize-instance + remove-method + shared-initialize + slot-boundp + slot-exists-p + slot-makunbound + slot-missing + slot-unbound + slot-value + standard + standard-class + standard-generic-function + standard-method + standard-object + structure-class + #-cmu17 symbol-macrolet + update-instance-for-different-class + update-instance-for-redefined-class + with-accessors + with-added-methods + with-slots + )) + +);eval-when + +#-(or KCL IBCL CMU) +(export *exports* *the-pcl-package*) + +#+CMU +(export '#.*exports* *the-pcl-package*) + +#+(or KCL IBCL) +(mapc 'export (list *exports*) (list *the-pcl-package*)) + + +(eval-when (compile load eval) + +(defvar *class-exports* + '(standard-instance + funcallable-standard-instance + generic-function + standard-generic-function + method + standard-method + standard-accessor-method + standard-reader-method + standard-writer-method + method-combination + slot-definition + direct-slot-definition + effective-slot-definition + standard-slot-definition + standard-direct-slot-definition + standard-effective-slot-definition + specializer + eql-specializer + built-in-class + forward-referenced-class + standard-class + funcallable-standard-class)) + +(defvar *chapter-6-exports* + '(add-dependent + add-direct-method + add-direct-subclass + add-method + allocate-instance + class-default-initargs + class-direct-default-initargs + class-direct-slots + class-direct-subclasses + class-direct-superclasses + class-finalized-p + class-precedence-list + class-prototype + class-slots + compute-applicable-methods + compute-applicable-methods-using-classes + compute-class-precedence-list + compute-discriminating-function + compute-effective-method + compute-effective-slot-definition + compute-slots + direct-slot-definition-class + effective-slot-definition-class + ensure-class + ensure-class-using-class + ensure-generic-function + ensure-generic-function-using-class + eql-specializer-instance + extract-lambda-list + extract-specializer-names + finalize-inheritance + find-method-combination + funcallable-standard-instance-access + generic-function-argument-precedence-order + generic-function-declarations + generic-function-lambda-list + generic-function-method-class + generic-function-method-combination + generic-function-methods + generic-function-name + intern-eql-specializer + make-instance + make-method-lambda + map-dependents + method-function + method-generic-function + method-lambda-list + method-specializers + method-qualifiers + accessor-method-slot-definition + reader-method-class + remove-dependent + remove-direct-method + remove-direct-subclass + remove-method + set-funcallable-instance-function + slot-boundp-using-class + slot-definition-allocation + slot-definition-initargs + slot-definition-initform + slot-definition-initfunction + slot-definition-location + slot-definition-name + slot-definition-readers + slot-definition-writers + slot-definition-type + slot-makunbound-using-class + slot-value-using-class + specializer-direct-generic-function + specializer-direct-methods + standard-instance-access + update-dependent + validate-superclass + writer-method-class + )) + +);eval-when + +#-(or KCL IBCL) +(export *class-exports* *the-pcl-package*) + +#+(or KCL IBCL) +(mapc 'export (list *class-exports*) (list *the-pcl-package*)) + +#-(or KCL IBCL) +(export *chapter-6-exports* *the-pcl-package*) + +#+(or KCL IBCL) +(mapc 'export (list *chapter-6-exports*) (list *the-pcl-package*)) + +(defvar *slot-accessor-name-package* + (or (find-package :slot-accessor-name) + (make-package :slot-accessor-name + :use '() + :nicknames '(:s-a-n)))) + +#+kcl +(when (get 'si::basic-wrapper 'si::s-data) + (import (mapcar #'(lambda (s) (intern (symbol-name s) "SI")) + '(:copy-structure-header :swap-structure-contents :set-structure-def + :%instance-ref :%set-instance-ref + + :cache-number-vector :cache-number-vector-length + :wrapper-cache-number-adds-ok :wrapper-cache-number-length + :wrapper-cache-number-mask :wrapper-cache-number-vector-length + :wrapper-layout :wrapper-cache-number-vector + :wrapper-state :wrapper-class :wrapper-length)))) diff --git a/pcl/gcl_pcl_precom1.lisp b/pcl/gcl_pcl_precom1.lisp new file mode 100644 index 0000000..0c550d9 --- /dev/null +++ b/pcl/gcl_pcl_precom1.lisp @@ -0,0 +1,51 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +;;; +;;; pre-allocate generic function caches. The hope is that this will put +;;; them nicely together in memory, and that that may be a win. Of course +;;; the first gc copy will probably blow that out, this really wants to be +;;; wrapped in something that declares the area static. +;;; +;;; This preallocation only creates about 25% more caches than PCL itself +;;; uses need. Some ports may want to preallocate some more of these. +;;; +(eval-when (load) + (flet ((allocate (n size) + (mapcar #'free-cache-vector + (mapcar #'get-cache-vector + (make-list n :initial-element size))))) + (allocate 128 4) + (allocate 64 8) + (allocate 64 9) + (allocate 32 16) + (allocate 16 17) + (allocate 16 32) + (allocate 1 64))) + diff --git a/pcl/gcl_pcl_precom2.lisp b/pcl/gcl_pcl_precom2.lisp new file mode 100644 index 0000000..97ab8f9 --- /dev/null +++ b/pcl/gcl_pcl_precom2.lisp @@ -0,0 +1,31 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(precompile-random-code-segments pcl) + diff --git a/pcl/gcl_pcl_slots.lisp b/pcl/gcl_pcl_slots.lisp new file mode 100644 index 0000000..6cb3c86 --- /dev/null +++ b/pcl/gcl_pcl_slots.lisp @@ -0,0 +1,385 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(defmethod wrapper-fetcher ((class standard-class)) + 'std-instance-wrapper) + +(defmethod slots-fetcher ((class standard-class)) + 'std-instance-slots) + +(defmethod raw-instance-allocator ((class standard-class)) + 'allocate-standard-instance) + +;;; +;;; These four functions work on std-instances and fsc-instances. These are +;;; instances for which it is possible to change the wrapper and the slots. +;;; +;;; For these kinds of instances, most specified methods from the instance +;;; structure protocol are promoted to the implementation-specific class +;;; std-class. Many of these methods call these four functions. +;;; + +(defun set-wrapper (inst new) + (cond ((std-instance-p inst) + #+new-kcl-wrapper + (set-structure-def inst new) + #-new-kcl-wrapper + (setf (std-instance-wrapper inst) new)) + ((fsc-instance-p inst) + (setf (fsc-instance-wrapper inst) new)) + (t + (error "What kind of instance is this?")))) + +#+ignore ; can't do this when using #+new-kcl-wrapper +(defun set-slots (inst new) + (cond ((std-instance-p inst) + (setf (std-instance-slots inst) new)) + ((fsc-instance-p inst) + (setf (fsc-instance-slots inst) new)) + (t + (error "What kind of instance is this?")))) + +(defun swap-wrappers-and-slots (i1 i2) + (without-interrupts + (cond ((std-instance-p i1) + #+new-kcl-wrapper + (swap-structure-contents i1 i2) + #-new-kcl-wrapper + (let ((w1 (std-instance-wrapper i1)) + (s1 (std-instance-slots i1))) + (setf (std-instance-wrapper i1) (std-instance-wrapper i2)) + (setf (std-instance-slots i1) (std-instance-slots i2)) + (setf (std-instance-wrapper i2) w1) + (setf (std-instance-slots i2) s1))) + ((fsc-instance-p i1) + (let ((w1 (fsc-instance-wrapper i1)) + (s1 (fsc-instance-slots i1))) + (setf (fsc-instance-wrapper i1) (fsc-instance-wrapper i2)) + (setf (fsc-instance-slots i1) (fsc-instance-slots i2)) + (setf (fsc-instance-wrapper i2) w1) + (setf (fsc-instance-slots i2) s1))) + (t + (error "What kind of instance is this?"))))) + + + + + + +(defun get-class-slot-value-1 (object wrapper slot-name) + (let ((entry (assoc slot-name (wrapper-class-slots wrapper)))) + (if (null entry) + (slot-missing (wrapper-class wrapper) object slot-name 'slot-value) + (if (eq (cdr entry) *slot-unbound*) + (slot-unbound (wrapper-class wrapper) object slot-name) + (cdr entry))))) + +(defun set-class-slot-value-1 (new-value object wrapper slot-name) + (let ((entry (assoc slot-name (wrapper-class-slots wrapper)))) + (if (null entry) + (slot-missing (wrapper-class wrapper) + object + slot-name + 'setf + new-value) + (setf (cdr entry) new-value)))) + +(defmethod class-slot-value ((class std-class) slot-name) + (let ((wrapper (class-wrapper class)) + (prototype (class-prototype class))) + (get-class-slot-value-1 prototype wrapper slot-name))) + +(defmethod (setf class-slot-value) (nv (class std-class) slot-name) + (let ((wrapper (class-wrapper class)) + (prototype (class-prototype class))) + (set-class-slot-value-1 nv prototype wrapper slot-name))) + + + +(defun find-slot-definition (class slot-name) + (dolist (slot (class-slots class) nil) + (when (eql slot-name (slot-definition-name slot)) + (return slot)))) + +(defun slot-value (object slot-name) + (let* ((class (class-of object)) + (slot-definition (find-slot-definition class slot-name))) + (if (null slot-definition) + (slot-missing class object slot-name 'slot-value) + (slot-value-using-class class object slot-definition)))) + +(setf (gdefinition 'slot-value-normal) #'slot-value) + +(define-compiler-macro slot-value (object-form slot-name-form) + (if (and (constantp slot-name-form) + (let ((slot-name (eval slot-name-form))) + (and (symbolp slot-name) (symbol-package slot-name)))) + `(accessor-slot-value ,object-form ,slot-name-form) + `(slot-value-normal ,object-form ,slot-name-form))) + +(defun set-slot-value (object slot-name new-value) + (let* ((class (class-of object)) + (slot-definition (find-slot-definition class slot-name))) + (if (null slot-definition) + (slot-missing class object slot-name 'setf) + (setf (slot-value-using-class class object slot-definition) + new-value)))) + +(setf (gdefinition 'set-slot-value-normal) #'set-slot-value) + +(define-compiler-macro set-slot-value (object-form slot-name-form new-value-form) + (if (and (constantp slot-name-form) + (let ((slot-name (eval slot-name-form))) + (and (symbolp slot-name) (symbol-package slot-name)))) + `(accessor-set-slot-value ,object-form ,slot-name-form ,new-value-form) + `(set-slot-value-normal ,object-form ,slot-name-form ,new-value-form))) + +(defconstant *optimize-slot-boundp* nil) + +(defun slot-boundp (object slot-name) + (let* ((class (class-of object)) + (slot-definition (find-slot-definition class slot-name))) + (if (null slot-definition) + (slot-missing class object slot-name 'slot-boundp) + (slot-boundp-using-class class object slot-definition)))) + +(setf (gdefinition 'slot-boundp-normal) #'slot-boundp) + +(define-compiler-macro slot-boundp (object-form slot-name-form) + (if (and (constantp slot-name-form) + (let ((slot-name (eval slot-name-form))) + (and (symbolp slot-name) (symbol-package slot-name)))) + `(accessor-slot-boundp ,object-form ,slot-name-form) + `(slot-boundp-normal ,object-form ,slot-name-form))) + +(defun slot-makunbound (object slot-name) + (let* ((class (class-of object)) + (slot-definition (find-slot-definition class slot-name))) + (if (null slot-definition) + (slot-missing class object slot-name 'slot-makunbound) + (slot-makunbound-using-class class object slot-definition)))) + +(defun slot-exists-p (object slot-name) + (let ((class (class-of object))) + (not (null (find-slot-definition class slot-name))))) + +;;; +;;; This isn't documented, but is used within PCL in a number of print +;;; object methods (see named-object-print-function). +;;; +(defun slot-value-or-default (object slot-name &optional (default "unbound")) + (if (slot-boundp object slot-name) + (slot-value object slot-name) + default)) + + +;;; +;;; +;;; +(defun standard-instance-access (instance location) + (%instance-ref (std-instance-slots instance) location)) + +(defun funcallable-standard-instance-access (instance location) + (%instance-ref (fsc-instance-slots instance) location)) + +(defmethod slot-value-using-class ((class std-class) + (object standard-object) + (slotd standard-effective-slot-definition)) + (let* ((location (slot-definition-location slotd)) + (value (typecase location + (fixnum + (cond ((std-instance-p object) + (unless (eq 't (wrapper-state (std-instance-wrapper object))) + (check-wrapper-validity object)) + (%instance-ref (std-instance-slots object) location)) + ((fsc-instance-p object) + (unless (eq 't (wrapper-state (fsc-instance-wrapper object))) + (check-wrapper-validity object)) + (%instance-ref (fsc-instance-slots object) location)) + (t (error "What kind of instance is this?")))) + (cons + (cdr location)) + (t + (error "The slot ~s has neither :instance nor :class allocation, ~@ + so it can't be read by the default ~s method." + slotd 'slot-value-using-class))))) + (if (eq value *slot-unbound*) + (slot-unbound class object (slot-definition-name slotd)) + value))) + +(defmethod (setf slot-value-using-class) + (new-value (class std-class) + (object standard-object) + (slotd standard-effective-slot-definition)) + (let ((location (slot-definition-location slotd))) + (typecase location + (fixnum + (cond ((std-instance-p object) + (unless (eq 't (wrapper-state (std-instance-wrapper object))) + (check-wrapper-validity object)) + (setf (%instance-ref (std-instance-slots object) location) new-value)) + ((fsc-instance-p object) + (unless (eq 't (wrapper-state (fsc-instance-wrapper object))) + (check-wrapper-validity object)) + (setf (%instance-ref (fsc-instance-slots object) location) new-value)) + (t (error "What kind of instance is this?")))) + (cons + (setf (cdr location) new-value)) + (t + (error "The slot ~s has neither :instance nor :class allocation, ~@ + so it can't be written by the default ~s method." + slotd '(setf slot-value-using-class)))))) + +(defmethod slot-boundp-using-class + ((class std-class) + (object standard-object) + (slotd standard-effective-slot-definition)) + (let* ((location (slot-definition-location slotd)) + (value (typecase location + (fixnum + (cond ((std-instance-p object) + (unless (eq 't (wrapper-state (std-instance-wrapper object))) + (check-wrapper-validity object)) + (%instance-ref (std-instance-slots object) location)) + ((fsc-instance-p object) + (unless (eq 't (wrapper-state (fsc-instance-wrapper object))) + (check-wrapper-validity object)) + (%instance-ref (fsc-instance-slots object) location)) + (t (error "What kind of instance is this?")))) + (cons + (cdr location)) + (t + (error "The slot ~s has neither :instance nor :class allocation, ~@ + so it can't be read by the default ~s method." + slotd 'slot-boundp-using-class))))) + (not (eq value *slot-unbound*)))) + +(defmethod slot-makunbound-using-class + ((class std-class) + (object standard-object) + (slotd standard-effective-slot-definition)) + (let ((location (slot-definition-location slotd))) + (typecase location + (fixnum + (cond ((std-instance-p object) + (unless (eq 't (wrapper-state (std-instance-wrapper object))) + (check-wrapper-validity object)) + (setf (%instance-ref (std-instance-slots object) location) *slot-unbound*)) + ((fsc-instance-p object) + (unless (eq 't (wrapper-state (fsc-instance-wrapper object))) + (check-wrapper-validity object)) + (setf (%instance-ref (fsc-instance-slots object) location) *slot-unbound*)) + (t (error "What kind of instance is this?")))) + (cons + (setf (cdr location) *slot-unbound*)) + (t + (error "The slot ~s has neither :instance nor :class allocation, ~@ + so it can't be written by the default ~s method." + slotd 'slot-makunbound-using-class)))) + nil) + +(defmethod slot-value-using-class + ((class structure-class) + (object structure-object) + (slotd structure-effective-slot-definition)) + (let* ((function (slot-definition-internal-reader-function slotd)) + (value (funcall function object))) + #+cmu (declare (type function function)) + (if (eq value *slot-unbound*) + (slot-unbound class object (slot-definition-name slotd)) + value))) + +(defmethod (setf slot-value-using-class) + (new-value (class structure-class) + (object structure-object) + (slotd structure-effective-slot-definition)) + (let ((function (slot-definition-internal-writer-function slotd))) + #+cmu (declare (type function function)) + (funcall function new-value object))) + +(defmethod slot-boundp-using-class + ((class structure-class) + (object structure-object) + (slotd structure-effective-slot-definition)) + #-new-kcl-wrapper t + #+new-kcl-wrapper + (let* ((function (slot-definition-internal-reader-function slotd)) + (value (funcall function object))) + #+cmu (declare (type function function)) + (not (eq value *slot-unbound*)))) + +(defmethod slot-makunbound-using-class + ((class structure-class) + (object structure-object) + (slotd structure-effective-slot-definition)) + (error "Structure slots can't be unbound")) + + +(defmethod slot-missing + ((class t) instance slot-name operation &optional new-value) + (error "When attempting to ~A,~%the slot ~S is missing from the object ~S." + (ecase operation + (slot-value "read the slot's value (slot-value)") + (setf (format nil + "set the slot's value to ~S (setf of slot-value)" + new-value)) + (slot-boundp "test to see if slot is bound (slot-boundp)") + (slot-makunbound "make the slot unbound (slot-makunbound)")) + slot-name + instance)) + +(defmethod slot-unbound ((class t) instance slot-name) + (error "The slot ~S is unbound in the object ~S." slot-name instance)) + +(defun slot-unbound-internal (instance position) + (slot-unbound (class-of instance) instance + (etypecase position + (fixnum + (nth position + (wrapper-instance-slots-layout (wrapper-of instance)))) + (cons + (car position))))) + + +(defmethod allocate-instance ((class standard-class) &rest initargs) + (declare (ignore initargs)) + (unless (class-finalized-p class) (finalize-inheritance class)) + (allocate-standard-instance (class-wrapper class))) + +(defmethod allocate-instance ((class structure-class) &rest initargs) + (declare (ignore initargs)) + #-new-kcl-wrapper + (let ((constructor (class-defstruct-constructor class))) + (if constructor + (funcall constructor) + (error "Can't allocate an instance of class ~S" (class-name class)))) + #+new-kcl-wrapper + (allocate-standard-instance (class-wrapper class))) + + diff --git a/pcl/gcl_pcl_slots_boot.lisp b/pcl/gcl_pcl_slots_boot.lisp new file mode 100644 index 0000000..48db465 --- /dev/null +++ b/pcl/gcl_pcl_slots_boot.lisp @@ -0,0 +1,406 @@ +;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(defmacro slot-symbol (slot-name type) + `(if (symbolp ,slot-name) + (or (get ,slot-name ',(ecase type + (reader 'reader-symbol) + (writer 'writer-symbol) + (boundp 'boundp-symbol))) + (intern (format nil "~A ~A slot ~a" + (if (symbol-package ,slot-name) + (package-name (symbol-package ,slot-name)) + "UNINTERNED") + (symbol-name ,slot-name) + ,(symbol-name type)) + *slot-accessor-name-package*)) + (progn + (error "non-symbol and non-interned symbol slot name accessors~ + are not yet implemented") + ;;(make-symbol (format nil "~a ~a" ,slot-name ,type)) + ))) + +(defun slot-reader-symbol (slot-name) + (slot-symbol slot-name reader)) + +(defun slot-writer-symbol (slot-name) + (slot-symbol slot-name writer)) + +(defun slot-boundp-symbol (slot-name) + (slot-symbol slot-name boundp)) + +(defmacro asv-funcall (sym slot-name type &rest args) + (declare (ignore type)) + `(if (#-akcl fboundp #+akcl %fboundp ',sym) + (,sym ,@args) + (no-slot ',sym ',slot-name))) + +(defun no-slot (sym slot-name) + (error "No class has a slot named ~S (~s has no function binding)." + slot-name sym)) + +(defmacro accessor-slot-value (object slot-name) + (unless (constantp slot-name) + (error "~s requires its slot-name argument to be a constant" + 'accessor-slot-value)) + (let* ((slot-name (eval slot-name)) + (sym (slot-reader-symbol slot-name))) + `(asv-funcall ,sym ,slot-name reader ,object))) + +(defmacro accessor-set-slot-value (object slot-name new-value &environment env) + (unless (constantp slot-name) + (error "~s requires its slot-name argument to be a constant" + 'accessor-set-slot-value)) + (setq object (macroexpand object env)) + (setq slot-name (macroexpand slot-name env)) + (let* ((slot-name (eval slot-name)) + (bindings (unless (or (constantp new-value) (atom new-value)) + (let ((object-var (gensym))) + (prog1 `((,object-var ,object)) + (setq object object-var))))) + (sym (slot-writer-symbol slot-name)) + (form `(asv-funcall ,sym ,slot-name writer ,new-value ,object))) + (if bindings + `(let ,bindings ,form) + form))) + +(defconstant *optimize-slot-boundp* nil) + +(defmacro accessor-slot-boundp (object slot-name) + (unless (constantp slot-name) + (error "~s requires its slot-name argument to be a constant" + 'accessor-slot-boundp)) + (let* ((slot-name (eval slot-name)) + (sym (slot-boundp-symbol slot-name))) + (if (not *optimize-slot-boundp*) + `(slot-boundp-normal ,object ',slot-name) + `(asv-funcall ,sym ,slot-name boundp ,object)))) + + +(defun structure-slot-boundp (object) + (declare (ignore object)) + t) + +(defun make-structure-slot-boundp-function (slotd) + (let* ((reader (slot-definition-internal-reader-function slotd)) + (fun #'(lambda (object) + (not (eq (funcall reader object) *slot-unbound*))))) + (declare (type function reader)) + #+(and kcl turbo-closure) (si:turbo-closure fun) + fun)) + +(defun get-optimized-std-accessor-method-function (class slotd name) + (if (structure-class-p class) + (ecase name + (reader (slot-definition-internal-reader-function slotd)) + (writer (slot-definition-internal-writer-function slotd)) + (boundp (make-structure-slot-boundp-function slotd))) + (let* ((fsc-p (cond ((standard-class-p class) nil) + ((funcallable-standard-class-p class) t) + (t (error "~S is not a standard-class" class)))) + (slot-name (slot-definition-name slotd)) + (index (slot-definition-location slotd)) + (function (ecase name + (reader #'make-optimized-std-reader-method-function) + (writer #'make-optimized-std-writer-method-function) + (boundp #'make-optimized-std-boundp-method-function))) + (value (funcall function fsc-p slot-name index))) + (declare (type function function)) + (values value index)))) + +(defun make-optimized-std-reader-method-function (fsc-p slot-name index) + (declare #.*optimize-speed*) + (set-function-name + (etypecase index + (fixnum (if fsc-p + #'(lambda (instance) + (let ((value (%instance-ref (fsc-instance-slots instance) index))) + (if (eq value *slot-unbound*) + (slot-unbound (class-of instance) instance slot-name) + value))) + #'(lambda (instance) + (let ((value (%instance-ref (std-instance-slots instance) index))) + (if (eq value *slot-unbound*) + (slot-unbound (class-of instance) instance slot-name) + value))))) + (cons #'(lambda (instance) + (let ((value (cdr index))) + (if (eq value *slot-unbound*) + (slot-unbound (class-of instance) instance slot-name) + value))))) + `(reader ,slot-name))) + +(defun make-optimized-std-writer-method-function (fsc-p slot-name index) + (declare #.*optimize-speed*) + (set-function-name + (etypecase index + (fixnum (if fsc-p + #'(lambda (nv instance) + (setf (%instance-ref (fsc-instance-slots instance) index) nv)) + #'(lambda (nv instance) + (setf (%instance-ref (std-instance-slots instance) index) nv)))) + (cons #'(lambda (nv instance) + (declare (ignore instance)) + (setf (cdr index) nv)))) + `(writer ,slot-name))) + +(defun make-optimized-std-boundp-method-function (fsc-p slot-name index) + (declare #.*optimize-speed*) + (set-function-name + (etypecase index + (fixnum (if fsc-p + #'(lambda (instance) + (not (eq *slot-unbound* + (%instance-ref (fsc-instance-slots instance) index)))) + #'(lambda (instance) + (not (eq *slot-unbound* + (%instance-ref (std-instance-slots instance) index)))))) + (cons #'(lambda (instance) + (declare (ignore instance)) + (not (eq *slot-unbound* (cdr index)))))) + `(boundp ,slot-name))) + +(defun make-optimized-structure-slot-value-using-class-method-function (function) + #+cmu (declare (type function function)) + #'(lambda (class object slotd) + (let ((value (funcall function object))) + (if (eq value *slot-unbound*) + (slot-unbound class object (slot-definition-name slotd)) + value)))) + +(defun make-optimized-structure-setf-slot-value-using-class-method-function (function) + #+cmu (declare (type function function)) + #'(lambda (nv class object slotd) + (declare (ignore class slotd)) + (funcall function nv object))) + +(defun make-optimized-structure-slot-boundp-using-class-method-function (function) + #+cmu (declare (type function function)) + #'(lambda (class object slotd) + (declare (ignore class slotd)) + (not (eq (funcall function object) *slot-unbound*)))) + +(defun get-optimized-std-slot-value-using-class-method-function (class slotd name) + (if (structure-class-p class) + (ecase name + (reader (make-optimized-structure-slot-value-using-class-method-function + (slot-definition-internal-reader-function slotd))) + (writer (make-optimized-structure-setf-slot-value-using-class-method-function + (slot-definition-internal-writer-function slotd))) + (boundp (make-optimized-structure-slot-boundp-using-class-method-function + (slot-definition-internal-writer-function slotd)))) + (let* ((fsc-p (cond ((standard-class-p class) nil) + ((funcallable-standard-class-p class) t) + (t (error "~S is not a standard-class" class)))) + (slot-name (slot-definition-name slotd)) + (index (slot-definition-location slotd)) + (function + (ecase name + (reader + #'make-optimized-std-slot-value-using-class-method-function) + (writer + #'make-optimized-std-setf-slot-value-using-class-method-function) + (boundp + #'make-optimized-std-slot-boundp-using-class-method-function)))) + #+cmu (declare (type function function)) + (values (funcall function fsc-p slot-name index) index)))) + +(defun make-optimized-std-slot-value-using-class-method-function + (fsc-p slot-name index) + (declare #.*optimize-speed*) + (etypecase index + (fixnum (if fsc-p + #'(lambda (class instance slotd) + (declare (ignore slotd)) + (unless (fsc-instance-p instance) (error "not fsc")) + (let ((value (%instance-ref (fsc-instance-slots instance) index))) + (if (eq value *slot-unbound*) + (slot-unbound class instance slot-name) + value))) + #'(lambda (class instance slotd) + (declare (ignore slotd)) + (unless (std-instance-p instance) (error "not std")) + (let ((value (%instance-ref (std-instance-slots instance) index))) + (if (eq value *slot-unbound*) + (slot-unbound class instance slot-name) + value))))) + (cons #'(lambda (class instance slotd) + (declare (ignore slotd)) + (let ((value (cdr index))) + (if (eq value *slot-unbound*) + (slot-unbound class instance slot-name) + value)))))) + +(defun make-optimized-std-setf-slot-value-using-class-method-function + (fsc-p slot-name index) + (declare #.*optimize-speed*) + (declare (ignore slot-name)) + (etypecase index + (fixnum (if fsc-p + #'(lambda (nv class instance slotd) + (declare (ignore class slotd)) + (setf (%instance-ref (fsc-instance-slots instance) index) nv)) + #'(lambda (nv class instance slotd) + (declare (ignore class slotd)) + (setf (%instance-ref (std-instance-slots instance) index) nv)))) + (cons #'(lambda (nv class instance slotd) + (declare (ignore class instance slotd)) + (setf (cdr index) nv))))) + +(defun make-optimized-std-slot-boundp-using-class-method-function + (fsc-p slot-name index) + (declare #.*optimize-speed*) + (declare (ignore slot-name)) + (etypecase index + (fixnum (if fsc-p + #'(lambda (class instance slotd) + (declare (ignore class slotd)) + (not (eq *slot-unbound* + (%instance-ref (fsc-instance-slots instance) index)))) + #'(lambda (class instance slotd) + (declare (ignore class slotd)) + (not (eq *slot-unbound* + (%instance-ref (std-instance-slots instance) index)))))) + (cons #'(lambda (class instance slotd) + (declare (ignore class instance slotd)) + (not (eq *slot-unbound* (cdr index))))))) + +(defun get-accessor-from-svuc-method-function (class slotd sdfun name) + (macrolet ((emf-funcall (emf &rest args) + `(invoke-effective-method-function ,emf nil ,@args))) + (set-function-name + (case name + (reader #'(lambda (instance) (emf-funcall sdfun class instance slotd))) + (writer #'(lambda (nv instance) (emf-funcall sdfun nv class instance slotd))) + (boundp #'(lambda (instance) (emf-funcall sdfun class instance slotd)))) + `(,name ,(class-name class) ,(slot-definition-name slotd))))) + +(defun make-internal-reader-method-function (class-name slot-name) + (list* ':method-spec `(internal-reader-method ,class-name ,slot-name) + (make-method-function + (lambda (instance) + (let ((wrapper (get-instance-wrapper-or-nil instance))) + (if wrapper + (let* ((class (wrapper-class* wrapper)) + (index (or (instance-slot-index wrapper slot-name) + (assq slot-name (wrapper-class-slots wrapper))))) + (typecase index + (fixnum + (let ((value (%instance-ref (get-slots instance) index))) + (if (eq value *slot-unbound*) + (slot-unbound (class-of instance) instance slot-name) + value))) + (cons + (let ((value (cdr index))) + (if (eq value *slot-unbound*) + (slot-unbound (class-of instance) instance slot-name) + value))) + (t + (error "The wrapper for class ~S does not have the slot ~S" + class slot-name)))) + (slot-value instance slot-name))))))) + + +(defun make-std-reader-method-function (class-name slot-name) + (let* ((pv-table-symbol (gensym)) + (initargs (copy-tree + (make-method-function + (lambda (instance) + (pv-binding1 (.pv. .calls. + (symbol-value pv-table-symbol) + (instance) (instance-slots)) + (instance-read-internal + .pv. instance-slots 1 + (slot-value instance slot-name)))))))) + (setf (getf (getf initargs ':plist) ':slot-name-lists) + (list (list nil slot-name))) + (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol) + (list* ':method-spec `(reader-method ,class-name ,slot-name) + initargs))) + +(defun make-std-writer-method-function (class-name slot-name) + (let* ((pv-table-symbol (gensym)) + (initargs (copy-tree + (make-method-function + (lambda (nv instance) + (pv-binding1 (.pv. .calls. + (symbol-value pv-table-symbol) + (instance) (instance-slots)) + (instance-write-internal + .pv. instance-slots 1 nv + (setf (slot-value instance slot-name) nv)))))))) + (setf (getf (getf initargs ':plist) ':slot-name-lists) + (list nil (list nil slot-name))) + (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol) + (list* ':method-spec `(writer-method ,class-name ,slot-name) + initargs))) + +(defun make-std-boundp-method-function (class-name slot-name) + (let* ((pv-table-symbol (gensym)) + (initargs (copy-tree + (make-method-function + (lambda (instance) + (pv-binding1 (.pv. .calls. + (symbol-value pv-table-symbol) + (instance) (instance-slots)) + (instance-boundp-internal + .pv. instance-slots 1 + (slot-boundp instance slot-name)))))))) + (setf (getf (getf initargs ':plist) ':slot-name-lists) + (list (list nil slot-name))) + (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol) + (list* ':method-spec `(boundp-method ,class-name ,slot-name) + initargs))) + +(defun initialize-internal-slot-gfs (slot-name &optional type) + (when (or (null type) (eq type 'reader)) + (let* ((name (slot-reader-symbol slot-name)) + (gf (ensure-generic-function name))) + (unless (generic-function-methods gf) + (add-reader-method *the-class-slot-object* gf slot-name)))) + (when (or (null type) (eq type 'writer)) + (let* ((name (slot-writer-symbol slot-name)) + (gf (ensure-generic-function name))) + (unless (generic-function-methods gf) + (add-writer-method *the-class-slot-object* gf slot-name)))) + (when (and *optimize-slot-boundp* + (or (null type) (eq type 'boundp))) + (let* ((name (slot-boundp-symbol slot-name)) + (gf (ensure-generic-function name))) + (unless (generic-function-methods gf) + (add-boundp-method *the-class-slot-object* gf slot-name)))) + nil) + +(defun initialize-internal-slot-gfs* (readers writers boundps) + (dolist (reader readers) + (initialize-internal-slot-gfs reader 'reader)) + (dolist (writer writers) + (initialize-internal-slot-gfs writer 'writer)) + (dolist (boundp boundps) + (initialize-internal-slot-gfs boundp 'boundp))) diff --git a/pcl/gcl_pcl_std_class.lisp b/pcl/gcl_pcl_std_class.lisp new file mode 100644 index 0000000..4c48387 --- /dev/null +++ b/pcl/gcl_pcl_std_class.lisp @@ -0,0 +1,1321 @@ +;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(defmethod slot-accessor-function ((slotd effective-slot-definition) type) + (ecase type + (reader (slot-definition-reader-function slotd)) + (writer (slot-definition-writer-function slotd)) + (boundp (slot-definition-boundp-function slotd)))) + +(defmethod (setf slot-accessor-function) (function + (slotd effective-slot-definition) type) + (ecase type + (reader (setf (slot-definition-reader-function slotd) function)) + (writer (setf (slot-definition-writer-function slotd) function)) + (boundp (setf (slot-definition-boundp-function slotd) function)))) + +(defconstant *slotd-reader-function-std-p* 1) +(defconstant *slotd-writer-function-std-p* 2) +(defconstant *slotd-boundp-function-std-p* 4) +(defconstant *slotd-all-function-std-p* 7) + +(defmethod slot-accessor-std-p ((slotd effective-slot-definition) type) + (let ((flags (slot-value slotd 'accessor-flags))) + (declare (type fixnum flags)) + (if (eq type 'all) + (eql *slotd-all-function-std-p* flags) + (let ((mask (ecase type + (reader *slotd-reader-function-std-p*) + (writer *slotd-writer-function-std-p*) + (boundp *slotd-boundp-function-std-p*)))) + (declare (type fixnum mask)) + (not (zerop (the fixnum (logand mask flags)))))))) + +(defmethod (setf slot-accessor-std-p) (value (slotd effective-slot-definition) type) + (let ((mask (ecase type + (reader *slotd-reader-function-std-p*) + (writer *slotd-writer-function-std-p*) + (boundp *slotd-boundp-function-std-p*))) + (flags (slot-value slotd 'accessor-flags))) + (declare (type fixnum mask flags)) + (setf (slot-value slotd 'accessor-flags) + (if value + (the fixnum (logior mask flags)) + (the fixnum (logand (the fixnum (lognot mask)) flags))))) + value) + +(defmethod initialize-internal-slot-functions ((slotd effective-slot-definition)) + (let* ((name (slot-value slotd 'name)) + (class (slot-value slotd 'class))) + (let ((table (or (gethash name *name->class->slotd-table*) + (setf (gethash name *name->class->slotd-table*) + (make-hash-table :test 'eq :size 5))))) + (setf (gethash class table) slotd)) + (dolist (type '(reader writer boundp)) + (let* ((gf-name (ecase type + (reader 'slot-value-using-class) + (writer '(setf slot-value-using-class)) + (boundp 'slot-boundp-using-class))) + (gf (gdefinition gf-name))) + (compute-slot-accessor-info slotd type gf))) + (initialize-internal-slot-gfs name))) + +(defmethod compute-slot-accessor-info ((slotd effective-slot-definition) type gf) + (let* ((name (slot-value slotd 'name)) + (class (slot-value slotd 'class)) + (old-slotd (find-slot-definition class name)) + (old-std-p (and old-slotd (slot-accessor-std-p old-slotd 'all)))) + (multiple-value-bind (function std-p) + (if (eq *boot-state* 'complete) + (get-accessor-method-function gf type class slotd) + (get-optimized-std-accessor-method-function class slotd type)) + #+kcl (si:turbo-closure function) + (setf (slot-accessor-std-p slotd type) std-p) + (setf (slot-accessor-function slotd type) function)) + (when (and old-slotd (not (eq old-std-p (slot-accessor-std-p slotd 'all)))) + (push (cons class name) *pv-table-cache-update-info*)))) + +(defmethod slot-definition-allocation ((slotd structure-slot-definition)) + :instance) + + + +(defmethod shared-initialize :after ((object documentation-mixin) + slot-names + &key (documentation nil documentation-p)) + (declare (ignore slot-names)) + (when documentation-p + (setf (plist-value object 'documentation) documentation))) + +(defmethod documentation (object &optional doc-type) + (lisp:documentation object doc-type)) + +(defmethod (setf documentation) (new-value object &optional doc-type) + (declare (ignore new-value doc-type)) + (error "Can't change the documentation of ~S." object)) + + +(defmethod documentation ((object documentation-mixin) &optional doc-type) + (declare (ignore doc-type)) + (plist-value object 'documentation)) + +(defmethod (setf documentation) (new-value (object documentation-mixin) &optional doc-type) + (declare (ignore doc-type)) + (setf (plist-value object 'documentation) new-value)) + + +(defmethod documentation ((slotd standard-slot-definition) &optional doc-type) + (declare (ignore doc-type)) + (slot-value slotd 'documentation)) + +(defmethod (setf documentation) (new-value (slotd standard-slot-definition) &optional doc-type) + (declare (ignore doc-type)) + (setf (slot-value slotd 'documentation) new-value)) + + +;;; +;;; Various class accessors that are a little more complicated than can be +;;; done with automatically generated reader methods. +;;; +(defmethod class-finalized-p ((class pcl-class)) + (with-slots (wrapper) class + (not (null wrapper)))) + +(defmethod class-prototype ((class std-class)) + (with-slots (prototype) class + (or prototype (setq prototype (allocate-instance class))))) + +(defmethod class-prototype ((class structure-class)) + (with-slots (prototype wrapper defstruct-constructor) class + (or prototype + (setq prototype + (if #-new-kcl-wrapper defstruct-constructor #+new-kcl-wrapper nil + (allocate-instance class) + (allocate-standard-instance wrapper)))))) + +(defmethod class-direct-default-initargs ((class slot-class)) + (plist-value class 'direct-default-initargs)) + +(defmethod class-default-initargs ((class slot-class)) + (plist-value class 'default-initargs)) + +(defmethod class-constructors ((class slot-class)) + (plist-value class 'constructors)) + +(defmethod class-slot-cells ((class std-class)) + (plist-value class 'class-slot-cells)) + + +;;; +;;; Class accessors that are even a little bit more complicated than those +;;; above. These have a protocol for updating them, we must implement that +;;; protocol. +;;; + +;;; +;;; Maintaining the direct subclasses backpointers. The update methods are +;;; here, the values are read by an automatically generated reader method. +;;; +(defmethod add-direct-subclass ((class class) (subclass class)) + (with-slots (direct-subclasses) class + (pushnew subclass direct-subclasses) + subclass)) + +(defmethod remove-direct-subclass ((class class) (subclass class)) + (with-slots (direct-subclasses) class + (setq direct-subclasses (remove subclass direct-subclasses)) + subclass)) + +;;; +;;; Maintaining the direct-methods and direct-generic-functions backpointers. +;;; +;;; There are four generic functions involved, each has one method for the +;;; class case and another method for the damned EQL specializers. All of +;;; these are specified methods and appear in their specified place in the +;;; class graph. +;;; +;;; ADD-DIRECT-METHOD +;;; REMOVE-DIRECT-METHOD +;;; SPECIALIZER-DIRECT-METHODS +;;; SPECIALIZER-DIRECT-GENERIC-FUNCTIONS +;;; +;;; In each case, we maintain one value which is a cons. The car is the list +;;; methods. The cdr is a list of the generic functions. The cdr is always +;;; computed lazily. +;;; + +(defmethod add-direct-method ((specializer class) (method method)) + (with-slots (direct-methods) specializer + (setf (car direct-methods) (adjoin method (car direct-methods)) ;PUSH + (cdr direct-methods) ())) + method) + +(defmethod remove-direct-method ((specializer class) (method method)) + (with-slots (direct-methods) specializer + (setf (car direct-methods) (remove method (car direct-methods)) + (cdr direct-methods) ())) + method) + +(defmethod specializer-direct-methods ((specializer class)) + (with-slots (direct-methods) specializer + (car direct-methods))) + +(defmethod specializer-direct-generic-functions ((specializer class)) + (with-slots (direct-methods) specializer + (or (cdr direct-methods) + (setf (cdr direct-methods) + (gathering1 (collecting-once) + (dolist (m (car direct-methods)) + (gather1 (method-generic-function m)))))))) + + + +;;; +;;; This hash table is used to store the direct methods and direct generic +;;; functions of EQL specializers. Each value in the table is the cons. +;;; +(defvar *eql-specializer-methods* (make-hash-table :test #'eql)) +(defvar *class-eq-specializer-methods* (make-hash-table :test #'eq)) + +(defmethod specializer-method-table ((specializer eql-specializer)) + *eql-specializer-methods*) + +(defmethod specializer-method-table ((specializer class-eq-specializer)) + *class-eq-specializer-methods*) + +(defmethod add-direct-method ((specializer specializer-with-object) (method method)) + (let* ((object (specializer-object specializer)) + (table (specializer-method-table specializer)) + (entry (gethash object table))) + (unless entry + (setq entry + (setf (gethash object table) + (cons nil nil)))) + (setf (car entry) (adjoin method (car entry)) + (cdr entry) ()) + method)) + +(defmethod remove-direct-method ((specializer specializer-with-object) (method method)) + (let* ((object (specializer-object specializer)) + (entry (gethash object (specializer-method-table specializer)))) + (when entry + (setf (car entry) (remove method (car entry)) + (cdr entry) ())) + method)) + +(defmethod specializer-direct-methods ((specializer specializer-with-object)) + (car (gethash (specializer-object specializer) + (specializer-method-table specializer)))) + +(defmethod specializer-direct-generic-functions ((specializer specializer-with-object)) + (let* ((object (specializer-object specializer)) + (entry (gethash object (specializer-method-table specializer)))) + (when entry + (or (cdr entry) + (setf (cdr entry) + (gathering1 (collecting-once) + (dolist (m (car entry)) + (gather1 (method-generic-function m))))))))) + +(defun map-specializers (function) + (declare (type function function)) + (map-all-classes #'(lambda (class) + (funcall function (class-eq-specializer class)) + (funcall function class))) + (maphash #'(lambda (object methods) + (declare (ignore methods)) + (intern-eql-specializer object)) + *eql-specializer-methods*) + (maphash #'(lambda (object specl) + (declare (ignore object)) + (funcall function specl)) + *eql-specializer-table*) + nil) + +(defun map-all-generic-functions (function) + (declare (type function function)) + (let ((all-generic-functions (make-hash-table :test 'eq))) + (map-specializers #'(lambda (specl) + (dolist (gf (specializer-direct-generic-functions specl)) + (unless (gethash gf all-generic-functions) + (setf (gethash gf all-generic-functions) t) + (funcall function gf)))))) + nil) + +(defmethod shared-initialize :after ((specl class-eq-specializer) slot-names &key) + (declare (ignore slot-names)) + (setf (slot-value specl 'type) `(class-eq ,(specializer-class specl)))) + +(defmethod shared-initialize :after ((specl eql-specializer) slot-names &key) + (declare (ignore slot-names)) + (setf (slot-value specl 'type) `(eql ,(specializer-object specl)))) + + + +(defun real-load-defclass (name metaclass-name supers slots other accessors) + (do-standard-defsetfs-for-defclass accessors) ;*** + (let ((res (apply #'ensure-class name :metaclass metaclass-name + :direct-superclasses supers + :direct-slots slots + :definition-source `((defclass ,name) + ,(load-truename)) + other))) + #+cmu17 (kernel:layout-class (class-wrapper res)) + #-cmu17 res)) + +(setf (gdefinition 'load-defclass) #'real-load-defclass) + +(defun ensure-class (name &rest all) + (apply #'ensure-class-using-class name (find-class name nil) all)) + +(defmethod ensure-class-using-class (name (class null) &rest args &key) + (multiple-value-bind (meta initargs) + (ensure-class-values class args) + (inform-type-system-about-class (class-prototype meta) name);*** + (setf class (apply #'make-instance meta :name name initargs) + (find-class name) class) + (inform-type-system-about-class class name) ;*** + class)) + +(defmethod ensure-class-using-class (name (class pcl-class) &rest args &key) + (multiple-value-bind (meta initargs) + (ensure-class-values class args) + (unless (eq (class-of class) meta) (change-class class meta)) + (apply #'reinitialize-instance class initargs) + (setf (find-class name) class) + (inform-type-system-about-class class name) ;*** + class)) + +(defmethod class-predicate-name ((class t)) + 'function-returning-nil) + +(defun ensure-class-values (class args) + (let* ((initargs (copy-list args)) + (unsupplied (list 1)) + (supplied-meta (getf initargs :metaclass unsupplied)) + (supplied-supers (getf initargs :direct-superclasses unsupplied)) + (supplied-slots (getf initargs :direct-slots unsupplied)) + (meta + (cond ((neq supplied-meta unsupplied) + (find-class supplied-meta)) + ((or (null class) + (forward-referenced-class-p class)) + *the-class-standard-class*) + (t + (class-of class))))) + (flet ((fix-super (s) + (cond ((classp s) s) + ((not (legal-class-name-p s)) + (error "~S is not a class or a legal class name." s)) + (t + (or (find-class s nil) + (setf (find-class s) + (make-instance 'forward-referenced-class + :name s))))))) + (loop (unless (remf initargs :metaclass) (return))) + (loop (unless (remf initargs :direct-superclasses) (return))) + (loop (unless (remf initargs :direct-slots) (return))) + (values meta + (list* :direct-superclasses + (and (neq supplied-supers unsupplied) + (mapcar #'fix-super supplied-supers)) + :direct-slots + (and (neq supplied-slots unsupplied) supplied-slots) + initargs))))) + + +;;; +;;; +;;; +#|| ; since it doesn't do anything +(defmethod shared-initialize :before ((class std-class) + slot-names + &key direct-superclasses) + (declare (ignore slot-names)) + ;; *** error checking + ) +||# + +(defmethod shared-initialize :after + ((class std-class) + slot-names + &key (direct-superclasses nil direct-superclasses-p) + (direct-slots nil direct-slots-p) + (direct-default-initargs nil direct-default-initargs-p) + (predicate-name nil predicate-name-p)) + (declare (ignore slot-names)) + (if direct-superclasses-p + (progn + (setq direct-superclasses (or direct-superclasses + (list *the-class-standard-object*))) + (dolist (superclass direct-superclasses) + (unless (validate-superclass class superclass) + (error "The class ~S was specified as a~%super-class of the class ~S;~%~ + but the meta-classes ~S and~%~S are incompatible.~% + Define a method for ~S to avoid this error." + superclass class (class-of superclass) (class-of class) + 'validate-superclass))) + (setf (slot-value class 'direct-superclasses) direct-superclasses)) + (setq direct-superclasses (slot-value class 'direct-superclasses))) + (setq direct-slots + (if direct-slots-p + (setf (slot-value class 'direct-slots) + (mapcar #'(lambda (pl) (make-direct-slotd class pl)) direct-slots)) + (slot-value class 'direct-slots))) + (if direct-default-initargs-p + (setf (plist-value class 'direct-default-initargs) direct-default-initargs) + (setq direct-default-initargs (plist-value class 'direct-default-initargs))) + (setf (plist-value class 'class-slot-cells) + (gathering1 (collecting) + (dolist (dslotd direct-slots) + (when (eq (slot-definition-allocation dslotd) class) + (let ((initfunction (slot-definition-initfunction dslotd))) + (gather1 (cons (slot-definition-name dslotd) + (if initfunction + (funcall initfunction) + *slot-unbound*)))))))) + (setq predicate-name (if predicate-name-p + (setf (slot-value class 'predicate-name) + (car predicate-name)) + (or (slot-value class 'predicate-name) + (setf (slot-value class 'predicate-name) + (make-class-predicate-name (class-name class)))))) + (add-direct-subclasses class direct-superclasses) + (update-class class nil) + (make-class-predicate class predicate-name) + (add-slot-accessors class direct-slots)) + +(defmethod shared-initialize :before ((class class) slot-names &key name) + (declare (ignore slot-names name)) + (setf (slot-value class 'type) `(class ,class)) + (setf (slot-value class 'class-eq-specializer) + (make-instance 'class-eq-specializer :class class))) + +(defmethod reinitialize-instance :before ((class slot-class) &key) + (remove-direct-subclasses class (class-direct-superclasses class)) + (remove-slot-accessors class (class-direct-slots class))) + +(defmethod reinitialize-instance :after ((class slot-class) + &rest initargs + &key) + (map-dependents class + #'(lambda (dependent) + (apply #'update-dependent class dependent initargs)))) + +(defmethod shared-initialize :after + ((class structure-class) + slot-names + &key (direct-superclasses nil direct-superclasses-p) + (direct-slots nil direct-slots-p) + direct-default-initargs + (predicate-name nil predicate-name-p)) + (declare (ignore slot-names direct-default-initargs)) + (if direct-superclasses-p + (setf (slot-value class 'direct-superclasses) + (or direct-superclasses + (setq direct-superclasses + (and (not (eq (class-name class) 'structure-object)) + (list *the-class-structure-object*))))) + (setq direct-superclasses (slot-value class 'direct-superclasses))) + (let* ((name (class-name class)) + (from-defclass-p (slot-value class 'from-defclass-p)) + (defstruct-p (or from-defclass-p (not (structure-type-p name))))) + (if direct-slots-p + (setf (slot-value class 'direct-slots) + (setq direct-slots + (mapcar #'(lambda (pl) + (when defstruct-p + (let* ((slot-name (getf pl :name)) + (acc-name (format nil "~s structure class ~a" + name slot-name)) + (accessor (intern acc-name))) + (setq pl (list* :defstruct-accessor-symbol accessor + pl)))) + (make-direct-slotd class pl)) + direct-slots))) + (setq direct-slots (slot-value class 'direct-slots))) + (when defstruct-p + (let* ((include (car (slot-value class 'direct-superclasses))) + (conc-name (intern (format nil "~s structure class " name))) + (constructor (intern (format nil "~a constructor" conc-name))) + (defstruct `(defstruct (,name + ,@(when include + `((:include ,(class-name include)))) + (:print-function print-std-instance) + (:predicate nil) + (:conc-name ,conc-name) + (:constructor ,constructor ())) + ,@(mapcar #'(lambda (slot) + `(,(slot-definition-name slot) + *slot-unbound*)) + direct-slots))) + (reader-names (mapcar #'(lambda (slotd) + (intern (format nil "~A~A reader" conc-name + (slot-definition-name slotd)))) + direct-slots)) + (writer-names (mapcar #'(lambda (slotd) + (intern (format nil "~A~A writer" conc-name + (slot-definition-name slotd)))) + direct-slots)) + (readers-init + (mapcar #'(lambda (slotd reader-name) + (let ((accessor + (slot-definition-defstruct-accessor-symbol slotd))) + `(defun ,reader-name (obj) + (declare (type ,name obj)) + (,accessor obj)))) + direct-slots reader-names)) + (writers-init + (mapcar #'(lambda (slotd writer-name) + (let ((accessor + (slot-definition-defstruct-accessor-symbol slotd))) + `(defun ,writer-name (nv obj) + (declare (type ,name obj)) + (setf (,accessor obj) nv)))) + direct-slots writer-names)) + (defstruct-form + `(progn + ,defstruct + ,@readers-init ,@writers-init + (declare-structure ',name nil nil)))) + (unless (structure-type-p name) (eval defstruct-form)) + (mapc #'(lambda (dslotd reader-name writer-name) + (let* ((reader (gdefinition reader-name)) + (writer (when (gboundp writer-name) + (gdefinition writer-name)))) + (setf (slot-value dslotd 'internal-reader-function) reader) + (setf (slot-value dslotd 'internal-writer-function) writer))) + direct-slots reader-names writer-names) + (setf (slot-value class 'defstruct-form) defstruct-form) + (setf (slot-value class 'defstruct-constructor) constructor)))) + (add-direct-subclasses class direct-superclasses) + (setf (slot-value class 'class-precedence-list) + (compute-class-precedence-list class)) + (setf (slot-value class 'slots) (compute-slots class)) + #-(or cmu17 new-kcl-wrapper) + (unless (slot-value class 'wrapper) + (setf (slot-value class 'wrapper) (make-wrapper 0 class))) + #+cmu17 + (let ((lclass (lisp:find-class (class-name class)))) + (setf (kernel:class-pcl-class lclass) class) + (setf (slot-value class 'wrapper) (kernel:class-layout lclass))) + #+new-kcl-wrapper + (let ((wrapper (get (class-name class) 'si::s-data))) + (setf (slot-value class 'wrapper) wrapper) + (setf (wrapper-class wrapper) class)) + (update-pv-table-cache-info class) + (setq predicate-name (if predicate-name-p + (setf (slot-value class 'predicate-name) + (car predicate-name)) + (or (slot-value class 'predicate-name) + (setf (slot-value class 'predicate-name) + (make-class-predicate-name (class-name class)))))) + (make-class-predicate class predicate-name) + (add-slot-accessors class direct-slots)) + +(defmethod direct-slot-definition-class ((class structure-class) initargs) + (declare (ignore initargs)) + (find-class 'structure-direct-slot-definition)) + +(defmethod finalize-inheritance ((class structure-class)) + nil) ; always finalized + +(defun add-slot-accessors (class dslotds) + (fix-slot-accessors class dslotds 'add)) + +(defun remove-slot-accessors (class dslotds) + (fix-slot-accessors class dslotds 'remove)) + +(defun fix-slot-accessors (class dslotds add/remove) + (flet ((fix (gfspec name r/w) + (let ((gf (ensure-generic-function gfspec))) + (case r/w + (r (if (eq add/remove 'add) + (add-reader-method class gf name) + (remove-reader-method class gf))) + (w (if (eq add/remove 'add) + (add-writer-method class gf name) + (remove-writer-method class gf))))))) + (dolist (dslotd dslotds) + (let ((slot-name (slot-definition-name dslotd))) + (dolist (r (slot-definition-readers dslotd)) (fix r slot-name 'r)) + (dolist (w (slot-definition-writers dslotd)) (fix w slot-name 'w)))))) + + +(defun add-direct-subclasses (class new) + (dolist (n new) + (unless (memq class (class-direct-subclasses class)) + (add-direct-subclass n class)))) + +(defun remove-direct-subclasses (class new) + (let ((old (class-direct-superclasses class))) + (dolist (o (set-difference old new)) + (remove-direct-subclass o class)))) + + +;;; +;;; +;;; +(defmethod finalize-inheritance ((class std-class)) + (update-class class t)) + + +(defun class-has-a-forward-referenced-superclass-p (class) + (or (forward-referenced-class-p class) + (some #'class-has-a-forward-referenced-superclass-p + (class-direct-superclasses class)))) + +;;; +;;; Called by :after shared-initialize whenever a class is initialized or +;;; reinitialized. The class may or may not be finalized. +;;; +(defun update-class (class finalizep) + (when (or finalizep (class-finalized-p class) + (not (class-has-a-forward-referenced-superclass-p class))) + (update-cpl class (compute-class-precedence-list class)) + (update-slots class (compute-slots class)) + (update-gfs-of-class class) + (update-inits class (compute-default-initargs class)) + (update-make-instance-function-table class)) + (unless finalizep + (dolist (sub (class-direct-subclasses class)) (update-class sub nil)))) + +(defun update-cpl (class cpl) + (when (class-finalized-p class) + (unless (equal (class-precedence-list class) cpl) + (force-cache-flushes class))) + (setf (slot-value class 'class-precedence-list) cpl) + (update-class-can-precede-p cpl)) + +(defun update-class-can-precede-p (cpl) + (when cpl + (let ((first (car cpl))) + (dolist (c (cdr cpl)) + (pushnew c (slot-value first 'can-precede-list)))) + (update-class-can-precede-p (cdr cpl)))) + +(defun class-can-precede-p (class1 class2) + (member class2 (class-can-precede-list class1))) + +(defun update-slots (class eslotds) + (let ((instance-slots ()) + (class-slots ())) + (dolist (eslotd eslotds) + (let ((alloc (slot-definition-allocation eslotd))) + (cond ((eq alloc :instance) (push eslotd instance-slots)) + ((classp alloc) (push eslotd class-slots))))) + ;; + ;; If there is a change in the shape of the instances then the + ;; old class is now obsolete. + ;; + (let* ((nlayout (mapcar #'slot-definition-name + (sort instance-slots #'< :key #'slot-definition-location))) + (nslots (length nlayout)) + (nwrapper-class-slots (compute-class-slots class-slots)) + (owrapper (class-wrapper class)) + (olayout (and owrapper (wrapper-instance-slots-layout owrapper))) + (owrapper-class-slots (and owrapper (wrapper-class-slots owrapper))) + (nwrapper + (cond ((null owrapper) + (make-wrapper nslots class)) + ((and (equal nlayout olayout) + (not + (iterate ((o (list-elements owrapper-class-slots)) + (n (list-elements nwrapper-class-slots))) + (unless (eq (car o) (car n)) (return t))))) + owrapper) + (t + ;; + ;; This will initialize the new wrapper to have the same + ;; state as the old wrapper. We will then have to change + ;; that. This may seem like wasted work (it is), but the + ;; spec requires that we call make-instances-obsolete. + ;; + (make-instances-obsolete class) + (class-wrapper class))))) + + (with-slots (wrapper slots) class + #+new-kcl-wrapper + (setf (si::s-data-name nwrapper) (class-name class)) + #+cmu17 + (update-lisp-class-layout class nwrapper) + (setf slots eslotds + (wrapper-instance-slots-layout nwrapper) nlayout + (wrapper-class-slots nwrapper) nwrapper-class-slots + (wrapper-no-of-instance-slots nwrapper) nslots + wrapper nwrapper)) + + (unless (eq owrapper nwrapper) + (update-pv-table-cache-info class))))) + +(defun compute-class-slots (eslotds) + (gathering1 (collecting) + (dolist (eslotd eslotds) + (gather1 + (assoc (slot-definition-name eslotd) + (class-slot-cells (slot-definition-allocation eslotd))))))) + +(defun compute-layout (cpl instance-eslotds) + (let* ((names + (gathering1 (collecting) + (dolist (eslotd instance-eslotds) + (when (eq (slot-definition-allocation eslotd) :instance) + (gather1 (slot-definition-name eslotd)))))) + (order ())) + (labels ((rwalk (tail) + (when tail + (rwalk (cdr tail)) + (dolist (ss (class-slots (car tail))) + (let ((n (slot-definition-name ss))) + (when (member n names) + (setq order (cons n order) + names (remove n names)))))))) + (rwalk (if (slot-boundp (car cpl) 'slots) + cpl + (cdr cpl))) + (reverse (append names order))))) + +(defun update-gfs-of-class (class) + (when (and (class-finalized-p class) + (let ((cpl (class-precedence-list class))) + (or (member *the-class-slot-class* cpl) + (member *the-class-standard-effective-slot-definition* cpl)))) + (let ((gf-table (make-hash-table :test 'eq))) + (labels ((collect-gfs (class) + (dolist (gf (specializer-direct-generic-functions class)) + (setf (gethash gf gf-table) t)) + (mapc #'collect-gfs (class-direct-superclasses class)))) + (collect-gfs class) + (maphash #'(lambda (gf ignore) + (declare (ignore ignore)) + (update-gf-dfun class gf)) + gf-table))))) + +(defun update-inits (class inits) + (setf (plist-value class 'default-initargs) inits)) + + +;;; +;;; +;;; +(defmethod compute-default-initargs ((class slot-class)) + (let ((cpl (class-precedence-list class)) + (direct (class-direct-default-initargs class))) + (labels ((walk (tail) + (if (null tail) + nil + (let ((c (pop tail))) + (append (if (eq c class) + direct + (class-direct-default-initargs c)) + (walk tail)))))) + (let ((initargs (walk cpl))) + (delete-duplicates initargs :test #'eq :key #'car :from-end t))))) + + +;;; +;;; Protocols for constructing direct and effective slot definitions. +;;; +;;; +;;; +;;; +(defmethod direct-slot-definition-class ((class std-class) initargs) + (declare (ignore initargs)) + (find-class 'standard-direct-slot-definition)) + +(defun make-direct-slotd (class initargs) + (let ((initargs (list* :class class initargs))) + (apply #'make-instance (direct-slot-definition-class class initargs) initargs))) + +;;; +;;; +;;; +(defmethod compute-slots ((class std-class)) + ;; + ;; As specified, we must call COMPUTE-EFFECTIVE-SLOT-DEFINITION once + ;; for each different slot name we find in our superclasses. Each + ;; call receives the class and a list of the dslotds with that name. + ;; The list is in most-specific-first order. + ;; + (let ((name-dslotds-alist ())) + (dolist (c (class-precedence-list class)) + (let ((dslotds (class-direct-slots c))) + (dolist (d dslotds) + (let* ((name (slot-definition-name d)) + (entry (assq name name-dslotds-alist))) + (if entry + (push d (cdr entry)) + (push (list name d) name-dslotds-alist)))))) + (mapcar #'(lambda (direct) + (compute-effective-slot-definition class + (nreverse (cdr direct)))) + name-dslotds-alist))) + +(defmethod compute-slots :around ((class std-class)) + (let ((eslotds (call-next-method)) + (cpl (class-precedence-list class)) + (instance-slots ()) + (class-slots ())) + (dolist (eslotd eslotds) + (let ((alloc (slot-definition-allocation eslotd))) + (cond ((eq alloc :instance) (push eslotd instance-slots)) + ((classp alloc) (push eslotd class-slots))))) + (let ((nlayout (compute-layout cpl instance-slots))) + (dolist (eslotd instance-slots) + (setf (slot-definition-location eslotd) + (position (slot-definition-name eslotd) nlayout)))) + (dolist (eslotd class-slots) + (setf (slot-definition-location eslotd) + (assoc (slot-definition-name eslotd) + (class-slot-cells (slot-definition-allocation eslotd))))) + (mapc #'initialize-internal-slot-functions eslotds) + eslotds)) + +(defmethod compute-slots ((class structure-class)) + (mapcan #'(lambda (superclass) + (mapcar #'(lambda (dslotd) + (compute-effective-slot-definition class + (list dslotd))) + (class-direct-slots superclass))) + (reverse (slot-value class 'class-precedence-list)))) + +(defmethod compute-slots :around ((class structure-class)) + (let ((eslotds (call-next-method))) + (mapc #'initialize-internal-slot-functions eslotds) + eslotds)) + +(defmethod compute-effective-slot-definition ((class slot-class) dslotds) + (let* ((initargs (compute-effective-slot-definition-initargs class dslotds)) + (class (effective-slot-definition-class class initargs))) + (apply #'make-instance class initargs))) + +(defmethod effective-slot-definition-class ((class std-class) initargs) + (declare (ignore initargs)) + (find-class 'standard-effective-slot-definition)) + +(defmethod effective-slot-definition-class ((class structure-class) initargs) + (declare (ignore initargs)) + (find-class 'structure-effective-slot-definition)) + +(defmethod compute-effective-slot-definition-initargs + ((class slot-class) direct-slotds) + (let* ((name nil) + (initfunction nil) + (initform nil) + (initargs nil) + (allocation nil) + (type t) + (namep nil) + (initp nil) + (allocp nil)) + + (dolist (slotd direct-slotds) + (when slotd + (unless namep + (setq name (slot-definition-name slotd) + namep t)) + (unless initp + (when (slot-definition-initfunction slotd) + (setq initform (slot-definition-initform slotd) + initfunction (slot-definition-initfunction slotd) + initp t))) + (unless allocp + (setq allocation (slot-definition-allocation slotd) + allocp t)) + (setq initargs (append (slot-definition-initargs slotd) initargs)) + (let ((slotd-type (slot-definition-type slotd))) + (setq type (cond ((eq type 't) slotd-type) + ((*subtypep type slotd-type) type) + (t `(and ,type ,slotd-type))))))) + (list :name name + :initform initform + :initfunction initfunction + :initargs initargs + :allocation allocation + :type type + :class class))) + +(defmethod compute-effective-slot-definition-initargs :around + ((class structure-class) direct-slotds) + (let ((slotd (car direct-slotds))) + (list* :defstruct-accessor-symbol (slot-definition-defstruct-accessor-symbol slotd) + :internal-reader-function (slot-definition-internal-reader-function slotd) + :internal-writer-function (slot-definition-internal-writer-function slotd) + (call-next-method)))) + +;;; +;;; NOTE: For bootstrapping considerations, these can't use make-instance +;;; to make the method object. They have to use make-a-method which +;;; is a specially bootstrapped mechanism for making standard methods. +;;; +(defmethod reader-method-class ((class slot-class) direct-slot &rest initargs) + (declare (ignore direct-slot initargs)) + (find-class 'standard-reader-method)) + +(defmethod add-reader-method ((class slot-class) generic-function slot-name) + (add-method generic-function + (make-a-method 'standard-reader-method + () + (list (or (class-name class) 'object)) + (list class) + (make-reader-method-function class slot-name) + "automatically generated reader method" + slot-name))) + +(defmethod writer-method-class ((class slot-class) direct-slot &rest initargs) + (declare (ignore direct-slot initargs)) + (find-class 'standard-writer-method)) + +(defmethod add-writer-method ((class slot-class) generic-function slot-name) + (add-method generic-function + (make-a-method 'standard-writer-method + () + (list 'new-value (or (class-name class) 'object)) + (list *the-class-t* class) + (make-writer-method-function class slot-name) + "automatically generated writer method" + slot-name))) + +(defmethod add-boundp-method ((class slot-class) generic-function slot-name) + (add-method generic-function + (make-a-method 'standard-boundp-method + () + (list (or (class-name class) 'object)) + (list class) + (make-boundp-method-function class slot-name) + "automatically generated boundp method" + slot-name))) + +(defmethod remove-reader-method ((class slot-class) generic-function) + (let ((method (get-method generic-function () (list class) nil))) + (when method (remove-method generic-function method)))) + +(defmethod remove-writer-method ((class slot-class) generic-function) + (let ((method + (get-method generic-function () (list *the-class-t* class) nil))) + (when method (remove-method generic-function method)))) + +(defmethod remove-boundp-method ((class slot-class) generic-function) + (let ((method (get-method generic-function () (list class) nil))) + (when method (remove-method generic-function method)))) + + +;;; +;;; make-reader-method-function and make-write-method function are NOT part of +;;; the standard protocol. They are however useful, PCL makes uses makes use +;;; of them internally and documents them for PCL users. +;;; +;;; *** This needs work to make type testing by the writer functions which +;;; *** do type testing faster. The idea would be to have one constructor +;;; *** for each possible type test. In order to do this it would be nice +;;; *** to have help from inform-type-system-about-class and friends. +;;; +;;; *** There is a subtle bug here which is going to have to be fixed. +;;; *** Namely, the simplistic use of the template has to be fixed. We +;;; *** have to give the optimize-slot-value method the user might have +;;; *** defined for this metclass a chance to run. +;;; +(defmethod make-reader-method-function ((class slot-class) slot-name) + (make-std-reader-method-function (class-name class) slot-name)) + +(defmethod make-writer-method-function ((class slot-class) slot-name) + (make-std-writer-method-function (class-name class) slot-name)) + +(defmethod make-boundp-method-function ((class slot-class) slot-name) + (make-std-boundp-method-function (class-name class) slot-name)) + + +;;;; inform-type-system-about-class +;;;; make-type-predicate +;;; +;;; These are NOT part of the standard protocol. They are internal mechanism +;;; which PCL uses to *try* and tell the type system about class definitions. +;;; In a more fully integrated implementation of CLOS, the type system would +;;; know about class objects and class names in a more fundamental way and +;;; the mechanism used to inform the type system about new classes would be +;;; different. +;;; +(defmethod inform-type-system-about-class ((class std-class) name) + (inform-type-system-about-std-class name)) + + +(defmethod compatible-meta-class-change-p (class proto-new-class) + (eq (class-of class) (class-of proto-new-class))) + +(defmethod validate-superclass ((class class) (new-super class)) + (or (eq new-super *the-class-t*) + (eq (class-of class) (class-of new-super)))) + + + +;;; +;;; +;;; +(defun force-cache-flushes (class) + (let* ((owrapper (class-wrapper class)) + (state (wrapper-state owrapper))) + ;; + ;; We only need to do something if the state is still T. If the + ;; state isn't T, it will be FLUSH or OBSOLETE, and both of those + ;; will already be doing what we want. In particular, we must be + ;; sure we never change an OBSOLETE into a FLUSH since OBSOLETE + ;; means do what FLUSH does and then some. + ;; + (when (eq state 't) + (let ((nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper) + class))) + (setf (wrapper-instance-slots-layout nwrapper) + (wrapper-instance-slots-layout owrapper)) + (setf (wrapper-class-slots nwrapper) + (wrapper-class-slots owrapper)) + (without-interrupts + #+cmu17 + (update-lisp-class-layout class nwrapper) + (setf (slot-value class 'wrapper) nwrapper) + (invalidate-wrapper owrapper ':flush nwrapper)))))) + +(defun flush-cache-trap (owrapper nwrapper instance) + (declare (ignore owrapper)) + (set-wrapper instance nwrapper)) + + + +;;; +;;; make-instances-obsolete can be called by user code. It will cause the +;;; next access to the instance (as defined in 88-002R) to trap through the +;;; update-instance-for-redefined-class mechanism. +;;; +(defmethod make-instances-obsolete ((class std-class)) + (let* ((owrapper (class-wrapper class)) + (nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper) + class))) + (setf (wrapper-instance-slots-layout nwrapper) + (wrapper-instance-slots-layout owrapper)) + (setf (wrapper-class-slots nwrapper) + (wrapper-class-slots owrapper)) + (without-interrupts + #+cmu17 + (update-lisp-class-layout class nwrapper) + (setf (slot-value class 'wrapper) nwrapper) + (invalidate-wrapper owrapper ':obsolete nwrapper) + class))) + +(defmethod make-instances-obsolete ((class symbol)) + (make-instances-obsolete (find-class class))) + + +;;; +;;; obsolete-instance-trap is the internal trap that is called when we see +;;; an obsolete instance. The times when it is called are: +;;; - when the instance is involved in method lookup +;;; - when attempting to access a slot of an instance +;;; +;;; It is not called by class-of, wrapper-of, or any of the low-level instance +;;; access macros. +;;; +;;; Of course these times when it is called are an internal implementation +;;; detail of PCL and are not part of the documented description of when the +;;; obsolete instance update happens. The documented description is as it +;;; appears in 88-002R. +;;; +;;; This has to return the new wrapper, so it counts on all the methods on +;;; obsolete-instance-trap-internal to return the new wrapper. It also does +;;; a little internal error checking to make sure that the traps are only +;;; happening when they should, and that the trap methods are computing +;;; apropriate new wrappers. +;;; + +;;; obsolete-instance-trap might be called on structure instances +;;; after a structure is redefined. In most cases, obsolete-instance-trap +;;; will not be able to fix the old instance, so it must signal an +;;; error. The hard part of this is that the error system and debugger +;;; might cause obsolete-instance-trap to be called again, so in that +;;; case, we have to return some reasonable wrapper, instead. + +(defvar *in-obsolete-instance-trap* nil) +(defvar *the-wrapper-of-structure-object* + (class-wrapper (find-class 'structure-object))) + +#+cmu17 +(define-condition obsolete-structure (error) + ((datum :reader obsolete-structure-datum :initarg :datum)) + (:report + (lambda (condition stream) + ;; Don't try to print the structure, since it probably + ;; won't work. + (format stream "Obsolete structure error in ~S:~@ + For a structure of type: ~S" + (conditions::condition-function-name condition) + (type-of (obsolete-structure-datum condition)))))) + +(defun obsolete-instance-trap (owrapper nwrapper instance) + (if (not #-(or cmu17 new-kcl-wrapper) + (or (std-instance-p instance) (fsc-instance-p instance)) + #+cmu17 + (pcl-instance-p instance) + #+new-kcl-wrapper + nil) + (if *in-obsolete-instance-trap* + *the-wrapper-of-structure-object* + (let ((*in-obsolete-instance-trap* t)) + #-cmu17 + (error "The structure ~S is obsolete." instance) + #+cmu17 + (error 'obsolete-structure :datum instance))) + (let* ((class (wrapper-class* nwrapper)) + (copy (allocate-instance class)) ;??? allocate-instance ??? + (olayout (wrapper-instance-slots-layout owrapper)) + (nlayout (wrapper-instance-slots-layout nwrapper)) + (oslots (get-slots instance)) + (nslots (get-slots copy)) + (oclass-slots (wrapper-class-slots owrapper)) + (added ()) + (discarded ()) + (plist ())) + ;; local --> local transfer + ;; local --> shared discard + ;; local --> -- discard + ;; shared --> local transfer + ;; shared --> shared discard + ;; shared --> -- discard + ;; -- --> local add + ;; -- --> shared -- + ;; + ;; Go through all the old local slots. + ;; + (iterate ((name (list-elements olayout)) + (opos (interval :from 0))) + (let* ((opos opos) + (npos (posq name nlayout))) + (declare (fixnum opos)) + (if npos + (setf (instance-ref nslots npos) (instance-ref oslots opos)) + (progn + (push name discarded) + (unless (eq (instance-ref oslots opos) *slot-unbound*) + (setf (getf plist name) (instance-ref oslots opos))))))) + ;; + ;; Go through all the old shared slots. + ;; + (iterate ((oclass-slot-and-val (list-elements oclass-slots))) + (let ((name (car oclass-slot-and-val)) + (val (cdr oclass-slot-and-val))) + (let ((npos (posq name nlayout))) + (if npos + (setf (instance-ref nslots npos) (cdr oclass-slot-and-val)) + (progn (push name discarded) + (unless (eq val *slot-unbound*) + (setf (getf plist name) val))))))) + ;; + ;; Go through all the new local slots to compute the added slots. + ;; + (dolist (nlocal nlayout) + (unless (or (memq nlocal olayout) + (assq nlocal oclass-slots)) + (push nlocal added))) + + (swap-wrappers-and-slots instance copy) + + (update-instance-for-redefined-class instance + added + discarded + plist) + nwrapper))) + + +;;; +;;; +;;; +(defmacro copy-instance-internal (instance) + `(#+new-kcl-wrapper if #-new-kcl-wrapper progn + #+new-kcl-wrapper (not (std-instance-p ,instance)) + (let* ((class (class-of instance)) + (copy (allocate-instance class))) + (if (std-instance-p ,instance) + (setf (std-instance-slots ,instance) (std-instance-slots ,instance)) + (setf (fsc-instance-slots ,instance) (fsc-instance-slots ,instance))) + copy) + #+new-kcl-wrapper + (copy-structure-header ,instance))) + +(defun change-class-internal (instance new-class) + (let* ((old-class (class-of instance)) + (copy (allocate-instance new-class)) + (new-wrapper (get-wrapper copy)) + (old-wrapper (class-wrapper old-class)) + (old-layout (wrapper-instance-slots-layout old-wrapper)) + (new-layout (wrapper-instance-slots-layout new-wrapper)) + (old-slots (get-slots instance)) + (new-slots (get-slots copy)) + (old-class-slots (wrapper-class-slots old-wrapper))) + + ;; + ;; "The values of local slots specified by both the class Cto and + ;; Cfrom are retained. If such a local slot was unbound, it remains + ;; unbound." + ;; + (iterate ((new-slot (list-elements new-layout)) + (new-position (interval :from 0))) + (let* ((new-position new-position) + (old-position (posq new-slot old-layout))) + (declare (fixnum new-position)) + (when old-position + (setf (instance-ref new-slots new-position) + (instance-ref old-slots old-position))))) + + ;; + ;; "The values of slots specified as shared in the class Cfrom and + ;; as local in the class Cto are retained." + ;; + (iterate ((slot-and-val (list-elements old-class-slots))) + (let ((position (posq (car slot-and-val) new-layout))) + (when position + (setf (instance-ref new-slots position) (cdr slot-and-val))))) + + ;; Make the copy point to the old instance's storage, and make the + ;; old instance point to the new storage. + (swap-wrappers-and-slots instance copy) + + (update-instance-for-different-class copy instance) + instance)) + +(defmethod change-class ((instance standard-object) + (new-class standard-class)) + (unless (std-instance-p instance) + (error "Can't change the class of ~S to ~S~@ + because it isn't already an instance with metaclass~%~S." + instance + new-class + 'standard-class)) + (change-class-internal instance new-class)) + +(defmethod change-class ((instance standard-object) + (new-class funcallable-standard-class)) + (unless (fsc-instance-p instance) + (error "Can't change the class of ~S to ~S~@ + because it isn't already an instance with metaclass~%~S." + instance + new-class + 'funcallable-standard-class)) + (change-class-internal instance new-class)) + +(defmethod change-class ((instance t) (new-class-name symbol)) + (change-class instance (find-class new-class-name))) + + + +;;; +;;; The metaclass BUILT-IN-CLASS +;;; +;;; This metaclass is something of a weird creature. By this point, all +;;; instances of it which will exist have been created, and no instance +;;; is ever created by calling MAKE-INSTANCE. +;;; +;;; But, there are other parts of the protcol we must follow and those +;;; definitions appear here. +;;; +(defmethod shared-initialize :before + ((class built-in-class) slot-names &rest initargs) + (declare (ignore slot-names initargs)) + (error "Attempt to initialize or reinitialize a built in class.")) + +(defmethod class-direct-slots ((class built-in-class)) ()) +(defmethod class-slots ((class built-in-class)) ()) +(defmethod class-direct-default-initargs ((class built-in-class)) ()) +(defmethod class-default-initargs ((class built-in-class)) ()) + +(defmethod validate-superclass ((c class) (s built-in-class)) + (eq s *the-class-t*)) + + + +;;; +;;; +;;; + +(defmethod validate-superclass ((c slot-class) + (f forward-referenced-class)) + 't) + + +;;; +;;; +;;; + +(defmethod add-dependent ((metaobject dependent-update-mixin) dependent) + (pushnew dependent (plist-value metaobject 'dependents))) + +(defmethod remove-dependent ((metaobject dependent-update-mixin) dependent) + (setf (plist-value metaobject 'dependents) + (delete dependent (plist-value metaobject 'dependents)))) + +(defmethod map-dependents ((metaobject dependent-update-mixin) function) + (dolist (dependent (plist-value metaobject 'dependents)) + (funcall function dependent))) + diff --git a/pcl/gcl_pcl_vector.lisp b/pcl/gcl_pcl_vector.lisp new file mode 100644 index 0000000..010803c --- /dev/null +++ b/pcl/gcl_pcl_vector.lisp @@ -0,0 +1,1109 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; Permutation vectors. +;;; + +(in-package :pcl) + +(defmacro instance-slot-index (wrapper slot-name) + `(let ((pos 0)) + (declare (fixnum pos)) + (block loop + (dolist (sn (wrapper-instance-slots-layout ,wrapper)) + (when (eq ,slot-name sn) (return-from loop pos)) + (incf pos))))) + + +;;; +;;; +;;; +(defun pv-cache-limit-fn (nlines) + (default-limit-fn nlines)) + +(defstruct (pv-table + (:predicate pv-tablep) + (:constructor make-pv-table-internal + (slot-name-lists call-list))) + (cache nil :type (or cache null)) + (pv-size 0 :type fixnum) + (slot-name-lists nil :type list) + (call-list nil :type list)) + +#+cmu +(declaim (ext:freeze-type pv-table)) + +(defvar *initial-pv-table* (make-pv-table-internal nil nil)) + +; help new slot-value-using-class methods affect fast iv access +(defvar *all-pv-table-list* nil) + +(defun make-pv-table (&key slot-name-lists call-list) + (let ((pv-table (make-pv-table-internal slot-name-lists call-list))) + (push pv-table *all-pv-table-list*) + pv-table)) + +(defun make-pv-table-type-declaration (var) + `(type pv-table ,var)) + +(defvar *slot-name-lists-inner* (make-hash-table :test #'equal)) +(defvar *slot-name-lists-outer* (make-hash-table :test #'equal)) + +;entries in this are lists of (table . pv-offset-list) +(defvar *pv-key-to-pv-table-table* (make-hash-table :test 'equal)) + +(defun intern-pv-table (&key slot-name-lists call-list) + (let ((new-p nil)) + (flet ((inner (x) + (or (gethash x *slot-name-lists-inner*) + (setf (gethash x *slot-name-lists-inner*) (copy-list x)))) + (outer (x) + (or (gethash x *slot-name-lists-outer*) + (setf (gethash x *slot-name-lists-outer*) + (let ((snl (copy-list (cdr x))) + (cl (car x))) + (setq new-p t) + (make-pv-table :slot-name-lists snl + :call-list cl)))))) + (let ((pv-table (outer (mapcar #'inner (cons call-list slot-name-lists))))) + (when new-p + (let ((pv-index 1)) + (declare (fixnum pv-index)) + (dolist (slot-name-list slot-name-lists) + (dolist (slot-name (cdr slot-name-list)) + (note-pv-table-reference slot-name pv-index pv-table) + (incf pv-index))) + (dolist (gf-call call-list) + (note-pv-table-reference gf-call pv-index pv-table) + (incf pv-index)) + (setf (pv-table-pv-size pv-table) pv-index))) + pv-table)))) + +(defun note-pv-table-reference (ref pv-offset pv-table) + (let ((entry (gethash ref *pv-key-to-pv-table-table*))) + (when (listp entry) + (let ((table-entry (assq pv-table entry))) + (when (and (null table-entry) + (> (length entry) 8)) + (let ((new-table-table (make-hash-table :size 16 :test 'eq))) + (dolist (table-entry entry) + (setf (gethash (car table-entry) new-table-table) + (cdr table-entry))) + (setf (gethash ref *pv-key-to-pv-table-table*) new-table-table))) + (when (listp entry) + (if (null table-entry) + (let ((new (cons pv-table pv-offset))) + (if (consp entry) + (push new (cdr entry)) + (setf (gethash ref *pv-key-to-pv-table-table*) (list new)))) + (push pv-offset (cdr table-entry))) + (return-from note-pv-table-reference nil)))) + (let ((list (gethash pv-table entry))) + (if (consp list) + (push pv-offset (cdr list)) + (setf (gethash pv-table entry) (list pv-offset))))) + nil) + +(defun map-pv-table-references-of (ref function) + (let ((entry (gethash ref *pv-key-to-pv-table-table*))) + (if (listp entry) + (dolist (table+pv-offset-list entry) + (funcall function + (car table+pv-offset-list) (cdr table+pv-offset-list))) + (maphash function entry))) + ref) + + +(defvar *pvs* (make-hash-table :test #'equal)) + +(defun optimize-slot-value-by-class-p (class slot-name type) + (or (not (eq *boot-state* 'complete)) + (let ((slotd (find-slot-definition class slot-name))) + (and slotd + (slot-accessor-std-p slotd type))))) + +(defun compute-pv-slot (slot-name wrapper class class-slots class-slot-p-cell) + (if (symbolp slot-name) + (when (optimize-slot-value-by-class-p class slot-name 'all) + (or (instance-slot-index wrapper slot-name) + (let ((cell (assq slot-name class-slots))) + (when cell + (setf (car class-slot-p-cell) t) + cell)))) + (when (consp slot-name) + (dolist (type '(reader writer) nil) + (when (eq (car slot-name) type) + (return + (let* ((gf-name (cadr slot-name)) + (gf (gdefinition gf-name)) + (location + (when (eq *boot-state* 'complete) + (accessor-values1 gf type class)))) + (when (consp location) + (setf (car class-slot-p-cell) t)) + location))))))) + +(defun compute-pv (slot-name-lists wrappers) + (unless (listp wrappers) (setq wrappers (list wrappers))) + (let* ((not-simple-p-cell (list nil)) + (elements + (gathering1 (collecting) + (iterate ((slot-names (list-elements slot-name-lists))) + (when slot-names + (let* ((wrapper (pop wrappers)) + (std-p #+cmu17 (typep wrapper 'wrapper) + #-cmu17 t) + (class (wrapper-class* wrapper)) + (class-slots (and std-p (wrapper-class-slots wrapper)))) + (dolist (slot-name (cdr slot-names)) + (gather1 + (when std-p + (compute-pv-slot slot-name wrapper class + class-slots not-simple-p-cell)))))))))) + (if (car not-simple-p-cell) + (make-permutation-vector (cons t elements)) + (or (gethash elements *pvs*) + (setf (gethash elements *pvs*) + (make-permutation-vector (cons nil elements))))))) + +(defun compute-calls (call-list wrappers) + (declare (ignore call-list wrappers)) + #|| + (map 'vector + #'(lambda (call) + (compute-emf-from-wrappers call wrappers)) + call-list) + ||# + '#()) + +#|| ; Need to finish this, then write the maintenance functions. +(defun compute-emf-from-wrappers (call wrappers) + (when call + ; FIXME use regular destructuring-bind + (pcl-destructuring-bind (gf-name nreq restp arg-info) call + (if (eq gf-name 'make-instance) + (error "should not get here") ; there is another mechanism for this. + #'(lambda (&rest args) + (if (not (eq *boot-state* 'complete)) + (apply (gdefinition gf-name) args) + (let* ((gf (gdefinition gf-name)) + (arg-info (arg-info-reader gf)) + (classes '?) + (types '?) + (emf (cache-miss-values-internal gf arg-info + wrappers classes types + 'caching))) + (update-all-pv-tables call wrappers emf) + #+copy-&rest-arg (setq args (copy-list args)) + (invoke-emf emf args)))))))) +||# + +(defun make-permutation-vector (indexes) + (make-array (length indexes) :initial-contents indexes)) + +(defun pv-table-lookup (pv-table pv-wrappers) + (let* ((slot-name-lists (pv-table-slot-name-lists pv-table)) + (call-list (pv-table-call-list pv-table)) + (cache (or (pv-table-cache pv-table) + (setf (pv-table-cache pv-table) + (get-cache (- (length slot-name-lists) + (count nil slot-name-lists)) + t + #'pv-cache-limit-fn + 2))))) + (or (probe-cache cache pv-wrappers) + (let* ((pv (compute-pv slot-name-lists pv-wrappers)) + (calls (compute-calls call-list pv-wrappers)) + (pv-cell (cons pv calls)) + (new-cache (fill-cache cache pv-wrappers pv-cell))) + (unless (eq new-cache cache) + (setf (pv-table-cache pv-table) new-cache) + (free-cache cache)) + pv-cell)))) + +(defun make-pv-type-declaration (var) + `(type simple-vector ,var)) + +(defvar *empty-pv* #()) + +(defmacro pvref (pv index) + `(svref ,pv ,index)) + +(defmacro copy-pv (pv) + `(copy-seq ,pv)) + +(defun make-calls-type-declaration (var) + `(type simple-vector ,var)) + +(defmacro callsref (calls index) + `(svref ,calls ,index)) + +(defvar *pv-table-cache-update-info* nil) + +;called by: +;(method shared-initialize :after (structure-class t)) +;update-slots +(defun update-pv-table-cache-info (class) + (let ((slot-names-for-pv-table-update nil) + (new-icui nil)) + (dolist (icu *pv-table-cache-update-info*) + (if (eq (car icu) class) + (pushnew (cdr icu) slot-names-for-pv-table-update) + (push icu new-icui))) + (setq *pv-table-cache-update-info* new-icui) + (when slot-names-for-pv-table-update + (update-all-pv-table-caches class slot-names-for-pv-table-update)))) + +(defun update-all-pv-table-caches (class slot-names) + (let* ((cwrapper (class-wrapper class)) + (std-p #+cmu17 (typep cwrapper 'wrapper) #-cmu17 t) + (class-slots (and std-p (wrapper-class-slots cwrapper))) + (class-slot-p-cell (list nil)) + (new-values (mapcar #'(lambda (slot-name) + (cons slot-name + (when std-p + (compute-pv-slot + slot-name cwrapper class + class-slots class-slot-p-cell)))) + slot-names)) + (pv-tables nil)) + (dolist (slot-name slot-names) + (map-pv-table-references-of + slot-name + #'(lambda (pv-table pv-offset-list) + (declare (ignore pv-offset-list)) + (pushnew pv-table pv-tables)))) + (dolist (pv-table pv-tables) + (let* ((cache (pv-table-cache pv-table)) + (slot-name-lists (pv-table-slot-name-lists pv-table)) + (pv-size (pv-table-pv-size pv-table)) + (pv-map (make-array pv-size :initial-element nil))) + (let ((map-index 1)(param-index 0)) + (declare (fixnum map-index param-index)) + (dolist (slot-name-list slot-name-lists) + (dolist (slot-name (cdr slot-name-list)) + (let ((a (assoc slot-name new-values))) + (setf (svref pv-map map-index) + (and a (cons param-index (cdr a))))) + (incf map-index)) + (incf param-index))) + (when cache + (map-cache #'(lambda (wrappers pv-cell) + (setf (car pv-cell) + (update-slots-in-pv wrappers (car pv-cell) + cwrapper pv-size pv-map))) + cache)))))) + +(defun update-slots-in-pv (wrappers pv cwrapper pv-size pv-map) + (if (not (if (atom wrappers) + (eq cwrapper wrappers) + (dolist (wrapper wrappers nil) + (when (eq wrapper cwrapper) + (return t))))) + pv + (let* ((old-intern-p (listp (pvref pv 0))) + (new-pv (if old-intern-p + (copy-pv pv) + pv)) + (new-intern-p t)) + (if (atom wrappers) + (dotimes (i pv-size) + (when (consp (let ((map (svref pv-map i))) + (if map + (setf (pvref new-pv i) (cdr map)) + (pvref new-pv i)))) + (setq new-intern-p nil))) + (let ((param 0)) + (declare (fixnum param)) + (dolist (wrapper wrappers) + (when (eq wrapper cwrapper) + (dotimes (i pv-size) + (when (consp (let ((map (svref pv-map i))) + (if (and map (= (car map) param)) + (setf (pvref new-pv i) (cdr map)) + (pvref new-pv i)))) + (setq new-intern-p nil)))) + (incf param)))) + (when new-intern-p + (setq new-pv (let ((list-pv (coerce pv 'list))) + (or (gethash (cdr list-pv) *pvs*) + (setf (gethash (cdr list-pv) *pvs*) + (if old-intern-p + new-pv + (make-permutation-vector list-pv))))))) + new-pv))) + + +(defun maybe-expand-accessor-form (form required-parameters slots env) + (let* ((fname (car form)) + #||(len (length form))||# + (gf (if (symbolp fname) + (unencapsulated-fdefinition fname) + (gdefinition fname)))) + (macrolet ((maybe-optimize-reader () + `(let ((parameter + (can-optimize-access1 (cadr form) + required-parameters env))) + (when parameter + (optimize-reader slots parameter gf-name form)))) + (maybe-optimize-writer () + `(let ((parameter + (can-optimize-access1 (caddr form) + required-parameters env))) + (when parameter + (optimize-writer slots parameter gf-name form))))) + (unless (and (consp (cadr form)) + (eq 'instance-accessor-parameter (caadr form))) + (or #|| + (cond ((and (= len 2) (symbolp fname)) + (let ((gf-name (gethash fname *gf-declared-reader-table*))) + (when gf-name + (maybe-optimize-reader)))) + ((= len 3) + (let ((gf-name (gethash fname *gf-declared-writer-table*))) + (when gf-name + (maybe-optimize-writer))))) + ||# + (when (and (eq *boot-state* 'complete) + (generic-function-p gf)) + (let ((methods (generic-function-methods gf))) + (when methods + (let* ((gf-name (generic-function-name gf)) + (arg-info (gf-arg-info gf)) + (metatypes (arg-info-metatypes arg-info)) + (nreq (length metatypes)) + (applyp (arg-info-applyp arg-info))) + (when (null applyp) + (cond ((= nreq 1) + (when (some #'standard-reader-method-p methods) + (maybe-optimize-reader))) + ((and (= nreq 2) + (consp gf-name) + (eq (car gf-name) 'setf)) + (when (some #'standard-writer-method-p methods) + (maybe-optimize-writer)))))))))))))) + +(defun optimize-generic-function-call (form required-parameters env slots calls) + (declare (ignore required-parameters env slots calls)) + (or (and (eq (car form) 'make-instance) + (expand-make-instance-form form)) + #|| + (maybe-expand-accessor-form form required-parameters slots env) + (let* ((fname (car form)) + (len (length form)) + (gf (if (symbolp fname) + (and (fboundp fname) + (unencapsulated-fdefinition fname)) + (and (gboundp fname) + (gdefinition fname)))) + (gf-name (and (fsc-instance-p gf) + (if (early-gf-p gf) + (early-gf-name gf) + (generic-function-name gf))))) + (when gf-name + (multiple-value-bind (nreq restp) + (get-generic-function-info gf) + (optimize-gf-call slots calls form nreq restp env)))) + ||# + form)) + + + +(defun can-optimize-access (form required-parameters env) + (let ((type (ecase (car form) + (slot-value 'reader) + (set-slot-value 'writer) + (slot-boundp 'boundp))) + (var (cadr form)) + (slot-name (eval (caddr form)))) ; known to be constant + (can-optimize-access1 var required-parameters env type slot-name))) + +(defun can-optimize-access1 (var required-parameters env &optional type slot-name) + (when (and (consp var) (eq 'the (car var))) + (setq var (caddr var))) + (when (symbolp var) + (let* ((rebound? (caddr (variable-declaration 'variable-rebinding var env))) + (parameter-or-nil (car (memq (or rebound? var) required-parameters)))) + (when parameter-or-nil + (let* ((class-name (caddr (variable-declaration + 'class parameter-or-nil env))) + (class (find-class class-name nil))) + (when (or (not (eq *boot-state* 'complete)) + (and class (not (class-finalized-p class)))) + (setq class nil)) + (when (and class-name (not (eq class-name 't))) + (when (or (null type) + (not (and class + (memq *the-class-structure-object* + (class-precedence-list class)))) + (optimize-slot-value-by-class-p class slot-name type)) + (cons parameter-or-nil (or class class-name))))))))) + +(defun optimize-slot-value (slots sparameter form) + (if sparameter + ; FIXME use regular destructuring-bind + (pcl-destructuring-bind (ignore ignore slot-name-form) form + (let ((slot-name (eval slot-name-form))) + (optimize-instance-access slots :read sparameter slot-name nil))) + `(accessor-slot-value ,@(cdr form)))) + +(defun optimize-set-slot-value (slots sparameter form) + (if sparameter + ; FIXME use regular destructuring-bind + (pcl-destructuring-bind (ignore ignore slot-name-form new-value) form + (let ((slot-name (eval slot-name-form))) + (optimize-instance-access slots :write sparameter slot-name new-value))) + `(accessor-set-slot-value ,@(cdr form)))) + +(defun optimize-slot-boundp (slots sparameter form) + (if sparameter + ; FIXME use regular destructuring-bind + (pcl-destructuring-bind (ignore ignore slot-name-form new-value) form + (let ((slot-name (eval slot-name-form))) + (optimize-instance-access slots :boundp sparameter slot-name new-value))) + `(accessor-slot-boundp ,@(cdr form)))) + +(defun optimize-reader (slots sparameter gf-name form) + (if sparameter + (optimize-accessor-call slots :read sparameter gf-name nil) + form)) + +(defun optimize-writer (slots sparameter gf-name form) + (if sparameter + ; FIXME use regular destructuring-bind + (pcl-destructuring-bind (ignore ignore new-value) form + (optimize-accessor-call slots :write sparameter gf-name new-value)) + form)) +;;; +;;; The argument is an alist, the CAR of each entry is the name of +;;; a required parameter to the function. The alist is in order, so the +;;; position of an entry in the alist corresponds to the argument's position +;;; in the lambda list. +;;; +(defun optimize-instance-access (slots read/write sparameter slot-name new-value) + (let ((class (if (consp sparameter) (cdr sparameter) *the-class-t*)) + (parameter (if (consp sparameter) (car sparameter) sparameter))) + (if (and (eq *boot-state* 'complete) + (classp class) + (memq *the-class-structure-object* (class-precedence-list class))) + (let ((slotd (find-slot-definition class slot-name))) + (ecase read/write + (:read + `(,(slot-definition-defstruct-accessor-symbol slotd) ,parameter)) + (:write + `(setf (,(slot-definition-defstruct-accessor-symbol slotd) ,parameter) + ,new-value)) + (:boundp + 'T))) + (let* ((parameter-entry (assq parameter slots)) + (slot-entry (assq slot-name (cdr parameter-entry))) + (position (posq parameter-entry slots)) + (pv-offset-form (list 'pv-offset ''.PV-OFFSET.))) + (unless parameter-entry + (error "Internal error in slot optimization.")) + (unless slot-entry + (setq slot-entry (list slot-name)) + (push slot-entry (cdr parameter-entry))) + (push pv-offset-form (cdr slot-entry)) + (ecase read/write + (:read + `(instance-read ,pv-offset-form ,parameter ,position + ',slot-name ',class)) + (:write + `(let ((.new-value. ,new-value)) + (instance-write ,pv-offset-form ,parameter ,position + ',slot-name ',class .new-value.))) + (:boundp + `(instance-boundp ,pv-offset-form ,parameter ,position + ',slot-name ',class))))))) + +(defun optimize-accessor-call (slots read/write sparameter gf-name new-value) + (let* ((class (if (consp sparameter) (cdr sparameter) *the-class-t*)) + (parameter (if (consp sparameter) (car sparameter) sparameter)) + (parameter-entry (assq parameter slots)) + (name (case read/write + (:read `(reader ,gf-name)) + (:write `(writer ,gf-name)))) + (slot-entry (assoc name (cdr parameter-entry) :test #'equal)) + (position (posq parameter-entry slots)) + (pv-offset-form (list 'pv-offset ''.PV-OFFSET.))) + (unless parameter-entry + (error "Internal error in slot optimization.")) + (unless slot-entry + (setq slot-entry (list name)) + (push slot-entry (cdr parameter-entry))) + (push pv-offset-form (cdr slot-entry)) + (ecase read/write + (:read + `(instance-reader ,pv-offset-form ,parameter ,position ,gf-name ',class)) + (:write + `(let ((.new-value. ,new-value)) + (instance-writer ,pv-offset-form ,parameter ,position ,gf-name ',class + .new-value.)))))) + +(defvar *unspecific-arg* '..unspecific-arg..) + +(defun optimize-gf-call-internal (form slots env) + (when (and (consp form) + (eq (car form) 'the)) + (setq form (caddr form))) + (or (and (symbolp form) + (let* ((rebound? (caddr (variable-declaration 'variable-rebinding + form env))) + (parameter-or-nil (car (assq (or rebound? form) slots)))) + (when parameter-or-nil + (let* ((class-name (caddr (variable-declaration + 'class parameter-or-nil env)))) + (when (and class-name (not (eq class-name 't))) + (position parameter-or-nil slots :key #'car)))))) + (if (constantp form) + (let ((form (eval form))) + (if (symbolp form) + form + *unspecific-arg*)) + *unspecific-arg*))) + +(defun optimize-gf-call (slots calls gf-call-form nreq restp env) + (unless (eq (car gf-call-form) 'make-instance) ; needs more work + (let* ((args (cdr gf-call-form)) + (all-args-p (eq (car gf-call-form) 'make-instance)) + (non-required-args (nthcdr nreq args)) + (required-args (ldiff args non-required-args)) + (call-spec (list (car gf-call-form) nreq restp + (mapcar #'(lambda (form) + (optimize-gf-call-internal form slots env)) + (if all-args-p + args + required-args)))) + (call-entry (assoc call-spec calls :test #'equal)) + (pv-offset-form (list 'pv-offset ''.PV-OFFSET.))) + (unless (some #'integerp + (let ((spec-args (cdr call-spec))) + (if all-args-p + (ldiff spec-args (nthcdr nreq spec-args)) + spec-args))) + (return-from optimize-gf-call nil)) + (unless call-entry + (setq call-entry (list call-spec)) + (push call-entry (cdr calls))) + (push pv-offset-form (cdr call-entry)) + (if (eq (car call-spec) 'make-instance) + `(funcall (pv-ref .pv. ,pv-offset-form) ,@(cdr gf-call-form)) + `(let ((.emf. (pv-ref .pv. ,pv-offset-form))) + (invoke-effective-method-function .emf. ,restp + ,@required-args ,@(when restp `((list ,@non-required-args))))))))) + + +(define-walker-template pv-offset) ; These forms get munged by mutate slots. +(defmacro pv-offset (arg) arg) +(define-walker-template instance-accessor-parameter) +(defmacro instance-accessor-parameter (x) x) + +;; It is safe for these two functions to be wrong. +;; They just try to guess what the most likely case will be. +(defun generate-fast-class-slot-access-p (class-form slot-name-form) + (let ((class (and (constantp class-form) (eval class-form))) + (slot-name (and (constantp slot-name-form) (eval slot-name-form)))) + (and (eq *boot-state* 'complete) + (standard-class-p class) + (not (eq class *the-class-t*)) ; shouldn't happen, though. + (let ((slotd (find-slot-definition class slot-name))) + (and slotd (classp (slot-definition-allocation slotd))))))) + +(defun skip-fast-slot-access-p (class-form slot-name-form type) + (let ((class (and (constantp class-form) (eval class-form))) + (slot-name (and (constantp slot-name-form) (eval slot-name-form)))) + (and (eq *boot-state* 'complete) + (standard-class-p class) + (not (eq class *the-class-t*)) ; shouldn't happen, though. + (let ((slotd (find-slot-definition class slot-name))) + (and slotd (skip-optimize-slot-value-by-class-p class slot-name type)))))) + +(defun skip-optimize-slot-value-by-class-p (class slot-name type) + (let ((slotd (find-slot-definition class slot-name))) + (and slotd + (eq *boot-state* 'complete) + (not (slot-accessor-std-p slotd type))))) + +(defmacro instance-read-internal (pv slots pv-offset default &optional type) + (unless (member type '(nil :instance :class :default)) + (error "Illegal type argument to ~S: ~S" 'instance-read-internal type)) + (if (eq type ':default) + default + (let* ((index (gensym)) + (value index)) + `(locally (declare #.*optimize-speed*) + (let ((,index (pvref ,pv ,pv-offset))) + (setq ,value (typecase ,index + ,@(when (or (null type) (eq type ':instance)) + `((fixnum (%instance-ref ,slots ,index)))) + ,@(when (or (null type) (eq type ':class)) + `((cons (cdr ,index)))) + (t ',*slot-unbound*))) + (if (eq ,value ',*slot-unbound*) + ,default + ,value)))))) + +(defmacro instance-read (pv-offset parameter position slot-name class) + (if (skip-fast-slot-access-p class slot-name 'reader) + `(accessor-slot-value ,parameter ,slot-name) + `(instance-read-internal .pv. ,(slot-vector-symbol position) + ,pv-offset (accessor-slot-value ,parameter ,slot-name) + ,(if (generate-fast-class-slot-access-p class slot-name) + ':class ':instance)))) + +(defmacro instance-reader (pv-offset parameter position gf-name class) + (declare (ignore class)) + `(instance-read-internal .pv. ,(slot-vector-symbol position) + ,pv-offset + (,gf-name (instance-accessor-parameter ,parameter)) + :instance)) + +(defmacro instance-write-internal (pv slots pv-offset new-value default + &optional type) + (unless (member type '(nil :instance :class :default)) + (error "Illegal type argument to ~S: ~S" 'instance-write-internal type)) + (if (eq type ':default) + default + (let* ((index (gensym))) + `(locally (declare #.*optimize-speed*) + (let ((,index (pvref ,pv ,pv-offset))) + (typecase ,index + ,@(when (or (null type) (eq type ':instance)) + `((fixnum (setf (%instance-ref ,slots ,index) ,new-value)))) + ,@(when (or (null type) (eq type ':class)) + `((cons (setf (cdr ,index) ,new-value)))) + (t ,default))))))) + +(defmacro instance-write (pv-offset parameter position slot-name class new-value) + (if (skip-fast-slot-access-p class slot-name 'writer) + `(accessor-set-slot-value ,parameter ,slot-name ,new-value) + `(instance-write-internal .pv. ,(slot-vector-symbol position) + ,pv-offset ,new-value + (accessor-set-slot-value ,parameter ,slot-name ,new-value) + ,(if (generate-fast-class-slot-access-p class slot-name) + ':class ':instance)))) + +(defmacro instance-writer (pv-offset parameter position gf-name class new-value) + (declare (ignore class)) + `(instance-write-internal .pv. ,(slot-vector-symbol position) + ,pv-offset ,new-value + (,(if (consp gf-name) + (get-setf-function-name gf-name) + gf-name) + (instance-accessor-parameter ,parameter) + ,new-value) + :instance)) + +(defmacro instance-boundp-internal (pv slots pv-offset default + &optional type) + (unless (member type '(nil :instance :class :default)) + (error "Illegal type argument to ~S: ~S" 'instance-boundp-internal type)) + (if (eq type ':default) + default + (let* ((index (gensym))) + `(locally (declare #.*optimize-speed*) + (let ((,index (pvref ,pv ,pv-offset))) + (typecase ,index + ,@(when (or (null type) (eq type ':instance)) + `((fixnum (not (eq (%instance-ref ,slots ,index) ',*slot-unbound*))))) + ,@(when (or (null type) (eq type ':class)) + `((cons (not (eq (cdr ,index) ',*slot-unbound*))))) + (t ,default))))))) + +(defmacro instance-boundp (pv-offset parameter position slot-name class) + (if (skip-fast-slot-access-p class slot-name 'boundp) + `(accessor-slot-boundp ,parameter ,slot-name) + `(instance-boundp-internal .pv. ,(slot-vector-symbol position) + ,pv-offset (accessor-slot-boundp ,parameter ,slot-name) + ,(if (generate-fast-class-slot-access-p class slot-name) + ':class ':instance)))) + +;;; +;;; This magic function has quite a job to do indeed. +;;; +;;; The careful reader will recall that contains all of the optimized +;;; slot access forms produced by OPTIMIZE-INSTANCE-ACCESS. Each of these is +;;; a call to either INSTANCE-READ or INSTANCE-WRITE. +;;; +;;; At the time these calls were produced, the first argument was specified as +;;; the symbol .PV-OFFSET.; what we have to do now is convert those pv-offset +;;; arguments into the actual number that is the correct offset into the pv. +;;; +;;; But first, oh but first, we sort a bit so that for each argument +;;; we have the slots in alphabetical order. This canonicalizes the PV-TABLE's a +;;; bit and will hopefully lead to having fewer PV's floating around. Even +;;; if the gain is only modest, it costs nothing. +;;; +(defun slot-name-lists-from-slots (slots calls) + (multiple-value-bind (slots calls) + (mutate-slots-and-calls slots calls) + (let* ((slot-name-lists + (mapcar #'(lambda (parameter-entry) + (cons nil (mapcar #'car (cdr parameter-entry)))) + slots)) + (call-list + (mapcar #'car calls))) + (dolist (call call-list) + (dolist (arg (cdr call)) + (when (integerp arg) + (setf (car (nth arg slot-name-lists)) t)))) + (setq slot-name-lists (mapcar #'(lambda (r+snl) + (when (or (car r+snl) (cdr r+snl)) + r+snl)) + slot-name-lists)) + (let ((cvt (apply #'vector + (let ((i -1)) + (declare (fixnum i)) + (mapcar #'(lambda (r+snl) + (when r+snl (incf i))) + slot-name-lists))))) + (setq call-list (mapcar #'(lambda (call) + (cons (car call) + (mapcar #'(lambda (arg) + (if (integerp arg) + (svref cvt arg) + arg)) + (cdr call)))) + call-list))) + (values slot-name-lists call-list)))) + +(defun mutate-slots-and-calls (slots calls) + (let ((sorted-slots (sort-slots slots)) + (sorted-calls (sort-calls (cdr calls))) + (pv-offset 0)) ; index 0 is for info + (declare (fixnum pv-offset)) + (dolist (parameter-entry sorted-slots) + (dolist (slot-entry (cdr parameter-entry)) + (incf pv-offset) + (dolist (form (cdr slot-entry)) + (setf (cadr form) pv-offset)))) + (dolist (call-entry sorted-calls) + (incf pv-offset) + (dolist (form (cdr call-entry)) + (setf (cadr form) pv-offset))) + (values sorted-slots sorted-calls))) + +(defun symbol-pkg-name (sym) + (let ((pkg (symbol-package sym))) + (if pkg (package-name pkg) ""))) + +(defun symbol-lessp (a b) + (if (eq (symbol-package a) + (symbol-package b)) + (string-lessp (symbol-name a) + (symbol-name b)) + (string-lessp (symbol-pkg-name a) + (symbol-pkg-name b)))) + +(defun symbol-or-cons-lessp (a b) + (etypecase a + (symbol (etypecase b + (symbol (symbol-lessp a b)) + (cons t))) + (cons (etypecase b + (symbol nil) + (cons (if (eq (car a) (car b)) + (symbol-or-cons-lessp (cdr a) (cdr b)) + (symbol-or-cons-lessp (car a) (car b)))))))) + +(defun sort-slots (slots) + (mapcar #'(lambda (parameter-entry) + (cons (car parameter-entry) + (sort (cdr parameter-entry) ;slot entries + #'symbol-or-cons-lessp + :key #'car))) + slots)) + +(defun sort-calls (calls) + (sort calls #'symbol-or-cons-lessp :key #'car)) + + +;;; +;;; This needs to work in terms of metatypes and also needs to work for +;;; automatically generated reader and writer functions. +;;; -- Automatically generated reader and writer functions use this stuff too. + +(defmacro pv-binding ((required-parameters slot-name-lists pv-table-symbol) + &body body) + (with-gathering ((slot-vars (collecting)) + (pv-parameters (collecting))) + (iterate ((slots (list-elements slot-name-lists)) + (required-parameter (list-elements required-parameters)) + (i (interval :from 0))) + (when slots + (gather required-parameter pv-parameters) + (gather (slot-vector-symbol i) slot-vars))) + `(pv-binding1 (.pv. .calls. ,pv-table-symbol ,pv-parameters ,slot-vars) + ,@body))) + +(defmacro pv-binding1 ((pv calls pv-table-symbol pv-parameters slot-vars) + &body body) + `(pv-env (,pv ,calls ,pv-table-symbol ,pv-parameters) + (let (,@(mapcar #'(lambda (slot-var p) `(,slot-var (get-slots-or-nil ,p))) + slot-vars pv-parameters)) + ,@body))) + +;This gets used only when the default make-method-lambda is overriden. +(defmacro pv-env ((pv calls pv-table-symbol pv-parameters) + &rest forms) + `(let* ((.pv-table. ,pv-table-symbol) + (.pv-cell. (pv-table-lookup-pv-args .pv-table. ,@pv-parameters)) + (,pv (car .pv-cell.)) + (,calls (cdr .pv-cell.))) + (declare ,(make-pv-type-declaration pv)) + (declare ,(make-calls-type-declaration calls)) + ,@(when (symbolp pv-table-symbol) + `((declare (special ,pv-table-symbol)))) + ,@(progn + #-cmu `(,pv ,calls) + #+cmu `(declare (ignorable ,pv ,calls))) + ,@forms)) + +(defvar *non-variable-declarations* + '(method-name method-lambda-list + optimize ftype inline notinline)) + +(defvar *variable-declarations-with-argument* + '(class + type)) + +(defvar *variable-declarations-without-argument* + '(ignore special dynamic-extent + array atom base-char bignum bit bit-vector character common compiled-function + complex cons double-float extended-char fixnum float function hash-table integer + keyword list long-float nil null number package pathname random-state ratio + rational readtable sequence short-float signed-byte simple-array + simple-bit-vector simple-string simple-vector single-float standard-char + stream string-char symbol t unsigned-byte vector)) + +(defun split-declarations (body args) + (let ((inner-decls nil) (outer-decls nil) decl) + (loop (when (null body) (return nil)) + (setq decl (car body)) + (unless (and (consp decl) + (eq (car decl) 'declare)) + (return nil)) + (dolist (form (cdr decl)) + (when (consp form) + (let ((declaration-name (car form))) + (if (member declaration-name *non-variable-declarations*) + (push `(declare ,form) outer-decls) + (let ((arg-p + (member declaration-name + *variable-declarations-with-argument*)) + (non-arg-p + (member declaration-name + *variable-declarations-without-argument*)) + (dname (list (pop form))) + (inners nil) (outers nil)) + (unless (or arg-p non-arg-p) + (warn "The declaration ~S is not understood by ~S.~@ + Please put ~S on one of the lists ~S,~%~S, or~%~S.~@ + (Assuming it is a variable declarations without argument)." + declaration-name 'split-declarations + declaration-name + '*non-variable-declarations* + '*variable-declarations-with-argument* + '*variable-declarations-without-argument*) + (push declaration-name + *variable-declarations-without-argument*)) + (when arg-p + (setq dname (append dname (list (pop form))))) + (dolist (var form) + (if (member var args) + (push var outers) + (push var inners))) + (when outers + (push `(declare (,@dname ,@outers)) outer-decls)) + (when inners + (push `(declare (,@dname ,@inners)) inner-decls))))))) + (setq body (cdr body))) + (values outer-decls inner-decls body))) + +(defun make-method-initargs-form-internal (method-lambda initargs env) + (declare (ignore env)) + (let (method-lambda-args lmf lmf-params) + (if (not (and (= 3 (length method-lambda)) + (= 2 (length (setq method-lambda-args (cadr method-lambda)))) + (consp (setq lmf (third method-lambda))) + (eq 'simple-lexical-method-functions (car lmf)) + (eq (car method-lambda-args) (cadr (setq lmf-params (cadr lmf)))) + (eq (cadr method-lambda-args) (caddr lmf-params)))) + `(list* :function #',method-lambda + ',initargs) + (let* ((lambda-list (car lmf-params)) + (nreq 0)(restp nil)(args nil)) + (dolist (arg lambda-list) + (when (member arg '(&optional &rest &key)) + (setq restp t)(return nil)) + (when (eq arg '&aux) (return nil)) + (incf nreq)(push arg args)) + (setq args (nreverse args)) + (setf (getf (getf initargs ':plist) ':arg-info) (cons nreq restp)) + (make-method-initargs-form-internal1 + initargs (cddr lmf) args lmf-params restp))))) + +(defun make-method-initargs-form-internal1 + (initargs body req-args lmf-params restp) + (multiple-value-bind (outer-decls inner-decls body) + (split-declarations body req-args) + (let* ((rest-arg (when restp '.rest-arg.)) + (args+rest-arg (if restp (append req-args (list rest-arg)) req-args))) + `(list* :fast-function + #'(lambda (.pv-cell. .next-method-call. ,@args+rest-arg) + ,@outer-decls + .pv-cell. .next-method-call. + (macrolet ((pv-env ((pv calls pv-table-symbol pv-parameters) + &rest forms) + (declare (ignore pv-table-symbol pv-parameters)) + `(let ((,pv (car .pv-cell.)) + (,calls (cdr .pv-cell.))) + (declare ,(make-pv-type-declaration pv) + ,(make-calls-type-declaration calls)) + ,pv ,calls + ,@forms))) + (fast-lexical-method-functions + (,(car lmf-params) .next-method-call. ,req-args ,rest-arg + ,@(cdddr lmf-params)) + ,@inner-decls + ,@body))) + ',initargs)))) + +;use arrays and hash tables and the fngen stuff to make this much better. +;It doesn't really matter, though, because a function returned by this +;will get called only when the user explicitly funcalls a result of method-function. +;BUT, this is needed to make early methods work. +(defun method-function-from-fast-function (fmf) + (declare (type function fmf)) + (let* ((method-function nil) (pv-table nil) + (arg-info (method-function-get fmf ':arg-info)) + (nreq (car arg-info)) + (restp (cdr arg-info))) + (setq method-function + #'(lambda (method-args next-methods) + (unless pv-table + (setq pv-table (method-function-pv-table fmf))) + (let* ((pv-cell (when pv-table + (get-method-function-pv-cell + method-function method-args pv-table))) + (nm (car next-methods)) + (nms (cdr next-methods)) + (nmc (when nm + (make-method-call :function (if (std-instance-p nm) + (method-function nm) + nm) + :call-method-args (list nms))))) + (if restp + (let* ((rest (nthcdr nreq method-args)) + (args (ldiff method-args rest))) + (apply fmf pv-cell nmc (nconc args (list rest)))) + (apply fmf pv-cell nmc method-args))))) + (let* ((fname (method-function-get fmf :name)) + (name `(,(or (get (car fname) 'method-sym) + (setf (get (car fname) 'method-sym) + (let ((str (symbol-name (car fname)))) + (if (string= "FAST-" str :end2 5) + (intern (subseq str 5) *the-pcl-package*) + (car fname))))) + ,@(cdr fname)))) + (set-function-name method-function name)) + (setf (method-function-get method-function :fast-function) fmf) + method-function)) + +(defun get-method-function-pv-cell (method-function method-args &optional pv-table) + (let ((pv-table (or pv-table (method-function-pv-table method-function)))) + (when pv-table + (let ((pv-wrappers (pv-wrappers-from-all-args pv-table method-args))) + (when pv-wrappers + (pv-table-lookup pv-table pv-wrappers)))))) + +(defun pv-table-lookup-pv-args (pv-table &rest pv-parameters) + (pv-table-lookup pv-table (pv-wrappers-from-pv-args pv-parameters))) + +(defun pv-wrappers-from-pv-args (&rest args) + (let* ((nkeys (length args)) + (pv-wrappers (make-list nkeys)) + w (w-t pv-wrappers)) + (declare (fixnum nkeys)) + (dolist (arg args) + (setq w + #+cmu17 (wrapper-of arg) + #-cmu17 + (cond ((std-instance-p arg) + (std-instance-wrapper arg)) + ((fsc-instance-p arg) + (fsc-instance-wrapper arg)) + (t + #+new-kcl-wrapper + (built-in-wrapper-of arg) + #-new-kcl-wrapper + (built-in-or-structure-wrapper arg)))) + (unless (eq 't (wrapper-state w)) + (setq w (check-wrapper-validity arg))) + (setf (car w-t) w)) + (setq w-t (cdr w-t)) + (when (= nkeys 1) (setq pv-wrappers (car pv-wrappers))) + pv-wrappers)) + +(defun pv-wrappers-from-all-args (pv-table args) + (let ((nkeys 0) + (slot-name-lists (pv-table-slot-name-lists pv-table))) + (declare (fixnum nkeys)) + (dolist (sn slot-name-lists) + (when sn (incf nkeys))) + (let* ((pv-wrappers (make-list nkeys)) + (pv-w-t pv-wrappers)) + (dolist (sn slot-name-lists) + (when sn + (let* ((arg (car args)) + (w (wrapper-of arg))) + (unless w ; can-optimize-access prevents this from happening. + (error "error in pv-wrappers-from-all-args")) + (setf (car pv-w-t) w) + (setq pv-w-t (cdr pv-w-t)))) + (setq args (cdr args))) + (when (= nkeys 1) (setq pv-wrappers (car pv-wrappers))) + pv-wrappers))) + +(defun pv-wrappers-from-all-wrappers (pv-table wrappers) + (let ((nkeys 0) + (slot-name-lists (pv-table-slot-name-lists pv-table))) + (declare (fixnum nkeys)) + (dolist (sn slot-name-lists) + (when sn (incf nkeys))) + (let* ((pv-wrappers (make-list nkeys)) + (pv-w-t pv-wrappers)) + (dolist (sn slot-name-lists) + (when sn + (let ((w (car wrappers))) + (unless w ; can-optimize-access prevents this from happening. + (error "error in pv-wrappers-from-all-wrappers")) + (setf (car pv-w-t) w) + (setq pv-w-t (cdr pv-w-t)))) + (setq wrappers (cdr wrappers))) + (when (= nkeys 1) (setq pv-wrappers (car pv-wrappers))) + pv-wrappers))) diff --git a/pcl/gcl_pcl_walk.lisp b/pcl/gcl_pcl_walk.lisp new file mode 100644 index 0000000..19c928b --- /dev/null +++ b/pcl/gcl_pcl_walk.lisp @@ -0,0 +1,2198 @@ +;;;-*- Mode:LISP; Package:(WALKER LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; A simple code walker, based IN PART on: (roll the credits) +;;; Larry Masinter's Masterscope +;;; Moon's Common Lisp code walker +;;; Gary Drescher's code walker +;;; Larry Masinter's simple code walker +;;; . +;;; . +;;; boy, thats fair (I hope). +;;; +;;; For now at least, this code walker really only does what PCL needs it to +;;; do. Maybe it will grow up someday. +;;; + +;;; +;;; This code walker used to be completely portable. Now it is just "Real +;;; easy to port". This change had to happen because the hack that made it +;;; completely portable kept breaking in different releases of different +;;; Common Lisps, and in addition it never worked entirely anyways. So, +;;; its now easy to port. To port this walker, all you have to write is one +;;; simple macro and two simple functions. These macros and functions are +;;; used by the walker to manipluate the macroexpansion environments of +;;; the Common Lisp it is running in. +;;; +;;; The code which implements the macroexpansion environment manipulation +;;; mechanisms is in the first part of the file, the real walker follows it. +;;; + +(in-package :walker) + +;;; +;;; The user entry points are walk-form and nested-walked-form. In addition, +;;; it is legal for user code to call the variable information functions: +;;; variable-lexical-p, variable-special-p and variable-class. Some users +;;; will need to call define-walker-template, they will have to figure that +;;; out for themselves. +;;; +(export '(define-walker-template + walk-form + walk-form-expand-macros-p + nested-walk-form + variable-lexical-p + variable-special-p + variable-globally-special-p + *variable-declarations* + variable-declaration + macroexpand-all + )) + + + +;;; +;;; On the following pages are implementations of the implementation specific +;;; environment hacking functions for each of the implementations this walker +;;; has been ported to. If you add a new one, so this walker can run in a new +;;; implementation of Common Lisp, please send the changes back to us so that +;;; others can also use this walker in that implementation of Common Lisp. +;;; +;;; This code just hacks 'macroexpansion environments'. That is, it is only +;;; concerned with the function binding of symbols in the environment. The +;;; walker needs to be able to tell if the symbol names a lexical macro or +;;; function, and it needs to be able to build environments which contain +;;; lexical macro or function bindings. It must be able, when walking a +;;; macrolet, flet or labels form to construct an environment which reflects +;;; the bindings created by that form. Note that the environment created +;;; does NOT have to be sufficient to evaluate the body, merely to walk its +;;; body. This means that definitions do not have to be supplied for lexical +;;; functions, only the fact that that function is bound is important. For +;;; macros, the macroexpansion function must be supplied. +;;; +;;; This code is organized in a way that lets it work in implementations that +;;; stack cons their environments. That is reflected in the fact that the +;;; only operation that lets a user build a new environment is a with-body +;;; macro which executes its body with the specified symbol bound to the new +;;; environment. No code in this walker or in PCL will hold a pointer to +;;; these environments after the body returns. Other user code is free to do +;;; so in implementations where it works, but that code is not considered +;;; portable. +;;; +;;; There are 3 environment hacking tools. One macro which is used for +;;; creating new environments, and two functions which are used to access the +;;; bindings of existing environments. +;;; +;;; WITH-AUGMENTED-ENVIRONMENT +;;; +;;; ENVIRONMENT-FUNCTION +;;; +;;; ENVIRONMENT-MACRO +;;; + +(defun unbound-lexical-function (&rest args) + (declare (ignore args)) + (error "The evaluator was called to evaluate a form in a macroexpansion~%~ + environment constructed by the PCL portable code walker. These~%~ + environments are only useful for macroexpansion, they cannot be~%~ + used for evaluation.~%~ + This error should never occur when using PCL.~%~ + This most likely source of this error is a program which tries to~%~ + to use the PCL portable code walker to build its own evaluator.")) + + +;;; +;;; In Coral Common Lisp, the macroexpansion environment is just a list +;;; of environment entries. The cadr of each element specifies the type +;;; of the element. The only types that interest us are CCL::MACRO and +;;; FUNCTION. In these cases the element is interpreted as follows. +;;; +;;; ( CCL::MACRO . macroexpansion-function) +;;; +;;; ( FUNCTION . ) +;;; +;;; When in the compiler, is a gensym which will be +;;; a variable which bound at run-time to the function. +;;; When in the interpreter, is the actual function. +;;; +;;; +#+:Coral +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +(defun with-augmented-environment-internal (env functions macros) + (dolist (f functions) + (push (list* f 'function (gensym)) env)) + (dolist (m macros) + (push (list* (car m) 'ccl::macro (cadr m)) env)) + env) + +(defun environment-function (env fn) + (let ((entry (assoc fn env :test #'equal))) + (and entry + (eq (cadr entry) 'function) + (cddr entry)))) + +(defun environment-macro (env macro) + (let ((entry (assoc macro env :test #'equal))) + (and entry + (eq (cadr entry) 'ccl::macro) + (cddr entry)))) + +);#+:Coral + + +;;; +;;; Franz Common Lisp is a lot like Coral Lisp. The macroexpansion +;;; environment is just a list of entries. The cadr of each element +;;; specifies the type of the element. The types that interest us +;;; are FUNCTION, EXCL::MACRO, and COMPILER::FUNCTION-VALUE. These +;;; are interpreted as follows: +;;; +;;; ( FUNCTION . ) +;;; +;;; This happens in the interpreter with lexically +;;; bound functions. +;;; +;;; ( COMPILER::FUNCTION-VALUE . ) +;;; +;;; This happens in the compiler. The gensym represents +;;; a variable which will be bound at run time to the +;;; function object. +;;; +;;; ( EXCL::MACRO . ) +;;; +;;; In both interpreter and compiler, this is the +;;; representation used for macro definitions. +;;; +;;; +#+:ExCL +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +(defun with-augmented-environment-internal (env functions macros) + (let (#+allegro-v4.1 (env-tail (cdr env)) #+allegro-v4.1 (env (car env))) + (dolist (f functions) + (push (list* f 'function #'unbound-lexical-function) env)) + (dolist (m macros) + (push (list* (car m) 'excl::macro (cadr m)) env)) + #-allegro-v4.1 env #+allegro-v4.1 (cons env env-tail))) + +(defun environment-function (env fn) + (let* (#+allegro-v4.1 (env (car env)) + (entry (assoc fn env :test #'equal))) + (and entry + (or (eq (cadr entry) 'function) + (eq (cadr entry) 'compiler::function-value)) + (cddr entry)))) + +(defun environment-macro (env macro) + (let* (#+allegro-v4.1 (env (car env)) + (entry (assoc macro env :test #'equal))) + (and entry + (eq (cadr entry) 'excl::macro) + (cddr entry)))) + +);#+:ExCL + + +#+Lucid +(progn + +(proclaim '(inline + %alphalex-p + add-contour-to-env-shape + make-function-variable + make-sfc-contour + sfc-contour-type + sfc-contour-elements + add-sfc-contour + add-function-contour + add-macrolet-contour + find-variable-in-contour + find-alist-element-in-contour + find-macrolet-in-contour)) + +(defun %alphalex-p (object) + #-Prime + (eq (cadddr (cddddr object)) 'lucid::%alphalex) + #+Prime + (eq (caddr (cddddr object)) 'lucid::%alphalex)) + +#+Prime +(defun lucid::augment-lexenv-fvars-dummy (lexical vars) + (lucid::augment-lexenv-fvars-aux lexical vars '() '() 'flet '())) + +#-lcl4.0 ; Maybe this should be #-lcl4.1 +(progn +(defconstant function-contour 1) +(defconstant macrolet-contour 5)) +#+lcl4.0 ; Maybe this should be #+lcl4.1 +(progn +(defconstant function-contour 2) +(defconstant macrolet-contour 6)) + +(defstruct lucid::contour + type + elements) + +(defun add-contour-to-env-shape (contour-type elements env-shape) + (cons (make-contour :type contour-type + :elements elements) + env-shape)) + +(defstruct (variable (:constructor make-variable (name source-type))) + name + (identifier nil) + source-type) + +(defconstant function-sfc-contour 1) +(defconstant macrolet-sfc-contour 8) +(defconstant function-variable-type 1) + +(defun make-function-variable (name) + (make-variable name function-variable-type)) + +(defun make-sfc-contour (type elements) + (cons type elements)) + +(defun sfc-contour-type (sfc-contour) + (car sfc-contour)) + +(defun sfc-contour-elements (sfc-contour) + (cdr sfc-contour)) + +(defun add-sfc-contour (element-list environment type) + (cons (make-sfc-contour type element-list) environment)) + +(defun add-function-contour (variable-list environment) + (add-sfc-contour variable-list environment function-sfc-contour)) + +(defun add-macrolet-contour (alist environment) + (add-sfc-contour alist environment macrolet-sfc-contour)) + +(defun find-variable-in-contour (name contour) + (dolist (element (sfc-contour-elements contour) nil) + (when (eq (variable-name element) name) + (return element)))) + +(defun find-alist-element-in-contour (name contour) + (cdr (assoc name (sfc-contour-elements contour)))) + +(defun find-macrolet-in-contour (name contour) + (find-alist-element-in-contour name contour)) + +(defmacro do-sfc-contours ((contour-var environment &optional result) + &body body) + `(dolist (,contour-var ,environment ,result) ,@body)) + + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let* ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +;;; +;;; with-augmented-environment-internal is where the real work of augmenting +;;; the environment happens. +;;; +(defun with-augmented-environment-internal (env functions macros) + (let ((function-names (mapcar #'first functions)) + (macro-names (mapcar #'first macros)) + (macro-functions (mapcar #'second macros))) + (cond ((or (null env) + (contour-p (first env))) + (when function-names + (setq env (add-contour-to-env-shape function-contour + function-names + env))) + (when macro-names + (setq env (add-contour-to-env-shape macrolet-contour + (pairlis macro-names + macro-functions) + env)))) + ((%alphalex-p env) + (when function-names + (setq env (lucid::augment-lexenv-fvars-dummy env function-names))) + (when macro-names + (setq env (lucid::augment-lexenv-mvars env + macro-names + macro-functions)))) + (t + (when function-names + (setq env (add-function-contour + (mapcar #'make-function-variable function-names) + env))) + (when macro-names + (setq env (add-macrolet-contour + (pairlis macro-names macro-functions) + env))))) + env)) + + +(defun environment-function (env fn) + (cond ((null env) nil) + ((contour-p (first env)) + (if (lucid::find-lexical-function fn env) + t + nil)) + ((%alphalex-p env) + (if (lucid::lexenv-fvar fn env) + t + nil)) + (t (do-sfc-contours (contour env nil) + (let ((type (sfc-contour-type contour))) + (cond ((eql type function-sfc-contour) + (when (find-variable-in-contour fn contour) + (return t))) + ((eql type macrolet-sfc-contour) + (when (find-macrolet-in-contour fn contour) + (return nil))))))))) + +(defun environment-macro (env macro) + (cond ((null env) nil) + ((contour-p (first env)) + (lucid::find-lexical-macro macro env)) + ((%alphalex-p env) + (lucid::lexenv-mvar macro env)) + (t (do-sfc-contours (contour env nil) + (let ((type (sfc-contour-type contour))) + (cond ((eql type function-sfc-contour) + (when (find-variable-in-contour macro contour) + (return nil))) + ((eql type macrolet-sfc-contour) + (let ((fn (find-macrolet-in-contour macro contour))) + (when fn + (return fn)))))))))) + + +);#+Lucid + + + +;;; +;;; On the 3600, the documentation for how the environments are represented +;;; is in sys:sys;eval.lisp. That total information is not repeated here. +;;; The important points are that: +;;; si:env-variables returns a list of which each element is: +;;; +;;; (symbol value) +;;; or (symbol . locative) +;;; +;;; The first form is for lexical variables, the second for +;;; special and instance variables. In either case CADR of +;;; the entry is the value and SETF of CADR is used to change +;;; the value. Variables are looked up with ASSQ. +;;; +;;; si:env-functions returns a list of which each element is: +;;; +;;; (symbol definition) +;;; +;;; where definition is anything that could go in a function cell. +;;; This is used for both local functions and local macros. +;;; +;;; The 3600 stack conses its environments (at least in the interpreter). +;;; This means that code written using this walker and running on the 3600 +;;; must not hold on to the environment after the walk-function returns. +;;; No code in this walker or in PCL does that. +;;; +#+Genera +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + (let ((funs (make-symbol "FNS")) + (macs (make-symbol "MACROS")) + (new (make-symbol "NEW"))) + `(let ((,funs ,functions) + (,macs ,macros) + (,new ())) + (dolist (f ,funs) + (push `(,(car f) ,#'unbound-lexical-function) ,new)) + (dolist (m ,macs) + (push `(,(car m) (special ,(cadr m))) ,new)) + (let* ((.old-env. ,old-env) + (.old-vars. (pop .old-env.)) + (.old-funs. (pop .old-env.)) + (.old-blks. (pop .old-env.)) + (.old-tags. (pop .old-env.)) + (.old-dcls. (pop .old-env.))) + (si:with-interpreter-environment (,new-env + .old-env. + .old-vars. + (append ,new .old-funs.) + .old-blks. + .old-tags. + .old-dcls.) + ,@body))))) + + +(defun environment-function (env fn) + (if (null env) + (values nil nil) + (let ((entry (assoc fn (si:env-functions env) :test #'equal))) + (if (and entry + (or (not (listp (cadr entry))) + (not (eq (caadr entry) 'special)))) + (values (cadr entry) t) + (environment-function (si:env-parent env) fn))))) + +(defun environment-macro (env macro) + (if (null env) + (values nil nil) + (let ((entry (assoc macro (si:env-functions env) :test #'equal))) + (if (and entry + (listp (cadr entry)) + (eq (caadr entry) 'special)) + (values (cadadr entry) t) + (environment-macro (si:env-parent env) macro))))) + +);#+Genera + +#+Cloe-Runtime +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env ,functions ,macros))) + ,@body)) + +(defun with-augmented-environment-internal (env functions macros) + functions + (dolist (m macros) + (setf env `(,(first m) (compiler::macro . ,(second m)) ,@env))) + env) + +(defun environment-function (env fn) + nil) + +(defun environment-macro (env macro) + (let ((entry (getf env macro))) + (if (and (consp entry) + (eq (car entry) 'compiler::macro)) + (values (cdr entry) t) + (values nil nil)))) + +);#+Cloe-Runtime + + +;;; +;;; In Xerox Lisp, the compiler and interpreter use different structures for +;;; the environment. This doesn't cause a serious problem, the parts of the +;;; environments we are concerned with are fairly similar. +;;; +#+:Xerox +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let* ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +;;; +;;; with-augmented-environment-internal is where the real work of augmenting +;;; the environment happens. Before it gets there, env had better not be NIL +;;; anymore because we have to know what kind of environment we are supposed +;;; to be building up. This is probably never a real concern in practice. +;;; It better not be because we don't do anything about it. +;;; +(defun with-augmented-environment-internal (env functions macros) + (cond + ((compiler::env-p env) + (dolist (f functions) + (setq env (compiler::copy-env-with-function + env f :function))) + (dolist (m macros) + (setq env (compiler::copy-env-with-function + env (car m) :macro (cadr m))))) + (t (setq env (if (il:environment-p env) + (il:\\copy-environment env) + (il:\\make-environment))) + ;; The functions field of the environment is a plist of function names + ;; and conses like (:function . fn) or (:macro . expansion-fn). + ;; Note that we can't smash existing entries in this plist since these + ;; are likely shared with older environments. + (dolist (f functions) + (setf (il:environment-functions env) + (list* f (cons :function #'unbound-lexical-function) + (il:environment-functions env)))) + (dolist (m macros) + (setf (il:environment-functions env) + (list* (car m) (cons :macro (cadr m)) + (il:environment-functions env)))))) + env) + +(defun environment-function (env fn) + (cond ((compiler::env-p env) (eq (compiler:env-fboundp env fn) :function)) + ((il:environment-p env) (eq (getf (il:environment-functions env) fn) + :function)) + (t nil))) + +(defun environment-macro (env macro) + (cond ((compiler::env-p env) + (multiple-value-bind (type def) + (compiler:env-fboundp env macro) + (when (eq type :macro) def))) + ((il:environment-p env) + (xcl:destructuring-bind (type . def) + (getf (il:environment-functions env) macro) + (when (eq type :macro) def))) + (t nil))) + +);#+:Xerox + + +;;; +;;; In IBUKI Common Lisp, the macroexpansion environment is a three element +;;; list. The second element describes lexical functions and macros. The +;;; function entries in this list have the form +;;; ( . (FUNCTION . ( . nil)) +;;; The macro entries have the form +;;; ( . (MACRO . ( . nil)). +;;; +;;; +#+(or KCL IBCL) +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +(defun with-augmented-environment-internal (env functions macros) + (let ((first (first env)) + (lexicals (second env)) + (third (third env))) + (dolist (f functions) + (push `(,(car f) . (function . (,#'unbound-lexical-function . nil))) + lexicals)) + (dolist (m macros) + (push `(,(car m) . (si::macro . ( ,(cadr m) . nil))) + lexicals)) + (list first lexicals third))) + +(defun environment-function (env fn) + (when env + (let ((entry (assoc fn (second env)))) + (and entry + (eq (cadr entry) 'function) + (caddr entry))))) + +(defun environment-macro (env macro) + (when env + (let ((entry (assoc macro (second env)))) + (and entry + (eq (cadr entry) 'si::macro) + (caddr entry))))) +);#+(or KCL IBCL) + + +;;; --- TI Explorer -- + +;;; An environment is a two element list, whose car we can ignore and +;;; whose cadr is list of the local-definitions-frames. Each +;;; local-definitions-frame holds either macros or functions, but not +;;; both. Each frame is a plist of ... where +;;; is a locative to the function cell of the symbol that names +;;; the function or macro, and is the new def or NIL if this is function +;;; redefinition or (cons 'ticl:macro ) if this is a macro +;;; redefinition. +;;; +;;; Here's an example. For the form: +;;; (defun foo () +;;; (macrolet ((bar (a b) (list a b)) +;;; (bar2 (a b) (list a b))) +;;; (flet ((some-local-fn (c d) (print (list c d))) +;;; (another (c d) (print (list c d)))) +;;; (bar (some-local-fn 1 2) 3)))) + +;;; the environment arg to macroexpand-1 when called on +;;; (bar (some-local-fn 1 2) 3) +;;;is +;;;(NIL ((# NIL +;;; # NIL) +;;; (# +;;; (TICL:MACRO TICL:NAMED-LAMBDA (BAR (:DESCRIPTIVE-ARGLIST (A B))) +;;; (SYS::*MACROARG* &OPTIONAL SYS::*MACROENVIRONMENT*) +;;; (BLOCK BAR ....)) +;;; # +;;; (TICL:MACRO TICL:NAMED-LAMBDA (BAR2 (:DESCRIPTIVE-ARGLIST (A B))) +;;; (SYS::*MACROARG* &OPTIONAL SYS::*MACROENVIRONMENT*) +;;; (BLOCK BAR2 ....)))) +#+TI +(progn + +;;; from sys:site;macros.lisp +(eval-when (compile load eval) + +(DEFMACRO MACRO-DEF? (thing) + `(AND (CONSP ,thing) (EQ (CAR ,thing) 'TICL::MACRO))) + +;; the following macro generates code to check the 'local' environment +;; for a macro definition for THE SYMBOL . Such a definition would +;; be set up only by a MACROLET. If a macro definition for is +;; found, its expander function is returned. + +(DEFMACRO FIND-LOCAL-DEFINITION (name local-function-environment) + `(IF ,local-function-environment + (LET ((vcell (ticl::LOCF (SYMBOL-FUNCTION ,name)))) + (DOLIST (frame ,local-function-environment) + ;; is nil or a locative + (LET ((value (sys::GET-LOCATION-OR-NIL (ticl::LOCF frame) + vcell))) + (When value (RETURN (CAR value)))))) + nil))) + + +;;;Edited by Reed Hastings 13 Jan 88 16:29 +(defun environment-macro (env macro) + "returns what macro-function would, ie. the expansion function" + ;;some code picked off macroexpand-1 + (let* ((local-definitions (cadr env)) + (local-def (find-local-definition macro local-definitions))) + (if (macro-def? local-def) + (cdr local-def)))) + +;;;Edited by Reed Hastings 13 Jan 88 16:29 +;;;Edited by Reed Hastings 7 Mar 88 19:07 +(defun environment-function (env fn) + (let* ((local-definitions (cadr env))) + (dolist (frame local-definitions) + (let ((val (getf frame + (ticl::locf (symbol-function fn)) + :not-found-marker))) + (cond ((eq val :not-found-marker)) + ((functionp val) (return t)) + ((and (listp val) + (eq (car val) 'ticl::macro)) + (return nil)) + (t + (error "we are confused"))))))) + + +;;;Edited by Reed Hastings 13 Jan 88 16:29 +;;;Edited by Reed Hastings 7 Mar 88 19:07 +(defun with-augmented-environment-internal (env functions macros) + (let ((local-definitions (cadr env)) + (new-local-fns-frame + (mapcan #'(lambda (fn) + (list (ticl:locf (symbol-function (car fn))) + #'unbound-lexical-function)) + functions)) + (new-local-macros-frame + (mapcan #'(lambda (m) + (list (ticl:locf (symbol-function (car m))) (cons 'ticl::macro (cadr m)))) + macros))) + (when new-local-fns-frame + (push new-local-fns-frame local-definitions)) + (when new-local-macros-frame + (push new-local-macros-frame local-definitions)) + `(,(car env) ,local-definitions))) + + +;;;Edited by Reed Hastings 7 Mar 88 19:07 +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +);#+TI + + +#+(and dec vax common) +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +(defun with-augmented-environment-internal (env functions macros) + #'(lambda (op &optional (arg nil arg-p)) + (cond ((eq op :macro-function) + (unless arg-p (error "Invalid environment use.")) + (lookup-macro-function arg env functions macros)) + (arg-p + (error "Invalid environment operation: ~S ~S" op arg)) + (t + (lookup-macro-function op env functions macros))))) + +(defun lookup-macro-function (name env fns macros) + (let ((m (assoc name macros))) + (cond (m (cadr m)) + ((assoc name fns) :function) + (env (funcall env name)) + (t nil)))) + +(defun environment-macro (env macro) + (let ((m (and env (funcall env macro)))) + (and (not (eq m :function)) + m))) + +;;; Nobody calls environment-function. What would it return, anyway? +);#+(and dec vax common) + + +;;; +;;; In Golden Common Lisp, the macroexpansion environment is just a list +;;; of environment entries. Unless the car of the list is :compiler-menv +;;; it is an interpreted environment. The cadr of each element specifies +;;; the type of the element. The only types that interest us are GCL:MACRO +;;; and FUNCTION. In these cases the element is interpreted as follows. +;;; +;;; Compiled: +;;; ( macroexpansion-function) +;;; ( ) +;;; +;;; Interpreted: +;;; ( GCL:MACRO macroexpansion-function) +;;; ( ) +;;; +;;; When in the compiler, is a gensym which will be +;;; a variable which bound at run-time to the function. +;;; When in the interpreter, is the actual function. +;;; +;;; +#+gclisp +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +(defun with-augmented-environment-internal (env functions macros) + (let ((new-entries nil)) + (dolist (f functions) + (push (cons (car f) nil) new-entries)) + (dolist (m macros) + (push (cons (car m) + (if (eq :compiler-menv (car env)) + (if (eq (caadr m) 'lisp::lambda) + `(,(gensym) ,(cadr m)) + `(,(gensym) ,@(cadr m))) + `(gclisp:MACRO ,@(cadr m)))) + new-entries)) + (if (eq :compiler-menv (car env)) + `(:compiler-menv ,@new-entries ,@(cdr env)) + (append new-entries env)))) + +(defun environment-function (env fn) + (let ((entry (lisp::lexical-function fn env))) + (and entry + (eq entry 'lisp::lexical-function) + fn))) + +(defun environment-macro (env macro) + (let ((entry (assoc macro (if (eq :compiler-menv (first env)) + (rest env) + env)))) + (and entry + (consp entry) + (symbolp (car entry)) ;name + (symbolp (cadr entry)) ;gcl:macro or gensym + (nthcdr 2 entry)))) + +);#+gclisp + + +;;;; CMU Common Lisp version of environment frobbing stuff. + +;;; In CMU Common Lisp, the environment is represented with a structure +;;; that holds alists for the functional things, variables, blocks, etc. +;;; Only the c::lexenv-functions slot is relevent. It holds: +;;; Alist (name . what), where What is either a Functional (a local function) +;;; or a list (MACRO . ) (a local macro, with the specifier +;;; expander.) Note that Name may be a (SETF ) function. + +#+:CMU +(progn + +(defmacro with-augmented-environment + ((new-env old-env &key functions macros) &body body) + `(let ((,new-env (with-augmented-environment-internal ,old-env + ,functions + ,macros))) + ,@body)) + +(defun with-augmented-environment-internal (env functions macros) + ;; Note: In order to record the correct function definition, we would + ;; have to create an interpreted closure, but the with-new-definition + ;; macro down below makes no distinction between flet and labels, so + ;; we have no idea what to use for the environment. So we just blow it + ;; off, 'cause anything real we do would be wrong. We still have to + ;; make an entry so we can tell functions from macros. + (let ((env (or env (c::make-null-environment)))) + (c::make-lexenv + :default env + :functions + (append (mapcar #'(lambda (f) + (cons (car f) (c::make-functional :lexenv env))) + functions) + (mapcar #'(lambda (m) + (list* (car m) 'c::macro + (coerce (cadr m) 'function))) + macros))))) + +(defun environment-function (env fn) + (when env + (let ((entry (assoc fn (c::lexenv-functions env) :test #'equal))) + (and entry + (c::functional-p (cdr entry)) + (cdr entry))))) + +(defun environment-macro (env macro) + (when env + (let ((entry (assoc macro (c::lexenv-functions env) :test #'eq))) + (and entry + (eq (cadr entry) 'c::macro) + (function-lambda-expression (cddr entry)))))) + +); end of #+:CMU + + + +(defmacro with-new-definition-in-environment + ((new-env old-env macrolet/flet/labels-form) &body body) + (let ((functions (make-symbol "Functions")) + (macros (make-symbol "Macros"))) + `(let ((,functions ()) + (,macros ())) + (ecase (car ,macrolet/flet/labels-form) + ((flet labels) + (dolist (fn (cadr ,macrolet/flet/labels-form)) + (push fn ,functions))) + ((macrolet) + (dolist (mac (cadr ,macrolet/flet/labels-form)) + (push (list (car mac) + (convert-macro-to-lambda (cadr mac) + (cddr mac) + (string (car mac)))) + ,macros)))) + (with-augmented-environment + (,new-env ,old-env :functions ,functions :macros ,macros) + ,@body)))) + +#-Genera +(defun convert-macro-to-lambda (llist body &optional (name "Dummy Macro")) + (let ((gensym (make-symbol name))) + (eval `(defmacro ,gensym ,llist ,@body)) + (macro-function gensym))) + +#+Genera +(defun convert-macro-to-lambda (llist body &optional (name "Dummy Macro")) + (si:defmacro-1 + 'sys:named-lambda 'sys:special (make-symbol name) llist body)) + + + + + +;;; +;;; Now comes the real walker. +;;; +;;; As the walker walks over the code, it communicates information to itself +;;; about the walk. This information includes the walk function, variable +;;; bindings, declarations in effect etc. This information is inherently +;;; lexical, so the walker passes it around in the actual environment the +;;; walker passes to macroexpansion functions. This is what makes the +;;; nested-walk-form facility work properly. +;;; +(defmacro walker-environment-bind ((var env &rest key-args) + &body body) + `(with-augmented-environment + (,var ,env :macros (walker-environment-bind-1 ,env ,.key-args)) + .,body)) + +(defvar *key-to-walker-environment* (gensym)) + +(defun env-lock (env) + (environment-macro env *key-to-walker-environment*)) + +(defun walker-environment-bind-1 (env &key (walk-function nil wfnp) + (walk-form nil wfop) + (declarations nil decp) + (lexical-variables nil lexp)) + (let ((lock (environment-macro env *key-to-walker-environment*))) + (list + (list *key-to-walker-environment* + (list (if wfnp walk-function (car lock)) + (if wfop walk-form (cadr lock)) + (if decp declarations (caddr lock)) + (if lexp lexical-variables (cadddr lock))))))) + +(defun env-walk-function (env) + (car (env-lock env))) + +(defun env-walk-form (env) + (cadr (env-lock env))) + +(defun env-declarations (env) + (caddr (env-lock env))) + +(defun env-lexical-variables (env) + (cadddr (env-lock env))) + + +(defun note-declaration (declaration env) + (push declaration (caddr (env-lock env)))) + +(defun note-lexical-binding (thing env) + (push (list thing :lexical-var) (cadddr (env-lock env)))) + +(defun VARIABLE-LEXICAL-P (var env) + (let ((entry (member var (env-lexical-variables env) :key #'car))) + (when (eq (cadar entry) :lexical-var) + entry))) + +(defun variable-symbol-macro-p (var env) + (let ((entry (member var (env-lexical-variables env) :key #'car))) + (when (eq (cadar entry) :macro) + entry))) + + +(defvar *VARIABLE-DECLARATIONS* '(special)) + +(defun VARIABLE-DECLARATION (declaration var env) + (if (not (member declaration *variable-declarations*)) + (error "~S is not a recognized variable declaration." declaration) + (let ((id (or (variable-lexical-p var env) var))) + (dolist (decl (env-declarations env)) + (when (and (eq (car decl) declaration) + (eq (cadr decl) id)) + (return decl)))))) + +(defun VARIABLE-SPECIAL-P (var env) + (or (not (null (variable-declaration 'special var env))) + (variable-globally-special-p var))) + +;;; +;;; VARIABLE-GLOBALLY-SPECIAL-P is used to ask if a variable has been +;;; declared globally special. Any particular CommonLisp implementation +;;; should customize this function accordingly and send their customization +;;; back. +;;; +;;; The default version of variable-globally-special-p is probably pretty +;;; slow, so it uses *globally-special-variables* as a cache to remember +;;; variables that it has already figured out are globally special. +;;; +;;; This would need to be reworked if an unspecial declaration got added to +;;; Common Lisp. +;;; +;;; Common Lisp nit: +;;; variable-globally-special-p should be defined in Common Lisp. +;;; +#-(or Genera Cloe-Runtime Lucid Xerox Excl KCL IBCL (and dec vax common) :CMU HP-HPLabs + GCLisp TI pyramid) +(defvar *globally-special-variables* ()) + +(defun variable-globally-special-p (symbol) + #+Genera (si:special-variable-p symbol) + #+Cloe-Runtime (compiler::specialp symbol) + #+Lucid (lucid::proclaimed-special-p symbol) + #+TI (get symbol 'special) + #+Xerox (il:variable-globally-special-p symbol) + #+(and dec vax common) (get symbol 'system::globally-special) + #+(or KCL IBCL) (si:specialp symbol) + #+excl (get symbol 'excl::.globally-special.) + #+:CMU (eq (ext:info variable kind symbol) :special) + #+HP-HPLabs (member (get symbol 'impl:vartype) + '(impl:fluid impl:global) + :test #'eq) + #+:GCLISP (gclisp::special-p symbol) + #+pyramid (or (get symbol 'lisp::globally-special) + (get symbol + 'clc::globally-special-in-compiler)) + #+:CORAL (ccl::proclaimed-special-p symbol) + #-(or Genera Cloe-Runtime Lucid Xerox Excl KCL IBCL (and dec vax common) :CMU HP-HPLabs + GCLisp TI pyramid :CORAL) + (or (not (null (member symbol *globally-special-variables* :test #'eq))) + (when (eval `(flet ((ref () ,symbol)) + (let ((,symbol '#,(list nil))) + (and (boundp ',symbol) (eq ,symbol (ref)))))) + (push symbol *globally-special-variables*) + t))) + + + ;; +;;;;;; Handling of special forms (the infamous 24). + ;; +;;; +;;; and I quote... +;;; +;;; The set of special forms is purposely kept very small because +;;; any program analyzing program (read code walker) must have +;;; special knowledge about every type of special form. Such a +;;; program needs no special knowledge about macros... +;;; +;;; So all we have to do here is a define a way to store and retrieve +;;; templates which describe how to walk the 24 special forms and we are all +;;; set... +;;; +;;; Well, its a nice concept, and I have to admit to being naive enough that +;;; I believed it for a while, but not everyone takes having only 24 special +;;; forms as seriously as might be nice. There are (at least) 3 ways to +;;; lose: +;; +;;; 1 - Implementation x implements a Common Lisp special form as a macro +;;; which expands into a special form which: +;;; - Is a common lisp special form (not likely) +;;; - Is not a common lisp special form (on the 3600 IF --> COND). +;;; +;;; * We can safe ourselves from this case (second subcase really) by +;;; checking to see if there is a template defined for something +;;; before we check to see if we we can macroexpand it. +;;; +;;; 2 - Implementation x implements a Common Lisp macro as a special form. +;;; +;;; * This is a screw, but not so bad, we save ourselves from it by +;;; defining extra templates for the macros which are *likely* to +;;; be implemented as special forms. (DO, DO* ...) +;;; +;;; 3 - Implementation x has a special form which is not on the list of +;;; Common Lisp special forms. +;;; +;;; * This is a bad sort of a screw and happens more than I would like +;;; to think, especially in the implementations which provide more +;;; than just Common Lisp (3600, Xerox etc.). +;;; The fix is not terribly staisfactory, but will have to do for +;;; now. There is a hook in get walker-template which can get a +;;; template from the implementation's own walker. That template +;;; has to be converted, and so it may be that the right way to do +;;; this would actually be for that implementation to provide an +;;; interface to its walker which looks like the interface to this +;;; walker. +;;; + +(eval-when (compile load eval) + +(defmacro get-walker-template-internal (x) ;Has to be inside eval-when because + `(get ,x 'walker-template)) ;Golden Common Lisp doesn't hack + ;compile time definition of macros + ;right for setf. + +(defmacro define-walker-template + (name &optional (template '(nil repeat (eval)))) + `(eval-when (load eval) + (setf (get-walker-template-internal ',name) ',template))) +) + +(defun get-walker-template (x) + (cond ((symbolp x) + (or (get-walker-template-internal x) + (get-implementation-dependent-walker-template x))) + ((and (listp x) + (or (eq (car x) 'lambda) + #+cmu17 (eq (car x) 'kernel:instance-lambda))) + '(lambda repeat (eval))) + (t + (error "Can't get template for ~S" x)))) + +(defun get-implementation-dependent-walker-template (x) + (declare (ignore x)) + ()) + + + ;; +;;;;;; The actual templates + ;; + +(define-walker-template BLOCK (NIL NIL REPEAT (EVAL))) +(define-walker-template CATCH (NIL EVAL REPEAT (EVAL))) +(define-walker-template COMPILER-LET walk-compiler-let) +(define-walker-template DECLARE walk-unexpected-declare) +(define-walker-template EVAL-WHEN (NIL QUOTE REPEAT (EVAL))) +(define-walker-template FLET walk-flet) +(define-walker-template FUNCTION (NIL CALL)) +(define-walker-template GO (NIL QUOTE)) +(define-walker-template IF walk-if) +(define-walker-template LABELS walk-labels) +(define-walker-template LAMBDA walk-lambda) +(define-walker-template LET walk-let) +(define-walker-template LET* walk-let*) +(define-walker-template LOCALLY walk-locally) +(define-walker-template MACROLET walk-macrolet) +(define-walker-template MULTIPLE-VALUE-CALL (NIL EVAL REPEAT (EVAL))) +(define-walker-template MULTIPLE-VALUE-PROG1 (NIL RETURN REPEAT (EVAL))) +(define-walker-template MULTIPLE-VALUE-SETQ walk-multiple-value-setq) +(define-walker-template MULTIPLE-VALUE-BIND walk-multiple-value-bind) +(define-walker-template PROGN (NIL REPEAT (EVAL))) +(define-walker-template PROGV (NIL EVAL EVAL REPEAT (EVAL))) +(define-walker-template QUOTE (NIL QUOTE)) +(define-walker-template RETURN-FROM (NIL QUOTE REPEAT (RETURN))) +(define-walker-template SETQ walk-setq) +(define-walker-template SYMBOL-MACROLET walk-symbol-macrolet) +(define-walker-template TAGBODY walk-tagbody) +(define-walker-template THE (NIL QUOTE EVAL)) +#+cmu(define-walker-template EXT:TRULY-THE (NIL QUOTE EVAL)) +(define-walker-template THROW (NIL EVAL EVAL)) +(define-walker-template UNWIND-PROTECT (NIL RETURN REPEAT (EVAL))) + +;;; The new special form. +;(define-walker-template pcl::LOAD-TIME-EVAL (NIL EVAL)) + +;;; +;;; And the extra templates... +;;; +(define-walker-template DO walk-do) +(define-walker-template DO* walk-do*) +(define-walker-template PROG walk-prog) +(define-walker-template PROG* walk-prog*) +(define-walker-template COND (NIL REPEAT ((TEST REPEAT (EVAL))))) + +#+Genera +(progn + (define-walker-template zl::named-lambda walk-named-lambda) + (define-walker-template SCL:LETF walk-let) + (define-walker-template SCL:LETF* walk-let*) + ) + +#+Lucid +(progn + (define-walker-template #+LCL3.0 lucid-common-lisp:named-lambda + #-LCL3.0 sys:named-lambda walk-named-lambda) + ) + +#+(or KCL IBCL) +(progn + (define-walker-template si::lambda-block walk-named-lambda);Not really right, + ;we don't hack block + ;names anyways. + ) + +#+TI +(progn + (define-walker-template TICL::LET-IF walk-let-if) + ) + +#+:Coral +(progn + (define-walker-template ccl:%stack-block walk-let) + ) + +#+cmu17 +(progn + (define-walker-template kernel:instance-lambda walk-lambda) + ) + + + +(defvar walk-form-expand-macros-p nil) + +(defun macroexpand-all (form &optional environment) + (let ((walk-form-expand-macros-p t)) + (walk-form form environment))) + +(defun WALK-FORM (form + &optional environment + (walk-function + #'(lambda (subform context env) + (declare (ignore context env)) + subform))) + (walker-environment-bind (new-env environment :walk-function walk-function) + (walk-form-internal form :eval new-env))) + +;;; +;;; nested-walk-form provides an interface that allows nested macros, each +;;; of which must walk their body to just do one walk of the body of the +;;; inner macro. That inner walk is done with a walk function which is the +;;; composition of the two walk functions. +;;; +;;; This facility works by having the walker annotate the environment that +;;; it passes to macroexpand-1 to know which form is being macroexpanded. +;;; If then the &whole argument to the macroexpansion function is eq to +;;; the env-walk-form of the environment, nested-walk-form can be certain +;;; that there are no intervening layers and that a nested walk is alright. +;;; +;;; There are some semantic problems with this facility. In particular, if +;;; the outer walk function returns T as its walk-no-more-p value, this will +;;; prevent the inner walk function from getting a chance to walk the subforms +;;; of the form. This is almost never what you want, since it destroys the +;;; equivalence between this nested-walk-form function and two seperate +;;; walk-forms. +;;; +(defun NESTED-WALK-FORM (whole + form + &optional environment + (walk-function + #'(lambda (subform context env) + (declare (ignore context env)) + subform))) + (if (eq whole (env-walk-form environment)) + (let ((outer-walk-function (env-walk-function environment))) + (throw whole + (walk-form + form + environment + #'(lambda (f c e) + ;; First loop to make sure the inner walk function + ;; has done all it wants to do with this form. + ;; Basically, what we are doing here is providing + ;; the same contract walk-form-internal normally + ;; provides to the inner walk function. + (let ((inner-result nil) + (inner-no-more-p nil) + (outer-result nil) + (outer-no-more-p nil)) + (loop + (multiple-value-setq (inner-result inner-no-more-p) + (funcall walk-function f c e)) + (cond (inner-no-more-p (return)) + ((not (eq inner-result f))) + ((not (consp inner-result)) (return)) + ((get-walker-template (car inner-result)) (return)) + (t + (multiple-value-bind (expansion macrop) + (walker-environment-bind + (new-env e :walk-form inner-result) + (macroexpand-1 inner-result new-env)) + (if macrop + (setq inner-result expansion) + (return))))) + (setq f inner-result)) + (multiple-value-setq (outer-result outer-no-more-p) + (funcall outer-walk-function + inner-result + c + e)) + (values outer-result + (and inner-no-more-p outer-no-more-p))))))) + (walk-form form environment walk-function))) + +;;; +;;; WALK-FORM-INTERNAL is the main driving function for the code walker. It +;;; takes a form and the current context and walks the form calling itself or +;;; the appropriate template recursively. +;;; +;;; "It is recommended that a program-analyzing-program process a form +;;; that is a list whose car is a symbol as follows: +;;; +;;; 1. If the program has particular knowledge about the symbol, +;;; process the form using special-purpose code. All of the +;;; standard special forms should fall into this category. +;;; 2. Otherwise, if macro-function is true of the symbol apply +;;; either macroexpand or macroexpand-1 and start over. +;;; 3. Otherwise, assume it is a function call. " +;;; + +(defun walk-form-internal (form context env) + ;; First apply the walk-function to perform whatever translation + ;; the user wants to this form. If the second value returned + ;; by walk-function is T then we don't recurse... + (catch form + (multiple-value-bind (newform walk-no-more-p) + (funcall (env-walk-function env) form context env) + (catch newform + (cond + (walk-no-more-p newform) + ((not (eq form newform)) + (walk-form-internal newform context env)) + ((not (consp newform)) + (let ((symmac (car (variable-symbol-macro-p newform env)))) + (if symmac + (let ((newnewform (walk-form-internal (cddr symmac) + context env))) + (if (eq newnewform (cddr symmac)) + (if walk-form-expand-macros-p newnewform newform) + newnewform)) + newform))) + (t + (let* ((fn (car newform)) + (template (get-walker-template fn))) + (if template + (if (symbolp template) + (funcall template newform context env) + (walk-template newform template context env)) + (multiple-value-bind + (newnewform macrop) + (walker-environment-bind + (new-env env :walk-form newform) + (macroexpand-1 newform new-env)) + (cond + (macrop + (let ((newnewnewform (walk-form-internal newnewform context + env))) + (if (eq newnewnewform newnewform) + (if walk-form-expand-macros-p newnewform newform) + newnewnewform))) + ((and (symbolp fn) + (not (fboundp fn)) + #+cmu17 + (special-operator-p fn) + #-cmu17 + (special-operator-p fn)) + (error + "~S is a special form, not defined in the CommonLisp.~%~ + manual This code walker doesn't know how to walk it.~%~ + Define a template for this special form and try again." + fn)) + (t + ;; Otherwise, walk the form as if its just a standard + ;; functioncall using a template for standard function + ;; call. + (walk-template + newnewform '(call repeat (eval)) context env)))))))))))) + +(defun walk-template (form template context env) + (if (atom template) + (ecase template + ((EVAL FUNCTION TEST EFFECT RETURN) + (walk-form-internal form :EVAL env)) + ((QUOTE NIL) form) + (SET + (walk-form-internal form :SET env)) + ((LAMBDA CALL) + (cond ((or (symbolp form) + (and (listp form) + (= (length form) 2) + (eq (car form) 'setf))) + form) + #+Lispm + ((sys:validate-function-spec form) form) + (t (walk-form-internal form context env))))) + (case (car template) + (REPEAT + (walk-template-handle-repeat form + (cdr template) + ;; For the case where nothing happens + ;; after the repeat optimize out the + ;; call to length. + (if (null (cddr template)) + () + (nthcdr (- (length form) + (length + (cddr template))) + form)) + context + env)) + (IF + (walk-template form + (if (if (listp (cadr template)) + (eval (cadr template)) + (funcall (cadr template) form)) + (caddr template) + (cadddr template)) + context + env)) + (REMOTE + (walk-template form (cadr template) context env)) + (otherwise + (cond ((atom form) form) + (t (recons form + (walk-template + (car form) (car template) context env) + (walk-template + (cdr form) (cdr template) context env)))))))) + +(defun walk-template-handle-repeat (form template stop-form context env) + (if (eq form stop-form) + (walk-template form (cdr template) context env) + (walk-template-handle-repeat-1 form + template + (car template) + stop-form + context + env))) + +(defun walk-template-handle-repeat-1 (form template repeat-template + stop-form context env) + (cond ((null form) ()) + ((eq form stop-form) + (if (null repeat-template) + (walk-template stop-form (cdr template) context env) + (error "While handling repeat: + ~%~Ran into stop while still in repeat template."))) + ((null repeat-template) + (walk-template-handle-repeat-1 + form template (car template) stop-form context env)) + (t + (recons form + (walk-template (car form) (car repeat-template) context env) + (walk-template-handle-repeat-1 (cdr form) + template + (cdr repeat-template) + stop-form + context + env))))) + +(defun walk-repeat-eval (form env) + (and form + (recons form + (walk-form-internal (car form) :eval env) + (walk-repeat-eval (cdr form) env)))) + +(defun recons (x car cdr) + (if (or (not (eq (car x) car)) + (not (eq (cdr x) cdr))) + (cons car cdr) + x)) + +(defun relist (x &rest args) + (if (null args) + nil + (relist-internal x args nil))) + +(defun relist* (x &rest args) + (relist-internal x args 't)) + +(defun relist-internal (x args *p) + (if (null (cdr args)) + (if *p + (car args) + (recons x (car args) nil)) + (recons x + (car args) + (relist-internal (cdr x) (cdr args) *p)))) + + + ;; +;;;;;; Special walkers + ;; + +(defun walk-declarations (body fn env + &optional doc-string-p declarations old-body + &aux (form (car body)) macrop new-form) + (cond ((and (stringp form) ;might be a doc string + (cdr body) ;isn't the returned value + (null doc-string-p) ;no doc string yet + (null declarations)) ;no declarations yet + (recons body + form + (walk-declarations (cdr body) fn env t))) + ((and (listp form) (eq (car form) 'declare)) + ;; Got ourselves a real live declaration. Record it, look for more. + (dolist (declaration (cdr form)) + (let ((type (car declaration)) + (name (cadr declaration)) + (args (cddr declaration))) + (if (member type *variable-declarations*) + (note-declaration `(,type + ,(or (variable-lexical-p name env) name) + ,.args) + env) + (note-declaration declaration env)) + (push declaration declarations))) + (recons body + form + (walk-declarations + (cdr body) fn env doc-string-p declarations))) + ((and form + (listp form) + (null (get-walker-template (car form))) + (progn + (multiple-value-setq (new-form macrop) + (macroexpand-1 form env)) + macrop)) + ;; This form was a call to a macro. Maybe it expanded + ;; into a declare? Recurse to find out. + (walk-declarations (recons body new-form (cdr body)) + fn env doc-string-p declarations + (or old-body body))) + (t + ;; Now that we have walked and recorded the declarations, + ;; call the function our caller provided to expand the body. + ;; We call that function rather than passing the real-body + ;; back, because we are RECONSING up the new body. + (funcall fn (or old-body body) env)))) + + +(defun walk-unexpected-declare (form context env) + (declare (ignore context env)) + (warn "Encountered declare ~S in a place where a declare was not expected." + form) + form) + +(defun walk-arglist (arglist context env &optional (destructuringp nil) + &aux arg) + (cond ((null arglist) ()) + ((symbolp (setq arg (car arglist))) + (or (member arg lambda-list-keywords) + (note-lexical-binding arg env)) + (recons arglist + arg + (walk-arglist (cdr arglist) + context + env + (and destructuringp + (not (member arg + lambda-list-keywords)))))) + ((consp arg) + (prog1 (recons arglist + (if destructuringp + (walk-arglist arg context env destructuringp) + (relist* arg + (car arg) + (walk-form-internal (cadr arg) :eval env) + (cddr arg))) + (walk-arglist (cdr arglist) context env nil)) + (if (symbolp (car arg)) + (note-lexical-binding (car arg) env) + (note-lexical-binding (cadar arg) env)) + (or (null (cddr arg)) + (not (symbolp (caddr arg))) + (note-lexical-binding (caddr arg) env)))) + (t + (error "Can't understand something in the arglist ~S" arglist)))) + +(defun walk-let (form context env) + (walk-let/let* form context env nil)) + +(defun walk-let* (form context env) + (walk-let/let* form context env t)) + +(defun walk-prog (form context env) + (walk-prog/prog* form context env nil)) + +(defun walk-prog* (form context env) + (walk-prog/prog* form context env t)) + +(defun walk-do (form context env) + (walk-do/do* form context env nil)) + +(defun walk-do* (form context env) + (walk-do/do* form context env t)) + +(defun walk-let/let* (form context old-env sequentialp) + (walker-environment-bind (new-env old-env) + (let* ((let/let* (car form)) + (bindings (cadr form)) + (body (cddr form)) + (walked-bindings + (walk-bindings-1 bindings + old-env + new-env + context + sequentialp)) + (walked-body + (walk-declarations body #'walk-repeat-eval new-env))) + (relist* + form let/let* walked-bindings walked-body)))) + +(defun walk-locally (form context env) + (declare (ignore context)) + (let* ((locally (car form)) + (body (cdr form)) + (walked-body + (walk-declarations body #'walk-repeat-eval env))) + (relist* + form locally walked-body))) + +(defun walk-prog/prog* (form context old-env sequentialp) + (walker-environment-bind (new-env old-env) + (let* ((possible-block-name (second form)) + (blocked-prog (and (symbolp possible-block-name) + (not (eq possible-block-name 'nil))))) + (multiple-value-bind (let/let* block-name bindings body) + (if blocked-prog + (values (car form) (cadr form) (caddr form) (cdddr form)) + (values (car form) nil (cadr form) (cddr form))) + (let* ((walked-bindings + (walk-bindings-1 bindings + old-env + new-env + context + sequentialp)) + (walked-body + (walk-declarations + body + #'(lambda (real-body real-env) + (walk-tagbody-1 real-body context real-env)) + new-env))) + (if block-name + (relist* + form let/let* block-name walked-bindings walked-body) + (relist* + form let/let* walked-bindings walked-body))))))) + +(defun walk-do/do* (form context old-env sequentialp) + (walker-environment-bind (new-env old-env) + (let* ((do/do* (car form)) + (bindings (cadr form)) + (end-test (caddr form)) + (body (cdddr form)) + (walked-bindings (walk-bindings-1 bindings + old-env + new-env + context + sequentialp)) + (walked-body + (walk-declarations body #'walk-repeat-eval new-env))) + (relist* form + do/do* + (walk-bindings-2 bindings walked-bindings context new-env) + (walk-template end-test '(test repeat (eval)) context new-env) + walked-body)))) + +(defun walk-let-if (form context env) + (let ((test (cadr form)) + (bindings (caddr form)) + (body (cdddr form))) + (walk-form-internal + `(let () + (declare (special ,@(mapcar #'(lambda (x) (if (listp x) (car x) x)) + bindings))) + (flet ((.let-if-dummy. () ,@body)) + (if ,test + (let ,bindings (.let-if-dummy.)) + (.let-if-dummy.)))) + context + env))) + +(defun walk-multiple-value-setq (form context env) + (let ((vars (cadr form))) + (if (some #'(lambda (var) + (variable-symbol-macro-p var env)) + vars) + (let* ((temps (mapcar #'(lambda (var) (declare (ignore var)) (gensym)) vars)) + (sets (mapcar #'(lambda (var temp) `(setq ,var ,temp)) vars temps)) + (expanded `(multiple-value-bind ,temps + ,(caddr form) + ,@sets)) + (walked (walk-form-internal expanded context env))) + (if (eq walked expanded) + form + walked)) + (walk-template form '(nil (repeat (set)) eval) context env)))) + +(defun walk-multiple-value-bind (form context old-env) + (walker-environment-bind (new-env old-env) + (let* ((mvb (car form)) + (bindings (cadr form)) + (mv-form (walk-template (caddr form) 'eval context old-env)) + (body (cdddr form)) + walked-bindings + (walked-body + (walk-declarations + body + #'(lambda (real-body real-env) + (setq walked-bindings + (walk-bindings-1 bindings + old-env + new-env + context + nil)) + (walk-repeat-eval real-body real-env)) + new-env))) + (relist* form mvb walked-bindings mv-form walked-body)))) + +(defun walk-bindings-1 (bindings old-env new-env context sequentialp) + (and bindings + (let ((binding (car bindings))) + (recons bindings + (if (symbolp binding) + (prog1 binding + (note-lexical-binding binding new-env)) + (prog1 (relist* binding + (car binding) + (walk-form-internal (cadr binding) + context + (if sequentialp + new-env + old-env)) + (cddr binding)) ;save cddr for DO/DO* + ;it is the next value + ;form. Don't walk it + ;now though. + (note-lexical-binding (car binding) new-env))) + (walk-bindings-1 (cdr bindings) + old-env + new-env + context + sequentialp))))) + +(defun walk-bindings-2 (bindings walked-bindings context env) + (and bindings + (let ((binding (car bindings)) + (walked-binding (car walked-bindings))) + (recons bindings + (if (symbolp binding) + binding + (relist* binding + (car walked-binding) + (cadr walked-binding) + (walk-template (cddr binding) + '(eval) + context + env))) + (walk-bindings-2 (cdr bindings) + (cdr walked-bindings) + context + env))))) + +(defun walk-lambda (form context old-env) + (walker-environment-bind (new-env old-env) + (let* ((arglist (cadr form)) + (body (cddr form)) + (walked-arglist (walk-arglist arglist context new-env)) + (walked-body + (walk-declarations body #'walk-repeat-eval new-env))) + (relist* form + (car form) + walked-arglist + walked-body)))) + +(defun walk-named-lambda (form context old-env) + (walker-environment-bind (new-env old-env) + (let* ((name (cadr form)) + (arglist (caddr form)) + (body (cdddr form)) + (walked-arglist (walk-arglist arglist context new-env)) + (walked-body + (walk-declarations body #'walk-repeat-eval new-env))) + (relist* form + (car form) + name + walked-arglist + walked-body)))) + +(defun walk-setq (form context env) + (if (cdddr form) + (let* ((expanded (let ((rforms nil) + (tail (cdr form))) + (loop (when (null tail) (return (nreverse rforms))) + (let ((var (pop tail)) (val (pop tail))) + (push `(setq ,var ,val) rforms))))) + (walked (walk-repeat-eval expanded env))) + (if (eq expanded walked) + form + `(progn ,@walked))) + (let* ((var (cadr form)) + (val (caddr form)) + (symmac (car (variable-symbol-macro-p var env)))) + (if symmac + (let* ((expanded `(setf ,(cddr symmac) ,val)) + (walked (walk-form-internal expanded context env))) + (if (eq expanded walked) + form + walked)) + (relist form 'setq + (walk-form-internal var :set env) + (walk-form-internal val :eval env)))))) + +(defun walk-symbol-macrolet (form context old-env) + (declare (ignore context)) + (let* ((bindings (cadr form))) + (walker-environment-bind + (new-env old-env + :lexical-variables + (append (mapcar #'(lambda (binding) + `(,(car binding) + :macro . ,(cadr binding))) + bindings) + (env-lexical-variables old-env))) + (relist* form 'symbol-macrolet bindings + (walk-repeat-eval (cddr form) new-env))))) + +(defun walk-tagbody (form context env) + (recons form (car form) (walk-tagbody-1 (cdr form) context env))) + +(defun walk-tagbody-1 (form context env) + (and form + (recons form + (walk-form-internal (car form) + (if (symbolp (car form)) 'quote context) + env) + (walk-tagbody-1 (cdr form) context env)))) + +(defun walk-compiler-let (form context old-env) + (declare (ignore context)) + (let ((vars ()) + (vals ())) + (dolist (binding (cadr form)) + (cond ((symbolp binding) (push binding vars) (push nil vals)) + (t + (push (car binding) vars) + (push (eval (cadr binding)) vals)))) + (relist* form + (car form) + (cadr form) + (progv vars vals (walk-repeat-eval (cddr form) old-env))))) + +(defun walk-macrolet (form context old-env) + (walker-environment-bind (macro-env + nil + :walk-function (env-walk-function old-env)) + (labels ((walk-definitions (definitions) + (and definitions + (let ((definition (car definitions))) + (recons definitions + (relist* definition + (car definition) + (walk-arglist (cadr definition) + context + macro-env + t) + (walk-declarations (cddr definition) + #'walk-repeat-eval + macro-env)) + (walk-definitions (cdr definitions))))))) + (with-new-definition-in-environment (new-env old-env form) + (relist* form + (car form) + (walk-definitions (cadr form)) + (walk-declarations (cddr form) + #'walk-repeat-eval + new-env)))))) + +(defun walk-flet (form context old-env) + (labels ((walk-definitions (definitions) + (if (null definitions) + () + (recons definitions + (walk-lambda (car definitions) context old-env) + (walk-definitions (cdr definitions)))))) + (recons form + (car form) + (recons (cdr form) + (walk-definitions (cadr form)) + (with-new-definition-in-environment (new-env old-env form) + (walk-declarations (cddr form) + #'walk-repeat-eval + new-env)))))) + +(defun walk-labels (form context old-env) + (with-new-definition-in-environment (new-env old-env form) + (labels ((walk-definitions (definitions) + (if (null definitions) + () + (recons definitions + (walk-lambda (car definitions) context new-env) + (walk-definitions (cdr definitions)))))) + (recons form + (car form) + (recons (cdr form) + (walk-definitions (cadr form)) + (walk-declarations (cddr form) + #'walk-repeat-eval + new-env)))))) + +(defun walk-if (form context env) + (let ((predicate (cadr form)) + (arm1 (caddr form)) + (arm2 + (if (cddddr form) + (progn + (warn "In the form:~%~S~%~ + IF only accepts three arguments, you are using ~D.~%~ + It is true that some Common Lisps support this, but ~ + it is not~%~ + truly legal Common Lisp. For now, this code ~ + walker is interpreting ~%~ + the extra arguments as extra else clauses. ~ + Even if this is what~%~ + you intended, you should fix your source code." + form + (length (cdr form))) + (cons 'progn (cdddr form))) + (cadddr form)))) + (relist form + 'if + (walk-form-internal predicate context env) + (walk-form-internal arm1 context env) + (walk-form-internal arm2 context env)))) + + +;;; +;;; Tests tests tests +;;; + +#| +;;; +;;; Here are some examples of the kinds of things you should be able to do +;;; with your implementation of the macroexpansion environment hacking +;;; mechanism. +;;; +;;; with-lexical-macros is kind of like macrolet, but it only takes names +;;; of the macros and actual macroexpansion functions to use to macroexpand +;;; them. The win about that is that for macros which want to wrap several +;;; macrolets around their body, they can do this but have the macroexpansion +;;; functions be compiled. See the WITH-RPUSH example. +;;; +;;; If the implementation had a special way of communicating the augmented +;;; environment back to the evaluator that would be totally great. It would +;;; mean that we could just augment the environment then pass control back +;;; to the implementations own compiler or interpreter. We wouldn't have +;;; to call the actual walker. That would make this much faster. Since the +;;; principal client of this is defmethod it would make compiling defmethods +;;; faster and that would certainly be a win. +;;; +(defmacro with-lexical-macros (macros &body body &environment old-env) + (with-augmented-environment (new-env old-env :macros macros) + (walk-form (cons 'progn body) :environment new-env))) + +(defun expand-rpush (form env) + `(push ,(caddr form) ,(cadr form))) + +(defmacro with-rpush (&body body) + `(with-lexical-macros ,(list (list 'rpush #'expand-rpush)) ,@body)) + + +;;; +;;; Unfortunately, I don't have an automatic tester for the walker. +;;; Instead there is this set of test cases with a description of +;;; how each one should go. +;;; +(defmacro take-it-out-for-a-test-walk (form) + `(take-it-out-for-a-test-walk-1 ',form)) + +(defun take-it-out-for-a-test-walk-1 (form) + (terpri) + (terpri) + (let ((copy-of-form (copy-tree form)) + (result (walk-form form nil + #'(lambda (x y env) + (format t "~&Form: ~S ~3T Context: ~A" x y) + (when (symbolp x) + (let ((lexical (variable-lexical-p x env)) + (special (variable-special-p x env))) + (when lexical + (format t ";~3T") + (format t "lexically bound")) + (when special + (format t ";~3T") + (format t "declared special")) + (when (boundp x) + (format t ";~3T") + (format t "bound: ~S " (eval x))))) + x)))) + (cond ((not (equal result copy-of-form)) + (format t "~%Warning: Result not EQUAL to copy of start.")) + ((not (eq result form)) + (format t "~%Warning: Result not EQ to copy of start."))) + (pprint result) + result)) + +(defmacro foo (&rest ignore) ''global-foo) + +(defmacro bar (&rest ignore) ''global-bar) + +(take-it-out-for-a-test-walk (list arg1 arg2 arg3)) +(take-it-out-for-a-test-walk (list (cons 1 2) (list 3 4 5))) + +(take-it-out-for-a-test-walk (progn (foo) (bar 1))) + +(take-it-out-for-a-test-walk (block block-name a b c)) +(take-it-out-for-a-test-walk (block block-name (list a) b c)) + +(take-it-out-for-a-test-walk (catch catch-tag (list a) b c)) +;;; +;;; This is a fairly simple macrolet case. While walking the body of the +;;; macro, x should be lexically bound. In the body of the macrolet form +;;; itself, x should not be bound. +;;; +(take-it-out-for-a-test-walk + (macrolet ((foo (x) (list x) ''inner)) + x + (foo 1))) + +;;; +;;; A slightly more complex macrolet case. In the body of the macro x +;;; should not be lexically bound. In the body of the macrolet form itself +;;; x should be bound. Note that THIS CASE WILL CAUSE AN ERROR when it +;;; tries to macroexpand the call to foo. +;;; +(take-it-out-for-a-test-walk + (let ((x 1)) + (macrolet ((foo () (list x) ''inner)) + x + (foo)))) + +;;; +;;; A truly hairy use of compiler-let and macrolet. In the body of the +;;; macro x should not be lexically bound. In the body of the macrolet +;;; itself x should not be lexically bound. But the macro should expand +;;; into 1. +;;; +(take-it-out-for-a-test-walk + (compiler-let ((x 1)) + (let ((x 2)) + (macrolet ((foo () x)) + x + (foo))))) + + +(take-it-out-for-a-test-walk + (flet ((foo (x) (list x y)) + (bar (x) (list x y))) + (foo 1))) + +(take-it-out-for-a-test-walk + (let ((y 2)) + (flet ((foo (x) (list x y)) + (bar (x) (list x y))) + (foo 1)))) + +(take-it-out-for-a-test-walk + (labels ((foo (x) (bar x)) + (bar (x) (foo x))) + (foo 1))) + +(take-it-out-for-a-test-walk + (flet ((foo (x) (foo x))) + (foo 1))) + +(take-it-out-for-a-test-walk + (flet ((foo (x) (foo x))) + (flet ((bar (x) (foo x))) + (bar 1)))) + +(take-it-out-for-a-test-walk (compiler-let ((a 1) (b 2)) (foo a) b)) +(take-it-out-for-a-test-walk (prog () (declare (special a b)))) +(take-it-out-for-a-test-walk (let (a b c) + (declare (special a b)) + (foo a) b c)) +(take-it-out-for-a-test-walk (let (a b c) + (declare (special a) (special b)) + (foo a) b c)) +(take-it-out-for-a-test-walk (let (a b c) + (declare (special a)) + (declare (special b)) + (foo a) b c)) +(take-it-out-for-a-test-walk (let (a b c) + (declare (special a)) + (declare (special b)) + (let ((a 1)) + (foo a) b c))) +(take-it-out-for-a-test-walk (eval-when () + a + (foo a))) +(take-it-out-for-a-test-walk (eval-when (eval when load) + a + (foo a))) + +(take-it-out-for-a-test-walk (multiple-value-bind (a b) (foo a b) (list a b))) +(take-it-out-for-a-test-walk (multiple-value-bind (a b) + (foo a b) + (declare (special a)) + (list a b))) +(take-it-out-for-a-test-walk (progn (function foo))) +(take-it-out-for-a-test-walk (progn a b (go a))) +(take-it-out-for-a-test-walk (if a b c)) +(take-it-out-for-a-test-walk (if a b)) +(take-it-out-for-a-test-walk ((lambda (a b) (list a b)) 1 2)) +(take-it-out-for-a-test-walk ((lambda (a b) (declare (special a)) (list a b)) + 1 2)) +(take-it-out-for-a-test-walk (let ((a a) (b a) (c b)) (list a b c))) +(take-it-out-for-a-test-walk (let* ((a a) (b a) (c b)) (list a b c))) +(take-it-out-for-a-test-walk (let ((a a) (b a) (c b)) + (declare (special a b)) + (list a b c))) +(take-it-out-for-a-test-walk (let* ((a a) (b a) (c b)) + (declare (special a b)) + (list a b c))) +(take-it-out-for-a-test-walk (let ((a 1) (b 2)) + (foo bar) + (declare (special a)) + (foo a b))) +(take-it-out-for-a-test-walk (multiple-value-call #'foo a b c)) +(take-it-out-for-a-test-walk (multiple-value-prog1 a b c)) +(take-it-out-for-a-test-walk (progn a b c)) +(take-it-out-for-a-test-walk (progv vars vals a b c)) +(take-it-out-for-a-test-walk (quote a)) +(take-it-out-for-a-test-walk (return-from block-name a b c)) +(take-it-out-for-a-test-walk (setq a 1)) +(take-it-out-for-a-test-walk (setq a (foo 1) b (bar 2) c 3)) +(take-it-out-for-a-test-walk (tagbody a b c (go a))) +(take-it-out-for-a-test-walk (the foo (foo-form a b c))) +(take-it-out-for-a-test-walk (throw tag-form a)) +(take-it-out-for-a-test-walk (unwind-protect (foo a b) d e f)) + +(defmacro flet-1 (a b) ''outer) +(defmacro labels-1 (a b) ''outer) + +(take-it-out-for-a-test-walk + (flet ((flet-1 (a b) () (flet-1 a b) (list a b))) + (flet-1 1 2) + (foo 1 2))) +(take-it-out-for-a-test-walk + (labels ((label-1 (a b) () (label-1 a b)(list a b))) + (label-1 1 2) + (foo 1 2))) +(take-it-out-for-a-test-walk (macrolet ((macrolet-1 (a b) (list a b))) + (macrolet-1 a b) + (foo 1 2))) + +(take-it-out-for-a-test-walk (macrolet ((foo (a) `(inner-foo-expanded ,a))) + (foo 1))) + +(take-it-out-for-a-test-walk (progn (bar 1) + (macrolet ((bar (a) + `(inner-bar-expanded ,a))) + (bar 2)))) + +(take-it-out-for-a-test-walk (progn (bar 1) + (macrolet ((bar (s) + (bar s) + `(inner-bar-expanded ,s))) + (bar 2)))) + +(take-it-out-for-a-test-walk (cond (a b) + ((foo bar) a (foo a)))) + + +(let ((the-lexical-variables ())) + (walk-form '(let ((a 1) (b 2)) + #'(lambda (x) (list a b x y))) + () + #'(lambda (form context env) + (when (and (symbolp form) + (variable-lexical-p form env)) + (push form the-lexical-variables)) + form)) + (or (and (= (length the-lexical-variables) 3) + (member 'a the-lexical-variables) + (member 'b the-lexical-variables) + (member 'x the-lexical-variables)) + (error "Walker didn't do lexical variables of a closure properly."))) + +|# + +() + diff --git a/pcl/impl/cmu/README b/pcl/impl/cmu/README new file mode 100644 index 0000000..2402793 --- /dev/null +++ b/pcl/impl/cmu/README @@ -0,0 +1,17 @@ +To install, + +put this version of PCL in cmucl's source directory, and name it pcl. +rename the cmucl file tools/pclcom.lisp to tools/pclcom.lisp.original +link the file impl/cmu/pclcom.lisp to cmucl/tools/pclcom.lisp +link the file impl/cmu/pclload.lisp to pclload.lisp + +For example, + +cd cmucl17f +mv pcl pcl.original +<> +cd tools +mv pclcom.lisp pclcom.lisp.original +ln -s ../pcl/impl/cmu/pclcom.lisp pclcom.lisp +cd ../pcl +ln -s impl/cmu/pclload.lisp pclload.lisp diff --git a/pcl/impl/cmu/cmu-low.lisp b/pcl/impl/cmu/cmu-low.lisp new file mode 100644 index 0000000..459c445 --- /dev/null +++ b/pcl/impl/cmu/cmu-low.lisp @@ -0,0 +1,217 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the CMU Lisp version of the file low. +;;; + +(in-package :pcl) + +#+small +(setq *optimize-speed* + '(optimize (speed 3) (safety 0) (debug 0.5) (ext:inhibit-warnings 3))) + +(defmacro dotimes ((var count &optional (result nil)) &body body) + `(lisp:dotimes (,var (the fixnum ,count) ,result) + (declare (fixnum ,var)) + ,@body)) + +;;; Just use our without-interrupts. We don't have the INTERRUPTS-ON/OFF local +;;; macros spec'ed in low.lisp, but they aren't used. +;;; +(defmacro without-interrupts (&rest stuff) + `(sys:without-interrupts ,@stuff)) + +(defun function-arglist (fcn) + "Returns the argument list of a compiled function, if possible." + (cond ((symbolp fcn) + (when (fboundp fcn) + (function-arglist (symbol-function fcn)))) + ((eval:interpreted-function-p fcn) + (eval:interpreted-function-arglist fcn)) + ((functionp fcn) + (let ((lambda-expr (function-lambda-expression fcn))) + (if lambda-expr + (cadr lambda-expr) + (let ((function (kernel:%closure-function fcn))) + (values (read-from-string + (kernel:%function-arglist function))))))))) + + +;;; And returns the function, not the *name*. +(defun set-function-name (fcn new-name) + "Set the name of a compiled function object." + (declare (special *boot-state* *the-class-standard-generic-function*)) + (cond ((symbolp fcn) + (set-function-name (symbol-function fcn) new-name)) + ((funcallable-instance-p fcn) + (if (if (eq *boot-state* 'complete) + (typep fcn 'generic-function) + (eq (class-of fcn) *the-class-standard-generic-function*)) + (setf (kernel:%funcallable-instance-info fcn 1) new-name) + (typecase fcn + (kernel:byte-closure + (set-function-name (kernel:byte-closure-function fcn) new-name)) + (kernel:byte-function + (setf (kernel:byte-function-name fcn) new-name)))) + fcn) + ((eval:interpreted-function-p fcn) + (setf (eval:interpreted-function-name fcn) new-name) + fcn) + (t + (let ((header (kernel:%closure-function fcn))) + #+cmu17 + (setf (c::%function-name header) new-name) + #-cmu17 + (system:%primitive c::set-function-name header new-name)) + fcn))) + +(in-package "C") + +(def-source-context pcl:defmethod (name &rest stuff) + (let ((arg-pos (position-if #'listp stuff))) + (if arg-pos + `(pcl:defmethod ,name ,@(subseq stuff 0 arg-pos) + ,(nth-value 2 (pcl::parse-specialized-lambda-list + (elt stuff arg-pos)))) + `(pcl:defmethod ,name "")))) + + +(in-package "PCL") + +;;;; STD-INSTANCE + +;;; Under CMU17 conditional, STD-INSTANCE-P is only used to discriminate +;;; between functions (including FINs) and normal instances, so we can return +;;; true on structures also. A few uses of (or std-instance-p fsc-instance-p) +;;; are changed to pcl-instance-p. +;;; +(defmacro std-instance-p (x) + `(kernel:%instancep ,x)) +(defmacro pcl-instance-p (x) + `(typep (kernel:layout-of ,x) 'wrapper)) + + +;;; We define this as STANDARD-INSTANCE, since we're going to clobber the +;;; layout with some standard-instance layout as soon as we make it, and we +;;; want the accesor to still be type-correct. +;;; +(defstruct (standard-instance + (:predicate nil) + (:constructor %%allocate-instance--class--fn ()) + (:alternate-metaclass kernel:instance lisp:standard-class + kernel:make-standard-class)) + (slots nil)) + +;;; Must immediately setf the std-instance-wrapper after calling this. +(defmacro %%allocate-instance--class () + `(ext:truly-the standard-instance (kernel:%make-instance 2))) + +;;; Both of these operations "work" on structures, which allows the above +;;; weakening of std-instance-p. +;;; +(defmacro std-instance-slots (x) `(kernel:%instance-ref ,x 1)) +(defmacro std-instance-wrapper (x) `(kernel:%instance-layout ,x)) + +(defmacro built-in-or-structure-wrapper (x) `(kernel:layout-of ,x)) + +(defmacro get-wrapper (inst) + (ext:once-only ((wrapper `(wrapper-of ,inst))) + `(progn + (assert (typep ,wrapper 'wrapper) () "What kind of instance is this?") + ,wrapper))) + +(defmacro get-instance-wrapper-or-nil (inst) + (ext:once-only ((wrapper `(wrapper-of ,inst))) + `(if (typep ,wrapper 'wrapper) + ,wrapper + nil))) + +;;; get-slots harmless + +(defmacro get-slots-or-nil (inst) + (ext:once-only ((n-inst inst)) + `(when (pcl-instance-p ,n-inst) + (if (std-instance-p ,n-inst) + (std-instance-slots ,n-inst) + (fsc-instance-slots ,n-inst))))) + + +;;;; Structure-instance stuff: + +(pushnew :structure-wrapper *features*) + +(defun structure-functions-exist-p () + t) + +(defun structure-instance-p (x) + (typep x 'lisp:structure-object)) + +(defun structurep (x) + (typep x 'lisp:structure-object)) + +(defun structure-type (x) + (lisp:class-name (kernel:layout-class (kernel:%instance-layout x)))) + + +(defun structure-type-p (type) + (and (symbolp type) + (let ((class (lisp:find-class type nil))) + (and class + (typep (kernel:layout-info (kernel:class-layout class)) + 'kernel:defstruct-description))))) + +(defun get-structure-dd (type) + (kernel:layout-info (kernel:class-layout (lisp:find-class type)))) + +(defun structure-type-included-type-name (type) + (let ((include (kernel::dd-include (get-structure-dd type)))) + (if (consp include) + (car include) + include))) + +(defun structure-type-slot-description-list (type) + (nthcdr (length (let ((include (structure-type-included-type-name type))) + (and include (kernel:dd-slots (get-structure-dd include))))) + (kernel:dd-slots (get-structure-dd type)))) + +(defun structure-slotd-name (slotd) + (kernel:dsd-name slotd)) + +(defun structure-slotd-accessor-symbol (slotd) + (kernel:dsd-accessor slotd)) + +(defun structure-slotd-reader-function (slotd) + (fdefinition (kernel:dsd-accessor slotd))) + +(defun structure-slotd-writer-function (slotd) + (unless (kernel:dsd-read-only slotd) + (fdefinition `(setf ,(kernel:dsd-accessor slotd))))) + +(defun structure-slotd-type (slotd) + (kernel:dsd-type slotd)) + +(defun structure-slotd-init-form (slotd) + (kernel::dsd-default slotd)) diff --git a/pcl/impl/cmu/pclcom.lisp b/pcl/impl/cmu/pclcom.lisp new file mode 100644 index 0000000..6be7d94 --- /dev/null +++ b/pcl/impl/cmu/pclcom.lisp @@ -0,0 +1,66 @@ +;; This is "target:tools/pclcom.lisp" + +(in-package "USER") + +(when (find-package "PCL") + (setf (compiler-macro-function 'make-instance) nil) + ;; + ;; Undefine all generic functions exported from Lisp so that bootstrapping + ;; doesn't get confused. + (let ((class (find-class 'generic-function nil))) + (when class + (do-external-symbols (sym "LISP") + (when (and (fboundp sym) + (typep (fdefinition sym) class)) + (fmakunbound sym)) + (let ((ssym `(setf ,sym))) + (when (and (fboundp ssym) + (typep (fdefinition ssym) class)) + (fmakunbound ssym)))))) + + ;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots. + (let ((wot (find-symbol "*FIND-CLASS*" "PCL"))) + (when (and wot (boundp wot)) + (do-hash (name ignore (symbol-value wot)) + (declare (ignore ignore)) + (let ((class (find-class name nil))) + (cond ((not class)) + ((typep class 'kernel::std-class) + (setf (kernel:class-cell-class + (kernel:find-class-cell name)) + nil) + (setf (info type kind name) nil)) + (t + (setf (kernel:class-pcl-class class) nil))))))) + + (rename-package "PCL" "OLD-PCL") + (make-package "PCL")) + +(when (find-package "SLOT-ACCESSOR-NAME") + (rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME")) + +(setf c:*suppress-values-declaration* t) +(pushnew :setf *features*) + +(setf (search-list "pcl:") '("target:pcl/")) + +(let ((obj (make-pathname :defaults "pcl:defsys" + :type (c:backend-fasl-file-type c:*backend*)))) + (when (< (or (file-write-date obj) 0) + (file-write-date "pcl:defsys.lisp")) + (compile-file "pcl:defsys" :byte-compile t))) + +(load "pcl:defsys" :verbose t) + +(import 'kernel:funcallable-instance-p (find-package "PCL")) + +(with-compilation-unit + (:optimize '(optimize (debug #+small .5 #-small 2) + (speed 2) (safety #+small 0 #-small 2) + (inhibit-warnings 2)) + :optimize-interface '(optimize-interface #+small (safety 1)) + :context-declarations + '((:external (declare (optimize-interface (safety 2) (debug 1)))) + ((:or :macro (:match "$EARLY-") (:match "$BOOT-")) + (declare (optimize (speed 0)))))) + (pcl::compile-pcl)) diff --git a/pcl/impl/cmu/pclload.lisp b/pcl/impl/cmu/pclload.lisp new file mode 100644 index 0000000..39fb098 --- /dev/null +++ b/pcl/impl/cmu/pclload.lisp @@ -0,0 +1,12 @@ +(in-package "PCL") +(unless (find-package "SLOT-ACCESSOR-NAME") + (make-package "SLOT-ACCESSOR-NAME")) +(rename-package "PCL" "PCL" '("OLD-PCL")) +(rename-package "SLOT-ACCESSOR-NAME" "SLOT-ACCESSOR-NAME" + '("OLD-SLOT-ACCESSOR-NAME")) +(import 'kernel:funcallable-instance-p) +(load "target:pcl/defsys") +(load-pcl) +(rename-package "PCL" "PCL" '()) +(rename-package "SLOT-ACCESSOR-NAME" "SLOT-ACCESSOR-NAME" '()) + diff --git a/pcl/impl/coral/coral-low.lisp b/pcl/impl/coral/coral-low.lisp new file mode 100644 index 0000000..650dd75 --- /dev/null +++ b/pcl/impl/coral/coral-low.lisp @@ -0,0 +1,63 @@ +;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +#-:ccl-1.3 +(ccl::add-transform 'std-instance-p + :inline + #'(lambda (call) + (ccl::verify-arg-count call 1 1) + (let ((arg (cadr call))) + `(and (eq (ccl::%type-of ,arg) 'structure) + (eq (%svref ,arg 0) 'std-instance))))) + +(eval-when (eval compile load) + (proclaim '(inline std-instance-p))) + +(defun printing-random-thing-internal (thing stream) + (prin1 (ccl::%ptr-to-int thing) stream)) + +(defun set-function-name-1 (function new-name uninterned-name) + (declare (ignore uninterned-name)) + (cond ((ccl::lfunp function) + (ccl::lfun-name function new-name))) + function) + + +(defun doctor-dfun-for-the-debugger (gf dfun) + #+:ccl-1.3 + (let* ((gfspec (and (symbolp (generic-function-name gf)) + (generic-function-name gf))) + (arglist (generic-function-pretty-arglist gf))) + (when gfspec + (setf (get gfspec 'ccl::%lambda-list) + (if (and arglist (listp arglist)) + (format nil "~{~A~^ ~}" arglist) + (format nil "~:A" arglist))))) + dfun) + diff --git a/pcl/impl/franz/cpatch.lisp b/pcl/impl/franz/cpatch.lisp new file mode 100644 index 0000000..23641de --- /dev/null +++ b/pcl/impl/franz/cpatch.lisp @@ -0,0 +1,32 @@ +;; -[Thu Feb 22 08:38:07 1990 by jkf]- +;; cpatch.cl +;; compiler patch for the fast clos +;; +;; copyright (c) 1990 Franz Inc. +;; + +(in-package :comp) + +(def-quad-op tail-funcall qp-end-block + ;; u = (argcount function-object) + ;; + ;; does a tail call to the function-object given + ;; never returns + ) + +(defun-in-runtime sys::copy-function (func)) + +(in-package :hyperion) + +(def-quad-hyp r-tail-funcall comp::tail-funcall (u d quad) + ;; u = (argcount function) + ;; + (r-move-single-to-loc (treg-loc (car u)) *count-reg*) + (r-move-single-to-loc (treg-loc (cadr u)) *fcnin-reg*) + (re restore *zero-reg* *zero-reg*) + (re move.l `(d #.r-function-start-adj #.*fcnout-reg*) '#.*ctr2-reg*) + (re jmpl '(d 0 #.*ctr2-reg*) *zero-reg*) + (re nop)) + + + diff --git a/pcl/impl/franz/excl-low.lisp b/pcl/impl/franz/excl-low.lisp new file mode 100644 index 0000000..54c734b --- /dev/null +++ b/pcl/impl/franz/excl-low.lisp @@ -0,0 +1,136 @@ +;;; -*- Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the EXCL (Franz) lisp version of the file portable-low. +;;; +;;; This is for version 1.1.2. Many of the special symbols now in the lisp +;;; package (e.g. lisp::pointer-to-fixnum) will be in some other package in +;;; a later release so this will need to be changed. +;;; + +(in-package 'pcl) + +(defmacro without-interrupts (&body body) + `(let ((outer-interrupts excl::*without-interrupts*) + (excl::*without-interrupts* 0)) + (macrolet ((interrupts-on () + '(unless outer-interrupts + (setq excl::*without-interrupts* nil))) + (interrupts-off () + '(setq excl::*without-interrupts* 0))) + ,.body))) + +(eval-when (compile load eval) + (unless (fboundp 'excl::sy_hash) + (setf (symbol-function 'excl::sy_hash) + (symbol-function 'excl::_sy_hash-value))) + ) + +(defmacro memq (item list) + (let ((list-var (gensym)) + (item-var (gensym))) + `(prog ((,list-var ,list) + (,item-var ,item)) + start + (cond ((null ,list-var) + (return nil)) + ((eq (car ,list-var) ,item-var) + (return ,list-var)) + (t + (pop ,list-var) + (go start)))))) + +(defun std-instance-p (x) + (and (excl::structurep x) + (locally + (declare #.*optimize-speed*) + (eq (svref x 0) 'std-instance)))) + +(excl::defcmacro std-instance-p (x) + (once-only (x) + `(and (excl::structurep ,x) + (locally + (declare #.*optimize-speed*) + (eq (svref ,x 0) 'std-instance))))) + +(excl::defcmacro fast-method-call-p (x) + (once-only (x) + `(and (excl::structurep ,x) + (locally + (declare #.*optimize-speed*) + (eq (svref ,x 0) 'fast-method-call))))) + +(defmacro %std-instance-wrapper (x) + `(svref ,x 1)) + +(defmacro %std-instance-slots (x) + `(svref ,x 2)) + +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (excl::pointer-to-fixnum thing))) + +#-vax +(defun set-function-name-1 (fn new-name ignore) + (declare (ignore ignore)) + (cond ((excl::function-object-p fn) + (setf (excl::fn_symdef fn) new-name)) + (t nil)) + fn) + +(defun function-arglist (f) + (excl::arglist f)) + +(defun symbol-append (sym1 sym2 &optional (package *package*)) + ;; This is a version of symbol-append from macros.cl + ;; It insures that all created symbols are of one case and that + ;; case is the current prefered case. + ;; This special version of symbol-append is not necessary if all you + ;; want to do is compile and run pcl in a case-insensitive-upper + ;; version of cl. + ;; + (let ((string (string-append sym1 sym2))) + (case excl::*current-case-mode* + ((:case-insensitive-lower :case-sensitive-lower) + (setq string (string-downcase string))) + ((:case-insensitive-upper :case-sensitive-upper) + (setq string (string-upcase string)))) + (intern string package))) + +;;; Define inspector hooks for PCL object instances. + +(defun (:property pcl::std-instance :inspector-function) (object) + (let ((class (class-of object))) + (cons (inspect::make-field-def "class" #'class-of :lisp) + (mapcar #'(lambda (slot) + (inspect::make-field-def + (string (slot-definition-name slot)) + #'(lambda (x) + (slot-value-using-class class x slot)) + :lisp)) + (slots-to-inspect class object))))) + +(defun (:property pcl::std-instance :inspector-type-function) (x) + (class-name (class-of x))) diff --git a/pcl/impl/franz/quadlap.lisp b/pcl/impl/franz/quadlap.lisp new file mode 100644 index 0000000..3d7507e --- /dev/null +++ b/pcl/impl/franz/quadlap.lisp @@ -0,0 +1,619 @@ +;; -[Thu Mar 1 10:54:27 1990 by jkf]- +;; pcl to quad translation +;; $Header$ +;; +;; copyright (c) 1990 Franz Inc. +;; +(in-package :compiler) + + + + +(defvar *arg-to-treg* nil) +(defvar *cvar-to-index* nil) +(defvar *reg-array* nil) +(defvar *closure-treg* nil) +(defvar *nargs-treg* nil) + +(defvar *debug-sparc* nil) + +(defmacro pcl-make-lambda (&key required) + `(list 'lambda nil :unknown-type 0 compiler::.function-level. + ,required nil nil nil nil nil nil nil nil nil + nil 'compiler::none nil nil nil + nil nil nil nil nil nil 0 nil)) + +(defmacro pcl-make-varrec (&key name loc contour-level) + `(list ,name nil 0 nil ,loc nil t compiler::.function-level. nil nil :unknown-type nil nil ,contour-level)) + +(defmacro pcl-make-lap (&key lap constants cframe-size locals) + `(list nil ,constants ,lap nil nil ,cframe-size ,locals nil nil nil)) + + +(defstruct preg + ;; pseudo reg descritpor + treg ; associated treg + index ; :index if this is an index type reg + ; :vector if this is a vector type reg + ) + + +(defun pcl::excl-lap-closure-generator (closure-vars-names + arg-names + index-regs + vector-regs + fixnum-vector-regs + t-regs + lap-code) + (let ((function (pcl::excl-lap-closure-gen closure-vars-names + arg-names + index-regs + (append vector-regs fixnum-vector-regs) + t-regs + lap-code))) + #'(lambda (&rest closure-vals) + (insert-closure-vals function closure-vals)))) + + +(defun pcl::excl-lap-closure-gen + (closure-vars-names arg-names index-regs vector-regs t-regs lap-code) + (let ((*quads* nil) + (*treg-num* 0) + (*all-tregs* nil) + (*bb-count* 0) + *treg-bv-size* + *treg-vector* + (*next-catch-frame* 0) + (*max-catch-frame* -1) + *catch-labels* + *top-label* + *mv-treg* + *mv-treg-target* + *zero-treg* + *nil-treg* + *bbs* *bb* lap + ;; bbs + *cross-block-regs* + *const-tregs* *move-tregs* + *actuals* + *ignore-argcount* + *binds-specs* + *bvl-current-bv* ; for bitvector cacher + *bvl-used-bvs* + *bvl-index* + (*inhibit-call-count* t) + + ; this fcn + *arg-to-treg* + *cvar-to-index* + *reg-array* + minargs + maxargs + *closure-treg* + + node + otherargregs + + *nargs-treg* + ) + + (if* *debug-sparc* + then (format t ">>** << Generating sparc lap code~%")) + + (setq *nil-treg* + #+allegro-v4.0 (new-reg :global t) + #-allegro-v4.0 (new-reg) + *mv-treg* (new-reg) + *mv-treg-target* (list *mv-treg*) + *zero-treg* (comp::new-reg)) + + ; examine given args + + (setq minargs 0 maxargs 0) + (let (requireds) + (dolist (arg arg-names) + (if* (eq '&rest arg) + then (setq maxargs nil) + else (if* (null arg) + then ; we want a name even though we won't use it + (setq arg (gensym))) + (incf minargs) + (incf maxargs) + (push (cons arg (new-reg)) *arg-to-treg*) + (push (pcl-make-varrec :name arg + :loc (cdr (car *arg-to-treg*)) + :contour-level 0) + requireds) + )) + (setq node (pcl-make-lambda :required (nreverse requireds)))) + (setq *arg-to-treg* (nreverse *arg-to-treg*)) + + ; build closure vector list + (let ((index -1)) + (dolist (cvar closure-vars-names) + (push (cons cvar (incf index)) *cvar-to-index*))) + + (let ((maxreg (max (apply #'max (cons -1 index-regs)) + (apply #'max (cons -1 vector-regs)) + (apply #'max (cons -1 t-regs))))) + (setq *reg-array* (make-array (1+ maxreg)))) + + (dolist (index index-regs) + (setf (svref *reg-array* index) + (make-preg :treg (new-reg) + :index :index))) + + (dolist (vector vector-regs) + (setf (svref *reg-array* vector) + (make-preg :treg (new-reg) + :index :vector))) + + (dolist (tr t-regs) + (setf (svref *reg-array* tr) (make-preg :treg (new-reg)))) + + + (if* closure-vars-names + then (setq *closure-treg* (new-reg))) + (setq *nargs-treg* (new-reg)) + + ;; (md-allocate-global-tregs) + + ; function entry + (qe nop :arg :first-block) + (qe entry) + (qe argcount :arg (list minargs maxargs)) + (qe lambda :d (mapcar #'cdr *arg-to-treg*)) + (qe register :arg :nargs :d (list *nargs-treg*)) + + (if* *closure-treg* + then ; put the first closure vector in *closure-treg* + (qe extract-closure-vec :d (list *closure-treg*)) + (let ((offsetreg (new-reg))) + (qe const :arg (mdparam 'md-cons-car-adj) :d (list offsetreg)) + (qe ref :u (list *closure-treg* offsetreg) + :d (list *closure-treg*) + :arg :long)) + ) + + (excl-gen-quads lap-code) + + (if* *debug-sparc* + then (do-quad-list (quad next *quads*) + (format t "~a~%" quad)) + + (format t "basic blocks~%")) + + (setq *bbs* (qc-compute-basic-blocks *quads*)) + + (excl::target-class-case + ((:r :m) (setq *actuals* (qc-compute-actuals *bbs*)))) + + (qc-live-variable-analysis *bbs*) + + (setq *treg-bv-size* (* 16 (truncate (+ *treg-num* 15) 16))) + + (qc-build-treg-vector) + + + (let ((*dump-bbs* nil) + (r::*local-regs* + ; use the in registers that aren't in use + (append r::*local-regs* + (if* maxargs + then (nthcdr maxargs r::*in-regs* ))))) + (unwind-protect + (progn + ; machine specific code generation + (multiple-value-bind (lap-code literals size-struct locals) + #+(target-class r m e) + (progn + #+allegro-v4.0 + (md-codegen node *bbs* + nil otherargregs) + #-allegro-v4.0 + (md-codegen node *bbs* + *nil-treg* *mv-treg* *zero-treg* + nil otherargregs)) + + #-(target-class r m e) (md-codegen node *bbs*) + (setq lap + (pcl-make-lap :lap lap-code + :constants literals + :cframe-size size-struct + :locals locals))) + + + lap) + (giveback-bvs))) + + #+ignore + (progn (format t "sparc code pre optimization~%") + (dolist (instr (lap-lap lap)) + (format t "> ~a~%" instr))) + (md-optimize lap) ; peephole optimize + (if* *debug-sparc* + then (format t "sparc code post optimization~%") + (dolist (instr (lap-lap lap)) + (format t "> ~a~%" instr))) + (md-assemble lap) + (setq last-lap lap) + + (nl-runtime-make-a-fcnobj lap))) + +(defun qe-slot-access (operand offset dest) + ;; access a slot in a structure + (let ((temp (new-reg))) + (qe const :arg offset :d (list temp)) + (qe ref :u (list (get-treg-of operand) temp) + :d (list (get-treg-of dest)) + :arg :long))) + + +(defun get-treg-of (operand &optional res-operand) + ;; get the appropriate treg for the operand + (let ((prefer-treg (and res-operand (simple-get-treg-of res-operand)))) + (if* (numberp operand) + then (let ((treg (new-reg))) + (qe const :arg operand :d (list treg)) + treg) + elseif (consp operand) + then (ecase (car operand) + (:reg + (preg-treg (svref *reg-array* (cadr operand)))) + (:arg + (let ((x (cdr (assoc (cadr operand) *arg-to-treg* :test #'eq)))) + (if* (null x) + then (error "where is arg ~s" operand) + else x))) + (:cvar + (let ((res-treg (or prefer-treg (new-reg))) + (temp-treg (new-reg))) + (qe const :arg (+ (mdparam 'md-svector-data0-adj) + (* 4 (cdr (assoc (cadr operand) + *cvar-to-index* + :test #'eq)))) + :d (list temp-treg)) + (qe ref :u (list *closure-treg* temp-treg) + :d (list res-treg) + :arg :long) + res-treg)) + (:constant + (let ((treg (or prefer-treg (new-reg)))) + (qe const :arg (if* (fixnump (cadr operand)) + then (* 8 (cadr operand)) ; md!! + else (cadr operand)) + :d (list treg)) + treg)) + (:index-constant + ; operand invented by jkf to denote an index type constant + (let ((treg (or prefer-treg (new-reg)))) + (qe const :arg (if* (fixnump (cadr operand)) + then (* 4 (cadr operand)) ; md!! + else (cadr operand)) + :d (list treg)) + treg))) + else (error "bad operand: ~s" operand)))) + +(defun simple-get-treg-of (operand) + ;; get the treg if it is so simple that we don't have to + ;; emit any instructions to access it. + ;; return nil if we can't do it. + (if* (numberp operand) + then nil + elseif (consp operand) + then (case (car operand) + (:reg + (preg-treg (svref *reg-array* (cadr operand)))) + (:arg + (let ((x (cdr (assoc (cadr operand) *arg-to-treg* :test #'eq)))) + (if* (null x) + then nil + else x)))) + + else nil)) + +(defun index-p (operand) + ;; determine if the result of this operand is an index value + ;* it would be better if conversion between lisp values and + ; index values were made explicit in the lap code + (and (consp operand) + (or (and (eq :reg (car operand)) + (eq :index (preg-index (svref *reg-array* (cadr operand))))) + (member (car operand) + '(:i+ :i- :ilogand :ilogxor :i1+) + :test #'eq)) + t)) + +(defun gen-index-treg (operand) + ;; return the non-index type operand in a index treg + (if* (and (consp operand) + (eq ':constant (car operand))) + then (get-treg-of `(:index-constant ,(cadr operand))) + else (let ((treg (get-treg-of operand)) + (new-reg (new-reg)) + (shift-reg (new-reg))) + (qe const :arg 1 :d (list shift-reg)) + (qe lsr :u (list treg shift-reg) :d (list new-reg)) + new-reg))) + + + + + +(defun vector-preg-p (operand) + (and (consp operand) + (eq :reg (car operand)) + (eq :vector (preg-index (svref *reg-array* (cadr operand)))))) + + + +(defun excl-gen-quads (laps) + ;; generate quads from the lap + (dolist (lap laps) + (if* *debug-sparc* then (format t ">> ~a~%" lap)) + (block again + (let ((opcode (car lap)) + (op1 (cadr lap)) + (op2 (caddr lap))) + (case opcode + (:move + ; can be either simple (both args registers) + ; or one arg can be complex and the other simple + (case (car op2) + ((:iref :instance-ref) + ;; assume that this is a lisp store + ;;(warn "assuming lisp store in ~s" lap) + (let (op1-treg) + (if* (not (vector-preg-p (cadr op2))) + then ; must offset before store + (error "must use vector register in ~s" lap) + else (setq op1-treg (get-treg-of (cadr op2)))) + + + + (qe set :u (list op1-treg + (get-treg-of (caddr op2)) + (get-treg-of op1)) + :arg :lisp) + (return-from again))) + (:cdr + ;; it certainly is a lisp stoer + (let (op1-treg const-reg) + (setq op1-treg (get-treg-of (cadr op2))) + (setq const-reg (new-reg)) + (qe const :arg (mdparam 'md-cons-cdr-adj) + :d (list const-reg)) + + + + (qe set :u (list op1-treg + const-reg + (get-treg-of op1)) + :arg :lisp) + (return-from again)))) + + ; the 'to'address is simple, the from address may not be + + (let ((index1 (index-p op1)) + (index2 (index-p op2)) + (vector1 (vector-preg-p op1)) + (vector2 (vector-preg-p op2))) + (ecase (car op1) + ((:reg :cvar :arg :constant :lisp-symbol) + (qe move + :u (list (get-treg-of op1 op2)) + :d (list (get-treg-of op2)))) + (:std-wrapper + (qe-slot-access (cadr op1) + (+ (* 1 4) + (comp::mdparam 'md-svector-data0-adj)) + op2)) + (:std-slots + (qe-slot-access (cadr op1) + (+ (* 2 4) + (comp::mdparam 'md-svector-data0-adj)) + op2)) + (:fsc-wrapper + (qe-slot-access (cadr op1) + (+ (* (- 15 1) 4) + (comp::mdparam 'md-function-const0-adj)) + op2)) + (:fsc-slots + (qe-slot-access (cadr op1) + (+ (* (- 15 2) 4) + (comp::mdparam 'md-function-const0-adj)) + op2)) + ((:built-in-wrapper :structure-wrapper :built-in-or-structure-wrapper) + (qe call :arg 'pcl::built-in-or-structure-wrapper + :u (list (get-treg-of (cadr op1))) + :d (list (get-treg-of op2)))) + (:other-wrapper + (warn "do other-wrapper")) + ((:i+ :i- :ilogand :ilogxor) + (qe arith :arg (cdr (assoc (car op1) + '((:i+ . :+) + (:i- . :-) + (:ilogand . :logand) + (:ilogxor . :logxor)) + :test #'eq)) + :u (list (get-treg-of (cadr op1)) + (get-treg-of (caddr op1))) + :d (list (get-treg-of op2)))) + (:i1+ + (let ((const-reg (new-reg))) + (qe const :arg 4 ; an index value of 1 + :d (list const-reg)) + (qe arith :arg :+ + :u (list const-reg + (get-treg-of (cadr op1))) + :d (list (get-treg-of op2))))) + + ((:iref :cref :instance-ref) + (let (op1-treg) + (if* (not (vector-preg-p (cadr op1))) + then ; must offset before store + (error "must use vector register in ~s" lap) + else (setq op1-treg (get-treg-of (cadr op1)))) + + (qe ref :u (list op1-treg + (get-treg-of (caddr op1) op2)) + :d (list (get-treg-of op2)) + :arg :long))) + (:cdr + (let ((const-reg (new-reg))) + (qe const :arg (mdparam 'md-cons-cdr-adj) + :d (list const-reg)) + (qe ref :arg :long + :u (list (get-treg-of (cadr op1)) + const-reg) + :d (list (get-treg-of op2)))))) + (if* (not (eq index1 index2)) + then (let ((shiftamt (new-reg))) + (qe const :arg 1 :d (list shiftamt)) + (if* (and index1 (not index2)) + then ; converting from index to non-index + (qe lsl :u (list (get-treg-of op2) shiftamt) + :d (list (get-treg-of op2))) + elseif (and (not index1) index2) + ; converting to an index + then (qe lsr :u (list (get-treg-of op2) shiftamt) + :d (list (get-treg-of op2))))) + elseif (and vector2 (not vector1)) + then ; add vector offset + (let ((tempreg (new-reg)) + (vreg (get-treg-of op2))) + (qe const :arg (mdparam 'md-svector-data0-adj) + :d (list tempreg)) + (qe arith :arg :+ :u (list vreg tempreg) + :d (list vreg)))))) + (:fix= + (let (tr1 tr2) + (if* (index-p op1) + then (setq tr1 (get-treg-of op1)) + (if* (not (index-p op2)) + then (setq tr2 (gen-index-treg op2)) + else (setq tr2 (get-treg-of op2))) + elseif (index-p op2) + then ; assert: op1 isn't an index treg + (setq tr1 (gen-index-treg op1)) + (setq tr2 (get-treg-of op2)) + else (setq tr1 (get-treg-of op1) + tr2 (get-treg-of op2))) + + + + (qe bcc :u (list tr1 tr2) + :arg (cadddr lap) + :arg2 :eq ))) + ((:eq :neq :fix=) + (if* (not (eq (index-p op1) (index-p op2))) + then (error "non matching operands indexwise in: ~s" lap)) + (qe bcc :u (list (get-treg-of op1) + (get-treg-of op2)) + :arg (cadddr lap) + :arg2 (cdr (assoc opcode '((:eq . :eq) + (:neq . :ne)) + :test #'eq)))) + (:izerop + (qe bcc :u (list (get-treg-of op1) + *zero-treg*) + :arg (caddr lap) + :arg2 :eq)) + (:std-instance-p + (let ((treg (get-treg-of op1)) + (tempreg (new-reg)) + (temp2reg (new-reg)) + (offsetreg (new-reg)) + (nope (pc-genlab))) + (qe typecheck :u (list treg) + :arg nope + :arg2 '(not structure)) + (qe const :arg 'pcl::std-instance :d (list tempreg)) + (qe const :arg (mdparam 'md-svector-data0-adj) + :d (list offsetreg)) + (qe ref :u (list treg offsetreg) + :d (list temp2reg) + :arg :long) + (qe bcc :arg2 :eq :u (list tempreg temp2reg) + :arg (caddr lap)) + (qe label :arg nope))) + + (:fsc-instance-p + (let ((treg (get-treg-of op1)) + (nope (pc-genlab)) + (offsetreg (new-reg)) + (tempreg (new-reg)) + (checkreg (new-reg))) + (qe typecheck :u (list treg) + :arg nope + :arg2 '(not compiled-function)) + (qe const :arg (mdparam 'md-function-flags-adj) + :d (list offsetreg)) + (qe ref :u (list treg offsetreg) :d (list tempreg) + :arg :ubyte) + (qe const :arg pcl::funcallable-instance-flag-bit + :d (list checkreg)) + (qe bcc :u (list checkreg tempreg) + :arg (caddr lap) + :arg2 :bit-and) + (qe label :arg nope))) + (:built-in-instance-p + ; always true + (qe bra :arg (caddr lap))) + (:jmp + (qe tail-funcall :u (list *nargs-treg* (get-treg-of op1)))) + (:structure-instance-p + ; always true + (qe bra :arg (caddr lap))) + + (:return + (let (op-treg) + (if* (index-p op1) + then ; convert to lisp before returning + (let ((shiftamt (new-reg))) + (setq op-treg (new-reg)) + (qe const :arg 1 :d (list shiftamt)) + (qe lsl :u (list (get-treg-of op1) shiftamt) + :d (list op-treg))) + else (setq op-treg (get-treg-of op1))) + + (qe move :u (list op-treg) :d *mv-treg-target*) + (qe return :u *mv-treg-target*))) + + (:go + (qe bra :arg (cadr lap))) + + (:label + (qe label :arg (cadr lap))) + + + + (t (warn "ignoring ~s" lap))))))) + + +(defun insert-closure-vals (function closure-vals) + ;; build a fucntion from the lap and insert + (let ((newfun (sys::copy-function function))) + (setf (excl::fn_closure newfun) (list (apply 'vector closure-vals))) + newfun)) + + + +; test case: +; (pcl::defclass foo () (a b c)) +; (pcl::defmethod barx ((a foo) b c) a ) +; (apply 'pcl::excl-lap-closure-generator pcl::*tcase*) +; +; to turn it on + +(if* (not (and (boundp 'user::noquad) + (symbol-value 'user::noquad))) + then (setq pcl::*make-lap-closure-generator* + 'pcl::excl-lap-closure-generator)) + + + + + + + diff --git a/pcl/impl/gcl/README b/pcl/impl/gcl/README new file mode 100644 index 0000000..7948b33 --- /dev/null +++ b/pcl/impl/gcl/README @@ -0,0 +1,14 @@ +Includes changes for gcl version 2.0 by W. Schelter + + +To compile + +ln -s impl/gcl/makefile.gcl makefile.gcl +ln -s impl/gcl/sys-package.lisp sys-package.lisp +ln -s impl/gcl/sys-proclaim.lisp sys-proclaim.lisp +make -f makefile.gcl compile + +Then to make saved version + +make -f makefile.gcl saved_pcl + diff --git a/pcl/impl/gcl/gcl-low.lisp b/pcl/impl/gcl/gcl-low.lisp new file mode 100644 index 0000000..883b32c --- /dev/null +++ b/pcl/impl/gcl/gcl-low.lisp @@ -0,0 +1,316 @@ +(in-package "SI") +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name)) +(in-package 'pcl) +(eval-when (compile eval load) +(setq *EVAL-WHEN-COMPILE* t) +) + +(defmacro memq (item list) `(member ,item ,list :test #'eq)) +(defmacro assq (item list) `(assoc ,item ,list :test #'eq)) +(defmacro posq (item list) `(position ,item ,list :test #'eq)) + +(defmacro dotimes ((var form &optional (val nil)) &rest body &environment env) + (multiple-value-bind (doc decls bod) + (extract-declarations body env) + (declare (ignore doc)) + (let ((limit (gensym)) + (label (gensym))) + `(let ((,limit ,form) + (,var 0)) + (declare (fixnum ,limit ,var)) + ,@decls + (block nil + (tagbody + ,label + (when (>= ,var ,limit) (return-from nil ,val)) + ,@bod + (setq ,var (the fixnum (1+ ,var))) + (go ,label))))))) + +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (si:address thing))) + +(eval-when (compile load eval) +(pushnew :turbo-closure *features*) +(pushnew :turbo-closure-env-size *features*)) +) + +(defmacro %svref (vector index) + `(svref (the simple-vector ,vector) (the fixnum ,index))) + +(defsetf %svref (vector index) (new-value) + `(setf (svref (the simple-vector ,vector) (the fixnum ,index)) + ,new-value)) + +(si::freeze-defstruct 'pcl::std-instance) + +(si::freeze-defstruct 'method-call) +(si::freeze-defstruct 'fast-method-call) + +(defvar *pcl-funcall* `(lambda (loc) + (compiler::wt-nl + "{object _funobj = " loc ";" + "if(type_of(_funobj)==t_cclosure && (_funobj->cc.cc_turbo)) + (*(_funobj->cc.cc_self))(_funobj->cc.cc_turbo); + else if (type_of(_funobj)==t_cfun) (*(_funobj->cc.cc_self))(); + else super_funcall_no_event(_funobj);}"))) + +(setq compiler::*super-funcall* *pcl-funcall*) + +(defmacro fmc-funcall (fn pv-cell next-method-call &rest args) + `(funcall ,fn ,pv-cell ,next-method-call ,@args)) + +(defun pcl::proclaim-defmethod (x y) y + (and (symbolp x) + (setf (get x 'compiler::proclaimed-closure ) t))) + + + +;#+turbo-closure-env-size +(clines " +static +object cclosure_env_nthcdr (n,cc) +int n; object cc; +{ object env,*turbo; + if(n<0)return Cnil; + if(type_of(cc)!=t_cclosure)return Cnil; + if((turbo=cc->cc.cc_turbo)==NULL) + {env=cc->cc.cc_env; + while(n-->0) + {if(type_of(env)!=t_cons)return Cnil; + env=env->c.c_cdr;} + return env;} + else + {if(n>=fix(*(turbo-1)))return Cnil; + return turbo[n];} +}") + +(defentry cclosure-env-nthcdr (int object) (object cclosure_env_nthcdr)) +;; This is the unsafe but fast version. +(defentry %cclosure-env-nthcdr (int object) (object cclosure_env_nthcdr)) + +(eval-when (compile eval load) +(defparameter *gcl-function-inlines* + '( (%fboundp (t) compiler::boolean nil nil "(#0)->s.s_gfdef!=OBJNULL") + (%symbol-function (t) t nil nil "(#0)->s.s_gfdef") + (si:%structure-name (t) t nil nil "(#0)->str.str_def->str.str_self[0]") + (si:%compiled-function-name (t) t nil nil "(#0)->cf.cf_name") + (si:%set-compiled-function-name (t t) t t nil "((#0)->cf.cf_name)=(#1)") + (cclosurep (t) compiler::boolean nil nil "type_of(#0)==t_cclosure") + (sfun-p (t) compiler::boolean nil nil "type_of(#0)==t_sfun") + (%cclosure-env (t) t nil nil "(#0)->cc.cc_env") + (%set-cclosure-env (t t) t t nil "((#0)->cc.cc_env)=(#1)") + #+turbo-closure + (%cclosure-env-nthcdr (fixnum t) t nil nil "(#1)->cc.cc_turbo[#0]") + + (logxor (fixnum fixnum) fixnum nil nil "((#0) ^ (#1))"))) + +(defun make-function-inline (inline) + (setf (get (car inline) 'compiler::inline-always) + (list (if (fboundp 'compiler::flags) + (let ((opt (cdr inline))) + (list (first opt) (second opt) + (logior (if (fourth opt) 1 0) ; allocates-new-storage + (if (third opt) 2 0) ; side-effect + (if nil 4 0) ; constantp + (if (eq (car inline) 'logxor) + 8 0)) ;result type from args + (fifth opt))) + (cdr inline))))) +) + + +(defmacro define-inlines () + `(progn + ,@(mapcan #'(lambda (inline) + (let ((name (intern (format nil "~S inline" (car inline)))) + (vars (mapcar #'(lambda (type) + (declare (ignore type)) + (gensym)) + (cadr inline)))) + `((eval-when (compile eval load) + (make-function-inline + ',(cons name (cdr inline)))) + ,@(when (or (every #'(lambda (type) (eq type 't)) + (cadr inline)) + (char= #\% (aref (symbol-name (car inline)) 0))) + `((defun ,(car inline) ,vars + ,@(mapcan #'(lambda (var var-type) + (unless (eq var-type 't) + `((declare (type ,var-type ,var))))) + vars (cadr inline)) + (the ,(caddr inline) (,name ,@vars))) + (make-function-inline ',inline)))))) + *gcl-function-inlines*))) + +(define-inlines) + +(defsetf si:%compiled-function-name si:%set-compiled-function-name) +(defsetf %cclosure-env %set-cclosure-env) + +(defun set-function-name-1 (fn new-name ignore) + (declare (ignore ignore)) + (cond ((compiled-function-p fn) + (si::turbo-closure fn) + (when (symbolp new-name) (pcl::proclaim-defmethod new-name nil)) + (setf (si:%compiled-function-name fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda-block)) + (setf (cadr fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda)) + (setf (car fn) 'lambda-block + (cdr fn) (cons new-name (cdr fn))))) + fn) + + +(clines " + + + +object fSuse_fast_links(); +static +object set_cclosure (result_cc,value_cc,available_size) + object result_cc,value_cc; int available_size; +{ + object result_env_tail,value_env_tail; int i; + + /* If we are currently using fast linking, */ + /* make sure to remove the link for result_cc. */ + (VFUN_NARGS=2,fSuse_fast_links(sLnil,result_cc)); + +/* use_fast_links(3,Cnil,result_cc); */ + + result_env_tail=result_cc->cc.cc_env; + value_env_tail=value_cc->cc.cc_env; + for(i=available_size; + result_env_tail!=Cnil && i>0; + result_env_tail=CMPcdr(result_env_tail), value_env_tail=CMPcdr(value_env_tail)) + CMPcar(result_env_tail)=CMPcar(value_env_tail), i--; + result_cc->cc.cc_self=value_cc->cc.cc_self; + result_cc->cc.cc_data=value_cc->cc.cc_data; + + + return result_cc; +}") + +(defentry %set-cclosure (object object int) (object set_cclosure)) + + +(defun structure-functions-exist-p () + t) + +(si:define-compiler-macro structure-instance-p (x) + (once-only (x) + `(and (si:structurep ,x) + (not (eq (si:%structure-name ,x) 'std-instance))))) + +(defun structure-type (x) + (and (si:structurep x) + (si:%structure-name x))) + +(si:define-compiler-macro structure-type (x) + (once-only (x) + `(and (si:structurep ,x) + (si:%structure-name ,x)))) + +(defun structure-type-p (type) + (or (not (null (gethash type *structure-table*))) + (let (#+akcl(s-data nil)) + (and (symbolp type) + (setq s-data (get type 'si::s-data)) + + (null (si::s-data-type s-data) + ))))) + + +(defun structure-type-included-type-name (type) + (or (car (gethash type *structure-table*)) + (let ((includes (si::s-data-includes (get type 'si::s-data)))) + (when includes + (si::s-data-name includes))))) + +(defun structure-type-internal-slotds (type) + (si::s-data-slot-descriptions (get type 'si::s-data)) + ) + +(defun structure-type-slot-description-list (type) + (or (cdr (gethash type *structure-table*)) + (mapcan #'(lambda (slotd) + (when (and slotd (car slotd)) + (let ((offset (fifth slotd))) + (let ((reader #'(lambda (x) + (si:structure-ref1 x offset) + )) + (writer #'(lambda (v x) + (si:structure-set x type offset v)))) + #+turbo-closure (si:turbo-closure reader) + #+turbo-closure (si:turbo-closure writer) + (let* ((reader-sym + (let ((*package* *the-pcl-package*)) + (intern (format nil "~s SLOT~D" type offset)))) + (writer-sym (get-setf-function-name reader-sym)) + (slot-name (first slotd)) + (read-only-p (fourth slotd))) + (setf (symbol-function reader-sym) reader) + (setf (symbol-function writer-sym) writer) + (do-standard-defsetf-1 reader-sym) + (list (list slot-name + reader-sym + (and (not read-only-p) writer)))))))) + (let ((slotds (structure-type-internal-slotds type)) + (inc (structure-type-included-type-name type))) + (if inc + (nthcdr (length (structure-type-internal-slotds inc)) + slotds) + slotds))))) + +(defun structure-slotd-name (slotd) + (first slotd)) + +(defun structure-slotd-accessor-symbol (slotd) + (second slotd)) + +;(defun structure-slotd-writer-function (slotd) +; (third slotd)) + +(defun structure-slotd-reader-function (slotd) + (third slotd)) + +(defun structure-slotd-writer-function (slotd) + (fourth slotd)) + +(defun renew-sys-files() + ;; packages: + (compiler::get-packages "sys-package.lisp") + (with-open-file (st "sys-package.lisp" + :direction :output + :if-exists :append) + (format st "(lisp::in-package \"SI\") +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name)) +(in-package \"PCL\") +")) + + ;; proclaims + (compiler::make-all-proclaims "*.fn") + (with-open-file (st "sys-proclaim.lisp" + :direction :output + :if-exists :append) + (format st "~%(IN-PACKAGE \"PCL\")~%") + (print + `(dolist (v ', + + (sloop::sloop for v in-package "PCL" + when (get v 'compiler::proclaimed-closure) + collect v)) + (setf (get v 'compiler::proclaimed-closure) t)) + st) + (format st "~%") +)) + + + diff --git a/pcl/impl/gcl/gcl-patches.lisp b/pcl/impl/gcl/gcl-patches.lisp new file mode 100644 index 0000000..9e666a6 --- /dev/null +++ b/pcl/impl/gcl/gcl-patches.lisp @@ -0,0 +1,225 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + + +(in-package "COMPILER") + +;; do evaluation of top level forms at compile time. +(eval-when (compile eval load) +(setq *EVAL-WHEN-COMPILE* t) +) + +(pushnew :turbo-closure *features*) +(pushnew :turbo-closure-env-size *features*) +;; patch around compiler bug. + + +(let ((rset "int Rset; +")) + (unless (search rset compiler::*cmpinclude-string*) + (setq compiler::*cmpinclude-string* + (concatenate 'string rset compiler::*cmpinclude-string*)))) + +(when (get 'si::basic-wrapper 'si::s-data) + (pushnew :new-kcl-wrapper *features*) + (pushnew :structure-wrapper *features*)) + + + + +#+akcl +(progn + +(unless (fboundp 'real-c2lambda-expr-with-key) + (setf (symbol-function 'real-c2lambda-expr-with-key) + (symbol-function 'c2lambda-expr-with-key))) + +(defun c2lambda-expr-with-key (lambda-list body) + (declare (special *sup-used*)) + (setq *sup-used* t) + (real-c2lambda-expr-with-key lambda-list body)) + + +;There is a bug in the implementation of *print-circle* that +;causes some akcl debugging commands (including :bt and :bl) +;to cause the following error when PCL is being used: +;Unrecoverable error: value stack overflow. + +;When a CLOS object is printed, travel_push_object ends up +;traversing almost the whole class structure, thereby overflowing +;the value-stack. + +;from lsp/debug.lsp. +;*print-circle* is badly implemented in kcl. +;it has two separate problems that should be fixed: +; 1. it traverses the printed object putting all objects found +; on the value stack (rather than in a hash table or some +; other structure; this is a problem because the size of the value stack +; is fixed, and a potentially unbounded number of objects +; need to be traversed), and +; 2. it blindly traverses all slots of any +; kind of structure including std-object structures. +; This is safe, but not always necessary, and is very time-consuming +; for CLOS objects (because it will always traverse every class). + +;For now, avoid using *print-circle* T when it will cause problems. + + + +(eval-when (compile eval ) +(defmacro si::f (op &rest args) + `(the fixnum (,op ,@ (mapcar #'(lambda (x) `(the fixnum ,x)) args) ))) + +(defmacro si::fb (op &rest args) + `(,op ,@ (mapcar #'(lambda (x) `(the fixnum ,x)) args) )) +) + +(defun si::display-env (n env) + (do ((v (reverse env) (cdr v))) + ((or (not (consp v)) (si::fb > (fill-pointer si::*display-string*) n))) + (or (and (consp (car v)) + (listp (cdar v))) + (return)) + (let ((*print-circle* (can-use-print-circle-p (cadar v)))) + (format si::*display-string* "~s=~s~@[,~]" (caar v) (cadar v) (cdr v))))) + +(defun si::display-compiled-env ( plength ihs &aux + (base (si::ihs-vs ihs)) + (end (min (si::ihs-vs (1+ ihs)) (si::vs-top)))) + (format si::*display-string* "") + (do ((i base ) + (v (get (si::ihs-fname ihs) 'si::debug) (cdr v))) + ((or (si::fb >= i end)(si::fb > (fill-pointer si::*display-string*) plength))) + (let ((*print-circle* (can-use-print-circle-p (si::vs i)))) + (format si::*display-string* "~a~@[~d~]=~s~@[,~]" + (or (car v) 'si::loc) (if (not (car v)) (si::f - i base)) (si::vs i) + (si::fb < (setq i (si::f + i 1)) end))))) + +(clines "#define objnull_p(x) ((x==OBJNULL)?Ct:Cnil)") +(defentry objnull-p (object) (object "objnull_p")) + +(defun can-use-print-circle-p (x) + (catch 'can-use-print-circle-p + (can-use-print-circle-p1 x nil))) + +(defun can-use-print-circle-p1 (x so-far) + (and (not (objnull-p x)) ; because of deficiencies in the compiler, maybe? + (if (member x so-far) + (throw 'can-use-print-circle-p t) + (let ((so-far (cons x so-far))) + (flet ((can-use-print-circle-p (x) + (can-use-print-circle-p1 x so-far))) + (typecase x + (vector (or (not (eq 't (array-element-type x))) + (every #'can-use-print-circle-p x))) + (cons (and (can-use-print-circle-p (car x)) + (can-use-print-circle-p (cdr x)))) + (array (or (not (eq 't (array-element-type x))) + (let* ((rank (array-rank x)) + (dimensions (make-list rank))) + (dotimes (i rank) + (setf (nth i dimensions) (array-dimension x i))) + (or (member 0 dimensions) + (do ((cursor (make-list rank :initial-element 0))) + (nil) + (declare (:dynamic-extent cursor)) + (unless (can-use-print-circle-p + (apply #'aref x cursor)) + (return nil)) + (when (si::increment-cursor cursor dimensions) + (return t))))))) + (t (or (not (si:structurep x)) + (let* ((def (si:structure-def x)) + (name (si::s-data-name def)) + (len (si::s-data-length def)) + (pfun (si::s-data-print-function def))) + (and (null pfun) + (dotimes (i len t) + (unless (can-use-print-circle-p + (si:structure-ref x name i)) + (return nil))))))))))))) + +(defun si::apply-display-fun (display-fun n lis) + (let ((*print-length* si::*debug-print-level*) + (*print-level* si::*debug-print-level*) + (*print-pretty* nil) + (*PRINT-CASE* :downcase) + (*print-circle* nil) + ) + (setf (fill-pointer si::*display-string*) 0) + (format si::*display-string* "{") + (funcall display-fun n lis) + (when (si::fb > (fill-pointer si::*display-string*) n) + (setf (fill-pointer si::*display-string*) n) + (format si::*display-string* "...")) + + (format si::*display-string* "}") + ) + si::*display-string* + ) + +;The old definition of this had a bug: +;sometimes it returned without calling mv-values. +(defun si::next-stack-frame (ihs &aux line-info li i k na) + (cond ((si::fb < ihs si::*ihs-base*) + (si::mv-values nil nil nil nil nil)) + ((let (fun) + ;; next lower visible ihs + (si::mv-setq (fun i) (si::get-next-visible-fun ihs)) + (setq na fun) + (cond ((and (setq line-info (get fun 'si::line-info)) + (do ((j (si::f + ihs 1) (si::f - j 1)) + (form )) + ((<= j i) nil) + (setq form (si::ihs-fun j)) + (cond ((setq li (si::get-line-of-form form line-info)) + (return-from si::next-stack-frame + (si::mv-values + i fun li + ;; filename + (car (aref line-info 0)) + ;;environment + (list (si::vs (setq k (si::ihs-vs j))) + (si::vs (1+ k)) + (si::vs (+ k 2))))))))))))) + ((and (not (special-form-p na)) + (not (get na 'si::dbl-invisible)) + (fboundp na)) + (si::mv-values i na nil nil + (if (si::ihs-not-interpreted-env i) + nil + (let ((i (si::ihs-vs i))) + (list (si::vs i) (si::vs (1+ i)) (si::vs (si::f + i 2))))))) + (t (si::mv-values nil nil nil nil nil)))) +) + + + + + + + diff --git a/pcl/impl/gcl/gcl_pcl_impl_low.lisp b/pcl/impl/gcl/gcl_pcl_impl_low.lisp new file mode 100644 index 0000000..f68e999 --- /dev/null +++ b/pcl/impl/gcl/gcl_pcl_impl_low.lisp @@ -0,0 +1,310 @@ +(in-package "SI") +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name)) +(in-package 'pcl) +(eval-when (compile eval load) +(setq *EVAL-WHEN-COMPILE* t) +) + +(defmacro memq (item list) `(member ,item ,list :test #'eq)) +(defmacro assq (item list) `(assoc ,item ,list :test #'eq)) +(defmacro posq (item list) `(position ,item ,list :test #'eq)) + +;; The generic dotimes macro is now sufficient for the performance +;; gains sought here. Even the declaration extraction should be the +;; same as that provided in do* which dotimes invokes. 20040403 CM +;(defmacro dotimes ((var form &optional (val nil)) &rest body &environment env) +; (multiple-value-bind (doc decls bod) +; (extract-declarations body env) +; (declare (ignore doc)) +; (let ((limit (gensym)) +; (label (gensym))) +; `(let ((,limit ,form) +; (,var 0)) +; (declare (fixnum ,limit ,var)) +; ,@decls +; (block nil +; (tagbody +; ,label +; (when (>= ,var ,limit) (return-from nil ,val)) +; ,@bod +; (setq ,var (the fixnum (1+ ,var))) +; (go ,label))))))) + +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (si:address thing))) + +(eval-when (compile load eval) +(pushnew :turbo-closure *features*) +(pushnew :turbo-closure-env-size *features*)) +) + +(defmacro %svref (vector index) + `(svref (the simple-vector ,vector) (the fixnum ,index))) + +(defsetf %svref (vector index) (new-value) + `(setf (svref (the simple-vector ,vector) (the fixnum ,index)) + ,new-value)) + +(si::freeze-defstruct 'pcl::std-instance) + +(si::freeze-defstruct 'method-call) +(si::freeze-defstruct 'fast-method-call) + +(defvar *pcl-funcall* `(lambda (loc) + (compiler::wt-nl + "{object _funobj = " loc ";" + "if(type_of(_funobj)==t_cclosure && (_funobj->cc.cc_turbo)) + (*(_funobj->cc.cc_self))(_funobj); + else if (type_of(_funobj)==t_cfun) (*(_funobj->cc.cc_self))(); + else super_funcall_no_event(_funobj);}"))) + +(setq compiler::*super-funcall* *pcl-funcall*) + +(defmacro fmc-funcall (fn pv-cell next-method-call &rest args) + `(funcall ,fn ,pv-cell ,next-method-call ,@args)) + +(defun pcl::proclaim-defmethod (x y) y + (and (symbolp x) + (setf (get x 'compiler::proclaimed-closure ) t))) + + + +;#+turbo-closure-env-size +(clines " +static object cclosure_env_nthcdr (fixnum n,object cc) { + object env,*turbo; + if(n<0)return Cnil; + if(type_of(cc)!=t_cclosure)return Cnil; + if((turbo=cc->cc.cc_turbo)==NULL) + {env=cc->cc.cc_env; + while(n-->0) + {if(type_of(env)!=t_cons)return Cnil; + env=env->c.c_cdr;} + return env;} + else + {if(n>=fix(*(turbo-1)))return Cnil; + return turbo[n];} +}") + +(defentry cclosure-env-nthcdr (fixnum object) (compiler::static object cclosure_env_nthcdr)) +;; This is the unsafe but fast version. +(defentry %cclosure-env-nthcdr (fixnum object) (compiler::static object cclosure_env_nthcdr)) + +(eval-when (compile eval load) +(defparameter *gcl-function-inlines* + '( (%fboundp (t) compiler::boolean nil nil "(#0)->s.s_gfdef!=OBJNULL") + (%symbol-function (t) t nil nil "(#0)->s.s_gfdef") + (si:%structure-name (t) t nil nil "(#0)->str.str_def->str.str_self[0]") + (si:%compiled-function-name (t) t nil nil "(#0)->cf.cf_name") + (si:%set-compiled-function-name (t t) t t nil "((#0)->cf.cf_name)=(#1)") + (cclosurep (t) compiler::boolean nil nil "type_of(#0)==t_cclosure") + (sfun-p (t) compiler::boolean nil nil "type_of(#0)==t_sfun") + (%cclosure-env (t) t nil nil "(#0)->cc.cc_env") + (%set-cclosure-env (t t) t t nil "((#0)->cc.cc_env)=(#1)") + #+turbo-closure + (%cclosure-env-nthcdr (fixnum t) t nil nil "(#1)->cc.cc_turbo[#0]") + + (logxor (fixnum fixnum) fixnum nil nil "((#0) ^ (#1))"))) + +(defun make-function-inline (inline) + (setf (get (car inline) 'compiler::inline-always) + (list (if (fboundp 'compiler::flags) + (let ((opt (cdr inline))) + (list (first opt) (second opt) + (logior (if (fourth opt) 1 0) ; allocates-new-storage + (if (third opt) 2 0) ; side-effect + (if nil 4 0) ; constantp + (if (eq (car inline) 'logxor) + 8 0)) ;result type from args + (fifth opt))) + (cdr inline)))))) + + +(defmacro define-inlines () + `(progn + ,@(mapcan #'(lambda (inline) + (let ((name (intern (format nil "~S inline" (car inline)))) + (vars (mapcar #'(lambda (type) + (declare (ignore type)) + (gensym)) + (cadr inline)))) + `((eval-when (compile eval load) + (make-function-inline + ',(cons name (cdr inline)))) + ,@(when (or (every #'(lambda (type) (eq type 't)) + (cadr inline)) + (char= #\% (aref (symbol-name (car inline)) 0))) + `((defun ,(car inline) ,vars + ,@(mapcan #'(lambda (var var-type) + (unless (eq var-type 't) + `((declare (type ,var-type ,var))))) + vars (cadr inline)) + (the ,(caddr inline) (,name ,@vars))) + (make-function-inline ',inline)))))) + *gcl-function-inlines*))) + +(define-inlines) + +(defsetf si:%compiled-function-name si:%set-compiled-function-name) +(defsetf %cclosure-env %set-cclosure-env) + +(defun set-function-name-1 (fn new-name ignore) + (declare (ignore ignore)) + (cond ((compiled-function-p fn) + (si::turbo-closure fn) + (when (symbolp new-name) (pcl::proclaim-defmethod new-name nil)) + (setf (si:%compiled-function-name fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda-block)) + (setf (cadr fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda)) + (setf (car fn) 'lambda-block + (cdr fn) (cons new-name (cdr fn))))) + fn) + + +(clines " +object fSuse_fast_links_2(object,object); +static object set_cclosure (object result_cc,object value_cc,fixnum available_size) { + object result_env_tail,value_env_tail; int i; + + /* If we are currently using fast linking, */ + /* make sure to remove the link for result_cc. */ + /* (VFUN_NARGS=2,fSuse_fast_links_2(Cnil,result_cc));*/ + fSuse_fast_links_2(Cnil,result_cc); + +/* use_fast_links(3,Cnil,result_cc); */ + + result_env_tail=result_cc->cc.cc_env; + value_env_tail=value_cc->cc.cc_env; + for(i=available_size; + result_env_tail!=Cnil && i>0; + result_env_tail=CMPcdr(result_env_tail), value_env_tail=CMPcdr(value_env_tail)) + CMPcar(result_env_tail)=CMPcar(value_env_tail), i--; + result_cc->cc.cc_self=value_cc->cc.cc_self; + result_cc->cc.cc_data=value_cc->cc.cc_data; + + return result_cc; +}") + +(defentry %set-cclosure (object object fixnum) (compiler::static object set_cclosure)) + + +(defun structure-functions-exist-p () + t) + +(si:define-compiler-macro structure-instance-p (x) + (once-only (x) + `(and (si:structurep ,x) + (not (eq (si:%structure-name ,x) 'std-instance))))) + +(defun structure-type (x) + (and (si:structurep x) + (si:%structure-name x))) + +(si:define-compiler-macro structure-type (x) + (once-only (x) + `(and (si:structurep ,x) + (si:%structure-name ,x)))) + +(defun structure-type-p (type) + (or (not (null (gethash type *structure-table*))) + (let (#+akcl(s-data nil)) + (and (symbolp type) + (setq s-data (get type 'si::s-data)) + + (null (si::s-data-type s-data) + ))))) + + +(defun structure-type-included-type-name (type) + (or (car (gethash type *structure-table*)) + (let ((includes (si::s-data-includes (get type 'si::s-data)))) + (when includes + (si::s-data-name includes))))) + +(defun structure-type-internal-slotds (type) + (si::s-data-slot-descriptions (get type 'si::s-data)) + ) + +(defun structure-type-slot-description-list (type) + (or (cdr (gethash type *structure-table*)) + (mapcan #'(lambda (slotd) + (when (and slotd (car slotd)) + (let ((offset (fifth slotd))) + (let ((reader #'(lambda (x) + (si:structure-ref1 x offset) + )) + (writer #'(lambda (v x) + (si:structure-set x type offset v)))) + #+turbo-closure (si:turbo-closure reader) + #+turbo-closure (si:turbo-closure writer) + (let* ((reader-sym + (let ((*package* *the-pcl-package*)) + (intern (format nil "~s SLOT~D" type offset)))) + (writer-sym (get-setf-function-name reader-sym)) + (slot-name (first slotd)) + (read-only-p (fourth slotd))) + (setf (symbol-function reader-sym) reader) + (setf (symbol-function writer-sym) writer) + (do-standard-defsetf-1 reader-sym) + (list (list slot-name + reader-sym + (and (not read-only-p) writer)))))))) + (let ((slotds (structure-type-internal-slotds type)) + (inc (structure-type-included-type-name type))) + (if inc + (nthcdr (length (structure-type-internal-slotds inc)) + slotds) + slotds))))) + +(defun structure-slotd-name (slotd) + (first slotd)) + +(defun structure-slotd-accessor-symbol (slotd) + (second slotd)) + +;(defun structure-slotd-writer-function (slotd) +; (third slotd)) + +(defun structure-slotd-reader-function (slotd) + (third slotd)) + +(defun structure-slotd-writer-function (slotd) + (fourth slotd)) + +(defun renew-sys-files() +;; ;; packages: +;; (compiler::get-packages "sys-package.lisp") +;; (with-open-file (st "sys-package.lisp" +;; :direction :output +;; :if-exists :append) +;; (format st "(lisp::in-package \"SI\") +;; (export '(%structure-name +;; %compiled-function-name +;; %set-compiled-function-name)) +;; (in-package \"PCL\") +;; ")) + + ;; proclaims + (compiler::make-all-proclaims "*.fn") + (with-open-file (st "sys-proclaim.lisp" + :direction :output + :if-exists :append) + (format st "~%(IN-PACKAGE \"PCL\")~%") + (print + `(dolist (v ', + + (sloop::sloop for v in-package "PCL" + when (get v 'compiler::proclaimed-closure) + collect v)) + (setf (get v 'compiler::proclaimed-closure) t)) + st) + (format st "~%") +)) + + + diff --git a/pcl/impl/gcl/makefile.gcl b/pcl/impl/gcl/makefile.gcl new file mode 100644 index 0000000..46a50be --- /dev/null +++ b/pcl/impl/gcl/makefile.gcl @@ -0,0 +1,38 @@ +# makefile for making pcl -- W. Schelter. + +# Directions: +# make -f makefile.gcl compile +# make -f makefile.gcl saved_pcl + + +LISP=gcl + + +SETUP='(load "sys-package.lisp")' \ + '(setq *features* (delete (quote kcl) *features*))'\ + '(load "defsys.lisp")(push (quote kcl) *features*)' \ + '(setq pcl::*default-pathname-extensions* (cons "lisp" "o"))' \ + '(setq pcl::*pathname-extensions* (cons "lisp" "o"))' \ + '(load "sys-proclaim.lisp")(compiler::emit-fn t)' + +compile: + echo ${SETUP} '(pcl::compile-pcl)' | ${LISP} + +saved_pcl: + echo ${SETUP} '(pcl::load-pcl)(si::save-system "saved_pcl")' | ${LISP} + + +# remake the sys-package.lisp and sys-proclaim.lisp files +# Those files may be empty on a first build. +remake-sys-files: + echo ${SETUP} '(pcl::load-pcl)(in-package "PCL")(renew-sys-files)' | ${LISP} + cp sys-proclaim.lisp xxx + cat xxx | sed -e "s/COMPILER::CMP-ANON//g" > sys-proclaim.lisp + rm xxx + + +tar: + make -f makefile.gcl tar1 DIR=`pwd` + +tar1: + (cd .. ; tar cvf - `basename ${DIR}` | gzip -c > `basename ${DIR}`.tgz) diff --git a/pcl/impl/gcl/sys-package.lisp b/pcl/impl/gcl/sys-package.lisp new file mode 100644 index 0000000..c04430e --- /dev/null +++ b/pcl/impl/gcl/sys-package.lisp @@ -0,0 +1,149 @@ + + +;;; Definitions for package SLOT-ACCESSOR-NAME of type ESTABLISH +(LISP::IN-PACKAGE "SLOT-ACCESSOR-NAME" :USE LISP::NIL :NICKNAMES + '("S-A-N")) + +;;; Definitions for package PCL of type ESTABLISH +(LISP::IN-PACKAGE "PCL" :USE LISP::NIL) + +;;; Definitions for package ITERATE of type ESTABLISH +(LISP::IN-PACKAGE "ITERATE" :USE LISP::NIL) + +;;; Definitions for package WALKER of type ESTABLISH +(LISP::IN-PACKAGE "WALKER" :USE LISP::NIL) + +;;; Definitions for package SLOT-ACCESSOR-NAME of type EXPORT +(LISP::IN-PACKAGE "SLOT-ACCESSOR-NAME" :USE 'LISP::NIL :NICKNAMES + '("S-A-N")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT 'LISP::NIL) + +;;; Definitions for package PCL of type EXPORT +(LISP::IN-PACKAGE "PCL" :USE '("LISP" "ITERATE" "WALKER")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT + '(PCL::CLASS-PRECEDENCE-LIST PCL::SLOT-DEFINITION + PCL::COMPUTE-APPLICABLE-METHODS-USING-CLASSES + PCL::SLOT-DEFINITION-WRITERS PCL::CLASS-OF + PCL::NO-APPLICABLE-METHOD PCL::STANDARD-WRITER-METHOD + PCL::ENSURE-CLASS-USING-CLASS PCL::ENSURE-GENERIC-FUNCTION + PCL::FIND-METHOD-COMBINATION PCL::UPDATE-DEPENDENT + PCL::MAP-DEPENDENTS PCL::SLOT-MISSING PCL::SPECIALIZER + PCL::CALL-NEXT-METHOD PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS + PCL::SLOT-MAKUNBOUND-USING-CLASS PCL::MAKE-INSTANCES-OBSOLETE + PCL::INTERN-EQL-SPECIALIZER PCL::REMOVE-DIRECT-SUBCLASS + PCL::METHOD-GENERIC-FUNCTION PCL::METHOD-QUALIFIERS + PCL::FUNCALLABLE-STANDARD-CLASS PCL::EXTRACT-LAMBDA-LIST + PCL::STANDARD-CLASS PCL::PRINT-OBJECT PCL::STRUCTURE-CLASS + PCL::COMPUTE-EFFECTIVE-SLOT-DEFINITION + PCL::GENERIC-FUNCTION-DECLARATIONS PCL::MAKE-INSTANCE + PCL::METHOD-LAMBDA-LIST PCL::DEFGENERIC + PCL::REMOVE-DIRECT-METHOD PCL::STANDARD-DIRECT-SLOT-DEFINITION + PCL::GENERIC-FUNCTION-METHODS PCL::VALIDATE-SUPERCLASS + PCL::REINITIALIZE-INSTANCE PCL::STANDARD-METHOD + PCL::STANDARD-ACCESSOR-METHOD + PCL::FUNCALLABLE-STANDARD-INSTANCE PCL::FUNCTION-KEYWORDS + PCL::STANDARD PCL::FIND-METHOD PCL::EXTRACT-SPECIALIZER-NAMES + PCL::INITIALIZE-INSTANCE PCL::GENERIC-FLET PCL::SLOT-UNBOUND + PCL::STANDARD-INSTANCE PCL::SLOT-DEFINITION-TYPE + PCL::COMPUTE-EFFECTIVE-METHOD PCL::ALLOCATE-INSTANCE + PCL::SYMBOL-MACROLET PCL::GENERIC-FUNCTION + PCL::GENERIC-FUNCTION-METHOD-COMBINATION + PCL::SPECIALIZER-DIRECT-METHODS PCL::ADD-DIRECT-SUBCLASS + PCL::WRITER-METHOD-CLASS PCL::SLOT-DEFINITION-INITARGS + PCL::METHOD-SPECIALIZERS PCL::GENERIC-FUNCTION-METHOD-CLASS + PCL::ADD-METHOD PCL::WITH-ACCESSORS + PCL::SLOT-DEFINITION-ALLOCATION + PCL::SLOT-DEFINITION-INITFUNCTION + PCL::SLOT-DEFINITION-LOCATION PCL::ADD-DIRECT-METHOD + PCL::SLOT-BOUNDP PCL::EQL-SPECIALIZER PCL::SHARED-INITIALIZE + PCL::STANDARD-GENERIC-FUNCTION + PCL::ACCESSOR-METHOD-SLOT-DEFINITION + PCL::SLOT-BOUNDP-USING-CLASS PCL::ADD-DEPENDENT + PCL::SPECIALIZER-DIRECT-GENERIC-FUNCTION + PCL::WITH-ADDED-METHODS PCL::COMPUTE-CLASS-PRECEDENCE-LIST + PCL::REMOVE-DEPENDENT PCL::NEXT-METHOD-P + PCL::GENERIC-FUNCTION-NAME PCL::SLOT-VALUE + PCL::EFFECTIVE-SLOT-DEFINITION PCL::CLASS-FINALIZED-P + PCL::COMPUTE-DISCRIMINATING-FUNCTION PCL::STANDARD-OBJECT + PCL::CLASS-DEFAULT-INITARGS PCL::CLASS-DIRECT-SLOTS + PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS PCL::BUILT-IN-CLASS + PCL::NO-NEXT-METHOD PCL::SLOT-MAKUNBOUND + PCL::STANDARD-READER-METHOD PCL::GENERIC-FUNCTION-LAMBDA-LIST + PCL::GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER + PCL::INVALID-METHOD-ERROR PCL::METHOD-COMBINATION-ERROR + PCL::SLOT-EXISTS-P PCL::FINALIZE-INHERITANCE + PCL::SLOT-DEFINITION-NAME + PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION PCL::COMPUTE-SLOTS + PCL::CLASS-SLOTS PCL::EFFECTIVE-SLOT-DEFINITION-CLASS + PCL::STANDARD-INSTANCE-ACCESS PCL::WITH-SLOTS + PCL::DIRECT-SLOT-DEFINITION PCL::DEFINE-METHOD-COMBINATION + PCL::MAKE-METHOD-LAMBDA PCL::ENSURE-CLASS + PCL::DIRECT-SLOT-DEFINITION-CLASS PCL::METHOD-FUNCTION + PCL::STANDARD-SLOT-DEFINITION PCL::CHANGE-CLASS PCL::DEFMETHOD + PCL::UPDATE-INSTANCE-FOR-DIFFERENT-CLASS + PCL::UPDATE-INSTANCE-FOR-REDEFINED-CLASS + PCL::FORWARD-REFERENCED-CLASS PCL::SLOT-DEFINITION-INITFORM + PCL::REMOVE-METHOD PCL::READER-METHOD-CLASS PCL::CALL-METHOD + PCL::CLASS-PROTOTYPE PCL::CLASS-NAME PCL::FIND-CLASS + PCL::DEFCLASS PCL::COMPUTE-APPLICABLE-METHODS + PCL::SLOT-VALUE-USING-CLASS PCL::METHOD-COMBINATION + PCL::EQL-SPECIALIZER-INSTANCE PCL::GENERIC-LABELS PCL::METHOD + PCL::SLOT-DEFINITION-READERS + PCL::CLASS-DIRECT-DEFAULT-INITARGS + PCL::CLASS-DIRECT-SUBCLASSES PCL::CLASS-DIRECT-SUPERCLASSES + PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION)) + +;;; Definitions for package ITERATE of type EXPORT +(LISP::IN-PACKAGE "ITERATE" :USE '("WALKER" "LISP")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT + '(ITERATE::SUMMING ITERATE::MINIMIZING ITERATE::PLIST-ELEMENTS + ITERATE::ITERATE* ITERATE::MAXIMIZING ITERATE::LIST-TAILS + ITERATE::*ITERATE-WARNINGS* ITERATE::GATHERING + ITERATE::EACHTIME ITERATE::ELEMENTS ITERATE::GATHER + ITERATE::LIST-ELEMENTS ITERATE::WHILE ITERATE::ITERATE + ITERATE::UNTIL ITERATE::JOINING ITERATE::COLLECTING + ITERATE::WITH-GATHERING ITERATE::INTERVAL)) + +;;; Definitions for package WALKER of type EXPORT +(LISP::IN-PACKAGE "WALKER" :USE '("LISP")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT + '(WALKER::DEFINE-WALKER-TEMPLATE WALKER::*VARIABLE-DECLARATIONS* + WALKER::NESTED-WALK-FORM WALKER::VARIABLE-DECLARATION + WALKER::WALK-FORM-EXPAND-MACROS-P WALKER::VARIABLE-LEXICAL-P + WALKER::VARIABLE-SPECIAL-P WALKER::WALK-FORM + WALKER::MACROEXPAND-ALL WALKER::VARIABLE-GLOBALLY-SPECIAL-P)) + +;;; Definitions for package SLOT-ACCESSOR-NAME of type SHADOW +(LISP::IN-PACKAGE "SLOT-ACCESSOR-NAME") +(LISP::SHADOW 'LISP::NIL) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT 'LISP::NIL) + +;;; Definitions for package PCL of type SHADOW +(LISP::IN-PACKAGE "PCL") +(LISP::SHADOW '(PCL::DOTIMES PCL::DOCUMENTATION)) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT + '(SYSTEM::STRUCTURE-REF SYSTEM::STRUCTURE-DEF SYSTEM::STRUCTUREP)) + +;;; Definitions for package ITERATE of type SHADOW +(LISP::IN-PACKAGE "ITERATE") +(LISP::SHADOW 'LISP::NIL) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT 'LISP::NIL) + +;;; Definitions for package WALKER of type SHADOW +(LISP::IN-PACKAGE "WALKER") +(LISP::SHADOW 'LISP::NIL) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT 'LISP::NIL) + +(in-package 'SI) +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name)) +(in-package 'pcl) diff --git a/pcl/impl/gcl/sys-proclaim.lisp b/pcl/impl/gcl/sys-proclaim.lisp new file mode 100644 index 0000000..26f8698 --- /dev/null +++ b/pcl/impl/gcl/sys-proclaim.lisp @@ -0,0 +1,1448 @@ + +(IN-PACKAGE "PCL") +(PROCLAIM + '(FTYPE (FUNCTION (T) FIXNUM) ONE-INDEX-LIMIT-FN + N-N-ACCESSORS-LIMIT-FN CHECKING-LIMIT-FN PV-CACHE-LIMIT-FN + ARG-INFO-NUMBER-REQUIRED DEFAULT-LIMIT-FN CACHE-COUNT + CACHING-LIMIT-FN PV-TABLE-PV-SIZE EARLY-CLASS-SIZE + CPD-COUNT FAST-INSTANCE-BOUNDP-INDEX)) +(PROCLAIM '(FTYPE (FUNCTION (T) FIELD-TYPE) CACHE-FIELD)) +(PROCLAIM + '(FTYPE (FUNCTION (T) FUNCTION) CACHE-LIMIT-FN METHOD-CALL-FUNCTION + FAST-METHOD-CALL-FUNCTION)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) POWER-OF-TWO-CEILING)) +(PROCLAIM + '(FTYPE (FUNCTION (T) LIST) CACHE-OVERFLOW PV-TABLE-SLOT-NAME-LISTS + PV-TABLE-CALL-LIST)) +(PROCLAIM '(FTYPE (FUNCTION (T) (MEMBER NIL T)) CACHE-VALUEP)) +(PROCLAIM '(FTYPE (FUNCTION (T) SIMPLE-VECTOR) CACHE-VECTOR)) +(PROCLAIM + '(FTYPE (FUNCTION (T) (VALUES T T)) MAKE-CLASS-PREDICATE-NAME + MAKE-KEYWORD)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) %CCLOSURE-ENV-NTHCDR)) +(PROCLAIM + '(FTYPE (FUNCTION (FIXNUM FIXNUM T) FIXNUM) + COMPUTE-PRIMARY-CACHE-LOCATION)) +(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 256)) CACHE-NKEYS)) +(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 512)) CACHE-LINE-SIZE)) +(PROCLAIM '(FTYPE (FUNCTION (T) (OR CACHE NULL)) PV-TABLE-CACHE)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T) *) + GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + ITERATE::WALK-GATHERING-BODY CACHE-MISS-VALUES + MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION + OPTIMIZE-SLOT-VALUE-BY-CLASS-P ACCESSOR-VALUES1 + EMIT-READER/WRITER EMIT-ONE-OR-N-INDEX-READER/WRITER + GENERATING-LISP EMIT-READER/WRITER-FUNCTION + EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION + WALKER::WALK-LET-IF SET-SLOT-VALUE CONVERT-METHODS + |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| + SLOT-VALUE-USING-CLASS-DFUN SLOT-BOUNDP-USING-CLASS-DFUN + |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| + CHECK-METHOD-ARG-INFO + |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| + LOAD-LONG-DEFCOMBIN MAKE-FINAL-N-N-ACCESSOR-DFUN + |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| + MAKE-FINAL-CACHING-DFUN MAKE-FINAL-CONSTANT-VALUE-DFUN + GET-CLASS-SLOT-VALUE-1 ACCESSOR-VALUES-INTERNAL + MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION + MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION + ITERATE::EXPAND-INTO-LET WALKER::WALK-FORM-INTERNAL + ITERATE::RENAME-VARIABLES CONSTANT-VALUE-MISS CACHING-MISS + |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| + CHECKING-MISS GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION + |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| + |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| + |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| + |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| + |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))|)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T) *) + |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| + |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| + |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| + COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL + ADD-METHOD-DECLARATIONS WALK-METHOD-LAMBDA + MAKE-TWO-CLASS-ACCESSOR-DFUN + |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| + |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| + |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| + |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T) *) + |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| + |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| + |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| + |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| + |(FAST-METHOD DESCRIBE-OBJECT (T T))| + |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| + |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| + |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| + |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| + |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| + GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION + |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| + BOOTSTRAP-ACCESSOR-DEFINITION GET-ACCESSOR-METHOD-FUNCTION + EMIT-CHECKING-OR-CACHING EMIT-CHECKING-OR-CACHING-FUNCTION + SETF-SLOT-VALUE-USING-CLASS-DFUN LOAD-SHORT-DEFCOMBIN + INITIALIZE-INSTANCE-SIMPLE-FUNCTION + MAKE-SHARED-INITIALIZE-FORM-LIST + MAKE-ONE-CLASS-ACCESSOR-DFUN + MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN MAKE-FINAL-CHECKING-DFUN + ACCESSOR-VALUES SET-CLASS-SLOT-VALUE-1 + GENERATE-DISCRIMINATION-NET REAL-MAKE-METHOD-LAMBDA + ORDER-SPECIALIZERS ACCESSOR-MISS + |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| + |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| + |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| + |(FAST-METHOD NO-APPLICABLE-METHOD (T))| + |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| + |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T) *) MEMF-CODE-CONVERTER + CACHE-MISS-VALUES-INTERNAL + GENERATE-DISCRIMINATION-NET-INTERNAL + MAKE-LONG-METHOD-COMBINATION-FUNCTION + DO-SHORT-METHOD-COMBINATION + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|)) +(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) *) REAL-MAKE-A-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T *) *) MAKE-ONE-INDEX-ACCESSOR-DFUN + WALKER::WALK-DECLARATIONS GET-SECONDARY-DISPATCH-FUNCTION)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T *) *) + MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 + ITERATE::RENAME-LET-BINDINGS)) +(PROCLAIM + '(FTYPE (FUNCTION (T T *) *) NESTED-WALK-FORM SLOT-VALUE-OR-DEFAULT + MAKE-EFFECTIVE-METHOD-FUNCTION + GET-EFFECTIVE-METHOD-FUNCTION MAKE-N-N-ACCESSOR-DFUN + MAKE-CHECKING-DFUN LOAD-DEFGENERIC TYPES-FROM-ARGUMENTS + MAKE-DEFAULT-INITARGS-FORM-LIST MAKE-FINAL-ACCESSOR-DFUN + MAKE-ACCESSOR-TABLE GET-SIMPLE-INITIALIZATION-FUNCTION + GET-COMPLEX-INITIALIZATION-FUNCTIONS + COMPUTE-SECONDARY-DISPATCH-FUNCTION)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T) *) + |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| + ITERATE::ITERATE-TRANSFORM-BODY)) +(PROCLAIM + '(FTYPE (FUNCTION (T) NON-NEGATIVE-FIXNUM) CACHE-NLINES + CACHE-MAX-LOCATION CACHE-SIZE CACHE-MASK)) +(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PRINT-DFUN-INFO)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T) T) + |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| + |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| + |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| + |(FAST-METHOD MAKE-INSTANCE (CLASS))| + |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| + MAKE-EFFECTIVE-METHOD-FUNCTION1 + MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL + MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE MEMF-TEST-CONVERTER + LOAD-PRECOMPILED-DFUN-CONSTRUCTOR TWO-CLASS-DFUN-INFO + WALKER::WALK-LET/LET* WALKER::WALK-PROG/PROG* + WALKER::WALK-DO/DO* WALKER::WALK-BINDINGS-2 OPTIMIZE-READER + OPTIMIZE-WRITER + |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| + EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY + |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| + MAYBE-EXPAND-ACCESSOR-FORM + |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| + INITIALIZE-INSTANCE-SIMPLE + |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| + GET-WRAPPERS-FROM-CLASSES + |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| + LOAD-PRECOMPILED-IIS-ENTRY FILL-CACHE-P ADJUST-CACHE + |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| + EXPAND-CACHE EXPAND-SYMBOL-MACROLET-INTERNAL + |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| + BOOTSTRAP-SET-SLOT EXPAND-DEFCLASS + |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| + |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| + |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| + |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| + |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| + WALKER::WALK-TEMPLATE + |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| + |(FAST-METHOD DOCUMENTATION (T))| + |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| + |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| + |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| + |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| + |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| + |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| + |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| + |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| + |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| + |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| + |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| + |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| + |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| + |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| + |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| + |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| + |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| + |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| + |(FAST-METHOD PRINT-OBJECT (T T))| + |(FAST-METHOD PRINT-OBJECT (CLASS T))| + |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| + |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| + |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| + |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| + |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + MAKE-DISPATCH-LAMBDA + |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T) T) + |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| + CAN-OPTIMIZE-ACCESS + |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| + OPTIMIZE-SLOT-VALUE + |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| + OPTIMIZE-SET-SLOT-VALUE + |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| + DECLARE-STRUCTURE OPTIMIZE-SLOT-BOUNDP PRINT-CACHE + FIRST-FORM-TO-LISP ITERATE::OPTIMIZE-ITERATE-FORM + WRAP-METHOD-GROUP-SPECIFIER-BINDINGS MAKE-TOP-LEVEL-FORM + INVALIDATE-WRAPPER STANDARD-COMPUTE-EFFECTIVE-METHOD + MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION + WALKER::RECONS ITERATE::OPTIMIZE-GATHERING-FORM + WALKER::WALK-MULTIPLE-VALUE-SETQ + |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| + |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| + |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| + |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| + |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| + |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| + |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| + VARIABLE-DECLARATION + |(FAST-METHOD CLASS-PREDICATE-NAME (T))| + |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| + |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| + |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| + |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| + |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| + ITERATE::SIMPLE-EXPAND-GATHERING-FORM + ITERATE::RENAME-AND-CAPTURE-VARIABLES + ITERATE::VARIABLE-SAME-P GET-FUNCTION-GENERATOR + GET-NEW-FUNCTION-GENERATOR TRACE-METHOD-INTERNAL + ONE-INDEX-DFUN-INFO ONE-CLASS-DFUN-INFO MAP-ALL-ORDERS + NOTE-PV-TABLE-REFERENCE WALKER::RELIST-INTERNAL + MAKE-DFUN-CALL WALKER::WALK-TAGBODY-1 WALKER::WALK-LAMBDA + OPTIMIZE-GF-CALL-INTERNAL WALKER::WALK-COMPILER-LET + |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| + SKIP-FAST-SLOT-ACCESS-P WALKER::WALK-UNEXPECTED-DECLARE + WALKER::WALK-FLET WALKER::WALK-IF WALKER::WALK-LABELS + WALKER::WALK-LET WALKER::WALK-LET* WALKER::WALK-LOCALLY + |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| + WALKER::WALK-MACROLET + |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| + FIX-SLOT-ACCESSORS + |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| + WALKER::WALK-MULTIPLE-VALUE-BIND + |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| + WALKER::WALK-SETQ + |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| + WALKER::WALK-SYMBOL-MACROLET + |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| + EMIT-SLOT-READ-FORM WALKER::WALK-TAGBODY EMIT-BOUNDP-CHECK + WALKER::WALK-DO WALKER::WALK-DO* WALKER::WALK-PROG + WALKER::WALK-NAMED-LAMBDA WALKER::WALK-PROG* + EXPAND-DEFGENERIC EMIT-GREATER-THAN-1-DLAP EMIT-1-T-DLAP + MAKE-METHOD-INITARGS-FORM-INTERNAL ENTRY-IN-CACHE-P + CONVERT-TABLE MAKE-METHOD-SPEC TRACE-EMF-CALL-INTERNAL + FLUSH-CACHE-TRAP SET-FUNCTION-NAME-1 OBSOLETE-INSTANCE-TRAP + COMPUTE-PRECEDENCE PRINT-STD-INSTANCE + |SETF PCL METHOD-FUNCTION-GET| |SETF PCL PLIST-VALUE| + WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL + |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| + |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| + INITIALIZE-INTERNAL-SLOT-GFS* + |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| + SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P + |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| + |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| + COMPUTE-EFFECTIVE-METHOD SORT-APPLICABLE-METHODS + SORT-METHODS)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T) T) + |(FAST-METHOD SLOT-UNBOUND (T T T))| + |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| + LOAD-FUNCTION-GENERATOR EXPAND-EMF-CALL-METHOD MAKE-FGEN + BOOTSTRAP-MAKE-SLOT-DEFINITIONS + BOOTSTRAP-ACCESSOR-DEFINITIONS1 + MAKE-FINAL-ORDINARY-DFUN-INTERNAL + WALKER::WALK-TEMPLATE-HANDLE-REPEAT COMPUTE-PV-SLOT + WALKER::WALK-BINDINGS-1 OPTIMIZE-INSTANCE-ACCESS + OPTIMIZE-ACCESSOR-CALL MAKE-METHOD-INITARGS-FORM-INTERNAL1 + UPDATE-SLOTS-IN-PV MAKE-PARAMETER-REFERENCES MAKE-EMF-CACHE + GET-MAKE-INSTANCE-FUNCTION-INTERNAL + |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| + MAKE-INSTANCE-FUNCTION-COMPLEX + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| + MAKE-INSTANCE-FUNCTION-SIMPLE + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| + OPTIMIZE-GENERIC-FUNCTION-CALL + REAL-MAKE-METHOD-INITARGS-FORM + |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| + |(FAST-METHOD (SETF DOCUMENTATION) (T T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| + |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| + |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| + |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| + |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| + |(FAST-METHOD REMOVE-NAMED-METHOD (T T))|)) +(PROCLAIM + '(FTYPE (FUNCTION (T T *) T) MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE + MAKE-EMF-FROM-METHOD EXPAND-EFFECTIVE-METHOD-FUNCTION + NAMED-OBJECT-PRINT-FUNCTION FIND-CLASS-FROM-CELL + FIND-CLASS-PREDICATE-FROM-CELL INITIALIZE-INFO + GET-EFFECTIVE-METHOD-FUNCTION1 GET-DECLARATION + GET-METHOD-FUNCTION-PV-CELL EMIT-MISS METHOD-FUNCTION-GET + PROBE-CACHE MAP-CACHE PRECOMPUTE-EFFECTIVE-METHODS + RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA CPL-ERROR + REAL-ADD-METHOD + REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION + REAL-ENSURE-GF-USING-CLASS--NULL + COMPUTE-SECONDARY-DISPATCH-FUNCTION1 + ENSURE-GENERIC-FUNCTION-USING-CLASS)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T) T) REAL-LOAD-DEFCLASS + WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 + BOOTSTRAP-MAKE-SLOT-DEFINITION EMIT-SLOT-ACCESS + OPTIMIZE-GF-CALL SET-ARG-INFO1 LOAD-DEFCLASS + MAKE-EARLY-CLASS-DEFINITION + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T) T) + |(FAST-METHOD SLOT-MISSING (T T T T))| EXPAND-DEFMETHOD + LOAD-DEFMETHOD-INTERNAL)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T FIXNUM) T) GET-CACHE + FILL-CACHE-FROM-CACHE-P)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T *) T) EMIT-DLAP + GET-SECONDARY-DISPATCH-FUNCTION1)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T *) T) CHECK-INITARGS-2-PLIST + CHECK-INITARGS-2-LIST WALKER::WALK-ARGLIST MAKE-EMF-CALL + CAN-OPTIMIZE-ACCESS1 EMIT-FETCH-WRAPPER FILL-CACHE + REAL-GET-METHOD CHECK-INITARGS-1 GET-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T *) T) LOAD-DEFMETHOD + MAKE-DEFMETHOD-FORM MAKE-DEFMETHOD-FORM-INTERNAL + EARLY-MAKE-A-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T *) T) FILL-DFUN-CACHE + EARLY-ADD-NAMED-METHOD REAL-ADD-NAMED-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T T) T) + GET-SECONDARY-DISPATCH-FUNCTION2)) +(PROCLAIM '(FTYPE (FUNCTION (T T FIXNUM) T) COMPUTE-STD-CPL-PHASE-3)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T T T *) T) + BOOTSTRAP-INITIALIZE-CLASS)) +(PROCLAIM + '(FTYPE (FUNCTION NIL *) COUNT-ALL-DFUNS EMIT-N-N-READERS + EMIT-N-N-WRITERS)) +(PROCLAIM + '(FTYPE (FUNCTION (*) *) UNTRACE-METHOD LIST-LARGE-CACHES + UPDATE-MAKE-INSTANCE-FUNCTION-TABLE INVALID-METHOD-ERROR + METHOD-COMBINATION-ERROR)) +(PROCLAIM + '(FTYPE (FUNCTION NIL T) RENEW-SYS-FILES + GET-EFFECTIVE-METHOD-GENSYM SHOW-EMF-CALL-TRACE + BOOTSTRAP-META-BRAID BOOTSTRAP-BUILT-IN-CLASSES + LIST-ALL-DFUNS DEFAULT-METHOD-ONLY-DFUN-INFO + INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST + CACHES-TO-ALLOCATE UPDATE-DISPATCH-DFUNS MAKE-CACHE + IN-THE-COMPILER-P STRUCTURE-FUNCTIONS-EXIST-P + ALLOCATE-FUNCALLABLE-INSTANCE-2 %%ALLOCATE-INSTANCE--CLASS + ALLOCATE-FUNCALLABLE-INSTANCE-1 DISPATCH-DFUN-INFO + INITIAL-DISPATCH-DFUN-INFO INITIAL-DFUN-INFO + NO-METHODS-DFUN-INFO SHOW-FREE-CACHE-VECTORS MAKE-CPD + MAKE-ARG-INFO SHOW-DFUN-CONSTRUCTORS)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T T) *) COMPUTE-CACHE-PARAMETERS)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T *) *) FIND-FREE-CACHE-LINE)) +(PROCLAIM + '(FTYPE (FUNCTION (*) T) |__si::MAKE-DFUN-INFO| + |__si::MAKE-NO-METHODS| |__si::MAKE-INITIAL| + |__si::MAKE-INITIAL-DISPATCH| |__si::MAKE-DISPATCH| + |__si::MAKE-DEFAULT-METHOD-ONLY| + |__si::MAKE-ACCESSOR-DFUN-INFO| + |__si::MAKE-ONE-INDEX-DFUN-INFO| MAKE-FAST-METHOD-CALL + |__si::MAKE-N-N| MAKE-FAST-INSTANCE-BOUNDP + |__si::MAKE-ONE-CLASS| |__si::MAKE-TWO-CLASS| + |__si::MAKE-ONE-INDEX| |__si::MAKE-CHECKING| + |__si::MAKE-ARG-INFO| FIX-EARLY-GENERIC-FUNCTIONS + STRING-APPEND |__si::MAKE-CACHING| + |__si::MAKE-CONSTANT-VALUE| FALSE + |STRUCTURE-OBJECT class constructor| + PV-WRAPPERS-FROM-PV-ARGS MAKE-PV-TABLE + |__si::MAKE-PV-TABLE| INTERN-PV-TABLE + CALLED-FIN-WITHOUT-FUNCTION |__si::MAKE-STD-INSTANCE| + MAKE-INITIALIZE-INFO |__si::MAKE-CACHE| MAKE-PROGN + WALKER::UNBOUND-LEXICAL-FUNCTION + |__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| MAKE-METHOD-CALL + TRUE USE-PACKAGE-PCL ZERO)) +(PROCLAIM + '(FTYPE (FUNCTION (T) *) TYPE-FROM-SPECIALIZER *NORMALIZE-TYPE + DEFAULT-CODE-CONVERTER CONVERT-TO-SYSTEM-TYPE + EMIT-CONSTANT-VALUE PCL-DESCRIBE GET-GENERIC-FUNCTION-INFO + EARLY-METHOD-FUNCTION + EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME + SPECIALIZER-FROM-TYPE CLASS-EQ-TYPE STRUCTURE-WRAPPER + FIND-STRUCTURE-CLASS MAKE-DISPATCH-DFUN FIND-WRAPPER + PARSE-DEFMETHOD PROTOTYPES-FOR-MAKE-METHOD-LAMBDA + EMIT-ONE-CLASS-READER EMIT-ONE-CLASS-WRITER + EMIT-TWO-CLASS-READER EMIT-TWO-CLASS-WRITER + EMIT-ONE-INDEX-READERS EMIT-ONE-INDEX-WRITERS + NET-CODE-CONVERTER EMIT-IN-CHECKING-CACHE-P + COMPILE-IIS-FUNCTIONS ANALYZE-LAMBDA-LIST + COMPUTE-APPLICABLE-METHODS-EMF GET-DISPATCH-FUNCTION + GENERIC-FUNCTION-NAME-P MAKE-FINAL-DISPATCH-DFUN + STRUCTURE-SLOTD-INIT-FORM PARSE-METHOD-GROUP-SPECIFIER + METHOD-PROTOTYPE-FOR-GF EARLY-COLLECT-INHERITANCE)) +(PROCLAIM + '(FTYPE (FUNCTION (T FIXNUM *) T) GET-CACHE-FROM-CACHE + COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) +(PROCLAIM + '(FTYPE (FUNCTION (T) T) COMPILE-LAMBDA-UNCOMPILED GF-LAMBDA-LIST + CACHING-CACHE CONSTANT-VALUE-CACHE COMPILE-LAMBDA-DEFERRED + FUNCALLABLE-INSTANCE-P SHOW-DFUN-COSTS + RESET-CLASS-INITIALIZE-INFO GET-CACHE-VECTOR + CONSTANT-SYMBOL-P FREE-CACHE-VECTOR + EARLY-METHOD-LAMBDA-LIST ARG-INFO-VALID-P DFUN-ARG-SYMBOL + EARLY-METHOD-CLASS EARLY-GF-P EARLY-GF-NAME + CACHING-DFUN-INFO COMPUTE-APPLICABLE-METHODS-EMF-STD-P + CONSTANT-VALUE-DFUN-INFO RESET-CLASS-INITIALIZE-INFO-1 + FREE-CACHE PARSE-SPECIALIZERS RESET-INITIALIZE-INFO + EARLY-METHOD-QUALIFIERS PROCLAIM-INCOMPATIBLE-SUPERCLASSES + WRAPPER-OF EARLY-METHOD-STANDARD-ACCESSOR-P + FUNCTION-PRETTY-ARGLIST GET-MAKE-INSTANCE-FUNCTION + CHECK-WRAPPER-VALIDITY UNPARSE-SPECIALIZERS + %SYMBOL-FUNCTION FINAL-ACCESSOR-DFUN-TYPE + COMPLICATED-INSTANCE-CREATION-METHOD DEFAULT-STRUCTUREP + UPDATE-GF-INFO CACHE-OWNER DEFAULT-STRUCTURE-INSTANCE-P + DEFAULT-STRUCTURE-TYPE STRUCTURE-TYPE + COMPUTE-STD-CPL-PHASE-2 GET-PV-CELL-FOR-CLASS + STRUCTURE-TYPE-INCLUDED-TYPE-NAME + STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST CACHE-P + STRUCTURE-SLOTD-NAME STRUCTURE-SLOTD-ACCESSOR-SYMBOL SFUN-P + DEFAULT-SECONDARY-DISPATCH-FUNCTION + STRUCTURE-SLOTD-WRITER-FUNCTION FIND-CYCLE-REASONS + EARLY-CLASS-DEFINITION ECD-SOURCE STRUCTURE-SLOTD-TYPE + FORMAT-CYCLE-REASONS ECD-METACLASS CPD-CLASS + EARLY-CLASS-PRECEDENCE-LIST + METHODS-CONTAIN-EQL-SPECIALIZER-P MAKE-TYPE-PREDICATE + CPD-SUPERS DEFAULT-TEST-CONVERTER EXPAND-LONG-DEFCOMBIN + INITIAL-P EARLY-CLASS-NAME-OF FORCE-CACHE-FLUSHES CPD-AFTER + EXPAND-SHORT-DEFCOMBIN MAKE-CALL-METHODS + DEFAULT-CONSTANT-CONVERTER EARLY-CLASS-SLOTDS + INITIAL-DISPATCH-P DISPATCH-P EARLY-SLOT-DEFINITION-NAME + SLOT-READER-SYMBOL GBOUNDP GMAKUNBOUND + EARLY-SLOT-DEFINITION-LOCATION WALKER::ENV-LOCK + DEFAULT-CONSTANTP MAKE-INITIAL-DFUN DEFAULT-METHOD-ONLY-P + FGEN-TEST EARLY-ACCESSOR-METHOD-SLOT-NAME + SLOT-WRITER-SYMBOL LOOKUP-FGEN WALKER::ENV-DECLARATIONS + ACCESSOR-DFUN-INFO-P WALKER::ENV-LEXICAL-VARIABLES + FGEN-GENERATOR FGEN-SYSTEM LIST-DFUN %FBOUNDP + SLOT-BOUNDP-SYMBOL ONE-INDEX-DFUN-INFO-P CCLOSUREP + MAP-ALL-GENERIC-FUNCTIONS FAST-METHOD-CALL-P + MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION N-N-P + EARLY-CLASS-DIRECT-SUBCLASSES FAST-INSTANCE-BOUNDP-P + MAKE-FUNCTION-INLINE METHOD-FUNCTION-PV-TABLE + LIST-LARGE-CACHE METHOD-FUNCTION-METHOD STORE-FGEN + CLASS-PRECEDENCE-DESCRIPTION-P ONE-CLASS-P + INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS + UNENCAPSULATED-FDEFINITION + MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION + METHOD-FUNCTION-NEEDS-NEXT-METHODS-P DFUN-INFO-P + MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + FTYPE-DECLARATION-FROM-LAMBDA-LIST NO-METHODS-P + WALKER::ENV-WALK-FUNCTION FGEN-GENSYMS + WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE + TWO-CLASS-P COUNT-DFUN ARG-INFO-LAMBDA-LIST + MAKE-INITFUNCTION ARG-INFO-PRECEDENCE + MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + ARG-INFO-METATYPES ITERATE::VARIABLES-FROM-LET + FGEN-GENERATOR-LAMBDA WALKER::ENV-WALK-FORM + ARG-INFO-NUMBER-OPTIONAL + MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION + ARG-INFO-KEY/REST-P INITIALIZE-INFO-P ONE-INDEX-P + ECD-CLASS-NAME ARG-INFO-KEYWORDS COPY-CACHE + GF-INFO-SIMPLE-ACCESSOR-TYPE COMPUTE-LINE-SIZE + GF-PRECOMPUTE-DFUN-AND-EMF-P CANONICAL-SLOT-NAME + GF-INFO-STATIC-C-A-M-EMF WALKER::GET-WALKER-TEMPLATE + CHECKING-P EARLY-CLASS-SLOTS GF-INFO-C-A-M-EMF-STD-P + STRUCTURE-TYPE-INTERNAL-SLOTDS GF-INFO-FAST-MF-P + UNDEFMETHOD-1 EARLY-COLLECT-CPL EARLY-COLLECT-SLOTS + ARG-INFO-P METHOD-LL->GENERIC-FUNCTION-LL + FAST-METHOD-CALL-ARG-INFO EARLY-COLLECT-DEFAULT-INITARGS + ARG-INFO-NKEYS ECD-SUPERCLASS-NAMES GF-DFUN-CACHE + GF-DFUN-INFO METHOD-CALL-P STRUCTURE-SLOT-BOUNDP + FUNCTION-RETURNING-NIL ITERATE::SEQUENCE-ACCESSOR + ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ECD-CANONICAL-SLOTS + EVAL-FORM ONE-INDEX-DFUN-INFO-INDEX ECD-OTHER-INITARGS + SLOT-INITARGS-FROM-STRUCTURE-SLOTD TYPE-CLASS + ONE-CLASS-WRAPPER0 EXTRACT-PARAMETERS CLASS-PREDICATE + EXTRACT-REQUIRED-PARAMETERS MAKE-CLASS-EQ-PREDICATE + TWO-CLASS-WRAPPER1 MAKE-EQL-PREDICATE CHECKING-FUNCTION + BOOTSTRAP-ACCESSOR-DEFINITIONS INITIALIZE-INFO-KEY + BOOTSTRAP-CLASS-PREDICATES GET-BUILT-IN-CLASS-SYMBOL + INITIALIZE-INFO-WRAPPER GET-BUILT-IN-WRAPPER-SYMBOL + DO-STANDARD-DEFSETF-1 CACHING-P GFS-OF-TYPE + LEGAL-CLASS-NAME-P STRUCTURE-TYPE-P CONSTANT-VALUE-P + USE-DEFAULT-METHOD-ONLY-DFUN-P + INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST + WRAPPER-FIELD NEXT-WRAPPER-FIELD SETFBOUNDP + GET-SETF-FUNCTION-NAME USE-CACHING-DFUN-P + MAKE-PV-TYPE-DECLARATION MAKE-CALLS-TYPE-DECLARATION + MAP-SPECIALIZERS SLOT-VECTOR-SYMBOL MAKE-PERMUTATION-VECTOR + VARIABLE-GLOBALLY-SPECIAL-P STRUCTURE-OBJECT-P + EXPAND-MAKE-INSTANCE-FORM MAKE-CONSTANT-FUNCTION + FUNCTION-RETURNING-T SORT-SLOTS SORT-CALLS SYMBOL-PKG-NAME + CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P + INITIALIZE-INFO-BOUND-SLOTS INITIALIZE-INFO-CACHED-VALID-P + GET-MAKE-INSTANCE-FUNCTIONS + INITIALIZE-INFO-CACHED-RI-VALID-P + INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST + INITIALIZE-INFO-CACHED-NEW-KEYS UPDATE-C-A-M-GF-INFO + INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION + UPDATE-GF-SIMPLE-ACCESSOR-TYPE UPDATE-GFS-OF-CLASS + INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION + DO-STANDARD-DEFSETFS-FOR-DEFCLASS STANDARD-SVUC-METHOD + INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION + %CCLOSURE-ENV STRUCTURE-SVUC-METHOD + INITIALIZE-INFO-CACHED-CONSTANTS CLASS-OF + METHOD-FUNCTION-PLIST + INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION + INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION + INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL + INTERNED-SYMBOL-P GDEFINITION UPDATE-CLASS-CAN-PRECEDE-P + %STD-INSTANCE-WRAPPER %STD-INSTANCE-SLOTS PV-TABLEP + STD-INSTANCE-P COMPUTE-MCASE-PARAMETERS COMPUTE-CLASS-SLOTS + MAKE-PV-TABLE-TYPE-DECLARATION INTERN-EQL-SPECIALIZER + NET-TEST-CONVERTER MAKE-INSTANCE-FUNCTION-SYMBOL + UPDATE-ALL-C-A-M-GF-INFO UPDATE-PV-TABLE-CACHE-INFO + DFUN-INFO-CACHE EXTRACT-LAMBDA-LIST NO-METHODS-CACHE + ARG-INFO-APPLYP CACHING-DFUN-COST INITIAL-CACHE + SYSTEM:%STRUCTURE-NAME INITIAL-DISPATCH-CACHE + SYSTEM:%COMPILED-FUNCTION-NAME CHECK-CACHE DISPATCH-CACHE + CLASS-FROM-TYPE DEFAULT-METHOD-ONLY-CACHE DNET-METHODS-P + ACCESSOR-DFUN-INFO-CACHE METHOD-FUNCTION-FROM-FAST-FUNCTION + ONE-INDEX-DFUN-INFO-CACHE ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE + METHOD-CALL-CALL-METHOD-ARGS KEYWORD-SPEC-NAME N-N-CACHE + GENERIC-CLOBBERS-FUNCTION N-N-ACCESSOR-TYPE + FAST-METHOD-CALL-PV-CELL WRAPPER-FOR-STRUCTURE + ONE-CLASS-CACHE EXTRACT-SPECIALIZER-NAMES + FAST-METHOD-CALL-NEXT-METHOD-CALL ONE-CLASS-ACCESSOR-TYPE + ONE-CLASS-INDEX BUILT-IN-WRAPPER-OF TWO-CLASS-CACHE + BUILT-IN-OR-STRUCTURE-WRAPPER1 TWO-CLASS-ACCESSOR-TYPE + TWO-CLASS-INDEX GET-MAKE-INSTANCE-FUNCTION-SYMBOL + ALLOCATE-CACHE-VECTOR TWO-CLASS-WRAPPER0 + FLUSH-CACHE-VECTOR-INTERNAL ONE-INDEX-CACHE + EARLY-CLASS-NAME ONE-INDEX-ACCESSOR-TYPE ONE-INDEX-INDEX + INTERN-FUNCTION-NAME CHECKING-CACHE)) +(PROCLAIM + '(FTYPE (FUNCTION (T *) *) COERCE-TO-CLASS GET-METHOD-FUNCTION + GET-FUNCTION GET-FUNCTION1 PARSE-METHOD-OR-SPEC + EXTRACT-DECLARATIONS GET-DFUN-CONSTRUCTOR MAP-ALL-CLASSES + MAKE-CACHING-DFUN MAKE-METHOD-FUNCTION-INTERNAL + PARSE-SPECIALIZED-LAMBDA-LIST MAKE-METHOD-LAMBDA-INTERNAL + MAKE-CONSTANT-VALUE-DFUN MAKE-FINAL-DFUN-INTERNAL + COMPILE-LAMBDA WALK-FORM MACROEXPAND-ALL ENSURE-CLASS + ENSURE-GENERIC-FUNCTION DISPATCH-DFUN-COST)) +(PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) SYMBOL-APPEND)) +(PROCLAIM + '(FTYPE (FUNCTION (T *) T) CAPITALIZE-WORDS + INITIALIZE-INTERNAL-SLOT-GFS FIND-CLASS + MAKE-TYPE-PREDICATE-NAME SET-DFUN TRACE-METHOD + FIND-CLASS-CELL MAKE-FINAL-DFUN PV-TABLE-LOOKUP-PV-ARGS + USE-DISPATCH-DFUN-P WALKER::RELIST* WALKER::RELIST + FIND-CLASS-PREDICATE EARLY-METHOD-SPECIALIZERS + USE-CONSTANT-VALUE-DFUN-P MAKE-EARLY-GF + ALLOCATE-FUNCALLABLE-INSTANCE SET-ARG-INFO + INITIALIZE-METHOD-FUNCTION UPDATE-DFUN MAKE-SPECIALIZABLE + ALLOCATE-STRUCTURE-INSTANCE ALLOCATE-STANDARD-INSTANCE + WALKER::WALKER-ENVIRONMENT-BIND-1 + ITERATE::FUNCTION-LAMBDA-P ITERATE::MAYBE-WARN + MAKE-WRAPPER)) +(PROCLAIM + '(FTYPE (FUNCTION (T T) *) SLOT-BOUNDP SLOT-VALUE SAUT-CLASS + SPECIALIZER-APPLICABLE-USING-TYPE-P COMPUTE-TEST + GET-NEW-FUNCTION-GENERATOR-INTERNAL COMPUTE-CODE + CLASS-APPLICABLE-USING-CLASS-P SAUT-AND SAUT-NOT + SAUT-PROTOTYPE DESTRUCTURE ENSURE-CLASS-VALUES + MAKE-DIRECT-SLOTD SLOT-MAKUNBOUND + MAKE-INSTANCE-FUNCTION-TRAP + GENERATE-FAST-CLASS-SLOT-ACCESS-P MUTATE-SLOTS-AND-CALLS + INVOKE-EMF EMIT-DEFAULT-ONLY-FUNCTION SPLIT-DECLARATIONS + EMIT-DEFAULT-ONLY SLOT-NAME-LISTS-FROM-SLOTS EMIT-CHECKING + UPDATE-SLOT-VALUE-GF-INFO EMIT-CACHING SDFUN-FOR-CACHING + SLOT-UNBOUND-INTERNAL MAKE-INSTANCE-1 SET-FUNCTION-NAME + COMPUTE-STD-CPL-PHASE-1 FORM-LIST-TO-LISP + FIND-SUPERCLASS-CHAIN SAUT-CLASS-EQ + COMPUTE-APPLICABLE-METHODS-USING-TYPES + CHECK-INITARGS-VALUES SAUT-EQL INSURE-DFUN *SUBTYPEP + ITERATE::PARSE-DECLARATIONS INITIAL-DFUN)) +(PROCLAIM + '(FTYPE (FUNCTION (T T) T) ADD-METHOD DO-SATISFIES-DEFTYPE + MEMF-CONSTANT-CONVERTER COMPUTE-CONSTANTS + CLASS-CAN-PRECEDE-P SAUT-NOT-CLASS SAUT-NOT-CLASS-EQ + SAUT-NOT-PROTOTYPE GF-MAKE-FUNCTION-FROM-EMF SAUT-NOT-EQL + SUPERCLASSES-COMPATIBLE-P CLASSES-HAVE-COMMON-SUBCLASS-P + DESCRIBE-PACKAGE PRINTING-RANDOM-THING-INTERNAL + MAKE-CLASS-PREDICATE METHOD-FUNCTION-RETURNING-NIL + METHOD-FUNCTION-RETURNING-T VARIABLE-CLASS MAKE-PLIST + REMTAIL DESTRUCTURE-INTERNAL ACCESSOR-MISS-FUNCTION + UPDATE-INITIALIZE-INFO-INTERNAL N-N-DFUN-INFO MAKE-CAXR + MAKE-CDXR CHECKING-DFUN-INFO + FUNCALLABLE-STANDARD-INSTANCE-ACCESS MAKE-PV-TABLE-INTERNAL + FIND-SLOT-DEFINITION WALKER::WALK-REPEAT-EVAL + WALKER::NOTE-DECLARATION MAKE-DFUN-LAMBDA-LIST + WALKER::NOTE-LEXICAL-BINDING MAKE-DLAP-LAMBDA-LIST + ADD-DIRECT-SUBCLASSES COMPUTE-PV MAKE-DFUN-ARG-LIST + COMPUTE-CALLS MAKE-FAST-METHOD-CALL-LAMBDA-LIST + UPDATE-ALL-PV-TABLE-CACHES UPDATE-CLASS + MAP-PV-TABLE-REFERENCES-OF ADD-SLOT-ACCESSORS + WALKER::ENVIRONMENT-FUNCTION REMOVE-DIRECT-SUBCLASSES + REMOVE-SLOT-ACCESSORS SYMBOL-LESSP SYMBOL-OR-CONS-LESSP + |SETF PCL FIND-CLASS| |SETF PCL FIND-CLASS-PREDICATE| + PV-WRAPPERS-FROM-ALL-ARGS PV-TABLE-LOOKUP + PROCLAIM-DEFGENERIC UPDATE-CPL LIST-EQ UPDATE-SLOTS + COMPUTE-APPLICABLE-METHODS-FUNCTION VARIABLE-LEXICAL-P + VARIABLE-SPECIAL-P UPDATE-INITS UPDATE-STD-OR-STR-METHODS + SET-STANDARD-SVUC-METHOD EMIT-1-NIL-DLAP PLIST-VALUE + SET-STRUCTURE-SVUC-METHOD + EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION + MEC-ALL-CLASSES-INTERNAL + EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION + MEC-ALL-CLASSES %SET-CCLOSURE-ENV MEC-ALL-CLASS-LISTS + REDEFINE-FUNCTION METHODS-CONVERTER COMPUTE-LAYOUT NO-SLOT + PV-WRAPPERS-FROM-ALL-WRAPPERS NET-CONSTANT-CONVERTER + AUGMENT-TYPE CHANGE-CLASS-INTERNAL VALUE-FOR-CACHING + |SETF PCL METHOD-FUNCTION-PLIST| GET-KEY-ARG GET-KEY-ARG1 + SET-METHODS SET-FUNCTION-PRETTY-ARGLIST + FIND-STANDARD-II-METHOD MAKE-EARLY-ACCESSOR + DOCTOR-DFUN-FOR-THE-DEBUGGER COMPUTE-STD-CPL + |SETF PCL GDEFINITION| MAKE-DISCRIMINATING-FUNCTION-ARGLIST + ADD-FORMS CPL-INCONSISTENT-ERROR + REDIRECT-EARLY-FUNCTION-INTERNAL ADD-TO-CVECTOR + BOOTSTRAP-SLOT-INDEX QUALIFIER-CHECK-RUNTIME + CPL-FORWARD-REFERENCED-CLASS-ERROR REAL-REMOVE-METHOD + WALKER::ENVIRONMENT-MACRO CANONICALIZE-SLOT-SPECIFICATION + CANONICALIZE-DEFCLASS-OPTION SET-WRAPPER + DEAL-WITH-ARGUMENTS-OPTION PARSE-QUALIFIER-PATTERN + SWAP-WRAPPERS-AND-SLOTS ITERATE::MV-SETQ + MAKE-UNORDERED-METHODS-EMF CLASS-MIGHT-PRECEDE-P + ITERATE::EXTRACT-SPECIAL-BINDINGS + WALKER::VARIABLE-SYMBOL-MACRO-P RAISE-METATYPE + SLOT-EXISTS-P PROCLAIM-DEFMETHOD STANDARD-INSTANCE-ACCESS + REMOVE-METHOD + SET-FUNCALLABLE-INSTANCE-FUNCTION + SYSTEM:%SET-COMPILED-FUNCTION-NAME FDEFINE-CAREFULLY + MAKE-INTERNAL-READER-METHOD-FUNCTION + MAKE-STD-READER-METHOD-FUNCTION + MAKE-STD-WRITER-METHOD-FUNCTION + ITERATE::SIMPLE-EXPAND-ITERATE-FORM + MAKE-STD-BOUNDP-METHOD-FUNCTION)) +(PROCLAIM '(FTYPE (FUNCTION NIL FIXNUM) GET-WRAPPER-CACHE-NUMBER)) +(IN-PACKAGE "PCL") + +(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| + |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| + |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| + |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| + |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| + |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| + ADD-READER-METHOD + SHORT-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT + REMOVE-READER-METHOD |LISP::T class predicate| + EQL-SPECIALIZER-P |(SETF GENERIC-FUNCTION-NAME)| + OBJECT-PLIST SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL + |PCL::STANDARD-OBJECT class predicate| + |PCL::STANDARD-SLOT-DEFINITION class predicate| + |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate| + |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate| + |PCL::STANDARD-METHOD-COMBINATION class predicate| + |(FAST-READER-METHOD SLOT-OBJECT METHOD)| + |PCL::BUILT-IN-CLASS class predicate| SPECIALIZER-TYPE + |LISP::RATIO class predicate| + |LISP::RATIONAL class predicate| GF-DFUN-STATE + |(SETF GENERIC-FUNCTION-METHOD-CLASS)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| + |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| + |(SETF GENERIC-FUNCTION-METHOD-COMBINATION)| + CLASS-DEFSTRUCT-CONSTRUCTOR + |(FAST-READER-METHOD SLOT-OBJECT SOURCE)| + |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)| + METHOD-FAST-FUNCTION |(SETF GENERIC-FUNCTION-METHODS)| + |(SETF GF-PRETTY-ARGLIST)| + |(FAST-READER-METHOD SLOT-OBJECT INITIALIZE-INFO)| + |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)| + |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + SPECIALIZERP EXACT-CLASS-SPECIALIZER-P + |(FAST-READER-METHOD SLOT-OBJECT WRAPPER)| + |(FAST-READER-METHOD PCL-CLASS WRAPPER)| + |(FAST-READER-METHOD SLOT-OBJECT INITARGS)| + |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-READER-METHOD SHORT-METHOD-COMBINATION OPERATOR)| + |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| + |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| + |LISP::CHARACTER class predicate| + COMPATIBLE-META-CLASS-CHANGE-P + |LISP::SEQUENCE class predicate| + |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| + |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| + |(BOUNDP READER-FUNCTION)| |(BOUNDP PREDICATE-NAME)| + |(BOUNDP READERS)| UPDATE-GF-DFUN + |(BOUNDP CLASS-PRECEDENCE-LIST)| + |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| + |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT + |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| + ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| + |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| + SPECIALIZER-CLASS |(BOUNDP PRETTY-ARGLIST)| + |PCL::PCL-CLASS class predicate| + |PCL::STD-CLASS class predicate| + |(BOUNDP DEFSTRUCT-FORM)| + |(SETF SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL)| + CLASS-EQ-SPECIALIZER-P + |(FAST-BOUNDP-METHOD SLOT-OBJECT SOURCE)| SLOTS-FETCHER + |(SETF SLOT-ACCESSOR-STD-P)| REMOVE-WRITER-METHOD + |(BOUNDP WRITER-FUNCTION)| |(BOUNDP INITFUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITIALIZE-INFO)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)| + STRUCTURE-CLASS-P |(BOUNDP WRITERS)| + |(BOUNDP INITFORM)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT WRAPPER)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITARGS)| + |LISP::BIT-VECTOR class predicate| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| + UPDATE-CONSTRUCTORS |(BOUNDP SLOT-NAME)| + |(SETF SLOT-DEFINITION-INITARGS)| |(BOUNDP ALLOCATION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| + DOCUMENTATION |(BOUNDP FUNCTION)| + |(BOUNDP GENERIC-FUNCTION)| |(BOUNDP LAMBDA-LIST)| + METHOD-PRETTY-ARGLIST |(BOUNDP SLOT-DEFINITION)| + |LISP::ARRAY class predicate| + |(BOUNDP CAN-PRECEDE-LIST)| |(BOUNDP PROTOTYPE)| + CLASS-EQ-SPECIALIZER INFORM-TYPE-SYSTEM-ABOUT-CLASS + |PCL::DEFINITION-SOURCE-MIXIN class predicate| + |(BOUNDP DFUN-STATE)| |(BOUNDP FROM-DEFCLASS-P)| + |(READER METHOD)| + |(CALL STANDARD-COMPUTE-EFFECTIVE-METHOD)| + |(BOUNDP FAST-FUNCTION)| + |LISP::COMPLEX class predicate| |(BOUNDP METHOD-CLASS)| + |(READER SOURCE)| |(BOUNDP INTERNAL-WRITER-FUNCTION)| + |(BOUNDP INTERNAL-READER-FUNCTION)| + |(BOUNDP METHOD-COMBINATION)| ACCESSOR-METHOD-CLASS + |(BOUNDP DIRECT-SLOTS)| |(BOUNDP DIRECT-METHODS)| + |(BOUNDP BOUNDP-FUNCTION)| |(BOUNDP DIRECT-SUBCLASSES)| + |(BOUNDP DIRECT-SUPERCLASSES)| |(BOUNDP METHODS)| + |(BOUNDP OPTIONS)| |(WRITER METHOD)| + |PCL::DEPENDENT-UPDATE-MIXIN class predicate| + GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| + |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| + |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| + |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| + |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| + |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| + |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| + |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| + MAKE-BOUNDP-METHOD-FUNCTION + |LISP::STRING class predicate| + |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| + |PCL::METAOBJECT class predicate| + |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| + |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| + |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| + |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| + |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| + |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| + |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| + |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| + |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| + |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| + |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| + |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| + |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| + |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| + |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| + |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| + |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| + |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| + |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| + |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| + |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| + |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| + |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| + |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| + |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| + |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| + |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| + |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| + |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| + |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| + |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| + |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| + |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| + |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| + |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| + |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| + |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| + |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| + |(FAST-METHOD MAKE-INSTANCE (CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| + |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| + |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| + CLASS-PREDICATE-NAME + |PCL::STRUCTURE-OBJECT class predicate| + |PCL::STRUCTURE-SLOT-DEFINITION class predicate| + |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| + |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate| + |LISP::SYMBOL class predicate| CLASSP + |PCL::EFFECTIVE-SLOT-DEFINITION class predicate| + |(COMBINED-METHOD SHARED-INITIALIZE)| + LEGAL-QUALIFIERS-P ADD-BOUNDP-METHOD + LEGAL-LAMBDA-LIST-P |LISP::VECTOR class predicate| + |SETF PCL GENERIC-FUNCTION-NAME| + |(READER READER-FUNCTION)| |(READER PREDICATE-NAME)| + |(READER READERS)| DESCRIBE-OBJECT + |(READER CLASS-PRECEDENCE-LIST)| + |(READER ACCESSOR-FLAGS)| |(READER LOCATION)| + |(READER DOCUMENTATION)| CLASS-INITIALIZE-INFO + |(SETF CLASS-SLOT-VALUE)| MAKE-WRITER-METHOD-FUNCTION + |SETF PCL GF-DFUN-STATE| + |(READER INCOMPATIBLE-SUPERCLASS-LIST)| + |(READER SPECIALIZERS)| + |(READER IDENTITY-WITH-ONE-ARGUMENT)| + |(SETF CLASS-INITIALIZE-INFO)| + |(READER PRETTY-ARGLIST)| |(READER DEFSTRUCT-FORM)| + |SETF PCL SLOT-DEFINITION-NAME| |SETF PCL CLASS-NAME| + |(WRITER READER-FUNCTION)| + |(SETF CLASS-DEFSTRUCT-CONSTRUCTOR)| + |(WRITER PREDICATE-NAME)| |(WRITER READERS)| + |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| + INITIALIZE-INTERNAL-SLOT-FUNCTIONS + |SETF PCL SLOT-DEFINITION-TYPE| + |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| + |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| + METHOD-COMBINATION-P |(WRITER LOCATION)| + |(WRITER DOCUMENTATION)| + |(CALL REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION)| + |SETF PCL GENERIC-FUNCTION-METHODS| + |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION| + |SETF PCL METHOD-GENERIC-FUNCTION| |(READER SLOT-NAME)| + |(WRITER INCOMPATIBLE-SUPERCLASS-LIST)| + |SETF PCL SLOT-ACCESSOR-STD-P| + |(CALL REAL-MAKE-METHOD-INITARGS-FORM)| + |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| + |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| + |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| + |(SETF METHOD-GENERIC-FUNCTION)| + |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P + |SETF PCL OBJECT-PLIST| |LISP::FLOAT class predicate| + |(WRITER DEFSTRUCT-FORM)| |(READER FUNCTION)| + |(READER GENERIC-FUNCTION)| |(READER LAMBDA-LIST)| + |(READER SLOT-DEFINITION)| + |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate| + |SETF PCL SLOT-DEFINITION-INITFORM| + |SETF PCL CLASS-DEFSTRUCT-FORM| + |(READER CAN-PRECEDE-LIST)| + |SETF PCL GENERIC-FUNCTION-METHOD-CLASS| + |(READER PROTOTYPE)| |(WRITER WRITER-FUNCTION)| + |(WRITER INITFUNCTION)| |(WRITER WRITERS)| + SLOT-ACCESSOR-STD-P |(WRITER INITFORM)| + |(READER DFUN-STATE)| |(READER FROM-DEFCLASS-P)| + |SETF PCL GF-PRETTY-ARGLIST| + |SETF PCL SLOT-ACCESSOR-FUNCTION| + |SETF PCL SLOT-DEFINITION-LOCATION| + |SETF PCL SLOT-DEFINITION-READER-FUNCTION| + |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION| + |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION| + |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION| + |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION| + |SETF PCL SLOT-DEFINITION-ALLOCATION| + |SETF PCL SLOT-DEFINITION-INITFUNCTION| + |(WRITER SLOT-NAME)| |(BOUNDP NAME)| + |(WRITER ALLOCATION)| |(READER FAST-FUNCTION)| + |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| + |(READER INTERNAL-WRITER-FUNCTION)| + |(READER INTERNAL-READER-FUNCTION)| + |(READER METHOD-COMBINATION)| + METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| + |(READER DIRECT-METHODS)| + |SETF PCL SLOT-DEFINITION-READERS| + |(READER BOUNDP-FUNCTION)| |(WRITER FUNCTION)| + |(WRITER GENERIC-FUNCTION)| + |(READER DIRECT-SUBCLASSES)| + |(READER DIRECT-SUPERCLASSES)| |SETF PCL DOCUMENTATION| + |(WRITER LAMBDA-LIST)| |LISP::LIST class predicate| + FUNCALLABLE-STANDARD-CLASS-P + |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| + |(BOUNDP CLASS)| |(WRITER SLOT-DEFINITION)| + |(READER METHODS)| |(READER OPTIONS)| + |(WRITER CAN-PRECEDE-LIST)| + |SETF PCL SLOT-DEFINITION-CLASS| + |SETF PCL SLOT-VALUE-USING-CLASS| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| + |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| + |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| + CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| + |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION + |(BOUNDP PLIST)| + |SETF PCL CLASS-INCOMPATIBLE-SUPERCLASS-LIST| + |SETF PCL SLOT-DEFINITION-WRITERS| + |(FAST-WRITER-METHOD SLOT-OBJECT SOURCE)| + |(WRITER DFUN-STATE)| |(WRITER FROM-DEFCLASS-P)| + |(BOUNDP SLOTS)| SLOT-CLASS-P + MAKE-READER-METHOD-FUNCTION LEGAL-METHOD-FUNCTION-P + |(FAST-WRITER-METHOD SLOT-OBJECT INITIALIZE-INFO)| + |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)| + |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| + |PCL::PLIST-MIXIN class predicate| + |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| + |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| + |(WRITER INTERNAL-WRITER-FUNCTION)| + |(WRITER INTERNAL-READER-FUNCTION)| + |(WRITER METHOD-COMBINATION)| GET-METHOD + |(WRITER DIRECT-SLOTS)| |(WRITER DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| + |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| + |(WRITER BOUNDP-FUNCTION)| |(WRITER DIRECT-SUBCLASSES)| + |(WRITER DIRECT-SUPERCLASSES)| + |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| + |(WRITER METHODS)| |(WRITER OPTIONS)| + SHORT-METHOD-COMBINATION-P GF-ARG-INFO + SPECIALIZER-METHOD-TABLE MAKE-METHOD-INITARGS-FORM + CLASS-DEFSTRUCT-FORM |LISP::INTEGER class predicate| + |(FAST-READER-METHOD SLOT-OBJECT PREDICATE-NAME)| + |(FAST-READER-METHOD CLASS PREDICATE-NAME)| + |(FAST-READER-METHOD CLASS NAME)| + |(FAST-READER-METHOD SLOT-DEFINITION NAME)| + |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)| + |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)| + |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| + |(FAST-READER-METHOD SLOT-OBJECT NAME)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)| + GF-PRETTY-ARGLIST SAME-SPECIALIZER-P + SLOT-DEFINITION-BOUNDP-FUNCTION + SLOT-DEFINITION-WRITER-FUNCTION + SLOT-DEFINITION-READER-FUNCTION + SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION + SLOT-DEFINITION-INTERNAL-READER-FUNCTION + |(FAST-READER-METHOD SLOT-OBJECT CLASS)| + |(FAST-READER-METHOD SLOT-DEFINITION CLASS)| + |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| + |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| + |(FAST-READER-METHOD TRACED-METHOD GENERIC-FUNCTION)| + |(FAST-READER-METHOD TRACED-METHOD FUNCTION)| + |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)| + |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)| + |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| + |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| + |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| + |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| + |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)| + |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)| + |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT LOCATION)| + |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| + |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)| + |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| + |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| + |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)| + |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)| + |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| + |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)| + |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)| + |(FAST-READER-METHOD SLOT-OBJECT WRITERS)| + |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)| + |(FAST-READER-METHOD SLOT-OBJECT READERS)| + |(FAST-READER-METHOD SLOT-DEFINITION READERS)| + |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| + |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD SPECIALIZER TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| + |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| + |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| + |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT TYPE)| + |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| + |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| + |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)| + |(FAST-READER-METHOD SLOT-OBJECT PLIST)| + |(FAST-READER-METHOD PLIST-MIXIN PLIST)| + |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| + |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| + |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| + |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)| + |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| + |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)| + |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)| + |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)| + |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-READER-METHOD SLOT-OBJECT SLOTS)| + |(FAST-READER-METHOD SLOT-CLASS SLOTS)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| + |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| + |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-READER-METHOD SLOT-OBJECT METHODS)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| + |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| + |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)| + SLOT-DEFINITION-CLASS EQL-SPECIALIZER-OBJECT + |PCL::DIRECT-SLOT-DEFINITION class predicate| + CLASS-CONSTRUCTORS |(BOUNDP WRAPPER)| SLOTS-TO-INSPECT + |(FAST-BOUNDP-METHOD SLOT-OBJECT PREDICATE-NAME)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)| + |(BOUNDP DEFSTRUCT-ACCESSOR-SYMBOL)| + SPECIALIZER-DIRECT-GENERIC-FUNCTIONS + |(BOUNDP CLASS-EQ-SPECIALIZER)| + |(SETF SLOT-DEFINITION-NAME)| ADD-WRITER-METHOD + |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)| + |(BOUNDP OPERATOR)| |(BOUNDP ARG-INFO)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| + |(SETF SLOT-VALUE-USING-CLASS)| + |(SETF SLOT-DEFINITION-CLASS)| + |(SETF SLOT-ACCESSOR-FUNCTION)| + |(SETF SLOT-DEFINITION-INITFUNCTION)| + |(SETF SLOT-DEFINITION-ALLOCATION)| + |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)| + |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)| + |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)| + |(SETF SLOT-DEFINITION-WRITER-FUNCTION)| + |(SETF SLOT-DEFINITION-READER-FUNCTION)| + |(SETF SLOT-DEFINITION-LOCATION)| + |(BOUNDP DEFSTRUCT-CONSTRUCTOR)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PLIST)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)| + |(SETF SLOT-DEFINITION-WRITERS)| + |(SETF SLOT-DEFINITION-READERS)| + |(SETF SLOT-DEFINITION-TYPE)| + |(SETF SLOT-DEFINITION-INITFORM)| + |(BOUNDP INITIALIZE-INFO)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| + |(FAST-INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION + GENERIC-FUNCTION-P + |PCL::SLOT-DEFINITION class predicate| + |LISP::NULL class predicate| |(READER NAME)| + |(READER CLASS)| + |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| + |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| + |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| + |(FAST-METHOD DESCRIBE-OBJECT (T T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| + |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| + |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| + |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| + |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| + |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| + |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| + |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| + |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| + |(FAST-METHOD PRINT-OBJECT (CLASS T))| + |(FAST-METHOD PRINT-OBJECT (T T))| + |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| + |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| + |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| + |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| + |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| + |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| + |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| + |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| + |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| + |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| + |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| + |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| + |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| + |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| + |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| + |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| + |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| + |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| + |(FAST-METHOD (SETF DOCUMENTATION) (T T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| + |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| + |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| + |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| + |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| + |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| + |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| + |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| + |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| + |(FAST-METHOD SLOT-UNBOUND (T T T))| + |(FAST-METHOD SLOT-MISSING (T T T T))| + |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| + |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| + LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| + CLASS-WRAPPER |(READER PLIST)| + |(FAST-METHOD CLASS-PREDICATE-NAME (T))| + |(FAST-METHOD DOCUMENTATION (T))| + |(FAST-METHOD NO-APPLICABLE-METHOD (T))| + |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE + |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS + |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| + |(WRITER TYPE)| + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| + |(WRITER PLIST)| |(WRITER SLOTS)| + |PCL::DOCUMENTATION-MIXIN class predicate| + FORWARD-REFERENCED-CLASS-P GF-FAST-METHOD-FUNCTION-P + LEGAL-QUALIFIER-P METHOD-P + |PCL::SPECIALIZER-WITH-OBJECT class predicate| + CLASS-SLOT-CELLS + |(COMBINED-METHOD INITIALIZE-INSTANCE)| + |(COMBINED-METHOD REINITIALIZE-INSTANCE)| + STANDARD-ACCESSOR-METHOD-P |(SETF CLASS-NAME)| + STANDARD-GENERIC-FUNCTION-P STANDARD-READER-METHOD-P + STANDARD-METHOD-P |(READER WRAPPER)| + |(READER DEFSTRUCT-ACCESSOR-SYMBOL)| + |(READER CLASS-EQ-SPECIALIZER)| + COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS + COMPUTE-DEFAULT-INITARGS |(SETF CLASS-DEFSTRUCT-FORM)| + |(CALL REAL-MAKE-METHOD-LAMBDA)| + |(SETF CLASS-INCOMPATIBLE-SUPERCLASS-LIST)| + |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)| + |(SETF CLASS-DIRECT-SLOTS)| |(READER OPERATOR)| + |(CALL REAL-GET-METHOD)| |(CALL REAL-REMOVE-METHOD)| + |(CALL REAL-ADD-METHOD)| |(READER ARG-INFO)| + METHOD-COMBINATION-TYPE + |(READER DEFSTRUCT-CONSTRUCTOR)| + |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)| + STANDARD-CLASS-P |LISP::NUMBER class predicate| + LEGAL-SPECIALIZER-P + |PCL::LONG-METHOD-COMBINATION class predicate| + |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| + COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| + |(WRITER CLASS-EQ-SPECIALIZER)| + STANDARD-BOUNDP-METHOD-P |(SETF DOCUMENTATION)| + RAW-INSTANCE-ALLOCATOR + |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| + |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| + |(WRITER ARG-INFO)| + COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO + STANDARD-WRITER-METHOD-P + CLASS-INCOMPATIBLE-SUPERCLASS-LIST + |(WRITER DEFSTRUCT-CONSTRUCTOR)| + |PCL::TRACED-METHOD class predicate| WRAPPER-FETCHER + MAKE-A-METHOD |(WRITER INITIALIZE-INFO)| + METHOD-COMBINATION-DOCUMENTATION + |SETF PCL SLOT-DEFINITION-INITARGS| + REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD + |LISP::CONS class predicate| |(WRITER INITARGS)| + |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| + |(BOUNDP METHOD)| + |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| + |(FAST-WRITER-METHOD CLASS NAME)| + |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| + |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)| + |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| + |(FAST-WRITER-METHOD SLOT-OBJECT NAME)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)| + |(BOUNDP SOURCE)| |(SETF GF-DFUN-STATE)| + SHORT-COMBINATION-OPERATOR + |(FAST-WRITER-METHOD SLOT-OBJECT CLASS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)| + |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| + |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| + |(FAST-WRITER-METHOD TRACED-METHOD GENERIC-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)| + |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)| + |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| + |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| + |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| + |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| + |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)| + |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)| + |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)| + |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| + |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| + |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| + |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)| + |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| + |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)| + |(FAST-WRITER-METHOD SLOT-OBJECT WRITERS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| + |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| + |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| + REMOVE-NAMED-METHOD + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)| + |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)| + |(FAST-WRITER-METHOD SLOT-OBJECT PLIST)| + |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)| + |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| + |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| + |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| + |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| + |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)| + |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| + LEGAL-DOCUMENTATION-P CLASS-DIRECT-SUPERCLASSES + CLASS-DIRECT-SUBCLASSES CLASS-DIRECT-DEFAULT-INITARGS + SLOT-DEFINITION-READERS SLOT-VALUE-USING-CLASS + COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASS-PROTOTYPE + READER-METHOD-CLASS REMOVE-METHOD + SLOT-DEFINITION-INITFORM + UPDATE-INSTANCE-FOR-REDEFINED-CLASS + UPDATE-INSTANCE-FOR-DIFFERENT-CLASS CHANGE-CLASS + METHOD-FUNCTION DIRECT-SLOT-DEFINITION-CLASS + MAKE-METHOD-LAMBDA EFFECTIVE-SLOT-DEFINITION-CLASS + CLASS-SLOTS COMPUTE-SLOTS SLOT-DEFINITION-NAME + FINALIZE-INHERITANCE GENERIC-FUNCTION-LAMBDA-LIST + CLASS-DIRECT-SLOTS CLASS-DEFAULT-INITARGS + COMPUTE-DISCRIMINATING-FUNCTION CLASS-FINALIZED-P + GENERIC-FUNCTION-NAME REMOVE-DEPENDENT + COMPUTE-CLASS-PRECEDENCE-LIST ADD-DEPENDENT + SLOT-BOUNDP-USING-CLASS ACCESSOR-METHOD-SLOT-DEFINITION + SHARED-INITIALIZE ADD-DIRECT-METHOD + SLOT-DEFINITION-LOCATION SLOT-DEFINITION-INITFUNCTION + SLOT-DEFINITION-ALLOCATION ADD-METHOD + GENERIC-FUNCTION-METHOD-CLASS METHOD-SPECIALIZERS + SLOT-DEFINITION-INITARGS WRITER-METHOD-CLASS + ADD-DIRECT-SUBCLASS SPECIALIZER-DIRECT-METHODS + GENERIC-FUNCTION-METHOD-COMBINATION ALLOCATE-INSTANCE + COMPUTE-EFFECTIVE-METHOD SLOT-DEFINITION-TYPE + SLOT-UNBOUND INITIALIZE-INSTANCE FUNCTION-KEYWORDS + REINITIALIZE-INSTANCE VALIDATE-SUPERCLASS + GENERIC-FUNCTION-METHODS REMOVE-DIRECT-METHOD + METHOD-LAMBDA-LIST MAKE-INSTANCE + COMPUTE-EFFECTIVE-SLOT-DEFINITION PRINT-OBJECT + METHOD-QUALIFIERS METHOD-GENERIC-FUNCTION + REMOVE-DIRECT-SUBCLASS MAKE-INSTANCES-OBSOLETE + SLOT-MAKUNBOUND-USING-CLASS + ENSURE-GENERIC-FUNCTION-USING-CLASS SLOT-MISSING + MAP-DEPENDENTS UPDATE-DEPENDENT FIND-METHOD-COMBINATION + ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD + SLOT-DEFINITION-WRITERS + COMPUTE-APPLICABLE-METHODS-USING-CLASSES + CLASS-PRECEDENCE-LIST)) + (SETF (GET V 'COMPILER::PROCLAIMED-CLOSURE) T)) diff --git a/pcl/impl/gold-hill/gold-low.lisp b/pcl/impl/gold-hill/gold-low.lisp new file mode 100644 index 0000000..ee47b6f --- /dev/null +++ b/pcl/impl/gold-hill/gold-low.lisp @@ -0,0 +1,51 @@ +;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; +;;; + +(in-package 'pcl) + +;;; fix a bug in gcl macro-expander (or->cond->or->cond->...) +(setf (get 'cond 'lisp::macro-expander) nil) + +;;; fix another bug in gcl3_0 case macro-expander +(defun lisp::eqv (a b) (eql a b)) + +(defun printing-random-thing-internal (thing stream) + (multiple-value-bind (offaddr baseaddr) + (sys:%pointer thing) + (princ baseaddr stream) + (princ ", " stream) + (princ offaddr stream))) + +;;; +;;; This allows the compiler to compile a file with many "DEFMETHODS" +;;; in succession. +;;; +(dolist (x '(defmethod defgeneric defclass precompile-random-code-segments)) + (setf (get x 'gcl::compile-separately) t)) + diff --git a/pcl/impl/gold-hill/gold-patches.lisp b/pcl/impl/gold-hill/gold-patches.lisp new file mode 100644 index 0000000..9f6f4e7 --- /dev/null +++ b/pcl/impl/gold-hill/gold-patches.lisp @@ -0,0 +1,168 @@ +;;; -*- Mode:Lisp; Package:USER; Base:10; Syntax:Common-lisp -*- + +(in-package 'user) + +(setq c::optimize-speed 3) +(setq c::optimize-safety 0) +(setq c::optimize-space 0) + +(remprop 'macroexpand 'c::fdesc) +(remprop 'macroexpand-1 'c::fdesc) + + +;;; this is here to fix the printer so it will find the print +;;; functions on structures that have 'em. + +(in-package 'lisp) + +(defun %write-structure (struct output-stream print-vars level) + (let* ((name (svref struct 0)) + (pfun (or (let ((temp (get name 'structure-descriptor))) + (and temp (dd-print-function temp))) + (get name :print-function)))) + (declare (symbol name)) + (cond + (pfun + (funcall pfun struct output-stream level)) + ((and (pv-level print-vars) (>= level (pv-level print-vars))) + (write-char #\# output-stream)) + ((and (pv-circle print-vars) + (%write-circle struct output-stream (pv-circle print-vars)))) + (t + (let ((pv-length (pv-length print-vars)) + (pv-pretty (pv-pretty print-vars))) + (when pv-pretty + (pp-push-level pv-pretty)) + (incf level) + (write-string "#s(" output-stream) + (cond + ((and pv-length (>= 0 pv-length)) + (write-string "...")) + (t + (%write-symbol name output-stream print-vars) + (do ((i 0 (1+ i)) + (n 0) + (slots (dd-slots (get name 'structure-descriptor)) + (rest slots))) + ((endp slots)) + (declare (fixnum i n) (list slots)) + (when pv-pretty + (pp-insert-break pv-pretty *structure-keyword-slot-spec* t)) + (write-char #\space output-stream) + (when (and pv-length (>= (incf n) pv-length)) + (write-string "..." output-stream) + (return)) + (write-char #\: output-stream) + (%write-symbol-name + (symbol-name (dsd-name (first slots))) output-stream print-vars) + (when pv-pretty + (pp-insert-break pv-pretty *structure-data-slot-spec* nil)) + (write-char #\space output-stream) + (when (and pv-length (>= (incf n) pv-length)) + (write-string "..." output-stream) + (return)) + (%write-object + (svref struct (dsd-index (first slots))) + output-stream print-vars level)))) + (write-char #\) output-stream) + (when pv-pretty + (pp-pop-level pv-pretty))))))) + +(eval-when (eval) (compile '%write-structure)) + +;;; +;;; Apparently, whoever implemented the TIME macro didn't consider that +;;; someone might want to use it in a non-null lexical environment. Of +;;; course this fix is a loser since it binds a whole mess of variables +;;; around the evaluation of form, but it will do for now. +;;; +(in-package 'lisp) + +(DEFmacro TIME (FORM) + `(LET (IGNORE START FINISH S-HSEC F-HSEC S-SEC F-SEC S-MIN F-MIN VALS) + (FORMAT *trace-output* "~&Evaluating: ~A" ,form) + ;; read the start time. + (MULTIPLE-VALUE-SETQ (IGNORE IGNORE IGNORE S-MIN START) + (SYS::%SYSINT #X21 #X2C00 0 0 0)) + ;; Eval the form. + (SETQ VALS (MULTIPLE-VALUE-LIST (progn ,form))) + ;; Read the end time. + (MULTIPLE-VALUE-SETQ (IGNORE IGNORE IGNORE F-MIN FINISH) + (SYS::%SYSINT #X21 #X2C00 0 0 0)) + ;; Unpack start and end times. + (SETQ S-HSEC (LOGAND START #X0FF) + F-HSEC (LOGAND FINISH #X0FF) + S-SEC (LSH START -8) + F-SEC (LSH FINISH -8) + S-MIN (LOGAND #X0FF S-MIN) + F-MIN (LOGAND #X0FF F-MIN)) + (SETQ F-HSEC (- F-HSEC S-HSEC)) ; calc hundreths + (IF (MINUSP F-HSEC) + (SETQ F-HSEC (+ F-HSEC 100) + F-SEC (1- F-SEC))) + (SETQ F-SEC (- F-SEC S-SEC)) ; calc seconds + (IF (MINUSP F-SEC) + (SETQ F-SEC (+ F-SEC 60) + F-MIN (1- F-MIN))) + (SETQ F-MIN (- F-MIN S-MIN)) ; calc minutes + (IF (MINUSP F-MIN) (INCF F-MIN 60)) + (FORMAT *trace-output* "~&Elapsed time: ~D:~:[~D~;0~D~].~:[~D~;0~D~]~%" + F-MIN (< F-SEC 10.) F-SEC (< F-HSEC 10) F-HSEC) + (VALUES-LIST VALS))) + +;;; +;;; Patch to PROGV +;;; +(in-package sys::*compiler-package-load*) + +;;; This is a fully portable (though not very efficient) +;;; implementation of PROGV as a macro. It does its own special +;;; binding (shallow binding) by saving the original values in a +;;; list, and marking things that were originally unbound. + +(defun PORTABLE-PROGV-BIND (symbol old-vals place-holder) + (let ((val-to-save '#:value-to-save)) + `(let ((,val-to-save (if (boundp ,symbol) + (symbol-value ,symbol) + ,place-holder))) + (if ,old-vals + (rplacd (last ,old-vals) (ncons ,val-to-save)) + (setq ,old-vals (ncons ,val-to-save)))))) + +(defun PORTABLE-PROGV-UNBIND (symbol old-vals place-holder) + (let ((val-to-restore '#:value-to-restore)) + `(let ((,val-to-restore (pop ,old-vals))) + (if (eq ,val-to-restore ,place-holder) + (makunbound ,symbol) + (setf (symbol-value ,symbol) ,val-to-restore))))) + + +(deftransform PROGV PORTABLE-PROGV-TRANSFORM + (symbols-form values-form &rest body) + (let ((symbols-lst '#:symbols-list) + (values-lst '#:values-list) + (syms '#:symbols) + (vals '#:values) + (sym '#:symbol) + (old-vals '#:old-values) + (unbound-holder ''#:unbound-holder)) + `(let ((,symbols-lst ,symbols-form) + (,values-lst ,values-form) + (,old-vals nil)) + (unless (and (listp ,symbols-lst) (listp ,values-lst)) + (error "PROGV: Both symbols and values must be lists")) + (unwind-protect + (do ((,syms ,symbols-lst (cdr ,syms)) + (,vals ,values-lst (cdr ,vals)) + (,sym nil)) + ((null ,syms) (progn ,@body)) + (setq ,sym (car ,syms)) + (if (symbolp ,sym) + ,(PORTABLE-PROGV-BIND sym old-vals unbound-holder) + (error "PROGV: Object to be bound not a symbol: ~S" ,sym)) + (if ,vals + (setf (symbol-value ,sym) (first ,vals)) + (makunbound ,sym))) + (dolist (,sym ,symbols-lst) + ,(PORTABLE-PROGV-UNBIND sym old-vals unbound-holder)))))) + diff --git a/pcl/impl/hp/hp-low.lisp b/pcl/impl/hp/hp-low.lisp new file mode 100644 index 0000000..d1e807f --- /dev/null +++ b/pcl/impl/hp/hp-low.lisp @@ -0,0 +1,37 @@ +;;; -*- Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the HP Common Lisp version of the file low. +;;; +;;; + +(in-package 'pcl) + +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (prim:@inf thing))) + + + diff --git a/pcl/impl/ibcl/ibcl-low.lisp b/pcl/impl/ibcl/ibcl-low.lisp new file mode 100644 index 0000000..2ab3f77 --- /dev/null +++ b/pcl/impl/ibcl/ibcl-low.lisp @@ -0,0 +1,327 @@ +;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; The version of low for Kyoto Common Lisp (KCL) +(in-package 'pcl) + +;;; +;;; The reason these are here is because the KCL compiler does not allow +;;; LET to return FIXNUM values as values of (c) type int, hence the use +;;; of LOCALLY (which expands into (LET () (DECLARE ...) ...)) forces +;;; conversion of ints to objects. +;;; +(defmacro %logand (&rest args) + (reduce-variadic-to-binary 'logand args 0 t 'fixnum)) + +;(defmacro %logxor (&rest args) +; (reduce-variadic-to-binary 'logxor args 0 t 'fixnum)) + +(defmacro %+ (&rest args) + (reduce-variadic-to-binary '+ args 0 t 'fixnum)) + +;(defmacro %- (x y) +; `(the fixnum (- (the fixnum ,x) (the fixnum ,y)))) + +(defmacro %* (&rest args) + (reduce-variadic-to-binary '* args 1 t 'fixnum)) + +(defmacro %/ (x y) + `(the fixnum (/ (the fixnum ,x) (the fixnum ,y)))) + +(defmacro %1+ (x) + `(the fixnum (1+ (the fixnum ,x)))) + +(defmacro %1- (x) + `(the fixnum (1- (the fixnum ,x)))) + +(defmacro %svref (vector index) + `(svref (the simple-vector ,vector) (the fixnum ,index))) + +(defsetf %svref (vector index) (new-value) + `(setf (svref (the simple-vector ,vector) (the fixnum ,index)) + ,new-value)) + + +;;; +;;; std-instance-p +;;; +(si:define-compiler-macro std-instance-p (x) + (once-only (x) + `(and (si:structurep ,x) + (eq (si:structure-name ,x) 'std-instance)))) + +(dolist (inline '((si:structurep + ((t) compiler::boolean nil nil "type_of(#0)==t_structure") + compiler::inline-always) + (si:structure-name + ((t) t nil nil "(#0)->str.str_name") + compiler::inline-unsafe))) + (setf (get (first inline) (third inline)) (list (second inline)))) + +(setf (get 'cclosure-env 'compiler::inline-always) + (list '((t) t nil nil "(#0)->cc.cc_env"))) + +;;; +;;; turbo-closure patch. See the file kcl-mods.text for details. +;;; +#+:turbo-closure +(progn +(CLines + "object tc_cc_env_nthcdr (n,tc)" + "object n,tc; " + "{return (type_of(tc)==t_cclosure&& " + " tc->cc.cc_turbo!=NULL&& " + " type_of(n)==t_fixnum)? " + " tc->cc.cc_turbo[fix(n)]: " ; assume that n is in bounds + " Cnil; " + "} " + ) + +(defentry tc-cclosure-env-nthcdr (object object) (object tc_cc_env_nthcdr)) + +(setf (get 'tc-cclosure-env-nthcdr 'compiler::inline-unsafe) + '(((fixnum t) t nil nil "(#1)->cc.cc_turbo[#0]"))) +) + + +;;;; low level stuff to hack compiled functions and compiled closures. +;;; +;;; The primary client for this is fsc-low, but since we make some use of +;;; it here (e.g. to implement set-function-name-1) it all appears here. +;;; + +(eval-when (compile eval) + +(defmacro define-cstruct-accessor (accessor structure-type field value-type + field-type tag-name) + (let ((setf (intern (concatenate 'string "SET-" (string accessor)))) + (caccessor (format nil "pcl_get_~A_~A" structure-type field)) + (csetf (format nil "pcl_set_~A_~A" structure-type field)) + (vtype (intern (string-upcase value-type)))) + `(progn + (CLines ,(format nil "~A ~A(~A) ~%~ + object ~A; ~%~ + { return ((~A) ~A->~A.~A); } ~%~ + ~%~ + ~A ~A(~A, new) ~%~ + object ~A; ~%~ + ~A new; ~%~ + { return ((~A)(~A->~A.~A = ~Anew)); } ~%~ + " + value-type caccessor structure-type + structure-type + value-type structure-type tag-name field + value-type csetf structure-type + structure-type + value-type + value-type structure-type tag-name field field-type + )) + + (defentry ,accessor (object) (,vtype ,caccessor)) + (defentry ,setf (object ,vtype) (,vtype ,csetf)) + + + (defsetf ,accessor ,setf) + + ))) +) +;;; +;;; struct cfun { /* compiled function header */ +;;; short t, m; +;;; object cf_name; /* compiled function name */ +;;; int (*cf_self)(); /* entry address */ +;;; object cf_data; /* data the function uses */ +;;; /* for GBC */ +;;; char *cf_start; /* start address of the code */ +;;; int cf_size; /* code size */ +;;; }; +;;; add field-type tag-name +(define-cstruct-accessor cfun-name "cfun" "cf_name" "object" "(object)" "cf") +(define-cstruct-accessor cfun-self "cfun" "cf_self" "int" "(int (*)())" + "cf") +(define-cstruct-accessor cfun-data "cfun" "cf_data" "object" "(object)" "cf") +(define-cstruct-accessor cfun-start "cfun" "cf_start" "int" "(char *)" "cf") +(define-cstruct-accessor cfun-size "cfun" "cf_size" "int" "(int)" "cf") + +(CLines + "object pcl_cfunp (x) " + "object x; " + "{if(x->c.t == (int) t_cfun) " + " return (Ct); " + " else " + " return (Cnil); " + " } " + ) + +(defentry cfunp (object) (object pcl_cfunp)) + +;;; +;;; struct cclosure { /* compiled closure header */ +;;; short t, m; +;;; object cc_name; /* compiled closure name */ +;;; int (*cc_self)(); /* entry address */ +;;; object cc_env; /* environment */ +;;; object cc_data; /* data the closure uses */ +;;; /* for GBC */ +;;; char *cc_start; /* start address of the code */ +;;; int cc_size; /* code size */ +;;; }; +;;; +(define-cstruct-accessor cclosure-name "cclosure" "cc_name" "object" + "(object)" "cc") +(define-cstruct-accessor cclosure-self "cclosure" "cc_self" "int" + "(int (*)())" "cc") +(define-cstruct-accessor cclosure-data "cclosure" "cc_data" "object" + "(object)" "cc") +(define-cstruct-accessor cclosure-start "cclosure" "cc_start" "int" + "(char *)" "cc") +(define-cstruct-accessor cclosure-size "cclosure" "cc_size" "int" + "(int)" "cc") +(define-cstruct-accessor cclosure-env "cclosure" "cc_env" "object" + "(object)" "cc") + + +(CLines + "object pcl_cclosurep (x) " + "object x; " + "{if(x->c.t == (int) t_cclosure) " + " return (Ct); " + " else " + " return (Cnil); " + " } " + ) + +(defentry cclosurep (object) (object pcl_cclosurep)) + + ;; +;;;;;; Load Time Eval + ;; +;;; + +;;; This doesn't work because it looks at a global variable to see if it is +;;; in the compiler rather than looking at the macroexpansion environment. +;;; +;;; The result is that if in the process of compiling a file, we evaluate a +;;; form that has a call to load-time-eval, we will get faked into thinking +;;; that we are compiling that form. +;;; +;;; THIS NEEDS TO BE DONE RIGHT!!! +;;; +;(defmacro load-time-eval (form) +; ;; In KCL there is no compile-to-core case. For things that we are +; ;; "compiling to core" we just expand the same way as if were are +; ;; compiling a file since the form will be evaluated in just a little +; ;; bit when gazonk.o is loaded. +; (if (and (boundp 'compiler::*compiler-input*) ;Hack to see of we are +; compiler::*compiler-input*) ;in the compiler! +; `'(si:|#,| . ,form) +; `(progn ,form))) + +(defmacro load-time-eval (form) + (read-from-string (format nil "'#,~S" form))) + +(defmacro memory-block-ref (block offset) + `(svref (the simple-vector ,block) (the fixnum ,offset))) + + ;; +;;;;;; Generating CACHE numbers + ;; +;;; This needs more work to be sure it is going as fast as possible. +;;; - The calls to si:address should be open-coded. +;;; - The logand should be open coded. +;;; + +;(defmacro symbol-cache-no (symbol mask) +; (if (and (constantp symbol) +; (constantp mask)) +; `(load-time-eval (logand (ash (si:address ,symbol) -2) ,mask)) +; `(logand (ash (the fixnum (si:address ,symbol)) -2) ,mask))) + +(defmacro object-cache-no (object mask) + `(logand (the fixnum (si:address ,object)) ,mask)) + + ;; +;;;;;; printing-random-thing-internal + ;; +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (si:address thing))) + + +(defun set-function-name-1 (fn new-name ignore) + (cond ((cclosurep fn) + (setf (cclosure-name fn) new-name)) + ((cfunp fn) + (setf (cfun-name fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda-block)) + (setf (cadr fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda)) + (setf (car fn) 'lambda-block + (cdr fn) (cons new-name (cdr fn))))) + fn) + + + + +#| +(defconstant most-positive-small-fixnum 1024) /* should be supplied */ +(defconstant most-negative-small-fixnum -1024) /* by ibuki */ + +(defmacro symbol-cache-no (symbol mask) + (if (constantp mask) + (if (and (> mask 0) + (< mask most-positive-small-fixnum)) + (if (constantp symbol) + `(load-time-eval (coffset ,symbol ,mask 2)) + `(coffset ,symbol ,mask 2)) + (if (constantp symbol) + `(load-time-eval + (logand (ash (the fixnum (si:address ,symbol)) -2) ,mask)) + `(logand (ash (the fixnum (si:address ,symbol)) -2) ,mask))) + `(logand (ash (the fixnum (si:address ,symbol)) -2) ,mask))) + + +(defmacro object-cache-no (object mask) + (if (and (constantp mask) + (> mask 0) + (< mask most-positive-small-fixnum)) + `(coffset ,object ,mask 4) + `(logand (ash (the fixnum (si:address ,object)) -4) ,mask))) + +(CLines + "object pcl_coffset (sym,mask,lshift)" + "object sym,mask,lshift;" + "{" + " return(small_fixnum(((int)sym >> fix(lshift)) & fix(mask)));" + "}" + ) + +(defentry coffset (object object object) (object pcl_coffset)) + + +|# + diff --git a/pcl/impl/ibcl/ibcl-patches.lisp b/pcl/impl/ibcl/ibcl-patches.lisp new file mode 100644 index 0000000..68e071c --- /dev/null +++ b/pcl/impl/ibcl/ibcl-patches.lisp @@ -0,0 +1,129 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package 'system) + +;;; This makes DEFMACRO take &WHOLE and &ENVIRONMENT args anywhere +;;; in the lambda-list. The former allows deviation from the CL spec, +;;; but what the heck. + +(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) + +(defvar *old-defmacro*) + +(defun new-defmacro (whole env) + (flet ((call-old-definition (new-whole) + (funcall *old-defmacro* new-whole env))) + (if (not (and (consp whole) + (consp (cdr whole)) + (consp (cddr whole)) + (consp (cdddr whole)))) + (call-old-definition whole) + (let* ((ll (caddr whole)) + (env-tail (do ((tail ll (cdr tail))) + ((not (consp tail)) nil) + (when (eq '&environment (car tail)) + (return tail))))) + (if env-tail + (call-old-definition (list* (car whole) + (cadr whole) + (append (list '&environment + (cadr env-tail)) + (ldiff ll env-tail) + (cddr env-tail)) + (cdddr whole))) + (call-old-definition whole)))))) + +(eval-when (load eval) + (unless (boundp '*old-defmacro*) + (setq *old-defmacro* (macro-function 'defmacro)) + (setf (macro-function 'defmacro) #'new-defmacro))) + +;;; +;;; setf patches +;;; + +(in-package 'system) + +(defun get-setf-method (form) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-method-multiple-value form) + (unless (listp vars) + (error + "The temporary variables component, ~s, + of the setf-method for ~s is not a list." + vars form)) + (unless (listp vals) + (error + "The values forms component, ~s, + of the setf-method for ~s is not a list." + vals form)) + (unless (listp stores) + (error + "The store variables component, ~s, + of the setf-method for ~s is not a list." + stores form)) + (unless (= (list-length stores) 1) + (error "Multiple store-variables are not allowed.")) + (values vars vals stores store-form access-form))) + +(defun get-setf-method-multiple-value (form) + (cond ((symbolp form) + (let ((store (gensym))) + (values nil nil (list store) `(setq ,form ,store) form))) + ((or (not (consp form)) (not (symbolp (car form)))) + (error "Cannot get the setf-method of ~S." form)) + ((get (car form) 'setf-method) + (apply (get (car form) 'setf-method) (cdr form))) + ((get (car form) 'setf-update-fn) + (let ((vars (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (cdr form))) + (store (gensym))) + (values vars (cdr form) (list store) + `(,(get (car form) 'setf-update-fn) + ,@vars ,store) + (cons (car form) vars)))) + ((get (car form) 'setf-lambda) + (let* ((vars (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (cdr form))) + (store (gensym)) + (l (get (car form) 'setf-lambda)) + (f `(lambda ,(car l) + (funcall #'(lambda ,(cadr l) ,@(cddr l)) + ',store)))) + (values vars (cdr form) (list store) + (apply f vars) + (cons (car form) vars)))) + ((macro-function (car form)) + (get-setf-method-multiple-value (macroexpand-1 form))) + (t + (error "Cannot expand the SETF form ~S." form)))) + diff --git a/pcl/impl/kcl/kcl-low.lisp b/pcl/impl/kcl/kcl-low.lisp new file mode 100644 index 0000000..77cb4f5 --- /dev/null +++ b/pcl/impl/kcl/kcl-low.lisp @@ -0,0 +1,438 @@ +;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; The version of low for Kyoto Common Lisp (KCL) +(in-package "SI") +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name + %instance-ref + %set-instance-ref)) +(in-package 'pcl) + +(shadow 'lisp:dotimes) + +(defmacro dotimes ((var form &optional (val nil)) &rest body &environment env) + (multiple-value-bind (doc decls bod) + (extract-declarations body env) + (declare (ignore doc)) + (let ((limit (gensym)) + (label (gensym))) + `(let ((,limit ,form) + (,var 0)) + (declare (fixnum ,limit ,var)) + ,@decls + (block nil + (tagbody + ,label + (when (>= ,var ,limit) (return-from nil ,val)) + ,@bod + (setq ,var (the fixnum (1+ ,var))) + (go ,label))))))) + +(defun memq (item list) (member item list :test #'eq)) +(defun assq (item list) (assoc item list :test #'eq)) +(defun posq (item list) (position item list :test #'eq)) + +(si:define-compiler-macro memq (item list) + (let ((var (gensym))) + (once-only (item) + `(let ((,var ,list)) + (loop (unless ,var (return nil)) + (when (eq ,item (car ,var)) + (return ,var)) + (setq ,var (cdr ,var))))))) + +(si:define-compiler-macro assq (item list) + (let ((var (gensym))) + (once-only (item) + `(dolist (,var ,list nil) + (when (eq ,item (car ,var)) + (return ,var)))))) + +(si:define-compiler-macro posq (item list) + (let ((var (gensym)) (index (gensym))) + (once-only (item) + `(let ((,var ,list) (,index 0)) + (declare (fixnum ,index)) + (dolist (,var ,list nil) + (when (eq ,item ,var) + (return ,index)) + (incf ,index)))))) + +(defun printing-random-thing-internal (thing stream) + (format stream "~X" (si:address thing))) + +(defmacro %svref (vector index) + `(svref (the simple-vector ,vector) (the fixnum ,index))) + +(defsetf %svref (vector index) (new-value) + `(setf (svref (the simple-vector ,vector) (the fixnum ,index)) + ,new-value)) + + +;;; +;;; std-instance-p +;;; +#-akcl +(si:define-compiler-macro std-instance-p (x) + (once-only (x) + `(and (si:structurep ,x) + (eq (si:%structure-name ,x) 'std-instance)))) + +#+akcl +(progn + +#-new-kcl-wrapper +;; declare that std-instance-p may be computed simply, and will not change. +(si::freeze-defstruct 'std-instance) + +(si::freeze-defstruct 'method-call) +(si::freeze-defstruct 'fast-method-call) + +(defvar *pcl-funcall* + `(lambda (loc) + (compiler::wt-nl + "{object _funobj = " loc ";" + "if(Rset&&type_of(_funobj)!=t_symbol)funcall_no_event(_funobj); + else super_funcall(_funobj);}"))) + +(setq compiler::*super-funcall* *pcl-funcall*) + +(defmacro fmc-funcall (fn pv-cell next-method-call &rest args) + `(funcall ,fn ,pv-cell ,next-method-call ,@args)) + +) + +;;; +;;; turbo-closure patch. See the file kcl-mods.text for details. +;;; +#-turbo-closure-env-size +(clines " +object cclosure_env_nthcdr (n,cc) +int n; object cc; +{ object env; + if(n<0)return Cnil; + if(type_of(cc)!=t_cclosure)return Cnil; + env=cc->cc.cc_env; + while(n-->0) + {if(type_of(env)!=t_cons)return Cnil; + env=env->c.c_cdr;} + return env; +}") + +#+turbo-closure-env-size +(clines " +object cclosure_env_nthcdr (n,cc) +int n; object cc; +{ object env,*turbo; + if(n<0)return Cnil; + if(type_of(cc)!=t_cclosure)return Cnil; + if((turbo=cc->cc.cc_turbo)==NULL) + {env=cc->cc.cc_env; + while(n-->0) + {if(type_of(env)!=t_cons)return Cnil; + env=env->c.c_cdr;} + return env;} + else + {if(n>=fix(*(turbo-1)))return Cnil; + return turbo[n];} +}") + +;; This is the completely safe version. +(defentry cclosure-env-nthcdr (int object) (object cclosure_env_nthcdr)) +;; This is the unsafe but fast version. +(defentry %cclosure-env-nthcdr (int object) (object cclosure_env_nthcdr)) + +;;; #+akcl means this is an AKCL newer than 5/11/89 (structures changed) +(eval-when (compile load eval) + +#+new-kcl-wrapper +(progn + +(defun instance-ref (slots index) + (si:structure-ref1 slots index)) + +(defun set-instance-ref (slots index value) + (si:structure-set1 slots index value)) + +(defsetf instance-ref set-instance-ref) +(defsetf %instance-ref %set-instance-ref) +) + +(defsetf structure-def set-structure-def) + +;;((name args-type result-type side-effect-p new-object-p c-expression) ...) +(defparameter *kcl-function-inlines* + '((%fboundp (t) compiler::boolean nil nil "(#0)->s.s_gfdef!=OBJNULL") + (%symbol-function (t) t nil nil "(#0)->s.s_gfdef") + #-akcl (si:structurep (t) compiler::boolean nil nil "type_of(#0)==t_structure") + #-akcl (si:%structure-name (t) t nil nil "(#0)->str.str_name") + #+akcl (si:%structure-name (t) t nil nil "(#0)->str.str_def->str.str_self[0]") + #+new-kcl-wrapper + (si:%instance-ref (t t) t nil nil "(#0)->str.str_self[fix(#1)]") + #+new-kcl-wrapper + (si:%set-instance-ref (t t t) t t nil "(#0)->str.str_self[fix(#1)]=(#2)") + (si:%compiled-function-name (t) t nil nil "(#0)->cf.cf_name") + (si:%set-compiled-function-name (t t) t t nil "((#0)->cf.cf_name)=(#1)") + (cclosurep (t) compiler::boolean nil nil "type_of(#0)==t_cclosure") + #+akcl (sfun-p (t) compiler::boolean nil nil "type_of(#0)==t_sfun") + (%cclosure-env (t) t nil nil "(#0)->cc.cc_env") + (%set-cclosure-env (t t) t t nil "((#0)->cc.cc_env)=(#1)") + #+turbo-closure + (%cclosure-env-nthcdr (fixnum t) t nil nil "(#1)->cc.cc_turbo[#0]") + + (logxor (fixnum fixnum) fixnum nil nil "((#0) ^ (#1))"))) + +(defun make-function-inline (inline) + (setf (get (car inline) 'compiler::inline-always) + (list (if (fboundp 'compiler::flags) + (let ((opt (cdr inline))) + (list (first opt) (second opt) + (logior (if (fourth opt) 1 0) ; allocates-new-storage + (if (third opt) 2 0) ; side-effect + (if nil 4 0) ; constantp + (if (eq (car inline) 'logxor) + 8 0)) ;result type from args + (fifth opt))) + (cdr inline))))) + +(defmacro define-inlines () + `(progn + ,@(mapcan #'(lambda (inline) + (let* ((*package* *the-pcl-package*) + (name (intern (format nil "~S inline" (car inline)))) + (vars (mapcar #'(lambda (type) + (declare (ignore type)) + (gensym)) + (cadr inline)))) + `((make-function-inline ',(cons name (cdr inline))) + ,@(when (or (every #'(lambda (type) (eq type 't)) + (cadr inline)) + (char= #\% (aref (symbol-name (car inline)) 0))) + `((defun ,(car inline) ,vars + ,@(mapcan #'(lambda (var var-type) + (unless (eq var-type 't) + `((declare (type ,var-type ,var))))) + vars (cadr inline)) + (,name ,@vars)) + (make-function-inline ',inline)))))) + *kcl-function-inlines*))) + +(define-inlines) +) + +(defsetf si:%compiled-function-name si:%set-compiled-function-name) +(defsetf %cclosure-env %set-cclosure-env) + +(defun set-function-name-1 (fn new-name ignore) + (declare (ignore ignore)) + (cond ((compiled-function-p fn) + (si::turbo-closure fn) + ;;(when (symbolp new-name) (proclaim-defgeneric new-name nil)) + (setf (si:%compiled-function-name fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda-block)) + (setf (cadr fn) new-name)) + ((and (listp fn) + (eq (car fn) 'lambda)) + (setf (car fn) 'lambda-block + (cdr fn) (cons new-name (cdr fn))))) + fn) + + +#+akcl (clines "#define AKCL206") + +(clines " +#ifdef AKCL206 +use_fast_links(); +#endif + +object set_cclosure (result_cc,value_cc,available_size) + object result_cc,value_cc; int available_size; +{ + object result_env_tail,value_env_tail; int i; +#ifdef AKCL206 + /* If we are currently using fast linking, */ + /* make sure to remove the link for result_cc. */ + use_fast_links(3,Cnil,result_cc); +#endif + result_env_tail=result_cc->cc.cc_env; + value_env_tail=value_cc->cc.cc_env; + for(i=available_size; + result_env_tail!=Cnil && i>0; + result_env_tail=CMPcdr(result_env_tail), value_env_tail=CMPcdr(value_env_tail)) + CMPcar(result_env_tail)=CMPcar(value_env_tail), i--; + result_cc->cc.cc_self=value_cc->cc.cc_self; + result_cc->cc.cc_data=value_cc->cc.cc_data; +#ifndef AKCL206 + result_cc->cc.cc_start=value_cc->cc.cc_start; + result_cc->cc.cc_size=value_cc->cc.cc_size; +#endif + return result_cc; +}") + +(defentry %set-cclosure (object object int) (object set_cclosure)) + + +(defun structure-functions-exist-p () + t) + +(si:define-compiler-macro structure-instance-p (x) + (once-only (x) + `(and (si:structurep ,x) + (not (eq (si:%structure-name ,x) 'std-instance))))) + +(defun structure-type (x) + (and (si:structurep x) + (si:%structure-name x))) + +(si:define-compiler-macro structure-type (x) + (once-only (x) + `(and (si:structurep ,x) + (si:%structure-name ,x)))) + +(defun structure-type-p (type) + (or (not (null (gethash type *structure-table*))) + (let (#+akcl(s-data nil)) + (and (symbolp type) + #+akcl (setq s-data (get type 'si::s-data)) + #-akcl (get type 'si::is-a-structure) + (null #+akcl (si::s-data-type s-data) + #-akcl (get type 'si::structure-type)))))) + +(defun structure-type-included-type-name (type) + (or (car (gethash type *structure-table*)) + #+akcl (let ((includes (si::s-data-includes (get type 'si::s-data)))) + (when includes + (si::s-data-name includes))) + #-akcl (get type 'si::structure-include))) + +(defun structure-type-internal-slotds (type) + #+akcl (si::s-data-slot-descriptions (get type 'si::s-data)) + #-akcl (get type 'si::structure-slot-descriptions)) + +(defun structure-type-slot-description-list (type) + (or (cdr (gethash type *structure-table*)) + (mapcan #'(lambda (slotd) + #-new-kcl-wrapper + (when (and slotd (car slotd)) + (let ((offset (fifth slotd))) + (let ((reader #'(lambda (x) + #+akcl (si:structure-ref1 x offset) + #-akcl (si:structure-ref x type offset))) + (writer #'(lambda (v x) + (si:structure-set x type offset v)))) + #+turbo-closure (si:turbo-closure reader) + #+turbo-closure (si:turbo-closure writer) + (let* ((reader-sym + (let ((*package* *the-pcl-package*)) + (intern (format nil "~s SLOT~D" type offset)))) + (writer-sym (get-setf-function-name reader-sym)) + (slot-name (first slotd)) + (read-only-p (fourth slotd))) + (setf (symbol-function reader-sym) reader) + (setf (symbol-function writer-sym) writer) + (do-standard-defsetf-1 reader-sym) + (list (list slot-name + reader-sym + reader + (and (not read-only-p) writer))))))) + #+new-kcl-wrapper + (list slotd)) + (let ((slotds (structure-type-internal-slotds type)) + (inc (structure-type-included-type-name type))) + (if inc + (nthcdr (length (structure-type-internal-slotds inc)) + slotds) + slotds))))) + +#+new-kcl-wrapper +(defun si::slot-reader-function (slot) + (let ((offset (si::slot-offset slot))) + (si:turbo-closure #'(lambda (x) + (si::structure-ref1 x offset))))) + +#+new-kcl-wrapper +(defun si::slot-writer-function (slot) + (let ((offset (si::slot-offset slot))) + (si:turbo-closure #'(lambda (x) + (si::structure-set1 x offset))))) + +(mapcar #'(lambda (fname value) + (setf (symbol-function fname) (symbol-function value))) + '(structure-slotd-name + structure-slotd-accessor-symbol + structure-slotd-reader-function + structure-slotd-writer-function + structure-slotd-type + structure-slotd-init-form) + #-new-kcl-wrapper + '(first second third fourth function-returning-nil function-returning-nil) + #+new-kcl-wrapper + '(si::slot-name si::slot-accessor-name + si::slot-reader-function si::slot-writer-function + si::slot-type si::slot-default-init)) + + +;; Construct files sys-proclaim.lisp and sys-package.lisp +;; The file sys-package.lisp must be loaded first, since the +;; package sys-proclaim.lisp will refer to symbols and they must +;; be in the right packages. sys-proclaim.lisp contains function +;; declarations and declarations that certain things are closures. + +(defun renew-sys-files() + ;; packages: + (compiler::get-packages "sys-package.lisp") + (with-open-file (st "sys-package.lisp" + :direction :output + :if-exists :append) + (format st "(in-package 'SI) +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name)) +(in-package 'pcl) +")) + + ;; proclaims + (compiler::make-all-proclaims "*.fn") + (let ((*package* (find-package 'user))) + (with-open-file (st "sys-proclaim.lisp" + :direction :output + :if-exists :append) + ;;(format st "~%(IN-PACKAGE \"PCL\")~%") + (print + `(dolist (v ', + + (sloop::sloop for v in-package "PCL" + when (get v 'compiler::proclaimed-closure) + collect v)) + (setf (get v 'compiler::proclaimed-closure) t)) + st) + (format st "~%") + ))) + + diff --git a/pcl/impl/kcl/kcl-mods.text b/pcl/impl/kcl/kcl-mods.text new file mode 100644 index 0000000..741e41a --- /dev/null +++ b/pcl/impl/kcl/kcl-mods.text @@ -0,0 +1,224 @@ +If you have akcl version 604 or newer, do not make these patches. + + +(1) Turbo closure patch + +To make the turbo closure stuff work, make the following changes to KCL. +These changes can also work for an IBCL. + +The three patches in this file add two features (reflected in the +value of *features*) to your KCL or IBCL: + a feature named :TURBO-CLOSURE which increases the speed of the + code generated by FUNCALLABLE-INSTANCE-DATA-1 + (previous versions of the file kcl-mods.text had this feature only), +and + a feature named :TURBO-CLOSURE-ENV-SIZE which increases the speed + of the function FUNCALLABLE-INSTANCE-P. + +(This file comprises two features rather than just one to allow the +PCL system to be work in KCL systems that do not have this patch, +or that have the old version of this patch.) + + +The first of these patches changes the turbo_closure function to +store the size of the environment in the turbo structure. + +The second of patch fixes a garbage-collector bug in which +the turbo structure was sometimes ignored, AND also adapts +the garbage-collector to conform to the change made in the +first patch. The bug has been fixed in newer versions of +AKCL, but it is still necessary to apply this patch, if the +first and third patches are applied. + +The third change pushes :turbo-closure and :turbo-closure-env-size +on the *features* list so that PCL will know that turbo closures +are enabled. + + +Note that these changes have to be made before PCL is compiled, and a +PCL which is compiled in a KCL/IBCL with these changes can only be run +in a KCL/IBCL with these changes. + +(1-1) edit the function turbo_closure in the file kcl/c/cfun.c, +change the lines +---------- +turbo_closure(fun) +object fun; +{ + object l; + int n; + + for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) + ; + fun->cc.cc_turbo = (object *)alloc_contblock(n*sizeof(object)); + for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) + fun->cc.cc_turbo[n] = l; +} +---------- +to +---------- +turbo_closure(fun) +object fun; +{ + object l,*block; + int n; + + if(fun->cc.cc_turbo==NULL) + {for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr); + block=(object *)alloc_contblock((1+n)*sizeof(object)); + *block=make_fixnum(n); + fun->cc.cc_turbo = block+1; /* equivalent to &block[1] */ + for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) + fun->cc.cc_turbo[n] = l;} +} +---------- + + +(1-2) edit the function mark_object in the file kcl/c/gbc.c, +Find the lines following case t_cclosure: in mark_object. +If they look like the ones between the lines marked (KCL), +make the first change, but if the look like the lines marked +(AKCL), apply the second change instead, and if the file +sgbc.c exists, apply the third change to it. +(1-2-1) Change: +(KCL)---------- + case t_cclosure: + mark_object(x->cc.cc_name); + mark_object(x->cc.cc_env); + mark_object(x->cc.cc_data); + if (x->cc.cc_start == NULL) + break; + if (what_to_collect == t_contiguous) { + if (get_mark_bit((int *)(x->cc.cc_start))) + break; + mark_contblock(x->cc.cc_start, x->cc.cc_size); + if (x->cc.cc_turbo != NULL) { + for (i = 0, y = x->cc.cc_env; + type_of(y) == t_cons; + i++, y = y->c.c_cdr); + mark_contblock((char *)(x->cc.cc_turbo), + i*sizeof(object)); + } + } + break; +(KCL)---------- +to +(KCL new)---------- + case t_cclosure: + mark_object(x->cc.cc_name); + mark_object(x->cc.cc_env); + mark_object(x->cc.cc_data); + if (what_to_collect == t_contiguous) + if (x->cc.cc_turbo != NULL) { + mark_contblock((char *)(x->cc.cc_turbo-1), + (1+fix(*(x->cc.cc_turbo-1)))*sizeof(object)); + } + if (x->cc.cc_start == NULL) + break; + if (what_to_collect == t_contiguous) { + if (get_mark_bit((int *)(x->cc.cc_start))) + break; + mark_contblock(x->cc.cc_start, x->cc.cc_size); + } + break; +(KCL new)---------- +(1-2-2) Or, Change: +(AKCL)---------- + case t_cclosure: + mark_object(x->cc.cc_name); + mark_object(x->cc.cc_env); + mark_object(x->cc.cc_data); + if (what_to_collect == t_contiguous) { + if (x->cc.cc_turbo != NULL) { + for (i = 0, y = x->cc.cc_env; + type_of(y) == t_cons; + i++, y = y->c.c_cdr); + mark_contblock((char *)(x->cc.cc_turbo), + i*sizeof(object)); + } + } + break; +(AKCL)---------- +To: +(AKCL new)---------- + case t_cclosure: + mark_object(x->cc.cc_name); + mark_object(x->cc.cc_env); + mark_object(x->cc.cc_data); + if (what_to_collect == t_contiguous) { + if (x->cc.cc_turbo != NULL) + mark_contblock((char *)(x->cc.cc_turbo-1), + (1+fix(*(x->cc.cc_turbo-1)))*sizeof(object)); + } + break; +(AKCL new)---------- +(1-2-3) In sgbc.c (if it exists), Change: +(AKCL)---------- + case t_cclosure: + sgc_mark_object(x->cc.cc_name); + sgc_mark_object(x->cc.cc_env); + sgc_mark_object(x->cc.cc_data); + if (what_to_collect == t_contiguous) { + if (x->cc.cc_turbo != NULL) { + for (i = 0, y = x->cc.cc_env; + type_of(y) == t_cons; + i++, y = y->c.c_cdr); + mark_contblock((char *)(x->cc.cc_turbo), + i*sizeof(object)); + } + } + break; +(AKCL)---------- +To: +(AKCL new)---------- + case t_cclosure: + sgc_mark_object(x->cc.cc_name); + sgc_mark_object(x->cc.cc_env); + sgc_mark_object(x->cc.cc_data); + if (what_to_collect == t_contiguous) { + if (x->cc.cc_turbo != NULL) + mark_contblock((char *)(x->cc.cc_turbo-1), + (1+fix(*(x->cc.cc_turbo-1)))*sizeof(object)); + } + break; +(AKCL new)---------- + + +(1-3) edit the function init_main in the file kcl/c/main.c, +change the lines where setting the value of *features* to add a :turbo-closure +and a :turbo-closure-env-size into the list in your KCL/IBCL. + +For example, in Sun4(SunOS) version of IBCL +changing the lines: +---------- + make_special("*FEATURES*", + make_cons(make_ordinary("SUN4"), + make_cons(make_ordinary("SPARC"), + make_cons(make_ordinary("IEEE-FLOATING-POINT"), + make_cons(make_ordinary("UNIX"), + make_cons(make_ordinary("BSD"), + make_cons(make_ordinary("COMMON"), + make_cons(make_ordinary("IBCL"), Cnil)))))))); +---------- +to +---------- + make_special("*FEATURES*", + make_cons(make_ordinary("SUN4"), + make_cons(make_ordinary("SPARC"), + make_cons(make_ordinary("IEEE-FLOATING-POINT"), + make_cons(make_ordinary("UNIX"), + make_cons(make_ordinary("BSD"), + make_cons(make_ordinary("COMMON"), + make_cons(make_ordinary("IBCL"), + make_cons(make_keyword("TURBO-CLOSURE"), + make_cons(make_keyword("TURBO-CLOSURE-ENV-SIZE"), + Cnil)))))))))); +---------- +But, if the C macro ADD_FEATURE is defined at the end of main.c, +use it instead. +Insert the lines: + ADD_FEATURE("TURBO-CLOSURE"); + ADD_FEATURE("TURBO-CLOSURE-ENV-SIZE"); +After the line: + ADD_FEATURE("AKCL"); + diff --git a/pcl/impl/kcl/kcl-notes.text b/pcl/impl/kcl/kcl-notes.text new file mode 100644 index 0000000..fc8a683 --- /dev/null +++ b/pcl/impl/kcl/kcl-notes.text @@ -0,0 +1,39 @@ + +Some notes on using "5/1/90 May Day PCL (REV 4b)" with KCL and AKCL. + +1. KCL will try to load the PCL file "init" when it starts up, + if you rename the files as is mentioned in defsys.lisp and the + currect directory is the one containing PCL. I suggest that + you do not rename any file except maybe "defsys", and also + that you change the (files-renamed-p t) to (files-renamed-p nil) + in defsys.lisp. + +2. Do not comment out the file kcl-patches.lisp, even if you are + using AKCL. It contins a patch to make compiler messages more + informative for AKCL, and also sets compiler::*compile-ordinaries* + to T, so that methods will get compiled. + +3. While fixup.lisp compiles, there will be a pause, because + KCL's compiler is not reentrant, and some uncompiled + code is run. If you want, you can change the form + (fix-early-generic-functions) to (fix-early-generic-functions t) + in fixup.lisp to see what is happening. + +4. (If you are using AKCL 605 or newer, skip this step.) + If you want, you can apply the changes in kcl-mods.text + to your KCL or AKCL to make PCL run faster. The file kcl-mods.text + is different from what it was in versions of PCL earlier than + May Day PCL. If you do not make these changes, or if you made + the old changes, things will still work. + +5. If you are using AKCL, and you previously used the kcl-low.lisp + file from rascal.ics.utexas.edu, you should not use it this time. + The kcl-low.lisp that comes with May Day PCL works fine. (If you + insist on using an old version of kcl-low.lisp, you will need to + use an old version of the KCL part of fin.lisp as well: this is + what is done for IBCL, by the way.) + +6. I recommend that you use AKCL version 457 or newer rather than using + KCL or an older version of AKCL, because there are some bugs in KCL + that cause problems for May Day PCL. + diff --git a/pcl/impl/kcl/kcl-patches.lisp b/pcl/impl/kcl/kcl-patches.lisp new file mode 100644 index 0000000..c051d9b --- /dev/null +++ b/pcl/impl/kcl/kcl-patches.lisp @@ -0,0 +1,362 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + + +(in-package "COMPILER") + +#+akcl +(eval-when (compile load eval) + +(when (<= system::*akcl-version* 609) + (pushnew :pre_akcl_610 *features*)) + +(if (and (boundp 'si::*akcl-version*) + (>= si::*akcl-version* 604)) + (progn + (pushnew :turbo-closure *features*) + (pushnew :turbo-closure-env-size *features*)) + (when (fboundp 'si::allocate-growth) + (pushnew :turbo-closure *features*))) + +;; patch around compiler bug. +(when (<= si::*akcl-version* 609) + (let ((vcs "static int Vcs; +")) + (unless (search vcs compiler::*cmpinclude-string*) + (setq compiler::*cmpinclude-string* + (concatenate 'string vcs compiler::*cmpinclude-string*))))) + +(let ((rset "int Rset; +")) + (unless (search rset compiler::*cmpinclude-string*) + (setq compiler::*cmpinclude-string* + (concatenate 'string rset compiler::*cmpinclude-string*)))) + +(when (get 'si::basic-wrapper 'si::s-data) + (pushnew :new-kcl-wrapper *features*) + (pushnew :structure-wrapper *features*)) + +) + + +#+akcl +(progn + +(unless (fboundp 'real-c2lambda-expr-with-key) + (setf (symbol-function 'real-c2lambda-expr-with-key) + (symbol-function 'c2lambda-expr-with-key))) + +(defun c2lambda-expr-with-key (lambda-list body) + (declare (special *sup-used*)) + (setq *sup-used* t) + (real-c2lambda-expr-with-key lambda-list body)) + + +;There is a bug in the implementation of *print-circle* that +;causes some akcl debugging commands (including :bt and :bl) +;to cause the following error when PCL is being used: +;Unrecoverable error: value stack overflow. + +;When a CLOS object is printed, travel_push_object ends up +;traversing almost the whole class structure, thereby overflowing +;the value-stack. + +;from lsp/debug.lsp. +;*print-circle* is badly implemented in kcl. +;it has two separate problems that should be fixed: +; 1. it traverses the printed object putting all objects found +; on the value stack (rather than in a hash table or some +; other structure; this is a problem because the size of the value stack +; is fixed, and a potentially unbounded number of objects +; need to be traversed), and +; 2. it blindly traverses all slots of any +; kind of structure including std-object structures. +; This is safe, but not always necessary, and is very time-consuming +; for CLOS objects (because it will always traverse every class). + +;For now, avoid using *print-circle* T when it will cause problems. + +(eval-when (compile eval) +(defmacro si::f (op &rest args) + `(the fixnum (,op ,@ (mapcar #'(lambda (x) `(the fixnum ,x)) args) ))) + +(defmacro si::fb (op &rest args) + `(,op ,@ (mapcar #'(lambda (x) `(the fixnum ,x)) args) )) +) + +(defun si::display-env (n env) + (do ((v (reverse env) (cdr v))) + ((or (not (consp v)) (si::fb > (fill-pointer si::*display-string*) n))) + (or (and (consp (car v)) + (listp (cdar v))) + (return)) + (let ((*print-circle* (can-use-print-circle-p (cadar v)))) + (format si::*display-string* "~s=~s~@[,~]" (caar v) (cadar v) (cdr v))))) + +(defun si::display-compiled-env ( plength ihs &aux + (base (si::ihs-vs ihs)) + (end (min (si::ihs-vs (1+ ihs)) (si::vs-top)))) + (format si::*display-string* "") + (do ((i base ) + (v (get (si::ihs-fname ihs) 'si::debug) (cdr v))) + ((or (si::fb >= i end)(si::fb > (fill-pointer si::*display-string*) plength))) + (let ((*print-circle* (can-use-print-circle-p (si::vs i)))) + (format si::*display-string* "~a~@[~d~]=~s~@[,~]" + (or (car v) 'si::loc) (if (not (car v)) (si::f - i base)) (si::vs i) + (si::fb < (setq i (si::f + i 1)) end))))) + +(clines "#define objnull_p(x) ((x==OBJNULL)?Ct:Cnil)") +(defentry objnull-p (object) (object "objnull_p")) + +(defun can-use-print-circle-p (x) + (catch 'can-use-print-circle-p + (can-use-print-circle-p1 x nil))) + +(defun can-use-print-circle-p1 (x so-far) + (and (not (objnull-p x)) ; because of deficiencies in the compiler, maybe? + (if (member x so-far) + (throw 'can-use-print-circle-p t) + (let ((so-far (cons x so-far))) + (flet ((can-use-print-circle-p (x) + (can-use-print-circle-p1 x so-far))) + (typecase x + (vector (or (not (eq 't (array-element-type x))) + (every #'can-use-print-circle-p x))) + (cons (and (can-use-print-circle-p (car x)) + (can-use-print-circle-p (cdr x)))) + (array (or (not (eq 't (array-element-type x))) + (let* ((rank (array-rank x)) + (dimensions (make-list rank))) + (dotimes (i rank) + (setf (nth i dimensions) (array-dimension x i))) + (or (member 0 dimensions) + (do ((cursor (make-list rank :initial-element 0))) + (nil) + (declare (:dynamic-extent cursor)) + (unless (can-use-print-circle-p + (apply #'aref x cursor)) + (return nil)) + (when (si::increment-cursor cursor dimensions) + (return t))))))) + (t (or (not (si:structurep x)) + (let* ((def (si:structure-def x)) + (name (si::s-data-name def)) + (len (si::s-data-length def)) + (pfun (si::s-data-print-function def))) + (and (null pfun) + (dotimes (i len t) + (unless (can-use-print-circle-p + (si:structure-ref x name i)) + (return nil))))))))))))) + +(defun si::apply-display-fun (display-fun n lis) + (let ((*print-length* si::*debug-print-level*) + (*print-level* si::*debug-print-level*) + (*print-pretty* nil) + (*PRINT-CASE* :downcase) + (*print-circle* nil) + ) + (setf (fill-pointer si::*display-string*) 0) + (format si::*display-string* "{") + (funcall display-fun n lis) + (when (si::fb > (fill-pointer si::*display-string*) n) + (setf (fill-pointer si::*display-string*) n) + (format si::*display-string* "...")) + + (format si::*display-string* "}") + ) + si::*display-string* + ) + +;The old definition of this had a bug: +;sometimes it returned without calling mv-values. +(defun si::next-stack-frame (ihs &aux line-info li i k na) + (cond ((si::fb < ihs si::*ihs-base*) + (si::mv-values nil nil nil nil nil)) + ((let (fun) + ;; next lower visible ihs + (si::mv-setq (fun i) (si::get-next-visible-fun ihs)) + (setq na fun) + (cond ((and (setq line-info (get fun 'si::line-info)) + (do ((j (si::f + ihs 1) (si::f - j 1)) + (form )) + ((<= j i) nil) + (setq form (si::ihs-fun j)) + (cond ((setq li (si::get-line-of-form form line-info)) + (return-from si::next-stack-frame + (si::mv-values + i fun li + ;; filename + (car (aref line-info 0)) + ;;environment + (list (si::vs (setq k (si::ihs-vs j))) + (si::vs (1+ k)) + (si::vs (+ k 2))))))))))))) + ((and (not (special-form-p na)) + (not (get na 'si::dbl-invisible)) + (fboundp na)) + (si::mv-values i na nil nil + (if (si::ihs-not-interpreted-env i) + nil + (let ((i (si::ihs-vs i))) + (list (si::vs i) (si::vs (1+ i)) (si::vs (si::f + i 2))))))) + (t (si::mv-values nil nil nil nil nil)))) +) + +#+pre_akcl_610 +(progn + +;(proclaim '(optimize (safety 0) (speed 3) (space 1))) + +;Not needed... make-top-level-form generates defuns now. +;(setq compiler::*compile-ordinaries* t) + +(eval-when (compile load eval) +(unless (fboundp 'original-co1typep) + (setf (symbol-function 'original-co1typep) #'co1typep)) +) + +(defun new-co1typep (f args) + (or (original-co1typep f args) + (let ((x (car args)) + (type (cadr args))) + (when (constantp type) + (let ((ntype (si::normalize-type (eval type)))) + (when (and (eq (car ntype) 'satisfies) + (cadr ntype) + (symbolp (cadr ntype)) + (symbol-package (cadr ntype))) + (c1expr `(the boolean (,(cadr ntype) ,x))))))))) + +(setf (symbol-function 'co1typep) #'new-co1typep) + +) + +#-(or akcl xkcl) +(progn +(in-package 'system) + +;;; This makes DEFMACRO take &WHOLE and &ENVIRONMENT args anywhere +;;; in the lambda-list. The former allows deviation from the CL spec, +;;; but what the heck. + +(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) + +(defvar *old-defmacro*) + +(defun new-defmacro (whole env) + (flet ((call-old-definition (new-whole) + (funcall *old-defmacro* new-whole env))) + (if (not (and (consp whole) + (consp (cdr whole)) + (consp (cddr whole)) + (consp (cdddr whole)))) + (call-old-definition whole) + (let* ((ll (caddr whole)) + (env-tail (do ((tail ll (cdr tail))) + ((not (consp tail)) nil) + (when (eq '&environment (car tail)) + (return tail))))) + (if env-tail + (call-old-definition (list* (car whole) + (cadr whole) + (append (list '&environment + (cadr env-tail)) + (ldiff ll env-tail) + (cddr env-tail)) + (cdddr whole))) + (call-old-definition whole)))))) + +(eval-when (load eval) + (unless (boundp '*old-defmacro*) + (setq *old-defmacro* (macro-function 'defmacro)) + (setf (macro-function 'defmacro) #'new-defmacro))) + +;;; +;;; setf patches +;;; + +(defun get-setf-method (form) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-method-multiple-value form) + (unless (listp vars) + (error + "The temporary variables component, ~s, + of the setf-method for ~s is not a list." + vars form)) + (unless (listp vals) + (error + "The values forms component, ~s, + of the setf-method for ~s is not a list." + vals form)) + (unless (listp stores) + (error + "The store variables component, ~s, + of the setf-method for ~s is not a list." + stores form)) + (unless (= (list-length stores) 1) + (error "Multiple store-variables are not allowed.")) + (values vars vals stores store-form access-form))) + +(defun get-setf-method-multiple-value (form) + (cond ((symbolp form) + (let ((store (gensym))) + (values nil nil (list store) `(setq ,form ,store) form))) + ((or (not (consp form)) (not (symbolp (car form)))) + (error "Cannot get the setf-method of ~S." form)) + ((get (car form) 'setf-method) + (apply (get (car form) 'setf-method) (cdr form))) + ((get (car form) 'setf-update-fn) + (let ((vars (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (cdr form))) + (store (gensym))) + (values vars (cdr form) (list store) + `(,(get (car form) 'setf-update-fn) + ,@vars ,store) + (cons (car form) vars)))) + ((get (car form) 'setf-lambda) + (let* ((vars (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (cdr form))) + (store (gensym)) + (l (get (car form) 'setf-lambda)) + (f `(lambda ,(car l) + (funcall #'(lambda ,(cadr l) ,@(cddr l)) + ',store)))) + (values vars (cdr form) (list store) + (apply f vars) + (cons (car form) vars)))) + ((macro-function (car form)) + (get-setf-method-multiple-value (macroexpand-1 form))) + (t + (error "Cannot expand the SETF form ~S." form)))) + +) + diff --git a/pcl/impl/kcl/makefile.akcl b/pcl/impl/kcl/makefile.akcl new file mode 100644 index 0000000..057a3f9 --- /dev/null +++ b/pcl/impl/kcl/makefile.akcl @@ -0,0 +1,32 @@ +# makefile for making pcl -- W. Schelter. + +# Directions: +# make -f makefile.akcl compile +# make -f makefile.akcl saved_pcl + +SHELL=/bin/sh + +LISP=akcl + + +SETUP='(load "pkg.lisp")(load "defsys.lisp")' \ + '(setq pcl::*default-pathname-extensions* (cons "lisp" "o"))' \ + '(setq pcl::*pathname-extensions* (cons "lisp" "o"))' \ + '(load "sys-proclaim.lisp")(compiler::emit-fn t)' + +compile: + echo ${SETUP} '(pcl::compile-pcl)' | ${LISP} + +saved_pcl: + echo ${SETUP} '(pcl::load-pcl)(si::save-system "saved_pcl")' | ${LISP} + + +# remake the sys-package.lisp and sys-proclaim.lisp files +# Those files may be empty on a first build. +remake-sys-files: + echo ${SETUP} '(pcl::load-pcl)(in-package "PCL")(renew-sys-files)' | ${LISP} + cp sys-proclaim.lisp xxx + cat xxx | sed -e "s/COMPILER::CMP-ANON//g" > sys-proclaim.lisp + +clean: + rm -f *.o diff --git a/pcl/impl/kcl/misc-kcl-patches.text b/pcl/impl/kcl/misc-kcl-patches.text new file mode 100644 index 0000000..54bb9c7 --- /dev/null +++ b/pcl/impl/kcl/misc-kcl-patches.text @@ -0,0 +1,340 @@ +c/cmpaux.c +*** c/cmpaux.c Mon Jul 6 00:14:55 1992 +--- ../akcl-1-615/c/cmpaux.c Thu Jun 18 20:01:07 1992 +*************** +*** 229,239 **** + if (leng > 0 && leng < x->st.st_dim && x->st.st_self[leng]==0) + return x->st.st_self; + if (x->st.st_dim == leng + && ( leng % sizeof(object)) + ) +! { x->st.st_self[leng] = 0; + return x->st.st_self; + } + else + {char *res=malloc(leng+1); + bcopy(x->st.st_self,res,leng); +--- 229,240 ---- + if (leng > 0 && leng < x->st.st_dim && x->st.st_self[leng]==0) + return x->st.st_self; + if (x->st.st_dim == leng + && ( leng % sizeof(object)) + ) +! { if(x->st.st_self[leng] != 0) +! x->st.st_self[leng] = 0; + return x->st.st_self; + } + else + {char *res=malloc(leng+1); + bcopy(x->st.st_self,res,leng); +c/main.c +*** c/main.c Mon Jul 6 00:14:59 1992 +--- ../akcl-1-615/c/main.c Fri Jul 3 02:19:37 1992 +*************** +*** 611,621 **** + {catch_fatal = -1; + if (sgc_enabled) + { sgc_quit();} + if (sgc_enabled==0) + { install_segmentation_catcher() ;} +! FEerror("Caught fatal error [memory may be damaged]"); } + printf("\nUnrecoverable error: %s.\n", s); + fflush(stdout); + #ifdef UNIX + abort(); + #endif +--- 611,621 ---- + {catch_fatal = -1; + if (sgc_enabled) + { sgc_quit();} + if (sgc_enabled==0) + { install_segmentation_catcher() ;} +! FEerror("Caught fatal error [memory may be damaged] ~A",1,make_simple_string(s)); } + printf("\nUnrecoverable error: %s.\n", s); + fflush(stdout); + #ifdef UNIX + abort(); + #endif +*************** +*** 853,872 **** + + siLsave_system() + { + int i; + +- #ifdef HAVE_YP_UNBIND +- extern object truename(),namestring(); + check_arg(1); +! /* prevent subsequent consultation of yp by getting +! truename now*/ +! vs_base[0]=namestring(truename(vs_base[0])); +! {char name[200]; +! char *dom = name; +! if (0== getdomainname(dom,sizeof(name))) +! yp_unbind(dom);} + #endif + + saving_system = TRUE; + GBC(t_contiguous); + +--- 853,867 ---- + + siLsave_system() + { + int i; + + check_arg(1); +! #ifdef HAVE_YP_UNBIND +! /* see unixsave.c */ +! {char *dname; +! yp_get_default_domain(&dname);} + #endif + + saving_system = TRUE; + GBC(t_contiguous); + +c/num_log.c +*** c/num_log.c Mon Jul 6 00:15:00 1992 +--- ../akcl-1-615/c/num_log.c Mon Jun 15 21:15:59 1992 +*************** +*** 266,286 **** + return(~j); + } + + int + big_bitp(x, p) +! object x; +! int p; + { GEN u = MP(x); + int ans ; + int i = p /32; + if (signe(u) < 0) + { save_avma; + u = complementi(u); + restore_avma; + } +! if (i < lgef(u)) + { ans = ((MP_ITH_WORD(u,i,lgef(u))) & (1 << p%32));} + else if (big_sign(x) < 0) ans = 1; + else ans = 0; + return ans; + } +--- 266,286 ---- + return(~j); + } + + int + big_bitp(x, p) +! object x; +! int p; + { GEN u = MP(x); + int ans ; + int i = p /32; + if (signe(u) < 0) + { save_avma; + u = complementi(u); + restore_avma; + } +! if (i < lgef(u) -MP_CODE_WORDS) + { ans = ((MP_ITH_WORD(u,i,lgef(u))) & (1 << p%32));} + else if (big_sign(x) < 0) ans = 1; + else ans = 0; + return ans; + } +c/unixsave.c +*** c/unixsave.c Mon Jul 6 00:15:07 1992 +--- ../akcl-1-615/c/unixsave.c Fri Jul 3 02:52:36 1992 +*************** +*** 71,81 **** +--- 71,160 ---- + break; + } else + break; + } + ++ #include "page.h" + ++ /* string is aligned on a word boundary */ ++ int ++ find_string_in_memory(string,length,other_p,function) ++ char *string; ++ int length,other_p; ++ int *function(); ++ { ++ int *imem_first,*imem_last,*imem,word; ++ char *mem; ++ int len,page_first,page_last,i; ++ int maxpage = page(heap_end); ++ if(((int)string & 3) == 0 && length >= 4) /* just to be safe */ ++ {word=*(int *)string; ++ for (page_first = 0; page_first < maxpage; page_first++) ++ if ((enum type)type_map[page_first] != t_other) ++ break; ++ for (; page_first < maxpage; page_first++) ++ if (((enum type)type_map[page_first] == t_other)?other_p:!other_p) ++ {for (page_last = page_first+1; page_last < maxpage; page_last++) ++ if ( !(((enum type)type_map[page_last] == t_other)?other_p:!other_p) ) ++ break; ++ imem_first=(int *)pagetochar(page_first); ++ imem_last=(int *)( ( ((int)pagetochar(page_last)) - length) &~3 ); ++ for (imem = imem_first; imem <= imem_last; imem++) ++ if (*imem == word) ++ {mem=(char *)imem; ++ for(i=4; i=length) ++ if((*function)(mem)) ++ return TRUE;}}} ++ return FALSE; ++ } ++ ++ int ++ fsim_first(address) ++ char *address; ++ { ++ return TRUE; ++ } ++ ++ int ++ fsim_reset_pointer(address) ++ char **address; ++ { ++ *address = NULL; ++ return FALSE; ++ } ++ ++ #define t_other_PAGES TRUE ++ #define NOT_t_other_PAGES FALSE ++ ++ int ++ reset_other_pointers(address) ++ char *address; ++ { ++ int word=(int)address; ++ find_string_in_memory(&word,4,t_other_PAGES,fsim_reset_pointer); ++ } ++ ++ int ++ maybe_reset_pointers(address) ++ char *address; ++ { ++ int word=(int)address; ++ if(!find_string_in_memory(&word,4,NOT_t_other_PAGES,fsim_first)) ++ reset_other_pointers(address); ++ return FALSE; ++ } ++ ++ reset_other_pointers_to_string(string) ++ char *string; ++ { ++ int length=strlen(string)+1; ++ find_string_in_memory(string,length,t_other_PAGES,maybe_reset_pointers); ++ } ++ ++ bool saving_system; ++ + memory_save(original_file, save_file) + char *original_file, *save_file; + { MEM_SAVE_LOCALS; + char *data_begin, *data_end; + int original_data; +*************** +*** 100,110 **** +--- 179,206 ---- + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { + fprintf(stderr, "Can't open the save file.\n"); + exit(1); + } ++ + setbuf(save, stdout_buf); ++ ++ #ifdef HAVE_YP_UNBIND ++ /* yp_get_default_domain() caches the result of getdomainname() in ++ a malloc'ed block of memory; and gethostbyname saves the result of ++ yp_get_default_domain() in yet another chunk of memory. These ++ cached values will cause problems if the saved image is run on a ++ machine having a different local domainname. [When getdomainname ++ is called (by CLX, for example) KCL will wait forever.] There doesn't ++ seem to be any way to uncache these things (apparently yp_unbind does ++ not do this), nor any good way to find these blocks of memory. */ ++ ++ if(saving_system) ++ {char *dname; ++ yp_get_default_domain(&dname); ++ reset_other_pointers(dname);} ++ #endif + + READ_HEADER; + FILECPY_HEADER; + + for (n = header.a_data, p = data_begin; ; n -= BUFSIZ, p += BUFSIZ) +cmpnew/cmpcall.lsp +*** cmpnew/cmpcall.lsp Mon Jul 6 00:15:13 1992 +--- ../akcl-1-615/cmpnew/cmpcall.lsp Thu Jun 18 21:43:24 1992 +*************** +*** 118,127 **** +--- 118,128 ---- + ;;; responsible for maintaining this condition. + (let ((*vs* *vs*) (form (caddr funob))) + (declare (object form)) + (cond ((and (listp args) + *use-sfuncall* ++ (<= (length (cdr args)) 10) + ;;Determine if only one value at most is required: + (or + (eq *value-to-go* 'trash) + (and (consp *value-to-go*) + (eq (car *value-to-go*) 'var)) +lsp/autoload.lsp +*** lsp/autoload.lsp Mon Jul 6 00:15:27 1992 +--- ../akcl-1-615/lsp/autoload.lsp Tue Jun 16 02:36:45 1992 +*************** +*** 430,440 **** + '(cons + fixnum bignum ratio short-float long-float complex + character symbol package hash-table + array vector string bit-vector + structure stream random-state readtable pathname +! cfun cclosure sfun gfun cfdata spice fat-string )) + + (defun room (&optional x) + (let ((l (multiple-value-list (si:room-report))) + maxpage leftpage ncbpage maxcbpage ncb cbgbccount npage + rbused rbfree nrbpage +--- 430,440 ---- + '(cons + fixnum bignum ratio short-float long-float complex + character symbol package hash-table + array vector string bit-vector + structure stream random-state readtable pathname +! cfun cclosure sfun gfun vfun cfdata spice fat-string dclosure)) + + (defun room (&optional x) + (let ((l (multiple-value-list (si:room-report))) + maxpage leftpage ncbpage maxcbpage ncb cbgbccount npage + rbused rbfree nrbpage +lsp/cmpinit.lsp +*** lsp/cmpinit.lsp Mon Jul 6 00:15:28 1992 +--- ../akcl-1-615/lsp/cmpinit.lsp Mon Jun 22 17:11:11 1992 +*************** +*** 4,12 **** + (setq compiler::*eval-when-defaults* '(compile eval load)) + (or (fboundp 'si::get-&environment) (load "defmacro.lsp")) + ;(or (get 'si::s-data 'si::s-data) + ; (progn (load "../lsp/setf.lsp") (load "../lsp/defstruct.lsp"))) + (if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp")) +! +! + + ;;;;; +--- 4,13 ---- + (setq compiler::*eval-when-defaults* '(compile eval load)) + (or (fboundp 'si::get-&environment) (load "defmacro.lsp")) + ;(or (get 'si::s-data 'si::s-data) + ; (progn (load "../lsp/setf.lsp") (load "../lsp/defstruct.lsp"))) + (if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp")) +! (unless (get 'si::basic-wrapper 'si::s-data) +! (setf (get 'si::s-data 'si::s-data) nil) +! (load "../lsp/defstruct.lsp")) + + ;;;;; diff --git a/pcl/impl/kcl/new-kcl-wrapper.text b/pcl/impl/kcl/new-kcl-wrapper.text new file mode 100644 index 0000000..7f161a6 --- /dev/null +++ b/pcl/impl/kcl/new-kcl-wrapper.text @@ -0,0 +1,2157 @@ +The new-kcl-wrapper modifications make the storage of standard-objects +and structure objects much more similar than before. These changes should +greatly speed up WRAPPER-OF for structure objects and should speed up +WRAPPER-OF for standard-instances also (but not funcallable instances). + +Look first at the defstructs defined here (scan this file for "(defstruct ("). +Then look at cache.lisp, at the "#+structure-wrapper" for the new definition of +the wrapper structure. Finally, look in low.lisp, at the +"#+new-structure-wrapper" for the definition of %allocate-instance--class. + +You need to have akcl-1-615 to use this file. + +This file contains new versions of the files V/c/structure.c and +V/lsp/defstruct.lsp, as well as small changes to the files c/gbc.c, c/sgbc.c, +cmpnew/cmpinit.lsp, lsp/cmpinit.lsp, and lsp/describe.lsp. + +-- The gbc changes allow the garbage collector to work correctly even when +structures which define other structures (ones which can be the value of +STRUCTURE-DEF) are not allocated in static storage. + + +c/gbc.c +*** c/gbc.c Tue Jun 30 04:11:00 1992 +--- ../akcl-1-615/c/gbc.c Tue Jun 30 02:48:04 1992 +*************** +*** 427,453 **** + break; + goto COPY_STRING; + + case t_structure: + mark_object(x->str.str_def); + p = x->str.str_self; + if (p == NULL) +! break; +! {object def=x->str.str_def; +! unsigned char * s_type = &SLOT_TYPE(def,0); +! unsigned short *s_pos= & SLOT_POS(def,0); +! for (i = 0, j = S_DATA(def)->length; i < j; i++) + if (s_type[i]==0) mark_object(STREF(object,x,s_pos[i])); + if ((int)what_to_collect >= (int)t_contiguous) { + if (inheap(x->str.str_self)) { + if (what_to_collect == t_contiguous) + mark_contblock((char *)p, +! S_DATA(def)->size); + + } else +! x->str.str_self = (object *) +! copy_relblock((char *)p, S_DATA(def)->size); + }} + break; + + case t_stream: + switch (x->sm.sm_mode) { +--- 427,461 ---- + break; + goto COPY_STRING; + + case t_structure: ++ x->d.m = 2; + mark_object(x->str.str_def); + p = x->str.str_self; + if (p == NULL) +! {x->d.m = TRUE; break;} +! {object def=x->str.str_def; +! struct s_data *sdef=S_DATA(def); +! unsigned char *s_type; +! unsigned short *s_pos; +! if((int)what_to_collect >= (int)t_contiguous && +! !inheap(sdef) && def->d.m==TRUE) +! sdef=(struct s_data *)(((char *)sdef)+(rb_start1-rb_start)); +! s_type = sdef->raw->ust.ust_self; +! s_pos = &USHORT(sdef->slot_position,0); +! for (i = 0, j = sdef->length; i < j; i++) + if (s_type[i]==0) mark_object(STREF(object,x,s_pos[i])); + if ((int)what_to_collect >= (int)t_contiguous) { + if (inheap(x->str.str_self)) { + if (what_to_collect == t_contiguous) + mark_contblock((char *)p, +! sdef->size); + + } else +! x->str.str_self = (object *) +! copy_relblock((char *)p, sdef->size); + }} ++ x->d.m = TRUE; + break; + + case t_stream: + switch (x->sm.sm_mode) { +*** c/sgbc.c Mon Jun 15 21:16:01 1992 +--- akcl-1-615/c/sgbc.c Wed Jul 1 18:37:24 1992 +*************** +*** 355,386 **** + if (cp == NULL) + break; + goto COPY_STRING; + + case t_structure: + sgc_mark_object(x->str.str_def); + p = x->str.str_self; + if (p == NULL) +! break; +! {object def=x->str.str_def; +! unsigned char * s_type = &SLOT_TYPE(def,0); +! unsigned short *s_pos= & SLOT_POS(def,0); +! for (i = 0, j = S_DATA(def)->length; i < j; i++) + if (s_type[i]==0 && + ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i])) + ) + sgc_mark_object(STREF(object,x,s_pos[i])); + if ((int)what_to_collect >= (int)t_contiguous) { + if (inheap(x->str.str_self)) { + if (what_to_collect == t_contiguous) + mark_contblock((char *)p, +! S_DATA(def)->size); + + } else if(SGC_RELBLOCK_P(p)) + x->str.str_self = (object *) +! copy_relblock((char *)p, S_DATA(def)->size); + }} + break; + + case t_stream: + switch (x->sm.sm_mode) { + case smm_input: +--- 355,394 ---- + if (cp == NULL) + break; + goto COPY_STRING; + + case t_structure: ++ x->d.m = 2; + sgc_mark_object(x->str.str_def); + p = x->str.str_self; + if (p == NULL) +! {x->d.m = TRUE; break;} +! {object def=x->str.str_def; +! struct s_data *sdef=S_DATA(def); +! unsigned char *s_type; +! unsigned short *s_pos; +! if((int)what_to_collect >= (int)t_contiguous && +! !inheap(sdef) && def->d.m==TRUE) +! sdef=(struct s_data *)(((char *)sdef)+(rb_start1-rb_start)); +! s_type = sdef->raw->ust.ust_self; +! s_pos = &USHORT(sdef->slot_position,0); +! for (i = 0, j = sdef->length; i < j; i++) + if (s_type[i]==0 && + ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i])) + ) + sgc_mark_object(STREF(object,x,s_pos[i])); + if ((int)what_to_collect >= (int)t_contiguous) { + if (inheap(x->str.str_self)) { + if (what_to_collect == t_contiguous) + mark_contblock((char *)p, +! sdef->size); + + } else if(SGC_RELBLOCK_P(p)) + x->str.str_self = (object *) +! copy_relblock((char *)p, sdef->size); + }} ++ x->d.m = TRUE; + break; + + case t_stream: + switch (x->sm.sm_mode) { + case smm_input: +cmpnew/cmpinit.lsp +*** cmpnew/cmpinit.lsp Tue Jun 30 04:11:13 1992 +--- ../akcl-1-615/cmpnew/cmpinit.lsp Mon Jun 22 18:41:51 1992 +*************** +*** 4,7 **** +--- 4,10 ---- + (load "sys-proclaim.lisp") + (setq compiler::*eval-when-defaults* '(compile eval load)) + + ;(dolist (v '( cmpeval cmpopt cmptype cmpbind cmpinline cmploc cmpvar cmptop cmplet cmpcall cmpmulti cmplam cmplabel cmpeval)) (load (format nil "~(~a~).lsp" v))) ++ (unless (get 'si::basic-wrapper 'si::s-data) ++ (setf (get 'si::s-data 'si::s-data) nil) ++ (load "../lsp/defstruct.lsp")) +lsp/cmpinit.lsp +*** lsp/cmpinit.lsp Tue Jun 30 04:11:26 1992 +--- ../akcl-1-615/lsp/cmpinit.lsp Mon Jun 22 17:11:11 1992 +*************** +*** 5,12 **** + (or (fboundp 'si::get-&environment) (load "defmacro.lsp")) + ;(or (get 'si::s-data 'si::s-data) + ; (progn (load "../lsp/setf.lsp") (load "../lsp/defstruct.lsp"))) + (if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp")) +! +! + + ;;;;; +--- 5,13 ---- + (or (fboundp 'si::get-&environment) (load "defmacro.lsp")) + ;(or (get 'si::s-data 'si::s-data) + ; (progn (load "../lsp/setf.lsp") (load "../lsp/defstruct.lsp"))) + (if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp")) +! (unless (get 'si::basic-wrapper 'si::s-data) +! (setf (get 'si::s-data 'si::s-data) nil) +! (load "../lsp/defstruct.lsp")) + + ;;;;; +lsp/describe.lsp +*** lsp/describe.lsp Tue Jun 30 04:11:27 1992 +--- ../akcl-1-615/lsp/describe.lsp Tue Jun 23 16:39:07 1992 +*************** +*** 266,282 **** + + (defun inspect-structure (x &aux name) + (format t "Structure of type ~a ~%Byte:[Slot Type]Slot Name :Slot Value" + (setq name (type-of x))) +! (let* ((sd (get name 'si::s-data)) + (spos (s-data-slot-position sd))) + (dolist (v (s-data-slot-descriptions sd)) + (format t "~%~4d:~@[[~s] ~]~20a:~s" +! (aref spos (nth 4 v)) +! (let ((type (nth 2 v))) + (if (eq t type) nil type)) +! (car v) +! (structure-ref1 x (nth 4 v)))))) + + + (defun inspect-object (object &aux (*inspect-level* *inspect-level*)) + (inspect-indent) +--- 266,282 ---- + + (defun inspect-structure (x &aux name) + (format t "Structure of type ~a ~%Byte:[Slot Type]Slot Name :Slot Value" + (setq name (type-of x))) +! (let* ((sd (structure-def x)) + (spos (s-data-slot-position sd))) + (dolist (v (s-data-slot-descriptions sd)) + (format t "~%~4d:~@[[~s] ~]~20a:~s" +! (aref spos (slot-offset v)) +! (let ((type (slot-type v))) + (if (eq t type) nil type)) +! (slot-name v) +! (structure-ref1 x (slot-offset v)))))) + + + (defun inspect-object (object &aux (*inspect-level* *inspect-level*)) + (inspect-indent) +============================================================================== +=============================== c/structure.c ================================ +Changes file for /kcl/c/structure.c +Usage \n@s[Original text\n@s|Replacement Text\n@s] +See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c +for a program to merge change files. Anything not between + "\n@s[" and "\n@s]" is a simply a comment. +This file was constructed using emacs and merge.el + by (Bill Schelter) wfs@carl.ma.utexas.edu + + +****Change:(orig (15 17 d)) +@s[object siSstructure_print_function; +object siSstructure_slot_descriptions; +object siSstructure_include; + +@s| +@s] + + +****Change:(orig (18 18 a)) +@s[ + +@s| +#define COERCE_DEF(x) if (type_of(x)==t_symbol) \ + x=getf(x->s.s_plist,siLs_data,Cnil) + +#define check_type_structure(x) \ + if(type_of((x))!=t_structure) \ + FEwrong_type_argument(Sstructure,(x)) + + + +@s] + + +****Change:(orig (22 31 c)) +@s[{ + do { + if (type_of(x) != t_symbol) + return(FALSE); + +@s, } while (x != Cnil); + return(FALSE); +} + +@s|{ if (x==y) return 1; + if (type_of(x)!= t_structure + || type_of(y)!=t_structure) + FEerror("bad call to structure_subtypep",0); + {if (S_DATA(y)->included == Cnil) return 0; + while ((x=S_DATA(x)->includes) != Cnil) + { if (x==y) return 1;} + return 0; + }} + +@s] + + +****Change:(orig (32 32 a)) +@s[ + +@s| +static +bad_raw_type() +{ FEerror("Bad raw struct type",0);} + + + +@s] + + +****Change:(orig (34 34 c)) +@s[structure_ref(x, name, n) + +@s|structure_ref(x, name, i) + +@s] + + +****Change:(orig (36 38 c)) +@s[object x, name; +int n; +{ + int i; + +@s|object x, name; +int i; +{unsigned short *s_pos; + COERCE_DEF(name); + if (type_of(x) != t_structure || + (type_of(name)!=t_structure) || + !structure_subtypep(x->str.str_def, name)) + FEwrong_type_argument((type_of(name)==t_structure ? + S_DATA(name)->name : name), + x); + s_pos = &SLOT_POS(x->str.str_def,0); + switch((SLOT_TYPE(x->str.str_def,i))) + { + case aet_object: return(STREF(object,x,s_pos[i])); + case aet_fix: return(make_fixnum((STREF(int,x,s_pos[i])))); + case aet_ch: return(code_char(STREF(char,x,s_pos[i]))); + case aet_bit: + case aet_char: return(make_fixnum(STREF(char,x,s_pos[i]))); + case aet_sf: return(make_shortfloat(STREF(shortfloat,x,s_pos[i]))); + case aet_lf: return(make_longfloat(STREF(longfloat,x,s_pos[i]))); + case aet_uchar: return(make_fixnum(STREF(unsigned char,x,s_pos[i]))); + case aet_ushort: return(make_fixnum(STREF(unsigned short,x,s_pos[i]))); + case aet_short: return(make_fixnum(STREF(short,x,s_pos[i]))); + default: + bad_raw_type(); + return 0; + }} + +@s] + + +****Change:(orig (40 43 c)) +@s[ if (type_of(x) != t_structure || + !structure_subtypep(x->str.str_name, name)) + FEwrong_type_argument(name, x); + return(x->str.str_self[n]); + +@s| +void +siLstructure_ref1() +{object x=vs_base[0]; + int n=fix(vs_base[1]); + object def; + check_type_structure(x); + def=x->str.str_def; + if(n>= S_DATA(def)->length) + FEerror("Structure ref out of bounds",0); + vs_base[0]=structure_ref(x,x->str.str_def,n); + vs_top=vs_base+1; + +@s] + + +****Change:(orig (45 45 a)) +@s[} + + +@s|} + +void +siLstructure_set1() +{object x=vs_base[0]; + int n=fix(vs_base[1]); + object v=vs_base[2]; + object def; + check_type_structure(x); + def=x->str.str_def; + if(n>= S_DATA(def)->length) + FEerror("Structure ref out of bounds",0); + vs_base[0]=structure_set(x,x->str.str_def,n,v); + vs_top=vs_base+1; +} + + + +@s] + + +****Change:(orig (47 47 c)) +@s[structure_set(x, name, n, v) + +@s|structure_set(x, name, i, v) + +@s] + + +****Change:(orig (49 51 c)) +@s[object x, name, v; +int n; +{ + int i; + +@s|object x, name, v; +int i; +{unsigned short *s_pos; + + COERCE_DEF(name); + if (type_of(x) != t_structure || + type_of(name) != t_structure || + !structure_subtypep(x->str.str_def, name)) + FEwrong_type_argument((type_of(name)==t_structure ? + S_DATA(name)->name : name) + , x); + +@s] + + +****Change:(orig (53 57 c)) +@s[ if (type_of(x) != t_structure || + !structure_subtypep(x->str.str_name, name)) + FEwrong_type_argument(name, x); + x->str.str_self[n] = v; + +@s, return(v); + +@s|#ifdef SGC + /* make sure the structure header is on a writable page */ + if (x->d.m) FEerror("bad gc field",0); else x->d.m = 0; +#endif + + s_pos= & SLOT_POS(x->str.str_def,0); + switch(SLOT_TYPE(x->str.str_def,i)){ + + case aet_object: STREF(object,x,s_pos[i])=v; break; + case aet_fix: (STREF(int,x,s_pos[i]))=fix(v); break; + case aet_ch: STREF(char,x,s_pos[i])=char_code(v); break; + case aet_bit: + case aet_char: STREF(char,x,s_pos[i])=fix(v); break; + case aet_sf: STREF(shortfloat,x,s_pos[i])=sf(v); break; + case aet_lf: STREF(longfloat,x,s_pos[i])=lf(v); break; + case aet_uchar: STREF(unsigned char,x,s_pos[i])=fix(v); break; + case aet_ushort: STREF(unsigned short,x,s_pos[i])=fix(v); break; + case aet_short: STREF(short,x,s_pos[i])=fix(v); break; + default: + bad_raw_type(); + + } + return(v); + +@s] + + +****Change:(orig (59 59 a)) +@s[} + + +@s|} + +void +siLstructure_subtype_p() +{object x,y; + check_arg(2); + x=vs_base[0]; + y=vs_base[1]; + if (type_of(x)!=t_structure) + {vs_base[0]=Cnil; goto BOTTOM;} + x=x->str.str_def; + COERCE_DEF(y); + if (structure_subtypep(x,y)) vs_base[0]=Ct; + else vs_base[0]=Cnil; + BOTTOM: + vs_top=vs_base+1; +} + +static object +slot_name(x) + object x; +{ + if(type_of(x)==t_cons) + return car(x); + if(type_of(x)==t_structure) + return x->str.str_self[0]; + return Cnil; +} + + +@s] + + +****Change:(orig (64 64 a)) +@s[object x; +{ + object *p, s; + +@s|object x; +{ + object *p, s; + struct s_data *def=S_DATA(x->str.str_def); + +@s] + + +****Change:(orig (66 69 c)) +@s[ + s = getf(x->str.str_name->s.s_plist, + siSstructure_slot_descriptions, Cnil); + vs_push(x->str.str_name); + +@s| + s = def->slot_descriptions; + vs_push(def->name); + +@s] + + +****Change:(orig (72 73 c)) +@s[ for (i=0, n=x->str.str_length; !endp(s)&&ic.c_cdr, i++) { + *p = make_cons(car(s->c.c_car), Cnil); + +@s| for (i=0, n=def->length; !endp(s)&&ic.c_cdr, i++) { + *p = make_cons(slot_name(s->c.c_car), Cnil); + +@s] + + +****Change:(orig (75 75 c)) +@s[ *p = make_cons(x->str.str_self[i], Cnil); + +@s| *p = make_cons(structure_ref(x,x->str.str_def,i), Cnil); + +@s] + + +****Change:(orig (81 81 a)) +@s[ stack_cons(); + return(vs_pop); +} + + +@s| stack_cons(); + return(vs_pop); +} + +void + +@s] + + +****Change:(orig (84 85 c)) +@s[ object x; + int narg, i; + +@s| object x,name,*base; + struct s_data *def; + int narg, i,size; + base=vs_base; + if ((narg = vs_top - base) == 0) + too_few_arguments(); + x = alloc_object(t_structure); + name=base[0]; + COERCE_DEF(name); + if (type_of(name)!=t_structure || + (def=S_DATA(name))->length != --narg) + FEerror("Bad make_structure args for type ~a",1, + base[0]); + x->str.str_def = name; + x->str.str_self = NULL; + size=S_DATA(name)->size; + base[0] = x; + x->str.str_self = (object *) + (def->staticp == Cnil ? alloc_relblock(size) + : alloc_contblock(size)); + /* There may be holes in the structure. + We want them zero, so that equal can work better. + */ + if (S_DATA(name)->has_holes != Cnil) + bzero(x->str.str_self,size); + {unsigned char *s_type; + unsigned short *s_pos; + s_pos= (&SLOT_POS(x->str.str_def,0)); + s_type = (&(SLOT_TYPE(x->str.str_def,0))); + base=base+1; + for (i = 0; i < narg; i++) + {object v=base[i]; + switch(s_type[i]){ + + case aet_object: STREF(object,x,s_pos[i])=v; break; + case aet_fix: (STREF(int,x,s_pos[i]))=fix(v); break; + case aet_ch: STREF(char,x,s_pos[i])=char_code(v); break; + case aet_bit: + case aet_char: STREF(char,x,s_pos[i])=fix(v); break; + case aet_sf: STREF(shortfloat,x,s_pos[i])=sf(v); break; + case aet_lf: STREF(longfloat,x,s_pos[i])=lf(v); break; + case aet_uchar: STREF(unsigned char,x,s_pos[i])=fix(v); break; + case aet_ushort: STREF(unsigned short,x,s_pos[i])=fix(v); break; + case aet_short: STREF(short,x,s_pos[i])=fix(v); break; + default: + bad_raw_type(); + +@s] + + +****Change:(orig (87 97 c)) +@s[ if ((narg = vs_top - vs_base) == 0) + too_few_arguments(); + x = alloc_object(t_structure); + x->str.str_name = vs_base[0]; + +@s, x->str.str_self[i] = vs_top[i]; + +@s| }} + vs_top = base; + vs_base=base-1; + + } + +@s] + + +****Change:(orig (99 99 a)) +@s[} + + +@s|} + +void + +@s] + + +****Change:(orig (103 103 c)) +@s[ object x, y; + int i, j; + +@s| object x, y; + struct s_data *def; + +@s] + + +****Change:(orig (105 105 c)) +@s[ + check_arg(2); + +@s| + if (vs_top-vs_base < 1) too_few_arguments(); + +@s] + + +****Change:(orig (107 110 c)) +@s[ if (type_of(x) != t_structure || x->str.str_name != vs_base[1]) + FEwrong_type_argument(vs_base[1], x); + vs_base[1] = y = alloc_object(t_structure); + y->str.str_name = x->str.str_name; + +@s| check_type_structure(x); + vs_base[0] = y = alloc_object(t_structure); + def=S_DATA(y->str.str_def = x->str.str_def); + +@s] + + +****Change:(orig (112 116 c)) +@s[ y->str.str_length = j = x->str.str_length; + y->str.str_self = (object *)alloc_relblock(sizeof(object)*j); + for (i = 0; i < j; i++) + y->str.str_self[i] = x->str.str_self[i]; + +@s, vs_base++; + +@s| y->str.str_self = (object *)alloc_relblock(def->size); + bcopy(x->str.str_self,y->str.str_self,def->size); + vs_top=vs_base+1; + +@s] + + +****Change:(orig (118 118 a)) +@s[} + + +@s|} + +void +siLcopy_structure_header() +{ + object x, y; + + if (vs_top-vs_base < 1) too_few_arguments(); + x = vs_base[0]; + check_type_structure(x); + vs_base[0] = y = alloc_object(t_structure); + y->str.str_def = x->str.str_def; + y->str.str_self = x->str.str_self; + vs_top=vs_base+1; +} + + +void + +@s] + + +****Change:(orig (122 124 c)) +@s[ if (type_of(vs_base[0]) != t_structure) + FEwrong_type_argument(Sstructure, vs_base[0]); + vs_base[0] = vs_base[0]->str.str_name; + +@s| check_type_structure(vs_base[0]); + vs_base[0] = S_DATA(vs_base[0]->str.str_def)->name; + +@s] + + +****Change:(orig (127 127 c)) +@s[} + +siLstructure_ref() + +@s|} + +#define FIND_SLOT(str,name) ((type_of(name)==t_fixnum)?fix(name): \ + structure_slot_position(str,name)) + +object +structure_ref_new(x, name, i) + object x,name,i; + +@s] + + +****Change:(orig (129 131 c)) +@s[ object x; + int i; + check_arg(3); + +@s| return structure_ref(x,name,FIND_SLOT(x,i)); +} + +@s] + + +****Change:(orig (133 144 c)) +@s[ x = vs_base[0]; + if (type_of(x) != t_structure || + !structure_subtypep(x->str.str_name, vs_base[1])) + FEwrong_type_argument(vs_base[1], x); + +@s, vs_base[0] = x->str.str_self[i]; + vs_top = vs_base+1; + +@s|object +structure_set_new(x, name, i, v) + object x,name,i,v; +{ + return structure_set(x,name,FIND_SLOT(x,i),v); + +@s] + + +****Change:(orig (146 146 a)) +@s[} + + +@s|} + +void +siLstructure_ref() +{ + check_arg(3); + vs_base[0]=structure_ref_new(vs_base[0],vs_base[1],vs_base[2]); + vs_top=vs_base+1; +} + +void + +@s] + + +****Change:(orig (149 150 d)) +@s[siLstructure_set() +{ + object x; + int i; + +@s|siLstructure_set() +{ + +@s] + + +****Change:(orig (152 163 c)) +@s[ + x = vs_base[0]; + if (type_of(x) != t_structure || + !structure_subtypep(x->str.str_name, vs_base[1])) + +@s, x->str.str_self[i] = vs_base[3]; + +@s| structure_set_new(vs_base[0],vs_base[1],vs_base[2],vs_base[3]); + +@s] + + +****Change:(orig (166 166 a)) +@s[ vs_base = vs_top-1; +} + + +@s| vs_base = vs_top-1; +} + +void + +@s] + + +****Change:(orig (228 228 c)) +@s[init_structure_function() + +@s|void +siLmake_s_data_structure() +{object x,y,raw,*base; + int i; + check_arg(5); + x=vs_base[0]; + base=vs_base; + raw=vs_base[1]; + y=alloc_object(t_structure); + y->str.str_def=y; + y->str.str_self = (object *)( x->v.v_self); + S_DATA(y)->name =siLs_data; + S_DATA(y)->length=(raw->v.v_dim); + S_DATA(y)->raw =raw; + for(i=3; iv.v_dim; i++) + y->str.str_self[i]=Cnil; + S_DATA(y)->slot_position=base[2]; + S_DATA(y)->slot_descriptions=base[3]; + S_DATA(y)->staticp=base[4]; + S_DATA(y)->size = (raw->v.v_dim)*sizeof(object); + vs_base[0]=y; + vs_top=vs_base+1; +} + +object siSstructure_init,siSstructure_init_named; +object siSname,siSdefault_init; +object siSraw,siSslot_position,siSsize,siSstaticp,siSslot_descriptions; + +static object +slot_value(str,name) + object str,name; + +@s] + + +****Change:(orig (230 237 c)) +@s[ siSstructure_print_function + = make_si_ordinary("STRUCTURE-PRINT-FUNCTION"); + enter_mark_origin(&siSstructure_print_function); + siSstructure_slot_descriptions + +@s, enter_mark_origin(&siSstructure_include); + +@s| top: + if(type_of(str)==t_structure) + return structure_ref_new(str,str->str.str_def,name); + if(str->c.c_car==siSstructure_init_named) + {object new=get(str->c.c_cdr,siLs_data); + str->c.c_car=siSstructure_init; + str->c.c_cdr=(type_of(new)==t_structure)?new:cdr(new);} + if(siSstructure_init!=car(str)) + FEerror("Illegal call to SI:MAKE-STRUCTURES 1",0); + {object key=intern(coerce_to_string(name),keyword_package); + object value=getf(cdddr(str),key,NULL); + if(value!=NULL) + return value; + else + {object slots; + if(str==caddr(str)&&name==siSslot_descriptions) + FEerror("Illegal call to SI:MAKE-STRUCTURES 2",0); + slots=slot_value(caddr(str),siSslot_descriptions); + for(;!endp(slots);slots=cdr(slots)) + if(name==slot_value(car(slots),siSname)) + {object result,form=slot_value(car(slots),siSdefault_init); + object *old_vs_base=vs_base,*old_vs_top=vs_top; + vs_base=vs_top;vs_push(form);Leval();result=vs_base[0]; + vs_base=old_vs_base; vs_top=old_vs_top; + return result;} + FEerror("Illegal call to SI:MAKE-STRUCTURES 3",0);}} + return Cnil; +} + +@s] + + +****Change:(orig (238 238 a)) +@s[ + +@s| +int +structure_slot_position(str,name) + object str,name; +{ + if(type_of(name)==t_fixnum) + return fix(name); + else + {object slotd_list; + int pos; + check_type_structure(str); + slotd_list=S_DATA(str->str.str_def)->slot_descriptions; + for(pos=0; type_of(slotd_list)==t_cons; pos++,slotd_list=cdr(slotd_list)) + {object slotd=car(slotd_list); + if(name==((type_of(slotd)==t_structure)? + slotd->str.str_self[0]:slot_value(slotd,siSname))) + return pos;} + FEerror("Slot ~S not found in structure ~S",2,name,str); + return 0;} +} + +static object +make_structures_internal(value) + object value; +{ + object str,def; + int def_index,i,ind; + + switch(type_of(value)) + {case t_cons: + if(value->c.c_car==siSstructure_init_named) + {object new=get(value->c.c_cdr,siLs_data); + value->c.c_car=siSstructure_init; + value->c.c_cdr=(type_of(new)==t_structure)?new:cdr(new);} + if(car(value)!=siSstructure_init) + {value->c.c_car=make_structures_internal(value->c.c_car); + value->c.c_cdr=make_structures_internal(value->c.c_cdr); + break;} + if(type_of(cadr(value))==t_structure) + {value=value->c.c_cdr->c.c_car; + break;} + {object def=caddr(value),plist=cdddr(value),result; + object slots,slots_tail; + int size,staticp,len,i; + if(def!=value)def=make_structures_internal(def); + result=alloc_object(t_structure); + result->str.str_def=(def==value)?result:def; + result->str.str_self=NULL; + value->c.c_cdr->c.c_car=result; + size=fixint(slot_value(def,siSsize)); + staticp=Cnil!=slot_value(def,siSstaticp); + slots=slot_value(def,siSslot_descriptions); + len=length(slots); + result->str.str_self=(object *)(staticp?alloc_contblock(size): + alloc_relblock(size)); + bzero(result->str.str_self,size); + if(def==value) + {S_DATA(result)->raw=slot_value(def,siSraw); + S_DATA(result)->slot_position=slot_value(def,siSslot_position);} + for(i=0,slots_tail=slots; istr.str_def,i,svalue);} + for(i=0,slots_tail=slots; istr.str_def,i); + svalue=make_structures_internal(svalue); + structure_set(result,result->str.str_def,i,svalue);} + value=result; + break;} + case t_vector: + if ((enum aelttype)value->v.v_elttype == aet_object) + {int i,len=value->v.v_dim; + for(i=0; iv.v_self[i]=make_structures_internal(value->v.v_self[i]);} + break; + case t_symbol: + {object plist=value->s.s_plist,next; + for(;!endp(plist);plist=cddr(plist)) + {next=plist->c.c_cdr; + if(plist->c.c_car==siLs_data&& + type_of(next->c.c_car)==t_cons) + next->c.c_car=make_structures_internal(next->c.c_car);} + break;}} + return value; +} + +void +siLmake_structures() +{ + check_arg(1); + vs_base[0]=make_structures_internal(vs_base[0]); +} + +void +siLstructure_def() +{check_arg(1); + check_type_structure(vs_base[0]); + vs_base[0]=vs_base[0]->str.str_def; +} + +short aet_sizes [] = { +sizeof(object), /* aet_object t */ +sizeof(char), /* aet_ch string-char */ +sizeof(char), /* aet_bit bit */ +sizeof(fixnum), /* aet_fix fixnum */ +sizeof(float), /* aet_sf short-float */ +sizeof(double), /* aet_lf long-float */ +sizeof(char), /* aet_char signed char */ +sizeof(char), /* aet_uchar unsigned char */ +sizeof(short), /* aet_short signed short */ +sizeof(short) /* aet_ushort unsigned short */ +}; + + + + + +void +siLsize_of() +{ object x= vs_base[0]; + int i; + i= aet_sizes[get_aelttype(x)]; + vs_base[0]=make_fixnum(i); +} + +void +siLaet_type() +{vs_base[0]=make_fixnum(get_aelttype(vs_base[0]));} + + +/* Return N such that something of type ARG can be aligned on + an address which is a multiple of N */ + + +void +siLalignment() +{struct {double x; int y; double z; + float x1; int y1; float z1;} + joe; + joe.z=3.0; + + if (vs_base[0]==Slong_float) + {vs_base[0]=make_fixnum((int)&joe.z- (int)&joe.y); return;} + else + if (vs_base[0]==Sshort_float) + {vs_base[0]=make_fixnum((int)&(joe.z1)-(int)&(joe.y1)); return;} + else + {siLsize_of();} +} + +void +swap_structure_contents(str1,str2) + object str1,str2; +{ + object def1,*self1; + check_type_structure(str1); + check_type_structure(str2); + def1=str1->str.str_def; + self1=str1->str.str_self; + str1->str.str_def=str2->str.str_def; + str1->str.str_self=str2->str.str_self; + str2->str.str_def=def1; + str2->str.str_self=self1; +} + +void +siLswap_structure_contents() +{ + check_arg(2); + swap_structure_contents(vs_base[0],vs_base[1]); + vs_base[0]=Cnil; + vs_top=vs_base+1; +} + +void +siLset_structure_def() +{check_arg(2); + check_type_structure(vs_base[0]); + check_type_structure(vs_base[1]); + vs_base[0]->str.str_def=vs_base[1]; + vs_base[0]=vs_base[1]; + vs_top=vs_base+1; +} + +init_structure_function() +{ + siLs_data=make_si_ordinary("S-DATA"); + siSstructure_init=make_si_ordinary("STRUCTURE-INIT"); + siSstructure_init_named=make_si_ordinary("STRUCTURE-INIT-NAMED"); + siSname=make_si_ordinary("NAME"); + siSdefault_init=make_si_ordinary("DEFAULT-INIT"); + siSraw=make_si_ordinary("RAW"); + siSslot_position=make_si_ordinary("SLOT-POSITION"); + siSsize=make_si_ordinary("SIZE"); + siSstaticp=make_si_ordinary("STATICP"); + siSslot_descriptions=make_si_ordinary("SLOT-DESCRIPTIONS"); + +@s] + + +****Change:(orig (239 239 a)) +@s[ make_si_function("MAKE-STRUCTURE", siLmake_structure); + +@s| make_si_function("MAKE-STRUCTURE", siLmake_structure); + make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure); + +@s] + + +****Change:(orig (240 240 a)) +@s[ make_si_function("COPY-STRUCTURE", siLcopy_structure); + +@s| make_si_function("COPY-STRUCTURE", siLcopy_structure); + make_si_function("COPY-STRUCTURE-HEADER", siLcopy_structure_header); + +@s] + + +****Change:(orig (242 242 a)) +@s[ make_si_function("STRUCTURE-REF", siLstructure_ref); + +@s| make_si_function("STRUCTURE-REF", siLstructure_ref); + make_si_function("STRUCTURE-DEF", siLstructure_def); + make_si_function("STRUCTURE-REF1", siLstructure_ref1); + make_si_function("STRUCTURE-SET1", siLstructure_set1); + +@s] + + +****Change:(orig (245 245 c)) +@s[ make_si_function("STRUCTUREP", siLstructurep); + + +@s| make_si_function("STRUCTUREP", siLstructurep); + make_si_function("SIZE-OF", siLsize_of); + make_si_function("ALIGNMENT",siLalignment); + make_si_function("STRUCTURE-SUBTYPE-P",siLstructure_subtype_p); + +@s] + + +****Change:(orig (247 247 a)) +@s[ make_si_function("LIST-NTH", siLlist_nth); + +@s| make_si_function("LIST-NTH", siLlist_nth); + make_si_function("AET-TYPE",siLaet_type); + make_si_function("SWAP-STRUCTURE-CONTENTS",siLswap_structure_contents); + make_si_function("SET-STRUCTURE-DEF", siLset_structure_def); + make_si_function("MAKE-STRUCTURES", siLmake_structures); + + +@s] + +============================================================================== +============================== V/lsp/defstruct.lsp ============================= +Changes file for /kcl/lsp/defstruct.lsp +Usage \n@s[Original text\n@s|Replacement Text\n@s] +See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c +for a program to merge change files. Anything not between + "\n@s[" and "\n@s]" is a simply a comment. +This file was constructed using emacs and merge.el + by (Bill Schelter) wfs@carl.ma.utexas.edu + + +****Change:(orig (20 71 c)) +@s[(defun make-access-function (name conc-name type named + slot-name default-init slot-type read-only + offset) + (declare (ignore named default-init slot-type)) + +@s, ((error "~S is an illegal structure type." type))))) + +@s|(defvar *accessors* (make-array 10 :adjustable t)) +(defvar *list-accessors* (make-array 2 :adjustable t)) +(defvar *vector-accessors* (make-array 2 :adjustable t)) + +@s] + + +****Change:(orig (72 72 a)) +@s[ + +@s| +(or (fboundp 'record-fn) (setf (symbol-function 'record-fn) + #'(lambda (&rest l) l nil))) + +@s] + + +****Change:(orig (73 73 a)) +@s[ + +@s| +(defun boot-slot-value (str name) + (if (structurep str) + (structure-ref str (structure-def str) name) + (getf (cdddr str) (intern (string name) :keyword)))) + +(defun boot-set-slot-value (str name new-value) + (if (structurep str) + (structure-set str (structure-def str) name new-value) + (setf (getf (cdddr str) (intern (string name) :keyword)) new-value))) + +(defun boot-subtypep (type1 type2) + (or (eq type1 type2) + (let* ((s-data (get type1 's-data)) + (include (boot-s-data-name (boot-slot-value s-data 'includes)))) + (boot-subtypep include type2)))) + +(defun make-slot-boot (&rest args) + (if (get 's-data 's-data) + (apply #'make-slot args) + (list* 'structure-init + nil + '(structure-init-named . slot) + args))) + +(defun make-s-data-boot (&rest args) + (if (get 's-data 's-data) + (apply #'make-s-data args) + (list* 'structure-init + nil + '(structure-init-named . s-data) + args))) + +(defun make-boot-accessor (slot accessor) + (setf (symbol-function accessor) + #'(lambda (object) + (boot-slot-value object slot))) + (let ((writer (intern (format nil "SET ~A" accessor)))) + (setf (symbol-function writer) + #'(lambda (object value) + (boot-set-slot-value object slot value))) + (eval `(defsetf ,accessor ,writer)))) + +(defmacro defstructboot (name &rest slots) + (let ((conc-name (if (listp name) + (string (second (assoc :conc-name (cdr name)))) + (format nil "~A-" name)))) + `(progn + ,@(mapcar #'(lambda (slot) + (let ((fname (intern (format nil "~A~A" conc-name slot)))) + `(make-boot-accessor ',slot ',fname))) + slots)))) + +(defstructboot (slot (:conc-name boot-slot-)) + name default-init type read-only offset accessor-name type-changed) + +(defstructboot (s-data-internal (:conc-name boot-s-data-)) + name length raw included includes staticp print-function + slot-descriptions slot-position size has-holes) + +(defstructboot (basic-wrapper (:conc-name boot-wrapper-)) + cache-number-vector state class) + +(defstructboot (s-data (:conc-name boot-s-data-)) + frozen documentation constructors offset + named type conc-name) + +(defun make-access-function (name conc-name type named include no-fun slot) + (declare (ignore named)) + + (let* ((slot-name (boot-slot-name slot)) + (slot-type (boot-slot-type slot)) + (read-only (boot-slot-read-only slot)) + (offset (boot-slot-offset slot)) + (access-function + (intern (si:string-concatenate (string conc-name) + (string slot-name)))) + accsrs dont-overwrite) + (unless (boot-slot-accessor-name slot) + (setf (boot-slot-accessor-name slot) access-function)) + (ecase type + ((nil) + (setf accsrs *accessors*)) + (list + (setf accsrs *list-accessors*)) + (vector + (setf accsrs *vector-accessors*))) + (or (> (length accsrs) offset) + (adjust-array accsrs (+ offset 10))) + (unless + dont-overwrite + (record-fn access-function 'defun '(t) slot-type) + (or no-fun + (and (fboundp access-function) + (eq (aref accsrs offset) (symbol-function access-function))) + (setf (symbol-function access-function) + (or (aref accsrs offset) + (setf (aref accsrs offset) + (cond ((eq accsrs *accessors*) + #'(lambda (x) + (or (structurep x) + (error "~a is not a structure" x)) + (structure-ref1 x offset))) + ((eq accsrs *list-accessors*) + #'(lambda(x) + (si:list-nth offset x))) + ((eq accsrs *vector-accessors*) + #'(lambda(x) + (aref x offset))))))))) + (cond (read-only + (remprop access-function 'structure-access) + (setf (get access-function 'struct-read-only) t)) + (t (remprop access-function 'setf-update-fn) + (remprop access-function 'setf-lambda) + (remprop access-function 'setf-documentation) + (let ((tem (get access-function 'structure-access))) + (cond ((and (consp tem) include + (if (consp (get include 's-data)) + (boot-subtypep include (car tem)) + (subtypep include (car tem))) + (eql (cdr tem) offset)) + ;; don't change overwrite accessor of subtype. + (setq dont-overwrite t) + ) + (t (setf (get access-function 'structure-access) + (cons (if type type name) offset))))))) + nil)) + + +@s] + + +****Change:(orig (80 89 c)) +@s[ (cond ((null x) + ;; If the slot-description is NIL, + ;; it is in the padding of initial-offset. + nil) + +@s, (t (car x)))) + +@s| (or (boot-slot-name x) + (and (boot-slot-default-init x) + ;; If the slot name is NIL, + ;; it is the structure name. + ;; This is for typed structures with names. + (list 'quote (boot-slot-default-init x))))) + +@s] + + +****Change:(orig (94 97 c)) +@s[ (cond ((null x) nil) + ((null (car x)) nil) + ((null (cadr x)) (list (car x))) + (t (list (list (car x) (cadr x)))))) + +@s| (when (boot-slot-name x) + (if (boot-slot-default-init x) + (list (list (boot-slot-name x) (boot-slot-default-init x))) + (list (boot-slot-name x))))) + +@s] + + +****Change:(orig (248 248 d)) +@s[ ((error "~S is an illegal structure type" type))))) + + + +@s| ((error "~S is an illegal structure type" type))))) + + +@s] + + +****Change:(orig (252 265 d)) +@s[ +(defun make-copier (name copier type named) + (declare (ignore named)) + (cond ((null type) + +@s, ((error "~S is an illegal structure type." type)))) + + + +@s| +@s] + + +****Change:(orig (267 275 c)) +@s[ (cond ((null type) + ;; If TYPE is NIL, the predicate searches the link + ;; of structure-include, until there is no included structure. + `(defun ,predicate (x) + +@s, (setq n (get n 'structure-include)))))) + +@s| (cond ((null type)) + ; done in define-structure + +@s] + + +****Change:(orig (282 283 c)) +@s[ (> (length x) ,name-offset) + (eq (elt x ,name-offset) ',name)))) + +@s| (> (the fixnum (length x)) ,name-offset) + (eq (aref (the (vector t) x) ,name-offset) ',name)))) + +@s] + + +****Change:(orig (294 294 a)) +@s[ ((= i 0) (and (consp y) (eq (car y) ',name))) + +@s| ((= i 0) (and (consp y) (eq (car y) ',name))) + (declare (fixnum i)) + +@s] + + +****Change:(orig (300 301 c)) +@s[;;; and returns a list of the form: +;;; (slot-name default-init slot-type read-only offset) + +@s|;;; and returns a slot. + +@s] + + +****Change:(orig (325 325 c)) +@s[ (list slot-name default-init slot-type read-only offset))) + +@s| (make-slot-boot :name slot-name + :default-init default-init + :type slot-type + :read-only read-only + :offset offset))) + +@s] + + +****Change:(orig (335 335 c)) +@s[ (let ((sds (member (caar olds) news :key #'car))) + +@s| (let* ((old (car olds)) + (sds (member (boot-slot-name old) news :key #'slot-name)) + (new (car sds))) + +@s] + + +****Change:(orig (337 348 c)) +@s[ (when (and (null (cadddr (car sds))) + (cadddr (car olds))) + ;; If read-only is true in the old + ;; and false in the new, signal an error. + +@s, (car (cddddr (car olds)))) + +@s| (when (and (null (boot-slot-read-only new)) + (boot-slot-read-only old)) + ;; If read-only is true in the old + ;; and false in the new, signal an error. + (error "~S is an illegal include slot-description." + new)) + ;; If + (setf (boot-slot-type new) + (best-array-element-type (boot-slot-type new))) + (when (not (equal (normalize-type (or (boot-slot-type new) t)) + (normalize-type (or (boot-slot-type old) t)))) + (error "Type mismmatch for included slot ~a" new)) + (cons (make-slot :name (boot-slot-name new) + :default-init (boot-slot-default-init new) + :type (boot-slot-type new) + :read-only (boot-slot-read-only new) + :offset (boot-slot-offset old)) + +@s] + + +****Change:(orig (353 353 a)) +@s[ (overwrite-slot-descriptions news (cdr olds)))))))) + + +@s| (overwrite-slot-descriptions news (cdr olds)))))))) + +(defvar *all-t-s-type* (make-array 50 :element-type 'unsigned-char :static t)) + +@s] + + +****Change:(orig (355 355 c)) +@s[;;; The DEFSTRUCT macro. + +@s|(defun make-t-type (n include slot-descriptions &aux i) + (let ((res (make-array n :element-type 'unsigned-char :static t))) + (when include + (let ((tem (get include 's-data))raw) + (or tem (error "Included structure undefined ~a" include)) + (setq raw (boot-s-data-raw tem)) + (dotimes (i (min n (length raw))) + (setf (aref res i) (aref raw i))))) + (dolist (v slot-descriptions) + (setq i (boot-slot-offset v)) + (let ((type (boot-slot-type v))) + (cond ((<= (the fixnum (alignment type)) #. (alignment t)) + (setf (aref res i) (aet-type type)))))) + (cond ((< n (length *all-t-s-type*)) + (dotimes (i n) + (cond ((not (eql (the fixnum (aref res i)) 0)) + (return-from make-t-type res)))) + *all-t-s-type*) + (t res)))) + +@s] + + +****Change:(orig (356 356 a)) +@s[ + +@s| +(defvar *standard-slot-positions* + (let ((ar (make-array 50 :element-type 'unsigned-short + :static t))) + (dotimes (i 50) + (declare (fixnum i)) + (setf (aref ar i)(* #. (size-of t) i))) + ar)) + +(eval-when (compile ) +(proclaim '(function round-up (fixnum fixnum ) fixnum)) +) + +(defun round-up (a b) + (declare (fixnum a b)) + (setq a (ceiling a b)) + (the fixnum (* a b))) + + +(defun get-slot-pos (leng include slot-descriptions &aux type small-types + has-holes) + (declare (special *standard-slot-positions*)) include + (dolist (v slot-descriptions) + (when (boot-slot-name v) + (setf type (best-array-element-type (boot-slot-type v)) + (boot-slot-type v) type) + (let ((val (boot-slot-default-init v))) + (unless (typep val type) + (if (and (symbolp val) + (constantp val)) + (setf val (symbol-value val))) + (and (constantp val) + (setf (boot-slot-default-init v) (coerce val type))))) + (cond ((memq type '(signed-char unsigned-char + short unsigned-short + long-float + bit)) + (setq small-types t))))) + (cond ((and (null small-types) + (< leng (length *standard-slot-positions*)) + (list *standard-slot-positions* (* leng #. (size-of t)) nil))) + (t (let ((ar (make-array leng :element-type 'unsigned-short + :static t)) + (pos 0)(i 0)(align 0)type (next-pos 0)) + (declare (fixnum pos i align next-pos)) + ;; A default array. + + (dolist (v slot-descriptions) + (setq type (boot-slot-type v)) + (setq align (alignment type)) + (unless (<= align #. (alignment t)) + (setq type t) + (setf (boot-slot-type v) t) + (setq align #. (alignment t)) + (setf (boot-slot-type-changed v) t)) + (setq next-pos (round-up pos align)) + (or (eql pos next-pos) (setq has-holes t)) + (setq pos next-pos) + (setf (aref ar i) pos) + (incf pos (size-of type)) + (incf i)) + (list ar (round-up pos (size-of t)) has-holes) + )))) + + +(defun define-structure (name conc-name type named slot-descriptions copier + static include print-function constructors + offset predicate &optional documentation no-funs + &aux leng) + (and (consp type) (eq (car type) 'vector)(setq type 'vector)) + (setq leng (length slot-descriptions)) + (setq slot-descriptions + (mapcar #'(lambda (info) + (make-slot-boot :name (first info) + :default-init (second info) + :type (third info) + :read-only (fourth info) + :offset (fifth info) + :accessor-name (sixth info) + :type-changed (seventh info))) + slot-descriptions)) + (dolist (x slot-descriptions) + (when (boot-slot-name x) + (make-access-function name conc-name type named include no-funs x))) + (when (and copier (not no-funs)) + (setf (symbol-function copier) + (ecase type + ((nil) #'si::copy-structure) + (list #'copy-list) + (vector #'copy-seq)))) + (let ((include-str (and include (get include 's-data)))) + (when (and (eq include 's-data-internal) + (not (eq name 'basic-wrapper))) + (error "only ~s can include ~s" 'basic-wrapper 's-data-internal)) + (when include-str + (cond ((and (not (consp include-str)) + (s-data-frozen include-str) + (or (not (s-data-included include-str)) + (not (let ((te (get name 's-data))) + (and te + (eq (s-data-includes te) + include-str)))))) + (warn " ~a was frozen but now included" + include))) + (let ((old-included (boot-slot-value include-str 'included))) + (unless (member name old-included) + (boot-set-slot-value include-str 'included (cons name old-included))))) + (let* ((tem (get name 's-data)) + (g-s-p (and (null type) + (get-slot-pos leng include slot-descriptions))) + (slot-position (car g-s-p)) + (size (if g-s-p (cadr g-s-p) 0)) + (has-holes (caddr g-s-p)) + (def (make-s-data-boot :name name + :length leng + :raw + (and (null type) + (make-t-type leng include + slot-descriptions)) + :slot-position slot-position + :size size + :has-holes has-holes + :staticp static + :includes include-str + :print-function print-function + :slot-descriptions slot-descriptions + :constructors constructors + :offset offset + :type type + :named named + :documentation documentation + :conc-name conc-name))) + (check-s-data tem def name) + (when (and (consp def) (eq name 's-data)) + (make-structures def)))) + (when documentation + (setf (get name 'structure-documentation) + documentation)) + (when (and (null type) predicate) + (record-fn predicate 'defun '(t) t) + (or no-funs + (setf (symbol-function predicate) + #'(lambda (x) + (si::structure-subtype-p x name)))) + (setf (get predicate 'compiler::co1) + 'compiler::co1structure-predicate) + (setf (get predicate 'struct-predicate) name)) + nil) + +(defun check-s-data (old new name) + (unless (and old (member name '(slot s-data-internal basic-wrapper s-data))) + (when (and old (eq (structure-def old) (get 's-data 's-data))) + (boot-set-slot-value new 'included (boot-slot-value old 'included)) + (boot-set-slot-value new 'frozen (boot-slot-value old 'frozen))) + (unless (and old + (eq (structure-def old) (get 's-data 's-data)) + (let ((new-cnv (boot-slot-value new 'cache-number-vector)) + (old-cnv (boot-slot-value old 'cache-number-vector))) + (boot-set-slot-value new 'cache-number-vector old-cnv) + (prog1 (equalp new old) + (boot-set-slot-value new 'cache-number-vector new-cnv)))) + (when old + (warn "structure ~a is changing" name) + (when (eq (structure-def old) (get 's-data 's-data)) + (boot-set-slot-value old 'state (list ':obsolete new)))) + (setf (get name 's-data) new)))) + + +@s] + + +****Change:(orig (364 364 c)) +@s[ predicate predicate-specified + include + +@s| predicate predicate-specified + include include-s-data + +@s] + + +****Change:(orig (367 367 c)) +@s[ offset name-offset + documentation) + +@s| offset name-offset + documentation + static) + +@s] + + +****Change:(orig (370 370 c)) +@s[ ;; The defstruct options are supplied. + +@s| ;; The defstruct options are supplied. + +@s] + + +****Change:(orig (390 425 c)) +@s[ (cond ((and (consp (car os)) (not (endp (cdar os)))) + (setq o (caar os) v (cadar os)) + (case o + (:conc-name + +@s, (t (error "~S is an illegal defstruct option." o)))))) + +@s| (cond ((and (consp (car os)) (not (endp (cdar os)))) + (setq o (caar os) v (cadar os)) + (case o + (:conc-name + (if (null v) + (setq conc-name "") + (setq conc-name v))) + (:constructor + (if (null v) + (setq no-constructor t) + (if (endp (cddar os)) + (setq constructors (cons v constructors)) + (setq constructors (cons (cdar os) constructors))))) + (:copier (setq copier v)) + (:static (setq static v)) + (:predicate + (setq predicate v) + (setq predicate-specified t)) + (:include + (setq include (cdar os)) + (unless (setq include-s-data (get v 's-data)) + (error "~S is an illegal included structure." v))) + (:print-function + (and (consp v) (eq (car v) 'function) + (setq v (second v))) + (setq print-function v)) + (:type (setq type v)) + (:initial-offset (setq initial-offset v)) + (t (error "~S is an illegal defstruct option." o)))) + (t + (if (consp (car os)) + (setq o (caar os)) + (setq o (car os))) + (case o + (:constructor + (setq constructors + (cons default-constructor constructors))) + ((:conc-name :copier :predicate :print-function)) + (:named (setq named t)) + (t (error "~S is an illegal defstruct option." o)))))) + +@s] + + +****Change:(orig (426 426 a)) +@s[ + +@s| + (setq conc-name (intern (string conc-name))) + + (and include-s-data (not print-function) + (setq print-function (boot-s-data-print-function include-s-data))) + + +@s] + + +****Change:(orig (434 435 c)) +@s[ (when include + (unless (equal type (get (car include) 'structure-type)) + +@s| (when include-s-data + (unless (equal type (boot-s-data-type include-s-data)) + +@s] + + +****Change:(orig (442 443 c)) +@s[ (t + (setq offset (get (car include) 'structure-offset)))) + +@s| (t + (setq offset (boot-s-data-offset include-s-data)))) + +@s] + + +****Change:(orig (457 458 c)) +@s[ (setq sds (cons (parse-slot-description (car ds) offset) sds)) + (setq offset (1+ offset))) + +@s| (setq sds (cons (parse-slot-description (car ds) offset) sds)) + (setq offset (1+ offset))) + +@s] + + +****Change:(orig (464 464 c)) +@s[ (cons (list nil name) slot-descriptions))) + +@s| (cons (make-slot :default-init name) slot-descriptions))) + +@s] + + +****Change:(orig (469 469 c)) +@s[ (append (make-list initial-offset) slot-descriptions))) + +@s| (append (mapcar #'make-named-slot (make-list initial-offset)) + slot-descriptions))) + +@s] + + +****Change:(orig (473 486 c)) +@s[ (cond ((null include)) + ((endp (cdr include)) + (setq slot-descriptions + (append (get (car include) 'structure-slot-descriptions) + +@s, slot-descriptions)))) + +@s| (let ((include-slot-descriptions + (and include + (boot-s-data-slot-descriptions include-s-data)))) + (cond ((null include)) + ((endp (cdr include)) + (setq slot-descriptions + (append include-slot-descriptions + slot-descriptions))) + (t + (setq slot-descriptions + (append (overwrite-slot-descriptions + (mapcar #'(lambda (sd) + (parse-slot-description sd 0)) + (cdr include)) + include-slot-descriptions) + slot-descriptions))))) + +@s] + + +****Change:(orig (489 492 c)) +@s[ ;; If a constructor option is NIL, + ;; no constructor should have been specified. + (when constructors + (error "Contradictory constructor options."))) + +@s| ;; If a constructor option is NIL, + ;; no constructor should have been specified. + (when constructors + (error "Contradictory constructor options."))) + +@s] + + +****Change:(orig (494 495 c)) +@s[ ;; If no constructor is specified, + ;; the default-constructor is made. + +@s| ;; If no constructor is specified, + ;; the default-constructor is made. + +@s] + + +****Change:(orig (497 497 a)) +@s[ (setq constructors (list default-constructor)))) + + +@s| (setq constructors (list default-constructor)))) + + ;; We need a default constructor for the sharp-s-reader + (or (member t (mapcar 'symbolp constructors)) + (push (intern (string-concatenate "__si::" default-constructor)) + constructors)) + + +@s] + + +****Change:(orig (509 509 c)) +@s[ (error "An print function is supplied to a typed structure.")) + +@s| (error "A print function is supplied to a typed structure.")) + + `(progn + (define-structure ',name ',conc-name ',type ',named + ',(mapcar #'(lambda (slotd) + (list (boot-slot-name slotd) + (boot-slot-default-init slotd) + (boot-slot-type slotd) + (boot-slot-read-only slotd) + (boot-slot-offset slotd) + (boot-slot-accessor-name slotd) + (boot-slot-type-changed slotd))) + slot-descriptions) + ',copier ',static ',include ',print-function ',constructors + ',offset ',predicate ',documentation) + +@s] + + +****Change:(orig (511 542 c)) +@s[ `(progn (si:putprop ',name + '(defstruct ,name ,@slots) + 'defstruct-form) + (si:putprop ',name t 'is-a-structure) + +@s, (si:putprop ',name ,documentation 'structure-documentation) + ',name))) + +@s| ,@(mapcar #'(lambda (constructor) + (make-constructor name constructor type named + slot-descriptions)) + constructors) + ,@(if (and type predicate) + (list (make-predicate name predicate type named + name-offset))) + ',name + ))) + +@s] + + +****Change:(orig (544 544 a)) +@s[ + + +@s| + +(eval-when (compile load eval) + +(defconstant wrapper-cache-number-adds-ok 4) + +(defconstant wrapper-cache-number-length + (- (integer-length most-positive-fixnum) + wrapper-cache-number-adds-ok)) + +(defconstant wrapper-cache-number-mask + (1- (expt 2 wrapper-cache-number-length))) + + +(defvar *get-wrapper-cache-number* (make-random-state)) + +(defun get-wrapper-cache-number () + (let ((n 0)) + (declare (fixnum n)) + (loop + (setq n + (logand wrapper-cache-number-mask + (random most-positive-fixnum *get-wrapper-cache-number*))) + (unless (zerop n) (return n))))) + +) + +(eval-when (compile load eval) + +(defconstant wrapper-cache-number-vector-length 8) + +(deftype cache-number-vector () + `(simple-array fixnum (8))) + +(defconstant wrapper-layout (make-list wrapper-cache-number-vector-length + :initial-element 'number)) + +) + +(defun make-wrapper-cache-number-vector () + (let ((cnv (make-array #.wrapper-cache-number-vector-length + :element-type 'fixnum))) + (dotimes (i #.wrapper-cache-number-vector-length) + (setf (aref cnv i) (get-wrapper-cache-number))) + cnv)) + +(defstruct (slot + (:static t) + (:constructor make-slot) + (:constructor make-named-slot (name))) + name + default-init + (type t) + read-only + offset + accessor-name + type-changed) + +;; All of the fields of s-data-internal must coincide with +;; the C structure s_data (see object.h). +(defstruct (s-data-internal + (:conc-name s-data-) + (:constructor nil) + (:static t)) + ;; all of these slots are used by c code + name ; a symbol + (length 0 :type fixnum) ; length of slot-descriptions + raw ; a static array of unsigned-short (enum aelttype) + included ; a list of the names of structures including this one + includes ; nil or a s-data structure + staticp ; t or nil + print-function ; nil, a symbol, or a lambda expression + slot-descriptions ; a list of slots + slot-position ; a static array of unsigned-short + (size 0 :type fixnum) ; total size to allocate + has-holes) ; t or nil + +(defstruct (basic-wrapper (:include s-data-internal) + (:conc-name wrapper-) + (:constructor nil) + (:static t)) + (cache-number-vector (make-wrapper-cache-number-vector)) + (state t) ; either t or a list (state-sym new-wrapper) + ;; where state-sym is either :flush or :obsolete + (class nil)) + +;(get name 'si::s-data) ;returns one of these: +(defstruct (s-data (:include basic-wrapper) + (:static t)) + ;; these slots are used only from lisp + frozen ; t or nil ; t means won't include this + documentation + constructors ; a list of either a symbol or a list symbol, arglist + offset ; the total number of slots and placeholders + named ; t or nil + type ; one of: nil, list, or vector + conc-name) ; an interned symbol + +#|| +(import '(si::wrapper-state si::wrapper-class si::basic-wrapper)) + +(defstruct (wrapper (:include basic-wrapper) + (:print-function print-wrapper) + (:constructor make-wrapper-internal) + (:predicate wrapper-p) + (:conc-name wrapper-)) + (class-slots nil :type list)) + +(defun print-wrapper (instance stream depth) + (printing-random-thing (wrapper stream) + (format stream "Wrapper ~S" (wrapper-class wrapper)))) +||# + +(defun update-wrapper-state (old new same-p) + (unless (consp old) + (setf (wrapper-state old) + (list (if same-p ':flush ':obsolete) new)))) + +(defun freeze-defstruct (name) + (let ((tem (and (symbolp name) (get name 's-data)))) + (if tem (setf (s-data-frozen tem) t)))) + + + +@s] + + +****Change:(orig (551 553 c)) +@s[ (let ((l (read stream))) + (unless (get (car l) 'is-a-structure) + (error "~S is not a structure." (car l))) + +@s| (let* ((l (prog1 (read stream t nil t) + (if *read-suppress* + (return-from sharp-s-reader nil)))) + (sd + (or (get (car l) 's-data) + + (error "~S is not a structure." (car l))))) + + +@s] + + +****Change:(orig (558 558 c)) +@s[ (do ((cs (get (car l) 'structure-constructors) (cdr cs))) + +@s| (do ((cs (s-data-constructors sd) (cdr cs))) + +@s] + + +****Change:(orig (571 571 d)) +@s[(set-dispatch-macro-character #\# #\S 'sharp-s-reader) + + + +@s|(set-dispatch-macro-character #\# #\S 'sharp-s-reader) + + +@s] + + +****Change:(orig (582 582 c)) +@s[(defstruct person name age sex) + +@s|(defstruct person name (age 20 :type signed-char) (eyes 2 :type signed-char) + sex) +(defstruct person name (age 20 :type signed-char) (eyes 2 :type signed-char) + sex) +(defstruct person1 name (age 20 :type fixnum) + sex) + +@s] + + +****Change:(orig (584 584 c)) +@s[(defstruct (astronaut (:include person (age 45)) + +@s|(defstruct joe a (a1 0 :type (mod 30)) (a2 0 :type (mod 30)) + (a3 0 :type (mod 30)) (a4 0 :type (mod 30)) ) + +;(defstruct person name age sex) + +(defstruct (astronaut (:include person (age 45 :type fixnum)) + +@s] + + +****Change:(orig (605 605 a)) +@s[ associative + identity) + +@s| associative + identity) + + +@s] + +============================================================================== diff --git a/pcl/impl/kcl/sys-package.lisp b/pcl/impl/kcl/sys-package.lisp new file mode 100644 index 0000000..427813b --- /dev/null +++ b/pcl/impl/kcl/sys-package.lisp @@ -0,0 +1,149 @@ + + +;;; Definitions for package SLOT-ACCESSOR-NAME of type ESTABLISH +(LISP::IN-PACKAGE "SLOT-ACCESSOR-NAME" :USE LISP::NIL :NICKNAMES + '("S-A-N")) + +;;; Definitions for package PCL of type ESTABLISH +(LISP::IN-PACKAGE "PCL" :USE LISP::NIL) + +;;; Definitions for package ITERATE of type ESTABLISH +(LISP::IN-PACKAGE "ITERATE" :USE LISP::NIL) + +;;; Definitions for package WALKER of type ESTABLISH +(LISP::IN-PACKAGE "WALKER" :USE LISP::NIL) + +;;; Definitions for package SLOT-ACCESSOR-NAME of type EXPORT +(LISP::IN-PACKAGE "SLOT-ACCESSOR-NAME" :USE 'LISP::NIL :NICKNAMES + '("S-A-N")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT 'LISP::NIL) + +;;; Definitions for package PCL of type EXPORT +(LISP::IN-PACKAGE "PCL" :USE '("LISP" "ITERATE" "WALKER")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT + '(PCL::CLASS-PRECEDENCE-LIST PCL::SLOT-DEFINITION + PCL::COMPUTE-APPLICABLE-METHODS-USING-CLASSES + PCL::SLOT-DEFINITION-WRITERS PCL::CLASS-OF + PCL::NO-APPLICABLE-METHOD PCL::STANDARD-WRITER-METHOD + PCL::ENSURE-CLASS-USING-CLASS PCL::ENSURE-GENERIC-FUNCTION + PCL::FIND-METHOD-COMBINATION PCL::UPDATE-DEPENDENT + PCL::MAP-DEPENDENTS PCL::SLOT-MISSING PCL::SPECIALIZER + PCL::CALL-NEXT-METHOD PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS + PCL::SLOT-MAKUNBOUND-USING-CLASS PCL::MAKE-INSTANCES-OBSOLETE + PCL::INTERN-EQL-SPECIALIZER PCL::REMOVE-DIRECT-SUBCLASS + PCL::METHOD-GENERIC-FUNCTION PCL::METHOD-QUALIFIERS + PCL::FUNCALLABLE-STANDARD-CLASS PCL::EXTRACT-LAMBDA-LIST + PCL::STANDARD-CLASS PCL::PRINT-OBJECT PCL::STRUCTURE-CLASS + PCL::COMPUTE-EFFECTIVE-SLOT-DEFINITION + PCL::GENERIC-FUNCTION-DECLARATIONS PCL::MAKE-INSTANCE + PCL::METHOD-LAMBDA-LIST PCL::DEFGENERIC + PCL::REMOVE-DIRECT-METHOD PCL::STANDARD-DIRECT-SLOT-DEFINITION + PCL::GENERIC-FUNCTION-METHODS PCL::VALIDATE-SUPERCLASS + PCL::REINITIALIZE-INSTANCE PCL::STANDARD-METHOD + PCL::STANDARD-ACCESSOR-METHOD + PCL::FUNCALLABLE-STANDARD-INSTANCE PCL::FUNCTION-KEYWORDS + PCL::STANDARD PCL::FIND-METHOD PCL::EXTRACT-SPECIALIZER-NAMES + PCL::INITIALIZE-INSTANCE PCL::GENERIC-FLET PCL::SLOT-UNBOUND + PCL::STANDARD-INSTANCE PCL::SLOT-DEFINITION-TYPE + PCL::COMPUTE-EFFECTIVE-METHOD PCL::ALLOCATE-INSTANCE + PCL::SYMBOL-MACROLET PCL::GENERIC-FUNCTION + PCL::GENERIC-FUNCTION-METHOD-COMBINATION + PCL::SPECIALIZER-DIRECT-METHODS PCL::ADD-DIRECT-SUBCLASS + PCL::WRITER-METHOD-CLASS PCL::SLOT-DEFINITION-INITARGS + PCL::METHOD-SPECIALIZERS PCL::GENERIC-FUNCTION-METHOD-CLASS + PCL::ADD-METHOD PCL::WITH-ACCESSORS + PCL::SLOT-DEFINITION-ALLOCATION + PCL::SLOT-DEFINITION-INITFUNCTION + PCL::SLOT-DEFINITION-LOCATION PCL::ADD-DIRECT-METHOD + PCL::SLOT-BOUNDP PCL::EQL-SPECIALIZER PCL::SHARED-INITIALIZE + PCL::STANDARD-GENERIC-FUNCTION + PCL::ACCESSOR-METHOD-SLOT-DEFINITION + PCL::SLOT-BOUNDP-USING-CLASS PCL::ADD-DEPENDENT + PCL::SPECIALIZER-DIRECT-GENERIC-FUNCTION + PCL::WITH-ADDED-METHODS PCL::COMPUTE-CLASS-PRECEDENCE-LIST + PCL::REMOVE-DEPENDENT PCL::NEXT-METHOD-P + PCL::GENERIC-FUNCTION-NAME PCL::SLOT-VALUE + PCL::EFFECTIVE-SLOT-DEFINITION PCL::CLASS-FINALIZED-P + PCL::COMPUTE-DISCRIMINATING-FUNCTION PCL::STANDARD-OBJECT + PCL::CLASS-DEFAULT-INITARGS PCL::CLASS-DIRECT-SLOTS + PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS PCL::BUILT-IN-CLASS + PCL::NO-NEXT-METHOD PCL::SLOT-MAKUNBOUND + PCL::STANDARD-READER-METHOD PCL::GENERIC-FUNCTION-LAMBDA-LIST + PCL::GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER + PCL::INVALID-METHOD-ERROR PCL::METHOD-COMBINATION-ERROR + PCL::SLOT-EXISTS-P PCL::FINALIZE-INHERITANCE + PCL::SLOT-DEFINITION-NAME + PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION PCL::COMPUTE-SLOTS + PCL::CLASS-SLOTS PCL::EFFECTIVE-SLOT-DEFINITION-CLASS + PCL::STANDARD-INSTANCE-ACCESS PCL::WITH-SLOTS + PCL::DIRECT-SLOT-DEFINITION PCL::DEFINE-METHOD-COMBINATION + PCL::MAKE-METHOD-LAMBDA PCL::ENSURE-CLASS + PCL::DIRECT-SLOT-DEFINITION-CLASS PCL::METHOD-FUNCTION + PCL::STANDARD-SLOT-DEFINITION PCL::CHANGE-CLASS PCL::DEFMETHOD + PCL::UPDATE-INSTANCE-FOR-DIFFERENT-CLASS + PCL::UPDATE-INSTANCE-FOR-REDEFINED-CLASS + PCL::FORWARD-REFERENCED-CLASS PCL::SLOT-DEFINITION-INITFORM + PCL::REMOVE-METHOD PCL::READER-METHOD-CLASS PCL::CALL-METHOD + PCL::CLASS-PROTOTYPE PCL::CLASS-NAME PCL::FIND-CLASS + PCL::DEFCLASS PCL::COMPUTE-APPLICABLE-METHODS + PCL::SLOT-VALUE-USING-CLASS PCL::METHOD-COMBINATION + PCL::EQL-SPECIALIZER-INSTANCE PCL::GENERIC-LABELS PCL::METHOD + PCL::SLOT-DEFINITION-READERS + PCL::CLASS-DIRECT-DEFAULT-INITARGS + PCL::CLASS-DIRECT-SUBCLASSES PCL::CLASS-DIRECT-SUPERCLASSES + PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION)) + +;;; Definitions for package ITERATE of type EXPORT +(LISP::IN-PACKAGE "ITERATE" :USE '("WALKER" "LISP")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT + '(ITERATE::SUMMING ITERATE::MINIMIZING ITERATE::PLIST-ELEMENTS + ITERATE::ITERATE* ITERATE::MAXIMIZING ITERATE::LIST-TAILS + ITERATE::*ITERATE-WARNINGS* ITERATE::GATHERING + ITERATE::EACHTIME ITERATE::ELEMENTS ITERATE::GATHER + ITERATE::LIST-ELEMENTS ITERATE::WHILE ITERATE::ITERATE + ITERATE::UNTIL ITERATE::JOINING ITERATE::COLLECTING + ITERATE::WITH-GATHERING ITERATE::INTERVAL)) + +;;; Definitions for package WALKER of type EXPORT +(LISP::IN-PACKAGE "WALKER" :USE '("LISP")) +(LISP::IMPORT 'LISP::NIL) +(LISP::EXPORT + '(WALKER::DEFINE-WALKER-TEMPLATE WALKER::*VARIABLE-DECLARATIONS* + WALKER::NESTED-WALK-FORM WALKER::VARIABLE-DECLARATION + WALKER::WALK-FORM-EXPAND-MACROS-P WALKER::VARIABLE-LEXICAL-P + WALKER::VARIABLE-SPECIAL-P WALKER::WALK-FORM + WALKER::MACROEXPAND-ALL WALKER::VARIABLE-GLOBALLY-SPECIAL-P)) + +;;; Definitions for package SLOT-ACCESSOR-NAME of type SHADOW +(LISP::IN-PACKAGE "SLOT-ACCESSOR-NAME") +(LISP::SHADOW 'LISP::NIL) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT 'LISP::NIL) + +;;; Definitions for package PCL of type SHADOW +(LISP::IN-PACKAGE "PCL") +(LISP::SHADOW '(PCL::DOTIMES PCL::DOCUMENTATION)) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT + '(SYSTEM::STRUCTURE-REF SYSTEM::STRUCTURE-DEF SYSTEM::STRUCTUREP)) + +;;; Definitions for package ITERATE of type SHADOW +(LISP::IN-PACKAGE "ITERATE") +(LISP::SHADOW 'LISP::NIL) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT 'LISP::NIL) + +;;; Definitions for package WALKER of type SHADOW +(LISP::IN-PACKAGE "WALKER") +(LISP::SHADOW 'LISP::NIL) +(LISP::SHADOWING-IMPORT 'LISP::NIL) +(LISP::IMPORT 'LISP::NIL) + +(lisp::in-package 'SI) +(export '(%structure-name + %compiled-function-name + %set-compiled-function-name)) +(in-package 'pcl) diff --git a/pcl/impl/kcl/sys-proclaim.lisp b/pcl/impl/kcl/sys-proclaim.lisp new file mode 100644 index 0000000..c1d1f92 --- /dev/null +++ b/pcl/impl/kcl/sys-proclaim.lisp @@ -0,0 +1,818 @@ + +(IN-PACKAGE "USER") +(PROCLAIM '(FTYPE (FUNCTION (*) FIXNUM) PCL::ZERO)) +(PROCLAIM + '(FTYPE (FUNCTION (T FIXNUM *) FIXNUM) + PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) +(PROCLAIM + '(FTYPE (FUNCTION (T) FIXNUM) PCL::FAST-INSTANCE-BOUNDP-INDEX + PCL::ONE-INDEX-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN + PCL::CHECKING-LIMIT-FN PCL::PV-CACHE-LIMIT-FN + PCL::CACHE-NLINES PCL::CACHE-MAX-LOCATION PCL::CACHE-SIZE + PCL::CACHE-MASK PCL::ARG-INFO-NUMBER-REQUIRED + PCL::DEFAULT-LIMIT-FN PCL::CACHE-COUNT + PCL::CACHING-LIMIT-FN PCL::PV-TABLE-PV-SIZE + PCL::EARLY-CLASS-SIZE)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) PCL::POWER-OF-TWO-CEILING)) +(PROCLAIM + '(FTYPE (FUNCTION (T) FUNCTION) PCL::CACHE-LIMIT-FN + PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION)) +(PROCLAIM '(FTYPE (FUNCTION (T) PCL::FIELD-TYPE) PCL::CACHE-FIELD)) +(PROCLAIM + '(FTYPE (FUNCTION (T) LIST) PCL::CACHE-OVERFLOW + PCL::PV-TABLE-SLOT-NAME-LISTS PCL::PV-TABLE-CALL-LIST)) +(PROCLAIM '(FTYPE (FUNCTION (T) (MEMBER NIL T)) PCL::CACHE-VALUEP)) +(PROCLAIM '(FTYPE (FUNCTION (T) SIMPLE-VECTOR) PCL::CACHE-VECTOR)) +(PROCLAIM + '(FTYPE (FUNCTION (T) (VALUES T T)) PCL::MAKE-CLASS-PREDICATE-NAME + PCL::MAKE-KEYWORD)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) PCL::%CCLOSURE-ENV-NTHCDR)) +(PROCLAIM + '(FTYPE (FUNCTION (FIXNUM FIXNUM T) FIXNUM) + PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) +(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 512)) PCL::CACHE-LINE-SIZE)) +(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 256)) PCL::CACHE-NKEYS)) +(PROCLAIM + '(FTYPE (FUNCTION (T) (OR PCL::CACHE NULL)) PCL::PV-TABLE-CACHE)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T) *) PCL::MEMF-CODE-CONVERTER + PCL::REAL-LOAD-DEFCLASS PCL::CACHE-MISS-VALUES-INTERNAL + PCL::GENERATE-DISCRIMINATION-NET-INTERNAL + PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION + PCL::DO-SHORT-METHOD-COMBINATION + WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T) *) + PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + ITERATE::WALK-GATHERING-BODY + PCL::CACHE-MISS-VALUES + PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION + PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::ACCESSOR-VALUES1 + PCL::EMIT-READER/WRITER + PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER + WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::GENERATING-LISP + PCL::EMIT-READER/WRITER-FUNCTION + PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION + WALKER::WALK-LET-IF PCL::SET-SLOT-VALUE + PCL::CONVERT-METHODS PCL::SLOT-VALUE-USING-CLASS-DFUN + PCL::SLOT-BOUNDP-USING-CLASS-DFUN + PCL::CHECK-METHOD-ARG-INFO PCL::LOAD-LONG-DEFCOMBIN + PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN + PCL::MAKE-FINAL-CACHING-DFUN + PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN + PCL::GET-CLASS-SLOT-VALUE-1 PCL::ACCESSOR-VALUES-INTERNAL + PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION + PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION + ITERATE::EXPAND-INTO-LET WALKER::WALK-FORM-INTERNAL + ITERATE::RENAME-VARIABLES + PCL::CONSTANT-VALUE-MISS PCL::CACHING-MISS + PCL::CHECKING-MISS + PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T) *) + PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL + PCL::ADD-METHOD-DECLARATIONS PCL::WALK-METHOD-LAMBDA + PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN + WALKER::WALK-TEMPLATE-HANDLE-REPEAT)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T) *) + PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION + PCL::BOOTSTRAP-ACCESSOR-DEFINITION + PCL::GET-ACCESSOR-METHOD-FUNCTION + PCL::EMIT-CHECKING-OR-CACHING + PCL::EMIT-CHECKING-OR-CACHING-FUNCTION + PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN + PCL::LOAD-SHORT-DEFCOMBIN + PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION + PCL::MAKE-SHARED-INITIALIZE-FORM-LIST + PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN + PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN + PCL::MAKE-FINAL-CHECKING-DFUN PCL::ACCESSOR-VALUES + PCL::SET-CLASS-SLOT-VALUE-1 + PCL::GENERATE-DISCRIMINATION-NET + PCL::REAL-MAKE-METHOD-LAMBDA + PCL::ORDER-SPECIALIZERS WALKER::WALK-TEMPLATE + PCL::ACCESSOR-MISS)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T) *) + ITERATE::ITERATE-TRANSFORM-BODY)) +(PROCLAIM + '(FTYPE (FUNCTION (T T *) *) PCL::SLOT-VALUE-OR-DEFAULT + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION + PCL::GET-EFFECTIVE-METHOD-FUNCTION + PCL::MAKE-N-N-ACCESSOR-DFUN WALKER:NESTED-WALK-FORM + PCL::MAKE-CHECKING-DFUN PCL::LOAD-DEFGENERIC + PCL::TYPES-FROM-ARGUMENTS + PCL::MAKE-DEFAULT-INITARGS-FORM-LIST + PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-ACCESSOR-TABLE + PCL::GET-SIMPLE-INITIALIZATION-FUNCTION + PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS + PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T *) *) + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 + ITERATE::RENAME-LET-BINDINGS)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T *) *) PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN + WALKER::WALK-DECLARATIONS + PCL::GET-SECONDARY-DISPATCH-FUNCTION)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T *) *) PCL::REAL-MAKE-A-METHOD)) +(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PCL::PRINT-DFUN-INFO)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T) T) ITERATE::SIMPLE-EXPAND-GATHERING-FORM + ITERATE::RENAME-AND-CAPTURE-VARIABLES + ITERATE::VARIABLE-SAME-P + PCL::GET-FUNCTION-GENERATOR + WALKER:VARIABLE-DECLARATION PCL::GET-NEW-FUNCTION-GENERATOR + PCL::TRACE-METHOD-INTERNAL PCL::ONE-INDEX-DFUN-INFO + PCL::ONE-CLASS-DFUN-INFO + PCL::MAP-ALL-ORDERS SYSTEM::APPLY-DISPLAY-FUN + PCL::NOTE-PV-TABLE-REFERENCE + WALKER::RELIST-INTERNAL + PCL::MAKE-DFUN-CALL + WALKER::WALK-TAGBODY-1 WALKER::WALK-LAMBDA + PCL::OPTIMIZE-GF-CALL-INTERNAL + PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P + WALKER::WALK-COMPILER-LET PCL::SKIP-FAST-SLOT-ACCESS-P + WALKER::WALK-UNEXPECTED-DECLARE WALKER::WALK-FLET + WALKER::WALK-IF + WALKER::WALK-LABELS WALKER::WALK-LET WALKER::WALK-LET* + WALKER::WALK-LOCALLY + WALKER::WALK-MACROLET + PCL::FIX-SLOT-ACCESSORS WALKER::WALK-MULTIPLE-VALUE-BIND + PCL:COMPUTE-EFFECTIVE-METHOD WALKER::WALK-SETQ + WALKER::WALK-SYMBOL-MACROLET PCL::EMIT-SLOT-READ-FORM + WALKER::WALK-TAGBODY PCL::EMIT-BOUNDP-CHECK WALKER::WALK-DO + WALKER::WALK-DO* WALKER::WALK-PROG + WALKER::WALK-NAMED-LAMBDA WALKER::WALK-PROG* + PCL::EXPAND-DEFGENERIC PCL::EMIT-GREATER-THAN-1-DLAP + PCL::EMIT-1-T-DLAP + PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL + PCL::ENTRY-IN-CACHE-P PCL::CONVERT-TABLE + PCL::MAKE-METHOD-SPEC PCL::TRACE-EMF-CALL-INTERNAL + PCL::FLUSH-CACHE-TRAP PCL::SET-FUNCTION-NAME-1 + PCL::OBSOLETE-INSTANCE-TRAP + PCL::COMPUTE-PRECEDENCE PCL::PRINT-STD-INSTANCE + PCL::|SETF PCL METHOD-FUNCTION-GET| + PCL::|SETF PCL PLIST-VALUE| + WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL + PCL::CAN-OPTIMIZE-ACCESS PCL::OPTIMIZE-SLOT-VALUE + PCL::OPTIMIZE-SET-SLOT-VALUE PCL::DECLARE-STRUCTURE + PCL::OPTIMIZE-SLOT-BOUNDP + PCL::PRINT-CACHE PCL::COMPUTE-STD-CPL-PHASE-3 + PCL::FIRST-FORM-TO-LISP + ITERATE::OPTIMIZE-ITERATE-FORM + PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS + PCL::MAKE-TOP-LEVEL-FORM PCL::INVALIDATE-WRAPPER + PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD + PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION + WALKER::RECONS ITERATE::OPTIMIZE-GATHERING-FORM)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T) T) PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE + PCL::MEMF-TEST-CONVERTER + PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR + PCL::TWO-CLASS-DFUN-INFO + WALKER::WALK-LET/LET* WALKER::WALK-PROG/PROG* + WALKER::WALK-DO/DO* + WALKER::WALK-BINDINGS-2 PCL::OPTIMIZE-READER + PCL::OPTIMIZE-WRITER + PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY + PCL::MAYBE-EXPAND-ACCESSOR-FORM + PCL::INITIALIZE-INSTANCE-SIMPLE + PCL::GET-WRAPPERS-FROM-CLASSES + PCL::LOAD-PRECOMPILED-IIS-ENTRY + PCL::FILL-CACHE-P + PCL::ADJUST-CACHE + PCL::EXPAND-CACHE + PCL::EXPAND-SYMBOL-MACROLET-INTERNAL + PCL::BOOTSTRAP-SET-SLOT PCL::EXPAND-DEFCLASS PCL::GET-CACHE + )) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T) T) PCL::LOAD-FUNCTION-GENERATOR + PCL::EXPAND-EMF-CALL-METHOD PCL::MAKE-FGEN + PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS + PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 + PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL PCL::COMPUTE-PV-SLOT + WALKER::WALK-BINDINGS-1 + PCL::OPTIMIZE-INSTANCE-ACCESS + PCL::OPTIMIZE-ACCESSOR-CALL + PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 + PCL::UPDATE-SLOTS-IN-PV + PCL::MAKE-PARAMETER-REFERENCES + PCL::MAKE-EMF-CACHE + PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL + PCL::MAKE-INSTANCE-FUNCTION-COMPLEX + PCL::MAKE-INSTANCE-FUNCTION-SIMPLE + PCL::OPTIMIZE-GENERIC-FUNCTION-CALL + PCL::REAL-MAKE-METHOD-INITARGS-FORM + )) +(PROCLAIM + '(FTYPE (FUNCTION (T T *) T) + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE + PCL::MAKE-EMF-FROM-METHOD + PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION + PCL::NAMED-OBJECT-PRINT-FUNCTION PCL::FIND-CLASS-FROM-CELL + PCL::FIND-CLASS-PREDICATE-FROM-CELL PCL::INITIALIZE-INFO + PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::GET-DECLARATION + PCL::GET-METHOD-FUNCTION-PV-CELL + PCL:ENSURE-GENERIC-FUNCTION-USING-CLASS PCL::EMIT-MISS + PCL::METHOD-FUNCTION-GET PCL::PROBE-CACHE PCL::MAP-CACHE + PCL::GET-CACHE-FROM-CACHE PCL::PRECOMPUTE-EFFECTIVE-METHODS + PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA + PCL::CPL-ERROR PCL::REAL-ADD-METHOD + PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION + PCL::REAL-ENSURE-GF-USING-CLASS--NULL + PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T T) T) + PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T) T) + PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS + PCL::OPTIMIZE-GF-CALL PCL::SET-ARG-INFO1 PCL::LOAD-DEFCLASS + PCL::MAKE-EARLY-CLASS-DEFINITION)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T *) T) PCL::FILL-DFUN-CACHE + PCL::EARLY-ADD-NAMED-METHOD PCL::REAL-ADD-NAMED-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T *) T) PCL::LOAD-DEFMETHOD + PCL::MAKE-DEFMETHOD-FORM PCL::MAKE-DEFMETHOD-FORM-INTERNAL + PCL::EARLY-MAKE-A-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T *) T) PCL::CHECK-INITARGS-2-PLIST + PCL::CHECK-INITARGS-2-LIST WALKER::WALK-ARGLIST + PCL::MAKE-EMF-CALL PCL::CAN-OPTIMIZE-ACCESS1 + PCL::EMIT-FETCH-WRAPPER PCL::FILL-CACHE + PCL::REAL-GET-METHOD PCL::CHECK-INITARGS-1 PCL::GET-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T *) T) PCL::EMIT-DLAP + PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T FIXNUM) T) PCL::FILL-CACHE-FROM-CACHE-P)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T) T) PCL::EXPAND-DEFMETHOD + PCL::LOAD-DEFMETHOD-INTERNAL + )) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T T T *) T) + PCL::BOOTSTRAP-INITIALIZE-CLASS)) +(PROCLAIM + '(FTYPE (FUNCTION NIL *) PCL::COUNT-ALL-DFUNS PCL::RENEW-SYS-FILES + PCL::EMIT-N-N-READERS PCL::EMIT-N-N-WRITERS)) +(PROCLAIM + '(FTYPE (FUNCTION NIL T) PCL::GET-EFFECTIVE-METHOD-GENSYM + PCL::SHOW-EMF-CALL-TRACE PCL::BOOTSTRAP-META-BRAID + PCL::BOOTSTRAP-BUILT-IN-CLASSES PCL::LIST-ALL-DFUNS + PCL::DEFAULT-METHOD-ONLY-DFUN-INFO + PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST + PCL::CACHES-TO-ALLOCATE PCL::UPDATE-DISPATCH-DFUNS + PCL::MAKE-CACHE PCL::RESET-PCL-PACKAGE + PCL::IN-THE-COMPILER-P PCL::STRUCTURE-FUNCTIONS-EXIST-P + PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 + PCL::%%ALLOCATE-INSTANCE--CLASS + PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 + PCL::DISPATCH-DFUN-INFO PCL::INITIAL-DISPATCH-DFUN-INFO + PCL::INITIAL-DFUN-INFO PCL::NO-METHODS-DFUN-INFO + PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-CPD + PCL::MAKE-ARG-INFO PCL::SHOW-DFUN-CONSTRUCTORS)) +(PROCLAIM + '(FTYPE (FUNCTION (*) *) PCL::UNTRACE-METHOD + PCL:INVALID-METHOD-ERROR PCL:METHOD-COMBINATION-ERROR + PCL::LIST-LARGE-CACHES + PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T *) *) PCL::FIND-FREE-CACHE-LINE)) +(PROCLAIM + '(FTYPE (FUNCTION (FIXNUM T T) *) PCL::COMPUTE-CACHE-PARAMETERS)) +(PROCLAIM + '(FTYPE (FUNCTION (*) T) PCL::|__si::MAKE-DFUN-INFO| + PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-INITIAL| + PCL::|__si::MAKE-INITIAL-DISPATCH| + PCL::|__si::MAKE-DISPATCH| + PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| + PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| + PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| + PCL::MAKE-FAST-METHOD-CALL PCL::|__si::MAKE-N-N| + PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::|__si::MAKE-ONE-CLASS| + PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-ONE-INDEX| + PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-ARG-INFO| + PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::STRING-APPEND + PCL::|__si::MAKE-CACHING| PCL::|__si::MAKE-CONSTANT-VALUE| + PCL::FALSE PCL::|STRUCTURE-OBJECT class constructor| + PCL::PV-WRAPPERS-FROM-PV-ARGS PCL::MAKE-PV-TABLE + PCL::|__si::MAKE-PV-TABLE| PCL::INTERN-PV-TABLE + PCL::CALLED-FIN-WITHOUT-FUNCTION + PCL::|__si::MAKE-STD-INSTANCE| PCL::TRUE + PCL::MAKE-INITIALIZE-INFO PCL::|__si::MAKE-CACHE| + PCL::MAKE-PROGN WALKER::UNBOUND-LEXICAL-FUNCTION + PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| + PCL::MAKE-METHOD-CALL)) +(PROCLAIM + '(FTYPE (FUNCTION (T) *) PCL::TYPE-FROM-SPECIALIZER + PCL::*NORMALIZE-TYPE PCL::UNPARSE-TYPE + PCL::DEFAULT-CODE-CONVERTER PCL::CONVERT-TO-SYSTEM-TYPE + PCL::EMIT-CONSTANT-VALUE PCL::SFUN-P PCL::PCL-DESCRIBE + PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION + PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME + PCL::SPECIALIZER-FROM-TYPE PCL::CLASS-EQ-TYPE + COMPILER::CAN-USE-PRINT-CIRCLE-P PCL::STRUCTURE-WRAPPER + PCL::FIND-STRUCTURE-CLASS PCL::MAKE-DISPATCH-DFUN + PCL::FIND-WRAPPER PCL::PARSE-DEFMETHOD + PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA + PCL::FORCE-CACHE-FLUSHES PCL::EMIT-ONE-CLASS-READER + PCL::EMIT-ONE-CLASS-WRITER PCL::EMIT-TWO-CLASS-READER + PCL::EMIT-TWO-CLASS-WRITER PCL::EMIT-ONE-INDEX-READERS + PCL::EMIT-ONE-INDEX-WRITERS PCL::NET-CODE-CONVERTER + PCL::EMIT-IN-CHECKING-CACHE-P PCL::COMPILE-IIS-FUNCTIONS + PCL::ANALYZE-LAMBDA-LIST + PCL::COMPUTE-APPLICABLE-METHODS-EMF + PCL::GET-DISPATCH-FUNCTION PCL::INSURE-CACHING-DFUN + PCL::%FBOUNDP PCL::CCLOSUREP PCL::GENERIC-FUNCTION-NAME-P + PCL::MAKE-FINAL-DISPATCH-DFUN + PCL::STRUCTURE-SLOTD-INIT-FORM + PCL::PARSE-METHOD-GROUP-SPECIFIER + PCL::METHOD-PROTOTYPE-FOR-GF + PCL::EARLY-COLLECT-INHERITANCE)) +(PROCLAIM + '(FTYPE (FUNCTION (T) T) PCL::UNENCAPSULATED-FDEFINITION + PCL::DFUN-INFO-P PCL::NO-METHODS-P + PCL::MAKE-TYPE-PREDICATE + PCL::DEFAULT-TEST-CONVERTER PCL::INITIAL-P + PCL::UNPARSE-TYPE-LIST PCL::MAKE-CALL-METHODS + PCL::DEFAULT-CONSTANT-CONVERTER PCL::INITIAL-DISPATCH-P + PCL::DISPATCH-P PCL::GBOUNDP PCL::GMAKUNBOUND + PCL::DEFAULT-CONSTANTP PCL::DEFAULT-METHOD-ONLY-P + PCL::FGEN-TEST PCL::LOOKUP-FGEN PCL::ACCESSOR-DFUN-INFO-P + PCL::FGEN-GENERATOR PCL::FGEN-SYSTEM + PCL::ONE-INDEX-DFUN-INFO-P PCL::FAST-METHOD-CALL-P + PCL::N-N-P PCL::FAST-INSTANCE-BOUNDP-P + PCL::METHOD-FUNCTION-PV-TABLE PCL::METHOD-FUNCTION-METHOD + PCL::STORE-FGEN PCL::ONE-CLASS-P + PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P + PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::FGEN-GENSYMS + PCL::TWO-CLASS-P PCL::ARG-INFO-LAMBDA-LIST + PCL::ARG-INFO-PRECEDENCE PCL::ARG-INFO-METATYPES + PCL::FGEN-GENERATOR-LAMBDA SYSTEM:%STRUCTURE-NAME + PCL::ARG-INFO-NUMBER-OPTIONAL + SYSTEM:%COMPILED-FUNCTION-NAME PCL::ARG-INFO-KEY/REST-P + PCL::ONE-INDEX-P PCL::ARG-INFO-KEYWORDS + PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE + PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P + PCL::GF-INFO-STATIC-C-A-M-EMF PCL::CHECKING-P + PCL::GF-INFO-C-A-M-EMF-STD-P PCL::GF-INFO-FAST-MF-P + PCL::UNDEFMETHOD-1 PCL::ARG-INFO-P + PCL::FAST-METHOD-CALL-ARG-INFO PCL::ARG-INFO-NKEYS + PCL::GF-DFUN-CACHE PCL:CLASS-OF PCL::GF-DFUN-INFO + PCL::FUNCTION-RETURNING-NIL + PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE PCL::EVAL-FORM + PCL::ONE-INDEX-DFUN-INFO-INDEX + PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::TYPE-CLASS + PCL::ONE-CLASS-WRAPPER0 PCL::EXTRACT-PARAMETERS + PCL::CLASS-PREDICATE PCL::EXTRACT-REQUIRED-PARAMETERS + PCL::MAKE-CLASS-EQ-PREDICATE PCL::TWO-CLASS-WRAPPER1 + PCL::MAKE-EQL-PREDICATE PCL::CHECKING-FUNCTION + PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS + PCL::INITIALIZE-INFO-KEY PCL::BOOTSTRAP-CLASS-PREDICATES + PCL::GET-BUILT-IN-CLASS-SYMBOL PCL::INITIALIZE-INFO-WRAPPER + PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::DO-STANDARD-DEFSETF-1 + PCL::CACHING-P PCL::GFS-OF-TYPE PCL::LEGAL-CLASS-NAME-P + PCL::STRUCTURE-TYPE-P PCL::CONSTANT-VALUE-P + PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P + SYSTEM::NEXT-STACK-FRAME PCL::WRAPPER-FIELD + PCL::NEXT-WRAPPER-FIELD PCL::SETFBOUNDP + PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P + PCL::MAKE-PV-TYPE-DECLARATION + PCL::MAKE-CALLS-TYPE-DECLARATION PCL::MAP-SPECIALIZERS + WALKER:VARIABLE-GLOBALLY-SPECIAL-P PCL::SLOT-VECTOR-SYMBOL + PCL::MAKE-PERMUTATION-VECTOR PCL::STRUCTURE-OBJECT-P + PCL::EXPAND-MAKE-INSTANCE-FORM PCL::MAKE-CONSTANT-FUNCTION + PCL::FUNCTION-RETURNING-T PCL::SORT-SLOTS PCL::SORT-CALLS + PCL::SYMBOL-PKG-NAME + PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P + PCL::INITIALIZE-INFO-BOUND-SLOTS + PCL::INITIALIZE-INFO-CACHED-VALID-P + PCL::GET-MAKE-INSTANCE-FUNCTIONS + PCL::INITIALIZE-INFO-CACHED-RI-VALID-P + PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST + PCL::INITIALIZE-INFO-CACHED-NEW-KEYS + PCL::UPDATE-C-A-M-GF-INFO + PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION + PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE + PCL::UPDATE-GFS-OF-CLASS + PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION + PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS + PCL::STANDARD-SVUC-METHOD + PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION + PCL:EXTRACT-LAMBDA-LIST PCL::%CCLOSURE-ENV + PCL::STRUCTURE-SVUC-METHOD + PCL::INITIALIZE-INFO-CACHED-CONSTANTS + PCL:EXTRACT-SPECIALIZER-NAMES PCL::METHOD-FUNCTION-PLIST + PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION + PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION + PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL + PCL::INTERNED-SYMBOL-P PCL::GDEFINITION + PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::%STD-INSTANCE-WRAPPER + PCL::%STD-INSTANCE-SLOTS PCL::PV-TABLEP PCL::STD-INSTANCE-P + PCL::COMPUTE-MCASE-PARAMETERS PCL::COMPUTE-CLASS-SLOTS + PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NET-TEST-CONVERTER + PCL:INTERN-EQL-SPECIALIZER + PCL::MAKE-INSTANCE-FUNCTION-SYMBOL + PCL::UPDATE-ALL-C-A-M-GF-INFO + PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DFUN-INFO-CACHE + PCL::NO-METHODS-CACHE PCL::ARG-INFO-APPLYP + PCL::INITIAL-CACHE PCL::INITIAL-DISPATCH-CACHE + PCL::CHECK-CACHE PCL::DISPATCH-CACHE PCL::CLASS-FROM-TYPE + PCL::DEFAULT-METHOD-ONLY-CACHE PCL::DNET-METHODS-P + PCL::ACCESSOR-DFUN-INFO-CACHE + PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION + PCL::ONE-INDEX-DFUN-INFO-CACHE + PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE + PCL::METHOD-CALL-CALL-METHOD-ARGS PCL::KEYWORD-SPEC-NAME + PCL::N-N-CACHE PCL::GENERIC-CLOBBERS-FUNCTION + PCL::N-N-ACCESSOR-TYPE PCL::FAST-METHOD-CALL-PV-CELL + PCL::WRAPPER-FOR-STRUCTURE PCL::ONE-CLASS-CACHE + PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL + PCL::ONE-CLASS-ACCESSOR-TYPE PCL::ONE-CLASS-INDEX + PCL::BUILT-IN-WRAPPER-OF PCL::TWO-CLASS-CACHE + PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 + PCL::TWO-CLASS-ACCESSOR-TYPE PCL::TWO-CLASS-INDEX + PCL::ALLOCATE-CACHE-VECTOR PCL::TWO-CLASS-WRAPPER0 + PCL::FLUSH-CACHE-VECTOR-INTERNAL PCL::ONE-INDEX-CACHE + PCL::EARLY-CLASS-NAME PCL::ONE-INDEX-ACCESSOR-TYPE + PCL::ONE-INDEX-INDEX PCL::INTERN-FUNCTION-NAME + PCL::CHECKING-CACHE PCL::COMPILE-LAMBDA-UNCOMPILED + PCL::GF-LAMBDA-LIST PCL::CACHING-CACHE + PCL::CONSTANT-VALUE-CACHE PCL::COMPILE-LAMBDA-DEFERRED + PCL::FUNCALLABLE-INSTANCE-P + PCL::RESET-CLASS-INITIALIZE-INFO PCL::GET-CACHE-VECTOR + PCL::CONSTANT-SYMBOL-P PCL::FREE-CACHE-VECTOR + PCL::EARLY-METHOD-LAMBDA-LIST PCL::ARG-INFO-VALID-P + PCL::DFUN-ARG-SYMBOL PCL::EARLY-METHOD-CLASS + PCL::EARLY-GF-P PCL::EARLY-GF-NAME PCL::CACHING-DFUN-INFO + PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P + PCL::CONSTANT-VALUE-DFUN-INFO + PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::FREE-CACHE + PCL::PARSE-SPECIALIZERS PCL::RESET-INITIALIZE-INFO + PCL::EARLY-METHOD-QUALIFIERS + PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::WRAPPER-OF + PCL::EARLY-METHOD-STANDARD-ACCESSOR-P + PCL::FUNCTION-PRETTY-ARGLIST + PCL::GET-MAKE-INSTANCE-FUNCTION PCL::CHECK-WRAPPER-VALIDITY + PCL::UNPARSE-SPECIALIZERS PCL::%SYMBOL-FUNCTION + PCL::FINAL-ACCESSOR-DFUN-TYPE + PCL::COMPLICATED-INSTANCE-CREATION-METHOD + PCL::DEFAULT-STRUCTUREP PCL::UPDATE-GF-INFO + PCL::CACHE-OWNER PCL::DEFAULT-STRUCTURE-INSTANCE-P + PCL::DEFAULT-STRUCTURE-TYPE PCL::STRUCTURE-TYPE + PCL::COMPUTE-STD-CPL-PHASE-2 PCL::GET-PV-CELL-FOR-CLASS + PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME + PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST PCL::CACHE-P + PCL::STRUCTURE-SLOTD-NAME + PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL + PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION + PCL::STRUCTURE-SLOTD-WRITER-FUNCTION + PCL::FIND-CYCLE-REASONS PCL::EARLY-CLASS-DEFINITION + PCL::ECD-SOURCE PCL::STRUCTURE-SLOTD-TYPE + PCL::FORMAT-CYCLE-REASONS PCL::ECD-METACLASS PCL::CPD-CLASS + PCL::EARLY-CLASS-PRECEDENCE-LIST + PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P PCL::CPD-SUPERS + PCL::EXPAND-LONG-DEFCOMBIN PCL::EARLY-CLASS-NAME-OF + PCL::CPD-AFTER PCL::EXPAND-SHORT-DEFCOMBIN + PCL::EARLY-CLASS-SLOTDS PCL::CPD-COUNT + PCL::EARLY-SLOT-DEFINITION-NAME PCL::SLOT-READER-SYMBOL + PCL::EARLY-SLOT-DEFINITION-LOCATION WALKER::ENV-LOCK + PCL::MAKE-INITIAL-DFUN PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME + PCL::SLOT-WRITER-SYMBOL WALKER::ENV-DECLARATIONS + WALKER::ENV-LEXICAL-VARIABLES PCL::LIST-DFUN + PCL::SLOT-BOUNDP-SYMBOL PCL::MAP-ALL-GENERIC-FUNCTIONS + PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION + PCL::EARLY-CLASS-DIRECT-SUBCLASSES + PCL::MAKE-FUNCTION-INLINE PCL::LIST-LARGE-CACHE + PCL::CLASS-PRECEDENCE-DESCRIPTION-P + PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS + PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION + PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + WALKER::ENV-WALK-FUNCTION + WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE + PCL::COUNT-DFUN PCL::MAKE-INITFUNCTION + PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + ITERATE::VARIABLES-FROM-LET WALKER::ENV-WALK-FORM + PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION + PCL::INITIALIZE-INFO-P PCL::ECD-CLASS-NAME PCL::COPY-CACHE + PCL::COMPUTE-LINE-SIZE PCL::CANONICAL-SLOT-NAME + WALKER::GET-WALKER-TEMPLATE PCL::EARLY-CLASS-SLOTS + PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::EARLY-COLLECT-CPL + PCL::EARLY-COLLECT-SLOTS + PCL::METHOD-LL->GENERIC-FUNCTION-LL + PCL::EARLY-COLLECT-DEFAULT-INITARGS + PCL::ECD-SUPERCLASS-NAMES PCL::METHOD-CALL-P + PCL::STRUCTURE-SLOT-BOUNDP ITERATE::SEQUENCE-ACCESSOR + PCL::ECD-CANONICAL-SLOTS PCL::ECD-OTHER-INITARGS)) +(PROCLAIM + '(FTYPE (FUNCTION (T *) *) PCL::COERCE-TO-CLASS + PCL::GET-METHOD-FUNCTION WALKER:MACROEXPAND-ALL + PCL::GET-FUNCTION PCL::GET-FUNCTION1 + PCL:ENSURE-GENERIC-FUNCTION PCL::PARSE-METHOD-OR-SPEC + PCL::EXTRACT-DECLARATIONS PCL::GET-DFUN-CONSTRUCTOR + PCL::MAP-ALL-CLASSES PCL::MAKE-CACHING-DFUN + WALKER:WALK-FORM PCL:ENSURE-CLASS + PCL::MAKE-METHOD-FUNCTION-INTERNAL + PCL::PARSE-SPECIALIZED-LAMBDA-LIST + PCL::MAKE-METHOD-LAMBDA-INTERNAL + PCL::MAKE-CONSTANT-VALUE-DFUN PCL::MAKE-FINAL-DFUN-INTERNAL + PCL::COMPILE-LAMBDA)) +(PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) PCL::SYMBOL-APPEND)) +(PROCLAIM '(FTYPE (FUNCTION (T *) STRING) PCL::CAPITALIZE-WORDS)) +(PROCLAIM + '(FTYPE (FUNCTION (T T) *) PCL::SAUT-CLASS + PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P PCL::*TYPEP + PCL::COMPUTE-TEST PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL + PCL::COMPUTE-CODE PCL::CLASS-APPLICABLE-USING-CLASS-P + PCL::SAUT-AND PCL::SAUT-NOT PCL::SAUT-PROTOTYPE + COMPILER::CAN-USE-PRINT-CIRCLE-P1 PCL:SLOT-BOUNDP + PCL::DESTRUCTURE PCL:SLOT-MAKUNBOUND PCL:SLOT-VALUE + PCL::ENSURE-CLASS-VALUES PCL::MAKE-DIRECT-SLOTD + PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P + PCL::MUTATE-SLOTS-AND-CALLS PCL::INVOKE-EMF + PCL::EMIT-DEFAULT-ONLY-FUNCTION PCL::SPLIT-DECLARATIONS + PCL::EMIT-DEFAULT-ONLY COMPILER::C2LAMBDA-EXPR-WITH-KEY + PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::EMIT-CHECKING + PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::EMIT-CACHING + PCL::SDFUN-FOR-CACHING PCL::SLOT-UNBOUND-INTERNAL + PCL::MAKE-INSTANCE-1 PCL::SET-FUNCTION-NAME + PCL::COMPUTE-STD-CPL-PHASE-1 PCL::FORM-LIST-TO-LISP + PCL::FIND-SUPERCLASS-CHAIN PCL::SAUT-CLASS-EQ + PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES + PCL::CHECK-INITARGS-VALUES PCL::SAUT-EQL PCL::*SUBTYPEP + ITERATE::PARSE-DECLARATIONS PCL::INITIAL-DFUN)) +(PROCLAIM + '(FTYPE (FUNCTION (T *) T) PCL::MAKE-TYPE-PREDICATE-NAME + PCL::SET-DFUN PCL:FIND-CLASS PCL::TRACE-METHOD + PCL::FIND-CLASS-CELL PCL::MAKE-FINAL-DFUN + PCL::PV-TABLE-LOOKUP-PV-ARGS PCL::USE-DISPATCH-DFUN-P + WALKER::RELIST* WALKER::RELIST PCL::FIND-CLASS-PREDICATE + PCL::EARLY-METHOD-SPECIALIZERS + PCL::USE-CONSTANT-VALUE-DFUN-P PCL::MAKE-EARLY-GF + PCL::ALLOCATE-FUNCALLABLE-INSTANCE PCL::SET-ARG-INFO + PCL::INITIALIZE-METHOD-FUNCTION PCL::UPDATE-DFUN + PCL::MAKE-SPECIALIZABLE PCL::ALLOCATE-STRUCTURE-INSTANCE + PCL::ALLOCATE-STANDARD-INSTANCE + WALKER::WALKER-ENVIRONMENT-BIND-1 + ITERATE::FUNCTION-LAMBDA-P ITERATE::MAYBE-WARN + PCL::MAKE-WRAPPER)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T) (*)) PCL::SORT-APPLICABLE-METHODS + PCL::SORT-METHODS)) +(PROCLAIM + '(FTYPE (FUNCTION (T T) T) PCL::FDEFINE-CAREFULLY + PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION + PCL::MAKE-STD-READER-METHOD-FUNCTION + PCL::MAKE-STD-WRITER-METHOD-FUNCTION + ITERATE::SIMPLE-EXPAND-ITERATE-FORM + PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION + PCL::DO-SATISFIES-DEFTYPE PCL::MEMF-CONSTANT-CONVERTER + PCL::COMPUTE-CONSTANTS PCL::CLASS-CAN-PRECEDE-P + PCL::SAUT-NOT-CLASS PCL::SAUT-NOT-CLASS-EQ + PCL::SAUT-NOT-PROTOTYPE PCL::GF-MAKE-FUNCTION-FROM-EMF + PCL::SAUT-NOT-EQL PCL::SUPERCLASSES-COMPATIBLE-P + PCL::CLASSES-HAVE-COMMON-SUBCLASS-P + SYSTEM:%SET-COMPILED-FUNCTION-NAME PCL:ADD-METHOD + SYSTEM::DISPLAY-ENV PCL::DESCRIBE-PACKAGE + SYSTEM::DISPLAY-COMPILED-ENV + PCL::PRINTING-RANDOM-THING-INTERNAL + PCL::MAKE-CLASS-PREDICATE + PCL::METHOD-FUNCTION-RETURNING-NIL + PCL::METHOD-FUNCTION-RETURNING-T PCL::VARIABLE-CLASS + PCL::MAKE-PLIST PCL::REMTAIL PCL:REMOVE-METHOD + PCL:SLOT-EXISTS-P PCL::DESTRUCTURE-INTERNAL + PCL::ACCESSOR-MISS-FUNCTION + PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::N-N-DFUN-INFO + PCL::MAKE-CAXR PCL::MAKE-CDXR WALKER:VARIABLE-LEXICAL-P + WALKER:VARIABLE-SPECIAL-P PCL::CHECKING-DFUN-INFO + PCL::MAKE-PV-TABLE-INTERNAL PCL::FIND-SLOT-DEFINITION + WALKER::WALK-REPEAT-EVAL WALKER::NOTE-DECLARATION + PCL::MAKE-DFUN-LAMBDA-LIST WALKER::NOTE-LEXICAL-BINDING + PCL::MAKE-DLAP-LAMBDA-LIST PCL::ADD-DIRECT-SUBCLASSES + PCL::COMPUTE-PV PCL::MAKE-DFUN-ARG-LIST PCL::COMPUTE-CALLS + PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST + PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::UPDATE-CLASS + PCL::MAP-PV-TABLE-REFERENCES-OF PCL::ADD-SLOT-ACCESSORS + WALKER::ENVIRONMENT-FUNCTION PCL::REMOVE-DIRECT-SUBCLASSES + PCL::REMOVE-SLOT-ACCESSORS PCL::SYMBOL-LESSP + PCL::SYMBOL-OR-CONS-LESSP PCL::|SETF PCL FIND-CLASS| + PCL::|SETF PCL FIND-CLASS-PREDICATE| + PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::PV-TABLE-LOOKUP + PCL::PROCLAIM-DEFGENERIC PCL::UPDATE-CPL PCL::LIST-EQ + PCL::UPDATE-SLOTS PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION + PCL::COMPUTE-EMF-FROM-WRAPPERS PCL::UPDATE-INITS + PCL::UPDATE-STD-OR-STR-METHODS + PCL::SET-STANDARD-SVUC-METHOD PCL::EMIT-1-NIL-DLAP + PCL::PLIST-VALUE PCL::SET-STRUCTURE-SVUC-METHOD + PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION + PCL:FUNCALLABLE-STANDARD-INSTANCE-ACCESS + PCL::MEC-ALL-CLASSES-INTERNAL + PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION + PCL::MEC-ALL-CLASSES PCL::%SET-CCLOSURE-ENV + PCL::MEC-ALL-CLASS-LISTS PCL::REDEFINE-FUNCTION + PCL::METHODS-CONVERTER PCL::COMPUTE-LAYOUT PCL::NO-SLOT + PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS + PCL::NET-CONSTANT-CONVERTER PCL::AUGMENT-TYPE + PCL::CHANGE-CLASS-INTERNAL + PCL:SET-FUNCALLABLE-INSTANCE-FUNCTION + PCL::VALUE-FOR-CACHING PCL:STANDARD-INSTANCE-ACCESS + PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::GET-KEY-ARG + PCL::GET-KEY-ARG1 PCL::SET-METHODS + PCL::SET-FUNCTION-PRETTY-ARGLIST + PCL::FIND-STANDARD-II-METHOD PCL::MAKE-EARLY-ACCESSOR + PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER PCL::COMPUTE-STD-CPL + PCL::|SETF PCL GDEFINITION| + PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST PCL::ADD-FORMS + PCL::CPL-INCONSISTENT-ERROR + PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::ADD-TO-CVECTOR + PCL::BOOTSTRAP-SLOT-INDEX PCL::QUALIFIER-CHECK-RUNTIME + PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR + PCL::REAL-REMOVE-METHOD WALKER::ENVIRONMENT-MACRO + PCL::CANONICALIZE-SLOT-SPECIFICATION + PCL::CANONICALIZE-DEFCLASS-OPTION PCL::SET-WRAPPER + PCL::DEAL-WITH-ARGUMENTS-OPTION + PCL::PARSE-QUALIFIER-PATTERN PCL::SWAP-WRAPPERS-AND-SLOTS + ITERATE::MV-SETQ PCL::MAKE-UNORDERED-METHODS-EMF + PCL::CLASS-MIGHT-PRECEDE-P + ITERATE::EXTRACT-SPECIAL-BINDINGS + WALKER::VARIABLE-SYMBOL-MACRO-P PCL::RAISE-METATYPE)) +(PROCLAIM '(FTYPE (FUNCTION NIL FIXNUM) PCL::GET-WRAPPER-CACHE-NUMBER)) +(DOLIST (PCL::V '(PCL::ADD-READER-METHOD + PCL::SHORT-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT + PCL::REMOVE-READER-METHOD PCL::EQL-SPECIALIZER-P + PCL::OBJECT-PLIST + PCL::SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL + PCL::SPECIALIZER-TYPE PCL::GF-DFUN-STATE + PCL::CLASS-DEFSTRUCT-CONSTRUCTOR + PCL::METHOD-FAST-FUNCTION PCL::SPECIALIZERP + PCL::EXACT-CLASS-SPECIALIZER-P + PCL::COMPATIBLE-META-CLASS-CHANGE-P + PCL::UPDATE-GF-DFUN PCL::SPECIALIZER-OBJECT + PCL::ACCESSOR-METHOD-SLOT-NAME + PCL::SPECIALIZER-CLASS PCL::CLASS-EQ-SPECIALIZER-P + PCL::SLOTS-FETCHER PCL::REMOVE-WRITER-METHOD + PCL::STRUCTURE-CLASS-P PCL::UPDATE-CONSTRUCTORS + PCL::DOCUMENTATION PCL::METHOD-PRETTY-ARGLIST + PCL::CLASS-EQ-SPECIALIZER + PCL::INFORM-TYPE-SYSTEM-ABOUT-CLASS + PCL::ACCESSOR-METHOD-CLASS + PCL::GENERIC-FUNCTION-PRETTY-ARGLIST + PCL::MAKE-BOUNDP-METHOD-FUNCTION + PCL::CLASS-PREDICATE-NAME PCL::CLASSP + PCL::LEGAL-QUALIFIERS-P PCL::ADD-BOUNDP-METHOD + PCL::LEGAL-LAMBDA-LIST-P + PCL::|SETF PCL GENERIC-FUNCTION-NAME| + PCL::DESCRIBE-OBJECT PCL::CLASS-INITIALIZE-INFO + PCL::MAKE-WRITER-METHOD-FUNCTION + PCL::|SETF PCL GF-DFUN-STATE| + PCL::|SETF PCL SLOT-DEFINITION-NAME| + PCL::|SETF PCL CLASS-NAME| + PCL::INITIALIZE-INTERNAL-SLOT-FUNCTIONS + PCL::|SETF PCL SLOT-DEFINITION-TYPE| + PCL::METHOD-COMBINATION-P + PCL::|SETF PCL GENERIC-FUNCTION-METHODS| + PCL::|SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION| + PCL::|SETF PCL METHOD-GENERIC-FUNCTION| + PCL::|SETF PCL SLOT-ACCESSOR-STD-P| + PCL::LEGAL-SPECIALIZERS-P + PCL::|SETF PCL OBJECT-PLIST| + PCL::|SETF PCL SLOT-DEFINITION-INITFORM| + PCL::|SETF PCL CLASS-DEFSTRUCT-FORM| + PCL::|SETF PCL GENERIC-FUNCTION-METHOD-CLASS| + PCL::SLOT-ACCESSOR-STD-P + PCL::|SETF PCL GF-PRETTY-ARGLIST| + PCL::|SETF PCL SLOT-ACCESSOR-FUNCTION| + PCL::|SETF PCL SLOT-DEFINITION-LOCATION| + PCL::|SETF PCL SLOT-DEFINITION-READER-FUNCTION| + PCL::|SETF PCL SLOT-DEFINITION-WRITER-FUNCTION| + PCL::|SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION| + PCL::|SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION| + PCL::|SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION| + PCL::|SETF PCL SLOT-DEFINITION-ALLOCATION| + PCL::|SETF PCL SLOT-DEFINITION-INITFUNCTION| + PCL::METHOD-COMBINATION-OPTIONS + PCL::|SETF PCL SLOT-DEFINITION-READERS| + PCL::|SETF PCL DOCUMENTATION| + PCL::FUNCALLABLE-STANDARD-CLASS-P + PCL::|SETF PCL SLOT-DEFINITION-CLASS| + PCL::|SETF PCL SLOT-VALUE-USING-CLASS| + PCL::CLASS-CAN-PRECEDE-LIST + PCL::|SETF PCL CLASS-DIRECT-SLOTS| + PCL::|SETF PCL CLASS-SLOTS| + PCL::SLOT-ACCESSOR-FUNCTION + PCL::|SETF PCL CLASS-INCOMPATIBLE-SUPERCLASS-LIST| + PCL::|SETF PCL SLOT-DEFINITION-WRITERS| + PCL::SLOT-CLASS-P PCL::MAKE-READER-METHOD-FUNCTION + PCL::LEGAL-METHOD-FUNCTION-P PCL::GET-METHOD + PCL::SHORT-METHOD-COMBINATION-P PCL::GF-ARG-INFO + PCL::SPECIALIZER-METHOD-TABLE + PCL::MAKE-METHOD-INITARGS-FORM + PCL::CLASS-DEFSTRUCT-FORM PCL::GF-PRETTY-ARGLIST + PCL::SAME-SPECIALIZER-P + PCL::SLOT-DEFINITION-BOUNDP-FUNCTION + PCL::SLOT-DEFINITION-WRITER-FUNCTION + PCL::SLOT-DEFINITION-READER-FUNCTION + PCL::SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION + PCL::SLOT-DEFINITION-INTERNAL-READER-FUNCTION + PCL::SLOT-DEFINITION-CLASS + PCL::EQL-SPECIALIZER-OBJECT + PCL::CLASS-CONSTRUCTORS PCL::SLOTS-TO-INSPECT + PCL::SPECIALIZER-DIRECT-GENERIC-FUNCTIONS + PCL::ADD-WRITER-METHOD + PCL::LONG-METHOD-COMBINATION-FUNCTION + PCL::GENERIC-FUNCTION-P PCL::LEGAL-SLOT-NAME-P + PCL::CLASS-WRAPPER PCL::DEFINITION-SOURCE + PCL::DEFAULT-INITARGS PCL::CLASS-SLOT-VALUE + PCL::FORWARD-REFERENCED-CLASS-P + PCL::GF-FAST-METHOD-FUNCTION-P + PCL::LEGAL-QUALIFIER-P PCL::METHOD-P + PCL::CLASS-SLOT-CELLS + PCL::STANDARD-ACCESSOR-METHOD-P + PCL::STANDARD-GENERIC-FUNCTION-P + PCL::STANDARD-READER-METHOD-P + PCL::STANDARD-METHOD-P + PCL::COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS + PCL::COMPUTE-DEFAULT-INITARGS + PCL::|SETF PCL CLASS-SLOT-VALUE| + PCL::METHOD-COMBINATION-TYPE PCL::STANDARD-CLASS-P + PCL::LEGAL-SPECIALIZER-P + PCL::COMPUTE-SLOT-ACCESSOR-INFO + PCL::STANDARD-BOUNDP-METHOD-P + PCL::RAW-INSTANCE-ALLOCATOR + PCL::|SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| + PCL::|SETF PCL CLASS-INITIALIZE-INFO| + PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO + PCL::STANDARD-WRITER-METHOD-P + PCL::CLASS-INCOMPATIBLE-SUPERCLASS-LIST + PCL::WRAPPER-FETCHER + PCL::METHOD-COMBINATION-DOCUMENTATION + PCL::|SETF PCL SLOT-DEFINITION-INITARGS| + PCL::REMOVE-BOUNDP-METHOD + PCL::|SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| + PCL::SHORT-COMBINATION-OPERATOR + PCL::REMOVE-NAMED-METHOD + PCL::LEGAL-DOCUMENTATION-P + PCL:CLASS-DIRECT-SUPERCLASSES + PCL:CLASS-DIRECT-SUBCLASSES + PCL:CLASS-DIRECT-DEFAULT-INITARGS + PCL:SLOT-DEFINITION-READERS + PCL:SLOT-VALUE-USING-CLASS + PCL:COMPUTE-APPLICABLE-METHODS PCL:CLASS-NAME + PCL:CLASS-PROTOTYPE PCL:READER-METHOD-CLASS + PCL:REMOVE-METHOD PCL:SLOT-DEFINITION-INITFORM + PCL:UPDATE-INSTANCE-FOR-REDEFINED-CLASS + PCL:UPDATE-INSTANCE-FOR-DIFFERENT-CLASS + PCL:CHANGE-CLASS PCL:METHOD-FUNCTION + PCL:DIRECT-SLOT-DEFINITION-CLASS + PCL:MAKE-METHOD-LAMBDA + PCL:EFFECTIVE-SLOT-DEFINITION-CLASS + PCL:CLASS-SLOTS PCL:COMPUTE-SLOTS + PCL:SLOT-DEFINITION-NAME PCL:FINALIZE-INHERITANCE + PCL:GENERIC-FUNCTION-LAMBDA-LIST + PCL:CLASS-DIRECT-SLOTS PCL:CLASS-DEFAULT-INITARGS + PCL:COMPUTE-DISCRIMINATING-FUNCTION + PCL:CLASS-FINALIZED-P PCL:GENERIC-FUNCTION-NAME + PCL:REMOVE-DEPENDENT + PCL:COMPUTE-CLASS-PRECEDENCE-LIST + PCL:ADD-DEPENDENT PCL:SLOT-BOUNDP-USING-CLASS + PCL:ACCESSOR-METHOD-SLOT-DEFINITION + PCL:SHARED-INITIALIZE PCL:ADD-DIRECT-METHOD + PCL:SLOT-DEFINITION-LOCATION + PCL:SLOT-DEFINITION-INITFUNCTION + PCL:SLOT-DEFINITION-ALLOCATION PCL:ADD-METHOD + PCL:GENERIC-FUNCTION-METHOD-CLASS + PCL:METHOD-SPECIALIZERS + PCL:SLOT-DEFINITION-INITARGS + PCL:WRITER-METHOD-CLASS PCL:ADD-DIRECT-SUBCLASS + PCL:SPECIALIZER-DIRECT-METHODS + PCL:GENERIC-FUNCTION-METHOD-COMBINATION + PCL:ALLOCATE-INSTANCE PCL:COMPUTE-EFFECTIVE-METHOD + PCL:SLOT-DEFINITION-TYPE PCL:SLOT-UNBOUND + PCL:INITIALIZE-INSTANCE PCL:FUNCTION-KEYWORDS + PCL:REINITIALIZE-INSTANCE PCL:VALIDATE-SUPERCLASS + PCL:GENERIC-FUNCTION-METHODS + PCL:REMOVE-DIRECT-METHOD PCL:METHOD-LAMBDA-LIST + PCL:MAKE-INSTANCE + PCL:COMPUTE-EFFECTIVE-SLOT-DEFINITION + PCL:PRINT-OBJECT PCL:METHOD-QUALIFIERS + PCL:METHOD-GENERIC-FUNCTION + PCL:REMOVE-DIRECT-SUBCLASS + PCL:MAKE-INSTANCES-OBSOLETE + PCL:SLOT-MAKUNBOUND-USING-CLASS + PCL:ENSURE-GENERIC-FUNCTION-USING-CLASS + PCL:SLOT-MISSING PCL:MAP-DEPENDENTS + PCL:FIND-METHOD-COMBINATION + PCL:ENSURE-CLASS-USING-CLASS + PCL:NO-APPLICABLE-METHOD + PCL:SLOT-DEFINITION-WRITERS + PCL:COMPUTE-APPLICABLE-METHODS-USING-CLASSES + PCL:CLASS-PRECEDENCE-LIST)) + (SETF (GET PCL::V 'COMPILER::PROCLAIMED-CLOSURE) T)) diff --git a/pcl/impl/kcl/sysdef.lisp b/pcl/impl/kcl/sysdef.lisp new file mode 100644 index 0000000..9da68cd --- /dev/null +++ b/pcl/impl/kcl/sysdef.lisp @@ -0,0 +1,121 @@ +;;; -*- Mode: Lisp; Base: 10; Syntax: Common-Lisp; Package: DSYS -*- +;;; File: sysdef.lisp +;;; Author: Richard Harris + +(in-package "DSYS") + +(defvar *pcl-compiled-p* nil) +(defvar *pcl-loaded-p* nil) + +(unless (boundp 'pcl::*redefined-functions*) + (setq pcl::*redefined-functions* nil)) + +(defun reset-pcl-package () + (pcl::reset-pcl-package) + (let ((defsys (subfile '("pcl") :name "defsys"))) + (setq pcl::*pcl-directory* defsys) + (load-file defsys)) + (mapc #'(lambda (path) + (setf (lfi-fwd (get-loaded-file-info path)) 0)) + (pcl-binary-files))) + +(defun pcl-binary-files () + (pcl::system-binary-files 'pcl::pcl)) + +(defun maybe-load-defsys (&optional compile-defsys-p) + (let ((defsys (subfile '("pcl") :name "defsys")) + (*use-default-pathname-type* nil) + (*skip-load-if-loaded-p* t) + (*skip-compile-file-fwd* 0)) + (set 'pcl::*pcl-directory* defsys) + (when compile-defsys-p + (compile-file defsys)) + (let ((b-s 'pcl::*boot-state*)) + (when (and (boundp b-s) (symbol-value b-s)) + #+ignore (reset-pcl-package))) + (load-file defsys))) + +(defun maybe-load-pcl (&optional force-p) + (unless (and (null force-p) + (fboundp 'pcl::system-binary-files) + (every #'(lambda (path) + (let* ((path-fwd (file-write-date path)) + (lfi (get-loaded-file-info path))) + (and lfi path-fwd (= path-fwd (lfi-fwd lfi))))) + (pcl-binary-files))) + (let ((b-s 'pcl::*boot-state*)) + (when (and (boundp b-s) (symbol-value b-s)) + (reset-pcl-package))) + (pcl::load-pcl))) + +(defsystem pcl + (:pretty-name "PCL") + #+akcl + (:forms + :compile (let ((cfn (subfile '("pcl") :name "collectfn" :type "lisp"))) + (unless (probe-file cfn) + (run-unix-command + (format nil "ln -s ~A ~A" + (namestring (merge-pathnames "../cmpnew/collectfn.lsp" + si::*system-directory*)) + (namestring cfn)))))) + + #+akcl + "collectfn" + (:forms + :compile + (progn + (maybe-load-defsys t) + (if (and (fboundp 'pcl::operation-transformations) + (or (null (probe-file (subfile '("pcl") :name "defsys" :type "lisp"))) + (every #'(lambda (trans) + (eq (car trans) :load)) + (pcl::operation-transformations 'pcl::pcl :compile)))) + (maybe-load-pcl) + (let ((b-s 'pcl::*boot-state*)) + (when (and (boundp b-s) (symbol-value b-s)) + (reset-pcl-package)) + #+akcl (compiler::emit-fn t) + #+akcl (load (merge-pathnames "../lsp/sys-proclaim.lisp" + si::*system-directory*)) + (#+cmu with-compilation-unit #-cmu progn + #+cmu (:optimize + '(optimize (user::debug-info #+(and small (not testing)) .5 + #-(and small (not testing)) 2) + (speed #+testing 1 #-testing 2) + (safety #+testing 3 #-testing 0) + #+ignore (user::inhibit-warnings 2)) + :context-declarations + '(#+ignore + (:external (declare (user::optimize-interface + (safety 2) (debug-info 1)))))) + (proclaim #+testing *testing-declaration* + #-testing *fast-declaration*) + (pcl::compile-pcl)) + (reset-pcl-package) + (maybe-load-pcl t))) + #+cmu (purify)) + :load + (progn + (maybe-load-pcl) + #+cmu (purify)))) + +(defparameter *pcl-files* + '((("systems") "lisp" + "pcl") + (("pcl") "lisp" + "sysdef" + "boot" "braid" "cache" "cloe-low" "cmu-low" "combin" "compat" + "construct" "coral-low" "cpatch" "cpl" "ctypes" "defclass" "defcombin" + "defs" "defsys" "dfun" "dlap" "env" "excl-low" "fin" "fixup" "fngen" "fsc" + "gcl-patches" "genera-low" "gold-low" "hp-low" "ibcl-low" "ibcl-patches" + "init" "iterate" "kcl-low" "kcl-patches" "lap" "low" "lucid-low" "macros" + "methods" "pcl-env-internal" "pcl-env" "pkg" "plap" "precom1" "precom2" + "precom4" "pyr-low" "pyr-patches" "quadlap" "rel-7-2-patches" "rel-8-patches" + "slots" "std-class" "sys-proclaim" "ti-low" "ti-patches" "vaxl-low" "vector" "walk" + "xerox-low" "xerox-patches") + (("pcl") "text" + "12-7-88-notes" "3-17-88-notes" "3-19-87-notes" "4-21-87-notes" + "4-29-87-notes" "5-22-87-notes" "5-22-89-notes" "8-28-88-notes" + "get-pcl" "kcl-mods" "kcl-notes" "lap" "notes" "pcl-env" "readme"))) + diff --git a/pcl/impl/lucid/lucid-low.lisp b/pcl/impl/lucid/lucid-low.lisp new file mode 100644 index 0000000..ec47357 --- /dev/null +++ b/pcl/impl/lucid/lucid-low.lisp @@ -0,0 +1,384 @@ +;;; -*- Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the Lucid lisp version of the file portable-low. +;;; +;;; Lucid: (415)329-8400 +;;; + +(in-package 'pcl) + +;;; First, import some necessary "internal" or Lucid-specific symbols + +(eval-when (eval compile load) + +(#-LCL3.0 progn #+LCL3.0 lcl:handler-bind + #+LCL3.0 ((lcl:warning #'(lambda (condition) + (declare (ignore condition)) + (lcl:muffle-warning)))) +(let ((importer + #+LCL3.0 #'sys:import-from-lucid-pkg + #-LCL3.0 (let ((x (find-symbol "IMPORT-FROM-LUCID-PKG" "LUCID"))) + (if (and x (fboundp x)) + (symbol-function x) + ;; Only the #'(lambda (x) ...) below is really needed, + ;; but when available, the "internal" function + ;; 'import-from-lucid-pkg' provides better checking. + #'(lambda (name) + (import (intern name "LUCID"))))))) + ;; + ;; We need the following "internal", undocumented Lucid goodies: + (mapc importer '("%POINTER" "DEFSTRUCT-SIMPLE-PREDICATE" + #-LCL3.0 "LOGAND&" "%LOGAND&" #+VAX "LOGAND&-VARIABLE")) + + ;; + ;; For without-interrupts. + ;; + #+LCL3.0 + (mapc importer '("*SCHEDULER-WAKEUP*" "MAYBE-CALL-SCHEDULER")) + + ;; + ;; We import the following symbols, because in 2.1 Lisps they have to be + ;; accessed as SYS:, whereas in 3.0 lisps, they are homed in the + ;; LUCID-COMMON-LISP package. + (mapc importer '("ARGLIST" "NAMED-LAMBDA" "*PRINT-STRUCTURE*")) + ;; + ;; We import the following symbols, because in 2.1 Lisps they have to be + ;; accessed as LUCID::, whereas in 3.0 lisps, they have to be + ;; accessed as SYS: + (mapc importer '( + "NEW-STRUCTURE" "STRUCTURE-REF" + "STRUCTUREP" "STRUCTURE-TYPE" "STRUCTURE-LENGTH" + "PROCEDUREP" "PROCEDURE-SYMBOL" + "PROCEDURE-REF" "SET-PROCEDURE-REF" + )) +; ;; +; ;; The following is for the "patch" to the general defstruct printer. +; (mapc importer '( +; "OUTPUT-STRUCTURE" "DEFSTRUCT-INFO" +; "OUTPUT-TERSE-OBJECT" "DEFAULT-STRUCTURE-PRINT" +; "STRUCTURE-TYPE" "*PRINT-OUTPUT*" +; )) + ;; + ;; The following is for a "patch" affecting compilation of %logand&. + ;; On APOLLO, Domain/CommonLISP 2.10 does not include %logand& whereas + ;; Domain/CommonLISP 2.20 does; Domain/CommonLISP 2.20 includes :DOMAIN/OS + ;; on *FEATURES*, so this conditionalizes correctly for APOLLO. + #-(or (and APOLLO DOMAIN/OS) LCL3.0 VAX) + (mapc importer '("COPY-STRUCTURE" "GET-FDESC" "SET-FDESC")) + + nil)) + +;; end of eval-when + +) + + +;;; +;;; Patch up for the fact that the PCL package creation in defsys.lisp +;;; will probably have an explicit :use list ?? +;;; +;;; #+LCL3.0 (use-package *default-make-package-use-list*) + + + + +#+lcl3.0 +(progn + +(defvar *saved-compilation-speed* 3) + +; the production compiler sometimes +; screws up vars within labels + +(defmacro dont-use-production-compiler () + '(eval-when (compile) + (setq *saved-compilation-speed* (if LUCID:*USE-SFC* 3 0)) + (proclaim '(optimize (compilation-speed 3))))) + +(defmacro use-previous-compiler () + `(eval-when (compile) + (proclaim '(optimize (compilation-speed ,*saved-compilation-speed*))))) + +) + +(defmacro %logand (x y) + #-VAX `(%logand& ,x ,y) + #+VAX `(logand&-variable ,x ,y)) + +;;; Fix for VAX LCL +#+VAX +(defun logand&-variable (x y) + (logand&-variable x y)) + +;;; Fix for other LCLs +#-(or (and APOLLO DOMAIN/OS) LCL3.0 VAX) +(eval-when (compile load eval) + +(let* ((logand&-fdesc (get-fdesc 'logand&)) + (%logand&-fdesc (copy-structure logand&-fdesc))) + (setf (structure-ref %logand&-fdesc 0 t) '%logand&) + (setf (structure-ref %logand&-fdesc 7 t) nil) + (setf (structure-ref %logand&-fdesc 8 t) nil) + (set-fdesc '%logand& %logand&-fdesc)) + +(eval-when (load) + (defun %logand& (x y) (%logand& x y))) + +(eval-when (eval) + (compile '%logand& '(lambda (x y) (%logand& x y)))) + +);#-(or LCL3.0 (and APOLLO DOMAIN/OS) VAX) + +;;; +;;; From: JonL +;;; Date: November 28th, 1988 +;;; +;;; Here's a better attempt to do the without-interrupts macro for LCL3.0. +;;; For the 2.1 release, maybe you should just ignore it (i.e, turn it +;;; into a PROGN and "take your chances") since there isn't a uniform way +;;; to do inhibition. 2.1 has interrupts, but no multiprocessing. +;;; +;;; The best bet for protecting the cache is merely to inhibit the +;;; scheduler, since asynchronous interrupts are only run when "scheduled". +;;; Of course, there may be other interrupts, which can cons and which +;;; could cause a GC; but at least they wouldn't be running PCL type code. +;;; +;;; Note that INTERRUPTS-ON shouldn't arbitrarily enable scheduling again, +;;; but rather simply restore it to the state outside the scope of the call +;;; to WITHOUT-INTERRUPTS. Note also that an explicit call to +;;; MAYBE-CALL-SHEDULER must be done when "turning interrupts back on", if +;;; there are any interrupts/schedulings pending; at least the test to see +;;; if any are pending is very fast. + +#+LCL3.0 +(defmacro without-interrupts (&body body) + `(macrolet ((interrupts-on () + `(when (null outer-scheduling-state) + (setq lcl:*inhibit-scheduling* nil) + (when *scheduler-wakeup* (maybe-call-scheduler)))) + (interrupts-off () + '(setq lcl:*inhibit-scheduling* t))) + (let ((outer-scheduling-state lcl:*inhibit-scheduling*)) + (prog1 (let ((lcl:*inhibit-scheduling* t)) . ,body) + (when (and (null outer-scheduling-state) *scheduler-wakeup*) + (maybe-call-scheduler)))))) + + +;;; The following should override the definitions provided by lucid-low. +;;; +#+(or LCL3.0 (and APOLLO DOMAIN/OS)) +(progn +(defstruct-simple-predicate std-instance std-instance-p) +(defstruct-simple-predicate fast-method-call fast-method-call-p) +(defstruct-simple-predicate method-call method-call-p) +) + + + +(defun set-function-name-1 (fn new-name ignore) + (declare (ignore ignore)) + (if (not (procedurep fn)) + (error "~S is not a procedure." fn) + (if (compiled-function-p fn) + ;; This is one of: + ;; compiled-function, funcallable-instance, compiled-closure + ;; or a macro. + ;; So just go ahead and set its name. + ;; Only change the name when necessary: maybe it is read-only. + (unless (eq new-name (procedure-ref fn procedure-symbol)) + (set-procedure-ref fn procedure-symbol new-name)) + ;; This is an interpreted function. + ;; Seems like any number of different things can happen depending + ;; vaguely on what release you are running. Try to do something + ;; reasonable. + (let ((symbol (procedure-ref fn procedure-symbol))) + (cond ((symbolp symbol) + ;; In fact, this is the name of the procedure. + ;; Just set it. + (set-procedure-ref fn procedure-symbol new-name)) + ((and (listp symbol) + (eq (car symbol) 'lambda)) + (setf (car symbol) 'named-lambda + (cdr symbol) (cons new-name (cdr symbol)))) + ((eq (car symbol) 'named-lambda) + (setf (cadr symbol) new-name)))))) + fn) + +(defun function-arglist (fn) + (arglist fn)) + + ;; +;;;;;; printing-random-thing-internal + ;; +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (%pointer thing))) + + +;;; +;;; 16-Feb-90 Jon L White +;;; +;;; A Patch provide specifically for the benefit of PCL, in the Lucid 3.0 +;;; release environment. This adds type optimizers for FUNCALL so that +;;; forms such as: +;;; +;;; (FUNCALL (THE PROCEDURE F) ...) +;;; +;;; and: +;;; +;;; (LET ((F (Frobulate))) +;;; (DECLARE (TYPE COMPILED-FUNCTION F)) +;;; (FUNCALL F ...)) +;;; +;;; will just jump directly to the procedure code, rather than waste time +;;; trying to coerce the functional argument into a procedure. +;;; + + +(in-package "LUCID") + + +;;; (DECLARE-MACHINE-CLASS COMMON) +(set-up-compiler-target 'common) + + +(set-function-descriptor 'FUNCALL + :TYPE 'LISP + :PREDS 'NIL + :EFFECTS 'T + :OPTIMIZER #'(lambda (form &optional environment) + (declare (ignore form environment)) + (let* ((fun (second form)) + (lambdap (and (consp fun) + (eq (car fun) 'function) + (consp (second fun)) + (memq (car (second fun)) + '(lambda internal-lambda))))) + (if (not lambdap) + form + (alphatize + (cons (second fun) (cddr form)) environment)))) + :FUNCTIONTYPE '(function (function &rest t) (values &rest t)) + :TYPE-DISPATCH `(((PROCEDURE &REST T) (VALUES &REST T) + ,#'(lambda (anode fun &rest args) + (declare (ignore anode fun args)) + `(FAST-FUNCALL ,fun ,@args))) + ((COMPILED-FUNCTION &REST T) (VALUES &REST T) + ,#'(lambda (anode fun &rest args) + (declare (ignore anode fun args)) + `(FAST-FUNCALL ,fun ,@args)))) + :LAMBDALIST '(FN &REST ARGUMENTS) + :ARGS '(1 NIL) + :VALUES '(0 NIL) + ) + +(def-compiler-macro fast-funcall (&rest args &environment env) + (if (COMPILER-OPTION-SET-P :READ-SAFETY ENV) + `(FUNCALL-SUBR . ,args) + `(&FUNCALL . ,args))) + + + +(setf (symbol-function 'funcall-subr) #'funcall) + + +;;; (UNDECLARE-MACHINE-CLASS) +(restore-compiler-params) + + +(in-package 'pcl) + +(pushnew :structure-wrapper *features*) + +(defun structure-functions-exist-p () + t) + +(defun structure-instance-p (x) + (and (structurep x) + (not (eq 'std-instance (structure-type x))))) + +(defvar *structure-type* nil) +(defvar *structure-length* nil) + +(defun structure-type-p (type) + (declare (special lucid::*defstructs*)) + (let ((s-data (gethash type lucid::*defstructs*))) + (or (and s-data + (eq 'structure (structure-ref s-data 1 'defstruct))) ; type - Fix this + (and type (eq *structure-type* type))))) + +(defun structure-type-included-type-name (type) + (declare (special lucid::*defstructs*)) + (let ((s-data (gethash type lucid::*defstructs*))) + (and s-data (structure-ref s-data 6 'defstruct)))) ; include - Fix this + +(defun structure-type-slot-description-list (type) + (declare (special lucid::*defstructs*)) + (let ((s-data (gethash type lucid::*defstructs*))) + (if s-data + (nthcdr (let ((include (structure-ref s-data 6 'defstruct))) + (if include + (let ((inc-s-data (gethash include lucid::*defstructs*))) + (if inc-s-data + (length (structure-ref inc-s-data 7 'defstruct)) + 0)) + 0)) + (map 'list + #'(lambda (slotd) + (let* ((ds 'lucid::defstruct-slot) + (slot-name (system:structure-ref slotd 0 ds)) + (position (system:structure-ref slotd 1 ds)) + (accessor (system:structure-ref slotd 2 ds)) + (read-only-p (system:structure-ref slotd 5 ds))) + (list slot-name accessor + #'(lambda (x) + (system:structure-ref x position type)) + (unless read-only-p + #'(lambda (v x) + (setf (system:structure-ref x position type) + v)))))) + (structure-ref s-data 7 'defstruct))) ; slots - Fix this + (let ((result (make-list *structure-length*))) + (dotimes (i *structure-length* result) + (let* ((name (format nil "SLOT~D" i)) + (slot-name (intern name (or (symbol-package type) *package*))) + (i i)) + (setf (elt result i) (list slot-name nil + #'(lambda (x) + (system:structure-ref x i type)) + nil)))))))) + +(defun structure-slotd-name (slotd) + (first slotd)) + +(defun structure-slotd-accessor-symbol (slotd) + (second slotd)) + +(defun structure-slotd-reader-function (slotd) + (third slotd)) + +(defun structure-slotd-writer-function (slotd) + (fourth slotd)) diff --git a/pcl/impl/pyramid/pyr-low.lisp b/pcl/impl/pyramid/pyr-low.lisp new file mode 100644 index 0000000..935a7d3 --- /dev/null +++ b/pcl/impl/pyramid/pyr-low.lisp @@ -0,0 +1,50 @@ +;;; -*- Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the Pyramid version of low.lisp -- it runs with versions 1.1 +;;; and newer -- Created by David Bein Mon May 4 11:22:30 1987 +;;; +(in-package 'pcl) + + ;; +;;;;;; Cache No's + ;; + +;;; The purpose behind the shift is that the bottom 2 bits are always 0 +;;; We use the same scheme for symbols and objects although a good +;;; case may be made for shifting objects more since they will +;;; be aligned differently... + +;(defmacro symbol-cache-no (symbol mask) +; `(logand (the fixnum (ash (lisp::%sp-make-fixnum ,symbol) -2)) +; (the fixnum ,mask))) + +(defmacro object-cache-no (symbol mask) + `(logand (the fixnum (ash (lisp::%sp-make-fixnum ,symbol) -2)) + (the fixnum ,mask))) + + + diff --git a/pcl/impl/pyramid/pyr-patches.lisp b/pcl/impl/pyramid/pyr-patches.lisp new file mode 100644 index 0000000..32647fe --- /dev/null +++ b/pcl/impl/pyramid/pyr-patches.lisp @@ -0,0 +1,9 @@ +(in-package 'pcl) + +;;; This next kludge disables macro memoization (the default) since somewhere +;;; in PCL, the memoization is getting in the way. + +(eval-when (load eval) + (format t "~&;;; Resetting *MACROEXPAND-HOOK* to #'FUNCALL~%") + (setq lisp::*macroexpand-hook* #'funcall)) + diff --git a/pcl/impl/symbolics/cloe-low.lisp b/pcl/impl/symbolics/cloe-low.lisp new file mode 100644 index 0000000..af7459d --- /dev/null +++ b/pcl/impl/symbolics/cloe-low.lisp @@ -0,0 +1,32 @@ +;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package :pcl) + +(defmacro object-cache-no (object mask) + `(logand (sys::address-of ,object) ,mask)) + diff --git a/pcl/impl/symbolics/genera-low.lisp b/pcl/impl/symbolics/genera-low.lisp new file mode 100644 index 0000000..71c939d --- /dev/null +++ b/pcl/impl/symbolics/genera-low.lisp @@ -0,0 +1,423 @@ +;;; -*- Mode:LISP; Package:(PCL Lisp 1000); Base:10.; Syntax:Common-lisp; Patch-File: Yes -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the 3600 version of the file portable-low. +;;; + +(in-package 'pcl) + +(pushnew ':pcl-internals dbg:*all-invisible-frame-types*) + +#+IMach ;On the I-Machine these are +(eval-when (compile load eval) ;faster than the versions + ;that use :test #'eq. +(defmacro memq (item list) `(member ,item ,list)) +(defmacro assq (item list) `(assoc ,item ,list)) +(defmacro rassq (item list) `(rassoc ,item ,list)) +(defmacro delq (item list) `(delete ,item ,list)) +(defmacro posq (item list) `(position ,item ,list)) + +) + +compiler:: +(defoptimizer (cl:the the-just-gets-in-the-way-of-optimizers) (form) + (matchp form + (('cl:the type subform) + (ignore type) + subform) + (* form))) + +(defmacro %ash (x count) + (if (and (constantp count) (zerop (eval count))) + x + `(the fixnum (ash (the fixnum ,x ) ,count)))) + +;;; +;;; +;;; + +(defmacro without-interrupts (&body body) + `(let ((outer-scheduling-state si:inhibit-scheduling-flag) + (si:inhibit-scheduling-flag t)) + (macrolet ((interrupts-on () + '(when (null outer-scheduling-state) + (setq si:inhibit-scheduling-flag nil))) + (interrupts-off () + '(setq si:inhibit-scheduling-flag t))) + (progn outer-scheduling-state) + ,.body))) + +;;; +;;; It would appear that #, does not work properly in Genera. At least I can't get it +;;; to work when I use it inside of std-instance-p (defined later in this file). So, +;;; all of this is just to support that. +;;; +;;; WHEN EXPANDS-TO +;;; compile to a file (#:EVAL-AT-LOAD-TIME-MARKER . ) +;;; compile to core ' +;;; not in compiler at all (progn ) +;;; +;;; Believe me when I tell you that I don't know why it is I need both a +;;; transformer and an optimizer to get this to work. Believe me when I +;;; tell you that I don't really care why either. +;;; +(defmacro load-time-eval (form) + ;; The interpreted definition of load-time-eval. This definition + ;; never gets compiled. + (let ((value (gensym))) + `(multiple-value-bind (,value) + (progn ,form) + ,value))) + +(compiler:deftransformer (load-time-eval optimize-load-time-eval) (form) + (compiler-is-a-loser-internal form)) + +(compiler:defoptimizer (load-time-eval transform-load-time-eval) (form) + (compiler-is-a-loser-internal form)) + +(defun compiler-is-a-loser-internal (form) + ;; When compiling a call to load-time-eval the compiler will call + ;; this optimizer before the macro expansion. + (if zl:compiler:(and (boundp '*compile-function*) ;Probably don't need + ;this boundp check + ;but it can't hurt. + (funcall *compile-function* :to-core-p)) + ;; Compiling to core. + ;; Evaluate the form now, and expand into a constant + ;; (the result of evaluating the form). + `',(eval (cadr form)) + ;; Compiling to a file. + ;; Generate the magic which causes the dumper compiler and loader + ;; to do magic and evaluate the form at load time. + `',(cons compiler:eval-at-load-time-marker (cadr form)))) + +;; +;;;;;; Memory Block primitives. *** + ;; + + +(defmacro make-memory-block (size &optional area) + `(make-array ,size :area ,area)) + +(defmacro memory-block-ref (block offset) ;Don't want to go faster yet. + `(aref ,block ,offset)) + +(defvar class-wrapper-area) +(eval-when (load eval) + (si:make-area :name 'class-wrapper-area + :room t + :gc :static)) + +(eval-when (compile load eval) + (remprop '%%allocate-instance--class 'inline)) + +(eval-when (compile load eval) + +(scl:defflavor std-instance + ((wrapper nil) + (slots nil)) + () + (:constructor %%allocate-instance--class()) + :ordered-instance-variables) + +(defvar *std-instance-flavor* (flavor:find-flavor 'std-instance)) + +) + +#-imach +(scl:defsubst pcl-%instance-flavor (instance) + (declare (compiler:do-not-record-macroexpansions)) + (sys::%make-pointer sys:dtp-array + (sys:%p-contents-as-locative + (sys:follow-structure-forwarding instance)))) + +#+imach +(scl:defsubst pcl-%instance-flavor (instance) + (sys:%instance-flavor instance)) + +(scl::defsubst std-instance-p (x) + (and (sys:instancep x) + (eq (pcl-%instance-flavor x) (load-time-eval *std-instance-flavor*)))) + +(scl:defmethod (:print-self std-instance) (stream depth slashify) + (declare (ignore slashify)) + (print-std-instance scl:self stream depth)) + +(scl:defmethod (:describe std-instance) () + (describe-object scl:self *standard-output*)) + +(defmacro %std-instance-wrapper (std-instance) + `(sys:%instance-ref ,std-instance 1)) + +(defmacro %std-instance-slots (std-instance) + `(sys:%instance-ref ,std-instance 2)) + +(scl:compile-flavor-methods std-instance) + + +(defun printing-random-thing-internal (thing stream) + (format stream "~\\si:address\\" (si:%pointer thing))) + +;;; +;;; This is hard, I am sweating. +;;; +(defun function-arglist (function) (zl:arglist function t)) + +(defun function-pretty-arglist (function) (zl:arglist function)) + + +;; New (& complete) fspec handler. +;; 1. uses a single #'equal htable where stored elements are (fn . plist) +;; (maybe we should store the method object instead) +;; 2. also implements the fspec-plist operators here. +;; 3. fdefine not only stores the method, but actually does the loading here! +;; + +;;; +;;; genera-low.lisp (replaces old method-function-spec-handler) +;;; + +;; New (& complete) fspec handler. +;; 1. uses a single #'equal htable where stored elements are (fn . plist) +;; (maybe we should store the method object instead) +;; 2. also implements the fspec-plist operators here. +;; 3. fdefine not only stores the method, but actually does the loading here! +;; + +(defvar *method-htable* (make-hash-table :test #'equal :size 500)) +(sys:define-function-spec-handler method (op spec &optional arg1 arg2) + (if (eq op 'sys:validate-function-spec) + (and (let ((gspec (cadr spec))) + (or (symbolp gspec) + (and (listp gspec) + (eq (car gspec) 'setf) + (symbolp (cadr gspec)) + (null (cddr gspec))))) + (let ((tail (cddr spec))) + (loop (cond ((null tail) (return nil)) + ((listp (car tail)) (return t)) + ((atom (pop tail))) + (t (return nil)))))) + (let ((table *method-htable*) + (key spec)) + (case op + ((si:fdefinedp si:fdefinition) + (car (gethash key table nil))) + (si:fundefine + (remhash key table)) + (si:fdefine + (let ((old (gethash key table nil)) + (quals nil) + (specs nil) + (ptr (cddr spec))) + (setq specs + (loop (cond ((null ptr) (return nil)) + ((listp (car ptr)) (return (car ptr))) + (t (push (pop ptr) quals))))) + (setf (gethash key table) (cons arg1 (cdr old))))) + (si:get + (let ((old (gethash key table nil))) + (getf (cdr old) arg1))) + (si:plist + (let ((old (gethash key table nil))) + (cdr old))) + (si:putprop + (let ((old (gethash key table nil))) + (unless old + (setf old (cons nil nil)) + (setf (gethash key table) old)) + (setf (getf (cdr old) arg2) arg1))) + (si:remprop + (let ((old (gethash key table nil))) + (when old + (remf (cdr old) arg1)))) + (otherwise + (si:function-spec-default-handler op spec arg1 arg2)))))) + + +#|| +;; this guy is just a stub to make the fspec handler simpler (and so I could trace it +;; easier). +(defun pcl-fdefine-helper (gspec qualifiers specializers fn) + (let* ((dlist (scl:debugging-info fn)) + (class (cadr (assoc 'pcl-method-class dlist))) + (lambda-list (let ((ll-stuff (assoc 'pcl-lambda-list dlist))) + (if ll-stuff (cadr ll-stuff) (arglist fn)))) + (doc (cadr (assoc 'pcl-documentation dlist))) + (plist (cadr (assoc 'pcl-plist dlist)))) + (load-defmethod (or class 'standard-method) + gspec + qualifiers + specializers + lambda-list + doc + (getf plist :pv-table-cache-symbol) + plist + fn))) +||# + +;; define a few special declarations to get pushed onto the function's debug-info +;; list... note that we do not need to do a (proclaim (declarations ...)) here. +;; +(eval-when (compile load eval) + (setf (get 'pcl-plist 'si:debug-info) t) + (setf (get 'pcl-documentation 'si:debug-info) t) + (setf (get 'pcl-method-class 'si:debug-info) t) + (setf (get 'pcl-lambda-list 'si:debug-info) t) +) + +(eval-when (load eval) + (setf + (get 'defmethod 'zwei:definition-function-spec-type) 'defun + (get 'defmethod-setf 'zwei:definition-function-spec-type) 'defun + (get 'method 'si:definition-type-name) "method" + (get 'method 'si:definition-type-name) "method" + + (get 'declass 'zwei:definition-function-spec-type) 'defclass + (get 'defclass 'si:definition-type-name) "Class" + (get 'defclass 'zwei:definition-function-spec-finder-template) '(0 1)) + ) + + + +(defun (:property defmethod zwei::definition-function-spec-parser) (bp) + (zwei:parse-pcl-defmethod-for-zwei bp nil)) + +;;; +;;; Previously, if a source file in a PCL-based package contained what looks +;;; like flavor defmethod forms (i.e. an (IN-PACKAGE 'non-pcl-package) form +;;; appears at top level, and then a flavor-style defmethod form) appear, the +;;; parser would break. +;;; +;;; Now, if we can't parse the defmethod form, we send it to the flavor +;;; defmethod parser instead. +;;; +;;; Also now supports multi-line arglist sectionizing. +;;; +zwei: +(defun parse-pcl-defmethod-for-zwei (bp-after-defmethod setfp) + (block parser + (flet ((barf (&optional (error t)) + (return-from parser + (cond ((eq error :flavor) + (funcall (get 'flavor:defmethod + 'zwei::definition-function-spec-parser) + bp-after-defmethod)) + (t + (values nil nil nil error)))))) + (let ((bp-after-generic (forward-sexp bp-after-defmethod)) + (qualifiers ()) + (specializers ()) + (spec nil) + (ignore1 nil) + (ignore2 nil)) + (when bp-after-generic + (multiple-value-bind (generic error-p) + (read-fspec-item-from-interval bp-after-defmethod + bp-after-generic) + (if error-p + (barf) ; error here is really bad.... BARF! + (progn + (when (listp generic) + (if (and (symbolp (car generic)) + (string-equal (cl:symbol-name (car generic)) "SETF")) + (setq generic (second generic) ; is a (setf xxx) form + setfp t) + (barf :flavor))) ; make a last-ditch-effort with flavor parser + (let* ((bp1 bp-after-generic) + (bp2 (forward-sexp bp1))) + (cl:loop + (if (null bp2) + (barf :more) ; item not closed - need another line! + (multiple-value-bind (item error-p) + (read-fspec-item-from-interval bp1 bp2) + (cond (error-p (barf)) ; + ((listp item) + (setq qualifiers (nreverse qualifiers)) + (cl:multiple-value-setq (ignore1 + ignore2 + specializers) + (pcl::parse-specialized-lambda-list item)) + (setq spec (pcl::make-method-spec + (if setfp + `(cl:setf ,generic) + generic) + qualifiers + specializers)) + (return (values spec + 'defun + (string-interval + bp-after-defmethod + bp2)))) + (t (push item qualifiers) + (setq bp1 bp2 + bp2 (forward-sexp bp2)))))))))))))))) + +zwei: +(progn + (defun indent-clos-defmethod (ignore bp defmethod-paren &rest ignore) + (let ((here + (forward-over *whitespace-chars* (forward-word defmethod-paren)))) + (loop until (char-equal (bp-char here) #\() + do (setf here + (forward-over *whitespace-chars* (forward-sexp here)))) + (if (bp-< here bp) + (values defmethod-paren nil 2) + (values defmethod-paren nil 4)))) + + (defindentation (pcl::defmethod . indent-clos-defmethod))) + +;;; +;;; Teach zwei that when it gets the name of a generic function as an argument +;;; it should edit all the methods of that generic function. This works for +;;; ED as well as meta-point. +;;; +(zl:advise (flavor:method :SETUP-FUNCTION-SPECS-TO-EDIT zwei:ZMACS-EDITOR) + :around + setup-function-specs-to-edit-advice + () + (let ((old-definitions (cadddr arglist)) + (new-definitions ()) + (new nil)) + (dolist (old old-definitions) + (setq new (setup-function-specs-to-edit-advice-1 old)) + (push (or new (list old)) new-definitions)) + (setf (cadddr arglist) (apply #'append (reverse new-definitions))) + :do-it)) + +(defun setup-function-specs-to-edit-advice-1 (spec) + (and (or (symbolp spec) + (and (listp spec) (eq (car spec) 'setf))) + (gboundp spec) + (generic-function-p (gdefinition spec)) + (mapcar #'(lambda (m) + (make-method-spec spec + (method-qualifiers m) + (unparse-specializers + (method-specializers m)))) + (generic-function-methods (gdefinition spec))))) + + diff --git a/pcl/impl/symbolics/rel-7-2-patches.lisp b/pcl/impl/symbolics/rel-7-2-patches.lisp new file mode 100644 index 0000000..9c9587b --- /dev/null +++ b/pcl/impl/symbolics/rel-7-2-patches.lisp @@ -0,0 +1,387 @@ +;;; -*- Mode: LISP; Syntax: Common-lisp; Package: ZL-USER; Base: 10; Patch-File: T -*- + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:l-COMPILER;OPTIMIZE.LISP.179") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: Lisp; Package: Compiler; Lowercase: T; Base: 8 -*-") + +;;; Does simple constant folding. This works for everything that doesn't have +;;; side-effects. +;;; ALL operands must be constant. +;;; Note that commutative-constant-folder can hack this case perfectly well +;;; by himself for the functions he handles. +(defun constant-fold-optimizer (form) + (let ((eval-when-load-p nil)) + (flet ((constant-form-p (x) + (when (constant-form-p x) + (cond ((and (listp x) + (eq (car x) 'quote) + (listp (cadr x)) + (eq (caadr x) eval-at-load-time-marker)) + (setq eval-when-load-p t) + (cdadr x)) + (t x))))) + (if (every (cdr form) #'constant-form-p) + (if eval-when-load-p + (list 'quote + (list* eval-at-load-time-marker + (car form) + (mapcar #'constant-form-p (cdr form)))) + (condition-case (error-object) + (multiple-value-call #'(lambda (&rest values) + (if (= (length values) 1) + `',(first values) + `(values ,@(mapcar #'(lambda (x) `',x) + values)))) + (eval form)) + (error + (phase-1-warning "Constant form left unoptimized: ~S~%because: ~~A~" + form error-object) + form))) + form)))) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:L-COMPILER;COMFILE.LISP.85") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: Lisp; Package: Compiler; Lowercase: T; Base: 8 -*-") + +;;; +;;; The damn compiler doesn't compile random forms that appear at top level. +;;; Its difficult to do because you have to get an associated function spec +;;; to go with those forms. This handles that by defining a special form, +;;; top-level-form that compiles its body. It takes a list of eval-when +;;; times just like eval when does. It also takes a name which it uses +;;; to construct a function spec for the top-level-form function it has +;;; to create. +;;; +; +;si:: +;(defvar *top-level-form-fdefinitions* (cl:make-hash-table :test #'equal)) +; +;si:: +;(define-function-spec-handler pcl::top-level-form +; (operation fspec &optional arg1 arg2) +; (let ((name (cadr fspec))) +; (selectq operation +; (validate-function-spec (and (= (length fspec) 2) +; (or (symbolp name) +; (listp name)))) +; (fdefine +; (setf (gethash name *top-level-form-fdefinitions*) arg1)) +; ((fdefinition fdefinedp) +; (gethash name *top-level-form-fdefinitions*)) +; (fdefinition-location +; (ferror "It is not possible to get the fdefinition-location of ~s." +; fspec)) +; (fundefine (remhash name *top-level-form-fdefinitions*)) +; (otherwise (function-spec-default-handler operation fspec arg1 arg2))))) +; +;;; +;;; This is basically stolen from PROGN (surprised?) +;;; +;(si:define-special-form pcl::top-level-form (name times +; &body body +; &environment env) +; (declare lt:(arg-template . body) (ignore name)) +; (si:check-eval-when-times times) +; (when (member 'eval times) (si:eval-body body env))) +; +;(defun (:property pcl::top-level-form lt:mapforms) (original-form form usage) +; (lt::mapforms-list original-form form (cddr form) 'eval usage)) + +;;; This is the normal function for looking at each form read from the file and calling +;;; *COMPILE-FORM-FUNCTION* on the sub-forms of it. +;;; COMPILE-TIME-TOO means override the normal cases that eval at compile time. It is +;;; used for recursive calls under (EVAL-WHEN (COMPILE LOAD) ...). +;(DEFUN COMPILE-FROM-STREAM-1 (FORM &OPTIONAL (COMPILE-TIME-TOO NIL)) +; (CATCH-ERROR-RESTART +; (SYS:ERROR "Skip compiling form ~2,2\COMPILER:SHORT-S-FORMAT\" FORM) +; (LET ((DEFAULT-CONS-AREA (FUNCALL *COMPILE-FUNCTION* ':CONS-AREA))) +; (LET ((ERROR-MESSAGE-HOOK +; #'(LAMBDA () +; (DECLARE (SYS:DOWNWARD-FUNCTION)) +; (FORMAT T "~&While processing ~V,V\COMPILER:SHORT-S-FORMAT\" +; DBG:*ERROR-MESSAGE-PRINLEVEL* +; DBG:*ERROR-MESSAGE-PRINLENGTH* +; FORM)))) +; (SETQ FORM (FUNCALL *COMPILE-FUNCTION* ':MACRO-EXPAND FORM))) +; (WHEN (LISTP FORM) ;Ignore atoms at top-level +; (LET ((FUNCTION (FIRST FORM))) +; (SELECTQ FUNCTION +; ((QUOTE)) ;and quoted constants e.g. 'COMPILE +; ((PROGN) +; (DOLIST (FORM (CDR FORM)) +; (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO))) +; ((EVAL-WHEN) +; (SI:CHECK-EVAL-WHEN-TIMES (CADR FORM)) +; (LET ((COMPILE-P (OR (MEMQ 'COMPILE (CADR FORM)) +; (AND COMPILE-TIME-TOO (MEMQ 'EVAL (CADR FORM))))) +; (LOAD-P (OR (MEMQ 'LOAD (CADR FORM)) (MEMQ 'CL:LOAD (CADR FORM)))) +; (FORMS (CDDR FORM))) +; (COND (LOAD-P +; (DOLIST (FORM FORMS) +; (COMPILE-FROM-STREAM-1 FORM (AND COMPILE-P ':FORCE)))) +; (COMPILE-P +; (DOLIST (FORM FORMS) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM ':FORCE NIL)))))) +; ((DEFUN) +; (LET ((TEM (DEFUN-COMPATIBILITY (CDR FORM) :WARN-IF-OBSOLETE T))) +; (IF (EQ (CDR TEM) (CDR FORM)) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T) +; (COMPILE-FROM-STREAM-1 TEM COMPILE-TIME-TOO)))) +; ((MACRO) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T) T)) +; ((DECLARE) +; (DOLIST (FORM (CDR FORM)) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T) +; ;; (DECLARE (SPECIAL ... has load-time action as well. +; ;; All other DECLARE's do not. +; (MEMQ (CAR FORM) '(SPECIAL ZL:UNSPECIAL))))) +; ((COMPILER-LET) +; (COMPILER-LET-INTERNAL (CADR FORM) (CDDR FORM) +; #'COMPILE-FROM-STREAM-1 COMPILE-TIME-TOO)) +; ((SI:DEFINE-SPECIAL-FORM) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T)) +; ((MULTIPLE-DEFINITION) +; (DESTRUCTURING-BIND (NAME TYPE . BODY) (CDR FORM) +; (LET ((NAME-VALID (AND (NOT (NULL NAME)) +; (OR (SYMBOLP NAME) +; (AND (LISTP NAME) (NEQ (CAR NAME) 'QUOTE))))) +; (TYPE-VALID (AND (NOT (NULL TYPE)) (SYMBOLP TYPE)))) +; (UNLESS (AND NAME-VALID TYPE-VALID) +; (WARN "(~S ~S ~S ...) is invalid because~@ +; ~:[~S is not valid as a definition name~;~*~]~ +; ~:[~&~S is not valid as a definition type~;~*~]" +; 'MULTIPLE-DEFINITION NAME TYPE NAME-VALID NAME TYPE-VALID TYPE))) +; (LET* ((COMPILED-BODY NIL) +; (COMPILE-FUNCTION *COMPILE-FUNCTION*) +; (*COMPILE-FUNCTION* +; (LAMBDA (OPERATION &REST ARGS) +; (DECLARE (SYS:DOWNWARD-FUNCTION)) +; (SELECTQ OPERATION +; (:DUMP-FORM +; (PUSH (FUNCALL COMPILE-FUNCTION :OPTIMIZE-TOP-LEVEL-FORM +; (FIRST ARGS)) +; COMPILED-BODY)) +; (:INSTALL-DEFINITION +; (PUSH (FORM-FOR-DEFINE *COMPILER* (FIRST ARGS) (SECOND ARGS)) +; COMPILED-BODY)) +; (OTHERWISE (CL:APPLY COMPILE-FUNCTION OPERATION ARGS))))) +; (LOCAL-DECLARATIONS `((FUNCTION-PARENT ,NAME ,TYPE) +; ,@LOCAL-DECLARATIONS))) +; (DOLIST (FORM BODY) +; (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO)) +; (FUNCALL COMPILE-FUNCTION :DUMP-FORM +; `(LOAD-MULTIPLE-DEFINITION +; ',NAME ',TYPE ',(NREVERSE COMPILED-BODY) NIL))))) +; ((pcl::top-level-form) +; (destructuring-bind (name times . body) +; (cdr form) +; (si:check-eval-when-times times) +; (let ((compile-p (or (memq 'compile times) +; (and compile-time-too (memq 'eval times)))) +; (load-p (or (memq 'load times) +; (memq 'cl:load times))) +; (fspec `(pcl::top-level-form ,name))) +; (cond (load-p +; (compile-from-stream-1 +; `(progn (defun ,fspec () . ,body) +; (funcall (function ,fspec))) +; (and compile-p ':force))) +; (compile-p +; (dolist (b body) +; (funcall *compile-form-function* form ':force nil))))))) +; (OTHERWISE +; (LET ((TEM (AND (SYMBOLP FUNCTION) (GET FUNCTION 'TOP-LEVEL-FORM)))) +; (IF TEM +; (FUNCALL *COMPILE-FORM-FUNCTION* (FUNCALL TEM FORM) COMPILE-TIME-TOO T) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T)))))))))) +; +; + + +dw:: +(defun symbol-flavor-or-cl-type (symbol) + (declare (values flavor defstruct-p deftype-fun typep-fun atomic-subtype-parent + non-atomic-deftype)) + (multiple-value-bind (result foundp) + (gethash symbol *flavor-or-cl-type-cache*) + (let ((frob + (if foundp result + (setf (gethash symbol *flavor-or-cl-type-cache*) + (or (get symbol 'flavor:flavor) + (not (null (defstruct-type-p symbol))) + (let* ((deftype (get symbol 'deftype)) + (descriptor (symbol-presentation-type-descriptor symbol)) + (typep + (unless (and descriptor + (presentation-type-explicit-type-function + descriptor)) + ;; Don't override the one defined in the presentation-type. + (get symbol 'typep))) + (atomic-subtype-parent (find-atomic-subtype-parent symbol)) + (non-atomic-deftype + (when (and (not descriptor) deftype) + (not (member (first (type-arglist symbol)) + '(&rest &key &optional)))))) + (if (or typep (not (atom deftype)) + non-atomic-deftype + ;; deftype overrides atomic-subtype-parent. + (and (not deftype) atomic-subtype-parent)) + (list-in-area *handler-dynamic-area* + deftype typep atomic-subtype-parent + non-atomic-deftype) + deftype))))))) + (locally (declare (inline compiled-function-p)) + (etypecase frob + (array (values frob)) + (null (values nil)) + ((member t) (values nil t)) + (compiled-function (values nil nil frob)) + (lexical-closure (values nil nil frob)) + (list (destructuring-bind (deftype typep atomic-subtype-parent non-atomic-deftype) + frob + (values nil nil deftype typep atomic-subtype-parent non-atomic-deftype))) + (symbol (values nil nil nil nil frob))))))) + +;;; +;;; The variable zwei::*sectionize-line-lookahead* controls how many lines the parser +;;; is willing to look ahead while trying to parse a definition. Even 2 lines is enough +;;; for just about all cases, but there isn't much overhead, and 10 should be enough +;;; to satisfy pretty much everyone... but feel free to change it. +;;; - MT 880921 +;;; + +zwei: +(defvar *sectionize-line-lookahead* 3) + +zwei: +(DEFMETHOD (:SECTIONIZE-BUFFER MAJOR-MODE :DEFAULT) + (FIRST-BP LAST-BP BUFFER STREAM INT-STREAM ADDED-COMPLETIONS) + ADDED-COMPLETIONS ;ignored, obsolete + (WHEN STREAM + (SEND-IF-HANDLES STREAM :SET-RETURN-DIAGRAMS-AS-LINES T)) + (INCF *SECTIONIZE-BUFFER*) + (LET ((BUFFER-TICK (OR (SEND-IF-HANDLES BUFFER :SAVE-TICK) *TICK*)) + OLD-CHANGED-SECTIONS) + (TICK) + ;; Flush old section nodes. Also collect the names of those that are modified, they are + ;; the ones that will be modified again after a revert buffer. + (DOLIST (NODE (NODE-INFERIORS BUFFER)) + (AND (> (NODE-TICK NODE) BUFFER-TICK) + (PUSH (LIST (SECTION-NODE-FUNCTION-SPEC NODE) + (SECTION-NODE-DEFINITION-TYPE NODE)) + OLD-CHANGED-SECTIONS)) + (FLUSH-BP (INTERVAL-FIRST-BP NODE)) + (FLUSH-BP (INTERVAL-LAST-BP NODE))) + (DO ((LINE (BP-LINE FIRST-BP) (LINE-NEXT INT-LINE)) + (LIMIT (BP-LINE LAST-BP)) + (EOFFLG) + (ABNORMAL T) + (DEFINITION-LIST NIL) + (BP (COPY-BP FIRST-BP)) + (FUNCTION-SPEC) + (DEFINITION-TYPE) + (STR) + (INT-LINE) + (first-time t) + (future-line) ; we actually read into future line + (future-int-line) + (PREV-NODE-START-BP FIRST-BP) + (PREV-NODE-DEFINITION-LINE NIL) + (PREV-NODE-FUNCTION-SPEC NIL) + (PREV-NODE-TYPE 'HEADER) + (PREVIOUS-NODE NIL) + (NODE-LIST NIL) + (STATE (SEND SELF :INITIAL-SECTIONIZATION-STATE))) + (NIL) + ;; If we have a stream, read another line. + (when (AND STREAM (NOT EOFFLG)) + (let ((lookahead (if future-line 1 *sectionize-line-lookahead*))) + (dotimes (i lookahead) ; startup lookahead + (MULTIPLE-VALUE (future-LINE EOFFLG) + (LET ((DEFAULT-CONS-AREA *LINE-AREA*)) + (SEND STREAM ':LINE-IN LINE-LEADER-SIZE))) + (IF future-LINE (SETQ future-INT-LINE (FUNCALL INT-STREAM ':LINE-OUT future-LINE))) + (when first-time + (setq first-time nil) + (setq line future-line) + (setq int-line future-int-line)) + (when eofflg + (return))))) + + (SETQ INT-LINE LINE) + + (when int-line + (MOVE-BP BP INT-LINE 0)) ;Record as potentially start-bp for a section + + ;; See if the line is the start of a defun. + (WHEN (AND LINE + (LET (ERR) + (MULTIPLE-VALUE (FUNCTION-SPEC DEFINITION-TYPE STR ERR STATE) + (SEND SELF ':SECTION-NAME INT-LINE BP STATE)) + (NOT ERR))) + (PUSH (LIST FUNCTION-SPEC DEFINITION-TYPE) DEFINITION-LIST) + (SECTION-COMPLETION FUNCTION-SPEC STR NIL) + ;; List methods under both names for user ease. + (LET ((OTHER-COMPLETION (SEND SELF ':OTHER-SECTION-NAME-COMPLETION + FUNCTION-SPEC INT-LINE))) + (WHEN OTHER-COMPLETION + (SECTION-COMPLETION FUNCTION-SPEC OTHER-COMPLETION NIL))) + (LET ((PREV-NODE-END-BP (BACKWARD-OVER-COMMENT-LINES BP ':FORM-AS-BLANK))) + ;; Don't make a section node if it's completely empty. This avoids making + ;; a useless Buffer Header section node. Just set all the PREV variables + ;; so that the next definition provokes the *right thing* + (UNLESS (BP-= PREV-NODE-END-BP PREV-NODE-START-BP) + (SETQ PREVIOUS-NODE + (ADD-SECTION-NODE PREV-NODE-START-BP + (SETQ PREV-NODE-START-BP PREV-NODE-END-BP) + PREV-NODE-FUNCTION-SPEC PREV-NODE-TYPE + PREV-NODE-DEFINITION-LINE BUFFER PREVIOUS-NODE + (IF (LOOP FOR (FSPEC TYPE) IN OLD-CHANGED-SECTIONS + THEREIS (AND (EQ PREV-NODE-FUNCTION-SPEC FSPEC) + (EQ PREV-NODE-TYPE TYPE))) + *TICK* BUFFER-TICK) + BUFFER-TICK)) + (PUSH PREVIOUS-NODE NODE-LIST))) + (SETQ PREV-NODE-FUNCTION-SPEC FUNCTION-SPEC + PREV-NODE-TYPE DEFINITION-TYPE + PREV-NODE-DEFINITION-LINE INT-LINE)) + ;; After processing the last line, exit. + (WHEN (OR #+ignore EOFFLG (null line) (AND (NULL STREAM) (EQ LINE LIMIT))) + ;; If reading a stream, we should not have inserted a CR + ;; after the eof line. + (WHEN STREAM + (DELETE-INTERVAL (FORWARD-CHAR LAST-BP -1 T) LAST-BP T)) + ;; The rest of the buffer is part of the last node + (UNLESS (SEND SELF ':SECTION-NAME-TRIVIAL-P) + ;; ---oh dear, what sort of section will this be? A non-empty HEADER + ;; ---node. Well, ok for now. + (PUSH (ADD-SECTION-NODE PREV-NODE-START-BP LAST-BP + PREV-NODE-FUNCTION-SPEC PREV-NODE-TYPE + PREV-NODE-DEFINITION-LINE BUFFER PREVIOUS-NODE + (IF (LOOP FOR (FSPEC TYPE) IN OLD-CHANGED-SECTIONS + THEREIS (AND (EQ PREV-NODE-FUNCTION-SPEC FSPEC) + (EQ PREV-NODE-TYPE TYPE))) + *TICK* BUFFER-TICK) + BUFFER-TICK) + NODE-LIST) + (SETF (LINE-NODE (BP-LINE LAST-BP)) (CAR NODE-LIST))) + (SETF (NODE-INFERIORS BUFFER) (NREVERSE NODE-LIST)) + (SETF (NAMED-BUFFER-WITH-SECTIONS-FIRST-SECTION BUFFER) (CAR (NODE-INFERIORS BUFFER))) + (SETQ ABNORMAL NIL) ;timing windows here + ;; Speed up completion if enabled. + (WHEN SI:*ENABLE-AARRAY-SORTING-AFTER-LOADS* + (SI:SORT-AARRAY *ZMACS-COMPLETION-AARRAY*)) + (SETQ *ZMACS-COMPLETION-AARRAY* + (FOLLOW-STRUCTURE-FORWARDING *ZMACS-COMPLETION-AARRAY*)) + (RETURN + (VALUES + (CL:SETF (ZMACS-SECTION-LIST BUFFER) + (NREVERSE DEFINITION-LIST)) + ABNORMAL)))))) + + diff --git a/pcl/impl/symbolics/rel-8-patches.lisp b/pcl/impl/symbolics/rel-8-patches.lisp new file mode 100644 index 0000000..99b85b2 --- /dev/null +++ b/pcl/impl/symbolics/rel-8-patches.lisp @@ -0,0 +1,255 @@ +;;; -*- Mode: LISP; Syntax: Common-lisp; Package: ZL-USER; Base: 10; Patch-File: T -*- + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:l-COMPILER;OPTIMIZE.LISP.179") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: Lisp; Package: Compiler; Lowercase: T; Base: 8 -*-") + +;;; Does simple constant folding. This works for everything that doesn't have +;;; side-effects. +;;; ALL operands must be constant. +;;; Note that commutative-constant-folder can hack this case perfectly well +;;; by himself for the functions he handles. +(defun constant-fold-optimizer (form) + (let ((eval-when-load-p nil)) + (flet ((constant-form-p (x) + (when (constant-form-p x) + (cond ((and (listp x) + (eq (car x) 'quote) + (listp (cadr x)) + (eq (caadr x) eval-at-load-time-marker)) + (setq eval-when-load-p t) + (cdadr x)) + (t x))))) + (if (every (cdr form) #'constant-form-p) + (if eval-when-load-p + (list 'quote + (list* eval-at-load-time-marker + (car form) + (mapcar #'constant-form-p (cdr form)))) + (condition-case (error-object) + (multiple-value-call #'(lambda (&rest values) + (if (= (length values) 1) + `',(first values) + `(values ,@(mapcar #'(lambda (x) `',x) + values)))) + (eval form)) + (error + (phase-1-warning "Constant form left unoptimized: ~S~%because: ~~A~" + form error-object) + form))) + form)))) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:L-COMPILER;COMFILE.LISP.85") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: Lisp; Package: Compiler; Lowercase: T; Base: 8 -*-") + +;;; +;;; The damn compiler doesn't compile random forms that appear at top level. +;;; Its difficult to do because you have to get an associated function spec +;;; to go with those forms. This handles that by defining a special form, +;;; top-level-form that compiles its body. It takes a list of eval-when +;;; times just like eval when does. It also takes a name which it uses +;;; to construct a function spec for the top-level-form function it has +;;; to create. +;;; +; +;si:: +;(defvar *top-level-form-fdefinitions* (cl:make-hash-table :test #'equal)) +; +;si:: +;(define-function-spec-handler pcl::top-level-form +; (operation fspec &optional arg1 arg2) +; (let ((name (cadr fspec))) +; (selectq operation +; (validate-function-spec (and (= (length fspec) 2) +; (or (symbolp name) +; (listp name)))) +; (fdefine +; (setf (gethash name *top-level-form-fdefinitions*) arg1)) +; ((fdefinition fdefinedp) +; (gethash name *top-level-form-fdefinitions*)) +; (fdefinition-location +; (ferror "It is not possible to get the fdefinition-location of ~s." +; fspec)) +; (fundefine (remhash name *top-level-form-fdefinitions*)) +; (otherwise (function-spec-default-handler operation fspec arg1 arg2))))) +; +;;; +;;; This is basically stolen from PROGN (surprised?) +;;; +;(si:define-special-form pcl::top-level-form (name times +; &body body +; &environment env) +; (declare lt:(arg-template . body) (ignore name)) +; (si:check-eval-when-times times) +; (when (member 'eval times) (si:eval-body body env))) +; +;(defun (:property pcl::top-level-form lt:mapforms) (original-form form usage) +; (lt::mapforms-list original-form form (cddr form) 'eval usage)) + +;;; This is the normal function for looking at each form read from the file and calling +;;; *COMPILE-FORM-FUNCTION* on the sub-forms of it. +;;; COMPILE-TIME-TOO means override the normal cases that eval at compile time. It is +;;; used for recursive calls under (EVAL-WHEN (COMPILE LOAD) ...). +;(DEFUN COMPILE-FROM-STREAM-1 (FORM &OPTIONAL (COMPILE-TIME-TOO NIL)) +; (CATCH-ERROR-RESTART +; (SYS:ERROR "Skip compiling form ~2,2\COMPILER:SHORT-S-FORMAT\" FORM) +; (LET ((DEFAULT-CONS-AREA (FUNCALL *COMPILE-FUNCTION* ':CONS-AREA))) +; (LET ((ERROR-MESSAGE-HOOK +; #'(LAMBDA () +; (DECLARE (SYS:DOWNWARD-FUNCTION)) +; (FORMAT T "~&While processing ~V,V\COMPILER:SHORT-S-FORMAT\" +; DBG:*ERROR-MESSAGE-PRINLEVEL* +; DBG:*ERROR-MESSAGE-PRINLENGTH* +; FORM)))) +; (SETQ FORM (FUNCALL *COMPILE-FUNCTION* ':MACRO-EXPAND FORM))) +; (WHEN (LISTP FORM) ;Ignore atoms at top-level +; (LET ((FUNCTION (FIRST FORM))) +; (SELECTQ FUNCTION +; ((QUOTE)) ;and quoted constants e.g. 'COMPILE +; ((PROGN) +; (DOLIST (FORM (CDR FORM)) +; (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO))) +; ((EVAL-WHEN) +; (SI:CHECK-EVAL-WHEN-TIMES (CADR FORM)) +; (LET ((COMPILE-P (OR (MEMQ 'COMPILE (CADR FORM)) +; (AND COMPILE-TIME-TOO (MEMQ 'EVAL (CADR FORM))))) +; (LOAD-P (OR (MEMQ 'LOAD (CADR FORM)) (MEMQ 'CL:LOAD (CADR FORM)))) +; (FORMS (CDDR FORM))) +; (COND (LOAD-P +; (DOLIST (FORM FORMS) +; (COMPILE-FROM-STREAM-1 FORM (AND COMPILE-P ':FORCE)))) +; (COMPILE-P +; (DOLIST (FORM FORMS) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM ':FORCE NIL)))))) +; ((DEFUN) +; (LET ((TEM (DEFUN-COMPATIBILITY (CDR FORM) :WARN-IF-OBSOLETE T))) +; (IF (EQ (CDR TEM) (CDR FORM)) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T) +; (COMPILE-FROM-STREAM-1 TEM COMPILE-TIME-TOO)))) +; ((MACRO) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T) T)) +; ((DECLARE) +; (DOLIST (FORM (CDR FORM)) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T) +; ;; (DECLARE (SPECIAL ... has load-time action as well. +; ;; All other DECLARE's do not. +; (MEMQ (CAR FORM) '(SPECIAL ZL:UNSPECIAL))))) +; ((COMPILER-LET) +; (COMPILER-LET-INTERNAL (CADR FORM) (CDDR FORM) +; #'COMPILE-FROM-STREAM-1 COMPILE-TIME-TOO)) +; ((SI:DEFINE-SPECIAL-FORM) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T)) +; ((MULTIPLE-DEFINITION) +; (DESTRUCTURING-BIND (NAME TYPE . BODY) (CDR FORM) +; (LET ((NAME-VALID (AND (NOT (NULL NAME)) +; (OR (SYMBOLP NAME) +; (AND (LISTP NAME) (NEQ (CAR NAME) 'QUOTE))))) +; (TYPE-VALID (AND (NOT (NULL TYPE)) (SYMBOLP TYPE)))) +; (UNLESS (AND NAME-VALID TYPE-VALID) +; (WARN "(~S ~S ~S ...) is invalid because~@ +; ~:[~S is not valid as a definition name~;~*~]~ +; ~:[~&~S is not valid as a definition type~;~*~]" +; 'MULTIPLE-DEFINITION NAME TYPE NAME-VALID NAME TYPE-VALID TYPE))) +; (LET* ((COMPILED-BODY NIL) +; (COMPILE-FUNCTION *COMPILE-FUNCTION*) +; (*COMPILE-FUNCTION* +; (LAMBDA (OPERATION &REST ARGS) +; (DECLARE (SYS:DOWNWARD-FUNCTION)) +; (SELECTQ OPERATION +; (:DUMP-FORM +; (PUSH (FUNCALL COMPILE-FUNCTION :OPTIMIZE-TOP-LEVEL-FORM +; (FIRST ARGS)) +; COMPILED-BODY)) +; (:INSTALL-DEFINITION +; (PUSH (FORM-FOR-DEFINE *COMPILER* (FIRST ARGS) (SECOND ARGS)) +; COMPILED-BODY)) +; (OTHERWISE (CL:APPLY COMPILE-FUNCTION OPERATION ARGS))))) +; (LOCAL-DECLARATIONS `((FUNCTION-PARENT ,NAME ,TYPE) +; ,@LOCAL-DECLARATIONS))) +; (DOLIST (FORM BODY) +; (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO)) +; (FUNCALL COMPILE-FUNCTION :DUMP-FORM +; `(LOAD-MULTIPLE-DEFINITION +; ',NAME ',TYPE ',(NREVERSE COMPILED-BODY) NIL))))) +; ((pcl::top-level-form) +; (destructuring-bind (name times . body) +; (cdr form) +; (si:check-eval-when-times times) +; (let ((compile-p (or (memq 'compile times) +; (and compile-time-too (memq 'eval times)))) +; (load-p (or (memq 'load times) +; (memq 'cl:load times))) +; (fspec `(pcl::top-level-form ,name))) +; (cond (load-p +; (compile-from-stream-1 +; `(progn (defun ,fspec () . ,body) +; (funcall (function ,fspec))) +; (and compile-p ':force))) +; (compile-p +; (dolist (b body) +; (funcall *compile-form-function* form ':force nil))))))) +; (OTHERWISE +; (LET ((TEM (AND (SYMBOLP FUNCTION) (GET FUNCTION 'TOP-LEVEL-FORM)))) +; (IF TEM +; (FUNCALL *COMPILE-FORM-FUNCTION* (FUNCALL TEM FORM) COMPILE-TIME-TOO T) +; (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T)))))))))) +; +; + + +dw:: +(defun symbol-flavor-or-cl-type (symbol) + (declare (values flavor defstruct-p deftype-fun typep-fun atomic-subtype-parent + non-atomic-deftype)) + (multiple-value-bind (result foundp) + (gethash symbol *flavor-or-cl-type-cache*) + (let ((frob + (if foundp result + (setf (gethash symbol *flavor-or-cl-type-cache*) + (or (get symbol 'flavor:flavor) + (let ((class (get symbol 'clos-internals::class-for-name))) + (when (and class + (not (typep class 'clos:built-in-class))) + class)) + (not (null (defstruct-type-p symbol))) + (let* ((deftype (get symbol 'deftype)) + (descriptor (symbol-presentation-type-descriptor symbol)) + (typep + (unless (and descriptor + (presentation-type-explicit-type-function + descriptor)) + ;; Don't override the one defined in the presentation-type. + (get symbol 'typep))) + (atomic-subtype-parent (find-atomic-subtype-parent symbol)) + (non-atomic-deftype + (when (and (not descriptor) deftype) + (not (member (first (type-arglist symbol)) + '(&rest &key &optional)))))) + (if (or typep (not (atom deftype)) + non-atomic-deftype + ;; deftype overrides atomic-subtype-parent. + (and (not deftype) atomic-subtype-parent)) + (list-in-area *handler-dynamic-area* + deftype typep atomic-subtype-parent + non-atomic-deftype) + deftype))))))) + (locally (declare (inline compiled-function-p)) + (etypecase frob + (array (values frob)) + (instance (values frob)) + (null (values nil)) + ((member t) (values nil t)) + (compiled-function (values nil nil frob)) + (lexical-closure (values nil nil frob)) + (list (destructuring-bind (deftype typep atomic-subtype-parent non-atomic-deftype) + frob + (values nil nil deftype typep atomic-subtype-parent non-atomic-deftype))) + (symbol (values nil nil nil nil frob))))))) + + diff --git a/pcl/impl/ti/ti-low.lisp b/pcl/impl/ti/ti-low.lisp new file mode 100644 index 0000000..95f5e84 --- /dev/null +++ b/pcl/impl/ti/ti-low.lisp @@ -0,0 +1,83 @@ +;;; -*- Mode:LISP; Package:(PCL (Lisp WALKER)); Base:10.; Syntax:Common-lisp; Patch-File: Yes -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the 3600 version of the file portable-low. +;;; + +(in-package 'pcl) + +(defmacro without-interrupts (&body body) + `(let ((outer-scheduling-state si:inhibit-scheduling-flag) + (si:inhibit-scheduling-flag t)) + (macrolet ((interrupts-on () + '(when (null outer-scheduling-state) + (setq si:inhibit-scheduling-flag nil))) + (interrupts-off () + '(setq si:inhibit-scheduling-flag t))) + ,.body))) + +(si:defsubst std-instance-p (x) + (si:typep-structure-or-flavor x 'std-instance)) + + ;; +;;;;;; printing-random-thing-internal + ;; +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (si:%pointer thing))) + +(eval-when (compile load eval) ;There seems to be some bug with + (setq si::inhibit-displacing-flag t)) ;macrolet'd macros or something. + ;This gets around it but its not + ;really the right fix. + +(defun function-arglist (f) + (sys::arglist f t)) + +(defun record-definition (type spec &rest ignore) + (if (eql type 'method) + (sys:record-source-file-name spec 'defun :no-query) + (sys:record-source-file-name spec type :no-query))) + +(ticl:defprop method method-function-spec-handler sys:function-spec-handler) +(defun method-function-spec-handler + (function function-spec &optional arg1 arg2) + (let ((symbol (second function-spec))) + (case function + (sys:validate-function-spec t) + (otherwise + (sys:function-spec-default-handler + function function-spec arg1 arg2))))) + +;;;Edited by Reed Hastings 13 Aug 87 16:59 +;;;Edited by Reed Hastings 2 Nov 87 22:58 +(defun set-function-name (function new-name) + (when (si:get-debug-info-struct function) + (setf (si:get-debug-info-field (si:get-debug-info-struct function) :name) + new-name)) + function) + + + diff --git a/pcl/impl/ti/ti-patches.lisp b/pcl/impl/ti/ti-patches.lisp new file mode 100644 index 0000000..c189861 --- /dev/null +++ b/pcl/impl/ti/ti-patches.lisp @@ -0,0 +1,105 @@ +;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; + +(in-package 'pcl) + +;;; +;;; This little bit of magic keeps the dumper from dumping the lexical +;;; definition of call-next-method when it dumps method functions that +;;; come from defmethod forms. +;;; +(proclaim '(notinline nil)) + +(eval-when (load) + (setf (get 'function 'si:type-predicate) 'functionp)) + +;; fix defsetf to deal with do-standard-defsetf + +#!C +; From file SETF.LISP#> KERNEL; VIRGO: +#8R SYSTEM#: +(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM")) + (SI:*LISP-MODE* :COMMON-LISP) + (*READTABLE* COMMON-LISP-READTABLE) + (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) + (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; SETF.#" + + +(defmacro defsetf (access-function arg1 &optional arg2 &environment env &body body) + "Define a SETF expander for ACCESS-FUNCTION. +DEFSETF has two forms: + +The simple form (DEFSETF access-function update-function [doc-string]) +can be used as follows: After (DEFSETF GETFROB PUTFROB), +\(SETF (GETFROB A 3) FOO) ==> (PUTFROB A 3 FOO). + +The complex form is like DEFMACRO: + +\(DEFSETF access-function access-lambda-list newvalue-lambda-list body...) + +except there are TWO lambda-lists. +The first one represents the argument forms to the ACCESS-FUNCTION. +Only &OPTIONAL and &REST are allowed here. +The second has only one argument, representing the value to be stored. +The body of the DEFSETF definition must then compute a +replacement for the SETF form, just as for any other macro. +When the body is executed, the args in the lambda-lists will not +really contain the value-expression or parts of the form to be set; +they will contain gensymmed variables which SETF may or may not +eliminate by substitution." + ;; REF and VAL are arguments to the expansion function + (if (null body) + `(defdecl ,access-function setf-method ,arg1) + (multiple-value-bind (body decls doc-string) + (parse-body body env t) + (let* ((access-ll arg1) + (value-names arg2) + (expansion + (let (all-arg-names) + (dolist (x access-ll) + (cond ((symbolp x) + (if (not (member x lambda-list-keywords :test #'eq)) + (push x all-arg-names) + (when (eq x '&rest) (return)))) ;;9/20/88 clm + (t ; it's a list after &optional + (push (car x) all-arg-names)))) + (setq all-arg-names (reverse all-arg-names)) + `(let ((tempvars (mapcar #'(lambda (ignore) (gensym)) ',all-arg-names)) + (storevar (gensym))) + (values tempvars (list . ,all-arg-names) (list storevar) + (let ((,(car value-names) storevar) + . ,(loop for arg in all-arg-names + for i = 0 then (1+ i) + collect `(,arg (nth ,i tempvars)))) + ,@decls . ,body) + `(,',access-function . ,tempvars)))))) + `(define-setf-method ,access-function ,arg1 + ,@doc-string ,expansion) + )))) +)) + + diff --git a/pcl/impl/vaxlisp/vaxl-low.lisp b/pcl/impl/vaxlisp/vaxl-low.lisp new file mode 100644 index 0000000..ae9383b --- /dev/null +++ b/pcl/impl/vaxlisp/vaxl-low.lisp @@ -0,0 +1,80 @@ +;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; The version of low for VAXLisp +;;; +(in-package 'pcl) + +(defmacro without-interrupts (&body body) + `(macrolet ((interrupts-on () + `(when (null outer-scheduling-state) + (setq system::*critical-section-p* nil) + (when (system::%sp-interrupt-queued-p) + (system::interrupt-dequeuer t)))) + (interrupts-off () + `(setq system::*critical-section-p* t))) + (let ((outer-scheduling-state system::*critical-section-p*)) + (prog1 (let ((system::*critical-section-p* t)) ,@body) + (when (and (null outer-scheduling-state) + (system::%sp-interrupt-queued-p)) + (system::interrupt-dequeuer t)))))) + + + ;; +;;;;;; Load Time Eval + ;; +(defmacro load-time-eval (form) + `(progn ,form)) + + ;; +;;;;;; Generating CACHE numbers + ;; +;;; How are symbols in VAXLisp actually arranged in memory? +;;; Should we be shifting the address? +;;; Are they relocated? +;;; etc. + +;(defmacro symbol-cache-no (symbol mask) +; `(logand (the fixnum (system::%sp-pointer->fixnum ,symbol)) ,mask)) + +(defmacro object-cache-no (object mask) + `(logand (the fixnum (system::%sp-pointer->fixnum ,object)) ,mask)) + + ;; +;;;;;; printing-random-thing-internal + ;; +(defun printing-random-thing-internal (thing stream) + (format stream "~O" (system::%sp-pointer->fixnum thing))) + + +(defun function-arglist (fn) + (system::function-lambda-vars (symbol-function fn))) + +(defun set-function-name-1 (fn name ignore) + (cond ((system::slisp-compiled-function-p fn) + (system::%sp-b-store fn 3 name))) + fn) + diff --git a/pcl/impl/xerox/pcl-env-internal.lisp b/pcl/impl/xerox/pcl-env-internal.lisp new file mode 100644 index 0000000..86b947b --- /dev/null +++ b/pcl/impl/xerox/pcl-env-internal.lisp @@ -0,0 +1,261 @@ +(DEFINE-FILE-INFO PACKAGE "XCL" READTABLE "XCL") +(il:filecreated "28-Aug-87 18:42:36" il:{phylum}pcl-env-internal.\;1 8356 + + il:|changes| il:|to:| (il:vars il:pcl-env-internalcoms) + (il:props (il:pcl-env-internal il:makefile-environment)) + (il:functions stack-eql stack-pointer-frame stack-frame-valid-p + stack-frame-fn-header stack-frame-pc fnheader-debugging-info + stack-frame-name compiled-closure-fnheader compiled-closure-env) +) + + +; Copyright (c) 1987 by Xerox Corporation. All rights reserved. + +(il:prettycomprint il:pcl-env-internalcoms) + +(il:rpaqq il:pcl-env-internalcoms ( + +(il:* il:|;;;| "***************************************") + + + +(il:* il:|;;;| " Copyright (c) 1987 Xerox Corporation. All rights reserved.") + + + +(il:* il:|;;;| "") + + + +(il:* il:|;;;| "Use and copying of this software and preparation of derivative works based upon this software are permitted. Any distribution of this software or derivative works must comply with all applicable United States export control laws.") + + + +(il:* il:|;;;| " ") + + + +(il:* il:|;;;| "This software is made available AS IS, and Xerox Corporation makes no warranty about the software, its performance or its conformity to any specification.") + + + +(il:* il:|;;;| " ") + + + +(il:* il:|;;;| "Any person obtaining a copy of this software is requested to send their name and post office or electronic mail address to:") + + + +(il:* il:|;;;| " CommonLoops Coordinator") + + + +(il:* il:|;;;| " Xerox Artifical Intelligence Systems") + + + +(il:* il:|;;;| " 2400 Hanover St.") + + + +(il:* il:|;;;| " Palo Alto, CA 94303") + + + +(il:* il:|;;;| "(or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)") + + + +(il:* il:|;;;| "") + + + +(il:* il:|;;;| " Suggestions, comments and requests for improvements are also welcome.") + + + +(il:* il:|;;;| " *************************************************************************") + + + +(il:* il:|;;;| "") + + (il:declare\: il:dontcopy (il:prop il:makefile-environment + il:pcl-env-internal)) + (il:* il:\; + "We're off to hack the system...") + + (il:declare\: il:eval@compile il:dontcopy (il:files pcl::abc) + + + (il:* il:|;;| "The Deltas and The East and The Freeze") +) + (il:functions stack-eql stack-pointer-frame stack-frame-valid-p + stack-frame-fn-header stack-frame-pc + fnheader-debugging-info stack-frame-name + compiled-closure-fnheader compiled-closure-env))) + + + +(il:* il:|;;;| "***************************************") + + + + +(il:* il:|;;;| " Copyright (c) 1987 Xerox Corporation. All rights reserved.") + + + + +(il:* il:|;;;| "") + + + + +(il:* il:|;;;| +"Use and copying of this software and preparation of derivative works based upon this software are permitted. Any distribution of this software or derivative works must comply with all applicable United States export control laws." +) + + + + +(il:* il:|;;;| " ") + + + + +(il:* il:|;;;| +"This software is made available AS IS, and Xerox Corporation makes no warranty about the software, its performance or its conformity to any specification." +) + + + + +(il:* il:|;;;| " ") + + + + +(il:* il:|;;;| +"Any person obtaining a copy of this software is requested to send their name and post office or electronic mail address to:" +) + + + + +(il:* il:|;;;| " CommonLoops Coordinator") + + + + +(il:* il:|;;;| " Xerox Artifical Intelligence Systems") + + + + +(il:* il:|;;;| " 2400 Hanover St.") + + + + +(il:* il:|;;;| " Palo Alto, CA 94303") + + + + +(il:* il:|;;;| "(or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)") + + + + +(il:* il:|;;;| "") + + + + +(il:* il:|;;;| " Suggestions, comments and requests for improvements are also welcome.") + + + + +(il:* il:|;;;| " *************************************************************************") + + + + +(il:* il:|;;;| "") + +(il:declare\: il:dontcopy + +(il:putprops il:pcl-env-internal il:makefile-environment (:package "XCL" :readtable "XCL")) +) + + + +(il:* il:\; "We're off to hack the system...") + +(il:declare\: il:eval@compile il:dontcopy +(il:filesload pcl::abc) +) + +(defun stack-eql (x y) "Test two stack pointers for equality" (and (il:stackp x) + (il:stackp y) + (eql (il:fetch (il:stackp il:edfxp + ) + il:of x) + (il:fetch (il:stackp il:edfxp + ) + il:of y)))) + + +(defun stack-pointer-frame (stack-pointer) (il:|fetch| (il:stackp il:edfxp) il:|of| stack-pointer)) + + +(defun stack-frame-valid-p (frame) (not (il:|fetch| (il:fx il:invalidp) il:|of| frame))) + + +(defun stack-frame-fn-header (frame) (il:|fetch| (il:fx il:fnheader) il:|of| frame)) + + +(defun stack-frame-pc (frame) (il:|fetch| (il:fx il:pc) il:|of| frame)) + + +(defun fnheader-debugging-info (fnheader) (let* ((start-pc (il:fetch (il:fnheader il:startpc) + il:of fnheader)) + (name-table-words + (let ((size (il:fetch (il:fnheader il:ntsize) + il:of fnheader))) + (if (zerop size) + il:wordsperquad + (* size 2)))) + (past-name-table-in-words (+ (il:fetch (il:fnheader + + il:overheadwords + ) + il:of fnheader) + name-table-words))) + (and (= (- start-pc (* il:bytesperword + past-name-table-in-words)) + il:bytespercell) + + (il:* il:|;;| "It's got a debugging-info list.") + + (il:\\getbaseptr fnheader + past-name-table-in-words)))) + + +(defun stack-frame-name (frame) (il:|fetch| (il:fx il:framename) il:|of| frame)) + + +(defun compiled-closure-fnheader (closure) (il:|fetch| (il:compiled-closure il:fnheader) il:|of| + closure)) + + +(defun compiled-closure-env (closure) (il:fetch (il:compiled-closure il:environment) il:of closure)) + +(il:putprops il:pcl-env-internal il:copyright ("Xerox Corporation" 1987)) +(il:declare\: il:dontcopy + (il:filemap (nil))) +il:stop + diff --git a/pcl/impl/xerox/pcl-env.lisp b/pcl/impl/xerox/pcl-env.lisp new file mode 100644 index 0000000..4cf7c26 --- /dev/null +++ b/pcl/impl/xerox/pcl-env.lisp @@ -0,0 +1,1629 @@ +;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.com) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; Xerox-Lisp specific environment hacking for PCL + +(in-package "PCL") + +;; +;; Protect the Corporation +;; +(eval-when (eval load) + (format *terminal-io* + "~&;PCL-ENV Copyright (c) 1987, 1988, 1989, by ~ + Xerox Corporation. All rights reserved.~%")) + + +;;; Make funcallable instances (FINs) print by calling print-object. + +(eval-when (eval load) + (il:defprint 'il:compiled-closure 'il:print-closure)) + +(defun il:print-closure (x &optional stream depth) + ;; See the IRM, section 25.3.3. Unfortunately, that documentation is + ;; not correct. In particular, it makes no mention of the third argument. + (cond ((not (funcallable-instance-p x)) + ;; IL:\CCLOSURE.DEFPRINT is the orginal system function for + ;; printing closures + (il:\\cclosure.defprint x stream)) + ((streamp stream) + ;; Use the standard PCL printing method, then return T to tell + ;; the printer that we have done the printing ourselves. + (print-object x stream) + t) + (t + ;; Internal printing (again, see the IRM section 25.3.3). + ;; Return a list containing the string of characters that + ;; would be printed, if the object were being printed for + ;; real. + (with-output-to-string (stream) + (list (print-object x stream)))))) + + +;;; Naming methods + +(defun gf-named (gf-name) + (let ((spec (cond ((symbolp gf-name) gf-name) + ((and (consp gf-name) + (eq (first gf-name) 'setf) + (symbolp (second gf-name)) + (null (cddr gf-name))) + (get-setf-function-name (second gf-name))) + (t nil)))) + (if (and (fboundp spec) + (generic-function-p (symbol-function spec))) + (symbol-function spec) + nil))) + +(defun generic-function-method-names (gf-name hasdefp) + (if hasdefp + (let ((names nil)) + (maphash #'(lambda (key value) + (declare (ignore value)) + (when (and (consp key) (eql (car key) gf-name)) + (pushnew key names))) + (gethash 'methods xcl:*definition-hash-table*)) + names) + (let ((gf (gf-named gf-name))) + (when gf + (mapcar #'full-method-name (generic-function-methods gf)))))) + +(defun full-method-name (method) + "Return the full name of the method" + (let ((specializers (mapcar #'(lambda (x) + (cond ((eq x 't) t) + ((consp x) x) + (t (class-name x)))) + (method-type-specifiers method)))) + ;; Now go through some hair to make sure that specializer is + ;; really right. Once PCL returns the right value for + ;; specializers this can be taken out. + (let* ((arglist (method-arglist method)) + (number-required (or (position-if + #'(lambda (x) (member x lambda-list-keywords)) + arglist) + (length arglist))) + (diff (- number-required (length specializers)))) + (when (> diff 0) + (setq specializers (nconc (copy-list specializers) + (make-list diff :initial-element 't))))) + (make-full-method-name (generic-function-name + (method-generic-function method)) + (method-qualifiers method) + specializers))) + +(defun make-full-method-name (generic-function-name qualifiers arg-types) + "Return the full name of a method, given the generic-function name, the method +qualifiers, and the arg-types" + ;; The name of the method is: + ;; ( .. + ;; (..)) + (labels ((remove-trailing-ts (l) + (if (null l) + nil + (let ((tail (remove-trailing-ts (cdr l)))) + (if (null tail) + (if (eq (car l) 't) + nil + (list (car l))) + (if (eq l tail) + l + (cons (car l) tail))))))) + `(,generic-function-name ,@qualifiers + ,(remove-trailing-ts arg-types)))) + +(defun parse-full-method-name (method-name) + "Parse the method name, returning the gf-name, the qualifiers, and the +arg-types." + (values (first method-name) + (butlast (rest method-name)) + (car (last method-name)))) + +(defun prompt-for-full-method-name (gf-name &optional has-def-p) + "Prompt the user for the full name of a method on the given generic function name" + (let ((method-names (generic-function-method-names gf-name has-def-p))) + (cond ((null method-names) + nil) + ((null (cdr method-names)) + (car method-names)) + (t (il:menu + (il:create + il:menu il:items il:_ ;If HAS-DEF-P, include only + ; those methods that have a + ; symbolic def'n that we can + ; find + (remove-if #'null + (mapcar #'(lambda (m) + (if (or (not has-def-p) + (il:hasdef m 'methods)) + `(,(with-output-to-string (s) + (dolist (x m) + (format s "~A " x)) + s) + ',m) + nil)) + method-names)) + il:title il:_ "Which method?")))))) + + +;;; Converting generic defining macros into DEFDEFINER macros + +(defmacro make-defdefiner (definer-name definer-type type-description &body + definer-options) + "Make the DEFINER-NAME use DEFDEFINER, defining items of type DEFINER-TYPE" + (let ((old-definer-macro-name (intern (string-append definer-name + " old definition") + (symbol-package definer-name))) + (old-definer-macro-expander (intern (string-append definer-name + " old expander") + (symbol-package definer-name)))) + `(progn + ;; First, move the current defining function off to some safe + ;; place + (unmake-defdefiner ',definer-name) + (cond ((not (fboundp ',definer-name)) + (error "~A has no definition!" ',definer-name)) + ((fboundp ',old-definer-macro-name)) + ((macro-function ',definer-name) + ; We have to move the macro + ; expansion function as well, + ; so it won't get clobbered + ; when the original macro is + ; redefined. See AR 7410. + (let* ((expansion-function (macro-function ',definer-name))) + (setf (symbol-function ',old-definer-macro-expander) + (loop (if (symbolp expansion-function) + (setq expansion-function + (symbol-function expansion-function)) + (return expansion-function)))) + (setf (macro-function ',old-definer-macro-name) + ',old-definer-macro-expander) + (setf (get ',definer-name 'make-defdefiner) expansion-function))) + (t (error "~A does not name a macro." ',definer-name))) + ;; Make sure the type is defined + (xcl:def-define-type ,definer-type ,type-description) + ;; Now redefine the definer, using DEFEDFINER and the original def'n + (xcl:defdefiner ,(if definer-options + (cons definer-name definer-options) + definer-name) + ,definer-type (&body b) `(,',old-definer-macro-name ,@,'b))))) + +(defun unmake-defdefiner (definer-name) + (let ((old-expander (get definer-name 'make-defdefiner))) + (when old-expander + (setf (macro-function definer-name old-expander)) + (remprop definer-name 'make-defdefiner)))) + + +;;; For tricking ED into being able to use just the generic-function-name +;;; instead of the full method name + +(defun source-manager-method-edit-fn (name type source editcoms options) + "Edit a method of the given name" + (let ((full-name (if (gf-named name) + ;If given the name of a + ; generic-function, try to get + ; the full method name + (prompt-for-full-method-name name t) + ; Otherwise it should name the + ; method + name))) + (when (not (null full-name)) + (il:default.editdef full-name type source editcoms options)) + (or full-name name))) ;Return the name + +(defun source-manager-method-hasdef-fn (name type &optional source) + "Is there a method defined with the given name?" + (cond ((not (eq type 'methods)) nil) + ((or (symbolp name) + (and (consp name) + (eq (first name) 'setf) + (symbolp (second name)) + (null (cddr name)))) + ;; If passed in the name of a generic-function, pretend that + ;; there is a method by that name if there is a generic function + ;; by that name, and there is a method whose source we can find. + (if (and (not (null (gf-named name))) + (find-if #'(lambda (m) + (il:hasdef m type source)) + (generic-function-method-names name t))) + name + nil)) + ((and (consp name) (>= (length name) 2)) + ;; Standard methods are named (gf-name {qualifiers}* ({specializers}*)) + (when (il:getdef name type source '(il:nocopy il:noerror)) + name)) + (t + ;; Nothing else can name a method + nil))) + +;;; Initialize the PCL env + +(defun initialize-pcl-env nil + "Initialize the Xerox PCL environment" + ;; Set up SourceManager DEFDEFINERS for classes and methods. + ;; + ;; Make sure to define methods before classes, so that (IL:FILES?) will build + ;; filecoms that have classes before methods. + (unless (il:hasdef 'methods 'il:filepkgtype) + (make-defdefiner defmethod methods "methods" + (:name (lambda (form) + (multiple-value-bind (name qualifiers arglist) + (parse-defmethod (cdr form)) + (make-full-method-name name qualifiers + (extract-specializer-names + arglist))))) + (:undefiner + (lambda (method-name) + (multiple-value-bind + (name qualifiers arg-types) + (parse-full-method-name method-name) + (let* ((gf (gf-named name)) + (method (when gf + (get-method gf qualifiers + (mapcar #'find-class + arg-types))))) + (when method (remove-method gf method)))))))) + ;; Include support for DEFGENERIC, if that is defined + (unless (or (not (fboundp 'defgeneric)) + (il:hasdef 'generic-functions 'il:filepkgtype)) + (make-defdefiner defgeneric generic-functions "generic-function definitions")) + ;; DEFCLASS FileManager stuff + (unless (il:hasdef 'classes 'il:filepkgtype) + (make-defdefiner defclass classes "class definitions" + (:undefiner (lambda (name) + (when (find-class name t) + (setf (find-class name) nil))))) + ;; CLASSES "include" TYPES. + (il:filepkgcom 'classes 'il:contents + #'(lambda (com name type &optional reason) + (declare (ignore name reason)) + (if (member type '(il:types classes) :test #'eq) + (cdr com) + nil)))) + ;; Set up the hooks so that ED can be handed the name of a generic function, + ;; and end up editing a method instead + (il:filepkgtype 'methods 'il:editdef 'source-manager-method-edit-fn + 'il:hasdef 'source-manager-method-hasdef-fn) + ;; Set up the inspect macro. The right way to do this is to + ;; (ENSURE-GENERIC-FUNCTION 'IL:INSPECT...), but for now... + (push '((il:function pcl-object-p) . \\internal-inspect-object) + il:inspectmacros) + ;; Unmark any SourceManager changes caused by this loadup + (dolist (com (il:filepkgchanges)) + (dolist (name (cdr com)) + (when (and (symbolp name) + (eq (symbol-package name) (find-package "PCL"))) + (il:unmarkaschanged name (car com)))))) + +(eval-when (eval load) + (initialize-pcl-env)) + + +;;; Inspecting PCL objects + +(defun pcl-object-p (x) + "Is the datum a PCL object?" + (or (std-instance-p x) + (fsc-instance-p x))) + +(defun \\internal-inspect-object (x type where) + (inspect-object x type where)) + +(defun \\internal-inspect-slot-names (x) + (inspect-slot-names x)) + +(defun \\internal-inspect-slot-value (x slot-name) + (inspect-slot-value x slot-name)) + +(defun \\internal-inspect-setf-slot-value (x slot-name value) + (inspect-setf-slot-value x slot-name value)) + +(defun \\internal-inspect-slot-name-command (slot-name x window) + (inspect-slot-name-command slot-name x window)) + +(defun \\internal-inspect-title (x y) + (inspect-title x y)) + +(defmethod inspect-object (x type where) + "Open an insect window on the object x" + (il:inspectw.create x '\\internal-inspect-slot-names + '\\internal-inspect-slot-value + '\\internal-inspect-setf-slot-value + '\\internal-inspect-slot-name-command nil nil + '\\internal-inspect-title nil where + #'(lambda (n v) ;Same effect as NIL, but avoids bug in + (declare (ignore v)) ; INSPECTW.CREATE + n))) + +(defmethod inspect-slot-names (x) + "Return a list of names of slots of the object that should be shown in the +inspector" + (mapcar #'(lambda (slotd) (slot-value slotd 'name)) + (slots-to-inspect (class-of x) x))) + +(defmethod inspect-slot-value (x slot-name) + (cond ((not (slot-exists-p x slot-name)) "** no such slot **") + ((not (slot-boundp x slot-name)) "** slot not bound **") + (t (slot-value x slot-name)))) + +(defmethod inspect-setf-slot-value (x slot-name value) + "Used by the inspector to set the value fo a slot" + ;; Make this UNDO-able + (il:undosave `(inspect-setf-slot-value ,x ,slot-name + ,(slot-value x slot-name))) + ;; Then change the value + (setf (slot-value x slot-name) value)) + +(defmethod inspect-slot-name-command (slot-name x window) + "Allows the user to select a menu item to change a slot value in an inspect +window" + ;; This code is a very slightly hacked version of the system function + ;; DEFAULT.INSPECTW.PROPCOMMANDFN. We have to do this because the + ;; standard version makes some nasty assumptions about + ;; structure-objects that are not true for PCL objects. + (declare (special il:|SetPropertyMenu|)) + (case (il:menu (cond ((typep il:|SetPropertyMenu| 'il:menu) + il:|SetPropertyMenu|) + (t (il:setq il:|SetPropertyMenu| + (il:|create| il:menu il:items il:_ + '((set 'set + "Allows a new value to be entered" + ))))))) + (set + ;; The user want to set the value + (il:ersetq (prog ((il:oldvalueitem (il:itemofpropertyvalue slot-name + window)) + il:newvalue il:pwindow) + (il:ttydisplaystream (il:setq il:pwindow + (il:getpromptwindow window 3))) + (il:clearbuf t t) + (il:resetlst + (il:resetsave (il:\\itemw.flipitem il:oldvalueitem window) + (list 'il:\\itemw.flipitem + il:oldvalueitem window)) + (il:resetsave (il:tty.process (il:this.process))) + (il:resetsave (il:printlevel 4 3)) + (il:|printout| t "Enter the new " + slot-name " for " x t + "The expression read will be EVALuated." + t "> ") + (il:setq il:newvalue (il:lispx (il:lispxread t t) + '>)) + ; clear tty buffer because it + ; sometimes has stuff left. + (il:clearbuf t t)) + (il:closew il:pwindow) + (return (il:inspectw.replace window slot-name il:newvalue))))))) + +(defmethod inspect-title (x window) + "Return the title to use in an inspect window viewing x" + (format nil "Inspecting a ~A" (class-name (class-of x)))) + +(defmethod inspect-title ((x standard-class) window) + (format nil "Inspecting the class ~A" (class-name x))) + + +;;; Debugger support for PCL + + +(il:filesload pcl-env-internal) + +;; Non-PCL specific changes to the debugger + +;; Redefining the standard INTERESTING-FRAME-P function. Now functions can be +;; declared uninteresting to BT by giving them an XCL::UNINTERESTINGP +;; property. + +(dolist (fn '(si::*unwind-protect* il:*env* + evalhook xcl::nohook xcl::undohook + xcl::execa0001 xcl::execa0001a0002 + xcl::|interpret-UNDOABLY| + cl::|interpret-IF| cl::|interpret-FLET| + cl::|interpret-LET| cl::|interpret-LETA0001| + cl::|interpret-BLOCK| cl::|interpret-BLOCKA0001| + il:do-event il:eval-input + apply t)) + (setf (get fn 'xcl::uninterestingp) t)) + +(defun xcl::interesting-frame-p (xcl::pos &optional xcl::interpflg) + "Return TRUE iff the frame should be visible for a short backtrace." + (declare (special il:openfns)) + (let ((xcl::name (if (il:stackp xcl::pos) (il:stkname xcl::pos) xcl::pos))) + (typecase xcl::name + (symbol (case xcl::name + (il:*env* + ;; *ENV* is used by ENVEVAL etc. + nil) + (il:errorset + (or (<= (il:stknargs xcl::pos) 1) + (not (eq (il:stkarg 2 xcl::pos nil) + 'il:internal)))) + (il:eval + (or (<= (il:stknargs xcl::pos) 1) + (not (eq (il:stkarg 2 xcl::pos nil) + 'xcl::internal)))) + (il:apply + (or (<= (il:stknargs xcl::pos) 2) + (not (il:stkarg 3 xcl::pos nil)))) + (otherwise + (cond ((get xcl::name 'xcl::uninterestingp) + ;; Explicitly declared uninteresting. + nil) + ((eq (il:chcon1 xcl::name) (char-code #\\)) + ;; Implicitly declared uninteresting by starting the + ;; name with a "\". + nil) + ((or (member xcl::name il:openfns :test #'eq) + (eq xcl::name 'funcall)) + ;;The function won't be seen when compiled, so only show + ;;it if INTERPFLG it true + xcl::interpflg) + (t + ;; Interesting by default. + t))))) + (cons (case (car xcl::name) + (:broken t) + (otherwise nil))) + (otherwise nil)))) + +(setq il:*short-backtrace-filter* 'xcl::interesting-frame-p) + + +(eval-when (eval compile) + (il:record il:bkmenuitem (il:label (il:bkmenuinfo il:frame-name)))) + + +;; Change the frame inspector to open up lexical environments + + ;; Since the DEFSTRUCT is going to build the accessors in the package that is + ;; current at read-time, and we want the accessors to reside in the IL + ;; package, we have got to make sure that the defstruct happens when the + ;; package is IL. + +(in-package "IL") + +(cl:defstruct (frame-prop-name (:type cl:list)) + (label-fn 'nill) + (value-fn + (function + (lambda (prop-name framespec) + (frame-prop-name-data prop-name)))) + (setf-fn 'nill) + (inspect-fn + (function + (lambda (value prop-name framespec window) + (default.inspectw.valuecommandfn value prop-name (car framespec) window)))) + (data nil)) + +(cl:in-package "PCL") + +(defun il:debugger-stack-frame-prop-names (il:framespec) + ;; Frame prop-names are structures of the form + ;; (LABEL-FN VALUE-FN SETF-FN EDIT-FN DATA) + (let ((il:pos (car il:framespec)) + (il:backtrace-item (cadr il:framespec))) + (il:if (eq 'eval (il:stkname il:pos)) + il:then + (let ((il:expression (il:stkarg 1 il:pos)) + (il:environment (il:stkarg 2 il:pos))) + `(,(il:make-frame-prop-name :inspect-fn + (il:function + (il:lambda (il:value il:prop-name il:framespec il:window) + (il:inspect/as/function il:value (car il:framespec) il:window))) + :data il:expression) + ,(il:make-frame-prop-name :data "ENVIRONMENT") + ,@(il:for il:aspect il:in + `((,(and il:environment (il:environment-vars il:environment)) + "vars") + (,(and il:environment (il:environment-functions il:environment)) + "functions") + (,(and il:environment (il:environment-blocks il:environment)) + "blocks") + (,(and il:environment (il:environment-tagbodies il:environment)) + "tag bodies")) + il:bind il:group-name il:p-list + il:eachtime (il:setq il:group-name (cadr il:aspect)) + (il:setq il:p-list (car il:aspect)) + il:when (not (null il:p-list)) + il:join + `(,(il:make-frame-prop-name :data il:group-name) + ,@(il:for il:p il:on il:p-list il:by cddr il:collect + (il:make-frame-prop-name :label-fn + (il:function (il:lambda (il:prop-name il:framespec) + (car (il:frame-prop-name-data il:prop-name)))) + :value-fn + (il:function (il:lambda (il:prop-name il:framespec) + (cadr (il:frame-prop-name-data il:prop-name)))) + :setf-fn + (il:function (il:lambda (il:prop-name il:framespec il:new-value) + (il:change (cadr (il:frame-prop-name-data + il:prop-name)) + il:new-value))) + :data il:p)))))) + il:else + (flet ((il:build-name (&key il:arg-name il:arg-number) + (il:make-frame-prop-name :label-fn + (il:function (il:lambda (il:prop-name il:framespec) + (car (il:frame-prop-name-data il:prop-name)))) + :value-fn + (il:function (il:lambda (il:prop-name il:framespec) + (il:stkarg (cadr (il:frame-prop-name-data + il:prop-name)) + (car il:framespec)))) + :setf-fn + (il:function (il:lambda (il:prop-name il:framespec il:new-value) + (il:setstkarg (cadr (il:frame-prop-name-data + il:prop-name)) + (car il:framespec) + il:new-value))) + :data + (list il:arg-name il:arg-number)))) + (let ((il:nargs (il:stknargs il:pos t)) + (il:nargs1 (il:stknargs il:pos)) + (il:fnname (il:stkname il:pos)) + il:argname + (il:arglist)) + (and (il:litatom il:fnname) + (il:ccodep il:fnname) + (il:setq il:arglist (il:listp (il:smartarglist il:fnname)))) + `(,(il:make-frame-prop-name :inspect-fn + (il:function (il:lambda (il:value il:prop-name il:framespec + il:window) + (il:inspect/as/function il:value + (car il:framespec) + il:window))) + :data + (il:fetch (il:bkmenuitem il:frame-name) il:of il:backtrace-item)) + ,@(il:bind il:mode il:for il:i il:from 1 il:to il:nargs1 il:collect + (progn (il:while (il:fmemb (il:setq il:argname (il:pop il:arglist)) + lambda-list-keywords) + il:do + (il:setq il:mode il:argname)) + (il:build-name :arg-name + (or (il:stkargname il:i il:pos) + ; special + (if (case il:mode + ((nil &optional) il:argname) + (t nil)) + (string il:argname) + (il:concat "arg " (- il:i 1)))) + :arg-number il:i))) + ,@(let* ((il:novalue "No value") + (il:slots (il:for il:pvar il:from 0 il:as il:i il:from + (il:add1 il:nargs1) + il:to il:nargs il:by 1 il:when + (and (il:neq il:novalue (il:stkarg il:i il:pos + il:novalue)) + (or (il:setq il:argname (il:stkargname + il:i il:pos)) + (il:setq il:argname (il:concat + "local " + il:pvar))) + ) + il:collect + (il:build-name :arg-name il:argname + :arg-number il:i)))) + (and il:slots (cons (il:make-frame-prop-name :data "locals") + il:slots))))))))) + +(defun il:debugger-stack-frame-fetchfn (il:framespec il:prop-name) + (il:apply* (il:frame-prop-name-value-fn il:prop-name) + il:prop-name il:framespec)) + +(defun il:debugger-stack-frame-storefn (il:framespec il:prop-name il:newvalue) + (il:apply* (il:frame-prop-name-setf-fn il:prop-name) + il:prop-name il:framespec il:newvalue)) + +(defun il:debugger-stack-frame-value-command (il:datum il:prop-name + il:framespec il:window) + (il:apply* (il:frame-prop-name-inspect-fn il:prop-name) + il:datum il:prop-name il:framespec il:window)) + +(defun il:debugger-stack-frame-title (il:framespec &optional il:window) + (declare (ignore il:window)) + (il:concat (il:stkname (car il:framespec)) " Frame")) + +(defun il:debugger-stack-frame-property (il:prop-name il:framespec) + (il:apply* (il:frame-prop-name-label-fn il:prop-name) + il:prop-name il:framespec)) + +;; Teaching the debugger that there are other file-manager types that can +;; appear on the stack + +(defvar xcl::*function-types* '(il:fns il:functions) + "Manager types that can appear on the stack") + +;; Redefine a couple of system functions to use the above stuff + +#+Xerox-Lyric +(progn + +(defun il:attach-backtrace-menu (&optional (il:ttywindow + (il:wfromds (il:ttydisplaystream))) + il:skip) + (let ((il:bkmenu (il:|create| il:menu + il:items il:_ + (il:collect-backtrace-items il:ttywindow il:skip) + il:whenselectedfn il:_ + (il:function il:backtrace-item-selected) + il:whenheldfn il:_ + #'(il:lambda (il:item il:menu il:button) + (declare (ignore il:item il:menu)) + (case il:button + (il:left (il:promptprint + "Open a frame inspector on this stack frame" + )) + (il:middle (il:promptprint + "Inspect/Edit this function")) + )) + il:menuoutlinesize il:_ 0 + il:menufont il:_ il:backtracefont + il:menucolumns il:_ 1)) + (il:ttyregion (il:windowprop il:ttywindow 'il:region)) + il:btw) + (cond + ((il:setq il:btw (il:|for| il:atw il:|in| (il:attachedwindows il:ttywindow) + il:|when| (and (il:setq il:btw (il:windowprop il:atw 'il:menu)) + (eql (il:|fetch| (il:menu il:whenselectedfn) + il:|of| (car il:btw)) + (il:function il:backtrace-item-selected))) + il:|do| + (return il:atw))) + (il:deletemenu (car (il:windowprop il:btw 'il:menu)) + nil il:btw) + (il:windowprop il:btw 'il:extent nil) + (il:clearw il:btw)) + ((il:setq il:btw (il:createw (il:region-next-to (il:windowprop il:ttywindow 'il:region) + (il:widthifwindow (il:imin (il:|fetch| (il:menu + il:imagewidth + ) + il:|of| il:bkmenu) + il:|MaxBkMenuWidth|)) + (il:|fetch| (il:region il:height) il:|of| il:ttyregion + ) + 'il:left))) + (il:attachwindow il:btw il:ttywindow (cond + ((il:igreaterp (il:|fetch| (il:region il:left) + il:|of| (il:windowprop + il:btw + 'il:region)) + (il:|fetch| (il:region il:left) + il:|of| il:ttyregion)) + 'il:right) + (t 'il:left)) + nil + 'il:localclose) + (il:windowprop il:btw 'il:process (il:windowprop il:ttywindow 'il:process)) + + )) + (il:addmenu il:bkmenu il:btw (il:|create| il:_ il:position + il:xcoord il:_ 0 + il:ycoord il:_ (il:idifference (il:windowprop + il:btw + 'il:height) + (il:|fetch| (il:menu il:imageheight + ) il:|of| + il:bkmenu + )))))) + +(defun il:backtrace-item-selected (il:item il:menu il:button) + (il:resetlst + (prog (il:olditem il:ttywindow il:bkpos il:pos il:positions il:framewindow + (il:framespecn (il:|fetch| (il:bkmenuitem il:bkmenuinfo) il:|of| il:item) + + )) + (cond + ((il:setq il:olditem (il:|fetch| (il:menu il:menuuserdata) il:|of| il:menu)) + (il:menudeselect il:olditem il:menu) + )) + (il:setq il:ttywindow (il:windowprop (il:wfrommenu il:menu) + 'il:mainwindow)) + (il:setq il:bkpos (il:windowprop il:ttywindow 'il:stack-position)) + (il:setq il:pos (il:stknth (- il:framespecn) + il:bkpos)) + (let ((il:lp (il:windowprop il:ttywindow 'il:lastpos))) + (and il:lp (il:stknth 0 il:pos il:lp))) + (il:menuselect il:item il:menu) + (if (eq il:button 'il:middle) + (progn + + + (il:resetsave nil (list 'il:relstk il:pos)) + (il:inspect/as/function (il:|fetch| (il:bkmenuitem il:frame-name) + il:|of| il:item) + il:pos il:ttywindow)) + (progn + + + (il:setq il:framewindow + (xcl:with-profile (il:process.eval + (il:windowprop il:ttywindow 'il:process) + '(let ((il:profile (xcl:copy-profile (xcl:find-profile + "READ-PRINT")))) + (setf (xcl::profile-entry-value ' + xcl:*eval-function* il:profile) + xcl:*eval-function*) + (xcl:save-profile il:profile)) + t) + (il:inspectw.create (list il:pos il:item) + 'il:debugger-stack-frame-prop-names + 'il:debugger-stack-frame-fetchfn + 'il:debugger-stack-frame-storefn nil ' + il:debugger-stack-frame-value-command nil ' + il:debugger-stack-frame-title nil ( + il:make-frame-inspect-window + il:ttywindow) + 'il:debugger-stack-frame-property))) + (cond + ((not (il:windowprop il:framewindow 'il:mainwindow)) + (il:attachwindow il:framewindow il:ttywindow + (cond + ((il:igreaterp (il:|fetch| (il:region il:bottom) + il:|of| (il:windowprop il:framewindow + 'il:region)) + (il:|fetch| (il:region il:bottom) + il:|of| (il:windowprop il:ttywindow 'il:region))) + 'il:top) + (t 'il:bottom)) + nil + 'il:localclose) + (il:windowaddprop il:framewindow 'il:closefn (il:function il:detachwindow + )))))) + (return)))) + +(defun il:collect-backtrace-items (xcl::tty-window xcl::skip) + (let* ((xcl::items (cons nil nil)) + (xcl::items-tail xcl::items)) + (macrolet ((xcl::collect-item (xcl::new-item) + `(progn (setf (rest xcl::items-tail) + (cons ,xcl::new-item nil)) + (pop xcl::items-tail)))) + (let* ((xcl::filter-fn (cond + ((null xcl::skip) + #'xcl:true) + ((eq xcl::skip t) + il:*short-backtrace-filter*) + (t xcl::skip))) + (xcl::top-frame (il:stknth 0 (il:getwindowprop xcl::tty-window ' + il:stack-position))) + (xcl::next-frame xcl::top-frame) + (xcl::frame-number 0) + xcl::interesting-p xcl::last-frame-consumed xcl::use-frame xcl::label) + (loop (when (null xcl::next-frame) + (return)) + (multiple-value-setq (xcl::interesting-p xcl::last-frame-consumed + xcl::use-frame xcl::label) + (funcall xcl::filter-fn xcl::next-frame)) + (when (null xcl::last-frame-consumed) + + (setf xcl::last-frame-consumed xcl::next-frame)) + (when xcl::interesting-p + (when (null xcl::use-frame) + (setf xcl::use-frame xcl::last-frame-consumed)) + + (when (null xcl::label) + (setf xcl::label (il:stkname xcl::use-frame)) + (if (member xcl::label '(eval il:eval il:apply apply) + :test + 'eq) + (setf xcl::label (il:stkarg 1 xcl::use-frame)))) + + (loop (cond + ((not (typep xcl::next-frame 'il:stackp)) + (error "~%Use-frame ~S not found" xcl::use-frame)) + ((xcl::stack-eql xcl::next-frame xcl::use-frame) + (return)) + (t (incf xcl::frame-number) + (setf xcl::next-frame (il:stknth -1 xcl::next-frame + xcl::next-frame))))) + + (xcl::collect-item (il:|create| il:bkmenuitem + il:label il:_ (let ((*print-level* 2) + (*print-length* 3) + (*print-escape* t) + (*print-gensym* t) + (*print-pretty* nil) + (*print-circle* nil) + (*print-radix* 10) + (*print-array* nil) + (il:*print-structure* + nil)) + (prin1-to-string + xcl::label)) + il:bkmenuinfo il:_ xcl::frame-number + il:frame-name il:_ xcl::label))) + + (loop (cond + ((not (typep xcl::next-frame 'il:stackp)) + (error "~%Last-frame-consumed ~S not found" + xcl::last-frame-consumed)) + ((prog1 (xcl::stack-eql xcl::next-frame xcl::last-frame-consumed + ) + (incf xcl::frame-number) + (setf xcl::next-frame (il:stknth -1 xcl::next-frame + + xcl::next-frame))) + (return))))))) + (rest xcl::items))) + +) +#+Xerox-Medley +(progn + +(defun dbg::attach-backtrace-menu (&optional tty-window skip) + (declare (special il:\\term.ofd il:backtracefont)) + (or tty-window (il:setq tty-window (il:wfromds (il:ttydisplaystream)))) + (prog (btw bkmenu + (tty-region (il:windowprop tty-window 'il:region)) + ;; And, for the FORMAT below... + (*print-level* 2) + (*print-length* 3) + (*print-escape* t) + (*print-gensym* t) + (*print-pretty* nil) + (*print-circle* nil) + (*print-radix* 10) + (*print-array* nil) + (il:*print-structure* nil)) + (setq bkmenu + (il:|create| il:menu + il:items il:_ (dbg::collect-backtrace-items tty-window skip) + il:whenselectedfn il:_ 'dbg::backtrace-item-selected + il:menuoutlinesize il:_ 0 + il:menufont il:_ il:backtracefont + il:menucolumns il:_ 1 + il:whenheldfn il:_ + #'(il:lambda (item menu button) + (declare (ignore item menu)) + (case button + (il:left + (il:promptprint + "Open a frame inspector on this stack frame")) + (il:middle + (il:promptprint "Inspect/Edit this function")))))) + (cond ((setq btw + (dolist (atw (il:attachedwindows tty-window)) + ;; Test for an attached window that has a backtrace menu in + ;; it. + (when (and (setq btw (il:windowprop atw 'il:menu)) + (eq (il:|fetch| (il:menu il:whenselectedfn) + il:|of| (car btw)) + 'dbg::backtrace-item-selected)) + (return atw)))) + ;; If there is alread a backtrace window, delete the old menu from + ;; it. + (il:deletemenu (car (il:windowprop btw 'il:menu)) nil btw) + (il:windowprop btw 'il:extent nil) + (il:clearw btw)) + ((setq btw + (il:createw (dbg::region-next-to + (il:windowprop tty-window 'il:region) + (il:widthifwindow + (il:imin (il:|fetch| (il:menu il:imagewidth) + il:|of| bkmenu) + il:|MaxBkMenuWidth|)) + (il:|fetch| (il:region il:height) + il:|of| tty-region) + :left))) + ; put bt window at left of TTY + ; window unless ttywindow is + ; near left edge. + (il:attachwindow btw tty-window + (if (il:igreaterp (il:|fetch| (il:region il:left) + il:|of| + (il:windowprop btw + 'il:region)) + (il:|fetch| (il:region il:left) + il:|of| tty-region)) + 'il:right + 'il:left) + nil + 'il:localclose) + ;; So that button clicks will switch the TTY + (il:windowprop btw 'il:process + (il:windowprop tty-window 'il:process)))) + (il:addmenu bkmenu btw (il:|create| il:position + il:xcoord il:_ 0 + il:ycoord il:_ (- (il:windowprop btw 'il:height) + (il:|fetch| (il:menu + il:imageheight) + il:|of| bkmenu)))) + ;; IL:ADDMENU sets up buttoneventfn for window that we don't + ;; want. We want to catch middle button events before the menu + ;; handler, so that we can pop up edit/inspect menu for the frame + ;; currently selected. So replace the buttoneventfn, and can + ;; nuke the cursorin and cursormoved guys, cause don't need them. + (il:windowprop btw 'il:buttoneventfn 'dbg::backtrace-menu-buttoneventfn) + (il:windowprop btw 'il:cursorinfn nil) + (il:windowprop btw 'il:cursormovedfn nil))) + +(defun dbg::collect-backtrace-items (tty-window skip) + (xcl:with-collection + ;; + ;; There are a number of possibilities for the values returned by the + ;; filter-fn. + ;; + ;; (1) INTERESTING-P is false, and the other values are all NIL. This + ;; is the simple case where the stack frame NEXT-POS should be ignored + ;; completly, and processing should continue with the next frame. + ;; + ;; (2) INTERESTING-P is true, and the other values are all NIL. This + ;; is the simple case where the stack frame NEXT-POS should appear in + ;; the backtrace as is, and processing should continue with the next + ;; frame. + ;; + ;; [Note that these two cases take care of old values of the + ;; filter-fn.] + ;; + ;; (3) INTERESTING-P is false, and LAST-FRAME-CONSUMED is a stack + ;; frame. In that case, ignore all stack frames from NEXT-POS to + ;; LAST-FRAME-CONSUMED, inclusive. + ;; + ;; (4) INTERESTING-P is true, and LAST-FRAME-CONSUMED is a stack + ;; frame. In this case, the backtrace should include a single entry + ;; coresponding to the frame USE-FRAME (which defaults to + ;; LAST-FRAME-CONSUMED), and processing should continue with the next + ;; frame after LAST-FRAME-CONSUMED. If LABEL is non-NIL, it will be + ;; the label that appears in the backtrace menu; otherwise the name of + ;; USE-FRAME will be used (or the form being EVALed if the frame is an + ;; EVAL frame). + ;; + (let* ((filter (cond ((null skip) #'xcl:true) + ((eq skip t) il:*short-backtrace-filter*) + (t skip))) + (top-frame (il:stknth 0 (il:getwindowprop tty-window + 'dbg::stack-position))) + (next-frame top-frame) + (frame-number 0) + interestingp last-frame-consumed frame-to-use label-to-use) + (loop (when (null next-frame) (return)) + ;; Get the values of INTERSTINGP, LAST-FRAME-CONSUMED, + ;; FRAME-TO-USE, and LABEL-TO-USE + (multiple-value-setq (interestingp last-frame-consumed + frame-to-use label-to-use) + (funcall filter next-frame)) + (when (null last-frame-consumed) + (setf last-frame-consumed next-frame)) + (when interestingp + (when (null frame-to-use) + (setf frame-to-use last-frame-consumed)) + (when (null label-to-use) + (setf label-to-use (il:stkname frame-to-use)) + (if (member label-to-use '(eval il:eval il:apply apply) + :test 'eq) + (setf label-to-use (il:stkarg 1 frame-to-use)))) + + ;; Walk the stack until we find the frame to use + (loop (cond ((not (typep next-frame 'il:stackp)) + (error "~%Use-frame ~S not found" frame-to-use)) + ((xcl::stack-eql next-frame frame-to-use) + (return)) + (t (incf frame-number) + (setf next-frame + (il:stknth -1 next-frame next-frame))))) + + ;; Add the menu item to the list under construction + (xcl:collect (il:|create| il:bkmenuitem + il:label il:_ (let ((*print-level* 2) + (*print-length* 3) + (*print-escape* t) + (*print-gensym* t) + (*print-pretty* nil) + (*print-circle* nil) + (*print-radix* 10) + (*print-array* nil) + (il:*print-structure* nil)) + (prin1-to-string label-to-use)) + il:bkmenuinfo il:_ frame-number + il:frame-name il:_ label-to-use))) + + ;; Update NEXT-POS + (loop (cond ((not (typep next-frame 'il:stackp)) + (error "~%Last-frame-consumed ~S not found" + last-frame-consumed)) + ((prog1 + (xcl::stack-eql next-frame last-frame-consumed) + (incf frame-number) + (setf next-frame (il:stknth -1 next-frame + next-frame))) + (return)))))))) + +(defun dbg::backtrace-menu-buttoneventfn (window &aux menu) + (setq menu (car (il:listp (il:windowprop window 'il:menu)))) + (unless (or (il:lastmousestate il:up) (null menu)) + (il:totopw window) + (cond ((il:lastmousestate il:middle) + ;; look for a selected frame in this menu, and then pop up + ;; the editor invoke menu for that frame. don't change the + ;; selection, just present the edit menu. + (let* ((selection (il:menu.handler menu + (il:windowprop window 'il:dsp))) + (tty-window (il:windowprop window 'il:mainwindow)) + (last-pos (il:windowprop tty-window 'dbg::lastpos))) + + ;; don't have to worry about releasing POS because we + ;; only look at it here (nobody here hangs on to it) + ;; and we will be around for less time than LASTPOS. + ;; The debugger is responsible for releasing LASTPOS. + (il:inspect/as/function (cond + ((and selection + (il:|fetch| (il:bkmenuitem il:frame-name) + il:|of| (car selection)))) + ((and (symbolp (il:stkname last-pos)) + (il:getd (il:stkname last-pos))) + (il:stkname last-pos)) + (t 'il:nill)) + last-pos tty-window))) + (t (let ((selection (il:menu.handler menu + (il:windowprop window 'il:dsp)))) + (when selection + (il:doselecteditem menu (car selection) (cdr selection)))))))) + +;; This function isn't really redefined, but it needs to be recomiled since we +;; changed the def'n of the BKMENUITEM record. + +(defun dbg::backtrace-item-selected (item menu button) + ;;When a frame name is selected in the backtrace menu, this is the function + ;;that gets called. + (declare (special il:brkenv) (ignore button)) + (let* ((frame-spec (il:|fetch| (il:bkmenuitem il:bkmenuinfo) il:|of| item)) + (tty-window (il:windowprop (il:wfrommenu menu) 'il:mainwindow)) + (bkpos (il:windowprop tty-window 'dbg::stack-position)) + (pos (il:stknth (- frame-spec) bkpos))) + (let ((lp (il:windowprop tty-window 'dbg::lastpos))) + (and lp (il:stknth 0 pos lp))) + ;; change the item selected from OLDITEM to ITEM. Only do this on left + ;; buttons now. Middle just pops up the edit menu, doesn't select. -woz + (let ((old-item (il:|fetch| (il:menu il:menuuserdata) il:|of| menu))) + (when old-item (il:menudeselect old-item menu)) + (il:menuselect item menu)) + ;; Change the lexical environment so it is the one in effect as of this + ;; frame. + (il:process.eval (il:windowprop tty-window (quote dbg::process)) + `(setq il:brkenv ',(il:find-lexical-environment pos)) + t) + (let ((frame-window (xcl:with-profile + (il:process.eval (il:windowprop tty-window + 'il:process) + `(let ((profile (xcl:copy-profile + (xcl:find-profile + "READ-PRINT")))) + (setf + (xcl::profile-entry-value + 'xcl:*eval-function* profile) + xcl:*eval-function*) + (xcl:save-profile profile)) + t) + (il:inspectw.create pos + #'(lambda (pos) + (dbg::stack-frame-properties pos t)) + 'dbg::stack-frame-fetchfn + 'dbg::stack-frame-storefn + nil + 'dbg::stack-frame-value-command + nil + (format nil "~S Frame" (il:stkname pos)) + nil (dbg::make-frame-inspect-window + tty-window) + 'dbg::stack-frame-property)))) + (when (not (il:windowprop frame-window 'il:mainwindow)) + (il:attachwindow frame-window tty-window + (if (> (il:|fetch| (il:region il:bottom) il:|of| + (il:windowprop frame-window 'il:region)) + (il:|fetch| (il:region il:bottom) il:|of| + (il:windowprop tty-window 'il:region))) + 'il:top 'il:bottom) + nil 'il:localclose) + (il:windowaddprop frame-window 'il:closefn 'il:detachwindow))))) + +) ;end of Xerox-Medley + +(defun il:select.fns.editor (&optional function) + ;; gives the user a menu choice of editors. + (il:menu (il:|create| il:menu + il:items il:_ (cond ((il:ccodep function) + '((il:|InspectCode| 'il:inspectcode + "Shows the compiled code.") + (il:|DisplayEdit| 'ed + "Edit it with the display editor") + (il:|TtyEdit| 'il:ef + "Edit it with the standard editor"))) + ((il:closure-p function) + '((il:|Inspect| 'inspect + "Inspect this object"))) + (t '((il:|DisplayEdit| 'ed + "Edit it with the display editor") + (il:|TtyEdit| 'il:ef + "Edit it with the standard editor")))) + il:centerflg il:_ t))) + +;; + + +;; PCL specific extensions to the debugger + + +;; There are some new things that act as functions, and that we want to be +;; able to edit from a backtrace window + +(pushnew 'methods xcl::*function-types*) + +(eval-when (eval compile load) + (unless (generic-function-p (symbol-function 'il:inspect/as/function)) + (make-specializable 'il:inspect/as/function))) + +(defmethod il:inspect/as/function (name stack-pointer debugger-window) + ;; Calls an editor on function NAME. STKP and WINDOW are the stack pointer + ;; and window of the break in which this inspect command was called. + (declare (ignore debugger-window)) + (let ((editor (il:select.fns.editor name))) + (case editor + ((nil) + ;; No editor chosen, so don't do anything + nil) + (il:inspectcode + ;; Inspect the compiled code + (let ((frame (xcl::stack-pointer-frame stack-pointer))) + (if (and (il:stackp stack-pointer) + (xcl::stack-frame-valid-p frame)) + (il:inspectcode (let ((code-base (xcl::stack-frame-fn-header frame))) + (cond ((eq (il:\\get-compiled-code-base name) + code-base) + name) + (t + ;; Function executing in this frame is not + ;; the one in the definition cell of its + ;; name, so fetch the real code. Have to + ;; pass a CCODEP + (il:make-compiled-closure code-base)))) + nil nil nil (xcl::stack-frame-pc frame)) + (il:inspectcode name)))) + (ed + ;; Use the standard editor. + ;; This used to take care to apply the editor in the debugger + ;; process, so forms evaluated in the editor happen in the + ;; context of the break. But that doesn't count for much any + ;; more, now that lexical variables are the way to go. Better to + ;; use the LEX debugger command (thank you, Herbie) and + ;; shift-select pieces of code from the editor into the debugger + ;; window. + (ed name `(,@xcl::*function-types* :display))) + (otherwise (funcall editor name))))) + +(defmethod il:inspect/as/function ((name standard-object) stkp window) + (when (il:menu (il:|create| il:menu + il:items il:_ '(("Inspect" t "Inspect this object")))) + (inspect name))) + +(defmethod il:inspect/as/function ((x standard-method) stkp window) + (let* ((generic-function-name (slot-value (slot-value x 'generic-function) + 'name)) + (method-name (full-method-name x)) + (editor (il:select.fns.editor method-name))) + (il:allow.button.events) + (case editor + (ed (ed method-name '(:display methods))) + (il:inspectcode (il:inspectcode (slot-value x 'function))) + ((nil) nil) + (otherwise (funcall editor method-name))))) + +;; A replacement for the vanilla IL:INTERESTING-FRAME-P so we can see methods +;; and generic-functions on the stack. + +(defun interesting-frame-p (stack-pos &optional interp-flag) + ;; Return up to four values: INTERESTING-P LAST-FRAME-CONSUMED USE-FRAME and + ;; LABEL. See the function IL:COLLECT-BACKTRACE-ITEMS for a full description + ;; of how these values are used. + (labels + ((function-matches-frame-p (function frame) + "Is the function being called in this frame?" + (let* ((frame-name (il:stkname frame)) + (code-being-run (cond + ((typep frame-name 'il:closure) + frame-name) + ((and (consp frame-name) + (eq 'il:\\interpreter + (xcl::stack-frame-name + (il:\\stackargptr frame)))) + frame-name) + (t (xcl::stack-frame-fn-header + (il:\\stackargptr frame)))))) + (or (eq function code-being-run) + (and (typep function 'il:compiled-closure) + (eq (xcl::compiled-closure-fnheader function) + code-being-run))))) + (generic-function-from-frame (frame) + "If this the frame of a generic function return the gf, otherwise + return NIL." + ;; Generic functions are implemented as compiled closures. On the + ;; stack, we only see the fnheader for the the closure. This could + ;; be a discriminator code, or in the default method only case it + ;; will be the actual method function. To tell if this is a generic + ;; function frame, we have to check very carefully to see if the + ;; right stuff is on the stack. Specifically, the closure's ccode, + ;; and the first local variable has to be a ptrhunk big enough to be + ;; a FIN environment, and fin-env-fin of that ptrhunk has to point + ;; to a generic function whose ccode and environment match. + (let ((n-args (il:stknargs frame)) + (env nil) + (gf nil)) + (if (and ;; is there at least one local? + (> (il:stknargs frame t) n-args) + ;; and does the local contain something that might be + ;; the closure environment of a funcallable instance? + (setf env (il:stkarg (1+ n-args) frame)) + ;; and does the local contain something that might be + ;; the closure environment of a funcallable instance? + (typep env *fin-env-type*) + (setf gf (fin-env-fin env)) + ;; whose fin-env-fin points to a generic function? + (generic-function-p gf) + ;; whose environment is the same as env? + (eq (xcl::compiled-closure-env gf) env) + ;; and whose code is the same as the code for this + ;; frame? + (function-matches-frame-p gf frame)) + gf + nil)))) + (let ((frame-name (il:stkname stack-pos))) + ;; See if there is a generic-function on the stack at this + ;; location. + (let ((gf (generic-function-from-frame stack-pos))) + (when gf + (return-from interesting-frame-p (values t stack-pos stack-pos gf)))) + ;; See if this is an interpreted method. The method body is + ;; wrapped in a (BLOCK ...). We look for an + ;; interpreted call to BLOCK whose block-name is the name of + ;; generic-function. + (when (and (eq frame-name 'eval) + (consp (il:stkarg 1 stack-pos)) + (eq (first (il:stkarg 1 stack-pos)) 'block) + (symbolp (second (il:stkarg 1 stack-pos))) + (fboundp (second (il:stkarg 1 stack-pos))) + (generic-function-p + (symbol-function (second (il:stkarg 1 stack-pos))))) + (let* ((form (il:stkarg 1 stack-pos)) + (block-name (second form)) + (generic-function (symbol-function block-name)) + (methods (generic-function-methods (symbol-function block-name)))) + ;; If this is really a method being called from a + ;; generic-function, the g-f should be no more than a + ;; few(?) frames up the stack. Check for the method call + ;; by looking for a call to APPLY, where the function + ;; being applied is the code in one of the methods. + (do ((i 100 (1- i)) + (previous-pos stack-pos current-pos) + (current-pos (il:stknth -1 stack-pos) (il:stknth -1 current-pos)) + (found-method nil) + (method-pos)) + ((or (null current-pos) (<= i 0)) nil) + (cond ((equalp generic-function + (generic-function-from-frame current-pos)) + (if found-method + (return-from interesting-frame-p + (values t previous-pos method-pos found-method)) + (return))) + (found-method nil) + ((eq (il:stkname current-pos) 'apply) + (dolist (method methods) + (when (eq (method-function method) + (il:stkarg 1 current-pos)) + (setq method-pos current-pos) + (setq found-method method) + (return)))))))) + ;; Try to handle compiled methods + (when (and (symbolp frame-name) + (not (fboundp frame-name)) + (eq (il:chcon1 frame-name) + (il:charcode il:\()) + (or (string-equal "(method " (symbol-name frame-name) + :start2 0 :end2 13) + (string-equal "(method " (symbol-name frame-name) + :start2 0 :end2 12) + (string-equal "(method " (symbol-name frame-name) + :start2 0 :end2 8))) + ;; Looks like a name that PCL consed up. See if there is a + ;; GF nearby up the stack. If there is, use it to help + ;; determine which method we have. + (do ((i 30 (1- i)) + (current-pos (il:stknth -1 stack-pos) + (il:stknth -1 current-pos)) + (gf)) + ((or (null current-pos) + (<= i 0)) + nil) + (setq gf (generic-function-from-frame current-pos)) + (when gf + (dolist (method (generic-function-methods gf)) + (when (function-matches-frame-p (method-function method) + stack-pos) + (return-from interesting-frame-p + (values t stack-pos stack-pos method)))) + (return)))) + ;; If we haven't already returned, use the default method. + (xcl::interesting-frame-p stack-pos interp-flag)))) + + +(setq il:*short-backtrace-filter* 'interesting-frame-p) + +;;; Support for undo + + (defun undoable-setf-slot-value (object slot-name new-value) + (if (slot-boundp object slot-name) + (il:undosave (list 'undoable-setf-slot-value + object slot-name (slot-value object slot-name))) + (il:undosave (list 'slot-makunbound object slot-name))) + (setf (slot-value object slot-name) new-value)) + + (setf (get 'slot-value :undoable-setf-inverse) 'undoable-setf-slot-value) + + +;;; Support for ?= and friends + +;; The arglists for generic-functions are built using gensyms, and don't reflect +;; any keywords (they are all included in an &REST arg). Rather then use the +;; arglist in the code, we use the one that PCL kindly keeps in the generic-function. + +(xcl:advise-function 'il:smartarglist + '(if (and il:explainflg + (symbolp il:fn) + (fboundp il:fn) + (generic-function-p (symbol-function il:fn))) + (generic-function-pretty-arglist (symbol-function il:fn)) + (xcl:inner)) + :when :around :priority :last) + +(setf (get 'defclass 'il:argnames) + '(nil (class-name (#\{ superclass-name #\} #\*) + (#\{ slot-specifier #\} #\*) + #\{ slot-option #\} #\*))) + +(setf (get 'defmethod 'il:argnames) + '(nil (#\{ name #\| (setf name) #\} #\{ method-qualifier #\} #\* + specialized-lambda-list #\{ declaration #\| doc-string #\} #\* + #\{ form #\} #\*))) + +;;; Prettyprinting support, the result of Harley Davis. + +;; Support the standard Prettyprinter. This is really minimal right now. If +;; anybody wants to fix this, I'd be happy to include their code. In fact, +;; there is almost no support for Commonlisp in the standard Prettyprinter, so +;; the field is wide open to hackers with time on their hands. + + +(setf (get 'defmethod :definition-print-template) ;Not quite right, since it + '(:name :arglist :body)) ; doesn't handle qualifiers, + ; but it will have to do. + +(defun defclass-prettyprint (form) + (let ((left (il:dspxposition)) + (char-width (il:charwidth (il:charcode x) *standard-output*))) + (xcl:destructuring-bind (defclass name supers slots . options) form + (princ "(") + (prin1 defclass) + (princ " ") + (prin1 name) + (princ " ") + (if (null supers) + (princ "()") ;Print "()" instead of "nil" + (il:sequential.prettyprint (list supers) (il:dspxposition))) + (if (null slots) + (progn (il:prinendline (+ left (* 4 char-width)) *standard-output*) + (princ "()")) + (il:sequential.prettyprint (list slots) (+ left (* 4 char-width)))) + (when options + (il:sequential.prettyprint options (+ left (* 2 char-width)))) + (princ ")") + nil))) + +(let ((pprint-macro (assoc 'defclass il:prettyprintmacros))) + (if (null pprint-macro) + (push (cons 'defclass 'defclass-prettyprint) + il:prettyprintmacros) + (setf (cdr pprint-macro) 'defclass-prettyprint))) + +(defun binder-prettyprint (form) + ;; Prettyprints expressions like MULTIPLE-VALUE-BIND and WITH-SLOTS + ;; that are of the form (fn (var ...) form &rest body). + ;; This code is far from correct, but it's better than nothing. + (if (and (consp form) + (not (null (cdddr form)))) + ;; I have no idea what I'm doing here. Seems I can copy and edit somebody + ;; elses code without understanding it. + (let ((body-indent (+ (il:dspxposition) + (* 2 (il:charwidth (il:charcode x) + *standard-output*)))) + (form-indent (+ (il:dspxposition) + (* 4 (il:charwidth (il:charcode x) + *standard-output*))))) + (princ "(") + (prin1 (first form)) + (princ " ") + (il:superprint (second form) form nil *standard-output*) + (il:sequential.prettyprint (list (third form)) form-indent) + (il:sequential.prettyprint (cdddr form) body-indent) + (princ ")") + nil) ;Return NIL to indicate that we did + ; the printing + t)) ;Return true to use default printing + + +(dolist (fn '(multiple-value-bind with-accessors with-slots)) + (let ((pprint-macro (assoc fn 'il:prettyprintmacros))) + (if (null pprint-macro) + (push (cons fn 'binder-prettyprint) + il:prettyprintmacros) + (setf (cdr pprint-macro) 'binder-prettyprint)))) + + + +;; SEdit has its own prettyprinter, so we need to support that too. This is due +;; to Harley Davis. Really. + +(push (cons :slot-spec + '(((sedit::prev-keyword? (sedit::next-inline? 1 break sedit::from-indent . 1) + break sedit::from-indent . 0) + (sedit::set-indent . 1) + (sedit::next-inline? 1 break sedit::from-indent . 1) + (sedit::prev-keyword? (sedit::next-inline? 1 break sedit::from-indent . 1) + break sedit::from-indent . 0)) + ((sedit::prev-keyword? (sedit::next-inline? 1 break sedit::from-indent . 1) + break sedit::from-indent . 0) + (sedit::set-indent . 1) + (sedit::next-inline? 1 break sedit::from-indent . 1) + (sedit::prev-keyword? (sedit::next-inline? 1 break sedit::from-indent . 1) + break sedit::from-indent . 0)))) + sedit:*indent-alist*) + +(setf (sedit:get-format :slot-spec) + '(:indent :slot-spec :inline t)) + +(setf (sedit:get-format :slot-spec-list) + '(:indent :binding-list :args (:slot-spec) :inline nil)) + +(setf (sedit:get-format 'defclass) + '(:indent ((2) 1) + :args (:keyword nil nil :slot-spec-list nil) + :sublists (4))) + +(setf (sedit:get-format 'defmethod) + '(:indent ((2)) + :args (:keyword nil :lambda-list nil) + :sublists (3))) + +(setf (sedit:get-format 'defgeneric) 'defun) + +(setf (sedit:get-format 'generic-flet) 'flet) + +(setf (sedit:get-format 'generic-labels) 'flet) + +(setf (sedit:get-format 'call-next-method) + '(:indent (1) :args (:keyword nil))) + +(setf (sedit:get-format 'symbol-macrolet) 'let) + +(setf (sedit:get-format 'with-accessors) + '(:indent ((1) 1) + :args (:keyword :binding-list nil) + :sublists (2) + :miser :never)) + +(setf (sedit:get-format 'with-slots) 'with-accessors) + +(setf (sedit:get-format 'make-instance) + '(:indent ((1)) + :args (:keyword nil :slot-spec-list))) + +(setf (sedit:get-format '*make-instance) 'make-instance) + +;;; PrettyFileIndex stuff, the product of Harley Davis. + +(defvar *pfi-class-type* '(class defclass pfi-class-namer)) + +(defvar *pfi-method-type* '(method defmethod pfi-method-namer) + "Handles method for prettyfileindex") + +(defvar *pfi-index-accessors* nil + "t -> each slot accessor gets a listing in the index.") + +(defvar *pfi-method-index* :group + ":group, :separate, :both, or nil") + +(defun pfi-add-class-type () + (pushnew *pfi-class-type* il:*pfi-types*)) + +(defun pfi-add-method-type () + (pushnew *pfi-method-type* il:*pfi-types*)) + +(defun pfi-class-namer (expression entry) + (let ((class-name (second expression))) + ;; Following adds all slot readers/writers/accessors as separate entries in + ;; the index. Probably a mistake. + (if *pfi-index-accessors* + (let ((slot-list (fourth expression)) + (accessor-names nil)) + (labels ((add-accessor (method-index name-index) + (push (case *pfi-method-index* + (:group method-index) + (:separate name-index) + ((t :both) (list method-index name-index)) + ((nil) nil) + (otherwise (error "Illegal value for *pfi-method-index*: ~S" + *pfi-method-index*))) + accessor-names)) + (add-reader (reader-name) + (add-accessor `(method (,reader-name (,class-name))) + `(,reader-name (,class-name)))) + (add-writer (writer-name) + (add-accessor `(method ((setf ,writer-name) (t ,class-name))) + `((setf ,writer-name) (t ,class-name))))) + (dolist (slot-def slot-list) + (do* ((rest-slot-args (cdr slot-def) (cddr rest-slot-args)) + (slot-arg (first rest-slot-args) (first rest-slot-args))) + ((null rest-slot-args)) + (case slot-arg + (:reader (add-reader (second rest-slot-args))) + (:writer (add-writer (second rest-slot-args))) + (:accessor (add-reader (second rest-slot-args)) + (add-writer (second rest-slot-args))) + (otherwise nil)))) + (cons `(class (,class-name)) accessor-names))) + class-name))) + +(defun pfi-method-namer (expression entry) + (let ((method-name (second expression)) + (specializers nil) + (qualifiers nil) + lambda-list) + (do* ((rest-qualifiers (cddr expression) (cdr rest-qualifiers)) + (qualifier (first rest-qualifiers) (first rest-qualifiers))) + ((listp qualifier) (setq lambda-list qualifier) + (setq qualifiers (reverse qualifiers)) qualifiers) + (push qualifier qualifiers)) + (do* ((rest-lambda-list lambda-list (cdr rest-lambda-list)) + (arg (first rest-lambda-list) (first rest-lambda-list))) + ((or (member arg lambda-list-keywords) (null rest-lambda-list)) + (setq specializers (reverse specializers))) + (push (if (listp arg) (second arg) t) specializers)) + (let ((method-index `(method (,method-name ,@qualifiers ,specializers))) + (name-index `(,method-name ,@qualifiers ,specializers))) + (case *pfi-method-index* + (:group method-index) + (:separate name-index) + ((t :both) (list method-index name-index)) + ((nil) nil) + (otherwise (error "Illegal value for *pfi-method-index*: ~S" *pfi-method-index*)))))) + +(defun pfi-install-pcl () + (pfi-add-method-type) + (pfi-add-class-type)) + +(eval-when (eval load) + (when (boundp (quote il:*pfi-types*)) + (pfi-install-pcl)) + ) + diff --git a/pcl/impl/xerox/pcl-env.text b/pcl/impl/xerox/pcl-env.text new file mode 100644 index 0000000..25e090f --- /dev/null +++ b/pcl/impl/xerox/pcl-env.text @@ -0,0 +1,105 @@ +A (very) few words about PCL-ENV. If you require more information, consult the +source code. While it is not particularly well documented, it is the final +arbiter of truth regarding its own functionality. + +The file PCL-ENV.LISP defines some low-level facilities to integrate PCL into +the XeroxLisp environment. The first order of business is teaching the +FileManager (nee FilePackage) about CLOS defineing forms. This in turn brings +us to the issue of names. + + +o Names and the FileManager + +For the FileManager to keep track of defining forms, it needs to know how to +extract a (unique) name and FileManager type from the form. PCL-ENV includes +FileManager support for the definers DEFCLASS, DEFGENERIC, and DEFMETHOD. + +DEFCLASS +The name of a DEFCLASS form is the name of the class defined by the form. The +FileManager type is PCL::CLASSES. There is a FileManager "undefiner" provided +for DEFCLASS. + +DEFGENERIC +The name of a DEFGENERIC form is the name of the generic-function defined by the +form. The FileManager type is PCL::GENERIC-FUNCTIONS. + +DEFMETHOD +The name of a DEFMETHOD form is a list of the form +( {}* ({*})). The FileManager type is +PCL::METHODS. There is a FileManager "undefiner" provided for DEFMETHOD. +However, note that if a generic-function was created as a side-effect of the +DEFMETHOD, the undefiner will leave the generic-function defined (albet with no +methods). + +When editing, it would be onerous to require the programmer to type in the full name of a +method. PCL-ENV arranges it so that (ED ) will ask the programmer +which method on that generic-function should be edited. (If there is only one +method, it is assumed that that is the method to be edited.) As of the +Victoria-Day release, EQL specialized methods are handled correctly. + + +o Inspecting CLOS objects (and metaobjects) + +PCL-ENV defines a protocol that is used to inspect objects, and arranges that +the standard INSPECT function uses this protocol. Programmers can use this +protocol by defining additional methods on the following generic-functions. + +INSPECT-SLOT-NAMES object +Returns a list of "slots" to include in the inspector. The default method +returns a list of all slots on the object. + +INSPECT-SLOT-VALUE object slot-name +Returns the value to associated with the slot-name in the inspector. Slot-name +is one of the items returned by INSPECT-SLOT-NAMES. The default method returns +(SLOT-VALUE object slot-name). + +INSPECT-SETF-SLOT-VALUE object slot-name new-value +Sets the value associated with the slot-name in the inspector. Slot-name is one +of the items returned by INSPECT-SLOT-NAMES. The default method executes +(SETF (SLOT-VALUE object slot-name) new-value). + +INSPECT-TITLE object inspect-window +Returns the title to use in the inspect-window when inspecting object. The +default returns the string "Inspecting the class " when the object +is a class, or "Inspecting a " otherwise. + + +o Debugging and the Stack + +Debugging in PCL is complicated by generic-functions and methods appear on the +stack not as single objects, but as collections of functions that the programmer +did not directly call. PCL-ENV redefines a number of internal debugger +functions to simplify the presentation of the stack, and allow the programmer to +access to the original defining forms from the stack. These changes only affect +the "short" display backtrace (brought up by BT in a break window); the full +backtrace (brought up by BT!) is unaffected. + + +o Misc + +Prettyprinting + +The support for standard Prettyprinting is pretty minimal. Only DEFMETHOD, +DEFCLASS, WITH-ACCESSORS, and WITH-SLOTS are supported, and they aren't really +done right. Thanks to Harley Davis, PCL-ENV defines SEdit pretty-print specs +for the forms DEFCLASS, DEFMETHOD, DEFGENERIC, GENERIC-FLET, GENERIC-LABELS, +CALL-NEXT-METHOD, SYMBOL-MACROLET, WITH-ACCESSORS, WITH-SLOTS, and +MAKE-INSTANCE. + +?= + +The function SMARTARGLIST is changed to return appropriate values for the +arglists of generic-functions. The macros DEFCLASS and DEFMETHOD have "pretty" +arglists defined. + +PrettyFileIndex + +Again thanks to Harley Davis, PCL-ENV teaches PRETTY-FILE-INDEX about classes, +methods, and accessors. The variables PCL::*PFI-INDEX-ACCESSORS* and +PCL::*PFI-METHOD-INDEX* may be changed by the user to tailor the computation of +the file index. Note that the file PRETTY-FILE-INDEX must be loaded before +PCL-ENV for this to take effect. + + +--- smL 25-May-89 + diff --git a/pcl/impl/xerox/xerox-low.lisp b/pcl/impl/xerox/xerox-low.lisp new file mode 100644 index 0000000..741d595 --- /dev/null +++ b/pcl/impl/xerox/xerox-low.lisp @@ -0,0 +1,173 @@ +;;; -*- Mode:LISP; Package:(PCL Lisp 1000); Base:10.; Syntax:Common-lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; This is the 1100 (Xerox version) of the file portable-low. +;;; + +(in-package 'pcl) + +(defmacro load-time-eval (form) + `(il:LOADTIMECONSTANT ,form)) + +;;; +;;; make the pointer from an instance to its class wrapper be an xpointer. +;;; this prevents instance creation from spending a lot of time incrementing +;;; the large refcount of the class-wrapper. This is safe because there will +;;; always be some other pointer to the wrapper to keep it around. +;;; +#+Xerox-Medley +(defstruct (std-instance (:predicate std-instance-p) + (:conc-name %std-instance-) + (:constructor %%allocate-instance--class ()) + (:fast-accessors t) + (:print-function %print-std-instance)) + (wrapper nil :type il:fullxpointer) + (slots nil)) + +#+Xerox-Lyric +(eval-when (eval load compile) + (il:datatype std-instance + ((wrapper il:fullxpointer) + slots)) + + (xcl:definline std-instance-p (x) + (typep x 'std-instance)) + + (xcl:definline %%allocate-instance--class () + (il:create std-instance)) + + (xcl:definline %std-instance-wrapper (x) + (il:fetch (std-instance wrapper) il:of x)) + + (xcl:definline %std-instance-slots (x) + (il:fetch (std-instance slots) il:of x)) + + (xcl:definline set-%std-instance-wrapper (x value) + (il:replace (std-instance wrapper) il:of x il:with value)) + + (xcl:definline set-%std-instance-slots (x value) + (il:replace (std-instance slots) il:of x il:with value)) + + (defsetf %std-instance-wrapper set-%std-instance-wrapper) + + (defsetf %std-instance-slots set-%std-instance-slots) + + (il:defprint 'std-instance '%print-std-instance) + + ) + +(defun %print-std-instance (instance &optional stream depth) + ;; See the IRM, section 25.3.3. Unfortunately, that documentation is + ;; not correct. In particular, it makes no mention of the third argument. + (cond ((streamp stream) + ;; Use the standard PCL printing method, then return T to tell + ;; the printer that we have done the printing ourselves. + (print-std-instance instance stream depth) + t) + (t + ;; Internal printing (again, see the IRM section 25.3.3). + ;; Return a list containing the string of characters that + ;; would be printed, if the object were being printed for + ;; real. + (list (with-output-to-string (stream) + (print-std-instance instance stream depth)))))) + + ;; +;;;;;; FUNCTION-ARGLIST + ;; + +(defun function-arglist (x) + ;; Xerox lisp has the bad habit of returning a symbol to mean &rest, and + ;; strings instead of symbols. How silly. + (let ((arglist (il:arglist x))) + (when (symbolp arglist) + ;; This could be due to trying to extract the arglist of an interpreted + ;; function (though why that should be hard is beyond me). On the other + ;; hand, if the function is compiled, it helps to ask for the "smart" + ;; arglist. + (setq arglist + (if (consp (symbol-function x)) + (second (symbol-function x)) + (il:arglist x t)))) + (if (symbolp arglist) + ;; Probably never get here, but just in case + (list '&rest 'rest) + ;; Make sure there are no strings where there should be symbols + (if (some #'stringp arglist) + (mapcar #'(lambda (a) (if (symbolp a) a (intern a))) arglist) + arglist)))) + +(defun printing-random-thing-internal (thing stream) + (let ((*print-base* 8)) + (princ (il:\\hiloc thing) stream) + (princ "," stream) + (princ (il:\\loloc thing) stream))) + +(defun record-definition (name type &optional parent-name parent-type) + (declare (ignore type parent-name)) + ()) + + +;;; +;;; FIN uses this too! +;;; +(eval-when (compile load eval) + (il:datatype il:compiled-closure (il:fnheader il:environment)) + + (il:blockrecord closure-overlay ((funcallable-instance-p il:flag))) + + ) + +(defun compiled-closure-fnheader (compiled-closure) + (il:fetch (il:compiled-closure il:fnheader) il:of compiled-closure)) + +(defun set-compiled-closure-fnheader (compiled-closure nv) + (il:replace (il:compiled-closure il:fnheader) il:of compiled-closure nv)) + +(defsetf compiled-closure-fnheader set-compiled-closure-fnheader) + +;;; +;;; In Lyric, and until the format of FNHEADER changes, getting the name from +;;; a compiled closure looks like this: +;;; +;;; (fetchfield '(nil 4 pointer) +;;; (fetch (compiled-closure fnheader) closure)) +;;; +;;; Of course this is completely non-robust, but it will work for now. This +;;; is not the place to go into a long tyrade about what is wrong with having +;;; record package definitions go away when you ship the sysout; there isn't +;;; enough diskspace. +;;; +(defun set-function-name-1 (fn new-name uninterned-name) + (cond ((typep fn 'il:compiled-closure) + (il:\\rplptr (compiled-closure-fnheader fn) 4 new-name) + (when (and (consp uninterned-name) + (eq (car uninterned-name) 'method)) + (let ((debug (si::compiled-function-debugging-info fn))) + (when debug (setf (cdr debug) uninterned-name))))) + (t nil)) + fn) + diff --git a/pcl/impl/xerox/xerox-patches.lisp b/pcl/impl/xerox/xerox-patches.lisp new file mode 100644 index 0000000..87ed713 --- /dev/null +++ b/pcl/impl/xerox/xerox-patches.lisp @@ -0,0 +1,248 @@ +;;; -*- Mode: Lisp; Package: XCL-USER; Base: 10.; Syntax: Common-Lisp -*- +;;; +;;; ************************************************************************* +;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. +;;; All rights reserved. +;;; +;;; Use and copying of this software and preparation of derivative works +;;; based upon this software are permitted. Any distribution of this +;;; software or derivative works must comply with all applicable United +;;; States export control laws. +;;; +;;; This software is made available AS IS, and Xerox Corporation makes no +;;; warranty about the software, its performance or its conformity to any +;;; specification. +;;; +;;; Any person obtaining a copy of this software is requested to send their +;;; name and post office or electronic mail address to: +;;; CommonLoops Coordinator +;;; Xerox PARC +;;; 3333 Coyote Hill Rd. +;;; Palo Alto, CA 94304 +;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa) +;;; +;;; Suggestions, comments and requests for improvements are also welcome. +;;; ************************************************************************* +;;; +;;; + +(in-package "XCL-USER") + + +;;; Patch a bug with Lambda-substitution + +#+Xerox-Lyric +(defun compiler::meta-call-lambda-substitute (node) + (let* ((fn (compiler::call-fn node)) + (var-list (compiler::lambda-required fn)) + (spec-effects + (il:for var il:in var-list + il:unless (eq (compiler::variable-scope var) :lexical) + il:collect (compiler::effects-representation var))) + ;; Bind *SUBST-OCCURED* just so that META-SUBST-VAR-REF ahs a binding + ;; to set even when nobody cares. + (compiler::*subst-occurred* nil)) + (il:for var il:in var-list + il:as tail il:on (compiler::call-args node) + il:when + (and (eq (compiler::variable-scope var) :lexical) + (compiler::substitutable-p (car tail) var) + (dolist (compiler::spec-effect spec-effects t) + (when + (not (compiler::null-effects-intersection compiler::spec-effect + (compiler::node-affected (car tail)))) + (return nil))) + (dolist (compiler::later-arg (cdr tail) t) + (when (not (compiler::passable (car tail) compiler::later-arg)) + (return nil)))) + il:do + (setf (compiler::lambda-body fn) + (compiler::meta-substitute (car tail) var + (compiler::lambda-body fn)))) + (when (null (compiler::node-meta-p (compiler::lambda-body fn))) + (setf (compiler::node-meta-p fn) nil) + (setq compiler::*made-changes* t)))) + +;;; Some simple optimizations missing from the compiler. + + +;; Shift by a constant. + +;; Unfortunately, these cause the compiler to generate spurious warning +;; messages about "Unknown function IL:LLSH1 called from ..." It's not often +;; you come across a place where COMPILER-LET is really needed. + +#+Xerox-Lyric +(progn + +(defvar *ignore-shift-by-constant-optimization* nil + "Marker used for informing the shift-by-constant optimizers that they are in + the shift function, and should not optimize.") + +(defun il:lrsh1 (x) + (compiler-let ((*ignore-shift-by-constant-optimization* t)) + (il:lrsh x 1))) + +(defun il:lrsh8 (x) + (compiler-let ((*ignore-shift-by-constant-optimization* t)) + (il:lrsh x 8))) + +(defun il:llsh1 (x) + (compiler-let ((*ignore-shift-by-constant-optimization* t)) + (il:llsh x 1))) + +(defun il:llsh8 (x) + (compiler-let ((*ignore-shift-by-constant-optimization* t)) + (il:llsh x 8))) + +(defoptimizer il:lrsh il:right-shift-by-constant (x n &environment env) + (if (and (constantp n) + (not *ignore-shift-by-constant-optimization*)) + (let ((shift-factor (eval n))) + (cond + ((not (numberp shift-factor)) + (error "Non-numeric arg to ~S, ~S" 'il:lrsh shift-factor)) + ((= shift-factor 0) + x) + ((< shift-factor 0) + `(il:llsh ,x ,(- shift-factor))) + ((< shift-factor 8) + `(il:lrsh (il:lrsh1 ,x) ,(1- shift-factor))) + (t `(il:lrsh (il:lrsh8 ,x) ,(- shift-factor 8))))) + 'compiler:pass)) + +(defoptimizer il:llsh il:left-shift-by-constant (x n &environment env) + (if (and (constantp n) + (not *ignore-shift-by-constant-optimization*)) + (let ((shift-factor (eval n))) + (cond + ((not (numberp shift-factor)) + (error "Non-numeric arg to ~S, ~S" 'il:llsh shift-factor)) + ((= shift-factor 0) + x) + ((< shift-factor 0) + `(il:lrsh ,x ,(- shift-factor))) + ((< shift-factor 8) + `(il:llsh (il:llsh1 ,x) ,(1- shift-factor))) + (t `(il:llsh (il:llsh8 ,x) ,(- shift-factor 8))))) + 'compiler:pass)) + +) + + +;; Simple TYPEP optimiziation + +#+Xerox-Lyric +(defoptimizer typep type-t-test (object type) + "Everything is of type T" + (if (and (constantp type) (eq (eval type) t)) + `(progn ,object t) + 'compiler:pass)) + +;;; Declare side-effects (actually, lack of side-effects) info for some +;;; internal arithmetic functions. These are needed because the compiler runs +;;; the optimizers before checking the side-effects, so side-effect +;;; declarations on the "real" functions are oft times ignored. + +#+Xerox-Lyric +(progn + +(il:putprops cl::%+ compiler::side-effects-data (:none . :none)) +(il:putprops cl::%- compiler::side-effects-data (:none . :none)) +(il:putprops cl::%* compiler::side-effects-data (:none . :none)) +(il:putprops cl::%/ compiler::side-effects-data (:none . :none)) +(il:putprops cl::%logior compiler::side-effects-data (:none . :none)) +(il:putprops cl::%logeqv compiler::side-effects-data (:none . :none)) +(il:putprops cl::%= compiler::side-effects-data (:none . :none)) +(il:putprops cl::%> compiler::side-effects-data (:none . :none)) +(il:putprops cl::%< compiler::side-effects-data (:none . :none)) +(il:putprops cl::%>= compiler::side-effects-data (:none . :none)) +(il:putprops cl::%<= compiler::side-effects-data (:none . :none)) +(il:putprops cl::%/= compiler::side-effects-data (:none . :none)) +(il:putprops il:lrsh1 compiler::side-effects-data (:none . :none)) +(il:putprops il:lrsh8 compiler::side-effects-data (:none . :none)) +(il:putprops il:llsh1 compiler::side-effects-data (:none . :none)) +(il:putprops il:llsh8 compiler::side-effects-data (:none . :none)) + +) + +;;; Fix a nit in the compiler +#+Xerox-Lyric +(progn + +(il:unadvise 'compile) +(il:advise 'compile ':around '(let (compiler::*input-stream*) (inner))) + +) + +;;; While no person would generate code like (logor x), macro can (and do). + +(defun optimize-logical-op-1-arg (form env ctxt) + (declare (ignore env ctxt)) + (if (= 2 (length form)) + (second form) + 'compiler::pass)) + +(xcl:defoptimizer logior optimize-logical-op-1-arg) +(xcl:defoptimizer logxor optimize-logical-op-1-arg) +(xcl:defoptimizer logand optimize-logical-op-1-arg) +(xcl:defoptimizer logeqv optimize-logical-op-1-arg) + + +#+Xerox-Medley + +;; A bug compiling LABELS + +(defun compiler::meta-call-labels (compiler::node compiler:context) + ;; This is similar to META-CALL-LAMBDA, but we have some extra information. + ;; There are only required arguments, and we have the correct number of them. + (let ((compiler::*made-changes* nil)) + ;; First, substitute the functions wherever possible. + (dolist (compiler::fn-pair (compiler::labels-funs compiler::node) + (when (null (compiler::node-meta-p (compiler::labels-body compiler::node))) + (setf (compiler::node-meta-p compiler::node) nil) + (setq compiler::*made-changes* t))) + (when (compiler::substitutable-p (cdr compiler::fn-pair) + (car compiler::fn-pair)) + (let ((compiler::*subst-occurred* nil)) + ;; First try substituting into the body. + (setf (compiler::labels-body compiler::node) + (compiler::meta-substitute (cdr compiler::fn-pair) + (car compiler::fn-pair) + (compiler::labels-body compiler::node))) + (when (not compiler::*subst-occurred*) + ;; Wasn't in the body - try the other functions. + (dolist (compiler::target-pair (compiler::labels-funs compiler::node)) + (unless (eq compiler::target-pair compiler::fn-pair) + (setf (cdr compiler::target-pair) + (compiler::meta-substitute (cdr compiler::fn-pair) + (car compiler::fn-pair) + (cdr compiler::target-pair))) + (when compiler::*subst-occurred* ;Found it, we can stop now. + (setf (compiler::node-meta-p compiler::node) nil) + (setq compiler::*made-changes* t) (return))))) + ;; May need to reanalyze the node, since things might have changed. + ;; Note that reanalyzing the parts of the node this way means the the + ;; state in the enclosing loop is not lost. + (dolist (compiler::fns (compiler::labels-funs compiler::node)) + (compiler::meval (cdr compiler::fns) :argument)) + (compiler::meval (compiler::labels-body compiler::node) :return)))) + ;; Now remove any functions that aren't referenced. + (dolist (compiler::fn-pair (prog1 (compiler::labels-funs compiler::node) + (setf (compiler::labels-funs compiler::node) nil))) + (cond ((null (compiler::variable-read-refs (car compiler::fn-pair))) + (compiler::release-tree (cdr compiler::fn-pair)) + (setq compiler::*made-changes* t)) + (t (push compiler::fn-pair (compiler::labels-funs compiler::node))))) + ;; If there aren't any functions left, replace the node with its body. + (when (null (compiler::labels-funs compiler::node)) + (let ((compiler::body (compiler::labels-body compiler::node))) + (setf (compiler::labels-body compiler::node) nil) + (compiler::release-tree compiler::node) + (setq compiler::node compiler::body compiler::*made-changes* t))) + ;; Finally, set the meta-p flag if everythings OK. + (if (null compiler::*made-changes*) + (setf (compiler::node-meta-p compiler::node) compiler:context) + (setf (compiler::node-meta-p compiler::node) nil))) + compiler::node) + diff --git a/pcl/makefile b/pcl/makefile new file mode 100644 index 0000000..3ebc3ea --- /dev/null +++ b/pcl/makefile @@ -0,0 +1,73 @@ +# makefile for making pcl -- W. Schelter. + +-include ../makedefs + +FILES:=$(shell ls -1 gcl_*.lisp | sed 's,\.lisp,,1') gcl_pcl_impl_low + +GFILES1:= 0 1 2 3 4 5 6 7 +GFILES:=$(addprefix gcl_pcl_gazonk,$(GFILES1)) + +AFILES:=$(FILES) $(GFILES) + +SETUP='(load "defsys.lisp")' \ + '(setq pcl::*default-pathname-extensions* (cons "lisp" "o"))' \ + '(setq pcl::*pathname-extensions* (cons "lisp" "o"))' \ + '(load "sys-proclaim.lisp")' \ + '(setq compiler::*default-h-file* t)'\ + '(setq compiler::*default-c-file* t)'\ + '(setq compiler::*default-data-file* t)'\ + '(setq compiler::*default-system-p* t)' \ + '(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) a nil)' \ + '(setq compiler::*keep-gaz* t compiler::*tmp-dir* "")' + +all: $(addsuffix .c,$(AFILES)) $(addsuffix .o,$(AFILES)) + +saved_gcl_pcl: ../unixport/saved_gcl$(EXE) + cp ../h/cmpinclude.h . + echo $(SETUP) '(pcl::compile-pcl)' | $< + echo $(SETUP) '(pcl::load-pcl)(si::save-system "$@")' | $< + +$(addsuffix .c,$(AFILES)) $(addsuffix .data,$(AFILES))\ + $(addsuffix .h,$(AFILES)) $(addsuffix .lsp,$(GFILES)): \ + $(addsuffix .lisp,$(subst gcl_pcl_impl_low,impl/gcl/gcl_pcl_impl_low,$(FILES))) + rm -f *.o *gazonk* + cp ../h/cmpinclude.h . + echo ${SETUP} '(pcl::compile-pcl)' | ../unixport/saved_gcl$(EXE) + for i in gazonk* ; do \ + j=$$(echo $$i | sed 's,\..*$$,,1');k="gazonk$$(echo $$j | cut -f3 -d\_)";\ + l=$$(echo $$i | sed 's,^.*\.,,1');\ + if test "$$l" = "data" ; then\ + cp $$i gcl_pcl_$$k.$$l;\ + else\ + cat $$i | sed -e "s,$$j\.h,gcl_pcl_$$k.h,1"\ + -e "s,init_.*$$j,init_gcl_pcl_$$k,g" >gcl_pcl_$$k.$$l && rm $$i;\ + fi; done + +%.o: %.c %.h %.data + $(CC) $(CFLAGS) -c $< -o $@ + ../xbin/append $*.data $@ + +clean: + rm -f *.o *.fn *.exe *.dll saved_gcl_pcl$(EXE) cmpinclude.h *.c *.h *.data *gazonk* + + +# remake the sys-package.lisp and sys-proclaim.lisp files +# Those files may be empty on a first build. +remake-sys-files: + rm -f *.o *gazonk* + cp ../h/cmpinclude.h . + echo ${SETUP} '(load "../cmpnew/gcl_collectfn.lsp")(compiler::emit-fn t)' \ + '(pcl::compile-pcl)' | ../unixport/saved_gcl$(EXE) ../unixport/ + echo ${SETUP} '(load "../cmpnew/gcl_collectfn.lsp") '\ + '(pcl::load-pcl)(in-package "PCL")(renew-sys-files)' | \ + ../unixport/saved_gcl$(EXE) ../unixport/ + cp sys-proclaim.lisp xxx + cat xxx | sed -e "s/COMPILER::CMP-ANON//g" > sys-proclaim.lisp + rm xxx + + +tar: + $(MAKE) -f makefile.gcl tar1 DIR=`pwd` + +tar1: + (cd .. ; tar cvf - `basename ${DIR}` | gzip -c > `basename ${DIR}`.tgz) diff --git a/pcl/notes/12-7-88-notes.text b/pcl/notes/12-7-88-notes.text new file mode 100644 index 0000000..a940515 --- /dev/null +++ b/pcl/notes/12-7-88-notes.text @@ -0,0 +1,45 @@ +Copyright (c) Xerox Corporation 1988. All rights reserved. + + +These notes correspond to the "12/7/88 Can't think of a cute name PCL" +version of PCL. + +Please read this entire file carefully. You may also be interested in +looking at previous versions of the notes.text file. These are called +xxx-notes.text where xxx is the version of the PCL system the file +corresponds to. At least the last two versions of this file contain +useful information for any PCL user. + +This version of PCL has been tested at PARC in the following Common +Lisps: + + Symbolics 7.2 + Coral 1.2 + Lucid 3.0 + KCL (October 15, 1987) + Allegro 3.0.1 + +These three should work, but haven't been tested just yet. + + EnvOS Medley + TI + +The notes file hasn't yet been fleshed out yet. + +The two major changes in this release are: + + - The generic function cache algorithm has been revised. In addition + generic function caches now expand automatically. Programs that used + to run into problems with lots of cache misses shouldn't run into + those problems anymore. + + - the DEFCONSTRUCTOR hack now works. Please see the construct.lisp + file for details. If you are consing lots of instances, you may be + able to get a tremendous performance boost by using this hack. + + +Another important change is that this version includes some KCL patches +which dramatically improve PCL performance in KCL. See the kcl-mods.text +file for more details. + + diff --git a/pcl/notes/3-17-88-notes.text b/pcl/notes/3-17-88-notes.text new file mode 100644 index 0000000..7602fb0 --- /dev/null +++ b/pcl/notes/3-17-88-notes.text @@ -0,0 +1,167 @@ +Copyright (c) Xerox Corporation 1988. All rights reserved. + +These notes correspond to the beta test release of March 17th 1988. +Later versions of this release will run in the usual lisps, but for the +time being this has only been tested in Symbolics, Lucid, Coral, +Xerox, Ibuki (01/01), TI and VAXLisp Common Lisps. + +Note may not run in all Franz Lisps, I believe it runs on the SUN3 +though. I will get back to this in a few days when I get the needed +code from Franz. + +*** +This release will run in Lucid 3.0 beta 2, with the boolean.lbin patch. + +*** +This release contains a prototype implementation of the make-instance +behavior documented in the CLOS specification (X3J13 document # 88-002). +This prototype implementation does not provide high performance, but it +should conform to the specification with one exception, it does not +check the validity of the initargs. + +All the generic functions in the instance creation protocol are as +specified in the CLOS specification except that make-instance is called +mki instead. This name is a temporary name, it is so that people can +try out the new make-instance protocol without having to convert all +their code at once. In a future release, the name make-instance will be +switched to the new behavior. + +*** +Standard method combination is supported. General declarative +method combination is not yet supported, so define-method-combination does +not yet work, but standard method combination is what generic functions +do by default now. :after :before :around and unqualified methods are +supported. Error checking is minimal. + +*** +call-next-method works with standard-method-combination. +call-next-method is much faster than it was before, and call-next-method +behaves as a lexically defined function. This means it is possible to +pass around funargs which include call-next-method. + +*** +All uses of slot-value within a method body should be optimized. It +should no longer be necessary to use with-slots just to get the +optimization. + +*** +There are new macros with-slots* and with-accessors*. These correspond +to the macros which will appear in the final specification, with-slots +and with-accessors. They work as follows: + +(with-slots* ((x x-slot) + (y y-slot)) ===\ (let ((#:g1 (foo))) + (foo) ===/ (swapf (slot-value #:g1 'x-slot) + (swapf x y)) (slot-value #:g1 'y-slot))) + +(with-accessors* ((x position-x) + (y position-y)) ===\ (let ((#:g1 (foo))) + (foo) ===/ (incf (position-x #:g1)) + (incf x) (incf (position-y #:g1))) + (incf y)) + +As an abbreviation, the ( ) pairs in with-slots* +can be abbreviated to just when the variable +and slot name are the same. This means that: + +(with-slots* (x y z) &body ) + +is equivalent to: + +(with-slots* ((x x) (y y) (z z)) &body ) + +You should begin to convert your code to use these macros as soon as +possible since the old macro with-slots will swap names with with-slots* +sometime soon. + +A trick you may want to use for remembering the order of the first two +arguments to with-slots* and with-accessors* is that it is "like +multiple-value-bind". + +*** +In addition this release includes the beginnings of support for doing +some of the compiling which PCL does a load time at compile time +instead. To use this support, put the form: + + (pcl::precompile-random-code-segments) + +in a file which is compiled after all your other pcl using files are +loaded. Then arrange for that file to be loaded before all your +other pcl using files are loaded. + +For example, if your system has two files called "classes" and "methods", +create a new file called "precom" that contains: + + (in-package 'pcl) + + (pcl::precompile-random-code-segments) + + +Then you can use the defsystem stuff defined in the file defsys to +maintain your system as follows: + +(defsystem my-very-own-system + "/usr/myname/lisp/" + ((classes (precom) () ()) + (methods (precom classes) (classes) ()) + (precom () (classes methods) (classes methods)))) + +This defsystem should be read as follows: + +* Define a system named MY-VERY-OWN-SYSTEM, the sources and binaries + should be in the directory "/usr/me/lisp/". There are three files + in the system, there are named classes, methods and precom. (The + extension the filenames have depends on the lisp you are running in.) + +* For the first file, classes, the (precom) in the line means that + the file precom should be loaded before this file is loaded. The + first () means that no other files need to be loaded before this + file is compiled. The second () means that changes in other files + don't force this file to be recompiled. + +* For the second file, methods, the (precom classes) means that both + of the files precom and classes must be loaded before this file + can be loaded. The (classes) means that the file classes must be + loaded before this file can be compiled. The () means that changes + in other files don't force this file to be recompiled. + +* For the third file, precom, the first () means that no other files + need to be loaded before this file is loaded. The first use of + (classes methods) means that both classes and methods must be + loaded before this file can be compiled. The second use of (classes + methods) mean that whenever either classes or methods changes precom + must be recompiled. + +Then you can compile your system with: + + (operate-on-system 'my-very-own-system :compile) + +and load your system with: + + (operate-on-system 'my-very-own-system :load) + +*** +The code walker has gone through some signigificant revision. The +principle change is that the function walk-form now takes three required +arguments, and the walk-function itself now must accept an environment +argument. There are other changes having to do with the implementation +specific representation of macroexpansion environments. For details see +the file walk.lisp. + +*** +The following functions and macros which used to be supported for +backward compatibility only are now not supported at all: + +WITH* and WITH + +DEFMETH + +GET-SLOT + +MAKE + + +*** +There are other small changes in this release. If you notice one that +causes you problems please send me a message about it. + diff --git a/pcl/notes/3-19-87-notes.text b/pcl/notes/3-19-87-notes.text new file mode 100644 index 0000000..ce332f6 --- /dev/null +++ b/pcl/notes/3-19-87-notes.text @@ -0,0 +1,138 @@ + + +These notes correspond to *pcl-system-date* 3/19/87 prime. + +This release runs in: + ExCL + Lucid + Symbolics Common Lisp (Genera) + Vaxlisp (2.0) + Xerox Common Lisp (Lyric Release) + +CMU Lisp (nee Spice) and KCL should be working soon, I will announce +another release at that time. I figured it was better to get some +people beating on it as soon as possibl. + +Xerox Lisp users should FTP all the source files from /pub/pcl/ as well +as all the dfasl files from /pub/pcl/xerox/. Included in the xerox +specific directory is a file called PCL-ENV, which provides some simple +environment support for using PCL in Xerox Lisp. + + + +Following is a description of some of the things that are different in +this release of PCL. This list isn't in any particular order. There +are a number of incompatible changes in this release, please read the +whole thing carefully. + +As usual, please enjoy, and send bug-reports, questions etc. to +CommonLoops@Xerox.com. + +*** +The single most significant change is that discriminator-objects with +corresponding discriminating functions have been replaced by generic +function objects. What does this mean?? Well, in previous releases of +PCL, if you did: + +(defmethod foo ((x class)) 'class) +(defmethod foo ((x method)) 'method) + +Then (discriminator-named 'foo) returned a discriminator object which +had both of these methods defined on it. (symbol-function 'foo) +returned a discriminating function, which (discriminator-named 'foo) had +put in foo's function cell. + +In this release of PCL, the above defmethod's put a generic-function +object in foo's function cell. This generic-function object is a +combination of the discriminator object and discriminating function of +the previous releases of PCL. This generic-function object is +funcallable, funcalling it causes the appropriate method to be looked up +and called. This generic function object has accessors which return the +methods defined on the generic function. This generic function object +is mutable. It is possible to add and remove methods from it. + +(defmethod foo ((x class)) 'class) +(defmethod foo ((x method)) 'method) + +(generic-function-methods #'foo) +(# #) + +(foo (make 'class)) ==> 'class +(foo (make 'method)) ==> 'method + +(remove-method #'foo (car (generic-function-methods #'foo))) + +(foo (make 'class)) ==> 'class +(foo (make 'method)) ==> no matching method error + + +Note that as part of this change, the name of any function, generic +function or class which included the string "DISCRIMINATOR" has changed. +The name changes that happened were: + The class essential-discriminator was renamed to generic-function, + The class basic-discriminator and the class discrimiantor were + combined and renamed to standard-generic-function. + +If you went through your code and made the following name changes, you +would probably win, (this is what I did to PCL and it worked). + + essential-discriminator ==> generic-function + basic-discriminator ==> standard-generic-function + discriminator + (when it appears as a specializer) + ==> standard-generic-function + discriminator + (when it appears as part of a variable name or something) + ==> generic-function + +*** +In most Lisp implementations, method lookup is at least twice as fast as +it was in the previous release. + +*** +The compiler isn't called when PCL is loaded anymore. In a future +release, the compiler will also not be called when any other method +definitions are loaded. This is part of an effort to get PCL to a state +where the compiler will never be needed when compiled files are loaded. + +*** +PCL now has a mechanism for naming the generic-function's and method +functions defined by defmethod. This means that in ports of PCL which +take advantage of this mechanism, you will see useful function names in +the debugger rather than the useless gensym names that have been in the +past few releases. + +*** +Compiled files containing defmethod forms should be smaller and load +faster. + +*** +Many of the files in the system have been renamed. More files will be +renamed in upcoming releases. + +*** +An important part of the bootstrapping code has been re-written. The +remainder of this code (the BRAID1 and BRAID2 files) will be re-written +sometime soon. + +The changes made to bootstrapping in this release were done to make +early methods more understandable, and as part of implementing generic +function objects. Also, most users should find that PCL loads in less +time than it did before. + +The changes which will be made to bootstrapping in a future release will +make understanding the "Braid" stuff easier, and will make it possible +to implement slot-description objects as described in the CURRENT DRAFT +of the Common Lisp Object System Chapter 3. + +*** +The defsys file has been re-written AGAIN. This shouldn't affect users +since there are still the old familiar variables *pcl-pathname-defaults* +and *pathname-extensions*. + +*** +The specialized foo-notes files are all gone. Most of them were +hopelessly out of date, and installing pcl is now the same operation for +any Lisp. In particular, note that in Vaxlisp, it is no longer +necessary to push lisp:vaxlisp on the *features* list. + diff --git a/pcl/notes/4-21-87-notes.text b/pcl/notes/4-21-87-notes.text new file mode 100644 index 0000000..b1acd73 --- /dev/null +++ b/pcl/notes/4-21-87-notes.text @@ -0,0 +1,53 @@ + + +These notes correspond to *pcl-system-date* "4/21/87 April 21rst 1987". + +The notes from the last release are stored as 3-19-notes.text + +This release runs in: + ExCL + Lucid + Symbolics Common Lisp (Genera) + Vaxlisp (2.0) + Xerox Common Lisp (Lyric Release) + Kyoto Common Lisp (5.2) + +CMU Lisp (nee Spice) should be working soon, I will announce another +release at that time. + +Xerox Lisp users should FTP all the source files from /pub/pcl/ as well +as all the dfasl files from /pub/pcl/xerox/. Included in the xerox +specific directory is a file called PCL-ENV, which provides some simple +environment support for using PCL in Xerox Lisp. + + +The major difference in this release is that defclass conforms to the +CLOS specification (pretty much I hope). Previous warnings about what +would happen when defclass became CLOS defclass now apply. Once major +difference is that PCL currently does require that all a classes +superclasses be defined when a defclass form is evaluated. This will +change sometime soon. + +Other small changes include: + +Some more of the files have been renamed and restructured (as promised). + +the defclass parsing protocol has changed + +slotd datastructures are now instances of the class +standard-slot-description. + +a performance bug in the ExCL port which causes method lookup and slot +access to cons needlessly. + +a bug in the 3600 port which broke the printer for stack consed closures + +make-specializable + +a bug in Lucid lisp which made it impossible to say (compile-pcl) has +been patched around, this is the bug that manifested itself as NAME +being ubound. + + +As usual, please enjoy and send comments. + diff --git a/pcl/notes/4-29-87-notes.text b/pcl/notes/4-29-87-notes.text new file mode 100644 index 0000000..307b86e --- /dev/null +++ b/pcl/notes/4-29-87-notes.text @@ -0,0 +1,80 @@ + + +These notes correspond to *pcl-system-date* "4/29/87 prime April 29, 1987". + +The notes from the last release are stored as 4-21-notes.text + +This release runs in: + ExCL + Lucid + Symbolics Common Lisp (Genera) + Vaxlisp (2.0) + Xerox Common Lisp (Lyric Release) + Kyoto Common Lisp (5.2) + TI Common Lisp (Release 3) + +CMU Lisp (nee Spice) should be working soon, I will announce another +release at that time. + +TI release 2 should also be working soon, I will announce that when it +happens. + + +Note once again, that Xerox Lisp users should FTP all the source files +from /pub/pcl/ as well as all the dfasl files from /pub/pcl/xerox/. +Included in the xerox specific directory is a file called PCL-ENV, which +provides some simple environment support for using PCL in Xerox Lisp. +You must load PCL BEFORE loading pcl-env. + + +MAJOR CHANGES IN THIS RELEASE: + + make has been renamed to make-instance + + make-instance has been renamed to allocate-instance + +for compatibility, make can continue to be used as a synonym for +make-instance. unfortunately, code which used to call make-instance +must be converted. + +I would actually suggest that you do both of these name changes right +away. Two passes through the code using Query Replace seems to work +quite well (changing make-instance to allocate-instance and then make to +make-instance.) I was able to change all of PCL in about 10 minutes +that way. + +--- + +all functions and generic functions whose name included the string +"get-slot" have been renamed. Basically, get-slot was replaced +everywhere it appeared with slot-value. + +get-slot itself still exists for compatibility, but you should start +converting your code to use slot-value. + + + +OTHER CHANGES in this release: + +There is a new file called PKG which does the exports for PCL. PCL now +exports fewer symbols than before. Specifically, PCL now exports only +those symbols documented in the CLOS spec chapters 1 and 2. This means +that some symbols which may be needed by some programs are not exported. + +A good example is print-instance. print-instance is not exported and +since print-instance has not yet been renamed to print-object programs +which define methods on print-instance may want to import that symbol. + +--- + +pcl should load faster in this release. In particular, the file fixup +should load in less than half the time it did before. This release +should load in something like 80% of the time it took in the last +release. Remember, these numbers are only for comparison, your mileage +may vary. + +--- + +This release of PCL, as well as the last one, has *pcl-system-date* +which presents the date in both mm/dd/yy and Month day year format. + diff --git a/pcl/notes/5-22-87-notes.text b/pcl/notes/5-22-87-notes.text new file mode 100644 index 0000000..01aed9f --- /dev/null +++ b/pcl/notes/5-22-87-notes.text @@ -0,0 +1,126 @@ + + +These notes correspond to *pcl-system-date* "5/22/87 May 22nd, 1987". + +The notes from the last release are stored as 4-29-notes.text + +This release runs in: + CMU Lisp + ExCL + Lucid + Symbolics Common Lisp (Genera) + Vaxlisp (2.0) + Xerox Common Lisp (Lyric Release) + Kyoto Common Lisp (5.2) + TI Common Lisp (Release 3) + +TI release 2 should also be working soon, I will announce that when it +happens. + + +Note once again, that Xerox Lisp users should FTP all the source files +from /pub/pcl/ as well as all the dfasl files from /pub/pcl/xerox/. +Included in the xerox specific directory is a file called PCL-ENV, which +provides some simple environment support for using PCL in Xerox Lisp. +You must load PCL BEFORE loading pcl-env. + + +MAJOR CHANGES IN THIS RELEASE: + +--- + it is possible to forward reference classes in a defclass (or + add-named-class) form. This means it is possible to say: + + (defclass foo (bar) (i j k)) + + (defclass bar () (x y z)) + + Rather than having to put the in the "right" order. + + NOTE: the full-on error checking for this is not finished yet. + don't try to break it by doing things like: + + (defclass foo (bar) (i j k)) + (make-instance 'foo) + (defclass bar () (x y z)) + +--- + print-instance has been renamed to print-object + +--- + the defclass and class-definition protocol has changed. some of the +effects of this change are: + +* ADD-NAMED-CLASS is a true functional interface for defclass, so for + example, + + (defclass foo () (x y z) (:accessor-prefix foo-)) + + is equivalent to: + + (add-named-class (class-prototype (class-named 'class)) + 'foo + () + '(x y z) + '((:accessor-prefix foo-))) + +* defclass (and add-named-class) now undefined accessor methods, reader + methods and constructors which 'went away'. For example: + + (defclass foo () (x y z) (:reader-prefix foo-)) + + defines methods on the generic functions foo-x foo-y and foo-z. + + but if you then evaluated the defclass form: + + (defclass foo () (x y z)) + + those reader methods will be removed from the generic functions + foo-x foo-y and foo-z. + + Similarly constructors which 'went away' will be undefined. + +--- + writer methods generated by the :accessor and :accessor-prefix options + now pay attention to the :type slot-option. So, + + (defclass foo () ((x :accessor foo-x :type symbol))) + + (defvar *foo-1* (make-instance 'foo)) + + (setf (foo-x *foo-1*) 'bar) ; is OK + + (setf (foo-x *foo-1*) 10) ; signals an error + +--- + There are fewer built-in classes. Specifically, only the following + Common Lisp types have classes: + + ARRAY BIT-VECTOR CHARACTER COMPLEX CONS FLOAT INTEGER LIST + NULL NUMBER RATIO RATIONAL SEQUENCE STRING SYMBOL T VECTOR + +* In a future release the subtypes of FLOAT may have classes, that issue + is still under discussion. + +* Some ports of PCL also define classes for: + + HASH-TABLE PACKAGE PATHNAME RANDOM-STATE READTABLE STREAM + + it depends on how the type is represented in that Lisp's type system. + + +--- + The with-slots option :use-slot-value is now obsolete. You should use + the :use-accessors option as specified in the CLOS spec instead. + + with-slot forms which did not use the :use-slot-value option are OK, + you don't have to touch them. + + with-slot forms which used :USE-SLOT-VALUE T should be changed to say + :USE-ACCESSORS NIL. + + with-slot forms which used :USE-SLOT-VALUE NIL should be changed to + use neither option, or if you insist :USE-ACCESSORS T + + + diff --git a/pcl/notes/5-22-89-notes.text b/pcl/notes/5-22-89-notes.text new file mode 100644 index 0000000..3f198d8 --- /dev/null +++ b/pcl/notes/5-22-89-notes.text @@ -0,0 +1,152 @@ +Copyright (c) Xerox Corporation 1989. All rights reserved. + +These notes correspond to the "5/22/89 Victoria PCL" version of PCL. + +Please read this entire file carefully. Failure to do so guarantees +that you will have problems porting your code from the previous release +of PCL. + +You may also be interested in looking at previous versions of the +notes.text file. These are called xxx-notes.text where xxx is the +version of the PCL system the file corresponds to. At least the last +two versions of this file contain useful information for any PCL user. + +This version of PCL has been tested at PARC in the following Common +Lisps: + + Symbolics 7.2, 7.4 + Coral 1.2 + Lucid 3.0 + IBCL (October 15, 1987) + Allegro 3.0.1 + Golden Common Lisp 3.1 + EnvOS Medley + +These should work, but haven't been tested yet: + + TI + +This release is similar to Cinco de Mayo and Passover PCL. The major +difference is that this release actually works. + +*** + +*other-exports* flushed. More exports now on *exports* + +The symbol STANDARD is now exported from the PCL package. standard-class +standard-method standard-generic-function standard-object built-in-class +structure-class + +scoping problem with *next-methods* + + +method and generic function initialization protocol + +methods are immutable + +type-specifiers --> specializers + +load-truename etc. + +defgeneric ensure-generic-function define-method-combination + +metabraid changes + +file namings + +*** + +There are a number of minor and one major difference between this +release and No Cute Name PCL. + + +- In the last release there was an implementation of the specified CLOS +initialization protocol. This implementation had the correct behavior, +but some of the generic functions had temporary names (*make-instance, +*initialize-instance and *default-initargs). This was done to give +people time to convert their code to the behavior of the new +initialization protocol. + +In this release, all generic functions in the specified initialization +protocol have their proper names. The implementation of the old, +obsolete initialization protocol has disappeared entirely. + +The following renamings have happened: + + 12/7/88 release this release + + *make-instance make-instance + *initialize-instance initialize-instance + *default-initargs default-initargs + +The functions shared-initialize and reinitialize-instance already had +the proper names. + +The new initialization protocol is documented fully in the 88-002R +specification. + +As part of this change, PCL now uses the new initialization protocol to +create metaobjects internally. That is it calls make-instance to create +these metaobjects. The actual initargs passed are not yet as specified, +that will be in a later release. + +This is the largest change in this release. If you have not already +started using the new initialization protocol (with the temporary *xxx +names) you are going to have to do so now. In most cases, old methods +on the generic functions INITIALIZE, INITIALIZE-FROM-DEFAULTS and +INITIALIZE-FROM-INIT-PLIST must be substantially rewritten to convert +them to methods on INITIALIZE and SHARED-INITIALIZE. + +- slots with :ALLOCATION, :CLASS now inherit properly. As part of this +change, some slot description objects now return a class object as the +result of SLOTD-ALLOCATION. + +- There is now a minimal implementation of the DEFGENERIC macro. This +implementation supports no options, but it does allow you to define a +generic function in one place and put some comments there with it. + +- The following functions and macros have disappeared. This table also + show briefly what you use instead. + + DEFMETHOD-SETF (use DEFMETHOD) + RUN-SUPER (use CALL-NEXT-METHOD) + OBSOLETE-WITH-SLOTS (use WITH-SLOTS or WITH-ACCESSORS) + SYMBOL-CLASS (use FIND-CLASS) + CBOUNDP (use FIND-CLASS) + CLASS-NAMED (use FIND-CLASS) + GET-SETF-GENERIC-FUNCTION (use GDEFINITION) + +- In certain ports, method lookup will be faster because of a new scheme +to deal with interrupts and the cache code. In other ports it will be +slightly slower. In all ports, the cache code now interacts properly +with interrupts. + +- DEFMETHOD should interact properly with TRACE, ADVISE etc. in most +ports. two new port-specific functions (in defs.lisp) implement this. +These are unencapsulated-fdefinition and fdefine-carefully. If this +doesn't work properly in your port, fix the definition of these +functions and send it back so it can be in the next release. + +- This release runs in Golden Common Lisp version 3.0. + +- Previously, the use of slot-value (or with-slots) in the body of a +method which had an illegal specializer gave strange errors. Now it +gives a more reasonable error message. + +- An annoying problem which caused KCL and friends to complain about +*exports* being unbound has been fixed. + +- The walker has been modified to understand the ccl:%stack-block +special form in Coral Common Lisp. + +- The use of defadvice in pre 3.0 releases has been fixed in Lucid Low. + +- multiple-value-setq inside of with-slots now returns the correct +value. + +- A minor bug having to do with macroexpansion environments and the KCL +walker has been fixed. + +- A bug in the parsing of defmethod which caused only symbols (rather +than non-nil atoms) to be used as qualifiers. + diff --git a/pcl/notes/8-28-88-notes.text b/pcl/notes/8-28-88-notes.text new file mode 100644 index 0000000..854a90b --- /dev/null +++ b/pcl/notes/8-28-88-notes.text @@ -0,0 +1,537 @@ +Copyright (c) Xerox Corporation 1988. All rights reserved. + + +These notes correspond to the "8/24/88 (beta) AAAI PCL" version of PCL. + +Please read this entire document carefully. + +There have been a number of changes since the 8/2/88 version of PCL. As +usual, these changes are part of our efforts to make PCL conform with +the CLOS specicification (88-002R). This release contains the big +changes which the 7/7 through 8/2 releases were really getting ready +for. + +This version of PCL has been tested at PARC in the following Common +Lisps: + + Symbolics 7.2 + Coral 1.2 + Lucid 3.0 + Franz ?? + Xerox Lyric + Xerox Medley (aka EnvOS Medley) + KCL (October 15, 1987) + + +Most of the changes in this version of PCL fall into one of two +categories. + +The first major set of changes makes the order of arguments to setf +generic functions and methods conform with the spec. In addition, these +changes allow the first argument to defmethod to be of the form (SETF +). + +The second major set of changes have to do with slot access and instance +structure. Importantly, PCL now checks to see if a slot is bound, and +calls slot-unbound if the slot is unbound. This is a major change from +previous releases in which slot access just returned NIL for slots which +had not yet been set. These changes affect all the functions which +access the slots of an instance. In addition, the generic functions +which are called by the slot access functions in exceptional +circumstances are affected. This set of changes also include the +implemenentation of the real initialization protocol as specified by +88-002R. + +In addition, there are a number of other changes. The most significant +of these has to do with the symbols which the PCL package exports by +default. + +The rest of this document goes on to first describe the slot access +changes, then describe the setf generic function changes, and finally +describe some of the other minor changes. + +At the very end of this file is a new section which lists PCL features +which are scheduled to disappear in future releases. Please read this +section and take it to heart. This features will be disappearing. + + +*** Changes to slot access and instance structure *** + +This release includes a number of changes to the way slot access works +in PCL. Some of these changes are incompatible with old behavior. Code +which was written with the actual CLOS spec in mind should not be +affected by these incompatible changes, but some older code may be +affected. + +The basic thrust of the changes to slot access is to bring the following +functions and generic functions in line with the specification: + + slot-boundp + slot-exists-p + slot-makunbound + slot-missing + slot-unbound + slot-value + + slot-boundp-using-class + slot-exists-p-using-class + slot-makunbound-using-class + slot-value-using-class + + (setf slot-value) + (setf slot-value-using-class) + + change-class + make-instances-obsolete + + make-instance (temporarily called *make-instance) + initialize-instance (temporarily called *initialize-instance) + reinitialize-instance + update-instance-for-different-class + update-instance-for-redefined-class + shared-initialize + +In this release, these functions accept the specified number of +arguments, return the specified values, have the specified effects, and +are called by the rest of PCL in the specified way at the specified +times (with the exception that PCL does not yet call *make-instance to +create its own metaobjects). Because PCL now checks for unbound slots, +you may notice a slight performance degradation in certain applications. + +For complete information, you should of course see the CLOS specification. +The rest of this note is a short summary of how this new behavior is +different from the last release. + +- Dynamic slots are no longer supported. Various functions like + slot-value-always and remove-slot no longer exist. Also, + slot-value-using-class now only accepts the three arguments as + described in the spec. The two extra arguments having to do with + dynamic slots are no longer accepted. + + Shortly, we will release a metaclass which provides the now missing + dynamic slot behavior. + +- slot-missing now receives and accepts different arguments. + +- slot-unbound is now implemented, and is called at the appropriate + times. + +- the initialization protocol specified in 88-002R is now almost + completely implemented. The only difference is that the current + implementation does not currently check the validity of initargs. + So, no errors are signalled in improper initargs are supplied. + + Because of name conflicts with the two other initialization protocols + PCL currently supports, some of the specified initialization functions + do not have their proper name. The mapping between names in the + specification and names in this version of PCL is as follows: + + SPECIFIED IN PCL + + make-instance *make-instance + initialize-instance *initialize-instance + reinitialize-instance + update-instance-for-different-class + update-instance-for-redefined-class + shared-initialize + + + In a future release of PCL, these functions will have their proper + names, and all the old, obsolete initialization protocols will + disappear. + + Convert to using this new wonderful initialization protocol soon. + + Sometime soon we will release a version of PCL which does significant + optimization of calls to make-instance. This should speed up instance + creation dramatically, which should significantly improve the + performance of some programs. + +- The function all-slots no longer exists. There is a new generic + function called slots-to-inspect, which controls the default behavior + of describe. It also controls the default behavior of the inspector + in ports which have connected their inspectors to PCL. It specifies + which slots of a given class should be inspected. See the definition + in the file high.lisp for more. + +- the metaclass obsolete-class no longer exists. The mechanism by which + instances are marked as being obsolete is now internal, as described + in the spec. The generic-function make-instances-obsolete can be used + to force the instances of a class to go through the obsolete instance + update protocol (see update-instance-for-redefined-class). + +- all-std-class-readers-miss-1, a generic function which was part of + the database interface code I sent out a few weeks ago, has a slightly + different argument list. People using the code I sent out a few weeks + ago should replace the definition there with: + + (defmethod all-std-class-readers-miss-1 + ((class db-class) wrapper slot-name) + (declare (ignore wrapper slot-name)) + ()) + +- The implementation of the slot access generic functions have been + considerably streamlined. The impenetrable macrology which used to be + used is now gone. + +- Because the behavior of the underlying slot access generic functions + has changed, it is possible that some user code which hacks the + underlying instance structure may break. Most of this code shouldn't + break though. There have been some questions on the mailing list + about what is the right way to modify the structure of an instance. + I am working on that section of chapter 3 right now, and will answer + those questions sometime soon. + + +*** Changes to SETF generic functions *** + +This release of PCL includes a significant change related to the order +of arguments of setf generic functions. To most user programs, this +change should be invisible. Your program should run just fine in the +new version of PCL. Even so, there is some conversion you should do to +your program, since DEFMETHOD-SETF is now obsolete and will be going +away soon. + +Some programs may take some work to adapt to this change. This will +be particularly true of programs which manipulated methods for setf +generic-functions using make-instance, add-method and friends. + +Included here is a brief overview of this change to PCL. Most people +will find that this is all they need to know about this change. + +The CLOS specification assumes a default behavior for SETF in the +absence of any defsetf or define-modify-macro. The default behavior is +to expand forms like: + + (SETF (FOO x y) a) + +into: + + (FUNCALL #'(SETF FOO) a x y) + +The key point is that by default, setf expands into a call to a function +with a well-defined name, and that in that call, the new value argument +comes before all the other arguments. + +This requires a change in PCL, because previously, PCL arranged for the +new-value argument to be the last required argument. This change +affects the way automatically generated writer methods work, and the way +that defmethod with a first argument of the form (SETF ) works. + +An important point is that I cannot implement function names of the form +(SETF ) portably in PCL. As a result, in PCL, I am using names +of the form |SETF FOO|. Note that the symbol |SETF FOO| is interned in +the home package of the symbol FOO. (See the description of the +GET-SETF-FUNCTION and GET-SETF-FUNCTION-NAME). + + +The user-visible changes are: + +- DEFMETHOD will accept lists of the form (SETF FOO) as a first + argument. This will define methods on the generic function named + by the symbol |SETF FOO|. As specified in the spec, these methods + should expect to receive the new-value as their first argument. + Calls to defmethod of this form will also arrange for SETF of FOO to + expand into an appropriate call to |SETF FOO|. + +- Automatically generated writer methods will expect to receive the new + value as their first argument. + +- DEFMETHOD-SETF will also place the new-value as the first argument. + This is for backward compatibility, since defmethod-setf itself will + be obsolete, and you should convert your code to stop using it. + +- GET-SETF-FUNCTION is a function which takes a function name and + returns the setf function for that function if there is one. Note + that it doesn't take an environment argument. Note that this function + is not specified in Common Lisp or CLOS. PCL will continue to support + it as an extra export indefinetely. + +- GET-SETF-FUNCTION-NAME is a function which takes a function name + and returns the symbol which names the setf function for that + function. Note that this function is not specified in Common Lisp + or CLOS. PCL will continue to support it as an extra export + indefinetely. + +- For convenience, PCL defines a macro called DO-STANDARD-DEFSETF which + can be used to do the appropriate defsetf. This may be helpful for + programs which have calls to setf of a generic-function before any + of the generic function's method definitions. A use of this macro + looks like: + + (do-standard-defsetf position-x) + + Afterwards, a form like (SETF (POSITION-X P) V) will expand into a + form like (|SETF POSITION-X| V P). + + The reason you may have to use do-standard-defsetf is that I cannot + portably change every implementations SETF to have the new default + behavior. The proper way to use this is to take an early file in + your system, and put a bunch of calls to do-standard-defsetf in it. + Note that as soon as PCL sees a defmethod with a name argument of + the form (SETF FOO), or it sees a :accessor in a defclass, it will + do an appropriate do-standard-defsetf for you. + + +In summary, the only things that will need to be changed in most +programs is that uses of defmethod-setf should be converted to +appropriate uses of defmethod. + +Here is an example of a typical user program which is affected by this +change. + +(defclass position () + ((x :initform 0 :accessor pos-x) + (y :initform 0 :accessor pos-y))) + +(defclass monitored-position (position) + ()) + +(defmethod-setf pos-x :before ((p monitored-position)) (new) + (format *trace-output* "~&Changing x coord of ~S to ~D." p new)) + +(defmethod-setf pos-y :before ((p monitored-position)) (new) + (format *trace-output* "~&Changing y coord of ~S to ~D." p new)) + + +To bring this program up to date, you should convert the two +defmethod-setf forms as follows: + +(defmethod (setf pos-x) :before (new (p monitored-position)) + (format *trace-output* "~&Changing x coord of ~S to ~D." p new)) + +(defmethod (setf pos-y) :before (new (p monitored-position)) + (format *trace-output* "~&Changing y coord of ~S to ~D." p new)) + + +*** Other changes in this release *** + +* The symbols exported by the PCL package have now changed. The PCL +package now exports the symbols listed in the table of contents of +chapter 2 of the spec. This list of symbols is the value of the +variable pcl::*exports*. + +Following is the list of symbols which were exported in the 8/2/88 +version but which are not exported in the 8/18/88 version. + +DEFMETHOD-SETF DEFGENERIC-OPTIONS DEFGENERIC-OPTIONS-SETF +CLASS-CHANGED CLASS-NAMED SYMBOL-CLASS +CBOUNDP GET-METHOD GET-SETF-GENERIC-FUNCTION +MAKE-METHOD-CALL + +Following is the list of symbols which are exported in the 8/18/88 +version, but which were not exported in previous versions: + +CALL-METHOD CLASS-NAME COMPUTE-APPLICABLE-METHODS +DEFGENERIC ENSURE-GENERIC-FUNCTION FIND-METHOD +FUNCTION-KEYWORDS GENERIC-FLET GENERIC-LABELS +INITIALIZE-INSTANCE MAKE-INSTANCES-OBSOLETE NO-APPLICABLE-METHOD +NO-NEXT-METHOD REINITIALIZE-INSTANCE SHARED-INITIALIZE +SLOT-BOUNDP SLOT-EXISTS-P SLOT-MAKUNBOUND +SLOT-MISSING SLOT-UNBOUND SYMBOL-MACROLET +UPDATE-INSTANCE-FOR-DIFFERENT-CLASS +UPDATE-INSTANCE-FOR-REDEFINED-CLASS +WITH-ADDED-METHODS + +It should be noted that not all of these newly exported symbols have +been "implemented" yet. + + +* Any program written using PCL will need to be completely recompiled +to run with this release of PCL. + +* The generic-function generic-function-pretty-arglist now returns a +nice arglist for any generic function. It combines all the keyword +arguments accepted by the methods to get the combined set of keywords. +In some ports, the environment specific ARGLIST function has been +connected to this, and so the environments will print out nice arglists +for generic functions. + +* Some bugs in trace-method have been fixed. Trace-method should now +work in all ports of PCL. + +* NO-MATCHING-METHOD has been renamed to NO-APPLICABLE-METHOD. In +addition, it now receives arguments as specified. + +* defmethod has been modified to allow macros which expand into +declarations. + +* The :documentation slot option is now accepted in defclass forms. The +documentation string put here cannot yet be retrieved using the +documentation function. That will happen in a later release. + +* The :writer slot option is now implemented. + +* Some brain damage in high.lisp which caused method lookup to work +incorrectly for built in classes. In addition, it caused the +class-local-supers and class-direct-subclasses of the built in classes +to be strange. People using CLOS browsers should notice this change +dramatically, as it will make the browse of the built in part of the +class lattice look right. + + +*** Older Changes *** + +Following are changes which appeared in release of PCL from 7/7/88 to +8/2/88. Each change is marked with the release it appeared in. + + + +8/2/88 +Loading defclass forms should be much faster now. The bug which caused +all the generic functions in the world to be invalidated whenever a +class was defined has now been fixed. + +Loading defmethod forms should also be much faster. A bug which caused +a tremendous amount of needles computation whenever a method was also +fixed. + + + +8/2/88 +A bug which caused several slots of the classes T, OBJECT, CLASS and +STANDARD-CLASS to be unbound has been fixed. + + + +8/1/88 +load-pcl now adds the symbols :PCL and :PORTABLE-COMMONLOOPS to +*features*. + +PCL still doesn't do any sort of call to PROVIDE because of the total +lack of uniformity in the behavior of require and provide in the various +common lisp implementations. + + +8/1/88 +This version of PCL finally fixes the horrible bug that prevented +the initform for :class allocation slots from being evaluated when the +class was defined. + + +7/20/88 +PCL now converts the function describe into a generic function of one +argument. This is to bring it into conformance with the spec as +described in 88-002. + +In Symbolics Genera, it is actually a function of one required and one +optional argument. This is because the 3600 sometimes calls describe +with more than one argument. + +In Lucid Lisp, describe only takes an optional argument. This argument +defaults to the value of *. PCL converts describe to a generic function +of one required argument so it is not possible to call describe with +only one argument. + + +7/7/88 +class-named and symbol-class have been replaced by find-class. +find-class is documented in 88-002R. + + +7/7/88 +with-slots and with-accessors now conform to 88-002R. + +The old definition of with-slots is now called obsolete-with-slots. The +same is true for with-accessors. + + with-slots ---> obsolete-with-slots + with-accessors --> obsolete-with-accessors + +The temporary correct definition of with-slots, with-slots* is now +called with-slots. The same is true for with-accessors*. + + with-slots* --> with-slots + with-accessors* -> with-accessors + + +7/7/88 +The class-precedence list of the class null now conforms to 88-002R. + +In previous releases of PCL, the class precedence-list of the class +null was: (null list symbol sequence t). In this release the class +precedence list of the class null is: (null symbol list sequence t). + +This change was made to bring PCL into conformance with the spec. + + + +7/7/88 + +print-object now takes only two arguments. + +This changes was made to begin bringing print-object in conformance with +88-002R. print-object conforms to the spec to the extent that is is +called at the approrpiate times for PCL instances. In most +implementations, it is not called at the appropriate times for other +instances. This is not under my control, encourage your vendor to +provide the proper support for print-object. + + +7/7/88 +This version of PCL now includes a beta test version of a new iteration +package. This iteration package was designed by Pavel Curtis and +implemented by Bill vanMelle. This iteration package is defined in the +file iterate.lisp. Please feel free to experiment with it. We are all +very interested in comments on its use. + + + +*** PCL Features that will be disappearing *** + +This section describes features in PCL that will be disappearing in +future releases. For each change, I try to give a release date after +which I will feel free to remove this feature. This list should not be +considered complete. Certain other PCL features will disappear as well. +The items on this list are the user-interface level items that it is +possible to give a lot of warning about. Other changes will have more +subtle effects, for example when the lambda-list congruence rules are +implemented. + +- :accessor-prefix in defclass + +Can disappear anytime after 8/29. + +Warning that this is obsolete has been out for some time. You should +use :accessor in each of the slot specifications of the defclass form. +It is true that this is slightly more cumbersome, but the semantic +difficulties associated with :accesor-prefix are even worse. + +- :constructor in defclass + +Can disappear anytime after 8/29. + +Warning that this is obsolete has been out for some time. It will be +disappearing shortly because the intialization protocol which it goes +with will be disappearing. A future release of PCL will support a +special mechanism for defining functions of the form: + +(defun make-foo (x y &optional z) + (make-instance 'foo 'x x :y y :z z)) + +In the case where there are only :after methods on initialize-instance +and shared-initialize, these functions will run like the wind. We hope +to release this facility by 9/15. + +- old definition of make-instance, intialize, initialize-from-defaults, + initialize-from-init-plist + +Can disappear anytime after 8/29. + +Convert to using the new initialization protocol as described in the +spec and above. + +- mki, old definition of initialize-instance + +Can disappear anytime after 8/29. + +Convert to using the new initialization protocol as described in the +spec and above. + +- defmethod-setf + +Can disappear anytime after 9/15. + +Convert to using (defmethod (setf foo) ... + + diff --git a/pcl/notes/get-pcl.text b/pcl/notes/get-pcl.text new file mode 100644 index 0000000..472f414 --- /dev/null +++ b/pcl/notes/get-pcl.text @@ -0,0 +1,180 @@ +Here is the standard information about PCL. I have also added you to +the CommonLoops@Xerox.com mailing list. + +Portable CommonLoops (PCL) started out as an implementation of +CommonLoops written entirely in CommonLisp. It is in the process of +being converted to an implementation of CLOS. Currently it implements a +only a subset of the CLOS specification. Unfortunately, there is no +detailed description of the differences between PCL and the CLOS +specification, the source code is often the best documentation. + + Currently, PCL runs in the following implementations of + Common Lisp: + + EnvOS Medley + Symbolics (Release 7.2) + Lucid (3.0) + ExCL (Franz Allegro 3.0.1) + KCL (June 3, 1987) + AKCL (1.86, June 30, 1987) + Ibuki Common Lisp (01/01, October 15, 1987) + TI (Release 4.1) + Coral Common Lisp (Allegro 1.2) + Golden Common Lisp (3.1) + CMU + VAXLisp (2.0) + HP Common Lisp + Pyramid Lisp + +There are several ways of obtaining a copy of PCL. + +*** Arpanet Access to PCL *** + +The primary way of getting PCL is by Arpanet FTP. + +The files are stored on arisia.xerox.com. You can copy them using +anonymous FTP (username "anonymous", password "anonymous"). There are +several directories which are of interest: + +/pcl + +This directory contains the PCL sources as well as some rudimentary +documentation (including this file). All of these files are combined +into a single Unix TAR file. The name of this file is "tarfile". + +Extract the individual files from this tarfile by saying: + +tar -xf tarfile * + +where `tarfile' is the name you have given the tarfile in your +directory. Once you have done this, the following files are of special +interest: + +readme.text READ IT + +notes.text contains notes about the current state of PCL, and some + instructions for installing PCL at your site. You should + read this file whenever you get a new version of PCL. + +get-pcl.text contains the latest draft of this message + + +/pcl/doc + +This directory contains TeX source files for the most recent draft of +the CLOS specification. There are TeX source files for two documents +called concep.tex and functi.tex. These correspond to chapter 1 and 2 +of the CLOS specification. + + +/pcl/archive + +This directory contains the joint archives of two important mailings +lists: + + CommonLoops@Xerox.com + + is the mailing list for all PCL users. It carries announcements + of new releases of PCL, bug reports and fixes, and general advice + about how to use PCL and CLOS. + + Common-Lisp-Object-System@Sail.Stanford.edu + + is a small mailing list used by the designers of CLOS. + +The file cloops.text is always the newest of the archive files. + +The file cloops1.text is the oldest of the archive files. Higher +numbered versions are more recent versions of the files. + +*** Getting PCL on Macintosh floppies *** + +PCL is listed in APDAlog. It is distributed on Macintosh floppies. +This makes it possible for people who don't have FTP access to arisia +(but who do have a Macintosh) to get PCL. + +For $40 you receive a version of PCL and a copy of the CLOS spec (X3J13 +document number 88-002R). The APDAlog catalog number is T0259LL/A and +you can order by calling: + + From the U.S. (800)282-2732 + From Canada (800)637-0029 + International (408)562-3910 + FAX (408)562-3971 + + +NOTE: Whenever there is a new release of PCL you want, you should +probably wait a couple of months before ordering it from APDAlog. We +want to let new PCL's stabilize a bit before sending it to them, and it +will take them some time to integrate the new disks into their +distribution. + +*** Using the BITFTP server at Princeton *** + +For people who can't FTP from Internet (Arpanet) hosts, but who have +mail access to the BITNET, there exists a way to get the PCL files using +the BITFTP service provided by Princeton University. If you know exactly +where to find the files that interest you, this is quite easy. In +particular, you have to know: + + * the Internet host name of the host that maintains the files (such + as `arisia.Xerox.COM') + * the directory where to find the files, relative to the root of the + FTP tree (i.E. `pub') + * whether the files are binary or ASCII text. + * the names of the files (say `pcl90.tar.Z' and `pcl90.README') + +To do this, send a message to BITFTP@PUCC (or BITFTP@PUCC.BITNET if you +aren't on BITNET itself). The subject line of the message will be +ignored. The text (body) of the message should be: + + FTP arisia.xerox.com UUENCODE + CD pcl + BINARY + GET tarfile + QUIT + +Then you wait (probably for about a day when you are in Europe) and +eventually you will receive E-Mail messages from BITFTP@PUCC (or +BITFTP2%PUCC...) with subject lines like `uudecoded file tarfile part +13'. Then you have to carefully concatenate the contents of ALL of +these files in the correct order. + + Note: The following works on our Suns and should work on any + Berkeley UNIX machine. If you don't have the `compress' or `zcat' + program, you can get a free version (with MIT's X Window System + distribution, for example). + +The resulting file can be `uudecode'd like this: + + dagobert% uudecode name-of-the-assembled-file + +This will give you a file tarfile.Z (it may actually have a different +name; then you may want to rename it in the first place). The `.Z' at +the end means that the file you now have is compressed. You can +uncompress it with `uncompress tarfile. You can untar the uncompressed +file with `tar -xvf tarfile'. + +This will write all files in the tarfile to the current directory. + +If you want to know more about the BITFTP service, send a letter to +`BITFTP@PUCC' that contains the single line `HELP'. + +*** Xerox Internet Access to PCL *** + +Xerox XNS users can get PCL from {NB:PARC:XEROX} + + + +Send any comments, bug-reports or suggestions for improvements to: + + CommonLoops.pa@Xerox.com + +Send mailing list requests or other administrative stuff to: + + CommonLoops-Request@Xerox.com + + +Thanks for your interest in PCL. +---------- + diff --git a/pcl/notes/lap.text b/pcl/notes/lap.text new file mode 100644 index 0000000..b7419f7 --- /dev/null +++ b/pcl/notes/lap.text @@ -0,0 +1,655 @@ +-*- Mode: Text -*- + +Copyright (c) 1985, 1986, 1987, 1988, 1989 Xerox Corporation. +All rights reserved. + +Use and copying of this document is permitted. Any distribution of this +document must comply with all applicable United States export control +laws. + +Last updated: 6/3/89 by Gregor + 10/26/89 by Gregor -- added :RETURN, removed :ISHIFT + +This file contains documentation of the PCL abstract LAP code. Any port +of PCL is required to implement the abstract LAP code interface. There +is a portable, relatively good performance implementation in the file +lap.lisp, port-specific implementations are in that file as well. + +The PCL abstract LAP code mechanism exists to provide PCL with a way to +create high-performance method lookup functions. Using this mechanism, +PCL can produce "LAP closures" which do the method lookup. By allowing +PCL to specify these closures using abstract LAP code rather that Lisp +code we hope to achieve the following: + + * Better runtime performance. By using abstract LAP code, we + will get better machine instruction sequences than we would + from compiling Lisp code. + + * Better load and update time performance. Because it should + be possible to "assemble" the LAP code more quickly than + compiling Lisp code, PCL will spend less time building the + method lookup code. + + * Ability to use PCL without a compiler. The LAP assembler will + still be required but this should be much smaller than the full + lisp compiler. + +Of course, not all implementations of the LAP code mechanism will +satisfy all of these goals. The first is the most important. + +In particular, many PCL ports will use the portable LAP implementation. +KCL will use the portable implementation in all of its ports. Other +Lisps may have custom LAP implementations for some ports and use the +portable implementation for other ports. + +Some Lisps will have a custom LAP implementation but will nonetheless +require the compiler to be loaded to generate LAP closure constructors. + +An important point is why we have chosen to take this route rather than +have each implementation implement the method lookup codes itself. This +was done because we are, at PARC, just beginning to study cache behavior +for CLOS programs. As we learn more about this we will want to modify +the caching strategy PCL uses. This architecture, because it leaves +PCL to implement caching behavior makes it possible to do this. Once +this study is complete, implementations may want to do their own, ultra +high performance implementations of caching strategies. + + + +Production of LAP closures is a two step process. In the first step, a +port-specific function is called to take abstract LAP code and produce a +a "lap closure generator". Lap closure generators are functions which +are called with a set of closure variable values and return a LAP +closure. + +The intermediary of the lap closure generators provides an important +optimization. Because it is assumed that producing the LAP closure +generator can take much longer than producing a LAP closure from the +generator, PCL attempts to make only one closure generator for each +sequence of LAP code. Because of the way PCL generates the LAP code +sequences, this is quite easy for it to do. + +The rest of this document is divided into six parts. + + * the metatypes std-instance and fsc-instance + + * an abstraction for simple vector indices + + * important optimizations + + * the port specific function for making lap closure generators + + * the actual abstract LAP code + + * examples + +*** The metatypes STD-INSTANCE and FSC-INSTANCE *** + +In PCL, instances with metaclass STANDARD-CLASS are represented using +the metatype STD-INSTANCE. (Note that in Cinco de Mayo PCL, this +metatype is called IWMC-CLASS.) Each port must implement this metatype. +The metatype could be implemented by the following DEFSTRUCT. + + (defstruct (std-instance + (:predicate std-instance-p) + (:conc-name %std-instance-) + (:constructor %allocate-std-instance (wrapper slots)) + (:constructor %allocate-std-instance-1 ()) + (:print-function print-std-instance)) + (wrapper nil) + (slots nil)) + + PCL itself will guarantee correct access to this structure and the + accessors and constructors. With this in mind, the following are + important. + + * Being able to type test this structure quickly is critical. See + the :STD-INSTANCE-P opcode. + + * The allocation functions should compile inline, do no argument + checking and be as fast as possible. + + * The accessor functions should compile inline, do no checking of their + arguments and be as fast as possible. SETF of the accessors should + do the same. + +The port is also required to implement the metatype FSC-INSTANCE (called +FUNCALLABLE-INSTANCE, or FIN for short, in Cinco de Mayo PCL). Objects +with this metatype are used, among other things, to implement generic +functions. These objects have field structure associated with them and +are also functions that can be applied to arguments. The fields are the +same as those for STD-INSTANCE, the FSC-INSTANCE metatype has +predicates, print-functions, constructors and accessors as follows: + + fsc-instance-p + print-fsc-instance + %fsc-instance-wrapper + %fsc-instance-slots + %allocate-fsc-instance (wrapper slots) + %allocate-fsc-instance-1 () + +In addition, objects of metatype FSC-INSTANCE have a property called the +funcallable instance function. When an FSC-INSTANCE is applied to +arguments, the funcallable instance function is what is actually called. +The funcallable instance function of an FSC-INSTANCE can be changed +using the function SET-FUNCALLABLE-INSTANCE-FUNCTION. There is no +mechanism for obtaining the funcallable instance function of an +FSC-INSTANCE. + +It is possible to implement the FSC-INSTANCE metatype in pure Common +Lisp. A simple implementation which uses lexical closures as the +instances and a hash table to record that the lexical closures are of +metatype FSC-INSTANCE is easy to write. Unfortunately, this +implementation adds significant overhead: + + to generic-function-invocation (1 function call) + to slot-access (1 function call or one hash table lookup) + to class-of a generic-function (1 hash-table lookup) + +In addition, it would prevent the FSC-INSTANCEs from being garbage +collected. In short, the pure Common Lisp implementation really isn't +practical. + +Note that previous implementations of FINS were always based on the +lexical closure metatype. In some ports, that provides poor +performance. Those ports may want to consider reimplementing to use the +compiled code metatype. In that implementation strategy, LAP closure +variables would become constants of the compiled code object. + +The following note from JonL is of interest when working on a FIN +implementation: + + Date: Tue, 16 May 89 05:45:56 PDT + From: Jon L White + + This isn't a bug in Lucid's compiler -- it's a lurking bug in PCL + that will "bite" most implementations where different settings of + the compiler optimization switches will produce morphologically + different (but of course functionally equivalent) function objects. + + The difficulty is in how discriminator codes service cache misses. + They "call out" to (potentially) random functions that will in some + cases "smash" the function object that was actually running as the + discriminator code. This is all right providing you don't return to + that function frame, but alas ... + + I know this is a more extensive problem because the code in the + port-independent function 'notice-methods-change' goes out of + its way to do a tail-recursive call to the function that is going + to smash the possibly-executing discriminator code. Here is the + commentary from that code (sic): + + ;; In order to prevent this we take a simple measure: we just + ;; make sure that it doesn't try to reference our its own closure + ;; variables after it makes the dcode change. This is done by + ;; having notice-methods-change-2 do the work of making the change + ;; AND calling the actual generic function (a closure variable) + ;; over. This means that at the time the dcode change is made, + ;; there is a pointer to the generic function on the stack where + ;; it won't be affected by the change to the closure variables. + + + A similar thing should be done in the construction of standard-accessor, + checking, and caching dcodes. In an experimental version here at Lucid, + I rewrote dcode.lisp to do that, and there is no problem with it. + Although that code is somewhat Lucid-specific, it could be of help to + someone who wanted to rewrite the generic dcode.lisp (no pun intended). + Contact me privately if you are interested. + + Doing a tail-recursive call out of dcodes when there is a cache miss + is a good thing, regardless of other problems. I think one might as + well do it. However, I should point out that in the presence of + multiprocessing, there is another more serious problem that cannot be + solved so simply. Think about what happens when one process decides + to update a dcode while another process is still using it; no such + stack-maintenance discipline will fix this case. A tail-recursive + exit from the dcode will *immensely* reduce the likelihood that + another process can sneak in during the interval in which the dcode + requires consistency in its function; but it can't reduce that + likelihood to zero. + + The more desirable thing to do is to put the whole "dcode" down one + more level of indirection through the symbol-function cell of the + generic function. This is effectively what PCL's 'make-trampoline' + function does, but unfortunately that is not a very efficient approach + when you consider how most compilers will compile it. Something akin + to the "mattress-pads" in Steve Haflich's code (in the fin.lisp file) + could probably be done for many other implementations as well. + + +*** Index Operations *** + +Indexes are an abstraction for indexes into a simple vector. This +abstraction is used to make it possible to generate more efficient +code to access simple vectors. The idea being that this may make it +possible to use alternate addressing modes to address these. + +The "index value" of an index is defined to be the fixnum of which that +index is an alternate form. So, using the Lisp function SVREF with the +index value of an index accesses the same element as using the index +with the appropriate access function or operand. + +The format of an index is unspecified, but is assumed to be something +like a fixnum with certain bits ignored. Accessing a vector using an +index must be done using the appropriate special accessor function or +opcode. + +Conversion from index values to indices and vice-versa can be done with +the following functions: + +INDEX-VALUE->INDEX (index-value) +INDEX->INDEX-VALUE (index) + + +The following constant indicates the maximum index value an index can +have in a given port. This must be at least 2^16. + +INDEX-VALUE-LIMIT - a fixnum, must be at least 2^16. + + +MAKE-INDEX-MASK ( ) + +This function is used to make index masks. Because I am lazy, I show an +implementation of it in the common case where indexes are just fixnums: + + (defun make-index-mask (cache-size line-size) + (let ((cache-size-in-bits (floor (log cache-size 2))) + (line-size-in-bits (floor (log line-size 2))) + (mask 0)) + (dotimes (i cache-size-in-bits) (setq mask (dpb 1 (byte 1 i) mask))) + (dotimes (i line-size-in-bits) (setq mask (dpb 0 (byte 1 i) mask))) + mask)) + +*** Optimizations *** + +This section discusses two important optimizations related to LAP +closures. The first relates to calling LAP closures themselves, the +second relates to calling other functions from LAP closures. + +The important point about calling LAP closures is that almost all of the +time, LAP closures will be used as the funcallable-instance-function of +funcallable instances. It is required that LAP closures be funcallable +themselves, but usually they will be stored in a FIN and the fin will +then be funcalled. This brings up several optimizations, including ones +having to do with access to the closure variables of a LAP closure. + +When a LAP closure is used to do method lookup, the function the LAP +closure ends up calling has the same number of required arguments as the +LAP closure itself. Since the LAP closure must check its required +arguments to do the lookup, it is redundant for the function called to +do so as well. Since LAP closures do all calls in a tail recursive way, +it should even be possible to optimize out certain parts of the normal +stack frame initialization. + +A similar situation occurs between effective method functions and the +individual method functions; the difference is that in effective method +functions, the calls are not necessarily tail recursive. + +Consequently, it would be nice to have a way to call certain functions +and inhibit the checking of required arguments. This is made possible +by use of the PCL-FAST-APPLY and PCL-FAST-FUNCALL macros together with +the PCL-FAST-CALL compiler declaration. + +The PCL-FAST-CALL compiler declaration declares that a function may be +fast called. Not all callers of the function will necessarily fast call +it, but most probably will. The :JMP opcode can only be used to call a +function compiled with the PCL-FAST-CALL declaration. + +The PCL-FAST-APPLY and PCL-FAST-FUNCALL macros are used to fast call a +function. The function argument must be a compiled function that has +the PCL-FAST-CALL compiler declaration in its lambda declarations. + +The basic idea is that the PCL-FAST-CALL compiler declaration causes the +compiler to set up an additional entrypoint to the function. This +entrypoint comes after checking of required arguments but before +processing of other arguments. + +Note: When FAST-APPLY is used, the required arguments will be given as +separate arguments and all other arguments will appear as a single +spread argument. For example: + +(let ((fn (compile () '(lambda (a b &optional (c 'z)) + (declare (pcl-fast-call)) + (list a b c))))) + + (pcl-fast-apply fn 'x 'y ()) ;legal + (pcl-fast-apply fn 'x 'y '(foo)) ;legal + (pcl-fast-apply fn '(a b c)) ;illegal + ) + +*** Producing LAP Closure Generators *** + +Each implementation of the LAP code mechanism must provide a port +specific function making lap closure generators. In the portable +implementation, this function is called PLAP-CLOSURE-GENERATOR. In +ExCL it should be called EXCL-LAP-CLOSURE-GENERATOR etc. + +At any time, the value of the variable *make-lap-closure-generator* is a +symbol which names the function currently being used to make lap closure +generators. + +The port specific function must accept arguments as follows: + +PLAP-CLOSURE-GENERATOR ( + + + + ) + +This returns a lap-closure generator. A lap-closure generator is a +function which is called with a number of arguments equal to the length +of . These arguments are the values of the closure +variables for the lap closure. These values cannot be changed once the +LAP closure is created. PCL takes care of keeping track of +lap-closure-generators it already has on hand and reusing them. The +function RESET-LAP-CLOSURE-GENERATORS can be called to force PCL to +forget all the lap closure generators it has remembered. + + + +A list of symbols. This provides a way to name particular arguments to +the LAP closure. Arguments which will not be referenced by name are +given as NIL. All required arguments to the LAP closure are explicitly +included (perhaps as NIL). If &REST appears at the end of arguments it +means that non-required arguments are allowed, these will be processed +by the methods. If &REST does not appear at the end of arguments, the +lap closure should signal an error if more than the indicated number of +arguments are supplied. + +Examples: + + - (obj-0 obj-1) + + Specifies a two argument lap closure. If more or less than + two arguments are supplied an error is signalled. Within + the actual lap code, both arguments can be referenced by + name (see the :ARG operand). + + - (obj-0 nil &rest) + + Specifies a two or more argument lap closure. If less than + two arguments are supplied an error is signalled. Within + the actual lap code, the first argument can be referenced by + name (see the :ARG operand). + + + + +A list of symbols. The closure will have these as closure variables. +Within the lap code these can be accessed using the :CVAR operand. The +lap code cannot change these values. SET-FUNCALLABLE-INSTANCE-FUNCTION +is permitted to have the special knowledge that there are at most ?? of +these and to be prepared to do something special when the funcallable +instance function of a funcallable instance is set to a lap closure. + + + +A list of register numbers. These registers will be used only to hold +indexes. Other registers may be used to hold indexes as well, but the +only values put into these registers will be indexes. + + + +A list of register numbers. These registers will be used only to hold +simple-vectors. Other registers may be used to hold simple-vectors as +well, but the only values put into these registers will be +simple-vectors. + + + + +The actual lap code for this closure. This is a list of LAP code +opcodes. See the section "Abstract LAP Code" for more details. + +Each implementation must also supply a function named PRE-MAKE-xxx where +xxx is the same as the name of its make-lap-closure-generator function. +The macro doesn't evaluate its arguments, and when it appears in a file +it should try to do some of the work at load time. It might appear in a +file like this: + +(eval-when (load) + (setq 1-arg-std-lap + (pre-make-plap-closure-generator ...))) + +*** Abstract LAP Code *** + +Each lap code operand has the form: (opcode operand1 ... operandn). + +In some cases, the distinction between an operand and an opcode is +somewhat arbitrary. In general, opcodes have a significant "action" +component to their behavior. Operands select a piece of data to operate +on. Some operands select their data in a more complex way, but they are +operands anyways. + +All data must be in a register before it can be operated on. This +requirement means that the only place a non-register operand can appear +is as the first argument to the :move opcode. (Actually, there is one +other exception, a :iref operand can be the target of a move as well.) +Moreover, only register operands can appear as the second argument to +the :move opcode and this register must not appear in the +operand. + +>> The operands are: + + (:reg ) + +A pseudo register. is an integer in the range [0 , 31]. + +A particular implementation can map this to a real register, a memory +location or the stack. The abstract LAP code itself does not include +the notion of a stack. + +PCL will attempt to optimize register use in two ways. PCL itself will +attempt to re-use registers whenever possible. That is, the port should +not have to worry with doing live register analysis for the registers. +In addition, PCL will consider lower numbered registers to be "faster" +than higher numbered ones. + + + (:cvar ) + +A closure variable of the lap-closure. is a symbol. + + + (:arg ) + +An argument to the LAP closure. is a symbol. + + (:std-wrapper ) + (:fsc-wrapper ) + (:built-in-wrapper ) + (:structure-wrapper ) + (:other-wrapper ) + +Get the class wrapper of . For std-instances and fsc-instances +this just fetches the wrapper field. The specific port is required to +implement fast access to the wrappers of built-in, structure and other +metatypes. A callback mechanism allows the port to ask PCL to generate +a class and wrapper for objects for which no class and wrapper exists +yet. This mechanism is <>. + + + (:std-slots ) + (:fsc-slots ) + +Fetch the slots field of a std-instance or a fsc-instance. + + (:constant ) + +This just allows inline constants. can be any Lisp object. + +The following operands operate on indexes. Each is patterned after a +Lisp function which would have a corresponding effect on the index value +of the index. + + (:i1+ ) + (:i+ ) + (:i- ) + (:ilogand ) + (:ilogxor ) + +Like the corresponding Lisp functions. + + + (:iref ) + +Like the SVREF function. must be a simple vector. + + (:cref ) + +The :cref operand is for constant vector references. must be +a fixnum. + +>> The opcodes are: + + (:move ) + +A full word move operation. + + + (:eq oO+S;w zu*_EaZ*ZQq6r zu_1oxzWx=P%hBBzO%&6Ps3VGg(8NUc{p-SJ6$ey=g6}lp1QX@*f;N7G``%eb4tj_Y zX^-D#_{MlWC%hCVE2GL$iRrLD`BEp6@tVX3ynr3i1}k2-96tX-0kI{YHVr2sLyfyo zmGG`8I9qTAs4#6?_6k6O*|Ocgp=&SDJCB|6_z+D1JP9 z#OKZA!Vfri0RPmv+<R8bIJSF@~Bk=+efXF@pt;=|KcT6yBCxw0QG2NsRQBv4RqfdxINWd56|03+1VnvC< zGkR>>wr$(CZQIs8wr!t#Y}>YN+r4elCQX|3WwIaUWp*Z$?D@a7K9q(eTGZ!IbN2Qb zi7y6qUH0^LPr2`l@d&yI5}6UXpz$G!8HCnvm{VUO^T}jcCHuk!s=$fMzy68lz-VOM z=eE*mcof?WMj=@|b~t}2A{5genGE?p_C%t%Qf|@jy(N0bDIYiErFhj|5CL-voGZdX zEw<~{AxB%;9!9Jo)w0oVS+OB9Mk0}{|2&M_ky_P>olLSpCXMix`zXA& ze=&r9q>d4Rqby~}QZtLHvJY{(on*%rU+t6`-o#J> z2@KJ}AohQ~jOG0fk3Dc)|5*vd;fRZzdl<^!*tB#j)-)v)qhC}eo!93>B{Sw_Af9~f zq4ti29UWrbv%#(7Y;<(TRV-wt@=A8Gj6lcvh`z+qJE2Z0N-K)qZ^R@= zP7Q~p;&Zk?T`rc1xwH=S#6;ee*J#@ZyBH44|0JNKzDk@R+EQn6&fS z)4uS<+*|qfa1QmPTwL@eCF&@lw zj)7NZv-Y*R%2{G3VP_V+yS|HJ-r!E0*C^*uoqUGr2J4=U!%3Qjo9-?9gh>a~)9~Q} zX+*Q|SY)_yh|Uq@hJzf9M0&bZ zE@Qq2UnV@Ht#uhuSG^$=PdmIo<$kozNtky0I6$Rak(dB`#UME`)hIO{-xM;_4zXcM z73SomB!7po?wm7hBMsD)VL1ItLy##7n2E`=;pUHe}#+p&=W}9@#ST(*J`UzaE@dNf78g~ z*eM`VMZQGgTVT8@K?T=|D8nCWFw88Olpd z|8lnk((x0h_1?ky9;$?usT$_4ark2L*3+TKSIkx)=(R>2ojNbB4RbKt3ux{($Fh<(RMD;*aiRl{q4b-0${E5j9uYv*3G?Z=xtKWg zX3T_5=Cm|xkdEuR%gnIkv>aBwD-K%3NfFx<4tBn&en@yMPg$889gh-`vzF9$E=PHjGLCHtzCY zA-yyn*q!oj#gjNjWaa7HGTE}cBte76!xn5}&sS5J@-FNnhCh9{n*!@V&)`3Y`E)P0 zQ(9K5TpSL<7229#9&vcm{qZJ-yZol>Jwr12cZo^#Fst#WNNQn?KF*r@^3MqxR&D7v zwYigrU*%HDPmAdW1|09=(MV&vBv-6Nfj7zOOqS&00HXhELlyZd`{_N6<$@b|l>UIA zj=UU2qiHX$d|JJ^^=_0T#bp(t*yS~gSs~%LqV8=!jIBx_T+KKbC9$T8JeNa1r}tQg z#BIc%Xq;IwqbLT_Y$D&r$Vl*%F5!^=$vtQ+YO+QMt{y}5a#fx|?LD(2zeUeTOp!07 zt+IZLq%HOp-jFn^p6&4~pFe--B9AMfC$T77Jw&TU@BcD=8~oV*jcQXIzI|+|wz6ha z+p|ZD6Yz4zU^#mT#R>z9sOu10u8r;5bzd8_zjWK=H9oxCh(q-=V{Kk1aG%L;IN?y3 zr$YGKm$D-UT1LOClxKEP$REy4SS->|CKy1ZIEkeRZZdXmscqc!Ax{?ag#9yg6+{q3 zg>h%dqp>;^gy-truwzVu2wC?M7*ZrSD|$%sJDY|4kZo6%dS z@FGS6czW&2f0s-8p?V<1vKN2{Q==+MMuV@wbo%FzA`H=8%CGaIwgj%U6HyZ-U0kFz zLpqlT-4d&EFg-9wL3A-6=MX*U)@TDS;2m?5XMkQKO}nsB+~%Z|GV>!VX1iJ2AG65$ zW=W)^1I`RNuN99jKyjEOd*-JmRBrKlt{%;l2tZsFWalEq+zCo zn6wpR#^^o(elx#Fm4V$8#>`qk%^Yz>!u zS9&{>F_~(7-mc!UL6~<<#K`aUUKq8|-6Sfqb@Ds4|EySy|1S^u24dzR82)GBV2P8P zYBSXywQ~vgF=$+uFZk!CtbrKN6ROSbz?e!~w0-RjbP<33?c`C~wzi-S67BOEg!oao zMgj#*cEZ}>)P459gqL=C{^{6?rxvb&>nXCw2L0ip6-9OjEq#yTAhmj1hQ{!2815FS zhGRW1QMeMD6OzVlMDA0?0^72Y;>_o#wE1-33iX&>3jGC$Iq5bDhdSMfo(CT&vPz1+ zf1PRd=j%ZmeKV$?vzU57|L1$+9c1thqj1FY%?Cxm?|Ka|7#x;1Ur=Z5%j$Wfh@Pp` zd#0UST0*lWCq^l$mJ(&E(~?sE-iYoyy}o@LJ=O{tFq^q%<^IiFy2P#*uOPUxXRK)} z*iL6HoQd0>8k1bv3{KLv&y1@Obd#J!C4Tgf_S(`3lA;IuffOK)9zYN8eM2Z`ik^5P z=q*!=Y?GIxt9ej!{o6@a3`ZJiBXybS4_ZImy?26>oNC-NJsrZpf%ERuCgQD7!;)CN{zBo-ffOkLeI7*}ERwC+US zC&g+t@>~WlM@|y73=<1{M!H`A7L?~0d&~eJejw3sQH@U^)omz;9y`kXl92VB~mcUm5{Q8Q!;MT ztTGsO!806`sgRoKe5^Xd%gd;rkCXTwQ*Crh+vBVN4mKR(xnXPcDlP+6wyv+avMI;I z@PRJv&OxK$+(;)QFt!>5b$v)YNTqr$EstOA$wBZxRV=>iwF?+#o<}Wdj?QocWIREq z24UQ>VQQLwWcvYA`4^Rg7#}7xh<3|Yygx9u?I&y%J!TscY2H+t*E=q1zf%$Di|=cB zR)Z_|CQ@zGWJFTJrhDwuD2L`P5D|zLJfWENMb0V2d9U6o+rx5j44X#xD3MhhAAQqJ zLv@S^We1tI?ZFpPW8#Rm0WWm~qxMGjjsrQT<{~2noIW(+C}H2Mf4WJ-<|<|*^*V^C z*(9HOq08G&4*U0(aYL~C@W^UaV3R1EQd6pEq(z+RjQ3+!SgtA&B zAbBf!%=6*9zb0kYLOTf+c9$sxr}q8i8JXiVYqL4#A6wWJAz?#TRN_lXAMK>^;@CW4 z<|2IX&$~MaXZz{4mok4+_vDGZ@$<{(p~z8qiP4$GsT5F!$qN02y(CHQ9ge*wH)3Q2 z08W_jzhc77~DRFBRqQljwLX^kmj>~u(PpHZ}SQ6OeGM5H{z7VyIwJCDgaayJHtcNHgwbbA*cOY1#cAA49)`NGyE3K$>` zj2NcT=!o0x)qS5%C^Tcv=U4YLgDBnOA1@j9jbB)3rEK>Hr=ARo_s#{kbT}>;d}gnszhQFV$7`jn1#DKJPGbml^l< z7ILa!)~~kAUQz2&_GkZE)cDyrArrm-2LQwy`2aVd8*jKW{E#V1e#MTPcqazvWlGj_ z|H)5yV-wKWoQ;-td?$O?d`UuogL>w?zj8&HKjE+D@) zn*4m4f&)JsfK&4d8ppVqH&e4X`N*j(+Y>S8O&~6^mwbKki>A!_{CO7B8~Q1Qf~j>2 z-PN@Gzxb#jxHn5AXM-2#o*vxpn`vd)kkjrj>H0ko~QP8(5p zy%?TVb0ZbH#94!P(~jJ>$-K+nHkULc^s{IvNyrvo+=8n#9k|M^Ge+?EcAPPYUg*y6 zQp0Ob)LLuvP9xXrS(D2Kzf@`HAXcH^5ctP8lbfZpNKT}@CLogx0woMDDmXC5_^|gH z)G1r0OOGjoU5@a;3;gtHZS^3E-fX%g*>C}Z{mr_foSURJ0ZE69FsNd#77)0 z)~IwLY3#$Z$qW#s8XHKMLIsRZNCd_!?6+Ou z={N8{&wV;o_$H!}V(hu^_qz6`Do<>@n{R=ZyD; z+gma?g{EsqiIe#P>msG>g#Zc}^6pGTAP2Xu#+?QFZw$N4Y=)8T=R4xs4@(j2#JPk9 zN_{ZmsT_4qj>hJfv)kP9GQm8x6g(h{-pp-R!%4#)4#$xvfWl`zX&XLcBYiwomKLxT z=xi_n<-dnGg*A+D9`KPWKR-J0It-5_Hb9IdN-ARdD+gno0GK`WKx$3j`kV@mtqLV3 z?t`(p`Y~ajNgHhOCrvwte0H$cFTmf~8r zT&$$WrEKKY>K9DE!Z>eD#~Zez#z*%{<#qO_E`p=?qJg-(+VS}`sm$SIc(*B3X@g|Z zkMgPdFEsCN5rnULTvF`wKs~s}qjAl*NR5Zl&}29mV8ugSJ9deF;R`cUN7=~r4FYOG zai;&_nivH1Cu`%D&$%98_d@um8jXE+z)+qMD+In+ibu?fk3}6~?y)I4L^bvnekSEH zjuY|?6I3Va*8-LLO4+M7?>;v8FZxMSouhs{3DZeLs9{6vYLjE?Ko4M2ET1B~`7AXj zfJZv7FE_$i%^Q$!CHXx?RXJ+nyvy**NRiJC0aoh4sLG660#Hln_sW!SlBAF6k#n*;p*HY+b_K zWjssg0Zt1O99c$7=_cUNv0?c(i;w!%oJ8crqv4#Ut0asZIVAmdDid`DxzCNY^uL-H zl)avTTP>|0b}vbYIk}^@>wtH5>hBDQAyTO3H3=fYr##jAmXZr z1h*=TO7UV%z;tPeylevsvcCa_>EdgM^;z96Rez-4run%WpMj^!?+)+%giE^o4@N*h zWvR_UdUHUJB~LGqzJ44)ljw_ItD?*TMGkZ?@&WwIb0ukaaNLrh@3kq#xjozDUl(Q= z;%-3|57;A$gO1UtF`f472n0j!XAQ9`&kVBpWP<|Zq)w;&o@y0uN0!7VL^1jC>nwq0 z+do}q<<4dLu>S~Is$kc%#E^m4i&4e$W$GsaGcGFvfxx6ALIr$~Fo<@)PtT5Q8*a4E zpgESxy$4=sn@dAkzElvWUvzC$@KiTMkAGa_4M&(6jHzb6`)sMuTBd5>6XLl4JhL_fjTNtGxG)U8loqYJt-h8u5YUKN9 z^^E)F!sXiMPo@R36Vpa$kLKz_z)NZ$n<89;<$(PQFwPL{Zjp~BhR+nxNrnKVh<|h= zKWq|{8crJpEyexnIDG zS%1d-c~noPh#O^v>b%1yhTFf%_sL>ezz+c&BP zzJj6TrT`Ijj5%GsCC?F~Ag>%q7T(?dU<&ru(?bT!1a9$wu}bI;M;!%srKUFBMoEss zyb}2PSzbn+45o@l-=^Ih5a@+ss~@~to_eM7ZbuT!;|?23Uw!By)`TW}^||_&GjE$* z5F=nu`lHG(Ze{I;$8q57)_vIsVk|zFi685}jJcOUH)^SuRI}*_+s$;4w&a{~nz1pV z7`;U$MQ4x7j%(xEre_MObiEHpA-us3DWdH?-OaO|_hgV|ZhWg4JHKfgd`kFA3zt{t zwUu8)(3tqcN|#OuOM8E19)`$`%TkwTlUeuR13`xRM@3*5KC0*lmrs$a>E<5qG@(Tu zUlJx)u$NT;2iUlKXVk%A3x^+4izwy=K<3E{5ewb5`zaQ(yS4ij+ux z>a5m<>xauqqnwDLTPIHbU$!mBf8?)gCqqL0OvX^TNrCL_2GCh7jm&BXNoB z_zbiCjQE11_J0oumXSB)#bVRVW#j+Ua8^o+Gr$>NL4)7FIv75*%Z$M#F#GNw2%eMT zH|<`MrCEeuUWTx4eA74KY!5OTy5WYIe_``4yTK-8JGQAQ(IN5{B3k3xZ7NP=P;XuH zI_JK?;_2SouCtd~q||lb0o;$Q$vUqvEHK1v5KlW{>bJUy_I`5W3dGEqR&(j|O&ZA7 z+Wxaucwr-8+zIiER0jYFk^2QSg7X$$%ns)Q_;(o+LxMOQxT_%Iym@CrRB%O45FMDK zPC!fFw<=>Cia}qJz-SxuFqj3J2STeXv|uNCnAP})Cr<|@Fyjwm(!`rTzVdsfhM8^+ z)t|JMCA3DKP$XnE*%`c37WZifSvR~|$#+(Mo;QIx?#Rrg%74Lj4m5b}UUslW0cSNx=`A$-^@ z$Tt!$HM1m$T-35o>pf!i2XTVaE8t!!W5S+-R&69m#)NUK zQdSr#oH_-wh`;~@Z;y6L*uN>U@CjzM`G#EAhPsiiYPdK~@(;_5^5&?=bb@NJ$Dqf9^P4!0DaMn&*Ih=PeynZ$~b>Tx-4L1D;r$Lrsg$NDY1D5Q4kVQC96iSleDhcP_LrRbc% ziIO@q&_Ue%CFmNs<2eQK-iYL?On2o|k8sIFE1=zyvlTb*u3=LwDllQ3Dr&Nd-FwCB zW(UJJw7|K;lyAXH3P>1wEeKH!*fcY?O$4J zu8{`6+hu^G6xUv(4WxvvRT~Gco?~>#F|aDl)x2#j?2nk_ z4GCgR+z+uNiC=H*3nmIwke{MVQ`9ooY~O7_#_#$ulnD9K$nEoXfq9qTE^Ll1)fFR77BEbweKh01AzGM)fiom@PXdp7K26cpHEecJO{}HR%^=JaN^l%b$i&6JNz-<>bXs z|4^+oz)_5fJK2aDhW-PdqEMCC%=>(K+TfIDl@-AaJD#ngWpovAE+Hk-F7rIDf*i?x z89ra+;pb~dNzvs+2t*wbRBlp{Hw_DRQFXIeNGYB&a((c{Fq=|t9hQnw zo*YMKYWH_2jcj+YN-Fi8ha#U3;fnJ_v0|Zmu~H1{vv4T`sJg+4w$6BD&)Hc#}oFO84VPEw6# zuz}S%BKK*U)o&HRwj$reW{rCWj;p1y2zS_%Ko4;WxDSagQ2is)ZmL+0K{;JEpAfM5 zY%GqH|2cs_7wATZ($K~WTP5TaH&8p{)5QQ*oysdp&oR<6R28banc0kH#8M+?#G808 zzmE=-K3voHOFxdR7rroHdc;u6cj8HS59n*#lpC1MlQg3unK3=dob3Oo2!2YaRiB0H zeI<~@7uMO&dwq(j>hIUql$-b`B@^9v4VQ7aBQvEA3zeCEO_;3sEqVkavoiSYkl|DP z*hvR9{Owvol&W~KdvJb)nAo0{ARhbH+i$Sw4_Y}^CgFFHn&Mi*QS6noHY1Fq-@zVK z{9Bpyn%M?1 z4_$cq&g4fjk_U`#B%Loki=Mo>ZP0dW$W;Zah7fnq*4bsl#%r`?eIL!=Qx~>3Ds+Jy>J)sdIT1_EUAIHyCi^=h>+@wm7Un#=Y*1R0zb$ois1JW?+bOa`7~ zFEYFx$BR_Oo~1kSs&GiwL*?zn@F)Y+$)0+r1-=_pf@+8;q>>8d5uAn)rLNd$(5Y&B zJy0+Un{pGwPTc?dX&;wkJIy)Rwlu=$IG~sA zyhe#Au->?%wF^GDK0|YwW>&C{7?Y(|euS}zr*Mu}7Vb_MWK{CfCNReZ#lN=wtRbq* zi$#RH5Ou0Sbe=WNq}Y;cx$`e__J|nGbw|1hc9cz6MU=^m1~p;S`*RFqKRLE81b&#j ziikFM18@&5u5>bB8KRUq)@jvAG1x>mK}vzJJus{ zuf_3pkes^ZBh#Hj9yJ)X5VG6{==AnjfByDpa=7*}G?%BloJ}DUMUie3?R(Wx@!^K- zd3v4{h(_9@bS%uN^Sw_Q=j8%nhbWb-M+tY)>w5ioJ+YEa#J1tv&#Z(^G#4qW#i7sw zhyI4Lb98mL0ljWutH`coXeC&YCv2ZqNvkp+=6rR*3Qhjp43-~51eEh_QyS@ zO|gJrsBIgisxbG-vVkbw`%u9+P%TjTcrT`~F;|m~XVTwq%|L6u^altmb&awT=7Yx7 zPr6FW#N^lO;M7 z@X)A@16N6sV|q+~Sn@ac-ZY}brV5Z14<5!~g(?&JCq)Z9ZVcPAvLX~eZDcD_#B?Z1 zvVkd)8&~LbQ^9(q2VKGj;m&F2SE)To>l{pX&P5?iQFB&J%iwsh^qO_D1I!F#eG^3z z+9Z2mwFd(YhGbKFD?zBivp&m0+28{Dx*d_^wh4lWl72Pn{4<-`3v10RF{cufR((16 z%H%(_eVOxx)FDP}@JDJEqqAz}hoXqf_aS|aJo>jd&aj0PRB4lUExz0?Ipeh?M2zcN zhOX&-kt=xA-H-g?Xt*)mDSCBYCBx`pNu$EEjczOhCRN7+G z$~d7s+}zo|r%Nxql$+bre7EnG2EO6Qhv7zVG`rH^TA%=RpodUj0UyYS&+7f=m7HIc7gXb}Wt_vxFDG>2XbM*!nq zW0V}n_;6#7)_wBB5~>i-Gj*2+(k24%5xy#nEL>P&&27Wm<=qdO{J#j~HZBoGO0ctc zvnr&%TVlfD!&rU}Fj9q|Gt7wIQ$q(x-05HpxpJcTsso!V3yiykR3VHBYe6JysL_qi zEnA(OM6paP`23Ncy|HvIsF7oMIGX6wZm!abae}3k(9eBpN1=;%ReBroCLWem0Nmtw ztqj)gL=h9lYZ>q~@aTOOj(cQJ_;RXeiQ)N?+MCu7|M@ZJ{R@wvfM?b4S!e!k;gc;R zfIR`-N7yBpD`D1yt@}5}9{d0$I~?x%c8?L6;68nux@+C37*LKgoC`JN}>zRpGR(^^f#c&Y#Yer`)E=U_9sN59fp_` z%@6IhOcl52P6cF%cH!C4BITWnwU19bCHz_|g>(g0m{6xBN#~83J~Ot6&c8#Kh9;jicK3_Se!-*ne8ERtkb) z4_Tj*V=;`)vN6rVJZwNb5V=C2U@dpgc4+E19L}(VUnx2AfwQ8bVz&ScCrYwj9qQvI zBJ>k}Alyh)mZ&*4-Jt@9;G;D}+oaDAN_kmPmBfpzrLddAH%QG!C59an_DC)xK4m>_oA63sk(Vh(+nM1A*!Iq zpd{RvYBS8=xRP!(SgzywP>ClI9~Knqgw{x#D<+!G@~k{#Of;<(bdK`Q^!zR*ZlH!& zqMgCMfk4ERm&P*!9{#)((YcBmlH2^O@lG!(HCA(yaQT*py-ec1gg#@l-EctQ5Tspp zWn(dWal5*wvRjyRBv|)M(Qe{G)!afXpIs*RZUBAejVY}|nC~!dZWS&V*0*co@e9m? zrf^WF1~!nk!M-D?9Bx`rUxHq>#6yTuoN6TKn|`?G9$8eqffsn3HiGW*4lhypR>wtb z`Lrh19lrXDbaK7N?5tOuA8|8;AnUd|gm9##0G`eAfTV#QQ-Pg&dm{U!=pur>CqIo8 zB|@($E&{RW``JV)AtP1m`C5YMmw~ceMh?xO35hbbD3IE7?Bx?#M@%x&<8oq3WZ4JH z;j)~+wh*xtx1{Siu2jE4+8onZ=SeRf|6ulKe#O#=5>I!KAspRIivbdukJx0*6~n}Q zmG<;Gd9WFy2s%QUM;gg0EUG4oE&=Xo=x@d?snfXmB2)EBZIPn^>|49COT84DV=~kS z&H56y=jFrrlj>l`=*I2vR`HuUm02rXkGqj4`ivLCw?*%o?Q+j-YU7Qlpw9UAj}xMGN+F%_I+#4^!i)4&O>gVThT*nr|;$v z9Ew`p^MHkB!!~bviTIzBlP2!JQu7g?sJg^Bd2 z`-}IaT_;>g9x)VS#xZEDp8mE_k`@=nL86#1H)wejj74%&iGSt=$-NV1(nZI48-8*=s5S21BcK6w2_5*p$%;Ej4K4%1y! zMNBKOyKz=0;42ND_3Gnm?#nFg8~hs3D_;wbfUE>^)(icmo*P`yol#Q++#Q^8tdE5G zQ|NiyP~M#IHzoyjZet$s zYjz5fjPlNYv<>pOX$Is1@|Tf`$;qJ}D8LOMzp8+8Q2&X_uBERxN5(&67uCbBxw#$` zqc;k`D-#oV*T2ulbSZ&(BYeSzuWycVgKt^P2tDe zxE$bDTX5#YHzg2YVmIsGiEqT>?I-5^_wna9=i%4>`q${)fAj0tn}CsAda`#r+5hv` zf9pfdEYF~2AzS*-Ed*zq?iTN%siw2s7$+_X9S5H#>`*oAh#MbD2mo1Ys zBBLEB24xBdR`yr3;8$ipXJ=swtK8tw;AK@CIN#XFi_Xd|4n_FOaM{gH4?B2IKeSHl;KVyf!9C7aXb{dRfPJ5H1rwm}{*b^w) z_R8=llY$#NK=6!ykw4ehAV4;XS4e0H*L)6ek)0tbR8FvX9^gn-Lg; z#E%#aAo$3B2+AP-BW9;+@=NS?+0?)2^}?xl-rM#4muTko0_xuq^mzBIJ7~iGsaEZo z-K*~I{of`3M}O$~X7M*>#~18B?;iXmYH`mih&lcQ_%${({hl;3edhkH8)w4!2HfQa z`I^3~{mg6rz`fgHIo!SD-Fkz6OIy5h=bF@?duPXA)CZf~{plUB&A$3I@P}u32kyyR zeR@6L^)|UMvxaK=AwJkPdja?1|ND-A*R77`-}f4(@dLQqY5E+V{3`clX67y5?5F?4 z|8=Wn>xX~ByME%ob!%kf-?=+(v&+9!O&d7U+c`S%RJZ)&pE>d2XSMl?K6(--__a*c zxf|?D-s;@o2!e&F@dJPO8TFw*`kUC`@O}BN&y2k2J%W#G?q#1pXuo_b2`50^_^XTE z(rXkj#|TAolB>&&!S0ZUQ)$b58Z}42QQHTse)?BXU*m= z6e-NNfYv%%Nf)9Hkh>KaI+2IDCwF8ByEm zz0qmGiS>N}Xp?dz&F0J>WI;mo=baMut>)S~7f%ukJ9WppNL{R#c9%#xC03!yR*Nv2 zQ37MMD2#;!xL;z{iFWFPsp)GLsg*bE0u>tA=+ioh)Sx;n>?uX~#+#~Rswp_#wc<4_ zjW>Kd1u?SmUOz60B-SJEkxLy_N2KCWfxtCB+3Q(dq~f?)NHnWl_Al|smIbx*pr?E#cIVl&Dy+`46jVjo%(t>oB&oDgCrDc=(2?xeC z{e+jtlH(FMvu6Gn4KD9j-U@mj({=?aqJ>?)g_~YSeF&8$770 zRe?Q6PF^`NC8oS#gy2~WtlU2L(>vb5fSmN>!>37a z%`TA-SbrT^g+-=`dLlvd&6PL8$W(%xz$u6I#d3X>Cc&^fWUYn;s zAyek)b+ziPcWkR3Ua|1Q4f=9j|KStnNE8`BFA0(nRSI7|4-Caex# z=}moTuFsS5GAaw^*4|Y~28RnztBOCr{YR>qGUysK7oLB$ zLBodqtYvp5E2Tl@Hj`d)92{d)J4(^`ivsDKZ9&S4QxTaAmvlEor$YQeg8h%03`7c_ zf#e%S@LtM2g==WA_A~02Q89;}y5Y}Ap}5wT47^~3)lb&G#j)27 z;DAE?arCPh&u6kF6?X_3%j1F9pokg_V8KXO4pfMC@+(p7s5)uymc+}>$JBnYyyQI2NuoQ4LQi@> zU-0;pBnQ3gheg4xsELF9co0tY-ynN}Gx6$VM~~|#pZu}_MWOB~N@b|chYDM)RghCf z*V%lnz&pf$5FwfgqR$Npf6mBRSoV1}hSdYw3iKxEC++IkzsTesc+iyvuJRBIbU(D| zc0#$XkfAg#?ik{1i5M3*UH{6s>)s|-lY#7}HKB@Il6ZQQO}cLvA=YXK5ZAFBSskc3 zwhF4e5ann9h_H_yvUTD@B8VFH=4+%S{#d*2GT4)+79&rb;sxq&L;!sGvEfHZXG;Nu z#*fp419GOw5h_ACqerK2@eW?2yPAo?7ZvUy+Hw{?{B;gcRWHPZRyZqXjPD9Da-X2e z(NM1&qB&##tLL$0I4f0vjb1%YOCa8`rJ-M7l=^m8hvS9Ot`u4>H2L89XQ7jDfeS8U zfH5CvqABxe2)(w|HRU6gEU**aEbZ?`A48!#`B^W24l8bR6kHJB&<2jGJ{f2*!W|@? zk4b#fRn(77GYD6cLUk)7aai#I`xW&LE8bW!xjFm}vRgUk{V=ZJs08^{X9MXX+?_ z)<%(OsJ+mZs2pOFQ%E;5cq6WCq@Z0gx04G|dqavNG;rDo1D1r^#i>1s9T2eUN`edF zo}H2q)tDpE%o5<;02V!xMe;t_7Iq39gIuZ^eOAy-cb~X@m3A0sN z|IAOy5&H~NtshCE8a4T`L{yEcNP!Zj8$1%6?E^Q--0hz#c~oq21ec zeFU?{{x*BEc2CFw(TvG5tN?mqIx(Ey$fSD9>W8(-La48f!PLW<4F|^|De+ZW{|yIA zki$Q4M_2szJj|?EEFfd9YJHMWQ_}$pmTGU+N8zAs#V=0t|9j;|ps$0s@|HTD6)O!1 zTU@--{CJ5{;J|4vJKCmrD5NN%#mOeG?u0#_kWKo2?3WVQ=zj?ZWLlwKNpN_E}->Y?#76qQhAs@c40XI7Ok5U4_$wo zQXWr}pJE?mRJKOZw}T_zGF3wiBNYtk0iBq{KcGeAxC|bMm#RMgRo)`KDz+{{vOHIO zzb)&F+fkG*(K+GkC+d*fGhcQDh#PxNf?|?Q$E7Dynk&2Nr)c#0cVK3yt~@fZ&#!k3 z{=CnmNh*+rZwpny&SfcM?KqQ{_{qp)D~)H1D>v!$YuF-%DIk;kaffU{f}Vt3UE)Qt zpMZcUVup*K?d|UbB9B~FaREWo?m~!<1(rs(N}xx)MW0y+mn1Dc)HE8feo>{-M?|;P z`PTSySd}#B2SYHgkQH@y>V|)GoCvefIt?}`?`BW&T`?LSxqTKh&z=QE^(t3Z_i#Ge zvi7C&__*4SXhcKY0Rvr#Bo%5Z6kHk9^Crvg-{ydFTa~5K9$Y88bhYI{M9^h<-4)TV z+uQ|xr%DT~=#w{BnAN3$^-o0%QPvM!OK|-;h5Cw#X*+&^Zor2SSJXvKo0YN9HnZ%! zHNA@058y-{_UeCPy-v}*J`t3iH|@s2Vv9uf$zGSt8uZR5!`|eFqTSOYt#})i4hWac z7n_ydn32~m8!k2zgFSk8#B(OVjWX|;E9+h~9_;>M+r<%iNIk26V~P>C5J-CBj@B&= zVt-J66P1q=t#wLY#6WRrzROOR2x*O)&_#X3#s=nuNs`Bk4jY_M5vww^rv0wVi{{fp z%w06(Bt&1705GOfJc`gD9O~%;LSmunyfg>fF7k1eXmSSQn>As^q48+}Ou`Jx+@xj@ zP)Me&K0G#nSln!w*-QB(Wo;vW=r(!xX&r{w?{RdcTixZ6<@U=R;`bbguD`wWc$gG) zs}*$S)F_!_P!$*XwtdD(&{7DJn z#aikEpzY-p8mV;xMTAIb16#aU*>_G00#M-Mv^hI{M3f$?q1BIEONc*+VdA<3?ZWm$ z7&@e#T#9v&f12k#{+e|`Kgb2tv6=?V8>u8tN5k&xCj6rj?AfLuHoK~9OXds+Sv`R7 zwj&Hc`fD2)6LYv2a92??i^Yhj#Ic+u;2o5CPr7BX{qD{19-cl6b?Cq*3~Jzf^YXWh z*-n+fFaKaEWysF-Kb+>yuSF%WrHaGm!(1mpYSX0|^B*!0dO#!AX;+=b>M*bdwA6!X zjebZSx=%tc8jeAx*gQBIX8yg;@mX=i#VrVNc&@qi)t*3kCM&W(8>h+ZV3BhTNbCTUlR4?WCv-n&7c0F&Tl@eH+Xb#SeDe zYm1BM^Psld11O}G;mrAB{!nM#;*6IXGu>u?QwoXMDFh2EPM!^8=(+2ZxresVw5!kl z55n$gM-(mG5^&jet+H*~wr$(CZQHhO+qP}HcRD#qU!0^b=Mzkg@%=9CF!nW0@s>4P zDk5u9A~ZZ{y}p>@%bbR}?7_r9_E7C!3NyUU@pERn5$viwx~FG*i$}bX97h!|zz{+u zbLi&@`OW0L$Gfj$I#%x?CIzC0VWHC=*9GZPWZO0pX9Ax8f*)I#_NKp z3a)Y(%tQU0_w~$2KiyYoCc)S(O?~M8VEDE^yn-aC?U#`?T|ZB zx)R+NZ|r|2#p|0^Hf3>0H)e$7v{ZLcGF>_H0_)BCpCW0WCi|mDreOb3emL-9Tob_8 zi)I_~!WHr}KJXR>DJ-;S6|lUbab8Ctc>Pe*Ad44wpA2B5(ylvp(r?BrX8o z@UOS*l{WQD(+-Mh%FEJo9AeOX%(hp$nY|3;dDL+Jg>7W}z>N_LBVg*%R$8qelUo6b zy+fYOl_mk?W$q7XvqINt+^)sKAfjs>GU7f(SrXijL7g-3n2^+r((OaAJS)*UVx`j! zvNWJ|*_NB=TFD|2hb3o2964gU0GJKCfJsOLsUznGxr=HTW!FJF$Qe?<&p#ymPSPT+ zw&oJDM3c$Kjjh?Taea<{{PK=m2vP$TwkbSIifiN{@UIcL`Xu4QjH&P((?wZmDnCeE z-H?5t1qm5ZI@B2HUcPNSiy}Rmv$0~D&bnNCtb^FMhoa9SexNR$oQ|+e=YLPF-7Ol) zBnDc4^n%G;5yF+y&x%JsD*aZweQq=8?B6DoGAj1fkWzH%m`L~JqWAv-<5&*c_c=<0 zu~Fzm*eqwvmLz(rp*aw69v@I9Ovur+Ayxd?T_!o`v$~El^ePfyByX(YKqh*s zDydKM&s%FJ@z%Lw%-%UWDLjb<;1rn$z9r}OE!O7>z0oT#5~%2#BrO7?P+ERJ&sv)a zIzDd`_4XWHz z_#5qdo-s+pq@>D=&8oSjj+>VS4buPD7FJxm^<_d;Uu=eIM#cX)$xIs- zhrVqj(?8O6%UErGRB)V=T;C66tL#XkVK9Hh_x2Dv4e4(Y@CuY$3-J(>?LYG4GnojD;rmLdB~iZ1hmPS0=wr z#jh%i5WA!3DoGpNoBJIew&Pl^z$iSsd5SSbFdKG}tGYNt6iO9Gp;0nM%Gm?49YfiU zg!{^~Ar{wLjf-3-mDfcFP^LKZZ%Rrs>ve=}98(WD8%0WCSdaEWW@g6;keL^8w{=Za z>c3l<`2yjkY_NGp#$i1T2-tL^em~Uvj=bgm_xDd{#$sb9m08rhKw^0dqhw$zk|&&T zt5)LqGijmSW*j^P-?zieSe{CIdi^ZQVbpciKlHj56>d+m91NvxHr}aFin}M3v0=aV z#!*n6k%zoSaW8SNo0xBi?16PdhStWQHh4L~NCbFgSn9JPk!*LKx_`e&B0;6t< z0MsNz?qvtx1@~y)EUm%aT+_=JV8Pu%{1D9HC=`Qqj-l5KkyG+gfU)Y?iSDqqc2&;@ zC#3}DPw2z)YHXT=C`jR6`0TpEsz|U7-?8wvOq+^LeifUk!s?RSGf1vN#7Xapt2x0| z>#OL)uR!hpxeh< zDQD+z=B&!%&$%z*=m5R*KWGgXXw!lg-(APq;OmmNN#3L51z{1&Z=|P!RSzh& z17LY5(e72P(9WfW=4JnF2aefhZZ&B7CEzR1Ma= zPz+1sA6PiZb{s+B4MI`7!xp&@62A6A0hP}KU=WQ9K1QZOpd~W=WXjz3+jb| zgq(4SSR^bOUasauipEdlU5sgx__C^2BFB&>PKFusk zwG;pgn?8=1<;e{PLWV#3EkUiMda$pZ7{MoxLn6BonzsA613<$o^wdNrGBkFjSykGH zVK`nA7OZ`PYGwR}Bwj+DeR_@($9hGOc~s&~b%YM}#XFW80J9W6jx zBF;a#N~7#Y=dM%dDp#!*7zzpE?VeiYzy@BoQI}NS$2%E%k>dN_9$feh;O1IHn0Z+C zeERmjB;hScsygO}7K+Z^BRjM6)i6uybRq(*cXBmv?~eirDfaeq>F7GZ?7jAp7EMiG z*Be@heR~FOW2ZeZ5HFI-zw5-d@$nQ`|$r;L@hx54W?0}2jkT_^;5HCL( zG^E)yxYb7&X1;XrEidJO7bT7*PZ1YSa-4XwZ3}q}ELbshWgy;Xrf^d_h{3PPm@xNd z{K5#bP%ZJPVlncVqHwb)n9lEjlks)~jZwoTI}Z}RHH@d0MlU(5MHF%jE|v%@v3o~& z#5Zx>!X36S_e@!~+wn z^kfE7>mbZ_;d#2k89b2LF2*qUJc`CPC_HH?1$)~@(2@c$B?!!0y9BP!w%M7br;~@F zF7FPHJm8hEc|O-mJ%O7X`{~Q~THF(@IhzJV$@35T_}TyYQQv644Oo2>0;McB8QEY2 zEVgALwAoX1Ktu*RB7AD0O0vVsUT?Dr=#p_(%)=6O7E8)^h{y8UESfglAS(eaQBAXL zB#G!9)d?}uIf0Tt#rH7^r$JxSRK0*sEtmu1;rCYSLZP9f2D6U z+ZhTCwFZ@}ijf`1vG!!XPD++FX3gEQC036HqS_JZTZqKwe=yi7>lef|HxT!m!&nIW z0&rQ({;~tcC5P^BwS_XEs)SfuDejG#L>VE|5CXiqqp2ilvkT=rXcC)qd1B zB_Ys!ZG*#K`!46}{-gUb>3eK4_ugYtvK?ca?2W9n%7=A|SCcgTLQ^-mS!>UMoM&XZ zbxvsDin|FVLA}sFam1aB$xC7+))c5$JxfwQHsGmFBP7&niJxrLS1&bsdOBld zj`;jB|Jgu`F`#0B3Whz8MBA}@g4ems94;_NEyXVT(QMi zorDkUv4P7pJv=g352YClzL>cFcxg0ZPREXR*=lira~9Aa>*0k>`tLO9UnuNCKe67C zaVlgx!kOm*#=Mi<)Gs$OM$dWNslT>E;P9V#5mQo1R zSS(i73ha1)S6!Ghs8rG0e+~hfh_eRKTOHcYI7!hm zJ4-2u8MqA`=Z!eU~$AhTEMydr!6LTb{YCz79V2xdaJ2n2PzC`iDS@ zQ2El;B|STu;`GD{H;n%V-vE0go^0R2mJu?mH zt`R=QH8qpBl$xQil~h$(7~U7^8c+ z)&%jp(A9;`Wx=yrfiGW*3|by)RJZ0zh6;8}D2Bc7fvV(XmGh#V!os=(UGKxd}lIy@S%PfyPA!6LaDTbGpv@I*wcShOxLnNd5cxg79G~U}VGH1qm7Iks2V62!Hi$Zalg+`x zrT#UQzQ2}w9##R8!WK+#Z+}G~U}Jna93vGETXSc+00*PMrO=78Y z(>AtZ!7T$+wCRE6a2-yXnRZPFo?~k=E>LCsR*Pxf4TGv{1|Gci{CltFM+bKo{}*ZP z;iiWqA9`WJXcHJdpchOA=%@6QOlqj>nVx5iN|ZM^Z+a(Wo#6~9GhM2%U7V42M23M7rqdnMg*-8hPTWBj=OedSR;o7HCWBJOqiRJ-%!cV&c@o>( z6Mp~9+0&e7Grdpn{fMnb%qDzd$%d+19IxJFi~sw zmEd=y?!&a8B%eG1{2vc!G+BP3(}EJbj+@X0ez)1;F69Z7+6hV>oaK3|GOTon0^lU) z7PLV!r5{>50cdjw!YCmqhy7a{_ZRJl)JFg#HsLf*Wbu}`;beG*4i!%eCo4 z2}u%kfn#3|0Iyk}s9>uT=-v(x&rIJo`SUJVGYR8foWrwz$Ep=i^`>-0Zc?2@YUfOH8n{5&sV7MTZy_PVn?@SlV@ z52)7lTxOoVOpz-3)2NpTOj?@NRps)rNMt9EK zdAI=dkeAS+cA~r(#Z$QVe&HZiyYrVo4xJUTYFLiozWxA zjB!&yVT0c>G`CefX}x41cKQ1Go1Vh~V{kX5|GQMHN5)D!8iOSAkJ2HK~Ng5S$nHNW`)-?HxT zc>|yWykf!N)x?=Qeu7kq#qV%h`<@6(F{%AAegxt^)+?tvI1%G|@tEWb z^x08wxJbYWK3oz|Hu`>y->g#y<S3`fl12FnO0{HUJ#7TH?zkdvwBZHz{)T~fMo_$qUy z)ZGO22wD+=3FNKj$XF->+d%)l8ZXP=3D&|A&``gNCUN&vxgx6x(|bqngfpPaaJSH? z5i==(QcJyR&#QR%tR!;9+P8@1qsuv6^CAIDHQOceK%8=gaZeX)$cJ=9jr}nn6;66U zOF;(aktneDf)?FWy<3uxrBI0jpQ8j2*&m~lS8927Mu^0CIIkrBSVtnWp1tteb+k`| zjnCwt9!gC5FLW1cABQx{ZC}!f!NPDC6g~(9Th+SdYRkNDv=fIS5>Wku z<<}V}yew}bdfO-2wA-!`pf<8vS)OfeVhMV`v6m5m^-@}8rs7E)J+7@azr$`PxYOBz%Ot^@=<(>R( z(b;#A=fY9vdN&|#{KPD#)}KU**Fgk%{e{Lpt@csiUM680L;y}~lE!e+Ga<$&7B7d@ z$d`6;&}McjI@xt04S#si@KzC9MFv)2;f<=NdARjnU-9pENocLx!JULEIAywko_{1`<23%OsB$ARmkCjeI}`{Z++KO*p;3e~v7?iP^GEEFo5jWfF2Ub^Sg74efUP&v%RZmAV8 z$5?-=^VF_7CL|<{32?f6+FEVKw3=V{t8gFPCl+kEZ7E#9O1@s=8Il=Se&8MVMka`! zlR!mPiAvpJn}C8ogPu?%mVgu?iQTE!!;6qkDj7S(RNEYxBg$>({y~1KkO-`X9wN;2 zi86QqNWu9Q;-Kvtc*ReZLmsFns0Zf)4NIb1*g4s}S$J7W@T&N{i$;evX%_>5tA3+l zH*D=`{2E9uv82WcV@uW12#lnf{a!xRFZD~YaVpR4GMiP~_0&&>G z(40U^gly*EE0^LSjDJ))L^igU(jLr>(UX^^mv5syk* zkP>h8nvP$a+1UM*K%o>Dcqp!K>lagN4ZjRvv}=%+CqLs0<9l`3A>5cUQo1apMIu(G z02jW88$8q@*NrSFv4A52IC+sfXg(#J2l2Z7sA2VvTp+ZnBQrwVj1a#b}+$df0SUqFJ@(HWh?V^ z=G*905`pr=`$w{6XeiyA6B{9+7>+H6_L!++$|%gzz52>!lPAiHr$w5bGyX{%q&p`8 zxL1Rf>mrr$E9&M4&xHdQVcKFCz(cMu_%$;MU;9rU*TSYf5Th(J20|9S3a`q2UR@TL z*HFHHir%5DyOpTXUY(4aQ82EB%N#PV1-Zc&1Wiup#Qz^i#ShZq_A&kGmu<$t< zVPxC8^Rcp27qj3?^v>$U+@+HG&}gd2eB<~Kn-LrJH1^=O!V6Tq#$n%c@oPwlw;_$Q zVPtMt0f}Z52sj=#)nj<;Dy#FmcKsBTD$PLw;*8kAOeQJR?OpFafg1k3(;ODnJ#AdT zD_q88k=*D7p{yMBJD7pqwMZ9O-&-ZG^}|@2oS^@*W@5mFi8y*Ybi|-8Pr2{)FQk5s2G$< z#gg+#vNydc#%W04-e$~#qVOlB8HZvkainl(UKpnaY*YbmgGL)6CH+7C;}HusQrSiL zy?>vJ!Vk3YnQ1j6ogptp@0Mn)Y?jPb991FHNS!PLWJ$0n`8g^ch=b`54cl?vHR_Y! zV@kb7+#VZsmxqP+>bpGt`YkGsav&lu294k{o#@Xncs`h4o_0ESR7C2qI^RgCx-aBA zH524d$l?j1lU~s~1<7nC{|zM~am?JbFKhE(ktGn9>TW6sR^1%(n=FuSMd)K0E1H(b zK)G2LyX&m`hXHjs#Y~aCr!P+?7t8`?k%%{*W2CK@LJeYSXcyd8}Y27`+iX^DoNKWm#wQt1SEP03guaZSxnE zkTSGxo$xOXj|2mPPV9?S>BB(RQ1(Q63z+-EqE}F)lva!wzoRyoRtP;@$_fUML9F)Co-q+iZkCD&EJbLn z5=(=%r#e{u`tJK4t_kwPuLkY%m?+Gf<7y9A#=?FsO_m zZJU9A`vhFjOctb?a^`kd`?~wLiG^@3VFi)J=5B_b*@1Vb`n(ugk*fHU0iOF8Ij9z> z#nEL=vH|qYH(&+EWa8&l_R3{T+M@5#Li8s0juezKDEno5} zB4TQHP)zVl&qj8jBfLWX0~eh1snqv;2+U^LQ^`BDTvg-aN+Ut+gpts$>mK{EPhDq@5KACU9IW{m_jlw`t&laO59&Tc~kSO zqNU9X$nZ3c>d`n6F>sRKv2JUN&>Cz})L{sU=)^7r6ADt^`v4dc?Ek)T0#lt+t0;&7MkZ%*yUq%I4+Z5KW2WiUp4qPF_mX(EmN5MIeYR0() z%^O9CI951l-G5x@iE3EoF~#$%hPwCVnK6A`qi^LzTA7^=v^w*Bx>l_1GC`I_(~cn!pb@22Pl+f6UNtO zT98cOVyxs%%!|^g`}N{krLM9-toQhUL^h@153T^!AW4eb3UH;B^^O}d!qHwQb)Y85 zY@4|Rmhnp4K;nvO;?XI~Wynpv6jxqSs^EL3Q~Wh$t4m2X(h6o-=-2l-b$LXplEVSF z2yn4idsoKZ{B5-XCCmG*s zj{g8ed5FFWqgfbjKAiFMZ{}IsBNfqBY0el?eE+I=}+ik z%h*U3nEjJ7hZH8TttdEVEJ*N)Lb+NZzGBVNTtME>Lcu(jW=oCLg3r1)6dd`@j@nAZ zJ?=MfSUU>K0qRvDW|{KTYUx-tQNJeeinV2{p%zB zJr^Rgp8@i#tbe~1x!X*C^^f3Pcv}?5 zu2UG%_=p3BB08#1Ti~uD*;HcorR2cD=%3pJaH;XRwdx!Z70#a-kR+=8D%*CkJk|Y~vJzAHB6K=m+?lv}bb*_Zj>!Can^9t3uVtB~pj}(YOjvF|qj>R`S zD;QEL@@I}LzEsNtnzuIKni(J?iR`RqUj}Cs0qDeYi}&Q(HHq5&jPnCBykyhDSFazQ z?5qnCR1^wesCc{B+hU&52PCY|zfD=~*^m{l$$W==5jzLpo#9mgEG$_PClUS5(-CI8 zsX>iG$sq;o=&U^QLl_!`67PlOH(OZ$h^-GsR8d%8@u`}yYTSj+^Lc4y?kYv3<&Gx< z_Too%-fn8CqSDMB?dY+?fZ;W8}p3ytu;*$t;szmCj#kysjGOpQ&WWR;jOb zermZE*7}K{-vE1pj#YnMJiK4&%9OlJ|H+1RDb`3wP6+0qtS%;Tc9U$djeNm%O zclhbDfbF^nVoKOW*^)YelYnb;>&stO;L#EBf9h1X=s54sR4%)X-j50DqRpb159`hb>1ywRBkDeJ3{G%2B z0hk5#N|0wnp?-iB;*;5jEsPo)t99w4BzH@PGhK(j^(0R?Me?nM-!fBbXL?Y$cuT1%t$_da8p1piO-6N;MLTAOt20P17Hl($+KMbsa|DyeI!K zJ*2Wng)ds7dJJ>DHcTIb?tsi5eo%Dd+WH9c-B#fi9q@8=I^K2^AC~=hM^?P zwAXVw{^;?GtF)Yi>^UxGfPDVGF-s=GvP~XmOcsu9jGjRiq;4~nx;};ev?Yg#nc#nT ztSZ^J3hxQD>9x5y;9}31H_RIh-OL`?CZ>}dD}Mtnkrkh_8B$E;rJI%yLS8F8PtBLd(Y zzR9LCkV3j84r9%I#5O|~(DRrFbePzUjh#WY*b6L{fBdP{_qJ8wQF&}T*SV3=&Mbj? z`0_{cK!O#SjAkq?TH={2M`a~LM@dN-OLHK;jf*gPkgyB11$lpXuKH94)++&uY^Mzg z#^{-~-J6w>o@yv8or*ibl!Fu*jGUKhCGa?>^2_#iT%~W0 zUg-wPAmz+|!{W!^LsbyfxZ)jFgg&>5*Nl`pFXG#88Y|GJUP9OOE(v?9SN6sCbk^cH z(uHJ9#VxPVKt$V#YedL_tv(OrJ<3;y+FURaiJQ4~6yocnR=i(Itc%Rz>Cvf+IbgFF zzE}-?rLi}dhGZZOq$R~~-{O=@4FW>q88=MZXVa+Yx0oyHUH+|c>9n#8ObR?eoYlgR zV9U1zSXyNZjtnEBmz8maT6`?sm_&^w8rAPGUSq2i?dmd_k6Jdh>05cTAyIB4LXr3z zH)y+W7KI-Q8AN}nnC$r>kZg_@Qm#@F@!9N90*ECTQ43$%9JVHdvy$UjwMvcdyhlkh zXUB}!3|wYE)i>H08Gf$j4kmHFLL*O+4eloftk$2XDWT(zv|-m78!SPz-m@VOb-{j_ z_{nVUyw-KHTHPKJHku;?ns4l@YF@N>0RukqS@bDQYXZ9KCyrF+2P1|~Y^|B%OMz5v zE)X_+wfcN-?CqoQS+GC4^vH`l%7324mf-w10H|zrvm`2Lca>o#t2baTyNkCZ-Wu^i zH6Z>jE0dfSVu2-EqDCHO;DU0Nqgyw--iE^_HjP#(XRAQ)&1&}Y<8XZe_QPPHP|K7A zVOCqE&UM`T#zrfR4P%gF^oF@0%k-7U$(tg0$bi=mSqfF*0Y6aUz}z+;30sSRV}bXw z`H*IrK{NBohTnDyvLxEpk2_dHwr(1wyzbs@;=(Vf#cxJbY1Y>k@@ewy8$`@xbY44o z(NzDngI75Wp#!`|>bb~?hN0l=GCF9Dd*(&cG`|rH6Fae=zTx9TE2jp97B! z8W@$KQ@n)uwCdu8*K(JxZHfe;DG55`9ocD#c6v9*Ilu<9uyE94r7geu*EJ7C;rJ#o z95S3^&vZO%Y`kuCBQh0C-3;BCTjpzglPyV6Z^o5Z@4&_R!~mWGHZ}!_tJjQB@Qg$m zhh&mqMmO=74^RfW@tIt2VE9s<)}q2C{SH=Mooi8E@WYS`Q*Qg#H-li(4_DuKZ&H8& zKa?eA5Bi@q%o#Zz`pTm3bTTw%eTh+chaKkdn;VWdAaZJ~^czgf4&g)A7BXZT$~RO2 zm#;9RBM=5Apq2aOI~FqG97j-{YD&`b`^ISdW!8Pu0{$pBsHzno5yp7b1$W_5{&N72JXQtaZQjhPp)LMPgYU2pLcBaUeVbN9|+N?w3E(YrcXAJK= z+`zLg?Eso7hG>{5bEff>XMYB1MtNLqKQ$mfP)b$Sl^FfLtj)eF}`VOTNP zgEm&+WJae7R8IoRMa1);XC5kbl*_)IQTSZQ?GQK&0g2w40(GNsf9!w&cjqY-v)}-S zjA2r}r0;nb=5NFp{7~^x&Q~f}M9)UH8(19`YFUKwyvI=4uSM)HUpVzAPi1hpT~M+y zb|jBw*Nh9-@fXZlpbU5J?*(c60o`=amdsp?99>uu)Wc<%^r+yfKOPb8)pskdUAIIo zl;Va_mb>Y-6H6+Y`)pAdaMf&f{fi76SzwbMlk2v4|Td@PP$ob2&G_NzkTojra|$09nZDHxKbH7a@?fq(``oST!OH z6A*lvsK73+u^Tss|DJ`U<57l6UyPjAqlchK?YO3{G3=T7W*TCvChiy zwRO|rLk7%ug#pyr?wrsT>~k7ToCka-w>&|x|CIQw<6QKy420U|P3-;}iyCn7x^y|E z+|?rwS>+4+>pKY7TFrB9?PvH`fH?8%8#+uGl3_|*wOM_P#9N|*w%gxPW%CSXJ%9J~D~HE0FALC+B0 z{T%DH*M@63asZDrJ1*47ch%>F!N<_7wiu-T^Z~_=8L|zg^DOcXxM@=g6D>T zy}N_R^btSsb~0^GUK*`Yn=2I;Woix=PK-i5h=N5!-(QfaVOMrH<%U1*gBT?HV+6Tu69H zF9&363)`lwS}f&&2I(wPm!B2dy+~@!N%S6{L@C|^|CRCh?!%HRDPpr7nP5@Q$LIzF zJn2{hXXkPhzxtFBx9m&K41`_iR}vsf{@3QZaKUpVUG?}Z{FL{Ef1h|?ffW`00r}76ZxrzNJB@tg!_(03gv)Ds?HRVvi zcQF_g z4nUKj?{6u5Vje?U5o~%0PK$nTjQNW+u(P|6B#+~V*PbGN@lD6 zvo*I<2r06yRTWTu-LEDdLmvA7ncsblpf0rJ-2cS|jeqp0JQrUGosk`&kwIhY%8KPm zc8EoJ=DkV(&@C8AI(;x|`l%QSSQ~IdWmyl0fc$!sJjJyHCr$N!Bjscply{z;{d}-E zZ)i}7iCLb7vezF!y6qwO>~i{)W!=kSQ~_8qz~nd$N_xX$m8zLzn4+OJcVT&A>~pZPH!R zKy#c*rAolNz^ISnK=VB#A^}=#Qo#B9KdGr6#e7-79-LFvwrX2) z_s?Q4v`xqBoz(g73w3d|^w^iYA?p~|)JrOzP7EE7BiD$RLlj)vxdl3Zx;>3VU~{JP zW(>WP_6!^*DG-~TJm#aVIO~xZ3)nQ)+M|hFG!G8VwP*mG#ArlZ4L+kN@190&zLM{t z;QfW|ODM=hGt^R0{5HBXj)dk$3;-5q2yiTmIuS(~3_j6iZc?-m<{tS38KK#vcaZF- ztKj0>Wi(`hnXU=An$?t9t{LmDi#%AN%4>G5hIES3_P8*4#!Gc?6jLC6duNx`P#w6P z=PYmFrNE6}D}lkKPQTUnNI0rmz5q?DyHwLPUt-8X5ZTg!4)Y5Qx}UMt0F#Rr^N?MH zONd26mVm)7wWg$lC&@e_CJoqjiad5Mw;(h-MK6zgQp)I0mJ9b#aj&wVqXbv~u@Ik% z$oW(J*ONQM7D~0?D1x@O)C#HpHYKsio z-mQxq7$@`T29c{-dqIj8ni`ALLRG2e7J*w;`767zHz1uIiTUvNHa}0cn1B-T=khmm zK_x#=;!;+VSm}y(ApgKv9uVdrG*r8cQo?6xK4pTx>?V`Y`0tHCaz9)iVHP4Qa~&p} znJvU9t5J%;-bDjpCNg^xqG?RTd%IYn zC9oC#Jhj(>osK&Y1E*tA94FH%Cjav2K0r5yiNJN;CqF-tOs@YFqmu4AN~yfiLEk2bD9 zynKp7y;We&%vgeHXHEgyJ<#l}Eun>6DjX<+X`9i^<(6L;YXm2y zTGvcS&|p$$4t{?~$t+hl0@-98sxc#zc)1Pgf>1j^Mm62zXDpAJSs9`3_}ZUgw3E7IR6;dW;$JY)ikDa@5iYVj3V)k=z7@E~)c#zr5R z|HWS8_+RWb1|~MP|H0N6@mcAa82)GV|I%x$9IR~rS6;*a|I=$R%Am^2J6Wa0#Zro3 z#a`lo3AeH-&i;U4p_u9Z1p>ug!ipfE#2|nr0>vd-{G1>l!V(iWKbC!ew;Ww&vmY}( zcDrZ2b50!`(b6F)I0vu#uyfM5mntSksnSf%h`fX?&s0P;Wp$*I7T;}H>n!z07Se^9|h#{ic2bm2t& zdLa40VF3xn+m-h4cp$?YpdmMpYe@ZP{qO*jlamlXvf$)hL5K+82r&8Zf*t-l4LCUb z^8OUtfIy-j-&G)cIOr&oLbA%sTU%Nn$FV2@MA>(b(16_p=K zxBGkj!r~o(rnCshc&1A2$dg#X0KoNN)(Hc!<_l~x#h(Xi9tT03(o5p*QHd$I4TEsb_VEC z5}(&TmhmC#fnQgBg#F@HV8Px(KYkiq1N*Uad=UTQ~C%)sZjwSk366 z@JUEXNr|9A{CNQNql2Q(>kdtMargIT_e`%pfWNu-aRJDvLF@sBA)|kYUW5X>`vFjZ zVBzk+?qdD!!~^*KiG~3|>%qB%^o#$L$1(?G{jM95#Q5m}s2Hdp`~e#D`ufyZ)onQj z4dnCu2L0gGmglzxrG(V(+4lQ%C@Jk>`sLIG|KU^9l7In3PJ{y**GKvLseNGm>8<-| z#qh`T&5^#!iP)qgW8;5;gIxb-84g{^$=?4^p!@dsabff~aDxHA{}%MLq$j5XzXE^z zCH=Wg{*8Xff9|CpWg+~X0h zf^!MZ-~L^!hz8V8%7=0Y{q+h%C;|rpa{UvKhokjFIIqLhpAsUVuSdj&{CJrL2o5kb z{5u%3oEd=qO2%(U`n&-$DtW$3y`%?kKcbt7kdgrAhX5H5L*a72mWA2}AC6o?jQ*Ih z@-K&gi5)BjsJ{mSkhKT7sPmAN0u)a1%MkxlSp|&Y*DrbXx?a!qyYajF2Q%uABVI;! z0QVTDQ-#ZxqfFW44qXRJ8SPNF<26Zl%@$)Wnx}|R@}OqSr^$~^QTF1S|JhwQ>sHP@ zPd&1k2G2l*P`~8A;Kg!)e1RfymMJ+>H|{1_z|Vp!F~i zvlqtX!%z`JrkRl1HK#;iG2oU165S6q`pA)=?E7p=Mg-9wlLLbWW8(qd;&a^ndxbUk zLI=Z%+P5R%LLTqHJa_$ZE>y7X{YNckdNw|*-}<9H{KNwTL*(I-#n><{vpGo@x&tw? zE&etr_id39;NqgWc9~bo}gc;*i}X#$~qCkwYe|}MkJO?9;u$iDgBQH z9t1Pb!kMV%JTnXGbSM}}GlFL}%aJ#6BYJ!K;yN##T5fq~_jl2f#X_r+oTR;Jk_!8A z)s#%6ptskoWc$ry9ae%KLux0c2%PU4Ra*h8!nyQj^&IRq=D#ZiscvL5+{ zJ6COzwh(Kll(idH91@{)LFN4-Wn*2Nu`i`^Fn(pa{Zo~Y;Y**zVyk284_)%Nk?l+{ zFWNsj?7?EtS)#!BaN@X5rZz`c+C@?pxbSq>zl40O z{n;#k5cI+F+rJh?e=2n>@`AyI<;OZLjE#-H|H^zi$%H!(zkmJX0gW$4AlP! z#4QZG51YTwq^c!eW5@K;?EUeytrRCEUyd92K~D(1C^UNMDnOM%q|KXcZKaWr5_XBR_~rq!#Bt8} z@45r`WU=uzPsc1WxXp_vEL&J#VskuY9E#Bc6QPW~L$+e0oMa{cwfKZ~Rfa*EWYN0C zCo31EXxl%2V_lX84<(w7sYVs2HemW3dOM~mNWz{zC;1Wtg>b$5o5C1@a0;?R2I15sq zyR~Mg?aM-F@aca#y|Cu6BJ$1^Me}$CeV^-n8BHw?WnGNis-^9f*)(d(s=U~~A8mMA ze3KDgw@Jk(n{CS-uVUrBFq*(EMUp>ULWH^5ddqFhtW|<2$ZQv*z9MT=>`v9!R~QMb)yN z**FJ`m4W^a04CCRZ{NImvlYs%JmR@M$ zk>FLWtCl(ADPrFn8ud7gj|btyZn``-z@A$aH7D^M+>7n`2$n5 zHjjkNiWPp_V}ZPB&d$X26oQi`=c-=ZCSp^8z&Hu2VXn#11h=~MJU^0{*-0oy{*}C} zGSqY50L{Pjy=(e)R*gJ_$k?_Q;@UJaZO!+fC5YUTG#1Q>0#QAI{u+R4cD;ty>5z|R zlJ+wev@Au>B^F%qq@mMC#Z5caYtz8d#_z5xE98VdcWu4eFqxv5XtY#Vad1J^eu;o+ zbHQp$3DQb|152)eLfkT(wbij!@g8_zwzfjk9Li?z)MmxixF`ixfR4B?Y2A8ua$CvO zp=w#TCrEsj-POFbisvA*XkhS`0>{+;LuyhQ{Al`4`-_PGYGg10Xi(65x3QKp$P&x& zDo1&kDV?=9>OpXI>ohFs1x3!YT6Vls(&N6H!O+wXd3}qtX(wRlxo4S$R*Y=yVw^Xx zuI;dS+df$>XIGR}yL_f8qDkU=KodF2nfDZIcR zb%J6^m-EfRG2{xD9ys?uF zADY6l(D{x=Ea>p&6kBzUM^A}Ns?+O#yMz6Bxn?rN&p6lUyby6+?%ng|4PUFPDqwl% z#P?f6&+PjI=2H8u@4jUM-asTESq{T0k_4%2I`hg%sU<<_dzD@bi3cEICRNYe1}e4+ zT;t=sRx%`+C?hgiz2XHtgxQ`hef^7}*VAD(P05RrrEDfFcONQ6|CTfg2lX@1&QhPS zSxK^a1Tpqu3As*G<(!>?D216+-91xnmZEad6pPfh9fJ_qyQIyoW9WMFX|m4rqwlkF zs*IOFq*`5wTI_Fv24iSKFyAtP%Ky-^C<|LNcMG#scnc^qa28?@n0mXo9GF>@2cPM8(EeNtw3j*FCEp&dw^ zR1>JN;hk6ejPrc(Uv4Rnp1vyxv(j0++h|hTyvH6>l<(jg2uJ$h(H1ISRXD+X3|fuI zGm5jFvVnXTRaK$X-oH|)42#s-@v2$fFI%O2>PV1ny$KIdBX{R}b$7qHM!VOCIM1YG z2SVoQF3q54S>Yr}7V8tk1`*YjVwvGxobP2?(v+Dug!M{~c1pfT*-3nPUdaS{O@}bw z0as(^A*|dM*E=DPF4{o3IXxPod^S~`Npo&IXNImLak_gLB$zca@^j3cI1J5wHEMw+ zi-tq8UpsZ(U@YLYrOk;`LV3d*PCeZE{&cGYIf zKA9wEFT^3=6>1YY{CY&Zn`YJ1C0brH_A)hH;wAqT;TGZEam|I_v-cUi;$^A`E(DIooJ7Fm7L~_?dG~iL$oSKlj8@75wrVo{LW0I5kMsS83;CJ0$IaAfNGr>T_iVIAO2Y&rYu*7BQ;*GeSMjBjP);ITNRrJ@ zR`E2TBuWCx+A4}%pYmc4cK`g=)oondQ?w_Xm41q#-_w*Vg?mSdd{a&Y%8h>}P}15Asg# zKQaq(!V^=0*i3*Xxx|HQ<(8Ox|S82*9LCvpA?nYY)OGuqf;Q40rIiC>xm}dG^#T?H!FW2*5mS@%!^JX0%qhDAClsd+K;s3&ge>Z16B{#CR zedY7TvKs#2#p^dTF_Ouya@}mDE{2s>(_gzYTY2XsRNq+}F>9=BK!jG&w_okvCvaZ8 zi9Oe??{?>^3}vb6h(@=mN!tRIBjQUyfb-fKp2N-T`3MLzV%loFe(et?vN~H2b51wp z3~Rf}IFJ0k52TMMG-cqz4&lHvr|GC-3a0}x98IUWDmY0wK`!+Ol0~AAXgt@}3mv^7 z_|~+4#KsFKX^+InizhF&mEw7a$xqPwyCdnSoM8xiQgP`Ox?#Y(WZ|bOzZCEf>t$gA z?nmL76v_7pUY56Sll9Y5h}-uUeGe~QNuzf>w>O*_)aDTlHW6b+x`XzU(OC^9I}ow! zoJXD5ZrJcz% zS$-lyg+H8{yQz7(bXm1SFJZi$fUtkG-v@z*J565rr{LK8ye@rpXr<@BA#BP#SN8<- zv#92d?NMvz1vUhnANzRKJ}c6NR8Tf}0*2su&)Enc6EzwQ6Qq&GieC`Yt(04sR$mjg z=ik+zPP|Uu=Oz?jg#LB2fZNazbc#RSzS?1E3^LzF+fF^zkz)%Onlkj(&oz64vrx$s+GU36e|M;RrX?zLT|QkM2fh$Rx}HTP~!>v>y=A8R<18fZ3FR% zD?e7!5D328C9a&o%9?i(pi>YiMOsw=4-6%45NM10OtNLvsc}3Mcs34JOt6Pp>*=8h zufU+qZ$e(5=oN#mn>kN^xMq?lL&q>#qdH5%qP}C;+akqmv%G>fpmZ*kUP-v7$D4LO zEF)le@-lO0aNg7VR1wPRh-QH>r!Wm0Doegxf?fs|v~Xkh<2(`g)*ApuNZS+$MJ1^C z0kb@|D+ewz=2kMBN=Iy1vVkTQlx)V-;$rBI{1u#1prTFpxVLSWg1xqrZ0P2UVk9OF zky`)H6b(+s(Tr7$9*+J5)>7fJK3=2TqdiH;65Xw~#(*@B$bh!k+OXTBrNwVtCD(JHLGx28tXxvl5 zNVQkr?ppE!CK?O3KK+U24fJll0eK5p*O?=hIG3-X^-gHYe1#0TUYZ*QM;R@xAV)bEY+Sz|A3mcB27&?V=i zaaA66q+cUSLDa6&yPbV75t+m8Rr;Pjw&wda!(r=_1bx2#zQ z2xGfY^Lp(ftE1qNamcvrX%B2~FEuiGvNp}d-D`Q5DyAVVWUD=uB{$F-r5+yAEn?2q zt+>Bk#)syDmrH*v!nz4O;V`R;B&Bop5mD)NHWVcL`U9YJpO>-cSBeHhI`XI*jTdL} z3k^z>c>uY;u{<@DAoTmcW3t6W-wA7OBSG1Sg#le8ZMzx(0}+h!C^QiT!U^gz*`4o< z`n|^szWVc9F8-9)b}DU%-(m;n&_{EQMW~*=y0z0Tzvzjkj103IFNDR_u6;L1l!fb~CijT;<`9_syCI%2sf|99(*iFmqx86nVBcp4F(V zsJKTq+2|d6lnie`dijq~0ezN0*{%fjj5sYD2Hr~m%OydZnLKv!@?4b1#H`N|>-Lg7 zv-M=r3tv}O%O@m*ez<_Vcz0e*Kxjb3k0HlBqLK*phCI?wepjr}F^HbI!crKnLpGb+?RS zSA1IFE9}bLUX}$l-?_$|sZf_>lN%vgP87C41tJLyg?vb!vff`*Dmqm81w9gA z9bUdrwmhsK%YW2r8Vt5zHLza>oA#2}8X<@)oEYz>8 zdf1tI8LH~Rlf9ECGsg?zJuPN@&BexuUh~_b1aFXR`+4H1CcfQzO!M+C@mrBcW2Sv5 zZtZYYrc;<#nld+aIVP`Wno1|E&3*N_iyLLn`&1P@>ZwsEaRqSx#F$X$h*<|c`%za` zF!bCctwKcDj_$o9y#(d6_nWo1`P9)Qv`{HnmF0R=JvubYl@E#K2N=)GUMwEy`1hwe zBR!|iqO(1|kyH%b?5gMY-n`J=$52^*bL*j%Tnm6id9l z>vN;NCarg7zybr2G7v*I-e zb`PmlC_mbr``+LI;AFyLil@&YCfuN(X=5diMq0j)Ery#ZjuAR>b-M4e4n4l+&PjGK z5N7`(rY(#cm_ML(;!R}Xgi2K0j;)hqQe^;xNZ1IHEchyfrIgF3}Z zD+pLmiS4SwNoIE{U6TJ*`!jb1(oOqZ@l5&T-r;A{JB?epU^?(iC8L^Q4_0v+l{iw1 z#;S=BtzR;(4J;5l7sDaQ#l%`V>M=+5ke5hLh3*(+MqagQlh`5aO*e?lU>r?65k;TV z-4r^~V#&XC8Vr2Nh_J*Zvat!Gq08zQj0) zooJR-{85jIvr~=r*u9#Xb=Q8&DaWl=QMBz;@^K@~NwgsHaxApDjF?AT8@RG|L4BgY z!eued&OW9wE#cZ0We9@2v9(ut5X_lQ`E6L>dGZ6S@<_z~|7jgNv`S&)w}vsU6tD9eVU&3ec@?JLbZhxMm8{km;|g0 z5HbuI5%F&XP~k&WfB&KYb{L8%*v3MA2?5A+tU~I;j0o)THj1`+qivG?E80taMC zjsYO}XWV=-=(BTRMIjFKBldAb{zwIJo4SyQpq^Ypi5fB%_q~*XxdjC}oZZrXly%Ta zB$F?`-l4+82KW0e__r5{&cxq`-746$@MC00{M};{r$8fsOioBlL;)7S2g=vgCtuJ5 zmFZcS|8HoA1Ma8C0tM@TU@q`|z(8>uw2Th?=nqtHd#m8L_irW1NtB8V%)fs?-5+=v zF_z@p%{3bn>eDLbst-l3X30BSk0R`#c+wScSElRU|m$_vg?MwJw zPYx9|8NFXkT^o#mh8Ps&AH08Fn7x9Z@%M`Q_BR<+XjcHD!hKz?fuD!uuOi^}?P)0X;GR-{%CFbA*I|JIJw>{+Ef#1h zw2Lq1rmJer^dV(8n@n^2GGdDU3N~fLNruPeRk3t-1?Pjp2;Sr2=sfb!#^U{h1wUHA zP7`7scwJKv+G6u#z58VkHPz?fJMbQy9=Fg2A%*Ff;sv=P^|Duln04~YYVd0J1lrP> z!J-b*RZ3o-p0oby-IO)3HlQfEGL8k!y86j>tj*V$Dvq}Fx?mN!vIC3l>cws8rfCuS zTik&|8I=vA%wD%z^$`;ozpr=F&f2HQVZK0Fm(-;w2Q6~W9B=G)L9s8{$MCgR3ICx2;xdR_snD8zE+~-KMF@Tps83DAH`48M>_?^G8Z2IqjeVV{q}{b+(Gv-pR=^Y@tX#H z_x7VH)1!IOh3uBT+Av?FRa%TM5ye0wuTz&9b%UbT<1ubahkqwZtC$(sip3ay9yULw zes-F)`TAx7rJJ6lscSUzu67{PUb5$?vKubF&TnRlb-Lp|2`XsKlr5#!iFe5IR@vi# z>|=!+P(a*n+>M?h^9Pc=N|WPG`PG)n76^EokD>#TR!(>9r`*fPNB3)e8}dHv7UUT= zl`68}=i(By2NnMe(6zZV9`AV2$WJ)8E`R0TRFiUTOm|$k)I~OgdV|+XYR$K=9*)&V zRRjIbO?SnWuIBTeJjAO7E*PuHC#Ntp;tA|SB5fu9=Xud|^`}6mjkqj{t&W`mtoYve zaJBr2Z5>#F4g2Nu>pcG?US&C;IfaMWkTHp>?m6h=_#0B9XeM}h0{&hBA$ZIRc$7S` z=zX?6Y;hHYXpTo{pp8}SnC!xG%O2~(C;3h_zJ->hy6D~Wr@uTTR1oX!*F8h>+r8xS zqQGTL8&hSI>FdHvXUvE&T8n;cby9Xd2j+R~PzWwd>)mx;}F{ zQHzp~#7IU@S%w8z>j&4?4(9ik!tpt|Uaj*zW9C_9c}|MW3G>*zVg8SSq{hV9_6moI zdjf$pti5%~>O>vlwF9e#C`G>k2#}7;4A}hgdmnUsNs20PYbaDA2<)DOnzkONrqy4R zf^jG`_3-0u9|LTC?T3xhX;$x)OWbY_<+5pgeWF<5PtWP8i8TIII~?pkzs*B(n&T$U zz2BL;ceTTARWQ`|t?90hof}KmdVMKJM#O&c!j`1>3%%1=f?U=vblZ;24HF8lThiXnoaeLr!!_ ztq_I0`6ow%;Cv|%4<8Brc)SRIM~vsE6}r$)tC*Fzq7C4Pw{Tl4EvNPnzYia{e3!ZU z-p6RXlIYq5dly|pRVCb+W_Cb@ciX+@LU+O4N#r1(9abE;GElE5@m6f9=}3z}ONC2# zDNHd=_OK%jzSLMKlTvc8$R#&#rHjQfYFBmxT7rSodtxGqgfd~@gs;Y_{TGw+$lECg zYeOs(d4F?_ub-k{?h#rquo+FIYfk?joZngo*olocN?p#cHvhh=`8ai8IAGLW7Q7BR zw&?hs7?&i%rhm&h!X|2b5ZXa3ol$cooVDq|9Amoqrc%ph0VYcE5d`yL6)xk`Gx)j= z_@xmF5XwHr_j~3Boljl7jwWoxOn{fK>ThAzish!a3;|mZmRfQJ5Z(!Yltym1)o+l56}lkJdbPjAE<3ttb0twK8jl4-lOuVaKY`%?De_CG ziRhRQtVK5221jKj&1{7tLxX@ny$MG?z)~Jb7J+dZ%m*lHbW#KPh%Ao#-%>lrWt4kN zj^B&=-Mr+s(`}72-`W7WPt%D%PNDlNEl^MID+xdGataouGYg@I$q1M~vjM0e z=uCE(9HE{yBzDa>O`HAGPy`zp7UDEsGOl|Z%cX}#sX=k2l|cVFiSE#(#3ZD+n>j~5Nzti6gYWJtT z>Qme-@9eD%bXQT8G`V})7|~w_rCNpsu$&5^(RPcj7cv`?l&U5F&8A6(AC6&3dkSgx zB2>lK=l((WiSn#ceM3-`gJAdN>lT zU`zC+Ev%4a*PFa+%A{#k;D?xbmm_?YhQoj7kYp-R`^OB45>}kKFKk@ zTu3jsj?voCWB_ueIX`{RDZJ7t3;(_2A}34f*H}n@+%@dc!S-zUJ{b*JXQ%}7y;}9I znl)3_ODATPs!UKE*31%$j`#*<1u9mAEI>$82QF!=UlcLe8>16?ptn? z{**C)(~Ez(hEw7i(sS3!aMDJa{{h!YnEBp2@meZ;@>3EHmH01BBQ4V;J6T0JQ@7O+ z9-E0+6Xk8ivqV5Y9j*(gm2QwMu=9tanWYy(bvfYdf(hRt=vziQS}(Jh1aB6Td$k9B z8q_%J8&g?r*QOTYuDBrLkyE>GY3*uFqa2{a`GxJ@aL8pXyW7q0mvO|!zle+YieTyR z&~VR&8f}J}v3G52ZH8DS9Z2|#K7I?yOKF%Mtylx(HBUmsg%ftpqHlJbV=dFx0%yUq z$h<{R0RxiDvg`b;m)mruPXYwhm#EC& zXd*IsE($RLoyS#ViQ%=g@^%(I>=h=^+B^`fHE$fwf9-v_1)BF{bzI_o$g97I&CJ>y zUqCMQc(7LOlHMaU7<2-JeLa#SyNBUYK~kW=E2*cS+`LT zW(ht*RuwuWip1Hh{vN2`m&NR{KJn=oNx}3Nw1${S^8H+l+7rLe%vJ#wKXAGWkRmeV zb^RsXUpCE8WB!joNN6PUVGS}(i8dFfL*=7yHVPFX3uJBb=f^Q#^jT)KdCcg}lKL$@ z0lc_#A`s+uqR*P-d!Dmsg|5=yI`&9dIwgb(x{lgS@wW|UrVNmnf>OkF{AIZW{u99v z$_?HP$-KAfYUg%S$*35*^Cm$D@MDW^QzQ@miP8(>wg$Rnu&9ey|;0OrAZilg+dto!tM{MsLT7MtW{~f@HN=-6uj^7J6w; zZD+&C9_V80oS{t-_r4qN7i|%Jl33t(LSwQ-?RZ&W9{G9m?vwhWCx*XsFB1Qyim%Bw z`;8~PX-(sv^mL@r2uzTjMX14{RG@oOU!CaC(~4DbAyQ|#a*3ojrK>9an5Lvq2^uLY z6$b~I=6OJ9B!;le=vzdNqU;+zg(kAoGq@;Wfb)dZ%5)aMyIzSDT%=Z5rz`~1TtBrY zkpYoLro{ecev7-8WmA?oP7%+I4=rpLUVs%7wHp`7ZS}|PZ)-%`myfYz4Ijj{zdecKB>f`mM z{@pp4D-rxAT}g&+Vv_~oE7rq2=?|6^IG3hs;WX}fy01=D82v_>iv+mE(fT8@>r{_~ zck&qHlsgL8*A+$FGnbd`S|7)Jr@W+XJCg!g>QAW)!nQr*cRX|T0qVp)WX&uAHe;|B zpl7|z=GQ%`Rh(C%(bne7suKXz*Jk{d(jPblyfN z@3WG04i4Rg?*%r)NNb`HWxtR`U&GC4)Fkh%-L9?OZf$F)wt##aWFY&#S5>a50!h1= z3>OOLCvlw3Be*Amp~5T6_K}S!dS0(AL?6l5t>pKXyu$Ks5H|XTE7XHwJFc%1XaJ?-5k^06V$`MXNn2+$dN#* zP@U>_ayXBh1&Z6Uc2iPElaAx5cce|pWRCYvYg9;Odckx!mlo=HfX0&*e_&N*5|p}h z8}F`y{#L_i>18xXn8A8|1$Sn5*;FO`qUQWpF#Vf+ zxUcEf&U7)|eqF|))laU9x}T1GT}X2;Tk@Ad9=N>l%6`S=VP-I&ZqTidOifuuL6;p7 zaA}Q6^T#y9YeT;MY}BH6)0n&^OYF=n45yZh*x(T8)D~GaSN>viWWQtYGBOfJa0uz2 zHo4h_5cN}5*u0chdm)&?-bZ(}S>H(C@1{qLh*WExlO878s9y#xp-eA zt*QqZGAP2uGHoor8lCqQ^9po+BT5gmQdeBtCzUWIfp zJ!9JRy=V4c)&gkFL0jB=Jgomua+edXhekqj>rvCFYE5 z66P`xwQw36AqalCH2uFilT4Tmm#l(+R}aO~2ds&lim5{+rkmQ)Ki8sbxG}~S6+hf^ z?0m@HC$PJBm&jfMT~iNJvVUbKzw5z00Xg?A_%<}my<-j~)!(3QzN5FUxe{U#gG+j_ z=enfUC@oS98)d1L0RD96Bg@_L;qrSCT_ zax-|9`-1{6bAzHzfRRKIc_1)}r_O{z8A*&4S#4rnHAd>JCvSidAu|Ud+T({bwO3ZT z9F#c%TZ9mxN8QndfR^0638$)b6VkhFL}D~jUUc1NqV{Dk`1y&WgF5)eWfa8cM=B6Z zwT}#bvD)BFS!F;Kq#-J&)o!fmkrGY#4{tx*v~Y$y*vulv=y&eErckxHkj3^Q3|)*#0is$XwG`e?r~%QAiQ4o*(Mt1h1rwRid%2UaD|PD8Y=(b9Pc2|a zx}nrwstN%+rJC)%#b3`Xuk9O@dmgb!=_l(PH|TrX95KC8?bu0u+j(d@Xyy|Xs-#z6 zt!=ctTDZ=XDD`^hmxfKwb-E(81gE!7G>W=3;|&)YEW=}9kK(G1cEdl^ArZq;Ou@XqiSZjH72rl$Ro=Q)IZ*Z-5tGL5`0fwfzSQ0;%p%h$*@LQ%Lq6wJg_V` zYuiyz=3>YcHWMVWv<_c#wfV|A8p>np$4d9a&%??5^K(W3!$X{SQW&w3p@h2$ry0>} zdVh1($~!|K$;d^y(`L~iq7|vgDtjiBBCy=VHI@?F{xy_8!Cfm=gnxZh*(nYh79k6x zdy%`w=YrA@V!=XdtaC!>H;ma?nOn_(bGt@hCNHreefkjed41}gQt=Guo;hwxj}eJK zQ}I3=y}{|)kWI17?TLSNz)E@r$0%iN-*;yt{}pbc4YdW0!T^nmmbwhr0HW2HVI( zR;i9XT<0F2@Zqh;Y@_+c2a^3Mab|x-auw;48ux0xh=NY2Tz%Lxm3)jG-tdU-)w|0; zx(D)JwTlLo^O;ZuwTE1_+LOZfs>_x|>qGwjohHH4}-1MaRf^p?lD1T5#V;|BhH&WW-s{ROZ(!sOb<+mur&(=ouG zLU_GpjJ=tDd6}xyfGs-qGBT=NANGy*!)-Zh13Y`?Sx=k~i!6cG8^b--M z?IhdT`nnAKoKaO5)>=4kOG@Wy93v$nrK6CmCQquggt!x=sGhVm$GdGU$o+*~Xnyq5 z6w;w)lFdGRwIjK-QXrXV7Rc+gl79FJ-aSp?%sMkNc9FM=OBAEagny%!MPUAz?IjNY zDKpJCj3?u+3>`2P*Dh-A;*EE{bRr&Bn^%|3RBnd|T_Z3vLSBCIjG@^4(H{`oJgnK&+ZBN}tAykI@@)V6>reauD>Es@jP{~^7Us@dNz zGk9VjRM<`V3Gzff3%e!?;1zO|Qf6xcju#*Ip}U@|!beWn5|T~RN!OKF3k$z!a93B| zEPe43nB{~PNg))jt?xl<1uRduo8@?db7Sj;ewo=sT-;WshPGrYVV7lWCU3n^eBb2& zLMzzfHaqwC&e)8MMJ?mjZ%ZcgPMiSCDb7xSUu_BJI9o<)JguffVuUu_l~W6;T<03b z@2V&SR~&4)8kn+&X~mGFky_Lx``GvzJuR}*1z2dTO7=dkWI<-Jd-fUul(oi#4MEd^ z2dY$g``{E))Y)3a7WF<>{A$ZteOFW-O+J>$Vol>r!Q?x`{A=^;Xxj{0&B{__bx(*s zQK>K*nOZM&gftmM7ANcfxi_%B|o*Ga_|V;x5nqt7|@dJ-|u z5!+tVfFbK*$l&y?Dv^>@B_b_o%%skfe4bVNGk>pEHN-wXEOu<Kb(?+v@vHGt`v>7NHkhAo&0cs6@)g$%)0zV{{7>{1)LiM{ z@)-m)MX`rRU;%(UIQ#`{Wx&8}!mEJa==sTppzEP=fP$cYfeCMb*xY>XC(^t4095o9 z{0p;y{iDG9N9d! z^x^m`;SUFAL)a2FJ{5h8|(dV}T;k?G#-Ppr8(zSR1eET{% z1>}@~^?&;B<$dj?(ZiFdvw`6p-bNCh)H1@1QbRN)hj4HQ6x29Q>t2%r+Wl$qXLq8W z<_{mmM1^ZVX4{4uLX+=6D+i$9F8_7vPKE!AU$kXe}=soVTlk?>ZFf+CVt}7j^~ow_%=2pE^A2$WL6b z_7t9*2(ravo|7A$9z6aPo*#q``~gI(LRg#D=68NkZ^-@p03aZ6#lU{N&g+a28se*N zedtnSlYg7`J}luIE&!kHYR|`{AeEs?k9vG&44%Qwf$?<^gzr2$D-M2t=()a1Rex>| z3EbXMz@QeM(jPq57r-hV`m}BU3KD>0#;?OyOB){O806RH5rCrx_XqI=*k0(z01A); z_m{21A3*M$U&a=oY{^eX_XqsS;F6)rkH8%;o9>qZpP;sH#*eYt*~!799mH4qA>c>v z#LpIOek&MwyOf&Yppo@01kJC)dFX8|G|rJH+yEIudY zDq}0A=S#ePMAu>0xJC@PndSXF6OKlfVP!7Z(yDIsgiDOjwHZX+AW&m1 z0k>=Q;*~8WQy<^RiEkrgax)&q)LX|@*UT$mX1RUVFNPHnBSwylay%dgWs@>(S(8|q zlAUf1yf73;D%MNRpRm<2eU5p2s&$h?ZzLRCZLDy6%jc@ZHM5B-zju3Broe;^EW=Rk zHj$`9&H$d*8Vts$)gRU@vS(#E>O?^fuI{t_e6I&i3c^i!55X6;;pvj>Y=F_IPuIhh zxHYOYbLLDn$?7ZFf1IMto@hIb_nq`Gm?NI}YAX#c8_PW%r&}X>3)R|3+&E4APWhx0l?QrY(t@*? zpx!ITl8wU7}yXi@&hrUANq6VAE=yIrYa7SwTXwdnq4sbt|v zFh%od&SvR=0`tV8B293sm6-d9DDDxf8CCOjWnS-IjP^r@Luwvn=9D^g;Z6!@-kfzL z!B~WC4S~Ha!G$5RmjoQ4yGXQ%v>dS%vO}z`c)47mz!A+9P6<;j%hckrWGw&QPw7%p z5P6B5azFHRV*9lL$+-%(llm?ToJhR1pJO3CnjfQdHIDuYZEAFU0J-pcl@$(>PxIK* zbAhTQI`{GA2=*-LOgvXYa)v-qHv~7$rnqnK55F)(6w^(!T&bq(KvsL!Y z3a!gXrcws;E0Ct;)q6@!fQ6N@vpdR&l!6e(j%ac z^+?=AMdVCzxFyIMs7iTE5PwG73xl(AIPgr0v1v9|6r|D0!ie`p^%zbaH+;PKS|L1J^giXl{?#N#L=lFuMcn(V2j!6R|QQ~tWEn@GZLYu zL8Lh#y;Bd;AIMU*7MYWEifsn-cD3h2F;O`eY|k!jsU=fwcJ5;L`sx%yz<0WmR#^Q8(YW`I z2>N3O_~5v_DXvsOjy*IgaZJyMufa1A6v^64Bsm?|#SasH_yir1>#Z6?i#UKj-D==& zB^ZsN|I-RM*7OXdrM=)=Wg0Y~Tp;qJesW=Nhfa-wGWwbi+f(|ea0Ne+CODy<1${C$HWx2fiWtqdYtwAdM3R(!RX7>w@7K1+3VSri1Z-vu>Bo&Yg1v=e&M-~u2bMTk+#CLO|Vh- z+1AOQqU>a;;X#lHQ#&xgQKC+veuCf0sh_(}z2p2H9j-ak$^_9&e&Wq%pb)uxo=2Jh zL&S$;IGEtH;yao+@le36CY!>Aa1Gs%#%~AB5gepi#=ETufBW7LFA_u)QIKXO@-wF= z6U_^~jT;{Bp~6U??ygxB(Q+E7jC%~>7EnC$1V;$)oM?lDvZf$T`Gt*GceiAu6nqa) zjdDq(F?k&3-b^a)K_e=9omUGGZELRgipK_yV6?gb6>=t5;4QL{f<*DOz-|wX>Swl1 zood-NkMVU2>%pq?c{trwJOI3sxWw0hDCmg&2|uPuwgpB!Fr@m{;gU;Bp%sAP07kwX z=H9igo?|z{SWL!Iz?K0ERq|I`#*qSsrSP^UAT~&%zEe>RH3^@XlgB_lSkQ^HGz4zc z35|Og_9w0~a$*&@%d$C_ZHVHqrksA;CK33_?u(02s}y}JEpq-VWIB}Z?sRrNF8G$; zvVWs{D=PW?BRz>o=w7O<=M-)tHj2=O82ehq_e&W^$Sm2!%ZH z&vOPg<5Hw(ICReo3Vo&k>)0Skfuc1kM7cS2?{s1XB9n$uy19&2)V5y?ZZPTQ_vwdrRpWgZjCIfLzRD-}}`Y(xz$ zj>2`BR6?q^fzyzuxcc2@BD0b5^!s9LqT5;pV`4>7sBwDN4b55T8>Lx6z})b1A$*>X z!OZ5H((H=l`jS#vh7$_6Q zxrQpG;jKz1&%-t8mxE1F-N(!5Naw&}km1g+iiuUY@`e*kMH{JkbabsAlvx4U-IP;d z&S>2W76i00g1y}dhG3HLSniN~zgh;&XX@|}!eI;W^h&*BFFgezWmw@ErcQ&$qJYKV zC3ER?GcioyeQdK(5n#vTMVq;e+tn_<7wj49lo}rWeIZtuVw6fqa1ni@^;G6bNh}PU zncYb0d5}5E9CS^=pmFE>=pWv?Yw>)7&RTQs%^Zpfd&*aW*N*qw1~m2#Cl3`wSDL4X>iRn7faHRc3kU<$YETQ0jDYHEnluunY=zFnKxD zvKDrwGKM-voE^lbpP%YXiOdM^yzw_v2Y-jdVH)Dg5?cncdMqPj55G8b`VN)C^Pzp~4IEXK-2`=IpqYmWb$!n}tGaLOf&A7wwoS zX$q-77+95eLR#-m=bMy4P4E>m6`WOo^_wy3+Fg&W`lUJ^0SCQdffO8j-W2CHZg?cLaWZx6F#-1r4iFkD zI%oEvc6a7M$!&@cKcx)C*a@9_$;m^BGmb?U?vmapY-wBHEIOGTFV5)_bJ`}k>Vq1M za;~;MpeC?xtJRwSgoGG(e_s(dxCoarT#c1v z`r5I@&<~0xD645XNp>HN1(uqspZ5aiWP!o+i%mY+i@!2&ga8Zu7h~rXBTCq;>#=Ry zwr$(CZO^QkHMVWrwr$(CJ#*Inlaq6HvM=^cUv#CDPN#3as;Az^7Q^<$Uc29X5n7iY zk<_@RBA?_W*nU`1V6`@iC4O?pcgBC4+ym2DD)8~d+LY(y=F)m*8{wqN_ z9?wEC>sQ#25 z`AeODFkZq4)@PcS@euP%wO@?*(CBU0c-fbee|S%ahUgS`;g8>oB%$eCw)#e5*ZCi_ zT#hg?75tYjy^EIZ)XYB*x@u3$`_$O7I@NVCQ><0-SivSkc-t!NGy4;E#`2G-Je8w2 zDn*bd!3qXEftPGdaqQ1qn__g}hozdXj?84oN3%>2)!4hmQ*{HsD~e_eeaS0s9X}M- z@VwL0aAzAHs>+LeK!hWh6gqjGA8m_-#Ix^;>yb%t@Qo35o8)LgBEv|kiQBJjRDjmQ zH^$1fSh76%r1(p(v8zHVUnSZ@5%Fk!Ku?GMoq4l^Kjc#zO^S{&0?_Fe*T52iHee1J zyEQ5mb7Se2$;V^Ndk*c>zM^Y=@cwjH!r|bNkQ2dy&Wq#;xcCQ_`S%lBmtC^CXS?Z?qM3lQ9ShW_n0H$<%}`Pq~B~bUG22c`fm|BF)NM zb-RxMtm7N(8io5#{lfmKLZ5kiao?K)X5-Y@gr?)1?y2s}Wq5u`irgzx?-!F8+YRLx zPA*pAKh*AxcX4mrl2ucCZg2n{GWz40C!u4w#i)mmdY?&v!POfQM3WWE%`j*=UH47f zat!$018SvN_2J+v?*b@~{iS5#pKkroiT_>Cd>!%OaWuxZV;!l!RA;UXIq2@hc<6aRa@(mUn$S1}fFJnGBVe?Dr-~MHj2_ z`%PKDJN$3G%-_QaE1Kup;#dA?BCxT%dK9R4g@^zMlwktDMDxVvj5?b3%91kf0V+YI z8qD9x8ItPuBxNy8#C&@Bh}>!zdeX+@M`}Dv*VTXi68vpZ%Dw5S%L5Pgpe&bG&MgoK z#etEmzZvbUO3Wz}7YNA9s}L6pZO{mhIeP_7X%aD4o^3GjrlB&Nuq@jpHfR`;Rm81ql;zqmkE=B2TNL4%i+35V-YHsXs~n@CyR zrEa?L_lhP+%BjZ=SMWNwEDkZ2Vc=yfFGV;G>DqjcWcFe7(4lK!wC(C#`mQ-aDc+Ra zCK~o2F4AZ#?}1&B$B(D6`^AmoGq2bfVqQQuG4C;BmNXSFoNW-SP@O2|ogP3Q6v6}Q z8)BuhP7*3_bIC%2N0a3{_K4os9E=<+h=jhUNfG&J2UZne?TBeb{>bsHzB)nc*ITM5O0)&)*_K0v82u(X`F#EHHu6PaAt=ChmtpS2+qj9e#|C0mejpisHE^vTNu(Nf1!nDS_}W z{GI1LK2JGEH|W0lDrEUQEMu*>)R)vGxLtEXNHZ_Uq5nW%U&JpndCXWxm)XBmH)}$J+H#Lc4m}oT#|axh-+b z&;%D-LUNxka?+!#y3^V6c?Z>GaOH8WmDG+}AKpYnjf~^wMH2ha4Sa;-+qYa!M>pRj zI$KpxCC96y;PiIR1%=T-qVTjIP?SdyRV!`f^!K|IUg1egp0>!+gDJZ+W7({-!-5nueNI85qa9u^}`;@@KgZOFAET2_==EUUc1Tc4$`m7FQo`%@X(+@wHG0aeVx zFZqQ!wRry-`r}JZ&0A;Avh{CbDmDCCQ+tgg95aL9h@`K?VrzWwEH_Mphf;xjb>*ns zCSM~CK>|I5a2da!AC!oEfW9|XPKVb;_&xWx417K~>~T-jL7e>tb-pSg)|v_x84H{}!_ZKVugk+1s9gpynu^p*Dp7_=F`FOU^QAXcEg*^qUv;jIpAJF6uJ)tpo z$=5BmA!opv;m2hRVOt@KQ^$BU@;n@H!lHL?)$a$Ve&<5>79hAZ=Ed8$#(Gkzyj49_ z;{|PZ)(lg?z2zE^rZx&KU1QFta7Th{d#}#6LW9eQRv$>q;Vy77(+`b?Q7bD4a;{5S zY0+up+~=n2ieT+GJtP^0j5RJ;ag(I>TP7!GA)wz+YzFdOry+7((x{5(U4znhDH<>m z*_h>O^ObLzt$p8}GI5T-Mf1{P5tGATb7+-XNOSeRxXk;#aI7W zi{dRSDGF&j$auqzbt&Xeyt%-$$~RZ#=tLyp)oldz%6&r#_aRmLwZi3^K27TQLfWs5 zR%FN(gp}XSU&RW}>}H@|sa0C<0ZX9h=;tp)n!Zd$B~^VGH8tpNuL4iJQm|UcFiEqO zCMtVH=IqBF5`JFFb=Z9 zS;<>+F$B@1ZlIO`rmoB>vXObI`;Xoz^11K1!4$^Xq+$EFm%>9Kyo}aV-(TYEM4bKe zcF>gRd$5Te?c?&19pv3 zV*)2FlCSm?x;C{kIF(17J_rdfADIu3JNx9iP81Y$Bz0FVlNk|J09}kvTf^HADEN_F zi~=(AF+qgW_1C|JaoeiE&&L8=%j!~+UQxnffh%m=J{Gf=>Q6RYDqS7ddgiVxGwp41 z>q~g*de@`Xzw%QVg z;$Yq-ijNVVWnc;cjp7b`gKPH|HT)f0ZkMXR#f2anEz=UJx7mlfVd1HX#!5YT&s#Jak*df0-55~0J+I97c|jM1aF$u2yF{uhH&oOYm{-r{a3 zuiZGj7-S>N!yKFR1=+RI z9m>F4*rJ<|w@WuY$$J|q07Z=mCsC)r64enN4lWj4WzmQ*LFY@{jWNzO^?I@?B<@W+ zc-b6j^W*kS1-pP~@aC*uIyyTwFe>C-MBk;yi1yD(gUW6-2v4${*D0iMSSPYp$7<>y zjq@g%_>MTE7&gXdCyGs&h7@dw4Bd?8YCr3}Sf<}!{=~gkVX#7G_v{G7o{bt~%W5Nf z;OFJi+?{LH-&HQrV0h0t(K8l__%}hs%j7TFqQ@xUJ2L(37NFUBLDn(Jpcj5~!{_0av|SPx5b*Ky<_(AXO1Xd^dabT@)nx#*xmPH0M^H;BVqERrom z8rLPzGt;+vpg8E^k?ikY)0k)$E$C#gbOz()ggKU^<}2%I;!z(mwm+!T!Gw%GT;)U8 z#nxNeu(x;n4#2vJRp1%xA_q}lZOM7dda&NI)!j(0I(xBBVIrCii(xKfjqS>QMG(d) z8ceN3hj=-R|2|r3xXcRfbjecluxy+|-fhN*W;zo0=p+smNl^G$kZ$qjrMDgHd4ouo zy-L3Xtjs>M@SG)P!|v!BNt@E>O@x@2T;Rb2QT$R%3uoZ3gK$@f^pTXy;y)Gb6O?vx zTpt~|g+OQ;73Ojv^9jj5smC;{fv{PI7fK|k!=y3vSIuP^9Eq4Wf3WY=2!XHQ#+hyP z?d;xXIf}?^gj6_zi2aW;xVP0k^3kW+aXX*_+o>XDjTVQW=KWj#Q(-K-vJsgh95S9O zY5s0D@-ry@xRuD^4ZxzB7|X)mqs)q(VbEuR0$`N7opx{W1Aj=Rq<9t$Ad%K3=!*#bH1{ADC{KihSK#1 zj}r79l|6(6J{8K#bX5;P8=*~=@6thTpL8V*H-lY%IV;WZWD8au-mlHwi9Y~)BO2cS zK*+HE4}=WUezrOeg%VBBv{yn+1@7I z)?FZA>_cF7kqC7OO<33_1wvYYAR_&Dcbl~9kn@z&<7c;Z<+Dc9+N=h5HOBk)lU-Q6 zIDeYV60{y*La@)yM&~MP0Kife7njZsfSeqjo1C1T3O5^WY#Q*5pOb1^IxmtM0toGA zP-p|x;sz}FA0Q(Lt4e4PkkI-60GX+A$i0&zl#g7(AyEth;~T&Rpt1(wBm#pxYN~9O zq47;n6XQ#;=*Qk#05NH@{}3{l`ZoZQ;(5?x3pg+etnQ7VTtdYEA!Gm1;o&f zJ=+Jf4Q)&>Zh=AsK;a0a2-Hz84ddE?x&R6k0ym+m0$j)m-0hA~`D51s{aC^UL}p*= zcldYtBme31=gidB62i%z>fa%#gYCmQ0stwSEU)YIY_A8J>R0Q9oyOH6RPc9(ca95c z2VL5$U77}TO2`0kwg~=RI<-0na&mGubqD4As);{jhi#f}Frc;!D(^Mj+7&~Doge{G*W z-S02iFZ<;0<=yXY)X^3$&d&n#kL}%WA-g*Wr^l}`V78e%`6Xww2fyXM9ZE8{OW7)2*A1k6%ETcF=AI{+J< z+{|xbP)$}b?~|NkFy4wj6@g3P54Iwj4P^aCx7U`>7l1Q5y0g8C+?kK#<2|5HTOPL+ z=+lRF6Clo&K^XQDC_wcLyaBAE;J0tlmk$8k_-;WjB7cDJ1>`?crYJX#AVBy85)zQZ zx zs>i=##(xzr{}rwI3H1O%XOII=3O@hlwRin{Qs*fLfu*CrR|2Af`4|0O;E~1MCD3l{ zcJkI=NzVf9q-HK3sC|QCA zoR3ie+TCl}PbOBA#~BGn8u!mWuwIJlJ|?895oQ7hKL%|j^g($EP!#Pq}qrMLyO zZFjcKpFMt>Jf=B(gp8DJe1r|2Pkw?Xo6vt3a(|LZ(CXLlbodLXkee}lFAHD-`Eh}4 z!e2$CQ&4kZiXESxRf-@Q<&tlSRR z>!`+mGg=GNdlkgkIsSp)1!qUW=wAya^d@upAs+>D^*rLU-p9VzO|Y|j@yho+lA1a3 z@m@?J?4t{V8>>%n#-^Cky1C1=!RZyyw^2{w%!3oi_d&pk{U7kZIkBVvUOxR4`6$H8 z`x`L-X~$o{;!~fW6x`Gc*5#dh$={Ae+8y2Ecl*cdOrW;&cfZ$96X1`Yfb>$kWmvI9 znXd0y>7|yWl6=dwqMhE;&tjP~N;j;gQLOE>f#rNAb57uy=6Fqc^;xEBR_<1D?DWeA zNY+aUbRv>ih;eglP+-)RxI;mU_HUxt*@_ z{!c(cUjLiqQh+R*(Ukr~$;YK>JV*4ON|Bm^Sie(9;Ni2Us2dDo5;VA8E$BcHLO$?bQ-jKn<=$D-fz?$ZC0!h*XK_pFSL?gX6m_!V)n{a>iDh<4#fJM&U8B-uW7(;NK%4 zrNW<)eAMS*ifDia^g~M~R}06WXBko#;mc0Jv#et@KFRUzV_j51!N!=)aW4Db{`e*a zs;~fpLHqs^O|BcJL5dxU+wsho&SRZ~S4kIAl`J$!a&{vQDUy1HY}gxd&U0rHdq3VA zh~H!7kF2ECqhcjy+i*5NhRhV9XbvE-*7FzzX+DpX15oL7VzDj}av_=aiRM0^Uy|T- z*`F0(Y;O>av@=mbrEO1-^y5472EVg}s-lE9+C9RVl77N=(j7y1$iT{1Fh|}3`D++0 zS*3qdbcHl7SwK`A4=?XIH}m_$pd2)rOH3FOA^mgCC+OS z);(cbL>{?!MLVXkxvtURY9=|^SNNgX41PeZ#cvdlSK9{=F2{mR z>*ms>MX>S6Wo|qU6EX%OhpX4lBvL_81am`dmR$rq)t-v5ow-i~353&JMyUpCtp>P* zlQn^!x4oCRS9d!2;5-_8gaNyM6D!kY6OKXIazPc(m!7*B5t?4``0zhIwV-DW#6lkp zYv|ETwsBOzY)h*inPOh`=Y@N;OoAc$`f7Ju&?!i7Fdfvh6FQB{O7Be09}PqR+do=N zuZUqcTVuC1T(^Hy+}d@d9@zwdUJYjo>pLB%a8#6KI0 zmf{l1#%}y;FfCX{NNj{BKroh-N5?~+_mEBP2<nnvF)-9qsmk;9D_FI?gK zo*&u4g*eZ=0A%uUtNI%;h?>ou(&xPTm?ytH9Knljtb8|-Owi_o7&qApuT zlZPBC8a_Z)jc`n)+}_8Yf)NQNi)T0lWf@;naE(`@`?eAki?IIA`goLmr-e^(AZa@xRunm z9ed66PNDA2x^;#;bIfJm+#H--mMXG~Ap=VG%iVHR{XsOo>eSQumSku3c*}Wz{}Hn* z5wZCi0NKE?MfFeWYYUKt(*3hdKbU^9JwY{zTyFI}IWri#Dm-WVSqJW2^_{DFg{OYe z@pjKk1jUaeyOGIUJwj${(jWGZGc`$a`}VC$mM!z~r!WCTKfX4Sai64%-4ZMc3dX<* z5XLZ$e6y0-J@*&cayu(BD-Tcf<9+Bgk{58^nO zfVS=1F9Hhk64FyY+AX(J*|vn&B4(Qs_!0SRhqVG_ee|rKdmL{kRfT)@<`5|K<~uLl zyvHaWzfjvE|MjliDtrdlYXOhia>?>7=+~27hTd=t$#m8LM?>oxsBiVd)-icGP^xrq z>-;}u7zwxh_e6UeP;gxnY0h;YZ zHm4zh!p=U{`<(6m44Jl%@b_iSlT3g59J4Y3vo|(^Hs(#%4qpZ;e2iGa5p-@=qcOq8 zE%ZnK9UkR?Ms6P87*_Gu-cW@L(qn>k^f{?#UGW{*3Zv9{zfyOFUaC$f%wH)IY+rBJ$o~%4mx}Z{ z96Ao>@O3~Iad(JEn}RcrskKXFfB&IHHFHYSe7e%MCnRR}7>v7}ec93y*?W59Rf|h| z2Xcs7gEVB$QOfUm&HQ}*_cs*P(PZP0>mvIp>XP9qGI}enDsW2jma%NJ=Lp|wa*<`q!rxg{g{^NxuKh@GHlmc~%+j&o&4+Q=vd25Ghb&T3U z@%f%jQd(-J2K@!JwE@K9%ri}7OJVQInn464Jx3Kwoek(_$ zg*2Sp>hw)knmq`CJkIw-vZ&;|1IT;}=LzV`Vg0cLu(|qBWyGq{5&XM7Qmo;Q9R%!k zoEgA~T&70D!(Uw?@~F=)h|iX9b)Jt}@JSo`O$^ZF{^>2VTc6#crq{y<5a%)uk^+>b zQbX+!$A28%F!ixax^&B7SkOl2xk93gQ_l&;TqyhoLwMY`k;&*e0=G~O?g1bUl(YhGVvo@E@3&kCSKza@PsykR9t&vt`}cFP1Og99v{J> z!SYL~AYP_n@&Q+SPS<(%V$+*tb65l$kbOT9bv3T~SC{;XTyB+5Fewn(eTYeL-54yF zH|L@&q{f*mY;azL?rGOcYzzq@EDmfulw|D4luSs`PKk#f$|2tvrkXr5&^)geeATyf z5)*pH7Z@trlMPp|cxG|07ZYR;s*m&!$a5J>C-?Lzk?xG^SQcrLdcCm|m-xtz(|v4D zyK#~K;RxzTeP`TC+xV%XQQP{<_)>1<1t>5SNDMlBzl`JQ7}DP_aBl45gm=f;$)JRN zY*&1|;XOtKx40zlLwzybRTBK}8s|xP4Y=yd&4WzP0{I9GG7!SpLs{goPA?&Lg>QpN1BtH!#0tm2aN-PV{*r8Qf=h~Rqz<% zhN1SFpD$cEBqK`ww;0|U?upyuJ6Fb6M{Y{DCA%xDXxqB^jraX<73WRz&N`2q5eeex z^$kJS@I2@dFZsPf%iL0@BS;i?!bdnO*Wx*>(JEzL$@Q3WdVkH+@U~p@SlI)?!?HkCU*JeH!O<6Zg&bL_6;Do|cgadK0vHK2iwxcC`Aa_L6NKrGkVo z{l~2gMS$aK>UUgV$W*m!)$^_Y8g{oOZm=lx!(BJ_*ONlAHp4!e?3ap&n6M61RiO{& z4%E!X%1eWP0`ZL&=IWb;!E=mSYCE@1Ki9t1>mZm%wC|MUS=VRk&M_t$B7=jj_mMKO z;w_Y5_2)0vfJQ1!yj8Z2I}Wlz?r4m*`O@8XLSS3Xek&-a(}YyJoj$mQmw#oU&|14f zEyJjVh#H-7$ugs7n^YZH?;3z6+LEX*P%+FHTJsi!t>V5|6nH zJ}KOhg-6~h-TTQir*(FPz+9Zx&fKXjMc!lLOGufJE@Q(+(H!;!9<*8i%=#tS@zN_} z7dt^-wIlwxWy)%-_afa2T8M@jB0`PIi}VTT2!PD%{jnWwasB{e{Mxc|#Axgk1EJg* z4!Jy{=1y&Ik~Cp=Dd>Y?J7_ckH54!_Mc}WAvv^WPqg;ZIbigB&uPNCsy%xt&R+*!n?O?vP!fhgSJyYmI7;>(8JLdOxx=J zyEW{`CTftOhdp>_n`9vWQ47|qHXx~f-lYX-AP;nbWhrrmXPA_gP8t;UU%Y>yjD-ZrB0{ zhYm_j(8Q}c^85A|uT!j$b}-$B^`YT495$0<_7jYTfteQb77wpygR5& z5(1a(Wp|2>9pjI`ZSnHTbspjuY8_kjY90=uW-;s;<^&XXaak^%>ZV4y%L38f_tHC@ zX}o7KlB>{R#^9KH98lr!w*Lz^&7Y zhs&e61|MqL$tr+$xMDhJ_opv_7rL|mvTTgfn+^_&Wk*oHeAaa|gvWUcd{zGzb1WhJ zFp`}(!Ai#?xNxjtI;DUHN<@bL&g*7!xaQoIm=ib9G&gp8qUiR!RV@ zk;??BGkxUdeh6^da`;@uRHj9vPCN{6509ozG?t=iY`@%1nx2{R-misUR=}G+D2Ty{ zrp6hupuI}RbP|)!iTzvKW6<^JP1Z_(f>+dBL6>WTov%U0`aw}w-!^RV=UiA;R26{* zT$qPDLdzDvKCwEhWYQuO5ql!PFMOF?lCv4mPKMirgE(Zp`eV&-0C|Ld8Zel`G=Ui8=k2!$;1A54Kj{h=dkCPA)q(cocbT=WC4`F#4xOxKZm z$=~}3$M1`o=#RL~HXEZtVL5)HsulSp_<950GnDaCMZGKRnmHX%vs?2xH_p&Y>2N^8 z+Ugc8PPg)f=Mt(E+tQiaDK}(Eyn<2tbjq$Wkr$D&9z!9gIiqJk4^)Ejqf84Z9(1Qq zx2iXuX05CSpJAUjF*_(>QhYi-i8R(8kH8hj^;pgUfS_JLz@Dp-*Y4cbr&DJYt7w|g z`(PX|8-FKp6{HqR#n;!=(|o5|0?YKO@E=fUMonQ2c(cF?JmnVQq0JChuda>k>kNb>CGp`Fbd(7X2+8= zoEtw@S2-e!;R^hYK~=3k+#+kA1kN%Vpp#6Pf!C0=^lB6Qo_lu+PhQ)G?d+Nv`UV+# z7f}KX{nX@%BWCm4I&UN)8J>{Wf8Q*w1Y&dOC!Ws_VbmRr)D6YxF8_g3ux}*~EPDxVyKfQXeNNMzUQP6&qoElXZ`43ttO6hIEI;jP7?tA_x(u zln32jo{U>$aiW9gp-_FCxY z6oQ=3x0%W;@7!}V(3@~kEyZ039BC_Ca`GTi?}A#8?k}EdFDfKNMvU6!_xHClaqFy3EA+N2lH5jE5Mnd4T*$30$Jc z^5v(BVqCwSj5p;f3~gLF7KWo?v9XQl-cQH~s9#Et(T^sFAfzc7sTViMV^Yx8bCx1~ zJi<;X8b$p{)6mVi>Uh{9dws_i@0zvdMg@;E(Kc_X9HLo+H8EUPzKg{WsO2znFr=FO zuANuf?NHe)tF?msd0Uk?m+0R7_|}-AA#yjV+J`}E3MuD>vY^m(o)CBT<4!g*W#+c= zN`~OrhfX%(_MKWOmYKv6;L~vEO-fSZ`3a1kG1AX3AI$I=!mY;+h<$OG?CSEZbD(3+ zkG@=%Jd)A%qSmosOLs+4X22|>;402c;Z?)cUKk$?gb|VhT3LXPC2H!%w7L5V#6rsz zllJ$Fhq?7}#4Ir5j#ggweNKedS)rA8lL%YX%(`N*tPzG0Hv2p~o{7x(q<)#aW4mUt zc6DmG{_C6*3F&9X_~~}@qy~I^Kp#@NsN+Qe)W^vJMiR`3kRda7B)U_aeVymEMfcb1 zQ>%wMNVBskT!xkfK%9Kqsm8Ti90n84@-I>Wp3(V`1M@h~&W3VnK?K#wnccRA#hNZf*`Y-W>%qeBc<>7iTUY`%GU*LiMS2F^ zS;JEVwj@9=z05HcV`U@1ZE?gQ0`!bhfi8%J|G8$D^%`rbI<4QF9QXC3(4E<(~25gvfT8$e}R*leyERCSny*K^kWk$ zi%3Rs=a++Z%3KnD@%s;1wo_liA;?*`Xc&;D3$f` zF%WL$evlW$vsf1oGyxUqi?nbQ@%oQJxwsB%-+A`puts(kb8CtGW4P=xBVgRL^2;*$ z#h~gC*52s>am{QcTifJuy#0fW?Q%`EjT*zK&^{k``kU3DiLH%wW%jHwQ+6+0c((96 z;F3`Z(2*8W4^g(IU+lPU;*jrWA7AcxY27-Li9Ft+EbY-QJw&E})M+`?hwO{e%Q0k0Ffs7KuwY?#TUnGmrUSDjeZE z+ZXMI+qOdVsPoSGX7$z*((XZ)l1j|~{nRLx;_b!N`(!vb-phi6%l?D$L%<=C6K zv`P*((RHJj#>Cx3aEf3N%F3@W72ZyG4{9jEOcKFslu~THUwu4}^NP4Tgb#;D#$2=WXSNGR95Sr+gCA0-7zDJGF9#95B3DU8 zB-%e$wfP;4U_J~L0%kQ!!VwK6 z`N%bv6SwVti0yY^o+}@hwHj}}CX9@sxZK)&Bzi(zM~HFZk2WpOPuU_>KQir3k>3>g z;U_9I7%Knb*MYi1VS9BJX9RTOQqi<2Wj>ap14bMuy>f;itlM#a zX6)-i(+Omn3U$TLY^t#G%ytQt{&LO+tN7K*O>7*2JixhAG<$^M*e7!gvb6 z(%l|FPZn<_$uNNA1LZLMa-ND6*eS;lc4KgdccCd$Pj$+o{%Ek zszMjL+cQZaz414}I_!O3iSmyk1fwhNF;qh}`+TpTr=>qu4eEJd%B4mgf0fQVV#waK zs`96tv)v<>v~p8|V|*mK9t)+I3;qQr75GMLij3~uf7M6p=N&WU2qA(jY&){|FstP6 z7+ufVZ7yNKN0i;PJuVN2yjv51XtEY(2#mg(cO1*XBs0vGe>BVtoU2;LhaQP;cs{m!R?#7RXeqiy;2**4@oyq* zy&*WR_Bm_*`s_n$afvN3=fwVFJsOl14~v;y=cbP$AAS1GIkE7VQ7%CCkZx6H?~l1% zpI8hE`vXHCzD$5sA z{cHTR#6i65sI&9uAS$?Ss@3m&;=phfFY%1en4#F*ih+~FE~1WGuiy%8W#k^!(+Krm zK8Q%M@mRf5-;2x*v-~3A`9*j3NivkjWoip*%q_H&4uZNnaX78@L7cFqFn!JD;f$h~ zUJXRyi?AQK?Uqhl5hP;xY3~jgPeY(bhT5-Gq3)b`)Lw3HUI1;devcmU16Oi=|#@0FMUtQ}sM3AZ(-oZGW#It(hgE zuGCg08DdqyNVcH%Ra3|Lk;4dW6cm4rDiE7F0#sPd<}7e4bjsne;x~V32Ml0r*1>+<)PzL2hTC(O6?i|SU>!%#*M$JI@*Go+`&ApUGCPjV0 z+oekk;qVHI`IDy-jTC3(7T)#LN11bnFkoA8Ci2vI_)il!p~13}Bpsa>nh>X8a?c!V z7odHjoAL0w0^Ygl7c6FDe46p`@F$3OC97-O`0Q8Ibd2pgx5%1V5A?>J;@{V#8nf`S zPH@xt+7ISVoJ6l$Vtlxb;!K3QKfO>dajRF2xIsk-S9(zWoVV=P2q~nw(X3$4J9$K} zrJ_k;{$YZLR;U2#-C{*urvoaQ5Om`c7gpD}U|pChk(-n=r*5m02&~KrPSV-WD(X$a z@w)4u@vWYt-Ga$k>cl|PFpp3Tm zfTy-oq7$(V^^rJ?BTQ8QntFCa`o>1lnGn|Ppyey&aKZbTVswN&KEyW?ycIFGxm6G_}EkViH&Drt#lJ^opo=Kbn==bf8UmiJyj!! z)bzkNnK>&8B;j?k?+=6239r*GYU05)r9{V^fjp=sHovl%c8))Zj}uWF_u+ zIJ^&Z;yTI=tV9bf9mktT466!KDJDBd-97A;e40-RS^N@udMm=ZIk2edMWgDXVGe5v ziA{ZVM0l9I7T4g^2mv_9t*7ra6=cha$j~&R~I|?Q5 z2?)zF56}6^SB1$1(+O-ojL8q*b5cqW?NJ*U_sJZd2I0D4U7$^DKB(86C3dr#|38gg zXHXMNw|;FPkq%Ntf&$V*LPvV=|w^Z>0Nqn z7w`SvnQ!L3cfLEbKlYqGJLlQiALq>OK4+)*iCb0Y=~zM(*9=xSY$G`!l-y=^X~W-D zvrB(oVWTxE3a~fgveM^Zxr%#1%{kkh?mQn9@@AJO>53rf;;?296ZoIy+0-=(MZO3@|)FU+1{ zvH~Xnl$=}s%G^XQI6uTJm~a*_ikO14B+zD zv?E)JpEiTo4>B0vcsH@i|A0j#mVnc<=#cjIe2j;g7d6!=-nSaCAUt^GI z6Bqr<`3Kf(iUWsIQ6jo&vVg5v)%m=jyf$@DxI@rdO4qZi9431ni9Z*v5}f5bm__3hqmd<&|)7^t`VsQDHv7PMg*H#Qe<5$oZhvRK~1wpq#Ln zKQC5f*M}80L+PF@{N_(x*;sHsEmd*ofP{%pkmw zXmVZ?-O@{2Lz97+{3yXA^etBQl>yW-P$crNjc-Ms)9YIKYC82Y?<<@J z`R|aSArj1}QL+%Zk%1=S3f~F&{yZsT1%k8-1)Wi4@Z86Q7kihn8~)iR_szUt$*dt6 z56f}CxRe_XA@mFT&DL(R>LcV!_i6#4$b2@RJ2kUXJA~fMmPCx;lH%X*e7z_o;>vOh zQx%IB=O33C(lBp4CI~K+bNV?MkPv`yUKkKMNuK3eTz&5+(+UN+6zTj31~oz}?O)r% zxFHYro-?gkrxS(MF@(x#meDVpFE77&&f(u+M7n2!0yX^N35^k-j!oHZy9?aIuIDpt z6cc?q);gZo@lxtnc@nKy;@_2EDis-qQB(trU>`mU<>;BPO2=^l>RpT@Ntjyp%Dipz za|b$7CFKiFVg7Y$Yc;t%r&OFjpsm9_HlnE-4Bthlp4^Tx^uwA+DwlJ$l?o*Fse2wy zUjP!xs}X!3`Xz0dpM3lJ;C6zyYle?RuFNj{p%$&YbM5XomdR?k)U4A>k`c1ZUvZxd zrDznE6Kx02n{7Dv*Pkv&os{=wa;r;$?3`=&nrJr|OkZT5^YJQpC zs@<#oeC#fz_0_}V)1A`W-N#T^(_w4SW$jlKAp`f>=XROZEP@`w!_&!OyoX(k(d6xS z`ZsC6xrWb4u;xKehgW;vf-7B?vYFvoO5vSjq4UL~(Wm>uIa3L@D*;(9;Zu|i*?9t! zF0=!utAu%UV7i3Cyk$&l_W$R%@+SPaMi z!nYCoH@?j?l#`XKB^(9haJI76gB$UJ`2_j-z=E6rkUR=*fpNMXxmN!zBAgr*EHH2& zhk`hSA1uf(#4iTEt|=fOY;tX(>16eP59*;ToSorTK#-D!JsJ)GJ=0S(;!|?9w})9c zI{xvmXNy1suiO9N-~k%IQRr)TK!IyCU?DMxFfW8p=x=!c4GO4%cm)Su;}8HTz+ngr zM@}Hp*#cvWhFbt%{cE-`AD9o!36PQk!X2%y%kTn3|84Pl?#^%^NE>FSi*W#ew17fF ze^^8)GzKUL7X6!U1O$um3;ch}@NODUI5LWmdyg1ye^#{Ed2`F}=4aiJ-r?{RQxa+W zh45m7xEIAZ@r%<`7Q;a`?$+31YHtppi#vTUPV76A4i@I8O2ZTr{UberTH_AJI5)*+ zkbj;hCdycTzI(L;3wwA=tqiEIY)s>4(^*Q#vn1#5Pud+T3?T_uW6TAcB6|d}t1I+% z*}nQD?(1wrk+01#9U&rd^fGq|@GP|8G27e#n(nXB)O4@kvJjV3UZ14CQ)RmI@+J|v zX@{weIL$6;I?sZn%niy(U1D+}@dSUw?g*!hucg+I07N-=HU`~&o0^mhtHVS_MY^~B z**BG(!g)qs!Cz3YG0=S}^Xz^)A(eP^w|SK?9t zm{Hq$z;=2ew>&f16c(wt6DHtY*s+3eivh)wNjkBDde?y2dDKD;?u`8L_%FDDt?t-PZ-SwZdr zImR#aZ1i( zMGQ|%kYFe6MU5Vw9b3jPxwX-cY*G8Y;&~5|9KR400_~TeE08IhK_InU|DzqslDyU} zpHqVK<4n+nl_40`5-{qDRR18KIPi*n`JFP8bh!;Bi!Eye-Tm;~%j^klo5)Ic2fhsd zuMIEob<37+#TxSM@|~Ovr}&yEa!u&c!`;Ew{WY7bFhZ{77lt{Z3|n%BPdFWfK67G{ zR7W0O*A#6LRM$ROOssTdtHO9K7+M zGWb-`l0CLPR~A@PE5+R9jFyc5@h}dnb)qs95p9Q;tSAy%8tm7}yy&ze8b_;czI@as z>2(idiSO}D{)F~vWAsxUMBM0iHH}<(+=r{~7}gP;iLI33&rQxku6y)TWJOecm05o* z8ne(*iq#q(zW(3XCjW<4On9y`J{y`j?LI_RANoFz;i+C+-gLoLfyf{-)-&_4vgL*F z2S#<#Fx7)vJ%%pgMGvk%hCEvFmlB*Gr)zv9>BIMY=ix5zqK*R32nm}mOOIejje2x+ z)U={_>)zHq5Ui(;!%3*EFYmo{+XJ za?a$_ckeRl$ju4ks=tjk+szK}nM*rOQ@=m$^WF9|%xq`cL(KU#$7Wm`R+^Rq6-i6hY&fv_{&T0f`GKyq8LxB&Z&X>Y zG7;@6M)nHVqV&tz&UiaANq}s1CXtsl$|jt3_nr^*Np!Ue8}nBsmpgz$m|JgX$n^Z$ zQHfRjZj}hfC;alh=R(|iv*xf0|Ah9FH$CtF;&YPH(uon5opXF1yL$8nxemQ6dEp=T zo9ggv-cGJtV4Ne3)>WQs#bZP|?S;X9-b7nl{9!iRgvFRJZ{m9gq3U9h>c#|3T20T- z_DONG-GV~7aji>n@q07T4#Ox@ktsZS!VW#rrE2%1>ZHzL)w<1La`G5;Xat!yL7J3= z9)+}Mytcd#jhK2?mN?~da@u)reANKU3kIK7OGxha#A&4VGtaL^iTC}^dRlCFIwT=k zhDv#=S!LS|?d)M#WH)adD{5a_7hB)bQNGayD2q8Mtow3onp9&5yo%rxH~#)pO5u_q zl>Ekvf2KB~{QrpVMmlh707%u*3ho9p8gyEMR>}^-kGiu$9%*8<8{n-xE*_gW zT6D`;C|Y(QXs@gsxZBeDwU(78_@mSEXCsQPmd&i{%)3EmgSA|0EmN#rFwLUSkWupF z7Vnufz2Fi?b5qtgUJfzMA4{0Zba(Y1gP! dwdoc p. 1 + + +

    + + Interface from GCL to X Windows
    + +

    + +

    +

    + +

    + + +Department of Computer Sciences
    + +University of Texas at Austin
    + +Austin, TX 78712
    + + +

    +Software copyright   by Gordon S. Novak Jr. and +The University of Texas at Austin. Distribution and use are allowed +under the Gnu Public License. Also see the copyright section at the end +of this document for the copyright on X Consortium software. +

    +

    + +

    +

    Introduction

    +

    +This document describes a relatively easy-to-use interface between +XGCL (X version of Gnu Common Lisp) and X windows. The interface +consists of several parts: +

      + +
    1. Hiep Huu Nguyen has written (and adapted from X Consortium software) +an interface between GCL and Xlib, the X library in C. +Xlib functions can be called directly if desired, but most users will find +the dwindow functions easier to use. There is little documentation +of these functions, but the Xlib documentation can be consulted, and +the dwindow functions can be examined as examples. +

      +

    2. The dwindow functions described in this document, which call +the Xlib functions and provide an easier interface for Lisp programs. +

      +

    3. It is possible to make an interactive graphical interface +within a web page; this is described in a section below. +
    + +The source file for the interface (written in GLISP) is + dwindow.lsp; this file is compiled into a file in plain Lisp, + dwtrans.lsp. dwtrans.lsp is compiled as part of XGCL. +

    +The functions in this package use the convention that the coordinate + (0 0) is the lower-left corner of a window, with positive y +being upward. This is different from the convention used by +X, which assumes that (0 0) is the upper left corner and +that positive y is downward. +

    +In the descriptions below, some function arguments are shown with a type, +e.g. arg:type, to indicate the expected type of the argument. +The type vector is a list (x y) of integers. The argument + w that is used with many functions is of type window +( window is a Lisp data structure used by the dwindow functions). +

    +Both the Xlib and dwindow functions are in the package xlib:. +In order to use these functions, the Lisp command (use-package 'xlib) +should be used to import the dwindow symbols. +

    +

    +

    Examples and Utilities

    +

    +

    dwtest

    +

    +The file dwtest.lsp contains example functions that illustrate +the use of the dwindow package. The function call (wtesta) +creates a small window for testing. (wtestb) through + (wtestk) perform drawing and mouse interaction tests using the +window. These functions may be consulted as examples of the use of +commonly used dwindow functions. +

    +

    pcalc

    +

    +The file pcalc.lsp implements +a pocket calculator as a picmenu; its entry is (pcalc). +

    +

    draw

    +

    +The file drawtrans.lsp contains an interactive drawing program; +its entry is (draw 'foo) where foo is the name of the drawing. +The file ice-cream.lsp can be loaded, followed by + (draw 'ice-cream) to examine an example drawing. + draw can produce a Lisp program or a set of commands to +recreate the drawing; use origin to zero before making a program. + (draw-out file names) will write definitions of drawings in the +list names to the file file. +

    +

    editors

    +

    +The file editorstrans.lsp contains some interactive editing programs; +it is a translation of the file editors.lsp . +One useful editor is the color editor; after entering (wtesta) +(in file dwtest.lsp), enter (edit-color myw) to edit a +color. The result is an rgb list as used in window-set-color. +

    +A simple line editor and an Emacs-like text editor are described in sections +texted and emacsed below. +

    +

    Menus

    +

    +The function menu provides an easy interface to make a pop-up menu, +get a selection from it, and destroy it:
    + +

    +

    + +          (menu items &optional title)
    + +

    +

    + +Example: (menu '(red white blue)) +

    +This simple call is all that is needed in most cases. +More sophisticated menu features are described below. +

    +The items in a menu is a list; each item may be a symbol, a cons +of a symbol or string and the corresponding value, or a cons of a +function name and the corresponding value. In the latter case, the function +is expected to draw the corresponding menu item. +

    +If a function name is specified as the first element of a menu item, the +drawing function should have arguments (fn w x y), where w +is the window and x and y are the lower-left corner of the +drawing area. The property list of the function name should have the +property display-size, which should be a list (width height) +in pixels of the displayed symbol. +

    +Menus can be associated with a particular window; if no window is specified, +the menu is associated with the window where the mouse cursor is located +when the menu is initialized (which might not be a Lisp user's window). If a +menu is associated with a user window, it may be permanent (left +displayed after a selection is made) and may be flat (drawn directly +on the containing window, rather than having its own window). +

    +A menu can be created by menu-create :
    + +

    +

    + +          + (menu-create items &optional title w:window x y perm flat font)
    + +

    +

    + + title, if specified, is displayed over the menu. + w is an existing window; if specified, the menu is put +within this window at the x y offsets specified (adjusted if necessary +to keep the menu inside the window). If no w +is specified, or if x is nil, the menu is put where the cursor +is the first time the menu is displayed. + perm is non- nil if the menu is to be permanent, i.e., is to +be left displayed after a selection has been made. + flat is non- nil if the menu is to be drawn directly on the +containing window. + font is a symbol or string that names the font to be used; the +default is a 9x15 typewriter font. +

    +The menu is returned as the value of menu-create. Such a menu can +be saved; selections can be made from a menu m as follows:
    + +

    +

    + +          (menu-select m &optional inside) or +          (menu-select! m)
    + +

    +

    + + menu-select will return nil if the mouse is clicked outside the +menu, or is moved outside after it has been inside (or if inside is +not nil), provided that the menu is contained within a user-created +window. + menu-select! requires that a choice be made. +

    +In order to avoid wasting storage, unused menus should be destroyed: + (menu-destroy m). The simple menu function destroys its +menu after it is used. +

    +          (menu-size m)
    + +          (menu-moveto-xy m x y)
    + +          (menu-reposition m) +

    + menu-reposition will reposition a flat menu within its parent +window by allowing the user to position a ghost box using the mouse. + menu-size returns the size of the menu as a vector, (x y). + menu-moveto-xy adjusts the offsets to move a flat menu to +the specified position within its parent window. These functions and + menu-destroy work for picmenus and barmenus as well. +

    +          (menu-item-position m name &optional location)
    + +

    +

    + + menu-item-position returns a vector (x y) that gives the +coordinates of the menu item whose name is name. location +may be center, left, right, top, or bottom; +the default is the lower-left corner of the menu item. center +specifies the center of the box containing the menu item; the other + location values are at the center of the specified edge of the box. +

    +

    Picmenus

    +

    +A picmenu (picture menu) is analogous to a menu, but involves a +user-defined picture containing sensitive spots or ``buttons''. +The test function (wteste) shows an example of a picmenu. +A picmenu is created by:
    + +

    +

    + +          (picmenu-create buttons width height drawfn
    + +         &optional title dotflg w:window x y perm flat font boxflg)
    + +

    +

    + +

    +If a picmenu is to be used more than once, the common parts can be made +into a picmenu-spec and reused: +

    +

    + +          (picmenu-create-spec buttons width height drawfn
    + +         &optional dotflg font)
    + +

    +

    + +          (picmenu-create-from-spec spec:picmenu-spec
    + +         &optional title w:window x y perm flat boxflg)
    + +

    +

    + + width and height are the size of the area occupied by the +picture. (drawfn w x y) should draw the picture at the offset + x y. Note that the draw utility can be used to +make the drawing function, including picmenu buttons. + dotflg is non- nil if it is desired that small boxes be +automatically added to the sensitive points when the picture is drawn. + boxflg is non- nil if a box is to be drawn around the picmenu +when the picture is drawn (this is only needed for flat +picmenus). If perm is non-nil, the drawing program is not called when +a selection is to be made, so that an external program must draw the + picmenu; this avoids the need to redraw a complex picture. +The remaining arguments are as described for menus. +

    +Each of the buttons in a picmenu is a list:
    + +

    +

    + +          (buttonname offset size highlightfn unhighlightfn)
    + +

    +

    + + buttonname is the name of the button; it is the value returned when that +button is selected. + offset is a vector (x y) that gives the offset of the center +of the button from the lower-left corner of the picture. +The remainder of the button list may be omitted. + size is an optional list (width height) that gives the size of the +sensitive area of the button; the default size is (12 12). + (highlightfn w x y) and (unhighlightfn w x y) (where (x y) +is the center of the button in the coordinates of w) are optional +functions to highlight the button area when the cursor is moved into it and +unhighlight the button when the cursor is moved out; the default is to +display a box of the specified size. +

    +          (picmenu-select m &optional inside)
    + +If the picmenu is not flat, its window should be destroyed +following the selection using menu-destroy. +

    +          (picmenu-item-position m name &optional location)
    + +

    +

    + +          (picmenu-delete-named-button m name:symbol)
    + +This deletes a button from a displayed picmenu. The set of +deleted buttons is reset to nil when the picmenu is drawn. +

    +

    Barmenus

    +

    +A barmenu displays a bar graph whose size can be adjusted using +the mouse. +

    +          +(barmenu-create maxval initval barwidth
    + +         &optional title horizontal subtrackfn subtrackparms
    + +         parentw x y perm flat color)     +

    +A value is selected by: (barmenu-select m:barmenu &optional inside)
    + +If the barmenu is not flat, its window should be destroyed +following the selection using menu-destroy. +

    +The user must first click the mouse in the bar area; then +the size of the displayed bar is adjusted as the user moves the mouse +pointer. In addition, the subtrackfn is called with arguments +of the size of the bar followed by the subtrackparms; this can +be used, for example, to display a numeric value in addition to the +bar size. +

    +

    +

    Menu Sets and Menu Conns

    +

    +A menu-set is a set of multiple menus, picmenus, or barmenus +that are simultaneously active within the same window. Menu-sets +can be used to implement graphical user interfaces. A menu-conns +is a menu-set that includes connections between menus; this can be +used to implement interfaces that allow the user to construct a network +from components. +

    +The source file for menu-sets is the GLISP file menu-set.lsp; +this file is translated as part of the file drawtrans.lsp in +plain Lisp. Examples of the use of menu sets are given at the top +of the file menu-set.lsp. In the following descriptions, + ms is a menu-set and mc is a menu-conns. +

    +          (menu-set-create w) creates a menu set to be displayed +in the window w. +

    +          (menu-set-name symbol) makes a gensym name that +begins with symbol. +

    +          (menu-set-add-menu ms name:symbol sym title items
    + +         &optional offset:vector) +

    +This function adds a menu to a menu-set. sym is arbitrary +information that is saved with the menu. +

    +          (menu-set-add-picmenu ms name sym title spec:picmenu-spec
    + +         &optional offset:vector nobox) +

    +          (menu-set-add-component ms name &optional offset:vector) +

    +This adds a component that has a picmenu-spec defined on the +property list of name. +

    +          (menu-set-add-barmenu ms name sym barmenu title
    + +         &optional offset:vector) +

    +          (menu-set-draw ms) draws all the menus. +

    +          (menu-set-select ms &optional redraw enabled) +

    + menu-set-select gets a selection from a menu-set. If redraw +is non- nil, the menu-set is drawn. enabled may be a list +of names of menus that are enabled for selection. The result is + (selection menu-name), or ((x y) BACKGROUND button) +for a click outside any menu. +

    +

    +          (menu-conns-create ms) creates a menu-conns +from a menu-set. +

    +          (menu-conns-add-conn mc) +

    +This function allows the user to select two ports from menus of the + menu-conns. It then draws a line between the ports and adds the +connection to the connections of the menu-conns. +

    +          (menu-conns-move mc) +

    +This function allows the user to select a menu and move it. +The menu-set and connections are redrawn afterwards. +

    +          (menu-conns-find-conn mc pt:vector)
    + +This finds the connection selected by the point pt, if any. +This is useful to allow the user to delete a connection: +

    +          (menu-conns-delete-conn mc conn) +

    +          (menu-conns-find-conns mc menuname port)
    + +This returns all the connections from the specified port (selection) +of the menu whose name is menuname. +

    +

    +

    Windows

    +

    +          (window-create width height &optional title parentw + x y font)
    + +

    +

    + + window-create makes a new window of the specified width and + height. title, if specified, becomes the displayed title +of the window. If parentw is specified, it should be the + window-parent property of an existing window, which becomes the parent +window of the new window. x and y are the offset of the +new window from the parent window. font is the font to be used +for printing in the window; the default is given by + *window-default-font-name*, initially courier-bold-12. +

    +          (window-open w) causes a window to be displayed +on the screen. +

    +          (window-close w) removes the window from the display; +it can be re-opened. +

    +          (window-destroy w) +

    +          (window-moveto-xy w x y) +

    +          (window-geometry w) queries X for the window geometry. +The result is a list, + (x y width height border-width) . +

    +          (window-size w) returns a list (width height) . +

    +

    + +Note that the width and height are cached within the structure so that no call +to X is needed to examine them. However, if the window is resized, it is +necessary to call (window-reset-geometry w) to reset the local +parameters to their correct values. +

    + + + + + + +

    +The following functions provide access to the parts of the window data +structure; most applications will not need to use them.
    + +

    +

    + +          (window-gcontext w)
    + +          (window-parent w)
    + +          (window-drawable-height w)
    + +          (window-drawable-width w)
    + +          (window-label w)
    + +          (window-font w)
    + +          (window-screen-height)
    + +

    +

    +

    Drawing Functions

    +

    +          (window-clear w) clears the window to the background +color. +

    +          (window-force-output &optional w) +

    +

    + +Communication between the running program and X windows is done through a +stream; actual drawing on the display is done asynchronously. + window-force-output causes the current drawing commands, if any, +to be sent to X. Without this, commands may be left in the stream buffer and +may appear not to have been executed. The argument w is not used. +

    +In all of the drawing functions, the linewidth argument is optional +and defaults to 1. +

    +

    + +          (window-draw-line w from:vector to:vector linewidth)
    + +          + (window-draw-line-xy w x1 y1 x2 y2 &optional linewidth op)
    + +          op may be xor or erase. +

    +

    + +          + (window-draw-arrow-xy w x1 y1 x2 y2 &optional linewidth size)
    + +          + (window-draw-arrow2-xy w x1 y1 x2 y2 &optional linewidth size)
    + +          + (window-draw-arrowhead-xy w x1 y1 x2 y2 &optional linewidth size) +

    +

    + +These draw a line with an arrowhead at the second point, a line with an +arrowhead at both points, or an arrowhead alone at the second point, +respectively. size is the arrowhead size; the default is + (+ 20 (* linewidth 5)). +

    +

    + +          (window-draw-box-xy w x y width height linewidth)
    + +          (window-xor-box-xy w x y width height linewidth)
    + +          (window-draw-box w offset:vector size:vector linewidth)
    + +          (window-draw-box-corners w x1 y1 x2 y2 linewidth)
    + +          where (x1 y1) and (x2 y2) are opposite corners.
    + +          (window-draw-rcbox-xy w x y width height radius linewidth)
    + +          draws a box with rounded corners. +

    +          (window-draw-arc-xy w x y radiusx radiusy anglea angleb linewidth) +

    +

    + + anglea is the angle, in degrees, at which the arc is started. + angleb is the angle, in degrees, that specifies the amount of arc +to be drawn, counterclockwise from the starting position. +

    +

    + +          (window-draw-circle-xy w x y radius linewidth)
    + +          (window-draw-circle w center:vector radius linewidth)
    + +          (window-draw-ellipse-xy w x y radiusx radiusy linewidth)
    + +          (window-draw-dot-xy w x y) +

    +

    + +          (window-erase-area-xy w left bottom width height)
    + +          (window-erase-area w offset:vector size:vector)
    + +          (window-copy-area-xy w fromx fromy tox toy width height)
    + +          (window-invert-area w offset:vector size:vector)
    + +          (window-invert-area-xy w left bottom width height) +

    +

    + +          (window-printat-xy w s x y)
    + +          (window-printat w s at:vector)
    + +          (window-prettyprintat-xy w s x y)
    + +          (window-prettyprintat w s at:vector)
    + +

    +

    + +The argument s is printed at the specified position. + s is stringified if necessary. +Currently, the pretty-print versions are the same as the plain versions. +

    +

    + +          (window-draw-border w) draws a border just +inside a window. +

    +

    Fonts, Operations, Colors

    +

    +          (window-set-font w font) +

    +

    + +The font symbols that are currently defined are courier-bold-12, + 8x10, and 9x15 . The global variable *window-fonts* +contains correspondences between font symbols and font strings. +A font string may also be specified instead of a font symbol. +

    +          (window-string-width w s)
    + +          (window-string-extents w s)
    + +These give the width and the vertical size (ascent descent) in pixels +of the specified string s using the font of the specified window. + s is stringified if necessary. +

    +Operations on a window other than direct drawing are performed by +setting a condition for the window, performing the operation, and then +unsetting the condition with window-unset. window-reset +will reset a window to its ``standard'' setting; it is useful primarily +for cases in which a program bug causes window settings to be in an +undesired state. +

    +

    + +          (window-set-xor w)
    + +          (window-set-erase w)
    + +          (window-set-copy w)
    + +          (window-set-invert w)
    + +          (window-unset w)
    + +          (window-reset w)
    + +

    +          (window-set-line-width w width)
    + +          (window-set-line-attr w width &optional line-style cap-style join-style)
    + +          (window-std-line-attr w)
    + +

    +          (window-foreground w)
    + +          (window-set-foreground w fg-color)
    + +          (window-background w)
    + +          (window-set-background w bg-color)
    + +

    +

    +

    Color

    +

    +The color of the foreground (things that are drawn, such as lines or +characters) is set by: +

    +          (window-set-color w rgb &optional background)
    + +          (window-set-color-rgb w r g b &optional background)
    + +

    + rgb is a list (red green blue) of 16-bit unsigned integers in +the range 0 to 65535. background is non- nil +to set the background color rather than the foreground color. +

    +          (window-reset-color w)
    + + window-reset-color resets a window's colors to the default values. +

    +Colors are a scarce resource; there is only a finite number of +available colors, such as 256 colors. If you only use a small, fixed set +of colors, the finite set of colors will not be a problem. However, +if you create a lot of colors that are used only briefly, it will be +necessary to release them after they are no longer needed. + window-set-color will leave the global variable *window-xcolor* +set to an integer value that denotes an X color; this value should be +saved and used as the argument to window-free-color to release +the color after it is no longer needed. +

    +          (window-free-color w &optional xcolor)
    + +

    + window-free-color frees either the last color used, as given by + *window-xcolor*, or the specified color. +

    +

    +

    Character Input

    texted +

    +Characters can be input within a window by the call: +

    +          (window-input-string w str x y &optional size)
    + +

    + window-input-string will print the initial string str, +if non- nil, +at the specified position in the window; str, if not modified +by the user, will also be the initial part of the result. A caret +is displayed showing the location of the next input character. +Characters are echoed as they are typed; backspacing erases characters, +including those from the initial string str. An area of width + size (default 100) is erased to the right of the initial caret. +

    +

    +

    Emacs-like Editing

    emacsed +

    + window-edit allows editing of text using an Emacs-subset editor. +Only a few simple Emacs commands are implemented. +

    +
+   (window-edit w x y width height optional strings boxflg scroll endp)
+
    + + x y width height specify the offset and size of the editing +area; it is a good idea to draw a box around this area first. + strings is an initial list of strings; the return value is a list +of strings. + scroll is number of lines to scroll down before displaying text, + or T to have one line only and terminate on return. + endp is T to begin editing at the end of the first line. +Example: +
    +
+  (window-draw-box-xy myw 48 48 204 204)
+  (window-edit myw 50 50 200 200 '("Now is the time" "for all" "good"))
+
    + +

    +

    +

    Mouse Interaction

    +

    +          (window-get-point w)
    + +          (window-get-crosshairs w)
    + +          (window-get-cross w)
    + +These functions get a point position by mouse click; they return (x y) . +

    +The following function gets a point position by mouse click. It returns + (button (x y)) where button is 1 for the left button, + 2 for middle, 3 for right. +

    +          (window-get-click w)
    + +

    +The following function gets a point position by mouse click within a specified +region. It returns (button (x y)) or NIL if the mouse leaves +the region. If boxflg is t, a box will be drawn outside the +region while the mouse is being tracked. +

    +          (window-track-mouse-in-region w x y sizex sizey &optional boxflg)
    + +

    +

    +The following functions get a point position indicated by drawing a line +from a specified origin position to the cursor position; they return + (x y) at the cursor position when a mouse button is clicked. +The latex version restricts the slope of the line to be a slope that + can draw; if flg is non- nil, the slope is restricted +to be a vector slope. +

    +          (window-get-line-position w orgx orgy)
    + +          (window-get-latex-position w orgx orgy flg)
    + +

    +The following function gets a position by moving a ``ghost'' icon, +defined by the icon drawing function fn. This allows exact positioning +of an object by the user. +

    +          (window-get-icon-position w fn args &optional (dx 0) + (dy 0))
    + +

    +

    + +The function fn has arguments (fn w x y . args) , where x +and y are the offset within the window w at which the icon is +to be drawn, and args is a list of arbitrary arguments, e.g., the size +of the icon, that are passed through to the drawing function. +The icon is drawn in xor mode, so it must be drawn using +only ``plain'' drawing functions, without resetting window attributes. +The returned value is (x y) at the cursor position when a button +is clicked. dx and dy, if specified, are offsets of x +and y from the cursor position. +

    +The following function gets a position by moving a ``ghost'' box icon. +

    +          (window-get-box-position w width height &optional (dx 0) (dy 0))
    + +

    +

    + +By default, the lower-left corner of the box is placed at the cursor position; + dx and dy may be used to offset the box from the cursor, e.g., +to move the box by a different corner. The returned value is (x y) +at the cursor position when a button is clicked. +

    +The following function gets coordinates of a box of arbitrary size and +position. +

    +          (window-get-region w)
    + +

    +

    + +The user first clicks for one corner of the box, moves the +mouse and clicks again for the opposite corner, then moves the box into +the desired position. The returned value is + ((x y) (width height)), +where (x y) is the lower-left corner of the box. +

    +The following function gets the size of a box by mouse selection, +echoing the size in pixels below the box. offsety +should be at least 30 to leave room to display the size of the box. +

    +          (window-get-box-size w offsetx offsety)
    + +

    +

    +The following function adjusts one side of a box. +

    +          (window-adjust-box-side w x y width height side)
    + +

    +

    + + side specifies the side of the box to be adjusted: left, + right, top, or bottom. The result is + ((x y) (width height)) for the resulting box. +

    +          (window-get-circle w &optional center:vector)
    + +          (window-get-ellipse w &optional center:vector)
    + +These functions interactively get a circle or ellipse. For an ellipse, +a circle is gotten first for the horizontal size; then the vertical +size of the ellipse is adjusted. + window-get-circle returns ((x y) radius). + window-get-ellipse returns ((x y) (xradius yradius)). +

    + + +

    + window-track-mouse is the basic function for following the mouse +and performing some action as it moves. This function is used in +the implementation of menus and the mouse-interaction functions described in +this section. +

    +          (window-track-mouse w fn &optional outflg) + +

    + +Each time the mouse position changes or a mouse button is pressed, +the function fn is called with +arguments (x y code) where x and y are the cursor +position, code is a button code ( 0 if no button, 1 for +the left button, 2 for the middle button, or 3 for the right +button). window-track-mouse continues to track the mouse until fn +returns a value other than nil, at which time window-track-mouse +returns that value. Usually, it is a good idea for fn to return a +value other than nil upon a mouse click. If the argument outflg +is non- nil, the function fn will be called for button clicks +outside the window w; note, however, that such clicks will not be +seen if the containing window intercepts them, so that this feature will +work only if the window w is inside another Lisp user window. +

    +

    +

    Miscellaneous Functions

    +

    +          (stringify x) makes its argument into a string. +

    +          (window-destroy-selected-window) waits 3 seconds, +then destroys the window containing the mouse cursor. This function +should be used with care; it can destroy a non-user window, causing +processes associated with the window to be destroyed. It is useful +primarily in debugging, to get rid of a window that is left on the screen +due to an error. + +

    +

    Examples

    +

    +Several interactive programs using this software for their graphical +interface can be found at http://www.cs.utexas.edu/users/novak/ +under the heading Software Demos. +

    +

    +

    Web Interface

    +

    +This software allows a Lisp program to be used interactively within +a web page. There are two approaches, either using an X server on +the computer of the person viewing the web page, or using WeirdX, a +Java program that emulates an X server. Details can be found at: + http://www.cs.utexas.edu/users/novak/dwindow.html +

    +

    +

    Files

    +

    + + + + + + + + + + + + + + + + + + + + +
    + dec.copyright Copyright and license for DEC/MIT files
    + draw.lsp GLISP source code for interactive drawing utility
    + drawtrans.lsp draw.lsp translated into plain Lisp
    + draw-gates.lsp Code to draw nand gates etc.
    + dwdoc.tex source for this document
    + dwexports.lsp exported symbols
    + dwimportsb.lsp imported symbols
    + dwindow.lsp GLISP source code for dwindow functions
    + dwtest.lsp Examples of use of dwindow functions
    + dwtrans.lsp dwindow.lsp translated into plain Lisp
    + editors.lsp Editors for colors etc.
    + editorstrans.lsp translation of editors.lsp
    + gnu.license GNU General Public License
    + ice-cream.lsp Drawing of an ice cream cone made with draw
    + lispserver.lsp Example web demo: a Lisp server
    + lispservertrans.lsp translation of lispserver.lsp
    + menu-set.lsp GLISP source code for menu-set functions
    + menu-settrans.lsp translation of menu-set.lsp
    + pcalc.lsp Pocket calculator implemented as a picmenu
    +
    + +

    +

    + +Contents    +Next    +Page+10    +Index    + diff --git a/xgcl-2/dwdoc/dwdoc2.html b/xgcl-2/dwdoc/dwdoc2.html new file mode 100644 index 0000000..3ce90ed --- /dev/null +++ b/xgcl-2/dwdoc/dwdoc2.html @@ -0,0 +1,117 @@ + dwdoc p. 2 + + +

    +

    Data Types

    +

    +

    +
+(window (listobject  (parent          drawable)
+                     (gcontext        anything)
+                     (drawable-height integer)
+                     (drawable-width  integer)
+                     (label           string)
+                     (font            anything) )
+
    + +

    +

    + +

    +

    +
+(menu (listobject (menu-window     window)
+                  (flat            boolean)
+                  (parent-window   drawable)
+                  (parent-offset-x integer)
+                  (parent-offset-y integer)
+                  (picture-width   integer)
+                  (picture-height  integer)
+                  (title           string)
+                  (permanent       boolean)
+                  (menu-font       symbol)
+                  (item-width      integer)
+                  (item-height     integer)
+                  (items           (listof symbol)) )
+
    + +

    +

    + +

    +

    +
+(picmenu (listobject (menu-window     window)
+                     (flat            boolean)
+                     (parent-window   drawable)
+                     (parent-offset-x integer)
+                     (parent-offset-y integer)
+                     (picture-width   integer)
+                     (picture-height  integer)
+                     (title           string)
+                     (permanent       boolean)
+                     (spec            (transparent picmenu-spec))
+                     (boxflg          boolean)
+                     (deleted-buttons (listof symbol)) )
+
    + +

    +

    + +

    +

    +
+(picmenu-spec (listobject (drawing-width   integer)
+                          (drawing-height  integer)
+                          (buttons         (listof picmenu-button))
+                          (dotflg          boolean)
+                          (drawfn          anything)
+                          (menu-font       symbol) ))
+
    + +

    +

    + +

    +

    +
+(picmenu-button (list (buttonname     symbol)
+                      (offset         vector)
+                      (size           vector)
+                      (highlightfn    anything)
+                      (unhighlightfn  anything))
+
    + +

    +

    + +

    +

    +
+(barmenu (listobject (menu-window     window)
+                     (flat            boolean)
+                     (parent-window   drawable)
+                     (parent-offset-x integer)
+                     (parent-offset-y integer)
+                     (picture-width   integer)
+                     (picture-height  integer)
+                     (title           string)
+                     (permanent       boolean)
+                     (color           rgb)
+                     (value           integer)
+                     (maxval          integer)
+                     (barwidth        integer)
+                     (horizontal      boolean)
+                     (subtrackfn      anything)
+                     (subtrackparms   (listof anything)))
+
    + +

    +

    + +Contents    +Prev    +Next    +Page+10    +Index    + diff --git a/xgcl-2/dwdoc/dwdoc3.html b/xgcl-2/dwdoc/dwdoc3.html new file mode 100644 index 0000000..cc061b8 --- /dev/null +++ b/xgcl-2/dwdoc/dwdoc3.html @@ -0,0 +1,44 @@ + dwdoc p. 3 + + +

    +

    Copyright

    +

    +The following copyright notice applies to the portions of the software +that were adapted from X Consortium software: +

    +
+;;**********************************************************
+;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
+;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
+
+;;                        All Rights Reserved
+
+;;Permission to use, copy, modify, and distribute this software and its 
+;;documentation for any purpose and without fee is hereby granted, 
+;;provided that the above copyright notice appear in all copies and that
+;;both that copyright notice and this permission notice appear in 
+;;supporting documentation, and that the names of Digital or MIT not be
+;;used in advertising or publicity pertaining to distribution of the
+;;software without specific, written prior permission.  
+
+;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+;;SOFTWARE.
+
+;;*****************************************************************
+
+
    + +

    + +Contents    +Prev    +Next    +Page+10    +Index    + diff --git a/xgcl-2/dwdoc/dwdoccontents.html b/xgcl-2/dwdoc/dwdoccontents.html new file mode 100644 index 0000000..31d9ca3 --- /dev/null +++ b/xgcl-2/dwdoc/dwdoccontents.html @@ -0,0 +1 @@ +1. Interface from GCL to X Windows

    diff --git a/xgcl-2/dwdoc/dwdocindex.html b/xgcl-2/dwdoc/dwdocindex.html new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/xgcl-2/dwdoc/dwdocindex.html @@ -0,0 +1 @@ + diff --git a/xgcl-2/gcl_X.lsp b/xgcl-2/gcl_X.lsp new file mode 100644 index 0000000..ac7afd4 --- /dev/null +++ b/xgcl-2/gcl_X.lsp @@ -0,0 +1,689 @@ +(in-package :XLIB) +; X.lsp modified by Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +;; +;; $XConsortium: X.h,v 1.66 88/09/06 15:55:56 jim Exp $ + + +;; Definitions for the X window system likely to be used by applications + + +;;********************************************************** +;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, +;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. + +;;modified by Hiep H Nguyen 28 Jul 91 + +;; All Rights Reserved + +;;Permission to use, copy, modify, and distribute this software and its +;;documentation for any purpose and without fee is hereby granted, +;;provided that the above copyright notice appear in all copies and that +;;both that copyright notice and this permission notice appear in +;;supporting documentation, and that the names of Digital or MIT not be +;;used in advertising or publicity pertaining to distribution of the +;;software without specific, written prior permission. + +;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL +;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, +;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +;;SOFTWARE. + +;;***************************************************************** +(defconstant X_PROTOCOL 11 ) ;; current protocol version +(defconstant X_PROTOCOL_REVISION 0 ) ;; current minor version + +(defconstant True 1) +(defconstant False 0) + +;; Resources + +;;typedef unsigned long XID) ; + +;;typedef XID Window) ; +;;typedef XID Drawable) ; +;;typedef XID Font) ; +;;typedef XID Pixmap) ; +;;typedef XID Cursor) ; +;;typedef XID Colormap) ; +;;typedef XID GContext) ; +;;typedef XID KeySym) ; + +;;typedef unsigned long Mask) ; + +;;typedef unsigned long Atom) ; + +;;typedef unsigned long VisualID) ; + +;;typedef unsigned long Time) ; + +;;typedef unsigned char KeyCode) ; + +;;**************************************************************** +;; * RESERVED RESOURCE AND CONSTANT DEFINITIONS +;; **************************************************************** + +(defconstant None 0 ) ;; universal null resource or null atom + +(defconstant ParentRelative 1 ) ;; background pixmap in CreateWindow + ;;and ChangeWindowAttributes + +(defconstant CopyFromParent 0 ) ;; border pixmap in CreateWindow + ;;and ChangeWindowAttributes + ;;special VisualID and special window + ;; class passed to CreateWindow + +(defconstant PointerWindow 0 ) ;; destination window in SendEvent +(defconstant InputFocus 1 ) ;; destination window in SendEvent + +(defconstant PointerRoot 1 ) ;; focus window in SetInputFocus + +(defconstant AnyPropertyType 0 ) ;; special Atom, passed to GetProperty + +(defconstant AnyKey 0 ) ;; special Key Code, passed to GrabKey + +(defconstant AnyButton 0 ) ;; special Button Code, passed to GrabButton + +(defconstant AllTemporary 0 ) ;; special Resource ID passed to KillClient + +(defconstant CurrentTime 0 ) ;; special Time + +(defconstant NoSymbol 0 ) ;; special KeySym + +;;**************************************************************** +;; * EVENT DEFINITIONS +;; **************************************************************** + +;; Input Event Masks. Used as event-mask window attribute and as arguments +;; to Grab requests. Not to be confused with event names. + +(defconstant NoEventMask 0) +(defconstant KeyPressMask (expt 2 0) ) +(defconstant KeyReleaseMask (expt 2 1) ) +(defconstant ButtonPressMask (expt 2 2) ) +(defconstant ButtonReleaseMask (expt 2 3) ) +(defconstant EnterWindowMask (expt 2 4) ) +(defconstant LeaveWindowMask (expt 2 5) ) +(defconstant PointerMotionMask (expt 2 6) ) +(defconstant PointerMotionHintMask (expt 2 7) ) +(defconstant Button1MotionMask (expt 2 8) ) +(defconstant Button2MotionMask (expt 2 9) ) +(defconstant Button3MotionMask (expt 2 10) ) +(defconstant Button4MotionMask (expt 2 11) ) +(defconstant Button5MotionMask (expt 2 12) ) +(defconstant ButtonMotionMask (expt 2 13) ) +(defconstant KeymapStateMask (expt 2 14)) +(defconstant ExposureMask (expt 2 15) ) +(defconstant VisibilityChangeMask (expt 2 16) ) +(defconstant StructureNotifyMask (expt 2 17) ) +(defconstant ResizeRedirectMask (expt 2 18) ) +(defconstant SubstructureNotifyMask (expt 2 19) ) +(defconstant SubstructureRedirectMask (expt 2 20) ) +(defconstant FocusChangeMask (expt 2 21) ) +(defconstant PropertyChangeMask (expt 2 22) ) +(defconstant ColormapChangeMask (expt 2 23) ) +(defconstant OwnerGrabButtonMask (expt 2 24) ) + +;; Event names. Used in "type" field in XEvent structures. Not to be +;;confused with event masks above. They start from 2 because 0 and 1 +;;are reserved in the protocol for errors and replies. + +(defconstant KeyPress 2) +(defconstant KeyRelease 3) +(defconstant ButtonPress 4) +(defconstant ButtonRelease 5) +(defconstant MotionNotify 6) +(defconstant EnterNotify 7) +(defconstant LeaveNotify 8) +(defconstant FocusIn 9) +(defconstant FocusOut 10) +(defconstant KeymapNotify 11) +(defconstant Expose 12) +(defconstant GraphicsExpose 13) +(defconstant NoExpose 14) +(defconstant VisibilityNotify 15) +(defconstant CreateNotify 16) +(defconstant DestroyNotify 17) +(defconstant UnmapNotify 18) +(defconstant MapNotify 19) +(defconstant MapRequest 20) +(defconstant ReparentNotify 21) +(defconstant ConfigureNotify 22) +(defconstant ConfigureRequest 23) +(defconstant GravityNotify 24) +(defconstant ResizeRequest 25) +(defconstant CirculateNotify 26) +(defconstant CirculateRequest 27) +(defconstant PropertyNotify 28) +(defconstant SelectionClear 29) +(defconstant SelectionRequest 30) +(defconstant SelectionNotify 31) +(defconstant ColormapNotify 32) +(defconstant ClientMessage 33) +(defconstant MappingNotify 34) +(defconstant LASTEvent 35 ) ;; must be bigger than any event # + + +;; Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer, +;; state in various key-, mouse-, and button-related events. + +(defconstant ShiftMask (expt 2 0)) +(defconstant LockMask (expt 2 1)) +(defconstant ControlMask (expt 2 2)) +(defconstant Mod1Mask (expt 2 3)) +(defconstant Mod2Mask (expt 2 4)) +(defconstant Mod3Mask (expt 2 5)) +(defconstant Mod4Mask (expt 2 6)) +(defconstant Mod5Mask (expt 2 7)) + +;; modifier names. Used to build a SetModifierMapping request or +;; to read a GetModifierMapping request. These correspond to the +;; masks defined above. +(defconstant ShiftMapIndex 0) +(defconstant LockMapIndex 1) +(defconstant ControlMapIndex 2) +(defconstant Mod1MapIndex 3) +(defconstant Mod2MapIndex 4) +(defconstant Mod3MapIndex 5) +(defconstant Mod4MapIndex 6) +(defconstant Mod5MapIndex 7) + + +;; button masks. Used in same manner as Key masks above. Not to be confused +;; with button names below. + +(defconstant Button1Mask (expt 2 8)) +(defconstant Button2Mask (expt 2 9)) +(defconstant Button3Mask (expt 2 10)) +(defconstant Button4Mask (expt 2 11)) +(defconstant Button5Mask (expt 2 12)) + +(defconstant AnyModifier (expt 2 15) ) ;; used in GrabButton, GrabKey + + +;; button names. Used as arguments to GrabButton and as detail in ButtonPress +;; and ButtonRelease events. Not to be confused with button masks above. +;; Note that 0 is already defined above as "AnyButton". + +(defconstant Button1 1) +(defconstant Button2 2) +(defconstant Button3 3) +(defconstant Button4 4) +(defconstant Button5 5) + +;; Notify modes + +(defconstant NotifyNormal 0) +(defconstant NotifyGrab 1) +(defconstant NotifyUngrab 2) +(defconstant NotifyWhileGrabbed 3) + +(defconstant NotifyHint 1 ) ;; for MotionNotify events + +;; Notify detail + +(defconstant NotifyAncestor 0) +(defconstant NotifyVirtual 1) +(defconstant NotifyInferior 2) +(defconstant NotifyNonlinear 3) +(defconstant NotifyNonlinearVirtual 4) +(defconstant NotifyPointer 5) +(defconstant NotifyPointerRoot 6) +(defconstant NotifyDetailNone 7) + +;; Visibility notify + +(defconstant VisibilityUnobscured 0) +(defconstant VisibilityPartiallyObscured 1) +(defconstant VisibilityFullyObscured 2) + +;; Circulation request + +(defconstant PlaceOnTop 0) +(defconstant PlaceOnBottom 1) + +;; protocol families + +(defconstant FamilyInternet 0) +(defconstant FamilyDECnet 1) +(defconstant FamilyChaos 2) + +;; Property notification + +(defconstant PropertyNewValue 0) +(defconstant PropertyDelete 1) + +;; Color Map notification + +(defconstant ColormapUninstalled 0) +(defconstant ColormapInstalled 1) + +;; GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes + +(defconstant GrabModeSync 0) +(defconstant GrabModeAsync 1) + +;; GrabPointer, GrabKeyboard reply status + +(defconstant GrabSuccess 0) +(defconstant AlreadyGrabbed 1) +(defconstant GrabInvalidTime 2) +(defconstant GrabNotViewable 3) +(defconstant GrabFrozen 4) + +;; AllowEvents modes + +(defconstant AsyncPointer 0) +(defconstant SyncPointer 1) +(defconstant ReplayPointer 2) +(defconstant AsyncKeyboard 3) +(defconstant SyncKeyboard 4) +(defconstant ReplayKeyboard 5) +(defconstant AsyncBoth 6) +(defconstant SyncBoth 7) + +;; Used in SetInputFocus, GetInputFocus + +(defconstant RevertToNone None) +(defconstant RevertToPointerRoot PointerRoot) +(defconstant RevertToParent 2) + +;;**************************************************************** +;; * ERROR CODES +;; **************************************************************** + +(defconstant Success 0 ) ;; everything's okay +(defconstant BadRequest 1 ) ;; bad request code +(defconstant BadValue 2 ) ;; int parameter out of range +(defconstant BadWindow 3 ) ;; parameter not a Window +(defconstant BadPixmap 4 ) ;; parameter not a Pixmap +(defconstant BadAtom 5 ) ;; parameter not an Atom +(defconstant BadCursor 6 ) ;; parameter not a Cursor +(defconstant BadFont 7 ) ;; parameter not a Font +(defconstant BadMatch 8 ) ;; parameter mismatch +(defconstant BadDrawable 9 ) ;; parameter not a Pixmap or Window +(defconstant BadAccess 10 ) ;; depending on context: + ;;- key/button already grabbed + ;;- attempt to free an illegal + ;; cmap entry + ;;- attempt to store into a read-only + ;; color map entry. + ;;- attempt to modify the access control + ;; list from other than the local host. + +(defconstant BadAlloc 11 ) ;; insufficient resources +(defconstant BadColor 12 ) ;; no such colormap +(defconstant BadGC 13 ) ;; parameter not a GC +(defconstant BadIDChoice 14 ) ;; choice not in range or already used +(defconstant BadName 15 ) ;; font or color name doesn't exist +(defconstant BadLength 16 ) ;; Request length incorrect +(defconstant BadImplementation 17 ) ;; server is defective + +(defconstant FirstExtensionError 128) +(defconstant LastExtensionError 255) + +;;**************************************************************** +;; * WINDOW DEFINITIONS +;; **************************************************************** + +;; Window classes used by CreateWindow +;; Note that CopyFromParent is already defined as 0 above + +(defconstant InputOutput 1) +(defconstant InputOnly 2) + +;; Window attributes for CreateWindow and ChangeWindowAttributes + +(defconstant CWBackPixmap (expt 2 0)) +(defconstant CWBackPixel (expt 2 1)) +(defconstant CWBorderPixmap (expt 2 2)) +(defconstant CWBorderPixel (expt 2 3)) +(defconstant CWBitGravity (expt 2 4)) +(defconstant CWWinGravity (expt 2 5)) +(defconstant CWBackingStore (expt 2 6)) +(defconstant CWBackingPlanes (expt 2 7)) +(defconstant CWBackingPixel (expt 2 8)) +(defconstant CWOverrideRedirect (expt 2 9)) +(defconstant CWSaveUnder (expt 2 10)) +(defconstant CWEventMask (expt 2 11)) +(defconstant CWDontPropagate (expt 2 12)) +(defconstant CWColormap (expt 2 13)) +(defconstant CWCursor (expt 2 14)) + +;; ConfigureWindow structure + +(defconstant CWX (expt 2 0)) +(defconstant CWY (expt 2 1)) +(defconstant CWWidth (expt 2 2)) +(defconstant CWHeight (expt 2 3)) +(defconstant CWBorderWidth (expt 2 4)) +(defconstant CWSibling (expt 2 5)) +(defconstant CWStackMode (expt 2 6)) + + +;; Bit Gravity + +(defconstant ForgetGravity 0) +(defconstant NorthWestGravity 1) +(defconstant NorthGravity 2) +(defconstant NorthEastGravity 3) +(defconstant WestGravity 4) +(defconstant CenterGravity 5) +(defconstant EastGravity 6) +(defconstant SouthWestGravity 7) +(defconstant SouthGravity 8) +(defconstant SouthEastGravity 9) +(defconstant StaticGravity 10) + +;; Window gravity + bit gravity above + +(defconstant UnmapGravity 0) + +;; Used in CreateWindow for backing-store hint + +(defconstant NotUseful 0) +(defconstant WhenMapped 1) +(defconstant Always 2) + +;; Used in GetWindowAttributes reply + +(defconstant IsUnmapped 0) +(defconstant IsUnviewable 1) +(defconstant IsViewable 2) + +;; Used in ChangeSaveSet + +(defconstant SetModeInsert 0) +(defconstant SetModeDelete 1) + +;; Used in ChangeCloseDownMode + +(defconstant DestroyAll 0) +(defconstant RetainPermanent 1) +(defconstant RetainTemporary 2) + +;; Window stacking method (in configureWindow) + +(defconstant Above 0) +(defconstant Below 1) +(defconstant TopIf 2) +(defconstant BottomIf 3) +(defconstant Opposite 4) + +;; Circulation direction + +(defconstant RaiseLowest 0) +(defconstant LowerHighest 1) + +;; Property modes + +(defconstant PropModeReplace 0) +(defconstant PropModePrepend 1) +(defconstant PropModeAppend 2) + +;;**************************************************************** +;; * GRAPHICS DEFINITIONS +;; **************************************************************** + +;; graphics functions, as in GC.alu + +(defconstant GXclear 0 ) ;; 0 +(defconstant GXand 1 ) ;; src AND dst +(defconstant GXandReverse 2 ) ;; src AND NOT dst +(defconstant GXcopy 3 ) ;; src +(defconstant GXandInverted 4 ) ;; NOT src AND dst +(defconstant GXnoop 5 ) ;; dst +(defconstant GXxor 6 ) ;; src XOR dst +(defconstant GXor 7 ) ;; src OR dst +(defconstant GXnor 8 ) ;; NOT src AND NOT dst +(defconstant GXequiv 9 ) ;; NOT src XOR dst +(defconstant GXinvert 10 ) ;; NOT dst +(defconstant GXorReverse 11 ) ;; src OR NOT dst +(defconstant GXcopyInverted 12 ) ;; NOT src +(defconstant GXorInverted 13 ) ;; NOT src OR dst +(defconstant GXnand 14 ) ;; NOT src OR NOT dst +(defconstant GXset 15 ) ;; 1 + +;; LineStyle + +(defconstant LineSolid 0) +(defconstant LineOnOffDash 1) +(defconstant LineDoubleDash 2) + +;; capStyle + +(defconstant CapNotLast 0) +(defconstant CapButt 1) +(defconstant CapRound 2) +(defconstant CapProjecting 3) + +;; joinStyle + +(defconstant JoinMiter 0) +(defconstant JoinRound 1) +(defconstant JoinBevel 2) + +;; fillStyle + +(defconstant FillSolid 0) +(defconstant FillTiled 1) +(defconstant FillStippled 2) +(defconstant FillOpaqueStippled 3) + +;; fillRule + +(defconstant EvenOddRule 0) +(defconstant WindingRule 1) + +;; subwindow mode + +(defconstant ClipByChildren 0) +(defconstant IncludeInferiors 1) + +;; SetClipRectangles ordering + +(defconstant Unsorted 0) +(defconstant YSorted 1) +(defconstant YXSorted 2) +(defconstant YXBanded 3) + +;; CoordinateMode for drawing routines + +(defconstant CoordModeOrigin 0 ) ;; relative to the origin +(defconstant CoordModePrevious 1 ) ;; relative to previous point + +;; Polygon shapes + +;(defconstant Complex 0 ) ;; paths may intersect +(defconstant Nonconvex 1 ) ;; no paths intersect, but not convex +(defconstant Convex 2 ) ;; wholly convex + +;; Arc modes for PolyFillArc + +(defconstant ArcChord 0 ) ;; join endpoints of arc +(defconstant ArcPieSlice 1 ) ;; join endpoints to center of arc + +;; GC components: masks used in CreateGC, CopyGC, ChangeGC, OR'ed into +;; GC.stateChanges + +(defconstant GCFunction (expt 2 0)) +(defconstant GCPlaneMask (expt 2 1)) +(defconstant GCForeground (expt 2 2)) +(defconstant GCBackground (expt 2 3)) +(defconstant GCLineWidth (expt 2 4)) +(defconstant GCLineStyle (expt 2 5)) +(defconstant GCCapStyle (expt 2 6)) +(defconstant GCJoinStyle (expt 2 7)) +(defconstant GCFillStyle (expt 2 8)) +(defconstant GCFillRule (expt 2 9) ) +(defconstant GCTile (expt 2 10)) +(defconstant GCStipple (expt 2 11)) +(defconstant GCTileStipXOrigin (expt 2 12)) +(defconstant GCTileStipYOrigin (expt 2 13)) +(defconstant GCFont (expt 2 14)) +(defconstant GCSubwindowMode (expt 2 15)) +(defconstant GCGraphicsExposures (expt 2 16)) +(defconstant GCClipXOrigin (expt 2 17)) +(defconstant GCClipYOrigin (expt 2 18)) +(defconstant GCClipMask (expt 2 19)) +(defconstant GCDashOffset (expt 2 20)) +(defconstant GCDashList (expt 2 21)) +(defconstant GCArcMode (expt 2 22)) + +(defconstant GCLastBit 22) +;;**************************************************************** +;; * FONTS +;; **************************************************************** + +;; used in QueryFont -- draw direction + +(defconstant FontLeftToRight 0) +(defconstant FontRightToLeft 1) + +(defconstant FontChange 255) + +;;**************************************************************** +;; * IMAGING +;; **************************************************************** + +;; ImageFormat -- PutImage, GetImage + +(defconstant XYBitmap 0 ) ;; depth 1, XYFormat +(defconstant XYPixmap 1 ) ;; depth == drawable depth +(defconstant ZPixmap 2 ) ;; depth == drawable depth + +;;**************************************************************** +;; * COLOR MAP STUFF +;; **************************************************************** + +;; For CreateColormap + +(defconstant AllocNone 0 ) ;; create map with no entries +(defconstant AllocAll 1 ) ;; allocate entire map writeable + + +;; Flags used in StoreNamedColor, StoreColors + +(defconstant DoRed (expt 2 0)) +(defconstant DoGreen (expt 2 1)) +(defconstant DoBlue (expt 2 2)) + +;;**************************************************************** +;; * CURSOR STUFF +;; **************************************************************** + +;; QueryBestSize Class + +(defconstant CursorShape 0 ) ;; largest size that can be displayed +(defconstant TileShape 1 ) ;; size tiled fastest +(defconstant StippleShape 2 ) ;; size stippled fastest + +;;**************************************************************** +;; * KEYBOARD/POINTER STUFF +;; **************************************************************** + +(defconstant AutoRepeatModeOff 0) +(defconstant AutoRepeatModeOn 1) +(defconstant AutoRepeatModeDefault 2) + +(defconstant LedModeOff 0) +(defconstant LedModeOn 1) + +;; masks for ChangeKeyboardControl + +(defconstant KBKeyClickPercent (expt 2 0)) +(defconstant KBBellPercent (expt 2 1)) +(defconstant KBBellPitch (expt 2 2)) +(defconstant KBBellDuration (expt 2 3)) +(defconstant KBLed (expt 2 4)) +(defconstant KBLedMode (expt 2 5)) +(defconstant KBKey (expt 2 6)) +(defconstant KBAutoRepeatMode (expt 2 7)) + +(defconstant MappingSuccess 0) +(defconstant MappingBusy 1) +(defconstant MappingFailed 2) + +(defconstant MappingModifier 0) +(defconstant MappingKeyboard 1) +(defconstant MappingPointer 2) + +;;**************************************************************** +;; * SCREEN SAVER STUFF +;; **************************************************************** + +(defconstant DontPreferBlanking 0) +(defconstant PreferBlanking 1) +(defconstant DefaultBlanking 2) + +(defconstant DisableScreenSaver 0) +(defconstant DisableScreenInterval 0) + +(defconstant DontAllowExposures 0) +(defconstant AllowExposures 1) +(defconstant DefaultExposures 2) + +;; for ForceScreenSaver + +(defconstant ScreenSaverReset 0) +(defconstant ScreenSaverActive 1) + +;;**************************************************************** +;; * HOSTS AND CONNECTIONS +;; **************************************************************** + +;; for ChangeHosts + +(defconstant HostInsert 0) +(defconstant HostDelete 1) + +;; for ChangeAccessControl + +(defconstant EnableAccess 1 ) +(defconstant DisableAccess 0) + +;; Display classes used in opening the connection +;; * Note that the statically allocated ones are even numbered and the +;; * dynamically changeable ones are odd numbered + +(defconstant StaticGray 0) +(defconstant GrayScale 1) +(defconstant StaticColor 2) +(defconstant PseudoColor 3) +(defconstant TrueColor 4) +(defconstant DirectColor 5) + + +;; Byte order used in imageByteOrder and bitmapBitOrder + +(defconstant LSBFirst 0) +(defconstant MSBFirst 1) + + +;(defconstant NULL 0) + + diff --git a/xgcl-2/gcl_X10.lsp b/xgcl-2/gcl_X10.lsp new file mode 100644 index 0000000..db54ff6 --- /dev/null +++ b/xgcl-2/gcl_X10.lsp @@ -0,0 +1,30 @@ +(in-package :XLIB) +; X10.lsp modified by Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + + +(defconstant VertexRelative #x01 ) ;; else absolute +(defconstant VertexDontDraw #x02 ) ;; else draw +(defconstant VertexCurved #x04 ) ;; else straight +(defconstant VertexStartClosed #x08 ) ;; else not +(defconstant VertexEndClosed #x10 ) ;; else not diff --git a/xgcl-2/gcl_XAtom.lsp b/xgcl-2/gcl_XAtom.lsp new file mode 100644 index 0000000..f1ca003 --- /dev/null +++ b/xgcl-2/gcl_XAtom.lsp @@ -0,0 +1,118 @@ +(in-package :XLIB) +; XAtom.lsp modified by Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + + + +;; THIS IS A GENERATED FILE + ;; + ;; Do not change! Changing this file implies a protocol change! + + +(defconstant XA_PRIMARY 1) +(defconstant XA_SECONDARY 2) +(defconstant XA_ARC 3) +(defconstant XA_ATOM 4) +(defconstant XA_BITMAP 5) +(defconstant XA_CARDINAL 6) +(defconstant XA_COLORMAP 7) +(defconstant XA_CURSOR 8) +(defconstant XA_CUT_BUFFER0 9) +(defconstant XA_CUT_BUFFER1 10) +(defconstant XA_CUT_BUFFER2 11) +(defconstant XA_CUT_BUFFER3 12) +(defconstant XA_CUT_BUFFER4 13) +(defconstant XA_CUT_BUFFER5 14) +(defconstant XA_CUT_BUFFER6 15) +(defconstant XA_CUT_BUFFER7 16) +(defconstant XA_DRAWABLE 17) +(defconstant XA_FONT 18) +(defconstant XA_INTEGER 19) +(defconstant XA_PIXMAP 20) +(defconstant XA_POINT 21) +(defconstant XA_RECTANGLE 22) +(defconstant XA_RESOURCE_MANAGER 23) +(defconstant XA_RGB_COLOR_MAP 24) +(defconstant XA_RGB_BEST_MAP 25) +(defconstant XA_RGB_BLUE_MAP 26) +(defconstant XA_RGB_DEFAULT_MAP 27) +(defconstant XA_RGB_GRAY_MAP 28) +(defconstant XA_RGB_GREEN_MAP 29) +(defconstant XA_RGB_RED_MAP 30) +(defconstant XA_STRING 31) +(defconstant XA_VISUALID 32) +(defconstant XA_WINDOW 33) +(defconstant XA_WM_COMMAND 34) +(defconstant XA_WM_HINTS 35) +(defconstant XA_WM_CLIENT_MACHINE 36) +(defconstant XA_WM_ICON_NAME 37) +(defconstant XA_WM_ICON_SIZE 38) +(defconstant XA_WM_NAME 39) +(defconstant XA_WM_NORMAL_HINTS 40) +(defconstant XA_WM_SIZE_HINTS 41) +(defconstant XA_WM_ZOOM_HINTS 42) +(defconstant XA_MIN_SPACE 43) +(defconstant XA_NORM_SPACE 44) +(defconstant XA_MAX_SPACE 45) + + + + + + + + + + + + + + + + +(defconstant XA_END_SPACE 46) +(defconstant XA_SUPERSCRIPT_X 47) +(defconstant XA_SUPERSCRIPT_Y 48) +(defconstant XA_SUBSCRIPT_X 49) +(defconstant XA_SUBSCRIPT_Y 50) +(defconstant XA_UNDERLINE_POSITION 51) +(defconstant XA_UNDERLINE_THICKNESS 52) +(defconstant XA_STRIKEOUT_ASCENT 53) +(defconstant XA_STRIKEOUT_DESCENT 54) +(defconstant XA_ITALIC_ANGLE 55) +(defconstant XA_X_HEIGHT 56) +(defconstant XA_QUAD_WIDTH 57) +(defconstant XA_WEIGHT 58) +(defconstant XA_POINT_SIZE 59) +(defconstant XA_RESOLUTION 60) +(defconstant XA_COPYRIGHT 61) +(defconstant XA_NOTICE 62) +(defconstant XA_FONT_NAME 63) +(defconstant XA_FAMILY_NAME 64) +(defconstant XA_FULL_NAME 65) +(defconstant XA_CAP_HEIGHT 66) +(defconstant XA_WM_CLASS 67) +(defconstant XA_WM_TRANSIENT_FOR 68) + +(defconstant XA_LAST_PREDEFINED 68) + diff --git a/xgcl-2/gcl_XStruct_l_3.lsp b/xgcl-2/gcl_XStruct_l_3.lsp new file mode 100644 index 0000000..1719188 --- /dev/null +++ b/xgcl-2/gcl_XStruct_l_3.lsp @@ -0,0 +1,491 @@ +(in-package :XLIB) +; XStruct-l-3.lsp modified by Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + + + + +;;;;;; XExtCodes functions ;;;;;; + +(defentry make-XExtCodes () ( fixnum "make_XExtCodes" )) +(defentry XExtCodes-first_error (fixnum) ( fixnum "XExtCodes_first_error" )) +(defentry set-XExtCodes-first_error (fixnum fixnum) ( void "set_XExtCodes_first_error" )) +(defentry XExtCodes-first_event (fixnum) ( fixnum "XExtCodes_first_event" )) +(defentry set-XExtCodes-first_event (fixnum fixnum) ( void "set_XExtCodes_first_event" )) +(defentry XExtCodes-major_opcode (fixnum) ( fixnum "XExtCodes_major_opcode" )) +(defentry set-XExtCodes-major_opcode (fixnum fixnum) ( void "set_XExtCodes_major_opcode" )) +(defentry XExtCodes-extension (fixnum) ( fixnum "XExtCodes_extension" )) +(defentry set-XExtCodes-extension (fixnum fixnum) ( void "set_XExtCodes_extension" )) + + +;;;;;; XPixmapFormatValues functions ;;;;;; + +(defentry make-XPixmapFormatValues () ( fixnum "make_XPixmapFormatValues" )) +(defentry XPixmapFormatValues-scanline_pad (fixnum) ( fixnum "XPixmapFormatValues_scanline_pad" )) +(defentry set-XPixmapFormatValues-scanline_pad (fixnum fixnum) ( void "set_XPixmapFormatValues_scanline_pad" )) +(defentry XPixmapFormatValues-bits_per_pixel (fixnum) ( fixnum "XPixmapFormatValues_bits_per_pixel" )) +(defentry set-XPixmapFormatValues-bits_per_pixel (fixnum fixnum) ( void "set_XPixmapFormatValues_bits_per_pixel" )) +(defentry XPixmapFormatValues-depth (fixnum) ( fixnum "XPixmapFormatValues_depth" )) +(defentry set-XPixmapFormatValues-depth (fixnum fixnum) ( void "set_XPixmapFormatValues_depth" )) + + +;;;;;; XGCValues functions ;;;;;; + +(defentry make-XGCValues () ( fixnum "make_XGCValues" )) +(defentry XGCValues-dashes (fixnum) ( char "XGCValues_dashes" )) +(defentry set-XGCValues-dashes (fixnum char) ( void "set_XGCValues_dashes" )) +(defentry XGCValues-dash_offset (fixnum) ( fixnum "XGCValues_dash_offset" )) +(defentry set-XGCValues-dash_offset (fixnum fixnum) ( void "set_XGCValues_dash_offset" )) +(defentry XGCValues-clip_mask (fixnum) ( fixnum "XGCValues_clip_mask" )) +(defentry set-XGCValues-clip_mask (fixnum fixnum) ( void "set_XGCValues_clip_mask" )) +(defentry XGCValues-clip_y_origin (fixnum) ( fixnum "XGCValues_clip_y_origin" )) +(defentry set-XGCValues-clip_y_origin (fixnum fixnum) ( void "set_XGCValues_clip_y_origin" )) +(defentry XGCValues-clip_x_origin (fixnum) ( fixnum "XGCValues_clip_x_origin" )) +(defentry set-XGCValues-clip_x_origin (fixnum fixnum) ( void "set_XGCValues_clip_x_origin" )) +(defentry XGCValues-graphics_exposures (fixnum) ( fixnum "XGCValues_graphics_exposures" )) +(defentry set-XGCValues-graphics_exposures (fixnum fixnum) ( void "set_XGCValues_graphics_exposures" )) +(defentry XGCValues-subwindow_mode (fixnum) ( fixnum "XGCValues_subwindow_mode" )) +(defentry set-XGCValues-subwindow_mode (fixnum fixnum) ( void "set_XGCValues_subwindow_mode" )) +(defentry XGCValues-font (fixnum) ( fixnum "XGCValues_font" )) +(defentry set-XGCValues-font (fixnum fixnum) ( void "set_XGCValues_font" )) +(defentry XGCValues-ts_y_origin (fixnum) ( fixnum "XGCValues_ts_y_origin" )) +(defentry set-XGCValues-ts_y_origin (fixnum fixnum) ( void "set_XGCValues_ts_y_origin" )) +(defentry XGCValues-ts_x_origin (fixnum) ( fixnum "XGCValues_ts_x_origin" )) +(defentry set-XGCValues-ts_x_origin (fixnum fixnum) ( void "set_XGCValues_ts_x_origin" )) +(defentry XGCValues-stipple (fixnum) ( fixnum "XGCValues_stipple" )) +(defentry set-XGCValues-stipple (fixnum fixnum) ( void "set_XGCValues_stipple" )) +(defentry XGCValues-tile (fixnum) ( fixnum "XGCValues_tile" )) +(defentry set-XGCValues-tile (fixnum fixnum) ( void "set_XGCValues_tile" )) +(defentry XGCValues-arc_mode (fixnum) ( fixnum "XGCValues_arc_mode" )) +(defentry set-XGCValues-arc_mode (fixnum fixnum) ( void "set_XGCValues_arc_mode" )) +(defentry XGCValues-fill_rule (fixnum) ( fixnum "XGCValues_fill_rule" )) +(defentry set-XGCValues-fill_rule (fixnum fixnum) ( void "set_XGCValues_fill_rule" )) +(defentry XGCValues-fill_style (fixnum) ( fixnum "XGCValues_fill_style" )) +(defentry set-XGCValues-fill_style (fixnum fixnum) ( void "set_XGCValues_fill_style" )) +(defentry XGCValues-join_style (fixnum) ( fixnum "XGCValues_join_style" )) +(defentry set-XGCValues-join_style (fixnum fixnum) ( void "set_XGCValues_join_style" )) +(defentry XGCValues-cap_style (fixnum) ( fixnum "XGCValues_cap_style" )) +(defentry set-XGCValues-cap_style (fixnum fixnum) ( void "set_XGCValues_cap_style" )) +(defentry XGCValues-line_style (fixnum) ( fixnum "XGCValues_line_style" )) +(defentry set-XGCValues-line_style (fixnum fixnum) ( void "set_XGCValues_line_style" )) +(defentry XGCValues-line_width (fixnum) ( fixnum "XGCValues_line_width" )) +(defentry set-XGCValues-line_width (fixnum fixnum) ( void "set_XGCValues_line_width" )) +(defentry XGCValues-background (fixnum) ( fixnum "XGCValues_background" )) +(defentry set-XGCValues-background (fixnum fixnum) ( void "set_XGCValues_background" )) +(defentry XGCValues-foreground (fixnum) ( fixnum "XGCValues_foreground" )) +(defentry set-XGCValues-foreground (fixnum fixnum) ( void "set_XGCValues_foreground" )) +(defentry XGCValues-plane_mask (fixnum) ( fixnum "XGCValues_plane_mask" )) +(defentry set-XGCValues-plane_mask (fixnum fixnum) ( void "set_XGCValues_plane_mask" )) +(defentry XGCValues-function (fixnum) ( fixnum "XGCValues_function" )) +(defentry set-XGCValues-function (fixnum fixnum) ( void "set_XGCValues_function" )) + + +;;;;;; *GC functions ;;;;;; + +;;(defentry make-*GC () ( fixnum "make_*GC" )) +;;(defentry *GC-values (fixnum) ( fixnum "*GC_values" )) +;;(defentry set-*GC-values (fixnum fixnum) ( void "set_*GC_values" )) +;;(defentry *GC-dirty (fixnum) ( fixnum "*GC_dirty" )) +;;(defentry set-*GC-dirty (fixnum fixnum) ( void "set_*GC_dirty" )) +;;(defentry *GC-dashes (fixnum) ( fixnum "*GC_dashes" )) +;;(defentry set-*GC-dashes (fixnum fixnum) ( void "set_*GC_dashes" )) +;;(defentry *GC-rects (fixnum) ( fixnum "*GC_rects" )) +;;(defentry set-*GC-rects (fixnum fixnum) ( void "set_*GC_rects" )) +;;(defentry *GC-gid (fixnum) ( fixnum "*GC_gid" )) +;;(defentry set-*GC-gid (fixnum fixnum) ( void "set_*GC_gid" )) +;;(defentry *GC-ext_data (fixnum) ( fixnum "*GC_ext_data" )) +;;(defentry set-*GC-ext_data (fixnum fixnum) ( void "set_*GC_ext_data" )) + + +;;;;;; Visual functions ;;;;;; + +(defentry make-Visual () ( fixnum "make_Visual" )) +(defentry Visual-map_entries (fixnum) ( fixnum "Visual_map_entries" )) +(defentry set-Visual-map_entries (fixnum fixnum) ( void "set_Visual_map_entries" )) +(defentry Visual-bits_per_rgb (fixnum) ( fixnum "Visual_bits_per_rgb" )) +(defentry set-Visual-bits_per_rgb (fixnum fixnum) ( void "set_Visual_bits_per_rgb" )) +(defentry Visual-blue_mask (fixnum) ( fixnum "Visual_blue_mask" )) +(defentry set-Visual-blue_mask (fixnum fixnum) ( void "set_Visual_blue_mask" )) +(defentry Visual-green_mask (fixnum) ( fixnum "Visual_green_mask" )) +(defentry set-Visual-green_mask (fixnum fixnum) ( void "set_Visual_green_mask" )) +(defentry Visual-red_mask (fixnum) ( fixnum "Visual_red_mask" )) +(defentry set-Visual-red_mask (fixnum fixnum) ( void "set_Visual_red_mask" )) +(defentry Visual-class (fixnum) ( fixnum "Visual_class" )) +(defentry set-Visual-class (fixnum fixnum) ( void "set_Visual_class" )) +(defentry Visual-visualid (fixnum) ( fixnum "Visual_visualid" )) +(defentry set-Visual-visualid (fixnum fixnum) ( void "set_Visual_visualid" )) +(defentry Visual-ext_data (fixnum) ( fixnum "Visual_ext_data" )) +(defentry set-Visual-ext_data (fixnum fixnum) ( void "set_Visual_ext_data" )) + + +;;;;;; Depth functions ;;;;;; + +(defentry make-Depth () ( fixnum "make_Depth" )) +(defentry Depth-visuals (fixnum) ( fixnum "Depth_visuals" )) +(defentry set-Depth-visuals (fixnum fixnum) ( void "set_Depth_visuals" )) +(defentry Depth-nvisuals (fixnum) ( fixnum "Depth_nvisuals" )) +(defentry set-Depth-nvisuals (fixnum fixnum) ( void "set_Depth_nvisuals" )) +(defentry Depth-depth (fixnum) ( fixnum "Depth_depth" )) +(defentry set-Depth-depth (fixnum fixnum) ( void "set_Depth_depth" )) + + +;;;;;; Screen functions ;;;;;; + +(defentry make-Screen () ( fixnum "make_Screen" )) +(defentry Screen-root_input_mask (fixnum) ( fixnum "Screen_root_input_mask" )) +(defentry set-Screen-root_input_mask (fixnum fixnum) ( void "set_Screen_root_input_mask" )) +(defentry Screen-save_unders (fixnum) ( fixnum "Screen_save_unders" )) +(defentry set-Screen-save_unders (fixnum fixnum) ( void "set_Screen_save_unders" )) +(defentry Screen-backing_store (fixnum) ( fixnum "Screen_backing_store" )) +(defentry set-Screen-backing_store (fixnum fixnum) ( void "set_Screen_backing_store" )) +(defentry Screen-min_maps (fixnum) ( fixnum "Screen_min_maps" )) +(defentry set-Screen-min_maps (fixnum fixnum) ( void "set_Screen_min_maps" )) +(defentry Screen-max_maps (fixnum) ( fixnum "Screen_max_maps" )) +(defentry set-Screen-max_maps (fixnum fixnum) ( void "set_Screen_max_maps" )) +(defentry Screen-black_pixel (fixnum) ( fixnum "Screen_black_pixel" )) +(defentry set-Screen-black_pixel (fixnum fixnum) ( void "set_Screen_black_pixel" )) +(defentry Screen-white_pixel (fixnum) ( fixnum "Screen_white_pixel" )) +(defentry set-Screen-white_pixel (fixnum fixnum) ( void "set_Screen_white_pixel" )) +(defentry Screen-cmap (fixnum) ( fixnum "Screen_cmap" )) +(defentry set-Screen-cmap (fixnum fixnum) ( void "set_Screen_cmap" )) +(defentry Screen-default_gc (fixnum) ( fixnum "Screen_default_gc" )) +(defentry set-Screen-default_gc (fixnum fixnum) ( void "set_Screen_default_gc" )) +(defentry Screen-root_visual (fixnum) ( fixnum "Screen_root_visual" )) +(defentry set-Screen-root_visual (fixnum fixnum) ( void "set_Screen_root_visual" )) +(defentry Screen-root_depth (fixnum) ( fixnum "Screen_root_depth" )) +(defentry set-Screen-root_depth (fixnum fixnum) ( void "set_Screen_root_depth" )) +(defentry Screen-depths (fixnum) ( fixnum "Screen_depths" )) +(defentry set-Screen-depths (fixnum fixnum) ( void "set_Screen_depths" )) +(defentry Screen-ndepths (fixnum) ( fixnum "Screen_ndepths" )) +(defentry set-Screen-ndepths (fixnum fixnum) ( void "set_Screen_ndepths" )) +(defentry Screen-mheight (fixnum) ( fixnum "Screen_mheight" )) +(defentry set-Screen-mheight (fixnum fixnum) ( void "set_Screen_mheight" )) +(defentry Screen-mwidth (fixnum) ( fixnum "Screen_mwidth" )) +(defentry set-Screen-mwidth (fixnum fixnum) ( void "set_Screen_mwidth" )) +(defentry Screen-height (fixnum) ( fixnum "Screen_height" )) +(defentry set-Screen-height (fixnum fixnum) ( void "set_Screen_height" )) +(defentry Screen-width (fixnum) ( fixnum "Screen_width" )) +(defentry set-Screen-width (fixnum fixnum) ( void "set_Screen_width" )) +(defentry Screen-root (fixnum) ( fixnum "Screen_root" )) +(defentry set-Screen-root (fixnum fixnum) ( void "set_Screen_root" )) +(defentry Screen-display (fixnum) ( fixnum "Screen_display" )) +(defentry set-Screen-display (fixnum fixnum) ( void "set_Screen_display" )) +(defentry Screen-ext_data (fixnum) ( fixnum "Screen_ext_data" )) +(defentry set-Screen-ext_data (fixnum fixnum) ( void "set_Screen_ext_data" )) + + +;;;;;; ScreenFormat functions ;;;;;; + +(defentry make-ScreenFormat () ( fixnum "make_ScreenFormat" )) +(defentry ScreenFormat-scanline_pad (fixnum) ( fixnum "ScreenFormat_scanline_pad" )) +(defentry set-ScreenFormat-scanline_pad (fixnum fixnum) ( void "set_ScreenFormat_scanline_pad" )) +(defentry ScreenFormat-bits_per_pixel (fixnum) ( fixnum "ScreenFormat_bits_per_pixel" )) +(defentry set-ScreenFormat-bits_per_pixel (fixnum fixnum) ( void "set_ScreenFormat_bits_per_pixel" )) +(defentry ScreenFormat-depth (fixnum) ( fixnum "ScreenFormat_depth" )) +(defentry set-ScreenFormat-depth (fixnum fixnum) ( void "set_ScreenFormat_depth" )) +(defentry ScreenFormat-ext_data (fixnum) ( fixnum "ScreenFormat_ext_data" )) +(defentry set-ScreenFormat-ext_data (fixnum fixnum) ( void "set_ScreenFormat_ext_data" )) + + +;;;;;; XSetWindowAttributes functions ;;;;;; + +(defentry make-XSetWindowAttributes () ( fixnum "make_XSetWindowAttributes" )) +(defentry XSetWindowAttributes-cursor (fixnum) ( fixnum "XSetWindowAttributes_cursor" )) +(defentry set-XSetWindowAttributes-cursor (fixnum fixnum) ( void "set_XSetWindowAttributes_cursor" )) +(defentry XSetWindowAttributes-colormap (fixnum) ( fixnum "XSetWindowAttributes_colormap" )) +(defentry set-XSetWindowAttributes-colormap (fixnum fixnum) ( void "set_XSetWindowAttributes_colormap" )) +(defentry XSetWindowAttributes-override_redirect (fixnum) ( fixnum "XSetWindowAttributes_override_redirect" )) +(defentry set-XSetWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XSetWindowAttributes_override_redirect" )) +(defentry XSetWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XSetWindowAttributes_do_not_propagate_mask" )) +(defentry set-XSetWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_do_not_propagate_mask" )) +(defentry XSetWindowAttributes-event_mask (fixnum) ( fixnum "XSetWindowAttributes_event_mask" )) +(defentry set-XSetWindowAttributes-event_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_event_mask" )) +(defentry XSetWindowAttributes-save_under (fixnum) ( fixnum "XSetWindowAttributes_save_under" )) +(defentry set-XSetWindowAttributes-save_under (fixnum fixnum) ( void "set_XSetWindowAttributes_save_under" )) +(defentry XSetWindowAttributes-backing_pixel (fixnum) ( fixnum "XSetWindowAttributes_backing_pixel" )) +(defentry set-XSetWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_pixel" )) +(defentry XSetWindowAttributes-backing_planes (fixnum) ( fixnum "XSetWindowAttributes_backing_planes" )) +(defentry set-XSetWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_planes" )) +(defentry XSetWindowAttributes-backing_store (fixnum) ( fixnum "XSetWindowAttributes_backing_store" )) +(defentry set-XSetWindowAttributes-backing_store (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_store" )) +(defentry XSetWindowAttributes-win_gravity (fixnum) ( fixnum "XSetWindowAttributes_win_gravity" )) +(defentry set-XSetWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_win_gravity" )) +(defentry XSetWindowAttributes-bit_gravity (fixnum) ( fixnum "XSetWindowAttributes_bit_gravity" )) +(defentry set-XSetWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_bit_gravity" )) +(defentry XSetWindowAttributes-border_pixel (fixnum) ( fixnum "XSetWindowAttributes_border_pixel" )) +(defentry set-XSetWindowAttributes-border_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixel" )) +(defentry XSetWindowAttributes-border_pixmap (fixnum) ( fixnum "XSetWindowAttributes_border_pixmap" )) +(defentry set-XSetWindowAttributes-border_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixmap" )) +(defentry XSetWindowAttributes-background_pixel (fixnum) ( fixnum "XSetWindowAttributes_background_pixel" )) +(defentry set-XSetWindowAttributes-background_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixel" )) +(defentry XSetWindowAttributes-background_pixmap (fixnum) ( fixnum "XSetWindowAttributes_background_pixmap" )) +(defentry set-XSetWindowAttributes-background_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixmap" )) + + +;;;;;; XWindowAttributes functions ;;;;;; + +(defentry make-XWindowAttributes () ( fixnum "make_XWindowAttributes" )) +(defentry XWindowAttributes-screen (fixnum) ( fixnum "XWindowAttributes_screen" )) +(defentry set-XWindowAttributes-screen (fixnum fixnum) ( void "set_XWindowAttributes_screen" )) +(defentry XWindowAttributes-override_redirect (fixnum) ( fixnum "XWindowAttributes_override_redirect" )) +(defentry set-XWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XWindowAttributes_override_redirect" )) +(defentry XWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XWindowAttributes_do_not_propagate_mask" )) +(defentry set-XWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XWindowAttributes_do_not_propagate_mask" )) +(defentry XWindowAttributes-your_event_mask (fixnum) ( fixnum "XWindowAttributes_your_event_mask" )) +(defentry set-XWindowAttributes-your_event_mask (fixnum fixnum) ( void "set_XWindowAttributes_your_event_mask" )) +(defentry XWindowAttributes-all_event_masks (fixnum) ( fixnum "XWindowAttributes_all_event_masks" )) +(defentry set-XWindowAttributes-all_event_masks (fixnum fixnum) ( void "set_XWindowAttributes_all_event_masks" )) +(defentry XWindowAttributes-map_state (fixnum) ( fixnum "XWindowAttributes_map_state" )) +(defentry set-XWindowAttributes-map_state (fixnum fixnum) ( void "set_XWindowAttributes_map_state" )) +(defentry XWindowAttributes-map_installed (fixnum) ( fixnum "XWindowAttributes_map_installed" )) +(defentry set-XWindowAttributes-map_installed (fixnum fixnum) ( void "set_XWindowAttributes_map_installed" )) +(defentry XWindowAttributes-colormap (fixnum) ( fixnum "XWindowAttributes_colormap" )) +(defentry set-XWindowAttributes-colormap (fixnum fixnum) ( void "set_XWindowAttributes_colormap" )) +(defentry XWindowAttributes-save_under (fixnum) ( fixnum "XWindowAttributes_save_under" )) +(defentry set-XWindowAttributes-save_under (fixnum fixnum) ( void "set_XWindowAttributes_save_under" )) +(defentry XWindowAttributes-backing_pixel (fixnum) ( fixnum "XWindowAttributes_backing_pixel" )) +(defentry set-XWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XWindowAttributes_backing_pixel" )) +(defentry XWindowAttributes-backing_planes (fixnum) ( fixnum "XWindowAttributes_backing_planes" )) +(defentry set-XWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XWindowAttributes_backing_planes" )) +(defentry XWindowAttributes-backing_store (fixnum) ( fixnum "XWindowAttributes_backing_store" )) +(defentry set-XWindowAttributes-backing_store (fixnum fixnum) ( void "set_XWindowAttributes_backing_store" )) +(defentry XWindowAttributes-win_gravity (fixnum) ( fixnum "XWindowAttributes_win_gravity" )) +(defentry set-XWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XWindowAttributes_win_gravity" )) +(defentry XWindowAttributes-bit_gravity (fixnum) ( fixnum "XWindowAttributes_bit_gravity" )) +(defentry set-XWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XWindowAttributes_bit_gravity" )) +(defentry XWindowAttributes-class (fixnum) ( fixnum "XWindowAttributes_class" )) +(defentry set-XWindowAttributes-class (fixnum fixnum) ( void "set_XWindowAttributes_class" )) +(defentry XWindowAttributes-root (fixnum) ( fixnum "XWindowAttributes_root" )) +(defentry set-XWindowAttributes-root (fixnum fixnum) ( void "set_XWindowAttributes_root" )) +(defentry XWindowAttributes-visual (fixnum) ( fixnum "XWindowAttributes_visual" )) +(defentry set-XWindowAttributes-visual (fixnum fixnum) ( void "set_XWindowAttributes_visual" )) +(defentry XWindowAttributes-depth (fixnum) ( fixnum "XWindowAttributes_depth" )) +(defentry set-XWindowAttributes-depth (fixnum fixnum) ( void "set_XWindowAttributes_depth" )) +(defentry XWindowAttributes-border_width (fixnum) ( fixnum "XWindowAttributes_border_width" )) +(defentry set-XWindowAttributes-border_width (fixnum fixnum) ( void "set_XWindowAttributes_border_width" )) +(defentry XWindowAttributes-height (fixnum) ( fixnum "XWindowAttributes_height" )) +(defentry set-XWindowAttributes-height (fixnum fixnum) ( void "set_XWindowAttributes_height" )) +(defentry XWindowAttributes-width (fixnum) ( fixnum "XWindowAttributes_width" )) +(defentry set-XWindowAttributes-width (fixnum fixnum) ( void "set_XWindowAttributes_width" )) +(defentry XWindowAttributes-y (fixnum) ( fixnum "XWindowAttributes_y" )) +(defentry set-XWindowAttributes-y (fixnum fixnum) ( void "set_XWindowAttributes_y" )) +(defentry XWindowAttributes-x (fixnum) ( fixnum "XWindowAttributes_x" )) +(defentry set-XWindowAttributes-x (fixnum fixnum) ( void "set_XWindowAttributes_x" )) + + +;;;;;; XHostAddress functions ;;;;;; + +(defentry make-XHostAddress () ( fixnum "make_XHostAddress" )) +(defentry XHostAddress-address (fixnum) ( fixnum "XHostAddress_address" )) +(defentry set-XHostAddress-address (fixnum fixnum) ( void "set_XHostAddress_address" )) +(defentry XHostAddress-length (fixnum) ( fixnum "XHostAddress_length" )) +(defentry set-XHostAddress-length (fixnum fixnum) ( void "set_XHostAddress_length" )) +(defentry XHostAddress-family (fixnum) ( fixnum "XHostAddress_family" )) +(defentry set-XHostAddress-family (fixnum fixnum) ( void "set_XHostAddress_family" )) + + +;;;;;; XImage functions ;;;;;; + +(defentry make-XImage () ( fixnum "make_XImage" )) +;;(defentry XImage-f (fixnum) ( fixnum "XImage_f" )) +;;(defentry set-XImage-f (fixnum fixnum) ( void "set_XImage_f" )) +(defentry XImage-obdata (fixnum) ( fixnum "XImage_obdata" )) +(defentry set-XImage-obdata (fixnum fixnum) ( void "set_XImage_obdata" )) +(defentry XImage-blue_mask (fixnum) ( fixnum "XImage_blue_mask" )) +(defentry set-XImage-blue_mask (fixnum fixnum) ( void "set_XImage_blue_mask" )) +(defentry XImage-green_mask (fixnum) ( fixnum "XImage_green_mask" )) +(defentry set-XImage-green_mask (fixnum fixnum) ( void "set_XImage_green_mask" )) +(defentry XImage-red_mask (fixnum) ( fixnum "XImage_red_mask" )) +(defentry set-XImage-red_mask (fixnum fixnum) ( void "set_XImage_red_mask" )) +(defentry XImage-bits_per_pixel (fixnum) ( fixnum "XImage_bits_per_pixel" )) +(defentry set-XImage-bits_per_pixel (fixnum fixnum) ( void "set_XImage_bits_per_pixel" )) +(defentry XImage-bytes_per_line (fixnum) ( fixnum "XImage_bytes_per_line" )) +(defentry set-XImage-bytes_per_line (fixnum fixnum) ( void "set_XImage_bytes_per_line" )) +(defentry XImage-depth (fixnum) ( fixnum "XImage_depth" )) +(defentry set-XImage-depth (fixnum fixnum) ( void "set_XImage_depth" )) +(defentry XImage-bitmap_pad (fixnum) ( fixnum "XImage_bitmap_pad" )) +(defentry set-XImage-bitmap_pad (fixnum fixnum) ( void "set_XImage_bitmap_pad" )) +(defentry XImage-bitmap_bit_order (fixnum) ( fixnum "XImage_bitmap_bit_order" )) +(defentry set-XImage-bitmap_bit_order (fixnum fixnum) ( void "set_XImage_bitmap_bit_order" )) +(defentry XImage-bitmap_unit (fixnum) ( fixnum "XImage_bitmap_unit" )) +(defentry set-XImage-bitmap_unit (fixnum fixnum) ( void "set_XImage_bitmap_unit" )) +(defentry XImage-byte_order (fixnum) ( fixnum "XImage_byte_order" )) +(defentry set-XImage-byte_order (fixnum fixnum) ( void "set_XImage_byte_order" )) +(defentry XImage-data (fixnum) ( fixnum "XImage_data" )) +(defentry set-XImage-data (fixnum fixnum) ( void "set_XImage_data" )) +(defentry XImage-format (fixnum) ( fixnum "XImage_format" )) +(defentry set-XImage-format (fixnum fixnum) ( void "set_XImage_format" )) +(defentry XImage-xoffset (fixnum) ( fixnum "XImage_xoffset" )) +(defentry set-XImage-xoffset (fixnum fixnum) ( void "set_XImage_xoffset" )) +(defentry XImage-height (fixnum) ( fixnum "XImage_height" )) +(defentry set-XImage-height (fixnum fixnum) ( void "set_XImage_height" )) +(defentry XImage-width (fixnum) ( fixnum "XImage_width" )) +(defentry set-XImage-width (fixnum fixnum) ( void "set_XImage_width" )) + + +;;;;;; XWindowChanges functions ;;;;;; + +(defentry make-XWindowChanges () ( fixnum "make_XWindowChanges" )) +(defentry XWindowChanges-stack_mode (fixnum) ( fixnum "XWindowChanges_stack_mode" )) +(defentry set-XWindowChanges-stack_mode (fixnum fixnum) ( void "set_XWindowChanges_stack_mode" )) +(defentry XWindowChanges-sibling (fixnum) ( fixnum "XWindowChanges_sibling" )) +(defentry set-XWindowChanges-sibling (fixnum fixnum) ( void "set_XWindowChanges_sibling" )) +(defentry XWindowChanges-border_width (fixnum) ( fixnum "XWindowChanges_border_width" )) +(defentry set-XWindowChanges-border_width (fixnum fixnum) ( void "set_XWindowChanges_border_width" )) +(defentry XWindowChanges-height (fixnum) ( fixnum "XWindowChanges_height" )) +(defentry set-XWindowChanges-height (fixnum fixnum) ( void "set_XWindowChanges_height" )) +(defentry XWindowChanges-width (fixnum) ( fixnum "XWindowChanges_width" )) +(defentry set-XWindowChanges-width (fixnum fixnum) ( void "set_XWindowChanges_width" )) +(defentry XWindowChanges-y (fixnum) ( fixnum "XWindowChanges_y" )) +(defentry set-XWindowChanges-y (fixnum fixnum) ( void "set_XWindowChanges_y" )) +(defentry XWindowChanges-x (fixnum) ( fixnum "XWindowChanges_x" )) +(defentry set-XWindowChanges-x (fixnum fixnum) ( void "set_XWindowChanges_x" )) + + +;;;;;; XColor functions ;;;;;; + +(defentry make-XColor () ( fixnum "make_XColor" )) +(defentry XColor-pad (fixnum) ( char "XColor_pad" )) +(defentry set-XColor-pad (fixnum char) ( void "set_XColor_pad" )) +(defentry XColor-flags (fixnum) ( char "XColor_flags" )) +(defentry set-XColor-flags (fixnum char) ( void "set_XColor_flags" )) +(defentry XColor-blue (fixnum) ( fixnum "XColor_blue" )) +(defentry set-XColor-blue (fixnum fixnum) ( void "set_XColor_blue" )) +(defentry XColor-green (fixnum) ( fixnum "XColor_green" )) +(defentry set-XColor-green (fixnum fixnum) ( void "set_XColor_green" )) +(defentry XColor-red (fixnum) ( fixnum "XColor_red" )) +(defentry set-XColor-red (fixnum fixnum) ( void "set_XColor_red" )) +(defentry XColor-pixel (fixnum) ( fixnum "XColor_pixel" )) +(defentry set-XColor-pixel (fixnum fixnum) ( void "set_XColor_pixel" )) + + +;;;;;; XSegment functions ;;;;;; + +(defentry make-XSegment () ( fixnum "make_XSegment" )) +(defentry XSegment-y2 (fixnum) ( fixnum "XSegment_y2" )) +(defentry set-XSegment-y2 (fixnum fixnum) ( void "set_XSegment_y2" )) +(defentry XSegment-x2 (fixnum) ( fixnum "XSegment_x2" )) +(defentry set-XSegment-x2 (fixnum fixnum) ( void "set_XSegment_x2" )) +(defentry XSegment-y1 (fixnum) ( fixnum "XSegment_y1" )) +(defentry set-XSegment-y1 (fixnum fixnum) ( void "set_XSegment_y1" )) +(defentry XSegment-x1 (fixnum) ( fixnum "XSegment_x1" )) +(defentry set-XSegment-x1 (fixnum fixnum) ( void "set_XSegment_x1" )) + + +;;;;;; XPoint functions ;;;;;; + +(defentry make-XPoint () ( fixnum "make_XPoint" )) +(defentry XPoint-y (fixnum) ( fixnum "XPoint_y" )) +(defentry set-XPoint-y (fixnum fixnum) ( void "set_XPoint_y" )) +(defentry XPoint-x (fixnum) ( fixnum "XPoint_x" )) +(defentry set-XPoint-x (fixnum fixnum) ( void "set_XPoint_x" )) + + +;;;;;; XRectangle functions ;;;;;; + +(defentry make-XRectangle () ( fixnum "make_XRectangle" )) +(defentry XRectangle-height (fixnum) ( fixnum "XRectangle_height" )) +(defentry set-XRectangle-height (fixnum fixnum) ( void "set_XRectangle_height" )) +(defentry XRectangle-width (fixnum) ( fixnum "XRectangle_width" )) +(defentry set-XRectangle-width (fixnum fixnum) ( void "set_XRectangle_width" )) +(defentry XRectangle-y (fixnum) ( fixnum "XRectangle_y" )) +(defentry set-XRectangle-y (fixnum fixnum) ( void "set_XRectangle_y" )) +(defentry XRectangle-x (fixnum) ( fixnum "XRectangle_x" )) +(defentry set-XRectangle-x (fixnum fixnum) ( void "set_XRectangle_x" )) + + +;;;;;; XArc functions ;;;;;; + +(defentry make-XArc () ( fixnum "make_XArc" )) +(defentry XArc-angle2 (fixnum) ( fixnum "XArc_angle2" )) +(defentry set-XArc-angle2 (fixnum fixnum) ( void "set_XArc_angle2" )) +(defentry XArc-angle1 (fixnum) ( fixnum "XArc_angle1" )) +(defentry set-XArc-angle1 (fixnum fixnum) ( void "set_XArc_angle1" )) +(defentry XArc-height (fixnum) ( fixnum "XArc_height" )) +(defentry set-XArc-height (fixnum fixnum) ( void "set_XArc_height" )) +(defentry XArc-width (fixnum) ( fixnum "XArc_width" )) +(defentry set-XArc-width (fixnum fixnum) ( void "set_XArc_width" )) +(defentry XArc-y (fixnum) ( fixnum "XArc_y" )) +(defentry set-XArc-y (fixnum fixnum) ( void "set_XArc_y" )) +(defentry XArc-x (fixnum) ( fixnum "XArc_x" )) +(defentry set-XArc-x (fixnum fixnum) ( void "set_XArc_x" )) + + +;;;;;; XKeyboardControl functions ;;;;;; + +(defentry make-XKeyboardControl () ( fixnum "make_XKeyboardControl" )) +(defentry XKeyboardControl-auto_repeat_mode (fixnum) ( fixnum "XKeyboardControl_auto_repeat_mode" )) +;;(defentry set-XKeyboardControl-auto_repeat_mode (fixnum fixnum) ( void "set_XKeyboardControl_auto_repeat_mode" )) +(defentry XKeyboardControl-key (fixnum) ( fixnum "XKeyboardControl_key" )) +(defentry set-XKeyboardControl-key (fixnum fixnum) ( void "set_XKeyboardControl_key" )) +(defentry XKeyboardControl-led_mode (fixnum) ( fixnum "XKeyboardControl_led_mode" )) +(defentry set-XKeyboardControl-led_mode (fixnum fixnum) ( void "set_XKeyboardControl_led_mode" )) +(defentry XKeyboardControl-led (fixnum) ( fixnum "XKeyboardControl_led" )) +(defentry set-XKeyboardControl-led (fixnum fixnum) ( void "set_XKeyboardControl_led" )) +(defentry XKeyboardControl-bell_duration (fixnum) ( fixnum "XKeyboardControl_bell_duration" )) +(defentry set-XKeyboardControl-bell_duration (fixnum fixnum) ( void "set_XKeyboardControl_bell_duration" )) +(defentry XKeyboardControl-bell_pitch (fixnum) ( fixnum "XKeyboardControl_bell_pitch" )) +(defentry set-XKeyboardControl-bell_pitch (fixnum fixnum) ( void "set_XKeyboardControl_bell_pitch" )) +(defentry XKeyboardControl-bell_percent (fixnum) ( fixnum "XKeyboardControl_bell_percent" )) +(defentry set-XKeyboardControl-bell_percent (fixnum fixnum) ( void "set_XKeyboardControl_bell_percent" )) +(defentry XKeyboardControl-key_click_percent (fixnum) ( fixnum "XKeyboardControl_key_click_percent" )) +(defentry set-XKeyboardControl-key_click_percent (fixnum fixnum) ( void "set_XKeyboardControl_key_click_percent" )) + + +;;;;;; XKeyboardState functions ;;;;;; + +(defentry make-XKeyboardState () ( fixnum "make_XKeyboardState" )) +(defentry XKeyboardState-auto_repeats (fixnum) ( fixnum "XKeyboardState_auto_repeats" )) +(defentry set-XKeyboardState-auto_repeats (fixnum object) ( void "set_XKeyboardState_auto_repeats" )) +(defentry XKeyboardState-global_auto_repeat (fixnum) ( fixnum "XKeyboardState_global_auto_repeat" )) +(defentry set-XKeyboardState-global_auto_repeat (fixnum fixnum) ( void "set_XKeyboardState_global_auto_repeat" )) +(defentry XKeyboardState-led_mask (fixnum) ( fixnum "XKeyboardState_led_mask" )) +(defentry set-XKeyboardState-led_mask (fixnum fixnum) ( void "set_XKeyboardState_led_mask" )) +(defentry XKeyboardState-bell_duration (fixnum) ( fixnum "XKeyboardState_bell_duration" )) +(defentry set-XKeyboardState-bell_duration (fixnum fixnum) ( void "set_XKeyboardState_bell_duration" )) +(defentry XKeyboardState-bell_pitch (fixnum) ( fixnum "XKeyboardState_bell_pitch" )) +(defentry set-XKeyboardState-bell_pitch (fixnum fixnum) ( void "set_XKeyboardState_bell_pitch" )) +(defentry XKeyboardState-bell_percent (fixnum) ( fixnum "XKeyboardState_bell_percent" )) +(defentry set-XKeyboardState-bell_percent (fixnum fixnum) ( void "set_XKeyboardState_bell_percent" )) +(defentry XKeyboardState-key_click_percent (fixnum) ( fixnum "XKeyboardState_key_click_percent" )) +(defentry set-XKeyboardState-key_click_percent (fixnum fixnum) ( void "set_XKeyboardState_key_click_percent" )) + + +;;;;;; XTimeCoord functions ;;;;;; + +(defentry make-XTimeCoord () ( fixnum "make_XTimeCoord" )) +(defentry XTimeCoord-y (fixnum) ( fixnum "XTimeCoord_y" )) +(defentry set-XTimeCoord-y (fixnum fixnum) ( void "set_XTimeCoord_y" )) +(defentry XTimeCoord-x (fixnum) ( fixnum "XTimeCoord_x" )) +(defentry set-XTimeCoord-x (fixnum fixnum) ( void "set_XTimeCoord_x" )) +(defentry XTimeCoord-time (fixnum) ( fixnum "XTimeCoord_time" )) +(defentry set-XTimeCoord-time (fixnum fixnum) ( void "set_XTimeCoord_time" )) + + +;;;;;; XModifierKeymap functions ;;;;;; + +(defentry make-XModifierKeymap () ( fixnum "make_XModifierKeymap" )) +(defentry XModifierKeymap-modifiermap (fixnum) ( fixnum "XModifierKeymap_modifiermap" )) +(defentry set-XModifierKeymap-modifiermap (fixnum fixnum) ( void "set_XModifierKeymap_modifiermap" )) +(defentry XModifierKeymap-max_keypermod (fixnum) ( fixnum "XModifierKeymap_max_keypermod" )) +(defentry set-XModifierKeymap-max_keypermod (fixnum fixnum) ( void "set_XModifierKeymap_max_keypermod" )) diff --git a/xgcl-2/gcl_Xakcl.example.lsp b/xgcl-2/gcl_Xakcl.example.lsp new file mode 100644 index 0000000..06bbd05 --- /dev/null +++ b/xgcl-2/gcl_Xakcl.example.lsp @@ -0,0 +1,326 @@ +(in-package :XLIB) +; Xakcl.example.lsp Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +;;;;;;;;;;;;;;;;;;;;;; +;;this is an example of getting a geometry feature of a drawable there +;;is also XGetWindowAttributes for just windows. See reference manual +;;on X lib. it is probably more efficient to use XGetGeometry function +;;once when a lot of geometry information is needed since, XGetGeometry +;;returns many values. also as can be noticed, XGetGeometry needs C +;;Pointers, so it is best to allocate these pointers as globals so that +;;they won't have to be created and destroyed all the time, taking time +;;and fragmenting memory + +(defun drawable-height (a-drawable &key (display *default-display*)) + (XGetGeometry display a-drawable *root-return* *x-return* *y-return* *width-return* + *height-return* *border-width-return* *depth-return*) + (int-pos *height-return* 0)) + + + +;;;;;;;;;;;;;;;;;;;;;; +;;this function is a simple application of line drawing. it uses the +;;drawable-height function and the default globals like +;;*default-display* and *default-GC* + +(defun graph-x-y (info &key (test #'first) (scale 10) (displ 0) (invert t)) + + (let* ((info (sort info #'< :key test)) + (first-x-y (first info)) + (prev-x (* (first first-x-y) scale)) + (mid-height ( / (drawable-height a-window) 2)) + (prev-y (if invert + (- mid-height (* (+ (second first-x-y) displ) scale)) + (* (+ (second first-x-y) displ) scale)))) + (print info) + (dolist (next-x-y (rest info)) + (let ((pres-x (* (first next-x-y) scale)) + (pres-y (if invert + (- mid-height (* (+ (second next-x-y) displ) scale)) + (* (+ (second next-x-y) displ) scale)))) + + ;; (format t "~%prev-x : ~a prev-y: ~a pres-x: ~a pres-y: ~a" prev-x prev-y pres-x pres-y) + (Xdrawline *default-display* a-window *default-GC* + prev-x prev-y pres-x pres-y) + (Xflush *default-display*) + (setq prev-x pres-x) + (setq prev-y pres-y))))) + + + +;;;;;;;;;;;;;;;;;;;;;; +;; here's an example of getting values stored in a certain GC +;; the structure XGCValues contain values for a GC +(defun get-foreground-of-gc (display GC) + (XGetGCValues display GC (+ GCForeground) *GC-Values*) + (XGCValues-foreground *GC-Values*)) + + +;;;;;;;;;;;;;;;;;;;;;; +;;this is an example of changing the graphics context and allocating a +;;color for drawing. this is also an example of setting the line +;;attributes this function changes the graphics context so becareful. +;;also notice that c-types Xcolor is created and freed. again it is +;;possible to make them global, because they could be used often. this +;;function was fixed to have no side effects. Side effects are a danger +;;with passing C structures. the structures could be changed as a side +;;effect if you're not careful + +(defun my-draw-line (&key (display *default-display*) (GC *default-GC*) x1 y1 x2 y2 (width 0) (color "BLACK") + (line-style LineSolid) (cap-style CapRound) (join-style JoinRound) (colormap *default-colormap*) + window) + + (let ((pixel-xcolor (make-Xcolor)) + (exact-rgb (make-Xcolor)) + (prev-fore-pixel (get-foreground-of-gc display GC))) + (XSetLineAttributes display GC width line-style cap-style join-style) + (XAllocNamedColor display colormap (get-c-string color) pixel-xcolor exact-rgb) + (Xsetforeground display GC (Xcolor-pixel pixel-xcolor)) + (XDrawLine display window GC x1 y1 x2 y2) + (Xflush display) + (free pixel-xcolor) + (free exact-rgb) + (XSetForeground display GC prev-fore-pixel))) + + + +(defun colors () + (let ((pixel-xcolor (make-Xcolor)) + (y 0) + (r 0) + (b 0) + (g 0)) + (dotimes (g 65535) +;; (format t "~% ~a ~a ~a" r b g) + (set-Xcolor-red pixel-xcolor r) + (set-Xcolor-blue pixel-xcolor b) + (set-Xcolor-green pixel-xcolor g) + (if (not (eql 0 (XallocColor *default-display* *default-colormap* pixel-xcolor))) + (progn (Xsetforeground *default-display* *default-GC* (Xcolor-pixel pixel-xcolor)) + (XDrawLine *default-display* a-window *default-GC* 0 0 200 y) + (Xflush *default-display*) + (incf y 1)) + ;; (format t "~%error in reading color") + )))) + + +(defun return-r-b-g (color &key (display *default-display*) (GC *default-GC*) (colormap *default-colormap*) + ) + (let ((pixel-xcolor (make-Xcolor)) + (exact-rgb (make-Xcolor))) + (XAllocNamedColor display colormap (get-c-string color) pixel-xcolor pixel-xcolor) + (format t "~% red: ~a blue: ~a green: ~a" (Xcolor-red pixel-xcolor) + (Xcolor-blue pixel-xcolor) (Xcolor-green pixel-xcolor)))) + +;;;;;;;;;;;;;;;;;;;;;; +;;this function tracks the mouse. when the mouse button is pressed a +;;line is drawn from the previous position to the current position. +;;this function also shows a way of handling exposure events. The +;;positions are remembered in order to redraw the contents of the window +;;when it is exposed. this function handles events in two windows, the +;;quit window and the draw window. there is an example of setting the +;;input for a window. the draw window can have button press events, +;;pointer motion events and exposure events, while the quit window +;;(button) only needs button press events, and exposure events. notice +;;that the event queue is actually flushed at the beginng of the +;;functions. There is also an example of drawing and inverting text. +;;and handling sub windows. the sub windows are destroyed at the end of +;;the function. + +(defun track-mouse (a-window) + (Xsync *default-display* 1) ;; this clears the event queue so that previous + ;; motion events won't show up + (XClearWindow *default-display* a-window) + + ;; create two sub window + + (let ((quit-window (XCreateSimpleWindow + *default-display* a-window + 2 2 50 20 1 *black-pixel* *white-pixel*)) + (draw-window (XCreateSimpleWindow + *default-display* a-window + 2 32 220 350 1 *black-pixel* *white-pixel*))) + (Xselectinput *default-display* quit-window (+ ButtonpressMask ExposureMask)) + (Xselectinput *default-display* draw-window + (+ ButtonpressMask PointerMotionMask ExposureMask)) + + (XMapWindow *default-display* quit-window) + (XMapWindow *default-display* draw-window) + (Xflush *default-display* ) + (XDrawString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) + (Xflush *default-display* ) + (do ((exit nil) + (lines-list nil) + (prev-x nil) + (prev-y nil)) + (exit) + (XNextEvent *default-display* *default-event*) + (let ((type (XAnyEvent-type *default-event*)) + (active-window (XAnyevent-window *default-event*))) + (cond ((eql draw-window active-window) + (cond +;;; draw a line + ((eql type ButtonPress) + (let ((x (XButtonEvent-x *default-event*)) + (y (XButtonEvent-y *default-event*))) + (if prev-x + (XDrawLine *default-display* draw-window *default-GC* prev-x prev-y x y)) + (setq prev-x x) + (setq prev-y y) + (push (list x y) lines-list))) +;;; track the mouse + ((eql type MotionNotify) + (let ((x (XMotionEvent-x *default-event*)) + (y (XMotionEvent-y *default-event*)) + (time (XmotionEvent-time *default-event*))) + ;;trace the mouse + ;;(format t "~% pos-x: ~a pos-y: ~a" x y) + ;;(format t "~%time: ~a" time) + )) + +;;;; redraw window after expose event + + ((eql type Expose) + (let* ((first-xy (first lines-list)) + (prev-x (first first-xy)) + (prev-y (second first-xy))) + (dolist (an-xy (rest lines-list)) + (let ((x (first an-xy)) + (y (second an-xy))) + (XDrawLine *default-display* draw-window *default-GC* prev-x prev-y x y) + (setq prev-x x) + (setq prev-y y))))))) + + ;; exit if the quit button is pressed + + ((eql quit-window active-window) + (cond ((eql type ButtonPress) + (setq exit t) + (XSetForeground *default-display* + *default-GC* *white-pixel*) + (XSetBackground *default-display* + *default-GC* *black-pixel*) + (XDrawImageString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) + (Xflush *default-display*) + +;;the drawing goes so fast that you can't see the text invert, so the +;;function wiats for for about .2 seconds. but it would be better to +;;keep the text inverted until the button is released this is done by +;;setting the quit window to have buton release events as well and +;;handling it appropriately + + (dotimes (i 1500)) + + + (XSetForeground *default-display* + *default-GC* *black-pixel*) + (XSetBackground *default-display* + *default-GC* *white-pixel*) + (XDrawImageString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) + (Xflush *default-display*)) + +;; do quit window expose event + ((eql type Expose) + (XDrawString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4))))))) + (XDestroySubWindows *default-display* a-window) + (Xflush *default-display*))) + + +;;;;;;;;;;;;;;;;;;;;;; +;;this function demonstrtes using different fonts of text + +(defun basic-text (a-window &key (display *default-display*) (GC *default-GC* )) + (my-load-font "9x15" :display display :GC GC) + (Xdrawstring display a-window GC 50 100 (get-c-string "hello") 5) + (my-load-font "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1" :display display :GC GC) + (Xdrawstring display a-window GC 50 150 (get-c-string "hello") 5) + (Xflush display)) + + +;;;;;;;;;;;;;;;;;;;;;; +;;this function demonstartes getting different fonts and setting them in a GC + +(defun my-load-font (a-string &key (display *default-display*) (GC *default-GC* )) + (let ((font-info (XloadQueryFont display (get-c-string a-string)))) + (if (not (eql 0 font-info)) + (XsetFont display GC (Xfontstruct-fid font-info)) + (format t "~%can't open font ~a" a-string)))) + + +;;;;;;;;;;;;;;;;;;;;;; +;;this function draws a ghst line by setting the X function to GXXor. and the +;;foreground color to th logxor of the back and foreground pixel +;;this function actually changes the graphics context. and does not change it back +;;to use the ghost method and switch back to regular drawing. set the function +;;back to GXcopy and the foregorund pixel appropriately + +(defun do-ghost-line-1 (a-window) + (Xsync *default-display* 1);; this clears the event queue so that previous + ;; motion events won't show up + (XClearWindow *default-display* a-window) + + (XdrawRectangle *default-display* a-window *default-GC* + 0 0 100 100) + (Xdrawarc *default-display* a-window *default-GC* 100 200 100 100 0 (* 360 64)) + + (Xsetfunction *default-display* *default-GC* GXxor) + (Xsetforeground *default-display* *default-GC* (logxor *black-pixel* *white-pixel*)) + (Xselectinput *default-display* a-window PointerMotionMask ) + (do ((exit nil) + (prev-x 0) + (prev-y 0)) + (exit) + (XNextEvent *default-display* *default-event*) + (let ((type (XAnyEvent-type *default-event*))) + (cond + + ;;draw ghost line + ((eql type MotionNotify) + (let ((x (XMotionEvent-x *default-event*)) + (y (XMotionEvent-y *default-event*)) + (time (XmotionEvent-time *default-event*))) + (Xdrawline *default-display* a-window *default-GC* 0 0 prev-x prev-y) + (Xdrawline *default-display* a-window *default-GC* 0 0 x y) + (setq prev-x x) + (setq prev-y y) + )))))) + + + + + + ;;example of a circle + ;;position 100 100 diameter 100 + + ;;(XdrawArc *default-display* a-window *default-GC* 100 100 100 100 0 (* 360 64)) + + ;;example of font + + ;;(XloadFont *default-display* (get-c-string "8x10")) + + + + ;; set a pixel + + ;;(XallocNamedColor *default-display* *default-colormap* (get-c-string "aquamarine") a b) diff --git a/xgcl-2/gcl_Xinit.lsp b/xgcl-2/gcl_Xinit.lsp new file mode 100644 index 0000000..c6cc66f --- /dev/null +++ b/xgcl-2/gcl_Xinit.lsp @@ -0,0 +1,147 @@ +(in-package :XLIB) +; Xinit.lsp Hiep Huu Nguyen 27 Aug 92; GSN 07 Mar 95 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +;;a word about Xakcl: +;;Since Xakcl is a direct translation of the X library in C to lisp to a +;;large extent. it would be beneficial to use a X 11 version 4, manual +;;in order to look up functions. the only unique functions of Xakcl are those +;;that involove manipulating C structs. all functions involved in creating +;;a C struct in X starts with a 'make' followed by the structure name. all +;;functions involved in getting a field of a C struct strats with the +;;name of the C struct followed by the name of the field. the +;;parameters it excepts is the variable contaning the structure. all +;;functions to set a field of a C struct starts with 'set' followed by +;;the C struct name followed by the field name. these functions accept +;;as parameter, the variable containing the struct and the value to be +;;put in the field. + +;;;; +;;contents of this file: +;;;; +;;this files has examples of initializing the display, screen, +;;root-window, pixel value, gc, and colormap. +;;;; +;;gives an example of opening windows, setting size's and sizehints for +;;the window manager getting drawbles' geometry +;;;; +;;drawing lines , drawing in color, changing line, attributes +;;;; +;;tracking the mouse and handling events and manipulating the event +;;queue +;;;; +;;there is also some basic text handling stuff +;;;; + +;;globals +(defvar *default-display* ) +(defvar *default-screen* ) +(defvar *default-colormap*) +(defvar *root-window* ) +(defvar *black-pixel* ) +(defvar *white-pixel* ) +(defvar *default-size-hints* (make-XsizeHints) ) +(defvar *default-GC* ) +(defvar *default-event* (make-XEvent)) +(defvar *pos-x* 10) +(defvar *pos-y* 20) +(defvar *win-width* 225) +(defvar *win-height* 400) +(defvar *border-width* 1) +(defvar *root-return* (int-array 1)) +(defvar *x-return* (int-array 1)) +(defvar *y-return* (int-array 1) ) +(defvar *width-return* (int-array 1)) +(defvar *height-return* (int-array 1)) +(defvar *border-width-return* (int-array 1)) +(defvar *depth-return* (int-array 1)) +(defvar *GC-Values* (make-XGCValues)) + +;;an example window +(defvar a-window) + + +;;;;;;;;;;;;;;;;;;;;;; +;;this function initializes all variables needed by most applications. +;;it uses all defaults which is inherited from the root window, and +;;screen. + +(defun Xinit() + (setq *default-display* (XOpenDisplay (get-c-string ""))) + (setq *default-screen* (XdefaultScreen *default-display*)) + (setq *root-window* (XRootWindow *default-display* *default-screen*)) + (setq *black-pixel* (XBlackPixel *default-display* + *default-screen*)) + (setq *white-pixel* (XWhitePixel *default-display* + *default-screen*)) + (setq *default-GC* (XDefaultGC *default-display* *default-screen*)) + (setq *default-colormap* ( XDefaultColormap *default-display* *default-screen*)) + (Xflush *default-display* )) + + + + +;;;;;;;;;;;;;;;;;;;;;; +;;this is an example of creating a window. this function takes care of +;;positioning, size and other attirbutes of the window. + +(defun open-window(&key (pos-x *pos-x* ) (pos-y *pos-y*) (win-width *win-width*) + (win-height *win-height* ) + (border-width *border-width*) (window-name "My Window") + (icon-name "My Icon")) +;;create the window + + (let (( a-window (XCreateSimpleWindow + *default-display* *root-window* + pos-x pos-y win-width win-height border-width *black-pixel* *white-pixel*))) + +;; all children of the root window needs a XSizeHints to tell the window manager +;; how to position it, etc + + (set-Xsizehints-x *default-size-hints* pos-x) + (set-xsizehints-y *default-size-hints* pos-y) + (set-xsizehints-width *default-size-hints* win-width) + (set-xsizehints-height *default-size-hints* win-height) + (set-xsizehints-flags *default-size-hints* (+ Psize Pposition)) + (XsetStandardProperties *default-display* a-window (get-c-string window-name) + (get-c-string icon-name) none 0 0 *default-size-hints*) + +;; the events or input a window can have are set with Xselectinput +;; (Xselectinput *default-display* a-window +;; (+ ButtonpressMask PointerMotionMask ExposureMask)) + +;; the window needs to be mapped + (Xmapwindow *default-display* a-window) + +;;the X server needs to have the output buffer sent to it before it can +;;process requests. this is acomplished with XFlush or functions that +;;read and manipulate the event queue. remember to do this after +;;operations that won't be calling an eventhandling function + + (Xflush *default-display* ) + +;;after flushing the request buffer the X server draws window as requested + + a-window)) + + diff --git a/xgcl-2/gcl_Xlib.lsp b/xgcl-2/gcl_Xlib.lsp new file mode 100644 index 0000000..616d5eb --- /dev/null +++ b/xgcl-2/gcl_Xlib.lsp @@ -0,0 +1,3456 @@ +(in-package :XLIB) +; Xlib.lsp Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +;;typedef unsigned long XID) ; + +;;typedef XID Window) ; +;;typedef XID Drawable) ; +;;typedef XID Font) ; +;;typedef XID Pixmap) ; +;;typedef XID Cursor) ; +;;typedef XID Colormap) ; +;;typedef XID GContext) ; +;;typedef XID KeySym) ; + +;;typedef unsigned long Mask) ; + +;;typedef unsigned long Atom) ; + +;;typedef unsigned long VisualID) ; + +;;typedef unsigned long Time) ; + +;;typedef unsigned char KeyCode) ; + +(defconstant True 1) +(defconstant False 0) + +(defconstant QueuedAlready 0) +(defconstant QueuedAfterReading 1) +(defconstant QueuedAfterFlush 2) + +(defentry XLoadQueryFont( + + fixnum ;; display + object ;; name + +)( fixnum "XLoadQueryFont")) + + + +(defentry XQueryFont( + + fixnum ;; display + fixnum ;; font_ID + +)( fixnum "XQueryFont")) + + + + +(defentry XGetMotionEvents( + + fixnum ;; display + fixnum ;; w + fixnum ;; start + fixnum ;; stop + fixnum ;; nevents_return + +)( fixnum "XGetMotionEvents")) + + + +(defentry XDeleteModifiermapEntry( + + fixnum ;; modmap + + fixnum ;; keycode_entry + + fixnum ;; modifier + +)( fixnum "XDeleteModifiermapEntry")) + + + +(defentry XGetModifierMapping( + + fixnum ;; display + +)( fixnum "XGetModifierMapping")) + + + +(defentry XInsertModifiermapEntry( + + fixnum ;; modmap + + fixnum ;; keycode_entry + + fixnum ;; modifier + +)( fixnum "XInsertModifiermapEntry")) + + + +(defentry XNewModifiermap( + + fixnum ;; max_keys_per_mod + +)( fixnum "XNewModifiermap")) + + + +(defentry XCreateImage( + + fixnum ;; display + fixnum ;; visual + fixnum ;; depth + fixnum ;; format + fixnum ;; offset + object ;; data + fixnum ;; width + fixnum ;; height + fixnum ;; bitmap_pad + fixnum ;; bytes_per_line + +)( fixnum "XCreateImage")) + + +(defentry XGetImage( + + fixnum ;; display + fixnum ;; d + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + fixnum ;; plane_mask + fixnum ;; format + +)( fixnum "XGetImage")) + + +(defentry XGetSubImage( + + fixnum ;; display + fixnum ;; d + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + fixnum ;; plane_mask + fixnum ;; format + fixnum ;; dest_image + fixnum ;; dest_x + fixnum ;; dest_y + +)( fixnum "XGetSubImage")) + +;;Window X function declarations. + + + +(defentry XOpenDisplay( + + object ;; display_name + +)( fixnum "XOpenDisplay")) + + + +(defentry XrmInitialize( + +;; void + +)( void "XrmInitialize")) + + + +(defentry XFetchBytes( + + fixnum ;; display + fixnum ;; nbytes_return + +)( fixnum "XFetchBytes")) + + +(defentry XFetchBuffer( + + fixnum ;; display + fixnum ;; nbytes_return + fixnum ;; buffer + +)( fixnum "XFetchBuffer")) + + +(defentry XGetAtomName( + + fixnum ;; display + fixnum ;; atom + +)( fixnum "XGetAtomName")) + + +(defentry XGetDefault( + + fixnum ;; display + object ;; program + object ;; option + +)( fixnum "XGetDefault")) + + +(defentry XDisplayName( + + object ;; string + +)( fixnum "XDisplayName")) + + +(defentry XKeysymToString( + + fixnum ;; keysym + +)( fixnum "XKeysymToString")) + + + + +(defentry XInternAtom( + + fixnum ;; display + object ;; atom_name + fixnum ;; only_if_exists + +)( fixnum "XInternAtom")) + + +(defentry XCopyColormapAndFree( + + fixnum ;; display + fixnum ;; colormap + +)( fixnum "XCopyColormapAndFree")) + + +(defentry XCreateColormap( + + fixnum ;; display + fixnum ;; w + fixnum ;; visual + fixnum ;; alloc + +)( fixnum "XCreateColormap")) + + +(defentry XCreatePixmapCursor( + + fixnum ;; display + fixnum ;; source + fixnum ;; mask + fixnum ;; foreground_color + fixnum ;; background_color + fixnum ;; x + fixnum ;; y + +)( fixnum "XCreatePixmapCursor")) + + +(defentry XCreateGlyphCursor( + + fixnum ;; display + fixnum ;; source_font + fixnum ;; mask_font + fixnum ;; source_char + fixnum ;; mask_char + fixnum ;; foreground_color + fixnum ;; background_color + +)( fixnum "XCreateGlyphCursor")) + + +(defentry XCreateFontCursor( + + fixnum ;; display + fixnum ;; shape + +)( fixnum "XCreateFontCursor")) + + +(defentry XLoadFont( + + fixnum ;; display + object ;; name + +)( fixnum "XLoadFont")) + + +(defentry XCreateGC( + + fixnum ;; display + fixnum ;; d + fixnum ;; valuemask + fixnum ;; values + +)( fixnum "XCreateGC")) + + +(defentry XGContextFromGC( + + fixnum ;; gc + +)( fixnum "XGContextFromGC")) + + +(defentry XCreatePixmap( + + fixnum ;; display + fixnum ;; d + fixnum ;; width + fixnum ;; height + fixnum ;; depth + +)( fixnum "XCreatePixmap")) + + +(defentry XCreateBitmapFromData( + + fixnum ;; display + fixnum ;; d + object ;; data + fixnum ;; width + fixnum ;; height + +)( fixnum "XCreateBitmapFromData")) + + +(defentry XCreatePixmapFromBitmapData( + + fixnum ;; display + fixnum ;; d + object ;; data + fixnum ;; width + fixnum ;; height + fixnum ;; fg + fixnum ;; bg + fixnum ;; depth + +)( fixnum "XCreatePixmapFromBitmapData")) + + +(defentry XCreateSimpleWindow( + + fixnum ;; display + fixnum ;; parent + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + fixnum ;; border_width + fixnum ;; border + fixnum ;; background + +)( fixnum "XCreateSimpleWindow")) + + +(defentry XGetSelectionOwner( + + fixnum ;; display + fixnum ;; selection + +)( fixnum "XGetSelectionOwner")) + + +(defentry XCreateWindow( + + fixnum ;; display + fixnum ;; parent + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + fixnum ;; border_width + fixnum ;; depth + fixnum ;; class + fixnum ;; visual + fixnum ;; valuemask + fixnum ;; attributes + +)( fixnum "XCreateWindow")) + + +(defentry XListInstalledColormaps( + + fixnum ;; display + fixnum ;; w + fixnum ;; num_return + +)( fixnum "XListInstalledColormaps")) + + +(defentry XListFonts( + + fixnum ;; display + object ;; pattern + fixnum ;; maxnames + fixnum ;; actual_count_return + +)( fixnum "XListFonts")) + + +(defentry XListFontsWithInfo( + + fixnum ;; display + object ;; pattern + fixnum ;; maxnames + fixnum ;; count_return + fixnum ;; info_return + +)( fixnum "XListFontsWithInfo")) + + +(defentry XGetFontPath( + + fixnum ;; display + fixnum ;; npaths_return + +)( fixnum "XGetFontPath")) + + +(defentry XListExtensions( + + fixnum ;; display + fixnum ;; nextensions_return + +)( fixnum "XListExtensions")) + + +(defentry XListProperties( + + fixnum ;; display + fixnum ;; w + fixnum ;; num_prop_return + +)( fixnum "XListProperties")) + + +(defentry XListHosts( + + fixnum ;; display + fixnum ;; nhosts_return + fixnum ;; state_return + +)( fixnum "XListHosts")) + + +(defentry XKeycodeToKeysym( + + fixnum ;; display + + fixnum ;; fixnum + + fixnum ;; index + +)( fixnum "XKeycodeToKeysym")) + + +(defentry XLookupKeysym( + + fixnum ;; key_event + fixnum ;; index + +)( fixnum "XLookupKeysym")) + + +(defentry XGetKeyboardMapping( + + fixnum ;; display + + fixnum ;; first_keycode + + fixnum ;; keycode_count + fixnum ;; keysyms_per_keycode_return + +)( fixnum "XGetKeyboardMapping")) + + +(defentry XStringToKeysym( + + object ;; string + +)( fixnum "XStringToKeysym")) + + +(defentry XMaxRequestSize( + + fixnum ;; display + +)( fixnum "XMaxRequestSize")) + + +(defentry XResourceManagerString( + + fixnum ;; display + +)( fixnum "XResourceManagerString")) + + +(defentry XDisplayMotionBufferSize( + + fixnum ;; display + +)( fixnum "XDisplayMotionBufferSize")) + + +(defentry XVisualIDFromVisual( + + fixnum ;; visual + +)( fixnum "XVisualIDFromVisual")) + +;; routines for dealing with extensions + + + +(defentry XInitExtension( + + fixnum ;; display + object ;; name + +)( fixnum "XInitExtension")) + + + +(defentry XAddExtension( + + fixnum ;; display + +)( fixnum "XAddExtension")) + + +(defentry XFindOnExtensionList( + + fixnum ;; structure + fixnum ;; number + +)( fixnum "XFindOnExtensionList")) + + + +;;;fix + + +;(defentry XEHeadOfExtensionList( + +; fixnum ;;object + +;)( fixnum "XEHeadOfExtensionList")) + +;; these are routines for which there are also macros + + +(defentry XRootWindow( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XRootWindow")) + + +(defentry XDefaultRootWindow( + + fixnum ;; display + +)( fixnum "XDefaultRootWindow")) + + +(defentry XRootWindowOfScreen( + + fixnum ;; screen + +)( fixnum "XRootWindowOfScreen")) + + +(defentry XDefaultVisual( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDefaultVisual")) + + +(defentry XDefaultVisualOfScreen( + + fixnum ;; screen + +)( fixnum "XDefaultVisualOfScreen")) + + +(defentry XDefaultGC( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDefaultGC")) + + +(defentry XDefaultGCOfScreen( + + fixnum ;; screen + +)( fixnum "XDefaultGCOfScreen")) + + +(defentry XBlackPixel( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XBlackPixel")) + + +(defentry XWhitePixel( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XWhitePixel")) + + +(defentry XAllPlanes( + +;; void + +)( fixnum "XAllPlanes")) + + +(defentry XBlackPixelOfScreen( + + fixnum ;; screen + +)( fixnum "XBlackPixelOfScreen")) + + +(defentry XWhitePixelOfScreen( + + fixnum ;; screen + +)( fixnum "XWhitePixelOfScreen")) + + +(defentry XNextRequest( + + fixnum ;; display + +)( fixnum "XNextRequest")) + + +(defentry XLastKnownRequestProcessed( + + fixnum ;; display + +)( fixnum "XLastKnownRequestProcessed")) + + +(defentry XServerVendor( + + fixnum ;; display + +)( fixnum "XServerVendor")) + + +(defentry XDisplayString( + + fixnum ;; display + +)( fixnum "XDisplayString")) + + +(defentry XDefaultColormap( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDefaultColormap")) + + +(defentry XDefaultColormapOfScreen( + + fixnum ;; screen + +)( fixnum "XDefaultColormapOfScreen")) + + +(defentry XDisplayOfScreen( + + fixnum ;; screen + +)( fixnum "XDisplayOfScreen")) + + +(defentry XScreenOfDisplay( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XScreenOfDisplay")) + + +(defentry XDefaultScreenOfDisplay( + + fixnum ;; display + +)( fixnum "XDefaultScreenOfDisplay")) + + +(defentry XEventMaskOfScreen( + + fixnum ;; screen + +)( fixnum "XEventMaskOfScreen")) + + + +(defentry XScreenNumberOfScreen( + + fixnum ;; screen + +)( fixnum "XScreenNumberOfScreen")) + + + +(defentry XSetErrorHandler ( + + fixnum ;; handler + +)( fixnum "XSetErrorHandler" )) + + +;;fix + + +(defentry XSetIOErrorHandler ( + + fixnum ;; handler + +)( fixnum "XSetIOErrorHandler" )) + + + + +(defentry XListPixmapFormats( + + fixnum ;; display + fixnum ;; count_return + +)( fixnum "XListPixmapFormats")) + + +(defentry XListDepths( + + fixnum ;; display + fixnum ;; screen_number + fixnum ;; count_return + +)( fixnum "XListDepths")) + +;; ICCCM routines for things that don't require special include files; +;; other declarations are given in Xutil.h + + +(defentry XReconfigureWMWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; screen_number + fixnum ;; mask + fixnum ;; changes + +)( fixnum "XReconfigureWMWindow")) + + + +(defentry XGetWMProtocols( + + fixnum ;; display + fixnum ;; w + fixnum ;; protocols_return + fixnum ;; count_return + +)( fixnum "XGetWMProtocols")) + + +(defentry XSetWMProtocols( + + fixnum ;; display + fixnum ;; w + fixnum ;; protocols + fixnum ;; count + +)( fixnum "XSetWMProtocols")) + + +(defentry XIconifyWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; screen_number + +)( fixnum "XIconifyWindow")) + + +(defentry XWithdrawWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; screen_number + +)( fixnum "XWithdrawWindow")) + +;;;fix + + +(defentry XGetCommand( + + fixnum ;; display + fixnum ;; w + fixnum ;; argv_return + fixnum ;; argc_return + +)( fixnum "XGetCommand")) + + +(defentry XGetWMColormapWindows( + + fixnum ;; display + fixnum ;; w + fixnum ;; windows_return + fixnum ;; count_return + +)( fixnum "XGetWMColormapWindows")) + + +(defentry XSetWMColormapWindows( + + fixnum ;; display + fixnum ;; w + fixnum ;; colormap_windows + fixnum ;; count + +)( fixnum "XSetWMColormapWindows")) + + +(defentry XFreeStringList( + + fixnum ;; list + +)( void "XFreeStringList")) + + +(defentry XSetTransientForHint( + + fixnum ;; display + fixnum ;; w + fixnum ;; prop_window + +)( void "XSetTransientForHint")) + +;; The following are given in alphabetical order + + + +(defentry XActivateScreenSaver( + + fixnum ;; display + +)( void "XActivateScreenSaver")) + + + +(defentry XAddHost( + + fixnum ;; display + fixnum ;; host + +)( void "XAddHost")) + + + +(defentry XAddHosts( + + fixnum ;; display + fixnum ;; hosts + fixnum ;; num_hosts + +)( void "XAddHosts")) + + + +(defentry XAddToExtensionList( + + fixnum ;; structure + fixnum ;; ext_data + +)( void "XAddToExtensionList")) + + + +(defentry XAddToSaveSet( + + fixnum ;; display + fixnum ;; w + +)( void "XAddToSaveSet")) + + + +(defentry XAllocColor( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; screen_in_out + +)( fixnum "XAllocColor")) + +;;;fix + + +(defentry XAllocColorCells( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; contig + fixnum ;; plane_masks_return + fixnum ;; nplanes + fixnum ;; pixels_return + fixnum ;; npixels + +)( fixnum "XAllocColorCells")) + + + +(defentry XAllocColorPlanes( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; contig + fixnum ;; pixels_return + fixnum ;; ncolors + fixnum ;; nreds + fixnum ;; ngreens + fixnum ;; nblues + fixnum ;; rmask_return + fixnum ;; gmask_return + fixnum ;; bmask_return + +)( fixnum "XAllocColorPlanes")) + + + +(defentry XAllocNamedColor( + + fixnum ;; display + fixnum ;; colormap + object ;; color_name + fixnum ;; screen_def_return + fixnum ;; exact_def_return + +)( fixnum "XAllocNamedColor")) + + + +(defentry XAllowEvents( + + fixnum ;; display + fixnum ;; event_mode + fixnum ;; time + +)( void "XAllowEvents")) + + + +(defentry XAutoRepeatOff( + + fixnum ;; display + +)( void "XAutoRepeatOff")) + + + +(defentry XAutoRepeatOn( + + fixnum ;; display + +)( void "XAutoRepeatOn")) + + + +(defentry XBell( + + fixnum ;; display + fixnum ;; percent + +)( void "XBell")) + + + +(defentry XBitmapBitOrder( + + fixnum ;; display + +)( fixnum "XBitmapBitOrder")) + + + +(defentry XBitmapPad( + + fixnum ;; display + +)( fixnum "XBitmapPad")) + + + +(defentry XBitmapUnit( + + fixnum ;; display + +)( fixnum "XBitmapUnit")) + + + +(defentry XCellsOfScreen( + + fixnum ;; screen + +)( fixnum "XCellsOfScreen")) + + + +(defentry XChangeActivePointerGrab( + + fixnum ;; display + fixnum ;; event_mask + fixnum ;; cursor + fixnum ;; time + +)( void "XChangeActivePointerGrab")) + + + +(defentry XChangeGC( + + fixnum ;; display + fixnum ;; gc + fixnum ;; valuemask + fixnum ;; values + +)( void "XChangeGC")) + + + +(defentry XChangeKeyboardControl( + + fixnum ;; display + fixnum ;; value_mask + fixnum ;; values + +)( void "XChangeKeyboardControl")) + + + +(defentry XChangeKeyboardMapping( + + fixnum ;; display + fixnum ;; first_keycode + fixnum ;; keysyms_per_keycode + fixnum ;; keysyms + fixnum ;; num_codes + +)( void "XChangeKeyboardMapping")) + + + +(defentry XChangePointerControl( + + fixnum ;; display + fixnum ;; do_accel + fixnum ;; do_threshold + fixnum ;; accel_numerator + fixnum ;; accel_denominator + fixnum ;; threshold + +)( void "XChangePointerControl")) + + + +(defentry XChangeProperty( + + fixnum ;; display + fixnum ;; w + fixnum ;; property + fixnum ;; type + fixnum ;; format + fixnum ;; mode + fixnum ;; data + fixnum ;; nelements + +)( void "XChangeProperty")) + + + +(defentry XChangeSaveSet( + + fixnum ;; display + fixnum ;; w + fixnum ;; change_mode + +)( void "XChangeSaveSet")) + + + +(defentry XChangeWindowAttributes( + + fixnum ;; display + fixnum ;; w + fixnum ;; valuemask + fixnum ;; attributes + +)( void "XChangeWindowAttributes")) + + + +(defentry XCheckMaskEvent( + + fixnum ;; display + fixnum ;; event_mask + fixnum ;; event_return + +)( fixnum "XCheckMaskEvent")) + + + +(defentry XCheckTypedEvent( + + fixnum ;; display + fixnum ;; event_type + fixnum ;; event_return + +)( fixnum "XCheckTypedEvent")) + + + +(defentry XCheckTypedWindowEvent( + + fixnum ;; display + fixnum ;; w + fixnum ;; event_type + fixnum ;; event_return + +)( fixnum "XCheckTypedWindowEvent")) + + + +(defentry XCheckWindowEvent( + + fixnum ;; display + fixnum ;; w + fixnum ;; event_mask + fixnum ;; event_return + +)( fixnum "XCheckWindowEvent")) + + + +(defentry XCirculateSubwindows( + + fixnum ;; display + fixnum ;; w + fixnum ;; direction + +)( void "XCirculateSubwindows")) + + + +(defentry XCirculateSubwindowsDown( + + fixnum ;; display + fixnum ;; w + +)( void "XCirculateSubwindowsDown")) + + + +(defentry XCirculateSubwindowsUp( + + fixnum ;; display + fixnum ;; w + +)( void "XCirculateSubwindowsUp")) + + + +(defentry XClearArea( + + fixnum ;; display + fixnum ;; w + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + fixnum ;; exposures + +)( void "XClearArea")) + + + +(defentry XClearWindow( + + fixnum ;; display + fixnum ;; w + +)( void "XClearWindow")) + + + +(defentry XCloseDisplay( + + fixnum ;; display + +)( void "XCloseDisplay")) + + + +(defentry XConfigureWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; value_mask + fixnum ;; values + +)( void "XConfigureWindow")) + + + +(defentry XConnectionNumber( + + fixnum ;; display + +)( fixnum "XConnectionNumber")) + + + +(defentry XConvertSelection( + + fixnum ;; display + fixnum ;; selection + fixnum ;; target + fixnum ;; property + fixnum ;; requestor + fixnum ;; time + +)( void "XConvertSelection")) + + + +(defentry XCopyArea( + + fixnum ;; display + fixnum ;; src + fixnum ;; dest + fixnum ;; gc + fixnum ;; src_x + fixnum ;; src_y + fixnum ;; width + fixnum ;; height + fixnum ;; dest_x + fixnum ;; dest_y + +)( void "XCopyArea")) + + + +(defentry XCopyGC( + + fixnum ;; display + fixnum ;; src + fixnum ;; valuemask + fixnum ;; dest + +)( void "XCopyGC")) + + + +(defentry XCopyPlane( + + fixnum ;; display + fixnum ;; src + fixnum ;; dest + fixnum ;; gc + fixnum ;; src_x + fixnum ;; src_y + fixnum ;; width + fixnum ;; height + fixnum ;; dest_x + fixnum ;; dest_y + fixnum ;; plane + +)( void "XCopyPlane")) + + + +(defentry XDefaultDepth( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDefaultDepth")) + + + +(defentry XDefaultDepthOfScreen( + + fixnum ;; screen + +)( fixnum "XDefaultDepthOfScreen")) + + + +(defentry XDefaultScreen( + + fixnum ;; display + +)( fixnum "XDefaultScreen")) + + + +(defentry XDefineCursor( + + fixnum ;; display + fixnum ;; w + fixnum ;; cursor + +)( void "XDefineCursor")) + + + +(defentry XDeleteProperty( + + fixnum ;; display + fixnum ;; w + fixnum ;; property + +)( void "XDeleteProperty")) + + + +(defentry XDestroyWindow( + + fixnum ;; display + fixnum ;; w + +)( void "XDestroyWindow")) + + + +(defentry XDestroySubwindows( + + fixnum ;; display + fixnum ;; w + +)( void "XDestroySubwindows")) + + + +(defentry XDoesBackingStore( + + fixnum ;; screen + +)( fixnum "XDoesBackingStore")) + + + +(defentry XDoesSaveUnders( + + fixnum ;; screen + +)( fixnum "XDoesSaveUnders")) + + + +(defentry XDisableAccessControl( + + fixnum ;; display + +)( void "XDisableAccessControl")) + + + + +(defentry XDisplayCells( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDisplayCells")) + + + +(defentry XDisplayHeight( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDisplayHeight")) + + + +(defentry XDisplayHeightMM( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDisplayHeightMM")) + + + +(defentry XDisplayKeycodes( + + fixnum ;; display + fixnum ;; min_keycodes_return + fixnum ;; max_keycodes_return + +)( void "XDisplayKeycodes")) + + + +(defentry XDisplayPlanes( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDisplayPlanes")) + + + +(defentry XDisplayWidth( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDisplayWidth")) + + + +(defentry XDisplayWidthMM( + + fixnum ;; display + fixnum ;; screen_number + +)( fixnum "XDisplayWidthMM")) + + + +(defentry XDrawArc( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + fixnum ;; angle1 + fixnum ;; angle2 + +)( void "XDrawArc")) + + + +(defentry XDrawArcs( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; arcs + fixnum ;; narcs + +)( void "XDrawArcs")) + + + +(defentry XDrawImageString( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + object ;; string + fixnum ;; length + +)( void "XDrawImageString")) + + + +(defentry XDrawImageString16( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; string + fixnum ;; length + +)( void "XDrawImageString16")) + + + +(defentry XDrawLine( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x1 + fixnum ;; x2 + fixnum ;; y1 + fixnum ;; y2 + +)( void "XDrawLine")) + + + +(defentry XDrawLines( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; points + fixnum ;; npoints + fixnum ;; mode + +)( void "XDrawLines")) + + + +(defentry XDrawPoint( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + +)( void "XDrawPoint")) + + + +(defentry XDrawPoints( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; points + fixnum ;; npoints + fixnum ;; mode + +)( void "XDrawPoints")) + + + +(defentry XDrawRectangle( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + +)( void "XDrawRectangle")) + + + +(defentry XDrawRectangles( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; rectangles + fixnum ;; nrectangles + +)( void "XDrawRectangles")) + + + +(defentry XDrawSegments( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; segments + fixnum ;; nsegments + +)( void "XDrawSegments")) + + + +(defentry XDrawString( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + object ;; string + fixnum ;; length + +)( void "XDrawString")) + + + +(defentry XDrawString16( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; string + fixnum ;; length + +)( void "XDrawString16")) + + + +(defentry XDrawText( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; items + fixnum ;; nitems + +)( void "XDrawText")) + + + +(defentry XDrawText16( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; items + fixnum ;; nitems + +)( void "XDrawText16")) + + + +(defentry XEnableAccessControl( + + fixnum ;; display + +)( void "XEnableAccessControl")) + + + +(defentry XEventsQueued( + + fixnum ;; display + fixnum ;; mode + +)( fixnum "XEventsQueued")) + + + +(defentry XFetchName( + + fixnum ;; display + fixnum ;; w + fixnum ;; window_name_return + +)( fixnum "XFetchName")) + + + +(defentry XFillArc( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + fixnum ;; angle1 + fixnum ;; angle2 + +)( void "XFillArc")) + + + +(defentry XFillArcs( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; arcs + fixnum ;; narcs + +)( void "XFillArcs")) + + + +(defentry XFillPolygon( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; points + fixnum ;; npoints + fixnum ;; shape + fixnum ;; mode + +)( void "XFillPolygon")) + + + +(defentry XFillRectangle( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + +)( void "XFillRectangle")) + + + +(defentry XFillRectangles( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; rectangles + fixnum ;; nrectangles + +)( void "XFillRectangles")) + + + +(defentry XFlush( + + fixnum ;; display + +)( void "XFlush")) + + + +(defentry XForceScreenSaver( + + fixnum ;; display + fixnum ;; mode + +)( void "XForceScreenSaver")) + + + +(defentry XFree( + + object ;; data + +)( void "XFree")) + + + +(defentry XFreeColormap( + + fixnum ;; display + fixnum ;; colormap + +)( void "XFreeColormap")) + + + +(defentry XFreeColors( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; pixels + fixnum ;; npixels + fixnum ;; planes + +)( void "XFreeColors")) + + + +(defentry XFreeCursor( + + fixnum ;; display + fixnum ;; cursor + +)( void "XFreeCursor")) + + + +(defentry XFreeExtensionList( + + fixnum ;; list + +)( void "XFreeExtensionList")) + + + +(defentry XFreeFont( + + fixnum ;; display + fixnum ;; font_struct + +)( void "XFreeFont")) + + + +(defentry XFreeFontInfo( + + fixnum ;; names + fixnum ;; free_info + fixnum ;; actual_count + +)( void "XFreeFontInfo")) + + + +(defentry XFreeFontNames( + + fixnum ;; list + +)( void "XFreeFontNames")) + + + +(defentry XFreeFontPath( + + fixnum ;; list + +)( void "XFreeFontPath")) + + + +(defentry XFreeGC( + + fixnum ;; display + fixnum ;; gc + +)( void "XFreeGC")) + + + +(defentry XFreeModifiermap( + + fixnum ;; modmap + +)( void "XFreeModifiermap")) + + + +(defentry XFreePixmap( + + fixnum ;; display + fixnum ;; fixnum + +)( void "XFreePixmap")) + + + +(defentry XGeometry( + + fixnum ;; display + fixnum ;; screen + object ;; position + object ;; default_position + fixnum ;; bwidth + fixnum ;; fwidth + fixnum ;; fheight + fixnum ;; xadder + fixnum ;; yadder + fixnum ;; x_return + fixnum ;; y_return + fixnum ;; width_return + fixnum ;; height_return + +)( fixnum "XGeometry")) + + + +(defentry XGetErrorDatabaseText( + + fixnum ;; display + object ;; name + object ;; message + object ;; default_string + object ;; buffer_return + fixnum ;; length + +)( void "XGetErrorDatabaseText")) + + + +(defentry XGetErrorText( + + fixnum ;; display + fixnum ;; code + object ;; buffer_return + fixnum ;; length + +)( void "XGetErrorText")) + + + +(defentry XGetFontProperty( + + fixnum ;; font_struct + fixnum ;; atom + fixnum ;; value_return + +)( fixnum "XGetFontProperty")) + + + +(defentry XGetGCValues( + + fixnum ;; display + fixnum ;; gc + fixnum ;; valuemask + fixnum ;; values_return + +)( fixnum "XGetGCValues")) + + + +(defentry XGetGeometry( + + fixnum ;; display + fixnum ;; d + fixnum ;; root_return + fixnum ;; x_return + fixnum ;; y_return + fixnum ;; width_return + fixnum ;; height_return + fixnum ;; border_width_return + fixnum ;; depth_return + +)( fixnum "XGetGeometry")) + + + +(defentry XGetIconName( + + fixnum ;; display + fixnum ;; w + fixnum ;; icon_name_return + +)( fixnum "XGetIconName")) + + + +(defentry XGetInputFocus( + + fixnum ;; display + fixnum ;; focus_return + fixnum ;; revert_to_return + +)( void "XGetInputFocus")) + + + +(defentry XGetKeyboardControl( + + fixnum ;; display + fixnum ;; values_return + +)( void "XGetKeyboardControl")) + + + +(defentry XGetPointerControl( + + fixnum ;; display + fixnum ;; accel_numerator_return + fixnum ;; accel_denominator_return + fixnum ;; threshold_return + +)( void "XGetPointerControl")) + + + +(defentry XGetPointerMapping( + + fixnum ;; display + object ;; map_return + fixnum ;; nmap + +)( fixnum "XGetPointerMapping")) + + + +(defentry XGetScreenSaver( + + fixnum ;; display + fixnum ;; intout_return + fixnum ;; interval_return + fixnum ;; prefer_blanking_return + fixnum ;; allow_exposures_return + +)( void "XGetScreenSaver")) + + + +(defentry XGetTransientForHint( + + fixnum ;; display + fixnum ;; w + fixnum ;; prop_window_return + +)( fixnum "XGetTransientForHint")) + + + +(defentry XGetWindowProperty( + + fixnum ;; display + fixnum ;; w + fixnum ;; property + fixnum ;; int_offset + fixnum ;; int_length + fixnum ;; delete + fixnum ;; req_type + fixnum ;; actual_type_return + fixnum ;; actual_format_return + fixnum ;; nitems_return + fixnum ;; bytes_after_return + fixnum ;; prop_return + +)( fixnum "XGetWindowProperty")) + + + +(defentry XGetWindowAttributes( + + fixnum ;; display + fixnum ;; w + fixnum ;; Window_attributes_return + +)( fixnum "XGetWindowAttributes")) + + + +(defentry XGrabButton( + + fixnum ;; display + fixnum ;; button + fixnum ;; modifiers + fixnum ;; grab_window + fixnum ;; owner_events + fixnum ;; event_mask + fixnum ;; pointer_mode + fixnum ;; keyboard_mode + fixnum ;; confine_to + fixnum ;; cursor + +)( void "XGrabButton")) + + + +(defentry XGrabKey( + + fixnum ;; display + fixnum ;; keycode + fixnum ;; modifiers + fixnum ;; grab_window + fixnum ;; owner_events + fixnum ;; pointer_mode + fixnum ;; keyboard_mode + +)( void "XGrabKey")) + + + +(defentry XGrabKeyboard( + + fixnum ;; display + fixnum ;; grab_window + fixnum ;; owner_events + fixnum ;; pointer_mode + fixnum ;; keyboard_mode + fixnum ;; fixnum + +)( fixnum "XGrabKeyboard")) + + + +(defentry XGrabPointer( + + fixnum ;; display + fixnum ;; grab_window + fixnum ;; owner_events + fixnum ;; event_mask + fixnum ;; pointer_mode + fixnum ;; keyboard_mode + fixnum ;; confine_to + fixnum ;; cursor + fixnum ;; fixnum + +)( fixnum "XGrabPointer")) + + + +(defentry XGrabServer( + + fixnum ;; display + +)( void "XGrabServer")) + + + +(defentry XHeightMMOfScreen( + + fixnum ;; screen + +)( fixnum "XHeightMMOfScreen")) + + + +(defentry XHeightOfScreen( + + fixnum ;; screen + +)( fixnum "XHeightOfScreen")) + + + +(defentry XImageByteOrder( + + fixnum ;; display + +)( fixnum "XImageByteOrder")) + + + +(defentry XInstallColormap( + + fixnum ;; display + fixnum ;; colormap + +)( void "XInstallColormap")) + + + +(defentry XKeysymToKeycode( + + fixnum ;; display + fixnum ;; keysym + +)( fixnum "XKeysymToKeycode")) + + + +(defentry XKillClient( + + fixnum ;; display + fixnum ;; resource + +)( void "XKillClient")) + + + +(defentry XLookupColor( + + fixnum ;; display + fixnum ;; colormap + object ;; color_name + fixnum ;; exact_def_return + fixnum ;; screen_def_return + +)( fixnum "XLookupColor")) + + + +(defentry XLowerWindow( + + fixnum ;; display + fixnum ;; w + +)( void "XLowerWindow")) + + + +(defentry XMapRaised( + + fixnum ;; display + fixnum ;; w + +)( void "XMapRaised")) + + + +(defentry XMapSubwindows( + + fixnum ;; display + fixnum ;; w + +)( void "XMapSubwindows")) + + + +(defentry XMapWindow( + + fixnum ;; display + fixnum ;; w + +)( void "XMapWindow")) + + + +(defentry XMaskEvent( + + fixnum ;; display + fixnum ;; event_mask + fixnum ;; event_return + +)( void "XMaskEvent")) + + + +(defentry XMaxCmapsOfScreen( + + fixnum ;; screen + +)( fixnum "XMaxCmapsOfScreen")) + + + +(defentry XMinCmapsOfScreen( + + fixnum ;; screen + +)( fixnum "XMinCmapsOfScreen")) + + + +(defentry XMoveResizeWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + +)( void "XMoveResizeWindow")) + + + +(defentry XMoveWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; x + fixnum ;; y + +)( void "XMoveWindow")) + + + +(defentry XNextEvent( + + fixnum ;; display + fixnum ;; event_return + +)( void "XNextEvent")) + + + +(defentry XNoOp( + + fixnum ;; display + +)( void "XNoOp")) + + + +(defentry XParseColor( + + fixnum ;; display + fixnum ;; colormap + object ;; spec + fixnum ;; exact_def_return + +)( fixnum "XParseColor")) + + + +(defentry XParseGeometry( + + object ;; parsestring + fixnum ;; x_return + fixnum ;; y_return + fixnum ;; width_return + fixnum ;; height_return + +)( fixnum "XParseGeometry")) + + + +(defentry XPeekEvent( + + fixnum ;; display + fixnum ;; event_return + +)( void "XPeekEvent")) + + + + +(defentry XPending( + + fixnum ;; display + +)( fixnum "XPending")) + + + +(defentry XPlanesOfScreen( + + fixnum ;; screen + + +)( fixnum "XPlanesOfScreen")) + + + +(defentry XProtocolRevision( + + fixnum ;; display + +)( fixnum "XProtocolRevision")) + + + +(defentry XProtocolVersion( + + fixnum ;; display + +)( fixnum "XProtocolVersion")) + + + + +(defentry XPutBackEvent( + + fixnum ;; display + fixnum ;; event + +)( void "XPutBackEvent")) + + + +(defentry XPutImage( + + fixnum ;; display + fixnum ;; d + fixnum ;; gc + fixnum ;; image + fixnum ;; src_x + fixnum ;; src_y + fixnum ;; dest_x + fixnum ;; dest_y + fixnum ;; width + fixnum ;; height + +)( void "XPutImage")) + + + +(defentry XQLength( + + fixnum ;; display + +)( fixnum "XQLength")) + + + +(defentry XQueryBestCursor( + + fixnum ;; display + fixnum ;; d + fixnum ;; width + fixnum ;; height + fixnum ;; width_return + fixnum ;; height_return + +)( fixnum "XQueryBestCursor")) + + + +(defentry XQueryBestSize( + + fixnum ;; display + fixnum ;; class + fixnum ;; which_screen + fixnum ;; width + fixnum ;; height + fixnum ;; width_return + fixnum ;; height_return + +)( fixnum "XQueryBestSize")) + + + +(defentry XQueryBestStipple( + + fixnum ;; display + fixnum ;; which_screen + fixnum ;; width + fixnum ;; height + fixnum ;; width_return + fixnum ;; height_return + +)( fixnum "XQueryBestStipple")) + + + +(defentry XQueryBestTile( + + fixnum ;; display + fixnum ;; which_screen + fixnum ;; width + fixnum ;; height + fixnum ;; width_return + fixnum ;; height_return + +)( fixnum "XQueryBestTile")) + + + +(defentry XQueryColor( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; def_in_out + +)( void "XQueryColor")) + + + +(defentry XQueryColors( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; defs_in_out + fixnum ;; ncolors + +)( void "XQueryColors")) + + + +(defentry XQueryExtension( + + fixnum ;; display + object ;; name + fixnum ;; major_opcode_return + fixnum ;; first_event_return + fixnum ;; first_error_return + +)( fixnum "XQueryExtension")) + + +;;fix +(defentry XQueryKeymap( + + fixnum ;; display + fixnum ;; keys_return + +)( void "XQueryKeymap")) + + + +(defentry XQueryPointer( + + fixnum ;; display + fixnum ;; w + fixnum ;; root_return + fixnum ;; child_return + fixnum ;; root_x_return + fixnum ;; root_y_return + fixnum ;; win_x_return + fixnum ;; win_y_return + fixnum ;; mask_return + +)( fixnum "XQueryPointer")) + + + +(defentry XQueryTextExtents( + + fixnum ;; display + fixnum ;; font_ID + object ;; string + fixnum ;; nchars + fixnum ;; direction_return + fixnum ;; font_ascent_return + fixnum ;; font_descent_return + fixnum ;; overall_return + +)( void "XQueryTextExtents")) + + + +(defentry XQueryTextExtents16( + + fixnum ;; display + fixnum ;; font_ID + fixnum ;; string + fixnum ;; nchars + fixnum ;; direction_return + fixnum ;; font_ascent_return + fixnum ;; font_descent_return + fixnum ;; overall_return + +)( void "XQueryTextExtents16")) + + + +(defentry XQueryTree( + + fixnum ;; display + fixnum ;; w + fixnum ;; root_return + fixnum ;; parent_return + fixnum ;; children_return + fixnum ;; nchildren_return + +)( fixnum "XQueryTree")) + + + +(defentry XRaiseWindow( + + fixnum ;; display + fixnum ;; w + +)( void "XRaiseWindow")) + + + +(defentry XReadBitmapFile( + + fixnum ;; display + fixnum ;; d + object ;; filename + fixnum ;; width_return + fixnum ;; height_return + fixnum ;; bitmap_return + fixnum ;; x_hot_return + fixnum ;; y_hot_return + +)( fixnum "XReadBitmapFile")) + + + +(defentry XRebindKeysym( + + fixnum ;; display + fixnum ;; keysym + fixnum ;; list + fixnum ;; mod_count + object ;; string + fixnum ;; bytes_string + +)( void "XRebindKeysym")) + + + +(defentry XRecolorCursor( + + fixnum ;; display + fixnum ;; cursor + fixnum ;; foreground_color + fixnum ;; background_color + +)( void "XRecolorCursor")) + + + +(defentry XRefreshKeyboardMapping( + + fixnum ;; event_map + +)( void "XRefreshKeyboardMapping")) + + + +(defentry XRemoveFromSaveSet( + + fixnum ;; display + fixnum ;; w + +)( void "XRemoveFromSaveSet")) + + + +(defentry XRemoveHost( + + fixnum ;; display + fixnum ;; host + +)( void "XRemoveHost")) + + + +(defentry XRemoveHosts( + + fixnum ;; display + fixnum ;; hosts + fixnum ;; num_hosts + +)( void "XRemoveHosts")) + + + +(defentry XReparentWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; parent + fixnum ;; x + fixnum ;; y + +)( void "XReparentWindow")) + + + +(defentry XResetScreenSaver( + + fixnum ;; display + +)( void "XResetScreenSaver")) + + + +(defentry XResizeWindow( + + fixnum ;; display + fixnum ;; w + fixnum ;; width + fixnum ;; height + +)( void "XResizeWindow")) + + + +(defentry XRestackWindows( + + fixnum ;; display + fixnum ;; windows + fixnum ;; nwindows + +)( void "XRestackWindows")) + + + +(defentry XRotateBuffers( + + fixnum ;; display + fixnum ;; rotate + +)( void "XRotateBuffers")) + + + +(defentry XRotateWindowProperties( + + fixnum ;; display + fixnum ;; w + fixnum ;; properties + fixnum ;; num_prop + fixnum ;; npositions + +)( void "XRotateWindowProperties")) + + + +(defentry XScreenCount( + + fixnum ;; display + +)( fixnum "XScreenCount")) + + + +(defentry XSelectInput( + + fixnum ;; display + fixnum ;; w + fixnum ;; event_mask + +)( void "XSelectInput")) + + + +(defentry XSendEvent( + + fixnum ;; display + fixnum ;; w + fixnum ;; propagate + fixnum ;; event_mask + fixnum ;; event_send + +)( fixnum "XSendEvent")) + + + +(defentry XSetAccessControl( + + fixnum ;; display + fixnum ;; mode + +)( void "XSetAccessControl")) + + + +(defentry XSetArcMode( + + fixnum ;; display + fixnum ;; gc + fixnum ;; arc_mode + +)( void "XSetArcMode")) + + + +(defentry XSetBackground( + + fixnum ;; display + fixnum ;; gc + fixnum ;; background + +)( void "XSetBackground")) + + + +(defentry XSetClipMask( + + fixnum ;; display + fixnum ;; gc + fixnum ;; fixnum + +)( void "XSetClipMask")) + + + +(defentry XSetClipOrigin( + + fixnum ;; display + fixnum ;; gc + fixnum ;; clip_x_origin + fixnum ;; clip_y_origin + +)( void "XSetClipOrigin")) + + + +(defentry XSetClipRectangles( + + fixnum ;; display + fixnum ;; gc + fixnum ;; clip_x_origin + fixnum ;; clip_y_origin + fixnum ;; rectangles + fixnum ;; n + fixnum ;; ordering + +)( void "XSetClipRectangles")) + + + +(defentry XSetCloseDownMode( + + fixnum ;; display + fixnum ;; close_mode + +)( void "XSetCloseDownMode")) + + + +(defentry XSetCommand( + + fixnum ;; display + fixnum ;; w + fixnum ;; argv + fixnum ;; argc + +)( void "XSetCommand")) + + + +(defentry XSetDashes( + + fixnum ;; display + fixnum ;; gc + fixnum ;; dash_offset + object ;; dash_list + fixnum ;; n + +)( void "XSetDashes")) + + + +(defentry XSetFillRule( + + fixnum ;; display + fixnum ;; gc + fixnum ;; fill_rule + +)( void "XSetFillRule")) + + + +(defentry XSetFillStyle( + + fixnum ;; display + fixnum ;; gc + fixnum ;; fill_style + +)( void "XSetFillStyle")) + + + +(defentry XSetFont( + + fixnum ;; display + fixnum ;; gc + fixnum ;; font + +)( void "XSetFont")) + + + +(defentry XSetFontPath( + + fixnum ;; display + fixnum ;; directories + fixnum ;; ndirs + +)( void "XSetFontPath")) + + + +(defentry XSetForeground( + + fixnum ;; display + fixnum ;; gc + fixnum ;; foreground + +)( void "XSetForeground")) + + + +(defentry XSetFunction( + + fixnum ;; display + fixnum ;; gc + fixnum ;; function + +)( void "XSetFunction")) + + + +(defentry XSetGraphicsExposures( + + fixnum ;; display + fixnum ;; gc + fixnum ;; graphics_exposures + +)( void "XSetGraphicsExposures")) + + + +(defentry XSetIconName( + + fixnum ;; display + fixnum ;; w + object ;; icon_name + +)( void "XSetIconName")) + + + +(defentry XSetInputFocus( + + fixnum ;; display + fixnum ;; focus + fixnum ;; revert_to + fixnum ;; fixnum + +)( void "XSetInputFocus")) + + + +(defentry XSetLineAttributes( + + fixnum ;; display + fixnum ;; gc + fixnum ;; line_width + fixnum ;; line_style + fixnum ;; cap_style + fixnum ;; join_style + +)( void "XSetLineAttributes")) + + + +(defentry XSetModifierMapping( + + fixnum ;; display + fixnum ;; modmap + +)( fixnum "XSetModifierMapping")) + + + +(defentry XSetPlaneMask( + + fixnum ;; display + fixnum ;; gc + fixnum ;; plane_mask + +)( void "XSetPlaneMask")) + + + +(defentry XSetPointerMapping( + + fixnum ;; display + object ;; map + fixnum ;; nmap + +)( fixnum "XSetPointerMapping")) + + + +(defentry XSetScreenSaver( + + fixnum ;; display + fixnum ;; intout + fixnum ;; interval + fixnum ;; prefer_blanking + fixnum ;; allow_exposures + +)( void "XSetScreenSaver")) + + + +(defentry XSetSelectionOwner( + + fixnum ;; display + fixnum ;; selection + fixnum ;; owner + fixnum ;; fixnum + +)( void "XSetSelectionOwner")) + + + +(defentry XSetState( + + fixnum ;; display + fixnum ;; gc + fixnum ;; foreground + fixnum ;; background + fixnum ;; function + fixnum ;; plane_mask + +)( void "XSetState")) + + + +(defentry XSetStipple( + + fixnum ;; display + fixnum ;; gc + fixnum ;; stipple + +)( void "XSetStipple")) + + + +(defentry XSetSubwindowMode( + + fixnum ;; display + fixnum ;; gc + fixnum ;; subwindow_mode + +)( void "XSetSubwindowMode")) + + + +(defentry XSetTSOrigin( + + fixnum ;; display + fixnum ;; gc + fixnum ;; ts_x_origin + fixnum ;; ts_y_origin + +)( void "XSetTSOrigin")) + + + +(defentry XSetTile( + + fixnum ;; display + fixnum ;; gc + fixnum ;; tile + +)( void "XSetTile")) + + + +(defentry XSetWindowBackground( + + fixnum ;; display + fixnum ;; w + fixnum ;; background_pixel + +)( void "XSetWindowBackground")) + + + +(defentry XSetWindowBackgroundPixmap( + + fixnum ;; display + fixnum ;; w + fixnum ;; background_pixmap + +)( void "XSetWindowBackgroundPixmap")) + + + +(defentry XSetWindowBorder( + + fixnum ;; display + fixnum ;; w + fixnum ;; border_pixel + +)( void "XSetWindowBorder")) + + + +(defentry XSetWindowBorderPixmap( + + fixnum ;; display + fixnum ;; w + fixnum ;; border_pixmap + +)( void "XSetWindowBorderPixmap")) + + + +(defentry XSetWindowBorderWidth( + + fixnum ;; display + fixnum ;; w + fixnum ;; width + +)( void "XSetWindowBorderWidth")) + + + +(defentry XSetWindowColormap( + + fixnum ;; display + fixnum ;; w + fixnum ;; colormap + +)( void "XSetWindowColormap")) + + + +(defentry XStoreBuffer( + + fixnum ;; display + object ;; bytes + fixnum ;; nbytes + fixnum ;; buffer + +)( void "XStoreBuffer")) + + + +(defentry XStoreBytes( + + fixnum ;; display + object ;; bytes + fixnum ;; nbytes + +)( void "XStoreBytes")) + + + +(defentry XStoreColor( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; color + +)( void "XStoreColor")) + + + +(defentry XStoreColors( + + fixnum ;; display + fixnum ;; colormap + fixnum ;; color + fixnum ;; ncolors + +)( void "XStoreColors")) + + + +(defentry XStoreName( + + fixnum ;; display + fixnum ;; w + object ;; window_name + +)( void "XStoreName")) + + + +(defentry XStoreNamedColor( + + fixnum ;; display + fixnum ;; colormap + object ;; color + fixnum ;; pixel + fixnum ;; flags + +)( void "XStoreNamedColor")) + + + +(defentry XSync( + + fixnum ;; display + fixnum ;; discard + +)( void "XSync")) + + + +(defentry XTextExtents( + + fixnum ;; font_struct + object ;; string + fixnum ;; nchars + fixnum ;; direction_return + fixnum ;; font_ascent_return + fixnum ;; font_descent_return + fixnum ;; overall_return + +)( void "XTextExtents")) + + + +(defentry XTextExtents16( + + fixnum ;; font_struct + fixnum ;; string + fixnum ;; nchars + fixnum ;; direction_return + fixnum ;; font_ascent_return + fixnum ;; font_descent_return + fixnum ;; overall_return + +)( void "XTextExtents16")) + + + +(defentry XTextWidth( + + fixnum ;; font_struct + object ;; string + fixnum ;; count + +)( fixnum "XTextWidth")) + + + +(defentry XTextWidth16( + + fixnum ;; font_struct + fixnum ;; string + fixnum ;; count + +)( fixnum "XTextWidth16")) + + + +(defentry XTranslateCoordinates( + + fixnum ;; display + fixnum ;; src_w + fixnum ;; dest_w + fixnum ;; src_x + fixnum ;; src_y + fixnum ;; dest_x_return + fixnum ;; dest_y_return + fixnum ;; child_return + +)( fixnum "XTranslateCoordinates")) + + + +(defentry XUndefineCursor( + + fixnum ;; display + fixnum ;; w + +)( void "XUndefineCursor")) + + + +(defentry XUngrabButton( + + fixnum ;; display + fixnum ;; button + fixnum ;; modifiers + fixnum ;; grab_window + +)( void "XUngrabButton")) + + + +(defentry XUngrabKey( + + fixnum ;; display + fixnum ;; keycode + fixnum ;; modifiers + fixnum ;; grab_window + +)( void "XUngrabKey")) + + + +(defentry XUngrabKeyboard( + + fixnum ;; display + fixnum ;; fixnum + +)( void "XUngrabKeyboard")) + + + +(defentry XUngrabPointer( + + fixnum ;; display + fixnum ;; fixnum + +)( void "XUngrabPointer")) + + + +(defentry XUngrabServer( + + fixnum ;; display + +)( void "XUngrabServer")) + + + +(defentry XUninstallColormap( + + fixnum ;; display + fixnum ;; colormap + +)( void "XUninstallColormap")) + + + +(defentry XUnloadFont( + + fixnum ;; display + fixnum ;; font + +)( void "XUnloadFont")) + + + +(defentry XUnmapSubwindows( + + fixnum ;; display + fixnum ;; w + +)( void "XUnmapSubwindows")) + + + +(defentry XUnmapWindow( + + fixnum ;; display + fixnum ;; w + +)( void "XUnmapWindow")) + + + +(defentry XVendorRelease( + + fixnum ;; display + +)( fixnum "XVendorRelease")) + + + +(defentry XWarpPointer( + + fixnum ;; display + fixnum ;; src_w + fixnum ;; dest_w + fixnum ;; src_x + fixnum ;; src_y + fixnum ;; src_width + fixnum ;; src_height + fixnum ;; dest_x + fixnum ;; dest_y + +)( void "XWarpPointer")) + + + +(defentry XWidthMMOfScreen( + + fixnum ;; screen + +)( fixnum "XWidthMMOfScreen")) + + + +(defentry XWidthOfScreen( + + fixnum ;; screen + +)( fixnum "XWidthOfScreen")) + + + +(defentry XWindowEvent( + + fixnum ;; display + fixnum ;; w + fixnum ;; event_mask + fixnum ;; event_return + +)( void "XWindowEvent")) + + + +(defentry XWriteBitmapFile( + + fixnum ;; display + object ;; filename + fixnum ;; bitmap + fixnum ;; width + fixnum ;; height + fixnum ;; x_hot + fixnum ;; y_hot + +)( fixnum "XWriteBitmapFile")) + + + +;;;;;;;;;problems + + + + +;;(defentry fixnum (int Synchronize( + +;; fixnum ;; display +;; fixnum ;; onoff + +;;))()()) +;;(defentry fixnum (int SetAfterFunction( + +;; fixnum ;; display +;; fixnum (int ( fixnum ;; display +;; ) ;; procedure + +;;))()()) + + +;;(defentry void XPeekIfEvent( + +;; fixnum ;; display +;; fixnum ;; event_return +;; fixnum (int ( fixnum ;; display +;; fixnum ;; event +;; object ;; arg +;; ) ;; predicate +;; object ;; arg + +;;)()) + +;;(defentry fixnum XCheckIfEvent( + +;; fixnum ;; display +;; fixnum ;; event_return +;; fixnum (int ( fixnum ;; display +;; fixnum ;; event +;; object ;; arg +;; ) ;; predicate +;; object ;; arg + +;;)()) + +;;(defentry void XIfEvent( + +;; fixnum ;; display +;; fixnum ;; event_return +;; fixnum (int ( fixnum ;; display +;; fixnum ;; event +;; object ;; arg +;; ) ;; predicate +;; object ;; arg + +;;)()) diff --git a/xgcl-2/gcl_Xstruct.lsp b/xgcl-2/gcl_Xstruct.lsp new file mode 100644 index 0000000..9ee3cc4 --- /dev/null +++ b/xgcl-2/gcl_Xstruct.lsp @@ -0,0 +1,311 @@ +(in-package :XLIB) +; Xstruct.lsp Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + + + + +;;;;;; _XQEvent functions ;;;;;; + +(defentry make-_XQEvent () ( fixnum "make__XQEvent" )) +(defentry _XQEvent-event (fixnum) ( fixnum "_XQEvent_event" )) +(defentry set-_XQEvent-event (fixnum fixnum) ( void "set__XQEvent_event" )) +(defentry _XQEvent-next (fixnum) ( fixnum "_XQEvent_next" )) +(defentry set-_XQEvent-next (fixnum fixnum) ( void "set__XQEvent_next" )) + + +;;;;;; XCharStruct functions ;;;;;; + +(defentry make-XCharStruct () ( fixnum "make_XCharStruct" )) +(defentry XCharStruct-attributes (fixnum) ( fixnum "XCharStruct_attributes" )) +(defentry set-XCharStruct-attributes (fixnum fixnum) ( void "set_XCharStruct_attributes" )) +(defentry XCharStruct-descent (fixnum) ( fixnum "XCharStruct_descent" )) +(defentry set-XCharStruct-descent (fixnum fixnum) ( void "set_XCharStruct_descent" )) +(defentry XCharStruct-ascent (fixnum) ( fixnum "XCharStruct_ascent" )) +(defentry set-XCharStruct-ascent (fixnum fixnum) ( void "set_XCharStruct_ascent" )) +(defentry XCharStruct-width (fixnum) ( fixnum "XCharStruct_width" )) +(defentry set-XCharStruct-width (fixnum fixnum) ( void "set_XCharStruct_width" )) +(defentry XCharStruct-rbearing (fixnum) ( fixnum "XCharStruct_rbearing" )) +(defentry set-XCharStruct-rbearing (fixnum fixnum) ( void "set_XCharStruct_rbearing" )) +(defentry XCharStruct-lbearing (fixnum) ( fixnum "XCharStruct_lbearing" )) +(defentry set-XCharStruct-lbearing (fixnum fixnum) ( void "set_XCharStruct_lbearing" )) + + +;;;;;; XFontProp functions ;;;;;; + +(defentry make-XFontProp () ( fixnum "make_XFontProp" )) +(defentry XFontProp-card32 (fixnum) ( fixnum "XFontProp_card32" )) +(defentry set-XFontProp-card32 (fixnum fixnum) ( void "set_XFontProp_card32" )) +(defentry XFontProp-name (fixnum) ( fixnum "XFontProp_name" )) +(defentry set-XFontProp-name (fixnum fixnum) ( void "set_XFontProp_name" )) + + +;;;;;; XFontStruct functions ;;;;;; + +(defentry make-XFontStruct () ( fixnum "make_XFontStruct" )) +(defentry XFontStruct-descent (fixnum) ( fixnum "XFontStruct_descent" )) +(defentry set-XFontStruct-descent (fixnum fixnum) ( void "set_XFontStruct_descent" )) +(defentry XFontStruct-ascent (fixnum) ( fixnum "XFontStruct_ascent" )) +(defentry set-XFontStruct-ascent (fixnum fixnum) ( void "set_XFontStruct_ascent" )) +(defentry XFontStruct-per_char (fixnum) ( fixnum "XFontStruct_per_char" )) +(defentry set-XFontStruct-per_char (fixnum fixnum) ( void "set_XFontStruct_per_char" )) +(defentry XFontStruct-max_bounds (fixnum) ( fixnum "XFontStruct_max_bounds" )) +(defentry set-XFontStruct-max_bounds (fixnum fixnum) ( void "set_XFontStruct_max_bounds" )) +(defentry XFontStruct-min_bounds (fixnum) ( fixnum "XFontStruct_min_bounds" )) +(defentry set-XFontStruct-min_bounds (fixnum fixnum) ( void "set_XFontStruct_min_bounds" )) +(defentry XFontStruct-properties (fixnum) ( fixnum "XFontStruct_properties" )) +(defentry set-XFontStruct-properties (fixnum fixnum) ( void "set_XFontStruct_properties" )) +(defentry XFontStruct-n_properties (fixnum) ( fixnum "XFontStruct_n_properties" )) +(defentry set-XFontStruct-n_properties (fixnum fixnum) ( void "set_XFontStruct_n_properties" )) +(defentry XFontStruct-default_char (fixnum) ( fixnum "XFontStruct_default_char" )) +(defentry set-XFontStruct-default_char (fixnum fixnum) ( void "set_XFontStruct_default_char" )) +(defentry XFontStruct-all_chars_exist (fixnum) ( fixnum "XFontStruct_all_chars_exist" )) +(defentry set-XFontStruct-all_chars_exist (fixnum fixnum) ( void "set_XFontStruct_all_chars_exist" )) +(defentry XFontStruct-max_byte1 (fixnum) ( fixnum "XFontStruct_max_byte1" )) +(defentry set-XFontStruct-max_byte1 (fixnum fixnum) ( void "set_XFontStruct_max_byte1" )) +(defentry XFontStruct-min_byte1 (fixnum) ( fixnum "XFontStruct_min_byte1" )) +(defentry set-XFontStruct-min_byte1 (fixnum fixnum) ( void "set_XFontStruct_min_byte1" )) +(defentry XFontStruct-max_char_or_byte2 (fixnum) ( fixnum "XFontStruct_max_char_or_byte2" )) +(defentry set-XFontStruct-max_char_or_byte2 (fixnum fixnum) ( void "set_XFontStruct_max_char_or_byte2" )) +(defentry XFontStruct-min_char_or_byte2 (fixnum) ( fixnum "XFontStruct_min_char_or_byte2" )) +(defentry set-XFontStruct-min_char_or_byte2 (fixnum fixnum) ( void "set_XFontStruct_min_char_or_byte2" )) +(defentry XFontStruct-direction (fixnum) ( fixnum "XFontStruct_direction" )) +(defentry set-XFontStruct-direction (fixnum fixnum) ( void "set_XFontStruct_direction" )) +(defentry XFontStruct-fid (fixnum) ( fixnum "XFontStruct_fid" )) +(defentry set-XFontStruct-fid (fixnum fixnum) ( void "set_XFontStruct_fid" )) +(defentry XFontStruct-ext_data (fixnum) ( fixnum "XFontStruct_ext_data" )) +(defentry set-XFontStruct-ext_data (fixnum fixnum) ( void "set_XFontStruct_ext_data" )) + + +;;;;;; XTextItem functions ;;;;;; + +(defentry make-XTextItem () ( fixnum "make_XTextItem" )) +(defentry XTextItem-font (fixnum) ( fixnum "XTextItem_font" )) +(defentry set-XTextItem-font (fixnum fixnum) ( void "set_XTextItem_font" )) +(defentry XTextItem-delta (fixnum) ( fixnum "XTextItem_delta" )) +(defentry set-XTextItem-delta (fixnum fixnum) ( void "set_XTextItem_delta" )) +(defentry XTextItem-nchars (fixnum) ( fixnum "XTextItem_nchars" )) +(defentry set-XTextItem-nchars (fixnum fixnum) ( void "set_XTextItem_nchars" )) +(defentry XTextItem-chars (fixnum) ( fixnum "XTextItem_chars" )) +(defentry set-XTextItem-chars (fixnum fixnum) ( void "set_XTextItem_chars" )) + + +;;;;;; XChar2b functions ;;;;;; + +(defentry make-XChar2b () ( fixnum "make_XChar2b" )) +(defentry XChar2b-byte2 (fixnum) ( char "XChar2b_byte2" )) +(defentry set-XChar2b-byte2 (fixnum char) ( void "set_XChar2b_byte2" )) +(defentry XChar2b-byte1 (fixnum) ( char "XChar2b_byte1" )) +(defentry set-XChar2b-byte1 (fixnum char) ( void "set_XChar2b_byte1" )) + + +;;;;;; XTextItem16 functions ;;;;;; + +(defentry make-XTextItem16 () ( fixnum "make_XTextItem16" )) +(defentry XTextItem16-font (fixnum) ( fixnum "XTextItem16_font" )) +(defentry set-XTextItem16-font (fixnum fixnum) ( void "set_XTextItem16_font" )) +(defentry XTextItem16-delta (fixnum) ( fixnum "XTextItem16_delta" )) +(defentry set-XTextItem16-delta (fixnum fixnum) ( void "set_XTextItem16_delta" )) +(defentry XTextItem16-nchars (fixnum) ( fixnum "XTextItem16_nchars" )) +(defentry set-XTextItem16-nchars (fixnum fixnum) ( void "set_XTextItem16_nchars" )) +(defentry XTextItem16-chars (fixnum) ( fixnum "XTextItem16_chars" )) +(defentry set-XTextItem16-chars (fixnum fixnum) ( void "set_XTextItem16_chars" )) + + +;;;;;; XEDataObject functions ;;;;;; + +(defentry make-XEDataObject () ( fixnum "make_XEDataObject" )) +(defentry XEDataObject-font (fixnum) ( fixnum "XEDataObject_font" )) +(defentry set-XEDataObject-font (fixnum fixnum) ( void "set_XEDataObject_font" )) +(defentry XEDataObject-pixmap_format (fixnum) ( fixnum "XEDataObject_pixmap_format" )) +(defentry set-XEDataObject-pixmap_format (fixnum fixnum) ( void "set_XEDataObject_pixmap_format" )) +(defentry XEDataObject-screen (fixnum) ( fixnum "XEDataObject_screen" )) +(defentry set-XEDataObject-screen (fixnum fixnum) ( void "set_XEDataObject_screen" )) +(defentry XEDataObject-visual (fixnum) ( fixnum "XEDataObject_visual" )) +(defentry set-XEDataObject-visual (fixnum fixnum) ( void "set_XEDataObject_visual" )) +(defentry XEDataObject-gc (fixnum) ( fixnum "XEDataObject_gc" )) +(defentry set-XEDataObject-gc (fixnum fixnum) ( void "set_XEDataObject_gc" )) + + +;;;;;; XSizeHints functions ;;;;;; + +(defentry make-XSizeHints () ( fixnum "make_XSizeHints" )) +(defentry XSizeHints-win_gravity (fixnum) ( fixnum "XSizeHints_win_gravity" )) +(defentry set-XSizeHints-win_gravity (fixnum fixnum) ( void "set_XSizeHints_win_gravity" )) +(defentry XSizeHints-base_height (fixnum) ( fixnum "XSizeHints_base_height" )) +(defentry set-XSizeHints-base_height (fixnum fixnum) ( void "set_XSizeHints_base_height" )) +(defentry XSizeHints-base_width (fixnum) ( fixnum "XSizeHints_base_width" )) +(defentry set-XSizeHints-base_width (fixnum fixnum) ( void "set_XSizeHints_base_width" )) + +(defentry XSizeHints-max_aspect_x (fixnum) ( fixnum "XSizeHints_max_aspect_x" )) +(defentry set-XSizeHints-max_aspect_x (fixnum fixnum) ( void "set_XSizeHints_max_aspect_x" )) +(defentry XSizeHints-max_aspect_y (fixnum) ( fixnum "XSizeHints_max_aspect_y" )) +(defentry set-XSizeHints-max_aspect_y (fixnum fixnum) ( void "set_XSizeHints_max_aspect_y" )) +(defentry XSizeHints-min_aspect_x (fixnum) ( fixnum "XSizeHints_min_aspect_x" )) +(defentry set-XSizeHints-min_aspect_x (fixnum fixnum) ( void "set_XSizeHints_min_aspect_x" )) +(defentry XSizeHints-min_aspect_y (fixnum) ( fixnum "XSizeHints_min_aspect_y" )) +(defentry set-XSizeHints-min_aspect_y (fixnum fixnum) ( void "set_XSizeHints_min_aspect_y" )) + +(defentry XSizeHints-height_inc (fixnum) ( fixnum "XSizeHints_height_inc" )) +(defentry set-XSizeHints-height_inc (fixnum fixnum) ( void "set_XSizeHints_height_inc" )) +(defentry XSizeHints-width_inc (fixnum) ( fixnum "XSizeHints_width_inc" )) +(defentry set-XSizeHints-width_inc (fixnum fixnum) ( void "set_XSizeHints_width_inc" )) +(defentry XSizeHints-max_height (fixnum) ( fixnum "XSizeHints_max_height" )) +(defentry set-XSizeHints-max_height (fixnum fixnum) ( void "set_XSizeHints_max_height" )) +(defentry XSizeHints-max_width (fixnum) ( fixnum "XSizeHints_max_width" )) +(defentry set-XSizeHints-max_width (fixnum fixnum) ( void "set_XSizeHints_max_width" )) +(defentry XSizeHints-min_height (fixnum) ( fixnum "XSizeHints_min_height" )) +(defentry set-XSizeHints-min_height (fixnum fixnum) ( void "set_XSizeHints_min_height" )) +(defentry XSizeHints-min_width (fixnum) ( fixnum "XSizeHints_min_width" )) +(defentry set-XSizeHints-min_width (fixnum fixnum) ( void "set_XSizeHints_min_width" )) +(defentry XSizeHints-height (fixnum) ( fixnum "XSizeHints_height" )) +(defentry set-XSizeHints-height (fixnum fixnum) ( void "set_XSizeHints_height" )) +(defentry XSizeHints-width (fixnum) ( fixnum "XSizeHints_width" )) +(defentry set-XSizeHints-width (fixnum fixnum) ( void "set_XSizeHints_width" )) +(defentry XSizeHints-y (fixnum) ( fixnum "XSizeHints_y" )) +(defentry set-XSizeHints-y (fixnum fixnum) ( void "set_XSizeHints_y" )) +(defentry XSizeHints-x (fixnum) ( fixnum "XSizeHints_x" )) +(defentry set-XSizeHints-x (fixnum fixnum) ( void "set_XSizeHints_x" )) +(defentry XSizeHints-flags (fixnum) ( fixnum "XSizeHints_flags" )) +(defentry set-XSizeHints-flags (fixnum fixnum) ( void "set_XSizeHints_flags" )) + + +;;;;;; XWMHints functions ;;;;;; + +(defentry make-XWMHints () ( fixnum "make_XWMHints" )) +(defentry XWMHints-window_group (fixnum) ( fixnum "XWMHints_window_group" )) +(defentry set-XWMHints-window_group (fixnum fixnum) ( void "set_XWMHints_window_group" )) +(defentry XWMHints-icon_mask (fixnum) ( fixnum "XWMHints_icon_mask" )) +(defentry set-XWMHints-icon_mask (fixnum fixnum) ( void "set_XWMHints_icon_mask" )) +(defentry XWMHints-icon_y (fixnum) ( fixnum "XWMHints_icon_y" )) +(defentry set-XWMHints-icon_y (fixnum fixnum) ( void "set_XWMHints_icon_y" )) +(defentry XWMHints-icon_x (fixnum) ( fixnum "XWMHints_icon_x" )) +(defentry set-XWMHints-icon_x (fixnum fixnum) ( void "set_XWMHints_icon_x" )) +(defentry XWMHints-icon_window (fixnum) ( fixnum "XWMHints_icon_window" )) +(defentry set-XWMHints-icon_window (fixnum fixnum) ( void "set_XWMHints_icon_window" )) +(defentry XWMHints-icon_pixmap (fixnum) ( fixnum "XWMHints_icon_pixmap" )) +(defentry set-XWMHints-icon_pixmap (fixnum fixnum) ( void "set_XWMHints_icon_pixmap" )) +(defentry XWMHints-initial_state (fixnum) ( fixnum "XWMHints_initial_state" )) +(defentry set-XWMHints-initial_state (fixnum fixnum) ( void "set_XWMHints_initial_state" )) +(defentry XWMHints-input (fixnum) ( fixnum "XWMHints_input" )) +(defentry set-XWMHints-input (fixnum fixnum) ( void "set_XWMHints_input" )) +(defentry XWMHints-flags (fixnum) ( fixnum "XWMHints_flags" )) +(defentry set-XWMHints-flags (fixnum fixnum) ( void "set_XWMHints_flags" )) + + +;;;;;; XTextProperty functions ;;;;;; + +(defentry make-XTextProperty () ( fixnum "make_XTextProperty" )) +(defentry XTextProperty-nitems (fixnum) ( fixnum "XTextProperty_nitems" )) +(defentry set-XTextProperty-nitems (fixnum fixnum) ( void "set_XTextProperty_nitems" )) +(defentry XTextProperty-format (fixnum) ( fixnum "XTextProperty_format" )) +(defentry set-XTextProperty-format (fixnum fixnum) ( void "set_XTextProperty_format" )) +(defentry XTextProperty-encoding (fixnum) ( fixnum "XTextProperty_encoding" )) +(defentry set-XTextProperty-encoding (fixnum fixnum) ( void "set_XTextProperty_encoding" )) +(defentry XTextProperty-value (fixnum) ( fixnum "XTextProperty_value" )) +(defentry set-XTextProperty-value (fixnum fixnum) ( void "set_XTextProperty_value" )) + + +;;;;;; XIconSize functions ;;;;;; + +(defentry make-XIconSize () ( fixnum "make_XIconSize" )) +(defentry XIconSize-height_inc (fixnum) ( fixnum "XIconSize_height_inc" )) +(defentry set-XIconSize-height_inc (fixnum fixnum) ( void "set_XIconSize_height_inc" )) +(defentry XIconSize-width_inc (fixnum) ( fixnum "XIconSize_width_inc" )) +(defentry set-XIconSize-width_inc (fixnum fixnum) ( void "set_XIconSize_width_inc" )) +(defentry XIconSize-max_height (fixnum) ( fixnum "XIconSize_max_height" )) +(defentry set-XIconSize-max_height (fixnum fixnum) ( void "set_XIconSize_max_height" )) +(defentry XIconSize-max_width (fixnum) ( fixnum "XIconSize_max_width" )) +(defentry set-XIconSize-max_width (fixnum fixnum) ( void "set_XIconSize_max_width" )) +(defentry XIconSize-min_height (fixnum) ( fixnum "XIconSize_min_height" )) +(defentry set-XIconSize-min_height (fixnum fixnum) ( void "set_XIconSize_min_height" )) +(defentry XIconSize-min_width (fixnum) ( fixnum "XIconSize_min_width" )) +(defentry set-XIconSize-min_width (fixnum fixnum) ( void "set_XIconSize_min_width" )) + + +;;;;;; XClassHint functions ;;;;;; + +(defentry make-XClassHint () ( fixnum "make_XClassHint" )) +(defentry XClassHint-res_class (fixnum) ( fixnum "XClassHint_res_class" )) +(defentry set-XClassHint-res_class (fixnum fixnum) ( void "set_XClassHint_res_class" )) +(defentry XClassHint-res_name (fixnum) ( fixnum "XClassHint_res_name" )) +(defentry set-XClassHint-res_name (fixnum fixnum) ( void "set_XClassHint_res_name" )) + + +;;;;;; XComposeStatus functions ;;;;;; + +(defentry make-XComposeStatus () ( fixnum "make_XComposeStatus" )) +(defentry XComposeStatus-chars_matched (fixnum) ( fixnum "XComposeStatus_chars_matched" )) +(defentry set-XComposeStatus-chars_matched (fixnum fixnum) ( void "set_XComposeStatus_chars_matched" )) +(defentry XComposeStatus-compose_ptr (fixnum) ( fixnum "XComposeStatus_compose_ptr" )) +(defentry set-XComposeStatus-compose_ptr (fixnum fixnum) ( void "set_XComposeStatus_compose_ptr" )) + + +;;;;;; XVisualInfo functions ;;;;;; + +(defentry make-XVisualInfo () ( fixnum "make_XVisualInfo" )) +(defentry XVisualInfo-bits_per_rgb (fixnum) ( fixnum "XVisualInfo_bits_per_rgb" )) +(defentry set-XVisualInfo-bits_per_rgb (fixnum fixnum) ( void "set_XVisualInfo_bits_per_rgb" )) +(defentry XVisualInfo-colormap_size (fixnum) ( fixnum "XVisualInfo_colormap_size" )) +(defentry set-XVisualInfo-colormap_size (fixnum fixnum) ( void "set_XVisualInfo_colormap_size" )) +(defentry XVisualInfo-blue_mask (fixnum) ( fixnum "XVisualInfo_blue_mask" )) +(defentry set-XVisualInfo-blue_mask (fixnum fixnum) ( void "set_XVisualInfo_blue_mask" )) +(defentry XVisualInfo-green_mask (fixnum) ( fixnum "XVisualInfo_green_mask" )) +(defentry set-XVisualInfo-green_mask (fixnum fixnum) ( void "set_XVisualInfo_green_mask" )) +(defentry XVisualInfo-red_mask (fixnum) ( fixnum "XVisualInfo_red_mask" )) +(defentry set-XVisualInfo-red_mask (fixnum fixnum) ( void "set_XVisualInfo_red_mask" )) +(defentry XVisualInfo-class (fixnum) ( fixnum "XVisualInfo_class" )) +(defentry set-XVisualInfo-class (fixnum fixnum) ( void "set_XVisualInfo_class" )) +(defentry XVisualInfo-depth (fixnum) ( fixnum "XVisualInfo_depth" )) +(defentry set-XVisualInfo-depth (fixnum fixnum) ( void "set_XVisualInfo_depth" )) +(defentry XVisualInfo-screen (fixnum) ( fixnum "XVisualInfo_screen" )) +(defentry set-XVisualInfo-screen (fixnum fixnum) ( void "set_XVisualInfo_screen" )) +(defentry XVisualInfo-visualid (fixnum) ( fixnum "XVisualInfo_visualid" )) +(defentry set-XVisualInfo-visualid (fixnum fixnum) ( void "set_XVisualInfo_visualid" )) +(defentry XVisualInfo-visual (fixnum) ( fixnum "XVisualInfo_visual" )) +(defentry set-XVisualInfo-visual (fixnum fixnum) ( void "set_XVisualInfo_visual" )) + + +;;;;;; XStandardColormap functions ;;;;;; + +(defentry make-XStandardColormap () ( fixnum "make_XStandardColormap" )) +(defentry XStandardColormap-killid (fixnum) ( fixnum "XStandardColormap_killid" )) +(defentry set-XStandardColormap-killid (fixnum fixnum) ( void "set_XStandardColormap_killid" )) +(defentry XStandardColormap-visualid (fixnum) ( fixnum "XStandardColormap_visualid" )) +(defentry set-XStandardColormap-visualid (fixnum fixnum) ( void "set_XStandardColormap_visualid" )) +(defentry XStandardColormap-base_pixel (fixnum) ( fixnum "XStandardColormap_base_pixel" )) +(defentry set-XStandardColormap-base_pixel (fixnum fixnum) ( void "set_XStandardColormap_base_pixel" )) +(defentry XStandardColormap-blue_mult (fixnum) ( fixnum "XStandardColormap_blue_mult" )) +(defentry set-XStandardColormap-blue_mult (fixnum fixnum) ( void "set_XStandardColormap_blue_mult" )) +(defentry XStandardColormap-blue_max (fixnum) ( fixnum "XStandardColormap_blue_max" )) +(defentry set-XStandardColormap-blue_max (fixnum fixnum) ( void "set_XStandardColormap_blue_max" )) +(defentry XStandardColormap-green_mult (fixnum) ( fixnum "XStandardColormap_green_mult" )) +(defentry set-XStandardColormap-green_mult (fixnum fixnum) ( void "set_XStandardColormap_green_mult" )) +(defentry XStandardColormap-green_max (fixnum) ( fixnum "XStandardColormap_green_max" )) +(defentry set-XStandardColormap-green_max (fixnum fixnum) ( void "set_XStandardColormap_green_max" )) +(defentry XStandardColormap-red_mult (fixnum) ( fixnum "XStandardColormap_red_mult" )) +(defentry set-XStandardColormap-red_mult (fixnum fixnum) ( void "set_XStandardColormap_red_mult" )) +(defentry XStandardColormap-red_max (fixnum) ( fixnum "XStandardColormap_red_max" )) +(defentry set-XStandardColormap-red_max (fixnum fixnum) ( void "set_XStandardColormap_red_max" )) +(defentry XStandardColormap-colormap (fixnum) ( fixnum "XStandardColormap_colormap" )) +(defentry set-XStandardColormap-colormap (fixnum fixnum) ( void "set_XStandardColormap_colormap" )) diff --git a/xgcl-2/gcl_Xutil.lsp b/xgcl-2/gcl_Xutil.lsp new file mode 100644 index 0000000..d27a0aa --- /dev/null +++ b/xgcl-2/gcl_Xutil.lsp @@ -0,0 +1,797 @@ +(in-package :XLIB) +; Xutil.lsp modified by Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +;; $XConsortium: Xutil.h,v 11.58 89/12/12 20:15:40 jim Exp $ */ + +;;********************************************************** +;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, +;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. + +;;modified by Hiep H Nguyen 28 Jul 91 + +;; All Rights Reserved + +;;Permission to use, copy, modify, and distribute this software and its +;;documentation for any purpose and without fee is hereby granted, +;;provided that the above copyright notice appear in all copies and that +;;both that copyright notice and this permission notice appear in +;;supporting documentation, and that the names of Digital or MIT not be +;;used in advertising or publicity pertaining to distribution of the +;;software without specific, written prior permission. + +;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL +;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, +;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +;;SOFTWARE. + +;;***************************************************************** + +;; +;; * Bitmask returned by XParseGeometry(). Each bit tells if the corresponding) +;; * value (x, y, width, height) was found in the parsed string.) + +(defconstant NoValue 0000) +(defconstant XValue 0001) +(defconstant YValue 0002) +(defconstant WidthValue 0004) +(defconstant HeightValue 0008) +(defconstant AllValues 15) +(defconstant XNegative 16) +(defconstant YNegative 32) + +;; + ;; The next block of definitions are for window manager properties that + ;; clients and applications use for communication. + + +;; flags argument in size hints +(defconstant USPosition (expt 2 0) ) ;; user specified x, y +(defconstant USSize (expt 2 1) ) ;; user specified width, height + +(defconstant PPosition (expt 2 2) ) ;; program specified position +(defconstant PSize (expt 2 3) ) ;; program specified size +(defconstant PMinSize (expt 2 4) ) ;; program specified minimum size +(defconstant PMaxSize (expt 2 5) ) ;; program specified maximum size +(defconstant PResizeInc (expt 2 6) ) ;; program specified resize increments +(defconstant PAspect (expt 2 7) ) ;; program specified min and max aspect ratios +(defconstant PBaseSize (expt 2 8) ) ;; program specified base for incrementing +(defconstant PWinGravity (expt 2 9) ) ;; program specified window gravity + +;; obsolete +(defconstant PAllHints (+ PPosition PSize PMinSize PMaxSize PResizeInc PAspect)) + +;; definition for flags of XWMHints + +(defconstant InputHint (expt 2 0)) +(defconstant StateHint (expt 2 1)) +(defconstant IconPixmapHint (expt 2 2)) +(defconstant IconWindowHint (expt 2 3)) +(defconstant IconPositionHint (expt 2 4)) +(defconstant IconMaskHint (expt 2 5)) +(defconstant WindowGroupHint (expt 2 6)) +(defconstant AllHints ( + InputHint StateHint IconPixmapHint IconWindowHint +IconPositionHint IconMaskHint WindowGroupHint)) + +;; definitions for initial window state +(defconstant WithdrawnState 0 ) ;; for windows that are not mapped +(defconstant NormalState 1 ) ;; most applications want to start this way +(defconstant IconicState 3 ) ;; application wants to start as an icon + +;; + ;; Obsolete states no longer defined by ICCCM + +(defconstant DontCareState 0 ) ;; don't know or care +(defconstant ZoomState 2 ) ;; application wants to start zoomed +(defconstant InactiveState 4 ) ;; application believes it is seldom used; + ;; some wm's may put it on inactive menu + + + +;; + ;; opaque reference to Region data type + +;;typedef struct _XRegion *Region; + +;; Return values from XRectInRegion() + +(defconstant RectangleOut 0) +(defconstant RectangleIn 1) +(defconstant RectanglePart 2) + + +(defconstant VisualNoMask 0) +(defconstant VisualIDMask 1) +(defconstant VisualScreenMask 2) +(defconstant VisualDepthMask 4) +(defconstant VisualClassMask 8) +(defconstant VisualRedMaskMask 16) +(defconstant VisualGreenMaskMask 32) +(defconstant VisualBlueMaskMask 64) +(defconstant VisualColormapSizeMask 128) +(defconstant VisualBitsPerRGBMask 256) +(defconstant VisualAllMask 511) + +(defconstant ReleaseByFreeingColormap 1) ;; for killid field above + + +;; +;; return codes for XReadBitmapFile and XWriteBitmapFile + +(defconstant BitmapSuccess 0) +(defconstant BitmapOpenFailed 1) +(defconstant BitmapFileInvalid 2) +(defconstant BitmapNoMemory 3) +;; + ;; Declare the routines that don't return int. + + +;; *************************************************************** +;; * +;; * Context Management +;; * +;; *************************************************************** + + +;; Associative lookup table return codes + +(defconstant XCSUCCESS 0 ) ;; No error. +(defconstant XCNOMEM 1 ) ;; Out of memory +(defconstant XCNOENT 2 ) ;; No entry in table + +;;typedef fixnum XContext; + +(defentry XSaveContext( + + fixnum ;; display + fixnum ;; w + fixnum ;; context + fixnum ;; data + +)( fixnum "XSaveContext")) + + + +(defentry XFindContext( + + fixnum ;; display + fixnum ;; w + fixnum ;; context + fixnum ;; data_return + +)( fixnum "XFindContext")) + + + +(defentry XDeleteContext( + + fixnum ;; display + fixnum ;; w + fixnum ;; context + +)( fixnum "XDeleteContext")) + + + + +(defentry XGetWMHints( + + fixnum ;; display + fixnum ;; w + +)( fixnum "XGetWMHints")) + + +(defentry XCreateRegion( + +;; void + +)( fixnum "XCreateRegion")) + + +(defentry XPolygonRegion( + + fixnum ;; points + fixnum ;; n + fixnum ;; fill_rule + +)( fixnum "XPolygonRegion")) + + + +(defentry XGetVisualInfo( + + fixnum ;; display + fixnum ;; vinfo_mask + fixnum ;; vinfo_template + fixnum ;; nitems_return + +)( fixnum "XGetVisualInfo")) + +;; Allocation routines for properties that may get longer + + +(defentry XAllocSizeHints ( + +;; void + +)( fixnum "XAllocSizeHints" )) + + +(defentry XAllocStandardColormap ( + +;; void + +)( fixnum "XAllocStandardColormap" )) + + +(defentry XAllocWMHints ( + +;; void + +)( fixnum "XAllocWMHints" )) + + +(defentry XAllocClassHint ( + +;; void + +)( fixnum "XAllocClassHint" )) + + +(defentry XAllocIconSize ( + +;; void + +)( fixnum "XAllocIconSize" )) + +;; ICCCM routines for data structures defined in this file + + +(defentry XGetWMSizeHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints_return + fixnum ;; supplied_return + fixnum ;; property + +)( fixnum "XGetWMSizeHints")) + + +(defentry XGetWMNormalHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints_return + fixnum ;; supplied_return + +)( fixnum "XGetWMNormalHints")) + + +(defentry XGetRGBColormaps( + + fixnum ;; display + fixnum ;; w + fixnum ;; stdcmap_return + fixnum ;; count_return + fixnum ;; property + +)( fixnum "XGetRGBColormaps")) + + +(defentry XGetTextProperty( + + fixnum ;; display + fixnum ;; window + fixnum ;; text_prop_return + fixnum ;; property + +)( fixnum "XGetTextProperty")) + + +(defentry XGetWMName( + + fixnum ;; display + fixnum ;; w + fixnum ;; text_prop_return + +)( fixnum "XGetWMName")) + + +(defentry XGetWMIconName( + + fixnum ;; display + fixnum ;; w + fixnum ;; text_prop_return + +)( fixnum "XGetWMIconName")) + + +(defentry XGetWMClientMachine( + + fixnum ;; display + fixnum ;; w + fixnum ;; text_prop_return + +)( fixnum "XGetWMClientMachine")) + + +(defentry XSetWMProperties( + + fixnum ;; display + fixnum ;; w + fixnum ;; window_name + fixnum ;; icon_name + fixnum ;; argv + fixnum ;; argc + fixnum ;; normal_hints + fixnum ;; wm_hints + fixnum ;; class_hints + +)( void "XSetWMProperties")) + + +(defentry XSetWMSizeHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints + fixnum ;; property + +)( void "XSetWMSizeHints")) + + +(defentry XSetWMNormalHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints + +)( void "XSetWMNormalHints")) + + +(defentry XSetRGBColormaps( + + fixnum ;; display + fixnum ;; w + fixnum ;; stdcmaps + fixnum ;; count + fixnum ;; property + +)( void "XSetRGBColormaps")) + + +(defentry XSetTextProperty( + + fixnum ;; display + fixnum ;; w + fixnum ;; text_prop + fixnum ;; property + +)( void "XSetTextProperty")) + + +(defentry XSetWMName( + + fixnum ;; display + fixnum ;; w + fixnum ;; text_prop + +)( void "XSetWMName")) + + +(defentry XSetWMIconName( + + fixnum ;; display + fixnum ;; w + fixnum ;; text_prop + +)( void "XSetWMIconName")) + + +(defentry XSetWMClientMachine( + + fixnum ;; display + fixnum ;; w + fixnum ;; text_prop + +)( void "XSetWMClientMachine")) + + +(defentry XStringListToTextProperty( + + fixnum ;; list + fixnum ;; count + fixnum ;; text_prop_return + +)( fixnum "XStringListToTextProperty")) + + +(defentry XTextPropertyToStringList( + + fixnum ;; text_prop + fixnum ;; list_return + fixnum ;; count_return + +)( fixnum "XTextPropertyToStringList")) + +;; The following declarations are alphabetized. + + + +(defentry XClipBox( + + fixnum ;; r + fixnum ;; rect_return + +)( void "XClipBox")) + + + +(defentry XDestroyRegion( + + fixnum ;; r + +)( void "XDestroyRegion")) + + + +(defentry XEmptyRegion( + + fixnum ;; r + +)( void "XEmptyRegion")) + + + +(defentry XEqualRegion( + + fixnum ;; r1 + fixnum ;; r2 + +)( void "XEqualRegion")) + + + +(defentry XGetClassHint( + + fixnum ;; display + fixnum ;; w + fixnum ;; class_hints_return + +)( fixnum "XGetClassHint")) + + + +(defentry XGetIconSizes( + + fixnum ;; display + fixnum ;; w + fixnum ;; size_list_return + fixnum ;; count_return + +)( fixnum "XGetIconSizes")) + + + +(defentry XGetNormalHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints_return + +)( fixnum "XGetNormalHints")) + + + +(defentry XGetSizeHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints_return + fixnum ;; property + +)( fixnum "XGetSizeHints")) + + + +(defentry XGetStandardColormap( + + fixnum ;; display + fixnum ;; w + fixnum ;; colormap_return + fixnum ;; property + +)( fixnum "XGetStandardColormap")) + + + +(defentry XGetZoomHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; zhints_return + +)( fixnum "XGetZoomHints")) + + + +(defentry XIntersectRegion( + + fixnum ;; sra + fixnum ;; srb + fixnum ;; dr_return + +)( void "XIntersectRegion")) + + + +(defentry XLookupString( + + fixnum ;; event_struct + object ;; buffer_return + fixnum ;; bytes_buffer + fixnum ;; keysym_return + fixnum ;; int_in_out + +)( fixnum "XLookupString")) + + + +(defentry XMatchVisualInfo( + + fixnum ;; display + fixnum ;; screen + fixnum ;; depth + fixnum ;; class + fixnum ;; vinfo_return + +)( fixnum "XMatchVisualInfo")) + + + +(defentry XOffsetRegion( + + fixnum ;; r + fixnum ;; dx + fixnum ;; dy + +)( void "XOffsetRegion")) + + + +(defentry XPointInRegion( + + fixnum ;; r + fixnum ;; x + fixnum ;; y + +)( fixnum "XPointInRegion")) + + + +(defentry XRectInRegion( + + fixnum ;; r + fixnum ;; x + fixnum ;; y + fixnum ;; width + fixnum ;; height + +)( fixnum "XRectInRegion")) + + + +(defentry XSetClassHint( + + fixnum ;; display + fixnum ;; w + fixnum ;; class_hints + +)( void "XSetClassHint")) + + + +(defentry XSetIconSizes( + + fixnum ;; display + fixnum ;; w + fixnum ;; size_list + fixnum ;; count + +)( void "XSetIconSizes")) + + + +(defentry XSetNormalHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints + +)( void "XSetNormalHints")) + + + +(defentry XSetSizeHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; hints + fixnum ;; property + +)( void "XSetSizeHints")) + + + +(defentry XSetStandardProperties( + + fixnum ;; display + fixnum ;; w + object ;; window_name + object ;; icon_name + fixnum ;; icon_pixmap + fixnum ;; argv + fixnum ;; argc + fixnum ;; hints + +)( void "XSetStandardProperties")) + + + +(defentry XSetWMHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; wm_hints + +)( void "XSetWMHints")) + + + +(defentry XSetRegion( + + fixnum ;; display + fixnum ;; gc + fixnum ;; r + +)( void "XSetRegion")) + + + +(defentry XSetStandardColormap( + + fixnum ;; display + fixnum ;; w + fixnum ;; colormap + fixnum ;; property + +)( void "XSetStandardColormap")) + + + +(defentry XSetZoomHints( + + fixnum ;; display + fixnum ;; w + fixnum ;; zhints + +)( void "XSetZoomHints")) + + + +(defentry XShrinkRegion( + + fixnum ;; r + fixnum ;; dx + fixnum ;; dy + +)( void "XShrinkRegion")) + + + +(defentry XSubtractRegion( + + fixnum ;; sra + fixnum ;; srb + fixnum ;; dr_return + +)( void "XSubtractRegion")) + + + +(defentry XUnionRectWithRegion( + + fixnum ;; rectangle + fixnum ;; src_region + fixnum ;; dest_region_return + +)( void "XUnionRectWithRegion")) + + + +(defentry XUnionRegion( + + fixnum ;; sra + fixnum ;; srb + fixnum ;; dr_return + +)( void "XUnionRegion")) + + + +(defentry XWMGeometry( + + fixnum ;; display + fixnum ;; screen_number + object ;; user_geometry + object ;; default_geometry + fixnum ;; border_width + fixnum ;; hints + fixnum ;; x_return + fixnum ;; y_return + fixnum ;; width_return + fixnum ;; height_return + fixnum ;; gravity_return + +)( fixnum "XWMGeometry")) + + + +(defentry XXorRegion( + + fixnum ;; sra + fixnum ;; srb + fixnum ;; dr_return + +)( void "XXorRegion")) +;; + ;; These macros are used to give some sugar to the image routines so that + ;; naive people are more comfortable with them. + +(defentry XDestroyImage(fixnum) (fixnum "XDestroyImage")) +(defentry XGetPixel(fixnum fixnum fixnum) (fixnum "XGetPixel" )) +(defentry XPutPixel(fixnum fixnum int fixnum) ( fixnum "XPutPixel")) +(defentry XSubImage(fixnum fixnum int fixnum fixnum) (fixnum "XSubImage")) +(defentry XAddPixel(fixnum fixnum) (fixnum "XAddPixel")) +;; + ;; Keysym macros, used on Keysyms to test for classes of symbols + +(defentry IsKeypadKey(fixnum) (fixnum "IsKeypadKey")) + +(defentry IsCursorKey(fixnum) (fixnum "IsCursorKey")) + +(defentry IsPFKey(fixnum) (fixnum "IsPFKey")) + +(defentry IsFunctionKey(fixnum) (fixnum "IsFunctionKey")) + +(defentry IsMiscFunctionKey(fixnum) (fixnum "IsMiscFunctionKey")) + +(defentry IsModifierKey(fixnum) (fixnum "IsModifierKey")) +(defentry XUniqueContext() (fixnum "XUniqueContext")) +(defentry XStringToContext(object) (fixnum "XStringToContext")) + diff --git a/xgcl-2/gcl_defentry_events.lsp b/xgcl-2/gcl_defentry_events.lsp new file mode 100644 index 0000000..c586fd3 --- /dev/null +++ b/xgcl-2/gcl_defentry_events.lsp @@ -0,0 +1,817 @@ +(in-package :XLIB) +; defentry-events.lsp Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + + +;;;;;; XKeyEvent functions ;;;;;; + +(defentry make-XKeyEvent () ( fixnum "make_XKeyEvent" )) +(defentry XKeyEvent-same_screen (fixnum) ( fixnum "XKeyEvent_same_screen" )) +(defentry set-XKeyEvent-same_screen (fixnum fixnum) ( void "set_XKeyEvent_same_screen" )) +(defentry XKeyEvent-keycode (fixnum) ( fixnum "XKeyEvent_keycode" )) +(defentry set-XKeyEvent-keycode (fixnum fixnum) ( void "set_XKeyEvent_keycode" )) +(defentry XKeyEvent-state (fixnum) ( fixnum "XKeyEvent_state" )) +(defentry set-XKeyEvent-state (fixnum fixnum) ( void "set_XKeyEvent_state" )) +(defentry XKeyEvent-y_root (fixnum) ( fixnum "XKeyEvent_y_root" )) +(defentry set-XKeyEvent-y_root (fixnum fixnum) ( void "set_XKeyEvent_y_root" )) +(defentry XKeyEvent-x_root (fixnum) ( fixnum "XKeyEvent_x_root" )) +(defentry set-XKeyEvent-x_root (fixnum fixnum) ( void "set_XKeyEvent_x_root" )) +(defentry XKeyEvent-y (fixnum) ( fixnum "XKeyEvent_y" )) +(defentry set-XKeyEvent-y (fixnum fixnum) ( void "set_XKeyEvent_y" )) +(defentry XKeyEvent-x (fixnum) ( fixnum "XKeyEvent_x" )) +(defentry set-XKeyEvent-x (fixnum fixnum) ( void "set_XKeyEvent_x" )) +(defentry XKeyEvent-time (fixnum) ( fixnum "XKeyEvent_time" )) +(defentry set-XKeyEvent-time (fixnum fixnum) ( void "set_XKeyEvent_time" )) +(defentry XKeyEvent-subwindow (fixnum) ( fixnum "XKeyEvent_subwindow" )) +(defentry set-XKeyEvent-subwindow (fixnum fixnum) ( void "set_XKeyEvent_subwindow" )) +(defentry XKeyEvent-root (fixnum) ( fixnum "XKeyEvent_root" )) +(defentry set-XKeyEvent-root (fixnum fixnum) ( void "set_XKeyEvent_root" )) +(defentry XKeyEvent-window (fixnum) ( fixnum "XKeyEvent_window" )) +(defentry set-XKeyEvent-window (fixnum fixnum) ( void "set_XKeyEvent_window" )) +(defentry XKeyEvent-display (fixnum) ( fixnum "XKeyEvent_display" )) +(defentry set-XKeyEvent-display (fixnum fixnum) ( void "set_XKeyEvent_display" )) +(defentry XKeyEvent-send_event (fixnum) ( fixnum "XKeyEvent_send_event" )) +(defentry set-XKeyEvent-send_event (fixnum fixnum) ( void "set_XKeyEvent_send_event" )) +(defentry XKeyEvent-serial (fixnum) ( fixnum "XKeyEvent_serial" )) +(defentry set-XKeyEvent-serial (fixnum fixnum) ( void "set_XKeyEvent_serial" )) +(defentry XKeyEvent-type (fixnum) ( fixnum "XKeyEvent_type" )) +(defentry set-XKeyEvent-type (fixnum fixnum) ( void "set_XKeyEvent_type" )) + + +;;;;;; XButtonEvent functions ;;;;;; + +(defentry make-XButtonEvent () ( fixnum "make_XButtonEvent" )) +(defentry XButtonEvent-same_screen (fixnum) ( fixnum "XButtonEvent_same_screen" )) +(defentry set-XButtonEvent-same_screen (fixnum fixnum) ( void "set_XButtonEvent_same_screen" )) +(defentry XButtonEvent-button (fixnum) ( fixnum "XButtonEvent_button" )) +(defentry set-XButtonEvent-button (fixnum fixnum) ( void "set_XButtonEvent_button" )) +(defentry XButtonEvent-state (fixnum) ( fixnum "XButtonEvent_state" )) +(defentry set-XButtonEvent-state (fixnum fixnum) ( void "set_XButtonEvent_state" )) +(defentry XButtonEvent-y_root (fixnum) ( fixnum "XButtonEvent_y_root" )) +(defentry set-XButtonEvent-y_root (fixnum fixnum) ( void "set_XButtonEvent_y_root" )) +(defentry XButtonEvent-x_root (fixnum) ( fixnum "XButtonEvent_x_root" )) +(defentry set-XButtonEvent-x_root (fixnum fixnum) ( void "set_XButtonEvent_x_root" )) +(defentry XButtonEvent-y (fixnum) ( fixnum "XButtonEvent_y" )) +(defentry set-XButtonEvent-y (fixnum fixnum) ( void "set_XButtonEvent_y" )) +(defentry XButtonEvent-x (fixnum) ( fixnum "XButtonEvent_x" )) +(defentry set-XButtonEvent-x (fixnum fixnum) ( void "set_XButtonEvent_x" )) +(defentry XButtonEvent-time (fixnum) ( fixnum "XButtonEvent_time" )) +(defentry set-XButtonEvent-time (fixnum fixnum) ( void "set_XButtonEvent_time" )) +(defentry XButtonEvent-subwindow (fixnum) ( fixnum "XButtonEvent_subwindow" )) +(defentry set-XButtonEvent-subwindow (fixnum fixnum) ( void "set_XButtonEvent_subwindow" )) +(defentry XButtonEvent-root (fixnum) ( fixnum "XButtonEvent_root" )) +(defentry set-XButtonEvent-root (fixnum fixnum) ( void "set_XButtonEvent_root" )) +(defentry XButtonEvent-window (fixnum) ( fixnum "XButtonEvent_window" )) +(defentry set-XButtonEvent-window (fixnum fixnum) ( void "set_XButtonEvent_window" )) +(defentry XButtonEvent-display (fixnum) ( fixnum "XButtonEvent_display" )) +(defentry set-XButtonEvent-display (fixnum fixnum) ( void "set_XButtonEvent_display" )) +(defentry XButtonEvent-send_event (fixnum) ( fixnum "XButtonEvent_send_event" )) +(defentry set-XButtonEvent-send_event (fixnum fixnum) ( void "set_XButtonEvent_send_event" )) +(defentry XButtonEvent-serial (fixnum) ( fixnum "XButtonEvent_serial" )) +(defentry set-XButtonEvent-serial (fixnum fixnum) ( void "set_XButtonEvent_serial" )) +(defentry XButtonEvent-type (fixnum) ( fixnum "XButtonEvent_type" )) +(defentry set-XButtonEvent-type (fixnum fixnum) ( void "set_XButtonEvent_type" )) + + +;;;;;; XMotionEvent functions ;;;;;; + +(defentry make-XMotionEvent () ( fixnum "make_XMotionEvent" )) +(defentry XMotionEvent-same_screen (fixnum) ( fixnum "XMotionEvent_same_screen" )) +(defentry set-XMotionEvent-same_screen (fixnum fixnum) ( void "set_XMotionEvent_same_screen" )) +(defentry XMotionEvent-is_hint (fixnum) ( char "XMotionEvent_is_hint" )) +(defentry set-XMotionEvent-is_hint (fixnum char) ( void "set_XMotionEvent_is_hint" )) +(defentry XMotionEvent-state (fixnum) ( fixnum "XMotionEvent_state" )) +(defentry set-XMotionEvent-state (fixnum fixnum) ( void "set_XMotionEvent_state" )) +(defentry XMotionEvent-y_root (fixnum) ( fixnum "XMotionEvent_y_root" )) +(defentry set-XMotionEvent-y_root (fixnum fixnum) ( void "set_XMotionEvent_y_root" )) +(defentry XMotionEvent-x_root (fixnum) ( fixnum "XMotionEvent_x_root" )) +(defentry set-XMotionEvent-x_root (fixnum fixnum) ( void "set_XMotionEvent_x_root" )) +(defentry XMotionEvent-y (fixnum) ( fixnum "XMotionEvent_y" )) +(defentry set-XMotionEvent-y (fixnum fixnum) ( void "set_XMotionEvent_y" )) +(defentry XMotionEvent-x (fixnum) ( fixnum "XMotionEvent_x" )) +(defentry set-XMotionEvent-x (fixnum fixnum) ( void "set_XMotionEvent_x" )) +(defentry XMotionEvent-time (fixnum) ( fixnum "XMotionEvent_time" )) +(defentry set-XMotionEvent-time (fixnum fixnum) ( void "set_XMotionEvent_time" )) +(defentry XMotionEvent-subwindow (fixnum) ( fixnum "XMotionEvent_subwindow" )) +(defentry set-XMotionEvent-subwindow (fixnum fixnum) ( void "set_XMotionEvent_subwindow" )) +(defentry XMotionEvent-root (fixnum) ( fixnum "XMotionEvent_root" )) +(defentry set-XMotionEvent-root (fixnum fixnum) ( void "set_XMotionEvent_root" )) +(defentry XMotionEvent-window (fixnum) ( fixnum "XMotionEvent_window" )) +(defentry set-XMotionEvent-window (fixnum fixnum) ( void "set_XMotionEvent_window" )) +(defentry XMotionEvent-display (fixnum) ( fixnum "XMotionEvent_display" )) +(defentry set-XMotionEvent-display (fixnum fixnum) ( void "set_XMotionEvent_display" )) +(defentry XMotionEvent-send_event (fixnum) ( fixnum "XMotionEvent_send_event" )) +(defentry set-XMotionEvent-send_event (fixnum fixnum) ( void "set_XMotionEvent_send_event" )) +(defentry XMotionEvent-serial (fixnum) ( fixnum "XMotionEvent_serial" )) +(defentry set-XMotionEvent-serial (fixnum fixnum) ( void "set_XMotionEvent_serial" )) +(defentry XMotionEvent-type (fixnum) ( fixnum "XMotionEvent_type" )) +(defentry set-XMotionEvent-type (fixnum fixnum) ( void "set_XMotionEvent_type" )) + + +;;;;;; XCrossingEvent functions ;;;;;; + +(defentry make-XCrossingEvent () ( fixnum "make_XCrossingEvent" )) +(defentry XCrossingEvent-state (fixnum) ( fixnum "XCrossingEvent_state" )) +(defentry set-XCrossingEvent-state (fixnum fixnum) ( void "set_XCrossingEvent_state" )) +(defentry XCrossingEvent-focus (fixnum) ( fixnum "XCrossingEvent_focus" )) +(defentry set-XCrossingEvent-focus (fixnum fixnum) ( void "set_XCrossingEvent_focus" )) +(defentry XCrossingEvent-same_screen (fixnum) ( fixnum "XCrossingEvent_same_screen" )) +(defentry set-XCrossingEvent-same_screen (fixnum fixnum) ( void "set_XCrossingEvent_same_screen" )) +(defentry XCrossingEvent-detail (fixnum) ( fixnum "XCrossingEvent_detail" )) +(defentry set-XCrossingEvent-detail (fixnum fixnum) ( void "set_XCrossingEvent_detail" )) +(defentry XCrossingEvent-mode (fixnum) ( fixnum "XCrossingEvent_mode" )) +(defentry set-XCrossingEvent-mode (fixnum fixnum) ( void "set_XCrossingEvent_mode" )) +(defentry XCrossingEvent-y_root (fixnum) ( fixnum "XCrossingEvent_y_root" )) +(defentry set-XCrossingEvent-y_root (fixnum fixnum) ( void "set_XCrossingEvent_y_root" )) +(defentry XCrossingEvent-x_root (fixnum) ( fixnum "XCrossingEvent_x_root" )) +(defentry set-XCrossingEvent-x_root (fixnum fixnum) ( void "set_XCrossingEvent_x_root" )) +(defentry XCrossingEvent-y (fixnum) ( fixnum "XCrossingEvent_y" )) +(defentry set-XCrossingEvent-y (fixnum fixnum) ( void "set_XCrossingEvent_y" )) +(defentry XCrossingEvent-x (fixnum) ( fixnum "XCrossingEvent_x" )) +(defentry set-XCrossingEvent-x (fixnum fixnum) ( void "set_XCrossingEvent_x" )) +(defentry XCrossingEvent-time (fixnum) ( fixnum "XCrossingEvent_time" )) +(defentry set-XCrossingEvent-time (fixnum fixnum) ( void "set_XCrossingEvent_time" )) +(defentry XCrossingEvent-subwindow (fixnum) ( fixnum "XCrossingEvent_subwindow" )) +(defentry set-XCrossingEvent-subwindow (fixnum fixnum) ( void "set_XCrossingEvent_subwindow" )) +(defentry XCrossingEvent-root (fixnum) ( fixnum "XCrossingEvent_root" )) +(defentry set-XCrossingEvent-root (fixnum fixnum) ( void "set_XCrossingEvent_root" )) +(defentry XCrossingEvent-window (fixnum) ( fixnum "XCrossingEvent_window" )) +(defentry set-XCrossingEvent-window (fixnum fixnum) ( void "set_XCrossingEvent_window" )) +(defentry XCrossingEvent-display (fixnum) ( fixnum "XCrossingEvent_display" )) +(defentry set-XCrossingEvent-display (fixnum fixnum) ( void "set_XCrossingEvent_display" )) +(defentry XCrossingEvent-send_event (fixnum) ( fixnum "XCrossingEvent_send_event" )) +(defentry set-XCrossingEvent-send_event (fixnum fixnum) ( void "set_XCrossingEvent_send_event" )) +(defentry XCrossingEvent-serial (fixnum) ( fixnum "XCrossingEvent_serial" )) +(defentry set-XCrossingEvent-serial (fixnum fixnum) ( void "set_XCrossingEvent_serial" )) +(defentry XCrossingEvent-type (fixnum) ( fixnum "XCrossingEvent_type" )) +(defentry set-XCrossingEvent-type (fixnum fixnum) ( void "set_XCrossingEvent_type" )) + + +;;;;;; XFocusChangeEvent functions ;;;;;; + +(defentry make-XFocusChangeEvent () ( fixnum "make_XFocusChangeEvent" )) +(defentry XFocusChangeEvent-detail (fixnum) ( fixnum "XFocusChangeEvent_detail" )) +(defentry set-XFocusChangeEvent-detail (fixnum fixnum) ( void "set_XFocusChangeEvent_detail" )) +(defentry XFocusChangeEvent-mode (fixnum) ( fixnum "XFocusChangeEvent_mode" )) +(defentry set-XFocusChangeEvent-mode (fixnum fixnum) ( void "set_XFocusChangeEvent_mode" )) +(defentry XFocusChangeEvent-window (fixnum) ( fixnum "XFocusChangeEvent_window" )) +(defentry set-XFocusChangeEvent-window (fixnum fixnum) ( void "set_XFocusChangeEvent_window" )) +(defentry XFocusChangeEvent-display (fixnum) ( fixnum "XFocusChangeEvent_display" )) +(defentry set-XFocusChangeEvent-display (fixnum fixnum) ( void "set_XFocusChangeEvent_display" )) +(defentry XFocusChangeEvent-send_event (fixnum) ( fixnum "XFocusChangeEvent_send_event" )) +(defentry set-XFocusChangeEvent-send_event (fixnum fixnum) ( void "set_XFocusChangeEvent_send_event" )) +(defentry XFocusChangeEvent-serial (fixnum) ( fixnum "XFocusChangeEvent_serial" )) +(defentry set-XFocusChangeEvent-serial (fixnum fixnum) ( void "set_XFocusChangeEvent_serial" )) +(defentry XFocusChangeEvent-type (fixnum) ( fixnum "XFocusChangeEvent_type" )) +(defentry set-XFocusChangeEvent-type (fixnum fixnum) ( void "set_XFocusChangeEvent_type" )) + + +;;;;;; XKeymapEvent functions ;;;;;; + +(defentry make-XKeymapEvent () ( fixnum "make_XKeymapEvent" )) +;;(defentry XKeymapEvent-key_vector[32] (fixnum) ( char "XKeymapEvent_key_vector[32]" )) +;;(defentry set-XKeymapEvent-key_vector[32] (fixnum char) ( void "set_XKeymapEvent_key_vector[32]" )) +(defentry XKeymapEvent-window (fixnum) ( fixnum "XKeymapEvent_window" )) +(defentry set-XKeymapEvent-window (fixnum fixnum) ( void "set_XKeymapEvent_window" )) +(defentry XKeymapEvent-display (fixnum) ( fixnum "XKeymapEvent_display" )) +(defentry set-XKeymapEvent-display (fixnum fixnum) ( void "set_XKeymapEvent_display" )) +(defentry XKeymapEvent-send_event (fixnum) ( fixnum "XKeymapEvent_send_event" )) +(defentry set-XKeymapEvent-send_event (fixnum fixnum) ( void "set_XKeymapEvent_send_event" )) +(defentry XKeymapEvent-serial (fixnum) ( fixnum "XKeymapEvent_serial" )) +(defentry set-XKeymapEvent-serial (fixnum fixnum) ( void "set_XKeymapEvent_serial" )) +(defentry XKeymapEvent-type (fixnum) ( fixnum "XKeymapEvent_type" )) +(defentry set-XKeymapEvent-type (fixnum fixnum) ( void "set_XKeymapEvent_type" )) + + +;;;;;; XExposeEvent functions ;;;;;; + +(defentry make-XExposeEvent () ( fixnum "make_XExposeEvent" )) +(defentry XExposeEvent-count (fixnum) ( fixnum "XExposeEvent_count" )) +(defentry set-XExposeEvent-count (fixnum fixnum) ( void "set_XExposeEvent_count" )) +(defentry XExposeEvent-height (fixnum) ( fixnum "XExposeEvent_height" )) +(defentry set-XExposeEvent-height (fixnum fixnum) ( void "set_XExposeEvent_height" )) +(defentry XExposeEvent-width (fixnum) ( fixnum "XExposeEvent_width" )) +(defentry set-XExposeEvent-width (fixnum fixnum) ( void "set_XExposeEvent_width" )) +(defentry XExposeEvent-y (fixnum) ( fixnum "XExposeEvent_y" )) +(defentry set-XExposeEvent-y (fixnum fixnum) ( void "set_XExposeEvent_y" )) +(defentry XExposeEvent-x (fixnum) ( fixnum "XExposeEvent_x" )) +(defentry set-XExposeEvent-x (fixnum fixnum) ( void "set_XExposeEvent_x" )) +(defentry XExposeEvent-window (fixnum) ( fixnum "XExposeEvent_window" )) +(defentry set-XExposeEvent-window (fixnum fixnum) ( void "set_XExposeEvent_window" )) +(defentry XExposeEvent-display (fixnum) ( fixnum "XExposeEvent_display" )) +(defentry set-XExposeEvent-display (fixnum fixnum) ( void "set_XExposeEvent_display" )) +(defentry XExposeEvent-send_event (fixnum) ( fixnum "XExposeEvent_send_event" )) +(defentry set-XExposeEvent-send_event (fixnum fixnum) ( void "set_XExposeEvent_send_event" )) +(defentry XExposeEvent-serial (fixnum) ( fixnum "XExposeEvent_serial" )) +(defentry set-XExposeEvent-serial (fixnum fixnum) ( void "set_XExposeEvent_serial" )) +(defentry XExposeEvent-type (fixnum) ( fixnum "XExposeEvent_type" )) +(defentry set-XExposeEvent-type (fixnum fixnum) ( void "set_XExposeEvent_type" )) + + +;;;;;; XGraphicsExposeEvent functions ;;;;;; + +(defentry make-XGraphicsExposeEvent () ( fixnum "make_XGraphicsExposeEvent" )) +(defentry XGraphicsExposeEvent-minor_code (fixnum) ( fixnum "XGraphicsExposeEvent_minor_code" )) +(defentry set-XGraphicsExposeEvent-minor_code (fixnum fixnum) ( void "set_XGraphicsExposeEvent_minor_code" )) +(defentry XGraphicsExposeEvent-major_code (fixnum) ( fixnum "XGraphicsExposeEvent_major_code" )) +(defentry set-XGraphicsExposeEvent-major_code (fixnum fixnum) ( void "set_XGraphicsExposeEvent_major_code" )) +(defentry XGraphicsExposeEvent-count (fixnum) ( fixnum "XGraphicsExposeEvent_count" )) +(defentry set-XGraphicsExposeEvent-count (fixnum fixnum) ( void "set_XGraphicsExposeEvent_count" )) +(defentry XGraphicsExposeEvent-height (fixnum) ( fixnum "XGraphicsExposeEvent_height" )) +(defentry set-XGraphicsExposeEvent-height (fixnum fixnum) ( void "set_XGraphicsExposeEvent_height" )) +(defentry XGraphicsExposeEvent-width (fixnum) ( fixnum "XGraphicsExposeEvent_width" )) +(defentry set-XGraphicsExposeEvent-width (fixnum fixnum) ( void "set_XGraphicsExposeEvent_width" )) +(defentry XGraphicsExposeEvent-y (fixnum) ( fixnum "XGraphicsExposeEvent_y" )) +(defentry set-XGraphicsExposeEvent-y (fixnum fixnum) ( void "set_XGraphicsExposeEvent_y" )) +(defentry XGraphicsExposeEvent-x (fixnum) ( fixnum "XGraphicsExposeEvent_x" )) +(defentry set-XGraphicsExposeEvent-x (fixnum fixnum) ( void "set_XGraphicsExposeEvent_x" )) +(defentry XGraphicsExposeEvent-drawable (fixnum) (fixnum "XGraphicsExposeEvent_drawable" )) +(defentry set-XGraphicsExposeEvent-drawable (fixnum fixnum) ( void "set_XGraphicsExposeEvent_drawable" )) +(defentry XGraphicsExposeEvent-display (fixnum) ( fixnum "XGraphicsExposeEvent_display" )) +(defentry set-XGraphicsExposeEvent-display (fixnum fixnum) ( void "set_XGraphicsExposeEvent_display" )) +(defentry XGraphicsExposeEvent-send_event (fixnum) ( fixnum "XGraphicsExposeEvent_send_event" )) +(defentry set-XGraphicsExposeEvent-send_event (fixnum fixnum) ( void "set_XGraphicsExposeEvent_send_event" )) +(defentry XGraphicsExposeEvent-serial (fixnum) ( fixnum "XGraphicsExposeEvent_serial" )) +(defentry set-XGraphicsExposeEvent-serial (fixnum fixnum) ( void "set_XGraphicsExposeEvent_serial" )) +(defentry XGraphicsExposeEvent-type (fixnum) ( fixnum "XGraphicsExposeEvent_type" )) +(defentry set-XGraphicsExposeEvent-type (fixnum fixnum) ( void "set_XGraphicsExposeEvent_type" )) + + +;;;;;; XNoExposeEvent functions ;;;;;; + +(defentry make-XNoExposeEvent () ( fixnum "make_XNoExposeEvent" )) +(defentry XNoExposeEvent-minor_code (fixnum) ( fixnum "XNoExposeEvent_minor_code" )) +(defentry set-XNoExposeEvent-minor_code (fixnum fixnum) ( void "set_XNoExposeEvent_minor_code" )) +(defentry XNoExposeEvent-major_code (fixnum) ( fixnum "XNoExposeEvent_major_code" )) +(defentry set-XNoExposeEvent-major_code (fixnum fixnum) ( void "set_XNoExposeEvent_major_code" )) +(defentry XNoExposeEvent-drawable (fixnum) ( fixnum "XNoExposeEvent_drawable" )) +(defentry set-XNoExposeEvent-drawable (fixnum fixnum) ( void "set_XNoExposeEvent_drawable" )) +(defentry XNoExposeEvent-display (fixnum) ( fixnum "XNoExposeEvent_display" )) +(defentry set-XNoExposeEvent-display (fixnum fixnum) ( void "set_XNoExposeEvent_display" )) +(defentry XNoExposeEvent-send_event (fixnum) ( fixnum "XNoExposeEvent_send_event" )) +(defentry set-XNoExposeEvent-send_event (fixnum fixnum) ( void "set_XNoExposeEvent_send_event" )) +(defentry XNoExposeEvent-serial (fixnum) ( fixnum "XNoExposeEvent_serial" )) +(defentry set-XNoExposeEvent-serial (fixnum fixnum) ( void "set_XNoExposeEvent_serial" )) +(defentry XNoExposeEvent-type (fixnum) ( fixnum "XNoExposeEvent_type" )) +(defentry set-XNoExposeEvent-type (fixnum fixnum) ( void "set_XNoExposeEvent_type" )) + + +;;;;;; XVisibilityEvent functions ;;;;;; + +(defentry make-XVisibilityEvent () ( fixnum "make_XVisibilityEvent" )) +(defentry XVisibilityEvent-state (fixnum) ( fixnum "XVisibilityEvent_state" )) +(defentry set-XVisibilityEvent-state (fixnum fixnum) ( void "set_XVisibilityEvent_state" )) +(defentry XVisibilityEvent-window (fixnum) ( fixnum "XVisibilityEvent_window" )) +(defentry set-XVisibilityEvent-window (fixnum fixnum) ( void "set_XVisibilityEvent_window" )) +(defentry XVisibilityEvent-display (fixnum) ( fixnum "XVisibilityEvent_display" )) +(defentry set-XVisibilityEvent-display (fixnum fixnum) ( void "set_XVisibilityEvent_display" )) +(defentry XVisibilityEvent-send_event (fixnum) ( fixnum "XVisibilityEvent_send_event" )) +(defentry set-XVisibilityEvent-send_event (fixnum fixnum) ( void "set_XVisibilityEvent_send_event" )) +(defentry XVisibilityEvent-serial (fixnum) ( fixnum "XVisibilityEvent_serial" )) +(defentry set-XVisibilityEvent-serial (fixnum fixnum) ( void "set_XVisibilityEvent_serial" )) +(defentry XVisibilityEvent-type (fixnum) ( fixnum "XVisibilityEvent_type" )) +(defentry set-XVisibilityEvent-type (fixnum fixnum) ( void "set_XVisibilityEvent_type" )) + + +;;;;;; XCreateWindowEvent functions ;;;;;; + +(defentry make-XCreateWindowEvent () ( fixnum "make_XCreateWindowEvent" )) +(defentry XCreateWindowEvent-override_redirect (fixnum) ( fixnum "XCreateWindowEvent_override_redirect" )) +(defentry set-XCreateWindowEvent-override_redirect (fixnum fixnum) ( void "set_XCreateWindowEvent_override_redirect" )) +(defentry XCreateWindowEvent-border_width (fixnum) ( fixnum "XCreateWindowEvent_border_width" )) +(defentry set-XCreateWindowEvent-border_width (fixnum fixnum) ( void "set_XCreateWindowEvent_border_width" )) +(defentry XCreateWindowEvent-height (fixnum) ( fixnum "XCreateWindowEvent_height" )) +(defentry set-XCreateWindowEvent-height (fixnum fixnum) ( void "set_XCreateWindowEvent_height" )) +(defentry XCreateWindowEvent-width (fixnum) ( fixnum "XCreateWindowEvent_width" )) +(defentry set-XCreateWindowEvent-width (fixnum fixnum) ( void "set_XCreateWindowEvent_width" )) +(defentry XCreateWindowEvent-y (fixnum) ( fixnum "XCreateWindowEvent_y" )) +(defentry set-XCreateWindowEvent-y (fixnum fixnum) ( void "set_XCreateWindowEvent_y" )) +(defentry XCreateWindowEvent-x (fixnum) ( fixnum "XCreateWindowEvent_x" )) +(defentry set-XCreateWindowEvent-x (fixnum fixnum) ( void "set_XCreateWindowEvent_x" )) +(defentry XCreateWindowEvent-window (fixnum) ( fixnum "XCreateWindowEvent_window" )) +(defentry set-XCreateWindowEvent-window (fixnum fixnum) ( void "set_XCreateWindowEvent_window" )) +(defentry XCreateWindowEvent-parent (fixnum) ( fixnum "XCreateWindowEvent_parent" )) +(defentry set-XCreateWindowEvent-parent (fixnum fixnum) ( void "set_XCreateWindowEvent_parent" )) +(defentry XCreateWindowEvent-display (fixnum) ( fixnum "XCreateWindowEvent_display" )) +(defentry set-XCreateWindowEvent-display (fixnum fixnum) ( void "set_XCreateWindowEvent_display" )) +(defentry XCreateWindowEvent-send_event (fixnum) ( fixnum "XCreateWindowEvent_send_event" )) +(defentry set-XCreateWindowEvent-send_event (fixnum fixnum) ( void "set_XCreateWindowEvent_send_event" )) +(defentry XCreateWindowEvent-serial (fixnum) ( fixnum "XCreateWindowEvent_serial" )) +(defentry set-XCreateWindowEvent-serial (fixnum fixnum) ( void "set_XCreateWindowEvent_serial" )) +(defentry XCreateWindowEvent-type (fixnum) ( fixnum "XCreateWindowEvent_type" )) +(defentry set-XCreateWindowEvent-type (fixnum fixnum) ( void "set_XCreateWindowEvent_type" )) + + +;;;;;; XDestroyWindowEvent functions ;;;;;; + +(defentry make-XDestroyWindowEvent () ( fixnum "make_XDestroyWindowEvent" )) +(defentry XDestroyWindowEvent-window (fixnum) ( fixnum "XDestroyWindowEvent_window" )) +(defentry set-XDestroyWindowEvent-window (fixnum fixnum) ( void "set_XDestroyWindowEvent_window" )) +(defentry XDestroyWindowEvent-event (fixnum) ( fixnum "XDestroyWindowEvent_event" )) +(defentry set-XDestroyWindowEvent-event (fixnum fixnum) ( void "set_XDestroyWindowEvent_event" )) +(defentry XDestroyWindowEvent-display (fixnum) ( fixnum "XDestroyWindowEvent_display" )) +(defentry set-XDestroyWindowEvent-display (fixnum fixnum) ( void "set_XDestroyWindowEvent_display" )) +(defentry XDestroyWindowEvent-send_event (fixnum) ( fixnum "XDestroyWindowEvent_send_event" )) +(defentry set-XDestroyWindowEvent-send_event (fixnum fixnum) ( void "set_XDestroyWindowEvent_send_event" )) +(defentry XDestroyWindowEvent-serial (fixnum) ( fixnum "XDestroyWindowEvent_serial" )) +(defentry set-XDestroyWindowEvent-serial (fixnum fixnum) ( void "set_XDestroyWindowEvent_serial" )) +(defentry XDestroyWindowEvent-type (fixnum) ( fixnum "XDestroyWindowEvent_type" )) +(defentry set-XDestroyWindowEvent-type (fixnum fixnum) ( void "set_XDestroyWindowEvent_type" )) + + +;;;;;; XUnmapEvent functions ;;;;;; + +(defentry make-XUnmapEvent () ( fixnum "make_XUnmapEvent" )) +(defentry XUnmapEvent-from_configure (fixnum) ( fixnum "XUnmapEvent_from_configure" )) +(defentry set-XUnmapEvent-from_configure (fixnum fixnum) ( void "set_XUnmapEvent_from_configure" )) +(defentry XUnmapEvent-window (fixnum) ( fixnum "XUnmapEvent_window" )) +(defentry set-XUnmapEvent-window (fixnum fixnum) ( void "set_XUnmapEvent_window" )) +(defentry XUnmapEvent-event (fixnum) ( fixnum "XUnmapEvent_event" )) +(defentry set-XUnmapEvent-event (fixnum fixnum) ( void "set_XUnmapEvent_event" )) +(defentry XUnmapEvent-display (fixnum) ( fixnum "XUnmapEvent_display" )) +(defentry set-XUnmapEvent-display (fixnum fixnum) ( void "set_XUnmapEvent_display" )) +(defentry XUnmapEvent-send_event (fixnum) ( fixnum "XUnmapEvent_send_event" )) +(defentry set-XUnmapEvent-send_event (fixnum fixnum) ( void "set_XUnmapEvent_send_event" )) +(defentry XUnmapEvent-serial (fixnum) ( fixnum "XUnmapEvent_serial" )) +(defentry set-XUnmapEvent-serial (fixnum fixnum) ( void "set_XUnmapEvent_serial" )) +(defentry XUnmapEvent-type (fixnum) ( fixnum "XUnmapEvent_type" )) +(defentry set-XUnmapEvent-type (fixnum fixnum) ( void "set_XUnmapEvent_type" )) + + +;;;;;; XMapEvent functions ;;;;;; + +(defentry make-XMapEvent () ( fixnum "make_XMapEvent" )) +(defentry XMapEvent-override_redirect (fixnum) ( fixnum "XMapEvent_override_redirect" )) +(defentry set-XMapEvent-override_redirect (fixnum fixnum) ( void "set_XMapEvent_override_redirect" )) +(defentry XMapEvent-window (fixnum) ( fixnum "XMapEvent_window" )) +(defentry set-XMapEvent-window (fixnum fixnum) ( void "set_XMapEvent_window" )) +(defentry XMapEvent-event (fixnum) ( fixnum "XMapEvent_event" )) +(defentry set-XMapEvent-event (fixnum fixnum) ( void "set_XMapEvent_event" )) +(defentry XMapEvent-display (fixnum) ( fixnum "XMapEvent_display" )) +(defentry set-XMapEvent-display (fixnum fixnum) ( void "set_XMapEvent_display" )) +(defentry XMapEvent-send_event (fixnum) ( fixnum "XMapEvent_send_event" )) +(defentry set-XMapEvent-send_event (fixnum fixnum) ( void "set_XMapEvent_send_event" )) +(defentry XMapEvent-serial (fixnum) ( fixnum "XMapEvent_serial" )) +(defentry set-XMapEvent-serial (fixnum fixnum) ( void "set_XMapEvent_serial" )) +(defentry XMapEvent-type (fixnum) ( fixnum "XMapEvent_type" )) +(defentry set-XMapEvent-type (fixnum fixnum) ( void "set_XMapEvent_type" )) + + +;;;;;; XMapRequestEvent functions ;;;;;; + +(defentry make-XMapRequestEvent () ( fixnum "make_XMapRequestEvent" )) +(defentry XMapRequestEvent-window (fixnum) ( fixnum "XMapRequestEvent_window" )) +(defentry set-XMapRequestEvent-window (fixnum fixnum) ( void "set_XMapRequestEvent_window" )) +(defentry XMapRequestEvent-parent (fixnum) ( fixnum "XMapRequestEvent_parent" )) +(defentry set-XMapRequestEvent-parent (fixnum fixnum) ( void "set_XMapRequestEvent_parent" )) +(defentry XMapRequestEvent-display (fixnum) ( fixnum "XMapRequestEvent_display" )) +(defentry set-XMapRequestEvent-display (fixnum fixnum) ( void "set_XMapRequestEvent_display" )) +(defentry XMapRequestEvent-send_event (fixnum) ( fixnum "XMapRequestEvent_send_event" )) +(defentry set-XMapRequestEvent-send_event (fixnum fixnum) ( void "set_XMapRequestEvent_send_event" )) +(defentry XMapRequestEvent-serial (fixnum) ( fixnum "XMapRequestEvent_serial" )) +(defentry set-XMapRequestEvent-serial (fixnum fixnum) ( void "set_XMapRequestEvent_serial" )) +(defentry XMapRequestEvent-type (fixnum) ( fixnum "XMapRequestEvent_type" )) +(defentry set-XMapRequestEvent-type (fixnum fixnum) ( void "set_XMapRequestEvent_type" )) + + +;;;;;; XReparentEvent functions ;;;;;; + +(defentry make-XReparentEvent () ( fixnum "make_XReparentEvent" )) +(defentry XReparentEvent-override_redirect (fixnum) ( fixnum "XReparentEvent_override_redirect" )) +(defentry set-XReparentEvent-override_redirect (fixnum fixnum) ( void "set_XReparentEvent_override_redirect" )) +(defentry XReparentEvent-y (fixnum) ( fixnum "XReparentEvent_y" )) +(defentry set-XReparentEvent-y (fixnum fixnum) ( void "set_XReparentEvent_y" )) +(defentry XReparentEvent-x (fixnum) ( fixnum "XReparentEvent_x" )) +(defentry set-XReparentEvent-x (fixnum fixnum) ( void "set_XReparentEvent_x" )) +(defentry XReparentEvent-parent (fixnum) ( fixnum "XReparentEvent_parent" )) +(defentry set-XReparentEvent-parent (fixnum fixnum) ( void "set_XReparentEvent_parent" )) +(defentry XReparentEvent-window (fixnum) ( fixnum "XReparentEvent_window" )) +(defentry set-XReparentEvent-window (fixnum fixnum) ( void "set_XReparentEvent_window" )) +(defentry XReparentEvent-event (fixnum) ( fixnum "XReparentEvent_event" )) +(defentry set-XReparentEvent-event (fixnum fixnum) ( void "set_XReparentEvent_event" )) +(defentry XReparentEvent-display (fixnum) ( fixnum "XReparentEvent_display" )) +(defentry set-XReparentEvent-display (fixnum fixnum) ( void "set_XReparentEvent_display" )) +(defentry XReparentEvent-send_event (fixnum) ( fixnum "XReparentEvent_send_event" )) +(defentry set-XReparentEvent-send_event (fixnum fixnum) ( void "set_XReparentEvent_send_event" )) +(defentry XReparentEvent-serial (fixnum) ( fixnum "XReparentEvent_serial" )) +(defentry set-XReparentEvent-serial (fixnum fixnum) ( void "set_XReparentEvent_serial" )) +(defentry XReparentEvent-type (fixnum) ( fixnum "XReparentEvent_type" )) +(defentry set-XReparentEvent-type (fixnum fixnum) ( void "set_XReparentEvent_type" )) + + +;;;;;; XConfigureEvent functions ;;;;;; + +(defentry make-XConfigureEvent () ( fixnum "make_XConfigureEvent" )) +(defentry XConfigureEvent-override_redirect (fixnum) ( fixnum "XConfigureEvent_override_redirect" )) +(defentry set-XConfigureEvent-override_redirect (fixnum fixnum) ( void "set_XConfigureEvent_override_redirect" )) +(defentry XConfigureEvent-above (fixnum) ( fixnum "XConfigureEvent_above" )) +(defentry set-XConfigureEvent-above (fixnum fixnum) ( void "set_XConfigureEvent_above" )) +(defentry XConfigureEvent-border_width (fixnum) ( fixnum "XConfigureEvent_border_width" )) +(defentry set-XConfigureEvent-border_width (fixnum fixnum) ( void "set_XConfigureEvent_border_width" )) +(defentry XConfigureEvent-height (fixnum) ( fixnum "XConfigureEvent_height" )) +(defentry set-XConfigureEvent-height (fixnum fixnum) ( void "set_XConfigureEvent_height" )) +(defentry XConfigureEvent-width (fixnum) ( fixnum "XConfigureEvent_width" )) +(defentry set-XConfigureEvent-width (fixnum fixnum) ( void "set_XConfigureEvent_width" )) +(defentry XConfigureEvent-y (fixnum) ( fixnum "XConfigureEvent_y" )) +(defentry set-XConfigureEvent-y (fixnum fixnum) ( void "set_XConfigureEvent_y" )) +(defentry XConfigureEvent-x (fixnum) ( fixnum "XConfigureEvent_x" )) +(defentry set-XConfigureEvent-x (fixnum fixnum) ( void "set_XConfigureEvent_x" )) +(defentry XConfigureEvent-window (fixnum) ( fixnum "XConfigureEvent_window" )) +(defentry set-XConfigureEvent-window (fixnum fixnum) ( void "set_XConfigureEvent_window" )) +(defentry XConfigureEvent-event (fixnum) ( fixnum "XConfigureEvent_event" )) +(defentry set-XConfigureEvent-event (fixnum fixnum) ( void "set_XConfigureEvent_event" )) +(defentry XConfigureEvent-display (fixnum) ( fixnum "XConfigureEvent_display" )) +(defentry set-XConfigureEvent-display (fixnum fixnum) ( void "set_XConfigureEvent_display" )) +(defentry XConfigureEvent-send_event (fixnum) ( fixnum "XConfigureEvent_send_event" )) +(defentry set-XConfigureEvent-send_event (fixnum fixnum) ( void "set_XConfigureEvent_send_event" )) +(defentry XConfigureEvent-serial (fixnum) ( fixnum "XConfigureEvent_serial" )) +(defentry set-XConfigureEvent-serial (fixnum fixnum) ( void "set_XConfigureEvent_serial" )) +(defentry XConfigureEvent-type (fixnum) ( fixnum "XConfigureEvent_type" )) +(defentry set-XConfigureEvent-type (fixnum fixnum) ( void "set_XConfigureEvent_type" )) + + +;;;;;; XGravityEvent functions ;;;;;; + +(defentry make-XGravityEvent () ( fixnum "make_XGravityEvent" )) +(defentry XGravityEvent-y (fixnum) ( fixnum "XGravityEvent_y" )) +(defentry set-XGravityEvent-y (fixnum fixnum) ( void "set_XGravityEvent_y" )) +(defentry XGravityEvent-x (fixnum) ( fixnum "XGravityEvent_x" )) +(defentry set-XGravityEvent-x (fixnum fixnum) ( void "set_XGravityEvent_x" )) +(defentry XGravityEvent-window (fixnum) ( fixnum "XGravityEvent_window" )) +(defentry set-XGravityEvent-window (fixnum fixnum) ( void "set_XGravityEvent_window" )) +(defentry XGravityEvent-event (fixnum) ( fixnum "XGravityEvent_event" )) +(defentry set-XGravityEvent-event (fixnum fixnum) ( void "set_XGravityEvent_event" )) +(defentry XGravityEvent-display (fixnum) ( fixnum "XGravityEvent_display" )) +(defentry set-XGravityEvent-display (fixnum fixnum) ( void "set_XGravityEvent_display" )) +(defentry XGravityEvent-send_event (fixnum) ( fixnum "XGravityEvent_send_event" )) +(defentry set-XGravityEvent-send_event (fixnum fixnum) ( void "set_XGravityEvent_send_event" )) +(defentry XGravityEvent-serial (fixnum) ( fixnum "XGravityEvent_serial" )) +(defentry set-XGravityEvent-serial (fixnum fixnum) ( void "set_XGravityEvent_serial" )) +(defentry XGravityEvent-type (fixnum) ( fixnum "XGravityEvent_type" )) +(defentry set-XGravityEvent-type (fixnum fixnum) ( void "set_XGravityEvent_type" )) + + +;;;;;; XResizeRequestEvent functions ;;;;;; + +(defentry make-XResizeRequestEvent () ( fixnum "make_XResizeRequestEvent" )) +(defentry XResizeRequestEvent-height (fixnum) ( fixnum "XResizeRequestEvent_height" )) +(defentry set-XResizeRequestEvent-height (fixnum fixnum) ( void "set_XResizeRequestEvent_height" )) +(defentry XResizeRequestEvent-width (fixnum) ( fixnum "XResizeRequestEvent_width" )) +(defentry set-XResizeRequestEvent-width (fixnum fixnum) ( void "set_XResizeRequestEvent_width" )) +(defentry XResizeRequestEvent-window (fixnum) ( fixnum "XResizeRequestEvent_window" )) +(defentry set-XResizeRequestEvent-window (fixnum fixnum) ( void "set_XResizeRequestEvent_window" )) +(defentry XResizeRequestEvent-display (fixnum) ( fixnum "XResizeRequestEvent_display" )) +(defentry set-XResizeRequestEvent-display (fixnum fixnum) ( void "set_XResizeRequestEvent_display" )) +(defentry XResizeRequestEvent-send_event (fixnum) ( fixnum "XResizeRequestEvent_send_event" )) +(defentry set-XResizeRequestEvent-send_event (fixnum fixnum) ( void "set_XResizeRequestEvent_send_event" )) +(defentry XResizeRequestEvent-serial (fixnum) ( fixnum "XResizeRequestEvent_serial" )) +(defentry set-XResizeRequestEvent-serial (fixnum fixnum) ( void "set_XResizeRequestEvent_serial" )) +(defentry XResizeRequestEvent-type (fixnum) ( fixnum "XResizeRequestEvent_type" )) +(defentry set-XResizeRequestEvent-type (fixnum fixnum) ( void "set_XResizeRequestEvent_type" )) + + +;;;;;; XConfigureRequestEvent functions ;;;;;; + +(defentry make-XConfigureRequestEvent () ( fixnum "make_XConfigureRequestEvent" )) +(defentry XConfigureRequestEvent-value_mask (fixnum) ( fixnum "XConfigureRequestEvent_value_mask" )) +(defentry set-XConfigureRequestEvent-value_mask (fixnum fixnum) ( void "set_XConfigureRequestEvent_value_mask" )) +(defentry XConfigureRequestEvent-detail (fixnum) ( fixnum "XConfigureRequestEvent_detail" )) +(defentry set-XConfigureRequestEvent-detail (fixnum fixnum) ( void "set_XConfigureRequestEvent_detail" )) +(defentry XConfigureRequestEvent-above (fixnum) ( fixnum "XConfigureRequestEvent_above" )) +(defentry set-XConfigureRequestEvent-above (fixnum fixnum) ( void "set_XConfigureRequestEvent_above" )) +(defentry XConfigureRequestEvent-border_width (fixnum) ( fixnum "XConfigureRequestEvent_border_width" )) +(defentry set-XConfigureRequestEvent-border_width (fixnum fixnum) ( void "set_XConfigureRequestEvent_border_width" )) +(defentry XConfigureRequestEvent-height (fixnum) ( fixnum "XConfigureRequestEvent_height" )) +(defentry set-XConfigureRequestEvent-height (fixnum fixnum) ( void "set_XConfigureRequestEvent_height" )) +(defentry XConfigureRequestEvent-width (fixnum) ( fixnum "XConfigureRequestEvent_width" )) +(defentry set-XConfigureRequestEvent-width (fixnum fixnum) ( void "set_XConfigureRequestEvent_width" )) +(defentry XConfigureRequestEvent-y (fixnum) ( fixnum "XConfigureRequestEvent_y" )) +(defentry set-XConfigureRequestEvent-y (fixnum fixnum) ( void "set_XConfigureRequestEvent_y" )) +(defentry XConfigureRequestEvent-x (fixnum) ( fixnum "XConfigureRequestEvent_x" )) +(defentry set-XConfigureRequestEvent-x (fixnum fixnum) ( void "set_XConfigureRequestEvent_x" )) +(defentry XConfigureRequestEvent-window (fixnum) ( fixnum "XConfigureRequestEvent_window" )) +(defentry set-XConfigureRequestEvent-window (fixnum fixnum) ( void "set_XConfigureRequestEvent_window" )) +(defentry XConfigureRequestEvent-parent (fixnum) ( fixnum "XConfigureRequestEvent_parent" )) +(defentry set-XConfigureRequestEvent-parent (fixnum fixnum) ( void "set_XConfigureRequestEvent_parent" )) +(defentry XConfigureRequestEvent-display (fixnum) ( fixnum "XConfigureRequestEvent_display" )) +(defentry set-XConfigureRequestEvent-display (fixnum fixnum) ( void "set_XConfigureRequestEvent_display" )) +(defentry XConfigureRequestEvent-send_event (fixnum) ( fixnum "XConfigureRequestEvent_send_event" )) +(defentry set-XConfigureRequestEvent-send_event (fixnum fixnum) ( void "set_XConfigureRequestEvent_send_event" )) +(defentry XConfigureRequestEvent-serial (fixnum) ( fixnum "XConfigureRequestEvent_serial" )) +(defentry set-XConfigureRequestEvent-serial (fixnum fixnum) ( void "set_XConfigureRequestEvent_serial" )) +(defentry XConfigureRequestEvent-type (fixnum) ( fixnum "XConfigureRequestEvent_type" )) +(defentry set-XConfigureRequestEvent-type (fixnum fixnum) ( void "set_XConfigureRequestEvent_type" )) + + +;;;;;; XCirculateEvent functions ;;;;;; + +(defentry make-XCirculateEvent () ( fixnum "make_XCirculateEvent" )) +(defentry XCirculateEvent-place (fixnum) ( fixnum "XCirculateEvent_place" )) +(defentry set-XCirculateEvent-place (fixnum fixnum) ( void "set_XCirculateEvent_place" )) +(defentry XCirculateEvent-window (fixnum) ( fixnum "XCirculateEvent_window" )) +(defentry set-XCirculateEvent-window (fixnum fixnum) ( void "set_XCirculateEvent_window" )) +(defentry XCirculateEvent-event (fixnum) ( fixnum "XCirculateEvent_event" )) +(defentry set-XCirculateEvent-event (fixnum fixnum) ( void "set_XCirculateEvent_event" )) +(defentry XCirculateEvent-display (fixnum) ( fixnum "XCirculateEvent_display" )) +(defentry set-XCirculateEvent-display (fixnum fixnum) ( void "set_XCirculateEvent_display" )) +(defentry XCirculateEvent-send_event (fixnum) ( fixnum "XCirculateEvent_send_event" )) +(defentry set-XCirculateEvent-send_event (fixnum fixnum) ( void "set_XCirculateEvent_send_event" )) +(defentry XCirculateEvent-serial (fixnum) ( fixnum "XCirculateEvent_serial" )) +(defentry set-XCirculateEvent-serial (fixnum fixnum) ( void "set_XCirculateEvent_serial" )) +(defentry XCirculateEvent-type (fixnum) ( fixnum "XCirculateEvent_type" )) +(defentry set-XCirculateEvent-type (fixnum fixnum) ( void "set_XCirculateEvent_type" )) + + +;;;;;; XCirculateRequestEvent functions ;;;;;; + +(defentry make-XCirculateRequestEvent () ( fixnum "make_XCirculateRequestEvent" )) +(defentry XCirculateRequestEvent-place (fixnum) ( fixnum "XCirculateRequestEvent_place" )) +(defentry set-XCirculateRequestEvent-place (fixnum fixnum) ( void "set_XCirculateRequestEvent_place" )) +(defentry XCirculateRequestEvent-window (fixnum) ( fixnum "XCirculateRequestEvent_window" )) +(defentry set-XCirculateRequestEvent-window (fixnum fixnum) ( void "set_XCirculateRequestEvent_window" )) +(defentry XCirculateRequestEvent-parent (fixnum) ( fixnum "XCirculateRequestEvent_parent" )) +(defentry set-XCirculateRequestEvent-parent (fixnum fixnum) ( void "set_XCirculateRequestEvent_parent" )) +(defentry XCirculateRequestEvent-display (fixnum) ( fixnum "XCirculateRequestEvent_display" )) +(defentry set-XCirculateRequestEvent-display (fixnum fixnum) ( void "set_XCirculateRequestEvent_display" )) +(defentry XCirculateRequestEvent-send_event (fixnum) ( fixnum "XCirculateRequestEvent_send_event" )) +(defentry set-XCirculateRequestEvent-send_event (fixnum fixnum) ( void "set_XCirculateRequestEvent_send_event" )) +(defentry XCirculateRequestEvent-serial (fixnum) ( fixnum "XCirculateRequestEvent_serial" )) +(defentry set-XCirculateRequestEvent-serial (fixnum fixnum) ( void "set_XCirculateRequestEvent_serial" )) +(defentry XCirculateRequestEvent-type (fixnum) ( fixnum "XCirculateRequestEvent_type" )) +(defentry set-XCirculateRequestEvent-type (fixnum fixnum) ( void "set_XCirculateRequestEvent_type" )) + + +;;;;;; XPropertyEvent functions ;;;;;; + +(defentry make-XPropertyEvent () ( fixnum "make_XPropertyEvent" )) +(defentry XPropertyEvent-state (fixnum) ( fixnum "XPropertyEvent_state" )) +(defentry set-XPropertyEvent-state (fixnum fixnum) ( void "set_XPropertyEvent_state" )) +(defentry XPropertyEvent-time (fixnum) ( fixnum "XPropertyEvent_time" )) +(defentry set-XPropertyEvent-time (fixnum fixnum) ( void "set_XPropertyEvent_time" )) +(defentry XPropertyEvent-atom (fixnum) ( fixnum "XPropertyEvent_atom" )) +(defentry set-XPropertyEvent-atom (fixnum fixnum) ( void "set_XPropertyEvent_atom" )) +(defentry XPropertyEvent-window (fixnum) ( fixnum "XPropertyEvent_window" )) +(defentry set-XPropertyEvent-window (fixnum fixnum) ( void "set_XPropertyEvent_window" )) +(defentry XPropertyEvent-display (fixnum) ( fixnum "XPropertyEvent_display" )) +(defentry set-XPropertyEvent-display (fixnum fixnum) ( void "set_XPropertyEvent_display" )) +(defentry XPropertyEvent-send_event (fixnum) ( fixnum "XPropertyEvent_send_event" )) +(defentry set-XPropertyEvent-send_event (fixnum fixnum) ( void "set_XPropertyEvent_send_event" )) +(defentry XPropertyEvent-serial (fixnum) ( fixnum "XPropertyEvent_serial" )) +(defentry set-XPropertyEvent-serial (fixnum fixnum) ( void "set_XPropertyEvent_serial" )) +(defentry XPropertyEvent-type (fixnum) ( fixnum "XPropertyEvent_type" )) +(defentry set-XPropertyEvent-type (fixnum fixnum) ( void "set_XPropertyEvent_type" )) + + +;;;;;; XSelectionClearEvent functions ;;;;;; + +(defentry make-XSelectionClearEvent () ( fixnum "make_XSelectionClearEvent" )) +(defentry XSelectionClearEvent-time (fixnum) ( fixnum "XSelectionClearEvent_time" )) +(defentry set-XSelectionClearEvent-time (fixnum fixnum) ( void "set_XSelectionClearEvent_time" )) +(defentry XSelectionClearEvent-selection (fixnum) ( fixnum "XSelectionClearEvent_selection" )) +(defentry set-XSelectionClearEvent-selection (fixnum fixnum) ( void "set_XSelectionClearEvent_selection" )) +(defentry XSelectionClearEvent-window (fixnum) ( fixnum "XSelectionClearEvent_window" )) +(defentry set-XSelectionClearEvent-window (fixnum fixnum) ( void "set_XSelectionClearEvent_window" )) +(defentry XSelectionClearEvent-display (fixnum) ( fixnum "XSelectionClearEvent_display" )) +(defentry set-XSelectionClearEvent-display (fixnum fixnum) ( void "set_XSelectionClearEvent_display" )) +(defentry XSelectionClearEvent-send_event (fixnum) ( fixnum "XSelectionClearEvent_send_event" )) +(defentry set-XSelectionClearEvent-send_event (fixnum fixnum) ( void "set_XSelectionClearEvent_send_event" )) +(defentry XSelectionClearEvent-serial (fixnum) ( fixnum "XSelectionClearEvent_serial" )) +(defentry set-XSelectionClearEvent-serial (fixnum fixnum) ( void "set_XSelectionClearEvent_serial" )) +(defentry XSelectionClearEvent-type (fixnum) ( fixnum "XSelectionClearEvent_type" )) +(defentry set-XSelectionClearEvent-type (fixnum fixnum) ( void "set_XSelectionClearEvent_type" )) + + +;;;;;; XSelectionRequestEvent functions ;;;;;; + +(defentry make-XSelectionRequestEvent () ( fixnum "make_XSelectionRequestEvent" )) +(defentry XSelectionRequestEvent-time (fixnum) ( fixnum "XSelectionRequestEvent_time" )) +(defentry set-XSelectionRequestEvent-time (fixnum fixnum) ( void "set_XSelectionRequestEvent_time" )) +(defentry XSelectionRequestEvent-property (fixnum) ( fixnum "XSelectionRequestEvent_property" )) +(defentry set-XSelectionRequestEvent-property (fixnum fixnum) ( void "set_XSelectionRequestEvent_property" )) +(defentry XSelectionRequestEvent-target (fixnum) ( fixnum "XSelectionRequestEvent_target" )) +(defentry set-XSelectionRequestEvent-target (fixnum fixnum) ( void "set_XSelectionRequestEvent_target" )) +(defentry XSelectionRequestEvent-selection (fixnum) ( fixnum "XSelectionRequestEvent_selection" )) +(defentry set-XSelectionRequestEvent-selection (fixnum fixnum) ( void "set_XSelectionRequestEvent_selection" )) +(defentry XSelectionRequestEvent-requestor (fixnum) ( fixnum "XSelectionRequestEvent_requestor" )) +(defentry set-XSelectionRequestEvent-requestor (fixnum fixnum) ( void "set_XSelectionRequestEvent_requestor" )) +(defentry XSelectionRequestEvent-owner (fixnum) ( fixnum "XSelectionRequestEvent_owner" )) +(defentry set-XSelectionRequestEvent-owner (fixnum fixnum) ( void "set_XSelectionRequestEvent_owner" )) +(defentry XSelectionRequestEvent-display (fixnum) ( fixnum "XSelectionRequestEvent_display" )) +(defentry set-XSelectionRequestEvent-display (fixnum fixnum) ( void "set_XSelectionRequestEvent_display" )) +(defentry XSelectionRequestEvent-send_event (fixnum) ( fixnum "XSelectionRequestEvent_send_event" )) +(defentry set-XSelectionRequestEvent-send_event (fixnum fixnum) ( void "set_XSelectionRequestEvent_send_event" )) +(defentry XSelectionRequestEvent-serial (fixnum) ( fixnum "XSelectionRequestEvent_serial" )) +(defentry set-XSelectionRequestEvent-serial (fixnum fixnum) ( void "set_XSelectionRequestEvent_serial" )) +(defentry XSelectionRequestEvent-type (fixnum) ( fixnum "XSelectionRequestEvent_type" )) +(defentry set-XSelectionRequestEvent-type (fixnum fixnum) ( void "set_XSelectionRequestEvent_type" )) + + +;;;;;; XSelectionEvent functions ;;;;;; + +(defentry make-XSelectionEvent () ( fixnum "make_XSelectionEvent" )) +(defentry XSelectionEvent-time (fixnum) ( fixnum "XSelectionEvent_time" )) +(defentry set-XSelectionEvent-time (fixnum fixnum) ( void "set_XSelectionEvent_time" )) +(defentry XSelectionEvent-property (fixnum) ( fixnum "XSelectionEvent_property" )) +(defentry set-XSelectionEvent-property (fixnum fixnum) ( void "set_XSelectionEvent_property" )) +(defentry XSelectionEvent-target (fixnum) ( fixnum "XSelectionEvent_target" )) +(defentry set-XSelectionEvent-target (fixnum fixnum) ( void "set_XSelectionEvent_target" )) +(defentry XSelectionEvent-selection (fixnum) ( fixnum "XSelectionEvent_selection" )) +(defentry set-XSelectionEvent-selection (fixnum fixnum) ( void "set_XSelectionEvent_selection" )) +(defentry XSelectionEvent-requestor (fixnum) ( fixnum "XSelectionEvent_requestor" )) +(defentry set-XSelectionEvent-requestor (fixnum fixnum) ( void "set_XSelectionEvent_requestor" )) +(defentry XSelectionEvent-display (fixnum) ( fixnum "XSelectionEvent_display" )) +(defentry set-XSelectionEvent-display (fixnum fixnum) ( void "set_XSelectionEvent_display" )) +(defentry XSelectionEvent-send_event (fixnum) ( fixnum "XSelectionEvent_send_event" )) +(defentry set-XSelectionEvent-send_event (fixnum fixnum) ( void "set_XSelectionEvent_send_event" )) +(defentry XSelectionEvent-serial (fixnum) ( fixnum "XSelectionEvent_serial" )) +(defentry set-XSelectionEvent-serial (fixnum fixnum) ( void "set_XSelectionEvent_serial" )) +(defentry XSelectionEvent-type (fixnum) ( fixnum "XSelectionEvent_type" )) +(defentry set-XSelectionEvent-type (fixnum fixnum) ( void "set_XSelectionEvent_type" )) + + +;;;;;; XColormapEvent functions ;;;;;; + +(defentry make-XColormapEvent () ( fixnum "make_XColormapEvent" )) +(defentry XColormapEvent-state (fixnum) ( fixnum "XColormapEvent_state" )) +(defentry set-XColormapEvent-state (fixnum fixnum) ( void "set_XColormapEvent_state" )) +(defentry XColormapEvent-new (fixnum) ( fixnum "XColormapEvent_new" )) +(defentry set-XColormapEvent-new (fixnum fixnum) ( void "set_XColormapEvent_new" )) +(defentry XColormapEvent-colormap (fixnum) ( fixnum "XColormapEvent_colormap" )) +(defentry set-XColormapEvent-colormap (fixnum fixnum) ( void "set_XColormapEvent_colormap" )) +(defentry XColormapEvent-window (fixnum) ( fixnum "XColormapEvent_window" )) +(defentry set-XColormapEvent-window (fixnum fixnum) ( void "set_XColormapEvent_window" )) +(defentry XColormapEvent-display (fixnum) ( fixnum "XColormapEvent_display" )) +(defentry set-XColormapEvent-display (fixnum fixnum) ( void "set_XColormapEvent_display" )) +(defentry XColormapEvent-send_event (fixnum) ( fixnum "XColormapEvent_send_event" )) +(defentry set-XColormapEvent-send_event (fixnum fixnum) ( void "set_XColormapEvent_send_event" )) +(defentry XColormapEvent-serial (fixnum) ( fixnum "XColormapEvent_serial" )) +(defentry set-XColormapEvent-serial (fixnum fixnum) ( void "set_XColormapEvent_serial" )) +(defentry XColormapEvent-type (fixnum) ( fixnum "XColormapEvent_type" )) +(defentry set-XColormapEvent-type (fixnum fixnum) ( void "set_XColormapEvent_type" )) + + +;;;;;; XClientMessageEvent functions ;;;;;; + +(defentry make-XClientMessageEvent () ( fixnum "make_XClientMessageEvent" )) +(defentry XClientMessageEvent-format (fixnum) ( fixnum "XClientMessageEvent_format" )) +(defentry set-XClientMessageEvent-format (fixnum fixnum) ( void "set_XClientMessageEvent_format" )) +(defentry XClientMessageEvent-message_type (fixnum) ( fixnum "XClientMessageEvent_message_type" )) +(defentry set-XClientMessageEvent-message_type (fixnum fixnum) ( void "set_XClientMessageEvent_message_type" )) +(defentry XClientMessageEvent-window (fixnum) ( fixnum "XClientMessageEvent_window" )) +(defentry set-XClientMessageEvent-window (fixnum fixnum) ( void "set_XClientMessageEvent_window" )) +(defentry XClientMessageEvent-display (fixnum) ( fixnum "XClientMessageEvent_display" )) +(defentry set-XClientMessageEvent-display (fixnum fixnum) ( void "set_XClientMessageEvent_display" )) +(defentry XClientMessageEvent-send_event (fixnum) ( fixnum "XClientMessageEvent_send_event" )) +(defentry set-XClientMessageEvent-send_event (fixnum fixnum) ( void "set_XClientMessageEvent_send_event" )) +(defentry XClientMessageEvent-serial (fixnum) ( fixnum "XClientMessageEvent_serial" )) +(defentry set-XClientMessageEvent-serial (fixnum fixnum) ( void "set_XClientMessageEvent_serial" )) +(defentry XClientMessageEvent-type (fixnum) ( fixnum "XClientMessageEvent_type" )) +(defentry set-XClientMessageEvent-type (fixnum fixnum) ( void "set_XClientMessageEvent_type" )) + + +;;;;;; XMappingEvent functions ;;;;;; + +(defentry make-XMappingEvent () ( fixnum "make_XMappingEvent" )) +(defentry XMappingEvent-count (fixnum) ( fixnum "XMappingEvent_count" )) +(defentry set-XMappingEvent-count (fixnum fixnum) ( void "set_XMappingEvent_count" )) +(defentry XMappingEvent-first_keycode (fixnum) ( fixnum "XMappingEvent_first_keycode" )) +(defentry set-XMappingEvent-first_keycode (fixnum fixnum) ( void "set_XMappingEvent_first_keycode" )) +(defentry XMappingEvent-request (fixnum) ( fixnum "XMappingEvent_request" )) +(defentry set-XMappingEvent-request (fixnum fixnum) ( void "set_XMappingEvent_request" )) +(defentry XMappingEvent-window (fixnum) ( fixnum "XMappingEvent_window" )) +(defentry set-XMappingEvent-window (fixnum fixnum) ( void "set_XMappingEvent_window" )) +(defentry XMappingEvent-display (fixnum) ( fixnum "XMappingEvent_display" )) +(defentry set-XMappingEvent-display (fixnum fixnum) ( void "set_XMappingEvent_display" )) +(defentry XMappingEvent-send_event (fixnum) ( fixnum "XMappingEvent_send_event" )) +(defentry set-XMappingEvent-send_event (fixnum fixnum) ( void "set_XMappingEvent_send_event" )) +(defentry XMappingEvent-serial (fixnum) ( fixnum "XMappingEvent_serial" )) +(defentry set-XMappingEvent-serial (fixnum fixnum) ( void "set_XMappingEvent_serial" )) +(defentry XMappingEvent-type (fixnum) ( fixnum "XMappingEvent_type" )) +(defentry set-XMappingEvent-type (fixnum fixnum) ( void "set_XMappingEvent_type" )) + + +;;;;;; XErrorEvent functions ;;;;;; + +(defentry make-XErrorEvent () ( fixnum "make_XErrorEvent" )) +(defentry XErrorEvent-minor_code (fixnum) ( char "XErrorEvent_minor_code" )) +(defentry set-XErrorEvent-minor_code (fixnum char) ( void "set_XErrorEvent_minor_code" )) +(defentry XErrorEvent-request_code (fixnum) ( char "XErrorEvent_request_code" )) +(defentry set-XErrorEvent-request_code (fixnum char) ( void "set_XErrorEvent_request_code" )) +(defentry XErrorEvent-error_code (fixnum) ( char "XErrorEvent_error_code" )) +(defentry set-XErrorEvent-error_code (fixnum char) ( void "set_XErrorEvent_error_code" )) +(defentry XErrorEvent-serial (fixnum) ( fixnum "XErrorEvent_serial" )) +(defentry set-XErrorEvent-serial (fixnum fixnum) ( void "set_XErrorEvent_serial" )) +(defentry XErrorEvent-resourceid (fixnum) ( fixnum "XErrorEvent_resourceid" )) +(defentry set-XErrorEvent-resourceid (fixnum fixnum) ( void "set_XErrorEvent_resourceid" )) +(defentry XErrorEvent-display (fixnum) ( fixnum "XErrorEvent_display" )) +(defentry set-XErrorEvent-display (fixnum fixnum) ( void "set_XErrorEvent_display" )) +(defentry XErrorEvent-type (fixnum) ( fixnum "XErrorEvent_type" )) +(defentry set-XErrorEvent-type (fixnum fixnum) ( void "set_XErrorEvent_type" )) + + +;;;;;; XAnyEvent functions ;;;;;; + +(defentry make-XAnyEvent () ( fixnum "make_XAnyEvent" )) +(defentry XAnyEvent-window (fixnum) ( fixnum "XAnyEvent_window" )) +(defentry set-XAnyEvent-window (fixnum fixnum) ( void "set_XAnyEvent_window" )) +(defentry XAnyEvent-display (fixnum) ( fixnum "XAnyEvent_display" )) +(defentry set-XAnyEvent-display (fixnum fixnum) ( void "set_XAnyEvent_display" )) +(defentry XAnyEvent-send_event (fixnum) ( fixnum "XAnyEvent_send_event" )) +(defentry set-XAnyEvent-send_event (fixnum fixnum) ( void "set_XAnyEvent_send_event" )) +(defentry XAnyEvent-serial (fixnum) ( fixnum "XAnyEvent_serial" )) +(defentry set-XAnyEvent-serial (fixnum fixnum) ( void "set_XAnyEvent_serial" )) +(defentry XAnyEvent-type (fixnum) ( fixnum "XAnyEvent_type" )) +(defentry set-XAnyEvent-type (fixnum fixnum) ( void "set_XAnyEvent_type" )) + + +;;;;;; XEvent functions ;;;;;; + +(defentry make-XEvent () ( fixnum "make_XEvent" )) +;;(defentry XEvent-pad[24] (fixnum) ( fixnum "XEvent_pad[24]" )) +;;(defentry set-XEvent-pad[24] (fixnum fixnum) ( void "set_XEvent_pad[24]" )) +;;(defentry XEvent-xkeymap (fixnum) ( XKeymapEvent "XEvent_xkeymap" )) +;;(defentry set-XEvent-xkeymap (fixnum XKeymapEvent) ( void "set_XEvent_xkeymap" )) +;;(defentry XEvent-xerror (fixnum) ( XErrorEvent "XEvent_xerror" )) +;;(defentry set-XEvent-xerror (fixnum XErrorEvent) ( void "set_XEvent_xerror" )) +;;(defentry XEvent-xmapping (fixnum) ( XMappingEvent "XEvent_xmapping" )) +;;(defentry set-XEvent-xmapping (fixnum XMappingEvent) ( void "set_XEvent_xmapping" )) +;;(defentry XEvent-xclient (fixnum) ( XClientMessageEvent "XEvent_xclient" )) +;;(defentry set-XEvent-xclient (fixnum XClientMessageEvent) ( void "set_XEvent_xclient" )) +;;(defentry XEvent-xcolormap (fixnum) ( XColormapEvent "XEvent_xcolormap" )) +;;(defentry set-XEvent-xcolormap (fixnum XColormapEvent) ( void "set_XEvent_xcolormap" )) +;;(defentry XEvent-xselection (fixnum) ( XSelectionEvent "XEvent_xselection" )) +;;(defentry set-XEvent-xselection (fixnum XSelectionEvent) ( void "set_XEvent_xselection" )) +;;(defentry XEvent-xselectionrequest (fixnum) ( XSelectionRequestEvent "XEvent_xselectionrequest" )) +;;(defentry set-XEvent-xselectionrequest (fixnum XSelectionRequestEvent) ( void "set_XEvent_xselectionrequest" )) +;;(defentry XEvent-xselectionclear (fixnum) ( XSelectionClearEvent "XEvent_xselectionclear" )) +;;(defentry set-XEvent-xselectionclear (fixnum XSelectionClearEvent) ( void "set_XEvent_xselectionclear" )) +;;(defentry XEvent-xproperty (fixnum) ( XPropertyEvent "XEvent_xproperty" )) +;;(defentry set-XEvent-xproperty (fixnum XPropertyEvent) ( void "set_XEvent_xproperty" )) +;;(defentry XEvent-xcirculaterequest (fixnum) ( XCirculateRequestEvent "XEvent_xcirculaterequest" )) +;;(defentry set-XEvent-xcirculaterequest (fixnum XCirculateRequestEvent) ( void "set_XEvent_xcirculaterequest" )) +;;(defentry XEvent-xcirculate (fixnum) ( XCirculateEvent "XEvent_xcirculate" )) +;;(defentry set-XEvent-xcirculate (fixnum XCirculateEvent) ( void "set_XEvent_xcirculate" )) +;;(defentry XEvent-xconfigurerequest (fixnum) ( XConfigureRequestEvent "XEvent_xconfigurerequest" )) +;;(defentry set-XEvent-xconfigurerequest (fixnum XConfigureRequestEvent) ( void "set_XEvent_xconfigurerequest" )) +;;(defentry XEvent-xresizerequest (fixnum) ( XResizeRequestEvent "XEvent_xresizerequest" )) +;;(defentry set-XEvent-xresizerequest (fixnum XResizeRequestEvent) ( void "set_XEvent_xresizerequest" )) +;;(defentry XEvent-xgravity (fixnum) ( XGravityEvent "XEvent_xgravity" )) +;;(defentry set-XEvent-xgravity (fixnum XGravityEvent) ( void "set_XEvent_xgravity" )) +;;(defentry XEvent-xconfigure (fixnum) ( XConfigureEvent "XEvent_xconfigure" )) +;;(defentry set-XEvent-xconfigure (fixnum XConfigureEvent) ( void "set_XEvent_xconfigure" )) +;;(defentry XEvent-xreparent (fixnum) ( XReparentEvent "XEvent_xreparent" )) +;;(defentry set-XEvent-xreparent (fixnum XReparentEvent) ( void "set_XEvent_xreparent" )) +;;(defentry XEvent-xmaprequest (fixnum) ( XMapRequestEvent "XEvent_xmaprequest" )) +;;(defentry set-XEvent-xmaprequest (fixnum XMapRequestEvent) ( void "set_XEvent_xmaprequest" )) +;;(defentry XEvent-xmap (fixnum) ( XMapEvent "XEvent_xmap" )) +;;(defentry set-XEvent-xmap (fixnum XMapEvent) ( void "set_XEvent_xmap" )) +;;(defentry XEvent-xunmap (fixnum) ( XUnmapEvent "XEvent_xunmap" )) +;;(defentry set-XEvent-xunmap (fixnum XUnmapEvent) ( void "set_XEvent_xunmap" )) +;;(defentry XEvent-xdestroywindow (fixnum) ( XDestroyWindowEvent "XEvent_xdestroywindow" )) +;;(defentry set-XEvent-xdestroywindow (fixnum XDestroyWindowEvent) ( void "set_XEvent_xdestroywindow" )) +;;(defentry XEvent-xcreatewindow (fixnum) ( XCreateWindowEvent "XEvent_xcreatewindow" )) +;;(defentry set-XEvent-xcreatewindow (fixnum XCreateWindowEvent) ( void "set_XEvent_xcreatewindow" )) +;;(defentry XEvent-xvisibility (fixnum) ( XVisibilityEvent "XEvent_xvisibility" )) +;;(defentry set-XEvent-xvisibility (fixnum XVisibilityEvent) ( void "set_XEvent_xvisibility" )) +;;(defentry XEvent-xnoexpose (fixnum) ( XNoExposeEvent "XEvent_xnoexpose" )) +;;(defentry set-XEvent-xnoexpose (fixnum XNoExposeEvent) ( void "set_XEvent_xnoexpose" )) +;;(defentry XEvent-xgraphicsexpose (fixnum) ( XGraphicsExposeEvent "XEvent_xgraphicsexpose" )) +;;(defentry set-XEvent-xgraphicsexpose (fixnum XGraphicsExposeEvent) ( void "set_XEvent_xgraphicsexpose" )) +;;(defentry XEvent-xexpose (fixnum) ( XExposeEvent "XEvent_xexpose" )) +;;(defentry set-XEvent-xexpose (fixnum XExposeEvent) ( void "set_XEvent_xexpose" )) +;;(defentry XEvent-xfocus (fixnum) ( XFocusChangeEvent "XEvent_xfocus" )) +;;(defentry set-XEvent-xfocus (fixnum XFocusChangeEvent) ( void "set_XEvent_xfocus" )) +;;(defentry XEvent-xcrossing (fixnum) ( XCrossingEvent "XEvent_xcrossing" )) +;;(defentry set-XEvent-xcrossing (fixnum XCrossingEvent) ( void "set_XEvent_xcrossing" )) +;;(defentry XEvent-xmotion (fixnum) ( XMotionEvent "XEvent_xmotion" )) +;;(defentry set-XEvent-xmotion (fixnum XMotionEvent) ( void "set_XEvent_xmotion" )) +;;(defentry XEvent-xbutton (fixnum) ( XButtonEvent "XEvent_xbutton" )) +;;(defentry set-XEvent-xbutton (fixnum XButtonEvent) ( void "set_XEvent_xbutton" )) +;;(defentry XEvent-xkey (fixnum) ( XKeyEvent "XEvent_xkey" )) +;;(defentry set-XEvent-xkey (fixnum XKeyEvent) ( void "set_XEvent_xkey" )) +;;(defentry XEvent-xany (fixnum) ( XAnyEvent "XEvent_xany" )) +;;(defentry set-XEvent-xany (fixnum XAnyEvent) ( void "set_XEvent_xany" )) +;;(defentry XEvent-type (fixnum) ( fixnum "XEvent_type" )) +;;(defentry set-XEvent-type (fixnum fixnum) ( void "set_XEvent_type" )) + + diff --git a/xgcl-2/gcl_dispatch-events.lsp b/xgcl-2/gcl_dispatch-events.lsp new file mode 100644 index 0000000..872381a --- /dev/null +++ b/xgcl-2/gcl_dispatch-events.lsp @@ -0,0 +1,50 @@ +(in-package :XLIB) +; dispatch-events.lsp Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + + +;;have to make each type have it's own eventlist +;;and eventmask +(defun dispatch-events () + (setq *exit* nil) + (mapcar #'(lambda (x) + (Xsync x 1)) + *display-list*) + (do ((window nil) + (call-back-fn nil) + (type nil)) + (*exit*) + (dolist (a-display *display-list*) + (unless (= (XPending a-display) 0) + (XNextEvent a-display *default-event*) + (setq type (XAnyEvent-type *default-event*)) + (setq window + (gethash (XAnyEvent-window *default-event*) + *window-table*)) + (setq call-back-fns + (rest (assoc type (slot-value window 'eventlist)))) + (if call-back-fns + (dolist (call-back-fn call-back-fns) + (eval `(,call-back-fn ',window)))))))) + + diff --git a/xgcl-2/gcl_draw-gates.lsp b/xgcl-2/gcl_draw-gates.lsp new file mode 100644 index 0000000..52b004a --- /dev/null +++ b/xgcl-2/gcl_draw-gates.lsp @@ -0,0 +1,101 @@ +; draw-gates.lsp Gordon S. Novak Jr. 20 Oct 94 + +; Copyright (c) 1995 Gordon S. Novak Jr. and The University of Texas at Austin. + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + +(defun draw-nand (w x y) + (window-draw-arc-xy w (+ x 24) (+ y 16) 16 16 -90 180) + (window-draw-circle-xy w (+ x 45) (+ y 16) 4) + (window-draw-line-xy w (+ x 24) (+ y 32) x (+ y 32)) + (window-draw-line-xy w x (+ y 32) x y) + (window-draw-line-xy w x y (+ x 24) y) + (window-force-output w)) + +(setf (get 'nand 'picmenu-spec) + '(picmenu-spec 52 32 ((in1 (0 26)) (in2 (0 6)) (out (50 16))) t + draw-nand 9x15)) + +(defun draw-and (w x y) + (window-draw-arc-xy w (+ x 24) (+ y 16) 16 16 -90 180) + (window-draw-line-xy w (+ x 24) (+ y 32) x (+ y 32)) + (window-draw-line-xy w x (+ y 32) x y) + (window-draw-line-xy w x y (+ x 24) y) + (window-force-output w)) + +(setf (get 'and 'picmenu-spec) + '(picmenu-spec 40 32 ((in1 (0 26)) (in2 (0 6)) (out (40 16))) t + draw-and 9x15)) + +(defun draw-not (w x y) + (window-draw-line-xy w x (+ y 24) (+ x 21) (+ y 12)) + (window-draw-line-xy w x y (+ x 21) (+ y 12)) + (window-draw-line-xy w x y x (+ y 24)) + (window-draw-circle-xy w (+ x 23) (+ y 12) 3) + (window-force-output w)) + +(setf (get 'not 'picmenu-spec) + '(picmenu-spec 27 24 ((in (0 12)) (out (27 12))) t + draw-not 9x15)) + +(defun draw-or (w x y) + (window-draw-arc-xy w x (- y 26) 58 58 46.4 43.6) + (window-draw-arc-xy w x (+ y 58) 58 58 270.0 43.6) + (window-draw-arc-xy w (- x 16) (+ y 16) 23 23 315 90) + (window-force-output w) ) + +(setf (get 'or 'picmenu-spec) + '(picmenu-spec 40 32 ((in1 (6 26)) (in2 (6 6)) (out (40 16))) t + draw-or 9x15)) + +(defun draw-xor (w x y) + (window-draw-arc-xy w (- x 16) (+ y 16) 23 23 315 90) + (draw-or w (+ x 6) y))) + +(setf (get 'xor 'picmenu-spec) + '(picmenu-spec 46 32 ((in1 (6 26)) (in2 (6 6)) (out (46 16))) t + draw-xor 9x15)) + +(defun draw-nor (w x y) + (window-draw-circle-xy w (+ x 44) (+ y 16) 4) + (draw-or w x y))) + +(setf (get 'nor 'picmenu-spec) + '(picmenu-spec 48 32 ((in1 (0 26)) (in2 (0 6)) (out (48 16))) t + draw-nor 9x15)) + + +(defun draw-nor2 (w x y) + (window-draw-circle-xy w (+ x 4) (+ y 6) 4) + (window-draw-circle-xy w (+ x 4) (+ y 26) 4) + (draw-and w (+ x 8) y))) + +(setf (get 'nor2 'picmenu-spec) + '(picmenu-spec 48 32 ((in1 (0 26)) (in2 (0 6)) (out (48 16))) t + draw-nor2 9x15)) + +(defun draw-nand2 (w x y) + (window-draw-circle-xy w (+ x 4) (+ y 6) 4) + (window-draw-circle-xy w (+ x 4) (+ y 26) 4) + (draw-or w (+ x 4) y))) + +(setf (get 'nand2 'picmenu-spec) + '(picmenu-spec 44 32 ((in1 (0 26)) (in2 (0 6)) (out (44 16))) t + draw-nand2 9x15)) diff --git a/xgcl-2/gcl_draw.lsp b/xgcl-2/gcl_draw.lsp new file mode 100644 index 0000000..662698f --- /dev/null +++ b/xgcl-2/gcl_draw.lsp @@ -0,0 +1,1089 @@ +; draw.lsp Gordon S. Novak Jr. ; 06 Dec 07 + +; Functions to make drawings interactively + +; Copyright (c) 2007 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 11 Nov 94; 05 Jan 95; 15 Jan 98; 09 Feb 99; 04 Dec 00; 28 Feb 02; 05 Jan 04 +; 27 Jan 06 + +; See the file gnu.license + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + + +; Use (draw 'foo) to make a drawing named foo. +; When finished with the drawing, give commands "Origin - to zero", "Program". +; This will produce a program (DRAW-FOO w x y) to make the drawing. +; The LaTex command will print Latex input to make the drawing +; (but LaTex cannot draw things as well as the draw program). +; (draw-output &optional names) will save things in a file for later. + +; The small square in the drawing menu is a "button" for picture menus. +; If buttons are used, a picmenu-spec will be produced with the program. + +(defvar *draw-window* nil) +(defvar *draw-window-width* 600) +(defvar *draw-window-height* 600) +(defvar *draw-leave-window* nil) ; t to leave window displayed at end +(defvar *draw-menu-set* nil) +(defvar *draw-zero-vector* '(0 0) ) +(defvar *draw-latex-factor* 1) ; multiplier from pixels to LaTex +(defvar *draw-snap-flag* t) +(defvar *draw-objects* nil) +(defvar *draw-latex-mode* nil) + +(glispglobals (*draw-window* window) ) + +(defmacro draw-descr (name) `(get ,name 'draw-descr)) + +(glispobjects + +(draw-desc (listobject (name symbol) + (objects (listof draw-object)) + (offset vector) + (size vector)) + prop ((fnname draw-desc-fnname) + (refpt draw-desc-refpt)) + msg ((draw draw-desc-draw) + (snap draw-desc-snap) + (find draw-desc-find) + (delete draw-desc-delete)) ) + +(draw-object (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + default ((linewidth 1)) + prop ((region ((virtual region with start = offset size = size))) + (vregion ((virtual region with start = vstart size = vsize))) + (vstart ((virtual vector with + x = (min (x offset) ((x offset) + (x size))) - 2 + y = (min (y offset) ((y offset) + (y size))) - 2))) + (vsize ((virtual vector with x = (abs (x size)) + 4 + y = (abs (y size)) + 4))) ) + msg ((erase draw-object-erase) + (draw draw-object-draw) + (snap draw-object-snap) + (selectedp draw-object-selectedp) + (move draw-object-move)) ) + +(draw-line (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + prop ((line ((virtual line-segment with p1 = offset + p2 = (offset + size))))) + msg ((draw draw-line-draw) + (snap draw-line-snap) + (selectedp draw-line-selectedp) ) + supers (draw-object) ) + +(draw-arrow (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + prop ((line ((virtual line-segment with p1 = offset + p2 = (offset + size))))) + msg ((draw draw-arrow-draw) + (snap draw-line-snap) + (selectedp draw-line-selectedp) ) + supers (draw-object) ) + +(draw-box (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-box-draw) + (snap draw-box-snap) + (selectedp draw-box-selectedp) ) + supers (draw-object) ) + +(draw-rcbox (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-rcbox-draw) + (snap draw-rcbox-snap) + (selectedp draw-rcbox-selectedp) ) + supers (draw-object) ) + +(draw-erase (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-erase-draw) + (snap draw-no-snap) + (selectedp draw-erase-selectedp) ) + supers (draw-object) ) + +(draw-circle (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + prop ((radius ((x size) / 2)) + (center (offset + size / 2))) + msg ((draw draw-circle-draw) + (snap draw-circle-snap) + (selectedp draw-circle-selectedp) ) + supers (draw-object) ) + +(draw-ellipse (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + prop ((radiusx ((x size) / 2)) + (radiusy ((y size) / 2)) + (radius ((max radiusx radiusy))) + (center (offset + size / 2)) + (delta ((sqrt (abs (radiusx ^ 2 - radiusy ^ 2))))) + (p1 ((if (radiusx > radiusy) ; 05 Jan 04 + (a vector x = (x center) - delta + y = (y center)) + (a vector x = (x center) + y = (y center) - delta)))) + (p2 ((if (radiusx > radiusy) + (a vector x = (x center) + delta + y = (y center)) + (a vector x = (x center) + y = (y center) + delta)))) ) + msg ((draw draw-ellipse-draw) + (snap draw-ellipse-snap) + (selectedp draw-ellipse-selectedp) ) + supers (draw-object) ) + +(draw-dot (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-dot-draw) + (snap draw-dot-snap) + (selectedp draw-button-selectedp) ) + supers (draw-object) ) + +(draw-button (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-button-draw) + (snap draw-dot-snap) + (selectedp draw-button-selectedp) ) + supers (draw-object) ) + +(draw-text (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-text-draw) + (snap draw-no-snap) + (selectedp draw-text-selectedp) ) + supers (draw-object) ) + +; null object: no image, cannot be selected. +(draw-null (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-null-draw) + (snap draw-no-snap) + (selectedp draw-null-selectedp) ) + supers (draw-object) ) + +(draw-refpt (listobject (offset vector) + (size vector) + (contents anything) + (linewidth integer)) + msg ((draw draw-refpt-draw) + (snap draw-refpt-snap) + (selectedp draw-refpt-selectedp) ) + supers (draw-object) ) + +; multi-item drawing group +(draw-multi (listobject (offset vector) + (size vector) + (contents (listof draw-object)) + (linewidth integer)) + msg ((draw draw-multi-draw) + (snap draw-no-snap) + (selectedp draw-multi-selectedp) ) + supers (draw-object) ) + + +) ; glispobjects + +; 05 Jan 04 +; Get drawing description associated with name +(gldefun draw-desc ((name symbol)) + (result draw-desc) + (let ((dd draw-desc)) + (dd = (draw-descr name)) + (if ~ dd (progn (dd = (a draw-desc with name = name)) + (setf (draw-descr name) dd))) + dd)) + +; Make a window to draw in. +(setf (glfnresulttype 'draw-window) 'window) +(defun draw-window () + (or *draw-window* + (setq *draw-window* + (window-create *draw-window-width* *draw-window-height* + "Draw window"))) ) + +; 09 Sep 92; 11 Sep 92; 14 Sep 92; 16 Sep 92; 21 Oct 92; 21 May 93; 17 Dec 93 +; 05 Jan 04 +(gldefun draw ((name symbol)) + (let (w dd done sel (redraw t) (new draw-object)) + (w = (draw-window)) + (open w) + (or *draw-menu-set* (draw-init-menus)) + (dd = (draw-desc name)) + (unless (member name *draw-objects*) + (setq *draw-objects* (nconc *draw-objects* (list name)))) + (draw dd w) + (while ~ done do + (sel = (menu-set-select *draw-menu-set* redraw)) + (redraw = nil) + (case (menu-name sel) + (command + (case (port sel) + (done (done = t)) + (move (draw-desc-move dd w)) + (delete (draw-desc-delete dd w)) + (copy (draw-desc-copy dd w)) + (redraw (clear w) + (setq redraw t) + (draw dd w)) + (origin (draw-desc-origin dd w) + (clear w) + (setq redraw t) + (draw dd w)) + (program (draw-desc-program dd)) + (latex (draw-desc-latex dd)) + (latexmode (setq *draw-latex-mode* (not *draw-latex-mode*)) + (format t "Latex Mode is now ~A~%" *draw-latex-mode*)) + )) + (draw + (new = nil) + (case (port sel) + (rectangle (new = (draw-box-get dd w))) + (rcbox (new = (draw-rcbox-get dd w))) + (circle (new = (draw-circle-get dd w))) + (ellipse (new = (draw-ellipse-get dd w))) + (line (new = (draw-line-get dd w))) + (arrow (new = (draw-arrow-get dd w))) + (dot (new = (draw-dot-get dd w))) + (erase (new = (draw-erase-get dd w))) + (button (new = (draw-button-get dd w))) + (text (new = (draw-text-get dd w))) + (refpt (new = (draw-refpt-get dd w)))) + (if new + (progn ((offset new) _- (offset dd)) + ((objects dd) _+ new) + (draw new w (offset dd))))) + (background nil)) ) + (setf (draw-descr name) dd) + (unless *draw-leave-window* (close w)) + name )) + +; 06 Dec 07 +; Copy a draw description to another name +(defun copy-draw-desc (from to) + (let (old) + (setq old (copy-tree (get from 'draw-descr))) + (setf (get to 'draw-descr) + (cons (car old) (cons to (cddr old))) ) )) + +; 09 Sep 92 +(gldefun draw-desc-draw ((dd draw-desc) (w window)) + (let ( (off (offset dd)) ) + (clear w) + (for obj in (objects dd) (draw obj w off)) + (force-output w) )) + +; 11 Sep 92; 12 Sep 92; 06 Oct 92; 05 Jan 04 +; Find a draw-object such that point p selects it +(gldefun draw-desc-selected ((dd draw-desc) (p vector)) + (result draw-object) + (let (objs objsb obj) + (objs = (for obj in objects when (selectedp obj p (offset dd)) + collect obj)) + (if objs + (if (null (rest objs)) + (obj = (first objs)) + (progn (objsb = (for z in objs + when (member (first z) + '(draw-button draw-dot)) + collect z)) + (if (and objsb (null (rest objsb))) + (obj = (first objsb)))) ) ) + obj)) + +; 11 Sep 92; 12 Sep 92; 13 Sep 92; 05 Jan 04 +; Find a draw-object such that point p selects it +(gldefun draw-desc-find ((dd draw-desc) (w window) &optional (crossflg boolean)) + (result draw-object) + (let (p obj) + (while ~ obj do + (p = (if crossflg (draw-get-cross dd w) + (draw-get-crosshairs dd w))) + (obj = (draw-desc-selected dd p)) ) + obj)) + +; 15 Sep 92 +(gldefun draw-get-cross ((dd draw-desc) (w window)) + (result vector) + (draw-desc-snap dd (window-get-cross w))) + +; 15 Sep 92 +(gldefun draw-get-crosshairs ((dd draw-desc) (w window)) + (result vector) + (draw-desc-snap dd (window-get-crosshairs w))) + +; 12 Sep 92; 14 Sep 92; 06 Oct 92 +; Delete selected object +(gldefun draw-desc-delete ((dd draw-desc) (w window)) + (let (obj) + (obj = (draw-desc-find dd w t)) + (erase obj w (offset dd)) + ((objects dd) _- obj) )) + +; 12 Sep 92; 07 Oct 92 +; Copy selected object +(gldefun draw-desc-copy ((dd draw-desc) (w window)) + (let (obj (objb draw-object)) + (obj = (draw-desc-find dd w)) + (objb = (copy-tree obj)) + (draw-get-object-pos objb w) + ((offset objb) _- (offset dd)) + (draw objb w (offset dd)) + (force-output w) + ((objects dd) _+ objb) )) + +; 12 Sep 92; 13 Sep 92; 07 Oct 92; 05 Jan 04 +; Move selected object +(gldefun draw-desc-move ((dd draw-desc) (w window)) + (let (obj) + (if (obj = (draw-desc-find dd w)) + (move obj w (offset dd))) )) + +; 14 Sep 92; 28 Feb 02; 05 Jan 04; 27 Jan 06 +; Reset origin of object group +(gldefun draw-desc-origin ((dd draw-desc) (w window)) + (let (sel) + (draw-desc-bounds dd) + (sel = (menu '(("To zero" . tozero) ("Select" . select)))) + (if (sel == 'select) + ((offset dd) = (get-box-position w (x (size dd)) (y (size dd)))) + (if (sel == 'tozero) ((offset dd) = (a vector x 0 y 0)) ) ))) + +; 14 Sep 92 +; Compute boundaries of objects in a drawing; set offset and size of +; the draw-desc and reset offsets of items relative to it. +(gldefun draw-desc-bounds ((dd draw-desc)) + (let ((xmin 9999) (ymin 9999) (xmax 0) (ymax 0) basev) + (for obj in objects do + (xmin = (min xmin (x (offset obj)) + ((x (offset obj)) + (x (size obj))))) + (ymin = (min ymin (y (offset obj)) + ((y (offset obj)) + (y (size obj))))) + (xmax = (max xmax (x (offset obj)) + ((x (offset obj)) + (x (size obj))))) + (ymax = (max ymax (y (offset obj)) + ((y (offset obj)) + (y (size obj))))) ) + ((x (size dd)) = (xmax - xmin)) + ((y (size dd)) = (ymax - ymin)) + (basev = (a vector with x = xmin y = ymin)) + ((offset dd) = basev) + (for obj in objects do ((offset obj) _- basev)) )) + +; 14 Sep 92; 16 Sep 92; 19 Dec 93; 15 Jan 98; 06 Dec 07 +; Produce LaTex output for object group. +; LaTex can only *approximately* reproduce the picture. +(gldefun draw-desc-latex ((dd draw-desc)) + (let (base bx by sx sy) + (format t " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" + (* (x (size dd)) *draw-latex-factor*) + (* (y (size dd)) *draw-latex-factor*) ) + (for obj in (objects dd) do + (base = (offset dd) + (offset obj)) + (bx = (x base) * *draw-latex-factor*) + (by = (y base) * *draw-latex-factor*) + (sx = (x (size obj)) * *draw-latex-factor*) + (sy = (y (size obj)) * *draw-latex-factor*) + (case (first obj) + (draw-line (latex-line (x base) (y base) + ((x base) + sx) ((y base) + sy))) + (draw-arrow (latex-line (x base) (y base) + ((x base) + sx) ((y base) + sy) t) ) + (draw-box + (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" + bx by sx sy)) + (draw-rcbox + (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" + (bx + sx / 2) (by + sy / 2) sx sy)) + (draw-circle + (format t " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" + (bx + sx / 2) (by + sy / 2) sx)) + (draw-ellipse + (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" + (bx + sx / 2) (by + sy / 2) sx sy)) + (draw-button + (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" + bx by sx sy)) + (draw-erase ) + (draw-dot + (format t " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" + (bx + sx / 2) (by + sy / 2) sx)) + (draw-text + (format t " \\put(~5,0F,~5,0F) {~A}~%" + bx (by + 4 * *draw-latex-factor*) (contents obj)) ) ) ) + (format t " \\end{picture}~%") )) + +; 14 Sep 92; 15 Sep 92; 16 Sep 92; 05 Oct 92; 17 Dec 93; 21 Dec 93; 28 Feb 02 +; 05 Jan 04 +; Produce program to draw object group +(gldefun draw-desc-program ((dd draw-desc)) + (let (base bx by sx sy tox toy r rx ry s code fncode fnname cd) + (code = (for obj in (objects dd) when + (cd = (progn + (base = (offset dd) + (offset obj) - (refpt dd)) + (bx = (x base)) + (by = (y base)) + (sx = (x (size obj))) + (sy = (y (size obj))) + (tox = bx + sx) + (toy = by + sy) + (if ((car obj) == 'draw-circle) + (r = (x (size obj)) / 2)) + (if ((car obj) == 'draw-ellipse) + (progn (rx = (x (size obj)) / 2) + (ry = (y (size obj)) / 2))) + (draw-optimize + (case (first obj) + (draw-line `(window-draw-line-xy w (+ x ,bx) (+ y ,by) + (+ x ,tox) (+ y ,toy))) + (draw-arrow `(window-draw-arrow-xy w (+ x ,bx) (+ y ,by) + (+ x ,tox) (+ y ,toy))) + (draw-box `(window-draw-box-xy w (+ x ,bx) (+ y ,by) + ,sx ,sy)) + (draw-rcbox `(window-draw-rcbox-xy w (+ x ,bx) (+ y ,by) + ,sx ,sy 8)) + (draw-circle `(window-draw-circle-xy w (+ x ,(+ r bx)) + (+ y ,(+ r by)) ,r)) + (draw-ellipse `(window-draw-ellipse-xy w (+ x ,(+ rx bx)) + (+ y ,(+ ry by)) + ,rx ,ry)) + ((draw-button draw-refpt) + nil) ; let picmenu draw the buttons + (draw-erase `(window-erase-area-xy w (+ x ,bx) (+ y ,by) + ,sx ,sy)) + (draw-dot `(window-draw-dot-xy w (+ x ,(+ 2 bx)) + (+ y ,(+ 2 by)))) + (draw-text (s = (stringify (contents obj))) + `(window-printat-xy w ,s (+ x ,bx) (+ y ,by))) + )) )) + collect cd)) + (fncode = (cons 'lambda (cons (list 'w 'x 'y) + (nconc code + (list (list 'window-force-output + 'w)))))) + (fnname = (fnname dd)) + (setf (symbol-function fnname) fncode) + (format t "Constructed program (~A w x y)~%" fnname) + (draw-desc-picmenu dd) + )) + +; 21 Dec 93 +; Optimize code if GLISP is present +(defun draw-optimize (x) (if (fboundp 'glunwrap) (glunwrap x nil) x)) + +; 14 Sep 92 +(gldefun draw-desc-fnname ((dd draw-desc)) + (intern (concatenate 'string "DRAW-" (symbol-name (name dd)))) ) + +; 14 Sep 92; 06 Oct 92; 08 Apr 93; 28 Feb 02; 05 Jan 04 +; Produce a picmenu-spec from the buttons of a drawing description +(gldefun draw-desc-picmenu ((dd draw-desc)) + (let (buttons) + (buttons = (for obj in (objects dd) when ((first obj) == 'draw-button) + collect (list (contents obj) + ((a vector x 2 y 2) + (offset obj) + + (offset dd) )) ) ) + (if buttons + (setf (get (name dd) 'picmenu-spec) + (list 'picmenu-spec (x (size dd)) (y (size dd)) buttons + t (fnname dd) '9x15))) )) + +; 15 Sep 92; 05 Jan 04 +(gldefun draw-desc-snap ((dd draw-desc) (p vector)) + (result vector) + (let (psnap obj (objs (objects dd)) ) + (if *draw-snap-flag* + (while objs and ~ psnap do + (obj = (pop objs)) + (psnap = (draw-object-snap obj p (offset dd))) ) ) + (or psnap p) )) + +; 10 Sep 92; 12 Sep 92 +; Move specified object +(gldefun draw-object-move ((d draw-object) (w window) (off vector)) + (let () + (erase d w off) + (draw-get-object-pos d w) + ((offset d) _- off) + (draw d w off) + (force-output w) )) + +; 12 Sep 92; 13 Sep 92; 15 Sep 92 +; Draw an object at specified (x y) by calling its drawing function +(defun draw-object-draw-at (w x y d) + (setf (second d) (list x y)) + (draw-object-draw d w *draw-zero-vector*) ) + +; 15 Sep 92 +; Simulate glsend of draw message to an object +(defun draw-object-draw (d w off) + (funcall (glmethod (car d) 'draw) d w off) ) + +; 15 Sep 92 +; Simulate glsend of snap message to an object +(defun draw-object-snap (d p off) + (funcall (glmethod (car d) 'snap) d p off) ) + +; 15 Sep 92 +; Simulate glsend of selectedp message to an object +(defun draw-object-selectedp (d w off) + (funcall (glmethod (car d) 'selectedp) d w off) ) + +; 12 Sep 92; 07 Oct 92; 28 Feb 02; 05 Jan 04; 06 Dec 07 +(gldefun draw-get-object-pos ((d draw-object) (w window)) + (window-get-icon-position w + (if ((first d) == 'draw-text) #'draw-text-draw-outline + #'draw-object-draw-at) + (list d)) ) + +; 10 Sep 92; 15 Sep 92; 05 Jan 04 +(gldefun draw-object-erase ((d draw-object) (w window) (off vector)) + (let () + (if ((first d) <> 'draw-erase) + (progn (set-xor w) + (draw d w off) + (unset w)) ))) + +; 09 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 +(gldefun draw-line-draw ((d draw-line) (w window) (off vector)) + (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) + (draw-line-xy w (x from) (y from) (x to) (y to)) )) + +; 11 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 +(gldefun draw-arrow-draw ((d draw-arrow) (w window) (off vector)) + (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) + (draw-arrow-xy w (x from) (y from) (x to) (y to)) )) + +; 09 Sep 92; 10 Sep 92; 12 Sep 92 +(gldefun draw-line-selectedp ((d draw-line) (pt vector) (off vector)) + (let ((ptp (pt - off))) + (and (contains? (vregion d) ptp) + ((distance (line d) ptp) < 5) ) )) + +; 09 Sep 92; 10 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 +(gldefun draw-line-get ((dd draw-desc) (w window)) + (let (from to) + (from = (draw-get-crosshairs dd w)) + (to = (if *draw-latex-mode* + (window-get-latex-position w (x from) (y from) nil) + (draw-desc-snap dd + (window-get-line-position w (x from) (y from))))) + (a draw-line with offset = from size = (to - from)) )) + +; 11 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 +(gldefun draw-arrow-get ((dd draw-desc) (w window)) + (let (from to) + (from = (draw-get-crosshairs dd w)) + (to = (if *draw-latex-mode* + (window-get-latex-position w (x from) (y from) nil) + (draw-desc-snap dd + (window-get-line-position w (x from) (y from))))) + (a draw-arrow with offset = from size = (to - from)) )) + +; 09 Sep 92 +(gldefun draw-box-draw ((d draw-box) (w window) (off vector)) + (draw-box w (off + (offset d)) (size d)) ) + +; 09 Sep 92; 11 Sep 92 +(gldefun draw-box-selectedp ((d draw-box) (p vector) (off vector)) + (let ((pt (p - off))) + (or (and ((y pt) < (top (vregion d)) + 5) + ((y pt) > (bottom (vregion d)) - 5) + (or ((abs (x pt) - (left (vregion d))) < 5) + ((abs (x pt) - (right (vregion d))) < 5))) + (and ((x pt) < (right (vregion d)) + 5) + ((x pt) > (left (vregion d)) - 5) + (or ((abs (y pt) - (top (vregion d))) < 5) + ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) + +; 11 Sep 92 +(gldefun draw-box-get ((dd draw-desc) (w window)) + (let (box) + (box = (window-get-region w)) + (a draw-box with offset = (start box) size = (size box)) )) + +; (dotimes (i 10) (print (draw-box-selectedp db (window-get-point dw)))) + +; 16 Sep 92 +(gldefun draw-rcbox-draw ((d draw-box) (w window) (off vector)) + (draw-rcbox-xy w ((x off) + (x (offset d))) ((y off) + (y (offset d))) + (x (size d)) (y (size d)) 8) ) + +; 16 Sep 92 +(gldefun draw-rcbox-selectedp ((d draw-box) (p vector) (off vector)) + (let ((pt (p - off))) + (or (and ((y pt) < (top (vregion d)) - 3) + ((y pt) > (bottom (vregion d)) + 3) + (or ((abs (x pt) - (left (vregion d))) < 5) + ((abs (x pt) - (right (vregion d))) < 5))) + (and ((x pt) < (right (vregion d)) - 3) + ((x pt) > (left (vregion d)) + 3) + (or ((abs (y pt) - (top (vregion d))) < 5) + ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) + +; 16 Sep 92 +(gldefun draw-rcbox-get ((dd draw-desc) (w window)) + (let (box) + (box = (window-get-region w)) + (a draw-rcbox with offset = (start box) size = (size box)) )) + +; 09 Sep 92 +(gldefun draw-circle-draw ((d draw-circle) (w window) (off vector)) + (draw-circle w (off + (center d)) (radius d)) ) + +; 09 Sep 92; 11 Sep 92; 17 Sep 92 +(gldefun draw-circle-selectedp ((d draw-circle) (p vector) (off vector)) + ((abs (radius d) - (magnitude ((center d) + off) - p)) < 5) ) + +; 11 Sep 92; 15 Sep 92 +(gldefun draw-circle-get ((dd draw-desc) (w window)) + (let (cir cent) + (cent = (draw-get-crosshairs dd w)) + (cir = (window-get-circle w cent)) + (a draw-circle with + offset = (a vector with x = ( (x (center cir)) - (radius cir) ) + y = ( (y (center cir)) - (radius cir) )) + size = (a vector with x = 2 * (radius cir) y = 2 * (radius cir))) )) + +; 11 Sep 92 +(gldefun draw-ellipse-draw ((d draw-ellipse) (w window) (off vector)) + (let ((c (off + (center d)))) + (draw-ellipse-xy w (x c) (y c) (radiusx d) (radiusy d)) )) + +; 11 Sep 92; 15 Sep 92; 17 Sep 92 +; Uses the fact that sum of distances from foci is constant. +(gldefun draw-ellipse-selectedp ((d draw-ellipse) (p vector) (off vector)) + (let ((pt (p - off))) + ( (abs ( (magnitude ((p1 d) - pt)) + (magnitude ((p2 d) - pt)) ) + - 2 * (radius d)) < 2) )) + +; print out what the "boundary" of an ellipse looks like via selectedp +(defun draw-test-ellipse-selectedp (e) + (let ( (size (third e)) (offset (second e)) ) + (dotimes (y (+ (cadr size) 10)) + (dotimes (x (+ (car size) 10)) + (princ (if (draw-ellipse-selectedp e + (list (+ x (car offset) -5) (+ y (cadr offset) -5)) + (list 0 0)) + "T" " "))) + (terpri)) )) + +; 11 Sep 92 +(gldefun draw-ellipse-get ((dd draw-desc) (w window)) + (let (ell cent) + (cent = (draw-get-crosshairs dd w)) + (ell = (window-get-ellipse w cent)) + (a draw-ellipse with + offset = (a vector with x = ( (x (center ell)) - (x (halfsize ell)) ) + y = ( (y (center ell)) - (y (halfsize ell)) )) + size = (a vector with x = 2 * (x (halfsize ell)) + y = 2 * (y (halfsize ell)))) )) + +; 10 Sep 92 +(gldefun draw-null-draw ((d draw-null) (w window) (off vector)) nil) + +; 10 Sep 92; 11 Sep 92 +(gldefun draw-null-selectedp ((d draw-null) (pt vector) (off vector)) nil) + +; 11 Sep 92 +(gldefun draw-button-draw ((d draw-button) (w window) (off vector)) + (draw-box w (off + (offset d)) (a vector x = 4 y = 4)) ) + +; 11 Sep 92 +(gldefun draw-button-selectedp ((d draw-button) (p vector) (off vector)) + (let ( (ptx (((x p) - (x off)) - (x (offset d)))) + (pty (((y p) - (y off)) - (y (offset d)))) ) + (and (ptx > -2) (ptx < 6) (pty > -2) (pty < 6) ) )) + )) + +; 11 Sep 92 +(gldefun draw-button-get ((dd draw-desc) (w window)) + (let (cent var) + (princ "Enter button name: ") + (var = (read)) + (cent = (draw-get-crosshairs dd w)) + (a draw-button with + offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) + size = (a vector with x = 4 y = 4) + contents = var) )) + +; 14 Sep 92 +(gldefun draw-erase-draw ((d draw-box) (w window) (off vector)) + (erase-area w (off + (offset d)) (size d)) ) + +; 14 Sep 92 +(gldefun draw-erase-selectedp ((d draw-box) (p vector) (off vector)) + (let ((pt (p - off))) + (contains? (region d) pt) )) + +; 14 Sep 92 +(gldefun draw-erase-get ((dd draw-desc) (w window)) + (let (box) + (box = (window-get-region w)) + (a draw-erase with offset = (start box) size = (size box)) )) + +; 11 Sep 92; 14 Sep 92 +(gldefun draw-dot-draw ((d draw-dot) (w window) (off vector)) + (window-draw-dot-xy w ((x off) + (x (offset d)) + 2) + ((y off) + (y (offset d)) + 2) ) ) + +; 11 Sep 92; 15 Sep 92 +(gldefun draw-dot-get ((dd draw-desc) (w window)) + (let (cent) + (cent = (draw-get-crosshairs dd w)) + (a draw-dot with + offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) + size = (a vector with x = 4 y = 4)) )) + +; 17 Dec 93 +(gldefun draw-refpt-draw ((d draw-refpt) (w window) (off vector)) + (window-draw-crosshairs-xy w ((x off) + (x (offset d))) + ((y off) + (y (offset d))) ) ) + +; 17 Dec 93 +(gldefun draw-refpt-selectedp ((d draw-button) (p vector) (off vector)) + (let ( (ptx (((x p) - (x off)) - (x (offset d)))) + (pty (((y p) - (y off)) - (y (offset d)))) ) + (and (ptx > -3) (ptx < 3) (pty > -3) (pty < 3) ) )) + +; 17 Dec 93; 05 Jan 04 +(gldefun draw-refpt-get ((dd draw-desc) (w window)) + (let (cent refpt) + (if (refpt = (assoc 'draw-refpt (objects dd))) + (progn (set-erase *draw-window*) + (draw refpt *draw-window* (a vector with x = 0 y = 0)) + (unset *draw-window*) + ((objects dd) _- refpt) ) ) + (cent = (draw-get-crosshairs dd w)) + (a draw-refpt with offset = cent + size = (a vector with x = 0 y = 0)) )) + +; 17 Dec 93; 05 Jan 04 +(gldefun draw-desc-refpt ((dd draw-desc)) (result vector) + (let (refpt) + (refpt = (assoc 'draw-refpt (objects dd))) + (if refpt (offset refpt) + (a vector x = 0 y = 0)) )) + +; 11 Sep 92; 06 Oct 92; 19 Dec 93; 11 Nov 94 +(gldefun draw-text-draw ((d draw-text) (w window) (off vector)) + (printat-xy w (contents d) ((x off) + (x (offset d))) + ((y off) + (y (offset d)))) ) + +; 07 Oct 92 +(gldefun draw-text-draw-outline ((w window) (x integer) (y integer) (d draw-text)) + (setf (second d) (list x y)) + (draw-box-xy w x (y + 2) (x (size d)) (y (size d))) ) + +; define compiled version directly to avoid repeated recompilation +(defun draw-text-draw-outline (W X Y D) + (SETF (SECOND D) (LIST X Y)) + (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) + +; 11 Sep 92 +(gldefun draw-text-selectedp ((d draw-text) (pt vector) (off vector)) + (let ((ptp (pt - off))) + (contains? (vregion d) ptp))) + +; 11 Sep 92; 17 Sep 92; 06 Oct 92; 11 Nov 94 +(gldefun draw-text-get ((dd draw-desc) (w window)) + (let (txt lng off) + (princ "Enter text string: ") + (txt = (stringify (read))) + (lng = (string-width w txt)) + (off = (get-box-position w lng 14)) + (a draw-text with offset = (off + (a vector x 0 y 4)) + size = (a vector with x = lng y = 14) + contents = txt) )) + +; 15 Sep 92; 05 Jan 04 +; Test if a point p1 is close to a point p2. If so, result is p2, else nil. +(gldefun draw-snapp ((p1 vector) (off vector) (p2x integer) (p2y integer)) + (if (and ((abs ((x p1) - (x off) - p2x)) < 4) + ((abs ((y p1) - (y off) - p2y)) < 4) ) + (a vector with x = ((x off) + p2x) y = ((y off) + p2y)) )) + +; 15 Sep 92 +(gldefun draw-dot-snap ((d draw-dot) (p vector) (off vector)) + (draw-snapp p off ((x (offset d)) + 2) + ((y (offset d)) + 2) ) ) + +; 17 Dec 93 +(gldefun draw-refpt-snap ((d draw-refpt) (p vector) (off vector)) + (draw-snapp p off (x (offset d)) (y (offset d)) ) ) + +; 15 Sep 92 +(gldefun draw-line-snap ((d draw-line) (p vector) (off vector)) + (or (draw-snapp p off (x (offset d)) (y (offset d))) + (draw-snapp p off ( (x (offset d)) + (x (size d)) ) + ( (y (offset d)) + (y (size d)) ) ) )) + +; 15 Sep 92; 19 Dec 93 +; Snap for square: corners, middle of sides. +(gldefun draw-box-snap ((d draw-box) (p vector) (off vector)) + (let ((xoff (x (offset d))) (yoff (y (offset d))) + (xsize (x (size d)) ) (ysize (y (size d)) ) ) + (or (draw-snapp p off xoff yoff) + (draw-snapp p off (xoff + xsize) (yoff + ysize)) + (draw-snapp p off (xoff + xsize) yoff) + (draw-snapp p off xoff (yoff + ysize)) + (draw-snapp p off (xoff + xsize / 2) yoff) + (draw-snapp p off xoff (yoff + ysize / 2)) + (draw-snapp p off (xoff + xsize / 2) (yoff + ysize)) + (draw-snapp p off (xoff + xsize) (yoff + ysize / 2)) ) )) + +; 15 Sep 92 +(gldefun draw-circle-snap ((d draw-circle) (p vector) (off vector)) + (or (draw-snapp p off ( (x (offset d)) + (radius d) ) + ( (y (offset d)) + (radius d) ) ) + (draw-snapp p off ( (x (offset d)) + (radius d) ) + (y (offset d)) ) + (draw-snapp p off (x (offset d)) + ( (y (offset d)) + (radius d) ) ) + (draw-snapp p off ( (x (offset d)) + (radius d) ) + ( (y (offset d)) + (y (size d)) ) ) + (draw-snapp p off ( (x (offset d)) + (x (size d)) ) + ( (y (offset d)) + (radius d) ) ) )) + +; 15 Sep 92 +(gldefun draw-ellipse-snap ((d draw-ellipse) (p vector) (off vector)) + (or (draw-snapp p off ( (x (offset d)) + (radiusx d) ) + ( (y (offset d)) + (radiusy d) ) ) + (draw-snapp p off ( (x (offset d)) + (radiusx d) ) + (y (offset d)) ) + (draw-snapp p off (x (offset d)) + ( (y (offset d)) + (radiusy d) ) ) + (draw-snapp p off ( (x (offset d)) + (radiusx d) ) + ( (y (offset d)) + (y (size d)) ) ) + (draw-snapp p off ( (x (offset d)) + (x (size d)) ) + ( (y (offset d)) + (radiusy d) ) ) )) + +; 16 Sep 92 +(gldefun draw-rcbox-snap ((d draw-rcbox) (p vector) (off vector)) + (let ( (rx ((x (size d)) / 2)) (ry ((y (size d)) / 2)) ) + (or (draw-snapp p off ( (x (offset d)) + rx ) (y (offset d)) ) + (draw-snapp p off (x (offset d)) ( (y (offset d)) + ry ) ) + (draw-snapp p off ( (x (offset d)) + rx ) + ( (y (offset d)) + (y (size d)) ) ) + (draw-snapp p off ( (x (offset d)) + (x (size d)) ) + ( (y (offset d)) + ry ) ) ) )) + +; 15 Sep 92 +(gldefun draw-no-snap ((d draw-ellipse) (p vector) (off vector)) nil) + +; 11 Sep 92 +(gldefun draw-multi-draw ((d draw-multi) (w window) (off vector)) + (let ( (totaloff ((offset d) + off)) ) + (for subd in (contents d) do + (draw subd w totaloff)) )) + +; 11 Sep 92; 13 Sep 92; 15 Sep 92; 16 Sep 92; 29 Sep 92; 17 Dec 93; 07 Jan 94 +; Initialize drawing and command menus +(defun draw-init-menus () + (let ((w (draw-window))) + (window-clear w) + (dolist (fn '(draw-menu-rectangle draw-menu-circle draw-menu-ellipse + draw-menu-line draw-menu-arrow draw-menu-dot + draw-menu-button draw-menu-text)) + (setf (get fn 'display-size) '(30 20)) ) + (setq *draw-menu-set* (menu-set-create w nil)) + (menu-set-add-menu *draw-menu-set* 'draw nil "Draw" + '((draw-menu-rectangle . rectangle) + (draw-menu-rcbox . rcbox) + (draw-menu-circle . circle) + (draw-menu-ellipse . ellipse) + (draw-menu-line . line) + (draw-menu-arrow . arrow) + (draw-menu-dot . dot) + (" " . erase) + (draw-menu-button . button) + (draw-menu-text . text) + (draw-menu-refpt . refpt)) + (list 0 0)) + (menu-set-adjust *draw-menu-set* 'draw 'top nil 1) + (menu-set-adjust *draw-menu-set* 'draw 'right nil 2) + (menu-set-add-menu *draw-menu-set* 'command nil "Commands" + '(("Done" . done) ("Move" . move) + ("Delete" . delete) ("Copy" . copy) + ("Redraw" . redraw) ("Origin" . origin) + ("LaTex Mode" . latexmode) + ("Make Program" . program) ("Make LaTex" . latex)) + (list 0 0)) + (menu-set-adjust *draw-menu-set* 'command 'top 'draw 5) + (menu-set-adjust *draw-menu-set* 'command 'right nil 2) )) + + +; 10 Sep 92 +(defun draw-menu-rectangle (w x y) + (window-draw-box-xy w (+ x 3) (+ y 3) 24 14 1)) +(defun draw-menu-rcbox (w x y) + (window-draw-rcbox-xy w (+ x 3) (+ y 3) 24 14 3 1)) +(defun draw-menu-circle (w x y) + (window-draw-circle-xy w (+ x 15) (+ y 10) 8 1)) +(defun draw-menu-ellipse (w x y) + (window-draw-ellipse-xy w (+ x 15) (+ y 10) 12 8 1)) +(defun draw-menu-line (w x y) + (window-draw-line-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) +(defun draw-menu-arrow (w x y) + (window-draw-arrow-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) +(defun draw-menu-dot (w x y) (window-draw-dot-xy w (+ x 15) (+ y 10)) ) +(defun draw-menu-button (w x y) + (window-draw-box-xy w (+ x 14) (+ y 5) 4 4 1)) +(defun draw-menu-text (w x y) + (window-printat-xy w "A" (+ x 12) (+ y 5))) +(defun draw-menu-refpt (w x y) + (window-draw-crosshairs-xy w (+ x 15) (+ y 9)) + (window-draw-circle-xy w (+ x 15) (+ y 9) 2)) + +; 14 Sep 92; 15 Jan 98 +; Draw a line or arrow in LaTex form +(defun latex-line (fromx fromy x y &optional arrowflg) + (let (dx dy sx sy siz err errb) + (setq dx (- x fromx)) + (setq dy (- y fromy)) + (if (= dx 0) + (progn (setq sx 0) + (setq sy (if (>= dy 0) 1 -1)) + (setq siz (* (abs dy) *draw-latex-factor*))) + (if (= dy 0) + (progn (setq sx (if (>= dx 0) 1 -1)) + (setq sy 0) + (setq siz (* (abs dx) *draw-latex-factor*))) + (progn + (setq err 9999) + (setq siz (* (abs dx) *draw-latex-factor*)) + (dotimes (i (if arrowflg 4 6)) + (dotimes (j (if arrowflg 4 6)) + (setq errb (abs (- (/ (float (1+ i)) + (float (1+ j))) + (abs (/ (float dx) + (float dy)))))) + (if (and (= (gcd (1+ i) (1+ j)) 1) + (< errb err)) + (progn (setq err errb) + (setq sx (1+ i)) + (setq sy (1+ j)))))) + (setq sx (* sx (latex-sign dx))) + (setq sy (* sy (latex-sign dy))) ))) + (format t " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" + (* fromx *draw-latex-factor*) (* fromy *draw-latex-factor*) + (if arrowflg "vector" "line") sx sy siz) )) + +(defun latex-sign (x) (if (>= x 0) 1 -1)) + + +; 16 Sep 92; 30 Sep 92; 02 Oct 92; 07 Oct 92 +(defun draw-output (outfilename &optional names) + (prog (prettysave lengthsave d fnname code) + (or names (setq names *draw-objects*)) + (if (symbolp names) (setq names (list names))) + (with-open-file (outfile outfilename + :direction :output + :if-exists :supersede) + (setq prettysave *print-pretty*) + (setq lengthsave *print-length*) + (setq *print-pretty* t) + (setq *print-length* 80) + (format outfile "; ~A ~A~%" + outfilename (draw-get-time-string)) + (dolist (name names) + (if (setq d (get name 'draw-descr)) + (progn (terpri outfile) + (print `(setf (get ',name 'draw-descr) ',d) outfile) + (if (and (setq fnname (draw-desc-fnname d)) + (setq code (symbol-function fnname))) + (progn (terpri outfile) + (print (cons 'defun + (if (eq (car code) 'lambda-block) + (cdr code) + (cons fnname (cdr code)))) + outfile)) ))) + (if (setq d (get name 'picmenu-spec)) + (progn (terpri outfile) + (print `(setf (get ',name 'picmenu-spec) ',d) outfile)))) + (terpri outfile) + (setq *print-pretty* prettysave) + (setq *print-length* lengthsave) ) + (return outfilename) )) + +; 09 Sep 92 +(defun draw-get-time-string () + (let (second minute hour date month year) + (multiple-value-setq (second minute hour date month year) + (get-decoded-time)) + (format nil "~2D ~A ~4D ~2D:~2D:~2D" + date (nth (1- month) '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" + "Aug" "Sep" "Oct" "Nov" "Dec")) + year hour minute second) )) + +; 14 Sep 92; 16 Sep 92; 13 July 93 +; Compile the draw.lsp and menu-set files into a plain Lisp file +(defun compile-draw () + (glcompfiles *directory* + '("glisp/vector.lsp" ; auxiliary files + "X/dwindow.lsp") + '("glisp/menu-set.lsp" ; translated files + "glisp/draw.lsp") + "glisp/drawtrans.lsp" ; output file + "glisp/draw-header.lsp") ; header file + (cf drawtrans) ) + +(defun compile-drawb () + (glcompfiles *directory* + '("glisp/vector.lsp" ; auxiliary files + "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/menu-set.lsp" ; translated files + "glisp/draw.lsp") + "glisp/drawtrans.lsp" ; output file + "glisp/draw-header.lsp") ; header file + ) + +; 16 Nov 92; 08 Apr 93; 08 Oct 93; 20 Apr 94; 29 Oct 94; 09 Feb 99 +; Output drawing descriptions and functions to the specified file +(defun draw-out (&optional names file) + (or names (setq names *draw-objects*)) + (if (not (consp names)) (setq names (list names))) + (draw-output (or file "glisp/draw.del") names) + (setq *draw-objects* (set-difference *draw-objects* names)) + names ) diff --git a/xgcl-2/gcl_drawtrans.lsp b/xgcl-2/gcl_drawtrans.lsp new file mode 100644 index 0000000..26ecd90 --- /dev/null +++ b/xgcl-2/gcl_drawtrans.lsp @@ -0,0 +1,1890 @@ +; 07 Jan 2010 16:40:19 EST +; drawtrans.lsp -- translation of draw.lsp Gordon S. Novak Jr. + +; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + +(IN-PACKAGE :USER) + +(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms) ) + +(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) + +(defmacro glmethod (class selector) + `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) + +(SETF (GET 'MENU-SET 'GLSTRUCTURE) + '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) + (COMMANDFN ANYTHING)) + MSG + ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) + (NAMED-MENU MENU-SET-NAMED-MENU) + (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) + (ADD-PICMENU MENU-SET-ADD-PICMENU) + (ADD-COMPONENT MENU-SET-ADD-COMPONENT) + (ADD-BARMENU MENU-SET-ADD-BARMENU) + (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) + (DELETE-ITEM MENU-SET-DELETE-ITEM) + (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) + (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) + (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) + (DRAW-CONN MENU-SET-DRAW-CONN)))) +(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) + '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) + PROP + ((LEFT ((PARENT-OFFSET-X MENU))) + (BOTTOM ((PARENT-OFFSET-Y MENU))) + (WIDTH ((PICTURE-WIDTH MENU))) + (HEIGHT ((PICTURE-HEIGHT MENU)))) + SUPERS (REGION))) +(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) + '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) +(SETF (GET 'MENU-PORT 'GLSTRUCTURE) + '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) +(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) + '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) +(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) + '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) +(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) + '((LISTOBJECT (MENU-SET MENU-SET) + (CONNECTIONS (LISTOF MENU-SET-CONN))) + PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG + ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) + (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) + (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) + (FIND-CONN MENU-CONNS-FIND-CONN) + (FIND-ITEM MENU-CONNS-FIND-ITEM) + (DELETE-ITEM MENU-CONNS-DELETE-ITEM) + (DELETE-CONN MENU-CONNS-DELETE-CONN) + (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) + (FIND-CONNS MENU-CONNS-FIND-CONNS) + (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) + (NEW-CONN MENU-CONNS-NEW-CONN) + (NAMED-MENU MENU-CONNS-NAMED-MENU) + (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) + + +(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) +(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) + '((W WINDOW) (&OPTIONAL NIL))) +(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) + + +(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) + (LET (RES RESB ITM SEL LASTX LASTY) + (IF REDRAW (MENU-SET-DRAW MS)) + (WHILE (NOT (OR RES RESB)) + (SETQ ITM + (WINDOW-TRACK-MOUSE (CADR MS) + #'(LAMBDA (X Y CODE) + (OR (AND (PLUSP CODE) (SETQ LASTX X) + (SETQ LASTY Y) CODE) + (SOME #'(LAMBDA (GLVAR128) + (IF + (AND + (BETWEEN X + (FIFTH (CADDR GLVAR128)) + (+ (FIFTH (CADDR GLVAR128)) + (SEVENTH (CADDR GLVAR128)))) + (BETWEEN Y + (SIXTH (CADDR GLVAR128)) + (+ (SIXTH (CADDR GLVAR128)) + (EIGHTH (CADDR GLVAR128))))) + GLVAR128)) + (CADDR MS)))))) + (IF (NUMBERP ITM) + (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) + (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) + (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) + (IF SEL + (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) + (IF (AND *WINDOW-MENU-CODE* + (NOT (ZEROP *WINDOW-MENU-CODE*))) + (SETQ RES + (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) + (XFLUSH *WINDOW-DISPLAY*) + (OR RES RESB))) +(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) + '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) +(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) + + +(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) + (LET (MENU) + (SETQ MENU + (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) + T T)) + (MENU-INIT MENU) + (IF (NOT OFFSET) + (SETQ OFFSET + (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) + (EIGHTH MENU)))) + (SETF (FIFTH MENU) (CAR OFFSET)) + (SETF (SIXTH MENU) (CADR OFFSET)) + (MENU-SET-ADD-ITEM MS NAME SYM MENU))) +(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) + (ITEMS NIL) (&OPTIONAL VECTOR))) +(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) + (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) +(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) +(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) +(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) +(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-PICMENU + (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) + (LET (MENU MAXWIDTH MAXHEIGHT) + (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) + (SETQ MENU + (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) + (CADR OFFSET) T T (NOT NOBOX))) + (SETQ MAXWIDTH + (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) + (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) + (IF (NOT OFFSET) + (SETQ OFFSET + (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) + (SETF (FIFTH MENU) (CAR OFFSET)) + (SETF (SIXTH MENU) (CADR OFFSET)) + (MENU-SET-ADD-ITEM MS NAME SYM MENU))) +(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) + (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) +(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) + (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) +(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) +(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) + (BARMENU-INIT MENU) + (IF (NOT OFFSET) + (SETQ OFFSET + (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) + (EIGHTH MENU)))) + (SETF (FIFTH MENU) (CAR OFFSET)) + (SETF (SIXTH MENU) (CADR OFFSET)) + (MENU-SET-ADD-ITEM MS NAME SYM MENU)) +(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) + (TITLE STRING) (&OPTIONAL VECTOR))) +(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-NAME (NM) + (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) +(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) +(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) + + +(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) +(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL))) +(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-SET-NAMED-MENU (MS NAME) + (CADDR (MENU-SET-NAMED-ITEM MS NAME))) +(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL))) +(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) + + +(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) + (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) + (IF (EQ (FIRST THISMENU) 'MENU) + (SOME #'(LAMBDA (X) + (OR (EQ X ITEMNAME) + (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) + (NTH 13 THISMENU)) + (IF (EQ (FIRST THISMENU) 'PICMENU) + (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) +(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) +(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) + (MENU-SET-NAMED-ITEM (CADR MC) NAME)) +(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) + '((MC MENU-CONNS) (NAME SYMBOL))) +(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) + (MENU-SET-NAMED-MENU (CADR MC) NAME)) +(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) + '((MC MENU-CONNS) (NAME SYMBOL))) +(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) + + +(DEFUN MENU-SET-FIND-ITEM (MS POS) + (LET (MITEM) + (DOLIST (MI (CADDR MS)) + (IF (AND (BETWEEN (CAR POS) + (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (FIFTH SELF) 0)) + (+ (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (FIFTH SELF) 0)) + (SEVENTH (CADDR MI)))) + (BETWEEN (CADR POS) + (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (SIXTH SELF) 0)) + (+ (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (SIXTH SELF) 0)) + (EIGHTH (CADDR MI))))) + (SETQ MITEM MI))) + MITEM)) +(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (POS VECTOR))) +(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-SET-DELETE-ITEM (MS MI) + (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) +(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (MI MENU-SET-ITEM))) +(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-MOVE (MS) + (LET (SEL M) + (SETQ SEL (MENU-SET-SELECT MS NIL T)) + (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) + (MENU-REPOSITION M))) + +(DEFUN MENU-MDRAW (M) + (CASE (FIRST M) + (MENU (MENU-DRAW M)) + (PICMENU (PICMENU-DRAW M)) + (BARMENU (BARMENU-DRAW M)) + (TEXTMENU (TEXTMENU-DRAW M)) + (EDITMENU (EDITMENU-DRAW M)) + (T (GLSEND M DRAW)))) + +(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) + (CASE (FIRST M) + (MENU (MENU-SELECT M T)) + (PICMENU (PICMENU-SELECT M T ANYCLICK)) + (BARMENU (BARMENU-SELECT M)) + (TEXTMENU (TEXTMENU-SELECT M T)) + (EDITMENU (EDITMENU-SELECT M T)) + (T (GLSEND M SELECT)))) + +(DEFUN MENU-MITEM-POSITION (M NAME LOC) + (CASE (FIRST M) + (MENU (MENU-ITEM-POSITION M NAME LOC)) + (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) + (T (GLSEND M ITEM-POSITION NAME LOC)))) + +(DEFUN MENU-SET-DRAW (MS) + (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE (CADR MS)) + (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) + +(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) + (LET (M) + (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) + (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) + (MENU-MITEM-POSITION M NIL LOC)))) +(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) + '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) +(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN MENU-SET-DRAW-CONN (MS CONN) + (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) + (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) + (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) + (WHEN (> (CAR PA) (CAR PB)) + (SETQ TMP DESCA) + (SETQ DESCA DESCB) + (SETQ DESCB TMP)) + (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) + (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) + (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) + (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) + (CADR PB) NIL) + (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) + (LET (M FROMM PLACE) + (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) + (IF FROM + (PROGN + (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) + (SETQ PLACE + (CASE EDGE + (TOP (SIXTH (CADDR FROMM))) + (BOTTOM (+ (SIXTH (CADDR FROMM)) + (EIGHTH (CADDR FROMM)))) + (LEFT (+ (FIFTH (CADDR FROMM)) + (SEVENTH (CADDR FROMM)))) + (RIGHT (FIFTH (CADDR FROMM)))))) + (SETQ PLACE + (CASE EDGE + (TOP (CADDDR (CADR MS))) + ((BOTTOM LEFT) 0) + (RIGHT (FIFTH (CADR MS)))))) + (CASE EDGE + (TOP (SETF (SIXTH (CADDR M)) + (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) + (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) + (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) + (RIGHT (SETF (FIFTH (CADDR M)) + (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) +(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) + (OFFSET INTEGER))) +(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) + + +(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) + (OR TOLERANCE (SETQ TOLERANCE 10)) + (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) + (LIST (CAR FIXED) (CADR APPROX)) + (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) + (LIST (CAR APPROX) (CADR FIXED)) APPROX))) +(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) + '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) +(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) +(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) +(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) + + +(DEFUN MENU-CONNS-DRAW (MC) + (MENU-SET-DRAW (CADR MC)) + (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) + +(DEFUN MENU-CONNS-MOVE (MC) + (MENU-SET-MOVE (CADR MC)) + (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) + (XFLUSH *WINDOW-DISPLAY*) + (MENU-CONNS-DRAW MC)) + +(DEFUN MENU-CONNS-REDRAW (MC) + (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) + (XFLUSH *WINDOW-DISPLAY*) + (MENU-CONNS-DRAW MC)) + +(DEFUN MENU-CONNS-ADD-CONN (MC) + (LET (SEL SELB CONN) + (SETQ SEL (MENU-SET-SELECT (CADR MC))) + (IF (EQ (CADR SEL) 'BACKGROUND) SEL + (PROGN + (SETQ SELB (MENU-SET-SELECT (CADR MC))) + (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) + (SETQ CONN (LIST SEL SELB)) + (MENU-SET-DRAW-CONN (CADR MC) CONN) + (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) + NIL)))) +(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) +(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) + + +(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) + (LET (CONN) + (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) + (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) +(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) + '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) + (TONAME SYMBOL) (TOPORT SYMBOL))) +(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-CONN)) + + +(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) + (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) +(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) + '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) +(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-CONNS-FIND-CONN (MC PT) + (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) + (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) + (SETQ MS (CADR MC)) + (DOLIST (CONN (CADDR MC)) + (UNLESS FOUND + (SETQ DESCA (CAR CONN)) + (SETQ DESCB (CADR CONN)) + (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) + (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) + (WHEN (> (CAR PA) (CAR PB)) + (SETQ TMP DESCA) + (SETQ DESCA DESCB) + (SETQ DESCB TMP)) + (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) + (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) + (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) + (- (CADR PT) (CADAR LS))) + (* (- (CADADR LS) (CADAR LS)) + (- (CAR PT) (CAAR LS)))) + (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) + (EXPT (- (CADADR LS) (CADAR LS)) 2))))) + 5) + (SETQ FOUND T) + (SETQ RES CONN)))) + RES)) +(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) + '((MC MENU-CONNS) (PT VECTOR))) +(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) + + +(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) +(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) + '((MC MENU-CONNS) (PT VECTOR))) +(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) + (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) +(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) + '((MC MENU-CONNS) (CONN MENU-SET-CONN))) +(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-CONN)) + + +(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) + (LET (MS) + (SETQ MS (CADR MC)) + (MENU-SET-DELETE-ITEM MS MI) + (DOLIST (CONN (CADDR MC)) + (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) + (MENU-CONNS-DELETE-CONN MC CONN))))) + +(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) + (MENU-SET-REMOVE-ITEMS (CADR MC)) + (SETF (CADDR MC) NIL)) +(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) +(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-CONN)) + + +(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) + (LET (PORTS) + (DOLIST (CONN (CADDR MC)) + (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) + (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) + PORTS)) + +(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) + (LET (RES) + (DOLIST (CONN (CADDR MC)) + (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) + (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) + (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) + (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) + RES)) +(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) + '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) +(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) + + +(DEFUN COMPILE-MENU-SET () + (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") + '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" + "glisp/menu-set-header.lsp") + (COMPILE-FILE "glisp/menu-settrans.lsp")) + +(DEFUN COMPILE-MENU-SETB () + (GLCOMPFILES *DIRECTORY* + '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" + "glisp/menu-set-header.lsp")) + +(DEFVAR *DRAW-WINDOW* NIL) + +(DEFVAR *DRAW-WINDOW-WIDTH* 600) + +(DEFVAR *DRAW-WINDOW-HEIGHT* 600) + +(DEFVAR *DRAW-LEAVE-WINDOW* NIL) + +(DEFVAR *DRAW-MENU-SET* NIL) + +(DEFVAR *DRAW-ZERO-VECTOR* '(0 0)) + +(DEFVAR *DRAW-LATEX-FACTOR* 1) + +(DEFVAR *DRAW-SNAP-FLAG* T) + +(DEFVAR *DRAW-OBJECTS* NIL) + +(DEFVAR *DRAW-LATEX-MODE* NIL) + +(DEFVAR *DRAW-WINDOW*) +(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVAR) T) +(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) + + +(DEFMACRO DRAW-DESCR (NAME) (LIST 'GET NAME ''DRAW-DESCR)) + +(SETF (GET 'DRAW-DESC 'GLSTRUCTURE) + '((LISTOBJECT (NAME SYMBOL) (OBJECTS (LISTOF DRAW-OBJECT)) + (OFFSET VECTOR) (SIZE VECTOR)) + PROP ((FNNAME DRAW-DESC-FNNAME) (REFPT DRAW-DESC-REFPT)) MSG + ((DRAW DRAW-DESC-DRAW) (SNAP DRAW-DESC-SNAP) + (FIND DRAW-DESC-FIND) (DELETE DRAW-DESC-DELETE)))) +(SETF (GET 'DRAW-OBJECT 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + DEFAULT ((LINEWIDTH 1)) PROP + ((REGION ((VIRTUAL REGION WITH START = OFFSET SIZE = SIZE))) + (VREGION ((VIRTUAL REGION WITH START = VSTART SIZE = VSIZE))) + (VSTART ((VIRTUAL VECTOR WITH X = + (MIN (X OFFSET) ((X OFFSET) + (X SIZE))) - 2 + Y = (MIN (Y OFFSET) ((Y OFFSET) + (Y SIZE))) + - 2))) + (VSIZE ((VIRTUAL VECTOR WITH X = (ABS (X SIZE)) + 4 Y = + (ABS (Y SIZE)) + 4)))) + MSG + ((ERASE DRAW-OBJECT-ERASE) (DRAW DRAW-OBJECT-DRAW) + (SNAP DRAW-OBJECT-SNAP) (SELECTEDP DRAW-OBJECT-SELECTEDP) + (MOVE DRAW-OBJECT-MOVE)))) +(SETF (GET 'DRAW-LINE 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + PROP + ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = + (OFFSET + SIZE))))) + MSG + ((DRAW DRAW-LINE-DRAW) (SNAP DRAW-LINE-SNAP) + (SELECTEDP DRAW-LINE-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-ARROW 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + PROP + ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = + (OFFSET + SIZE))))) + MSG + ((DRAW DRAW-ARROW-DRAW) (SNAP DRAW-LINE-SNAP) + (SELECTEDP DRAW-LINE-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-BOX 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-BOX-DRAW) (SNAP DRAW-BOX-SNAP) + (SELECTEDP DRAW-BOX-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-RCBOX 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-RCBOX-DRAW) (SNAP DRAW-RCBOX-SNAP) + (SELECTEDP DRAW-RCBOX-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-ERASE 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-ERASE-DRAW) (SNAP DRAW-NO-SNAP) + (SELECTEDP DRAW-ERASE-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-CIRCLE 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + PROP ((RADIUS ((X SIZE) / 2)) (CENTER (OFFSET + SIZE / 2))) MSG + ((DRAW DRAW-CIRCLE-DRAW) (SNAP DRAW-CIRCLE-SNAP) + (SELECTEDP DRAW-CIRCLE-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-ELLIPSE 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + PROP + ((RADIUSX ((X SIZE) / 2)) (RADIUSY ((Y SIZE) / 2)) + (RADIUS ((MAX RADIUSX RADIUSY))) (CENTER (OFFSET + SIZE / 2)) + (DELTA ((SQRT (ABS (RADIUSX ^ 2 - RADIUSY ^ 2))))) + (P1 ((IF (RADIUSX > RADIUSY) + (A VECTOR X = (X CENTER) - DELTA Y = (Y CENTER)) + (A VECTOR X = (X CENTER) Y = (Y CENTER) - DELTA)))) + (P2 ((IF (RADIUSX > RADIUSY) + (A VECTOR X = (X CENTER) + DELTA Y = (Y CENTER)) + (A VECTOR X = (X CENTER) Y = (Y CENTER) + DELTA))))) + MSG + ((DRAW DRAW-ELLIPSE-DRAW) (SNAP DRAW-ELLIPSE-SNAP) + (SELECTEDP DRAW-ELLIPSE-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-DOT 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-DOT-DRAW) (SNAP DRAW-DOT-SNAP) + (SELECTEDP DRAW-BUTTON-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-BUTTON 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-BUTTON-DRAW) (SNAP DRAW-DOT-SNAP) + (SELECTEDP DRAW-BUTTON-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-TEXT 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-TEXT-DRAW) (SNAP DRAW-NO-SNAP) + (SELECTEDP DRAW-TEXT-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-NULL 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-NULL-DRAW) (SNAP DRAW-NO-SNAP) + (SELECTEDP DRAW-NULL-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-REFPT 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) + (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-REFPT-DRAW) (SNAP DRAW-REFPT-SNAP) + (SELECTEDP DRAW-REFPT-SELECTEDP)) + SUPERS (DRAW-OBJECT))) +(SETF (GET 'DRAW-MULTI 'GLSTRUCTURE) + '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) + (CONTENTS (LISTOF DRAW-OBJECT)) (LINEWIDTH INTEGER)) + MSG + ((DRAW DRAW-MULTI-DRAW) (SNAP DRAW-NO-SNAP) + (SELECTEDP DRAW-MULTI-SELECTEDP)) + SUPERS (DRAW-OBJECT))) + + +(DEFUN DRAW-DESC (NAME) + (LET (DD) + (SETQ DD (DRAW-DESCR NAME)) + (WHEN (NOT DD) + (SETQ DD + (LIST 'DRAW-DESC NAME NIL (COPY-LIST '(0 0)) + (COPY-LIST '(0 0)))) + (SETF (DRAW-DESCR NAME) DD)) + DD)) +(SETF (GET 'DRAW-DESC 'GLARGUMENTS) '((NAME SYMBOL))) +(SETF (GET 'DRAW-DESC 'GLFNRESULTTYPE) 'DRAW-DESC) + + +(SETF (GET 'DRAW-WINDOW 'GLFNRESULTTYPE) 'WINDOW) + +(DEFUN DRAW-WINDOW () + (OR *DRAW-WINDOW* + (SETQ *DRAW-WINDOW* + (WINDOW-CREATE *DRAW-WINDOW-WIDTH* *DRAW-WINDOW-HEIGHT* + "Draw window")))) + +(DEFUN DRAW (NAME) + (LET (W DD DONE SEL (REDRAW T) NEW) + (SETQ W (DRAW-WINDOW)) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE W) + (OR *DRAW-MENU-SET* (DRAW-INIT-MENUS)) + (SETQ DD (DRAW-DESC NAME)) + (UNLESS (MEMBER NAME *DRAW-OBJECTS*) + (SETQ *DRAW-OBJECTS* (NCONC *DRAW-OBJECTS* (LIST NAME)))) + (DRAW-DESC-DRAW DD W) + (WHILE (NOT DONE) + (SETQ SEL (MENU-SET-SELECT *DRAW-MENU-SET* REDRAW)) + (SETQ REDRAW NIL) + (CASE (CADR SEL) + (COMMAND (CASE (CAR SEL) + (DONE (SETQ DONE T)) + (MOVE (DRAW-DESC-MOVE DD W)) + (DELETE (DRAW-DESC-DELETE DD W)) + (COPY (DRAW-DESC-COPY DD W)) + (REDRAW (XCLEARWINDOW *WINDOW-DISPLAY* + (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) + (ORIGIN (DRAW-DESC-ORIGIN DD W) + (XCLEARWINDOW *WINDOW-DISPLAY* + (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) + (PROGRAM (DRAW-DESC-PROGRAM DD)) + (LATEX (DRAW-DESC-LATEX DD)) + (LATEXMODE + (SETQ *DRAW-LATEX-MODE* + (NOT *DRAW-LATEX-MODE*)) + (FORMAT T "Latex Mode is now ~A~%" + *DRAW-LATEX-MODE*)))) + (DRAW (SETQ NEW NIL) + (CASE (CAR SEL) + (RECTANGLE (SETQ NEW (DRAW-BOX-GET DD W))) + (RCBOX (SETQ NEW (DRAW-RCBOX-GET DD W))) + (CIRCLE (SETQ NEW (DRAW-CIRCLE-GET DD W))) + (ELLIPSE (SETQ NEW (DRAW-ELLIPSE-GET DD W))) + (LINE (SETQ NEW (DRAW-LINE-GET DD W))) + (ARROW (SETQ NEW (DRAW-ARROW-GET DD W))) + (DOT (SETQ NEW (DRAW-DOT-GET DD W))) + (ERASE (SETQ NEW (DRAW-ERASE-GET DD W))) + (BUTTON (SETQ NEW (DRAW-BUTTON-GET DD W))) + (TEXT (SETQ NEW (DRAW-TEXT-GET DD W))) + (REFPT (SETQ NEW (DRAW-REFPT-GET DD W)))) + (WHEN NEW + (SETF (CADR NEW) + (LIST (- (CAADR NEW) (CAR (CADDDR DD))) + (- (CADADR NEW) (CADR (CADDDR DD))))) + (SETF (CADDR DD) + (NCONC (CADDR DD) (CONS NEW NIL))) + (DRAW-OBJECT-DRAW NEW W (CADDDR DD)))) + (BACKGROUND))) + (SETF (DRAW-DESCR NAME) DD) + (UNLESS *DRAW-LEAVE-WINDOW* + (PROGN + (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-UNMAP W))) + NAME)) +(SETF (GET 'DRAW 'GLARGUMENTS) '((NAME SYMBOL))) +(SETF (GET 'DRAW 'GLFNRESULTTYPE) 'SYMBOL) + + +(DEFUN COPY-DRAW-DESC (FROM TO) + (LET (OLD) + (SETQ OLD (COPY-TREE (GET FROM 'DRAW-DESCR))) + (SETF (GET TO 'DRAW-DESCR) (CONS (CAR OLD) (CONS TO (CDDR OLD)))))) + +(DEFUN DRAW-DESC-DRAW (DD W) + (LET ((OFF (CADDDR DD))) + (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (DOLIST (OBJ (CADDR DD)) (DRAW-OBJECT-DRAW OBJ W OFF)) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN DRAW-DESC-SELECTED (DD P) + (LET (OBJS OBJSB OBJ) + (SETQ OBJS + (MAPCAN #'(LAMBDA (OBJ) + (AND (DRAW-OBJECT-SELECTEDP OBJ P (CADDDR DD)) + (CONS OBJ NIL))) + (CADDR DD))) + (IF OBJS + (IF (NULL (REST OBJS)) (SETQ OBJ (FIRST OBJS)) + (PROGN + (SETQ OBJSB + (MAPCAN #'(LAMBDA (Z) + (AND (MEMBER (FIRST Z) + '(DRAW-BUTTON DRAW-DOT)) + (CONS Z NIL))) + OBJS)) + (IF (AND OBJSB (NULL (REST OBJSB))) + (SETQ OBJ (FIRST OBJSB)))))) + OBJ)) +(SETF (GET 'DRAW-DESC-SELECTED 'GLARGUMENTS) + '((DD DRAW-DESC) (P VECTOR))) +(SETF (GET 'DRAW-DESC-SELECTED 'GLFNRESULTTYPE) 'DRAW-OBJECT) + + +(DEFUN DRAW-DESC-FIND (DD W &OPTIONAL CROSSFLG) + (LET (P OBJ) + (WHILE (NOT OBJ) + (SETQ P + (IF CROSSFLG (DRAW-GET-CROSS DD W) + (DRAW-GET-CROSSHAIRS DD W))) + (SETQ OBJ (DRAW-DESC-SELECTED DD P))) + OBJ)) +(SETF (GET 'DRAW-DESC-FIND 'GLARGUMENTS) + '((DD DRAW-DESC) (W WINDOW) (&OPTIONAL BOOLEAN))) +(SETF (GET 'DRAW-DESC-FIND 'GLFNRESULTTYPE) 'DRAW-OBJECT) + + +(DEFUN DRAW-GET-CROSS (DD W) (DRAW-DESC-SNAP DD (WINDOW-GET-CROSS W))) +(SETF (GET 'DRAW-GET-CROSS 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-GET-CROSS 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-GET-CROSSHAIRS (DD W) + (DRAW-DESC-SNAP DD (WINDOW-GET-CROSSHAIRS W))) +(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLARGUMENTS) + '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-DESC-DELETE (DD W) + (LET (OBJ) + (SETQ OBJ (DRAW-DESC-FIND DD W T)) + (DRAW-OBJECT-ERASE OBJ W (CADDDR DD)) + (SETF (CADDR DD) (REMOVE OBJ (CADDR DD))))) +(SETF (GET 'DRAW-DESC-DELETE 'GLARGUMENTS) + '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-DESC-DELETE 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) + + +(DEFUN DRAW-DESC-COPY (DD W) + (LET (OBJ OBJB) + (SETQ OBJ (DRAW-DESC-FIND DD W)) + (SETQ OBJB (COPY-TREE OBJ)) + (DRAW-GET-OBJECT-POS OBJB W) + (SETF (CADR OBJB) + (LIST (- (CAADR OBJB) (CAR (CADDDR DD))) + (- (CADADR OBJB) (CADR (CADDDR DD))))) + (DRAW-OBJECT-DRAW OBJB W (CADDDR DD)) + (XFLUSH *WINDOW-DISPLAY*) + (SETF (CADDR DD) (NCONC (CADDR DD) (CONS OBJB NIL))))) +(SETF (GET 'DRAW-DESC-COPY 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-DESC-COPY 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) + + +(DEFUN DRAW-DESC-MOVE (DD W) + (LET (OBJ) + (IF (SETQ OBJ (DRAW-DESC-FIND DD W)) + (DRAW-OBJECT-MOVE OBJ W (CADDDR DD))))) + +(DEFUN DRAW-DESC-ORIGIN (DD W) + (LET (SEL) + (DRAW-DESC-BOUNDS DD) + (SETQ SEL (MENU '(("To zero" . TOZERO) ("Select" . SELECT)))) + (IF (EQ SEL 'SELECT) + (SETF (CADDDR DD) + (WINDOW-GET-BOX-POSITION W (CAR (FIFTH DD)) + (CADR (FIFTH DD)))) + (IF (EQ SEL 'TOZERO) (SETF (CADDDR DD) (COPY-LIST '(0 0))))))) +(SETF (GET 'DRAW-DESC-ORIGIN 'GLARGUMENTS) + '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-DESC-ORIGIN 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-DESC-BOUNDS (DD) + (LET ((XMIN 9999) (YMIN 9999) (XMAX 0) (YMAX 0) BASEV) + (DOLIST (OBJ (CADDR DD)) + (SETQ XMIN (MIN XMIN (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) + (SETQ YMIN + (MIN YMIN (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ))))) + (SETQ XMAX (MAX XMAX (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) + (SETQ YMAX + (MAX YMAX (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ)))))) + (SETF (CAR (FIFTH DD)) (- XMAX XMIN)) + (SETF (CADR (FIFTH DD)) (- YMAX YMIN)) + (SETQ BASEV (LIST XMIN YMIN)) + (SETF (CADDDR DD) BASEV) + (DOLIST (OBJ (CADDR DD)) + (SETF (CADR OBJ) + (LIST (- (CAADR OBJ) (CAR BASEV)) + (- (CADADR OBJ) (CADR BASEV))))))) + +(DEFUN DRAW-DESC-LATEX (DD) + (LET (BASE BX BY SX SY) + (FORMAT T " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" + (* (CAR (FIFTH DD)) *DRAW-LATEX-FACTOR*) + (* (CADR (FIFTH DD)) *DRAW-LATEX-FACTOR*)) + (DOLIST (OBJ (CADDR DD)) + (SETQ BASE + (LIST (+ (CAR (CADDDR DD)) (CAADR OBJ)) + (+ (CADR (CADDDR DD)) (CADADR OBJ)))) + (SETQ BX (* (CAR BASE) *DRAW-LATEX-FACTOR*)) + (SETQ BY (* (CADR BASE) *DRAW-LATEX-FACTOR*)) + (SETQ SX (* (CAADDR OBJ) *DRAW-LATEX-FACTOR*)) + (SETQ SY (* (CADR (CADDR OBJ)) *DRAW-LATEX-FACTOR*)) + (CASE (FIRST OBJ) + (DRAW-LINE + (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) + (+ (CADR BASE) SY))) + (DRAW-ARROW + (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) + (+ (CADR BASE) SY) T)) + (DRAW-BOX + (FORMAT T + " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" + BX BY SX SY)) + (DRAW-RCBOX + (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" + (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) + (DRAW-CIRCLE + (FORMAT T " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" + (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) + (DRAW-ELLIPSE + (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" + (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) + (DRAW-BUTTON + (FORMAT T + " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" + BX BY SX SY)) + (DRAW-ERASE) + (DRAW-DOT + (FORMAT T " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" + (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) + (DRAW-TEXT + (FORMAT T " \\put(~5,0F,~5,0F) {~A}~%" BX + (+ BY (* 4 *DRAW-LATEX-FACTOR*)) (CADDDR OBJ))))) + (FORMAT T " \\end{picture}~%"))) + +(DEFUN DRAW-DESC-PROGRAM (DD) + (LET (BASE BX BY SX SY TOX TOY R RX RY S CODE FNCODE FNNAME CD) + (SETQ CODE + (MAPCAN #'(LAMBDA (OBJ) + (AND (SETQ CD + (PROGN + (SETQ BASE + (LET + ((GLVAR133 + (LIST + (+ (CAR (CADDDR DD)) + (CAADR OBJ)) + (+ (CADR (CADDDR DD)) + (CADADR OBJ)))) + (GLVAR134 (DRAW-DESC-REFPT DD))) + (LIST + (- (CAR GLVAR133) + (CAR GLVAR134)) + (- (CADR GLVAR133) + (CADR GLVAR134))))) + (SETQ BX (CAR BASE)) + (SETQ BY (CADR BASE)) + (SETQ SX (CAADDR OBJ)) + (SETQ SY (CADR (CADDR OBJ))) + (SETQ TOX (+ BX SX)) + (SETQ TOY (+ BY SY)) + (IF (EQ (CAR OBJ) 'DRAW-CIRCLE) + (SETQ R (* 1/2 (CAADDR OBJ)))) + (WHEN (EQ (CAR OBJ) 'DRAW-ELLIPSE) + (SETQ RX (* 1/2 (CAADDR OBJ))) + (SETQ RY + (* 1/2 (CADR (CADDR OBJ))))) + (DRAW-OPTIMIZE + (CASE (FIRST OBJ) + (DRAW-LINE + (LIST 'WINDOW-DRAW-LINE-XY 'W + (LIST '+ 'X BX) (LIST '+ 'Y BY) + (LIST '+ 'X TOX) + (LIST '+ 'Y TOY))) + (DRAW-ARROW + (LIST 'WINDOW-DRAW-ARROW-XY 'W + (LIST '+ 'X BX) (LIST '+ 'Y BY) + (LIST '+ 'X TOX) + (LIST '+ 'Y TOY))) + (DRAW-BOX + (LIST 'WINDOW-DRAW-BOX-XY 'W + (LIST '+ 'X BX) (LIST '+ 'Y BY) + SX SY)) + (DRAW-RCBOX + (LIST 'WINDOW-DRAW-RCBOX-XY 'W + (LIST '+ 'X BX) (LIST '+ 'Y BY) + SX SY 8)) + (DRAW-CIRCLE + (LIST 'WINDOW-DRAW-CIRCLE-XY 'W + (LIST '+ 'X (+ R BX)) + (LIST '+ 'Y (+ R BY)) R)) + (DRAW-ELLIPSE + (LIST 'WINDOW-DRAW-ELLIPSE-XY 'W + (LIST '+ 'X (+ RX BX)) + (LIST '+ 'Y (+ RY BY)) RX RY)) + ((DRAW-BUTTON DRAW-REFPT) NIL) + (DRAW-ERASE + (LIST 'WINDOW-ERASE-AREA-XY 'W + (LIST '+ 'X BX) (LIST '+ 'Y BY) + SX SY)) + (DRAW-DOT + (LIST 'WINDOW-DRAW-DOT-XY 'W + (LIST '+ 'X (+ 2 BX)) + (LIST '+ 'Y (+ 2 BY)))) + (DRAW-TEXT + (SETQ S + (STRINGIFY (CADDDR OBJ))) + (LIST 'WINDOW-PRINTAT-XY 'W S + (LIST '+ 'X BX) + (LIST '+ 'Y BY))))))) + (CONS CD NIL))) + (CADDR DD))) + (SETQ FNCODE + (CONS 'LAMBDA + (CONS (LIST 'W 'X 'Y) + (NCONC CODE + (LIST (LIST 'WINDOW-FORCE-OUTPUT 'W)))))) + (SETQ FNNAME (DRAW-DESC-FNNAME DD)) + (SETF (SYMBOL-FUNCTION FNNAME) FNCODE) + (FORMAT T "Constructed program (~A w x y)~%" FNNAME) + (DRAW-DESC-PICMENU DD))) + +(DEFUN DRAW-OPTIMIZE (X) (IF (FBOUNDP 'GLUNWRAP) (GLUNWRAP X NIL) X)) + +(DEFUN DRAW-DESC-FNNAME (DD) + (INTERN (CONCATENATE 'STRING "DRAW-" (SYMBOL-NAME (CADR DD))))) +(SETF (GET 'DRAW-DESC-FNNAME 'GLARGUMENTS) '((DD DRAW-DESC))) +(SETF (GET 'DRAW-DESC-FNNAME 'GLFNRESULTTYPE) 'SYMBOL) + + +(DEFUN DRAW-DESC-PICMENU (DD) + (LET (BUTTONS) + (SETQ BUTTONS + (MAPCAN #'(LAMBDA (OBJ) + (AND (EQ (FIRST OBJ) 'DRAW-BUTTON) + (CONS (LIST (CADDDR OBJ) + (LET + ((GLVAR136 + (LET + ((GLVAR135 + (COPY-LIST '(2 2)))) + (LIST + (+ (CAR GLVAR135) + (CAADR OBJ)) + (+ (CADR GLVAR135) + (CADADR OBJ)))))) + (LIST + (+ (CAR GLVAR136) + (CAR (CADDDR DD))) + (+ (CADR GLVAR136) + (CADR (CADDDR DD)))))) + NIL))) + (CADDR DD))) + (IF BUTTONS + (SETF (GET (CADR DD) 'PICMENU-SPEC) + (LIST 'PICMENU-SPEC (CAR (FIFTH DD)) (CADR (FIFTH DD)) + BUTTONS T (DRAW-DESC-FNNAME DD) '9X15))))) +(SETF (GET 'DRAW-DESC-PICMENU 'GLARGUMENTS) '((DD DRAW-DESC))) +(SETF (GET 'DRAW-DESC-PICMENU 'GLFNRESULTTYPE) + '(LIST GLTYPE INTEGER INTEGER (LISTOF (LIST ANYTHING VECTOR)) + BOOLEAN SYMBOL SYMBOL)) + + +(DEFUN DRAW-DESC-SNAP (DD P) + (LET (PSNAP OBJ (OBJS (CADDR DD))) + (IF *DRAW-SNAP-FLAG* + (WHILE (AND OBJS (NOT PSNAP)) (SETQ OBJ (POP OBJS)) + (SETQ PSNAP (DRAW-OBJECT-SNAP OBJ P (CADDDR DD))))) + (OR PSNAP P))) +(SETF (GET 'DRAW-DESC-SNAP 'GLARGUMENTS) '((DD DRAW-DESC) (P VECTOR))) +(SETF (GET 'DRAW-DESC-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-OBJECT-MOVE (D W OFF) + (DRAW-OBJECT-ERASE D W OFF) + (DRAW-GET-OBJECT-POS D W) + (SETF (CADR D) + (LIST (- (CAADR D) (CAR OFF)) (- (CADADR D) (CADR OFF)))) + (DRAW-OBJECT-DRAW D W OFF) + (XFLUSH *WINDOW-DISPLAY*)) + +(DEFUN DRAW-OBJECT-DRAW-AT (W X Y D) + (SETF (SECOND D) (LIST X Y)) + (DRAW-OBJECT-DRAW D W *DRAW-ZERO-VECTOR*)) + +(DEFUN DRAW-OBJECT-DRAW (D W OFF) + (FUNCALL (GLMETHOD (CAR D) 'DRAW) D W OFF)) + +(DEFUN DRAW-OBJECT-SNAP (D P OFF) + (FUNCALL (GLMETHOD (CAR D) 'SNAP) D P OFF)) + +(DEFUN DRAW-OBJECT-SELECTEDP (D W OFF) + (FUNCALL (GLMETHOD (CAR D) 'SELECTEDP) D W OFF)) + +(DEFUN DRAW-GET-OBJECT-POS (D W) + (WINDOW-GET-ICON-POSITION W + (IF (EQ (FIRST D) 'DRAW-TEXT) #'DRAW-TEXT-DRAW-OUTLINE + #'DRAW-OBJECT-DRAW-AT) + (LIST D))) +(SETF (GET 'DRAW-GET-OBJECT-POS 'GLARGUMENTS) + '((D DRAW-OBJECT) (W WINDOW))) +(SETF (GET 'DRAW-GET-OBJECT-POS 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-OBJECT-ERASE (D W OFF) + (WHEN (NOT (EQ (FIRST D) 'DRAW-ERASE)) + (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (DRAW-OBJECT-DRAW D W OFF) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) + +(DEFUN DRAW-LINE-DRAW (D W OFF) + (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) + (TO (LET ((GLVAR137 + (LIST (+ (CAR OFF) (CAADR D)) + (+ (CADR OFF) (CADADR D))))) + (LIST (+ (CAR GLVAR137) (CAADDR D)) + (+ (CADR GLVAR137) (CADR (CADDR D))))))) + (LET ((QQWHEIGHT (CADDDR W))) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR FROM) + (- QQWHEIGHT (CADR FROM)) (CAR TO) (- QQWHEIGHT (CADR TO))) + NIL))) + +(DEFUN DRAW-ARROW-DRAW (D W OFF) + (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) + (TO (LET ((GLVAR138 + (LIST (+ (CAR OFF) (CAADR D)) + (+ (CADR OFF) (CADADR D))))) + (LIST (+ (CAR GLVAR138) (CAADDR D)) + (+ (CADR GLVAR138) (CADR (CADDR D))))))) + (WINDOW-DRAW-ARROW-XY W (CAR FROM) (CADR FROM) (CAR TO) (CADR TO)))) + +(DEFUN DRAW-LINE-SELECTEDP (D PT OFF) + (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) + (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) + (+ 2 + (+ (+ (CAADR D) (MIN 0 (CAADDR D))) + (ABS (CAADDR D))))) + (BETWEEN (CADR PTP) + (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) + (+ 2 + (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) + (ABS (CADR (CADDR D)))))) + (< (ABS (/ (- (* (CAADDR D) (- (CADR PTP) (CADADR D))) + (* (CADR (CADDR D)) (- (CAR PTP) (CAADR D)))) + (SQRT (+ (EXPT (CAADDR D) 2) + (EXPT (CADR (CADDR D)) 2))))) + 5)))) +(SETF (GET 'DRAW-LINE-SELECTEDP 'GLARGUMENTS) + '((D DRAW-LINE) (PT VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-LINE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-LINE-GET (DD W) + (LET (FROM TO) + (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) + (SETQ TO + (IF *DRAW-LATEX-MODE* + (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) + (DRAW-DESC-SNAP DD + (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) + (LIST 'DRAW-LINE FROM + (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL + 1))) +(SETF (GET 'DRAW-LINE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-LINE-GET 'GLFNRESULTTYPE) 'DRAW-LINE) + + +(DEFUN DRAW-ARROW-GET (DD W) + (LET (FROM TO) + (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) + (SETQ TO + (IF *DRAW-LATEX-MODE* + (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) + (DRAW-DESC-SNAP DD + (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) + (LIST 'DRAW-ARROW FROM + (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL + 1))) +(SETF (GET 'DRAW-ARROW-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-ARROW-GET 'GLFNRESULTTYPE) 'DRAW-ARROW) + + +(DEFUN DRAW-BOX-DRAW (D W OFF) + (LET ((GLVAR139 + (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) + (WINDOW-DRAW-BOX-XY W (CAR GLVAR139) (CADR GLVAR139) (CAADDR D) + (CADR (CADDR D)) NIL))) + +(DEFUN DRAW-BOX-SELECTEDP (D P OFF) + (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) + (OR (AND (< (CADR PT) + (+ 7 + (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) + (ABS (CADR (CADDR D)))))) + (> (CADR PT) + (+ -7 (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) + (OR (< (ABS (+ 2 + (- (CAR PT) + (+ (CAADR D) (MIN 0 (CAADDR D)))))) + 5) + (< (ABS (+ -2 + (- (CAR PT) + (+ (+ (CAADR D) (MIN 0 (CAADDR D))) + (ABS (CAADDR D)))))) + 5))) + (AND (< (CAR PT) + (+ 7 + (+ (+ (CAADR D) (MIN 0 (CAADDR D))) + (ABS (CAADDR D))))) + (> (CAR PT) (+ -7 (+ (CAADR D) (MIN 0 (CAADDR D))))) + (OR (< (ABS (+ -2 + (- (CADR PT) + (+ (+ (CADADR D) + (MIN 0 (CADR (CADDR D)))) + (ABS (CADR (CADDR D))))))) + 5) + (< (ABS (+ 2 + (- (CADR PT) + (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) + 5)))))) +(SETF (GET 'DRAW-BOX-SELECTEDP 'GLARGUMENTS) + '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-BOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-BOX-GET (DD W) + (LET (BOX) + (SETQ BOX (WINDOW-GET-REGION W)) + (LIST 'DRAW-BOX (CAR BOX) (CADR BOX) NIL 1))) +(SETF (GET 'DRAW-BOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-BOX-GET 'GLFNRESULTTYPE) 'DRAW-BOX) + + +(DEFUN DRAW-RCBOX-DRAW (D W OFF) + (WINDOW-DRAW-RCBOX-XY W (+ (CAR OFF) (CAADR D)) + (+ (CADR OFF) (CADADR D)) (CAADDR D) (CADR (CADDR D)) 8)) + +(DEFUN DRAW-RCBOX-SELECTEDP (D P OFF) + (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) + (OR (AND (< (CADR PT) + (1- (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) + (ABS (CADR (CADDR D)))))) + (> (CADR PT) (1+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) + (OR (< (ABS (+ 2 + (- (CAR PT) + (+ (CAADR D) (MIN 0 (CAADDR D)))))) + 5) + (< (ABS (+ -2 + (- (CAR PT) + (+ (+ (CAADR D) (MIN 0 (CAADDR D))) + (ABS (CAADDR D)))))) + 5))) + (AND (< (CAR PT) + (1- (+ (+ (CAADR D) (MIN 0 (CAADDR D))) + (ABS (CAADDR D))))) + (> (CAR PT) (1+ (+ (CAADR D) (MIN 0 (CAADDR D))))) + (OR (< (ABS (+ -2 + (- (CADR PT) + (+ (+ (CADADR D) + (MIN 0 (CADR (CADDR D)))) + (ABS (CADR (CADDR D))))))) + 5) + (< (ABS (+ 2 + (- (CADR PT) + (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) + 5)))))) +(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLARGUMENTS) + '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-RCBOX-GET (DD W) + (LET (BOX) + (SETQ BOX (WINDOW-GET-REGION W)) + (LIST 'DRAW-RCBOX (CAR BOX) (CADR BOX) NIL 1))) +(SETF (GET 'DRAW-RCBOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-RCBOX-GET 'GLFNRESULTTYPE) 'DRAW-RCBOX) + + +(DEFUN DRAW-CIRCLE-DRAW (D W OFF) + (LET ((GLVAR142 + (LET ((GLVAR141 + (LET ((GLVAR140 + (LIST (* 1/2 (CAADDR D)) + (* 1/2 (CADR (CADDR D)))))) + (LIST (+ (CAADR D) (CAR GLVAR140)) + (+ (CADADR D) (CADR GLVAR140)))))) + (LIST (+ (CAR OFF) (CAR GLVAR141)) + (+ (CADR OFF) (CADR GLVAR141)))))) + (WINDOW-DRAW-CIRCLE-XY W (CAR GLVAR142) (CADR GLVAR142) + (* 1/2 (CAADDR D)) NIL))) + +(DEFUN DRAW-CIRCLE-SELECTEDP (D P OFF) + (< (ABS (- (* 1/2 (CAADDR D)) + (LET ((SELF (LET ((GLVAR146 + (LET + ((GLVAR145 + (LET + ((GLVAR144 + (LIST (* 1/2 (CAADDR D)) + (* 1/2 (CADR (CADDR D)))))) + (LIST + (+ (CAADR D) (CAR GLVAR144)) + (+ (CADADR D) (CADR GLVAR144)))))) + (LIST (+ (CAR GLVAR145) (CAR OFF)) + (+ (CADR GLVAR145) (CADR OFF)))))) + (LIST (- (CAR GLVAR146) (CAR P)) + (- (CADR GLVAR146) (CADR P)))))) + (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))))) + 5)) +(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLARGUMENTS) + '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-CIRCLE-GET (DD W) + (LET (CIR CENT) + (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) + (SETQ CIR (WINDOW-GET-CIRCLE W CENT)) + (LIST 'DRAW-CIRCLE + (LIST (- (CAAR CIR) (CADR CIR)) (- (CADAR CIR) (CADR CIR))) + (LIST (* 2 (CADR CIR)) (* 2 (CADR CIR))) NIL 1))) +(SETF (GET 'DRAW-CIRCLE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-CIRCLE-GET 'GLFNRESULTTYPE) 'DRAW-CIRCLE) + + +(DEFUN DRAW-ELLIPSE-DRAW (D W OFF) + (LET ((C (LET ((GLVAR148 + (LET ((GLVAR147 + (LIST (* 1/2 (CAADDR D)) + (* 1/2 (CADR (CADDR D)))))) + (LIST (+ (CAADR D) (CAR GLVAR147)) + (+ (CADADR D) (CADR GLVAR147)))))) + (LIST (+ (CAR OFF) (CAR GLVAR148)) + (+ (CADR OFF) (CADR GLVAR148)))))) + (LET ((GLVAR149 (* 1/2 (CAADDR D))) + (GLVAR150 (* 1/2 (CADR (CADDR D))))) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) + (- (CAR C) GLVAR149) (- (CADDDR W) (+ (CADR C) GLVAR150)) + (* 2 GLVAR149) (* 2 GLVAR150) 0 23040) + NIL))) + +(DEFUN DRAW-ELLIPSE-SELECTEDP (D P OFF) + (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) + (< (ABS (- (+ (LET ((SELF (LET ((GLVAR156 + (IF + (> (CAADDR D) (CADR (CADDR D))) + (LIST + (ROUND + (- + (+ (CAADR D) + (* 1/2 (CAADDR D))) + (SQRT + (ABS + (* 1/4 + (- (EXPT (CAADDR D) 2) + (EXPT (CADR (CADDR D)) 2))))))) + (+ (CADADR D) + (* 1/2 (CADR (CADDR D))))) + (LIST + (+ (CAADR D) (* 1/2 (CAADDR D))) + (ROUND + (- + (+ (CADADR D) + (* 1/2 (CADR (CADDR D)))) + (SQRT + (ABS + (* 1/4 + (- (EXPT (CAADDR D) 2) + (EXPT (CADR (CADDR D)) 2))))))))))) + (LIST (- (CAR GLVAR156) (CAR PT)) + (- (CADR GLVAR156) (CADR PT)))))) + (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))) + (LET ((SELF (LET ((GLVAR161 + (IF + (> (CAADDR D) (CADR (CADDR D))) + (LIST + (ROUND + (+ + (+ (CAADR D) + (* 1/2 (CAADDR D))) + (SQRT + (ABS + (* 1/4 + (- (EXPT (CAADDR D) 2) + (EXPT (CADR (CADDR D)) 2))))))) + (+ (CADADR D) + (* 1/2 (CADR (CADDR D))))) + (LIST + (+ (CAADR D) (* 1/2 (CAADDR D))) + (ROUND + (+ + (+ (CADADR D) + (* 1/2 (CADR (CADDR D)))) + (SQRT + (ABS + (* 1/4 + (- (EXPT (CAADDR D) 2) + (EXPT (CADR (CADDR D)) 2))))))))))) + (LIST (- (CAR GLVAR161) (CAR PT)) + (- (CADR GLVAR161) (CADR PT)))))) + (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2))))) + (* 2 (MAX (* 1/2 (CAADDR D)) (* 1/2 (CADR (CADDR D))))))) + 2))) +(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLARGUMENTS) + '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-TEST-ELLIPSE-SELECTEDP (E) + (LET ((SIZE (THIRD E)) (OFFSET (SECOND E))) + (DOTIMES (Y (+ (CADR SIZE) 10)) + (DOTIMES (X (+ (CAR SIZE) 10)) + (PRINC (IF (DRAW-ELLIPSE-SELECTEDP E + (LIST (+ X (CAR OFFSET) -5) + (+ Y (CADR OFFSET) -5)) + (LIST 0 0)) + "T" " "))) + (TERPRI)))) + +(DEFUN DRAW-ELLIPSE-GET (DD W) + (LET (ELL CENT) + (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) + (SETQ ELL (WINDOW-GET-ELLIPSE W CENT)) + (LIST 'DRAW-ELLIPSE + (LIST (- (CAAR ELL) (CAADR ELL)) + (- (CADAR ELL) (CADADR ELL))) + (LIST (* 2 (CAADR ELL)) (* 2 (CADADR ELL))) NIL 1))) +(SETF (GET 'DRAW-ELLIPSE-GET 'GLARGUMENTS) + '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-ELLIPSE-GET 'GLFNRESULTTYPE) 'DRAW-ELLIPSE) + + +(DEFUN DRAW-NULL-DRAW (D W OFF) NIL) + +(DEFUN DRAW-NULL-SELECTEDP (D PT OFF) NIL) + +(DEFUN DRAW-BUTTON-DRAW (D W OFF) + (LET ((GLVAR162 + (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) + (GLVAR163 (COPY-LIST '(4 4)))) + (WINDOW-DRAW-BOX-XY W (CAR GLVAR162) (CADR GLVAR162) (CAR GLVAR163) + (CADR GLVAR163) NIL))) + +(DEFUN DRAW-BUTTON-SELECTEDP (D P OFF) + (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) + (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) + (AND (> PTX -2) (< PTX 6) (> PTY -2) (< PTY 6)))) +(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLARGUMENTS) + '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-BUTTON-GET (DD W) + (LET (CENT VAR) + (PRINC "Enter button name: ") + (SETQ VAR (READ)) + (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) + (LIST 'DRAW-BUTTON (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) + (COPY-LIST '(4 4)) VAR 1))) +(SETF (GET 'DRAW-BUTTON-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-BUTTON-GET 'GLFNRESULTTYPE) 'DRAW-BUTTON) + + +(DEFUN DRAW-ERASE-DRAW (D W OFF) + (LET ((GLVAR164 + (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) + (WINDOW-ERASE-AREA-XY W (CAR GLVAR164) (CADR GLVAR164) (CAADDR D) + (CADR (CADDR D))))) + +(DEFUN DRAW-ERASE-SELECTEDP (D P OFF) + (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) + (AND (BETWEEN (CAR PT) (CAADR D) (+ (CAADR D) (CAADDR D))) + (BETWEEN (CADR PT) (CADADR D) (+ (CADADR D) (CADR (CADDR D))))))) +(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLARGUMENTS) + '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-ERASE-GET (DD W) + (LET (BOX) + (SETQ BOX (WINDOW-GET-REGION W)) + (LIST 'DRAW-ERASE (CAR BOX) (CADR BOX) NIL 1))) +(SETF (GET 'DRAW-ERASE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-ERASE-GET 'GLFNRESULTTYPE) 'DRAW-ERASE) + + +(DEFUN DRAW-DOT-DRAW (D W OFF) + (WINDOW-DRAW-DOT-XY W (+ 2 (+ (CAR OFF) (CAADR D))) + (+ 2 (+ (CADR OFF) (CADADR D))))) + +(DEFUN DRAW-DOT-GET (DD W) + (LET (CENT) + (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) + (LIST 'DRAW-DOT (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) + (COPY-LIST '(4 4)) NIL 1))) +(SETF (GET 'DRAW-DOT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-DOT-GET 'GLFNRESULTTYPE) 'DRAW-DOT) + + +(DEFUN DRAW-REFPT-DRAW (D W OFF) + (WINDOW-DRAW-CROSSHAIRS-XY W (+ (CAR OFF) (CAADR D)) + (+ (CADR OFF) (CADADR D)))) + +(DEFUN DRAW-REFPT-SELECTEDP (D P OFF) + (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) + (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) + (AND (> PTX -3) (< PTX 3) (> PTY -3) (< PTY 3)))) +(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLARGUMENTS) + '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-REFPT-GET (DD W) + (LET (CENT REFPT) + (WHEN (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) + (LET ((GC (CADDR *DRAW-WINDOW*))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 3) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*)))) + (DRAW-OBJECT-DRAW REFPT *DRAW-WINDOW* (COPY-LIST '(0 0))) + (LET ((GC (CADDR *DRAW-WINDOW*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)) + (SETF (CADDR DD) (REMOVE REFPT (CADDR DD)))) + (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) + (LIST 'DRAW-REFPT CENT (COPY-LIST '(0 0)) NIL 1))) +(SETF (GET 'DRAW-REFPT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-REFPT-GET 'GLFNRESULTTYPE) 'DRAW-REFPT) + + +(DEFUN DRAW-DESC-REFPT (DD) + (LET (REFPT) + (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) + (IF REFPT (CADR REFPT) (COPY-LIST '(0 0))))) +(SETF (GET 'DRAW-DESC-REFPT 'GLARGUMENTS) '((DD DRAW-DESC))) +(SETF (GET 'DRAW-DESC-REFPT 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-TEXT-DRAW (D W OFF) + (LET ((SSTR (STRINGIFY (CADDDR D)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) + (+ (CAR OFF) (CAADR D)) + (- (CADDDR W) (+ (CADR OFF) (CADADR D))) (GET-C-STRING SSTR) + (LENGTH SSTR)))) + +(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) + (SETF (SECOND D) (LIST X Y)) + (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) + +(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) + (SETF (SECOND D) (LIST X Y)) + (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) + +(DEFUN DRAW-TEXT-SELECTEDP (D PT OFF) + (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) + (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) + (+ 2 + (+ (+ (CAADR D) (MIN 0 (CAADDR D))) + (ABS (CAADDR D))))) + (BETWEEN (CADR PTP) + (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) + (+ 2 + (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) + (ABS (CADR (CADDR D))))))))) +(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLARGUMENTS) + '((D DRAW-TEXT) (PT VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN DRAW-TEXT-GET (DD W) + (LET (TXT LNG OFF) + (PRINC "Enter text string: ") + (SETQ TXT (STRINGIFY (READ))) + (SETQ LNG + (LET ((SSTR (STRINGIFY TXT))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) + (SETQ OFF (WINDOW-GET-BOX-POSITION W LNG 14)) + (LIST 'DRAW-TEXT + (LET ((GLVAR167 (COPY-LIST '(0 4)))) + (LIST (+ (CAR OFF) (CAR GLVAR167)) + (+ (CADR OFF) (CADR GLVAR167)))) + (LIST LNG 14) TXT 1))) +(SETF (GET 'DRAW-TEXT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) +(SETF (GET 'DRAW-TEXT-GET 'GLFNRESULTTYPE) 'DRAW-TEXT) + + +(DEFUN DRAW-SNAPP (P1 OFF P2X P2Y) + (IF (AND (< (ABS (- (- (CAR P1) (CAR OFF)) P2X)) 4) + (< (ABS (- (- (CADR P1) (CADR OFF)) P2Y)) 4)) + (LIST (+ (CAR OFF) P2X) (+ (CADR OFF) P2Y)))) +(SETF (GET 'DRAW-SNAPP 'GLARGUMENTS) + '((P1 VECTOR) (OFF VECTOR) (P2X INTEGER) (P2Y INTEGER))) +(SETF (GET 'DRAW-SNAPP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-DOT-SNAP (D P OFF) + (DRAW-SNAPP P OFF (+ 2 (CAADR D)) (+ 2 (CADADR D)))) +(SETF (GET 'DRAW-DOT-SNAP 'GLARGUMENTS) + '((D DRAW-DOT) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-DOT-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-REFPT-SNAP (D P OFF) + (DRAW-SNAPP P OFF (CAADR D) (CADADR D))) +(SETF (GET 'DRAW-REFPT-SNAP 'GLARGUMENTS) + '((D DRAW-REFPT) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-REFPT-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-LINE-SNAP (D P OFF) + (OR (DRAW-SNAPP P OFF (CAADR D) (CADADR D)) + (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) + (+ (CADADR D) (CADR (CADDR D)))))) +(SETF (GET 'DRAW-LINE-SNAP 'GLARGUMENTS) + '((D DRAW-LINE) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-LINE-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-BOX-SNAP (D P OFF) + (LET ((XOFF (CAADR D)) (YOFF (CADADR D)) (XSIZE (CAADDR D)) + (YSIZE (CADR (CADDR D)))) + (OR (DRAW-SNAPP P OFF XOFF YOFF) + (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF YSIZE)) + (DRAW-SNAPP P OFF (+ XOFF XSIZE) YOFF) + (DRAW-SNAPP P OFF XOFF (+ YOFF YSIZE)) + (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) YOFF) + (DRAW-SNAPP P OFF XOFF (+ YOFF (* 1/2 YSIZE))) + (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) (+ YOFF YSIZE)) + (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF (* 1/2 YSIZE)))))) +(SETF (GET 'DRAW-BOX-SNAP 'GLARGUMENTS) + '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-BOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-CIRCLE-SNAP (D P OFF) + (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) + (+ (CADADR D) (* 1/2 (CAADDR D)))) + (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) + (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) (* 1/2 (CAADDR D)))) + (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) + (+ (CADADR D) (CADR (CADDR D)))) + (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) + (+ (CADADR D) (* 1/2 (CAADDR D)))))) +(SETF (GET 'DRAW-CIRCLE-SNAP 'GLARGUMENTS) + '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-CIRCLE-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-ELLIPSE-SNAP (D P OFF) + (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) + (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) + (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) + (DRAW-SNAPP P OFF (CAADR D) + (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) + (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) + (+ (CADADR D) (CADR (CADDR D)))) + (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) + (+ (CADADR D) (* 1/2 (CADR (CADDR D))))))) +(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLARGUMENTS) + '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-RCBOX-SNAP (D P OFF) + (LET ((RX (* 1/2 (CAADDR D))) (RY (* 1/2 (CADR (CADDR D))))) + (OR (DRAW-SNAPP P OFF (+ (CAADR D) RX) (CADADR D)) + (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) RY)) + (DRAW-SNAPP P OFF (+ (CAADR D) RX) + (+ (CADADR D) (CADR (CADDR D)))) + (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) (+ (CADADR D) RY))))) +(SETF (GET 'DRAW-RCBOX-SNAP 'GLARGUMENTS) + '((D DRAW-RCBOX) (P VECTOR) (OFF VECTOR))) +(SETF (GET 'DRAW-RCBOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-NO-SNAP (D P OFF) NIL) + +(DEFUN DRAW-MULTI-DRAW (D W OFF) + (LET ((TOTALOFF + (LIST (+ (CAADR D) (CAR OFF)) (+ (CADADR D) (CADR OFF))))) + (DOLIST (SUBD (CADDDR D)) (DRAW-OBJECT-DRAW SUBD W TOTALOFF)))) + +(DEFUN DRAW-INIT-MENUS () + (LET ((W (DRAW-WINDOW))) + (WINDOW-CLEAR W) + (DOLIST (FN '(DRAW-MENU-RECTANGLE DRAW-MENU-CIRCLE + DRAW-MENU-ELLIPSE DRAW-MENU-LINE DRAW-MENU-ARROW + DRAW-MENU-DOT DRAW-MENU-BUTTON DRAW-MENU-TEXT)) + (SETF (GET FN 'DISPLAY-SIZE) '(30 20))) + (SETQ *DRAW-MENU-SET* (MENU-SET-CREATE W NIL)) + (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'DRAW NIL "Draw" + '((DRAW-MENU-RECTANGLE . RECTANGLE) (DRAW-MENU-RCBOX . RCBOX) + (DRAW-MENU-CIRCLE . CIRCLE) (DRAW-MENU-ELLIPSE . ELLIPSE) + (DRAW-MENU-LINE . LINE) (DRAW-MENU-ARROW . ARROW) + (DRAW-MENU-DOT . DOT) (" " . ERASE) + (DRAW-MENU-BUTTON . BUTTON) (DRAW-MENU-TEXT . TEXT) + (DRAW-MENU-REFPT . REFPT)) + (LIST 0 0)) + (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'TOP NIL 1) + (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'RIGHT NIL 2) + (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'COMMAND NIL "Commands" + '(("Done" . DONE) ("Move" . MOVE) ("Delete" . DELETE) + ("Copy" . COPY) ("Redraw" . REDRAW) ("Origin" . ORIGIN) + ("LaTex Mode" . LATEXMODE) ("Make Program" . PROGRAM) + ("Make LaTex" . LATEX)) + (LIST 0 0)) + (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'TOP 'DRAW 5) + (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'RIGHT NIL 2))) + +(DEFUN DRAW-MENU-RECTANGLE (W X Y) + (WINDOW-DRAW-BOX-XY W (+ X 3) (+ Y 3) 24 14 1)) + +(DEFUN DRAW-MENU-RCBOX (W X Y) + (WINDOW-DRAW-RCBOX-XY W (+ X 3) (+ Y 3) 24 14 3 1)) + +(DEFUN DRAW-MENU-CIRCLE (W X Y) + (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 10) 8 1)) + +(DEFUN DRAW-MENU-ELLIPSE (W X Y) + (WINDOW-DRAW-ELLIPSE-XY W (+ X 15) (+ Y 10) 12 8 1)) + +(DEFUN DRAW-MENU-LINE (W X Y) + (WINDOW-DRAW-LINE-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) + +(DEFUN DRAW-MENU-ARROW (W X Y) + (WINDOW-DRAW-ARROW-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) + +(DEFUN DRAW-MENU-DOT (W X Y) (WINDOW-DRAW-DOT-XY W (+ X 15) (+ Y 10))) + +(DEFUN DRAW-MENU-BUTTON (W X Y) + (WINDOW-DRAW-BOX-XY W (+ X 14) (+ Y 5) 4 4 1)) + +(DEFUN DRAW-MENU-TEXT (W X Y) + (WINDOW-PRINTAT-XY W "A" (+ X 12) (+ Y 5))) + +(DEFUN DRAW-MENU-REFPT (W X Y) + (WINDOW-DRAW-CROSSHAIRS-XY W (+ X 15) (+ Y 9)) + (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 9) 2)) + +(DEFUN LATEX-LINE (FROMX FROMY X Y &OPTIONAL ARROWFLG) + (LET (DX DY SX SY SIZ ERR ERRB) + (SETQ DX (- X FROMX)) + (SETQ DY (- Y FROMY)) + (IF (= DX 0) + (PROGN + (SETQ SX 0) + (SETQ SY (IF (>= DY 0) 1 -1)) + (SETQ SIZ (* (ABS DY) *DRAW-LATEX-FACTOR*))) + (IF (= DY 0) + (PROGN + (SETQ SX (IF (>= DX 0) 1 -1)) + (SETQ SY 0) + (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*))) + (PROGN + (SETQ ERR 9999) + (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*)) + (DOTIMES (I (IF ARROWFLG 4 6)) + (DOTIMES (J (IF ARROWFLG 4 6)) + (SETQ ERRB + (ABS (- (/ (FLOAT (1+ I)) (FLOAT (1+ J))) + (ABS (/ (FLOAT DX) (FLOAT DY)))))) + (IF (AND (= (GCD (1+ I) (1+ J)) 1) (< ERRB ERR)) + (PROGN + (SETQ ERR ERRB) + (SETQ SX (1+ I)) + (SETQ SY (1+ J)))))) + (SETQ SX (* SX (LATEX-SIGN DX))) + (SETQ SY (* SY (LATEX-SIGN DY)))))) + (FORMAT T " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" + (* FROMX *DRAW-LATEX-FACTOR*) (* FROMY *DRAW-LATEX-FACTOR*) + (IF ARROWFLG "vector" "line") SX SY SIZ))) + +(DEFUN LATEX-SIGN (X) (IF (>= X 0) 1 -1)) + +(DEFUN DRAW-OUTPUT (OUTFILENAME &OPTIONAL NAMES) + (PROG (PRETTYSAVE LENGTHSAVE D FNNAME CODE) + (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) + (IF (SYMBOLP NAMES) (SETQ NAMES (LIST NAMES))) + (WITH-OPEN-FILE + (OUTFILE OUTFILENAME :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE) + (SETQ PRETTYSAVE *PRINT-PRETTY*) + (SETQ LENGTHSAVE *PRINT-LENGTH*) + (SETQ *PRINT-PRETTY* T) + (SETQ *PRINT-LENGTH* 80) + (FORMAT OUTFILE "; ~A ~A~%" OUTFILENAME (DRAW-GET-TIME-STRING)) + (DOLIST (NAME NAMES) + (IF (SETQ D (GET NAME 'DRAW-DESCR)) + (PROGN + (TERPRI OUTFILE) + (PRINT (LIST 'SETF + (LIST 'GET (LIST 'QUOTE NAME) ''DRAW-DESCR) + (LIST 'QUOTE D)) + OUTFILE) + (IF (AND (SETQ FNNAME (DRAW-DESC-FNNAME D)) + (SETQ CODE (SYMBOL-FUNCTION FNNAME))) + (PROGN + (TERPRI OUTFILE) + (PRINT (CONS 'DEFUN + (IF (EQ (CAR CODE) 'LAMBDA-BLOCK) + (CDR CODE) + (CONS FNNAME (CDR CODE)))) + OUTFILE))))) + (IF (SETQ D (GET NAME 'PICMENU-SPEC)) + (PROGN + (TERPRI OUTFILE) + (PRINT (LIST 'SETF + (LIST 'GET (LIST 'QUOTE NAME) + ''PICMENU-SPEC) + (LIST 'QUOTE D)) + OUTFILE)))) + (TERPRI OUTFILE) + (SETQ *PRINT-PRETTY* PRETTYSAVE) + (SETQ *PRINT-LENGTH* LENGTHSAVE)) + (RETURN OUTFILENAME))) + +(DEFUN DRAW-GET-TIME-STRING () + (LET (SECOND MINUTE HOUR DATE MONTH YEAR) + (MULTIPLE-VALUE-SETQ (SECOND MINUTE HOUR DATE MONTH YEAR) + (GET-DECODED-TIME)) + (FORMAT NIL "~2D ~A ~4D ~2D:~2D:~2D" DATE + (NTH (1- MONTH) + '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" + "Sep" "Oct" "Nov" "Dec")) + YEAR HOUR MINUTE SECOND))) + +(DEFUN COMPILE-DRAW () + (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") + '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" + "glisp/draw-header.lsp") + (CF DRAWTRANS)) + +(DEFUN COMPILE-DRAWB () + (GLCOMPFILES *DIRECTORY* + '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" + "glisp/draw-header.lsp")) + +(DEFUN DRAW-OUT (&OPTIONAL NAMES FILE) + (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) + (IF (NOT (CONSP NAMES)) (SETQ NAMES (LIST NAMES))) + (DRAW-OUTPUT (OR FILE "glisp/draw.del") NAMES) + (SETQ *DRAW-OBJECTS* (SET-DIFFERENCE *DRAW-OBJECTS* NAMES)) + NAMES) diff --git a/xgcl-2/gcl_dwexports.lsp b/xgcl-2/gcl_dwexports.lsp new file mode 100644 index 0000000..cf30668 --- /dev/null +++ b/xgcl-2/gcl_dwexports.lsp @@ -0,0 +1,153 @@ +; dwexports.lsp Gordon S. Novak Jr. 26 Jan 2006 + + +(setf (get 'xlib::int-pos 'user::glfnresulttype) 'lisp::integer) + +(in-package :xlib) + +; exported symbols: from dwimports.lsp +(dolist (x '( menu stringify window picmenu textmenu editmenu barmenu + window-get-mouse-position window-create window-set-font + window-font-info window-gcontext window-parent + window-drawable-height window-drawable-width window-label + window-font window-foreground window-set-foreground + window-background window-set-background window-wfunction + window-get-geometry window-get-geometry-b window-sync + window-screen-height window-geometry window-size + window-left window-top-neg-y window-reset-geometry + window-force-output window-query-pointer window-set-xor + window-unset window-reset window-set-erase + window-set-copy window-set-invert window-set-line-width + window-set-line-attr window-std-line-attr window-draw-line + window-draw-line-xy window-draw-arrowhead-xy + window-draw-arrow-xy window-draw-arrow2-xy window-draw-box + window-draw-box-xy window-xor-box-xy window-draw-box-corners + window-draw-rcbox-xy window-draw-arc-xy + window-draw-circle-xy window-draw-circle window-erase-area + window-erase-area-xy window-erase-box-xy + window-draw-ellipse-xy window-copy-area-xy window-invertarea + window-invert-area window-invert-area-xy + window-prettyprintat window-prettyprintat-xy window-printat + window-printat-xy window-string-width window-string-height + window-string-extents window-font-string-width + window-yposition window-centeroffset dowindowcom + window-menu window-close window-unmap window-open + window-map window-destroy window-destroy-selected-window + window-clear window-moveto-xy window-paint + window-move window-draw-border window-track-mouse + window-wait-exposure window-wait-unmap + window-init-mouse-poll window-poll-mouse menu-init + menu-calculate-size menu-adjust-offset menu-draw + menu-item-value menu-find-item-width menu-find-item-height + menu-clear menu-display-item menu-choose menu-box-item + menu-unbox-item menu-item-position menu-select + menu-select! menu-select-b menu-destroy + menu-create menu-offset menu-size menu-moveto-xy + menu-reposition picmenu-create picmenu-create-spec + picmenu-create-from-spec picmenu-calculate-size picmenu-init + picmenu-draw picmenu-draw-button picmenu-delete-named-button + picmenu-select picmenu-box-item picmenu-unbox-item + picmenu-destroy picmenu-button-containsxy? + picmenu-item-position barmenu-create + barmenu-calculate-size barmenu-init barmenu-draw + barmenu-select barmenu-update-value window-get-point + window-get-click window-get-line-position + window-get-latex-position window-get-box-position + window-get-icon-position window-get-region + window-get-box-size window-track-mouse-in-region + window-adjust-box-side window-adj-box-xy window-get-circle + window-circle-radius window-draw-circle-pt + window-get-ellipse window-draw-ellipse-pt + window-draw-vector-pt window-get-vector-end + window-get-crosshairs window-draw-crosshairs-xy + window-get-cross window-draw-cross-xy window-draw-dot-xy + window-draw-latex-xy window-reset-color + window-set-color-rgb window-set-xcolor window-set-color + window-set-color window-free-color window-get-chars + window-process-char-event window-input-string + window-input-char-fn window-draw-carat window-init-keymap + window-set-cursor window-positive-y window-code-char + window-get-raw-char + window-print-line window-print-lines textmenu-create + textmenu-calculate-size textmenu-init textmenu-draw + textmenu-select textmenu-set-text textmenu + editmenu editmenu-create editmenu-calculate-size + editmenu-init editmenu-draw editmenu-display + window-edit + window-edit-display editmenu-carat editmenu-erase + window-edit-erase editmenu-select editmenu-edit-fn + window-edit-fn editmenu-setxy editmenu-char + editmenu-edit + *window-editmenu-kill-strings* +*window-add-menu-title* +*window-menu* +*mouse-x* +*mouse-y* +*mouse-window* +*window-fonts* +*window-display* +*window-screen* +*root-window* +*black-pixel* +*white-pixel* +*default-fg-color* +*default-bg-color* +*default-size-hints* +*default-GC* +*default-colormap* +*window-event* +*window-default-pos-x* +*window-default-pos-y* +*window-default-border* +*window-default-font-name* +*window-default-cursor* +*window-save-foreground* +*window-save-function* +*window-attributes* +*window-attr* +*menu-title-pad* +*root-return* +*child-return* +*root-x-return* +*root-y-return* +*win-x-return* +*win-y-return* +*mask-return* +*x-return* +*y-return* +*width-return* +*height-return* +*depth-return* +*border-width-return* +*text-width-return* +*direction-return* +*ascent-return* +*descent-return* +*overall-return* +*GC-Values* +*window-xcolor* +*window-menu-code* + +*window-keymap* +*window-shiftkeymap* +*window-keyinit* +*window-meta* +*window-ctrl* +*window-shift* +*window-string* +*window-string-count* +*window-string-max* +*window-input-string-x* +*window-input-string-y* +*window-input-string-charwidth* + +*window-shift-keys* +*window-control-keys* +*window-meta-keys* +*barmenu-update-value-cons* +*picmenu-no-selection* +*min-keycodes-return* +*max-keycodes-return* +*keycodes-return* + )) + (export x)) ; export the above symbols diff --git a/xgcl-2/gcl_dwimports.lsp b/xgcl-2/gcl_dwimports.lsp new file mode 100644 index 0000000..2d570cc --- /dev/null +++ b/xgcl-2/gcl_dwimports.lsp @@ -0,0 +1,77 @@ +; dwimports.lsp Gordon S. Novak Jr. 08 Sep 06 + +; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. + +; This file imports symbols of the XGCL package; these symbols may be +; needed by a more serious user of some of the XGCL functions. + +; See the file gnu.license . + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +; This file should be loaded immediately after starting Lisp: +; If Lisp has seen any of these symbols, loading this file will cause an error. + +(dolist (x '( xlib::picmenu-spec xlib::picmenu-button xlib::rgb + xlib::menu-window xlib::flat xlib::parent-window xlib::parent-offset-x + xlib::parent-offset-y xlib::picture-width xlib::picture-height + xlib::title xlib::permanent xlib::menu-font xlib::item-width xlib::item-height + xlib::items xlib::menuw xlib::title-present xlib::width xlib::height + xlib::base-x xlib::base-y xlib::offset xlib::size xlib::region xlib::voffset + xlib::vsize xlib::init xlib::init? xlib::contains? xlib::create xlib::clear + xlib::select xlib::select! xlib::choose xlib::draw xlib::destroy + xlib::moveto-xy xlib::reposition xlib::box-item xlib::unbox-item + xlib::display-item xlib::item-value xlib::item-position xlib::find-item-width + xlib::find-item-height xlib::adjust-offset xlib::calculate-size + xlib::menu-x xlib::menu-y xlib::spec xlib::boxflg xlib::deleted-buttons + xlib::draw-button xlib::delete-named-button xlib::drawing-width + xlib::drawing-height xlib::buttons xlib::dotflg xlib::drawfn xlib::menu-font + xlib::offset xlib::size xlib::highlightfn xlib::unhighlightfn + xlib::containsxy? xlib::color xlib::value xlib::maxval xlib::barwidth + xlib::horizontal xlib::subtrackfn xlib::subtrackparms xlib::update-value + xlib::gcontext xlib::parent xlib::drawable-height xlib::drawable-width + xlib::label xlib::font xlib::width xlib::height xlib::left xlib::right + xlib::top-neg-y xlib::leftmargin xlib::rightmargin xlib::yposition + xlib::wfunction xlib::foreground xlib::background xlib::force-output + xlib::set-font xlib::set-foreground xlib::set-background + xlib::set-cursor xlib::set-erase xlib::set-xor xlib::set-invert xlib::set-copy + xlib::set-line-width xlib::set-line-attr xlib::std-line-attr xlib::unset + xlib::reset xlib::sync xlib::geometry xlib::size xlib::get-geometry + xlib::reset-geometry xlib::query-pointer xlib::wait-exposure xlib::wait-unmap + xlib::clear xlib::mapw xlib::unmap xlib::destroy + xlib::positive-y xlib::drawline xlib::draw-line xlib::draw-line-xy + xlib::draw-latex-xy xlib::draw-arrow-xy xlib::draw-arrow2-xy + xlib::draw-arrowhead-xy xlib::draw-box xlib::draw-box-xy + xlib::draw-box-corners xlib::draw-rcbox-xy xlib::xor-box-xy xlib::draw-circle + xlib::draw-circle-xy xlib::draw-ellipse-xy xlib::draw-arc-xy xlib::invertarea + xlib::invert-area xlib::invert-area-xy xlib::copy-area-xy xlib::printat + xlib::printat-xy xlib::prettyprintat-xy xlib::prettyprintat xlib::string-width + xlib::string-extents xlib::erase-area xlib::erase-area-xy xlib::erase-box-xy + xlib::moveto-xy xlib::move xlib::paint xlib::centeroffset xlib::draw-border + xlib::track-mouse xlib::track-mouse-in-region xlib::init-mouse-poll + xlib::poll-mouse xlib::get-point xlib::get-click xlib::get-line-position + xlib::get-latex-position xlib::get-icon-position xlib::get-box-position + xlib::get-box-size xlib::get-region xlib::adjust-box-side + xlib::get-mouse-position xlib::get-circle xlib::get-ellipse + xlib::get-crosshairs xlib::draw-crosshairs-xy xlib::get-cross + xlib::draw-cross-xy xlib::draw-dot-xy xlib::draw-vector-pt + xlib::get-vector-end xlib::reset-color xlib::set-color-rgb xlib::set-color + xlib::set-xcolor xlib::free-color xlib::get-chars xlib::input-string + xlib::courier-bold-12 xlib::8x10 xlib::9x15 xlib::center xlib::top + xlib::bottom xlib::xor xlib::erase xlib::copy xlib::buttonname + )) (import x)) diff --git a/xgcl-2/gcl_dwimportsb.lsp b/xgcl-2/gcl_dwimportsb.lsp new file mode 100644 index 0000000..1f7e5a5 --- /dev/null +++ b/xgcl-2/gcl_dwimportsb.lsp @@ -0,0 +1,76 @@ +; dwimportsb.lsp Gordon S. Novak Jr. 11 Sep 06 + +; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. + +; This file imports symbols of the XGCL package; these symbols may be +; needed by a hard-core user of the Xlib functions. + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; This file imports symbols from the dwindow.lsp file (in XLIB: package) +; to the current package (such as the :USER package). +; This will allow the dwindow.lsp functions to be called by just their +; names and without any package qualifier. + +; This file should be loaded immediately after starting Lisp: +; If Lisp has seen any of these symbols, loading this file will cause an error. + +(dolist (x '(xlib::XRecolorCursor +xlib::XFlush xlib::XUnMapWindow xlib::XClearWindow xlib::XMapWindow +xlib::XTextWidth xlib::XOpenDisplay xlib::XdefaultScreen xlib::XRootWindow +xlib::XBlackPixel xlib::XWhitePixel xlib::XDefaultGC xlib::XDefaultColormap +xlib::make-XsetWindowAttributes xlib::set-XsetWindowAttributes-backing_store +xlib::set-XsetWindowAttributes-save_under xlib::make-XWindowAttributes +xlib::make-XsizeHints xlib::make-XEvent xlib::make-XGCValues +xlib::XQueryPointer xlib::XCreateSimpleWindow xlib::XsetStandardProperties +xlib::XCreateGC xlib::CWSaveUnder xlib::CWBackingStore +xlib::XloadQueryFont xlib::XsetFont xlib::XGetGCValues +xlib::XGCValues-foreground xlib::XsetForeground xlib::XGCValues-Background +xlib::XsetBackground xlib::XGCValues-function xlib::XCreateFontCursor +xlib::XDefineCursor xlib::XGetGeometry +xlib::Xsync xlib::XsetFunction xlib::GXxor xlib::GXcopy +xlib::XsetLineAttributes xlib::LineSolid xlib::CapButt xlib::JoinMiter +xlib::XDrawLine xlib::XdrawArc xlib::XClearArea xlib::XCopyArea +xlib::XFillRectangle xlib::XdrawImageString xlib::XTextExtents +xlib::XDestroyWindow xlib::XFreeGC xlib::XMoveWindow xlib::Xsync +xlib::Xselectinput xlib::ButtonPressMask xlib::PointerMotionMask +xlib::XNextEvent xlib::XAnyEvent-type xlib::XAnyEvent-window +xlib::MotionNotify xlib::ButtonPress +xlib::XMotionEvent-x xlib::XMotionEvent-y xlib::XButtonEvent-button +xlib::XAnyEvent-window +xlib::XButtonEvent-button xlib::XWindowAttributes-map_state +xlib::ISUnmapped xlib::XPending +xlib::Expose xlib::XAllocColor xlib::XColor-Pixel xlib::XFreeColors +xlib::KeyPressMask xlib::KeyReleaseMask xlib::KeyRelease +xlib::KeyPress xlib::ButtonPress xlib::XDisplayKeycodes +xlib::XGetKeyboardMapping +xlib::XFree xlib::XK_Shift_R xlib::XK_Shift_L xlib::XK_Control_L +xlib::XK_Control_R xlib::XK_Alt_R xlib::XK_Alt_L xlib::XK_Return +xlib::XK_Tab xlib::XK_BackSpace xlib::get-c-string xlib::int-pos +xlib::fixnum-array xlib::int-array xlib::fixnum-pos +xlib::set-xsizehints-x xlib::set-xsizehints-y xlib::set-xsizehints-width +xlib::set-xsizehints-height xlib::set-xsizehints-flags xlib::set-foreground +xlib::set-background xlib::set-font +xlib::set-cursor xlib::set-line-width xlib::set-line-attr +xlib::set-Xcolor-red xlib::set-Xcolor-green xlib::set-Xcolor-blue +xlib::WhenMapped xlib::Psize xlib::Pposition xlib::CWSaveUnder +xlib::CWBackingStore xlib::NoSymbol +xlib::leavewindowmask xlib::buttonreleasemask xlib::exposuremask +xlib::GCForeground xlib::GCBackground xlib::GCFunction +xlib::None xlib::Xfontstruct-fid xlib::XChangeWindowAttributes +xlib::XGetWindowAttributes lisp::null xlib::Make-Xcolor + )) (import x) ) diff --git a/xgcl-2/gcl_dwindow.lsp b/xgcl-2/gcl_dwindow.lsp new file mode 100644 index 0000000..15864f0 --- /dev/null +++ b/xgcl-2/gcl_dwindow.lsp @@ -0,0 +1,3020 @@ +; dwindow.lsp Gordon S. Novak Jr. ; 13 Jan 10 + +; Window types and interface functions for using X windows from GNU Common Lisp + +; Copyright (c) 2010 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 08 Jan 97; 17 May 02; 17 May 04; 18 May 04; 01 Jun 04; 18 Aug 04; 21 Jan 06 +; 24 Jan 06; 24 Jun 06; 25 Jun 06; 17 Jul 06; 23 Aug 06; 08 Sep 06; 21 May 09 +; 28 Aug 09; 31 Aug 09; 28 Oct 09; 07 Nov 09; 12 Jan 10 + +; See the files gnu.license and dec.copyright . + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + +; These functions use the convention that positive y is upwards, +; (0 0) is the lower-left corner of a window. + +; derived from {DSK}DWINDOW.CL;1 1-Mar-89 13:16:20 +; Modified for AKCL/X using Hiep Huu Nguyen's interfaces from AKCL -> C -> X. +; Parts of Nguyen's file Xinit.lsp are included. + + +(defvar *window-add-menu-title* nil) ; t to add title bar within menu area +(defvar *window-menu* nil) +(defvar *mouse-x* nil) +(defvar *mouse-y* nil) +(defvar *mouse-window* nil) + +(defvar *window-fonts* (list + (list 'courier-bold-12 + "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1") + (list 'courier-medium-12 + "*-*-courier-medium-r-*-*-12-*-*-*-*-*-iso8859-1") + (list '6x12 "6x12") + (list '8x13 "8x13") + (list '9x15 "9x15"))) + +(glispglobals (*window-menu* menu) + (*mouse-x* integer) + (*mouse-y* integer) + (*mouse-window* window) + (*picmenu-no-selection* picmenu-button) ) + +(defvar *window-display* nil) +(defvar *window-screen* nil) +(defvar *root-window*) +(defvar *black-pixel*) +(defvar *white-pixel*) +(defvar *default-fg-color*) +(defvar *default-bg-color*) +(defvar *default-size-hints*) +(defvar *default-GC*) +(defvar *default-colormap*) +(defvar *window-event*) +(defvar *window-default-pos-x* 10) +(defvar *window-default-pos-y* 20) +(defvar *window-default-border* 1) +(defvar *window-default-font-name* 'courier-bold-12) +(defvar *window-default-cursor* 68) +(defvar *window-save-foreground*) +(defvar *window-save-function*) +(defvar *window-attributes*) +(defvar *window-attr*) +(defvar *menu-title-pad* 30) ; extra space for title bar of menu +; The following -return globals are used in calls to Xlib +; routines. +; Where the Xlib parameter is int*, the parameter must be +; initialized to (int-array 1) and is accessed with +; (int-pos param 0). +; The following X types are CARD32: (from Xproto.h) +; Window Drawable Font Pixmap Cursor Colormap GContext +; Atom VisualID Time KeySym +; KeyCode = CARD8 +(defvar *root-return* (fixnum-array 1)) +(defvar *child-return* (fixnum-array 1)) +(defvar *root-x-return* (int-array 1)) +(defvar *root-y-return* (int-array 1)) +(defvar *win-x-return* (int-array 1)) +(defvar *win-y-return* (int-array 1)) +(defvar *mask-return* (int-array 1)) +(defvar *x-return* (int-array 1)) +(defvar *y-return* (int-array 1)) +(defvar *width-return* (int-array 1)) +(defvar *height-return* (int-array 1)) +(defvar *depth-return* (int-array 1)) +(defvar *border-width-return* (int-array 1)) +(defvar *text-width-return* (int-array 1)) +(defvar *direction-return* (int-array 1)) +(defvar *ascent-return* (int-array 1)) +(defvar *descent-return* (int-array 1)) +(defvar *overall-return* (int-array 1)) +(defvar *GC-Values*) +(defvar *window-xcolor* nil) +(defvar *window-menu-code* nil) + +(defvar *window-keymap* (make-array 256)) +(defvar *window-shiftkeymap* (make-array 256)) +(defvar *window-keyinit* nil) +(defvar *window-meta*) ; set if meta down when char is pressed +(defvar *window-ctrl*) ; set if ctrl down when char is pressed +(defvar *window-shift*) ; set if shift down when char is pressed + +(defvar *window-shift-keys* nil) +(defvar *window-control-keys* nil) +(defvar *window-meta-keys* nil) +(defvar *min-keycodes-return* (int-array 1)) +(defvar *max-keycodes-return* (int-array 1)) +(defvar *keycodes-return* (int-array 1)) + +(setq *window-keyinit* nil) + +(defmacro picmenu-spec (symbol) `(get ,symbol 'picmenu-spec)) + +(glispobjects + +(drawable anything) + +(menu (listobject (menu-window window) + (flat boolean) + (parent-window drawable) + (parent-offset-x integer) + (parent-offset-y integer) + (picture-width integer) + (picture-height integer) + (title string) + (permanent boolean) + (menu-font symbol) + (item-width integer) + (items (listof symbol)) ) + prop ((menuw (menu-window or (menu-init self)) result window) + (title-present (title and ((length title) > 0))) + (width (picture-width)) + (height (picture-height)) + (base-x ((if flat parent-offset-x 0))) + (base-y ((if flat parent-offset-y 0))) + (offset menu-offset) + (size menu-size) + (region ((virtual region with start = voffset size = vsize))) + (voffset ((virtual vector with x = base-x y = base-y))) + (vsize ((virtual vector with x = picture-width + y = picture-height))) ) + msg ((init menu-init) + (init? ((menu-window and (picture-height > 0)) or (init self))) + (contains? (glambda (m p) (contains? (region m) p))) + (create menu-create result menu) + (clear menu-clear) + (select menu-select) + (select! menu-select!) + (choose menu-choose) + (draw menu-draw) + (destroy menu-destroy) + (moveto-xy menu-moveto-xy) + (reposition menu-reposition) + (reposition-line menu-reposition-line) + (box-item menu-box-item) + (unbox-item menu-box-item) ; same since it uses xor + (display-item menu-display-item) + (item-value menu-item-value open t) + (item-position menu-item-position result vector) + (find-item-width menu-find-item-width) + (find-item-height menu-find-item-height) + (adjust-offset menu-adjust-offset) + (calculate-size menu-calculate-size) + (menu-x (glambda (m x) ((base-x m) + x))) + (menu-y (glambda (m y) ((base-y m) + y))) ) ) + +; picture menu: a drawn object with "hot buttons" at certain points. +; note: the first 10 data items of picmenu must be the same as in menu. +(picmenu (listobject (menu-window window) + (flat boolean) + (parent-window drawable) + (parent-offset-x integer) + (parent-offset-y integer) + (picture-width integer) + (picture-height integer) + (title string) + (permanent boolean) + (spec (transparent picmenu-spec)) + (boxflg boolean) + (deleted-buttons (listof symbol)) + (button-colors (listof (list (name symbol) (color rgb)))) + ) + prop ((menuw (menu-window or (picmenu-init self)) result window) ) + msg ((init picmenu-init) + (init? ((menu-window and (picture-height > 0)) or (init self))) + (create picmenu-create result picmenu) + (select picmenu-select) + (draw picmenu-draw) + (draw-button picmenu-draw-button) + (draw-named-button picmenu-draw-named-button) + (set-named-button-color picmenu-set-named-button-color) + (delete-named-button picmenu-delete-named-button) + (box-item picmenu-box-item) + (unbox-item picmenu-unbox-item) + (calculate-size picmenu-calculate-size) + (item-position picmenu-item-position result vector) ) + supers (menu) ) + +(picmenu-spec (listobject (drawing-width integer) + (drawing-height integer) + (buttons (listof picmenu-button)) + (dotflg boolean) + (drawfn anything) + (menu-font symbol) )) + +(picmenu-button (list (buttonname symbol) + (offset vector) + (size vector) + (highlightfn anything) + (unhighlightfn anything)) + msg ((containsxy? picmenu-button-containsxy?)) ) + +(barmenu (listobject (menu-window window) + (flat boolean) + (parent-window drawable) + (parent-offset-x integer) + (parent-offset-y integer) + (picture-width integer) + (picture-height integer) + (title string) + (permanent boolean) + (color rgb) + (value integer) + (maxval integer) + (barwidth integer) + (horizontal boolean) + (subtrackfn anything) + (subtrackparms (listof anything))) + prop ((menuw (menu-window or (barmenu-init self)) result window) + (picture-width ((if (horizontal m) (maxval m) + (barwidth m)) )) + (picture-height ((if (horizontal m) (barwidth m) + (maxval m)) )) ) + msg ((init barmenu-init) + (init? ((menu-window and (picture-height > 0)) + or (init self))) + (create barmenu-create result barmenu) + (select barmenu-select) + (draw barmenu-draw) + (update-value barmenu-update-value) + (calculate-size barmenu-calculate-size) ) +supers (menu)) + +; Note: data through 'permanent' must be same as in menu. +(textmenu (listobject (menu-window window) + (flat boolean) + (parent-window drawable) + (parent-offset-x integer) + (parent-offset-y integer) + (picture-width integer) + (picture-height integer) + (title string) + (permanent boolean) + (text string) + (drawing-width integer) + (drawing-height integer) + (boxflg boolean) + (menu-font symbol) ) + + prop ((menuw (menu-window or (textmenu-init self)) result window) ) + msg ((init textmenu-init) + (init? ((menu-window and (picture-height > 0)) or (init self))) + (create textmenu-create result textmenu) + (select textmenu-select) + (draw textmenu-draw) + (calculate-size textmenu-calculate-size) + (set-text textmenu-set-text open t) ) + supers (menu) ) + +; Note: data through 'permanent' must be same as in menu. +(editmenu (listobject (menu-window window) + (flat boolean) + (parent-window drawable) + (parent-offset-x integer) + (parent-offset-y integer) + (picture-width integer) + (picture-height integer) + (title string) + (permanent boolean) + (text (listof string)) + (drawing-width integer) + (drawing-height integer) + (boxflg boolean) + (menu-font symbol) + (column integer) + (line integer) + (scrollval integer) ) + prop ((menuw (menu-window or (editmenu-init self)) result window) + (scroll ((if (numberp scrollval) + scrollval + 0))) ) + + msg ((init editmenu-init) + (init? ((menu-window and (picture-height > 0)) or (init self))) + (create editmenu-create result editmenu) + (select editmenu-select) + (draw editmenu-draw) + (edit editmenu-edit) + (carat editmenu-carat) + (display editmenu-display) + (calculate-size editmenu-calculate-size) + (line-y editmenu-line-y open t) ) + supers (menu) ) + +(window (listobject (parent drawable) + (gcontext anything) + (drawable-height integer) + (drawable-width integer) + (label string) + (font anything) ) +default ((self nil)) +prop ((width (drawable-width)) + (height (drawable-height)) + (left window-left open t result integer) + (right (left + width)) + (top-neg-y window-top-neg-y open t result integer) + (leftmargin (1)) + (rightmargin (width - 1)) + (yposition window-yposition result integer open t) + (wfunction window-wfunction open t) + (foreground window-foreground open t) + (background window-background open t) + (font-width ((string-width self "W"))) + (font-height ((string-height self "Tg"))) ) +msg ((force-output window-force-output open t) + (set-font window-set-font) + (set-foreground window-set-foreground open t) + (set-background window-set-background open t) + (set-cursor window-set-cursor open t) + (set-erase window-set-erase open t) + (set-xor window-set-xor open t) + (set-invert window-set-invert open t) + (set-copy window-set-copy open t) + (set-line-width window-set-line-width open t) + (set-line-attr window-set-line-attr open t) + (std-line-attr window-std-line-attr open t) + (unset window-unset open t) + (reset window-reset open t) + (sync window-sync open t) + (geometry window-geometry open t) + (size window-size) + (get-geometry window-get-geometry open t) + (reset-geometry window-reset-geometry open t) + (query-pointer window-query-pointer open t) + (wait-exposure window-wait-exposure) + (wait-unmap window-wait-unmap) + (clear window-clear open t) + (mapw window-map open t) + (unmap window-unmap open t) + (open window-open open t) + (close window-close open t) + (destroy window-destroy open t) + (positive-y window-positive-y open t) + (drawline window-draw-line open t) + (draw-line window-draw-line open t) + (draw-line-xy window-draw-line-xy open t) + (draw-latex-xy window-draw-latex-xy) + (draw-arrow-xy window-draw-arrow-xy ) + (draw-arrow2-xy window-draw-arrow2-xy ) + (draw-arrowhead-xy window-draw-arrowhead-xy ) + (draw-box window-draw-box open t) + (draw-box-xy window-draw-box-xy) + (draw-box-corners window-draw-box-corners open t) + (draw-rcbox-xy window-draw-rcbox-xy) + (draw-box-line-xy window-draw-box-line-xy) + (xor-box-xy window-xor-box-xy open t) + (draw-circle window-draw-circle open t) + (draw-circle-xy window-draw-circle-xy open t) + (draw-ellipse-xy window-draw-ellipse-xy open t) + (draw-arc-xy window-draw-arc-xy open t) + (invertarea window-invertarea open t) + (invert-area window-invert-area open t) + (invert-area-xy window-invert-area-xy open t) + (copy-area-xy window-copy-area-xy open t) + (printat window-printat open t) + (printat-xy window-printat-xy open t) + (print-line window-print-line) + (print-lines window-print-lines) + (prettyprintat window-prettyprintat open t) + (prettyprintat-xy window-prettyprintat-xy open t) + (string-width window-string-width open t) + (string-extents window-string-extents open t) + (erase-area window-erase-area open t) + (erase-area-xy window-erase-area-xy open t) + (erase-box-xy window-erase-box-xy open t) + (moveto-xy window-moveto-xy) + (move window-move) + (paint window-paint) + (centeroffset window-centeroffset open t) + (draw-border window-draw-border open t) + (track-mouse window-track-mouse) + (track-mouse-in-region window-track-mouse-in-region) + (init-mouse-poll window-init-mouse-poll) + (poll-mouse window-poll-mouse) + (get-point window-get-point) + (get-click window-get-click) + (get-line-position window-get-line-position) + (get-latex-position window-get-latex-position) + (get-icon-position window-get-icon-position) + (get-box-position window-get-box-position) + (get-box-line-position window-get-box-line-position) + (get-box-size window-get-box-size) + (get-region window-get-region) + (adjust-box-side window-adjust-box-side) + (get-mouse-position window-get-mouse-position) + (get-circle window-get-circle) + (get-ellipse window-get-ellipse) + (get-crosshairs window-get-crosshairs) + (draw-crosshairs-xy window-draw-crosshairs-xy) + (get-cross window-get-cross) + (draw-cross-xy window-draw-cross-xy) + (draw-dot-xy window-draw-dot-xy) + (draw-vector-pt window-draw-vector-pt) + (get-vector-end window-get-vector-end) + (reset-color window-reset-color) + (set-color-rgb window-set-color-rgb) + (set-color window-set-color) + (set-xcolor window-set-xcolor) + (free-color window-free-color) + (get-chars window-get-chars) + (input-string window-input-string) + (string-width window-string-width) + (string-extents window-string-extents) + (string-height window-string-height) + (draw-carat window-draw-carat) + )) + +(rgb (list (red integer) (green integer) (blue integer))) + + ) ; glispobjects + +(glispconstants ; used by GEV + (windowcharwidth 9 integer) + (windowlineyspacing 17 integer) +) + +(defvar *picmenu-no-selection* '(no-selection (0 0) (0 0) nil nil)) + +; 14 Mar 95 +; Make something into a string. +; The copy-seq avoids an error with get-c-string on Sun. +(defun stringify (x) + (cond ((stringp x) x) + ((symbolp x) (copy-seq (symbol-name x))) + (t (princ-to-string x)))) + +; 24 Jun 06 +; This function initializes variables needed by most applications. +; It uses all defaults inherited from the root window, and screen. ; H. Nguyen +(defun window-Xinit () + (setq *window-display* (XOpenDisplay (get-c-string ""))) + (if (or (not (numberp *window-display*)) ; 22 Jun 06 + (< *window-display* 10000)) + (error "DISPLAY did not open: return value ~A~%" *window-display*)) + (setq *window-screen* (XdefaultScreen *window-display*)) + (setq *root-window* (XRootWindow *window-display* *window-screen*)) + (setq *black-pixel* (XBlackPixel *window-display* *window-screen*)) + (setq *white-pixel* (XWhitePixel *window-display* *window-screen*)) + (setq *default-fg-color* *black-pixel*) + (setq *default-bg-color* *white-pixel*) + (setq *default-GC* (XDefaultGC *window-display* *window-screen*)) + (setq *default-colormap* (XDefaultColormap *window-display* + *window-screen*)) + (setq *window-attributes* (make-XsetWindowAttributes)) + (set-XsetWindowAttributes-backing_store *window-attributes* + WhenMapped) + (set-XsetWindowAttributes-save_under *window-attributes* 1) ; True + (setq *window-attr* (make-XWindowAttributes)) + (Xflush *window-display*) + (setq *default-size-hints* (make-XsizeHints)) + (setq *window-event* (make-XEvent)) + (setq *GC-Values* (make-XGCValues)) ) + +(defun window-get-mouse-position () + (XQueryPointer *window-display* *root-window* + *root-return* *child-return* *root-x-return* *root-y-return* + *win-x-return* *win-y-return* *mask-return*) + (setq *mouse-x* (int-pos *root-x-return* 0)) + (setq *mouse-y* (int-pos *root-y-return* 0)) + (setq *mouse-window* (fixnum-pos *child-return* 0)) ) ; 22 Jun 06 + +; 13 Aug 91; 14 Aug 91; 06 Sep 91; 12 Sep 91; 06 Dec 91; 01 May 92; 01 Sep 92 +; 08 Sep 06 +(setf (glfnresulttype 'window-create) 'window) +(gldefun window-create (width height &optional str parentw pos-x pos-y font) + (let (w pw fg-color bg-color (null 0)) + (or *window-display* (window-Xinit)) + (setq fg-color *default-fg-color*) + (setq bg-color *default-bg-color*) + (unless pos-x (pos-x = *window-default-pos-x*)) + (unless pos-y (pos-y = *window-default-pos-y*)) + (w = (a window with + drawable-width = width + drawable-height = height + label = (if str (stringify str) " ") )) + (pw = (or parentw *root-window*)) + (window-get-geometry-b pw) + ((parent w) = + (XCreateSimpleWindow *window-display* pw + pos-x + ((int-pos *height-return* 0) + - pos-y - height) + width height + *window-default-border* + fg-color bg-color)) + (set-xsizehints-x *default-size-hints* pos-x) + (set-xsizehints-y *default-size-hints* pos-y) + (set-xsizehints-width *default-size-hints* (width w)) + (set-xsizehints-height *default-size-hints* (height w)) + (set-xsizehints-flags *default-size-hints* + (+ Psize Pposition)) + (XsetStandardProperties *window-display* (parent w) + (get-c-string (label w)) + (get-c-string (label w)) ; icon name + none null null + *default-size-hints*) + ((gcontext w) = (XCreateGC *window-display* (parent w) 0 null)) + (set-foreground w fg-color) + (set-background w bg-color) + (set-font w (or font *window-default-font-name*)) + (set-cursor w *window-default-cursor*) + (set-line-width w 1) + (XChangeWindowAttributes *window-display* (parent w) + (+ CWSaveUnder CWBackingStore) + *window-attributes*) + (Xselectinput *window-display* (parent w) + (+ leavewindowmask buttonpressmask + buttonreleasemask + pointermotionmask exposuremask)) + (open w) + w )) + +; 06 Aug 91; 17 May 04 +; Set the font for a window to the one specified by fontsymbol. +; derived from Nguyen's my-load-font. +(gldefun window-set-font ((w window) (fontsymbol symbol)) + (let (fontstring font-info (display *window-display*)) + (fontstring = (or (cadr (assoc fontsymbol *window-fonts*)) + (stringify fontsymbol))) + (font-info = (XloadQueryFont display + (get-c-string fontstring))) + (if (eql 0 font-info) + (format t "~%can't open font ~a ~a~%" fontsymbol fontstring) + (progn (XsetFont display (gcontext w) (Xfontstruct-fid font-info)) + ((font w) = font-info)) ) )) + +; 15 Oct 91 +(defun window-font-info (fontsymbol) + (XloadQueryFont *window-display* + (get-c-string + (or (cadr (assoc fontsymbol *window-fonts*)) + (stringify fontsymbol))))) + + +; Functions to allow access to window properties from plain Lisp +(gldefun window-gcontext ((w window)) (gcontext w)) +(gldefun window-parent ((w window)) (parent w)) +(gldefun window-drawable-height ((w window)) (drawable-height w)) +(gldefun window-drawable-width ((w window)) (drawable-width w)) +(gldefun window-label ((w window)) (label w)) +(gldefun window-font ((w window)) (font w)) + +; 07 Aug 91; 14 Aug 91 +(gldefun window-foreground ((w window)) + (XGetGCValues *window-display* (gcontext w) GCForeground + *GC-Values*) + (XGCValues-foreground *GC-Values*) ) + +(gldefun window-set-foreground ((w window) (fg-color integer)) + (XsetForeground *window-display* (gcontext w) fg-color)) + +(gldefun window-background ((w window)) + (XGetGCValues *window-display* (gcontext w) GCBackground + *GC-Values*) + (XGCValues-Background *GC-Values*) ) + +(gldefun window-set-background ((w window) (bg-color integer)) + (XsetBackground *window-display* (gcontext w) bg-color)) + +; 08 Aug 91 +(gldefun window-wfunction ((w window)) + (XGetGCValues *window-display* (gcontext w) GCFunction + *GC-Values*) + (XGCValues-function *GC-Values*) ) + +; 08 Aug 91 +; Get the geometry parameters of a window into global variables +(gldefun window-get-geometry ((w window)) (window-get-geometry-b (parent w))) + +; 06 Dec 91 +; Set cursor to a selected cursor number +(gldefun window-set-cursor ((w window) (n integer)) + (let (c) + (c = (XCreateFontCursor *window-display* n) ) + (XDefineCursor *window-display* (parent w) c) )) + +(defun window-get-geometry-b (w) + (XGetGeometry *window-display* w + *root-return* *x-return* *y-return* *width-return* + *height-return* *border-width-return* *depth-return*) ) + +; 15 Aug 91 +; clear event queue of previous motion events +(gldefun window-sync ((w window)) + (Xsync *window-display* 1) ) + +; 03 Oct 91; 06 Oct 94 +(gldefun window-screen-height () + (window-get-geometry-b *root-window*) + (int-pos *height-return* 0) ) + +; 08 Aug 91; 12 Sep 91; 28 Oct 91 +; Make a list of window geometry, (x y width height border-width). +(gldefun window-geometry ((w window)) + (let (sh) + (sh = (window-screen-height)) + (get-geometry w) + ((drawable-width w) = (int-pos *width-return* 0)) + ((drawable-height w) = (int-pos *height-return* 0)) + (list (int-pos *x-return* 0) + (sh - (int-pos *y-return* 0) + - (int-pos *height-return* 0)) + (int-pos *width-return* 0) + (int-pos *height-return* 0) + (int-pos *border-width-return* 0)) )) + +; 27 Nov 91 +(gldefun window-size ((w window)) (result vector) + (get-geometry w) + (list ((drawable-width w) = (int-pos *width-return* 0)) + ((drawable-height w) = (int-pos *height-return* 0)) ) ) + +(gldefun window-left ((w window)) + (get-geometry w) + (int-pos *x-return* 0)) + +; Get top of window in X (y increasing downwards) coordinates. +(gldefun window-top-neg-y ((w window)) + (get-geometry w) + (int-pos *y-return* 0)) + +; 08 Aug 91 +; Reset the local geometry parameters of a window from its X values. +; Needed, for example, if the user resizes the window by mouse command. +(gldefun window-reset-geometry ((w window)) + (get-geometry w) + ((drawable-width w) = (int-pos *width-return* 0)) + ((drawable-height w) = (int-pos *height-return* 0)) ) + +(gldefun window-force-output (&optional (w window)) + (Xflush *window-display*)) + +(gldefun window-query-pointer ((w window)) + (window-query-pointer-b (parent w)) ) + +(defun window-query-pointer-b (w) + (XQueryPointer *window-display* w + *root-return* *child-return* *root-x-return* *root-y-return* + *win-x-return* *win-y-return* *mask-return*) ) + +(gldefun window-positive-y ((w window) (y integer)) ((height w) - y)) + +; 08 Aug 91 +; Set parameters of a window for drawing by XOR, saving old values. +(gldefun window-set-xor ((w window)) + (let ((gc (gcontext w)) ) + (setq *window-save-function* (wfunction w)) + (XsetFunction *window-display* gc GXxor) + (setq *window-save-foreground* (foreground w)) + (XsetForeground *window-display* gc + (logxor *window-save-foreground* (background w))) )) + +; 08 Aug 91 +; Reset parameters of a window after change, using saved values. +(gldefun window-unset ((w window)) + (let ((gc (gcontext w)) ) + (XsetFunction *window-display* gc *window-save-function*) + (XsetForeground *window-display* gc *window-save-foreground*) )) + +; 04 Sep 91 +; Reset parameters of a window, using default values. +(gldefun window-reset ((w window)) + (let ((gc (gcontext w)) ) + (XsetFunction *window-display* gc GXcopy) + (XsetForeground *window-display* gc *default-fg-color*) + (XsetBackground *window-display* gc *default-bg-color*) )) + +; 09 Aug 91; 03 Sep 92 +; Set parameters of a window for erasing, saving old values. +(gldefun window-set-erase ((w window)) + (let ((gc (gcontext w)) ) + (setq *window-save-function* (wfunction w)) + (XsetFunction *window-display* gc GXcopy) + (setq *window-save-foreground* (foreground w)) + (XsetForeground *window-display* gc (background w)) )) + +(gldefun window-set-copy ((w window)) + (let ((gc (gcontext w)) ) + (setq *window-save-function* (wfunction w)) + (XsetFunction *window-display* gc GXcopy) + (setq *window-save-foreground* (foreground w)) )) + +; 12 Aug 91 +; Set parameters of a window for inversion, saving old values. +(gldefun window-set-invert ((w window)) + (let ((gc (gcontext w)) ) + (setq *window-save-function* (wfunction w)) + (XsetFunction *window-display* gc GXxor) + (setq *window-save-foreground* (foreground w)) + (XsetForeground *window-display* gc + (logxor *window-save-foreground* (background w))) )) + +; 13 Aug 91 +(gldefun window-set-line-width ((w window) (width integer)) + (set-line-attr w width nil nil nil)) + +; 13 Aug 91; 12 Sep 91 +(gldefun window-set-line-attr + (w\:window width &optional line-style cap-style join-style) + (XsetLineAttributes *window-display* (gcontext w) + (or width 1) + (or line-style LineSolid) + (or cap-style CapButt) + (or join-style JoinMiter) ) ) + +; 13 Aug 91 +; Set standard line attributes +(gldefun window-std-line-attr ((w window)) + (XsetLineAttributes *window-display* (gcontext w) + 1 LineSolid CapButt JoinMiter) ) + +; 06 Aug 91; 08 Aug 91; 12 Sep 91 +(gldefun window-draw-line ((w window) (from vector) (to vector) + &optional linewidth) + (window-draw-line-xy w (x from) (y from) (x to) (y to) linewidth) ) + +; 19 Dec 90; 07 Aug 91; 08 Aug 91; 09 Aug 91; 13 Aug 91; 12 Sep 91; 28 Sep 94 +(gldefun window-draw-line-xy ((w window) (fromx integer) + (fromy integer) + (tox integer) (toy integer) + &optional linewidth + (operation atom)) + (let ( (qqwheight (drawable-height w)) ) + (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) + (case operation + (xor (set-xor w)) + (erase (set-erase w)) + (t nil)) + (XDrawLine *window-display* (parent w) (gcontext w) + fromx (- qqwheight fromy) tox (- qqwheight toy) ) + (case operation + ((xor erase) (unset w)) + (t nil)) + (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) )) + +; 09 Oct 91 +(defun window-draw-arrowhead-xy (w x1 y1 x2 y2 &optional (linewidth 1) size) + (let (th theta ysth ycth (y2dela 0) (y2delb 0) (x2dela 0) (x2delb 0)) + (or size (setq size (+ 20 (* linewidth 5)))) + (setq th (atan (- y2 y1) (- x2 x1))) + (setq theta (* th (/ 180.0 pi))) + (setq ysth (round (* (1+ size) (sin th)))) + (setq ycth (round (* (1+ size) (cos th)))) + (if (and (eql y1 y2) (evenp linewidth)) ; correct for even-size lines + (if (> x2 x1) (setq y2delb 1) (setq y2dela 1))) + (if (and (eql x1 x2) (evenp linewidth)) ; correct for even-size lines + (if (> y2 y1) (setq x2delb 1) (setq x2dela 1))) + (window-draw-arc-xy w (- (- x2 ysth) x2dela) + (+ (+ y2 ycth) y2dela) size size + (+ 240 theta) 30 linewidth) + (window-draw-arc-xy w (- (+ x2 ysth) x2delb) + (+ (- y2 ycth) y2delb) size size + (+ 90 theta) 30 linewidth) )) + +(defun window-draw-arrow-xy (w x1 y1 x2 y2 + &optional (linewidth 1) size) + (window-draw-line-xy w x1 y1 x2 y2 linewidth) + (window-draw-arrowhead-xy w x1 y1 x2 y2 linewidth size) ) + +(defun window-draw-arrow2-xy (w x1 y1 x2 y2 + &optional (linewidth 1) size) + (window-draw-line-xy w x1 y1 x2 y2 linewidth) + (window-draw-arrowhead-xy w x1 y1 x2 y2 linewidth size) + (window-draw-arrowhead-xy w x2 y2 x1 y1 linewidth size) ) + +; 08 Aug 91; 14 Aug 91; 12 Sep 91 +(gldefun window-draw-box + ((w window) (offset vector) (size vector) &optional linewidth) + (window-draw-box-xy w (x offset) (y offset) (x size) (y size) linewidth) ) + +; 08 Aug 91; 12 Sep 91; 11 Dec 91; 01 Sep 92; 02 Sep 92; 17 Jul 06 +; New version avoids XDrawRectangle, which messes up when used with XOR. +; was (XDrawRectangle *window-display* (parent w) (gcontext w) +; offsetx (- qqwheight (offsety + sizey)) sizex sizey) +(gldefun window-draw-box-xy + ((w window) (offsetx integer) (offsety integer) + (sizex integer) (sizey integer) &optional linewidth) + (let ((qqwheight (drawable-height w)) lw lw2 lw2b (pw (parent w)) + (gc (gcontext w))) + (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) + (lw = (or linewidth 1)) + (lw2 = (truncate lw 2)) + (lw2b = (truncate (lw + 1) 2)) + (XdrawLine *window-display* pw gc + (- offsetx lw2) (- qqwheight offsety) + (- (+ offsetx sizex) lw2) (- qqwheight offsety)) + (XdrawLine *window-display* pw gc + (+ offsetx sizex) (- qqwheight (- offsety lw2b)) + (+ offsetx sizex) (- qqwheight (+ sizey (- offsety lw2b)))) + (XdrawLine *window-display* pw gc + (+ offsetx sizex lw2b) (- qqwheight (+ offsety sizey)) + (+ offsetx lw2b) (- qqwheight (+ offsety sizey))) + (XdrawLine *window-display* pw gc + offsetx (- qqwheight (+ offsety sizey lw2)) + offsetx (- qqwheight (+ offsety lw2)) ) + (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) )) + +; 26 Nov 91 +(gldefun window-xor-box-xy + ((w window) (offsetx integer) (offsety integer) + (sizex integer) (sizey integer) + &optional linewidth) + (window-set-xor w) + (window-draw-box-xy w offsetx offsety sizex sizey linewidth) + (window-unset w)) + +; 15 Aug 91; 12 Sep 91 +; Draw a box whose corners are specified +(gldefun window-draw-box-corners ((w window) (xa integer) (ya integer) + (xb integer) (yb integer) + &optional lw) + (draw-box-xy w (min xa xb) (min ya yb) (abs (- xa xb)) (abs (- ya yb)) lw) ) + +; 13 Sep 91; 17 Jul 06 +; Draw a box with round corners +(gldefun window-draw-rcbox-xy ((w window) (x integer) (y integer) + (width integer) + (height integer) (radius integer) + &optional linewidth) + (let (x1 x2 y1 y2 r lw2 lw2b fudge) + (r = (max 0 (min radius (truncate (abs width) 2) + (truncate (abs height) 2)))) + (if (not (numberp linewidth)) (linewidth = 1)) + (lw2 = (truncate linewidth 2)) + (lw2b = (truncate (1+ linewidth) 2)) + (fudge = (if (oddp linewidth) 0 1)) + (x1 = x + r) + (x2 = x + width - r) + (y1 = y + r) + (y2 = y + height - r) + (draw-line-xy w (- (- x1 1) lw2) y x2 y linewidth) ; bottom + (draw-line-xy w (x + width) (- y1 lw2b) (x + width) (+ y2 1) + linewidth) ; right + (draw-line-xy w (- x1 1) (+ y height) (+ x2 lw2) (+ y height) linewidth) + (draw-line-xy w x y1 x (+ y2 1) linewidth) ; left + (draw-arc-xy w (- x1 fudge) y1 r r 180 90 linewidth) + (draw-arc-xy w x2 y1 r r 270 90 linewidth) + (draw-arc-xy w x2 (+ y2 fudge) r r 0 90 linewidth) + (draw-arc-xy w (- x1 fudge) (+ y2 fudge) r r 90 90 linewidth) )) + +; 13 Aug 91; 15 Aug 91; 12 Sep 91 +(gldefun window-draw-arc-xy ((w window) (x integer) (y integer) + (radiusx integer) (radiusy integer) + (anglea number) (angleb number) + &optional linewidth) + (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) + (XdrawArc *window-display* (parent w) (gcontext w) + (x - radiusx) (positive-y w (y + radiusy)) + (radiusx * 2) (radiusy * 2) + (truncate (* anglea 64)) (truncate (* angleb 64))) + (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) ) + +; 08 Aug 91; 12 Sep 91 +(gldefun window-draw-circle-xy ((w window) (x integer) (y integer) + (radius integer) + &optional linewidth) + (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) + (XdrawArc *window-display* (parent w) (gcontext w) + (x - radius) (positive-y w (y + radius)) + (radius * 2) (radius * 2) 0 (* 360 64)) + (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) ) + +; 06 Aug 91; 14 Aug 91; 12 Sep 91 +(gldefun window-draw-circle ((w window) (pos vector) (radius integer) + &optional linewidth) + (window-draw-circle-xy w (x pos) (y pos) radius linewidth) ) + +; 08 Aug 91; 09 Sep 91 +(gldefun window-erase-area ((w window) (offset vector) (size vector)) + (window-erase-area-xy w (x offset) (y offset) (x size) (y size))) + +; 09 Sep 91; 11 Dec 91 +(gldefun window-erase-area-xy ((w window) (xoff integer) (yoff integer) + (xsize integer) (ysize integer)) + (XClearArea *window-display* (parent w) + xoff (positive-y w (yoff + ysize - 1)) + xsize ysize + 0 )) ; exposures + +; 21 Dec 93; 08 Sep 06 +(gldefun window-erase-box-xy ((w window) (xoff integer) (yoff integer) + (xsize integer) (ysize integer) + &optional (linewidth integer)) + (XClearArea *window-display* (parent w) + (xoff - (truncate (or linewidth 1) 2)) + (positive-y w (+ yoff ysize (truncate (or linewidth 1) 2))) + (xsize + (or linewidth 1)) + (ysize + (or linewidth 1)) + 0 )) ; exposures + +; 15 Aug 91; 12 Sep 91 +(gldefun window-draw-ellipse-xy ((w window) (x integer) (y integer) + (rx integer) (ry integer) &optional lw) + (draw-arc-xy w x y rx ry 0 360 lw)) + +; 09 Aug 91 +(gldefun window-copy-area-xy ((w window) fromx (fromy integer) + tox (toy integer) width height) + (let ((qqwheight (drawable-height w))) + (set-copy w) + (XCopyArea *window-display* (parent w) (parent w) (gcontext w) + fromx (- qqwheight (+ fromy height)) + width height + tox (- qqwheight (+ toy height))) + (unset w) )) + +; 07 Dec 90; 09 Aug 91; 12 Sep 91 +(gldefun window-invertarea ((w window) (area region)) + (window-invert-area-xy w (left area) (bottom area) + (width area) (height area))) + +; 07 Dec 90; 09 Aug 91; 12 Sep 91 +(gldefun window-invert-area ((w window) (offset vector) (size vector)) + (window-invert-area-xy w (x offset) (y offset) (x size) (y size)) ) + +; 12 Aug 91; 15 Aug 91; 13 Dec 91 +(gldefun window-invert-area-xy ((w window) left (bottom integer) width height) + (set-invert w) + (XFillRectangle *window-display* (parent w) (gcontext w) + left (- (drawable-height w) (bottom + height - 1)) + width height) + (unset w) ) + +; 05 Dec 90; 15 Aug 91 +(gldefun window-prettyprintat ((w window) (s string) (pos vector)) + (printat w s pos) ) + +(gldefun window-prettyprintat-xy ((w window) (s string) (x integer) + (y integer)) + (printat-xy w s x y)) + +; 06 Aug 91; 08 Aug 91; 15 Aug 91 +(gldefun window-printat ((w window) (s string) (pos vector)) + (printat-xy w s (x pos) (y pos)) ) + +; 06 Aug 91; 08 Aug 91; 12 Aug 91 +(gldefun window-printat-xy ((w window) (s string) (x integer) (y integer)) + (let ( (sstr (stringify s)) ) + (XdrawImageString *window-display* (parent w) (gcontext w) + x (- (drawable-height w) y) + (get-c-string sstr) (length sstr)) )) + +; 19 Apr 95; 02 May 95; 17 May 04 +; Print a string that may contain #\Newline characters in a window. +(gldefun window-print-line ((w window) (str string) (x integer) (y integer) + &optional (deltay integer)) + (let ((lng (length str)) (n 0) end strb done) + (while ~done + (end = (position #\Newline str :test #'char= :start n)) + (strb = (subseq str n end)) + (printat-xy w strb x y) + (if (numberp end) + (n = (1+ end)) + (done = t)) + (y _- (or deltay 16)) + (if (y < 0) (done = t))) + (force-output w) )) + +; 02 May 95; 08 May 95 +; Print a list of strings in a window. +(gldefun window-print-lines ((w window) (lines (listof string)) + (x integer) (y integer) + &optional (deltay integer)) + (for str in lines when (y > 0) (printat-xy w str x y) (y _- (or deltay 16))) ) + +; 08 Aug 91 +; Find the width of a string when printed in a given window +(gldefun window-string-width ((w window) (s string)) + (let ((sstr (stringify s))) + (XTextWidth (font w) (get-c-string sstr) (length sstr)) )) + +; 01 Dec 93 +; Find the ascent and descent of a string when printed in a given window +(gldefun window-string-extents ((w window) (s string)) + (let ((sstr (stringify s))) + (XTextExtents (font w) (get-c-string sstr) (length sstr) + *direction-return* *ascent-return* *descent-return* *overall-return*) + (list (int-pos *ascent-return* 0) + (int-pos *descent-return* 0)) )) + +; Find the height (ascent + descent) of a string when printed in a given window +(gldefun window-string-height ((w window) (s string)) + (let ((sstr (stringify s))) + (XTextExtents (font w) (get-c-string sstr) (length sstr) + *direction-return* *ascent-return* *descent-return* *overall-return*) + (+ (int-pos *ascent-return* 0) + (int-pos *descent-return* 0)) )) + +; 15 Oct 91 +(gldefun window-font-string-width (font (s string)) + (let ((sstr (stringify s))) + (XTextWidth font (get-c-string sstr) (length sstr)) )) + +(gldefun window-yposition ((w window)) + (window-get-mouse-position) + (positive-y w (- *mouse-y* (top-neg-y w))) ) + +(gldefun window-centeroffset ((w window) (v vector)) + (a vector with x = (truncate ((width w) - (x v)) 2) + y = (truncate ((height w) - (y v)) 2))) + +; 18 Aug 89; 15 Aug 91 +; Command to a window display manager +(gldefun dowindowcom ((w window)) + (let (comm) + (comm = (select (window-menu)) ) + (case comm + (close (close w)) + (paint (paint w)) + (clear (clear w)) + (move (move w)) + (t (when comm + (princ "This command not implemented.") (terpri))) ) )) + +(gldefun window-menu () + (result menu) + (or *window-menu* + (setq *window-menu* + (a menu with items = '(close paint clear move)))) ) + +; 06 Dec 90; 11 Mar 93 +(gldefun window-close ((w window)) + (unmap w) + (force-output w) + (window-wait-unmap w)) + +(gldefun window-unmap ((w window)) + (XUnMapWindow *window-display* (parent w)) ) + +; 06 Aug 91; 22 Aug 91 +(gldefun window-open ((w window)) + (mapw w) + (force-output w) + (wait-exposure w) ) + +(gldefun window-map ((w window)) + (XMapWindow *window-display* (parent w)) ) + +; 08 Aug 91; 02 Sep 91 +(gldefun window-destroy ((w window)) + (XDestroyWindow *window-display* (parent w)) + (force-output w) + ((parent w) = nil) + (XFreeGC *window-display* (gcontext w)) + ((gcontext w) = nil) ) + +; 09 Sep 91 +; Wait 3 seconds, then destroy the window where the mouse is. Use with care. +(defun window-destroy-selected-window () + (prog (ww child) + (sleep 3) + (setq ww *root-window*) + lp (window-query-pointer-b ww) + (setq child (fixnum-pos *child-return* 0)) ; 22 Jun 06 + (if (> child 0) + (progn (setq ww child) (go lp))) + (if (/= ww *root-window*) + (progn (XDestroyWindow *window-display* ww) + (Xflush *window-display*))) )) + +; 07 Aug 91 +(gldefun window-clear ((w window)) + (XClearWindow *window-display* (parent w)) + (force-output w) ) + +; 08 Aug 91 +(gldefun window-moveto-xy ((w window) (x integer) (y integer)) + (XMoveWindow *window-display* (parent w) + x (- (window-screen-height) y)) ) + +; 15 Aug 91; 05 Sep 91 +; Paint in window with mouse: Left paints, Middle erases, Right quits. +(defun window-paint (window) + (let (state) + (window-track-mouse window + #'(lambda (x y code) + (if (= code 1) (if (= state 1) (setq state 0) (setq state 1)) + (if (= code 2) (if (= state 2) (setq state 0) (setq state 2)))) + (if (= state 1) (window-draw-line-xy window x y x y 1 'paint) + (if (= state 2) (window-draw-line-xy window x y x y 1 'erase))) + (= code 3)) ) )) + +; 15 Aug 91; 06 May 93 +; Move a window. +(gldefun window-move ((w window)) + (window-get-mouse-position) + (XMoveWindow *window-display* (parent w) + *mouse-x* (- (window-screen-height) *mouse-y*)) ) + +; 15 Sep 93; 06 Jan 94 +(gldefun window-draw-border ((w window)) + (draw-box-xy w 0 1 ((x (size w)) - 1) ((y (size w)) - 1)) + (force-output w) ) + +; 13 Aug 91; 22 Aug 91; 27 Aug 91; 14 Oct 91 +; Track the mouse within a window, calling function fn with args (x y event). +; event is 0 = no button, 1 = left button, 2 = middle, 3 = right button. +; Tracking continues until fn returns non-nil; result is that value. +; Partly adapted from Hiep Nguyen's code. +(defun window-track-mouse (w fn &optional outflg) + (let (win h) + (setq win (window-parent w)) + (setq h (window-drawable-height w)) + (Xsync *window-display* 1) ; clear event queue of prev motion events + (Xselectinput *window-display* win + (+ ButtonPressMask PointerMotionMask)) + ;; Event processing loop: stop when function returns non-nil. + (do ((res nil)) (res res) + (XNextEvent *window-display* *window-event*) + (let ((type (XAnyEvent-type *window-event*)) + (eventwindow (XAnyEvent-window *window-event*))) + (when (or (and (eql eventwindow win) + (or (eql type MotionNotify) + (eql type ButtonPress))) + (and outflg (eql type ButtonPress))) + (let ((x (XMotionEvent-x *window-event*)) + (y (XMotionEvent-y *window-event*)) + (code (if (eql type ButtonPress) + (XButtonEvent-button *window-event*) + 0))) + (setq res (if (eql eventwindow win) + (funcall fn x (- h y) code) + (funcall fn -1 -1 code))) ) ) ) ) )) + +; 22 Aug 91; 23 Aug 91; 27 Aug 91; 04 Sep 92; 11 Mar 93 +; Wait for a window to become exposed, but not more than 1 second. +(defun window-wait-exposure (w) + (prog (win start-time max-time eventwindow type) + (setq win (window-parent w)) + (XGetWindowAttributes *window-display* win *window-attr*) + (unless (eql (XWindowAttributes-map_state *window-attr*) + ISUnmapped) + (return t)) + (setq start-time (get-internal-real-time)) + (setq max-time internal-time-units-per-second) + (Xselectinput *window-display* win (+ ExposureMask)) + ; Event processing loop: stop when exposure is seen or time out + lp (cond ((> (XPending *window-display*) 0) + (XNextEvent *window-display* *window-event*) + (setq type (XAnyEvent-type *window-event*)) + (setq eventwindow (XAnyEvent-window *window-event*)) + (if (and (eql eventwindow win) + (eql type Expose)) + (return t))) + ((> (- (get-internal-real-time) start-time) + max-time) + (return nil)) ) + (go lp) )) + +; 11 Mar 93; 06 May 93 +; Wait for a window to become unmapped, but not more than 1 second. +(defun window-wait-unmap (w) + (prog (win start-time max-time) + (setq win (window-parent w)) + (setq start-time (get-internal-real-time)) + (setq max-time internal-time-units-per-second) +lp (XGetWindowAttributes *window-display* win *window-attr*) + (if (eql (XWindowAttributes-map_state *window-attr*) + ISUnmapped) + (return t) + (if (> (- (get-internal-real-time) start-time) max-time) + (return nil))) + (go lp) )) + +; 07 Oct 93 +; Initialize to poll the mouse for a specified window +(defun window-init-mouse-poll (w) + (let (win) + (setq win (window-parent w)) + (Xsync *window-display* 1) ; clear event queue of prev motion events + (Xselectinput *window-display* win + (+ ButtonPressMask PointerMotionMask)) )) + +; 07 Oct 93 +; Poll the mouse for a position change or button push +; Returns nil if no mouse activity, +; else (x y code), where x and y are positions, or nil if no movement, +; and code is 0 if no button else button number +(defun window-poll-mouse (w) + (let (win h eventtype eventwindow x y cd (code 0)) + (setq win (window-parent w)) + (setq h (window-drawable-height w)) + (while (> (XPending *window-display*) 0) + (XNextEvent *window-display* *window-event*) + (setq eventtype (XAnyEvent-type *window-event*)) + (setq eventwindow (XAnyEvent-window *window-event*)) + (if (eql eventwindow win) + (if (eql eventtype MotionNotify) + (progn (setq x (XMotionEvent-x *window-event*)) + (setq y (XMotionEvent-y *window-event*))) + (if (eql eventtype ButtonPress) + (if (> (setq cd (XButtonEvent-button *window-event*)) + 0) + (setq code cd))))) ) + (if (or x (> code 0)) (list x (if y (- h y)) code)) )) + +; 14 Dec 90; 17 Dec 90; 13 Aug 91; 20 Aug 91; 30 Aug 91; 09 Sep 91; 11 Sep 91 +; 15 Oct 91; 16 Oct 91; 10 Feb 92; 25 Sep 92; 26 Sep 92 +; Initialize a menu +(gldefun menu-init ((m menu)) + (let () + (or *window-display* (window-Xinit)) ; init windows if necessary + (calculate-size m) + (if ~ (flat m) + ((menu-window m) = (window-create (picture-width m) + (picture-height m) + ((title m) or "") + (parent-window m) + (parent-offset-x m) + (parent-offset-y m) + (menu-font m) )) ) )) + +; 25 Sep 92; 26 Sep 92; 11 Mar 93; 05 Oct 93; 08 Oct 93; 17 May 04; 12 Jan 10 +; Calculate the displayed size of a menu +(gldefun menu-calculate-size ((m menu)) + (let (maxwidth totalheight nitems) + (or (menu-font m) ((menu-font m) = '9x15)) + (maxwidth = (find-item-width m (title m)) + + (if (or (flat m) *window-add-menu-title*) + 0 + *menu-title-pad*)) + (nitems = (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + 1 0)) + (totalheight = (* nitems 13)) ; ***** fix for font + (for item in (items m) do + (nitems _+ 1) + (maxwidth = (max maxwidth (find-item-width m item))) + (totalheight =+ (menu-find-item-height m item)) ) + ((item-width m) = maxwidth + 6) + ((picture-width m) = (item-width m) + 1) + ((picture-height m) = totalheight + 2) + (adjust-offset m) )) + +; 06 Sep 91; 09 Sep 91; 10 Sep 91; 21 May 93; 30 May 02; 17 May 04; 08 Sep 06 +; Adjust a menu's offset position if necessary to keep it in parent window. +(gldefun menu-adjust-offset ((m menu)) + (let (xbase ybase wbase hbase xoff yoff wgm width height) + (width = (picture-width m)) + (height = (picture-height m)) + (if ~ (parent-window m) + (progn (window-get-mouse-position) ; put it where the mouse is + (wgm = t) ; set flag that we got mouse position + ((parent-window m) = *root-window*))) ; 21 May 93 was *mouse-window* + (window-get-geometry-b (parent-window m)) + (setq xbase (int-pos *x-return* 0)) + (setq ybase (int-pos *y-return* 0)) + (setq wbase (int-pos *width-return* 0)) + (setq hbase (int-pos *height-return* 0)) + (if (~ (parent-offset-x m) or (parent-offset-x m) == 0) + (progn (or wgm (window-get-mouse-position)) + (xoff = ((*mouse-x* - xbase) - (truncate width 2) - 4)) + (yoff = ((hbase - (*mouse-y* - ybase)) - (truncate height 2)))) + (progn (xoff = (parent-offset-x m)) + (yoff = (parent-offset-y m)))) + ((parent-offset-x m) = (max 0 (min xoff (wbase - width)))) + ((parent-offset-y m) = (max 0 (min yoff (hbase - height)))) )) + +; 07 Dec 90; 14 Dec 90; 12 Aug 91; 22 Aug 91; 09 Sep 91; 10 Sep 91; 28 Jan 92; +; 10 Feb 92; 26 Sep 92; 11 Mar 93; 08 Oct 93; 17 May 04; 12 Jan 10 +(gldefun menu-draw ((m menu)) + (let (mw xzero yzero bottom) + (init? m) + (xzero = (menu-x m 0)) + (yzero = (menu-y m 0)) + (mw = (menu-window m)) + (open mw) + (clear m) + (if (flat m) (draw-box-xy mw (xzero - 1) yzero ((picture-width m) + 2) + ((picture-height m) + 1) 1)) + (bottom = (yzero + (picture-height m) + 3)) + (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + (progn (bottom _- 15) ; ***** fix for font + (printat-xy mw (stringify (title m)) (+ xzero 3) bottom) + (invert-area-xy mw xzero (bottom - 2) + ((picture-width m) + 1) 15))) + (for item in (items m) do + (bottom _- (menu-find-item-height m item)) + (display-item m item (+ xzero 3) bottom) ) + (force-output mw) )) + +; 17 May 04 +(gldefun menu-item-value (self item) + (if (consp item) (cdr item) item)) + +; 06 Sep 91; 11 Sep 91; 15 Oct 91; 16 Oct 91; 23 Oct 91; 17 May 04 +(gldefun menu-find-item-width ((self menu) item) + (let ((tmp vector)) + (if (and (consp item) + (symbolp (car item)) + (fboundp (car item))) + (or (and (tmp = (get (car item) 'display-size)) + (x tmp)) + 40) + (window-font-string-width + (or (and (flat self) + (menu-window self) + (font (menu-window self))) + (window-font-info (menu-font self))) + (stringify (if (consp item) (car item) item)))) )) + + +; 09 Sep 91; 10 Sep 91; 11 Sep 91; 17 mAY 04 +(gldefun menu-find-item-height ((self menu) item) ; ***** fix for font + (let ((tmp vector)) + (if (and (consp item) + (symbolp (car item)) + (tmp = (get (car item) 'display-size))) + ((y tmp) + 3) + 15) )) + +; 09 Sep 91; 10 Sep 91; 10 Feb 92; 17 May 04 +(gldefun menu-clear ((m menu)) + (if (flat m) + (erase-area-xy (menu-window m) ((base-x m) - 1) ((base-y m) - 1) + ((picture-width m) + 3) ((picture-height m) + 3)) + (clear (menu-window m))) ) + +; 06 Sep 91; 04 Dec 91; 17 May 04 +(gldefun menu-display-item ((self menu) item x y) + (let ((mw (menu-window self))) + (if (consp item) + (if (and (symbolp (car item)) + (fboundp (car item))) + (funcall (car item) mw x y) + (if (or (stringp (car item)) (symbolp (car item)) + (numberp (car item))) + (printat-xy mw (car item) x y) + (printat-xy mw (stringify item) x y))) + (printat-xy mw (stringify item) x y)) )) + +; 07 Dec 90; 18 Dec 90; 15 Aug 91; 27 Aug 91; 06 Sep 91; 10 Sep 91; 29 Sep 92 +; 04 Aug 93; 07 Jan 94; 17 May 04; 18 May 04; 12 Jan 10; 13 Jan 10 +(gldefun menu-choose ((m menu) (inside boolean)) + (let (mw current-item ybase itemh val maxx maxy xzero yzero) + (init? m) + (mw = (menu-window m)) + (draw m) + (xzero = (menu-x m 0)) + (yzero = (menu-y m 0)) + (maxx = (+ xzero (picture-width m))) + (maxy = (+ yzero (picture-height m))) + (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + (maxy =- 15)) + (track-mouse mw + #'(lambda (x y code) + (setq *window-menu-code* code) + (if (and (>= x xzero) (<= x maxx) ; is mouse in menu area? + (>= y yzero) (<= y maxy)) + (if (or (null current-item) ; is mouse in a new item? + (< y ybase) + (> y (+ ybase itemh)) ) + (progn + (if current-item + (unbox-item m current-item ybase)) + (current-item = (menu-find-item-y m (- y yzero))) + (if current-item + (progn (ybase = (menu-item-y m current-item)) + (itemh = (menu-find-item-height + m current-item)) + (box-item m current-item ybase) + (inside = t))) + (if (> code 0) ; same item: click? + (progn (unbox-item m current-item ybase) + (val = 1)))) + (if (> code 0) ; same item: click? + (progn (unbox-item m current-item ybase) + (val = 1)))) + (progn (if current-item ; mouse outside area + (progn (unbox-item m current-item ybase) + (current-item = nil))) + (if (or (> code 0) + (and inside + (or (< x xzero) (> x maxx) + (< y yzero) (> y maxy)))) + (val = -777))))) + t) + (if (not (eql val -777)) (item-value m current-item)) )) + +; 07 Dec 90; 12 Aug 91; 10 Sep 91; 05 Oct 92; 12 Jan 10 +(gldefun menu-box-item ((m menu) (item menu-item) (ybase integer)) + (let ( (mw (menuw m)) ) + (set-xor mw) + (draw-box-xy mw (menu-x m 1) ((menu-y m ybase) + 2) + ((item-width m) - 2) + (menu-find-item-height m item) + 1) + (unset mw) )) + +; 07 Dec 90; 12 Aug 91; 14 Aug 91; 15 Aug 91; 05 Oct 92; 12 Jan 10 +(gldefun menu-unbox-item ((m menu) (item menu-item) (ybase integer)) + (box-item m item ybase) ) + +; 11 Sep 91; 08 Sep 92; 28 Sep 92; 18 Jan 94; 08 Sep 06; 12 Jan 10; 13 Jan 10 +(gldefun menu-item-position ((m menu) (itemname symbol) + &optional (place symbol)) + (let ( (xsize (item-width m)) ybase item ysize) + (item = (menu-find-item m itemname)) + (ysize = (menu-find-item-height m item)) + (ybase = (menu-item-y m item)) + (a vector with + x = ((menu-x m 0) + + (case place + ((center top bottom) (truncate xsize 2)) + (left -1) + (right xsize + 2) + else 0)) + y = ((menu-y m ybase) + + (case place + ((center right left) (truncate ysize 2)) + (bottom 0) + (top ysize) + else 0)) ) )) + +; 13 Jan 10 +; find the y position of bottom of item with given name +(gldefun menu-find-item ((m menu) (itemname symbol)) + (let (found itms item) + (itms = (items m)) + (found = (null itemname)) + (while (and itms (not found)) + (item -_ itms) + (if (or (eq item itemname) + (and (consp item) + (or (eq itemname (car item)) + (and (stringp (car item)) + (string= (stringify itemname) (car item))) + (eq (cdr item) itemname) + (and (consp (cdr item)) + (eq (cadr item) itemname))))) + (found = t))) + item)) + +; 12 Jan 10 +; find the y position of bottom of a given item +(gldefun menu-item-y ((m menu) (item menu-item)) + (let (found itms itm ybase) + (ybase = (picture-height m) - 1) + (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + (ybase =- 15)) + (itms = (items m)) + (while (and itms (not found)) + (itm -_ itms) + (ybase =- (menu-find-item-height m itm)) + (found = (eq item itm)) ) + ybase)) + +; 12 Jan 10 +; find item based on y position +(gldefun menu-find-item-y ((m menu) (y integer)) + (let (found itms itm ybase) + (ybase = (picture-height m) - 1) + (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + (ybase =- 15)) + (itms = (items m)) + (while (and itms (not found)) + (itm -_ itms) + (ybase =- (menu-find-item-height m itm)) + (found = (and (>= y ybase) + (<= y (+ ybase (menu-find-item-height m itm)))))) + (and found itm))) + +; 10 Dec 90; 13 Dec 90; 10 Sep 91; 29 Sep 92; 17 May 04 +; Choose from menu, then close it +(gldefun menu-select ((m menu) &optional inside) (menu-select-b m nil inside)) +(gldefun menu-select! ((m menu)) (menu-select-b m t nil)) +(gldefun menu-select-b ((m menu) (flg boolean) (inside boolean)) + (prog (res) +lp (res = (choose m inside)) + (if (flg and ~res) (go lp)) + (if ~(permanent m) + (if (flat m) + (progn (clear m) + (force-output (menu-window m))) + (close (menu-window m)))) + (return res))) + +; 12 Aug 91; 17 May 04 +(gldefun menu-destroy ((m menu)) + (if ~ (flat m) + (progn (destroy (menu-window m)) + ((menu-window m) = nil) ))) + +; 19 Aug 91; 02 Sep 91 +; Easy interface to make a menu, select from it, and destroy it. +(defun menu (items &optional title) + (let (m res) + (setq m (menu-create items title)) + (setq res (menu-select m)) + (menu-destroy m) + res )) + +; 12 Aug 91; 15 Aug 91; 06 Sep 91; 09 Sep 91; 12 Sep 91; 23 Oct 91; 17 May 04 +; Simple call from plain Lisp to make a menu. +(setf (glfnresulttype 'menu-create) 'menu) +(gldefun menu-create (items &optional title (parentw window) x y + (perm boolean) (flat boolean) (font symbol)) + (a menu with title = (if title (stringify title) "") + menu-window = (if flat parentw) + items = items + parent-window = (parent parentw) + parent-offset-x = x + parent-offset-y = y + permanent = perm + flat = flat + menu-font = font )) + +; 15 Oct 91; 30 Oct 91 +(gldefun menu-offset ((m menu)) + (result vector) + (a vector with x = (base-x m) y = (base-y m))) + +; 15 Oct 91; 30 Oct 91; 25 Sep 92; 29 Sep 92; 18 Apr 95; 25 Jul 96 +(gldefun menu-size ((m menu)) + (result vector) + (if ((picture-width m) <= 0) + (case (first m) + (picmenu (picmenu-calculate-size m)) + (barmenu (barmenu-calculate-size m)) + (textmenu (textmenu-calculate-size m)) + (editmenu (editmenu-calculate-size m)) + (t (menu-calculate-size m)))) + (a vector with x = (picture-width m) y = (picture-height m)) ) + +; 15 Oct 91; 17 May 04 +(gldefun menu-moveto-xy ((m menu) (x integer) (y integer)) + (if (flat m) + (progn ((parent-offset-x m) = x) + ((parent-offset-y m) = y) + (adjust-offset m)) )) + +; 27 Nov 92; 17 May 04 +; Reposition a menu to a position specified by the user by mouse click +(gldefun menu-reposition ((m menu)) + (let (sizev pos) + (if (flat m) + (progn (sizev = (size m)) + (pos = (get-box-position (menu-window m) (x sizev) (y sizev))) + (moveto-xy m (x pos) (y pos)) ) ))) + +; 31 Aug 09 +; Reposition a menu to a position specified by the user by mouse click +(gldefun menu-reposition-line ((m menu) (offset vector) (target vector)) + (let (sizev pos) + (if (flat m) + (progn (sizev = (size m)) + (pos = (get-box-line-position (menu-window m) + (x sizev) (y sizev) (x offset) (y offset) + (x target) (y target))) + (moveto-xy m (x pos) (y pos)) ) ))) + +; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91 +; Simple call from plain Lisp to make a picture menu. +(setf (glfnresulttype 'picmenu-create) 'picmenu) +(gldefun picmenu-create + (buttons (width integer) (height integer) drawfn + &optional title (dotflg boolean) (parentw window) x y (perm boolean) + (flat boolean) (font symbol) (boxflg boolean)) + (picmenu-create-from-spec + (picmenu-create-spec buttons width height drawfn dotflg font) + title parentw x y perm flat boxflg)) + +; 14 Sep 91 +(setf (glfnresulttype 'picmenu-create-spec) 'picmenu-spec) +(gldefun picmenu-create-spec (buttons (width integer) (height integer) drawfn + &optional (dotflg boolean) (font symbol)) + (a picmenu-spec with drawing-width = width + drawing-height = height + buttons = buttons + dotflg = dotflg + drawfn = drawfn + menu-font = (font or '9x15))) + +; 14 Sep 91; 17 May 04 +(setf (glfnresulttype 'picmenu-create-from-spec) 'picmenu) +(gldefun picmenu-create-from-spec + ((spec picmenu-spec) &optional title (parentw window) x y + (perm boolean) (flat boolean) (boxflg boolean)) + (a picmenu with title = (if title (stringify title) "") + menu-window = (if flat parentw) + parent-window = (if parentw (parent parentw)) + parent-offset-x = x + parent-offset-y = y + permanent = perm + flat = flat + spec = spec + boxflg = boxflg +)) + +; 29 Sep 92; 13 Oct 93; 17 May 04 +(gldefun picmenu-calculate-size ((m picmenu)) + (let (maxwidth maxheight) + (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) + 0) + (drawing-width m))) + (maxheight = (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + 15 0) + + (drawing-height m)) + ((picture-width m) = maxwidth) + ((picture-height m) = maxheight) )) + +; 09 Sep 91; 10 Sep 91; 29 Sep 92 +; Initialize a picture menu +(gldefun picmenu-init ((m picmenu)) + (let () + (calculate-size m) + (adjust-offset m) + (if ~ (flat m) + ((menu-window m) = (window-create (picture-width m) + (picture-height m) + ((title m) or "") + (parent-window m) + (parent-offset-x m) + (parent-offset-y m) + (menu-font m) )) ) )) + +; 09 Sep 91; 10 Sep 91; 11 Sep 91; 10 Feb 92; 05 Oct 92; 30 Oct 92; 13 Oct 93 +; 17 May 04 +; Draw a picture menu +(gldefun picmenu-draw ((m picmenu)) + (let (mw bottom xzero yzero) + (init? m) + (mw = (menu-window m)) + (open mw) + (clear m) + (xzero = (menu-x m 0)) + (yzero = (menu-y m 0)) + (bottom = yzero + (picture-height m)) + (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + (progn (printat-xy mw (stringify (title m)) (xzero + 3) (bottom - 13)) + (invert-area-xy mw xzero (bottom - 15) (picture-width m) 16))) + (funcall (drawfn m) mw xzero yzero) + (if (boxflg m) (draw-box-xy mw xzero yzero + (picture-width m) (picture-height m) 1)) + (if (dotflg m) + (for b in (buttons m) do (draw-button m b)) ) + ((deleted-buttons m) = nil) + (force-output mw) )) + +; 28 Oct 09 +(gldefun picmenu-draw-named-button ((m picmenu) (nm symbol)) + (draw-button m (assoc nm (buttons m)))) + +; 28 Oct 09 +(gldefun picmenu-set-named-button-color ((m picmenu) (nm symbol) (color rgb)) + (let (lst) + (if (lst = (assoc nm (button-colors m))) + ((color lst) = color) + ((button-colors m) +_ (list nm color)) ) )) + +; 05 Oct 92; 28 Oct 09 +(gldefun picmenu-draw-button ((m picmenu) (b picmenu-button)) + (let ((mw (menu-window m)) col) + (set-invert mw) + (draw-box-xy mw ((menu-x m 0) + (x (offset b)) - 2) + ((menu-y m 0) + (y (offset b)) - 2) + 4 4 1) + (unset mw) + (if (setq col (assoc (buttonname b) (button-colors m))) + (progn (window-set-color-rgb mw (red (color col)) (green (color col)) + (blue (color col))) + (draw-box-xy mw ((menu-x m 0) + (x (offset b)) - 1) + ((menu-y m 0) + (y (offset b)) - 1) + 3 3 2) + (window-reset-color mw)) ) )) + +; 05 Oct 92; 30 Oct 92; 17 May 04 +; Delete a button and erase it from the display +(gldefun picmenu-delete-named-button ((m picmenu) (name symbol)) + (let (b) + (if (and (b = (assoc name (buttons m))) + ~ (name <= (deleted-buttons m))) + (progn (if (dotflg m) (draw-button m b)) + ((deleted-buttons m) +_ name) )) + (force-output (menu-window m)) )) + +; 09 Sep 91; 10 Sep 91; 18 Sep 91; 29 Sep 92; 26 Oct 92; 30 Oct 92; 06 May 93 +; 04 Aug 93; 07 Jan 94; 30 May 02; 17 May 04; 18 May 04; 01 Jun 04; 24 Jan 06 +; inside = t if the mouse is already inside the menu area +; anyclick = value to return for a mouse click that is not on a button. +(gldefun picmenu-select ((m picmenu) &optional inside anyclick) + (let (mw (current-button picmenu-button) item items (val picmenu-button) + xzero yzero codeval) + (mw = (menuw m)) + (if ~ (permanent m) (draw m)) + (xzero = (menu-x m 0)) + (yzero = (menu-y m 0)) + (track-mouse mw + #'(lambda (x y code) + (setq *window-menu-code* code) + (x = (x - xzero)) + (y = (y - yzero)) + (if ((x >= 0) and (x <= (picture-width m)) + and (y >= 0) and (y <= (picture-height m))) + (inside = t)) + (if current-button + (if ~ (containsxy? current-button x y) + (progn (unbox-item m current-button) + (current-button = nil)))) + (if ~ current-button + (progn (items = (buttons m)) + (while ~ current-button and (item -_ items) do + (if (and (containsxy? item x y) + (not ((buttonname item) <= + (deleted-buttons m)))) + (progn (box-item m item) + (current-button = item)))))) + (if (or (> code 0) + (and inside (or (x < 0) (x > (picture-width m)) + (y < 0) (y > (picture-height m))))) + (progn (if current-button (unbox-item m current-button)) + (codeval = code) + (val = (if (and (> code 0) current-button) + current-button + *picmenu-no-selection*)) ))) + t) + (if ~(permanent m) + (if (flat m) (progn (clear m) + (force-output (menu-window m))) + (close (menu-window m)))) + (if (val == *picmenu-no-selection*) + (and (> codeval 0) anyclick) + (buttonname val)) )) + + +; 09 Sep 91; 10 Sep 91; 17 May 04; 08 Sep 06 +(gldefun picmenu-box-item ((m picmenu) (item picmenu-button)) + (let ((mw (menuw m)) xoff yoff siz) + (xoff = (menu-x m (x (offset item)))) + (yoff = (menu-y m (y (offset item)))) + (if (highlightfn item) + (funcall (highlightfn item) (menuw m) xoff yoff) + (progn (set-xor mw) + (if (siz = (size item)) + (draw-box-xy mw (xoff - (truncate (x siz) 2)) + (yoff - (truncate (y siz) 2)) + (x siz) (y siz) 1) + (draw-box-xy mw (xoff - 6) (yoff - 6) 12 12 1)) + (unset mw) + (force-output mw) ) ))) + +; 09 Sep 91; 06 May 93; 17 May 04 +(gldefun picmenu-unbox-item ((m picmenu) (item picmenu-button)) + (let ((mw (menuw m))) + (if (unhighlightfn item) + (progn (funcall (unhighlightfn item) (menuw m) + (x (offset item)) (y (offset item))) + (force-output mw)) + (box-item m item) ) )) + +(defun picmenu-destroy (m) (menu-destroy m)) + +; 09 Sep 91; 10 Sep 91; 11 Sep 91; 08 Sep 06 +(gldefun picmenu-button-containsxy? ((b picmenu-button) (x integer) + (y integer)) + (let ((xsize 6) (ysize 6)) + (if (size b) (progn (xsize = (truncate (x (size b)) 2)) + (ysize = (truncate (y (size b)) 2)))) + ((x >= ((x (offset b)) - xsize)) and (x <= ((x (offset b)) + xsize)) and + (y >= ((y (offset b)) - ysize)) and (y <= ((y (offset b)) + ysize)) ) )) + +; 11 Sep 91; 08 Sep 92; 18 Jan 94; 30 May 02; 17 May 04; 24 Jan 06; 08 Sep 06 +(gldefun picmenu-item-position ((m picmenu) (itemname symbol) + &optional (place symbol)) + (let ((b picmenu-button) (xsize 0) (ysize 0) xoff yoff) + (if (null itemname) + (progn (xsize = (picture-width m)) + (ysize = (truncate ((picture-height m) - (drawing-height m)) 2)) + (xoff = (truncate xsize 2)) + (yoff = (drawing-height m) + (truncate ysize 2))) + (if (b = (that (buttons m) with buttonname == itemname)) + (progn (if (size b) + (progn (xsize = (x (size b))) + (ysize = (y (size b))))) + (xoff = (x (offset b))) + (yoff = (y (offset b))) ) )) + (if xoff (a vector with + x = ((menu-x m xoff) + (case place + ((center top bottom) 0) + (left (- (truncate xsize 2))) + (right (truncate xsize 2)) + else 0)) + y = ((menu-y m yoff) + (case place + ((center right left) 0) + (bottom (- (truncate ysize 2))) + (top (truncate ysize 2)) + else 0))) ) )) + +; 03 Jan 94; 18 Jan 94; 17 May 04 +; Simple call from plain Lisp to make a picture menu. +(setf (glfnresulttype 'barmenu-create) 'barmenu) +(gldefun barmenu-create + ((maxval integer) (initval integer) (barwidth integer) + &optional title (horizontal boolean) subtrackfn subtrackparms + (parentw window) x y (perm boolean) (flat boolean) (color rgb)) + (a barmenu with title = (if title (stringify title) "") + menu-window = (if flat parentw) + parent-window = (if parentw (parent parentw)) + parent-offset-x = (or x 0) + parent-offset-y = (or y 0) + permanent = perm + flat = flat + value = initval + maxval = maxval + barwidth = barwidth + horizontal = horizontal + subtrackfn = subtrackfn + subtrackparms = subtrackparms + color = color) ) + +; 03 Jan 94; 17 May 04 +(gldefun barmenu-calculate-size ((m barmenu)) + (let (maxwidth maxheight) + (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) + 0) + (barwidth m))) + (maxheight = (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + 15 0) + + (maxval m)) + ((picture-width m) = maxwidth) + ((picture-height m) = maxheight) )) + +; 03 Jan 94 +; Initialize a picture menu +(gldefun barmenu-init ((m barmenu)) + (let () + (calculate-size m) + (adjust-offset m) + (if ~ (flat m) + ((menu-window m) = (window-create (picture-width m) + (picture-height m) + ((title m) or "") + (parent-window m) + (parent-offset-x m) + (parent-offset-y m) )) ) )) + +; 03 Jan 94; 18 Jan 94; 17 May 04; 18 May 04; 08 Sep 06 +; Draw a picture menu +(gldefun barmenu-draw ((m barmenu)) + (let (mw xzero yzero) + (init? m) + (mw = (menu-window m)) + (open mw) + (clear m) + (xzero = (menu-x m (truncate (picture-width m) 2))) + (yzero = (menu-y m 0)) + (if (color m) (window-set-color mw (color m))) + (if (horizontal m) + (draw-line-xy (menu-window m) xzero yzero + (xzero + (value m)) yzero (barwidth m)) + (draw-line-xy (menu-window m) xzero yzero + xzero (+ yzero (value m)) (barwidth m)) ) + (if (color m) (window-reset-color mw)) + (force-output mw) )) + +; 03 Jan 94; 04 Jan 94; 07 Jan 94; 18 Jan 94; 08 Sep 06 +; inside = t if the mouse is already inside the menu area +(gldefun barmenu-select ((m barmenu) &optional inside) + (let (mw xzero yzero val) + (mw = (menuw m)) + (if ~ (permanent m) (draw m)) + (xzero = (menu-x m (truncate (picture-width m) 2))) + (yzero = (menu-y m 0)) + (when (window-track-mouse-in-region mw (menu-x m 0) yzero + (picture-width m) (picture-height m) t t) + (track-mouse mw + #'(lambda (x y code) + (setq *window-menu-code* code) + (val = (if (horizontal m) (x - xzero) (y - yzero))) + (update-value m val) + (if (> code 0) code) )) + val) )) + +; 03 Jan 93; 17 May 04; 08 Sep 06 +(defvar *barmenu-update-value-cons* (cons nil nil)) ; reusable cons +(gldefun barmenu-update-value ((m barmenu) (val integer)) + (let ((mw (menuw m)) xzero yzero) + (val = (max 0 (min val (maxval m)))) + (if (val <> (value m)) + (progn (if (val < (value m)) + (set-erase mw) + (if (color m) (window-set-color mw (color m)))) + (xzero = (menu-x m (truncate (picture-width m) 2))) + (yzero = (menu-y m 0)) + (if (horizontal m) + (draw-line-xy (menu-window m) + (+ xzero (value m)) yzero + (+ xzero val) yzero (barwidth m)) + (draw-line-xy (menu-window m) + xzero (+ yzero (value m)) + xzero (+ yzero val) (barwidth m)) ) + (if (val < (value m)) + (unset mw) + (if (color m) (window-reset-color mw)) ) + ((value m) = val) + (if (subtrackfn m) + (progn ((car *barmenu-update-value-cons*) = val) + ((cdr *barmenu-update-value-cons*) = (subtrackparms m)) + (apply (subtrackfn m) *barmenu-update-value-cons*))) + (force-output mw) ) ))) + +; Functions for text input "menus". Derived from picmenu code. +; Making text input analogous to menus allows use with menu-sets. + +; 18 Apr 95; 17 May 04 +; (setq tm (textmenu-create 200 30 nil myw 50 50 t t '9x15 t "Rutabagas")) +; Simple call from plain Lisp to make a text menu. +(setf (glfnresulttype 'textmenu-create) 'textmenu) +(gldefun textmenu-create ((width integer) (height integer) + &optional title (parentw window) x y + (perm boolean) (flat boolean) + (font symbol) (boxflg boolean) + (initial-text string)) + (a textmenu with title = (if title (stringify title) "") + menu-window = (if flat parentw) + parent-window = (if parentw (parent parentw)) + parent-offset-x = (or x 0) + parent-offset-y = (or y 0) + permanent = perm + flat = flat + drawing-width = width + drawing-height = height + menu-font = (font or '9x15) + boxflg = boxflg + text = initial-text) ) + +; 18 Apr 95; 17 May 04 +(gldefun textmenu-calculate-size ((m textmenu)) + (let (maxwidth maxheight) + (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) + 0) + (drawing-width m))) + (maxheight = (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + 15 0) + + (drawing-height m)) + ((picture-width m) = maxwidth) + ((picture-height m) = maxheight) )) + +; 18 Apr 95 +; Initialize a picture menu +(gldefun textmenu-init ((m textmenu)) + (let () + (calculate-size m) + (adjust-offset m) + (if ~ (flat m) + ((menu-window m) = + (window-create (picture-width m) (picture-height m) + ((title m) or "") (parent-window m) + (parent-offset-x m) (parent-offset-y m) + (menu-font m) )) ) )) + +; 18 Apr 95; 14 Aug 96; 17 May 04; 08 Sep 06 +; Draw a picture menu +(gldefun textmenu-draw ((m textmenu)) + (let (mw bottom xzero yzero) + (init? m) + (mw = (menu-window m)) + (open mw) + (clear m) + (xzero = (menu-x m 0)) + (yzero = (menu-y m 0)) + (bottom = yzero + (picture-height m)) + (if (and (title-present m) + (or (flat m) *window-add-menu-title*)) + (progn (printat-xy mw (stringify (title m)) (xzero + 3) (bottom - 13)) + (invert-area-xy mw xzero (bottom - 15) (picture-width m) 16))) + (if (text m) + (printat-xy mw (text m) (xzero + 10) + (yzero + (truncate (picture-height m) 2) - 8))) + (if (boxflg m) (draw-box-xy mw xzero yzero + (picture-width m) (picture-height m) 1)) + (force-output mw) )) + +; 18 Apr 95; 20 Apr 95; 21 Apr 95; 14 Aug 96; 17 May 04; 01 Jun 04; 08 Sep 06 +(gldefun textmenu-select ((m textmenu) &optional inside) + (let (mw xzero yzero codeval res) + (mw = (menuw m)) + (if ~ (permanent m) (draw m)) + (xzero = (menu-x m 0)) + (yzero = (menu-y m 0)) + (track-mouse mw + #'(lambda (x y code) + (setq *window-menu-code* code) + (x = (x - xzero)) + (y = (y - yzero)) + (if (or (> code 0) + (or (x < 0) (x > (picture-width m)) + (y < 0) (y > (picture-height m)))) + (codeval = code)) ) + t) + (if (and (not (permanent m)) (not (flat m))) + (close (menu-window m))) + (if (codeval > 0) + (progn (draw m) + (input-string mw (text m) (xzero + 10) + (yzero + (truncate (picture-height m) 2) - 8) + ((picture-width m) - 12)) ) ))) + +(gldefun textmenu-set-text ((m textmenu) &optional (s string)) + ((text m) = (or s ""))) + +; 15 Aug 91 +; Get a point position by mouse click. Returns (x y). +(setf (glfnresulttype 'window-get-point) 'vector) +(defun window-get-point (w) + (let (orgx orgy) + (window-track-mouse w ; get one point + #'(lambda (x y code) + (when (not (zerop code)) + (setq orgx x) + (setq orgy y)))) + (list orgx orgy) )) + +; 23 Aug 91 +; Get a point position by mouse click. Returns (button (x y)). +(setf (glfnresulttype 'window-get-click) + '(list (button integer) (pos vector))) +(defun window-get-click (w) + (let (orgx orgy button) + (window-track-mouse w ; get one point + #'(lambda (x y code) + (when (not (zerop code)) + (setq button code) + (setq orgx x) + (setq orgy y)))) + (list button (list orgx orgy)) )) + +; 13 Aug 91; 06 Aug 91 +; Get a position indicated by a line from a specified origin position. +; Returns (x y) at end of line. +(setf (glfnresulttype 'window-get-line-position) 'vector) +(defun window-get-line-position (w orgx orgy) + (window-get-icon-position w #'window-draw-line-xy (list orgx orgy 1 'paint))) + +; 17 Dec 93 +; Get a position indicated by a line from a specified origin position. +; The visual feedback is restricted to lines that LaTex can draw. +; Returns (x y) at end of line. flg is T for a vector position, nil for line. +(setf (glfnresulttype 'window-get-latex-position) 'vector) +(defun window-get-latex-position (w orgx orgy &optional flg) + (window-get-icon-position w #'window-draw-latex-xy (list orgx orgy flg))) + +; 13 Aug 91; 15 Aug 91; 05 Sep 91 +; Get a position indicated by a box of a specified size. +; (dx dy) is offset of lower-left corner of box from mouse +; Returns (x y) of lower-left corner of box. +(setf (glfnresulttype 'window-get-box-position) 'vector) +(defun window-get-box-position (w width height &optional (dx 0) (dy 0)) + (window-get-icon-position w #'window-draw-box-xy + (list width height 1) dx dy)) + +; 28 Aug 09 +; Get a position indicated by a box and line to a specified point +(setf (glfnresulttype 'window-get-box-line-position) 'vector) +(defun window-get-box-line-position (w width height offx offy tox toy + &optional (dx 0) (dy 0)) + (window-get-icon-position w #'window-draw-box-line-xy + (list width height offx offy tox toy) dx dy)) + +; 01 Sep 09 +(defun window-draw-box-line-xy (w x y width height offx offy tox toy) + (window-draw-box-xy w x y width height) + (window-draw-line-xy w (+ x offx) (+ y offy) tox toy)) + +; 05 Sep 91 +; Get a position indicated by an icon. +; fn is the function to draw the icon: (fn w x y . args) . +; fn must simply draw the icon, not set window parameters. +; (dx dy) is offset of lower-left corner of icon (x y) from mouse. +; Returns (x y) of mouse. +(setf (glfnresulttype 'window-get-icon-position) 'vector) +(defun window-get-icon-position (w fn args &optional (dx 0) (dy 0)) + (let (lastx lasty argl) + (setq argl (cons w (cons 0 (cons 0 args)))) ; arg list for fn + (window-set-xor w) + (window-track-mouse w + #'(lambda (x y code) + (when (or (null lastx) (/= x lastx) (/= y lasty)) + (if lastx (apply fn argl)) ; undraw + (rplaca (cdr argl) (+ x dx)) + (rplaca (cddr argl) (+ y dy)) + (apply fn argl) ; draw + (setq lastx x) + (setq lasty y)) + (not (zerop code)) )) + (apply fn argl) ; undraw + (window-unset w) + (window-force-output w) + (list lastx lasty) )) + +; 13 Aug 91; 06 Sep 91; 06 Nov 91 +; Get a box size and position. +; Click for top right, then click for bottom left, then move it. +; Returns ((x y) (width height)) where (x y) is lower-left corner of box. +(setf (glfnresulttype 'window-get-region) 'region) +(defun window-get-region (w &optional wid ht) + (let (lastx lasty start end width height place offx offy stx sty) + (if (and (numberp wid) (numberp ht)) + (progn (setq start (window-get-box-position w wid ht (- wid) (- ht))) + (setq stx (- (car start) wid)) + (setq sty (- (cadr start) ht)) ) + (progn (setq start (window-get-point w)) + (setq stx (car start)) + (setq sty (cadr start)))) + (setq end (window-get-icon-position w #'window-draw-box-corners + (list stx sty 1))) + (setq lastx (car end)) + (setq lasty (cadr end)) + (setq width (abs (- stx lastx))) + (setq height (abs (- sty lasty))) + (setq offx (- (min stx lastx) lastx)) + (setq offy (- (min sty lasty) lasty)) + (setq place (window-get-box-position w width height offx offy)) + (list (list (+ offx (first place)) + (+ offy (second place))) + (list width height)) )) + +; 27 Nov 91; 10 Sep 92 +; Get box size and echo the size in pixels. Click for top right. +; Returns (width height) of box. +(setf (glfnresulttype 'window-get-box-size) 'vector) +(defun window-get-box-size (w offsetx offsety) + (let (legendy lastx lasty dx dy) + (setq offsety (max offsety 30)) + (setq legendy (- offsety 25)) + (window-erase-area-xy w offsetx legendy 71 21) + (window-draw-box-xy w offsetx legendy 70 20) + (window-track-mouse w + #'(lambda (x y code) + (when (or (null lastx) (/= x lastx) (/= y lasty)) + (if lastx (window-xor-box-xy w offsetx offsety + (- lastx offsetx) + (- lasty offsety))) + (setq lastx nil) + (setq dx (- x offsetx)) + (setq dy (- y offsety)) + (when (and (> dx 0) (> dy 0)) + (window-xor-box-xy w offsetx offsety dx dy) + (window-printat-xy w (format nil "~3D x ~3D" dx dy) + (+ offsetx 3) (+ legendy 5)) + (setq lastx x) + (setq lasty y))) + (not (zerop code)) )) + (if lastx (window-xor-box-xy w offsetx offsety (- lastx offsetx) + (- lasty offsety))) + (window-erase-area-xy w offsetx legendy 71 21) + (window-force-output w) + (list dx dy) )) + +; 29 Oct 91; 30 Oct 91; 04 Jan 94 +; Track mouse until a button is pressed or it leaves specified region. +; Returns (x y code) or nil. boxflg is T to box the region. +(setf (glfnresulttype 'window-track-mouse-in-region) + '(list (code integer) + (position (transparent vector)))) +(defun window-track-mouse-in-region (w offsetx offsety sizex sizey + &optional boxflg inside) + (let (res) + (when boxflg + (window-set-xor w) + (window-draw-box-xy w (- offsetx 4) (- offsety 4) + (+ sizex 8) (+ sizey 8)) + (window-unset w) + (window-force-output w) ) + (setq res (window-track-mouse w + #'(lambda (x y code) + (if (> code 0) + (if inside (list code (list x y)) t) + (if (or (< x offsetx) + (> x (+ offsetx sizex)) + (< y offsety) + (> y (+ offsety sizey))) + inside + (and (setq inside t) nil)))) ) ) + (when boxflg + (window-set-xor w) + (window-draw-box-xy w (- offsetx 4) (- offsety 4) + (+ sizex 8) (+ sizey 8)) + (window-unset w) + (window-force-output w) ) + (if (consp res) res) )) + +; 04 Nov 91 +; Adjust one side of a box by mouse movement. Returns ((x y) (width height)). +(setf (glfnresulttype 'window-adjust-box-side) 'region) +(defun window-adjust-box-side (w orgx orgy width height side) + (let (new (xx orgx) (yy orgy) (ww width) (hh height)) + (setq new (window-get-icon-position w #'window-adj-box-xy + (list orgx orgy width height side))) + (case side (left (setq xx (car new)) + (setq ww (+ width (- orgx (car new))))) + (right (setq ww (- (car new) orgx))) + (top (setq hh (- (cadr new) orgy))) + (bottom (setq yy (cadr new)) + (setq hh (+ height (- orgy (cadr new))))) ) + (list (list xx yy) (list ww hh)) )) + +; 04 Nov 91 +(defun window-adj-box-xy (w x y orgx orgy width height side) + (let ((xx orgx) (yy orgy) (ww width) (hh height)) + (case side (left (setq xx x) (setq ww (+ width (- orgx x)))) + (right (setq ww (- x orgx))) + (top (setq hh (- y orgy))) + (bottom (setq yy y) (setq hh (+ height (- orgy y)))) ) + (window-draw-box-xy w xx yy ww hh) )) + + +; 10 Sep 92 +; Get a circle with a specified center and size. +; center is initial center position, if specified. +; Returns ((x y) radius) +(setf (glfnresulttype 'window-get-circle) + '(list (center vector) (radius integer))) +(defun window-get-circle (w &optional center) + (let (pt) + (or center (setq center (window-get-crosshairs w))) + (setq pt (window-get-icon-position w #'window-draw-circle-pt + (list center))) + (list center (window-circle-radius (car pt) (cadr pt) center)) )) + +; 10 Sep 92 +(defun window-circle-radius (x y center) + (let ((dx (- x (car center))) (dy (- y (cadr center)))) + (truncate (+ 0.5 (sqrt (+ (* dx dx) (* dy dy))))) )) + +; 10 Sep 92 +(defun window-draw-circle-pt (w x y center) + (window-draw-circle w center (window-circle-radius x y center) 1)) + +; 10 Sep 92; 15 Sep 92; 06 Nov 92 +; Get an ellipse with a specified center and sizes. +; center is initial center position, if specified. +; First gets a circle whose radius is x size, then adjusts it. +; Returns ((x y) (radiusx radiusy)) +(setf (glfnresulttype 'window-get-ellipse) + '(list (center vector) (halfsize vector))) +(defun window-get-ellipse (w &optional center) + (let (cir radiusx pt) + (setq cir (window-get-circle w center)) + (setq center (car cir)) + (setq radiusx (cadr cir)) + (setq pt (window-get-icon-position w #'window-draw-ellipse-pt + (list center radiusx))) + (list center (list radiusx (abs (- (cadr pt) (cadr center))))) )) + +; 10 Sep 92 +(defun window-draw-ellipse-pt (w x y center radiusx) + (window-draw-ellipse-xy w (car center) (cadr center) + radiusx (abs (- y (cadr center)))) ) + +; 30 Dec 93 +(defun window-draw-vector-pt (w x y center radius) + (let (dx dy theta) + (setq dy (- y (cadr center))) + (setq dx (- x (car center))) + (when (or (/= dx 0) (/= dy 0)) + (setq theta (atan (- y (cadr center)) (- x (car center)))) + (window-draw-line-xy w (car center) (cadr center) + (+ (car center) (* radius (cos theta))) + (+ (cadr center) (* radius (sin theta))) ) ) )) + +; 30 Dec 93 +(setf (glfnresulttype 'window-get-vector-end) 'vector) +(defun window-get-vector-end (w center radius) + (window-get-icon-position w #'window-draw-vector-pt (list center radius)) ) + +; 12 Sep 92 +(setf (glfnresulttype 'window-get-crosshairs) 'vector) +(defun window-get-crosshairs (w) + (window-get-icon-position w #'window-draw-crosshairs-xy nil) ) + +; 12 Sep 92 +(defun window-draw-crosshairs-xy (w x y) + (window-draw-line-xy w (- x 12) y (- x 3) y) + (window-draw-line-xy w (+ x 3) y (+ x 12) y) + (window-draw-line-xy w x (- y 12) x (- y 3)) + (window-draw-line-xy w x (+ y 3) x (+ y 12)) ) + +; 12 Sep 92 +(setf (glfnresulttype 'window-get-cross) 'vector) +(defun window-get-cross (w) + (window-get-icon-position w #'window-draw-cross-xy nil) ) + +; 12 Sep 92 +(defun window-draw-cross-xy (w x y) + (window-draw-line-xy w (- x 10) (- y 10) (+ x 10) (+ y 10) 2) + (window-draw-line-xy w (+ x 10) (- y 10) (- x 10) (+ y 10) 2) ) + +; 11 Sep 92; 14 Sep 92 +; Draw a dot whose center is at (x y) +(defun window-draw-dot-xy (w x y) + (window-draw-circle-xy w x y 1) + (window-draw-circle-xy w x y 2) + (window-draw-line-xy w x y (+ x 1) y 1) ) + +; 17 Dec 93; 19 Dec 93 +; Draw a line close to the specified coordinates, but restricted to slopes +; that can be drawn by LaTex. flg = T to restrict slopes for vector. +(defun window-draw-latex-xy (w x y orgx orgy flg) + (let (dx dy delx dely n ratio cd nrat) + (setq dx (- x orgx)) + (setq dy (- y orgy)) + (if (or (= dx 0) (= dy 0)) + (window-draw-line-xy w x y orgx orgy) + (progn (setq n (if flg 4 6)) + (if (> (abs dy) (abs dx)) + (progn (setq ratio (round (/ (* (abs dx) n) (abs dy)))) + (setq cd (gcd n ratio)) + (setq n (/ n cd)) + (setq ratio (/ ratio cd)) + (setq nrat (round (/ (abs dy) n))) + (setq dely (* (signum dy) nrat n)) + (setq delx (* (signum dx) nrat ratio)) ) + (progn (setq ratio (round (/ (* (abs dy) n) (abs dx)))) + (setq cd (gcd n ratio)) + (setq n (/ n cd)) + (setq ratio (/ ratio cd)) + (setq nrat (round (/ (abs dx) n))) + (setq delx (* (signum dx) nrat n)) + (setq dely (* (signum dy) nrat ratio)) )) + (window-draw-line-xy w (+ orgx delx) (+ orgy dely) orgx orgy)) ) + )) + +; 31 Dec 93 +; Reset window colors to default foreground and background. +(gldefun window-reset-color ((w window)) + (XSetForeground *window-display* (gcontext w) *default-fg-color*) + (XSetBackground *window-display* (gcontext w) *default-bg-color*) ) + +; 31 Dec 93; 04 Jan 94; 05 Jan 94 +; Set color to be used in a window to specified red/green/blue values. +; Values of r, g, b are integers on scale of 65535. +; Background is t if the background color is to be set, else foreground is set. +; Returns an xcolor. +(defun window-set-color-rgb (w r g b &optional background) + (let (ret) + (or *window-xcolor* (setq *window-xcolor* (Make-Xcolor))) + (set-Xcolor-red *window-xcolor* (+ r 0)) + (set-Xcolor-green *window-xcolor* (+ g 0)) + (set-Xcolor-blue *window-xcolor* (+ b 0)) + (setq ret (XAllocColor *window-display* + *default-colormap* *window-xcolor*)) + (if (not (eql ret 0)) + (window-set-xcolor w *window-xcolor* background)) )) + +; 05 Jan 94 +(defun window-set-xcolor (w &optional xcolor background) + (if background + (window-set-background w (XColor-Pixel xcolor)) + (window-set-foreground w (XColor-Pixel xcolor))) + xcolor) + +; 03 Jan 94 +(defun window-set-color (w rgb &optional background) + (window-set-color-rgb w (first rgb) (second rgb) (third rgb) background) ) + +; 31 Dec 93; 03 Jan 94; 05 Jan 94 +; Free the last xcolor used +(defun window-free-color (w &optional xcolor) + (or xcolor (setq xcolor *window-xcolor*)) + (if xcolor + (unless (or (eql xcolor *default-fg-color*) + (eql xcolor *default-bg-color*)) + (XFreeColors *window-display* + *default-colormap* xcolor 1 0)) ) ) + +; 31 Dec 93; 18 Jul 96; 25 Jul 96 +; Get characters or mouse clicks within a window, calling function fn +; with arguments (char button x y args). +; Tracking continues until fn returns non-nil; result is that value. +(defun window-get-chars (w fn &optional args) + (let (win res) + (or *window-keyinit* (window-init-keymap)) + (setq *window-shift* nil) + (setq *window-ctrl* nil) + (setq *window-meta* nil) + (setq win (window-parent w)) + (Xsync *window-display* 1) ; clear event queue of prev motion events + (Xselectinput *window-display* win + (+ KeyPressMask KeyReleaseMask ButtonPressMask)) + ;; Event processing loop: stop when function returns non-nil. + (while (null res) + (XNextEvent *window-display* *window-event*) + (let ((type (XAnyEvent-type *window-event*)) + (eventwindow (XAnyEvent-window *window-event*))) + (if (eql eventwindow win) + (setq res (window-process-char-event w type fn args))) )) + res)) + +; 31 Dec 93; 18 Jan 94; 04 Oct 94; 18 Jul 96; 19 Jul 96; 22 Jul 96; 23 Jul 96 +; 25 Jul 96; 08 Sep 06 +; Process a character event. type is event type. +; For Control, Shift, and Meta, global flags are set. +; (fn char button x y) is called for other characters. +(defun window-process-char-event (w type fn args) + (let (code) + (if (eql type KeyRelease) + (progn + (setq code (XButtonEvent-button *window-event*)) + (if (member code *window-shift-keys*) + (setq *window-shift* nil) + (if (member code *window-control-keys*) + (setq *window-ctrl* nil) + (if (member code *window-meta-keys*) + (setq *window-meta* nil))))) + (if (eql type KeyPress ) + (progn + (setq code (XButtonEvent-button *window-event*)) + (if (member code *window-shift-keys*) + (progn (setq *window-shift* t) nil) + (if (member code *window-control-keys*) + (progn (setq *window-ctrl* t) nil) + (if (member code *window-meta-keys*) + (progn (setq *window-meta* t) nil) + (funcall fn w (window-char-decode code) 0 0 0 + args) )))) + (if (eql type ButtonPress) + (funcall fn w 0 (XButtonEvent-button *window-event*) + (XMotionEvent-x *window-event*) + (- (window-drawable-height w) + (XMotionEvent-y *window-event*)) + args)) ) ) )) + +; 23 Jul 96; 23 Dec 96 +; Change keyboard code into character; assumes ASCII for control chars +(defun window-char-decode (code) + (let (char) + (setq char (aref (if *window-shift* *window-shiftkeymap* *window-keymap*) + code)) + (if (and char *window-ctrl*) + (setq char (code-char (- (char-code (char-upcase char)) 64)))) + (if (and char *window-meta*) ; simulate meta using 128 + (setq char (code-char (+ (char-code (char-upcase char)) 128)))) + (or char #\Space) )) + +; 31 Dec 93; 04 Oct 94; 16 Nov 94 +; Get character within a window, calling function fn with arg (char). +; Tracking continues until fn returns non-nil; result is that value. +(defun window-get-raw-char (w) + (let (win res) + (or *window-keyinit* (window-init-keymap)) + (setq *window-shift* nil) + (setq *window-ctrl* nil) + (setq *window-meta* nil) + (setq win (window-parent w)) + (Xsync *window-display* 1) ; clear event queue of prev motion events + (Xselectinput *window-display* win + (+ KeyPressMask KeyReleaseMask)) + ;; Event processing loop: stop when function returns non-nil. + (while (null res) + (XNextEvent *window-display* *window-event*) + (let ((type (XAnyEvent-type *window-event*)) + (eventwindow (XAnyEvent-window *window-event*))) + (if (and (eql eventwindow win) + (eql type KeyPress)) + (setq res (XButtonEvent-button *window-event*)) ) )) + res)) + +; 31 Dec 93; 19 Jul 96; 12 Aug 96; 13 Aug 96 +; Input a string from keyboard, echo in window. str is initial string. +; Backspace is handled; terminate with return. Size is max width in pixels. +(defun window-input-string (w str x y &optional size) + (car (window-edit w x y (or size 100) 16 (list (or str "")) nil t t) ) ) + +; 19 Jul 96; 22 Jul 96; 12 Aug 96; 13 Aug 96 +; Edit strings in a window area with Emacs-subset editor +; strings is a list of strings, which is the return value +; scroll is number of lines to scroll down before displaying text, +; or t to have one line only and terminate on return. +; endp is T to begin edit at end of first line +; e.g. (window-draw-box-xy myw 48 48 204 204) +; (window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) +(gldefun window-edit (w x y width height &optional strings boxflg scroll endp) + (let (em) + (em = (editmenu-create width height nil w x y nil t '9x15 boxflg + strings scroll endp)) + (edit em) + (carat em) ; erase the carat + (text em) )) + +; 25 Jul 96; 26 Jul 96; 12 Aug 96; 13 Aug 96; 15 Aug 96; 17 May 04 +; (setq em (editmenu-create 200 30 nil myw 50 50 t t '9x15 t ("Rutabagas"))) +; Simple call from plain Lisp to make an edit menu. +(setf (glfnresulttype 'editmenu-create) 'editmenu) +(gldefun editmenu-create ((width integer) (height integer) + &optional title (parentw window) x y + (perm boolean) (flat boolean) + (font symbol) (boxflg boolean) + (initial-text (listof string)) + scrollval (endp boolean)) + (an editmenu with title = (if title (stringify title) "") + menu-window = (if flat parentw) + parent-window = (if parentw (parent parentw)) + parent-offset-x = (or x 0) + parent-offset-y = (or y 0) + permanent = perm + flat = flat + drawing-width = width + drawing-height = height + menu-font = (font or '9x15) + boxflg = boxflg + text = (or initial-text (list "")) + scrollval = (or scrollval 0) + line = (if (numberp scrollval) + scrollval + 0) + column = (if endp + (length (car (nthcdr + (if (numberp scrollval) + scrollval + 0) + initial-text))) + 0)) ) + +; 25 Jul 96 +(gldefun editmenu-calculate-size ((m editmenu)) + ((picture-width m) = (drawing-width m)) + ((picture-height m) = (drawing-height m)) ) + +; 18 Apr 95 +; Initialize a picture menu +(gldefun editmenu-init ((m editmenu)) + (let () + (calculate-size m) + (adjust-offset m) + (if ~ (flat m) + ((menu-window m) = + (window-create (picture-width m) (picture-height m) + ((title m) or "") (parent-window m) + (parent-offset-x m) (parent-offset-y m) + (menu-font m) )) ) )) + +; 25 Jul 96; 31 July 96; 14 Aug 96 +(gldefun editmenu-draw ((m editmenu)) + (let (mw xzero yzero) + (init? m) + (mw = (menu-window m)) + (open mw) + (clear m) + (xzero = (menu-x m 0)) + (yzero = (menu-y m 0)) + (if (boxflg m) (draw-box-xy mw xzero yzero + (picture-width m) (picture-height m) 1)) + (display m 0 0 (not (numberp scrollval))) )) + +; 19 Jul 96; 22 Jul 96; 23 Jul 96; 25 Jul 96; 31 July 96; 01 Aug 96; 17 May 04 +; 18 Aug 04; 27 Jan 06 +; Display contents of edit area +; Begin with the specified line and char number; one line only if only is T. +(gldefun editmenu-display ((m editmenu) line char only) + (let (lines y maxwidth linewidth (w (menuw m))) + (setq lines (nthcdr line (text m))) + (setq y (line-y m (- line (scroll m)))) + (setq maxwidth (truncate (- (picture-width m) 6) (font-width (menuw m)))) + (while (and lines (>= y (menu-y m 4))) + (when (< char maxwidth) + (if (> char 0) + (printat-xy w (subseq (first lines) char + (min maxwidth (length (first lines)))) + (menu-x m (+ 2 (* char (font-width (menuw m))))) + y) + (printat-xy w (if (<= (length (first lines)) maxwidth) + (first lines) + (subseq (first lines) 0 maxwidth)) + (menu-x m 2) y))) + (setq linewidth (+ 2 (* (font-width (menuw m)) (length (first lines))))) + (window-erase-area-xy w (menu-x m linewidth) + (- y 2) + (- (picture-width m) (+ linewidth 2)) + (font-height (menuw m))) + (y _- (font-height (menuw m))) + (if only (setq lines nil) + (progn (pop lines) + (if (and (null lines) (>= y (menu-y m 4))) + ; erase an extra line at the end + (window-erase-area-xy w (menu-x m 2) + (- y 2) + (- (picture-width m) 4) + (font-height (menuw m))) ) )) + (setq char 0) ) + (force-output w) )) + +; 19 Jul 96; 22 Jul 96; 25 Jul 96; 31 Jul 96; 01 Aug 96 +; draw/erase carat at the specified position +(gldefun editmenu-carat ((m editmenu)) + (let ((w (menuw m))) + (draw-carat w (menu-x m (+ 2 (* (column m) (font-width (menuw m))))) + (- (line-y m (line m)) 2)) + (force-output w) )) + +; 19 Jul 96; 25 Jul 96; 31 Jul 96; 01 Aug 96; 17 May 04 +; erase at the current position. onep = t to erase only one char +(gldefun editmenu-erase ((m editmenu) onep) + (let ((w (menuw m)) xw) + (xw = (+ 2 (* (font-width w) (column m)))) + (erase-area-xy w (menu-x m xw) + (- (line-y m (line m)) (cadr (string-extents w "Tg"))) + (if onep (font-width w) + (- (picture-width m) xw)) + (font-height w)) + (force-output w) )) + +; 01 Aug 96 +; Calculate the y position of the current line +(gldefun editmenu-line-y ((m editmenu) (line integer)) + (menu-y m (- (picture-height m) + (+ -1 (* (font-height (menuw m)) + (1+ (- line (scroll m))))))) ) + +; 25 Jul 96; 30 Jul 96; 31 Jul 96; 01 Aug 96; 13 Aug 96; 24 Sep 96; 08 Jan 97 +; 17 May 04 +(gldefun editmenu-select ((m editmenu) &optional inside) + (let (mw codeval res xval yval) + (mw = (menuw m)) + (if ~ (permanent m) (draw m)) + (track-mouse mw + #'(lambda (x y code) + (setq *window-menu-code* code) + (if (or (> code 0) + (x < (parent-offset-x m)) + (x > (+ (parent-offset-x m) (picture-width m))) + (y < (parent-offset-y m)) + (y > (+ (parent-offset-y m) (picture-height m)))) + (progn (codeval = code) + (xval = x) + (yval = y)) )) + t) +; (if (and (not (permanent m)) (not (flat m)) (close (menu-window m)))) ; ?? + (if (codeval > 0) + (editmenu-edit m codeval xval yval)) )) + +(defvar *window-editmenu-kill-strings* nil) + +; 13 Aug 96; 15 Aug 96 +; begin active editing of an editmenu. +; (code x y), if present, represent a mouse click in the window. +(gldefun editmenu-edit ((m editmenu) &optional code x y) + (let ((mw (menuw m))) + (draw m) + (carat m) + (if code (editmenu-edit-fn mw nil code x y (list m)) ) + (setq *window-editmenu-kill-strings* nil) + (window-get-chars mw #'editmenu-edit-fn (list m)) + (text m) )) + + +; 31 Dec 93; 18 Jul 96; 19 Jul 96; 22 Jul 96; 23 Jul 96; 25 Jul 96; 26 Jul 96 +; 30 Jul 96; 13 Aug 96; 14 Aug 96; 23 Dec 96; 17 May 04; 18 May 04 +; Process input characters and mouse clicks for editmenu eidting +(gldefun editmenu-edit-fn ((w window) char (button integer) (buttonx integer) + (buttony integer) args) + (let (m\:editmenu inside done) + (m = (car args)) + (carat m) ; erase carat + (if (and (numberp button) + (not (zerop button))) + (progn (inside = (editmenu-setxy m buttonx buttony)) + (case button + (1 (if inside + (progn (carat m) nil) ; return nil to continue input + t)) ; quit on click outside the editing area + (2 (if inside + (progn (editmenu-yank m) + (carat m) + nil)) ))) + (progn (if (< (char-code char) 32) + (case char of + (#\Return (if (numberp (scrollval m)) + (editmenu-return m) + (done = t)) ) + (#\Backspace (editmenu-backspace m)) + (#\^D (editmenu-delete m)) + (#\^N (if (numberp (scrollval m)) + (editmenu-next m))) + (#\^P (editmenu-previous m)) + (#\^F (editmenu-forward m)) + (#\^B (editmenu-backward m)) + (#\^A (editmenu-beginning m)) + (#\^E (editmenu-end m)) + (#\^K (editmenu-kill m)) + (#\^Y (editmenu-yank m)) + else nil) + (if (> (char-code char) 128) + (progn (setq char (code-char + (- (char-code char) 128))) + (case char of + (#\B (editmenu-meta-b m)) + (#\F (editmenu-meta-f m)) + else nil)) + (editmenu-char m char))) + (carat m) + done) ))) ; return nil to continue input + +; 31 Jul 96; 15 Aug 96; 17 May 04 +; Set cursor location based on mouse click; returns T if inside menu region +(gldefun editmenu-setxy ((m editmenu) (buttonx integer) (buttony integer)) + (let (linecons okay) + (setq okay + (and (>= buttonx (parent-offset-x m)) + (<= buttonx (+ (parent-offset-x m) (picture-width m))) + (>= buttony (parent-offset-y m)) + (<= buttony (+ (parent-offset-y m) (picture-height m))) )) + (if okay + (progn ((line m) = (min (1- (length (text m))) + (+ (scroll m) + (truncate (- (menu-y m (- (picture-height m) 6)) + buttony) + (font-height (menuw m)))))) + (linecons = (nthcdr (line m) (text m))) + ((column m) = (min (length (car linecons)) + (truncate (- buttonx (menu-x m 2)) + (font-width (menuw m))))) )) + okay)) + +; 19 Jul 96; 22 Jul 96; 25 Jul 96; 17 May 04 +; Process an ordinary input character +(gldefun editmenu-char ((m editmenu) char) + (let ((linecons (nthcdr (line m) (text m))) ) + (if (<= (length (car linecons)) (column m)) + ((car linecons) = ; insert char at end of line + (concatenate 'string (car linecons) (string char))) + ((car linecons) = ; insert char in middle of line + (concatenate 'string + (subseq (car linecons) 0 (column m)) + (string char) + (subseq (car linecons) (column m)))) ) + (display m (line m) (column m) t) + ((column m) _+ 1) )) + +; 23 Dec 96 +; Get the current character in an editment +(gldefun editmenu-current-char ((m editmenu)) + (let ((linecons (nthcdr (line m) (text m))) ) + (char (car linecons) (column m)) )) + +; 19 Jul 96; 22 Jul 96; 25 Jul 96; 17 May 04 +; Process a Return character +(gldefun editmenu-return ((m editmenu)) + (let ((linecons (nthcdr (line m) (text m)))) + (if (<= (length (car linecons)) (column m)) + ((cdr linecons) = (cons "" (cdr linecons))) ; end of line + (progn ((cdr linecons) = (cons (subseq (car linecons) (column m)) + (cdr linecons))) + ((car linecons) = (subseq (car linecons) 0 (column m))))) + (display m (line m) 0 nil) + ((line m) _+ 1) + ((column m) = 0) )) + +; 19 Jul 96; 22 Jul 96; 25 Jul 96; 30 Jul 96; 31 Jul 96; 17 May 04 +; Process a backspace +(gldefun editmenu-backspace ((m editmenu)) + (let (tmp linedel (linecons (nthcdr (line m) (text m)))) + (if (> (column m) 0) + (progn ((column m) _- 1) ; middle/end of line + ((car linecons) = + (concatenate 'string + (subseq (car linecons) 0 (column m)) + (subseq (car linecons) + (1+ (column m)))))) + (if (> (line m) 0) + (progn ((line m) _- 1) + (linedel = t) + (linecons = (nthcdr (line m) (text m))) + ((column m) = (length (car linecons))) + (tmp = (concatenate 'string (car linecons) + (cadr linecons))) + ((cdr linecons) = (cddr linecons)) + ((car linecons) = tmp) ) )) + (display m (line m) (column m) (not linedel)) )) + +; 23 Jul 96; 25 Jul 96 +; Move cursor to end of line: C-E +(gldefun editmenu-end ((m editmenu)) + (let ((linecons (nthcdr (line m) (text m))) ) + ((column m) = (length (car linecons))) )) + +; 23 Jul 96; 25 Jul 96 +; Move cursor to beginning of line: C-A +(gldefun editmenu-beginning ((m editmenu)) + ((column m) = 0)) + +; 22 Jul 96; 25 Jul 96; 14 Aug 96; 17 May 04 +; Move cursor forward: C-F +(gldefun editmenu-forward ((m editmenu)) + (let ((linecons (nthcdr (line m) (text m)))) + (if (< (column m) (length (car linecons))) + ((column m) _+ 1) + (if (numberp (scrollval m)) + (progn ((line m) _+ 1) + (if (null (cdr linecons)) + ((cdr linecons) = (list ""))) + ((column m) = 0)) ) ))) + +; 23 Dec 96; 17 May 04 +; Move cursor forward over a word: M-F +(gldefun editmenu-meta-f ((m editmenu)) + (let (found done) + (while (and (or (< (line m) (1- (length (text m)))) + (< (column m) (length (nth (line m) (text m))))) + (not found)) + (if (editmenu-alphanumbericp (editmenu-current-char m)) + (found = t) + (editmenu-forward m) ) ) + (if found + (while (and (or (< (line m) (1- (length (text m)))) + (< (column m) (length (nth (line m) (text m))))) + (not done)) + (if (editmenu-alphanumbericp (editmenu-current-char m)) + (editmenu-forward m) + (done = t) )) ) )) + +; 23 Dec 96 +; alphanumbericp not defined in gcl +(defun editmenu-alphanumbericp (x) + (or (alpha-char-p x) (not (null (digit-char-p x)))) ) + +; 22 Jul 96; 25 Jul 96 +; Move cursor to next line: C-N +(gldefun editmenu-next ((m editmenu)) + (let ((linecons (nthcdr (line m) (text m)))) + ((line m)_+ 1) + (if (null (cdr linecons)) + ((cdr linecons) = (list ""))) + (setq linecons (cdr linecons)) + ((column m) = (min (column m) (length (car linecons)))) )) + +; 22 Jul 96; 23 Jul 96; 25 Jul 96; 30 Jul 96; 17 May 04 +; Move cursor backward: C-B +(gldefun editmenu-backward ((m editmenu)) + (if (> (column m) 0) + ((column m) _- 1) + (if (> (line m) 0) + (progn ((line m) _- 1) + ((column m) = (length (nth (line m) (text m)))) ) ) )) + +; 23 Dec 96; 17 May 04 +; Move cursor backward over a word: M-B +(gldefun editmenu-meta-b ((m editmenu)) + (let (found done) + (while (and (or (> (column m) 0) (> (line m) 0)) + (not found)) + (editmenu-backward m) + (if (editmenu-alphanumbericp (editmenu-current-char m)) + (found = t))) + (if found + (progn (while (and (or (> (column m) 0) (> (line m) 0)) + (not done)) + (if (editmenu-alphanumbericp (editmenu-current-char m)) + (editmenu-backward m) + (done = t) )) + (unless (editmenu-alphanumbericp (editmenu-current-char m)) + (editmenu-forward m)) ) ))) + +; 22 Jul 96; 23 Jul 96; 25 Jul 96; 17 May 04 +; Move cursor to previous line: C-P +(gldefun editmenu-previous ((m editmenu)) + (if (> (line m) 0) + (progn ((line m) _- 1) + ((column m) = (min (column m) + (length (nth (line m) (text m)))))))) + +; 23 Jul 96; 25 Jul 96 +; Delete character ahead of cursor: C-D +(gldefun editmenu-delete ((m editmenu)) + (editmenu-forward m) + (editmenu-backspace m)) + +; 31 Jul 96; 17 May 04 +(gldefun editmenu-kill ((m editmenu)) + (let ((linecons (nthcdr (line m) (text m)))) + (if ((column m) < (length (car linecons))) + (progn (setq *window-editmenu-kill-strings* + (list (subseq (car linecons) (column m)))) + ((car linecons) = (subseq (car linecons) 0 (column m))) + (display m (line m) (column m) t)) + (editmenu-delete m) ) )) + +; 31 Jul 96; 01 Aug 96; 17 May 04 +(gldefun editmenu-yank ((m editmenu)) + (let ((linecons (nthcdr (line m) (text m))) (col (column m))) + (when *window-editmenu-kill-strings* + (if (<= (length (car linecons)) (column m)) + (progn ((car linecons) = ; insert at end of line + (concatenate 'string (car linecons) + (car *window-editmenu-kill-strings*))) + ((column m) = (length (car linecons)))) + (progn ((car linecons) = ; insert in middle of line + (concatenate 'string + (subseq (car linecons) 0 col) + (car *window-editmenu-kill-strings*) + (subseq (car linecons) col))) + ((column m) _+ (length (car *window-editmenu-kill-strings*))) )) + (display m (line m) col t) ) )) + +; 31 Dec 93; 19 Jul 96 +; Draw a carat symbol /\ centered at x and with top at y. +(defun window-draw-carat (w x y) + (window-set-xor w) + (window-draw-line-xy w (- x 5) (- y 2) x y) + (window-draw-line-xy w x y (+ x 5) (- y 2)) + (window-unset w) + (window-force-output w) ) + +; 31 Dec 93; 04 Oct 94; 15 Nov 94; 16 Nov 94; 14 Mar 95; 25 Jun 06 +; Initialize mapping between keys and ASCII. +(defun window-init-keymap () + (let (mincode maxcode keycode keysym keynum shiftkeynum char) + ; Get the min and max keycodes for this keyboard + (XDisplayKeycodes *window-display* *min-keycodes-return* + *max-keycodes-return*) + (setq mincode (int-pos *min-keycodes-return* 0)) + (setq maxcode (int-pos *max-keycodes-return* 0)) + (setq *window-keymap* (make-array (1+ maxcode) :initial-element nil)) + (setq *window-shiftkeymap* (make-array (1+ maxcode) :initial-element nil)) + (setq *window-shift-keys* nil) + (setq *window-control-keys* nil) + (setq *window-meta-keys* nil) + ; Get the ASCII corresponding to these keycodes + (dotimes (i (1+ (- maxcode mincode))) + (setq keycode (+ i mincode)) + (setq keysym (XGetKeyboardMapping *window-display* keycode 1 + *keycodes-return*)) + (setq keynum (fixnum-pos keysym 0)) ; ascii integer code + (setq shiftkeynum (fixnum-pos keysym 1)) + ; (XFree keysym) ; ***** commented out -- causes error on Sun + ; Following is a Kludge (TM) for Sun keyboard + (if (and (>= keynum 65) (<= keynum 90) (eql shiftkeynum NoSymbol)) + (progn (setq shiftkeynum keynum) + (setq keynum (+ keynum 32)))) + (if (> keynum 0) + (if (setq char (window-code-char keynum)) + (setf (aref *window-keymap* keycode) char) + (if (> keynum 256) + (cond ((or (eql keynum XK_Shift_R) (eql keynum XK_Shift_L)) + (push keycode *window-shift-keys*)) + ((or (eql keynum XK_Control_L) (eql keynum XK_Control_R)) + (push keycode *window-control-keys*)) + ((or (eql keynum XK_Alt_R) (eql keynum XK_Alt_L)) + (push keycode *window-meta-keys*)))))) + (if (> shiftkeynum 0) + (if (setq char (window-code-char shiftkeynum)) + (setf (aref *window-shiftkeymap* keycode) char) + )) ) + (setq *window-keyinit* t) )) ; signify initialization done + +; 15 Nov 94 +(defun window-code-char (code) + (if (> code 0) + (if (< code 256) + (code-char code) + (cond ((eql code XK_Return) #\Return) + ((eql code XK_Tab) #\Tab) + ((eql code XK_BackSpace) #\Backspace)) ) ) ) + +; 14 Dec 90; 12 Aug 91; 09 Oct 91; 09 Sep 92; 04 Aug 93; 06 Oct 94 +; Compile the dwindow file into a plain Lisp file +(defun compile-dwindow () + (glcompfiles *directory* + '("glisp/vector.lsp") ; auxiliary files + '("X/dwindow.lsp") ; translated files + "X/dwtrans.lsp" ; output file + "X/dwhead.lsp" ; header file + '(glfnresulttype glmacro glispobjects + glispconstants glispglobals compile-dwindow compile-dwindowb)) + (compile-file (concatenate 'string *directory* "X/dwtrans.lsp")) ) + +(defun compile-dwindowb () + (glcompfiles *directory* + '("glisp/vector.lsp") ; auxiliary files + '("X/dwindow.lsp") ; translated files + "X/dwtransb.lsp") ; output file + (compile-file (concatenate 'string *directory* "X/dwtransb.lsp")) ) + +; Note: when compiling dwtrans.lsp, be sure glmacros.lsp is loaded. diff --git a/xgcl-2/gcl_dwsyms.lsp b/xgcl-2/gcl_dwsyms.lsp new file mode 100644 index 0000000..dba3257 --- /dev/null +++ b/xgcl-2/gcl_dwsyms.lsp @@ -0,0 +1,148 @@ +; dwsyms.lsp Gordon S. Novak Jr. 14 Mar 95 + +; Copyright (c) 1995 Gordon S. Novak Jr. and The University of Texas at Austin. + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; This file imports symbols from the X library (in XLIB: package) +; to the current package (such as the :USER package). +; This will allow these symbols to be accessed by just their +; names and without any package qualifier. +; This file may be useful if you wish to modify dwindow.lsp or dwtrans.lsp . + +; This file should be loaded immediately after starting Lisp: +; If Lisp has seen any of these symbols, loading this file will cause an error. + +(import '( +xlib::BUTTONPRESS +xlib::BUTTONPRESSMASK +xlib::BUTTONRELEASEMASK +xlib::CAPBUTT +xlib::CWBACKINGSTORE +xlib::CWSAVEUNDER +xlib::EXPOSE +xlib::EXPOSUREMASK +xlib::GCBACKGROUND +xlib::GCFOREGROUND +xlib::GCFUNCTION +xlib::GET-C-STRING +xlib::GXCOPY +xlib::GXXOR +xlib::INT-ARRAY +xlib::INT-POS +xlib::ISUNMAPPED +xlib::JOINMITER +xlib::KEYPRESS +xlib::KEYPRESSMASK +xlib::KEYRELEASE +xlib::KEYRELEASEMASK +xlib::LEAVEWINDOWMASK +xlib::LINESOLID +xlib::MAKE-XCOLOR +xlib::MAKE-XEVENT +xlib::MAKE-XGCVALUES +xlib::MAKE-XSETWINDOWATTRIBUTES +xlib::MAKE-XSIZEHINTS +xlib::MAKE-XWINDOWATTRIBUTES +xlib::MOTIONNOTIFY +xlib::NONE +xlib::NoSymbol +xlib::POINTERMOTIONMASK +xlib::PPOSITION +xlib::PSIZE +xlib::SET-XCOLOR-BLUE +xlib::SET-XCOLOR-GREEN +xlib::SET-XCOLOR-RED +xlib::SET-XSETWINDOWATTRIBUTES-BACKING_STORE +xlib::SET-XSETWINDOWATTRIBUTES-SAVE_UNDER +xlib::SET-XSIZEHINTS-HEIGHT +xlib::SET-XSIZEHINTS-FLAGS +xlib::SET-XSIZEHINTS-WIDTH +xlib::SET-XSIZEHINTS-X +xlib::SET-XSIZEHINTS-Y +xlib::WHENMAPPED +xlib::XALLOCCOLOR +xlib::XANYEVENT-TYPE +xlib::XANYEVENT-WINDOW +xlib::XBLACKPIXEL +xlib::XBUTTONEVENT-BUTTON +xlib::XCHANGEWINDOWATTRIBUTES +xlib::XCLEARAREA +xlib::XCLEARWINDOW +xlib::XCOLOR-PIXEL +xlib::XCOPYAREA +xlib::XCREATEFONTCURSOR +xlib::XCREATEGC +xlib::XCREATESIMPLEWINDOW +xlib::XDEFAULTCOLORMAP +xlib::XDEFAULTGC +xlib::XDEFAULTSCREEN +xlib::XDEFINECURSOR +xlib::XDESTROYWINDOW +xlib::XDRAWARC +xlib::XDRAWIMAGESTRING +xlib::XDRAWLINE +xlib::XFILLRECTANGLE +xlib::XFONTSTRUCT-FID +xlib::XFLUSH +xlib::XFREECOLORS +xlib::XFREEGC +xlib::XGCVALUES-BACKGROUND +xlib::XGCVALUES-FOREGROUND +xlib::XGCVALUES-FUNCTION +xlib::XGETGCVALUES +xlib::XGETGEOMETRY +xlib::XGETWINDOWATTRIBUTES +xlib::XLOADQUERYFONT +xlib::XMAPWINDOW +xlib::XMOTIONEVENT-X +xlib::XMOTIONEVENT-Y +xlib::XMOVEWINDOW +xlib::XNEXTEVENT +xlib::XOPENDISPLAY +xlib::XPENDING +xlib::XQUERYPOINTER +xlib::XRECOLORCURSOR +xlib::XROOTWINDOW +xlib::XSELECTINPUT +xlib::XSETBACKGROUND +xlib::XSETFONT +xlib::XSETFOREGROUND +xlib::XSETFUNCTION +xlib::XSETLINEATTRIBUTES +xlib::XSETSTANDARDPROPERTIES +xlib::XSYNC +xlib::XTEXTEXTENTS +xlib::XTEXTWIDTH +xlib::XUNMAPWINDOW +xlib::XWHITEPIXEL +xlib::XWINDOWATTRIBUTES-MAP_STATE +xlib::XDisplayKeycodes +xlib::XGetKeyboardMapping +xlib::XFree +xlib::XK_Shift_R +xlib::XK_Shift_L +xlib::XK_Control_L +xlib::XK_Control_R +xlib::XK_Alt_R +xlib::XK_Alt_L +xlib::XK_Return +xlib::XK_Tab +xlib::XK_BackSpace +)) + +(setf (get 'xlib::int-pos 'glfnresulttype) 'integer) diff --git a/xgcl-2/gcl_dwtest.lsp b/xgcl-2/gcl_dwtest.lsp new file mode 100644 index 0000000..340961e --- /dev/null +++ b/xgcl-2/gcl_dwtest.lsp @@ -0,0 +1,192 @@ +; dwtest.lsp Gordon S. Novak Jr. 10 Jan 96 + +; Some examples for testing the window interface in dwindow.lsp / dwtrans.lsp + +; Copyright (c) 1996 Gordon S. Novak Jr. and The University of Texas at Austin. + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + +(use-package :xlib) +(defun user::xgcl-demo nil + (wtesta) + (wtestb) + (format t "Try (wtestc) ... (wtestk) for more examples.")) + +(defmacro while (test &rest forms) + `(loop (unless ,test (return)) ,@forms) ) + +(defvar *myw*) ; my window +(defvar myw) + +; Make a window to play in. +(defun wtesta () + (setq myw (setq *myw* (window-create 300 300 "test window"))) ) + +; 15 Aug 91; 12 Sep 91; 05 Oct 94; 06 Oct 94 +; Draw some basic things in the window +(defun wtestb () + (window-clear *myw*) + (window-draw-box-xy *myw* 50 50 50 20 1) + (window-printat *myw* "howdy" '(58 55)) + (window-draw-line *myw* '(100 70) '(200 170)) + (window-draw-arrow-xy *myw* 200 170 165 205) + (window-draw-circle-xy *myw* 200 170 50 2) + (window-draw-ellipse-xy *myw* 100 170 40 20 1) + (window-printat-xy *myw* "ellipse" 70 165) + (window-draw-arc-xy *myw* 100 250 20 20 0 90 1) + (window-draw-arc-xy *myw* 100 250 20 20 0 -90 1) + (window-printat-xy *myw* "arcs" 80 244) + (window-printat-xy *myw* "invert" 54 200) + (window-invert-area-xy *myw* 50 160 60 60) + (window-copy-area-xy *myw* 40 150 200 50 60 40) + (window-printat-xy *myw* "copy" 210 100) + (window-set-color-rgb *myw* 65535 0 0) ; red foreground + (window-printat-xy *myw* "Red" 20 20) + (window-draw-rcbox-xy *myw* 15 15 32 20 5) + (window-set-color-rgb *myw* 0 0 65535 t) ; blue background + (window-set-color-rgb *myw* 0 65535 0) ; green foreground + (window-printat-xy *myw* "Green" 120 20) + (window-set-color-rgb *myw* 0 65535 0 t) ; green background + (window-set-color-rgb *myw* 0 0 65535) ; blue foreground + (window-printat-xy *myw* "Blue" 220 20) + (window-reset-color *myw*) + (window-force-output *myw*) ) + +; 15 Aug 91; 19 Aug 91; 03 Sep 91; 21 Apr 95 +; Illustrate mouse interaction: +; click in window *myw* (2 times for line, 3 times for region). +(defun wtestc () + (let (mymenu result start done) + (setq mymenu (menu-create '(quit point line box region) "Choose One:")) + (while (not done) + (setq result + (case (menu-select mymenu) + (quit (setq done t)) + (point (window-get-point *myw*)) + (line (setq start (window-get-point *myw*)) + (list start + (window-get-line-position *myw* (car start) + (cadr start)))) + (box (window-get-box-position *myw* 40 20)) + (region (window-get-region *myw*)) )) + (format t "Result: ~A~%" result) ) + (menu-destroy mymenu) )) + +; 09 Sep 91 +; Illustrate icons in menus +(defun wtestd () + (menu '(("Triangle" . triangle) + (dwtest-square . square) + (dwtest-circle . circle) + hexagon) + "Icons in Menu") ) + +(defun dwtest-square (w x y) (window-draw-box-xy w x y 20 20 1)) +(setf (get 'dwtest-square 'display-size) '(20 20)) + +(defun dwtest-circle (w x y) (window-draw-circle-xy w (+ x 10) (+ y 10) 10 1)) +(setf (get 'dwtest-circle 'display-size) '(20 20)) + +(defvar mypms nil) +; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91 +; Illustrate a diagrammatic menu-like object: square with sensitive spots +(defun wteste () + (let (pm val) + (or mypms (mypms-init)) + (setq pm (picmenu-create-from-spec mypms "Points on Square")) + (setq val (picmenu-select pm)) + (picmenu-destroy pm) + val )) + +; 14 Sep 91 +(defun mypms-init () + (setq mypms (picmenu-create-spec + '((bottom-left ( 20 20)) + (center-left ( 20 70)) + (top-left ( 20 120)) + (bottom-center ( 70 20)) + (center ( 70 70) (20 20)) ; larger + (top-center ( 70 120)) + (bottom-right (120 20)) + (center-right (120 70)) + (top-right (120 120))) + 140 140 'wteste-draw-square t)) ) + +(defvar mypm nil) +; 10 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91; 17 Sep 91 +; A picmenu that is "flat" within another window, in this case *myw*. +; Must do (wtesta) first. +(defun wtestf () + (or mypms (mypms-init)) + (or mypm (setq mypm (picmenu-create-from-spec mypms "Points on Square" + *myw* 50 50 nil t t))) + (picmenu-select mypm)) + +(defun wteste-draw-square (w x y) + (window-draw-box-xy w (+ x 20) (+ y 20) 100 100 1)) + +(defvar mym nil) +; 10 Sep 91; 17 Sep 91 +; A menu that is "flat" within another window, in this case *myw*. +; Must do (wtesta) first. +(defun wtestg () + (or mym (setq mym (menu-create '(red white blue) "Flag" *myw* 50 50 nil t))) + (menu-select mym)) + +; 09 Oct 91 +; Demonstrate arrows. Optional arg is line width. +(defun wtesth ( &optional (lw 1)) + (window-clear *myw*) + (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 160 lw)) + (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 40 lw)) + (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 40 (+ 40 (* i 30)) lw)) + (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 160 (+ 40 (* i 30)) lw)) + (dotimes (i 5) (window-draw-arrow-xy *myw* 200 (+ 40 (* i 30)) + 240 (+ 40 (* i 30)) + (1+ i) )) + (window-force-output *myw*) ) + +; 04 Jan 94 +; Redo some of the arrows from wtesth in color +(defun wtesti () + (window-set-color-rgb *myw* 65535 0 0) + (window-draw-arrow-xy *myw* 200 70 240 70 2) + (window-set-color-rgb *myw* 0 65535 0) + (window-draw-arrow-xy *myw* 200 100 240 100 3) + (window-set-color-rgb *myw* 0 0 65535) + (window-draw-arrow-xy *myw* 200 130 240 130 4) + (window-reset-color *myw*) + (window-force-output *myw*) ) + +; 04 Jan 94 +; Get text from a window. Move mouse pointer into test window. +; Add characters and/or backspace, Return. +; Note: it might be necessary to change the keyboard mapping, using +; (window-init-keyboard-mapping *myw*) and (window-print-keyboard-mapping) +(defun wtestj () (window-input-string *myw* "Foo" 50 200 200)) + +; 04 Jan 94 +; Change foreground and background colors and input a string +(defun wtestk () + (window-set-color-rgb *myw* 0 65535 0) ; green foreground + (window-set-color-rgb *myw* 0 0 65535 t) ; blue background + (prog1 (window-input-string *myw* "Foo" 50 200 200) + (window-reset-color *myw*) + (window-force-output *myw*) ) ) diff --git a/xgcl-2/gcl_dwtestcases.lsp b/xgcl-2/gcl_dwtestcases.lsp new file mode 100644 index 0000000..ca2cc1a --- /dev/null +++ b/xgcl-2/gcl_dwtestcases.lsp @@ -0,0 +1,32 @@ +(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtrans.lsp") +(use-package 'xlib) +(load "/stage/ftp/pub/novak/xgcl-4/gcl_drawtrans.lsp") +(load "/stage/ftp/pub/novak/xgcl-4/gcl_editorstrans.lsp") +(load "/stage/ftp/pub/novak/xgcl-4/gcl_lispservertrans.lsp") +(load "/stage/ftp/pub/novak/xgcl-4/gcl_menu-settrans.lsp") +(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtest.lsp") +(load "/stage/ftp/pub/novak/xgcl-4/gcl_draw-gates.lsp") + +(wtesta) +(wtestb) +(wtestc) +(wtestd) +(wteste) +(wtestf) +(wtestg) +(wtesth) +(wtesti) +(wtestj) +(wtestk) + +(window-clear myw) +(edit-color myw) + +(lisp-server) + +(draw 'foo) + +(window-draw-box-xy myw 48 48 204 204) +(window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) + +(draw-nand myw 50 50) diff --git a/xgcl-2/gcl_dwtrans.lsp b/xgcl-2/gcl_dwtrans.lsp new file mode 100644 index 0000000..1e96ca4 --- /dev/null +++ b/xgcl-2/gcl_dwtrans.lsp @@ -0,0 +1,2894 @@ +; 13 Jan 2010 17:40:33 EST +; dwtrans.lsp -- translation of dwindow.lsp ; 07 Jan 10 + +; Copyright (c) 2010 Gordon S. Novak Jr. and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + + +(in-package :xlib) + +(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms) ) + +(setf (get 'xlib::int-pos 'user::glfnresulttype) 'lisp::integer) +(setf (get 'xlib::fixnum-pos 'user::glfnresulttype) 'lisp::integer) + +; exported symbols: from dwimports.lsp +(dolist (x '( menu stringify window picmenu textmenu editmenu barmenu + display-size + window-get-mouse-position window-create window-set-font + window-font-info window-gcontext window-parent + window-drawable-height window-drawable-width window-label + window-font window-foreground window-set-foreground + window-background window-set-background window-wfunction + window-get-geometry window-get-geometry-b window-sync + window-screen-height window-geometry window-size + window-left window-top-neg-y window-reset-geometry + window-force-output window-query-pointer window-set-xor + window-unset window-reset window-set-erase + window-set-copy window-set-invert window-set-line-width + window-set-line-attr window-std-line-attr window-draw-line + window-draw-line-xy window-draw-arrowhead-xy + window-draw-arrow-xy window-draw-arrow2-xy window-draw-box + window-draw-box-xy window-xor-box-xy window-draw-box-corners + window-draw-rcbox-xy window-draw-arc-xy + window-draw-circle-xy window-draw-circle window-erase-area + window-erase-area-xy window-erase-box-xy + window-draw-ellipse-xy window-copy-area-xy window-invertarea + window-invert-area window-invert-area-xy + window-prettyprintat window-prettyprintat-xy window-printat + window-printat-xy window-string-width window-string-height + window-string-extents window-font-string-width + window-yposition window-centeroffset dowindowcom + window-menu window-close window-unmap window-open + window-map window-destroy window-destroy-selected-window + window-clear window-moveto-xy window-paint + window-move window-draw-border window-track-mouse + window-wait-exposure window-wait-unmap + window-init-mouse-poll window-poll-mouse menu-init + menu-calculate-size menu-adjust-offset menu-draw + menu-item-value menu-find-item-width menu-find-item-height + menu-clear menu-display-item menu-choose menu-box-item + menu-unbox-item menu-item-position menu-select + menu-select! menu-select-b menu-destroy + menu-create menu-offset menu-size menu-moveto-xy + menu-reposition picmenu-create picmenu-create-spec + picmenu-create-from-spec picmenu-calculate-size picmenu-init + picmenu-draw picmenu-draw-button picmenu-delete-named-button + picmenu-select picmenu-box-item picmenu-unbox-item + picmenu-destroy picmenu-button-containsxy? + picmenu-item-position barmenu-create + barmenu-calculate-size barmenu-init barmenu-draw + barmenu-select barmenu-update-value window-get-point + window-get-click window-get-line-position + window-get-latex-position window-get-box-position + window-get-icon-position window-get-region + window-get-box-size window-track-mouse-in-region + window-adjust-box-side window-adj-box-xy window-get-circle + window-circle-radius window-draw-circle-pt + window-get-ellipse window-draw-ellipse-pt + window-draw-vector-pt window-get-vector-end + window-get-crosshairs window-draw-crosshairs-xy + window-get-cross window-draw-cross-xy window-draw-dot-xy + window-draw-latex-xy window-reset-color + window-set-color-rgb window-set-xcolor window-set-color + window-set-color window-free-color window-get-chars + window-process-char-event window-input-string + window-input-char-fn window-draw-carat window-init-keymap + window-set-cursor window-positive-y window-code-char + window-get-raw-char + window-print-line window-print-lines textmenu-create + textmenu-calculate-size textmenu-init textmenu-draw + textmenu-select textmenu-set-text textmenu + editmenu editmenu-create editmenu-calculate-size + editmenu-init editmenu-draw editmenu-display + window-edit + window-edit-display editmenu-carat editmenu-erase + window-edit-erase editmenu-select editmenu-edit-fn + window-edit-fn editmenu-setxy editmenu-char + editmenu-edit + *window-editmenu-kill-strings* +*window-add-menu-title* +*window-menu* +*mouse-x* +*mouse-y* +*mouse-window* +*window-fonts* +*window-display* +*window-screen* +*root-window* +*black-pixel* +*white-pixel* +*default-fg-color* +*default-bg-color* +*default-size-hints* +*default-GC* +*default-colormap* +*window-event* +*window-default-pos-x* +*window-default-pos-y* +*window-default-border* +*window-default-font-name* +*window-default-cursor* +*window-save-foreground* +*window-save-function* +*window-attributes* +*window-attr* +*menu-title-pad* +*root-return* +*child-return* +*root-x-return* +*root-y-return* +*win-x-return* +*win-y-return* +*mask-return* +*x-return* +*y-return* +*width-return* +*height-return* +*depth-return* +*border-width-return* +*text-width-return* +*direction-return* +*ascent-return* +*descent-return* +*overall-return* +*GC-Values* +*window-xcolor* +*window-menu-code* + +*window-keymap* +*window-shiftkeymap* +*window-keyinit* +*window-meta* +*window-ctrl* +*window-shift* +*window-string* +*window-string-count* +*window-string-max* +*window-input-string-x* +*window-input-string-y* +*window-input-string-charwidth* + +*window-shift-keys* +*window-control-keys* +*window-meta-keys* +*barmenu-update-value-cons* +*picmenu-no-selection* +*min-keycodes-return* +*max-keycodes-return* +*keycodes-return* + )) + (export x)) ; export the above symbols + +(DEFVAR *WINDOW-ADD-MENU-TITLE* NIL) + +(DEFVAR *WINDOW-MENU* NIL) + +(DEFVAR *MOUSE-X* NIL) + +(DEFVAR *MOUSE-Y* NIL) + +(DEFVAR *MOUSE-WINDOW* NIL) + +(DEFVAR *WINDOW-FONTS* + (LIST (LIST 'COURIER-BOLD-12 + "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1") + (LIST 'COURIER-MEDIUM-12 + "*-*-courier-medium-r-*-*-12-*-*-*-*-*-iso8859-1") + (LIST '6X12 "6x12") (LIST '8X13 "8x13") + (LIST '9X15 "9x15"))) + + + +(DEFVAR *WINDOW-DISPLAY* NIL) + +(DEFVAR *WINDOW-SCREEN* NIL) + +(DEFVAR *ROOT-WINDOW*) + +(DEFVAR *BLACK-PIXEL*) + +(DEFVAR *WHITE-PIXEL*) + +(DEFVAR *DEFAULT-FG-COLOR*) + +(DEFVAR *DEFAULT-BG-COLOR*) + +(DEFVAR *DEFAULT-SIZE-HINTS*) + +(DEFVAR *DEFAULT-GC*) + +(DEFVAR *DEFAULT-COLORMAP*) + +(DEFVAR *WINDOW-EVENT*) + +(DEFVAR *WINDOW-DEFAULT-POS-X* 10) + +(DEFVAR *WINDOW-DEFAULT-POS-Y* 20) + +(DEFVAR *WINDOW-DEFAULT-BORDER* 1) + +(DEFVAR *WINDOW-DEFAULT-FONT-NAME* 'COURIER-BOLD-12) + +(DEFVAR *WINDOW-DEFAULT-CURSOR* 68) + +(DEFVAR *WINDOW-SAVE-FOREGROUND*) + +(DEFVAR *WINDOW-SAVE-FUNCTION*) + +(DEFVAR *WINDOW-ATTRIBUTES*) + +(DEFVAR *WINDOW-ATTR*) + +(DEFVAR *MENU-TITLE-PAD* 30) + +(DEFVAR *ROOT-RETURN* (FIXNUM-ARRAY 1)) + +(DEFVAR *CHILD-RETURN* (FIXNUM-ARRAY 1)) + +(DEFVAR *ROOT-X-RETURN* (INT-ARRAY 1)) + +(DEFVAR *ROOT-Y-RETURN* (INT-ARRAY 1)) + +(DEFVAR *WIN-X-RETURN* (INT-ARRAY 1)) + +(DEFVAR *WIN-Y-RETURN* (INT-ARRAY 1)) + +(DEFVAR *MASK-RETURN* (INT-ARRAY 1)) + +(DEFVAR *X-RETURN* (INT-ARRAY 1)) + +(DEFVAR *Y-RETURN* (INT-ARRAY 1)) + +(DEFVAR *WIDTH-RETURN* (INT-ARRAY 1)) + +(DEFVAR *HEIGHT-RETURN* (INT-ARRAY 1)) + +(DEFVAR *DEPTH-RETURN* (INT-ARRAY 1)) + +(DEFVAR *BORDER-WIDTH-RETURN* (INT-ARRAY 1)) + +(DEFVAR *TEXT-WIDTH-RETURN* (INT-ARRAY 1)) + +(DEFVAR *DIRECTION-RETURN* (INT-ARRAY 1)) + +(DEFVAR *ASCENT-RETURN* (INT-ARRAY 1)) + +(DEFVAR *DESCENT-RETURN* (INT-ARRAY 1)) + +(DEFVAR *OVERALL-RETURN* (INT-ARRAY 1)) + +(DEFVAR *GC-VALUES*) + +(DEFVAR *WINDOW-XCOLOR* NIL) + +(DEFVAR *WINDOW-MENU-CODE* NIL) + +(DEFVAR *WINDOW-KEYMAP* (MAKE-ARRAY 256)) + +(DEFVAR *WINDOW-SHIFTKEYMAP* (MAKE-ARRAY 256)) + +(DEFVAR *WINDOW-KEYINIT* NIL) + +(DEFVAR *WINDOW-META*) + +(DEFVAR *WINDOW-CTRL*) + +(DEFVAR *WINDOW-SHIFT*) + +(DEFVAR *WINDOW-SHIFT-KEYS* NIL) + +(DEFVAR *WINDOW-CONTROL-KEYS* NIL) + +(DEFVAR *WINDOW-META-KEYS* NIL) + +(DEFVAR *MIN-KEYCODES-RETURN* (INT-ARRAY 1)) + +(DEFVAR *MAX-KEYCODES-RETURN* (INT-ARRAY 1)) + +(DEFVAR *KEYCODES-RETURN* (INT-ARRAY 1)) + +(SETQ *WINDOW-KEYINIT* NIL) + +(DEFMACRO PICMENU-SPEC (SYMBOL) (LIST 'GET SYMBOL ''PICMENU-SPEC)) + + + + + +(DEFVAR *PICMENU-NO-SELECTION* '(NO-SELECTION (0 0) (0 0) NIL NIL)) + +(DEFUN STRINGIFY (X) + (COND + ((STRINGP X) X) + ((SYMBOLP X) (COPY-SEQ (SYMBOL-NAME X))) + (T (PRINC-TO-STRING X)))) + +(DEFUN WINDOW-XINIT () + (SETQ *WINDOW-DISPLAY* (XOPENDISPLAY (GET-C-STRING ""))) + (IF (OR (NOT (NUMBERP *WINDOW-DISPLAY*)) (< *WINDOW-DISPLAY* 10000)) + (ERROR "DISPLAY did not open: return value ~A~%" + *WINDOW-DISPLAY*)) + (SETQ *WINDOW-SCREEN* (XDEFAULTSCREEN *WINDOW-DISPLAY*)) + (SETQ *ROOT-WINDOW* (XROOTWINDOW *WINDOW-DISPLAY* *WINDOW-SCREEN*)) + (SETQ *BLACK-PIXEL* (XBLACKPIXEL *WINDOW-DISPLAY* *WINDOW-SCREEN*)) + (SETQ *WHITE-PIXEL* (XWHITEPIXEL *WINDOW-DISPLAY* *WINDOW-SCREEN*)) + (SETQ *DEFAULT-FG-COLOR* *BLACK-PIXEL*) + (SETQ *DEFAULT-BG-COLOR* *WHITE-PIXEL*) + (SETQ *DEFAULT-GC* (XDEFAULTGC *WINDOW-DISPLAY* *WINDOW-SCREEN*)) + (SETQ *DEFAULT-COLORMAP* + (XDEFAULTCOLORMAP *WINDOW-DISPLAY* *WINDOW-SCREEN*)) + (SETQ *WINDOW-ATTRIBUTES* (MAKE-XSETWINDOWATTRIBUTES)) + (SET-XSETWINDOWATTRIBUTES-BACKING_STORE *WINDOW-ATTRIBUTES* + WHENMAPPED) + (SET-XSETWINDOWATTRIBUTES-SAVE_UNDER *WINDOW-ATTRIBUTES* 1) + (SETQ *WINDOW-ATTR* (MAKE-XWINDOWATTRIBUTES)) + (XFLUSH *WINDOW-DISPLAY*) + (SETQ *DEFAULT-SIZE-HINTS* (MAKE-XSIZEHINTS)) + (SETQ *WINDOW-EVENT* (MAKE-XEVENT)) + (SETQ *GC-VALUES* (MAKE-XGCVALUES))) + +(DEFUN WINDOW-GET-MOUSE-POSITION () + (XQUERYPOINTER *WINDOW-DISPLAY* *ROOT-WINDOW* *ROOT-RETURN* + *CHILD-RETURN* *ROOT-X-RETURN* *ROOT-Y-RETURN* *WIN-X-RETURN* + *WIN-Y-RETURN* *MASK-RETURN*) + (SETQ *MOUSE-X* (INT-POS *ROOT-X-RETURN* 0)) + (SETQ *MOUSE-Y* (INT-POS *ROOT-Y-RETURN* 0)) + (SETQ *MOUSE-WINDOW* (FIXNUM-POS *CHILD-RETURN* 0))) + + + +(DEFUN WINDOW-CREATE + (WIDTH HEIGHT &OPTIONAL STR PARENTW POS-X POS-Y FONT) + (LET (W PW FG-COLOR BG-COLOR) + (OR *WINDOW-DISPLAY* (WINDOW-XINIT)) + (SETQ FG-COLOR *DEFAULT-FG-COLOR*) + (SETQ BG-COLOR *DEFAULT-BG-COLOR*) + (UNLESS POS-X (SETQ POS-X *WINDOW-DEFAULT-POS-X*)) + (UNLESS POS-Y (SETQ POS-Y *WINDOW-DEFAULT-POS-Y*)) + (SETQ W + (LIST 'WINDOW NIL NIL HEIGHT WIDTH + (IF STR (STRINGIFY STR) " ") NIL)) + (SETQ PW (OR PARENTW *ROOT-WINDOW*)) + (WINDOW-GET-GEOMETRY-B PW) + (SETF (CADR W) + (XCREATESIMPLEWINDOW *WINDOW-DISPLAY* PW POS-X + (- (- (INT-POS *HEIGHT-RETURN* 0) POS-Y) HEIGHT) WIDTH + HEIGHT *WINDOW-DEFAULT-BORDER* FG-COLOR BG-COLOR)) + (SET-XSIZEHINTS-X *DEFAULT-SIZE-HINTS* POS-X) + (SET-XSIZEHINTS-Y *DEFAULT-SIZE-HINTS* POS-Y) + (SET-XSIZEHINTS-WIDTH *DEFAULT-SIZE-HINTS* (FIFTH W)) + (SET-XSIZEHINTS-HEIGHT *DEFAULT-SIZE-HINTS* (CADDDR W)) + (SET-XSIZEHINTS-FLAGS *DEFAULT-SIZE-HINTS* 12) + (XSETSTANDARDPROPERTIES *WINDOW-DISPLAY* (CADR W) + (GET-C-STRING (SIXTH W)) (GET-C-STRING (SIXTH W)) 0 0 0 + *DEFAULT-SIZE-HINTS*) + (SETF (CADDR W) (XCREATEGC *WINDOW-DISPLAY* (CADR W) 0 0)) + (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) FG-COLOR) + (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) BG-COLOR) + (WINDOW-SET-FONT W (OR FONT *WINDOW-DEFAULT-FONT-NAME*)) + (LET (C) + (SETQ C + (XCREATEFONTCURSOR *WINDOW-DISPLAY* + *WINDOW-DEFAULT-CURSOR*)) + (XDEFINECURSOR *WINDOW-DISPLAY* (CADR W) C)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0) + (XCHANGEWINDOWATTRIBUTES *WINDOW-DISPLAY* (CADR W) 1088 + *WINDOW-ATTRIBUTES*) + (XSELECTINPUT *WINDOW-DISPLAY* (CADR W) 32876) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE W) + W)) + +(DEFUN WINDOW-SET-FONT (W FONTSYMBOL) + (LET (FONTSTRING FONT-INFO) + (SETQ FONTSTRING + (OR (CADR (ASSOC FONTSYMBOL *WINDOW-FONTS*)) + (STRINGIFY FONTSYMBOL))) + (SETQ FONT-INFO + (XLOADQUERYFONT *WINDOW-DISPLAY* (GET-C-STRING FONTSTRING))) + (IF (ZEROP FONT-INFO) + (FORMAT T "~%can't open font ~a ~a~%" FONTSYMBOL FONTSTRING) + (PROGN + (XSETFONT *WINDOW-DISPLAY* (CADDR W) + (XFONTSTRUCT-FID FONT-INFO)) + (SETF (SEVENTH W) FONT-INFO))))) + +(DEFUN WINDOW-FONT-INFO (FONTSYMBOL) + (XLOADQUERYFONT *WINDOW-DISPLAY* + (GET-C-STRING + (OR (CADR (ASSOC FONTSYMBOL *WINDOW-FONTS*)) + (STRINGIFY FONTSYMBOL))))) + +(DEFUN WINDOW-GCONTEXT (W) (CADDR W)) + +(DEFUN WINDOW-PARENT (W) (CADR W)) + +(DEFUN WINDOW-DRAWABLE-HEIGHT (W) (CADDDR W)) + +(DEFUN WINDOW-DRAWABLE-WIDTH (W) (FIFTH W)) + +(DEFUN WINDOW-LABEL (W) (SIXTH W)) + +(DEFUN WINDOW-FONT (W) (SEVENTH W)) + +(DEFUN WINDOW-FOREGROUND (W) + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*)) + +(DEFUN WINDOW-SET-FOREGROUND (W FG-COLOR) + (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) FG-COLOR)) + +(DEFUN WINDOW-BACKGROUND (W) + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*)) + +(DEFUN WINDOW-SET-BACKGROUND (W BG-COLOR) + (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) BG-COLOR)) + +(DEFUN WINDOW-WFUNCTION (W) + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*)) + +(DEFUN WINDOW-GET-GEOMETRY (W) (WINDOW-GET-GEOMETRY-B (CADR W))) + +(DEFUN WINDOW-SET-CURSOR (W N) + (LET (C) + (SETQ C (XCREATEFONTCURSOR *WINDOW-DISPLAY* N)) + (XDEFINECURSOR *WINDOW-DISPLAY* (CADR W) C))) + +(DEFUN WINDOW-GET-GEOMETRY-B (W) + (XGETGEOMETRY *WINDOW-DISPLAY* W *ROOT-RETURN* *X-RETURN* *Y-RETURN* + *WIDTH-RETURN* *HEIGHT-RETURN* *BORDER-WIDTH-RETURN* + *DEPTH-RETURN*)) + +(DEFUN WINDOW-SYNC (W) (declare (ignore w)) (XSYNC *WINDOW-DISPLAY* 1)) + +(DEFUN WINDOW-SCREEN-HEIGHT () + (WINDOW-GET-GEOMETRY-B *ROOT-WINDOW*) + (INT-POS *HEIGHT-RETURN* 0)) + +(DEFUN WINDOW-GEOMETRY (W) + (LET (SH) + (SETQ SH (WINDOW-SCREEN-HEIGHT)) + (WINDOW-GET-GEOMETRY-B (CADR W)) + (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) + (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0)) + (LIST (INT-POS *X-RETURN* 0) + (- (- SH (INT-POS *Y-RETURN* 0)) (INT-POS *HEIGHT-RETURN* 0)) + (INT-POS *WIDTH-RETURN* 0) (INT-POS *HEIGHT-RETURN* 0) + (INT-POS *BORDER-WIDTH-RETURN* 0)))) + +(DEFUN WINDOW-SIZE (W) + (WINDOW-GET-GEOMETRY-B (CADR W)) + (LIST (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) + (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0)))) + +(DEFUN WINDOW-LEFT (W) + (WINDOW-GET-GEOMETRY-B (CADR W)) + (INT-POS *X-RETURN* 0)) + +(DEFUN WINDOW-TOP-NEG-Y (W) + (WINDOW-GET-GEOMETRY-B (CADR W)) + (INT-POS *Y-RETURN* 0)) + +(DEFUN WINDOW-RESET-GEOMETRY (W) + (WINDOW-GET-GEOMETRY-B (CADR W)) + (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) + (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0))) + +(DEFUN WINDOW-FORCE-OUTPUT (&OPTIONAL W) (declare (ignore w)) (XFLUSH *WINDOW-DISPLAY*)) + +(DEFUN WINDOW-QUERY-POINTER (W) (WINDOW-QUERY-POINTER-B (CADR W))) + +(DEFUN WINDOW-QUERY-POINTER-B (W) + (XQUERYPOINTER *WINDOW-DISPLAY* W *ROOT-RETURN* *CHILD-RETURN* + *ROOT-X-RETURN* *ROOT-Y-RETURN* *WIN-X-RETURN* *WIN-Y-RETURN* + *MASK-RETURN*)) + +(DEFUN WINDOW-POSITIVE-Y (W Y) (- (CADDDR W) Y)) + +(DEFUN WINDOW-SET-XOR (W) + (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*)))))) + +(DEFUN WINDOW-UNSET (W) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) + +(DEFUN WINDOW-RESET (W) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 3) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *DEFAULT-FG-COLOR*) + (XSETBACKGROUND *WINDOW-DISPLAY* GC *DEFAULT-BG-COLOR*))) + +(DEFUN WINDOW-SET-ERASE (W) + (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 3) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + +(DEFUN WINDOW-SET-COPY (W) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* (CADDR W) 3) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*)))) + +(DEFUN WINDOW-SET-INVERT (W) + (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*)))))) + +(DEFUN WINDOW-SET-LINE-WIDTH (W WIDTH) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR WIDTH 1) 0 1 0)) + +(DEFUN WINDOW-SET-LINE-ATTR + (W WIDTH &OPTIONAL LINE-STYLE CAP-STYLE JOIN-STYLE) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR WIDTH 1) + (OR LINE-STYLE 0) (OR CAP-STYLE 1) (OR JOIN-STYLE 0))) + +(DEFUN WINDOW-STD-LINE-ATTR (W) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) + +(DEFUN WINDOW-DRAW-LINE (W FROM TO &OPTIONAL LINEWIDTH) + (WINDOW-DRAW-LINE-XY W (CAR FROM) (CADR FROM) (CAR TO) (CADR TO) + LINEWIDTH)) + +(DEFUN WINDOW-DRAW-LINE-XY + (W FROMX FROMY TOX TOY &OPTIONAL LINEWIDTH OPERATION) + (LET ((QQWHEIGHT (CADDDR W))) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) + 0 1 0)) + (CASE OPERATION + (XOR (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*)))))) + (ERASE (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 3) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (T)) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) FROMX + (- QQWHEIGHT FROMY) TOX (- QQWHEIGHT TOY)) + (CASE OPERATION + ((XOR ERASE) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) + (T)) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) + +(DEFUN WINDOW-DRAW-ARROWHEAD-XY + (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) + (LET (TH THETA YSTH YCTH (Y2DELA 0) (Y2DELB 0) (X2DELA 0) (X2DELB 0)) + (OR SIZE (SETQ SIZE (+ 20 (* LINEWIDTH 5)))) + (SETQ TH (ATAN (- Y2 Y1) (- X2 X1))) + (SETQ THETA (* TH (/ 180.0 PI))) + (SETQ YSTH (ROUND (* (1+ SIZE) (SIN TH)))) + (SETQ YCTH (ROUND (* (1+ SIZE) (COS TH)))) + (IF (AND (EQL Y1 Y2) (EVENP LINEWIDTH)) + (IF (> X2 X1) (SETQ Y2DELB 1) (SETQ Y2DELA 1))) + (IF (AND (EQL X1 X2) (EVENP LINEWIDTH)) + (IF (> Y2 Y1) (SETQ X2DELB 1) (SETQ X2DELA 1))) + (WINDOW-DRAW-ARC-XY W (- (- X2 YSTH) X2DELA) (+ (+ Y2 YCTH) Y2DELA) + SIZE SIZE (+ 240 THETA) 30 LINEWIDTH) + (WINDOW-DRAW-ARC-XY W (- (+ X2 YSTH) X2DELB) (+ (- Y2 YCTH) Y2DELB) + SIZE SIZE (+ 90 THETA) 30 LINEWIDTH))) + +(DEFUN WINDOW-DRAW-ARROW-XY + (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) + (WINDOW-DRAW-LINE-XY W X1 Y1 X2 Y2 LINEWIDTH) + (WINDOW-DRAW-ARROWHEAD-XY W X1 Y1 X2 Y2 LINEWIDTH SIZE)) + +(DEFUN WINDOW-DRAW-ARROW2-XY + (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) + (WINDOW-DRAW-LINE-XY W X1 Y1 X2 Y2 LINEWIDTH) + (WINDOW-DRAW-ARROWHEAD-XY W X1 Y1 X2 Y2 LINEWIDTH SIZE) + (WINDOW-DRAW-ARROWHEAD-XY W X2 Y2 X1 Y1 LINEWIDTH SIZE)) + +(DEFUN WINDOW-DRAW-BOX (W OFFSET SIZE &OPTIONAL LINEWIDTH) + (WINDOW-DRAW-BOX-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) + (CADR SIZE) LINEWIDTH)) + +(DEFUN WINDOW-DRAW-BOX-XY + (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL LINEWIDTH) + (LET ((QQWHEIGHT (CADDDR W)) LW LW2 LW2B (PW (CADR W)) + (GC (CADDR W))) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) + 0 1 0)) + (SETQ LW (OR LINEWIDTH 1)) + (SETQ LW2 (TRUNCATE LW 2)) + (SETQ LW2B (TRUNCATE (1+ LW) 2)) + (XDRAWLINE *WINDOW-DISPLAY* PW GC (- OFFSETX LW2) + (- QQWHEIGHT OFFSETY) (- (+ OFFSETX SIZEX) LW2) + (- QQWHEIGHT OFFSETY)) + (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX SIZEX) + (- QQWHEIGHT (- OFFSETY LW2B)) (+ OFFSETX SIZEX) + (- QQWHEIGHT (+ SIZEY (- OFFSETY LW2B)))) + (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX SIZEX LW2B) + (- QQWHEIGHT (+ OFFSETY SIZEY)) (+ OFFSETX LW2B) + (- QQWHEIGHT (+ OFFSETY SIZEY))) + (XDRAWLINE *WINDOW-DISPLAY* PW GC OFFSETX + (- QQWHEIGHT (+ OFFSETY SIZEY LW2)) OFFSETX + (- QQWHEIGHT (+ OFFSETY LW2))) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) + +(DEFUN WINDOW-XOR-BOX-XY + (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL LINEWIDTH) + (WINDOW-SET-XOR W) + (WINDOW-DRAW-BOX-XY W OFFSETX OFFSETY SIZEX SIZEY LINEWIDTH) + (WINDOW-UNSET W)) + +(DEFUN WINDOW-DRAW-BOX-CORNERS (W XA YA XB YB &OPTIONAL LW) + (WINDOW-DRAW-BOX-XY W (MIN XA XB) (MIN YA YB) (ABS (- XA XB)) + (ABS (- YA YB)) LW)) + +(DEFUN WINDOW-DRAW-RCBOX-XY + (W X Y WIDTH HEIGHT RADIUS &OPTIONAL LINEWIDTH) + (LET (X1 X2 Y1 Y2 R LW2 LW2B FUDGE) + (SETQ R + (MAX 0 + (MIN RADIUS (TRUNCATE (ABS WIDTH) 2) + (TRUNCATE (ABS HEIGHT) 2)))) + (IF (NOT (NUMBERP LINEWIDTH)) (SETQ LINEWIDTH 1)) + (SETQ LW2 (TRUNCATE LINEWIDTH 2)) + (SETQ LW2B (TRUNCATE (1+ LINEWIDTH) 2)) + (SETQ FUDGE (IF (ODDP LINEWIDTH) 0 1)) + (SETQ X1 (+ X R)) + (SETQ X2 (- (+ X WIDTH) R)) + (SETQ Y1 (+ Y R)) + (SETQ Y2 (- (+ Y HEIGHT) R)) + (LET ((QQWHEIGHT (CADDDR W))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) + (OR LINEWIDTH 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (1- X1) LW2) + (- QQWHEIGHT Y) X2 (- QQWHEIGHT Y)) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) + (LET ((QQWHEIGHT (CADDDR W))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) + (OR LINEWIDTH 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ X WIDTH) + (- QQWHEIGHT (- Y1 LW2B)) (+ X WIDTH) (- QQWHEIGHT (1+ Y2))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) + (LET ((QQWHEIGHT (CADDDR W))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) + (OR LINEWIDTH 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (1- X1) + (- QQWHEIGHT (+ Y HEIGHT)) (+ X2 LW2) + (- QQWHEIGHT (+ Y HEIGHT))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) + (LET ((QQWHEIGHT (CADDDR W))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) + (OR LINEWIDTH 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) X (- QQWHEIGHT Y1) + X (- QQWHEIGHT (1+ Y2))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) + 0 1 0)) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (- X1 FUDGE) R) + (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 11520 5760) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) + 0 1 0)) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X2 R) + (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 17280 5760) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) + 0 1 0)) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X2 R) + (- (CADDDR W) (+ (+ Y2 FUDGE) R)) (* 2 R) (* 2 R) 0 5760) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) + 0 1 0)) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (- X1 FUDGE) R) + (- (CADDDR W) (+ (+ Y2 FUDGE) R)) (* 2 R) (* 2 R) 5760 5760) + (IF (AND LINEWIDTH (/= LINEWIDTH 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) + +(DEFUN WINDOW-DRAW-ARC-XY + (W X Y RADIUSX RADIUSY ANGLEA ANGLEB &OPTIONAL LINEWIDTH) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) 0 + 1 0)) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RADIUSX) + (- (CADDDR W) (+ Y RADIUSY)) (* 2 RADIUSX) (* 2 RADIUSY) + (TRUNCATE (* 64 ANGLEA)) (TRUNCATE (* 64 ANGLEB))) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) + +(DEFUN WINDOW-DRAW-CIRCLE-XY (W X Y RADIUS &OPTIONAL LINEWIDTH) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) 0 + 1 0)) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RADIUS) + (- (CADDDR W) (+ Y RADIUS)) (* 2 RADIUS) (* 2 RADIUS) 0 23040) + (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) + +(DEFUN WINDOW-DRAW-CIRCLE (W POS RADIUS &OPTIONAL LINEWIDTH) + (WINDOW-DRAW-CIRCLE-XY W (CAR POS) (CADR POS) RADIUS LINEWIDTH)) + +(DEFUN WINDOW-ERASE-AREA (W OFFSET SIZE) + (WINDOW-ERASE-AREA-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) + (CADR SIZE))) + +(DEFUN WINDOW-ERASE-AREA-XY (W XOFF YOFF XSIZE YSIZE) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) XOFF + (- (CADDDR W) (1- (+ YOFF YSIZE))) XSIZE YSIZE 0)) + +(DEFUN WINDOW-ERASE-BOX-XY + (W XOFF YOFF XSIZE YSIZE &OPTIONAL LINEWIDTH) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) + (- XOFF (TRUNCATE (OR LINEWIDTH 1) 2)) + (- (CADDDR W) (+ YOFF YSIZE (TRUNCATE (OR LINEWIDTH 1) 2))) + (+ XSIZE (OR LINEWIDTH 1)) (+ YSIZE (OR LINEWIDTH 1)) 0)) + +(DEFUN WINDOW-DRAW-ELLIPSE-XY (W X Y RX RY &OPTIONAL LW) + (IF (AND LW (NOT (EQL LW 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LW 1) 0 1 0)) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RX) + (- (CADDDR W) (+ Y RY)) (* 2 RX) (* 2 RY) 0 23040) + (IF (AND LW (NOT (EQL LW 1))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) + +(DEFUN WINDOW-COPY-AREA-XY (W FROMX FROMY TOX TOY WIDTH HEIGHT) + (LET ((QQWHEIGHT (CADDDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* (CADDR W) 3) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XCOPYAREA *WINDOW-DISPLAY* (CADR W) (CADR W) (CADDR W) FROMX + (- QQWHEIGHT (+ FROMY HEIGHT)) WIDTH HEIGHT TOX + (- QQWHEIGHT (+ TOY HEIGHT))) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) + +(DEFUN WINDOW-INVERTAREA (W AREA) + (WINDOW-INVERT-AREA-XY W (CAAR AREA) (CADAR AREA) (CAADR AREA) + (CADADR AREA))) + +(DEFUN WINDOW-INVERT-AREA (W OFFSET SIZE) + (WINDOW-INVERT-AREA-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) + (CADR SIZE))) + +(DEFUN WINDOW-INVERT-AREA-XY (W LEFT BOTTOM WIDTH HEIGHT) + (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR W) (CADDR W) LEFT + (- (CADDDR W) (1- (+ BOTTOM HEIGHT))) WIDTH HEIGHT) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) + +(DEFUN WINDOW-PRETTYPRINTAT (W S POS) + (LET ((SSTR (STRINGIFY S))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR POS) + (- (CADDDR W) (CADR POS)) (GET-C-STRING SSTR) (LENGTH SSTR)))) + +(DEFUN WINDOW-PRETTYPRINTAT-XY (W S X Y) + (LET ((SSTR (STRINGIFY S))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X + (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))) + +(DEFUN WINDOW-PRINTAT (W S POS) + (LET ((SSTR (STRINGIFY S))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR POS) + (- (CADDDR W) (CADR POS)) (GET-C-STRING SSTR) (LENGTH SSTR)))) + +(DEFUN WINDOW-PRINTAT-XY (W S X Y) + (LET ((SSTR (STRINGIFY S))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X + (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))) + +(DEFUN WINDOW-PRINT-LINE (W STR X Y &OPTIONAL DELTAY) + (LET ((N 0) END STRB DONE) + (WHILE (NOT DONE) + (SETQ END (POSITION #\Newline STR :TEST #'CHAR= :START N)) + (SETQ STRB (SUBSEQ STR N END)) + (LET ((SSTR (STRINGIFY STRB))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X + (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR))) + (IF (NUMBERP END) (SETQ N (1+ END)) (SETQ DONE T)) + (DECF Y (OR DELTAY 16)) (IF (MINUSP Y) (SETQ DONE T))) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN WINDOW-PRINT-LINES (W LINES X Y &OPTIONAL DELTAY) + (DOLIST (STR LINES) + (WHEN (PLUSP Y) + (LET ((SSTR (STRINGIFY STR))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X + (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR))) + (DECF Y (OR DELTAY 16))))) + +(DEFUN WINDOW-STRING-WIDTH (W S) + (LET ((SSTR (STRINGIFY S))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) + +(DEFUN WINDOW-STRING-EXTENTS (W S) + (LET ((SSTR (STRINGIFY S))) + (XTEXTEXTENTS (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR) + *DIRECTION-RETURN* *ASCENT-RETURN* *DESCENT-RETURN* + *OVERALL-RETURN*) + (LIST (INT-POS *ASCENT-RETURN* 0) (INT-POS *DESCENT-RETURN* 0)))) + +(DEFUN WINDOW-STRING-HEIGHT (W S) + (LET ((SSTR (STRINGIFY S))) + (XTEXTEXTENTS (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR) + *DIRECTION-RETURN* *ASCENT-RETURN* *DESCENT-RETURN* + *OVERALL-RETURN*) + (+ (INT-POS *ASCENT-RETURN* 0) (INT-POS *DESCENT-RETURN* 0)))) + +(DEFUN WINDOW-FONT-STRING-WIDTH (FONT S) + (LET ((SSTR (STRINGIFY S))) + (XTEXTWIDTH FONT (GET-C-STRING SSTR) (LENGTH SSTR)))) + +(DEFUN WINDOW-YPOSITION (W) + (WINDOW-GET-MOUSE-POSITION) + (- (CADDDR W) + (- *MOUSE-Y* + (PROGN + (WINDOW-GET-GEOMETRY-B (CADR W)) + (INT-POS *Y-RETURN* 0))))) + +(DEFUN WINDOW-CENTEROFFSET (W V) + (LIST (TRUNCATE (- (FIFTH W) (CAR V)) 2) + (TRUNCATE (- (CADDDR W) (CADR V)) 2))) + +(DEFUN DOWINDOWCOM (W) + (LET (COMM) + (SETQ COMM (MENU-SELECT (WINDOW-MENU))) + (CASE COMM + (CLOSE (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) (WINDOW-WAIT-UNMAP W)) + (PAINT (WINDOW-PAINT W)) + (CLEAR (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*)) + (MOVE (WINDOW-MOVE W)) + (T (WHEN COMM (PRINC "This command not implemented.") (TERPRI)))))) + +(DEFUN WINDOW-MENU () + (OR *WINDOW-MENU* + (SETQ *WINDOW-MENU* + (LIST 'MENU (COPY-LIST '(WINDOW NIL NIL 0 0 "" NIL)) NIL + NIL 0 0 0 0 "" NIL NIL 0 '(CLOSE PAINT CLEAR MOVE))))) + +(DEFUN WINDOW-CLOSE (W) + (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-UNMAP W)) + +(DEFUN WINDOW-UNMAP (W) (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W))) + +(DEFUN WINDOW-OPEN (W) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE W)) + +(DEFUN WINDOW-MAP (W) (XMAPWINDOW *WINDOW-DISPLAY* (CADR W))) + +(DEFUN WINDOW-DESTROY (W) + (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*) + (SETF (CADR W) NIL) + (XFREEGC *WINDOW-DISPLAY* (CADDR W)) + (SETF (CADDR W) NIL)) + +(DEFUN WINDOW-DESTROY-SELECTED-WINDOW () + (PROG (WW CHILD) + (SLEEP 3) + (SETQ WW *ROOT-WINDOW*) + LP + (WINDOW-QUERY-POINTER-B WW) + (SETQ CHILD (FIXNUM-POS *CHILD-RETURN* 0)) + (IF (> CHILD 0) (PROGN (SETQ WW CHILD) (GO LP))) + (IF (/= WW *ROOT-WINDOW*) + (PROGN + (XDESTROYWINDOW *WINDOW-DISPLAY* WW) + (XFLUSH *WINDOW-DISPLAY*))))) + +(DEFUN WINDOW-CLEAR (W) + (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) + (XFLUSH *WINDOW-DISPLAY*)) + +(DEFUN WINDOW-MOVETO-XY (W X Y) + (XMOVEWINDOW *WINDOW-DISPLAY* (CADR W) X + (- (WINDOW-SCREEN-HEIGHT) Y))) + +(DEFUN WINDOW-PAINT (WINDOW) + (LET (STATE) + (WINDOW-TRACK-MOUSE WINDOW + #'(LAMBDA (X Y CODE) + (IF (= CODE 1) + (IF (= STATE 1) (SETQ STATE 0) (SETQ STATE 1)) + (IF (= CODE 2) + (IF (= STATE 2) (SETQ STATE 0) (SETQ STATE 2)))) + (IF (= STATE 1) + (WINDOW-DRAW-LINE-XY WINDOW X Y X Y 1 'PAINT) + (IF (= STATE 2) + (WINDOW-DRAW-LINE-XY WINDOW X Y X Y 1 'ERASE))) + (= CODE 3))))) + +(DEFUN WINDOW-MOVE (W) + (WINDOW-GET-MOUSE-POSITION) + (XMOVEWINDOW *WINDOW-DISPLAY* (CADR W) *MOUSE-X* + (- (WINDOW-SCREEN-HEIGHT) *MOUSE-Y*))) + +(DEFUN WINDOW-DRAW-BORDER (W) + (WINDOW-DRAW-BOX-XY W 0 1 (1- (CAR (WINDOW-SIZE W))) + (1- (CADR (WINDOW-SIZE W)))) + (XFLUSH *WINDOW-DISPLAY*)) + +(DEFUN WINDOW-TRACK-MOUSE (W FN &OPTIONAL OUTFLG) + (LET (WIN H) + (SETQ WIN (WINDOW-PARENT W)) + (SETQ H (WINDOW-DRAWABLE-HEIGHT W)) + (XSYNC *WINDOW-DISPLAY* 1) + (XSELECTINPUT *WINDOW-DISPLAY* WIN + (+ BUTTONPRESSMASK POINTERMOTIONMASK)) + (DO ((RES NIL)) (RES RES) + (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) + (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) + (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) + (WHEN (OR (AND (EQL EVENTWINDOW WIN) + (OR (EQL TYPE MOTIONNOTIFY) + (EQL TYPE BUTTONPRESS))) + (AND OUTFLG (EQL TYPE BUTTONPRESS))) + (LET ((X (XMOTIONEVENT-X *WINDOW-EVENT*)) + (Y (XMOTIONEVENT-Y *WINDOW-EVENT*)) + (CODE (IF (EQL TYPE BUTTONPRESS) + (XBUTTONEVENT-BUTTON *WINDOW-EVENT*) 0))) + (SETQ RES + (IF (EQL EVENTWINDOW WIN) (FUNCALL FN X (- H Y) CODE) + (FUNCALL FN -1 -1 CODE))))))))) + +(DEFUN WINDOW-WAIT-EXPOSURE (W) + (PROG (WIN START-TIME MAX-TIME EVENTWINDOW TYPE) + (SETQ WIN (WINDOW-PARENT W)) + (XGETWINDOWATTRIBUTES *WINDOW-DISPLAY* WIN *WINDOW-ATTR*) + (UNLESS (EQL (XWINDOWATTRIBUTES-MAP_STATE *WINDOW-ATTR*) + ISUNMAPPED) + (RETURN T)) + (SETQ START-TIME (GET-INTERNAL-REAL-TIME)) + (SETQ MAX-TIME INTERNAL-TIME-UNITS-PER-SECOND) + (XSELECTINPUT *WINDOW-DISPLAY* WIN (+ EXPOSUREMASK)) + LP + (COND + ((> (XPENDING *WINDOW-DISPLAY*) 0) + (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) + (SETQ TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) + (SETQ EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*)) + (IF (AND (EQL EVENTWINDOW WIN) (EQL TYPE EXPOSE)) (RETURN T))) + ((> (- (GET-INTERNAL-REAL-TIME) START-TIME) MAX-TIME) + (RETURN NIL))) + (GO LP))) + +(DEFUN WINDOW-WAIT-UNMAP (W) + (PROG (WIN START-TIME MAX-TIME) + (SETQ WIN (WINDOW-PARENT W)) + (SETQ START-TIME (GET-INTERNAL-REAL-TIME)) + (SETQ MAX-TIME INTERNAL-TIME-UNITS-PER-SECOND) + LP + (XGETWINDOWATTRIBUTES *WINDOW-DISPLAY* WIN *WINDOW-ATTR*) + (IF (EQL (XWINDOWATTRIBUTES-MAP_STATE *WINDOW-ATTR*) ISUNMAPPED) + (RETURN T) + (IF (> (- (GET-INTERNAL-REAL-TIME) START-TIME) MAX-TIME) + (RETURN NIL))) + (GO LP))) + +(DEFUN WINDOW-INIT-MOUSE-POLL (W) + (LET (WIN) + (SETQ WIN (WINDOW-PARENT W)) + (XSYNC *WINDOW-DISPLAY* 1) + (XSELECTINPUT *WINDOW-DISPLAY* WIN + (+ BUTTONPRESSMASK POINTERMOTIONMASK)))) + +(DEFUN WINDOW-POLL-MOUSE (W) + (LET (WIN H EVENTTYPE EVENTWINDOW X Y CD (CODE 0)) + (SETQ WIN (WINDOW-PARENT W)) + (SETQ H (WINDOW-DRAWABLE-HEIGHT W)) + (WHILE (> (XPENDING *WINDOW-DISPLAY*) 0) + (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) + (SETQ EVENTTYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) + (SETQ EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*)) + (IF (EQL EVENTWINDOW WIN) + (IF (EQL EVENTTYPE MOTIONNOTIFY) + (PROGN + (SETQ X (XMOTIONEVENT-X *WINDOW-EVENT*)) + (SETQ Y (XMOTIONEVENT-Y *WINDOW-EVENT*))) + (IF (EQL EVENTTYPE BUTTONPRESS) + (IF (> (SETQ CD + (XBUTTONEVENT-BUTTON + *WINDOW-EVENT*)) + 0) + (SETQ CODE CD)))))) + (IF (OR X (> CODE 0)) (LIST X (IF Y (- H Y)) CODE)))) + +(DEFUN MENU-INIT (M) + (OR *WINDOW-DISPLAY* (WINDOW-XINIT)) + (MENU-CALCULATE-SIZE M) + (IF (NOT (CADDR M)) + (SETF (CADR M) + (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") + (CADDDR M) (FIFTH M) (SIXTH M) (NTH 10 M))))) + +(DEFUN MENU-CALCULATE-SIZE (M) + (LET (MAXWIDTH TOTALHEIGHT NITEMS) + (OR (NTH 10 M) (SETF (NTH 10 M) '9X15)) + (SETQ MAXWIDTH + (+ (MENU-FIND-ITEM-WIDTH M (NINTH M)) + (IF (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*) 0 + *MENU-TITLE-PAD*))) + (SETQ NITEMS + (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + 1 0)) + (SETQ TOTALHEIGHT (* 13 NITEMS)) + (DOLIST (ITEM (NTH 12 M)) + (INCF NITEMS) + (SETQ MAXWIDTH (MAX MAXWIDTH (MENU-FIND-ITEM-WIDTH M ITEM))) + (INCF TOTALHEIGHT (MENU-FIND-ITEM-HEIGHT M ITEM))) + (SETF (NTH 11 M) (+ 6 MAXWIDTH)) + (SETF (SEVENTH M) (1+ (NTH 11 M))) + (SETF (EIGHTH M) (+ 2 TOTALHEIGHT)) + (MENU-ADJUST-OFFSET M))) + +(DEFUN MENU-ADJUST-OFFSET (M) + (LET (XBASE YBASE WBASE HBASE XOFF YOFF WGM WIDTH HEIGHT) + (SETQ WIDTH (SEVENTH M)) + (SETQ HEIGHT (EIGHTH M)) + (WHEN (NOT (CADDDR M)) + (WINDOW-GET-MOUSE-POSITION) + (SETQ WGM T) + (SETF (CADDDR M) *ROOT-WINDOW*)) + (WINDOW-GET-GEOMETRY-B (CADDDR M)) + (SETQ XBASE (INT-POS *X-RETURN* 0)) + (SETQ YBASE (INT-POS *Y-RETURN* 0)) + (SETQ WBASE (INT-POS *WIDTH-RETURN* 0)) + (SETQ HBASE (INT-POS *HEIGHT-RETURN* 0)) + (IF (OR (NOT (FIFTH M)) (ZEROP (FIFTH M))) + (PROGN + (OR WGM (WINDOW-GET-MOUSE-POSITION)) + (SETQ XOFF (+ -4 (- (- *MOUSE-X* XBASE) (TRUNCATE WIDTH 2)))) + (SETQ YOFF + (- (- HBASE (- *MOUSE-Y* YBASE)) (TRUNCATE HEIGHT 2)))) + (PROGN (SETQ XOFF (FIFTH M)) (SETQ YOFF (SIXTH M)))) + (SETF (FIFTH M) (MAX 0 (MIN XOFF (- WBASE WIDTH)))) + (SETF (SIXTH M) (MAX 0 (MIN YOFF (- HBASE HEIGHT)))))) + +(DEFUN MENU-DRAW (M) + (LET (MW XZERO YZERO BOTTOM) + (OR (AND (CADR M) (PLUSP (EIGHTH M))) (MENU-INIT M)) + (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (SETQ MW (CADR M)) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE MW) + (MENU-CLEAR M) + (IF (CADDR M) + (WINDOW-DRAW-BOX-XY MW (1- XZERO) YZERO (+ 2 (SEVENTH M)) + (1+ (EIGHTH M)) 1)) + (SETQ BOTTOM (+ 3 (+ YZERO (EIGHTH M)))) + (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + (INCF BOTTOM -15) + (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) + (+ 3 XZERO) (- (CADDDR MW) BOTTOM) (GET-C-STRING SSTR) + (LENGTH SSTR))) + (LET ((GC (CADDR MW))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO + (+ -12 (- (CADDDR MW) BOTTOM)) (1+ (SEVENTH M)) 15) + (LET ((GC (CADDR MW))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) + (DOLIST (ITEM (NTH 12 M)) + (DECF BOTTOM (MENU-FIND-ITEM-HEIGHT M ITEM)) + (MENU-DISPLAY-ITEM M ITEM (+ 3 XZERO) BOTTOM)) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN MENU-ITEM-VALUE (SELF ITEM) (declare (ignore self)) (IF (CONSP ITEM) (CDR ITEM) ITEM)) + +(DEFUN MENU-FIND-ITEM-WIDTH (SELF ITEM) + (LET (TMP) + (IF (AND (CONSP ITEM) (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) + (OR (AND (SETQ TMP (GET (CAR ITEM) 'DISPLAY-SIZE)) (CAR TMP)) + 40) + (WINDOW-FONT-STRING-WIDTH + (OR (AND (CADDR SELF) (CADR SELF) (SEVENTH (CADR SELF))) + (WINDOW-FONT-INFO (NTH 10 SELF))) + (STRINGIFY (IF (CONSP ITEM) (CAR ITEM) ITEM)))))) + +(DEFUN MENU-FIND-ITEM-HEIGHT (SELF ITEM) + (declare (ignore self)) + (LET (TMP) + (IF (AND (CONSP ITEM) (SYMBOLP (CAR ITEM)) + (SETQ TMP (GET (CAR ITEM) 'DISPLAY-SIZE))) + (+ 3 (CADR TMP)) 15))) + +(DEFUN MENU-CLEAR (M) + (IF (CADDR M) + (LET ((GLVAR386 (+ 3 (EIGHTH M)))) + (XCLEARAREA *WINDOW-DISPLAY* (CADADR M) + (1- (IF (CADDR M) (FIFTH M) 0)) + (- (CADDDR (CADR M)) + (1- (+ (1- (IF (CADDR M) (SIXTH M) 0)) GLVAR386))) + (+ 3 (SEVENTH M)) GLVAR386 0)) + (PROGN + (XCLEARWINDOW *WINDOW-DISPLAY* (CADADR M)) + (XFLUSH *WINDOW-DISPLAY*)))) + +(DEFUN MENU-DISPLAY-ITEM (SELF ITEM X Y) + (LET ((MW (CADR SELF))) + (IF (CONSP ITEM) + (IF (AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) + (FUNCALL (CAR ITEM) MW X Y) + (IF (OR (STRINGP (CAR ITEM)) (SYMBOLP (CAR ITEM)) + (NUMBERP (CAR ITEM))) + (LET ((SSTR (STRINGIFY (CAR ITEM)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) + (CADDR MW) X (- (CADDDR MW) Y) + (GET-C-STRING SSTR) (LENGTH SSTR))) + (LET ((SSTR (STRINGIFY (STRINGIFY ITEM)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) + (CADDR MW) X (- (CADDDR MW) Y) + (GET-C-STRING SSTR) (LENGTH SSTR))))) + (LET ((SSTR (STRINGIFY (STRINGIFY ITEM)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) X + (- (CADDDR MW) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))))) + +(DEFUN MENU-CHOOSE (M INSIDE) + (LET (MW CURRENT-ITEM YBASE ITEMH VAL MAXX MAXY XZERO YZERO) + (OR (AND (CADR M) (PLUSP (EIGHTH M))) (MENU-INIT M)) + (SETQ MW (CADR M)) + (MENU-DRAW M) + (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (SETQ MAXX (+ XZERO (SEVENTH M))) + (SETQ MAXY (+ YZERO (EIGHTH M))) + (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + (INCF MAXY -15)) + (WINDOW-TRACK-MOUSE MW + #'(LAMBDA (X Y CODE) + (SETQ *WINDOW-MENU-CODE* CODE) + (IF (AND (>= X XZERO) (<= X MAXX) (>= Y YZERO) (<= Y MAXY)) + (IF (OR (NULL CURRENT-ITEM) (< Y YBASE) + (> Y (+ YBASE ITEMH))) + (PROGN + (IF CURRENT-ITEM + (MENU-BOX-ITEM M CURRENT-ITEM YBASE)) + (SETQ CURRENT-ITEM + (MENU-FIND-ITEM-Y M (- Y YZERO))) + (WHEN CURRENT-ITEM + (SETQ YBASE (MENU-ITEM-Y M CURRENT-ITEM)) + (SETQ ITEMH + (MENU-FIND-ITEM-HEIGHT M CURRENT-ITEM)) + (MENU-BOX-ITEM M CURRENT-ITEM YBASE) + (SETQ INSIDE T)) + (WHEN (PLUSP CODE) + (MENU-BOX-ITEM M CURRENT-ITEM YBASE) + (SETQ VAL 1))) + (WHEN (PLUSP CODE) + (MENU-BOX-ITEM M CURRENT-ITEM YBASE) + (SETQ VAL 1))) + (PROGN + (WHEN CURRENT-ITEM + (MENU-BOX-ITEM M CURRENT-ITEM YBASE) + (SETQ CURRENT-ITEM NIL)) + (IF (OR (PLUSP CODE) + (AND INSIDE + (OR (< X XZERO) (> X MAXX) (< Y YZERO) + (> Y MAXY)))) + (SETQ VAL -777))))) + T) + (IF (NOT (EQL VAL -777)) + (IF (CONSP CURRENT-ITEM) (CDR CURRENT-ITEM) CURRENT-ITEM)))) + +(DEFUN MENU-BOX-ITEM (M ITEM YBASE) + (LET ((MW (OR (CADR M) (MENU-INIT M)))) + (LET ((GC (CADDR MW))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (WINDOW-DRAW-BOX-XY MW (1+ (IF (CADDR M) (FIFTH M) 0)) + (+ 2 (+ (IF (CADDR M) (SIXTH M) 0) YBASE)) (+ -2 (NTH 11 M)) + (MENU-FIND-ITEM-HEIGHT M ITEM) 1) + (LET ((GC (CADDR MW))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) + +(DEFUN MENU-UNBOX-ITEM (M ITEM YBASE) (MENU-BOX-ITEM M ITEM YBASE)) + +(DEFUN MENU-ITEM-POSITION (M ITEMNAME &OPTIONAL PLACE) + (LET ((XSIZE (NTH 11 M)) YBASE ITEM YSIZE) + (SETQ ITEM (MENU-FIND-ITEM M ITEMNAME)) + (SETQ YSIZE (MENU-FIND-ITEM-HEIGHT M ITEM)) + (SETQ YBASE (MENU-ITEM-Y M ITEM)) + (LIST (+ (IF (CADDR M) (FIFTH M) 0) + (CASE PLACE + ((CENTER TOP BOTTOM) (TRUNCATE XSIZE 2)) + (LEFT -1) + (RIGHT (+ 2 XSIZE)) + (T 0))) + (+ (+ (IF (CADDR M) (SIXTH M) 0) YBASE) + (CASE PLACE + ((CENTER RIGHT LEFT) (TRUNCATE YSIZE 2)) + (BOTTOM 0) + (TOP YSIZE) + (T 0)))))) + +(DEFUN MENU-FIND-ITEM (M ITEMNAME) + (LET (FOUND ITMS ITEM) + (SETQ ITMS (NTH 12 M)) + (SETQ FOUND (NULL ITEMNAME)) + (WHILE (AND ITMS (NOT FOUND)) (SETQ ITEM (POP ITMS)) + (IF (OR (EQ ITEM ITEMNAME) + (AND (CONSP ITEM) + (OR (EQ ITEMNAME (CAR ITEM)) + (AND (STRINGP (CAR ITEM)) + (STRING= (STRINGIFY ITEMNAME) + (CAR ITEM))) + (EQ (CDR ITEM) ITEMNAME) + (AND (CONSP (CDR ITEM)) + (EQ (CADR ITEM) ITEMNAME))))) + (SETQ FOUND T))) + ITEM)) + +(DEFUN MENU-ITEM-Y (M ITEM) + (LET (FOUND ITMS ITM YBASE) + (SETQ YBASE (1- (EIGHTH M))) + (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + (INCF YBASE -15)) + (SETQ ITMS (NTH 12 M)) + (WHILE (AND ITMS (NOT FOUND)) (SETQ ITM (POP ITMS)) + (DECF YBASE (MENU-FIND-ITEM-HEIGHT M ITM)) + (SETQ FOUND (EQ ITEM ITM))) + YBASE)) + +(DEFUN MENU-FIND-ITEM-Y (M Y) + (LET (FOUND ITMS ITM YBASE) + (SETQ YBASE (1- (EIGHTH M))) + (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + (INCF YBASE -15)) + (SETQ ITMS (NTH 12 M)) + (WHILE (AND ITMS (NOT FOUND)) (SETQ ITM (POP ITMS)) + (DECF YBASE (MENU-FIND-ITEM-HEIGHT M ITM)) + (SETQ FOUND + (AND (>= Y YBASE) + (<= Y (+ YBASE (MENU-FIND-ITEM-HEIGHT M ITM)))))) + (AND FOUND ITM))) + +(DEFUN MENU-SELECT (M &OPTIONAL INSIDE) (MENU-SELECT-B M NIL INSIDE)) + +(DEFUN MENU-SELECT! (M) (MENU-SELECT-B M T NIL)) + +(DEFUN MENU-SELECT-B (M FLG INSIDE) + (PROG (RES) + LP + (SETQ RES (MENU-CHOOSE M INSIDE)) + (IF (AND FLG (NOT RES)) (GO LP)) + (IF (NOT (TENTH M)) + (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*)) + (PROGN + (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-UNMAP (CADR M))))) + (RETURN RES))) + +(DEFUN MENU-DESTROY (M) + (WHEN (NOT (CADDR M)) + (XDESTROYWINDOW *WINDOW-DISPLAY* (CADADR M)) + (XFLUSH *WINDOW-DISPLAY*) + (SETF (CADADR M) NIL) + (XFREEGC *WINDOW-DISPLAY* (CADDR (CADR M))) + (SETF (CADDR (CADR M)) NIL) + (SETF (CADR M) NIL))) + +(DEFUN MENU (ITEMS &OPTIONAL TITLE) + (LET (M RES) + (SETQ M (MENU-CREATE ITEMS TITLE)) + (SETQ RES (MENU-SELECT M)) + (MENU-DESTROY M) + RES)) + + + +(DEFUN MENU-CREATE (ITEMS &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT) + (LIST 'MENU (IF FLAT PARENTW) FLAT (CADR PARENTW) X Y 0 0 + (IF TITLE (STRINGIFY TITLE) "") PERM FONT 0 ITEMS)) + +(DEFUN MENU-OFFSET (M) + (LIST (IF (CADDR M) (FIFTH M) 0) (IF (CADDR M) (SIXTH M) 0))) + +(DEFUN MENU-SIZE (M) + (IF (<= (SEVENTH M) 0) + (CASE (FIRST M) + (PICMENU (PICMENU-CALCULATE-SIZE M)) + (BARMENU (BARMENU-CALCULATE-SIZE M)) + (TEXTMENU (TEXTMENU-CALCULATE-SIZE M)) + (EDITMENU (EDITMENU-CALCULATE-SIZE M)) + (T (MENU-CALCULATE-SIZE M)))) + (LIST (SEVENTH M) (EIGHTH M))) + +(DEFUN MENU-MOVETO-XY (M X Y) + (WHEN (CADDR M) + (SETF (FIFTH M) X) + (SETF (SIXTH M) Y) + (MENU-ADJUST-OFFSET M))) + +(DEFUN MENU-REPOSITION (M) + (LET (SIZEV POS) + (WHEN (CADDR M) + (SETQ SIZEV (MENU-SIZE M)) + (SETQ POS + (WINDOW-GET-BOX-POSITION (CADR M) (CAR SIZEV) (CADR SIZEV))) + (MENU-MOVETO-XY M (CAR POS) (CADR POS))))) + +(DEFUN MENU-REPOSITION-LINE (M OFFSET TARGET) + (LET (SIZEV POS) + (WHEN (CADDR M) + (SETQ SIZEV (MENU-SIZE M)) + (SETQ POS + (WINDOW-GET-BOX-LINE-POSITION (CADR M) (CAR SIZEV) + (CADR SIZEV) (CAR OFFSET) (CADR OFFSET) (CAR TARGET) + (CADR TARGET))) + (MENU-MOVETO-XY M (CAR POS) (CADR POS))))) + + + +(DEFUN PICMENU-CREATE + (BUTTONS WIDTH HEIGHT DRAWFN &OPTIONAL TITLE DOTFLG PARENTW X Y + PERM FLAT FONT BOXFLG) + (PICMENU-CREATE-FROM-SPEC + (PICMENU-CREATE-SPEC BUTTONS WIDTH HEIGHT DRAWFN DOTFLG FONT) + TITLE PARENTW X Y PERM FLAT BOXFLG)) + + + +(DEFUN PICMENU-CREATE-SPEC + (BUTTONS WIDTH HEIGHT DRAWFN &OPTIONAL DOTFLG FONT) + (LIST 'PICMENU-SPEC WIDTH HEIGHT BUTTONS DOTFLG DRAWFN + (OR FONT '9X15))) + + + +(DEFUN PICMENU-CREATE-FROM-SPEC + (SPEC &OPTIONAL TITLE PARENTW X Y PERM FLAT BOXFLG) + (LIST 'PICMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) X Y + 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM SPEC BOXFLG NIL NIL)) + +(DEFUN PICMENU-CALCULATE-SIZE (M) + (LET (MAXWIDTH MAXHEIGHT) + (SETQ MAXWIDTH + (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) + (CADR (NTH 10 M)))) + (SETQ MAXHEIGHT + (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + 15 0) + (CADDR (NTH 10 M)))) + (SETF (SEVENTH M) MAXWIDTH) + (SETF (EIGHTH M) MAXHEIGHT))) + +(DEFUN PICMENU-INIT (M) + (PICMENU-CALCULATE-SIZE M) + (MENU-ADJUST-OFFSET M) + (IF (NOT (CADDR M)) + (SETF (CADR M) + (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") + (CADDDR M) (FIFTH M) (SIXTH M) (SEVENTH (NTH 10 M)))))) + +(DEFUN PICMENU-DRAW (M) + (LET (MW BOTTOM XZERO YZERO) + (OR (AND (CADR M) (PLUSP (EIGHTH M))) (PICMENU-INIT M)) + (SETQ MW (CADR M)) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE MW) + (MENU-CLEAR M) + (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (SETQ BOTTOM (+ YZERO (EIGHTH M))) + (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) + (+ 3 XZERO) (+ 13 (- (CADDDR MW) BOTTOM)) + (GET-C-STRING SSTR) (LENGTH SSTR))) + (LET ((GC (CADDR MW))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO + (- (CADDDR MW) BOTTOM) (SEVENTH M) 16) + (LET ((GC (CADDR MW))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) + (FUNCALL (SIXTH (NTH 10 M)) MW XZERO YZERO) + (IF (NTH 11 M) + (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) + (IF (FIFTH (NTH 10 M)) + (DOLIST (B (CADDDR (NTH 10 M))) (PICMENU-DRAW-BUTTON M B))) + (SETF (NTH 12 M) NIL) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN PICMENU-DRAW-NAMED-BUTTON (M NM) + (PICMENU-DRAW-BUTTON M (ASSOC NM (CADDDR (NTH 10 M))))) + +(DEFUN PICMENU-SET-NAMED-BUTTON-COLOR (M NM COLOR) + (LET (LST) + (IF (SETQ LST (ASSOC NM (NTH 13 M))) (SETF (CADR LST) COLOR) + (PUSH (LIST NM COLOR) (NTH 13 M))))) + +(DEFUN PICMENU-DRAW-BUTTON (M B) + (LET ((MW (CADR M)) COL) + (LET ((GC (CADDR MW))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (WINDOW-DRAW-BOX-XY MW + (+ -2 (+ (IF (CADDR M) (FIFTH M) 0) (CAADR B))) + (+ -2 (+ (IF (CADDR M) (SIXTH M) 0) (CADADR B))) 4 4 1) + (LET ((GC (CADDR MW))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)) + (WHEN (SETQ COL (ASSOC (CAR B) (NTH 13 M))) + (WINDOW-SET-COLOR-RGB MW (CAADR COL) (CADADR COL) + (CADDR (CADR COL))) + (WINDOW-DRAW-BOX-XY MW + (1- (+ (IF (CADDR M) (FIFTH M) 0) (CAADR B))) + (1- (+ (IF (CADDR M) (SIXTH M) 0) (CADADR B))) 3 3 2) + (WINDOW-RESET-COLOR MW)))) + +(DEFUN PICMENU-DELETE-NAMED-BUTTON (M NAME) + (LET (B) + (WHEN (AND (SETQ B (ASSOC NAME (CADDDR (NTH 10 M)))) + (NOT (MEMBER NAME (NTH 12 M) :TEST #'EQUAL))) + (IF (FIFTH (NTH 10 M)) (PICMENU-DRAW-BUTTON M B)) + (PUSH NAME (NTH 12 M))) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN PICMENU-SELECT (M &OPTIONAL INSIDE ANYCLICK) + (LET (MW CURRENT-BUTTON ITEM ITEMS VAL XZERO YZERO CODEVAL) + (SETQ MW (OR (CADR M) (PICMENU-INIT M))) + (IF (NOT (TENTH M)) (PICMENU-DRAW M)) + (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (WINDOW-TRACK-MOUSE MW + #'(LAMBDA (X Y CODE) + (SETQ *WINDOW-MENU-CODE* CODE) + (DECF X XZERO) + (DECF Y YZERO) + (IF (AND (>= X 0) (<= X (SEVENTH M)) (>= Y 0) + (<= Y (EIGHTH M))) + (SETQ INSIDE T)) + (IF CURRENT-BUTTON + (WHEN (NOT (PICMENU-BUTTON-CONTAINSXY? CURRENT-BUTTON X + Y)) + (PICMENU-UNBOX-ITEM M CURRENT-BUTTON) + (SETQ CURRENT-BUTTON NIL))) + (WHEN (NOT CURRENT-BUTTON) + (SETQ ITEMS (CADDDR (NTH 10 M))) + (WHILE (AND (NOT CURRENT-BUTTON) (SETQ ITEM (POP ITEMS))) + (WHEN (AND (PICMENU-BUTTON-CONTAINSXY? ITEM X Y) + (NOT (MEMBER (CAR ITEM) (NTH 12 M) + :TEST #'EQUAL))) + (PICMENU-BOX-ITEM M ITEM) + (SETQ CURRENT-BUTTON ITEM)))) + (WHEN (OR (PLUSP CODE) + (AND INSIDE + (OR (MINUSP X) (> X (SEVENTH M)) (MINUSP Y) + (> Y (EIGHTH M))))) + (IF CURRENT-BUTTON (PICMENU-UNBOX-ITEM M CURRENT-BUTTON)) + (SETQ CODEVAL CODE) + (SETQ VAL + (IF (AND (PLUSP CODE) CURRENT-BUTTON) + CURRENT-BUTTON *PICMENU-NO-SELECTION*)))) + T) + (IF (NOT (TENTH M)) + (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*)) + (PROGN + (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-UNMAP (CADR M))))) + (IF (EQUAL VAL *PICMENU-NO-SELECTION*) + (AND (PLUSP CODEVAL) ANYCLICK) (CAR VAL)))) + +(DEFUN PICMENU-BOX-ITEM (M ITEM) + (LET ((MW (OR (CADR M) (PICMENU-INIT M))) XOFF YOFF SIZ) + (SETQ XOFF (+ (IF (CADDR M) (FIFTH M) 0) (CAADR ITEM))) + (SETQ YOFF (+ (IF (CADDR M) (SIXTH M) 0) (CADADR ITEM))) + (IF (CADDDR ITEM) + (FUNCALL (CADDDR ITEM) (OR (CADR M) (PICMENU-INIT M)) XOFF + YOFF) + (PROGN + (LET ((GC (CADDR MW))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (IF (SETQ SIZ (CADDR ITEM)) + (WINDOW-DRAW-BOX-XY MW (- XOFF (TRUNCATE (CAR SIZ) 2)) + (- YOFF (TRUNCATE (CADR SIZ) 2)) (CAR SIZ) (CADR SIZ) + 1) + (WINDOW-DRAW-BOX-XY MW (+ -6 XOFF) (+ -6 YOFF) 12 12 1)) + (LET ((GC (CADDR MW))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + *WINDOW-SAVE-FOREGROUND*)) + (XFLUSH *WINDOW-DISPLAY*))))) + +(DEFUN PICMENU-UNBOX-ITEM (M ITEM) + (IF (FIFTH ITEM) + (PROGN + (FUNCALL (FIFTH ITEM) (OR (CADR M) (PICMENU-INIT M)) + (CAADR ITEM) (CADADR ITEM)) + (XFLUSH *WINDOW-DISPLAY*)) + (PICMENU-BOX-ITEM M ITEM))) + +(DEFUN PICMENU-DESTROY (M) (MENU-DESTROY M)) + +(DEFUN PICMENU-BUTTON-CONTAINSXY? (B X Y) + (LET ((XSIZE 6) (YSIZE 6)) + (WHEN (CADDR B) + (SETQ XSIZE (TRUNCATE (CAADDR B) 2)) + (SETQ YSIZE (TRUNCATE (CADR (CADDR B)) 2))) + (AND (>= X (- (CAADR B) XSIZE)) (<= X (+ (CAADR B) XSIZE)) + (>= Y (- (CADADR B) YSIZE)) (<= Y (+ (CADADR B) YSIZE))))) + +(DEFUN PICMENU-ITEM-POSITION (M ITEMNAME &OPTIONAL PLACE) + (LET (B (XSIZE 0) (YSIZE 0) XOFF YOFF) + (IF (NULL ITEMNAME) + (PROGN + (SETQ XSIZE (SEVENTH M)) + (SETQ YSIZE (TRUNCATE (- (EIGHTH M) (CADDR (NTH 10 M))) 2)) + (SETQ XOFF (TRUNCATE XSIZE 2)) + (SETQ YOFF (+ (CADDR (NTH 10 M)) (TRUNCATE YSIZE 2)))) + (WHEN (SETQ B (ASSOC ITEMNAME (CADDDR (NTH 10 M)))) + (WHEN (CADDR B) + (SETQ XSIZE (CAADDR B)) + (SETQ YSIZE (CADR (CADDR B)))) + (SETQ XOFF (CAADR B)) + (SETQ YOFF (CADADR B)))) + (IF XOFF + (LIST (+ (+ (IF (CADDR M) (FIFTH M) 0) XOFF) + (CASE PLACE + ((CENTER TOP BOTTOM) 0) + (LEFT (- (TRUNCATE XSIZE 2))) + (RIGHT (TRUNCATE XSIZE 2)) + (T 0))) + (+ (+ (IF (CADDR M) (SIXTH M) 0) YOFF) + (CASE PLACE + ((CENTER RIGHT LEFT) 0) + (BOTTOM (- (TRUNCATE YSIZE 2))) + (TOP (TRUNCATE YSIZE 2)) + (T 0))))))) + + + +(DEFUN BARMENU-CREATE + (MAXVAL INITVAL BARWIDTH &OPTIONAL TITLE HORIZONTAL SUBTRACKFN + SUBTRACKPARMS PARENTW X Y PERM FLAT COLOR) + (LIST 'BARMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) + (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM + COLOR INITVAL MAXVAL BARWIDTH HORIZONTAL SUBTRACKFN + SUBTRACKPARMS)) + +(DEFUN BARMENU-CALCULATE-SIZE (M) + (LET (MAXWIDTH MAXHEIGHT) + (SETQ MAXWIDTH + (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) + (NTH 13 M))) + (SETQ MAXHEIGHT + (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + 15 0) + (NTH 12 M))) + (SETF (SEVENTH M) MAXWIDTH) + (SETF (EIGHTH M) MAXHEIGHT))) + +(DEFUN BARMENU-INIT (M) + (BARMENU-CALCULATE-SIZE M) + (MENU-ADJUST-OFFSET M) + (IF (NOT (CADDR M)) + (SETF (CADR M) + (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") + (CADDDR M) (FIFTH M) (SIXTH M))))) + +(DEFUN BARMENU-DRAW (M) + (LET (MW XZERO YZERO) + (OR (AND (CADR M) (PLUSP (EIGHTH M))) (BARMENU-INIT M)) + (SETQ MW (CADR M)) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE MW) + (MENU-CLEAR M) + (SETQ XZERO + (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (IF (NTH 10 M) (WINDOW-SET-COLOR MW (NTH 10 M))) + (IF (NTH 14 M) + (LET ((QQWHEIGHT (CADDDR (CADR M)))) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) + (OR (NTH 13 M) 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) XZERO + (- QQWHEIGHT YZERO) (+ XZERO (NTH 11 M)) + (- QQWHEIGHT YZERO)) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 0 + 1 0))) + (LET ((QQWHEIGHT (CADDDR (CADR M)))) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) + (OR (NTH 13 M) 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) XZERO + (- QQWHEIGHT YZERO) XZERO + (- QQWHEIGHT (+ YZERO (NTH 11 M)))) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 0 + 1 0)))) + (IF (NTH 10 M) (WINDOW-RESET-COLOR MW)) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN BARMENU-SELECT (M &OPTIONAL INSIDE) + (declare (ignore inside)) + (LET (MW XZERO YZERO VAL) + (SETQ MW (OR (CADR M) (BARMENU-INIT M))) + (IF (NOT (TENTH M)) (BARMENU-DRAW M)) + (SETQ XZERO + (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (WHEN (WINDOW-TRACK-MOUSE-IN-REGION MW (IF (CADDR M) (FIFTH M) 0) + YZERO (SEVENTH M) (EIGHTH M) T T) + (WINDOW-TRACK-MOUSE MW + #'(LAMBDA (X Y CODE) + (SETQ *WINDOW-MENU-CODE* CODE) + (SETQ VAL (IF (NTH 14 M) (- X XZERO) (- Y YZERO))) + (BARMENU-UPDATE-VALUE M VAL) + (IF (PLUSP CODE) CODE))) + VAL))) + +(DEFVAR *BARMENU-UPDATE-VALUE-CONS* (CONS NIL NIL)) + +(DEFUN BARMENU-UPDATE-VALUE (M VAL) + (LET ((MW (OR (CADR M) (BARMENU-INIT M))) XZERO YZERO) + (SETQ VAL (MAX 0 (MIN VAL (NTH 12 M)))) + (WHEN (/= VAL (NTH 11 M)) + (IF (< VAL (NTH 11 M)) + (LET ((GC (CADDR MW))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 3) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*)))) + (IF (NTH 10 M) (WINDOW-SET-COLOR MW (NTH 10 M)))) + (SETQ XZERO + (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (IF (NTH 14 M) + (LET ((QQWHEIGHT (CADDDR (CADR M)))) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) + (OR (NTH 13 M) 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) + (+ XZERO (NTH 11 M)) (- QQWHEIGHT YZERO) (+ XZERO VAL) + (- QQWHEIGHT YZERO)) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 + 0 1 0))) + (LET ((QQWHEIGHT (CADDDR (CADR M)))) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) + (OR (NTH 13 M) 1) 0 1 0)) + (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) + XZERO (- QQWHEIGHT (+ YZERO (NTH 11 M))) XZERO + (- QQWHEIGHT (+ YZERO VAL))) + (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 + 0 1 0)))) + (IF (< VAL (NTH 11 M)) + (LET ((GC (CADDR MW))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + *WINDOW-SAVE-FOREGROUND*)) + (IF (NTH 10 M) (WINDOW-RESET-COLOR MW))) + (SETF (NTH 11 M) VAL) + (WHEN (NTH 15 M) + (SETF (CAR *BARMENU-UPDATE-VALUE-CONS*) VAL) + (SETF (CDR *BARMENU-UPDATE-VALUE-CONS*) (NTH 16 M)) + (APPLY (NTH 15 M) *BARMENU-UPDATE-VALUE-CONS*)) + (XFLUSH *WINDOW-DISPLAY*)))) + + + +(DEFUN TEXTMENU-CREATE + (WIDTH HEIGHT &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT BOXFLG + INITIAL-TEXT) + (LIST 'TEXTMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) + (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM + INITIAL-TEXT WIDTH HEIGHT BOXFLG (OR FONT '9X15))) + +(DEFUN TEXTMENU-CALCULATE-SIZE (M) + (LET (MAXWIDTH MAXHEIGHT) + (SETQ MAXWIDTH + (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) + (NTH 11 M))) + (SETQ MAXHEIGHT + (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + 15 0) + (NTH 12 M))) + (SETF (SEVENTH M) MAXWIDTH) + (SETF (EIGHTH M) MAXHEIGHT))) + +(DEFUN TEXTMENU-INIT (M) + (TEXTMENU-CALCULATE-SIZE M) + (MENU-ADJUST-OFFSET M) + (IF (NOT (CADDR M)) + (SETF (CADR M) + (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") + (CADDDR M) (FIFTH M) (SIXTH M) (NTH 14 M))))) + +(DEFUN TEXTMENU-DRAW (M) + (LET (MW BOTTOM XZERO YZERO) + (OR (AND (CADR M) (PLUSP (EIGHTH M))) (TEXTMENU-INIT M)) + (SETQ MW (CADR M)) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE MW) + (MENU-CLEAR M) + (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (SETQ BOTTOM (+ YZERO (EIGHTH M))) + (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) + (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) + (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) + (+ 3 XZERO) (+ 13 (- (CADDDR MW) BOTTOM)) + (GET-C-STRING SSTR) (LENGTH SSTR))) + (LET ((GC (CADDR MW))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO + (- (CADDDR MW) BOTTOM) (SEVENTH M) 16) + (LET ((GC (CADDR MW))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) + (IF (NTH 10 M) + (LET ((SSTR (STRINGIFY (NTH 10 M)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) + (+ 10 XZERO) + (+ 8 (- (CADDDR MW) (+ YZERO (TRUNCATE (EIGHTH M) 2)))) + (GET-C-STRING SSTR) (LENGTH SSTR)))) + (IF (NTH 13 M) + (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN TEXTMENU-SELECT (M &OPTIONAL INSIDE) + (declare (ignore inside)) + (LET (MW XZERO YZERO CODEVAL) + (SETQ MW (OR (CADR M) (TEXTMENU-INIT M))) + (IF (NOT (TENTH M)) (TEXTMENU-DRAW M)) + (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (WINDOW-TRACK-MOUSE MW + #'(LAMBDA (X Y CODE) + (SETQ *WINDOW-MENU-CODE* CODE) + (DECF X XZERO) + (DECF Y YZERO) + (IF (OR (PLUSP CODE) (MINUSP X) (> X (SEVENTH M)) + (MINUSP Y) (> Y (EIGHTH M))) + (SETQ CODEVAL CODE))) + T) + (WHEN (AND (NOT (TENTH M)) (NOT (CADDR M))) + (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-UNMAP (CADR M))) + (WHEN (PLUSP CODEVAL) + (TEXTMENU-DRAW M) + (WINDOW-INPUT-STRING MW (NTH 10 M) (+ 10 XZERO) + (+ -8 (+ YZERO (TRUNCATE (EIGHTH M) 2))) (+ -12 (SEVENTH M)))))) + +(DEFUN TEXTMENU-SET-TEXT (M &OPTIONAL S) (SETF (NTH 10 M) (OR S ""))) + + + +(DEFUN WINDOW-GET-POINT (W) + (LET (ORGX ORGY) + (WINDOW-TRACK-MOUSE W + #'(LAMBDA (X Y CODE) + (WHEN (NOT (ZEROP CODE)) (SETQ ORGX X) (SETQ ORGY Y)))) + (LIST ORGX ORGY))) + + + +(DEFUN WINDOW-GET-CLICK (W) + (LET (ORGX ORGY BUTTON) + (WINDOW-TRACK-MOUSE W + #'(LAMBDA (X Y CODE) + (WHEN (NOT (ZEROP CODE)) + (SETQ BUTTON CODE) + (SETQ ORGX X) + (SETQ ORGY Y)))) + (LIST BUTTON (LIST ORGX ORGY)))) + + + +(DEFUN WINDOW-GET-LINE-POSITION (W ORGX ORGY) + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-LINE-XY + (LIST ORGX ORGY 1 'PAINT))) + + + +(DEFUN WINDOW-GET-LATEX-POSITION (W ORGX ORGY &OPTIONAL FLG) + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-LATEX-XY + (LIST ORGX ORGY FLG))) + + + +(DEFUN WINDOW-GET-BOX-POSITION (W WIDTH HEIGHT &OPTIONAL (DX 0) (DY 0)) + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-XY + (LIST WIDTH HEIGHT 1) DX DY)) + + + +(DEFUN WINDOW-GET-BOX-LINE-POSITION + (W WIDTH HEIGHT OFFX OFFY TOX TOY &OPTIONAL (DX 0) (DY 0)) + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-LINE-XY + (LIST WIDTH HEIGHT OFFX OFFY TOX TOY) DX DY)) + +(DEFUN WINDOW-DRAW-BOX-LINE-XY (W X Y WIDTH HEIGHT OFFX OFFY TOX TOY) + (WINDOW-DRAW-BOX-XY W X Y WIDTH HEIGHT) + (WINDOW-DRAW-LINE-XY W (+ X OFFX) (+ Y OFFY) TOX TOY)) + + + +(DEFUN WINDOW-GET-ICON-POSITION (W FN ARGS &OPTIONAL (DX 0) (DY 0)) + (LET (LASTX LASTY ARGL) + (SETQ ARGL (CONS W (CONS 0 (CONS 0 ARGS)))) + (WINDOW-SET-XOR W) + (WINDOW-TRACK-MOUSE W + #'(LAMBDA (X Y CODE) + (WHEN (OR (NULL LASTX) (/= X LASTX) (/= Y LASTY)) + (IF LASTX (APPLY FN ARGL)) + (RPLACA (CDR ARGL) (+ X DX)) + (RPLACA (CDDR ARGL) (+ Y DY)) + (APPLY FN ARGL) + (SETQ LASTX X) + (SETQ LASTY Y)) + (NOT (ZEROP CODE)))) + (APPLY FN ARGL) + (WINDOW-UNSET W) + (WINDOW-FORCE-OUTPUT W) + (LIST LASTX LASTY))) + + + +(DEFUN WINDOW-GET-REGION (W &OPTIONAL WID HT) + (LET (LASTX LASTY START END WIDTH HEIGHT PLACE OFFX OFFY STX STY) + (IF (AND (NUMBERP WID) (NUMBERP HT)) + (PROGN + (SETQ START + (WINDOW-GET-BOX-POSITION W WID HT (- WID) (- HT))) + (SETQ STX (- (CAR START) WID)) + (SETQ STY (- (CADR START) HT))) + (PROGN + (SETQ START (WINDOW-GET-POINT W)) + (SETQ STX (CAR START)) + (SETQ STY (CADR START)))) + (SETQ END + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-CORNERS + (LIST STX STY 1))) + (SETQ LASTX (CAR END)) + (SETQ LASTY (CADR END)) + (SETQ WIDTH (ABS (- STX LASTX))) + (SETQ HEIGHT (ABS (- STY LASTY))) + (SETQ OFFX (- (MIN STX LASTX) LASTX)) + (SETQ OFFY (- (MIN STY LASTY) LASTY)) + (SETQ PLACE (WINDOW-GET-BOX-POSITION W WIDTH HEIGHT OFFX OFFY)) + (LIST (LIST (+ OFFX (FIRST PLACE)) (+ OFFY (SECOND PLACE))) + (LIST WIDTH HEIGHT)))) + + + +(DEFUN WINDOW-GET-BOX-SIZE (W OFFSETX OFFSETY) + (LET (LEGENDY LASTX LASTY DX DY) + (SETQ OFFSETY (MAX OFFSETY 30)) + (SETQ LEGENDY (- OFFSETY 25)) + (WINDOW-ERASE-AREA-XY W OFFSETX LEGENDY 71 21) + (WINDOW-DRAW-BOX-XY W OFFSETX LEGENDY 70 20) + (WINDOW-TRACK-MOUSE W + #'(LAMBDA (X Y CODE) + (WHEN (OR (NULL LASTX) (/= X LASTX) (/= Y LASTY)) + (IF LASTX + (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY + (- LASTX OFFSETX) (- LASTY OFFSETY))) + (SETQ LASTX NIL) + (SETQ DX (- X OFFSETX)) + (SETQ DY (- Y OFFSETY)) + (WHEN (AND (> DX 0) (> DY 0)) + (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY DX DY) + (WINDOW-PRINTAT-XY W (FORMAT NIL "~3D x ~3D" DX DY) + (+ OFFSETX 3) (+ LEGENDY 5)) + (SETQ LASTX X) + (SETQ LASTY Y))) + (NOT (ZEROP CODE)))) + (IF LASTX + (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY (- LASTX OFFSETX) + (- LASTY OFFSETY))) + (WINDOW-ERASE-AREA-XY W OFFSETX LEGENDY 71 21) + (WINDOW-FORCE-OUTPUT W) + (LIST DX DY))) + + + +(DEFUN WINDOW-TRACK-MOUSE-IN-REGION + (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL BOXFLG INSIDE) + (LET (RES) + (WHEN BOXFLG + (WINDOW-SET-XOR W) + (WINDOW-DRAW-BOX-XY W (- OFFSETX 4) (- OFFSETY 4) (+ SIZEX 8) + (+ SIZEY 8)) + (WINDOW-UNSET W) + (WINDOW-FORCE-OUTPUT W)) + (SETQ RES + (WINDOW-TRACK-MOUSE W + #'(LAMBDA (X Y CODE) + (IF (> CODE 0) (IF INSIDE (LIST CODE (LIST X Y)) T) + (IF (OR (< X OFFSETX) (> X (+ OFFSETX SIZEX)) + (< Y OFFSETY) (> Y (+ OFFSETY SIZEY))) + INSIDE (AND (SETQ INSIDE T) NIL)))))) + (WHEN BOXFLG + (WINDOW-SET-XOR W) + (WINDOW-DRAW-BOX-XY W (- OFFSETX 4) (- OFFSETY 4) (+ SIZEX 8) + (+ SIZEY 8)) + (WINDOW-UNSET W) + (WINDOW-FORCE-OUTPUT W)) + (IF (CONSP RES) RES))) + + + +(DEFUN WINDOW-ADJUST-BOX-SIDE (W ORGX ORGY WIDTH HEIGHT SIDE) + (LET (NEW (XX ORGX) (YY ORGY) (WW WIDTH) (HH HEIGHT)) + (SETQ NEW + (WINDOW-GET-ICON-POSITION W #'WINDOW-ADJ-BOX-XY + (LIST ORGX ORGY WIDTH HEIGHT SIDE))) + (CASE SIDE + (LEFT (SETQ XX (CAR NEW)) (SETQ WW (+ WIDTH (- ORGX (CAR NEW))))) + (RIGHT (SETQ WW (- (CAR NEW) ORGX))) + (TOP (SETQ HH (- (CADR NEW) ORGY))) + (BOTTOM (SETQ YY (CADR NEW)) + (SETQ HH (+ HEIGHT (- ORGY (CADR NEW)))))) + (LIST (LIST XX YY) (LIST WW HH)))) + +(DEFUN WINDOW-ADJ-BOX-XY (W X Y ORGX ORGY WIDTH HEIGHT SIDE) + (LET ((XX ORGX) (YY ORGY) (WW WIDTH) (HH HEIGHT)) + (CASE SIDE + (LEFT (SETQ XX X) (SETQ WW (+ WIDTH (- ORGX X)))) + (RIGHT (SETQ WW (- X ORGX))) + (TOP (SETQ HH (- Y ORGY))) + (BOTTOM (SETQ YY Y) (SETQ HH (+ HEIGHT (- ORGY Y))))) + (WINDOW-DRAW-BOX-XY W XX YY WW HH))) + + + +(DEFUN WINDOW-GET-CIRCLE (W &OPTIONAL CENTER) + (LET (PT) + (OR CENTER (SETQ CENTER (WINDOW-GET-CROSSHAIRS W))) + (SETQ PT + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CIRCLE-PT + (LIST CENTER))) + (LIST CENTER (WINDOW-CIRCLE-RADIUS (CAR PT) (CADR PT) CENTER)))) + +(DEFUN WINDOW-CIRCLE-RADIUS (X Y CENTER) + (LET ((DX (- X (CAR CENTER))) (DY (- Y (CADR CENTER)))) + (TRUNCATE (+ 0.5 (SQRT (+ (* DX DX) (* DY DY))))))) + +(DEFUN WINDOW-DRAW-CIRCLE-PT (W X Y CENTER) + (WINDOW-DRAW-CIRCLE W CENTER (WINDOW-CIRCLE-RADIUS X Y CENTER) 1)) + + + +(DEFUN WINDOW-GET-ELLIPSE (W &OPTIONAL CENTER) + (LET (CIR RADIUSX PT) + (SETQ CIR (WINDOW-GET-CIRCLE W CENTER)) + (SETQ CENTER (CAR CIR)) + (SETQ RADIUSX (CADR CIR)) + (SETQ PT + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-ELLIPSE-PT + (LIST CENTER RADIUSX))) + (LIST CENTER (LIST RADIUSX (ABS (- (CADR PT) (CADR CENTER))))))) + +(DEFUN WINDOW-DRAW-ELLIPSE-PT (W X Y CENTER RADIUSX) + (declare (ignore x)) + (WINDOW-DRAW-ELLIPSE-XY W (CAR CENTER) (CADR CENTER) RADIUSX + (ABS (- Y (CADR CENTER))))) + +(DEFUN WINDOW-DRAW-VECTOR-PT (W X Y CENTER RADIUS) + (LET (DX DY THETA) + (SETQ DY (- Y (CADR CENTER))) + (SETQ DX (- X (CAR CENTER))) + (WHEN (OR (/= DX 0) (/= DY 0)) + (SETQ THETA (ATAN (- Y (CADR CENTER)) (- X (CAR CENTER)))) + (WINDOW-DRAW-LINE-XY W (CAR CENTER) (CADR CENTER) + (+ (CAR CENTER) (* RADIUS (COS THETA))) + (+ (CADR CENTER) (* RADIUS (SIN THETA))))))) + + + +(DEFUN WINDOW-GET-VECTOR-END (W CENTER RADIUS) + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-VECTOR-PT + (LIST CENTER RADIUS))) + + + +(DEFUN WINDOW-GET-CROSSHAIRS (W) + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CROSSHAIRS-XY NIL)) + +(DEFUN WINDOW-DRAW-CROSSHAIRS-XY (W X Y) + (WINDOW-DRAW-LINE-XY W (- X 12) Y (- X 3) Y) + (WINDOW-DRAW-LINE-XY W (+ X 3) Y (+ X 12) Y) + (WINDOW-DRAW-LINE-XY W X (- Y 12) X (- Y 3)) + (WINDOW-DRAW-LINE-XY W X (+ Y 3) X (+ Y 12))) + + + +(DEFUN WINDOW-GET-CROSS (W) + (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CROSS-XY NIL)) + +(DEFUN WINDOW-DRAW-CROSS-XY (W X Y) + (WINDOW-DRAW-LINE-XY W (- X 10) (- Y 10) (+ X 10) (+ Y 10) 2) + (WINDOW-DRAW-LINE-XY W (+ X 10) (- Y 10) (- X 10) (+ Y 10) 2)) + +(DEFUN WINDOW-DRAW-DOT-XY (W X Y) + (WINDOW-DRAW-CIRCLE-XY W X Y 1) + (WINDOW-DRAW-CIRCLE-XY W X Y 2) + (WINDOW-DRAW-LINE-XY W X Y (+ X 1) Y 1)) + +(DEFUN WINDOW-DRAW-LATEX-XY (W X Y ORGX ORGY FLG) + (LET (DX DY DELX DELY N RATIO CD NRAT) + (SETQ DX (- X ORGX)) + (SETQ DY (- Y ORGY)) + (IF (OR (= DX 0) (= DY 0)) (WINDOW-DRAW-LINE-XY W X Y ORGX ORGY) + (PROGN + (SETQ N (IF FLG 4 6)) + (IF (> (ABS DY) (ABS DX)) + (PROGN + (SETQ RATIO (ROUND (/ (* (ABS DX) N) (ABS DY)))) + (SETQ CD (GCD N RATIO)) + (SETQ N (/ N CD)) + (SETQ RATIO (/ RATIO CD)) + (SETQ NRAT (ROUND (/ (ABS DY) N))) + (SETQ DELY (* (SIGNUM DY) NRAT N)) + (SETQ DELX (* (SIGNUM DX) NRAT RATIO))) + (PROGN + (SETQ RATIO (ROUND (/ (* (ABS DY) N) (ABS DX)))) + (SETQ CD (GCD N RATIO)) + (SETQ N (/ N CD)) + (SETQ RATIO (/ RATIO CD)) + (SETQ NRAT (ROUND (/ (ABS DX) N))) + (SETQ DELX (* (SIGNUM DX) NRAT N)) + (SETQ DELY (* (SIGNUM DY) NRAT RATIO)))) + (WINDOW-DRAW-LINE-XY W (+ ORGX DELX) (+ ORGY DELY) ORGX ORGY))))) + +(DEFUN WINDOW-RESET-COLOR (W) + (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) *DEFAULT-FG-COLOR*) + (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) *DEFAULT-BG-COLOR*)) + +(DEFUN WINDOW-SET-COLOR-RGB (W R G B &OPTIONAL BACKGROUND) + (LET (RET) + (OR *WINDOW-XCOLOR* (SETQ *WINDOW-XCOLOR* (MAKE-XCOLOR))) + (SET-XCOLOR-RED *WINDOW-XCOLOR* (+ R 0)) + (SET-XCOLOR-GREEN *WINDOW-XCOLOR* (+ G 0)) + (SET-XCOLOR-BLUE *WINDOW-XCOLOR* (+ B 0)) + (SETQ RET + (XALLOCCOLOR *WINDOW-DISPLAY* *DEFAULT-COLORMAP* + *WINDOW-XCOLOR*)) + (IF (NOT (EQL RET 0)) + (WINDOW-SET-XCOLOR W *WINDOW-XCOLOR* BACKGROUND)))) + +(DEFUN WINDOW-SET-XCOLOR (W &OPTIONAL XCOLOR BACKGROUND) + (IF BACKGROUND (WINDOW-SET-BACKGROUND W (XCOLOR-PIXEL XCOLOR)) + (WINDOW-SET-FOREGROUND W (XCOLOR-PIXEL XCOLOR))) + XCOLOR) + +(DEFUN WINDOW-SET-COLOR (W RGB &OPTIONAL BACKGROUND) + (WINDOW-SET-COLOR-RGB W (FIRST RGB) (SECOND RGB) (THIRD RGB) + BACKGROUND)) + +(DEFUN WINDOW-FREE-COLOR (W &OPTIONAL XCOLOR) + (declare (ignore w)) + (OR XCOLOR (SETQ XCOLOR *WINDOW-XCOLOR*)) + (IF XCOLOR + (UNLESS (OR (EQL XCOLOR *DEFAULT-FG-COLOR*) + (EQL XCOLOR *DEFAULT-BG-COLOR*)) + (XFREECOLORS *WINDOW-DISPLAY* *DEFAULT-COLORMAP* XCOLOR 1 0)))) + +(DEFUN WINDOW-GET-CHARS (W FN &OPTIONAL ARGS) + (LET (WIN RES) + (OR *WINDOW-KEYINIT* (WINDOW-INIT-KEYMAP)) + (SETQ *WINDOW-SHIFT* NIL) + (SETQ *WINDOW-CTRL* NIL) + (SETQ *WINDOW-META* NIL) + (SETQ WIN (WINDOW-PARENT W)) + (XSYNC *WINDOW-DISPLAY* 1) + (XSELECTINPUT *WINDOW-DISPLAY* WIN + (+ KEYPRESSMASK KEYRELEASEMASK BUTTONPRESSMASK)) + (WHILE (NULL RES) (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) + (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) + (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) + (IF (EQL EVENTWINDOW WIN) + (SETQ RES (WINDOW-PROCESS-CHAR-EVENT W TYPE FN ARGS))))) + RES)) + +(DEFUN WINDOW-PROCESS-CHAR-EVENT (W TYPE FN ARGS) + (LET (CODE) + (IF (EQL TYPE KEYRELEASE) + (PROGN + (SETQ CODE (XBUTTONEVENT-BUTTON *WINDOW-EVENT*)) + (IF (MEMBER CODE *WINDOW-SHIFT-KEYS*) + (SETQ *WINDOW-SHIFT* NIL) + (IF (MEMBER CODE *WINDOW-CONTROL-KEYS*) + (SETQ *WINDOW-CTRL* NIL) + (IF (MEMBER CODE *WINDOW-META-KEYS*) + (SETQ *WINDOW-META* NIL))))) + (IF (EQL TYPE KEYPRESS) + (PROGN + (SETQ CODE (XBUTTONEVENT-BUTTON *WINDOW-EVENT*)) + (IF (MEMBER CODE *WINDOW-SHIFT-KEYS*) + (PROGN (SETQ *WINDOW-SHIFT* T) NIL) + (IF (MEMBER CODE *WINDOW-CONTROL-KEYS*) + (PROGN (SETQ *WINDOW-CTRL* T) NIL) + (IF (MEMBER CODE *WINDOW-META-KEYS*) + (PROGN (SETQ *WINDOW-META* T) NIL) + (FUNCALL FN W (WINDOW-CHAR-DECODE CODE) 0 0 0 + ARGS))))) + (IF (EQL TYPE BUTTONPRESS) + (FUNCALL FN W 0 (XBUTTONEVENT-BUTTON *WINDOW-EVENT*) + (XMOTIONEVENT-X *WINDOW-EVENT*) + (- (WINDOW-DRAWABLE-HEIGHT W) + (XMOTIONEVENT-Y *WINDOW-EVENT*)) + ARGS)))))) + +(DEFUN WINDOW-CHAR-DECODE (CODE) + (LET (CHAR) + (SETQ CHAR + (AREF (IF *WINDOW-SHIFT* *WINDOW-SHIFTKEYMAP* + *WINDOW-KEYMAP*) + CODE)) + (IF (AND CHAR *WINDOW-CTRL*) + (SETQ CHAR (CODE-CHAR (- (CHAR-CODE (CHAR-UPCASE CHAR)) 64)))) + (IF (AND CHAR *WINDOW-META*) + (SETQ CHAR (CODE-CHAR (+ (CHAR-CODE (CHAR-UPCASE CHAR)) 128)))) + (OR CHAR #\Space))) + +(DEFUN WINDOW-GET-RAW-CHAR (W) + (LET (WIN RES) + (OR *WINDOW-KEYINIT* (WINDOW-INIT-KEYMAP)) + (SETQ *WINDOW-SHIFT* NIL) + (SETQ *WINDOW-CTRL* NIL) + (SETQ *WINDOW-META* NIL) + (SETQ WIN (WINDOW-PARENT W)) + (XSYNC *WINDOW-DISPLAY* 1) + (XSELECTINPUT *WINDOW-DISPLAY* WIN (+ KEYPRESSMASK KEYRELEASEMASK)) + (WHILE (NULL RES) (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) + (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) + (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) + (IF (AND (EQL EVENTWINDOW WIN) (EQL TYPE KEYPRESS)) + (SETQ RES (XBUTTONEVENT-BUTTON *WINDOW-EVENT*))))) + RES)) + +(DEFUN WINDOW-INPUT-STRING (W STR X Y &OPTIONAL SIZE) + (CAR (WINDOW-EDIT W X Y (OR SIZE 100) 16 (LIST (OR STR "")) NIL T T))) + +(DEFUN WINDOW-EDIT + (W X Y WIDTH HEIGHT &OPTIONAL STRINGS BOXFLG SCROLL ENDP) + (LET (EM) + (SETQ EM + (EDITMENU-CREATE WIDTH HEIGHT NIL W X Y NIL T '9X15 BOXFLG + STRINGS SCROLL ENDP)) + (EDITMENU-EDIT EM) + (EDITMENU-CARAT EM) + (NTH 10 EM))) + + + +(DEFUN EDITMENU-CREATE + (WIDTH HEIGHT &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT BOXFLG + INITIAL-TEXT SCROLLVAL ENDP) + (LIST 'EDITMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) + (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM + (OR INITIAL-TEXT (LIST "")) WIDTH HEIGHT BOXFLG (OR FONT '9X15) + (IF ENDP + (LENGTH (NTH (IF (NUMBERP SCROLLVAL) SCROLLVAL 0) + INITIAL-TEXT)) + 0) + (IF (NUMBERP SCROLLVAL) SCROLLVAL 0) (OR SCROLLVAL 0))) + +(DEFUN EDITMENU-CALCULATE-SIZE (M) + (SETF (SEVENTH M) (NTH 11 M)) + (SETF (EIGHTH M) (NTH 12 M))) + +(DEFUN EDITMENU-INIT (M) + (EDITMENU-CALCULATE-SIZE M) + (MENU-ADJUST-OFFSET M) + (IF (NOT (CADDR M)) + (SETF (CADR M) + (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") + (CADDDR M) (FIFTH M) (SIXTH M) (NTH 14 M))))) + +(DEFUN EDITMENU-DRAW (M) + (LET (MW XZERO YZERO) + (OR (AND (CADR M) (PLUSP (EIGHTH M))) (EDITMENU-INIT M)) + (SETQ MW (CADR M)) + (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE MW) + (MENU-CLEAR M) + (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) + (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) + (IF (NTH 13 M) + (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) + (EDITMENU-DISPLAY M 0 0 (NOT (NUMBERP (NTH 17 M)))))) + +(DEFUN EDITMENU-DISPLAY (M LINE CHAR ONLY) + (LET (LINES Y MAXWIDTH LINEWIDTH (W (OR (CADR M) (EDITMENU-INIT M)))) + (SETQ LINES (NTHCDR LINE (NTH 10 M))) + (SETQ Y + (+ (IF (CADDR M) (SIXTH M) 0) + (- (EIGHTH M) + (1- (* (WINDOW-STRING-HEIGHT + (OR (CADR M) (EDITMENU-INIT M)) "Tg") + (1+ (- (- LINE + (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)) + (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)))))))) + (SETQ MAXWIDTH + (TRUNCATE (+ -6 (SEVENTH M)) + (LET ((SSTR (STRINGIFY "W"))) + (XTEXTWIDTH (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) + (GET-C-STRING SSTR) (LENGTH SSTR))))) + (WHILE (AND LINES (>= Y (+ 4 (IF (CADDR M) (SIXTH M) 0)))) + (IF (< CHAR MAXWIDTH) + (IF (PLUSP CHAR) + (LET ((SSTR (STRINGIFY + (SUBSEQ (FIRST LINES) CHAR + (MIN MAXWIDTH + (LENGTH (FIRST LINES))))))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) + (CADDR W) + (+ (IF (CADDR M) (FIFTH M) 0) + (+ 2 + (* CHAR + (LET ((SSTR (STRINGIFY "W"))) + (XTEXTWIDTH + (SEVENTH + (OR (CADR M) (EDITMENU-INIT M))) + (GET-C-STRING SSTR) (LENGTH SSTR)))))) + (- (CADDDR W) Y) (GET-C-STRING SSTR) + (LENGTH SSTR))) + (LET ((SSTR (STRINGIFY + (IF + (<= (LENGTH (FIRST LINES)) + MAXWIDTH) + (FIRST LINES) + (SUBSEQ (FIRST LINES) 0 MAXWIDTH))))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) + (CADDR W) (+ 2 (IF (CADDR M) (FIFTH M) 0)) + (- (CADDDR W) Y) (GET-C-STRING SSTR) + (LENGTH SSTR))))) + (SETQ LINEWIDTH + (+ 2 + (* (LET ((SSTR (STRINGIFY "W"))) + (XTEXTWIDTH + (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) + (GET-C-STRING SSTR) (LENGTH SSTR))) + (LENGTH (FIRST LINES))))) + (WINDOW-ERASE-AREA-XY W + (+ (IF (CADDR M) (FIFTH M) 0) LINEWIDTH) (+ -2 Y) + (+ -2 (- (SEVENTH M) LINEWIDTH)) + (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) + "Tg")) + (DECF Y + (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) + "Tg")) + (IF ONLY (SETQ LINES NIL) + (PROGN + (POP LINES) + (IF (AND (NULL LINES) + (>= Y (+ 4 (IF (CADDR M) (SIXTH M) 0)))) + (WINDOW-ERASE-AREA-XY W + (+ 2 (IF (CADDR M) (FIFTH M) 0)) (+ -2 Y) + (+ -4 (SEVENTH M)) + (WINDOW-STRING-HEIGHT + (OR (CADR M) (EDITMENU-INIT M)) "Tg"))))) + (SETQ CHAR 0)) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN EDITMENU-CARAT (M) + (WINDOW-DRAW-CARAT (OR (CADR M) (EDITMENU-INIT M)) + (+ (IF (CADDR M) (FIFTH M) 0) + (+ 2 + (* (NTH 15 M) + (LET ((SSTR (STRINGIFY "W"))) + (XTEXTWIDTH (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) + (GET-C-STRING SSTR) (LENGTH SSTR)))))) + (+ -2 + (+ (IF (CADDR M) (SIXTH M) 0) + (- (EIGHTH M) + (1- (* (WINDOW-STRING-HEIGHT + (OR (CADR M) (EDITMENU-INIT M)) "Tg") + (1+ (- (NTH 16 M) + (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0))))))))) + (XFLUSH *WINDOW-DISPLAY*)) + +(DEFUN EDITMENU-ERASE (M ONEP) + (LET ((W (OR (CADR M) (EDITMENU-INIT M))) XW) + (SETQ XW + (+ 2 + (* (LET ((SSTR (STRINGIFY "W"))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) + (LENGTH SSTR))) + (NTH 15 M)))) + (LET ((GLVAR423 (WINDOW-STRING-HEIGHT W "Tg"))) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) + (+ (IF (CADDR M) (FIFTH M) 0) XW) + (- (CADDDR W) + (1- (+ (- (+ (IF (CADDR M) (SIXTH M) 0) + (- (EIGHTH M) + (1- (* (WINDOW-STRING-HEIGHT + (OR (CADR M) (EDITMENU-INIT M)) + "Tg") + (1+ + (- (NTH 16 M) + (IF (NUMBERP (NTH 17 M)) + (NTH 17 M) 0))))))) + (CADR (LET ((SSTR (STRINGIFY "Tg"))) + (XTEXTEXTENTS (SEVENTH W) + (GET-C-STRING SSTR) (LENGTH SSTR) + *DIRECTION-RETURN* *ASCENT-RETURN* + *DESCENT-RETURN* *OVERALL-RETURN*) + (LIST (INT-POS *ASCENT-RETURN* 0) + (INT-POS *DESCENT-RETURN* 0))))) + GLVAR423))) + (IF ONEP + (LET ((SSTR (STRINGIFY "W"))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) + (LENGTH SSTR))) + (- (SEVENTH M) XW)) + GLVAR423 0)) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN EDITMENU-LINE-Y (M LINE) + (+ (IF (CADDR M) (SIXTH M) 0) + (- (EIGHTH M) + (1- (* (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) + "Tg") + (1+ (- LINE (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)))))))) + +(DEFUN EDITMENU-SELECT (M &OPTIONAL INSIDE) + (declare (ignore inside)) + (LET (MW CODEVAL XVAL YVAL) + (SETQ MW (OR (CADR M) (EDITMENU-INIT M))) + (IF (NOT (TENTH M)) (EDITMENU-DRAW M)) + (WINDOW-TRACK-MOUSE MW + #'(LAMBDA (X Y CODE) + (SETQ *WINDOW-MENU-CODE* CODE) + (WHEN (OR (PLUSP CODE) (< X (FIFTH M)) + (> X (+ (FIFTH M) (SEVENTH M))) (< Y (SIXTH M)) + (> Y (+ (SIXTH M) (EIGHTH M)))) + (SETQ CODEVAL CODE) + (SETQ XVAL X) + (SETQ YVAL Y))) + T) + (IF (PLUSP CODEVAL) (EDITMENU-EDIT M CODEVAL XVAL YVAL)))) + +(DEFVAR *WINDOW-EDITMENU-KILL-STRINGS* NIL) + +(DEFUN EDITMENU-EDIT (M &OPTIONAL CODE X Y) + (LET ((MW (OR (CADR M) (EDITMENU-INIT M)))) + (EDITMENU-DRAW M) + (EDITMENU-CARAT M) + (IF CODE (EDITMENU-EDIT-FN MW NIL CODE X Y (LIST M))) + (SETQ *WINDOW-EDITMENU-KILL-STRINGS* NIL) + (WINDOW-GET-CHARS MW #'EDITMENU-EDIT-FN (LIST M)) + (NTH 10 M))) + +(DEFUN EDITMENU-EDIT-FN (W CHAR BUTTON BUTTONX BUTTONY ARGS) + (declare (ignore w)) + (LET (M INSIDE DONE) + (SETQ M (CAR ARGS)) + (EDITMENU-CARAT M) + (IF (AND (NUMBERP BUTTON) (NOT (ZEROP BUTTON))) + (PROGN + (SETQ INSIDE (EDITMENU-SETXY M BUTTONX BUTTONY)) + (CASE BUTTON + (1 (IF INSIDE (PROGN (EDITMENU-CARAT M) NIL) T)) + (2 (WHEN INSIDE (EDITMENU-YANK M) (EDITMENU-CARAT M) NIL)))) + (PROGN + (IF (< (CHAR-CODE CHAR) 32) + (CASE CHAR + (#\Return + (IF (NUMBERP (NTH 17 M)) (EDITMENU-RETURN M) + (SETQ DONE T))) + (#\Backspace (EDITMENU-BACKSPACE M)) + (#\^D (EDITMENU-DELETE M)) + (#\^N (IF (NUMBERP (NTH 17 M)) (EDITMENU-NEXT M))) + (#\^P (EDITMENU-PREVIOUS M)) + (#\^F (EDITMENU-FORWARD M)) + (#\^B (EDITMENU-BACKWARD M)) + (#\^A (EDITMENU-BEGINNING M)) + (#\^E (EDITMENU-END M)) + (#\^K (EDITMENU-KILL M)) + (#\^Y (EDITMENU-YANK M)) + (T NIL)) + (IF (> (CHAR-CODE CHAR) 128) + (PROGN + (SETQ CHAR (CODE-CHAR (+ -128 (CHAR-CODE CHAR)))) + (CASE CHAR + (#\B (EDITMENU-META-B M)) + (#\F (EDITMENU-META-F M)) + (T NIL))) + (EDITMENU-CHAR M CHAR))) + (EDITMENU-CARAT M) + DONE)))) + +(DEFUN EDITMENU-SETXY (M BUTTONX BUTTONY) + (LET (LINECONS OKAY) + (SETQ OKAY + (AND (>= BUTTONX (FIFTH M)) + (<= BUTTONX (+ (FIFTH M) (SEVENTH M))) + (>= BUTTONY (SIXTH M)) + (<= BUTTONY (+ (SIXTH M) (EIGHTH M))))) + (WHEN OKAY + (SETF (NTH 16 M) + (MIN (1- (LENGTH (NTH 10 M))) + (+ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0) + (TRUNCATE + (- (+ (IF (CADDR M) (SIXTH M) 0) + (+ -6 (EIGHTH M))) + BUTTONY) + (WINDOW-STRING-HEIGHT + (OR (CADR M) (EDITMENU-INIT M)) "Tg"))))) + (SETQ LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) + (SETF (NTH 15 M) + (MIN (LENGTH (CAR LINECONS)) + (TRUNCATE + (+ -2 (- BUTTONX (IF (CADDR M) (FIFTH M) 0))) + (LET ((SSTR (STRINGIFY "W"))) + (XTEXTWIDTH + (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) + (GET-C-STRING SSTR) (LENGTH SSTR))))))) + OKAY)) + +(DEFUN EDITMENU-CHAR (M CHAR) + (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) + (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) + (SETF (CAR LINECONS) + (CONCATENATE 'STRING (CAR LINECONS) (STRING CHAR))) + (SETF (CAR LINECONS) + (CONCATENATE 'STRING (SUBSEQ (CAR LINECONS) 0 (NTH 15 M)) + (STRING CHAR) (SUBSEQ (CAR LINECONS) (NTH 15 M))))) + (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) T) + (INCF (NTH 15 M)))) + +(DEFUN EDITMENU-CURRENT-CHAR (M) + (CHAR (NTH (NTH 16 M) (NTH 10 M)) (NTH 15 M))) + +(DEFUN EDITMENU-RETURN (M) + (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) + (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) + (PUSH "" (CDR LINECONS)) + (PROGN + (PUSH (SUBSEQ (CAR LINECONS) (NTH 15 M)) (CDR LINECONS)) + (SETF (CAR LINECONS) (SUBSEQ (CAR LINECONS) 0 (NTH 15 M))))) + (EDITMENU-DISPLAY M (NTH 16 M) 0 NIL) + (INCF (NTH 16 M)) + (SETF (NTH 15 M) 0))) + +(DEFUN EDITMENU-BACKSPACE (M) + (LET (TMP LINEDEL (LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) + (IF (PLUSP (NTH 15 M)) + (PROGN + (DECF (NTH 15 M)) + (SETF (CAR LINECONS) + (CONCATENATE 'STRING + (SUBSEQ (CAR LINECONS) 0 (NTH 15 M)) + (SUBSEQ (CAR LINECONS) (1+ (NTH 15 M)))))) + (WHEN (PLUSP (NTH 16 M)) + (DECF (NTH 16 M)) + (SETQ LINEDEL T) + (SETQ LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) + (SETF (NTH 15 M) (LENGTH (CAR LINECONS))) + (SETQ TMP + (CONCATENATE 'STRING (CAR LINECONS) (CADR LINECONS))) + (SETF (CDR LINECONS) (CDDR LINECONS)) + (SETF (CAR LINECONS) TMP))) + (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) (NOT LINEDEL)))) + +(DEFUN EDITMENU-END (M) + (SETF (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) + +(DEFUN EDITMENU-BEGINNING (M) (SETF (NTH 15 M) 0)) + +(DEFUN EDITMENU-FORWARD (M) + (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) + (IF (< (NTH 15 M) (LENGTH (CAR LINECONS))) (INCF (NTH 15 M)) + (WHEN (NUMBERP (NTH 17 M)) + (INCF (NTH 16 M)) + (IF (NULL (CDR LINECONS)) (SETF (CDR LINECONS) (LIST ""))) + (SETF (NTH 15 M) 0))))) + +(DEFUN EDITMENU-META-F (M) + (LET (FOUND DONE) + (WHILE (AND (OR (< (NTH 16 M) (1- (LENGTH (NTH 10 M)))) + (< (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) + (NOT FOUND)) + (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) + (SETQ FOUND T) (EDITMENU-FORWARD M))) + (IF FOUND + (WHILE (AND (OR (< (NTH 16 M) (1- (LENGTH (NTH 10 M)))) + (< (NTH 15 M) + (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) + (NOT DONE)) + (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) + (EDITMENU-FORWARD M) (SETQ DONE T)))))) + +(DEFUN EDITMENU-ALPHANUMBERICP (X) + (OR (ALPHA-CHAR-P X) (NOT (NULL (DIGIT-CHAR-P X))))) + +(DEFUN EDITMENU-NEXT (M) + (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) + (INCF (NTH 16 M)) + (IF (NULL (CDR LINECONS)) (SETF (CDR LINECONS) (LIST ""))) + (SETQ LINECONS (CDR LINECONS)) + (SETF (NTH 15 M) (MIN (NTH 15 M) (LENGTH (CAR LINECONS)))))) + +(DEFUN EDITMENU-BACKWARD (M) + (IF (PLUSP (NTH 15 M)) (DECF (NTH 15 M)) + (WHEN (PLUSP (NTH 16 M)) + (DECF (NTH 16 M)) + (SETF (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))))) + +(DEFUN EDITMENU-META-B (M) + (LET (FOUND DONE) + (WHILE (AND (OR (PLUSP (NTH 15 M)) (PLUSP (NTH 16 M))) (NOT FOUND)) + (EDITMENU-BACKWARD M) + (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) + (SETQ FOUND T))) + (WHEN FOUND + (WHILE (AND (OR (PLUSP (NTH 15 M)) (PLUSP (NTH 16 M))) + (NOT DONE)) + (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) + (EDITMENU-BACKWARD M) (SETQ DONE T))) + (UNLESS (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) + (EDITMENU-FORWARD M))))) + +(DEFUN EDITMENU-PREVIOUS (M) + (WHEN (PLUSP (NTH 16 M)) + (DECF (NTH 16 M)) + (SETF (NTH 15 M) + (MIN (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))))) + +(DEFUN EDITMENU-DELETE (M) + (EDITMENU-FORWARD M) + (EDITMENU-BACKSPACE M)) + +(DEFUN EDITMENU-KILL (M) + (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) + (IF (< (NTH 15 M) (LENGTH (CAR LINECONS))) + (PROGN + (SETQ *WINDOW-EDITMENU-KILL-STRINGS* + (LIST (SUBSEQ (CAR LINECONS) (NTH 15 M)))) + (SETF (CAR LINECONS) (SUBSEQ (CAR LINECONS) 0 (NTH 15 M))) + (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) T)) + (EDITMENU-DELETE M)))) + +(DEFUN EDITMENU-YANK (M) + (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) (COL (NTH 15 M))) + (WHEN *WINDOW-EDITMENU-KILL-STRINGS* + (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) + (PROGN + (SETF (CAR LINECONS) + (CONCATENATE 'STRING (CAR LINECONS) + (CAR *WINDOW-EDITMENU-KILL-STRINGS*))) + (SETF (NTH 15 M) (LENGTH (CAR LINECONS)))) + (PROGN + (SETF (CAR LINECONS) + (CONCATENATE 'STRING (SUBSEQ (CAR LINECONS) 0 COL) + (CAR *WINDOW-EDITMENU-KILL-STRINGS*) + (SUBSEQ (CAR LINECONS) COL))) + (INCF (NTH 15 M) + (LENGTH (CAR *WINDOW-EDITMENU-KILL-STRINGS*))))) + (EDITMENU-DISPLAY M (NTH 16 M) COL T)))) + +(DEFUN WINDOW-DRAW-CARAT (W X Y) + (WINDOW-SET-XOR W) + (WINDOW-DRAW-LINE-XY W (- X 5) (- Y 2) X Y) + (WINDOW-DRAW-LINE-XY W X Y (+ X 5) (- Y 2)) + (WINDOW-UNSET W) + (WINDOW-FORCE-OUTPUT W)) + +(DEFUN WINDOW-INIT-KEYMAP () + (LET (MINCODE MAXCODE KEYCODE KEYSYM KEYNUM SHIFTKEYNUM CHAR) + (XDISPLAYKEYCODES *WINDOW-DISPLAY* *MIN-KEYCODES-RETURN* + *MAX-KEYCODES-RETURN*) + (SETQ MINCODE (INT-POS *MIN-KEYCODES-RETURN* 0)) + (SETQ MAXCODE (INT-POS *MAX-KEYCODES-RETURN* 0)) + (SETQ *WINDOW-KEYMAP* + (MAKE-ARRAY (1+ MAXCODE) :INITIAL-ELEMENT NIL)) + (SETQ *WINDOW-SHIFTKEYMAP* + (MAKE-ARRAY (1+ MAXCODE) :INITIAL-ELEMENT NIL)) + (SETQ *WINDOW-SHIFT-KEYS* NIL) + (SETQ *WINDOW-CONTROL-KEYS* NIL) + (SETQ *WINDOW-META-KEYS* NIL) + (DOTIMES (I (1+ (- MAXCODE MINCODE))) + (SETQ KEYCODE (+ I MINCODE)) + (SETQ KEYSYM + (XGETKEYBOARDMAPPING *WINDOW-DISPLAY* KEYCODE 1 + *KEYCODES-RETURN*)) + (SETQ KEYNUM (FIXNUM-POS KEYSYM 0)) + (SETQ SHIFTKEYNUM (FIXNUM-POS KEYSYM 1)) + (IF (AND (>= KEYNUM 65) (<= KEYNUM 90) + (EQL SHIFTKEYNUM NOSYMBOL)) + (PROGN + (SETQ SHIFTKEYNUM KEYNUM) + (SETQ KEYNUM (+ KEYNUM 32)))) + (IF (> KEYNUM 0) + (IF (SETQ CHAR (WINDOW-CODE-CHAR KEYNUM)) + (SETF (AREF *WINDOW-KEYMAP* KEYCODE) CHAR) + (IF (> KEYNUM 256) + (COND + ((OR (EQL KEYNUM XK_SHIFT_R) + (EQL KEYNUM XK_SHIFT_L)) + (PUSH KEYCODE *WINDOW-SHIFT-KEYS*)) + ((OR (EQL KEYNUM XK_CONTROL_L) + (EQL KEYNUM XK_CONTROL_R)) + (PUSH KEYCODE *WINDOW-CONTROL-KEYS*)) + ((OR (EQL KEYNUM XK_ALT_R) (EQL KEYNUM XK_ALT_L)) + (PUSH KEYCODE *WINDOW-META-KEYS*)))))) + (IF (> SHIFTKEYNUM 0) + (IF (SETQ CHAR (WINDOW-CODE-CHAR SHIFTKEYNUM)) + (SETF (AREF *WINDOW-SHIFTKEYMAP* KEYCODE) CHAR)))) + (SETQ *WINDOW-KEYINIT* T))) + +(DEFUN WINDOW-CODE-CHAR (CODE) + (IF (> CODE 0) + (IF (< CODE 256) (CODE-CHAR CODE) + (COND + ((EQL CODE XK_RETURN) #\Return) + ((EQL CODE XK_TAB) #\Tab) + ((EQL CODE XK_BACKSPACE) #\Backspace))))) + + + + diff --git a/xgcl-2/gcl_editors.lsp b/xgcl-2/gcl_editors.lsp new file mode 100644 index 0000000..5dacb57 --- /dev/null +++ b/xgcl-2/gcl_editors.lsp @@ -0,0 +1,483 @@ +; editors.lsp Gordon S. Novak Jr. ; 08 Dec 08 + +; Copyright (c) 2008 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 13 Apr 95; 02 Jan 97; 28 Feb 02; 08 Jan 04; 03 Mar 04; 26 Jan 06; 27 Jan 06 + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Graphical editor functions + +; (edit-thermom 75 myw 20 20 150 250) +; (window-draw-thermometer myw 0 20 5 50 50 50 232) +; (window-adjust-thermometer myw 0 20 5 50 50 50 232) + +; 20 Nov 91; 03 Dec 91; 27 Dec 91; 26 Dec 93; 28 Feb 02; 08 Jan 04 +; Edit an integer with a thermometer-like display +(gldefun edit-thermom ((num number) (w window) + &optional (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (prog (nmin ndel ndiv range pten drange pair neww (res num) off) + (if ~ sizex (progn (sizex = 150) (sizey = 250))) + (if ~ offsetx + (progn (off = (centeroffset w (a vector with x = sizex y = sizey))) + (offsetx = (x off)) + (offsety = (y off)))) + (neww = (window-create sizex sizey nil (parent w) offsetx offsety)) + (window-draw-button neww "Typein" 80 20 50 25) + (window-draw-button neww "Adjust" 80 70 50 25) + (window-draw-button neww "Done" 80 120 50 25) + rn (range = (abs res) * 2) + (if (range == 0) (range = 50)) + (if ((range < 8) and (integerp num)) (range = 10)) + (pten = (expt 10 (truncate (log range 10)))) + (drange = (range * 10) / pten) + (setq pair (car (some #'(lambda (x) (> (car x) drange)) + '((14 2) (20 4) (40 5) (70 10) (101 20))))) + (setq ndel ((cadr pair) * pten / 10)) + (setq ndiv (ceiling (range / ndel))) + (setq nmin (if (>= res 0) + 0 + (- ndel * ndiv))) + (window-draw-thermometer neww nmin ndel ndiv res 10 10 (sizey - 20)) + lp (case (button-select neww '((done (84 124) (42 17)) + (adjust (84 74) (42 17)) + (typein (84 24) (42 17)))) + (done (destroy neww) (return res)) + (adjust (setq res (window-adjust-thermometer neww nmin ndel ndiv res + 10 10 (sizey - 20))) + (go lp)) + (typein (princ "Enter new value: ") + (setq res (read)) + (if ((res >= nmin) and (res <= (nmin + ndel * ndiv))) + (progn (window-set-thermometer neww nmin ndel ndiv res + 10 10 (sizey - 20)) + (go lp)) + (go rn)) ) ) )) + +; 20 Nov 91; 04 Dec 91 +; Draw a button-like icon +(gldefun window-draw-button ((w window) (s string) + (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (let (sw) + (erase-area-xy w offsetx offsety sizex sizey 8) + (draw-rcbox-xy w offsetx offsety sizex sizey 8) + (sw = (string-width w s)) + (printat-xy w s (offsetx + (sizex - sw) / 2) (offsety + 8)) + (force-output w))) + +; 17 Dec 91 +; Print in the center of a specified region +(gldefun window-center-print ((w window) (s string) + (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (let (sw) + (erase-area-xy w offsetx offsety sizex sizey 8) + (sw = (string-width w s)) + (printat-xy w s (offsetx + (sizex - sw) / 2) + (offsety + (sizey - 10) / 2) ) + (force-output w))) + +; 20 Nov 91; 03 Dec 91; 26 Dec 93 +; Draw a thermometer-like icon +(gldefun window-draw-thermometer ((w window) (nmin integer) (ndel integer) + (ndiv integer) (val number) + (offsetx integer) (offsety integer) + (sizey integer)) + (let (hdel marky) + (erase-area-xy w offsetx offsety 66 sizey) + (editors-print-in-box val w offsetx offsety 40 20) + (draw-arc-xy w (offsetx + 12) (offsety + 36) 12 12 132 276) + (draw-line-xy w (offsetx + 4) (offsety + 44) + (offsetx + 4) (offsety + sizey - 8) ) + (draw-line-xy w (offsetx + 20) (offsety + 44) + (offsetx + 20) (offsety + sizey - 8) ) + (draw-arc-xy w (offsetx + 12) (offsety + sizey - 8) 8 8 0 180) + (draw-circle-xy w (offsetx + 12) (offsety + 36) 4 7) + (hdel = (sizey - 56) / ndiv) + (draw-line-xy w (offsetx + 12) (offsety + 35) + (offsetx + 12) + (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) + (dotimes (i (1+ ndiv)) + (marky = (offsety + 48 + i * hdel)) + (draw-line-xy w (offsetx + 24) marky (offsetx + 34) marky) + (printat-xy w (nmin + i * ndel) (offsetx + 36) (marky - 6)) ) + (force-output w))) + + +; 20 Nov 91; 03 Dec 91; 13 Apr 95 +; Draw value for a thermometer-like icon +(gldefun window-set-thermometer ((w window) (nmin integer) (ndel integer) + (ndiv integer) (val number) + (offsetx integer) (offsety integer) + (sizey integer)) + (let (hdel) + (hdel = (sizey - 56) / ndiv) + (erase-area-xy w (offsetx + 7) (offsety + 48) + 10 (sizey - 56)) + (draw-line-xy w (offsetx + 12) (offsety + 35) + (offsetx + 12) + (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) + (editors-update-in-box val w offsetx offsety 40 20)))) + + +; 20 Nov 91; 03 Dec 91; 15 Oct 93; 02 Dec 93; 08 Jan 04 +; Adjust a thermometer-like icon with the mouse. Returns new value. +(gldefun window-adjust-thermometer ((w window) (nmin integer) (ndel integer) + (ndiv integer) (val number) + (offsetx integer) (offsety integer) + (sizey integer)) + (let (hdel (lasty integer) xmin xmax ymin ymax inside (newval number)) + (hdel = (sizey - 56) / ndiv) + (lasty = (truncate (offsety + 48 + hdel * ((val - nmin) / ndel)))) + (xmin = offsetx + 4) + (xmax = offsetx + 20) + (ymin = offsety + 48) + (ymax = offsety + sizey - 8) + (window-track-mouse w + #'(lambda (x y code) + (inside = (and (>= x xmin) (<= x xmax) + (>= y ymin) (<= y ymax))) + (when (and inside (/= y lasty)) + (if (> y lasty) + (draw-line-xy w (offsetx + 12) lasty (offsetx + 12) y 7) + (erase-area-xy w (offsetx + 7) (y + 1) + 10 (- lasty y))) + (lasty = y) + (newval = ( ( (lasty - (offsety + 48)) + / (float hdel)) * ndel) + nmin) + (if (integerp val) (newval = (truncate newval))) + (editors-update-in-box newval w offsetx offsety 40 20)) + (not (zerop code)))) + (if inside + newval + val) )) + +; 20 Nov 91; 15 Oct 93; 08 Jan 04; 26 Jan 06 +; Get a mouse selection from a button area. cf. picmenu-select +(gldefun button-select ((mw window) (buttons (listof picmenu-button))) + (let ((current-button picmenu-button) item items (val picmenu-button) + xzero yzero inside) + (xzero = 0) ; (menu-x m 0) + (yzero = 0) ; (menu-y m 0) + (track-mouse mw + #'(lambda (x y code) + (x = (x - xzero)) + (y = (y - yzero)) + (if ((x >= 0) and (y >= 0)) + (inside = t)) + (if current-button + (if ~ (button-containsxy? current-button x y) + (progn (button-invert mw current-button) + (current-button = nil)))) + (if ~ current-button + (progn (items = buttons) + (while ~ current-button and (item -_ items) do + (if (button-containsxy? item x y) + (progn (current-button = item) + (button-invert mw current-button) ))))) + (if (> code 0) + (progn (if current-button + (button-invert mw current-button) ) + (val = (or current-button *picmenu-no-selection*)) ))) + t) + (if (val <> *picmenu-no-selection*) (buttonname val)) )) + +; 03 Dec 91 +(gldefun button-invert ((w window) (button picmenu-button)) + (window-invert-area w (offset button) (size button)) ) + +(gldefun window-undraw-box ((w window) offset size &optional lw) + (set-erase w) + (window-draw-box w offset size lw) + (unset w) ) + +; 20 Nov 91; 08 Jan 04 +(gldefun button-containsxy? ((b picmenu-button) (x integer) (y integer)) + (let ((xsize 6) (ysize 6)) + (if (size b) + (progn (xsize = (x (size b))) + (ysize = (y (size b))))) + ((x >= (x (offset b))) and (x <= ((x (offset b)) + xsize)) and + (y >= (y (offset b))) and (y <= ((y (offset b)) + ysize)) ) )) + + +(glispobjects + +(menu-item (z anything) + prop ((value ((if z is atomic + z + (cdr z)))) ) + msg ((print-size menu-item-print-size) + (draw menu-item-draw)) ) + +) ; glispobjects + +(gldefun menu-item-print-size ((item menu-item) (w window)) + (result vector) + (let (siz) + (if item is atomic + (a vector with x = (string-width w item) y = 11) + (if (car item) is a string + (a vector with x = (string-width w (car item)) y = 11) + (if ((symbolp (car item)) + and (siz = (get (car item) 'display-size))) + siz + (a vector with x = 50 y = 11)))) )) + +; 17 Dec 91; 08 Jan 04 +(gldefun menu-item-draw ((item menu-item) (w window) + (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (if item is atomic + (window-center-print w item offsetx offsety sizex sizey) + (if ((symbolp (car item)) and (fboundp (car item))) + (funcall (car item) w offsetx offsety) + (window-center-print w (car item) offsetx offsety + sizex sizey))) ) + +; 03 Dec 91; 26 Dec 93; 08 Jan 04 +(gldefun pick-one-size ((items (listof menu-item)) (w window)) + (let (wid) + (for item in items do + (wid = (if wid + (max wid (x (print-size item w))) + (x (print-size item w))) ) ) + (a vector with x = wid y = 11) )) + +; 03 Dec 91; 26 Dec 93; 29 Jul 94; 28 Feb 02 +(gldefun draw-pick-one ((items (listof menu-item)) (val anything) (w window) + &optional (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (let (itm) + (if (itm = (that item with (value (that item)) == val)) + (draw itm w offsetx offsety sizex sizey)))) + +; 04 Dec 91; 26 Dec 93; 29 Jul 94; 08 Jan 04 +(gldefun edit-pick-one ((items (listof menu-item)) (val anything) (w window) + &optional (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (let (newval) + (if ((length items) <= 3) + (if (equal val (value (first items))) + (newval = (value (second items))) + (if (equal val (value (second items))) + (newval = (if (third items) + (value (third items)) + (value (first items)))) + (newval = (value (first items))))) + (newval = (menu items)) ) + (draw-pick-one newval w items offsetx offsety sizex sizey) + newval )) + + +; 13 Dec 91; 26 Dec 93; 28 Jul 94; 28 Feb 02; 08 Jan 04 +(gldefun draw-black-white ((items (listof menu-item)) (val anything) (w window) + &optional (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (let (itm) + (erase-area-xy w offsetx offsety sizex sizey) + (if (itm = (that item with (value (that item)) == val)) + (if (eql (if (consp itm) + (car itm) + itm) + 1) + (invert-area-xy w offsetx offsety sizex sizey)) ) )) + +; 13 Dec 91; 15 Dec 91; 26 Dec 93; 28 Jul 94; 08 Jan 04 +(gldefun edit-black-white ((items (listof menu-item)) (val anything) (w window) + &optional (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (let (newval) + (if (equal val (value (first items))) + (newval = (value (second items))) + (if (equal val (value (second items))) + (newval = (value (first items))))) + (draw-black-white items newval w offsetx offsety sizex sizey) + newval )) + +; 23 Dec 91; 26 Dec 93 +(gldefun draw-integer ((val integer) (w window) + &optional (offsetx integer) (offsety integer) + (sizex integer) (sizey integer)) + (editors-anything-print val w offsetx offsety sizex sizey) ) + +; 24 Dec 91; 26 Dec 93 +(defun draw-real (val w &optional offsetx offsety sizex sizey) + (let (str nc lng fmt) + (if (null sizex) (setq sizex 50)) + (setq nc (max 1 (truncate sizex 7))) + (setq str (princ-to-string val)) + (setq lng (length str)) + (if (> lng nc) + (if (or (find #\. str :start nc) + (find #\E str) + (find #\L str)) + (if (>= nc 8) + (progn (setq fmt (cadr (or (assoc nc '((8 "~8,2E") + (9 "~9,2E") (10 "~10,2E") + (11 "~11,2E") (12 "~12,2E") + (13 "~13,2E") (14 "~14,2E"))) + '(15 "~15,2E")))) + (setq str (format nil fmt val))) + (setq str "*******")) + (setq str (subseq str 0 nc)) )) + (editors-anything-print w str offsetx offsety sizex sizey) )) + +; 09 Dec 91; 10 Dec 91; 23 Dec 91; 26 Dec 93; 22 Jul 94 +; Display function for use when a more specific one is not found. +(gldefun editors-anything-print (obj (w window) offsetx offsety sizex sizey) + (let ((s (stringify obj)) swidth smax dx dy) + (erase-area-xy w offsetx offsety sizex sizey) + (swidth = (string-width w s)) + (smax = (min swidth sizex)) + (dx = (sizex - smax) / 2) + (dy = (max 0 ((sizey - 10) / 2))) + (printat-xy w (editors-string-limit obj w smax) + (offsetx + dx) (offsety + dy)) + )) + +; 26 Dec 93 +(gldefun editors-print-in-box (obj (w window) offsetx offsety sizex sizey) + (printat-xy w (editors-string-limit obj w sizex) + (offsetx + 4) (offsety + (sizey - 10) / 2)) + (draw-box-xy w offsetx offsety sizex sizey) ) + +; 26 Dec 93 +(gldefun editors-update-in-box (obj (w window) offsetx offsety sizex sizey) + (erase-area-xy w (offsetx + 3) (offsety + 3) (sizex - 6) (sizey - 6)) + (printat-xy w (editors-string-limit obj w sizex) + (offsetx + 4) (offsety + (sizey - 10) / 2)) ) + +; 28 Oct 91; 26 Dec 93; 08 Jan 04 +; Limit string to a specified number of pixels +(gldefun editors-string-limit ((s string) (w window) (max integer)) + (result string) + (let ((str (stringify s)) (lng integer) (nc integer)) + (lng = (string-width w str)) + (if (lng > max) + (progn (nc = (((length str) * max) / lng)) + (subseq str 0 nc)) + str) )) + +(defvar *edit-color-menu-set* nil) +(defvar *edit-color-rmenu* nil) +(defvar *edit-color-old-color* nil) +(glispglobals (*edit-color-menu-set* menu-set) + (*edit-color-rmenu* barmenu)) + +; 03 Jan 94; 04 Jan 94; 05 Jan 94; 08 Dec 08 +(gldefun edit-color-init ((w window)) + (let (rm gm bm rgb) + (rgb = (a rgb)) + (glcc 'edit-color-red) + (glcc 'edit-color-green) + (glcc 'edit-color-blue) + (*edit-color-menu-set* = (menu-set-create w nil)) + (rm = (barmenu-create 256 200 10 "" nil #'edit-color-red (list rgb) w + 120 40 nil t (a rgb with red = 65535))) + (*edit-color-rmenu* = rm) + (gm = (barmenu-create 256 50 10 "" nil #'edit-color-green (list rgb) w + 170 40 nil t (a rgb with green = 65535))) + (bm = (barmenu-create 256 250 10 "" nil #'edit-color-blue (list rgb) w + 220 40 nil t (a rgb with blue = 65535))) + (add-barmenu *edit-color-menu-set* 'red nil rm "Red" '(120 40)) + (add-barmenu *edit-color-menu-set* 'green nil gm "Green" '(170 40)) + (add-barmenu *edit-color-menu-set* 'blue nil bm "Blue" '(220 40)) + (add-menu *edit-color-menu-set* 'done nil "" '(("Done" . done)) '(30 150)) + (edit-color-red 200 rgb) + (edit-color-green 50 rgb) + (edit-color-blue 250 rgb) + )) + +; 03 Jan 94; 04 Jan 94 +(gldefun edit-color-red ((val integer) (color rgb)) + (let ((w (window *edit-color-menu-set*))) + (printat-xy w (format nil "~3D" val) 113 20) + ((red color) = (max 0 (val * 256 - 1))) + (edit-display-color w color) )) + +; 03 Jan 94; 04 Jan 94 +(gldefun edit-color-green ((val integer) (color rgb)) + (let ((w (window *edit-color-menu-set*))) + (printat-xy w (format nil "~3D" val) 163 20) + ((green color) = (max 0 (val * 256 - 1))) + (edit-display-color w color) )) + +; 03 Jan 94; 04 Jan 94 +(gldefun edit-color-blue ((val integer) (color rgb)) + (let ((w (window *edit-color-menu-set*))) + (printat-xy w (format nil "~3D" val) 213 20) + ((blue color) = (max 0 (val * 256 - 1))) + (edit-display-color w color) )) + +; 03 Jan 94 +(gldefun edit-display-color ((w window) (color rgb)) + (window-set-color w color) + (window-draw-line-xy w 50 40 50 100 60) + (window-reset-color w) + (if *edit-color-old-color* (window-free-color w *edit-color-old-color*)) + (*edit-color-old-color* = *window-xcolor*) ) + +; 03 Jan 94; 04 Jan 94; 05 Jan 94; 28 Feb 02 +(gldefun edit-color ((w window)) + (let (done (color rgb) sel) + (if (or (null *edit-color-menu-set*) + (not (eq w (menu-window (menu (first (menu-items + *edit-color-menu-set*))))))) + (edit-color-init w)) + (color = (first (subtrackparms *edit-color-rmenu*))) + (draw *edit-color-menu-set*) + (edit-color-red (truncate (1+ (red color)) 256) color) + (edit-color-green (truncate (1+ (green color)) 256) color) + (edit-color-blue (truncate (1+ (blue color)) 256) color) + (while ~ done + (sel = (select *edit-color-menu-set*)) + (done = (and sel ((first sel) == 'done))) ) + color)) + +; 08 Dec 08 +(gldefun color-dot ((w window) (x integer) (y integer) (color symbol)) + (let (rgb) + (setq rgb (cdr (assoc color '((red 65535 0 0) + (yellow 65535 57600 0) + (green 0 50175 12287) + (blue 0 0 65535))))) + (or rgb (setq rgb '(30000 30000 30000))) + (set-color w rgb) + (draw-dot-xy w x y) + (reset-color w) )) + +; 15 Oct 93; 26 Jan 06 +; Compile the editors.lsp file into a plain Lisp file +(defun compile-editors () + (glcompfiles *directory* + '("glisp/vector.lsp" ; auxiliary files + "X/dwindow.lsp") + '("glisp/editors.lsp") ; translated files + "glisp/editorstrans.lsp" ; output file + "glisp/gpl.txt") ; header file + (cf editorstrans) ) + +; Compile the editors.lsp file into a plain Lisp file for XGCL +(defun compile-editorsb () + (glcompfiles *directory* + '("glisp/vector.lsp" ; auxiliary files + "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/editors.lsp") ; translated files + "glisp/editorstrans.lsp" ; output file + "glisp/gpl.txt") ; header file + ) diff --git a/xgcl-2/gcl_editorstrans.lsp b/xgcl-2/gcl_editorstrans.lsp new file mode 100644 index 0000000..a93a2e7 --- /dev/null +++ b/xgcl-2/gcl_editorstrans.lsp @@ -0,0 +1,589 @@ +; 07 Jan 2010 16:43:40 EST +; 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 of the License, 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, see . + + +(DEFUN EDIT-THERMOM (NUM W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) + (PROG (NMIN NDEL NDIV RANGE PTEN DRANGE PAIR NEWW (RES NUM) OFF) + (WHEN (NOT SIZEX) (SETQ SIZEX 150) (SETQ SIZEY 250)) + (WHEN (NOT OFFSETX) + (SETQ OFF + (LET ((GLVAR168 (LIST SIZEX SIZEY))) + (LIST (TRUNCATE (- (FIFTH W) (CAR GLVAR168)) 2) + (TRUNCATE (- (CADDDR W) (CADR GLVAR168)) 2)))) + (SETQ OFFSETX (CAR OFF)) + (SETQ OFFSETY (CADR OFF))) + (SETQ NEWW + (WINDOW-CREATE SIZEX SIZEY NIL (CADR W) OFFSETX OFFSETY)) + (WINDOW-DRAW-BUTTON NEWW "Typein" 80 20 50 25) + (WINDOW-DRAW-BUTTON NEWW "Adjust" 80 70 50 25) + (WINDOW-DRAW-BUTTON NEWW "Done" 80 120 50 25) + RN + (SETQ RANGE (* 2 (ABS RES))) + (IF (ZEROP RANGE) (SETQ RANGE 50)) + (IF (AND (< RANGE 8) (INTEGERP NUM)) (SETQ RANGE 10)) + (SETQ PTEN (EXPT 10 (TRUNCATE (LOG RANGE 10)))) + (SETQ DRANGE (/ (* 10 RANGE) PTEN)) + (SETQ PAIR + (CAR (SOME #'(LAMBDA (X) (> (CAR X) DRANGE)) + '((14 2) (20 4) (40 5) (70 10) (101 20))))) + (SETQ NDEL (* 1/10 (* (CADR PAIR) PTEN))) + (SETQ NDIV (CEILING (/ RANGE NDEL))) + (SETQ NMIN (IF (>= RES 0) 0 (- (* NDEL NDIV)))) + (WINDOW-DRAW-THERMOMETER NEWW NMIN NDEL NDIV RES 10 10 + (+ -20 SIZEY)) + LP + (CASE (BUTTON-SELECT NEWW + '((DONE (84 124) (42 17)) (ADJUST (84 74) (42 17)) + (TYPEIN (84 24) (42 17)))) + (DONE (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR NEWW)) + (XFLUSH *WINDOW-DISPLAY*) (SETF (CADR NEWW) NIL) + (XFREEGC *WINDOW-DISPLAY* (CADDR NEWW)) + (SETF (CADDR NEWW) NIL) (RETURN RES)) + (ADJUST (SETQ RES + (WINDOW-ADJUST-THERMOMETER NEWW NMIN NDEL NDIV RES + 10 10 (+ -20 SIZEY))) + (GO LP)) + (TYPEIN (PRINC "Enter new value: ") (SETQ RES (READ)) + (IF (AND (>= RES NMIN) (<= RES (+ NMIN (* NDEL NDIV)))) + (PROGN + (WINDOW-SET-THERMOMETER NEWW NMIN NDEL NDIV RES 10 + 10 (+ -20 SIZEY)) + (GO LP)) + (GO RN)))))) +(SETF (GET 'EDIT-THERMOM 'GLARGUMENTS) + '((NUM NUMBER) (W WINDOW) (&OPTIONAL INTEGER) (OFFSETX INTEGER) + (OFFSETY INTEGER) (SIZEX INTEGER))) +(SETF (GET 'EDIT-THERMOM 'GLFNRESULTTYPE) 'NUMBER) + + +(DEFUN WINDOW-DRAW-BUTTON (W S OFFSETX OFFSETY SIZEX SIZEY) + (LET (SW) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX + (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) + (WINDOW-DRAW-RCBOX-XY W OFFSETX OFFSETY SIZEX SIZEY 8) + (SETQ SW + (LET ((SSTR (STRINGIFY S))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) + (LET ((SSTR (STRINGIFY S))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) + (+ OFFSETX (* 1/2 (- SIZEX SW))) + (+ -8 (- (CADDDR W) OFFSETY)) (GET-C-STRING SSTR) + (LENGTH SSTR))) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN WINDOW-CENTER-PRINT (W S OFFSETX OFFSETY SIZEX SIZEY) + (LET (SW) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX + (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) + (SETQ SW + (LET ((SSTR (STRINGIFY S))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) + (LET ((SSTR (STRINGIFY S))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) + (+ OFFSETX (* 1/2 (- SIZEX SW))) + (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) + (GET-C-STRING SSTR) (LENGTH SSTR))) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN WINDOW-DRAW-THERMOMETER + (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) + (LET (HDEL MARKY) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX + (- (CADDDR W) (1- (+ OFFSETY SIZEY))) 66 SIZEY 0) + (EDITORS-PRINT-IN-BOX VAL W OFFSETX OFFSETY 40 20) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX + (+ -48 (- (CADDDR W) OFFSETY)) 24 24 8448 17664) + (LET ((QQWHEIGHT (CADDDR W))) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) + (+ -44 (- QQWHEIGHT OFFSETY)) (+ 4 OFFSETX) + (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) + (LET ((QQWHEIGHT (CADDDR W))) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 20 OFFSETX) + (+ -44 (- QQWHEIGHT OFFSETY)) (+ 20 OFFSETX) + (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) + (- (CADDDR W) (+ OFFSETY SIZEY)) 16 16 0 11520) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) + (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 8 OFFSETX) + (+ -40 (- (CADDDR W) OFFSETY)) 8 8 0 23040) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0) + (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) + (LET ((QQWHEIGHT (CADDDR W))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) + (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) + (- QQWHEIGHT + (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) + (DOTIMES (I (1+ NDIV)) + (SETQ MARKY (+ (+ 48 OFFSETY) (* I HDEL))) + (LET ((QQWHEIGHT (CADDDR W))) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 24 OFFSETX) + (- QQWHEIGHT MARKY) (+ 34 OFFSETX) (- QQWHEIGHT MARKY)) + NIL) + (LET ((SSTR (STRINGIFY (+ NMIN (* I NDEL))))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) + (+ 36 OFFSETX) (+ 6 (- (CADDDR W) MARKY)) + (GET-C-STRING SSTR) (LENGTH SSTR)))) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN WINDOW-SET-THERMOMETER + (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) + (LET (HDEL) + (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) + (LET ((GLVAR204 (+ -56 SIZEY))) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) + (- (CADDDR W) (1- (+ (+ 48 OFFSETY) GLVAR204))) 10 GLVAR204 + 0)) + (LET ((QQWHEIGHT (CADDDR W))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) + (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) + (- QQWHEIGHT + (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) + (EDITORS-UPDATE-IN-BOX VAL W OFFSETX OFFSETY 40 20))) + +(DEFUN WINDOW-ADJUST-THERMOMETER + (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) + (LET (HDEL LASTY XMIN XMAX YMIN YMAX INSIDE NEWVAL) + (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) + (SETQ LASTY + (TRUNCATE (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) + (SETQ XMIN (+ 4 OFFSETX)) + (SETQ XMAX (+ 20 OFFSETX)) + (SETQ YMIN (+ 48 OFFSETY)) + (SETQ YMAX (+ -8 (+ OFFSETY SIZEY))) + (WINDOW-TRACK-MOUSE W + #'(LAMBDA (X Y CODE) + (SETQ INSIDE + (AND (>= X XMIN) (<= X XMAX) (>= Y YMIN) (<= Y YMAX))) + (WHEN (AND INSIDE (/= Y LASTY)) + (IF (> Y LASTY) + (LET ((QQWHEIGHT (CADDDR W))) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 + 1 0) + (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) + (+ 12 OFFSETX) (- QQWHEIGHT LASTY) + (+ 12 OFFSETX) (- QQWHEIGHT Y)) + (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 + 1 0)) + (LET ((GLVAR214 (- LASTY Y))) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) + (- (CADDDR W) (1- (+ (1+ Y) GLVAR214))) 10 + GLVAR214 0))) + (SETQ LASTY Y) + (SETQ NEWVAL + (+ (* (/ (+ -48 (- LASTY OFFSETY)) (FLOAT HDEL)) + NDEL) + NMIN)) + (IF (INTEGERP VAL) (SETQ NEWVAL (TRUNCATE NEWVAL))) + (EDITORS-UPDATE-IN-BOX NEWVAL W OFFSETX OFFSETY 40 20)) + (NOT (ZEROP CODE)))) + (IF INSIDE NEWVAL VAL))) +(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLARGUMENTS) + '((W WINDOW) (NMIN INTEGER) (NDEL INTEGER) (NDIV INTEGER) + (VAL NUMBER) (OFFSETX INTEGER) (OFFSETY INTEGER) + (SIZEY INTEGER))) +(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLFNRESULTTYPE) 'NUMBER) + + +(DEFUN BUTTON-SELECT (MW BUTTONS) + (LET (CURRENT-BUTTON ITEM ITEMS VAL XZERO YZERO) + (SETQ XZERO 0) + (SETQ YZERO 0) + (WINDOW-TRACK-MOUSE MW + #'(LAMBDA (X Y CODE) + (DECF X XZERO) + (DECF Y YZERO) + (AND (>= X 0) (>= Y 0)) + (IF CURRENT-BUTTON + (WHEN (NOT (BUTTON-CONTAINSXY? CURRENT-BUTTON X Y)) + (BUTTON-INVERT MW CURRENT-BUTTON) + (SETQ CURRENT-BUTTON NIL))) + (WHEN (NOT CURRENT-BUTTON) + (SETQ ITEMS BUTTONS) + (WHILE (AND (NOT CURRENT-BUTTON) (SETQ ITEM (POP ITEMS))) + (WHEN (BUTTON-CONTAINSXY? ITEM X Y) + (SETQ CURRENT-BUTTON ITEM) + (BUTTON-INVERT MW CURRENT-BUTTON)))) + (WHEN (PLUSP CODE) + (IF CURRENT-BUTTON (BUTTON-INVERT MW CURRENT-BUTTON)) + (SETQ VAL (OR CURRENT-BUTTON *PICMENU-NO-SELECTION*)))) + T) + (IF (NOT (EQUAL VAL *PICMENU-NO-SELECTION*)) (CAR VAL)))) +(SETF (GET 'BUTTON-SELECT 'GLARGUMENTS) + '((MW WINDOW) (BUTTONS (LISTOF PICMENU-BUTTON)))) +(SETF (GET 'BUTTON-SELECT 'GLFNRESULTTYPE) 'SYMBOL) + + +(DEFUN BUTTON-INVERT (W BUTTON) + (WINDOW-INVERT-AREA W (CADR BUTTON) (CADDR BUTTON))) + +(DEFUN WINDOW-UNDRAW-BOX (W OFFSET SIZE &OPTIONAL LW) + (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 3) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*)))) + (WINDOW-DRAW-BOX W OFFSET SIZE LW) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) + +(DEFUN BUTTON-CONTAINSXY? (B X Y) + (LET ((XSIZE 6) (YSIZE 6)) + (WHEN (CADDR B) + (SETQ XSIZE (CAADDR B)) + (SETQ YSIZE (CADR (CADDR B)))) + (AND (>= X (CAADR B)) (<= X (+ (CAADR B) XSIZE)) (>= Y (CADADR B)) + (<= Y (+ (CADADR B) YSIZE))))) +(SETF (GET 'BUTTON-CONTAINSXY? 'GLARGUMENTS) + '((B PICMENU-BUTTON) (X INTEGER) (Y INTEGER))) +(SETF (GET 'BUTTON-CONTAINSXY? 'GLFNRESULTTYPE) 'BOOLEAN) + + +(SETF (GET 'MENU-ITEM 'GLSTRUCTURE) + '((Z ANYTHING) PROP ((VALUE ((IF Z IS ATOMIC Z (CDR Z))))) MSG + ((PRINT-SIZE MENU-ITEM-PRINT-SIZE) (DRAW MENU-ITEM-DRAW)))) + + +(DEFUN MENU-ITEM-PRINT-SIZE (ITEM W) + (LET (SIZ) + (IF (ATOM ITEM) + (LIST (LET ((SSTR (STRINGIFY ITEM))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) + (LENGTH SSTR))) + 11) + (IF (STRINGP (CAR ITEM)) + (LIST (LET ((SSTR (STRINGIFY (CAR ITEM)))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) + (LENGTH SSTR))) + 11) + (IF (AND (SYMBOLP (CAR ITEM)) + (SETQ SIZ (GET (CAR ITEM) 'DISPLAY-SIZE))) + SIZ (COPY-LIST '(50 11))))))) +(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLARGUMENTS) + '((ITEM MENU-ITEM) (W WINDOW))) +(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN MENU-ITEM-DRAW (ITEM W OFFSETX OFFSETY SIZEX SIZEY) + (IF (ATOM ITEM) + (WINDOW-CENTER-PRINT W ITEM OFFSETX OFFSETY SIZEX SIZEY) + (IF (AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) + (FUNCALL (CAR ITEM) W OFFSETX OFFSETY) + (WINDOW-CENTER-PRINT W (CAR ITEM) OFFSETX OFFSETY SIZEX + SIZEY)))) + +(DEFUN PICK-ONE-SIZE (ITEMS W) + (LET (WID) + (DOLIST (ITEM ITEMS) + (SETQ WID + (IF WID (MAX WID (CAR (MENU-ITEM-PRINT-SIZE ITEM W))) + (CAR (MENU-ITEM-PRINT-SIZE ITEM W))))) + (LIST WID 11))) +(SETF (GET 'PICK-ONE-SIZE 'GLARGUMENTS) + '((ITEMS (LISTOF MENU-ITEM)) (W WINDOW))) +(SETF (GET 'PICK-ONE-SIZE 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN DRAW-PICK-ONE + (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) + (LET (ITM) + (IF (SETQ ITM + (SOME #'(LAMBDA (GLVAR216) + (IF (EQUAL (IF (ATOM GLVAR216) GLVAR216 + (CDR GLVAR216)) + VAL) + GLVAR216)) + ITEMS)) + (MENU-ITEM-DRAW ITM W OFFSETX OFFSETY SIZEX SIZEY)))) + +(DEFUN EDIT-PICK-ONE + (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) + (LET (NEWVAL) + (IF (<= (LENGTH ITEMS) 3) + (IF (EQUAL VAL + (LET ((SELF (FIRST ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))) + (SETQ NEWVAL + (LET ((SELF (SECOND ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))) + (IF (EQUAL VAL + (LET ((SELF (SECOND ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))) + (SETQ NEWVAL + (IF (THIRD ITEMS) + (LET ((SELF (THIRD ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF))) + (LET ((SELF (FIRST ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF))))) + (SETQ NEWVAL + (LET ((SELF (FIRST ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))))) + (SETQ NEWVAL (MENU ITEMS))) + (DRAW-PICK-ONE NEWVAL W ITEMS OFFSETX OFFSETY SIZEX SIZEY) + NEWVAL)) + +(DEFUN DRAW-BLACK-WHITE + (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) + (LET (ITM) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX + (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) + (IF (SETQ ITM + (SOME #'(LAMBDA (GLVAR218) + (IF (EQUAL (IF (ATOM GLVAR218) GLVAR218 + (CDR GLVAR218)) + VAL) + GLVAR218)) + ITEMS)) + (WHEN (EQL (IF (CONSP ITM) (CAR ITM) ITM) 1) + (LET ((GC (CADDR W))) + (SETQ *WINDOW-SAVE-FUNCTION* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 + *GC-VALUES*) + (XGCVALUES-FUNCTION *GC-VALUES*))) + (XSETFUNCTION *WINDOW-DISPLAY* GC 6) + (SETQ *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 + *GC-VALUES*) + (XGCVALUES-FOREGROUND *GC-VALUES*))) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + (LOGXOR *WINDOW-SAVE-FOREGROUND* + (PROGN + (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 + *GC-VALUES*) + (XGCVALUES-BACKGROUND *GC-VALUES*))))) + (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX + (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY) + (LET ((GC (CADDR W))) + (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) + (XSETFOREGROUND *WINDOW-DISPLAY* GC + *WINDOW-SAVE-FOREGROUND*)))))) + +(DEFUN EDIT-BLACK-WHITE + (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) + (LET (NEWVAL) + (IF (EQUAL VAL + (LET ((SELF (FIRST ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))) + (SETQ NEWVAL + (LET ((SELF (SECOND ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))) + (IF (EQUAL VAL + (LET ((SELF (SECOND ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))) + (SETQ NEWVAL + (LET ((SELF (FIRST ITEMS))) + (IF (ATOM SELF) SELF (CDR SELF)))))) + (DRAW-BLACK-WHITE ITEMS NEWVAL W OFFSETX OFFSETY SIZEX SIZEY) + NEWVAL)) + +(DEFUN DRAW-INTEGER (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) + (EDITORS-ANYTHING-PRINT VAL W OFFSETX OFFSETY SIZEX SIZEY)) + +(DEFUN DRAW-REAL (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) + (LET (STR NC LNG FMT) + (IF (NULL SIZEX) (SETQ SIZEX 50)) + (SETQ NC (MAX 1 (TRUNCATE SIZEX 7))) + (SETQ STR (PRINC-TO-STRING VAL)) + (SETQ LNG (LENGTH STR)) + (IF (> LNG NC) + (IF (OR (FIND #\. STR :START NC) (FIND #\E STR) (FIND #\L STR)) + (IF (>= NC 8) + (PROGN + (SETQ FMT + (CADR (OR (ASSOC NC + '((8 "~8,2E") (9 "~9,2E") + (10 "~10,2E") (11 "~11,2E") + (12 "~12,2E") (13 "~13,2E") + (14 "~14,2E"))) + '(15 "~15,2E")))) + (SETQ STR (FORMAT NIL FMT VAL))) + (SETQ STR "*******")) + (SETQ STR (SUBSEQ STR 0 NC)))) + (EDITORS-ANYTHING-PRINT W STR OFFSETX OFFSETY SIZEX SIZEY))) + +(DEFUN EDITORS-ANYTHING-PRINT (OBJ W OFFSETX OFFSETY SIZEX SIZEY) + (LET (SWIDTH SMAX DX DY) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX + (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) + (SETQ SWIDTH + (LET ((SSTR (STRINGIFY (STRINGIFY OBJ)))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) + (SETQ SMAX (MIN SWIDTH SIZEX)) + (SETQ DX (* 1/2 (- SIZEX SMAX))) + (SETQ DY (MAX 0 (+ -5 (* 1/2 SIZEY)))) + (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SMAX)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) + (+ OFFSETX DX) (- (CADDDR W) (+ OFFSETY DY)) + (GET-C-STRING SSTR) (LENGTH SSTR))))) + +(DEFUN EDITORS-PRINT-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) + (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) + (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) + (GET-C-STRING SSTR) (LENGTH SSTR))) + (WINDOW-DRAW-BOX-XY W OFFSETX OFFSETY SIZEX SIZEY)) + +(DEFUN EDITORS-UPDATE-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) + (LET ((GLVAR229 (+ -6 SIZEY))) + (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 3 OFFSETX) + (- (CADDDR W) (1- (+ (+ 3 OFFSETY) GLVAR229))) (+ -6 SIZEX) + GLVAR229 0)) + (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) + (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) + (GET-C-STRING SSTR) (LENGTH SSTR)))) + +(DEFUN EDITORS-STRING-LIMIT (S W MAX) + (LET ((STR (STRINGIFY S)) LNG NC) + (SETQ LNG + (LET ((SSTR (STRINGIFY STR))) + (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) + (IF (> LNG MAX) + (PROGN + (SETQ NC (/ (* (LENGTH STR) MAX) LNG)) + (SUBSEQ STR 0 NC)) + STR))) +(SETF (GET 'EDITORS-STRING-LIMIT 'GLARGUMENTS) + '((S STRING) (W WINDOW) (MAX INTEGER))) +(SETF (GET 'EDITORS-STRING-LIMIT 'GLFNRESULTTYPE) 'STRING) + + +(DEFVAR *EDIT-COLOR-MENU-SET* NIL) + +(DEFVAR *EDIT-COLOR-RMENU* NIL) + +(DEFVAR *EDIT-COLOR-OLD-COLOR* NIL) + +(DEFVAR *EDIT-COLOR-MENU-SET*) +(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVAR) T) +(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) +(DEFVAR *EDIT-COLOR-RMENU*) +(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVAR) T) +(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVARTYPE) 'BARMENU) + + +(DEFUN EDIT-COLOR-INIT (W) + (LET (RM GM BM RGB) + (SETQ RGB (COPY-LIST '(0 0 0))) + (GLCC 'EDIT-COLOR-RED) + (GLCC 'EDIT-COLOR-GREEN) + (GLCC 'EDIT-COLOR-BLUE) + (SETQ *EDIT-COLOR-MENU-SET* (MENU-SET-CREATE W NIL)) + (SETQ RM + (BARMENU-CREATE 256 200 10 "" NIL #'EDIT-COLOR-RED (LIST RGB) + W 120 40 NIL T (COPY-LIST '(65535 0 0)))) + (SETQ *EDIT-COLOR-RMENU* RM) + (SETQ GM + (BARMENU-CREATE 256 50 10 "" NIL #'EDIT-COLOR-GREEN + (LIST RGB) W 170 40 NIL T (COPY-LIST '(0 65535 0)))) + (SETQ BM + (BARMENU-CREATE 256 250 10 "" NIL #'EDIT-COLOR-BLUE + (LIST RGB) W 220 40 NIL T (COPY-LIST '(0 0 65535)))) + (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'RED NIL RM "Red" + '(120 40)) + (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'GREEN NIL GM "Green" + '(170 40)) + (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'BLUE NIL BM "Blue" + '(220 40)) + (MENU-SET-ADD-MENU *EDIT-COLOR-MENU-SET* 'DONE NIL "" + '(("Done" . DONE)) '(30 150)) + (EDIT-COLOR-RED 200 RGB) + (EDIT-COLOR-GREEN 50 RGB) + (EDIT-COLOR-BLUE 250 RGB))) + +(DEFUN EDIT-COLOR-RED (VAL COLOR) + (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) + (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 113 + (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) + (SETF (CAR COLOR) (MAX 0 (1- (* 256 VAL)))) + (EDIT-DISPLAY-COLOR W COLOR))) + +(DEFUN EDIT-COLOR-GREEN (VAL COLOR) + (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) + (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 163 + (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) + (SETF (CADR COLOR) (MAX 0 (1- (* 256 VAL)))) + (EDIT-DISPLAY-COLOR W COLOR))) + +(DEFUN EDIT-COLOR-BLUE (VAL COLOR) + (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) + (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) + (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 213 + (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) + (SETF (CADDR COLOR) (MAX 0 (1- (* 256 VAL)))) + (EDIT-DISPLAY-COLOR W COLOR))) + +(DEFUN EDIT-DISPLAY-COLOR (W COLOR) + (WINDOW-SET-COLOR W COLOR) + (WINDOW-DRAW-LINE-XY W 50 40 50 100 60) + (WINDOW-RESET-COLOR W) + (IF *EDIT-COLOR-OLD-COLOR* + (WINDOW-FREE-COLOR W *EDIT-COLOR-OLD-COLOR*)) + (SETQ *EDIT-COLOR-OLD-COLOR* *WINDOW-XCOLOR*)) + +(DEFUN EDIT-COLOR (W) + (LET (DONE COLOR SEL) + (IF (OR (NULL *EDIT-COLOR-MENU-SET*) + (NOT (EQ W (CADR (CADDR (CAADDR *EDIT-COLOR-MENU-SET*)))))) + (EDIT-COLOR-INIT W)) + (SETQ COLOR (FIRST (NTH 16 *EDIT-COLOR-RMENU*))) + (MENU-SET-DRAW *EDIT-COLOR-MENU-SET*) + (EDIT-COLOR-RED (TRUNCATE (1+ (CAR COLOR)) 256) COLOR) + (EDIT-COLOR-GREEN (TRUNCATE (1+ (CADR COLOR)) 256) COLOR) + (EDIT-COLOR-BLUE (TRUNCATE (1+ (CADDR COLOR)) 256) COLOR) + (WHILE (NOT DONE) + (SETQ SEL (MENU-SET-SELECT *EDIT-COLOR-MENU-SET*)) + (SETQ DONE (AND SEL (EQ (FIRST SEL) 'DONE)))) + COLOR)) +(SETF (GET 'EDIT-COLOR 'GLARGUMENTS) '((W WINDOW))) +(SETF (GET 'EDIT-COLOR 'GLFNRESULTTYPE) 'RGB) + + +(DEFUN COLOR-DOT (W X Y COLOR) + (LET (RGB) + (SETQ RGB + (CDR (ASSOC COLOR + '((RED 65535 0 0) (YELLOW 65535 57600 0) + (GREEN 0 50175 12287) (BLUE 0 0 65535))))) + (OR RGB (SETQ RGB '(30000 30000 30000))) + (WINDOW-SET-COLOR W RGB) + (WINDOW-DRAW-DOT-XY W X Y) + (WINDOW-RESET-COLOR W))) + +(DEFUN COMPILE-EDITORS () + (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") + '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt") + (CF EDITORSTRANS)) + +(DEFUN COMPILE-EDITORSB () + (GLCOMPFILES *DIRECTORY* + '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt")) diff --git a/xgcl-2/gcl_general.lsp b/xgcl-2/gcl_general.lsp new file mode 100644 index 0000000..ae30642 --- /dev/null +++ b/xgcl-2/gcl_general.lsp @@ -0,0 +1,86 @@ +(in-package :XLIB) +; general.lsp Hiep Huu Nguyen ; 24 Jun 06 +; 15 Sep 05; 24 Jan 06 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +; 27 Aug 92 +; 15 Sep 05: Edited by G. Novak to change C function headers to new form +; 24 Jan 06: Edited by G. Novak to remove vertex-array entries. +; 22 Jun 06: Edited by G. Novak to fix entry types + +;(defentry free (string) (void free)) +;(defentry calloc(fixnum fixnum) (string calloc)) +(defentry char-array (int) (fixnum char_array)) +(defentry char-pos (fixnum int) (char char_pos)) +(defentry set-char-array (fixnum int char) (void set_char_array)) + +(defentry int-array (int) (fixnum int_array)) +(defentry int-pos (fixnum int) (int int_pos)) +(defentry set-int-array (fixnum int int) (void set_int_array)) + +(defentry fixnum-array (int) (fixnum fixnum_array)) +(defentry fixnum-pos (fixnum int) (fixnum fixnum_pos)) +(defentry set-fixnum-array (fixnum int fixnum) (void set_fixnum_array)) + +;;from mark ring's function +;; General routines. +(defCfun "object get_c_string(object s)" 0 + " return((object)s->st.st_self);" + ) +(defCfun "object get_c_string1(object s)" 0 + " return((object)object_to_string(s));" + ) +(defCfun "fixnum get_c_string2(object s)" 0 + " return((fixnum)get_c_string(s));" + ) +(defentry get_c_string_2 (object) (object get_c_string)) + +;; make sure string is null terminated + +(defentry get-c-string (object) (object get_c_string1));"(object)object_to_string")) + +;; General routines. +(defCfun "object lisp_string(object a_string, fixnum c_string) " 0 + "extern unsigned long strlen(const char *);" + "fixnum len = strlen((void *)c_string);" + "a_string->st.st_dim = len;" + "a_string->st.st_fillp = len;" + "a_string->st.st_self = (void *)c_string;" + "return(a_string);" + ) + +(defentry lisp-string-2 (object fixnum ) (object lisp_string)) +(defun lisp-string (a-string ) + (lisp-string-2 "" a-string )) + +;;modified from mark ring's function +;; General routines. +(defCfun "fixnum get_st_point(object s)" 0 + " return((fixnum) s->st.st_self);" + ) +(defentry get-st-point2 (object) (fixnum get_c_string2));"(fixnum)get_c_string")) + +;; make sure string is null terminated +(defun get-st-point (string) + ( get-st-point2 (concatenate 'string string ""))) + diff --git a/xgcl-2/gcl_ice-cream.lsp b/xgcl-2/gcl_ice-cream.lsp new file mode 100644 index 0000000..dcf51a9 --- /dev/null +++ b/xgcl-2/gcl_ice-cream.lsp @@ -0,0 +1,37 @@ +; ice-cream.lsp 14 Nov 1994 16:16:15 + + +(SETF (GET 'ICE-CREAM 'DRAW-DESCR) + '(DRAW-DESC ICE-CREAM + ((DRAW-DOT (79 294) (4 4) NIL 0) + (DRAW-CIRCLE (7 222) (148 148) NIL 0) + (DRAW-ELLIPSE (7 274) (148 44) NIL 0) + (DRAW-LINE (81 296) (0 -278) NIL 0) + (DRAW-LINE (81 18) (74 278) NIL 0) + (DRAW-LINE (81 18) (-74 278) NIL 0) + (DRAW-ELLIPSE (0 269) (162 54) NIL 0) + (DRAW-ARROW (154 391) (-27 -35) NIL 0) + (DRAW-TEXT (140 395) (63 14) "Ice Cream" 0) + (DRAW-ARROW (81 296) (-74 0) NIL 0) + (DRAW-TEXT (47 299) (7 14) "r" 0) + (DRAW-TEXT (86 186) (7 14) "h" 0) + (DRAW-LINE (81 0) (81 296) NIL 0) + (DRAW-LINE (81 0) (-81 296) NIL 0)) + (0 0) (203 409))) + +(DEFUN DRAW-ICE-CREAM (W X Y) + (WINDOW-DRAW-DOT-XY W (+ 81 X) (+ 296 Y)) + (WINDOW-DRAW-CIRCLE-XY W (+ 81 X) (+ 296 Y) 74) + (WINDOW-DRAW-ELLIPSE-XY W (+ 81 X) (+ 296 Y) 74 22) + (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 296 Y) (+ 81 X) (+ 18 Y)) + (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 18 Y) (+ 155 X) (+ 296 Y)) + (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 18 Y) (+ 7 X) (+ 296 Y)) + (WINDOW-DRAW-ELLIPSE-XY W (+ 81 X) (+ 296 Y) 81 27) + (WINDOW-DRAW-ARROW-XY W (+ 154 X) (+ 391 Y) (+ 127 X) (+ 356 Y)) + (WINDOW-PRINTAT-XY W "Ice Cream" (+ 140 X) (+ 395 Y)) + (WINDOW-DRAW-ARROW-XY W (+ 81 X) (+ 296 Y) (+ 7 X) (+ 296 Y)) + (WINDOW-PRINTAT-XY W "r" (+ 47 X) (+ 299 Y)) + (WINDOW-PRINTAT-XY W "h" (+ 86 X) (+ 186 Y)) + (WINDOW-DRAW-LINE-XY W (+ 81 X) Y (+ 162 X) (+ 296 Y)) + (WINDOW-DRAW-LINE-XY W (+ 81 X) Y X (+ 296 Y)) + (WINDOW-FORCE-OUTPUT W)) diff --git a/xgcl-2/gcl_imports.lsp b/xgcl-2/gcl_imports.lsp new file mode 100644 index 0000000..3fee7b9 --- /dev/null +++ b/xgcl-2/gcl_imports.lsp @@ -0,0 +1,728 @@ +; From: Bill Schelter imports.lsp 16 Nov 94 + +; Copyright (c) 1994 William Schelter and The University of Texas at Austin. + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + +; The following will make ALL currently defined functions and special variables +; in the xlib package be imported into user. + +(in-package :XLIB) + +(import '(SET-XGCVALUES-SUBWINDOW_MODE SET-XGCVALUES-ARC_MODE WINDOW-SET-CURSOR + MAKE-XVISUALINFO XCOLORMAPEVENT-SERIAL XGCVALUES-LINE_WIDTH + WINDOW-CIRCLE-RADIUS XVISIBILITYEVENT-SERIAL XCOLOR-GREEN + XTEXTPROPERTY-VALUE XCREATEREGION XGCVALUES-SUBWINDOW_MODE + MAKE-XTEXTPROPERTY PICMENU-CREATE XDISPLAYKEYCODES XGCVALUES-DASHES + WINDOW-CLOSE SET-XGCVALUES-BACKGROUND SET-XGCVALUES-FOREGROUND + XUNIONRECTWITHREGION XTEXTITEM-DELTA XCONNECTIONNUMBER + MAKE-XEXTCODES SCREENFORMAT-SCANLINE_PAD XFREEGC XARC-HEIGHT + XPARSECOLOR XKEYCODETOKEYSYM XBUTTONEVENT-TIME WINDOW-SET-INVERT + XPROTOCOLREVISION XPROTOCOLVERSION SET-XFOCUSCHANGEEVENT-TYPE + BARMENU-INIT XSTANDARDCOLORMAP-BLUE_MULT + XSTANDARDCOLORMAP-GREEN_MULT XSTANDARDCOLORMAP-RED_MULT + SET-XCOLOR-FLAGS XQUERYTREE XQUERYCOLOR MAKE-DEPTH XCHANGESAVESET + XCOLORMAPEVENT-COLORMAP SET-XRECTANGLE-HEIGHT XBUTTONEVENT-TYPE + XALLOWEVENTS XDRAWRECTANGLES XSETFILLRULE + XGCVALUES-GRAPHICS_EXPOSURES XSETFILLSTYLE XCOLOR-FLAGS + SET-XKEYBOARDCONTROL-LED_MODE XSETSTATE XBUTTONEVENT-STATE + XQUERYTEXTEXTENTS SCREEN-DEPTHS SCREEN-NDEPTHS MENU-INIT + SET-XGCVALUES-LINE_WIDTH SCREENFORMAT-DEPTH XINSTALLCOLORMAP XARC-Y + SET-XFOCUSCHANGEEVENT-SERIAL XOFFSETREGION SET-XFONTPROP-CARD32 + XIMAGE-BITMAP_BIT_ORDER SET-XWMHINTS-INITIAL_STATE XSTORECOLOR + MAKE-XMAPEVENT XBUTTONEVENT-SERIAL SET-XKEYBOARDCONTROL-BELL_PITCH + SET-XKEYBOARDSTATE-BELL_PITCH SET-XKEYEVENT-KEYCODE + SCREENFORMAT-BITS_PER_PIXEL XKEYSYMTOSTRING + SET-XCLIENTMESSAGEEVENT-FORMAT SET-XRESIZEREQUESTEVENT-WIDTH + WINDOW-DRAW-LINE XGCVALUES-PLANE_MASK XFILLRECTANGLES XDRAWSEGMENTS + WINDOW-DRAW-CIRCLE SET-XUNMAPEVENT-TYPE XEXPOSEEVENT-HEIGHT + XSTANDARDCOLORMAP-BLUE_MAX XSTANDARDCOLORMAP-GREEN_MAX + XSTANDARDCOLORMAP-RED_MAX XSETWMSIZEHINTS XKEYEVENT-KEYCODE + WINDOW-FORCE-OUTPUT WINDOW-UNMAP XCHARSTRUCT-WIDTH + XDEFAULTCOLORMAPOFSCREEN SET-XFOCUSCHANGEEVENT-DETAIL XSEGMENT-X1 + SCREEN-ROOT XEDATAOBJECT-SCREEN XSEGMENT-Y1 + SET-XMODIFIERKEYMAP-MAX_KEYPERMOD SET-XGCVALUES-CLIP_Y_ORIGIN + SET-XGCVALUES-CLIP_X_ORIGIN SET-XGCVALUES-TS_Y_ORIGIN + SET-XGCVALUES-TS_X_ORIGIN SET-XGCVALUES-CLIP_MASK + SET-XGCVALUES-PLANE_MASK XCHECKMASKEVENT XDEFAULTCOLORMAP + XSEGMENT-X2 SCREEN-DISPLAY XBUTTONEVENT-SAME_SCREEN XSEGMENT-Y2 + XCREATEWINDOWEVENT-BORDER_WIDTH XCREATEWINDOWEVENT-WIDTH + WINDOW-CLEAR SET-SCREEN-EXT_DATA XEXPOSEEVENT-COUNT + SET-XUNMAPEVENT-SERIAL SET-XCLIENTMESSAGEEVENT-SEND_EVENT + XGCVALUES-TS_Y_ORIGIN XGCVALUES-TS_X_ORIGIN XDRAWARCS + XDEFAULTGCOFSCREEN XIMAGE-XOFFSET SET-SCREEN-DEFAULT_GC + SET-XCLIENTMESSAGEEVENT-DISPLAY XCOLORMAPEVENT-SEND_EVENT + XHOSTADDRESS-FAMILY XPROPERTYEVENT-ATOM XMAPPINGEVENT-TYPE + WINDOW-PRINTAT XVISIBILITYEVENT-SEND_EVENT XCOLORMAPEVENT-DISPLAY + XCHANGEPROPERTY XDEFAULTDEPTHOFSCREEN XBUTTONEVENT-BUTTON + XSETWINDOWATTRIBUTES-BACKING_STORE SET-XCLIENTMESSAGEEVENT-WINDOW + XIMAGE-FORMAT XVISIBILITYEVENT-DISPLAY WINDOW-LEFT WINDOW-UNSET + VERTEX-ARRAY XCOLORMAPEVENT-WINDOW XBUTTONEVENT-X + SET-XWMHINTS-ICON_PIXMAP XEDATAOBJECT-PIXMAP_FORMAT + XSELECTIONEVENT-REQUESTOR WINDOW-FONT PICMENU-INIT WINDOW-SET-FONT + XEDATAOBJECT-GC XVISIBILITYEVENT-WINDOW XDELETEPROPERTY + XFINDONEXTENSIONLIST XGETFONTPATH XBUTTONEVENT-Y + WINDOW-CENTEROFFSET SET-XKEYBOARDSTATE-LED_MASK XEDATAOBJECT-FONT + XREBINDKEYSYM SCREEN-SAVE_UNDERS SET-XGCVALUES-DASHES + XMAPPINGEVENT-SERIAL SET-XARC-Y SET-XARC-X WINDOW-INPUT-STRING + SET-XGCVALUES-GRAPHICS_EXPOSURES SET-XCOLOR-BLUE + XDEFAULTVISUALOFSCREEN SET-XWMHINTS-FLAGS VISUAL-CLASS + SET-XRESIZEREQUESTEVENT-HEIGHT WINDOW-PARENT XMATCHVISUALINFO + SET-SCREEN-BACKING_STORE WINDOW-XOR-BOX-XY XFONTSTRUCT-PER_CHAR + XFONTSTRUCT-DEFAULT_CHAR SET-XMODIFIERKEYMAP-MODIFIERMAP + SET-XWMHINTS-WINDOW_GROUP FREE + SET-XSETWINDOWATTRIBUTES-BACKING_PIXEL + SET-XSETWINDOWATTRIBUTES-BORDER_PIXEL + SET-XSETWINDOWATTRIBUTES-BACKGROUND_PIXEL XMOTIONEVENT-TIME + XCHARSTRUCT-DESCENT XCHARSTRUCT-ASCENT SET-XNOEXPOSEEVENT-TYPE + XCHARSTRUCT-ATTRIBUTES XARC-WIDTH SET-XFOCUSCHANGEEVENT-SEND_EVENT + WINDOW-INIT-MOUSE-POLL XBUTTONEVENT-ROOT XBUTTONEVENT-X_ROOT + XBUTTONEVENT-Y_ROOT XMOTIONEVENT-TYPE XCOPYCOLORMAPANDFREE + SET-XFOCUSCHANGEEVENT-DISPLAY XBUTTONEVENT-SEND_EVENT + XCREATEWINDOWEVENT-HEIGHT XSETWINDOWATTRIBUTES-COLORMAP + SET-XKEYBOARDCONTROL-KEY XCHANGEWINDOWATTRIBUTES WINDOW-GCONTEXT + WINDOW-DRAW-BORDER XBUTTONEVENT-DISPLAY XSELECTIONEVENT-PROPERTY + XNOOP XERROREVENT-MINOR_CODE XERROREVENT-REQUEST_CODE + XERROREVENT-ERROR_CODE XMOTIONEVENT-STATE XERROREVENT-RESOURCEID + XFREEMODIFIERMAP SET-XFOCUSCHANGEEVENT-WINDOW XGETATOMNAME + XGETICONNAME SET-XCONFIGUREEVENT-ABOVE + SET-XCONFIGUREREQUESTEVENT-ABOVE WINDOW-INPUT-CHAR-FN + WINDOW-PROCESS-CHAR-EVENT XSETWINDOWATTRIBUTES-BORDER_PIXMAP + XSETWINDOWATTRIBUTES-BACKGROUND_PIXMAP MAKE-XMOTIONEVENT + SET-XKEYBOARDCONTROL-BELL_PERCENT + SET-XKEYBOARDCONTROL-KEY_CLICK_PERCENT + SET-XKEYBOARDSTATE-BELL_PERCENT + SET-XKEYBOARDSTATE-KEY_CLICK_PERCENT XBUTTONEVENT-WINDOW + XBUTTONEVENT-SUBWINDOW SET-XWMHINTS-INPUT SET-XNOEXPOSEEVENT-SERIAL + SET-XSETWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK + SET-XSETWINDOWATTRIBUTES-EVENT_MASK SET-XTEXTITEM-DELTA + SET-XTEXTITEM16-DELTA XSETWINDOWCOLORMAP XSETWINDOWBACKGROUNDPIXMAP + XSETWINDOWBORDERPIXMAP XSETWINDOWATTRIBUTES-SAVE_UNDER + XVISUALINFO-SCREEN SET-XKEYBOARDSTATE-AUTO_REPEATS + XMOTIONEVENT-SERIAL XGETDEFAULT XQUERYEXTENSION DEPTH-VISUALS + SET-XSELECTIONREQUESTEVENT-OWNER XMAPWINDOW WINDOW-DESTROY + SET-XCONFIGUREEVENT-TYPE SET-XCONFIGUREREQUESTEVENT-TYPE + XCELLSOFSCREEN SET-XWMHINTS-ICON_WINDOW XFONTSTRUCT-MAX_BOUNDS + XFONTSTRUCT-MIN_BOUNDS XDEFAULTROOTWINDOW XFONTSTRUCT-DESCENT + XFONTSTRUCT-ASCENT SET-XTEXTPROPERTY-VALUE WINDOW-DRAW-BOX-CORNERS + SET-XUNMAPEVENT-EVENT SET-XUNMAPEVENT-SEND_EVENT + WINDOW-DESTROY-SELECTED-WINDOW WINDOW-POSITIVE-Y XFREEFONTPATH + XSETWINDOWBORDER SET-XSETWINDOWATTRIBUTES-BACKING_PLANES + XWMHINTS-ICON_MASK SET-XSELECTIONREQUESTEVENT-REQUESTOR + SET-XSELECTIONEVENT-REQUESTOR SET-XUNMAPEVENT-DISPLAY XGETWMNAME + XSETWINDOWATTRIBUTES-OVERRIDE_REDIRECT WINDOW-DRAW-VECTOR-PT + SET-XANYEVENT-TYPE XREMOVEFROMSAVESET XSETWMNAME + XDEFAULTSCREENOFDISPLAY XMOTIONEVENT-SAME_SCREEN + SET-XUNMAPEVENT-WINDOW XSETWINDOWATTRIBUTES-CURSOR + SET-XCONFIGUREEVENT-SERIAL SET-XCONFIGUREREQUESTEVENT-SERIAL + WINDOW-DRAW-ARROW2-XY XSELECTIONREQUESTEVENT-OWNER + SET-XCOLORMAPEVENT-TYPE MAKE-XPIXMAPFORMATVALUES XNEXTREQUEST + MAKE-XWMHINTS SET-XCOLORMAPEVENT-STATE XALLOCWMHINTS SET-XPOINT-X + XFREECOLORMAP SET-XANYEVENT-SERIAL XSELECTIONREQUESTEVENT-REQUESTOR + XMAPPINGEVENT-SEND_EVENT SET-XCONFIGUREREQUESTEVENT-DETAIL + SET-SCREEN-DEPTHS SET-SCREEN-NDEPTHS XFONTPROP-CARD32 + SET-SCREEN-SAVE_UNDERS XMAPPINGEVENT-DISPLAY SET-XPOINT-Y + SET-XCOLORMAPEVENT-SERIAL XMOTIONEVENT-X WINDOW-DRAW-ARROWHEAD-XY + SET-XHOSTADDRESS-LENGTH XMAPPINGEVENT-WINDOW XVISUALINFO-CLASS + XREMOVEHOSTS SET-XFONTSTRUCT-EXT_DATA + SET-XSELECTIONREQUESTEVENT-PROPERTY SET-XSELECTIONEVENT-PROPERTY + XMOTIONEVENT-Y WINDOW-ERASE-BOX-XY MENU-CHOOSE + XCONFIGUREEVENT-BORDER_WIDTH XCONFIGUREEVENT-WIDTH XGRABPOINTER + SET-XCHARSTRUCT-WIDTH XSETFONTPATH MAKE-XWINDOWATTRIBUTES + WINDOW-QUERY-POINTER XMOTIONEVENT-IS_HINT MAKE-XIMAGE + SET-XCONFIGUREEVENT-X SET-XCONFIGUREREQUESTEVENT-X + SET-XFONTPROP-NAME WINDOW-DRAW-DOT-XY XCOPYAREA SET-SCREEN-DISPLAY + SET-XEXTCODES-MAJOR_OPCODE WINDOW-DRAW-RCBOX-XY + WINDOW-DRAW-LATEX-XY WINDOW-DRAW-BOX-XY SET-XCONFIGUREEVENT-Y + SET-XCONFIGUREREQUESTEVENT-Y SET-XCOLORMAPEVENT-COLORMAP + MAKE-XNOEXPOSEEVENT XDRAWLINE XDRAWLINES XSCREENNUMBEROFSCREEN + WINDOW-PRETTYPRINTAT XSELECTIONREQUESTEVENT-PROPERTY + XWMHINTS-ICON_X SET-XNOEXPOSEEVENT-SEND_EVENT XFREECOLORS + XMOTIONEVENT-ROOT XMOTIONEVENT-X_ROOT XMOTIONEVENT-Y_ROOT + SET-XCONFIGUREEVENT-OVERRIDE_REDIRECT XMOTIONEVENT-SEND_EVENT + SET-XNOEXPOSEEVENT-DISPLAY XWMHINTS-ICON_Y + XSETWINDOWATTRIBUTES-WIN_GRAVITY XSETWINDOWATTRIBUTES-BIT_GRAVITY + XBLACKPIXELOFSCREEN XRECTANGLE-X XMOTIONEVENT-DISPLAY + XDESTROYWINDOW WINDOW-WFUNCTION XRECTANGLE-Y XADDPIXEL + SET-SCREENFORMAT-EXT_DATA XGETPIXEL XMOTIONEVENT-WINDOW + XMOTIONEVENT-SUBWINDOW SET-XEXPOSEEVENT-WIDTH + XWINDOWCHANGES-STACK_MODE XPUTPIXEL XBITMAPBITORDER + XDOESBACKINGSTORE XSETFUNCTION XSETICONNAME + SET-XCONFIGUREREQUESTEVENT-PARENT SET-XMOTIONEVENT-TIME + MAKE-XICONSIZE SET-XCONFIGUREEVENT-EVENT + SET-XCONFIGUREEVENT-SEND_EVENT + SET-XCONFIGUREREQUESTEVENT-SEND_EVENT SET-XMOTIONEVENT-TYPE + XALLOCICONSIZE XDISPLAYNAME XFINDCONTEXT XSIZEHINTS-HEIGHT_INC + XSIZEHINTS-WIDTH_INC SET-XCONFIGUREEVENT-DISPLAY + SET-XCONFIGUREREQUESTEVENT-DISPLAY XKEYMAPEVENT-TYPE MAKE-VISUAL + WINDOW-WAIT-UNMAP SET-XMOTIONEVENT-STATE XTIMECOORD-TIME + WINDOW-PRINTAT-XY SET-XCONFIGUREEVENT-WINDOW + SET-XCONFIGUREREQUESTEVENT-WINDOW SET-XGRAPHICSEXPOSEEVENT-TYPE + SET-XANYEVENT-SEND_EVENT XCONFIGUREEVENT-HEIGHT + SET-XANYEVENT-DISPLAY SET-XCHARSTRUCT-DESCENT + SET-XCHARSTRUCT-ASCENT XEHEADOFEXTENSIONLIST + SET-XCHARSTRUCT-ATTRIBUTES XSIZEHINTS-BASE_WIDTH + XSIZEHINTS-MAX_WIDTH XSIZEHINTS-MIN_WIDTH XSIZEHINTS-WIDTH + SET-XMOTIONEVENT-SERIAL SET-XIMAGE-BITMAP_PAD XBELL + SET-XCREATEWINDOWEVENT-TYPE SET-XHOSTADDRESS-ADDRESS XLOOKUPSTRING + XDISPLAYSTRING SET-XCOLORMAPEVENT-SEND_EVENT XKEYMAPEVENT-SERIAL + SET-XANYEVENT-WINDOW XRESIZEREQUESTEVENT-WIDTH + SET-XCOLORMAPEVENT-DISPLAY VISUAL-MAP_ENTRIES + SET-XGRAPHICSEXPOSEEVENT-SERIAL XWINDOWCHANGES-BORDER_WIDTH + XWINDOWCHANGES-WIDTH SET-XCOLORMAPEVENT-WINDOW SET-VISUAL-EXT_DATA + ISPFKEY WINDOW-YPOSITION XWIDTHMMOFSCREEN XWINDOWATTRIBUTES-DEPTH + SET-XCREATEWINDOWEVENT-SERIAL SET-XMOTIONEVENT-SAME_SCREEN + XGRAPHICSEXPOSEEVENT-MINOR_CODE XGRAPHICSEXPOSEEVENT-MAJOR_CODE + XCONFIGUREREQUESTEVENT-BORDER_WIDTH XCONFIGUREREQUESTEVENT-WIDTH + XWINDOWATTRIBUTES-BORDER_WIDTH XWINDOWATTRIBUTES-WIDTH + MAKE-XRECTANGLE XWINDOWATTRIBUTES-BACKING_PIXEL XINITEXTENSION + SET-XFONTSTRUCT-DIRECTION SET-XIMAGE-DEPTH SET-XMAPEVENT-TYPE + XDESTROYWINDOWEVENT-TYPE XWINDOWATTRIBUTES-VISUAL + SET-XEXPOSEEVENT-HEIGHT WINDOW-PRETTYPRINTAT-XY + XGRAPHICSEXPOSEEVENT-DRAWABLE SET-XIMAGE-WIDTH XDESTROYSUBWINDOWS + SET-XIMAGE-BITS_PER_PIXEL XUNMAPEVENT-FROM_CONFIGURE XGETWMHINTS + GET_C_STRING_2 XGETIMAGE SET-XMOTIONEVENT-X + SET-XFONTSTRUCT-PROPERTIES SET-XFONTSTRUCT-N_PROPERTIES + XDISPLAYWIDTHMM SET-XEXTCODES-EXTENSION XPUTIMAGE + XCONFIGUREREQUESTEVENT-VALUE_MASK XDRAWSTRING16 XSUBIMAGE + XWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK + XWINDOWATTRIBUTES-YOUR_EVENT_MASK MAKE-XPROPERTYEVENT + SET-XMAPEVENT-SERIAL XDESTROYWINDOWEVENT-SERIAL + SET-XEXPOSEEVENT-COUNT SET-XMOTIONEVENT-Y XWINDOWCHANGES-X + SET-XSTANDARDCOLORMAP-KILLID SET-XGRAPHICSEXPOSEEVENT-X + WINDOW-GET-VECTOR-END SET-XIMAGE-BLUE_MASK SET-XIMAGE-GREEN_MASK + SET-XIMAGE-RED_MASK _XQEVENT-EVENT XRECOLORCURSOR XWINDOWCHANGES-Y + XWIDTHOFSCREEN XWINDOWATTRIBUTES-X SET-XVISUALINFO-VISUALID + XTIMECOORD-X XSIZEHINTS-BASE_HEIGHT XSIZEHINTS-MAX_HEIGHT + XSIZEHINTS-MIN_HEIGHT XSIZEHINTS-HEIGHT MENU-DISPLAY-ITEM + LISP-STRING-2 SET-XGRAPHICSEXPOSEEVENT-Y + XWINDOWATTRIBUTES-BACKING_PLANES MENU-FIND-ITEM-WIDTH + XSTRINGTOKEYSYM _XQEVENT-NEXT SET-XCREATEWINDOWEVENT-X + SET-XMOTIONEVENT-IS_HINT MAKE-XANYEVENT XWINDOWATTRIBUTES-Y + SET-XGRAVITYEVENT-TYPE XTIMECOORD-Y XRESIZEREQUESTEVENT-HEIGHT + XDOESSAVEUNDERS SET-XCREATEWINDOWEVENT-Y + XWINDOWATTRIBUTES-ALL_EVENT_MASKS XFONTPROP-NAME XSCREENOFDISPLAY + XLISTEXTENSIONS XWINDOWCHANGES-HEIGHT XGRAPHICSEXPOSEEVENT-WIDTH + SET-XCREATEWINDOWEVENT-OVERRIDE_REDIRECT XPARSEGEOMETRY + SET-XMOTIONEVENT-ROOT SET-XMOTIONEVENT-X_ROOT + SET-XMOTIONEVENT-Y_ROOT PICMENU-DRAW-BUTTON + SET-XFONTSTRUCT-ALL_CHARS_EXIST SET-XVISUALINFO-BITS_PER_RGB + SET-VERTEX-ARRAY SET-XMOTIONEVENT-SEND_EVENT + XCONFIGUREREQUESTEVENT-HEIGHT XWINDOWATTRIBUTES-HEIGHT XWARPPOINTER + XKEYMAPEVENT-SEND_EVENT SET-XMOTIONEVENT-DISPLAY + SET-XGRAVITYEVENT-SERIAL XCROSSINGEVENT-MODE SET-XMAPPINGEVENT-TYPE + XKEYMAPEVENT-DISPLAY SET-_XQEVENT-EVENT XRESOURCEMANAGERSTRING + SET-XIMAGE-HEIGHT SET-XGRAPHICSEXPOSEEVENT-SEND_EVENT + SET-XMOTIONEVENT-WINDOW SET-XMOTIONEVENT-SUBWINDOW + SET-XCREATEWINDOWEVENT-PARENT XKEYMAPEVENT-WINDOW + SET-XGRAPHICSEXPOSEEVENT-DISPLAY SET-_XQEVENT-NEXT XQUERYPOINTER + SET-CHAR-ARRAY ISCURSORKEY SET-XCREATEWINDOWEVENT-SEND_EVENT + XSAVECONTEXT SET-XWINDOWCHANGES-STACK_MODE + SET-XMAPEVENT-OVERRIDE_REDIRECT XGETCLASSHINT WINDOW-GET-ELLIPSE + PICMENU-ITEM-POSITION SET-XCREATEWINDOWEVENT-DISPLAY + XQUERYTEXTEXTENTS16 SET-XMAPPINGEVENT-SERIAL + SET-XMAPREQUESTEVENT-TYPE SET-XIMAGE-BITMAP_UNIT + SET-XVISUALINFO-DEPTH SET-XCROSSINGEVENT-TIME + SET-XCREATEWINDOWEVENT-WINDOW XNOEXPOSEEVENT-TYPE + SET-XVISUALINFO-COLORMAP_SIZE SET-XCROSSINGEVENT-TYPE + SET-XERROREVENT-TYPE XSIZEHINTS-MAX_ASPECT_X + XSIZEHINTS-MIN_ASPECT_X XGETTRANSIENTFORHINT MENU-FIND-ITEM-HEIGHT + XADDHOSTS SET-XVISUALINFO-VISUAL SET-XCROSSINGEVENT-STATE + XSIZEHINTS-MAX_ASPECT_Y XSIZEHINTS-MIN_ASPECT_Y SET-XMAPEVENT-EVENT + SET-XMAPEVENT-SEND_EVENT SET-XMAPREQUESTEVENT-SERIAL + XDESTROYWINDOWEVENT-EVENT XDESTROYWINDOWEVENT-SEND_EVENT + SET-XGRAVITYEVENT-X XFOCUSCHANGEEVENT-TYPE + SET-XSTANDARDCOLORMAP-COLORMAP SET-VISUAL-MAP_ENTRIES XDRAWTEXT16 + WINDOW-GET-BOX-SIZE MAKE-XSELECTIONCLEAREVENT + MAKE-XSELECTIONREQUESTEVENT MAKE-XSELECTIONEVENT + SET-XMAPEVENT-DISPLAY XDESTROYWINDOWEVENT-DISPLAY + XNOEXPOSEEVENT-SERIAL SET-XGRAVITYEVENT-Y XFETCHBUFFER + XGRAPHICSEXPOSEEVENT-HEIGHT WINDOW-SET-COLOR-RGB + SET-XCROSSINGEVENT-SERIAL SET-XERROREVENT-SERIAL + SET-XVISUALINFO-BLUE_MASK SET-XVISUALINFO-GREEN_MASK + SET-XVISUALINFO-RED_MASK SET-XWINDOWATTRIBUTES-DEPTH + SET-XMAPEVENT-WINDOW XDESTROYWINDOWEVENT-WINDOW + SET-XSIZEHINTS-HEIGHT_INC SET-XSIZEHINTS-WIDTH_INC XPOINTINREGION + GET-ST-POINT2 SET-XWINDOWATTRIBUTES-BORDER_WIDTH + SET-XWINDOWATTRIBUTES-WIDTH SET-XWINDOWCHANGES-BORDER_WIDTH + SET-XWINDOWCHANGES-WIDTH SET-VISUAL-CLASS GET-C-STRING XSETWMHINTS + SET-XWINDOWATTRIBUTES-BACKING_PIXEL MAKE-SCREEN SET-XEDATAOBJECT-GC + XFOCUSCHANGEEVENT-SERIAL XWHITEPIXELOFSCREEN XTEXTEXTENTS + SET-XWINDOWATTRIBUTES-VISUAL PICMENU-DELETE-NAMED-BUTTON + XARC-ANGLE1 SET-XCROSSINGEVENT-DETAIL XGRAPHICSEXPOSEEVENT-COUNT + XWRITEBITMAPFILE XMINCMAPSOFSCREEN + SET-XPIXMAPFORMATVALUES-SCANLINE_PAD WINDOW-GET-REGION + SET-XCROSSINGEVENT-SAME_SCREEN XMAXCMAPSOFSCREEN + SET-XSIZEHINTS-BASE_WIDTH SET-XSIZEHINTS-MAX_WIDTH + SET-XSIZEHINTS-MIN_WIDTH SET-XSIZEHINTS-WIDTH SET-XSEGMENT-X1 + XARC-ANGLE2 MAKE-XREPARENTEVENT SET-XSEGMENT-Y1 SET-SCREEN-ROOT + XFOCUSCHANGEEVENT-DETAIL XSETCLIPORIGIN SET-XSEGMENT-X2 + SET-XGRAVITYEVENT-EVENT SET-XGRAVITYEVENT-SEND_EVENT XPOINT-Y + XSETCLIPMASK SET-XSEGMENT-Y2 + SET-XWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK + SET-XWINDOWATTRIBUTES-YOUR_EVENT_MASK XFILLARCS XDISPLAYHEIGHTMM + SET-XGRAVITYEVENT-DISPLAY XGETSTANDARDCOLORMAP XQUERYBESTTILE + XIMAGEBYTEORDER SET-XPROPERTYEVENT-TIME SCREEN-BLACK_PIXEL + SET-XGRAVITYEVENT-WINDOW SET-XPROPERTYEVENT-TYPE + SET-XCROSSINGEVENT-X XICONSIZE-HEIGHT_INC SET-XWINDOWATTRIBUTES-X + SET-XWINDOWCHANGES-X SET-XPIXMAPFORMATVALUES-DEPTH XGETSIZEHINTS + SET-XWINDOWATTRIBUTES-BACKING_PLANES XQUERYBESTCURSOR + SET-XPROPERTYEVENT-STATE SET-XCROSSINGEVENT-Y XSETWMPROPERTIES + WINDOW-GET-CROSSHAIRS SET-XWINDOWATTRIBUTES-Y SET-XWINDOWCHANGES-Y + SET-XMAPPINGEVENT-SEND_EVENT SET-XPIXMAPFORMATVALUES-BITS_PER_PIXEL + MAKE-XCLASSHINT XCREATEBITMAPFROMDATA XALLOCCLASSHINT + SET-XMAPPINGEVENT-DISPLAY SET-XWINDOWATTRIBUTES-ALL_EVENT_MASKS + XQUERYBESTSTIPPLE SET-XPROPERTYEVENT-SERIAL + SET-XMAPPINGEVENT-WINDOW SET-XMAPREQUESTEVENT-PARENT + WINDOW-SET-FOREGROUND WINDOW-SET-BACKGROUND WINDOW-GET-POINT + SET-XWINDOWATTRIBUTES-HEIGHT SET-XWINDOWCHANGES-HEIGHT + XGETWMCLIENTMACHINE XGETERRORDATABASETEXT XSTRINGLISTTOTEXTPROPERTY + SET-XMAPREQUESTEVENT-SEND_EVENT XGETERRORTEXT XSETCLIPRECTANGLES + XGETTEXTPROPERTY XSETCLASSHINT XCROSSINGEVENT-FOCUS + SET-XMAPREQUESTEVENT-DISPLAY XDRAWSTRING XNOEXPOSEEVENT-SEND_EVENT + MAKE-XRESIZEREQUESTEVENT XGETMODIFIERMAPPING XDEFAULTDEPTH + SET-XCROSSINGEVENT-ROOT SET-XCROSSINGEVENT-X_ROOT + SET-XCROSSINGEVENT-Y_ROOT XLISTPROPERTIES SET-XEDATAOBJECT-SCREEN + XSTANDARDCOLORMAP-KILLID MAKE-XEDATAOBJECT XNOEXPOSEEVENT-DISPLAY + SET-XSIZEHINTS-BASE_HEIGHT SET-XSIZEHINTS-MAX_HEIGHT + SET-XSIZEHINTS-MIN_HEIGHT SET-XSIZEHINTS-HEIGHT + SET-XCROSSINGEVENT-SEND_EVENT MAKE-XSTANDARDCOLORMAP + XALLOCSTANDARDCOLORMAP SET-XMAPREQUESTEVENT-WINDOW CALLOC + XNEXTEVENT ISKEYPADKEY XSENDEVENT SET-XCROSSINGEVENT-DISPLAY + SET-XERROREVENT-DISPLAY WINDOW-INVERT-AREA WINDOW-INVERTAREA + XADDHOST XSETFONT XGCVALUES-CAP_STYLE XDEFAULTVISUAL + XFOCUSCHANGEEVENT-SEND_EVENT XSETTRANSIENTFORHINT MENU + SET-XCROSSINGEVENT-WINDOW SET-XCROSSINGEVENT-SUBWINDOW + XICONSIZE-MAX_WIDTH XICONSIZE-MIN_WIDTH XENABLEACCESSCONTROL + XMAPSUBWINDOWS XFOCUSCHANGEEVENT-DISPLAY WINDOW-GET-GEOMETRY + XCONVERTSELECTION WINDOW-SET-LINE-WIDTH MENU-CLEAR + XKEYBOARDCONTROL-BELL_DURATION XFOCUSCHANGEEVENT-WINDOW + XSETACCESSCONTROL MAKE-XCHARSTRUCT XCHANGEKEYBOARDMAPPING + XDISPLAYOFSCREEN XGCVALUES-FILL_RULE XAUTOREPEATOFF + XEXTCODES-FIRST_ERROR XGCVALUES-FILL_STYLE + SET-XEDATAOBJECT-PIXMAP_FORMAT WINDOW-FOREGROUND XSETERRORHANDLER + XSTOREBUFFER XFILLARC WINDOW-BACKGROUND SET-XEDATAOBJECT-FONT + XMAPREQUESTEVENT-TYPE XANYEVENT-TYPE MENU-DRAW MAKE-XCONFIGUREEVENT + MAKE-XCONFIGUREREQUESTEVENT XEXTCODES-FIRST_EVENT LISP-STRING + XDRAWRECTANGLE XIMAGE-BITMAP_PAD XIMAGE-BLUE_MASK + MAKE-XCLIENTMESSAGEEVENT XTEXTITEM16-FONT VISUAL-BLUE_MASK + XKEYBOARDSTATE-BELL_DURATION XGCVALUES-JOIN_STYLE + XGETSELECTIONOWNER XTEXTITEM16-NCHARS XTEXTITEM16-CHARS + XUNGRABBUTTON XMAPREQUESTEVENT-SERIAL SET-XCOLOR-PIXEL + SET-XSIZEHINTS-MAX_ASPECT_X SET-XSIZEHINTS-MIN_ASPECT_X + XUNGRABPOINTER SET-XPROPERTYEVENT-SEND_EVENT XSETSTANDARDCOLORMAP + XSERVERVENDOR XRECTANGLE-WIDTH XCLASSHINT-RES_NAME SCREEN-MWIDTH + SCREEN-WIDTH XICONSIZE-WIDTH_INC XPLANESOFSCREEN + XCIRCULATESUBWINDOWSUP WINDOW-ERASE-AREA XUNGRABSERVER + MAKE-XBUTTONEVENT XCHANGEKEYBOARDCONTROL + SET-XSIZEHINTS-MAX_ASPECT_Y SET-XSIZEHINTS-MIN_ASPECT_Y + SET-XPROPERTYEVENT-DISPLAY XKEYBOARDSTATE-GLOBAL_AUTO_REPEAT + VISUAL-VISUALID XFILLRECTANGLE XHEIGHTOFSCREEN XCOLOR-PIXEL + XLOADFONT XLISTFONTS XHOSTADDRESS-LENGTH XEXPOSEEVENT-TYPE + XGCVALUES-LINE_STYLE WINDOW-TOP-NEG-Y MAKE-XCIRCULATEEVENT + MAKE-XCIRCULATEREQUESTEVENT XTRANSLATECOORDINATES + MENU-ITEM-POSITION XSETSIZEHINTS XSTANDARDCOLORMAP-COLORMAP + SET-XPROPERTYEVENT-WINDOW XICONSIZE-MAX_HEIGHT XICONSIZE-MIN_HEIGHT + XGETCOMMAND WINDOW-STD-LINE-ATTR WINDOW-SET-LINE-ATTR + XUNINSTALLCOLORMAP MAKE-SCREENFORMAT XGRAVITYEVENT-X SCREEN-CMAP + XSELECTIONCLEAREVENT-TIME XALLOCNAMEDCOLOR XHEIGHTMMOFSCREEN + XQUERYFONT SCREENFORMAT-EXT_DATA SET-XFOCUSCHANGEEVENT-MODE + WINDOW-SET-XCOLOR WINDOW-SET-COLOR XBITMAPPAD + XCLIENTMESSAGEEVENT-MESSAGE_TYPE XCLIENTMESSAGEEVENT-TYPE + XGRAVITYEVENT-Y XSELECTIONCLEAREVENT-TYPE MAKE-XDESTROYWINDOWEVENT + WINDOW-SYNC XGCVALUES-TILE XCLOSEDISPLAY XGCVALUES-DASH_OFFSET + XEXPOSEEVENT-SERIAL XQUERYKEYMAP WINDOW-ADJUST-BOX-SIDE + VISUAL-BITS_PER_RGB WINDOW-CREATE XSETSTANDARDPROPERTIES + XSELECTIONEVENT-TIME XIMAGE-GREEN_MASK XGCVALUES-FUNCTION + XSETWMCLIENTMACHINE SET-XREPARENTEVENT-TYPE XSELECTIONEVENT-TYPE + XTEXTPROPERTY-ENCODING XCREATECOLORMAP XSHRINKREGION SET-INT-ARRAY + VISUAL-GREEN_MASK XCREATEPIXMAPFROMBITMAPDATA CHAR-ARRAY + SET-XRECTANGLE-X XSETTEXTPROPERTY XCLIENTMESSAGEEVENT-SERIAL + MAKE-XCOLORMAPEVENT SET-XGCVALUES-STIPPLE XFREESTRINGLIST + XSELECTIONCLEAREVENT-SERIAL XSETMODIFIERMAPPING WINDOW-MOVE + XCREATEPIXMAP BARMENU-SELECT SET-XGCVALUES-FILL_RULE + SET-XRECTANGLE-Y WINDOW-LABEL SET-XGCVALUES-TILE + SET-XGCVALUES-FILL_STYLE SET-XGCVALUES-JOIN_STYLE + SET-XGCVALUES-CAP_STYLE SET-XGCVALUES-LINE_STYLE XPENDING + XIMAGE-DEPTH XGCVALUES-STIPPLE BARMENU-DRAW XSYNC XIMAGE-WIDTH + SET-XREPARENTEVENT-SERIAL XSELECTIONEVENT-SERIAL WINDOW-SIZE + XLISTHOSTS XIMAGE-BITS_PER_PIXEL XQUERYCOLORS MAKE-XMODIFIERKEYMAP + XCOLORMAPEVENT-NEW XLISTPIXMAPFORMATS XFONTSTRUCT-EXT_DATA + XRMINITIALIZE XRECTANGLE-HEIGHT XKEYEVENT-TIME SCREEN-MHEIGHT + SCREEN-HEIGHT SET-XRESIZEREQUESTEVENT-TYPE SET-XKEYEVENT-X + SET-XCOLOR-PAD WINDOW-FREE-COLOR XEDATAOBJECT-VISUAL + XMAPPINGEVENT-FIRST_KEYCODE XARC-X XPUTBACKEVENT XKEYEVENT-TYPE + SET-XUNMAPEVENT-FROM_CONFIGURE XNEWMODIFIERMAP XGRAVITYEVENT-TYPE + SET-XKEYEVENT-Y SET-XCOLOR-RED XRESTACKWINDOWS XWITHDRAWWINDOW + XCHANGEGC MENU-REPOSITION XMAPREQUESTEVENT-PARENT MAKE-XEVENT + XEXPOSEEVENT-X VERTEX-POS-X SCREEN-MIN_MAPS SCREEN-MAX_MAPS + XKEYEVENT-STATE XPROPERTYEVENT-TIME WINDOW-QUERY-POINTER-B + MAKE-XCROSSINGEVENT XFREEFONT XKILLCLIENT + XMAPREQUESTEVENT-SEND_EVENT WINDOW-OPEN XIMAGE-RED_MASK + WINDOW-SET-XOR XCHARSTRUCT-RBEARING XCHARSTRUCT-LBEARING + XGETWINDOWATTRIBUTES XEXPOSEEVENT-Y XPROPERTYEVENT-TYPE + VERTEX-POS-Y XSTORECOLORS XCREATEWINDOWEVENT-TYPE + XMAPREQUESTEVENT-DISPLAY MENU-SELECT XSELECTIONCLEAREVENT-SELECTION + MAKE-XCREATEWINDOWEVENT SET-XRESIZEREQUESTEVENT-SERIAL + XDEFINECURSOR XMAPEVENT-TYPE VISUAL-RED_MASK XTEXTWIDTH XGRABBUTTON + XREFRESHKEYBOARDMAPPING XHOSTADDRESS-ADDRESS XGETWMCOLORMAPWINDOWS + XPROPERTYEVENT-STATE MENU-ADJUST-OFFSET XGRAVITYEVENT-SERIAL + XMAPREQUESTEVENT-WINDOW XVISUALINFO-VISUALID GET-ST-POINT + XGRABSERVER XANYEVENT-DISPLAY XIMAGE-BITMAP_UNIT + XCLIENTMESSAGEEVENT-FORMAT XSELECTIONEVENT-SELECTION + SET-XSELECTIONCLEAREVENT-TIME SET-XSELECTIONREQUESTEVENT-TIME + SET-XSELECTIONEVENT-TIME MAKE-XVISIBILITYEVENT XKEYSYMTOKEYCODE + SET-XREPARENTEVENT-X WINDOW-TRACK-MOUSE XPROPERTYEVENT-SERIAL + XCREATEWINDOWEVENT-SERIAL XSETWINDOWBACKGROUND + SET-XSELECTIONCLEAREVENT-TYPE SET-XSELECTIONREQUESTEVENT-TYPE + SET-XSELECTIONEVENT-TYPE WINDOW-FONT-STRING-WIDTH XFREECURSOR + XCREATEGLYPHCURSOR XSETSELECTIONOWNER SET-XWMHINTS-ICON_MASK + XCREATEWINDOW WINDOW-DRAWABLE-WIDTH STRINGIFY XCLASSHINT-RES_CLASS + SET-XREPARENTEVENT-Y XQLENGTH WINDOW-RESET MENU-UNBOX-ITEM + SET-XNOEXPOSEEVENT-MINOR_CODE SET-XNOEXPOSEEVENT-MAJOR_CODE + XEXPOSEEVENT-SEND_EVENT XANYEVENT-SERIAL XGEOMETRY + XVISUALINFO-BITS_PER_RGB MAKE-XFONTPROP XGCVALUES-FONT + SET-XKEYEVENT-TIME XEXPOSEEVENT-DISPLAY + SET-XREPARENTEVENT-OVERRIDE_REDIRECT SET-XGCVALUES-FUNCTION + XIMAGE-HEIGHT XDELETECONTEXT PICMENU-SELECT WINDOW-PAINT + SET-XFONTSTRUCT-MAX_BYTE1 SET-XFONTSTRUCT-MIN_BYTE1 + XSELECTIONEVENT-TARGET SET-XKEYEVENT-TYPE WINDOW-XINIT + SET-XNOEXPOSEEVENT-DRAWABLE SET-XGCVALUES-DASH_OFFSET + XSELECTIONREQUESTEVENT-TIME XCREATEFONTCURSOR WINDOW-DRAW-BOX + XSETCOMMAND XEXPOSEEVENT-WINDOW XTEXTPROPERTY-FORMAT + SET-XSELECTIONCLEAREVENT-SERIAL SET-XSELECTIONREQUESTEVENT-SERIAL + SET-XSELECTIONEVENT-SERIAL XCLIENTMESSAGEEVENT-SEND_EVENT + WINDOW-POLL-MOUSE PICMENU-DRAW SET-XFONTSTRUCT-MAX_CHAR_OR_BYTE2 + SET-XFONTSTRUCT-MIN_CHAR_OR_BYTE2 XDESTROYIMAGE + XSELECTIONCLEAREVENT-SEND_EVENT SET-XKEYEVENT-STATE + XSELECTIONREQUESTEVENT-TYPE WINDOW-FONT-INFO + XSETWINDOWATTRIBUTES-BACKING_PIXEL + XSETWINDOWATTRIBUTES-BORDER_PIXEL + XSETWINDOWATTRIBUTES-BACKGROUND_PIXEL XCLIENTMESSAGEEVENT-DISPLAY + XSELECTIONCLEAREVENT-DISPLAY XCHECKTYPEDEVENT + XCHECKTYPEDWINDOWEVENT SET-XBUTTONEVENT-TIME XKEYEVENT-X + XCHANGEPOINTERCONTROL XSETWINDOWBORDERWIDTH + SET-XDESTROYWINDOWEVENT-TYPE SET-XREPARENTEVENT-PARENT + SET-XBUTTONEVENT-TYPE SET-XGCVALUES-FONT XCLIENTMESSAGEEVENT-WINDOW + XSELECTIONCLEAREVENT-WINDOW SET-XSETWINDOWATTRIBUTES-BACKING_STORE + XKEYEVENT-Y XTEXTPROPERTY-NITEMS SET-XREPARENTEVENT-EVENT + SET-XREPARENTEVENT-SEND_EVENT SET-XKEYEVENT-SERIAL + XSELECTIONEVENT-SEND_EVENT WINDOW-MENU WINDOW-INVERT-AREA-XY + SET-XBUTTONEVENT-STATE XVISUALINFO-DEPTH SET-XREPARENTEVENT-DISPLAY + XSELECTIONEVENT-DISPLAY WINDOW-TRACK-MOUSE-IN-REGION + XINSERTMODIFIERMAPENTRY WINDOW-DRAW-CARAT XCREATEWINDOWEVENT-X + XTEXTPROPERTYTOSTRINGLIST SET-SCREEN-ROOT_DEPTH + XSELECTIONREQUESTEVENT-SERIAL WINDOW-STRING-WIDTH MENU-DESTROY + XSETWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK + XSETWINDOWATTRIBUTES-EVENT_MASK SET-XREPARENTEVENT-WINDOW + XVISUALINFO-COLORMAP_SIZE SET-SCREEN-MWIDTH SET-SCREEN-WIDTH + XINTERNATOM SET-XKEYBOARDCONTROL-BELL_DURATION + SET-XKEYBOARDSTATE-BELL_DURATION XCREATEWINDOWEVENT-Y MENU-OFFSET + SET-XDESTROYWINDOWEVENT-SERIAL SET-SCREEN-BLACK_PIXEL + SET-SCREEN-WHITE_PIXEL SCREEN-ROOT_DEPTH XLISTDEPTHS XLOADQUERYFONT + SET-XBUTTONEVENT-SERIAL XVISUALINFO-VISUAL XFREE WINDOW-SET-COPY + SET-SCREEN-ROOT_VISUAL XTEXTITEM-NCHARS SET-XKEYEVENT-SAME_SCREEN + XTEXTITEM-FONT XCREATEWINDOWEVENT-OVERRIDE_REDIRECT XTEXTITEM-CHARS + SET-XSELECTIONCLEAREVENT-SELECTION + SET-XSELECTIONREQUESTEVENT-SELECTION SET-XSELECTIONEVENT-SELECTION + SET-XKEYBOARDSTATE-GLOBAL_AUTO_REPEAT XFONTSTRUCT-DIRECTION + WINDOW-GEOMETRY XCREATEPIXMAPCURSOR + XSETWINDOWATTRIBUTES-BACKING_PLANES XUNLOADFONT SCREEN-ROOT_VISUAL + SET-XRESIZEREQUESTEVENT-SEND_EVENT MAKE-XUNMAPEVENT + WINDOW-DRAWABLE-HEIGHT XKEYEVENT-ROOT XDELETEMODIFIERMAPENTRY + XSELECTINPUT SET-XRESIZEREQUESTEVENT-DISPLAY XWMHINTS-FLAGS + XGETGCVALUES XVISUALINFO-BLUE_MASK XVISUALINFO-GREEN_MASK + XVISUALINFO-RED_MASK XGRAVITYEVENT-EVENT XGRAVITYEVENT-SEND_EVENT + CHAR-POS WINDOW-INIT-KEYMAP SET-SCREEN-ROOT_INPUT_MASK + WINDOW-DRAW-ELLIPSE-PT WINDOW-DRAW-CIRCLE-PT + SET-XBUTTONEVENT-SAME_SCREEN XVISUALIDFROMVISUAL DEPTH-NVISUALS + XGRAVITYEVENT-DISPLAY WINDOW-RESET-COLOR + SET-XRESIZEREQUESTEVENT-WINDOW ISFUNCTIONKEY + XCREATEWINDOWEVENT-PARENT WINDOW-SCREEN-HEIGHT + XFONTSTRUCT-PROPERTIES XFONTSTRUCT-N_PROPERTIES MENU-BOX-ITEM + SET-XSETWINDOWATTRIBUTES-COLORMAP SCREEN-ROOT_INPUT_MASK + PICMENU-DESTROY XPROPERTYEVENT-SEND_EVENT + XCREATEWINDOWEVENT-SEND_EVENT SET-XSELECTIONREQUESTEVENT-TARGET + SET-XSELECTIONEVENT-TARGET XGRAVITYEVENT-WINDOW XSTORENAMEDCOLOR + MAKE-XGCVALUES XKEYEVENT-DISPLAY XSELECTIONREQUESTEVENT-SELECTION + XMAPEVENT-EVENT XPROPERTYEVENT-DISPLAY SET-XTEXTPROPERTY-ENCODING + XCREATEWINDOWEVENT-DISPLAY SET-XSETWINDOWATTRIBUTES-BORDER_PIXMAP + SET-XSETWINDOWATTRIBUTES-BACKGROUND_PIXMAP XGETWMNORMALHINTS + SET-XCONFIGUREEVENT-BORDER_WIDTH SET-XCONFIGUREEVENT-WIDTH + SET-XCONFIGUREREQUESTEVENT-BORDER_WIDTH + SET-XCONFIGUREREQUESTEVENT-WIDTH XANYEVENT-SEND_EVENT + XDESTROYREGION SET-XKEYMAPEVENT-TYPE SET-XARC-ANGLE1 + WINDOW-MOVETO-XY XPROPERTYEVENT-WINDOW SET-XBUTTONEVENT-BUTTON + XCREATEWINDOWEVENT-WINDOW XSETWMCOLORMAPWINDOWS + SET-XSETWINDOWATTRIBUTES-SAVE_UNDER SET-XBUTTONEVENT-X + SET-XFONTSTRUCT-FID WINDOW-ERASE-AREA-XY XMAPEVENT-DISPLAY + XKEYEVENT-SERIAL XFREEFONTINFO SET-XARC-ANGLE2 XMAPPINGEVENT-COUNT + SET-XCOMPOSESTATUS-CHARS_MATCHED XCHAR2B-BYTE1 + SET-XSELECTIONCLEAREVENT-SEND_EVENT + SET-XSELECTIONREQUESTEVENT-SEND_EVENT + SET-XSELECTIONEVENT-SEND_EVENT XERROREVENT-TYPE SET-XBUTTONEVENT-Y + XWMHINTS-INPUT XWMHINTS-ICON_PIXMAP SCREEN-WHITE_PIXEL + XCONFIGUREEVENT-ABOVE XUNMAPSUBWINDOWS + XSELECTIONREQUESTEVENT-TARGET SET-XSELECTIONCLEAREVENT-DISPLAY + SET-XSELECTIONREQUESTEVENT-DISPLAY SET-XSELECTIONEVENT-DISPLAY + XCHAR2B-BYTE2 SET-SCREEN-MHEIGHT SET-SCREEN-HEIGHT + SET-XSETWINDOWATTRIBUTES-OVERRIDE_REDIRECT XROTATEBUFFERS + SET-XKEYMAPEVENT-SERIAL XBLACKPIXEL XTEXTEXTENTS16 + SET-XCONFIGUREREQUESTEVENT-VALUE_MASK SET-XWMHINTS-ICON_X + MAKE-XERROREVENT COMPILE-DWINDOW WINDOW-STRING-EXTENTS + SET-XSELECTIONCLEAREVENT-WINDOW XFREEFONTNAMES + XFONTSTRUCT-ALL_CHARS_EXIST XMAPEVENT-SERIAL SET-XKEYEVENT-ROOT + SET-XKEYEVENT-X_ROOT SET-XKEYEVENT-Y_ROOT WINDOW-RESET-GEOMETRY + SET-XSETWINDOWATTRIBUTES-CURSOR XCONFIGUREEVENT-TYPE + XMAPPINGEVENT-REQUEST SET-XKEYEVENT-SEND_EVENT XFLUSH + WINDOW-DRAW-ARC-XY MAKE-XARC XREMOVEHOST XKEYEVENT-SAME_SCREEN + WINDOW-COPY-AREA-XY SET-XWMHINTS-ICON_Y WINDOW-DRAW-ELLIPSE-XY + WINDOW-DRAW-CIRCLE-XY WINDOW-DRAW-LINE-XY XERROREVENT-SERIAL + SET-SCREEN-MIN_MAPS SET-SCREEN-MAX_MAPS SET-XKEYEVENT-DISPLAY + MAKE-XWINDOWCHANGES XSELECTIONREQUESTEVENT-SEND_EVENT + SET-DEPTH-DEPTH SET-XCHARSTRUCT-RBEARING SET-XCHARSTRUCT-LBEARING + XGETWINDOWPROPERTY XANYEVENT-WINDOW XFILLPOLYGON + XSELECTIONREQUESTEVENT-DISPLAY XWMHINTS-INITIAL_STATE + SET-XKEYEVENT-WINDOW SET-XKEYEVENT-SUBWINDOW XDRAWPOINTS INT-POS + SET-XBUTTONEVENT-ROOT SET-XBUTTONEVENT-X_ROOT + SET-XBUTTONEVENT-Y_ROOT SET-XDESTROYWINDOWEVENT-EVENT + SET-XDESTROYWINDOWEVENT-SEND_EVENT XICONIFYWINDOW + SET-XBUTTONEVENT-SEND_EVENT XLASTKNOWNREQUESTPROCESSED + SET-XDESTROYWINDOWEVENT-DISPLAY XADDTOEXTENSIONLIST + XCONFIGUREEVENT-SERIAL XGETICONSIZES WINDOW-DRAW-CROSS-XY + WINDOW-DRAW-CROSSHAIRS-XY XCREATESIMPLEWINDOW + SET-XBUTTONEVENT-DISPLAY XRECTINREGION XREPARENTWINDOW + MAKE-XFONTSTRUCT XRESIZEWINDOW SET-XDESTROYWINDOWEVENT-WINDOW + WINDOW-DRAW-ARROW-XY WINDOW-WAIT-EXPOSURE MENU-SIZE + XMAPEVENT-OVERRIDE_REDIRECT SET-XBUTTONEVENT-WINDOW + SET-XBUTTONEVENT-SUBWINDOW SET-XGRAPHICSEXPOSEEVENT-MINOR_CODE + SET-XGRAPHICSEXPOSEEVENT-MAJOR_CODE XCLEARWINDOW + BARMENU-UPDATE-VALUE SET-XCONFIGUREEVENT-HEIGHT + SET-XCONFIGUREREQUESTEVENT-HEIGHT SET-XCOLORMAPEVENT-NEW + SET-XEXPOSEEVENT-TYPE SET-XGRAPHICSEXPOSEEVENT-DRAWABLE + XMOVERESIZEWINDOW XREPARENTEVENT-TYPE XCOLOR-PAD + XWMHINTS-ICON_WINDOW XGETZOOMHINTS MAKE-XFOCUSCHANGEEVENT + MAKE-XTEXTITEM16 XUNIQUECONTEXT XWMHINTS-WINDOW_GROUP + SET-XTEXTPROPERTY-FORMAT XWINDOWATTRIBUTES-MAP_INSTALLED XDRAWPOINT + XCOPYGC SET-XEXPOSEEVENT-SERIAL MAKE-XEXPOSEEVENT SET-XIMAGE-OBDATA + XCHECKWINDOWEVENT SET-XSETWINDOWATTRIBUTES-WIN_GRAVITY + SET-XSETWINDOWATTRIBUTES-BIT_GRAVITY XCONFIGUREEVENT-X XCOLOR-RED + XREPARENTEVENT-SERIAL XKEYEVENT-SEND_EVENT MAKE-XPOINT XTEXTWIDTH16 + MAKE-XHOSTADDRESS XCONFIGUREEVENT-Y SET-XTEXTPROPERTY-NITEMS + SET-SCREENFORMAT-SCANLINE_PAD WINDOW-MAP + XCOMPOSESTATUS-CHARS_MATCHED MAKE-_XQEVENT SET-XTEXTITEM-FONT + SET-XTEXTITEM16-FONT MAKE-XGRAPHICSEXPOSEEVENT + XRESIZEREQUESTEVENT-TYPE XWMGEOMETRY XKEYEVENT-SUBWINDOW + XCONFIGUREREQUESTEVENT-ABOVE SET-XKEYMAPEVENT-SEND_EVENT + SET-XTEXTITEM-NCHARS SET-XTEXTITEM-CHARS SET-XTEXTITEM16-NCHARS + SET-XTEXTITEM16-CHARS XMODIFIERKEYMAP-MAX_KEYPERMOD XBITMAPUNIT + XCONFIGUREEVENT-OVERRIDE_REDIRECT XGETGEOMETRY XMAPEVENT-SEND_EVENT + XWINDOWCHANGES-SIBLING SET-XKEYMAPEVENT-DISPLAY XPOLYGONREGION + XROTATEWINDOWPROPERTIES MAKE-XGRAVITYEVENT XSETWMNORMALHINTS + MENU-MOVETO-XY DOWINDOWCOM SET-XGRAPHICSEXPOSEEVENT-WIDTH + SET-XIMAGE-BYTES_PER_LINE XSCREENCOUNT XALLPLANES + SET-XKEYMAPEVENT-WINDOW XDISPLAYWIDTH XCONFIGUREREQUESTEVENT-TYPE + SET-XFONTSTRUCT-PER_CHAR SET-XFONTSTRUCT-DEFAULT_CHAR + XGETWMICONNAME XERROREVENT-DISPLAY XWINDOWATTRIBUTES-BACKING_STORE + MAKE-XCHAR2B SET-VISUAL-VISUALID PICMENU-CREATE-FROM-SPEC + PICMENU-CREATE-SPEC XRESIZEREQUESTEVENT-SERIAL + XPIXMAPFORMATVALUES-SCANLINE_PAD XKEYEVENT-X_ROOT + SET-XCREATEWINDOWEVENT-BORDER_WIDTH SET-XCREATEWINDOWEVENT-WIDTH + XWINDOWATTRIBUTES-MAP_STATE SET-SCREENFORMAT-DEPTH XGETWMPROTOCOLS + SET-XEXPOSEEVENT-X XKEYEVENT-Y_ROOT XCONFIGUREEVENT-EVENT + XCONFIGUREEVENT-SEND_EVENT XSETTSORIGIN XKEYEVENT-WINDOW + SET-SCREENFORMAT-BITS_PER_PIXEL SET-XHOSTADDRESS-FAMILY + XGETKEYBOARDMAPPING XCONFIGUREEVENT-DISPLAY XREPARENTEVENT-X + SET-XEXPOSEEVENT-Y ISMODIFIERKEY XCONFIGUREREQUESTEVENT-SERIAL + XSETLINEATTRIBUTES XSETIOERRORHANDLER WINDOW-GET-GEOMETRY-B + XREPARENTEVENT-Y XCONFIGUREEVENT-WINDOW SET-VISUAL-BITS_PER_RGB + MENU-SELECT! BARMENU-CALCULATE-SIZE XLOWERWINDOW XSTORENAME + XMAPEVENT-WINDOW XUNGRABKEY XPIXMAPFORMATVALUES-DEPTH + SET-XSTANDARDCOLORMAP-VISUALID XREPARENTEVENT-OVERRIDE_REDIRECT + SET-XFONTSTRUCT-MAX_BOUNDS SET-XFONTSTRUCT-MIN_BOUNDS + XCONFIGUREREQUESTEVENT-DETAIL SET-XFONTSTRUCT-DESCENT + SET-XFONTSTRUCT-ASCENT XLISTINSTALLEDCOLORMAPS + XPIXMAPFORMATVALUES-BITS_PER_PIXEL XDISPLAYPLANES + SET-XMAPPINGEVENT-FIRST_KEYCODE XGETINPUTFOCUS PICMENU-UNBOX-ITEM + XUNMAPEVENT-TYPE XWINDOWATTRIBUTES-SCREEN XSETICONSIZES + XMODIFIERKEYMAP-MODIFIERMAP XWINDOWATTRIBUTES-COLORMAP + XSIZEHINTS-FLAGS XINIT SET-XEXPOSEEVENT-SEND_EVENT XCOPYPLANE + XREPARENTEVENT-PARENT SET-XCOMPOSESTATUS-COMPOSE_PTR + SET-XCIRCULATEEVENT-PLACE SET-XCIRCULATEREQUESTEVENT-PLACE + SET-XEXPOSEEVENT-DISPLAY XGRAPHICSEXPOSEEVENT-TYPE XFREEPIXMAP + XDISPLAYCELLS SET-XTIMECOORD-TIME XREPARENTEVENT-EVENT + XREPARENTEVENT-SEND_EVENT MENU-CREATE XGETKEYBOARDCONTROL + MENU-CALCULATE-SIZE SET-XGRAPHICSEXPOSEEVENT-HEIGHT + XGETFONTPROPERTY XUNMAPEVENT-SERIAL XREPARENTEVENT-DISPLAY + XDISPLAYHEIGHT SET-XEXPOSEEVENT-WINDOW XCIRCULATEEVENT-PLACE + SET-XEXTCODES-FIRST_ERROR XCONFIGUREREQUESTEVENT-X XGETSUBIMAGE + XLOOKUPKEYSYM XACTIVATESCREENSAVER XWINDOWATTRIBUTES-SAVE_UNDER + XNOEXPOSEEVENT-MINOR_CODE XNOEXPOSEEVENT-MAJOR_CODE + XRECONFIGUREWMWINDOW XLOOKUPCOLOR XSETZOOMHINTS + SET-XCREATEWINDOWEVENT-HEIGHT XREPARENTEVENT-WINDOW + XCONFIGUREREQUESTEVENT-Y SET-XERROREVENT-MINOR_CODE + SET-XERROREVENT-REQUEST_CODE SET-XERROREVENT-ERROR_CODE + SET-XERROREVENT-RESOURCEID SET-XARC-WIDTH XSETREGION + SET-XVISIBILITYEVENT-TYPE XGRAPHICSEXPOSEEVENT-SERIAL + XNOEXPOSEEVENT-DRAWABLE XXORREGION SET-XGRAPHICSEXPOSEEVENT-COUNT + SET-XIMAGE-XOFFSET SET-XIMAGE-BITMAP_BIT_ORDER + SET-XIMAGE-BYTE_ORDER XWINDOWATTRIBUTES-OVERRIDE_REDIRECT + SET-XEXTCODES-FIRST_EVENT XSETCLOSEDOWNMODE XRAISEWINDOW + SET-XVISIBILITYEVENT-STATE SET-XCROSSINGEVENT-MODE XREADBITMAPFILE + SET-VISUAL-BLUE_MASK SET-VISUAL-GREEN_MASK SET-VISUAL-RED_MASK + SET-XIMAGE-FORMAT SET-SCREEN-CMAP SET-XCIRCULATEEVENT-TYPE + SET-XCIRCULATEREQUESTEVENT-TYPE XMAXREQUESTSIZE + XRESIZEREQUESTEVENT-SEND_EVENT XGRABKEY + SET-XWINDOWATTRIBUTES-MAP_INSTALLED + SET-XSTANDARDCOLORMAP-BASE_PIXEL XWINDOWATTRIBUTES-CLASS + XLISTFONTSWITHINFO XRESIZEREQUESTEVENT-DISPLAY + XFOCUSCHANGEEVENT-MODE XEVENTSQUEUED SET-XVISIBILITYEVENT-SERIAL + XDRAWTEXT XCIRCULATEEVENT-TYPE INT-ARRAY XMAPRAISED + XCONFIGUREREQUESTEVENT-PARENT WINDOW-GET-CIRCLE + XKEYBOARDCONTROL-LED XWINDOWATTRIBUTES-ROOT + XRESIZEREQUESTEVENT-WINDOW XWHITEPIXEL XCREATEGC + XCONFIGUREREQUESTEVENT-SEND_EVENT PICMENU-CALCULATE-SIZE + XDRAWIMAGESTRING16 XCROSSINGEVENT-TIME + XCONFIGUREREQUESTEVENT-DISPLAY SET-XCIRCULATEEVENT-SERIAL + SET-XCIRCULATEREQUESTEVENT-SERIAL XUNMAPWINDOW XCROSSINGEVENT-TYPE + SET-XCLASSHINT-RES_NAME MAKE-XKEYMAPEVENT XSETWMICONNAME + MAKE-XKEYBOARDSTATE XEMPTYREGION XCLIPBOX XSETSTIPPLE XEQUALREGION + XFORCESCREENSAVER XCONFIGUREREQUESTEVENT-WINDOW + XCIRCULATEEVENT-SERIAL PICMENU-BUTTON-CONTAINSXY? XWINDOWEVENT + WINDOW-GET-CLICK XCROSSINGEVENT-STATE XGRAPHICSEXPOSEEVENT-X + XSETWMPROTOCOLS XSIZEHINTS-WIN_GRAVITY XGRAPHICSEXPOSEEVENT-Y + SET-XWINDOWCHANGES-SIBLING XGETPOINTERMAPPING XFETCHNAME + XCHANGEACTIVEPOINTERGRAB SET-XWINDOWATTRIBUTES-BACKING_STORE + SET-XTIMECOORD-X XCROSSINGEVENT-SERIAL + SET-XWINDOWATTRIBUTES-MAP_STATE SCREEN-DEFAULT_GC SET-XARC-HEIGHT + XGETSCREENSAVER SET-XVISUALINFO-SCREEN SET-XTIMECOORD-Y + SET-DEPTH-NVISUALS XCOMPOSESTATUS-COMPOSE_PTR + MAKE-XSETWINDOWATTRIBUTES XUNMAPEVENT-EVENT XUNMAPEVENT-SEND_EVENT + XMASKEVENT XPEEKEVENT XKEYBOARDCONTROL-AUTO_REPEAT_MODE + XKEYBOARDCONTROL-LED_MODE XCROSSINGEVENT-DETAIL XTEXTITEM16-DELTA + XUNMAPEVENT-DISPLAY XWINDOWATTRIBUTES-WIN_GRAVITY + XWINDOWATTRIBUTES-BIT_GRAVITY XCONFIGUREWINDOW XSETINPUTFOCUS + XCROSSINGEVENT-SAME_SCREEN MAKE-XKEYBOARDCONTROL + XCIRCULATEREQUESTEVENT-PLACE XCLEARAREA XFONTSTRUCT-FID + XUNMAPEVENT-WINDOW XGRAPHICSEXPOSEEVENT-SEND_EVENT + XKEYBOARDCONTROL-BELL_PITCH XGETRGBCOLORMAPS XPOINT-X XSETPLANEMASK + XFETCHBYTES XGRAPHICSEXPOSEEVENT-DISPLAY XSUBTRACTREGION + XEXTCODES-MAJOR_OPCODE SET-XSTANDARDCOLORMAP-BLUE_MULT + SET-XSTANDARDCOLORMAP-GREEN_MULT SET-XSTANDARDCOLORMAP-RED_MULT + MAKE-XTIMECOORD SET-XWINDOWATTRIBUTES-SCREEN XADDTOSAVESET + XGETPOINTERCONTROL WINDOW-GET-LATEX-POSITION + WINDOW-GET-LINE-POSITION WINDOW-GET-ICON-POSITION + WINDOW-GET-BOX-POSITION WINDOW-GET-MOUSE-POSITION + SET-XWINDOWATTRIBUTES-COLORMAP XCROSSINGEVENT-X + XDISABLEACCESSCONTROL SET-XMAPPINGEVENT-COUNT XGETNORMALHINTS + SET-XVISIBILITYEVENT-SEND_EVENT XCROSSINGEVENT-Y XSETFOREGROUND + SET-XVISIBILITYEVENT-DISPLAY SET-XICONSIZE-HEIGHT_INC + SET-XICONSIZE-WIDTH_INC MAKE-XCOLOR + SET-XCIRCULATEREQUESTEVENT-PARENT XMOVEWINDOW + XCIRCULATEREQUESTEVENT-TYPE XALLOCCOLOR XSETDASHES + XGCVALUES-ARC_MODE XDRAWARC MENU-SELECT-B SET-XVISUALINFO-CLASS + SET-XWINDOWATTRIBUTES-SAVE_UNDER SET-XCIRCULATEEVENT-EVENT + SET-XCIRCULATEEVENT-SEND_EVENT + SET-XCIRCULATEREQUESTEVENT-SEND_EVENT SET-XVISIBILITYEVENT-WINDOW + XOPENDISPLAY XQUERYBESTSIZE MAKE-XSIZEHINTS + SET-XMAPPINGEVENT-REQUEST PICMENU-BOX-ITEM SET-DEPTH-VISUALS + WINDOW-GET-CHARS SET-XEDATAOBJECT-VISUAL XKEYBOARDSTATE-BELL_PITCH + MAKE-XSEGMENT XALLOCSIZEHINTS SET-XCIRCULATEEVENT-DISPLAY + SET-XCIRCULATEREQUESTEVENT-DISPLAY XFREEEXTENSIONLIST + SET-XSTANDARDCOLORMAP-BLUE_MAX SET-XSTANDARDCOLORMAP-GREEN_MAX + SET-XSTANDARDCOLORMAP-RED_MAX ISMISCFUNCTIONKEY XSIZEHINTS-X + XCIRCULATEEVENT-EVENT XCIRCULATEEVENT-SEND_EVENT + XSTANDARDCOLORMAP-VISUALID MAKE-XTEXTITEM SET-XICONSIZE-MAX_WIDTH + SET-XICONSIZE-MIN_WIDTH XGETVISUALINFO MENU-ITEM-VALUE + SET-XCIRCULATEEVENT-WINDOW SET-XCIRCULATEREQUESTEVENT-WINDOW + XCIRCULATEEVENT-DISPLAY XUNGRABKEYBOARD SET-XPROPERTYEVENT-ATOM + XSIZEHINTS-Y SET-XWINDOWATTRIBUTES-OVERRIDE_REDIRECT MAKE-XKEYEVENT + XCIRCULATEREQUESTEVENT-SERIAL XGCVALUES-BACKGROUND WINDOW-GET-CROSS + WINDOW-ADJ-BOX-XY XEXTCODES-EXTENSION XCROSSINGEVENT-ROOT + XCROSSINGEVENT-X_ROOT XCROSSINGEVENT-Y_ROOT XCIRCULATEEVENT-WINDOW + OPEN-WINDOW XVENDORRELEASE SET-XSIZEHINTS-X SET-XSIZEHINTS-FLAGS + SET-XCROSSINGEVENT-FOCUS XIMAGE-BYTES_PER_LINE + XCROSSINGEVENT-SEND_EVENT SET-XCLASSHINT-RES_CLASS + SCREEN-BACKING_STORE XCROSSINGEVENT-DISPLAY SET-XSIZEHINTS-Y + SET-XWINDOWATTRIBUTES-CLASS XDEFAULTGC WINDOW-SET-ERASE + XDISPLAYMOTIONBUFFERSIZE XUNDEFINECURSOR DEPTH-DEPTH + SCREEN-EXT_DATA XRESETSCREENSAVER XSETGRAPHICSEXPOSURES + SET-XWINDOWATTRIBUTES-ROOT XCROSSINGEVENT-WINDOW + XCROSSINGEVENT-SUBWINDOW SET-XCHAR2B-BYTE1 XROOTWINDOW + XFONTSTRUCT-MAX_BYTE1 XFONTSTRUCT-MIN_BYTE1 SET-XCHAR2B-BYTE2 + XGCVALUES-FOREGROUND XADDEXTENSION XSTRINGTOCONTEXT + XSETPOINTERMAPPING SET-XIMAGE-DATA XFONTSTRUCT-MAX_CHAR_OR_BYTE2 + XFONTSTRUCT-MIN_CHAR_OR_BYTE2 BARMENU-CREATE XSETARCMODE + XCREATEIMAGE XKEYBOARDCONTROL-KEY XDEFAULTSCREEN XSETSCREENSAVER + XCIRCULATESUBWINDOWSDOWN XKEYBOARDSTATE-LED_MASK XINTERSECTREGION + MAKE-XMAPREQUESTEVENT XGETWMSIZEHINTS XKEYBOARDCONTROL-BELL_PERCENT + XKEYBOARDCONTROL-KEY_CLICK_PERCENT XCOLOR-BLUE XSETBACKGROUND + XSTANDARDCOLORMAP-BASE_PIXEL XUNIONREGION VERTEX-POS-FLAG + SET-XICONSIZE-MAX_HEIGHT SET-XICONSIZE-MIN_HEIGHT XSETSUBWINDOWMODE + XGCVALUES-CLIP_Y_ORIGIN XGCVALUES-CLIP_X_ORIGIN XGCVALUES-CLIP_MASK + SET-XRECTANGLE-WIDTH XSETRGBCOLORMAPS XGCONTEXTFROMGC + XALLOCCOLORPLANES SET-XWINDOWATTRIBUTES-WIN_GRAVITY + SET-XWINDOWATTRIBUTES-BIT_GRAVITY MAKE-XMAPPINGEVENT + XDRAWIMAGESTRING MAKE-XCOMPOSESTATUS XIMAGE-OBDATA XIMAGE-DATA + XCIRCULATESUBWINDOWS SET-XCLIENTMESSAGEEVENT-MESSAGE_TYPE + SET-XCLIENTMESSAGEEVENT-TYPE XSTOREBYTES + XCIRCULATEREQUESTEVENT-PARENT XCOLORMAPEVENT-TYPE VISUAL-EXT_DATA + SET-XSIZEHINTS-WIN_GRAVITY XCIRCULATEREQUESTEVENT-SEND_EVENT + XKEYBOARDSTATE-BELL_PERCENT XKEYBOARDSTATE-KEY_CLICK_PERCENT + XSETNORMALHINTS XVISIBILITYEVENT-TYPE XSETTILE XAUTOREPEATON + XALLOCCOLORCELLS XGETMOTIONEVENTS XCOLORMAPEVENT-STATE PICMENU-SPEC + XCIRCULATEREQUESTEVENT-DISPLAY XEVENTMASKOFSCREEN + SET-XKEYBOARDCONTROL-LED XGRABKEYBOARD XKEYBOARDSTATE-AUTO_REPEATS + XIMAGE-BYTE_ORDER XVISIBILITYEVENT-STATE XROOTWINDOWOFSCREEN + XEXPOSEEVENT-WIDTH XCIRCULATEREQUESTEVENT-WINDOW + SET-XCLIENTMESSAGEEVENT-SERIAL SET-XCOLOR-GREEN window-code-char + gcfunction gcforeground gcbackground GXxor GXcopy LineSolid CapButt + JoinMiter XK_Shift_R XK_Shift_L XK_Control_L XK_Control_R XK_Alt_R + XK_Alt_L XK_Return XK_Tab XK_BackSpace window-get-raw-char + ) :user) + +(import '(*WINDOW-META* *TEXT-WIDTH-RETURN* *WINDOW-STRING* *WINDOW-SCREEN* + *WINDOW-EVENT* *WINDOW-MENU* *WINDOW-KEYMAP* *WINDOW-SHIFT* + *BORDER-WIDTH* *ROOT-X-RETURN* *POS-X* *ROOT-Y-RETURN* *DEFAULT-GC* + *DEFAULT-EVENT* *GC-VALUES* *MENU-TITLE-PAD* *DEFAULT-SCREEN* + *CHILD-RETURN* *DEPTH-RETURN* *WINDOW-ADD-MENU-TITLE* + *OVERALL-RETURN* *WINDOW-DEFAULT-BORDER* + *BORDER-WIDTH-RETURN* *DEFAULT-COLORMAP* *MOUSE-X* *MOUSE-Y* + *WINDOW-INPUT-STRING-CHARWIDTH* A-WINDOW *WINDOW-DISPLAY* + *WINDOW-ATTRIBUTES* *DESCENT-RETURN* + *WIDTH-RETURN* *WIN-Y-RETURN* *WIN-X-RETURN* *WINDOW-KEYINIT* + *BARMENU-UPDATE-VALUE-CONS* *ROOT-WINDOW* *PICMENU-NO-SELECTION* + *WINDOW-CTRL* *WINDOW-XCOLOR* *DIRECTION-RETURN* *WINDOW-FONTS* + *WINDOW-ATTR* *POS-Y* *X-RETURN* *Y-RETURN* *WIN-WIDTH* + *MASK-RETURN* *ASCENT-RETURN* *ROOT-RETURN* *HEIGHT-RETURN* + *BLACK-PIXEL* *WINDOW-DEFAULT-FONT-NAME* *DEFAULT-BG-COLOR* + *DEFAULT-FG-COLOR* *DEFAULT-SIZE-HINTS* *DEFAULT-DISPLAY* + *WINDOW-DEFAULT-CURSOR* *WINDOW-SHIFTKEYMAP* *WINDOW-DEFAULT-POS-X* + *WINDOW-DEFAULT-POS-Y* *WINDOW-MENU-CODE* *MOUSE-WINDOW* + *WINDOW-INPUT-STRING-X* *WINDOW-INPUT-STRING-Y* *WINDOW-STRING-MAX* + *WINDOW-STRING-COUNT* *WINDOW-SAVE-FOREGROUND* + *WINDOW-SAVE-FUNCTION* *WIN-HEIGHT* *WHITE-PIXEL* + *min-keycodes-return* *max-keycodes-return* *keycodes-return* + *window-shift-keys* *window-control-keys* *window-meta-keys* + ) :user) + +(import '(courier-bold-12 8x10 9x15 top bottom + left right center paint xor erase + copy close move clear display-size + menu window picmenu picmenu-spec barmenu + picmenu-button) :user) diff --git a/xgcl-2/gcl_index.lsp b/xgcl-2/gcl_index.lsp new file mode 100644 index 0000000..3491201 --- /dev/null +++ b/xgcl-2/gcl_index.lsp @@ -0,0 +1,88 @@ +; index.lsp Gordon S. Novak Jr. 08 Dec 00; 18 May 06 + +; This program processes LaTeX index entries, printing an index in +; either LaTeX or HTML form. + +; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + +; To use: Gather the LaTeX index data: use \index{foo} within the +; text and include a \makeindex command at the top of the file, +; producing a file .idx when the file is run through LaTeX. +; Use an editor to change the index data from LaTeX form to Lisp: +; \indexentry{combination}{37} LaTeX +; ((combination) 37) Lisp + +; We assume that indexdata is a list of such entries, as illustrated +; at the end of this file. + +; Warning: quote characters or apostrophes within the indexed +; entries will not read into Lisp as expected. +; Get rid of ' or change it to \' + +; Start /p/bin/gcl +; (load "index.lsp") +; (printindex indexdata) ; for LaTeX output +; (printindex indexdata "prefix") ; for HTML output +; where "prefix" is the file name prefix for HTML files. + +; Print index for LaTeX given a list of items ((words ...) page-number) +(in-package 'xlib) +(defun printindex (origlst &optional html) + (let (lst top) + (setq lst + (sort origlst + #'(lambda (x y) (or (wordlist< (car x) (car y)) + (and (equal (car x) (car y)) + (< (cadr x) (cadr y))))))) + (terpri) + (while lst + (setq top (pop lst)) + (if (not html) + (princ "\\item ")) + (dolist (word (car top)) + (princ (string-downcase (symbol-name word))) (princ " ")) + (printindexn (cadr top) html nil) + (while (equal (caar lst) (car top)) + (setq top (pop lst)) + (printindexn (cadr top) html t) ) + (if html + (format t "

    ~%") + (terpri)) ) )) + +(defun wordlist< (x y) + (and (consp x) (consp y) + (or (string< (symbol-name (car x)) + (symbol-name (car y))) + (and (eq (car x) (car y)) + (or (and (null (cdr x)) (cdr y)) + (and (cdr x) (cdr y) + (wordlist< (cdr x) (cdr y)))))))) + +(defun printindexn (n html comma) + (if comma (princ ", ")) + (if html + (format t "~D" html n n) + (princ n)) ) + +(setq indexdata '( + +; Insert index entry data here. Data should look like: +; ((isomorphism) 20) +; ((artificial intelligence) 30) + +)) diff --git a/xgcl-2/gcl_init_xgcl.lsp b/xgcl-2/gcl_init_xgcl.lsp new file mode 100644 index 0000000..cc89f2d --- /dev/null +++ b/xgcl-2/gcl_init_xgcl.lsp @@ -0,0 +1,118 @@ +; Copyright (c) 1994 William F. Schelter + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. +(in-package :XLIB) +(in-package "COMPILER") +(in-package "SYSTEM") +(defvar *command-args* nil) +(in-package "USER") +(in-package "LISP") + +(lisp::in-package "SLOOP") +;;Appropriate for Austin +#-winnt +(setq SYSTEM:*DEFAULT-TIME-ZONE* 6) +#+winnt +(setq SYSTEM:*DEFAULT-TIME-ZONE* (GET-SYSTEM-TIME-ZONE)) + +(in-package "USER") +(progn (allocate 'cons 100) (allocate 'string 40) + (system:init-system) (gbc t) + (si::multiply-bignum-stack 25) + (or si::*link-array* + (setq si::*link-array* + (make-array 500 :element-type 'fixnum :fill-pointer 0))) + (use-fast-links t) +(setq compiler::*cmpinclude* "") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp") + (gbc t) (load #"../cmpnew/cmpopt.lsp") (gbc t) +(load #"../lsp/auto.lsp") (gbc t) +(defun si::src-path (x) + (si::string-concatenate (or si::*lib-directory* "GCLDIR/") x)) + + (when compiler::*cmpinclude-string* + (with-open-file (st "../h/cmpinclude.h") + (let + ((tem (make-array (file-length st) :element-type 'standard-char + :static t))) + (if (si::fread tem 0 (length tem) st) + (setq compiler::*cmpinclude-string* tem))))) + ;;compile-file is in cmpmain.lsp + + (setf (symbol-function 'si:clear-compiler-properties) + (symbol-function 'compiler::compiler-clear-compiler-properties)) +; (load "../lsp/setdoc.lsp") + (setq system::*old-top-level* (symbol-function 'system:top-level)) +(defvar si::*command-args* nil) +(defun si::get-command-arg (a &optional val-if-there) + ;; return non nil if a is in si::*command-args* and return + ;; the string which is after it if there is one" + (let ((tem (member a si::*command-args* :test 'equal))) + (if tem (or val-if-there (cadr tem) t)))) +(defvar si::*lib-directory* nil) +(defun system::gcl-top-level (&aux tem) + (dotimes (i (si::argc)) + (setq si::*command-args* (cons (si::argv i) si::*command-args*))) + (setq si::*command-args* (nreverse si::*command-args* )) + (setq si::*system-directory* + (or (si::get-command-arg "-dir") + (car si::*command-args*))) + (setq si::*lib-directory* (si::get-command-arg "-libdir")) + + (when (si::get-command-arg "-compile") + (let ((system::*quit-tag* (cons nil nil)) + (system::*quit-tags* nil) (system::*break-level* '()) + (system::*break-env* nil) (system::*ihs-base* 1) + (system::*ihs-top* 1) (system::*current-ihs* 1) + (*break-enable* nil)) + (system:error-set + '(progn + (compile-file (si::get-command-arg "-compile") + :output-file + (or (si::get-command-arg "-o") + (si::get-command-arg "-compile")) + :o-file (not (si::get-command-arg "-no-o" t)) + :c-file (si::get-command-arg "-system-p" t) + :h-file (si::get-command-arg "-system-p" t) + :data-file (si::get-command-arg "-system-p" t) + :system-p (si::get-command-arg "-system-p" t)))) + (bye (if compiler::*error-p* 1 0)))) + (format t "GCL (GNU Common Lisp) ~A~%~a~%~a~%" "DATE" + "Licensed under GNU Public Library License" + "Contains Enhancements by W. Schelter") + (setq si::*ihs-top* 1) + (in-package 'system::user) (incf system::*ihs-top* 2) + (funcall system::*old-top-level*)) + (setq si::*gcl-version* 600) + (defun lisp-implementation-version nil (format nil "1-~a" si::*gcl-version*)) + (setq si:*inhibit-macro-special* t) + ;(setq *modules* nil) + (gbc t) (system:reset-gbc-count) + (allocate 'cons 200) + (defun system:top-level nil (system::gcl-top-level)) + (unintern 'system) + (unintern 'lisp) + (unintern 'compiler) + (unintern 'user) + (si::chdir "/d19/staff/wfs/novak-xgcl")(user::user-init)(si::save-system "saved_xgcl") + (if (fboundp 'user-init) (user-init)) + (system:save-system "saved_gcl") (bye) + (defun system:top-level nil (system::gcl-top-level)) + (save "saved_gcl") (bye)) + diff --git a/xgcl-2/gcl_keysymdef.lsp b/xgcl-2/gcl_keysymdef.lsp new file mode 100644 index 0000000..5dbf050 --- /dev/null +++ b/xgcl-2/gcl_keysymdef.lsp @@ -0,0 +1,1151 @@ +(in-package :XLIB) +; keysymdef.lsp modified by Hiep Huu Nguyen 27 Aug 92 + +; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +;; $XConsortium: keysymdef.h,v 1.13 89/12/12 16:23:30 rws Exp $ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconstant XK_VoidSymbol #xFFFFFF ;; void symbol + +;;#ifdef XK_MISCELLANY +;; + ; TTY Functions, cleverly chosen to map to ascii, for convenience of + ; programming, but could have been arbitrary at the cost of lookup + ; tables in client code. + + +)(defconstant XK_BackSpace #xFF08 ;; back space, back char +)(defconstant XK_Tab #xFF09 +)(defconstant XK_Linefeed #xFF0A ;; Linefeed, LF +)(defconstant XK_Clear #xFF0B +)(defconstant XK_Return #xFF0D ;; Return, enter +)(defconstant XK_Pause #xFF13 ;; Pause, hold +)(defconstant XK_Scroll_Lock #xFF14 +)(defconstant XK_Escape #xFF1B +)(defconstant XK_Delete #xFFFF ;; Delete, rubout + + + +;; International & multi-key character composition + +)(defconstant XK_Multi_key #xFF20 ;; Multi-key character compose + +;; Japanese keyboard support + +)(defconstant XK_Kanji #xFF21 ;; Kanji, Kanji convert +)(defconstant XK_Muhenkan #xFF22 ;; Cancel Conversion +)(defconstant XK_Henkan_Mode #xFF23 ;; Start/Stop Conversion +)(defconstant XK_Henkan #xFF23 ;; Alias for Henkan_Mode +)(defconstant XK_Romaji #xFF24 ;; to Romaji +)(defconstant XK_Hiragana #xFF25 ;; to Hiragana +)(defconstant XK_Katakana #xFF26 ;; to Katakana +)(defconstant XK_Hiragana_Katakana #xFF27 ;; Hiragana/Katakana toggle +)(defconstant XK_Zenkaku #xFF28 ;; to Zenkaku +)(defconstant XK_Hankaku #xFF29 ;; to Hankaku +)(defconstant XK_Zenkaku_Hankaku #xFF2A ;; Zenkaku/Hankaku toggle +)(defconstant XK_Touroku #xFF2B ;; Add to Dictionary +)(defconstant XK_Massyo #xFF2C ;; Delete from Dictionary +)(defconstant XK_Kana_Lock #xFF2D ;; Kana Lock +)(defconstant XK_Kana_Shift #xFF2E ;; Kana Shift +)(defconstant XK_Eisu_Shift #xFF2F ;; Alphanumeric Shift +)(defconstant XK_Eisu_toggle #xFF30 ;; Alphanumeric toggle + +;; Cursor control & motion + +)(defconstant XK_Home #xFF50 +)(defconstant XK_Left #xFF51 ;; Move left, left arrow +)(defconstant XK_Up #xFF52 ;; Move up, up arrow +)(defconstant XK_Right #xFF53 ;; Move right, right arrow +)(defconstant XK_Down #xFF54 ;; Move down, down arrow +)(defconstant XK_Prior #xFF55 ;; Prior, previous +)(defconstant XK_Next #xFF56 ;; Next +)(defconstant XK_End #xFF57 ;; EOL +)(defconstant XK_Begin #xFF58 ;; BOL + + +;; Misc Functions + +)(defconstant XK_Select #xFF60 ;; Select, mark +)(defconstant XK_Print #xFF61 +)(defconstant XK_Execute #xFF62 ;; Execute, run, do +)(defconstant XK_Insert #xFF63 ;; Insert, insert here +)(defconstant XK_Undo #xFF65 ;; Undo, oops +)(defconstant XK_Redo #xFF66 ;; redo, again +)(defconstant XK_Menu #xFF67 +)(defconstant XK_Find #xFF68 ;; Find, search +)(defconstant XK_Cancel #xFF69 ;; Cancel, stop, abort, exit +)(defconstant XK_Help #xFF6A ;; Help, ? +)(defconstant XK_Break #xFF6B +)(defconstant XK_Mode_switch #xFF7E ;; Character set switch +)(defconstant XK_script_switch #xFF7E ;; Alias for mode_switch +)(defconstant XK_Num_Lock #xFF7F + +;; Keypad Functions, keypad numbers cleverly chosen to map to ascii + +)(defconstant XK_KP_Space #xFF80 ;; space +)(defconstant XK_KP_Tab #xFF89 +)(defconstant XK_KP_Enter #xFF8D ;; enter +)(defconstant XK_KP_F1 #xFF91 ;; PF1, KP_A, ... +)(defconstant XK_KP_F2 #xFF92 +)(defconstant XK_KP_F3 #xFF93 +)(defconstant XK_KP_F4 #xFF94 +)(defconstant XK_KP_Equal #xFFBD ;; equals +)(defconstant XK_KP_Multiply #xFFAA +)(defconstant XK_KP_Add #xFFAB +)(defconstant XK_KP_Separator #xFFAC ;; separator, often comma +)(defconstant XK_KP_Subtract #xFFAD +)(defconstant XK_KP_Decimal #xFFAE +)(defconstant XK_KP_Divide #xFFAF +)(defconstant XK_KP_0 #xFFB0 +)(defconstant XK_KP_1 #xFFB1 +)(defconstant XK_KP_2 #xFFB2 +)(defconstant XK_KP_3 #xFFB3 +)(defconstant XK_KP_4 #xFFB4 +)(defconstant XK_KP_5 #xFFB5 +)(defconstant XK_KP_6 #xFFB6 +)(defconstant XK_KP_7 #xFFB7 +)(defconstant XK_KP_8 #xFFB8 +)(defconstant XK_KP_9 #xFFB9 + + + +;; + ; Auxiliary Functions; note the duplicate definitions for left and right + ; function keys; Sun keyboards and a few other manufactures have such + ; function key groups on the left and/or right sides of the keyboard. + ; We've not found a keyboard with more than 35 function keys total. + + +)(defconstant XK_F1 #xFFBE +)(defconstant XK_F2 #xFFBF +)(defconstant XK_F3 #xFFC0 +)(defconstant XK_F4 #xFFC1 +)(defconstant XK_F5 #xFFC2 +)(defconstant XK_F6 #xFFC3 +)(defconstant XK_F7 #xFFC4 +)(defconstant XK_F8 #xFFC5 +)(defconstant XK_F9 #xFFC6 +)(defconstant XK_F10 #xFFC7 +)(defconstant XK_F11 #xFFC8 +)(defconstant XK_L1 #xFFC8 +)(defconstant XK_F12 #xFFC9 +)(defconstant XK_L2 #xFFC9 +)(defconstant XK_F13 #xFFCA +)(defconstant XK_L3 #xFFCA +)(defconstant XK_F14 #xFFCB +)(defconstant XK_L4 #xFFCB +)(defconstant XK_F15 #xFFCC +)(defconstant XK_L5 #xFFCC +)(defconstant XK_F16 #xFFCD +)(defconstant XK_L6 #xFFCD +)(defconstant XK_F17 #xFFCE +)(defconstant XK_L7 #xFFCE +)(defconstant XK_F18 #xFFCF +)(defconstant XK_L8 #xFFCF +)(defconstant XK_F19 #xFFD0 +)(defconstant XK_L9 #xFFD0 +)(defconstant XK_F20 #xFFD1 +)(defconstant XK_L10 #xFFD1 +)(defconstant XK_F21 #xFFD2 +)(defconstant XK_R1 #xFFD2 +)(defconstant XK_F22 #xFFD3 +)(defconstant XK_R2 #xFFD3 +)(defconstant XK_F23 #xFFD4 +)(defconstant XK_R3 #xFFD4 +)(defconstant XK_F24 #xFFD5 +)(defconstant XK_R4 #xFFD5 +)(defconstant XK_F25 #xFFD6 +)(defconstant XK_R5 #xFFD6 +)(defconstant XK_F26 #xFFD7 +)(defconstant XK_R6 #xFFD7 +)(defconstant XK_F27 #xFFD8 +)(defconstant XK_R7 #xFFD8 +)(defconstant XK_F28 #xFFD9 +)(defconstant XK_R8 #xFFD9 +)(defconstant XK_F29 #xFFDA +)(defconstant XK_R9 #xFFDA +)(defconstant XK_F30 #xFFDB +)(defconstant XK_R10 #xFFDB +)(defconstant XK_F31 #xFFDC +)(defconstant XK_R11 #xFFDC +)(defconstant XK_F32 #xFFDD +)(defconstant XK_R12 #xFFDD +)(defconstant XK_R13 #xFFDE +)(defconstant XK_F33 #xFFDE +)(defconstant XK_F34 #xFFDF +)(defconstant XK_R14 #xFFDF +)(defconstant XK_F35 #xFFE0 +)(defconstant XK_R15 #xFFE0 + +;; Modifiers + +)(defconstant XK_Shift_L #xFFE1 ;; Left shift +)(defconstant XK_Shift_R #xFFE2 ;; Right shift +)(defconstant XK_Control_L #xFFE3 ;; Left control +)(defconstant XK_Control_R #xFFE4 ;; Right control +)(defconstant XK_Caps_Lock #xFFE5 ;; Caps lock +)(defconstant XK_Shift_Lock #xFFE6 ;; Shift lock + +)(defconstant XK_Meta_L #xFFE7 ;; Left meta +)(defconstant XK_Meta_R #xFFE8 ;; Right meta +)(defconstant XK_Alt_L #xFFE9 ;; Left alt +)(defconstant XK_Alt_R #xFFEA ;; Right alt +)(defconstant XK_Super_L #xFFEB ;; Left super +)(defconstant XK_Super_R #xFFEC ;; Right super +)(defconstant XK_Hyper_L #xFFED ;; Left hyper +)(defconstant XK_Hyper_R #xFFEE ;; Right hyper +;;#endif ;; XK_MISCELLANY + +;; + ; Latin 1 + ; Byte 3 = 0 + +;;ifdef XK_LATIN1 +)(defconstant XK_space #x020 +)(defconstant XK_exclam #x021 +)(defconstant XK_quotedbl #x022 +)(defconstant XK_numbersign #x023 +)(defconstant XK_dollar #x024 +)(defconstant XK_percent #x025 +)(defconstant XK_ampersand #x026 +)(defconstant XK_apostrophe #x027 +)(defconstant XK_quoteright #x027 ;; deprecated +)(defconstant XK_parenleft #x028 +)(defconstant XK_parenright #x029 +)(defconstant XK_asterisk #x02a +)(defconstant XK_plus #x02b +)(defconstant XK_comma #x02c +)(defconstant XK_minus #x02d +)(defconstant XK_period #x02e +)(defconstant XK_slash #x02f +)(defconstant XK_0 #x030 +)(defconstant XK_1 #x031 +)(defconstant XK_2 #x032 +)(defconstant XK_3 #x033 +)(defconstant XK_4 #x034 +)(defconstant XK_5 #x035 +)(defconstant XK_6 #x036 +)(defconstant XK_7 #x037 +)(defconstant XK_8 #x038 +)(defconstant XK_9 #x039 +)(defconstant XK_colon #x03a +)(defconstant XK_semicolon #x03b +)(defconstant XK_less #x03c +)(defconstant XK_equal #x03d +)(defconstant XK_greater #x03e +)(defconstant XK_question #x03f +)(defconstant XK_at #x040 +)(defconstant XK_A #x041 +)(defconstant XK_B #x042 +)(defconstant XK_C #x043 +)(defconstant XK_D #x044 +)(defconstant XK_E #x045 +)(defconstant XK_F #x046 +)(defconstant XK_G #x047 +)(defconstant XK_H #x048 +)(defconstant XK_I #x049 +)(defconstant XK_J #x04a +)(defconstant XK_K #x04b +)(defconstant XK_L #x04c +)(defconstant XK_M #x04d +)(defconstant XK_N #x04e +)(defconstant XK_O #x04f +)(defconstant XK_P #x050 +)(defconstant XK_Q #x051 +)(defconstant XK_R #x052 +)(defconstant XK_S #x053 +)(defconstant XK_T #x054 +)(defconstant XK_U #x055 +)(defconstant XK_V #x056 +)(defconstant XK_W #x057 +)(defconstant XK_X #x058 +)(defconstant XK_Y #x059 +)(defconstant XK_Z #x05a +)(defconstant XK_bracketleft #x05b +)(defconstant XK_backslash #x05c +)(defconstant XK_bracketright #x05d +)(defconstant XK_asciicircum #x05e +)(defconstant XK_underscore #x05f +)(defconstant XK_grave #x060 +)(defconstant XK_quoteleft #x060 ;; deprecated +)(defconstant XK_a #x061 +)(defconstant XK_b #x062 +)(defconstant XK_c #x063 +)(defconstant XK_d #x064 +)(defconstant XK_e #x065 +)(defconstant XK_f #x066 +)(defconstant XK_g #x067 +)(defconstant XK_h #x068 +)(defconstant XK_i #x069 +)(defconstant XK_j #x06a +)(defconstant XK_k #x06b +)(defconstant XK_l #x06c +)(defconstant XK_m #x06d +)(defconstant XK_n #x06e +)(defconstant XK_o #x06f +)(defconstant XK_p #x070 +)(defconstant XK_q #x071 +)(defconstant XK_r #x072 +)(defconstant XK_s #x073 +)(defconstant XK_t #x074 +)(defconstant XK_u #x075 +)(defconstant XK_v #x076 +)(defconstant XK_w #x077 +)(defconstant XK_x #x078 +)(defconstant XK_y #x079 +)(defconstant XK_z #x07a +)(defconstant XK_braceleft #x07b +)(defconstant XK_bar #x07c +)(defconstant XK_braceright #x07d +)(defconstant XK_asciitilde #x07e + +)(defconstant XK_nobreakspace #x0a0 +)(defconstant XK_exclamdown #x0a1 +)(defconstant XK_cent #x0a2 +)(defconstant XK_sterling #x0a3 +)(defconstant XK_currency #x0a4 +)(defconstant XK_yen #x0a5 +)(defconstant XK_brokenbar #x0a6 +)(defconstant XK_section #x0a7 +)(defconstant XK_diaeresis #x0a8 +)(defconstant XK_copyright #x0a9 +)(defconstant XK_ordfeminine #x0aa +)(defconstant XK_guillemotleft #x0ab ;; left angle quotation mark +)(defconstant XK_notsign #x0ac +)(defconstant XK_hyphen #x0ad +)(defconstant XK_registered #x0ae +)(defconstant XK_macron #x0af +)(defconstant XK_degree #x0b0 +)(defconstant XK_plusminus #x0b1 +)(defconstant XK_twosuperior #x0b2 +)(defconstant XK_threesuperior #x0b3 +)(defconstant XK_acute #x0b4 +)(defconstant XK_mu #x0b5 +)(defconstant XK_paragraph #x0b6 +)(defconstant XK_periodcentered #x0b7 +)(defconstant XK_cedilla #x0b8 +)(defconstant XK_onesuperior #x0b9 +)(defconstant XK_masculine #x0ba +)(defconstant XK_guillemotright #x0bb ;; right angle quotation mark +)(defconstant XK_onequarter #x0bc +)(defconstant XK_onehalf #x0bd +)(defconstant XK_threequarters #x0be +)(defconstant XK_questiondown #x0bf +)(defconstant XK_Agrave #x0c0 +)(defconstant XK_Aacute #x0c1 +)(defconstant XK_Acircumflex #x0c2 +)(defconstant XK_Atilde #x0c3 +)(defconstant XK_Adiaeresis #x0c4 +)(defconstant XK_Aring #x0c5 +)(defconstant XK_AE #x0c6 +)(defconstant XK_Ccedilla #x0c7 +)(defconstant XK_Egrave #x0c8 +)(defconstant XK_Eacute #x0c9 +)(defconstant XK_Ecircumflex #x0ca +)(defconstant XK_Ediaeresis #x0cb +)(defconstant XK_Igrave #x0cc +)(defconstant XK_Iacute #x0cd +)(defconstant XK_Icircumflex #x0ce +)(defconstant XK_Idiaeresis #x0cf +)(defconstant XK_ETH #x0d0 +)(defconstant XK_Eth #x0d0 ;; deprecated +)(defconstant XK_Ntilde #x0d1 +)(defconstant XK_Ograve #x0d2 +)(defconstant XK_Oacute #x0d3 +)(defconstant XK_Ocircumflex #x0d4 +)(defconstant XK_Otilde #x0d5 +)(defconstant XK_Odiaeresis #x0d6 +)(defconstant XK_multiply #x0d7 +)(defconstant XK_Ooblique #x0d8 +)(defconstant XK_Ugrave #x0d9 +)(defconstant XK_Uacute #x0da +)(defconstant XK_Ucircumflex #x0db +)(defconstant XK_Udiaeresis #x0dc +)(defconstant XK_Yacute #x0dd +)(defconstant XK_THORN #x0de +)(defconstant XK_Thorn #x0de ;; deprecated +)(defconstant XK_ssharp #x0df +)(defconstant XK_agrave #x0e0 +)(defconstant XK_aacute #x0e1 +)(defconstant XK_acircumflex #x0e2 +)(defconstant XK_atilde #x0e3 +)(defconstant XK_adiaeresis #x0e4 +)(defconstant XK_aring #x0e5 +)(defconstant XK_ae #x0e6 +)(defconstant XK_ccedilla #x0e7 +)(defconstant XK_egrave #x0e8 +)(defconstant XK_eacute #x0e9 +)(defconstant XK_ecircumflex #x0ea +)(defconstant XK_ediaeresis #x0eb +)(defconstant XK_igrave #x0ec +)(defconstant XK_iacute #x0ed +)(defconstant XK_icircumflex #x0ee +)(defconstant XK_idiaeresis #x0ef +)(defconstant XK_eth #x0f0 +)(defconstant XK_ntilde #x0f1 +)(defconstant XK_ograve #x0f2 +)(defconstant XK_oacute #x0f3 +)(defconstant XK_ocircumflex #x0f4 +)(defconstant XK_otilde #x0f5 +)(defconstant XK_odiaeresis #x0f6 +)(defconstant XK_division #x0f7 +)(defconstant XK_oslash #x0f8 +)(defconstant XK_ugrave #x0f9 +)(defconstant XK_uacute #x0fa +)(defconstant XK_ucircumflex #x0fb +)(defconstant XK_udiaeresis #x0fc +)(defconstant XK_yacute #x0fd +)(defconstant XK_thorn #x0fe +)(defconstant XK_ydiaeresis #x0ff +;;endif ;; XK_LATIN1 + +;; + ; Latin 2 + ; Byte 3 = 1 + + +;;ifdef XK_LATIN2 +)(defconstant XK_Aogonek #x1a1 +)(defconstant XK_breve #x1a2 +)(defconstant XK_Lstroke #x1a3 +)(defconstant XK_Lcaron #x1a5 +)(defconstant XK_Sacute #x1a6 +)(defconstant XK_Scaron #x1a9 +)(defconstant XK_Scedilla #x1aa +)(defconstant XK_Tcaron #x1ab +)(defconstant XK_Zacute #x1ac +)(defconstant XK_Zcaron #x1ae +)(defconstant XK_Zabovedot #x1af +)(defconstant XK_aogonek #x1b1 +)(defconstant XK_ogonek #x1b2 +)(defconstant XK_lstroke #x1b3 +)(defconstant XK_lcaron #x1b5 +)(defconstant XK_sacute #x1b6 +)(defconstant XK_caron #x1b7 +)(defconstant XK_scaron #x1b9 +)(defconstant XK_scedilla #x1ba +)(defconstant XK_tcaron #x1bb +)(defconstant XK_zacute #x1bc +)(defconstant XK_doubleacute #x1bd +)(defconstant XK_zcaron #x1be +)(defconstant XK_zabovedot #x1bf +)(defconstant XK_Racute #x1c0 +)(defconstant XK_Abreve #x1c3 +)(defconstant XK_Lacute #x1c5 +)(defconstant XK_Cacute #x1c6 +)(defconstant XK_Ccaron #x1c8 +)(defconstant XK_Eogonek #x1ca +)(defconstant XK_Ecaron #x1cc +)(defconstant XK_Dcaron #x1cf +)(defconstant XK_Dstroke #x1d0 +)(defconstant XK_Nacute #x1d1 +)(defconstant XK_Ncaron #x1d2 +)(defconstant XK_Odoubleacute #x1d5 +)(defconstant XK_Rcaron #x1d8 +)(defconstant XK_Uring #x1d9 +)(defconstant XK_Udoubleacute #x1db +)(defconstant XK_Tcedilla #x1de +)(defconstant XK_racute #x1e0 +)(defconstant XK_abreve #x1e3 +)(defconstant XK_lacute #x1e5 +)(defconstant XK_cacute #x1e6 +)(defconstant XK_ccaron #x1e8 +)(defconstant XK_eogonek #x1ea +)(defconstant XK_ecaron #x1ec +)(defconstant XK_dcaron #x1ef +)(defconstant XK_dstroke #x1f0 +)(defconstant XK_nacute #x1f1 +)(defconstant XK_ncaron #x1f2 +)(defconstant XK_odoubleacute #x1f5 +)(defconstant XK_udoubleacute #x1fb +)(defconstant XK_rcaron #x1f8 +)(defconstant XK_uring #x1f9 +)(defconstant XK_tcedilla #x1fe +)(defconstant XK_abovedot #x1ff +;;endif ;; XK_LATIN2 + +;; + ; Latin 3 + ; Byte 3 = 2 + + +;;ifdef XK_LATIN3 +)(defconstant XK_Hstroke #x2a1 +)(defconstant XK_Hcircumflex #x2a6 +)(defconstant XK_Iabovedot #x2a9 +)(defconstant XK_Gbreve #x2ab +)(defconstant XK_Jcircumflex #x2ac +)(defconstant XK_hstroke #x2b1 +)(defconstant XK_hcircumflex #x2b6 +)(defconstant XK_idotless #x2b9 +)(defconstant XK_gbreve #x2bb +)(defconstant XK_jcircumflex #x2bc +)(defconstant XK_Cabovedot #x2c5 +)(defconstant XK_Ccircumflex #x2c6 +)(defconstant XK_Gabovedot #x2d5 +)(defconstant XK_Gcircumflex #x2d8 +)(defconstant XK_Ubreve #x2dd +)(defconstant XK_Scircumflex #x2de +)(defconstant XK_cabovedot #x2e5 +)(defconstant XK_ccircumflex #x2e6 +)(defconstant XK_gabovedot #x2f5 +)(defconstant XK_gcircumflex #x2f8 +)(defconstant XK_ubreve #x2fd +)(defconstant XK_scircumflex #x2fe +;;endif ;; XK_LATIN3 + + +;; + ; Latin 4 + ; Byte 3 = 3 + + +;;ifdef XK_LATIN4 +)(defconstant XK_kra #x3a2 +)(defconstant XK_kappa #x3a2 ;; deprecated +)(defconstant XK_Rcedilla #x3a3 +)(defconstant XK_Itilde #x3a5 +)(defconstant XK_Lcedilla #x3a6 +)(defconstant XK_Emacron #x3aa +)(defconstant XK_Gcedilla #x3ab +)(defconstant XK_Tslash #x3ac +)(defconstant XK_rcedilla #x3b3 +)(defconstant XK_itilde #x3b5 +)(defconstant XK_lcedilla #x3b6 +)(defconstant XK_emacron #x3ba +)(defconstant XK_gcedilla #x3bb +)(defconstant XK_tslash #x3bc +)(defconstant XK_ENG #x3bd +)(defconstant XK_eng #x3bf +)(defconstant XK_Amacron #x3c0 +)(defconstant XK_Iogonek #x3c7 +)(defconstant XK_Eabovedot #x3cc +)(defconstant XK_Imacron #x3cf +)(defconstant XK_Ncedilla #x3d1 +)(defconstant XK_Omacron #x3d2 +)(defconstant XK_Kcedilla #x3d3 +)(defconstant XK_Uogonek #x3d9 +)(defconstant XK_Utilde #x3dd +)(defconstant XK_Umacron #x3de +)(defconstant XK_amacron #x3e0 +)(defconstant XK_iogonek #x3e7 +)(defconstant XK_eabovedot #x3ec +)(defconstant XK_imacron #x3ef +)(defconstant XK_ncedilla #x3f1 +)(defconstant XK_omacron #x3f2 +)(defconstant XK_kcedilla #x3f3 +)(defconstant XK_uogonek #x3f9 +)(defconstant XK_utilde #x3fd +)(defconstant XK_umacron #x3fe +;;endif ;; XK_LATIN4 + +;; + ; Katakana + ; Byte 3 = 4 + + +;;ifdef XK_KATAKANA +)(defconstant XK_overline #x47e +)(defconstant XK_kana_fullstop #x4a1 +)(defconstant XK_kana_openingbracket #x4a2 +)(defconstant XK_kana_closingbracket #x4a3 +)(defconstant XK_kana_comma #x4a4 +)(defconstant XK_kana_conjunctive #x4a5 +)(defconstant XK_kana_middledot #x4a5 ;; deprecated +)(defconstant XK_kana_WO #x4a6 +)(defconstant XK_kana_a #x4a7 +)(defconstant XK_kana_i #x4a8 +)(defconstant XK_kana_u #x4a9 +)(defconstant XK_kana_e #x4aa +)(defconstant XK_kana_o #x4ab +)(defconstant XK_kana_ya #x4ac +)(defconstant XK_kana_yu #x4ad +)(defconstant XK_kana_yo #x4ae +)(defconstant XK_kana_tsu #x4af +)(defconstant XK_kana_tu #x4af ;; deprecated +)(defconstant XK_prolongedsound #x4b0 +)(defconstant XK_kana_A #x4b1 +)(defconstant XK_kana_I #x4b2 +)(defconstant XK_kana_U #x4b3 +)(defconstant XK_kana_E #x4b4 +)(defconstant XK_kana_O #x4b5 +)(defconstant XK_kana_KA #x4b6 +)(defconstant XK_kana_KI #x4b7 +)(defconstant XK_kana_KU #x4b8 +)(defconstant XK_kana_KE #x4b9 +)(defconstant XK_kana_KO #x4ba +)(defconstant XK_kana_SA #x4bb +)(defconstant XK_kana_SHI #x4bc +)(defconstant XK_kana_SU #x4bd +)(defconstant XK_kana_SE #x4be +)(defconstant XK_kana_SO #x4bf +)(defconstant XK_kana_TA #x4c0 +)(defconstant XK_kana_CHI #x4c1 +)(defconstant XK_kana_TI #x4c1 ;; deprecated +)(defconstant XK_kana_TSU #x4c2 +)(defconstant XK_kana_TU #x4c2 ;; deprecated +)(defconstant XK_kana_TE #x4c3 +)(defconstant XK_kana_TO #x4c4 +)(defconstant XK_kana_NA #x4c5 +)(defconstant XK_kana_NI #x4c6 +)(defconstant XK_kana_NU #x4c7 +)(defconstant XK_kana_NE #x4c8 +)(defconstant XK_kana_NO #x4c9 +)(defconstant XK_kana_HA #x4ca +)(defconstant XK_kana_HI #x4cb +)(defconstant XK_kana_FU #x4cc +)(defconstant XK_kana_HU #x4cc ;; deprecated +)(defconstant XK_kana_HE #x4cd +)(defconstant XK_kana_HO #x4ce +)(defconstant XK_kana_MA #x4cf +)(defconstant XK_kana_MI #x4d0 +)(defconstant XK_kana_MU #x4d1 +)(defconstant XK_kana_ME #x4d2 +)(defconstant XK_kana_MO #x4d3 +)(defconstant XK_kana_YA #x4d4 +)(defconstant XK_kana_YU #x4d5 +)(defconstant XK_kana_YO #x4d6 +)(defconstant XK_kana_RA #x4d7 +)(defconstant XK_kana_RI #x4d8 +)(defconstant XK_kana_RU #x4d9 +)(defconstant XK_kana_RE #x4da +)(defconstant XK_kana_RO #x4db +)(defconstant XK_kana_WA #x4dc +)(defconstant XK_kana_N #x4dd +)(defconstant XK_voicedsound #x4de +)(defconstant XK_semivoicedsound #x4df +)(defconstant XK_kana_switch #xFF7E ;; Alias for mode_switch +;;endif ;; XK_KATAKANA + +;; + ; Arabic + ; Byte 3 = 5 + + +;;ifdef XK_ARABIC +)(defconstant XK_Arabic_comma #x5ac +)(defconstant XK_Arabic_semicolon #x5bb +)(defconstant XK_Arabic_question_mark #x5bf +)(defconstant XK_Arabic_hamza #x5c1 +)(defconstant XK_Arabic_maddaonalef #x5c2 +)(defconstant XK_Arabic_hamzaonalef #x5c3 +)(defconstant XK_Arabic_hamzaonwaw #x5c4 +)(defconstant XK_Arabic_hamzaunderalef #x5c5 +)(defconstant XK_Arabic_hamzaonyeh #x5c6 +)(defconstant XK_Arabic_alef #x5c7 +)(defconstant XK_Arabic_beh #x5c8 +)(defconstant XK_Arabic_tehmarbuta #x5c9 +)(defconstant XK_Arabic_teh #x5ca +)(defconstant XK_Arabic_theh #x5cb +)(defconstant XK_Arabic_jeem #x5cc +)(defconstant XK_Arabic_hah #x5cd +)(defconstant XK_Arabic_khah #x5ce +)(defconstant XK_Arabic_dal #x5cf +)(defconstant XK_Arabic_thal #x5d0 +)(defconstant XK_Arabic_ra #x5d1 +)(defconstant XK_Arabic_zain #x5d2 +)(defconstant XK_Arabic_seen #x5d3 +)(defconstant XK_Arabic_sheen #x5d4 +)(defconstant XK_Arabic_sad #x5d5 +)(defconstant XK_Arabic_dad #x5d6 +)(defconstant XK_Arabic_tah #x5d7 +)(defconstant XK_Arabic_zah #x5d8 +)(defconstant XK_Arabic_ain #x5d9 +)(defconstant XK_Arabic_ghain #x5da +)(defconstant XK_Arabic_tatweel #x5e0 +)(defconstant XK_Arabic_feh #x5e1 +)(defconstant XK_Arabic_qaf #x5e2 +)(defconstant XK_Arabic_kaf #x5e3 +)(defconstant XK_Arabic_lam #x5e4 +)(defconstant XK_Arabic_meem #x5e5 +)(defconstant XK_Arabic_noon #x5e6 +)(defconstant XK_Arabic_ha #x5e7 +)(defconstant XK_Arabic_heh #x5e7 ;; deprecated +)(defconstant XK_Arabic_waw #x5e8 +)(defconstant XK_Arabic_alefmaksura #x5e9 +)(defconstant XK_Arabic_yeh #x5ea +)(defconstant XK_Arabic_fathatan #x5eb +)(defconstant XK_Arabic_dammatan #x5ec +)(defconstant XK_Arabic_kasratan #x5ed +)(defconstant XK_Arabic_fatha #x5ee +)(defconstant XK_Arabic_damma #x5ef +)(defconstant XK_Arabic_kasra #x5f0 +)(defconstant XK_Arabic_shadda #x5f1 +)(defconstant XK_Arabic_sukun #x5f2 +)(defconstant XK_Arabic_switch #xFF7E ;; Alias for mode_switch +;;endif ;; XK_ARABIC + +;; + ; Cyrillic + ; Byte 3 = 6 + +;;ifdef XK_CYRILLIC +)(defconstant XK_Serbian_dje #x6a1 +)(defconstant XK_Macedonia_gje #x6a2 +)(defconstant XK_Cyrillic_io #x6a3 +)(defconstant XK_Ukrainian_ie #x6a4 +)(defconstant XK_Ukranian_je #x6a4 ;; deprecated +)(defconstant XK_Macedonia_dse #x6a5 +)(defconstant XK_Ukrainian_i #x6a6 +)(defconstant XK_Ukranian_i #x6a6 ;; deprecated +)(defconstant XK_Ukrainian_yi #x6a7 +)(defconstant XK_Ukranian_yi #x6a7 ;; deprecated +)(defconstant XK_Cyrillic_je #x6a8 +)(defconstant XK_Serbian_je #x6a8 ;; deprecated +)(defconstant XK_Cyrillic_lje #x6a9 +)(defconstant XK_Serbian_lje #x6a9 ;; deprecated +)(defconstant XK_Cyrillic_nje #x6aa +)(defconstant XK_Serbian_nje #x6aa ;; deprecated +)(defconstant XK_Serbian_tshe #x6ab +)(defconstant XK_Macedonia_kje #x6ac +)(defconstant XK_Byelorussian_shortu #x6ae +)(defconstant XK_Cyrillic_dzhe #x6af +)(defconstant XK_Serbian_dze #x6af ;; deprecated +)(defconstant XK_numerosign #x6b0 +)(defconstant XK_Serbian_DJE #x6b1 +)(defconstant XK_Macedonia_GJE #x6b2 +)(defconstant XK_Cyrillic_IO #x6b3 +)(defconstant XK_Ukrainian_IE #x6b4 +)(defconstant XK_Ukranian_JE #x6b4 ;; deprecated +)(defconstant XK_Macedonia_DSE #x6b5 +)(defconstant XK_Ukrainian_I #x6b6 +)(defconstant XK_Ukranian_I #x6b6 ;; deprecated +)(defconstant XK_Ukrainian_YI #x6b7 +)(defconstant XK_Ukranian_YI #x6b7 ;; deprecated +)(defconstant XK_Cyrillic_JE #x6b8 +)(defconstant XK_Serbian_JE #x6b8 ;; deprecated +)(defconstant XK_Cyrillic_LJE #x6b9 +)(defconstant XK_Serbian_LJE #x6b9 ;; deprecated +)(defconstant XK_Cyrillic_NJE #x6ba +)(defconstant XK_Serbian_NJE #x6ba ;; deprecated +)(defconstant XK_Serbian_TSHE #x6bb +)(defconstant XK_Macedonia_KJE #x6bc +)(defconstant XK_Byelorussian_SHORTU #x6be +)(defconstant XK_Cyrillic_DZHE #x6bf +)(defconstant XK_Serbian_DZE #x6bf ;; deprecated +)(defconstant XK_Cyrillic_yu #x6c0 +)(defconstant XK_Cyrillic_a #x6c1 +)(defconstant XK_Cyrillic_be #x6c2 +)(defconstant XK_Cyrillic_tse #x6c3 +)(defconstant XK_Cyrillic_de #x6c4 +)(defconstant XK_Cyrillic_ie #x6c5 +)(defconstant XK_Cyrillic_ef #x6c6 +)(defconstant XK_Cyrillic_ghe #x6c7 +)(defconstant XK_Cyrillic_ha #x6c8 +)(defconstant XK_Cyrillic_i #x6c9 +)(defconstant XK_Cyrillic_shorti #x6ca +)(defconstant XK_Cyrillic_ka #x6cb +)(defconstant XK_Cyrillic_el #x6cc +)(defconstant XK_Cyrillic_em #x6cd +)(defconstant XK_Cyrillic_en #x6ce +)(defconstant XK_Cyrillic_o #x6cf +)(defconstant XK_Cyrillic_pe #x6d0 +)(defconstant XK_Cyrillic_ya #x6d1 +)(defconstant XK_Cyrillic_er #x6d2 +)(defconstant XK_Cyrillic_es #x6d3 +)(defconstant XK_Cyrillic_te #x6d4 +)(defconstant XK_Cyrillic_u #x6d5 +)(defconstant XK_Cyrillic_zhe #x6d6 +)(defconstant XK_Cyrillic_ve #x6d7 +)(defconstant XK_Cyrillic_softsign #x6d8 +)(defconstant XK_Cyrillic_yeru #x6d9 +)(defconstant XK_Cyrillic_ze #x6da +)(defconstant XK_Cyrillic_sha #x6db +)(defconstant XK_Cyrillic_e #x6dc +)(defconstant XK_Cyrillic_shcha #x6dd +)(defconstant XK_Cyrillic_che #x6de +)(defconstant XK_Cyrillic_hardsign #x6df +)(defconstant XK_Cyrillic_YU #x6e0 +)(defconstant XK_Cyrillic_A #x6e1 +)(defconstant XK_Cyrillic_BE #x6e2 +)(defconstant XK_Cyrillic_TSE #x6e3 +)(defconstant XK_Cyrillic_DE #x6e4 +)(defconstant XK_Cyrillic_IE #x6e5 +)(defconstant XK_Cyrillic_EF #x6e6 +)(defconstant XK_Cyrillic_GHE #x6e7 +)(defconstant XK_Cyrillic_HA #x6e8 +)(defconstant XK_Cyrillic_I #x6e9 +)(defconstant XK_Cyrillic_SHORTI #x6ea +)(defconstant XK_Cyrillic_KA #x6eb +)(defconstant XK_Cyrillic_EL #x6ec +)(defconstant XK_Cyrillic_EM #x6ed +)(defconstant XK_Cyrillic_EN #x6ee +)(defconstant XK_Cyrillic_O #x6ef +)(defconstant XK_Cyrillic_PE #x6f0 +)(defconstant XK_Cyrillic_YA #x6f1 +)(defconstant XK_Cyrillic_ER #x6f2 +)(defconstant XK_Cyrillic_ES #x6f3 +)(defconstant XK_Cyrillic_TE #x6f4 +)(defconstant XK_Cyrillic_U #x6f5 +)(defconstant XK_Cyrillic_ZHE #x6f6 +)(defconstant XK_Cyrillic_VE #x6f7 +)(defconstant XK_Cyrillic_SOFTSIGN #x6f8 +)(defconstant XK_Cyrillic_YERU #x6f9 +)(defconstant XK_Cyrillic_ZE #x6fa +)(defconstant XK_Cyrillic_SHA #x6fb +)(defconstant XK_Cyrillic_E #x6fc +)(defconstant XK_Cyrillic_SHCHA #x6fd +)(defconstant XK_Cyrillic_CHE #x6fe +)(defconstant XK_Cyrillic_HARDSIGN #x6ff +;;endif ;; XK_CYRILLIC + +;; + ; Greek + ; Byte 3 = 7 + + +;;ifdef XK_GREEK +)(defconstant XK_Greek_ALPHAaccent #x7a1 +)(defconstant XK_Greek_EPSILONaccent #x7a2 +)(defconstant XK_Greek_ETAaccent #x7a3 +)(defconstant XK_Greek_IOTAaccent #x7a4 +)(defconstant XK_Greek_IOTAdiaeresis #x7a5 +)(defconstant XK_Greek_OMICRONaccent #x7a7 +)(defconstant XK_Greek_UPSILONaccent #x7a8 +)(defconstant XK_Greek_UPSILONdieresis #x7a9 +)(defconstant XK_Greek_OMEGAaccent #x7ab +)(defconstant XK_Greek_accentdieresis #x7ae +)(defconstant XK_Greek_horizbar #x7af +)(defconstant XK_Greek_alphaaccent #x7b1 +)(defconstant XK_Greek_epsilonaccent #x7b2 +)(defconstant XK_Greek_etaaccent #x7b3 +)(defconstant XK_Greek_iotaaccent #x7b4 +)(defconstant XK_Greek_iotadieresis #x7b5 +)(defconstant XK_Greek_iotaaccentdieresis #x7b6 +)(defconstant XK_Greek_omicronaccent #x7b7 +)(defconstant XK_Greek_upsilonaccent #x7b8 +)(defconstant XK_Greek_upsilondieresis #x7b9 +)(defconstant XK_Greek_upsilonaccentdieresis #x7ba +)(defconstant XK_Greek_omegaaccent #x7bb +)(defconstant XK_Greek_ALPHA #x7c1 +)(defconstant XK_Greek_BETA #x7c2 +)(defconstant XK_Greek_GAMMA #x7c3 +)(defconstant XK_Greek_DELTA #x7c4 +)(defconstant XK_Greek_EPSILON #x7c5 +)(defconstant XK_Greek_ZETA #x7c6 +)(defconstant XK_Greek_ETA #x7c7 +)(defconstant XK_Greek_THETA #x7c8 +)(defconstant XK_Greek_IOTA #x7c9 +)(defconstant XK_Greek_KAPPA #x7ca +)(defconstant XK_Greek_LAMDA #x7cb +)(defconstant XK_Greek_LAMBDA #x7cb +)(defconstant XK_Greek_MU #x7cc +)(defconstant XK_Greek_NU #x7cd +)(defconstant XK_Greek_XI #x7ce +)(defconstant XK_Greek_OMICRON #x7cf +)(defconstant XK_Greek_PI #x7d0 +)(defconstant XK_Greek_RHO #x7d1 +)(defconstant XK_Greek_SIGMA #x7d2 +)(defconstant XK_Greek_TAU #x7d4 +)(defconstant XK_Greek_UPSILON #x7d5 +)(defconstant XK_Greek_PHI #x7d6 +)(defconstant XK_Greek_CHI #x7d7 +)(defconstant XK_Greek_PSI #x7d8 +)(defconstant XK_Greek_OMEGA #x7d9 +)(defconstant XK_Greek_alpha #x7e1 +)(defconstant XK_Greek_beta #x7e2 +)(defconstant XK_Greek_gamma #x7e3 +)(defconstant XK_Greek_delta #x7e4 +)(defconstant XK_Greek_epsilon #x7e5 +)(defconstant XK_Greek_zeta #x7e6 +)(defconstant XK_Greek_eta #x7e7 +)(defconstant XK_Greek_theta #x7e8 +)(defconstant XK_Greek_iota #x7e9 +)(defconstant XK_Greek_kappa #x7ea +)(defconstant XK_Greek_lamda #x7eb +)(defconstant XK_Greek_lambda #x7eb +)(defconstant XK_Greek_mu #x7ec +)(defconstant XK_Greek_nu #x7ed +)(defconstant XK_Greek_xi #x7ee +)(defconstant XK_Greek_omicron #x7ef +)(defconstant XK_Greek_pi #x7f0 +)(defconstant XK_Greek_rho #x7f1 +)(defconstant XK_Greek_sigma #x7f2 +)(defconstant XK_Greek_finalsmallsigma #x7f3 +)(defconstant XK_Greek_tau #x7f4 +)(defconstant XK_Greek_upsilon #x7f5 +)(defconstant XK_Greek_phi #x7f6 +)(defconstant XK_Greek_chi #x7f7 +)(defconstant XK_Greek_psi #x7f8 +)(defconstant XK_Greek_omega #x7f9 +)(defconstant XK_Greek_switch #xFF7E ;; Alias for mode_switch +;;endif ;; XK_GREEK + +;; + ; Technical + ; Byte 3 = 8 + + +;;ifdef XK_TECHNICAL +)(defconstant XK_leftradical #x8a1 +)(defconstant XK_topleftradical #x8a2 +)(defconstant XK_horizconnector #x8a3 +)(defconstant XK_topintegral #x8a4 +)(defconstant XK_botintegral #x8a5 +)(defconstant XK_vertconnector #x8a6 +)(defconstant XK_topleftsqbracket #x8a7 +)(defconstant XK_botleftsqbracket #x8a8 +)(defconstant XK_toprightsqbracket #x8a9 +)(defconstant XK_botrightsqbracket #x8aa +)(defconstant XK_topleftparens #x8ab +)(defconstant XK_botleftparens #x8ac +)(defconstant XK_toprightparens #x8ad +)(defconstant XK_botrightparens #x8ae +)(defconstant XK_leftmiddlecurlybrace #x8af +)(defconstant XK_rightmiddlecurlybrace #x8b0 +)(defconstant XK_topleftsummation #x8b1 +)(defconstant XK_botleftsummation #x8b2 +)(defconstant XK_topvertsummationconnector #x8b3 +)(defconstant XK_botvertsummationconnector #x8b4 +)(defconstant XK_toprightsummation #x8b5 +)(defconstant XK_botrightsummation #x8b6 +)(defconstant XK_rightmiddlesummation #x8b7 +)(defconstant XK_lessthanequal #x8bc +)(defconstant XK_notequal #x8bd +)(defconstant XK_greaterthanequal #x8be +)(defconstant XK_integral #x8bf +)(defconstant XK_therefore #x8c0 +)(defconstant XK_variation #x8c1 +)(defconstant XK_infinity #x8c2 +)(defconstant XK_nabla #x8c5 +)(defconstant XK_approximate #x8c8 +)(defconstant XK_similarequal #x8c9 +)(defconstant XK_ifonlyif #x8cd +)(defconstant XK_implies #x8ce +)(defconstant XK_identical #x8cf +)(defconstant XK_radical #x8d6 +)(defconstant XK_includedin #x8da +)(defconstant XK_includes #x8db +)(defconstant XK_intersection #x8dc +)(defconstant XK_union #x8dd +)(defconstant XK_logicaland #x8de +)(defconstant XK_logicalor #x8df +)(defconstant XK_partialderivative #x8ef +)(defconstant XK_function #x8f6 +)(defconstant XK_leftarrow #x8fb +)(defconstant XK_uparrow #x8fc +)(defconstant XK_rightarrow #x8fd +)(defconstant XK_downarrow #x8fe +;;endif ;; XK_TECHNICAL + +;; + ; Special + ; Byte 3 = 9 + + +;;ifdef XK_SPECIAL +)(defconstant XK_blank #x9df +)(defconstant XK_soliddiamond #x9e0 +)(defconstant XK_checkerboard #x9e1 +)(defconstant XK_ht #x9e2 +)(defconstant XK_ff #x9e3 +)(defconstant XK_cr #x9e4 +)(defconstant XK_lf #x9e5 +)(defconstant XK_nl #x9e8 +)(defconstant XK_vt #x9e9 +)(defconstant XK_lowrightcorner #x9ea +)(defconstant XK_uprightcorner #x9eb +)(defconstant XK_upleftcorner #x9ec +)(defconstant XK_lowleftcorner #x9ed +)(defconstant XK_crossinglines #x9ee +)(defconstant XK_horizlinescan1 #x9ef +)(defconstant XK_horizlinescan3 #x9f0 +)(defconstant XK_horizlinescan5 #x9f1 +)(defconstant XK_horizlinescan7 #x9f2 +)(defconstant XK_horizlinescan9 #x9f3 +)(defconstant XK_leftt #x9f4 +)(defconstant XK_rightt #x9f5 +)(defconstant XK_bott #x9f6 +)(defconstant XK_topt #x9f7 +)(defconstant XK_vertbar #x9f8 +;;endif ;; XK_SPECIAL + +;; + ; Publishing + ; Byte 3 = a + + +;;ifdef XK_PUBLISHING +)(defconstant XK_emspace #xaa1 +)(defconstant XK_enspace #xaa2 +)(defconstant XK_em3space #xaa3 +)(defconstant XK_em4space #xaa4 +)(defconstant XK_digitspace #xaa5 +)(defconstant XK_punctspace #xaa6 +)(defconstant XK_thinspace #xaa7 +)(defconstant XK_hairspace #xaa8 +)(defconstant XK_emdash #xaa9 +)(defconstant XK_endash #xaaa +)(defconstant XK_signifblank #xaac +)(defconstant XK_ellipsis #xaae +)(defconstant XK_doubbaselinedot #xaaf +)(defconstant XK_onethird #xab0 +)(defconstant XK_twothirds #xab1 +)(defconstant XK_onefifth #xab2 +)(defconstant XK_twofifths #xab3 +)(defconstant XK_threefifths #xab4 +)(defconstant XK_fourfifths #xab5 +)(defconstant XK_onesixth #xab6 +)(defconstant XK_fivesixths #xab7 +)(defconstant XK_careof #xab8 +)(defconstant XK_figdash #xabb +)(defconstant XK_leftanglebracket #xabc +)(defconstant XK_decimalpoint #xabd +)(defconstant XK_rightanglebracket #xabe +)(defconstant XK_marker #xabf +)(defconstant XK_oneeighth #xac3 +)(defconstant XK_threeeighths #xac4 +)(defconstant XK_fiveeighths #xac5 +)(defconstant XK_seveneighths #xac6 +)(defconstant XK_trademark #xac9 +)(defconstant XK_signaturemark #xaca +)(defconstant XK_trademarkincircle #xacb +)(defconstant XK_leftopentriangle #xacc +)(defconstant XK_rightopentriangle #xacd +)(defconstant XK_emopencircle #xace +)(defconstant XK_emopenrectangle #xacf +)(defconstant XK_leftsinglequotemark #xad0 +)(defconstant XK_rightsinglequotemark #xad1 +)(defconstant XK_leftdoublequotemark #xad2 +)(defconstant XK_rightdoublequotemark #xad3 +)(defconstant XK_prescription #xad4 +)(defconstant XK_minutes #xad6 +)(defconstant XK_seconds #xad7 +)(defconstant XK_latincross #xad9 +)(defconstant XK_hexagram #xada +)(defconstant XK_filledrectbullet #xadb +)(defconstant XK_filledlefttribullet #xadc +)(defconstant XK_filledrighttribullet #xadd +)(defconstant XK_emfilledcircle #xade +)(defconstant XK_emfilledrect #xadf +)(defconstant XK_enopencircbullet #xae0 +)(defconstant XK_enopensquarebullet #xae1 +)(defconstant XK_openrectbullet #xae2 +)(defconstant XK_opentribulletup #xae3 +)(defconstant XK_opentribulletdown #xae4 +)(defconstant XK_openstar #xae5 +)(defconstant XK_enfilledcircbullet #xae6 +)(defconstant XK_enfilledsqbullet #xae7 +)(defconstant XK_filledtribulletup #xae8 +)(defconstant XK_filledtribulletdown #xae9 +)(defconstant XK_leftpointer #xaea +)(defconstant XK_rightpointer #xaeb +)(defconstant XK_club #xaec +)(defconstant XK_diamond #xaed +)(defconstant XK_heart #xaee +)(defconstant XK_maltesecross #xaf0 +)(defconstant XK_dagger #xaf1 +)(defconstant XK_doubledagger #xaf2 +)(defconstant XK_checkmark #xaf3 +)(defconstant XK_ballotcross #xaf4 +)(defconstant XK_musicalsharp #xaf5 +)(defconstant XK_musicalflat #xaf6 +)(defconstant XK_malesymbol #xaf7 +)(defconstant XK_femalesymbol #xaf8 +)(defconstant XK_telephone #xaf9 +)(defconstant XK_telephonerecorder #xafa +)(defconstant XK_phonographcopyright #xafb +)(defconstant XK_caret #xafc +)(defconstant XK_singlelowquotemark #xafd +)(defconstant XK_doublelowquotemark #xafe +)(defconstant XK_cursor #xaff +;;endif ;; XK_PUBLISHING + +;; + ; APL + ; Byte 3 = b + + +;;ifdef XK_APL +)(defconstant XK_leftcaret #xba3 +)(defconstant XK_rightcaret #xba6 +)(defconstant XK_downcaret #xba8 +)(defconstant XK_upcaret #xba9 +)(defconstant XK_overbar #xbc0 +)(defconstant XK_downtack #xbc2 +)(defconstant XK_upshoe #xbc3 +)(defconstant XK_downstile #xbc4 +)(defconstant XK_underbar #xbc6 +)(defconstant XK_jot #xbca +)(defconstant XK_quad #xbcc +)(defconstant XK_uptack #xbce +)(defconstant XK_circle #xbcf +)(defconstant XK_upstile #xbd3 +)(defconstant XK_downshoe #xbd6 +)(defconstant XK_rightshoe #xbd8 +)(defconstant XK_leftshoe #xbda +)(defconstant XK_lefttack #xbdc +)(defconstant XK_righttack #xbfc +;;endif ;; XK_APL + +;; + ; Hebrew + ; Byte 3 = c + + +;;ifdef XK_HEBREW +)(defconstant XK_hebrew_doublelowline #xcdf +)(defconstant XK_hebrew_aleph #xce0 +)(defconstant XK_hebrew_bet #xce1 +)(defconstant XK_hebrew_beth #xce1 ;; deprecated +)(defconstant XK_hebrew_gimel #xce2 +)(defconstant XK_hebrew_gimmel #xce2 ;; deprecated +)(defconstant XK_hebrew_dalet #xce3 +)(defconstant XK_hebrew_daleth #xce3 ;; deprecated +)(defconstant XK_hebrew_he #xce4 +)(defconstant XK_hebrew_waw #xce5 +)(defconstant XK_hebrew_zain #xce6 +)(defconstant XK_hebrew_zayin #xce6 ;; deprecated +)(defconstant XK_hebrew_chet #xce7 +)(defconstant XK_hebrew_het #xce7 ;; deprecated +)(defconstant XK_hebrew_tet #xce8 +)(defconstant XK_hebrew_teth #xce8 ;; deprecated +)(defconstant XK_hebrew_yod #xce9 +)(defconstant XK_hebrew_finalkaph #xcea +)(defconstant XK_hebrew_kaph #xceb +)(defconstant XK_hebrew_lamed #xcec +)(defconstant XK_hebrew_finalmem #xced +)(defconstant XK_hebrew_mem #xcee +)(defconstant XK_hebrew_finalnun #xcef +)(defconstant XK_hebrew_nun #xcf0 +)(defconstant XK_hebrew_samech #xcf1 +)(defconstant XK_hebrew_samekh #xcf1 ;; deprecated +)(defconstant XK_hebrew_ayin #xcf2 +)(defconstant XK_hebrew_finalpe #xcf3 +)(defconstant XK_hebrew_pe #xcf4 +)(defconstant XK_hebrew_finalzade #xcf5 +)(defconstant XK_hebrew_finalzadi #xcf5 ;; deprecated +)(defconstant XK_hebrew_zade #xcf6 +)(defconstant XK_hebrew_zadi #xcf6 ;; deprecated +)(defconstant XK_hebrew_qoph #xcf7 +)(defconstant XK_hebrew_kuf #xcf7 ;; deprecated +)(defconstant XK_hebrew_resh #xcf8 +)(defconstant XK_hebrew_shin #xcf9 +)(defconstant XK_hebrew_taw #xcfa +)(defconstant XK_hebrew_taf #xcfa ;; deprecated +)(defconstant XK_Hebrew_switch #xFF7E ;; Alias for mode_switch +;;endif ;; XK_HEBREW +) diff --git a/xgcl-2/gcl_lispserver.lsp b/xgcl-2/gcl_lispserver.lsp new file mode 100644 index 0000000..79acade --- /dev/null +++ b/xgcl-2/gcl_lispserver.lsp @@ -0,0 +1,130 @@ +; lispserver.lsp Gordon S. Novak Jr. ; 26 Jan 06 + +; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 06 Jun 02 + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + +;------------------------------------------------------------------------ + +; This is an example of a simple interactive graphical interface +; to a Lisp program. It reads Lisp expressions from the user, +; evaluates them, and prints the result. + +; Stand-alone usage using XGCL (edit file paths as appropriate): +; (load "/u/novak/X/xgcl-2/dwsyms.lsp") +; (load "/u/novak/X/xgcl-2/dwimports.lsp") +; (load "/u/novak/X/solaris/dwtrans.o") +; (load "/u/novak/glisp/menu-settrans.lsp") +; (load "/u/novak/glisp/lispservertrans.lsp") +; (lisp-server) + +; Usage with the WeirdX Java emulation of an X server begins with +; the web page example.html and uses the files lispserver.cgi , +; nph-lisp-action.cgi , and lispdemo.lsp . + +;------------------------------------------------------------------------ + +(defvar *wio-window* nil) +(defvar *wio-window-width* 500) +(defvar *wio-window-height* 300) +(defvar *wio-menu-set* nil) +(defvar *wio-font* '8x13) + +(glispglobals (*wio-window* window) + (*wio-window-width* integer) + (*wio-window-height* integer) + (*wio-menu-set* menu-set) ) + +(defmacro while (test &rest forms) + `(loop (unless ,test (return)) ,@forms) ) + +; 18 Apr 95; 20 Apr 95; 08 May 95; 31 May 02 +; Make a window to use. +(setf (glfnresulttype 'wio-window) 'window) +(defun wio-window (&optional title width height (posx 0) (posy 0) font) + (if width (setq *wio-window-width* width)) + (if height (setq *wio-window-height* height)) + (or *wio-window* + (setq *wio-window* + (window-create *wio-window-width* *wio-window-height* title + nil posx posy font))) ) + +; 19 Apr 95 +(defun wio-init-menus (w commands) + (let () + (window-clear w) + (setq *wio-menu-set* (menu-set-create w nil)) + (menu-set-add-menu *wio-menu-set* 'command nil "Commands" + commands (list 0 0)) + (menu-set-adjust *wio-menu-set* 'command 'top nil 2) + (menu-set-adjust *wio-menu-set* 'command 'right nil 2) + )) + +; 19 Apr 95; 20 Apr 95; 25 Apr 95; 02 May 95; 29 May 02 +; Lisp server example +(gldefun lisp-server () + (let (w inputm done sel (redraw t) str result) + (w = (wio-window "Lisp Server")) + (open w) + (clear w) + (set-font w *wio-font*) + (wio-init-menus w '(("Quit" . quit))) + (window-print-lines w + '("Click mouse in the input box, then enter" + "a Lisp expression followed by Return." + "" + "Input: e.g. (+ 3 4) or (sqrt 2)") + 10 (- *wio-window-height* 20)) + (window-printat-xy w "Result:" 10 (- *wio-window-height* 150)) + (inputm = (textmenu-create (- *wio-window-width* 100) 30 nil w + 20 (- *wio-window-height* 110) t t '9x15 t)) + (add-item *wio-menu-set* 'input nil inputm) + (while ~ done do + (sel = (menu-set-select *wio-menu-set* redraw)) + (redraw = nil) + (case (menu-name sel) + (command + (case (port sel) + (quit (done = t)) + )) + (input (str = (port sel)) + (result = (catch 'error + (eval (safe-read-from-string str)))) + (erase-area-xy w 20 2 (- *wio-window-width* 20) + (- *wio-window-height* 160)) + (window-print-line w (write-to-string result :pretty t) + 20 (- *wio-window-height* 170))) + ) ) + (close w) + )) + +; 25 Apr 95; 14 Mar 01 +(defun safe-read-from-string (str) + (if (and (stringp str) (> (length str) 0)) + (read-from-string str nil 'read-error))) + +(defun compile-lispserver () + (glcompfiles *directory* + '("glisp/vector.lsp") ; auxiliary files + '("glisp/lispserver.lsp") ; translated files + "glisp/lispservertrans.lsp") ; output file + ) diff --git a/xgcl-2/gcl_lispservertrans.lsp b/xgcl-2/gcl_lispservertrans.lsp new file mode 100644 index 0000000..49f6388 --- /dev/null +++ b/xgcl-2/gcl_lispservertrans.lsp @@ -0,0 +1,110 @@ +; 27 Jan 2006 14:38:08 CST +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + +(DEFVAR *WIO-WINDOW* NIL) + +(DEFVAR *WIO-WINDOW-WIDTH* 500) + +(DEFVAR *WIO-WINDOW-HEIGHT* 300) + +(DEFVAR *WIO-MENU-SET* NIL) + +(DEFVAR *WIO-FONT* '8X13) + +(DEFVAR *WIO-WINDOW*) +(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVAR) T) +(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) +(DEFVAR *WIO-WINDOW-WIDTH*) +(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVAR) T) +(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVARTYPE) 'INTEGER) +(DEFVAR *WIO-WINDOW-HEIGHT*) +(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVAR) T) +(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVARTYPE) 'INTEGER) +(DEFVAR *WIO-MENU-SET*) +(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVAR) T) +(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) + + +(DEFMACRO WHILE (TEST &REST FORMS) + (LIST* 'LOOP (LIST 'UNLESS TEST '(RETURN)) FORMS)) + +(SETF (GET 'WIO-WINDOW 'GLFNRESULTTYPE) 'WINDOW) + +(DEFUN WIO-WINDOW (&OPTIONAL TITLE WIDTH HEIGHT (POSX 0) (POSY 0) FONT) + (IF WIDTH (SETQ *WIO-WINDOW-WIDTH* WIDTH)) + (IF HEIGHT (SETQ *WIO-WINDOW-HEIGHT* HEIGHT)) + (OR *WIO-WINDOW* + (SETQ *WIO-WINDOW* + (WINDOW-CREATE *WIO-WINDOW-WIDTH* *WIO-WINDOW-HEIGHT* TITLE + NIL POSX POSY FONT)))) + +(DEFUN WIO-INIT-MENUS (W COMMANDS) + (LET () + (WINDOW-CLEAR W) + (SETQ *WIO-MENU-SET* (MENU-SET-CREATE W NIL)) + (MENU-SET-ADD-MENU *WIO-MENU-SET* 'COMMAND NIL "Commands" COMMANDS + (LIST 0 0)) + (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'TOP NIL 2) + (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'RIGHT NIL 2))) + +(DEFUN LISP-SERVER () + (LET (W INPUTM DONE SEL (REDRAW T) STR RESULT) + (SETQ W (WIO-WINDOW "Lisp Server")) + (WINDOW-OPEN W) + (WINDOW-CLEAR W) + (WINDOW-SET-FONT W *WIO-FONT*) + (WIO-INIT-MENUS W '(("Quit" . QUIT))) + (WINDOW-PRINT-LINES W + '("Click mouse in the input box, then enter" + "a Lisp expression followed by Return." "" + "Input: e.g. (+ 3 4) or (sqrt 2)") + 10 (+ -20 *WIO-WINDOW-HEIGHT*)) + (WINDOW-PRINTAT-XY W "Result:" 10 (+ -150 *WIO-WINDOW-HEIGHT*)) + (SETQ INPUTM + (TEXTMENU-CREATE (+ -100 *WIO-WINDOW-WIDTH*) 30 NIL W 20 + (+ -110 *WIO-WINDOW-HEIGHT*) T T '9X15 T)) + (MENU-SET-ADD-ITEM *WIO-MENU-SET* 'INPUT NIL INPUTM) + (WHILE (NOT DONE) + (SETQ SEL (MENU-SET-SELECT *WIO-MENU-SET* REDRAW)) + (SETQ REDRAW NIL) + (CASE (CADR SEL) + (COMMAND (CASE (CAR SEL) (QUIT (SETQ DONE T)))) + (INPUT (SETQ STR (CAR SEL)) + (SETQ RESULT + (CATCH 'ERROR + (EVAL (SAFE-READ-FROM-STRING STR)))) + (WINDOW-ERASE-AREA-XY W 20 2 + (+ -20 *WIO-WINDOW-WIDTH*) + (+ -160 *WIO-WINDOW-HEIGHT*)) + (WINDOW-PRINT-LINE W + (WRITE-TO-STRING RESULT :PRETTY T) 20 + (+ -170 *WIO-WINDOW-HEIGHT*))))) + (WINDOW-CLOSE W))) + +(DEFUN SAFE-READ-FROM-STRING (STR) + (IF (AND (STRINGP STR) (> (LENGTH STR) 0)) + (READ-FROM-STRING STR NIL 'READ-ERROR))) + +(DEFUN COMPILE-LISPSERVER () + (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp") + '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" + "glisp/gpl.txt")) + +(DEFUN COMPILE-LISPSERVERB () + (GLCOMPFILES *DIRECTORY* + '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" + "glisp/gpl.txt")) diff --git a/xgcl-2/gcl_menu-set.lsp b/xgcl-2/gcl_menu-set.lsp new file mode 100644 index 0000000..ca0b260 --- /dev/null +++ b/xgcl-2/gcl_menu-set.lsp @@ -0,0 +1,521 @@ +; menu-set.lsp Gordon S. Novak Jr. ; 17 Jan 08 + +; Functions to handle a set of menus within a single window. + +; Copyright (c) 2008 Gordon S. Novak Jr. and The University of Texas at Austin. + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + +; 12 Aug 96; 04 Nov 97; 28 Feb 02; 05 Jan 04; 03 Mar 04; 30 Jul 04; 02 Aug 04 +; 27 Jan 06 + +; (wtesta) ; in dwtest.lsp, to create window myw +; (setq ms (menu-set-create myw nil)) +; (menu-set-add-menu ms 'flag1 nil "Colors" '(red white blue)) +; position w/mouse +; (menu-set-add-menu ms 'Test1 nil "Choice" '(yes no)) +; position w/mouse +; do (wteste) to create the square picmenu +; (menu-set-add-picmenu ms 'square1 nil "Square" mypms) +; following is alternative -- window is too small to hold both square and cone +; create cone with draw +; (menu-set-add-picmenu ms 'cone1 'cone "Cone" 'cone) +; (menu-set-add-component ms 'nand) ; load draw-gates for nand and cone +; +; (menu-set-draw ms) +; (menu-set-select ms) ; click a menu or background +; (setq mc (menu-conns-create ms)) ; make a menu-conns object from menu set +; (menu-conns-add-conn mc) ; click two buttons/menu items +; repeat above as desired +; (menu-conns-move mc) ; click a menu and move it + +(glispobjects + +(menu-set (listobject (window window) + (menu-items (listof menu-set-item)) + (commandfn anything)) + msg ((draw menu-set-draw) + (select menu-set-select) + (named-menu menu-set-named-menu) + (named-item menu-set-named-item) + (add-menu menu-set-add-menu) + (add-picmenu menu-set-add-picmenu) + (add-component menu-set-add-component) + (add-barmenu menu-set-add-barmenu) + (add-item menu-set-add-item) + (find-item menu-set-find-item) + (delete-item menu-set-delete-item) + (remove-items menu-set-remove-items) + (item-position menu-set-item-position) + (itemp menu-set-itemp) + (adjust menu-set-adjust) + (move menu-set-move) + (draw-conn menu-set-draw-conn) ) ) + +(menu-set-item (list (menu-name symbol) + (sym anything) ; extra info + (menu menu-set-menu) ) + prop ((left ((parent-offset-x menu))) + (bottom ((parent-offset-y menu))) + (width ((picture-width menu))) + (height ((picture-height menu))) ) + supers (region) ) + +(menu-set-menu (transparent menu) ; menu or picmenu + msg ((draw menu-mdraw)) ) + +(menu-port (list (port symbol) (menu-name symbol)) ) + +(menu-selection (list (port symbol) (menu-name symbol) (button integer)) ) + +(menu-set-conn (list (from menu-port) + (to menu-port))) + +(menu-conns (listobject (menu-set menu-set) + (connections (listof menu-set-conn))) + prop ((window ((window (menu-set self))))) + msg ((draw menu-conns-draw) + (redraw menu-conns-redraw) + (move menu-conns-move) + (add-conn menu-conns-add-conn) + (add-item menu-conns-add-item open t) + (find-conn menu-conns-find-conn) + (find-item menu-conns-find-item) + (delete-item menu-conns-delete-item) + (delete-conn menu-conns-delete-conn) + (remove-items menu-conns-remove-items) + (find-conns menu-conns-find-conns) + (connected-ports menu-conns-connected-ports) + (new-conn menu-conns-new-conn) + (named-menu menu-conns-named-menu) + (named-item menu-conns-named-item) ) ) + + ) ; glispobjects + +; 04 Sep 92; 09 Feb 94; 12 Oct 94 +(gldefun menu-set-create ((w window) &optional fn) + (a menu-set with window = w commandfn = fn)) + +; 05 Sep 92; 09 Sep 92; 10 Sep 92; 02 Nov 92; 05 May 93; 07 May 93; 04 Aug 93 +; 03 Jan 94; 07 Jan 94; 03 May 94; 05 Jan 95; 11 Apr 95; 03 Nov 97; 05 Jan 04 +; Select from multiple menu-like regions within a window. +; Result is a menu-selection, i.e., a list of the value selected, +; menu name, and button used, +; e.g., (QUIT COMMAND 1) for selecting the QUIT item from the COMMAND menu. +; A click outside any menu returns ((x y) BACKGROUND button-code). +; enabled, if specified, is a list of names of menus enabled for selection. +(gldefun menu-set-select ((ms menu-set) &optional (redraw boolean) + (enabled (listof symbol))) + (result menu-selection) + (let ((res menu-selection) resb (itm menu-set-item) (sel symbol) lastx lasty) + (if redraw (draw ms)) + (while ~ (or res resb) + (setq itm (window-track-mouse (window ms) + #'(lambda (x y code) + (or (and (> code 0) + (setq lastx x) + (setq lasty y) + code) + (that menu-item with + (contains-xy (that menu-item) x y)))))) + (if (numberp itm) + (resb = (a menu-selection with + port (a vector with x = lastx y = lasty) + menu-name 'background + button itm)) + (if (or (atom enabled) + (member (menu-name itm) enabled)) + (progn (sel = (menu-mselect (menu itm) (eq enabled t))) + (if sel + (res = (a menu-selection with + menu-name (menu-name itm) + port sel + button *window-menu-code*)) + (if (and *window-menu-code* + (*window-menu-code* <> 0)) + (res = (a menu-selection with + menu-name (menu-name itm) + port nil + button *window-menu-code*)))) ) ) )) + (force-output (window ms)) + (or res resb) )) + +; 05 Sep 92; 25 Sep 92; 29 Sep 92 +; Add a menu to a menu set. +; name is the name of the menu. sym is extra info such as data type. +(gldefun menu-set-add-menu ((ms menu-set) (name symbol) (sym symbol) + (title string) items + &optional (offset vector)) + (let (menu) + (menu = (menu-create items title (window ms) (x offset) (y offset) t t)) + (init menu) + (if ~ offset (offset = (get-box-position (window ms) + (picture-width menu) + (picture-height menu)))) + ((parent-offset-x menu) = (x offset)) + ((parent-offset-y menu) = (y offset)) + (add-item ms name sym menu) )) + +; 25 Sep 92; 29 Sep 92; 07 May 93 +(gldefun menu-set-add-item ((ms menu-set) (name symbol) (sym symbol) + (menu menu)) + ((menu-items ms) _+ (a menu-set-item with menu-name = name sym = sym + menu = menu)) ) + +; 25 Sep 92 +(gldefun menu-set-remove-items ((ms menu-set)) + ((menu-items ms) = nil) ) + +; 06 Sep 92; 08 Sep 92; 14 Sep 92; 25 Sep 92; 29 Sep 92; 05 Jan 04; 23 Jun 04 +(gldefun menu-set-add-picmenu ((ms menu-set) (name symbol) (sym symbol) + (title string) + (spec picmenu-spec) + &optional (offset vector) + (nobox boolean)) + (let (menu maxwidth maxheight) + (if (and spec (symbolp spec)) + (spec = (get spec 'picmenu-spec)) ) + (menu = (picmenu-create-from-spec spec title (window ms) + (x offset) (y offset) t t (not nobox))) + (maxwidth = (max (if title ((* 9 (length title)) + 6) 0) + (drawing-width spec))) + (maxheight = (if title 15 0) + (drawing-height spec)) + (if ~ offset (offset = (get-box-position (window ms) maxwidth maxheight))) + ((parent-offset-x menu) = (x offset)) + ((parent-offset-y menu) = (y offset)) + (add-item ms name sym menu) )) + +; 11 Oct 93 +(gldefun menu-set-add-component ((ms menu-set) (name symbol) + &optional (offset vector)) + (menu-set-add-picmenu ms (menu-set-name name) name nil name offset t)) + +; 03 Jan 94; 05 Jan 04 +; Add a barmenu to a menu set. +(gldefun menu-set-add-barmenu ((ms menu-set) (name symbol) (sym symbol) + (menu barmenu) + (title string) &optional (offset vector)) + (let () + (init menu) + (if ~ offset + (offset = (get-box-position (window ms) + (picture-width menu) (picture-height menu)))) + ((parent-offset-x menu) = (x offset)) + ((parent-offset-y menu) = (y offset)) + (add-item ms name sym menu) )) + +; 11 Oct 93 +(gldefun menu-set-name ((nm symbol)) (result symbol) + (intern (symbol-name (gensym (symbol-name nm)))) ) + +; 29 Sep 92; 07 May 93; 28 Feb 02 +(gldefun menu-set-named-item ((ms menu-set) (name symbol)) + (result menu-set-item) + (that menu-item with (menu-name (that menu-item)) == name) ) + +; 08 Sep 92; 29 Sep 92 +(gldefun menu-set-named-menu ((ms menu-set) (name symbol)) + (result menu-set-menu) + (menu (named-item ms name))) + +; 17 Jan 08 +(gldefun menu-set-itemp ((ms menu-set) (name symbol) (itemname symbol)) + (let ((thismenu (named-menu ms name))) + (if thismenu is a menu + (some #'(lambda (x) (or (eq x itemname) + (and (consp x) (eq (car x) itemname)))) + (items thismenu)) + (if thismenu is a picmenu + (assoc itemname (buttons thismenu)) ) ) )) + +; 30 Jul 04 +(gldefun menu-conns-named-item ((mc menu-conns) (name symbol)) + (result menu-set-item) + (named-item (menu-set mc) name) ) + +; 01 Feb 94 +(gldefun menu-conns-named-menu ((mc menu-conns) (name symbol)) + (result menu-set-menu) + (named-menu (menu-set mc) name) ) + +; 29 Apr 93; 30 Apr 93; 05 Jan 04 +; Find the item at specified position, if any +(gldefun menu-set-find-item ((ms menu-set) (pos vector)) + (result menu-set-item) + (let (mitem) + (for mi in (menu-items ms) do + (if (contains? (menu mi) pos) + (mitem = mi))) + mitem)) + +; 29 Apr 93 +; Delete an item +(gldefun menu-set-delete-item ((ms menu-set) (mi menu-set-item)) + ((menu-items ms) _- mi)) + +; 08 Sep 92; 10 Sep 92; 05 May 93; 06 May 93; 07 May 93 +(gldefun menu-set-move ((ms menu-set)) + (let (sel m) + (sel = (menu-set-select ms nil t)) + (m = (named-menu ms (menu-name sel))) + (menu-reposition m) )) + +; 10 Sep 92; 05 Jan 94; 06 Jan 94; 20 Apr 95; 12 Aug 96 +; Draw either a menu or picmenu +(gldefun menu-mdraw (m) + (case (first m) + (menu (menu-draw m)) + (picmenu (picmenu-draw m)) + (barmenu (barmenu-draw m)) + (textmenu (textmenu-draw m)) + (editmenu (editmenu-draw m)) + (t (glsend m draw)) ) ) + +; 10 Sep 92; 29 Sep 92; 05 May 93; 03 Jan 94; 06 Jan 94; 20 Apr 95; 21 Apr 95 +; 12 Aug 96 +; Select from either a menu or picmenu +(gldefun menu-mselect (m &optional anyclick) + (case (first m) + (menu (menu-select m t)) + (picmenu (picmenu-select m t anyclick)) + (barmenu (barmenu-select m)) + (textmenu (textmenu-select m t)) + (editmenu (editmenu-select m t)) + (t (glsend m select)) ) ) + +; 10 Sep 92; 06 Jan 94 +; Get item position from either a menu or picmenu; 20 Apr 95 +(gldefun menu-mitem-position (m name loc) + (case (first m) + (menu (menu-item-position m name loc)) + (picmenu (picmenu-item-position m name loc)) + (t (glsend m item-position name loc)) ) ) + +; 05 Sep 92; 08 Sep 92 +(gldefun menu-set-draw ((ms menu-set)) + (let () + (open (window ms)) + (for item in (menu-items ms) do (draw (menu item))) )) + +; 08 Sep 92; 28 Sep 92; 07 May 93; 25 Jan 94 +(gldefun menu-set-item-position ((ms menu-set) (desc menu-port) + &optional (loc symbol)) + (result vector) + (let (m) + (m = (named-menu ms (menu-name desc))) + (or (menu-mitem-position m (port desc) loc) + (menu-mitem-position m nil loc)) )) ; header if it cannot be found + +; 08 Sep 92; 05 Jan 04 +(gldefun menu-set-draw-conn ((ms menu-set) (conn menu-set-conn)) + (let (pa pb tmp (desca (from conn)) (descb (to conn))) + (pa = (menu-set-item-position ms desca 'center)) + (pb = (menu-set-item-position ms descb 'center)) + (if ((x pa) > (x pb)) + (progn (tmp = desca) + (desca = descb) + (descb = tmp))) + (pa = (menu-set-item-position ms desca 'right)) + (pb = (menu-set-item-position ms descb 'left)) + (draw-circle (window ms) pa 3) + (draw-line (window ms) pa pb) + (draw-circle (window ms) pb 3) + (force-output (window ms)) )) + +; 02 Dec 93; 07 Jan 94; 05 Jan 04 +(gldefun menu-set-adjust ((ms menu-set) (name symbol) (edge symbol) + (from symbol) (offset integer)) + (let (m fromm place) + (if (m = (named-item ms name)) + (progn + (if from + (progn (fromm = (named-item ms from)) + (place = (case edge + (top (bottom fromm)) + (bottom (top fromm)) + (left (right fromm)) + (right (left fromm))))) + (place = (case edge + (top (height (window ms))) + ((bottom left) 0) + (right (width (window ms))) )) ) + (case edge (top ((bottom m) = place - (height m) - offset)) + (bottom ((bottom m) = place + offset)) + (left ((left m) = place + offset)) + (right ((left m) = place - (width m) - offset)))) ) )) + +; 21 Nov 08 +; align the vector approx with the vector fixed if within tolerance +(gldefun vector-snap ((fixed vector) (approx vector) + &optional tolerance) + (let () + (or tolerance (tolerance = 10)) + (if (< (abs (- (x fixed) (x approx))) tolerance) + (a vector x = (x fixed) y = (y approx)) + (if (< (abs (- (y fixed) (y approx))) tolerance) + (a vector x = (x approx) y = (y fixed)) + approx) ) )) + +; 12 Oct 94; 28 Feb 02 +(gldefun menu-conns-create ((ms menu-set)) + (a menu-conns with menu-set = ms)) + +; 08 Sep 92 +(gldefun menu-conns-draw ((mc menu-conns)) + (let () + (draw (menu-set mc)) + (for c in (connections mc) (draw-conn (menu-set mc) c)) )) + +; 08 Sep 92 +(gldefun menu-conns-move ((mc menu-conns)) + (let () + (menu-set-move (menu-set mc)) + (clear (window mc)) + (draw mc) )) + +; 29 Apr 93 +(gldefun menu-conns-redraw ((mc menu-conns)) + (let () + (clear (window mc)) + (draw mc) )) + +; 08 Sep 92; 07 May 93; 21 Oct 93; 05 Jan 95; 28 Feb 02; 05 Jan 04 +(gldefun menu-conns-add-conn ((mc menu-conns)) + (let (sel selb conn) + (sel = (select (menu-set mc))) + (if ((menu-name sel) == 'background) + sel + (progn (selb = (select (menu-set mc))) + (if ((menu-name selb) <> 'background) + (progn (conn = (a menu-set-conn with from = sel to = selb)) + (draw-conn (menu-set mc) conn) + ((connections mc) _+ conn))) + nil) ) )) + +; 02 Aug 04 +(gldefun menu-conns-new-conn ((mc menu-conns) (fromname symbol) + (fromport symbol) (toname symbol) + (toport symbol)) + (let (conn) + (conn = (a menu-set-conn with + from = (a menu-port with menu-name = fromname port = fromport) + to = (a menu-port with menu-name = toname port = toport))) + ((connections mc) _+ conn) )) + +; 30 Apr 93 +(gldefun menu-conns-add-item + ((mc menu-conns) (name symbol) (sym symbol) (menu menu)) + (add-item (menu-set mc) name sym menu)) + +; 29 Apr 93; 05 Jan 04 +; Find the connection that is selected by the given point, if any. +(gldefun menu-conns-find-conn ((mc menu-conns) (pt vector)) + (result menu-set-conn) + (let (ms ls found res pa pb tmp desca descb) + (ls = (a line-segment)) + (ms = (menu-set mc)) + (for conn in (connections mc) when (not found) do + (desca = (from conn)) + (descb = (to conn)) + (pa = (menu-set-item-position ms desca 'center)) + (pb = (menu-set-item-position ms descb 'center)) + (if ((x pa) > (x pb)) + (progn (tmp = desca) + (desca = descb) + (descb = tmp))) + ((p1 ls) = (menu-set-item-position ms desca 'right)) + ((p2 ls) = (menu-set-item-position ms descb 'left)) + (if (< (distance ls pt) 5) + (progn (found = t) + (res = conn)) )) + res)) + +; 29 Apr 93; 30 Apr 93 +; Find the menu item that is selected by the given point, if any. +(gldefun menu-conns-find-item ((mc menu-conns) (pt vector)) + (result menu-set-item) + (find-item (menu-set mc) pt)) + +; 29 Apr 93 +; Delete a connection +(gldefun menu-conns-delete-conn ((mc menu-conns) (conn menu-set-conn)) + ((connections mc) _- conn)) + +; 29 Apr 93; 07 May 93; 28 Feb 02; 05 Jan 04 +; Delete a menu item and all its connections +(gldefun menu-conns-delete-item ((mc menu-conns) (mi menu-set-item)) + (let (ms) + (ms = (menu-set mc)) + (delete-item ms mi) + (for conn in (connections mc) do + (if (or ((menu-name (from conn)) == (menu-name mi)) + ((menu-name (to conn)) == (menu-name mi))) + (delete-conn mc conn))) )) + +; 30 Apr 93 +(gldefun menu-conns-remove-items ((mc menu-conns)) + (remove-items (menu-set mc)) + ((connections mc) = nil)) + +; 30 Apr 93; 07 May 93; 28 Feb 02; 05 Jan 04 +; find all ports of a given named menu that are connected to something +(gldefun menu-conns-connected-ports ((mc menu-conns) (boxname symbol)) + (let (ports) + (for conn in (connections mc) do + (if (boxname == (menu-name (to conn))) + (pushnew (port (to conn)) ports) + (if (boxname == (menu-name (from conn))) + (pushnew (port (from conn)) ports)))) + ports)) + +; 30 Apr 93; 07 May 93; 28 Feb 02 +; Find connections of a given port of a named box +(gldefun menu-conns-find-conns ((mc menu-conns) (boxname symbol) (port symbol)) + (result (listof menu-port)) + (let (res) + (for conn in (connections mc) do + (if (and (boxname == (menu-name (to conn))) + (port == (port (to conn)))) + (res _+ (from conn))) + (if (and (boxname == (menu-name (from conn))) + (port == (port (from conn)))) + (res _+ (to conn))) ) + res)) + +; 03 May 94 +; Compile menu-set.lsp into a plain Lisp file +(defun compile-menu-set () + (glcompfiles *directory* + '("glisp/vector.lsp" ; auxiliary files + "X/dwindow.lsp") + '("glisp/menu-set.lsp") ; translated files + "glisp/menu-settrans.lsp" ; output file + "glisp/menu-set-header.lsp") ; header file + (compile-file "glisp/menu-settrans.lsp") ) + +; Compile menu-set.lsp into a plain Lisp file for XGCL distribution +(defun compile-menu-setb () + (glcompfiles *directory* + '("glisp/vector.lsp" ; auxiliary files + "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/menu-set.lsp") ; translated files + "glisp/menu-settrans.lsp" ; output file + "glisp/menu-set-header.lsp") ; header file + ) diff --git a/xgcl-2/gcl_menu-settrans.lsp b/xgcl-2/gcl_menu-settrans.lsp new file mode 100644 index 0000000..f4e5552 --- /dev/null +++ b/xgcl-2/gcl_menu-settrans.lsp @@ -0,0 +1,531 @@ +; 07 Jan 2010 16:46:11 EST + +; menu-settrans.lsp -- translation of menu-set.lsp Gordon S. Novak Jr. + +; Copyright 2006 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + +(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) + +(defmacro glmethod (class selector) + `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) + +(SETF (GET 'MENU-SET 'GLSTRUCTURE) + '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) + (COMMANDFN ANYTHING)) + MSG + ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) + (NAMED-MENU MENU-SET-NAMED-MENU) + (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) + (ADD-PICMENU MENU-SET-ADD-PICMENU) + (ADD-COMPONENT MENU-SET-ADD-COMPONENT) + (ADD-BARMENU MENU-SET-ADD-BARMENU) + (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) + (DELETE-ITEM MENU-SET-DELETE-ITEM) + (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) + (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) + (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) + (DRAW-CONN MENU-SET-DRAW-CONN)))) +(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) + '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) + PROP + ((LEFT ((PARENT-OFFSET-X MENU))) + (BOTTOM ((PARENT-OFFSET-Y MENU))) + (WIDTH ((PICTURE-WIDTH MENU))) + (HEIGHT ((PICTURE-HEIGHT MENU)))) + SUPERS (REGION))) +(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) + '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) +(SETF (GET 'MENU-PORT 'GLSTRUCTURE) + '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) +(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) + '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) +(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) + '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) +(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) + '((LISTOBJECT (MENU-SET MENU-SET) + (CONNECTIONS (LISTOF MENU-SET-CONN))) + PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG + ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) + (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) + (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) + (FIND-CONN MENU-CONNS-FIND-CONN) + (FIND-ITEM MENU-CONNS-FIND-ITEM) + (DELETE-ITEM MENU-CONNS-DELETE-ITEM) + (DELETE-CONN MENU-CONNS-DELETE-CONN) + (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) + (FIND-CONNS MENU-CONNS-FIND-CONNS) + (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) + (NEW-CONN MENU-CONNS-NEW-CONN) + (NAMED-MENU MENU-CONNS-NAMED-MENU) + (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) + + +(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) +(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) + '((W WINDOW) (&OPTIONAL NIL))) +(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) + + +(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) + (LET (RES RESB ITM SEL LASTX LASTY) + (IF REDRAW (MENU-SET-DRAW MS)) + (WHILE (NOT (OR RES RESB)) + (SETQ ITM + (WINDOW-TRACK-MOUSE (CADR MS) + #'(LAMBDA (X Y CODE) + (OR (AND (PLUSP CODE) (SETQ LASTX X) + (SETQ LASTY Y) CODE) + (SOME #'(LAMBDA (GLVAR237) + (IF + (AND + (BETWEEN X + (FIFTH (CADDR GLVAR237)) + (+ (FIFTH (CADDR GLVAR237)) + (SEVENTH (CADDR GLVAR237)))) + (BETWEEN Y + (SIXTH (CADDR GLVAR237)) + (+ (SIXTH (CADDR GLVAR237)) + (EIGHTH (CADDR GLVAR237))))) + GLVAR237)) + (CADDR MS)))))) + (IF (NUMBERP ITM) + (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) + (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) + (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) + (IF SEL + (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) + (IF (AND *WINDOW-MENU-CODE* + (NOT (ZEROP *WINDOW-MENU-CODE*))) + (SETQ RES + (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) + (XFLUSH *WINDOW-DISPLAY*) + (OR RES RESB))) +(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) + '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) +(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) + + +(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) + (LET (MENU) + (SETQ MENU + (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) + T T)) + (MENU-INIT MENU) + (IF (NOT OFFSET) + (SETQ OFFSET + (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) + (EIGHTH MENU)))) + (SETF (FIFTH MENU) (CAR OFFSET)) + (SETF (SIXTH MENU) (CADR OFFSET)) + (MENU-SET-ADD-ITEM MS NAME SYM MENU))) +(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) + (ITEMS NIL) (&OPTIONAL VECTOR))) +(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) + (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) +(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) +(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) +(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) +(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-PICMENU + (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) + (LET (MENU MAXWIDTH MAXHEIGHT) + (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) + (SETQ MENU + (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) + (CADR OFFSET) T T (NOT NOBOX))) + (SETQ MAXWIDTH + (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) + (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) + (IF (NOT OFFSET) + (SETQ OFFSET + (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) + (SETF (FIFTH MENU) (CAR OFFSET)) + (SETF (SIXTH MENU) (CADR OFFSET)) + (MENU-SET-ADD-ITEM MS NAME SYM MENU))) +(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) + (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) +(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) + (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) +(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) +(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) + (BARMENU-INIT MENU) + (IF (NOT OFFSET) + (SETQ OFFSET + (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) + (EIGHTH MENU)))) + (SETF (FIFTH MENU) (CAR OFFSET)) + (SETF (SIXTH MENU) (CADR OFFSET)) + (MENU-SET-ADD-ITEM MS NAME SYM MENU)) +(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) + (TITLE STRING) (&OPTIONAL VECTOR))) +(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-NAME (NM) + (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) +(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) +(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) + + +(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) +(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL))) +(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-SET-NAMED-MENU (MS NAME) + (CADDR (MENU-SET-NAMED-ITEM MS NAME))) +(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL))) +(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) + + +(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) + (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) + (IF (EQ (FIRST THISMENU) 'MENU) + (SOME #'(LAMBDA (X) + (OR (EQ X ITEMNAME) + (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) + (NTH 13 THISMENU)) + (IF (EQ (FIRST THISMENU) 'PICMENU) + (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) +(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) +(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) + + +(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) + (MENU-SET-NAMED-ITEM (CADR MC) NAME)) +(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) + '((MC MENU-CONNS) (NAME SYMBOL))) +(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) + (MENU-SET-NAMED-MENU (CADR MC) NAME)) +(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) + '((MC MENU-CONNS) (NAME SYMBOL))) +(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) + + +(DEFUN MENU-SET-FIND-ITEM (MS POS) + (LET (MITEM) + (DOLIST (MI (CADDR MS)) + (IF (AND (BETWEEN (CAR POS) + (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (FIFTH SELF) 0)) + (+ (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (FIFTH SELF) 0)) + (SEVENTH (CADDR MI)))) + (BETWEEN (CADR POS) + (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (SIXTH SELF) 0)) + (+ (LET ((SELF (CADDR MI))) + (IF (CADDR SELF) (SIXTH SELF) 0)) + (EIGHTH (CADDR MI))))) + (SETQ MITEM MI))) + MITEM)) +(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (POS VECTOR))) +(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-SET-DELETE-ITEM (MS MI) + (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) +(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) + '((MS MENU-SET) (MI MENU-SET-ITEM))) +(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-SET-MOVE (MS) + (LET (SEL M) + (SETQ SEL (MENU-SET-SELECT MS NIL T)) + (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) + (MENU-REPOSITION M))) + +(DEFUN MENU-MDRAW (M) + (CASE (FIRST M) + (MENU (MENU-DRAW M)) + (PICMENU (PICMENU-DRAW M)) + (BARMENU (BARMENU-DRAW M)) + (TEXTMENU (TEXTMENU-DRAW M)) + (EDITMENU (EDITMENU-DRAW M)) + (T (GLSEND M DRAW)))) + +(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) + (CASE (FIRST M) + (MENU (MENU-SELECT M T)) + (PICMENU (PICMENU-SELECT M T ANYCLICK)) + (BARMENU (BARMENU-SELECT M)) + (TEXTMENU (TEXTMENU-SELECT M T)) + (EDITMENU (EDITMENU-SELECT M T)) + (T (GLSEND M SELECT)))) + +(DEFUN MENU-MITEM-POSITION (M NAME LOC) + (CASE (FIRST M) + (MENU (MENU-ITEM-POSITION M NAME LOC)) + (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) + (T (GLSEND M ITEM-POSITION NAME LOC)))) + +(DEFUN MENU-SET-DRAW (MS) + (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) + (XFLUSH *WINDOW-DISPLAY*) + (WINDOW-WAIT-EXPOSURE (CADR MS)) + (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) + +(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) + (LET (M) + (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) + (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) + (MENU-MITEM-POSITION M NIL LOC)))) +(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) + '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) +(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN MENU-SET-DRAW-CONN (MS CONN) + (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) + (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) + (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) + (WHEN (> (CAR PA) (CAR PB)) + (SETQ TMP DESCA) + (SETQ DESCA DESCB) + (SETQ DESCB TMP)) + (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) + (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) + (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) + (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) + (CADR PB) NIL) + (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) + (XFLUSH *WINDOW-DISPLAY*))) + +(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) + (LET (M FROMM PLACE) + (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) + (IF FROM + (PROGN + (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) + (SETQ PLACE + (CASE EDGE + (TOP (SIXTH (CADDR FROMM))) + (BOTTOM (+ (SIXTH (CADDR FROMM)) + (EIGHTH (CADDR FROMM)))) + (LEFT (+ (FIFTH (CADDR FROMM)) + (SEVENTH (CADDR FROMM)))) + (RIGHT (FIFTH (CADDR FROMM)))))) + (SETQ PLACE + (CASE EDGE + (TOP (CADDDR (CADR MS))) + ((BOTTOM LEFT) 0) + (RIGHT (FIFTH (CADR MS)))))) + (CASE EDGE + (TOP (SETF (SIXTH (CADDR M)) + (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) + (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) + (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) + (RIGHT (SETF (FIFTH (CADDR M)) + (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) +(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) + '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) + (OFFSET INTEGER))) +(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) + + +(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) + (OR TOLERANCE (SETQ TOLERANCE 10)) + (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) + (LIST (CAR FIXED) (CADR APPROX)) + (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) + (LIST (CAR APPROX) (CADR FIXED)) APPROX))) +(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) + '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) +(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) + + +(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) +(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) +(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) + + +(DEFUN MENU-CONNS-DRAW (MC) + (MENU-SET-DRAW (CADR MC)) + (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) + +(DEFUN MENU-CONNS-MOVE (MC) + (MENU-SET-MOVE (CADR MC)) + (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) + (XFLUSH *WINDOW-DISPLAY*) + (MENU-CONNS-DRAW MC)) + +(DEFUN MENU-CONNS-REDRAW (MC) + (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) + (XFLUSH *WINDOW-DISPLAY*) + (MENU-CONNS-DRAW MC)) + +(DEFUN MENU-CONNS-ADD-CONN (MC) + (LET (SEL SELB CONN) + (SETQ SEL (MENU-SET-SELECT (CADR MC))) + (IF (EQ (CADR SEL) 'BACKGROUND) SEL + (PROGN + (SETQ SELB (MENU-SET-SELECT (CADR MC))) + (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) + (SETQ CONN (LIST SEL SELB)) + (MENU-SET-DRAW-CONN (CADR MC) CONN) + (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) + NIL)))) +(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) +(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) + + +(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) + (LET (CONN) + (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) + (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) +(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) + '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) + (TONAME SYMBOL) (TOPORT SYMBOL))) +(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-CONN)) + + +(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) + (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) +(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) + '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) +(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-ITEM)) + + +(DEFUN MENU-CONNS-FIND-CONN (MC PT) + (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) + (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) + (SETQ MS (CADR MC)) + (DOLIST (CONN (CADDR MC)) + (UNLESS FOUND + (SETQ DESCA (CAR CONN)) + (SETQ DESCB (CADR CONN)) + (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) + (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) + (WHEN (> (CAR PA) (CAR PB)) + (SETQ TMP DESCA) + (SETQ DESCA DESCB) + (SETQ DESCB TMP)) + (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) + (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) + (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) + (- (CADR PT) (CADAR LS))) + (* (- (CADADR LS) (CADAR LS)) + (- (CAR PT) (CAAR LS)))) + (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) + (EXPT (- (CADADR LS) (CADAR LS)) 2))))) + 5) + (SETQ FOUND T) + (SETQ RES CONN)))) + RES)) +(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) + '((MC MENU-CONNS) (PT VECTOR))) +(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) + + +(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) +(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) + '((MC MENU-CONNS) (PT VECTOR))) +(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) + + +(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) + (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) +(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) + '((MC MENU-CONNS) (CONN MENU-SET-CONN))) +(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-CONN)) + + +(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) + (LET (MS) + (SETQ MS (CADR MC)) + (MENU-SET-DELETE-ITEM MS MI) + (DOLIST (CONN (CADDR MC)) + (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) + (MENU-CONNS-DELETE-CONN MC CONN))))) + +(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) + (MENU-SET-REMOVE-ITEMS (CADR MC)) + (SETF (CADDR MC) NIL)) +(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) +(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) + '(LISTOF MENU-SET-CONN)) + + +(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) + (LET (PORTS) + (DOLIST (CONN (CADDR MC)) + (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) + (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) + PORTS)) + +(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) + (LET (RES) + (DOLIST (CONN (CADDR MC)) + (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) + (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) + (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) + (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) + RES)) +(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) + '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) +(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) + + +(DEFUN COMPILE-MENU-SET () + (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") + '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" + "glisp/menu-set-header.lsp") + (COMPILE-FILE "glisp/menu-settrans.lsp")) + +(DEFUN COMPILE-MENU-SETB () + (GLCOMPFILES *DIRECTORY* + '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") + '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" + "glisp/menu-set-header.lsp")) diff --git a/xgcl-2/gcl_pcalc.lsp b/xgcl-2/gcl_pcalc.lsp new file mode 100644 index 0000000..01dfd71 --- /dev/null +++ b/xgcl-2/gcl_pcalc.lsp @@ -0,0 +1,133 @@ +; pcalc.lsp Gordon S. Novak Jr. 20 Oct 94 + +; Pocket calculator implemented using a picmenu. Entry is (pcalc) . + +; Copyright (c) 1994 Gordon S. Novak Jr. and The University of Texas at Austin. + +; See the file gnu.license . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Written by: Gordon S. Novak Jr., Department of Computer Sciences, +; University of Texas at Austin 78712. novak@cs.utexas.edu + + +(defvar *pcalcw* nil) ; window +(defvar *pcalcm* nil) ; picmenu + +(defun pcalc-draw (w x y) + (let (items item over up) + (window-open w) + (window-clear w) + (window-draw-rcbox-xy *pcalcw* 0 0 170 215 10 2) + (window-draw-rcbox-xy *pcalcw* 10 180 150 25 6) + (setq items '(0 \. = + 1 2 3 - 4 5 6 * 7 8 9 / off ac ce +-)) + (dotimes (i 5) + (setq up (+ 10 (* i 35))) + (dotimes (j 4) + (setq over (+ 10 (* j 40))) + (setq item (pop items)) + (window-printat-xy *pcalcw* item + (+ over 15 (* (if (numberp item) 1 + (length (stringify item))) + -5)) (+ up 3)) + (window-draw-rcbox-xy *pcalcw* over up 28 20 6) )) + (window-force-output) )) + +(defun pcalc-init () + (prog ((n 15)) + (setq *pcalcw* (window-create 170 215 "pcalc" nil nil nil '9x15)) + lp (when (and (> n 0) (null (window-wait-exposure *pcalcw*))) + (sleep 1.0) (decf n) (go lp)) + (setq *pcalcm* + (picmenu-create + '((0 (24 20) (24 16)) + (\. (64 20) (24 16)) + (= (104 20) (24 16)) + (+ (144 20) (24 16)) + (1 (24 55) (24 16)) + (2 (64 55) (24 16)) + (3 (104 55) (24 16)) + (- (144 55) (24 16)) + (4 (24 90) (24 16)) + (5 (64 90) (24 16)) + (6 (104 90) (24 16)) + (* (144 90) (24 16)) + (7 (24 125) (24 16)) + (8 (64 125) (24 16)) + (9 (104 125) (24 16)) + (/ (144 125) (24 16)) + (off (24 160) (24 16)) + (ac (64 160) (24 16)) + (ce (104 160) (24 16)) + (+- (144 160) (24 16))) + 170 215 'pcalc-draw nil nil *pcalcw* 0 0 t t)) )) + +(defun pcalc-display (val) + (let (str) + (window-erase-area-xy *pcalcw* 15 182 140 20) + (setq str (if (integerp val) + (princ-to-string val) + (format nil "~8,4F" val))) + (window-printat-xy *pcalcw* str (- 131 (* 9 (length str))) 185) + (window-force-output) )) + + +(defun pcalc () + (prog (key (ent 0) (ac 0) decpt lastop lastkey) + (or *pcalcw* (pcalc-init)) + (pcalc-draw *pcalcw* 0 0) + (pcalc-display ent) + lp (setq key (picmenu-select *pcalcm*)) + (if (numberp key) + (progn (when (eq lastkey '=) + (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil)) + (if decpt + (progn (setq ent (+ ent (* key decpt))) + (setq decpt (/ decpt 10.0)) ) + (setq ent (+ key (* ent 10))) ) + (pcalc-display ent)) + (case key + ((+ - * /) + (if lastop + (progn (setq ac (if (eq lastop '/) + (/ (float ac) ent) + (funcall lastop ac ent))) + (pcalc-display ac)) + (setq ac ent)) + (setq lastop key) + (setq ent 0) + (setq decpt nil)) + (= (if lastop + (progn (setq ent (if (eq lastop '/) + (/ (float ac) ent) + (funcall lastop ac ent))) + (pcalc-display ent))) + (setq lastop nil)) + (\. (when (eq lastkey '=) + (setq ent 0) (setq ac 0) (setq lastop nil)) + (setq decpt 0.1) + (setq ent (float ent)) + (pcalc-display ent)) + (+- (setq ent (- ent)) + (pcalc-display ent)) + (ce (setq ent 0) (setq decpt nil) (pcalc-display ent)) + (ac (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil) + (pcalc-display ent)) + (off (window-close *pcalcw*) + (return nil)) ) ) + (setq lastkey key) + (go lp) )) + diff --git a/xgcl-2/gcl_sysinit.lsp b/xgcl-2/gcl_sysinit.lsp new file mode 100644 index 0000000..e77963a --- /dev/null +++ b/xgcl-2/gcl_sysinit.lsp @@ -0,0 +1,69 @@ +; Copyright (c) 1994 William F. Schelter + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +(in-package :XLIB) + +;; This file is used for defining the C function user_init, to run the +;; initialization code from a list of files in *files*. These files +;; should have been compiled with (compile-file "foo.lsp" :system-p t) +;; and have been linked into the image. It presumes the .o files +;; are in the current directory, and the files *files* are in the proper +;; order to be loaded. + +;;define a function USER::USER-INIT, which will run the init code for a set +;;of files which are linked into an image. + +(clines "#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} while(0)") +(clines "static void") +(clines "load1(char *x) {") +(clines "printf(\"loading %s\\n\",x);") +(clines "fflush(stdout);") +(clines "load(x);") +(clines "}") + +#. +(let ((files *files*)) + (declare (special object-path)) + (with-open-file (st "maxobjs" :direction :output) + `(progn + (clines "object user_init() {") + (clines "load1(\"../xgcl-2/sysdef.lisp\");") + ,@(sloop::sloop for x in files + for f = (substitute #\_ #\- x) + for ff = (namestring (merge-pathnames (make-pathname :type "o") (pathname (format nil "~a.lsp" x)))) + do (princ ff st) (princ " " st) + collect + `(clines ,(Format nil "init_or_load(init_~a,\"~a\");" (string-downcase f) ff)) + finally (terpri st) + )) + + )) + +(clines "return Cnil;}") + +;; invoke this to initialize maxima. + +;; make this if you dont want the invocation done automatically. +;(defentry user::user-init () "user_init") + + + + diff --git a/xgcl-2/gcl_tohtml.lsp b/xgcl-2/gcl_tohtml.lsp new file mode 100644 index 0000000..48ae538 --- /dev/null +++ b/xgcl-2/gcl_tohtml.lsp @@ -0,0 +1,502 @@ +; tohtml.lsp Gordon S. Novak Jr. ; 13 Jan 06 + +; Translate LaTex file to HTML web pages + +; Make table of contents for LaTex files of slides + +; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. + +; 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 of the License, 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, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; 21 Aug 00; 07 Sep 00; 11 Sep 00; 07 Dec 00; 24 Jul 02; 25 Jul 02; 29 Jul 02 +; 12 Feb 03; 28 Aug 03; 29 Aug 03; 15 Jan 04; 11 May 04; 29 Aug 05 + +; This program converts a LaTeX file into one or more HTML files. +; The HTML file may need some minor hand editing. + +; The program produces a new file in response to \pagebreak +; and puts in links to other pages. + +; I have used it to put class lecture slides on the web; +; see http://www.cs.utexas.edu/users/novak/cs375contents.html +; See the README for notes on how this is all created. +; See also the file index.lsp for making indexes. + +; To use: +; Start Lisp: e.g. /p/bin/gcl +; (load "tohtml.lsp") + +; To translate LaTeX to HTML web pages: +; (tohtml "myfile.tex" "myprefix" ) +; where "myfile.tex" = LaTeX file +; "myprefix" = file name prefix for HTML files +; = number of first page if not 1 +; \setcounter{page} will override this + +; To make contents: +; The contents program looks for header lines, which +; in my files look something like: +; \begin{center} {\bf Lexical Analysis} \end{center} + +; (makecont "myfile.tex" ) +; where "myfile.tex" = LaTeX file +; = number of first page if not 1 +; = t for html output, nil for LaTeX output + + +; 22 Aug 97; 28 Apr 00; 07 Aug 00; 08 Aug 00; 17 Aug 00; 18 Aug 00; 07 Dec 00 +; 24 Jul 02; 26 Aug 03; 28 Aug 03; 11 Jan 05 +; Make a contents list for a file of LaTex slides +; n is first page number: required if first page is not 1. +; html is prefix string to make html contents +(in-package 'xlib) + +(defvar *line*) +(defvar *ptr*) +(defvar *lng*) + +(defun makecont (filenm &optional (n 1) html) + (let (line ptr lng done depth pagebr lastbr doit (first t)) + (with-open-file (infile filenm :direction :input + :if-does-not-exist nil) + (while (not (or (null infile) + (eq (setq line (read-line infile nil 'zzeofvalue)) + 'zzeofvalue) )) + (setq lng (length line)) + (setq lastbr pagebr) + (setq pagebr + (and (>= lng 10) + (string= line "\\pagebreak" :end1 10))) + (if (and pagebr (not first)) (incf n)) + (when (and (> lng 18) + (string= line "\\setcounter{page}{" :end1 18)) + (setq *line* line) + (setq *lng* lng) + (setq *ptr* 18) + (setq n (parse-int))) + (when (and (> lng 20) + (string= line "\\addtocounter{page}{" :end1 20)) + (setq *line* line) + (setq *lng* lng) + (setq *ptr* 20) + (setq n (+ n (parse-int))) ) + (setq doit nil) + (if (and (> lng 30) + (or (string= line "\\begin{center} {\\bf " :end1 20) + (string= line "\\begin{center} {\\bf " :end1 21))) + (progn (setq doit t) (setq ptr 20)) ) + (if (and (> lng 6) lastbr + (string= line "{\\bf " :end1 5)) + (progn (setq doit t) (setq ptr 5)) ) + (when doit + (setq first nil) + (if html + (format t "~D. " html n n)) + (setq lng (length line)) + (setq done nil) + (setq depth 0) + (if (char= (char line ptr) #\Space) (incf ptr)) + (while (and (< ptr lng) (not done)) + (if (char= (char line ptr) #\\) + (if (string= line "\\index" :start1 ptr :end1 (min lng (+ ptr 6))) + (progn (while (and (< ptr lng) + (not (char= (char line ptr) #\}))) + (incf ptr)) + (incf ptr)))) + (if (char= (char line ptr) #\{) + (progn (incf depth) (princ (char line ptr))) + (if (char= (char line ptr) #\}) + (if (> depth 0) + (progn (decf depth) (princ (char line ptr))) + (setq done t)) + (princ (char line ptr))) ) + (incf ptr)) + (if html + (format t "

    ~%") + (format t "~60T& ~D \\\\~%" n)) ) ) ) )) + +(defvar *prefix* "") +(defvar *feof* nil) +(defvar *done* nil) +(defvar *pagenumber* 0) +(defvar *firstpage* 1) +(defvar *lastpage* 999) +(defvar *center* nil) +(defvar *modestack* nil) +(defvar *verbatim* nil) +(defvar *ignore* t) +(defvar *specials* nil) +; ¬in &there4 &nsub © ° +(setq *specials* '(("pm" "±") ("cdot" "·") ("cap" "&cap") + ("cup" "&cup") ("vee" "&or") ("wedge" "&and") ("leq" "&le") ("geq" "&ge") + ("subset" "&sub") ("subseteq" "&sube") ("supset" "&sup") + ("supseteq" "&supe") ("in" "&isin") ("perp" "&perp") ("cong" "&cong") + ("sim" "&tilde") ("neq" "&ne") ("mid" "|") ("leftarrow" "&larr") + ("rightarrow" "&rarr") ("leftrightarrow" "&harr") ("Leftarrow" "&lArr") + ("Rightarrow" "&rArr") ("Leftrightarrow" "&hArr") ("uparrow" "&uarr") + ("downarrow" "&darr") ("surd" "&radic ") ("emptyset" "&empty") + ("forall" "&forall") ("exists" "&exist") ("neg" "¬") ("Box" "□") + ("models" "⊨") ("vdash" "⊢") + ("filledBox" "■") ("sum" "&sum") ("prod" "&prod") ("int" "&int") + ("infty" "&infin") ("times" "X") ("sqrt" "&radic ") ("ll" "< < ") + ("alpha" "&alpha") ("beta" "&beta") ("gamma" "&gamma") ("delta" "&delta") + ("epsilon" "&epsilon") ("zeta" "&zeta") ("eta" "&eta") ("theta" "&theta") + ("iota" "&iota") ("kappa" "&kappa") ("lambda" "&lambda") ("mu" "&mu") + ("nu" "&nu") ("xi" "&xi") ("pi" "&pi") ("rho" "&rho") ("sigma" "&sigma") + ("tau" "&tau") ("upsilon" "&upsilon") ("phi" "&phi") ("chi" "&chi") + ("psi" "&psi") ("omega" "&omega") + ("Alpha" "&Alpha") ("Beta" "&Beta") ("Gamma" "&Gamma") ("Delta" "&Delta") + ("Epsilon" "&Epsilon") ("Zeta" "&Zeta") ("Eta" "&Eta") ("Theta" "&Theta") + ("Iota" "&Iota") ("Kappa" "&Kappa") ("Lambda" "&Lambda") ("Mu" "&Mu") + ("Nu" "&Nu") ("Xi" "&Xi") ("Pi" "&Pi") ("Rho" "&Rho") ("Sigma" "&Sigma") + ("Tau" "&Tau") ("Upsilon" "&Upsilon") ("Phi" "&Phi") ("Chi" "&Chi") + ("Psi" "&Psi") ("Omega" "&Omega") ("vert" "|") +) ) + +; 28 Apr 00; 07 Aug 00 +; Translate a file of LaTex slides to HTML +; prefix is a prefix string for output files +; pagenumber is first page number. +(defun tohtml (filenm prefix &optional (pagenumber 1)) + (let (c) + (setq *pagenumber* pagenumber) + (setq *prefix* (stringify prefix)) + (setq *feof* nil) + (setq *ignore* t) + (setq *center* nil) + (setq *modestack* nil) + (setq *verbatim* nil) + (with-open-file (infile filenm :direction :input :if-does-not-exist nil) + ; skip initial stuff + (while (and *ignore* + (not (or (null infile) + (eq (setq *line* (read-line infile nil 'zzeofvalue)) + 'zzeofvalue) ))) + (setq *lng* (length *line*)) + (setq *ptr* 0) + (while (< *ptr* *lng*) + (setq c (char *line* *ptr*)) + (incf *ptr*) + (if (and (char= c #\%) (not *verbatim*)) + (flushline) + (if (char= c #\\) + (if (alpha-char-p (safe-char)) + (docommand nil) ) ) ) ) ) + (while (not *feof*) (dohtml infile)) ) )) + +; 08 Aug 00; 18 Aug 00; 21 Aug 00; 07 Sep 00; 24 Jul 02; 25 Jul 02; 13 Jan 06 +; Process input to produce one .html file +(defvar c) +(defun dohtml (infile) + (let (c) + (setq *done* nil) + (with-open-file (outfile (concatenate 'string *prefix* + (stringify *pagenumber*) ".html") + :direction :output :if-exists :supersede) + (princ " " outfile) + (princ *prefix* outfile) + (princ " p. " outfile) + (princ (stringify *pagenumber*) outfile) + (princ " " outfile) + (terpri outfile) + (princ "" outfile) (terpri outfile) + (terpri outfile) + (while (not (or *done* *feof* + (setq *feof* + (eq (setq *line* (read-line infile nil 'zzeofvalue)) + 'zzeofvalue)))) + (doline outfile) + (terpri outfile) ) + ; *pagenumber* is too large by 1 at this point... + (if *feof* (incf *pagenumber*)) + (format outfile + "Contents   ~%" + *prefix*) + (if (>= *pagenumber* (+ *firstpage* 11)) + (format outfile "Page-10   ~%" + *prefix* (- *pagenumber* 11))) + (if (>= *pagenumber* (+ *firstpage* 2)) + (format outfile "Prev   ~%" + *prefix* (- *pagenumber* 2))) + (if (<= *pagenumber* *lastpage*) + (format outfile "Next   ~%" + *prefix* *pagenumber*)) + (if (<= *pagenumber* (- *lastpage* 9)) + (format outfile "Page+10   ~%" + *prefix* (+ *pagenumber* 9))) + (format outfile + "Index   ~%" *prefix*) + (princ "" outfile) (terpri outfile) + ) + )) + +; 13 Jan 06 +; process *line* +(defun doline (outfile) + (let () + (setq *lng* (length *line*)) + (setq *ptr* 0) + (if (and (= *lng* 0) (not *verbatim*)) + (princ "

    " outfile)) + (while (< *ptr* *lng*) + (setq c (char *line* *ptr*)) + (incf *ptr*) + (if (and (char= c #\%) (not *verbatim*)) + (flushline) + (if (char= c #\\) + (if (alpha-char-p (setq c (safe-char))) + (docommand outfile) + (if (char= c #\\) + (progn (termline outfile) (incf *ptr*)) + (if (char= c #\/) + (progn (princ " " outfile) (incf *ptr*)) + (if (char= c #\[) + (progn (pushfont '$ outfile) (incf *ptr*)) + (if (char= c #\]) + (progn (popenv outfile) (incf *ptr*)) + (progn (if *verbatim* (princ #\\ outfile)) + (princ c outfile) (incf *ptr*))))))) + (if (char= c #\&) + (princ "" outfile) + (if (char= c #\{) + (if *verbatim* + (princ #\{ outfile) + (pushenv nil)) + (if (char= c #\}) + (if *verbatim* + (princ #\} outfile) + (popenv outfile)) + (if (and (char= c #\$) (not *verbatim*)) + (if (eq (car *modestack*) '$) + (popenv outfile) + (pushfont '$ outfile)) + (if (and (or (char= c #\^) (char= c #\_)) + (eq (car *modestack*) '$)) + (progn + (pushfont (if (char= c #\^) 'sup 'sub) outfile) + (searchfor #\{)) + (princ (if (char= c #\>) "> " + (if (char= c #\<) "< " + c)) + outfile))))))))) )) + +; 24 Jul 02; 25 Jul 02; 29 Jul 02; 12 Feb 03; 28 Aug 03 +(defun docommand (outfile) + (let (wordstring word subword termch done tmp c pair (saveptr (1- *ptr*))) + (setq wordstring (car (parse-word nil))) + (setq word (intern (string-upcase wordstring))) + (case word + ((documentstyle pagestyle setlength hyphenpenalty sloppy + large) + (flushline)) + (setcounter (searchfor #\{) + (setq subword (intern (car (parse-word t)))) + (when (eq subword 'page) + (searchfor #\{) + (setq *pagenumber* (1- (parse-int))) ; assumes pagebreak + (flushline)) ) + (addtocounter (searchfor #\{) + (setq subword (intern (car (parse-word t)))) + (when (eq subword 'page) + (searchfor #\{) + (setq *pagenumber* (+ *pagenumber* (parse-int))) + (flushline)) ) + (includegraphics (searchfor #\{) (searchforalpha) + (setq done nil) + (while (not done) + (setq tmp (parse-word nil)) + (if (char= (cadr tmp) #\}) + (setq done t) + (if (char= (cadr tmp) #\.) + (progn (setq done t) + (princ "" outfile) + (terpri outfile) + (flushline) ) + (incf *ptr*))))) + (begin (searchfor #\{) + (setq subword (intern (car (parse-word t)))) + (searchfor #\}) + ; (format t "subword = ~s~%" subword) + (case subword + (document (setq *ignore* nil)) + (center (pushenv 'center)) + (itemize (princ "

      " outfile) (terpri outfile)) + (enumerate (princ "
        " outfile) (terpri outfile)) + (verbatim (princ "
        " outfile) (terpri outfile)
+		    (setq *verbatim* t))
+	  (tabular (dotabular outfile))
+	  ((quotation abstract quote)
+	    (princ "
        " outfile) (terpri outfile))
+	  ))
+      (end (searchfor #\{)
+	(setq subword (intern (car (parse-word t))))
+	(searchfor #\})
+	(case subword
+	  (document (setq *feof* t))
+	  (center (popenv outfile))
+	  (itemize (princ "
    " outfile) (terpri outfile)) + (enumerate (princ "
    +

    +Next: , Previous: , Up: Numbers Dictionary  

    +

    rFXk=2T}I?0mp9M7=bWFwJGe_#c2inp#7I-E$BLIghpuCQyKDipma!1B z?@AzwU8b`Tf4UpA*73J;6nOYNY4|qorhlL|{_jiq^2jn7w}hZ$N?u}xmL*^_tQdu! zdSyMuFtjw6hY~K-{+Z0kl>JzjP(C@BN^=vuD)|z3b^T$QK-OpO85GK=SUk)?YiX0x z$_CM%Wn^w%K5x4B4$}n*%5lq$jSV8Iu1-B63w@pp9euEa*L5-?# zJpT&HB@-F%SB;NDsqlXZp-5M4%cxeM1D^OqzD zk6YE_?~^;Lj{^BK-Vg|e6;VcX9m%3*_H|*L>TaDk0xZPlV-d4gw34m_qj`+IDS^yT zWj5D%I>K2#*YstCx{{8)4^`nK=1rSG9%rZM&6VQ7 zlL2lBr*QRu^2#UOU@>XV}xZhq&Vfy0J0^ z@_S=Pro3=dpUwZex!HmlX&f9xGxK`u4Go@OEJWerRB5lP?84sxukr7C z=xXne$v#B9N=H;0tn<(=IThyyE>*fz44wABdXC4{oj&swl07Zf`NPj1byAu2h!A*# zDoEyn2vqTor3C(~{Mzv9JwO52CNi6qxUUaC5WoBhDZx2fjGQ(q8QSzW4MZXF35J3jfsNykC@I2x2iY{ zfT27xshk@*AqQPkJIdfQH!9^o(k|Zh;IUG2Q&^NqhpDjSq}Z6cb7tf96GHudTf+FY zm&zYZCIZAvJ{LooM?8ht-cPX5uvM#9Y14bYf!Dl!F(de>&WtC_>+Teo8km09`r^ck z?nX(V$?3)VaHQw}Bc{H7xO}|Cl!;Bd3b_WRkaS5uy{$muD6#S}29(=eR#Egrw-x;5 zHP>B&wIzF8%vDa_H_9<|8F~s?-~+P}*r9qa76`X0DXNM_ioe8hkn--8T{-N2MMmTl zvmmnswg;FpRi%^Gg|Wu6=JyFmgkSMw3jh|7Ylm1Plbyq8H!{#GdCT$<<`XW%-}fR} z8eRw@(cU&0+jVT$l|`*Ah79y)4ruR>7cCCfFDv`KB#q=sTVP)cj9nJfi#!~2eVjl3 zo1{g35zAX=;p|lsvNMnl>AB+laK?`uIsg8S{J(YrfX8t}g#K3%@Sm|38Ckjh`(?WJ z|KUc?C#2F??};a7C*1*6J=CdHog4gyqShm!#I2;Q%|{0L_N;XXhdnm;MN0jy`8 zSOm&MqD2DyCCXFB1`3Fk)W3gNKfJtOPwpLfCRNoVK~~2+L`&@)s8ush=5wd0X);?v z0vz-W@H^zg8^^@Fm~+nD&nY$!7}sk}nF(+%GvkLj8A2$q*@|)W%J9PLaPU2odRo37 zCAz;j1fuVB-{{S_m(bgdKNsY*@boTb@(++P;%SLB$6B3T_*aL&ovq(D_Mweo)p=>6 z7v;)B_)B7gV74aNRh=`lHvi6sTvZniPLI&XcV&HnQK(LF?j{C?Ph>Pz=V!e|)?bv! zzYIgG-7i0rX0ANO()8wCr=0$g@01gPsm-<$XtNN|Asr6#?=B1|qtgE%_G(&Wt8mEe zF=gT_RZr~?89FH7t?wDy!fx4_tG|%pAy_JOP-fxZqKT}XQ%yaoTCXrTrMB{ZTxLV% z`?VH@Dt}#1?#4~;H3oa)Is?F#7wD1JkB_ryeH4xRg9t<0++83oByfFfs!WsV49?6% zvBayNmGRFaxR7P+)mRfTnk+Esu09iZfcQO)n5MT&heAbQre%89RZryzj}qK}o?9!T zxmh$GHVCJd4q0wRi}kf+aA}hS(Jl^KEMa_D+Ht2(D0UD-81DOKd~7BzU`5WmP`m;= zw?m3%WuLY_%a<$-v)I)bsy1iNEeUSgkOdz{WvM|7`xl#%Tu3R^>CTDc#mh?p2CFVQ zKBZ!DfkJ8L8ioDs0sLkkqGP?^O?FnEAkXo8*c9P6`16x!gOsFXVw_|o^3wYFHpYJL$^o|S$$>_)OdduldGN*7ETZzjV+@#$(on$eu$ZH(|pbzw3f6_gtO6V5^@r%ZA?#ew;ga#{eyOvzJfx>!o1iY ztpT==%Fvq*0DdtuJMKn71kdHN*qGOSxGPLHt42(5Sfe}Y_QP~;GCqX>= z%HlD&GDGazqB7@=Cd&~fDQXzm^XY3(&=`kZpm~C4h}?PM0n_=nOQWvG>K=4%g{tyX zPIP!kP#&tlmC^KTfRn8})z#SIS%CtpSsZ^R-i*0JzGwXNHB?edW$L0S^vA&FaH=!UAtA<$BZ|%U#e8a)|WA< z1mvp|E+sKvg04Q7c~K04(`A)o1fuDNBR-L{*Y$DPj9b1-zwxw9aJiimrpTMxpD0_P zMeWM&aFx+<@?tf-aOb}q0r4>nAdY&K9`BK0;wt}+y_jW=!Rp`A(#=J{@>@zkix|lQ zR`7Yd3s+Z84|uo=VcTUX5Ay0T-bvife2a}tzu@XcwYkl^>xl%3Q` zYW5BUFPauo)UL;FUqTbIo)sUKV+SY{o|V}hho@<2r}ReXfIPiPW)GU?6i!`vUE&(0EFfVUE)(V>`q-|{k-Urj62Kj03dpQDdCBkK|Im}&Sk=iws zZNBMf%>yuVF?1?vNg7{4d%b7ISwY9y^QQ2>odqT)M>51HFNZM4Cu%u%6L#UnAz&2O z*$ggSav>ZK>D1G$y1SRdLpi%8ckHCiymuU9zD=MzcB*^Wgj(l1ZvPtSrkKFQLqj~! zUo^tVsAwT)T5u+$k;5D7p-g@1GzZkx*%w-9s*u(OV`bE;nh$-Fo({D+Th-OZ zkt3&Tbk6~hRfRpcTYNXpBg$eo)#j*tvm$VsG!s`CH-GP0WnH*)i86UwKAz^|ReA;{ zNJ*`n4;CvSvLz%TUEe=}f)&}2JlvQb$Ro^fnVs+t7t9~$wzqI(3m?Rp*;Q+>D2NIB znCr+eHlyHW#y3vf0GC|acF@&jl&reuSvClLjF;{R49|goiL1~c#k~4k6KVR1@Ub8u zJB`G5o$J)UE%#_*MrjH!dYZtFdS-^9XK;<~Qz5qe_w=lbtToILK~1sZzTOxnb*ZUk zHvfXM%iQ80LT4b7-9oe4qFR;l6o#ug=Vo;FCBA;YDsJW=xthh4;bvIv$bU?;YH^HP zEVCmB=xy4|>#TJLLjgL1pnNTI0e%B-sb7kM#F$sKwSgJOokL7hNX&hd&@IhFhqKmA z6Awcn7C7*~u-5z=^ZOnnNaTPIl&nvrest4a%pUw`_dIoTU(yj-|JvpiQ<#gTTB&{K zQG9O(4YxLF4g_rll`y4OFMkn)c!*ihmUo*q&hrygcBytH@HbWD#2DFllkKw`SkC=} z2)vHR$X*MeV_0I2xw+g~nStxzHaK zb?ykW7IU^++4d)}Dc^XjTFs8^jEd2T94{5=AtIP{ zQ@?jpe{hEnM6p(*s^c(3mwo&>&4pK-4-9M~7ZDkGb*EFycW_HQ52ru`!nwMDA z6cB=(FwuXai_%X^fam6v*Q zu6qCdK#A(B*Bi=r-V8!Bl%h;WWp*IbBCGT+A|$4sNjv@bY)vQd0nS6^)Gx zcA`Gj?IrKNl9zR!J4_UCZVay%wRn>WQLb}a1 z$&sBfq$fSV7#NR=KbCG7=mr*MT`=P(L$y)2O3;&%FXbkLYJggO%%;`l$h5t70dSyg zv2V-=Cx7x=gRnXFhW$OazdjIuK+hEC>i<{4@SpJsnVJ4aJ=cE;hOLhOs^_YpjyNfy zr3F3|J3A)ruADWYsg#w^#I=mV{%2){q1xd2;r{}nR0iGLtW42klS2Z-jvHGu;AnZj zm9BGsrO=Qc{PAt&s`G#8cz^b3{oP6Vs9cBdL35$egjD)mJ$~KaRP==S)Y0ed-W{T36L$W zD`gQLYOv9RVPJ#z-{k=9{d)FcQIkCp)@nuZqOaU5uX3nLh~R$8r4v3Yy7O+u=NV44 zDSZTxR4(W#+LfBQ-*ogIj*GD5XkEI09`@9$OilElaWm9!;$A)W`7knXAxMRlI69Xp z`rzf09|J3P)Af7ZbWcn1*0e5f90g-Y!|J_uw+7ZW2%jLp89-UpW$j}m?MNBZ>_Zd@ z({I_*^9dMytkSxEwISR(Ru{VTTID%cUeUGtkL>shY024Y&9JMd4QXTgUhyGj&f{ZD z>2)o2UT6=}m&6v=52lAwt%v!qlhu-mSsk+e^r}Ltw;1Hl8?U_SzSvpoGl&_Pz9QI_ zs6itnJ1c>!w-%n=Ie$iidPE!>=THt14Ha16KShpp!5v(XY_a&(mK)%ZObLh82P9+f zLD?PN?TaGJ{1C}9yRqsWZ!~f{I3D`R**spfN?o9q9q|RuqAy-%>iCUTH27bQ|2;CI z@#BOely&_y-!F4y6}nvP&bBeKebXL)@@fHcy6h^4#tE_Xbxp^Hl!Y(pnJC`t;lOD@cxjoJse(b~E8+BS(^Tc>?+ujRMh&TZjEdSt`UOJx zXXm2RgR3q=E*8|Dnl+S4L|4dVi}z}i67b6400z~4<9M!k@~0vC#c@-*{g)BYT1(7n zMM61CQH6#t(jxt}8sG=vta;o0-1%wR5+hqFG>jg0z#>jDtOxTo zXTl7i3(rF4>Rz#Bu{zW6D9;Ah0+hvndzH3zNv%mzxUMZlmXcSzB-&r%y|33PYaAF; z#hGl^)mI)`I!;F8v)kdq)o&g z3v!#c13@Q&?;4JYLsy<;0HuXNKCN#ka2Q}?xWPBK7up8`7Sp;~Snxf@_A_+r9=K`W zf~Z{m^=^;*M}BTc0}ru=qX-Cub66^#^2`Eo-F>bi7^0`1D<5GlB1(|=MW^r_v?(%Q z3%RM7Qhiosl{v*AZUXMxKzW^hr0Pu7hvW}8kpWC+O2cnITse-6B@WDQ`NVBU7TNTU zZMq@;FUmE+RyKaFcsqCH(teYD#&@RD5D^A zK^}eRoc_SAeg*5IP1f^l(4@Mk2=PhQrDBlJ;8YKkM)a2Lq9p1(a?5N^k0fs49}0f} zW!pu9hfxnjRdIIgxP%-e&P~kkOv|v8_~ea0>7|!J_$tr8)OO9e44~(W-F*c0ei<-c zS);|Rwu{TYzD|L%lJU**4)%in5IcdDj;Rts5pA0*S|OHnE{C^I0xF6u5}e z+SU*mI_x1A+lq=sAp0jib?_WZl=}|?e;vfoh$)HY85J2%A#@bhLXSy8vO>4PuXJL$ zGia<-q(-CZ(n2-O314S}fLSK)Dm;+zphaPU#t!emFnpm0zq8i9%+<JISPA-%$R#&u#n2H@5x zr4fw^LyKUvB0Y<=b48mZ5IvnAu7W6T&lhPjgVr!`;l8dd!0oy5_+tsr#%UN0|1#9g z^ONlIqY8q!({D4lM>gr1|BbBRA`-CsX{arX=|5^tBgI>HJs?z zl&29ngz=JwZ0xon6kj~Ob;(>I6NXbHOxR?GJ1oxhul>m@9`}jP2t!iGzJ3@gQkN9a zAsiI)7zYim!!x@NxN;&Hr;Z-&u|Qxj0Z41YDYGXlNc%J1mP79A>}zcOJszmJ>bw1Y z(KBOIHY6v6|D0LKq^YTln}PLO&l1XE4=2ayVYqH$iQT~krUy$DxB?dnrtLoz{(i#3 zF618?N3Kf*$NO1BJ${Qx(}7YUkp#5mItGg+F%of!Yn2`(nY-l`EUbj5X*7|#e_L4( zED0ovjv7%T@zO6kYd3Hb~Z;i|2My>f=xOjBY; zLJ42gi%nFcN`t2cFIbGO^%X`o<)mnN6%GtSz?c!1uvJIUZ*&lk9qSC_YC_o!3c4!q z4HLsUtYG;QMG*!gP7i?dtnUlc+>p@cWz5jewe!sHf}d`*CzrnHFDOP`C`y3Uu!d0H z@0fep@?L+MwQ`IAoIFxYhzpRq2eo$8^sNg z)}3ZqdN_8mPzM3G?E(3llh$M!Yz@L*NIZsbEWvy}!r@=NMCAj(!S7{TW1Ixf5-_KF zrP3^~Skq@SZgbJ9F$3b1fXLX%;LIvGHRXA7JdXM;TJaOyGHu%b4Y7WO%!HpG?qZ-Z z&KQ~vNk)|u-95Qi!=dMMBY{Y757JwDY;owIU>kFtb!WMz3+wn;>0AJHM1~*mI}7A| zmrb6ZkC%@$2ybKOX>(cVjJYqP1AK(sWThl_?#9Ta2#iHh=+>pdMPS@E zbjoM-{(HYV>Bfje({2e4DqWd}x0P4$jT=alR!WQ_tZv1V_>D_$#G+3R3_(ls;fpxm z0&?<0WoGa=w@?IHV0TRE_)ocq>|I0cz0I7C;6G5~NG2QW$Q9T;4W%2jK&qz9{&&X1 z9L&af)vHVhC;d=O>^b#)R*CfmqY;JipU3vK$lQ{t6Thpm>DK$-$dm0a8;Eup#W=z7 z+13>i98TrB_%1WP-qr8Ow5G|Q3{t<;QvUD*- zs50S>yUo99yD`FFN_)1v&_g*1tS5Bc!;(#`{h&8hz@0*s z9<)9Npt$SYR!sx{p0H&Ip4rtqJ<$^eDC#{>>#ICjjRpt6N&PsR043$Htg-6DIe4MW$o+pu5hEtSJc z+oaMI&hUmOXdU1x(bn;EeHKb5%pH&Fk%Xus9W$bG^p${sfA?w?0?U%vgVc|;YxYlhP>|6{~fud%ntsLlm-5!5PxMTtx(_x5yKV0ikm&*G0 z_RFXxeXik`-`@z_emf`1nuSps+WSgaUVEz~on?mJs9x3>FY>YC_0YtOAczPUHp^xu zb&Z`Cveec#cc+}BO8awnTJ?P?0gjKv#$3H79&$Rd_MS!HQ5NTS)J^lC_3;Z#;2f*m34&vJ8Tdu&3$o}9*yE>tGLK2 z%reR|4gN~b{5^F=6Qf}85IdNWa#3>}hVv$8%dBQD^mvPJXG@Q8Hc2CJdTl5$H*0ux zt}CXlx|jf9P+1ywn*2?6bV7e(27=?0&tfG3IGJ23&c$Egc8ttCZ*Dbzn(b>|<{a+8 zH?R1e^^cq{KtpU2=h(AT_`Q*d2i8-(78q%iLOyC-Fso3VK2i~G${B>Q^@(c)2$aYXs=}`hFnN;sKC*J!jw^25usc zK^oi)v8Tq`Kb9M$!Kv-pEtLgrvg|GHXYP`g64~Q9Hur_Xa^oYo?>-%LKG#_d#u={o zWgpxZ9>Z@1IXgXt%wOJrq4Z}L*zQW}8u8f41=gB<*fak;`Ca<;+X3HP_@$7!Wlwlm z!>66gcNS=r%3nf=X~rJP_MUEgATB?p6`_J;`s3nQ9IUfF)xx84=esmNU3sn#IbKFQ z+E-Cu02bnlvGOYOY3*p5k~4Hi@s)rHvTg>o@Cu;p(LnI9N}sN5kALffy$OS5=9~rz zCds7k2es@|!C$K_dJUbO@_rG^omrI8RUGHF2!-UC*uw#(PmVq-hB94(8f`x}++fa7 z4Q%H4BGC?#g*RI@>XF%jF2L17od~+UD-}dH*o6=omuNtvEO_FQ4m~by<5>xgICYpK z?T2FehnQYKBpiM~*W15@RFA70VPO&#vF+Xj^$ftcb?LdbCRVSs%&q=Q4W;rtA_;r_ zQi_4k$u=ZfkHH`oJ<#O}$Ju{Qg|gt-yf})>NM_)S8(g3LJWmhIofv_GhX_q7sAjRi zIaB}!mN~EO<**N@o++pouF*6E&qmf9wC6UroQH68-cwXa&FHef>&XQkOwRSK=pm+5 z@HrWDy*@vK*2f4*+xOZWj;8MgHkjdj_dnyfGek_CM=n5t(7UDT5fU`)GUr_q9K!Zg z|2P3q;2K9*>{HBT8YQ}D^*_mE_TTjPOi6PV)ORo->F36*fK3Yv7YKeyWl|h0;U;`x z1+Twa+FU~8(+jmLfa1bMUxzP3cCk>SZ}|kbZ36TASeK1wfWxj=PlP!5p-SWx1?v{A zZx#pzxyYfxNbMwq z@H|1T8vDccNAp{)8gn3ih_D6V^#Gd@$R3h=Y6NQ8IBY~%shr(v&$TZ69pxK?Sz}$I zugGW%u!1aJ;m<;S9V&6o$IAkylUM7&BQ+1qj(3`p{xBzx!%2>T13_|Gm7 zdAeQ$m8j?>PH~rYZ-nP<2wk$p1<@_IskD)`9yNcNRzw6%Hw^^70~ZdTwt~J$gMtCc^N2$LQ zGB7cKKX%6A|438i6yr)Gdk+Khi|Y^d zWc%soSG~Z`=M}?+LBRX9!-YV=#{mJ;WXnt_Of`}%fj~w?g=o=4$1zSB_{Cm+FT987 zC4ADGUtq+yKb_mW7RW*vnsNs&ibN+eylHi1B_hB#~eV=%B z1%ccQNw1ZIo)I+cdY6B}JDVq7cz5wUe+Ey=pz3%FYPL_ImYL>cYKP-kRF*@CQYxI! zhC0sbp$#T$CWdtq#xQ|n{}2LsWUWT*s)-}Fbf&xODt{B3puYqqQ`h_uZw9Si^P9ZV z)!*ZYb4A@juZFkPFSPGsp6bfme!?UZc#~cRX>t11s5-VUX8%IH{qxOFJzPljW_P9L_sh z=1#d2#|a1+cAXyCFVhx$M)vqnF~u5h>knCgQP0j8%n zpfNIhR?yT0Ia&wPE)ba8P^sbtANOJxX!wg;B6GfVLk5wGSi)GVJQxk65YUSM8q|rCzORU-ItCT zQ53a~LzbniVzHE{K4&Cpt}_=~@OgP{(maN301~4%PE8Q%DNFf5`gKa`!i1Q8^E5<+ zLZE;v?Cd7Cpf!R${^ei%)=r{phX@|CA=?_0pXxScCG9b?T1K!o1Z0=OVfK#EWHl(= zN0%<$;e`I_j9%7<*=+8mRmx%3z%fIhV*g7|RVMTBB-j#f5*C{Go|i=tl57rxcIkG) zl_-2DeG^}&IZY?&31Pt)cqvl#gQm61gDPmtBa)!hy$vy(z^$HFXR#A5nG2mbiCQE> z@f$LSqOJ;)_l_YkDZgs& z)y{~%SI*Hn^=ox`pwi0w&I#4pNar=RPp>{BsWUh8sTM6ioZ5C4-nS=$;C#br+A+0k zd3z%$%Z_PgRGS@dh>Ut0{RTORZWfgnCUy&m)H*wb9<3Zd>uQa?dl$GzW7M=7b;J7Y zDMJ3#4iE?99tLS-Q>5$rS*aocS9OAWz85$jBgWfHgKVB^jf=r+R^7U^cgHWqF#uf;pd(4!?dS0kXObbAz<{blQ# z?`)l)JTKkujv4H#eqt6+p$Rt;?tC9BP^vShuWE$hY;=|=RcHj2hu5$W{$=I~A^04~@zB_B>Tf6^(jEUVl9B#*>NvAPs0f5Tw@fi0rD zb4g@AZ>KZ^1i?%-cBPf(bRd1g*XSfW9~wl&z$3W*$XJK_4qntNHbnp7I?-+5R%}&0mrCZxS3v(B{+SQy}7Y0q>+6X zCLVjn-=ceC5>MalM!AZE$+-zS(a)7A8Cd9gSK=k%F>ei92r=)y;O4`gx^p;qaknsw z^M(={ei9K#PTK*|8^uuZU^r+TCX_Veda;AWPUgihq%nxXr7$*S@bcXh;H-ZWF%an% zES*fnfH0qoJ1#U1EmaCiT{)~r8la^-?FmC7B}ZaR7L^_;XS|6!;kG$;dJt@ue*&S> z)=2AsA_Rq9K|x7JGfec5WTiYp z2_>WkCwWkD2;Mw);cN~|G>@5ucV@-IMDSF0iS(p|fy_rsYE_nCt0nv zIF8uQ?tyHJ)SCkqJ0)TO0mUnV_7N0@3&!9?O6IgI0Y9ywvjir|Kp`Psm90cZwh3$# zV_da`B|P~?Vn=;~SwMqWmw<}~r6nRi+#ileSLpxx$nJ~8IKA!f^Hp{`I0 zHLv$gTCR*CMg7h1@B8+UzxVytUccw>|Mrlsz!32B{?VTPr~muNz~IOC?S1Lw>XCs! z;Jd}*ZDqF=R)c1Z-?!c4diIOz^*2wpIc<0jtuIH!8H{eGvZrk}e z{-`^AFz$q)ttn!iSXwuNEeKU3M1y7RMwapQGK)|2Ry;bX`x(jadacUUt3Bx^6N`Kf zI>;mB5VVKq*JEtdIlFk>j<(sY`(^-QT0+$KpDrwYtL1S z$yRSw4&P#7?-tc99~xbnMacn-)6mpG+^>55N?wmibHzp8eArDknc(rbCq?}Z6LD_VDk>)y*|Xw@h3(R(U3uR!j~5JImWADBUbmno z?~gli@jWNs;iKrse1~`iVRB7=Z`|h7Czn~G(d4}BKQofk?Xn7r$NKssUfUUnr$3cv zE5np|j1;^<`IxDm_#USG-6>3|s(~0W2mn z8b4Q>b7FNO6o%zA&T$g0$pvM3n+RoXOLXY*rv;faSiBZaUH5#$lYcIU-m{8scSGt} zFdJ;r_=YWF$=7kr7GI8QI^(rmJ$bj6w&_OH%lB3&=SJ)`2QwSucaO&AHogBPe%?MO zi`McH@L&}DFpft4rmi5)3DkTySQfL>^VNB!`CK+$76u<3v(2ITSa`BH{ryM?@v@R@ zJaA1OE)*V%YPV5%TK}6>v>Am-ZPW4E;nAdlNlD(L!m&OQy9dm_Gq^Meb2}4KaH23) zPrpouKZ6SBp%CC{R3XVSyq&-KaW!gqpD@vk>I(C86Xv;=|8gDi+19D}Nl3_npGvuE zAFx?me?>E02yF=+ul~szbCHu{*@Mvw1zg%KHFDs~zhHLler#UEF-Qp1Rdm0TIz4y? zyoNq4bFUSlc2<^~S2qvfctpnFr)PfBZqIU?tcVn&3V*L7Z$wqIA!e83bKWuxy1XsD zMdX2Mx~emFF0;9b{|K=J07;RJl>Yydo{5?1KO?fUu>Fr|-m5L+ay0f|i{ZOtkm`~9 z9wtWwDjt2FtLS!W{Z8iwzd%XJP;eC8z?7PQo8dpOKwR_6Qq*Q^)||g)iU|w?c0xwW z!F3d06X=`~ewIeP+h0%J{}Hx*2Pvs62Qk`TV9haP6NR%zuTRrumAgK#pCiCAbB;R$ z+Z$i55DE4eG=w8-wjFejJ`e@E#|*Z1>UKnbza1oQLeS`|UyX+PF9th`XuvU5_$t*)1^-Mt@r zxvysV>Z1ge3{=I+Nnp zXP+xR<&F3oGh7QEYPea?D!=D-_lC&&)^H^&77ES4On?eq~0geI`*u=ZT1HKu*lSO)I);P_xH`z4^ zH7{PA8iaA9m^)n{+VGauhRe7Zddyt5iM{1oo%(Ay8<{HL0^S~A2C!!!2u((82B<%7EiDgTInb)qWZfRKkZ(<3s zjgbT>VSNNGC0ZMt2e?=( zXGvoF)`^3olV7#lLAJqW&|r1k5RBK!)`CaoppK0${|H>QgQ%k^Wl$o5SNX2D8$J=z zi?yPr|JK*Ft`R)9lTc7OTtq|q(6(Y4+#{sBa~m694DMyS{ss;^;RDOjIWa-3{1!Y? z5I09a!btfmz07)vqPh4hH#tW^v|7ylZ2Q183i6Y`?N!74#jgFzZ*7$u-&I{frnISv zD^=oyd;Gwjj4Mu+E3nnT+JHj}YCbfJu?%kdPYh^pGFr48z-oXG>AJO$nqn*?3HNs) zMwXDe`mMTf)P|spDtJiiQ1R-spwzr-pzz;?DU?_ZnADxQK&Vg-^tdx*5aTUy@ct81 zXWE4lw83)te30zsa{N@O`E{1<~Gp~FRf|IXd$NruH~PX&xk z`O7igCql=a=#BLF++|}(wEKs$VGDOd-$w)ArC}gVxbxAqg+h_nK-8Yvt`u{tfPzrF zvK-BzL85qmhGJOQs#6Q1;E>kyXD*9*ia;~1bq=o-DqwN0Tc>#O#59OLXK1f{(gEvQ zj9k|5t7O8(avIsobwomjWrfC>%S+tXr-up_g?meWTs7hUR zoX;JNSyOWw0%DEFrPi%!LFW|-ak+z&0+ffXs5_ct=L^3EI?TMZeCAUZFA<_F{z683szG!v9yy*U_)ejeF!g!_+@iua!rKDlu7Uu@=NkmC|V0th^?#KESRy8 zk>cOuV0&y`R-}Q?&7CkRgThndMX+q1eOvf44DpY6Embhf$;?g+bl?c|$rVz+8-)lF zl`Sv{Cl744Y~-`VO=_<^B$L*o)=*AJ%rz3mG}?%U*iiU%m;eqo&ZLSiMZ+NZv>lIY zdMQuJ5?F4{3CvPR9Y=f=r`+y|-zd+dm)+JB_!J0NTd zDVm{%{f)lAQ12g;#=%hASY6>jnf+M-E(pIWzLx^e5Q1}prl8~duDaX}S}C%1j-dbu z3VwBsz~7Dh+NvQ29)-Tj=ZQ3#f`-@q*_a&gC6wjnEdDo;9xH>=cr3quK0EpCRj9$K zfce2wL6A4wo>$~%+;<+K{e#>F61%+(4vEy!bLgSfz{!*$hvP)b$jKyGE4*(($`=dX zyqmFa&HdpS*?+$C^*A9i|6V|qL`F(kIp%Wpj-@~u=OYF;)`1H=qhmX4^un!9$C!q} zDUT=DG7Fh2-6GS<7?cGeJo!R{4We5V9L!l|^XTpuI)my-L3`(4l{wYoKa4hI_8=Z1 zMAY%QvX#+yuy8Nr^$8^BuBu{13FSm6ht>zQ%{|%CGU1`vDrDsQMhpT!1ZAqM%vEga_$gXxb z%}qF@&|sSU7XR;qZ^Z2kE2=i4#?W4p(gOXTs(dS{Vf8SxB!8L_>CDTS34lPi_EHQD zb~L8d5bj>w&Ljq;z8(qfZFNMZVfR7D3zxJ|So_}JDRN#u@&kNd4xW!jGRPl(rX40c zEuZaL?WgMC8p>caCX@^JLF4Sy>~*J88D{RzLH6$aG=4EHHEEobuP@^Tnjek7yXa;0 z)Vu1D7Kx6x9I441k}?AD`$ca%KxE_*Po&(;jY*7+G-K46c^ivFo{56_1~%8hFNn z{e%kM#N$2$Smwy(GQ$AN-E%ENO!3EdNo}%DJ~nq}szH@je~)f>X48iaQiY-&O&v72 zQPA_ElJ`5~=Ln%JI7R62HfU^%5z@t?aE2hf+)~$q1Y1Zt2p(h|@NIuN%z@lmbyh5uj9< zhJwR~5&87EOD_3f*m(Aj!3(T@m?jAqbwvM!8wbL4DO)3!%bNggB7-1O5ao6gCOCImWzm80J0e)NcYZij00q$Pes*P-jLJ zd^o4AyqZV;0PS$GjK^HtDRX{>7a%5K0j4Qzw#DB>VDEDg;85$ou_gff^uYi-xE&`k z=UG4WfBtBmEOUb7ey_qx6|)L%R&qBAZ9|=C{U9A&F)XxL&vMc!p0Mg|d1^TpjEdjw zmV-&TgGvmHM4$4n__}Czo^Z5C4aF%sH17Z8{FSkGm({7Kr#705mL_vfnQsI%d-jMEc)et+z@2p&`gzX!YDfi2hQyRq!!jF}f0 zPxq=5+OKQ2USptWG5*OP%g#^@J+thA&6>GoNn%((>j;G4KVs;M`0}un2YJ(1S{;VsY)nkcHow~6Y5|D z(JJ44`1(RJnG??cjBZsJ(I&JT-=~k2`Hb8n$ShUpnZA-=DJUCzJ>G!iIMgUM?PN&9 z(DnO8g6dowftv^p*XN$v=Q;rdgzhkC!}jXwP$a~_$%4?*2G@jq$~R{ScDfUxyH+z; zpV>GPKPeP^+v$)5GoL+`_x^|`o_B>j-%@w-1{b*~R>0z^g{=NkVjf-%$Y`64i%ei| zr9bNmysH{UN{<0W+!UR-&S|O3%{_=On5j)|nNv5494x26I4B22H#esJqZ_Ho+c?S_tv?;;>w`jYpeM#aGWph^k0uCv#B%gO~Br3%OpY zbTOcDlk2O11`(zd_uS)wUkeOldCU1X@0Uwf*i*-&UoZQzFGRO8db9fxFb{HGbzi1J z+9S(Lw4Y=5r=6;3fpzMU{2#{t`MDEdi~2@m+qRR5ZQHhO+qP}nw#~`J`NlRU z)}80xx>e7qI`3QOAL#z2YxVBldwmuY6FbNM?LW@b&~YebNBajM60BYhM(f40HKbrr ztJ#i_R#UUu;ZC~(U z3KaAr78oN+oFU;idQ|h~`fv(CCi_%8DEwr=_Qdxh4wFfJUSWlXBK^EX5S3Q_ATo>- zzh3^Wkzf?FN)C3g5+SLT7xBSM2AyV7GVt%e!{{X&C1lXm`?!muI~>tVJ|&1IsfCmF zk7u;w_E(!PAEAxZMmV}ykG6vJE0kNekRPW&c+lIBU6wR?wgoT>QlURWSY zIroXD(V;%NQ}aJyPDd{$c%l%?KzCbMt=~E=wSrQr*|_YRI@k_GJtoVud@EWBr%Y_t zc#iSFGH^_wxc^!$qsK4-*+N&7MIW@eljt~@Opur%sa)U!)G=}rtRlWzIpIL#iT2~Z z=T-~~uru~xG5C`X$K-`0oKtJs7P-I1xq?`r?y}xTrG_-rG#LH0BvJ+SFg3fIZwSz~ zxHL+t(F}e~g!}}Wn;-7DKJ}QCVoQs(9<4YCtS>$Kk_&aabHX^8*i=yFV8cbIIW#tm4rRF0G*lZ^RPejr)(mD8(oV zf1n(Vb|g!sOGTiK!vNuqBM)b(4}E>{&6Z}${z>Agc1|gv;poDm&zseuZ-Ytikk*Hu zX(?VW$|$CTfH4N*h*takNQ*&(&Bk1MN(!_dZ|n;#5Oa^>ZaDHjp#vI0G2~JhEJ^{C z4{CY3SwyCSD_g&C=esBq=!eDVsoaCvBM60kyWbuT-I)>=DX=}tQd6;P4i_f0!kWDk z=?>m>!-8qVgvWt(@M2QA!-QrY0|2r3iMXM0Xx=nld@A$Rp`OLfgxhyK4yzPJRxc(5 zI>xp*o_ysBIqCtxohvz1Tr%JKqJM10gg-HG&$P@gf%xm1Hpy0I{C@7urRr!+gp#uB z`L^Mohg(q0_fy(XTZmAa;F!XSfUMo^afu2js56cXcv;$TSZ_0=Xt)gsHLUfb%6h8l zVw`8Bh(tLsg}i}LU)xvC@mQT!N1tdm!|$P%^N}!<*2uEg0|iRv&)Xf2@^7udD;MgA zP%;st>w74crVS{;>yEa1D&*x%k|l!vhZ%PBQ{aXF$mk)L4$pHwgXnugk7i?vareH( z+p_ud5+~##yq(h|REplSQvUsA9{$?f*?Mq3p0P9td=h8H7)xZby3oS#`tJCeUd~Q| zh_|=bUY6k9gNfl z{j%aMyyyq;rlL<9)&Rx$l%x@^Z!x|)i=Nk{D=*fK%`xAabzvpg4&qH7+OZQCahG$d z^aBby@XrJ3AbCpw@Jh7jYAjwHPNnN6@Av4Y{)iI_ca2qH7 zZ?eYxKg|?!asG!%YDHbnVT&E9??nTN{~@v zal;mHDoCgiwyB}=ccerreZQ?w1Y^7rx{-_4Z||q)_YSp4CIm~JtcW#-A67&LucbS6 zft0-jZGzb~gIAi^$HFVz)%pXvGl=EWhP!3A%yPykA<0!n3DY~*?_wzF?%fFZOZVR7 z8pbFoMX=y)CgLoAIgsw_Oe*zvi$HiK2&MW!RT3&}$M0uDxM?qBTN`2?P-i4Jk+F~< zuh3~y@Gv?woW|(F9UL$k&juJqG^$lAPj`h6*3&xLg%r2aCCu4O)Lq^nt=zc->obd! z9)R=w_n!{I@+Ah~d|>I~+A z>M%l;B6+!`39tjSg(}y{?Bs9)Y3tnpUv)5_%`MgCB5cQ)@M2$-!K!h^#+%fbVVlbR zO!!TkzfdDo9;#ymYVertgVoZ}t@HioLrqW0WVXNDcuvLx(`u^$3KDR>Y`_v`9$R0d zh?~FJ!t1TZY_SXUSasctcpIB{R?RqNr!p;BMQFCpvvU^Ofni4yolI^s_@wuK!VK7oiBnjcQ?7J1J^6D{k+(c#glhv{nXsJsu05D7&(A z!k?gQUd5R{`88Ws>yRs51?5e#zp?kc2Hyz|R__uz#7C5sEm!*tCeMOJj%`U%kPKJ9 zgmyK==IO9n+EH`B82@JZ7GlW*r0tlv^{ULcdg6`rtrEuwP?EQJP zi7Sc)3xM|i7kh}V@|A#b`sV~|C*wOrUHK5K!j*C=9qgu&&K*KTSM)aeN{BvMb(=Bu2 z$Z62FX9EUgl3b~{th(V4kfghLU-CzMBq3ga5sY8=iDdQ|5H8qX8=>v(Q-CIvkTE&e zuRwAkIpbiGA#+Y{?+%MD&{JSj%dIl&Fd~sq{CDV)^ul*F>%zw}<_Lj@ShdS#23K7q zbK@Nx>{SS{%A}AN$)S;`i}6yJ+Tnbr0MhxuOvHCord_{HaOy*CUCsHP!)d2(6m*-% zd8?g)QC+!34>A-idop8Ex=MF^Ad^|9=IRdGMyTm119c#bh> zuuae<)%X+4<_pv`Ix;q-UdS{4o~3$KP<@^7Y-HK?>N0n?5M`c}|Hf~RC{8Eb;H#}a z%PTu3q>kyD1oo7WmzGSWSI!diSNY0r`lmaD?Dve=y?_VOgr(vN#t~LwUx8)~hr@18 zE+hVUc{0?ok znWkG@&T|efo>qqjp_IQ{XlfDn%aw9`#UzU*D_9XFM66u0LB&PqIQ|$@ z*Xm^(^w-gc8`uzr-U};F;LHS(6s(SYVHYyK!!O!`E zz;lg=N>*t3vE~pP4FgcKJ?P`Q(-j)Ovhrkd;rNhjmd}Y|VB<(zcA7W!HR8o;ub>&yKqv(ex7*ni^TzAFCw!9BhJlt6D;8SfdLkYy!OA!00$8xk%O@{3@`8h z%cux53+I14e73c>6aM+A{|`~UVi;DG_g-ffpzp&~dInDA4#+SiY;EtYSxv{2vTup_ zzR%l_klk3W5BbY3mIN-VwCwnrvkMn7LdVZ=M)EJ_vk3e1IA+EE{_y%B!oya`#n@Q{ zvm*!m7e*>7Y4q6j`=RpD!Ntw90_-^UV)n?|y3g1C$(PzVmqGg6CY%5FoyOX$NDrV5 zzJ2Ur!EL~!FTl2eS)EQJLT^QvsSmGqnQ%ubmoB2q>4I)H8CnE}=1Nz55JezdT)` zkoHrx54W?P|5%kZ?dQhe>F!K>#N-&~%LD*l-(}U4XXCbVDzg2CyprL}W?Qf&0#MaA zz`mSeBh5u8*j$Kk);Szi%h1k63dJzG+NqyGoCQ-8RR*s){g?kKaTQ-fX_9)-e>LbDx|Jlt}en!q_psq@rBxrMIUR}nNJ867}e{h zTw3c7QrTP>OJwko^XN+xUaoDAagvH=*zGyuN1q;b;#@Ma{tjtakop!Fx3EQM)W<{a z#c!^41wOYxH0jFYHW#T6f1R{G2Z&+wFp6wU0$7Q@`u`IJ>~b?T+75b*uLySvmpZ1A z1`FLp>_laJ0TShN>t$s??llG0IWyT|5j7Q6$bi}clwgd^Augbra2n03oWvOhIXadQ&H`au-d=Ao(ib5S%D8P8j4S$TF1sFoG;~by*B!R*c9i2 zFtqqtMqHWixJG%`l)^7cR00;#mwn3v%N3TTpEdKesbd(_iDs;}Uk%()P1v?wEXYacK+*(-vhWEe5#kw>k{qhc zKXm?EBOZ%1Tt(Ya`s?#I5O~lNAjEGr4<&Wu1p%L+1T2E0R7s2c~^B5*5hFhci}n{e21-yAUss z@!uTEm%XYnVkq_W{*?+^-K=u@=qe|VFitkif4RkPh0U!5E9bsSXrRtO19{^K#dnoF`HBsj5j^VNf~P2{px32RS7R@s zPVBVJwy(se4{J4t3$^yD9)HOyNo;cA&<1h1H#8?ntIT{7f99d~+$2P8bk@Xkx!w+Z zt)WxRqB9$N8;cDNH%}+WJpgS3mg`&2+WcVFh8N zE7GmVjMjH}WZPOap&{a z-*9>8ws;3>Ovf3<(*sb4{k&n% zZ`l!eNbhjE_We$i*ocTvi#_?tzPx$lBgmR zdM4`jU^!yHEp^%e)?*sg7&eTkL(~pAj=eA2t2wsClEr?=*Hfe=4KiD>`-BK@9@8Su zA$U;wM$Vk$nS_dhDxtKU#`G_$0K?M>AkC6uaeCvIAP^u z_oDRj)wbTcA5JZj7)NM9x|G~bCCefSv!-5yWc*-Iy4l{pA)%wkxL^`v*(@(taF~(y2s!oYB<^ znbKWYK}{ppjkwKr&Y&xBmY&tr9mEO@mZ9_rCUVaujtrs9V6o4I2Wm3MK8%(vk<_@J z?sighjm1Xp?2Dm()}F%1zsmM=+z73~FenXsp6Qss?q~$ z1^utNsg{}-@VTL~&fnX^?0Zh_V^JaU7L0Y`ODIC04m-nOQo8rp(U-$LJ0P!(+&Q+g zoYK5##7rNOXX@{4?8-3Yu`d@^)};o|5Rlge7?I9i-8X#vVBa#JR83C(ourvKUUJnA zs5oF;pFq;uV?*0hNaNAhEi-{g5*~KSa>CXFlVO#j;f=UYG78{oJAlVPj1a*bv*jmj zS@<<1|0&hd7!sgO;XqeR_cW^>r5Fe8?byGAN}uy~S4uHkyzLC3Xqk;<8*iBJDBAVv zk1WA#-Z;&Bf9PO1y`1lFYr9}Wi1s_nTVu(s3q14L;Ve|sPas=;KIa)lmW`~AZtv;# zsDJz+<=0&II;`*`$?}bqw7Iw%!W2x7uKjElZQ8lg@I*{J=JL)eiw2OOt~PH2xh3Uw z+Pu=tj>f0KLEMpOY=_!FUNrc+&Qw&mMQ)D0KbP0kPCFy!242}lTKAyobwI+7N!^OQ zT|ibTi0Plt$xvCrW;;~)tyv;DT11_Jf-(n@r2K=h8Aa>Cg1;?98+n~n=IiOAQi;NP z=Dm`N6nl2ZzuV>b;3Z6n{aJ!Kx5tn(yOvU5kwR$D1U)C2 zf9%SvBVU=NDDP}U(K0r1#PBlq&y>k}oJ;vW#)>XXrqQvaT7AU91 zZgEJEB*pP@NEt3UrgenrI^YQ2A#I4J2+WPT8tj9)Bo?WUc+-~bv!8X7> z>59QP_H3(lZFeKCZiXw-_QAAkclQ3yJ>%?_IhOI)rXB}2dX89k`Y2NY%BKko>@`BYG7YtHs*_yns)gb>fg%M!Z_GRh^Q^Reu79T!Ap2*Oya+zBy=Q@i zl=?0iCXamO+QFTs#dK$sUW`K091bcMm8RIL&p?-BIsg&JK2@{wU$~FPerpGW{b<=f(OaSHJBAMsR>*F*A4KPl+wGQ1hOfm|uqh0AAZP z#JZTIDxIlCBOB~wzQx-L>Nrm+2}^@9wV7p|Lm@e{e7oQ4xQby~ZU*QA(unjNigk*_ zpN~Y{zyF?TQ|qF+n&%vsvjpAW=0oYSkZVzx*R^RgzBQy#mC>=-d;bb6 zLgvS|+oR$YToZXi<&~{gPq)}oEB$J^Cl0{MAb3Gzh37@%#l{9F`4|JEFgMK2LyfNs z59MC?JDcHIPFi(htmV%n&bv8(@6htC#`g-kzYxanHV?+MT`fMl=t2O1_FI8?> zbmG{5>5naD)6(EjOW-fFE5^H|-pASm%*o@#v}&_s{CRXYNa@!L?@Kfb#QIBhZmfx+ zkNj?azL(|_9HNMapsV&VJykSW6lCA)0fwk=qn#HOaw!VpcoANU164zI;?Z_X50ttx z3T96^!d0RND}OLl-44bfVgg&l?7_Ef5xG6q?p_`KgFU!AdXslVug=ilpWXK_wMnyI z^N>1`Z`p!)7ofAf)i#%r%Z7?rr7Rb@qNZBS%{e@n6^2`?*Gv1LaJe%#`yeS>-PZ_G zdtolJo~zG~{k7M_Kiu)~ePN``dvGM>zKP1v@16(6#M{vAZ+L68h!lgGO;+GZCh^Rz zZaQn7vFBUBX#B{9(P?@}qBx;*H)ER^IqqjIsOG()j^*8AJ!d=GKh8!OWBx0mZgoUL z@I!l{^=xoGWokZB`-C3H0($gVa@j7yGD*Tc%oj)RSC5Fx z-TeQksNsz5lOkzgq96$c7ca{upoun=5J#GyKIM)BZl7IvPxxsBHy_VXA%JQ2 zE1ET>RVQT!XYU)Ucf=D=L&Iwaw#JU(odlK%pLWDoV%Q5IPh3h7;h~WNtoKKRS1)*7 zPQ{@0uk+_a@PVe)K@TKBcivc}JB|I&T&4FDXu*|Xf6aACBM$+_)0~k8q05K{YbMf? zlZbA}p(v`+I+GzJqG-gB%lC@DHm4sX z1ApCSv`kq@K0CwB8Bhp=GGRkSox>HkW!3tqOe@q;tfjp4hp^646Z-~f1@{Fulw5xr zKxg`MKtnF!r!)b-B%Ud7m4|apbIM{1tfbrvIwyNA9AJye@5jBq6qHlXiRSB)U<}-e z_SSv6=&?S2IJ>NUKlqZ$ZM?Ae=4*a}5h<(kqj;ifDmsrtFB4tvz`3zh&>;=ObaMJc zgZKM=*`R%r8U7**@Vn{(N2llNGd>RU)?@dv@aUQN7&%D%Xu6-K zhisTC(2l1`KK1Iw1OL%{<&V1r5m9Qd!ciD5>SXEf9O=-^-fN+~!K+IvcvPc%7pd(W z!Cd*%z>DVb3M*x;!zd0MP=5Pc;;ok_=#lBokO{3iLO`*qvqeuFE5Eqr+L4BpEW*zO zeA!)m)7NGNg_d;iTm*5F5O<~(uF!8_`#5<k#75>hb zP7Hi-9u$*OMYVb^3Ju-Z*55svMi`nWyO>7m=dc?%NA;?Tx;pVdXdkHA^&|;@mK2rr z#0YLbH{XIli(VlcQdE9NtPqVPjIx*YFhaaGsyy6;cG97{mfSCe_oRiAi$gAd1H5r`IihlDIt48O5SJG_ zIG-TG23*5|N46qq2%`T!s)SwBYh>8g9Ih zBaD=|?zf~F%xinPtUD(%}ktL3WD~*S& z(G`imow5n3A~y#{D`&&ItaCaFv)bnvZ?6j*21>jzYy1=poOKN>%E7%XDL(Z_4*?+w z2ShU=MX=r%K5TPvN(p|cU^Zo<)_jof+U zQ5J~*wZvlipGquNrvG4W%xV3j2>$;@t4l#@V()t)OLB~L=*v(t^m?Yu+8`rG>5Wo= z-~*F0rxO$wU=eQukJ34CGulOYAz1jf4Lkz2TVDNyF#e?ph85pMVAgCOG<3u`>@I;1 zNt(!EbRfbe|AG?9wuk{d=?ypO?(BZs31N##Grex|`n@d8MVL)v$vjwJ)BAs(7u+25 zcz4v$y3C~vWL)p?ef8^?v&yJP=qdfGlIG^Q?6{56f*aX1KWD8?c8+5nzSiEwysoBx z(bLj!*nMxH067$sMoW&}*zd?0u6xx~6;r9-nj0z7&cgnD@ohGeMMhqB_+`+rq_=1n z+e@Q0fsqPkL=t{qrx8X-J8pt4fg&TYI!7z%tDR08f%=&1dNj^DP1vyh}gsiEktIrW-m&O^7nBaEo?DyGMT}w!%3qHIP$mD zeVc7hvv+L6B(mDYo6PDxyds$!yPCGQya6`w%3l}tMJ{kG5={?>(iz+j0ZAR!#xXd` zJzx;ZFt1*kN4vM%Vk?uGpkHWPNR8m2yeJiY*7)E+LaAV*-~NGG0>;A@6eoKs+=a)u zkTvw4Q(T~u!19@Vggs>*k>%?Sk7`ZgN(Pk7BC*5n)Dl}fw}=KBVNZX3VO6N|w^Fx> zIS@A=`xkt66MABxn(ZF9DSKk@FcP^phM!GPVS`#{Aq2}}Wg6J(laYv;O|N(UayB=d z0#PMR|809u<;C)}0676Z3Y`*rn5w@7*IHRIae*RUi9X1ijloR`kxDgNSdIu{p6+}; zB;?nQs(e9u#4k}1wK+h(`2w zzBW8sq_*6>7oC}~XpdQCEvSg9BW)TmditvxiEHtEIlW?Wdbr?Rs@4AeA)3j!XRpT_n>ou@nG1^Y{APljqYLUTrMOjFdR0b-?*Ndd*r#Mh zE!9k_(miUu@%97S80p_0WW+(m3k@-=X(o4zQ*Z zD_fK7&Jp03CokjMGD_oLj?1?R_M1cVTUgPojvwZ3y?C$)*58ORSFfSBP%5>RQB^xv3dNZ#5a zRZPI?A?#V`z;N2@(!KCZBk9GR`GAM36qv{qaxe5AEpg2tUg{1r>lY!Ue=_bfe0{K} z^>S6-y(~cy#0Z^!QY3otT=69Jh=t5yprMdD6Bel0wP4EfH?Av1yU%D*e9aP>Xh@zL zf?AFv>@-6EK*FsY(!Zd0p9`>+V>L_PY*ls*XHYHS^KL9gfdlIdvo4Bb^mf~vhX+9N zBP!vVPZkbB?h1%A!R=?%0PFN@fycLemlmoYrX+W|U&4J`-msyiJy+25+a}yNub_Ep z)E>%#1#_n2oPOR)MIdC35$T8!nDm#P1kVOmFpd&@w zde&^(MD5|_5^Din8GW7xufbQ%YVrQBp_o$Q>nV1(K;*9ceU!60#b4r5wa<){;jZJc zNM+pZpc?CqXJHOz4qlm!R1-rL6pCizciRG-% z5d5hM4t*(lJi_o46feKNYpe0S@&Y+&Y_}UVGB+-lh6@;87Kg4e;wW__4L3pY-RG1< zRrFqW>Y2(h&WkrTqZ_pbg3ZF(t^L#RrKlrbv6q(ui_*DpSH5n!o4;udBMw8X+hTOpc&PSGfpiX9^VE?r;~+n;Z4p?UYUgjD6$nKIEw2Dd z9C~NP{MJ=PSai4D1(U&iN3VjWk{`Os;|~FJFUC7Zb}j3#W{PH1EDxykjJGH3iUX_baT<9w^#Az1R7=B%2(9)qiaTHn11fxgvl$y{s```Nv)YFb zJoTF}J?jvdr?|fTJ~tPbz;&|tErdt?h?5F^flAF>QSim0aTR{ju%%51t!e1vY{!?n zLx*xI(ARSd@6&&H+7bIVq!{;|ejNq9t2Ea-__UEc^V^e!@fUUpEE3~i>Z;-$C0%a^ z7%c71Q~wl4wH3YBtx@oGfXKf1{ N0uMO|6-0r!p~4--zHtgbUhf>C>dY~n3AiOZ zSfSb?IBSFXuP(N5s;KtYn*voRT*~%#=hb`BT992@lFKi-#I%ba4Hqo392*2gvs>EB zJ1OKd*T_@1NV$uEaVdo}c42MCgbH~_bJAE~yG4d&--UP5%Qa3g80B5;?qvVw+Lmyy z7feKkLeYtL1y9fW;rAX_Um*$@uvh{*CR|ppTd=Qv_xl-xZ&-KZDwzLTy0QN+r5h6q z$A7ru<}`I2a>f78#O5AyDPz_LWBPj{w_BRD-HK-#CJ&-##x}Y3h`Z4e_eH{O7WSYa zVyzzFaxxuwVShI3cB^0HPD2m`PJm1i&EJV}0Kq>S++o2|knxXZieWpPBnnbEt3vR` z0ST{O1%MkM#$-aLN~tu$!fUd$_qg-Y9QZwgWFgk&VN1$`YO<{kyj&>W^fo&hD}T*E@RB;~`s zJE#;D93w$oBx&;iM0(DGTa}pFTk$yTEvSiz<>TeqJ@bc~0rn*o1J-3^7*S0B^qk_y z98&-=LVn0Uh^0i*56j@mDmD6a7#9Q3Otps&#*MdJrI<5M1eN7LzHZ|Z((C}iBz(!K z1#tz3%_x(?9J&p>#n`=8|G2D;tc1CoeixB_3n2-UYMB`Ix+ld8Li7Sw@DlU@xfH?4 zx19&td)e?!xp^=?cC1}PXv&m|CtHa#$XgN+gN6lu71Nhsg?7+=qRF`NUiejeim}lh zwg}w;Mb^oSgTUW`q*BTxi4~M79UJQ?iybIbS1Js{WCp_q58PcH9rKqvB!wDTKX*-$ z~Be9QS|QxV`TDE^DReNPqxiTHiVD-A9Z zr97uIS-~PtMFQ6hdKS6*5*)G<#YRtPY3%0WhYpRBj$1$>o;Y|FuP4G_xrh2Y=3U>j zK*m!PwUt~ZX)>X?hF%0 zst!S%TgH2&yy30m4KkPQ}~FB z#}uu{69(?QQu0{@I^Nk!tD8z&K~Ah*h;=n_(vo-MX+nQG1sh7Xt6jAM4ptwu{^~+mjv^g1|9Z(*c(hNPv2&)4 zvG{Dg5pkpzQBvXLauJyxR-2p!zn9W57X|H9_vG#_`j@l}ROToszS&H;A+)+V{R=aD z0D;EQ&L?SWN5;TN7O>8Tr}u%UciM`~M5lg269+rc?9vvW5|nad7}*EUw>4C8*8DPO zng)y#%ZNbWbPRvm?ed3L2t?f{*V`wm(A}bHYSxj&2Qw5T5JvUvqw83^N4RBvz`*MAfO`02!t=6aWMRb^! zz0c>ei+R)E7#99Ixqg*av1oDxY7sL4g0-QefrVg!fLFwR8!6QPs?%KmlTNd<{l}o$|Iz7xgJ%A_4M>d< z(}JUS@-$cwN2|m(>9tKNhLR73>(Yng>B=(pYeoY85hUa?^v9ff>Tti1#FG#P9`in+ z`60*#?-IbGhXe3pPltx6*8Su_gOy@UP-1UDib01JXWbaHb;Iy3hvv@K0-2*zjqlpL zx&zpGu|;E>7^f(n?`Ag2`0!31z4EhI5EUxMO8mT25lN~??w#|^L92(Gle<5%GiMmL z?CRq$bVvwDw{OHY?Zqbtb?d zLRQkq=olB@2YzE{q()j;c3mbo%l;Ov^5!$G>ww2?UD~;?Zr4~jwqa?mwjX)s0$v*A z^wNavdd@J$iW{{fR17KTSjj*tB+?^V^X>yIk|z7#UPDGN7PMpsqMWgvkR^ta95kd2 zLQq9eDV-)sC9PNt!FK%Z)wl^g2)xdv@>e*dL~)iTYRw{TSm-!SXpg*k#2BOr^sf@+=XHq6j#?q2*vJgbW&^Rx5st|ET!_v22j(6jKc3o#7IQx* zp(UBE9YFQm3K1nfEF?ZKCG5^1Pfs1L;uMXkG<25-yCAeSn=Z*;xN|8Ht&VhA+l=+G z?Yx^VJ#DTY08J{wf~)3#T0T{{Yr5Jq3rzLzq_1We1KhuFUR&V}9A!u=#sAt!nEF`0tTKO#*rsWR`&45VcB%FmB=Ay{ow2cuXD@<&9BTnF3WL2c(i3^%d7bEGu>eg9ZXoB z=i56((R##$z0} z>ej(0Z_z@fNB0nxA%c(<$xmMMoTJYa4oTk;rdk?f)lXOKB+?{N8cr9s(LTu@4MJY^ z8&G_im0U!gl=_`>Z+b+CB}g=44G0n%ZJU0Hx=&YFy5jT1CSTzNfn0SaRqIOfk`_7L zynC_!!zjRFNS7t|BfU-Aq4pc_Xx)8|L5|g=!DZE8Md!;>5C~M?BIKfRAPiG4xz)RE zO94kSx_R6&>$iGwG)A%E;0i1$R}*A!VHd~z%h%mV5zp(IZK|_bn#}`U%&a(SZAFvK z3Xp)q|4|`k-p+sX#M7a6Uj^q3u5b2UA5_DOY}Xt{?Rc_I00f*41TSUri?KQvigPNt zi)ZDq;fX==hoWR%Vhw4!YE3v*K;SELelx4YXCH!2{4w7z7=odA+v_=CqjMBqLxZ-N zq@<;;!&?M^Lb|Q_^ns?k8Bct@P;Lk@zanliw;zPGAF*6;HtR0mU}3v4w;t_3pk889 zR?QNr3pa*hOm#ztsT&T;f$vW}?W*5kNz6_-b1-gJpkKnA=?CpMRey^u{v@tEn~0K6 zA8mV9tj%)TQ5%=BVdr3eS?^n9n)wwn!%o4}uo6U1*nM!*<#S}-C!YPZ>D?ZLVQlB~ z?EGO`pnd73%D(-jA_JfdJ5LXI<9IRGw*@H^%&q$rHHRvlrX? zQ* znp{m->?V~oD{EJOSGd?Xi3>S}G+I)GZ4&!q@!kDm;y0pw%aoRdGZu;B7%S7rz=mUH zZh~{^P*KZFkq19({oLYhy#uWNK7AOD$J{f+>rmN3Q^YGC0)4=94>8`kJ_?4|v5ijF`|&Z0;4Omc!}hkUgeT0=2jPJmxgEyqOo7RSe4A-XvTsD7bZJ zJSqyBbS5(3I~j*yBGc-uT7V_+&hlH>&0=YgCTjQg)6rR?uB#<;qYfd+dCFy*)Al1T z$hGMQy`7VxoXF&ZtvNcFEB?E`tp~qpiB)!#&F8}r9e)KRVGglp96@$TIgRUM*TzpS zy-d$6mv?E5^dIAZz(ZxON9v?a*GMBbo$>+Q&*`c2)uAu{&6%aMH_WLFXqWG!x1o4> z+0v=KVdy5KKxWqZ8q2qtX)MFeRJH0N&Q>;1f$jbM2GLzu*6zQaj{gh5_W#USW9Iz7 z{emh~s*I|PK*A#6E~G@vijwncP)8s@tQKHF|8kDMYqj*I`VAr!tB*%$$)}5fQYPuD4ElDTrx%STb)B4Q0yZVooW48n`$#}h zfRe8GIe`NIT0jwF_i${8q*jYX-RdF1ZJff_q^>+my}LT8i> zlro$r3!d_ANkhjZ``TijFAd&;c)V|=#E-8&@t6|qSTx8dwcRp`rN<|{J|;rF=KQSF zPxYvmgrC1al&hHf7YrmC%f==V$Gl6MkWV?x`Ng80^Xf(cske?+xR5{E1<}dBo|^_B zQARe)`Moto0;vB}t6ARDhuXN>G*ZGeO5*r5s0W3jw$FCp%#mT+?zveX&Fqp%ENK>H z`2JV4F7YCFkZ0_Ckh>BBxtag&q;n(f+}TYR@4@eK9-&w~x{90c9xEiZ0@OhSiP{1# zFPwNokWS_MXu=B$)=v~Bs}!vB??gOhhT~PO@G#aw5LPsR|83Cn~gS~%! zlTIh!Ph%=n<@r0#aBFDI`{0BYBGYm1!p+T2D65!J;L0!@)Lh=~%IEHGgq27**CJM( zopiV$JQEOfQR<2*SlH-ZBF7qc5aWi`UljRFy!1kOS+Ayb-d_>6b=Va6JZNOOM!oD>l+`YNM*1fk6x)8Kv4k4O zgLCTMZu*zzge{ZL&XHEJcyk8V(|&2|pLJavZt4imabc^IMVCI}=1aA`0!Lz8XU3Lh z;*jVTzQuozAN!?G>j27eqtYuy%v;@#UZ`EtP$s zRFRMzqp+ok*V)+YmyYh}ht4$JYnShoygX&|meME!Eo_TUJrOPc+1K!X3>y$c2Z-?(zvea8gCLe%eCLm(fqqi zE;#XeEnUh99vxGZXmdDlj|@?bnWl~K3PCEnn|3+@#%EP%$#M_GUW8bTfodY4P|<`( zGjT5Ds8xmIU&4R^Q+{9p`v((j)(niy^w-8q9x>hWzFEBtGh7fepRMcTEHFr}z5C=3 z{v(*5hrlB9u=b>Wm1%2e(jF1&@cbLiH5c4DO|>7c+$O3{hP+g^A_9?C0)^(i??z!$ zQG8lH-)`iE%%(q}yY>?I&R+B~3HVn5#_D5O6~?s)*t0a-{3Pqc!mVLqEa7gZC7If>>WJBrXru(-E7tq7ZS9~xHlvKUT<6y1KNJEh<{^C zsHFuLb5wixitEc=gM}LtCkYU;Z?#Q=$K}n=lgj>@a^7>AmOR;UpD8mL#pr16S%Agg zyJ6{`#rCzG2@n}4kZIpjJSSrRHCoY`-QpYb$We&f;oV^NiwyT@4#r26KQ@0S^-puJ z4Wc|AFM3~C&)OrJ(+W$pFdo4}5FU$~ZkjQg#Mh%zNo^UYoGn+{-fs$vel2PvUXBdD zZcFj_l3oHu)`L>41VnVhP47{&^-Z(2!Uo0YMRvD`=IyQ7fDt~O^s^?7%TRIsVW7>p z?lvP)F6pKg`Y_Wgu*J?p;j^^uptY(A4Yy!hDQ?|Y8Q)y{wsUmK!STWUE$(dF;1OX* z=5S`-7)O_BSL62*2x>G1W!ApIB#|-8i4w?^M}#ecAv#s_emLZKi?kf$wNrq(ywO?J z=I-vIX@)g3cEY7e-!z0&92a0Or;t$g@!N(9FQ{!7b`MW7P~BnHpNqF!gUe;!yeuG# z++3@vc1PliufsRpE?<2jCnu5YNrw79_;_}WE)=SDwPy6{C(>AwZ^UqhFov%Aa*#f| zdDBml)519xQ89$JAnAV7a(F{@gOInCL!xYu0>IyC<*yZxpj%AWq>WG$yb4Jx44AlV zr#AT%aG+&lPnv78bry_uu^q8;U18)zxYS5N4mTTR5OzJiuo6*pP@#YZwG5@N4&nlI zGWw5e2dPP-?Q2gvwpyUf>j(5VJfxk4PDP@Wm*~UT55R5fpEl&-{&R9`y(y@7D^O`U zZi45EU-k~@;y)~)L%&9{ssV&8nsyR5xY-{}+;p0F^x6w53N30z*aZk4Bjzq7K3l{~ z7hDusWO+R!=N{bLI2mdx24?TGwwKJc{Pey$UZkc7ska=C>%AGTh=DB1MrT&7T;zeI<^4c@c)}g_=>^Nco5B?l$}elv27S)7(|q( zLID{^=Rs>Cqc4>&&+u@lqUIavtRjzC&Qwg+tyw#vVW8Aw;NhDwBGAtQ^8KLavh#KC z^zx-(JmI2#jK0f9;L*F~G)1F!LxA|RMN3cc{q&lVml%vqy1(}N_wXO1@r^h|`R4N5 z5HjHVn9%*MV&9j*8?WZepy%AU;G2=xw0MhS%>^I;)lwjJ@gi{Uc`oZXBCT}Itk#rF zt8K##@50V++3#>a@SX_&b1VY{&G1kw^I`e<7j%QdwnHn> zjYQ7ZDP-O)q%ULc)v%xSShKP6qnT9t7A6BZYVe3)OLHS2d%}jr;Cj5dpTA=Y9=bgG zkCvYc&-2q??{C{DIjQ8_^Q{jD5gA~A4tW{9#o4zfW4QvPDOxD#!!+D?47!P$FUQuk zw=TI~Dvs)wKQ%=BDbm-(nuBMi*X19nE-UdVs72}|H0q9&`^$1J%3NbG#9O7e$;z4P z{=*uvQ|(z1Oyn}EN>>4p-7rmvEXQ?H|31#Fe%LUq4x(UWXZuVj;rc>Zi5<_%_)1lm zW}#4R#+6t)Pd=~C3NennsT5`kES2Sf!n`K#1fo?BZ}x~c*ubHZVZ%cwEX zN^h1^7LKU#18 z0(NZCJmL*gC1iBWI4$Q&ESE(>L_&mhD7q2pyk0{MieOlUJE^C_yaBufV%n7Y|6%ML zf<%e7ZCkc&+qP}nwr$(4Q?_l})+yVzd49dlkM|;O<94!@johtVvDchq@H0agf})zC z4!ZYP<3}!@DCHxF4tt2+o$M_Fd^vvqWJOM3Pk3AlE9WaW7&1+m zKz+Iu!kRRy5U_+t7`NI>h~E@m4UqrikqHJNn40z7!ry`%rU{CAB8Z~#M`56W8)qYz z4E58l75RW9WOGB0F2PS1n8DEgaG23rh#&)v&zT6QQ8#F@ING@s=z|k=xBLVu0-!FX zs@tL;4kbsW)d{aU*xmYhH5E;!G8O#G`MYFBsS8Abws`K*qDFR9Rd8?If_=|c+)1#_ zL%XAeLnm{8v84!iY~#`Pni;S|N9e6u*3ol&N94XHivmc&By=Cal>A9nRLU@FU^Jm} zzvzPt-kic-*0)e4KzwG+sG@#YK3MB4`Ft`0uPd@r0L-%jn1?6$t%6J_ zz~@uH4q&+x!HrYs5I=tM<*|%9-_Fh$8-cwnff!0ughu*Qg*7}z15X=5;^kdu?rEnW zk7ubN?8Edg02q=E946KZBJ`yB$SrUU zuQFFHjDt@jP|LV>&GIm>VB(vh!L|B+_w)L4ff&SHG}N&B!id2jH90huk-#BU9yc2* zuKe?jIJjJDu(!*Vp>~ASUUYPxfG?S0*opv2XHmeyse05Hz?9fuXCB+M17=ebw=}>cuoUVt)}m!aN=E<%*rDBn z8vs_ylPn>qs%)zJIXyU^tXFUPkB~UFgow^IAXP)ButYT^6i>Vq&q}{}B?kjhbtv^o zLyn{^MO41lg;`*8r~MaEhylrHkN%Jf7$rUM3Fpw~Bu$`&sP0%St&5L=`z}OKD&PR7 zS>+CY65sGq-19TbCiVkNj71ZrQkpO=gkF#Qq+RrM>+V$ceNx@?=UMX*noMgEzlx5f zCcyPsPX^6-JqwD-E{^frLu3t3?suTM-t}9>XOyOt@g<4s2daUI_n?!fYP|duX4&_0 zy^N%)C~eVFaG2a(T7+~7U9(3)<+>eX1`JYlwQuK>?t==#L$MZ|rq?Eij9=UH6%1Gj zLJ%w1*-lP& zHCEU8LK7{U;Ye#++dfE?)fE-uJ*%Q&Vd$SZ?8Z++9`2}^uJX@iskonyYY=T($f~L1 zBWYr#wfRLpKZAO<@>-+d!OJ3FoNt2?GL!HVR8#QD%83sS%lg5KBckIOBD#)8)u`d_ zbuTZD959`)k((gASaa`L5RU38R5<^QG6Y}`_5R)Vrh6#b{DgZb0|VGl7lVfqUti2o z;Zeg|p=3A)zplV#6GU0Gis^AkVo#mn|@wlM@bgn;sz5~Vp^Pgs<5=uNG3fZ^*E+VtD{XJlSqBMK9F&nm9 zduY>q{0fZD?$SR{*kTTzML2Rko_J(Y30p%X(>7s_HssjF!v24*l)YuLJ`dDI`RiR7 zt5HgLw+CMwcBPcGKUY>a%WS1P+6n~nd`fBU2uwsilg2s&G|dVWPc08Or8$HN(GS=A zXCmnUC+5UIXK`sX=nuwU9Jg}74}*KNxIfHX@8GXu-aDMjkX<%Zwc9CEd8Zg^nV*nW zgKTUZ_Uwg5_wn;q#I5MBT(?X9l=GJq53$a3OayB{il~G`xdb!L0x3wsO)0(&De?M<*WQH=+>hxDxpLX!-n|;pHyHr+89~3$J-ce*hlfmel zCsV&DjKQ&=4AcJjHNq1zv51LvsrUqduXSZ$exBJW#%{^fn9 zOxnXiM4&$g;~{3dbqh8UMcmjF08JhL9(Z2ttjvlVc6g+Vv;70LOOv&KRWQE{eMCY9 zenrwszs=4wm!)a#`ixTN)vBSx-VyROZit87Kgw3l+%y>}~69#wroP`=TC zM#As2h0aH_MO~Y8jL%{1+_OCwF0!;FtF-FduclDwc)zNG{8jUPY;1ei@0A~`hwMM@ z1X=$p_5>6A|D|n}{QprI!#fGxy7sNqOfJg+e60u6(g3*Fd4BDonW6D0@#y^g`? z(QD16ELo5}pJ_zALF0K@{qM3Qp*$(-wFq!`R{y7cmm zC4|ghHhLBhtiLHkzyD&JOom4RT2qaJi_cnfy@@>j@#P)p(wwcUcEid9y~D991zhmH z{cAbs)SN26Gp!WXZks7(QKwvOq@7s$(|NE%f!DF?!j2j`ZoQ|0w8 z&rWEglOf-Jb16zIYi{Kbsucss~$Wl zCW7+F2aY7a@*KEBEFIsVgTUY4Z=BDGOUNW-(zn>T&s|A_WW}Wz{iv`K=b8_>SYfi% zJ&T)-yxig*&ep8Qd>-*FiI+Ui=1e&MWA>_0zwFJdU0O6NE7{7I0^!5-srBOe-XKYT zg3_Opx#g}m3{9=yA9e;EU@A2v_&31%snog%q4T$t)QWT1yq(b6kqXdi|CE|T12c8J z5iS2*M*ai>kH+Iobw9RB`yMbI>JAZc0Ts-YzTR=`Gt^6YiR=MhQ>0c;1?$X}X~wYx z;tg?I3~o&(6C)pG>R7XUl=60?zrP!njKOB z;XGQO`RS_A)2d!#QFU=-2&z|470V@L>LWyeRtR9CR`lUABGquzQ| zAlwUkjNs-nzO;)aa9bu>pO}S&-qI+0X<*k7-D%P>XHG*eD<2i6+Dm|3tE+gl)k_YH zE-+ih0EZSrrEK2F zbU;5zI`AKqYnPG}VL9kbiilvAmq1WOelg*L(LDW~Bi$w6y^whxV;cay`0TlSr;jV;o%3gY@ ztQOyWtdx4J3X56h;XyZfy3(g6(@sC0ewTS_%6*1ud3s1d*B@rDPnh|p{(Ee-6uQMz zKQ$azm(w8Jk?PWZ4FJT6imQ>LP#( zhQEjlPKtY2og7;V5}_`Of~~jFWu2Rm9p!n=s|Qr=KGmaYxccQeLv)=H3r3?IPc%7z z-XNLl)skXImKpt@h0wg5EmBosD2XjZkOE}0R+DW4mSpv#cpcF*qJ65tqk$(9RT2?? z05QPtF$Nq(*PF0MR$UCu@Q&IXD^{4@ZjjC#x$-nkU^QY^V_QmU4`CYEB7E@$u4M*#|7h*IObjx03t8b6mYrQrQ(m7PN)4R$ zu&8G#`PPw*YlUaYC=l0wBIBptr8!A)bU*ELkrmc$L6E0OZ7c$bXDXXRJ%bRxbhGvI z-U=e9+qUc-^zNqVBO_UB{bGD$qxt(X(^M_DX` zf+#ZS&>H)c)$ftPCy)eVYCuj&KJs{kSerr@PY*7gZ^Xrt4&bK6?%+1Qwcn}1?E@~i zI%@A+rn=nX7Xb?wKtY3Vq^Y8@bf?bBpUp6RJ}c<&+1?fNA?(J!l^T^|NDfe5om`le z_kUpGvMVT)ESNc}*a7J@ZeEu?VWdj}OAr+H&e?&<9!N19ZcjipT-&KusPGUZJOlzN z>Dbrp$6RWPPrE*v=N!l1UtIHmfA$Kwai`2AfT7HNg7jRt+-oeWmwbklF?X7Ad5x{4 zjj-8$9DQHsj>P(_wxH&lb%3$*Cwv8rl_x{uwx$!ikr%^aA;$F_;nyyPXlbaMlFw0>rmN8h{cw7eTX) zYA7vE<8wfGe0^R_m6U3gK&s+ClZsuS;V($Q?rJP**fZ=R-0TX4-@Pl0)+H^LxE58h zA!rF@>f^Kd|C{m$K<`-jj}Thc|BA)L%*@X6zZbqOTHDUQ2IyZFlVdX9k=>{X00M#F z>qKOZTCB0WiR)rUCH!C9Uk;`?70F!V$ErI&08+7M>(_kZ2?U*>LBm@7E?xVFF{wJx z&k>dK9lhG-;l)_hGCY4(DvBeWQ%7f~u4Gq|WVUrz=f<~nP07yhsc)%M%Q>cyJg_V3 zc6{5{L?n}{qrJvr`+7gY+5N2I#!5$9_4;Z$!ApDX*b*Brug^7Buv2Tiu~;95#JJ*X z{<3&1?7;SPdLWy2=;>ci$ri_IxXXX#zk$4R>F=`9#y$zE?-jD%H)wGFm%880Kb>0jKWy}~#wb>+&W=IGhn*sB*$cf`u`OVR40a{Uj5rVQsL;4zAh#yeX z*`kZoGi8%2PCiv9p*ON^xzuv~ExHejc`sL24J|S(2K0E@y5kW@DdCoBG9hZlGR^)a zK_L`ed2LO1Xl(_fq#Arlqt_>HSNr9sDCQsR4DmU+ZLpXl@EML!ysnSqwbaJM0Q3C*rm2 zv>;b49YNTCmV28$pRz>M9<eUzz6KhcubwRNTsuHe z)c@QhX8^4WfA)=ary9={-8{BW2^Y88pOJ;|D-~~=M#ZS|N^=GyC=Z(kNQKxYuHce$ zh&L$pDP-7g?uygI$pACUiLKujB1*tyUN8aU7;IN;kpM3TmJLG`v3cX-g7tw62~_)2 z`x-KmxY&7*!;=T2bZ1&GBV;IWH#+A{B!t_^6^Zz-$w`&vGA@)f8qB zU^*MA#0-k@Gj~L)wHTC1ML3`eyQ2Bh7G1yudeRe?Mj{&1W` zB^vRUFgCmV*3|$%Q4tFgHfn`BTinCBHq|hA1ox@8PR9A zkZZn30E-NbqykG{C>wSn-I^@mgeX8q~UyQ%Ue+s0j*XMDA@!@mi zvZ@a@hU1{Fu69R9uiI;??Urt*Q&W+BZ3I@$HMWbd+6-ah!K*mHhu?o?rF6h3fiaga z(Xq7j{fZSkTzxJ86PZD{jVrQ=IR=oSp6SzU)1Dga6uU7$Rq~*A!Jow|z)yhuQA+|phHyN0Sc0#lSBMV%!=x&pYN=u{DhTh5(sfSk20`$$u= zX#Vk}47pJ3;Ih-d3rzsALG^N+v0Q)7&4Cs!d@*4|iBJOqCF-L`fY}HUdI}N%YJ_Dk zOwR2!qG2h3Yj`hvi?{}}1%;6__*;yl(pXZE?NzL{X9QWyGb$l8R1*LM#eM_@8DPj+ zBs)X&&U4hNgy|UoOPBmPmJo z0VP@Z)K6=a&}^m*C6VW#(;a~$09F(^YKZsjMIn~ZFnq@$c~h@5Sw(0`S}VNQxfLNly8No zm_W;=O7Srm1?F?QkwE#@f)O!J!iV-jHPsqxzK(QsqFCWFFw%zLR(1I*T%1*Qb#k-^ zlj_@+8ORercqLp?mm{Fi4~<2{2NTp5OY-e?5Qh5wydwe(BJLV`7PXiC#@`w*|E1YJ z0xd%&sOc(6Gwluc4h0Gf^_+@Fs!38Q8JRm>I`F25o@O!>db3r09!S)l@l1RMOG#Dg zZqvA;5~l|31QWKZD2$CI6DA6=!K#N$NFNu|fb$pjDlMqx!!lL(XsBzL$wj?iQO@PU zG|_|8W`LJe*Qwuut-ZI`4O+<+F0EBkHjg43Zq3tb1<-X#X4vuoE#~0^%33i=U|2IH zu281u4WXMIf9_GFC?PAk^o8%=Od^^Ge@nPY52i{Z7l475g!`)F>40PDQLytMeBG^L zbJ;fdLFmVn43rj4t#gHP^CBe8s@`juxo^yJkcEXGFrHm@d&q2=P{7wGM!7DcX6RA^JS4dg#uV*7 z2}4u)?4wd=ljecb1j`u`7FU?3$JXG^WpMDxN)2W5iXZR;#<$_GB&haiHjPCbj!<6VBsS46cT>=HERENC@BXZFN}D zD_gb;*BEtj&jeg-O!nG;fGiBLARa^>rXRr$s2@C28204KCAqgZj&@(&sBpHlrrbtT}Av(pT9E-7s6AlN6_Ri5C{l~)Tco+bphcr({^4K}4Ad6&Ffepi(0_PEF=z=OZJ zSr)^T;}Sm38oMuTI=RlU;`7&Vvf#!R3;c5>>xf@_)4S(Ge& zM-H2g@hyc)GnB>W*BMC5LhMVFaF!z(Wakd**S#I3rW4}nBsX=pFySeb;X6&*Bmw1wtT?mBS-;BO z%cwe~x5Fx-e*ex5Jhj_fb$(w2>fA=EnzswTwu9p+X|)O`*MD!E@1Aw>Md$XbN|VJt z?pl{MCzJ^4R7a$0uZ~)+!9N|%HO(gM ztlEC>>fh4H=|AllSpI%5xiDPUP$W6#|Ek`dmkjVMS=^qgH@&J|mH(~QV7&gmgX^11 zUc=XKPO%}6Z{lH;5&R`ptC8tMUE)@S<~5-~7`5!B=YnqBk_Kvylokl(X|~F%W1hw( zrq^BG0}xhfW}lIo=uaKsY3zF%H{&jyaLXg zVAR`+>-TBoD?+l7gqjOz&YlHMEqA&T%-oQb@u~@rZzr9x_6Sthx$XKbm<&u5n9H=j zlqMo#PSj%_EuctAEmh{Ry=%tfX?0;3vo1lER_1p-YhP#CbO#{;7v~^MUCnB6vgYn~ zyaIy&w8ue3ojl-i{}4+3KxEuVBRq3s+(=2*|1Q~F;meYhQswrm<&jTq`a9-{dx*+) zdHT9T=D!54avJ9g%H1(K zU(oAh%vF#)K4Q2R#zpuj!g3HYkL}uo3}{?4gd-g%wX}VZyP?Xc3XO)^hp>w{cy9en z!R7a;_qBy?7i;-Jbx?UGdCn6#ixhi@acNYAPUuc!i%yD6x6-*S!`vI;u>WDH^`Ep- zcg8po$H1rhN#gH-2LKw3o{?kkOx)+yPT$T+c$I2zUk&>HAcr*pFRV49MazT7zG-J$ zJqb0g``xaEjDvv#EX7^x{s25@?F`a?ZWn+7j*6TeuQP)zS=w!tzA>`MH8oi?w9ydX zQ@vT4;!q$-3H`960NK9&P8#S@0UQiJ=h2Uls2{^f2Y54a!x3H_A!pfDZ9R?zH{DBc zd)~aPhnYxZ35`cpsrMiUfh;|wlhIF!p%XakF1F4@UOmK603FY)g} z5wpi%ga5KMJU0oopcK9b&d`E<*;$|D;)p~*pYg|yE%W_YFpyYbrCji(&m5Svs7ok^ z_Fpm0X$3pG6`-Hz_=qbnVrenV3{4mC%i?>42hoO%aEuZoMS=RGkk2<0Gno0v4|I2N zEz-%Cj4DhQ5O-ZK^QBcxF@ogGu0xh&50NnF2fPY(H13fr?@I8db!EVk6$gmtq?%eGoZ(Y3#fD?w%i*F@URz-%wcO2&%Pv&A=8oPYbzvi7yyZj1I~IF zo$Q?Q&7PZ$b_$CtEmX?;(h3^9K&CYZeMK~xne9cy9CiD?Tz5wta1P7MTX1Tpvq_?Ms5j@mkOCf9+}#Rm zLO;BS=UYiye0@F1ak5&cDU*XH(-~CtJ0qqbmEPS*q}@FF{E2cYAt&t`Dv*FeMuYhv zZ0%G}1G|u#6>cIpJ$NVc1@F<;B>#B(X+@RFOEu`tpR4ANb6y;9nz1>UUztSxNDWOW zr;dG~jZ;m+&PsrW6N4rhU>j?BqZU{41>4{9ZZ$oGtWdDboB!8#SH zseBp^-dCL+Gia$bu8N^LVqR|<{V=z9)p{doL;G+75_z!`3&|_% zui=gW_6FgaZBCzkplJ*3$h0{Jz1taK?pka8Dz&{g0gl$O{2ega=QI*e(D!P6$9T4A zd6Y*+0B-dn0u#5m#Yb(JmZf_Gd8Sm=XW>O8)a1f}o9F9g`%o-J`js1)bC=;^xN zta{^f`Z_z^GeD;d?N_gbl=fwU0MSVux9zgd7kt!ZV>sw9q$;H zW33bRWS5Fq=~*D|(e!ZtteDSkIIi4mcMGAiO)mlL*-Hs*E0ukt%^w>9)7YrG^=giJ zK32ldTZ(K83wcvULEmzC_qALuJONLd)uG#1h7!}nT^TUc-D8J82X#o}sWFHsSqwg@ zyKjftd+h5$EE4@tH3)badUN``fN6aj*6LoR)5==D60~q9%BYU!BHc6Ng(TLDn(O%Tc8F2%S3Hp1A z_>3)Bl@FW8oMT^xDl;IH(9UO!B45CC6rD%%TFUvyk#}#d#9r4i`Ra-JXltPwf0~(NF!}K7Q?X5+`LJ)R z?&rPhAK=&Wqy2vzEB`yR90%wB;ggj7TDv#L|Hs;0Zv_vAjGX%l@Gy~8-PWDT(bBRp zCB`X0LQ((&!~!6dru=?;o{I;=h(e*5+Bk&+bFy&z)44yg3aZcWHiWL$uivU+kIt`0 zx8sWfJ-e8F?BnR!w6`8K#iG7`;PhB0;@I@{dQ1;ZC~8#`vd!_i|7f3=Monp|#Db0W z_4V$K_0_U%w+S{z_3piVYw==#?L^vW(zBa3qqJt?P}ciNQKnwkzDyaetwtr!T)U-< zuG&=lnzd*jVX@3}{7z&V(^Yb5w445o0{7)w5dtt8L#4*h1cF0qo^$4F9;9^au-KnUN`sGT~@kwr>YzJx3W;QT}{eOt+S z5AlbR&6J(olv0^kYsg^Cmi(dg`k-rXpjavrxmr3)mX*jh7sYjValB#CP5%xO z40eWV;E-S=om19KFZqqj0*R!OIn4*^Q?ZbPstI|ku&vqp-RUH)3F&{-1PZKx zo7r4azvNdO_|y}67)$zj_sX+4Gr&19<(dYC?fu?)-RZ>pH-1WntXy&=**^fiIb30* zCkK@lxq|IPCu?GC{uoF4gcA!Mc1sn0ruzPk%6y3=82?4-|Y(KpoUA01WeF4n|uHl%HlT~6bJvu2_~GE zw*0~izAJjb9%D2oLD>?Zl|8GO6I?pVd0U$6D1(Cx189HiJg7v>Sfdf)IA+r+_38Ky z^$nToJ&Yf#v~?ui$+dlDMvsL~_3&=y`RCK!9WebDGbnbXhtfuxQ|5wY3huR?zI*n} zkjzDQGwG!bSJnI51_ji5UVgBWY-MoYPhCB=Dn{VAzufg@Q3gE130o&ZO|pQjic10j zv2W4{HRb>L8N>has_nm9PRXNQoSRBF2V)uemp7#e=4TM^QMPFx_1Rh#=H#lolde18 z52@5{NXOrkmNo^S=l{}df+U2-&s0*ob+!6)fxq(=T0Mfe=1u$&goq%{-+eCythMjP z{+jEzaamA~)i>lBhuti!_zB7`e!B+~h5CyL?xjN!v4uc~hn}&q3gn0&2%rckyEc(p zQ0aNIy{9I8jc}(lC;$W_3@S@P4)B++=I!ubeereG^JE_uEdN>5S35 z7s`|l#Q15C6ul-&JRw_GL4Y77AmK{fWQ4}M6N6m%Tf-Y@z*($Os~>0}JIVA-@@H-h z9tBTklHw#OYdYJCsh*WvP{sKLf(@NvcKFgP5LhBQnnrBaLRkj6JdYDUsE=iR{plhg z90z0|85m??T1Khe8zy2nasFc>tbdV4FRg-!-k3z9b}>c?Y`j4A#2O?$`-|53T!0D0 zRguM;Z`A?9@53SaFO6q=)x~-UwJTK1mgXcA02r~Nl9DPQvpN377u zGWiAklrr^|X1~Rx#RVg;4L?vJK33%z_4Jo9tzJI&UbjT+@-;3|av)yC4$bOWioOMT zAU;pwJT9nHKi1~-xxX~eLt$kma7l=o;hZ^-$|E^ZiwJp9>%?^ zky8V4jhPKe9nT7S`m9o(c6o7&ZLRZ4ChAtcv`!v{GC;vq=E8+sp@HT4==y zM(eY%BSO85(iIX*y$cQ&N{t6@Y$cXuuz{*rDI-B^4H3>e^EPS#kvR%3`-jr3fic8C zF&=3b1-O*RT2j(RPZCOMcwWOh+Hp08RtVLdId#fLVCY+EsJ)i0iNzrqtKeiBxDen- z54Fpu58A^Zb~!L}3?u;}79$vyApWJbq8ELY)haNYY)7WCMS&x7!AB?KKH|n8$%)+^ z{;wiYe(kFVN58U*BV8Oy$m*=sz!Bw~_`kE))wvD`1CN=}uN#}_&!Yfzxk31NKI}J> zK#pHnOKQ==B{rEhj|?5b$Z6^Z3$Hw*m-vz)8BPk#L(`@BJ_#B`CIc z!HNR1DUhps?Mt>TyCAH<50@>HLI1iUtR$3R%&??AJ)a-}dJz(&hJoH7i@3g7J{5*L z2;ozB>AK~S5NdA}kBY5z^p1$1482}dWSf@?z^xYr$^wY(j) zjk}-rHXOAS8gC5=#?bTrA%wW&BXVAI3dgT<{>{_EJ|rlFoL#r8WOYb)Grc*Is4HPX zQ*pyl9K2P>;EIul8n;(t@4RjKn_{ut*ZD#k>`g5#huj?Xh-ap3B+{%VMIjrX-8$Yb zf<{mK6*W+lNEZ}RX6p72=&CZVzm7aKHtd zF`G}b%l@E6)c)uj2oN$J?qJH$j#&6e*aPZUCs3Rc(i-}b_%n0@;3bALDAUj4evJGh zw#-=G2X_9Q+?;eBYPZpse;GY5^+*oYtnskUzy_2vSVU zMp9!(5k9EpuMlubxnV&~KKX(mJR^pI>4i_CRK3<(nF5QIg{9#L7YY#y#b3yTTf)nq z#%I==-I9A`*KGU5(m;8NB98yq2e7Js zqh}^tzRxx(h@8wfC!eDn8dhr`;L87+Aj^JI`8NXseEnEr~g=CI3OkfEeMh z;$vJ5R=)P(Vs&jPi-psbKU$>x>vE{A@jz264kUOMbSx$gX)yVW1x#s14jvGkX{~Vr zx3%x{nY6Q5uj9FMBOrv>8=x_fu{U_%3lU}#C0*AK`80EArM_FNLx`Y6WlhL!m=SmKq>BnnF{(_liw?ILoQ^+`*HZc~OJxrXitz-^-P9YUc81yMuQE>#oyf zBcDy11^jv0^pEHbf6Q4iu233iUGXSl89UV;8}+ChbJw0XbBTrs{bvi5ISd z@Yi7CI9$YV{Yzv;u9(AcSTXzCFRpZ&xoMmyB-0Wiz940wPh!6N_By!)9%^YU>A$gO zs>-;yt^`s4dTXel$ThT8_uL6X*Um-m?9c-4SU~qSL$%vQEbbK?;83bX_GcriMlfmT zT;M+IcUQ}O*XJLV{EMfN$RfIOd_QAcLm6dI4-UlZ1=mTo_Zd`-=LNsfADMMwW))3C z0k~t=stIruG~<$dR1hizogd>TkX1*QaEiO*1}8i#2}2jdab625BN&bK@-ww=sH4}wr~cq z0T7dhBeaMgvu?Aurrd@O?^~_2BSdQ(@>)Mbz`thtkd+4~P9RK@B6Y-IpxDkEAUh-L zX~mfudOjV#@9j~-L}yLN)Wbb9124l$F5f|bi~!tB)NAf9`z#=LxB4#%NKq6WL6#(lt!URPJ~+jf5u zLDo#cDgwxNM_*$Pt5lHv%$$mN8bq=!o*ZudiZ zlt&qcr5Yw_v}(|a6VfHfm_k62m&hkyvlEJ!Z`18lbGF+c*kmre`UmNj$|f3dmBiPg zkSMAir8o`%>Stfi#{f}+d@at~&aqNy?@+`+LKn=rU7*VwgQtZ>6n|#Z zBe7ZFs%O2q1C{?Y!)z|?47*-a}eX?CO${H6AG>n@g0C> zCM%t=RPBy^71HToveUa8%&wR?*WV8nom{LK^Bq9%E}AqLmV#KP(N|-_YKg%Qn_k4F zCGFM+l$3ZUu5NOp00Y?nt3y+q@4E9Lo0W8;&g>aYW79)&0A-U;gNwvP6wksk6K2^` z4fWWI6i)jvM6Rp{vHX|8<5M4>nPXu9!sMzQs;PTC_Zcv!$wtvuFR=y+V{j(Ll7b^V zVQ6SPrdA+3-HePy-;@E}D}#kvg1@zYvhAtE_S}(+;(Vm`BF9q+RoglzUIWz5^5Ay+ z6r6lM1H?lYIfui0&?oIg+B;~0!4nPaR`lwYA+3iN+{2s6zVqG*JTk>DF_~@fxEIUK z_quhHJMcOxPtX13-#76N)fyholJxb_yvyCF{qAl~Pa9ZgpjZC-h+V!3)}}~T7??f* z%bWK^CN;JZV~v?d;4CQzmE+%hI&PdpJ`H-4|R}<1=t(SL~qkT1Iy5 z13~ITHa*u@t7mqtxll074q>m6#2B2F8*0ER+l$(KSPwSdc8g-#I(F5&?C{*ba=eR+ zrK1^xlS?}nbfGqja`D1m>QCeKuFom|h59hb;yk))8iS|1`ar=xo7rUn{3Y4UP96IK zRJmkqIn0YLeIbeB=-kWHk>Jlx(_mn1roW`C%3H^rBWzz>^u^%lGGM_IRO#kTlx;2d zrte~2>Wha<*pZEnODLAi@R6Ec?f`&HJ$>j!mu;9@wOzvuDjy}$z30&5=wttGUB1la zhQC4+-{dnQR((O!znGvD2-Xn_S%Sep_5aXmT(#S?ecK|KfRDDtp4Jae#YezRXyxJiC%4zQMaRh z^_od8b*Vy#fw*cU3bMjd>;7X|ekv7>iq+*Fm-j~s9#>uKKFX1Lj}lWJAOGUj@41z; zm0ask)cXNf$By*OSQH)$ZzHa=&yOwF&JS@WWu-pYATGD+WYUlQw3x~(0?ex&gV#7F(8?{n!t@w%{b=l*7dbSlL@PXs|J=Gh^ z5RVQ5=wuz0m2C`F&~yV-d#XA%ZM4~0IdrxSp@UXug5@lt^(};LJ@?gM8j9o#EvAKv z$4zGc6VG-9MOgXv)tzO?pMxDgT?_pgPhX4SjDfG&k)9Q~+%d)(ksaGjwrv7el0r@G zBp1gVT6LPV#b(o){i<<_!>ptmLcXHn%Is2dK3ndzleS~yB>gB(_3-`Ngj&-vtQEUh z?qtRD$sGk3V^usQ13XYum4PReYKJAh7p?bP2Y?$(0BYr0mf#NS3isD0WEB<5XFdR8hK z!8oWVW9WiPC%3eB94G)GY5k!$@`&)eu=}<&0S`s^Fz+@t+Vicw3|n(>C;y;MaW*|5 z7v)9b?BjdpU`UA3yhF!F%i{Wv3Ic6MvJ7SyhfEj^>@~VQ8ozQ%-v49l9ilS}yRGfm zww+XLR&3kJ6Wg|J+qP}ntk^ax_E+cpjeopjyp7Y@?Y%o|&--3;UQ?K-naeYU68%u_ zi^Krw$*}lce(FSvCtF$^xF5InE))U>p_m21L0lO1eA>Ep5e`oh=%PbP52S*T+242- zaSb>QO3wc-FU03@b73-WhA*nxUO#ORY4~h7&T~r;?Q0LQd9~FF(HZP<2(S#%O6;7% zb4<{A99Ru*Cz<=l_Q8tT2<66XsNAGf1{H~N5qKzrgJ2{C5?Bl?Fx0;PY8vnJFE^+Q zj$1Db!XU(SktULHGioulg{Z@09`ZmnTtnh$Vz6v{eRH=)8`<6OemoiC^q@M*{_L)1 zJTOF0!D0@XYwyf%J4g~`nvsCmHL7R506_$`v&vsPOpyNFU>1VokZop>NgB%asDRXp zq$0sgiwtY$=pFcrnWA6?)-F#8I{BCi^Zd=>41+YJOVN8v+_4RBu=02w5pDQ;7AH=L z-y#{b$?Qy`etbF4F}p;5NCszUc1S|b zrDZ%KnnQ%LXg^Qi?KeI!`_N1#7UJy;i9de=Lbt9ISR&P-xxKGe9)ax0i4U$Fh{%~W ze=5=LKweZ?hx!#o2DA3|BD0S6;=$!n%FkPU$cBUh8Kn9Cpk^X7ZfAS=r>VVLoTs?c z_Eh#?j-WQta7!Xd`O-x$q}_r&x}298A@p?BXQ1TN@J zwdnAD9t$EqjRo*McWn>D`Fn$$8BHzrpgf-8iz|!}F)t!Sl>Z|WNtpT8xl25AqM?5P!u9PXgCUS78- zQ;7FWP=_Lfl2Ud4wJ9nzHc3-(VpX^{l(}3!k$pydsVX0CB_}X0_q#kn6bC93Q7WjE zR@p*9Ryv6DP0B(67?~hqtn;RpEFyJt3?^tkc`&xhx^XHzaorMSJGwy~HYk$nkp5Cf zb6#L$zqf+cJbE-d+(fnhMEJoL^C&_m$k>0>$h~B?Q}lrM)#sD)m;L8&-{#u69zVI3 zEu^U-j^Uj=GY$KgbCF}1=xn1#4M?OQhp6b`VkvCru_8%r2%h3C3t>=M034Y_3p3V( z&Z=t_Tj$Aa*qE0mWK~TBvCV-evGL)rF#_c@NYRn>OxdY&<>0JQpFLc*YwV1Hv-5x> zvg}-Aam!+e0I2Gt5K7~vd5=bC{8=#2@r=J{HbZh7GxP9apq(KcEM!G#f~~KS!TzM6 zF~zDuUwi!pJFn|vWt~yGV6CWX_sik@`l6vYv%lF8-({saW5k)A$%4dD5cVDrVA*L; z6o=qOF-;;rb}5HpcbE+KHDohw9 zHCsd;q(_nT;URV)mikgHRF!;eW@n~YQ!cXF-SPWrwu)%A?xyI?VpB{lX|r{gFd^j( z{=9bK?t?M7_Af)V#!;b<{D#d7s|n8PQow(2k7nct-*nk@F@oSwT>ZBQUd{=8WK-eP z=M!zaBmEu0(k=T$nFVo&MO~bC`Ro`^-@E1E$-SVVfg6>=wFAm$F3!?t8;U|%mSq9q zR&{&Jh9b}BHo|r^X-tbiYOG*(!m8C^`8n_a%@0a!7tf9nWgq1NwJ~oVN4)8>)P7Ze zXCGZ-DlM->%vxF+dpi_qOKWn#$1gGmOi7iJl}1xOPJQf6e0Fn@i?g6%9WViGpur&$ zA}x9RN5Rsb1uuYOUkL?NhkqFft3v$z&3N0v2q2nb)C#iOlrVA1$hsPd?|lC$h3ZoXmo$s2H`fh8g8K)z4SAf=aF4=&f05ivp+7^M-X*h|;E{_jSg4xrT;nW4*!#|i}8&dwF=&hNktd)yW4Ljb%Hgvf`b{T(;bve&%;^tO z63nE?h_Pd&6j-d>*Mj+PH`%Y-O2ml}IRu*FEvXYcF!_B>D7q=Z3I&z5FUJ%UNsn?j zMOPT`QKQr=F!{t^`RSUONHmts682IFu;%8De!wToyZ(MkC^**1TXlcZ zPilc85H$;~@y#T5mYI2+XG|t1nGCQ(gALnNZaE2Iq|_|ykiE(GLyW`ai9TT@zHS``n`arz+K>;JQif9$I?&|((6lbn(lW)2mI z_VTv#Y37^=8e=;k_13SHzJYz$vjll{gm_``MjG$7h-do8Bj*XcDzIy}O^X@NV3yT_ zvT_}#xHy7XUeG}$>)s~puI019E)(aU2Jg-G zXuRUC4eem-%DRQlV%63fJ#K8X^h=!<@TP()=r@o$nnXG+=w}B!JdFlg>x~f$GexaG za1UlUk4=--R6`X*qi&$;6bF&>&fIy%*7ZaryqiPq8kiT%E88ft@oSFJRU_F@6qqO> zmgnHWm3DCx(kyD?RBYoW^YBUf8O&7RMmX9Dp+yU4k(v5~%qx#ZsT<;`%S2IqiezV+ zRz!-jKCOgPILfX;NcaGm=F5YlUu;>1KS40|Zy`vgIo*8XwL+QAdC)wd?Q_WpR-6oq zi}7^`;l*?a0dU^o+_2byE%i7f@e}~JG>(|nKD{niUki%xnjO|Qb+39x*maH&?aZKqz zaPj$Jb$m~th4BXGbs1vc_q9>-0Nzs}l*Th@AS7|OGDKMzPClB{5(q3)30kf8B58OJ z=bn*W_Bh<4Nge3eU*(qG@@}BU==({l7+h$)o36^jp!W*_-;hMpB$gIRBzL94Go52= zu-nw|C(0ctHVTuiyEK6A>>@Ji>@%)t?-r7fvZW~!K~jz>=5c02hn}^SgTtj^U|Gg= z65`oFvvAmvpvkB^wUG-6EC^Wu5F2bb@&*jJHxsapqD7%>oC`|6WY9m+XQ=>9Ktt24 z_V2KcEc|RZTee%trOd9`HN}dMw~1hY#70%u$5^2>n{h-O+fp!J`h#IM@SwovmabxC zqQ9Hl)#g=({j|cX!|*vtn4_2R7&c0Xc^LSvxn(nswkU;kwfY_t^MIGiDn7Y8l=SW0 z^xmxmRMQUNt!CC&rVvQ*4}l|^yWqrSW_8y1>V1!)ZZY74wuyxc6bUM!@JbL~O8JwG zih9@^VHzQYpj-~y*`-M8gbL$%ieSxf>nUmUiWx}9jDdfqw7hOu1^iyznj_8AHp5{Ow^+< zhOI8wb+s*VG~!gR^&ZT?h-*b6a%(x zb^dg9L!pH)TJ0q#uuH()fS~yLxl=ln zpnr>QvtjDT*!^AcjBr~e)U%)5Kd!hMkBXva44OwL>4YWp2g{ROw_Qhk+TU|+8<8^C z=+5r_e9GTzI@qaZrP|faoUTb8sv}hC7bH0l%MFr?{d2e4R}VG*XN+Y>(c$5l=k+hw z>mrH5-J+p9sHM(xZ3MKtsBC5KI-8yuT+D(;Nim}@`@VVii+hAI!f7dt=zuK)U_;l$yVCG z)Az?nm1qcJ*l1P#X~zvDAkU(WZz|2CCK_h_byN#sHm6r%uf7Imz`UpIyM1XK+M5f= z)E?EG|N3R>)WuprU-K1wq-d|xqu9ObjJGgLygw;mQ= zymFCqiqA(C!D@NofTq|WiA_sg&6YpK?N7+#{5V(qFiYEMZPuinR065uhBA1Jr}Or{ z+b0@7Wn`PT1dvmRvmzL|4+#+9_7Iu`|7%AGQ_Zd9FPku16OFjRg&ItC|Av;9jYECT zX1mz-7;K%u$SY`aDWAw?EfN-Z9_-9X%gwMP)j1kB&pWwW7-0^q^6O;`62+XWzx%mw zhT-BmgK|F0Ppx%31Nb1URqW``)(F@{tk3S!62`i3zf{2hTf=xRY&gR^9bwT}9@gu& zSuKbs0k2T+`zGNxC{VCy%YRkv|2NP-`+vg9uK#~n**NiE{b}@Fm0QDrZuWHjh6%&p zW!JprHXYglbRJ|L6ggiH6$jFVVK+CD&sff&rIeAX)u-wsf5OmpQtrgnGY9-SHVD-H z+I4)M@U<5bRZK+H+dk0QXeK4er!QPzl!-MuzTckfXhyLYGKW?uvscBWs|>iLYN6?3Ra3k6JysSGO^ zSZq5#HLSlKLze+iYtJH+$y;bPk?+9Ytz`9QAW)+hTFYSz!NpnwmVI%Y6XSn#*BM`m(f|MxhEr-HDyg@kV*fLfB7M5^C@%p-kc~@sSTi ziLF`eA5LvK8@*FD)?{!oyRSC3Mxx1!z5%=SeLrSRIgXn)?L;Z56Z>|ASzEo)$Z9&) zpR{G@$SQA7<^vtPR8%qEbWJ#9C4qY%s3;IdN6{E(K;;`YU4Dbu5EnJSUTSC0<5Tk= ziNuPnw!zKoIF!&}A&jZ%6fiJ#wPxwF&KvZkwT^NiWB9V|5J%J3(OQd3?yN>FIPJi}gP$7COZKs`_qrAQ%;x8O?mRHWu`#uO+yGoDM<5i)ZRafx|Jq@li3^-EF~;6!Lu)E1Vt1yEsynhj7j%gc&xZdcvTnmN zdk?&@SWXcf&v4GY!83^a-QWl!?NEB^rjJ@tWRP}9y*mqUPGcf4Q9sJW-p(w)K9VCI zG`38j8!nav33$_PHz*a;-PpMlBjg0jJ$S2Sc&x=QcaR&qeg9>_*8XN;py%UX{EKH< zuc##QhdVD`9AAd7hRH%|RgL#k6aGUHB5xTHrY71#aCNDTA;$a$8o;ThErZ3L!!;{gPklJUK&Mdp z6Xf79^>>qHajHp5;M)I=el%xkAH?Zh;Z{i2%XV+k36yr4cR5scU2CO^s>L)Hi#V~E4dPJ&zY6givCE{z zXPT3YSh)_NAx{q9UF6IGL7Q}AY3fF6GWoyK{BAPsXmsQ>jllqLX9lvVg@Y;{yh6pU zhWRT9y#k^7skOPJsUv8J>cbYbv2~h`|1FkaV`$Ony(U0%fxe|=T+0nBhyXAniTcK{<>XH znsVi|{)>_yI?g;Ac6dIYulI)@`Dl^ep9j16Unk8&y2=7K;1AOp6i9-;W47((EPUw6 z{K`u_n>X#MzKJ9DSYeVN4`u7uJ($16Y3@ZB&Nf+`{Q$3szqg%fwAURR{*JLSGf}J* z-8J0!6%LfuSnC6ifQH*~niu57=j1@9 zu2qrrlFuy*XrUKty$oMcbh-x4md=FvZwLNrt2dYYK?eWG*m;C_RWbXN7}BWX!mo9O ziyzB4d%h?*{mwUgTc41KT!U(}exC5nLldH3%H2Gr%tp8qO0Cu3X z0^n$%Fh3J-^tydEdssx?f7qjKBuLTSA75QRJAm&h>*QFsNi|H1^d@TPz+^dV0OSqQ z8J9eOZNtnm!kraL?wgW?*$+v8PbEu3N%yN4U*`Bj5`Eu9!4;~Xt4FW`f0KXCTn_Lj zJ1mWS4>grNv{su0%cUZ3l`1>8tb{-X95Rd8Dmp;kRSvzx?~h59v@mqc+ELl1SuS6SY2*Bb}FqqCrp3M3T5mazNF#0?CS}VJe5!-j{!F4m5 z6wHUQfTGwF;x&S~SLW#u`4Uu5aG2ugEZ6F%i9u^j|P5K{Z&Q zXP2ubuX&Lf&l2H@x=(IM=JoFb-^F|=X>$&Z4<7T-_r-zn-=?IAqyKq!#66@A>e^9A zX^f*E%pfzRkhWigULCDPDpv68`!xFRc0KI9LZ}?>F$_l_Hzj7_(6YNsBO3V-HB2O@ zUIWIfOuSnBGZ|ij;0&5ODK{M4R#6iR%ukWJ0SmE7c?VFqmU{_N8;E8f{RdH^+%(Wp z883be8?w$OmyYC4->USUOt1Bn!VAI`@|drdn$2a>kZt>b=0hv-(6K`NvHfj;*yGKT zXS%f0*rlk+4a%CV%Dc2lo6RGw$XrL=$8aHuhH2p%q85<(Gc$0MPimK574?rafIhu@ z_;_{S)UoHjD&H|z13vcw#Fqi#!lbcXrX8Y%1C2SMLgk?Q2XeCxd{e!F+6d1QE5lzk zIzr0mgGKvM0I+g0;#(==?28QJpv(&Msk3EhX|WYkwb&YEwHt;jj<>o#T3Z37`uIfm zClZwc^ZMsfTbLTeXo*DeU}}NTnqTej{$~3WHx#-MvF| zsj3a}v?Wugutxre_T9@WO=)iEief(J+c|{_?%;ZwTN^eaCbx(-S;+01tx;meayHQ- z6}o*3S&}{Pjk2ne@*8Jww(x|q?Tf+4?>A?mPgf`CRjC=y3;q};uUKLQk5J&~r>gDG zR80PVPJ{G3fX7ZQlf}b~wW59*c-leUiNa|XdGW=m{{>Me8Vzsv`{48AxW*)(S>H*K z(fiQA=RUmvS-58&{-On-2S?Nc-FZ5xD=m!R))=!;u1}q<*{FH#+R zK{`b=&A7VW%0knJ%}_h)*El;%;2-s@>!p)2w=BZlaQHe6?H2Ec8-t-N__S)(nUn1s zpZm12oBGGGEF~#T);5k3rOH^yUrTk+3@)$zU>`(C5t z-FE4S@gUbMD$#~g?F~p#xXx0lB3aZKtHT~pnc3Es|N6_hZLWK@m(xmjG89uA`7IV@ z$nE^G|B_2^;$56^)S`U~{F$^K#j&8=s)IHte80B(^ zkO07Z0BhQ>6fANp`x4^N2VFq>G74jVW0euljOiU28-hy5PxTdVBN%f3vd_*vt1Kd9 zXxoGsaq>beS_&kKN;wG%PYw%m>Pw&ZKfZ4x@JrB;OMG7g z#-HbXuAH8|j_|{ILT5Nc!eB*n`V!lgW@mv@gXVOV&Vv}<~`$UnA?jY+vhi`DvCJo9Vx8@nBGI6&Vx*8 zAPtgEDlp>NpX9|ST^&o+Smc^>vTV@&!AL*P{#>FSaPKd6JT0_8l%30 zQmCVseojCf-lsE5N*5-;zB@=vEt6M{(dflPq6wqPbrM)$arGt9Hb2i2`G>2auu}6Z zveJ~>51uyrTgcMMAbr`ag+&Z`fsJg=<2-gsW;Kb<^p22v1?&&Y>$p@>Q0alc&n?FUhLGgR7Z{G~%Lkt}hyz5%Ae+*JSg%_*meDt9#S3zH}Js-uz}S_(j+2d}{@^*j)$2GjMhYhr z5-9@6w;QYVR|+lKq#PVRrSNX&zeApxYEJ3g&FlT+a@aD$x8LC9Qg^)HO-0%uuBbpu zxd+rvR?~OTF)3tV3$54*tfZvlZR{qk+dU3Wk=CypqG{W-_`XC@ml^LXOboQw=eWr{IAbf5tc zKAl(q(za>K=ClS`RqAhLcY21RG-^v_#Zl@8KgymZYEXJ!2-}L9 znbXjgD>wX@%iiM*XGVpN^dY>zJkvdwENH{Q$&y+3-+5nU1%A)gweG5)%)tr1Ys~Ig47g$E5Ykp)J&Ok(3}-sDw&;HSjFutGZ#D z*Mrrij6of4A;LdAh%XX9t~~-I&uHeDB2t4$Mm{sO>cIv|bF1udyf&=nzzKsZsT1&X zVDMtn%9^V7LMUvEHx3q*cx+csO*DAA=A)PSW%rat{o7i*Llp56y8FMheFn(w9yR$o z;^mx=iG{#ZK!`Rl(C6@0X{jTctO-IOTdPz44n6}ZETvamyU{VkQ;>it`??7?3EZY^uBG&kga-&}d}J5hy6^1@zAHByZ+M~&I6dmYKHmB}u3@)eI{Q)OcX->^SKT!MW9cjb%* zsyE=`SGIHXI8Zw?c6ARJ1YQ0Rk_TsYPFx$Cb7sZ&LsSe4^;)TqS~ZSRsMcI8<-M_H zIS4q!&dXVumm?b34VZDF*Kg#-We zlzP-~Zfv8W0xLb)-V6Hqq5dhs2{!0PbnDacGC4A*y{Lrwc%@CxWFrJ!ZiC5$>Tl?$ z5mXah;lw=)%wG+RpK>C-EOK6M=hi?1M3J}U3 zj3Jcb*1lI0O1H_OqQ*}t-@j&kTAPNnwPwEX&ayqAav)FToNW8jV6l8!A{N&)3Oakh zVa<>h?q)@>z6Hmdp(Veye$BvWd$ta)1g9!l9#6~A^wQg`9>=)x0*+uINYD0W$0-}K z*qRR5OjnF6&fA;H;5iwtBUU*aA!}9o z7PDb{`o0#;>bAr=+8ud$IOAEXqQPZDG6)9h30>dtfVf(HRGrp^1Md`3Cy5rBaYMye zYI%C_1q0&_@49#=8ya^>qjeo?YiG1D*K5IKEhE3w&jYfecIC?EmUnjFnuxmvOT#92bWuHCxj8tEKZ_#zn*=wUb(U8oT8$MBvtoj=4*`#lLLuu zZYxr^ggF+h9F}m#B0^&^|Q#(t{h^g2yao4mXp4xpY za=!cn|}jfT<@{?`4RSpso>qt3I}ot>XMv94Pck$)O)J zAf$J!{Q9(gh~xjnxI4vihHYM`+8aM5(~Q@ZwTxqkd)E>fucT7k~Dp^8&tvl)+X&= zwQJbJ{^;4N^Ly{nsHLXYYQ#Jm1pLyIVy2*Eu|I&*ky$ zREHpmF4})h^o`aqU*5R7Ck@IQ2)|`3PQg zx_m(6TvTOVYVz{rPG_9?-o)Qy(aWCQEyd?tyT}b={MH|HAyfYLr_iaEnA(Oh^fhxt zqGwS}HBwsX{Gvtd!c(P?Ho1~PBlBksLNo4krAwwR0hWr%cctI1e^^e=nYmGUi_uq*$)}$Kor>YeD)}jhA$WDnwLsq z5mw0DFdAJmT#EL6wBP-$#nxHcEn#9oeNP=L3tdecZBQI@n}u5&b<45mt)2OHz~iv_ zJS=tqA5vo~<~HQZpFihC)G?UW<^bj$;! z!zF>s@}jb*_q?}0*(2_yBj{4}Q3?#*V?v4P8-WXg47__MCVQznOw(pf zfGX7`a0P~J0G#dzvx5#`Odz82h#p%S?36l5UTER+`-v!01nC-+C#B$CcX>d$NYt!sS2grK3uu5YVN>ho7pTr z(kh#kknzgl1!?+Wx`(RoNA8c-ZgDB-&}9ih1RF|@#Y7nL^5$`pP(CzOK4Qz(aO_{j zSdC7S`BYCruRkO?gZ!~V2tu9BF040PgnOxqmcc<}_6~3w!aHSwRwsg=WyYt~IY6(4 zNv=r!G3;ako~iyuC61<(!n9*4iVW$F!e7t(r6(iyg=sd21K3tdwSO8NHxO$L6=%`) zD~GXA%9iyKFl$+XHhFDBQIn$sTIeVgxS$0PrqjnI_9Cyq-A%oSy*3!peo>?SdiQ(= zaXb~`AE+9`9#z%lcksm~a*7>7D%N9#i`TbAmF^E3OQF8Uk`lfN5K6Hxc3;j`ZX`D@ z#YR4X{jDu!s*EOCzM0>gztKBJ>*3g?)EZ$|_F+oGcL$Z*@e+=8jr>3sf61(d$YA9{ zN5ncu;&%XUr6V(=ZajZHa0jJ7762U774?Od)@!7=04^RSjZg1TQijHCnd!m>`iWwC zAu4rtvQ(ZGvj75sItmjUyKbH$TwsunlVHLDEaPP~RN@GG>=DxewuJfa0?I`D*G{^~ zUSr6}s1D_Utv;btMM zkq7x{reww%9n#~iviS?nZ1WLP5!YKHBOLygH(QOU#1=yt z7LiWuQ4^>v_J`w4uabC0OKEoIoLiYCnc($)*iPZk+ONI+UVX1$2<8-u+qDDehgM=ZXMpz}OP=E2aeC3`oJ#vA z8ahEuPGJe-h8dTiLrxu53Rv! zk_;^}Q-Lrtc06-gFIl(YPr@%u&;0ukN9FZh{}bxJ$@v*Y+B%QZ2Bp_w4>@&+;2OR< z=d6v+yc>pxIo;sCR242SfLHGj1GS9B#@|*bRt8wa^^;aORby)#!|a$gM}z5XNG@`< zF3AgF`z1<$Q#gpDXK2nd$x}Zw6WzD2c}$gYv{RIZtGa7_R~=5b@c8pP3}KmgUiJ-Y`c z$_S&&jE>>ifqH#Fr7r<)X<~$%*CXFiE-_nk%`S8nz~XAI3qWk z+ZzwDNGazG2r~z_2TqMG4|Ao6HbRcIc+rpbn?3R1h}&(8GsNC#zaVVvp~dT+b=%@3 zA!y%yYP@z-^#%bwttblf_4%LTwN}j{ z`wxRvXSmJlF1}^1+*6f_hd&P{cH-;)dHlYej(SXbS%BpASvUO58ED|&fC)vEdlw@7 zx!!6WZ8?EjA0}C>fH$nY^8_#m(DA};RZ=)Jtm8xipt>UxJI%WT%_)#7G$zy-(KN*B zsg3%GuK<5dneZ-Q>k`J7KCSu)h+yJ`QCu>)m(g248-y_*?p~iPBakH9auIOVs$1`W z5GRhQO^3WEK=F134dS-5+jdn{*!^`%6zfQu+h!i>kRDBR);>rg(6`f7P5E8mwWXJeU_~`D+;^q6}oA+JlXRvZ4ADSFAN0Bhmz|lnQcrE~^REDkTm$4}9GfJuBvs6x_ zem7jg{Wow_wj{ElIY-R}fkNBZGK3b3a`{^H>dTBqqZFk0pX+DSJcL|1^X32X7C5L2 zY`u*yWk_h0m{fJm7yb!xwr7#a$1S_BJlu-9x zDP7o?q%Xb?T}S{=f;l&O;THa}ASxtlEtVhz%Jle=m~kZ5NxVo*RH-+C1d5Gx1^cnx;7mB1{*;=x1nw5j|DQgSo$U~L*P9eZxS z`*_a|4G47#OWg}iFY5GGO!x)d!XRUc3z!*VL*x1{!Q!6|Qe($A8YikN#vWj(SVVc0 zl&H^YjEKOs#xb%V7h<19-Sw94-y65hloEV;_EIkWhUTto2U^8O9eUk1PnNOb5-n=7 zVF5FnWlM8(WcdniS5gLSOTwc=!j9wEs}mleQ#lWL>QeA0k$DRb zjoa(H5Cwc4Dya3nI`I#ZH($I*eIuAf+eJ!DAjmDcBtVvL;`_kB=b8QKWXyCJ3x$XUW>U36K%y z(Ds0=jXjQxEpA;7>2HVESYjs^ONNsHrHEpw_#D6O_}m`Mi2(q1=5qY-5mB7T4#l( zaD#5#hFh+GaEWhz!EM*SYN)mX*TuH`j-tTx*&ItX0C-eIl$;tnr>DyL-KQIkwq`>& zOhfN^?CJ}3R<(?Xo;|L(o_!b>biaD->p)ifD;Gz{K^ak)_dRGvJEEF03u_W@Ra@Jw*Dlx?lfM92-oXOGf05Ov2S{LUz(Hxt|u}**oCt;Y_^6^-2|rMR8sI| z3Q$HPSwB5R`wp^H?e5kdm%A$^!reIp&)h9Bm1&>M_MIVSKtnx5gS-N-Tfvk!1I&`SSb1Ou!$)aw43q=HRUO()@xOC8jkejD!C4nvX>5(f5=-&9%6rmU*YatYs)VoT+0M+ zZ-Th88+Xh40_h4kd)nw|mEI&pB^FLyqLl)n^^ILP@_wm+)s)X&`aLl+i8AnbVn{CK zGd?~(3K;s?PL;Qe8w+o_?l0+aN+=9-Ed~zfw0I@uUq`xtxaXd2OaCuV_vEM1oRu1y4f_#GY1O3C;C;xbE+;RopDVeD;VvL+V+Re-6j>76E8OVo3V;XYe(zTX${B{O-DMMRXyA z8gCfI^5__L@bw8HvnJYGTbE-tA}%g^$a%<#0@?)viTxDzH+;MGcZc`Q32-B16hMH> zK?+z0$p<0=5#|7DIwG7JxjEWh|K$%InvBxXmHT!4d~-NV5v-w@dNyF!ruVcbRlQ15 zHCF2~6cv-}!$84~P~EQ8WF1(cN?mcw7yrD#K1lq?Sig+~F|H~;Lzmh(R({kXgXonS zW}h#5~8Y?1ag2{34^YtP_l>Qv!Z#op`;H%s7U~ehmau6fHN4ydLM>lA0Aeo zGWGlRslwR!t9k~uNDW3JKh+*hev)V*0bxYdI?BpJGf5ehv2i09X<_!TMXm8RlP+v4 zqsi!c6CY2s%AW7!1)f&&UD(Y!GKB6Uea*J8Wk0C^_i)Sn8PrxP;3!@ zc%SpWq4|qG_42-O(y-(xA)n0OccZnCvN&cHcMy3!G7ZuBJfq5qa8kGaO31dkr z9pVnkSjvRyVGbcHAUGT!vXkKa{Pp4dh_ewQ?p)7oUtr@s*;-tF!d0Xd#UsM1f?M6lc)zh{R!Zh`gp-m8`ty zQ~cGcoU5^*ZCslzY*9SW<$?9OrQ|nP6(nUq1#dD+fKf)FH#Ra#bxYAY`h4>+V<64F zWETZNI;WNr(Tp}GOp~B!H~Y0!l_iWT1xV>1J)?87ZEfPFP#{xhDbi#jsyz0P&MJ4_ zOhTPlymrpalsv`Mc@KjNXT^x3FYctGSNZ5M32=| zX8wuu4*O#~2#{DqWtcQf4vz9tG>Pbl13dQp#<@Q7>;8X?y+f2H0T!*Bwr$(CZM)L8 zZQHE0ZT@Lg+N!i|+qd4E+}msQpa-#H8lyPaXMa0W>5=65qvJ>FoN~0uo%bdC@pCMl zPhkx=259nm^BT5Jymn+b>%;gVOo)TjDy?B3YRb=psp#GVJvDwxlz6R?!utqe2FAQj zdjl==%@4h>tJcRmH2Ct!JbID^^#$5W7VzS@d1MiXE_=%P1deXP3m{0 zocU2;+KI+vDu?(EVRN7&QQ66ksf9tW{@1)O+56{Uz_A7>+JF1!a{o_3A4$AWo3PD8G9Ud$trUP{J~ zlAsxvoy=^>ECW~>iKco~6M({(@8TZ+B5;}?awV)Rboc6yM&aw0H6>@hDQz^?L}uux z*QxRb4*PQCYdgI5X9G17Ir7OVg@PVT+D_StxLOjB{FVE7vc1mxc{qAR6&Yi=GgLW@ zFpML?GvvQItnOAwk;__@!Dckm#;)&0FO91itNo$T3NZ@=Lk5*~S;@NB!2_x;k3XLU zlrI+29nsh~t=sB}y4P$}H);JkT;v-ICARWXn$XAJlTSW{ctbv-cn!;Oy7exOkaW1(5RT7X=DL#FN^8l1Mi<);QGM z7Ga>z6Ib=#sVkl8Hp}!+JE+)=EToFgVOYHxI(!&iR5TFSpo_p$-UfM)qJAd5UfGw= zGH?r9Nhr>%;`u{5M#a7ArtUKG&>|E6M5Ha6h@qF-w??}hz!+eH2zYSp2TC*?eRXmu(yruQu{ZLvG{E3UjW_sC z96*dCFX(<+&d~{Bc1*l#H{$eEw>@teJFsoo*_4lMU6C#d6`BnloJE;z`c~gu?M%92 z$qremPP=b^SdX-2b2Os-6J%!Nz&;}};5vg~c5p*D!)DZ zF?mw|fYFo(K~0Zgnz6V{&$wMpQdsZhSwXmZeHoG1NUTKZK8Wxpo>5sWeBKG2UZ6oK z$-bn-3nk9;&;iu4x2o0UFhtvSBZ@Q0M?MLYlFBPkQ2z?z}ZAm-b?6_mv91P}>I zs5W1O;A#1S8q5m4h^5jg&GK*sCiKYa^N7U^*q+BPJ(8}$7?}2wQa9AKZ+oW|F zI}G|ol;6o)+4V6CHS29A?+3;b?Q7{)+i?Zr&{BE*ZA+&-JxO!B;n+sjlv$*D=!Nn1 zY_z+eEyu(cD`W0EhMvUXQH8Am4-`N`W-Toz zwou7}@y%8jFURrKVXu?Kjv$)QCvWM%YJ@m^^oscW-3X<;+;sZKIGfFemPu!aVX5QD z!~@k}eEt9(Rcw$$aQ3E&MWSncsSZExeR%J$MM8&oKFav=>M%r!B-5!11MM)3!ikk3GmtN88Fmhq5{zr66q&3^7e^(q$Onw=GJ97hZ5!NUU ze(=PIZH7iYyldn0em~unuL*8KSO3u(@Om~)_`MfVcoDuW@bI~^eED@&ZKOWO;&80+ zLR)n|Zsqr#rDcL;`)g6WMdcPIEtL0{L%4Kybv04IG0hB2QKIP-w7!EI5=yxUT5y#A z&1hTxqt>HaxhjlV6c==pIqwuNR6K1mBBw+`e(laWq1?vptrxkN{*Ad^@Zrdh!|_P8 z!xy8?ia2~5E)Znm?-3&l1LNx8lc&{XPTqR(lUC^MJJlPkbSZV3*B4i19j?7#b#xLr zU7;haPcd3fxGctLsaDYAVLu(+{{LNI6%p*S&Oa18Bg0m9bIk+w{o3`4F8hl@5& zRL?l4Z5&p>m!0Rq>~&4V(`v*6%MM&|0P7lO#BR<{nT@=rB2dm000V|L;J~vu_c0e- z;lh$P&5k0~L}6^t{&#en17*W{=|1CckdY{sz+(aD)Z^rEGTC&_L8zpgTuRYC_r_J1 z>ThW|bY5DLnZPl&b|-fHXX#$%a8v9(!e;_an@;v^k$PM^IevoASs)43S&H^_uppr~ zDro}PV6@0Nsp=UJ{;t$uLQdj;z;`reh8ZYx5s>U>Pzv38zb!yd{kxIw#k`IC+wGKG)e2Y)6Wxow_7?>0rwR6W%3lv#ZSZcn6^bI{f5<5Cb%TsEv#G(k0cm)s zY6&J=J3N14l!)ZikTJQca3_O}*uKL;ROm|g5G_!Z8uZldJuO>nXc=NBoCaEB{& zJLPOtz-YOSq$VEp7u`Q{!=D9~IAVr%ZZv}rI}HYvClCrjq>=ZUq%%k)W{C}2mn@p; z3tQ#B|CX_lg`BiOsa!(tG?0`li)2>&vcA;0WSYYFbCR^hSx~p4sK@jxSAK&i8*i{a z{?@1gx-T})pd~E6oq8@+r?C`0DP!A?P~6$6?4T~II4BchhpxXySwBlV4`mVVXR zQ;%x^Xv1Ds#jy($Q>W;WUem;L!dQDE8)x{y8nm%x3;D9hy(~zy5w0S#9Z#u}h1S#f zg1iu}pqZuIJ97U6>`4{-#~w{UoSY=G4hA^43HzBg{6Tat#-G5Bo+hs^pr=ZUpyGv@ zopvANz=HmidnqZf+>~iA-7&aC);lpBGgksCop|EY^`k*X5ss{VDq4K%pjVJAhzO5| zDydwm8_!|O8WJokHes_qT;?!92W&IGrN(LBA4ml`_eJ46_T%+O0YNC5Fz`eLTR#h5 z=D8Dwl&*Tw?-V4*MFd5S#{Y5V-)*Sm=`ST2cgdDw8yUtLna<^RdSKlWStv3Y@2on_ z2CVp6TmWMIvcT>Rd;45=!+m)U#ws$@4{knTeX}C=K1xpaBu%gs^ap>K`k&x+GxSGL z;snaBOTA|fC;CdTqQ5cBmp#cwHmjlVr0|rZx4<6|T=-k1$riAK4qw-|4cdFp6QfzJ z>Nt`{yx2Xk!mZ{;O4Tcjd`|D}Odaq`0>TsKui zPi$MncTIGF@l0@Xe2b|Mv-%G#j(I=7?8|O)r274z?3D6}JaW`&rq%_EDF30WEJ4q% zvPi~@=@38V_FqR$>H=!K4MkLquKhmO=S;EOF~BRwMMU<$0`zWDs`0+75H2WBndMF1 zo#SaRq>BWnpX~Fy?~+pN(V$#e74H;S->iF9qE*TNO~30sSUkN#_& z_@DULtZe^zt}bP1uCmR^>(7UYJ9+=U zQ`*kDY_x${UfCC2`)Ns2+|GaFRv!50wG8dHZ}oCETQFer^N!JY5LN>neaF{#m5Mqu z$$XH!I(5sJ@3Tq0sQcsTV5fk5=QbI-4!v!Yy3TJgx9a!N1fcfXeLeCjLC?o>q|7Fw zvfNk&JBUAKTEUtEMnMm&@7xuTQo8N$Ng&}-#?rmsRn8pWro|jPVgx4~^VP_k?*x`; z^6_Hs`6qe(+KAjFU~LfUyW<)k9l?I}W%_GNVYQZ5NpB-g?R0&SH7)C((PAZk5NS)a zf~T{r+!*UvYbVP2qvOn5N8*x??VvP|1AK)Zd!+?7LUyMmVNU7pD#N6ClsNuXYZq?z zF*qF_91CSTp^pDm+@v^uJCuEH(5zs^_rr>}T?u+HtW)u(=TWh}Y{w*bRbc5$%Av>i z_Tsz&W8Is7$6Fg(BaH}JW{!W$%5wW)#~W;q)uI)aU&?t0J^^aPeN=>E1!z4pH!pua#mhnAv{-wKC<*#TLe983+ zy5zYgum5~>w?)#OJVis`PRq#g@U;t;`P5Z{T~D*~4apQbq0qEo!a7%ggWhBfUrWCENJj8D= z(R8*MuBBmxtRty>&cS)BfZjkEmT9Bl@#7GodO5ne+hnLQS{gfw6R%;}dW8>jGv*Ib zlS0)VsMp1lti)}{<(?10vkcnWUantPIvRqzZt|z4&7{U<|u8MZ#OA3|PIaW^-!eJs+UqHxW@X{kLVuj)hb_OaD9cmYlnlFql%Yv`S7sxdE}FnM?%UV;RgA+?9(e}PF0;WNDiX2mtX~c<| zP!yeHe?rz_vbUFjpR<6K96nKMXt8GDC&EipkwtovgjijE+2)4DMF5Dv^^dNtH?~3J z9}{2`Y}5(*aDp6__xfC3u(o;_Y<;72fm$!qCqdKgTq!a1{TaF00rx}YyYA|R90RJ` zbEB&DQ7L4c_Pm@!ms!m&<>H~>fz}H&afR=YuN?l{ww(aq zD%lwVe{&~Kwb*E_Nb%0}3u_PLkyNczuOCvWa4UE}G5To>ntyXfr|T=NZQ9fN6HY-1DY|%_bRmmIifL<0gA7$hJCim^r&TZ63KdKm&W1ypsx zHb96!BTSw~UQzj?@e&;wHfr!-5X?@h&lkXgV~HRKJD57rnZhoZKl7}|#Zizi8-H!p z9;!4_jEym8%i3%+{D?~dxy!hyz`%rO0lkdB>kF9_!sZ-wLYO64@E~BHtb!UAY7k6E z1w`ZJ+y>bx%l^_H7io)>FfD{nc)>S7^IO^BZpQfD^qY@-;coum(ATQKpmT7oZ|;&{ zpwORC7c7vx$8w)Ynhdc;j5E-Scsv(ZYsenldSPW+NSU0k#&ZYdGy=)NP&zDrgZU+z z2^g4q`cU?nT&fn0%P%QX&POP9I}hkMnr}+FxrN5$^0|1__4n!C!u5%Dn_*r$EBbp< z-&kW|$8qmu9LOo_-O7^_O~0|*1y_jX?j;uzmDXLB(SF-e1&2lO=#0T_{W?wor`pntRupC*Dl2>J15YL0AD8DMt=37dV?V@y%w4&)h+LoEg?bF zwC{-ER@Ca0kZ9t#5n@68M}PS4eD!7#ZRi9T=F?vqg$!}Xad^pHTd5h1 z@T2h_Nf$lnpJ=qUw<|z}8bj=sp#DrsO2e47W@20jZ7Ox5FaCO93A%Esq6eEElzstP zShme%K*Oo=?^^EWB@(*3W7U75j*9xlnrPCv=5JSCsN)mP(v1Gz)UuGlnHz3w-~;-` zTKu7Z2B5ODu%IG?h{s_;)RA zSUED(Q$%J6-drgx1YVoEN%FPpvugZnH^ZN_9iAtzJ=Pcy7T{+n&ZJB8fsdQ*Y& zLt&ckPOS^QmyTrBrceB?PzcP zlhnOtN;xA|Ax+k+Z+;!!%{w%}7!Xr+I{YDH&n>5c7D?4>WdL?I=Q133I0{4!dE718 z&p?`>FpqH8LJwVe+^){6T4>r}FjtN11IdHs!EdFD$<#?Bp|Tl27%tZ;DJk&hvGzT) z5FO7l9a|Y?2+}L3>-V-s8sx9k7w~ZP0v!Gv(w*GJ-&12dNg={Ot*5Wlu|o4_Ae@q$ z0Yy}7IeY016YE4*e;C-md1Fumrl|wUAtq+)i>691_S#H!Gk3iwus-ky{joW0#q5oF#D_*+dBXKc=I*;m}Qgg!(SMP${@VL zW@TMBNJOXwU?To%e%m-n8my>XqCtD+!H*mH=z8@*yn9}c(58i{RP0!pf{W~ll}}#} zi|caz-r)4~#kB9{`-vu`H7rBj{K7ltV>Jqb_|$tnK|=X>FP+Dy)?Y{wud1r`_vs)y zpXp4+7~ShOok4kwmZIxoUh_nf6XH^)&vKy&=-4EK;%l4#aQrDvTr^eYJvyvhw&IKl zO(YW*CY!b-6W$LmLeUMbL-d1DQj#VP(FH;^?$sz)L{wOxS;ytp2AI17=RP|41?D(UNueCt3Br zXx?hTKyhxqGyz)VqtV2pNzN)^~{di`O%>1bjVJ!M>$z{ zcs>&MYC;3JQoz15v|YyhH_c}alHf8bXlQfnUa&Q=%PNd%Hm<)Xu$8m>0Db16C}iYe zfN22ZcDG*-HC3tC*3ITHqre0OmOg97B1L*$f&&C?sL zZNE%E$J}tRN&^h_6rDyG)1T~MSdg+0Jzl_a=i!^X=;Y@BP-;hB_W)Ho3vGi~u!_x@ zx{nV|>z(NF66PgCr+XHq2ltMZLuiBqO*Gj{kRmIXZUS!ngWiYshGKvHMEBY)3*sj# zTmAs2|1`TCwThT$m!&F`$`Pac^;f4XHwlw*&MPNQ$QR=+nWR?b(NU)d@y=@1YtH3k z7fQ4K&EYNj%t2i^+{mZx z&$(j130?n9G?7SOYs66n%;vb+o^sGg;{nHUN9n(MnBKx*o5Ts;z<9I@U-n@c5Zi|f zg8^&?OD26}ZCbJ6?2)KZ)Dn1%pM1-4%y<5S;`%$`$h#^e6{iyiMr9S(a2Wn9SeA5#Te z#}Lpyde~%wk_N(f#Iv=U8(e>h=9pDM?lLHF#vY`hh1HHFOAjxCJUAJWa1Aq3q^Ha@ za(|`A-_^c;mKhKg&WPSHUeH=-UPt~4w7d9b({yfUBUznClB-C?q^G&$deWX0y`%iEHTjX0V~e&xD_%h-NY6Q`B5dk zrxrOD27C1AmU}cg+6k0?b$gw9wybaBlXabDI<0>`*df=g6+uY;QyWKiEev4*$KB*Wd zFoW=UkW0`b+A#Teor&DE%99}jv&RJE#dh0w1TR<9N|(eb(F8(YASKVgVWrOey5u+G z(YEZ^`XSS@@nX&Uu?w>4j@W5BOL_Y>u(gn%g#fnS(@{w5DeU=8f{qy`T?!RI;{{Vi zG>RsPTX;pBc6EtuZQ70dG$%OSt#EF1Q`Y3gq;8?aW`WL~tE)dc3RxhcreC1}933~b zxy6%UiZIb?-|5|yM{|?Z>3++kQ=rS9?!(B=4XzR`Xyq)UM8IZkc@_hu|4-#;;v`p# zVWimp8{w)iWE<4wjhLLtD! ze1=H5#ktOF__4BiuE|_!n4Rh3F{gIY{knFVWwFKb?UMJj$Muoj3yMf&?Z=34jZpHH z^b|xJY$;uzSXiUMLe?CZv@46coM2B~kYk*Y#wIwp9Ubcu3#A>s^W1pX4$G{fRr|CN zLGd=MR;OXrNH`)2v(nz_UX@SBG?^59g`$wI6@?=Ba=kgv0$uOvn1vIJ_t%lEo8xdo zePFhFPDj%kBy@CP-@9WG5qjE8SN z^jQ%+;{D&@9p<$5J1K}f`UoMi{|l+R>-h6U)$^4L26a+=bCS)=7z{V}C^<^OoJhTi z;kzI+$&ww~-^+!JV%+qRQ-*O5h;xHljKvEigl=nQPXiAtJKOkSEWt0iWW#c9Q_2Gj zbs-zgz>JN{gqv^R$AggB|FYs_W%}PZ>@2LD|C#Nx5r5E*>^G~41)VrH5J|gTI=*;K z7GfJn1hwFh$yZ_K{;R9)aLLRE_w7yX&U{>SW6MisE~JrMS-k1|Z>8$vaXI`J+N~sK z)?mwdA#Pr~G{#v=8U)EH^H1~=2lT$VduwP3)Or)|9wwO(TksNR&vqK==0E=frGmyO~!kcD{Jjo=B#>T zFPxq4F(UMA1P@``Qj;(aU)V}oM(@ooVbSosnDBrh2lo$?#Z3H{iW0Dmqlw~E3xLB# zLtUN2E^|WPX^#e0)cuK#5Ve|T3BK-av{p^~%a;SnL$;gtjzMcbr%>&ekt;=t>}ers>fIAAcV&g>19#C=CO*YU?4JK-x`8XOZa=o#?b+={{Iic8__mT zhN9-+uHQ}3e#qZA@nRyd{5dAv0`$G1i$HxCxxSS7@$Yda?U8KuU@3Y;vBnQ6JWX3f z2QmQdK;7i97G;LdCP#{_Rnm&wAwCysJtMNVe8s9-c||?Os0sgA1_}T)dY?oOX|l1X zjjdxX7HMqSlFgl#pf5_nHdDWsFm{sps#Q}Of+K0iCWQ$R1Zr1NBj)fjkL+?Z~Aw)3kCX2q8c02eT=ug+5php0b;h2FEit&j8??q%L z6=r<(Q9WYeORQVt!&419zz1|=0Gjg1||E$|9P#@f2|-~%;)-WAa!kC??jt=Bv@vZRnorV>6) za6t%2&(Hn^U4tGO3uqf5d{CRHKBn#`t8;T7sE;|cegCFKmf z{4q)hSEkEK4qe^ww0$zdST4HJf+|#UxcjCnV)h!lGk{GHE5uX)rv?(sU7ncSOz+_1 zp`IZ90?x*7Q!D6Iu^Dq>0e|rdjnJZBn0Y6i8(Ftrd)4SCJ6?T zr!{c*V<(MN5fUbvC+%UB%s<=MKi4*X0D~jArj;(S<~%D&mN%Pbpc^LAQ3qQ-IYwlc z4M*XowA*Y6LSkQIQ!_Bik*2}w%=L>T;o?TI*q0umXGE#Mnj|e)ZnVXN0Zig7W2`D3=R|su?R-M zTAAFLIIEK&s_+oAe^-sw=>(CEL0T)3s~|lYt6G~NPM0rj^G$l2LoQE?H?w% zwpGWlU@c1VMe!~GgP-oXt;Ys`OJGf{R&3-|N}o^MG<4mKMOPeEydW2t!iPT_f^&wC zs4v74_&)aTDY}L?qL(@nIMtv~)B^bVCXYS^INHqEa3B5@7ddZC^r?y@c%*%!tlXkw zT|ti0G3GAOOCVV+a*H2u0Sfteb5K7bp;9APELmAyfp~1`**k|2)P%Km(j}Z#%G^D* zdaoO&)@6lOl>yt=k?ew^Ru{ECs#DsxsR48~G&aG8w%Y>cnRbc9KB)Tb~mM&Js zC*RvROhzMn+ya+4z4VepoIr^JnvJiHE$xsuFvfx41zm(;$p(4fh)?fqo3Sy$m){AD ziTJvmo0z&m;y?iD2OHpZJnz1T$Cn-;9C!>ogZ>$83#<17t2XSz<3~u?=T&LPTqjMV^G%V#2wGWu&vNSoI=9cW{G3`DM5v-^nwjVp znEs|#{1yoH)Nr@Mp7H?oz)?Npr=*d)g>{fO!r9f36Z*ghN{wa>i9taut!M(XRu|F8 zSD=z0LtS(5hpgROu`AT~aOm$$t`~u2oK(^vnY@cprBH*TH3MPMUtf&EQ%q<3*@4XC z9db)sCxnq7bR)Aac=i+s>31Ae5toMHOXF)k_|@>wtnT#1P}A_Cg}l-LG6#n30-W}7 zT5(!Lc#9Vw(OXZMk~4CD!lEjehd6OS{5H*vL9CzsJg73lSl9`{Ayt73Y36skC!}#jz-~CVVjg240L1xG}nI)O% z_DH>UvvAT*!>Tl#`hn-|W~3%1OvM{===f8409tl^8x)z_|EsLbyMwgM{w?yJlWJc^ zA~;jR#j`0a!EDE4pgS9?0tLsJkM;J}vRgc$vFq)gVv^EV{G0i5cL8$|bGwFGJ zL(?=;y!Iqr`GXCIvvoIE6~F54&DQWz$4o2>(m1^}W7yI;C)XyxdNDIhAI29hdB2p6 z4;G_~ukEd2CS+M)wSLPxn@_+I@Us*E6dpc^@n4&u{|#%+#r+>mP_E9el)oeB{;wuB5opH8c?~L*FPyR3ijVVA2xruCR6tt za4iD7zmAut<6ZL7x3&?!zuyhqZ;J$T-w{ShzARYtt}b`pv+)=jOR5NO;<%sGpNWpKMtG4mx7X z7b1x+J7D`K?@JglG>KpUhs6~;DZuQbul{M-4rJO(9cnxz9GHYuB+i(6Q#SKAaOuK<6a2Jccw1b|^2lu|loi+m#3E zJosEXXypm~0i|E?bCINqNC7$M-i<(J%K76X6t)Q#jDqqTCtFlg;frbHwNT7F$J zw0N>PPI~A_ZRS z<5zJkLy2%PGcl#nO_4IG>Z6Gh#)mkq=%tHIfj^dVfkc4rTO34$AD;P0#>kOQ2r!i@ zVNJMIic3}Z-j9yW4f!kGp6TA02MN|faV+KDpw>q2+zs!+Wl_PL3Fs>mocCn~@8D2U z%YRXR2)}8{(vGSzfLc(X*-q$4J2)tI%S&=$Yy*v*N&CZO-FU0CHPFKLipMNR_WtCQ z_6a-o?vc3}DMOFh%(NG8i^W1X+pDh9Mly?35z*h;Sx$i=Z$E{elHVusv8>!G^MiMicP+FT5doh5efx`PoAl~89I+}??IMbWtG7gE&5GcZ z-cb>J_v6NAoDZ*^Dp#+iM8-Y#tf??yzS{QJ<^b`tu*TK-i)X^Pu1cpExtXIo-O4>) z90x|8Nzszw8H*wItO1s;mDRd8If=6ku>I&J^Ub7td>IRBz2C7`(~*Qts+m__7x@lj z=;e7M4X}uCSyf+xxir%Le#A5uI-F&OH?23-2D1Wb*lQu+OoPb}``kW3LyJdA(Bu51 z35u<`t}7ooeQF_?d8MC}^=F>rk9mo{1&x_FrYA&Y*?Jg-9P!(Y*RyE#;W^-3Sz-I47B{M-ZGy~*MY-Vr&7 z$&n>RMy^Gx9+&psxuAnroojyqy!|ZX-NjY>J5 zRHMarMh|UO??yK)bV!Kov)FHr8iMsN209600G#j}GmPfgFqP zr(8hs>3_Moj}?JTvkt3KDFx}Lg=h|6!c{eyJym^mfZ}dvyaZN%_y|>yd^N|%WPyAH zzaa&9qy+hZjQF!_E6C9bcUTiZf@0)`q%k%-PIr>^YnQf-3uXn*>7QyI5>mXDK|thp zarP9J;wl5zb6{qAZ~(1o9{F3TvZdI_X;B|B_&G&hJ$Y4(D#gI&35US<+`17uY?#`f zxzTe`5=4;g8S$_`K2l7v`zR((K~dgHNyNerwe-CjUQ*C1WGe>Du^s6d0B{vh=xe&a_#in#6?& z7IZhajtsN_Zsqw!0t0I-3GDz=@r3jotREOLT_i3L+zNE-oq-8NUi*#4YP&S9tg?NK zvAgaSOW_v1)KC&e&hmkx=SDQRC$<6*9K~kPm#ERAu0$rRV_-ypxxzgAF|Caz7C`1N%oZ_O%N#KGIk+w9he@9GHA_M)@#Dc)q(-s>E58kk7c1z3nah-iWPYlD4th!agYS4knVsexhdzr)} z#34I;fw_`?)eTAarjN_-i1-rnKc+xvhdo`~G=;>OrS3CpZ5@9Fg6&Bg-2rlc%As`~K zQA9ReukRwa81dSFSp(|(APxKzy#Fzm*&uBM->uIE+7WaF6g8oj#D90P`KMT}FCz@R zND!?Of%?Xu_%m@iDUTNuGyaAXR6aEZoye0SycLVNWsR#(9B}dry8MMQk`^7eL3P3* zZoRR0C?k!?EXQ#4psDqM67xaq%>eXG-tDP&hGh2nD?+D}tIfg)hPEPR!8~rd&eAzn z9D9KbRc)xbtKePQ?Iu13?_9iN*q_2s+PwRE{vA<3UUWw|4I)W2I5D7e`Ib0C%!`$| z^4oUoy=a%37+YEYo)T?=4@bmuw?-)KLZTl&<>H7rn~fZ-)hS2OeyioyXme@mFGKq^ zR&p&s1qudA;q82}0)-|gu_6>}sSN^L04EMxv5ZCx(>^4Dym;%y@+%=akkFGWtqv*B zV5(QiiMEF5%k2nTk)T0|h1060AbnF(i!9(&no z>Ma`K9PwXslU3=awUrN^4iNEjaj_BX7FQ;9a%4u_C24lN6Zf(&YqI;+tkatF_X{6z zfLb`&oz56IP+fnu#Ot8XDriSQPW0Qmr0h$kp`HX5(-rkqg7h!rtuP(QNM4hkF)+J^ zP$8<3vtJ0A?X0$b2;yX{fph+0$7-{kMx15ZX__vqy8>2cn?7ud4X4>iqc4!CSj(-c zCH|uy(f}?UaE1VMAMe>!z#u>9`c)_Nr(|1kD3pIVCssRAV8MF`k0Co3m&3+CYwu1y6O3(Q zP!_sFQ40e2auFyG9O$yy>R=P(NRdfx(^2&Ozk33}4W7Q~c;TWeEs7SJc;3emDdr8P zYtkU09u>sTn{m&t?rt5vk05$Wg{tnNnCj`^blCrIH94&QCHZV!jTmy4K|AB6;n$@L zP28mUPqGg$+t@hD*A!#`ODow0R~o?&R^|M-gp3Y#E{HMJbXt;8D=GO?TMI>=b9*F% zLH99!+PSs^LQBrtQ~$MVt$kOsB9AK&b!p)O$vE&7uMH4omRvA7~@G4`Z~)9mu!_$JIQY-17#^9qwvPiD`{!; zY3_+IWa@bE7A;)G^toN1B~2V;n}jwUv&0aMZU8#%?_FOn0?B=4??s47xJ)+LsJ85-68+fYnxt-e@M$=)@61=0j5 zzcc*QC;EWIhQsLE@w7|*R=<)cAv*H~!LJzdAjR$Uj|(ova&7`TAw~{sBs0?P!CF%< zFG5AQ&%mupX0zkVj0MrDB&EYO0En@nQK8li!3|DOpQ}geteXmwr+a zSQ<6*t=-hB%v)^jM00FdRAM8Oj0N3ENdYE`#_>@I^snH7BRV7DtWGz`54I!M4RDi_q{pNzV&0Texe6V^Xwtvr57ib={ z=YSrA=N2A>L#$FxKa|^S?Val}GEMZoDf3|y{Kp8C8=gsMIgBZ9^PzRjbMh1=zd&n1=q~9GSLa)|$gI@o!!%_SUxz+}rkaSV z@3r7(EOAVT)q))M7pFjRLk$sL)k(nIO4I}lNA$aU*0TMltiQ{=>3x1UlpSIEo< zq<3+w9U_FyZK{LgQ43@`pY@pxTtD3Fa642yeItl=h|wO#hCODRFtqKb$dCW&w41^( zq%UeB7NuOcnCogjgp4jQP|>3kRBSxgxD_K2eks*;7YLJ77A|-Vn~E0!%N>hqWkIPJ zWCxtY0)xx$8GLNF(A&SsyYy*!*zFW5Gk-aZXec#tvm9)us5aiI%ia!CVwu1PRr~Cf zpDEuwk`=ho!`9Pwm}X31P(P`0c--qpE;T+ zk`*Nz7dlvFn@(JKdMUI<4w!xC4KBJXS<^_XO8}>v%uAV|Rnw)_!(M;XQwKLK{!KUk-Ds5OhJH_UZbh6TMara} zHGCb=IJ>#+?)IM#HB^Z(kREP?NaGmRMl+eqA^-Y__KMM(>_tVG9~NkJ1{p%>u%>+} zUFV^4_GmIEdyRO4(nA_subO;)zw~_l?pKs731q>QpcAahA~E$PzgRMU2@p%mKj2ew zkbHIiLq1r3CSUkdAxu&HC=@+xHhwKyOYJb^2?uc!cAv~dzw!Dyvql+nk9H4L=k^z_ zU|o|U91N=XIJ)#)y5hid62^v_+cwNuUq1>KIDvg7DnH&79*Gqq-lr)kv0q_ko+UlG z;-st0^_RZnK_f)Ehm1Tux7;LmRPiLxGU1O<3QG-|mREtCOaWVswO^h!O|LAc9(T#1 z18a*rr1Jmo2d-T zYT~K?y>-nJE-3oqPGT!40Ruza;bYQgMxj>92$EBV39Fk>l)-uK*P4*R6n? zpT@o5@)0Os`JS7A*T*}1+EA$p^BbI%AcVX64~%hyYpjcRb1$xQxb2m~U*tbkQo`viTXQ~X7|UZEzsyzWLzj-em5i{%6teCQ ze_a)S;Qy({FFW>DiNK`s!c#9q{wm}re5w0VV^`NCNH92^CzI!G|Aw?-5HxGRHm`WL zm!KQ9sy<$aAy=Jt>66{cHHKa;zr1gdV_;I>$xu{xt(7PfasF|#mb4|GUHsDzMPe4c z#z|;JL-8-Q*B~?1FF|jsD`HOxp-_ET%`{UQ7Ng{{I^tnbb!qr-5)Hf2rmPHHr07vPHITyXa8)fH zP)DWZdeet<(9iu_hfRK0Ctej>xE)Z`q}q`&SgUK|x0)dP(LAZ<8}$4uLT#l_=+!h8 zyZC|tFPhsnU0cF!mIXn*@HSuZfRaOSa%b%WYoVVG!@Z&iisbWg}5_1F>$& zXp--2^`y|PZ?vi#E7;_MBSD&}U}y@5Z|G`jCzUtr0O=PzXXU&Rv&-(oBU^WMI`(xPBkM-m(owUuQww#N)mOn%CV5`Ksj3hJUn{FjAMuia40hP zG-Kdk=mq8nS<9>hIzU=DwN#%m#i{i@_KQB<+uDUxftG5*yn za!j=Wz&s%2|9raah=)Q@V|U`a$iwX`Bqa8AdfYk|iEo^AO!DKR>Vw*vur1`|5QNI` zfR1;|>A0I416fyo3dz%#4(K3df>Hh)VBOmlABeOZLaRr}QaU~k3I9Kgy;FN8ff}qG z8*gmep4hf++s?%1#I|kQwkCEaww;~z9qs*H>tOwXKIoIKuBWPQa%I>RFCvpkr{p6m zLC)*TraVQc#R~|jDN*XtZu(9u@W0fsI;xML0JUex&Ojej%ONDeM+2ddYVPNu_js0w zm?N=i1caq6z9m@~FWWj>;IZ62c?+kz%CF~qf{q19`K4Qhr>5K`T*DR7D|hlH6eyNVHJ9YyqDhjyWZmNlJ$KH-yp$^ZU0n!nQhZyQJ+THfHl)K_b?#SC`X9Q0B{HBdMJs3a?xbupwASuw*luTGouyX>vCdP#1c}N+_26vpj8lQ zvCvS+p7>cYlV^0APL}1su_@RmYwIyl?OPX(-)-*lJDQR^oA$n2MM^<`_2T9%3?}1P z*!~ii!ryhGIu5QnZ+fqPpq3NNbAY<629(U%vFXV(+%Byr;b7A{vDgXA_NGiw*`Qpm zc~!4@LbwYun|%o8N}9_06PSaP8%G)Ah6gkB0f$y_*i*O=!OdHpX=&rZPkCNJpf6Pa z;ZCR5QNssPnw_RiUSX_2YKxm0lOaNYv>IHqhMDif)ijXF$1v}o&^AK=v4kbiBdM*^ zqO1~66hlpc!%-+}A4v#MbMe(R9`B0?WMDJH!0ucm(_b+x(J;F9sploumdP-;gYt8A z>1pjzqRQ=Nn2#fRGG3Qn44jLTG$|WiYL0{$$Vav_&^t7wBArm0&X6gJng|b($q+ol zF;SXIN0Uz9jDP`7_t9{GS6^T$Fcz-dg9AMHuKRd#v#`3JFg=y#*L(#j@}db9qQx7b zBPm$Yi?xo){xcm`B>VtO&YgV$egd&6(ZvZ<`AyYWgGn+aVo~MR%Si(D`zFq!ni5RJ zNC~*FnF6XOnhMFz`{!DY0eDANHRu>3+^??9ZE*$~Jt|SZo4Y8YBSer3$DLT>ZHTIcJ%aJ$U?bedzP`tpTl(2`e0%rq||OIR7%9T!;> znd?O)pkg#^u2|FzBa%{2O*P@Zyd8;ch;9|Kd92tHXd^+*@IOY))Y~0OiwJ(T+jtS$ zp0YpvX;`9a)f?g9guKnLK89H;Jxo)PPp?`g&lv~FqU~j~ROfJdyOdEg5`K+Iucubx zJpGL!vk$5^5Jh~0NiY4qibYRWRH z3I^C)ANVZDfd_HH;EXX3ehM1|P}k~a=yk5OHSNmf_cX-E#rFFh^j>NGM((!Y%Ghc) z^>VEI`3~xu?jMp-GDzmocFg%z1qrKD`ld@nlUg2-EX|kI3WZv4*BPpDy5T=Duzcj$ zqfP4!XGbIrB9W3I_y|oci`$HoR;_a~)xuGci8!pwUzpq-Ncx?BV;8rKHy-y=Y#Z`$ z={(Ztxo%mvw;txLm+0awK+P+BrmmEf-8?hjM%c>V2SL;q8m@@77K|j^hY8v?cZc`C zAn#|aG=)$DcJ6Pjn0wnYSnmP6XCFu<|AtMG5+i=VG8`G|XE78A6t@^}{KYET<#&fD zn`^%g4MxZ&?_tD!DlS6msyQ4A$%zXf#Q{rqa7XwfAN_M=AE&P;8@g;++~2LpPv?7c zIgro0r34)frv!r^S1Fo*{4D32#TPOs4~-8>OZ~%)lGGNdf_Lf z526OZmcPx%6T7e7Yx+OQ0@IZ1Z(I?G4$$@X8e=t*X;sQzlp0;&FSBS}r;_r%sJil7 zQ*}E85v|`1Tt^jY|4v=v!)B`LML;`>U0>ffe`EbgOEVA(e&dzM0UMNbpEM>_q@vVFpkZu~rk8qJZ%kp?T?u-H_RDz(R zNMs>`3TV6dw_%U5{ozjX3-=2pQ)z&|XD$1eU&oI3bK@q|46eJ8^LG={vKZx&OLP0q zcje2iLa)rUL#wJ3+SPk!_1}({`s=65rKc^A=j-=gyC%jdYFL&73@xgi&gCqYb5d5^ z%HSvdZ365xsmcA*%}aWgp9kmI_j8%WY%@?2fJk2Vr#j-Z$>LI zk`0-TEJK?Pn~<5Iv}|S5MlrZIP`}N-d^`A4x2{akL=uZXY#gb@T~y`KUok61CSxIoyNwL8 zt)WCvQ!Rcg+lPZ>O3T{UX;#Q`k{<4d=-M|}t=I>vO!_L@pGe>S@#MK>HR#=dIm`57AKQnIFZB@1d=}R#Ur7AYz>D zc^VX>!+H+?2Cjs*<83LLb37%`GTZw^L*DXSkK<*^x--e)sW^7Ol=GrNhQb>-b0(0; zAb}_DYVq$V z@r|27bRvl0`1!5pr8lZF6ZzUA1dB7Ye1<6r5+ex5Izq&NtiT`v1^f+U9{K)XQfiXx zp~iU{&%7)kz>@;^B6vXW70UYW})@2apW+dxNb z>qdV>r6kes7Xk-1y^A{vuyPe*LwovlU>e0JV_T9P6d4t#fN2^Eh~Uxq518n_DJOA| zS177GiiMw)cYLO3;#<2Nw^lVg)Uyy2d)B&TBt$F|8a&oo(e+8^!TDV&TMigVQ-#c3 z`phG>q)_uDm>GjGix}f`rI(eYg&~_So4Y#<`KJpMzIv=IhdkaE=a}m6_L`t)UGPz1 z*r537+Q-v>s{&KW5L@(+MZ0ChIoG@3U@(GO8HGFuHcVDmOMC<$w-(hTV9DjY%gUey z)5GB~Al+@#6<`vIQ!-SQsA@3X`^Z9@%!K|_dc|mGb$(3*lr#jTtjau*$e?|U za)yWu3?}x2E?4WPa_jrae?#d^(cQdK05gB5spl9Cr*UB&hEatuUpQWlg>Pr?5oW!i zh&8zFRaFUi8HNObL+ecv`Goyt3@_y2)65U_f&T~|ousVRoZjBl+2@?yI~J_OW!Kvi z!f$Aq`@6U79e82%!K~L`W4qNcFb?&B)tl3`a6r+s9D6{Twm4pV#OWj2qLS}Vfd}9u zy~7wM?hk%Qngyl9=p86p^+I;xpd?zL^a2U?(gWG>{+OOjlb2zA=#=eFE2MB)a^;#8 zH|{D*l0I>)Nh|>e+dQFn%D*~vUq&chy(Q< zy)WHPe8cju-&od>0fn=xi(Lh;{6)Pl%R$&u+Av^rkuvGxd6mEE&%%Q z<z^qVQr0$ogSa4I$a6RodH0%;6^b$Zl{?F?Ua(p&dB67U;+0 zei{*x!alfv7oFk6T6K%8@*h@^$9~GYr7ASWfWM51t8K@CYbfaP6#7&i@JV$IzdkW1 z=!oVl@(*v{{68gRWrguzP|Qim-p1Z|rAHz`?^6PS5WU2bb~^?a5W?-^kyu6SLuJ6P zv|zsNl+v^znwH2Vu}@!2bEl`n;&29pOw7hRgM$S+u+~1pL6k{4CH~o(K%u?Oxz|Fn z5Nfby%pgOQ$B_mqrad{8(ZqH-WtIkc3g5*l&wyVd=?t z1_DEKCjvRh#n_wo3c1@~zW5B$)|yOW{;Eji+gG04Rg=TS+KcL4Q2Px?Mk7(aW9rxj zNgsJH@X|QZdI;%l;)dB2_hO8eBw54f1y$t%JvtM!JRcb$X0?Sj<4U}J6hYxP0Jc~@ zH?vPkL7f&RCtqGxJi3N~nE+sI8s8v;gfp=Wc4N12$v}*rlqn`6VM_%I<{mx_PWTgL zI+hFoOy46FstODLkRG+@Bv9+i0}|DPXIU-JF?gc>c97w>)x;&?`AeCrfbs@xf1(@` z-yXz%4uklJDV49`GYT(;PTuu?NkDZL{nT$7aJ7FGty%V4s>U&i75C*Qou{l#)RI>9k0-<3)TTe_0!>mk1ZYpEqxgR2_DRN_yeB8;%Rb0y6=1&< zO|8^Qtnu|p1J;6K(u1?wqf#QvQNMj5Bh!c5YbVtNiuN~qHzRcuEb~)DCdPJozo6!S zM^A)7F(?qI*M~$X(*6rjWmaFiFrC`G+NE2KmA9PB>o8M{HGd`iEa`g=Smd%rPgT{K zqObHP-&+~tc)DEyq;TjXN`o-)EG`?*Z9mmtHUO+AH2w8xc+~$b+h{yb&6sIWnX89K zrdIl4D=?QEzX+(>isyRun%l>5uDfKSe#i*7bWf4{X|!|ipK9&8Ih3_^AOvWKQ0d`e zU$XuZmk~24x!9q`Bw!2dX@Vt-p)~=Gkq~+x`+GPb?m*U&i#^zY@phzMB1nwM0|zBp zoG3;QjS95!L3S8cQ_G;xYjB`#yF6v8E*TSaKt3psuX~FMl41uEST)tb!Y~ZH#HfnR z2xdOXMaaTSb52=$CtXOHr1AVgX6pjDytvj_U-XwcY|Xogm79Q*2*%VFigxuftdM?b zo4`w#b_cEe-2@O9tuUpSozVu}^(CH6os^;5>78O#qfq+IjH#Kf*pF@g^1{)A+Wvb3aVJ0g$EIg*?1f1Ly%n zs;*PFdizghD0 zC|>h-xKe#uIrIIx)aqEKx_BF;V8PIp+Dl7SRXmII%nzz!uqIKPcBpt?1YpoTEJr#X z!;G{;-FM!uDg3l&2DvSToRkS@nE z9fXte-V?sUZD~Fiar%boVz}Qv5=;IHnbrk+)P|>u;2hrWDeb<^rAmoU?t()87`K{s zk($T=@oRCj*6NLgmBK3TS@`>?=^JnOr)pS=0;jJ(@WsE4){7>yF@ZLl7XcpoQs9z6 zWgSKGpd!ty+x$WXs&UGB@Hf~q#alq>NpZdYT%4|Ca31%I=WqWXtL3jO2kY-L=PFKBt z)RhsHJTg84T(SUQD5^&KqJdK%2VKHdZWmY1R(77kOg5fnfyb9}7=bO@Hts*fNgmVo z6WUwhc=h!2iY5k44Vq?p5m1NYQ=3Ahw}gf15!g^6agyGnQ2}0FtZL9aB>yL7*SnotVc`4zs(~g03gglQ2t#lKR%o17*1N^P>l6JBZbz) z`bMUqnN1~Hd>xxGBo(IFMbDqsp*f`?l=$w^YS{0Kb1F}Xwz{n05`rEibek2WZfhIa z*@Y$}3{S5j8Gx^aZ1CLp2!q{%5b@t5s&!BuLUO^)*ox>N9Dwka=%ScpOq|CvDpd6l zZwexesQ4W+AuS$6;J$;$XAt{CTM_Q9jnP~Vb4C#rDsbV;qPz{-OAFcmqi)0= ztXVh|Gahjykc=@tezgfgU^G#KSBC6FX7Mn6x(O+;zruU=9cU}tVSMaFhDY4eV5eOb zeM-nN2-Rcd&z{LgU6oo2qS4?M+22$v|DN*cYK(VCusK|;>-Me$N;45}GR&i()OVpDEmG7oA2uccXbfk#+11iDh?0 zKWvUs<-Bi)!Cr)t5|I$6KJsd^w0V>ZQm((v;?zVgJZ*gy4RG@Wgc*E4-!lMoHUbn0 zoBJfN2HGqS{@J zT`6g_Bd`{65(OI|w3h?s$f#GVi^#?c1bbEna!?W1cr7Z4E62%~&wWTIyhDKTKP7W+JDjPLn(9TCY8NNHun zF}=|J0Dw&Jvq+wGccL&d@k)N-w=$xvTsRX85v{HY3JpS+!lF+?TEV{)sSapJ0d?l2 zfOi*p2ThOj{t*q--BIf#gP+$BuikN%0a?5leSUZq`~K^6u?rdum@^6)1D|f(jE?k> z$_uzA4!7sPW~^}u)7TCqqAfbq>U9cfTT@RvC8p+uvhbTwX!DtnRPiHBVhZ##rm5V8 z`n{H-NP)n^(*B5)<|7Gm0a{Wbv^vxI;GC8yBO4kwjznPTQ{aFFIjmM--^$xo#mWmp z#^o!(42&<#E*uKDedC^7uF7)2VVk6JSk9m=O$ib`?6$)XQ(qr4g*#J*@qH!<7Ql)8 zc3x~znOx3+uP=M~q5Bx;7mygLs>(GGF>p)E)L4f;o80SIqwuCm@|8=_Npu!BaR)_P zN&Xn>SoVj*KN^=Bz&$EhH8%xgS%moH(Rjo5cxWHAOU~o=5&!X53!*Ix#%q!@S(uVP zQ^)ZrxaYNAJz74npJiL8|AWIJ;+2tAOud#uKPDYUwV?t;O81T+#M%}E9Nk+f06a!B zpm?jRZvX)WmKF2#TtPdSO=SU&l@U$Pqu-^X*$~@ACex=6QU*sE9}|il+LV8!KLpR) zP=H+tSr9&hP%*X`pLsZrjD{U{{{3JvADA#(NKdy!9VF0)eo8<)Mt)iS?9T)f%EZZJ z$Dqy5y4SzDDU_q!%z08=YQUojUw27W~ zkF@@h68*Z>-suk*xb%>r;3A0gtJ?Tnd{xNJ$g2wPnwgfd<`T9r_z@r1x6On-j>J_T z1Bjqb`_ga4tSQ_8^fM8#7d*S{m>P>`*-lI5N3QPh3xXLRlan*Q6zoBgPoPY53tGj5 zYH2A1QBp6DwmahD(tW5dWWOC%Ww$zj$rA0T?=u+O;z6Z#RSD^ZfhxFvVApUYZaZf< z+;wlQuIDRtHCz0zkzKI_%MGmGHXR3xudH?)yIQ};P3>k(l>}yvYwkp_Mvqs=5~_nD z2P>>ik-t1x)v8`V<*vTp*(4dhh2Yb;(iLmD-u8T?-P-#oM9|C=?<{6C=sm{~Yj{_g-u zv8HzHM#q1wX~s8FP;s99Y^hu)a3xg9%ojRnh3Y9?*mzU*ghbkz+-o?74x5wd9Q00q z(n#Vk=hvgm+arFQ4yxT)JJz6YBV_`12Di+eojQ0r3C$#z#?CE;#{8_L0UNh>`L#)5 zSA5&v|CG&NZT?d>Pc60EiJmUUY0-D{+kv8v*oRRYVE{|Ddw6C?#h^CO)%g|M=%k1& z9FnPxECr^xp+lYGQ#YvbNMciL+Om%ClZ_X?$ zqX{woR$ZjIN?K2?9-PWN#j66E)eO*F-cvPOX3T2gWYOGGDcpKbC8>JC*<{Y~;b#?u zdoGE{eXq4=(2aq)moL@+zFS(W^YC-$Tu107_^h10G2Q3sVk}A`htfOJ-Fv$`Rsd&W3Cc~$ol>lZdw)xKVwGU z(b-*D|BVluiU>YA8Vbply9 zFIE+l={GO+ma&kFpjKC+u$`13I{c=v)rFVzOG>aPp-?7^hyMTsPo)zA>B1T;;;-g# zp9nyLoLF>l$2uhURw-QnX2Dmp*XKjuLW1B;;gf$OrI4wo5DO&)6!n8~-Nw2VB)IpROu7V7Un{&kKBMxfz3R|e3x-Ri(E1c@TQ7qjQ_I#bA)_3Dm_J&#gZDyff1#m z0sVFKkf)#-j(QmPw-SG)4=0sqdol32bjgc9B3n)=K zBvg*$rjnB|@!3Ch6y`5U(#Q|MmGY2TlBC8BGVj~F-96<4zea?Ui{!-;7I-+t$3SMV z5d(GbVjV)r1I>eW$CHVS;(hE*<2fOIwz8nZkgddylopGRy+Y0Uprjy4Xn_e}fk%Xd zLWJ_I<|`d7$htT$ zAH+&c#ua#=dBxVImkP%yVU5lF0E*ee-znlX%qT!l0lFb^(BX5QFeyX3<%2dIXXXjm zGOH;6D48*@xLu-1hFX$IvTk`TY3~%_oZxSo-Bq9|MBPceXaJi{x9D4JVJk{Y(6Hao z05~GrRwg0@a5{t*(+DF-H6;PxIWGKCSMc>X*K~i)h?NKyxDH_12jh0UGJ>9K#+e~H zH+wu00Pc-kbk;%@HS_aD`U?z0O6m;DtFX!9_xyEn+xNBr)!l1qOY>4SG@-vTU? zZWx~C(SFO@))tC$ep!8KtFHZ%utr7GD0qJ`!+eKfy$;P+tGvW&Bd=Np}kvxN8(dJfwENHFan z*COSwmt=!L22EIhpTRIFm{o%J(Jm++u({O^^Jo3tJQmbpF?#^+q9FL=5NU>C*GshR zYurcw{V9J!EcIfStC8g0`tsBCg^W*Cj*u)pPaL;AeC0Xms%AuY273n6hw?Msw# ztr&&?2=yI31*#ljqz}gi5q3zpjhSc$gc zpNYV*;eIDR)rg}@^yny$WgY3a0P*I$eKfWCoCN)y?5g<(xK8e# zgVOX>1wHERF1rSof}7`kiCrRmR3)Va&UT@5=A@?+GpL=d$JjyL-#Ghk${y zRfG67fQ>4y|Fz~ z0^)B4#^&l{?V9YyQ9IJ)^v?i+s9w0eYr2+u_sYMNJfr$?0#Kub810jmsK?Pyqc7}j zq7_)|3lc7P%KhUbkLVu!T3;{=*hNkthz;*q5B+A;_8Pm1h^Y$@eE& z%apb%kpd7{Je;4`YIpiwp3n#IcSvJ>P;~Bhy&oK0g+1Gdqa=`FZSnG5mTfD_G3UF- zj>g9CT7AFXGH{PzNh%}QA1t>L_`X^aIL{Pz@pTO6@_%g6ZL=LaD<5cy@TYDK>wea+ zjmn4*JN$agDOR+1kNIq=9}6!Tu=AyV-`=f}M1G8Ur`?jKyGjrn&1byw^5seKSzGcn zeSY8T)+r}eN}y~ekrcZ8`#EXKU}@5Edz!pYOQuxX>EX403ZazYh5CaE8|6x$2_`)Y zR!H%!?IW(;`hu)1L6a)vA(db(Aj<`J9qgZkiP+C@phGX{B5!BAfE}A`7^?}p$H!&M z$#b>ak3>oCdk0{t%;5MN_oL?DJ4#`i8n@9R{7`6jgDnZP>m0{^bQJlhcnvEWO`#KU z*-oW}6$XJ|c_3r?C`E*F(p@wqFkgNoX&wCb+vvD|!X;mdB+QIIA|8CUswr&R3<7O)kER zQf4JN%<99}VGp1LY-dwM2fWiZhG@lZxBeC{D}QV z-MzCT}-d;h=^EdiRbsK0Mvq#b(nH@V?5)n78OO9C=z?IK@pl<3~`Bw4vk2sVhkVp-Ygx%)((7|c6Ps;BQ^h<%09a@82OR1YQj1LMe93~H}n;GVcon=uII;I zTC14ZI;DYDj8=R+pjeV~fm_jt9BQ5Yb?#&DDtAgxo}%}Kj0%^|1`CJl_f&)^_YrQ} zToSVaw{b2*@kk?ywD?sOjg(Y(+0Uh>OUa3_UXZ=6$A(@65L) z$$98>K&o6`$TBeXUdlAEa;dRgXR7PUu`3ds4|s5T?Q@PT!|K3O;O+cVo6yFA`44<3 zlW|`%L88UbA#Y@QPdx~oVSp0u0SnWqqh{-9C$)lh0^c72Q*ssQZyynR9XvaaocHf$ zBx4b3zc2Rcb|4{J1zTRG$s=YE5=^IpEgAx7QPf#q?Y|Kh$yEoZ#OE^#o8m8UT7rP| zH!sjMtaW66Rp;8BV!Zc}wt%rX;k!Dm0f_Wt^#|5k?!WsRZ;ndI+K1mOeH~0!IY4dZ)~HE(K#BM+b;(^QR?2q06ov4j z->338GNkH0`#=>C3_?}mynM-&J9Wh{4R_Ip^WOKMSv#7IdCJ52dbCOPsS8JWOXpz` z%KV@Fo^%kXfu&i*r)gp9uD_buLIUuI5ps67awlv2?#WFsih|;zvu5d5J;HBvLMPJY zz*;~_Xdb5zqNl5Qyq^T4%;sdE_^_AYf&5r?=Tlk~WZoL$diE=L#w+i@KEJvTaOyAg zTVp6FC7W|>7X#$EFj#%LlGT@?CR*g%G)$OCb{-MwhFta}7V`*|D+S(%F)^_0D{DM? zk+V#Jgc*~mQTUA^+mx)y=rq>|Kr=f1L-7a;wh#ns>m!mQ zL*4PO-^olW!23ahDfzejQds`WlCkQ_5NQz)NyomW76T}J(^ZjH97cNKU^sW=JX@h7 z#L^F2)47Kta>Sb#NUe}FpxwuJ=Kj`9KzmE-tu+^6-r8Ux;W^Ei$J%|R6}64q=lz~i zL##bcTsF_^3Lt|2D#t?>!2*npH_5`Kme!?q{_ZIgm!A1zdhJXy40Y(Cn`Z!-bDUL0 z%bNRx!v>2l)|{4UG%lBVmwE9o_l*ml*SHS?Z`2xZ+b!!D(4#^gvga$^GFes=4N7sSi_~O>)NnR zAKsnpB9t!%zXC=^U+uCcYUsl<#-MQ~Oux)>PY?B5GBWHv{EI=YwAo0Q1(hV=Cy~H` zsB_}cy)-Caq=M!+Q<~uib1*FuP4XP|)nqqhD$5svMg>|M4kQ3bAb(SpW#ov_WX3PF zIE!i778uOJUs>DXlUNbj6N?f56q90$+i@Zh%yYqi9LF9YmumoMOS-vE}Ea7e!lTg>nTDjR(8Wk+E&+u z&}Z$uEKJq>>=TtS^y?`5x#QEoa?c_xRHI*eX4}(54-J<@9Hv7+6=)ucn+SIq928W< zk7$7D-KzR8?dyZ%MsIh#B}fGXDcO^BToBNslhXNU3vN7SVL~scaZ8J?spYkPrlZ$4 z-_bwCB!33Uy%RDjB$FA;&_EEo+(Oqd37jLprmPD9ecaX@yBJAHjQ6gFOIUJ#znHwhE! zP`pnR622V>w`ArF!g|4=iTZOl57fzZ`RDIIhf2|vp)P3kMzTSH>?HhuhsR4z#7MUh zypf0@UJ}cQpi43Pdn*iCTLw7@@_mMQ44e=HU7Wz-@zPWRAVA?lLldK1Qq<<84nPQ_ zeXXr1fc-x$E&jv_H_JB}T!2QMkU9);nqYFK@WmM&&k$Uh3@4intEtJVH#^HlWXMR_ zf1Ao!X|d3I07hh#aBf0YnszScn}Z(yxC4OKA7&1&hHgVLn73s6pe|U`HOg zJIZgb7DXLy91*na2!mg_ipuCAc%Cba@8^V4NmII$n0f0Yb$ev{kGl1baqBT!yU`}DJIO&FgZ8gg;X{MtQgE{4=UH`)c zOb!aVVZIS%%ni7f-&BS=-O}YT0FP+cSfK#Cm!_@N@w_6q&I-Kt07Amly8_g81r>Nh zbpj`+orFJ2HA$6vA93R3u32P9GsyMlv`9Drs;p@?dZ`&Z>yB}p+|!>8&h#MPfI3)H zx_!s_g%HMe^*Gin(Xra4UK25lW2iJ?tXIxg{|8EmAE~uX;@=7ER{@B^@_=wzop6A} z`REuX_e^2nVDN7ilGm@|D(J@ns!Ix~Ekgrq#S9S#WcvZrV;5vh?SPr}H$gi=71flj zPIdvkJ*agY7r|v&Ammg-|BcvM=$A?u{qr{vld$2qN6^#?hp+&NbwwewCM#$`0gaXZ zvV!u{!tGoo$cQyTtT!|o?9DHeq877U`x+V-W@;CS>s}#8k{$nSqx6LpHKOlSwgiYt zsYfv;{zkEm7;YX1Oeq~zj9uq~4szCi`?M)YF5L9;8A%qSQEawp<5Q2r*hy4cv@<+i z*l!PMbI&{@c>T|lMI~nSWSUd^*U3J@l-BhH&6fB21F}kG zrCL3dJZdNVWe;t2d>>tg7-0W2S@J!e=y*Qd!1;$okg7&oL^QJEm271&Nx}lUK)j^8W zBZw2f`*I}N~|cpIXr2 zQB4bw$nqMO8#bnOMUY!2B?Ya1!Fd78E*=>O777r@ zc_%#Y``2Wa<}e059^WP4>s_I*Gb87W@00};5UiW9QC0I*aaIYb{;d;_7V2kGO!+Zd z`QsCQ4xVMUx`;ATI|!;F=BkO*LJ5PfREAB5MYD8&z1$q5{eO&9+xLe~_v`Pb87yPX zHM@^tf}PK4{jRI0_nPJvp7$Pngs;;~yKLob)zNOt6&2IM#J6c}Blf|%)}Oia&ciN& z42M?rfZa7Nj0Ce}%Z$wjpOs_Vc6LI|h>O7u*Zu}$?HJb;UpS++4-t=Kln_#5xov5p zFK{M5K@158q#3Ph@bL~eW$jnP=B(NyY(+WsaOT>Z+4Cfs0l^ZTe~S%kN2P=SK_meP z3kA~pJO5|xFkF%~j#cM-e;%NlLSDZ$-07Rk*79t9Tzw`w+`HEnbeH2&3PxJ<>T{7k=XbI1ho&N5m>a@0%6+IsRIri_Vcx z<^YLf56Cqhx_>*AD}A-oU%31n_pDf z`lc(3zL{V{WJZyEki?~;teMJT9+T$|`<&M{noF?2D9RXE?xoxLS&x$c(WEc4Fe=55 zV+uwC1eUSGH_L*AxVS9g85e};v*3lKPWFHG^fTqf&XnV4XLlHPj`P=sj7{{=6J(N( ztwT6_Z{XvG<>e1IK2|5_X*LH#jKxRlLn~?#vXxu;OvC5_p!TNfGyXiD`15w?2x&gO zF2wt*lxn;;RMNnX(~E!{_3aa{PSw`=(d#x)<2vp3rjQ|XK{I*)Gmu1gw@aJbKM%qM z6)wmoWU}rn(92wF=E0uv$|QEmc?|jR7`AGO7OfH$R%a5+lP!?@yRF5XhLe-7D~&F!SW7(n9+a?ODrgr{KvQ z$3f-^G)+ZN7x;T{`~x7j3vOfj@Cq*W{Um^1*g6BfvRpVGeVAd70QDn5dR47h+UsR{3rYy4AeDvC2^J_;( zOnE4w8eQG}qYJm}>#vhI0|Q1)R%I^%?b%D@qCsxP)Z{%T{p*CL~YKWsW zt=8BJX0K=_qUT10KUx>jJnMF?+hz7k*~PC$YQo5QE$?ue_vF;;#Y( zYQ0S7G&P7*8CRiAMRBfY-?agZ9}9);?`z2oJ#Pk3CNWNDhBf=Ug8Xdu%Di0~RT7p0fBM zK+PYt)O%>$aF5p23@JKJuPGzDFiCvR-nt3UX~6SpZD*~&8!j(rk>TR7p;iq;vRJtP z$a*$aE*rTtZVT&z>j+Bjd_MYcYK~Z4*}v6|m|7DJwxJ!`OdU9Ovia0;;|dF1%*@}g z$RsppDkL*u8#D#ks6jsA1I^_&>L&A2ld{f7YqZJy?m45JC`Ju{|Ub^8Sq zTV;G^;w#0TT>ML&>lcuD9Sb<$w($YEVHgidwfI;VBhd^dzD(8i#1)J34m`er?(Yuj z!?DY6$#ru*m;ca6_;LTINla6iMwrxAPW1PHSPCdJ7f7riaRn0Xf z#x+<12k8Ju@$U6rkG!i|C}Fd_%_VtU1r+*j!>Gw!+ym=p=LLBkQbBk9I*Lx1BQhiR zk{^49fPtGYc%#Ab>HnrLSpT=c32s)d|GQ^u`pMMY82x|x0&0|avH#puP|8c81DA1^ z2pGjAKI#ZmqCi}hOqrrA8vk&lq`aa-DmIIhJF9m%oFq$k3Gi}Wv{ZtwUvwK+!vg%h zuyoz|c4i3pWHcI5Q7;77=f_j$({~($NvR=tB23JSJ2EY82Z&2&pxLkB7OCDlZ(LsF z+hzHE-t8gM4zaV&_fEfrCWdr%+_i9){|sWD47pXG_MUrAx#b|}ex@pJYVR-4R#l$$ zxLz$@!})Bo1NU;8Jr^{a9;D6*a3kl@8Z6XVO{0m7Gu8=|_MM8wkY{W8D8|Dsl3X)g(`{02>1K?x5OmQ7d`(a%9}$SGP_*d?XRN}o+J zQFbnA)@GSWhuF5PN+Gg~4UC-CNySwFpGe+0@hh`@hLEINVOgU z?f<#1L~(@lu}KE=1bhN~>O^-tGV0*s2v=}x<0HG_Mx6eteY%E4#VWm;;@A+qOZzF^ zL8r>J%v%lK+NxURE}Utfc~Y5f72izUfc4OKdlywvc@w7#@CJht1s+|PjSul)#L&v)clUTFoBtr z^GUkEq6j{j)eZ+aO)SgS3J;PtAWr(5=NvL>Qh!)trJ?7YY*;*s3HK7Ht0rzMeJD%C zIEN2&%l@T0Evx78`Yc);imBLRvMV~73BgBuCqh~Brh}*#>aZdBRQj4o+Z)1Xcg9>@ zpKW>F1`-UfjJl>{l}b00Iy#Qw!T za3}?61=yG|X9?uXvp(&Jdt74LgE)v;qB-O*?M*a#=F#v1B(a#M35gA-53xoR#BXQ_ zfUP*KVVGb>@;w2({z%98AvL12j!Cwh@5F&XlU*YEZ5h6mkfL-@15`u+)$ z=X9^NNcSGc==EX#-nlS_!x+W7&$%^?egGFSRjo~?16i~024lYutbcXL;E>InySm_< zdIWWvfvIK0sOX8&U1bVN?~kyQPp`)23hk+U*mx!?i=eol8}0Gw8S0-KEp@D3A}Q{g z`GYd2N(TCK|qB4p=GqcMk37M`5osHS(lJ19rGpH8n(SZ|R zP=e>}pe?T-gZZ~`e!oR0(g;aYWbwEqtM|E-x-$(R^LRcBr%HCZa0_DSbKp89D>a8g zuJu>Ffjf6c{#Dfpz{MD%Grg7e5aF@ZHI&Hd~(kQmllF#NYg<*uS~R z;o)j{QTX?g912wi2}6UMQ8RT%wau`Y>X_%mWXY<)nc>s~?~c6OWt9DaFR)LEODQ^R z2(F@d@?1~O1re?4ntDX+t+{m@pYxDDFN;g;OuQQ%+=9BI+2rG>|8!6$ELV~16 zmCqt6_7B3$QXCOc%?Y^x0rqT$uPOlu5{ISFQt#ote8;uv3Mu4JY%9ZbW`b~(MdWg% zStZPa!bYPe`uHf`2BR-ke=8%R26QEJ<}4%EpCf0DxS~tkLKwz z4DpSb216a~jp4Im?wf}hm=OX1kd@vKmsEfSxXo<;5D3meSW|<6usQx5^mzMu=p1PM z_E;7kZL+jDN*g*W+^!WKxqXlL3Msygz$6iiT1RSHpk3QP6cBxQI-lytq< zG)|e(W$W|kj1OJxnnbrjW{V@cFF9Og3N&X0_p;ripG3d{84FlT7<%Uh%$F4P4g^m9 zl6TJQ3jjSaoA-~3mGA8mUVsb(Z)Wu@|28Fdj`K{Fq*GUi^wMPifmcvt_~#e*5(mg4 zBgnM3D<9y$54`|hH5ubvVSrO=I~$aWg_(vu16-@kc0?i>{Z~$mqq>|6Pif&tzQl#M zvW|?7EqJv}N?j7CXrTyG=juJ{^LqtctGrq%6#Uf?%y!3{L-!i+LSasHF#=O)l^g}b z<(BOJGVb}p4%2N9rP3jGP50;#VzM%(h{Pi&4PuXl2GR)l?I~|9f%kEo$z-ilF_GfI zPkY_N%g+*7{aGSst}bAy&SW)aw$%{>Z~JVNp7`K{%vBg+6Za%4a&NbKKxfuy!xj9D zR0-nb|K(lig7e%g2GrhHv#2;oS61GY z6`yv~H*h@y)xtZ?y4G=g_fb9^ueh8Wi%u(tH(pzL@%o6HispsaW2JExdVJj5lt5?H z#Mo3>U(tP8d64#0`I}%+Y5CVbYb>2%==qQIRR!p&n(uGsrNS>~B``=EsGcM$BV+cJ zG36{M%8~;_V)2u(@MH$J*xq>6%($NRT01b&w~HgE^0F{vVVSYNW!gb&`tFO$EMsj& z3GunY^`F;}b{rS?QJX+xt8+;mg_s>U3tquqc(frq)`#53kSe0(0*Ja&|IV?cvdtHW z@NRd@07t}g{}fG?3t!6^jRk7@_vhE!I!18}o~Fkg&rb~N zspX#a@{fhiyAusg@m0^6p?XR&7dxD^-+-o1jgsWP7K`b__puxOgi5!Oe;+@dR9Hfe zCR#IF!*;&w><@b2S&Y`eRM;$It&+6l)pk@S&Mca28$m1Cj#tz6%;xOaqDpD3f4PA$ zY%k04FCJN{%=u(qk6-aTG95P%WMa-$O3aw^JAJ8;zoDzA13uJ0TIE1KU&733+GV#| zY}&Jo;g1IMaWXPTRQ2@znmX${4o$ycJxybU9*xmN58K-9*IZgkJB5vR9c(RjoVi^9 zCsVIpIOh}8k~M`<5-qSNZkpVfZ)G?i_qO+2MHN{AU|;xK5R5Q3o!*+CN1Wfl_uc56 z|5d^NPiZO4?96QcSHWNXK$#aLf1u3zhJBz2QIIo31iVJHMY9D3^C29%0Z@qYe3n&j zC_dCvFjw|Fte7Qk4(q0v9>2*GPn@cEvbj%ImnmVj89r)!$Lg;FX?;x|7-5(v_#z~Tirl}n!md3``=0@|A*Odq^`X-W``91VZv=Szm z8{(3ziZt}mNW;LM3dTeQNH(ie7E8h!E7toqMUtH+42fZwRNBqlRMiS9C1NGgv!!AP z?hIbEdBew9e)F0p>z}1qaI816+qXc$6~bo|A1lquAwNYA)Au=osB1(#N=vOEc2=20 z*;Er=+mQW{#uW1RImb0^1>7vNNF6>k6Y|B~cb2kCEf>1hORso6tz;N(PR<3zhS-qK z-62tS-WX9Au<7z@siuv^ETB*FK-kj#@j87D40h%svLhCb>7APmKq=VTitoymRfyZ> zu9=A|k+6^5!BzBukq~ND#BRJ4*KQ^VKA+eg?PGu?2Afc(JGaP%kz*XMrvflBmo%7; zwNl#4Y)+$kyx2H-@p#ryLgjaT1^6_@T-U#;s=BJ;@DG)T3Y8CcVDU}c@GUpqM2RB` zP+D5iF~!!5lV~sXZ>F2V3MXWJx)IY#HzY>Qcsbw~#gxt>=oI=HJt{<{5ESnJE_8o; z5uVI~4Vq8u>bff!y&$uXw)?nTOY3O;j;F9~W5KpB+_Gudnd$m7K~H)u&2>(5F(kpd zu|T@62XIWJbVVtOl?2yubJqN_SuEdfr*wEoKMCLl3t9b6&AN}5HFJRFD^|Po!|_Zf z#k1KVmK(Z0aeE)z%X+21|Zp3so+i|G} z6z7g=ZJRhNWkOvmZc&Ap-B+w_E5aWbpKLznGcqtn82t`dRTdfEU|xl)P*%(R&^ERKN7pn#>2lzc4TT2 z(1HsAE?zdDNGg%pO)kUqFUe1FP5sNi%g~^FG3iyIolamz@GG~{J-H)%?t9_VU9#cE z4wd|yvh6yn9b^&?JGH6=*5x-rs0xB=xX3{H+jK@0b#R4fCJ5X6#ocOceKmx}7GmBx z!u=gyW)3Z+QI#~qJyjI}Zm!=BZ2pKQV?`-Z+LkrB6@NT&_4>A0j!s;-JuKBerZ**LP zkF8!Egfp{nCL>i&PdXr{RM1_}`Sds)Lfmx|Nh}GzTll`P5StH1a6XXt@vkJOe0AZB%(-dA-7Dqp0qVxxM))ahz)~Qe&BaYGby$%47rrjn}MkjD3xz- z91lX9$FSbx(}EG5SHDp&G53}(uxi*Y+!_Bc`dmgahH)ynFSO&BCsjHz>iZA`dCgUD z7BjTh;LQ`nSLQkHWIQP7go#f(CoXC$CEG-hwH!2;c~~YFRYg$-QEGEAnACpo<)w~z z9qD_q^}*2gZamqL^nniD)pk&dMTEs6!=F0V2NB10nmN8%J{ZfI>qqb~BT z_=@qLcC~H`aOJ6D|Fn|XYoS(w|C94FBrZnwa0(a=dj23=%E5(ht6su4&EFErdoP{8 zq@}O0DTnfc4Ex1LNZ)hK!?vyZ&>!CR6jJG;Ljr*tknayzgIk9I&_i~Dt;Kl!)xs1@ z?JJWc#O_Xk!Wgg|vy*^TZbCa0l^*?#dIo~KZAHDIt%<#-RLyzZ?u3PH39ovmsM1Ki zUsnoTQ?5UHF;O_bQ*LBPWYuGF7N^c1w{tZeT)ej=IrAQ73iI=do`sXT{i#}u3( zIvRG%m^LSDv;Gr3`2p`&yEFA)e~kYPZ$3dERUh=78ExDkfg#mi9jCV6Bcfo*h5B-mKl3rA%8x7Ph{d|0+=e30 ztcFh>3`PqodkKCzV%yhE7>yLp2YsVg37qd2^Ij&$FEnHpXi-UDt(BBSROs)6F*3ui zVjU{%JUY&04HR$S2!H$qn@KehiZ_#J5}0P3p;XHbYPzLfqhTb>e&tW)iDLYt5M+!^ zW}ORvaeWb*R3IIedEf6hgIujZsV24Olnc)> zCnn981Cm8xu!Grk3^R-pmN??epI(GSSqIFj4Q4m9b0-mwHL;9lHU4oqQ7YnCH?=h< z$&pp%aB)2C`H=Z}^oi0;=7Ppeq=c!f3=f#X=`39%zh{A1 zg_DTZC9y)L>8t6R)Fz+&*gDThFyV!$gy~%BF?fH&dju^7^0IY7J~NRJ?2XSlX^C*Q&w6!ZLiorfKRu}nIDy=BKSiiM+bW^*#dRWO(=W=q- zV?AY~rZJSxfnGK9{yo!;P~ z&q}$*FeoxIybektKDwaMz^!v?r;wa7KxyI_RP)tXEKYcGFlGD=LE$xXWLtN57elPZzM$3dAo1nGRLbmo(kA&-af_Y6Zb`j7(*fIgWeSdC#TjV7J#v|Nl-!USB1Ncrj5I9V1Tfdr41$A%OoL%UBSTbULvVZV-srM-|B z4n3@91XzUjw~i70Pt}F;KZp;&1K+L$XRs~r?+YT+c@{@>Fbo>znMo6x8fV`?J+P%H* z8@cq0?bscnZ?iC>X)29~RjunUz+bHB=9?8hSEc7~T4&);;{l)omx~|6tdfi76<_K~ zlB5I=Fge{B;E;W1?}B=GdGN^Q@rvIVj=9@YU1zh)j|ih57SXQ?1hkS5ErOr$lBFQW z|Lq51``@VZEG!)Vx91qbUbEXAz2nzsUJVOwV6v=7B+gr87&S(;U70)jX9nY&sSMKP4n35MlC5rajZu-7nf3!3)7CqjZ4MYj{yhAeT zwYY9^w5o6GPx#Gr^fX%Q7wR!D7i&cg;zC_Kv^dGH$JMhT(dfO>z|Kn|SG{9e3(iN} z7c?~0ggp6i4y>|w68!!$6>e>}cusk>DEEg7_E&*O5HNsIJN`7P9=U=I?fG-Jf9bjb zXUdAR9pU$O_I2vy;`9C||NFx>cph#qd^;hka8k*Oii*?(yl}CY{Zi{NvhcPtL`w8*k%2N* zc{6E{-XREE18W|EKMoI>Ap`LiwY^9?>d6|rS6Ky6wG0$Rpis)X zR2b$*icm02k`Rr%f}!{rqVP%Bg1}{k{l(hS4)Fy{q5`ZmAL*(BB}bvxYgaSfG==FK zgiKMBLS0xICm1Rgh+>8|O{EBBEPT<6Z;=T-MFOIE5%r>>StR!-Q8W=0F-!>lM#m^H zR&?h?a|_r`c8JX*t!ym}n+3&I<1}dXL--L4GdQKljMfVk%LAu@ug!WpxZqpa=h;u8 z%yYpux^Q?Tio7;)Wecu2J=s8`hSN_zs@Qz~0UNp7lj_UQ5!;C#sG)6b6Y$Lv6UG-B z6m-g#;KJC&y=M+pfr5zLlW|z*Ayh16iItCJg9gnxy)lg%U911GTaRB_*8_%}KxJ%r zv*6!K2GjDz%yuS7PWDw0hf3(O<@#+LSwL}EGBpYmOw8#)bhtBR^q|WldorMu4MzB{ z=G7?$FenOXa&pzt!LrAEySs`&%}eO`oCttIg;V zteF8i#avUH86sdd3M={wEO@7`hkI@k{OCuHU|;sj=r_KbGWDZoP*<1rh}FPF*>^AE z_2POrV-0P`(5DW{x*tM7t4jIZ)JseZ^)DP1W~xWG()+2-Zvm?~=fa;f4lV};myMLL z+``>2Ut{lr@pIR+Oj<`a!pcUI*IIEx3ns6cM(-`~x_LYnCmH_{uD`korr z{n%mw^H$S4=uQ9NOtMfvUJM1Fc=u83l7t-Iz3@Vp-OgI*wAPzPKAEm3|-M2u> zP4t*3Avwby#2*hBC6Olz$qsFeb;JBkoNW?mF;!z;o}OllC*i!#U}Z3w97kDsLa1yG z#s0+`qsGaTjKnfHLPbGIRe)3>X%tBI+`VUCkM%OnR)j94$5dI z774>^;NE!j>4%B8g9(Mb{PHYux;+E?Ch{l6>c;=`oU@iZ|ST>4SSnk7#t$Q z2LEw%{<0R>Y`2yr%A)m(&oY-tI#Aq%3hY?ArBDXmy>@;G{Fh6WvUSJVwO{i0wy~hl z-k#mny|9>i^_2mVyd;^2VL;KSQnGWZz#lCB9I|O?{?zWMoYoCos2XDho}~uGNWxnx zJZ87y{_X48NK5u2E)d?rR#1FR^i;TBybYS5HE`=oR_}k5Lc^Eb&skk^W&2E*hb|q? zZmoLRTw5+Sc}#V#lcKYuWmU~rC_kC&+kQi z*O4q^3q_vt+_{czK1Ps=Y%_#$;%p}40euny%!F&-@wE_lvAvB;UV-i& zW^NS50E%|mjhqSKzXdNF0gfg3BV%c?p?zLWPF35VW%&TMP7f=BY%s0lsgu4(%oZ{D z3nD4P);&_^U6*Co4j^!HF9G$SPu4NEB861*w+OI*uIei)Sx=)(f;o;OZjZ-CfM>xE z%)zu@TmM!0{7)orW>)V1R6ZL2fA9P;t0?3)(B%OY08HuTk6|0I3iGB22*A)lv5r*r z;9@p7Y;k`okj!w>K@%e$SWI;GV|{=>@_h=&><#lk4(aLDzUp*`y_teMPXMC)CEPi* zPFg2{CGT-bUoZIayy3Dl?iGq3Prvk+@y`CP*{|sejzIj7VJj;MMJf)u%4dz^* zZJgtw=kRLTM@HsAyhF$Rs2mZQ8RQiOX2~GkpWL)$tC;=~Jm0T-1M`)}9)142Q##5B zX9Ee6?v0@t50;^F(b|;d@u7*?7sd#IsS|4t3o%ELAS4z20;&h(va1y10#MsLqPg%YB88 zYt^KSC+hdJt)3)+>@mwnrC3bQF8Z&^s_JJ|IaoTk8hv~QuYPvBqVvBR7%$tJnH4_0 z4QpNw{Rx+%H_M7zumcyW{6ttA9G<98xB#0aw%4lriQQTCW0+EEUfXKM96y|X-KqpF z!=$c2b;7hS)wFoY-Sjr8$+|%mDo_RRK*V*#(*7akiROx`I9J`P;!Hl}fBTsqY^Hs( z^}&SaRSoAjx~MsRJ7=U9AO*0i`T1TJM&MJT^VxgpJc3P`@N12hTk`W%K3Cqe{-B*x zjzS`GgAwHWdCN(+D0l!q_r$2h($G7DH!kQ8mvI7cZ$7^})d3i&q;4D3ClWj*&d4%x zqlGJzH4c^I;PLhmZhE=wmRXltuEl^CxfaN6)~l&qt(A2XE81E1%-#qX9eZMr(h}%v zp|dX>CAtV>Dpj^j+kq)7K<+NT+ZKqkgJJe{mskLabZg5)omFp^;H^HGAfNr#lOd_jl_81e6;jOznJif z?Zf*~RwYyA9U#xxy`6EWBS?$HoAY8C^e_Qd>W+iIWH_sSpIxp`x6dmkFnrplS;;SP zGiIq5V+*j3G>GL?C|BG>(mb+vC5f08Hs?^H37-iUpDh|C` zr&5(xE-Iq*XQxIkhBmYH1L-`5NLx%UpVwJ(m&+b6%vc4Bh)AwcFFq_`$wu%UNOVm@ z+RszW-{h8hy|%9p(C3JGUsPH1_jj}biIpYA%A;J>9@*Gyc;4D}wA3kIyCGK$N^ zsA)R3sw%e(&V&Ux`(zBn2Aai95pt5aKl8<0$kNid7wwF7X0`@YemqRiO985pF78=H z*KFgUFzdo_yw;Rpr-_GD76bVrmb}+Hb~dPNz97d@08`}v!xh1}U_UX!EI*1P0ojzo z*HxT3pzSY;$U{kX+sx`zi6YNb&8Ts}ak@!N1n`8_`^49$`J}AS(>dh=G!1xX_4qRQ zqj0bu|5g1f62KH{+sb)2+bQEoc0T z$$#CHvHef1RxVb~|7cp(b?w)g(0q4l!aX!a$UEwCZqy_{4VH?l=lumz1i+Y(=vUdG zD`?a{p1A8k!BAkdOF)!mFTJntx<> z5^IQnc@NyQc!S&kHZzs{miaM0W#B1G4UQ?41Nn=X!YQM7as~KM=#T{7 z02c*R2Fh1-1UB`R6F?+|!3?g1q(BuvNmkcAoy-^v2CE{3tQkK`I(;(KenM?J#1&V; zGShcFFBe+0-J*(iI6(Y)?8Q)gMxxG2mp2N9go=_y1tQ6eHP3Y%Y5i|%KG2ZAs@U26PSYd zIUBKv+6M9l9NP>YmO=BPL$9%oFeyEPRy>!uQ|q;CFg0G?oE=(%5tnp`AW1P-5s!SB zHL(`&9m}ANsA)Oe&8_cN8+X;kiX-JbI?aTC=qU(t^F-=UKDnXU+7d zMbXK(TH-B>zrfrLN}}uQuXAo5z(?Qz(NROhq40mpHOhDb930Hd&2v57j@Ndbg#xks zB;%D|VuH>{xbPsoN7#s%r}v}54kr9Z{h6{Iv7^n+_ueaf*2*Y^qwAP(#loElx@#)5 z=FnZ2#4!(cK;*&XH9>L#Fw-HP9qyAHTY;bfmg1m;taQ+v%_n=NTXgpf!aoO`{M(z~ zT-~}f?+SK=rrVQSSyoNyrDlgVGo%e#ctlW{P$x}lTju7rgeQjo?$IS){m0r$qO=z z?Jh_9Lp&Y4-p&r8KK&f-Cy?J>&Ib18B4i$Wv6~sH+Pw(~KXj-l%dhT-JxkMy6aSTP z;dm$9$F~y2mdmpT`RcFAG8Wt2wd%ENF2&H~#oU;)YfU{@0k*!rEPiX~DplzO9&UAX z(D$7W)f^*uq}D$-xo5+z(lB9ye5hn645kX)&t)o$_y$uqI7(WMi73mGdD44ozHKF% z-&!fV;4-(}v{!5vjn045FO`mdxmE`#m`k|K#P-edka5M3JH#0emof8m#X*BYlwmhI z`Jdmqu{l}49uw3V+V$J~+0GE!=oEJiSvS%HFP2Kn9Yo(LAT zXyo_UWC6UCSoN)EV z2aHH<{;j16x> zQe`mzoU(a=Lu&s8EIEMa3)C+i<@W4$~>H zd~LKVB4&X6T$GLe8xx(gJ$amyjT*lxMudk_!cBPqNk$pJlwSTTvc0G$`Ct4T$Gt|ejeCr-j=HhjS)-)PI zQ=N2Q(Gb9I4$buP@g9FE>mr({cmE%aI2G*(IsJ2&h z@?PgsE2x=haKlp`9NJS?`F#H6Mrr_t{94B*^cbuP0S!tMEP3r|&%Do9xZVnG&toxg zJAoJyo`29i%2gzYsC3`VZkm|z+)9%V1~*j+aa2R8Dd1Ac(b9+ZZ>9T!LRV&=u$XP* zhC058B{blxT1n+a7gkayCZiFwf<%f}?~D@x0&yj0>$Kx+Ts z))}=al{naqBm9DBvELH@uT}ehqf)W5{YTaA(zN}-HX#30?K(*TQEgG4h{Em7UVmKP zs*Q?;^(;_?mgj(FCtKp*mj5u{bq+_|Lq)0!V=gP5&xple>K7f%UM5*ZrUj+~GZ4Q6 zwI+9G@=UYV^f4OHElOv?o zB70(fHj`HOS;`pj7IY{QnMZpLZAiJg*;50(W#>4!A>XD|oeYbc=+V3|C%!M9Rx`og z$gIlcfJF}AhyFzd%U^%GMuM-Ry$$QN!;7trNhR9;_CG!mKL^g{nsifGZ)k_)ERNCe z5b{x^b4;hJvm)!^go)2L$FC{Q%;nPE`4|F{n@Gw`m*$JbJ13H6jU9m?BY7Z9QkLO} z7PD6Jj$RyEAupafmu=obGv}j6^l&tBJE;jflnx#Bk;awpVyIyEWI*vE=7^0-)NM7g z{M0ZI57BrMG&lJ3<#r|X5`WWXHJ7J&b0UgJU~Cm?^v}w8m@K3I&Qf2#Dr6Og>gg5! zM=a(9AI{rY_ZF_(=XJ3VV(Y`**h$aan-3z2Jxpt0k7r+mL z*1L~nEY|W`j2UdamcAon%42QC&h!{e0oh@52C1`TB{pCUk8>II6_nC`ZD*%?Wmp?J z{VKE@Jkl1Y;H;c48l$4v63p?deQpquGBku^A zqr7Dt#@#h%7GM*T3s1l5OLCEwdur*pB$MNS9mFK-R`}?eTx=s@07_^{%Nk)(>(hT* zk>H$$W63993G65hA=CjrYo|Sk5WDO~e2olDzRY6n+?6uV6qZNVEty*oJGA0tH<*^h zVN3vpSfpS#lg7euS@3C$Ruhf78*dFaO@@E)vzm#PAZmJ{!xP^l1*<4wT7Fb$6vtxf zh4cTV$>gxS0-P-3DA=V3GJ-1Mkb_RUutW#hb5e!PdHle^2-BdpBv3FY&CV_U60G8x z=|vJzta754b5LZ+N8$%1ejUMvuk_iUOM?_uiW`*9u_Ft@jo<>pdn@~|@npS>h3Hn) zWFfR2)P6$Uy#6PHGN3(cC_G@1@`l8pa>$vGs22ev4@gP#mH*P1tHg^G)+wqU@7J$V z&YBKkcA+Li6t0slVJ}}`-er~cHn=BLAG~(`73L={8JoWb;vSXp#saF*VL2*=QG4Aw zM$J0&IgXP|b(kJp=)Be$nDC$FphJ=A<2QUEKytYWw*I{XA`iT(9b-VwzZ0sJDti6` z*DX+Wh&8r^^i(|9QR3g!>3XiD(1z40Uz50y!8KSmRxlSklSK6uE0x_&tO?ZnyU>V` zXl$`N0EQLA<=JPyaOKt5d%BC+wLMuawd05NdRHey@CbdTdbctMY%WcYAx9sJ5Bw$c z;MVLUrR21=g?9uEjw7~yv9+ja5Yd<5fne0=kD5>?vdHD8aEfhj&L5Wdn9l`2*;$QK z=m_-lw5q*OlM@?xYkDDq6IZ2(OWNV5wEWz{<)M!wF@Vw40=NVj)9%5KnetfJ8<|wP zHK*AlPQ7f;Sy1}8pVZb-35+_Fbrz6DOH@H~iZ_G-Qs8#u;ev+i)f0dDPD=&+6E4@S zKpiGc@+W|IIduW@bMRO+Bv0?x6zeZTRp-uXEccta0-EdFr6}bXRdxO-X8$rF4tn8A zg%+9~lBZV@Uw+|1mr+W-ZIa#+1T{flvvw*8FP!celL&w49>DT)R4rU0*%)|Ff}9K{ zyTW-yKNyT6dRQwilgJ!I22pfxcsh2E(e&gkO>?2GY1CmM(9sTpgZ#OJ^F#f{z8wVy#y`c^9TN>Iq(CVMi3W^n=KdnRy94TSnYCbg zrA0~~Gj6f}-oz^fMR!jQxMxAo#>_|mN;K;2^wc^_w8&kOOxE&qxAA?R9p2|@)Kp!L zRC(|RV67rik~(Pc&_&(R>Y^G*BwB9L(^NV?qWw0#jy^u%uQM4bC;-HRD=oay zy2NgG_h@G8`*5+EYXgUDl5RV?*y4rNGXVfh0gY=mHrNfz`rW&!~+6W_yZJiv>EwfSLf{bb?}dP9&*rq>;4G0_UO>ueb4ED zii$4q0GeI)uias)!3PYDALwOT&3y`pK{E!P`pP$Hn~x)oLi|M9qtWfVEV?^3HymqCgcVO9gEpYV^Hw zn^RN$sTNPsCf3jq#4j@>r{?s}6NPV3B=iK>|EjhACqx!AGsk}<3r%U*+Gj~3efjl( z0Aw5(ZB{WgYs)1q_csBBT;;NYO9=>BO)=w9u&psgA1_&^n4tXGs%>mM-bkb#K zaS|BDlbw?dRMq=@v=Z)p`Va#MPGzvUM{vU)pMc9ux2@lcfP@RK&>^2gL-md6sUvZ^ z9?c~`TJcm7JXTm0{>&^xj55PE1x!zp5jX*J&mvoQDHg&hiSsMDmw#budZoY8&&<)F zKP{UkQWN`d(;4REK@KYV;%^MCd^oY5<0YW|pOEfi8b5{35hIvc1!%6k$aHD=7tw4l z3G%UuUl|tA_A61Wl`N2&4Feum`v8+YCuU?oCG~t)G|oHmxmi85TGve}P7G>u0`$?y z&R9h5$W3*_$)OV@n9thu%&ZFM296Y!v64)MR-%Ys)74ws^*p=y80e^noY4{@7YdR& zq!=WNb3{Cs>yqCTCv1lnVQ3PXFrRSBI)Vt(Z{>p7adbAUJK1PrdeJG4wR7`-V3TqP zj%fkedYiKHO$wjUGC7fQ#R9bKbH=BEI@pX4m5~iOvk4n?xcb}jL5K?qNfZW&hdUt* zr9<6>{5#|Ra%x4ez=Iuq8>uMoglx~P^?~o2{da|?=kk#Kk9!iwTso8zXS+ngb>cx?u2gC{)9wzNfC5xW9p>j8V!ThMd?;&c<45fTa zge3cNEx-34aq0Y&PRa2P|7HGIH&(D%;{NdKJa;WJA;{DK7|`wXC>u=c4UbW534-UQ zz7vs(>h$R+MY1xS0R@@5s__mLKsWq~5f#ZX$39WUr}Rt5v^?ZWfQM>|1EqVhC;2+v z^%Aq`C~;>COjosz++LUXHt6_Nj9FH&%-r=I`DLewAs?=MAH++79X4w$R({u&gB>d0 zp~80g2L$M5=(sYPTEmni(FXBhE@>G5;XtBdnpH&-u^<9eZ&ROfWd>*qca3S)9ei8m z2G~6sTdQGH+F0{IFH-2U3vWU#9dQS+@1?k5lME#3h93W?xvJs16g(=IjkLTdLnbcCC}@bzPYX?u_Gj$^y`yOuvd zbX%~0|7$_}pHMc;+)V#rHUB{x$8B&Rbw6voERKr}-jXMd)6W!$AvcaT^OJE~kgsD{ z$;1+5VV%a^+!AZ8D|T!bQvGi1RW`Qd%Kpikz%~Q?q*!5nktT5N87^yjp zG)Uf0uB_&uEl>~6Pp()}yW`l`soK&1Y%GW-p~m*HEmY9&d3D5R9WJP(+1w9X>1i8! zcylPFZ8)BrG4*zt#{}>c(~Q3dRWGZG=PbRwpfhI~u5Q@iBX$h(iA6eetUUNGH~$sA zKTQ)qX`fZAo^m!?bXUmrkn{0^>WqvK4P>q;phq0(igjIBjQQj3b|^|*mMpmOFJ2%Z zIQ|Q~hQ6kv;8L2)O6Z>|Rh#NgfmZUrVExMCB{{9lW>ZAWwkvI z)=1IwEpf_;TBI7f~jU>8%wHY1Og4-D}8CRZqSfq#H_s7i(pY66Ef3qQ~|^* zBhf)sT8|QNpk{*o}&xcxcv3BESToxHDD&np;DidqaMQCXxr@C{EI8JC^S(Gb)h+n`<)ytTadvQZ2ik)Gj07r>9}Z1p4Z;?jfOM!d;0qp0d>3aUsy|Q zhUj8Gkt#H#{2^;$F_e5_<$>sIY2`AU1gAA{`;#d$p-T(sIH=a%o(cBFRfVfGsr{ID z53;tnyVh3r5<08Fbf>x3e%;|Z>m}l1gdSJ3#un`1l5wY^W0BT_?(i+VCy7cn@9B~Imd=9W z+U?(J1@8Fbo0BO7XvgQK(5fax{S(?dlYpcAQA2c0{l&+$N0(@G%MU{l2lj`8;L|3N zr|u-R!-y7+dUgWN*FYF1;!v}!KQ#$#95|t2vMVH;8$~6#_+Qhn#Z}W@gMSzj951?x zErDJNL$4F8D#5h~Pvs`fQ)1f)ZHI0xr1>~Wj1_*D)92I>^w+P;sR!s*_SUfU11MhI6au6*Y#IX`1JihXSq83d&^Y;2|-!Y|_+C z?Hgs$@az<7>wWpGH>=d5AeqTvAv_facF<5tgv#P_B^=Y@@xwKMz^Ug0aTnbNI*2q* zRoMp98x_+PQa&O-*zh9#7MSA{c|m$?V`WaC+EyEQFh^ZJd)y!>;bFCCzfpK=eF!L+ zr!P}_D+8^};C07zGrmL=TuiTHb~IOX#C|iIEI;R>V4q=F^Hj4LZ$fK7yzqjgt6ZLY zv)ce-cU_&}ldYC*jtB8C>QIc>L`ZY0M`9Xm0qghr|BtbEY|b=X+Hhk{Z1ah2+qP}n z*2K0mv29xuXJXs7lbyF}*RH*))`#^6?vHnOUw!s*G%_}4*$r$WPC}m~^v;3aap+@TIIQUWfMn%Vm8y5!y*7?O~aJyu`)$td#ytt6v2UYH*J$VvUY z6;$Kquf5W~nN2oi*BKAZyP2+he$+I3+E8DcdviS?LNjW3o$i`rCqpc;D-j@#g@>aX zK)`i*V0t*D>G6b2fhLUj%a*O?frbK|eJ?sIo;u%Oa%6WBU{S{+1j)2SyMqKib*F5; zk6N`AR>CS>f{WT$%P|O_d%!UzB`mt+Q|3{fB=dKeC#$}Y(wUu1`)_=+nXLip9mc_= z$LXD@L~Kqd78_rNk-i&5E1BX%%=dbGzLL7*|p$=3KOl9mtg^i#+5_nxD{A z<2afVbM;X>-y0{|7$LCpJQnpw{d`HKrp4>R3XUJ=ANc5vlNx)QWQKamQ3lw-91IO~ zi|pAJAj0`SA2YM@$%Z@5pmi=?5SCWPhogCwP(~gDyt|Bov%uf25Yh-IU~4-nQy>J` zoc7OJzc)6w-_=VlKeHNU?NEK8PbXcrn$ucd+3rGmu3EJ($y0^fH($q%@oROZ*$C$g zl`sU)Z+z6AmR8_ltGwMh-t`tY<$U}%PcCLKaZlIYpWffyy$ZWQbFbFDHbiLb8-95a z%q7&kS?!Dv7sUv(lR-ex2gmFjG+bOV&E&pbev%yD6k3{sY9lkMwtE0Q1%Pgteyc1O z-V~J+Lf1V6N=&z^4{YkewW<#NN!h)vI$o!?v#(tNwX6N8MziQDwzXW6CfFJRt#)#q z^F`}@=%M<=xT+*1ERX+w@kRUg--H&N40%1y{ocz_kmwXJqM6ipMSHljdOTf=iTbs_UmjvN2axiYz8S&@o1t_$#1D8lxO+Ubwd^enS2!J z#=n|L<WQ0ZlQ)LrMpzW=J?mm!qgUiiBLYyr~Mkjyq~FHqF*bZ${H?RB)}&@inWBz zECw?!U-P{Ul@J9!NwG@c4bg~18CY0dF3?;a7Oe1k{U;%t4b3CM5w7U!(~Necz`})Ab)sOQwhAG_{vd^<%N>lG08tVO9vLPIGt8$C zWR3xE0V1!)vLR-czsVW6j3%q)YN`5(@y5P51d?`xRkVF>ViKCxBwlpLNPF?UO7vV* z$QU^jPlCwUy(uJw7VYu&u<5oYy6=F5DQ-mBnclfIg#amHIM>~a` zwt0r;-%TMZj6X+BN{~nH^DkA|NCp{Gnb7&jT3hqyNF`&VjF{*@TvSXR(#pN63wb0~ zMXA{2bSIL10Smi2x;NL=zYNMGUs}%G+Sz<6Rj|UAR_(|qqbfFdPZrY(HqRn4Uvv4B zS9>(p4Y1(nEs$yRj0u;URW?tN#}9&I24``^>n(`ZXAbjI8n0}?CAZX8$Y(&F3 zNcc5mi6F+RDn_+b<`)y^GNnl8iuHAg(WAOF>!}}6_GB(k_R=$%TcMofI+~nzRZ~aw zW0?O$73B8v8{4fSLSPqeCGlzAS??9;;2YXRG6qwbEy@e+msdR1SD2x4f#>0_JH|*^ zIqqldL4<}oY;${xuzDl(4Y z(E524@L^fG;$NfeQOR#5#Xd}DCq91BRfYd7jIzfYTh_TJRP`pGh(CS~InNhRb_g2| z?Q6Q_(5?4_sDmoxcyN_`Ww&UuX+w6y1*xy%Qii8>hZuLj667L_)s8SwYx>2KH1+oa zw!ESBTF!?Qmgjif8vA}z#=b=y4i!_V@!H@gQ3?y-HFA9KE0w0P=?jrIS6h{`r8_Al z!YjviH|P{%$Z$mz2V%89Wbe2zV==Dkg|xR#bmUk%R%467m&|b@Pn=pr+N)@Xo%s%s z$vZrl;FKzG^JFf?S|9imPc3(Fb5Rop*7Kj%vK^NK1H*(KKng^2o-=Ezm6XpLnjPh1 zDH=E{Z%o)Kc4#6QVvlaq7(tgNAp7j!g1?Xa3E^>_Fj_GC{qAcDFYHc4M#uRIN<|MBUv$yad=->4l zeb5zB2_x`r-B>{&AvMJB9a#1NZB(r8IVdX6w^#&TG&>krTk4IKqx=>a?j3hy_`4nR zZAvY5UTU@CwaSNUu;Gm5o4UxbI7p~a_4r{O6e*lta+=_F+lu5hx6Y9$wkWuu`M&a+ z74k8^5EX8;bYY@jm5wnf@C%vQyIW zzm}l?jdQ@x^dFpqZVl=GyITDjAE8eARSfLf=;=gu?-_HO;~F^yMUZA(+{4>uIznBj|<38j&aV$&2txzz4A0RO*PFSJ^6ROw`$_Wh3ySJeJ+u6c@LxSZxS4nX*}+r^sFzAs{dR%nUfR zy*;ejI03@bZ}h~b!ESA~*Z^b+oupQP@D9vCeBOdW2ZSckEqK%xJ&KI!YGu@~=QA){WaEDe-7Ol@zc5m| zHfz-y8s*o$np^S=@$G@7L;$oy92^NbECM10R@ZU@kQ4E;yRwZa@MC(LZVfNk!V7CF zinT&QW>`{67kYwA!T{O$9UxT>QBILozBh||F-^u8>4$=6tr(wt@GjPPiWup~dNe^b z!D8=lIoD%akmO0tWjlpgl62tT%*QCyn>feNgFrm@PhXB{8ZW-z^3`vGB4M!82tWu9 z1q!p%azMuTA8qvnNSh%^E^`lNg=>OVZdzvqH|Oo0337IXL7yS6;b6kQUn|<|si4`+ z;50Y{qKZlET*EbD8Blq>cSi!2((XMc1+I1L6Nxe@g(XMyl=?;waORzYav**G5Q}|? zs@el{!mARAXqbfaA41$Erydk4|&kJZkR%ygQ&Rb~Ps-ru$CTp~(oATKs1^75TToE^iR5=qhfB{O5r68$Pt zzR>2ei`d_A0~5ouS06l1uh=>SNxA`513#`N1N&Ox40;;$@IdXdIN}mUGEDstZ|E2fyA;PU60+~K6Q5a_f_jhSX zPO*`)+zu&e_Lob#2~M#TVhl+}3d7}=4F?8tzSU9kZDTF~x_9u5p1m%j>hvmI<%29m zFkp<4O@C>RlMS#;`XC~Tu$vzHrnt<2K(il^yW%Rx)v1Ul1k!qq2NeH}A00>tR=t|pi)g|vtgaD#jQ0vAjTBIH{bS&Kop>Rq?B;-^HlVluA-u9)5kw8P~(gor56UX5e0 zT!6Djvi$3WI*!W2{QgCw^e8Ppx(?w@DIR)u3T1ULm{UxtHBQ(17_;N z0xz>>bQ!1+We7a!`S-WKB@P_vqdnShxk#wT;0S3W=CkKr!s564!-$Hhl5*%6(eaW5 ze^{&Aes8}6KJZ3JV#w|K!W(?831uJr(5-rI<-mq~BsST++0RzX5})al$7Ez1QZ~j1 z&G`;#5{kf5l>UTc12RWkJT`g_A;Y!(q%MyRWHWhHq3i1s_)HvU=1LjEIoE6w2^tzg zwY!=Xd)$p~{mHM7L;gSNp#N2y!uG$B8(5hC!wNU0@&BbJ9hDpbU9Hz!qN>HzkX#i{ z7T{+X1CZ33gjUGMHsZKSi`!e8wYFV`wgabf>fn?klhe~Y_mentrQsr&d;lrRj~$Da zNWb>Tt=zeAgQ9w}xkXzM6%ovTI-=_L=Pw6*>nbJbfarP+0(sxgDN-F0Q4d;gOIQmz&ksAzqtVeR&Q*3uacIe1 z!b*et8sO2i`Aj^kF&6=4eOK({lN5fQ= z7g5l%`xRqp?BeJ+*!B(FC>;qDApkj?nC-2vo(2+(mO`=E=R@QQfKi87TDX?a*m_ml zdQJ3w8|+A`10gJA4yxmkP$iP6h&(cpB@YD2AZxUEETnK^ta(A_->uoq;jtvmf@@;q z9c&&hkapo^^CT6Japua;63$_spGFdR(1pNcCxn&Hg;Nnskg8o^k}PQGa@RlyP3JGM zNJggv7xdYIga#s4{Ss_x57pVV=`6KET$9Q)b~RG1)2`-c|(SFY5x$Y}(e6i?bN0MI649+&^}>4V|>U-zG#c zsBs3OpfnEuUTqO6#u&zN63!frRWlX*ltVcz!QDaeXnbIr1x53-P+;7(@84jtN%Kne zsD4CX{CU}G;b{`I7B8fWlv1y4mm(5?h_rbU*!w2xz`B3$SUoz)suGa1S#HBXA<`6} zSb{wGz3hio8a6gVTn%@-M{VM*FxcdnEC;EBA>}RLEN*3oOf^@sWBUDpKt|*mDkpw* zCjxbZy5%;UJ#1$1G1HqVo!7F41S&kthizzJC`B3_?oN-)j|>`X$P%;wTgJdKM8VvI zxkT`|MDU*oH~FmJcFHW)E5@@fzY|c&zcAw0g7 zUFKXFN@U8_7`_#4ae|)i6K!zlV9x}^wV|QKZeSsbWU5EBR|A6iT8$*PupblNPWzwR z(m%`-A*EXftd0~&K_z;@nIpyJeEsR7oayQ7kihintJ|MW`n|lcZonYUz>4_$aqcBq zZx26YozBDUiQqTFEAfMu)q|ay?2+eJ7bE`sRUkrzN16ly>p6v>F5rIW9Hmws7tn#M zKXfzx-}|le2M2rm@AsAWQE^vNRFvURPmRWLQ%s^f&n1p6t26{T?Dp{MeQSf~!wsT0 z#R;|OphGy$lDz#ld}Q;yN0n@LgHT8@O-uSg3Mh<7{%ssk$O?$bMu)f8{%!G=$uOKv z@vE284y;|iiqQb|?Vq>O612AQ5 z$m#9P%#>5ur{p-n+GfLl-R9iDt7#7KhOT!f8?~nKtz0rwFU8)~VGmd_v|zt2_}7sO z&*xROvY0RMRJK&cA4We0ywx-4GC!$nMAunx+m>~{?JO7L!T>#=gAr&nXQ$J82_Aqw zFg(VfR|@Ksi3!E$#Ct`W@D{)c@1ck+o3>|cg=O;CnU}RwVz{4IjYs9N35cM4vLLnT zKwX3FsSb`!AE}?`WUbqDR&CIy;DH)$2UAjZ-4s_n%eR%t@vR68%n!fOaYQK(u@K-X z5e`YXS^wQpV?sWa{&m6xMGjgkiE~aEiOoo?2TXjO&e+B$UGuE{htzuT86VTOVZ1dA zu@;_+rLT1aiTymitpw1@h>k~b#tg4vAg1r~)+v-5MY?Ub+}mndwyg1gBHz8APE{X{ z5x#+qX2ui$+o;3-Kj9S^Sy=z$$Z+Zh(6hnze}EpuJ7ik}Mq<&k8(|>w`Y5oF7&aU* z(N=^t-I}!U*cf;M0e>HJ38_@{rhQaeg_Rrl=D`g6tAuWQ{70dee7%7k_6N4&XSdVt z9s_(hNp!OX?JJ&4FBW1f`R>Cfgg?JpUYuX&jFCtrk^60Zyxd+-2Z_TA#%3z3iTrv# zY{K1LHJ8x-ZG4M1L*765c0*~L*}o~N{YrhwNyTQ!j88Vz>tjw-stKWg{R zO>qcueR(g{T>JwE#}VGxWA{`pKU?Ebs1{v@&lXiAnYZ<>KB<~L;1IX zGm>O?a(iJ>&DE;TadxrdoQnQnY5dQt3IG7Hieq3OYq1XvfgGl@* zRZ#>iki#3;j!3))ly|LQU&G~HiF1F9(OC2gaLsfUg`5N?`BLc{b#fh@N@o~i0ByY_ z0>EpM2(T1>gKxQeOs9i76q2#nyxb1A0<+2y2rZ#&mjV3(E%Q~!oQVqXyx7jeIIDe8 z_f9kg;jy&kP|8sf8hv}ql?KZvYVH~-6W(fRU@f_PgV-~TnPE4^2crp%il>;DY2tGP z$4Cd~9v8sCMNjaMSwzuh^)@|QT!?NM{`V+ripk~~7my>Fg1qAqyZ4)ckHM|E`m-Tf zJH@@BjU55IyqT|n@=&;oTD2`%L5!l%I9+#>1X&?qx60RmIPY$}V8CR6CzFk?W@3D^ z-%R!>KmYQq$4f74E&~%94v3!?NG8FeEJgwoOkxsoCm0%p=P1T>0g)jio0Hy*iy$jp@sCDPxf`TPShe3#nF zEO_n^HMLHcVXTveG}A(9rBOJls;f@nYnrJQOccM~77wXEX?rLrRnB+gA!&ilicEE> zVL}5{mrgEn2Iu_2dYQ%ZHSOT`2DRlaedjVXQi(1Ub`n`k*Bhb%jf7Ih+F&j;<(gla zS|3;O+44JCA$<#HhY7I0UIU{7VT_-1d<8a#6?PRhc$W?qK{7}Y9%49#;sPf6Jev(P0Go>j)Mho!4sF@)O}Gbar5kl0=1vSdDk!_Yz^; zD4={NkK8{lqdjl=1@HPx_FfD^7-~{h5IJ=ca3b(GAi_b<@8Jno}Ok+Lz1g)i6fW66W5ysYptN-T+ zHc#6C?kNex$F=geN9ax)yfU{?de5z-t)o*A^~~-eO=8xSVdkWm3I`6rJg)02^XK8J z+m^odWoz)2p^_7p;O6$R?j-fh%YN(WQT091vM1>ctvm@1#xWgv`e-L3q-K;a{qE_@ z5-0Sue9dm7+?@MGtA9^Jw{_ao?899^W?;x9p)ibNq4d<`ki+o`1`r!YdWlw*;);@P z`;U@7zb<34HT1st`CQ%~^ha|0UysY#|EJ^fAKA};TqsWcSP}PIkp1|3g)9iD=+$%* zh)JoA^8~W&0?>zBc+cn4Wbsk6B3y~3Yv?3FAAaKX7@BwgV&~J)I|C@9aN&>drr2d} zv;~4Ozvc*yZ}{QW)_2xTZ>}Q2S;#!I=M6kD6tHH0ALu|#JeJ-#DPMRk(iH$C2R@9D z9H$2-O7zlxT+N$%X0O71<%E`rK_)u=q6PlG?xKncuuh6L2WFx?`K0%MUZ$8-wKor6`(06tWjXrQj0-1=SO8Th_voWqEE_+AFz1dzXwjQs#pN!<*M( z)fMm4jXwT;Byw__$sOf|9aUXaPRPn^72(Xp(*R)WA8lA!k7II#!(vMeoLes* zIQh*j54Y3VUZptqz(II%e&i(Cm-BI9Qj@V@TuoQlgMzhDa%sF+Mlyp$KM46fA*l;& z#lB~J(r>w7NhN5{Jc3F_n8))kRL!!!P0z&hfF%O$ML1Rak;2nNPgp1kKwA2;Vg0)5 zOq2uzlHcoMi-*FT34i~Kh4^4!9DyKdS9fEBZyocHrHQeeCLH-bvYVp z+84?Wy{p|;^%ha^D|4!Yo$s;;;3x%(JnE7-dR_DH6aX{~24a%kblVZYATaGXtx&t@ zD&twb#FxOc_7Yghy~KbQjEb__qSpT@_iwZ0&EiC{?Z6 ztz>o?XS)0+siKgMoRQ8L@b|Uf(_E?Eh7+@qNxgJMjx2&hee3*X{MUe-)o_2UF)cS0 z6`tbCu?LyclrY)!x14Kb%R=%CE=bqIyyOTJLHp%u@tzE%@KC4Mas^(puj+o}mh?PW z&hNqK6?_su&9jE$ZPf1Sgz8LnfHJwgtL=Rbbs7rDDg42DylH%{@#|KZ7VnZBR!MU7>vmTtl>r!j|lt)-nZo-+xZ*?kZ<5GmEv?aso}&*Sb*m%H!}V%yi0 zpOCJ3(}F}c3|-;a+rPgAcMal;bBQ6C)ij3UzAeC*9U+{YN~>~x_e&24RPfj;fjob4 zcVzVDC_r&3ZfZ~@d^DMfJSYmqcLvv{xSX1X5q4JoV<$aGm=d$p_f#1Thb|24`!kQ1seSHd306fjmi!v^nYcm~kue9C3bzp}-`-2}Wk#7ZT6W3GnxeD25r2l@$amU}Mzffs zPE7&k{00k5DYele@oLdVaXR(IBGK6=#px&)_fen#B|sYSESJaGRJWxrhBClPS+Q012mUS3HU%VOTU7Ge!@HS7LqF znvTS8hH|i(b>!H}EG&;XOe3a&U%t5T$z8;Rgr;CINRm^z;uiqP)cX59qJ8g?bp+c@ ztiP;IJr!PJb^(g%Bj_1B>*-VIr-9z}lp2#!(If%Jl1^!Kv5m4+U_!tgVRAsh%xp;E z_9*yK%FCoIzPwv4yW-wZb;=OKpS^EWKALE5vldm_)ezLRL(&^ z1YaOqf9zuT<{GeT* zkLravPZ0LoA`kN;F8GwmgB4ycyFOq95XFogT??8Ck(?w`)bH`ch^iFL7vm3&X)Zzu zUwV7_clhv?VlO-F)ygd54?Um8o@={KDs_?QOH0}E(`A+uYCTJKi*z?OBN|)ic@%Tx zfKhx*L7|)!fGJVQ&_oxV8IC6zO1{=;{IRJ#E^gCuPMrsyxI$u}o%6}3g#6N{rt$nt%GjL zJ(a%J(pzJ0i>x6J#DrY1rlP#`c{vEa<;qzG=XCajVkM4?%=p0c0^BbZK!FlcDkULD zej+wp_PuMd`49&14G{|1fWhDeZjCt`(2wZITknB~0Ihg=TM0QA`WTUAcrZ?JfWp~3 z7gs_GAiF_S>$sDETF?){re~F=OCHs+k)C$Jc0EFl`w}5%IED=ui$cwN?}!2&kwixV zL%=Mml+q4I;HsLkSW2QTdhS!>%Y!2ILWbf_HP$QG{{zqPGnlZ2=aB^&3Szh*IO11GIC4$Ukc&3Q@Tey(YeEG|( zV`XL_fmok z^7a(qFT%W1s8mYGn@qfZ&nws2ax*--m5A?7eCI+R5A#upA9!GAV z?;4Yyz=Goz!`_jr7D9PcI(gyezCtH0H7sDQ3~o8|TbNTE7|cQarCOl&J%{ zw1|g33%lw1j*t+BM)KHIkH*yHOuON?0fu$3-$Vx;*>Hh{S8ww2lcvjExUxGp%of{fVf9zhKI zvn~OCbk9OY90jG~tQM_By(bO*`VE8!5t$0V9cHzL}?jtghi<8#O6Mf=0hBWgt)@ zLEXtDlP{RY^@dqoz-+IRJ?BqIlO>L&XbgPz7RmZS8n&$PA=4LqM^k{bB&c5V+;jb= z9m9FyAAzg(0?5*_U1lob(9#Tm5@8+jU#Yk#z{h;4a>Wnd@omOzPWk;Gc>RB zsvb{QImPV_Gf9;RpzODVgFRiiqAci|FK3^pe`{lx=UIRd7T0QF!}-q+xc7cvB=ON* z(pg|4W~g-vPYtd~a`=5-8Tt6#?k>>PN}r@XYrM2&@^G-KJ!y8phd)&4%DK4mAbwG3 zgWwj*oj#WY;eA)=XpO&^mR@<}w%_kN*+zu)%tv(}_4H?Zoi;~b&7#KPEjawz5(B~l zLJ?=+XKq`AN4z2=$6~SF5^uvew(mZLzn2*XD#}B;PbT>28E_*By>;`oMck{y{_aMA zGpLYx1|e@f{GI{+ew_hE*WDzFq_n@SjqT`ao;Kmmfxc-SJ$?5fU2!U%+M0K~Sx4{( zl_s^8|8M1k<9`BoFfnre#|o-gW7B?}1KGc~S7=OFeyg%+FHPjI`m&|Z*C257*A@O5 zNa>0UjY_JHq+HE=eD9}OXc0}jOVVC^LCM&zgBb@wui*o!ks^dY4Hd`7M8OoFmp97i zN1!;3^hA}(+?4K+%aDkc6yBx{|H!r5q9MyC6_U`<;UiUo(#Um(n|7S*GJK^xyMGiw z*^kXB&}DHtc#Ois`fTogrbhK z&2X>f5BPt07V;GLQ(GUoj0YY{HZ@w22>CVYUPL3bIc8d~cPBIkZdCnJMh5Y>rDY9L~=daHli&S8oNg#NN^1@O;d?~1djNYfO zJ*!$FYV_|h@3RxxpbJVqmmcWm`z@7dNibg{VKwa7HhV~@Z7Y#<$($K~2Qz2wg)XIE z8mLp!a@`5g)FD@8defeN<};?#S5RV3+b9JzrX0FFM}Ud)=b3Fr4tMizezXelW)^Fu@}nmCf~zmQHvv;RB6qoK;lsuJ!_r z&y%>eFQ7+yX*VPGiZ;$pZi~luic_Vk#>{&Ic z%cO7vppaRN)BB34+>*Q7{&6B}liO@xRzq)neSJ-B&r_4r4vOR*4V&Y!n>7_#zr6q5 zc568AnBmv7v)!yxcZPRD60(*+LD)1;dg&GkU&LcLNp#Q$UNx%-ce(hJ)n6tV!d4BKR>5}y{Lk2?zGpj^{nSeBasJ$As&omX47(S6)sxzR-sh^HI zuO{P$781$-WvvQ=e|Zk$v`9|RqrO9iUbg-SQL6z|)2-QmRSRikMD{T){GzKTXU7FD zalTtbB*7gTl^jI9(6eQT9s)}>C?n{u_fiCQ+uELdKq^npU@e#$EzeQ(>o)YPnB!06 zA+#qv#_!Y(chU2@rsz^B{UM8E zP-za7zc)tEU#@tvIf6Mr99ZH?ds`fMRpJR@38^?lho7}IUj4^+C8{vl@V<>gW%ZS@ zJSAT~z0K4Ut$uxE_f3m|0uP*!^r1fz-u66aM?Kfb$g=spzGJuW_=3vXZm{jtXSmK#$rhL}5 zQGlkBL7p;jRi=5HxTGid2p%}Cw1y%>m~e|0D7J8CeX8eT0D@!TK}zMoFKOX3i0OJB)ryj)f%SX|}OLEI8sj&K3q z5V#F;w_;4{{bMLk(@6nwl&$6@1gIyEkZrcYpu2fSLrz5t%w^TC($Bg#^=p_(0-Ooq zA>MR@VEr)?y9Jj4hSi3lcHeh%>HQ61zijeo1>rH+zZ3-IJ-{rDz}{H|L8aTYqtyrNlxRpr#P+0Q=fVIHNCqY^C=BTA^?)mq?o(G|ii5Xs#ZdUA%BpckT@V%k_(wrcrV$9TzWM!>U$C!w?9)NN8eor&#} z^!PbHa-}H&*SNklMZdBJe825q56aJLEm4;C&wMoKW3(jWzBv$kcFm1jP0GHyRGr|D z->V6K?iLR?8{~s_PBgn8Z~CCn-nRh>2lhY$^RQkkvuqIL?_qB*=gX0&(XHnFBw94w z$(P})+V0=8qxPl7jrS<|DO;q7}3)@SpjPJU6;&*GhG)Lo44 zm?m1NPJ;{M@Y144eL%*&fWXi#|b{LE6%}FQ;Q#D3nXMO{Km>Q!< z>>(t$f;pxW2}6)k8i3N`S(ky+Do#+9$kP2heQpP`;f}Fq=fRQ@zf(Z)^|QNiXiO?UzASy2A>CLxw!&YgN!SmE2y6ig$2IaT zHx5zw&WfJz!&guH4f+tVk#~hi6cCrCq0Q0|$xD%e^EceOu?8dBS>n-e`zI(I^BH3a z*By!}@)>?BbJ4pDF@y+7BUeehNCKgeFqFNe9=)=WQ z%r<{Ijqc!-(ctiALxxgEu?7^~AL(+pIF9Z&W}F(jTA+a8LH`W$#peoeY#Gzbb54b^ zaW{few~|*&n!eHNB}vjWf@?FlmD}910+b1($dftZe@g+qwL|(U=XKORFp%`@49^`^yiSqsICzQKHiXj5)VWi;IA6D+&WTSjiwvn z_Y4vP95Gt3QHuaBFDl&^C}0F@6>(gY0wux=2FCF}bEYvu?4F)Ck$WP3|3YRw1y>mm zvctHLwaWRzQZb!9P&d_L@wPMEa3+%Js}aW(XFe_@dWrIWJAQxd$kA;Y> zxUd`CU$GQeb6#O5CO8Bpv&Mdp{JPEF?nt(hzSdiH=D7x;soLVIx^ocau3D_V-NQjp z?f5tgiG-vGHi9K-;lmGEFddj?vER9DKHB^7_C>+L#rx?H>6~4!p!63$J1J4&hg>oI zJ1i$I#EyGrI&4f#ygJPKB^gA|5kqs%pGf*)%;_m8SJ3+UzMmp5U*e+`;+F4hFvU%B zMcAFh*X!ZP9Ce9Qq&;_ULd5*EVeUmqch7l73X(uBsBxb_eyfXrouu^?U%hS8BPmV# zlC4CSHhb%H5P^JuKWRJe=COe)@@yWvALftcsQ`^k$8MX>GK>d^TS;VIt3-tn zV$Nj1MSbGXsb};W60FJgay;Bj2J8b?!>(nL;phMf3UBB0JM~5qy}Ch5&Sz`RB}B0` zdphBOO#d4*oQ^}^dx=GbYtlbzk^FP{x{!3v1U>N|BlV=K_=Ho%j4+iHp_4#XxFn`B zc@_etG>{4T&D>J%uTJL${UUWQ3G*tbD3sQN2~d{tHWY_3J$N?DL@2sHu&KM%g>cHJ za$Cp)1Kghb2tY3`O|}IvH+hJLA{^Ui^KPJK@mL>heT<5Z3yg1;Lq&g=Q6p9@{QjFUH)}!OR}eh;z(U~M)UNz2XYI}6R~sF z;R$w8kZcJ0DwCYK{=iU-o0!aRHrI}p3b4XcCskBPf65<%s@!SUb+NnV3$tcl6C6oJ0t6i>hgPm8M3T0#_1K2{8w zu>mXRsk9MOkI}w*knq=Ioxav$x6LuP^|Pf|y21t{Wr|MRI$ffP&!b^yOf9Bs61|W( z07=&vXyurPV;mC_z;Lwa03hwqESiI z3!$Ml8$r3azDs1}DS>)9q_Y;_^#Ba?6nF=u zXdB!+oi{?;;I3LQ&VYwn+$v?D8R(JR7`tx@^yT5JRXiL90(r4kByxU`^8%`q))rj$`O-3XH z$zv7*Y6@u{j_RnMG!4t&GKLNo!{5d08YMJb0UaF|d!6HDs!VUUe>~@!`8h3pJmXDJ zltq=MW6~EZ-JZ`@B9U_6?k|a3Np6|dijtEjLd5DD^-XdXTB zb^%Ug$FwAi?r_}J<71;05_(LkZgAGFFp&p14C%3{reSp@1J-41p!SU{snJAW+9OII zF*a9iNn^(Ss>1SeDF0%<+v3My8H-SWQzQW9mttLK)##2h6-0BwTkXHQKw&}S`GNa1 zu~X1*;7ye!mTppm6sVAnL=>|0uR9=27~X3BPQ~f&i7O z*5mBoLnVrMspHB8u5LN2zn~hOp{Os}KK~!a&LKLpK-<=_ZQHEawr!ggTa~1e{IPA@ zwr$(CQSr-tt#`*ejnmz&-PvQ$wdR`N9E(?aZB0Vq%RnqDsL5+uQLzZK7QiSnX^qu} zAwZub^ze-S=Vu$92Lb^XCo7()I@2E3M?m}}CcwvNfLb=>im;L5`!stfg6qBz#JQA91JqlRRlGG}rGyBBkX9^Pzx~Cy(Irj}wR_0ZZMGO@B2W-!(tUmkaR;j3ad3kl z5Dd6jxc;wWcQXT*C1@e`Ig$?9h?{R6jDufUPG%*FLC&x7S*r<_Geqbv?6atPqhNG4 z1RU=Qa(@i7VV$RTmXx9nQ_X>b|+A12C`nJAxRjhFsCS~C;X-ogOT32ab zGuZ53eOq?@I(suD={b}52LC{>jk%7T=8Cya@@Gi?O7Q7Ud8KpdS~W4T$O9Z!Pm zGn8*Wzh}*{A-YnfTTwC3R%%~UbS4um}R#8 zGx!8eNJzKdmeBmF(SbtLMuv+GT9x0@^}g8;EQ+c=Fs|({3nwU-c>IHX$N+p-yyn@} zqsZH~(m}{$8x{F)-c-%(&Bue)6k!F{N3gG-PVNsW@gPX2w|D6q?30kRo8H_WYBQf- zWYsIbzVu|Yjir$79UN7i=S-wx%W671!zFg~oePa9T2)H29flB9HffR`m zqI8nDEjae$6#}Pw;rLg|xD0+6hM5#X4dVqloq}eznCxlcJf~U`)IVNhvNpJ^w#$c< ztG-u$-~JW!X6driB;n1`NZDyb;p(_I%^Gm^YZZU;p1(++lsUsw{P2LSWh45v_QRD! zO@?>JWGTk;H^(v3{Bs}ny()Y*)ey`fO4`c17Xb$lzSuS-i#nO861!YTtXSDNoM5H; z2^PJiF_w36^aohiO<6^(ya;Gw$g8Ho2)0*vVxI&=wcW_DzX;2SQf=x>*E@}3n>ZfE z7MK~~$HmraE4Vv+iUCY+HuqfH7YJQ-Sr0VpHnh%?fyQ^QR(f^jlA$*6m<0roEY|3Y z&`6Qb+@+q<)$y&|t05ZpYypM8lB-4sAgh9XH4caY?yMz=S`-GS#rV>z63kq1sHpy8 zy_%yJNzj|n;$i?kDx~1SaM&rWA1;8O{=6KzC5|STB3b@uA*m|T(p5gMxJj1+vpEI4 zmOPbTa1oe%wLJaE6VFQ9qXqW925gC@Yx%0T$aX7M1hLEzNv4NL+ZH%|S>Iq3n@9`q zs2ahS9o=j})gL5>Ll!u}fV)Cka##fFVqjoCUQ9`9CmIp*U1^$ztuxe}0YGQQTt*xd z-hSn4=1)!~uFUY)$`~SFTaX}7)lnG}LD*4I$r|YgMCkU>+W8JQrAN z%KD@WX^DM&9!`egfhVW+(w{CZMg{?>C(DdqBaao@>i!uzws+&WR+;VdogA3a(-Yu~ zeI;0cxwyiRh2Kfb^7RYZ7GZ9}33sy~tR)8}zqPl$p8b1waL74k`na^xQ92#t{=UhN zD(t57V#bt^OR1CPdBPW^%-DIc9Zh_4+i`X8+CUnFcN#3!zXHj`TT1q}%$-iX_iwE7 z+c+BFUbS(i1k?fn?(jq<=wmh>Ot>Pmi}dn#`E-=AeW55*IK*sS+WE!We?1y1S1??q zBmeUE+~>M&C$%3Y7(9{x?F=Z}=&)j|D#M4)1H+K%EWef{eWYCLa~gCC;qrc@gFx{8 zp1_+p@^1F1Wc43gHbOw%HZkOe*1#XT5`!Rbi{VCTo%tKB&VK|XjUD}-(%a5#)_-J_s0by#os zX1p#J$j5>6v~DY&S7}l#STH;t$-DL#qI|jeIy=T~2 zDJeKyoLxKeyhON|gzc-J2^$EnCk`}UHtsCyS08s!|_uSy7-fcbv$@$pos>?OtH^IWE)Pypy-~!x271aoxB$dXI<~9 z;ovl1ws8p&3@!&+w)Ym8}?hxn*>^-7Obv zfv{;*(+2zbj;4@HnQGx}{qp20F9ur|mkY5*rqPFw z?&ciLN@Y^=`^#xMtV?P={U`)YTLOY32w7cFUx_Y*7SKV|5c5q_(cK~SD!dADy_oSQ zJ+wSL{=~$7z#7Yz07ci7P@uR`ohy&dG7C;4rD7}4z85ym4$=wF_FN`GmG$yu zi#-01beUafD(}8bcpz~?^-kl~HEo@n;d(|!qD!oAc;~9181h5E2vdxtj@96V?H;@j zcO*5tEb`Ppa?;RIC`D${ia`@~e)>o^tE!9ZigT~lm&anV&$kTeDs1yyAdI^7q2-|DICVE(~{ftr58 z%~E%I%W?D+3%ZW+5E}xa1EP`{l z3E*OQgmS?%=cW4|oq>jXhjIXP+oIKr>rFmsHwf^Rl5wPGQbd(zd08fX+@*t7<@d6T8A zYXcQlUjmf^L{tJ_e+1WTA&cm8M2hNQ#VaYwBZ{(`(N4e#x*sz1-@tMXL`HjF07jlqxL~)2>mC7zv~wp z-QG|)eDnRy5IphD00SOHXNPg_C=Ba7V#@9s`t_!kD9<)4xlfRi+s<3)ZL#&LWJ&FH8QR%0Hi9tE`%+uuXROU%n# zC`$+hnHdBsQ+jh*)tqmAM75n&`pocJ4|AVe*BzV_H*q+QgqWozt4cs(a^TGR&BQd7 z5d8QtMxptT5LH}4)r*2+5RNTT(CGPd-Pu+z9Fi1s)j}tc%RcCIL|u5L&&jMyNgv;B z$gMkjG1o*x{e1)HqY8f1{_rs}Xf6fPysWuEvfpZQplu@BIPcCey$pX&`T8OUSERp@ z`sro2h+EEGu>)}kVim?Ux0M_ij8i(5s(P%OZzBVhAiqtL^UzA8V{V}0UH_Fv7)YHdW}T?}#Hj9J>6ZJ9FiZscrI$JG8gDmtMi zYLZlXIy_ueYg`B0m)7GwdVZ~ltHd>Qasc_1{za&Kr%l@*Bd?h|2k2;1-i}NgpSIdCYvbSt=MUsdi z<44IwPf|$O@%*_#O!Z26)Vc9^^q~u=@C~X>a-gHys|g!1tiN7X(hJ54MAI#vvBdzy z5036%TFAnxw!6-c#M&`~=m>I0HZwpSI?`=UMwjar`Z|@kJ-b-Md}?0TlL=xFRzs+4 z_qCAp;{JMpq2OszV3a~po+_r(%mJ1ress^IZw1jpdN8a!I;We)HtY>F8f-Mn0ocn| zRkRaXy9>t{i_au%?u{uZl8d?!SY+FHKMqZ~^jh`Tk?Bs}0{XPhpnTm~Ha9@!JQSa! z_5M*L$zc0KnCmCBxr`Pf+@$um^L!DsFK72^ZL9fnujud&6fmSJBTT~usXAs8ko7ss zhx#U{+~?UE2V?th7#HmfaH=*o4*F5J@r zZV_|XQ>eUCQrml82Zonl6rluJ1@#y46`a9j?r=Kqi!i^HaFb)+6R|R6=1=UAcZE`d zpXJJ1(0Z;k3P+SrYAzx{05rwtW0D8!SIS>Bnomn=e1!mSl!;lr1WxDt$WWGK|Cfn0^pgSH82uk*N|Xsu7UG;}yEASC-yGa1UUgNR@TJ=4on2g| z5OzX~5C4tU(bHvNhgKGeM=hyMRvS{V*XDP^4#N-58M;S^pbYYTkZT**qYp0dDf@Gv z$~*1o;EKCT*Nb*U2V1RvBa%EAfvE8f1w~FJN8MTFHp7r?kBMBwO1GY*^>MXtV1B2~ z9%Z|f9^9k)xqjIl7ZGY|)Mh2xL1e{gS&rOCJuXQg`ahVf^nXiTvj$&}EIH$1SpC!p zig+fzm6Z{4j9%U@#UNA22fU%f4PulSy@4TJRPD-lJ(#pD4^}2(<>Bpq${l2#SEdE( zba;pBczA_tt#jd{MzQePqFj4>8#>*@&<{z9vo3D5F1}r@_Dv7PCP+tk=6r#kfMznbms@ z!C~4(If2hY`C;_$9N1)JuAJvQ=@H|HYyl>;kR3?I)x0mJr%bs(>b^vqfh80Y!YIW6d6>T6GsG&Bu~wcy3=(5+rk83Kkwcz_TSc z-?&haO9XsxFqJPEmw2Y5_w7YtGe(Y50G&U}ekmOWGN85{K?9^wgV>CqqC?%Se*|O% zyD;V;6$qEG=qyiXjg4PANLG+_p4eHX#4ybkK}tZHfIB#Td4#Gc0qeCo`mJtVA=rsH zogy~38)`1p=@^CbXw%fX$+C!%y_X2f0u}g^8nl4S5kI7mkQY4G+yGduUEUCXK&ONI%RZ(Bv>%dIkfyJXy*_Htq~_KiGTM)j5N zU><+(-w@)ZV~v_7wJXx7k|!W1br7T_f^knO0pEle$<&*_U=X}c=YkvKk}m0WV5HZsMlgbezZnQB{1mCv zj7}tx_8)`;inmwG(UeBBs1t*wir9oNP~BR&KyCHTlr<0dyE{J5GFKm$x5KbPC}rLh4z>i!_}n{ zgaJo8t&CO{TBUmph>(H+3FV?M`YUDtLD>Q4k*|A+Ml7wF^!_#zyWY}pH`%b+!7qFr ze-cMNX3B@o!rpaTNL~hZa3O!IudqE*{54woH{h!~@wdQ_vsBRakRo77)nHl)HwhPJ{3@?%%q`fPfwM z4XyQ`U{0*{!I=hF_#D^s6pZoz)DMj?+&{3#T`to=g$-gWp06GVDmR6P{{sWPRTbt< zO`3uoqhlnSIRuAWOFJAn1ZN+E%{;A>eW+#Z=sk*+mf{D!9`I$m5}!hvZ^OqDw^`e6BQ65E=$B1OHHR~HO^sqz?5Gfz zJ;8oTN`p>ygRK9kOHVgh!aBQ-F%*T;z~|_XwC0*7j4;=W_*&ffX%FLkl%1u_3u4AC zpauTYxMEbzCpa$P52P|sgFq^#Cg8B0HLTR*2zYwh+1M&BiA^O7^wcdAc9#(E8pW~;iX`}S)m!tSWiFLukp zK3Va4(Xlt;{>gMz`dCC6Voc#K@FOPSRj^Kn2qhg1nPhR)rCB$dF=g(;9n*eWzsuKs zFC;RoBQxI^VL~~2NAf8V&*<^%q;X63-(4%pWgsB;#b(To z#$qAsvM9Y7sw2*)hO5OM#OgOMTZXariuL*Zhn@R9)9D9n&f+#Zk#6AV6pNpi`+TFr z>j97IsOExllz{e=1oEcE1Eh(sSu5`*3#*MM23xo?j?i$RvSy>Vdf$MPl1$18%wmRK zU^Td9u2?K;GM~ZF5HevY40jB?RKsnnUY-9vzs`%$!F2DJz!{G7z+3a{%v3SfW(FZ7 zkVf*fdQ+=AMK;E_$td>^~=L3UB1^dGj55QYYpOtkg%QS+NZ8cvYSbd*;yt~Nj4_zmfiTi@MEAX#}h=mR;?by%T%Ar+MJpf~1LEJKe-pj$*aQIsCvI{+*Lv`TTn)82d=4&4XZ0cqg>N{oF&U#PEEc>OL? z;AkZb3(nRp2u-lm{K&9fw+AMlhMAZwTZ|u3F_|0@%7oEfRw4I4-Kz}zTVLqECY6Ly zYb&=6p_dg5x(ZYpkdHv(h>WpOQqQv7jZ$vZpN^GoMzENs1ECN`I={bt^?ysRiB{yV z(~-zy@piy^Kb$T4gitcL#7LaE1~QAHuHUqKI$|cj8a0hooyikKyTg8xC?EqTM{=~f zmn3arHoQRWl!E7Uqs+M7ocl3;UYWN=9Heg3FXn9HnU%Q>1zdm*D@o5oGdN*jz9YAe zvN+TcU|u+$VIm7-kYN0jIWi23yOk7&H_Q2^Dz#N*4D`k%z#kvtuG{+<2gQg3wO?M& z&rr$lOJQuDL~*Evrjnt}8Y9;uy+$%4Skb>-(UdUa;yVZYJXOY|f0wcxn-P?$7O|l# zhr{k$;QUJmdZ$@*;?&XOD-MUDd2nTINtdCAsVxdKTCjR+LtTV zL)rTnDyWmZx$<0+U2aP=#kZQw7zF9p&z~Sqx~2;mnW-N{$ERJn2lWuEYzgXV;E9^= zf*RSVR?Y-Kh5N*)y`Xx3P*;XY22U6+vORXM#7B|$;Y4$dnHlU!T>*}4WRdOuG=Bmy zjfANv1QtI=F;`x>l2bM6uWltysv;*2#}*LHi!X1cfhU8#b#f#n{FP*8->0h?6#+#isZ?2rKG$xOhq4^y2V9&KiE)t2TJO4tr1Qs`PqE&2&+1Sy)#S^HzOWyK~uPfoL9XImozN|o*M zS(#qaQgpm>BcJE!ocSKb54M`avlGZU0m;hsB}W!X;Wyjz#+@Ody+exB8QH`qhDjoY zdgOyRPJ;N?;W67skRWD~5Q|_UqK&6&El>$IN?uc;F6TJ+P_>s;$=j*M61~j>5H}Tv zlxcejf3`9^p1n#$8%u$|YLl*-*x6t36#gT5L>Y^!``#I}i1#QPba!vx$22p4<}veE zR+VltG3>hW5{@tG4ObP*?qq#QyQY7Szq6NokT}`OV(DNNsy0*AN=~CpN)bG3s9I3N zA=`k?uvCYIZunAB4YMQ9P9{ueKl?~ndGw_CCj}LF(c-WvKS79V`Q}_qz#X%4*7MiX z2w@CR+@=cNs8#DhEX4vTL`vxB*qvP0#h#@>Z7Hv7>k{DW?=zW>Py2c#lAiN)G2NNW ztuMWFp-{RX_X2U@PnvUm@?1_qB#iCu#vsd1wR5=DkTYW+%ra=E2<6KbQ(`zLyO?{C z2#&+2Op*x0*=$dsZ`};AfU5+LdF-+Ko-EL2YrM;79xs*PD8h}@H!sRTIe%$;me{2O z_gU?O8S$6~WT^UM2vEw1jWe22mz=q3jYDS7Sd{s|$2^90mTff@fD&$bWg^$MrI_|neQW$j*| zf>1x*!R3A*vv&(TGe%1ize<=r+1HgbKb@>TQHFXZ&PP89;5sorPwyrNg1_@-_Mff^79 zOdAsBm~NhDJTmeRdxn@=>rv69#7cXzx0w3=R=3-EZ*KoHkb&f10qoGOfc9a>&%}lvsVM))oYb`NVrh5B>j5;&(VcKV`J6OvE}9m_CieeZ3v$nBR&tY_PFK zi`_b}T}@pYq??V#6A4^~dyT2i+LYJ$?JpFFa0W>?L5WGD&^#)+_vO*9J8WErtF48+ zSMDsYRk!Nw=TM+1%ZC{=AsBXSEunwDn^C1f5sc$N{(J>GRLIJ!_%58K)#24VYc80T z8Ez?0$w9APckhHX7xQ15DQZR%*l-$dW+vSg6gqJ`Pi1k=1ep$p047xspOGL5P=Qu9 zy1h&XPGK;{bBarZSN6@8sp2U&Mmq46=Mn)%5u7mAe{>A+v?wlR#qB=MKXfS!F;me| zDx3&%vH%6mlF2fASk3@is^PvJu1tqalT(`zP5LuS{b zQht14WR^+9AM~fs*~N-_#<>>o*87c-YDPD6xR`t69rqVT`pkr&+C-kz%mvnj-SGSG zLMy`Rgwg!<+@7-tJFo`S>Q*A<4j2-zQ1zo?yLA$}^=7Nzbi{5AKX^>27)TML&@&$i z|Ck}(=8DRS94Itp;xJh(xL#NI1v86$ySpz%KTT<*y6F;Ox4dm*78gp!c^K)7i|9)oh^7Zoo|DeFb$yWL|5uFUCQw=bWcCDE5k+aEc3j8iAaTNYu zMgwV_Ncp3IauR0zN0nttICR3f6GI#IH0Z`z8QBI$e zCW#f-zeIU>L12%KLoi8`WwUJ{Ck@S0=W<3AE0*Y)OSXHHxs)RPr_d+#2#CR+s_RxA zF#~O}=CmwUwZ&uX=EqqKgqMfam+kf2sg%9`N?8u7kUz;QYga(%E%qNxwxk}L${5>* zJ{{HwPR)8w4?%%>8_n6IPht^Nm*VZQhV@F`dRPHY>=?S2H8{Gb%{-(6^^ zXsush9lr!14602X-er6^?0FySmfBNRjU((iWuygrRb+BJ(@ zo)XxgwaoBqYrTWs_D>DW!@vcqCEr69YBa`}v)y(;5NfBHnIvgq4vo*(q;I2GEt?+$ zQ?p*#A8zAjf}s`lJ1(l#G2m}`=rSY)mGvFeIz6663hgF{thd5;rkTZStaSe^tfra@ z^xH-fr0p9cMbx4{L6~*hWfTf5ffopibP68&MtLUh6DI61Vr^u z-y;yVX)xiT$<9C%@rwY>5JTsYbgRBk`GG(H;9?~4DrVH&E-B!mZGM>xPsy94Sa}9& zQXi6#A(`v_6Z)OTEt$Q*$}`702sW{~w3PE$3|)xt9tOTi2GQ$xANLoA1B3K9X0Vab z??5e@gjA|)d#=$&S+c?*Au?MDQP*phW2w=BOF}KygB8(o_jy@IN#3TjNr6j+)}TqO znMRuskn7M1s}(@#e&f<#-8pJ(T6xUw7b)Nha-B|!!-$vDsS%%AduUunuwGACWZa9 zN+LzV$o^YhO)h)tRT2-h=RVUD(yx{QXs%*d6kk?neRHOW?iZI?3H3#VbfjEtO*Gh}W_r2P@W?5N7C*{oD*I>l)>&XaNxBdE;EeZ#Dn>ZOA;>k5AGw}LZV`*VH+0bg$#4n_{(bmG_5c)bje_x=hvV2g*=<`CO)1`R{mTN-ef8-|_wiIhxkX56 zYVNv0(*$&0)Q-{I_@wJ9tV(=^l6azQwq@dsHQK)2iiNA)gkD8rMdx_?^n_JDk!I`4 z3~V2o%Bbrd>b8#tc#L}+cZn!@iC9-A?KvZmm=ARo4NIeXTAKj|;R}%;nqaUi9F`qn z5=|($hf;bciN}`RBQB9VsPDUmh`r$0uE9j&1;kw47R?DRZiB{aYN!Vs<2D0c#4*~S zd?NkG<8IWY5!^m=i|4!$A);(97HF0+zeyECe$-D&)h$DuaCM$xg?pcBxZ~?GI z5v~M(CT)}Sa2Tv*{d9G>1On}iCtFV50H2fPO{DL>S23GnHy9(A{{~Z&N zh3WrqjTA@ezNwj20-1E{A#|QV9o5H($l91D;6yV+j*|>7)`E#|iG_TB9KjfhS_lhs~_#lR!f-1J!kW6uD#FQ|6`-=Er=@&(yX)r}wH8jZLlX;nu(|J=;G!c`AP zN^EZ0@wY_Byi9qJI!g&(@E%W1I#$tEyy<72A*L9MJTJqpR}B-2oGDcY;~<<&VkfcmY$oy4yzQMl^E^%2^VM|C!w7`8@{@Llba^TU zk|F6&;BxoXH-cfB47}s)Yo9RHX{mQ4J9mVp6C<+v9icdj z@$sw1w8e?BV@X9n31>ivG-+?)buHc5eH@1X+#Z@I$L)qrtIc`}LTO;&SnXm~a{Sb9 z8f`gxHdUxQpP^*94PBRu5t@1UN>7K}(fhmhafL8FM*Uy= z)H*_Q!15%o4Y^@lW0~z=EF$X*R<4BQp2-tNTIPdUb}eU0G-PQzT{mbZN))9_CUZ{1 zk9m%RAjj5mW7#-EujsldC1?|GCL`M#-eI>Rrej^O$SXcTonGSCm~W(zvDm5&mdfBN zo-t)`kr((*UD)( z`toxlC?-8BGR(`A82bX6ASAhO$$=I7Up{YaZZ$pI*TgSUMs|XLP}L-75JUz9KKN31`Fa4I4LOr*@q79Ibgv1weEomygPl# zCp+*Dmxx$=3h&c~C=Z3n5p?X|8HlkmwWy|rrOj-Z@t>;(6A16s`^)$0_UsF{PE0s~ z9cNgCjNtPgD$dy_tW$r?-N&b*i;*%gSB)MS=yXV;aPdnQpbdz*B=`U?A@Kfg-tTUL z@@_}Aw*e6bPh*WKnPUl{_cv(N?PW1^0L&T;ge>oq&|MPJ*k6YAw;>rmWTzJijc;DyVR8t%=IWmO7`N`q$%;!$Yv7h94`OBI$}lv82S)%+D4#gh?+sE#!f zo&^M#XfE{1U23$`8qeF6<|Zm`I!k%6ClKqm@w*6gcx-Mc9HD>0*iOF$F|xtmPFs;^ zzKAN-+BF2s8#y%-_=WW%zN)G;s6|#e0}YerQj6Jk!*;s!KFln%Pd>+1anrTik?drs z6DY3GzTYbFDs6Xz_<#dAYOdg-K$fcs)(Pt914Qw9d@iF=BL3?34!vZyZeQ zWq5y?RXG)+R;7>HKpYt_=sZeSMv;@h@+)tadV;HH()9a-3d_1dIf!Abgn_sVy~BJ^ z1K1vh0G6+8SZm{P%p0GJGkSX=x^DcPJX%mi_&8PZ0^N$M(y0QaCdGaT0{#@}oCzOW zK*ZYtf_2fo3;hVveqODzBoqG)7Dk+9Tox2sJSQ_xia^K5m$XxS!?j@}cdog29jTIs z`=6(^#Uaplq9@L05*VHLi4>EqH#Ka(i*Jy5HJ0BeRvpi){l9l6z>0exOd4ulmaVv+ z-rT%-u^@2Jnj<;&ZDflBGGWeS7+B$vi6*BCr|Q^;quJs5f4Ara-KA^Kh@oH)Z_lQb z$f6z97X4AlPB-w40|9CN5=x`*YQ)c=z&V*HlV>xotLgG?@@`E+1?p#RjnEH#Gp==RDi8dAb10hzYwnHh~})52C?pC4BkYHwa>RzNToQ`x`_o9D4R1ka|1|ZWe2CBq#h>;4VE6 zma&fWWV%y?roLxI1W$W|f#h^)yF#MTrn!5~)e*pF^WY{ND^2`5QE!TL^~x)~idrG@MAl=LxPnkM&!phkY}$m8a}EFkxYxDe+>%@IgH;s8cvId7oP` zL&>i!uio)qX+}-ABW8&>MvQs8pl;&bd*L2zTk;YvfWX79SmePkSK%_Xfu#^ax19@L zUkuPS0v*Z!Qq3z*Tko7@Cs6N>kjpXE|7^D)VwYPI{9t7{6qrOZ!bM5=WKLk*GgsA27|DKCk4=95fTAhGt3AA7R}wFxOjKTSoMpja$NO%7AXof4pYOmV5GfRP^TeI8 z_SIK}gX?21%KVmb=Tbhy-kxLU<0n2wDW*R=b@dsN4u4dLWbWMYO^zzP`Qi1x0)G%` zIkjhV`T4N%VsF=+`A}*5Tz!|)^6e6}a&@-IzKXG?;QGDm)njAdJZakTP-bnHIt{^d z!69%_$THj%)<4si)pg-%nosu3+06#X&+yvJ10AmQ_i`%(*3Z=x686d)q0};dyR) zIUpJV;zI454U*auvu(*SL{$?F?MEcx&;h>ady_wQ1Bxzq=|p*3^=v$)AlrcE}B>;oChv`B8zj)oJywrLth+ig#N!^uvK zqeM}6%*aMW%M6(!s3`GrC$%z1&sWr1@+t4YO|$q7Y93FfW=SF_!`Fh-k}?81IiTw1 zP%{wDnMgvD!Wag+I4N5gfI3}dq%~0n0h`3Ky#KQ!sR&xF#SNM&TIu)Pt=Qq{s&bYz69w`qlWgcL;(wusT<2umgUPlu81&ht|LvI^T2v3bcc$2P zp_X#4Wx4|&p9wou$;dhL6Fy@4*T23Rxl(ffLuu7t_Ej`81F2Iw0H5iNk6HRs*xkOz zt0HM*k&;!6`BGf>Rr{BtR$;7XiR6pURxms0m1!I@`*TUcns;xbDfJL&IZY{yDqN`q zA~y>J^SGERK_B;~O^;lV%!+^@$BTJ#kqtYG^v=9e1k8!fLU?luE=1B)coEMvmKK<0 z%;~1{c|^EW((dJAgh?uNy@lO;{cD%E{)m6{*1B`|o8P;rhyZrOjQk_B^8oVr3ykvVSJHFX9761=xFsn=)~xVDfBF6CCYq4nBn-t?!{v zZYS%!&lnQHyGe*Jduc(DEpG;g#%ET5qctVZr{5hm0j1vX^bPKFo>SN=Hb)1P=$Mp~ zCHEy&v^Nv<81NM|ZcGt=4gFhFaTmAFT4gR=z)b%nO zUJ$$t+EBHBV}KmQxMPzf_B7FRCJB~?rGKNR8IhSh;&8i!&jj?AK6xv6wAgg`Zuz*> zsJO}ovl9~uW2}@yBs&4YSG2jisFBC+mHuF~pMXKi(E$WQaR>tJnUlsdw;zh1DFFaf z3^w22IMY)4sh+cAQ&=wdBzyIBE0kSrE!?(1#`Q3q=XqJ@et60Eop4~)PZJ=FL7B$h zsn}={<`R(p_J+YTv}k>JaHg5gR`i2$+Bj6A@_&VaK=sBGoTN_~o(i2PfarA0VzK+B z^o7{3Y%l&@E*eE1a*nRCv*wPdq17$yJLpoj%3dl@V@{5wct`B!eb!l*PaiYh24Z)* zf5qCMc~w{Fw}RB3=hf32?hOpoHA4weX-M`?H&#F_%`@-TJzsNVKwZbj9|-cjfze`T z`c+kyQXpBL+;_PmG1NvQxwzL}FFV7U=0-J!7@Y-}KQG;!!1U|gupg@g(4$T+qfyw^ z1zqlgz1@6-)U5R{Kya=!j%D`?JB0HXc2n5B#=}Mgl)5a)O$^g4CIK~dOu{slxYsZQ z?#2^=J-*ENWkL3|7wz|Asyi-v?ZX?nRw`D}uMKw_LzDW@INAvxyENH6JUvv641Shp zWX!)Gc`JrCI~Td-UOcEzla>!X$NYJJr(J313qo%%36+|el;cU>uetU;n<93EzjKx? z7->5Y>JOR*8a}&MB?y<`teZNbE2^zFiXUq^IpDXo;3d(_=NqLqtxN;K?Mr$5grTyy zv!$fRMA(kVFeXl4&OZ4^_wk1`MT*`zJtMjj{UB{oSbD!cad|p+5R1@YvvzNA*3+#S z?c*?$>TpHsJ66OTrS5HeNq}T#{MB?8YT-; zYn8riV_^lsx?O87K|=V#_mVB9Y}&=hg$$E82$d;?`Zm6`zud+tQIyEjd?;M}#d;dg zGXkKR?+&1~7R++(?{O5@)7;YUy-uvibmy8X`w&ZqeZnEb&@|I>kf!N>en zQqo-40rd;hI@=TmYawSaId!x)gj`*KmpT4z=kx9AvDrVYi_Gf*D*ddY2Qoz+>=bWQfotk#7(b8mSqKc zcM@!_{r@)4nK#%f5PLq;Siv#4zdjM z)9xq5yjBjO7n}vsEKLnihKYT^y9fJV;=Z|q?XH|x;>V~uPFIygL9}H6L+t~;nl+p9 z%q|ZQ7X4c1oiew9<)7i}z+NyxBdlH+#%V`sAqJ@rJvX2U9$xS;kbr!IM0EVG!7}5T8s(xDUX~|Mt3fh&maO*Hv)yRb3ef>G& z1S2w5&vTZr-OFSIdE08c5dO`PMhnUqPU6XQ*zPhU>BvcNpcZVS&Ei&E@~|irDi2pn=fDF<;A{u>6*YXUCBm}6Y{s2M#=jw zRspUO{6UYfRV#S0hA7aRfx%M?X4cU%%%9vvV+FFW1l| zLU7_&ae$4<8MW?bdn+dITFTw|JewEE2VN#}JkP^A}q zZT%RRv}uVZXTR_tWQwP|?-PL!$O)BvuKzStnNV>SG;RP5V ze#G`73RnX7jODfC`FZgBylUZj^oJMj0!|hJP9U@Eg^vLzZ#Q!>C->ZGdsrn_IOqx^ zKThc9s=F%-n=c2!_ua?J-$QJbGLZ3Bk@CsuVXNc@uwoOf+Dw`EJ4VX)tBIMl@FIKy z&3K0nYff`sW{r;xM3v1X%!B4CGPTSjuGyRyHqtSzkkrs1^6;Is$c0%Kd*XIsmh1@d zt(!1gmbQ~g2m)rD8KT3sOY3yLr@y4>3}M5b!_3o&OjNXTiAC=yO-Dyf5Zr08x9Xl< z`=TKz>G$_ejfb2T%n7x8X1oV>-oMM6@!;tHgr&Dszu2=>r4$sz+Oqc`PMPi};XEqu z^VV4tRUjO=I$FV-ULKsfFR@X^BN0UAF$K>AyO;+fs(am7>`z_# zbg^Gn&?nEhaSsJyIPGijXe`0el=b&KD+k)#4YDKykMyK^9j6#j1h64+7Y0KG|bH%%e5R(g~aW>c4Y^ zU9GnBKEBD;m#ub4x>U#^FiY@TKk~iA+5{+SH;dka#JP(6`9QK0rCm+Y{d2mB!p1H% zMyeF~U&kbqg{~-TBUJ@*Mk?4;(-H4b!9#A%RobiVB`wr*mRLv)R58{I`wezM6-Os7 z30dUmC_{sM2J-^w`QXk)84bw@t{y+3~~lQ0`)98}<)X|n`5w*Uz(Yb%deNXi#UUx5Oxw5OU4^Z9im z_`a8ibSGSvGwVu640@-O14Oy!ZXGJNnXtptrb7}F4~{pRO~FqFqmLuhoGzA+gjGGq|mw=p{k<($^b4(Pv-=J^7R)57rW*5nA-dxTPij< z)k^blr=dz)+~%T!5YV|FLEuNKN&1^7Qy?#O>Ia_wT1Zb}g!6=3Pz;M!;?M-?l}X>L zxCjVr?t5?mbP#4C70;lgW7s&9lQUbLxH?)tAYOG+6PMLA0C?j^%*pkoq*+;wmX*QR z4G)5*OoD0ywB&xYUMrN`4zJ6?pkaED#6DTl45abE&ED+O&JXcq)O=IzfEW>c4OV%4 zI^Jj@>18798@j++(i{MscMI&!$%H)QP0+$t#Sm8pnW(yk?Krkha84cShwL@O(W|7` zSY5>5Var0aKA>8EUZgSj-iEct&d@&zse3aQiQNv2CRtGvSrPl!99C#>G+zr0Q8r0i zkF{Rm@jqq_=6pMJ;s zU3D(Bw7bS70i9b1t9y%LQX%Fc{O$F#^)@2M2kd#ronrZZrSiXms|85b7ilOFt(kXZ ziRt@f;`u$!#c$|BC+C7*F3QWv|GG3dU*w29B+}C#z(4-S zg0foA^+Z^%^R2$fgd2Z7ZCPc%t<(mv29{)3d0zOmEz3S<0%7~!=ET=NuQ(((VBWjr zFq8hyG^Y&j5My8()pVT#ib=mY7~>ApI`(c>XdFj<;$5h_jzdYR8;{v0Q{Xjzwn06o zVf6;pA%`h97(cv+C!GKs7l}X||K)&)WkKrr_8|y4d8h6x5CI^7g3WEkVEFFd-k=#C z2;5r~JU8d_K#ahwUBbuS2FL$lVs!$%>HK$$6{wrcaYf;))mv&u7iROGn_ zmZv!Y4H1CO-bVp8#cB#1ls$xV{+1-JE z*C0$PIJ(Z{wSY+VwafXh1Ve$fG`S)=FAkdd3F((5QpN-EiL7B#$ydv|j#pm9+~Iim^v zFE?YNhDDQP^cp?lNov(%VAU2k#Sxy`+}y>fD73k37l2vokws?jXV``cviGpB-tNM3 z;`{q2Mv9F5O;~JW@x!4`)MHr&8Oy{gcWO1CB6COv4fcJz?_Jz zb=XW6W6&<|2ONo>%B2@&bTh*EWS{JIEuU3vUP#>}bcxqO_`xL64)q<3oehen!ykl~ zmSfiVR3s>xn+M)j3V)f}<0)v938V$lgTse~CG>2IWst*cNmY4GQ{>|kvd;2ar=kSm zraBQ!5eEU!qL|aP6nQw*9YE$ly4JS3&z`ETYap@mtsu}27z!C!v(dY&xa9K6KY?P+Ty112Y2BV$RC1kIE zs7m9XHsJYDkfMty$o;{Aq2OBJ%TOoVGNgCFE-QlKi<<3{jGumt zhDdla7uiaU`KE4Qq0-{^+0Iy(nszAbgs@R;Q39!49U~_@qy+onXV17DYmUm$&597_ z6J^mr-oL|wT83I(kBg3(DozrpqTmq`_5lMd(Mr8fp;xz8qU->(Y&xJsI5c{sL%xlc z`XzS2a%f}}_{yYQs@d+t#iZBs%Tvg#Z}{^p|JMk^>jU!cZD#b!QBA`iqha=}Bz;)I zJhjvzffwKaU9?8}SO!)T1I+k^Mhp5^CjI#v4c1%d=&K$n$}{ng(HgicGzakEZU@X3 z@2|Qx@3)5By4#z?*=Dc(TnnJEXdKS|T?45;vnTaL`CFW4kJV@o^o@>ijVksco&;|2 zAKL4ls3oS`r{|3cDk&i7vXij6b-(toAI0$_aF#F3BIkBnVN;@mc2b4CHhG)qWrNO& zrA`2$7k=b0ag-f0;HPIdFZ{(+1VP}d!&A8AXdI*idQ5Tme6c;vjr;TW!6DwLoyRpZ zK5p5yB{a1%HM)UW467P(`*QAW{DHi{;o}jhCfKR1LOMAH68Iu{Ql|KMxTlRb(eXzX z;~R;E)v+;FF7FUk{^t-oBO6swnAg?|JMIh_Oep@>d2Dqp7390#8Xquf)tg-&s-#>6g_WpOyYT_nrA16jz5skmaKs>)TWeXvvJ;TsG<=+c_Aaymk z@!=PUOqAdZgyA3Zxj=+*@u1uCWMkpgD7Uj{49-s~l@AN5iKQ$?uE^)l|7=ar38yWr ztwFPSMr)pNprpb)_k9+^TN}j+c(wH2&Ku9AZkwxr%#n#;{b5C%%Uh5Z=357-tvFC-#GJ=qQX(? z61xldGfVixYOfVe&Nr}XIg)Txgc0`ngmD*JmpP{zVqx<)OZ#%C-EJfLM4BfL zhKXVX^)YAC7NsSfy;GqsBqLi06irYUdI)n+2;<7s@{W={I<8#0Cfm;*8gfep!{19N z>8bdvEbp8dK1dOl6Gu|W{o= zA}UAUXZu4Gf=tIt*t*GzC64Y&5?B+2OZH6kCJWdozCQ8=IV76cHl-zC(v{W^O^RcX zWn*YS9B1sjHQkijv@oV0I)Jl;7-6uZ>VWdzez@{nbM5n!9yaz4id22NXl=Do!cq!q z2pCV|)yN1m4&K_Dx=ZmHYIJMFAiAH;lMs?rv{Y-bq*?I6Zi1$fB$mBA(R?dHr zaw!}RJ-VrXm+e=nEcSlpRYY@z+i2Ry00fxf0R^Ib>&=bqcN(u|HhOJP!9R@|*-Yv2 ze>yByX=-mq&D!hR|H1zp#@cY3tr;Gj!M$Q9#v-&=mN07FSorV`#xmruN$@Dqy(eUX zlL8A@!fL!$O{YoEgXv>EeSeq2*7|z=oHDa>b9$U0?MH))E8GL9LFeYPIkl9`td>EJ z-3s|Sygc2!(d0j;q7;DaMZV(SO;s*!{Qp2(QVz&1o>TOR%(d0+fi&Mw3sB;_v>t6X z8qDu6TVofc@72x_G%>d?+1FIAeSr4~0xh*;=5>2IU9I0U>W2u%X;D}*8G>8kGrKj1bKgRVw0uMYe(Ll-U& zg{Wi{)4e`@=Ce?`cAsSmu(+tVc+i6i{dpNN*4bNgfRoYRJ8X0Tmrls`sE@<7%EF=Z zcY}_ctL$DafXc5ZeB;7O=De5m2C9gO)9MuOmulGv4( zJk0%e*b<7l_^(QlH#WA6eo)6COG}!cc~V5F0Soy=@b*jJK&)pN>1*c>Ply1FIqJ@6 zm~>h7rtcnP>&0gCcF*;I(=y09h1eF;g;}grcx-D9Pn_-ckl%$`-vj zDro~68VH=mg+`Akg&<~LkQijBT~oBK+eY@8fk4#gm*S!~tf&#OMujq% zq?^9rkXXxX$ueVK>`mfl>3>?h=qkJw!{aJ@LlcBd zJw@Cd-NDoQeYM1pq9~fIwz!|V{9X9F*J@KU&=UEh^vbpAW0BTCUbxb`VoLE~Zm-$* zlTp+FVqJ9Z-i%n4h@zcPV|%EZ$c^bKpGsxNELXIbM$$firV{}B>flGcgB#1aw`YB6*wJ4FNXOF=rhBFVerQ$_8To)d{pIUEaQ zda||aJOA*8DHoYSDrwNG@s_2r0YKH3g=Q75)bbL=2aqLb3k`fw+kS0BMy=(^xxV?F zC!fyXXep5*mlu=|asv1#>D*sboK4=-0N+ppC;>pXKg&Vz-52UK#Cex6Pej=zGrVWh z4Tsbd6=o*LuNCtGj=YK@Tw5SPfyq^u%ij?}0QqG`K1*i&yjow78z%6`sQesm4_+EXfPs1?)P483M;^sKg}XRj|pbBlmUwb!`=DFEBh1q#>t`NLGAk?CWY8?X>< z5O_3)2}xLVsIiD8BXmSn&5AOI*6~MyKE%IE;|Cc!9u5h5nu~-HAa~B+uWRK5n-71H zTH-APrCA?i*x9q-CTP})bl_EDQXMI;!b!0qIEpAno#PQGJD;2wApSZC-ULEP61$pv z#4d#%;Ab2;gp!JYMMh6-A&nmn3C*<1(w;0<@)%( zhH*#oi9t0xkN2xWbzTy^vM?Vr`fv%~8)|-bh1juLSM`NE{`os*mh!UMFw`2{ zO@@+2dSFYS^P`F`7T3F8Mlr4-{!`*h&H85oK4P~|tt-9NKz5F`rre{`{uT&I1tlx3 zf;9P+;mkM1$)s=Pb((#QzM$q$%|;E`pDkUs`+sp&Hhh|LkzGD!U5gN>|7dS_1|GQG zUio@|r%nptS2K=DI1>-a45nzr9YDt!{)8Mh?b+d|@)yeZ_`{Ob>AM9J#>d=W<85lC z$;@PYA#1QQxG?P;d(3kdimij@$kHMP$`pPJM$+gb>BTU7CN zQ_dKmxdC}aF^12rJv!4R?*yeTWA)e&A<7zMC4Znj=J&Db##ke4m|)-iyLxZ~s0aQE z=VCTPpzJW}#AlGUy@KJdnw8Qun#|nw38)}|Z6*c+X*DK!ZTI{E7ZMY(RfiVZBpHK|AG zoeRJTi>+k=EDb-wg!GiwW7F&Gu&CM^S2TJC9Um!j$>sM)a)g3sD~#7*=&9Q<6Za(v{{0y^t-7|tL`$V;q@DCZv63-{k((XHhR~; zX|9g;<>h^41;Xz{|Lgmk@g#z>XgKM3=28uijg;YLq;{{@<7$AIqJ_Pc+5_8uJOWd%bGd4)KAA!tK={x-M$2 z)@*D>eT;tk$h%Tf7OE*d2&j(432V#Os7(4&+`i8c{NC<1GjX^~p@u^MFpy1%R~ctX zd4I`Q(1pVpjh-J*JvD?8g%uHnnMI+osBpREJw4tk&r6;S6JAY~HTxbi0@j}$cP3af zCp(i)}Ti#f-e5doyc@ev&kNx z&TL}luBn;M>$vo2i|%-~R8HdHfsJ*#G}Lc(W-TzPFVIo9y2V1Jap7`jy=%7yq3GX) z2)|rKNFqY(r>~#3*wv>Kt5lO*f;}$Q5epEUzZ+g`$JI)fADFR6dm9Y zQg{T{TX>@QM>!`3q)C(AJh0Op{MV86vRB!%!0WC9gp6nOl`e*M%;Ok|D&I~#RGES_ zFj(mGASKJz;25(jNyc^#zJN#@QX7m> zj6H||&6Vas0vLobJV07Vz{2||L4Ywv+Z_N(O&vsq(0cYa0Wx9G%9#*eX5`=ID|vIl zpAKVDe)l3Cgvd|M0RXsCv&;$-=1(#ok8}D;;%N0~FDErc=vs^TGW!M+#5>TN8bVyl;WRb}_% zj)-!jq8&8c$fh<1b4RvPputwFVyYnxYlKe45stbnrLXGW{37O5+<-Ry-0veb-C#ciPpe# z%1%(unrp#kwE;)?vLzoK{;k0AVEOVmMGD>&6w9@oUO%d*KqALH&e}u046aosBSZ1q zLRAD5v1nm@%J!Hzb!gUgDdO2_-l^`gzd;i7x1P=BIFD_?pt&`CT!m6=`)NvBR53^i zF;}7`J|@$NaFOXxf+aQ65;}T@eA)6XAlOG^H0~az8ByW|w*}&77h69!&aF!+6R{Vk z&=~_r=~kO|&TLD9?I4px{`N|v4y%qGZ*EAI0~M6kD{@_x4&=aN9VaKFe%c^%lsww-cL{np_#1~4(ja0!?W8Yl=-FSRB`^~88w)dt6D|uQ-Re-J z-3W0&ViwjvpMr|{!o*(1nR3V5&D1VNylz%Yo9UybP9i}hLH-`VZsJ%j!2>Fp#bY8m zth`0o(VXPyZ2RMOPu!iQRd)NU?gggBMlU)>Z4uPh)g=T(33h>JxiB z61bJLrnUZNcx9|Q_0iUaMl?lyED#m|9~${FhBL!eyyPtPI{I?7%vHa1sD$+RbbL8- za@)dgf=#*Drq{JPi^k%qo{n}3fLF6-PFgmt7~Q^|{X7bNqT0MLOxh2YyEm`hrTM|t zt?j+o{H#2p-5h?k7Il#g?IgYPre;eAvGIL_W%XLt{zswyuTZ57Z2w=3n9cw0yZh9t*02K;ob_s*k3S~L(W&XyWYOYa9RqQE-iO1_J5}!yEE8F!i5RjQT+PUxO zI=#X6h7|Wdz=J>z;lnom+#iv-JG8=tk4DUn-#0~yXUB&o;fA$cy%nmx`#Us42WWy! zF|yz6;pO4-ZHmA!I@qkeH8Q7md-d0(Wlya{1wA*96Uhtd?C$I{91s%4$a zQmM-pzFYhp?esw_wyYF!3D5P5n8v1g9xXw9;bg%5G}-bvCM)!!Du@4ZQYpODTgM{r z={4Yy8SSY`u8ECs8rTTanL==CyVYhOUps?r95A#QE&_BF>X;faj7$kBH{>hmwYmJ!o4S z2Cw+bXxfcUTG}fzdoOhfg?v_8)GU@xO^4?AFt*g(t76fkjyRS-k5!yBk)Vc04OD1o zYQpR%s&oR;J>LyuX;swUmW4Co}Zo?sWTzQL^2xg@RiK$|l) zTOo9#z|Ki(1(F+X3nRijIu6hu(T>;f(xO9*NoltA`t^vTA1RtbUW4IL%~a{@?yBKE zBaqBtV>6jsg=W{G0V&JAE)qFLzt_KN5iOG?7zB?HKt_-AB8u|Oh-(A1I{1?#DV2g9 zfu;#C_wKzhW1u~Doa-!nG|NXAat6=6Bv%t?_wp^I0=|1Tf$g&@q{W4p z6=!{pu<=k};!n9Yl-PDAe2`XzW7lWMluXYt+*=dp699Hzg-dL6-=PP-KSrq6^+9RE zrzi(ZKxe~%Q)Rij^6bsace4ZA-Q(+z$~H%RdH%o)#%-^jQpO(1pI3tJRg`a$nl0WngIj*tj$oYogu#^?h+Nv(i=K zv#l(m;KLeWnyYGCC@EzoI0vTGPir~}*9od@{@2#i2drt_6yAhy_1(0{3W;tEy?NH~ z3`uTxTD(m5V=H&@#Oyjwj%N}DWWI+s7vwxe*JbPUrT_5pv~BEK`**|*2H6!yhFYa9 zD$m#RNp`w*Dj+Zxk?^#LB`YovzN_`O5kb11jVqrQh8a*W)_(_)x<_6 zJ{=fozU17ag)(CbTryDWmh_wlW16!x9tN^dkKHo380bwo#}0?WS)LaN zN64+gzqLuX`+#r*2mo>qtS`oSHfx@=(Z8@QAjOX#>fl*XnG+CmRF?QWaS?T-T z+|0rD=Okf_z*N)!jp-kV^Uzm|^iyT)>L185wS$wT`Hjwg)7Ne^DjDjAmcKr19L<^rdydlq)8xKY$b=&8vG z@I47M@T{-^IOzM_Hq$eM%XQ}*2N)BRPpf~7ye*y;*4cSKsMp4=ol}~3r*@a&PQY{H zO-?~uGHt0G0yiX|A8wi#LHMGLYzMqpt(9cvZ3Kj~g{X*608eq2Bg>v8#GR ztMSRj=+j76U-P@StfK}y9PT!_Cz_&tgwyYyY!%!OPwXzXs)fW@jx%lcgi^8|^uh45 zy~P0X(SU0eioDDrUPiS6>=t98=#;RA>dx9xUz2vCV2dE!UG z##SFXT3ZjqishQDo7W#8bm6NYqzwuEP8&Mlg(z9}Q(d(IgXKkqlU`%YQMi@9D1VC$ zPNaqdmN+gAuho!D(<549E4ju>$DFbBfdvIMy)y(^18`kFUt}8MumH0U(w50bVLOBl;VNucQapvR8Y>mo;&kE^!V-K`t zZ&~Bfe)y&0?VwQ=AVvNK;#kN1)}C$m)|vhexw{0#O|mw)1HqW}p>?%BKY*3YDw>0Z z8Ef+bI;qhVfYrRFr~p$|k3rR`g;I>*0+w}~L4g*@&q@@>{iY}8gbgHfRYF@UD$=cIS6 z5X8TI!6wpkB;QU+bilFN$RmlBy&DR+d)Aw`kaPxze~^N-2%BMf)lLNC84@b#7sBp% zi<`417*RTZX;bF!BXRqXoQJWZ{GrL5@gL2~&lgjyhsg3Ut_D{+p9UppHkz%caqHWu zR%k1cd zi^Zz&=bVgP<|`=w4Vio-7kM?+a`s``t(~?8YT(p`WOKT-z>cDzOW^7y z9m)i{IT9zDSe~5lt+}pG2hZ7NWFH39y(NSlW<`V@W-Rib*-_RXiOjnZoQx`eaZcz6 zHeix>a@%wU5z7J=SOW39rTXg2ml9jjh5I`wOJVzdaIscp)#g3UMW=Dd5Q^T|2ewh? z_r4aVc01vOZHL*0f{2>@g~O`rgqddN+uQ5m_C1y2)tvj}F9DLr%jfa9stbbkt~5+* zHVxNJB3-v^^^pgJGuynbgJU%B6+tj8XBoPjQTDSti}Tp@TU~#ro{V*u z-=o2$sKyrM_j}Iwqi^B*pC%Zl{|Zvdz`^+ct0Ku3Mg9jV&6hKwV#=U`w#A~bNTgKB zqKw=^pQ`F+dn=m)~+j!kB5JkG%hb;@(``Qpif!H^7ENg9}ll4Tv~kJOtP7>VDzMiz+12yKCL@dOV*TQ~tZjYpAS` z*wy{CM(JJd)Yd*_hWRC5$L#p1))7(;dG{%;M3NeqmGgQIj8+pRN(y^m3v-Jk+7Dgc z+*1;!mmM&<^z8Mc34mJj_CiiwwEET+ini#iIxA?nR8Bn9cB^a!@w^Cat;9syHeKuL z)cF3q&)SdlhZ7K%9?`+FP4=d2#JTKTT~$_Hmn{Z2*7B9AtVQ`$&4M)~=1vu%-3zk? zw8Qsj6ebUcKCeugfk-M$_k)BpQV|T?pfAJ@*v~E!kq=qhqY>K5!s${W* zr4%1z_$;q-ne^;gh~eP_>! z5}vfc?3eCphPWM{-xw6|SlJhu0WP!)yFVIU%GV6|yLAZoH`)?q3V7Suh7$DHOl zf(EFnjV|VoWi5GromDsfTe&UK z%3Ab5>@##VJ8^=0QwLA+C*jF_SaC#@jXm6jR|}|)rH@*-{b5uN;P4?ek`pu{wc9#IZb7tBe*}bYo|OlvKQB8r*^Y zVM(MBDa$|ljgpOfuAQo6x8Mmy9OyG(pKY?h%PBJcsJv1BjEC&@rXl(k59M)WVL_X( z5)&Nc7nK%6@kgp?Fe^~2I0OvNCp7<>k|-1q!|rSW#QD%KaCj0O!j$RHSMTB3XY^qY zy3lW{gCSJ}ZhQ9Sx?^fqUN6$v8k- zwY4{~NTl%M+V%`ZqVG5a@?XGgI*h1U_jwXrUqk@K4)^kt(zQo;z--Yz?G1}VF_Y+G zkH>Vl~KQF;%m_)3~J6$Nvc#Pb3%P>copB;moxVph;)`{<5 zH4tsW_!5f&S-kgOgl_=%S(5#)c))#5|g7T(Sj7+#n;J(^IpmNm%3b z?A0wZY%799m~a%sbTkC=MB~II=~H%#6XzfR^K$erGFQ^*#`26g@Egfijt3RQiTydp zWrSD;(mzD!&*R{p?Fl<_q|xY_XHQ!oECc@cN$W<|I(yv%GvM1nyl*$m#m^I2f~2=9 zj7@rcG^VCAK7+R}G9{7k^|7H)(uf?RPElzLp(I&4sT;|EvPBaujP9jdJd`pKHiR~# zl+KX7v!PoweH7nu2Z5T0DzHQluSQc{fi$tNb_bK8;&STCJ6%->V^y~6AIH!HdLkl$ zkz*LwQqc-3ZKbkeD9Ocl1#ky8`+Jc11pN;3)Dc0*tvw7mYTNK$@(qEdMw1=~`1NZtMRAX(m8c zyY^*0(Lf;fdudR+)~Bt5Y5t84|F>HdU%lAp zv10#($0XgQ*}a_3$iZc`^-ad?SMP_cb937Y_aa21aPDzq`%d}trp^hi*tkhnRJ*tB zSkyG-ZJo%&xokac#lihHNB_3&*ek^|Nn5fZDZ8SCCyM-m6M;)BTT)BZ^V!ABNhy=!PzKXf zTk7RHcRZOk1#>_ewPV3{pqg#^F1f5UrLtkQc55VWRC+e+p_6l0bIMD zfq0ST7*`nk&uPKCMz$0Th9s2Oywf3P8m_OI5g%)YY=6E0L~?qen!L0N|3<9@M1Uqt zJ0x32Mp9#hj9h@@lwKi^qbcck`EBH`PDd$QZ%Cb&nH{HV=Qrk8rK9#Nv;i}LjTn9E z;oS^YR~WTbT1XWgKKh0;72pf;ulLqU2thKPrXPE}j_YbQ6N6-MkZz1KR7q$spnPiL zl(O<}y~Rw?Aa&g3F*y-#gHWCJ(WKq3iXb|-LjZ*_h?-9YtU3AgO!ZBnM&k;Sw6MpB z#vBl0i66%rhL~(sknvC8>2xN#Pu?)T4`Oq8OX4*6vra=R>H|6E`HbU6nkV}%^R#%W zh;;m7(b5tqjfCo~>~SOo(W(4{vY#jom2>{nb0WPI)IS8w4`>rSTC=(pQY6#C&4lF0 zlX~naV#~YarrQ3$X}@?jmxodX=P&rT;-c6RYnRgHEu!L}osb&qw~_ZUm_{bFJ|-Jp z=Zo+sFt_6U=^1>N_`U=JKw&K=t&Y(Al0OjcDG&X>nlK^Y)wTHsr+F`)^1mX^6y6NH zr}twE&$OLC{%p$afI9PT{CM)#)b3G~POWVduq$O#OGuhge0~65*_19Bvzv{D?l@hp zN2n%%7f*v!Ymvvg4Z`v=1JO~5yw(K(&~p+d`PlJWymjBE;X$&Bd?Q|A7Y)(!N6gJc zk-)VA@%&p~odz*E$kUx&h;#J3e^0PsbFzmDpk&GN$Y+dc(PT5+R+xn`XPkKt#@QCJ z*iy3g1BH50gd`!65g!`6pxIP))v^=%19QnRjfz2F7jpB!I%UUlajh0(1T;uTNB2v< z9V$5Wlxe+wU-Tr7v6ufsv!{elgVBB%d2xhXHjq0AG%`4jY@44}+$_NWegw>(egnK} zosHHpmAqcTYRZW(AshJ97Cv2ys3CcDQGO8LIISmA=QtXP(YdQ;U4E-)vXJ0;@l07hwKMLsA>WE?4SuQiS#ZX1(GUE(& z{KG{y|M?2@EgTJ}$$_t}XRwIXCHYD`?N!-c*T6}u%V@PPri54|UGCstD_0iT48aU~ zlPu5&DS+QBM1=U06feGtOo#2xG*#ae+MKMEdw_OJ8FB~QB;ubV)SeufmS zUr>Za`7)fC&^Rr@CWOP1+PvpQowsi7Bd4WKuf!Uw#-zkOL#8JH5Tah+s(`3}zJAE< zCw1ySlOcc6i=3`GSUpmZUolcZ{1-)Xk_)|$UY>^3@T3iT0ejSr!z^xn=7LuOui!am zXmW=&)&dun1z`I|}T)o@252{}ng3^H>m zTT(Pdrdo@+gcocm2yA*0xH%w)P#y;e7vK> z<5{Tj4u9-~$Stz8zr?E~Mv zP#Mp6oC2u-SXfQX!*}bl0N`{_RZMBjVBAd<6Th}Oq|{2FLk7IaPK(OzBOcgD zor51q7#hJ7uxrD_l44@Xu3Uvrf8?K1!xGvjnccM!F}Zccz~X=s=gUE26HHaB99Tl& zNSbwU3TuZ2B~3*;mw97xlEwcfo=M%US4$m6`fLGwX}<{JTR1?~(wuX`t+JEBa?TDb zBn5*B$=i}xB+QTIt&zjtMIu}kiQ41&S9J{Dz9TrU`Rk$h3ws))`M&w9CS&ljG?K^p zYRWE+$!;0m9E)S@&%DgSSx2UsiDkwmQA5>a>37iF9lQN&Ph~d}Xl3CS&?rxlPD3g* zaZG2f7@)yFjk2log(4SQ>OK2F#+_1W2>=m*GU$Pk5GebssmwtJKC?s66n2CH@vjUY zF0ZxouS9zZtXywmgTdx#`r%VUe$Gm?XEX%xRto1?4dH{sLV5IofkC)U_a(Oer9X4R zd}Qk+njDJAn9!a{V72edp|U>q2#I3VX~&!y$Rl0|LTY1IPqz=nB);{sA`~?hWV#U^ z;wLGDH>OR@qqEdl7!hpAhk&U9Mff^|`VIfXAFxndp`V?t#0n2x)h)gMMZMyN)THK- z!Mevk&1;R>^X7wpUn*k|9f;{j^Mh)wLDXxoILa|EU~o;I=@34Dn2#anA``$Mt#6;7 z_D3Y&VAHYxs&pXyfK?Etw(Oz)2V?cP$^<|nQ>p`lUrkSgg8M1=41Th}{fu!}H^ex1 zaC~wneE;lBDdg6On;bVQ(!`^Ioy0J*cr9PrkDgyH3E=tZzGC zJfC4AL;_EmoQkCt3H}jGUuD?`7>`{A=iU`;kB(o`CdBB^J;e2I?ed_TyL8VL56PGt z1%6Pe72PnPMd7VmIkvwj^p#(3+PI9=@>lc^-0xwa9^O9@?$|Ft=TLpYe_dGrCq^j~ z2OInUzp(CTN+oTzBle!DQLs~*7(}28aHR~{u4Zwhv^TaS9q-=<5F3bAiyzZS#4xM8 z-(QFV6I2ASH2O%@Sb+u-%+J-~r;pS@_m1!L^)dkcm_*GO+z-thcI6ERnpICr_O^HE z-5Cy$QmZtyZ}@6c6{+Ug{xl*eG8mC~$29Hvy`6kp(w1ne&ZL6*ecZugeKqjlY=Vth zzOQxq6>s2gt!Sc5&D`r}r7%nl+WlklO}(zt;3+-9^`F0Tg|FmCT1RP zbw1}+!h&u*JwH9x7V|G@Y}~EcTCu4%@lPWvUpRu{uiIbeKkSIs=$|+hzcQow^T?2O zMQzeHb&f+#61^}xm8_TW@Llc3LF0HT|BQ%0Ue%={ znJq+afqjF$)?$A=OXuHuk!^1klmX6nmbJmRHt4i~zxd;}Mc8v6R?ez=ZK~5^TMeLU zAknr@W6*=x*Q)CxX!<8HTBus(M0E(RE}ox^^%XeyJ#-n{?>uzq}C3^Dbv zm6Z(;&*TaeYBz6uCwEM9V~^59k4yojxOgO5%Z3b6FEWUwhfBgNLHit`kIJKL zOUH)D0iIly{;2=1oUx(B!o>(-?zP0g%)O}r)op0DW0b=kZ8aymr)&Pzb*E2psX5WIY8pbtZ;BIS$-5}>O@i^4*u&-!a zf<)NKHNezgSw%M)wp5>LiFqTQ01x*YujOBEYhT**Bqb5Eld&SJE61S&k=DyefI?g7 znt4qklNt9BzVFN=APqU~O)^05g+jq}mbnZm4)D4$8`e0E@%(pBJzu#tGGp?{8vxY| z*gQE*a?;4kq088k29}x8w7VA6-+?v|%~!6_YBK=r#i9f?w8au5${(3y5dplBvp5%4 zWNH43_CQ*D8IXis^bQ01L;M-d1-dH}-bF^S)-Hpx^`NAra91S!kqGnK{P)cAJMGVpi>ZsI(kk2(1o zeT=ydO(v^KJ`^_7qfu|{XTkvGnwVu}pP$Tew*8=^QoL-sL3 z9JI^x$u(B>v)j#GG9lhM4(dXlyt+)`0hl#<{XZ9bMn3PP8nY7U@K8FS9IP`se$C&d zRrm|(bgvJ~Ej=jqU*=`hH9V3}5}yq6X_xfPLqMVT5NkV=56t;=gy-NTc6o#bHSG1; zSj3B^@)^hM&P&4@FcUX!iL*HCX(B)mV*4i>Z8~A;J*rH4y>f#=AR$%bA1iP2gA5oKHlr&4Dt~ou0Fb~TC7GPe9vBAs z5V%$WHe}9^ywhN|!Rn#qMqW>70Y^Nv(5a@M7kI0;=bnZ1Wjui-(Rd6YkPa?N82(g5 zw#G*dR%-zsv&k84KI|ACxK~ih7btb|8S9{U;(Q{#Uu(6yrie#Be>JqD)Ed@7}EW;wqEq-gJr=0G%oe1n0x!d&b zD0v?!)4OzDS=VAt{IdBjTQ2Kmun7{kvX*RC030GYL{^ zBw0pbu4TrE=d5(ePtB783*%Dl8Rium&p4Q_g8@iU|2RDDH&oVCMVRvA_C{;^p?j3+ zwic5aSg_ri$xO^@{b@xrM@u`#qzX_;be5e8e#P^m(Al^PkU2f|TkLw6<~$QJz-$KN zGx3v~#00)EqLU@?Zw%-LxcK|=19M?^v9c_+qD1XCt&n&Fhid9)6MVbkwwugI2qAB2QH^PV@i$=%LD1@^EWzuj98 zczpEVI!Ir$x5@kjHn48(}z1kbmB zK8l|%X$Nc|CX77*{W+7lJu_o$=tV?o$WG$`vL8=oX7jG-3&ae0aCcV_t+cs>GK0^W z*fag<5>el|;fIUCscN2KOptrplHjJWh~FjTZgozSj*>?K?Tj9TXw$-+Zd5Dy%^VL^ zDB_sEbtsSx5!vnT1ZUZ;?x>1p+1wj$EgS3Oq>}f?-~MI!fiLj#+QwpkWC>nD8DwP< zaPf5lL2q|t=w+=pXU$3iol;FcSY$spi#B4Zvh`YytHS}@(fS*bXGd+PJN-c*uPa{N zF5^_dRe9$1==+&V(7C<Rzocy6i*gMEL$cbQwl-p(5tC}4sMF?o z!z^o!I~116_tcv`El+^4Y^w&uDE4L`38et(=AS!(SVd}r3Ax;>+H(+&pvdB)?ZM4V zeXvvQ;4jP`XN3&7WNZCHQ@p^_~W%`E86&8-VGc>WbU_hTuo6AOG!Fo`i zzwyn$8aG|q)0LUq#H?WO!N6(162>#?&-SSG(&FG>Sld(J#6JeJ46+A%if@Q)>JAJh z=Q}fpXM11ptzONQ|84bV`QNym?2P|e!P3--+ZspoovTA&;}@i@X8SxmXdA8vB=4t7 z%n`w3^4OQpMr=T-Ag#chi}LfjG}p~MjrPX~fUVlFR#jVjS7~AIvpXgW=5s`*e#5qX zI6AFk&w9;U5e+5!XD#XI*c&${ZV{Jh?AZAI^X5J->$70%rg=s1UB82A6c{JdL;u-W z(RJfz`_sy}7%48skJ-o2P_nVZ(8F9IUR;ni1Iaf$mD8dnk`V z%T5GC>ho1l9gsqEJ2htT9r&mYiCH;g`?cRz6B%^)Zc&w(Z}Hl$frQft2gU^RxAjjt zePm_^hucW5-cyWG-9Kwu(bfcwvGIYp)9NHvn`d#1?~q@Vj+V2}>dPPR6cFH}VTI>w zBm5U-K{3-N;CHF1VCG{cxJ;)wDu#gq0Vuh*{B(tRsa+hov)+AF%(tn&6<>f-Lb9)4rjD}$-nMNLTr+y`3n>k&sY+ur6ig9!k1U4$WXyL|VJ z#uC}|FEM|e&l>0cRvI`OfWN_}Cyb4{NrniH2ECcreLCe7+4e}6?E45I+)*Jo7c^_x zdr46D%4Y>)JS)OLdr}3wF@+zvUKvp#vf-kr28vXQgN_`n24*RrRg2vmpuAChaV-rC z_}XqMh_)9}^`>%;(t1zX;Z3zxNF?s>0tr_P?n})z$YDW(m7tfd;buC85RR_r(|$Nb z1&j&jlg0^*HZWY+x2_G_vOpL-b$gNNvBy41ui^H2awT)};-5x4S4~k4_urbUwZ{sQ z<|#=KJ}-{^z56utTSqZvNw`I1B6SZ`i70w=&R4fB${&U>Gg9Q_Sv${t?0Fd+)3+q7 z_7nSYoy0(lBlKYrDzX7sRaSVKAIASq{65hC)ix88N8xdwj*&3-rsB|7Rh=C&_*hOw zsLaqG>eHB!EO`Bk@mFRKeN5>$b{#&gqiokHAI!&%mpEj|px4mj+m~+B4DB=RmCq}v z0VoSE*=4Vp*n!>fxPpMq`#a{fvD@ag(|xuz#7=^Wv)k2>4PJ^09p{h9^ni~ z5ZOjPSa!*xiF6)+XeyV!bR-xtVZy10gX0@e-nY46s6J5A<8K@X5oFSpLvSyYm~h=; zcrpp25}Wt|kk~%TdoE5lB$yM<036(iJW7>^AVxum!Ua@w_`q7N=x!m!_qjvxgQOAx)gOl_kPF`N-tZ6~9DP(1$`SBWw8~{T!09l&maH$Hg zes)a0IECevRCzkd7Wv~dn?gtsOoqTiD_3q6P_p9W>!_~BA)$qbr3P;f`PzN@ z#!g#;OSG@VDq0Nto&ckf4tPDJSndQ{*e&kf-kuq3UQYCYv%|2E9>g>cC+^t4)BaCE zb0s`qTBK%lN(D7hCk)+c$5oTY9}ZS1srlNg_;afL?T&3!YPdl}(th^EiiY zGmRGTMXBo~U9YU-o(_)Y_;$SCFV^I|OAkPPo!3FfFtG02P;hvaM~oD7yvDH?O|pR^ zI;r!~KxvH%a{Ny>1HsQaooE-jyJ1TTF0oG=U}d1K$Q){QjE5#F)JIcdi}T<{7)kc& z@zV$|QY;}8{i+YACLN}+m$yuk+w(p!rnCu#_!USBHGEcw6n4vJS2v3!g~>XILP|eO zyp*-RHN8;!U*ogSa7NKpONf1BBvN~=qaJ>QMhrP`2IrR1N+wJkVE3v~m{tYdQ}#;Y zH3D~j&Gb+zuNi-mR7e?Dm|a!p`cX)^-cE+oNv3+sWeY3Z2ikrPNuh|TbmQZxb=w<^ zbd1a#BMWjB67G%Yfrpg!fb$E`TJNiK1rpWg+`}y~E(IzvQ6Y?>za?`>l8kfFl2&xV zXmANlWJlV&*tH%%-V$v^Z_X-Yt~N*;iE!O6wouoU<(cDh)X3r1ZgQ~#wKeq9*d)1?#;>37Zl6Ox_Ox_B&x{5(qz>)C}~7(mA9L`6xI)rASma(y^a%7=1))Vjn4$$WPlo zvi-*v*t%X>q^pa%qrcyGqUO;u^33n6iC&7JM~*$q@9UuN2<2VizplCe6QY%!<3AD+ zIVxIqSqvz?dv)~>^#LqP>)K1~o$<9wsg{sB_^CYY0~QMaW&DcICVf6&*gz;utd_-i zSx&vT+pxKSKt?}d{xR=%Fl>zN4+A4Gz$~j|N02~2XawK{I$0QScR_lQ23nVPzu5g; ztJYd)t0OgC>O1A~Yc3%q0SL9|Zh~)vhv}pt))bEnTM=87N`$V-GrXk{kv63C3iPI) zNm!SyryOAZqry({3W_x;{G8$9>qRgYs3kv{8M1irsX~s3) z#$AIdND)!M>~$a!&Wuf(7yPLprywfgmU@Tn;HkEN|)7qw5+iJL9ygvDX(vxW5lf=?* zlKkfONF-URnxLdO^v#CA}}}X z%<0u0rxM1lk0@3CDduR7Fs0Dg z6^{Zd_;0Pj# z)Nk9@mjlIdmNFE2$X=l)_Kd>Q2sT=u0J6h-?nO%y#VXg~nP8V{>;mp_C%_>}w?hxI zPiWWFIS@OMW^6!8y-42o&zp4=>`7>ftrMZvl@TlM`YM3LInc%JLfX0uY@IoW{K*?i zxux@Q_dD_np?>WGKg+%K^4a>ZaYB&-BYXPykEpq9Ow8DwoW0Hei~S*yi(Gi$QT*K+ ztvyZAPM_(>CpoMu9Ew~Y#neS^LFgHwPD)P>er*H(e(`9iEz?UzgP|c z_HMezfBmlhH_YU}R%xmu;lo|*@-WOH z28v01+CCxGEk7a+X1E5Wc{vQv07MDE`us?(V*Z^IS;J7i{-=$JM=q61UD*IkvVel) zaVDHV7brCs_EhJe)Njw4brc2rNnG54{fd`}4k`@sbzt)hf%mZ0V%wFM6^U@Uw_o=;YtO_sC(`1M>{3SLc6q*$s48p#6ix4%2Hqwlw#hK&IFIe&tvIq3~3ap{nN$g`rt&< zhV1rDK|<5~g5-i0?C0@==-bwAy?|SER8)m-YIsw%JW@5lB~ZpJ;dR3VW|wre`*!ZV zn-$PnEquDq0gM&)aFj8tsL{KjO(VfGT2c67lyyy1IX^bLdb>L>dlKxvcgtVb_9c5j zBL*-0Frr2G_6fg@Qg((|4ye?m1(LI*E3RMcYRA&n+JN7=Ie^d$$Jm8_EISgJ0w zpyF2?C)=&$3gypRbu5WaUMo1Q^6*j7ctc5(`UxQ%VG4OQz_kmZjD{ywa+jx$AE~IA zII+q!rdMfr+nH}SoLk!Cq4DVHI-lVtFrQv-jtW-#MlNK{$tqp(fiG-hjtTQZEpU>n z+3a2+wzz9H`kVqk@ohiY)q3vvu^*TgQ4uON8LK8y1c?J{PcQ+L&et1xJ_p<1gYDGl z=@xC(%*sib0)@iW?aPEUY4JnS4Oe>anJ3B63L*J0u~;torvxO~76Uxu+y4bdxa8OAX4?NlM zSFH$wxzt^76POwSP&FAWh2T4284@^~(+k52B%L#7*);jDS?TOuK7&BVUSxlrpzzyA zzSqSL^_-n@&nBDX$JNgeM-$;(XP6GxCS+J6WL*0qS8=nL zk=5{dnvx&8Yb~Ssd7F6(=T$-&%N(%&Wmb8F{Bm8;Q%wrK*Tj8oc6L2xn5)tBRX~c| zueS89y?>7M)^RBA{_A=7zhMbkSpK6ZQKPmM`wxWRbE^iSo}Um9j!550J0I385s4z= z&z99|{K!AmOv{gi8!>4b;OlKBKACE5(+P>zIh&1%7aKGO2y6IOBrv+q2RBLf z_Dtq}9}3DsCZavRZ;Cz7ou7?D1aHfRFO+anCCBau63v`wg468qeA4x5r-pdOoqRJ2 z>+APA0PDLXQ>29xbvIYZ*S@0WiQ2$T6DHb1of2n_{7Z+=uh@4q0KmwJhWH8qW z8?#;We7b8nOfW1kYUfhP-pIVrDaePE+P`VDJ}Iie-s9QaE5Cvn@HcG9P}Nos8MZw&~h=zq?dL+7>wtwtrn&2i{)~PM_*6 z&NSG_7`XJV+~4tz(nxK~h`Q$}L}G8y$Xs@EAit+q{QBFS`mamk*`%(=`-#^&(k)-! zqySWRQ;3_Ilw3BpuH!EMCy9lh@|Yz@#F?}gIlQbtfCmxo+RMS-PuEIx0Wl6)-#j2# zqOrJs6JN7?2D^B}_;>`*j8eF8`$4v)GKn=X;HuN5hy=&81=q4olQR%(U{P65wSUtR zrOEmh41SUe(Cs~Yey5j8!I}@P{q;L}y+>HCi3kK1%aVP!y!X1YD2Jok^L0h*wT9Zr z@?=y`H3GtfhoUhOL~5vQra<*bi*-T$<($8kbAGTp{mev$*!+NEA|0f>7B)8U2c=2lirB zawn(qv+#&AEK&Rkk@rQehI*(Y20-}oU*5iAuI&F%vY3DvALZaH7yoBLKR*x z@|f%i07JWw4-+00f8sh2a*r@*0x8a66gs7X(k8-C2;GrYGdX4bn2*CLr`-4x5v&bzg= z72ZG0I7T0s#)6RrbjN?~bDY45!VfmFg$zZHS)5i(Hl>?N+Ts&1 zF^wq^E{=1q?z3Ax&#J`_XNY*u(0hbIkzZlSP~EFi5_1H};DLGAYZbe}{pS1;t#m$t zx;CfWu%lgpiYicF#P5IaXsY@{Pk9QEV6<=30uehi4B_-_LthXy^YE1*dx(n(T=~&d zHpHenRiQs`SH_vA6S}5H`r=;ZsOPIFd*Mz)yrzlI{cQ*xNWy9)>2Ci`Z*1KMRuo%& zbNh9bwO^O_1Kbnp?egDFd)EJvPsjEj?&KK_DZ4FEgx*&*2u=l&_6_!l5uKU$$8$%#j%AOC%(ue(-WKO(rNWXQW4_8%91VC82?WWyUWLNGN( zGDl}M(L);Gw4t0p7`ljV`-g`!;rEaz>T+z4fX<^6tu)t-I=`v&SZKKwOfZ$bCZ&84 zVI;;x=4XoIZ$Kl#+Uv6H!g58ESgrw$%|`iydq_PMFU`%bR?oUbc9;(p1J|@OA^eqg})aj<6<4Q{l?u9niI@?S<0eGl7 z2Z%kh6c6KOev^Na!(^I}c)D$HI5?phQu1^o=J715%t9B5W-(dgj}=+j9!!Fmt!$iL zicdVcy;eUHr{L){3fdBjZ=^Y(=+H5Xahfr|Op<9?lSLsK2WY=ZPN2WilYp+kAo}s1 zd&rwyk01z5oA@@!LRb-k6sYjJ^C^<1CIVDuK8ci=6{~>Lj3ky?&Q@|CD`($|rye+A zJkou1w5*}ON}ClS(G^_Q9VWy`zSnrwfa*XH1CU4=`EVHMmO?qtXtLhzx2CHgYz;6TsvKf#vzY+8(H zKtF6t)#D_QVnr1p-ex;>on130cvtZaTcy_vfjOfL$s2T*PD7iH#@UW;+0ikeBI!r| z55lLS3ieP1%Y8PJ(Rw?47%tS8DSk+fFJZ?4B7IB+B5Z)IRbm8H=!5EQ1y!3>f?CQ7 znGP2h;GV?s#R`(}-2y}_SxXso7)?I+sW;fwgoX5Mx5VB%WJ%Nfy=2eYE`Wf;0(K%~ zXVmNzL!yzc=AmWa8^n@BEt&Yf^`HusM{_(gA~tmDOz*^1qyGtJoU)VFCc}2W4nekD zgTG|j>h4j=BzSC&Q%q}&Yf?SO+{!6)Uxn0 zLs!3_U{iumEFYS^&b6J3A{`pbkC|Ts^ec?r>jN^h)jqxHPt>|igT+|)eE;{NJpsu@ z&J@YJHKz5HM3n7GrRrH|WQom?c#yxG5lEWV7Mf1>aXNKI!MUBcvRih}#mjjiT_Ke9 zfMMcWX)*^f{bvjKK%FSBYEcW`1DoK69~j_v1X8M#7piSNN^rHXr%T|p`vChHrAlrz zo1M1UQt&-$c44hA4ZN^%Zd{#bRvcrydiD>o?u&KT&oc(sR(`T|5B!1@*ymTv>cM)#1Im2&s-H>ez2oQEc|j%Cc(^nv zmHNQQS6J+y$zWs(`RfsPhFo}imVVwy3l@wyUl;RZSU>Dv4gy{QgY%)a!;6cPv#5fr&)%eC z=9V{mk1Dj=sFA|)kxVZ9rA}qJxyS-3BC}5IJ8yBpvV`*6*#`O30Na91R!wcJA_%3D zs?Ie0_jLeP z5Gw`3w>a1sBEgybCE>)_Fs9>1qbEi>b8HL80FK%@WC1LF{fe#iDOeRu1c%IqXDNW)%AQLPh( zy87;0CPc-XTI!U|Fj*`Tg$2vg#|y3|yN_FG9Vj^Zt2Dvm8XcpHYt zGcuS`{OkYA3MMJP)CMdY9!2jDX22pAGZ14ds#1hUnLT8zP7W(0eI6m0_r597yi2p8 z0yc(qk-rN@@WNp#b$=HgSde$5+bY}Vn)2*mGbL#-BGT}K5C_IEujT{DHRr@sGf$X- zc+|T>iqNQ@_>Nv#q)a-u28C^c#bFu9Sv>Bq79w|OJ(EKuN)R0-AY>U^eD_-oNk0_! zskL^>=kwkuj*Z}u(H2xbKp31tKRb_JJ@Lw6Er1-B*aB&VB|sdkX76rb7GQ{Brw}9` zixkbbNfJ3GYeJ>um}=9$N6MwiWbSFjN)va z3PJ%I?~qx01b}w>XdD|$)KE63Z^492T(=BdwxGB(m}d|r^uUIXlCU^q!kGYtNY?z( zCYR^lk;R|Qi!sOrT4zbx4rUoC*0AddqETv*XEof$QJ|&K{ zAWxJ@IeyMoLtV=nF0E&U9;RcH;B8hRh=*|#V_#lYR{zQu7ZYhw#a`fnake%g$f!66 z0E7C42aDu_IsV`fgbB^Eyy|amso^_*Kxj3+LfQHXG0_6``HK`hp*o$ktqrZgG#6#4 z;TA4A2lj10W66AD#eYJvVO-zfvx*o;kHKY;dsa-LweSr!QwuP7E9akD5nLP2i zzY{n!gPyPr2BZ0KV)~?h#Bqvh2AiEaQnA~BAoX4>cL$b~2CULl2dKU2rRj$)1LgG8 zyjk+u5o%1#qZgSSNmt{34U=ory}csIB1f~N`IZk;IHw4E0`C&Geid(Nop-6V#jJb9 zl^l9zJ4MAoZh8g>#>>8m<;=e%FM_7}mW^~-&yGWQvHsz57STc(L$KrB75HGsW1gpW zFhCm(Jb)Ab+$p*yGXD?oI#pNro8;rn`O`G659jx}?w+=G>`t7T+FIpF!MuHN8_|-Q z$?||^!P@gxjprws!q1zQBGl{2X94sR(x0MAs!C*1sy7ijq~|3;r)pcdxUP5GXq@Ij z<(tWo9W56RNy`?0SOK-K3Mzf}qFkP|kLwPjGn<1wqI<;&ymm6Nx_2Up`tqNzyoS}X5|>Z4*A%E=au$-t!E z^d$o$uvQ6lp93YTaMgRcP1IYFC)Pu&=;olMkOD6l zrM}1sNg7GWc2P~a0XXm=*ptSCzuY;A>v*(G}5T!k~`GdK6z{1@12xZ_Pr~s zZVuJe4req@7-=<-RF@`spjy680<50V+EKzT7J}IGsqO_;M8Ir^=jLGvT{kr_-hR&) zAFkYvbM(F)-QUN$df(ig4t28yIK$}DO0MMPT`kV~h!*~ZOp0~Ohm+D3>@E%a^HZg^ zWEbC?lv6MavNj&fSn$3dr*;bj3vmB+TK-Q|I!4a_eDj=9w~5c~69iEZt$B1}A2T(m_WkGq8ld(aH+-a!%BB7vang$bLR=4O66 z90S!Nxl5yUg!@e#Db?uKrt9^cLZ^wCDmIQfnF&ONCOcF_i#mA`y0a{M>1j0}35J;b zw*@MK)k$~Nd`vd$yg9tjg&138N5GIA!D%qCe>`hB(6AwaMrkP05owHqCfVLlt*4vv zJ#lSjdD##T7dcEG4NLgl1W#5m>B6U|4I*dj}{J1dPbU!$K4;L|f@T)%%2MXM7{ z?Z>o?>K;C@yy3Met!>LsRa9_UdKr}~QF~P#MeJ8>m*}-K+UT_e_1*#Dy<~c()%AAi z>gxR7h4R`->kQp%eQ5H@S83MG;suoX{!?|?966;)I<>d;&39eS=CNJ(bY6u9ZDoW-wa`PAII_<%Imy?VC)3{3U&y+3pe4i{Z-+w*;? zO_tH7j4{a!-Ts$J8Uop4vCvWhK})%>%)-g+eJKeWb!%EWoAf=*yoK+l$9hj>seg)J#!^ z>xLV*OjE3-XBH5|CH*ITzjNm^x7}%rX%RH3+>fO=8P+mO$z;)}BTkR~aPCx64%T?v z+|oX*@EA->zjqgmd!oBn-{$tbBaJ(I&Z%=w^Y~(2Wc;xD-%@uz&>KE z8p|hfpH>9`_<4U;VI1xmKx7YTe7%Fw39$VAf(4ts7>OcrL)CgnFP|2+t*|kjuo4A)j51E`ByysyT}tSI1Avj&dgmF_O!8~pPM z9!~Aw<^{T>%1jpiKfoT7MDUeA_Kj9!?qeoZ`aEwJtMd)~h7#GG{2cqH&v8N~&u9pd z|IiE+#%L5)Dqd9=LE>VbHTBGbf!~No*Z2Z~i@M_rQZc{_pn|A^cdUK zPLTNE{1KSmCO~hK2{iL}%n(5lQI5?5W)QHDvoXzn*LnTT-@*T2ArIW`W54oJ13|Ty z;36WV4b_$r>I&c7cQoBKT-7R}m0K4!+-XXQ5)WYH;iSNIGw%8PiTVLiObKNJVXr6! z_+wBZWe$Q{x>dUG#d3s5ktFATusm;Lyv7y2ykk2 z(WAggP4czG9nq)?Xnp?3s3WmlDxLE{rMeBZ?|M;I1L%wixG9;d++?c|&ch#Ju*Qw| zgExM=!nw6;Pj5W>pOJFhsFzY&fkeFO)Juf(Y(YrYcJce`UpCA zrv9a9`ub8tcVDi!+Q=jefFa2}6SzA?HrkLPH&crFtXw#{OJ!N&yP-U0*Ik)q>D=QS z9Sn)z>6Wrr7$(X(9fafX(J7L)bF@A{?IK6B?i*mI!7F6*`Q~4G4VFCYQRXVD6qA@G zJ@>vvT4%HD25(1{Zw66%r(ebh88t{g;a2Yq`Gi9Bfq*`!I=Fb8Z19}emV)16Y^9~p z+zH7YoFXX?0A?LVD6KM{1`30IcI(z@2an2)PMx zSe&o|-Bmtv3e63JD2H7Fu}vNfY1^Dt9YO#-^7zCpVeOnyD(isi;D|-wQo6gyNC;gd z+uW+Wu|UFrA)EGPTN0>5ruoxtLa?j=$h`d*pizcN263}n(+%?i97bkC%Ps98H z@*k6v4RY6kL*?VXr{SL&XKplC#wxk&l#|=iS&+u6gaO-SuswuEg4%dccrtszr<|Z9 ziF)@$-d}R)JS-Ar=s1(|EUyPk!Qm2$zNfWl-^8-M6FEV>{W{qe4ThZeMn15aB5sHlL7=$aHp2GndE0n-wSzHey%-5J^o?Y< zxr6Bou_?Y#G#uQzzz$~#oxX=rJqNb$H2bxLwXdn)8OQs)zAqSJXik*>wg|BOZ*Vtu zhX26R&Zti~ZnGiuoKdUK4&bCfB15z9p-8zND<(Ix$iiXaGmwZ5F@@ncEjUiJl{Lf@ ziN(`!Qf`o{Bn-1)!PjBKa&ze6{y#f)`2V$2W1qEkJbvIh)W;$54a|Ch0!vFVfpp&6HA|{BeqVG_BHtugnlL zWWQl6%uX1$Nm*OFt;d-TYdD$L<%=9cLNO{Gl|>p6(_fv4x7QxNYU+4&Q>j!)1K^ zQf8s8+nSp!gSQ0|4&;C4-KSks{d^9=(tfdXUaEN8JZTxT~nL(BCzukqI=^iip ztI?8>jj(rvrQnsJ{+6CXv^0Jj59^9eSLSY1s?HLcP}Qwr1$npJd!`IL4elU9XP5FHbujpVUO>6^TD z(>kt1hyD>{5q6NW^iJ;DU=SHgsoJME*uaf3( z;wy_jF{mR{h!!t9rLAhRA@H&iQNioy1L^y2nsNVg*8DnV=#PBMk*#0;$xCg23u`^q znpV$XpfDLo!>0tf1h(8BGN@oV)#;X(mbQY<_^fHgPHdJNih0u?ywIeTZL$I<9u?W9 z_3gsrZon&Su{IK3g8uj++NJbe;D7PbEkYkX!uQXfy)b7WEmVEEuBDgd@J$IlX^NhO zo*#ZaI|p*$IXH6le;9j*C{cp-iL-6nwr$&e+qP}nwr%%q+wR-8ZQGvyFXo(ibKc^u zYf-hyip=~X;^(%<5e5XqZF)%{6!VioyO3`jf?_$S4+d$q72$v(gj$+J!iQ`+xD|HK zZ0u;hvE__ZYjcE9$xU2}<$7du)aY(Rct6;qe8OhNSm(kvZAo!@I{;k#%m|IKSoe}9dtW*#y5<&Ivp7SVibAr?q1Qri} zxTNd>Cl(6g{G4UsCJ(E)K>i1LiZBw=L#*%%@TQ%wMtj_+;l0pxqGy)UQ^T3Rn@<$c zWCqOZa#El%5mFEu^Mld)Iya0pZ0~D=SIpY}=b@OQt?bW+O_|3k^I*A|+fqsekBPc` z1wm4%(T|}ie2Oy~k5Re$Ja+a2m|QE>*pcxKG=ep&B0H1I#}Y{!k7doHsHD z#BA)OQ8U-P6%OU8gDzhLo|G5BIC|`s2ap)V*f9|*Y6JP^x*dsMuU)W&yBaeBP8Z!$ zdz9EC`P|Fl$0Khx0xfkm1H$WMKtm`#=^ADikXKOmyoy0_2MzSBzam#6gKL^5spcY8 zw&y-U7p@}o&AO(VL^0_y)Wf)r-GUM`Clar8QW~o94>8{^~Q)t~!-oz=Tp?8IZb7n*FgP4t^FZ z@Id!%^R!hpscxJja&|o91a@Q$mbP$lm<>CJXYJl)V5VZP#)d9qF=CqsqI>oUM@~f7yrc_Da@i_T@f0fzM7?XWDQ=fSq=ELgx`kBz+Vyk2flQ0 zB{@7F`MNXJDxt^l9tSOd+7(bYgh#OrIo)7Mn2P>xWb96eUayjc<8=j|PvvJN%p+d^{>T@F&xwdf%WVq6b$0RqOtz>N7@GM#lfIA8}ay z%=UL;`@K^}fJ8tTLo?Xzjv@MIML`kW0!~Blk2+WfnHm~mgtCNGO90W#HZQ4Sp)t5Q z(m#e;&fbiiHI0)f;2eR^d}P8qbdIylH=jcuzYrXZSIKw*GZqK^OMy#r5?8Uc5HBv1 zs8BV$K8((>dTY#qr)__1Ra6fLoe6kl1ip5vM(!^L$|?`u=VUYpAE5}~ z;IVkBjGyQ&Ogoy5RbIo!j8u|nDte|V(q?Qy&4+_B+#P=d4d`u`<2Ac+jVIPqicPjAlbr`O18@%^AF1+P zG}FO9Sr<>k60f8O5Z=Mf@A76v{C#0@W{Sc3^Ddnuvl4>Q@jw44yB@ zd+|N$Me}m7QBtbY_nx>YjpZtt5NwUgCZ)`c_ESf5E983eJ=dY`u#0pf+(OX(pDR4^v;0tRy^7xilmWlF`sf z!^8(iKsh9vprWM5hy161NT<$fn_P9#Ig)tr>C46% z+H2V=4xelcp1BNoO=GX%A8NPbfFd1J_Ry@2l!vG-xE#u52r?4lo&WX;fG#({V9Wf+$$Ea8@;da9u;rv_TZIUp}m{c2`tOLk26w|aAk&x^XKFOG%@Iy;jx5l`B< zRuem1LHRhzXN5}p20(o}0@C`Ke?*+OkO(JCf)=~UaQ`@RtMxDEYwkH;dSea|F`~S4 zPkNbQfxqhFC>tFQZnJc`HdOoanJV}12G#nGYKB}^ig<+zEuP6*>WYbt?xEc@QR{}7}mA*V1$hzn%L!x z+!BG|^3+uzbq|ydtfTEEf>Exle;$9gI*&nXhf?3=_!J=(N^fe69k-v(WQg*tBk7b5 z5K*!oE3c=>_D8M$%DS|Isfvempvp@x01&OjmL^qZU(9q>j#nuE?~Hg>;0x7&nv*=^^INh)a%Uu{YxE4jzSb!Te`5P$gD5WR&oxG$f1a^ z*04mGhA!YiiLvWl92zCrRu)GYxt?ON)8aGZGCtoUt6j1xwohI0Y*(MWe&k(9i=;O- zbR$O3-n=lMj%Jj@6vQ6oHs4SG?2Ny6*%OxZl`+Obu2E8#dP<(hiW%@|+wS9*zB?B~yG%qrAI6H74IZEOcAbx7aZyvi zG9KPjnY9|*m0_}+$9p>}qS36eYJ=&;rHGbOC%ix~K8(H>37VDK9IV)MnBF&VjR<+& zf0c{>t$2u;mE->_7gw5EaR)7^zrEKCfAZr4P>HuInkeGgwhV&|1IQL04NUP_n0Qr* zrI97Kq2uv)gcS=(=}E2XI+MUC8p1i7MDTo1o^yole7ARHfqwR4NN(xZ4o9c-Y}xd> zNwBl?StRd{O?&$-gD9mk);BM0iAz_Xr>5Mng&-3X2R2NfvsU=K)<=@(DXLs;Z(mk^ z9D{n7M~!qc7^A)wn&NDqH$1VCQIE=sYFb3Za&(@m(pIfg`?gIl+*e6WDHYS#x_xJ{ zQsZgfORX&!gDoM%P0gceE-$JJVQ3tMsny{j>_i<*G)Q_*nJv5 z(_{ajS^2B*HuJ23vi=252O*m z%X9{;Nu&b9wUd@+)~88pXEE+P3|PB2Ycm> z@_KR<{GTbqSrfbfo%v7KEc2)*wYoYvi~*Co_;$v@8gPWf3}v{((6HH(JOhHCBTlNs zSU1yuT6H1ql%l$kLCGA~-Jq(%fkdxi5*xCyvr2PQLEbwfqF_E^@JBP@yGv&J~Vuchou6iklV+m&H7O z0tcr{7W;6K!Vs2)EgaWj@N#n4EJOWb{4vHM!3=(l1)L%{=76KYt&+uKKJ}Kd$y@&y zB=+^@sV}te4`Gv;8%>_Uk`(Zf12;#S+3j}rct z1iS3k(uuje|gh8ovxcrHU8W-of)K^ZiLex1$7GGX{z&-hC$s@f)+_#m0d z=UT{0$2U$Pao5WH!_0J?c4W=GU@$U7Rihtut&fp`o8IH^^MG@~GZDi55jqF3E-(Wo zur(;Gn&HrV5~@(*49y|wJbqF)s68PUS)Xlg>{VkEJRdl2cE!}trQwW%SX`S&d30%% z2}>uQADPHT{cN&)-;a7Jw+|=FD?pYor*C(cgeRH7g(UcUIx=BwymCR0N|5<_t{aI65ME6^>4LJ2UY@bUrwHQ@aW`yInJVoAs3|*v!Ey+{d7oRgmKJl5p zgC7*_U;;@HpWX_;Eh_E`P*SrxlV!!{8YoFM!GVD(VA13m)*@sjPsqjFBH6#@^a%Np zXj(&6RFhedx_o<@CH#ruwF8S@`hKJwR4_~gQK%|<3k2&N!8*Me0tohu3^|xWx21M0 zC5YQ*!G(je(!X4wnDXB+&tk#;|HqbYI|nS#wr)0cF*X!nENIm zl9F0N>?-wllpWGs5#Ib*`d72tpIGtpYTu6M_9*UjBJ~=m(ho<*T6=!t*k%v=`{YQZ zyye6Th7AoAHx|c*)%DP>2UeVVjRgsl^7s8;O1dYnOX;?PFLDuAmKnmh zmTgYNVx~WigRkfm#I>#`3VBZ%W&-?EU^j|c4Yi~~L>`qE!jZA__Y zR&1GCcp+9zM}3t|gw=w9BuG$^w{x4tYJCR5!n?~H%(0DUuPvg~DN& zVuRUNq1pb?$;4C4fZbe~4B&K1`q#md&7N1E)e=`PE;jo`+Z)*ZvIgY_|9~IvGd%Wx z5x2iqYp?vHf?4}ViN?S}7fRqRuiON2l&%hMYBg?)I`s!%AN*U+6snxj9=iNPR2X6Q zZflH6pgwtG{!Zg87vkd34Z~*Vn$7hRBVZ_eFzP`4&C+h2kE+u0OvQG(AXYuH-3 zRhF1D-eQJG_^-EP!a1^D4NC_%t6*oTzB#0qkf-}xE17>`vE!!Q1KFPN0nxKm?ESo> zbzl(mOvZ5^qv)0WX3<;`J*i;E0|_3^m3BeXa8Q9pklwodN_uM=``!nT1o9#=hc^18 z_ArAtrVzoy)XO)hSfG4{q)dniRYt1*58tUi3L`1CZY4Jz?a0q}zWGVbrB7>FWtIDg zeqT8fPfue!lxvHHme8JG`G&m-Kz%MK7V=dzxuRcvO2!3(6C!L~%di~#^ZMAeNkb*( zo47L|*m|4f*S5&=00R_y7e?sh5FJu$ghPH+*FUaKx`R1x^`V$cxc*dGAWuzrK2gQu z1N;&UH+wB*mlLpV3QMu%$xP+jL|CPTe666Q!4zlemA=cER-2NlKm z?9mf+7oavGC5~LoS^$$Z@;Z%QOD`b6CuqTivxNA09N{Bu&2Fa?>GEqU+-F516mX9JTgM00(b!+A1c9v-06)h=`>NQFNXyq z4B|f$mMpgITXa#W@=SgBf%gJN+8iQ?Go(SBuPtpfGSWrJ^lQxv>3~+m@yJxI&lxps zlhEM9pad^+*Yg|#hU)+ltGvCvdEl?3E&WD;*fX_@FWia2MW{we)yh&D?kVA-DZ_>|?N@o1SI^c4+bEM!ByLJYo& zyp}fK6t&2%gPB&dsJ<&uDEfG_VU<{2p`jbdEm5}@eYh^d5=+UB$?2eIiL$l?Hb&$; zuc@TWA#L7HQOWE(1Bo?lJgW{Au!ah#-@xF#{1Xt_+WYT2qHA@uV=x&)<6qUrgR*#R zkjzYNm1lK9W_dUNo9Z?xk6C%E)wH$D)mb5Zsf>@&NTf|FQ?n3g+RBAWPl6ku8vDwn zUMj)bdV!Db=}6TX$tzDgriJivPVA7ExUG_8Ry{?)TQ`NOoK$CZSpd8n%~HsPO2<-? zh5uz~11I(MkvccUW&sx~OpK@vs;8nPBqcX&%t=9?%1jjty*f%!u4XZTRx>Gmp`SV~ zjC2#&rIvrpwhOVB$$CmtiG{F)<*e<6rzxneFsGHX1F-N3RC1`w|@_Z}ORnS6^WQhB8B{IHy=$*9Hqds)m^soN{h>4yILew#Eb zb=kvNLf;JnaS}?6YPi(tugpugb41oq>z*%9LO^+R^gX%Mx}Wc_g_nc<4<++ANs>^O zzaie2U6YFU$|U28M{E9C3q=Qr#JcTW)8y3=HNP~&kD4WVDj3bA+#y3hc1$p3NeU_)P<{Bn4B;=8&*%TT+W)5rJ}2vc zm^YVxS9_KO!uPgbz&iZ!{8gyW9&H6tdqmO%rQ>3{Hh=aF@Q8FYRP}^(lEm9xYaKLT z2pTL5}%a>^ANlR8=9XmG}2Xf8E&=#Eaoh$cCkl6C=M**siOG9 z^3UmFJ=u?^pT+OwV?)GTt!m+I-w+6bup_Ug#GbD=VE|GdDOZ(giN462T21~9L|+_! zJh%ke`a;y^X*b%r0MHRPyrKl~TnKy)%c`PQLmeuJtklyv>pnVwn_s%Q#qX!A!B@1%pIo@rn+$4sok%FI>>QvYJ+dmalYA%%1Z*X zy1zejhZ6m!>Pl*Fck+BV3|FFhoDfFGSQ0p?UPd2=mgpXUF(Fnjd#1L=Z1>>N)0dH7 z&p*yjS9`i|Y-wr}`KB4t-#Q#;5#G)0I&&2`x2A|_|JN7($BH!kE1H#SKGFN)lp1J0jsh=^8~}51N%F?%2Yb6LTr7wUwIFvY zY@zB+MvRKDJ(M^XjU*I=my0X0fAadv7`rNIzrY&}ySeVRvgwPryDMW1w3jj>OVp0n z$Yak;R2MjNcElCFX0$=zmW0MAo}YvoFNoe(yQM3^>LVP@TKyIh1zxL!n6={`E|C&l zaQ8%>1s2BokguEPAAt(S6p@ijH$z-O}n(F!0@WBDc+;XHr=+>)it$`2% zA4z#X$GH_aVYYVIyDHM2SQy;DLOi-W3~n^VMPKRpb;P&A5QJoY5I!%s7F@DB>Mk%~ zq#7JkrI#i!(M>LY*kqn4P>z9M91o)Eol2$x0)fo6ErMGlC$T}=)0m+QwnXTBQ9wJ6 zOG=x59`_M2^ojNoj{a&u>;PC7nl$uNEM>&s6?LBas{LvqECMCVrN8fXs4sqyrxM~r zA#YnrQ36GL6oPV|zRO3AXE*vcU4`^RIHBPxIgDIwNhRN6jWEv0cN8Tty)>=KT97;{zlXcIAt7@rw9U?0ET=-hl2M z%mw^lWs%W`=w@<(uj?J2N2kC2zy1RLx3&Ndj{jet>bEUG?EliU2oQgi%-h#K9COIa z9A;50q88<%2Bv{!6&MjClO?HIKAv*A|vpKy?U0qSMK}q^<<3J(@ z@Zsi7Za-Pv-xI+=h+|kG<+efka7+wa4B12D`kTsG-(nNc%qtwKkF^Ld2glGtI3Mo+QAgaEtp3w z8X_n}i~-cbLq44F3&qoD7etn}Y3M45J~ELmY*8RbdxG=u{9;51=s;ox63B0y9J@gy zjM}7z>8tWHxx7w|csnE$Dh7n%b((EfUT1n;yqvM$Jf2_AtGvq^3uG=<;;0e|N2A5t zZJg<<9S%uvn;WYlD;{2${jJ72O|}FZ&JVBMn5$dweA_}oeXe|_w@j2LqN?KP9-KE~ z++n^`dmUZn%O>o#xB}EeBoDwG3wb!%VWJIP>Ev*f)e(79_r>Bdu(M76tQYIYHxrf5 zmje7d$Z>=h3ou*E6y0!_$@tDF+`igjNU*Wzpz$E%rV^n6D8_5IaTZzaF4TxDg38V-x zXbhnY&TexLozxXd`*>#<4K&u-!oqqUC|(UFIv-(h1o0~eTja(~_W}u8_-wXIRXB@~ z_yW!PqA)~Qi^gd}-ZZBKFbpzld}=peq@-S8I;yKwa>#9t9l{eTXuxh4!xlZsBsd^Y zwemCk{ntZwy6%uM8Su@7f+clH&_$n%z>fg~PExjckh3SNSS%XqV~!U?QZCoA#HYp}rW?)$5j4$z>YIX1Zm{Gf zySZt2aC^uMgFX;C{(wU#3MQ6(b|8#3r+INQh+w$M6k6R&4uuQdOcT1rhXu6HHs8Ez zBW~1(4$s(5Qe!<-Hk_##${YFPPTO>%yuXzl=p4Qtx5%NYhmi&|n8{&EilMoJ%V$3g z>8?0XoTJpzN6^xRB7;Q?i~K>78!c?5i~A zjrXJ6ymDLi$d;2zgQKCcyT@I($5f4)px@2ZRqe4dr*|2Vfz#eg4UZR# zs$jUHuPldGV+M=tF;6;FR}wuWq{%0(3P&m~Cga$sjODsbaK+SZnX5Hi1!%9AAd44^ z6Y0Fqw{z;c%?MriCN3I@xc0)R;-ozdyfs%o5=zwToik7IR4#bKqO}Zu;j*@^8r_(NAZ9C&qnJ8O%H z()8i=zcSt@$Kaf6MWH!+^Fy7+a)?**WbnOS(XX9sK>jjseCH%$G~X@Un;ZvMK(EKi z?^;WySr4b>kHZ{DrCdD!Txa%BOyTrfc2iwZ-_C%3n@03pp!i3VWn>MwC@BrG2sbGAYvZh|DA(j%+4 zk|!^&T@%tCXtT50Z3x%cC%J+Zw@T(ce;Lyp}Yd{=pUBg-sTjB-ydm?@tq~m9-_V+D<}E{<+E;?I)*e z=&>v`s-9FWQ48ba;ln-YZ?N2Efhdi_;aMnPlelZ?F_iW>8H1mfGJ?UMzaW8h2a z{=BRXl&~Y!rgkQ6s$%`yl|$?9+NW>*(2nay9tgxhh@q-LXbR50y1JyfBdu>!cCS@d z!#cdetcV#zVdx*z?EJW=!Gfx~NGFJ|wD&TbEu(s`%MBgWp?^+{EX*PkIQ!Mn6 zg%xOt(`xDzPhFI*DvE%z5eNobb(CPe@`%k8&mT5AXfIkXbjQLMqhYd|@MIDHRN`B2 zs==j;GG(-#U+eSx5n4GhQ_0K)Rn zL9Wa5qrZB?bcKx^1Xg&seA@OlZ9x^3NJ+vY9UW7FCl)r{#6eda4-2F2 zIhw8rFRhA7n+Ekz<6Y&dSk9b4e73|p>RQ7q)hkryZ~^qqPGUS**T+0woSFc3w=OLC z-qIBJ)xwj88c}RbfGimX)UAO*v!4?6}r&`nQZ^P4$2{ppHb2HONG#`_W<5-GnJJe;XZ!) z&w!4IgFIIT5GC2zux6`Rgvx$7J(}_&jffbBK#xh#_!{u5=X|1OTPrUna(p6kyC+*T zFi_Ia$AP5}U{%ivtkoZ)#U*}U6RQ# zp6q1p!^77P0=2;+Og+c#2?3D5DG%MD&4UAg#N}+K?7U6Wm*Q%6L@l&Xo-?LC`fvb5 z&pXH`)oB3{Xy)!;1RJ-~{8iy53>bNO^ux+j0$>{%Q%SOYWg3STayHs zlq*k+8S+1T53?cOWsb=`&&6u+d+ZS^w;0I8qRDi<+EA(K|KwLnGbULHi;XJmr}iyL-9HHLJ*8UHn_1slKq*7@8_TTmWlWQVoKKy zPtkf8bSQr~$3UuV4mPe?{xBZ+aU7C4^ZZ_d!2;cZn~}b$uFFwdx|-`Uiv(V}@Y$$v z8r$QlFRMMb$|eFlkp|N`7(>;M(G7`V7mgTZHAXR3-L42XH~+;wFbi32aW8l>L&*mx z$NzHTeYCI@dqLQm&2F$O47?hCF#qhZa?_1K-={$NV^g2tf~_?3fw9F+knIY=RU(sTLN#$^VX@j2 z7ACto{SG20yc#N8{}fbECeZSV2zK>?EAyxiPmagU>_gm-F|KP{!xM$o1aZQvxma}_ zXli6G^lSu*e4o9yaM~2tM>fWEbL`o=quN<{2S%fo(i?0MKQxw`wSSoJf2{x@i7S#H zDuQP~?4AX6ZTjs&Sb+Em@!t7pgSf81+)_k;8_4qMOdZ^(d+L;*)YgDffR#rj_7f;$ zDKS!n$s33q3oZ{@SihX0J5WKPhPT_|fZOim1EV*O#~41K4yaonfaI|~07dc>W_O)i zD4o`w{SV)MCPIq{jTGc?0a#()%s!)_R#XLvl`V?h09eqO;}67Nc}}Do>@Ql7^l~AM z0ZE?Zox7U*S)O)fC!Z?b6rEEFjnbJKWcrFo-C)yw$sHimiasMgX}-;=@9#7ITkNWd z|EjtFQ*xS_o#j6OOU+suNe3du=L#azOb=Wrq_T<8bX>{ zvwf|$SWQ7+%}~|aiN8FM7>2*|Z8FS3-E@3w)%7uI*Yk01FvzKwHZ`sH`IhDP9yKF3 zdQj1CRsXH!!}-yfmxsqTS>3u~w8X>EeZ5(ZU1=g{uo_brQZNAf{oL*d&;O-ZdSO_d zFH{31RPObcGVaT(=!qF4Vr+@5M_o@JQlz#v4QfSdvZL#D#%ay@-qy>e<#zck%7~?iqWH+|Pdt*tANU>QiNm%B(;gb~6y~m0WWh7ia$aNO zbf=m!$5f$T!1PJLPDKt%`emEFUdZ_oSN6_Z({4#7PA*3{h6Gv~LK0-(J*K6@K)Wl1 z7D*LHuJrH+DqcTzst5{f;IS4@TKfZh6H<%6lfDj{;S8_-^B@8fBa(y%jKZJ=4x|MfYU&w!FKllE$tZ) zk9po}V``s+Jm4k|zHZ#x+e=tCNK~m4CQFfd@dYfh0~!1P9#gmSn}C!^8i+Jdnqj|1 z2!I8ac53P)jhzB;My@`oJtRQ@rBm3t9VCEglb2Pnb9gmRUBQniwx~6_%MtSqPHbmq zdOG5xY%*Rb>?Ub&0Cl4&(y<$}R!_lt1$4VU)t~pKK20w~T_4_bvD_cCL{My^&GmHi z*;m}01p$>DS;83N%qn4`3dnSd@9+cb+NS&0lRbg#3T>Du`eTyH7W)SkCRx$v{5059 zA+QO%)`dkm(uZKvN zsKaTwBr^fnZwT@=36~c;pwP#?QTdGJ^p}$;K*li3m+s|R0Vsz$1@~6*P0H7?O?q8h z)PcodITNKI1XXk0;{yfeIdwsj1Zvy58l&vYvRKda4?8(LCPCG(PgKr2Bms1HjO|0= zx+Vl>dt5SSo{g@c1jMZHYrZ|Q?Vw*D> z^NpT4CNXn^>7Ojn;R(9dT2`cIK8*;q%j=n85_Ar^mX+FS9)lJ$$h{+U7VT4k!3HAV zpXLsQbaYB2oQ?_ZP^>Ma}2Q3&mEK+?qHwtfU;}are67; zy{+H_1(mORu%`&LREB>GFevKKi!`pmjb7V(-`;~(aOabIc@gfHwvqw?N zI*&33FPDB5Dr`^C|GdyOh*XKKBB8;Dd)D9QZBbm-AM#}RCcVW=jIV$>K+F(`qg4;E z?jHA3WKntvO>U3X&Hr2Fwu0a+4J7W?)XTd;Jt7{n)0JK@kD)6w4^8PZPS$9VPqIDROq51o8G>ESPr#t>Eo+vGpb) z%;6sPotD@A_I|;>WBvWSA}(%)C1Qfa<|X%W0}e4-*Qy7*x;S9?<9Mq3?95TkS&MF*c+o_V~q2j^?Z%Psk~ zx=UM5?$1WYWfyozXFA+^2zrM<6p9C-z&-@(`upAb8$~+Ur7)-4%#m@M35~mbGmm^4 zK{LYU0eGw*lw7Zi#Wh3s4l)m|8!x)P52JtJ1t-|ut2l)3v{SQ7ukTQPgs2?_FtNUC zlT*CIif({#Z{D;uWccvMf@?g<{TddKm|cU^aMRQU?H@hM1rGILL-6U-C|viWWMR;w z^kT?e%OZv62kwnaxhoSSEN8)LoRA1|WdO2je&}pBwN@30MFYk{1l5v050D%lJ@^96 zfK%vFM%1#4fpN@1VnH#4xT<&p5c&n#8tksD823+G-iSYtr^>@hjALRdfrjZ%bu5&g z;n+<5hVdWDE+1oeGJ@@RCg`@IfE3Y-fQufEC?N2IBUM7!>6$52(I^>-eVkQ}01ZKp zc%KDN%x(IBIXae9{dD~r_y&tMTOJcQ_}z`?K6QhVpdk#>Ss`OoYQ^_<-+br@>!+1u zkC25MH1Wg?Yv_a=0mN&-guqhB47ZC$d&Nsyx#`!Rt^$=X?r#{L{JHyvHVn0GRHj`5 z4$Pj?){{oY$}uQn@JEFQm|G7h#R7FmCtfdq+#R!PeGs{WAa@BG%p^iN%nkv4Xj7hQ zqKzqX5G8X=ZYmx@{qkiwq!T%%hZFCW!dLrdN>f@9DyE7b{FCoav9qXEsZX7ofdok* zGs;epOUBXFk=`F`!GXE?wI5WlnTqX|39wv=M1r&EfU~y0xp7(2>kJz-|qPM3m{Zk0^ z94BD7ZryuOhQRy*k|zlQz!Xs)GTkiOf_FHySGPFRP_Usuuq`B)qt(w}Za?n_FlOGn8L;yigJJt+iOv+B31aQck~ouBZ=40owaJHyk=FXM`aQc!UtmY?{{=vTi8%^Tj^5j_Z<{cPpKlC-!&{e>LU3;s@w4myVd#B+T! z%)0G0(CGevsA;Ie9Y)g2a+Fl#bdsS+=k!uGAy7thHuh(KYZKuFVq`8NqMr=(<0vcg z$7)Tzbl7VYKdo?&gbGPYmlFrF^sTap_kr}67glPpEr^`ne`Awuoz2pdT=u+rhv)O* zJDvdS0;-qd;%+u)h{`9&8Y8=ecj>}Ufkj2ZkKUJACAlY08g?~};^Ky)YeuB4kw>G9 ztdXk)+E*B~VVLCIZgtQrvg|d^@U@5So#?LfNNmU=0$rCen4k&B0RHTVB7{#BHu-R; zP3_~?aX&-`n`b&e#llA|nN-`PWuVOWQD;{K%5*lIdB1tWRlrb!;G>@z=~AN1>}@it z!-~8+#;7E2IuaBo?XwrJ3OP7&Z38T_F~0Cv!K&A?KIkw78oY_cbQt%Dq_Vbza2Ap_ z3BZNm(}$yNJBv_zP-bTIX57+9dI#X$tn7*Bn(d_s!@Oo6XpEzgwCG-+gaD@z6=-s_ z7irqkl{wfpAH|aq(6M;#iTMx05P&;e^)=mU1^Z=9y#|hRRqFr=5+P#88j9uFVb9CCl#lbFu(Z190GlJTPNHpUTRv zxAjG&OL}1rl9$7c%&R=~*y2iB#i}q%iowRiCb@nbQa8c4-Zea4Il{WNlY>}uB`ya) z=z6=SQ@0e&KUj!%F6AW4d#EiuP)3AgF{VAG3fv%4O|4mRL(hvvn@c;#O2KM6he<@B zWQkvaI2F!8`KCMf2R7xX)O(ZS?IRPXX`&LFDl1HQS!k9^>^i9)t<@USj|-vUXyBgD zs>)+yrDxzs%q*WUk)^?wvCy$A2MBPr7{GT2v=EVJ&ID2WK*9%!{aFMJj- zL8PlB@(sae9~%eVS@2Xu$=`CM)JzEDy8)~n7#fqeVqU^%O48lf#&__Ia`f7T1&*;x zqV6x+lIaBX15L%xb^t4(!Ku;Pj5bDYUw9};eUhPX6~%u%0Oq|BIKnwFkYhlKWjF1-DUqxG#utP*&;b%TSf64a5#qpAIQ4CGT)b++{b&4F zQ_;TuID{Tqg#Ok9V%T*&Ed&o$pVv^NOWS8_Tt)@V#&34u;O!4#YFqTTshS6Lu>ZIy zDA?{(5cOaA0dgE?1LaIH*N5ENzpZTxC5~&mG6*r0(ItKW0I|}gKAs%%_z->QOYF#f zHfrsS_j0$@0bdJRu`Kv}z>Tf%Kd5}-Mfk%rRQUW8Bsn-gBtUIpyG5bAJ3R(^AhX4G zJO1MAzk7k5x@GWLV-$g;d|jUopd0syP5{j(K$b@4oa+vP!_+zPQH0!5ab|R5D=Boh zknhmrJGIainu7=J;BNlrQJF~zite+agnv<|6oWsdc5&gT&i&p8INowAJbiiQ&-Lea z2;swO+b>H1?F6XVx%0muSl+w>WX^&Q=@B)aGvP-ILP7DXZ-P7>mo*`VD?x*knMEd`AXyey_bVygPBJxPwWE1xLgp*WA#aWkYX_^?E&37fa&mO$lrNgwpmRL=LZ)vmfsmiJ_)rZruDtu`<@dh^ApLviv&pIp9uyvMi#+?z=~t zkJK3CDAII2gm!Gy1JTCZ+|O&7FdvSDNaKhHCMqX}<4TAStk`ORf1FL2(O|oWa4`}{ ztM1ri>to4KkT7d_nBCRni-2IIanZY^VxUjHL{#z1>wQ^2bda%!n!~=Vp8jD#OBBU! zOhy!$Z_?@r=xKgCdb}mE>*^uvrOJ^mq}j3Q_;czQU0?>LwFCVUYjNmS8U6TJ~M zJvd5E@l$d!Q0@G@$@Rbh1dYLfws#*LiY-t0+W%|&-WG-Thlom8^gevuyw%KJFExX= zKF;kUm@H#(cciza$0#20yR~v7c~~isNKTXmC1hRi*Itzg9=5bGz8iECB`u0@bZP5A zX-`8Z9E+^=%1HB)A}pCK#g(Bzp-^$JVM`+u`D@@R<>I@39xFhDxef}P@Gj63g9Qw- zFdOZ-qzRBhNC0bwo7lbJiNu?y5&0O)rpj{RIvaWyfl zgp@@bBy{Kd5eyxOH6$WYl<{M95^L+JPgf~;IHs%A$oy=>n+4FT-aEs%)=)cVFjpR2 z#QO-iegt0JLg5%I6~5---gq49#PK6w>J9pb%a_ncd##V%oo90x?*LUY>+!)#Zg<{Q zwSAN_>XcQKP@|_o%;*pgdAtglwEhELY{NFI!e_SXnQO zhl=I7fZ<{KO4#)7pKiOri;9mJdwyYRs^Zg@|i$BR^B4Q zUC_ZH_6gaBJ0antm;bFYV6m-OgqXU_2#thY?qppMdB|tsOWDDMw8m)h+2*?b2iTe15IP ztbjWFFs?HC3#YJ}4C{IC=ahsIB-bP&^RQtY>A_?Y0l`q}G@4a8kVr(Dn53pOm3STM zfhJwNi@FS6yyZ=iWD84qsOm^{svqv!!>}ly8>zZExZtD;+Z~;CBAWe^!Mx!3DPOP3=^(D@DcRoS|;8>}P zY~BC_2LYVr6rd#j55}dtE5l?bzAJGE7QC2LUc;+Eix;lK0d*w(1-MHs1F`7H*IpooAtXZ4oI#TMa@1*m2rj#+J^gOXZ29#|ma;xyT>OhmTyD zF3dQ2xNZKPGa3JDWxs#e3-C#9M5UnTZhEGo$l{Z+q)WQJOp}PxqdEsiqnDm4Fp2h? z2eb~V#51|isFq|D^10~))v2?~?@-J=_`(z=B5Oh`f zb#sqy6C^?hEfj5iiXP-ji+#z2`$k$#jv$Tv} z!|4ahEZjh1$gi1v`HVHAcf4}%o)(dX@1EkH0~+bYKUC%|>cK_H!?S2;@qCapdqZDyD{|Y_R;ppg$%+Dx3-srRY(UpX-uDk`e!%em zvgH4p0(1V4eIsoDk-^^5*!dmsBKYp;5k49u1VkRmD@^8gG~;r?;C7gLNxl?5`K+d zA*hgaHNc4=!Gyy}yM{iPj-u%J^u7=jMG{hAJ8VVtJ3j86;TT2+n$=qqFE_pp^gAgV zHX7+}c;D$u-0bg_+9E8FY9D{;(3C@Cn&0T9>Lsxk>R7L=p@u zvjQpa)(C-yrCgH+j(y9z>o~-YuP|u1|K_+HyRHRs=O<8!fQFz0#wtH!>xUEdgp0@w zZh#IJ^z>>mV5Kgtw@KXJ-cJe5+3QtjR@3mkBkUqBwd(i#ZcL#NS3^1UgKKF*AU$tj zDU3lR?plgq;v@4hNwm4>EXsGzh15hZvCMoo9k0yI^GJQj+lI{#OvEA8kzmg~G<4L@ z8O0Aog4XyRSEqUf*)s=H>sR*kYZh#LhPF^O)kW{adRxKiC? zM(ty8L;)HGhRb{dx)p(GZ`T=(PN+>E0hE=lp*dd#5hJ zqNHm#ZQHhO+qP}nwpnT0ww;x>ZQDHc-kkCE7=6({VBf91B4(_Z&s-D}vahg1uFg9M z6w<-r@|xaSMIR^wa7^~PA;us_VKOX+EfHFl2KENgOQ+fxs4h zu`YJ%`EDa6I59k=OcYcscgR`B%bh3sBr3u6+1U(kktt6)vL<$6Ol%urmAxT3h+uA% zvcYe0U28=D*m?En&ExyW-scobyt$9)I=ZEIFa+J}x@k0=y>7}JW`$^5(yfCkx>Hh@ zx9QUYPH1pY*Q==KJ%CuK>+`b@-o>I?^u?z#X+YetLA;+UqgPuvn^HKR0puK)SYhH9 zG%zs-$q{LD-wtpnV%OVz@vdaf%$0lmN!b%aI|xCRNO2t=QTPD-n{Ygp7aqO_ui7jsYCEzhzoaSjZz4e?chSCVGE)iQRfnrba4j5f{E>#M)I8MK+NfILeoY*%d=DTBl=|Y^Ls^w5jN08899x(> zO~6gyi7;RsMO~_A!YI&)I_Im(1Fq-kP$yK@4n%F$ulh}?LtcbpjX}!AN2w^g^ud$8e5uzYSTTJ2gjP%w#Jgil5xC) z0#s`uhXjN@wo~#z6A0&zFoKZRw@IZ#z!e>mvUg(E*ZKX4njVA*2m(RLdVL#S2^lHL#!Oruh&7d)&JALoq&V^E$!WVO&Tgh~X~d zQ}jT=3H3l|TO&ls2NE=7!I!5?Tn>87D;;J#b&s(}&V`6olog0NMyY+cAM723zKQK_!AlM(A<%!Fj9`6X} zfO{m{RtOjX;NS^WWgJ1f~u7{ISL;rlhJdy71ftX^l2b9E=@D7vAG4PVpPGPBtOd>kacV6j34cqOl z{w%D^wQ`@WF6`;y8|e|2p4>uj4^=K($B(;$;SZ z6uEq#`;-S#agc?HuNlbJ9co>3HC4e1K^@i_ccF^_2ZR`3|x;b9ru9<5SW-}a_<&|UiZ_Z)~#ZpUQXI*^^|9fepUi_r3OU#~=iyEnNm z1ez!V1FVQ=$Z%nt@vcc^fJ)w>x}QS@7Z5f^$4tZqLK+jt#?@Ebc|Ig$%qA*VoV1@x zkb^k6C17&T5HqYRM%th?<=IB@4&6v9ADq_0dB+>GmDlT1W(>fTPN@>R^4H6 zqN-e(qkGS$K-mZLx8i&f8j^TWK%-ODa=r+}073J*2+HmzTK4>Qi*v`wvcDe#Dlr}l z;ZLe`AaawM}Dnn_((aD1VqO{Bt!6O|>g zJOU1U`X~qYjF?(RDNPUTqKQyYFX1Zkx9!C?aql1ypF3+U@R|kp9DTR^;w=0!)-CUw zp((~5KAYXa^T(Ro&%Ikp;`#+g2|>1SX<=NE6s+(1IgxYHqfa5ag~#F&pv7HvmmYz# zw$WL>3%?5P9kE4jE48Q~mZ2F$GHFNCXk1W|WI9xaOET`pNiXe7pxSig_Y3#aZZ1gE{7mjAw29EjU?|x8z3Zip{C-`ZF zd*d0?IUiW!)fu7yj^>{U)zj9x3A)k-uvWZmajridYW;q~m6BshX?acNck(3ag-ex~ zx4SK`;%AiV0uHs??ifWTQ`g?HP)dJ&bM78j%oPmg}C#;c}6ZOw6 zYadkOCY~kmC#>m$lSOsG-uf#g%vx8K{+yhmf&EFIzrLJ!$Ykm@gM9SeE?b>C_{;)% zs@Uf3Xg8zC^_HwrHWWWpdPgqEju&{l`?k{%zy#^@T3OBARh^`C7|!T!gr94QP^rkd*!8R0=X!=@ zxs#*Z?{f&RWN5oOk!DmiguO}gGW**-nZ-Ul@3TOvkD_gf?Z_ViZ&5G64|r$deJhKR z^s4&3nj!yiDjH9Cchw(9HNwrmrf^ErvIgLy?ss#pwZUW@5a9>%p#VCn*ykgbn)Pep z-xonk^Fn8Y9MzNOrO9PSK^D1oR(0}CWRrCuCO3lTj0r&;6Tm-E3qw4I>p~HJG#6RN z&qDygu;fYRZtgAXN%>4j0!}kOb>IJ)a~d2A`9bZf1dXh>Aqt(>B~ld9!~YlN9PRdT zEJ_yz7p}Xy)|xvqJ}VRgf*c~8EzkPo6)WhsTpt*wK2s0XMIk%(1)mjU0f~_B4h*}G zEspx47(vwuHw}TW-x+09bev+IZ0N7|C zP`N}il-8@=-#NC!R0uQ&OBlEcUFEFjA zLza(p4lfwOM~+3sd#+X{5WxD3@-;Gy45!U_C`Z>R`3r}$%}JlsiGSv!PH#*7((*kH z74Giqtg3ELL+?bx@B7DkN301aI+o*I#P9h$!^cgl#db3G_vlx=d#aNcWi3<~+Aw1O zVlg0@Oo`yNN!O9Ei$#+jH~E z!)ivkb%)h8qrr%SEyM2@!|=?XiiCZxXz@6CobsgWmw)ODEBEu4 z>7Xg#_6Hm=4-b-$FeCIyTKQ*#nGfML&;Qka7Z&XJzcwEK8}^2gjr0G--c0|Sk#Dh~ z{hvZ_7O0{mQtOUD>52wzv{Wvp=%%>3lFkPA3}Z%9BbFtRwE_M-e7z%+HnuXeF<}>t zktn2i(CKxaap#yXgAk|u8cHO%OB0*4eTuI-8*3vOq)e(9o?qq~^bDa)qKU6n!#5&Z zKR8^rM=St=6x_Gw{rEU|*d{7S85QkmWbf1KZezF4yl$;{=8g8J@5;gb?$9J5iBJ2i zsYDkU?$LZ6Yjf##4Kj^`I8+=YnP6o0)*ZW8B>D>xy;`G1I$2qv8U)RoA{%B`i*BdL zw=7OXLMokJrT5%L^>vehW zQ59z-j_abFg#8zM{Ohmq1!cnOr`LK~XOJh2H-!J^x2q27W>)HC`s#g;KPWr%+X)iD zgO9e~XItAX{fbzLoK#+Yc zDz{vfD-<^mDjFOQR(X8N2`tEt#sQTv`Rl^d;=v>nzfb{#f_q~n7f4k8Wy zYqU%_-uLSwicuIZF^#Lm2xR0Aijmu-1T^`oCmElmFwhB|t6aIyC$gwokxn9DjFU4~ z>g+wr?9EKe1=%@mTw%dEj&Z{1yX!dc9FbAI*$<(+bj zRm)V(SceqHYubd(=>i=Ic7x%z_qU;r2o`++T>i#i%PRQ#noZYHu~0(%%YegMOuya* zW6?cOT6yWsQ(gp>f1FilFo#qi{4? zIe}f@wSB6D&4>~pN)GUCy|kCI2v#7T+FRRyq}UXpOkwCw3WLLlKmmU(i+g-!#D~x z#1M{jYp7JKvJE^cFiu24VjM4VAFbUrI9>W>)A&z~8Ao|c^r7I)GJyO=Fn^CkfxXI= zPX?(LNC+r|4{T9vkqb#^XnOlM)dCoB9E&H!Vw@(t*-Y@#E5F6k9|xu~!`LU}-U?5q zlM>#tv7!X~UQD+I3G@))-V;<{Vw}8mGmdkkIBJ?%Ven=FDSc0CjkyuPOSWdSPybAi z%_l^}YyO2qGf&E$Nx=Y`0Um3_uxbpe_;OXMf)!~Wv9N$P=+f~zO>wPjj%BONnVe99 zJCnjN{xGpoPn90Wjx(rP>ReOrL0e^@(w1AcZ6M(J(P6vRf943J6O}z^wrY-XrywCo zP+h~i3>yPD0{wd&61ZAZ;G$a}BRp>;FLlc@C;sH1Z_V7=(m;X{s(53>pM%JP4$*XF zv6O_;iF8r4QutxMOuM-dvUm?9KmEk6zz_g!;m(0`nWgsp*~(U=nNBEVCW_QVZ%UD! zh$*Z{D2Evpk8wsFi;agaM@%py7LGk86agToq_S+hB@@vJkOtYegaZmAMk{E-!Mq}9 z@Nq@03;*;YtIMkqsCK-897rS1l+}7}P4WD!q=~Bok?yxI2b~}0#e|BLSrfQ}Bi%YD z=qXpoi)*El&jQ=?o>xCIl;IXhBrh0Ff#*sfXsCe7{^?)1G4+|AuAy>F6a?Z zv^iO%#4PKPC9l*)r{AB@#Vaw^;sVeviJyQxDd#Ld>;%EyLPI+gISzn# z>&l(}`dRa%FPuA8*%JNSCTd^Cqcw1~^7d-@3kmr&9K4LD5Jo5nwgp2DmwXq}EQI*v zoSc0h4Eqkk#aNYL<)1E@93wj+NyK1;&|*y8r#;KUYZEa;U>mq;gY&zh%54B>W$HtU zBR!!DpV-tf2n36kOil@hNZfie2LM;j3lPOOPRe-%>nK+y8UA#zyzU-0Z7~22It7i- z=vMzva-iCs?1^)g6wck1zTX1`@(6Y09d6cy2-1_T3oahRySkV<=SUzA#`9s|am5p- z3JEd2DlnEzx|E_Z1sq?=j9Ya2;xJ{)&Xf=o#V`yh-7paAnhdp+59J49jlZvlxQ1Z& zL=VNvSva>NMkJ)s{YF5f*|rcd{}no_N8}?`S0IZ!ftp4RFCxw()^S^2V#>mM$eqB0 z*`gFb*9x8*ngI>7W8{*)4HsK8wf?MsIjuM)MuTSKO7+Gxd8Ri{!VzLC*kZSHFow+R zrQWXUY*2Tt`Y#O(E5rXpj$veH`Hu#sMMLvnwh6*N zZXd!z_{4w|BE0TqS+Q(1ie-RN?7tLd0_kR1k#J(g^=*dFl&BlOl`A4;Bcn`!cMEa6Dd{5KE9!>AMpM1Q?L7s`owjD2$M+j)=T+hpkqTkJ44vP6YpwV>s z!b#PB&eyt|OjOzLX{vzPT0FJ96@Sm{VZ%Wr4gmHCo|U4y9|8(`pnD45`YNE@aLj$L z>&?wV&LyMv?(EijWr3J*M%kW#;`+pM*wr6`r8HFpU#u8^?0!UF-g&f=R)USNiyY#yat_~;QKZ51`-|^O8&ZYn8ThAPwjhRHHPdog~%GO z7BJ42dfVNk0|W-H)2o2&G)(BLf(&S^4UUdQ;~W~Jh&7rTuLG; zVvg)=O=I0ZV(|i4Ihr(cTwdE!!b!Q=DrODU7Gpuu!f9itcV!MIR?a14omY~C)xqb zv-n;j0mLH`s`VSBSaGvjo+FJr83=iw2Z0KCA7y2w*oGf!n=Bc|ol* zB4|t6U6W~(&N*=Jvj7(n`Z7RqlAw{YHIS`FQP%0L3bT(1Iq{*r)E0S4bntrHPy-fB zYeU$Cv%o#&O|`l~N)OSroIg3Tn^sxC<wb!^sb>J>q2#0bkOMZ=VjanfA~wZ$QUb_XLvB&zLvl!C_gd zWlx26!|_^2=@Dsh{Hyke!;_-x4B*BcDJX)Q)5^xKbS+px6J#wN`ikXKZK7x#nn%`p z^4Ws}XE06^{q0_ZX%(|VonBi)FMi(V??3D=h;f47{E6^vEw+lFC$e(>C)w9t?aWxilS)T zxRzCaIYlx$)=>;6g`&#QR`aTnJ~9_=4vhw;$TCIHi_}?+fQAV*fBbaVSA~--gSM9} z&*nwZe8#zKH08r9ckJF{B+|xpM~Zji;e6^RhMZ^wYQ$e2NuY=`N^reIa;sHQY)dQ1 zSc#g|5;3bz70J&cfJC_+1J?iB$s7V=o7$ud3{6Jji?QE)g0g>WMB!aQc~1%Y#5yd` zhdyE~VyL2|aBBu{inR0kh6NbC+>(+0Cj(s=oB{$FO`M@smH&?vGT==1U-1b6!XJ&7 zqXga+wDdi-d_a1;RB4uCy2-2B@Ftu>e&VqSxTWH1v8;*;4}tIiLE~J(JWnaw%?8?e z=-QO9XnP#qg5(H!I?IBlE%N-L-Z|mw!PGa+whkOG6Y8E}Y`EC>#92$6PoSukY+mS8 zWU#CnusNdvT}g87V;h3~jlqM%?S4;tpy;){yO^SUdtT@H2x4j&Ypg;#txHl5#m0d~ z3FWg+F;kXA4U_x*ODH}V?0v0o=K~H6#%I`G^mK6duuDgt5U<9&Yn(3+M4uT_a^R#A z{-`_)kb7DGe$`J+#5cF=@5e>|XMG!u|5_aXC(sfT1H*q9tpBO|f5q|t)V<+RK|(Ym zwVp`SdYMZWO({gF#n^Tl2|QK?GqK8_?xd|@0e>HOPYTV<0vq{yS~N(5OtRTyZugmk zKIqPfeSBRCu-`+`UR|F)J)hS&S_>JM>T@ICzWnnbr$W(A4SPNjp~>U2=XmH*OvR`n z+pf=(lNYa!gKTllmVuEzd%uy9zKiSD+AA%Q+i17&F8-xSROuq0KGx-=igIU_K5uc_ zCJYblm8#rHDT^efeUEJ{V3L%GofO;ekCs02F`}_(R84 zn2Pc#G7(t`B&_lxumL#9aaKgCbHEv`V$aj=nRKX~^ygoNrk)B%Y=QrUCExW8zoy2sCWEiBV* zgafWJMywi5qU@Dc-p5VfgN0~_bkVKU57jjA?XZQWzrxXgk%l}FYg=k#+-Ey0rC(l!q{A3aP zLk)Nn7YO~+!uY!0d&M9fya-xdgMtF+|GoU78Ufluv(`^Ua2iDx;0J@5BSl0i{9W^b zTqQ@WDLB_KxrCqWgxADqd#_-syB#7?hGi6_8xgsAg(oWkKszv`EKjk^ZZTh(<-BS6 zUN4uL9TE%N408cGIC{G6CWKMHlC2-M#T&H+W{qep0(1O8B{CMZEbajqnO_l80)9`> z9-}bjAtsY55T_#l;0L3GidE(M_qtgjpz)Jtd#+X6}TtB(Ybk>R5EzZq0x{C<{ z+NFv}HvTM}XT*xE7w%YO;jB~m*h_;-Ilwb3U$9`JX{QOn?Tp+!Ap9!>#-IPw#%U#jhNcA+q0`K{m-M-DXx!&>o>f}P9y?EHv)1 ztLYHtgpMIOZCB{kGmiHJsA2^is}|u1jU2DLIoBkgFx)lX&0l&04ZwldcSJ0&h(>Xq zL+wb^@Ec)C-pDh$&*@y39*-#k?G^2=#u-EY&{&+SWZR~*8G~DzYdpIv?KI#$CEX4_ zjN0vW?eM)T0ZJIqb4NE0O$4JPxc8M~Hbmc;+S{HO!6KzWWM9R&;A*C|Md&M(hrdu9 z9Q49CTC+_djm?}>ED)I_=Nu07a;hl{ixm?ydk@q~snM>trEZLwK38E6vZx-CprCE| zKiPsEvx|3!XieXM?p;RKU+~|6#f1b>P6{m6aJjazd0k+6SZtp-qI#C)4mKCjg3dzD z<>&9|Wx^I7hmL%in?Ap5n>Q-RkYNNq1a64p*e6Zv$%;uZv?JrVx*yFqh6GH}FO45BADA-qT>keJduY>(P6vZB2`@ED%Z@4>QJI)AV8ldtUg|`V{(|*^pV>Y1cs7H$MX-)7iVl6 z?(L`S3)=R{Zt1+hdTxAH{1@8q%3`5yP=@BsOX5H0N9eG=wpL;XxDGDxGdx!o;3kck zy|2HjV9gFtn$?82p;n1Gm}3~xpUNpEm-JPr%g+`sY{;df^>?}(xK>eI2Y+Lv>`X913oMxg=>v@D$$ z`RBMm?4#{&|G8a^_Ffux(&S7rJJQ;aR%^?`HU7j@(6`UkpF9U@INuwn3&lALpqme{*%sPNdGtcH^7&{R15b_maFftHU^#n zVq?qLHZXh-ByKTFmna?_It2VWY^#KiT4LdK0>UO+zN+o&t+b;5(U=p3@;?(|e#@d` z3m@UHL*MN&gw9OjnLa=8YRg{_a!QJ}aqRg{=w~~m^PV;K=gjRUvI+I zp;^1P>$OYAulL)Gpn^1l%FrK7wCeWU#g1}bB7j#>H&~lGE-4ne{Ta>JFA#lXwYx&E z|KV&!quQyV2n*i9>u}m81A-m`dD8K^yi%=9Mb#9mh#XZM_0eM*lTMZ~^Bo4?R%(S0 zhp*2;jT5bnOkByS*zsa+MtZbMu)hj|v*?BRukNBC%FwC7yeM_u>uzVbF)(DY-#zCz zPTYK0EvC92$4A^Fl0v2q92gM8M9$#EDLR58@?bRE;NI78vY9Enm`Pt{sM19sVUZ}h zvETT1JsusANGKn>0q$3E+SWfOt%%`{Ry1&VRuSZdhDiygi$&dPk6<0^`;*47W4R|(% z1V8g(P4w$S`Pau~B_sV^V=qUR5dnZNm)Z&DoAzDDLXS+C#1V=QCgu!@i0+{aQBlC$ z6(*S~r-76Qu4;s$a<0fz(nQWR)mP653^|bZmM1F(HroKC7ZA|wOj$U`a_AyLX^P!yLaG-Zq8Ef+O-8jUHEBvHLi?5t2M zlsAor0F$O!Uyj{WwqYx^oxE7Fy*{Wd3Xo8$;tzII-UYl&4D^9vgk()PPR97Cupe+F zDrxNu;${cMa02sl^|I6eR52Hfl{E%%)*dT~7|bHGyla|d;Yzl|aa*W={;A!{M{$pP zYTfEgt8ArWbclFYS@G@icj%iwZG6saZBcIH<#uAg!&ajKwFX?JEJtaVH9UOq{!~=sYw8zpFEF)X{Ci>5)4X1pM4eYSpi3|G5xQktR#QUG zOX7B_*IByD-(KXa`ZM1JB1zt0c#MevrPsX$14TvV?4U&ZLnJtb&;!yzx3_w9t(K*o=EO+?WbLxIGK7BMDb2C3X_@u5o!Hd z!n}A`2!g;M2HDVY*O8l>_}fh!c(3raaM0+y?H2?jM#f;Yod^$&28fi2!t2g0KpAT= zuDZYzcuAFO+A@GQix#1AxChDd)bZ97Zz$KTph_?ON7}IU9=><56ZNS1P4+r0%Qb`z z@3gML+83h)3Q>reKxfouj7eo@+HtsdRu~KU_kaF|Q*Ul8O^>aGAfNCsuGz~F7~Rp3 zGa22k%|-b#sW1+$@t_*HR?MdtI{*tF}3t;TjkeQij9v zV?+O>p_rN%qvDs*KqzK-pXK?YgT>RFZwvsKCwELl27y6uiMBVY)Mjq}0E}@I3tZ9( z6e=KS!&5Ubl}qw;Vlq@OD@FHg(J`ekAeVuyL6E^_BR^JuSXjzlaf8^|4^`@ zd0S-`E?F9i+3+|}j5iTE9$2c$QPs5_U@|eSi06RD*0;PcJHZl&$rMkW)nx(biV4qo zp0QkwJaB@8-YcAQ>AZq;%y- zAYV9a%636xMpH(zuOvtF`r#ZX;92?cMN>z*h`d>Y-@-}#SL6XEtg8T7QQ4q`WcE>F zY;=~6;o5&4X7lG~DC@V|+x7e9n|o}3d3pBtj=3D<>c}Yx+}X(W^?20alO&@VGhnvR z>0d(xp{61P{PZo0VQ@G3TxYM}0~cOtp5wj!?;j_T^BTqHd y@;z$rgG3HpWTi= zomrX0jE1za>RmUGGczZYHI!00^mCF#z9-2GgfL`$&*L$89{K&j;rlI~DGKC(L95rt*VENAkwMJ6 zWyeymzWnaxz@$}AtrY9YPgZx$^P+yGsDLs5X0>TY{@|@w#TdCww~Ig$h9aIPpuB>N zN8d_lAC*ZPgwTYc&%QgmC)u(s1bZ7gG&jvd>*ArdbB9KGpC6$R0z4;8KLTXz+I2{z zf>|j;oW}4Jicx{h1Pv_|x9qlC$Aa4Ss}KzVH5mS%xt$vNDx!2Ku1smHCl0^ z#kHvbg%phuG&(CvQAA)PL{qh2=sep3ERIL=#6&cNKnWSM&gMq#^;pjUBKf$0Cl}ui z8T>9^ZmS`?FtN)sMlJsL^P}(c$;VZD`DY?a%~bbGtHqxy1!ptzugR+r|CXFP@wLcg zy3%gSA2&57Kc_hZwY23@ofWN$q7o3-tpsF10U`V7AwN>M!RyRe7jU$w0Y$ef_q3&< zdN|A-J`=8}F_(U-DGaYgijyj{TrE{Te3ac0G12k@0#^j zt0Egs>qB$L)=S+sT(#U9wFldLb-9!wR3}T{lG4|;tgg|rQY_77c_IRu97KsBRU-YN zzN-qI@V-QvcLIUDHSS7<5&|FGAu&*I1duJn0X5uA?glJi+S(Mz>b}xJ(g?8-c&dAO zM{xDuX1QUxMa9QaE+bBCgl)D1K*cO1T<4Y)@Vb?=70){pdlirCBh~N1_J%D z6E-al0#XzQIe3MXf<$5XIWiGq6QVYYoL4K3l4X#F(MWBx0zi*AP07n5UkEi(N)6?^ zZ$TGSw=^tU-@9ZkKoA@xg2P3FZ1+(dnE8%E3|gQW)olKn z=J&QNnf0rd&LZtTgVFT%b$QF|3aYWV;kJp2a68p<350^Ba;L?k9G7zdsKsHw<5514 z21^GcjR0sTWd8D22};*3554AP1jfQ|#KVnH$;nMdjWiZKLL6AP3nVn+pzAO{fM6xY zLiv0AJfJ0p`^zV(PLXH~rC8MOYsa`yOcVJW&aeUw$lKr%JiyEStC~fBHs8$}ix@8~ zZ#3fWG|}|9@%**l@X-Kaw9ynfpV!SHWD2y%V`nYK7nz`c`7lVM>Aw8IAQpCHlpsK^ z6NSpi-*_^uWUpCRo&3a&p-(;CLX?DqZ`}76G@tp)dn_3uD~pxM*ZWfOn<_jHa|Z^0 z;tg>xw>7nHB>%!}Fj%QdF{i?R;;*;PG*2NOv1n)L3JdKSUis^V6y%{{J3}Aq`^!F; zB(!;!R*J&?bY2@RRWa#iak>`4|NhC6ITn3Ba{`pw;k*>aD-zLIsy8gS%6^9@j;q0i zH6`AKL{*WQHH%UyL(=4s%r~C#W2x9avNrI7pDu{NlVe6{N^IGvq`8q{%!g19t}5(Y zdS=IGtlWXo4$R&dMZqFsqGb65=3@6WDz{v<)DIoPQaIPKLRVog=(GIf3KRd4-O=qr zi!~+z*+xrV2^#4^i$TO~t*iRCjaVJc!W>=ZbsPxi!BPmk6Jw40{d1y~=^iCJrY1NZ zOouu6ZwdUSB2abK+yO6x%DR)58K>TMQYtH*5;FV;=*il|8ovLv4F^To6APACoHwP3 zN~UrP;%QJArl67DiQE0(xs4*59{5%$REv} z!R`(u4Q^9DND>x8A#Jtpx>KJ+ISsQ1=NK@D-2`;7fwS8npTj8Rh9<{+Xp^$tofhi& zd-~JndEo?W2Utf2c3@|JPZ3Zqw}YXzp#%GCxNz~O2xyV5#>3tA^RbV;h8Y;)j4*j% zx;1R)#&R;ru&sHZo9p%GYhOQ2F8<`dRXxW4jnT^dpN!UHb#3`Wwf}oxuRjBBRq^(< z>kX+y3Z*I0kzP<+Hp7>3BA|=RX~{vQejam=n{`|v#|aj0L$3f5WJu1iKgoJGGxDuZ zI37Z86oT39W!2T%jjv(1ZwU3Fe=#B-<#`o)p^UHmpc7^6OSf30VN3lIEZD5yDYQcA=;k>e;w@F)aYP&Ari6Hj)>z8 z!AS#MqZ?qq54HdI(H4!SlLs!-=e9OE*$Y>enq_W}`i>-amwg8X$ZN41bgmsX_(FP1 zY;ZoP`WhFEpnxe>v#jLaK0!T?49Q-ku~S6(7==kIqqXQtbN~QpC{$Ov$JAKMy`f{D z-oq5(c&$_-Lrby^8S}3wNiNMwHx7(UVpewrCwi=Y(13#Jx46+m*mrH=Ssa3aJ&z}u zxE+EwMHC>;qtRfib)n}_pm=aOd2OXclXp=X0?+}ijMsJ1xG|$@iFnICBYl}@Cz5ST z1-)-;uk0&$>yCj()c}SOl*~YtYhtQXLS;t-G3FA1)y~{;>KonzcG1_&TEtpWdhZ_* zbgHv=#o~FkTxUq%OmouT`jhpPDw8CkZ|j`tw_$OX!$Mog7G-9xa%eG+G!|vlD1VgD zG^dbjQ#crr7aCN-_bC~6F$gnsOCNartTUgu0E`(w;I>S%LmS)|XZf zjZxNxb8AZI;+8CPA;R;y1Ki-f&hzNgn>7MXKIwTO`sP)X(nNJ9!0xifjY9`1JUcyG zl8z>3xqt~MFUc5_df~>5#2weh7y(SyquYxV86S8-b*?$>uZ){|mMpM(k}vIl&e`#jwfHO?A zV_P=+DzCN0gUo~+S2Es_aAELjeMSs{+8_2gr|}dkv-8ry0F*(tMan#VHk}qyMB82Y z(C0TXqK~+rBnSUg5(*GXZzreP@wP;6DPOQ*UVesJ=jL+v$Ah(h(bG|G-px!h)A#rG z^>A_XV6rLH(bdt>?K~|jvc|mOZjr{EVqj@;EVCAPEt8yYSrRl5YJQ|zW?+In1jCEn z`!>Y)XuEvC4=zhn7Ezt$haUPkvP!$#6WGXI zB3GhBuC_P3H_9o=w*k$b+8qZsrSqRnj-Md0&OMTT7BQtVAG;M?iw4I+ZR}#UPAfZ= z-GN{;sSh>D;JK?A)#S~m_hz<7cJd8lGqE6l5@d4y9IsQ??K1mvOhs26+R)9M){!h9vat}rl=U;V1T`W5gH0r^!mxS5H6^*Q&{j?edHe|V|M_k~Zt zyBk-Rk-We5abCp_=y#-t`Csqf|B2Vh$o!vSIoBGp&j0qCdS2BX7KAG>p~-qBPm4+9 z$Rd;5TQW1^QiF+x*vOG85>$|8pT^wp1-0_?HJldT78=HYDn<^jH%EpB=T9NTA;0z{ zklthq*NMEC;^6XADnQ&t1iL=Gh3u8*=-wt?AB$?hA{7@045>imiF58OQ%;~{} zr7U@9>8|!hHudf>1KX%x{;;xO`_Kh7_3iL@x-;?M^7`_6IbQWzKfHH~E>~9$(tf-gLqfgf z0{BmxU-p%*JhdH@`?#pcqfd4eCI?C<-CYDrkwiuy6#U7YnVKXelu#HqF?ajG;>nBM z$G0dyBkz&Kt6q-OHEa_$s zgM!WFoxy0zp(AIWSE^nq+Gy%KWzaO<11O-`j6h{1G~90_fgvS;9CIUsB(q$tsO3TuowtR9+ws@N7gG1Elj&c&mt^4ExW;NK z>k9~c3N7js<)+|xj(`w^d4l%)!ZYHX=z^|~q1fKv*@6-9#C%zayi7MrK0 z#r7gj_VKh;rT!8wI>|67>*8$fo)W0HGmitL7kUYc&_@QaIXIGVYGSW;~W9f}PU7`VhZ zHgahI4m6=TQVEkY*lFAG+r9v@=t0S!yZ~cDgy{{T-&;j1^X9f1FDF9g5Xk#8FmMn< zT7#go5I74Y|B&`14eLvuI#*T+yu5fbX4O^GXToCj-t^`P8#C}I2_%livsNOcK&0&y z>AoGzgP6L%#~%yB_IXGadF6bw%?OX1%0CNg-z0D&;2&cP&y9Wl9=^KQG=wZ&fXnKa zUC}LRq6h$`O%UQpGd5`A%c)^Q`Miq-fGJO92pfv?oT>Zd%aSLGK=1z(18vs zW+t1AkPvI%lO^)HQ6f>i7jb9|g28#jIDZ>$waUp{&rd?tnJfJC!;Ye|GtNGiKVJfAb?Ht>zlG z=QNvMi;%D8Okw8k!S_y|;@!*ExKcyU|R3Vy3AbGAXN8A9~zh)%@x*`0u;RfCM zp;5&*Nzpb3Y>#BgtO9&xQ62OB#Wd>{yYY~R(m_Z3nyRh9WQ7esK!S15GCXvP#vE`gAcY!Eih!T{ zF~db`D1uyZeX^R?>KjNP#g;924b8|-&msbnTwjj(zm5(@G?xWqV3hd6#uvDN{aFcaF-fJaFpIV5l*R#9?E? zUV;;Zcg8j(x>t5S#YJUAwoj|F5Rd?Q*o;8{!BkMfn8-3;e&PWN&m~hg{GO>=E$RZ~ zBY*B`M?#|=pXTM#h+k_-Vq?BK_kuJ;p*ETCP=`l<2Sy^tJwk!bY%gSXw{ZmXP3Wej z?<#Qq|Hs%n1&I=D>(*`CcK2%Awr$(CZQHi()wYe*wr%V0`^SwN=S1v>9Z~P~QZ+O4 z%Q?po#3`YN9t6;YKNP`csVOTt7;!rSUoxY(5%Ko)ETRFeID??P1MNG}4(gqDQbiudhl>+(~YFeU$rZt$RuNsY5yTim$$i5=zd*%;-WsTlT{#`HyF=a&#dT3 za{1P5SW)yN`X*A!f$lI3hTCS>DV2t;shK}V4uvq|vKa{b6fd~5=iVJPc+Ty-946l` zEr;eZjU)}XEqS1VNP}L%5MgL_I$z5ZG|1vQN+uyUJd_aVqZU(meC4~WA z8zD$}23f>$!A}lJPS&&`jlLj@F%`UbkEamN?%3!CRLPP7!}>RkE@tv&>dNdpuk{fE*Y{G})+F^HwsMB>D+s zQEJ-D9)E@NIw7KK618^Fi0C?nxDOwz%`1|`m*EGE6^&D02x_#Z`pGLhGo1Sg26x$Y z;Kp$m6MMtMb@{_xY6t1QU#6OArjMeW4dPfn=Wzh)q-j?cTQyhQkLcJAW`T6O?+ zO^g45zH0qte`VGx2l;XR2I2L5HQ-Hx#G`=)&AO*CdjfY_vEb{?T=VL5;IDC6K_u%9 z(kp8*3;gDis*-g}*YKvu_JCMAjOfnZlQA<>S39UjTl?ewvSF3QZrx4N|G}Y$dL&ML zo(O;+H@+;FhWjjudAjX{jPURgX-XI9`xKT{-{Yc)qs=lWrl@CI9@nBW=BgmhR5=u6 zQ_#_96?u)519OvG&ug~sh3PU8^24CzMY}bg%4t6W?=rGb#_`)%kE$V^*4LiRU!tQgghC^kjP_|QM5*+Mp(7MbA1U&9YNBP zSV~mJ`K`1(PN)*_q?lv2(Aa1q@k}T0IXBr3&m4mqfPC!8Aih!7EweqnvpruC#_jx- z^6Z^{Q}t8yB9Y^lzF!9Y(2bwYKQGbpfx-E=t$#nBzqUF}WGQr%!&*9DH$ME@qk36C ze4OZ4tnZw*aJRPbGfiX<4PDkR1{1?Y?9{%V|8Q<{j!F^@Oi-IaNlabp;-hapd>5=8 z^{R9x=^kg-53`NFA1u_##|G1(P%4K)99b`v%L)`&7 zlcSD7T%GA+vK0)AgW2A*mMTdpCl~nU&UjnE$mJa!Z4e!F51kasA~E3RH?TVg2RXb?H?I;AQjv>EUT&5w03-ETAQYNBnxtxk2`vlLT~3<0 zn7h^3S{PNr9eg*=F$7ZI#S(mo%0vRl56BD=iH(hI3&rW(DA9I7@u*$k6byuze{9Cz z3N0_r4a$@n#pjeGqga)~)7s946G(uoNU!496%^FlR;4K!09c~Gn$TLq9UDyfK6G#5 zx<3rHjjNmM{;hAFWjTKe$j;@&xixUF~tH)@2~P+_|vrz z0W%xUKX4eq?B4qvD4jQJ0ySGtvpLF=ofF5u5zO%dXARPStgaCqn`-(60@_UKFP61l zFB$@sQ+aAQOd<9YhTAE#2Yz6blaG`mSO+V+X>tX7c3xzL%N%jD+9VNz3`Y!^YgzI8 zy3SoJSytnym&%qxAt|K5pP+F0dIHCSeBf8b$ktF33>)IiMoQ=r9+OgpS!wi}QxhHy z`DJUToKIrVDM-~}BBFyJ3iM=l4Gz<0Al~B>0|jtT{m{|n@+*R1d;!4prOy_BWxuf} z<0yRBRg0Mg#S`(@){*^NvdpW?l=1g|tjdg$b>9J@#3aZ~Brf;fdF<#684!HJBiWj< z2QJ5A8q;AUQIB^usiG}=*7-}%f~L#kQi_sM)#H$dz4d{u^)uxG|G_&a=+!BihC(o# z;95h?#_sInLLVimegPDRIH4LySeCgeNKkv5G1|3&WF~}xmA>x>BY{d(&^WNc*Kwg3 zbzGg_SCu{rE9Mk4FU`)mU>aiz{dEAktsyx?bhdT2W7Sz@a;&Y*tN}@*Rm?`d#j6lu zE+MuDMuiZM@!pZh9;Vcfj=x>2ns2%2EBR!1z`l7}3>qLVL9NFqQzh=Bjy(;f&tY*- z2e_wRKbV&_cSQ0WKt6~Fz4G3`dG)T`qbOFb*IIgzZ{oV+WW_ld;`j?!3_`^n9WBuK z*Zp!cDl*|ZH=2k0`D4Y&n4qzLi?cfYB==4cm%t+g3Rxm9J_ZFfHmTj-Wy9tQA#hiC zgG1pg1Ow6OM=L`GaFGKTuLsg6brprl=$`STR5I=D<;ON$=&%Ct7kr*R66A)A`-03= zbDw;NkYcxfh#CH;aeA8ajEG3Se@ui>C4#-QDD_b_?`Q9RP4$cyz!+ihnWte9XRw=} zGXJ?i_8k&9Rs<@W6%Y+4!;y==-@9(m2K@k5KC5`71l;9vvEEVX&#R|3Hs74N*WwdT z)`mAA!1hy40cmmlO(}sG5Xq*wC~_2Ydc%%tchZDwvS_)p(zj^NbX%c^N5X}a2i99liv^6#ZxiM}J9MyrF`RQXEX9X9t zGx`6PBj~Z-k(r=pGKr4B-obZhwX_T$Yqf8inl?jx`7swARazlKCeFgNNb>LHzt7J| zVX-w?eVqKwkeQpF`J;c7L0(GcdAhmY7x!ui{#Re`>yGy$TVRSRfyZP{T1c9T$%#zd z*sC3I6FSM>C~eE6m*n_xsJSb!b2Pc`-_UqEo?2!DQ?H9YIq{eGI;)PR2|`>&6r~=` zze@gwu#Aib%!eU{O-=mwF-WEA;6N67lOpcyjNEwvHs@|_fk8Ym8#}Tv_?m0EtNyr_ z^KChGHJJ@dcof)bzt!RmkoJ)#Rp(~6*vYhGM{ZA2?H+(&H~(!ID&)=@*EE&(`WoOq zIiJmvy*2s|_MIFE^^0p0VWV*bmg+EMwxiWSnlTgIT)SxzmQ(^BhuJ$p_Q-1xpUMv# z`69{tk;eLu888wWJN-DEh{-b4IoDDC^ifi*2-3$C9p>IndiiA_j8!^USxQ4bUI90M z0)^Pg37RpH>0l^1q97tjGF;Ukx7@0aK6W{?={Np`A((p6Za6`U>=Q2Z4%kIn>m<_Y!31RgD>l!2eU;papIzFj&M(>8q`Ds%g_ax)mw$<1GQeFTf@z|6tb8f6&~ zpetOv+oxUE`l&ho!ms1CVje_MfCUprb=HJ6E;eu4`t-HV)OBdxi8|f*Dv;E< z!xDf2ffZt=!m)v37Xy_&WPx|cu)p!d6&)&d&q=$dkhd5Ll@_)og&5(>rHT+x-2<<+ zQ6hum$7^g#9Wo2jVD-Gg;)N+JBzYY0IEx0?wGrt(@;VSf9w%y*4#v=EVjxOgIhKn} zYnchWl{&V6sv-snjF+aT?3Dd5XP-@(WvqWJF}JnFjjUXxdjLnyxAb_lJ43viXj_k|u<^YkAROUD0-WyQe8_`iluy8j<` z8G%thAu#etC9TIKYjJYjISLj=L`nbmB5vJyJms+T`-KaILc`H~RCJz5phP?@48PY& zEob%@_x*|Rr}#E1=WOB4WuLpZ5U!tmgu#K#DNGp7fc!XtDZ|IvPm82VGc|V>!wJ%N z?=9QOtxLm`+4+VW|C^?9;)B`az@A9H4``L21|^+EE>91!1U|^KWXrC^8?Pw*R@C*8 zMWdEcqubpewVsz?Bq6`xAPE7j(X_vYE9t@I`Yq7WE#vdgR|<7ip$Eb46*o=Q`fO6k zl3e4^r^f{g7eZkBZhj&mQMf|Jc!!SP1>DotWLF?Dn_tcsM+fGw6ZcmGG^?7ks-QOR zSqoVCBJEwe;)J5Fc_sACXb{Z>lxd{O&Ti~2q)^-2tk#|yY__E&>BJh;Z&mkcg$ z@5;Cz#df2oqi0^v9F7Qiz!8 z7&~(Qr6HzHTlK}~Og`{P+?Qb`&ywh(u0ger`T$M0~3%OAoF;MBPjbJYAc zo&bRRj$Xgj{{1oM25i`u{Zp7d@)_72%%X~#P0I<3i5F$721)$ra=dGq40K)&Dkt?J z%-J>(aAmzFLO(7OFZ*G*qeJRmqw1oe^x*c=nB11@WPDXt%@T3-E)asvI4}3h)|M9o zoj|^W9e-hQ%?E=R7+ghS#?ELJs~@8%K5`M*v}#qD!6d$aOhMsOd8rOl=+U@ zi8uu5uTz~xX>=Mp%5L2=w z+BsEO$fQ=kqYb@rjH9r9-92M=kA|E(nc)%`K+8fv1I=mzKpP&@H~K+#J~;RFIQ76m zb}i}AYvUT-=ceWQ5@`I#pF6mrt_m=8&+zI}A^4z7-Ut7@@=7eJ&qgb_%se=lcnp4U zL+$yB**50l;&NPKj{CZ7HYglZh#?A|5KaNb6(-H`7k`>5sFE>PVn&Y*@l#DHxpGz5DK9Z{)U?n)Qck2yGM`E8J`jubJEw$A)p+IV32p4SWD}U9oaQPQ~ zY@21k=PQ7qu9B4V?` z>zS@B+450=A;JnvS|*wXR}OI@etNSqOg5OaQ5LI74Yxu;-aZ8~M?vHW4=y&ypiMO~ zFs4NGb?2F*);>z&q`HrjCD>>N1xHj6XZ$B_iQfu7d@L{%UpS$mwnbYD78pE?^9X@z z`o^3E0|J-SLB6%<_;8j^L~HI(-V{FyoCi0Mu*(?UVYFhAn<}cnIQuO08o!fxJhmL=Hg!s4X#GPM(B?r~%9#NJ2I%Xa?7K5!ZP#Bis4ak&gctWj2eV=Etlo zXPL)bi2yeJ!EYG>VgN_-2DkH!VhKYw3V*OtG%|9T60!2(GK|F_&>FolArY>H*Q8tA zEmi^5gvZ)k82kDkgGvqA@fo&V zEs&J@^<>=@bwomkl9< zD9xoL&uKQWGR(;>3O-hCHv{&VGAzwm>5txw_hx`Yl%s}bG)0l_8$;hFRq^{YkEKjS z(i`C=IAKYJ)Qb~X^8VGI>sq6`3j;be55#YVSUmVZr={*`lQJcY5Y|KzY2t9Isanbs zwtT==72_2+aI4t^7!k*Y>L9LYux%w z=%HXIA|~DBT7<`NZN5RF!a~e;Uelre4?jdzm6w*+u2kh(2?4VU5{p=a+h|*G!UhaW zY$7gVhB{@}tJO~Sz4-z%qv_RD>r>eM^fN;?LT}bo;MhtRS;f5f(@gxF0*x!Mac!01 z=gYS3haT81JNm(e++9zQp{6lIG`F_iXRsU~>%FbP(F~-z4E|DWE>6~%03|^GN)ITG z=NqktTk{i5xiyWR#L=-y8wT4+LBJYRN3McQtXaC^Nuyt|xA)qN0bgD{-OnLS0CFmI zC!xX0p3ElQVfS_x>cx3W5{?FJc{qA;di-3_a`Lz_;XkL8;;R}MA4*Pv&9odyGjiyz z8uH>e*J`)>=g8f&8fj)^MxEW=h5*sV=r;lx zsU`}dCW(4wG$UmmfHm5g{3)A&DU+h}1>3wl*g0J|c)jji&i>N~b&srd;6pkjnO(8c zuz{@40P7=rxBL5-L>=tBK1|K7c70aA68b#7>@VN@i@VdqOXn-zPEQY4PYzCA+%>r( z+Gv|@?lI79{_&=_T6Tt&p}oz#E|+4aq{@3f;f{cB{TZzwoOy5j`5wvs7NeJZlFL=n zNbCAe7eqh!+?*7tE70b7(idz{KbjA<`lrDLay$++_=q;Yp;7pfc|X3dJo8IEC0-;_ zFynnhWKvTI(^9d&k8aA2)_TkM-Upq6aL9B?haXw3_!S2|oep_zZC(}zx_3j}s_#gq z3?H)*23+wjIxJgXa2_k#vWR6L+YFWVM*FAmgQo13_)on}q*)6$K4wxTTpGrL9V&gmW> zwQw_%&O4tfPaPuTT3ZIB-~3x*J2sUTvQlf<3UOVAiZvfhjMbC^B-vZTPn|8(x`|H- zi?*_njB~VpBv#+o@d50$g_*TC4(_yU z8WYl4dIQM%fd{kh+XcF#L9?WJf=1P}%61LKx@=9L57=T{$a-+f`;vnxzXu`3IbamR zr>JG`c4-SS85C7e1myBV)pg zQZfXRwRysTfWVOp4Yy_I6Q6()v8Hm88C??t!N54bX3<+f8a};k;oq>VYi6jlhI&2E zf2z=$JhnNUS7zepBFujb;yBMZ3jhiv+7i)DAS$#A30vG1M3LeC`n(LrkAFVJ{;xBE zoJW^ar`^uSMc1)<1o?$h9FagU$0yIOYkO9^C%f&+xkl$-<%D0$-*Mv6;f6*jClH;Y zL=yQExqNmkKw73esVBQ|)Qn%z@ zI6Ogt<)Ui)bRRfNs!%9LjYMu)XLxM?#H_}c(YW0da$z}5R%5JkiPY4utn0?sW}A&c znasr{y$<~K^(<=)-QtEG+-5do`7!awC>MqO)~Ne3K9(aoF^hDm&K6|^)Z@f+GjsBLdaoyVNNDc(Bjw!MCKE8f@%qJ4WaW=79rhyTS(tY(-4<;etsWc>;h) zB0)XWq8j1&jBe$hVe6aPrWH9-Rqm}%&&YoT4H-rfVnnn`$w6UV(J=WSe_6$KR?Wmr z@aXz}R6?|v5I&mk_LhHv=IUC^6U;4iI}e@3i)g?n{(Tta1OQ|5vPU`B;T$lSsoGzU5n6 zWvXAqNu8x`3r92)_28 zNU}raXP9edzRuJIK5(UGA;=tvF-|y`Tbt5XDZZLS8KOk{olFhvdXL4A;pWrK`t$g{ zzzrwFQUBvo`d`t17?_y;*TCAcx|H34C``|b+NtW_7_$?eh3y5~R`YpU`JpS)8G(jB z5gm<(Er-s)kE3Z1@kGCWn1(eJ3M7KYUi_!{jM&0_S-3EUuXr)}=e~JMgs-}=-S%R* ze)4{@aMVUP38De{kwmk)-Z0SQ+S7ho`2RV8+OK!<{Mf%eSkGWYH9214`M%$VdA&BQ zTURb{KfJDVZFjWYRIX){-C6d|A4ONTH)!s3{Taak+ZcK5YGFK~kc4n+b#;42Aa+m+ zVjS*PAl>IPqiC1E{GCaxQ6qm>w`cwXB{5Q6`tIPwgiKNkMaR_#TWS(@lSf?~WB79e zEFy$5UdKXP)G8HBIO6uvZRrW?^WtJcgWasYVIqH+3fpv>oI1Yn&5Ms)=<*<+BA z&n!bMoMB(4Nx{NzJs~6dAX~k54(JzZF z_G*P=_s|o!=Qk}77tA_CJ{mqrX=TnprBzJxXqughG7~()_`dI1NADqAe#==j>`eZs za_gLEnnST~CsOoapFa2pU^h4mzGoJm#2Oh>z=+T~#ObCAGy`N*hHG?U0DgO>pjK3# zmSXl#{{^V$cz-AxiG-eKrcjt5vpDEb$5LSDNdT?mNxiNE=(waU?tdDhJjD14T|mL0?*2TGzRD zf8LEr`*JiZ7{-)CTS)p;n)wfXQYGD5X8Kw{sQF+hB|^;%Rfh zG6M5`AG)F}$GZ{M`Pok^-A^qUO_B->QUC(v2Ei-2YwvBEPHc@HP}`N-oed*4JQN!# zH#e2ShHSnA$ciO^Y9kk1rW~%e-qAjk9K7Uj$9T2mY!!)7M**0(^-3Ko8}>r@Pv`8m z7=~)7-BQrWn@>Eaa6Z2uQ?bJH$fX9S&gx(c8gBNycv$!eV(ms)xT4R{P%CCjQqnA2 zmiiBjf{0!hih>yzqHD=HjZYZjE-er;ZnlKy0%JK`3^L`VAxph(b9>tDK|#~elvQg9 z6Wp?9U8Hqcr{wmzN-pZP(Hib>7~uDz$$HYx3$Ihs)%^TP?R2?z>YbZx5*z<5gW38b zu^HKe1Io7YKr-x(6f{detwEqV)G25Y_cv;PTC(viRp5b&LqoXl&#_({($~*_ti1mf zS%ra_ndyHXVy4w(><<3_ru|biicZ5<8HzSmeEukr*5QusAr5l1Bn)|yx{~7Q-W&O1 z}W4U@gP3jJ+(jxWQd7ejpfpByuP}c6Dy>-l@PQD=dU)#q31=XM}hX0+MIW1Pto3^MzQ>}qv6Yuv=KA0aG&K-7 zzUR=BG3{ASz#lZ=DvOK#4(bE786JmtNH6Ihf~)xG3s*R7tE_7XgVPen3$($JJ2XGU zjhE97!sSUWTrd&FMX&II(;pp-BO`QPP>@FOu99|F=t+SMj+ILeUg}?Ye~O!@`{m+- ztmpmpU~2k;jvNut;yhKMAgz*%kA@^*u}&6%kCvF@`u=q9h?B5OKMcGWmDEN?71`FV z{!eD~&%-5Eg0BNhb`A7bwbV;TxALX3np(nSkF0d6>htj0dAV0(R(}$p{|w?>%dkGm z!Ji8=luZL!H=kH-*E~0Nc2Sf{2RtMziWa_2ii9M(k0Q^i4P^k?3>du0nJm3tb|?}U z%EV|(zjlc@x#7;h-7uBX9I~20*;&B5t9Dz5yLg9(QRhJ4M(gT=DBm*_C zKL^-YP6W^$HMK9!d7pQe9XyyoL(~akvUOghj zL>&ZE1=kGFtQLvZXDYR7R^4NnG1@VgBS^Gl6&#ZSeQ*8$&^0tvr(22En^|1>xPyZu z=UT^1aUR=oXSy1v3StIvU7){a9SwpxsPtpx^ItDaT=m>V@UPP&B)24c$%MWU!meOr z|IqUzW}7y|qmUypSf@km*c%@AiC|oLw=Vd2DWtqL%D{I;*_*0%)vS}g*IqnT@Z)It z>Y-@pY_#+WfjQSshO}Ds@)s>I1_w?FjeOU^TG|n|hj)Dwj!e3KmVj$ZlBA;YMC%T-G(X z%w(0;yNE&T_l91i2m+aidsYjwfZ-6JMm0JPSnGv7YFszV%resPxIcpC5Ft{y!4r}v z$R`^=O?^DjfnC~V@7_A(WBuD$gXvYqB9(C784PdhHXU50aXTva0|Y~mQ1>58{eMM; zU}XQFgP5Ku`$OiI{*~9zBtyW9_o%40tGlh+uKZ-~^5%gifS2Lr)=UJ^NoAsH-n zJho*FpR?Ozt9B1tzCE4Akd1~dHhlWn4o+to4zfUuiEHQyMRt+sMg&WNbi?lqv@}YO z7S1Q110T$ODGT?fcA8A)O!=xJ5pSp%)*QW9QS?(PS`2XbvN6)d12hHl5WV7FjJ78X zUuedG$>e`>249*YA$jLp73Qg0;-q*ba9QL;b#o={5kxzXY@_OHw!=EF~@-eEh`BpIU0Ep7HwuA=zD#)}*jxI;&_>QEJk70`s|1QF?N&!F5fj$8}fZV8bjqSDD zYsm{bl1-!vq+MXVp0G{sr94;wywaRXuL3KqKUdob?=oFp3+-Zkn1-yYjTAzlpngrQ z*)m{*;Y@5FDx0*TC_HMU_yqmb3Zfr^Fui+pe9g0EctI7oDBpY-p((2JlB0y$aA9B4 zx|ZqhrVx)Q)+0cXx&V;UOuO`VQ-G^>6-5|| z8K1K%bB0uE?-p1vWjH(AFhKElqbx2ygMf|nR4}jzC8`U77>_!`TcIdBJRpF59ANw! z5!W)2DUP)Ef>>W@*U3}i%2RKq)$JWa zdMPgt5s*F_?oL2AgH(EG?yVZ}(LA{Vv+pBYlXIlO5sdY8bBpHiQY=X;Qj?-^pT9Pz z^&)bNvD21`h)tZ2%9sNj4FUHUY<90rwPfsLB*Xoo&Y6A}YPT7E5MwfUB&vcOw?-B#GiJW(B!mhGLYK@72qVyW+73Kr~u`35X7$$jQ>_ zj1w+{KN~8~v2P-VA-_E+bKMfA@Zdwlx~WHt-~Okc{8^7?QVXbtRLmP zxnqRXTkB=Oo)08KgilLN;|26K=Fm?hdnl`YbA+rS1y>Tyu<))ksU}*e{FP{JZk!)Y z`C>%>i*B;Mx2)?YdZ3j-KO0~2G}Xccd$U&a=wwJ_6<**o{t`OwV)$c+>Bw^#JuT-Y zWVjErb+bGYjl7u_+&z4DK>(YkVv*j?E_GG~w*O^*x@{jiXN)vv)F;T!R z00pt)9dv6HD%{$&-rx~km@@tkriXR$8Q*Xa(Cn()Q+j1F--kb)pC}uxkp{PZK%yAT zR4)A~GCDeTtj0EXn*=S!q0oi>9kM^nke(^U^O45nC_=4G!%^Ru@$}Y{wsCChQ%>N$ z8fQjE^0%R$8_DD+s~BRq)3Z&ee!!cF3j90+J}u>EI806L&cD&qhfVo|(m(j|6Ay^0 zfved|yPvk?vJ~1f1K6K*4{YSl1IM5Q8UX1$w%B|v`-Y0Z0MZDihp0Tb>nAYlvwOjY zJrP_`5rjMQgUGY$B0V_i(&%)mxwt_a=u1TWb=SE;+;#LZ?_(esjI81p?dyE(C6Ptive*1G=aw@sbrbeS!EB%7hMOPu`ILZyPMtwlQ1%^s=dI8tMmF~ znV__VVUy(%KTW%zcM|^I5=GDP-x)sl$P@y=c;sRUX^|75gvt|cqjQ^>2GH3L_55)) zWSr@pPN>BJqIKi7oD#^^sS0)=a{7fp+osFc3AJsY2AM@T-`BDd7>LSYY`p?H&PZVp z^n<>9zcnD3n&-bkJf$=oO4gO|OKbaD!BWP86{4Vc-?`6Yfdl0?l z9eXmVlONrPMRcd$qW-Sb>n&*)B-8teGm?uG51~n?`#n*QVnwvRkHcoFwuWA?Y0dERVR;O`Z%&+ps*pq`T zn9CW9FKQ0>x$YtPoz-aX?U50OGHBf;Dh&9-nyQuL+Mjd}@Sj<*-=|?q(D4!sKG1{Z zy=S*q&Po9pu~+wlvrR6wxkNd`3+`cmGZ2olHcYOXGn{;T1BCIv)9+%CzB=!X99>7@KQ+~ zRFkT*u_xsV{FOne2kpZ&p_wz&Vz_ecGR}aT- zH??o&#tHrVis|3|R`tA>WrJ}Uhx?}QTU}U*I!;Qevv8AzMa$kB{Ip2aY1(h&X3hTa zLPG&^lkW>Y0!*#!T>q&^Y^|j-cbhxQ$jVT+QF_%c*UH#1NAzuGhh{ivoUV!k?Xoh) zPFuJaC|flP%-QyR$FG)8MH96e$h1$(<+zjfRUu?MygNnavOkGMRwM=!Fk|287)Z)u z;|lTGSy~{MQG}A5?FPY^CuZbvsGqA9`+vD}Z)MS^S)=_o2l|};ibDG6P^tg~_1Zb8 zqs^X->U6{9kzm?Rx@6xj4V`s;Iw>YcvY!-2!jh!xbQcfFDfMuv%nCcysqQWUB58EYy?S+wp4p5iVVIU}>uX7EDI8(|VgT}C;((0YtkqgTo zPEn$Cr!Im3<``>=0o4QV3~nh!kO1N0?B#mZM{}!Gg)1}OU0bk?Dut}bq;>(^lYQ%Z zSwC+9-G_ph(*4aI&1fTJPy|TNLad~*_9smSkMT_-9%4Uhy^Zyo-xeMylOwI{aGXck zEv0#oEM%cyusA9BG3RC@9dI4sU^W=>@!%}*8~8|rWWW?FcWgrKbIFY9K{%<|sQz*w zO5)FpW4BpW4O4PGOI5G!w1D634OZ><^8j*RZeCr{%MEM`GuSv&-J}|aSe@@vov5B+ z0KIuD>F)P7-Q9JxVg_SpLvLN)uD3KfdB+oJKV4!L>HEAF2nbG-k;hJ_nVH?w9KCVfM)!H?f$-3lFo=4Q znvB|I!x)McLiK&PJh3)RkDzPY+iL6Z6bL!24|`)jfRMxc?0F;Kz5+6Y(6+#YXnES3 zq`hykb?vnDsmu~OiHLTS6X@1h7apG<%FEj;qj3}uQkx2)E6&bdIy?1CU=kr%s-uS} z9>0gBl7OgP5vI5y0)^JqP7mlg=>}gppO7}2vZbD{j60+P_WXV^9e25F6dry%{^1)) zl|+SIg@zl#6oFM3FHb1%m)87@jx1=tt9TKAO?O7duY6Vp3bx3rl)-QZtPWqNsCcC1 zqf!>aXkki$v{raHjNY(p6RBkfmD9Va%t*&68{6Ck24 zpGm0e1)=8{F3)QgL}f_a)swG8K9B1?3V6)6q|aA^H4n6H3KF@Z(_r>aIyg+(s=SRfQot2HgVBzZ`>gar8_fSDkp zL5=aT62J<6-sa!Y+%Yj^#ww6z?06l)M`M>4(!G?YD8el zpdd65ob)cwA%woLKKZmL4BHq|9`_LH!nP7J>aS&TKg-+2>=)hT`^D`8-aqfK|RqFj;ce&CIp449Tad8Ny+`xX0VM|RgSEP_LF@&r%$tj`G6%p16IOMC(ffl zObQ;R|P2Usgs{2LZ!9ybdE++Lax|p8egReB81Q zB7<4tP02bo$@k>rrS{c9h&Tbz1;`Q#27c{G6b)EhjN*Zj&~uU#>KrZ`rdvyrKq|z6 z$Ct!*)ze?v4^khu?MI7wm7PBEQr-e*RJt-+g{eIrbzj^VXO+fD#;~QAVQ*C$)BEd@ z6{>`IL5qZ$tl+d=;LFHzKBCtM3`miJV5X+>ZfLj;TS~iNd&`t-(jGbjxaqDJ$tD0X z^K6OZL1{_YR7E4G4ElMcnF9KhI`Xrr6A4odRYo7Hmz)UgK+7!C z8VvLWx>)NIS;1{O$Sf;P-*UEyW9unS9do;bi)Tc7h9zQ9e^Ln`_t|1U37IzgdzVxQ zLJ0`!?x5zHn1aDRvP$Wb)?1uZ z=LBL5jZgV!taUOC#LAxX{*NFyflXsq+uSLkg8jGGDs#REYGif1^X#d0X$}fKip4E| z*oK97#Mi=HIbV3qjpkO?MwP~VpL|&hDrqeotUO>i_skQb(<#yC;wxHTJNHn#<~iIe zTELAbq;HscK_LGJTtM22z^f~HfP4O7V0B@GB36yqh-=;BtP%buEv_7`B5+4cXxa(R zh!M_5z&`9KWB!VD!$vVa5~7jX{JWRc4+b(Hw}EUJYk~hmx5B_d8@U8`ZJ!C_dM+)I_2?P*@7mWUb;4^JQwm)r&*f2j6GX?v8 ztQxqizwdn>2Iwq^nB+~0H#>dT#arSvl7_9fZ+;R#oyw*Sw`>)woe7U(Hx@AxJ2xr_ z%Uxby9#~r>p2~5Xf4qNUqvPA^+WjPM540pLq=g(UB=?H)Q+pOFI}u!n{z)lpdwaO6E~<#d4ObYsad>YYtIz)d|9P?yn1-M_;+A*`iX=}!Bn`w) z)e7;z%VY)Dzj9cAU`?&NoLO+FHDOf2C_PTE=sqqFX+M|H1Wyas$VfTCZBM*$G!K1X zRi-U>oeGu0qEoCO9<9BXhUy@6>AtD46d3PZi>`{WBH69S6xE{Cm=a4l zTFnRQhNxu^S4r_dmb0fw7pO?GBP|6iLV2xSE#bJl?dbN|KBq3##oos zJ{;qdpzi!ICqQFirqSKmd(r!+5iq8ay}2%=1rAZTChluJ3>=-OG~XnD05ZpPnysxV zZe?d3%((vI9XOCtWFb#S$34<^K4Rj^p~A!0(A@;&t*R5%?Njl!QGejNG&)migVA;r zQYDE=V0{g$*Au_XCa+#R+JIllk3E&p!tD_!NmJz)t&9ymix`#6YYnztnQ!sjiAv0> zwI=S`@pooM7p`fCx^8sa_7r_l#+BpR9mQ7a^Lo*q4j51ATTzQ+%dh`=svD~?Vpg5N z=uX>X)H=O0`x)lMCg4uli{Pn_vk~}ko@zy{ENV0G5qKpcby?es%Ul9`UO_;^V*pm! zNSu$@@HJdjXP}`L!|>HQ~#Px0`x}4HLOji+?7rjRYG{j|Ij@!N)z2h6C&V_hkF9!mKYyB+ zz64QASPMXwGEx7MuH$b0Lu|3pA3^00V6Oa}xjbbLvz0ClEZ^=dkS)eW{?G_|D?2}X z>xtY!!dJ2BXNU|y;dlUO=WXSfLhWp(bSF-o8-~h3i}i$|l3(*@AlHKPpNHKUL0sEs7ZR?Nu%h1rjMFXDF0$|hLAl_ zNSqx+?T`z*vS+5c5o)P?Iv;C&`L4hm$&RoJIEb?iaIyd%Dw97wHe<(b-vbejIc;WOn68?a?cQXgxppPmD_bO@ZRv&RzyTR}YShquP7ITxXwCL#q?=U}O zkJf9X37d=&-&0(TPC@zKwwZsy`D4Y*;G8&!sKD5EQK-v`-ojpjvgTP(+d#zbO9M%_ z)=|A{{E-+zUH>(Mg;Dzlz|&)j%=5IwVJW3>E3Zm|2|*@3eiwem802<5SNmnP+n$uz zB6y+tW5kPRM5bZW;o?@N7z09`p6OQL+nrfS%k%LEbXCrbItx;k#f2*@24MUARmX7Y z<$;Ji<_RMx1T~r@HF4);8af?0ZO2D!H1UtglSu#Us4*l8tTc9UXp(4S+XYDT)q}p` zWyMMJQ__V8pO93y@ce6$3f(e_(s~a#7)lQYs67JceLRg0p_#W#K$=QJ!F)@WnlCeR z0VK7kd}V}Pj~LuE#AY?hXg?Hm6!P8c7Wu2t+1A2C{{|B$HBv)T&w(>`Ip1p2N5sYW zZCjTUa&{+J<==Ce0KwEVyG{y2kt|V}I5^J1u`lqg=N}shUn>()`YDuouFLheo8NMEz=3Rz&0_ym1|w%UVc-wn$lynPa~N6a z>QM<|qU-)?(y6l#{SyG$rxKP{)yol0FIkO$Gw(p$*KVM6tYwt0F*+$sxYQhFg$U8{ z&qO9Te@RiZ^2TghtOUyV2diLpJ^0juVVZ}-G+ORf|MoNbfn7p$j z4p5J;u1RgS-{VPXv%``|G|3^J_0GxfYzqZ%Z0>@M6 zX~pZQ?TmInxnH;>7*tzUsTHI554Y!%Mf@SP`TPpzPjns2A0X;oU=!UC1~+Epvb`_W zntL8~+q>)r6^yYp3!-#UMj+nSJDbE^cSh$cLhkUZ>4S{aOBTJ5Q zFmG~7@u{P!aEFk=UW8E5n_3OZmtH0T^=suAwg$5{Iw*nKa&qBIw!c0kQN7nj^{EG| zS+PET?jins&!_|}Q%y!c7w^;M>xL2&dhTA2Cy2nhUx>oK7G6O7)m~V7R_sg^adbEr ziqc`+DwCk)LMJ0<-X-wiAT5iig-kD+6c9O~?^;7pCf+Q|dYgKfdB~cphv=QAHraq( zWpZ#@k<%Cog%WK#^x2+CAoR6ykwE0r59Rt~7H-8T?tf@7IH_%6U>45aY#vLKCx{<3n?(IPnWV0Px&yVxxPlEMJK| z0!X2IV@DL7c?4*V6n$dUG$64vCO+C}OE-TOy*LqE8WKY4IdI*fn!&}M>oSm`os^{1 zi$&9!znFKPD2z=aLlwWn0q5QlI7WBYGl<`fxY20R!ko6FE#PF{kx0(_6(mtN?wZCvh$dgP@hF5WAA}G$Ln%irYkPlC`2#Inq29$Wk zI^qW1Pw3)H><^vHU6+`}w8%RSVun_lzqsF*J+0sVX*{RT)ug7l!S;FDRFe1e|K!c} zf9jxOoWl~YfTnP&XTI%V=F?1C^`6(r8=BhJrt8%0#)S zkuk@~Fcof95O8>@ej*l^ECpt;B_<+)+u*n&x49>xAwsp!^F=x(ED3y)YmwhVNmD-~ z88%0kg7WQgB-(1i%xn0fElX5vB4Sx4%o)yWM6oDIUXV@bZMq?D#S|832@7BcU7*n1 z{NzBY8fJgHor}qe5eXmahq~^LZH5UVYv@M!l|-%y;~< zgFMmr)4dAxc8LnAy}$5?9Z8YuYn&G%**GmlQWyxu10KRR`w!9T10cCTXS znP2;{u93Cf$Izk@0?^H^9lG=#dI2c&wAami)TjrQcsJkey8+0CAf3^!KexwQl}j2B z_0*ZwJ+BX$H(x`MEd!Wd&NwbK&<5#Ffj^f% z3L&SU`AP19udKSPN8SBY^_z`Tp5sbgXJ0SBD^A`|O*pkfXu?blYNhrSGxT`$JGdXW zpGH@LNY;~j%{<4V#+y^l7*C6fKJrWTW3W^t`5~|aHnPdT!7uM?se3dm?vaT4Vk&S{ zLn%kchHrAlCpHjEUi9}H(;H=(Bj;)_&JVlRPwWf1x4zcX6@aM}yo?>yTyE~jtWseC zcANBJh$WlATMOU7GSyqoYeR|!RWSY!id%ew{Nl}*c$Jq0psy*RrCcpr3FbX_>3zv0 zAwy+e@Ywa$|1?QaCOKo)@%k`(X5QtHYpif=j!Zp#tzPt}scPn&(X_zXPX7ff<2X*# z?Pj+g&vhUDDGJ-Qht2$V*Ua1MRUWX?M??L(c{5&rzP?4aIRu4Vr?i6oV_t#d%Of`1T2mGkqZK0xM(tdJzvm(xLiAux(k-ro==zHKgvJh3!r{c&HIn*pJS%rpk>PhySp&y%|4 zO7>gCIKcBX%Cia-hN3@H*8};7(|Jzqgio8$2uRto4x8v?QTalsO#t0ji=rz_owo`( zaj8eB9~nkItDop~P{U5Bl^VbfRo@TkmDn%{v0H;`D)q+0PSbsJ`Nw|GXz~6^QqJy8 z(yk6xc2a~6^an@@I(Ex7mW4KM%~;j?eSHZ~g}Oz#g<}~H=TRlQhYc72#zYOJ2j8{q z_Z*HjzKKp98OMff^Xsm3Jqp!6@~s`{q|6lw#A-O3HK#~_07jnBafy$VF zr)HWK-A4c?j8?McosKEVi&?`k^YMvWh_y})b$~icrC%9Be@8H!^alF(0OXpcv#u{n zqvx<`fUd3gnE%YR@>=Ws`q}Qo{s-AauvlT?(e%>vnyv4Z5^STeNH&zMelX4cyrtl*-r(3_iN^1Q5Os zWg}{lLL}o{MFJc$=*8~m-rsCP0^nz|UxvBg1maejh;pefbV&4_c zT&1^@ANd|{7nm+?thMbWP6;*a0>3^AT>3K8+TXR^BS^$x+J20}tZgr?seS$q|M&3H zj2fr2w%feBBIl*uN~8hUl_@NBGp80|d_v{eRBrDVJwOEn332VS_7Y#|mA7JUz$)K8c_)Gmxzx(<#cS z=Dn>Hx}Di++b}3bL0CSTaZj#*0;0t*z42GCa;eU42k7ao7X=}WlJ-u}1o)0gVH+c< z8yKTr)pQ3{BwtWIC=xhsWc;DNHwfz|u+-R&;n9xr$&OOEsE}E$5{I7GgUUFSh)F9` z-h3@-gu3^yI9KMYf=QZr-(!B)+A+AIFs8RTy>w#?)BApumUnzHh6y9zNnOQ`-ZMYQ z%x;WBD%(Ds6ovearBo_Xw!;NO!dN;p(B+Xr7V7h+6-o1$d2?+;jIkWcVbTbMSrCgG zw!Iq4B_W&;Mrp`t1|JMXYj^q^dNam{(EfwEa3C%M&>3a{1xYPoM!+CzxG~|5y~{2O z4Bm|8op$R)s?IL^Ri)t?k-|Y@n*J-MtHqS_UatYp0tByGoV{u}E-@^RdOfLVDXOVA z2-h=ZD z7a)Hza|^53w-89Er0_m>I~44_uH1Z@h#0D*L#t*%NW!Bl3Qy1ebEQJwtas*MPR*QR z5@rzr>{&}13Q2^6jL*M%4dsN@*6VTrg{uxBCCI)~>j6ImMTN&nggp3ErE=`@txls@ zqwnKTrKbQ+{3yw*o<5kwJR`q13tqIzh|w?@VRl1Dr`t0n4V7V6xtJ%xA)6mOJMckg zoT%N2zs@_Nu7jeQgj^_Azo*8ynzjb36QyFGy^4N6yyeHNI#_0aqoqHUd4K4Kx9mS3 z|8eKIFX>44{kI%^636`byGUy{fEPzf;N3)ox#7Xo}~IKmy@HPZaEG?KJ44S=JD zb^+}B)i_KIf=Z_J$qH?gpfyt0`p6+c=K^T=I9an?JbI)4(nFkt#KibaFtG@PM^Wqu z^Q-{!A8(t3YgP7rQYJR@BxLMX4tu^FTHrUd?yFXTeLwPe)HzhLDvH)b9tE9fcnGTr z5^OJ;nhryy?O`S0$6THm=`WWM7-G9EZ^e+8fDS~St6 zj%>idL!Rqx492BpLGR~5m`}oaC&M27@>h+jIi8g*s53y*zeP5j{8SJcfhdWFQ{w-k zzmmG#FhyWFMqpv1u)J8Hi0FA1B}$SgNz#>dVOVb6o>t~Lb4}R1G)!of=7U*ZCo679 zf9HWNLn&sVuDw+gcHrQ(-E!Cjc<6CbVwP)U=^T*Ou>@oN-I<(ZG?lFC<_I{t0<1#P zzXgO*OarkyRV*u%H|(AE*hb2p7M}6j?KIEZmr_Wl1;XcUH_^4hQEO6Hfvk?ecv2UK zeE5gM%3?k_?LJ)Ykhxxr4Ls`%4xY@U@_c1adZLtIGn`DgI-UE8I+%t*2;Z^1G-vj- z5Nu%6dvkW`p^@q)kZ;F+4_CaEi`6j!SMa_l!V!#QQaaMv?X$YJD1QcF_OY1s;SmT# z(ZensDYhq}#iP9KSBn*x|De!|w_7m5JW>fGVLm)Xy6EUG+EZWYYe zjmESAa#b#A+Wn;n5wA5XfR_o9$kYx1ZIii`*i&)S)pq`%uWEblgP!CpkWWPKwQj?S z4j}pDFHzP@Y=pA4C&T`@4s@Z^o0IQ<;3GZzuNaJ$EVJM-N9O8Uhz(r$mA(+6lGvYT zX~`ziOXuRqyY1rsWC&~-x#eMdMx0QuWFhE8(4b(JXtwAc%M2~>8Ym4Djt_M2@-vGt zvQQ0f=t{|ttoWQW0m|LQOsc#zGznDMZ~7Ui*G`!8BmH9l#gDU)RIFH!Aa_WPrmW3N z1}djJXf}$`ptw6~j_}DBodN4Uf@GZyc)C}86^0eu8%&G%P>J#ZUT5&ayx9L(DSEnU zMg|Q(EFtQVTHsavk<|NA?Wxo-F*WoF;>FZ4^shl0<_TQtv%xj_uFwo7I2&6TK~_vA zGc$8-2!!(oLuuPr60*N-61k5jrmL?VBam<^m!OD<^whVzD&WU(%^}<^*)W+Fv~2D1 zsa8U{i351tma6@EWox_EP`s1_3&Il%{lrn_HlBxoQlk&&%azSadr#4Y=!w;uqmtgO zNz6_~f3o=b-^0L}81Ec)p%Dn{jvU-T0{Fw_))*#qZ!o{Twnyr;c8_B~>k*LN*>Uc@ zBZ=WwxJ6*_PPoM?ao?`_>=}XVKV@)?uf;?fq?cE1CWX6)2M1 z>k}PAJH8LPIp{qx|7U;l-$4#JSlIr5?&1L zV;8_^AWh_m0MZ5|);`|treOH|aHG+Ne-aWR27%J9bFOQ9u5oL8H0x1=eXWeyKT9kB zsejqEczngw{;w^+eWNB#o8i~GRoO8`x0X3#u%jC4OdB+c@nMtwm!jdt(&k^m;Eb$g zal^i$v(}Ht%Sy6Qgqc1+B&~|nYsZ@%S89wJ>DK_A^AChU+w^!%SE-auMRQeu_ILeh zXyvt2+t{ly7KZ6t@%H~h>pYxaOPKz z)pb77F9Hw-6&a_+DIZl9g%EZL;*NJSy44%6aAG8a68D; z9?y+yy>Khcu1#x~kye=*8|I2SleD+))k3dv;<{I)ISa^1uoU#LBG2d-t&%bzW-*5# zu0{ARU=DGy1R%`*I$oS%Vd2bL7IMvCkdfal0Q_zl1ZU0?-~rCM0BFoMkMdsihn1># z^pJ*2df7dSV=d#9?~>s6rJx`7G*abcco!~fgPcVL@~n>aldn(AWqgCMD|0U zKWJ~>1zZ5;K9KO&X_r4UfQ5C1szj^Ih_kjKJ~j=vn{YZ3g3x8AdX=HZ;6k8AhOp%y z5NCkv(AE`pfrnR$nzYV5YFb0$#y;m5TQL2mHp3{G_ovOW=|{p8Y>t($z7Cd(N%qVV z4CTs$_G}wd%9gUoB4)ao-dzvC1hZ1J!V4KNRVSCsgM-VMoTk=GlbRF$e;^gUbBy9u z3!n&#o~DOvooaq$roH3pJ$em(a5T7ac5&bw>b!SelUO2Z60~!M{XHN~y`S4?6$}X% zjaXUxGcBNlU&}Ai!=_@0#wrg-Aq7%?6Vvl>WB<|wBDN4qN1c10MLt~gUsj;{whhYZ zJC+S(dW6HksFjC&5nhRkCU*mb#D$jdYr}E`nC8g#;_S`rUY7ccq6H2X1?;VSjmTqF zA0x3APQjGDyQ*aaRe%MPE$oj4odgV>Az@LmPT${2ne;Q>M;UKIDv^6os$_?=7*cWa zQJAAy&!qu4@R~#479}m%vZPbnC}ySzL$a|Yag?c9#fW<9pT3k{4`jM)o!V^9 z=J0@-fJE9vDQO_`vg!s(ry%`3DLSRKYS+|^{}XZF?-?nf$If8L+utfjN)zyCw4Qa4 zOJS#Dbq~hZS1=Jq*e#ma?grAv=alpL6~3{!t5gBybAJFGv&p=~Mv;L${6-C05!^t@ ziMvKDL4Pu;vpfZrpQ^?NEliV~Au)N-WpqG*jvc!zm`GERVCB&18i75K_u#&{>WkfC zxUR)iF3Cm($38zVk?A`D*kXy%5)@s!y3*JCjX_WT(gPI2*N7^sf9^2&)@Je9KZD5b zWmI;RZyB&0e1{63k+is@=hMY)IhJ3AJbn~qlisRcl`teBu*NhHVYp-~gjm)c!U*sn z*1o{p+ZL$4LGWRN)DH4$&tz^Pr=LNBxkM-1RNp1!@2>b13uu#>WM?URH6+f3A1Usr zLVLJmKV|F8n=joe9+SAzgft1GBy&dl$rn@gdJz6oZD39&n8m_4iJUdoN zqLX|LMNjDcaj4&>>u%NY`bJgXMLJVB7<$?Qsst?&XKHHQ{#3J@OySf1aTXvKP*8B& z*!+5EQPrhWO`0#@wAvif?f%-O-EREw_M~5_a$9*6bA6d`X(Oyq&C=4+L##Pb4Wwolxt4$wMq(BPo z0;R4Xh(Kh~AebaTz1qR30H+00mpOE*%7&8fk8Eio48!!-#RbWT2uoGVEfBbf@{2ko zWC3I6{?LF4&Uw+mdU&ai^&KaX&KA5fcr7D6K}Q!RB&euxmSh=4fe~fC55Zn)(-s~T z@f;x?%7|XsYEOM_sI?`?#vyS&R5GWy!-|WkXfW(Dr5h^seO>uw0NYfLCEIs|h4$u3 zXuIX|Uqi&9tpj}?=3RsIat1Y|6M@N6noi*19u}nAf-^@#dKfOMFYKkeR?94r&Fg;_ zU}DL02szD9eVLS-C!1v%gp=8*svX%I*0)F}-W!}${`^XH`2N~GPa6amR5+w^cYBw9 zdch#bKa(Z)q(H+3Qr13}+IL{=U9KL&ppO?!FlsKeEWOH?I_O)@o zK-iBodx#H%5fMlX!_g!}F>MWcQN4?Znl-KXL&}zOGWYverOw{WA#)u!e$LOorx9j* z1qZdcI?S_}idqmWy!F?H?Y8g3)Q7F=O?UVE^jjzZ83@b(J~4Y+`fCRXXop&65B%S> z_FvkHg6V+|W$QMVYv|36^Od*iRYRrj5N0oOdEj?#b$%~#XjKD*(y(+nAFQ)$SyZsS z&g0C7W<%zcjR_mez=6#=hp1r@@(JjbC{^e7yu#xlU#0uqp)a-`CBw{v|Z zAB$yWXH_bc@HqY&&0v9*+6hE~{AyNT^i3J86awk`;_jsOm96MQdXUd5x!qKPGzt&K zTCP7NqWmJ$Lux_^*tov;hQ%mNcmzh9jknblC_zZ;Y`6yK164r&71EUH4X^I`3cdgG zSL?%~waO5}4L?yIo&JWct8~v4C!o-rWB`nE96^T)SO>b)3Au~S>a2Qx>fzSTeH%NmFPZ%mefwOKCO<@ zlG-bz-oES24JLl*3pqr3TL21 z02+B}P>lz}rH&2vJQ|ibJBOS~iugQAQd56;;8K;O*k+MNqEXQx{F}LV9asiujDR$T z@buAAX07oRKR7F$g$Fq}g2LV8UHkbiCE@&CN z%;?Clb!mvKhR07(S{s}1Zf4C^&#En^6-1{#?C(=t4KYe1h5l_Gv+_7R%D;1c&jvwX z##9j8s3?RqmQn}?c!T~k9)_RDe`6QZLX-D<7kBsN_>5m*dszx@#VSLy0LcgcW^&X>fl;BCd(^$PnmkUjwS@gzN>1SRX7@k~qU47N&c+^5L zoewUQwPzFkFy4ndDhS~$Daj&>>X|FdL9S}ZM3{0=h;h%igHV)vWhXi?3P^I#NC;3m za45{TqSrdkGt9Ysps`cr{FA#>C(qH(2jDGII!PqBR9I0K$B?!*Y|nR;s1D#~P)OGr z0?48~K2Aa1<)*^N3ZTFyNKG~Z1A{CYqP#ypNE2i=@l}Tu^=N!EJUJ(`M{!UX@6D1u z`PF&d9V&s|kRaa_ayI)O6xk!>ou&ww!Riy{Y1LgZ(ZvGt(sVK^ReB6a%f z50xZLInY2U7Po`2ad2Kh9Ko{CQvqu9-EE3$B zusuRX8;Xh^naVoV17Q(NZZiwUfRGEza9X^5H{Q8CqFN6nkv6-%JnqKAug^s9M$>s8=AV1zL4x$~BT}84v{H^UzKH z-WRz*lueA?6>!PqfMLBW3r%fPU`F;Tsb4&zSC}F<7A5@ahHu4Tm}7 zJsiBr@oPgLB+KE;ag;l*N(>w_4S`i3lDvbUBWZn}L$=5-r0em=u@^5qK(gK{VHV0u z)d^52TUqk9?x zzH9sqpQ$}BZ%o4J(dq#F()*ElL_v*6;3;NYZ{|n-B~j2!$$wp5Vy}n`^7( zwU%i+Qzg8rt?%s>>cSiYEG8qX5o1D9BJPAUu5Isg;aN`_O(7^fz}V4HTA=d!M;*0S z$z}mkr52w{jk_r}BmgPv^t7xI77xka%)}V#j#xX!-_Ji0^0>nHI@IH)Rywl{Uf-Xv zq(tiZE=)_RdwZH$v5!U#E?jzBfqR-62vmsE;7f{|-Z)yV+KmU-j)ZmtyY84lD6%pW zT7uYPOoX*RG2#sLivex9r728sF)JRRM6h5;4eJ$t>YYG<%45C}O(2HtM!{Xym|PZ0 zFr*2RfdJeQ4upKAkFIpd; zJ^YrK2Oa5SlZ=X>yO##oR76nK8)`|@z<&hT|HUn)I3NtfqfuAu%56wju`%sAbHm=t z@$ogqD7WYD=+J#P@k{ZqdIfy3O?l9h%jknAX$5skDNW_%}Y;09`q#vKERXbmz z9`mSVHxV&yRaX|ReK6(A_JNHsZ{*ensaq3m252{p%}k>fFeKK#rz_%6W5KgOQ8J4# z8>p4`J!f@bn?;depcB7ZrC91IX$Ki<=!6+6^?w3lTbl)RcEZI*EF8GjH>L8`$JG^% z45Zk)nA|BSg@MVD`yrus`q zXm+>5-7_uw&(IM6fgvXvfh1^V!6ceQxx?9gx&{a)fzoRXT?V!Ey@$Mht$Uc`^){1w zkXt*>*Q0$2G!-4EXVH<4ix^4L0f~W;5k22!1ZDf#wwWNRlR%itF$^rX{Zj>hfQk76 z#8iBD7ldu(gq8L=HU|7)G!_}n5hrj#%k$$E@#@9Bo`&Jhhg@x(e(y3KSt|v;nKKml zb}pN&FPs~#OzP>W+cECrZ1&#O;f$`sk>TSzX(AgF#Lpi6rc-2e9|gxCu3oJ&#-lkW!*a1{UPu8P*-IKBMZgg`F#CBMbFM9s(vciO4HDd-0WiAD+c) ziw{hy`I#Kd+9_ia6MJhbYD`O9c1mdQAMK}iR{1Sgtd47uX}Bd|w%_0IKY-DyA^&GH z#`<3Yf*Dy@{xcNt7p#BK`ajLso@_PDAoraJano1h7W(eG&`S+=Be}~r zg9G6E0oMS5F~wgpjyzWy7eslaDa`2!rWv`&TIlZ4Jv?0uz@LX9kDk|sqy3H-gFZ)< zV-j609lBO+yD>>)^wdn*wM=Vg46PO|2@0lZT^d!%^2?E8diAE^o|Xwg)1~N(R9)Ji zPPtA!4J?EJK3ccET%VVmgA9%^e#lC8%VJ5BwtGho(=14nluE(K%MTNZ2N)1GXGh@v z=yA$Ul(mu2FNOO{sB5?7>r?%$S?5(wtk0t@z90Vu-p?zVuXiymc;*n(mcKOe2YKsO z4{ruTu&1P5GN~Kv5;A0veNYnvxbjGn`R+qbISG>*sK1}$g%lM%6`G|cm`?`|ea-}o17zwLx8^8?WEusTO%=uH=zg42rBhi+llkd zR=*%?tylxgRbrvz+79flh6;FQ!?YwYVHRF3^K7|wPqu09fv|^+J*%ci+qLctRYzC6hr>H0#s^83l3GOa` zHkChbixC=S$WTFT<(Bz8`3wtlIj%oQPz!{x`5K>SAn)eO0PCq$25cm(M&sT$7s=VJr zDM?yJxIm!iPf8&hveRK|H_N!tI zCGQYy>$+ZF*bA23Zh@fOq7~wm8r+j5Zr6E99V$x8lJNipWuxjN%(i?Sj?=Hj*xloJ z9{Q2a`3(X~yj`hbn(Bl94&Z)8+cmrfFdnqoZjwx@FtPl@tTjYFl%YwHTYe#$^{dk* zind*QMc5IDq1zfkyv@Db=Iz#KaClzOSOYNJ5b;2WSvcF$*_eqIf!vRFc%<3`!LfI6 z;h?p6nLpf4Ew3lT@Ri=)6^u>Q0T7Ty- z+Z}Na5twCGo^Bup`5LjYE|Ia3xe8NSaJVSUwTmREh6*zc{*LQ_*@yu%(R+ro&cMeK zaFYdV{K`O3%COd{M#MuPL_A9aP%Bk`#$HZsm%_epPjMr)T9MN`3Jnkzt*2ku{D#TC z-xy~EY)RcdqhoaDZo3sxX*Oc`)XPPNnI}l-MmoT9iaSdDjnYgjz1NJy8vM zJR3817VtbYj1*y&6BLj9rN$`IDTPX-IO<&&={y&8yPSn}S&1C?OP5uRPOy47oZtO2 zw22LY+s7DK&+&P~wn64l#%EE?gK9p@eG)BKqhlaAt4B;UVxvJ;+Ijt0c=DS0G8XvC zz|a5c@7S(?b;C0Gl-1h~#apTzTIc|++q1^&tNk<;thm#p4+r2-LnhbJ9a| z1C^68p-EHONJVe;vWg;P12ym4!+jD^ibA*|8tf^(NZZ?KJS1t*APwYzeGN9IJYjl> z?;yw=+k!wkAb>0hgvQuUjt_Hl&dq3fHo*K-?>)`izDjxh&ic(Lfg1ELE`b54CU(lB zpvMEmQv|mqvPQ%IP9=0ve)}LrjRAE66_}T$KgmErApCCF|C@ylnxE>FQwecS5Tk z;adxt8C9^^g*^dk2M~KZFUtmnqqqvx8zUCHPLs&vIUaDNtG%a(2|WJ#!Po_>x#mo< zd4K&{R54e5TEJyQM_FPNG=*W>tvPpL%LBrYAkZ3zP#qhM@Q?m!PtfKsHC6iLz3ZV{@o&U4oCJK zP}R_*FH?!mWl-cI5*nl0j|u^Ai;*hwAA*uX=6V&J^~(WNwD3z^n=2YDUdbe>QH~)# zQ)6*$78leW>ngG-?rM~tZceuv8b@Uc%vO1_&|`wNqPu!}&4< zV)-!|;kA)?Zj)~yIyCLY3P8x}P;&CD{z}PK8`iMY3!j2%BRFEA^C&&dj})G&Zrh&p zL;BRnVLj%+M7Ku;Coyr1PKfQQ{l_&wI>LHBy?I1tZS;Nh?En{@FGYI#&-4?M z!#Byr*3o|H&KG$80awlcCFisLS6pmH4wnC*vv&QDod3TSq`noO65ulTUA9ytP}|1l zmd*{@icLhp>2sg~RefD^a^m6C(T;0Kk=aD0jX^U z_FF(&w7fo>+)ce$2{;-!{zYeVg|)jim%gvZ;_ zrRF$Muh;!Z#N+*3$n{daae2a>5qWl8;(hJ7Igcb^T05_!dO?>m&BlJpyrGau8Q5fh z`j=}=LCv7l+P0m1RZ))HUa_sK6QUcQ-}`1D!6Kj4u`;ovFPfHT^G+dJd5~a6)X(TL zWSUfLB_KM`;Gw%8?zgiqZ_?3DF@W#D9+oVePA~e=*wGcoT-jo6!7Cs^tM1mafs&n@ zFAh(QQ6CY~5{Vjf@ttI?xn(nP2$Di>F(6yvZJ{(v&(w8>Yu9P;)YeKzc4({+;>u?n zoB3}eDH`2Fo8_otgEu#1P<8d#nvxTPkR~>u8v{Fqa3(yD=+Pz% zw`}yei7zGBVZ0CaR?-CH^!6HM+N_4Z^gKO0(K287n0w!Naoe z0{8>rTo61{va3H}G1g6F66Vs(M`2{1rsTJaH&@94Yp&X4z^A{>|;?iA~ zZjop*{<(BT<0W0lOrAH{ak#AuI5X7^5V(EW!V9F?;QR8l@A$wWj=MJPNU;}1a0GOU z-XJ9RQJm&^i1WIr2AhPve@grJ8N>}6Imj5;2Jii6plk3iwu`#{$cZ4I5z;*3E8cEO z{iXKDo_ul_QVTL`iUlqm4pyUtU^6+4J_!I=-FOzjXM`__KEQI@T#?8#(~DM_iees+ zP-y~(G#D}hCk~L}nr%G;`2IFBh*v>G9LZp+jS{XahkwE5+c+rE(D#E*MRvr5X!SBF z180-tDZ{n*7uoP+03p=_6)IemcGeXDuJld zGt@9I7B4;j1M9zg>oxW_zcI4nZLQ40@8n5RsL~<02okb5L#6`YAxU{7JdUUd=fN`# zI6e^zYq4fgb#A)&khJ5zz*7e^B`yat$AUcnHR-1q9r%=<0h|TGhdi>=e;l=a)bum( zEdeuSi=!oo?RjXri)uC>KX1ZfsmZ%~cw`swNOb=TGTsp+npeImzkW2}hzat(Gz7%J z(1S;0G)5jk=!sQ>YiGIuNYs!4a492veoOh|3CTY+PY96L_}k)4B`Xdq2_UgvKSxRi zMA@upM&86*a9CJMzGn*ez-f!Y_g7`PvFBayRpyMGKpvm2;)pk5hM$cP*CIm4!G?@% zC|d!K?IUp;^Kk!Y+*Gkf0#1@JsE+==SC;H$o5UXg^5a{~9;k%EjWkW0`OLmOoyCn) z-aD%>8<2kF;ubX^9bR7HQ1jIi$byama!`$(5>mXn*|VMq#6df-Us9GqYE?6QBe;cA z!9^(P6uvDISFkGsN?)vnVE5v8a_~qhpx78_emJSO!luzFC)mOppj5*O92s3VM8O=D zer^=RJi(ph=nDIwO#jMbJVCTv&51~trRVq;rHK=o6uI5W9YX8ti1M7J-U{ZX_pZR} z-FMX8xg+>Kc=>A_SMESEWZ`~CXQXvqSfb49I?wmLQu7G1*Qz`6_t>qsjeiA$yE)anfhvsZhD9q)fjyLslntCDpn zXHtR#Y=q2~)+6|yX6U`wf|0t)Z9Wp3L(ztGf>tQ2B)hMI4Fm;>2gc_H=;g)rxV^0@ zciqeH*;}C9#?VL4se*E1|Dk?7+5B3~6dbdG--1vSDg{{a&8G*Ztt?BQ5TQ9J%yS6>p|HtbedgG%PDt007cN;eMD`ev!`NI{6EwIbZK89hp@|<4$KgQl+ zOO!x~wk_MXZQI5!+qP}nwr$(CZQHx-s=M#)ym!Vpjnl|q$cT(wYfe5ZMEOFRELW-*x&vr#3ILYy^5`6Zn-jDQ zGSx{zP5sSMP_Qei0n^u53fyN5dv&vnk9wWYsrj~h^xU?giC*t*K3edL`afV0miiG* z%$!eZHsN|vH@^*b3wcRgqUM}0XypRvF>+H)SRGiZ~wr78WJz?Z#YX=DO zueWCqFcZ*SuYy5#5i&n_p^&*Gig;r`INMYcw)1k*8_ZxRm;@K9Kj*sdEZ>8O04=1F_%3X zI@QW5fTd9f+i}l*``r4A;JskDFT z?3Uj`sy&aW{$;<(S$}%?4#Thez5hA=(D_Kp#);}_$n&dSjTMc$=DH5W*U2s6o4Mch zZGucbZ@$0?l!eBEC#143&8e$dLshjo;ld1mNHA9uB+wfPzuqdN$jDB;rg}I)qy+1= zoAq@q1lRg|A%UrjDL$!k!Dr!!-{zlp&$i~tZWGB;ZH`S4)w3jI{*pm6Z zf)oRq&K!!Wlx6ou8Se3{+ZH?0bmhM8t2G)KQ3q*%Wjqh%yOLTnUQ@Qm;Hh`>v1%bD z=UuNg&)ZQkiPAMX6IedK6k3)?MwrzYoRvg(rdWUQPpl;G0>5vcM+SkVo`+z47zMn~ z$9ZL<@or-_r<}vvX;?XmecOmrAH@|S`E2Zhemjh7KrhwlttWH=!V=_5YhlTrtC08p2NuD5J167W0>~W&J1pWV zYh>^DFMm;*tkZv8=>Ip}0z1opoP=-G_nflC5Pa|S2Hpw;nGYQKJA{24kvd$+j#^t2 zFaBhM(-=gF0inttP9MkJ;ekUe3k$_2bvs`-fbhBYeY(DGon-sr9O}Oj#{OUJ_{O9M zpG$6zLYO|vzCXv3Rv1MX1B(60pR>Dd^eB5Bk&SVq=#JoMalC&oXCsjk?AfP1c;bVu z1D)i!T{%6@Y=~oKNZF^M!10IMCgwsLL;C_=_h+g&a0x`++MY-vd!i1n&grH5cF$Qm z;-Oe^5}xr%aI}>~IQLkJvXoaDrnp+h14))PjU&E6zKYdRHX|fR{Q(+x^tx4I_?Ilx zkYN3~9(+K(E`ZwEpu4|jbb6*BODB`>+VSx=q0r-Wn z(8aMh!IP9Io>)-BXyFGY5fIAX9&m;bA%o8d6{hkC8!83X6m!dG(ah;WmxMIqAs74& zkT1yF-+b$q3g8gAxIr!-*eVD?l!gRyZ%g+qulKW+aD!K|uql}|O^)EtTWb^s01oOy z77x7)Q#L@xNGEJ;X?Fd78nl~{UU+IN-3OwmBc7@&Wrt`DbJo?IhE1hjUp)ATs_(oY$qRLrjW9Gwm491eG zS@CR8-eNalN;+;1U$YZq?uovMH8U3Q8CTfyh^DO-FmW7bZ#X(DF;59n;JdNvI44hS5*h z_wWyw*5D?MNb!pQExRkpXLD$z4#m2W>N5BrOHuDgtLeSH)6< zP=%_T+#JIlS}eR}!H+~TRKSZGnG+7`tr!iS*d)>95mDkb+%6#^Dz}w(BN&nT13#Rd zA&Pbt_Rb<(%_z9^hqijKtPiw-^@KryhZNW1zb46ZjqS>hVt4L+yDc9`Pe$j`%Xbsz zhy+xYVrdqf$TNdPi~k%@1~wampoht@v>2-*PfJ8IH6?)0k}9x7kZLcP{pAO=vo+t~ zo_Q$3n#GDOd?}(+6+T7DM1O+7lW789ktVhuw|HqTi7dqih}Dh)9|oT!vGyA`+Ro16 zhzTbxj?ro1mw6y7&rTO;XvNXyqfHgsqC!{BY&wHKf`q=4<33AA03a#BDbOecxw}p9 zUfjsA`kl$+?EHCEAoRXV|NT0gbNOt`P$H=D){10va(3UU9$l{FUHc;AU1>vo4wYsu zPKDXW11nxN?Je5N5%7Q+6~w<(8H-Y4&DZ$GuPZuSvF9YwWuU=}PNO>eXWQhomcQo) zk{A0^(HqYAodOq=ZaJu636j1O7%-K;Djh|Pk%!G6HclRXpg9>OnreHC);a;SS`qp# zgXeK|E18vo-$(kH-pQU-xG7=l8ebgJ(&OI`YOGEtWHurpzY;ODc4oZMqW-!wVwShlOchXEF#qWu;tnsaKF2~aZ{K~UG3s$mu7$dwPi07y zb=VE=3=cdL155@7e5QHUNa3AfUPuft#&Ye4POMP5V@H+#+cSJ@q#6A1?aPp>qno1z z=sUmx56sP6lWbv(;?cHnizSNZ9QE-oC$(o>H(NJ1ojh-PafM2z+a$Y=b#xj|VGFjN zhX^p*$-epIZ`;JlyYoY%P~|6Tb1FFD&4I$eRTqi)qk7Qst^0!-`+V{C^FTL`-?u&& zKF0mGGamG_!+W&?-o6vSs1=6SBDbPm^&tF7zX_b{b5D|*U2W;Evm+~S-&>2PIZU^j zRyWuvqI}`9rg0UH`ff* z&}vd2yT<{lg6{Cdj(hbPSkvpvHxv>d886Kof1<66>+YsIxdxfi*<9Was1#Vj=zpDy z|C5`7k)82B=HiID);|Y1itk<>LSxv3!0>}CB?efr4U@4=5}kvaU?TX4DN;@Av8Lk| zz~?@X24M_@80M@5OLwdU z7Gfw?qgjBJ+NYusEc7^D%+>{Nr+m-p8!t*-Ktg-RxCoF4k~ zw9iK)770s?cvJ-)xbjF$%Exv5vkEzhG~x-9lzXV+U`=h*TPMYsqz`*fC0US&Jl-7+ ze$OtWG~!)1*W2T3(oz~XdXQ@26A9FC2*3b}i3o>BP`ss7f^j~E!f9(jq)r)->J8*c zL?|()tRS1P2!hx7F^e(CKLZget!Nl6!6Jr-z+^hZ zS3Sj3rJLGDH8kY;URcM!FcS7J=_{}HTUvl;THn|47={K$9RYC$p(vq6$pcx;V^z?9 z((za~4BNYaMq&v=jFNNHZgk`3SVSw1X&u~z7fBKoTd^Z45zvZN z9?3{xy7i$ADtGev`DvmF5)y1^wU)UuPKcdWUV#aZzQn?Up*m_@q8<$PIcSs`dYZ*; zrw%$GcXYEEZ9LALzi0W<$`2uuVx?nI%`~}@Zsaa4C5byS#M%U_1o2`JMvGakssoC; zK|;Ym0_XH4`>{K}MI}mwDkfE#=G5lwJFE&xW6Y|eJReF#XpVT_f3s$`Kh7QJYNIZ@ z2JFWWykBXfwZT`RaLC_{4S|XP-=Q$5jw}_qi{HhHBVuZvv;<{7<-;)MB%vsr;_k;( zimq&cOrxf-$Og<4iAK2cXe`$=BHA-Iv}?~il$1&Hz0Ua7@Xew{H*X`TH792>#g!yQsSy6(io*ou0iL&k;4P$(-+)`0PjynQZL7-0+Y@ z99|b^x+&}gy5#TG*G6PA*jIQ+SWhTQa0T_FsDpzBD`@%edBc%nm)bi&q~Sqg#Rt48 zQ5C&oGzaMg8YmYCauEU)%Zmr^_L0$a1s87sJPLdI>0~|2gSB&?A=N>2pr~9LLD;Vq zM}?WMoi0jh#UBk#c}yfRIx`r=*929KNI3iM2>8nKSr2-`$L-O4y%Pxs#<{xE-Ggu3al2ewg~lv8>&aT^0l)gJd>y$3i7uxB)C{cLHSfHCo2dYS!bM1XZ$2 zow*4zno|aVr{%+qFDIrMREaCo*W_JUAj|^@h|(SehFRT}* zGIU!2-k>YLq~__duDAEY5_0xQk_vM}%z#0*WrX^EmpA%f`FnT#?k#`Mf?T5?507WE zl8%m_7dEzX@^Hi@EXyT67zvDxe$5|lulJpYP=btcOf)`BQX~C4SG6|{F)>Eo(onHnx<_cjxSCu#P?wT$OS+n<^ zh!|CqcWzh)1E0VqXvH~{zI$cGv%yGtPXOKDh;upF7~X+JtwDe@qD4m4vHA_jo!8zQ zJp#5Jcq7}U*`)7rVD|Tyo5+1V$D9Tf_kr;N+NFK@#!+_THDLz{M|iAnX#F#mNB{k~*hwnZvdd^vV?T1j0yKnp-7VSJamDRs+v76d)G4IPMbS5$U2R>#-QzmX}9I@w2?O#4XvA;a+dxuv54tY$h+rBYtXW(@I zK7iOkY*^x0q0d3||t5Pn@MlJg>c=75)3L@dF+n8%&_3ds+ zv694V`syTX3m-jDs<1s&@~??xP1nZ|cBD}$1L$o1Wv(WqGz{wPM&HTvhdd9vsEV#$ zn_Wb&&V`{UYxn5RksBrIiD}A>Yt_di9&CqRZMsyY&Q33ny%hGKikWJT8MxUeTD7hN zS>l%)&kTItmfOj`4oC4$S6E50Wb7{w8Y@^S_fEgWAlaOBhLCYC0TCm2G~r;qYjxNq zLRK7AA%T2NP2TG($5*f(5h)StP16jU)jWQNHS-gAHj{pKSK^3iBEsChM#fDM*<*6? z(+P^`jbD}x9=7KQEHTio*1({WWDhg45`%Dg$qkCzM8o!R7zRi?fVS)0%1i+T{x1@% z1|k`E(p{=PMTw;9*tId`LMm)%v}QRZ>&`R?8{pc6jPpIsfo2Q*EdWu&LOG$7GqpBv z^UICvPd=Zgy_i}wQh}*(kmLs6l`8Zo-|@`7{At!|h@YL4dS6hVT1(%SB_#F*ac*(a z)D(*d$w|-&?@=vds~x1hq>I1kEc;J!cx_B!u+~CPo8RuqXSX#|arg?EpQ{#pzTzmk z2~fYyVB&~-cnLsx@?Zc7*Yohhhf*l>Nic?0oqCc3lp{xLzHGU#8G3;)yfS0fd;QOA_gt)ZCjpigp3^J!v2uO z{P}jj5Ju_3_HN6b?(g?am0O)(51&!YeJQt9ZwR9gcDD+-kvGjX0h*hn0+3$X&&J*U z!QEf^!5E*H&svxMVmN(a_#gWG33^~nh8gbPuzsC-3%K*%2+E-HaFXD&xO!sU(2HmrVIq(> zsOFjb{IV83CuKNI685f6DC2U&$mzcN7&5{^ku)8~8tx6SYJ5x?io{B~5i|uv@#x#d z@lREN*x|h}>OT}j9()&d10<=)Cfp;BH?*Sz?w|cDB2bDV44e{z{s8N7_3n`dn?oWn z7f3E?sS}^<(o+MCtfd3+jOH+DpkV!O#1|=99zuaZ5^6c;Z%!v9o~>E(M_R=jbuQN0f$BLcA|OdndT@J0TNk+{&sM2;`7kb5V}fU6lN!*;P>p&2CdvLi{069 z2PJP5hQ?u2zorf;8@s#5F8AuDGV(t`2_)oPD01*BS}r5vAmT9{)yy(-rlZGH;m%~H zhXP1dZxZsbDuf{)VoG&!)>;)k!vprpuvy_VQM!KRsA(TU95JL7rocgJC~UMY5va7r ze9(4I_!lxi@wjd>^ToGrLV!VKWae+r_xscXjrXBC6u>P2y(wlblp%>JjLiN|*I1m^ zKKY_K*)P8sZ3WZQY+0T_rYt@h_J8_^#%~uQCeexmQJSXGmYs)KQ8^5K8X&=;nsFNW zE<0dM5O$-0x6KI<*d!(CCrAI%kR>LQ+vMrTlsqA$h1t@zu`j@>v2+!=s0dZYk91nx zysNWpsZLwKWmv_3Jj&IZ$hDN>c+ib}QB?G|dmKb|V5|T$h7q_IuOho3hvDL201omr zL>FAx6PD`dFP!pFalCEWgj&ZO)$~NTIP^uuS$a{2?DwxqFX*dSi9RTGxPCEc^jNB! z|F9zBJ*(&|qTtylrXkB9OzU~(OE{=WrOj{kDp)IO(|ZaP>ZAC)!-)G&^fVRnTEPA# z5Bma)w6ymNIs;mp)5!}5PFWAsl%_Fl7+R_U8tma>D|^odtaTrxUO(xF zRtPMk6zCs^6sc(kg-RYmDiUR^Y?4FPsRHPV(^AJ9I~m)2cMV--tye$C>ZZOln>z!K z4%Vu>Ue3Zgvt^WJO)OS~Nj!jsDYKTwc6Tm>^}}<`#+X>mU!`m6gzRbddNtl9(B`AO(&fO80e&CVd)S1Amk%tFl>1j0D}2U-s5aN^=mEO_ zBLMOm@pvGA(=%L0jV{blS!zD#&n}p+M@EIqw8KUHJzrz=a~!|6a_eRt8`7)txjqzu z&b4y7>1l6ec?Ai)FYhEg)9j6TsovWvQhYrU%QwX0|2qHMZRY`cvu7r^gCk&+tUeXW zvbqn&tS$Rh(Y8_Q$nYq+IDZeNXP{|J$2a{pe-Ksl@4?{eW<}*%hh<45AQy>{8swHx2|ME^HBr)+|+;7nB887nXE?~fiMlnEk!rR zu;B__AP!wH!x$|#WE)Yh^6b7Vi&o@rz2?kigXL$#old36V#gNHWZB^qPsooX1s-?Y}`|YQ{1a*9)I;_z6FughpU-G9V?r^YihC z>@I^^o@uCf(NL;x+PQ7&OY_4bt!tj*vUf^M+UJm%G~hHpk9L%QRTZx|{#kEMaQ};j zA|pP6ReVt2vZGRI_5uTbe8Ac;)1HLkPEO#HsG=pR4o@D)3=tf z92{v~ws6|zXl>gb=?mX1e51qHvet}FH|ZkATF3U@i3e_4d7icI*F zW}=RXa>7>i4MU1XYmsS9ttYT~jM-OK^_O=?uUq=iQzMB5g%or`viURUK`FK~E=ab3 zNc-{c#)_XZ1ilavuQjwMRWt3^5ia9j4M+r(|R{=a5zyFd{r zP3RpGyoG<14_tQV+Vbv8)EvGu(yMHbjs>xW7asvXpK!vW6qjX>Y{Fou+YBiueBQq- z&iH}C-h_h#vuuxH8jI!pEL<>hLmz#+(_p+{q z?UKO;C_&MmEXX{)_107r2F_wM0DvewsF!k*$1>NoZDsY)@BZ@PI|`AH9|g!O;HW>C z13n@L%&X5C+}Eq8*VE7Eeb$he5fD5Z@b(!W{PyF98yv2;12st^CY&go5>yW)u>p4d znU^D$634dE^Q;M2zunn^2M(1Za5k#7lHL|RE2b7adFfgosDi}xYU^nLq{+75xNvZF zldRxp`?B*-8yX~osp*ao*swuMi_)ZXnG-%A5$B;~o&{PIJfw7d@P5-$( z4)d@I)BV}XRoj(cx7*T)@f8Lo;r8lh3PFK1GCWLd0*d#3Qx821rm}}DY*3sj#f>S+ z!K#JO=H>RccOCahf2uV$V+rEGL zg41EfSWjG}>Hf4A2G}I_t44QQGHWPH-k*L%!~&nc_>Z8Ii-B?&f`Jfqaw68=fpYI4 z4`~wt^m;kO7|I|(WIzi_5tpXE6c4dVc)C0KgU+jX(!0if*Oj>V7q~c}QW^KdLsH}Q z)E1`o9+m=WH?OfuZ`&KqQ_u`UF1MoLiDdJ`y%#^68Cshixxl2q4(8pCne1 z-1R`pil94j^zIx%BG`drBC;ny<6lWF7dNW(=CC6XT4h(Al{JX_ljwzzhRtfFFBW#N z?y;K-%Vl>o5=2&`z+zzfpWdcLP*4c;EP-VfJFWrey{_LX4B&( z8*5UNfw@B);FMc8v|~17cD)3E7^F)NZhL8oq_6-B7?xtdE1sa9b6uS`&v@hL_*A0q z{|sLyhj8ckdP&p8AU3P@3Abn1;_b0B+n z<$fC<+$8mtr~PfE`urYCqC{*UQky5zrqA7!XiT7)wBZ1xWItb6lD|SKtk!>XW7Ax< zzV~XEsB4%|oxUe4kwg?xG`P{U@c7Vfdb%jzBI=*f&k1eM56q`NL%I&3NholhFicfC^djkiP!C>2iT$)_~7^*6?3 z4rqsq1iscCthC?WE=rycekA;}U%4yy-r~e9*o>Ccy)Jr01&d*7&VMs_zC9@7Q+a#G zbA!9^zKOi9sr7T^a@kdp0~vB#H9-~uN9HG_uxtedik!Pxm`fTO7QXIh zpe%O)QP46YOOYG zvpm%Hb3b4Hc*gG=I`83K2p!#NrU*1-Dtc(RNvK5!*Az|jL5>i8wH46q;ECC>8)k6E zy;oET_N&yn^?9x&8@@K(2ez@1QYeT|JT(X*;%i1VC<@)n4PL(R|2uJ8^&l8Q;o@-a z{6oSZvK{7xFD}e|>z6a~8>+LMh7g*zr#qz(7<^Rd?!NkDyALo-14J*4X zF|_aAzQDggT2KsSkG>#LpxqUVrCFv*;_CW{XTZcUw6-KtgcUBZPh+pMFp^0R^QoT# zh{R-J$J=WiX16`Ey(A<9f8$6Z2jOK?w~q6oj<3{M2r)3NB^ujh!(}0aL$8b*KH__| z&pt<0o1z(0ksb_F9cGu@m@5~(FMfV`keO!eta(4%-}nwh2qsV<9Ppu~zWyC%!ncrv zAjk=?b|>2fGwpwGMO~cMHyuYMHkS!x?^)>8ZiR|}GcZ$6vw~{$y3N^9gi{<65ka|` z`j&jjAShljlP&e|HpWl}6I-!h5sI}19O?Iy<*HcCLfG|tGqDp#ZCcUv$Qmu+n-j|Y5p)6)KZBBYxM;@A%+GB63C>EbYer+Q=BW?s) z7E681+;F!7<%cQl^eVC{DePinVlB%!4}q(AGtsTE|MoPly&EjGW9Oo|s9UeHmHH=0 zDD2o8w|$<{jps2%NRtG6F7Nz7V91K;XN0h9{e0rTvQ1L}R3!Gido69MXrxoDN*4gN zs5RU_P%jh2$VDoRKRh1KbVyX1OaP;1nv9<(oak$KZlrpVX`uf6Q`+zcu1;_Bn@mp= z{hyvsA4&VoIDmSADOigN2oqHKqXcr>947NIe1)+xKKubt9YmE@UEsyG39D)eF?GqR z=_2JXbkFUp9%qaR*LYDhQbcrWEC~YQvGNnY0mzs{CSAruWk|>l$`;V#aP6Rv{EkjA zI|slRcc0GB@wONGiYS(d^I6H*_#gk(cHnGej3Tf=3QU_9iZuk|bB>Ds4wT#~M2q)) zhd)avwbeIiLA1P;+mUT+IyjRlJ%hn%v&L=m+Hx6I!JH%7=%O19>MN1dEGGouVQn#Fd|WXMJZXhQYYOwJawUbrcZuE=juK<5v^>j+iqTb=}W@}B= znp9(P2qA!mL1hq3h$J#bmJ9X;z&cj@Ue@~hy4>IEqU_EDW6>Y(rlO{PbH9iD`1MHi zkl-Mt)E%?z3FHDpia29}l_y;5MFtniJo3IUsAyc1!FQ39F-2s~A_bNa&6-`ezBg@c zQtS>*k%2ogzq4j?`#x=dhQ1ySWvtlLk%7u2$iz9dziLo|zscX_=_2C)%;=Z3p zHPece;HLdKK>*-mL4|$Q=DVy(Kh_)OB6^z)nf?lRU_kYpf%C}=Ab7o8&Up8_f4^)s z{X7;)4ai{CwKP?JjsCjtCcgY>#wW&T5(Iu3qvqYd=DGDbbWDotmfKGj2OA`}(5!o0u^qMd z#0GjeNV$4}J6TkTz&CQo03Y@9!{(Lm8fxy{@^utlv`zX4Te@8)$l3d8ePpE~F*DXG zUyMjh8cB;r(Srw^9cvB(K?n9{N6s~tXsRtl>vP)jPD~;>BzG-}W6zVvuHfTY>vHWy z*i#@Vd4_~N!rx$Q6vt+V@>P(MW3~1BK_McpeRvFeQ&8|;erYV*)P;>b%_&L?t90z# zXoQTs(HY~gX$DdQ8pOZCig2{4#xvkqWqlxr7)Us~2|jX}Q}@upr*iXFkQq4ajyUZS zjQk6(j06g;>|AP97K~Zm30N5EaqN7?_ z+YoM!vwoe8?)#`2?uX7LCnXyb;olZ6SZIO>Y|g~m+eTAYHhhw+$7JWc)pnUHq`Y=V+)QH=mW$RW8uq_8?i z1Sy6QkS8t4LInW-tRfQ8%B|VuP zaUBkCG&?CzwxN1u9U0~T460=x8AhB>O~^_ct~j9VHl6(|DAd?)vhhj+#$W_MpF$oW z+~_7YRl0@;;G{Ejd>J9v%b77>Z_ddaHy7(0=GoWhf_C0#y9Y%LDOEg#N7Kl@$}kE} zdYQ(J*#9z{;08)@A+W-lQOHAL@%`7kS=j>lt7rg9pb4Lormv4AZH-oW$uF)>YtNS$ z3Z!9=!E8@w@Ko`QHPC8RFO={&{XnBbL$KaGozQZEz~e&r6ORJN2nxT(fv%Lwg~@JW zA-aWiFhSh)~*O3v~oF%dIkzg_;crZ zR~D_@Xyq&~RIGys^8-+`W5#5BYY|Ya#>l6-u`H1DP8o(lySs)4KXI_Z$HIukP_wJhE{g_M2LM*B}Z|spIpCc~| zRgiS@p+tq5<)iz}Sh6LY@mb<0NmZu)k!8JW0D9$$`2tDdOrb=`~ch3_i^j}O?L`Q;B?13y99x?PU+ zwc7-#t0!HC-d!dF=x*_nV?<88bRE>HIo(ayTSi{0qI^md&9_#Y#miR9r$@NkQmf1r zZ1K7?bN&2_AYHgfdpi-PQ_NeVW{`WWh^KFgf~~4goBCVY$a)vdwOb5;UeiPX?Cb7b z&XZ@YVDH@p^>z#8l@_p06e`yZI~cm?=CjFN+DyzRjxX@oeGfe|r4lqi?*^~){QY)l z<%`gZY`~U6XV@!q>JV1=fbhJ=OPRSktBYDdqUZDe?5qb<5snpcJ(|}6i7r48~_YvVTz;jcwVSR*V6lo0SB7vm-_C_78?TL`~=Ww zIUb|f7MNGBP=BvJBi}&3^wH6&^%iT8&AY=E8{;GB-$n$=PfweED}|srM2q-K4cYHq zDza(<6pZApzZd&Dxo{^q!bHi=U(Z;vymAGtexZ{@%>aJ@!qsO~qRmsi4*L42DQM~q zt+2x4(sei|3S#(-(0*wVR{;;=!U+ni!IK9RBb0k`Kc6NrDIYBIbThhk4{r<^V%uo^ zji>lgY}xv8sdG?9Lml4qSma~mBq!k0T`>Vp+9oMw$PMMAS&YaigN>R?r4(V-_td`0 z!b9M5R!?TzQBg+2i9lz3AcBGlIeXVemQO$xJRqtaw=x~S_gOOa3WQwcD3=6g)ft}Q zSl`*uoT&2z_|K9{);@P5`bHrhEvr0@HY@3`QX00j4O|pLH5hK{eB17ojwyCf53TTZ zw-y$vGl4;th5!>wE&dKI2nOx86L9O1@so=jhe+KX5HJ@Ohe9SvB@P&xiPuNt=UOLC z9gnT+!+a_eZi}h514e-(^8(0cNUQZ)IraJcg$0!@!58wi^ct<^2VMW@xK zdE~E?QQKKH;b)kQAb}jt2%~ZY_S!y?RW2m4EVt95U}W@APAV7z&Wj+UMHGJHJ1c9R zvB0`?^mHm_RZy0pIO1Na*_=GxTM`EM zV{wKt0o~Br!XJ=&*pGYGVF<6Hf9s972&~9F6&`6GTwy%GS=Xl%(~*YQYXJe+;Wn{y zW4GwGWhd*udkJp4HPGlXvo&pso2FkK-t?)m-7Yh_q4?I{@h4v+0tL-4phpN}9N&mBqk?yf`|@y#;es=DUN&q6aWfD0+Dn6w z5is`mpjk$Xe3@JD6Ctt^j9eS72lESe@NnpG+Zu<-q#vHce4@wc}7*S!0O5NE{HO z2^{l47=(q!=vI5wk51nwODrXK)__3d$!^9qiT-wXqg_eS z$2jwKbdqNlI4R-)D`ekbydCTNs|Z6n92hTRf`ivcQZhJev-;jR2zwXxK=#iX^q5{z zUa8eLBrz6E61bot1kn;@U;-m87@^L9nDU+zfv(~qT26yT3->T?*~RuZL9C5nD5f># zR~!3PpRcVnJIK5%dH}v-FMr*x_#+03{mR!yKWsB%u4a;vl<7cf5LmAKDH2UaE4dsA zJ^#+^^LZ3s0WK~*G1xKA=+WMdH;tu|jgX-oh#@`CQ?J>ot%Da4-C`L4%eMSU&O(`m zFe6#99lj4)n?AhxH@%dymYs}5TLPi>E0MqdR8eGP61rB_-e2>$Te&K%&kA*iIMg(v zh^lim0sM8FS}*f6zSMq;XTgFC=oOk_K_n4w0oiQ+^=dE!)Yk-2eWz4__)z;TYD^>K zw_6z0P3DSBFK8m*;kHaiBe@;1UCLrEXiD|yK?&A*ALk3oIi^iFPCYQs`|=PS*w_SBb|)s)0m zE}MaFNA)rO&!|9Z=E!&R-tYa+MpWLMFBd<_t=y~vrUE2x)}qRC`b&})xM>LdVlDvv zx=+x}Znw9~{UK5_Uw+%_zU(DM&$Gat?U5`u0ry0YCvS2Nkzu|>*{P1NRjB;b`PS;T z4g3Y9BXXkY-017W*K^m>lI%ys(&@|ybzR%Cey}4@)f!bRihc!NPwOU&ZOa;SxG7m8 zjdWhki7ugCbduLCD&XCiJ#+748Hys*TMjQi8$RCRa;}+k-LIE>t*6r!dUQ^nWU9QV z`0Q`5I?=raVvcb1iRr?vhd#>XL^x0`>JcDbs*CrHIu||TTsY?ALJS}vyUp(A7)_Z+N=kSuQnwV1rqLi{^LSRPlTVvlym05I6Ekv9e7 zI^;sG#^2Q_Y(3~qKAihaQ{~kM``J=^2f22F*oFE=Kzj{;P>3cNakzS1q2+Pc+3t~b z21vB0Az?eN>-vlC^_3O}!qpHxzq@kDmP?{me0S$N*MOea{7hr(?a{55jnWFwon?ca z)q!Di1QoZFMFOdGED%>@D7q5pA5nAWaAKxsWIm3*g>!a%x$TYC&nvu}YDuD|X?mV= zvfr9zoZJmdu>;~^6`q5>5=C)g_CHH}p0MzSX=FlWzpv{fv1uS^#7p~b>U#EJd}@3k zRktu#L$2CTqq*{nfCc8#6i|>Ofb?)caw=@=UwyU&Lp`!^A_8$c{v`Q|f%OuEG}LIc zGo#IHN10AQ3>3E(;1b6}Qy!tu1BJAe4@MLuaTCUUYyLxHDTL;NOFQ)H=&hn*}{=Jm8lif9!`g}lRi%VP<+R2LLj25RyjGs^> zWioK%h;iJ~0@2*a<3!@)fkT1?KgNjT{Zb;6-#wkT^Kqpb%OhwqpBGsxF|M1Y@={ra|ybnUyAfH;tm%_0wD1ajnm`3%8a_ zBPuSIs9!^-}YGVK^l^C1?QE4EHZg9?s+Wq1dVC@=`s z<6|YQfU(k6zZ)Uo^y9;r8DOrpchF-XAxrJAf+hMyH9)keQOe_QYRFS5bx`Wm~hAY1MkYH5L6n0V$g!D+oF>AnxEh<<1lFgSr{&Z{+S!FC*|5g*I3} zbnCGS+KsjF!dhi(4aIf@OEjk=@5NisE(7Rr&lL_rRF{6V9YOlX$f&7@W6N`u2iKZQ z7(_MsYtggOx^=JB#a4g<;RLo?W)Z}v1L0PZ*c^AScls6W5>|6bo&sRBHx`yR_j~`^ z*7t?MA^|5m+$ZF#i(S@FVB&I$;{-aO635t5OBNWC+N~kC7i89towR6OGP*|P#M7@fjg-Y4hFRho z0JHJXjEUj9f;TdBWhSx^2<5~iDRK+RfkHvITA#hjyaF@EzqO^>o_oV2HjB>BZU4;Q zDRshRbsQqi4l~)8t3Em^zJj;CTTK<;8`t@9`RhnjKJe7(MUJ3z59WRwNlB0BpROjJ z3%a+x_mBIm=czOVHIJYM(=73v6Jq)6uf_rYz8Ph`vc7Exd-g!-Q-BV2Vo$nExw91Y zTa@1A)-nrwNW%^x14!!jF2apl>%_Kg5^hiS5+0a}aXwHFA4Vglq{)e2S8#h-Zr)(f z^aUBMWpsm`DAUWI7c}Kdz%C%9;W2P!XhT4td#1^Gj|CQs2n~>ZwB301;*BmMO9ZmA zHjk&k**nkZK39ftpKK!Uq`Y4JRB4Alyr^z(|J9qdn(krE;3VsdiCev?-h#-DKQspR z_Q;pLk7OS=CVzAQfPw7RUYLUEy`K0I8L)f*iV~vOlS|-xBlw;?xj?Dp*j_-7wS<23P$WUEuimWNK?>v*4(YB7{OVOoB#6>xrwyR=H=hn*!a>` z>NE*PN;gS1XHyh0#&Pkzo+|rLj-*uF%D~qmes#CFVbjO#>yN0)$)HL zw*Pa~|A(Z$Ctc_NHeW*TUa5nx3l$M5Nkn}-gaO)IHmyZBOX%dCcS8&r8|0-ONii*= zzu#~povo#sYn)vY00=1_PMmgy@gf*|vDO9t2F3XI(=(N3+#6bF>mUFVlM5lTjkbZo z!CrGA!p1l}v|S)tel!0J5zsjV_J?eAySYCfEH>(_u^#at#;mE~iyoOIn2649EqiCF zLN9z))>|WGE}4uvMuC{_ly6#TWQoa!TM+-t@ia9-%MAnu^h_n<gkcwKCOS&|fY=6f(*P6>gk?>e zph|>x8*EE>EHC8AZPS$iUIAEVu%$0IO{swfO|9dUA=i=C#L;IIK}^c9XAHs84g!RD zDWZ>^$Nhn37R6Zw2F$sta!!E(wy@uSuhU>aW;$|NmkR5(;_a)2@**_Pccz2KGkZvH zy+ipSOSjv@jW{#Vn3&_im8XterGZL$;H&cAh!Pv(ke4E*-O} zmd|!ApL6jrCM2K7v-UC_uOiH3F9HM)HWRp%h>~rm)PpDuooCBM(g|bJdfx{nL{7HM z`ARuAa-r=0{KN81HF2`C2CoaaxGGQB)8pCH*@qLa$FhKmwKS@7xx=Vn(i>k$MLUHA zddABE9LFWgW;q1ja+Wmj691gY^Z*tk}Ijz!1LG+Som{bevGOtWZ=_Wb*!<}W2K5^Q)Ix+pI5G` z)30%GoDk5LX~CEm0SX}0Ab?MeHW%;x!xryEg>LGt0}lzmQ2U!@@-(POxT2~go2kJL zFE>>WNKFmr$6mf2;@&PS$F)@up8N+q(Dz3#zse}UH9eVz+;COEThHIz zICip;0{js5+xIgSz%?8UL@Q!d$jA4_xlSvtGp)^Vy?OkKMX&L=nba$9_N>r_7`2Hb zp{DcyFm{e#y#-p^&bDpawrgkGwr#t1w#}XEmu=gwooi>mop0|m#`$pmhc(u`*If6! zuEbxbAE7Pj{M(oc_w~6FCL{kwsXNoqPR8FqEp0y@Cj$U$MKS;FEyDdjp+o&aD^ z6dqV3Me!V*gg6?;*4dY*O&z5ff`aR*yjJI?GVSpv@IC4Q`Bo&BsESV~fl7l(JQEZUg0xZ;_`r%d% zjHPS^NJs`5Ux|94frCc+F^gvTI{j^kVd(d56&>jN@Sy%M6l@$ewA#TV4F$>T)7|7f zWpCd1R^#K|!Eg+u1wBA4F+-eQ<$0h}wi=j^l)C=vqO4+-XR_Y8`)>weW@p{MUM5S;CLxv+pPvS#0SPTo9qSN)G#-C)*k6aB zSSnk>&5d1@xtEKdW#V#fN#|hz1zU1v@IJ-$*<9)NXX?TnP_HVYDVreiP{s?DDZ8)f z8<@v0B)PI;MRL=V7Z)LA0G7Ua7-_*&s`$vA(awbbOeFoDArSUXt$fq-r!;|qD!!38 zhfReb8G0YY91H@CYLh3gXZ8UwK1mWbGGemdJCQ9Hjd;Ges6JuIhcMktxjAuv31ct5 zdLttgUFcPiPCkxNo#j%iSkaBfztD*+zyX(=izf-b2&Qg(wV>=)#TQI7EjUki$ z^K=O<6Ney`8cKm5fDJ=m4P(IeHJWcQT*Z=zIAk;Dfz>uQ6h z5pp=v5g2$blSe-Uqsc zZ4^T&E0UXQO2FW6=}xZvdp3x}#`)~;2_xsHM*lyPdiqOo^1_XSdtxa4JeLxg2v2Yx znQ+yyFh0o|wB2Ki64{X;VX5{UYD&D1`^FW3$eDD8eN8+~%*PUXyEzK%LwDlh=3h!0 zreTWf!_AK9iNnr+xiLidL!!-h^+@1#d=Z1d!wQ_wLg*>s@XwS86|o|G(+OqAL0^G` zpsx9N1WAA`dBE-T3#hNV_LysiZDsVCK$Lu4jj5>SeG_){jIlpfbZ;*-Gz zH?_HCFd)?@P)M{!w@1);@sQwb-2ya4bESqVSR{M=QI+GFb_&UGkAB}axpoW*?Gqsc z^!F8~>Zf}C#iv=IUn`0u>1ysf!|$cV0E{{7<-7i3AotA~)&f*IHMym-Lfz%9Ca9T0 zDXe$Ayl-IJ#6oS1PQ6QLlv%(~>9k|b6iBB0vf!fC{8GilkP1%RW6xb#gDedNV;Lb} zA{|+7=*-O`;tX)rJB=9NB~!|`%^f%?tI3tqhC-S2w6>NZc}HrCLkn}*Dgw<@lsdkH zag=o-`}t|ib~vhGA`FJf?;3|M(x4u=c$}0RN{$*sM%p#_@C;GThn8o2s63~O^Zv#d zOvgDH_W4F(cTY6JhZH@K9L66Nrn=c?=d0OQcGgj0o;dfcc=cp%S~fDT36?v);=YK6 zdw@s288ayTFLlK|n9ty6FU~8odO0>7hD%u#bkCXirKl!0KeOVqK!hf`&fd3m=2Y~i z>F4)nsGGl`waz0C-$B@j?e7Sr()~AV3l@CDjBp+e3N&{SAqG7jlwn8WltF15E5X}} z>P(-ir{#&g>)b_*7Kl89?5yX-2K9)jfYjpWO-UULcp)Qx7zYjCG<9Eq-A`86U!c;DBWzq??rPjA3IVU#UO#D5(|{~NWC zg@x|K#@~TQu)^A>+AnOQhqDS92PNL4Rfx3|G{*~nl7t+WRLkl z-PiiPsWnMO#-?}1Rbi6F_>ex{*EguA1>4v1+-akvkw#@MFYjb0P{qF^gqlrJPkVmM ziX%|ecvSg(Za^QI7%WirW22ataZNTlaQs9T)VBd zsrezM-O@3rX>6~G?=}-xvWQbtT(hE~WEsZ)PQ+pW3ngNuy|8|*fWH!9@rve}nQd~_ zbMupeNR#qLo~9uKK^=nPJ#(Dn8AqB#AfSwGcsUVXH>FyxTC4TRCRMW_d_tr#6++l2 zT7Xv0w(D(sJJmG?amveuV<+c6=!j{SyVt{Ctb7^MV|`wt+D2{OvS6Mj9I&5t@_N=B zv0$k3KH?8qvH&Mba(evfQUpeF*-lrE4_%J3B4sHD=d_C2tGwM<+sXqax=CEvYJ$6# zt&ZM(?)#LHugwoW7&ptBQz~`TLzP$cwXZ0m{!!Q|cbu%moV$#`J>l%_3<-T4Y3kb; zwn~YMiH80dk5S9oK{Y8O*{m7S9O-NNQez4;KGStn9${Vidt@klC|hLrvbK>IsF+T@ z6oqePoNe~iyM^LW$@-u@{jf>y^o|=jw6yST#J2$7tm9Fpx;Z?>Nidz*m0eo zC-(h|?OGAcV5HQqg+@4#BbzX7907X+wrE`LYufFV=a9?l-RlOLE^S00%6+a9B;3Z8 zBRVkr{*HS~1gx=Rfd`D6#vuVWDLl|_Kzb48og2%)^bqZdv*|+R^WUmMYouDkqQ(z{ zV?0NQ804S0L7>tOtnxeGRR6{Y?5RIgtZ|J~2{^^m4d4+4c>18So8oL-mWrnjlx~EswlN87nMCoufgc7*Lmu~Q|arX37zvUXmZU4A$2O!T6<$bPRlTTqg zH-vKW3hG=B#WFN4TFJYJu=2vwtL(jJk*?{Ype*-zp4SU0XNlZ6WPwUeFo^t``{Ua{ z!HQMo=f0iI4GStGVoTktt#m$3G+!GTuUCxN_MlJ^6{_su>Bm@jW6fANLPj>st;lyAWlAOj67h-PL6uO-cLkesA^aSceZWnCwSc0)Z;E8oY4shhL!4!*R zoHkns>v!jEc2TvM*TeLPf)LW}&W(f=GpUVG0=52T5$A%s8zTUJkvO6Lx{{#})R0)v zl#%YEaCS>tPv3^hNW58hBkmhbq;?{$XzfRW3D#cPEco3wdY|G3OP@1c`J5~K^amZ% zTWf1gH*Ue?jv(+3jotQY^4oH0a{*Xq*1WDBU6+Erbc1%Z%eUtr6=EW(`J*`n8dPuCf9jW3D z0$gcH%c=MoG^nTPE*~nO#QwQ*!x*q8XYZ|r^%Px@$hlpqkf$83jQK={Te7OYW^$j0o|Yx}2>{D&)HU z++N!?G-{H}-SiRX6>J+l#|*Fu@lm+%e!R60AEOJQHarcqDgyafS0Ys_W>^j)3tN#) z|AtDTF)COuTNva#<6jimh5C)$TPu@x6zNZ9^Iq6?4*8ZuE4>`!`)cJ0V(CwXHr6Lh zlRb}F3SN`esOf0@mAmhqsolq%OVJ~CJFiGs8 zh7pk4{$j1NgsB2su1bPApZ<^=Ln?h1M4N1VMY8r)`Fqz$K*=Hk3jP}k(bFFnQXy4> znVF4s{LfrPig#LF8@Cqw6-5n5u`ibP7YO>Q4m5-}i^tAN4Qe*a^-Du`W}iyb%MWrR zXUUL~i?DG>mib~JmTmYimn>d>rz7LT7k6O*d{m$|7#4-^R$v~x0~(9d!)U=E@_7ya zWeI6jgB|4R4~F#gz<|4IQ@yZ3f-3)m4rS$jkw1Yp;X1j!HL4mrS*Z=sIxu@69 zoqCPkhrz~6_4u#9Qa{fWbHW>S972(>O%N~QQdr(Mv$AW}4!#3)X>-wM&3eC{4-GVu zsEfjaZenMmPa|N`yr1%5 zYANMUe(f8fRh&qcRl~CqDRD{5Inj-lV?;a2m9!qt`_mW)bKyHY*N>L}n3i=$$)F|B z&<~5rC@hPG_3S@7+I_A=|3zOV7*@;aJr0`hx{qeK!Y-5oZgQxxb&&)r-)cSdU%hJ4 zv>UJ{a(kCJHW%u{R|4{QG##_AW)^e*e#y!VOq&MTOdCTgCqembnt~wEvv-;`RhWv4 z`IqZ>m>KYM4$rwONe5#YF{b6h?Fno>?O4CB5x^Av8gIi0+NEOMY)`n#fh`)cyKqcK z9SLhgn5-{yW$gm+PlkqNxG&*7nK=A2;_1y0q^17dL6GlPfg==K z7Fiab1^FD2K_}OYP&C2l5%Z77jrn&D3eDQFXGCK)6ST1iJQznWemT;I`td#2cB*BL zou2E=o#--$(tZxraJ{G+g$VkvI6o;Iv+uy#zsYes?I%BD4InKycnCROT}5H}3Z&I^ zY9T8?A4_PiC6No)1|4>`C5N@h<5AqXXH~Tw`wN?}n&nE7z^sxU8(Ms#S=1rRTsl3f zS@T>6!5df}XpvmG{1NDE)C^^Hfcr8P4Q!%@e1aeOu%W@s3*5xJ*!IM(YPOlM*+wA5 z9!b36*j91?!@HeEE)$06@=-(8*~JawvSS4f)r~ITa6rV&?X`46<94H9|yaZA({9|=_wxV+DNu!c7rOw z)9Crc{uaA`u45W-?IOC_8H>0xy~Q2_@t*E6$en^sU6Y0bZ9CV_j>i?U21^Tn2>ao0 z9DM$uP}QVl{%WeEAdh}+TUW|=c2i4Ira27pV;>;#@e)MMvPPH1gx9uOCRe?qfyZ=F zXc!NrIPS}#BR`7tSg7jY0hQmb7Pqa#+woXgKqbqS@>uIbl}7nvSuv7-wmP>KwbNnSb;MRR*772*Q%7n|EKgCnX$C$_Q@53qI2@^I)aqK=7T&gK*LgU-}dQ z)cv@FUQdICu`uaGx)UByt9?r%k9=qdRV@iXZU4STQb9p=Q{1BbNHYQ)O9#xyC~o5= zy;;fQwa5^*@+lFH@JTt+VPmdlq~rs!#oe+;UspvX!)cBO@U;5r!p)~MrpjgptFK-| zU|qUS2l&Fp!%-)XgP%SQ?E;Ya^TO%iJe%#hnR%DM|3P1=#vRjzpCw7r{#1hg#L-3* z?U+KR!FJ4u0MK7k%o#MQ9F#6N~_Rj|NR%T|@hJCVplZiswi%>>_7-@1w6iQFMWfB=$R! z)-z;VvcST^XXSJpa-gfrZl59*1{vR*9X`7fh*ZG|sEOne<4LwQL)duyEy{@k^t(BC zhVr~-Q|RgT*MYEeaiyTh-Sc{{#fW|fd_q&M6k0uq_C5strgVD5?UZANG=^>Svy;8$ z{kO?)9;obVWsr{)pO^%dm-}8&1mKx1mFo?myN8vKXVA6YPhv@pF{DBVl#4dl7}!?? z)6FrQHI26*2Nlt!=bY-c{1$8^K`v37Mdh=rsx9i4>(Nm$5o;0%v+Vx?=aN`GkCDg=>Pg3#;vFB~?9STXN<4ern4^M*R8O95Z=!A?Y< zYRgp9O+xu^Mv%-LfVDI=o~JF%9ju7^p@{=%Da0E|_a#q`7jfOY1|jD#X1;78>kqKc ze)F{K&0(1@LHf_8T07|vRUT7_@Z&D|u*{BM;Aj+hW~zw}KgY17q0iHY@If|7cfxD( z#R=?q2x#BhzZ*!HR?3p`YjiQ>*Ud$-OY?CLf5MPQmNdX0CWUbTHD3CxucVJM`bdHS z3+;Zz3F)fsHS%?s#kL#fA#5L&t$(>{ojZQ_9alwV?|PV3nOY>XhnEtR*IgJ?*@7Dy z*B_+HkKr@dM2qe75g0YXu+Qzj6Cub2<*!{Gpx=Kz)K@z}>ipMc4a&br{^AZ9x=!56 zb`A#_J#=t#;(f9=J-@)ILf1RmB9tAUm$FT>sAu2ikK?oq&4|RR?QnfWS1uvGvU1i^ zM7g_>6nk~zxQ+>*1ThF&6yv_No&)lWUD*zwMO|i;0ung--UAqatMQ(=4PZm!pB~hX z%j<+@M-_5(rm=IVrwQNCV8dqy76!soa|nN~ci|9KkJL-t4wVrGvhOw@?Dy_)b}4*Q zmQ-M^SL~Q&?9jLwLAE)Cw}IFFa@^eElv@J;}Q>jqRsp2*qKCC9Y0sLG{W+jYxc|~E7i)~!`@1VSV*RcVDz@l>*Kzc}Z!$)oD=ooEHl5 zQOM7wyQY58Kqp0j%eSLDwpCEqxYR$c+ta!Doyo$k$`a7<%Ii&t72u`&`H3h9ng+NS z{I9v}e*+A1asHoNHmv!}VT%K)=UD^lj99zCSUh@(G@Zn+NL;7jkI(s2L2A2xe^UEA zX)ELF6~40+|B80G6)YM@4YK%*PY?Enk)DB(FdoWE$jWmmmJH)F2_0lYMZ`BEpp zH`}A77)zda+c9B};o0@3ys9%|p!XGIBns zKe|67>~fmHC5W)7W-U(%bydkM;qn?hCF$SEo8bis4DryrAyOl$xT$9^{)ruXy$;d? zGGLmFR&{=7Litz6LS@Q`1{<>u@}zKNX;guj%lxcCc}0WeY~y~$2a!vN)j(GH1Fk!e zNNjX-3w_JhlZ4CnbHzz|U=p&*Kl?RAx_rNCh=saLrDUMxD*3%ul>Z$F^lqXJVDDS` z%1wmGhx$TV-G#!c>8OhfjG-7HzIDE$%|C4F-!=OxLgI&5-3Qja7+BtG}nG$|v!%XuTa(qreWI^{=8O;RipEeu zD4JJ~f#o=(GzFMZA7HtegxhiM$Y{?Ov%5BZ*8+kcp-Pd zAL}bRV{QP&ebHt=1<=q;{&Y9N>lAbKg9zAwwD%?1S;c_=FcQ)%Z!{q!a5by<$fQEs z3Jd>rIh@ldU1C&6mP=8v+ffDY`76>ahn9eMSLso#^I9b$A}nUT{iXMbXO-h9(&$=IdTLFLwdo12}8sH4nDb5P9?GAT8gRrMd2(-evGb?8~Yf@W; zjw(Z;w_Z-rB+$SiFP7&IIlpm}{GAIS7f!HL3z> zqDMg+XOhHhXDl)RR-W0$&`;utwjUMm^J@rS=kM z*(M{%y-qs{%=&j}b;0&cjmX^PJzypD5!Y5sFR((-@#4*@Q?KtON$v^-=0#ECbDYG4 zNaUQ;3-}D<&Dw=Pw$N|rny(!U2xbl!74f`Pm%0L7<JKU#6KU=HzUWHxQF-Z`o+YqFnt-KGG_@b3kUm76bo^>tTX z>Y=6GY_4q!tZ9eW6m4-W=!9nTGhzK(kU@^!h<61L6^M%p0zzsXx@j=q zZxwyClNqg_9Ao;5t=HIsKH_uVpD9-m1nb3r&i&Bgy(!P1@Hy^<4z%t4LcZ+iiEt_n8(O2)>OT9#V3hJ@RI7Cz$D-3(#2EpFVJLMqKHy`yC5H94frZ>d7w z{}Gu|i}(6QAL?k~S}l;lE%PFgG3>@JAj6l?UIUhMSy|z{o<5uOi>_rz-FiPb^<}&E zc_yTRuk`mb&?-eDfrvNsHo3_@dklH>uNIHP&+u;^ogghT<95d22r;rL@CCLaaynUP zh|=7J7xIdv8;NxIM@qA&UykOT8BeFx+2ApVoG)y8VyKer0MqgJ$Gmfr{<}jR->|45cc$*`Hnn(Dk@~%8hoyhz|?v(D zAlZ_Kz;FGp*si+B=D)N!naBhK?1HVsD1C#VReH6e+XwD4kLZzS2Drk`zDVZNv~EL^ zgHBh2bIx|F_RO#GFgsn{0)VZ>f&Bl=WaeP{p8$x=-0c6STmK*Q@74&q|7<;xZUHf{%Rq-yxJ;r@ z!?CJeQTqx9V;W(Fo(#zpIVag_YxLJk9xLXxGdt}hbhJo#I^IkU_v(#q(Jm>D*{vk$ z@SXt%{px%|%-?Jcx*}}q#$btf6OzQjRQ4hB$HD5j-FJJWdpvtTWV?Na;t3kNpG5M zZS6w`*>;_H7j?s&$PRCS;hRIlUiZy;{|bRU=jGjOogOc83uiQJC0R+b$%+ogMara+ zWyKapT_$|Q=L;L%a~u!|-F8wU)q{k{zA8|eo55s#tH2IlJ=F8zOv zT`GrKyY~ev-S_jibMvmPY8#ggxGi1gd-t40S);J=mw5E}C?LTsg)Coz%h9l<}+>%z?pvVmF0^x}Y& zO1AZtUQ?j4;9Qq){l>cCq|g`XVv&G3zu9=$wlkWBV)qof(dbUh1Xdmy25ej zJ$99*=d@K9SVFb`u6m$Mh#oV|K!jaqRUHeB_8<%$mR#S>Uqn!*5SGJICu7fDP;*b4 z$(F^NLTp$W&zT$uM_eL?*?xZ$FZjQpM`jrHB7nst$K$v&Rn%LdL^Kn@P4JjmHl*vs zz^AJZa-)*z!=N*vj}dLyoTHIaQRLN`f**t?eT*ftIy5?*>=AcQ&>kEBq0frpgF&H< zAfh0ReZ0vxdca%n>92(HFob4EVN$ZJS7#zono|%Fg@vKJmKw&8e0E{>9<3mPfk)va zxY59F_l-BOHOR|UC8sEoYNYy(yaQ$w#8odis08m(A(DabQ(RXw`W6 z?-F{YVC|tI6d1k{y(fiWDdI@9y_v;U<_dXjsiGm-?DEem3}P%cOBsdRfD4g=@mPcQi+$9{(-O3czv_6+A=K^(bnmcOUQy5Dr!h_msaPSlx7A0oczuYfc4AJiqf5t z$65=lsg8e9IpEtPVmL76hELEd*4<9%+52qf8|p>J+A)a}VB(x(k5wd)aI0l8sZaU7 znX%KoZ-DKoOejVWuRT2oLn3RQdxAgq5Dz*cb07Jv(u0*oNLJ>ba0UUf5-q8 zCxDFR-~}EXF_}bkRjoZ{)UEfUQ>l+!-O?9S{(2%=jl687sDkL6T#|Vyb?z8qQ0ON) zfhQunlD*gR`-hG0B4a9yNXK6;<5GdMG)0O zTwU?&e9!v{r_+ox6MAkN+zPo=(#g;B8$ywGt65Qr@Y02zu~yFsPIcS*73d~dLg0yR z^b#&MJ|v2Y*DuLqwtH8HcSZliK^2wVL!;4;9i1emu!dkALYubI$^{BNst(LB_5`EZ zRRyP=X%VVGa(M!0NlL5eZp)^E1hAnBX;v}vUh*QmHH$Z;b%4C+%<$;O^IrK4vayhf z2r6@V>fSO?b8?_q$izOlO^Ysy+@Or!&^Kg1Uxq8;iFuTK-J(25GShcVH zmxw@J{G%Xbme}vIs;JlZ`R!p?P(FZ%*M0k$fre$w-&?@dNxUd~U-Q?-K1^bVW*7J8 z-NV5#tKgVc`c1Xpy6MNGW-X_Ad*e4wQhc_1PLb<@%K|lNE-nXvIxsX#i%`DW{@lHV zlNgn?F2Pa@#&gA><~Zg)KYx>VZ#)%M20LWhYXf0<>nnjOOc_tDiqU+8nw;tJy@>}| z!DP^W6WP6ro4faAb3OZhczsfmed)S$dv&r7|NS4JxoJo;H&O&Mb}>q@im_soAfE5L zUfvZ-7%uvs?7SDEL$u2^wKAjvCK9)fKOj1Lw9-Y{cV3~ zo#gFQ;~V@imfZWlj{Em}2s0+>aCmW^;*e3`yIR z50lJ*%Ei%j_Yk#9Ih#gU8@x-~w)6?zA5sz(Psy}%; z7>)6GI?(FYUq#oyzg1hezuZ23q${GKYqimvu7KkeeeA>p%Ovl^)so~-kF;nY+4={N zhguXb|NZ-DAJL<{{CYoXOBx9oyF50tJkKt>>=X=S?$6afc^$3uu+%yo0B&|yUoxSE zNa$;=JK|PLuKuV1H);yo3>JIM%#SRsjP`=YKnt32(mwkz?#W-e)}Imc8ZO_HIEp)c zW@}UC8`>QV`J(Jz>By=^^;|xk9&bA7w)MkAViBpvu;=7jnAuBlM9lQM|HXESoW0{mhym1DX0XupuPgJ3_Wv*-_!}Sf+?eEe>YbBZrmEo74M%&##l!)14QS zhN%~gTgjX4LBew=HNQ7LpZmAR?3lmHlap-%*nQYqIb@~>v5=-lR@ zoGM#tku0iP39LoE+d1gE-LV=7-q%Ip&qb1+uIc@TOzBJ=7N3i0?txLmk)Y1{flwzZ zarj@JW4I|!$awFRf|UzBp9E21YgaMLo*kH<8$c=wK@8`S=a6YHk*-8J$Q5N5WIyv` z&tr__3k!Z>4stLcb18yJ4S@BNy#3MB=UA@=AM{FCE?%oY#d>>uSh81WBRVl=@--KO~+Jksaf1|LDW}w}E4MAJ?ddN;zz-~~-l+oTyL48n z-&*OWNKm2Bys8!6{-`A~J16}ayl&gpM$nfVrsDQMUM7$t&3mM9?WDtV5Xc_KDeZN! z^jUn+Vrq+mfUlZ!d5?Rh{+lTv{KO^q-t6yv?hwP|aXok~EdfFRZWx{Gk}^C>Bqsw= zvTm0>LFhB*4H3G|uH&ExM1)bKkmJ0M^jlOyMeN8dNhC1&;pK~?-_ZT)W;0x*9JkL_ z&3hbq^LQHv(P`+kaT)SfPz*oaXYYvN+7} z;ridlD&?S|;Pxn$`8=*$(~x8ARc)Y(`DuX9<(c4a9{>C6<>g^-c$Z z&bD9UtebbYRk2-I;~~D0YC|=~$J5a^_&=|O@75W?^M)dl4-9GD+1uH2!V*u}K0SkL zPJ}ay1ijo|e;;q_j%>)8`d|g%1lCLCe9*c+XpnH9-%=Snrhj&}4>G%3U>HISE+@;O z8HH=V!Qhydx`6;Y^ic?F!)IrYg(Xf!JtC4CPb>&jLYJ?WO6vDe$q*Y{hyc51J#N1(8t-@ssUY10pA{lMb`<#sr{_q z_0D$7cd4`YHJQa9=@+fzauXTQ*OJ} zhmpoZoA6HmUjw83>+bCV8qFZ%?g!+)ycfxT4K@E8g^-!+|1@5we?rYq2 zuY|e~+UMhWv`Gbl(65Y5niE<^HAaq=$S9xVj3wM~yA*~$DW-vvLAe_#FWpXc_@D9? z4+mhn{vH$r%)xz~#yl<_MEqFh^Vfn;O2%LT?Yj&WT0dYRBaG*4#`WzwJ~*{DU8fmV znIDgXNaW@2ud*iRxPSmHnbgz-wcZc!@7b_|B&s?iR9`J;>wN$3sG=#n);@f7qh%Si zAw{EA|Bu!>1kr7dV*-vvl6PIiQ53=lLIF=|RQ~(nXltawtBdan1-E-B2MiY4yP`&a z4f_ppmG$othqqJ8rB|bl;NGhpemrePec3G{>iMwSG`ws;KW9I>oD4QG^z7h)+d9|y zsJR_F7k%b<4eIO$`?1RL^@`oSi@aGk!Pcpf#v3nF-!>lLT(xb~|J#<+U|uAI6MoAP zBzi+HS4l0*hc?SiZTDKC!X-?^6c|=0)xtyYlBR8nS6YYi_puC1=4box&A-b)WOb9! z?Li$6?kA+XC7SOCNDu1lxXsgR3h&&a>6Kiw?Faede>JlcIGGAHxNbws=W0ZHQl5Ay zYKgiogh>vS1=2;Ccd#|yTNku(%LeE7r@YS{&eFXu`6RR-tGi6Xwh)8mm@-fDC=mY1 z${Et)DTxkNHRU*>WVn>=)p<4P^2O;)6C4IytD(WHIg(cw$$iCCPH`%*GE|)v#=>my zVSlbRDADNk*2phgBzLL6CjeW`J<4@7dk57Z*A!~Nj0Nh7Vj*hlD=N!m-BQ%!VgGRW ze5Gi{`{2}G*s%^vh)B?3$^F7|yf4@Y-R*ATu;@MtT7gYWKX~@=#FoaS%S6!#(vmhp zrHSR_#gIu9-BU$R1cjz_K{Zd1@wG)H&W1NGjFfiUVgD-ph zUAbo)0=HVu0j;Fc4;CF{+$xTPQbsVemo94DOTF9ASCP*&Vb67Xmq~BP6l<1~Wx-%5 z)0(!ZRwBQ3!Bx&vnB-y+3O`vm_)rIl*SuCa*4p0cIj`@5d!;WWu_>KpCwC3rHP_^L z;B=A0Gmyf7ts{gbL~#}AsB)4^^CCAZ3*U zVwHcKHUtfq`O8Zt@m??ja`{vOLc~c-HF07rjiAyONnU)G>pM4`=WQ}h_0BqwlJnGG zvqLwsBy;}3l*^u*9EusZPIPe3a)Z;rY*ZP5Ev-&AZ#ivmTu(05d^z&6q&zlU%!O9< znQbHQUG8NzfS>p$l z1}^#amox}3PIc6ySgMpv*nB9q5ZvEp5y#ayaJQwK<<@E!&>3==vfX-R>$UCx=@F*Q zwe&vG&9kJC>Jv+bSpTza2B26WG0-6D>#v994zR-~=2Rd{L_F>3k^^aDWh)Q(xmA70 z231isN&FU>jL|$z=c;g7{5))Og5+HS6+E;aVd;Oz8kp*N; z|KJ0I6z-Hd$u$mk+d!}gmuyQO>kJN^Fw4ZUzJ#Sr^{LJwH<>0W#C+-%zOC4;O254Y zEo-aP*MI+tr7LIArkI45Bkn@DS5y8}jH}+Wz(x*2LnlvY%0719z$W^p)Ai>J0D#+CX1h>xBlHNF2&FE zl2H*Wp=*g(Tj&mF*s+PVWzasc&J}@)_Rg1{;Zg84^pQlwKF_%69xVxa{7dW*jeRC( z^)SW#aH*kR38uX$y9!HQjV`N7U_aI=6q`WihzuS3P=?ehcM;UKyu`slMGux( zvZRWTC0TRj-RDEsIE-}0O0VBu7ax~_A`i9%AGx`Tc|b30x%G1E4?a@`ZradXhFW!r zOFvfPZF*h`sh_cl6G*g==tLc)!p=WO zQsFn|I$$7Kx}cjou~Bb%IfVbYZ#GTqa5{F9nigt0B>uF?1Guc)DcYI~&NT>bCIysI zHVYdF-W0ZmaV^w#8U%th6ow~nvE&3_IW}bX-8dDM__bqI+$903I6BZ44sVxV0de$Y za=~+i_xgKesk8{B$k$yU68ptRJBf);;8sFsgpl`A0XQ285n71(HFNMAjM<&Z0$OmW&@maGb`&2n zfaS1OdPAf*BsXO6l0b*#$DLT$K_8%|fw^Rw$$Kbp(s$XwpkB=N_@b8fE-JVMHkzJGPLS2$$obtex_I>@jdFRYUI^!p8jRXCmlp;F0 z81Z<9-#!JyglRVYP1Ecv9dgPjqkgyF{mGS@vzOB+!|Sp4*Vpj$lmbOW9V;1E0+N~i zmHnEboQx4YHu?4+hp(^e%Vh-%!Ku--_lR7ILQRrDPT=$?qMfymi`EVHYdI6|1!VtjsnD?AFzAICh^YzG*Jmhq5DA09@NI1GBVA7>UayQ6M z2`lq%4^1kq{Z+x`o?8b8Dp+2#r9#s9~zMQb&d16ycbQ(Zp zGY;-PAW+j7v%3)xs~`xZZVwoqLxxb3xsH3nfzFwl6dOvl3}w_t(NzCt%M zi5d`140+;zFI5uiEY;E3>1t`C@8QpCP{F}&Nl|6`XwL9qy-oz(e;yjC;z8>3U%J~p zhAdm@a%v^>iuMWWFlY0A13_6y?97Hn(lcMdCa^2AT9UV(NZ0CZITN-vx#_vJjyr8$ z2PYE4bX*Rq)j5MILkmEfAEFpZYrBdjTZM-G0~L5lxhIf0+?OPxOsD4B8Fu&+oF)~$ zlJ(u)@j2dQwhPgOoW%UutHlm<2OXGePAIydF8E`Dnf8{Tl<(offYRhisdowpOw7Os z&2%GzsyXNwE8iFNi0B3Wv98j{4 zA-c`A>DP+S^P_&`CDMzi7yDoYwQTkO+j3xxH(QA%Y(TU5@Zx}h<^`Wl&sE*UAds%5 zawXCPeH+>~^rQ2d>j;MI*CtcsJ=Fvzp;msg1U9BaY72GRZfZd|VL{W`p<3yDSr+4`h5EI8pE5hh0fDObef!zGfz31x8U{+yZf`rSUs{_s?ciqMxrKY z+je1Wz&VTxV{P9IqI$(m9gJ=e^o36WIviW$_oCB+BtxIO;u z)TbiF%ITh&ilFRihFDp^FNGS^&@zjlecZM_2)M(QE=5`d^a5M+W|@~fE=WbK%#pK^ zjI4Co>cT>#9fGFO+HVeEv>PUba+72|dY9aH>0iUpdgtoj7QbyWS`w>}MfRHGN8YOA zJEud7LFHm$jv38+uL_BdsQ|y%_n1$k^a)<0`P6tcj!LyzOi62(FojuFQ`C<&qNKL=MUYjjV9M}#)v-30NW z&X-0&Xf(>d+#mE10v29&+M_x)u-r@R%{lHY!|UOie3$=}DuxA~+|4*Ybpql@OUd zSScrwFbp$Oum5^Yu^#j8=1jfIykmLvR4(=L1iag?3n#XmKf0q9(*`Q}QgtGct;3=; zFWr499m{T}!?`@uan)h2zEl!iZBnl-?Wgq@*2BO>rO3}rsJ3GJc2);-OOm5qJPc)} zkgUsX*@L0Z{9qi7Tgy7T>Q;K!hYULMV-`N0ZFXO$4_aLqvS%|-9P~5(;gcnhNYUQO z@<~30y_2xUQzXJ9Vew@9TXZ&12}PqHpAxYe+T^wl)lBrCYM%T*#?E0&6d;STY1_7K z+qP}nwr$(CZS!U3OWU^9uY1(BRt;(p-w-Em+_QJftX^QV035=Ng0Sm_`57JR=8|%P zigCX7O&AGW+j`590S%`Ys^z&n3!#jWYiuzVSaL5!YJU z&YS;lJR`6i9*}7i+)JOq##}|qZiO3MAK<|Sm3G57qtE879F^jVX)HT#3fFq2q-1h>e4l9E-v+h6dF zOjN}%#1WwpgkolPY1>iVY>_>;3s@^T0twx3Th*d>&KmC8w!R~W!^*gq&a5#FfH*~4 z8F{N91Y@k&ZfoWysv$Lk84N1Ah6sU+pLk-KyDB@qz=0e?G-(a-TEE_0eI6IFMwc3lY77=4IuT@ARDcfc z4}w=R{lJ$>)7=Hz7)v($v&)4aufvi?He5%;4YRhX9Wwu3GU7=OVhm(TCrqp;FG;0P z21I+e&IiN+-{3zs{eovrIF1B4((#L(5-ttC3r^zQH3<>bjE#b=)Z;19i!MH}zd4o$6UAu6DO~55Z zRihZBtejzIlflqHL<&=32Tb(v0J}3r(xtql!N>6wm|fo7q*R+$=OxqD-fAte{M1pN zO}6J;V;_}Gk>c_7so@@brbTy3)kY@=rGS(e$2hxz*?*1Ro5T4-1YM5 zrlw6LdV?_-3<7duGWiVvZ(BE=*`QZIBcjAX;Q&&xAnSY?j3FryY!8rie1UH77PuXd z{VBcfBy$P*@ltXEz~d@<-bARH z(0FNilOT(s@B?IOznAQn&l-m@J*{Rhi~X{w!$A!?c5 zeA{+QRLq$jjici{^(Wn~TF0{?5ET+A(BG`#NCviS0dNy!Ap0Oy+=4@*ZOfLCV*zPF zTrD9^M<=H)da3SxU5*j-X#(^(U|OhV=PWBgrGIaTE+{#v{=`yW+S&C{w#(`T5ldt4 zY`jL$qwws`8y769UpOujRgd&tNm z%y_-tPFHZ~l|nxbX1Ae863O#gX6GY*lCs;rwPsGabVN3|V|odXSt@S;6fsY+Z!=vH zA(QpW_C|<*VBXRii@4*@fn8S)SzHJ!lM0s75lrA0XaR;4bp0$u2(9v7@+Kjn`7qr; z@M_4VK`c#>nLu|AA}&h@c`MPU_3u08r}mn!FlyRu-4{bt@ey4ZJ`2t#o^+khHyCM* z>-#1~6(-`t@?{yL0L1obJfqI4q3SCeWS&x`iJ_E>OXm8GZ;vekNwoVZx-NKj&R5-G z3nkh(AKS$gWUq+1`yLywe*v^C6z}>3t3bBM2mpLc{TNB(Tc>0x7s8`RfM@Lye{!yV z4Bqcvt{rxWaMRqryfF}RwCJ)w^IkG4MCbW>C0P`X)wQ1*!@mr|x3%@HLsTB=vic}? zzY#eoJS!8{Gja9PFOfZO07swC?8X%X6MCV{N%B zA_#BGy@|iNX714K=-oV2&wUFHl8i>#y31$O=HW% ze*2h(Hh=ZnWA}o2EZ`};4@2Mr656BI_1XC;o5;Hss_bS*UgzudLV)(ew$CF|%|m-~GEU+% zk-Y-g`(DTNXo<+?CchmJj6HcUh|$NAV?Z52KT7ctw zZh72yvAy;UAdhsw0~EfXU)LOq-BMmFci@n`ThFy`RBmu6YpBUx^|$-(M>gOX+*;Fu z3EA1aX*CG<>hVYs{Rk3e<;es>LM5Arg*?lnwDf3QM;|l7!@q*D&+iXA-yeGKg~q!h zl!N4Nct9$|>!L}W3;=v$PB@3u7}a>;Phn$}SNq~nh{v)QGEU#qk+9-bMl;J82Op2l z=IYIKE|v^K#(|dgDP6|kRrKhV2QqrX*H`J6xI#QnUr|>D3mr9Ny^NTn9S%o?n;)(8 z4Q%{`S6o_{-h$;`f)eVYj$bLmj52^G@II>$V+5^A>NHoIq4&Ry&@~w}w(FLp0rJ^Ev%y~N+jY+B{vse)|1NC1 z3(AqNje5KCp1eBWSNQU??4;g4*qbwQKUeBVmDi@7d*D>R#X49~WzvZ{sRb#_Y6$?K z7BU==6s_;?WTLSoaV{1ds{y+Su9#wT(|%Bzwi} zX=?G7X(Bv5OC0_wYSAj-G_=+6940ZPi215S0@kIwKe`ti%ZlBqnkIb8&}Yuvo4D+( zM{HmOtUm1xy}Bz1O!C`A+g(nKuJn;7q1~Qt17KBJ=6y;S%-><4*Gj_@lr!T}h7`7J zJ85`dp|IHL)tYzH`9IJvWabqAH6Q*@3`Qmn#{ZzF)oM+~9sYB$e^R@s02b$LrFVK_ z7sDC@7+cBN;cFnRh_;AKl~h$v>)%G`bf_vBt&g#UQKF?LX5Rk;hZV5>ZZyD#{;rKV zyos}aKAynGXXE>yV2ec-$Jye=W1F$dAdp|5+~395B0cQq$NO(P3`Q~n^~JjT|4!HE ziUbsM2R9u`k)z<9~ zH`>k}8IqT7_;H=^oUkx%jY!&gNKcwnUJNa}BHOyqr%zW>!SjdUGLS|v005Oiw$u55 zPZ~>Tjwp0^-QUqC<*EMT!n85TEB6}!@Jm@lJlIOvSeIKm6s54x~8D2RA8hnb1o~^L}R}^M3Hn!{Or#nXia5yd6(yzAXOOUgd z(C1+QcsOA^T7~qT)^tmznq{M5k4BJ;X<{c%aFzo(8jt}Q0=x=1&U)z*2GWQ5R{+F& ztk}D>lT*rFx;|F9n&x)c!10$)=~Y<-?3~&XsB_+veTl0ess*`f({wdLZB&7QP?E9ZUm3L9 z2I>ARq8`o#eZ`W9PpY585hI(Eq-3&bj@zt5e`Yy?70ppij_AKNx=tDd(^&@l2xrkN zSHuL9)h$ceGiEIS_+gML;xuzlb6`(a`=#eX52;F}0+mAfEB&dG-w`+$TI^VFCvxf) zIY*cp1;5CN)6$46yXVCUl3{k7A;L^s4EFIw%Bb z`^mfF=(jeYjX?_%5?1@<z$LH(TV!k<51of9WDZJ{Ym9xPNtBZtfQ%Wa zz5nlEVgiawgBwI3JGFMW@s4+1*N5_n80|V@3+u;P^7@Rt&1E34gS%pus7 zpC7k&@dfiO+f?2YvM%)Yt)d4t+<>RpO_ncf?5U5p{DFuJ>ha z8Ydk5t4CwU4hq5VyJ?3+jCB(h-P`H*jR^-jX*Eaw1QFaKB>Gmy^%(`MgX$ZG)?{e! z)4;+|oz4Mq7v@OL1!;3}k%gMgRqYiso#)j7{1gVoBB{ld3fLk}ms45!l15##s(c?_ zyHdm#zCkcd+_&JiI;ok7jIRVFJEERIdtf63su}Bq!vi96L`6W{fIBVQ{SC=37=Z^O zabOV`0@~oi9o~Klh4c<w}@kpuWvLtW>q zAgzkWzcaT8%*v)+&=VveWK8||od$xU(w$u9CYnOxdYgObYbDxYA@K5XJSPW;I6%>keS@Y@d|X5Il=z@8B`8PX zUR`Z-VV29A0NRUkMAv3^f1*n{L6CnRpAuAYzFg8A?pA~{LMSEJ1Lw4xN$|Sg6(BMI zh~lf_U-34MW?c7>NH958>u9{DwBfG6{DSll23|@MH`~m&ktxN}F`9&v?8A6@2(3JO zd&x-rCKDe@HP>IylI*6OU{S0d<{1gbwbS&>k*pjVw)6@G%U|L{;}sf)n^yRF;B0@@ z=dvH~dow$hTKJPwZu@kxdt9}u@i;ZUdtcgC8r@g$hSmN$nnXJo(dKpHpYx+|BaZ;G zZ9r0U=wyjKL$F)TY=dsUQHvfyZ*Jou-qE&yev)wvQdMxKbxyO(I+!aqM;Rr6}UKjxgeMFP{NDQ|xc9nLV^ z`SHNxWdwj{cPPExQaLlyB`k+(zl%2PE`%6!uG*Y_{^RO=6(wM`M78{^u?ydymLOpU z4sVS~0aIT;pQ=tXzkk^3&r)%G2MB=hS9_)}7gaQeaR|8_Z|V?B7DTIQm3F+0SDbm# zZ>8VWpAp)?kD<-xntzmtqeqMw4os0TlL ziPEK}JHH1N3!Y1aeHv+yqQ$<~2(37un`T)U2R=>yR7(|HF!B$%X3_=BLY>h^Qv9y& zFH)~FjvTCp6iV((*68;8Eo!XK(}DF0;r2vO1<#tx?95>La|<=uE!~G$Y)Ydcr-caf z;B5VOG{Q_*gi}ayhzDi2^}S0~m-#MF0JfsB@wI{L?u-JL5vDkC)nI2B9Y`M~<*R}N zs;$rRYLJ63*C@VCsKE2?B^|x(N{`EZbS2yxAU`LkrTkSkR$6Hl0ak#Sz9PY}g(3^b zzP{h~3XEDsr;K9Xz*DlZ+E7e@HWVmBX*4Y&+@!$d@5+$?yhl4-zy9!d9i+QhlJAZ^ zs|Y3AwaFGhIl&j+T%~`h4}NfQrI*_2Ul7!h+U>SuMwg7kTj4z@$a9?>hUoqB%~+<2 zhE`T;?X#(LtYL41n>3!VS?o?HZ<`AypR4)!?Ec>y{x2P|jQ*Z;v|9Qrq2&8UdyJpQmf&?Bc2$29y% zp9N|0z+2_NaO$t7UW3GGA8lc-wq%&!wl&;kdC^4c)r@&=MUu_OVky_xe+;GL6h~@? zFqC0gIAa6p2;Hkqe)F$XbK5{cy3k8?FN0hX+1tBkmv!4d&DzBcP{EBb53I4}jp zX5&7)AWzQ*DQ~&;G)6#~8ey&olt!lGyn%LDNBL^Y$OmsZL|Mey?3Qa6ZS}VE#J-0{ zSF7Y9Tgekz>MXgaPWV76NGW-pS+;3~9owzNoBE>i6(dcCFiQh?O@PXvo=q})uwm0x z)KvWe9-^Y(GJ#1P>@huv#VO^CjN2b5NjZH$L_sT-l9-uY^`RB5lcGx;nfD z3JQvU`h|cr>ISVe)j>BVc@MJNWggM45SQ_|1AE7tYPt1y_u?z;QfWb#h(?AA*RP_>W?P<|+!eY@A)qi%sFDat3JJ1} zz6(I--aZ1){LVM|yNB1y_<8oDc@_j=0lPNFi?q)l_T$yQvx2ulbsgX5`*`;GFEYh$ zdTdz$eE;rzEAP9j;cj>Q9ddjB?l%vg4O}+N+qrx{H=a2?Up>>kY7rnv*vTB7cwzJY z&&RLtYWVzQ&Qn<-h7xv(#~-8AlVplsPHpA#pTY?ZsMGu&wy0L!{-3Y?ZFYH z$VVxtQSf9`eK+^WP5zDK?d_M#Sj{{PejsTD=!ct7Pu{<}+q#uh^={_EtFXPA{kCPb znyJFSwKuk4)#wPPFYKcxC7k^+Kam(y%tFPth{*&fCsKqlDm`w^>RUZl#nETU=bKLz z41lPq5dSLnZuB!!v_^k|T>koiWGL)c{X}QZ94>R%ZYihwtA8NB9(yGS#b`aIrmnoF zBNy=2ivA@cIbp;|Q9@_xb&}U*YAw)$Qk9K)YqP_d?1?Bo%o^%oF0H35*Jmhnt!xBH zrSbDTt)4F8I}kPG{9TmcUMUA=O&8P-Q?gyoa;;}z7z{A3;KiW}!4wU`MIUPVdsl1` zyNo_-r+?<*6Z2FB&K#5qdp*?0z!9F{v0>kCtE^tgCG8N0;RZE_M6-+znKa{`iYB1$ zYOY}!!LHdB>}mA|zI6#+BMmTR7~u3egKc94R63*i+8G4jX&O|>8B1k}%CEo=0#T3; z0bcLso|SqybOIg-)&c!CL+sEkvKVQI&ZHP-aDYl8ZKrFKS;T^h*ADmD#sq}x01$EX#L#`hg(HuF zc#e@TGy6N#N0QK8r{$5EmNEbfF0`U>!(H)*i#{kI5y;?fkW)N*;|#?t=4qmOn}KW3 z>9XN&A-xR+vEns`cFSdPz&==k9ejiX_{8?w6n5AFZ2dN=&f3mS)#bdCQklV7Ve{6C znicA{nu`M-K?7NQERKQNHS%L}$iWek_@PxISOV>UF>wr_lAmn>iAu#FDHPvlK#>zX zFFK%@YwxM~Y`6_U!Dn&^V{pQlAvHquUz55!?_!55a0tV6OjC;4zXabc%@=ZIeb1Zp zz|WeXFKd|UQ_|kg`~+BI3of8R*l-x|cu#bT#0_Pf(ugL%{RX@^UoyqH>5OLplMKTW zcx|C$`5N6v56)KmvU2olm@z@v^`wsKEt5wP)~NK&Fn@W}qZmnTQ-#$(qBHv>d*g5K zdX-qA$8C~0wr^#hLCK%*_Nsh{9@n_FmPi|w*_F2 z|6kmKV9APxa7BO4Uxx{s&gEAR2?z%Q7SLxMOdc8cAS32}D2zv+I7q33s>~m5mN9vN zO%pKi>MBMLkRqO9Ii=%rfdmptmXjD7!cF6%P~!SM#Rdul7HBl8_x%%#bLk9TXh0CGF@6mm|e? zPct{bK^O@ik3fjC8rWiY0-Nn;7pkU*PtB|y03Ib|1cMB0Npysm%;STN0x0tVMmajc zN8{|z;|NN-vXevTtiG*NyQIJac$veO4zWpx^7a1JRv`ublH@T;f9medQx%a!nu$q( z@gzYZcW)UH2JY!+Sbnfs}P@JKJXe-La&11jEp52|e;5GZF-HRzyjTIav}UPK4vpk9<*cAC`g zE9&9nD@zv;I1Qy?#6vbs_+)*4ehxlQjrsJ>Z_jC-9K|BQ;GITUZO64WM0>=f9L zPpj}rpg@O5)Hz@|_;oAtT7lA0Aed^W+Qq0Upd^_pX$ApE0G~t}c?6bN^)K$O$dx*X zu%XJuv(0o>PG+wq%Yi2k?w zgl~~lGqA70`lsbAvD)B`$xm~jQ2F>Ce=gz}M5lD7UQpi;xtp7%6Cb9^fe#Ac#eke! zN!|1)uV6oqCw>~GE;mUTQ%>D21%(^8#}c6Bb72~ zclEwo5R@8t((l-A{C+PUMw!x-#8kV>M)~!6%SPe1-8Nf0)E4Jk*B5VgyG?1LELwLj z+$bL`8p{1%bBG&3EQrt7lp|Fqq3URArEB*ibVPUA%ep%pZcUZbl0|2n(r|#W+|lgDt+I!#D=ymDV~u?gvww-*++5IG36ppr31wkV+PdlTi(vO{ zhux54O7v>t#nlG|1^kA*O+`Pc({jhZd|~t3^PxjdgW^PwIUw4np@v3BH)&6Eatuvp zVfw@_-o5peYHwFlU0Sd@!{KEu1}~2sTGGCpg)`>kAMptoXEC*skzQQ{dk#R6XCKv3R&Q9e>NcGs9PZ&36g}B1+(E8O7ZLK`Sf46Y4<=M1Nb5EB^}T+%X;~zE zz+tjV^8P#f{Q~BBh9yjuhF};uV_pfq3>d%W-@^DTi)?~MbriUs{Vfo<<>ptYe&@8Z zI?HQ&CV#f3I*emD$|1gFMpG{JJG4>Xauc(vS6`514ROJ03*)}Br=Epo@kWDn!AIkr zCj5bLN~!NSHtqBTRlSuJWHYs5cf0PwPSu5R_XO5SRlvuxB4unAtR?sc!bbb5=0d3O z;!@{)*{o?M3LOD-fwlBJ97K`{17Q>))IMl!hZ#OycWd`)b@}2Y3r&s7bA^Xh8qA8f zX3-X-oGK*O9EI6_UaPwD=LELXPJ&2LNDq~dDQga@^{)l@98?6LcI6%HXLHkz8~;{kF3F!*!NkzJIY{~1R_HZ1TMO`m zRB_tc@NPPsihonIrYC3Y?1Dt(H1eGZ1L)GEGbj7UwOr#gx?;@$aVBURujV!U-nzeZ zWQgG@&f_g{0Q=k_(dkDt$9d=YexC0S>FW3M^mP8Q`uaa_^$8iKQzM;(l+BugWIgdj zegZLnSFD?YuYnvk&9DGzg1gmWT>-%M8p^`0j9)ey6l5bhfjD$ZmV8{?OfjwjK5!p* z1xN3IshTg9Y;M5X)CyeZR|8o1v=S{2KfI!~KMmn62O&Y%9d@%nfV~R*guKCDluYJ% zN^PC*fZtRzqZ9UxAW3D9l>_T@C;s9%QmM4`#=9dwI?Sn5ncXR!eEdpKJJj#1m$ z%!gvXZuh-{8*m~^YKqN!QLH62%%09Kz*Rxie<<66Y1v)uC_H@KTixS1XlXihzI7-l z=s;50XRTtb!cW9WFZAa6kgBm zM3O+tPp)Vxo)eqJX5lPzykpbWTa+MdENC%H*3(NHD#{tC1Y#(97)MIr^`&VcnR>KX zA_*XaJ^us)0&Z2htBl(tLpgB|vs1|)%xW&^0#CO!FNEo10dQBnHOPqN+5*EsIp9F8 zISSt~xLP=7%;OL~R_JeVd=kwXz&AH#t7cw912Uj2wr#zzlme})(mKTIIRdH1(UNAh zdcCqzHPM@_w%e_VWND4luui~RZmg>gqDcAu)J&)G`ml z>*0$qCg^D{&f``q8mRNXI4pZSTPvawNHccW{PtoFuTBV5hl|E@pyZG{9N7KeZ;1J{l zl)X`mzehYzoJGWNskNU~!);Ym-3BAvbeV9fqs^qxaKInQd;5GeB`n@?y-rB1T}@r^ zu32r91w2A)g7#3EIwlll#qtu)avg){Y}5|bYs4L52BRSMWXop6AmUcJts&p9pW)=P zDekfi{Z2ZjpGc$8Q1dF>J^zef;Lfo!Bv3twAjvI5%+9ruMKA@dNHn0SyBs_-6SjWR z2Hb-L?CIUv67a01zL39%r0`c0j~y{${>I&xW-U zR+;I==Ja>!zn$n$KwK?egg;}_RbLM7r9?*Ca$<5_)Qe{gLTGL(;*OBl=o%dyu!ZiN zbs zG^a5QIvDOx;K=(E0(SF;IDw7_IPkl!+x31znik$pm_0WhGcq(AnUYGHoaKTW>f^-) z_O0+d=n?e92WPem0*)5mc2?*qI`pP7CYN{2Y%XtH=?mHNJ0 zuLNh<0J$hjYvJax6*rPKl~g~Lc&hl{z&y)qWjl{+dHQ2@ZzQ|YQK`@KETpgtHqIS- zEL45%b}(hGNmwXc%*A^mTb%hZJVa3+2`oznloY0mF|L8?IaqcRg;JAwDh;nQ#DezCUzewT|YEQ$6jspOE3#0pya(H>+KCt~Yaj9f`SD&>p2oXmQ`CB~n{ zVM~igq#%TV_G`M8^Jl>MDKqZ)Fv7U?mQrOS&;>?HzR#dvhmo{-U1V>K+=QwyP)+$e zFFky`cY3Mv_&LOgp)FYLD!&$(#gzCKhMKFbCHg! zt@t*s#u@&5X63Bm>)rZs0<6y{#j;}K>e_8I8UrSy#2wi?yo0VCPC(e5Cl)1xLLjHqo52~S(0L+H6WB6B}INW2lpvOD4E)P#V&?o=1aWbM9?;S zw(+KJLAU51g1-{5bmuYsM=cAIn&R8UARVAV1fXk1RuV_Pt(9KrLiAK5oiWrTM@hP= zL{es_9P!h8J$~vRA>IQH%m7k%vE;tmf46HbHyPhCf*3+|bwJEg93lc!glSOV82j4) z8LtF9Ju!g=C1}%tvAlh3|J>XM7};MTX8Wq>hq4{%?MAP)C9HZzkgqNK1U@LFf1cm0 z|GD8Jc45HUU@zZWu|*kzPHI$?>D8|bnw?er;{hJ zK|Y+iqa)KcGl2OyB3a~^g~Y$oU9q!gL7-9jlewcCnU81{tah~}Y!(6z&bg93w~Q`9 z(==)VjBR4v)Vlb=X0gkui`&vIWF)`TF-$W-vG6wPIR*q#Yy@LW>5M%VyjaAb3eXe< zp!^7gB`+%KR9Qw>xYZ4U_T%z$`?9DjoCXX{5u`tJVj=CBHAwl>$=v!0_{U<4JnB5_ zOei1o3#Nfq!$v*sJ(Ng;qE_(9_p%XnB6VF)q*PfHggy_AIv*+pnQ{ERlxmE*NRtgR zg49akbF`!mE@qG%Ko3Ixqkgvb6UUD~CA*D~5l0#`_$xO#+_@102yDR5fCF#t%Tn%c z#u^#g223VK*5mJTEhU4S$%6s`d*J)dm8?uIP(^(fLS2>K5O=|HaSJ4#h%@A#fE)Pyi^1+7SotgxZW3_3T(a=e2P(?xMs1eYVZES-=zNBwP%00% z^Z+L_Sb%oApq=WijP`m&3(@Auo~m#z;YamnuO>qjQ7A%l2uJlugk~fstOi_1@ly@A zr&a*EG*1JiUWF&%4FV*=jP)y|r^WjGp->Cdq!~hh|4kL#=E5E7V~QjXtuI*{l;DH; zJXES*MZCWESU42pKNG_yr4C00HO+Faqltu`m3L+(v3`X>ggqbyK0yT+c%2{|8fg|d z#7@dMT%c4mC>cBk>2hYPJr$-r&hP8+>Hu-ikajgfURi zG^eT*mb(>LD@%|f^bvf-B2H1rSQln956Hj*U8v*a5Q4xNWML}`SlhKwLfR+ADzH@T z=(~y1SwRe`2f={2F9Ga2NjuSvQ|itNpt@)y+!_?LE5U^fm=Ai_XL1tWWeA#e_n0M& zKTxvVRg4b6=qq;jw7eU942f1nOYQd)YO2RyUx=t>z1gTh)8xhhgA#+$YBE^N+5AHb z#UzMUbj`)bUI2iFg`v>e^6!C|&+EKGZ^m0_xG*S0E%n6|AgqzFIFf%{mI^4g=xldK zBvpYOnC}_F877hs-(3x!Za+OEC62==R>d?DLP^D-WF7Zk7(%%WA&e5} z*(h>Hl0&&xfTLlXM$DN!bZ|`tWN^&mZwrH6z3M+OuOxKAxQ>t(~0o|=93PE6IzY&ix`NT13ZD_K9r{J5mjPhIGU^DE7 zG!O>KX&mjejC$1dl*ndF?l+gibsGfbYopC_2z(^h)5-Xm;oj4Ks~aqJq*79ENh^t& zm07PDM)3(Y1PVbPoS_Sdg2$TU7Et*E2=nH-LCk@2FaQZ=dx2^TK&1`-<_*{pJXU|e ziMz^>!{!va_J2}A%4@U_qdJ%?5VQ{tqH!zLu{^zB>GVl9BZO7Nf#-f7QVd-%+AgmD zDVdVP2>UTF^kOie1;+1j47@dW+OL?IvA@m_8k=ODYgGi5UjKViRkxM zhj)0!f*pd30E3)RsvZa$m$h{MW?FZDF0x=$r`}>Oi{Ul7@4F_va(nQEreATEDb}|U zI%^!M#ZmTVlEmzvI!GF9V9>0NdE1{d;3&i1Gmb!RD!VUY`M`9DRrHiBdCQwAi<&-p z>*d@rUMfXrYaT*vz`knTZ^_0@%%X-ul;N-+_34n!LAjV2V1s4%d40>@_jyBq`}4MQ z{d;opt5b;G7|{D35) z!-44kxi8-C0lm64#oFG{bq_{m{d&Gk^IZ=yi5CYQ6Ka$uW>5W_0L!Z*gHu?8H%EYj zl#lipUVp!>v-C1Yr2HAc+W&n%ek%|2l+?-*5*o&K&>GjH1-z=j;u+19%OqdR?4ozW zfrLwZ^0S@2PjOdzxgC6G8vBcb!$6eE(-?F(%-$C0EDsZ{9Wdx(rsV%)5O;a>vv!@M z@rxpXceI#E@hLsyMCsr&Gle1n1UId3*mKFaCYG;XL>dnJ@Gg@mUo>HNzrcF?UNx_0YKT5ZeX}g-J#o&0I0t&(rk2br?WH`L7Wj-lfy2b&tBMN0ZaP z1t}&i<%v~m@A5n0fauV)Xj#fDtVK{f`m2Yd) zEsK)o2#p@orRdQ(z$cGjBuWJV3}Qgl(_Xb~+%B6<-*)Y_?MfeljKJ)x8mgx0@oooX z4wn0D^nNX?`Fq}{@vXC^^}ESlyL~OFK)!X3#s7zcco_K8xEYck{^~3}Q7nd2^W!KK zuekIcCobn`yDFVghm%|jpeiI9E~omG|I5Sk{l%W&lX>gdy}sZ7FZ6_1m4J}k>_pwF zy^+`;5K|tlTvid7YuYY51nphJ>&r6`Mi}Yn>H|(Q4Dw5F&J={Z9r!j}}%UP88|#zC1?M%L0lvex!Yz_GS!Km&{I@^`*ZT z92-QpRW`g~sPaN{&M?+*#YF51NQG^W%q zY(d&K@y(}DO<7|uSPb@%Nt%H>X+-4F^WcWZ7=|TK!bnI-R??x0gjy@0=SF(w2sOU> zmcoDVz74ixTh*3lLb8pc5Hn+MWw7g68 zW4NPGVZjAe@HN`JQJRDwcp}Fz-x3^I>Hjhjd8CV}HeT}b-auku#rt&7J4{UGxp_!m zS`Y;UipjKr`sugxs3x)?b9s6KSBD4T>hkV^!hYXZ_irx8igqpo?z0-84iT#nx>pZs z*QG$h0MUspi7v`K*Ys`Wgwmh#`p7i~-Z(dmeoTuv&vso=sdY%b#@l8+cwvt!DGpWg za8j661Kd2L<^{?mYmu2=&fd)Muf2Ex6oteolX1|=S8eRt#Zkv3$!;M5?<_jwQd;^2 z(UHM1W!{Sqra}P&CdGqqO0I=4>PKRa^2mWY#7^yqB4cfEu|FmRV5Yjm^-yodqF)`L zmo*=?J&|-lLFtwp!mirycLaG12i?-~AO|J)-Mn!h1U`ZFF|$XJ5HlFN_*wQm5kWB# zlomQR?}th5LMcs}41~!UBty2#Is@e?+Q1elg3nqBH4nkY&6)ZVXBRVpqb;63#jY|6 zT7rP4O`H~|O$ydxOryTOff(z;e~$mVxgI}en=MiRsV}OBjV%t_87&ufV6w?!V#yWo z#5~=u!OXj>-2Fz9l^ZPi3P!WN%*_=AFxp*rNiVXIS6#?;kw%t}MV#JSMd*$fUSp?- zKr;S-lurTQpd5^rmnzx40T4X&)R+96u$t|rW3(C|h-v04oK}J|2rtd|qA#upWt@-G zqj{pQ@G%T-R0gOcIIQ!WL&Af)E1` z^VSe^YpblKb6fe?y#(9?n#ccBnj52f2(QXrSn1;Qy&-%Z^`PhTd(@$SeyW$8n);w)3naos(kv71J;O8Gs&LD!S99p(%+F(3#D0$~ zaHF?-ah<}odmY5?ytmnp`q9}qFvXlRGtfjlhD0RC%wJs@LK`nkkEqZenlY5+WMym) zaO^5NY$UvrAvxCPK&|>Kry&EwJn!FM{>~&b7p(SMo-h}H|J)%wNvt?vxhzb3DnC^q z$O_MY_@D-tOGreENh`#_Cd1hsQ4vF?8Dw!e%#GT{l&?5PLChMwc~uvIRJ zgM)Zo&$Y;HW~2ouT)nBboyYBjnt_ueBclUEdu! zRS>I~0^_DzbQOfYSv?j~3*&|0;hc47R2=P~y}_J#M$R&pPU<8?fvfhqT`%o+(t(IG zji!;xK5}h!a=Uwbfi~ta<(2v^gP?}-a~?jo$kkBqo<-gBS}>bEYkn6&VLa@3nMhL! ziW*`?ZokKe)d0rn`UOJ8cM|L@@mU@qce^#{;bDZ47{i%)<|~y{ZWB)z`2i~#8w^|d z7*^?#l5S&RK$c~GR~tVsE1bMuFXKW31On=j_mJD$#gUPVo0EyC1t^CXKi6Y^ ze4PBe82AUSJG@@}&(Gu2)iHwJWJ1c~4!GZ%>+^DlRV9fkP1C&6J4T5&qqVRX$49mB zl^YzA90HmKJVC38>9LL=*BeKEL-Q!=Rk{G8*13>@BM~E1G1$VY_!g@g z;o)5aE-M(;J$vv9F_ZfJQxzDy2sS!H$u6+1O+s6(M8kS13M6J*810&m7!k>^9+Cg| zx0nMSYpYf^EfJ(^dBC08pI8Yd3}-Q6Y9a zJb|9ppzw&07WD!7rl#V8HHZD3kZe|ShA5F_=B1hgR1iF#kZiM3JO_5whGr`jvlDqU zGWWx&x7?r5PRkyZllf#CP$3VdN?4T#$GVs(nLpUf`uRjT%OrZ}Q!~<9;rKif&a`6B zBakSKe+q!oSvj5?ci?ZY#YMi09IqXD6zKN|fJaQ0Q3)nz&UT&ZoJ_+c4fF1WR{wB+ zLoZ>sdyE4DcCMRXR+!!Cek+J3>d+4mKo?=DG6YZs?Ged(`N~XrLQlZJOnbQ`W27mW zz+&NqQb1)!ViA`V79oj1M1Tnr(39c83amg^srKq)gZ0tJ^GXsPkeeozs*; zEXOp?IUEB_Yzy)^tup<1LUQa*$nv<-Z{Q`&90`e5NTy|4rDJx-M_-aMS41|W;5-Ynl&oCaI5D@}b zYnTc1Cft2uKu*Y4CE4YmF^m#QYsP*~%JnC1@dPb1X+#RbVP&=Qle~Y9yB4QZE||tnr%Op2#M3;yjLf2emG zJfp|9C+-t}=}K1z-9cX7kqw!Y2O` z0Pf4i21bJM3*qeLV79S3;C)yhyKCxQ^~C`XJ1-Zv**~bJ=S=d>lWP1Wa^`SfU%!TA zw=*8h5YAB84|Xf75Gvwl6F?0fpeyC-kIKu4yFv1thhnYKk73fUal2CPT+@r8<))HK zHChY1?2OWhM=DlC_RMt)g6)e<0_9!hW3_b)LVwfiuD0r1bV^6w`)Cv>b=c*`>(($F zzPtKSb#VE0E7ndzQzwho7hK5g=my%d)6Y>cfi|$o9dk^68E_zPhIxdSmGSUVvJYbi zjxrH?t%BlYUDcfzfGFDR9p5*+!w>4!e^jRbiapQ3!tlR+QU9uD{wb61KV^DUge+Iz zr8ud%GC7Y2(>bz%cfm!@iU?Uxq?)(^x*ofeC&rm7prcT{4kQ4qW?vq2`j~Zt!|;g} z4?YMJjvSmRNJt1sDWLR z%cYxyM=ayujqZ%hUnC-jHK6oETP2diy+my3^g3rR&r5)jQaX0Y2*Jb#T#F0{B($Wh zL(#4g;IRxrb;YxTJQ0XE!?!z`@?=O9ITx*6Wf3(tf^%vybq{l7L0L$m@Z)<5gqfNi z6^@RY$PinhcpxIctGGs2-BullAY<|;gclcxK>1+`H>u59imI%97X9wyEjTzQDfiI! zhxmU!_)E3k)th39G#w4KE09HbAQ}|jOWPIY8WUxJE@CfWRuqfWewST_KYi3C>g`;Oc#V#Mz%@}MRU@S+Y?%cS%i z0wdow%Fw1dDKfiobB?hoD5VJq2*u;vIzgYTvGbyLyZ_o7BFe%HPOvlZ%?fgqOGGmK z18@~UIi4+fp7f*HYcgV#gfkv+H|*OM`7XUw4UIzvBG0x0u`T#0AUjdHqnWf(PNUs0 zm^d<2sX38N^-#|AsBX#aF!xX9(sfnhPHK2MI=k`ka5KI4JAkp=RMjw@07ogk&sXe_ z6l){QNVmI9)&st?8#=<697{D?xBV++i=-CQz9&n5sNs}{diKJ1490&C0!ATb0g*$G zwfh743b?SP!B8V(_XWk0-RcJY5z(nOoZeNZ(@H43pVbQqKolf={gDFoHFbj|-jC=9ZpknM2 z82)*D2gY&(yYt42upm`60q*>I^)Xv;_=9ONJf?`oA4wsOL}Bg~;?Mes+dOeM*d%7A zImUS|JlRA`dWp^udL;kefTt`AY%UG^ryJu<7->ih!TfCLA->W08B*RxRfO|2ZEGzD ze9f=vfDRt`S>!NMYbNEq++NS01@Q1r5Y46S%En7)B@HH7-fk`~E)Hx0C~DvxALn4t zplRH>8{D(IS?&4#>ntM_>6|2nB7IiXDWvCv{1|#O)8hwcM-67OEI(0HnfB_otq*T{ zlEHxhYnh0@dC9+0WF^owHmG{DTb?<59bA4*`BhkHC{>n~W9j!$q&4#%qOWIgXekKk z!X5V)KhAt!+JYfU69tBY;3OglX1n2cb|iSa2nrPYMCCtNW?_9a?pi@xB~9*X)Q~J? zL)Y;u*Iyt^!aA}7vn&3cXD(%1MzIWibIj3sGe0<{f9K8Q3u`+h8eo4s%|cP zWcVK9E7-k<>J-dku&QTlYHNjihEQ~{(SM8rmvm#@7vaDz!N7n~t7K$B0hW9-*#Y4X zXn3`trf?uY2N%AI-RUrxF@kb+6FSO<% zAQt~to@^J652Y1(^Ug70jSq@8U(>%mh8m++2VPRU-KV1b%e1IJ9kxPg#HI0-X{jU3 zBA{8@q4r!y=)P`mrqVpr1uaF9PL&Pq3-u=~1cUm4;Gc>!0ToyTG%F8uw-j$LQlo?1 zZA)JulQs0j6}**~UpXeL*5plRFTY^CmFIsK=kdZzdRB~9?-<>C~+HumgneF4J^w6@YUQEWEX2t z%{Qm^QPZ`Z<1@)~eiOmf*G|)yAh6)1U=&wyjT~ttu$_^yMSTooSxOzKZm{(>hU=%NV4w=wE+q60UKt<+ZolleA<&dGrl+UyDmz8aSHBIYp_C8()f)V#d zp>74OE+wUJe6v(6?H~G4x#8l_&d9z4JPb4?27qzaG8QeTGQjo?jB+RrP zxuV#bggLCFe=S~loga)m?0eC#$1+G0dc8SByOla`@$gIX7s_>tOw6>Eg9pyMc{#zO zLvPY$0rPPBy`F=6JqvZ^5^;^>@q9Fq{gvbS_-iqdvX)5q+OpqmGk~^>xMQnoRtS+! zuGg&(hjNf>@wo0BwaVNf!$gm(3TnF4w`#iBd$KZBtqF8c{g>kDHp&mcW^gXzKMhId z{|Xe$z{v8ys+C*Rw4Aa;k^hw+=x>7)$!%Qw4BR-6x?D$V?O{^g2qlAC6NRY*fy-;U zeI9wG>LBcoyv4GB)xe#3pMBzV*Wo_Ueh=>|QIy=_4P6yDxQ!3C7VQ zKg?(8`aXk}CCM%6@%$e?@Y1LA+55FV68-2mdlxg?T`XUE){b|_G?UNV&rowWLz&%^ z1i#Ql^+BmUzI?{ks1Y(Z$45)e)Z}^ zN3ShPWF5VFG=vahqn6U|Zz)E^;Xd=|x9?JdK}ikpzcEZ{yp)Kk!;{?kvINr=C?d2b z0m584TJ~lNA7~-Zsy>a5abKI z>qGDisG<@681HZ6rvww>3Q|&t1!CRplAeep>?&L2wtN)UdS^`c$yKT(q|nN-3ur?? z=ToXiFoD8AE+kuXx?K>wD@+)JP%K(f%1E5a#^@)DbPKq86{WDAzw^f@iQbd;&g(ev zATGw$W$)5g*wuW;p$fimQ2a_x9fLphpvS2b%P%XxaqA}Eh9i~}xY+4psEP{@o~o=S zdijk_Wr>tQYQVEYD6ULhOLKX{#tu3oB!6kWUaeXivW)Adl7ne&2e~qYEJs%0dP0Ha z=V>;`8ayL_1~b_s*V-e>3TL6cphKh54~X(JgdnHLfvv#)0;CLwOIR8plGSGL$u&*& z<6bf`^k0ff6>K{{>mdvZ_=TZUl$YE3;hn8KMfL{>lMAEVIGb%{2=z#_=5VO;l-rDB zln$4KLJ$*eKwR{?6dj^pbcM;k471i`(R31=IUtAh_!5FB2n&tZ7Q5IJ136eHE;tq?tCa@Wd03;7c@1 zIU|OZ)R14VwzjW`RsY$^wLk$nV|#h1q2)!J>VM70^rwk>{IwThw;s2(>W|f;EeRxK z1koja0?F6Qv{SLIb@-`5e+tl#Cb!+U*t3F~lkVP^C^uTnTA-_gqFSVhG_$wNbnyuI z!W#PAMaPIIz$#F4rDOB{yL2&oYsYo>Iy(JhEeN)t-9%%d{Ywj9l5 zk?gODcMeRTTdR|^XFHmD4pyjTo0^GGXH#xS48tL;a8CtTW=ObqE8ig;{uQip|7Mn{ znZHbbGSz|?J z2&)%6&&z}SrL6+%{n#IiB>M5KKS#<~4O@#!g2T^Q?(dugj?TwcAQTNQ%^Y)2q|_Fw zBqF9SH+k97uVua{`}e8uo_DDCnspsl2GOkp!&6w&f{umdd#6_r_bwo!iPS<{`LP5q z>uni56>nc|e*uR@LOK59wEVAFqzugT|G(RDExDurGcD^|;afjDO#sdtYK_Z9PVH?8_ zbZOkb27-YUfshfW?|=w{2Nwii>9@8+&D|}&j3)oT8)eM@Y?K%ZD5V)c9(a%#rER5= zwPt+a*$~7TKxD6t`_;amuYu}W=-TS=4sMjEkc+`xO8&S35-16YFgA z8euAIVsv2=y7(9dl^l4c9rU{kCdjILz4gU4+f~P051U2U3nM)m8o&a0Z(@$|FJnqL zP^-U2>;JQqlJcWFNye)Jc_t7L>Ox3>(smW}HWuj_fe$-Fa1|gfJg;CP5I(Wt3&EVC z^?_OU-Wr8<$w89SeXwoaVL*I}|ItK3OfTcLLJA}=lt6~IV45HdB@mdf4s4*9QrU>V zT=}R}KhE-2S??2JZvw|#y9bAxak+t8Pk|bC7^*#+YOc)eN-LR|9z@Qtxb+>cnt2bk zl)gUL2|bd~feOZD^RyIQ4%(L>I+usvs4UaUidsS9&`i z-2zPhGfa%<+#gpuIq7Y)(^)t_)M((k#?pnZ53WPp`MSk#1c8L97r*bZR<=Y{oq%8n zt^`VB+!a-B?{X9+#?PI2OKE%5&;z4LJWUud1a~>9#R{~v+CeqLXw!`1zEyo)2B$Xv ziO@l@G%Eg7e;*k*};%TKXr@~alq z2-hd992!S+SbMOJ4+Ddux-*|wE7mCKzn|T0%~L{?642D#y~CS6$ZE*M!VpAiq7A1X zI_TBep)01N34hVUVmL|xD6Y;Gzon9f8g-i1{U|WYEdFTwY+wxV^chw`X~fsVnLCu< zP18F$kiVsz4TfE0goKA|GNeEct-_jJt97( z`d2NX&U4s}1rnYLyF3*<1h|2^=7fp@96|qlpbAyn*GeMdUFy{v}2D;x>4Rmtn-Xo_s{(pSGx zELW(tt>FM}F4N_8+(unhhYWU_h_mz!!zNhuI+kZgN+>@Z%qD4^SJ8~d3K%&{)r^%I z3h3z#f>oh&J9APYm_0g#uEOVpWC!Yp>tzy;I}qUoe>wZr3N4*U_Jf&b1k$fH^|H$3 z7#g26qBcz#MoA!lip(4w40;!`mIxnKB}ks$Ld93B7|XApQ$T%TK}CR=oVBD+cAeGc zK5N5Ts_K}$T*&TQp7UfEepCq6b;3=_$ta|(#gdKgTQJswH3gsKoq1+--?}iTdxPT< z1zaJF{G1XKjvrM{lAvOV43|u7H@Goq@m3*~B4K*f2ZC zBZRj+e-5&qKS_S?m(Hfxp2mGW{u+R2tkK!@LqjGA>6&=a86Xkw#j5rF{66Ln z;dLVf9V@EirD^NEZ2tP9et*vJbqclw{l_`}Uor##?}V)qxiY;nJ%FGPs1p%BqrCX6 z3dAuG0J9lLz<>Gz%YTJaVW4Mb{J+03qAFvz&5F?Trgl!=f=J_gUKI}9Y~e^A2nPC^ z`iw8toH`<@Ok8tR?AObLZCUd&>1r1egCYWlx5wR^v9mAL9|ZF29uNI47uX5yy926r zC({2%m6QbDwJjhq(S#AY-MEA@Q0Iw4S_Si`AvR1if5V%e;ulrCw^RA zA(bp2B^g&n1_2M;-I2fA)aVQJg4&Be5Qa%&qPs=M%xgV4@;)d73=_5}Mi_NBLsX7^ zXebgDZe`sP`=1kDa;Y9OCYLB7Y>#|;S1}tDUxEAHo=eoH+;m5N*qW!qSw@yL5Tyeo zQM{JVl}%w%?J(DbP^whQ#`(fO~`dkHwNIsFM6I z^1|v2DwHzrOGru->%e;=QCxtJMymbYOHCQ=-0RqIXY0@280xiuorimQ*VI*S;k>99 zx%#l7_{b^fuk=tH{O3VQwY6hoh}v&j(jzfrb5wR7MK?A0bSTl~A*iHGCJ?G8gv5i2}Y zE$TnBDD3MZ`w8G?-ce8(y~<#@<==gpC2SdgarUX#VdM9Xd;hL(z!up`-(-JF1NU_9 zT6!AF{LG-PB%ctz0j}lqc+RDmuQLys;)UR`lu)n9di89GR_q`(_6|9_@Wm5^4LNLr zou$cqzWC+G%-&Rb*^{RZx$$TQ#!=Y9y2&7O>b1l{WUI_)p*>xmlMN)!MEowL5ae0h zw7C`^x*NkiBy%j6aO~a$^7*}^K@D6<{>RDkU-ALi{@01UM?))as}u3xiT%DPx)%9? zP?7VDLPjnURV1)b>zN=6T;z0fuz^G^Q7-Xy&Mj1EF)?jZ2U(y&fI8{WzIIQ$`(rKC z#_`<r>M^6TT54vW^kw8ej^ z{quEb?{BwE2!h1U&G~^G-md`s-RDxp-Mt2>pUoIk&2PhAX}5Id)P%EEZPJ9I49Akj zM3oF>RkiUVlHcAfT~L8h^k1>XCHM1(?X?A5@2B4MC+&u4rrwFiYz-u?r+B7~44VO@ ztBTW^61X^InNI3N@so)V!RtG4q!OO6xC$3Ub&#-wtM*FSEGaancVR4)r}haZ1k;yu`VMw7-PdlnESgId zCL*o{4^J1~=7KCX7d)AAAsF;$4q_qghXTcj-pJ6tXfbgV<%u`T)nQp!pjm!1<&)Hi zEyZg+%6mNK5SAUoJzzeRll&lZC}fbBav8q2N<$7Owj6|Y)fb!XhwN^eQ9K@TRGa(6 z&`{6qe;7a9+WpFI&Qst8pxz%53*yN_2`MB08D91!AQaD9kiLZhK=BfA$o-)Z^jya4(C|Nu`s=$#&BER z>eb4NV+rc#5js)abhq&DUw4f7vbobseq%cFS|B9i5lI`3U~&X-OispgEw3QZhd4Rl zWf_?YWh;@K4GpU=DF1YTM|kqDzNUwkmP11Ew@K<0%_-J)ZH(-D=3tl?{d>zgI(Ev` z`P!5PcZ+VW3wlji;ho37QG%MTB6Ih&LL|vkFBXp4Pvu9z3GLj%%F}AHq4dbz#@kHT zUGIoTk5FBcYt|Lghgxd4E9dLlgXf~cuhxL=Ut9xjXP6hAz~@(0ronefrY^NQ1Ge=G znBFH=kb>ZUIFzLFB%o^2*L>3Q>BfiJEXE@sHz^f7{lExHIJ!YUKVP{AoZpO{F(Dow zy89ur$=YiL9p=^De?_jifV()JFz5EO9MCIij4y&$C}pJW0g3klQWg!D5WkG{Sc?{w zDiu8ZFg_S60AsiYIAQkfb$X2_Sr3?FTIkpnBRK#)rv6AI{uYy9Bn!Q*t~|~|eGE2+ z>}-k0w#CpOex=cMP)abx%OTuY{2`&O&&5D8*i2MVN2kC(&L1$6L)LsKV0tUS~t z`5ERvC51>KD2(LIpG5%u@0qTYgoWO&h_}C>NSy*sF@x#;b05tMO@#qhJy%HT7^ka3 zA<86HW1Z6dJg%Al01lpaTS`j)UBEN$Kpt*J=mPcu{ay!k z#FKL6{rtr*EWOa$AOhQ6;o;+IJ~8`!Ejt0Q+LYZBJnD-*ZVkjV1*^8=jR-Sz`7JsoKO zIr&_mwOm(m62k*qlMIO)qF57;XcxG+#iIf`Ydc5=e*l*fqkPy{&X93QJ$j!4Mt9D5 za(3wS!U+tSgbHn1Z}_4wbMsFjqi`U_70H!4Mij?oIfmbb26Q#(YA^4{y`mF+#z5|oI_6wU)7EF+@-(kBT|SKI^Li%ItlmQS|j-{GeQNvmT%x|{o?Va z8yW(gI#m&r@#4L`O^Fy(JX>)>euSH1PwX992m}R{=-gc4%8QtCa7A_m?6aS#H;O%5 zAFNNKmVzd02XLAcr#<5GJ?A}<9_5E~^ABzt8eqz{UVmVz03jL5^F&%wENbh*X_#NX zONlC34=RE;`v*!$Ps)G<&z$+ZS06qRoX_m`Uef4Tr72nAlgQ=d?cKjNdM6qk1yy_Z zqhlwr)SGGSsl!2-U8L#40FWseLQ(;OElYt3y5Z{QyO>!+mYfGkZL=t?8+9zf_Bmk; z*L*^R926QaMasKYwXbFegPOR(T{w#COhiTs^pp=v3xSro(g{q(&&@L`SL6As)CdD= zBO#E;U86v3MG=I6av$g`ePNN1QM3pFjn55yImp=ksSxo6`zRS}BDXY3M8LN~=d8dR zdCVTr$pHa+VgyU$FGmpk+hIh7^c-d3-Gn3%9l+T81qHR-C{ZLkUCJh1J}SR8f;qN@ z4zCu3d~hYO#(cXiOD$-HcD&2%T8;nx9{Z1q{u(ca-1Js*H^TDw2+8)$n7-AHCD7df zDBu=TK*)N)<%%XE4&dnBzP-mW?yl&aMy8tH^G(fEOm9qdF}E*0xkn zyM<>+yz~WbR#eVElH1N%>`K9Hn+9m0wkp>_}8=jzt6<~pM&du%edOmJ#Cq{W(UX_-IXG+r`bo|cytwCs+PFz z;`PjJTxc>?hKz!~SzKX((Bn4k&iuh(02TT7e}Y(Xw3Ro9Co_kanRMtRpfu};r?vx+ zpnr)!a>1{oY>^Y)+I5J&q!2C+z zuwc8fuV}21#u8{1Yaxmz8$K6$x;j;va4^CXy(Fqi3?&Lkkat zbkMbRfmH`~k1*Ud>lXuf6*g{0+|zy-WKhx$36fk(?g#2cxJhZ_vO?-CSXd~Q4kEro zN*zyHbIa>rwL?iD&+Si0vrQ5 zxJ|h#SIm}FB>zZPJ%n!d6t6JSoGTP1Wt{63&SXXw7Rg6;KVy{Mo(gmn=Y6Pu$>3$^ zrJR4ihZzks*{HRD7#)${*so(EgQ%h93ScU9d|45^N>4|dsYFbIDU5%pLw`c6j)l|) zXcC<9{;q6l`NpOC>R2d{(q`m5nm3EQ))MB8U%G3#6EO%i5I!4K(HS@D5(FJhLM92$l?L2M?X||OJ%*{fZaPgZ>6k6Ew`EHL z?|^zhr?JoHyQ}dkpvWPGD$z(0B?c~BUCYTp;TX|ED-jIk77AO4LlqqsP~albuWF6@ zA=DFUX>{$7K=P8~b6TFtu86TXkcVz>wtkmS5$1JNiv8fTZr9~Nh{6D_mMmT}w}ZF@ zN0^Z}{7qqetOV8T8>}io&cz=XkH z+d@ld_NV@2G2uSVv*~JP|72haI{-r4H38s^;JFWPaT0}^%*$5Cs4i$ChuWM73`b)U zW4E_37&4r;(%%T|Uth!MgK<9a)*6uaSA{e_DU zTiON4H~XYX=-3za0e||EbB3jyWEor%B#pHlQY}MHy?O|0QW4jaJYQOtIEUj z=uf%EKzfPF*L2Wg0&A&G9M+VOmgH<;oTWvGWAeTzJ#>?gW8kQGx=E)ems_qM5Z}rw{M$WRa8K58{Qh=1P`ChGApo{8gLBs-<6^ts@r5_LwVzNAEoV%JiJ}i=T`HuWi8gNB&R`RuK zMBKm_LZqq)EPRtFt!bpla2vW*aO-OYE}P30hDc8Z`b2Cm3^z`7F~L z-Srrde;{g_|5w|K=MiG@IEODOr{4_#5&kk{W2cZqlDOzFu~paJF6YJJEdYA*8F*N^ zAbZ%blA!4&v566cjwHmd^&pBmQlUZVet!C3^@IJQZ%m0H93y2poKasLcWTsSO=Hmn zn$Un@Jy~dA>221rfo|KolaiY1FRbBAoD^1w&(00F_ksZ2n|fcK?x%k5DyN^~#Z*D$ zlhIfHql$@Z5xBb`r8qC^SE}b?-ZL9mBY0H5Y%}S?kXzxFMJO+9YBVyzC+&1RLcVrR z$dA3jYyxARj11o%_3!sB-w85(|9@2I|0*)gz(W7OAmBObQc2mY2)$=&_QsWg(IAHj zT83syS&|({WV{3X0GDPe#O?!R6KfegV z3dd-l!gPE+zEX5_Tcs8(y<@+0EAtE2Rj&x)({yE`7eV4b3*xZB@zS0GgzCA&qR)tG zd~uW2WCT)!!<0M}@t{#R@-YKl@ne->I}(YXFBj<1mi3G`1pwXqiFLtXzl+B3n zd7VWZV??vV*9J;3elwEM>TSJLZson@Lj6zNVn)*e^U#IaBZ}!cZYv&_Cg2A{kOAHuK-ULhn84mD|2FM1Dw3o$1MVow#%r=x?1~j9H3B9{wzBQ8~eJ8zU z=Vtn|qlQr&Y50yXFc<8-q?$>K&T5%@Kpn{V{}P&UlOUG4a;`#M{CnGlQD#$Sna@*) z_sB7ceYv3r)65z8i4(VRBK^f;WPK_dJps(Y$9g-i17SCbw|bQH1)8dNb_Lhjq|UBW zaj;p?#30U@2#z`6uk-!poS@Po&u}{i%0s$jSFtvO?-je*sOzgKr$bL&ra&{k#o$yZg{ zwW_dlXgQ|pe~CS-B$0DxzqGA=Yp)oLMc|-+Yi~3TMKR21`@Hk>DSBL%<#66_fI^L>VV@n^?K*-ZDr8HW zHhM2iFc?vaWEmP!z~U5|9=*-ppA1CgD>v6p=E{LNN1RI_T$Z^H>~>8zWkp`&lsjVc zB!7G`Wx=&{z7yx7M+DPv7{6-w9%U?#ez!va^DP=3)H@?|LINil_xhS^eO~r#%)`kJ zEpw3Bp4fU-oViIWnU$<9gEiVlFWW)QI1|IYl>fa}E$FIZM)5#3v;ubzr#GZPnjTQ9 z16xbmd@z%-0fgi;(c<0Y#}G^0>p4gYcJ;z)S;esJNH?vV~LvA4Sl zUe%vYB4b|;)8xZ3FkIo=(sBt4&6cgl4ZG~>>gdLmsAZgoMSdPql~l^*Fi6Qb5O+%x z&w?FPpB(R~?)8%f{liMwFeLm3D&_!LKe!h0ot=b7s$l!Vl1j$;_*-yy1!WCLj(GlY z9f>V~w1_D~4+DBQwYJa`3@BjQ_y>lmBX>~#hA@TE#qST5Am}$28yg)|#pC4W;gIN7 zIcI%2y0Gn?6R6qr>H`<5RL!(;JGv*31V23|(@Vj<<-_U~Q5PbhhELi`$s3;r#{|e-!s7u9d z{S%8fH3*&w{^@&)h?@!u%w`@C^G<$v2RO~TZd84#THFm6KOZypVqD!0*985v!>6na zyIumePc9_HFh4>`lJB#HS9Blu@Lj*;g#Bqps=_cG;zn_DQx{YoZl4Ih-LtYINjtR1?9jfxcG} zP^*~muU7ZL)aa*F&&kVWx8;@q_{-~8P!}GQu5P~fhgWTaXj;FW>Rkb~#Lx)B+DqEI z$xcW7T|Z@|KL&(M+G5d82lv$-d8}{2rT|{)$#}Z=&E6zU@7Mi~{=jF*Gy?-o7FbL> zqmHFZ#@yA_ora(gc>^`j`^tmC^+`@>4H&7D&f7^IdQ;IG%$h;~Aq5F}srZn9fT+BR zS|CblU7Z}MD@?+i6NiuPoXBH^nIHDI*e2)7HS=%l^bfpazjo&hKwix5 zbFj=K6%?C;VRJbLs;gX>d)5HZHxgIB6q%o1n85i`tP(j4xu&@D!xJ}1-z|;)dUM(< zH%`MjK;RF{$m^=DIvO@ypPMW%37RHnWYMm~ML6{VO~9jwt$NID;bhD%SYP2~8Da)hBZ2Cs-cnBuXP(6x~WL%aLDonI1GK6Gl`>tAP@Ziz; zO6oEU6vxB_TMq`8%|&-_J|ej}Zwn^dl*rd!qT?W@#!O9#|j7gk-Q8AM$>P z+B>hhz8koccO)O)yFr4F1n{$!OkiT|W4b+V<9Jmx`Bc9M_}Z*7#d^Q_6*y1pF@2M@ z&N~vRBA^J?Uvd$oJP1>OK16l>X(_Hyy+5?QsiM#fv9ckyzd#tn&78=g=6yscy2ve4d61JK|xb zHxRBv%O!3*l`tPKBN8JE17k|xYBHL1;Kc*06eyn*fqXs+YARYXYS^>csQM<22A^AM zGnJb~^l&0q?UaPvo)lY$eRzQ*N+1jzWrz0-=N~d=2it`}kGe)raGJ48*bVPKN9+E9 z>ti+z#=N_3051#^C#j7LOkimueXPHovxllU=8XWmM#i%)-P`tHERZ)kL&CGK>+B|E`nRn?#}Htr`^U=n!lnp z-x(!IO5ntW4o?&9HQb78VI59F%HtJ*9hRJ*_UCT3e_g_Q5L{Uf%q)nJtvBW zbyn4l$hT8K@e%Pq09f;(wvQw2^Vd%h!QDv|KoclcJ33PSv6cX%yZ<89B3_$@nRLpcy?sJu5l*GI3Q}AKd@-Der%sqC2ebMcAJCRY|MbpLFh9AA z1l3Mynt?<8I68Dhx^2{we80<~pH32NF2y$-* ziVT5i>>HUa8Ll+JSa!c#y<7s4@s~*8jS`{Pa4d}xMK%QlMUqr9DLO={Bxw*5cxeza zuhzcOIiqe+5Ha{|)Bco4(|)dSlP4+Pg}b?WMS^{eZ&S!Z=ASD?&3oSCVFr^d{3u#siE z|GTtXTmzMb4LcK|#-x>xo32^Y+Z7%B0^Z&aH2E#{!he*z|1N*Z!OZr5J9<_$cm4-z z`j5*mkWYtt=P;6${}%hX;1-x>2~|NtS)9_W=BlK+N2dYgj6?z&bBB*~xdb^`2>ry(5T6po z(@3A~-%R@1@Kx;H(Jno|w~HadqwKPi*8$ky#~pavdz+>WW-aWfXFHcRC%3=b)QqN! zC%#HHXwqdpE13+W5z>q!;swDfK27x8J9cS4F_OuO7iEr3T57U0W0hNVU$ed5E<~fQ zXA)qpN)k1hkGv2M4e|NGjF$@A8Wqxv3BSG`X^z;F%G)%zsJ}WazH7(A;t2?&C0;&= zSpf`%?UIcG(w-DN4va0G**G#-O2RA!p&p15kLah-mZH(~O6OCia9yUK{x~Dl?wDg# z6b$h&b|YDOKz6)gY7q34`#Afxh3+9P6XAIvK&f@WrFDR*?ab56{W?7{ zK(i6Wj{xW+*8Wd>ivAo59p6B9+=KgAy3zn&5NCZQ5JR2GmWhi#9XSJ4pj`VR4N3NX zDS)ZN_N=h<01@EoNR`VV_ai{nehkA%lNE@6hNn0s7qqwJLAuFZplakn#Oz||P`Ny( zVLr$2(%H?I+J<jl8yeNZ4*pd!?iK$*>7}uL^@(rzX-y#D_knKSrmQ$t(nG{ zajN&|GzFhBfk5vvw;P~Cr1dpaAe>dmyj3+(8?m}UpdvFWD$xV}D&6*eg!KZ8D8lB{Xyp6Nr zTQbP-4n`Z%7S(m88=ythb;UQ|&oT0aE1ha?FQl~X@$|AdP$M+u8Xvf)X;^e@O%5zn zu$;a5%!gbs*T@AQ_dOz$tsRL%T{3t~Qg*I)@D;%%Z088X(M!n2mQ-B-_?d)fT3_%~ z78VRIKtW3EIGXvi*!vukp8PfXJr8Ar9vZAL3u{yVe9@8hXt}2H>-X%_r}S}{Ci)wElc+33>BdwtWRb8~YY{YBuSHAxw0--P92U;C$C$ zC~Mf|HE|D=S^_)IJENE_0L6X0)dw=O1>wXUHFR+Bc2?Fy08-bIAmgfvB z*uGh%ldZSgrhDh-WXc|&%_S_Nd4<`qRFAbLV93{p`7?~pIVfH(biq?m@`58w4z(Pv(gshB=Qk#wp>^EcdQah(NR$^U^NtKkCs^Ghgu=-FjYImFfLStnGt}s zndzLPjJYxnW%ynoPe#JRCnC3}u8s9(f3{}|4?T$T`=H{kys}kSGp#>KEU!!NfJE3- zMdSwf^K@DmUkp*n-oQVIjKCbOAIWA7+^Q{u3PzhK12t*#{!gYxiz^`H_@8NtfIMo$ z(uu(1M8Au!@+;&6Q*yvKSt`NSpxW*C1*0X~$y{ninr|q)c4J01lSBv<#si1^fOI)1 zL81B1A0)(D>`up9?2ya+4|s+c=C4W6`VJtr9LU3c-ChEYxazvJ0m>`ZjL9Lq3zqo4i0HYR`2 z%&+xHwYizK==Q5Q2z#%kW`nS8uY6l7K0Pnc0o z#?C3YvS%_#9U@>E|}Jd6#MTwrkrT7qMaTJh`VD0mO-?QtS7WFZZi$ji&i|9VDyc#c(?=C(gR zBWYKby-nmgd*ph)H~m0g#=$)Q>k|Jz-56$J`A=x~-;OqEy&d)6`13|mg)ZG4^?)0D zl)YBkk~V9KCPjn-8VORPx=@s!C^zHt@l+ffgGR(a@joL=@wr{(SLv?M>b=y|OiS(#E4y_X9kGS1t zR0`h}>)kpV;MBLPUmV6VT?#c!UyP;`=lg9{c5Y7!t{LxmQO$(LNQ&0`>3rFgDm*49 zJ->_f`Se`5mAvo5gT%R>TA7T^ucr-cpT+FYY(IX&syj)MuirB}>dtIbAEfWf$=yL| zqFU|r%W4F?zdbhAWUPQDuwk76tM{C5E*6zee@)FC+*W)(%sLlfej2>_?x!TmrzD!v z{k;!|l>&^Yur9*xE&zX|Ii$9`tY;76e+s`nwLJJV(h10<&z)`Fp{HK(f#phuig%wm zcJYsqgRDD1q^AZPjOZME3O0w4piv;iwUU~!p!S#N>gZ+8mzYaTwoJE*U3T26KaNHO z@U#vf^IEu7cP2=kr-Ja zD(3Q_^*}3@l|kR4ulWym!bBJT!`PNj@j3g4ah+q(!|wUPsGS$$i%tN3FuWY!?em2$hBtYxe{ z;jB+NqMhtw>&g9Tjf!=kyg)3UEVsUfM+Yq1PF8kUfX+95zw?M~62RJ(T>xE5TUFO< z>|-x?C(FyYIj2Zsu#rmgp8)m%(j>hy$eG_d$C@*~hC?=VAo3vjmX?*% zErl}u*}aI-rM9W&dvMdg+5_>myy|PVH#pfirPZ0BYwUGF;0Y_Yu5E1el+D<>gPeK{ zeZVD*uB*B*(85ltqYGmeGz*CxA0fJXD& zdiw$Q<8a69I|xFlI2R!F5&m}+sB?8S_|^1wDEazoSlr~sRS!skj#NE!FAbIFePP+; zmW1ZrLi!dAs%-fIqNfPCdu@F{4oCg;p z=-$a2%dseNwoPw81zgTmcCfl6&oAdsj7~AW=TJUK@lgpXUMeQ*a5?hC6$_E6&rwK3Su_~}Q|xdS;Q|ADC#u*@u4NM|f6kRobGw$kA1 zEN1EaGH#;p9tVaEuX>SfSytZMxj>|i@_Y%z=6n$rbEB{N=K0aBnt(gj9Jek=pQ1ji zrQIMgr&j9LCv}=6W4|sTgWjpN1yc}V4 z8VdUp0;B%)%%^yLl#IQ3zR?lZdjwF_IQW)fU$Q_htI#h+aB_$?2pp7vYlOvo|{6fEsyp0&ZipT;y_ zBwA)ZQ9S`Q-`NKqFRzeLeQP~0u1fIx6OaW5>GAf_iZ>cFgATBTZZaVq3d_lY@J#%( zZ;;YXNvsKnoLGf3RWTjBeJ9}J*bLmrEZ!Infxj5eVIh4rml<7a(hg!JNQKlgk2jdL za3@q16IC!0X7K7r$Dr-HRLyp@X9ibP8AU~x9vv_BgMW}^gk&>RqQ-k90 z0|_AVRJ=abgC?n@c1BtOZY6wSsjcPMN^VF#k2qI#T&_}4FS9m^GH{SBDC2j-K)1h; z%uoxIL!xjk<60>=rpnycscPm?PcysG%l8^`^@1B<*=a!CnE&Jr6q0G)b zL8!_BlQ#)v1**t+2Ze}SUpxC-RV=%MyeHe2g?ir)equbYDgP}AasE$Q02Wr3|CsH! z;I1ZawBGXRF=Gk@E0q*PL=o5A1<`3ymk^}I#ppG9>`dFcrQ468B1=_$c)x+TUl^)t zwJKGiWeS4(aCS0hx#2fR?fkN?4)z;2^;`3HYI(hj*$5|_PSUonwdEvThrvANUf2Hd zg^T;M?Yr}BU7QA2t4g19y60^-t!+I=k%lG{9Nh17mk6QD_E%Y}kh;XS+GmDYuT2|I zhS>Y9GKZE$QGopCU5rNJmXyK1>`_+E^uDZl;i64Uxb#O|`DQ6*@3<-D+=^*veO2zM z4yCZ$XCKjfs(H`o_k=A~gb6NUO%lmal%y;|l>83goZYYE&JUbDp-FYzFwY?6tBipT zs|b6S@=TsOCc-Ku2Q_vvx4(JEh4|`bmo-KCsu#r;bkWXii74n4t#jPLD&|=7a(gzv@hW~+DbjtYW}UuY_nVo^yd8W-@^`CulfS%!U7zc z#^%LYn{_VlGV&3M=)x;T-06{ue+{XSo|+}I_H?))EJl1x8*_zXhYgM`Ec%P{9uK_4 zOVHZZqi=nAoCgk9&G|7U$qqEbtTxq#e2^fw%(<;!Qpl8%t|99v%0|2XmyiY;rR*hNBW z!UPZt9JdQ)q{xONSR9fqgXTJofiMk}tftu}&x0r?~l4|7g|=1_#>M`mgZUbL8?_!uSf+-Q~!#ZMS3 z#j;T6bi*@Z7c|Y+2Ehp3;5kh0#z)-SsO9B^fDclaWNo`3xEc7MLNBP;V0BE5Gke(+ z43LyN8i|&RX5*|7UWPD?@*j5vV2~Awb(v7s))2;tS$=~pNuuxd6D&JsdmWbP>AfG# z%2#)Tt5y$PUb!ybpbAR=aIu+ZzMs0`NMpz$M#MyK*@h0X}68h^bg2%J+Qj)bhi`lAi7}xH;*-5Kq zw@;8=K&ykxq6rxI)f}*1xdwV05*r)})YPsAt%zXKVRJ-Wo0B z4?_wvq+E{MkQK0JrRMFf3;IoX{zsO?zM#4h>&lR>DnGm4R72H*p{i$Jd9_ZaYFovc z!RJ|_4!MSpP zA_dzYq$~R-fOi_aAX`1)x8Brnmp*=zbE>e0Z;iut`)bA$3DgUn7Q`lOd@ zO|(FEgn#a`ES>UgG3n0qFW(|HK;F$kf4ypH9N(T4<_E`}lt1b9=o^ribzI8bG||6T zTM1gYKXiLJS)32)E2KRcRy#eBu4LJJ4c?n&Z6?M95Lptb(%HKBbE~^aAn5r(qbuw9 zcG|oxK43!sD0!z%BQ*q1aWLb4wAS)zan)={uZ?R<=x3SYr6#WWODSz8-_iI_#xBAz zGqxPRJbdYX4R!eKKrjUtB^k)=)CyE6h4W`}ZH15Yei(|*A6b01C%7?Id@JsSnLUIw z%k1eV3VZNkN}b>pzS&ai$c|EM~2>ItY?kkY;;V>D`V`u z4r&}G5(xN~o!&i; z{f&l(h5ZfVk;&)Rnd3;$oE?nT3)4fgdmX^fU_}Gh~a|vR9xcbmj z%ZI-zC}XkFaki}clup?kv*w}C*pO^z2B()~^TBdUPGi(=JNqsddxkZTax}}Wy8zxY5kJ)y=_1g9K+=n`VZ9}$-K)fTCe#O7x5i>~bg=tO2&1OD# zq9CX$%=`Ls@C8g+KJ%k$@B77V?EVf|+A+UW%|00Jmd_LP+clu{V6WNCToM(|rSn_;2 ziWBow&B*8d?4ZGOqMTF9v&61mjf}GaBZwE2R&$-5%u~;kpVJ#Y;txpz&=ZhpkpN?tfZ{|&=&9ra2(rlOkTy!v$*-=v z-hk;F*0nk>o61Mw2qM^-eQo2wJ2KVlP-7V)?~^IDWz67kIj8j7SOV1=371<;dw-kI z*l~*sNoKZ*N{N#6YscHiiy-_nWfGn%mFvP8OFlBAzBFBv;qdS1$Fx5iFv#{|dIc0| za)>KZldb9~!sm1~QTI5e;IZ!4U%h-z`75<-i@;}up%3PclMm;-7C^3FXQxr@| zSzr2EdKGnU=`aSL@4={s6^650Tn$03}OeR0k&!X zYoj^d3OSTOJNeJQh>O+*7+6flaO4X(a>EVEVu-1dmXG-;IkDtI$tS3gt)cb^hzV9& z7afU48m$g2vzyO@IBZ@nlA$|Dp-6qOeGbji(#4`*dAB~1MRU7Ba#Rr$!ZjM&${df{yc#gyXlwv#>M;wGeCOsS{(Kqi&__(E&K1vGNA*G8k(tvC@{IQ z%A%!Kvj2F=vWdjcYKNWOHT?Uhwp~7BoJ6#N7oCS~v8Nx^hnYxno@hO+H5S=`Q10*G zsfs{h>*AaExLKmzhP#Y`4doyeEQlaY|4cL`F|dIjPw(xQZ|;iamp_|iCD7$S%pO*_ zs$cPbioasKhBQdgA6E5A-udU|6;>n>>ppt)unehx#n)x#mg~erW1$_UTgnnZokT>5q zXIJzUK$BiJ(FV7&vqDqanBRU@)mnXI(`BToy?efLGV-Y;jl!_-NyuW+ zU1WP&)ri0BRcIX$39TZ@Yqwblk=*}revZ|Xt@AC}M#TkM{r z^wCdQW=SGJ5LH%=r9N4O)y`9*31XEfdzudSWgez9sH?+vp**HR%*~%++VAG=8(Dx+$)AXbIaDp#U{AnC^ z;37gX|;brnLnZppcyr7wHdG7P(mUql8I7}|M6r!bZpj{70ev;*%|GG5& zZ(0;4W~Toiap?Yc{;|=D+VigVCt)AW;Gajaa)Kn4G);$rtAT@Z6#4?eHEkM!Yft2k z+mC*=jtmn>lweb;3m$7Eli+u^#`Zkwsnu^AZK)9=90CO zQ=5V5AVfvU>c)j1O{KK0U(c)UAS9(G{7OudpU?Z%x(#(Ol{FAK$ZqS46+zc!)M$B6 z9c!C&kor&0RVz8?uq}6|>!b^_XN6w3fjdq})9ndMj^acn4#lTNG`jdhYc&R=Z}5Jn z(W`B95qL)@jj!NqwSD)GtlA%i3n@a*N-T28D7qV2N4{q|3X!+pOn9MTrZ{0t1f4}u zj+H4!>SBQXSxB#E#tGx|R!rI%$P@-mFJ}!zwx5cP?GE1cMh`l3gSqlyre=1?w;mUb z$4X+#HAU%!$WK==VaO**7pKyw8fEhldZ0XjisS%La%pG@zg6gKPbocHnbKsMf$Z&I zUyNWC-`m+Q{JPncNx5~!ic0nAT_0x9D=5|P241X4goi1C~aGZ64qj(rNCox%_zl|{PbDGH^XdP+c zGw@)3p3i{jD;z@I9~Vp?+1AIH32ZM@y?yMBFJ9NKw%2Pq!7LDyFLx#j;zuY1SL36| z<{-Necst||9ah+p=D9O>q?A}Y#dCq)ywXCV^xdFcNVoTEh`=7Mf@@QgR}T|A!p4Rn zt_1DUCZb<3rfKsD@T3}=?j?tbXa$OuYc3?)E2h&(v~py|1V(#%S5MePGe8Hxz9LO! z`_sNilgK!7xSa08)dG-&oHK5#=m!zO2XuiC3@a{pC{99kVKCk`Ff!`z(`LL&E`^I? zn_Ir<2*vb2F`;#C(jf6IAJ>CBce`Fw>~XQGOXA{jQ@O_28s{LR&U|1mS-Ww%Z8ul* z7$pn1x$`$0*&H1e`2Udh6d|qd{TbuU?1O(YqBmDvlPVoje z+O_fA2^>+fsinD_(%W8?s_sqB+=CxC!nccCO=&3eV>AxaBZnNk!kBk7I~e6V$6by9 z$>G1fQx+ggH<_4i^EfURgKH=Izuej0@Sn?@^n+xz)z0uLA%^WjzgHcR#}+3Y^&Bgv zf6yZkSAT63F``3Eq(b!P5o-9G$%ms;_A5Y3LXM#6ZfZ{*PZ47U3ZBhZ;BhZnxZB&CZyZlH4^pSkt( z&WU)L`#^D+h9Ie}8|uQB?k5Dx$W)gkzV(&o_CUGg7_bP&mWHWaDSC{-xycuZ9$;Ti zS~FHdx8EB2C&II0Hu3WISqHGN0J$=X(vSb??eu99a;aDrZF_l z|BDZ3UlTLU-_thrH=zdmhh(pp{yq-E*c!bTo~E)AUqO3OXZ6p_nVOhsSW@c@RCW3` z6CwYz)kP6qX$E2BVk(CqH|>e(9e+Jr2?vs|h5%3J&}-<#`*IDqNk{ND@ye%)iHVD! zjy1q&go~y73Riz}*n{xet8&eQstBotC0kd?1GF$%%2N6u}FQ{7E zY0nE0nt=UIp5Jcz)d@nVOt&P)Yj;ZK9xWd@%a9*cih_vz3SUF^JJHN}615_7fsUP{ zx1+}kwQz&A*V+EW0hCfU$|Sh$YLMf=U?u75&oNYr8sdPobjRC+*X;m+^{?_i%N!)Y zFdc2|);UUmTZ{a|@|TlBL(nykPuK?_xVx%O7iX(Kdkk4W`vpH2vRihZ6r?v(XZ^c)iOw&+}w56-qp+TVM z_z!|aF-x-vn?*t&S=b=!@m)?8MX&q`nZKVi8uJU0Y$|YE4?F34s~#3n5{=Bc(LH;{ zU6@Nslvktrs%w>ElT(BJk?WYy=>LNFCJ`r$qE+s>0`^{$WFEE=iVV58{gx zTA=xPg(&6;8ZU9?+ct>}8&NS6mJH;}7VK`MSG7kE*)oKS`{l_#FVl8pk+BV}OqHwu zSk|SUlb2Nl6$pWzCvK0WX123DcER$i?X~ybP)_@zpOcP^4er~j$2KpL8o7(&^Mlt- z6Z|=Mb@1H_!XOaWhan)%=4sVBDaZ!2pQrnJR*Z^_6k#fqr-_8XHeB79gN;}h=5FCF z&@WZ~iVBB`gXq)LHT)|U;(+z~8!(c}giolQNTRg~Yn6uej&W5c-}ie&DxFMksvdi> zbJJw4y`{wlV7qSiz!e`dN_LRb;U}XLtYL5bQ=dATx0nED;zwO9I9X*=kWiBp{^ep- zHC0yi67sasPjT}N2h}#B%Trrw(pjMjZ|8)fXc&rEa)%vgI!g1fd>WayT5yXEk>2?V zA1umX;p$gSloyh!G?gB^yG8){!^V`FhmtCaJ23=#fg9x62oEeMhVWdH?&s;<-MK10WXNuCs4}dRgOd|;OviJ-o_Blh`@P%!M)=q`w=MW(k$D0l!AtQPx72GO`O$*NnZg`YQ^FUs-SseZrY^ribU7O$Arp z2iq~0#rDOVTvJPhnO9q9L}D7 z&11ip!z9OIU?KzK_`R8>v3LSmpL)CGyi2lWMyd^5w>agMS0=4II7S7G@UlrTkxGBW zUDL3{zPYy95LwY*JDQrEW$N5n*RGVt@N*D8C^a$ zexys6#MvZ95JVbCVCN>s+m<-#O8vCJsXfR!+=cq(aJS{JZrq5=--5-94vccMf&!3? zl)~W+$)f5%p9%$)I$0pBLG)ZxB?qgM`}iG_$zEm)^gVrphe*ajFNCFqQJ)l!e_q^; zZcuE4e&Td3y|v+c*-uu~pI-g0(5weBQCoHfx||Z+5QUW$fyGlo=L^okVYtr+2s54W zsUFJL;Yqe5Op{9`#-0~$zOGq`q6GAf_k|LrY*u-aeXZtmfYH~t)IcGPp*a{P96lF3 z%91Dd(YHtoUMl`6lh51VnN#4;JnN)SrJ3Zer-ImpHv6_Nh!^tA6 z8>&949w8k7dxCRfo#ZdAl2>+-%*jlSa)}YvV{~5*N~IpW=z|0?M#f>*U=lOQo{`!# zt;|Q;8g6B)PvuZY4?UUx7H0cN>IAy6btpGaLy z%@xw!l}IPuxZj5?c)lBHWPFb7c($!2*q(>6*4+4XPHS5`o`i~QWgM@=Z&JD*k%Dd! zCXwN_Uw#i@{h`^lg~HTOYS}SM4{lG^i^X54jFoq9OCLe7RF_rMC~%Hdz@O(D^ulM9 z2-&Ygxgt-wKUPL^m>Vgyo1PM!UskCF-5hq!GYT=7vco6G{MVS?%~!gt{6}Hl#_mY$p9KK2N>O z2~E6JJ}gw6sCLqsR~UQOeK{v$k$dZ*@^N=$L)%h~3k)|nyu51OR{$u{NrJ9>RV%j; zJ-+nI7Xs-SYQ3-VY_6M_Gy>XTzoAAMiB&0-VydmBUm=H!#CZOg^EoJdDB&?^9jZA) zm3C^~q_bMuhiAQ5rPG@D!2Bi-8nfD~2=LXLzx_Z>aMs6U81#>HK%;EUy}x5N3~HS(2k8IDbIO0EwF&m$M!!w=r~D_mbwS z7XK4a+1Zb;vPq@uN=-LFlr*!OQ`9hP8N8J_#CsYhxQPo+_!j0=8f7XPQjkwH5$FFv z%9@uxGO_w5OoHv=+4XFCeazX^@iYL&SnwRS`aXH?cJCMc2+#b`G<#oEr%<^6WJDYi z8E+2|Y_vrJf$9SKRAyP15t(Y8h!b^cAb8V)B_Z5|$k#2awEj_@0cQSQ1$Nn58)NP# zJQj0pWkki2DZ0+ZW?Z)~rFQ#%i512ug|I*o)Ca)*A_O5!jIdG{B;jjNI?6}z{P{FM zfKlF1elBru*kPmQIVV2)ChiZ_G7&I++3|#cp8R7tO9M=Szdi3^LDBxelI~P6)Xj2x zmQ6^G)ge%|^*m;)G${N@95+!NX$_4p1Z|XZcfz3hFjs2_|6OU4Nh^qDpika7{L{lc ze3m5JpYZXnl4Y@n?-d@m-)}0NiM@y|JEU^6L}R6R?3Pkx(DfehN%4+AU7m!zV1s9k z=TLsQLcCANPDKaxw2)$i+eSOZ*M3HLTw=fUZuow%BmqXKZ+6{U6`DH&%WqDIysM3v zo-h1T9y*!9-(0P#znJ1{ZpCL1sZn=%G)F08Wr8|raw{QB0cY*v^N{* zN$EsT#(MkEbhmFr^+!?T+kVePYGX^B|20khZz@Oj|14ja($t7sA4B#1TZi%?O0LTI zzPBr;@8111u-YfNgnkip2nj%A9~2~QA!FZ%4g7dgc5!JNb5NQa@`bUE&NQy*?2N5L za(H@={%iO$YF6R@eQVv4^=Z%kepQoxn||mpZKjrm``1*vQQM@c>Ty)^-1zJCjFFWD zQbq}Odjwdw<>$_+CrMpYs5`$`_WYecd~VuiWvN|tQm4{Z1{C194;d?5G*DY|N)Yef zecRNE%^I%fwC%PB(kV}~)c(=!L-x2S=SuHZ{Gl_odlzt(>UqQTiUhb-5zAL+# zLH&_tJl@YO-t&}r%(Q_b{KyS5>WTbf*Y@rS8gKtf4d&()m0k2&-FE!pE1Jx8To>hZ z9^}?T+>fazyT>`?@DFmC+_Jv{id&2=4>l61bA53^iP82u%B$7S!)Gvf;VX87nexm`(z9;;F`{2EaY@M-2h|t$Geyy)5QrU%d#pQ$K{# zeTcj$#K^qdY|;a{MYFYW@J#Jyx9_ZKR}+4a9()0XmC`RYrJ2QecD~3CINi?G%RNfMJ$6k9xpx zGCmDpH7Cqrrfy1b$;A<_8_*v!K62%l;0T!eH5~CvoPvNA2IfPuPzMwg+^;ev0>ym> ziwZ}FTmeRh=q(?_--Fbp7NOwB2A3(f%as<2pI#Z5n^IY*y+7;tBMNl30tszN5Kc(o zzy%of(1oBq2q*F4#fd65jg{hb^8NTB3qp&8o_fut2Xox`VTyRxA1KT2rj5aAl}bRi#~1pW>-T<1oX_nNbc-sY}a;OHTBv$zBSw-H{y zd#=|>NOu`L&9LH?G0P&?=id)c|r#YO4yMzGgPFgEh&Z|07rlnc0J`L{zE25`mT}nXmsN2E8xf?nQZlSo z8!)hP1I&f`Fvsl8df~r{Ua>~4K`-=Y_(1ExQ^|0QK1!}IWBw47Iu|L&)W^=IjdKYe zHQ;9}+hFMsX;=+sb~FbWwy>}?hU34EuZTS`Y3dga*PkPUyQ$eHunnDe^t&B>L6vhk z$316u%okIpZR$Vv3H2soUB^TpYAFH@yK8Sa0BMD~MJ;;;=QwbC7L(hRJsRqhYp%hB z-&NLG*HVZXhME%zTJfn$3oK0eo$KYOXAX0$bUn$KeEj#qyJ>xk5jc3|p|-0qWl@2- z3~4-xSNc)D7}vOiPb4v0HsMQ6Di{>@RkkN@FE;Da2-AVpxxj48K8R$DCLCEkTV2=pI-<~#lMc783qi-JupTJe`iMPE&L zH~iun-`<(Ms+wkh>i$HyN-R~t1G464QdCZ^ObVBZ5}U+VhuZ9o>P-MEi$zxw@3uI7 zPRpSDe>*>i6>ef)!n2IkLH(LRf)vwos$ag|>hciL^VRFR77y}f(u`THfbymWruEPY zkjPEvuyxq8A~-##aUDB6od0D!LFTzsllf$MLz)Ttdb_H0@!r?X7BX`lywDE|{3(aIjKYr;5s?HjG#Px+$ zIwh9$;P<~9JznZ**y8XnFN@7#zG~tM^nej->@OzZJ4{#_MQ}jb4=*d707aMo(-X4& zGIxswzu?QZP@&T|lCD<16)Gz7>F*%@GPH_N2anFV&<>%_f0b;Q@yS)HzEckn3&)yW=TaUI z9>(j;0E<#ue;yNM!aYxLjAG$N5Cy~dOAhX}26Zexg)bP$G*zh)sS!a+svjRAeJ%5L&5azmKzeag>$S_}H<^|~}@;#=ePz-Wqy zTOEHUTxj#Y4#@Mm-Szv(vAOFGtMk1SiqrFQcVd5kC;Ec_b+V56UlZj2rc~tO`VW|7 zQ9~+ezZLV}jivev_>^Y-3y|X@*^Mye3C!gaj!bYZVVP?CgpNOkz`OPPdIhJAIjDmGz>Az~bG$@ztHUwM( z)#?T^3_X8lS4RYjWbjm5^QXJ&V5!VP@2x&U3W=86M*wknA^`Pw5QC@9XvFjEq4pk? z;Gc}lp}x3Ok$4NA{EXcr&!x0TE?b;Jqu5=nA?XAr9@cAAZt>Xng7bcNcTmFoF!ITsk5a-56i~|B#_0m!<#CNc14p#ahw}Ny=cXK-2k6c&cIf{qnJ`&P{c^! zxWv^Fpwh_htdw)vrKsl9l)*G5>G}6Il$bO(8s{UrQ5%&dyda0Ns&FyCb~z$;{MJCC z{M42bzxv;Ij7I>I|D5NM!z4d(eCaBpubAGB8iWaMucclo8(K!@>T`?(#ldNt$+C7B zuU*Oe9#ivtyBRCzka_a%HnT1mHFqfaCs&jX1k+K3DTEvsD<9fE$tVtVER}$SaX04@ zrBzd0!`{wqV)QId$S`btm(S*c&NdRTrySW|74DnctDixNXub5VYD&7P`8BPC+2#4l zwgoG_tn5SIa8IG#dt}Thttju@QOPtJ^6=-vy?oD)t}mkig;C{_O4Ge z{Jq81KJhaj*wf+DrIC|FTi9xo(l4gbh|?!9JJwSsYrME^tsNjFJw1sw4qW*c%s8eh zR;P4txg!YYi_*niJ*(kH|7-cD#unapIeXcX^9cF@vWY%C%0(Wh%PaNG^#>(c$V35E z_4jY*GWBBC8kA+D0oZT@)Xobm8c^3->uPc?h{c(>tKxzlqo!g+Z#?28`O1}7FcZ&( z?`iVsGv&;<8~mD);D9u=P>87biwY*x?BZuyIVH7_zJeno+tp2v8{Q7OS!bQyManYG zlzf#e@R~caHcWW$iFjXq2Lrklhtm4K!oPicm_qrUztjI<2#t`n(uQ?+WU?MML)8x# zs7&@Z|0Yv|iTjeJ~b4HKhXy?lJtQdVFc14cyo6Nth*uu?v&G(1&A&;Jbi@$wI z$I1rh;9wocWGR2NmhbW9h%0lg^k9X@u`w7(LuntO;1)uGxz#)MDf-Ke$xVh7K4h=8 z;T_c=b?Np4bSV(8^@(p!sfRa-q)^_?t-6vS=dw}Hav5+YzZ?saAZU4wGxxoQ*_zi_^ zw!rYPkck(%zdcUyXhbwei=o|Dz=ARm+wGVaob=1_F8P|ou(th zVUke(fLVNo=A)%r?=2`^EpC`lK*sb<{(vqWI#+WzFVLo^BE5&*kv-8&=B3q21EL)0 z7X-suYz*psioG~E>6ms|nXkVM0h>P#9+qOv&FYV2sphPzcR*kof~W-)@u7tLwS$%$ zUdm%XBr=a>>n@oMK58g=KfWF^;0l&f;gi-%IJmmyK_tej-Xzt5oFNoa!Jd6$!avzA zN1Nm(a!wIGBo+gtp8_$+NPoR^eOGwcRBJ8$Yu_1!WOA~3t$d_q_rg2OjTK0aRwTH7 z>9nc2NXWa^jVEeQi1VBVOTPAr^A(=eWCdeNmsVV6i`c4aM5uA2;w-3cFfCcOCvUqGUUIM7V^0+22-(gdwlwrl(^*@jMpo z?om1z$WX~4xb9TH6DM5~zgbnKF zA+OM=qd`zc`f1OGWeZrU5HqOeEgUTSYgDgyNEAg=Y_t;J&&!=Ip>e-*`Apm2&k)oQ z+Jc{(6gmL%fV|t(Chk~`|Bb5{@V(avrI4ooS3yAv;mKg${rR3ehcJKT}gY*dj{o=m4t)ICDqqV51abA6Q=x!vFxgj+?F!9ZqDMH^s8d^AzV;ZQa#(1%IAbv4FbV`%G*zwZIhI`P%`a}VG60yx{WRQ`&N4I@nxISJ=*Q_h)zfxb_4zHMbKU+2FI;QM$Ifh;P<$9h~dwm(- zMHso%L``I-BIf7f9()bNbQiN0eH#`ukGIp-9fP29In2|K1(t^8I%pk4Yo>0x$F@JA zSp9pe=#i=o^y^$TzJNDM?rtfcnWz;x<2}aO=rnAy{-~7ht>f)K13Rz!xq*Lt&&J`U ztC{#bNML2gX$y@!WcnVd9i$?nhf0VkNNQo?hUtIL??nbS`8be=ONLJd)J>qJqPXo; zUPc%xlnu8)sQq*RucbKn@v@f2N#LE6%88a8bASlQif`Mo(c5yoan;;{vtNEZWN-h! zuk7@;8j5@6{d*I-p!{B&yCD7E@1j}k-8BP#BN2|`;c3fTqzC*(u;MD|2PCj4D(tvO z_oEO}+r!yLSwK$1#$aN!=P1q$iNh(()0Gh8%r*oXM;|(+?7$gw=%yLBfae#Ebc$ z$?CxoAy`soK>lre=nOT42f;EC*-)kx@oY~zL=I$x!;5#r@R3Jg2Gi z*95^08vCK~U~H%nd2X_uhFXK6@&jWmA|8xwLa3;-jJc#}n>zR|eMv!BF6~fTaHz1iQbMS#S1rnpA)+XNr=|dPmlQDu zhI7GPN*;8ItA3_Ls101C+q>M7*k!sSJ3^4BZt`vJm9k z969}IQmILmT9=vPlTq|S3zIag$dcjL4)3%|^r5k6#BlS`y3yac6^uBi2r^#ye;9kG z;LO6UYdf}`bZjS2Y}>ZevE8w4r(>gI+qP}n_Mi9UtAAJRgI%@G?{##KwZ_n6Xe6**!je6=>RSaZDuwCUjOM_L=Bm4VruYHIDy>(<_L0WH{{K`n7rf(c} zM6%p=ADa2d;etB+p%h4RxCCm28=-E3L*>zx6oEFet{vFM-ydP+no*Zft%On;V)n;Y zPN&PhjRe{r1N7sb(snLihQE#)e9g@s9X~%Fs7TLVtij_evP4`yt3gUUnYn-)bY#|&vz?m%?pjHMKr6It%B%JyGfYv7P=}yo zu2UxEmWI-7M`^Y6@vFIXu5C5vYOw)nCTZvk=C{F4D-~UoGzj&0Z|SmZMRYaWsB&NT zsTUY}p6+4Y0jF57#Rmb-fN$q*c6gegrSFH^gw}JU%}Fr}Mh!jj?8WY=R|=a9Gsj>F zGdHr6?C*fEVF>pxDG?01Ty%)xL3_YC?K-L5=#u&s6rg#V9B_y=N?G3dg~6Q2iE-%+ z-K3!JOM@US5DBk-N{EUshHW+~4%mIn7Ug~DO-Z|nYVdf;Ufr94=0~SXxoA{Y7|1fD zd{#c0c^O`bvPwDGUoD7V&5pZvN@)M(UcBUUx%4SFo_$iGjVH3S5YDV5m_g} zoL4^5?dC41%MIwUsET134sE-!iRd(sZdk@~>1Lg4VrAOKu`!S4v5c;;h^|=1ai7Q0 zT*p}*Uy{)8Wc7d)pHrMchTsl{Ul5Isr(p&C#gZ41^Vf;w3C%$*a~;L6cV<*(UPQu` zd=Jdp&zX&U?92hl$S>8A9IAJ^Nj)@+#JXn~Db&hkL>LVxlmJ4KlU3-e zwe)V<=k@dRwilhZz{c6Xv!+tM zf5cL!*TEacKhK&u@88m51;ZcIF+S}#DiN)!3hJz+zilVt&RDDUhwkKhW9a#WG}QGY zJX-1556z?Kd@AEupslEhBjsa>GEmi`K}W0``J&zD>fbD^@!n!KVwVK%sQBnXO0f04 zhdev-scKFiA#0A`9*vMfxKY4(lmp@AqAbJ%k!7aCAO>2vi__sCJQvOFsU}1?f`+5yvkJ_SFYdKihjtBDilk3a-@FN3x2J$#N17phb$20aB4}abN*6_Qt zcS0*W*r<8wjR6~6!EfirK((_+kn3gP_P8zCSS4U2a@( zUQS=6x)CN|=jm1h9UHkQtL#(SVXj>Lj&h{xkhhhWY^rhix?rD*IBp)S>e#M&QstE@ z!c(wVE1npLMh}#P<-HCNrF2+go6o^?=*Sl~vNl|EqajSb^hflWJ&fIJyBlZ?xxZS3 zpZf}3Ff2j&nsAV$G?Bfd*bk%V2O`dT@fZGwc}(14<|;;uj_>;~@brn#Y|j-ot$Mgf z&gZ$KbqMh9Q3EW_Qi$NZusfZ;IZ%>`t)`komr-1bYDjg0*!ULQ*~RxnKA_0}h!LtYBY9hIe?)j6y}ki@Y+)ZsU|1Qb z0&-)@{@{+@Mez`|f3^nrLl8>t{d^AoxOe)PC#ZY1P15r{M|`s1S6M@-tx~5ZZpgddQA+V>9$f^+ z65XwTf_Zqb$UjmObx~h0GuKoWG6u3=a`DpfJz9$O+a3B*Us2{sef&5U5a09Wt&u)y z;&%MCVa24<%s7+R#FoTklH@Wh`ra}8)_30OEcHQ7_{vYVDNsav`iSk=^S4GRJ=^&f zX3h6G#DZjsI>4YElqRM*U7w`GC*cyx`AiU@QCQTpmrYemqfI`P>A$tF#-{XnkfmXX z8>1xBl{}ASp>&Z2fjtQ8dVXeq7Jw2*$!=d@3 zMe3koN<+e~0{0O0B9O1S`P53(j&(G_izxHed%M_n@POs@xW!gtnMcDf?>GQ*-LW(e z@L+`$z>g6&jb%V00v>}_!(y|GUm5Z5D#G>86@txdtMJOUN?+^p zdI%8?;5y(H2twY%&Yr^G=RifR-0`oQC?f))c5?C8nWj(Xoxy-#FYhk-HEwFhtsa>ccK`)8S~MTG4j(zLu%~n%025aN9=vhCCuK*76 z_Y>h>-EA@oj3|Wr#g$p1l(i=(?Yp4r=<->H~RDvfr;VBZT-iAlnE=99A&-)ES;| zVdIn;4?OL3Y%MJX6;YP?pP@@>TY@ zZu)@AUOen0jIV4+Wi{n|@MmIndVLCSGQv6VU+5|W)7r86!B_(0ik7%nBSyT2`k+sE z=GVAhtL|PBlE75%0++H!tMf!A%d%bGpo$1tEp`OZ<8X!{Ifdr%?yEdW8YeY)2VHbv zm7qhC=)CMxB1JzMdSIF#|0=mKMd5)+5)fYRu>|p}%ZIima4)ep9s9K~FJd%gP38=O zB>ZGEpph9(+%%|xdY#|$hLr<~=^rm`h1_X@9K{X9Sh~jrDA7%vH~A5f;Gjm%FA z)uBurk>YFluZQWGS$eZ(8i;Gm$l?|T!6!>RG}=!~;!WIg?BCL<-;cPxT?5%a@5yc$ z5DZ@>cVf`-tL;-4%7Ta48$m9yV9(P#4Y%Xh0Em<0TYz9f0_}PII~(aI)(zWlzuJfM zvcI*6n+)~#ZtMvo^+&hqK!3I?5Zn8}1-S?OGHrR6C*<Isy5M7Ul0+G?>1-V`N_$$RPPR?VZy4tSmg) zpnSB1mQicVk3||c@xLt z80xz}H?1w&tR_E)DYYn>x9(ia$-Rdt@4OT1OA6wvJMc{vYIyD>yr3;_vHZL*OF?yREauRq(*!H0si&PTkS+yRT-6SF+ z4ras^3LtAF;!dz8?XT>}-&lziLHJ1%(0mfjyJEVs#q9WI!bmx!nNVb}iSvp3?1xlY zbahDL$rIO4-H=Vtq(^tG?jQE<&h|-7qw+d*S|aTjd|ffG|2?)*PqK>hqfG{SzICM! zsN}txR*pj_mp1Bbdl8ChfYe2wtVoBuhoJv}vy+#4gdCk~E&ny!wOBHI_dtmZDhTx|6CTdX^&0vDY{D^n$Vm^UP#%T%Amt*l!=VaZ zoP$CZAr)NAaFVGp-SfSuVA2m&B4QPslyuNhTWKf4zFSK}^;#r+l@H+^lZ+OcfP{xL zn~@0t24Mn7i=Y;MLt8#7Ez^ruS2xL)FCU5Jx|MfW*wX1sC{QzEZPwK=Y(VB%@-D;b zPBp$mz=*9Mb08kJ(7HGpC^HQCv>}wXB~>Ig5==6z^0q%@V(^jS-mR{fIMIOVuAvNTa036>0EBS z(sR{MO@8mDUJ^amYyBEPy1B1NHJP==*eqGhy0#^9!2%~JdJyp@C!o;!#x`82W-N6Ta-AMvGWG4x#9+ zzIZM?v~NG!!TWIh?ls>qSWw#@2lXJWpw}E6-fU2v*mCW%Q>ai8OpBosXDIjQdSL%i zBs#MtgNqh?gh>hyNC@HsNyUa%BH)fKtLJiw_mX-`)s3AYYFUQ}{p3AgCo{>eUbB)Q za-$)Ar!~PT>%{Ur!u#tr$!Rke=?RAoH<3+#NzP5^H+lU&QitLJ;pgw_i%znVZ9FOq3uE&nUL!yF+yFe&olF zU!t82J)2+xPFR8WiPmyJE|*W#fFT#1uAY-z54(E)0Fz!l1fyyn7TKV2I67z0Lpr!CcpxPlet=-viU1yfK5X^T~Z7{ZhUvPFs-p)QtA4C9$$y? zo7=LS%o;0&zz7fD32HL{fV;&i7rHr|Phw13`9rQe?Y)?SO0|Wq9&dbn0d?!bK)F>} z7Ywui3?g18m`dgol4OZ$UDVQ9pNNq@5$@Aed<6+9n6rGCQO*^LjWq2sapxJ;+<2Hp;~Pq7)>ew84qI zM>$^B&?zBA8$9qKb_Zrb(OehdF%a({l^{Y|NVu6G!tS`@UVd6oV8bu+>^Pih2{S0C z#%-jsK5Vj26rz>t(LYTw%*4-SmMIQW+2V`pW@@aaxwK}EXt^14Q5YV`+#L&NaU*E< z_I8Dg2B#9P%Qb(s`=6K$c$k?ss9l5PgsoP}WuNP8LklOV-j`7qP;euao8uWYyKzmP z*q2*_a4bH2Tc{7;Nd02|;x>aQ;~|KA^r8Z{&PyHDW>k@vw2 z2r$e!1_cn=EE{mRvj|sZACNV~XyuGsU;y=H|E5qa8lq+*+b)PtMZb_fS3&mz0n+PMa^ik*475#{L-AZhHu!0pWU-MJ$~`fM0oFR?%1&n(myXBwh_%H zVamKG9cMxndFw86Lv}xL6Sxn zg}Y`h3YV-AfvbL@P{UBT_`FwlqAso3HJ$)b$zv$bpv;aU)uGFGAG`sf^)4gq+T7l_ zh9MX+4J$~GHAYp(b%E|0_udyM46L&mYx?X%@E6 zaP+tSR}vgNjAACYyE)jOU1UTI+1WQyZ#+>Z4e3gJPvSE>$#CqArL7~u2ONbm?TR=0 z{w%5I!A*Q1)}0p!JD4Ds>TO_yZo4|xmmiV=f&nBqa_;BWmkj=;=!{QovuD;%rzG=Q ziYX5{4;@`zBGR$8V#gSNB>H>+ir8?p(GZuSBSigvRGOL^PIX>VAdiJZL=O}3!wEy8ldCyOCh-gy zZ2Tfbp!P;@UT>QP!0{6+st2~*^rs>D+?^4KIwB6(lNdQI#+TRw8Q<|oNjZS+`-Mi8 zLx%wTc>5^R;9I@*;dg-st~!Ve)IJymS+~7vW~KA<_H&cQ-*4=)wgEbWtlOnG;}`c61!3Z$A?Io;Zzsx}v25+VbC$3ZpnPKXMU)PkY1jQ8fn! z0n+v^N}1bxMYp!bX0&wx?wZ=tDi0Pr9t)RWvJ$1%L>Ht4Ih&XO@lC2d2o~z0bq(jR z*tOYT4r;|X8h7FqvJaCun81`9Buh)!D6VcdAfGMklwCyjc)dI(PKVCmK`jKFAEv;2 z-cMkF5_&7AfHdU>x#jvycEyx@Y;AUUMYkgpaS_K3B4)*Z1n4o+*9DY&bJi;6@87fI zN`hCoNQeB?TPi&t66D`-} znb;0=S;`E#@h5f`^1tb0h&W=KEg7X~iYo~eJLT|E;;FiP!xL_^ zHR@O1UpB3XSOj79V(hr7ycwf>pEJGgxBCKnj+Y_+7gb_s{GWJ<0A}|8sJ1=)e_co? z5}3#&T_RKhi0kB3ZvuWso64DiOGh5yD+$J;Zg=~m z_Yj0G2->inSn%|IUo_h0-s$_DOL6>~uwuorfLHIH1V8BXG19bZK2-Gk)zsH(V9ZQQ zx}Ei>)5((cZPPrYfZu~-bUvRC&DtMIw#_Dn%LyNU)w!P^yg6arg;GK*sZ4be+XTJe z<28+uSDK3Zm!v3_(-~J+j4~a^R%pT0M=%V)NS2D#4(`3kiSMjsMFv{Tn%hl7HIE|0 zB<+{C7r=S6R;fKzEZ&3ut*%hKQe*L0qsy{f05z}>GFWk5O0+E;F~3ycc>NFaIeVDp ziYbbV-;vQ4+}LxAI}SbgLh^|Phaqs~ZB3|Kd={)*uFagtY z@C>K|g;u|iqOaC{@ku3@hpPn`Vz#|HTW*x6HoIrN2Xn%#iJHK33$L31(eO}Qpm3n6 z{O>dG*IV3F4|VrKTz9sr7_Z9g<|TQvh7AKXRsKM=2*YETdU&n!-x-pab%cEMg1Ne+ z4bokXRHGlq*si2pmsytZ9Ywe{RI&yQ3TjWglEXSHe|rqan^ zkX&DUVo_I#X+SV_{k(9$lK5FGo3y)U)xTT8NAzSbXzaq{p1t!p;7Bah^v9wP-wAN` z6Ok#yRo&TiskBlMATB){YHq&3g@Qzm&`~;7%&h=xC2fa4UX(P(@fm;n9EW>3gr{=N z>oSpAJOru;Y}TTwX53-+}=+L`ApzrlPfmX^c)7 zfNFz;XZm4#T8kqg*+&nL6xBZmx~8BJ>N;Rk!Vkp!8tx2uZ- zFtakTerBS)Cy_h1LNgt=-OMVG&(eV=j@;RoF`hx4R>r9cWFD!Z;Mn2ll!iQcYH(*v ze3fb_FJgp7Wb2Y1-nA;HsY))HozoJ@H>e|TDo5|#>RF2^tP~TU-1%3FR=x$MFs-CiiHy$yzPWq1Q3r}?-i-(w{TQ_(HGUC+;(H@RTbrC(;Lklth?r7 zq+Ze3x8oUo(BZX6MPbTU6K>DV;e-whBfNqk9H-#b|7H~okn#WMY#iR(dS5#;AsX}{_fJrDM%=@oL67a%okb)MX(<3-m$%h7 zkKa|T*;XZ#lQxL-p>NQXAb<;+5rT4O&%yyL02FA7B48R479V@!8jWbT*c&U?<+sn! zLqJ{jXc?ZtBoYUHvatJpFE(#S3da`vqe1rPbFF4YbS2w@km9&=|NE^s zybzx=XqO>>!oxc^?uIG|EHn;xKur{!2W| zau6e?o)F*GCI=_(f`bqT(E$g4ui$oOSMG0rpa^c zHLI5!zjnNTk)o&&TDu~i3q;}XBm#A{s-9!xok;Dwh3^#Ot`2)(A7Bfj5XfYK?P*0r z+$sq5O2D8f<;K?>vI#1p~uTjTL`;udEUA>0jJHq}$sv`n&J zRaIQL^oW*N)9&H?&UiLik94`h+4_eTc8h;*(q-G9K~}(Gstnrz1?C9Ff$rzmVC?m% z=h>a@XW&-M#NKM{)J}gDK?oH<$hGpbvMJ@Ct*T8QF_f9w<8?|hXVw2qB!;wU zPURAW(oOc24+36ir3h2!h#fjXBGKwHAZ3M#J{0wlx znml%?rz~Hze?ZmngkZFH{n_=~O+)2cauy8KVi7g5-=mXF8$%NvG zVZ3mBc@jwo#Q?pJkB3(4>&h!cRDv{85TuP=pu5B=U(;(3Dh9+U1xt=9lX7mZa$=;v zwa7+KXqsAb^Qy7&^%+m>I29t52;w5XPZW{o{WrhbjX^|CqB-SoA1zP3)(Gctq>ISf^UN9E6u) zF@>V-(-xvz4Lg>)X0-ilZ=*hrd$@j&J&L2zLS57XBknNI)`mm{(z!Ss2VkbjE*|0h z&|w<}C~kOm|4PyrFL(2dKB9S6g$_e6!xl0*l+Ffdi^a6y*D;|F>oU|FduS{)oX=mV zEcX}ocr6DS?R!Y!x8Up1MZ}-)uDW#!sZ68k7oO*^9S8-hCAeS2{n4R**azb#MG-!J zXduV&lL_5m`pfxpI{}Q$=gc3%=a|knqc!$$Fwsl)d_scfz0)R7@JDrVF-)+E7^z+| zmNiASi5(FTCa(rBQ5fX~149*sHX5+HZ%ifPe$@DS!y!l{L6GLPfE;lJ7@6fX;D|~8 zjTF4rKV%F<>k%NRk~1`tIP7N_Q>zSg!b;cuM}Y7X28yMM?=3ks;5UTJw3QgYI>efl zIQE248x0>Dh!3~Yi#|S;%3z1NHa8Yv-mhQhXy8p4!s*WqeQozkD&s;hVmVYGtrYWh z$J?TA)$q{MP4&AMOOM~6jrPMa_V_MO!SUzZC;9r*@UJVkXUER1Cf!80&+7Z)ywG#e z*0m?0pfAurX+<4vQC}}t`d6FhH~&>H|0fz8fP?WrXmE>Kx_0YqXx`h^NQ?$?wGq4Q zMZ^d*HnO#bG>j~p((}OoNGQ&%X_60E2A}rbsHEyn73%P~t0Ey7E0q>@TSJfa=I;31 z2l{Vf|3vf=Jc%h^m%v^hWO{%VK#32uV|kK3KnWuwc1D)Fb;WtzeC@HvGDRdA**AB+ z?LB7bLjoI5#G0uW-<~~c&%bbH$kqR~b^3m8Xkk_N9fbgf|D5$opMX$#HDNs)<<$0Z z7AOKUhqp|J)@+N_v;^h04)IIOC?9$s`h0ji#qNqwh<{WHC{3qq=wB!wD6E z5})K4304GRufRT<D6`q9;ZAmjmcGgktOqOy0VoDjHyvZD@_) zll8+fiZq_J+xsEHd#*ju02@lEbjqb0dL=^NhY%Bp*Fe+*oR)6pp#^&j>Y@qmdJjn^ zzjT|>yc#D6NN9v83|!mSpz&8gQX4it2A zsahCJ6R}iAzX5-%3*`Or4yBSy?Mm>q{Ww{!h=8L~Crh1id9EBggGjd!xQSC3UFinX zpT*q^BA#0$6ExAF1js!vu)VmvxY9rcIu7E5w#PG(Eg1s>o$DPi77-paMA8qa5%kqv zLm9Q1qPa%H_lcUxSo7322^F*c=o#-yk;CE{YI%vur~;-?Rjp=$kH*Q~(MDciFP$TM zwgxYQUn9e&2q^+xWKE;WHJ!>u5PNDGt+B`(HwN&^qKGwjq=HE^q3cx$8lkfk;S%x| zo;p!k_yA*g7L{e{?O1wDea3*IT?kpIVA62}0dfbt8doB6@38(#HoeX;6NW`NP=rNK z@~|5{*U;FK#*iuX@ zKSpw^+or5GLgkR4tzcTQU+tC7fQ3%0%u+6wCIMA`51&$>dl{+Ez~f_oTk`st&2-zw z=l!ZsTI0p;jy4$1M3Hsd_<4Fmg0_i0=0NtWX!3jF&iOxyG10#+$kzsI9OwKlkWd~9 z*BiP1wD8-v@LNis-vN-B+0VnzR zUSp5;=WIB;phH<=JM-s$;s z_iQYvpfBkYr+FW3(qQ*>;$Imw6#ZIcH>Z0ks7R*uK=SP$f{hVQ$!F5yFJ|1aH5kIo zc`>R32ML5reb`HQVLsE~!m%EmJxrkgK(S~GL+(NR=%k7=&DCCA+>7|^D3 z+VKMoTLmMGk2aI}=gxoKS4sC!-9|oWA^x`A$G`+J+-i|L@UIM7s+%@_W_mBL+w`iIk{1$6n_ z1{2ulFrN|*EsssPA(V?tOLLZ zCj7iQ6_Al+l`)vWkUN{pKUflc)}*$Xe($l#sr-7|diM5Qz$ z`q8?EhxBZL{A5DfktY2!D=w#=gkxe$raQ{)W)nbjVuFZbLt7I;!qN_&$^1Hpd^+SN zXWy_T@KXm)(EgYkXNed}o3N{u!10cHaCT_a z$24ILDZP$zZq0RcsRluw1WzUy&y)-Z(7`C3PKAC=u-mr3qo!u;-r5Nh;h2I$5B)Xdq>aB_!nq241z zWu%^wjy-b~DRn^LaaNz#^Y=ozc zZ|_H`QKY@E#iR^@`j6m$44t5Z}=QR>ppn3VA3~Ra$_J?af#7Y%DB+=Y4V)tJeu)5r8 z+~a})V)RJI&SC`tGUa?SE&o2Z0@Hw|vRnmB@OPZQmW!=IJ*+&Y+nsWRPK{+TzP9CR z_4iUGpnOBK%iz#a^wHN? zoi8I4_tG{4nL!YBJ;qLQDDPuwdWnX__jBHn_ToMT@_@E-70QlbNGH5atj<-TJ}xEo ziBnXRRg|*L<%H`B$%uJSR33qi4rN&$c@1F91f=^i$r)otHqxbgVV7XkjKF}k7k;

" outfile) (terpri outfile)) + (verbatim (princ "" outfile) (terpri outfile) + (setq *verbatim* nil)) + (tabular (princ "" outfile) (terpri outfile) + (popenv outfile)) + ((quotation abstract quote) + (princ "" outfile) (terpri outfile)) + )) + (item (princ "
  • " outfile)) + (pagebreak (setq *done* t) (incf *pagenumber*)) + ((bf tt em it) (pushfont word outfile)) + ((title section subsection subsubsection paragraph) + (searchfor #\{) + (pushfont (cadr (assoc word '((title h1) (section h2) + (subsection h3) (subsubsection h4) + (paragraph b)))) + outfile)) + ((vspace vspace*) (searchfor #\}) + (princ "

    " outfile) (terpri outfile)) + ((hspace hspace*) (searchfor #\}) + (dotimes (i 8) (princ " " outfile))) + ((index) (searchfor #\})) ; ignore and consume + (verb (setq termch (char *line* *ptr*)) + (incf *ptr*) + (pushfont 'tt outfile) + (xferchars outfile termch) + (popenv outfile) ) + ((cite bibitem) (searchfor #\{) + (princ "[" outfile) + (xferchars outfile #\}) + (princ "]" outfile) ) + (footnote (searchfor #\{) + (princ "[" outfile) + (pushenv 'footnote)) + (t (if *verbatim* + (while (< saveptr *ptr*) + (princ (char *line* saveptr) outfile) + (incf saveptr)) + (if (setq pair (assoc wordstring *specials* :test #'string=)) + (princ (cadr pair) outfile)) ) ) ) )) + +; push a new item on the mode stack +(defun pushenv (item) + (if (and *modestack* (eq (car *modestack*) nil)) + (setf (car *modestack*) item) + (push item *modestack*))) + +; 24 Jul 02; 25 Jul 02 +(defun popenv (outfile) + (let ((item (pop *modestack*)) new) + (setq new (cadr (assoc item '((em i) (bf b) (it i) ($ i))))) + (case item + ((bf tt it em $ h1 h2 h3 h4 sub sup) + (princ "" outfile)) + (footnote (princ "]" outfile)) + ) + item)) + +(defun pushfont (word outfile) + (let ((new (cadr (assoc word '((em i) (bf b) (it i) ($ i)))))) + (pushenv word) + (princ "<" outfile) (princ (or new word) outfile) + (princ ">" outfile) )) + +; transfer chars to output until termch +(defun xferchars (outfile termch) + (let (done) + (while (and (< *ptr* *lng*) (not done)) + (setq c (char *line* *ptr*)) + (incf *ptr*) + (if (char= c termch) + (setq done t) + (princ c outfile)) ) )) + +(defun dotabular (outfile) + (let ((ncols 0) done) + (searchfor #\{) + (while (and (< *ptr* *lng*) (not done)) + (setq c (char *line* *ptr*)) + (incf *ptr*) + (if (char= c #\}) + (setq done t) + (if (or (char= c #\l) (char= c #\r) (char= c #\c)) + (incf ncols))) ) + (princ "" outfile) + (terpri outfile) + (princ "" outfile) + (terpri outfile) + (princ "
    " outfile) + (pushenv 'table) + )) + +(defun termline (outfile) + (if (eq (car *modestack*) 'table) + (progn (princ "
    " outfile)) + (progn (princ "
    " outfile) (terpri outfile) ))) + +(defun safe-char () + (if (< *ptr* *lng*) + (char *line* *ptr*) + #\Space)) + +; Parse a word of alpha/num characters +; Returns ("word" ch) where ch is the terminating character +(defun parse-word (upper) + (let (c res) + (while (and (< *ptr* *lng*) + (or (alpha-char-p (setq c (char *line* *ptr*))) + (and res (digit-char-p c)) + (char= c #\*))) + (push (if upper (char-upcase c) c) res) + (incf *ptr*)) + (if res (list (coerce (nreverse res) 'string) + (and (not (alpha-char-p c)) c))) )) + +(defun searchfor (ch) + (let (c) + (while (and (< *ptr* *lng*) + (setq c (char *line* *ptr*)) + (not (char= ch c))) + (incf *ptr*)) + (if (and c (char= ch c)) (incf *ptr*)) + c)) + +(defun searchforalpha () + (while (and (< *ptr* *lng*) + (not (alpha-char-p (char *line* *ptr*)))) + (incf *ptr*))) + +(defun flushline () (setq *lng* 0)) + +(defun stringify (x) + (cond ((stringp x) x) + ((symbolp x) (symbol-name x)) + (t (princ-to-string x)))) + +; Parse an integer +(defun parse-int () + (let (c (n 0) digit found) + (while (and (< *ptr* *lng*) + (setq digit (digit-char-p + (setq c (char *line* *ptr*))))) + (setq found (or found digit)) + (setq n (+ (* n 10) digit)) + (incf *ptr*)) + (if found n) )) diff --git a/xgcl-2/general-c.c b/xgcl-2/general-c.c new file mode 100644 index 0000000..1dd207a --- /dev/null +++ b/xgcl-2/general-c.c @@ -0,0 +1,65 @@ +/* general-c.c Hiep Huu Nguyen 24 Jun 06 */ +/* 27 Aug 92; 24 Jan 06; 22 Jun 06 */ +/* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. */ + +/* 24 Jan 06: edited by G. Novak to remove vertex_array functions, + remove includes, change function arg lists to new form */ +/* 22 Jun 06: edited by G. Novak to be compatible with 64-bit machines */ + +#include +#define fixnum long +fixnum char_array(int size) { + return ((fixnum) calloc (size, sizeof(char))); +} + +char char_pos (char* array, int pos) { + return (array[pos]); +} + +void set_char_array (char* array, int pos, char val) { + array[pos] = val; +} + +fixnum int_array(int size) { + return ((fixnum) calloc (size, sizeof(int))); +} + +int int_pos (int* array, int pos) { + return (array[pos]); +} + +void set_int_array (int* array, int pos, int val) { + array[pos] = val; +} + +fixnum fixnum_array(int size) { + return ((fixnum) calloc (size, sizeof(fixnum))); +} + +fixnum fixnum_pos (fixnum* array, int pos) { + return (array[pos]); +} + +void set_fixnum_array (fixnum* array, int pos, fixnum val) { + array[pos] = val; +} + diff --git a/xgcl-2/gnu.license b/xgcl-2/gnu.license new file mode 100644 index 0000000..9a17037 --- /dev/null +++ b/xgcl-2/gnu.license @@ -0,0 +1,249 @@ + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + 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 1, 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, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/xgcl-2/makefile b/xgcl-2/makefile new file mode 100644 index 0000000..8c9654a --- /dev/null +++ b/xgcl-2/makefile @@ -0,0 +1,38 @@ +-include ../makedefs + + +all: objects #docs + +objects: $(LISP) + echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)' | $(LISP) + +saved_xgcl: $(LISP) + echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP) + +sys-proclaim.lisp: + echo '(load "sysdef.lisp")(compiler::emit-fn t)(xlib::compile-xgcl)(compiler::make-all-proclaims "*.fn")' | $(LISP) + +docs: dwdoc/dwdoccontents.html dwdoc.pdf + +dwdoc/dwdoccontents.html: $(LISP) + mkdir -p $(@D) && \ + cd $(@D) && \ + echo '(load "../sysdef.lisp")(in-package :xlib)(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms))(load "../gcl_tohtml.lsp")(load "../gcl_index.lsp")(tohtml "../dwdoc.tex" "dwdoc")(with-open-file (s "dwdoccontents.html" :direction :output) (let ((*standard-output* s)) (xlib::makecont "../dwdoc.tex" 1 "dwdoc")))(with-open-file (s "dwdocindex.html" :direction :output) (let ((*standard-output* s)) (xlib::printindex indexdata "dwdoc")))' | ../$< + + +dwdoc.pdf: dwdoc.tex + pdflatex $< + +clean: + rm -f *.o *.data saved_* cmpinclude.h dwdoc.aux dwdoc.log gmon.out + rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* *fn + +clean-docs: + rm -rf dwdoc dwdoc.pdf + +install: + -mkdir -p $(DESTDIR)$(INFO_DIR)../doc + -cp -r dwdoc $(DESTDIR)$(INFO_DIR)../doc + -cp *tex *.pdf $(DESTDIR)$(INFO_DIR)../doc + +#.INTERMEDIATE: saved_xgcl diff --git a/xgcl-2/package.lisp b/xgcl-2/package.lisp new file mode 100644 index 0000000..89b147d --- /dev/null +++ b/xgcl-2/package.lisp @@ -0,0 +1 @@ +(make-package :XLIB :use '(:lisp :system)) diff --git a/xgcl-2/sys-proclaim.lisp b/xgcl-2/sys-proclaim.lisp new file mode 100644 index 0000000..6428f0c --- /dev/null +++ b/xgcl-2/sys-proclaim.lisp @@ -0,0 +1,287 @@ + +(COMMON-LISP::IN-PACKAGE "COMMON-LISP-USER") +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) + XLIB::WINDOW-UNSET XLIB::WINDOW-GET-GEOMETRY + XLIB::WINDOW-SET-INVERT XLIB::WINDOW-FONT-INFO + XLIB::GET-ST-POINT XLIB::EDITMENU-YANK + XLIB::WINDOW-INIT-MOUSE-POLL XLIB::WINDOW-SET-XOR + XLIB::WINDOW-TOP-NEG-Y XLIB::WINDOW-LEFT + XLIB::WINDOW-QUERY-POINTER XLIB::TEXTMENU-DRAW + XLIB::EDITMENU-CARAT XLIB::EDITMENU-DRAW + XLIB::WINDOW-STD-LINE-ATTR XLIB::WINDOW-UNMAP + XLIB::WINDOW-QUERY-POINTER-B XLIB::WINDOW-BACKGROUND + XLIB::EDITMENU-DELETE XLIB::WINDOW-MOVE XLIB::DOWINDOWCOM + XLIB::WINDOW-SYNC XLIB::PICMENU-DRAW XLIB::WINDOW-MAP + XLIB::WINDOW-RESET-COLOR XLIB::EDITMENU-KILL + XLIB::BARMENU-DRAW XLIB::WINDOW-GET-GEOMETRY-B + XLIB::MENU-CLEAR XLIB::WINDOW-RESET XLIB::WINDOW-WFUNCTION + XLIB::MENU-DRAW XLIB::WINDOW-FOREGROUND XLIB::WINDOW-CLEAR + XLIB::EDITMENU-BACKSPACE XLIB::WINDOW-DRAW-BORDER + XLIB::LISP-STRING XLIB::WINDOW-SET-ERASE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) + XLIB::OPEN-WINDOW)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + XLIB::WINDOW-GET-ELLIPSE XLIB::EDITMENU-SELECT + XLIB::WINDOW-SET-XCOLOR XLIB::TEXTMENU-SELECT + XLIB::PICMENU-SELECT XLIB::MAKECONT XLIB::WINDOW-GET-CIRCLE + XLIB::MENU XLIB::WINDOW-GET-REGION XLIB::TEXTMENU-SET-TEXT + XLIB::MENU-SELECT XLIB::BARMENU-SELECT + XLIB::PICMENU-CREATE-FROM-SPEC XLIB::PRINTINDEX + XLIB::EDITMENU-EDIT XLIB::MENU-CREATE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + XLIB::BARMENU-UPDATE-VALUE XLIB::WINDOW-FONT-STRING-WIDTH + XLIB::MENU-FIND-ITEM-WIDTH XLIB::WINDOW-STRING-WIDTH + XLIB::PICMENU-BOX-ITEM XLIB::WINDOW-SET-FOREGROUND + XLIB::WINDOW-INVERTAREA XLIB::PICMENU-UNBOX-ITEM + XLIB::PICMENU-DRAW-NAMED-BUTTON XLIB::WINDOW-SET-CURSOR + XLIB::WINDOW-SET-LINE-WIDTH XLIB::PICMENU-DELETE-NAMED-BUTTON + XLIB::EDITMENU-ERASE XLIB::PICMENU-DRAW-BUTTON + XLIB::WINDOW-SET-BACKGROUND)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) + XLIB::XINIT XLIB::WINDOW-SCREEN-HEIGHT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) + XLIB::WINDOW-CIRCLE-RADIUS)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + XLIB::WINDOW-XOR-BOX-XY XLIB::WINDOW-DRAW-BOX-CORNERS + XLIB::WINDOW-DRAW-LINE-XY XLIB::WINDOW-DRAW-ARROW2-XY + XLIB::WINDOW-DRAW-ARROW-XY XLIB::WINDOW-DRAW-ELLIPSE-XY + XLIB::WINDOW-ERASE-BOX-XY XLIB::WINDOW-DRAW-BOX-XY + XLIB::WINDOW-DRAW-ARROWHEAD-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) + XLIB::WINDOW-COPY-AREA-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + XLIB::WINDOW-PRETTYPRINTAT XLIB::MENU-UNBOX-ITEM + XLIB::WINDOW-PRINTAT XLIB::WINDOW-DRAW-CROSSHAIRS-XY + XLIB::WINDOW-MOVETO-XY XLIB::WINDOW-INVERT-AREA + XLIB::WINDOW-DRAW-DOT-XY XLIB::WINDOW-DRAW-CARAT + XLIB::WINDOW-ERASE-AREA XLIB::MENU-BOX-ITEM + XLIB::WINDOW-DRAW-CROSS-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + XLIB::WINDOW-DRAW-CIRCLE-XY XLIB::WINDOW-PRINT-LINE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) + XLIB::WINDOW-PRETTYPRINTAT-XY XLIB::WINDOW-DRAW-CIRCLE-PT + XLIB::EDITMENU-DISPLAY XLIB::WINDOW-PRINTAT-XY + XLIB::WINDOW-PROCESS-CHAR-EVENT XLIB::MENU-DISPLAY-ITEM)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + XLIB::WINDOW-ADJ-BOX-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + XLIB::WINDOW-DRAW-ARC-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + XLIB::WINDOW-DRAW-ELLIPSE-PT XLIB::WINDOW-ERASE-AREA-XY + XLIB::WINDOW-INVERT-AREA-XY XLIB::WINDOW-DRAW-VECTOR-PT)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::*) + XLIB::WINDOW-DRAW-LINE XLIB::WINDOW-DRAW-BOX + XLIB::WINDOW-DRAW-CIRCLE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::*) + XLIB::WINDOW-DRAW-RCBOX-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + XLIB::WINDOW-DRAW-LATEX-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + XLIB::WINDOW-SET-LINE-ATTR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) + XLIB::WINDOW-DRAW-BOX-LINE-XY)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + XLIB::WINDOW-POSITIVE-Y XLIB::WINDOW-STRING-EXTENTS + XLIB::MENU-CHOOSE XLIB::WINDOW-SET-FONT XLIB::PUSHFONT + XLIB::WINDOW-STRING-HEIGHT XLIB::WORDLIST< + XLIB::EDITMENU-LINE-Y XLIB::MENU-ITEM-Y + XLIB::MENU-FIND-ITEM-HEIGHT XLIB::XFERCHARS + XLIB::WINDOW-CENTEROFFSET XLIB::MENU-FIND-ITEM-Y + XLIB::EDITMENU-CHAR XLIB::MENU-ITEM-VALUE + XLIB::MENU-FIND-ITEM)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) + XLIB::WINDOW-FREE-COLOR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) + XLIB::SEARCHFORALPHA XLIB::SAFE-CHAR XLIB::WINDOW-XINIT + XLIB::WINDOW-MENU XLIB::WINDOW-INIT-KEYMAP XLIB::PARSE-INT + XLIB::WINDOW-DESTROY-SELECTED-WINDOW + XLIB::WINDOW-GET-MOUSE-POSITION)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) + XLIB::FLUSHLINE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + XLIB::PICMENU-BUTTON-CONTAINSXY? XLIB::MENU-MOVETO-XY + XLIB::WINDOW-GET-BOX-SIZE XLIB::PRINTINDEXN + XLIB::WINDOW-GET-LINE-POSITION + XLIB::PICMENU-SET-NAMED-BUTTON-COLOR XLIB::EDITMENU-SETXY + XLIB::MENU-SELECT-B XLIB::MENU-REPOSITION-LINE + XLIB::WINDOW-GET-VECTOR-END)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + XLIB::WINDOW-CREATE XLIB::WINDOW-TRACK-MOUSE + XLIB::PICMENU-ITEM-POSITION XLIB::WINDOW-GET-CHARS + XLIB::TEXTMENU-CREATE XLIB::EDITMENU-CREATE XLIB::TOHTML + XLIB::WINDOW-SET-COLOR XLIB::MENU-ITEM-POSITION)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + XLIB::WINDOW-INPUT-STRING XLIB::PICMENU-CREATE-SPEC + XLIB::WINDOW-SET-COLOR-RGB XLIB::WINDOW-PRINT-LINES + XLIB::PICMENU-CREATE)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::T) + XLIB::WINDOW-GET-ICON-POSITION XLIB::BARMENU-CREATE + XLIB::WINDOW-GET-LATEX-POSITION XLIB::WINDOW-GET-BOX-POSITION)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + XLIB::WINDOW-EDIT XLIB::WINDOW-TRACK-MOUSE-IN-REGION)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + XLIB::WINDOW-ADJUST-BOX-SIDE XLIB::EDITMENU-EDIT-FN)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + XLIB::WINDOW-GET-BOX-LINE-POSITION)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) + XLIB::WINDOW-DESTROY XLIB::EDITMENU-CALCULATE-SIZE + XLIB::STRINGIFY XLIB::DOLINE XLIB::PUSHENV + XLIB::WINDOW-POLL-MOUSE XLIB::WINDOW-FONT XLIB::WINDOW-SIZE + XLIB::EDITMENU-END XLIB::WINDOW-PAINT XLIB::WINDOW-GEOMETRY + XLIB::MENU-DESTROY XLIB::WINDOW-LABEL + XLIB::PICMENU-CALCULATE-SIZE XLIB::POPENV XLIB::WINDOW-PARENT + XLIB::WINDOW-WAIT-UNMAP XLIB::EDITMENU-INIT + XLIB::WINDOW-GET-POINT XLIB::MENU-SELECT! + XLIB::MENU-CALCULATE-SIZE XLIB::BARMENU-INIT XLIB::DOCOMMAND + XLIB::MENU-INIT XLIB::WINDOW-OPEN XLIB::EDITMENU-META-B + XLIB::WINDOW-GET-RAW-CHAR XLIB::WINDOW-DRAWABLE-HEIGHT + XLIB::MENU-REPOSITION XLIB::WINDOW-YPOSITION + XLIB::EDITMENU-ALPHANUMBERICP XLIB::EDITMENU-NEXT + XLIB::MENU-SIZE XLIB::EDITMENU-PREVIOUS XLIB::EDITMENU-FORWARD + XLIB::EDITMENU-BEGINNING XLIB::PICMENU-DESTROY + XLIB::WINDOW-RESET-GEOMETRY XLIB::WINDOW-GCONTEXT + XLIB::EDITMENU-BACKWARD XLIB::TERMLINE + XLIB::WINDOW-DRAWABLE-WIDTH XLIB::WINDOW-GET-CROSSHAIRS + XLIB::BARMENU-CALCULATE-SIZE XLIB::WINDOW-CHAR-DECODE + XLIB::DOTABULAR XLIB::PICMENU-INIT XLIB::WINDOW-WAIT-EXPOSURE + XLIB::PARSE-WORD XLIB::TEXTMENU-INIT XLIB::SEARCHFOR + XLIB::MENU-OFFSET XLIB::MENU-ADJUST-OFFSET + XLIB::WINDOW-SET-COPY XLIB::TEXTMENU-CALCULATE-SIZE + XLIB::WINDOW-GET-CROSS XLIB::EDITMENU-META-F + XLIB::WINDOW-GET-CLICK XLIB::EDITMENU-CURRENT-CHAR + XLIB::DOHTML XLIB::WINDOW-CLOSE XLIB::EDITMENU-RETURN + XLIB::WINDOW-CODE-CHAR)) +(COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) + XLIB::WINDOW-FORCE-OUTPUT)) \ No newline at end of file diff --git a/xgcl-2/sysdef.lisp b/xgcl-2/sysdef.lisp new file mode 100644 index 0000000..639e819 --- /dev/null +++ b/xgcl-2/sysdef.lisp @@ -0,0 +1,81 @@ +; Copyright (c) 1994 William F. Schelter + +; See the files gnu.license and dec.copyright . + +; 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 1, 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, write to the Free Software +; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +; Some of the files that interface to the Xlib are adapted from DEC/MIT files. +; See the file dec.copyright for details. + +(load "package.lisp") +(in-package :XLIB) + +(defvar *files* '( "gcl_Xlib" + "gcl_Xutil" + "gcl_X" + "gcl_XAtom" + "gcl_defentry_events" + "gcl_Xstruct" + "gcl_XStruct_l_3" + "gcl_general" + "gcl_keysymdef" + "gcl_X10" + "gcl_Xinit" + "gcl_dwtrans" + "gcl_tohtml" + "gcl_index" +; "gcl_sysinit" + )) + + +(defun compile-xgcl() + #+(or m68k sh4) + (progn (trace si::readdir si::opendir si::closedir si::pathname-match-p) + (print (directory "*.c")) + (untrace si::readdir si::opendir si::closedir si::pathname-match-p)) + (mapc (lambda (x) + (let ((x (concatenate 'string compiler::*cc* " -I../h " (namestring x)))) + (unless (zerop (system x)) + (error "compile failure: ~s~%" x)))) + (or (directory "*.c") + #+(or m68k sh4) + (progn (print "qemu/readdir issue still present") + (mapcar (lambda (x) (truename (merge-pathnames ".c" x))) '("XStruct-4" "general-c" "Xutil-2" "Events" "XStruct-2"))))) + (mapc (lambda (x) + (compile-file (format nil "~a.lsp" x) :system-p t)) *files*)) + + +(defun load-xgcl() + (mapcar (lambda (x) (load (format nil "~a.o" x))) *files*)) + +(defun load-xgcl-interp() + (mapcar (lambda (x) (load (format nil "~a.lsp" x))) *files*)) + +(defun save-xgcl (pn) + (let* ((x (mapcar (lambda (x) (probe-file (concatenate 'string x ".o"))) *files*)) + (y (directory "*.o")) + (z (set-difference y x :test 'equal))) + (compiler::link x (namestring pn) (format nil "(load ~s)(mapc 'load '~s)" "sysdef.lisp" x) + (reduce (lambda (&rest xy) (when xy (concatenate 'string (namestring (car xy)) " " (cadr xy)))) z + :initial-value " -lXmu -lXt -lXext -lXaw -lX11" :from-end t) nil))) + + + + + + + + + diff --git a/xgcl-2/version b/xgcl-2/version new file mode 100644 index 0000000..0cfbf08 --- /dev/null +++ b/xgcl-2/version @@ -0,0 +1 @@ +2 -- 2.30.2

    • nM39Ll5ZS+cbfIF>>p%4~doVul*{Kxo@7eb!NQIR^}40w9_L z=nK~JX2uu|&ciBH*WC-f8dyhK1sPU$T9IC6X60!fibq_= zGosQnz{?U(gBEHtbr2!Mi#?6n)uMAQBLVC^G=72VJw+^S1=*>zBdqNW}t-G1SxdSg88!wkhxvP_IHeY z<2nW_DkcB?@=~k5DI|CR<)urRhyf<{WfO)%lHrN0JC99>3y6Qgj7iVeypPi<_7s^0 zv!tcLY%42WNUI_>y;=?&UQ#z057T_)!;hwsWPUR>fnLZJABpC9q`R5Sl|)OhqO2If z&#d(jhq>9vH>A$Mpkt(dkR4AnG@2NF^}ZR#Bn5?#1~+QL(ZG4uP=FfLjk`r+CVnqz za2*=iUmbKs^2Fn?Q~eTgl0}copVhz>imoxWdFgR|b%sO~&Y$5qR&Sylm~V8W9g`;gxbJE8ZYl6cG+zd$Wo z-p!UUaf6tCW^1U`noV+OHk{8L-|lDUBrFFGAHDt4g2Y#46CZNeJdGd3~`K4s7OE}4$_?%)zP3y=U8%dU{T#z*#;I0*sL zpp;>b8*dd(o&`71`KeMf_*?=SGY_z=vYVD!mXoBimG;0e5|9EByJ*1;#k z-OCejwr>JY$WxH?Yy%gp$mR5akjW5vt(i9(rkqv|6PD_|r>nYPFAXtu4i0r>MuSGm zxNy{1F*{rh0Yv;0y@@sK@Uv%LqgE2$?zbV^Ia#RpEYIyxb6eAD|dLw--rGiOVm{ zFy0{LMRVj`X&fWWHwh_!bd&qJ)EG_^7i0Vz&A(N}R|6nuU@1>c>F?&)bsG$!*ar+h zSDe;|g4+39316v?gx+Y8r-RBeXF&uspf1mWl>fMe8C;8Xv0K|Zw7k<@b|=Ri>Hzm^ zny~?~lyc~336$^pcyhy^{$hS|_kM|q<@@@>-RwtY?kbakE~o=_n|2x~oS735K~$g~ zv!MhxUMU+Q(m$h2PxX2TEfi%ccnpu*3EcyJ;(_ea3lopTGMS2Q{x2|pOx`d+fhy&M zZ~~t4)2$JCL$s05BKjo79eD3^8nei7*KL@_FJ9fAKr80&GVJoe3O4YqpCLfs9B?V( z$xDE=K-VqbmToUWUTxUl3t2^!{9SXQ{+moQ@y9f3^qr&-dKy{3S%&pGhaku zINr%oQU-{MA4R(T$|FLLm6w=woOP5+$inY*kryr5zLND3v7eLn-_VjaI#d5mz5j1q zIL80Wg=@wdk3AT9%Bh{BwJ{J`>ER&%YX}Sn1k(RF{rrmo){Z7s5>{fq?w$2&j#oin zV!AZIB5tU7Jzv^LUH9IegAMR=F2wwdpT2H-du@9=7H`QfY8slKK6nVtfITWkHG63L zX@C7z$R6$RTXmd){=OPigHZguJray8;L@w8Khw%G7G1jjD!A!fXy<%S*T?^9M~qH^ z$l!1n>+HA1*@Du>qT1YaKidFwRVcu~PowME_rry|CA!vt$2aJ!FydK+n`h^r0DT@x zQL2=cgm4j<^>M0rSAUhr+=mu|$fbp=_86Zs%j`MNY3%c`EJ`=vcl(Ms?)#%CRcv;P zn0_IQFNS?9cNqsAvJrIz|# zTCvOm3 z)YW)6i{h;fmfqhtSA?$^-DCpbJGSMQdsjN8v8w$DRj#mfpzC65;l=#3>`3DUA$Fk; z-BY+nQX)@3)&?z2n?aQ#c_b*M`iBN!Y$$h)`y=%#0apQgq#WzWFKN5)Am1c4 zFkFB&Ws>M(%+z%pxLw!2C?H&mL|-2DTbJx`8t9-fs$770kp<1U)6C+Pyn2t?Z}i^J zgTGTTZ$VRWYxrJ^m*Q4f;AYac!VoMF0Dp|ph#G*;Fg_;jqDRihwL@SMn<*fFg6`*^ zZUjwBl6Ln$?~T>38eCIuTC)2N8GmC)G_ zv1dpQm3jh-i%G2Z+7k6OlW#cx%*C;Fnmu*`%N4mFz@b}cXfuh{%EIWQ+Cjtv)L#(S z2Bu=@iyY2Sl0TIpdc6p4@Of7^FKGK1_{SsSqWC@R}-Goe9N6pg?plKGss)g?u<|Ve~g`D zlP18{Wy`j@Y&~V$wr$(C)n(gVHoI)wwrzWQW+Eoyowy(FpUBLUXYaLS)KChJ&p|&_ zsOJP4+Jt?5w#9_nXAif875k;9PM_pFmon$B+1?FIdJ!d)oEI=*z@e*za9up_mrv$b z^vtreoSEm|+m7Bigr`#;+4PWPQTh@w+h{I2IwfgSbh#Ys;#F}LucepRmz4FcVkl!2 z8zW#9?K?akkuwhEGmc6VccX07gbWWhCc&bFGrH$dX8o&W#iR+HIt(2NL9}ppj1>{D zY3=WcmSh6sxH&HCMl__FrZEl5PQ%V$!2yA)({eKY^7CHFO-#oLP@YDKyJ1;MTf7yqEJOBF-ndbpn8> z=3fuE&^io+N6)tgYA%T4VeaRz)jwg$@)32mvC0I;%igk~FHFJerWb3(!QB<~13j}h zv5J1$U(Y;64FE0dfNu0UiAdAg9yw2|RqrASE3r2nS>RKv!l7z@f<}W!8U*illOgD; zD%Iz|QqI#m=p}0j+u-}UaE=(9&MYPcKqJo4XEYRP25U4G ze;=iV^c6$WJz<(Bb-dQ-+Mh_>QfgOXLTT9j$mFO;iV6ZEAg(c~T5D_m-LC3Zxky$T z+%MuuJNci}sKzq9N1=6Rf27sxAy(iBmJ>;*mtDPNgL*}am4>??xOiT3bTUT?{Y03$ z-x-U>kelqhU?Ckn*7pzQ238AJ-r>~^eSFr#f~as~6#mZk{T_tl7APZsy;W*)%_DD; z?sxqBXBX(SytqQLiFIe??#YK9628g2RX)jdsQB&@x(p{9B#nP<;6UD&!5IC1HSj=Q z`O~~gn=`s-1+9lvwUBmH0}jwYUaAz%?Dw;VU*7PZi^>K z(^g0f_i6!x|2!2ieDg1m@AX5g;mh+XMG-lsR60#S+WO@IOb2BIyhRv*+qhwB*T69< z6+BCt6c-ylri#`pUY}xhq^5y-CT3?NUN1iWNU&|M*3jus4WXt_*K!}D-?(lAnJ27# z1RCO)bvWA`fv%|rT0?4DtYCuP6UhUP3FEB}igK%H-#Xpa83huO44`nYfSq>=UM&yy z7^z3gJG!k2Yem5MjAfdG`>Dk0hwioQJiH)7njj5dcc(!7yeN=Fmoi#@o{v|OmrZil z3hGsc(P~z~au**!pYgctZa=JkFthy$_a3!5-rqTe4{yE3R|7%oGAN$ir4@3<^vglV zpnCS*?3`)aHT;)v$wFM-?HgdMcck;l!tzJlVvG*y?f%V&fCBhCnNdiuR8SU*_~GSV z)fo({429({e0`z+IsCf#`fb0}vNY#uEV`h0yM_n;OHPx1*(lP##gCOdU1Q3{dODxn zQ2PV|xiKP*Ulv9#6``*B!q-OTLqgL@A7~@y&UBg^i&@wM)6DXF+qLekT|{Cvu{tWG zQ=PO#%?dShEif%&&7sjB9$`}Mn6({AkVr-DsX7`Kcmv!qTKMXy!OlaVS_v@qvI2l$ z_dT(PUF^vdR1<>4@8>XR7tfLfp%Ly64tB25*8XI9zxgZ>j9r(}LwL|fY=$-KJcTI2 zDCT}0KQGqkjR1f!&lQ8}*L?vEjH6RKdRKXp_*NtEDVLF+lqb@5ZM_V*OvtHf5{jXFTN_ZM8QP*o!dOG(O}CdNtpuGO%hj@`6u0{w zfndtpIpX7Nc0d;IcGutxgXGY5ERWWi0R-UyR8X4DSOufFqw1&odj3hP&{ zPG4i!Rnl-HZ<=HKxSc@hnJvYpClpm|8PPox$BkGzwZCV4`X&E(WC?Np33-`OYZpzH zR!7l}KmFpCBz1jMM=d?$(snZ+AmS|XZ)Rdp9G|?(&kj+#6~3C~JcSQFdQoT#03wcjZBzMOi4wtus8`M%eb%%L6s0tWlB9>xA zV4~G?e{lKQb9~6_`9ciHR0sM`!^?l=Y-46*`X5s3f6lg~gTMb9uys0Gj@{?MAB#gF zN0!n$esl-O0#)Cy(nuA_NOp7k@om2&6og(Jl^fS44;%b5cl!N)5vJBty&Bo?Z)3{w z`Ony9_;ixCG?ljA9nJV zg(52W?1T^O`M*)Hcih8;-3R|xeXk*u-agZBEo5$3Idig%P}o&8=DAK~5T$l3X>l24 zJSO#AV*lKA5U9{$oP5+^h5*gh0#EaAyrb@R3O3651BzZPHRp;fn&(741tOtwIx zGMcGfIF>xOTE9Q@^rB6w)cU$ZRXb}UQAdCzjOKE zlUEf5yDF3xp&f&}_5(Aazmq;WR1zRhIqo+_o<#2_#|EJoYFsAS|Man9CW%C{^c8${ z!jjh?OR45{79_jV8|vbOH*2SNJzhW}q;$ z(p#r)8N54W&nVW+pn=ztPA!SpV~WL_cJ=QL;FhE!;F6GSI&fsjOk0@itkPnkmo9Si zcMufAa-8fm=88_gQ(%&X>+J_!=NH$q&<7FA*wK7VH{qug@d=}m+^DEDC>#8_z zILhC(_Ep7jd$pcVAASuC`u$e@-@2|8pK(Ja%M5e<;ACD;05o8HdRorrljGKFWza=ck zcb$E%9T_dAoz)IFOP9$G2uYhO!?ljz5Dc?deEhH;Z>t*#cNL0cZ1Jm5*JJtB;NkaY z_%miVjYTSSg6HRzWsn0RIK6PTlQU^N)PtED20xFcqAPE1R(WRa(_WK(E+fp?x$O$> zz{jrVsqVMO#ci+e&@{0Jpu20GzEkjISaZK_Wx|o!cQO#^-RHg=xAZ*Ac?&$`-!&UULH9eeRoIuS^hSw(E2hS`%%WVH(Z0#5LYMe-;FO+)xwa7Xhmw z(iC`|NZ)qdY*`a+Ye9Dw@rMHzcx9Zq7> zDEzPx4Ke%tw0`tZuZSF}{#xj4hFGWx*l|X8Biv{#EMM|)W)^WKe1#8Z05B)*u=cQ zK_`hE%|LPnS$`hTQF26(-$} z$j=mu<=$N@{9>rpgjQZWK6+5F4aN*u1{GOmMl>53DMi!ieJsnpdS7H0rV0>(I{}t` zH3A=XAQtEDEZ)9nJcloGR)fiOKvR>WTGwNXnfWAweZQIqNr+eN5;yFV*w0V8S%Vk; zfaXMe=5@iRaYQ>6u-C#ZQ1(qT96aC>e@`e!$BPhKnM=ArO65kp7kSL~@7r@hY@G}z zhGEh-Z&(}WwWN$z++1q!g>*d7)vqSDVE4oO z%S=R$YYJLe$_X-Ow=t=%PWdW>NAF)|-Wy$IPEp>3hZ?80WINO5XsHox%hgS$BFodz z+r#BAOQ>&R);PKwrv~x2mZvHh^zZI#-E#gj@o`wUbi1>7@D5g|mujz61b#XX1~~fz zKB~q!e#-}65sL=t#G^X9{)s=!9y866<~U&FeoV<8vLGgm!IXUKe&bs1_=1Vs1YjC9 zw`$QSxL*m^qV~D(0bMBHu9sXxP8PLQcHiJc=oG9LkE;Pog2tP5kseUwV=2>mk#A@L zy)=j&bD#+H(=-?s{N8P$+;A%T^$K}_ZVipn@5TUh8to3SemKKgL#>c2V<7Ot|v$fB)sh)14THt z+WbM}#tL9mD9LgXnXAY)*0s!EvsI7e(^Qf=fK+HYjFl!hCUYq57 z2z{)9pA?1?guV3L)45O4XCj{Jqhljln<Z9qkgH0qVsNK6i z?fSmM&G2thZj1T!$Bg7Bllc_^Sx)sbwS*7J>)owZL@A_#lDpa<2 z)lW7QbZ0nkbVrxNzEw5=ZTVYsKC=g@)(fXE!Et)|+(P{t( zCG9i&{;dqD5tu=t(T5^hGC4~Rl%v%x0o2|vKK!7;I7`(?Dk~IaZK%`@PNY8TnXsbI z=pb&~iFl>q(6&o)u^$)wPti-0FAmZD$_K!gpK0q1nm#zfc;;H_Q+5b?sJWrbbKeto z!tp!Vhj9|68sa`?FG*Qtb*|01(fBK&UpG|?$?*IhwF;#9%G|!pP2cozAF0EqRusoG zbryBM-JEJO`O_dgDS8`EMTEYN=vdFi^GW)xT-Dv%A$tXA01M}nPkfWxa0?J26ct0J zJ5LimA=V){sWN$MVfua_yyMhdcLRRBr+TuWpYeqL18tfl-78PiFzDT~(7invr?>4> zQDe{FGU5cZ2je-{K{xd~*=V?wi2n6V{s)}PaR2&0j2#^RrL69M?o5WXq~i|%&)D&( zXk2CS+kTy5S_=YbJ!vc`%o73Br@*JyK9_d>~?7y6TuVv3&apDRMoF^9AMTJxNq4C#Es zK$RL!XRUX0{VtV}f}V-Cv2*_EI)m?Mb+!xtk8`?z&S>!-H{L@(vu}^H*ulVMF772n zQ9uXR&h-6b0HnMu2RZu7;x@Z{S^)yiN8ERqm_Kw>$dt>HH19srUvIvasrvWXF!z#N zKXWUVi6mU!soI@1$}teID5t5m2dB|cQ!&6yumSGRwNtU@^MWbI0I}(EoJ4nClP`J^Vt@pyvva{8etT1b+_RiDDKse1fNZQys6oj5%hO6P(;u?&sNZDi z%=q9}cxf)6wS^=_3A02h14UX0p}}BtItlAlcC68#cLgt@LJ6$MEGVn;>1zf&C(1f& zPtU#RI`VCa{PHXpJ5-l{ zvkNpBY`}I_W~pY=W=w!Auw~mGN(ACZT{#aU2TVMJo!L8o9Tj^woLN#EeR!)*bwZ&0 zA8v#i^6c^wbd{>u81h4fk}%6x|29F~brrGeTDq z{E~Uw?^#B0QE(j__$<;uX9Su3h5JVA?GlUG-)GvXLJMy!G$C?RbqD*8q05TbnWTVv zvil9;kctjI<}hPvP?-2xH(41w;>Q7AkqXpJ* zgJTwY8`mw3a=3fQZD%nR2Hxtk#3?mZm30RagDE7p@rgkUVnaG^cI&5Z4XP6PFI7Abz*0>3ff#SppdmY)t znVguxltV)lV+#ZV=@PAP_z91rBz?=H#<%7c|AV_xQh64Hq8KCxhd4FHU$@4?4dK!1 z16)V0L!X)-w*Wj!CoFCVT%!62THf8S;!pmpBg=BnN4#0n-5i3+J}?HQ$kWVgUj+U` ztcfa$wT}*`C+w{p;B!bT3?8j(gJ=ug`&ZYU4uy;}izaSeHl#-xmWyrDo%=_=mMxe6bvGIp6RELKw}vt#c)ZJr%D#VlW&*`CM}srB4QGT5vEM;=N;vq(mSCVhkZ~iGbe780EJX zIfywXp`#j9lI`i&`t04fH}D$KrN&qO1TwYLJ~w40zXx7HY_MR&tGGNn9U)ZFWdSX96)+M0peln zV?#yb%KUp#$tH1)T6tZHl<>+A@(dPal|&QCzO21;JquJEFuN;d;sGlf)>H4(Zw;mU z+L0eiGgx9*A@711iB>jO!ln`(m=rVeQeY^K7vSfGP)5)$VBF|ZU*^e_7($rh7%w+W zd8Lg3efB%?ZmC#Ohf}IncG#1_2Hg_l`BA0|%0Z&4rmE-~_EYHsafJJ=g}F-OJh}XZ zmpQljX{3FqV6`@jW+93sag3yooS|+-kMemPR)CdFvQ1x05Jl@$mI**IDF%*VmsKhb z$f6VC1%bBUerCxGYtQsqTp%-*@nYv!wXt>ba9mT>ansj{*J^8?z9TP=+P!3m=!gvD z({S%s$qoUrj!keKrFf99G_<7!hqE5*IEY1moozXNWx}~w8-5%v5JZ~EY_mHc*z7e?8`;0I6>O#Q6(d~Yj2}`?Mad$b; z;U#;~(2^Lzu)V&H{Xy)Y*5Aa*qw)lu+fGR5RN$AGAtqe3`8 zU%%|3QBIRW1v*!s0Ip$ z6?hS~sR^;KHbs&XG_cZGwS%t{h>89V?c$}Kq`kdHfx)=w2~LedfR#T>YeVT{!C74z z*F2r?zVV3`s1b$9rr6~opx?m>Z6_KhuToiFm-)wp)&xH8f_otC9br2%hN_c2*6=|V zDu>}p`5=je*}NWSoUf)oN51d;7wJrGq7Me_>AuZ_xOl{~hB zWcb>J*Cu2Bn)W@|XQH?OUXsT|@-tk^r2Mb-^I)QAcH=HE$}t-nRq|@EaEU8GEdkIE+cW z7vrMYnZo#b?I7|2+&yUIZNL7LeG!8&#^Vi35+)l={NB6xhK-`7kizVXL!uVnPcuNlvLkP2*3OS7BpYh! zO0LH`wZ^hzxk88J?jk@^E#K1asRkmC(UQ{AdSzOs2FFZqjTrvmQ_J|8;pV8TTk)k@ zgqOWI73et|F0YYeT#Be%kz;lOmT{g#_|3zbXMv`|bvy%lp>7ijT)1&o1Ebv-Vm6w)9fqF{l z&c8|U{Z{$|@>qIV@t+?3|DF4egZck6RR6!4Lz$$eMkiGK*w~tha@Kfz;=1G!(n)Uu z2g$NhQEHLfrGL*C(Ce%KvmS+M8nh7M?B#d+$3+P{zx|?EKSA>y_V@VIchlR#*KyX( zqnM=PsF3Y70Xx+WB?(NH{Wapx8pi!~&x`+t#h=g@2>ju(7XrV}Z#(nowbZLXNdK=} zdVHUa968-6UE#WY^E^p6R zX=zjP?zbLG{+$DwJ=KuiYCW5lkPjXwe|?`Gimxj{`8nM>OE%-u8Z7x9Y-CSmO$d5f-9TacHxvn4>b~MX1 zqhPqL%YJkPmv(Nr@lK339M_%6Q|b-fIAdwF=8Q!%X#QObG*uD9afz#1yVJPKuMLxC zUcN%zQOlb)CC}Wgn+;wk&`Lyt6YSn@zK<*`??z{sC@;Pk3L#+ zQ{Z}l^FOUVl`bxG{mO{dCZOY810CXfiN5ep|t4BHIMSya3euPSn3AMoq6DN ztcx9kfFW%3lDKXx+TM#)_AS%ldq93CWPGO9#~^R7(zm$rb&Z$%aXA4Mwh+;C-o6fN zavN7G)IfQu+6VCw1wp2%QL#c8Zqjdp|c*xA6Gdjr(f!_4Q82x%hsmw3sHj z?9lw0er*Y;3T=KLXOtzPA-WuAL@j|tJ)4{XMk97jwWavIY>owV&BWDxD`{^3UX{~z)!P1}qLG;Sd|WjKQF0zqeW>rE1_pw8NWIO`8)P)uRDaBirb_@)N9lv$Z@cJ?~Pt%tozOMMA&% zo4Q8@8)vKjqlz&9);~I?kx4QSQ1$)=kMjD7ei-&B$^)jBKrPV9iE-CR^GKbbl+F>6 zu+&G&aKPYMV>(A=oYLA~e9aVxU1-D}IN&wZLW1<6TUk#&cGh}+jr#yZAB6Q=CCaY9 zrfc^g4JOKe<wtU6j~t792sQFB2giII$Xh%Y(>1rEY! z;Z4BIjX(V+;wbYD2nNU=Fc+H8r4Xr?BEX(@rPZUf3nrsJw-mxsRV@VV2^GYMSQo%A zn{H_dH=2D6uiq|qR5Yf2jl)c0VLL!?mnxtuBk-L=8ONK~+1fLWdJEXBSN zM9o37d3d0*Wq(B~b!X@>pNOLCN+%hmS0Rg&h1t0^oLS&u_@Z#B!8LCvEH3_Qr=#=q`> z&Mbvjz-=_0N#Vv<8!uOB8%&rNMlWgXkvU)`4UoKX{VW0Z8+$fd0|PYM(Q8}jVsI}@ zmuZZFeR~&ikb8wV8Hp~GW6pGg2Y8f{AwWiv(I8HwXB2M2B3JS&=MuXQT|(H2;ID_@ z(eR@gV`h6c+k2YEOo$V9dT&;52Sp7rQ>piIo zzM!ZPz8|V8`^R|gzAV%voxGdUmWZU(x49WYQcLbh*yM(OQ{>dAg3(AdWfQ@pkt%Ym zKx4Ls-$5#Avn<&95HWm$uXClr-f}6DA**-5K$Vq3Gje|tJicH4d#v*k4qJHKl&BQh zg0@r;U%?heU4W5Z@GG(-2UPi6qveB2Gs&|zV5WyO5odp*5#u(32`>nyY$sBkcy`)o z#t7Xu5s$(+G;ciJG)v4>IWy}l$uYjc@D0UQ*wsjlA?TdQQMe|!|NKFqeI>H75upw(pnUG;7-wHDNV%_NjO`VoXur+4_X%&`(_?Duj*0?e&6)AQ1U8Px7 zUMDjyM^uVZy&I*$Ueu;Xrf(DiD=d22j!N?&PC{1Mm9;gR-M+H|v2pqt=tJmr0Y^VHzEN!zp$Q-IXO#-u!m#dApd zMd_34FR3F&5yv|#Bkp_{_yr~zem7ZRmS;~1jI)l`4g2z?ozgGCqbTx;b%LtNZ5!Ly zvn(Jk-0{2(g=-?D)?b$Q(a0(0>q+AuQL@0d|J;Rby@*4!tsP~)J`sY90e<(96@@p)Hd zEm#@M!^*==+d9gSeo-ir7sZ_aXwU3nV04Z)TxQCVu7QP0_jhqQAJDg4Eb zj;_1I+yy>o9ET)V;G?c!s`NrLJkYRMUB0ChvZ~&S?iyw(#%7GDvGWO_YsfD8?3ams zVLQkJA-;&~E|HHcd`0yhGV_W#3U3qK9OVbMsDHikmD|Ks*5fDjrogE9)8-gf`yBF9 zZ`3Ime{Z8YOT%}e56Y;{h{USvng8zbYdl2y{eUuEpW{fKu=A~;|F=+^X0i#aSprq< z!p0<#o}_&)C7gZT=kat&llA0A<&6bLq``4~=*72F&)dn3A2_KDFzbJMRsUCtJZ6Uf zNjLnL;Bh|qzvW?xQZbEv(fE$iF_Tg&XX)xnr_o~p>82?W;%3q#tdo^e0w9s`{Nbdc zOR7Y|2yy=I@AiVJ8=SVWJ$bwApdX(`Zo6-np0~Zm^-&!aPcrtGI2=v8B8(IO`^!g< zd0y_t!XlizcC~AXf9D3aaYLT|b=BDUKwIv5_kcT9We2bO`yzq-Rp8F&!8bk5pQ7FZ zXYAU<#nz=z3<#~35|m<=#~Qq|EyTPlBVMW1O&gJ1>GP$|*}ca)({ZcD z82v?MCmoXU!p`W90bt83_{#>DwMG1_#n(_2xs=8`|Mm^7c&Uxz5=AXa-we~s8BjTq z#yJu2?GsJ;4@voSSoWP6%hQ{`@BG5GQ9l! zy>#PMlGGzm;6l?o<@ZV!@lJlyTL$)?b^V}{9b!?mj}?V67{zMesK8EP-90Xy&n4iF zaGiO&yle!wYKhThwid$=fxjA5O%eq4XcoSa-#Py!9h$YOMXnc}KKcr3mcVh642`cw z2N0&}ISVCu;)_{8*MGaMcK|lC#qE@^Ua79Yc4B>wYcxi4b#vlNA{AxHs!Sy516Ci!IZ=fea?d-V^m(%_qD? zcEp~?;cXQ?IDJQyIXld3zXite#S)0<`?R>M)}_QL;TJgVQ=Ftcc#ap~r%mwlN{dBE z=MU{_%Pfw?xw;=_rug*e#R6fbl@bNsH|W zy;{7KkxxxUD4re^kOmJ_hc~pAY6@CPDlFWtsQXAsR^q?cI^z*;=)XL4<87B49-G+!VbiO5)Twieu`CY+K&|BGZf~ z3b6FBdeb1vJdI-K{&7MiQjm)Ag#}>QreA0ZRD!Af{ELl3N!G(?fN#J+U*r?)_luYf#W7?Cnl+3z3sWfU;022JU`2M$pHd z*!{x%3!Lf55rOt-1Fb=b0d4*S;x`HN`RQe}K&o3p3a2aluU_z=KyVSE9&4dHZbe9Q zBpCCd&cKb}qx!6bNL%QFl3SrODplRDJa&87%kcbN13%{tp5{cWQ=qOgB?a<3uyNY; zu-P9rj;7Vakj}$|sA{X9gbW7f@NU-4J0yr@Qj?axHI%XQc5gxPl?Eyp5YSI+h_2JY zS8ToB#rW%{tJ)4$+i9*qU_tm6DxIh*6uv-27|P<>X|y2K!Y{hFRzoybt|S}TvR=n^ zc)U{_4+XVqUiWTiH=5;37^+N8H~nhz&TNqVx6C|9K_zjuZTH_Mjeh|=P9ge*0&Opd z!qXa#qxmdqvZ9A;o9!X;Ye!|N4xlhvX$9a*lFD9oR(?Gsa2!r6N`f~tP^3&D<~yQJ z!#@!;CS&ig5fllbOwv`;j6g%T!0hkDVa~w zNW^5rj(=;1HJZn!vlgL8+zIxv07UeZ_jUq)H5DW$77-v_%gTfWVJ~P_mJ5kTzvp)O zeLIjmQr>Q8dc4zmb9lEgP$&gT1OR33%v>Rf<-G4)`%GewIOk)Uf@eH1y?bg`)+rs< zmZGMs8(H&JJ+Pa)S7#y3B!S8a?sd9nJxFc{r@j_z?B;(wUR~ z-hoOyNMTV(zuXi=!u7oh{H=6$^#C zBZ3PVTK!Sj_b$W;Yh7S;{=4(S99*~c{Ll=Wsgi(i(DJcl?H22nS)#QDH~bbQmj zgZl%8z*F`~ckl=A>-+AExevt$v8zNBa?eyhh`t5yFBw|NLn1CX!#mFf2`y!v7I%g9 zSoZG-vrAPS^8g>BzKDX+0~6`Lm4BamBLxQFSn(0mKch$`eg;8FSqkVac%HV>s)399 zk#ormC^Aq!>72j59<>o9p-b8lB1W0+h*JS|74k*VSPE?1_Q_mV%a0evIJIW^sA0sy zfl%yraJKcPdsb~+|MbzSrI@NGiyjTP4`3yKiXo7Tq63DBYuWf}m)Y;nnN})Q@Xh?p z^_)vL0+l*twXeIFt1iejVyw^!+3^nE&JISxov>w%fb&z!H$*4u&m>8Gy zOhO6eYK2^<-A~&*LkrS1d52c4yUYmve`iWo{|!N-P@|n6kwIZ#QroLR%y9U$$75O( zDoZa_;sW9psyG=!+1wm32Nt;49uAkjG9t(6FM4IGe}$Pz(xIuA?JffAwqrTWL;SIE zxa&}rB1no;fLNHbRKHxZDlmpVGj#)U%&Bh;z!TYDhFlbQE0(kR6@|v$oF!bNyd?uI zYbUz5=#Cuo5#cIRV%sf&C~mj!6&duTWXhx})mxpS8WM^X(asWKRNl6jmZ@*0kgw&& zcFX~P(&QJoiSCrk(qFieB=*a57Y9k{s6zni3Sa3rSz3=l0#QpI)Koo+tObJhokgtd z1SzgI<*YCP!s9Etuw=Q*^BK@@)Ov(dhElj$+b;!mY7!^czVi`0grwxW>@;zqdmW8} zUxIeBMVty3%{{i2_lWAo_~Yr%|e^}Yvh3DBRTB7Pz6y!wnZXpA)J4kDqo z!|&;v^B6O!j2ctuJh^SXQ*~#m4Nhoz;ZANmv|3r?$?>d1PM{i7?Wr`YoA+go)U+aS zJQ0v}tZJU;qMFgbT%J65>%;s=*Ts?bDGJDa!w& zMDX86z)nDFLp1$NRSiHi@xB_YQD^Ha-%O3xL%YDa`C*E{KnS zY2cDn0MLroT?=ef;q3h;LzjtW1-sq6&wblY(JgOb2i2@D`nc>v9;1%!B69I)&!1FtR7i-rcCQxhf&H?{ z0OlLvWpUGJD@pC)tyw(*2@HGzLdcCLP@Bl4p4^MJMZOt1wT0F^q*>i%m>}kI{iU$#g-Seb{z13Lb3G>}ya~YT2?YpPVugU|^5A-wZ z1Znpx7l0g?QCfoilV55Qd)&JG#=GT(!#Y2|G6UDAf^nq_(WPqft*qD+5ku|w=i?^W-Y?gGS>2~SF3l1vbb>mCvn7J&7`~tPH@}A!{!d8x#SiKK zG(h}!#zs!g|A9xZ*4m2uM<4RP(Kp;o(y8*?PopfBzj~T4;Q&)NiQ?Pb4kor<0kIiN zIkb81xq%BWq70W~6HNdrk%-K`d7H9e|5>}0MfiCghI-Aj&s;dBf5{@)iG-igOi}l7 z{%PGi3X@hVcXICep{*Qze);gX2|=60gr+|@%-iwzXxWkkG`8<7?AqV_hz93{Em)p9 zRyF9ipUE`(Sj&As(8k*7d}z5;8Ir2G)b)4aR%fvqh=iYTwrlzP zY_ptU)+v%%-dn1eJQkKlRc6;eZ^L>2jj=v+V!Yz=a2L89x5d)ptyRenl0uI2w{Vot zHgNkH0mCJCDHaM3mB?glT*=lgFn&aOXIB-Fm|_x2_p9*bN_bjTUcL5AZc|l7#u`s| z$*&@gy8{&pjiz?e4ASagy#{4uBZo?6`8luMvC@<6k?@mK6lcbHxY%j^Ne423 zF1FO}FG_!#XRm$+p4B4p7?e3j#Hih>dvB_Zc&%B-vBwpz;_WxX{44|+Kfr`L2+r{W=>VuFJZN52a6R1_SuC@@J$c=4SDVA#&&Kw z8c9cRu(W&@y@qj=+l5(v1j3nbXw`we2wKdQfJJ^y{PTt6WqI&}{(45dunFX+g2*ZY zGi;xx@1^;HhX|^RvpuFcUxun`5B*!<)9o8t_9x^#SvC2EBNw+^Blm@jfzZeL10lwV zY2qIUwm(0Q@VHa~z~aNvFFe{80!$7=`Iigd0lD({VDV zuvZ0MMhd-Wv*GoE#zT=T2==Wy#14v|_TKN8u@LA1~F2x`P+CsDF<)??Y519OQzEA1WmuYEX=F@>V+aMq*+|Sing~KrK(!hJL=7F`VNJz1W*Ji zL}R}|nRVKe&kkp<_p#w`7RTOxga`Gr7W(Gn)~^!32TDrnN#A^zR-`2k1)LmvdwE?S z3oDVg2Uscj%UcNeoKOmxguECjDT85mjYvvB|8vLVhvUOaDSD=pQ|KAa@-{bZXtm{Jg(YPpIWN`J%4f9XfVB@!po5O>3j z9FbTYcGlCek?g6upcJTgPj`*Er;$sZC=>TSuVsAZ(f}t}l{TbubX5;tkbhwLdQT0&7QJTMKxuno*`kL)+ zizU0t;$jUfp=~W0y0RIN3oP>SWz>JI5+U^`y^^ER3}htd5SH}kcbIGp7JyTO#(M-? zeVlueJ?qq@3scDA!X1g#)v#Zk{B4^&!%s9LqZeKd+1E9-Z;406tApIbF++<(PH%Qf zac*)-HX~Hi&9N!^j4Z8vK!sfG>d%(+lpMNO(CCzcM6wO=YaT?xImaCzG*h6{@hMf5 zu43)xYFwZ&d0?7q!WglE^dnt_;aTD?bGmVO-sjcQ8v+cgJ4S~?o>YxLaVfEt0c(Is z+`|Mb%8Z?p-#jag+oJ13>3NKlhPwMyjMQJ}fov!^99oYw)i2(vQVw9{;m3^nkgOX` z{mN_<>9s~{cLsAtUIg3pd@6ozT+jQY<~L-Efk0e^Sibk14xO) z4mvN$n=GSB?I>me@^75av>x2(80;}|bt@iGAa|n9_4WIb<#{EoRFg5;6<47-ly3_4uwW(ja|!yedW-KA`_HH&@>sN8(%X9^6& z&^1krr0@|gS0=Ce&^8P>u3)VqGV21iL6S+qd&^3`8aw$DgNyc_I6vXHLbVq z9mz)=tK#9f@YCQNz8+cUaf|G`3TLPa4US#)k$I>%^G_qya*=?M&@?=Ft4eaa>K%4S zY?=@L*)F{Z@Ecq^H;k;;IzlhWwUVm0^7Xj@uEf;s9{9a^_4k%ME^^>6V!&ub(Ikl# z7Ub;o?$S+R0p|)Ep@9!{qy}ExP(@c}zyEnY&QiHO z=rx_aC{XMWi9!FU;iDvqLYFBEk0Jgc%>TkSnlDkD(B2U77yy-` zSehyiDk2DK9Ss@KLJIn&2~b*8U*w+3z7oZE41Rv2{|w(Jx_ftw-~ST*IsQYPC@bTC zALak|JIcS&`d_2`w}mi++S_ysCCu4*l&%Xp&a;MdXFb(hkC*Ks#{GH51| zT>J?F)Cr&BInaD~c$QBlBB~hQ2`L4)VQL#+=W_5B_}dGpeWUt9s_?n0!Zi>=p%+U7 z*Lq7GC-3gIvKO#Mm4??Sh*uevMmsUH0A_Wfjn z4Hnlg%ws4vX~w~P=K#7af)?r;e~6>#AzF?tA_)Sn4y)#0^J9=7*NAP-w97_`j&A7i6k-i)9t6?m=JZSqdd-__ zPxPH-PiUE5Xv50z-Jw~BO=w>WG_E~H@z>_F%gONTURU~gj$uTRvVdAH zT#1i)ih8)>AP00z{0jLJ5~V!(oVe71WoZo()Y$Cud9VTUv0yEJA5T+IO}W#8B8~#0 zSyN3*NfW^`LUhEC1XKV;380aS2>Yq!sH6-6IEz^axJwOab?3O#fq7`24uBYCrI_~g z)bzx$4l-V+N^--vItK{oulX>mY^tGsHrxs?lnX!Bm0QDQYNfa#&Qbv%$>062ncYc# zCt>OQlKjoUf^)3R&l>u57u%I!*5Wbn`cLHy=SvsE2lRU zaLz!uTmnXAWcNw5Xsw{=sKm@b|0@i6H%J%!RGQSn#*&ZiMfJzEl$|yt8FM=ldbmUm z1?Pp7sbKVWS}>N6#Hom$A_ihPc{ej52AcO6uZ+g%TOx7!Xno&#aDWy<5=PDmYz>i1 zuMj;qH-`vigT8yr?Wl^*Y=)AN><pwyib-A$>S=Q=7F=_V|V@M@pLZb&$_7yoDE^fBI5`9bpA>(%U zFCr8b9}p>gIU651P&u0(;2`+?^*em(yfQxKe8)@U=1A=fJ<9GRZkHgR6bT&+Jsk|X z8Ww#J(}F6!^#`Z;UmRR>=8zj^`eIR;-rcDhz6aJkg=ND@6H8lV2oz9`?a&fh%rRtC zfCBRJ{m$Oj5dVpTx5;7gtIjG&$CM$^O8Q`S)?&rms^zUq7qUp~$Kt)FYUlagXTj_X z7Kki=)p>4!pKj)A+4IuL7GzrApkk5z(Go|M8BT2u{X*#gTx!$o1oV-*?9%oC`rQ<} z85;sK-jIrcl;A??LY!G%)pXncfO+2DFJLUtuzfT(PaYjHI53Yxdlskejyk4XH12|) zuiQY10P-$^`%dPJ1p%Ml0$Z@7eWuD+CVo)i16FvlHne?e!YOI%9fX^aY2$tPHZjJC zXTb3K@4W%gldBi|6;J~c`r`V|%hkyQrEu0|kL969BuEPk5#sYQyKCAk4bu0@oKiZz zls6>n>}X%qI)Z49Gw{FO}A zy*FRjg|M?P=a?V@>FRCUueX6EA8XytQNEZF2(I0)f%6F{2aCn?A+V@t&G zQq>nwfPg~K1xWs65;73hHWYq_QEmR-Gte0X1X@%?guEgM2o!Nhz<|Gh3E4+=1jP|H zNg#j&(Gd^~XHoh*G#qbTxP>s{|I!lsqdG?-;E>P}f}oT@=(iyW?zbJ*E|e1W<6R*E z1k;iN3|6oMQm{87ssi*n5Q3T`bb!!{lL5#GoCEO>z@-7{H&6jhN}B^aYXV`w2_}K$ zk1GP>pMnS&^da}7BccH3P9gA{i-6E;MiQjXLqV)^pTQVtR0Y>E@MRN~9yI|0u?x%~ z)KhbSno1!~GG?iZ(r2+qAf~QMLL4b#AcM4Qs`A@&rfuSZMnUYdP8UNMv{m^d^x80i zyod#f1UtVKQ1&}&0TKpmCyY6^F7GSsqk2Pi1A`IJ1*d!swuF9gAymo%xAqsnak7_ zm{&9Hh}$gHmU^8PVev>HqQrUzLk`G4ybGRJtntscteL465%xF?Z{aytf+CZ^Xn z9Lc9wSc`+p0!|r@9+R*~kDv^WlI(T*BD6DmLg$PM7>a@-q`;lnc5h_y18q__2iFCB zh_<#E)>oW-ZKML&3u~s&kle~)Ejht(>8;`I&seMpj^CM$ebC6E*@G#htkR+snrFTU zMJc7qT=yOOYhJhgi+8XQP~p6jR2rqj6NQT(G&E~xSW>bU{!R_wac}@xjz8a?`@l`^ zjM&L ze#Ba2!grls`Y7?)Xz}`43-EzuYzv?Bl`}F@OrH;%eLoI9`3RSN9`@Z87Nu?VQ~$aT z`vGJU5GDNI0`Y&Q3T6ABh@97PWA(ac&YB{@wg!XT=N17>O+95m zjCf3(caQ#jTb!E`D&Q84?*)(YQC0KNL09XkUX<*Q)AWGtacttM_HEVj`BA7zMiBsO zYWGqvGyE3~(X768^^*YF@qMzDtGaH!*A+0f`ntEUG&7iS%nejSM(!+Gu@$7Dm zU1am@w8iIe5qITT7-j9ot2(9maVcEk`!grwwoP#p9H_&}8ZM}@evy9_>u?(_a}`qO zOIoDNTzzdoUenOc%ZsZU&$?D;dv4?*UeodXs*GRWrEaHfTMr*LfP_v(7Yx@sSnKT9 zEk^rJ%36u;X(a52!M|Es%#E(4OPvB0) zHfofBoDH18Oycfqy-_MyDyTG5@(jYQnPOHl;-~;C8*uBQ4S^9jmnU@`IhsZ7jt~mv zKsE;S;&EPZU(qd=ps%$>f@dB-vu>;BvcQ|m!?(;eI8NNniSyo%TXKGJCT;mohzd8D znF@-MY9Denv`uAguOUyQ>7|npNvrHKe_vLR;U!Q!yj*gXE37LGVZVspk&KY|frOC6 zE&wghL~tIFpTyQHZp2%FQw|0VvI-Yoz}@H%^a8m-eX2m0hrLqr=EGS4e6pQwVP1ea zzq|BaBHA_JJ)l|vy~pzi8i&WQ-%=XOY32ELU*7KUn}mWm?=6rL=*pDY^=9CxTiAoI zIeRJ>Mi|UQMtOOSoXNt9O@qz=|Cz%YXnxQs&?d-RD)w2Y%s64lemRU7L8dF>QyZcO zFL0MD@Tto;)ahPq26Iw;a7S(DA%rzA1`qx;uCtqh$29c6`wVgQr=v1cACeY*XKt4Ucc8pkx^ z8$m8GoZg|fN^a{M{Jws=@UZ}ureE$bq)kEb+*&Q?Bl5IQ&`$P=fn~2B4UJdKVfJsc zK$h%RsUDHIg)lDF@i#zeD38mtke4L-+9ce*z_CdB*!Nej&#@ELSP zP*{CPq|rA1y5rAzrT~-%3_y+CSuY?0)5?3Sr{^V=x}Er9E_UmcmoFe7ou_(L6~*MF z^5oVunVA1}zh`YftQgQ46~EoHgO0x_+6$AwDbZTTk0&v`0LSZMy#`PrZSd0=njdzE zC`unWp%{K$1-|a6^id-0Rv;rGBZG&d%}qtk(zSPas_SYx5x9H?W+~Y@bM@}UWj~3e zKYDvzHAWoA3r8M%*#ZZ{aG4tm{|*Y2?dAGdr4H~sA6*WXU`$`LOeNzrE1sJztW!e8 zn~je83dLRu78;&f5%3nW=^D$WUMsQ;LALj*Yw={Bux_wg@)@nLP2b&HMycI!l&E=b z>NibRJKEH()0W!J>sKf}L1jXlXApg*gOb4@YD6p2@Z#ZcMOJiGKY(_BI}S==GLN=K zEji(Bc1Q!n>j1l|nV-Om)#9mdj2pGN`?q@jka_4cUm?2gA%0gqdfQ&D7o(j3(Q;rX za=~m}P4@2vFH6WR;qMzbk!8q+bd8QSqo@U=^-DbL_QW6#lTy=@Ud5oEwWa}G8D4du z8CGryk0W2jZlYv9&HuSF64AT4u??&|dJt0nbDotvi{_SEhALxeqm54 z8nmd4gkG)S0;IW<1z_nyW-mE9QKng>uS4CGXG8DM_5d^|mWpY}`qv6<+jQ&sdq{Aj z+K@TV5j60^9VlRN0x%*3iI>_7QQ37M)6`IoL|Z=h2oVT?b+s>J(}aScExU+~)q0i6 z7nDMwl2^*_zo;9O3Lv7q7Z8}$WgC@=%+AY?X5`L&%{I}BrpFIUEP%>|aXj1=R&X@N zbCl#l-tH#rZZ{tp4Yyp>kBG9oU4s8S^l8e`qdOH}kvbUKa?(2V_XoOC!vkE2@o~^e z`sz3R2`#bT2180yA0BdgM)Fl&M{(;W_D(to^4fg27@+pdfJ${6%-Y{HT7x+pxbhA z^eyZ#!;GZ()eU?dCWEA0IeKrAc}N9ZlV}R?DQ-%P-3QYM5jzfQ#LT?`26q{r^@=&y zgEt0RiLTLMzfXhyXem(Hfy#Ufkuj)vEhnU_7*zOD#lKqEUB*E-^=Mc}aUzR@b1O(l zIFX}1G92?-sW4#lQjFrFj#Fn3VcfM4V04@K@SK$fSk zH}$7aB%RnXI|%}I`@rWaAbTLjljIPh&kqL&qC`Z%`~GTy33&o0C*)YvO7GgeC`6{s zMMH?{-WX?x9_Ld|MkJ$QO3fGt7~lhNLhESfUAE(~YtXP1cY3tL{ z^5^!DE)}C$SxUYNb~Q=ccF`|9ZoI}*p$_YjPSn~=UVL(EgvNR#UaEXL3sv$Kvw|h0 zJ!nH&Q5iKk0@tR6bbY0uC!xa4@3#<;kmUy2C+zH0eZOb@09-hyhWu}d_doNpaxngn zE8uKRt(xBf$p3o<3}e?$?<2XOLm(1a&Q9KAoX6`IPmLn@)a)OoT!z~_)E%_i z+U4xIdf=|$o8wGOi>7n+bbtq6AK=r@CBB}+)nY6cHfnzgdpAS`er4UkO*Y_6yY70q zD%sHIVgFY8;xFV|u(WxJsQ!t(k7Zw8TX5o;+rl?UtdHr*%%PDXcwHS(^16fWaT@or z2wsDQIfub_aHPdpkI`4+0wnU7Icuz=6Fnf zqb7=m9HYN2fT^Htd>A+4CkJ9x3Ep?p!}1zZI%E9!w9fX_hnVGTk>SejnP>4gtrx?3 zv47ul;#$AiBBpIruw};pH*?mBs64YfA>Oh+-!MP0 zI)!BZ#}|@jtq9#_APV||YlkoQWiOE_q9(0kKvYH5tg3?byH8d2oEI}~AGG)ms$TCf=>d&pjWQM3;PTQdwDV={=v~O$3wzapj1** z3ey5rBD6Z+( zoV3^N?zJJsD`wN|`o6lj)1e4&RM!cKvGKL*!cjy1gw-oD);#LO zi-!{Ca|qY^%S)H!+z0$jurNqT0U|3qm#GOJl7ip>!EnC`cPGMy57X;QFc1{02O;qD z$Mm6`m>ccFW~vX+(a__cWb*@lgK-9X^#CpMsF`=5s@x9l@xb8gL&?D<0|C8PS*5No zRxktWVmMoL<&q^3W2U{!p1D~OqNdHYlQ=QDI1WG1*Wh*jk~xumxJcFX2YWSF!&>Qk zNIvsiEFh-mJ_( z0&VE!x2BVV;z80v-3Ube30C^rgQ=k*dVqPX3pmckL0b#|P2kA`sNPcaa>)v@uSR~5 z)_S5c;fLlmUZhdsG~h{CBJDsj49Z85;7%tfGJ~%q0n!$!)%{c3CI4%oMDqp-q^WvD zCbuu2GZ^&9W;Ps(gqcn}Qs*{lbRW;*p4Is>iYh7q?Er2U27KJgtmqU;$?zem#IA@x z4GQ)7rIdstnv8%$1X{2vY#S^_hHEVaJw&V4$9YPv zi&BbA^L_9Qw;?Ym2BQ9*3A{GkPvA_e$D=VK36YPA>MO?`c>8CDIDXR-ROOz zg;yV55Or`#(6ZW|Vuj6mc{=R`4O2oU>|!NDLVRY63^^4U@kr+)A(41nscKQ?0A93~ z;SP_?0H^Hv>b~VNDMBq_Q$tM0$snSh(BQI zpE*Hlb^f>;QeM?zuJ4(~Uh?v)$1Zb#qJan=)#O>1N_pVpVF{UGWj1WNWLE&3t~Qqw z1#rk%olpNr&*Q3kDJ3kEFWBtB9I&{@i%EI~cyLtP=A(o{VU@yAswXZmud2AD7q2EK z#9}F0O&Q6Ij_Z>xqry%T6eZY3umzz?8x!@wcwb zM@-Fq{&FB?y9~QEHa{s&`iE^iJw@t3;ymNVl(&g4UJw8UQr-Rho8=>erV0O5m4>8# zxH6#E+bwD-j)t9AVVa4-tESCCRIVTp@0H{CZ()^Bk^!yzg#wIVEu`2IriT{9LT$AP zRA=NVzHFh>yQ<}G_^sg2uqxc~s?TC2Wm{fe2zl&j^|;#&pi%)F)1=R3!82=nq@G}l zSODb}2!KPIY?=diE9s~}UMm#YXFI)-RZj&jsn?LN@G%8jaG$HrEC^E~b8eSqyI8+V6oZ!xRCITn&N0G9Y=2yQF9?^kI=lRW>|k4ld)s z>Waw>l(jO?lN(_;KOMf~vy(O1_?pDW%N-v+^G|E1Mm9PseS8tC^mp{`b>5!ILA^>S zCyzZx&DjO^7e8dDILq_cLFbhbfVZatQ4f~ zo(xV89DAxt2U2N_cZ*QrKaO{M+K#iJ0hl?dSreRZjmJpV&}w1qYxlO$!K;Lxv4Zb+ zwh9!gO~Y2z4Q-8?7RKC&-VlwYzNR4-O5Cdh%k@O^b1C;amw;<1O3xP=;K6Z}zQ2t{TFvZ@l$WpjT@4yZm#s zJEKzc<9x(K89NKA9WrO<-JV$P*{Q(jU2PN2HhenSTFdRp| z^H#P39)RFuug84aOlM~c*Jgj!knE~a9^pp`IM`QNPayAaw84Kb1aNmbQ2!Fl#{D_n zwedXg%>}eyzfTEkk_d%8D0b0f-8Y(+ejO2YzvSA29&bpL^e969qdJ$tg!;4*)^uU9 z9Rjw)%H^+hJK{94-%w-6V@a8z;WYw`+8mnZ?yF{C#c9o%ZLf;K#AZ9|A!9B!I|Ta! zW>!?1@YYPtlOG2cB_4<#0iSN)Q(*Gx^%w&qib$d!^CzimM~$%qc9n2AwiIOoZndLi zYv<=y?@G$E?f(tzO!WVeES8Cp{(l7a|6(={n*WR0puZ;pW*Ddt<|)o97FQ^uaE;`3 ze$T68F(Pd~6n7+B(A#lx7uUR3Y!1=~|07vE>hv`oqWM*i^at)|usr^DL~Y~Xd`7Oq zt~>2dpT?L}ou{V`WCv1Y%6fH<>(AJ@_t#EIPgPN3B?U@nGZHqWb{>Duu7Q$q8rs)%O!W(xaPxUHEvVQSQj;S-JR5~=N&EG zoOl;GWVRKlzNO)#rW=2ES>Eq_^bnW4n*aeJ4@#?O2jK=A3r8Y`r@oK9m{M$Q(=y%{8ULQ7{E4! zz!F*eLy->+ph8+Dke1P>rZ9GXvve1wHj+YvEpnGrTR`zWb#dT?1NH_PT+R^0nfUg? z_NE4qD2CWe!Av1?12I>z^bo7kD_c#pc>$EBtb6a_W0ShGE}9bw5@?f*G6X{Y>+z2u z9BVQNfz|ff2*O2RP&@`cXLIcHP97)shO_ukkk(=fB3-rFbQ6-n>2l@a@!DaVyWB$I z%dgrw8v`jF!*!m9qAj@wc*HfRKU#Zmio}H=*aQ)Rde@|n*&WuK3#8TVT?$L~4BN|3 zUbBx?*1`j^OvrBkr!XHFyeEBMJA#HP+8avjOgRnw`0o;2&^FnUiG&S-;FV53N>#3s zqHjpj$AQ6^CWb<>z8)cNhy+p=sUJN=Dt;tNXg|}IzYJTkB=DBNn8A(mBpjvUa8eL} z)m*^cR|CN|)F;eoTPyPr!Htoew5;>D3xHo68Mua_+uv_o@=FXKS6Os9=-Mbin6`TU zuCg$^>NsfsEW;>ZP0tpCL{H6uL*1g;JMthODLOaMFKolyL)W2A@{2qQ6IJvTL;v-9~9)ex{;`*Y3ki#Jw>Kl*hh4p5I`5UiY< zv*D8~`|?n`8{i4_tuc^TQAle37{Zki_!mr`sBT8%kGYR$Fd)C$N67`qIAy_Z&6!Y) z53s@vcUO;o-=6K(AdmIgyae`>jWM7UjCbp4Im6e>DD)nOWaK}051SLPkOa91FOx530(0F z7==uc=kXSKQI4_5P2nUPF?IjCg@1|Cw`lWNoOB7C8if!syP%>)P|ik*;8l!%*?R|-Wr@{s9BK-^&b z5KjBImG4Ytq%QMM>*ZxeU;~lm;2RFx-~h66x9Wkib$gUck_UA(rV&_@9eK0Vqw7}2 z1lV|0HJJ(hR8#E^T4Et2O8Qy?!0ERyJgw5x{{hK;t@*>nBR|0p&{UlYFVX}Q=p!v6 z1O==me-~MJ5m+;s7FZwXgLbOqFfg;DC3bjJ)XkbhLfve5@Bteaw`t7FfIQI|U<~a8zTgoL;376U<3vF6UtUSA1|uV6i<9Y3yLzG zc2Xwd<8|^|FKnHqy2jn0&=iS>kU@GUNI{vBKSoc9yww59 z3QQa|b6QmHQRz9YS)f>s{(y*i_fMO)%Gw^)(1F;F#rJJ@m#L{NIcz6hLndyd^YT=U6fZFUBBqZK z{axQL<&6Hg{%n46JNp#n2U(1O*wb8Uf&b3u@0dN7C9%(P6}S+Qj;M*-CJoNm-~!w) zwRk3~;-d<-=ln_@ixR6<)E03mf;(r~ac=?0;o+U8vmgB!fzTIul) zZ>r1t3Yn?yRe+_#|8hQde7&H$-Qur@ zlLRANcd?0N^gahOq8~rEZ@uITa^$}kOl8_;h3EI6CClZW7c*%+Q_Lx=hpX+kEOVqLrHrycZ7cZ_B1}`9iOI8?&n#?xcK&jr@~rWywM;={oD+ z;hSIY`{6tH4-M$RKM!rXR`%BeE}ktXCh7Il-p*MEOK2(95t$V=pKM=d;zf2-HS9c< zboQUG7Ot~pnM})KrGEzVt-^v{W`ms7u$vGqvDnW4aQ_;Q!}ECoJO|2o_fPQf_P1MJ z%*U!STnWBgwD1KAug{~6GZ}ejw)hqOTTtzd(_uRi+MEsOBo0FTzWG;J_gg&L5bxQ} zZejT<^(&94t>#2B!A1mX&?V7;Br5xMtd@HvrW|PZC^~Uc%XOP7mYMI%N49n2-R>j9 zHyEtCXfC8%x~0CO3pAXD*W4)>%{obAe@J_&p!-v7V_#wS2b1K0sFGE+Ht+Bpf;g{| z;9=C@srJ1}zl2eJ7*^dsMOq#Gg~7@7`t0tijCXFM-4_RPCd&S$Qb+DWx!$V|u|kD%Zs)}&ExCr%M){dpA9ek=!%`5S=gHt<7^*s+IU z_o*f}CijA_9Im@x0feHO*5W)eXsXT95;bj~LA`-w1^dUq`wr~5CI_ftg{SwzuH{_m z-BV6CPk!p%P28N4r84igMD@Y)M*GG27Coqsm3l)d6eSB&#u2>ssgN^!jOg?V!|RfW z8r$x<{!HO)m*x%f+QzxFy|ObAP3Q_t%12Hb9EwG@tfpeXrDW98RGB4y zw5$zB^o>iCxn*d#^(RC)CzQF8%Br7k2jTlGHnUF-2y}?g*)1;B+Em0jd=c0 zjOIiV6pbzA(}#%3OrqWMJQI%QbkHX}X9u`FC)0r5Bo{aPUqIPXi!PPxi?2=19;c*|ADw1Ro@pg>O|GrBfd0bjQg=+(!#XHA<|dfV?;2J4^SD7LwX)mLy@C+wxO2JJQ^^jk0B zmjY0rM?6fsA&zR z4+wV4(Jc@Tnlw9JkZ4b!8H&c5DTzZNCMXTPPX=;KK7<@9NR)Sp!M$IKjhThTMw`h_ zk%b8Wz1Wt8UcWL$(?VUq7iI+^X>z4Yy5T<+Zt)r*VuTPp|CsqlP*i2@-AR(#*c-eQ zFFgo}pAp}1*iD~CF-|B7b4Nhqiboa%Qeyly(40h*n0;sjXm)RMd_&MgqtW5&#^DHp zkt}4tKpRASJ72vqWHt&G1JIlgfOJ?r;2>273yuUg~T^RudIk2b}3yq0;7aNtf zpGUvO0&5{KE+4l?2l@(#U|>~_mj74cfZ*=meXvT@!p@`k;X`Z-m^(MkUC-JRCT|v$fA^Bd_1|Pp zxdj!iw4}6eIuTJ?KR=S%J%%l#t1e9&S9NEh`%Qu8Cdf*_yw5tBDq#BrJr)-4I9#IB zdj6SGr}*iL$kMSJ&vi)=Tw4nV;WYbBVatXDgt+aY!y|a}L@I`w5I-#Ct6ReWtRGJ) z^oo9qL#A7k%Th%k@$J)yonE}kTK#3}orDL^oHB5FTf&O#Mb){fN4WX@ESQ(WczBNW zytAfrN10z`bT4sy}V25)MfCgm;&eKp^~yD0epYP)m1g0O&SvX2^^4{b?G%= zmlPjzB{gKT%!&1B5EfN+B;Luw_e5K<+vWV@6d2y)OZq%cF*B#%06eAk%N*nNJ*7xq zVHx|86L)KYQxCl|pSLMak)UM}eW)X;R=a~cI}281or`=vhLz z;CJi+vMBu|^`bmpz2`L3ine?och-Y~YQBnXvEY+r$j!BPq-!{vQDacrOuBqPyLl;@ z1MtB>gxgjEu!@ctdCi882q8MsUJK7#8b9o+0I-9v0@iI(1T)bkjbzY{c4j{FrZ!eU z57KZ=Tw4fMmAb_^3B9v*C}Mf=9nCtOuk@kY*7rgF^iF*QdZR2^EHb(@H;dy*>fL&y z5#a=J;tDql=^bh6zBZgK(Sd*r=lb>hCaVu;ZsNt#2G8-QC;01-Al7%=UpoL8O(wp^ zKBa%9oUr0g9D<2tIYo$pbUCVopU8&xEzYxP*zbvOaG`=%+(oNYW5wf%Ib7OHGVd3h zKN`Fr$gAZO5Z&L%{!@^QuYL>ryC2T39zY0+p;PX&R*cBdQ&#{kC9n<0&rVBx*`ZMo zes7o5xmv^DCYtp)WdsU`hS!7~sM%Q&>5oH(z#F@y5gY9`sWZ0L(RV_+p|2t3q~@iH zLIISE1ry|B#?BLBrvTn58Myg$p$lUMS1&_xQZ&%l87odSdYj_(AzGY9B2U-T0%L-F z6c-4(Hnce#hX_F{+Q*EGp7ZhN(+juy0S^QpgZ4FqpYXw$A=WxPu^F00(R8^&P_ zrMoI&VEy|}atml!rJAC&X2tb4dT3CDxgDBZ?J|fD#FerwnDlAiZ8wT?cm-w_QsPg< zFC;7K-!uYFG*?HXJ66n1XrFDyZQ`tEzLGRc`JV0>}t18Le+IaDX9K z1T97)Ywk?XRh@scdGIqWTOwAd$92}cqn#>0NIEp8Q8ab>=m+2;)R*CpZnwxds2a#{7t|zHcN4;$kIq5Fo>m!NR?QlS1oWs zmb3Xp|7h>WaQ;z5LrDAuOx)8Iy0Os~|CMYZ^$q)KIOyb)lZUko)0vTxo6lviqp3uM zISYk-W3gic&K6*VAlxagRfV32!H=f^w>;=Vdc@~?$d7u$LdQb~uDcg!4UG5S)nq(V z+SfQ*r$)AUL*K3&(CU+wnGWCFIqFzQOgN9auE-zCY_UOzvkD|o40`6{L(JLI4y#ET zTo-2n=B%BO!WXquYj={Q(7bUKdGVQJ`j`L3ji)9N8cT+4fzSp-fG+G!(MDk}y7K-P zz{uap!2ZY?6JBpgeD5e0IjFO$}DdEW#gWi+7=f;clH}lp#0qIRx5t^z|?2 zFFjlf#T}62CTVmU1)>80Js!g?Xze{t{Go`Sl{i=0nh75F=V6Y1()cJiD~|2gbIT7P zRG~lU|90T|&s@LEjBNkC?fc(czoljM`knY$Ne8QxC5jG6a#UgL;IV@l`D#Q>MTbwX zD<#-;iCFeU4vHNtKzinRb6-y@u$8?3CHv)TX2khkSbDB~ANV?-uzQPC*e^Az_!vQL z_(K++`@B#@AyL_z~cGGErep2@pI%3<{w zBFV}c((XdCJF~%7*m|cImTu*EXvqLrrt6bo(NP+w$yWQ+Q8mA_I!x97G;YSfpbV3v z=+u00i+5a0=08KoGK=q)Yny$vuCnwTW@|&GMY>|1i6IL$PJ@jCC_*md`VNEQpLVkMlF5;ZQF^@CIr(7K z1ea9s?NDM6Qt>(i?lS71VW~sehQ78$p?qve8v(H+fUVaPF~F*`V|=1?++NMp(%KJp z@3=J*+#Gx3^WHeMaX!K+epgXD9tD+Q8XcOX3iYGqv!gMudb2Va*-6^3;YLjHV@?gl z$B|M;blkbkTs+Td-o!i!cG*KY$S=P#c%y! zn=Roa|0sz3Z8!tGwYzB0t75uP^ZE@iy=_%QJDLL3OS5kS9oGND*g16x7A>scnHX>HUHz(a3P@$)p4tsShUSXCq9-=^3 zFhCuFq@+L;i zq?`<5%6mRAcRN_&A3#aZfe+_hAN?y=J{_-&IwJkTuAV@NpgdNPfs<-zJYS~>6#E-5 z2)wyj`6nP15;=;-NuUr7uk7DPs)NWUfD%J*KI(Aaa;V9G1ruOY0XH>=3a0RT1(++= z>~!X<1&+Oy@cnAPcofaM6lw+du_11@fpqX-vMgejKS)0=QEI_NfIm8$TP#o0e-1-7 z=$|anM?N&*1MQeNw~82A&;G0Z~{+UL?{oS5PiYFs8meE^eEm4P9AsCt4T_* zc-W*7rehkXF{7l*tJ9O_FAd%$Y1~YUcQTk`p|N+~BsNTNYfNy4w24>#QSl2~gBeV1 z^mOJbWFK%R*N8hF5ShF1zz*=6o#0~RRAlLsWPU>+cAimFYx>m$u(27bNs-Kki+_oT zIkJ@G%$s%AJ*413dc|+lxGDk;t(-R7v;cB!!N-g;5`TwC2bkz5=afCgsMJLZeLx^S;$KzNm5}ruveHtzP_dA>W9`@LT%97h;H+C4}gfg7VKuda_n7qM zI-XiAg%4oWjlskUr4!wQ%FRs?01?#%MciAml#>O-0Y01l za?9!aak2YIsdx{-^os8Sx!|9(7bl_@CfjGK)qbn!7{(jPPRwWt%+9sSx6sZ%gYTA| zT%B!tJ!v18t06n(5iOV@Y2+`}mM>fVlZ$RY5z}n`)=pm-vpx(Na0K1=dEi`B#m?e% z0z(2Ur_4=)NVgX#2Pe5oumY}kuCF4%gtZTg8GeUhkosF+#g!bCO{_Bs`2;0&4w^V~ zUllLpbpy2uh-O^FL|=6$@yyj(=z6GaHwA$*+w@wEe9yZxqT64~iNM|6H^RKq#b*q0 zwZ6)^1{`ZlzzwB<%G7jYpAB=%MD{2B4|GN-Eg|LFjZe;_)0joN#3VgphY?Vij0=Q( z=c?iL9_FnlK7T6oVgk24rq+~Pu>re@VQP#wr3g9B@4G=6Zg=^U48=&~RQ@T97|LRZ zv|!|pEFmM2@s1$Ek1_~sGR;(-P0thHlS&PSvyfJ=fS>%_V34gfgN)0aim9v?d1bSS z8Jp#_JFMdm6aW z7w=;Jqd^6rt%R4B1CM|U`9Ub4bbuk&OkaP(-2oAU(p`S4C10gA>ARG+$jN2 z8w;G=xY4jT>U*Qui+ns$)C)xoRq~eZLpa`?P;D-xge%0!+fZFR%4ueFaxs+{C32X1 z%XA%BAjjhqK&t6>rNiD7A$DD?EWIOWfpW;t*@q@cF{N&%YUw)}oeCI~qHIuTvb=R~ zRZN(eb7E68{4|$R>0Pisxo!V?D(zR$*QbmjzhkrUYvUgdvV2F0wxDwxwO3#g+m)bT zd{)oMTwvL73LxQ0gYQubnJiSIi6Cd9cI;0>|d1ilK}rURynZG_<(Pnc(%JvqTF z^|-C3pf`=(*V&V7{j1rkr$VM1+U?-A$UvQ2Lqq(tbOzi>F9u7 zYRpFM7eU?Ts1VNqJ{-k}9FSqZ#+|rwuW@BlYB?G`2!X-UqqsZs^&v`Y zY(O0=pF2Sju)BJMpI*7i*9Z1JTvN5UE|o)7>zHaVV2?3lET574XYmJ^mw2NylvM24 zkhOn=IR*sE-ak+eQ{6(ONgF_i_(`hpg+7)%P!}-W%nt6zz*Y}+5#Tq}x zdWJK=(hN$t)tA4Qh)ne{^~65Oku)?OaO?t7reK|Ev_)=X-W$zI-mqDJrF$5!vNR@e zZTJtrdhtAO)!T`I=g2Savx(A~sNnlNSp|(Hl}<*alMBb`>NlytWt1P)&IW_3WZ}UB zNOXGM2kvcK(Y5NP_Yd!hjA_wJA;TD9-CLO>faCpr6=aM@Hl<^yElO;)zH7|JHB`Yv zi&iuoj3zW zK(jc!$7GC6nPrcN2Rj^7e!?bntTzu6hqKEe%UgGUw1(JHlOBy=!s1!7!Q#2!RKOXO zWZC}e;zgmIv&hRoMp`^J#pZ#tq$fOrvd56o9nuctMs;{|pAYvRcVXQn_Jdb4)D*vK z1<8bDvQ5CH$8AY)Y*-0|L^2WHKB>l07BdvBiuo{xa(^?HLJQ4@97WsH^x+77u;AZL zAr1{Az)1C=Hr0a_>Um~= zo8D@GMRQ8T!#R6N*CL$W2`4WQcYo&JRt{;b4?<-@c7kIILM1W%@K#>~o52FV8XHs3 zvb%aXXWgD^NNmu1QI(i&Ld)m+{veew`|&_Wx(xoSk$tf(+r{45to{D(`~iZ2op$*T zof_kRrAKCFU}ye+JGB%o>7*=){~3+VCB)WQo|GboHpE zKnp|HXeYs&&)CX6s*7JJVCIGO`PR)tGgbwhc=q}FQ>NU~p*Slw;#got*Xq?lTNpSo z)4E0s?K;)$_pVUuQ@WPM-$o=7PI!g4ls#8#wbByROvxIw#ui>VHQcZ42n&>O*|TAm zFNVdiavz^Ms*hmi)HRnX@K!M$0A?sQFf6o@ZXuzbSY&53vdYdot~_^<>!AbfaZqSF z&HQBbs}MA=S2f;J(E`{5u9uv!_j0`RYX$r*7+G|)^U*_{Vv`ZH?4_LSU3L9ZBsoVhkO3XG^sQhbym( zt^UNPFM&zzF<8@!Svhb|`YUE-vwCEO%o?S~QaDD9-eMd*pB!n+7TiCeX&+a-E&>-ZsefcdxAuGAK??$UkBrhitx) zu<6wOk?eEQ6<{F610`AiU_CHBnO=o?W1kpzqnTAFQeN>D&ub}nC}5JP!UqrRd%K~4 zDHir|`I4y$F9Jd!!{Du>mol_?Do5TF=cyf2Pq?a8W3-N1nI|7Tpd57pyBe*kv+|z%t#gNEbZpuO7?374d77uRJ`k4I#ww9;N=$gj_osT1*WC z4z(~m7Gsqh+uKz3d&G1fnGDRhwFwkt`hdgVetNa)ENH_QOi$DmF9|{;joC;;bIRnU zX~l~b`+)aloILkv3eyk_M&gpr$6p0ENnOE`o*V@>s67W_Lp(RQ5h0uQo79&a!zu%* zj_r3xNGk&+@1Co;%pQJvEX!P@E5`LMfi+vw?lihH?Na1p9$)8vo|5z9z9kO9fJsnm znX$WRW!XV8z`Wlo?l|AmA>;7UUvk@uJ&M|nK#xwZ-UF7$e&L9R$-%|`5(`L`@R23H za9t~8ZZpM@^gGaNGOjC{yL=F`jta??BL1t2wZ8=WM&X)3@)c0Aw?qe zT2eakV2S*@+A=(BS;#m5e!uvMbZ6-57D1B+T=;VPEAytSbCJDNl(xf z?bZ3mG5c)H0`G+39>)L5;#Vp`q_o1Ieoi-aCG`CZM=AA1+f?a!Hm4J(q!1@eF}4A2 z*By6cmTLh}sF&)RlChlYN^rlUKuiReVN&Lpfj|o@h9+$ot-QHyP(?#Pkc=w3RQ7|5 z?F=rGrJ;TADY>67foTHr-N#304YY^wu3dE_(C7#SDEDqT!{ zLyafwV*g%jfIw{UHr5q^i((S0mxSZgkb4|y73wsy0poCIwmlRZD9dHlN6ldb{bJ}y zQoeCjngT^cdG_5~-brbylFZ0q$B(Gf*PPw*=S=(8s?;rk*(%nYfk%WtjBrnkd`PYK zo0K(Hb^tY*eDB$Jr{T*JtO|u|Y9*C{$b|`Fa4-xp$=@Zo9x>%i<-Je0>%f5=5Qb(? zyDYPDlLqZ?=t#KS*ckWKDQm>p zT&8_z1~NKj(ES3QU-SW>@2eQw33f;hrl1GuAq4^E{1a`fOC{u?pY#~zKiS8+a})Tm{C{?2zV`tZkEGda`l(eg8z^akee)3+8d*~ zyL8cWLs`fic@j43AF~PZdrXJRH4`WX7n!kD2yoB-SdsmF#mrGoj>f8UPmRXW1}Y~s znc4KLl4Uy*ilPogH9IKi^#0#G4rE10c4luyqPMb?g+6CID~1$$fqZ?pB^c>3EUTAK z{}f@KajdPUdN*AL!xHS$9$w!8sBbgJ$c2s1gS`R`(oc@j$#Mr%+}5dTdqnv)qvx~P zn9!orzKEG6KJ`CuY#lLzi^r1@8u^P>`g@-}pcsLjN>7FragrQD706F+qpe1qlw!Km zr=h*BDy<GR|{MW2I4v$6Wi_bM? zCbl1iG~{4jdyTPsWi@JL06m_elRG(=T&xksWiL+FP?G2!zLBprdH}|N-0~`}=2yGk z%?-?`G#I0QaQhYFSjLZcn=p=HJSPKcrZX7tsVFxXV<|yCyJUD9RpaM=46X-~QU%SC zR)Gyjo2#}o-#kf7F56J!L%W1eq=2{o)dtsaH)mH;Z=1^&E6`uMn*n#27ytLwX^ue` z3Jal7YzNcy!&S!CnCM*!&b5+n6xcpzxa2^$63BUW`XOSUheneo%3+yiC{SIHWKpH8Iqao@Vc{cC?8!+NBm@HVAmX>Vn}5vsJTf*7m7Qh>)4rj%ErmDhAOFK;BQ za_|LwQ!vcWfuOV~Snbw89F0^VTsgMW(KeyB#s4LN<+MMsypI14lw|~RR~1(Lr=ynM zB>=2dm{6fc2&bfj6^J0QS^lD{x*i$O!82z#*kK@P2!r+NP&t;A+) zdJSREb(LAWdNtx_G7f4Gh--Pdrl8oxz|dTDyiIzPclCDmM4nvi^PZAjV#z${@Y;c* z!7J{M+l2=Hx~2WS*iMC$n+nEGK0*Lle=#`A-Ah6$*d!#r)|>QZU`w`%YBI?!r15ID zH_E1_6ebIZM1|=Q~5y$?s@%VY{8i{=6v^K6*FAT4w)NM4HGjCz*z2w#|UOd@eE7srIyCBq`F*izyK<^8OG+pu&}ta;B!}=i0LP6N=~27Av_f#S^Royx%>o$X@yG-04F8yv{(p>R-c^ zZpGod@qf~|cA2Kp0PZ-S4Zk^oCS#Oz_NQ8Mh(6lzGE9ku1Rk}+oq#F+16T`wcii$ zZ*ymBqlWE0&bitSaVs|=fAP5s+VV6%T*k7n!8^=2yE?yxSF#xIJi8%BSn++ZhdszJ z%fUim1TF5dN#KWd)^q0UvSOv1p*${z@Uj|y8=k&6gVYFULiv&&tmE&l&RoqMh|nr9 z$bIbn=~ii|NN3_Qck=aY``2Y}SfC|`5@<08FDv7{sJ@B9 z?_(nepVMg#?Q6=o(`sm9dEyj=UAkfByk}I9(JH(G+xC6%C?2mdVdO0SQhr!LZo0S0 z@U)5FMWTezCKto@jJ5A8e=^=n>=JXcJ6jK`I3M$m*8oA@T^vq%IH4xznB89UY=6!f zSF(J9g0%Yb25;ldw|VS+*4@oNC(^bZF(>w$iR)u3%joe6*ZPHN>K&Q`wF zNED?Sm`bMRU=Zbcr!R)?j8Pu3t|)hs157#c431IhnfdEvj9OiH%iCqQQjp_yR>pB6 zYxPcfE>DNH%6UKT&Mu?y(0=kOi3U9_`2Lep7bJMF!DP0b9gTM9&oiOubacx&t?{eD z?v2MVmEilQ13=@EQNGc<+TIfYoTl!wOqv5GkFA^`TMNPU6Q?QXfnhO+=ZK zF$eLy;R-U9mVjRV*!(*h0^C!CU^1c@;Ry;(;aD%h2QChlH`l2L1Ws zLj*uN-W$t=u?8dIC0K)%hf>o(U%S!snWzSvv4fDU1W^_o?b${GZbIUPO>KYt3)Z5x z@Nv(|`3Dr_V0ARiTo#vu#9Q-YD5xwIn;`C+fx2;gJVT^&h4xyVoG@-JFrM3Z68(TU z69L9OO2ZIAw5BSZjV3Wqmd=MtLvPWVsfu?1DmG&D5&VHC27o}ID2s{6ys?pBDlgtY z;`0oo_qoFfG&Fm05D4%RPhxHP;&@9mWy%Vj+{=OF-2Q}}3HO(GOWlnh`t#$Qt)DpO z&Vnb-2`S(TY(Y$N?A>kmM;R;F7Gv5Pmg~@?NiMTwj|#W(#mB_%rMATtdQ%oEZY8*5 zU5;qyS$JU~p_m}^%8}69hNyKi5dT<{#|E;y^GO&L?yzj;1QENCM4~7c28BTKwXc|+E%+m+G!28Nf#O9Rii%N%`1a^` zVN>L(^chW~4xVjz+b_$I@*5k1iN{EUbO6-BDibtl3>W88WPpIwirmeV?wdh&Q14QF zUHAihH@m?l0PXbcm?2jL&}-oy01sj}y%s<97*omr1>hO)+dgKwPJx6ki3f+jxkh7v-b5oF7179I%z&vjr@CzIUhr(pLgmg>I?@^8B_k)Wg4I|C;_;5avtyq(d;Upx*4Mc zS^ljUn@?O8Vo<*-0*fg-hVCUa{m)--fTvxTlN`h7qHV#>5?<4X7&9tVgEI{)F98{KM~m1l3drJuW%Z&p6&ZkGT@Es} z>GrA-%^bCio2}5m=9pMUP^3^O+iowXsQRoeZB-`Sm01VisQAn_q7 z90`zeb^hq3$2%$!eJ-i<0|6OQl`iUnV>UBSj#+H1@iRk5lru;kipBS-oinu_&6u5n zdMiyTOk)>O>vTX0Vr7RiMeX|WJSLh^bP-rGOM5yP>e%I9*kNqFT!p zK0WQ>omP`t`D`iSlkIJ(m)Ghe9&19QHFO=WVSVzji#K1%IuR->+64UvT5kNE?G6zJ zhowbjr>nEl)}(d%BU#dHikEGAiW)4=MV1O5$_c>LGgXgTtHCcRG~@g>JXuXVJwo^t zz<@Uxq#r%9WJ^h{H>$2$8RoITSR0GINfXV!?M;bdU zc?P4M_=UdQR$6}~X`BB<%#b|WdlQC%^JYxYafeTk{0ZwS39zktz&g|pHX{`NL8#UG zsU+ghu8S&gzxz(bJ7El(M3RF0#+oaubml8i!uv2Z++i6kHcH!be?NGGjr`rceLjsX3=dg~?i1dG;&prqRd2Y{yJ#(e}CpaF6y{S_&ktpATY05z{^ z=fwlgSI5R6qGu#Av6s)S^W8E=RtD9&+1AZW3 z+%s%=3ZP$Hj$uaGnvRsUkGG`X<%QOpIKAwC3LQ6o%@mbgynE)A5$Xe?^q7ID1a?iK z38{`Krz-B^RS$c)m5+Mhraq@EcJSok3jz9I<9N>XYV-Ye;r7yo?~>+_<_Qb*d=dE> zio|5s=;_W9F_tNmc)p#|-EXeOuS12DXT5Bv>9*TgEtRKK&ZehSuAjty|M8nhVpuG` z;)+02AU{Powgkic1D|ge$rxql>T`Eplh)q*BjtpBL^S=;Ka$7B(T3zXZ9RAnaUE(Sm0Z z6#fWbVvgN8vgW>>xl)4nHq)i&H-G4o)Ik1i#-At5bb)t@n>cWxxarL~)%Qb4yz?I| z0Pw6qKzG7sR~nz-6gBjNwV!-AI9Kq_$p#fX^o^5{$32gKIm# zSNhxbf5-o+^#8B4&`cZ*|7(OW{X0VVwYv43sGmx-)6i@aWG6LtDyOJSs8Y(yIl$p0 z80V`Ip(fm~b~gX;#*|9HN{mawQSyV_1&F__==;H%Kh>gY8ommvMGok9t>dZrdFp)K z3aEn+$FOSh^3_VT6Tw*M)!<$Dq3~Z<9L!}eV~=R`Z&$NtKkT2-TlGg-`qh9fG(Y3f zRDhz_+Gbo__j~i@X4WO{G}%3N+RCcl z&41LU{H$jA-d10)`K}LN4?-9j(ZnVsJ2<#Bq7~IKH|ILE2%&1qzk`BhuJ1JdZ{SRQt4^*N$y+L%W)8Re%XoP{ShFywB`U;*`% z74X;WofWKQPSnm}#SjvO`+aC@<4(CQc;oi%G62>^B^NMUZ8z1&^-oW^7DbxPM_e4d zIqHXgBoa?pFlcYU=5x0O+uQL#vmcyWzym9tq#PK)9j~yUErdg7KHPVLOazHjQGZ)r zW>#O7lm%+Tsk$a0>vy-Dd4&n7r4Ksn;0$m>=Gb??nm%-eeNIUoBFG=g~UH6s+P+W z=w-1vx8kNpje*CLrN{+z+zA?42ot1CT%7aHfCAwfU6Vl&rw64evK}NP`&og~LkKH| zNKXj&8@ESs>xO1FKpgSXjgkR#JCp2q)_Kg=Q2DU@EJUoMBL1DMy=ZPCh-CO4$%jg3 zF$LpJWEv1^^$jJ8KwDQX8{y~!t@?7lENixyZe8&?IVoZ>_F#0oYPA-qS0+prim#gB zkW4~+4-H!aflADu8zq}9;1fFWWwGoR^(qN4&wR9MfBBR*et-~I>_w}*`xNd(>k zgsu>hm_kYN5exI%a$~y}jXB=1O!<1kZd%(*5nL+89EAQ}De-61=mK6>y%_ZTTtAxz z$^(<@#mH`Z=nKodV+4RW=L?Bm(3`xkYA!t2y&+M$T^YLYDOf}#1DB9op)5JNz$Xyo z%0Zzsh%mS8C+MwMl{feM=@trW>Cp*U2wYc5F?lcEwylj~p^yzI7k)4iMEm@iI1C&a+1+BD)W z$|zPVj(1Np14~l`75A7@Mucb9@jmv1AT60Hm)+h&!8(^k6L>lPlCY~~n(gcQTMd<^ z7$Q4FU}*(mvs+XBTz%2j5(EJsZiY(jL3R6p4xN{+!ST7UV<8zv(_y+;f`zC=jQ@5M z9D=4Tm}f(Z6^wy|#o~w^y_9>{%E@-x2qAtO&pyk9x*3E_!ohPJOJRNIK3#UhxgXV|kP%@ff(7 zlH6Ks;AC<}WTsg^$H{%wWuL~5kv1n2;?c=B6B`4B0r`mf`01ck?pDA`$p1G7=I>P3 zkZW)#%+5_++eSCFORqs_T5Rpks?;B9&ZgwC9a^JLMz19uDou5j)n81BtB?1#+v|Fg z&+dY(=k<(^Kc?-Me=TIG`Wj@_Bk+wqbvU`b~7!^ z2H{T$E85QQRR6^Bwxzyl#%W9Kn4b(Ufl1wcNKJhhoV5k119W)F%q~SsbMHwF20# zU@Ejp9}3}tuD0MlB;wTWoQjS4Oa^WtQc|a2v0`K=Lch1`2j+Z)l)XL~cPf>E8^m1B zOY@DVx-Q$uLCQM)7~23{r~i3qw`%~gH2U`RlJBka-&;>9FXcl)dwLlh9r8pZ$h#`( zAqv>N%ai*TH1Cr>`lw@S0V69gae-T02@m@$&N)}jtKr9M5dXO~%K{L*5ce&D=*k!F$4Igho9Rt6ke+TOgr-ZSP-_s7nS)Cq`o3=R)AFA7{L*{Kd1;eyuz?zQ>uVKQ zjK$k<{4Kl`ey_TeoGoR*SR6=>ih=fQ8<4Rhb{Niqh+G*fFawKRQxM3N@6*81$Fzyd@+Cd;WR6|C-(M+8$2Zy?Xl4+Mk9IHnG6r#ZfY+_^e zJ^nR4nE?cK))v?|1MoOlzCZYm*_|V4z;~0Q33?dw$|lb>?<5iA4L^twHs_`+b`-Ex+so_%-%_sYRn5}nf-Zv zd99Tk(7M{}Xav%D(zf0|UpPIFOr+d40sXK>S|#r8dOL3JZSOacRScj1BSnL+b^X1+ zTs6C$Unv^JFr_AMcU8C^VyIG$y8K5RWWV#**_l4|1cg#$|Hkpzj_=#kpywclbc5v$ z*w5z?JNv7+56^N6=ELERsFS0-U)2hBMbg$$y1G?G;%^!7%!?hl4MK_imq@lP<*7S& zJd8O+$T5V0%ypuNE{d#*Ln%~BBwfpc7N5*DJkWs#DfY*vmUwkxq2n=q@C%lV%m zp?XxxeHMleo_XwJrZ?5^AV zCD;Ur;CUDqYz=>Oui01R=*gFQQHvbuQ(D7Di;R-wk@MAiAN1JSsUZ;c!rfIMP$^^= z>RG|{4w&_r2i@?C-7>vpu>NY*nRh{s9y|H5u|%UB6__Okj_Ww zjoybU`6EGk3v1SaxIi~vgL3I<5rMw3PBoJEAsMJ-STpYZDa4l#prSE^X|ciY8FCd2 z7poXdutE`oAjkZvqoS zVzdu-ITC3v!kBw1X!m%!H)r8sxT)rUED6xX)L9 z@8ww``)jtR_Hq=L{lt zz?_VPAS7X`FjP?OK=c($nS`Z`Z;P-^CCEcrh4CKfFb9MeOAi1f$VKEZ_<G#qKjdGz)OG$w~pIG=yqzxxoudgRScU11QaXx{Ap9=-EP z%-fa3P?r^s6kC8;M5Y4~$g@RML1sZo2<;itrGU8VCy3DSCj666(wi3lq!w5049dGa zDb*a)5yHtsr7@~NlBLO4aYRM8MS|dMlAZ0VO{3s{y9g?G7y#=a;RX|2V_YFraB7Ig zk)Uv%j8)?(5ddMCPKr_pgO+Qe70{_(ZGb%S4W^q28gh`~#m))-7)mlbl`T)ab-OBX z{#%(tm^fgw%LX&nA1gC@w~{9ul&nqe?3kRyFNunT%d(d68QPFY3F|@E02I6fK6F$` z;5e=t?eZU~xEbaS#HEVFMH#Ht2rOnuO4q6q58;cQa{Eq^KP7&?)4byYTW1tkw$L4n~*T`#|YiK9$! zHJ3(Q%H^2G3{r2jprOh+hl9RkDQ40{hnyjTeY0CNM%UsxWvm!WHS1m^>J@i6;TUyh z$UfE(wT4tmR+|*uQ65oSPrSRF zXV9@MOLpJvw(zX6A~ZAi6pY*uUcFrD0O%hy6dVFYq|%IaqXR400WkY`H3mUD8(H0D z`qq2_u<5=b@gGQYBV1sG^RE>$FjARZs|gCn{q&VH(#?t}?Wcs%0)rrCcQ+YdO~eP7 zIdX00%{feyw4VVWG>qUQMZhr|F9jvxxdmFh`<%(dp6|5O6tx54fIG|H#gcFz{|2gh z$pe-Yd3*njW^J}q9*X7Cw%e3iRx`6ScQ}fIrGxrIBsetIPh1%Ur~cq9Bd#vWu* z#`}3gpv!1a2pe?qOUxQ8uZ}w?9nh9{>2R(wYogJn(bKUB(YRb`LmfKGZE?+nI=dqV zH4sq5hH+pHUj_=!h=_U!5Qy*X!ui8Cpl7eQ6KBru=gqLT^v4I(UL4i2|9J=Sw~nu} zv-!}gEXe_hFF1%FfKT|fNtQi)+5!P)_1lE=~yhc6o!hT;YA(|!S z4?tES(eiozp-NZy@2~!&$$<{UnjAWU{a8~4Aw?o_TMvDe<={+GI~`9PZ^Y3wJF>4g za6EQ!^#vBUb9O+N)Xz$KiZ>qHQTi@MB@I}>6-ta^buaCkQlZtCXanlOcHi)1UXI}# zo(#&fE6hJ^XF%)SSgA#ZlG>f)#oR+1UeZ4^ zB%HpUT3;twKY#!gv04A2C}aAsOtp-h?41AaM)b6XWYWe6>hE#pu7n!s)i(NDGKZS! zzu^?gH-j^Oz$~m}!9Xwpi;=enk8Z;~mOn}Gh`IPKX;iRknq(1G;Vm!6*xzk7M90al#+y})1O^uFaq%el?& zy#sT$^_I%j5X+a1bRa00?Y=UKW{n6Mh$4fDBn6WQ*!D)YV{#y%i6YU22!l{jffcep zC<(YP6rwEe9)Gq2=~}eg^lr`R$hLZzvenO}FJ_w^aR0COls`J4q}6LOzgh?XMHy|&Iq<$~n$L)Hw)4tIr_Rbawc_w=d_)k4owqlW~$=3Qu$u?Aj z1D`>rjcwLJ4X5u+L=lBjI%&qU=CFToed!|=XUZ-Y+TZ~4x?z>=hFM!9U34=P)S#Qf zsy>U4_wl3XhLTbHn^$YG<%5g#(}?d~F7IooF;6eYY6mx2%?6VB`THh0czc#6FGhld z)m>9iw8r}%%Im{i3cHR#>-+NlJ}|6(hYT!zY=wD7Bz0bLe=bb7TfGap>xJXPLNG*T z?hDGEXadPZrVqZlM|@Ic93@xi^3(Zc@CgvQw7qz)Q=keLlG1MSAil`5Mco(5lC%LW4`#> z2Qw3h7q(t=;JMv@Q(QhcDjJ!f9;q?ILxk^+xZC?YyxJ?6guC4eM;#bB!8 ziPh_-DqYRcu`qMA=7Zras0cl*>MgydG{TU|L`VzQCfAAA2#T;fAl6CpZoG@6EV}lh zz|~Yk*n#T6iPa?m)+@^Gfi5dp=-~JP%pxoLgDcmFCd4g;l5DI-ZWN`7jg)roCgTO1 ztFvO_f|S2kQk8-tHvw$OMvk(&4Rl>5r?hZ6@nIxnuZjH_~ibb-hwoGLCm zroh64e4?*3aDDV6lwF&XJz)IA(q|pKwx{Q}((3CU$~W6BgYgs8|8O9!zX6Vj3ss3@ zBkDX!0FbP+~>PJk2d1D4|TF zrbYLT9Jq+pwgJ2gyxGL_W%CbH1YR|)Fggs~^@AGtS5p-NZUW6Z8?N&%C06$Jo4txTib{jJPQ>rS~Ba~AAHrHe%DC6rqr#^=#ySctt`1hr>b(2ha9oe45@fzlsrtS z^|j{DFulgs@c6fXKd?BMu*m;b0=dPlRu-i(h@2fXHW9z&v_CsvDXkmSLW@W)b@Qaf zp(a%v!s_`~jAt|y&Os&HAK^-#1)yrCYKhWKW;3Cw{EsP1?1ZB`p086F1sP8TmP}u6 z*YIrMAJpNTPl23|zXJw7IbaFST>PF@gm%+>VdsGDF}~EskNd`nfK-SJ9mhNv8xeZv zGV++K;Wv$H-?qTMYo~?6nMUZfMn&IERS&}XTR4G3mhh>wLrb!C)^W&wSGnMmp!?73 zHNeI#9wlmfTgs0l9FoGQMr(s>kScnv9&Cd+{j;R|rv`NFz+KHhBie7bPsPH*G&CDi znWC!4LyC{#EcyAe=N->omgoI*(rlp#oURS8X||w9wJ$M@UKI^8nt{=yw+(0qYm@ue z=^yiLI=LzktmhV6W#=urHHLb&;?}c#k49CTjELAi!b(kos0i>udo^PfrDJ={#Y5?l z-Mh8PZi9?(8HZrd4M%)-y!lE2v%k`I-S+PP^wv74TTC6z#>mNQ!<@ahp+JZ7=MU4Z6q z{0vaEvq^JjsR6CbGt&6E#3cLNMt#<}VIxu=B`$j8^Qii4PWEYsk%<7r_RL`OzQ5c3 z3wOvuggLdTYk|z-xtL8&N)K>X!^JhBm%m{|*XEEe1E_m_egJGN6bi zoV@2icfZ%|R|0+CsZ#Fx)vsTw`}Jt}yl7Rq_g56`S4Lf+wo=n+7GItleXt#bXzA;H z+K?6*m{RUpWq<9Ru=CeAQJSjZx3Iik%>Lx{Pulk0z;URp$zR!vH~O6|x7V#5H`&2i zDVmA@625CW@zna(+@0~{##M)D)URpAQ4TJ2uoJ%K?KXtBb_P?6XM8JOtTav3Z&ge- z*5z9U9d5m5SE(BM$i%sM^&nwOnZy+Rw6#8pX= zEABU%fN7SAxM8Q!#F@BVAAgngvO9X5?JO)V8~N6J|Ik^dVW$(owp=Y&}7|r`l@@LF1vSb&0b)b_FV}OF8oHxC=5*w(f&D!L~q0mnn_NOdih0>y}uGMsN z;j)Z3aFv|LBT@T1R=IwYV(6{1=LVVp;D%={9_sck=9_m0fE`nCPd$RFhKLu{%hnBIdF? zAE*YbG8RS`I*jz@ug4HFi~hj9ta$Fe?Zois7se~_f;LYMO31WXb-)2<(NL`>18@M5 ziL*sr5Wf+Y9;r3SzA_EUAb+-I_Gwvh3C*Nxs9mc6!`V4B2^MbKHf@`gwr$(CZQHhO z+qP}nww;x{^?LV4oW_aQ*uP<~HP<)Cuy7>lm*J=Yi#vWIGB9p>oB1XqMjY3mXNTiQ zO2_0z`CHWIj2@zyFnw2im;(@(BGj+$KXVg~HC4$t zT8;PSCR=>$YOaWZUsK|aZ=Is^1{+%$SjaxT{W4q0*Sa-Yw`04N!IB$+y@+d|v^yzg z7qVcqtC=x=!Jr>W>D2>9lh2HcDNK439$bjJPxpQx$lWFaB;w6nhhZGZqy{to$X+AL zzy-zE9-Z9*BbfD+`U;K8U4|;OR9qi=l{g_;5+oJNeELU&mtdEDO$UHaH`xg|AtWSv z0AMYYLRMRE+jAY`mM11JqSq>(U$WYA(yEsN+uz4ITd9+I>1rT`_9hIrfJsR2?NGZ)zp;RRWqsN=-9B60_q2W%5Y~Vj5$^Q2c;Q8V|lSY zgc6oLT#<^g6ZB(V#xjX=yk?nPFtu!4$#i-+u`n=Tkk&)GM)_}qM*2VHcON+J2LtDE z(J7{CFgZYYq7iJU!v-y8O^d=uYU|MYv)$tH!9LZs@5UjCk`d%LNR*q{_Ft$Y8^!ie zR8n;m(_W+1C``LfGkVBR#uk!eSR+v}XkDFZUjKB;sguj4Nfe;M6#sfqeLDY5A7)Tq z8iK?dRXf!_#W^!sT4D_(pd64M407|_(`*8CzPCim$njsg)xX5|(yiE~?>rmolt-a3 zPK$Dz^M`^reNhe#xVpS(hunx9Yx;YdvxUF#6UNx-DyN7M4q&L8$qU3seYcH|l z?Etgkz?X`D^_$~w$`Su)OS(Bm^e*zY2{|i}>M)v*M8j#ryd|GFPi)GkO2>@Av%ua* zyXHJu=RXv1Eo#t;j0AwQVHimEh=ZkNtEl7~9fh;QjBTP@$14RnIdVXU<3F|bZn8*d z!d4w?KoZ?U@TgrY78O$FnT|mSd#^^xb7OZUD|UqDPi-qTt|^ciT|fksqpZ=IBz!-$ zaxmlRoZnoGgUb#?_BQIx#7Jcsn6Zmdl?TbbEUXaHyWB+1hqJM9nMf1cK$p*+QA~SC zM6E!f8%se>#+WGbk^TWjwX@Ij!9AyNUj3H`bA~valu=KH>$>Bax!=RBFKg77pHtaQ zwHvQ#<5^6yKpv_^7~-1h5J9BM?8sa03t&)+XiL#CSF!iME@S%%ySPTPyyTRX-h!hz zm>e9<+=7fO!@9yh3!M%oP#W|?#uFcB8Bs?ZOD-q>{28tkH@Kf?>+&L;+X?TtLx9Hk zr|Vjs#y)-l8xU0mjM8^LKW{5KjZ_q=HuV--#aXT{p0RD9A69#tE%=iC!%@)c+7&P5 zMn;UI*B3<+iF~tgw|FoE;0ok$*C99E<Ew_IJqALuFiEF zbQ|T^aWazft%#zuIF?)?IsO;rm=5Z(1qZ?yYB7#SI-ml`>_|EJY35ssTGrNsjSBX=rTx(m@hF@ZnA*n?9R$)LQ@5el zvXoXO(nxD92s^a~FA#<94Lb3I!%X2#!kXCm(P475#ccRO-lN?$+;n77t)};O zoypd$s=1G&2)SNmd~oQ@4{}QC0jw^6PEqIfPmNS*I1!Y;}>y!`F{yE^Ux* zi;QvUC-f|Bl2QoJ)Qsfi41tXYj8uOs?{u8OGxc^^WB1=sSldh7M}6*?d-JA6Kv^!i zdAuMav1#)@Kk9lV9xG{@h~jA)DShcwk7m>#6>*2~(2Vu*YJC`VE5oc_*xbeD%EbBR zRX9(COI}|U41XRDmS1VjD2uF*20mR;H%o5`YZrfPQNhna8=)w~SmyNh9q!q@7k`)u90yH!px<))$+Op(^Tlx^gpgo;r4xyFjRHPo4dT7xikOgLJvt zQdY-C?cwWfSi3s$5QTGedZVdjDSUd8FO*Gn4Fx+NuJC?EzPj1u)Ow=+YSZfHW5!-A zJh6ORDqhzPuS6&^3v+hFCPeG2aSs~A=WPJ`WfJxIeMr|9Mc0Q4Ju5keqqogV?cTEA z=v=9}UAu?6XMK6p!9k;@I4SsJ(V-}bYR5~{LV3AU!fUq${2EcnTWvAVcJtG|qcA7e z=BGtoD@8<89rff;`n{E6Sj{XeIFy2_*86k=JX;s_RLa4!&MX28i}QQZ#z?YQzv$RY zj(PMmC4|9z8l198qxzk%^fYDSWx3is-oU%^3FdxfUeZO_hA^+idE|Q}`RPev{U8k8 zqgT66aQ}37y1Ywcw?9ysJjdf}e=$2mhU!xo^&u_fDg*n?fkmZdY2`~4GuC;U86EwG=kh%Ym?wWnqx!~LKy;0h!1Jw7&SmnGN{=vA5@GN zh(qQ?sl>eSh?@wN{u_THORpe_IPtUh6p}PSpRZjjZ4#-~x7IHhr71TfY|xD*X^$%VxIpSo zBG?C%hg!O$<@M3vwjX=4|=;@`~_roR0{`TnJO_=2@;4B%>5AGCe?tgSk(1tUwI; zaj}#Apmw)U&r-MA>K&rH-!`gNm0iQzI`@wOFbmZxM`Jc^h>8K)wz)QAHBA&44;Jet z_{WWxJ>a}INqU^6?=-%PyJQXtZ<2Sx!HJ#M-@5Np4MjgX7+RY3y>%6q7B>uRc^*~N z8$g>-jymXfFB69QS~#B}QdjZ%1&Q}b> z;R9Ho=cc%&UM6WdS^&La4nytXvRtF&y2OP|wNd08$``;1#zVh<|hngvyHXf5zAn^Db4KWsS+03c9FSiN=RzHNu6wypchQ8Tvx-g3gg>&4cnM;ju&qCjC)+3tV3SUffdxhL2cC@BrgstFb@1Mjm8 zMkzN_s;fYp_dpgaq)7}XxC2Do1KGYkpoJMvqGYFIi3{{BchgB#rAHw$DNGOt{D{Cw zSdd{hIOz(8m}cP@YTD{WY7`VG&V25c4EkGHPO3{^xVUQws^7!wGZ03)N#Pk=-nC?7 z1m&-nJOcllvPr=YK{~>p@`nO;5lB=3wov(VXY_3OAXJX7sDPdrBZu_a3%7L~Swi{Y z<+Ydh&Hve92}BD7WHVGxPSU^1$ox{G-=kaGLA=nOoiW{nzn9>(9AnDZVK28|C2`F> zAoWj{%zXm&K@)ml1#O2CPvYFZiF_^8VjU%L7RkVA9VEOP@-sK!9LqPr!5O6QEXNar z_s^hT3R`ZZ$dSMp(BO+ME{th(+`~+KkW|9){yK|4F`mtugSa>|$O1et1MGwmI-I;> zR(XMLPK26&uGnxMT}8V{!B~6tQzrk$k?9t&0RAMG);o`$Y#3x*@ic!DBN5-a8Wr(e z;|y|Z$L*1Htbx5f#AY30yD~Svy>(A;KP+<Wv_33Ka7;XDekK56IQxHvUW6%FxEoKOo_UpivAsnMBwH?|MGoG zPX9YL)Cr*B&|5)v@Jug2NS;T5j9%g|=4w8Hi>xb>eQ5P^%ju??Wi24QLPi4mgKZHV z2g$k!ocDNqzdi|>SlT}>1|t|K?^%m6#Tn9FKE^<-@qxqPzThFfkUXfu^vJWZYz6y$ zjnPXnEOip)LHEuj0`pC;qREy~unzj1se$9C`n;IllBaF0(e6&Y|FT8(*=Gvp9 zcp9Ryhe;*59AcYFbd(%lJ*c_}E3O4652(5pClFy=1HH45n`#xOtiT6Hs$xVt6k-Ms z(s&bdUbmP~DNve%j}kbc+~>nbGU)reFx_`-4mFV9<S#Z%nmnDABYAE?33W>cVG-m!wJ)>3NuXi2F0-KY)Zy&gkr zeB+>6$zA$n^t^>5m^J>8PF|dkCsF+wSzhg~}{>#kLD6wbL_D8g1 zFiuXb!BBx{As|$kUXcVrKZAUv2`0GRhRRl!~dvrWEXXUlNkP_`05}BGia9c(^H>+ zfizj(oc72yv=-+Obt#hshb_$I{5m9nmqw%>w3-_6d)Yk;lbJV*YhSc1g?#(No;Ng! zgaC}ZVm1`FKWA;>!m=3cwpTZF`s<@Vh2}Hy9N^pc#4r(@4pM)4wcP333CYOp%YCJ`{k;!rT8;R*>>kBLDti zCJj)dF>YDqJ`8Ht35EehcVy;cR_c2LK1?(YMg&s+Z1bh>?PGp@%)eY6XL|FQ_uVk) z!&`hnf|;ahs=sh-+~X)9zK(^iSkg%HHHD@a(!|7zJ6d^8+es#vcVipMjLh;x#VM92 zWe% zKaZzZ&!#9p+A3JPVSSuPO^+eJD#?KqBzQt)__fxLdYE)W>6m#nP5kuubluqShXKp= zdU9X}l#z^_9iud5_%plV^`F)0W8qwb8;)&sC^ArLZ3+FLt;8kgwP)X|K2|HS5)btS zQsuwTKAwftWvIBgA#QEcsuWVI=s9;iPTcKF^840xp~X}HjyX} zg^DJqAtb}S2-Yyg0z)%sna=Zl6EE81?1ehsZ>M^EzQ1#QrgB*ggVbW(JAOFcz3rVR zs5`4geYWXQ*FeXZYO>d^Kx~-oq&&PaTcMhd+PcH|r6V@yrleryeA~3$PYz^W@~{%A zs^7+E$mNT9X2!J6EaiP<^|y^&6koWvXEJ}1-&no&eosTi4<-vinorg6HnGBQ8DhUY$DX9W5^xi_-5M)-d2@$j_ufd0c8 z$@Kr_hV9YZO59>a^4Y7KR}xgwfQZ1B_@u~U&(a!6aaXKRCWUVnmZ(k`XOQsV*7|(d zLib09Y#hs4PE|sL0GhGg&;N8bLbF4kAPn`JAWXT}>sH4@|LxZBeu&W~ZWuq}*4Va2 zmuMAF9(QSN-}pi#Y0&xcc={Hkq*zoQu)h9&EL+>7QIo7FFK63+Uz6)|JgPc%x3;vt zIv=a-I@_(wI*~M8_;9AaDv>VAEw1fePni`-HAm8Qp%=+IUrxy~Tc0lS)hiUXX&8y& zN>=3Mr53PUvUQi#!P&9OzBXn4@}mA=ncY}Q>w6!Sj!9)iRiqKdAuASIpp`+ok>Bcd zLN={3PL_|*sSd@w&+yk)m#}$KxaEm7ImoxvYc)7f#h@S?tfD37My%&4y5~}l4K=n? zZAJoIU`3TIMP8V5Cu*J+hWpO9H#{F1>UF$oS#*GzYD;GIJPu=P&LH6(FNe5DC8@8A z2$Fhp_YSgT35%DcM0Ge!P+1{IQ4N!S#6YTP9xrw{@(@^a8=*C?Z4|V;7>zuc1WLCp zQqx-X-pSsq1&O{Oj;o~c>$v<&GKk=JRq93=!loXn&bK4$VM=zGF;=;u4vL-J*}&KR z_1&h{=Z*XEC3*61UAWVFoR9))l}bvSQ9M}ylcT_?ip867u4pW$T{BrjwQ+GjX4COl zubp(0Dk?g(r~F6+*(kSq|L!!G%Jm%f;dYUo2f*<@hvpq-;p4sT2x)>3tK98S_)PR_ zEA!k@+t-AspN+0Ka9$i(!^zS1PE>HSlzJ8Y?mhPq-f12??Ehy6LH(pjUs3~q`)Htq z&zglM?{ISFt#IO{hm6Z^*Gcq@0E4d-;DR2LNpNNJ(v6sRCF`Ki$b{{SVI@)T*2b(T zvRTp};=ePqpX}H{%ew5jyT!Ycvh~wl@#&!2+9Ej@y%l|*a25_-K&@?`#>wjcgR|y<%!3{zHisbywa>6?mue>j5M&D09TB!o zI~KQ0z3C%6hlcX80o;2smuevOX;REKR37ECudC^VF;?5kK_D>X3j{nv zxAW|{b1wzq>f>>|yX62-ZZglXs4=84^Qs-v1RK&HgdIr_yzhG!ikG!25ghSi9W~Kh zO1hXDQ1vQ5T-ITIZBVao1q3Rb#|EuO@D(Ss#^m%Bk3gEq;UJ>S5hr2dt-|(o35=yf zxFW&I;67Vxn5H7 z6rgRe)gLT&*9Z{38lHj5D*PtNXz|AY0o%VqF7feFG=>#<&C9CA4d{|T_2=qmO(MJ7 zv?Aw971Mlgr{>xw~zU7^Y?O&4sIxI}8&sIME;c!=A*&!A~!9MzD8BQU8&Yo7;uVXPAnWJIS z<1nlui1m*J{8XNzqy%WM2fHBo#^fB!ptBqkS->;G_@0w10mCE|{1eTh&k`BB`&Yp1 zR6atQosy3UTYX9128JN3F5=Mi;WCnHb0WZMMfo!JHAo0RN)vJ5c?a=sJ;Q2NQ|Q|g-m7nj`%ag z0gQNoNkI9r0f=35L6x{bjV}QrdQj}HG4W9mS)oGiD=&BIurIYOy{bK9W#-2oV6j57 zod5a^KCoyj@|rg;2<#h8Htb9@Skg{>Gnp}gk8gvILrWTfNgCjk_%p1)DN3_q8+UWO z++q{u(0g;!f#?>YVjm$}XLXv+hnHjfx6z3(@fU*4r!~^v7+NTZ{a}U!iV0g+2+5kVcxIJljIOVWLDpdd3$MbInWkM$iNo>w!U9sp29!H=y$v62;lj8n-lt)H}p{$ z;O#=bxz^5?kbqW(PQW|aN;a%Yg?-jfK`e_%i)q9*j4CG1?j4B4esD?n`~d7&0-Rfp zAWVTsP?|bJJLDFrdEEJ<;?}6#=!T+lYy0f=I~R`%CYv*c?6{Y`dUZs;XqY}@*l8_r z#l&?J;9{$Mvz;f1oxvI27ZfjYrqq#w(xFr;d5N6zLC8p!sKHjGE@Q}~n#qaZ4bcC2 z{=#{p+m-C+kHu_D*2S5Od6=(bzMY%5B%6a^3G z2!2%upE~{b+Cg)tw3kW*|~IV+66Y zSv=wCZ|%_G%i&r7P4^_hEI+RlumF~?bm*E)`2m=NXAW*R<^ZQ+>h#>DNkf4B-R%BUqzP${~3rY7F{_xzYfiRj;xj5%w?PJuX)b&ku>RP$f|wm?ggH{($PJ zx;V2F5KD74ZdYv(rwENX4$ksb{;Y6j#V=p!_eewO3Hq9y`%rxnAvR+%*&v*^ZfPD= z7tTK8$wz-BX}~->6w2sz<{o2seo>WY@0;rqdnMwF4cy)6JA)d0c1o+9V8|*1T7nuW z)8ODLZh_bU>14wd7C8XKp!pQ=6LD88RQ_#hm@Lz2+&3tEwrUj_@zytu|7Q?LFzBxU z(8$BCPDGv=+rTvuD9P7lH@0H%lMtNxPkG(=lAI)J;4zST8)#V)D0`?$?8BpvLpL8j zgJ__@2-5p^R(cpG6K7UJ96Fuuy&kB1420dC4{FdB3tM^q@sINU-!#6T_sh1Gsw_Lb zpT>`ale@Z(&(Uv-e|2?p3KJ56eDq6VZb84FF+aepX+XRGw8;EdZde9(M)v=G58Kh$ za@=A?@VQgFpAae`72I}j$lH!yDt5VAU63wQdI?Cyk3x=6CZ9~}y90ujFBF_eJmQoY z`vVLjaDBTGv;%tW^H`2P2>)UT)>pum?ZNllvu2keCX^UT@$z95NBZZ47&T%I@B5@L z!}v*4rN`gt_9;mhKlpym&P(xq!#QKcL*v|SdM*-C)>CQr^e@WZ*Us+*vT|bh7`|Ga z*wA`(ukX}a2pD%kup%7-g+w{M68JsSjOkiYHM%(I{>6Eb=e*Cw9=s=ZPLh{(g-8e+Y(UEe@mA)#iCA3d$cDjY0*-}xO4U#5mu z05V*ImJY6Dtct6XnV3p2o<(SLa-rWI=nN69fg{-WP?HAvywpkz$}*FZ?J^>k*(l(k zK{Q3iQOLM*8K<&uFaq53t$+&hn(wv^W;_kq`E`(KI#ZT=*STadmt6RO>d+O0igb{_ z`d~5b33Czn$;0p!WPwmwk9g&|^7kb|zKv5||Q# zwmgNn8%fJ+v&RzGa!x%(&hSPi@a!y&Q{gWr`Dh3UI>Q(n28dD-(jhs;JJl|0n3||O zXrJ{50GPMfq~XIn~e;qddx3QHT2Ll()0kE$4lH*f9!E8887_D zAVvQP7sAegXrJd)qY7p3U4ZXWo}B)>4uLzG z#QRQVId=3P(C~{!RA^X}E5B69vXJN7oaIliPY~yXv631k{$s=n+(uhdG$%0LG#m`% zFr~i9i0pF?Ra-h%NL2yPkh=Bvb9Z`%GtWQn5oJ5=3fd@ESKy3Hmt8 z;1XY@N|AcV{oW>XkfYeKGZ(`E)M%G#+3bmvSGNeJGu zdT^|zL1)ZrF}|L0Isp&HZ`pXvm*mYJ&Va2Wz5D-GL)M!Lm{@j9#jdFO3MBHh?V7%99D(|O4oeJm^wc$t%AzW&EyiahugrQeEx#`iX^Tesv zZW4d@8E6)Me&)0u!7bs3Ayd4oG1^4QC_q65 z%Xe6|s*fZoN634z$ zw^MUvTJ;`)+5I^ix0GAh`6UQwN}>gUr%?rKuYIQ;s1f<217V{}+FL#I3gy_&WOl$8 z@s2Kp-~$E#e<1ulu5$~W&bNsvn>Y0p3Mf(b_ZRT(4ir2LcJeR?dWXi?UU2qv_ipbS z_?A8}ziGYSOM4 zJ4UsJT%>vuxA6SDX^jY_t+XD+AQKP3h<0ndG{nYTNAQX}#nMjv3^Olh{OEpB8D_&3aZHV_*zkP4`y|-U92C-O@8{ru zT|@dt0p(bO+7J zTC*c(EJV{IA&xSV+?z^qjD#KKZE#LmQ4N$X-kz5LSwWKwz;M84d08Cu z8smJUeeDbETAfD4!D6$`WrCOM{9WJB+I?SC;o7i#MU~M#2o4gFMH&78axZJ_x|OnI z2}7Ww7tFJO>oMv@4msFyR$sI?I{exKYvgb2sl3GO5oeL$i4Xu9^Ug4j^;%vU!b6Lr z;jw8zZCNv7p@T1FwQ3E==lXOeJWhPT89vX(R@%pMN-+KvE z^|&_|!cb&%ro{?m@(@cl$AM=4h!ufJk{soLo4zy3u+J`De3uON-%B!NB*~}xSx^c@ z%4r;mO(c4f47{e1m9Uh#8mLEc-p9V^(udlLu1e;brE>M7Ku9%v8f8mUwY4(OFw*YU zI0Sp_g@EH7G;zg;lj8T_4=v3Z<83Ya`@B(><$i1_wq|p?&^I)`?Lzo)m0Ccve_(}| z%{82B+E<;Uwe_261{m7OMl5oU|$4ohU>Y z^(MenoYFTrkA@a;LdnO;pZtUGTEa(aKhhNqdKjm~U^&Cxv?JG1xPq_I zx>B?-LwELAF{V7gYHeUG?0qnlU2NlHKG}zDOUSfpE;5A%k3KZEF-xxzMj%IzxqoUO z3J_oG=io|x+R(uF8FL;Hv|497*J4$XOV^hsh!K?$8rm1_X6W5%n?R6Z#?Fga(Y;}^ z77f5{F=R1l1AKxuw(^3s8HBs@LFq$4=p>QGFrWTY?r){ zJh4Nsc}4E_B8)|oC(T4p@Z|}20|dvp*b&MXq*4AfPJyj6%xtN{uZHR@5r3m^b8?jt z2JvSvjmep@pDZkGWTY`o4ocu?dBM5yXK|7-D8|gD@xTK(3E!be?ZBTOVTN(*TMsK- zXp3dUahAq~Lp*PuNnT@*gEQAA!I#pj8P}2G6_r=H2H7^|)(;aJoJb)C@;yjQLrM%} z4SFi-3n`W}z~9v5_(zv~rp*3^%}C;ZE#=6gP}aiD9wZVSJ24f2jaIWE9-+cTT3%2D|vZ0tOIv(lT0C z{h|_^USO)&3;t!@p!eBEA?x&*3mgN@c(8O1XV#*PFU4pxw=1=@-%0nlRFe0q}e60?j+LZ@bNUGlcU9(G=c?2xkuHVp6lt!=}zxIN~r!IA%1QJ0jK5 z7z7+MMAA+^-(PGT+Nw512!q2%HV6|GNBMT?lB1(ude>KG(DokM*Hd5TuS}iP>Ta^C zrt}CWP$WXYI^FS#IyQVRKd^8wv{PReBA*ogGwz{^{aG7fD9i2Ly?CErg zG97U7?(1i>Y0%xG;;f&0cW&Z*uQa!N&9aQzyS*k09fMRUE;|4-<~BfThC>tY=ayy| zvTx8<-3K#2K#6-|_HDi*Eas7cJo%9KB1{T;1>#)HgqYb@1G$E4{qoRSeRJucTP5J6 zAky}vvZ>s$Y2wEXOe&?kz09&{*lKH60sY1|3pSbb)7{(VBq`9I8m)whZrD?iU2UvR z_)E_OIXB<}nniwV^zuI697|Q;>>akNn4SZ~Ub{(ehFMT?22&Fp5JCz&kD5(?yJGsC zuz>;K==4*LzuCC$6U^%r31FV#;MV%VpHUtUvi{K9sGNOC02An{lApR;Jvzp|&bbDJ z7Hv)-H%t&@ZI2Qr?i4Om&?teEo0t`mT&x*)hydE=5ME`){899&D9bzw@uHZ#GWmp* zPry{@b@v7|M5?w8S^Yy7U>9Xe-=a~S`Laoz8s_O`)Yd6>^)YhRl%K~GFLG*W*gbHU zXx6d4vEhbi=th~NidV=)_e&|PhgjilzAZ!?LMss=?nMHY5g=8}b-##<0PZS3o#cVn zYgqpnb!wZ4LAp&|O(G{j97mj4KSWTZI5)dDkPJxZ^?R+tMF4D}6G_DAt?Gb>MqqJ| z_LFS6La`D%(i6yBr>s68Uj&ZaZCoxh#WndQ}-?Eb`OX)HyOlnwhjPynmO!Xe@-V zrT7f>W^`*lf^oLk)j6Rjy8kx-kz+);9B^a+H;-Nc`^2$A$Y85}xx8YfM95%U6RM1r`vC}zmQNAj!KOc|GP|TaeKAAbLD2c@9;MUG&=DB;t&Yg!( zlO3)!nk2%x7pb}2*9b9W0Jsc$AufSHi={oL&`?(l;Ojo8L}n>CXozgN^dpiwv^R4+ zG1(%?tvaFOy^}2*mw~krcy!(dNvooLj}0VDXTMC57=iH@)j8rGo6W|?=v)xl#X!;q zE*7i1L+|(~>=p&(D*Jqn02%%28jkwm7Y6kLq$>RGYtA%13>{lybbwB1R`5A1jtJ5p<1Ijpq_I^Zl~T# z{PO204y+2>o-=kUWj;He*<80!HIu04-iM}s$~9KpSZhCanXDLr6@-!>yQ{BS@9>LP zc)iu%3&F4Q3+$7-A9!(}tLykGYag@=ij9;!>!E?8pg_uym`kpI?R>a39=_`bLlWIA z*e2N(XANX{mRIb#=JIHWk2ki{aE!@8Y|8~UpWD;2=MTs(_<`qvi)9WBlZ6sDSlPkF znarU>7l3Zfuk9nhH+yQ^=3lW66uC{r_-J7r{iRVppsQe^g)&`_Hlu6YaK({WQJp`# zx?FTpCUU46MXuc4{xQN?Qk!ZcaDC62dLCL5LC*9_p(Jq#5kRv)9@6TM>Y$g=gv97pU-C%99r|BX zl;}Jfo69!A89~zEb;VZU)!cb$Zr{1n6fzL4=A(^!4fieAK!%_{CV9Vrt%JR8qdjMX zm@2ZL1DG>WKx+e$D3bduL*Syb(O$u~UDW8_uKrBPN&&e3@PuN_<(aypW&9!WZ;%9F zG(tKu%EJu};&dgV2vag`YNR7(#m;C(dxg7yGDuXtPIbSj!G$bFxs+?js_+Qs&ZDXa z1Ic{DQF*;>)l_}qG34RWD+Z3GPYxm>Q$v{l@_0otm1KxUJ$RhjkVw1ix<(SyanyoE z2lkwV1Q?OH90MaOSLjEQyjLJV*M`ZD!k#a&Cy{}Jf}9YiJF;em@}P%FMAHgZpcQ7n zf<4W+%#1ObFoKl-ZEG(&tgWPub2S7po7}{wg0|l8Xk_2vbwp-pWrP@Kt;i&=qO3OB z;Ou%_DcCifIsat>yo_>rG`*8Ab8}~% zN;5P#s}aJmX|URyWi$#j(Bz`^#9ur!gLhN{)=&g@JW&hSHXvlb1C!+QBNZ<=E4AKs zAn5Wvw&A30o|C?|u<}O+He)LA?mRLq3fM0{5?pLKvY<~E7AhHb>$&Uw3ohDGHT9py zg#S)W!@&A~>fAS)T25J_D86@f`E;1e6xgr5#-;E*B}<>ihq8FqeEN`M%t+)wY_3~) zdrjyF`67ZwBeq;Q#z^Y(8%<{)K3yPpKsdwq;NXe|* z)j-k;gUa@;?C=b+W@%=7putGQBq4fN3v+&+-#65S$)Oev_2_$F&rv<^joLMnf_hE& zVcnWr3w4tk!piJ@Iwm90JW^>>iog3l%ByS}q@Mre zQX4)jQNaiYO>G|xp9&Pr(zW7=@w_c9W+Uy9JZ^uy0Xl!Hf6Q;ieJGI zQ=kk;ydDxuoNm&w^DKi2O4E@$ENK4TvhMAgYdIp-wnS3EBq6Nom|@pN#;Zplw@GHX z0}!z;bTGe71_K0#^+;4rnkeV4lBzn#9>2tRU9(gkhcgfG=>hS&GmELKm)LX%jx%FHtIQ_I$Lyoi@peJ%Xcg+^Bv>Q= z-DKmrBc8ppFv8t*a)>@$<@ECiLJGLpfvzF!vFK-rzLpjeE#r8DEFdp+Uk2ALpcW8j zzUt~u{~Jw=m=I%Y*WG%%evX_MlCSGH4PFT^EKVqfB_W4tOZzMG$0{uc-2+!(w$_@A zv(9$y$|RSj(4|?HjrA|Bn6^J?2;&6aG03-IQ?b<3;F{S0m%3PCK4~{Rdr<8t2yvz{ zM3VjrX21m`^RUT1r@M)O>|U;XYPqi*!!YK~-6`o#>$%}NQlhM4tUCgzr589r)w6ycypd7NgA$5H&XMa}hGa7$d5Uhd$KX}xN`a0E$K**2#ZS6yh9*@rh zN`_I{{U}aAv-v`;=ps$zD#T_R6r^ftPd4`WGKrU-EaeVf#4NQ=h>L71kz!eYa5e~u z@F3}_anNXM)iMSov_7?eAK|^{pbcPXyBG{*5&l8kg*Whfs-!IhLJZ4C3EbV)Kq>%i z>1sFpU|3_1ws=dnJ}B}9WdYey;~drVH-vgndTOxSc--tj=&FK!;)z96b*9~8Rk!<* zSbl>*8?a3GRiS+0CM5cXNVLYn^eRb0riDjoBGz0uSc6uv34ybYZ6#thc2epts%t4A zVCuL6c`V|pO`DJqHg1tehvu17IS191lFSzRhKm>3%;c2GDba0BGG$d=(Y0+38gv-+ zkuFztxP;Oj@A-N#@ zVT{1{xZu&HfRhOOQoJ&1FmI|9vWF^9kR^e|HsafK`F~AXPakoYDcKmv9yn7p-L5nn zzb374Xu6(a5Qag`sm;QRy{en#+J|={B>2O)Hz7l8->^Yws7e&zJiH4o0Ji4(#Bs*) zal?&E-=*$37bP_$J1SM@a66AKUSfy4%hSDc!BZX1J=^?Y6Ii~8tmS-nj>4UGhGW?? zpLHvjVT1M2&8ri?9_$)(O6BcvB%c=%6^SufveNx6bCS*1kffo6IcC~(jJxQLB^f~_ zRpuh|<^K6pDc%{UPi$$LFc(%bN>u45xYSF-Q7vTv{*q%&e{*No=POl9g~Dul!JbS~ z+a!Dw6L8kBpqG+a8vfwb*#i5ZzB6ksT20C3ml+3#hj?(9TNzv5C$6w%P^}7?J z9M!7Cqzff~6ss+3+OKO!SIfPG`VQcCNjEB?$fPJGKWs0xygHn$t>vxum%d4fvW)s< zlEDEh<5QPEHzL%z_j+6pYq%t-8kXa!CE4{T_sRnQ%9=Ydm{pgV)ph&J`-Lx+_hs0# zWF6aVygH{-`*89OcB;L9AbhK5YY>DwHp5gJGnIjK+7py1(5925*h}E|YEdXoa(n6< z{P;UIS^U0+Q)@}gc|c)5jH`=JuRC}>5MgtrJmWy9Nhh54+pOUN7a5e=851);VRP7( zXlhpEDlvC>!03#@3wLoW5_mp;8y<^$WAKi+=e&OTgzIK^+bb*U7I+hY9)(&RO<-~5 zd~ox9nM^nlB>jPjc${){ATDD+Q&z*X z;W7mb3?kIeg7A33X=}}vMYggn7}iGG+9&rWpnaz zAd|YR;0<|1-BG>0#Y^c=0!myuLX+(Mj%?+zy2Nvm0%L9LzB&-Bty<$Xs~OlORgp^^ z7|=`7>c4q*#I~!dss)w@Y}tWXA*H~Q-Nhm&pI?p)Xh5Trq8I|nR0o!man9+zC-o6f z%4Bt@IfJmS6S`EyaB=9udR#-W*EW~*FbINXhUXyD8D~B7T&S57{VP;Z_M$0{{ZBrO zDhK?kweYvgrS_+iQ<^jph4aQ`+fA+)-!3QeXn`JQC~5^mN4@3YIZ#`)lL5X0uK*iH z)(4=tLDIa*Jsm<>!-hVi`2cg7n)|2>I6ED+z@asm{7|MtKX}9f*jyO%MllcpUoOz9 z1MIuQJgN$p6)Hw#_luR~Ft4?eEvX_fsCZsb9YCd7KoV3u=rSM?+=~IW)Ba+*GTtof zvP3nvHij5H;MKwK^YtUqW0C}*ABkG`lQ9?Yq3wiPHa1;#g-v#KcNX1r-@KkvbG2L; zsZ(#J>YGUO{H-z2*;OW_Wj2WldRY(^t%U<6(u?+@lruo7S(ryipR@qZDwl?GO`Cy0 zT1KQ(!vw%+xD&<_BcN#(n{jZq0kmt@!u$pau%O;ST~4(?MAyG!D*;cPp6huka~y+- zt1nD4Y`qZ+kzG3wIGLX<&wRC{`XpE$qb9*^i79$bR&1|he5urGk>GjlNU);ZLup=9 zl=+{qHTfM@U31=HW_!9D3SAMq?iZkrbSeKu*q0_Pz@^qqYEp)Z4r`pIlq8I%9gZ*> zc7P7l213e?ySQ^syP#lK7GPFPev!wxEOK|!gtNfsWI~tZW2xNMQdoQ)QKHpAZ~`@vgzEegFo`g0k8tdJcZ=Yr+`mt z|3RjdaqFTRBGkSVA{G30pa=$Oj*4U?6ot-75-+`hPoZ?c`@}=4+&aR2Xhw6`_YO|O zfnY9g0CbRQXcX>`>&`uu!=07y#_RPmqy(@yxtEAAVk$|2PmgS>8zrK~-4nb@t$oQ-f$}K;snMXkHEw>H-Oi#G{6P zlQa%q3)u2b8I<0$ktyu)XfkToKQ2eE4TeU%o`%lhBJZ;N)OLb@SjaS4Uy+T&OUQhK zBbhd%Sh6COXmc@-XVqn6?~*$SC1eolvL23&at&(A&^iMH5ZJx1OFFrM zg2#dd+4uJY74Y&pFt+v2$;3j05aJNEBM@+AW^S5LiDuR#6#5pt7HU?wg6OB%F?O4* zHG9koWs7>Bnax9-1>vK(-Y11I9s&T(^}KE7%@` z+(ZYjtQIt@OmxM3!4_Bqr&NZ{9I#j37lqSJcoebPBIqr15CRc2=*GjEQQ4=?ZD=$v zY*kB5Vd6;vvf!T`K9NR_42o^Yi5zplRUZOkg~(H~!M!JAHH2~0g!#NOgd zo^zouz*03k$G*n`Lj$zD;@;r<4*=H)cWuuU{)AOV3$q!YUx>b`Al-WvP9DXjnijGN zsD8ZB#KN&m2T#dAcO)XL;%vpq>-vVJL`ZMUFN-w=)}mah)q|20WdH2Rx+`Z?v|xQZ zYyDh;rG?O`>($7MI)5vn>d*4Rj39so&IW|h$y_Xg#emV##u8%*?%g|viINFeVBq9` z6<(Or_wVOO_QJjM6V*7b>U6;vg37mAiJZ)P9n6i?W<5>zT;*Jx`JF5%Pv$1zIyUMS zVNm8@VRc5h@H(fixiS`0)zC%N*3t@|Zz?*_O8=Hdz4LIbM8;L}=Ft@8VQdm~5UN+h zac?x^N+!0dSJcPuP=evb`i}&;n5-;zmbaTxHtwp(yc`^rpa+hgLZ%3o+J7`CtJ9p@ zSSoO_<^$=6T^0g4vH%Q)ui1SU45DzAs!~<<`gYg0V2f%dhUp^UyvL#JW+h?x$5@ieMT9Zo+7WqL0a#4I7;kEg4U-eHAE0}XmosQFg?zy z+zc14SpkKqbH4BHR$9tS4gHlAt_YC2=l3s(Piu<;C(*@&U`-!%!HU!k< z%^%#~kXiSt?oi9I)D*4Y|HGq(ayzm8RWG+KRTjnMyT+3>eV4z(&(HmJ;P+bJ{{`vCf`9a%HUa_A0cjcf`F&s@6bfn8O{D4O4C3isn< zR6+c$QmkLmYNLM7pV_PK{O74rLp)Qfm#226O{q+VcFn7^x5fo2dj4JS%Tn05WtD-u z93L;k@ptRk#xna^xb8o12l_kj!rgz`VP9B8THtK)ajpyNnrex~n?NSO0t?$YahHF)&S1#Sn>pTDAYFGu}845U308 zx&+^3?>5K@ap;`wxMTD1p$HFeI&$6}xLLsKP)^TJJZc)7r?4>9?bN>_*%)d~D%iQ1 z+P%plhYD|(XPq77>y+b$Ik|=PF==Sue3!OWsS(QlM{hz!7DknX=NJ?N2Vd{>kqG8d5!Bt2JxqI;&aF3I0*nraC?YsQ6(oW~`3hxTU zZKsHk2$d{5Zs?`vT2X6&1}-tU@>A4QWYF_!AB+Y+=UACqzKb`3Iav;jqYRW^hzmtd zVo~v=>fY*3KQA8iCH-{FIBPWbpB)KL+opwn2t}@iOYP^uMA&4vnK-Jh0{Qn)Ns%+} z+F&bvv50HG8Zj`-$y&@#SR#ZO7&o>RaV^9K&({T0)8J$V8;I!!lWP&c_n1ifN%FxB z(I@)*Qf%=fMy}OQdi#xeEuj-3R1rD!@vxH|5b^ z)r5iHK92)^H~#+3t4Dtfl}K8;%CCJr>egj#(G_h8sE5B%aI%k1QD8o#cze|U{n5tr z^#-7)aI8wxOw+l>eFwYSuv576#-qPP!r_N_@Yu)gPW$%%;}czv5WHM_g%-*8H;7v? zHMR-C{)X8cDlIjEW^zIa4Xx#OkNfZj;z{n$-=;F$Dxo%p@SZhh2wgNP7dv9pd=E;T z=5$TX=ZVI;GK6A{K!Xy0i}>d_d!YQ{3!=ojuM>^J@VqgQ&QRjBE&l!G3GM@Hj%ClQTuLO!fTAJ4@Pnj%N3o za455>4;Rvg#A(YdGvd2K=N@%MLGgRbUem5K3XTa`YF(z zr2;T}Y?3RS`vuxnSnH9$Y@JZe9C=!YFgRD|TpVr48!P!D-1!RaEF-i}NL=g?bJ2B3 z%6ktQCr4IH&^}V3mU$i)?Ji^#QO|`(8`n}#^06Js&{k}a#Se$8NR2El#ywwe?Q$bR zFhy38cT$oFED=@Dku_3-&b#T+=?wtGE$>UDGwM2rrQ9->kTe?_xnYzevz4Oph+sHk zY0c_`a?zVJ#2R$|azk;mOVs--0OzZd=>}X5Y(P!y5W01V)59Fk_FVJFY>p_iGtqtZ zxDf4X2D>s5F=J-T#Rt@CuTyyWgB7ubGnxMgN6$1xMDS<;yBV9B z0M2q?xc+-mUQ0@LPKTUv>BJK`{c1?zl25Dg^&FQ3&x{pE?=bR_g?bn^CApJhKuV>< z7I8`B*G~XvAKl0oP`a!91yarpLfv0MNF`OLFv^^3x@8yBTks!MJRkY*Qyjgw)T$V< zK%EkkqS^#bU*(2J)@70Hx!9u_o@0hEmiH*#dLhyQCpEyGC)`G73ys7S6cI-dl>Tw$ zC^vi7!x96I&UrxLtr+G6jgmdYR_*-CAF43x3cgHStbT?ourbiW{+@cw)IgXCeoxn$ z;dr(*<2K=eLTL;jg6M6#ZYO6`lA@q!gQC_7p@oN9uyoO!exw-v7OG$lVwXIaLi+MI zjn!cf5F+s#ZQ>Uav4IeL4mM$mW|vTEELy|aDxX$Ea4@|6zhkIxWfROC9HMU<#4mzIx&o_z%d-Ji z{6!sp@sM+2+GpifGxM&_vBz9C)U*UimLD?29RzHzL>~g@C4B*t5_O{{>duBKi^lni#=Vkm zvPGDAv|%nJE5@cS)Ex+p0UWd?nwCKC>}E93*qggBG%>Krv+GjoMw|+{wd&}tR$J>$ zyb-ez8R)bws$*9g68pS~aPKzPBD7nUf5R`f>L;c#qZ#RyCh>Jyf=f$_E*>jfqPwD9 zH)+x3qEDJENwQlw9;c3MBx=ZRfkumH)op81QYyvOY!-FhOecj+b#LeMoQzR}cr&wm z--kq50InxuxcW3CAY}Oz1-W(sSvu?|rZp+Eji<}Cs*YUqjv&45(=-4`gNT=GE-~7o zN3Ri>QltM~SG@AR<%H4T=Q~qCl#hg<8W{ZfH*K$IcYSZUzn-R#?QnlFX}@<@ch&J~ z?~{pZ_4qkhnX&G4td-4PTT#R{y35D@l8w6!<~N;IA< zdmI7ZX8sWv?9Y3Uw@~*JlriI6?pA7kO@?LNKgqAtO zQg44P*A&5AGgj=k`J(SM&H=n@%k+o??ako6TIafmyl9#>Fb*}?ea9N<&R*sBd*sLa z@x%HL>X`Mvg0wI(v;7}PORc7K{0r0y{4d`Gi?P(P1KpCe@_NbFFj@#J1is>yIzbN|l;0MPM z)8%ZZXdP1?Aah%FUR>USlx1Xj0Zyp?GpZ*qu5n#JI7WOt^>*f?L4um5Sn5T%9S^** zdA9u1Pzl-5sL7n#`tw!eJ|eMhM2m?ODz&apjqH7S-cEaO4UfDR-fp=Yw<(>URkO5+yd+h( z-@2q{QWFh2H&rGNir8qoiqff!nJIt{`k{zpOZ{?=KxFJ$_w-D zt8x}zdLySX!FS)EWs9b!3#DSIlOf zCGKkZ)@+KR`UzX^HPl+`t=r3hvpu;GQLl>`ed3TBsFcid0<9xTcXDo*E^pFlkG3=< zTcK=~_aQ}9!5;v5j&{*_fVBMus32*=$MbeK29~>CboaMh^W9HQbMg{F#BD#Un*fu6 zV3DVWa@RrWG<5Gg-4c5$UTTdrkd>EuzObGIg|^o`EtDAa6R4cr&Wt+ei8(;kj=N}N zWMwD1cCI1OxE`Uu1(7f&-accmh=_Dh6Wi!A=OZOLo)rrFg@M!XH?W1^los-NDUN)e zgt=F`9OU;$&NpZibvKq~&7!i}Ew9T&=Auep{2T@0@(vDm_*LMthE+`HylZ?)p;4m> z9o+yrlzeiV4sw6u&zp6Gx>ym;tX25>JQet@%|W8yLHLQ!-dH|jkmtKWqhvJFO1TRT zI$u=^a($Rz1l6)z;xxvbS$VBQ8oZiM_nUTN!!?IM(y4jtQ>;E+WqMl%H$U)S8A2E< zO-hmO1{CImFg`F`z zC_0#hBIh`aLd)npBM_Xf`40ijB?ouy-8rC{R5#2iYnZqKFJ6R0x)vaW4E_WXe(RH(dCdZOWq*mLrtv9cPqlIu z*>N<6=#PYYsA}x~f%etS3l*_wPu>4l`oqLP@vmv(MFZhFCnsveQQpKonX)8|X=Q}g z4M^YCegluO;uQ)E?l35cYC;d6t2w`yK)hmM(vPE4FPuQD_ZBII29?^I zgWIUjdM0|_$9iH2d@3=@sibTEKAH;Rtg>qm(NITpe$0H6Fz1v+?|9QEPbl2XUi2^I z(H(*s0M3-rVpT-R&Px-KBVK2@Ce4+n!i_eXkj?QRKpoY%FqLy%Va1EMmoJINSeT-L zIcD>{@0y0_OlW8pULRi|;(08WG$DpaU8*ADZb$vZ@Bu@RSR?*516*8v(LENu(7sKs zkYK9aQu3cPSWl=;PJ$)QMZ77FWTpzZ!%!)d{TZ(~o`wAw)&-~m=(usej7_KS@u*EL zd0tmajk>1PV`JrPJ{1UWBnbq8iT>g<Iuq33xEIqxlCC^FZ9&sEh{Zd((Jv`wJl8uwaD*iX zn0yK@KQ8&q=Y7NYZu$FlA3Lq^KWs(YIw~|0w+6^c!fD`zgpDw=y z=E{E;`Fc0YAk|A+3vIOf4UytF31QU=t>@ua-uwG3(>=O2a-dBwje_W9a2K~GL0=)& z#cYksxUqT617ZE&yQ+!9fRkRPn`Sn^%vh~Y2zLe{%S5_{^tWft=X;6aPdG=oq!e

    +

    +Previous: , Up: C Interface   [Contents][Index]

    +